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/branch_push_workflow.yml b/.github/workflows/branch_push_workflow.yml index 96bc23e44e..23c7a19460 100644 --- a/.github/workflows/branch_push_workflow.yml +++ b/.github/workflows/branch_push_workflow.yml @@ -16,13 +16,13 @@ jobs: runs-on: ubuntu-latest steps: # acquire github action routines - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 # acquire specific version of python - - name: Set up Python 3.6 + - name: Set up Python 3.10 if: github.repository == 'ESCOMP/CAM' #Only run on main repo - uses: actions/setup-python@v1 + uses: actions/setup-python@v4 with: - python-version: '3.6' # Semantic version range syntax or exact version of a Python version + python-version: '3.10' # Semantic version range syntax or exact version of a Python version # install required python packages - name: Install dependencies if: github.repository == 'ESCOMP/CAM' #Only run on main repo diff --git a/.github/workflows/fleximod_test.yaml b/.github/workflows/fleximod_test.yaml new file mode 100644 index 0000000000..4e432c0b19 --- /dev/null +++ b/.github/workflows/fleximod_test.yaml @@ -0,0 +1,29 @@ +on: pull_request + +jobs: + fleximod-test: + runs-on: ubuntu-latest + strategy: + fail-fast: false + 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 + echo + echo "Update complete, checking status" + echo + $GITHUB_WORKSPACE/bin/git-fleximod test + - id: check-cleanliness + run: | + echo + echo "Checking if git fleximod matches expected externals" + echo + git diff --exit-code +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 diff --git a/.gitignore b/.gitignore index 48a511250b..ca3a7df6c0 100644 --- a/.gitignore +++ b/.gitignore @@ -1,18 +1,3 @@ -# Ignore externals -chem_proc -cime -components -manage_externals.log -src/physics/carma/base -src/physics/clubb -src/physics/cosp2/src -src/physics/silhs -src/physics/pumas -src/dynamics/fv3/atmos_cubed_sphere -libraries/FMS -src/atmos_phys -src/dynamics/mpas/dycore - # Ignore compiled python buildnmlc buildcppc diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000000..f899639357 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,213 @@ +[submodule "chem_proc"] + path = chem_proc + url = https://github.com/ESCOMP/CHEM_PREPROCESSOR.git + fxrequired = AlwaysRequired + fxtag = chem_proc5_0_06 + fxDONOTUSEurl = https://github.com/ESCOMP/CHEM_PREPROCESSOR.git + +[submodule "carma"] + path = src/physics/carma/base + url = https://github.com/ESCOMP/CARMA_base.git + fxrequired = AlwaysRequired + fxtag = carma4_09 + fxDONOTUSEurl = https://github.com/ESCOMP/CARMA_base.git + +[submodule "pumas"] + path = src/physics/pumas + url = https://github.com/ESCOMP/PUMAS + fxrequired = AlwaysRequired + fxtag = pumas_cam-release_v1.36 + fxDONOTUSEurl = https://github.com/ESCOMP/PUMAS + +[submodule "pumas-frozen"] + path = src/physics/pumas-frozen + url = https://github.com/ESCOMP/PUMAS + fxrequired = AlwaysRequired + fxtag = pumas_cam-release_v1.17_rename + fxDONOTUSEurl = https://github.com/ESCOMP/PUMAS + +[submodule "ali_arms"] + path = src/physics/ali_arms + url = https://github.com/ESCOMP/ALI-ARMS + fxrequired = AlwaysRequired + fxtag = ALI_ARMS_v1.0.1 + fxDONOTUSEurl = https://github.com/ESCOMP/ALI-ARMS + +[submodule "atmos_phys"] + path = src/atmos_phys + url = https://github.com/ESCOMP/atmospheric_physics + fxtag = atmos_phys0_08_000 + fxrequired = AlwaysRequired + fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics + +[submodule "fv3"] + path = src/dynamics/fv3 + url = https://github.com/ESCOMP/CAM_FV3_interface.git + fxrequired = AlwaysRequired + fxtag = fv3int_061924 + fxDONOTUSEurl = https://github.com/ESCOMP/CAM_FV3_interface.git + +[submodule "geoschem"] + path = src/chemistry/geoschem/geoschem_src + url = https://github.com/geoschem/geos-chem.git + fxrequired = AlwaysRequired + fxtag = 14.4.3 + fxDONOTUSEurl = https://github.com/geoschem/geos-chem.git + +[submodule "cloud_j"] + path = src/chemistry/cloud_j + url = https://github.com/geoschem/cloud-j.git + fxrequired = AlwaysRequired + fxtag = 7.7.3 + fxDONOTUSEurl = https://github.com/geoschem/cloud-j.git + +[submodule "hetp"] + path = src/chemistry/hetp + url = https://github.com/geoschem/heterogeneous-vectorized-or-parallel.git + fxrequired = AlwaysRequired + fxtag = geoschem_hetp_1.0 + fxDONOTUSEurl = https://github.com/geoschem/heterogeneous-vectorized-or-parallel.git + +[submodule "hemco"] + path = src/hemco + url = https://github.com/ESCOMP/HEMCO_CESM.git + fxtag = hemco-cesm2_0_hemco3_9_0 + fxrequired = AlwaysRequired + fxDONOTUSEurl = https://github.com/ESCOMP/HEMCO_CESM.git + +[submodule "rte-rrtmgp"] + path = src/physics/rrtmgp/ext + url = https://github.com/earth-system-radiation/rte-rrtmgp.git + fxrequired = AlwaysRequired + fxtag = v1.7 + fxDONOTUSEurl = https://github.com/earth-system-radiation/rte-rrtmgp.git + +[submodule "rrtmgp-data"] + path = src/physics/rrtmgp/data + url = https://github.com/earth-system-radiation/rrtmgp-data.git + fxrequired = AlwaysRequired + fxtag = v1.8 + fxDONOTUSEurl = https://github.com/earth-system-radiation/rrtmgp-data.git + +[submodule "mpas"] + path = src/dynamics/mpas/dycore + url = https://github.com/MPAS-Dev/MPAS-Model.git + fxrequired = AlwaysRequired + fxsparse = ../.mpas_sparse_checkout + fxtag = v8.2.1 + fxDONOTUSEurl = https://github.com/MPAS-Dev/MPAS-Model.git + +[submodule "cosp2"] + path = src/physics/cosp2/src + url = https://github.com/CFMIP/COSPv2.0 + fxrequired = AlwaysRequired + fxsparse = ../.cosp_sparse_checkout + fxtag = v2.1.4cesm + fxDONOTUSEurl = https://github.com/CFMIP/COSPv2.0 + +[submodule "clubb"] + path = src/physics/clubb + url = https://github.com/larson-group/clubb_release + fxrequired = AlwaysRequired + fxsparse = ../.clubb_sparse_checkout + fxtag = clubb_4ncar_20240605_73d60f6_gpufixes_posinf + fxDONOTUSEurl = https://github.com/larson-group/clubb_release + +[submodule "cism"] +path = components/cism +url = https://github.com/ESCOMP/CISM-wrapper +fxtag = cismwrap_2_2_005 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/CISM-wrapper + +[submodule "rtm"] +path = components/rtm +url = https://github.com/ESCOMP/RTM +fxtag = rtm1_0_84 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/RTM + +[submodule "mosart"] +path = components/mosart +url = https://github.com/ESCOMP/MOSART +fxtag = mosart1.1.07 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/MOSART + +[submodule "mizuRoute"] +path = components/mizuRoute +url = https://github.com/ESCOMP/mizuRoute +fxtag = cesm-coupling.n03_v2.2.0 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/mizuRoute + +[submodule "ccs_config"] +path = ccs_config +url = https://github.com/ESMCI/ccs_config_cesm.git +fxtag = ccs_config_cesm1.0.21 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESMCI/ccs_config_cesm.git + +[submodule "cime"] +path = cime +url = https://github.com/ESMCI/cime +fxtag = cime6.1.58 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESMCI/cime + +[submodule "cmeps"] +path = components/cmeps +url = https://github.com/ESCOMP/CMEPS.git +fxtag = cmeps1.0.33 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/CMEPS.git + +[submodule "cdeps"] +path = components/cdeps +url = https://github.com/ESCOMP/CDEPS.git +fxtag = cdeps1.0.61 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/CDEPS.git + +[submodule "share"] +path = share +url = https://github.com/ESCOMP/CESM_share +fxtag = share1.1.9 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/CESM_share + +[submodule "parallelio"] +path = libraries/parallelio +url = https://github.com/NCAR/ParallelIO +fxtag = pio2_6_3 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/NCAR/ParallelIO + +[submodule "cice"] +path = components/cice +url = https://github.com/ESCOMP/CESM_CICE +fxtag = cesm3_cice6_6_0_6 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/CESM_CICE + +[submodule "clm"] +path = components/clm +url = https://github.com/ESCOMP/CTSM +fxtag = ctsm5.3.017 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/CTSM + +[submodule "fms"] +path = libraries/FMS +url = https://github.com/ESCOMP/FMS_interface +fxtag = fi_240828 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/ESCOMP/FMS_interface + +[submodule "tools/CUPiD"] +path = tools/CUPiD +url = https://github.com/NCAR/CUPiD.git +fxtag = v0.1.4 +fxrequired = ToplevelRequired +fxDONOTUSEurl = https://github.com/NCAR/CUPiD.git + diff --git a/.lib/git-fleximod/.github/workflows/pre-commit b/.lib/git-fleximod/.github/workflows/pre-commit new file mode 100644 index 0000000000..1a6ad0082a --- /dev/null +++ b/.lib/git-fleximod/.github/workflows/pre-commit @@ -0,0 +1,13 @@ +name: pre-commit +on: + pull_request: + push: + branches: [main] + +jobs: + pre-commit: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v3 + - uses: actions/setup-python@v3 + - uses: pre-commit/action@v3.0.0 diff --git a/.lib/git-fleximod/.github/workflows/pytest.yaml b/.lib/git-fleximod/.github/workflows/pytest.yaml new file mode 100644 index 0000000000..0868dd9a33 --- /dev/null +++ b/.lib/git-fleximod/.github/workflows/pytest.yaml @@ -0,0 +1,77 @@ +# Run this job on pushes to `main`, and for pull requests. If you don't specify +# `branches: [main], then this actions runs _twice_ on pull requests, which is +# annoying. + +on: + push: + branches: [main] + pull_request: + branches: [main] + +jobs: + test: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + + # If you wanted to use multiple Python versions, you'd have specify a matrix in the job and + # reference the matrixe python version here. + - uses: actions/setup-python@v5 + with: + python-version: '3.9' + + # Cache the installation of Poetry itself, e.g. the next step. This prevents the workflow + # from installing Poetry every time, which can be slow. Note the use of the Poetry version + # number in the cache key, and the "-0" suffix: this allows you to invalidate the cache + # manually if/when you want to upgrade Poetry, or if something goes wrong. This could be + # mildly cleaner by using an environment variable, but I don't really care. + - name: cache poetry install + uses: actions/cache@v4 + with: + path: ~/.local + key: poetry-1.7.1 + + # Install Poetry. You could do this manually, or there are several actions that do this. + # `snok/install-poetry` seems to be minimal yet complete, and really just calls out to + # Poetry's default install script, which feels correct. I pin the Poetry version here + # because Poetry does occasionally change APIs between versions and I don't want my + # actions to break if it does. + # + # The key configuration value here is `virtualenvs-in-project: true`: this creates the + # venv as a `.venv` in your testing directory, which allows the next step to easily + # cache it. + - uses: snok/install-poetry@v1 + with: + version: 1.7.1 + virtualenvs-create: true + virtualenvs-in-project: true + + # Cache your dependencies (i.e. all the stuff in your `pyproject.toml`). Note the cache + # key: if you're using multiple Python versions, or multiple OSes, you'd need to include + # them in the cache key. I'm not, so it can be simple and just depend on the poetry.lock. + - name: cache deps + id: cache-deps + uses: actions/cache@v4 + with: + path: .venv + key: pydeps-${{ hashFiles('**/poetry.lock') }} + + # Install dependencies. `--no-root` means "install all dependencies but not the project + # itself", which is what you want to avoid caching _your_ code. The `if` statement + # ensures this only runs on a cache miss. + - run: poetry install --no-interaction --no-root + if: steps.cache-deps.outputs.cache-hit != 'true' + + # Now install _your_ project. This isn't necessary for many types of projects -- particularly + # things like Django apps don't need this. But it's a good idea since it fully-exercises the + # pyproject.toml and makes that if you add things like console-scripts at some point that + # they'll be installed and working. + - run: poetry install --no-interaction + + # And finally run tests. I'm using pytest and all my pytest config is in my `pyproject.toml` + # so this line is super-simple. But it could be as complex as you need. + - run: | + git config --global user.name "${GITHUB_ACTOR}" + git config --global user.email "${GITHUB_ACTOR_ID}+${GITHUB_ACTOR}@users.noreply.github.com" + poetry run pytest + diff --git a/.lib/git-fleximod/.pre-commit-config.yaml b/.lib/git-fleximod/.pre-commit-config.yaml new file mode 100644 index 0000000000..2f6089da72 --- /dev/null +++ b/.lib/git-fleximod/.pre-commit-config.yaml @@ -0,0 +1,18 @@ +exclude: ^utils/.*$ + +repos: + - repo: https://github.com/pre-commit/pre-commit-hooks + rev: v4.0.1 + hooks: + - id: end-of-file-fixer + - id: trailing-whitespace + - repo: https://github.com/psf/black + rev: 22.3.0 + hooks: + - id: black + - repo: https://github.com/PyCQA/pylint + rev: v2.11.1 + hooks: + - id: pylint + args: + - --disable=I,C,R,logging-not-lazy,wildcard-import,unused-wildcard-import,fixme,broad-except,bare-except,eval-used,exec-used,global-statement,logging-format-interpolation,no-name-in-module,arguments-renamed,unspecified-encoding,protected-access,import-error,no-member diff --git a/.lib/git-fleximod/CODE_OF_CONDUCT.md b/.lib/git-fleximod/CODE_OF_CONDUCT.md new file mode 100644 index 0000000000..84f2925bba --- /dev/null +++ b/.lib/git-fleximod/CODE_OF_CONDUCT.md @@ -0,0 +1,107 @@ +# Contributor Code of Conduct +_The Contributor Code of Conduct is for participants in our software projects and community._ + +## Our Pledge +We, as contributors, creators, stewards, and maintainers (participants), of **git-fleximod** pledge to make participation in +our software, system or hardware project and community a safe, productive, welcoming and inclusive experience for everyone. +All participants are required to abide by this Code of Conduct. +This includes respectful treatment of everyone regardless of age, body size, disability, ethnicity, gender identity or expression, +level of experience, nationality, political affiliation, veteran status, pregnancy, genetic information, physical appearance, race, +religion, or sexual orientation, as well as any other characteristic protected under applicable US federal or state law. + +## Our Standards +Examples of behaviors that contribute to a positive environment include: + +* All participants are treated with respect and consideration, valuing a diversity of views and opinions +* Be considerate, respectful, and collaborative +* Communicate openly with respect for others, critiquing ideas rather than individuals and gracefully accepting criticism +* Acknowledging the contributions of others +* Avoid personal attacks directed toward other participants +* Be mindful of your surroundings and of your fellow participants +* Alert UCAR staff and suppliers/vendors if you notice a dangerous situation or someone in distress +* Respect the rules and policies of the project and venue + +Examples of unacceptable behavior include, but are not limited to: + +* Harassment, intimidation, or discrimination in any form +* Physical, verbal, or written abuse by anyone to anyone, including repeated use of pronouns other than those requested +* Unwelcome sexual attention or advances +* Personal attacks directed at other guests, members, participants, etc. +* Publishing others' private information, such as a physical or electronic address, without explicit permission +* Alarming, intimidating, threatening, or hostile comments or conduct +* Inappropriate use of nudity and/or sexual images +* Threatening or stalking anyone, including a participant +* Other conduct which could reasonably be considered inappropriate in a professional setting + +## Scope +This Code of Conduct applies to all spaces managed by the Project whether they be physical, online or face-to-face. +This includes project code, code repository, associated web pages, documentation, mailing lists, project websites and wiki pages, +issue tracker, meetings, telecons, events, project social media accounts, and any other forums created by the project team which the +community uses for communication. +In addition, violations of this Code of Conduct outside these spaces may affect a person's ability to participate within them. +Representation of a project may be further defined and clarified by project maintainers. + +## Community Responsibilities +Everyone in the community is empowered to respond to people who are showing unacceptable behavior. +They can talk to them privately or publicly. +Anyone requested to stop unacceptable behavior is expected to comply immediately. +If the behavior continues concerns may be brought to the project administrators or to any other party listed in the +[Reporting](#reporting) section below. + +## Project Administrator Responsibilities +Project administrators are responsible for clarifying the standards of acceptable behavior and are encouraged to model appropriate +behavior and provide support when people in the community point out inappropriate behavior. +Project administrator(s) are normally the ones that would be tasked to carry out the actions in the [Consequences](#consequences) +section below. + +Project administrators are also expected to keep this Code of Conduct updated with the main one housed at UCAR, as listed below in +the [Attribution](#attribution) section. + +## Reporting +Instances of unacceptable behavior can be brought to the attention of the project administrator(s) who may take any action as +outlined in the [Consequences](#consequences) section below. +However, making a report to a project administrator is not considered an 'official report' to UCAR. + +Instances of unacceptable behavior may also be reported directly to UCAR pursuant to [UCAR's Harassment Reporting and Complaint +Procedure](https://www2.fin.ucar.edu/procedures/hr/harassment-reporting-and-complaint-procedure), or anonymously through [UCAR's +EthicsPoint Hotline](https://www2.fin.ucar.edu/ethics/anonymous-reporting). + +Complaints received by UCAR will be handled pursuant to the procedures outlined in UCAR's Harassment Reporting and Complaint +Procedure. +Complaints to UCAR will be held as confidential as practicable under the circumstances, and retaliation against a person who +initiates a complaint or an inquiry about inappropriate behavior will not be tolerated. + +Any Contributor can use these reporting methods even if they are not directly affiliated with UCAR. +The Frequently Asked Questions (FAQ) page for reporting is [here](https://www2.fin.ucar.edu/procedures/hr/reporting-faqs). + +## Consequences +Upon receipt of a complaint, the project administrator(s) may take any action deemed necessary and appropriate under the +circumstances. +Such action can include things such as: removing, editing, or rejecting comments, commits, code, wiki edits, email, issues, and +other contributions that are not aligned to this Code of Conduct, or banning temporarily or permanently any contributor for other +behaviors that are deemed inappropriate, threatening, offensive, or harmful. +Project administrators also have the right to report violations to UCAR HR and/or UCAR's Office of Diversity, Equity and Inclusion +(ODEI), as well as a participant's home institution and/or law enforcement. +In the event an incident is reported to UCAR, UCAR will follow its Harassment Reporting and Complaint Procedure. + +## Process for Changes +All UCAR managed projects are required to adopt this Contributor Code of Conduct. +Adoption is assumed even if not expressly stated in the repository. +Projects should fill in sections where prompted with project-specific information, including, project name and adoption date. + +Projects that adopt this Code of Conduct need to stay up to date with UCAR's Contributor Code of Conduct, linked with a DOI in the +[Attribution](#attribution) section below. +Projects can make limited substantive changes to the Code of Conduct, however, the changes must be limited in scope and may not +contradict the UCAR Contributor Code of Conduct. + +## Attribution +This Code of Conduct was originally adapted from the [Contributor Covenant](http://contributor-covenant.org/version/1/4), version +1.4. +We then aligned it with the UCAR Participant Code of Conduct, which also borrows from the American Geophysical Union (AGU) Code of +Conduct. +The UCAR Participant Code of Conduct applies to both UCAR employees as well as participants in activities run by UCAR. +The original version of this for all software projects that have strong management from UCAR or UCAR staff is available on the UCAR +website at https://doi.org/10.5065/6w2c-a132. +The date that it was adopted by this project was **Feb/13/2018**. +When responding to complaints, UCAR HR and ODEI will do so based on the latest published version. +Therefore, any project-specific changes should follow the [Process for Changes](#process-for-changes) section above. diff --git a/.lib/git-fleximod/License b/.lib/git-fleximod/License new file mode 100644 index 0000000000..88bc22515e --- /dev/null +++ b/.lib/git-fleximod/License @@ -0,0 +1,20 @@ +Copyright 2024 NSF National Center for Atmospheric Sciences (NCAR) + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +“Software”), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/.lib/git-fleximod/README.md b/.lib/git-fleximod/README.md new file mode 100644 index 0000000000..53917da400 --- /dev/null +++ b/.lib/git-fleximod/README.md @@ -0,0 +1,108 @@ +# git-fleximod + +Flexible, Enhanced Submodule Management for Git + +## Overview + +Git-fleximod is a Python-based tool that extends Git's submodule and sparse checkout capabilities, offering additional features for managing submodules in a more flexible and efficient way. + +## Installation + + If you choose to locate git-fleximod in your path you can access it via command: git fleximod + +## Usage + + Basic Usage: + git fleximod [options] + Available Commands: + status: Display the status of submodules. + update: Update submodules to the tag indicated in .gitmodules variable fxtag. + test: Make sure that fxtags and submodule hashes are consistant, + make sure that official urls (as defined by fxDONOTUSEurl) are set + make sure that fxtags are defined for all submodules + Additional Options: + See git fleximod --help for more details. + +## Supported .gitmodules Variables + + fxtag: Specify a specific tag or branch to checkout for a submodule. + fxrequired: Mark a submodule's checkout behavior, with allowed values: + - ToplevelRequired: Top-level and required (checked out only when this is the Toplevel module). + - ToplevelOptional: Top-level and optional (checked out with --optional flag if this is the Toplevel module). + - AlwaysRequired: Always required (always checked out). + - AlwaysOptional: Always optional (checked out with --optional flag). + fxsparse: Enable sparse checkout for a submodule, pointing to a file containing sparse checkout paths. + fxDONOTUSEurl: This is the url used in the test subcommand to assure that protected branches do not point to forks + **NOTE** the fxDONOTUSEurl variable is only used to identify the official project repository and should not be + changed by users. Use the url variable to change to a fork if desired. + +## Sparse Checkouts + + To enable sparse checkout for a submodule, set the fxsparse variable + in the .gitmodules file to the path of a file containing the desired + sparse checkout paths. Git-fleximod will automatically configure + sparse checkout based on this file when applicable commands are run. + See [git-sparse-checkout](https://git-scm.com/docs/git-sparse-checkout#_internalsfull_pattern_set) + for details on the format of this file. + +## Tests + + The git fleximod test action is designed to be used by, for example, github workflows + to assure that protected branches are consistant with respect to submodule hashes and fleximod fxtags + +## Examples + +Here are some common usage examples: + +Update all submodules, including optional ones: +```bash + git fleximod update --optional +``` + +Updating a specific submodule to the fxtag indicated in .gitmodules: + +```bash + git fleximod update submodule-name +``` +Example .gitmodules entry: +```ini, toml + [submodule "cosp2"] + path = src/physics/cosp2/src + url = https://github.com/CFMIP/COSPv2.0 + fxsparse = ../.cosp_sparse_checkout + fxrequired = AlwaysRequired + fxtag = v2.1.4cesm +``` +Explanation: + +This entry indicates that the submodule named cosp2 at tag v2.1.4cesm +should be checked out into the directory src/physics/cosp2/src +relative to the .gitmodules directory. It should be checked out from +the URL https://github.com/CFMIP/COSPv2.0 and use sparse checkout as +described in the file ../.cosp_sparse_checkout relative to the path +directory. It should be checked out anytime this .gitmodules entry is +read. + +Additional example: +```ini, toml + [submodule "cime"] + path = cime + url = https://github.com/jedwards4b/cime + fxrequired = ToplevelRequired + fxtag = cime6.0.198_rme01 +``` + +Explanation: + +This entry indicates that the submodule cime should be checked out +into a directory named cime at tag cime6.0.198_rme01 from the URL +https://github.com/jedwards4b/cime. This should only be done if +the .gitmodules file is at the top level of the repository clone. + +## Contributing + +We welcome contributions! Please see the CONTRIBUTING.md file for guidelines. + +## License + +Git-fleximod is released under the MIT License. diff --git a/.lib/git-fleximod/doc/Makefile b/.lib/git-fleximod/doc/Makefile new file mode 100644 index 0000000000..d4bb2cbb9e --- /dev/null +++ b/.lib/git-fleximod/doc/Makefile @@ -0,0 +1,20 @@ +# Minimal makefile for Sphinx documentation +# + +# You can set these variables from the command line, and also +# from the environment for the first two. +SPHINXOPTS ?= +SPHINXBUILD ?= sphinx-build +SOURCEDIR = . +BUILDDIR = _build + +# Put it first so that "make" without argument is like "make help". +help: + @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) + +.PHONY: help Makefile + +# Catch-all target: route all unknown targets to Sphinx using the new +# "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). +%: Makefile + @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) diff --git a/.lib/git-fleximod/doc/conf.py b/.lib/git-fleximod/doc/conf.py new file mode 100644 index 0000000000..423099eec9 --- /dev/null +++ b/.lib/git-fleximod/doc/conf.py @@ -0,0 +1,26 @@ +# Configuration file for the Sphinx documentation builder. +# +# For the full list of built-in configuration values, see the documentation: +# https://www.sphinx-doc.org/en/master/usage/configuration.html + +# -- Project information ----------------------------------------------------- +# https://www.sphinx-doc.org/en/master/usage/configuration.html#project-information + +project = "git-fleximod" +author = "Jim Edwards " +release = "0.4.0" + +# -- General configuration --------------------------------------------------- +# https://www.sphinx-doc.org/en/master/usage/configuration.html#general-configuration + +extensions = ["sphinx_argparse_cli"] + +templates_path = ["_templates"] +exclude_patterns = ["_build", "Thumbs.db", ".DS_Store"] + + +# -- Options for HTML output ------------------------------------------------- +# https://www.sphinx-doc.org/en/master/usage/configuration.html#options-for-html-output + +html_theme = "alabaster" +html_static_path = ["_static"] diff --git a/.lib/git-fleximod/doc/index.rst b/.lib/git-fleximod/doc/index.rst new file mode 100644 index 0000000000..0f9c1a7f7e --- /dev/null +++ b/.lib/git-fleximod/doc/index.rst @@ -0,0 +1,24 @@ +.. git-fleximod documentation master file, created by + sphinx-quickstart on Sat Feb 3 12:02:22 2024. + You can adapt this file completely to your liking, but it should at least + contain the root `toctree` directive. + +Welcome to git-fleximod's documentation! +======================================== + +.. toctree:: + :maxdepth: 2 + :caption: Contents: +.. module:: sphinxcontrib.autoprogram +.. sphinx_argparse_cli:: + :module: git_fleximod.cli + :func: get_parser + :prog: git-fleximod + + +Indices and tables +================== + +* :ref:`genindex` +* :ref:`modindex` +* :ref:`search` diff --git a/.lib/git-fleximod/doc/make.bat b/.lib/git-fleximod/doc/make.bat new file mode 100644 index 0000000000..32bb24529f --- /dev/null +++ b/.lib/git-fleximod/doc/make.bat @@ -0,0 +1,35 @@ +@ECHO OFF + +pushd %~dp0 + +REM Command file for Sphinx documentation + +if "%SPHINXBUILD%" == "" ( + set SPHINXBUILD=sphinx-build +) +set SOURCEDIR=. +set BUILDDIR=_build + +%SPHINXBUILD% >NUL 2>NUL +if errorlevel 9009 ( + echo. + echo.The 'sphinx-build' command was not found. Make sure you have Sphinx + echo.installed, then set the SPHINXBUILD environment variable to point + echo.to the full path of the 'sphinx-build' executable. Alternatively you + echo.may add the Sphinx directory to PATH. + echo. + echo.If you don't have Sphinx installed, grab it from + echo.https://www.sphinx-doc.org/ + exit /b 1 +) + +if "%1" == "" goto help + +%SPHINXBUILD% -M %1 %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% +goto end + +:help +%SPHINXBUILD% -M help %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% + +:end +popd diff --git a/.lib/git-fleximod/escomp_install b/.lib/git-fleximod/escomp_install new file mode 100644 index 0000000000..ae782e72a4 --- /dev/null +++ b/.lib/git-fleximod/escomp_install @@ -0,0 +1,25 @@ +#!/usr/bin/env python +# updates git-fleximod in an ESCOMP model +# this script should be run from the model root directory, it expects +# git-fleximod to already be installed with the script in bin +# and the classes in lib/python/site-packages +import sys +import shutil +import os + +from glob import iglob + +fleximod_root = sys.argv[1] +fleximod_path = os.path.join(fleximod_root,"src","git-fleximod") +if os.path.isfile(fleximod_path): + with open(fleximod_path,"r") as f: + fleximod = f.readlines() + with open(os.path.join(".","bin","git-fleximod"),"w") as f: + for line in fleximod: + f.write(line) + if "import argparse" in line: + f.write('\nsys.path.append(os.path.join(os.path.dirname(__file__),"..","lib","python","site-packages"))\n\n') + + for file in iglob(os.path.join(fleximod_root, "src", "fleximod", "*.py")): + shutil.copy(file, + os.path.join("lib","python","site-packages","fleximod",os.path.basename(file))) diff --git a/.lib/git-fleximod/git_fleximod/__init__.py b/.lib/git-fleximod/git_fleximod/__init__.py new file mode 100644 index 0000000000..e69de29bb2 diff --git a/.lib/git-fleximod/git_fleximod/cli.py b/.lib/git-fleximod/git_fleximod/cli.py new file mode 100644 index 0000000000..131466b9b5 --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/cli.py @@ -0,0 +1,133 @@ +from pathlib import Path +import argparse +from git_fleximod import utils + +__version__ = "0.9.4" + +def find_root_dir(filename=".gitmodules"): + """ finds the highest directory in tree + which contains a file called filename """ + try: + root = utils.execute_subprocess(["git","rev-parse", "--show-toplevel"], + output_to_caller=True ).rstrip() + except: + d = Path.cwd() + root = Path(d.root) + dirlist = [] + dl = d + while dl != root: + dirlist.append(dl) + dl = dl.parent + dirlist.append(root) + dirlist.reverse() + + for dl in dirlist: + attempt = dl / filename + if attempt.is_file(): + return str(dl) + return None + return Path(root) + +def get_parser(): + description = """ + %(prog)s manages checking out groups of gitsubmodules with additional support for Earth System Models + """ + parser = argparse.ArgumentParser( + description=description, formatter_class=argparse.RawDescriptionHelpFormatter + ) + + # + # user options + # + choices = ["update", "status", "test"] + parser.add_argument( + "action", + choices=choices, + default="update", + help=f"Subcommand of git-fleximod, choices are {choices[:-1]}", + ) + + parser.add_argument( + "components", + nargs="*", + help="Specific component(s) to checkout. By default, " + "all required submodules are checked out.", + ) + + parser.add_argument( + "-C", + "--path", + default=find_root_dir(), + help="Toplevel repository directory. Defaults to top git directory relative to current.", + ) + + parser.add_argument( + "-g", + "--gitmodules", + nargs="?", + default=".gitmodules", + help="The submodule description filename. " "Default: %(default)s.", + ) + + parser.add_argument( + "-x", + "--exclude", + nargs="*", + help="Component(s) listed in the gitmodules file which should be ignored.", + ) + parser.add_argument( + "-f", + "--force", + action="store_true", + default=False, + help="Override cautions and update or checkout over locally modified repository.", + ) + + parser.add_argument( + "-o", + "--optional", + action="store_true", + default=False, + help="By default only the required submodules " + "are checked out. This flag will also checkout the " + "optional submodules relative to the toplevel directory.", + ) + + parser.add_argument( + "-v", + "--verbose", + action="count", + default=0, + help="Output additional information to " + "the screen and log file. This flag can be " + "used up to two times, increasing the " + "verbosity level each time.", + ) + + parser.add_argument( + "-V", + "--version", + action="version", + version=f"%(prog)s {__version__}", + help="Print version and exit.", + ) + + # + # developer options + # + parser.add_argument( + "--backtrace", + action="store_true", + help="DEVELOPER: show exception backtraces as extra " "debugging output", + ) + + parser.add_argument( + "-d", + "--debug", + action="store_true", + default=False, + help="DEVELOPER: output additional debugging " + "information to the screen and log file.", + ) + + return parser diff --git a/.lib/git-fleximod/git_fleximod/git_fleximod.py b/.lib/git-fleximod/git_fleximod/git_fleximod.py new file mode 100755 index 0000000000..2c2601fa14 --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/git_fleximod.py @@ -0,0 +1,366 @@ +#!/usr/bin/env python +import sys + +MIN_PYTHON = (3, 7) +if sys.version_info < MIN_PYTHON: + sys.exit("Python %s.%s or later is required." % MIN_PYTHON) + +import os +import shutil +import logging +import textwrap +from git_fleximod import utils +from git_fleximod import cli +from git_fleximod.gitinterface import GitInterface +from git_fleximod.gitmodules import GitModules +from git_fleximod.submodule import Submodule + +# logger variable is global +logger = None + + +def fxrequired_allowed_values(): + return ["ToplevelRequired", "ToplevelOptional", "AlwaysRequired", "AlwaysOptional", "TopLevelRequired", "TopLevelOptional"] + + +def commandline_arguments(args=None): + parser = cli.get_parser() + + if args: + options = parser.parse_args(args) + else: + options = parser.parse_args() + + # explicitly listing a component overrides the optional flag + if options.optional or options.components: + fxrequired = fxrequired_allowed_values() + else: + fxrequired = ["ToplevelRequired", "AlwaysRequired", "TopLevelRequired"] + + action = options.action + if not action: + action = "update" + handlers = [logging.StreamHandler()] + + if options.debug: + try: + open("fleximod.log", "w") + except PermissionError: + sys.exit("ABORT: Could not write file fleximod.log") + level = logging.DEBUG + handlers.append(logging.FileHandler("fleximod.log")) + elif options.verbose: + level = logging.INFO + else: + level = logging.WARNING + # Configure the root logger + logging.basicConfig( + level=level, format="%(name)s - %(levelname)s - %(message)s", handlers=handlers + ) + + if hasattr(options, "version"): + exit() + + return ( + options.path, + options.gitmodules, + fxrequired, + options.components, + options.exclude, + options.force, + action, + ) + + +def submodule_sparse_checkout(root_dir, name, url, path, sparsefile, tag="master"): + """ + This function performs a sparse checkout of a git submodule. It does so by first creating the .git/info/sparse-checkout fileq + in the submodule and then checking out the desired tag. If the submodule is already checked out, it will not be checked out again. + Creating the sparse-checkout file first prevents the entire submodule from being checked out and then removed. This is important + because the submodule may have a large number of files and checking out the entire submodule and then removing it would be time + and disk space consuming. + + Parameters: + root_dir (str): The root directory for the git operation. + name (str): The name of the submodule. + url (str): The URL of the submodule. + path (str): The path to the submodule. + sparsefile (str): The sparse file for the submodule. + tag (str, optional): The tag to checkout. Defaults to "master". + + Returns: + None + """ + logger.info("Called sparse_checkout for {}".format(name)) + rgit = GitInterface(root_dir, logger) + superroot = git_toplevelroot(root_dir, logger) + + if superroot: + gitroot = superroot.strip() + else: + gitroot = root_dir.strip() + assert os.path.isdir(os.path.join(gitroot, ".git")) + # first create the module directory + if not os.path.isdir(os.path.join(root_dir, path)): + os.makedirs(os.path.join(root_dir, path)) + + # initialize a new git repo and set the sparse checkout flag + sprep_repo = os.path.join(root_dir, path) + sprepo_git = GitInterface(sprep_repo, logger) + if os.path.exists(os.path.join(sprep_repo, ".git")): + try: + logger.info("Submodule {} found".format(name)) + chk = sprepo_git.config_get_value("core", "sparseCheckout") + if chk == "true": + logger.info("Sparse submodule {} already checked out".format(name)) + return + except NoOptionError: + logger.debug("Sparse submodule {} not present".format(name)) + except Exception as e: + utils.fatal_error("Unexpected error {} occured.".format(e)) + + sprepo_git.config_set_value("core", "sparseCheckout", "true") + + # set the repository remote + + logger.info("Setting remote origin in {}/{}".format(root_dir, path)) + _, remotelist = sprepo_git.git_operation("remote", "-v") + if url not in remotelist: + sprepo_git.git_operation("remote", "add", "origin", url) + + topgit = os.path.join(gitroot, ".git") + + if gitroot != root_dir and os.path.isfile(os.path.join(root_dir, ".git")): + with open(os.path.join(root_dir, ".git")) as f: + gitpath = os.path.relpath( + os.path.join(root_dir, f.read().split()[1]), + start=os.path.join(root_dir, path), + ) + topgit = os.path.join(gitpath, "modules") + else: + topgit = os.path.relpath( + os.path.join(root_dir, ".git", "modules"), + start=os.path.join(root_dir, path), + ) + + with utils.pushd(sprep_repo): + if not os.path.isdir(topgit): + os.makedirs(topgit) + topgit += os.sep + name + + if os.path.isdir(os.path.join(root_dir, path, ".git")): + with utils.pushd(sprep_repo): + if os.path.isdir(os.path.join(topgit,".git")): + shutil.rmtree(os.path.join(topgit,".git")) + shutil.move(".git", topgit) + with open(".git", "w") as f: + f.write("gitdir: " + os.path.relpath(topgit)) + # assert(os.path.isdir(os.path.relpath(topgit, start=sprep_repo))) + gitsparse = os.path.abspath(os.path.join(topgit, "info", "sparse-checkout")) + if os.path.isfile(gitsparse): + logger.warning( + "submodule {} is already initialized {}".format(name, topgit) + ) + return + + with utils.pushd(sprep_repo): + if os.path.isfile(sparsefile): + shutil.copy(sparsefile, gitsparse) + + + # Finally checkout the repo + sprepo_git.git_operation("fetch", "origin", "--tags") + sprepo_git.git_operation("checkout", tag) + + print(f"Successfully checked out {name:>20} at {tag}") + rgit.config_set_value(f'submodule "{name}"', "active", "true") + rgit.config_set_value(f'submodule "{name}"', "url", url) + +def init_submodule_from_gitmodules(gitmodules, name, root_dir, logger): + path = gitmodules.get(name, "path") + url = gitmodules.get(name, "url") + assert path and url, f"Malformed .gitmodules file {path} {url}" + tag = gitmodules.get(name, "fxtag") + if not tag: + tag = gitmodules.get(name, "hash") + fxurl = gitmodules.get(name, "fxDONOTUSEurl") + fxsparse = gitmodules.get(name, "fxsparse") + fxrequired = gitmodules.get(name, "fxrequired") + return Submodule(root_dir, name, path, url, fxtag=tag, fxurl=fxurl, fxsparse=fxsparse, fxrequired=fxrequired, logger=logger) + +def submodules_status(gitmodules, root_dir, toplevel=False, depth=0): + testfails = 0 + localmods = 0 + needsupdate = 0 + wrapper = textwrap.TextWrapper(initial_indent=' '*(depth*10), width=120,subsequent_indent=' '*(depth*20)) + for name in gitmodules.sections(): + submod = init_submodule_from_gitmodules(gitmodules, name, root_dir, logger) + + result,n,l,t = submod.status() + if toplevel or not submod.toplevel(): + print(wrapper.fill(result)) + testfails += t + localmods += l + needsupdate += n + subdir = os.path.join(root_dir, submod.path) + if os.path.exists(os.path.join(subdir, ".gitmodules")): + gsubmod = GitModules(logger, confpath=subdir) + t,l,n = submodules_status(gsubmod, subdir, depth=depth+1) + if toplevel or not submod.toplevel(): + testfails += t + localmods += l + needsupdate += n + + return testfails, localmods, needsupdate + +def git_toplevelroot(root_dir, logger): + rgit = GitInterface(root_dir, logger) + _, superroot = rgit.git_operation("rev-parse", "--show-superproject-working-tree") + return superroot + +def submodules_update(gitmodules, root_dir, requiredlist, force): + for name in gitmodules.sections(): + submod = init_submodule_from_gitmodules(gitmodules, name, root_dir, logger) + + _, needsupdate, localmods, testfails = submod.status() + if not submod.fxrequired: + submod.fxrequired = "AlwaysRequired" + fxrequired = submod.fxrequired + allowedvalues = fxrequired_allowed_values() + assert fxrequired in allowedvalues + + superroot = git_toplevelroot(root_dir, logger) + + if ( + fxrequired + and ((superroot and "Toplevel" in fxrequired) + or fxrequired not in requiredlist) + ): + if "Optional" in fxrequired and "Optional" not in requiredlist: + if fxrequired.startswith("Always"): + print(f"Skipping optional component {name:>20}") + continue + optional = "AlwaysOptional" in requiredlist + + if fxrequired in requiredlist: + submod.update() + repodir = os.path.join(root_dir, submod.path) + if os.path.exists(os.path.join(repodir, ".gitmodules")): + # recursively handle this checkout + print(f"Recursively checking out submodules of {name}") + gitsubmodules = GitModules(submod.logger, confpath=repodir) + newrequiredlist = ["AlwaysRequired"] + if optional: + newrequiredlist.append("AlwaysOptional") + submodules_update(gitsubmodules, repodir, newrequiredlist, force=force) + +def local_mods_output(): + text = """\ + The submodules labeled with 'M' above are not in a clean state. + The following are options for how to proceed: + (1) Go into each submodule which is not in a clean state and issue a 'git status' + Either revert or commit your changes so that the submodule is in a clean state. + (2) use the --force option to git-fleximod + (3) you can name the particular submodules to update using the git-fleximod command line + (4) As a last resort you can remove the submodule (via 'rm -fr [directory]') + then rerun git-fleximod update. +""" + print(text) + +def submodules_test(gitmodules, root_dir): + """ + This function tests the git submodules based on the provided parameters. + + It first checks that fxtags are present and in sync with submodule hashes. + Then it ensures that urls are consistent with fxurls (not forks and not ssh) + and that sparse checkout files exist. + + Parameters: + gitmodules (ConfigParser): The gitmodules configuration. + root_dir (str): The root directory for the git operation. + + Returns: + int: The number of test failures. + """ + # First check that fxtags are present and in sync with submodule hashes + testfails, localmods, needsupdate = submodules_status(gitmodules, root_dir) + print("") + # Then make sure that urls are consistant with fxurls (not forks and not ssh) + # and that sparse checkout files exist + for name in gitmodules.sections(): + url = gitmodules.get(name, "url") + fxurl = gitmodules.get(name, "fxDONOTUSEurl") + fxsparse = gitmodules.get(name, "fxsparse") + path = gitmodules.get(name, "path") + fxurl = fxurl[:-4] if fxurl.endswith(".git") else fxurl + url = url[:-4] if url.endswith(".git") else url + if not fxurl or url.lower() != fxurl.lower(): + print(f"{name:>20} url {url} not in sync with required {fxurl}") + testfails += 1 + if fxsparse and not os.path.isfile(os.path.join(root_dir, path, fxsparse)): + print(f"{name:>20} sparse checkout file {fxsparse} not found") + testfails += 1 + return testfails + localmods + needsupdate + + +def main(): + ( + root_dir, + file_name, + fxrequired, + includelist, + excludelist, + force, + action, + ) = commandline_arguments() + # Get a logger for the package + global logger + logger = logging.getLogger(__name__) + + logger.info("action is {} root_dir={} file_name={}".format(action, root_dir, file_name)) + + if not root_dir or not os.path.isfile(os.path.join(root_dir, file_name)): + if root_dir: + file_path = utils.find_upwards(root_dir, file_name) + + if root_dir is None or file_path is None: + root_dir = "." + utils.fatal_error( + "No {} found in {} or any of it's parents".format(file_name, root_dir) + ) + + root_dir = os.path.dirname(file_path) + logger.info( + "root_dir is {} includelist={} excludelist={}".format( + root_dir, includelist, excludelist + ) + ) + gitmodules = GitModules( + logger, + confpath=root_dir, + conffile=file_name, + includelist=includelist, + excludelist=excludelist, + ) + if not gitmodules.sections(): + sys.exit(f"No submodule components found, root_dir={root_dir}") + retval = 0 + if action == "update": + submodules_update(gitmodules, root_dir, fxrequired, force) + elif action == "status": + tfails, lmods, updates = submodules_status(gitmodules, root_dir, toplevel=True) + if tfails + lmods + updates > 0: + print( + f" testfails = {tfails}, local mods = {lmods}, needs updates {updates}\n" + ) + if lmods > 0: + local_mods_output() + elif action == "test": + retval = submodules_test(gitmodules, root_dir) + else: + utils.fatal_error(f"unrecognized action request {action}") + return retval + + +if __name__ == "__main__": + sys.exit(main()) diff --git a/.lib/git-fleximod/git_fleximod/gitinterface.py b/.lib/git-fleximod/git_fleximod/gitinterface.py new file mode 100644 index 0000000000..fb20883cd0 --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/gitinterface.py @@ -0,0 +1,92 @@ +import os +import sys +from . import utils +from pathlib import Path + +class GitInterface: + def __init__(self, repo_path, logger): + logger.debug("Initialize GitInterface for {}".format(repo_path)) + if isinstance(repo_path, str): + self.repo_path = Path(repo_path).resolve() + elif isinstance(repo_path, Path): + self.repo_path = repo_path.resolve() + else: + raise TypeError("repo_path must be a str or Path object") + self.logger = logger + try: + import git + + self._use_module = True + try: + self.repo = git.Repo(str(self.repo_path)) # Initialize GitPython repo + except git.exc.InvalidGitRepositoryError: + self.git = git + self._init_git_repo() + msg = "Using GitPython interface to git" + except ImportError: + self._use_module = False + if not (self.repo_path / ".git").exists(): + self._init_git_repo() + msg = "Using shell interface to git" + self.logger.info(msg) + + def _git_command(self, operation, *args): + self.logger.info(operation) + if self._use_module and operation != "submodule": + try: + return getattr(self.repo.git, operation)(*args) + except Exception as e: + sys.exit(e) + else: + return ["git", "-C", str(self.repo_path), operation] + list(args) + + def _init_git_repo(self): + if self._use_module: + self.repo = self.git.Repo.init(str(self.repo_path)) + else: + command = ("git", "-C", str(self.repo_path), "init") + utils.execute_subprocess(command) + + # pylint: disable=unused-argument + def git_operation(self, operation, *args, **kwargs): + newargs = [] + for a in args: + # Do not use ssh interface + if isinstance(a, str): + a = a.replace("git@github.com:", "https://github.com/") + newargs.append(a) + + command = self._git_command(operation, *newargs) + if isinstance(command, list): + try: + status, output = utils.execute_subprocess(command, status_to_caller=True, output_to_caller=True) + return status, output.rstrip() + except Exception as e: + sys.exit(e) + else: + return 0, command + + def config_get_value(self, section, name): + if self._use_module: + config = self.repo.config_reader() + try: + val = config.get_value(section, name) + except: + val = None + return val + else: + cmd = ("git", "-C", str(self.repo_path), "config", "--get", f"{section}.{name}") + output = utils.execute_subprocess(cmd, output_to_caller=True) + return output.strip() + + def config_set_value(self, section, name, value): + if self._use_module: + with self.repo.config_writer() as writer: + if "." in section: + section = section.replace("."," \"")+'"' + writer.set_value(section, name, value) + writer.release() # Ensure changes are saved + else: + cmd = ("git", "-C", str(self.repo_path), "config", f"{section}.{name}", value) + self.logger.info(cmd) + utils.execute_subprocess(cmd, output_to_caller=True) diff --git a/.lib/git-fleximod/git_fleximod/gitmodules.py b/.lib/git-fleximod/git_fleximod/gitmodules.py new file mode 100644 index 0000000000..cf8b350dd6 --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/gitmodules.py @@ -0,0 +1,97 @@ +import shutil, os +from pathlib import Path +from configparser import RawConfigParser, ConfigParser +from .lstripreader import LstripReader + + +class GitModules(RawConfigParser): + def __init__( + self, + logger, + confpath=Path.cwd(), + conffile=".gitmodules", + includelist=None, + excludelist=None, + ): + """ + confpath: Path to the directory containing the .gitmodules file (defaults to the current working directory). + conffile: Name of the configuration file (defaults to .gitmodules). + includelist: Optional list of submodules to include. + excludelist: Optional list of submodules to exclude. + """ + self.logger = logger + self.logger.debug( + "Creating a GitModules object {} {} {} {}".format( + confpath, conffile, includelist, excludelist + ) + ) + super().__init__() + self.conf_file = (Path(confpath) / Path(conffile)) + if self.conf_file.exists(): + self.read_file(LstripReader(str(self.conf_file)), source=conffile) + self.includelist = includelist + self.excludelist = excludelist + self.isdirty = False + + def reload(self): + self.clear() + if self.conf_file.exists(): + self.read_file(LstripReader(str(self.conf_file)), source=self.conf_file) + + + def set(self, name, option, value): + """ + Sets a configuration value for a specific submodule: + Ensures the appropriate section exists for the submodule. + Calls the parent class's set method to store the value. + """ + self.isdirty = True + self.logger.debug("set called {} {} {}".format(name, option, value)) + section = f'submodule "{name}"' + if not self.has_section(section): + self.add_section(section) + super().set(section, option, str(value)) + + # pylint: disable=redefined-builtin, arguments-differ + def get(self, name, option, raw=False, vars=None, fallback=None): + """ + Retrieves a configuration value for a specific submodule: + Uses the parent class's get method to access the value. + Handles potential errors if the section or option doesn't exist. + """ + self.logger.debug("git get called {} {}".format(name, option)) + section = f'submodule "{name}"' + try: + return ConfigParser.get( + self, section, option, raw=raw, vars=vars, fallback=fallback + ) + except ConfigParser.NoOptionError: + return None + + def save(self): + if self.isdirty: + self.logger.info("Writing {}".format(self.conf_file)) + with open(self.conf_file, "w") as fd: + self.write(fd) + self.isdirty = False + + def __del__(self): + self.save() + + def sections(self): + """Strip the submodule part out of section and just use the name""" + self.logger.debug("calling GitModules sections iterator") + names = [] + for section in ConfigParser.sections(self): + name = section[11:-1] + if self.includelist and name not in self.includelist: + continue + if self.excludelist and name in self.excludelist: + continue + names.append(name) + return names + + def items(self, name, raw=False, vars=None): + self.logger.debug("calling GitModules items for {}".format(name)) + section = f'submodule "{name}"' + return ConfigParser.items(section, raw=raw, vars=vars) diff --git a/.lib/git-fleximod/git_fleximod/lstripreader.py b/.lib/git-fleximod/git_fleximod/lstripreader.py new file mode 100644 index 0000000000..01d5580ee8 --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/lstripreader.py @@ -0,0 +1,43 @@ +class LstripReader(object): + "LstripReader formats .gitmodules files to be acceptable for configparser" + + def __init__(self, filename): + with open(filename, "r") as infile: + lines = infile.readlines() + self._lines = list() + self._num_lines = len(lines) + self._index = 0 + for line in lines: + self._lines.append(line.lstrip()) + + def readlines(self): + """Return all the lines from this object's file""" + return self._lines + + def readline(self, size=-1): + """Format and return the next line or raise StopIteration""" + try: + line = self.next() + except StopIteration: + line = "" + + if (size > 0) and (len(line) < size): + return line[0:size] + + return line + + def __iter__(self): + """Begin an iteration""" + self._index = 0 + return self + + def next(self): + """Return the next line or raise StopIteration""" + if self._index >= self._num_lines: + raise StopIteration + + self._index = self._index + 1 + return self._lines[self._index - 1] + + def __next__(self): + return self.next() diff --git a/.lib/git-fleximod/git_fleximod/metoflexi.py b/.lib/git-fleximod/git_fleximod/metoflexi.py new file mode 100755 index 0000000000..cc347db2dd --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/metoflexi.py @@ -0,0 +1,236 @@ +#!/usr/bin/env python +from configparser import ConfigParser +import sys +import shutil +from pathlib import Path +import argparse +import logging +from git_fleximod.gitinterface import GitInterface +from git_fleximod.gitmodules import GitModules +from git_fleximod import utils + +logger = None + +def find_root_dir(filename=".git"): + d = Path.cwd() + root = Path(d.root) + while d != root: + attempt = d / filename + if attempt.is_dir(): + return d + d = d.parent + return None + + +def get_parser(): + description = """ + %(prog)s manages checking out groups of gitsubmodules with addtional support for Earth System Models + """ + parser = argparse.ArgumentParser( + description=description, formatter_class=argparse.RawDescriptionHelpFormatter + ) + + parser.add_argument('-e', '--externals', nargs='?', + default='Externals.cfg', + help='The externals description filename. ' + 'Default: %(default)s.') + + parser.add_argument( + "-C", + "--path", + default=find_root_dir(), + help="Toplevel repository directory. Defaults to top git directory relative to current.", + ) + + parser.add_argument( + "-g", + "--gitmodules", + nargs="?", + default=".gitmodules", + help="The submodule description filename. " "Default: %(default)s.", + ) + parser.add_argument( + "-v", + "--verbose", + action="count", + default=0, + help="Output additional information to " + "the screen and log file. This flag can be " + "used up to two times, increasing the " + "verbosity level each time.", + ) + parser.add_argument( + "-d", + "--debug", + action="store_true", + default=False, + help="DEVELOPER: output additional debugging " + "information to the screen and log file.", + ) + + return parser + +def commandline_arguments(args=None): + parser = get_parser() + + options = parser.parse_args(args) + handlers = [logging.StreamHandler()] + + if options.debug: + try: + open("fleximod.log", "w") + except PermissionError: + sys.exit("ABORT: Could not write file fleximod.log") + level = logging.DEBUG + handlers.append(logging.FileHandler("fleximod.log")) + elif options.verbose: + level = logging.INFO + else: + level = logging.WARNING + # Configure the root logger + logging.basicConfig( + level=level, format="%(name)s - %(levelname)s - %(message)s", handlers=handlers + ) + + return( + options.path, + options.gitmodules, + options.externals + ) + +class ExternalRepoTranslator: + """ + Translates external repositories configured in an INI-style externals file. + """ + + def __init__(self, rootpath, gitmodules, externals): + self.rootpath = rootpath + if gitmodules: + self.gitmodules = GitModules(logger, confpath=rootpath) + self.externals = (rootpath / Path(externals)).resolve() + print(f"Translating {self.externals}") + self.git = GitInterface(rootpath, logger) + +# def __del__(self): +# if (self.rootpath / "save.gitignore"): + + + def translate_single_repo(self, section, tag, url, path, efile, hash_, sparse, protocol): + """ + Translates a single repository based on configuration details. + + Args: + rootpath (str): Root path of the main repository. + gitmodules (str): Path to the .gitmodules file. + tag (str): The tag to use for the external repository. + url (str): The URL of the external repository. + path (str): The relative path within the main repository for the external repository. + efile (str): The external file or file containing submodules. + hash_ (str): The commit hash to checkout (if applicable). + sparse (str): Boolean indicating whether to use sparse checkout (if applicable). + protocol (str): The protocol to use (e.g., 'git', 'http'). + """ + assert protocol != "svn", "SVN protocol is not currently supported" + print(f"Translating repository {section}") + if efile: + file_path = Path(path) / Path(efile) + newroot = (self.rootpath / file_path).parent.resolve() + if not newroot.exists(): + newroot.mkdir(parents=True) + logger.info("Newroot is {}".format(newroot)) + newt = ExternalRepoTranslator(newroot, ".gitmodules", efile) + newt.translate_repo() + if protocol == "externals_only": + if tag: + self.gitmodules.set(section, "fxtag", tag) + if hash_: + self.gitmodules.set(section, "fxtag", hash_) + + self.gitmodules.set(section, "fxDONOTUSEurl", url) + if sparse: + self.gitmodules.set(section, "fxsparse", sparse) + self.gitmodules.set(section, "fxrequired", "ToplevelRequired") + else: + newpath = (self.rootpath / Path(path)) + if newpath.exists(): + shutil.rmtree(newpath) + logger.info("Creating directory {}".format(newpath)) + newpath.mkdir(parents=True) + if tag: + logger.info("cloning {}".format(section)) + try: + self.git.git_operation("clone", "-b", tag, "--depth", "1", url, path) + except: + self.git.git_operation("clone", url, path) + with utils.pushd(newpath): + ngit = GitInterface(newpath, logger) + ngit.git_operation("checkout", tag) + if hash_: + self.git.git_operation("clone", url, path) + git = GitInterface(newpath, logger) + git.git_operation("fetch", "origin") + git.git_operation("checkout", hash_) + if sparse: + print("setting as sparse submodule {}".format(section)) + sparsefile = (newpath / Path(sparse)) + newfile = (newpath / ".git" / "info" / "sparse-checkout") + print(f"sparsefile {sparsefile} newfile {newfile}") + shutil.copy(sparsefile, newfile) + + logger.info("adding submodule {}".format(section)) + self.gitmodules.save() + self.git.git_operation("submodule", "add", "-f", "--name", section, url, path) + self.git.git_operation("submodule","absorbgitdirs") + self.gitmodules.reload() + if tag: + self.gitmodules.set(section, "fxtag", tag) + if hash_: + self.gitmodules.set(section, "fxtag", hash_) + + self.gitmodules.set(section, "fxDONOTUSEurl", url) + if sparse: + self.gitmodules.set(section, "fxsparse", sparse) + self.gitmodules.set(section, "fxrequired", "ToplevelRequired") + + + def translate_repo(self): + """ + Translates external repositories defined within an external file. + + Args: + rootpath (str): Root path of the main repository. + gitmodules (str): Path to the .gitmodules file. + external_file (str): The path to the external file containing repository definitions. + """ + econfig = ConfigParser() + econfig.read((self.rootpath / Path(self.externals))) + + for section in econfig.sections(): + if section == "externals_description": + logger.info("skipping section {}".format(section)) + return + logger.info("Translating section {}".format(section)) + tag = econfig.get(section, "tag", raw=False, fallback=None) + url = econfig.get(section, "repo_url", raw=False, fallback=None) + path = econfig.get(section, "local_path", raw=False, fallback=None) + efile = econfig.get(section, "externals", raw=False, fallback=None) + hash_ = econfig.get(section, "hash", raw=False, fallback=None) + sparse = econfig.get(section, "sparse", raw=False, fallback=None) + protocol = econfig.get(section, "protocol", raw=False, fallback=None) + + self.translate_single_repo(section, tag, url, path, efile, hash_, sparse, protocol) + + + +def _main(): + rootpath, gitmodules, externals = commandline_arguments() + global logger + logger = logging.getLogger(__name__) + with utils.pushd(rootpath): + t = ExternalRepoTranslator(Path(rootpath), gitmodules, externals) + logger.info("Translating {}".format(rootpath)) + t.translate_repo() + + +if __name__ == "__main__": + sys.exit(_main()) diff --git a/.lib/git-fleximod/git_fleximod/submodule.py b/.lib/git-fleximod/git_fleximod/submodule.py new file mode 100644 index 0000000000..75d9dd4eb9 --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/submodule.py @@ -0,0 +1,427 @@ +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 + status, tags = rootgit.git_operation("ls-remote", "--tags", self.url) + status, result = rootgit.git_operation("submodule","status",smpath) + result = result.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: + status, ahash = rootgit.git_operation( + "submodule", "status", "{}".format(self.path) + ) + 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) + status, remote = git.git_operation("remote") + if remote == '': + result = f"e {self.name:>20} has no associated remote" + testfails = True + needsupdate = True + return result, needsupdate, localmods, testfails + status, rurl = git.git_operation("ls-remote","--get-url") + status, lines = git.git_operation("log", "--pretty=format:\"%h %d\"") + line = lines.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") + # 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, output = git.git_operation("status", "--ignore-submodules", "-uno") + if "nothing to commit" not in output: + localmods = True + result = "M" + textwrap.indent(output, " ") +# 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. + """ + status, remotes = git.git_operation("remote", "-v") + remotes = remotes.splitlines() + upstream = None + if remotes: + status, upstream = git.git_operation("ls-remote", "--get-url") + 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) + status, superroot = rgit.git_operation("rev-parse", "--show-superproject-working-tree") + if superroot: + gitroot = superroot.strip() + else: + gitroot = self.root_dir + # Now need to move the .git dir to the submodule location + rootdotgit = os.path.join(self.root_dir, ".git") + while os.path.isfile(rootdotgit): + with open(rootdotgit) as f: + line = f.readline().rstrip() + if line.startswith("gitdir: "): + rootdotgit = os.path.abspath(os.path.join(self.root_dir,line[8:])) + assert os.path.isdir(rootdotgit) + # 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, remotes = sprepo_git.git_operation("remote", "-v") + if self.url not in remotes: + 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), + ) + rootdotgit = os.path.join(gitpath, "modules", self.name) + else: + rootdotgit = os.path.relpath( + os.path.join(self.root_dir, ".git", "modules", self.name), + start=os.path.join(self.root_dir, self.path), + ) + + 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(rootdotgit,".git")): + shutil.rmtree(os.path.join(rootdotgit,".git")) + shutil.move(".git", rootdotgit) + with open(".git", "w") as f: + f.write("gitdir: " + os.path.relpath(rootdotgit)) + infodir = os.path.join(rootdotgit, "info") + if not os.path.isdir(infodir): + os.makedirs(infodir) + gitsparse = os.path.abspath(os.path.join(infodir, "sparse-checkout")) + if os.path.isfile(gitsparse): + self.logger.warning( + "submodule {} is already initialized {}".format(self.name, rootdotgit) + ) + 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") + status,_ = sprepo_git.git_operation("checkout", self.fxtag) + if status: + print(f"Error checking out {self.name:>20} at {self.fxtag}") + else: + print(f"Successfully checked out {self.name:>20} at {self.fxtag}") + rgit.config_set_value('submodule.' + self.name, "active", "true") + rgit.config_set_value('submodule.' + self.name, "url", self.url) + rgit.config_set_value('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: + status, tag = smgit.git_operation("describe", "--tags", "--always") + 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:] + + 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) + status, tags = git.git_operation("tag", "-l") + fxtag = self.fxtag + if fxtag and fxtag not in tags: + git.git_operation("fetch", newremote, "--tags") + status, atag = git.git_operation("describe", "--tags", "--always") + if fxtag and fxtag != atag: + try: + status, _ = git.git_operation("checkout", fxtag) + if not status: + 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 new file mode 100644 index 0000000000..c4f43d5238 --- /dev/null +++ b/.lib/git-fleximod/git_fleximod/utils.py @@ -0,0 +1,365 @@ +#!/usr/bin/env python3 +""" +Common public utilities for manic package + +""" + +import logging +import os +import subprocess +import sys +from threading import Timer +from pathlib import Path + +LOCAL_PATH_INDICATOR = "." +# --------------------------------------------------------------------- +# +# functions to massage text for output and other useful utilities +# +# --------------------------------------------------------------------- +from contextlib import contextmanager + + +@contextmanager +def pushd(new_dir): + """context for chdir. usage: with pushd(new_dir)""" + previous_dir = os.getcwd() + os.chdir(new_dir) + try: + yield + finally: + os.chdir(previous_dir) + + +def log_process_output(output): + """Log each line of process output at debug level so it can be + filtered if necessary. By default, output is a single string, and + logging.debug(output) will only put log info heading on the first + line. This makes it hard to filter with grep. + + """ + output = output.split("\n") + for line in output: + logging.debug(line) + + +def printlog(msg, **kwargs): + """Wrapper script around print to ensure that everything printed to + the screen also gets logged. + + """ + logging.info(msg) + if kwargs: + print(msg, **kwargs) + else: + print(msg) + sys.stdout.flush() + + +def find_upwards(root_dir, filename): + """Find a file in root dir or any of it's parents""" + d = Path(root_dir) + root = Path(d.root) + while d != root: + attempt = d / filename + if attempt.exists(): + return attempt + d = d.parent + return None + + +def last_n_lines(the_string, n_lines, truncation_message=None): + """Returns the last n lines of the given string + + Args: + the_string: str + n_lines: int + truncation_message: str, optional + + Returns a string containing the last n lines of the_string + + If truncation_message is provided, the returned string begins with + the given message if and only if the string is greater than n lines + to begin with. + """ + + lines = the_string.splitlines(True) + if len(lines) <= n_lines: + return_val = the_string + else: + lines_subset = lines[-n_lines:] + str_truncated = "".join(lines_subset) + if truncation_message: + str_truncated = truncation_message + "\n" + str_truncated + return_val = str_truncated + + return return_val + + +def indent_string(the_string, indent_level): + """Indents the given string by a given number of spaces + + Args: + the_string: str + indent_level: int + + Returns a new string that is the same as the_string, except that + each line is indented by 'indent_level' spaces. + + In python3, this can be done with textwrap.indent. + """ + + lines = the_string.splitlines(True) + padding = " " * indent_level + lines_indented = [padding + line for line in lines] + return "".join(lines_indented) + + +# --------------------------------------------------------------------- +# +# error handling +# +# --------------------------------------------------------------------- + + +def fatal_error(message): + """ + Error output function + """ + logging.error(message) + raise RuntimeError("{0}ERROR: {1}".format(os.linesep, message)) + + +# --------------------------------------------------------------------- +# +# Data conversion / manipulation +# +# --------------------------------------------------------------------- +def str_to_bool(bool_str): + """Convert a sting representation of as boolean into a true boolean. + + Conversion should be case insensitive. + """ + value = None + str_lower = bool_str.lower() + if str_lower in ("true", "t"): + value = True + elif str_lower in ("false", "f"): + value = False + if value is None: + msg = ( + 'ERROR: invalid boolean string value "{0}". ' + 'Must be "true" or "false"'.format(bool_str) + ) + fatal_error(msg) + return value + + +REMOTE_PREFIXES = ["http://", "https://", "ssh://", "git@"] + + +def is_remote_url(url): + """check if the user provided a local file path instead of a + remote. If so, it must be expanded to an absolute + path. + + """ + remote_url = False + for prefix in REMOTE_PREFIXES: + if url.startswith(prefix): + remote_url = True + return remote_url + + +def split_remote_url(url): + """check if the user provided a local file path or a + remote. If remote, try to strip off protocol info. + + """ + remote_url = is_remote_url(url) + if not remote_url: + return url + + for prefix in REMOTE_PREFIXES: + url = url.replace(prefix, "") + + if "@" in url: + url = url.split("@")[1] + + if ":" in url: + url = url.split(":")[1] + + return url + + +def expand_local_url(url, field): + """check if the user provided a local file path instead of a + remote. If so, it must be expanded to an absolute + path. + + Note: local paths of LOCAL_PATH_INDICATOR have special meaning and + represent local copy only, don't work with the remotes. + + """ + remote_url = is_remote_url(url) + if not remote_url: + if url.strip() == LOCAL_PATH_INDICATOR: + pass + else: + url = os.path.expandvars(url) + url = os.path.expanduser(url) + if not os.path.isabs(url): + msg = ( + 'WARNING: Externals description for "{0}" contains a ' + "url that is not remote and does not expand to an " + "absolute path. Version control operations may " + "fail.\n\nurl={1}".format(field, url) + ) + printlog(msg) + else: + url = os.path.normpath(url) + return url + + +# --------------------------------------------------------------------- +# +# subprocess +# +# --------------------------------------------------------------------- + +# Give the user a helpful message if we detect that a command seems to +# be hanging. +_HANGING_SEC = 300 + + +def _hanging_msg(working_directory, command): + print( + """ + +Command '{command}' +from directory {working_directory} +has taken {hanging_sec} seconds. It may be hanging. + +The command will continue to run, but you may want to abort +git-fleximod with ^C and investigate. A possible cause of hangs is git +requires authentication to access a private repository. On some +systems, git requests for authentication information will not +be displayed to the user. In this case, the program will appear to +hang. Ensure you can run git manually and access all +repositories without entering your authentication information. + +""".format( + command=command, + working_directory=working_directory, + hanging_sec=_HANGING_SEC, + ) + ) + + +def execute_subprocess(commands, status_to_caller=False, output_to_caller=False): + """Wrapper around subprocess.check_output to handle common + exceptions. + + check_output runs a command with arguments and waits + for it to complete. + + check_output raises an exception on a nonzero return code. if + status_to_caller is true, execute_subprocess returns the subprocess + return code, otherwise execute_subprocess treats non-zero return + status as an error and raises an exception. + + """ + cwd = os.getcwd() + msg = "In directory: {0}\nexecute_subprocess running command:".format(cwd) + logging.info(msg) + commands_str = " ".join(str(element) for element in commands) + logging.info(commands_str) + return_to_caller = status_to_caller or output_to_caller + status = -1 + output = "" + hanging_timer = Timer( + _HANGING_SEC, + _hanging_msg, + kwargs={"working_directory": cwd, "command": commands_str}, + ) + hanging_timer.start() + try: + output = subprocess.check_output( + commands, stderr=subprocess.STDOUT, universal_newlines=True + ) + log_process_output(output) + status = 0 + except OSError as error: + msg = failed_command_msg( + "Command execution failed. Does the executable exist?", commands + ) + logging.error(error) + fatal_error(msg) + except ValueError as error: + msg = failed_command_msg( + "DEV_ERROR: Invalid arguments trying to run subprocess", commands + ) + logging.error(error) + fatal_error(msg) + except subprocess.CalledProcessError as error: + # Only report the error if we are NOT returning to the + # caller. If we are returning to the caller, then it may be a + # simple status check. If returning, it is the callers + # responsibility determine if an error occurred and handle it + # appropriately. + msg_context = ( + "Process did not run successfully; " + "returned status {0}".format(error.returncode) + ) + msg = failed_command_msg(msg_context, commands, output=error.output) + if not return_to_caller: + logging.error(error) + logging.error(msg) + log_process_output(error.output) + fatal_error(msg) + status = error.returncode + finally: + hanging_timer.cancel() + + if status_to_caller and output_to_caller: + ret_value = (status, output) + elif status_to_caller: + ret_value = status + elif output_to_caller: + ret_value = output + else: + ret_value = None + + return ret_value + + +def failed_command_msg(msg_context, command, output=None): + """Template for consistent error messages from subprocess calls. + + If 'output' is given, it should provide the output from the failed + command + """ + + if output: + output_truncated = last_n_lines( + output, 20, truncation_message="[... Output truncated for brevity ...]" + ) + errmsg = ( + "Failed with output:\n" + indent_string(output_truncated, 4) + "\nERROR: " + ) + else: + errmsg = "" + + command_str = " ".join(command) + errmsg += """In directory + {cwd} +{context}: + {command} +""".format( + cwd=os.getcwd(), context=msg_context, command=command_str + ) + + if output: + errmsg += "See above for output from failed command.\n" + + return errmsg diff --git a/.lib/git-fleximod/poetry.lock b/.lib/git-fleximod/poetry.lock new file mode 100644 index 0000000000..ac82fb0d97 --- /dev/null +++ b/.lib/git-fleximod/poetry.lock @@ -0,0 +1,693 @@ +# This file is automatically @generated by Poetry 1.7.1 and should not be changed by hand. + +[[package]] +name = "alabaster" +version = "0.7.13" +description = "A configurable sidebar-enabled Sphinx theme" +optional = false +python-versions = ">=3.6" +files = [ + {file = "alabaster-0.7.13-py3-none-any.whl", hash = "sha256:1ee19aca801bbabb5ba3f5f258e4422dfa86f82f3e9cefb0859b283cdd7f62a3"}, + {file = "alabaster-0.7.13.tar.gz", hash = "sha256:a27a4a084d5e690e16e01e03ad2b2e552c61a65469419b907243193de1a84ae2"}, +] + +[[package]] +name = "babel" +version = "2.15.0" +description = "Internationalization utilities" +optional = false +python-versions = ">=3.8" +files = [ + {file = "Babel-2.15.0-py3-none-any.whl", hash = "sha256:08706bdad8d0a3413266ab61bd6c34d0c28d6e1e7badf40a2cebe67644e2e1fb"}, + {file = "babel-2.15.0.tar.gz", hash = "sha256:8daf0e265d05768bc6c7a314cf1321e9a123afc328cc635c18622a2f30a04413"}, +] + +[package.dependencies] +pytz = {version = ">=2015.7", markers = "python_version < \"3.9\""} + +[package.extras] +dev = ["freezegun (>=1.0,<2.0)", "pytest (>=6.0)", "pytest-cov"] + +[[package]] +name = "certifi" +version = "2024.8.30" +description = "Python package for providing Mozilla's CA Bundle." +optional = false +python-versions = ">=3.6" +files = [ + {file = "certifi-2024.8.30-py3-none-any.whl", hash = "sha256:922820b53db7a7257ffbda3f597266d435245903d80737e34f8a45ff3e3230d8"}, + {file = "certifi-2024.8.30.tar.gz", hash = "sha256:bec941d2aa8195e248a60b31ff9f0558284cf01a52591ceda73ea9afffd69fd9"}, +] + +[[package]] +name = "charset-normalizer" +version = "3.3.2" +description = "The Real First Universal Charset Detector. Open, modern and actively maintained alternative to Chardet." +optional = false +python-versions = ">=3.7.0" +files = [ + {file = "charset-normalizer-3.3.2.tar.gz", hash = "sha256:f30c3cb33b24454a82faecaf01b19c18562b1e89558fb6c56de4d9118a032fd5"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-macosx_10_9_universal2.whl", hash = "sha256:25baf083bf6f6b341f4121c2f3c548875ee6f5339300e08be3f2b2ba1721cdd3"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:06435b539f889b1f6f4ac1758871aae42dc3a8c0e24ac9e60c2384973ad73027"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:9063e24fdb1e498ab71cb7419e24622516c4a04476b17a2dab57e8baa30d6e03"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:6897af51655e3691ff853668779c7bad41579facacf5fd7253b0133308cf000d"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:1d3193f4a680c64b4b6a9115943538edb896edc190f0b222e73761716519268e"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:cd70574b12bb8a4d2aaa0094515df2463cb429d8536cfb6c7ce983246983e5a6"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:8465322196c8b4d7ab6d1e049e4c5cb460d0394da4a27d23cc242fbf0034b6b5"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:a9a8e9031d613fd2009c182b69c7b2c1ef8239a0efb1df3f7c8da66d5dd3d537"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_aarch64.whl", hash = "sha256:beb58fe5cdb101e3a055192ac291b7a21e3b7ef4f67fa1d74e331a7f2124341c"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_i686.whl", hash = "sha256:e06ed3eb3218bc64786f7db41917d4e686cc4856944f53d5bdf83a6884432e12"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_ppc64le.whl", hash = "sha256:2e81c7b9c8979ce92ed306c249d46894776a909505d8f5a4ba55b14206e3222f"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_s390x.whl", hash = "sha256:572c3763a264ba47b3cf708a44ce965d98555f618ca42c926a9c1616d8f34269"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:fd1abc0d89e30cc4e02e4064dc67fcc51bd941eb395c502aac3ec19fab46b519"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-win32.whl", hash = "sha256:3d47fa203a7bd9c5b6cee4736ee84ca03b8ef23193c0d1ca99b5089f72645c73"}, + {file = "charset_normalizer-3.3.2-cp310-cp310-win_amd64.whl", hash = "sha256:10955842570876604d404661fbccbc9c7e684caf432c09c715ec38fbae45ae09"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-macosx_10_9_universal2.whl", hash = "sha256:802fe99cca7457642125a8a88a084cef28ff0cf9407060f7b93dca5aa25480db"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:573f6eac48f4769d667c4442081b1794f52919e7edada77495aaed9236d13a96"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:549a3a73da901d5bc3ce8d24e0600d1fa85524c10287f6004fbab87672bf3e1e"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:f27273b60488abe721a075bcca6d7f3964f9f6f067c8c4c605743023d7d3944f"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:1ceae2f17a9c33cb48e3263960dc5fc8005351ee19db217e9b1bb15d28c02574"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:65f6f63034100ead094b8744b3b97965785388f308a64cf8d7c34f2f2e5be0c4"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:753f10e867343b4511128c6ed8c82f7bec3bd026875576dfd88483c5c73b2fd8"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:4a78b2b446bd7c934f5dcedc588903fb2f5eec172f3d29e52a9096a43722adfc"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_aarch64.whl", hash = "sha256:e537484df0d8f426ce2afb2d0f8e1c3d0b114b83f8850e5f2fbea0e797bd82ae"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_i686.whl", hash = "sha256:eb6904c354526e758fda7167b33005998fb68c46fbc10e013ca97f21ca5c8887"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_ppc64le.whl", hash = "sha256:deb6be0ac38ece9ba87dea880e438f25ca3eddfac8b002a2ec3d9183a454e8ae"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_s390x.whl", hash = "sha256:4ab2fe47fae9e0f9dee8c04187ce5d09f48eabe611be8259444906793ab7cbce"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:80402cd6ee291dcb72644d6eac93785fe2c8b9cb30893c1af5b8fdd753b9d40f"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-win32.whl", hash = "sha256:7cd13a2e3ddeed6913a65e66e94b51d80a041145a026c27e6bb76c31a853c6ab"}, + {file = "charset_normalizer-3.3.2-cp311-cp311-win_amd64.whl", hash = "sha256:663946639d296df6a2bb2aa51b60a2454ca1cb29835324c640dafb5ff2131a77"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-macosx_10_9_universal2.whl", hash = "sha256:0b2b64d2bb6d3fb9112bafa732def486049e63de9618b5843bcdd081d8144cd8"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:ddbb2551d7e0102e7252db79ba445cdab71b26640817ab1e3e3648dad515003b"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:55086ee1064215781fff39a1af09518bc9255b50d6333f2e4c74ca09fac6a8f6"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:8f4a014bc36d3c57402e2977dada34f9c12300af536839dc38c0beab8878f38a"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:a10af20b82360ab00827f916a6058451b723b4e65030c5a18577c8b2de5b3389"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:8d756e44e94489e49571086ef83b2bb8ce311e730092d2c34ca8f7d925cb20aa"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:90d558489962fd4918143277a773316e56c72da56ec7aa3dc3dbbe20fdfed15b"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:6ac7ffc7ad6d040517be39eb591cac5ff87416c2537df6ba3cba3bae290c0fed"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_aarch64.whl", hash = "sha256:7ed9e526742851e8d5cc9e6cf41427dfc6068d4f5a3bb03659444b4cabf6bc26"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_i686.whl", hash = "sha256:8bdb58ff7ba23002a4c5808d608e4e6c687175724f54a5dade5fa8c67b604e4d"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_ppc64le.whl", hash = "sha256:6b3251890fff30ee142c44144871185dbe13b11bab478a88887a639655be1068"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_s390x.whl", hash = "sha256:b4a23f61ce87adf89be746c8a8974fe1c823c891d8f86eb218bb957c924bb143"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:efcb3f6676480691518c177e3b465bcddf57cea040302f9f4e6e191af91174d4"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-win32.whl", hash = "sha256:d965bba47ddeec8cd560687584e88cf699fd28f192ceb452d1d7ee807c5597b7"}, + {file = "charset_normalizer-3.3.2-cp312-cp312-win_amd64.whl", hash = "sha256:96b02a3dc4381e5494fad39be677abcb5e6634bf7b4fa83a6dd3112607547001"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-macosx_10_9_x86_64.whl", hash = "sha256:95f2a5796329323b8f0512e09dbb7a1860c46a39da62ecb2324f116fa8fdc85c"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:c002b4ffc0be611f0d9da932eb0f704fe2602a9a949d1f738e4c34c75b0863d5"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:a981a536974bbc7a512cf44ed14938cf01030a99e9b3a06dd59578882f06f985"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:3287761bc4ee9e33561a7e058c72ac0938c4f57fe49a09eae428fd88aafe7bb6"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:42cb296636fcc8b0644486d15c12376cb9fa75443e00fb25de0b8602e64c1714"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:0a55554a2fa0d408816b3b5cedf0045f4b8e1a6065aec45849de2d6f3f8e9786"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_aarch64.whl", hash = "sha256:c083af607d2515612056a31f0a8d9e0fcb5876b7bfc0abad3ecd275bc4ebc2d5"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_i686.whl", hash = "sha256:87d1351268731db79e0f8e745d92493ee2841c974128ef629dc518b937d9194c"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_ppc64le.whl", hash = "sha256:bd8f7df7d12c2db9fab40bdd87a7c09b1530128315d047a086fa3ae3435cb3a8"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_s390x.whl", hash = "sha256:c180f51afb394e165eafe4ac2936a14bee3eb10debc9d9e4db8958fe36afe711"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_x86_64.whl", hash = "sha256:8c622a5fe39a48f78944a87d4fb8a53ee07344641b0562c540d840748571b811"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-win32.whl", hash = "sha256:db364eca23f876da6f9e16c9da0df51aa4f104a972735574842618b8c6d999d4"}, + {file = "charset_normalizer-3.3.2-cp37-cp37m-win_amd64.whl", hash = "sha256:86216b5cee4b06df986d214f664305142d9c76df9b6512be2738aa72a2048f99"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-macosx_10_9_universal2.whl", hash = "sha256:6463effa3186ea09411d50efc7d85360b38d5f09b870c48e4600f63af490e56a"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-macosx_10_9_x86_64.whl", hash = "sha256:6c4caeef8fa63d06bd437cd4bdcf3ffefe6738fb1b25951440d80dc7df8c03ac"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-macosx_11_0_arm64.whl", hash = "sha256:37e55c8e51c236f95b033f6fb391d7d7970ba5fe7ff453dad675e88cf303377a"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:fb69256e180cb6c8a894fee62b3afebae785babc1ee98b81cdf68bbca1987f33"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:ae5f4161f18c61806f411a13b0310bea87f987c7d2ecdbdaad0e94eb2e404238"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:b2b0a0c0517616b6869869f8c581d4eb2dd83a4d79e0ebcb7d373ef9956aeb0a"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:45485e01ff4d3630ec0d9617310448a8702f70e9c01906b0d0118bdf9d124cf2"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:eb00ed941194665c332bf8e078baf037d6c35d7c4f3102ea2d4f16ca94a26dc8"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_aarch64.whl", hash = "sha256:2127566c664442652f024c837091890cb1942c30937add288223dc895793f898"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_i686.whl", hash = "sha256:a50aebfa173e157099939b17f18600f72f84eed3049e743b68ad15bd69b6bf99"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_ppc64le.whl", hash = "sha256:4d0d1650369165a14e14e1e47b372cfcb31d6ab44e6e33cb2d4e57265290044d"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_s390x.whl", hash = "sha256:923c0c831b7cfcb071580d3f46c4baf50f174be571576556269530f4bbd79d04"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_x86_64.whl", hash = "sha256:06a81e93cd441c56a9b65d8e1d043daeb97a3d0856d177d5c90ba85acb3db087"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-win32.whl", hash = "sha256:6ef1d82a3af9d3eecdba2321dc1b3c238245d890843e040e41e470ffa64c3e25"}, + {file = "charset_normalizer-3.3.2-cp38-cp38-win_amd64.whl", hash = "sha256:eb8821e09e916165e160797a6c17edda0679379a4be5c716c260e836e122f54b"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-macosx_10_9_universal2.whl", hash = "sha256:c235ebd9baae02f1b77bcea61bce332cb4331dc3617d254df3323aa01ab47bd4"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:5b4c145409bef602a690e7cfad0a15a55c13320ff7a3ad7ca59c13bb8ba4d45d"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:68d1f8a9e9e37c1223b656399be5d6b448dea850bed7d0f87a8311f1ff3dabb0"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:22afcb9f253dac0696b5a4be4a1c0f8762f8239e21b99680099abd9b2b1b2269"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:e27ad930a842b4c5eb8ac0016b0a54f5aebbe679340c26101df33424142c143c"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:1f79682fbe303db92bc2b1136016a38a42e835d932bab5b3b1bfcfbf0640e519"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:b261ccdec7821281dade748d088bb6e9b69e6d15b30652b74cbbac25e280b796"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:122c7fa62b130ed55f8f285bfd56d5f4b4a5b503609d181f9ad85e55c89f4185"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_aarch64.whl", hash = "sha256:d0eccceffcb53201b5bfebb52600a5fb483a20b61da9dbc885f8b103cbe7598c"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_i686.whl", hash = "sha256:9f96df6923e21816da7e0ad3fd47dd8f94b2a5ce594e00677c0013018b813458"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_ppc64le.whl", hash = "sha256:7f04c839ed0b6b98b1a7501a002144b76c18fb1c1850c8b98d458ac269e26ed2"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_s390x.whl", hash = "sha256:34d1c8da1e78d2e001f363791c98a272bb734000fcef47a491c1e3b0505657a8"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:ff8fa367d09b717b2a17a052544193ad76cd49979c805768879cb63d9ca50561"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-win32.whl", hash = "sha256:aed38f6e4fb3f5d6bf81bfa990a07806be9d83cf7bacef998ab1a9bd660a581f"}, + {file = "charset_normalizer-3.3.2-cp39-cp39-win_amd64.whl", hash = "sha256:b01b88d45a6fcb69667cd6d2f7a9aeb4bf53760d7fc536bf679ec94fe9f3ff3d"}, + {file = "charset_normalizer-3.3.2-py3-none-any.whl", hash = "sha256:3e4d1f6587322d2788836a99c69062fbb091331ec940e02d12d179c1d53e25fc"}, +] + +[[package]] +name = "colorama" +version = "0.4.6" +description = "Cross-platform colored terminal text." +optional = false +python-versions = "!=3.0.*,!=3.1.*,!=3.2.*,!=3.3.*,!=3.4.*,!=3.5.*,!=3.6.*,>=2.7" +files = [ + {file = "colorama-0.4.6-py2.py3-none-any.whl", hash = "sha256:4f1d9991f5acc0ca119f9d443620b77f9d6b33703e51011c16baf57afb285fc6"}, + {file = "colorama-0.4.6.tar.gz", hash = "sha256:08695f5cb7ed6e0531a20572697297273c47b8cae5a63ffc6d6ed5c201be6e44"}, +] + +[[package]] +name = "docutils" +version = "0.19" +description = "Docutils -- Python Documentation Utilities" +optional = false +python-versions = ">=3.7" +files = [ + {file = "docutils-0.19-py3-none-any.whl", hash = "sha256:5e1de4d849fee02c63b040a4a3fd567f4ab104defd8a5511fbbc24a8a017efbc"}, + {file = "docutils-0.19.tar.gz", hash = "sha256:33995a6753c30b7f577febfc2c50411fec6aac7f7ffeb7c4cfe5991072dcf9e6"}, +] + +[[package]] +name = "exceptiongroup" +version = "1.2.1" +description = "Backport of PEP 654 (exception groups)" +optional = false +python-versions = ">=3.7" +files = [ + {file = "exceptiongroup-1.2.1-py3-none-any.whl", hash = "sha256:5258b9ed329c5bbdd31a309f53cbfb0b155341807f6ff7606a1e801a891b29ad"}, + {file = "exceptiongroup-1.2.1.tar.gz", hash = "sha256:a4785e48b045528f5bfe627b6ad554ff32def154f42372786903b7abcfe1aa16"}, +] + +[package.extras] +test = ["pytest (>=6)"] + +[[package]] +name = "fsspec" +version = "2023.12.2" +description = "File-system specification" +optional = false +python-versions = ">=3.8" +files = [ + {file = "fsspec-2023.12.2-py3-none-any.whl", hash = "sha256:d800d87f72189a745fa3d6b033b9dc4a34ad069f60ca60b943a63599f5501960"}, + {file = "fsspec-2023.12.2.tar.gz", hash = "sha256:8548d39e8810b59c38014934f6b31e57f40c1b20f911f4cc2b85389c7e9bf0cb"}, +] + +[package.extras] +abfs = ["adlfs"] +adl = ["adlfs"] +arrow = ["pyarrow (>=1)"] +dask = ["dask", "distributed"] +devel = ["pytest", "pytest-cov"] +dropbox = ["dropbox", "dropboxdrivefs", "requests"] +full = ["adlfs", "aiohttp (!=4.0.0a0,!=4.0.0a1)", "dask", "distributed", "dropbox", "dropboxdrivefs", "fusepy", "gcsfs", "libarchive-c", "ocifs", "panel", "paramiko", "pyarrow (>=1)", "pygit2", "requests", "s3fs", "smbprotocol", "tqdm"] +fuse = ["fusepy"] +gcs = ["gcsfs"] +git = ["pygit2"] +github = ["requests"] +gs = ["gcsfs"] +gui = ["panel"] +hdfs = ["pyarrow (>=1)"] +http = ["aiohttp (!=4.0.0a0,!=4.0.0a1)", "requests"] +libarchive = ["libarchive-c"] +oci = ["ocifs"] +s3 = ["s3fs"] +sftp = ["paramiko"] +smb = ["smbprotocol"] +ssh = ["paramiko"] +tqdm = ["tqdm"] + +[[package]] +name = "gitdb" +version = "4.0.11" +description = "Git Object Database" +optional = false +python-versions = ">=3.7" +files = [ + {file = "gitdb-4.0.11-py3-none-any.whl", hash = "sha256:81a3407ddd2ee8df444cbacea00e2d038e40150acfa3001696fe0dcf1d3adfa4"}, + {file = "gitdb-4.0.11.tar.gz", hash = "sha256:bf5421126136d6d0af55bc1e7c1af1c397a34f5b7bd79e776cd3e89785c2b04b"}, +] + +[package.dependencies] +smmap = ">=3.0.1,<6" + +[[package]] +name = "gitpython" +version = "3.1.43" +description = "GitPython is a Python library used to interact with Git repositories" +optional = false +python-versions = ">=3.7" +files = [ + {file = "GitPython-3.1.43-py3-none-any.whl", hash = "sha256:eec7ec56b92aad751f9912a73404bc02ba212a23adb2c7098ee668417051a1ff"}, + {file = "GitPython-3.1.43.tar.gz", hash = "sha256:35f314a9f878467f5453cc1fee295c3e18e52f1b99f10f6cf5b1682e968a9e7c"}, +] + +[package.dependencies] +gitdb = ">=4.0.1,<5" + +[package.extras] +doc = ["sphinx (==4.3.2)", "sphinx-autodoc-typehints", "sphinx-rtd-theme", "sphinxcontrib-applehelp (>=1.0.2,<=1.0.4)", "sphinxcontrib-devhelp (==1.0.2)", "sphinxcontrib-htmlhelp (>=2.0.0,<=2.0.1)", "sphinxcontrib-qthelp (==1.0.3)", "sphinxcontrib-serializinghtml (==1.1.5)"] +test = ["coverage[toml]", "ddt (>=1.1.1,!=1.4.3)", "mock", "mypy", "pre-commit", "pytest (>=7.3.1)", "pytest-cov", "pytest-instafail", "pytest-mock", "pytest-sugar", "typing-extensions"] + +[[package]] +name = "idna" +version = "3.7" +description = "Internationalized Domain Names in Applications (IDNA)" +optional = false +python-versions = ">=3.5" +files = [ + {file = "idna-3.7-py3-none-any.whl", hash = "sha256:82fee1fc78add43492d3a1898bfa6d8a904cc97d8427f683ed8e798d07761aa0"}, + {file = "idna-3.7.tar.gz", hash = "sha256:028ff3aadf0609c1fd278d8ea3089299412a7a8b9bd005dd08b9f8285bcb5cfc"}, +] + +[[package]] +name = "imagesize" +version = "1.4.1" +description = "Getting image size from png/jpeg/jpeg2000/gif file" +optional = false +python-versions = ">=2.7, !=3.0.*, !=3.1.*, !=3.2.*, !=3.3.*" +files = [ + {file = "imagesize-1.4.1-py2.py3-none-any.whl", hash = "sha256:0d8d18d08f840c19d0ee7ca1fd82490fdc3729b7ac93f49870406ddde8ef8d8b"}, + {file = "imagesize-1.4.1.tar.gz", hash = "sha256:69150444affb9cb0d5cc5a92b3676f0b2fb7cd9ae39e947a5e11a36b4497cd4a"}, +] + +[[package]] +name = "importlib-metadata" +version = "8.0.0" +description = "Read metadata from Python packages" +optional = false +python-versions = ">=3.8" +files = [ + {file = "importlib_metadata-8.0.0-py3-none-any.whl", hash = "sha256:15584cf2b1bf449d98ff8a6ff1abef57bf20f3ac6454f431736cd3e660921b2f"}, + {file = "importlib_metadata-8.0.0.tar.gz", hash = "sha256:188bd24e4c346d3f0a933f275c2fec67050326a856b9a359881d7c2a697e8812"}, +] + +[package.dependencies] +zipp = ">=0.5" + +[package.extras] +doc = ["furo", "jaraco.packaging (>=9.3)", "jaraco.tidelift (>=1.4)", "rst.linker (>=1.9)", "sphinx (>=3.5)", "sphinx-lint"] +perf = ["ipython"] +test = ["flufl.flake8", "importlib-resources (>=1.3)", "jaraco.test (>=5.4)", "packaging", "pyfakefs", "pytest (>=6,!=8.1.*)", "pytest-checkdocs (>=2.4)", "pytest-cov", "pytest-enabler (>=2.2)", "pytest-mypy", "pytest-perf (>=0.9.2)", "pytest-ruff (>=0.2.1)"] + +[[package]] +name = "iniconfig" +version = "2.0.0" +description = "brain-dead simple config-ini parsing" +optional = false +python-versions = ">=3.7" +files = [ + {file = "iniconfig-2.0.0-py3-none-any.whl", hash = "sha256:b6a85871a79d2e3b22d2d1b94ac2824226a63c6b741c88f7ae975f18b6778374"}, + {file = "iniconfig-2.0.0.tar.gz", hash = "sha256:2d91e135bf72d31a410b17c16da610a82cb55f6b0477d1a902134b24a455b8b3"}, +] + +[[package]] +name = "jinja2" +version = "3.1.4" +description = "A very fast and expressive template engine." +optional = false +python-versions = ">=3.7" +files = [ + {file = "jinja2-3.1.4-py3-none-any.whl", hash = "sha256:bc5dd2abb727a5319567b7a813e6a2e7318c39f4f487cfe6c89c6f9c7d25197d"}, + {file = "jinja2-3.1.4.tar.gz", hash = "sha256:4a3aee7acbbe7303aede8e9648d13b8bf88a429282aa6122a993f0ac800cb369"}, +] + +[package.dependencies] +MarkupSafe = ">=2.0" + +[package.extras] +i18n = ["Babel (>=2.7)"] + +[[package]] +name = "markupsafe" +version = "2.1.5" +description = "Safely add untrusted strings to HTML/XML markup." +optional = false +python-versions = ">=3.7" +files = [ + {file = "MarkupSafe-2.1.5-cp310-cp310-macosx_10_9_universal2.whl", hash = "sha256:a17a92de5231666cfbe003f0e4b9b3a7ae3afb1ec2845aadc2bacc93ff85febc"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:72b6be590cc35924b02c78ef34b467da4ba07e4e0f0454a2c5907f473fc50ce5"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:e61659ba32cf2cf1481e575d0462554625196a1f2fc06a1c777d3f48e8865d46"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:2174c595a0d73a3080ca3257b40096db99799265e1c27cc5a610743acd86d62f"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:ae2ad8ae6ebee9d2d94b17fb62763125f3f374c25618198f40cbb8b525411900"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-musllinux_1_1_aarch64.whl", hash = "sha256:075202fa5b72c86ad32dc7d0b56024ebdbcf2048c0ba09f1cde31bfdd57bcfff"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-musllinux_1_1_i686.whl", hash = "sha256:598e3276b64aff0e7b3451b72e94fa3c238d452e7ddcd893c3ab324717456bad"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:fce659a462a1be54d2ffcacea5e3ba2d74daa74f30f5f143fe0c58636e355fdd"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-win32.whl", hash = "sha256:d9fad5155d72433c921b782e58892377c44bd6252b5af2f67f16b194987338a4"}, + {file = "MarkupSafe-2.1.5-cp310-cp310-win_amd64.whl", hash = "sha256:bf50cd79a75d181c9181df03572cdce0fbb75cc353bc350712073108cba98de5"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-macosx_10_9_universal2.whl", hash = "sha256:629ddd2ca402ae6dbedfceeba9c46d5f7b2a61d9749597d4307f943ef198fc1f"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:5b7b716f97b52c5a14bffdf688f971b2d5ef4029127f1ad7a513973cfd818df2"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:6ec585f69cec0aa07d945b20805be741395e28ac1627333b1c5b0105962ffced"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:b91c037585eba9095565a3556f611e3cbfaa42ca1e865f7b8015fe5c7336d5a5"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:7502934a33b54030eaf1194c21c692a534196063db72176b0c4028e140f8f32c"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-musllinux_1_1_aarch64.whl", hash = "sha256:0e397ac966fdf721b2c528cf028494e86172b4feba51d65f81ffd65c63798f3f"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-musllinux_1_1_i686.whl", hash = "sha256:c061bb86a71b42465156a3ee7bd58c8c2ceacdbeb95d05a99893e08b8467359a"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:3a57fdd7ce31c7ff06cdfbf31dafa96cc533c21e443d57f5b1ecc6cdc668ec7f"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-win32.whl", hash = "sha256:397081c1a0bfb5124355710fe79478cdbeb39626492b15d399526ae53422b906"}, + {file = "MarkupSafe-2.1.5-cp311-cp311-win_amd64.whl", hash = "sha256:2b7c57a4dfc4f16f7142221afe5ba4e093e09e728ca65c51f5620c9aaeb9a617"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-macosx_10_9_universal2.whl", hash = "sha256:8dec4936e9c3100156f8a2dc89c4b88d5c435175ff03413b443469c7c8c5f4d1"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:3c6b973f22eb18a789b1460b4b91bf04ae3f0c4234a0a6aa6b0a92f6f7b951d4"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:ac07bad82163452a6884fe8fa0963fb98c2346ba78d779ec06bd7a6262132aee"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:f5dfb42c4604dddc8e4305050aa6deb084540643ed5804d7455b5df8fe16f5e5"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:ea3d8a3d18833cf4304cd2fc9cbb1efe188ca9b5efef2bdac7adc20594a0e46b"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-musllinux_1_1_aarch64.whl", hash = "sha256:d050b3361367a06d752db6ead6e7edeb0009be66bc3bae0ee9d97fb326badc2a"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-musllinux_1_1_i686.whl", hash = "sha256:bec0a414d016ac1a18862a519e54b2fd0fc8bbfd6890376898a6c0891dd82e9f"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:58c98fee265677f63a4385256a6d7683ab1832f3ddd1e66fe948d5880c21a169"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-win32.whl", hash = "sha256:8590b4ae07a35970728874632fed7bd57b26b0102df2d2b233b6d9d82f6c62ad"}, + {file = "MarkupSafe-2.1.5-cp312-cp312-win_amd64.whl", hash = "sha256:823b65d8706e32ad2df51ed89496147a42a2a6e01c13cfb6ffb8b1e92bc910bb"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-macosx_10_9_x86_64.whl", hash = "sha256:c8b29db45f8fe46ad280a7294f5c3ec36dbac9491f2d1c17345be8e69cc5928f"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:ec6a563cff360b50eed26f13adc43e61bc0c04d94b8be985e6fb24b81f6dcfdf"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:a549b9c31bec33820e885335b451286e2969a2d9e24879f83fe904a5ce59d70a"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:4f11aa001c540f62c6166c7726f71f7573b52c68c31f014c25cc7901deea0b52"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-musllinux_1_1_aarch64.whl", hash = "sha256:7b2e5a267c855eea6b4283940daa6e88a285f5f2a67f2220203786dfa59b37e9"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-musllinux_1_1_i686.whl", hash = "sha256:2d2d793e36e230fd32babe143b04cec8a8b3eb8a3122d2aceb4a371e6b09b8df"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-musllinux_1_1_x86_64.whl", hash = "sha256:ce409136744f6521e39fd8e2a24c53fa18ad67aa5bc7c2cf83645cce5b5c4e50"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-win32.whl", hash = "sha256:4096e9de5c6fdf43fb4f04c26fb114f61ef0bf2e5604b6ee3019d51b69e8c371"}, + {file = "MarkupSafe-2.1.5-cp37-cp37m-win_amd64.whl", hash = "sha256:4275d846e41ecefa46e2015117a9f491e57a71ddd59bbead77e904dc02b1bed2"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-macosx_10_9_universal2.whl", hash = "sha256:656f7526c69fac7f600bd1f400991cc282b417d17539a1b228617081106feb4a"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-macosx_10_9_x86_64.whl", hash = "sha256:97cafb1f3cbcd3fd2b6fbfb99ae11cdb14deea0736fc2b0952ee177f2b813a46"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:1f3fbcb7ef1f16e48246f704ab79d79da8a46891e2da03f8783a5b6fa41a9532"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:fa9db3f79de01457b03d4f01b34cf91bc0048eb2c3846ff26f66687c2f6d16ab"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:ffee1f21e5ef0d712f9033568f8344d5da8cc2869dbd08d87c84656e6a2d2f68"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-musllinux_1_1_aarch64.whl", hash = "sha256:5dedb4db619ba5a2787a94d877bc8ffc0566f92a01c0ef214865e54ecc9ee5e0"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-musllinux_1_1_i686.whl", hash = "sha256:30b600cf0a7ac9234b2638fbc0fb6158ba5bdcdf46aeb631ead21248b9affbc4"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-musllinux_1_1_x86_64.whl", hash = "sha256:8dd717634f5a044f860435c1d8c16a270ddf0ef8588d4887037c5028b859b0c3"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-win32.whl", hash = "sha256:daa4ee5a243f0f20d528d939d06670a298dd39b1ad5f8a72a4275124a7819eff"}, + {file = "MarkupSafe-2.1.5-cp38-cp38-win_amd64.whl", hash = "sha256:619bc166c4f2de5caa5a633b8b7326fbe98e0ccbfacabd87268a2b15ff73a029"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-macosx_10_9_universal2.whl", hash = "sha256:7a68b554d356a91cce1236aa7682dc01df0edba8d043fd1ce607c49dd3c1edcf"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:db0b55e0f3cc0be60c1f19efdde9a637c32740486004f20d1cff53c3c0ece4d2"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:3e53af139f8579a6d5f7b76549125f0d94d7e630761a2111bc431fd820e163b8"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:17b950fccb810b3293638215058e432159d2b71005c74371d784862b7e4683f3"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:4c31f53cdae6ecfa91a77820e8b151dba54ab528ba65dfd235c80b086d68a465"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-musllinux_1_1_aarch64.whl", hash = "sha256:bff1b4290a66b490a2f4719358c0cdcd9bafb6b8f061e45c7a2460866bf50c2e"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-musllinux_1_1_i686.whl", hash = "sha256:bc1667f8b83f48511b94671e0e441401371dfd0f0a795c7daa4a3cd1dde55bea"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:5049256f536511ee3f7e1b3f87d1d1209d327e818e6ae1365e8653d7e3abb6a6"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-win32.whl", hash = "sha256:00e046b6dd71aa03a41079792f8473dc494d564611a8f89bbbd7cb93295ebdcf"}, + {file = "MarkupSafe-2.1.5-cp39-cp39-win_amd64.whl", hash = "sha256:fa173ec60341d6bb97a89f5ea19c85c5643c1e7dedebc22f5181eb73573142c5"}, + {file = "MarkupSafe-2.1.5.tar.gz", hash = "sha256:d283d37a890ba4c1ae73ffadf8046435c76e7bc2247bbb63c00bd1a709c6544b"}, +] + +[[package]] +name = "packaging" +version = "24.1" +description = "Core utilities for Python packages" +optional = false +python-versions = ">=3.8" +files = [ + {file = "packaging-24.1-py3-none-any.whl", hash = "sha256:5b8f2217dbdbd2f7f384c41c628544e6d52f2d0f53c6d0c3ea61aa5d1d7ff124"}, + {file = "packaging-24.1.tar.gz", hash = "sha256:026ed72c8ed3fcce5bf8950572258698927fd1dbda10a5e981cdf0ac37f4f002"}, +] + +[[package]] +name = "pluggy" +version = "1.5.0" +description = "plugin and hook calling mechanisms for python" +optional = false +python-versions = ">=3.8" +files = [ + {file = "pluggy-1.5.0-py3-none-any.whl", hash = "sha256:44e1ad92c8ca002de6377e165f3e0f1be63266ab4d554740532335b9d75ea669"}, + {file = "pluggy-1.5.0.tar.gz", hash = "sha256:2cffa88e94fdc978c4c574f15f9e59b7f4201d439195c3715ca9e2486f1d0cf1"}, +] + +[package.extras] +dev = ["pre-commit", "tox"] +testing = ["pytest", "pytest-benchmark"] + +[[package]] +name = "pyfakefs" +version = "5.5.0" +description = "pyfakefs implements a fake file system that mocks the Python file system modules." +optional = false +python-versions = ">=3.7" +files = [ + {file = "pyfakefs-5.5.0-py3-none-any.whl", hash = "sha256:8dbf203ab7bef1529f11f7d41b9478b898e95bf9f3b71262163aac07a518cd76"}, + {file = "pyfakefs-5.5.0.tar.gz", hash = "sha256:7448aaa07142f892d0a4eb52a5ed3206a9f02c6599e686cd97d624c18979c154"}, +] + +[[package]] +name = "pygments" +version = "2.18.0" +description = "Pygments is a syntax highlighting package written in Python." +optional = false +python-versions = ">=3.8" +files = [ + {file = "pygments-2.18.0-py3-none-any.whl", hash = "sha256:b8e6aca0523f3ab76fee51799c488e38782ac06eafcf95e7ba832985c8e7b13a"}, + {file = "pygments-2.18.0.tar.gz", hash = "sha256:786ff802f32e91311bff3889f6e9a86e81505fe99f2735bb6d60ae0c5004f199"}, +] + +[package.extras] +windows-terminal = ["colorama (>=0.4.6)"] + +[[package]] +name = "pytest" +version = "8.2.2" +description = "pytest: simple powerful testing with Python" +optional = false +python-versions = ">=3.8" +files = [ + {file = "pytest-8.2.2-py3-none-any.whl", hash = "sha256:c434598117762e2bd304e526244f67bf66bbd7b5d6cf22138be51ff661980343"}, + {file = "pytest-8.2.2.tar.gz", hash = "sha256:de4bb8104e201939ccdc688b27a89a7be2079b22e2bd2b07f806b6ba71117977"}, +] + +[package.dependencies] +colorama = {version = "*", markers = "sys_platform == \"win32\""} +exceptiongroup = {version = ">=1.0.0rc8", markers = "python_version < \"3.11\""} +iniconfig = "*" +packaging = "*" +pluggy = ">=1.5,<2.0" +tomli = {version = ">=1", markers = "python_version < \"3.11\""} + +[package.extras] +dev = ["argcomplete", "attrs (>=19.2)", "hypothesis (>=3.56)", "mock", "pygments (>=2.7.2)", "requests", "setuptools", "xmlschema"] + +[[package]] +name = "pytz" +version = "2024.1" +description = "World timezone definitions, modern and historical" +optional = false +python-versions = "*" +files = [ + {file = "pytz-2024.1-py2.py3-none-any.whl", hash = "sha256:328171f4e3623139da4983451950b28e95ac706e13f3f2630a879749e7a8b319"}, + {file = "pytz-2024.1.tar.gz", hash = "sha256:2a29735ea9c18baf14b448846bde5a48030ed267578472d8955cd0e7443a9812"}, +] + +[[package]] +name = "requests" +version = "2.32.3" +description = "Python HTTP for Humans." +optional = false +python-versions = ">=3.8" +files = [ + {file = "requests-2.32.3-py3-none-any.whl", hash = "sha256:70761cfe03c773ceb22aa2f671b4757976145175cdfca038c02654d061d6dcc6"}, + {file = "requests-2.32.3.tar.gz", hash = "sha256:55365417734eb18255590a9ff9eb97e9e1da868d4ccd6402399eaf68af20a760"}, +] + +[package.dependencies] +certifi = ">=2017.4.17" +charset-normalizer = ">=2,<4" +idna = ">=2.5,<4" +urllib3 = ">=1.21.1,<3" + +[package.extras] +socks = ["PySocks (>=1.5.6,!=1.5.7)"] +use-chardet-on-py3 = ["chardet (>=3.0.2,<6)"] + +[[package]] +name = "smmap" +version = "5.0.1" +description = "A pure Python implementation of a sliding window memory map manager" +optional = false +python-versions = ">=3.7" +files = [ + {file = "smmap-5.0.1-py3-none-any.whl", hash = "sha256:e6d8668fa5f93e706934a62d7b4db19c8d9eb8cf2adbb75ef1b675aa332b69da"}, + {file = "smmap-5.0.1.tar.gz", hash = "sha256:dceeb6c0028fdb6734471eb07c0cd2aae706ccaecab45965ee83f11c8d3b1f62"}, +] + +[[package]] +name = "snowballstemmer" +version = "2.2.0" +description = "This package provides 29 stemmers for 28 languages generated from Snowball algorithms." +optional = false +python-versions = "*" +files = [ + {file = "snowballstemmer-2.2.0-py2.py3-none-any.whl", hash = "sha256:c8e1716e83cc398ae16824e5572ae04e0d9fc2c6b985fb0f900f5f0c96ecba1a"}, + {file = "snowballstemmer-2.2.0.tar.gz", hash = "sha256:09b16deb8547d3412ad7b590689584cd0fe25ec8db3be37788be3810cbf19cb1"}, +] + +[[package]] +name = "sphinx" +version = "5.3.0" +description = "Python documentation generator" +optional = false +python-versions = ">=3.6" +files = [ + {file = "Sphinx-5.3.0.tar.gz", hash = "sha256:51026de0a9ff9fc13c05d74913ad66047e104f56a129ff73e174eb5c3ee794b5"}, + {file = "sphinx-5.3.0-py3-none-any.whl", hash = "sha256:060ca5c9f7ba57a08a1219e547b269fadf125ae25b06b9fa7f66768efb652d6d"}, +] + +[package.dependencies] +alabaster = ">=0.7,<0.8" +babel = ">=2.9" +colorama = {version = ">=0.4.5", markers = "sys_platform == \"win32\""} +docutils = ">=0.14,<0.20" +imagesize = ">=1.3" +importlib-metadata = {version = ">=4.8", markers = "python_version < \"3.10\""} +Jinja2 = ">=3.0" +packaging = ">=21.0" +Pygments = ">=2.12" +requests = ">=2.5.0" +snowballstemmer = ">=2.0" +sphinxcontrib-applehelp = "*" +sphinxcontrib-devhelp = "*" +sphinxcontrib-htmlhelp = ">=2.0.0" +sphinxcontrib-jsmath = "*" +sphinxcontrib-qthelp = "*" +sphinxcontrib-serializinghtml = ">=1.1.5" + +[package.extras] +docs = ["sphinxcontrib-websupport"] +lint = ["docutils-stubs", "flake8 (>=3.5.0)", "flake8-bugbear", "flake8-comprehensions", "flake8-simplify", "isort", "mypy (>=0.981)", "sphinx-lint", "types-requests", "types-typed-ast"] +test = ["cython", "html5lib", "pytest (>=4.6)", "typed_ast"] + +[[package]] +name = "sphinxcontrib-applehelp" +version = "1.0.4" +description = "sphinxcontrib-applehelp is a Sphinx extension which outputs Apple help books" +optional = false +python-versions = ">=3.8" +files = [ + {file = "sphinxcontrib-applehelp-1.0.4.tar.gz", hash = "sha256:828f867945bbe39817c210a1abfd1bc4895c8b73fcaade56d45357a348a07d7e"}, + {file = "sphinxcontrib_applehelp-1.0.4-py3-none-any.whl", hash = "sha256:29d341f67fb0f6f586b23ad80e072c8e6ad0b48417db2bde114a4c9746feb228"}, +] + +[package.extras] +lint = ["docutils-stubs", "flake8", "mypy"] +test = ["pytest"] + +[[package]] +name = "sphinxcontrib-devhelp" +version = "1.0.2" +description = "sphinxcontrib-devhelp is a sphinx extension which outputs Devhelp document." +optional = false +python-versions = ">=3.5" +files = [ + {file = "sphinxcontrib-devhelp-1.0.2.tar.gz", hash = "sha256:ff7f1afa7b9642e7060379360a67e9c41e8f3121f2ce9164266f61b9f4b338e4"}, + {file = "sphinxcontrib_devhelp-1.0.2-py2.py3-none-any.whl", hash = "sha256:8165223f9a335cc1af7ffe1ed31d2871f325254c0423bc0c4c7cd1c1e4734a2e"}, +] + +[package.extras] +lint = ["docutils-stubs", "flake8", "mypy"] +test = ["pytest"] + +[[package]] +name = "sphinxcontrib-htmlhelp" +version = "2.0.1" +description = "sphinxcontrib-htmlhelp is a sphinx extension which renders HTML help files" +optional = false +python-versions = ">=3.8" +files = [ + {file = "sphinxcontrib-htmlhelp-2.0.1.tar.gz", hash = "sha256:0cbdd302815330058422b98a113195c9249825d681e18f11e8b1f78a2f11efff"}, + {file = "sphinxcontrib_htmlhelp-2.0.1-py3-none-any.whl", hash = "sha256:c38cb46dccf316c79de6e5515e1770414b797162b23cd3d06e67020e1d2a6903"}, +] + +[package.extras] +lint = ["docutils-stubs", "flake8", "mypy"] +test = ["html5lib", "pytest"] + +[[package]] +name = "sphinxcontrib-jsmath" +version = "1.0.1" +description = "A sphinx extension which renders display math in HTML via JavaScript" +optional = false +python-versions = ">=3.5" +files = [ + {file = "sphinxcontrib-jsmath-1.0.1.tar.gz", hash = "sha256:a9925e4a4587247ed2191a22df5f6970656cb8ca2bd6284309578f2153e0c4b8"}, + {file = "sphinxcontrib_jsmath-1.0.1-py2.py3-none-any.whl", hash = "sha256:2ec2eaebfb78f3f2078e73666b1415417a116cc848b72e5172e596c871103178"}, +] + +[package.extras] +test = ["flake8", "mypy", "pytest"] + +[[package]] +name = "sphinxcontrib-qthelp" +version = "1.0.3" +description = "sphinxcontrib-qthelp is a sphinx extension which outputs QtHelp document." +optional = false +python-versions = ">=3.5" +files = [ + {file = "sphinxcontrib-qthelp-1.0.3.tar.gz", hash = "sha256:4c33767ee058b70dba89a6fc5c1892c0d57a54be67ddd3e7875a18d14cba5a72"}, + {file = "sphinxcontrib_qthelp-1.0.3-py2.py3-none-any.whl", hash = "sha256:bd9fc24bcb748a8d51fd4ecaade681350aa63009a347a8c14e637895444dfab6"}, +] + +[package.extras] +lint = ["docutils-stubs", "flake8", "mypy"] +test = ["pytest"] + +[[package]] +name = "sphinxcontrib-serializinghtml" +version = "1.1.5" +description = "sphinxcontrib-serializinghtml is a sphinx extension which outputs \"serialized\" HTML files (json and pickle)." +optional = false +python-versions = ">=3.5" +files = [ + {file = "sphinxcontrib-serializinghtml-1.1.5.tar.gz", hash = "sha256:aa5f6de5dfdf809ef505c4895e51ef5c9eac17d0f287933eb49ec495280b6952"}, + {file = "sphinxcontrib_serializinghtml-1.1.5-py2.py3-none-any.whl", hash = "sha256:352a9a00ae864471d3a7ead8d7d79f5fc0b57e8b3f95e9867eb9eb28999b92fd"}, +] + +[package.extras] +lint = ["docutils-stubs", "flake8", "mypy"] +test = ["pytest"] + +[[package]] +name = "tomli" +version = "2.0.1" +description = "A lil' TOML parser" +optional = false +python-versions = ">=3.7" +files = [ + {file = "tomli-2.0.1-py3-none-any.whl", hash = "sha256:939de3e7a6161af0c887ef91b7d41a53e7c5a1ca976325f429cb46ea9bc30ecc"}, + {file = "tomli-2.0.1.tar.gz", hash = "sha256:de526c12914f0c550d15924c62d72abc48d6fe7364aa87328337a31007fe8a4f"}, +] + +[[package]] +name = "urllib3" +version = "2.2.2" +description = "HTTP library with thread-safe connection pooling, file post, and more." +optional = false +python-versions = ">=3.8" +files = [ + {file = "urllib3-2.2.2-py3-none-any.whl", hash = "sha256:a448b2f64d686155468037e1ace9f2d2199776e17f0a46610480d311f73e3472"}, + {file = "urllib3-2.2.2.tar.gz", hash = "sha256:dd505485549a7a552833da5e6063639d0d177c04f23bc3864e41e5dc5f612168"}, +] + +[package.extras] +brotli = ["brotli (>=1.0.9)", "brotlicffi (>=0.8.0)"] +h2 = ["h2 (>=4,<5)"] +socks = ["pysocks (>=1.5.6,!=1.5.7,<2.0)"] +zstd = ["zstandard (>=0.18.0)"] + +[[package]] +name = "wheel" +version = "0.42.0" +description = "A built-package format for Python" +optional = false +python-versions = ">=3.7" +files = [ + {file = "wheel-0.42.0-py3-none-any.whl", hash = "sha256:177f9c9b0d45c47873b619f5b650346d632cdc35fb5e4d25058e09c9e581433d"}, + {file = "wheel-0.42.0.tar.gz", hash = "sha256:c45be39f7882c9d34243236f2d63cbd58039e360f85d0913425fbd7ceea617a8"}, +] + +[package.extras] +test = ["pytest (>=6.0.0)", "setuptools (>=65)"] + +[[package]] +name = "zipp" +version = "3.19.2" +description = "Backport of pathlib-compatible object wrapper for zip files" +optional = false +python-versions = ">=3.8" +files = [ + {file = "zipp-3.19.2-py3-none-any.whl", hash = "sha256:f091755f667055f2d02b32c53771a7a6c8b47e1fdbc4b72a8b9072b3eef8015c"}, + {file = "zipp-3.19.2.tar.gz", hash = "sha256:bf1dcf6450f873a13e952a29504887c89e6de7506209e5b1bcc3460135d4de19"}, +] + +[package.extras] +doc = ["furo", "jaraco.packaging (>=9.3)", "jaraco.tidelift (>=1.4)", "rst.linker (>=1.9)", "sphinx (>=3.5)", "sphinx-lint"] +test = ["big-O", "importlib-resources", "jaraco.functools", "jaraco.itertools", "jaraco.test", "more-itertools", "pytest (>=6,!=8.1.*)", "pytest-checkdocs (>=2.4)", "pytest-cov", "pytest-enabler (>=2.2)", "pytest-ignore-flaky", "pytest-mypy", "pytest-ruff (>=0.2.1)"] + +[metadata] +lock-version = "2.0" +python-versions = "^3.8" +content-hash = "25ee2ae1d74abedde3a6637a60d4a3095ea5cf9731960875741bbc2ba84a475d" diff --git a/.lib/git-fleximod/pyproject.toml b/.lib/git-fleximod/pyproject.toml new file mode 100644 index 0000000000..65924ff9a0 --- /dev/null +++ b/.lib/git-fleximod/pyproject.toml @@ -0,0 +1,41 @@ +[tool.poetry] +name = "git-fleximod" +version = "0.9.4" +description = "Extended support for git-submodule and git-sparse-checkout" +authors = ["Jim Edwards "] +maintainers = ["Jim Edwards "] +license = "MIT" +readme = "README.md" +homepage = "https://github.com/jedwards4b/git-fleximod" +keywords = ["git", "submodule", "sparse-checkout"] +packages = [ +{ include = "git_fleximod"}, +{ include = "doc"}, +] + +[tool.poetry.scripts] +git-fleximod = "git_fleximod.git_fleximod:main" +me2flexi = "git_fleximod.metoflexi:_main" +fsspec = "fsspec.fuse:main" + +[tool.poetry.dependencies] +python = "^3.8" +GitPython = "^3.1.0" +sphinx = "^5.0.0" +fsspec = "^2023.12.2" +wheel = "^0.42.0" +pytest = "^8.0.0" +pyfakefs = "^5.3.5" + +[tool.poetry.urls] +"Bug Tracker" = "https://github.com/jedwards4b/git-fleximod/issues" + +[tool.pytest.ini_options] +markers = [ + "skip_after_first: only run on first iteration" +] + +[build-system] +requires = ["poetry-core"] +build-backend = "poetry.core.masonry.api" + diff --git a/.lib/git-fleximod/tbump.toml b/.lib/git-fleximod/tbump.toml new file mode 100644 index 0000000000..be0b799d34 --- /dev/null +++ b/.lib/git-fleximod/tbump.toml @@ -0,0 +1,43 @@ +# Uncomment this if your project is hosted on GitHub: +github_url = "https://github.com/jedwards4b/git-fleximod/" + +[version] +current = "0.9.4" + +# Example of a semver regexp. +# Make sure this matches current_version before +# using tbump +regex = ''' + (?P\d+) + \. + (?P\d+) + \. + (?P\d+) + ''' + +[git] +message_template = "Bump to {new_version}" +tag_template = "v{new_version}" + +# For each file to patch, add a [[file]] config +# section containing the path of the file, relative to the +# tbump.toml location. +[[file]] +src = "git_fleximod/cli.py" + +[[file]] +src = "pyproject.toml" + +# You can specify a list of commands to +# run after the files have been patched +# and before the git commit is made + +# [[before_commit]] +# name = "check changelog" +# cmd = "grep -q {new_version} Changelog.rst" + +# Or run some commands after the git tag and the branch +# have been pushed: +# [[after_push]] +# name = "publish" +# cmd = "./publish.sh" diff --git a/.lib/git-fleximod/tests/__init__.py b/.lib/git-fleximod/tests/__init__.py new file mode 100644 index 0000000000..4d4c66c78e --- /dev/null +++ b/.lib/git-fleximod/tests/__init__.py @@ -0,0 +1,3 @@ +import sys, os + +sys.path.append(os.path.join(os.path.dirname(__file__), os.path.pardir, "src")) diff --git a/.lib/git-fleximod/tests/conftest.py b/.lib/git-fleximod/tests/conftest.py new file mode 100644 index 0000000000..1dd1b86f34 --- /dev/null +++ b/.lib/git-fleximod/tests/conftest.py @@ -0,0 +1,150 @@ +import pytest +from git_fleximod.gitinterface import GitInterface +import os +import subprocess +import logging +from pathlib import Path + +@pytest.fixture(scope='session') +def logger(): + logging.basicConfig( + level=logging.INFO, format="%(name)s - %(levelname)s - %(message)s", handlers=[logging.StreamHandler()] + ) + logger = logging.getLogger(__name__) + return logger + +all_repos=[ + {"subrepo_path": "modules/test", + "submodule_name": "test_submodule", + "status1" : "test_submodule MPIserial_2.5.0-3-gd82ce7c is out of sync with .gitmodules MPIserial_2.4.0", + "status2" : "test_submodule at tag MPIserial_2.4.0", + "status3" : "test_submodule at tag MPIserial_2.4.0", + "status4" : "test_submodule at tag MPIserial_2.4.0", + "gitmodules_content" : """ + [submodule "test_submodule"] + path = modules/test + url = https://github.com/ESMCI/mpi-serial.git + fxtag = MPIserial_2.4.0 + fxDONOTUSEurl = https://github.com/ESMCI/mpi-serial.git + fxrequired = ToplevelRequired +"""}, + {"subrepo_path": "modules/test_optional", + "submodule_name": "test_optional", + "status1" : "test_optional MPIserial_2.5.0-3-gd82ce7c is out of sync with .gitmodules MPIserial_2.4.0", + "status2" : "test_optional at tag MPIserial_2.4.0", + "status3" : "test_optional not checked out, out of sync at tag MPIserial_2.5.1, expected tag is MPIserial_2.4.0 (optional)", + "status4" : "test_optional at tag MPIserial_2.4.0", + "gitmodules_content": """ + [submodule "test_optional"] + path = modules/test_optional + url = https://github.com/ESMCI/mpi-serial.git + fxtag = MPIserial_2.4.0 + fxDONOTUSEurl = https://github.com/ESMCI/mpi-serial.git + fxrequired = ToplevelOptional +"""}, + {"subrepo_path": "modules/test_alwaysoptional", + "submodule_name": "test_alwaysoptional", + "status1" : "test_alwaysoptional MPIserial_2.3.0 is out of sync with .gitmodules e5cf35c", + "status2" : "test_alwaysoptional at hash e5cf35c", + "status3" : "out of sync at tag MPIserial_2.5.1, expected tag is e5cf35c", + "status4" : "test_alwaysoptional at hash e5cf35c", + "gitmodules_content": """ + [submodule "test_alwaysoptional"] + path = modules/test_alwaysoptional + url = https://github.com/ESMCI/mpi-serial.git + fxtag = e5cf35c + fxDONOTUSEurl = https://github.com/ESMCI/mpi-serial.git + fxrequired = AlwaysOptional +"""}, + {"subrepo_path": "modules/test_sparse", + "submodule_name": "test_sparse", + "status1" : "test_sparse at tag MPIserial_2.5.0", + "status2" : "test_sparse at tag MPIserial_2.5.0", + "status3" : "test_sparse at tag MPIserial_2.5.0", + "status4" : "test_sparse at tag MPIserial_2.5.0", + "gitmodules_content": """ + [submodule "test_sparse"] + path = modules/test_sparse + url = https://github.com/ESMCI/mpi-serial.git + fxtag = MPIserial_2.5.0 + fxDONOTUSEurl = https://github.com/ESMCI/mpi-serial.git + fxrequired = AlwaysRequired + fxsparse = ../.sparse_file_list +"""}, +] +@pytest.fixture(params=all_repos) + +def shared_repos(request): + return request.param + +@pytest.fixture +def get_all_repos(): + return all_repos + +def write_sparse_checkout_file(fp): + sparse_content = """m4 +""" + fp.write_text(sparse_content) + +@pytest.fixture +def test_repo(shared_repos, tmp_path, logger): + subrepo_path = shared_repos["subrepo_path"] + submodule_name = shared_repos["submodule_name"] + test_dir = tmp_path / "testrepo" + test_dir.mkdir() + str_path = str(test_dir) + gitp = GitInterface(str_path, logger) + assert test_dir.joinpath(".git").is_dir() + (test_dir / "modules").mkdir() + if "sparse" in submodule_name: + (test_dir / subrepo_path).mkdir() + # Add the sparse checkout file + write_sparse_checkout_file(test_dir / "modules" / ".sparse_file_list") + gitp.git_operation("add","modules/.sparse_file_list") + else: + gitp = GitInterface(str(test_dir), logger) + gitp.git_operation("submodule", "add", "--depth","1","--name", submodule_name, "https://github.com/ESMCI/mpi-serial.git", subrepo_path) + assert test_dir.joinpath(".gitmodules").is_file() + gitp.git_operation("add",subrepo_path) + gitp.git_operation("commit","-a","-m","\"add submod\"") + test_dir2 = tmp_path / "testrepo2" + gitp.git_operation("clone",test_dir,test_dir2) + return test_dir2 + + +@pytest.fixture +def complex_repo(tmp_path, logger): + test_dir = tmp_path / "testcomplex" + test_dir.mkdir() + str_path = str(test_dir) + gitp = GitInterface(str_path, logger) + gitp.git_operation("remote", "add", "origin", "https://github.com/jedwards4b/fleximod-test2") + gitp.git_operation("fetch", "origin") + gitp.git_operation("checkout", "v0.0.1") + return test_dir + +@pytest.fixture +def complex_update(tmp_path, logger): + test_dir = tmp_path / "testcomplex" + test_dir.mkdir() + str_path = str(test_dir) + gitp = GitInterface(str_path, logger) + gitp.git_operation("remote", "add", "origin", "https://github.com/jedwards4b/fleximod-test2") + gitp.git_operation("fetch", "origin") + gitp.git_operation("checkout", "v0.0.2") + + return test_dir + +@pytest.fixture +def git_fleximod(): + def _run_fleximod(path, args, input=None): + cmd = ["git", "fleximod"] + args.split() + result = subprocess.run(cmd, cwd=path, input=input, + stdout=subprocess.PIPE, stderr=subprocess.PIPE, + text=True) + if result.returncode: + print(result.stdout) + print(result.stderr) + return result + return _run_fleximod + diff --git a/.lib/git-fleximod/tests/test_a_import.py b/.lib/git-fleximod/tests/test_a_import.py new file mode 100644 index 0000000000..d5ca878de5 --- /dev/null +++ b/.lib/git-fleximod/tests/test_a_import.py @@ -0,0 +1,8 @@ +# pylint: disable=unused-import +from git_fleximod import cli +from git_fleximod import utils +from git_fleximod.gitinterface import GitInterface +from git_fleximod.gitmodules import GitModules + +def test_import(): + print("here") diff --git a/.lib/git-fleximod/tests/test_b_update.py b/.lib/git-fleximod/tests/test_b_update.py new file mode 100644 index 0000000000..159f1cfae0 --- /dev/null +++ b/.lib/git-fleximod/tests/test_b_update.py @@ -0,0 +1,26 @@ +import pytest +from pathlib import Path + +def test_basic_checkout(git_fleximod, test_repo, shared_repos): + # Prepare a simple .gitmodules + gm = shared_repos['gitmodules_content'] + file_path = (test_repo / ".gitmodules") + repo_name = shared_repos["submodule_name"] + repo_path = shared_repos["subrepo_path"] + + file_path.write_text(gm) + + # Run the command + result = git_fleximod(test_repo, f"update {repo_name}") + + # Assertions + assert result.returncode == 0 + assert Path(test_repo / repo_path).exists() # Did the submodule directory get created? + if "sparse" in repo_name: + assert Path(test_repo / f"{repo_path}/m4").exists() # Did the submodule sparse directory get created? + assert not Path(test_repo / f"{repo_path}/README").exists() # Did only the submodule sparse directory get created? + + status = git_fleximod(test_repo, f"status {repo_name}") + + assert shared_repos["status2"] in status.stdout + diff --git a/.lib/git-fleximod/tests/test_c_required.py b/.lib/git-fleximod/tests/test_c_required.py new file mode 100644 index 0000000000..89ab8d294d --- /dev/null +++ b/.lib/git-fleximod/tests/test_c_required.py @@ -0,0 +1,30 @@ +import pytest +from pathlib import Path + +def test_required(git_fleximod, test_repo, shared_repos): + file_path = (test_repo / ".gitmodules") + gm = shared_repos["gitmodules_content"] + repo_name = shared_repos["submodule_name"] + if file_path.exists(): + with file_path.open("r") as f: + gitmodules_content = f.read() + # add the entry if it does not exist + if repo_name not in gitmodules_content: + file_path.write_text(gitmodules_content+gm) + # or if it is incomplete + elif gm not in gitmodules_content: + file_path.write_text(gm) + else: + file_path.write_text(gm) + result = git_fleximod(test_repo, "update") + assert result.returncode == 0 + status = git_fleximod(test_repo, f"status {repo_name}") + assert shared_repos["status3"] in status.stdout + status = git_fleximod(test_repo, f"update --optional") + assert result.returncode == 0 + status = git_fleximod(test_repo, f"status {repo_name}") + assert shared_repos["status4"] in status.stdout + status = git_fleximod(test_repo, f"update {repo_name}") + assert result.returncode == 0 + status = git_fleximod(test_repo, f"status {repo_name}") + assert shared_repos["status4"] in status.stdout diff --git a/.lib/git-fleximod/tests/test_d_complex.py b/.lib/git-fleximod/tests/test_d_complex.py new file mode 100644 index 0000000000..edde7d816d --- /dev/null +++ b/.lib/git-fleximod/tests/test_d_complex.py @@ -0,0 +1,66 @@ +import pytest +from pathlib import Path +from git_fleximod.gitinterface import GitInterface + +def test_complex_checkout(git_fleximod, complex_repo, logger): + status = git_fleximod(complex_repo, "status") + assert("ToplevelOptional not checked out, aligned at tag v5.3.2" in status.stdout) + assert("ToplevelRequired not checked out, aligned at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired not checked out, aligned at tag MPIserial_2.4.0" in status.stdout) + assert("Complex not checked out, aligned at tag testtag02" in status.stdout) + assert("AlwaysOptional not checked out, out of sync at tag None, expected tag is MPIserial_2.3.0" in status.stdout) + + # This should checkout and update test_submodule and complex_sub + result = git_fleximod(complex_repo, "update") + assert result.returncode == 0 + + status = git_fleximod(complex_repo, "status") + assert("ToplevelOptional not checked out, aligned at tag v5.3.2" in status.stdout) + assert("ToplevelRequired at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired at tag MPIserial_2.4.0" in status.stdout) + assert("Complex at tag testtag02" in status.stdout) + + # now check the complex_sub + root = (complex_repo / "modules" / "complex") + assert(not (root / "libraries" / "gptl" / ".git").exists()) + assert(not (root / "libraries" / "mpi-serial" / ".git").exists()) + assert((root / "modules" / "mpi-serial" / ".git").exists()) + assert(not (root / "modules" / "mpi-serial2" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / "m4").exists()) + assert(not (root / "modules" / "mpi-sparse" / "README").exists()) + + # update a single optional submodule + + result = git_fleximod(complex_repo, "update ToplevelOptional") + assert result.returncode == 0 + + status = git_fleximod(complex_repo, "status") + assert("ToplevelOptional at tag v5.3.2" in status.stdout) + assert("ToplevelRequired at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired at tag MPIserial_2.4.0" in status.stdout) + assert("Complex at tag testtag02" in status.stdout) + assert("AlwaysOptional not checked out, out of sync at tag None, expected tag is MPIserial_2.3.0" in status.stdout) + + # Finally update optional + result = git_fleximod(complex_repo, "update --optional") + assert result.returncode == 0 + + status = git_fleximod(complex_repo, "status") + assert("ToplevelOptional at tag v5.3.2" in status.stdout) + assert("ToplevelRequired at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired at tag MPIserial_2.4.0" in status.stdout) + assert("Complex at tag testtag02" in status.stdout) + assert("AlwaysOptional at tag MPIserial_2.3.0" in status.stdout) + + # now check the complex_sub + root = (complex_repo / "modules" / "complex" ) + assert(not (root / "libraries" / "gptl" / ".git").exists()) + assert(not (root / "libraries" / "mpi-serial" / ".git").exists()) + assert((root / "modules" / "mpi-serial" / ".git").exists()) + assert((root / "modules" / "mpi-serial2" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / "m4").exists()) + assert(not (root / "modules" / "mpi-sparse" / "README").exists()) + + diff --git a/.lib/git-fleximod/tests/test_e_complex_update.py b/.lib/git-fleximod/tests/test_e_complex_update.py new file mode 100644 index 0000000000..0c3ab4c6a6 --- /dev/null +++ b/.lib/git-fleximod/tests/test_e_complex_update.py @@ -0,0 +1,69 @@ +import pytest +from pathlib import Path +from git_fleximod.gitinterface import GitInterface + +def test_complex_update(git_fleximod, complex_update, logger): + status = git_fleximod(complex_update, "status") + assert("ToplevelOptional not checked out, aligned at tag v5.3.2" in status.stdout) + assert("ToplevelRequired not checked out, aligned at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired not checked out, aligned at tag MPIserial_2.4.0" in status.stdout) + assert("Complex not checked out, out of sync at tag testtag02, expected tag is testtag3" in status.stdout) + assert("AlwaysOptional not checked out, out of sync at tag None, expected tag is MPIserial_2.3.0" in status.stdout) + + # This should checkout and update test_submodule and complex_sub + result = git_fleximod(complex_update, "update") + assert result.returncode == 0 + + status = git_fleximod(complex_update, "status") + assert("ToplevelOptional not checked out, aligned at tag v5.3.2" in status.stdout) + assert("ToplevelRequired at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired at tag MPIserial_2.4.0" in status.stdout) + assert("Complex at tag testtag3" in status.stdout) + + # now check the complex_sub + root = (complex_update / "modules" / "complex") + assert(not (root / "libraries" / "gptl" / ".git").exists()) + assert(not (root / "libraries" / "mpi-serial" / ".git").exists()) + assert((root / "modules" / "mpi-serialAR" / ".git").exists()) + assert((root / "modules" / "mpi-serialSAR" / ".git").exists()) + assert(not (root / "modules" / "mpi-serial2" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / "m4").exists()) + assert(not (root / "modules" / "mpi-sparse" / "README").exists()) + + # update a single optional submodule + + result = git_fleximod(complex_update, "update ToplevelOptional") + assert result.returncode == 0 + + status = git_fleximod(complex_update, "status") + assert("ToplevelOptional at tag v5.3.2" in status.stdout) + assert("ToplevelRequired at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired at tag MPIserial_2.4.0" in status.stdout) + assert("Complex at tag testtag3" in status.stdout) + assert("AlwaysOptional not checked out, out of sync at tag None, expected tag is MPIserial_2.3.0" in status.stdout) + + # Finally update optional + result = git_fleximod(complex_update, "update --optional") + assert result.returncode == 0 + + status = git_fleximod(complex_update, "status") + assert("ToplevelOptional at tag v5.3.2" in status.stdout) + assert("ToplevelRequired at tag MPIserial_2.5.0" in status.stdout) + assert("AlwaysRequired at tag MPIserial_2.4.0" in status.stdout) + assert("Complex at tag testtag3" in status.stdout) + assert("AlwaysOptional at tag MPIserial_2.3.0" in status.stdout) + + # now check the complex_sub + root = (complex_update / "modules" / "complex" ) + assert(not (root / "libraries" / "gptl" / ".git").exists()) + assert(not (root / "libraries" / "mpi-serial" / ".git").exists()) + assert(not (root / "modules" / "mpi-serial" / ".git").exists()) + assert((root / "modules" / "mpi-serialAR" / ".git").exists()) + assert((root / "modules" / "mpi-serialSAR" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / ".git").exists()) + assert((root / "modules" / "mpi-serial2" / ".git").exists()) + assert((root / "modules" / "mpi-sparse" / "m4").exists()) + assert(not (root / "modules" / "mpi-sparse" / "README").exists()) + + diff --git a/CODE_OF_CONDUCT.md b/CODE_OF_CONDUCT.md deleted file mode 100644 index 10dc362beb..0000000000 --- a/CODE_OF_CONDUCT.md +++ /dev/null @@ -1,84 +0,0 @@ -# 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 the Community Atmosphere Model (CAM) 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 2020-04-08 and replaces the previous version. -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/Externals.cfg b/Externals.cfg deleted file mode 100644 index 511f55d36c..0000000000 --- a/Externals.cfg +++ /dev/null @@ -1,60 +0,0 @@ -[externals_description] -schema_version = 1.0.0 - -[cice] -tag = cice5_20200430 -protocol = git -repo_url = https://github.com/ESCOMP/CESM_CICE5 -local_path = components/cice -required = True - -[cime] -tag = cime5.8.34 -protocol = git -repo_url = https://github.com/ESMCI/cime -local_path = cime -required = True - -[cism] -tag = cism2_1_68 -protocol = git -repo_url = https://github.com/ESCOMP/cism-wrapper -local_path = components/cism -externals = Externals_CISM.cfg -required = True - -[clm] -tag = ctsm1.0.dev107 -protocol = git -repo_url = https://github.com/ESCOMP/ctsm -local_path = components/clm -externals = Externals_CLM.cfg -required = True - -[mosart] -tag = mosart1_0_36 -protocol = git -repo_url = https://github.com/ESCOMP/mosart -local_path = components/mosart -required = True - -[rtm] -tag = rtm1_0_71 -protocol = git -repo_url = https://github.com/ESCOMP/rtm -local_path = components/rtm -required = True - -[fms] -tag = fi_20200609 -protocol = git -repo_url = https://github.com/ESCOMP/FMS_interface.git -local_path = libraries/FMS -externals = Externals_FMS.cfg -required = True - -[cam] -local_path = . -protocol = externals_only -externals = Externals_CAM.cfg -required = True diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg deleted file mode 100644 index 27074c8781..0000000000 --- a/Externals_CAM.cfg +++ /dev/null @@ -1,67 +0,0 @@ -[chem_proc] -local_path = chem_proc -protocol = svn -repo_url = https://svn-ccsm-models.cgd.ucar.edu/tools/proc_atm/chem_proc/release_tags -tag = chem_proc5_0_04 -required = True - -[carma] -local_path = src/physics/carma/base -protocol = svn -repo_url = https://svn-ccsm-models.cgd.ucar.edu/carma/release_tags -tag = carma3_49_rel -required = True - -[cosp2] -local_path = src/physics/cosp2/src -protocol = svn -repo_url = https://github.com/CFMIP/COSPv2.0/tags/ -tag = v2.1.4cesm/src -required = True - -[clubb] -local_path = src/physics/clubb -protocol = git -repo_url = https://github.com/ESCOMP/CLUBB_CESM -tag = clubb_release_b76a124_20200220_c20200320 -required = True - -[silhs] -local_path = src/physics/silhs -protocol = git -repo_url = https://github.com/ESCOMP/SILHS_CESM -tag = silhs_clubb_release_b76a124_20200220_c20200320 -required = True - -[pumas] -local_path = src/physics/pumas -protocol = git -repo_url = https://github.com/ESCOMP/PUMAS -tag = pumas_cam-release_v1.8 -required = True - -[atmos_phys] -tag = version0_00_007 -protocol = git -repo_url = https://github.com/NCAR/atmospheric_physics -required = True -local_path = src/atmos_phys - -[atmos_cubed_sphere] -tag = fv3_cesm.04 -protocol = git -repo_url = https://github.com/ESCOMP/FV3_CESM.git -local_path = src/dynamics/fv3/atmos_cubed_sphere -required = True - -[mpas] -local_path = src/dynamics/mpas/dycore -protocol = git -repo_url = https://github.com/MPAS-Dev/MPAS-Model.git -sparse = ../.mpas_sparse_checkout -hash = d059bdf -required = True - -[externals_description] -schema_version = 1.0.0 - diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000000..2ba2f9c2d8 --- /dev/null +++ b/LICENSE @@ -0,0 +1,34 @@ +Copyright (c) 2005-2018, University Corporation for Atmospheric Research (UCAR) +All rights reserved. + +Developed by: + University Corporation for Atmospheric Research - National Center for Atmospheric Research + https://www2.cesm.ucar.edu/working-groups/sewg + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the "Software"), +to deal with the Software without restriction, including without limitation +the rights to use, copy, modify, merge, publish, distribute, sublicense, +and/or sell copies of the Software, and to permit persons to whom +the Software is furnished to do so, subject to the following conditions: + + - Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimers. + - Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimers in the documentation + and/or other materials provided with the distribution. + - Neither the names of [Name of Development Group, UCAR], + nor the names of its contributors may be used to endorse or promote + products derived from this Software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md index e03fb36018..a6aa6fee8c 100644 --- a/README.md +++ b/README.md @@ -2,6 +2,20 @@ ## NOTE: This is **unsupported** development code and is subject to the [CESM developer's agreement](http://www.cgd.ucar.edu/cseg/development-code.html). +----------- + +To checkout externals: + bin/git-fleximod update + +The externals are stored in: + .gitmodules + +.gitmodules can be modified. Then run "bin/git-fleximod update" to get the updated externals + +Details about git-fleximod and the variables in the .gitmodules file can be found at: .lib/git-fleximod/README.md + +------------ + ### CAM Documentation - https://ncar.github.io/CAM/doc/build/html/index.html ### CAM6 namelist settings - http://www.cesm.ucar.edu/models/cesm2/settings/current/cam_nml.html diff --git a/README_EXTERNALS b/README_EXTERNALS deleted file mode 100644 index 2b6c2bc4e3..0000000000 --- a/README_EXTERNALS +++ /dev/null @@ -1,49 +0,0 @@ -Example taken from bulletin board forum for "Subversion Issues" in the -thread for "Introduction to Subversion"...(070208) - - -Working with externals: - -checkout the HEAD of cam's trunk into working copy directory -> svn co $SVN/cam1/trunk cam_trunk_head_wc - -view the property set for cam's external definitions -> svn propget svn:externals cam_trunk_head_wc - -view revision, URL and other useful information specific to external files -> cd cam_trunk_head_wc/models/lnd/clm2/src -> svn info main - -create new clm branch for mods required of cam -> svn copy $SVN/clm2/trunk_tags/ $SVN/clm2/branches/ -m "appropriate message" - -have external directories in working copy refer to new clm branch to make changes -> svn switch $SVN/clm2/branches//src/main main - ---make changes to clm files-- - -when satisfied with changes and testing, commit to HEAD of clm branch -> svn commit main -m "appropriate message" - -tag new version of clm branch - review naming conventions! -> svn copy $SVN/clm2/branches/ $SVN/clm2/branch_tags/_tags/ -m "appropriate message" - -have external directories in working copy refer to new clm tag -> svn switch $SVN/clm2/branch_tags/_tags//src/main main - -modify cam's property for external definitions in working copy -> emacs cam_trunk_head_wc/SVN_EXTERNAL_DIRECTORIES - ---point definition to URL of new-tag-name-- - -set the property - don't forget the 'dot' at the end! -> svn propset svn:externals -F SVN_EXTERNAL_DIRECTORIES cam_trunk_head_wc - ---continue with other cam mods-- - -commit changes from working copy directory to HEAD of cam trunk - NOTE: a commit from here will *NOT* recurse to external directories -> cd cam_trunk_head_wc -> svn commit -m "appropriate message" - -tag new version of cam trunk -> svn copy $SVN/cam1/trunk $SVN/cam1/trunk_tags/ -m "appropriate message" diff --git a/bin/git-fleximod b/bin/git-fleximod new file mode 100755 index 0000000000..f69ede1c22 --- /dev/null +++ b/bin/git-fleximod @@ -0,0 +1,8 @@ +#!/usr/bin/env python3 +import sys +import os +sys.path.insert(0,os.path.abspath(os.path.join(os.path.dirname(__file__),"..",".lib","git-fleximod"))) +from git_fleximod.git_fleximod import main + +if __name__ == '__main__': + sys.exit(main()) diff --git a/bld/Makefile.in b/bld/Makefile.in index 09ff53cc56..e2760621bc 100644 --- a/bld/Makefile.in +++ b/bld/Makefile.in @@ -208,7 +208,7 @@ endif $(AS) -m $< %.F90: %.F90.in - $(ROOTDIR)/cime/src/externals/genf90/genf90.pl $< > $@ + $(ROOTDIR)/cime/CIME/non_py/externals/genf90/genf90.pl $< > $@ # Rules used for the tests run by "configure -test" test_fc: test_fc.o @@ -375,9 +375,9 @@ ifneq ($(strip $(FV3CORE_LIBDIR)),) mod_path += -I$(FV3CORE_LIBDIR) endif -# PGI +# PGI and NVHPC compilers -ifeq ($(FC_TYPE),pgi) +ifneq (,$(filter $(FC_TYPE),pgi nvhpc pgi-gpu nvhpc-gpu)) CPPDEF += -DNO_R16 -DCPRPGI $(NO_CONTIGUOUS_FLAG) CFLAGS += -gopt -O2 diff --git a/bld/build-namelist b/bld/build-namelist index ce70474f87..665b5767da 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3,8 +3,7 @@ # # build-namelist # -# This script builds the namelists for the standalone CAM configuration of -# CESM. +# This script builds the namelists for the CAM component of CESM. # # build-namelist is designed to be used in conjuction with configure. # By default configure produces a config_cache.xml file that contains all @@ -49,7 +48,7 @@ OPTIONS -case "name" Case identifier up to 32 characters -config "filepath" Read the given configuration cache file to determine the configuration of the CAM executable. Default: "config_cache.xml". - -csmdata "dir" Root directory of CCSM input data. + -csmdata "dir" Root directory of CESM input data. Can also be set by using the CSMDATA environment variable. -dir "directory" Directory where output namelist files for each component will be written, i.e., atm_in, drv_in, ice_in, lnd_in, rof_in, and ocn_in. @@ -93,7 +92,7 @@ EOF (my $ProgName = $0) =~ s!(.*)/!!; # name of this script $ProgName = "CAM $ProgName"; # Since multiple components are now using a build-namelist # utility add "CAM" qualifier to the name. This helps when - # looking at error output from the whole CCSM system. + # looking at error output from the whole CESM system. my $ProgDir = $1; # name of directory containing this script -- may be a # relative or absolute path, or null if the script is in # the user's PATH @@ -146,6 +145,7 @@ GetOptions( "uc|use_case=s" => \$opts{'use_case'}, "v|verbose" => \$opts{'verbose'}, "version" => \$opts{'version'}, + "cmeps" => \$opts{'cmeps'}, ) or usage(); # Give usage message. @@ -182,7 +182,7 @@ EOF if ($print>=2) { print "Using CAM configuration cache file $opts{'config'}$eol"; } -# Check that the CCSM inputdata root directory has been specified. +# Check that the CESM inputdata root directory has been specified. my $inputdata_rootdir = undef; if (defined($opts{'csmdata'})) { $inputdata_rootdir = $opts{'csmdata'}; @@ -191,16 +191,16 @@ elsif (defined $ENV{'CSMDATA'}) { $inputdata_rootdir = $ENV{'CSMDATA'}; } else { - die "$ProgName - ERROR: CCSM inputdata root directory must be specified by either -csmdata argument\n" . + die "$ProgName - ERROR: CESM inputdata root directory must be specified by either -csmdata argument\n" . " or by the CSMDATA environment variable. :"; } -if ($print>=2) { print "CCSM inputdata root directory: $inputdata_rootdir$eol"; } +if ($print>=2) { print "CESM inputdata root directory: $inputdata_rootdir$eol"; } # If the -test option is specified, then the inputdata root directory must be local or nfs mounted. if ($opts{'test'}) { (-d $inputdata_rootdir) or die <<"EOF"; -** $ProgName - ERROR: CCSM inputdata root is not a directory: \"$inputdata_rootdir\" ** +** $ProgName - ERROR: CESM inputdata root is not a directory: \"$inputdata_rootdir\" ** EOF } @@ -368,7 +368,9 @@ if (defined $opts{'case'}) { add_default($nl, 'case_name', 'val'=>$opts{'case'}) # Run type if (defined $opts{'runtype'}) { add_default($nl, 'start_type', 'val'=>$opts{'runtype'}); } -# Process the -namelist arg. +# Process the -namelist argument. CIME uses this argument to pass the values that have been +# set by the compset definition via the CAM_NAMELIST_OPTS variable, along with additional +# settings made in the buildnml script. if (defined $opts{'namelist'}) { # Parse commandline namelist @@ -386,7 +388,8 @@ if (defined $opts{'namelist'}) { $nl->merge_nl($nl_arg_valid); } -# Process the -infile arg. +# Process the -infile argument. CIME uses this argument to pass the contents of the user_nl_cam +# file, along with additional settings made in the buildnml script. if (defined $opts{'infile'}) { # Parse namelist input from a file @@ -404,6 +407,11 @@ if (defined $opts{'infile'}) { $nl->merge_nl($nl_infile_valid); } +# Check for user input via the user_nl_cam file which is inconsistent with settings determined by +# the compset definition. + +check_user_input($nl); + # Process the -use_case arg. # Declare global symbol $uc_defaults even if it's not defined, because we check whether it's # defined before using it in the get_default_value method below. @@ -472,10 +480,26 @@ if ($phys eq 'adiabatic') { ++$phys_mode_flags; } my $ideal_mode = 0; -if ($phys eq 'kessler' or $phys eq 'held_suarez' or $phys eq 'tj2016') { +if ($phys eq 'kessler' or $phys eq 'held_suarez' or $phys eq 'tj2016' or $phys eq 'grayrad' ) { $ideal_mode = 1; ++$phys_mode_flags; } +if ($phys eq 'grayrad' ) { + add_default($nl, 'frierson_albedo'); + add_default($nl, 'frierson_c0'); + add_default($nl, 'frierson_deltas'); + add_default($nl, 'frierson_fb'); + add_default($nl, 'frierson_linfrac'); + add_default($nl, 'frierson_ri_c'); + add_default($nl, 'frierson_tau_eqtr'); + add_default($nl, 'frierson_tau_pole'); + add_default($nl, 'frierson_tdlt'); + add_default($nl, 'frierson_tmin'); + add_default($nl, 'frierson_twidth'); + add_default($nl, 'frierson_wetdrycoef'); + add_default($nl, 'frierson_wind_min'); + add_default($nl, 'frierson_z0'); +} if ($phys_mode_flags > 1) { die "$ProgName - ERROR: Only one of the variables atm_adiabatic, atm_ideal_phys, and aqua_planet can be set .true. \n"; } @@ -487,6 +511,7 @@ if ($adia_mode or $ideal_mode) { $simple_phys = 1; } # 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. @@ -516,7 +541,7 @@ my $rad_prog_bcarb = (($prog_species =~ "BC" or $aero_chem) and !($chem_rad_pa my $rad_prog_sulf = (($prog_species =~ "SO4" or $aero_chem) and !($chem_rad_passive)); my $rad_prog_dust = (($prog_species =~ "DST" or $aero_chem) and !($chem_rad_passive)); my $rad_prog_sslt = (($prog_species =~ "SSLT" or $aero_chem) and !($chem_rad_passive)); -my $rad_prog_ozone = (($chem =~ "mozart" or $chem =~ "waccm_ma" or $chem =~ "tsmlt" or $chem =~ "trop_strat") and !($chem_rad_passive)); +my $rad_prog_ozone = (($chem =~ "mozart" or $chem =~ "waccm_ma" or $chem =~ "tsmlt" or $chem =~ "trop_strat" or $chem =~ /geoschem/) and !($chem_rad_passive)); # Check for eruptive volcano emissions. These will be radiatively active by default, but # only if using BAM and the camrt radiation package @@ -545,6 +570,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'); @@ -552,12 +585,13 @@ if ( ($chem ne 'none') or ( $prog_species ) ){ my ( $gas_wetdep_list, $aer_wetdep_list, $aer_sol_facti, $aer_sol_factb, $aer_scav_coef, $aer_drydep_list, $gas_drydep_list ) = - set_dep_lists( $cfgdir, $chem_proc_src, $chem_src_dir, $nl, $print ); + set_dep_lists( $chem, $cfgdir, $chem_proc_src, $chem_src_dir, $nl, $print ); if (length($gas_wetdep_list)>2){ add_default($nl, 'gas_wetdep_method' ); add_default($nl, 'gas_wetdep_list', 'val'=>$gas_wetdep_list ); } + if (length($aer_wetdep_list)>2){ # determine if prescribed aerosols are not needed ... if ($aer_wetdep_list =~ /so4/i && @@ -566,8 +600,9 @@ if ( ($chem ne 'none') or ( $prog_species ) ){ ($aer_wetdep_list =~ /ncl/i || $aer_wetdep_list =~ /sslt/i)) { $prescribe_aerosols = $FALSE; } - - add_default($nl, 'aer_wetdep_list', 'val'=>$aer_wetdep_list ); + if ($chem !~ /_mam/) { + add_default($nl, 'aer_wetdep_list', 'val'=>$aer_wetdep_list ); + } if (!($chem =~ /_mam/)) { if (!defined $nl->get_value('aer_sol_facti')) { @@ -590,11 +625,18 @@ 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'); } # Initial conditions @@ -655,6 +697,19 @@ if ($sim_year =~ /(\d+)-(\d+)/) { $sim_year_start = $1; } +# Setup default ndep streams only if not simple_phys or aqua_mode and +# the chemistry cannot produce the nitrogen depostion fluxes +if (!($simple_phys or $aqua_mode)) { + my $chem_nitrodep = chem_has_species($cfg, 'NO') and chem_has_species($cfg, 'NH3'); + if ((!$chem_nitrodep) or ($chem =~ /geoschem/)) { + add_default($nl, 'stream_ndep_mesh_filename'); + add_default($nl, 'stream_ndep_data_filename', 'sim_year'=>$sim_year); + add_default($nl, 'stream_ndep_year_first', 'sim_year'=>$sim_year); + add_default($nl, 'stream_ndep_year_last', 'sim_year'=>$sim_year); + add_default($nl, 'stream_ndep_year_align', 'sim_year'=>$sim_year); + } +} + # Topography add_default($nl, 'use_topo_file'); my $use_topo_file = $nl->get_value('use_topo_file'); @@ -668,6 +723,23 @@ my $rad_pkg = $cfg->get('rad'); if ($rad_pkg eq 'camrt') { add_default($nl, 'absems_data'); } +elsif ($rad_pkg =~ m/rrtmgp/) { + # Dataset for gas optics are checked out of an external repo into + # the source code directory. The paths to this data are relative + # to the root directory of the cam component. + my $cam_dir = $cfg->get('cam_dir'); + + add_default($nl, 'rrtmgp_coefs_lw_file'); + my $rel_path = $nl->get_value('rrtmgp_coefs_lw_file'); + my $abs_path = quote_string(set_abs_filepath($rel_path, $cam_dir)); + # Overwrite the relative pathname with the absolute pathname in the namelist object + $nl->set_variable_value('radiation_nl', 'rrtmgp_coefs_lw_file', $abs_path); + + add_default($nl, 'rrtmgp_coefs_sw_file'); + $rel_path = $nl->get_value('rrtmgp_coefs_sw_file'); + my $abs_path = quote_string(set_abs_filepath($rel_path, $cam_dir)); + $nl->set_variable_value('radiation_nl', 'rrtmgp_coefs_sw_file', $abs_path); +} # Solar irradiance @@ -679,21 +751,24 @@ if (defined $nl->get_value('solar_const') and } -if ($rad_pkg eq 'rrtmg' or $chem =~ /waccm/) { +if ($rad_pkg =~ /rrtmg/ or $chem =~ /waccm/) { if (defined $nl->get_value('solar_const')) { - die "$ProgName - ERROR: Specifying solar_const with RRTMG or WACCM is not allowed.\n" + die "$ProgName - ERROR: Specifying solar_const with RRTMG/RRTMGP or WACCM is not allowed.\n" } # use solar data file as the default for rrtmg and waccm_ma add_default($nl, 'solar_irrad_data_file'); + + # The solar spectral scaling is done based on the distribution from + # the solar_irrad_data_file. add_default($nl, 'solar_htng_spctrl_scl', 'val'=>'.true.'); } elsif (!$simple_phys) { if ($chem eq 'none' and !($prog_species =~ /SO4/) ) { # Spectral solar data is needed for photolysis - # this preserves the default cam3 and cam4 configurations which do not have chemistry + # this preserves the default cam4 configuration which does not have chemistry unless (defined $nl->get_value('solar_irrad_data_file')) { add_default($nl, 'solar_const'); } @@ -772,17 +847,8 @@ if ($test_tracer_num > 0) { if ($cfg->get('age_of_air_trcs')) { add_default($nl, 'aoa_tracers_flag', 'val'=>'.true.'); } -# If phys option is "cam3" then turn on the CAM3 prescribed ozone and aerosols -if ($phys eq 'cam3' and !$aqua_mode) { - add_default($nl, 'cam3_ozone_data_on', 'val'=>'.true.'); - add_default($nl, 'cam3_aero_data_on', 'val'=>'.true.'); -} - # Defaults for radiatively active constituents -my $cam3_ozone_data = $FALSE; -my $cam3_aero_data = $FALSE; - my $moz_ozone_data = $FALSE; if (!$rad_prog_ozone) { $moz_ozone_data = $TRUE; @@ -793,31 +859,12 @@ if (!($rad_prog_ocarb) or !($rad_prog_bcarb) or !($rad_prog_sulf) or !($rad_prog $moz_aero_data = $TRUE; } -# CAM3 prescribed ozone only by request -if (defined $nl->get_value('cam3_ozone_data_on') and - $nl->get_value('cam3_ozone_data_on') =~ /$TRUE/io) { - add_default($nl, 'bndtvo'); - $cam3_ozone_data = $TRUE; - $moz_ozone_data = $FALSE; -} - -# CAM3 prescribed aerosols only by request -if (defined $nl->get_value('cam3_aero_data_on') and - $nl->get_value('cam3_aero_data_on') =~ /$TRUE/io) { - - # CAM3 aerosol mass climatology dataset (horizontal resolution dependent) - add_default($nl, 'bndtvaer'); - $cam3_aero_data = $TRUE; - $moz_aero_data = $FALSE; -} - if ($chem_rad_passive or $aqua_mode) { add_default($nl, 'atm_dep_flux', 'val'=>'.false.'); } # The aerosol optics depend on which radiative transfer model is used due to differing # wavelength bands used. -my $rrtmg = $rad_pkg eq 'rrtmg' ? 1 : 0; # @aero_names contains the names of the entities (bulk aerosols and modes) # that are externally mixed in aerosol optics calculation. These entities are all @@ -837,10 +884,10 @@ my $radval = "'A:Q:H2O'"; if (($chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/) and !$chem_rad_passive) { $radval .= ",'A:O2:O2','A:CO2:CO2'"; } -elsif ($chem =~ /trop_strat/ and !$chem_rad_passive) { +elsif (($chem =~ /trop_strat/ or $chem =~ /geoschem/) and !$chem_rad_passive) { $radval .= ",'N:O2:O2','A:CO2:CO2'"; } -elsif ($co2_cycle and !$co2_cycle_rad_passive) { +elsif (($co2_cycle and !$co2_cycle_rad_passive) or ($chem =~ /ghg_mam4/)) { $radval .= ",'N:O2:O2','A:CO2:CO2'"; } else { @@ -860,18 +907,18 @@ if ($rad_prog_ozone) { add_default($nl, 'prescribed_ozone_type'); add_default($nl, 'prescribed_ozone_cycle_yr'); } -} elsif ($cam3_ozone_data =~ /$TRUE/io) { - $radval .= ",'N:O3:O3'"; } else { die "ERROR: can not set ozone rad_climate specification\n"; } -if ((($chem =~ /waccm_ma/) or ($chem =~ /waccm_sc_mam/) or ($chem =~ /waccm_tsmlt/) or ($chem =~ /trop_strat/)) and !$chem_rad_passive ) { +if ((($chem =~ /ghg_mam4/) or ($chem =~ /waccm_ma/) or ($chem =~ /waccm_sc_mam/) or ($chem =~ /waccm_tsmlt/) or ($chem =~ /trop_strat/)) and !$chem_rad_passive ) { $radval .= ",'A:N2O:N2O','A:CH4:CH4','N:CFC11STAR:CFC11','A:CFC12:CFC12'"; } elsif ($prog_ghg1 and $prog_ghg2 and !$chem_rad_passive ) { $radval .= ",'A:N2O:N2O','A:CH4:CH4','A:CFC11:CFC11','A:CFC12:CFC12'"; } elsif ($prog_ghg1 and !$prog_ghg2 and !$chem_rad_passive ) { $radval .= ",'A:N2O:N2O','A:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'"; +} elsif ($chem =~ /geoschem/) { + $radval .= ",'A:N2O:N2O','A:CH4:CH4','A:CFC11:CFC11','A:CFC12:CFC12'"; } else { $radval .= ",'N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'"; } @@ -908,6 +955,7 @@ if ($aer_model eq 'mam' ) { my $aero_modes = '3mode'; if ($chem =~ /_mam7/) {$aero_modes = '7mode';} if ($chem =~ /_mam4/) {$aero_modes = '4mode';} + if ($chem =~ /_mam5/) {$aero_modes = '5mode';} my @mode_names; my @mode_types; @@ -972,6 +1020,28 @@ if ($aer_model eq 'mam' ) { @mode_num_src = qw(A A A A); + } elsif($aero_modes eq '5mode') { + # For 5 modes + + # MAM rad_climate settings. The externally mixed quantities in the modal aerosol + # model are the modes. + push @aero_names, qw(mam5_mode1 mam5_mode2 mam5_mode3 mam5_mode4 mam5_mode5); + push @aerosources, qw(M: M: M: M: M:); + + # Each of the mode names put into the @aero_names array needs to be defined. + @mode_names = qw(mam5_mode1 mam5_mode2 mam5_mode3 mam5_mode4 mam5_mode5); + @mode_types = qw(accum aitken coarse primary_carbon coarse_strat); + @mode_num = qw(num_a1 num_a2 num_a3 num_a4 num_a5); + @mode_num_cw = qw(num_c1 num_c2 num_c3 num_c4 num_c5); + + %modal_groups = ( 'accum' => [qw(so4 pom soa bc dst ncl)], + 'aitken' => [qw(so4 soa ncl dst)], + 'coarse' => [qw(dst ncl so4)], + 'primary_carbon' => [qw(pom bc)], + 'coarse_strat' => [qw(so4)] ); + + @mode_num_src = qw(A A A A A); + } elsif($aero_modes eq '7mode') { # For 7 modes @@ -1023,9 +1093,6 @@ if ($aer_model eq 'mam' ) { } elsif ($moz_aero_data =~ /$TRUE/io) { push(@aero_names, "sulf"); push(@aerosources, "N:" ); - } elsif ($cam3_aero_data =~ /$TRUE/io) { - push(@aero_names, "cam3_sul" ); - push(@aerosources, "N:" ); } else { die "ERROR: can not set sulf rad_climate specification\n"; } @@ -1036,9 +1103,6 @@ if ($aer_model eq 'mam' ) { } elsif ($moz_aero_data =~ /$TRUE/io) { push(@aero_names, "dust1", "dust2", "dust3", "dust4"); push(@aerosources, "N:", "N:", "N:", "N:" ); - } elsif ($cam3_aero_data =~ /$TRUE/io) { - push(@aero_names, "cam3_dust1", "cam3_dust2", "cam3_dust3", "cam3_dust4" ); - push(@aerosources, "N:", "N:", "N:", "N:" ); } else { die "ERROR: can not set dust rad_climate specification\n"; } @@ -1049,9 +1113,6 @@ if ($aer_model eq 'mam' ) { } elsif ($moz_aero_data =~ /$TRUE/io) { push(@aero_names, "bcar1", "bcar2"); push(@aerosources, "N:", "N:" ); - } elsif ($cam3_aero_data =~ /$TRUE/io) { - push(@aero_names, "cam3_bcpho", "cam3_bcphi"); - push(@aerosources, "N:", "N:" ); } else { die "ERROR: can not set black carbon rad_climate specification\n"; } @@ -1062,15 +1123,12 @@ if ($aer_model eq 'mam' ) { } elsif ($moz_aero_data =~ /$TRUE/io) { push(@aero_names, "ocar1", "ocar2"); push(@aerosources, "N:", "N:" ); - } elsif ($cam3_aero_data =~ /$TRUE/io) { - push(@aero_names, "cam3_ocpho", "cam3_ocphi"); - push(@aerosources, "N:", "N:" ); } else { die "ERROR: can not set organic carbon rad_climate specification\n"; } if ($rad_prog_sslt) { - if ($rrtmg) { + if ($rad_pkg =~ /rrtmg/) { push(@aero_names, "SSLT01", "SSLT02", "SSLT03", "SSLT04"); push(@aerosources, "A:", "A:", "A:", "A:" ); } else { @@ -1078,16 +1136,13 @@ if ($aer_model eq 'mam' ) { push(@aerosources, "N:", "N:"); } } elsif ($moz_aero_data =~ /$TRUE/io ) { - if ($rrtmg) { + if ($rad_pkg =~ /rrtmg/) { push(@aero_names, "sslt1", "sslt2", "sslt3", "sslt4"); push(@aerosources, "N:", "N:", "N:", "N:" ); } else { push(@aero_names, "SSLTA", "SSLTC"); push(@aerosources, "N:", "N:"); } - } elsif ($cam3_aero_data =~ /$TRUE/io ) { - push(@aero_names, "cam3_ssam", "cam3_sscm"); - push(@aerosources, "N:", "N:" ); } else { die "ERROR: can not set sslt rad_climate specification\n"; } @@ -1108,7 +1163,7 @@ if ( $prescribed_aero_model ne 'none' ) { # Prescribed aerosol deposition fluxes. # Not needed if in aquaplanet mode. - if ( (($moz_aero_data =~ /$TRUE/io) or ($cam3_aero_data =~ /$TRUE/io)) and !$aqua_mode ) { + if ( $moz_aero_data =~ /$TRUE/io and !$aqua_mode ) { # If user has not set aerodep_flx_file, then use defaults unless (defined $nl->get_value('aerodep_flx_file')) { my @settings = ('aerodep_flx_datapath', 'aerodep_flx_file', 'aerodep_flx_type', @@ -1173,7 +1228,7 @@ if ($carma eq 'bc_strat') { } } -if ($rrtmg) { +if ($rad_pkg eq 'rrtmg') { # CARMA Microphysics - RRTMG Only # @@ -1216,6 +1271,7 @@ if ($carma ne 'none') { add_default($nl, 'carma_model', 'val'=>$carma); add_default($nl, 'carma_flag', 'val'=>'.true.'); add_default($nl, 'history_carma', 'val'=>'.true.'); + add_default($nl, 'carma_sulfnuc_method','val'=>'ZhaoTurco'); } if ($carma eq 'bc_strat') { add_default($nl, 'carma_do_drydep', 'val'=>'.true.'); @@ -1494,7 +1550,7 @@ elsif ($carma eq 'tholin') { # turn on stratospheric aerosol forcings in CAM6 configurations my $chem_has_ocs = chem_has_species($cfg, 'OCS'); -if ($phys =~ /cam6/) { +if (($phys =~ /cam6/ or $phys =~ /cam7/) and $chem =~ /_mam/) { # turn on volc forcings in cam6 -- prognostic or prescribed if ( $chem_has_ocs ) { # turn on prognostic stratospheric aerosols @@ -1524,9 +1580,9 @@ if (chem_has_species($cfg, 'O3S')) { # stratospheric aerosols are needed for heterogeneous chemistry as well as radiation feedback my $het_chem = chem_has_species($cfg, 'N2O5'); -# Default for CAM6, is that prescribed_strataero_3modes is TRUE, but allow user to override +# Default for cam6 and cam7 is that prescribed_strataero_3modes is TRUE, but allow user to override my $prescribed_strataero_3modes = $FALSE; -if ($phys =~ /cam6/) { +if ($phys =~ /cam6/ or $phys =~ /cam7/) { $prescribed_strataero_3modes = $TRUE; } if (defined $nl->get_value('prescribed_strataero_3modes')) { @@ -1535,7 +1591,7 @@ if (defined $nl->get_value('prescribed_strataero_3modes')) { # determine if prescribed stratospheric aerosol data is needed if ( ($het_chem) || ($nl->get_value('prescribed_strataero_feedback') =~ /$TRUE/io ) ){ - if ( ($carma ne 'sulfate') && !($nl->get_value('modal_strat_sulfate') =~ /$TRUE/io) ) { # if no prognostic stratospheric aerosols + if ( !($nl->get_value('modal_strat_sulfate') =~ /$TRUE/io) ) { # if no prognostic stratospheric aerosols unless (defined $nl->get_value('prescribed_strataero_type')) { add_default($nl, 'prescribed_strataero_type','val'=>'CYCLICAL'); @@ -1593,11 +1649,25 @@ if ($rad_pkg ne 'none') { } # Cloud optics -if ($rrtmg) { +if ($rad_pkg =~ m/rrtmg/) { # matches both rrtmg and rrtmgp add_default($nl, 'liqcldoptics'); add_default($nl, 'icecldoptics'); add_default($nl, 'liqopticsfile'); add_default($nl, 'iceopticsfile'); + + # rrtmgp only implemented with mitchell and gammadist cloud optics + if ($rad_pkg =~ m/rrtmgp/) { + my $liqcldoptics = $nl->get_value('liqcldoptics'); + if ($liqcldoptics !~ m/gammadist/) { + die "$ProgName - ERROR: RRTMGP only implemented with gammadist liquid cloud optics\n" . + "liqcldoptics = $liqcldoptics\n"; + } + my $icecldoptics = $nl->get_value('icecldoptics'); + if ($icecldoptics !~ m/mitchell/) { + die "$ProgName - ERROR: RRTMGP only implemented with mitchell ice cloud optics\n" . + "icecldoptics = $icecldoptics\n"; + } + } } # Volcanic Aerosol Mass climatology dataset @@ -1621,11 +1691,21 @@ if ($chem =~ /waccm_sc/) { add_default($nl, 'waccm_forcing_type', 'val'=>'CYCLICAL'); add_default($nl, 'waccm_forcing_cycle_yr'); } - add_default($nl, 'nlte_use_mo', 'val'=>".false."); + add_default($nl, 'nlte_use_mo', 'val'=>".false."); + add_default($nl, 'nlte_use_aliarms', 'val'=>".false."); add_default($nl, 'h2orates'); add_default($nl, 'solar_parms_data_file'); } - +if ($chem =~ /ghg_mam4/) { + add_default($nl, 'h2orates'); + my $flbc_list = "'CH4','N2O','CO2','CFC11','CFC12'"; + add_default($nl, 'flbc_list', 'val'=>$flbc_list); + unless (defined $nl->get_value('flbc_type')) { + add_default($nl, 'flbc_type', 'val'=>'CYCLICAL'); + add_default($nl, 'flbc_cycle_yr', 'val'=>'2000'); + } + add_default($nl, 'flbc_file'); +} if ( $prog_species ) { my $ddval; my $emisval; @@ -1690,7 +1770,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' ); } @@ -1757,16 +1837,8 @@ if (defined $nl->get_value('prescribed_aero_file')) { my $megan_emis = defined $nl->get_value('megan_specifier'); if ( $megan_emis ) { add_default($nl, 'megan_factors_file'); } -# Aerosol convective processes -if ($chem =~ /trop_strat/) { - add_default($nl, 'convproc_do_aer', 'val'=>'.true.'); - add_default($nl, 'convproc_do_evaprain_atonce', 'val'=>'.true.'); - add_default($nl, 'convproc_pom_spechygro', 'val'=>'0.2D0'); - add_default($nl, 'convproc_wup_max', 'val'=>'4.0D0'); -} - # Tropospheric full chemistry options -if (($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) and ($phys !~ /cam6/)) { +if (($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) and ($phys !~ /cam6/) and ($phys !~ /cam7/)) { # Surface emission datasets: my %verhash; @@ -1814,7 +1886,7 @@ if (($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) 'num_a2 -> ' => 'num_a2_emis_file', ); %verhash = ('ver'=>'mam'); - } elsif ($chem =~ /_tsmlt_mam4/ or $chem =~ /mam4_vbs/) { + } elsif ($chem =~ /_tsmlt_mam4/ or $chem =~ /_tsmlt_mam5/ or $chem =~ /mam4_vbs/) { %species = (%species, 'BENZENE -> ' => 'soa_benzene_emis_file', 'XYLENES -> ' => 'soa_xylene_emis_file', @@ -1828,6 +1900,17 @@ if (($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) 'num_a2 -> ' => 'num_a2_emis_file', 'num_a4 -> ' => 'mam4_num_a4_emis_file', ); + } elsif ($chem =~ /mam5/) { + %species = (%species, + 'SOAG -> ' => 'soag_emis_file', + 'bc_a4 -> ' => 'bc_a4_emis_file', + 'pom_a4 -> ' => 'pom_a4_emis_file', + 'so4_a1 -> ' => 'so4_a1_emis_file', + 'so4_a2 -> ' => 'so4_a2_emis_file', + 'num_a1 -> ' => 'mam4_num_a1_emis_file', + 'num_a2 -> ' => 'num_a2_emis_file', + 'num_a4 -> ' => 'mam4_num_a4_emis_file', + ); } elsif ($chem =~ /mam4/) { %species = (%species, 'SOAG -> ' => 'soag_emis_file', @@ -1889,7 +1972,7 @@ if (($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) 'num_a1 -> ' => 'num_a1_ext_file', 'num_a2 -> ' => 'num_a2_ext_file', ); $cyc_yr = '2000'; - } elsif ($chem =~ /_tsmlt_mam4/ or $chem =~ /mam4_vbs/) { + } elsif ($chem =~ /_tsmlt_mam4/ or $chem =~ /_tsmlt_mam5/ or $chem =~ /mam4_vbs/) { %species = ( 'NO2 -> ' => 'no2_aircraft_emis_file', 'SO2 -> ' => 'so2_ext_file', 'so4_a1 -> ' => 'so4_a1_ext_file', @@ -1901,6 +1984,16 @@ if (($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) 'num_a4 -> ' => 'mam4_num_a4_ext_file', 'SVOC -> ' => 'svocbb_ext_file' ); $cyc_yr = '2000'; + } elsif ($chem =~ /mam5/) { + %species = ( 'NO2 -> ' => 'no2_aircraft_emis_file', + 'SO2 -> ' => 'so2_ext_file', + 'so4_a1 -> ' => 'so4_a1_ext_file', + 'so4_a2 -> ' => 'so4_a2_ext_file', + 'pom_a4 -> ' => 'pom_a4_ext_file', + 'bc_a4 -> ' => 'bc_a4_ext_file', + 'num_a1 -> ' => 'mam4_num_a1_ext_file', + 'num_a2 -> ' => 'num_a2_ext_file', + 'num_a4 -> ' => 'mam4_num_a4_ext_file' ); } elsif ($chem =~ /mam4/) { %species = ( 'NO2 -> ' => 'no2_aircraft_emis_file', 'SO2 -> ' => 'so2_ext_file', @@ -1947,6 +2040,39 @@ if (($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) } } +if ($chem =~ /geoschem/) { + + # Input directories + add_default($nl, 'geoschem_chem_inputs'); + add_default($nl, 'geoschem_aeropt_inputs'); + add_default($nl, 'geoschem_photol_inputs'); + + # Species with fixed lower boundary + my $val = "'CCL4','CH4','N2O','CO2','CFC11','CFC12','CH3BR','CH3CCL3','CH3CL'" + .",'HCFC22','CFC114','CFC115','HCFC141B','HCFC142B','CH2BR2','CHBR3','H2402'"; + + if ($chem_has_ocs) { + $val .= ",'OCS'"; + } + if (chem_has_species($cfg, 'SF6')) { + $val .= ",'SF6'"; + } + add_default($nl, 'flbc_list', 'val'=>$val); + unless (defined $nl->get_value('flbc_type')) { + add_default($nl, 'flbc_type', 'val'=>'CYCLICAL'); + add_default($nl, 'flbc_cycle_yr', 'val'=>'2000'); + } + + # Datasets + my @files = ( 'flbc_file' ); + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } + foreach my $file (@files) { + add_default($nl, $file); + } +} + if ($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) { my $val; @@ -1980,12 +2106,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); } @@ -2081,23 +2210,43 @@ if ($chem eq 'trop_mam3') { add_default($nl, 'fstrat_list', 'val'=>"' '"); add_default($nl, 'flbc_list', 'val'=>"' '"); - add_default($nl, 'xactive_prates', 'val'=>'.false.'); # Datasets - my @files = ('soil_erod_file', - 'xs_long_file', 'rsf_file', 'exo_coldens_file' ); + my @files = ( 'xs_long_file', 'rsf_file', 'exo_coldens_file' ); + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } foreach my $file (@files) { add_default($nl, $file); } } # CMIP6 emissions -if ($chem =~ /_mam4/ and $phys =~ /cam6/) { +if (($chem =~ /_mam4/ or $chem =~ /_mam5/) and ($phys =~ /cam6/ or $phys =~ /cam7/)) { + + # OASISS (ocean) DMS emissions + if (!$aqua_mode and !$scam) { + my $rel_filepath = get_default_value('dms_ocn_emis_file'); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + my $val = quote_string("DMS -> ". $abs_filepath); + add_default($nl, 'csw_specifier', 'val'=>$val); + add_default($nl, 'bubble_mediated_transfer', 'val'=>'.false.'); + add_default($nl, 'ocean_salinity_file'); + if (!defined $nl->get_value('csw_time_type')) { + add_default($nl, 'csw_time_type', 'val'=>'CYCLICAL'); + add_default($nl, 'csw_cycle_yr', 'val'=>'2000'); + } + if ($nl->get_value('csw_time_type') =~ /CYCLICAL/) { + if ((not defined $nl->get_value('csw_cycle_yr'))) { + die "$ProgName - ERROR: must set csw_cycle_yr when csw_time_type is 'CYCLICAL' \n"; + } + } + } + my %species; # Surface emission datasets: - %species = ('dms_ot_srf_file' => 'DMS', - 'dms_bb_srf_file' => 'DMS', + %species = ('dms_bb_srf_file' => 'DMS', 'so2_ag_sh_file' => 'SO2', 'so2_an_srf_file' => 'SO2', 'so2_bb_srf_file' => 'SO2', @@ -2113,6 +2262,10 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { 'num_a4_oc_srf_file' => 'num_a4', 'num_a4_bb_srf_file' => 'num_a4', 'num_pom_bb_srf_file' => 'num_a4' ); + if ((not defined $nl->get_value('csw_specifier')) or (not $nl->get_value('csw_specifier') ~~ /DMS/)) { + %species = (%species, + 'dms_ot_srf_file' => 'DMS' ); + } if ($chem =~ /_vbsext/) { %species = (%species, 'pom_a4_an_srf_file' => 'pomff1_a4', @@ -2123,8 +2276,8 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { 'pom_a4_bb_srf_file' => 'pom_a4' ); } - # for mechanism missing full tropospheric chemistry - if ($chem =~ /trop_mam/ or $chem =~ /waccm_ma/ or $chem =~ /waccm_sc/) { + # for old simple SOA schemes (without SOAE) + if ($chem =~ /trop_mam3/ or $chem =~ /waccm_ma/) { %species = (%species, 'soag_an_srf_file' => 'SOAG', 'soag_bg_srf_file' => 'SOAG', @@ -2147,14 +2300,8 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { # 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', @@ -2171,8 +2318,6 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { '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', @@ -2181,25 +2326,39 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { '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' ); - if ($chem =~ /trop_strat_mam4_ts2/) { + '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' ); } @@ -2221,7 +2380,7 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { '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', @@ -2230,6 +2389,8 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { } } + # Note, this section might need to be modified if cam7 values + # diverge from cam6 values my %verhash = ('ver'=>'cam6'); my $first = 1; my $pre = ""; @@ -2244,10 +2405,37 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { $first = 0; } } - add_default($nl, 'srf_emis_specifier', 'val'=>$val); - unless (defined $nl->get_value('srf_emis_type')) { - add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); - add_default($nl, 'srf_emis_cycle_yr', 'val'=>2000); + 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', + 'BENZENE_bb_srf_file' => '2.5592D0', + 'ISOP_bb_srf_file' => '0.5954D0', + 'MTERP_bb_srf_file' => '5.1004D0', + 'TOLUENE_an_srf_file' => '8.2367D0', + 'TOLUENE_bb_srf_file' => '8.2367D0', + 'XYLENES_an_srf_file' => '6.5013D0', + 'XYLENES_bb_srf_file' => '6.5013D0', + 'IVOC_an_srf_file' => '8.5371D0', + 'IVOC_bb_srf_file' => '8.5371D0', + 'SVOC_an_srf_file' => '16.650D0', + 'SVOC_bb_srf_file' => '16.650D0'); + foreach my $id (sort keys %soae_fctrs) { + my $rel_filepath = get_default_value($id, \%verhash); + my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir); + $val .= $pre . quote_string("SOAE -> $soae_fctrs{$id}*" . $abs_filepath); + if ($first) { + $pre = ","; + $first = 0; + } + } + } + if ($chem !~ /geoschem/) { + add_default($nl, 'srf_emis_specifier', 'val'=>$val); + unless (defined $nl->get_value('srf_emis_type')) { + add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL'); + add_default($nl, 'srf_emis_cycle_yr', 'val'=>2000); + } } # Vertical emission datasets: @@ -2261,12 +2449,17 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { ); # air craft emissions - if ($chem !~ /trop_mam/ and $chem !~ /waccm_sc/) { + if ($chem !~ /trop_mam/ and $chem !~ /ghg_mam/ and $chem !~ /waccm_sc/) { %species = (%species, 'bc_a4_ar_ext_file' => 'bc_a4', 'num_a4_ar_ext_file' => 'num_a4', 'no2_ar_ext_file' => 'NO2', 'so2_ar_ext_file' => 'SO2' ); + } elsif ($chem =~ /ghg_mam/) { + %species = (%species, + 'bc_a4_ar_ext_file' => 'bc_a4', + 'num_a4_ar_ext_file' => 'num_a4', + 'so2_ar_ext_file' => 'SO2' ); } # for transient cases include volcanic emissions @@ -2308,18 +2501,36 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { $first = 0; } } - add_default($nl, 'ext_frc_specifier', 'val'=>$val); - unless (defined $nl->get_value('ext_frc_type')) { - add_default($nl, 'ext_frc_type', 'val'=>"'CYCLICAL'"); - add_default($nl, 'ext_frc_cycle_yr', 'val'=>2000); + if ($chem !~ /geoschem/) { + add_default($nl, 'ext_frc_specifier', 'val'=>$val); + unless (defined $nl->get_value('ext_frc_type')) { + add_default($nl, 'ext_frc_type', 'val'=>"'CYCLICAL'"); + add_default($nl, 'ext_frc_cycle_yr', 'val'=>2000); + } } # MEGAN emissions + 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 +'," + . "' 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_vbsext/ or $chem =~ /waccm_tsmlt/) { my $val = "'ISOP = isoprene'," - . "'MTERP = pinene_a + carene_3 + thujene_a + 2met_styrene + cymene_p + cymene_o + terpinolene + bornene " - . "+ fenchene_a + ocimene_al + pinene_b + sabinene + camphene + limonene + phellandrene_a + terpinene_g " - . "+ terpinene_a + phellandrene_b + myrcene + ocimene_t_b + ocimene_c_b'," + . "'MTERP = pinene_a + carene_3 + thujene_a + 2met_styrene + cymene_p + cymene_o + terpinolene + bornene +'" + . "' fenchene_a + ocimene_al + pinene_b + sabinene + camphene + limonene + phellandrene_a + terpinene_g +'" + . "' terpinene_a + phellandrene_b + myrcene + ocimene_t_b + ocimene_c_b'," . "'BCARY = caryophyllene_b + bergamotene_a + bisabolene_b + farnescene_b + humulene_a'," . "'CH3OH = methanol'," . "'C2H5OH = ethanol'," @@ -2341,7 +2552,31 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { add_default($nl, 'megan_factors_file'); add_default($nl, 'megan_mapped_emisfctrs', 'val'=>'.false.'); } - if ($chem =~ /trop_strat_mam4_vbs/ ) { + if ($chem =~ /geoschem/) { + my $val = "'ISOP = isoprene'," + . "'MOH = methanol'," + . "'EOH = ethanol'," + . "'CH2O = formaldehyde'," + . "'ALD2 = acetaldehyde'," + . "'ACTA = acetic_acid'," + . "'ACET = acetone'," + . "'HCOOH = formic_acid'," + . "'HCN = hydrogen_cyanide'," + . "'CO = carbon_monoxide'," + . "'C2H6 = ethane'," + . "'C2H4 = ethene'," + . "'C3H8 = propane'," + . "'ALK4 = pentane + hexane + heptane + tricyclene'," + . "'PRPE = propene + butene'," + . "'TOLU = toluene'," + . "'LIMO = limonene'," + . "'MTPA = pinene_a + pinene_b + sabinene + carene_3'," + . "'MTPO = terpinene_g + terpinene_a + terpinolene + myrcene + ocimene_al + ocimene_t_b + ocimene_c_b + thujene_a + 2met_styrene + cymene_p + cymene_o + bornene + fenchene_a + camphene + phellandrene_a + phellandrene_b'"; + 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_vbs/ or $chem =~ /trop_strat_mam5_vbs/) { my $val = "'ISOP = isoprene'," . "'MTERP = 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 " @@ -2380,7 +2615,39 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { add_default($nl, 'megan_factors_file'); add_default($nl, 'megan_mapped_emisfctrs', 'val'=>'.false.'); } - if ($chem =~ /trop_strat_mam4_ts2/ ) { + 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'," . "'BPIN = carene_3 + thujene_a + bornene + fenchene_a + pinene_b + sabinene + camphene + terpineol_4 + terpineol_a + terpinyl_ACT_a'," @@ -2426,10 +2693,10 @@ if ($chem =~ /_mam4/ and $phys =~ /cam6/) { } } -if ($chem eq 'trop_mam4' or $chem eq 'waccm_sc_mam4') { +if (($chem eq 'trop_mam4') or ($chem eq 'waccm_sc_mam4') or ($chem eq 'ghg_mam4')) { # Prescribed species - if ($chem eq 'waccm_sc_mam4') { + if (($chem eq 'waccm_sc_mam4')or($chem eq 'ghg_mam4')) { add_default($nl, 'tracer_cnst_specifier', 'val'=>"'O3','OH','NO3','HO2','HALONS'"); add_default($nl, 'tracer_cnst_file'); add_default($nl, 'tracer_cnst_datapath'); @@ -2450,11 +2717,12 @@ if ($chem eq 'trop_mam4' or $chem eq 'waccm_sc_mam4') { add_default($nl, 'fstrat_list', 'val'=>"' '"); add_default($nl, 'flbc_list', 'val'=>"' '"); - add_default($nl, 'xactive_prates', 'val'=>'.false.'); # 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); } @@ -2540,11 +2808,12 @@ if ($chem eq 'trop_mam7') { add_default($nl, 'fstrat_list', 'val'=>"' '"); add_default($nl, 'flbc_list', 'val'=>"' '"); - add_default($nl, 'xactive_prates', 'val'=>'.false.'); # 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); } @@ -2552,6 +2821,30 @@ if ($chem eq 'trop_mam7') { my $waccmx = $cfg->get('waccmx'); +# set maximum solar zenith angle for photolysis +my $maxzen = 0.0; +if ($waccmx){ + $maxzen = 116.; +} elsif ($chem =~ "trop_strat" or $chem =~ "waccm_") { + $maxzen = 97.01; +} elsif ($chem =~ "trop_mam" or $chem =~ "trop_mozart" or $chem =~ "ghg_mam") { + $maxzen = 88.85; +} +if ($maxzen>0.0) { + add_default($nl, 'photo_max_zen', 'val'=>"${maxzen}D0"); +} + +# upper boundary specifier +my $ubc_ver; +if (($chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/ ) and !$waccmx) { + $ubc_ver = 'waccmchem'; +} elsif ($chem =~ /waccm_sc/) { + $ubc_ver = 'waccmsc'; +} +if (defined $ubc_ver) { + add_default($nl, 'ubc_specifier', 'ver'=>$ubc_ver); +} + # WACCM options. if ($chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/) { @@ -2579,8 +2872,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' ); } @@ -2641,8 +2936,6 @@ if ($chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/) { add_default($nl, 'srf_emis_cycle_yr', 'val'=>'1997'); } - add_default($nl, 'xactive_prates', 'val'=>'.false.'); - if ($dyn eq 'fv') { add_default($nl, 'do_circulation_diags', 'val'=>'.true.'); } @@ -2721,6 +3014,46 @@ else { } } +# Harmonized Emissions Component (HEMCO) options +# Because HEMCO is configured at runtime, all of the options will be +# present in the namelist. +add_default($nl, 'use_hemco'); +if ($nl->get_value('use_hemco') =~ m/$TRUE/io) { + add_default($nl, 'cam_physics_mesh'); + add_default($nl, 'hemco_data_root'); + add_default($nl, 'hemco_config_file'); + add_default($nl, 'hemco_diagn_file'); + add_default($nl, 'hemco_grid_xdim'); + add_default($nl, 'hemco_grid_ydim'); + # Remove these variables if present in the namelist since they are + # ignored at runtime when HEMCO is used. + $nl->delete_variable('chem_inparm', 'ext_frc_specifier'); + $nl->delete_variable('chem_inparm', 'srf_emis_specifier'); + + if ($chem =~ /geoschem/) { + + # For now, HEMCO config and diagnostic configuration files are always used from + # the case directory. Exit if user has specified other paths in the user namelist + # because it will not work. + if ($nl->get_value('hemco_config_file') ne "'" . $inputdata_rootdir . "/HEMCO_Config.rc'") { + die "CAM Namelist ERROR: When running with GEOS-Chem chemistry, hemco_config_file\n". + "must not be manually set in the namelist. Instead, modify (or symlink from) the HEMCO_Config.rc\n". + "in the case directory, which will be copied to the run directory when submitting.\n". + "Then remove the hemco_config_file option from the user namelist.\n"; + } + + if ($nl->get_value('hemco_diagn_file') ne "'" . $inputdata_rootdir . "/HEMCO_Diagn.rc'") { + die "CAM Namelist ERROR: When running with GEOS-Chem chemistry, hemco_diagn_file\n". + "must not be manually set in the namelist. Instead, modify (or symlink from) the HEMCO_Diagn.rc\n". + "in the case directory, which will be copied to the run directory when submitting.\n". + "Then remove the hemco_diagn_file option from the user namelist.\n"; + } + + $nl->set_variable_value('hemco_nl', 'hemco_config_file', "'HEMCO_Config.rc'"); + $nl->set_variable_value('hemco_nl', 'hemco_diagn_file', "'HEMCO_Diagn.rc'"); + } +} + # Physics options # Add the name of the physics package based on the info in configure. If the user tries @@ -2754,20 +3087,15 @@ if ($waccmx) { if (($ionos eq 'none') and ($wmx_opt =~ /ionosphere/) ) { die "CAM Namelist ERROR: WACCMX must be configured with an active ionosphere wmx_opt is set to ionosphere\n"; } - if (($ionos ne 'none') and ($wmx_opt =~ /neutral/) ) { + if (($ionos eq 'wxie') and ($wmx_opt =~ /neutral/) ) { die "CAM Namelist ERROR: WACCMX cannot be configured with an active ionosphere wmx_opt is set to neutral\n"; } - if (($ionos eq 'wxie') and ($wmx_opt =~ /ionosphere/) and ($dyn eq 'fv')) { + if (($ionos eq 'wxie') and ($wmx_opt =~ /ionosphere/)) { # turn on electro-dynamo generated ion drift velocities add_default($nl, 'ionos_xport_active', 'val'=>'.true.'); add_default($nl, 'ionos_edyn_active', 'val'=>'.true.'); add_default($nl, 'empirical_ion_velocities', 'val'=>'.false.'); - } elsif (($ionos eq 'wxi') and ($wmx_opt =~ /ionosphere/) and ($dyn eq 'fv')) { - # turn off electro-dynamo generated ion drift velocities - add_default($nl, 'ionos_xport_active', 'val'=>'.true.'); - add_default($nl, 'ionos_edyn_active', 'val'=>'.false.'); - add_default($nl, 'empirical_ion_velocities', 'val'=>'.true.'); } elsif (($ionos eq 'none') and ($wmx_opt =~ /neutral/)) { add_default($nl, 'ionos_xport_active', 'val'=>'.false.'); add_default($nl, 'ionos_edyn_active', 'val'=>'.false.'); @@ -2778,6 +3106,11 @@ if ($waccmx) { if ($dyn eq 'fv') { add_default($nl, 'fv_high_altitude', 'val'=>'.true.'); } + if ($ionos ne 'none') { + add_default($nl, 'cam_physics_mesh'); + add_default($nl, 'oplus_grid'); + add_default($nl, 'edyn_grid'); + } add_default($nl,'dadadj_niter'); add_default($nl,'ionos_epotential_model'); if ($nl->get_value('ionos_epotential_model') =~ 'weimer') { @@ -2787,6 +3120,7 @@ if ($waccmx) { add_default($nl,'ionos_xport_nsplit'); add_default($nl,'steady_state_ion_elec_temp', 'val'=>'.false.'); add_default($nl,'oplus_ring_polar_filter'); + add_default($nl,'rxn_rate_sums'); } # Chemistry options @@ -2804,6 +3138,15 @@ $epp_gcr_file =~ s/['"]//g; # strip quotes "' $epp_mee_file =~ s/['"]//g; # strip quotes "' $gcr_ion_file =~ s/['"]//g; # strip quotes "' +if ($nl->get_value('mee_ion_inline') =~ m/$TRUE/io) { + if ((defined $epp_mee_file) and ($epp_mee_file ne 'NONE') and + ($nl->get_value('mee_ion_diagonly') !~ m/$TRUE/io)) { + die "Cannot specify both epp_mee_filepath and mee_ion_inline without mee_ion_diagonly set to .true.\n"; + } + # Set default bounce cone loss angle. + add_default($nl, 'mee_ion_blc'); +} + if ($gcr_ion_file and $gcr_ion_file ne 'NONE') { if (($epp_all_file and $epp_all_file ne 'NONE') or ($epp_gcr_file and $epp_gcr_file ne 'NONE')) { die "CAM Namelist ERROR: Conflicting GCR inputs specified. Variable gcr_ionization_filename". @@ -2832,23 +3175,34 @@ $cam_chempkg = "'" . "$chem" . "'"; # add quotes to this string value $nl->set_variable_value('phys_ctl_nl', 'cam_chempkg', $cam_chempkg); -# Check the snapshot settings. -add_default($nl, 'cam_snapshot_before_num'); -add_default($nl, 'cam_snapshot_after_num'); -check_snapshot_settings(); - # Tropopause climatology if (!$simple_phys) { add_default($nl, 'tropopause_climo_file'); } # tropopause level used in gas-phase / aerosol processes -if (($chem ne 'none') and ($chem ne 'terminator')) { +if (($chem ne 'none') and ($chem ne 'terminator') and !($chem =~ /geoschem/)) { add_default($nl, 'chem_use_chemtrop'); } # Deep convection scheme add_default($nl, 'deep_scheme'); +my $deep_scheme = $nl->get_value('deep_scheme'); + +# Aerosol convective processes +if (($phys =~ /cam6/ or $phys =~ /cam7/) and $deep_scheme =~ /ZM/) { + add_default($nl, 'convproc_do_aer', 'val'=>'.true.'); + add_default($nl, 'convproc_do_evaprain_atonce', 'val'=>'.true.'); + add_default($nl, 'convproc_pom_spechygro', 'val'=>'0.2D0'); + add_default($nl, 'convproc_wup_max', 'val'=>'4.0D0'); +} + +# cam7 specific namelists +if ($phys =~ /cam7/ and $deep_scheme =~ /ZM/) { + add_default($nl, 'zmconv_parcel_pbl', 'val'=>'.true.'); +} else { + add_default($nl, 'zmconv_parcel_pbl', 'val'=>'.false.'); +} # Radiation scheme add_default($nl, 'radiation_scheme', 'val'=>$rad_pkg); @@ -2877,7 +3231,6 @@ if ($cfg->get('microphys') =~ /^mg/) { add_default($nl, 'nucleate_ice_subgrid_strat'); add_default($nl, 'nucleate_ice_use_troplev'); add_default($nl, 'cld_macmic_num_steps', 'dtime'=>$dtime); - add_default($nl, 'micro_mg_dcs'); add_default($nl, 'micro_mg_precip_frac_method'); add_default($nl, 'micro_mg_berg_eff_factor'); add_default($nl, 'nucleate_ice_incloud'); @@ -2886,11 +3239,75 @@ if ($cfg->get('microphys') =~ /^mg/) { add_default($nl, 'micro_mg_do_graupel'); add_default($nl, 'graupel_in_rad'); add_default($nl, 'micro_do_massless_droplet_destroyer'); - + add_default($nl, 'micro_mg_accre_enhan_fact'); + add_default($nl, 'micro_mg_autocon_fact'); + add_default($nl, 'micro_mg_autocon_nd_exp'); + add_default($nl, 'micro_mg_autocon_lwp_exp'); + add_default($nl, 'micro_mg_homog_size'); + add_default($nl, 'micro_mg_vtrmi_factor'); + add_default($nl, 'micro_mg_effi_factor'); + add_default($nl, 'micro_mg_iaccr_factor'); + add_default($nl, 'micro_mg_max_nicons'); + + + # namelist options for pumas tag release_v1.22 or later + # (currently only in the cam7 physics package) + if ($phys =~ /cam7/) { + add_default($nl, 'micro_mg_warm_rain'); + add_default($nl, 'micro_mg_accre_sees_auto'); + add_default($nl, 'micro_mg_vtrms_factor'); + add_default($nl, 'micro_mg_implicit_fall'); + add_default($nl, 'pumas_stochastic_tau_kernel_filename', 'val'=>"$cfgdir/../src/physics/pumas/KBARF_tau_kernel.dat"); + + #set path for stochastic_tau_kernel_filename + my $cam_dir = $cfg->get('cam_dir'); + add_default($nl, 'pumas_stochastic_tau_kernel_filename'); + my $rel_path = $nl->get_value('pumas_stochastic_tau_kernel_filename'); + 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 - add_default($nl, 'micro_do_sb_physics', 'val'=>'.false.'); + # This variable is replaced with micro_mg_warm_rain in cam7 runs + add_default($nl, 'micro_do_sb_physics', 'val'=>'.false.'); + } + + # tunings for micro_mg_dcs + my $microphys = $cfg->get('microphys'); + my $hgrid = $cfg->get('hgrid'); + my $silhs = $cfg->get('silhs'); + + my $micro_mg_dcs = '400.D-6'; # default for cam5/mg1 + + if ($microphys =~ /mg2|mg3/) { + if ($silhs eq '1') { + $micro_mg_dcs = '390.D-6'; # default for SIHLS + } + elsif ($hgrid =~ /1.9x2.5/ and $phys eq 'cam6') { + $micro_mg_dcs = '200.D-6'; + } + elsif ($phys eq 'cam6') { + $micro_mg_dcs = '500.D-6'; + } + elsif ($phys eq 'cam7') { + $micro_mg_dcs = '500.D-6'; + } + } + + + add_default($nl, 'micro_mg_dcs', 'val'=>$micro_mg_dcs); } +# Aerosol Namelist options +add_default($nl, 'microp_aero_bulk_scale'); +add_default($nl, 'microp_aero_npccn_scale'); +add_default($nl, 'microp_aero_wsub_scale'); +add_default($nl, 'microp_aero_wsubi_scale'); +add_default($nl, 'microp_aero_wsub_min'); +add_default($nl, 'microp_aero_wsub_min_asf'); +add_default($nl, 'microp_aero_wsubi_min'); + # Ice nucleation options if (!$simple_phys) { if ($chem =~ /_mam/) { @@ -2898,6 +3315,11 @@ if (!$simple_phys) { } else { add_default($nl, 'use_hetfrz_classnuc', 'val'=>'.false.'); } + if ($nl->get_value('use_hetfrz_classnuc') =~ m/$TRUE/io) { + # set default scaling factors if het frz is turned on + add_default($nl, 'hetfrz_bc_scalfac'); + add_default($nl, 'hetfrz_dust_scalfac'); + } add_default($nl, 'use_preexisting_ice'); if ($chem =~ /_mam7/) { if ($nl->get_value('use_preexisting_ice') =~ m/$TRUE/io) { @@ -2975,6 +3397,12 @@ if ($use_subcol_microp =~ /$TRUE/io) { } # CLUBB_SGS +my $do_clubb_sgs = $nl->get_value('do_clubb_sgs'); +if (defined $do_clubb_sgs) { + die "CAM Namelist ERROR: User may not specify the value of do_clubb_sgs.\n". + "This variable is set by build-namelist based on information\n". + "from the configure cache file.\n"; +} add_default($nl, 'do_clubb_sgs'); my $clubb_sgs = $nl->get_value('do_clubb_sgs'); if ($clubb_sgs =~ /$TRUE/io) { @@ -2990,67 +3418,157 @@ if ($clubb_sgs =~ /$TRUE/io) { } add_default($nl, 'clubb_do_icesuper'); - - add_default($nl, 'clubb_expldiff'); - add_default($nl, 'clubb_rainevap_turb'); + add_default($nl, 'clubb_do_energyfix'); add_default($nl, 'clubb_cloudtop_cooling'); - add_default($nl, 'clubb_timestep'); + add_default($nl, 'clubb_rainevap_turb'); add_default($nl, 'clubb_rnevap_effic'); - add_default($nl, 'clubb_beta'); - add_default($nl, 'clubb_c1'); - add_default($nl, 'clubb_c1b'); - add_default($nl, 'clubb_c11'); - add_default($nl, 'clubb_c11b'); - add_default($nl, 'clubb_c14'); - add_default($nl, 'clubb_C2rt'); - add_default($nl, 'clubb_C2thl'); - add_default($nl, 'clubb_C2rtthl'); - add_default($nl, 'clubb_C4'); + add_default($nl, 'clubb_timestep'); + add_default($nl, 'clubb_l_diag_Lscale_from_tau'); + + my $clubb_Lscale_from_tau = $nl->get_value('clubb_l_diag_Lscale_from_tau'); + + if($clubb_Lscale_from_tau =~ "true") { + add_default($nl, 'clubb_beta', 'val'=>2.27756371212011); + add_default($nl, 'clubb_c1', 'val'=>1.0); + add_default($nl, 'clubb_c1b', 'val'=>1.0); + add_default($nl, 'clubb_c11', 'val'=>0.31057411754034614); + add_default($nl, 'clubb_c11b', 'val'=>0.3250718127387944); + add_default($nl, 'clubb_c14', 'val'=>1.0); + add_default($nl, 'clubb_C2rt', 'val'=>1.0); + add_default($nl, 'clubb_C2rtthl', 'val'=>1.0); + add_default($nl, 'clubb_C2thl', 'val'=>1.0); + add_default($nl, 'clubb_C4', 'val'=>5.2); + add_default($nl, 'clubb_c6rt', 'val'=>2.0); + add_default($nl, 'clubb_c6rtb', 'val'=>2.0); + add_default($nl, 'clubb_c6rtc', 'val'=>1.0); + add_default($nl, 'clubb_c6thl', 'val'=>2.0); + add_default($nl, 'clubb_c6thlb', 'val'=>2.0); + add_default($nl, 'clubb_c6thlc', 'val'=>1.0); + add_default($nl, 'clubb_C8', 'val'=>3.440377776099962); + add_default($nl, 'clubb_C8b', 'val'=>0.0); + add_default($nl, 'clubb_C_invrs_tau_bkgnd', 'val'=>3.727123755772682); + add_default($nl, 'clubb_C_invrs_tau_sfc', 'val'=>0.12743072568015346); + add_default($nl, 'clubb_C_invrs_tau_shear', 'val'=>0.12502726304767026); + add_default($nl, 'clubb_C_invrs_tau_N2', 'val'=>0.08122667220596895); + add_default($nl, 'clubb_C_invrs_tau_N2_clear_wp3', 'val'=>1.0); + add_default($nl, 'clubb_C_invrs_tau_N2_wp2', 'val'=>0.1); + add_default($nl, 'clubb_C_invrs_tau_N2_wpxp', 'val'=>0.0); + add_default($nl, 'clubb_C_invrs_tau_N2_xp2', 'val'=>0.05); + add_default($nl, 'clubb_C_uu_buoy', 'val'=>0.3); + add_default($nl, 'clubb_C_uu_shr', 'val'=>0.1076484659222455); + add_default($nl, 'clubb_gamma_coef', 'val'=>0.5492223674353673); + add_default($nl, 'clubb_gamma_coefb', 'val'=>0.2531868210746816); + } else { + add_default($nl, 'clubb_beta'); + add_default($nl, 'clubb_c1'); + add_default($nl, 'clubb_c1b'); + add_default($nl, 'clubb_c11'); + add_default($nl, 'clubb_c11b'); + add_default($nl, 'clubb_c14'); + add_default($nl, 'clubb_C2rt'); + add_default($nl, 'clubb_C2rtthl'); + add_default($nl, 'clubb_C2thl'); + add_default($nl, 'clubb_C4'); + add_default($nl, 'clubb_c6rt'); + add_default($nl, 'clubb_c6rtb'); + add_default($nl, 'clubb_c6rtc'); + add_default($nl, 'clubb_c6thl'); + add_default($nl, 'clubb_c6thlb'); + add_default($nl, 'clubb_c6thlc'); + add_default($nl, 'clubb_C8'); + add_default($nl, 'clubb_C8b'); + add_default($nl, 'clubb_C_invrs_tau_bkgnd'); + add_default($nl, 'clubb_C_invrs_tau_sfc'); + add_default($nl, 'clubb_C_invrs_tau_shear'); + add_default($nl, 'clubb_C_invrs_tau_N2'); + add_default($nl, 'clubb_C_invrs_tau_N2_clear_wp3'); + add_default($nl, 'clubb_C_invrs_tau_N2_wp2'); + add_default($nl, 'clubb_C_invrs_tau_N2_wpxp'); + add_default($nl, 'clubb_C_invrs_tau_N2_xp2'); + add_default($nl, 'clubb_C_uu_buoy'); + add_default($nl, 'clubb_C_uu_shr'); + add_default($nl, 'clubb_gamma_coef'); + add_default($nl, 'clubb_gamma_coefb'); + } + + add_default($nl, 'clubb_bv_efold'); add_default($nl, 'clubb_C7'); add_default($nl, 'clubb_C7b'); - add_default($nl, 'clubb_C8'); - add_default($nl, 'clubb_C8b'); - add_default($nl, 'clubb_c_K9'); - add_default($nl, 'clubb_nu9'); + add_default($nl, 'clubb_c_K1'); add_default($nl, 'clubb_c_K10'); add_default($nl, 'clubb_c_K10h'); + add_default($nl, 'clubb_c_K2'); + add_default($nl, 'clubb_c_K8'); + add_default($nl, 'clubb_c_K9'); + add_default($nl, 'clubb_C_wp2_splat'); + add_default($nl, 'clubb_C_wp3_pr_turb'); + add_default($nl, 'clubb_detice_rad'); + add_default($nl, 'clubb_detliq_rad'); + add_default($nl, 'clubb_detphase_lowtemp'); + add_default($nl, 'clubb_do_energyfix'); add_default($nl, 'clubb_do_liqsupersat'); - add_default($nl, 'clubb_gamma_coef'); - add_default($nl, 'clubb_gamma_coefb'); + add_default($nl, 'clubb_ipdf_call_placement'); add_default($nl, 'clubb_lambda0_stability_coef'); add_default($nl, 'clubb_lmin_coef'); - add_default($nl, 'clubb_mult_coef'); - add_default($nl, 'clubb_Skw_denom_coef'); - add_default($nl, 'clubb_skw_max_mag'); - add_default($nl, 'clubb_up2_vp2_factor'); - add_default($nl, 'clubb_C_wp2_splat'); - add_default($nl, 'clubb_l_brunt_vaisala_freq_moist'); add_default($nl, 'clubb_l_call_pdf_closure_twice'); + add_default($nl, 'clubb_l_damp_wp2_using_em'); add_default($nl, 'clubb_l_damp_wp3_Skw_squared'); + add_default($nl, 'clubb_l_do_expldiff_rtm_thlm'); + add_default($nl, 'clubb_l_e3sm_config'); + add_default($nl, 'clubb_l_enable_relaxed_clipping'); + add_default($nl, 'clubb_l_godunov_upwind_wpxp_ta'); + add_default($nl, 'clubb_l_godunov_upwind_xpyp_ta'); + add_default($nl, 'clubb_l_intr_sfc_flux_smooth'); + add_default($nl, 'clubb_l_lmm_stepping'); add_default($nl, 'clubb_l_lscale_plume_centered'); add_default($nl, 'clubb_l_min_wp2_from_corr_wx'); add_default($nl, 'clubb_l_min_xp2_from_corr_wx'); + add_default($nl, 'clubb_l_mono_flux_lim_rtm'); + add_default($nl, 'clubb_l_mono_flux_lim_spikefix'); + add_default($nl, 'clubb_l_mono_flux_lim_thlm'); + add_default($nl, 'clubb_l_mono_flux_lim_um'); + add_default($nl, 'clubb_l_mono_flux_lim_vm'); + add_default($nl, 'clubb_l_partial_upwind_wp3'); add_default($nl, 'clubb_l_predict_upwp_vpwp'); add_default($nl, 'clubb_l_rcm_supersat_adj'); + add_default($nl, 'clubb_l_smooth_Heaviside_tau_wpxp'); add_default($nl, 'clubb_l_stability_correct_tau_zm'); + add_default($nl, 'clubb_l_standard_term_ta'); add_default($nl, 'clubb_l_trapezoidal_rule_zm'); add_default($nl, 'clubb_l_trapezoidal_rule_zt'); add_default($nl, 'clubb_l_upwind_xpyp_ta'); - add_default($nl, 'clubb_l_use_C7_Richardson'); add_default($nl, 'clubb_l_use_C11_Richardson'); + add_default($nl, 'clubb_l_use_C7_Richardson'); add_default($nl, 'clubb_l_use_cloud_cover'); - add_default($nl, 'clubb_l_use_ice_latent'); + add_default($nl, 'clubb_l_use_shear_Richardson'); add_default($nl, 'clubb_l_use_thvm_in_bv_freq'); + add_default($nl, 'clubb_l_use_tke_in_wp2_wp3_K_dfsn'); + add_default($nl, 'clubb_l_use_tke_in_wp3_pr_turb_term'); + add_default($nl, 'clubb_l_vary_convect_depth'); add_default($nl, 'clubb_l_vert_avg_closure'); - add_default($nl, 'clubb_l_diag_Lscale_from_tau'); - add_default($nl, 'clubb_l_damp_wp2_using_em'); + add_default($nl, 'clubb_mult_coef'); + add_default($nl, 'clubb_nu2'); + add_default($nl, 'clubb_nu9'); + add_default($nl, 'clubb_penta_solve_method'); + add_default($nl, 'clubb_Skw_denom_coef'); + add_default($nl, 'clubb_skw_max_mag'); + add_default($nl, 'clubb_tridiag_solve_method'); + add_default($nl, 'clubb_up2_sfc_coef'); + add_default($nl, 'clubb_wpxp_L_thresh'); + add_default($nl, 'clubb_wpxp_Ri_exp'); + add_default($nl, 'clubb_z_displace'); + + #CLUBB+MF options add_default($nl, 'do_clubb_mf'); add_default($nl, 'do_clubb_mf_diag'); add_default($nl, 'clubb_mf_L0'); add_default($nl, 'clubb_mf_ent0'); add_default($nl, 'clubb_mf_nup'); + + #Turn on HB scheme where CLUBB not active + add_default($nl, 'do_hb_above_clubb'); } # Tuning for wet scavenging of modal aerosols @@ -3121,7 +3639,10 @@ if (!$simple_phys) { add_default($nl, 'cldfrc2m_rhmaxi'); add_default($nl, 'cldfrc2m_rhminis'); add_default($nl, 'cldfrc2m_rhmaxis'); + add_default($nl, 'cldfrc2m_qist_min'); + add_default($nl, 'cldfrc2m_qist_max'); add_default($nl, 'cldfrc2m_do_subgrid_growth'); + add_default($nl, 'cldfrc2m_do_avg_aist_algs'); } my $rk_strat_polstrat_rhmin = $nl->get_value('rk_strat_polstrat_rhmin'); @@ -3137,9 +3658,11 @@ if (!$simple_phys) { add_default($nl, 'zmconv_c0_ocn'); add_default($nl, 'zmconv_ke'); add_default($nl, 'zmconv_ke_lnd'); - add_default($nl, 'zmconv_org'); - add_default($nl, 'zmconv_microp'); add_default($nl, 'zmconv_num_cin'); + add_default($nl, 'zmconv_dmpdz'); + add_default($nl, 'zmconv_tiedke_add'); + add_default($nl, 'zmconv_capelmt'); + add_default($nl, 'zmconv_tau'); } # moist convection rainwater coefficients @@ -3163,7 +3686,7 @@ if ($cfg->get('microphys') eq 'rk') { } # Eddy Diffusivity Adjustments -if ($cfg->get('pbl') eq "uw" or $cfg->get('pbl') eq "spcam_m2005") { +if ($cfg->get('pbl') eq "uw") { add_default($nl, 'kv_top_pressure'); add_default($nl, 'kv_top_scale'); add_default($nl, 'kv_freetrop_scale'); @@ -3190,23 +3713,21 @@ 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 =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/ or $chem =~ /trop_mozart/) { - add_default($nl, 'dust_emis_fact', 'ver'=>'chem'); - # set scaling of lightning NOx production - add_default($nl, 'lght_no_prd_factor' ); - } - else { - add_default($nl, 'dust_emis_fact'); - } + add_default($nl, 'dust_emis_fact'); } } +if (chem_has_species($cfg, 'NO')) { + # set scaling of lightning NOx production + add_default($nl, 'lght_no_prd_factor' ); +} # Seasalt emissions tuning factor if ($chem =~ /_mam(\d)/) { @@ -3232,7 +3753,7 @@ if ($chem =~ /_mam(\d)/) { # By default, orographic waves are always on if (!$simple_phys) { - if ($phys =~ /cam6/) { + if ($phys =~ /cam6/ or $phys =~ /cam7/) { add_default($nl, 'use_gw_oro', 'val'=>'.false.'); @@ -3249,6 +3770,18 @@ if (!$simple_phys) { add_default($nl, 'use_gw_rdg_beta', 'val'=>'.false.'); } + if ($phys =~ /cam7/) { + add_default($nl, 'use_gw_movmtn_pbl', 'val'=>'.true.'); + } + + my $use_gw_movmtn_pbl = $nl->get_value('use_gw_movmtn_pbl'); + if ($use_gw_movmtn_pbl =~ /$TRUE/io) { + if ( ! ($dyn =~ /se/) ) { + die "$ProgName - ERROR: use_gw_movmtn_pbl is only available with the SE dycore \n"; + + } + } + 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.'); @@ -3262,24 +3795,44 @@ if (!$simple_phys) { add_default($nl, 'gw_rdg_do_divstream' , 'val'=>'.true.'); } +my $use_gw_convect_dp = '.false.'; if ($waccm_phys or - (!$simple_phys and $cfg->get('nlev') >= 60)) { + (!$simple_phys and $cfg->get('model_top') eq 'mt')) { # Spectral gravity waves are part of WACCM physics, and also drive the # QBO in the high vertical resolution configuration. add_default($nl, 'use_gw_front' , 'val'=>'.true.'); - add_default($nl, 'use_gw_convect_dp', 'val'=>'.true.'); + $use_gw_convect_dp = '.true.'; my $hdepth_scaling = '0.25D0' ; + my $qbo_forcing = '.false.'; + if ($dyn eq 'fv') { + my $nlon = $cfg->get('nlon'); + my $nlat = $cfg->get('nlat'); + # turn on QBO nudging only for coarse FV grids + if ($nlat <= 96 and $nlon <= 144) { + $qbo_forcing = '.true.'; + } + } + add_default($nl, 'qbo_use_forcing','val'=>$qbo_forcing); if ($nl->get_value('qbo_use_forcing') =~ /$TRUE/io) { $hdepth_scaling = '1.D0' ; - add_default($nl, 'qbo_cyclic','val'=>'.true.'); + add_default($nl, 'qbo_cyclic','val'=>'.false.'); add_default($nl, 'qbo_forcing_file'); } add_default($nl, 'gw_qbo_hdepth_scaling', 'val'=>$hdepth_scaling); add_default($nl, 'gw_top_taper'); +} elsif ($phys =~ /cam7/) { + # cam7 settings for model_top = 'lt' + add_default($nl, 'use_gw_front' , 'val'=>'.true.'); + $use_gw_convect_dp = '.true.'; + add_default($nl, 'gw_qbo_hdepth_scaling', 'val'=>'1.0D0'); } else { add_default($nl, 'use_gw_front' , 'val'=>'.false.'); - add_default($nl, 'use_gw_convect_dp', 'val'=>'.false.'); } +# Check if deep convection scheme used. If not set use_gw_convect_dp=.false. +if ($deep_scheme =~ /off/) { + $use_gw_convect_dp = '.false.'; +} +add_default($nl, 'use_gw_convect_dp', 'val'=>$use_gw_convect_dp); # We need a lot of logic to use these below, so make flags for them. my $do_gw_oro = ($nl->get_value('use_gw_oro') =~ /$TRUE/io); @@ -3287,15 +3840,13 @@ my $do_gw_front = ($nl->get_value('use_gw_front') =~ /$TRUE/io); my $do_gw_front_igw = ($nl->get_value('use_gw_front_igw') =~ /$TRUE/io); my $do_gw_convect_dp = ($nl->get_value('use_gw_convect_dp') =~ /$TRUE/io); my $do_gw_convect_sh = ($nl->get_value('use_gw_convect_sh') =~ /$TRUE/io); +my $do_gw_movmtn_pbl = ($nl->get_value('use_gw_movmtn_pbl') =~ /$TRUE/io); my $do_gw_rdg_beta = ($nl->get_value('use_gw_rdg_beta') =~ /$TRUE/io); my $do_gw_rdg_gamma = ($nl->get_value('use_gw_rdg_gamma') =~ /$TRUE/io); +my $do_gw_rdg_resid = ($nl->get_value('use_gw_rdg_resid') =~ /$TRUE/io); my $do_divstream = ($nl->get_value('gw_rdg_do_divstream') =~ /$TRUE/io); -if (!$simple_phys) { - # GW option used only for backwards compatibility with CAM3. - add_default($nl, 'fcrit2', 'val'=>'1.0'); -} # Mid-scale wavelength settings. if ($do_gw_front or $do_gw_convect_dp or $do_gw_convect_sh) { add_default($nl, 'pgwv'); @@ -3331,6 +3882,7 @@ if ($do_gw_front_igw) { if ($do_gw_front or $do_gw_front_igw) { add_default($nl, 'frontgfc'); + add_default($nl, 'front_gaussian_width'); } if ($do_gw_convect_dp) { @@ -3343,13 +3895,22 @@ 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'); + add_default($nl, 'effgw_movmtn_pbl'); + add_default($nl, 'movmtn_source'); + add_default($nl, 'movmtn_psteer'); + add_default($nl, 'movmtn_plaunch'); +} + 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"; } add_default($nl, 'n_rdg_beta', 'val'=>'10'); - add_default($nl, 'effgw_rdg_beta', 'val'=>'1.0D0'); - add_default($nl, 'effgw_rdg_beta_max', 'val'=>'1.0D0'); + add_default($nl, 'effgw_rdg_beta'); + add_default($nl, 'effgw_rdg_beta_max'); add_default($nl, 'trpd_leewv_rdg_beta', 'val'=>'.false.'); add_default($nl, 'rdg_beta_cd_llb', 'val'=>'1.0D0'); } @@ -3360,6 +3921,10 @@ if ($do_gw_rdg_beta) { add_default($nl, 'gw_prndl'); } +if ($do_gw_rdg_resid) { + add_default($nl, 'effgw_rdg_resid' ); +} + if ($do_gw_rdg_gamma) { add_default($nl, 'n_rdg_gamma', 'val'=>'-1'); add_default($nl, 'effgw_rdg_gamma', 'val'=>'1.0D0'); @@ -3405,7 +3970,9 @@ if (($do_gw_rdg_beta or $do_gw_rdg_gamma)) { # use tau_0_ubc = .false. to avoid changing answers. if ((not $waccm_phys) and ($do_gw_front or $do_gw_front_igw or - $do_gw_convect_dp or $do_gw_convect_sh)) { + $do_gw_convect_dp or $do_gw_convect_sh )) { + add_default($nl, 'tau_0_ubc', 'val'=>'.true.'); +} elsif ($phys =~ /cam7/) { add_default($nl, 'tau_0_ubc', 'val'=>'.true.'); } elsif (!$simple_phys) { add_default($nl, 'tau_0_ubc', 'val'=>'.false.'); @@ -3512,30 +4079,33 @@ if ( $dyn eq 'fv3') { } -# EUL dycore -if ($dyn eq 'eul') { - add_default($nl, 'eul_dif2_coef'); - add_default($nl, 'eul_hdif_order'); - add_default($nl, 'eul_hdif_kmnhdn'); - add_default($nl, 'eul_hdif_coef'); - add_default($nl, 'eul_divdampn'); - add_default($nl, 'eul_tfilt_eps'); - add_default($nl, 'eul_kmxhdc'); - add_default($nl, 'eul_nsplit'); -} - -# SLD dycore -if ($dyn eq 'sld') { - add_default($nl, 'sld_dif2_coef'); - add_default($nl, 'sld_dif4_coef'); - add_default($nl, 'sld_divdampn'); - add_default($nl, 'sld_tfilt_eps'); - add_default($nl, 'sld_kmxhdc'); -} - # 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 @@ -3572,8 +4142,6 @@ if ($dyn =~ /se/) { my @vars = qw( se_ftype se_horz_num_threads - se_hypervis_dynamic_ref_state - se_lcp_moist se_large_Courant_incr se_hypervis_subcycle se_hypervis_subcycle_sponge @@ -3584,6 +4152,9 @@ if ($dyn =~ /se/) { se_nu_div se_nu_p se_nu_top + se_sponge_del4_nu_fac + se_sponge_del4_nu_div_fac + se_sponge_del4_lev se_qsplit se_rsplit se_statediag_numtrac @@ -3598,11 +4169,9 @@ if ($dyn =~ /se/) { se_fvm_supercycling_jet se_kmin_jet se_kmax_jet - se_phys_dyn_cp - se_raytau0 - se_raykrange - se_rayk0 se_molecular_diff + se_pgf_formulation + se_dribble_in_rsplit_loop ); my %opts; @@ -3690,6 +4259,14 @@ if ($dyn =~ /mpas/) { add_default($nl, 'mpas_h_ScaleWithMesh'); add_default($nl, 'mpas_zd'); add_default($nl, 'mpas_xnutr'); + add_default($nl, 'mpas_cam_coef'); + add_default($nl, 'mpas_cam_damping_levels'); + add_default($nl, 'mpas_print_detailed_minmax_vel'); + add_default($nl, 'mpas_rayleigh_damp_u'); + add_default($nl, 'mpas_rayleigh_damp_u_timescale_days'); + add_default($nl, 'mpas_number_rayleigh_damp_u_levels'); + add_default($nl, 'mpas_apply_lbcs'); + add_default($nl, 'mpas_jedi_da'); add_default($nl, 'mpas_do_restart'); add_default($nl, 'mpas_print_global_minmax_vel'); add_default($nl, 'mpas_print_detailed_minmax_vel'); @@ -3701,23 +4278,11 @@ if ($dyn =~ /mpas/) { add_default($nl, 'mpas_block_decomp_file_prefix'); } - # invoke MPAS utility to generate streams files - my $mpas_libdir = $cfg->get('mpas_libdir'); - - # Check that the executable file streams_gen is present. streams_gen is built - # at the same time as the MPAS library. This allows build-namelist - # to be called before the MPAS library is built (via CESM scripts). - if ( -x "$mpas_libdir/streams_gen") { - - my $cmnd = "$mpas_libdir/streams_gen $mpas_libdir/Registry_processed.xml ". - "streams.atmosphere stream_list.atmosphere. listed "; - - system($cmnd) == 0 or die - "$ProgName - ERROR: generating MPAS streams files via command:\n". - "$cmnd"; - } } +# Defaults for scaling initial pressure +add_default($nl, 'scale_dry_air_mass'); + # Defaults for history output add_default($nl, 'history_amwg'); add_default($nl, 'history_vdiag'); @@ -3783,11 +4348,6 @@ if ($offline_drv ne 'stub') { } } -if ($phys eq 'spcam_sam1mom' or $phys eq 'spcam_m2005') { - add_default($nl, 'iradsw', 'val'=>'1'); - add_default($nl, 'iradlw', 'val'=>'1'); -} - #----------------------------------------------------------------------------------------------- # Rename component logfiles. # @@ -3826,6 +4386,26 @@ foreach my $comp (@comps) { } } +# Check the snapshot settings. +add_default($nl, 'cam_snapshot_before_num'); +add_default($nl, 'cam_snapshot_after_num'); +check_snapshot_settings(); + +if ($opts{'cmeps'}) { + # advertise the nature of ozone data passed to surface models + if ($rad_prog_ozone) { + add_default($nl, 'atm_ozone_frequency', 'val'=>'subdaily'); + } else { + add_default($nl, 'atm_ozone_frequency', 'val'=>'multiday_average'); + } + # for lightning flash freq to CTSM + if ($simple_phys or $aqua_mode) { + add_default($nl, 'atm_provides_lightning', 'val'=>'.false.'); + } else { + add_default($nl, 'atm_provides_lightning', 'val'=>'.true.'); + } +} + #----------------------------------------------------------------------------------------------- # Write output files @@ -3841,8 +4421,9 @@ my $outfile; my %nl_group = (); foreach my $name (@nl_groups) { $nl_group{$name} = ''; } -# Dry deposition and MEGAN VOC emis namelists -@comp_groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm ndep_inparm); +# 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 dust_emis_inparm); + $outfile = "$opts{'dir'}/drv_flds_in"; $nl->write($outfile, 'groups'=>\@comp_groups); if ($print>=1) { @@ -3998,7 +4579,7 @@ sub add_default { # # ***** N.B. ***** This routine assumes the following variables are in package main:: # $definition -- the namelist definition object -# $inputdata_rootdir -- CCSM inputdata root directory +# $inputdata_rootdir -- CESM inputdata root directory my $nl = shift; # namelist object my $var = shift; # name of namelist variable @@ -4051,7 +4632,7 @@ sub add_default { # The default values for input pathnames are relative. If the namelist # variable is defined to be an absolute pathname, then prepend - # the CCSM inputdata root directory. + # the CESM inputdata root directory. if ($is_input_pathname eq 'abs') { $val = set_abs_filepath($val, $inputdata_rootdir); } @@ -4221,6 +4802,37 @@ sub fv3_decomp_set{ #----------------------------------------------------------------------------------------------- +sub check_user_input { + +# Check that user input in the user_nl_cam file is consistent with input that has been set by +# the compset definition via CAM_NAMELIST_OPTS. This routine is called after build-namelist has +# processed both the -namelist argument which contains the input from CAM_NAMELIST_OPTS, and +# the -infile argument which contains input from user_nl_cam. +# +# Checks for specific inconsistencies are added here by CAM developers as deemed useful for +# improving robustness of the user interface. + + my $nl = shift; # namelist object + + # When HEMCO is being used any emissions or external forcings specified by the + # srf_emis_specifier and ext_frc_specifier variables will be ignored at runtime. + # Check here that these variable are not set if the compset definition sets + # use_hemco=.true. + + my $hemco = $nl->get_value('use_hemco'); + if (defined $hemco and $hemco =~ m/$TRUE/io) { + if (defined $nl->get_value('srf_emis_specifier') or + defined $nl->get_value('ext_frc_specifier') ) { + die "$ProgName - ERROR: It is not allowed to set either srf_emis_specifier \n", + " or ext_frc_specifier when HEMCO is used.\n"; + } + } + + +} + +#----------------------------------------------------------------------------------------------- + sub check_input_files { # For each variable in the namelist which is an input dataset, or contains filepaths @@ -4271,7 +4883,7 @@ sub check_input_files { if ($var eq 'mpas_block_decomp_file_prefix') { $pathname = "$pathname$opts{'ntasks'}"; } - + print $fh "$var = $pathname\n"; } else { @@ -4312,9 +4924,10 @@ sub check_input_files { # Treat special cases... # These namelist variables are arrays of strings. - my @vars = qw(aircraft_specifier ext_frc_specifier srf_emis_specifier mode_defs - rad_climate rad_diag_1 rad_diag_2 rad_diag_3 rad_diag_4 rad_diag_5 - rad_diag_6 rad_diag_7 rad_diag_8 rad_diag_9 rad_diag_10); + my @vars = qw(aircraft_specifier csw_specifier ext_frc_specifier + rad_climate rad_diag_1 rad_diag_2 rad_diag_3 rad_diag_4 + rad_diag_5 rad_diag_6 rad_diag_7 rad_diag_8 rad_diag_9 + rad_diag_10 srf_emis_specifier mode_defs); foreach my $var (@vars) { @@ -4337,7 +4950,7 @@ sub check_input_files { # Extract name and filename if ($spec =~ m/\s*(\w+) # name of species preceded by optional whitespace \s*->\s* # -> separator surrounded by optional whitespace - (\S+) # filename (all characters up to optional whitespace) + (.+) # filename and possible coefficient(all characters up to optional whitespace) /xo) { my $name = $1; my $file = $2; @@ -4385,7 +4998,7 @@ sub check_input_files { # If $name2 starts with a slash, then it is an absolute filepath. # If $name2 starts with a $, then it is an unresolved filepath - # (generated when run from CCSM scripts). + # (generated when run from CIME scripts). # Otherwise check for more fields if ($name2 =~ m:^[/\$]:) { @@ -4525,10 +5138,33 @@ sub check_snapshot_settings { push (@validList_bc, ("'kessler_tend'")); } elsif ($phys eq 'tj2016') { push (@validList_bc, ("'thatcher_jablonowski_precip_tend'")); + } elsif ($phys eq 'grayrad') { + push (@validList_bc, ("'frierson_tend'")); } if ($chem ne 'none') { push (@validList_bc, ("'chem_timestep_tend'")); } + } elsif ($phys =~ /cam7/) { + # cam7 physpkg + push(@validList_ac, ("'chem_emissions'", + "'clubb_tend_cam'", + "'microp_section'")); + if ($use_subcol_microp =~ /$TRUE/io) { + push (@validList_bc, ("'microp_driver_tend_subcol'")); + } + push (@validList_ac, ("'aero_model_wetdep'", + "'radiation_tend'", + "'aoa_tracers_timestep_tend'", + "'co2_cycle_set_ptend'")); + if ($chem ne 'none') { + push (@validList_ac, ("'chem_timestep_tend'")); + } + push (@validList_ac, ("'vertical_diffusion_section'", + "'aero_model_drydep'", "'gw_tend'", + "'qbo_relax'", "'iondrag_calc_section'", + "'physics_dme_adjust'")); + push (@validList_bc, ("'dadadj_tend'", "'convect_deep_tend'", + "'convect_diagnostics_calc'")); } else { # CAM physpkg push(@validList_ac, ("'chem_emissions'", @@ -4622,38 +5258,6 @@ sub check_snapshot_settings { #----------------------------------------------------------------------------------------------- -sub strip_rootdir { - -# Strip a root directory from the begining of a filepath. -# Allow for the possibility that the root directory is specified as a shell variable -# to support a CCSM script requirement. - - my ($filepath, $rootdir) = @_; - - # Check whether the rootdir is specified as a shell variable. - if ($rootdir =~ m/^\$(\w*)/) { - - my $rootname = $1; - - # Strip off the root directory with the following regexp that - # avoids the problem of $rootdir being interpolated to a scalar variable - # name... - #$filepath =~ s:^\$$rootname::; - - # The CCSM scripts are currently set up to expect the shell variable in the - # output file that contains the list of inputdata files. So in this case - # do nothing. - - } - else { - # Strip off the rootdir specified as a resolved pathname - $filepath =~ s:^$rootdir::; - } - return $filepath; -} - -#----------------------------------------------------------------------------------------------- - sub set_abs_filepath { # check whether the input filepath is an absolute path, and if it isn't then diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml index ba0550dd09..c3af153035 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -26,8 +26,8 @@ Switch specifies whether CAM is being built by the CCSM sequential scripts. 0 = Coupling framework: mct or nuopc. Default: mct. - -Dynamics package: eul, fv, fv3, se, or mpas. + +Dynamics package: fv, fv3, se, or mpas. Switch to turn on waccm physics: 0 => no, 1 => yes. @@ -46,22 +46,30 @@ Switch to turn on analytic initial conditions for the dynamics state: 0 => no 1 => yes. + +Model top specifier - set by compset definition + lt: ~ 40 km top + mt: ~ 80 km top + Option to turn on waccmx thermosphere/ionosphere extension: 0 => no, 1 => yes - + Ionosphere model used in WACCMX. - -Physics package: cam3, cam4, cam5, cam6, held_suarez, adiabatic, kessler, tj2016, spcam_sam1mom, spcam_m2005. + +Physics package: cam4, cam5, cam6, cam7, held_suarez, adiabatic, kessler, tj2016, grayrad. + + +Switch to turn on Harmonized Emissions Component (HEMCO) for chemistry: 0 => no, 1 => yes. - + Microphysics package: rk (Rasch and Kristjansson), mg1 (Morrison and Gettelman two moment scheme CAM5.1), mg2 (Morrison and Gettelman second -version CAM6), mg3 (MG scheme 3rd version, graupel), SPCAM_m2005, SPCAM_sam1mom. +version CAM6), mg3 (MG scheme 3rd version, graupel), PUMAS. - -Macrophysics package: RK, Park, CLUBB_SGS, SPCAM_sam1mom, SPCAM_m2005. + +Macrophysics package: RK, Park, CLUBB_SGS. Switch to turn on CLUBB_SGS package: 0 => no, 1 => yes @@ -75,28 +83,24 @@ Switch to turn on UNICON package: 0 => off, 1 => on Switch to turn on/off advecting CLUBB moments: 0 => no, 1 => yes - -Switch to turn on/off parameterization for sub-grid scale convective organization for the ZM deep convective scheme based -on Mapes and Neale (2011): 0 => no, 1 => yes - - + PBL package: uw (University of Washington), hb (Holtslag and Boville), hbr - (Holtslag, Boville, and Rasch), clubb_sgs, spcam_sam1om, spcam_m2005, none. + (Holtslag, Boville, and Rasch), clubb_sgs, none. - -Radiative transfer calculation: -camrt (CAM3 and CAM4 RT package), rrtmg (RRTMG package from AER). + +Radiative transfer calculation: +camrt (CAM4 RT package), rrtmg (RRTMG package from AER), rrtmgp (updated version). -CARMA sectional microphysics: +CARMA sectional microphysics: none (disabled), bc_strat (Stratospheric Black Carbon), cirrus (Cirrus Clouds), -cirrus_dust (Cirrus Clouds with dust), dust (Dust), meteor_impact (Meteor Impact), +cirrus_dust (Cirrus Clouds with dust), dust (Dust), meteor_impact (Meteor Impact), meteor_smoke (Meteor Smoke), mixed_sulfate (Meteor Smoke and Sulfate), pmc (Polar Mesospheric Clouds), pmc_sulfate (PMC and Sulfate), sea_salt (Sea Salt), -sulfate (Sulfate Aerosols), tholin (early earth haze), test_detrain (Detrainment), test_growth (Particle Growth), test_passive (Passive Dust), +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: trop_mam3 trop_mam4 trop_mam7 trop_mozart trop_strat_mam4_ts2 trop_strat_mam4_vbs trop_strat_mam4_vbsext waccm_ma waccm_mad waccm_mad_mam4 waccm_ma_mam4 waccm_ma_sulfur waccm_sc waccm_sc_mam4 waccm_tsmlt_mam4 terminator none + + 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 @@ -139,12 +143,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 SE dycore. + + +Single column IOP +Only supported for SE dycore. 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. +Only supported for SE dycore. Horizontal grid specifier. The recognized values depend on @@ -183,15 +191,6 @@ Switch on (off) age of air tracers: 0=off, 1=on. Maximum number of constituents that are radiatively active or in any one diagnostic list. - -Maximum Fourier wavenumber. - - -Highest degree of the Legendre polynomials for m=0. - - -Highest degree of the associated Legendre polynomials. - Maximum number of columns in a chunk (physics data structure). @@ -213,7 +212,7 @@ User specified C compiler options to append to Makefile defaults. User specified Fortran compiler overrides Makefile default. - + Type of Fortran compiler. Used when -fc specifies a generic wrapper script such as mpif90 or ftn. @@ -302,23 +301,5 @@ that setting to allow for cross-compilation, and for instances where the $OSNAME value is too generic. For example, currently on both cray-xt and bluegene systems $OSNAME has the value "linux". - -Switch to turn on SPCAM version of CLUBB_SGS package: 0 => no, 1 => yes - - -SPCAM number of grid points in x - - -SPCAM number of grid points in y - - -SPCAM number of grid points in z - - -SPCAM horizontal grid spacing, m - - -SPCAM time step, s - diff --git a/bld/config_files/horiz_grid.xml b/bld/config_files/horiz_grid.xml index 1164009073..186adf4c6e 100644 --- a/bld/config_files/horiz_grid.xml +++ b/bld/config_files/horiz_grid.xml @@ -2,15 +2,6 @@ - - - - - - - - - diff --git a/bld/configure b/bld/configure index 5dbe6152a1..138436315a 100755 --- a/bld/configure +++ b/bld/configure @@ -62,14 +62,14 @@ OPTIONS test_detrain | test_growth | test_passive | test_radiative | test_swelling | test_tracers, test_tracers2]. Default: none. - -chem Build CAM with specified prognostic chemistry package - [ trop_mam3 | trop_mam4 | trop_mam7 | trop_mozart | - trop_strat_mam4_ts2 | trop_strat_mam4_vbs | trop_strat_mam4_vbsext | - waccm_ma | waccm_mad | waccm_mad_mam4 | waccm_ma_mam4 | - waccm_ma_sulfur | waccm_sc | waccm_sc_mam4 | waccm_tsmlt_mam4 | - terminator | 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_ts4 | trop_strat_mam5_vbs | + trop_strat_mam5_vbsext | waccm_ma | waccm_mad | waccm_ma_sulfur | waccm_sc | waccm_sc_mam4 | + waccm_mad_mam4 | waccm_ma_mam4 | waccm_tsmlt_mam4 | waccm_tsmlt_mam4_vbsext | waccm_mad_mam5 | + waccm_ma_mam5 | waccm_tsmlt_mam5 | waccm_tsmlt_mam5_vbsext | geoschem_mam4 ]. Default: trop_mam4 for cam6 and trop_mam3 for cam5. - -[no]clubb_sgs Switch on [off] CLUBB_SGS. Default: on for cam6, otherwise off. + -[no]clubb_sgs Switch on [off] CLUBB_SGS. Default: on for cam6 and cam7, otherwise off. -clubb_opts Comma separated list of CLUBB options to turn on/off. By default they are all off. Current option is: clubb_do_adv (Advect CLUBB moments) -co2_cycle This option modifies the CAM configuration by @@ -78,17 +78,18 @@ OPTIONS -cppdefs A string of user specified CPP defines. Appended to Makefile defaults. E.g. -cppdefs '-DVAR1 -DVAR2' -cpl Coupling framework [mct | nuopc]. Default: mct. - -dyn Dynamical core option: [eul | fv | se | fv3 | mpas]. Default: fv. + -dyn Dynamical core option: [fv | se | fv3 | mpas]. Default: fv. -edit_chem_mech Invokes CAMCHEM_EDITOR to allow the user to edit the chemistry mechanism file -hgrid Specify horizontal grid. Use nlatxnlon for spectral grids; dlatxdlon for fv grids (dlat and dlon are the grid cell size in degrees for latitude and longitude respectively); nexnp for se grids. - -ionosphere Ionophere module used in WACCMX [ none | wxi | wxie ]. + -ionosphere Ionophere module used in WACCMX [ none | wxie ]. -macrophys Specify the macrophysics option [rk | park | clubb_sgs]. -max_n_rad_cnst Maximum number of constituents that are either radiatively active, or in any single diagnostic list for the radiation. - -microphys Specify the microphysics option [mg1 | mg2 | mg3| rk]. + -microphys Specify the microphysics option [mg1 | mg2 | mg3| rk | pumas]. + -model_top Specify the model_top option for cam7 [ lt | mt ]. -nadv Set total number of advected species to . -nadv_tt Set number of advected test tracers . -nlev Set number of levels to . @@ -96,34 +97,28 @@ OPTIONS -pbl Specify the PBL option [uw | hb | hbr]. -pcols Set maximum number of columns in a chunk to . -pergro Switch enables building CAM for perturbation growth tests. - -phys Physics option [cam3 | cam4 | cam5 | cam6 | - held_suarez | adiabatic | kessler | tj2016 | - spcam_sam1mom | spcam_m2005]. Default: cam6 + -phys Physics option [cam4 | cam5 | cam6 | cam7 | + held_suarez | adiabatic | kessler | tj2016 | grayrad]. -prog_species Comma-separate list of prognostic mozart species packages. Currently available: DST,SSLT,SO4,GHG,OC,BC,CARBON16 -psubcols Maximum number of sub-columns in a run - set to 1 if not using sub-columns (default) - -rad Specify the radiation package [rrtmg | camrt] + -rad Specify the radiation package [rrtmg | rrtmgp | rrtmgp_gpu | camrt] -silhs Switch on SILHS. - -spcam_clubb_sgs Turn on the SPCAM version of CLUBB - -spcam_nx SPCAM x-grid. - defaults to 4 (note the CRM requires spcam_nx to be greater than or equal to 4) - -spcam_ny SPCAM y-grid. - defaults to 1 - -spcam_dx SPCAM horizontal grid spacing. - -spcam_dt SPCAM timestep. -unicon Switch to turn on the UNICON scheme. Default: off. -usr_mech_infile Path and file name of the user supplied chemistry mechanism file. -waccm_phys Switch enables the use of WACCM physics in any chemistry configuration. The user does not need to set this if one of the waccm chemistry options is chosen. -waccmx Build CAM/WACCM with WACCM upper Thermosphere/Ionosphere extended package - -zmconv_org Include parameterization for sub-grid scale convective organization for the ZM deep convective scheme based - on Mapes and Neale (2011) Options relevent to SCAM mode: -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: @@ -139,10 +134,6 @@ OPTIONS -verbose [or -v] Turn on verbose echoing of settings made by configure. -version Echo the CVS tag name used to check out this CAM distribution. - Options for surface components used in standalone CAM mode: - - -ocn Build CAM with ocean model [docn | dom | som | socn | aquaplanet | pop]. Default: aquaplanet - Options for building CAM via standalone scripts: -cam_bld Directory where CAM will be built. This is where configure will write the @@ -212,6 +203,7 @@ EOF # command was issued from the current working directory. (my $ProgName = $0) =~ s!(.*)/!!; # name of this script +$ProgName = "CAM $ProgName"; # distinquish from other components configure my $ProgDir = $1; # name of directory containing this script -- may be a # relative or absolute path, or null if the script is in # the user's PATH @@ -254,7 +246,6 @@ GetOptions( "cosp_libdir=s" => \$opts{'cosp_libdir'}, "cppdefs=s" => \$opts{'cppdefs'}, "cpl=s" => \$opts{'cpl'}, - "spcam_clubb_sgs" => \$opts{'spcam_clubb_sgs'}, "debug" => \$opts{'debug'}, "dyn=s" => \$opts{'dyn'}, "edit_chem_mech" => \$opts{'edit_chem_mech'}, @@ -275,6 +266,7 @@ GetOptions( "max_n_rad_cnst=s" => \$opts{'max_n_rad_cnst'}, "mct_libdir=s" => \$opts{'mct_libdir'}, "microphys=s" => \$opts{'microphys'}, + "model_top=s" => \$opts{'model_top'}, "mpas_libdir=s" => \$opts{'mpas_libdir'}, "mpi_inc=s" => \$opts{'mpi_inc'}, "mpi_lib=s" => \$opts{'mpi_lib'}, @@ -298,14 +290,10 @@ 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'}, - "spcam_nx=s" => \$opts{'spcam_nx'}, - "spcam_ny=s" => \$opts{'spcam_ny'}, - "spcam_dx=s" => \$opts{'spcam_dx'}, - "spcam_dt=s" => \$opts{'spcam_dt'}, "spmd!" => \$opts{'spmd'}, "target_os=s" => \$opts{'target_os'}, "unicon" => \$opts{'unicon'}, @@ -315,7 +303,6 @@ GetOptions( "version" => \$opts{'version'}, "waccm_phys" => \$opts{'waccm_phys'}, "waccmx" => \$opts{'waccmx'}, - "zmconv_org" => \$opts{'zmconv_org'}, ) or usage(); # Give usage message. @@ -536,21 +523,16 @@ if ($print>=2) { print "Coupling framework: $cpl$eol"; } #----------------------------------------------------------------------------------------------- # Physics package -# -# The default physics package is cam6. Physics packages >=cam5 use chemistry packages -# that include modal aerosols, i.e., the -chem value matches /_mam/. If the chem_pkg -# name doesn't match /_mam/ then set the default physics package to cam4. -my $phys_pkg = 'cam6'; -if (defined $opts{'chem'} and $opts{'chem'} !~ /_mam/) { - $phys_pkg = 'cam4'; -} -elsif (defined $opts{'waccmx'}) { - $phys_pkg = 'cam4'; -} -# user override +my $phys_pkg = 'not_set'; + +# There is no default physics package. It is always specified by the CAM component part +# of a compset longname. Add check that -phys has been set. + if (defined $opts{'phys'}) { $phys_pkg = lc($opts{'phys'}); +} else { + die "$ProgName ERROR: the -phys option must be set"; } # Add to the config object. @@ -561,22 +543,28 @@ if ($print>=2) { print "Physics package: $phys_pkg$eol"; } # Set flag to indicate a simple physics option my $simple_phys = 0; -if ($phys_pkg =~ m/^adiabatic$|^held_suarez$|^kessler$|^tj2016$/) { +if ($phys_pkg =~ m/^adiabatic$|^held_suarez$|^kessler$|^tj2016$|^grayrad$/) { $simple_phys = 1; } #----------------------------------------------------------------------------------------------- # Chemistry package -my $chem_pkg = 'trop_mam4'; +my $chem_pkg = 'not_set'; # defaults based on physics package -if ($simple_phys or $phys_pkg =~ m/^cam[34]$/ or $phys_pkg eq 'spcam_sam1mom') { +if ($simple_phys or $phys_pkg =~ m/^cam[34]$/) { $chem_pkg = 'none'; } -elsif ($phys_pkg eq 'cam5' or $phys_pkg eq 'spcam_m2005') { +elsif ($phys_pkg eq 'cam5') { $chem_pkg = 'trop_mam3'; } +elsif ($phys_pkg eq 'cam6') { + $chem_pkg = 'trop_mam4'; +} +elsif ($phys_pkg eq 'cam7') { + $chem_pkg = 'ghg_mam4'; +} # some overrides for special configurations if (defined $opts{'prog_species'}) { @@ -594,14 +582,13 @@ if (defined $opts{'chem'}) { # If the user has specified a simple physics package... if ($simple_phys) { - # the only valid chemistry options are 'none' and 'terminator' if (($chem_pkg ne 'none') and ($chem_pkg ne 'terminator')) { die "configure ERROR: -phys=$phys_pkg -chem=$chem_pkg\n". " -chem can only be set to 'none' or 'terminator'.\n"; } } - elsif ($phys_pkg =~ m/^cam3$|^cam4$|^spcam_sam1mom$/) { - # The modal aerosols are not valid with cam3 or cam4 physics + elsif ($phys_pkg =~ m/cam4/) { + # The modal aerosols are not valid with cam4 physics if ($chem_pkg =~ /_mam/) { die "configure ERROR: -phys=$phys_pkg -chem=$chem_pkg\n". " -chem cannot be set to a modal aerosol option.\n"; @@ -642,6 +629,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); @@ -694,14 +685,6 @@ $waccm_phys = $cfg_ref->get('waccm_phys'); if ($print>=2) { print "WACCM physics: $waccm_phys$eol"; } - -# WACCM physics only runs with FV, SE and FV3 dycores -if ( ($waccm_phys) and ($dyn_pkg eq 'eul') ) { - die <<"EOF"; -** ERROR: WACCM physics does not run with the Eulerian spectral dycore. -EOF -} - # WACCM includes 4 age of air tracers by default if ($chem_pkg =~ /waccm_ma/ or $chem_pkg =~ /waccm_tsmlt/) { $cfg_ref->set('age_of_air_trcs', 1); @@ -761,46 +744,6 @@ my $co2_cycle = $cfg_ref->get('co2_cycle'); if ($co2_cycle and $print>=2) { print "co2_cycle option: ON$eol"; } -#----------------------------------------------------------------------------------------------- -# Superparameterization mode (SPCAM) -# -# These values all default to 1 unless specified by the user during configure - -if ($phys_pkg eq 'spcam_sam1mom' or $phys_pkg eq 'spcam_m2005') { - - if ($smp eq 'ON') { - die "ERROR: SPCAM may not be used with threading $eol"; - } - - if ($print>=2) {print "Configure CAM for SPCAM (superparameterization) mode: $phys_pkg.$eol"; } - - if (defined $opts{'spcam_nx'}) { - $cfg_ref->set('spcam_nx', $opts{'spcam_nx'}); - my $spcam_nx = $cfg_ref->get('spcam_nx'); - if ($spcam_nx < 4) { - die "configure ERROR: spcam_nx must be greater than or equal to 4\n"; - } - if ($print>=2) {print "spcam_nx= $spcam_nx $eol"; } - } - if (defined $opts{'spcam_ny'}) { - $cfg_ref->set('spcam_ny', $opts{'spcam_ny'}); - my $spcam_ny = $cfg_ref->get('spcam_ny'); - if ($print>=2) {print "spcam_ny= $spcam_ny $eol"; } - } - if (defined $opts{'spcam_dx'}) { - $cfg_ref->set('spcam_dx', $opts{'spcam_dx'}); - my $spcam_dx = $cfg_ref->get('spcam_dx'); - if ($print>=2) {print "spcam_nx= $spcam_dx $eol"; } - } - if (defined $opts{'spcam_dt'}) { - $cfg_ref->set('spcam_dt', $opts{'spcam_dt'}); - my $spcam_dt = $cfg_ref->get('spcam_dt'); - if ($print>=2) {print "spcam_nt= $spcam_dt $eol"; } - } - -} - - #----------------------------------------------------------------------------------------------- # Micro-physics package @@ -815,11 +758,8 @@ elsif ($phys_pkg eq 'cam5') { elsif ($phys_pkg eq 'cam6') { $microphys_pkg = 'mg2'; } -elsif ($phys_pkg eq 'spcam_sam1mom') { - $microphys_pkg = 'spcam_sam1mom'; -} -elsif ($phys_pkg eq 'spcam_m2005') { - $microphys_pkg = 'spcam_m2005'; +elsif ($phys_pkg eq 'cam7') { + $microphys_pkg = 'mg3'; } # Allow the user to override the default via the commandline. @@ -827,6 +767,10 @@ if (defined $opts{'microphys'}) { $microphys_pkg = lc($opts{'microphys'}); } +if($microphys_pkg eq 'pumas') { + $microphys_pkg = 'mg3'; +} + $cfg_ref->set('microphys', $microphys_pkg); if ($print>=2) { print "Microphysics package: $microphys_pkg$eol"; } @@ -845,7 +789,7 @@ if ($carma_pkg =~ m/cirrus/i) { unless ($microphys_pkg =~ /^mg/) { die <<"EOF"; ** ERROR: microphysics package set to: $microphys_pkg -** The CARMA cirrus model only works with MG microphysics. +** The CARMA cirrus model only works with MG or PUMAS microphysics. EOF } } @@ -857,7 +801,7 @@ if ($print>=2) { print "CARMA microphysical model: $carma_pkg$eol"; } #----------------------------------------------------------------------------------------------- # CLUBB my $clubb_sgs = 0; -if ($phys_pkg eq 'cam6') { +if ($phys_pkg eq 'cam6' or $phys_pkg eq 'cam7') { $clubb_sgs = 1; } @@ -868,11 +812,18 @@ if (defined $opts{'clubb_sgs'}) { # consistency checks... +# cam7 only works with CLUBB_SGS +if (($phys_pkg eq 'cam7') and not ($clubb_sgs )) { + die <<"EOF"; +** ERROR: CLUBB_SGS must be enabled for cam7 physics. +EOF +} + # CLUBB_SGS only works with mg microphysics if ($clubb_sgs and not ($microphys_pkg =~ m/^mg/ )) { die <<"EOF"; ** ERROR: microphysics package set to: $microphys_pkg -** CLUBB_SGS only works with MG microphysics. +** CLUBB_SGS only works with MG or PUMAS microphysics. EOF } @@ -899,14 +850,6 @@ $cfg_ref->set('silhs', $silhs); if ($print>=2) { print "silhs: $silhs$eol"; } -#----------------------------------------------------------------------------------------------- -# SPCAM version of CLUBB -if (defined $opts{'spcam_clubb_sgs'}) { - $cfg_ref->set('spcam_clubb_sgs', $opts{'spcam_clubb_sgs'}); -} -my $spcam_clubb_sgs = $cfg_ref->get('spcam_clubb_sgs'); - - #----------------------------------------------------------------------------------------------- # Break apart CLUBB options into separate fields @@ -919,16 +862,6 @@ if (defined $opts{'clubb_opts'}) { my $clubb_do_adv = $cfg_ref->get('clubb_do_adv'); if ($print>=2) { print "clubb_do_adv: $clubb_do_adv$eol"; } -#----------------------------------------------------------------------------------------------- -# ZM convective organization - -if (defined $opts{'zmconv_org'}) { - $cfg_ref->set('zmconv_org', $opts{'zmconv_org'}); -} - -my $zmconv_org = $cfg_ref->get('zmconv_org'); -if ($print>=2) { print "zmconv_org: $zmconv_org$eol"; } - #----------------------------------------------------------------------------------------------- # Macro-physics package @@ -940,21 +873,20 @@ if ($phys_pkg =~ /cam[34]/) { elsif ($phys_pkg =~ /cam5/) { $macrophys_pkg = 'park'; } -elsif ($phys_pkg =~ /cam6/ and $clubb_sgs) { - $macrophys_pkg = 'clubb_sgs'; -} -elsif ($phys_pkg =~ /cam6/ and !$clubb_sgs) { - $macrophys_pkg = 'park'; -} -elsif ($phys_pkg eq 'spcam_sam1mom') { - $macrophys_pkg = 'spcam_sam1mom'; +elsif ($phys_pkg =~ /cam6/) { + if ($clubb_sgs) { + $macrophys_pkg = 'clubb_sgs'; + } + else { + $macrophys_pkg = 'park'; + } } -elsif ($phys_pkg eq 'spcam_m2005') { - $macrophys_pkg = 'spcam_m2005'; +elsif ($phys_pkg =~ /cam7/) { + $macrophys_pkg = 'clubb_sgs'; } # user overrides -if ($clubb_sgs or $spcam_clubb_sgs) { +if ($clubb_sgs) { $macrophys_pkg = 'clubb_sgs'; } @@ -978,17 +910,16 @@ if ($phys_pkg =~ m/^cam[34]$/) { elsif ($phys_pkg =~ /cam5/) { $pbl_pkg = 'uw'; } -elsif ($phys_pkg =~ /cam6/ and $clubb_sgs) { - $pbl_pkg = 'clubb_sgs'; -} -elsif ($phys_pkg =~ /cam6/ and !$clubb_sgs) { - $pbl_pkg = 'uw'; -} -elsif ($phys_pkg eq 'spcam_sam1mom') { - $pbl_pkg = 'spcam_sam1mom'; +elsif ($phys_pkg =~ /cam6/) { + if ($clubb_sgs) { + $pbl_pkg = 'clubb_sgs'; + } + else { + $pbl_pkg = 'uw'; + } } -elsif ($phys_pkg eq 'spcam_m2005') { - $pbl_pkg = 'spcam_m2005'; +elsif ($phys_pkg =~ /cam7/) { + $pbl_pkg = 'clubb_sgs'; } # Allow the user to override the default via the commandline. @@ -1006,7 +937,7 @@ if ($pbl_pkg =~ m/uw/i) { unless ($microphys_pkg =~ /^mg/) { die <<"EOF"; ** ERROR: microphysics package set to: $microphys_pkg -** The UW PBL scheme only works with MG microphysics. +** The UW PBL scheme only works with MG or PUMAS microphysics. EOF } } @@ -1041,16 +972,26 @@ if ($unicon and $print>=2) { print "Using UNICON scheme.$eol"; } # Set default my $rad_pkg = 'none'; -if ($phys_pkg =~ m/^cam[34]$|^spcam_sam1mom$/) { +if ($phys_pkg =~ m/cam4/) { $rad_pkg = 'camrt'; } -elsif ($phys_pkg =~ m/^cam[56]$|^spcam_m2005$/) { +elsif ($phys_pkg =~ m/cam5|cam6/) { $rad_pkg = 'rrtmg'; } - +elsif ($phys_pkg =~ m/cam7/) { + $rad_pkg = 'rrtmgp'; +} # Allow the user to override the default via the commandline. +my $use_rrtmgp_gpu = 0; if (defined $opts{'rad'}) { $rad_pkg = lc($opts{'rad'}); + # If the radiation package is set to rrtmgp_gpu then will add the gpu code version + # (openmp and openacc) to the Filepath file, but strip off the "_gpu" when setting + # the radiation package name in the config_cache file. + if ($rad_pkg eq 'rrtmgp_gpu') { + $use_rrtmgp_gpu = 1; + $rad_pkg = 'rrtmgp'; + } } # consistency checks... @@ -1063,12 +1004,11 @@ if ($rad_pkg eq 'camrt') { " with aerosol package $chem_pkg\n"; } } -elsif ($rad_pkg eq 'rrtmg') { +elsif ($rad_pkg =~ m/rrtmg/) { - # The rrtmg package doesn't work with the CAM3 prescribed aerosols - if ($phys_pkg eq 'cam3') { - die "configure ERROR: radiation package: $rad_pkg is not compatible\n". - " with physics package $phys_pkg\n"; + # RRTMGP not currently working with CARMA + if ($rad_pkg eq 'rrtmgp' and $carma_pkg ne 'none') { + die "configure ERROR: The CARMA microphysics package does not currently work with RRTMGP\n"; } } @@ -1083,38 +1023,13 @@ if (defined $opts{'cosp'}) { } my $cosp = $cfg_ref->get('cosp'); -# cosp is only implemented with the cam5 and cam6 physics packages -if ($cosp and ($phys_pkg ne 'cam5' and $phys_pkg ne 'cam6')) { +# cosp is only implemented with the cam5, cam6, and cam7 physics packages +if ($cosp and ($phys_pkg ne 'cam5' and $phys_pkg ne 'cam6' and $phys_pkg ne 'cam7')) { die "configure ERROR: cosp not implemented for the $phys_pkg physics package \n"; } if ($cosp and $print>=2) { print "COSP simulator enabled$eol"; } -#----------------------------------------------------------------------------------------------- -# Checks for SPCAM compatability - -if ($phys_pkg eq 'spcam_sam1mom') { - if ($rad_pkg ne 'camrt') { - die "configure ERROR: radiation package: $rad_pkg is not compatible\n". - " with sam1mom -- it should be camrt\n"; - } - if ($chem_pkg ne 'none') { - die "configure ERROR: chemistry package: $chem_pkg is not compatible\n". - " with sam1mom -- it should be none\n"; - } -} - -if ($phys_pkg eq 'spcam_m2005') { - if ($rad_pkg ne 'rrtmg') { - die "configure ERROR: radiation package: $rad_pkg is not compatible\n". - " with m2005 -- it should be rrtmg\n"; - } - if ($chem_pkg ne 'trop_mam3') { - die "configure ERROR: chemistry package: $chem_pkg is not compatible\n". - " with m2005 -- it should be trop_mam3\n"; - } -} - #----------------------------------------------------------------------------------------------- # offline unit driver if (defined $opts{'offline_drv'}) { @@ -1168,15 +1083,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 dycore supported in SCAM mode is the Spectral Element +if ($scam eq 'ON' and !($dyn_pkg eq 'se')) { die <<"EOF"; -** ERROR: SCAM mode only works with Eulerian dycore. +** ERROR: SCAM mode only works with SE dycore. ** Requested dycore is: $dyn_pkg EOF } @@ -1190,10 +1115,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 dycore supported in SCAM mode is the Spectral Element +if ($camiop eq 'ON' and !($dyn_pkg eq 'se')) { die <<"EOF"; -** ERROR: CAMIOP mode only works with Eulerian dycore. +** ERROR: CAMIOP mode only works with the Spectral Element dycore. ** Requested dycore is: $dyn_pkg EOF } @@ -1207,9 +1132,6 @@ my $hgrid; if ($dyn_pkg eq 'fv') { $hgrid = '1.9x2.5'; } -elsif ($dyn_pkg eq 'eul') { - $hgrid = '64x128'; -} elsif ($dyn_pkg eq 'se') { $hgrid = 'ne16np4'; } @@ -1267,21 +1189,36 @@ EOF if ($print>=2) { print "Maximum number of sub-columns per column: $psubcols$eol"; } +#----------------------------------------------------------------------------------------------- +# model_top -- Introduced in cam7 to provide a way to specify the model top +# independently of the number of model layers. + +# Set default +my $model_top = 'none'; +$cfg_ref->set('model_top', $model_top); + +# user override +if (defined $opts{'model_top'} and $opts{'model_top'} ne 'none') { + if ($phys_pkg eq 'cam7') { + $cfg_ref->set('model_top', $opts{'model_top'}); + } else { + die "configure ERROR: model_top=$opts{'model_top'} is only implemented for cam7 physics"; + } +} +if ($print>=2) { print "model_top: $model_top$eol"; } + #----------------------------------------------------------------------------------------------- # Number of vertical levels my $nlev = 0; # Defaults if ($waccmx) { - if ($ionos =~ /wxi/) { - if ($phys_pkg eq 'cam6') { + if ($phys_pkg eq 'cam6') { + $nlev = 130; + } elsif ($phys_pkg eq 'cam7') { $nlev = 130; - } else { + } else { $nlev = 126; - } - } - else { - $nlev = 81; } } elsif ($chem_pkg =~ /waccm_/) { @@ -1292,16 +1229,16 @@ elsif ($chem_pkg =~ /waccm_/) { $nlev = 70; } } +elsif ($phys_pkg eq 'cam7') { + $nlev = 32; +} elsif ($phys_pkg eq 'cam6') { $nlev = 32; } -elsif ($phys_pkg eq 'cam5' or $phys_pkg eq 'spcam_m2005') { +elsif ($phys_pkg eq 'cam5') { $nlev = 30; } -elsif ($phys_pkg eq 'cam4' or $phys_pkg eq 'spcam_sam1mom') { - $nlev = 26; -} -elsif ($phys_pkg eq 'cam3') { +elsif ($phys_pkg eq 'cam4') { $nlev = 26; } else { @@ -1326,10 +1263,6 @@ $cfg_ref->set('nlev', $nlev); if ($print>=2) { print "Number of vertical levels: $nlev$eol"; } -if ($phys_pkg eq 'spcam_sam1mom' or $phys_pkg eq 'spcam_m2005') { - $cfg_ref->set('spcam_nz', $nlev-2); -} - #------------------------------------------------------------------------------------------------ # chemistry preprocessor.... # -- avoid using the chem_preprocessor unless it's required @@ -1339,7 +1272,11 @@ my $chem_cppdefs = ''; my $chem_src_dir = ''; if (!$prog_species) { - $chem_src_dir = "$cam_dir/src/chemistry/pp_$chem_pkg"; + if ($chem_pkg =~ 'geoschem') { + $chem_src_dir = "$cam_dir/src/chemistry/geoschem"; + } else { + $chem_src_dir = "$cam_dir/src/chemistry/pp_$chem_pkg"; + } $cfg_ref->set('chem_src_dir', $chem_src_dir); } @@ -1366,10 +1303,10 @@ if ($customize) { } if ($print>=2) { print "Chem preprocessor compiler: $chemproc_fc $eol"; } ($chem_nadv) = chem_preprocess($cfg_ref,$print,$chemproc_fc); -} elsif ($chem_pkg ne 'none') { +} elsif ($chem_pkg ne 'none' and $chem_pkg !~ 'geoschem') { # copy over chem docs - copy("$chem_src_dir/chem_mech.doc",$cam_bld) or die "copy failed $! \n"; - copy("$chem_src_dir/chem_mech.in" ,$cam_bld) or die "copy failed $! \n"; + copy("$chem_src_dir/chem_mech.doc",$cam_bld) or die "copy of chem_mec.doc failed $! \n"; + copy("$chem_src_dir/chem_mech.in" ,$cam_bld) or die "copy of chem_mech.in failed $! \n"; ($chem_nadv) = chem_number_adv($chem_src_dir); } @@ -1377,10 +1314,19 @@ if ($chem_pkg =~ '_mam3') { $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_3MODE '; } elsif ($chem_pkg =~ '_mam4') { $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_4MODE '; +} elsif ($chem_pkg =~ '_mam5') { + $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_5MODE '; } elsif ($chem_pkg =~ '_mam7') { $chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_7MODE '; } +# Customize GEOS-Chem advected species and chemistry CPP definitions +if ($chem_pkg =~ 'geoschem') { + $chem_cppdefs .= ' -DEXTERNAL_GRID -DEXTERNAL_FORCING -DMODEL_CESM -DMODEL_GEOSCHEM'; + if ($chem_pkg =~ '_mam4') { + $chem_nadv = 269; # includes all GEOS-Chem advected species, CO2, and MAM aerosols + } +} # CARMA sectional microphysics # # New CARMA models need to define the number of advected constituents. @@ -1475,11 +1421,11 @@ else { unless ($simple_phys) { # Microphysics parameterization - if ($microphys_pkg eq 'rk' or $microphys_pkg eq 'spcam_sam1mom') { + if ($microphys_pkg eq 'rk') { $nadv += 2; if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 2$eol"; } } - elsif ($microphys_pkg =~ /^mg1/ or $microphys_pkg eq 'spcam_m2005') { + elsif ($microphys_pkg =~ /^mg1/) { $nadv += 4; if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 4$eol"; } } @@ -1492,11 +1438,6 @@ else { if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 10$eol"; } } - if ($zmconv_org == 1 ) { - $nadv += 1; - if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 8$eol"; } - } - if ($clubb_do_adv) { $nadv += 9; if ($print>=2) { print "Advected constituents added by $microphys_pkg microphysics: 8$eol"; } @@ -1532,7 +1473,7 @@ else { if ($print>=2 and $ttrac_nadv) { print "Advected constituents added by test tracer package: $ttrac_nadv$eol"; } if ($age_of_air_trcs eq "ON") { - $nadv += 4; + $nadv += 3; if ($print>=2) { print "Advected constituents added by the age of air tracer package: 4$eol"; } } @@ -1646,10 +1587,11 @@ elsif ($fc =~ /^nag/) { $fc_type = 'nag'; } elsif ($fc =~ /path/) { $fc_type = 'pathscale'; } elsif ($fc =~ /gfort/) { $fc_type = 'gnu'; } elsif ($fc =~ /xlf/) { $fc_type = 'ibm'; } +elsif ($fc =~ /nvfor/) { $fc_type = 'nvhpc'; } # User override for Fortran compiler type if (defined $opts{'fc_type'}) { $fc_type = $opts{'fc_type'}; } - +if ($fc_type =~ /intel/) {$fc_type = 'intel'; } if ($fc_type) { $cfg_ref->set('fc_type', $fc_type); if ($print>=2) { print "Fortran compiler type: $fc_type$eol"; } @@ -1690,6 +1632,7 @@ if ($cc eq '') { elsif ($fc_type eq 'pathscale') { $cc = 'pathcc'; } elsif ($fc_type eq 'gnu') { $cc = 'gcc'; } elsif ($fc_type eq 'ibm') { $cc = 'xlc'; } + elsif ($fc_type eq 'nvhpc') { $cc = 'nvc'; } } } @@ -1782,28 +1725,6 @@ my $cfg_cppdefs = ' '; # Building for perturbation growth tests if ($pergro eq "ON") { $cfg_cppdefs .= " -DPERGRO"; } -# Building for superparameterization -my $spcam_clubb_sgs = $cfg_ref->get('spcam_clubb_sgs'); -my $spcam_nx = $cfg_ref->get('spcam_nx'); -my $spcam_ny = $cfg_ref->get('spcam_ny'); -my $spcam_nz = $cfg_ref->get('spcam_nz'); -my $spcam_dx = $cfg_ref->get('spcam_dx'); -my $spcam_dt = $cfg_ref->get('spcam_dt'); - -my $yes3Dval = 1; # default to 3D for spcam -if ($spcam_ny eq 1) {$yes3Dval = 0;} #Turn off if not using 3D - -if ($phys_pkg eq 'spcam_m2005' or $phys_pkg eq 'spcam_sam1mom') { - $cfg_cppdefs .= " -DSPCAM_NX=$spcam_nx -DSPCAM_NY=$spcam_ny -DSPCAM_NZ=$spcam_nz -DSPCAM_DX=$spcam_dx -DSPCAM_DT=$spcam_dt -DYES3DVAL=$yes3Dval -DCRM "; - if ( $spcam_clubb_sgs == 1 ) { - $cfg_cppdefs .= "-DSPCAM_CLUBB_SGS -DCLUBB_CRM -DCLUBB_REAL_TYPE=dp -DCLUBB_SAM"; ## -DNO_LAPACK_ISNAN"; - } -} - -if ($phys_pkg eq 'spcam_m2005') {$cfg_cppdefs .= " -DECPP -Dm2005";} - -if ($phys_pkg eq 'spcam_sam1mom') {$cfg_cppdefs .= " -Dsam1mom";} - # Configure CAM to produce IOP files for SCAM if ($camiop eq 'ON') { $cfg_cppdefs .= " -DBFB_CAM_SCAM_IOP"; } @@ -1855,12 +1776,6 @@ $cfg_cppdefs .= " -DPLEV=$nlev -DPCNST=$nadv -DPCOLS=$pcols -DPSUBCOLS=$psubcols # Radiatively active constituent number $cfg_cppdefs .= " -DN_RAD_CNST=$max_n_rad_cnst"; -# Spectral truncation parameters -my $trm = $cfg_ref->get('trm'); -my $trn = $cfg_ref->get('trn'); -my $trk = $cfg_ref->get('trk'); -$cfg_cppdefs .= " -DPTRM=$trm -DPTRN=$trn -DPTRK=$trk"; - # offline driver for FV dycore if ($offline_dyn) { $cfg_cppdefs .= ' -DOFFLINE_DYN'; } @@ -1881,15 +1796,6 @@ if ($cfg_ref->get('analytic_ic')) { #WACCM-X extended thermosphere/ionosphere model if ($waccmx) { $cfg_cppdefs .= ' -DWACCMX_PHYS'; - if (($dyn_pkg ne 'fv') and ($ionos ne 'none')) { - die "ERROR: Ionosphere is only available for FV dycore \n"; - } - if ($ionos =~ /wxi/) { - $cfg_cppdefs .= ' -DWACCMX_IONOS'; - } - if ($ionos =~ /wxie/) { - $cfg_cppdefs .= ' -DWACCMX_EDYN_ESMF'; - } } # PIO @@ -1909,9 +1815,26 @@ if ($silhs == 1) { $cfg_cppdefs .= ' -DSILHS'; } +# Simple Models +if ($simple_phys) { $cfg_cppdefs .= ' -DSIMPLE'; } + # UNICON if ($unicon) { $cfg_cppdefs .= ' -DUSE_UNICON'; } +# Harmonized Emissions Component (HEMCO) +# These CPP definitions are used by HEMCO to recognize - +# MODEL_ - HEMCO/GEOS-Chem components running in model environment +# MODEL_CESM - ...within CESM +# USE_REAL8 - HEMCO/GEOS-Chem should use real8 internal precision +# HEMCO_CESM - indicates CESM model environment. Deprecated, will be removed soon. +$cfg_cppdefs .= ' -DMODEL_ -DMODEL_CESM -DHEMCO_CESM -DUSE_REAL8 '; + +# Compiler CPP definitions for GEOS-Chem +if ($chem_pkg =~ 'geoschem') { + if ($fc_type eq 'intel') { $cfg_cppdefs .= ' -DLINUX_IFORT'; } + elsif ($fc_type eq 'gnu') { $cfg_cppdefs .= ' -DLINUX_GFORTRAN'; } +} + #----------------------------------------------------------------------------------------------- # CPP defines to put on Makefile @@ -2045,6 +1968,7 @@ sub write_fv3core_filepath my $camsrcdir = $cfg_ref->get('cam_dir'); my $CASEROOT = "$ENV{'CASEROOT'}"; print $fh "$CASEROOT/SourceMods/src.cam\n"; + print $fh "$camsrcdir/src/dynamics/fv3/src_override\n"; print $fh "$camsrcdir/src/dynamics/fv3/microphys\n"; print $fh "$camsrcdir/src/dynamics/fv3/atmos_cubed_sphere/model\n"; print $fh "$camsrcdir/src/dynamics/fv3/atmos_cubed_sphere/tools\n"; @@ -2100,9 +2024,21 @@ sub write_filepath print $fh "$camsrcdir/src/unit_drivers\n"; print $fh "$camsrcdir/src/unit_drivers/${offline_drv}\n"; + if ($phys_pkg eq 'cam7') { + print $fh "$camsrcdir/src/physics/cam7\n"; + } + if ($simple_phys) { print $fh "$camsrcdir/src/physics/simple\n"; - print $fh "$camsrcdir/src/atmos_phys/kessler\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/kessler\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/held_suarez\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/tj2016\n"; + } + + # Weak scaling fix. This has to come before physics/cam and before dycores + # It also has to come before utils (which is already near the end). + if ($dyn eq 'se' or $dyn eq 'mpas' or $dyn eq 'fv3') { + print $fh "$camsrcdir/src/infrastructure\n"; } if ($carma ne 'none') { @@ -2121,25 +2057,55 @@ sub write_filepath if ($chem_src_dir) { print $fh "$chem_src_dir\n"; } + + # GEOS-Chem and dependencies; GEOS-Chem must be prior to Mozart + if ($chem_pkg =~ 'geoschem') { + print $fh "$camsrcdir/src/chemistry/cloud_j/src/Core\n"; + print $fh "$camsrcdir/src/chemistry/hetp/src/Core\n"; + print $fh "$chem_src_dir/geoschem_src/GeosCore\n"; + print $fh "$chem_src_dir/geoschem_src/GeosUtil\n"; + print $fh "$chem_src_dir/geoschem_src/Headers\n"; + print $fh "$chem_src_dir/geoschem_src/ISORROPIA\n"; + print $fh "$chem_src_dir/geoschem_src/KPP/fullchem\n"; + print $fh "$camsrcdir/src/chemistry/pp_none\n"; + } + if ($chem =~ /_mam/) { - print $fh "$camsrcdir/src/chemistry/modal_aero\n"; + print $fh "$camsrcdir/src/chemistry/modal_aero\n"; } else { - print $fh "$camsrcdir/src/chemistry/bulk_aero\n"; + print $fh "$camsrcdir/src/chemistry/bulk_aero\n"; } print $fh "$camsrcdir/src/chemistry/aerosol\n"; if ($waccmx) { print $fh "$camsrcdir/src/physics/waccmx\n"; - if ($ionos =~ /wxi/) { + if ($ionos =~ /wxie/) { print $fh "$camsrcdir/src/ionosphere/waccmx\n"; } } if ($waccm_phys) { print $fh "$camsrcdir/src/physics/waccm\n"; + print $fh "$camsrcdir/src/physics/ali_arms\n"; + print $fh "$camsrcdir/src/physics/ali_arms/subs\n"; + print $fh "$camsrcdir/src/physics/ali_arms/include\n"; } print $fh "$camsrcdir/src/ionosphere\n"; print $fh "$camsrcdir/src/chemistry/mozart\n"; + + print $fh "$camsrcdir/src/hemco\n"; + + # shared dependencies for HEMCO (Harmonized Emissions Component) + print $fh "$camsrcdir/src/hemco/HEMCO/src/Shared\n"; + print $fh "$camsrcdir/src/hemco/HEMCO/src/Shared/Headers\n"; + print $fh "$camsrcdir/src/hemco/HEMCO/src/Shared/GeosUtil\n"; + print $fh "$camsrcdir/src/hemco/HEMCO/src/Shared/NcdfUtil\n"; + + # HEMCO source code directory paths from HEMCO external + print $fh "$camsrcdir/src/hemco/HEMCO/src/Core\n"; + print $fh "$camsrcdir/src/hemco/HEMCO/src/Extensions\n"; + print $fh "$camsrcdir/src/hemco/HEMCO/src/Interfaces/Shared\n"; + print $fh "$camsrcdir/src/chemistry/utils\n"; if ($rad eq 'rrtmg') { @@ -2149,38 +2115,32 @@ sub write_filepath elsif ($rad eq 'camrt') { print $fh "$camsrcdir/src/physics/camrt\n"; } + elsif ($rad eq 'rrtmgp') { + print $fh "$camsrcdir/src/physics/rrtmgp\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/extensions\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/gas-optics\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp-frontend\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte-frontend\n"; + if ($use_rrtmgp_gpu) { + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp-kernels/accel\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte-kernels/accel\n"; + } + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp-kernels\n"; + print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte-kernels\n"; + } if ($clubb_sgs) { - print $fh "$camsrcdir/src/physics/clubb\n"; + print $fh "$camsrcdir/src/physics/clubb/src/CLUBB_core\n"; } if ($silhs) { - print $fh "$camsrcdir/src/physics/silhs\n"; + print $fh "$camsrcdir/src/physics/clubb/src/SILHS\n"; } - print $fh "$camsrcdir/src/physics/pumas\n"; - - # Superparameterization - if ($phys_pkg eq 'spcam_m2005' or $phys_pkg eq 'spcam_sam1mom') { - print $fh "$camsrcdir/src/physics/spcam\n"; - print $fh "$camsrcdir/src/physics/spcam/crm\n"; - - # add additional directories for sam6.10.4 - print $fh "$camsrcdir/src/physics/spcam/crm/ADV_MPDATA\n"; - if ($phys_pkg eq 'spcam_sam1mom') { - print $fh "$camsrcdir/src/physics/spcam/crm/MICRO_SAM1MOM\n"; - } - if ($phys_pkg eq 'spcam_m2005') { - print $fh "$camsrcdir/src/physics/spcam/crm/MICRO_M2005\n"; - print $fh "$camsrcdir/src/physics/spcam/ecpp\n"; - } - if ( $spcam_clubb_sgs == 1 ) { - print $fh "$camsrcdir/src/physics/spcam/crm/CLUBB\n"; - print $fh "$camsrcdir/src/physics/spcam/crm/SGS_CLUBBkvhkvm\n" - } - else { - print $fh "$camsrcdir/src/physics/spcam/crm/SGS_TKE\n"; - } + if ($phys_pkg eq 'cam7') { + print $fh "$camsrcdir/src/physics/pumas\n"; + } else { + print $fh "$camsrcdir/src/physics/pumas-frozen\n"; } # This directory contains much of the code for physics packages, @@ -2188,6 +2148,16 @@ sub write_filepath # be overridden by modules from directories that occur earlier # in the list of filepaths. print $fh "$camsrcdir/src/physics/cam\n"; + print $fh "$camsrcdir/src/atmos_phys/to_be_ccppized\n"; + + #Add the CCPP'ized subdirectories + print $fh "$camsrcdir/src/atmos_phys/schemes/tropopause_find\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/zhang_mcfarlane\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/dry_adiabatic_adjust\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/check_energy\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/utilities\n"; + + print $fh "$camsrcdir/src/atmos_phys/schemes/cloud_fraction\n"; # Dynamics package and test utilities print $fh "$camsrcdir/src/dynamics/$dyn\n"; @@ -2204,16 +2174,10 @@ sub write_filepath print $fh "$camsrcdir/src/utils/pilgrim\n"; } - # Advective transport - if ($dyn eq 'eul') { - print $fh "$camsrcdir/src/advection/slt\n"; - } - print $fh "$camsrcdir/src/cpl/$cpl\n"; print $fh "$camsrcdir/src/control\n"; print $fh "$camsrcdir/src/utils\n"; - print $fh "$camsrcdir/src/atmos_phys/utilities\n"; - + print $fh "$camsrcdir/src/utils/cam_ccpp\n"; $fh->close; } @@ -2247,13 +2211,13 @@ sub write_cosp_makefile CAM_BLD := $cam_bld COSP_PATH := $cam_dir/src/physics/cosp2 -ISCCP_PATH := $cam_dir/src/physics/cosp2/src/simulator/icarus -RS_PATH := $cam_dir/src/physics/cosp2/src/simulator/quickbeam -RT_PATH := $cam_dir/src/physics/cosp2/src/simulator/rttov -CS_PATH := $cam_dir/src/physics/cosp2/src/simulator/actsim -MISR_PATH := $cam_dir/src/physics/cosp2/src/simulator/MISR_simulator -MODIS_PATH := $cam_dir/src/physics/cosp2/src/simulator/MODIS_simulator -PARASOL_PATH := $cam_dir/src/physics/cosp2/src/simulator/parasol +ISCCP_PATH := $cam_dir/src/physics/cosp2/src/src/simulator/icarus +RS_PATH := $cam_dir/src/physics/cosp2/src/src/simulator/quickbeam +RT_PATH := $cam_dir/src/physics/cosp2/src/src/simulator/rttov +CS_PATH := $cam_dir/src/physics/cosp2/src/src/simulator/actsim +MISR_PATH := $cam_dir/src/physics/cosp2/src/src/simulator/MISR_simulator +MODIS_PATH := $cam_dir/src/physics/cosp2/src/src/simulator/MODIS_simulator +PARASOL_PATH := $cam_dir/src/physics/cosp2/src/src/simulator/parasol EOF @@ -2308,7 +2272,8 @@ sub write_mpas_makefile print $fh_out <<"EOF"; -MPAS_SRC_ROOT := $cam_root/src/dynamics/mpas +MPAS_SRC_ROOT := $cam_dir/src/dynamics/mpas +COMP_INTERFACE:= $cpl EOF @@ -2385,9 +2350,9 @@ sub set_horiz_grid $hgrid =~ m/C(\d+)/; $cfg_ref->set('hgrid', $hgrid); } - elsif ($dyn_pkg =~ m/^eul$|^fv/) { + elsif ($dyn_pkg =~ m/^fv/) { - # For EUL and FV dycores the parameters are read from an input file, + # For FV dycore the parameters are read from an input file, # and if no dycore/grid matches are found then issue error message. my $xml = XML::Lite->new( $hgrid_file ); @@ -2416,26 +2381,7 @@ sub set_horiz_grid unless ($found) { die "set_horiz_grid: no match for dycore $dyn_pkg and hgrid $hgrid\n"; } # Set parameter values -- dycore specific. - if ( $dyn_pkg =~ m/eul/ ) { - $cfg_ref->set('nlat', $a{'nlat'}); - $cfg_ref->set('nlon', $a{'nlon'}); - $cfg_ref->set('trm', $a{'m'}); - $cfg_ref->set('trn', $a{'n'}); - $cfg_ref->set('trk', $a{'k'}); - - # Override resolution settings to configure for SCAM mode. The override is needed - # because in SCAM mode the -hgrid option is used to specify the resolution of default - # datasets from which single data columns are extracted. - my $scam = $cfg_ref->get('scam'); - if ($scam) { - $cfg_ref->set('nlat', 1); - $cfg_ref->set('nlon', 1); - $cfg_ref->set('trm', 1); - $cfg_ref->set('trn', 1); - $cfg_ref->set('trk', 1); - } - } - elsif ( $dyn_pkg eq 'fv' ) { + if ( $dyn_pkg eq 'fv' ) { $cfg_ref->set('nlat', $a{'nlat'}); $cfg_ref->set('nlon', $a{'nlon'}); } diff --git a/bld/namelist_files/geoschem_master_aer_drydep_list.xml b/bld/namelist_files/geoschem_master_aer_drydep_list.xml new file mode 100644 index 0000000000..a31d3ff31c --- /dev/null +++ b/bld/namelist_files/geoschem_master_aer_drydep_list.xml @@ -0,0 +1,91 @@ + + + + + + + dst_a1 + so4_a1 + nh4_a1 + pom_a1 + pomff1_a1 + pombb1_a1 + soa_a1 + bc_a1 + ncl_a1 + num_a1 + so4_a2 + nh4_a2 + soa_a2 + ncl_a2 + dst_a2 + num_a2 + dst_a3 + ncl_a3 + so4_a3 + pom_a3 + bc_a3 + num_a3 + ncl_a4 + so4_a4 + pom_a4 + pomff1_a4 + pombb1_a4 + bc_a4 + nh4_a4 + num_a4 + dst_a5 + so4_a5 + nh4_a5 + num_a5 + ncl_a6 + so4_a6 + nh4_a6 + num_a6 + dst_a7 + so4_a7 + nh4_a7 + num_a7 + soa1_a1 + soa1_a2 + soa2_a1 + soa2_a2 + soa3_a1 + soa3_a2 + soa4_a1 + soa4_a2 + soa5_a1 + soa5_a2 + soaff1_a1 + soaff2_a1 + soaff3_a1 + soaff4_a1 + soaff5_a1 + soabb1_a1 + soabb2_a1 + soabb3_a1 + soabb4_a1 + soabb5_a1 + soabg1_a1 + soabg2_a1 + soabg3_a1 + soabg4_a1 + soabg5_a1 + soaff1_a2 + soaff2_a2 + soaff3_a2 + soaff4_a2 + soaff5_a2 + soabb1_a2 + soabb2_a2 + soabb3_a2 + soabb4_a2 + soabb5_a2 + soabg1_a2 + soabg2_a2 + soabg3_a2 + soabg4_a2 + soabg5_a2 + + + diff --git a/bld/namelist_files/geoschem_master_aer_wetdep_list.xml b/bld/namelist_files/geoschem_master_aer_wetdep_list.xml new file mode 100644 index 0000000000..16391485fe --- /dev/null +++ b/bld/namelist_files/geoschem_master_aer_wetdep_list.xml @@ -0,0 +1,89 @@ + + + + + dst_a1 + so4_a1 + nh4_a1 + pom_a1 + pomff1_a1 + pombb1_a1 + soa_a1 + bc_a1 + ncl_a1 + num_a1 + so4_a2 + nh4_a2 + soa_a2 + ncl_a2 + dst_a2 + num_a2 + dst_a3 + ncl_a3 + so4_a3 + pom_a3 + bc_a3 + num_a3 + ncl_a4 + so4_a4 + pom_a4 + pomff1_a4 + pombb1_a4 + bc_a4 + nh4_a4 + num_a4 + dst_a5 + so4_a5 + nh4_a5 + num_a5 + ncl_a6 + so4_a6 + nh4_a6 + num_a6 + dst_a7 + so4_a7 + nh4_a7 + num_a7 + soa1_a1 + soa1_a2 + soa2_a1 + soa2_a2 + soa3_a1 + soa3_a2 + soa4_a1 + soa4_a2 + soa5_a1 + soa5_a2 + soaff1_a1 + soaff2_a1 + soaff3_a1 + soaff4_a1 + soaff5_a1 + soabb1_a1 + soabb2_a1 + soabb3_a1 + soabb4_a1 + soabb5_a1 + soabg1_a1 + soabg2_a1 + soabg3_a1 + soabg4_a1 + soabg5_a1 + soaff1_a2 + soaff2_a2 + soaff3_a2 + soaff4_a2 + soaff5_a2 + soabb1_a2 + soabb2_a2 + soabb3_a2 + soabb4_a2 + soabb5_a2 + soabg1_a2 + soabg2_a2 + soabg3_a2 + soabg4_a2 + soabg5_a2 + + + diff --git a/bld/namelist_files/geoschem_master_gas_drydep_list.xml b/bld/namelist_files/geoschem_master_gas_drydep_list.xml new file mode 100644 index 0000000000..dcf1ed67f8 --- /dev/null +++ b/bld/namelist_files/geoschem_master_gas_drydep_list.xml @@ -0,0 +1,171 @@ + + + + + + + ACET + ACTA + ALD2 + AROMP4 + AROMP5 + ATOOH + BALD + BENZP + BR2 + BRCL + BRNO3 + BZCO3H + BZPAN + CH2O + CL2 + CLNO2 + CLNO3 + CLO + CLOO + CSL + EOH + ETHLN + ETHN + ETHP + ETNO3 + ETP + FURA + GLYC + GLYX + H2O2 + HAC + HBR + HC5A + HCL + HCOOH + HI + HMHP + HMML + HNO3 + HOBR + HOCL + HOI + HONIT + HPALD1 + HPALD2 + HPALD3 + HPALD4 + HPETHNL + I2 + I2O2 + I2O3 + I2O4 + IBR + ICHE + ICL + ICN + ICPDH + IDC + IDCHP + IDHDP + IDHPE + IDN + IEPOXA + IEPOXB + IEPOXD + IHN1 + IHN2 + IHN3 + IHN4 + INPB + INPD + IONO + IONO2 + IPRNO3 + ITCN + ITHN + LIMO + LVOC + LVOCOA + MACR + MACR1OOH + MAP + MCRDH + MCRENOL + MCRHN + MCRHNB + MCRHP + MCT + MENO3 + MGLY + MOH + MONITS + MONITU + MPAN + MTPA + MTPO + MVK + MVKDH + MVKHC + MVKHCB + MVKHP + MVKN + MVKPC + N2O5 + NH3 + NO2 + NPHEN + NPRNO3 + O3 + PAN + PHEN + PP + PPN + PROPNN + PRPN + PYAC + R4N2 + R4P + RA3P + RB3P + RIPA + RIPB + RIPC + RIPD + RP + SO2 + AERI + AONITA + ASOA1 + ASOA2 + ASOA3 + ASOAN + ASOG1 + ASOG2 + ASOG3 + BRSALA + BRSALC + INDIOL + IONITA + ISALA + ISALC + MONITA + MSA + NH4 + NIT + NITS + SALAAL + SALACL + SALCAL + SALCCL + SO4S + SOAGX + SOAIE + TSOA0 + TSOA1 + TSOA2 + TSOA3 + TSOG0 + TSOG1 + TSOG2 + TSOG3 + PFE + + + diff --git a/bld/namelist_files/geoschem_master_gas_wetdep_list.xml b/bld/namelist_files/geoschem_master_gas_wetdep_list.xml new file mode 100644 index 0000000000..61c4ddd3a2 --- /dev/null +++ b/bld/namelist_files/geoschem_master_gas_wetdep_list.xml @@ -0,0 +1,153 @@ + + + + + ACTA + ALD2 + AROMP4 + AROMP5 + ATOOH + BALD + BENZP + BR2 + BRCL + BZCO3H + BZPAN + CH2O + CSL + EOH + ETHLN + ETHN + ETHP + ETP + FURA + GLYC + GLYX + H2O2 + HAC + HBR + HC5A + HCL + HCOOH + HI + HMHP + HMML + HNO3 + HOBR + HOCL + HOI + HONIT + HPETHNL + I2 + I2O2 + I2O3 + I2O4 + IBR + ICHE + ICL + ICN + ICPDH + IDCHP + IDHDP + IDHPE + IDN + IEPOXA + IEPOXB + IEPOXD + IHN1 + IHN2 + IHN3 + IHN4 + INPB + INPD + IONO + IONO2 + ITCN + ITHN + LIMO + LVOC + LVOCOA + MACR1OOH + MAP + MCRDH + MCRENOL + MCRHN + MCRHNB + MCRHP + MCT + MEK + MGLY + MOH + MONITS + MONITU + MP + MPAN + MPN + MTPA + MTPO + MVK + MVKDH + MVKHC + MVKHCB + MVKHP + MVKN + MVKPC + NH3 + NPHEN + PAN + PHEN + PP + PPN + PROPNN + PRPE + PRPN + PYAC + R4N2 + R4P + RA3P + RB3P + RIPA + RIPB + RIPC + RIPD + RP + SO2 + AERI + AONITA + ASOA1 + ASOA2 + ASOA3 + ASOAN + ASOG1 + ASOG2 + ASOG3 + BRSALA + BRSALC + INDIOL + IONITA + ISALA + ISALC + MONITA + MSA + NH4 + NIT + NITS + SALAAL + SALACL + SALCAL + SALCCL + SO4S + SOAGX + SOAIE + TSOA0 + TSOA1 + TSOA2 + TSOA3 + TSOG0 + TSOG1 + TSOG2 + TSOG3 + PFE + + + diff --git a/bld/namelist_files/master_gas_drydep_list.xml b/bld/namelist_files/master_gas_drydep_list.xml deleted file mode 100644 index fd947b2464..0000000000 --- a/bld/namelist_files/master_gas_drydep_list.xml +++ /dev/null @@ -1,193 +0,0 @@ - - - - - - - ALKOOH - APIN - BENZOOH - BZOOH - BCARY - BENZENE - BEPOMUC - BIGALD - BIGALD1 - BIGALD2 - BIGALD3 - BIGALD4 - BIGALK - BIGENE - BPIN - BZALD - C2H2 - C2H4 - C2H5OH - C2H5OOH - C2H6 - C3H6 - C3H7OOH - C6H5OOH - C3H8 - CH2O - CH3CHO - CH3CN - CH3COCH3 - CH3COCHO - CH3COOH - CH3COOOH - CH3OH - CH3OOH - CO - CRESOL - DHPMPAL - DMS - GLYALD - GLYOXAL - H2O2 - HCN - HCOCH2OOH - HCOOH - HMHP - HNO3 - HO2NO2 - HPALD - HPALD1 - HPALD4 - HPALDB1C - HPALDB4C - HYAC - HYDRALD - HYPERACET - ICHE - IEPOX - INHEB - INHED - ISOP - ISOPFDN - ISOPFDNC - ISOPFNC - ISOPFNP - ISOPHFP - ISOPN1D - ISOPN2B - ISOPN3B - ISOPN4D - ISOPNBNO3 - ISOPNOOHB - ISOPNOOHD - ISOPOH - ISOPNO3 - ISOPOOH - LIMON - MACR - MACRN - MACROOH - MEK - MEKOOH - MPAN - MTERP - MVK - MVKN - MVKOOH - MYRC - N2O5 - NH3 - NO - NO2 - NO3CH2CHO - O3 - O3S - ONIT - ONITR - PAN - PBZNIT - PHENOL - PHENOOH - POOH - ROOH - SO2 - H2SO4 - SQTN - TEPOMUC - TERP1OOH - TERP2AOOH - TERP2OOH - TERPA - TERPA2 - TERPA3 - TERPACID - TERPACID2 - TERPACID3 - TERPA2PAN - TERPA3PAN - TERPAPAN - TERPDHDP - TERPF1 - TERPF2 - TERPFDN - TERPHFN - TERPK - TERPOOHL - TERPNT - TERPNS - TERPNT1 - TERPNS1 - TERPNPT - TERPNPS - TERPNPT1 - TERPNPS1 - TERPOOH - TERPROD1 - TERPROD2 - TOLOOH - TOLUENE - XOOH - XYLENOOH - XYLOLOOH - Pb - EOOH - HI, HOI, IONO2, INO2, I2O2, I2O3, I2O4, BR2 - NOA, ALKNIT, ISOPNITA, ISOPNITB, HONITR - ISOPNOOH, NC4CHO, NC4CH2OH, TERPNIT, NTERPOOH - SOAGff0, SOAGff1, SOAGff2, SOAGff3, SOAGff4, SOAGbb0 - SOAGbb1, SOAGbb2, SOAGbb3, SOAGbb4, SOAGbg0, SOAGbg1, SOAGbg2, SOAGbg3, SOAGbg4, - SOAG0, SOAG1, SOAG2, SOAG3, SOAG4 - IVOC, SVOC, IVOCbb, IVOCff, SVOCbb, SVOCff - XYLENES - XYLOL - - - - - - CB1 - CB2 - NH4 - NH4NO3 - OC1 - OC2 - SO4 - SOA - - - - SOAM,SOAI,SOAT,SOAB,SOAX - SOGM,SOGI,SOGT,SOGB,SOGX - - - - - XNO - XNO2 - XHNO3 - XONIT - XONITR - XPAN - XMPAN - XHO2NO2 - XNH4NO3 - O3A - - - diff --git a/bld/namelist_files/master_gas_wetdep_list.xml b/bld/namelist_files/master_gas_wetdep_list.xml deleted file mode 100644 index 01d7bdb066..0000000000 --- a/bld/namelist_files/master_gas_wetdep_list.xml +++ /dev/null @@ -1,177 +0,0 @@ - - - - - - NH4, NH4NO3 - - - XNH4NO3 - - - - APIN - BPIN - BCARY - BENZENE - BEPOMUC - BIGALD - BIGALD1 - BIGALD2 - BIGALD3 - BIGALD4 - BIGALK - BIGENE - BZALD - C2H2 - C2H4 - C2H6 - C3H6 - C3H8 - CO - CRESOL - DMS - DHPMPAL - GLYOXAL - HCOCH2OOH - HMHP - HPALD1 - HPALD4 - HPALDB1C - HPALDB4C - HYPERACET - ICHE - INHEB - INHED - ISOP - ISOPHFP - ISOPOH - ISOPFDN - ISOPFDNC - ISOPFNC - ISOPFNP - ISOPN3B - ISOPN2B - ISOPN1D - ISOPN4D - ISOPNBNO3 - ISOPNOOHB - ISOPNOOHD - LIMON - MEK - MPAN - MTERP - MYRC - N2O5 - NO - NO2 - NO3CH2CHO - PAN - PBZNIT - PHENOL - SQTN - TERPNT - TERPNS - TERPNT1 - TERPNS1 - TERPNPT - TERPNPS - TERPNPT1 - TERPNPS1 - TERPFDN - TERPHFN - TERP1OOH - TERPDHDP - TERPF2 - TERPF1 - TERPA - TERPA2 - TERPK - TERPAPAN - TERPACID - TERP2AOOH - TERPA2PAN - TERPACID2 - TERPACID3 - TERPA3PAN - TERPOOHL - TERPA3 - TEPOMUC - TOLUENE - XYLENES - XYLOL - HCN - CH3CN - ALKOOH - BRONO2 - C2H5OH - C2H5OOH - C3H7OOH - CH2O - CH3CHO - CH3COCH3 - CH3COCHO - CH3COOH - CH3COOOH - CH3OH - CH3OOH - CLONO2 - GLYALD - H2O2 - HBR - HCL - HCOOH - HNO3 - HO2NO2 - HOBR - HOCL - HYAC - HYDRALD - ISOPNO3 - ISOPOOH - MACR - MACRN - MACROOH - MEKOOH - MVK - MVKN - MVKOOH - NH3 - ONIT - ONITR - Pb - POOH - ROOH - SO2 - H2SO4 - TERPOOH - TOLOOH - XOOH - COF2 - COFCL - HF - EOOH - IBR, ICL, BRNO2, CLNO2, HI, HOI, IONO2, BR2, IO, OIO, I2O2, I2O3, I2O4 - NH_50W, SO2t - BENZOOH, BZOOH, C6H5OOH, HMPROP, HPALD, IEPOX, MBOOOH, PHENOOH, TERP2OOH - TERPROD1, TERPROD2, XYLENOOH, XYLOLOOH, NOA, ALKNIT, ISOPNITA, ISOPNITB, HONITR, ISOPNOOH - NC4CHO, NC4CH2OH, TERPNIT, NTERPOOH, - SOAGff0, SOAGff1, SOAGff2, SOAGff3, SOAGff4, SOAGbb0 - SOAGbb1, SOAGbb2, SOAGbb3, SOAGbb4, SOAGbg0, SOAGbg1, SOAGbg2, SOAGbg3, SOAGbg4, - SOAG0, SOAG1, SOAG2, SOAG3, SOAG4 - IVOC, SVOC, IVOCbb, IVOCff, SVOCbb, SVOCff - NDEP, NHDEP - - - SOGM,SOGI,SOGT,SOGB,SOGX - - - - XHNO3 - XHO2NO2 - XONIT - XONITR - XISOPNO3 - - - diff --git a/bld/namelist_files/master_aer_drydep_list.xml b/bld/namelist_files/mozart_master_aer_drydep_list.xml similarity index 100% rename from bld/namelist_files/master_aer_drydep_list.xml rename to bld/namelist_files/mozart_master_aer_drydep_list.xml diff --git a/bld/namelist_files/master_aer_wetdep_list.xml b/bld/namelist_files/mozart_master_aer_wetdep_list.xml similarity index 100% rename from bld/namelist_files/master_aer_wetdep_list.xml rename to bld/namelist_files/mozart_master_aer_wetdep_list.xml diff --git a/bld/namelist_files/mozart_master_gas_drydep_list.xml b/bld/namelist_files/mozart_master_gas_drydep_list.xml new file mode 100644 index 0000000000..2d5264216c --- /dev/null +++ b/bld/namelist_files/mozart_master_gas_drydep_list.xml @@ -0,0 +1,193 @@ + + + + + + + ALKOOH + APIN + BENZOOH + BZOOH + BCARY + BENZENE + BEPOMUC + BIGALD + BIGALD1 + BIGALD2 + BIGALD3 + BIGALD4 + BIGALK + BIGENE + BPIN + BZALD + C2H2 + C2H4 + C2H5OH + C2H5OOH + C2H6 + C3H6 + C3H7OOH + C6H5OOH + C3H8 + CH2O + CH3CHO + CH3CN + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CO + CRESOL + DHPMPAL + DMS + GLYALD + GLYOXAL + H2O2 + HCN + HCOCH2OOH + HCOOH + HMHP + HNO3 + HO2NO2 + HPALD + HPALD1 + HPALD4 + HPALDB1C + HPALDB4C + HYAC + HYDRALD + HYPERACET + ICHE + IEPOX + INHEB + INHED + ISOP + ISOPFDN + ISOPFDNC + ISOPFNC + ISOPFNP + ISOPHFP + ISOPN1D + ISOPN2B + ISOPN3B + ISOPN4D + ISOPNBNO3 + ISOPNOOHB + ISOPNOOHD + ISOPOH + ISOPOOH + LIMON + MACR + MACRN + MACROOH + MEK + MEKOOH + MPAN + MTERP + MVK + MVKN + MVKOOH + MYRC + N2O5 + NH3 + NO + NO2 + NO3CH2CHO + O3 + O3S + ONIT + ONITR + PAN + PBZNIT + PHENOL + PHENOOH + POOH + ROOH + SO2 + H2SO4 + SQTN + TEPOMUC + TERP1OOH + TERP2AOOH + TERP2OOH + TERPA + TERPA2 + TERPA3 + TERPACID + TERPACID2 + TERPACID3 + TERPA2PAN + TERPA3PAN + TERPAPAN + TERPDHDP + TERPF1 + TERPF2 + TERPFDN + TERPHFN + TERPK + TERPOOHL + TERPNT + TERPNS + TERPNT1 + TERPNS1 + TERPNPT + TERPNPS + TERPNPT1 + TERPNPS1 + TERPOOH + TERPROD1 + TERPROD2 + TOLOOH + TOLUENE + XOOH + XYLENOOH + XYLOLOOH + Pb + EOOH + HI, HOI, IONO2, INO2, I2O2, I2O3, I2O4, BR2 + NOA, ALKNIT, ISOPNITA, ISOPNITB, HONITR + ISOPNOOH, NC4CHO, NC4CH2OH, TERPNIT, NTERPOOH + SOAG + SOAGff0, SOAGff1, SOAGff2, SOAGff3, SOAGff4, SOAGbb0 + SOAGbb1, SOAGbb2, SOAGbb3, SOAGbb4, SOAGbg0, SOAGbg1, SOAGbg2, SOAGbg3, SOAGbg4, + SOAG0, SOAG1, SOAG2, SOAG3, SOAG4 + IVOC, SVOC, IVOCbb, IVOCff, SVOCbb, SVOCff + XYLENES + XYLOL + + + + + + CB1 + CB2 + NH4 + NH4NO3 + OC1 + OC2 + SO4 + SOA + + + + SOAM,SOAI,SOAT,SOAB,SOAX + SOGM,SOGI,SOGT,SOGB,SOGX + + + + + XNO + XNO2 + XHNO3 + XONIT + XONITR + XPAN + XMPAN + XHO2NO2 + XNH4NO3 + O3A + + + diff --git a/bld/namelist_files/mozart_master_gas_wetdep_list.xml b/bld/namelist_files/mozart_master_gas_wetdep_list.xml new file mode 100644 index 0000000000..c937493abe --- /dev/null +++ b/bld/namelist_files/mozart_master_gas_wetdep_list.xml @@ -0,0 +1,176 @@ + + + + + + NH4, NH4NO3 + + + XNH4NO3 + + + + APIN + BPIN + BCARY + BENZENE + BEPOMUC + BIGALD + BIGALD1 + BIGALD2 + BIGALD3 + BIGALD4 + BIGALK + BIGENE + BZALD + C2H2 + C2H4 + C2H6 + C3H6 + C3H8 + CO + CRESOL + DMS + DHPMPAL + GLYOXAL + HCOCH2OOH + HMHP + HPALD1 + HPALD4 + HPALDB1C + HPALDB4C + HYPERACET + ICHE + INHEB + INHED + ISOP + ISOPHFP + ISOPOH + ISOPFDN + ISOPFDNC + ISOPFNC + ISOPFNP + ISOPN3B + ISOPN2B + ISOPN1D + ISOPN4D + ISOPNBNO3 + ISOPNOOHB + ISOPNOOHD + LIMON + MEK + MPAN + MTERP + MYRC + N2O5 + NO + NO2 + NO3CH2CHO + PAN + PBZNIT + PHENOL + SQTN + TERPNT + TERPNS + TERPNT1 + TERPNS1 + TERPNPT + TERPNPS + TERPNPT1 + TERPNPS1 + TERPFDN + TERPHFN + TERP1OOH + TERPDHDP + TERPF2 + TERPF1 + TERPA + TERPA2 + TERPK + TERPAPAN + TERPACID + TERP2AOOH + TERPA2PAN + TERPACID2 + TERPACID3 + TERPA3PAN + TERPOOHL + TERPA3 + TEPOMUC + TOLUENE + XYLENES + XYLOL + HCN + CH3CN + ALKOOH + BRONO2 + C2H5OH + C2H5OOH + C3H7OOH + CH2O + CH3CHO + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CLONO2 + GLYALD + H2O2 + HBR + HCL + HCOOH + HNO3 + HO2NO2 + HOBR + HOCL + HYAC + HYDRALD + ISOPOOH + MACR + MACRN + MACROOH + MEKOOH + MVK + MVKN + MVKOOH + NH3 + ONIT + ONITR + Pb + POOH + ROOH + SO2 + H2SO4 + TERPOOH + TOLOOH + XOOH + COF2 + COFCL + HF + EOOH + IBR, ICL, BRNO2, CLNO2, HI, HOI, IONO2, BR2, IO, OIO, I2O2, I2O3, I2O4 + NH_50W, SO2t + BENZOOH, BZOOH, C6H5OOH, HMPROP, HPALD, IEPOX, MBOOOH, PHENOOH, TERP2OOH + TERPROD1, TERPROD2, XYLENOOH, XYLOLOOH, NOA, ALKNIT, ISOPNITA, ISOPNITB, HONITR, ISOPNOOH + NC4CHO, NC4CH2OH, TERPNIT, NTERPOOH, + SOAG + SOAGff0, SOAGff1, SOAGff2, SOAGff3, SOAGff4, SOAGbb0 + SOAGbb1, SOAGbb2, SOAGbb3, SOAGbb4, SOAGbg0, SOAGbg1, SOAGbg2, SOAGbg3, SOAGbg4, + SOAG0, SOAG1, SOAG2, SOAG3, SOAG4 + IVOC, SVOC, IVOCbb, IVOCff, SVOCbb, SVOCff + NDEP, NHDEP + + + SOGM,SOGI,SOGT,SOGB,SOGX + + + + XHNO3 + XHO2NO2 + XONIT + XONITR + + + diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index f83f2b03c9..b84e2b6cf2 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -3,14 +3,6 @@ -1200 -300 -600 -1200 -1800 -1800 -1800 - 1800 300 @@ -23,6 +15,7 @@ 450 1800 +300 1800 1800 1800 @@ -42,9 +35,17 @@ atm/cam/inic/cam_vcoords_L30_c180105.nc atm/cam/inic/cam_vcoords_L32_c180105.nc - -atm/cam/inic/mpas/mpasa480_L32_v6.1.grid_c190924.nc -atm/cam/inic/mpas/mpasa120_L32_topo_grid_c201022.nc + +atm/cam/inic/mpas/mpasa480_L32_notopo_coords_c240507.nc +atm/cam/inic/mpas/mpasa120_L32_notopo_coords_c240507.nc +atm/cam/inic/mpas/mpasa60_L32_notopo_coords_c240507.nc +atm/cam/inic/mpas/mpasa30_L32_notopo_coords_c240507.nc +atm/cam/inic/mpas/mpasa480_L58_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa120_L58_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa60_L58_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa480_L93_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa120_L93_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa60_L93_notopo_coords_c240814.nc atm/cam/inic/fv/cami_0000-01-01_0.23x0.31_L26_c100513.nc @@ -73,6 +74,9 @@ atm/cam/inic/fv/f.e22.FC2010climo.f09_f09_mg17.cam6_2_022.001.cam.i.0016-01-01-00000_c200610.nc atm/cam/inic/fv/f.e22.FC2010climo.f09_f09_mg17.cam6_2_022.001.cam.i.0016-01-01-00000_c200610.nc +atm/cam/inic/fv/f.e22.FC2010climo.f09_f09_mg17.cam6_2_022.001.cam.i.0016-01-01-00000_c200610.nc +atm/cam/inic/fv/f.e22.FC2010climo.f09_f09_mg17.cam6_2_022.001.cam.i.0016-01-01-00000_c200610.nc +atm/cam/inic/fv/FC2000mam5_f10_0002-01-01_c221214.nc atm/cam/inic/fv/cami-mam3_0000-01-01_0.9x1.25_L32_c141031.nc atm/cam/inic/fv/cami-mam3_0000-01-01_1.9x2.5_L32_c150407.nc atm/cam/inic/fv/cami-mam4_0000-01-01_10x15_L32_c170914.nc @@ -102,13 +106,25 @@ atm/cam/inic/fv/camchemi_0012-01-01_1.9x2.5_L30_c081104.nc atm/cam/inic/fv/trop_strat_mam3_chem_2000-01-01_10x15_L30_c121015.nc +atm/cam/inic/fv/trop_strat_mam3_chem_2000-01-01_10x15_L30_c121015.nc atm/cam/inic/fv/trop_strat_mam3_chem_2000-01-01_4x5_L30_c121015.nc +atm/cam/inic/fv/trop_strat_mam3_chem_2000-01-01_4x5_L30_c121015.nc atm/cam/inic/fv/trop_strat_mam3_chem_2000-01-01_1.9x2.5_L30_c121015.nc +atm/cam/inic/fv/trop_strat_mam3_chem_2000-01-01_1.9x2.5_L30_c121015.nc atm/cam/inic/se/f.e22.FC2010climo.ne30_ne30_mg17.cam6_2_032.001.cam.i.0006-01-01-00000_c200623.nc +atm/cam/inic/se/f.e22.FC2010climo.ne30_ne30_mg17.cam6_2_032.001.cam.i.0006-01-01-00000_c200623.nc atm/cam/inic/se/f.e22.FC2010climo.ne30_ne30_mg17.cam6_2_032.001.cam.i.0006-01-01-00000_c200623.nc +atm/cam/inic/se/f.e22.FC2010climo.ne30_ne30_mg17.cam6_2_032.001.cam.i.0006-01-01-00000_c200623.nc atm/cam/inic/se/f.e22.FC2010climo.ne30pg3_ne30pg3_mg17.cam6_2_032.001.cam.i.0007-01-01-00000_c200623.nc +atm/cam/inic/se/f.e22.FC2010climo.ne30pg3_ne30pg3_mg17.cam6_2_032.001.cam.i.0007-01-01-00000_c200623.nc atm/cam/inic/se/f.e22.FCnudged.ne0CONUSne30x8_ne0CONUSne30x8_mt12.cam6_2_032.002.cam.i.2013-01-01-00000_c200623.nc +atm/cam/inic/se/f.e22.FCnudged.ne0CONUSne30x8_ne0CONUSne30x8_mt12.cam6_2_032.002.cam.i.2013-01-01-00000_c200623.nc +atm/cam/inic/se/f.e22.FCnudged.ne30_ne30_mg17.release-cesm2.2.0_spinup.2010_2020.001.cam.i.2011-01-01-00000_L58_c220310.nc +atm/cam/inic/se/f.cam6_3_160.FCMT_ne30.moving_mtn.001.cam.i.1996-01-01-00000_c240618.nc + +atm/cam/inic/se/FLT_L58_ne30pg3_IC_c220623.nc +atm/cam/inic/se/c153_ne30pg3_FMTHIST_x02.cam.i.1990-01-01-00000_c240618.nc atm/cam/chem/trop_mozart/ic/cami_0000-09-01_4x5_L26_c060217.nc atm/cam/chem/trop_mozart/ic/cami_0000-09-01_10x15_L26_c060216.nc @@ -119,6 +135,9 @@ atm/waccm/ic/f2000.waccm-mam3_1.9x2.5_L70.cam2.i.0017-01-01.c120410.nc atm/waccm/ic/aqua.cam6.waccmsc_1.9x2.5_L70.2000-01-01.c170123.nc atm/waccm/ic/aqua.waccm_tsmlt_1.9x2.5_L70_c170814.nc +atm/waccm/ic/aqua.waccm_tsmlt_1.9x2.5_L70_c170814.nc +atm/waccm/ic/aqua_waccm_ma_ne5np4_70L_c220729.nc +atm/waccm/ic/aqua_waccm_ma_ne5np4_70L_c220729.nc atm/waccm/ic/f2000.waccm-mam3_4x5_L70.cam2.i.0017-01-01.c121113.nc atm/waccm/ic/f2000.waccm-mam3_10x15_L70.cam2.i.0017-01-01.c141016.nc atm/waccm/ic/b1850.waccm-mam3_1.9x2.5_L70.cam2.i.0156-01-01.c120523.nc @@ -131,12 +150,20 @@ atm/waccm/ic/WAX3548T08CO_2003top_f2000.waccm_0017bottom_4x5_L81_c160630.nc atm/waccm/ic/WAX3548T08CO_2003top_f2000.waccm_0017bottom_10x15_L81_c141027.nc atm/waccm/ic/waccmx_aqua_4x5_L126_c170705.nc +atm/waccm/ic/f.c54137.FX2000climo.f19_f19.ZGTest.001.cam.i.0002-01-01-00000_c170817.nc atm/waccm/ic/fx2000_0.9x1.25_126lev_0002-01-01-00000_c181221.nc atm/waccm/ic/wcmx-cam6-phys_1.9x2.5_130lev_2000_c181115.nc atm/waccm/ic/wcmx-cam6-phys_0.9x1.25_130lev_2000_c190122.nc atm/waccm/ic/FC6X2000_f05_spinup01.cam.i.0002-01-01-00000_c190711.nc atm/waccm/ic/waccmx_mam4_aqua_4x5_L130_c180803.nc atm/waccm/ic/waccmx_mam4_aqua_1.9x2.5_L130_c180803.nc +atm/waccm/ic/waccmx_aqua_ne5np4_126L_c210304.nc +atm/waccm/ic/waccmx_ne16np4_126L_c200108.nc +atm/waccm/ic/fx2000_phys-ionos-cpl_ne16_spinup03.cam.i.0002-01-01-00000_c201005.nc +atm/waccm/ic/waccmx_aqua_ne16np4_126L_c191108.nc +atm/waccm/ic/waccmx4_neutral_aquap_ne16np4_126lev_c200827.nc +atm/waccm/ic/fx2000_phys-ionos-cpl_ne30_spinup01.cam.i.0002-01-01-00000_c201014.nc +atm/waccm/ic/waccmx_ne30pg3_c231005.nc atm/cam/inic/fv3/aqua_0006-01-01_C24_L32_c200625.nc atm/cam/inic/fv3/aqua_0006-01-01_C48_L32_c200625.nc @@ -166,29 +193,18 @@ atm/waccm/ic/f2000.waccm-mam3_C48_L70.cam2.i.0017-01-01_c200625.nc atm/waccm/ic/f2000.waccm-mam3_C96_L70.cam2.i.0017-01-01_c200625.nc -atm/cam/inic/gaus/T341clim01.cam2.i.0024-01-01-00000.nc -atm/cam/inic/gaus/cami_0000-01-01_256x512_L26_c030918.nc - -atm/cam/inic/gaus/cami_0000-01-01_128x256_L26_c030918.nc -atm/cam/inic/gaus/cami_0000-09-01_128x256_L26_c040422.nc - -atm/cam/inic/gaus/cami_0000-01-01_64x128_T42_L26_c031110.nc -atm/cam/inic/gaus/cami_0000-09-01_64x128_L26_c030918.nc -atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/inic/gaus/cami_0000-01-01_64x128_L32_c170510.nc -atm/cam/inic/gaus/cami_0000-01-01_64x128_L32_c170510.nc -atm/cam/inic/gaus/cami_0000-01-01_48x96_L26_c091218.nc -atm/cam/inic/gaus/cami_0000-09-01_48x96_L26_c040420.nc -atm/cam/inic/gaus/cami_0000-01-01_48x96_L30_c100426.nc -atm/cam/inic/gaus/cami_0000-09-01_32x64_L26_c030918.nc -atm/cam/inic/gaus/cami_0000-01-01_32x64_L30_c090107.nc -atm/cam/inic/gaus/cami_0000-01-01_8x16_L26_c030228.nc -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 +atm/cam/inic/se/F2000climo_ne5pg3_mg37_L32_01-01-31_c230520.nc +atm/cam/inic/se/F2000climo_ne5pg3_mg37_L58_01-01-31_c230520.nc atm/cam/inic/se/ape_topo_cam4_ne16np4_L26_c171020.nc atm/cam/inic/se/ape_topo_cam4_ne16np4_L30_c171020.nc atm/cam/inic/se/ape_topo_cam4_ne16np4_L32_c171020.nc @@ -206,7 +222,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 @@ -218,6 +234,7 @@ atm/cam/inic/se/ape_cam5_ne30np4_L30_c170417.nc atm/cam/inic/se/ape_cam5_ne120np4_L30_c170419.nc +atm/cam/inic/se/cam6_QPC6_aqua_ne3pg3_mg37_L32_01-01-31_c221214.nc atm/cam/inic/se/ape_cam6_ne5np4_L32_c170517.nc atm/cam/inic/se/ape_cam6_ne16np4_L32_c170509.nc atm/cam/inic/se/ape_cam6_ne30np4_L32_c170509.nc @@ -230,24 +247,26 @@ atm/waccm/ic/wa3_ne5np4_1950_spinup.cam2.i.1960-01-01-00000_c150810.nc atm/waccm/ic/FW2000_ne30_L70_01-01-0001_c200602.nc -atm/waccm/ic/FW2000_ne30pg3_L70_01-01-0001_c200602.nc +atm/waccm/ic/FWsc2000climo_ne30pg3_L70_0002-01-01_c221103.nc +atm/waccm/ic/FW2000.ne30pg3_ne30pg3_nlev70_c230906.nc atm/waccm/ic/FWsc2000_ne30pg3_L110_01-01-0001_c200521.nc atm/waccm/ic/FW2000_CONUS_30x8_L70_01-01-0001_c200602.nc -atm/cam/inic/mpas/mpasa120_L32_init.umjs.dry_c201021.nc +atm/waccm/ic/mpasa120_L70.waccm_topography_SC_c240904.nc - -atm/cam/topo/topo-from-cami_0000-01-01_256x512_L26_c030918.nc -atm/cam/topo/USGS-gtopo30_128x256_c050520.nc -atm/cam/topo/T42_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20180111.nc -atm/cam/topo/USGS-gtopo30_48x96_c050520.nc -atm/cam/topo/USGS-gtopo30_32x64_c050520.nc -atm/cam/topo/USGS-gtopo30_8x16_c050520.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa480_L32_CFSR_c240508.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa120_L32_CFSR_c240508.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa480_L58_CFSR_c240814.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa120_L58_CFSR_c240814.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa480_L93_CFSR_c240814.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa120_L93_CFSR_c240814.nc + atm/cam/topo/USGS_gtopo30_0.23x0.31_remap_c061107.nc atm/cam/topo/USGS_gtopo30_0.47x0.63_remap_c061106.nc atm/cam/topo/fv_0.47x0.63_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171023.nc +atm/cam/topo/fv_0.47x0.63_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171023.nc atm/cam/topo/topo-from-cami_0000-10-01_0.5x0.625_L26_c031204.nc atm/cam/topo/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_c170103.nc atm/cam/topo/fv_1.9x2.5_nc3000_Nsw084_Nrs016_Co120_Fi001_ZR_GRNL_c190405.nc @@ -273,24 +292,30 @@ atm/cam/topo/se/ne60pg2_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171014.nc atm/cam/topo/se/ne120pg2_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171012.nc atm/cam/topo/se/ne240pg2_nc3000_Co008_Fi001_PF_nullRR_Nsw005_20171014.nc - +atm/cam/topo/se/ne3np4_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230717.nc +atm/cam/topo/se/ne3pg3_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230209.nc atm/cam/topo/se/ne5pg3_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw064_20170516.nc atm/cam/topo/se/ne16pg3_nc3000_Co120_Fi001_PF_nullRR_Nsw084_20171012.nc -atm/cam/topo/se/ne30pg3_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20171014.nc +atm/cam/topo/se/ne30pg3_gmted2010_modis_bedmachine_nc3000_Laplace0100_noleak_20240720.nc atm/cam/topo/se/ne60pg3_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171012.nc atm/cam/topo/se/ne120pg3_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171014.nc atm/cam/topo/se/ne240pg3_nc3000_Co008_Fi001_PF_nullRR_Nsw005_20171015.nc -atm/cam/topo/se/ne5pg4_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw060_20170707.nc -atm/cam/topo/se/ne30pg4_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20171014.nc -atm/cam/topo/se/ne60pg4_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171018.nc -atm/cam/topo/se/ne120pg4_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171014.nc - atm/cam/topo/se/ne30x8_CONUS_nc3000_Co060_Fi001_MulG_PF_RR_Nsw042_c200428.nc atm/cam/topo/se/ne30x4_ARCTIC_nc3000_Co060_Fi001_MulG_PF_RR_Nsw042_c200428.nc atm/cam/topo/se/ne30x8_ARCTICGRIS_nc3000_Co060_Fi001_MulG_PF_RR_Nsw042_c200428.nc -atm/cam/topo/mpas/mpas_120_nc3000_Co060_Fi001_MulG_PF_Nsw042_c200921.nc +atm/cam/topo/mpas/mpasa480_gmted2010_modis_bedmachine_nc3000_Laplace0400_noleak_20240507.nc +atm/cam/topo/mpas/mpasa120_gmted2010_modis_bedmachine_nc3000_Laplace0100_noleak_20240507.nc + + + 0.0D0 + 101080.0D0 + + 98288.0D0 + 98288.0D0 + 98288.0D0 + 98288.0D0 atm/cam/topo/fv_0.9x1.25_nc3000_Nsw006_Nrs002_Co008_Fi001_ZR_c160505.nc @@ -315,22 +340,27 @@ held_suarez_1994 moist_baroclinic_wave_dcmip2016 moist_baroclinic_wave_dcmip2016 + moist_baroclinic_wave_dcmip2016 + + + + 1.0d-5 + 3.21d-5 + 1.0d0 + 0.1d0 + 0.310d0 + 1.4d0 + 6.0d0 + 1.5d0 + 0.1d0 + 1.d7 + 1.d0 + 271.d0 + 39.d0 + 26.d0 - -atm/cam/physprops/sul_cam3_c080918.nc -atm/cam/physprops/dustv1b1_cam3_c080918.nc -atm/cam/physprops/dustv1b2_cam3_c080918.nc -atm/cam/physprops/dustv1b3_cam3_c080918.nc -atm/cam/physprops/dustv1b4_cam3_c080918.nc -atm/cam/physprops/bcpho_cam3_c080918.nc -atm/cam/physprops/bcphi_cam3_c080918.nc -atm/cam/physprops/ocpho_cam3_c080918.nc -atm/cam/physprops/ocphi_cam3_c080918.nc -atm/cam/physprops/ssam_cam3_c080918.nc -atm/cam/physprops/sscm_cam3_c080918.nc - atm/cam/physprops/sulfate_camrt_c080918.nc @@ -385,6 +415,36 @@ atm/cam/physprops/ssam_rrtmg_c080918.nc atm/cam/physprops/sscm_rrtmg_c080918.nc + +atm/cam/physprops/sulfate_rrtmg_c080918.nc +atm/cam/physprops/sulfate_rrtmg_c080918.nc +atm/cam/physprops/dust1_rrtmg_c080918.nc +atm/cam/physprops/dust1_rrtmg_c080918.nc +atm/cam/physprops/dust2_rrtmg_c080918.nc +atm/cam/physprops/dust2_rrtmg_c080918.nc +atm/cam/physprops/dust3_rrtmg_c080918.nc +atm/cam/physprops/dust3_rrtmg_c080918.nc +atm/cam/physprops/dust4_rrtmg_c080918.nc +atm/cam/physprops/dust4_rrtmg_c080918.nc +atm/cam/physprops/bcpho_rrtmg_c080918.nc +atm/cam/physprops/bcpho_rrtmg_c080918.nc +atm/cam/physprops/bcphi_rrtmg_c080918.nc +atm/cam/physprops/bcphi_rrtmg_c080918.nc +atm/cam/physprops/ocpho_rrtmg_c080918.nc +atm/cam/physprops/ocpho_rrtmg_c080918.nc +atm/cam/physprops/ocphi_rrtmg_c080918.nc +atm/cam/physprops/ocphi_rrtmg_c080918.nc +atm/cam/physprops/seasalt1_rrtmg_c080918.nc +atm/cam/physprops/seasalt1_rrtmg_c080918.nc +atm/cam/physprops/seasalt2_rrtmg_c080918.nc +atm/cam/physprops/seasalt2_rrtmg_c080918.nc +atm/cam/physprops/seasalt3_rrtmg_c080918.nc +atm/cam/physprops/seasalt3_rrtmg_c080918.nc +atm/cam/physprops/seasalt4_rrtmg_c080918.nc +atm/cam/physprops/seasalt4_rrtmg_c080918.nc +atm/cam/physprops/ssam_rrtmg_c080918.nc +atm/cam/physprops/sscm_rrtmg_c080918.nc + @@ -397,13 +457,29 @@ atm/cam/physprops/dust_aeronet_rrtmg_c141106.nc atm/cam/physprops/sulfate_rrtmg_c080918.nc + +atm/cam/physprops/sulfate_rrtmg_c080918.nc +atm/cam/physprops/ocpho_rrtmg_c101112.nc +atm/cam/physprops/ocpho_rrtmg_c130709.nc +atm/cam/physprops/ocphi_rrtmg_c100508.nc +atm/cam/physprops/bcpho_rrtmg_c100508.nc +atm/cam/physprops/ssam_rrtmg_c100508.nc +atm/cam/physprops/dust_aeronet_rrtmg_c141106.nc +atm/cam/physprops/sulfate_rrtmg_c080918.nc + atm/cam/physprops/volc_camRT_byradius_sigma1.6_c130724.nc atm/cam/physprops/sulfuricacid_cam3_c080918.nc atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_c130724.nc -atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode1_c170214.nc -atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode2_c170214.nc -atm/cam/physprops/volc_camRRTMG_byradius_sigma1.2_mode3_c170214.nc +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode1_c210211.nc +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode2_c210211.nc +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.2_mode3_c210211.nc + + +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_c130724.nc +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode1_c210211.nc +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.6_mode2_c210211.nc +atm/cam/physprops/volc_camRRTMG_byradius_sigma1.2_mode3_c210211.nc atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_c141106.nc @@ -419,7 +495,13 @@ 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 +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_c141106.nc +atm/cam/physprops/mam4_mode4_rrtmg_c130628.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_sig1.2_dgnl.40_c150219.nc atm/cam/physprops/mam7_mode1_rrtmg_c120904.nc atm/cam/physprops/mam7_mode2_rrtmg_c120904.nc @@ -429,10 +511,41 @@ atm/cam/physprops/mam7_mode6_rrtmg_c120904.nc atm/cam/physprops/mam7_mode7_rrtmg_c120904.nc + +atm/cam/physprops/mam4_mode1_rrtmg_aeronetdust_c141106.nc +atm/cam/physprops/mam4_mode2_rrtmg_aitkendust_c141106.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_c141106.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_mode1_rrtmg_aeronetdust_c141106.nc +atm/cam/physprops/mam4_mode2_rrtmg_aitkendust_c141106.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_c141106.nc +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_mode1_rrtmg_aeronetdust_sig1.6_dgnh.48_c140304.nc +atm/cam/physprops/mam4_mode2_rrtmg_aitkendust_c141106.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_c141106.nc +atm/cam/physprops/mam4_mode4_rrtmg_c130628.nc +atm/cam/physprops/mam4_mode3_rrtmg_aeronetdust_sig1.2_dgnl.40_c150219.nc + +atm/cam/physprops/mam7_mode1_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode2_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode3_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode4_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode5_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode6_rrtmg_c120904.nc +atm/cam/physprops/mam7_mode7_rrtmg_c120904.nc + atm/cam/physprops/water_refindex_rrtmg_c080910.nc -.false. -.true. +.false. +.true. +.true. slingo @@ -442,6 +555,15 @@ atm/cam/physprops/iceoptics_c080917.nc atm/cam/physprops/F_nwvl200_mu20_lam50_res64_t298_c080428.nc + +gammadist +mitchell +atm/cam/physprops/iceoptics_c080917.nc +atm/cam/physprops/F_nwvl200_mu20_lam50_res64_t298_c080428.nc + +src/physics/rrtmgp/data/rrtmgp-gas-lw-g128.nc +src/physics/rrtmgp/data/rrtmgp-gas-sw-g112.nc + atm/cam/rad/abs_ems_factors_fastvx.c030508.nc @@ -469,7 +591,9 @@ ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc -ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc +ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc +ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc +ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc waccm_ozone_c121126.nc 0 @@ -525,15 +649,16 @@ atm/cam/ggas/ghg_hist_1765-2005_c091218.nc atm/waccm/lb/LBC_1765-2100_1.9x2.5_CCMI_RCP60_za_RNOCStrend_c141002.nc +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc -atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_0.9x1.25_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc +atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_175001-201512_fv_1.9x2.5_c20181011.nc ac_CO2_filelist_175001-201512_fv_0.9x1.25_c20181011.txt ac_CO2_filelist_175001-201512_fv_1.9x2.5_c20181011.txt @@ -553,30 +678,13 @@ atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_1.9x2.5_c20181011.nc atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_175001-201512_fv_1.9x2.5_c20181011.nc - -atm/cam/scyc/DMS_emissions_128x256_clim_c040122.nc -atm/cam/scyc/DMS_emissions_64x128_c030722.nc -atm/cam/scyc/DMS_emissions_32x64_c030722.nc -atm/cam/scyc/DMS_emissions_4x5_noncon_c050306.nc - - -atm/cam/scyc/oxid_128x256_L26_clim_c040112.nc -atm/cam/scyc/oxid_3d_64x128_L26_c030722.nc -atm/cam/scyc/oxid_3d_32x64_L26_c030722.nc -atm/cam/scyc/oxid_4x5_L26_noncon_c050306.nc - - -atm/cam/scyc/SOx_emissions_128x256_L2_1850-2000_c040321.nc -atm/cam/scyc/SOx_emissions_64x128_L2_c030722.nc -atm/cam/scyc/SOx_emissions_32x64_L2_c030722.nc -atm/cam/scyc/SOx_emissions_4x5_noncon_c050306.nc - atm/cam/ggas/noaamisc.r8.nc atm/waccm/phot/xh2o_c080826.nc atm/waccm/phot/xh2o_c080826.nc +atm/waccm/phot/xh2o_c080826.nc atm/waccm/ub @@ -607,8 +715,15 @@ atm/waccm/solar/solar_wind_imf_OMNI_WACCMX_2000001-2017365_c180731.nc + +80.D0 + -atm/waccm/qbo/qbocyclic28months.nc +atm/waccm/qbo/qbocoefficients_c151023.nc 0.125D0 @@ -627,6 +742,7 @@ 3.00D-15 7.5D-16 3.0D-15 + 30.D0 @@ -639,42 +755,75 @@ 18 -0.1D0 +0.7D0 0.4D0 +0.30D0 +0.70D0 0.55D0 0.5D0 -0.325D0 +0.5D0 0.7D0 +0.5D0 0.5D0 0.5D0 +0.5D0 +0.5D0 + 0.0625D0 +1.0D0 + +1.0D0 +0.5D0 +0.5D0 + +1.0D0 +0.5D0 +0.5D0 + 0.03D0 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 0.5d0 0.5d0 +0.5d0 +0.5d0 1.d0 2.d0 +2.d0 2.d0 2.d0 +2.d0 +2.d0 .true. .false. +.false. .false. .false. +.false. +.false. .false. .true. +.true. .true. .true. -.true. -.false. +.true. +.true. +.true. +.false. +.false. +.false. .false. .false. +.false. +.false. .true. @@ -689,6 +838,12 @@ 1.0d-3 0.002d0 0.1d0 + 0.01d0 + 1.0d0 + 65000.0d0 + 32500.0d0 + 1 + 15 @@ -702,22 +857,52 @@ atm/waccm/efld/wei05sc_c080415.nc 5 30 +30 90 -.false. -.true. -.true. +.true. + + + 144,96 + 144,96 + 288,192 + 288,192 + 576,384 + +80x97 +160x193 +160x193 +320x385 + + +atm/cam/coords/fv0.47x0.63_esmf_c210305.nc +atm/cam/coords/fv0.9x1.25_esmf_c210305.nc +atm/cam/coords/fv1.9x2.5_esmf_200428.nc +atm/cam/coords/fv4x5_esmf_c210305.nc +atm/cam/coords/ne5np4_esmf_20191204.nc +atm/cam/coords/ne5np4.pg3_esmf_mesh_c210121.nc +atm/cam/coords/ne16np4_esmf_c210305.nc +share/meshes/ne16pg3_ESMFmesh_cdf5_c20211018.nc +atm/cam/coords/ne30np4_esmf_c210305.nc +atm/cam/coords/ne30pg3_esmf_20200428.nc 1.00D0 -1.80D0 -1.80D0 -1.50D0 -1.30D0 -1.60D0 -0.32D0 +1.80D0 +1.80D0 +1.50D0 +1.30D0 +1.60D0 +0.32D0 +1.50D0 +1.30D0 +1.60D0 +0.32D0 atm/cam/chem/trop_mozart/emis/megan21_emis_factors_78pft_c20161108.nc + +atm/cam/chem/ocnexch/SSS_climatology_f09f09_c20230110.nc +atm/cam/chem/ocnexch/Csw_DMS_Lana2011_f09f09_1750_2100_20200717a.nc atm/cam/chem/trop_mozart/emis/emissions.aircraft.T42LR.nc @@ -1166,6 +1351,11 @@ atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_so4_a1_anthro-ene_vertical_mol_175001-201412_ne30pg3_c20200103.nc atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_num_so4_a1_anthro-ene_vertical_mol_175001-201412_ne30pg3_c20200103.nc +atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_bc_a4_aircraft_vertical_1750-2015_ne30pg3_c20231112.nc +atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_num_bc_a4_aircraft_vertical_1750-2015_ne30pg3_c20231112.nc +atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_NO2_aircraft_vertical_1750-2015_ne30pg3_c20231112.nc +atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_SO2_aircraft_vertical_1750-2015_ne30pg3_c20231112.nc + atm/cam/chem/emis/historical_ne30pg2/emissions-cmip6_DMS_other_surface_1750_2015_ne30pg2_c20200630.nc @@ -1265,101 +1455,195 @@ -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_so4_a1_anthro-ene_vertical_v3.1_c20191104.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_num_so4_a1_anthro-ene_vertical_v3.1_c20191104.nc -atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc -atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc -atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc -atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc -atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_SO2_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc - -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_bc_a4_v3.1_c20191103.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_num_bc_a4_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_bc_a4_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_num_bc_a4_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_pom_a4_v3.1_c20191103.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_num_pom_a4_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_pom_a4_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_num_pom_a4_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_so4_a1_anthro-ag-ship_surface_v3.1_c20191103.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_num_so4_a1_anthro-ag-ship_surface_v3.1_c20191103.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_so4_a2_anthro-res_surface_v3.1_c20191103.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_num_so4_a2_anthro-res_surface_v3.1_c20191103.nc - -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_BENZENE_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_BENZENE_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_BIGALD_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_BIGALK_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_BIGALK_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_BIGENE_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_BIGENE_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C2H2_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C2H2_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C2H4_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C2H4_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_C2H4_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C2H5OH_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C2H5OH_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C2H6_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C2H6_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_C2H6_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C3H6_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C3H6_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_C3H6_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C3H8_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C3H8_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_C3H8_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH2O_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH2O_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3CHO_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3CHO_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3CN_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3CN_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3COCH3_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3COCH3_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3COCHO_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3COOH_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3COOH_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3OH_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3OH_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CO_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CO_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_CO_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CRESOL_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_DMS_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_GLYALD_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_HCN_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_HCN_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_HCOOH_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_HCOOH_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_HYAC_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_ISOP_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_ISOP_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_IVOC_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_IVOC_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_MACR_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_MEK_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_MEK_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_MTERP_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_TERPENES_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_MVK_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_NH3_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_NH3_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_NH3_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_NOx_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_NO_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_NO_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_NO2_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_SO2_anthro-ag-ship-res_surface_v3.1_c20191103.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_SO2_anthro-ene_surface_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_SO2_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_SOAGx1.5_v3.1_c20191103.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_SVOC_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_SVOC_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_TOLUENE_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_TOLUENE_bb_surface_20100101-20171231_ne0conus_c200619.nc -atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_XYLENES_v3.1_c20191103.nc -atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_XYLENES_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_so4_a1_anthro-ene_vertical_v3.1_c20191104.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_num_so4_a1_anthro-ene_vertical_v3.1_c20191104.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_SO2_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc + +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_so4_a1_anthro-ene_vertical_v3.1_c20191104.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_num_so4_a1_anthro-ene_vertical_v3.1_c20191104.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_SO2_contvolcano_vertical_850-5000_ne0CONUSne30x8_c20191202.nc + +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_bc_a4_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_num_bc_a4_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_bc_a4_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_num_bc_a4_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_pom_a4_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_num_pom_a4_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_pom_a4_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_num_pom_a4_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_so4_a1_anthro-ag-ship_surface_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_num_so4_a1_anthro-ag-ship_surface_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_so4_a2_anthro-res_surface_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_num_so4_a2_anthro-res_surface_v3.1_c20191103.nc + +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_bc_a4_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_num_bc_a4_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_bc_a4_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_num_bc_a4_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_pom_a4_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_num_pom_a4_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_pom_a4_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_num_pom_a4_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_so4_a1_anthro-ag-ship_surface_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_num_so4_a1_anthro-ag-ship_surface_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_so4_a2_anthro-res_surface_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_num_so4_a2_anthro-res_surface_v3.1_c20191103.nc + +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_BENZENE_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_BENZENE_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_BIGALD_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_BIGALK_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_BIGALK_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_BIGENE_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_BIGENE_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C2H2_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C2H2_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C2H4_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C2H4_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_C2H4_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C2H5OH_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C2H5OH_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C2H6_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C2H6_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_C2H6_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C3H6_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C3H6_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_C3H6_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C3H8_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C3H8_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_C3H8_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH2O_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH2O_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3CHO_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3CHO_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3CN_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3CN_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3COCH3_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3COCH3_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3COCHO_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3COOH_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3COOH_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3OH_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3OH_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CO_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CO_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_CO_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CRESOL_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_DMS_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_GLYALD_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_HCN_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_HCN_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_HCOOH_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_HCOOH_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_HYAC_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_ISOP_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_ISOP_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_IVOC_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_IVOC_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_MACR_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_MEK_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_MEK_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_MTERP_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_TERPENES_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_MVK_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_NH3_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_NH3_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_NH3_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_NOx_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_NO_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_NO_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_NO2_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_SO2_anthro-ag-ship-res_surface_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_SO2_anthro-ene_surface_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_SO2_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_SOAGx1.5_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_SVOC_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_SVOC_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_TOLUENE_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_TOLUENE_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_XYLENES_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_XYLENES_bb_surface_20100101-20171231_ne0conus_c200619.nc + +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_BIGALD_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_BIGALK_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_BIGALK_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_BIGENE_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_BIGENE_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C2H2_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C2H2_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C2H4_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C2H4_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_C2H4_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C2H5OH_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C2H5OH_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C2H6_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C2H6_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_C2H6_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C3H6_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C3H6_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_C3H6_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_C3H8_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_C3H8_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_C3H8_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH2O_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH2O_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3CHO_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3CHO_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3CN_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3CN_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3COCH3_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3COCH3_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3COCHO_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3COOH_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3COOH_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CH3OH_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CH3OH_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_CO_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CO_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_CO_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_CRESOL_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_DMS_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_GLYALD_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_HCN_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_HCN_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_HCOOH_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_HCOOH_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_HYAC_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_ISOP_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_ISOP_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_IVOC_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_IVOC_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_MACR_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_MEK_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_MEK_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_MTERP_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_TERPENES_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_MVK_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_NH3_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_NH3_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_NH3_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_NOx_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_NO_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/historical_ne0CONUSne30x8/emissions-cmip6_NO_other_surface_1750_2015_historical_ne0CONUSne30x8_c20191028.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_NO2_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_SO2_anthro-ag-ship-res_surface_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_SO2_anthro-ene_surface_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_SO2_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_SOAGx1.5_v3.1_c20191103.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_SVOC_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_SVOC_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_TOLUENE_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_TOLUENE_bb_surface_20100101-20171231_ne0conus_c200619.nc +atm/cam/chem/emis/CAMS_Anthro_ne0CONUSne30x8/CAMS-GLOB-ANT_Glb_ne0CONUSne30x8_anthro_surface_XYLENES_v3.1_c20191103.nc +atm/cam/chem/emis/finn1.5/CONUSne30x8/emissions-finnv1.5_XYLENES_bb_surface_20100101-20171231_ne0conus_c200619.nc @@ -1592,10 +1876,14 @@ oxid_1.9x2.5_L26_1850-2005_c091123.nc -oxid_1.9x2.5_L26_1850clim_c091123.nc -1850 -oxid_1.9x2.5_L26_1850clim_c091123.nc -1850 +oxid_1.9x2.5_L26_1850clim_c091123.nc +1850 +oxid_1.9x2.5_L26_1850clim_c091123.nc +1850 +oxid_1.9x2.5_L26_1850clim_c091123.nc +1850 +oxid_1.9x2.5_L26_1850clim_c091123.nc +1850 atm/cam/chem/trop_mozart_aero/oxid CYCLICAL @@ -1617,6 +1905,8 @@ halons_oxid_1.9x2.5zm_L66_1849-2099_c160714.nc atm/waccm/halons +halons_oxid_1.9x2.5zm_L66_1849-2099_c160714.nc +atm/waccm/halons CYCLICAL 2000 @@ -1627,26 +1917,35 @@ 1995 -CESM_1949_2100_sad_V2_c130627.nc -atm/waccm/sulf -CESM_1849_2100_sad_V3_c160211.nc -atm/cam/volc -ozone_strataero_CAM6chem_1849-2014_zm_5day_c170924.nc -atm/cam/ozone -ozone_strataero_WACCM6_L70_zm5day_19750101-20141229_c180216.nc -atm/cam/ozone_strataero +CESM_1949_2100_sad_V2_c130627.nc +atm/waccm/sulf +CESM_1849_2100_sad_V3_c160211.nc +atm/cam/volc +ozone_strataero_CAM6chem_1849-2014_zm_5day_c170924.nc +atm/cam/ozone +ozone_strataero_WACCM6_L70_zm5day_19750101-20141229_c180216.nc +atm/cam/ozone_strataero +CESM_1849_2100_sad_V3_c160211.nc +atm/cam/volc +ozone_strataero_CAM6chem_1849-2014_zm_5day_c170924.nc +atm/cam/ozone +ozone_strataero_WACCM6_L70_zm5day_19750101-20141229_c180216.nc +atm/cam/ozone_strataero atm/waccm/sulf/sulfate.ar5_camchem_c130304.nc NEU -MOZ -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 atm/cam/chem/trop_mam/atmsrf_ne16np4_110920.nc +atm/cam/chem/trop_mam/atmsrf_ne16pg3_c230520.nc atm/cam/chem/trop_mam/atmsrf_ne30np4_110920.nc atm/cam/chem/trop_mam/atmsrf_ne30np4.pg2_200108.nc atm/cam/chem/trop_mam/atmsrf_ne30pg3_180522.nc @@ -1665,47 +1964,70 @@ atm/cam/chem/trop_mam/atmsrf_C192_c200625.nc atm/cam/chem/trop_mam/atmsrf_C384_c200625.nc +atm/cam/chem/trop_mam/atmsrf_mpasa120_c090720.nc +atm/cam/chem/trop_mam/atmsrf_mpasa480_c090720.nc + atm/cam/chem/trop_mozart/dvel/regrid_vegetation.nc atm/cam/chem/trop_mozart/dvel/regrid_vegetation_all_zero_aquaplanet_1deg_regularGrid_c20170421.nc + +atm/cam/chem/trop_mozart/dvel/dep_data_c20221208.nc +atm/cam/chem/geoschem/dvel/dep_data_file_geoschem_v14.3_2023Jan08.nc + atm/waccm/phot/effxstex.txt -atm/cam/chem/trop_mozart/phot/tuv_xsect.nc -atm/cam/chem/trop_mozart/phot/o2src.nc -atm/waccm/phot/xs_short_jpl10_c140303.nc -atm/waccm/phot/temp_prs_GT200nm_JPL10_c140624.nc +atm/waccm/phot/xs_short_c221005mm.nc +atm/waccm/phot/temp_prs_GT200nm_c221005mm.nc atm/waccm/phot/RSF_GT200nm_v3.0_c080811.nc atm/cam/chem/trop_mozart/phot/exo_coldens.nc atm/waccm/ub/tgcm_ubc_1993_c100204.nc atm/waccm/ub/snoe_eof.nc + + 'T->MSIS','Q->2.d-8vmr','CH4->2.d-10vmr','F->1.0D-15mmr','HF->1.0D-15mmr','H->MSIS','N->MSIS','O->MSIS','O2->MSIS','H2->TGCM','NO->SNOE' + + + 'T->MSIS','Q->2.d-8vmr','CH4->2.d-10vmr' + atm/cam/chem/trop_mozart/ub/ubvals_b40.20th.track1_1996-2005_c110315.nc - - -atm/cam/rad/carbon_penner_cooke_doubled_64x128_c021120.nc -atm/cam/rad/carbon_penner_cooke_doubled_32x64_c021120.nc -atm/cam/rad/carbon_penner_cooke_doubled_4x5_c021120.nc - atm/cam/dst/dst_source2x2tunedcam6-2x2-04062017.nc atm/cam/dst/dst_source2x2_cam5.4_c150327.nc atm/cam/dst/dst_source2x2tuned-cam4-06132012.nc atm/cam/dst/dst_source1x1tuned-cam4-06202012.nc + +share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc + +lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc +lnd/clm2/ndepdata/fndep_clm_WACCM6_CMIP6piControl001_y21-50avg_1850monthly_0.95x1.25_c180802.nc + +2000 +1850 +1850 +2010 + +2000 +1850 +2015 +2010 + +1 +1850 + .false. .true. .true. .false. - .true. + .false. 0.075D0 - 0.100D0 0.100D0 1.0D0 @@ -1713,18 +2035,19 @@ .false. .true. + .true. .false. .true. .true. - .true. + .true. 0 1 1 - 1 + 1 0.01d0 0.001d0 @@ -1732,84 +2055,152 @@ .false. .true. - .true. .false. .false. - - .false. + .false. - .false. - .true. - .false. .false. + .false. + 300.0D0 1.0D0 + .false. - 300.0D0 - 150.0D0 - 150.0D0 - 75.0D0 - 150.0D0 - 75.0D0 + + .false. + + + 2.4 + 5.0 1.0 1.0 + 0.7D0 + 0.35D0 + 2.2D0 + 1.6D0 1.0 - 1.0 1.3 + 1.0 5.2 + 4.0 + 6.0 + 1.0 + 4.0 + 6.0 + 1.0 0.5 + 0.1 0.5 4.2 + 4.5 0.0 - 0.7D0 - 0.35D0 - 2.2D0 - 1.6D0 - 0.25 - 20.0 + 1.0 + 0.1 + 0.02 + 0.1 + 0.0 + 0.2 + 0.0 + 0.2 + 0.75 0.5 0.3 + 0.125 + 1.25 + 0.25 + 0.3 + 0.1 + 0.3 + 0.0 + 0.4 + 25.0D-6 + 61.0D-6 + 8.0D-6 + 238.15D0 + .true. .false. 0.308 - 0.280 - 0.270 + 0.3 + 0.280 0.32 - 2.4 + 0.3 + 2 0.04 0.1 - 1.0D0 - 0.0 - 4.5 - 2.0 - 0.0 - .false. + .false. + .true. + .false. .true. + .false. + .false. .false. + .false. + .false. + .false. + .true. + .false. + .false. + .false. + .true. + .false. + .false. + .false. + .true. + .false. .false. - .false. - .false. + .false. + .true. + .true. + .true. + .true. + .true. + .true. + .false. .false. + .true. + .false. .false. + .false. + .false. + .false. .true. + .false. + .true. .true. .true. + .true. .true. - .false. .false. + .false. .true. - .false. + .true. + .false. .false. + .false. + .false. + .false. .true. - .false. - .false. + 1.0D0 + 5.0 + 20.0 + 1 + 0.0 + 4.5 + 1 + 2.0 + 60.0 + 0.5 + 25.0 +.false. +.true. +.true. .true. - 0.2 0.2 0.2 @@ -1819,12 +2210,11 @@ 0.02 0.5 0.5 - 1.0 + 0.5 0.25 20.0 2.0 1.0 - .false. 0.24 0.37 0.03 @@ -1832,8 +2222,9 @@ 1.5 4.0 10.0 - 4.0 + 4.0 0.0 + 5.0 .true. .false. @@ -1851,7 +2242,10 @@ .true. .false. .false. - .true. + .false. + 0.5 + 25.00 + .false. @@ -1870,26 +2264,20 @@ RK MG MG -SPCAM_m2005 -SPCAM_sam1mom -MG +MG +MG 1 0 1 - 400.D-6 - 2 - 0 - 1 - 500.D-6 - 390.D-6 - 200.D-6 + 2 + 0 + 1 - 3 - 0 - 1 - 500.D-6 + 3 + 0 + 1 .false. .true. @@ -1897,8 +2285,57 @@ max_overlap in_cloud - 1.0D0 - 1.0D0 + 1.D0 + 1.D0 + + 1.D0 + 1.D0 + + 0.01D0 + 0.01D0 + + -1.1D0 + -1.1D0 + + 2.47D0 + 2.47D0 + + 2.D0 + + 1.D0 + 1.D0 + + 1.D0 + + 1.D0 + + 0.2D0 + 0.1D0 + + 0.1D0 + 0.0D0 + + 0.001D0 + + 25.D-6 + 25.D-6 + + 1.D0 + 1.D0 + + 1.D0 + 1.D0 + + 1.D0 + 1.D0 + + 1.D8 + 1.D8 + + .true. + .true. + kk2000 + .true. 1 3 @@ -1910,6 +2347,11 @@ 1 1 3 + + 2 + 1 + 2 + 1 1.0D0 @@ -1924,16 +2366,21 @@ 1.2D0 1.2D0 -.false. -.true. +.false. +.true. +.true. +0.01D0 +0.05D0 -.false. -.true. +.false. +.true. +.true. -.true. -.false. -1.0D0 -.true. +.true. +.false. +.false. +1.0D0 +.true. .true. @@ -1944,8 +2391,6 @@ rk park CLUBB_SGS -SPCAM_sam1mom -SPCAM_m2005 @@ -1960,22 +2405,25 @@ 0.D0 -1.D0 -0.D0 -0.D0 +1.D0 +0.D0 +0.D0 +0.D0 1.D0 40.D3 -40.D3 -30.D0 -100.D0 -100.D0 +40.D3 +30.D0 +100.D0 +100.D0 +100.D0 -100.D3 -100.D0 -100.D0 +100.D3 +100.D0 +100.D0 +100.D0 30.D0 40.D0 @@ -1990,42 +2438,68 @@ 0.37D0 0.35D0 -0.35D0 0.45D0 -0.45D0 0.45D0 0.35D0 +2.30D0 0.30D0 +2.30D0 0.45D0 +2.30D0 0.45D0 -0.45D0 +2.30D0 0.55D0 0.22D0 0.70D0 -0.8D0 -0.8D0 -0.8D0 -0.8D0 -0.8D0 -0.8D0 +2.30D0 +2.30D0 +0.8D0 +2.30D0 +0.8D0 +2.30D0 +0.8D0 +2.30D0 +0.8D0 +2.30D0 +0.8D0 +2.30D0 +0.8D0 +2.30D0 +0.8D0 +2.30D0 +0.8D0 +2.30D0 +0.8D0 +2.30D0 +0.8D0 +2.30D0 0.70D0 -0.13D0 - -0.26D0 -0.7D0 -0.24D0 -0.9D0 +2.300D0 + +0.26D0 +2.30D0 +0.7D0 +2.30D0 +0.24D0 +2.30D0 +0.9D0 +2.30D0 + + + Zender_2003 + Leung_2023 +atm -1.35D0 -1.62D0 -0.90D0 -1.00D0 -1.10D0 -1.2D0 -0.60D0 +1.35D0 +1.62D0 +0.90D0 +1.00D0 +1.50D0 +1.10D0 +0.60D0 1.0D0 @@ -2039,9 +2513,6 @@ 0.4D0 1.0D0 -1.00D0 -1.00D0 - .false. .true. @@ -2086,6 +2557,17 @@ 0.0 0.0 + .true. + .false. + .false. + .true. + .true. + .false. + .true. + .true. + .true. + .false. + .true. NONE @@ -2093,16 +2575,12 @@ HB HBR CLUBB_SGS -SPCAM_m2005 -SPCAM_sam1mom ZM off UNICON NONE -SPCAM -SPCAM NONE UW @@ -2110,8 +2588,6 @@ Hack Hack CLUBB_SGS -SPCAM -SPCAM .true. @@ -2119,6 +2595,7 @@ .false. .true. .true. +.true. 0.900D0 0.910D0 @@ -2131,37 +2608,38 @@ 0.8875D0 0.9125D0 - 0.910D0 - 0.950D0 - 0.950D0 + 0.910D0 + 0.950D0 + 0.950D0 0.8975D0 - 0.8875D0 + 0.8875D0 0.9125D0 + 0.910D0 + 0.950D0 + 0.950D0 + 0.8975D0 + 0.8875D0 + 0.9125D0 + 0.910D0 0.920D0 0.920D0 0.913D0 - 0.903D0 - 0.905D0 - 0.880D0 0.910D0 0.100D0 0.000D0 + 0.000D0 0.000D0 0.800D0 0.770D0 0.700D0 0.770D0 - 0.500D0 0.900D0 0.900D0 - 0.680D0 - 0.680D0 - 0.650D0 0.07D0 0.04D0 @@ -2173,6 +2651,7 @@ 0.14D0 0.10D0 0.10D0 + 0.10D0 0.10D0 0.10D0 @@ -2182,35 +2661,34 @@ 25000.0D0 25000.0D0 25000.0D0 - 25000.0D0 - 25000.0D0 - 25000.0D0 40000.0D0 40000.0D0 40000.0D0 40000.0D0 - 40000.0D0 - 40000.0D0 - 40000.0D0 40000.0D0 750.0D2 700.0D2 700.0D2 + 700.0D2 1 5 5 - 4 - 4 - 4 + 5 + 4 + 4 + 4 + 4 0.95D0 0.93D0 0.93D0 - 0.70D0 - 0.70D0 - 0.70D0 + 0.93D0 + 0.70D0 + 0.70D0 + 0.70D0 + 0.70D0 0.80D0 0.85D0 @@ -2222,15 +2700,19 @@ 1.1D0 1.0D0 1.05D0 - 1.0D0 1.1D0 1.0D0 - 1.0D0 + +1.e-7 +5.e-3 .false. -.false. -.true. +.false. +.true. +.true. + +.false. 5.0e-6 @@ -2245,10 +2727,6 @@ 9.5e-6 9.5e-6 - 30.0e-6 - 20.0e-6 - 16.0e-6 - 1.0e-6 18.0e-6 4.0e-4 @@ -2258,13 +2736,9 @@ 10.0e-6 5.0e-6 - 5.0e-6 - 5.0e-6 - 5.0e-6 5.0e-6 10.0e-6 - 1.0e-6 1800.0D0 @@ -2275,10 +2749,6 @@ 2.0e-4 2.0e-4 - 1.0e-5 - 1.0e-5 - 1.0e-4 - 1.0e-4 1.0e-4 @@ -2308,12 +2778,13 @@ 0.0035D0 0.0075D0 0.0075D0 + 0.0059D0 + 0.0035D0 + 0.0035D0 + 0.0075D0 + 0.0075D0 0.0035D0 0.0035D0 - 0.0020D0 - 0.0040D0 - 0.0040D0 - 0.0040D0 0.0030D0 0.0450D0 @@ -2324,12 +2795,13 @@ 0.0035D0 0.0300D0 0.0300D0 + 0.0450D0 + 0.0035D0 + 0.0035D0 + 0.0300D0 + 0.0300D0 0.0035D0 0.0035D0 - 0.0020D0 - 0.0040D0 - 0.0040D0 - 0.0040D0 3.0E-6 1.0E-5 @@ -2338,16 +2810,17 @@ 3.0E-6 5.0E-6 5.0E-6 - 5.0E-6 - 5.0E-6 - 5.0E-6 - - .false. - .true. - .false. 5 1 + 1 + + -1.0E-3 + 0.5 + 70.0 + 3600.0 + + .false. @@ -2356,23 +2829,20 @@ 0.5D0 -0 1 2 4 4 - 4 + 4 42 -42 42 -42 42 -42 42 42 +42 42 -42 +42 1 2 @@ -2406,43 +2876,125 @@ -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/ARM97_4scam.nc - 1500 - 9 - .true. - slt - - - - 2.5D5 - 2.5D7 - - - 4 - - 4 - - 1.0D18 - 2.0D16 - 2.0D16 - 1.17D16 - 7.14D14 - 1.5D14 - 1.5D13 - - 0.0D0 - 0.06D0 - 5 - - 1 - 12 - - -atm/cam/scam/iop/ARM95_4scam.nc + 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/scam/iop/ARM95_4scam.nc + 368.9e-6 + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.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/scam/iop/ATEX_48hr_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.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/scam/iop/S11_CTL_MixedLayerInit_reduced.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.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/scam/iop/S6_CTL_reduced.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.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/scam/iop/DYCOMSrf02_48hr_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.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.macquarie2017.iop.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.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/scam/iop/RICO_3day_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.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/scam/iop/SPARTICUS_4scam.nc + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.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/scam/iop/TWP06_4scam.nc + 1 + 1 + + +atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc +atm/cam/scam/iop/ARM97_4scam.nc - 3 2 @@ -2461,7 +3013,6 @@ .true. .false. - -1 -1 @@ -2471,11 +3022,14 @@ '' 'O', 'O2', 'H', 'N2' -'Q' -'Q','CLDLIQ','RAINQM' -'Q','CLDLIQ','CLDICE' -'Q','CLDLIQ','CLDICE' -'Q','CLDLIQ','CLDICE','RAINQM','SNOWQM' +'Q' +'Q' +'Q' +'Q','CLDLIQ','RAINQM' +'Q','CLDLIQ','CLDICE' +'Q','CLDLIQ','CLDICE' +'Q','CLDLIQ','CLDICE','RAINQM','SNOWQM' +'Q','CLDLIQ','CLDICE','RAINQM','SNOWQM','GRAUQM' @@ -2515,11 +3069,14 @@ 3 3 5 - 6 + 5 + 6 + 6 1 1 3 1 + 1 0 0 -10 @@ -2569,66 +3126,70 @@ - 0 - 240 + 1 +3 - 2 + 0 + 1 - .false. - .true. + 2 .true. - 0 - -3.0D0 - - 3 - 1 - 4 - 2 - 1 - - 1 - 1 - 4 - 4 - 7 +3.22D0 + + 3 + 2 + 4 + 9 + 8 + 2 + 3 + 3 + 1 + + 1 + 3 + 2 + 4 + 20 + 4 + 2 + 4 1 2 8 + 0 + 0 + 1.0e99 1.9 -1 - -1 - 1.0e13 +6.e15 +5.e15 -1 - 1.5625e13 +6.e15 + 10.e15 -1 - 1.5625e13 - - 5.0e5 - 2.0e5 - - 0.0 - 0.0 - 0.5 - 2 - - 0.0 - 3 - 2 + 1.25e5 + 1.0e6 + 1.0e6 + 1.0e6 0.0 -100.0 + 1.0 + + -1 + -1 + 7.5 + -1 1 @@ -2641,17 +3202,19 @@ 2 1 - 3 - 3 - 5 - 4 + 3 + 5 + 2 + 4 + 2 + 10 - 5 7 3 - 4 - 5 + 2 + 4 + 3 -1 -1 @@ -2684,11 +3247,15 @@ SRK3 2 1800.0D0 - 600.0D0 + 900.0D0 + 600.D0 + 450.0D0 + 225.0D0 .true. 2 3 + 4 0.0D0 0.0D0 0.0D0 @@ -2699,6 +3266,8 @@ 480000.0D0 120000.0D0 + 60000.0D0 + 30000.0D0 0.05D0 10.0D0 @@ -2712,16 +3281,27 @@ .true. .false. .true. - 0.25D0 + 1.0D0 0.125D0 .true. 0.1D0 + 0.5D0 0.1D0 0.5D0 + 0.0D0 .true. 22000.0D0 + 80000.0D0 0.2D0 - + 0.0D0 + 0.2D0 + 0 + .true. + 5.0 + 5 + .false. + .false. + .true. atm/cam/inic/mpas/mpasa480.graph.info.part. atm/cam/inic/mpas/mpasa120.graph.info.part. atm/cam/inic/mpas/mpasa60.graph.info.part. @@ -2739,7 +3319,25 @@ - + + 'O3S_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 + S_O3' + + + 'O3S_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 + S_O3', + '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 + ', 'MCO3_NO + MEKO2_NO + ALKO2_NO + jalknit + ACBZO2_NO + BENZO2_NO + BZOO_NO + ', @@ -2850,6 +3448,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 + ', @@ -2890,97 +3517,36 @@ ' C3H6_O3 + ISOP_O3 + MVK_O3 + MACR_O3 + MTERP_O3 + BCARY_O3 + S_O3 + SO_O3' - - - - - - -atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_c061106.nc -atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_c061106.nc -atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_c040926a.nc -atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_c061031.nc -atm/cam/sst/sst_HadOIBl_bc_2.5x3.33_clim_c091210.nc -atm/cam/sst/sst_HadOIBl_bc_4x5_clim_c061031.nc -atm/cam/sst/sst_HadOIBl_bc_10x15_clim_c050526.nc - -atm/cam/sst/sst_HadOIBl_bc_256x512_clim_c031031.nc -atm/cam/sst/sst_HadOIBl_bc_128x256_clim_c050526.nc -atm/cam/sst/sst_HadOIBl_bc_64x128_clim_c050526.nc -atm/cam/sst/sst_HadOIBl_bc_48x96_clim_c050526.nc -atm/cam/sst/sst_HadOIBl_bc_32x64_clim_c050526.nc -atm/cam/sst/sst_HadOIBl_bc_8x16_clim_c050526.nc - -atm/cam/sst/sst_HadOIBl_bc_1x1_clim_c101029.nc -atm/cam/sst/sst_HadOIBl_bc_1x1_clim_c101029.nc - - -atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c091020.nc -atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_pi_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_pi_c100127.nc -atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_pi_c100127.nc -atm/cam/sst/sst_HadOIBl_bc_4x5_clim_pi_c100127.nc -atm/cam/sst/sst_HadOIBl_bc_10x15_clim_pi_c100127.nc - -atm/cam/sst/sst_HadOIBl_bc_128x256_clim_pi_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_64x128_clim_pi_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_48x96_clim_pi_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_32x64_clim_pi_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_8x16_clim_pi_c100128.nc - -atm/cam/sst/sst_HadOIBl_bc_1x1_clim_pi_c100129.nc -atm/cam/sst/sst_HadOIBl_bc_1x1_clim_pi_c100129.nc - - -atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c091020.nc -atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_4x5_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_10x15_1850_2012_c130411.nc - -atm/cam/sst/sst_HadOIBl_bc_128x256_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_64x128_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_48x96_1850_2008_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_32x64_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_8x16_1850_2012_c130411.nc - -atm/cam/sst/sst_HadOIBl_bc_1x1_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_1x1_1850_2012_c130411.nc - -atm/cam/som/cam4.som.forcing.aquaplanet.QzaFix_h50Fix_TspunFix.fv19.nc - - -ocn/docn7/domain.ocn.1x1.111007.nc -ocn/docn7/domain.ocn.1x1.111007.nc - - -atm/cam/ocnfrac/domain.camocn.128x256_USGS_070807.nc -share/domains/domain.ocn.T42_gx1v7.180727.nc -share/domains/domain.ocn.48x96_gx3v7_100114.nc -atm/cam/ocnfrac/domain.camocn.32x64_USGS_070807.nc -atm/cam/ocnfrac/domain.camocn.8x16_USGS_070807.nc - -atm/cam/ocnfrac/domain.camocn.0.23x0.31_gx1v6_101108.nc -atm/cam/ocnfrac/domain.camocn.0.47x0.63_gx1v6_090408.nc -share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc -share/domains/domain.ocn.fv1.9x2.5_gx1v7.170518.nc -share/domains/domain.ocn.4x5_gx3v7_100120.nc -atm/cam/ocnfrac/domain.camocn.10x15_USGS_070807.nc - -share/domains/domain.ocn.C24_gx1v7_c200625.nc -share/domains/domain.ocn.C48_gx1v7_c200625.nc -share/domains/domain.ocn.C96_gx1v7_c200625.nc -share/domains/domain.ocn.C192_gx1v7_c200625.nc -share/domains/domain.ocn.C384_gx1v7_c200625.nc - -share/domains/domain.ocn.ne5np4_gx3v7.140810.nc -share/domains/domain.ocn.ne16np4_gx1v7.171018.nc -share/domains/domain.ocn.ne30_gx1v7.171003.nc -share/domains/domain.ocn.ne60np4_gx1v6.121113.nc -share/domains/domain.ocn.ne120np4_gx1v6.121113.nc -share/domains/domain.ocn.ne240np4_gx1v6.111226.nc - -atm/cam/ocnfrac/domain.aqua.fv1.9x2.5.nc + +.false. +atm/cam/geoschem/emis/ExtData/HEMCO +atm/cam/geoschem/emis/HEMCO_Config.CC.CEDS_AEIC19.NEx.c230615.rc +atm/cam/geoschem/emis/HEMCO_Diagn.3_5_0.c230307.rc +-1 + + +144 +91 + + +576 +361 + + +288 +201 + + +288 +201 + + +144 +91 + + +atm/cam/geoschem/emis/ExtData/CHEM_INPUTS +atm/cam/geoschem/emis/ExtData/CHEM_INPUTS/FAST_JX/v2024-05/ +atm/cam/geoschem/emis/ExtData/CHEM_INPUTS/CLOUD_J/v2023-05/ diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 6403914d39..38f643253d 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -54,6 +54,122 @@ that have only a small number of allowed values. --> + + + + Minimum Wind Threshold for surface flux calculations which is + added to avoid possible cases that would result in a division by zero. + Default: 1.0d-5 + + + + Surface Roughness Length for surface drag calculation. + Default: 3.21d-5 + + + + Critical Richardson Number for stable mixing cutoff. + Default: 1.0 + + + + Surface Layer Fraction of boundary layer depth. + The prescribed fraction of the boundary layer depth + for surface interactions. + Default: 0.1 + + + + Frierson Albedo: Frierson's Net Solar Flux=> 938.4 = 1360*(1.-0.31) + The Frierson model prescribes a net solar flux which incorporated the + effects of albedo. Rather than adhering to this formulation, the net + solar flux is obtained by a more common practice of specifying an albedo + value. For the approximate (simple) solar flux of 1360 W m-2, the albedo + value of 0.31 yields the value used by Frierson. + Default: 0.31 + + + + Latitudinal Variation of Shortwave Radiation. + Shortwave radiation contains no seasonal/diurnal variations and has a + Latitudinal variation specified by DeltaS according to: + R_solar = (R_net/4)*[1 + DeltaS*P_2(Lat)] + where P_2 is the second Legendre polynomial. + Default: 1.4 + + + + Longwave Optical Depth at Equator. + The optical depths are specified as a function of Latitude to approximate + the effects of water vapor according to: + Tau_0 = Tau_eqtr + (Tau_pole - Tau_eqtr)*sin^2(Lat) + Default: 6.0 + + + + Longwave Optical Depth at Poles. + The optical depths are specified as a function of Latitude to approximate + the effects of water vapor according to: + Tau_0 = Tau_eqtr + (Tau_pole - Tau_eqtr)*sin^2(Lat) + Default: 1.5 + + + + Linear Optical Depth Parameter for stratosphere. + The pressure dependence of optical depths that approximate the effects of + water vapor varies according to: + Tau = Tau_0*[ LinFrac*(P/P_s) + (1-LinFrac)*(P/P_s)^4 ] + Default: 0.1 + + + + Ocean Mixed-Layer Heat Capacity. + The ocean surface is a slab mixed layer with a specified heat capacity in units of J K-1 m-2 + Default: 1.e7 + + + + Scale Factor for E0 (saturation vapor pressure) to contol wet/dry experiments. + WetDryCoef=0 corresponds to the atmosphere in the dry limit. + Friersons wet limit corresponds to WetDryCoef=10. + Default: 1. + + + + Tsrf Initial Condition: Minimum SST (K). + The ocean temperatures are initailized with the values: + T_s = Tmin + Tdlt*exp[-0.5*(Lat/Twidth)^2] + Default: 271. + + + + Tsrf Initial Condition: Equator-Pole SST difference (K). + The ocean temperatures are initailized with the values: + T_s = Tmin + Tdlt*exp[-0.5*(Lat/Twidth)^2] + Default: 39. + + + + Tsrf Initial Condition: Latitudinal width parameter for sst (degrees latitude) + The ocean temperatures are initailized with the values: + T_s = Tmin + Tdlt*exp[-0.5*(Lat/Twidth)^2] + Default: 26. + + + + Switch to turn on zonal mean filtering nudging. If TRUE, the nudging scheme + filters 3D model and the 3D input target data to zonal mean values, and then + applies nudging to the differences. + Default: FALSE + - - - -Full pathname of time-variant boundary dataset for aerosol masses. -Default: set by build-namelist. - - - -Add CAM3 prescribed aerosols to the physics buffer. -Default: FALSE - + + Number of zonal mean basis functions (number of m=0 spherical harmonics) used in + zonal mean filtering nudging. + Default: none + - + @@ -422,6 +538,24 @@ Default: .false., unless it is overridden (WACCM with interactive chemistry and configurations do this) + +Number of zonal mean basis functions (number of m=0 spherical harmonics) used in +Transformed Eulerian Mean (TEM) diagnostics + + + +Number of latitude grid points for zonal average TEM diagnostics history fields + + + + Frequency of TEM diagnostics calucation. + If > 0, frequency is specified as number of timesteps. + If < 0, frequency is specified as number of hours. + + Turn on verbose output identifying columns that fail energy/water @@ -537,8 +671,7 @@ Default: 0 -1 for FFT filter always, 0 for combined algebraic/FFT filter. The value 0 -is used for CAM3, otherwise it is using the value 1. +1 for FFT filter always, 0 for combined algebraic/FFT filter. Default: set by build-namelist @@ -1051,107 +1184,6 @@ If true nudge atmospheric temperature (T) from the meteorology. Default: true - - - -del^2 horizontal diffusion coefficient. This is used above the Nth order -diffusion. -Default: set by build-namelist - - - -Order (N) of horizontal diffusion operator used below the sponge layers. -N must be a positive multiple of 2. -Default: 4 - - - -The order N horizontal diffusion operator will be used in and below the -layer specified by this variable. -Default: 4 - - - -Nth order horizontal diffusion coefficient. -Default: set by build-namelist - - - -Number of days (from timestep 0) to run divergence damper. Use only if spectral -model becomes dynamicallly unstable during initialization. Suggested value: -2. (Value must be >= 0.) Default: 0. - - - -Time filter coefficient. Default: 0.06 - - - -Number of levels over which to apply Courant limiter, starting at top of -model. -Default: 5 - - - -Number of dynamics timesteps per physics timestep. If zero, a best-estimate -will be automatically calculated. -Default: 1 - - - - - -Spectral dynamics gather option. - 0: use mpi_allgatherv - 1: use point-to-point MPI-1 two-sided implementation - 2: use point-to-point MPI-2 one-sided implementation if supported, - otherwise use MPI-1 implementation - 3: use Co-Array Fortran implementation if supported, - otherwise use MPI-1 implementation -Default: 0 - - - -Spectral dynamics transpose option. - 0: use mpi_alltoallv - 1: use point-to-point MPI-1 two-sided implementation - 2: use point-to-point MPI-2 one-sided implementation if supported, - otherwise use MPI-1 implementation - 3: use Co-Array Fortran implementation if supported, - otherwise use MPI-1 implementation -Default: 0 - - - -Flag indicating whether to assign latitudes to equidistribute columns or -latitudes. This only matters when using a reduced grid. -Default: TRUE - - - -Number of processes assigned to dynamics (SE, EUL and SLD dycores). -Default: Total number of processes assigned to job. - - - -Stride for dynamics processes (EUL and SLD dycores). -E.g., if stride=2, assign every second process to the dynamics. -Default: 1 - - + +Whether or not to enable gravity waves from PBL moving mountains source. +Default: .false. + + + +Whether or not to enable gravity waves from residual (non-ridge) +orography +Default: set by build-namelist. + + Gravity wave spectrum dimension (wave numbers are from -pgwv to pgwv). @@ -1287,6 +1332,36 @@ Max efficiency associated with anisotropic OGW. Default: 1.0 + +Efficiency scaling factor associated with residual non-ridge topo +Default: set by build-namelist. + + + +Efficiency scaling factor for moving mountain source +Default: set by build-namelist. + + + +Global steering level (Pa) for moving mtns. If negative steering level, it will be provided by future code +Default: set by build-namelist. + + + +Global launch level (Pa) for moving mtns. If negative launch level, it will be provided by future code +Default: set by build-namelist. + + + +Integer code for movmtn source: 1=vorticity, 2=upwp +Default: set by build-namelist. + + Drag coefficient for obstacles in low-level flow. @@ -1341,12 +1416,6 @@ Full pathname of boundary dataset for meso-gamma ridges. Default: set by build-namelist. - -Critical Froude number squared (used only for orographic waves). -Default: set by build-namelist. - - Factor to multiply tau by, for orographic waves in the southern hemisphere. @@ -1379,6 +1448,19 @@ Frontogenesis function critical threshold. Default: set by build-namelist. + +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 @@ -1393,6 +1475,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). @@ -1701,7 +1789,7 @@ Default: none + group="cam_history_nl" valid_values="A,B,I,X,M,N,L,S" > Sets the averaging flag for all variables on a particular history file series. Valid values are: @@ -1709,6 +1797,7 @@ series. Valid values are: B ==> GMT 00:00:00 average I ==> Instantaneous M ==> Minimum + N ==> average over nsteps X ==> Maximum L ==> Local-time S ==> Standard deviation @@ -1727,6 +1816,15 @@ the {{ hilight }}fincl#{{ closehilight }} namelist items. Default: FALSE + +If true then write the nstep==0 time sample to all history files except +the monthly average file. This output is primarily useful for development +and debugging as it captures changes to the model state made during the +initialization phase of the run. +Default: FALSE + + List of fields to exclude from the 1st history file (by default the name @@ -1800,6 +1898,7 @@ are: B ==> GMT 00:00:00 average I ==> Instantaneous M ==> Minimum + N ==> average over nsteps X ==> Maximum L ==> Local-time S ==> Standard deviation @@ -1874,41 +1973,35 @@ if .true. then output CLUBBs radiative history statistics Default: false - Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on zt grid. -Default: none. - Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on zm grid. -Default: none. - Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on radiation zt grid. -Default: none. - Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on radiation zm grid. -Default: none. - Same as {{ hilight }}fincl1{{ closehilight }}, but for CLUBB statistics on surface. -Default: none. Collect all column data into a single field and output in ncol format, much faster than default when you have a lot of columns. -Default: false @@ -2149,9 +2241,8 @@ Default: 2,2,2,2,2,2,2,2,2,2 group="cam_history_nl" valid_values="" > Array of write frequencies for each history file series. -If {{ hilight }}nhtfrq(1){{ closehilight }} = 0, the file will be a monthly average. -Only the first file series may be a monthly average. If -{{ hilight }}nhtfrq(i){{ closehilight }} > 0, frequency is specified as number of +If {{ hilight }}nhtfrq(i){{ closehilight }} = 0, the file will be a monthly average. +If {{ hilight }}nhtfrq(i){{ closehilight }} > 0, frequency is specified as number of timesteps. If {{ hilight }}nhtfrq(i){{ closehilight }} < 0, frequency is specified as number of hours. @@ -2220,6 +2311,14 @@ Required for branch run. Default: none + +Specify whether and how to perform dry surface pressure scaling. If less than or equal to 0.0, +do not perform scaling. If greater than 0.0, perform scaling to scale_dry_air_mass +value (in Pa) as the average dry surface pressure target. +Default: set by build-namelist. + + If TRUE, try to initialize data for all consituents by reading from the @@ -2230,7 +2329,6 @@ internally-specified defaults. Default: TRUE - + +Unitless ratio to increase the accretion process in microphysics as a method of accounting for unrepresented subgridscale variability. +Default: 1 + + + +Unitless ratio to directly scale the autoconversion process in microphysics as a method of accounting for unrepresented subgridscale variability. +Default: 0.01 + + + +Unitless exponent of cloud number condensation in the KK autoconversion parameterization equation. See Khairoutdinov and Kogan, 2002. +Default: -1.1 + + + +Unitless exponent of liquid water path in the KK autoconversion parameterization equation. See Khairoutdinov and Kogan, 2002. +Default: 2.47 + + + +Mean volume radius of droplets used in the process of homogeneously freezing below -40C in (m). Default value is currently the previously assumed 25 microns. +Default: 25.e-6 m + + + +Unitless scaling factor for ice fall speed to account for sub-grid scale ice crystal shape variability. +Default: 1.0 + + + +Unitless scaling factor for snow fall speed to account for sub-grid scale ice crystal shape variability. +Default: 1.0 + + + +Unitless scaling factor for ice effective radius as seen by radiation. This scaling factor adjusts for sub-grid scale ice crystal shape variability. +Default: 1.0 + + + +Ice accrete cloud droplet factor +Default: 1 + + + +Maximum allowed ice number concentration +Default: 1.0e8 + + Do Seifert and Behang (2001) autoconversion and accretion physics when set to true. Default: .false. + +Warm rain process +sb2001 turns on alternative autoconversion and accretion scheme for liquid in microphysics (Seifert and Behang 2001) +kk2000 uses original autoconversion and accretion scheme for liquid in microphysics +tau replaces autoconversion and accretion with a faster emulator to generate machine learning training data +emulated turns on use of machine learning for warm rain +Default: set in namelist_defaults + + + +Neural net file for warm_rain machine learning + + + +Neural net input scaling values file for warm_rain machine learning + + + +Neural net output scaling values file for warm_rain machine learning + + + +Coefficients for the stochastic collection kernel used by the TAU stochastic collection code, invoked in PUMAS with micro_pumas_warm_rain = 'tau' + + Do destruction of massless droplets @@ -2647,21 +2835,21 @@ Default: .false. -Apply 0.3 scaling factor to evaporation of precipitation as done in the +Apply 0.3 scaling factor to evaporation of precipitation as done in the IFS model (https://www.ecmwf.int/en/forecasts/documentation-and-support) Default: .false. -Do not evaporate precipitation until RH<90% as done in the +Do not evaporate precipitation until RH < 90% as done in the IFS model (https://www.ecmwf.int/en/forecasts/documentation-and-support) Default: .false. -Freeze rain at 0C as done in the +Freeze rain at 0C as done in the IFS model (https://www.ecmwf.int/en/forecasts/documentation-and-support) Default: .false. @@ -2678,6 +2866,19 @@ If .true., ensure non-zero precipitation fallspeed (rain,snow and graupel) if pr Default: .false. + +If .true., use implicit fall speed (sedimentation) routine for all hydrometeors. Improves numerical stability of precipitation +Default: .true. + + + +If true, then the autoconverted liquid is added to rain and removed from cloud before accretion is estimated. +Default: .true. + + + @@ -2685,6 +2886,42 @@ prescribed aerosol bulk sulfur scale factor Default: 2 + +Unitless scaling factor for the activated number concentration of cloud condensation nuclei. +Default: 1.0 + + + +Unitless scaling factor for the liquid droplet subgrid scale vertical velocity during aerosol activation. +Default: set by build-namelist + + + +Unitless scaling factor for ice droplet subgrid scale vertical velocity during aerosol activation. +Default: 1.0 + + + +Minimum subgrid vertical velocity (before scale factor) for liquid droplets during aerosol activation with units of (m s-1). +Default: set by build-namelist + + + +Minimum subgrid vertical velocity (after scale factor) for liquid droplets during aerosol activation with units of (m s-1). +Default: set by build-namelist + + + +Minimum subgrid vertical velocity for ice droplets during aerosol activation with units of (m s-1). +Default: 0.001 m s-1 + + Switch to turn on heterogeneous freezing code. @@ -2697,6 +2934,18 @@ Add diagnostic output for heterogeneous freezing code. Default: .false. + +Heterogeneous freezing scaling factor for black carbon aerosols. +Default: 0.01 + + + +Heterogeneous freezing scaling factor for dust aerosols. +Default: 0.05 + + Switch to turn on treatment of pre-existing ice in the ice nucleation code. @@ -2882,6 +3131,18 @@ rhi at which ice cloud fraction = 1 in the stratosphere. Default: set by build-namelist + +Minimum in-stratus IWC constraint [ kg/kg ] +Default: set by build-namelist + + + +Maximum in-stratus IWC constraint [ kg/kg ] +Default: set by build-namelist + + Use cloud fraction to determine whether to do growth of ice clouds below @@ -2889,6 +3150,12 @@ RHice of 1 down to RHice = rhmini. Default: .true. for CAM6; all others => .false. + +For small ice cloud concentrations, take the geometric mean of the iceopt=4 and iceopt=5 area fractions +Default: .true. for CAM_DEV; all others .false. + + Convective momentum transport parameter (upward) @@ -2926,29 +3193,45 @@ Tunable evaporation efficiency in ZM deep convection scheme. Default: set by build-namelist - -Include organization parameterization in ZM. This value is set to true automatically -if -zmconv_org is set in configure. -Default: .false., unless -zmconv_org set in configure +The number of negative buoyancy regions that are allowed before the convection top and CAPE calculations are completed. +Default: => 1 for CAM6; + => 5 for all other - -Turn on convective microphysics -Default: .false. +Tunable entrainment rate in ZM deep convection scheme in units of (m-1). +Default: -1.0e-3 m-1 - -The number of negative buoyancy regions that are allowed before the convection top and CAPE calculations are completed. -Default: => 1 for CAM6; - => 5 for all other +Tunable parcel temperature perturbation in ZM deep convection scheme in units of (K). +Default: 0.5K perturbation + +Tunable triggering threshold for convection in ZM deep scheme in units of (J kg-1). +Default: 70.0 J kg-1 + + + +Turn on ZM deep convection initial parcel properties as a function of a well mixed boundary layer +Default: .false. + + + +Convective adjustment timescale in units of (s) +Default: 3600.0 s + + + - - Factor applied to the ice fall velocity computed from @@ -3141,6 +3424,61 @@ Intercept of linear equation that calculates precribed in-cloud ice mixing ratio Intercept of linear equation that calculates precribed in-cloud ice concentration ratio [N_i'^2] / [N_i]^2 [-] + +Enables importance sampling for SILHS subcolumns + + + +Enables calculation of Lscale_vert_avg, used to generate SILHS samples. + + + +Enables straight Monte Carlo sampling, this overrides l_lh_importance_sampling. + + + +Enables the "new" SILHS importance sampling scheme with prescribed probabilities. Requires l_lh_importance_sampling. + + + +Determine starting SILHS first sampling level (k_lh_start) based on maximum within-cloud rcm. If false, and if l_random_k_lh_start is also false, then the SILHS first sampling level is the column maximum of liquid cloud water. + + + +Determine starting SILHS first sampling level (k_lh_start) based on random choice. Overrides l_rcm_in_cloud_k_lh_start if true. + + + +Assumption of maximum vertical overlap when grid-box rcm exceeds cloud threshold. + + + +Produces "instantaneous" variance-covariance microphysical source terms, ignoring discretization effects. + + + +Limit SILHS sample point weights for stability. + + + +Prescribe variance fractions. + + + +Scale sample point weights to sum to num_samples (the "ratio estimate"). + + Type of deep convection scheme employed. 'ZM' for Zhang-McFarlane; 'off' for none; or 'UNICON' which doesn't distinquish shallow and deep. -Default: 'ZM' unless using 'UNICON', 'SPCAM' or 'pbl=none' +Default: 'ZM' unless using 'UNICON' or 'pbl=none' + group="phys_ctl_nl" valid_values="NONE,RK,MG" > Type of microphysics scheme employed. 'RK' for Rasch and Kristjansson (1998); 'MG' for Morrison and Gettelman (2008), Gettelman et al (2010) two moment scheme for CAM5 and CAM6 -SPCAM has two different microphysics schemes: SPCAM_m2005 (Morrison et al 2005), -SPCAM_sam1mom (Khairoutinov 2003) Default: set by build-namelist (depends on value set in configure). @@ -3194,19 +3530,19 @@ Default: set by build-namelist -Switch for CLUBB_SGS +Flag for CLUBB_SGS. N.B. this variable may not be set by the user. It is +set by build-namelist via information in the configure cache file to be +consistent with how CAM was built. Default: set by build-namelist + group="phys_ctl_nl" valid_values="Hack,UW,CLUBB_SGS,UNICON" > Type of shallow convection scheme employed. 'Hack' for Hack shallow convection; 'UW' for original McCaa UW pbl scheme, modified by Sungsu Park; 'CLUBB_SGS' for CLUBB_SGS 'UNICON' which doesn't distinquish shallow and deep. - 'SPCAM_m2005' for SPCAM double moment - 'SPCAM_sam1mom' for SPCAM single moment Default: set by build-namelist (depends on {{ hilight }}eddy_scheme{{ closehilight }}). @@ -3318,56 +3654,53 @@ History file number for offline unicon driver output. Default: 2 (i.e., h1 history file) - -Flag to perform a saturation adjustment for ice which will add ice mass if the -air is supersaturated with respect to ice. -Default: .false. - + Apply cloud top radiative cooling parameterization -Default: .false. Include effects of precip evaporation on turbulent moments -Default: .false. - -Explicit diffusion on temperature and moisture when CLUBB is on -Default: .false. +Switch for CLUBB_ADV parameter that turns on advection of CLUBB pdf moments by +the dynamics core. Very experimental. -CLUBB timestep. -Default: set by build-namelist +CLUBB timestep, set by build-namelist, do not adjust. Rain evaporation efficiency factor. -Default: set by build-namelist - -Switch for CLUBB_ADV -Default: FALSE +Flag to perform a saturation adjustment for ice which will add ice mass if the +air is supersaturated with respect to ice. - + + Plume widths for theta_l and rt + +E-folding parameter for mixed Brunt Vaisala Frequency + + Limiting value of C1 when skewness of w (vertical velocity) is small in @@ -3384,20 +3717,17 @@ damping of CLUBB's wp2 (variance of vertical velocity). -Low Skewness in C11 Skw. Function -Default: 0.7D0 +Low Skewness in C11 Skew Function -High Skewness in C11 Skw. Function -Default: 0.35D0 +High Skewness in C11 Skew Function Constant for u'^2 and v'^2 terms -Default: 2.2D0 - -C2 coef. for the thlp2_dp1 term +C2 coef. for the rtpthlp_dp1 term - -C2 coef. for the rtpthlp_dp1 term +C2 coef. for the thlp2_dp1 term + +CLUBB tunable parameter - Low Skewness in C6rt Skw. Function + + + +CLUBB tunable parameter - High Skewness in C6rt Skw. Function + + + +CLUBB tunable parameter - Degree of Slope of C6rt Skw. Function + + + +CLUBB tunable parameter - Low Skewness in C6thl Skw. Function + + + +CLUBB tunable parameter - High Skewness in C6thl Skw. Function + + + +CLUBB tunable parameter - Degree of Slope of C6thl Skw. Function + + Low Skewness in C7 Skw. Function @@ -3443,41 +3803,132 @@ the damping of CLUBB's wp3 when skewness of w (vertical velocity) is large in magnitude. - -Coefficient of Kh_zm (diffusivity on momentum grid levels) in the up2 (variance -of the west-east wind component) and vp2 (variance of the south-north wind -component) predictive equations. +Coefficient of inverse tau term contributed by background constant value (units: none) - -Constant in the diffusivity term in the up2 (variance of the west-east wind -component) and vp2 (variance of the south-north wind component) predictive -equations. +Coefficient of inverse tau term contributed by surface log law (units: none) + + + +Coefficient of inverse tau term contributed by vertical wind shear (units: none) + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency (units: none) + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency but for wp3 (units: none) + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency but for wp3_wp2 (units: none) + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency but for xm_wpxp (units: none) + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency but for xp2_wpxp (units: none) + + + +Coefficient of Kh_zm (diffusivity on momentum grid levels) in the wp2 (variance +of vertical velocity) predictive equation. Momentum coefficient of Kh_zm -Default: 0.5 Thermo of Kh_zm -Default: 0.3 + + + +Coefficient of Kh_zm (diffusivity on momentum grid levels) in the scalar +variance predictive equations (e.g. rtp2, variance of total water). + + + +Coefficient of Kh_zt (diffusivity on thermodynamic grid levels) in the wp3 +(third-order moment of vertical velocity) predictive equation. + + + +Coefficient of Kh_zm (diffusivity on momentum grid levels) in the up2 (variance +of the west-east wind component) and vp2 (variance of the south-north wind +component) predictive equations. + + + +Coefficient in the wp2 (variance of vertical velocity) pressure terms opposing shear production. + + + +Coefficient in the wp2 (variance of vertical velocity) pressure terms opposing buoyancy production. + + + +Coefficient for gustiness near ground. + + + +Coefficient in the pressure-turbulence term of CLUBB's wp3 predictive equation. + + + +Radius of detrained ice drops as they are used in the CLUBB parameterization in units of (m). + + + +Radius of detrained liquid drops as they are used in the CLUBB parameterization in units of (m). + + + +Temperature at which detrained water is classified as entirely ice (no liquid) +in the CLUBB parameterization in units of (K). + + + +Apply adjustments to dry static energy so that CLUBB conserves +energy. Apply liquid supersaturation adjustment code -Default: false -Low Skw.: gamma coef. Skw. Fnct. +Low Skewness in gamma coefficient Skewness Function (units: none) +Default changes depending on grid and physics options + +Selected option for the two-component normal (double Gaussian) PDF type to use for the w, rt, +and theta-l (or w, chi, and eta) portion of CLUBB's multivariate, two-component PDF. +iiPDF_ADG1 = 1 (ADG1 PDF), iiPDF_ADG2 = 2 (ADG2 PDF), iiPDF_3D_Luhar = 3 (3D Luhar PDF), +iiPDF_new = 4 (new PDF), iiPDF_TSDADG = 5 (TSDADG PDF), iiPDF_LY93 = 6 (Lewellen and Yoh (1993)), +iiPDF_new_hybrid = 7 (new hybrid PDF) + + + +Option for the placement of the call to CLUBB's PDF closure. The options include: ipdf_pre_advance_fields (1) calls the PDF closure before advancing prognostic fields. ipdf_post_advance_fields (2) calls after advancing prognostic fields, and ipdf_pre_post_advance_fields (3) calls both before and after advancing prognostic fields. + + Intensity of stability correction applied to C1 and C6 -Default 0.04 - -Coef. applied to log(avg dz/thresh) +Flag to uses an alternate equation to calculate the Brunt-Vaisala frequency. +This equation calculates an in-cloud Brunt-Vaisala frequency. - -Factor to decrease sensitivity in the denominator of Skw calculation -Default: 0.0 +Flag to use cloud fraction to adjust the value of the +turbulent dissipation coefficient, C2. - -Maximum magnitude of skewness allowed. +Include the contribution of radiation to thlp2 - -Factor used in calculating the surface values of up2 (variance of the u wind -component) and vp2 (variance of the v wind component). Increasing -clubb_up2_vp2_factor increases the values of up2 and vp2 at the surface. +Calculate the correlations between w and the hydrometeors - -Coefficient for gustiness near ground. +Flag to call CLUBB's PDF closure at both thermodynamic and momentum vertical +grid levels. When this flag is turned off, CLUBB's PDF closure is only called +on thermodynamic grid levels. - - - -Flag to uses an alternate equation to calculate the Brunt-Vaisala frequency. -This equation calculates an in-cloud Brunt-Vaisala frequency. +Use a constant cloud droplet conc. within cloud - -Flag to call CLUBB's PDF closure at both thermodynamic and momentum vertical -grid levels. When this flag is turned off, CLUBB's PDF closure is only called -on thermodynamic grid levels. +Flag to use a dissipation formula of -(2/3)*em/tau_zm, as in Bougeault (1981), +in the wp2 (variance of vertical velocity) predictive equation. + +Flag that, when it is enabled, first calculates dissipation time tau, and then +calculates the mixing length scale as Lscale = tau * sqrt(tke). When the flag +is turned off, Lscale is calculated first, and then dissipation time-scale tau +is calculated as tau = Lscale / sqrt(tke). + + + +Diagnose correlations instead of using fixed ones + + + +Implicit diffusion on moisture and temperature, implemented within CLUBB's +matrix equations for wprtp/rtm and wpthlp/thlm. + + + +Explicit diffusion on temperature and moisture by CLUBB, in addition to CLUBB's +normal prognostic equations for rtm and thlm. + + + +Flag to run CLUBB with E3SM settings. + + + +Flag to relax clipping on wpxp in xm_wpxp_clipping_and_stats. + + + +Use a fixed correlation for s and t Mellor(chi/eta) + + + +This flag determines whether we want to use an upwind differencing approximation +rather than a centered differencing for turbulent advection terms. It affects +wpxp only. + + + +This flag determines whether we want to use an upwind differencing approximation +rather than a centered differencing for turbulent advection terms. It affects +xpyp only. + + + +Flag to apply a locally calculated ustar to momentum surface fluxes in the +clubb interface. + + + +Flag to apply Linear Multistep Method (LMM) stepping in CLUBB. + + Uses PDF to compute perturbed values for l_avg_Lscale code -Default: .false. + +Flag to turn on the clubb monotonic flux limiter for rtm. + + + +Flag to turn on the smoothing code options for the monotonic flux limiter. + + + +Flag to turn on the clubb monotonic flux limiter for thlm. + + + +Flag to turn on the clubb monotonic flux limiter for um (zonal momemtum). + + + +Flag to turn on the clubb monotonic flux limiter for vm (meridional momemtum). + + + +Flag to use an "upwind" discretization rather than a centered discretization +for the portion of the wp3 turbulent advection term for ADG1 that is linearized +in terms of wp3(t+1). (Requires ADG1 PDF and l_standard_term_ta=true). + + Flag to predict horizontal momentum fluxes upwp and vpwp along with mean @@ -3590,6 +4147,11 @@ horizontal winds um and vm. When this flag is turned off, upwp and vpwp are calculated by down-gradient diffusion. + +used in adj_low_res_nu. If .true., avg_deltaz = deltaz + + Flag to take any remaining supersaturation after CLUBB PDF call and add it to @@ -3599,6 +4161,28 @@ levels and the momentum grid levels and variables are interpolated between the two grid level types. + +Turn on (true) and off (false) rtm nudging. + + + +Flag to use smooth Heaviside 'Peskin' in computation of invrs_tau. + + + +Use the standard discretization for the turbulent advection terms. Setting to +.false. means that a_1 and a_3 are pulled outside of the derivative in +advance_wp2_wp3_module.F90 and in advance_xp2_xpyp_module.F90. + + + +Whether or not we want CLUBB to apply a stability correction Kh_N2_zm. + + Flag to use a stability corrected version of CLUBB's time scale (tau_zm). This @@ -3606,6 +4190,13 @@ creates a time scale that provides stronger damping at altitudes where Brunt-Vaisala frequency is large. + +Use anisotropic turbulent kinetic energy in the CLUBB higher order closure, i.e. +calculate TKE = 1/2 (u'^2 + v'^2 + w'^2). This improves the simulation of complex +turbulence but at a greater cost than running without. + + Flag that uses the trapezoidal rule to adjust fields calculated by CLUBB's PDF @@ -3622,6 +4213,13 @@ adjacent vertical grid level. The clubb_l_trapezoidal_rule_zt flag applies this adjustment to PDF fields calculated on thermodynamic vertical grid levels. + +This flag determines whether we want to use an upwind differencing approximation +rather than a centered differencing for turbulent or mean advection terms. It +affects rtm, thlm, sclrm, um and vm. + + Flag to use "upwind" discretization in the turbulent advection term in the @@ -3631,12 +4229,9 @@ potential temperature). When this flag is turned off, centered discretization is used. - -Flag to calculate the value of CLUBB's C7 based on Richardson number, where -C7 is a coefficient in a wpxp pressure term and is used to balance the effects -of pressure and buoyancy in the wpxp predictive equation. The variable wpxp is -a flux such as total water flux or flux of liquid water potential temperature. +Turn on (true) or off (false) uv wind speed nudging. + +Flag to calculate the value of CLUBB's C7 based on Richardson number, where +C7 is a coefficient in a wpxp pressure term and is used to balance the effects +of pressure and buoyancy in the wpxp predictive equation. The variable wpxp is +a flux such as total water flux or flux of liquid water potential temperature. + + Flag to allow cloud fraction and mean cloud water at adjacent vertical grid @@ -3653,10 +4256,16 @@ levels influence the amount of cloudiness and amount of cloud water in a grid box. - -Include the effects of ice latent heating in turbulence terms -Default: .false. +Flag to use precipitation fraction in KK microphysics. The +precipitation fraction is automatically set to 1 when this +flag is turned off. + + + +Flag to use shear in the calculation of Richardson number. + +Flag to use Total Kenetic Energy (TKE) in eddy diffusion for wp2 and wp3. + + + +Flag to use Total Kenetic Energy (TKE) formulation for wp3 pr_turb (turbulent +production) term. + + + +Flag used to calculate convective velocity using a variable estimate of layer +depth based on the depth over which wpthlp is positive near the ground when true + + Flag that, when it is enabled, automatically enables CLUBB's l_trapezoidal_rule_zt, l_trapezoidal_rule_zm, and l_call_pdf_closure_twice. - -Flag that, when it is enabled, first calculates dissipation time tau, and then -calculates the mixing length scale as Lscale = tau * sqrt(tke). When the flag -is turned off, Lscale is calculated first, and then dissipation time-scale tau -is calculated as tau = Lscale / sqrt(tke). -Default: .false. +Coef. applied to log(avg dz/thresh) - -Flag to use a dissipation formula of -(2/3)*em/tau_zm, as in Bougeault (1981), -in the wp2 (variance of vertical velocity) predictive equation. +Constant in the diffusivity term in the scalar variance predictive equations +(e.g. rtp2, variance of total water). - -Apply adjustments to dry static energy so that CLUBB conserves -energy. -Default: true +Constant in the diffusivity term in the up2 (variance of the west-east wind +component) and vp2 (variance of the south-north wind component) predictive +equations. + + + +Specifier for method to solve the penta-diagonal system that is common in CLUBB. +Valid values: 0 (lapack), 1 (penta_lu), 2 (penta_bicgstab) + + + +Factor to decrease sensitivity in the denominator of Skw calculation + + + +Maximum magnitude of skewness allowed. + + + +Specifier for method to solve tri-diagonal systems that are common in CLUBB. +Experimental option and currently the only valid value is 1: lapack + + + +Factor used in calculating the surface values of up2 (variance of the u wind +component) and vp2 (variance of the v wind component). Increasing +clubb_up2_sfc_coef increases the values of up2 and vp2 at the surface. + + + +CLUBB tunable parameter - Lscale threshold: damp C6 and C7 (units: m) + + + +Exponent for Richardson number in calculation of invrs_tau_wpxp term + + + +Displacement of log law profile above ground (units: m) -If .true. add ensemble mass fluxes to CLUBB's higher-order equation set. -Together with CLUBB, this constitutes an eddy-diffusivity mass-flux approach. +If .true. add ensemble mass fluxes to CLUBB's higher-order equation set. +Together with CLUBB, this constitutes an eddy-diffusivity mass-flux approach. Default: .false. @@ -3735,6 +4401,23 @@ is not active. Default: none + + Nucleation methods: + ZhaoTurco + Zhao, J. and Turco, R., + Nucleation simulations in the wake of a jet aircraft in stratospheric flight, + J. Aerosol Sci., 26, 779-795, 1995, + https://doi.org/10.1016/0021-8502(95)00010-A + Vehkamaki + Vehkamaki, H., M. Kulmala, I. Napari, K.E.J. Lehtinen, + C. Timmreck, M. Noppel and A. Laaksonen, 2002, + An improved parameterization for sulfuric acid-water nucleation + rates for tropospheric and stratospheric conditions, + J. Geophys. Res., 107, 4622, doi:10.1029/2002jd002184 +Default: none + + A fraction that scales how tight the convergence criteria are to @@ -4151,30 +4834,6 @@ Specifies the name of the sea salt emission parameterization. Default: Gong - -======= - - - -Full pathname of time-variant ozone mixing ratio boundary dataset. -Default: set by build-namelist. - - - -Add CAM3 prescribed ozone to the physics buffer. -Default: FALSE - - - -Flag for yearly cycling of ozone data. If set to FALSE, a multi-year -dataset is assumed, otherwise a single-year dataset is assumed, and ozone -will be cycled over the 12 monthly averages in the file. -Default: TRUE - - + group="phys_ctl_nl" valid_values="cam4,cam5,cam6,adiabatic,held_suarez,kessler,frierson" > Name of the CAM physics package. N.B. this variable may not be set by the user. It is set by build-namelist via information in the configure cache file to be consistent with how CAM was built. @@ -4323,16 +4982,35 @@ cache file to be consistent with how CAM was built. Default: set by build-namelist - + Name of the CAM chemistry package. N.B. this variable may not be set by the user. It is set by build-namelist via information in the configure cache file to be consistent with how CAM was built. Default: set by build-namelist + +Full pathname to CAM physics grid ESMF mesh file. +N.B. this variable may not be set by the user. +It is set by build-namelist via information in the configure +cache file to be consistent with how CAM was built. +Default: set by build-namelist + + + +If TRUE then the Harmonized Emissions Component, HEMCO, will be used +to calculate emissions in chemistry. ext_frc_specifier and srf_emis_specifier +will be ignored. +Default: FALSE + + Runtime options of upper thermosphere WACCM-X. 'ionosphere' for @@ -4367,6 +5045,25 @@ Switch to apply ring polar filter within in ionosphere O+ transport. Default: FALSE + +Oplus transport grid size, entered as num_longitudes, num_latitudes. +Default: set by build-namelist + + + +Magnetic grid resolution (nlon x nlat). +Default: set by build-namelist + + + +Number of MPI processes on which to run the WACCM-X ionosphere +electro-dynamo and O+ ion transport modules. +Default: 0 (use all atmosphere tasks) + + Switch to to turn on/off O+ transport in ionosphere. @@ -4393,9 +5090,10 @@ Electric potential model used in the waccmx ionosphere. Default: set by build-namelist - -Give the user the ability to input prescribed high-latitude electric potential. +Switch to add history fields to master field list for the purpose +of debugging ionospheric processes in WACCMX. Default: FALSE @@ -4414,16 +5112,93 @@ high latitude electric potential model. Default: set by build-namelist. - -Full pathname of AMIE inputs for northern hemisphere. -Default: NONE. + +Give the user the ability to input prescribed high-latitude electric potential. +Default: FALSE + + + +List of full pathnames of AMIE electic potential inputs for northern hemisphere. +Default: NONE. + + + +List of full pathnames of AMIE electic potential inputs for southern hemisphere. +Default: NONE. + + + +Give the user the ability to input LTR high-latitude electric potential. +Default: FALSE + + + +List of full pathnames of LTR electic potential inputs for both hemispheres. +Default: NONE. + + + + + +Full pathname of HEMCO data root for use in reading HEMCO input files. +(e.g., '$DIN_LOC_ROOT/atm/cam/geoschem/emis/ExtData/HEMCO'). +Default: set by build-namelist. + + + +Full pathname of the HEMCO_Config.rc input file used to configure HEMCO. +Default: set by build-namelist. + + + +Full pathname of the HEMCO_Diagn.rc input file used to configure HEMCO diagnostics. +Default: set by build-namelist. + + + +Number of x-dimensions in HEMCO internal grid. +Default: set by build-namelist. + + + +Number of y-dimensions in HEMCO internal grid. +Default: set by build-namelist. + + + +Force emission year for HEMCO clock if positive. This will force cycling of data on this year. +Default: set by build-namelist for climo cases, otherwise -1 to use model clock. + + + + + +Full pathname of the GEOS-Chem chemistry inputs directory. +Default: set by build-namelist. + + + +Full pathname of the aerosols optical property inputs directory used in GEOS-Chem outside of Cloud-J. +Default: set by build-namelist. - -Full pathname of AMIE inputs for southern hemisphere. -Default: NONE. + +Full pathname of the Cloud-J photolysis inputs directory used in GEOS-Chem. +Default: set by build-namelist. @@ -4490,13 +5265,20 @@ Default: 0 + group="phys_ctl_nl" valid_values="HB,diag_TKE,HBR,CLUBB_SGS" > Type of eddy scheme employed by the vertical diffusion package. 'HB' for Holtslag and Boville; 'diag_TKE' for diagnostic tke version of Grenier and Bretherton; 'HBR' for Rasch modified version of 'HB'. Default: set by build-namelist + +Logical: If True activate Holtslag and Boville vertical diffusion scheme where CLUBB is not active + (note that CLUBB top is dynamic in each column) +Default: Set by build-namelist. + + + +History tape number thermo budget output is written to. +Default: 1 + + + +Produce output for the energy budget diagnostic package. +Default: .false. + @@ -4688,7 +5481,7 @@ Default: + group="phys_ctl_nl" valid_values="chem_emissions,aoa_tracers_timestep_tend,co2_cycle_set_ptend,chem_timestep_tend,vertical_diffusion_section,aero_model_drydep,gw_tend,qbo_relax,iondrag_calc_section,physics_dme_adjust,physics_dme_adjust,dadadj_tend,convect_deep_tend,convect_shallow_tend,convect_diagnostics_calc,macrop_driver_tend,clubb_tend_cam,microp_section,microp_driver_tend_subcol,aero_model_wetdep,radiation_tend,held_suarez_tend,kessler_tend,thatcher_jablonowski_precip_tend,user_set" > Name of parameterization to take snapshot before running user_set is used when a user inserts a call to cam_snapshot_all_outfld using cam_snapshot_before_num as the first argument. @@ -4696,7 +5489,7 @@ Default: Unused + group="phys_ctl_nl" valid_values="chem_emissions,aoa_tracers_timestep_tend,co2_cycle_set_ptend,chem_timestep_tend,vertical_diffusion_section,aero_model_drydep,gw_tend,qbo_relax,iondrag_calc_section,physics_dme_adjust,physics_dme_adjust,dadadj_tend,convect_deep_tend,convect_shallow_tend,convect_diagnostics_calc,macrop_driver_tend,clubb_tend_cam,microp_section,microp_driver_tend_subcol,aero_model_wetdep,radiation_tend,held_suarez_tend,kessler_tend,thatcher_jablonowski_precip_tend,user_set" > Name of parameterization to take snapshot after running user_set is used when a user inserts a call to cam_snapshot_all_outfld using cam_snapshot_after_num as the first argument. @@ -4705,7 +5498,7 @@ Default: Unused + group="phys_ctl_nl" valid_values="rrtmgp,rrtmg,camrt" > Type of radiation scheme employed. Default: set by build-namelist @@ -4895,10 +5688,29 @@ Switch to turn on Fixed Dynamical Heating in the offline radiation tool (PORT). Default: false + + + +Relative pathname for LW gas optics coefficients for RRTMGP. This data is +part of the RRTMGP source, thus this pathname is relative to the root source +code directory for the CAM component. +Default: set by build-namelist. + + + +Relative pathname for SW gas optics coefficients for RRTMGP. This data is +part of the RRTMGP source, thus this pathname is relative to the root source +code directory for the CAM component. +Default: set by build-namelist. + + + + group="aerosol_optics_nl" valid_values="" > Full pathname of dataset for water refractive indices used in modal aerosol optics Default: none @@ -5098,6 +5910,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 @@ -5266,7 +6084,7 @@ Wet deposition method used MOZ --> mozart scheme is used NEU --> J Neu's scheme is used OFF --> wet deposition is turned off -Default: NEU except for SPCAM runs +Default: NEU + group="aero_wetdep_nl" valid_values="" > Tuning for below cloud scavenging of interstitial modal aerosols. Default: set by build-namelist. + group="aero_wetdep_nl" valid_values="" > Tuning for in-cloud scavenging of interstitial modal aerosols. Default: set by build-namelist. + group="aero_wetdep_nl" valid_values="" > Tuning for in-cloud scavenging of cloud-borne modal aerosols. Default: set by build-namelist. @@ -5684,56 +6502,6 @@ Type of time interpolation for fixed lower boundary data. Default: 'CYCLICAL' - -File name of dataset for NOy upper boundary conditions. -Default: set by build-namelist. - - - -Full pathname of the directory that contains the NOy upper boundary conditions files specified in -{{ hilight }}noy_ubc_filelist{{ closehilight }}. -Default: set by build-namelist. - - - -Filename of file that contains a sequence of filenames for prescribed NOy upper boundary conditions. -The filenames in this file are relative to the directory specified by {{ hilight }}noy_ubc_datapath{{ closehilight }}. -Default: set by build-namelist. - - - -Type of time interpolation for NOy upper boundary conditions. -Default: 'SERIAL' - - - -The cycle year of the NOy upper boundary data -if {{ hilight }}flbc_type{{ closehilight }} is 'CYCLICAL'. -Format: YYYY -Default: 0 - - - -The date at which the NOy upper boundary data is fixed -if {{ hilight }}flbc_type{{ closehilight }} is 'FIXED'.. -Format: YYYYMMDD -Default: 0 - - - -The time of day (seconds) corresponding to {{ hilight }}noy_ubc_fixed_ymd{{ closehilight }} -at which the NOy upper boundary data is fixed -if {{ hilight }}flbc_type{{ closehilight }} is 'FIXED'. -Default: 0 seconds - - Full pathname of dataset for chemical tracers constrained in the stratosphere @@ -5746,20 +6514,14 @@ List of species that are constrained in the stratosphere. Default: set by build-namelist. - -Full pathname of dataset for land mask applied to the lighting NOx production -Default: set by build-namelist. - - + group="lightning_nl" valid_values="" > Multiplication factor applied to the lighting NOx production Default: 1.0. + group="upper_bc_opts" valid_values="" > Multiplication factor applied to the upper boundary NO mass mixing ratio. Default: 1.0 @@ -5770,18 +6532,6 @@ Full pathname of dataset for the neutral species absorption cross sections. Default: set by build-namelist. - -Full pathname of dataset for fast-tuv photolysis cross sections -Default: set by build-namelist. - - - -Full pathname of dataset of O2 cross sections for fast-tuv photolysis -Default: set by build-namelist. - - Full pathname of dataset of O2 and 03 column densities above the model for look-up-table photolysis @@ -6305,7 +7055,7 @@ Default: set by build-namelist. + group="upper_bc_opts" valid_values="" > Full pathname of dataset for the coefficients of the NOEM nitric oxide model used to calculate its upper boundary concentration. Default: set by build-namelist. @@ -6404,25 +7154,20 @@ if {{ hilight }}sulf_type{{ closehilight }} is 'FIXED'. Default: 0 seconds - - - - - + group="upper_bc_opts" valid_values="" > Full pathname of dataset for TGCM upper boundary Default: set by build-namelist. + group="upper_bc_opts" valid_values="CYCLICAL,SERIAL,INTERP_MISSING_MONTHS,FIXED" > Type of time interpolation for data in TGCM upper boundary file. Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. Default: 'SERIAL' + group="upper_bc_opts" valid_values="" > The cycle year of the TGCM upper boundary data if {{ hilight }}tgcm_ubc_type{{ closehilight }} is 'CYCLICAL'. Format: YYYY @@ -6430,7 +7175,7 @@ Default: 0 + group="upper_bc_opts" valid_values="" > The date at which the TGCM upper boundary data is fixed if {{ hilight }}tgcm_ubc_type{{ closehilight }} is 'FIXED'. Format: YYYY @@ -6438,7 +7183,7 @@ Default: 0 + group="upper_bc_opts" valid_values="" > The time of day (seconds) corresponding to {{ hilight }}tgcm_ubc_fixed_ymd{{ closehilight }} at which the TGCM upper boundary data is fixed if {{ hilight }}tgcm_ubc_type{{ closehilight }} is 'FIXED'. @@ -6446,11 +7191,75 @@ Default: 0 seconds + group="upper_bc_opts" valid_values="" > Perturbation applied to the upper boundary temperature. Default: 0.0 + + +List of fields that have fixed upper boundary conditions (temperature and mass mixing ratios) +and corresponding data sources. Each entry in this list is of the form: + FLD->source +where source may be of the following: + MSIS - NRL neutral atmosphere empirical model (Mass Spectrometer Incoherent Scatter radar) + TGCM - Input file generated by Thermospheric General Circulation Model + SNOE - Input file generated from Student Nitric Oxide Explorer satellite observations + UBC_FILE - Generalized input file which spans the upper boundary altitude + value (mmr|vmr) - Set to a constant value (e.g., 1.2e-6 mmr) + +These fields can be set to constant values with units of "mmr" (mass mixing ratio) +or "vmr" (volume mixing ratio). The upper boundary values of source UBC_FILE are prescribed +in the UBC_FILE_path file. Fields of source UBC_FILE may include a CAM constituent name +and a file field name separated by ":". + +Note: Constituents not included in ubc_specifier default to zero flux through the upper boundary. + +Example: + ubc_specifier = 'Q:H2O->UBC_FILE', 'CH4->2.D-10vmr', 'F->1.0D-15mmr', 'HF->1.0D-15mmr', + 'T->MSIS', 'H->MSIS', 'N->MSIS','O->MSIS', 'O2->MSIS', 'H2->TGCM', 'NO->SNOE' + +Default: set by build-namelist + + + +Full path of the file containing prescribed upper boundary conditions. +Default: NONE + + + +Type of time interpolation for data in {{ hilight }}ubc_file_path file{{ closehilight }}. +Can be set to 'CYCLICAL', 'SERIAL', 'INTERP_MISSING_MONTHS', or 'FIXED'. +Default: NONE + + + +The cycle year of the prescribed upper boundary data +if {{ hilight }}ubc_file_input_type{{ closehilight }} is 'CYCLICAL'. +Format: YYYY +Default: 0 + + + +The date at which the upper boundary data is fixed +if {{ hilight }}ubc_file_input_type{{ closehilight }} is 'FIXED'. +Format: YYYYMMDD +Default: 0 + + + +The time of day (seconds) corresponding to {{ hilight }}ubc_file_fixed_ymd{{ closehilight }} +at which the upper boundary data is fixed +if {{ hilight }}ubc_file_input_type{{ closehilight }} is 'FIXED'. +Default: 0 seconds + + Frequency in time steps at which the chemical equations are solved. @@ -6583,13 +7392,6 @@ if {{ hilight }}tracer_srcs_type{{ closehilight }} is 'FIXED'. Default: 0 seconds - -If TRUE then use the FTUV method to calculate the photolysis reactions rates, -otherwise use the look up table method. -Default: FALSE - - Full pathname of dataset for Chebyshev polynomial Coeff data used for photolysis @@ -6609,6 +7411,13 @@ Full pathname of cross section dataset for short wavelengh photolysis Default: set by build-namelist. + +Maximum zenith angle (degrees) used for photolysis. +Default: set by build-namelist. + + + + +Full pathname of file containing gas phase deposition data including effective +Henry's law coefficients. +Default: set by build-namelist. + + Give the user the ability to specify rate families (or groupings) diagnostics based @@ -6735,10 +7551,29 @@ Bubble-mediated sea-air transfer. See ocean_emis.F90 for details. Default: FALSE - -List of nitrogen deposition fluxes to be sent from CAM to surface models. -Default: set by build-namelist. + +Year first to use in nitrogen deposition stream data. + + + +Year last to use in nitrogen deposition stream data. + + + +Model year to align with stream_ndep_year_first. + + + +Nitrogen deposition stream data filename. + + + +Grid mesh file corresponding to stream_ndep_data_filename. - MEGAN specifier. Default: set by build-namelist. @@ -6766,6 +7601,38 @@ 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 + + + + + +Frequency of surface ozone field passed from CAM to surface components. +Surface ozone is passed every coupling interval, but this namelist flag +indicates whether the timestep-level values are interpolated from a +coarser temporal resolution. +Default: set by build-namelist. + + + +If TRUE atmosphere model will provide prognosed lightning flash frequency. +Default: FALSE + + + +If TRUE, then use the ALI-ARMS scheme (an alternative method of computing non-LTE heating rates in the upper atmosphere) +Default: FALSE + + + +Call ALI-ARMS every X timesteps +Default: 1 + + TRUE implies assume cyclic qbo data. @@ -6939,6 +7818,41 @@ ion pairs production rates. Default: None. + +Switch to turn on medium energy electron ionization chemical forcings +computed inline using Ap geomagnetic activity index input data. +Default: FALSE + + + +Bounce cone loss angle (degrees) for medium energy electrons in radiation belts. +Must range from 0 to 90 degrees. +Default: 80 degrees + + + +If TRUE, compute medium energy electron ionization rates only for output to history stream. +Otherwise, apply the ionization rates as forcings to the chemistry. +Default: FALSE + + + +Filepath input dataset for radiation belt medium energy electrons fluxes incident +on upper atmosphere. +Default: None. + + + +If TRUE, fill in missing fluxes with computed fluxes based in Ap index using van de Kamp +method. +Default: FALSE + + Switch to apply lunar tidal tendencies to neutral winds. @@ -7017,28 +7931,6 @@ Number of hyperviscosity subcycles per dynamics timestep in sponge del2 diffusio Default: Set by build-namelist - - -Variable to specify the vertical index at which the -Rayleigh friction term is centered (the peak value). -Default: 2 - - - -Rayleigh friction parameter to determine the width of the profile. If set -to 0 then a width is chosen by the algorithm (see rayleigh_friction.F90). -Default: 0.5. - - - -Rayleigh friction parameter to determine the approximate value of the decay -time (days) at model top. If 0.0 then no Rayleigh friction is applied. -Default: 0. - - Used by SE dycore to apply sponge layer diffusion to u, v, and T for @@ -7100,16 +7992,6 @@ Number of dynamics steps per physics timestep. Default: Set by build-namelist. - -Scaling of temperature increment for different levels of -thermal energy consistency. -0: no scaling -1: scale increment for cp consistency between dynamics and physics -2: do 1 as well as take into account condensate effect on thermal energy -Default: Set by build-namelist. - - Hyperviscosity coefficient for u,v, T [m^4/s]. @@ -7137,28 +8019,42 @@ Second-order viscosity applied only near the model top [m^2/s]. Default: Set by build-namelist. - -Hyperscosity for T and dp is applied to (T-Tref) and (dp-dp_ref) where -Xref are reference states where the effect of topography has been removed -(Simmons and Jiabin, 1991, QJRMS, Section 2a). -If TRUE dp_ref is dynamic smoothed reference state derived by Patrick Callaghan -(Lauritzen et al., 2018, JAMES, Appendix A.2) and temperature reference state -based on Simmons and Jiabin (1991) but using smoothed dp_ref. -If FALSE Tref is static reference state (Simmons and Jiabin) and dp_ref state -derived from hydrostatic balance. -Default: FALSE +Hyperviscosity coefficient se_nu [m^4/s] for u,v, T is increased to +se_nu_p*se_sponge_del4_nu_fac following a hyperbolic tangent function +centered around pressure at vertical index se_sponge_del4_lev: + + 0.5_r8*(1.0_r8+tanh(2.0_r8*log(pmid(se_sponge_del4_lev)/press))) + +where press is pressure + +If < 0, se_sponge_del4_nu_fac is automatically set based on model top location. +Default: Set by build-namelist. - -If TRUE the continous equations the dynamical core is based on will conserve a -comprehensive moist total energy -If FALSE the continous equations the dynamical core is based on will conserve -a total energy based on cp for dry air and no condensates (same total energy as -CAM physics uses). -For more details see Lauritzen et al., (2018;DOI:10.1029/2017MS001257) -Default: TRUE +Divergence damping hyperviscosity coefficient se_nu_div [m^4/s] for u,v is increased to +se_nu_p*se_sponge_del4_nu_div_fac following a hyperbolic tangent function +centered around pressure at vertical index se_sponge_del4_lev: + + 0.5_r8*(1.0_r8+tanh(2.0_r8*log(pmid(se_sponge_del4_lev)/press))) + +where press is pressure + +If < 0, se_sponge_del4_nu_div_fac is automatically set based on model top location. +Default: Set by build-namelist. + + + +Level index around which increased del4 damping is centered. + +See se_sponge_del4_nu_fac and se_sponge_del4_nu_div_fac + +If < 0, se_sponge_del4_lev is automatically set based on model top location. +Default: Set by build-namelist. + + + 1: Exner version of pressure gradient force (PGF) + see Appendix A in https://agupubs.onlinelibrary.wiley.com/doi/epdf/10.1029/2022MS003192 + + 2: Traditional pressure gradient formulation (grad p) + + 3: Hybrid (formulation 1 where hybm>0 else formulation 2) + Use hybrid PGF option for WACCM-x to make WACCM-x consistent with PGF + used in CAM in the troposphere and traditional PGF formulation above + + Default: Set by build-namelist. + + + + + 0: physics tendencies will be added every vertical remapping time-step (dt_phys/se_nsplit) + for se_ftype=0,2 + + 1: physics tendencies will be added every dynamics time-step (dt_phys/se_nsplit*se_rsplit) + for se_ftype=0,2 + + If se_ftype=1 then se_dribble_in_rsplit_loop has no effect since physics tendencies are added as an adjustment + + Default: Set by build-namelist. + + @@ -7551,7 +8476,7 @@ Default: TRUE Upwinding coefficient in the 3rd order advection scheme in MPAS dycore. -Default: 0.25 +Default: 1.0 + +Coefficient for scaling the 2nd-order horizontal diffusion in the mpas_cam absorbing +layer. The absorbing layer depth is controlled with mpas_cam_damping_levels. The damping +coefficients scale linearly with mpas_cam_coef. A value of 0.0 (or +mpas_cam_damping_levels=0) disables the 2nd-order diffusion in the absorbing layer. Sponge +layer absorption can also be provided by Rayleigh damping. + +E.g. a value of 1.0 with mpas_cam_damping_levels=3 will result in damping coefficients of +2E6 m^2/s, 6E5, 2E5 in the top-most three layers on the dynamics variables u, w, and +theta. +Default: 0.0 + + + +Number mpas_cam absorbing layers in which to apply 2nd-order horizontal diffusion. +Viscocity linearly ramps to zero by layer number from the top. mpas_cam_damping_levels and +mpas_cam_coef must both be greater than 0 for the diffusion to be enabled. +Default: 0 + + + +Whether to apply Rayleigh damping on horizontal velocity in the top-most model levels. +The number of levels is specified by the config_number_rayleigh_damp_u_levels option, +and the damping timescale is specified by the config_rayleigh_damp_u_timescale_days option. +Default: TRUE + + + +Timescale, in days (86400 s), for the Rayleigh damping on horizontal velocity in +the top-most model levels. +Default: 5.0 + + + +Number layers in which to apply Rayleigh damping on horizontal velocity at top of model; +damping linearly ramps to zero by layer number from the top +Default: 3 + + + +Whether to apply lateral boundary conditions +Default: FALSE + + + +Whether this run is within the JEDI data assimilation framework; used to add +temperature and specific humidity as diagnostics +Default: FALSE + + Prefix of the MPAS graph decomposition file, to be suffixed with the MPI @@ -7659,30 +8641,6 @@ us_standard_atmosphere: static atmospheric state (u,v)=0, standard lapse rate fo Default: 'none' - - - - - -Full pathname of time-variant sea-surface temperature and sea-ice -concentration boundary dataset. -Default: set by build-namelist. - - - -Full pathname of -Default: set by build-namelist. - - - -Full pathname of grid file for time-variant sea-surface temperature and sea-ice -concentration boundary dataset. -Default: set by build-namelist. - - - atm/cam/chem/trop_mozart_aero/oxid - oxid_1.9x2.5_L26_1850-2005_c091123.nc - INTERP_MISSING_MONTHS + atm/cam/chem/trop_mozart_aero/oxid + oxid_1.9x2.5_L26_1850-2005_c091123.nc + INTERP_MISSING_MONTHS 1850-2000 - -.false. -1850 -2012 -2008 - -atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_4x5_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_10x15_1850_2012_c130411.nc - -atm/cam/sst/sst_HadOIBl_bc_128x256_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_64x128_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_48x96_1850_2008_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_32x64_1850_2012_c130411.nc -atm/cam/sst/sst_HadOIBl_bc_8x16_1850_2012_c130411.nc - - -.true. -0 -0 -atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c091020.nc - diff --git a/bld/namelist_files/use_cases/1850_cam5.xml b/bld/namelist_files/use_cases/1850_cam5.xml new file mode 100644 index 0000000000..f33151bb3d --- /dev/null +++ b/bld/namelist_files/use_cases/1850_cam5.xml @@ -0,0 +1,54 @@ + + + + + +atm/cam/solar/SOLAR_SPECTRAL_Lean_1610-2008_annual_c090324.nc +18500101 +FIXED + + +284.7e-6 +791.6e-9 +275.68e-9 +12.48e-12 +0.0 + + +atm/cam/ozone +ozone_1.9x2.5_L26_1850clim_c090420.nc +O3 +CYCLICAL +1850 + + +CYCLICAL +atm/cam/chem/trop_mozart_aero/emis/aerocom_mam3_dms_surf_2000_c090129.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_surf_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_soag_1.5_surf_1850_c100217.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_surf_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_oc_surf_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_surf_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a2_surf_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_surf_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a2_surf_1850_c090726.nc + + +CYCLICAL +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_elev_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_elev_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a2_elev_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_elev_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a2_elev_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_oc_elev_1850_c090726.nc +atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_elev_1850_c090726.nc + + +CYCLICAL +1850 +oxid_1.9x2.5_L26_1850clim_c091123.nc + + +1850 + + diff --git a/bld/namelist_files/use_cases/1850_cam6.xml b/bld/namelist_files/use_cases/1850_cam6.xml index 9abb3b9782..7f4cf09a5c 100644 --- a/bld/namelist_files/use_cases/1850_cam6.xml +++ b/bld/namelist_files/use_cases/1850_cam6.xml @@ -1,4 +1,3 @@ - @@ -27,6 +26,9 @@ CYCLICAL 1850 +CYCLICAL +1850 + CYCLICAL 1850 diff --git a/bld/namelist_files/use_cases/1850_cam_lt.xml b/bld/namelist_files/use_cases/1850_cam_lt.xml new file mode 100644 index 0000000000..d046c8bec7 --- /dev/null +++ b/bld/namelist_files/use_cases/1850_cam_lt.xml @@ -0,0 +1,67 @@ + + + + +atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc + 18500101 + FIXED + + +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc +1850 +'CYCLICAL' +'CO2','CH4','N2O','CFC11','CFC12','CFC11eq' + + +'Q:H2O->UBC_FILE' +atm/cam/chem/ubc/b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensAvg123.cam.h0zm.H2O.1849-2014_c240604.nc +CYCLICAL +1850 + + + 'atm/cam/ozone_strataero' + 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc' + 'O3' + CYCLICAL + 1850 + + + 1850 + 'atm/cam/ozone_strataero' + 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc' + .true. + 'CYCLICAL' + + + + 1850 + 'atm/cam/tracer_cnst' + 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc' + 'O3','OH','NO3','HO2','HALONS' + 'CYCLICAL' + '' + + + CYCLICAL + 1850 + + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_num_so4_a1_anthro-ene_vertical_mol_175001-201412_ne30pg3_c20200103.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_SO2_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_so4_a1_anthro-ene_vertical_mol_175001-201412_ne30pg3_c20200103.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc' + + + + CYCLICAL + 1850 + +CYCLICAL +1850 + + +1850 + + diff --git a/bld/namelist_files/use_cases/1850_cam_mt.xml b/bld/namelist_files/use_cases/1850_cam_mt.xml new file mode 100644 index 0000000000..68e7ca4a1a --- /dev/null +++ b/bld/namelist_files/use_cases/1850_cam_mt.xml @@ -0,0 +1,62 @@ + + + + +atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc + 18500101 + FIXED + + +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc +1850 +'CYCLICAL' +'CO2','CH4','N2O','CFC11','CFC12','CFC11eq' + + + + 'atm/cam/ozone_strataero' + 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc' + 'O3' + CYCLICAL + 1850 + + + 1850 + 'atm/cam/ozone_strataero' + 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc' + .true. + 'CYCLICAL' + + + + 1850 + 'atm/cam/tracer_cnst' + 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc' + 'O3','OH','NO3','HO2','HALONS' + 'CYCLICAL' + '' + + + CYCLICAL + 1850 + + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_num_so4_a1_anthro-ene_vertical_mol_175001-201412_ne30pg3_c20200103.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_SO2_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_so4_a1_anthro-ene_vertical_mol_175001-201412_ne30pg3_c20200103.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc' + + + + CYCLICAL + 1850 + +CYCLICAL +1850 + + +1850 + + diff --git a/bld/namelist_files/use_cases/1850_trop_strat_t4s_cam7.xml b/bld/namelist_files/use_cases/1850_trop_strat_t4s_cam7.xml new file mode 100644 index 0000000000..dfd6d55003 --- /dev/null +++ b/bld/namelist_files/use_cases/1850_trop_strat_t4s_cam7.xml @@ -0,0 +1,48 @@ + + + + + +atm/cam/inic/se/1850C_T4S_ne30pg3_spinup01.cam.i.0002-01-01_c241114.nc + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc +FIXED +18500701 + + +CYCLICAL +1850 + + +CYCLICAL +1850 + + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_num_so4_a1_anthro-ene_vertical_mol_175001-201412_ne30pg3_c20200103.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_SO2_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_so4_a1_anthro-ene_vertical_mol_175001-201412_ne30pg3_c20200103.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/historical_ne30pg3/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_ne30pg3_c20200125.nc' + + + +CYCLICAL +1850 + + +CYCLICAL +1850 +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/1950-2010_ccmi_refc1_waccmx_ma.xml b/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml index 613c2f8cb0..15306d5711 100644 --- a/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +++ b/bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml @@ -23,11 +23,6 @@ atm/waccm/gcrs gcr_prod_NO_1949-2142_c150309.nc - -.false. -atm/waccm/qbo/qbocoefficients_c151023.nc -.true. - atm/waccm/lb/LBC_1765-2100_1.9x2.5_CCMI_RCP60_za_c130313.nc 'SERIAL' @@ -80,60 +75,60 @@ 0, -1, -24, -24, -120, -24 1, 24, 7, 7, 10, 365 - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2' 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', - 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'QRS_TOT', 'QO3', 'QCO2', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2' 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', + 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'QRS_TOT', 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', - 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', - 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', - 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', - 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO2', 'NO3', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'PHIS', + 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', + 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', + 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO2', 'NO3', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'PHIS', 'PRECC', 'PRECL', 'Q', 'QFLX', 'QPERT', 'QRL', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', 'QTHERMAL', 'QRL_TOT', 'PSL', 'HNO3_STS', 'HNO3_NAT', 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'TREFHT', - 'VERT', 'VTGWORO', 'VTGWSPEC', 'O2_1S', 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', - 'TCLY', 'TOTH', 'UIONTEND', 'VIONTEND', 'DTCORE', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', - 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'VERT', 'VTGWORO', 'VTGWSPEC', 'O2_1S', 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', + 'TCLY', 'TOTH', 'UIONTEND', 'VIONTEND', 'DTCORE', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', + 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', 'TROPP_FD', 'KVH', 'KVM', 'KVT', 'Qbkgndtot', 'Z3GM', 'OpDens', 'EDens' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H' + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', - 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', + 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' - - + + 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN' - - - 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' + + + 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' 42 @@ -157,6 +152,6 @@ atm/cam/dst/dst_source2x2tuned-cam4-06132012.nc atm/cam/topo/USGS-gtopo30_1.9x2.5_remap_c050602.nc 1.200D0 -.false. +.false. diff --git a/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml b/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml index 3d96dd4c48..a47840883e 100644 --- a/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml +++ b/bld/namelist_files/use_cases/2000_cam4_trop_chem.xml @@ -63,7 +63,7 @@ 'C10H16', 'TERPO2', 'TERPOOH', 'TOLUENE', 'CRESOL', 'TOLO2', 'TOLOOH', 'XOH', 'BIGALD', 'GLYOXAL', 'PAN', 'ONIT', 'MPAN', 'ISOPNO3', 'ONITR', 'CB1', 'CB2', 'OC1', 'OC2', 'SOA', 'SO2', 'SO4', 'DMS', 'NH3', 'NH4', 'NH4NO3', 'SSLT01', 'SSLT02', 'SSLT03', 'SSLT04', 'DST01', 'DST02', 'DST03', 'DST04', 'Rn', 'Pb','HCN','CH3CN', - 'SFNO','SFNO2','SFCO','SFBIGALK','SFBIGENE','SFC10H16','SFC2H4','SFC2H5OH','SFC2H6','SFC3H6','SFC3H8', + 'SFNO','SFCO','SFBIGALK','SFBIGENE','SFC10H16','SFC2H4','SFC2H5OH','SFC2H6','SFC3H6','SFC3H8', 'SFCH2O','SFCH3CHO','SFCH3COCH3','SFCH3OH','SFDMS','SFISOP','SFMEK','SFNH3', 'SFCB1','SFCB2','SFOC1','SFOC2','SFSO2','SFTOLUENE','SFHCN','SFCH3CN', 'DV_HCN','DV_CH3CN','WD_HCN','WD_CH3CN','WD_SO2','WD_HNO3','WD_H2O2','WD_CH2O', diff --git a/bld/namelist_files/use_cases/2000_cam6.xml b/bld/namelist_files/use_cases/2000_cam6.xml index 6d5df41ecd..05d019beb2 100644 --- a/bld/namelist_files/use_cases/2000_cam6.xml +++ b/bld/namelist_files/use_cases/2000_cam6.xml @@ -2,63 +2,84 @@ - - 2000 - atm/cam/ozone - tracer_cnst_CAM6chem_2000climo_3D_monthly_c171004.nc - '' - 'O3','OH','NO3','HO2' - 'CYCLICAL' +atm/cam/ozone +tracer_cnst_CAM6chem_2000climo_3D_monthly_c171004.nc +'O3','OH','NO3','HO2' +atm/cam/tracer_cnst +tracer_cnst_halons_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc +'O3','OH','NO3','HO2','HALONS' +2000 +CYCLICAL +'' 2000 atm/cam/ozone - ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc + ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc 'O3' - 'CYCLICAL' + 'CYCLICAL' 2000 atm/cam/ozone - ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc - 'CYCLICAL' + ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc + 'CYCLICAL' 'atm/cam/solar/SolarForcing1995-2005avg_c160929.nc' 20000101 FIXED + +CYCLICAL +2000 - 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3Dmonthly_L70_2000climo_c180511.nc', - 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc', - 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a1_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc', - 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a2_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc', - 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_contvolcano_vertical_2000climo_0.9x1.25_c20170322.nc ', - 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc', - 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc', - 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc' + 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3Dmonthly_L70_2000climo_c180511.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a1_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a2_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_contvolcano_vertical_2000climo_0.9x1.25_c20170322.nc ', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc' - - 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', - 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_other_surface_2000climo_0.9x1.25_c20170322.nc', - 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', - 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', - 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', - 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', - 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_bb_surface_2000climo_0.9x1.25_c20170509.nc', - 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', - 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc ', - 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ag-ship-res_surface_2000climo_0.9x1.25_c20170616.nc', - 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ene_surface_2000climo_0.9x1.25_c20170616.nc', - 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', - 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', - 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_anthro_surface_2000climo_0.9x1.25_c20170608.nc', - 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_biogenic_surface_2000climo_0.9x1.25_c20170322.nc' - + + +CYCLICAL +2000 + + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_bb_surface_2000climo_0.9x1.25_c20170509.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc ', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ag-ship-res_surface_2000climo_0.9x1.25_c20170616.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ene_surface_2000climo_0.9x1.25_c20170616.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', + 'SOAE -> 2.5592D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'SOAE -> 2.5592D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SOAE -> 0.5954D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_ISOP_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SOAE -> 5.1004D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MTERP_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SOAE -> 8.2367D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'SOAE -> 8.2367D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SOAE -> 6.5013D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'SOAE -> 6.5013D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SOAE -> 8.5371D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'SOAE -> 8.5371D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SOAE -> 16.650D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'SOAE -> 16.650D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc' + + + +2000 + 'atm/waccm/lb/LBC_2000climo_CMIP6_0p5degLat_c180227.nc' 'CO2','CH4','N2O','CFC11eq','CFC12' 'CYCLICAL' diff --git a/bld/namelist_files/use_cases/2000_geoschem.xml b/bld/namelist_files/use_cases/2000_geoschem.xml new file mode 100644 index 0000000000..384d46b42a --- /dev/null +++ b/bld/namelist_files/use_cases/2000_geoschem.xml @@ -0,0 +1,169 @@ + + + + + + + + +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +HEMCO_Config.rc +HEMCO_Diagn.rc + + + +00010101 + + +atm/cam/solar/SolarForcing1995-2005avg_c160929.nc +20000101 +FIXED + + +.true. +.true. +.false. +0.25D0 + + +CYCLICAL +2000 +atm/waccm/lb/LBC_2000climo_CMIP6_0p5degLat_c180227.nc + + + + + + + 1,30,365,240,240,480,365,73,30 + 0,-24,-24,-3,-1,1,-24,-120,-240 +'A','A','A','A','A','A','A','A','I' + +.true. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. + + +'AREA', +'HEIGHT', +'T', +'U', +'V', +'Q', +'PS', +'CLOUD', +'TROPP_P', +'TROPP_T', +'TROPP_Z', +'DF_CO', +'DF_O3', +'DF_NO2', +'DF_SO4', +'DF_NIT', +'CT_O3', +'CT_OH', +'OHwgtByAirMassColumnFull', +'Chem_SO3AQ', +'Jval_Cl2O2', +'Jval_H2O2', +'Jval_NO2', +'Jval_PAN', +'JvalO3O3P', +'JvalO3O1D', +'LNO_COL_PROD', +'Prod_Ox', +'Prod_SO4', +'Prod_CO', +'Prod_H2O2', +'ProdCOfromCH4', +'ProdCOfromNMVOC', +'Loss_Ox', +'Loss_CH4', +'Loss_CO', +'LossOHbyCH4columnTrop', +'LossOHbyMCFcolumnTrop', +'LossHNO3onSeaSalt', +'ACET', +'ALD2', +'ALK4', +'BR', +'BRCL', +'BRNO3', +'BRO', +'BROX', +'BROY', +'C3H8', +'CH2O', +'CH3CL', +'CH4', +'CL', +'CLNO3', +'CLO', +'CLOX', +'CLOY', +'CO', +'DMS', +'EOH', +'H2O', +'H2O2', +'H2SO4', +'HO2', +'HOX', +'HBR', +'HCL', +'HOBR', +'HOCL', +'HNO3', +'HNO4', +'ISOP', +'MACR', +'MAP', +'MEK', +'MOH', +'MVK', +'N2O', +'N2O5', +'NHX', +'NIT', +'NO', +'NO2', +'NO3', +'NOX', +'NOY', +'O3', +'OH', +'PAN', +'PM25', +'RCHO', +'SALA', +'SALC', +'SO2', +'SO4', +'SOX', +'TOLU', +'bc_a1', +'bc_a4', +'dst_a1', +'dst_a2', +'dst_a3', +'num_a1', +'num_a2', +'num_a3', +'num_a4', +'pom_a1', +'pom_a4', +'so4_a1', +'so4_a2', +'so4_a3', + + + diff --git a/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml b/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml index 9e1710e922..039685230f 100644 --- a/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +++ b/bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml @@ -111,7 +111,6 @@ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_other_surface_2000climo_0.9x1.25_c20170322.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', @@ -129,7 +128,8 @@ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc' -'noy', 'nhx' + +2000 @@ -147,14 +147,14 @@ .false. .false. - + - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'CFC11STAR', 'AODDUST', 'AODDUST02', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3OH', 'CH4', - 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', 'MTERP', 'N2O', 'O3', 'O3S', + 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', 'MTERP', 'N2O', 'O3', 'O3S', 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', 'BCARY', 'BENZENE', 'BENZOOH', 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALK', 'BIGENE', 'BR', 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', 'C2H2', 'C2H4', 'C2H5OH', @@ -181,14 +181,14 @@ 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdn_aitken', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdn_accum', 'AODdn_coarse', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', - 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', + 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', @@ -196,7 +196,7 @@ 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', - 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', + 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'dry_deposition_NHx_as_N', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', @@ -214,8 +214,8 @@ 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', 'SFISOP', 'SFMTERP', 'SFCH3OH', 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', - 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', - 'r_HO2_O3', 'r_OH_O3', 'r_OH_O', 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', + 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', + 'r_HO2_O3', 'r_OH_O3', 'r_OH_O', 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', diff --git a/bld/namelist_files/use_cases/2010_cam6.xml b/bld/namelist_files/use_cases/2010_cam6.xml index 9d00f7a86f..641a8a8689 100644 --- a/bld/namelist_files/use_cases/2010_cam6.xml +++ b/bld/namelist_files/use_cases/2010_cam6.xml @@ -11,20 +11,21 @@ 2010 atm/cam/ozone - ozone_strataero_CAM6chem_2010climo_zm_5day_c171004.nc + ozone_strataero_CAM6chem_2010climo_zm_5day_c171004.nc 'O3' - 'CYCLICAL' + 'CYCLICAL' 2010 atm/cam/ozone - ozone_strataero_CAM6chem_2010climo_zm_5day_c171004.nc - 'CYCLICAL' + ozone_strataero_CAM6chem_2010climo_zm_5day_c171004.nc + 'CYCLICAL' 'atm/cam/solar/SolarForcing1995-2005avg_c160929.nc' 20100101 FIXED - 2010 +CYCLICAL +2010 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3Dmonthly_L70_2010climo_c180511.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a1_anthro-ene_vertical_2010climo_0.9x1.25_c20180918.nc', @@ -36,12 +37,12 @@ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_so4_a2_contvolcano_vertical_2010climo_0.9x1.25_c20170724.nc' - 2010 - +CYCLICAL +2010 + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_bc_a4_anthro_surface_2010climo_0.9x1.25_c20180918.nc', 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_bc_a4_bb_surface_2010climo_0.9x1.25_c20180918.nc', 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_DMS_bb_surface_2010climo_0.9x1.25_c20180918.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_DMS_other_surface_2010climo_0.9x1.25_c20180918.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a1_bb_surface_2010climo_0.9x1.25_c20180918.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2010climo_0.9x1.25_c20180918.nc', 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2010climo_0.9x1.25_c20180918.nc', @@ -57,13 +58,32 @@ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_so4_a1_anthro-ag-ship_surface_2010climo_0.9x1.25_c20180918.nc', 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_so4_a1_bb_surface_2010climo_0.9x1.25_c20180918.nc', 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_so4_a2_anthro-res_surface_2010climo_0.9x1.25_c20180918.nc', - 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SOAGx1.5_anthro_surface_2010climo_0.9x1.25_c20180918.nc', - 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SOAGx1.5_bb_surface_2010climo_0.9x1.25_c20180918.nc', - 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SOAGx1.5_biogenic_surface_2010climo_0.9x1.25_c20180918.nc' - + 'SOAE -> 2.5592D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_BENZENE_anthro_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 2.5592D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_BENZENE_bb_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 0.5954D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_ISOP_bb_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 5.1004D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_MTERP_bb_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 8.2367D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_TOLUENE_anthro_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 8.2367D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_TOLUENE_bb_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 6.5013D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_XYLENES_anthro_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 6.5013D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_XYLENES_bb_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 8.5371D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_IVOC_anthro_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 8.5371D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_IVOC_bb_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 16.650D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SVOC_anthro_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 16.650D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SVOC_bb_surface_2010climo_0.9x1.25_c20180918.nc' + + + +2010 + +CYCLICAL +2010 + 'atm/waccm/lb/LBC_2010climo_CMIP6_0p5degLat_c180227.nc' 'CO2','CH4','N2O','CFC11eq','CFC12' 'CYCLICAL' 2010 + +2010 + diff --git a/bld/namelist_files/use_cases/2010_geoschem.xml b/bld/namelist_files/use_cases/2010_geoschem.xml new file mode 100644 index 0000000000..8f50e0321d --- /dev/null +++ b/bld/namelist_files/use_cases/2010_geoschem.xml @@ -0,0 +1,170 @@ + + + + + + +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +HEMCO_Config.rc +HEMCO_Diagn.rc + + + + +00010101 + + +atm/cam/solar/SolarForcing2006-2014avg_c180917.nc +20100101 +FIXED + + +.true. +.true. +.false. +0.25D0 + + +CYCLICAL +2010 +atm/waccm/lb/LBC_2010climo_CMIP6_0p5degLat_c180227.nc + + + + + + + 1,30,365,240,240,480,365,73,30 + 0,-24,-24,-3,-1,1,-24,-120,-240 +'A','A','A','A','A','A','A','A','I' + +.true. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. + + +'AREA', +'HEIGHT', +'T', +'U', +'V', +'Q', +'PS', +'CLOUD', +'TROPP_P', +'TROPP_T', +'TROPP_Z', +'DF_CO', +'DF_O3', +'DF_NO2', +'DF_SO4', +'DF_NIT', +'CT_O3', +'CT_OH', +'OHwgtByAirMassColumnFull', +'Chem_SO3AQ', +'Jval_Cl2O2', +'Jval_H2O2', +'Jval_NO2', +'Jval_PAN', +'JvalO3O3P', +'JvalO3O1D', +'LNO_COL_PROD', +'Prod_Ox', +'Prod_SO4', +'Prod_CO', +'Prod_H2O2', +'ProdCOfromCH4', +'ProdCOfromNMVOC', +'Loss_Ox', +'Loss_CH4', +'Loss_CO', +'LossOHbyCH4columnTrop', +'LossOHbyMCFcolumnTrop', +'LossHNO3onSeaSalt', +'ACET', +'ALD2', +'ALK4', +'BR', +'BRCL', +'BRNO3', +'BRO', +'BROX', +'BROY', +'C3H8', +'CH2O', +'CH3CL', +'CH4', +'CL', +'CLNO3', +'CLO', +'CLOX', +'CLOY', +'CO', +'DMS', +'EOH', +'H2O', +'H2O2', +'H2SO4', +'HO2', +'HOX', +'HBR', +'HCL', +'HOBR', +'HOCL', +'HNO3', +'HNO4', +'ISOP', +'MACR', +'MAP', +'MEK', +'MOH', +'MVK', +'N2O', +'N2O5', +'NHX', +'NIT', +'NO', +'NO2', +'NO3', +'NOX', +'NOY', +'O3', +'OH', +'PAN', +'PM25', +'RCHO', +'SALA', +'SALC', +'SO2', +'SO4', +'SOX', +'TOLU', +'bc_a1', +'bc_a4', +'dst_a1', +'dst_a2', +'dst_a3', +'num_a1', +'num_a2', +'num_a3', +'num_a4', +'pom_a1', +'pom_a4', +'so4_a1', +'so4_a2', +'so4_a3', + + +2010 + + diff --git a/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml b/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml index 2abf440959..7cd77b9b58 100644 --- a/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml +++ b/bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml @@ -138,7 +138,6 @@ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_bc_a4_anthro_surface_2010climo_0.9x1.25_c20180918.nc', 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_bc_a4_bb_surface_2010climo_0.9x1.25_c20180918.nc', 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_DMS_bb_surface_2010climo_0.9x1.25_c20180918.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_DMS_other_surface_2010climo_0.9x1.25_c20180918.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a1_bb_surface_2010climo_0.9x1.25_c20180918.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2010climo_0.9x1.25_c20180918.nc', 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2010climo_0.9x1.25_c20180918.nc', @@ -221,7 +220,6 @@ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30np4/2010climo/emissions-cmip6_bc_a4_anthro_surface_2010climo_ne30np4_c20200519.nc', 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30np4/2010climo/emissions-cmip6_bc_a4_bb_surface_2010climo_ne30np4_c20200519.nc', 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30np4/2010climo/emissions-cmip6_DMS_bb_surface_2010climo_ne30np4_c20200519.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30np4/2010climo/emissions-cmip6_DMS_other_surface_2010climo_ne30np4_c20200224.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30np4/2010climo/emissions-cmip6_num_so4_a1_bb_surface_2010climo_ne30np4_c20200519.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30np4/2010climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_mol_2010climo_ne30np4_c20200519.nc', 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30np4/2010climo/emissions-cmip6_num_so4_a2_anthro-res_surface_mol_2010climo_ne30np4_c20200519.nc', @@ -302,7 +300,6 @@ 'XYLENES -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30pg3/2010climo/emissions-cmip6_XYLENES_anthro_surface_2010climo_ne30pg3_c20200224.nc', 'XYLENES -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30pg3/2010climo/emissions-cmip6_XYLENES_bb_surface_2010climo_ne30pg3_c20200224.nc', 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30pg3/2010climo/emissions-cmip6_DMS_bb_surface_2010climo_ne30pg3_c20200224.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30pg3/2010climo/emissions-cmip6_DMS_other_surface_2010climo_ne30pg3_c20200224.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30pg3/2010climo/emissions-cmip6_num_so4_a1_bb_surface_2010climo_ne30pg3_c20200224.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30pg3/2010climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_mol_2010climo_ne30pg3_c20200224.nc', 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30pg3/2010climo/emissions-cmip6_num_so4_a2_anthro-res_surface_mol_2010climo_ne30pg3_c20200224.nc', @@ -322,7 +319,8 @@ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ne30pg3/2010climo/emissions-cmip6_so4_a2_anthro-res_surface_mol_2010climo_ne30pg3_c20200224.nc' -'noy', 'nhx' + +2010 @@ -340,14 +338,14 @@ .false. .false. - + - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', + 'CFC11STAR', 'AODDUST', 'AODDUST02', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3OH', 'CH4', - 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', 'MTERP', 'N2O', 'O3', 'O3S', + 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', 'MTERP', 'N2O', 'O3', 'O3S', 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', 'BCARY', 'BENZENE', 'BENZOOH', 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALK', 'BIGENE', 'BR', 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', 'C2H2', 'C2H4', 'C2H5OH', @@ -374,14 +372,14 @@ 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdn_aitken', 'AODVISstdn', 'AODNIRstdn', + 'AODUVstdn', 'AODdn_accum', 'AODdn_coarse', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', - 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', + 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', @@ -389,7 +387,7 @@ 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', - 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', + 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'dry_deposition_NHx_as_N', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', @@ -407,8 +405,8 @@ 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', 'SFISOP', 'SFMTERP', 'SFCH3OH', 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', - 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', - 'r_HO2_O3', 'r_OH_O3', 'r_OH_O', 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', + 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', + 'r_HO2_O3', 'r_OH_O3', 'r_OH_O', 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', diff --git a/bld/namelist_files/use_cases/aquaplanet_cam3.xml b/bld/namelist_files/use_cases/aquaplanet_cam3.xml deleted file mode 100644 index 3fd3d876cb..0000000000 --- a/bld/namelist_files/use_cases/aquaplanet_cam3.xml +++ /dev/null @@ -1,81 +0,0 @@ - - - - - -300 -150 - - -0. -0. -0. -fixed_parameters - - - false - - -348.0e-6 -1650.0e-9 -306.0e-9 -280.e-12 -503.e-12 - - - .false. - - - 4.0e-4 - 16.0e-6 - 5.0e-6 - 0.910D0 - 0.700D0 - 0.070D0 - 500.0D0 - 0.140D0 - 500.0D0 - 25000.0D0 - 1800.0D0 - 1.0e-4 - 0.0040D0 - 0.0040D0 - 1.0E-6 - - - -1365.0 -/ - - -apeozone_cam3_5_54.nc -atm/cam/ozone -OZONE -CYCLICAL -1990 - - - - - -.true. - - -86164.10063718943 -6.37100e6 -9.79764 -28.96623324623746 -18.01618112892741 -1.846e3 -273.16 - -'A:Q:H2O', 'N:O2:O2', 'N:CO2:CO2', 'N:ozone:O3', 'N:N2O:N2O', 'N:CH4:CH4', 'N:CFC11:CFC11','N:CFC12:CFC12' - - - 0.5 - - - 0 - - - diff --git a/bld/namelist_files/use_cases/aquaplanet_cam4.xml b/bld/namelist_files/use_cases/aquaplanet_cam4.xml index a18f4cfcd0..67d32c9f9f 100644 --- a/bld/namelist_files/use_cases/aquaplanet_cam4.xml +++ b/bld/namelist_files/use_cases/aquaplanet_cam4.xml @@ -31,8 +31,6 @@ - -.true. 86164.10063718943 6.37100e6 @@ -45,4 +43,3 @@ .false. - diff --git a/bld/namelist_files/use_cases/aquaplanet_cam5.xml b/bld/namelist_files/use_cases/aquaplanet_cam5.xml index afc820ecef..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 @@ -29,10 +27,6 @@ CYCLICAL 1990 - -.true. - - 86164.10063718943 6.37100e6 @@ -50,4 +44,3 @@ "" - diff --git a/bld/namelist_files/use_cases/aquaplanet_cam6.xml b/bld/namelist_files/use_cases/aquaplanet_cam6.xml index cbe41e8cee..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 @@ -29,9 +27,6 @@ CYCLICAL 1990 - -.true. - 86164.10063718943 6.37100e6 @@ -49,4 +44,3 @@ "" - diff --git a/bld/namelist_files/use_cases/aquaplanet_cam7.xml b/bld/namelist_files/use_cases/aquaplanet_cam7.xml new file mode 100644 index 0000000000..8e1c9fba5a --- /dev/null +++ b/bld/namelist_files/use_cases/aquaplanet_cam7.xml @@ -0,0 +1,63 @@ + + + + + +atm/cam/inic/se/QPLT_L58_ne3pg3_c241127.nc +atm/cam/inic/se/QPLT_L58_ne30pg3_c241127.nc +atm/cam/inic/se/QPMT_L93_ne3pg3_c241223.nc +atm/cam/inic/se/QPMT_L93_ne30pg3_c241223.nc + + +0. +0. +0. +fixed_parameters + + + false + + +1.650e-6 +0.306e-6 +348.0e-6 +0.0 +0.0 + + +atm/cam/solar/ape_solar_ave_tsi_1365.nc + + +apeozone_cam3_5_54.nc +aquaplanet_ozone_hightop_c20180412.nc +atm/cam/ozone +OZONE +CYCLICAL +1990 + + +86164.10063718943 +6.37100e6 +9.79764 +28.96623324623746 +18.01618112892741 +1.846e3 + +.false. + +.true. +.true. + "" + "" + "" + "" + "" + + 0.0 + + + 'A:Q:H2O', 'N:O2:O2', 'N:CO2:CO2', 'N:ozone:O3', + 'N:N2O:N2O', 'N:CH4:CH4', 'N:CFC11:CFC11', 'N:CFC12:CFC12' + + diff --git a/bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml b/bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml index 01d810b08d..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,26 +21,21 @@ 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 1990 - -.true. - .true. 0.73391095 - 0.0 86164.10063718943 @@ -70,5 +54,10 @@ "" 0.0 - + true + I + 1 + 1 + 'T','Q','U','V','PS','PRECT','Z3' + diff --git a/bld/namelist_files/use_cases/aquaplanet_waccm_2000.xml b/bld/namelist_files/use_cases/aquaplanet_waccm_2000.xml new file mode 100644 index 0000000000..d4919690c4 --- /dev/null +++ b/bld/namelist_files/use_cases/aquaplanet_waccm_2000.xml @@ -0,0 +1,26 @@ + + + + +00010101 + + +20000101 +FIXED + + +atm/waccm/phot/wa_smax_c100517.nc + + +.true. +.true. +.true. +.true. +.false. +.false. +.false. +.false. +.false. +.false. + + diff --git a/bld/namelist_files/use_cases/aquaplanet_waccm_ma_2000_cam6.xml b/bld/namelist_files/use_cases/aquaplanet_waccm_ma_2000_cam6.xml deleted file mode 100644 index ed57d8e5a3..0000000000 --- a/bld/namelist_files/use_cases/aquaplanet_waccm_ma_2000_cam6.xml +++ /dev/null @@ -1,106 +0,0 @@ - - - - -00010101 - -2000 - - -atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc -20000101 -FIXED - - -atm/waccm/phot/wa_smax_c100517.nc - - -atm/waccm/ic/f2000.waccm-mam3_1.9x2.5_L70.cam2.i.0017-01-01.c120410.nc -atm/waccm/ic/f2000.waccm-mam3_4x5_L70.cam2.i.0017-01-01.c121113.nc - - - -CYCLICAL -2000 -atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc - - 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', - 'HCFC22', 'N2O', 'CFC114', 'CFC115', 'HCFC141B', 'HCFC142B', 'CH2BR2', 'CHBR3', 'H2402', 'OCS', 'CFC11eq' - - - -atm/waccm/ub/tgcm_ubc.2000.c100203.nc -CYCLICAL - - -.true. -.false. -.false. -atm/waccm/qbo/qbocoefficients_c151023.nc - - - - - -CYCLICAL -2000 - - -CYCLICAL -2000 - - - - 1, 30, 120, 240, 240, 480, 365, 73, 30 - 0, -24, -6, -3, -1, 1, -24,-120,-240 - 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - - - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', - 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', - 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', - 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', - 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', - 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', 'HNO3_GAS', 'NO_Lightning', 'QNO', 'QRS_AUR', - 'QRS_CO2NIR', 'QRS_EUV', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'TREFHT', 'TTGW', - 'UTGWSPEC', 'VERT', 'VTGWSPEC', 'Z3', 'HOX', 'NOX', 'NOY', 'CLOX', - 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE', 'UI', 'VI', 'UIONTEND', 'VIONTEND', - 'DTCORE', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', - 'OMEGA_12_COS', 'OMEGA_12_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', - 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'PS_24_COS', 'PS_24_SIN', 'PS_12_COS', - 'PS_12_SIN', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', 'BUTGWSPEC', 'BTAUE', 'BTAUW', - 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUX', 'TAUY', - 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', - 'TROPP_FD', 'NITROP_PD', 'TROP_P', 'TROP_T', 'TROP_Z', 'SAD_AERO', 'REFF_AERO', - 'AODVISstdn', 'EXTINCTdn', 'EXTxASYMdn', 'AODUVstdn', 'AODNIRstdn', 'AODVISdn', 'MASS', - 'TMOCS', 'TMSO2', 'TMDMS', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'BURDENDUSTdn', - 'BURDENPOMdn', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', - 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', - 'soa_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', - 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', 'soa_c2', - 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', - 'CO2', 'H2O', 'N2O', 'CH4', 'N2O5', 'NO2', 'NO', - 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'LNO_PROD', 'LNO_COL_PROD', 'dry_deposition_NHx_as_N', 'dry_deposition_NOy_as_N', - 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N' - - - 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' - - - 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', - 'REFF_AERO', 'SAD_AERO', 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'NITROP_PD', - 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' - - -.true. -.true. -.true. -.true. -.false. -.false. -.false. -.false. -.false. -.false. - - diff --git a/bld/namelist_files/use_cases/dabi_p2004.xml b/bld/namelist_files/use_cases/dabi_p2004.xml deleted file mode 100644 index 113209a1aa..0000000000 --- a/bld/namelist_files/use_cases/dabi_p2004.xml +++ /dev/null @@ -1,40 +0,0 @@ - - - - - 10101 - - -atm/cam/inic/gaus/DABIp2004.128x256.L30.nc -atm/cam/inic/gaus/DABIp2004.128x256.L60.nc -atm/cam/inic/gaus/DABIp2004.64x128.L30.nc - - -.false. - - - 9.806D0 - 6.371D6 - - 86165.45950602833D0 - - 28.97027035191638D0 - - 1004.5D0 - - - 2 - 1 - 7.D5 - 0 - - -.true. -'I' --24 -30 - - 'U','V','T','PS','OMEGA' - - - diff --git a/bld/namelist_files/use_cases/dctest_frierson.xml b/bld/namelist_files/use_cases/dctest_frierson.xml new file mode 100644 index 0000000000..340052bc84 --- /dev/null +++ b/bld/namelist_files/use_cases/dctest_frierson.xml @@ -0,0 +1,31 @@ + + + + + +0. +0. +0. +fixed_parameters + + +.false. + + +.true. +-720 +'A' + + + 'U:A','T:A','V:A','Q:A','Z3:A','PRECL:A','PRECC:A','PS:A','SST:A','TS:A', 'gray_DTCOND', 'gray_DQCOND', 'gray_EVAPDT', 'gray_EVAPDQ', 'gray_PRECL' , 'gray_PRECC' , 'gray_Tsurf' , 'gray_Qsurf' , 'gray_Cdrag' , 'gray_Zpbl' , 'gray_KVH' , 'gray_KVM' , 'gray_VSE' , 'gray_Zm' , 'gray_Rf' , 'gray_DTV' , 'gray_DUV' , 'gray_DVV' , 'gray_VD01' , 'gray_SHflux', 'gray_LHflux', 'gray_TauU' , 'gray_TauV' , 'gray_QRL' , 'gray_QRS' , 'gray_SWflux', 'gray_LUflux', 'gray_LDflux', 'gray_LWflux', 'gray_LUflux_TOA', 'gray_LDflux_TOA', 'gray_LWflux_TOA' + + +'moist_baroclinic_wave_dcmip2016' + +atm/cam/inic/fv/FGRAYRAD_f19.cam.i.0051-01-01-00000_c20230510.nc + + + 'TT_SLOT','TT_GBALL','TT_TANH','TT_EM8','TT_Y2_2','TT_Y32_16' + + + diff --git a/bld/namelist_files/use_cases/held_suarez_1994.xml b/bld/namelist_files/use_cases/held_suarez_1994.xml index 4f6ffe13a8..a8ae45148b 100644 --- a/bld/namelist_files/use_cases/held_suarez_1994.xml +++ b/bld/namelist_files/use_cases/held_suarez_1994.xml @@ -4,19 +4,9 @@ 10101 - -atm/cam/inic/gaus/HS1994.128x256.L30_c062216.nc -atm/cam/inic/gaus/HS1994.128x256.L60_c061516.nc -atm/cam/inic/gaus/HS1994.64x128.L30_c061616.nc - 1.0D-5 - - 4 - 1.17D16 - 7.14D14 - 0,-6 diff --git a/bld/namelist_files/use_cases/hist_cam6.xml b/bld/namelist_files/use_cases/hist_cam6.xml index 5b04e73496..9b79a04132 100644 --- a/bld/namelist_files/use_cases/hist_cam6.xml +++ b/bld/namelist_files/use_cases/hist_cam6.xml @@ -18,10 +18,11 @@ INTERP_MISSING_MONTHS INTERP_MISSING_MONTHS + SERIAL 'SERIAL' 'atm/cam/ozone_strataero' - 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc' + 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc' .true. 'CHEM_LBC_FILE' @@ -30,6 +31,6 @@ 'CO2','CH4','N2O','CFC11eq','CFC12' - 1850-2000 + 1850-2015 diff --git a/bld/namelist_files/use_cases/hist_cam_lt.xml b/bld/namelist_files/use_cases/hist_cam_lt.xml new file mode 100644 index 0000000000..8f071a149b --- /dev/null +++ b/bld/namelist_files/use_cases/hist_cam_lt.xml @@ -0,0 +1,48 @@ + + + +19790101 + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc + + +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc +'SERIAL' +'CO2','CH4','N2O','CFC11','CFC12','CFC11eq' + + +'Q:H2O->UBC_FILE' +atm/cam/chem/ubc/b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensAvg123.cam.h0zm.H2O.1849-2014_c240604.nc +'SERIAL' + + + 'atm/cam/ozone_strataero' + 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc' + 'O3' + SERIAL + + + .true. + 'atm/cam/ozone_strataero' + 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc' + SERIAL + + + 'atm/cam/tracer_cnst' + 'tracer_cnst_halons_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc' + 'O3','OH','NO3','HO2','HALONS' + INTERP_MISSING_MONTHS + '' + + +INTERP_MISSING_MONTHS + + +INTERP_MISSING_MONTHS +SERIAL + + +1850-2015 + + diff --git a/bld/namelist_files/use_cases/hist_cam_mt.xml b/bld/namelist_files/use_cases/hist_cam_mt.xml new file mode 100644 index 0000000000..0c8e2e85fb --- /dev/null +++ b/bld/namelist_files/use_cases/hist_cam_mt.xml @@ -0,0 +1,43 @@ + + + +19790101 + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc + + +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc +'SERIAL' +'CO2','CH4','N2O','CFC11','CFC12','CFC11eq' + + + 'atm/cam/ozone_strataero' + 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc' + 'O3' + SERIAL + + + .true. + 'atm/cam/ozone_strataero' + 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc' + SERIAL + + + 'atm/cam/tracer_cnst' + 'tracer_cnst_halons_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc' + 'O3','OH','NO3','HO2','HALONS' + INTERP_MISSING_MONTHS + '' + + +INTERP_MISSING_MONTHS + + +INTERP_MISSING_MONTHS +SERIAL + + +1850-2015 + + diff --git a/bld/namelist_files/use_cases/hist_geoschem.xml b/bld/namelist_files/use_cases/hist_geoschem.xml new file mode 100644 index 0000000000..587ec4c1a4 --- /dev/null +++ b/bld/namelist_files/use_cases/hist_geoschem.xml @@ -0,0 +1,166 @@ + + + + + + + + +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +HEMCO_Config.rc +HEMCO_Diagn.rc + + + +00010101 + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc + + +.true. +.true. +.false. +0.25D0 + +SERIAL +atm/waccm/lb/LBC_17500116-25001216_CMIP6_SSP585_0p5degLat_c20200824.nc + +SERIAL + + + + 1,30,365,240,240,480,365,73,30 + 0,-24,-24,-3,-1,1,-24,-120,-240 +'A','A','A','A','A','A','A','A','I' + +.true. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. + + +'AREA', +'HEIGHT', +'T', +'U', +'V', +'Q', +'PS', +'CLOUD', +'TROPP_P', +'TROPP_T', +'TROPP_Z', +'DF_CO', +'DF_O3', +'DF_NO2', +'DF_SO4', +'DF_NIT', +'CT_O3', +'CT_OH', +'OHwgtByAirMassColumnFull', +'Chem_SO3AQ', +'Jval_Cl2O2', +'Jval_H2O2', +'Jval_NO2', +'Jval_PAN', +'JvalO3O3P', +'JvalO3O1D', +'LNO_COL_PROD', +'Prod_Ox', +'Prod_SO4', +'Prod_CO', +'Prod_H2O2', +'ProdCOfromCH4', +'ProdCOfromNMVOC', +'Loss_Ox', +'Loss_CH4', +'Loss_CO', +'LossOHbyCH4columnTrop', +'LossOHbyMCFcolumnTrop', +'LossHNO3onSeaSalt', +'ACET', +'ALD2', +'ALK4', +'BR', +'BRCL', +'BRNO3', +'BRO', +'BROX', +'BROY', +'C3H8', +'CH2O', +'CH3CL', +'CH4', +'CL', +'CLNO3', +'CLO', +'CLOX', +'CLOY', +'CO', +'DMS', +'EOH', +'H2O', +'H2O2', +'H2SO4', +'HO2', +'HOX', +'HBR', +'HCL', +'HOBR', +'HOCL', +'HNO3', +'HNO4', +'ISOP', +'MACR', +'MAP', +'MEK', +'MOH', +'MVK', +'N2O', +'N2O5', +'NHX', +'NIT', +'NO', +'NO2', +'NO3', +'NOX', +'NOY', +'O3', +'OH', +'PAN', +'PM25', +'RCHO', +'SALA', +'SALC', +'SO2', +'SO4', +'SOX', +'TOLU', +'bc_a1', +'bc_a4', +'dst_a1', +'dst_a2', +'dst_a3', +'num_a1', +'num_a2', +'num_a3', +'num_a4', +'pom_a1', +'pom_a4', +'so4_a1', +'so4_a2', +'so4_a3', + + +1850-2015 + + diff --git a/bld/namelist_files/use_cases/hist_geoschem_nudged.xml b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml new file mode 100644 index 0000000000..6d6e94c6c5 --- /dev/null +++ b/bld/namelist_files/use_cases/hist_geoschem_nudged.xml @@ -0,0 +1,221 @@ + + + + + + + + +atm/cam/geoschem/initial_conditions/f.e20.FC2010.f09_f09.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +atm/cam/geoschem/initial_conditions//f.e20.FC2010.f19_f19.144.GC_vbsext.001.cam.i.0007-01-01-00000.nc + +HEMCO_Config.rc +HEMCO_Diagn.rc + + + +00010101 + + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc + + +.true. +.true. +.false. +0.25D0 + +SERIAL +atm/waccm/lb/LBC_17500116-25001216_CMIP6_SSP585_0p5degLat_c20200824.nc + +SERIAL + + + +.true. +'atm/cam/met/nudging/MERRA2_fv09_32L/' +'atm/cam/met/nudging/MERRA2_ne30_32L/' +'atm/cam/met/nudging/MERRA2_ne30pg3_32L/' +'atm/cam/met/nudging/MERRA2_ne0CONUS30x8_L32/' +'%y/MERRA2_fv09.cam2.i.%y-%m-%d-%s.nc' +'%y/MERRA2_ne30np4_L32.cam2.i.%y-%m-%d-%s.nc' +'%y/MERRA2_ne30pg3_L32.cam2.i.%y-%m-%d-%s.nc' +'%y/MERRA2_ne0CONUS30x8_L32.cam2.i.%y-%m-%d-%s.nc' +0 +0 +4 +8 + +48 +384 +1 +0.06 +1 +0.06 +1 +0.06 +0 +0.00 +0 +0.00 +2010 +2013 +1 +1 +2020 +12 +31 +0.0 +37. +9999. +56. +1. +5. +180. +264. +9999. +94. +1. +5. +.false. +.true. +33. +0.001 +0. +0.1 +.false. + + + + 1,30,365,240,240,480,365,73,30 + 0,-24,-24,-3,-1,1,-24,-120,-240 +'A','A','A','A','A','A','A','A','I' + +.true. +.false. +.false. +.false. +.false. +.false. +.false. +.false. +.false. + + +'AREA', +'HEIGHT', +'T', +'U', +'V', +'Q', +'PS', +'CLOUD', +'TROPP_P', +'TROPP_T', +'TROPP_Z', +'DF_CO', +'DF_O3', +'DF_NO2', +'DF_SO4', +'DF_NIT', +'CT_O3', +'CT_OH', +'OHwgtByAirMassColumnFull', +'Chem_SO3AQ', +'Jval_Cl2O2', +'Jval_H2O2', +'Jval_NO2', +'Jval_PAN', +'JvalO3O3P', +'JvalO3O1D', +'LNO_COL_PROD', +'Prod_Ox', +'Prod_SO4', +'Prod_CO', +'Prod_H2O2', +'ProdCOfromCH4', +'ProdCOfromNMVOC', +'Loss_Ox', +'Loss_CH4', +'Loss_CO', +'LossOHbyCH4columnTrop', +'LossOHbyMCFcolumnTrop', +'LossHNO3onSeaSalt', +'ACET', +'ALD2', +'ALK4', +'BR', +'BRCL', +'BRNO3', +'BRO', +'BROX', +'BROY', +'C3H8', +'CH2O', +'CH3CL', +'CH4', +'CL', +'CLNO3', +'CLO', +'CLOX', +'CLOY', +'CO', +'DMS', +'EOH', +'H2O', +'H2O2', +'H2SO4', +'HO2', +'HOX', +'HBR', +'HCL', +'HOBR', +'HOCL', +'HNO3', +'HNO4', +'ISOP', +'MACR', +'MAP', +'MEK', +'MOH', +'MVK', +'N2O', +'N2O5', +'NHX', +'NIT', +'NO', +'NO2', +'NO3', +'NOX', +'NOY', +'O3', +'OH', +'PAN', +'PM25', +'RCHO', +'SALA', +'SALC', +'SO2', +'SO4', +'SOX', +'TOLU', +'bc_a1', +'bc_a4', +'dst_a1', +'dst_a2', +'dst_a3', +'num_a1', +'num_a2', +'num_a3', +'num_a4', +'pom_a1', +'pom_a4', +'so4_a1', +'so4_a2', +'so4_a3', + + +1850-2015 + + diff --git a/bld/namelist_files/use_cases/hist_trop_strat_nudged_cam6.xml b/bld/namelist_files/use_cases/hist_trop_strat_nudged_cam6.xml index 4303e95e88..026e329d7a 100644 --- a/bld/namelist_files/use_cases/hist_trop_strat_nudged_cam6.xml +++ b/bld/namelist_files/use_cases/hist_trop_strat_nudged_cam6.xml @@ -16,21 +16,118 @@ .false. 0.25D0 + SERIAL -atm/waccm/lb/LBC_1750-2014_CMIP6_0p5degLat_c170126.nc +atm/waccm/lb/LBC_17500116-25001216_CMIP6_SSP585_0p5degLat_c20200824.nc SERIAL +2.70D0 + 0.38D0 + 'SERIAL' + INTERP_MISSING_MONTHS + + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_bc_a4_aircraft_vertical_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_NO2_aircraft_vertical_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_so4_a1_anthro-ene_vertical_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_bc_a4_aircraft_vertical_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_aircraft_vertical_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/stratvolc/VolcanEESMv3.10_piControl_SO2_1850-2014average_ext_1deg_ZeroTrop_c181020.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_so4_a1_anthro-ene_vertical_mol_175001-210101_0.9x1.25_c20190224.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc' + INTERP_MISSING_MONTHS - -'noy', 'nhx' + + 'BENZENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BENZENE_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'BENZENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BENZENE_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'BIGALK -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BIGALK_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'BIGALK -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BIGALK_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'BIGENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BIGENE_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'BIGENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BIGENE_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H2_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H2_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_C2H4_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H5OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H5OH_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H5OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H5OH_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H6_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H6_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_C2H6_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C3H6_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C3H6_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_C3H6_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C3H8_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C3H8_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_C3H8_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH2O_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH2O_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3CHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3CHO_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3CHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3CHO_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3CN -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3CN_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3CN -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3CN_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3COCH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3COCH3_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3COCH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3COCH3_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3COCHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3COCHO_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3COOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3COOH_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3COOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3COOH_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3OH_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3OH_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CO_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CO_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_CO_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'E90 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions_E90global_surface_175001-210101_0.9x1.25_c20190224.nc', + 'GLYALD -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_GLYALD_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'HCN -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_HCN_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'HCN -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_HCN_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'HCOOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_HCOOH_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'HCOOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_HCOOH_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'ISOP -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_ISOP_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'IVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_IVOC_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'IVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_IVOC_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'MEK -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_MEK_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'MEK -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_MEK_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'MTERP -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_MTERP_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_NH3_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_NH3_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_NH3_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_NO_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_NO_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_NO_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SVOC_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SVOC_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'TOLUENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_TOLUENE_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'TOLUENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_TOLUENE_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'XYLENES -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_XYLENES_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'XYLENES -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_XYLENES_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_bc_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_bc_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_DMS_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_so4_a1_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_so4_a1_anthro-ag-ship_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_so4_a2_anthro-res_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_bc_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_bc_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_pom_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_pom_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_pom_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_pom_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_anthro-ag-ship-res_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_anthro-ene_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_so4_a1_anthro-ag-ship_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_so4_a1_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_so4_a2_anthro-res_surface_mol_175001-210101_0.9x1.25_c20190224.nc' + - .true. 'atm/cam/met/nudging/MERRA2_fv09_32L/' 'atm/cam/met/nudging/MERRA2_ne30_32L/' @@ -42,16 +139,15 @@ '%y/MERRA2_ne0CONUS30x8_L32.cam2.i.%y-%m-%d-%s.nc' 0 0 -4 -8 -24 +8 +48 384 1 -0.06 +0.25 1 -0.06 +0.25 1 -0.06 +0.25 0 0.00 0 @@ -89,14 +185,14 @@ 0, -24 'A', 'A' - 1, 1 - 0, 0 -'A', 'A' + 1, 1 + 0, 0 +'A', 'A' .true. .false. .false. -.false. +.true. .false. .false. .false. @@ -104,236 +200,51 @@ .false. - - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', - 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', - 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', - 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', - 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3OH', 'CH4', - 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', 'MTERP', 'N2O', 'O3', 'O3S', - 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', 'BCARY', 'BENZENE', 'BENZOOH', - 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALK', 'BIGENE', 'BR', - 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', 'C2H2', 'C2H4', 'C2H5OH', - 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7OOH', 'C3H8', 'C6H5OOH', 'CCL4', 'CF2CLBR', 'CF3BR', - 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', - 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', 'CH3COOOH', 'CH3OH', 'CH3OOH', - 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLONO2', 'CLY', 'CO', - 'CO2', 'COF2', 'COFCL', 'CRESOL', 'DMS', 'EOOH', 'F', 'GLYALD', 'GLYOXAL', - 'H', 'H2', 'H2402', 'H2O2', 'H2SO4', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', - 'HCL', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HO2NO2', 'HOBR', 'HOCL', 'HONITR', - 'HPALD', 'HYAC', 'HYDRALD', 'IEPOX', 'ISOP', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', 'ISOPNOOH', - 'ISOPOOH', 'IVOC', 'MACR', 'MACROOH', 'MEK', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', - 'N', 'N2O', 'N2O5', 'NC4CH2OH', 'NC4CHO', 'NH3', 'NH4', 'NO', - 'NO2', 'NO3', 'NOA', 'NTERPOOH', 'O', 'OCLO', - 'OCS', 'ONITR', 'PAN', 'PBZNIT', 'PHENO', 'PHENOL', 'PHENOOH', 'POOH', 'ROOH', - 'S', 'SF6', 'SO', 'SO2', 'SO3', 'SOAG0', 'SOAG1', 'SOAG2', 'SOAG3', - 'SOAG4', 'SVOC', 'TEPOMUC', 'TERP2OOH', 'TERPNIT', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TOLOOH', - 'TOLUENE', 'XOOH', 'XYLENES', 'XYLENOOH', 'XYLOL', 'XYLOLOOH', 'NHDEP', 'NDEP', 'ACBZO2', - 'ALKO2', 'BENZO2', 'BZOO', 'C2H5O2', 'C3H7O2', 'C6H5O2', 'CH3CO3', 'CH3O2', 'DICARBO2', - 'ENEO2', 'EO', 'EO2', 'HO2', 'HOCH2OO', 'ISOPAO2', 'ISOPBO2', 'MACRO2', - 'MALO2', 'MCO3', 'MDIALO2', 'MEKO2', 'NTERPO2', - 'O1D', 'OH', 'PHENO2', 'PO2', 'RO2', - 'TERP2O2', 'TERPO2', 'TOLO2', 'XO2', 'XYLENO2', 'XYLOLO2', 'H2O', 'SAD_ICE', 'SAD_LNAT', - 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', - 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', - 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', - 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', - 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', - 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', - 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', - 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', - 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', - 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', - 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', - 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', - 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', - 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', - 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', - 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', - 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', - 'dry_deposition_NHx_as_N', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', - 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', - 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', - 'DF_XYLENOOH', 'DF_XYLOLOOH', 'dry_deposition_NOy_as_N', 'SO2_CLXF', 'SO2_XFRC', 'SVOC_CLXF', 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', - 'LNO_COL_PROD', 'SFISOP', 'SFMTERP', 'SFBCARY', 'SFCH3OH', 'SFC2H5OH', 'SFCH3CHO', 'SFMEK', 'SFHCN', - 'SFCH3CN', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFC2H4', 'SFC3H6', 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', - 'SFBENZENE', 'SFTOLUENE', 'SFXYLENES', 'SFCO', 'SFNO', 'SFC2H2', 'SFHCOOH', 'SFCH3COOH', 'SFCH3COCH3', - 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', 'SFIVOC', 'SFSVOC', 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', - 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', - 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', - 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', - 'CO2_CHML', 'AQ_SO2', 'GS_SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', - 'SOAG3_CHMP', 'SOAG4_CHMP', 'IVOC_CHMP', 'SVOC_CHML', 'MASS', 'ABSORB', 'WD_H2SO4', 'WD_IVOC', 'WD_SO2', - 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'DF_CO', 'DF_IVOC', 'DF_O3', - 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', - 'SFISOP', 'SFMTERP', 'SFCH3OH', 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', - 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', - 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', - 'r_HO2_O3', 'r_OH_O3', 'r_OH_O', 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', - 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', - 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', - 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', - 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', - 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', - 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', - 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', - 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', - 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', - 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', - 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', - 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', - 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', - 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', - 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', - 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', - 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', - 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', - 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', - 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', - 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', 'so4_a2_sfnnuc1', - 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', - 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'soa1_a1_CHML', 'soa2_a1_CHML', 'soa3_a1_CHML', 'soa4_a1_CHML', 'soa5_a1_CHML', 'soa1_a2_CHML', - 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', 'so4_a3_CHMP', 'soa1_a1_CHMP', 'soa2_a1_CHMP', - 'soa3_a1_CHMP', 'soa4_a1_CHMP', 'soa5_a1_CHMP', 'soa1_a2_CHMP', 'soa2_a2_CHMP', 'soa3_a2_CHMP', 'soa4_a2_CHMP', 'soa5_a2_CHMP', 'r_jsoa1_a1', - 'r_jsoa2_a1', 'r_jsoa3_a1', 'r_jsoa4_a1', 'r_jsoa5_a1', 'r_jsoa1_a2', 'r_jsoa2_a2', 'r_jsoa3_a2', 'r_jsoa4_a2', 'r_jsoa5_a2', - 'r_GLYOXAL_aer', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', 'TMOCS', 'TMSO2', 'TMDMS', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', - 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BURDENSEASALTdn','BURDENBCdn', 'PM25', - 'O3_Prod','O3_Loss','O3S_Loss','RO2_NO_sum','O3_alkenes','RO2_NO3_sum','RO2_HO2_sum','RO2_RO2_sum','RCO2_NO2_sum', - 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', - 'Ox_Prod','Ox_Loss' + + 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', + 'BTTGWSPEC', 'BTTGWSDF', 'BTTGWSKE', 'CONCLD', 'CME', 'CMFDQ', 'CMFMC', 'CMFMC_DP', + 'CH3CCL3_CHML', 'CH4_CHML', 'CO2_CHML', 'CO_CHML', 'IVOC_CHML', 'N2O_CHML', 'O3_CHML', 'SO2_CHML', + 'CO_CHMP', 'O3_CHMP', 'SO2_CHMP', 'TMDMS', 'TMOCS', 'TMSO2','TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'soa1_a1_CHML', 'soa1_a2_CHML', 'soa2_a1_CHML', 'soa2_a2_CHML', 'soa3_a1_CHML', 'soa3_a2_CHML', + 'soa4_a1_CHML', 'soa4_a2_CHML', 'soa5_a1_CHML', 'soa5_a2_CHML', 'SVOC_CHML', + 'so4_a1_CHMP','so4_a2_CHMP', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'TOTH', 'TOT_CLD_VISTAU', + 'TREFHTMN', 'TREFHTMX', 'TROP_P', 'TROP_T', 'TROP_Z', 'TTEND_TOT', 'TTGWORO', 'TTGWSDF', 'TTGWSDFORO', 'TTGWSKE', 'TTGWSKEORO', + 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', + 'ABSORB', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODdn_aitken', 'AODdn_accum', 'AODdn_coarse', + 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', + 'AODVISdn', 'AODVISstdn', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'FLDSC', 'FLNR', 'FSNR', + 'CME', 'CMFDQ', 'CMFMC','CMFMC_DP', 'SOLLD', 'SOLSD', 'SSAVIS', 'SST','TAQ', + 'DCOCHM','DH2O2CHM', 'DHNO3CHM', 'DO3CHM', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', + 'FLASHFRQ', 'LNO_COL_PROD', 'LNO_PROD','KVH_CLUBB','MASS', 'PDELDRY', 'NITROP_PD','PM25', 'PRECT', 'PTEQ', 'PTTEND', + 'QRLC', 'QRSC', 'QSNOW', 'QRAIN','GS_SO2', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS','H2SO4M_C', 'H2SO4_sfnnuc1','HCL_GAS', + 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP' 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RHREFHT', + 'EVAPPREC', 'EVAPQZM', 'EVAPTZM', 'FCTL','FREQZM', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU','VEL_NAT2', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', 'dst_c3DDF', + 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'num_c1DDF','num_c2DDF','num_c3DDF','num_c4DDF', + 'so4_a1_sfgaex1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_a2_sfgaex1', 'so4_c2AQH2SO4', 'so4_c2AQSO4', 'so4_c2DDF', + 'so4_a3_sfgaex1', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_a2_sfnnuc1', 'num_a2_sfnnuc1', + 'soa1_a1_sfgaex1','soa1_c1DDF', 'soa1_a2_sfgaex1','soa1_c2DDF', 'soa2_a1_sfgaex1','soa2_c1DDF', 'soa2_a2_sfgaex1','soa2_c2DDF', + 'soa3_a1_sfgaex1','soa3_c1DDF', 'soa3_a2_sfgaex1','soa3_c2DDF', 'soa4_a1_sfgaex1','soa4_c1DDF', 'soa4_a2_sfgaex1','soa4_c2DDF', + 'soa5_a1_sfgaex1','soa5_c1DDF', 'soa5_a2_sfgaex1','soa5_c2DDF', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', + 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_het10', 'r_het11', 'r_het12', 'r_het13', + 'r_het15', 'r_het16', 'r_het17', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', + 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_GLYOXAL_aer', 'r_HO2_O3', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', 'r_OH_O3', 'r_OH_O', + 'O3_Prod','O3_Loss','O3S_Loss','RO2_NO_sum','O3_alkenes','RO2_NO3_sum','RO2_HO2_sum','RO2_RO2_sum','RCO2_NO2_sum', + 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', 'Ox_Prod','Ox_Loss' - - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', - 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', - 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', - 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', - 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', - 'CH3OH', 'CH4', 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', - 'N2O', 'O3', 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', - 'ALKOOH', 'BCARY', 'BENZENE', 'BENZOOH', 'BEPOMUC', 'BIGALD1', 'BIGALD2', - 'BIGALD3', 'BIGALD4', 'BIGALK', 'BIGENE', 'BR', 'BRCL', 'BRO', 'BRONO2', - 'BRY', 'BZALD', 'BZOOH', 'C2H2', 'C2H4', 'C2H5OH', 'C2H5OOH', 'C2H6', - 'C3H6', 'C3H7OOH', 'C3H8', 'C6H5OOH', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', - 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', - 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', 'CH3COOOH', 'CH3OH', - 'CH3OOH', 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLONO2', - 'CLY', 'CO', 'CO2', 'COF2', 'COFCL', 'CRESOL', 'DMS', 'EOOH', - 'F', 'GLYALD', 'GLYOXAL', 'H', 'H2', 'H2402', 'H2O2', 'H2SO4', - 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', 'HCL', 'HCN', 'HCOOH', 'HF', - 'HNO3', 'HO2NO2', 'HOBR', 'HOCL', 'HONITR', 'HYAC', 'HYDRALD', - 'IEPOX', 'ISOP', 'ISOPNO3', 'ISOPOOH', 'IVOC', - 'MACR', 'MACROOH', 'MEK', 'MEKOOH', 'MPAN', 'MVK', 'N', - 'N2O', 'N2O5', 'NC4CHO', 'NH3', 'NH4', 'NO', 'NO2', - 'NO3', 'NOA', 'O', 'OCLO', 'OCS', 'ONITR', 'PAN', - 'PBZNIT', 'PHENO', 'PHENOL', 'PHENOOH', 'POOH', 'ROOH', 'S', 'SF6', - 'SO', 'SO2', 'SO3', 'SOAG0', 'SOAG1', 'SOAG2', 'SOAG3', 'SOAG4', - 'SVOC', 'TEPOMUC', 'TERP2AOOH', 'TERPOOH', 'TOLOOH', - 'TOLUENE', 'XYLENES', 'XYLENOOH', 'XYLOL', 'XYLOLOOH', 'NHDEP', 'NDEP', - 'ACBZO2', 'ALKO2', 'BENZO2', 'BZOO', 'C2H5O2', 'C3H7O2', 'C6H5O2', 'CH3CO3', - 'CH3O2', 'DICARBO2', 'ENEO2', 'EO', 'EO2', 'HO2', 'HOCH2OO', - 'MACRO2', 'MALO2', 'MCO3', 'MDIALO2', 'MEKO2', 'O1D', - 'OH', 'PHENO2', 'PO2', 'RO2', 'TOLO2', - 'XYLENO2', 'XYLOLO2', 'H2O', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', - 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', - 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', - 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', - 'AODNIRstdn', 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', - 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', - 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', - 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', - 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', - 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', - 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', - 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', - 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', - 'WD_NOA', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', - 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2AOOH', 'WD_TERPOOH', - 'WD_TOLOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', 'DF_ALKNIT', 'DF_ALKOOH', - 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', - 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', - 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', - 'DF_HONITR', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', - 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CHO', - 'dry_deposition_NHx_as_N', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', 'DF_O3', - 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', - 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2AOOH', 'DF_TERPOOH', - 'DF_TOLOOH', 'DF_XYLENOOH', 'DF_XYLOLOOH', 'dry_deposition_NOy_as_N', 'SO2_CLXF', 'SO2_XFRC', - 'SVOC_CLXF', 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', 'LNO_COL_PROD', 'SFISOP', 'SFBCARY', - 'SFCH3OH', 'SFC2H5OH', 'SFCH3CHO', 'SFMEK', 'SFHCN', 'SFCH3CN', 'SFCH2O', 'SFC2H6', - 'SFC3H8', 'SFC2H4', 'SFC3H6', 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', 'SFBENZENE', 'SFTOLUENE', - 'SFXYLENES', 'SFCO', 'SFNO', 'SFC2H2', 'SFHCOOH', 'SFCH3COOH', 'SFCH3COCH3', 'SFDMS', - 'SFMEK', 'SFSO2', 'SFNH3', 'SFIVOC', 'SFSVOC', 'MEG_ISOP', 'MEG_BCARY', - 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', 'MEG_HCOOH', 'MEG_HCN', - 'MEG_CO', 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_TOLUENE', - 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'CH4_CHML', - 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', 'CO2_CHML', 'AQ_SO2', 'GS_SO2', 'SO2_CHML', 'SO2_CHMP', - 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'IVOC_CHMP', 'SVOC_CHML', - 'MASS', 'ABSORB', 'WD_H2SO4', 'WD_IVOC', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', - 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'DF_CO', 'DF_IVOC', 'DF_O3', 'DF_SO2', 'DF_SOAG0', - 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', 'SFISOP', - 'SFCH3OH', 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', - 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', 'SO2_CHML', 'SO2_CHMP', - 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'O3_Prod', 'O3_Loss', - 'OddOx_Ox_Loss', 'OddOx_HOx_Loss', 'OddOx_NOx_Loss', 'OddOx_CLOxBROx_Loss', 'OddOx_Loss_Tot', 'OddOx_Prod_Tot', 'O3_Prod', 'O3_Loss', - 'r_HO2_O3', 'r_OH_O3', 'r_OH_O', 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', - 'r_het5', 'r_het6', 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', - 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', - 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', - 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', 'soa4_a2', 'soa5_a2', 'bc_c1', - 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', 'ncl_c2', 'ncl_c3', - 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', 'soa3_c1', - 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', 'bc_a1SFWET', - 'num_a1', 'num_a2', 'num_a3', 'num_a4', 'num_c1', 'num_c2', 'num_c3', 'num_c4', - 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', 'ncl_a2SFWET', 'ncl_a3SFWET', - 'pom_a1SFWET', 'pom_a4SFWET', 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', 'soa2_a1SFWET', - 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', - 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', - 'pom_c4SFWET', 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', - 'soa3_c1SFWET', 'soa3_c2SFWET', 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', 'bc_a1DDF', 'bc_a4DDF', - 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', 'pom_a4DDF', - 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', - 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', - 'dst_c2DDF', 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'so4_c1DDF', - 'so4_c2DDF', 'so4_c3DDF', 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', 'soa3_c2DDF', - 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', - 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', - 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', - 'SFnum_a3', 'so4_a1_sfgaex1', 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', - 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', 'so4_a2_sfnnuc1', 'so4_c1AQH2SO4', - 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', - 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'soa1_a1_CHML', 'soa2_a1_CHML', 'soa3_a1_CHML', 'soa4_a1_CHML', 'soa5_a1_CHML', - 'soa1_a2_CHML', 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', 'so4_a3_CHMP', - 'r_jsoa1_a1', 'r_jsoa2_a1', 'r_jsoa3_a1', 'r_jsoa4_a1', 'r_jsoa5_a1', 'r_jsoa1_a2', 'r_jsoa2_a2', 'r_jsoa3_a2', - 'r_jsoa4_a2', 'r_jsoa5_a2', 'r_GLYOXAL_aer', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', 'TMOCS', 'TMSO2', 'TMDMS', - 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BURDENSEASALTdn', - 'BURDENBCdn', 'PM25', - 'MEG_XYLENES','MEG_BZALD','MEG_MEK', - 'DF_BCARY', 'DF_BENZENE', 'DF_BEPOMUC', 'DF_BIGALD1', 'DF_BIGALD2', 'DF_BIGALD3', - 'DF_BIGALD4', 'DF_BIGALK', 'DF_BIGENE', 'DF_BZALD', 'DF_C2H2', 'DF_C2H4', 'DF_C2H6', 'DF_C3H6', - 'DF_C3H8', 'DF_CRESOL', 'DF_DMS', 'DF_GLYOXAL', 'DF_ISOP', 'DF_MACR', 'DF_MEK', - 'DF_MVK', 'DF_N2O5', 'DF_PBZNIT', 'DF_PHENOL', 'DF_TEPOMUC', 'DF_TOLUENE', 'DF_XYLENES', 'DF_XYLOL', - 'WD_BCARY', 'WD_BENZENE', 'WD_BEPOMUC', 'WD_BIGALD1', 'WD_BIGALD2', 'WD_BIGALD3', 'WD_BIGALD4', - 'WD_BIGALK', 'WD_BIGENE', 'WD_BZALD', - 'WD_C2H2', 'WD_C2H4', 'WD_C2H6', 'WD_C3H6', 'WD_C3H8', 'WD_CO', 'WD_CRESOL', 'WD_DMS', 'WD_GLYOXAL', 'WD_ISOP', - 'WD_MEK', 'WD_MPAN', - 'WD_N2O5', 'WD_NO', 'WD_NO2', 'WD_PAN', 'WD_PBZNIT', 'WD_PHENOL', 'WD_TEPOMUC','WD_TOLUENE', 'WD_XYLENES', 'WD_XYLOL' - - + 'PMID', 'PDELDRY','PS','PHIS:I','Z3','T','U','V','Q','TROP_P', 'CLOUD', 'CO','O3','O3S','NO2','NO','OH','ISOP','SO2', 'PAN', 'HNO3', 'C2H6', 'C3H8', 'CH2O', 'CH3COCH3', 'SFISOP','SFCO','SFNO','SFNO2', 'PM25_SRF', 'so4_a1','so4_a2','so4_a3','dst_a1','dst_a2','dst_a3','soa_a1','soa_a2', 'ncl_a1','ncl_a2','ncl_a3','bc_a1', 'bc_a4','pom_a1','pom_a4', 'AODVISdn', - + 'soa_a1 = soa1_a1 + soa2_a1 + soa3_a1 + soa4_a1 + soa5_a1', 'soa_a2 = soa1_a2 + soa2_a2 + soa3_a2 + soa4_a2 + soa5_a2' - + 'MEG_APIN','MEG_BPIN','MEG_LIMON','MEG_MYRC', 'ISOPFDN', 'ISOPFNP', 'ISOPN3B', 'ISOPN2B', 'ISOPN1D', 'ISOPN4D', 'ISOPNBNO3', 'ISOPNOOHB', 'ISOPNOOHD', 'INHEB','INHED', diff --git a/bld/namelist_files/use_cases/hist_trop_strat_t4s_cam7.xml b/bld/namelist_files/use_cases/hist_trop_strat_t4s_cam7.xml new file mode 100644 index 0000000000..4e65f4f34c --- /dev/null +++ b/bld/namelist_files/use_cases/hist_trop_strat_t4s_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/hist_trop_strat_vbs_cam6.xml b/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml index 98309c552e..f9ea8eb9eb 100644 --- a/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml +++ b/bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml @@ -16,17 +16,114 @@ 0.25D0 SERIAL -atm/waccm/lb/LBC_1750-2014_CMIP6_0p5degLat_c170126.nc +atm/waccm/lb/LBC_17500116-25001216_CMIP6_SSP585_0p5degLat_c20200824.nc - SERIAL +SERIAL +2.70D0 + 0.38D0 + 'SERIAL' + INTERP_MISSING_MONTHS + + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_bc_a4_aircraft_vertical_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_NO2_aircraft_vertical_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_so4_a1_anthro-ene_vertical_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_bc_a4_aircraft_vertical_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_aircraft_vertical_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/stratvolc/VolcanEESMv3.10_piControl_SO2_1850-2014average_ext_1deg_ZeroTrop_c181020.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_so4_a1_anthro-ene_vertical_mol_175001-210101_0.9x1.25_c20190224.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc' + INTERP_MISSING_MONTHS - -'noy', 'nhx' + + 'BENZENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BENZENE_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'BENZENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BENZENE_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'BIGALK -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BIGALK_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'BIGALK -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BIGALK_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'BIGENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BIGENE_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'BIGENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BIGENE_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H2_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H2_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_C2H4_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H5OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H5OH_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H5OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H5OH_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H6_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C2H6_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_C2H6_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C3H6_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C3H6_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_C3H6_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C3H8_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_C3H8_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_C3H8_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH2O_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH2O_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3CHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3CHO_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3CHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3CHO_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3CN -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3CN_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3CN -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3CN_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3COCH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3COCH3_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3COCH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3COCH3_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3COCHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3COCHO_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3COOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3COOH_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3COOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3COOH_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3OH_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CH3OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CH3OH_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CO_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_CO_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_CO_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'E90 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions_E90global_surface_175001-210101_0.9x1.25_c20190224.nc', + 'GLYALD -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_GLYALD_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'HCN -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_HCN_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'HCN -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_HCN_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'HCOOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_HCOOH_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'HCOOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_HCOOH_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'ISOP -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_ISOP_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'IVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_IVOC_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'IVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_IVOC_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'MEK -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_MEK_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'MEK -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_MEK_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'MTERP -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_MTERP_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_NH3_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_NH3_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_NH3_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_NO_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_NO_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_NO_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SVOC_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SVOC_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'TOLUENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_TOLUENE_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'TOLUENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_TOLUENE_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'XYLENES -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_XYLENES_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'XYLENES -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_XYLENES_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_bc_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_bc_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_DMS_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_so4_a1_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_so4_a1_anthro-ag-ship_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_so4_a2_anthro-res_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_bc_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_bc_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_pom_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_pom_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_pom_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_pom_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_anthro-ag-ship-res_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_anthro-ene_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_so4_a1_anthro-ag-ship_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_so4_a1_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_so4_a2_anthro-res_surface_mol_175001-210101_0.9x1.25_c20190224.nc' + @@ -37,113 +134,45 @@ .true. .false. .false. -.false. +.true. .false. .false. .false. .false. .false. - + - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', - 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', - 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', - 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', - 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3OH', 'CH4', - 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', 'MTERP', 'N2O', 'O3', 'O3S', - 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', 'BCARY', 'BENZENE', 'BENZOOH', - 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALK', 'BIGENE', 'BR', - 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', 'C2H2', 'C2H4', 'C2H5OH', - 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7OOH', 'C3H8', 'C6H5OOH', 'CCL4', 'CF2CLBR', 'CF3BR', - 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', - 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', 'CH3COOOH', 'CH3OH', 'CH3OOH', - 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLONO2', 'CLY', 'CO', - 'CO2', 'COF2', 'COFCL', 'CRESOL', 'DMS', 'EOOH', 'F', 'GLYALD', 'GLYOXAL', - 'H', 'H2', 'H2402', 'H2O2', 'H2SO4', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', - 'HCL', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HO2NO2', 'HOBR', 'HOCL', 'HONITR', - 'HPALD', 'HYAC', 'HYDRALD', 'IEPOX', 'ISOP', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', 'ISOPNOOH', - 'ISOPOOH', 'IVOC', 'MACR', 'MACROOH', 'MEK', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', - 'N', 'N2O', 'N2O5', 'NC4CH2OH', 'NC4CHO', 'NH3', 'NH4', 'NO', - 'NO2', 'NO3', 'NOA', 'NTERPOOH', 'O', 'OCLO', - 'OCS', 'ONITR', 'PAN', 'PBZNIT', 'PHENO', 'PHENOL', 'PHENOOH', 'POOH', 'ROOH', - 'S', 'SF6', 'SO', 'SO2', 'SO3', 'SOAG0', 'SOAG1', 'SOAG2', 'SOAG3', - 'SOAG4', 'SVOC', 'TEPOMUC', 'TERP2OOH', 'TERPNIT', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TOLOOH', - 'TOLUENE', 'XOOH', 'XYLENES', 'XYLENOOH', 'XYLOL', 'XYLOLOOH', 'NHDEP', 'NDEP', 'ACBZO2', - 'ALKO2', 'BENZO2', 'BZOO', 'C2H5O2', 'C3H7O2', 'C6H5O2', 'CH3CO3', 'CH3O2', 'DICARBO2', - 'ENEO2', 'EO', 'EO2', 'HO2', 'HOCH2OO', 'ISOPAO2', 'ISOPBO2', 'MACRO2', - 'MALO2', 'MCO3', 'MDIALO2', 'MEKO2', 'NTERPO2', - 'O1D', 'OH', 'PHENO2', 'PO2', 'RO2', - 'TERP2O2', 'TERPO2', 'TOLO2', 'XO2', 'XYLENO2', 'XYLOLO2', 'H2O', 'SAD_ICE', 'SAD_LNAT', - 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', - 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', - 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', - 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', - 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', - 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', - 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', - 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', - 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', - 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', - 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', - 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', - 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', - 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', - 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', - 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', - 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', - 'dry_deposition_NHx_as_N', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', - 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', - 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', - 'DF_XYLENOOH', 'DF_XYLOLOOH', 'dry_deposition_NOy_as_N', 'SO2_CLXF', 'SO2_XFRC', 'SVOC_CLXF', 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', - 'LNO_COL_PROD', 'SFISOP', 'SFMTERP', 'SFBCARY', 'SFCH3OH', 'SFC2H5OH', 'SFCH3CHO', 'SFMEK', 'SFHCN', - 'SFCH3CN', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFC2H4', 'SFC3H6', 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', - 'SFBENZENE', 'SFTOLUENE', 'SFXYLENES', 'SFCO', 'SFNO', 'SFC2H2', 'SFHCOOH', 'SFCH3COOH', 'SFCH3COCH3', - 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', 'SFIVOC', 'SFSVOC', 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', - 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', - 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', - 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', - 'CO2_CHML', 'AQ_SO2', 'GS_SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', - 'SOAG3_CHMP', 'SOAG4_CHMP', 'IVOC_CHMP', 'SVOC_CHML', 'MASS', 'ABSORB', 'WD_H2SO4', 'WD_IVOC', 'WD_SO2', - 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'DF_CO', 'DF_IVOC', 'DF_O3', - 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', - 'SFISOP', 'SFMTERP', 'SFCH3OH', 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', - 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', - 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', - 'r_HO2_O3', 'r_OH_O3', 'r_OH_O', 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', - 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', - 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', - 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', - 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', - 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', - 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', - 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', - 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', - 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', - 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', - 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', - 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', - 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', - 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', - 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', - 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', - 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', - 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', - 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', - 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', - 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', 'so4_a2_sfnnuc1', - 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', - 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'soa1_a1_CHML', 'soa2_a1_CHML', 'soa3_a1_CHML', 'soa4_a1_CHML', 'soa5_a1_CHML', 'soa1_a2_CHML', - 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', 'so4_a3_CHMP', 'soa1_a1_CHMP', 'soa2_a1_CHMP', - 'soa3_a1_CHMP', 'soa4_a1_CHMP', 'soa5_a1_CHMP', 'soa1_a2_CHMP', 'soa2_a2_CHMP', 'soa3_a2_CHMP', 'soa4_a2_CHMP', 'soa5_a2_CHMP', 'r_jsoa1_a1', - 'r_jsoa2_a1', 'r_jsoa3_a1', 'r_jsoa4_a1', 'r_jsoa5_a1', 'r_jsoa1_a2', 'r_jsoa2_a2', 'r_jsoa3_a2', 'r_jsoa4_a2', 'r_jsoa5_a2', - 'r_GLYOXAL_aer', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', 'TMOCS', 'TMSO2', 'TMDMS', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', - 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BURDENSEASALTdn','BURDENBCdn', 'PM25', - 'O3_Prod','O3_Loss','O3S_Loss','RO2_NO_sum','O3_alkenes','RO2_NO3_sum','RO2_HO2_sum','RO2_RO2_sum','RCO2_NO2_sum', - 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', - 'Ox_Prod','Ox_Loss' + 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', + 'BTTGWSPEC', 'BTTGWSDF', 'BTTGWSKE', 'CONCLD', 'CME', 'CMFMC', 'CMFMC_DP', + 'CH3CCL3_CHML', 'CH4_CHML', 'CO2_CHML', 'CO_CHML', 'IVOC_CHML', 'N2O_CHML', 'O3_CHML', 'SO2_CHML', + 'CO_CHMP', 'O3_CHMP', 'SO2_CHMP', 'TMDMS', 'TMOCS', 'TMSO2','TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'soa1_a1_CHML', 'soa1_a2_CHML', 'soa2_a1_CHML', 'soa2_a2_CHML', 'soa3_a1_CHML', 'soa3_a2_CHML', + 'soa4_a1_CHML', 'soa4_a2_CHML', 'soa5_a1_CHML', 'soa5_a2_CHML', 'SVOC_CHML', + 'so4_a1_CHMP','so4_a2_CHMP', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'TOTH', 'TOT_CLD_VISTAU', + 'TREFHTMN', 'TREFHTMX', 'TROP_P', 'TROP_T', 'TROP_Z', 'TTEND_TOT', 'TTGWORO', 'TTGWSDF', 'TTGWSDFORO', 'TTGWSKE', 'TTGWSKEORO', + 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', + 'ABSORB', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODdn_aitken', 'AODdn_accum', 'AODdn_coarse', + 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', + 'AODVISdn', 'AODVISstdn', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'FLDSC', 'FLNR', 'FSNR', + 'SOLLD', 'SOLSD', 'SSAVIS', 'SST','TAQ', + 'DCOCHM','DH2O2CHM', 'DHNO3CHM', 'DO3CHM', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', + 'FLASHFRQ', 'LNO_COL_PROD', 'LNO_PROD','KVH_CLUBB','MASS', 'PDELDRY', 'NITROP_PD','PM25', 'PRECT', 'PTEQ', 'PTTEND', + 'QRLC', 'QRSC', 'QSNOW', 'QRAIN','GS_SO2', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS','H2SO4M_C', 'H2SO4_sfnnuc1','HCL_GAS', + 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP' 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RHREFHT', + 'EVAPPREC', 'EVAPQZM', 'EVAPTZM', 'FCTL','FREQZM', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU','VEL_NAT2', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', 'dst_c3DDF', + 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'num_c1DDF','num_c2DDF','num_c3DDF','num_c4DDF', + 'so4_a1_sfgaex1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_a2_sfgaex1', 'so4_c2AQH2SO4', 'so4_c2AQSO4', 'so4_c2DDF', + 'so4_a3_sfgaex1', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_a2_sfnnuc1', 'num_a2_sfnnuc1', + 'soa1_a1_sfgaex1','soa1_c1DDF', 'soa1_a2_sfgaex1','soa1_c2DDF', 'soa2_a1_sfgaex1','soa2_c1DDF', 'soa2_a2_sfgaex1','soa2_c2DDF', + 'soa3_a1_sfgaex1','soa3_c1DDF', 'soa3_a2_sfgaex1','soa3_c2DDF', 'soa4_a1_sfgaex1','soa4_c1DDF', 'soa4_a2_sfgaex1','soa4_c2DDF', + 'soa5_a1_sfgaex1','soa5_c1DDF', 'soa5_a2_sfgaex1','soa5_c2DDF', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', + 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_het10', 'r_het11', 'r_het12', 'r_het13', + 'r_het15', 'r_het16', 'r_het17', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', + 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_GLYOXAL_aer', 'r_HO2_O3', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', 'r_OH_O3', 'r_OH_O', + 'O3_Prod','O3_Loss','O3S_Loss','RO2_NO_sum','O3_alkenes','RO2_NO3_sum','RO2_HO2_sum','RO2_RO2_sum','RCO2_NO2_sum', + 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', 'Ox_Prod','Ox_Loss' diff --git a/bld/namelist_files/use_cases/hist_trop_strat_vbsext_cam6.xml b/bld/namelist_files/use_cases/hist_trop_strat_vbsext_cam6.xml index 8d8ff90bf9..1605081d6d 100644 --- a/bld/namelist_files/use_cases/hist_trop_strat_vbsext_cam6.xml +++ b/bld/namelist_files/use_cases/hist_trop_strat_vbsext_cam6.xml @@ -26,8 +26,6 @@ INTERP_MISSING_MONTHS -'noy', 'nhx' - 1,30,365,240,240,480,365,73,30 @@ -44,9 +42,9 @@ .false. .false. - + - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'O3S', + 'CFC11STAR', 'AODDUST', 'AODDUST02', 'T', 'U', 'V', 'O3', 'OH', 'O3S', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', @@ -81,18 +79,18 @@ 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', - 'AODNIRstdn', 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdn_aitken', 'AODVISstdn', + 'AODNIRstdn', 'AODUVstdn', 'AODdn_accum', 'AODdn_coarse', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', - 'WD_NOA', 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', + 'WD_NOA', 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAGbb0', 'WD_SOAGbb1', 'WD_SOAGbb2', 'WD_SOAGbb3', 'WD_SOAGbb4', 'WD_SOAGbg0', 'WD_SOAGbg1', 'WD_SOAGbg2', 'WD_SOAGbg3', 'WD_SOAGbg4', 'WD_SOAGff0', 'WD_SOAGff1', 'WD_SOAGff2', 'WD_SOAGff3', 'WD_SOAGff4', 'WD_SVOCbb','WD_SVOCff', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', - 'DF_CO', 'DF_GLYALD', + 'DF_CO', 'DF_GLYALD', 'dry_deposition_NHx_as_N', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', - 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', + 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAGbb0', 'DF_SOAGbb1', 'DF_SOAGbb2', 'DF_SOAGbb3', 'DF_SOAGbb4', 'DF_SOAGbg0', 'DF_SOAGbg1', 'DF_SOAGbg2', 'DF_SOAGbg3', 'DF_SOAGbg4', 'DF_SOAGff0', 'DF_SOAGff1', 'DF_SOAGff2', 'DF_SOAGff3', 'DF_SOAGff4', 'DF_SVOCbb','DF_SVOCff', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', diff --git a/bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml b/bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml index 0fbe223cac..51e3538f47 100644 --- a/bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml +++ b/bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml @@ -24,21 +24,49 @@ - 'bc_a4 = BC','pom_a4 = 1.4*OC', 'SO2 = 0.975*SO2', 'so4_a1 = 0.025*SO2', 'NO = NO', 'CO = CO', 'BIGALK = BIGALK', 'BIGENE = BIGENE', - 'TOLUENE = TOLUENE','XYLENES = XYLENE','BENZENE = BENZENE','C2H2 = C2H2', 'C2H4 = C2H4', 'C2H6 = C2H6', 'C3H6 = C3H6', 'C3H8 = C3H8', 'CH3COCHO = CH3COCHO', - 'GLYALD = GLYALD','CH3COCH3 = CH3COCH3', 'CH2O = CH2O', 'CH3CHO = CH3CHO','HCOOH = HCOOH', 'CH3COOH = CH3COOH', 'CH3OH = CH3OH', - 'C2H5OH = C2H5OH', 'HCN = HCN', 'CH3CN = CH3CN', 'MEK = MEK', 'MTERP = C10H16','ISOP = ISOP','NH3 = NH3','SVOC = 0.03251613*OC', 'DMS = DMS', - 'IVOC = 0.033*C2H4 + 0.035*C2H6 + 0.049*C3H6 + 0.052*C3H8 + 0.066*BIGENE + 0.068*BIGALK + 0.068*CH3COCH3 + 0.085*MEK + 0.052*CH3CHO + 0.035*CH2O + 0.108*TOLUENE + 0.092*BENZENE + 0.125*XYLENE' + 'bc_a4 = bc_a4', + 'pom_a4 = pom_a4', + 'num_a4 = num_a4_bc + num_a4_pom', + 'so4_a1 = so4_a1', + 'num_a1 = num_a1_so4', + 'SO2 = SO2x0.975', + 'NO = NO', + 'CO = CO', + 'BIGALK = BIGALK', + 'BIGENE = BIGENE', + 'TOLUENE = TOLUENE', + 'XYLENES = XYLENE', + 'BENZENE = BENZENE', + 'C2H2 = C2H2', + 'C2H4 = C2H4', + 'C2H6 = C2H6', + 'C3H6 = C3H6', + 'C3H8 = C3H8', + 'CH3COCHO = CH3COCHO', + 'GLYALD = GLYALD', + 'CH3COCH3 = CH3COCH3', + 'CH2O = CH2O', + 'CH3CHO = CH3CHO', + 'HCOOH = HCOOH', + 'CH3COOH = CH3COOH', + 'CH3OH = CH3OH', + 'C2H5OH = C2H5OH', + 'HCN = HCN', + 'CH3CN = CH3CN', + 'MEK = MEK', + 'MTERP = C10H16', + 'ISOP = ISOP', + 'NH3 = NH3', 'DMS = DMS', + 'SVOC = 0.03251613*OC', + 'IVOC = 0.033*C2H4 + 0.035*C2H6 + 0.049*C3H6 + 0.052*C3H8 + 0.066*BIGENE + 0.068*BIGALK + 0.068*CH3COCH3 + 0.085*MEK + 0.052*CH3CHO + 0.035*CH2O + 0.108*TOLUENE + 0.092*BENZENE + 0.125*XYLENE' .false. -lnd/clm2/firedata/fire_emission_factors_78PFTs_c180912.nc +lnd/clm2/firedata/fire_emission_factors_78PFTs_c20240624.nc INTERP_MISSING_MONTHS INTERP_MISSING_MONTHS -'noy', 'nhx' - 1,30,365,240,240,480,365,73,30 @@ -48,113 +76,92 @@ .true. .false. .false. -.false. +.true. .false. .false. .false. .false. .false. - + - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', - 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', - 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', - 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', - 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3OH', 'CH4', - 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', 'MTERP', 'N2O', 'O3', 'O3S', - 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', 'BCARY', 'BENZENE', 'BENZOOH', - 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALK', 'BIGENE', 'BR', - 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', 'C2H2', 'C2H4', 'C2H5OH', - 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7OOH', 'C3H8', 'C6H5OOH', 'CCL4', 'CF2CLBR', 'CF3BR', - 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', - 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', 'CH3COOOH', 'CH3OH', 'CH3OOH', - 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLONO2', 'CLY', 'CO', - 'CO2', 'COF2', 'COFCL', 'CRESOL', 'DMS', 'EOOH', 'F', 'GLYALD', 'GLYOXAL', - 'H', 'H2', 'H2402', 'H2O2', 'H2SO4', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', - 'HCL', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HO2NO2', 'HOBR', 'HOCL', 'HONITR', - 'HPALD', 'HYAC', 'HYDRALD', 'IEPOX', 'ISOP', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', 'ISOPNOOH', - 'ISOPOOH', 'IVOC', 'MACR', 'MACROOH', 'MEK', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', - 'N', 'N2O', 'N2O5', 'NC4CH2OH', 'NC4CHO', 'NH3', 'NH4', 'NO', - 'NO2', 'NO3', 'NOA', 'NTERPOOH', 'O', 'OCLO', - 'OCS', 'ONITR', 'PAN', 'PBZNIT', 'PHENO', 'PHENOL', 'PHENOOH', 'POOH', 'ROOH', - 'S', 'SF6', 'SO', 'SO2', 'SO3', 'SOAG0', 'SOAG1', 'SOAG2', 'SOAG3', - 'SOAG4', 'SVOC', 'TEPOMUC', 'TERP2OOH', 'TERPNIT', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TOLOOH', - 'TOLUENE', 'XOOH', 'XYLENES', 'XYLENOOH', 'XYLOL', 'XYLOLOOH', 'NHDEP', 'NDEP', 'ACBZO2', - 'ALKO2', 'BENZO2', 'BZOO', 'C2H5O2', 'C3H7O2', 'C6H5O2', 'CH3CO3', 'CH3O2', 'DICARBO2', - 'ENEO2', 'EO', 'EO2', 'HO2', 'HOCH2OO', 'ISOPAO2', 'ISOPBO2', 'MACRO2', - 'MALO2', 'MCO3', 'MDIALO2', 'MEKO2', 'NTERPO2', - 'O1D', 'OH', 'PHENO2', 'PO2', 'RO2', - 'TERP2O2', 'TERPO2', 'TOLO2', 'XO2', 'XYLENO2', 'XYLOLO2', 'H2O', 'SAD_ICE', 'SAD_LNAT', - 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', - 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', - 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', - 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', - 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', - 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', - 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', - 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', - 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', - 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', - 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', - 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', - 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', - 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', - 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', - 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', - 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', - 'dry_deposition_NHx_as_N', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', - 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', - 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', - 'DF_XYLENOOH', 'DF_XYLOLOOH', 'dry_deposition_NOy_as_N', 'SO2_CLXF', 'SO2_XFRC', 'SVOC_CLXF', 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', - 'LNO_COL_PROD', 'SFISOP', 'SFMTERP', 'SFBCARY', 'SFCH3OH', 'SFC2H5OH', 'SFCH3CHO', 'SFMEK', 'SFHCN', - 'SFCH3CN', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFC2H4', 'SFC3H6', 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', - 'SFBENZENE', 'SFTOLUENE', 'SFXYLENES', 'SFCO', 'SFNO', 'SFC2H2', 'SFHCOOH', 'SFCH3COOH', 'SFCH3COCH3', - 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', 'SFIVOC', 'SFSVOC', 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', - 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', - 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', - 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', - 'CO2_CHML', 'AQ_SO2', 'GS_SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', - 'SOAG3_CHMP', 'SOAG4_CHMP', 'IVOC_CHMP', 'SVOC_CHML', 'MASS', 'ABSORB', 'WD_H2SO4', 'WD_IVOC', 'WD_SO2', - 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'DF_CO', 'DF_IVOC', 'DF_O3', - 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', - 'SFISOP', 'SFMTERP', 'SFCH3OH', 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', - 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', - 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', - 'r_HO2_O3', 'r_OH_O3', 'r_OH_O', 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', - 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', - 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', - 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', - 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', - 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', - 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', - 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', - 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', - 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', - 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', - 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', - 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', - 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', - 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', - 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', - 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', - 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', - 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', - 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', - 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', - 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', 'so4_a2_sfnnuc1', - 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', - 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'soa1_a1_CHML', 'soa2_a1_CHML', 'soa3_a1_CHML', 'soa4_a1_CHML', 'soa5_a1_CHML', 'soa1_a2_CHML', - 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', 'so4_a3_CHMP', 'soa1_a1_CHMP', 'soa2_a1_CHMP', - 'soa3_a1_CHMP', 'soa4_a1_CHMP', 'soa5_a1_CHMP', 'soa1_a2_CHMP', 'soa2_a2_CHMP', 'soa3_a2_CHMP', 'soa4_a2_CHMP', 'soa5_a2_CHMP', 'r_jsoa1_a1', - 'r_jsoa2_a1', 'r_jsoa3_a1', 'r_jsoa4_a1', 'r_jsoa5_a1', 'r_jsoa1_a2', 'r_jsoa2_a2', 'r_jsoa3_a2', 'r_jsoa4_a2', 'r_jsoa5_a2', - 'r_GLYOXAL_aer', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', 'TMOCS', 'TMSO2', 'TMDMS', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', - 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BURDENSEASALTdn','BURDENBCdn', 'PM25', - 'O3_Prod','O3_Loss','O3S_Loss','RO2_NO_sum','O3_alkenes','RO2_NO3_sum','RO2_HO2_sum','RO2_RO2_sum','RCO2_NO2_sum', - 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', - 'Ox_Prod','Ox_Loss' + 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', + 'BTTGWSPEC', 'BTTGWSDF', 'BTTGWSKE', 'CONCLD', 'CME', 'CMFDQ', 'CMFMC', 'CMFMC_DP', + 'CH3CCL3_CHML', 'CH4_CHML', 'CO2_CHML', 'CO_CHML', 'IVOC_CHML', 'N2O_CHML', 'O3_CHML', 'SO2_CHML', + 'CO_CHMP', 'O3_CHMP', 'SO2_CHMP', 'TMDMS', 'TMOCS', 'TMSO2','TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'soa1_a1_CHML', 'soa1_a2_CHML', 'soa2_a1_CHML', 'soa2_a2_CHML', 'soa3_a1_CHML', 'soa3_a2_CHML', + 'soa4_a1_CHML', 'soa4_a2_CHML', 'soa5_a1_CHML', 'soa5_a2_CHML', 'SVOC_CHML', + 'so4_a1_CHMP','so4_a2_CHMP', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'TOTH', 'TOT_CLD_VISTAU', + 'TREFHTMN', 'TREFHTMX', 'TROP_P', 'TROP_T', 'TROP_Z', 'TTEND_TOT', 'TTGWORO', 'TTGWSDF', 'TTGWSDFORO', 'TTGWSKE', 'TTGWSKEORO', + 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', + 'ABSORB', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODdn_aitken', 'AODdn_accum', 'AODdn_coarse', + 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', + 'AODVISdn', 'AODVISstdn', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'FLDSC', 'FLNR', 'FSNR', + 'CME', 'CMFDQ', 'CMFMC','CMFMC_DP', 'SOLLD', 'SOLSD', 'SSAVIS', 'SST','TAQ', + 'DCOCHM','DH2O2CHM', 'DHNO3CHM', 'DO3CHM', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', + 'FLASHFRQ', 'LNO_COL_PROD', 'LNO_PROD','KVH_CLUBB','MASS', 'PDELDRY', 'NITROP_PD','PM25', 'PRECT', 'PTEQ', 'PTTEND', + 'QRLC', 'QRSC', 'QSNOW', 'QRAIN','GS_SO2', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS','H2SO4M_C', 'H2SO4_sfnnuc1','HCL_GAS', + 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP' 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RHREFHT', + 'EVAPPREC', 'EVAPQZM', 'EVAPTZM', 'FCTL','FREQZM', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU','VEL_NAT2', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', 'dst_c3DDF', + 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'num_c1DDF','num_c2DDF','num_c3DDF','num_c4DDF', + 'so4_a1_sfgaex1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_a2_sfgaex1', 'so4_c2AQH2SO4', 'so4_c2AQSO4', 'so4_c2DDF', + 'so4_a3_sfgaex1', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_a2_sfnnuc1', 'num_a2_sfnnuc1', + 'soa1_a1_sfgaex1','soa1_c1DDF', 'soa1_a2_sfgaex1','soa1_c2DDF', 'soa2_a1_sfgaex1','soa2_c1DDF', 'soa2_a2_sfgaex1','soa2_c2DDF', + 'soa3_a1_sfgaex1','soa3_c1DDF', 'soa3_a2_sfgaex1','soa3_c2DDF', 'soa4_a1_sfgaex1','soa4_c1DDF', 'soa4_a2_sfgaex1','soa4_c2DDF', + 'soa5_a1_sfgaex1','soa5_c1DDF', 'soa5_a2_sfgaex1','soa5_c2DDF', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', + 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_het10', 'r_het11', 'r_het12', 'r_het13', + 'r_het15', 'r_het16', 'r_het17', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', + 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_GLYOXAL_aer', 'r_HO2_O3', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', 'r_OH_O3', 'r_OH_O', + 'O3_Prod','O3_Loss','O3S_Loss','RO2_NO_sum','O3_alkenes','RO2_NO3_sum','RO2_HO2_sum','RO2_RO2_sum','RCO2_NO2_sum', + 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', 'Ox_Prod','Ox_Loss' + + 'BENZENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BENZENE_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'BIGALK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BIGALK_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'BIGENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_BIGENE_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'C2H2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H2_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'C2H4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H4_other_surface_1750-2015_0.9x1.25_c20170322.nc', + 'C2H5OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H5OH_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H6_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'C2H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C2H6_other_surface_1750-2015_0.9x1.25_c20170322.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H6_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'C3H6 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H6_other_surface_1750-2015_0.9x1.25_c20170322.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H8_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'C3H8 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_C3H8_other_surface_1750-2015_0.9x1.25_c20170322.nc', + 'CH2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH2O_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'CH3CHO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3CHO_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'CH3CN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3CN_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'CH3COCH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3COCH3_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'CH3COOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3COOH_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'CH3OH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CH3OH_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CO_anthro_surface_1750-2015_0.9x1.25_c20180504.nc', + 'CO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_CO_other_surface_1750-2015_0.9x1.25_c20170322.nc', + 'E90 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions_E90global_surface_1750-2100_0.9x1.25_c20170322.nc', + 'HCN -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_HCN_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'HCOOH -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_HCOOH_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'IVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_IVOC_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'MEK -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_MEK_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NH3_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'NH3 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NH3_other_surface_1750-2015_0.9x1.25_c20170322.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NO_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'NO -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_NO_other_surface_1750-2015_0.9x1.25_c20170322.nc', + 'SVOC -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SVOC_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'TOLUENE -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_TOLUENE_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'XYLENES -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_XYLENES_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_bc_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_1750-2015_0.9x1.25_c20170616.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a2_anthro-res_surface_1750-2015_0.9x1.25_c20170616.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_bc_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_pom_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_pom_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_anthro-ag-ship-res_surface_1750-2015_0.9x1.25_c20170616.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_anthro-ene_surface_1750-2015_0.9x1.25_c20170616.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_anthro-ag-ship_surface_1750-2015_0.9x1.25_c20170616.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_anthro-res_surface_1750-2015_0.9x1.25_c20170616.nc' + + + diff --git a/bld/namelist_files/use_cases/scam_arm95.xml b/bld/namelist_files/use_cases/scam_arm95.xml deleted file mode 100644 index bf9ebc7391..0000000000 --- a/bld/namelist_files/use_cases/scam_arm95.xml +++ /dev/null @@ -1,22 +0,0 @@ - - - - - -368.9e-6 - -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/ARM95_4scam.nc - 36.6 - 262.5 - 19950718 - 19800 - 1259 - 1500 - 1 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_arm97.xml b/bld/namelist_files/use_cases/scam_arm97.xml deleted file mode 100644 index 7508853f08..0000000000 --- a/bld/namelist_files/use_cases/scam_arm97.xml +++ /dev/null @@ -1,22 +0,0 @@ - - - - - -368.9e-6 - -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/ARM97_4scam.nc - 36.6 - 262.5 - 19970618 - 84585 - 2088 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_gateIII.xml b/bld/namelist_files/use_cases/scam_gateIII.xml deleted file mode 100644 index c5c822d5e3..0000000000 --- a/bld/namelist_files/use_cases/scam_gateIII.xml +++ /dev/null @@ -1,20 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/GATEIII_4scam.nc - 9.00 - 336.0 - 19740830 - 0 - 1440 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_mpace.xml b/bld/namelist_files/use_cases/scam_mpace.xml deleted file mode 100644 index a559a8489e..0000000000 --- a/bld/namelist_files/use_cases/scam_mpace.xml +++ /dev/null @@ -1,30 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-09-01_64x128_L30_c031210.nc -atm/cam/scam/iop/MPACE_4scam.nc - 70.5 - 206.0 - 20041005 - 7171 - 1242 - 1500 - 9 - nsteps - 'CLDST', 'CNVCLD', - 'ICWMR','ICIMR','FREQL','FREQI','LANDFRAC','CDNUMC','FICE','WSUB','CCN3','ICLDIWP', - 'CDNUMC', 'AQSNOW', 'WSUB', 'CCN3', 'FREQI', 'FREQL', 'FREQR', 'FREQS', 'CLDLIQ', 'CLDICE', - 'FSDS', 'FLDS','AREL','AREI','NSNOW','QSNOW','DSNOW', - 'FLNT','FLNTC','FSNT','FSNTC','FSNS','FSNSC','FLNT','FLNTC','QRS','QRSC','QRL','QRLC', - 'LWCF','SWCF', 'NCAI', 'NCAL', 'NIHF','NIDEP','NIIMM','NIMEY','ICLDIWP','ICLDTWP', 'CONCLD', - 'QCSEVAP', 'QISEVAP', 'QVRES', 'CMELIQ', 'CMEIOUT', 'EVAPPREC', 'EVAPSNOW', 'TAQ', - 'ICLMRCU', 'ICIMRCU' ,'ICWMRSH' ,'ICWMRDP', 'ICLMRTOT' , 'ICIMRTOT' , 'SH_CLD' , 'DP_CLD', - 'LIQCLDF','ICECLDF', 'ICWMRST', 'ICIMRST', 'EFFLIQ', 'EFFICE','ADRAIN','ADSNOW','WSUBI', - 'TGCLDLWP','GCLDLWP' - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_sparticus.xml b/bld/namelist_files/use_cases/scam_sparticus.xml deleted file mode 100644 index 105994b36b..0000000000 --- a/bld/namelist_files/use_cases/scam_sparticus.xml +++ /dev/null @@ -1,20 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc -atm/cam/scam/iop/SPARTICUS_4scam.nc - 36.6 - 262.51 - 20100401 - 3599 - 2156 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_togaII.xml b/bld/namelist_files/use_cases/scam_togaII.xml deleted file mode 100644 index 9b2706382b..0000000000 --- a/bld/namelist_files/use_cases/scam_togaII.xml +++ /dev/null @@ -1,20 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc -atm/cam/scam/iop/TOGAII_4scam.nc - -2.10 - 154.69 - 19921218 - 64800 - 1512 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/scam_twp06.xml b/bld/namelist_files/use_cases/scam_twp06.xml deleted file mode 100644 index e599a45b16..0000000000 --- a/bld/namelist_files/use_cases/scam_twp06.xml +++ /dev/null @@ -1,20 +0,0 @@ - - - - - -atm/cam/inic/gaus/cami_0000-01-01_64x128_L30_c090102.nc -atm/cam/scam/iop/TWP06_4scam.nc - -12.43 - 130.89 - 20060117 - 10800 - 1926 - 1500 - 9 - nsteps - - -2000 - - diff --git a/bld/namelist_files/use_cases/sd_cam6.xml b/bld/namelist_files/use_cases/sd_cam6.xml index 146268c62b..2e81857089 100644 --- a/bld/namelist_files/use_cases/sd_cam6.xml +++ b/bld/namelist_files/use_cases/sd_cam6.xml @@ -28,7 +28,7 @@ 'SERIAL' 'atm/cam/ozone_strataero' - 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc' + 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc' .true. 'CHEM_LBC_FILE' @@ -36,4 +36,6 @@ 'SERIAL' 'CO2','CH4','N2O','CFC11eq','CFC12' + 1850-2015 + diff --git a/bld/namelist_files/use_cases/sd_trop_strat2_cam6.xml b/bld/namelist_files/use_cases/sd_trop_strat2_cam6.xml index 8ef3f6903d..4d32182f8a 100644 --- a/bld/namelist_files/use_cases/sd_trop_strat2_cam6.xml +++ b/bld/namelist_files/use_cases/sd_trop_strat2_cam6.xml @@ -31,8 +31,6 @@ INTERP_MISSING_MONTHS -'noy', 'nhx' - 1, 1 @@ -49,9 +47,9 @@ .false. .false. - + - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', + 'CFC11STAR', 'AODDUST', 'AODDUST02', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', @@ -85,8 +83,8 @@ 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', - 'AODNIRstdn', 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', + 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdn_aitken', 'AODVISstdn', + 'AODNIRstdn', 'AODUVstdn', 'AODdn_accum', 'AODdn_coarse', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', @@ -161,46 +159,46 @@ 'DF_BIGALD4', 'DF_BIGALK', 'DF_BIGENE', 'DF_BZALD', 'DF_C2H2', 'DF_C2H4', 'DF_C2H6', 'DF_C3H6', 'DF_C3H8', 'DF_CRESOL', 'DF_DMS', 'DF_GLYOXAL', 'DF_ISOP', 'DF_MACR', 'DF_MEK', 'DF_MVK', 'DF_N2O5', 'DF_PBZNIT', 'DF_PHENOL', 'DF_TEPOMUC', 'DF_TOLUENE', 'DF_XYLENES', 'DF_XYLOL', - 'WD_BCARY', 'WD_BENZENE', 'WD_BEPOMUC', 'WD_BIGALD1', 'WD_BIGALD2', 'WD_BIGALD3', 'WD_BIGALD4', + 'WD_BCARY', 'WD_BENZENE', 'WD_BEPOMUC', 'WD_BIGALD1', 'WD_BIGALD2', 'WD_BIGALD3', 'WD_BIGALD4', 'WD_BIGALK', 'WD_BIGENE', 'WD_BZALD', - 'WD_C2H2', 'WD_C2H4', 'WD_C2H6', 'WD_C3H6', 'WD_C3H8', 'WD_CO', 'WD_CRESOL', 'WD_DMS', 'WD_GLYOXAL', 'WD_ISOP', + 'WD_C2H2', 'WD_C2H4', 'WD_C2H6', 'WD_C3H6', 'WD_C3H8', 'WD_CO', 'WD_CRESOL', 'WD_DMS', 'WD_GLYOXAL', 'WD_ISOP', 'WD_MEK', 'WD_MPAN', 'WD_N2O5', 'WD_NO', 'WD_NO2', 'WD_PAN', 'WD_PBZNIT', 'WD_PHENOL', 'WD_TEPOMUC','WD_TOLUENE', 'WD_XYLENES', 'WD_XYLOL' 'MEG_APIN','MEG_BPIN','MEG_LIMON','MEG_MYRC', - 'ISOPFDN', 'ISOPFNP', 'ISOPN3B', 'ISOPN2B', 'ISOPN1D', 'ISOPN4D', + 'ISOPFDN', 'ISOPFNP', 'ISOPN3B', 'ISOPN2B', 'ISOPN1D', 'ISOPN4D', 'ISOPNBNO3', 'ISOPNOOHB', 'ISOPNOOHD', 'INHEB','INHED', 'HPALD1','HPALD4','ISOPHFP', - 'MVKN', 'MACRN', 'HMHP', 'NO3CH2CHO', 'HYPERACET', 'HCOCH2OOH', + 'MVKN', 'MACRN', 'HMHP', 'NO3CH2CHO', 'HYPERACET', 'HCOCH2OOH', 'DHPMPAL', 'MVKOOH', 'ISOPOH', 'HPALDB1C','HPALDB4C','ICHE','ISOPFDNC','ISOPFNC', - 'TERPNT', 'TERPNS','TERPNT1', 'TERPNS1', 'TERPNPT', 'TERPNPS', 'TERPNPT1', + 'TERPNT', 'TERPNS','TERPNT1', 'TERPNS1', 'TERPNPT', 'TERPNPS', 'TERPNPT1', 'TERPNPS1', 'TERPFDN', 'SQTN', 'TERPHFN', - 'TERP1OOH', 'TERPDHDP', 'TERPF2', 'TERPF1', 'TERPA', 'TERPA2', 'TERPK', 'TERPAPAN', + 'TERP1OOH', 'TERPDHDP', 'TERPF2', 'TERPF1', 'TERPA', 'TERPA2', 'TERPK', 'TERPAPAN', 'TERPACID', 'TERPA2PAN', 'TERPACID2','TERPACID3','TERPA3PAN','TERPOOHL','TERPA3', 'APIN','BPIN','LIMON','MYRC', 'DF_ISOPFDN', 'DF_ISOPFNP', 'DF_ISOPN3B', 'DF_ISOPN2B', 'DF_ISOPN1D', 'DF_ISOPN4D', 'DF_ISOPNBNO3', 'DF_ISOPNOOHB', 'DF_ISOPNOOHD', - 'DF_INHEB','DF_INHED', + 'DF_INHEB','DF_INHED', 'DF_HPALD1','DF_HPALD4','DF_ISOPHFP','DF_MVKN', 'DF_MACRN', 'DF_HMHP' 'DF_NO3CH2CHO', 'DF_HYPERACET', 'DF_HCOCH2OOH', 'DF_DHPMPAL', 'DF_MVKOOH', 'DF_ISOPOH', 'DF_HPALDB1C','DF_HPALDB4C','DF_ICHE','DF_ISOPFDNC','DF_ISOPFNC', - 'DF_TERPNT', 'DF_TERPNS','DF_TERPNT1', 'DF_TERPNS1', 'DF_TERPNPT', 'DF_TERPNPS', + 'DF_TERPNT', 'DF_TERPNS','DF_TERPNT1', 'DF_TERPNS1', 'DF_TERPNPT', 'DF_TERPNPS', 'DF_TERPNPT1', 'DF_TERPNPS1', 'DF_TERPFDN', 'DF_SQTN', 'DF_TERPHFN', - 'DF_TERP1OOH', 'DF_TERPDHDP', 'DF_TERPF2', 'DF_TERPF1', 'DF_TERPA', - 'DF_TERPA2', 'DF_TERPK', 'DF_TERPAPAN', 'DF_TERPACID', 'DF_TERPA2PAN', + 'DF_TERP1OOH', 'DF_TERPDHDP', 'DF_TERPF2', 'DF_TERPF1', 'DF_TERPA', + 'DF_TERPA2', 'DF_TERPK', 'DF_TERPAPAN', 'DF_TERPACID', 'DF_TERPA2PAN', 'DF_TERPACID2','DF_TERPACID3','DF_TERPA3PAN','DF_TERPOOHL','DF_TERPA3', 'DF_APIN','DF_BPIN','DF_LIMON','DF_MYRC', - 'WD_ISOPFDN', 'WD_ISOPFNP', 'WD_ISOPN3B', 'WD_ISOPN2B', 'WD_ISOPN1D', 'WD_ISOPN4D', + 'WD_ISOPFDN', 'WD_ISOPFNP', 'WD_ISOPN3B', 'WD_ISOPN2B', 'WD_ISOPN1D', 'WD_ISOPN4D', 'WD_ISOPNBNO3', 'WD_ISOPNOOHB', 'WD_ISOPNOOHD', - 'WD_INHEB','WD_INHED', + 'WD_INHEB','WD_INHED', 'WD_HPALD1','WD_HPALD4','WD_ISOPHFP','WD_MVKN', 'WD_MACRN', 'WD_HMHP' 'WD_NO3CH2CHO', 'WD_HYPERACET', 'WD_HCOCH2OOH', 'WD_DHPMPAL', 'WD_MVKOOH', 'WD_ISOPOH', 'WD_HPALDB1C','WD_HPALDB4C','WD_ICHE','WD_ISOPFDNC','WD_ISOPFNC', - 'WD_TERPNT', 'WD_TERPNS','WD_TERPNT1', 'WD_TERPNS1', 'WD_TERPNPT', 'WD_TERPNPS', + 'WD_TERPNT', 'WD_TERPNS','WD_TERPNT1', 'WD_TERPNS1', 'WD_TERPNPT', 'WD_TERPNPS', 'WD_TERPNPT1', 'WD_TERPNPS1', 'WD_TERPFDN', 'WD_SQTN', 'WD_TERPHFN', - 'WD_TERP1OOH', 'WD_TERPDHDP', 'WD_TERPF2', 'WD_TERPF1', 'WD_TERPA', + 'WD_TERP1OOH', 'WD_TERPDHDP', 'WD_TERPF2', 'WD_TERPF1', 'WD_TERPA', 'WD_TERPA2', 'WD_TERPK', 'WD_TERPAPAN','WD_TERPACID','WD_TERPA2PAN', 'WD_TERPACID2','WD_TERPACID3','WD_TERPA3PAN','WD_TERPOOHL','WD_TERPA3', 'WD_APIN','WD_BPIN','WD_LIMON','WD_MYRC' diff --git a/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml b/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml index 10cf37265a..29c41758ca 100644 --- a/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml +++ b/bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml @@ -41,8 +41,6 @@ INTERP_MISSING_MONTHS -'noy', 'nhx' - 1,30,365,240,240,480,365,73,30 @@ -52,113 +50,45 @@ .true. .false. .false. -.false. +.true. .false. .false. .false. .false. .false. - + - 'CFC11STAR', 'AODDUST', 'AODDUST2', 'T', 'U', 'V', 'O3', 'OH', 'NO3', 'HO2', - 'LNO_COL_PROD', 'NO2_CLXF', 'SFNO', 'SFNH3', 'BRO', - 'CH3CL', 'CLO', 'CO2', 'HCL', 'HO2', 'HOCL', 'H2O', 'PHIS', 'Z3', - 'BENZENE', 'C2H2', 'C2H4', 'C2H6', 'C3H8', 'CCL4', 'CFC11', 'CFC113', 'CFC12', - 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3OH', 'CH4', - 'CO', 'H2O2', 'HCFC22', 'HCN', 'HNO3', 'ISOP', 'MTERP', 'N2O', 'O3', 'O3S', - 'PAN', 'SO2', 'TOLUENE', 'OH', 'ALKNIT', 'ALKOOH', 'BCARY', 'BENZENE', 'BENZOOH', - 'BEPOMUC', 'BIGALD', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALK', 'BIGENE', 'BR', - 'BRCL', 'BRO', 'BRONO2', 'BRY', 'BZALD', 'BZOOH', 'C2H2', 'C2H4', 'C2H5OH', - 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7OOH', 'C3H8', 'C6H5OOH', 'CCL4', 'CF2CLBR', 'CF3BR', - 'CFC11', 'CFC113', 'CFC114', 'CFC115', 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', - 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', 'CH3COOOH', 'CH3OH', 'CH3OOH', - 'CH4', 'CHBR3', 'CL', 'CL2', 'CL2O2', 'CLO', 'CLONO2', 'CLY', 'CO', - 'CO2', 'COF2', 'COFCL', 'CRESOL', 'DMS', 'EOOH', 'F', 'GLYALD', 'GLYOXAL', - 'H', 'H2', 'H2402', 'H2O2', 'H2SO4', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', - 'HCL', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HO2NO2', 'HOBR', 'HOCL', 'HONITR', - 'HPALD', 'HYAC', 'HYDRALD', 'IEPOX', 'ISOP', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', 'ISOPNOOH', - 'ISOPOOH', 'IVOC', 'MACR', 'MACROOH', 'MEK', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', - 'N', 'N2O', 'N2O5', 'NC4CH2OH', 'NC4CHO', 'NH3', 'NH4', 'NO', - 'NO2', 'NO3', 'NOA', 'NTERPOOH', 'O', 'OCLO', - 'OCS', 'ONITR', 'PAN', 'PBZNIT', 'PHENO', 'PHENOL', 'PHENOOH', 'POOH', 'ROOH', - 'S', 'SF6', 'SO', 'SO2', 'SO3', 'SOAG0', 'SOAG1', 'SOAG2', 'SOAG3', - 'SOAG4', 'SVOC', 'TEPOMUC', 'TERP2OOH', 'TERPNIT', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TOLOOH', - 'TOLUENE', 'XOOH', 'XYLENES', 'XYLENOOH', 'XYLOL', 'XYLOLOOH', 'NHDEP', 'NDEP', 'ACBZO2', - 'ALKO2', 'BENZO2', 'BZOO', 'C2H5O2', 'C3H7O2', 'C6H5O2', 'CH3CO3', 'CH3O2', 'DICARBO2', - 'ENEO2', 'EO', 'EO2', 'HO2', 'HOCH2OO', 'ISOPAO2', 'ISOPBO2', 'MACRO2', - 'MALO2', 'MCO3', 'MDIALO2', 'MEKO2', 'NTERPO2', - 'O1D', 'OH', 'PHENO2', 'PO2', 'RO2', - 'TERP2O2', 'TERPO2', 'TOLO2', 'XO2', 'XYLENO2', 'XYLOLO2', 'H2O', 'SAD_ICE', 'SAD_LNAT', - 'SAD_SULFC', 'SAD_TROP', 'SAD_AERO', 'REFF_AERO', 'PDELDRY', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'H2SO4M_C', - 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'VEL_NAT2', 'NITROP_PD', 'NOX', 'NOY', 'CLOX', 'CLOY', - 'BROX', 'BROY', 'TCLY', 'TOTH', 'MASS', 'TBRY', 'HCL_GAS', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', - 'HCL_GAS', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'ABSORB', 'AODVISdn', 'AODdnMODE1', 'AODVISstdn', 'AODNIRstdn', - 'AODUVstdn', 'AODdnMODE2', 'AODdnMODE3', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODVISstdn', 'AODUVstdn', 'AODNIRstdn', - 'AODNIRstdn', 'AODVISdn', 'AODUVdn', 'EXTINCTdn', 'EXTxASYMdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'WD_ALKNIT', 'WD_ALKOOH', - 'WD_BENZOOH', 'WD_BRONO2', 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', - 'WD_CH3CN', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3COCH3', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', - 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', - 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', - 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', - 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', - 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', - 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', - 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', - 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', - 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', - 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', - 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', - 'dry_deposition_NHx_as_N', 'DF_NH3', 'DF_NH4', 'DF_NO', 'DF_NO2', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', - 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', - 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', - 'DF_XYLENOOH', 'DF_XYLOLOOH', 'dry_deposition_NOy_as_N', 'SO2_CLXF', 'SO2_XFRC', 'SVOC_CLXF', 'CO_CLXF', 'NO2_CLXF', 'LNO_PROD', - 'LNO_COL_PROD', 'SFISOP', 'SFMTERP', 'SFBCARY', 'SFCH3OH', 'SFC2H5OH', 'SFCH3CHO', 'SFMEK', 'SFHCN', - 'SFCH3CN', 'SFCH2O', 'SFC2H6', 'SFC3H8', 'SFC2H4', 'SFC3H6', 'SFCH3COCH3', 'SFBIGALK', 'SFBIGENE', - 'SFBENZENE', 'SFTOLUENE', 'SFXYLENES', 'SFCO', 'SFNO', 'SFC2H2', 'SFHCOOH', 'SFCH3COOH', 'SFCH3COCH3', - 'SFDMS', 'SFMEK', 'SFSO2', 'SFNH3', 'SFIVOC', 'SFSVOC', 'MEG_ISOP', 'MEG_MTERP', 'MEG_BCARY', - 'MEG_CH3OH', 'MEG_C2H5OH', 'MEG_CH2O', 'MEG_CH3CHO', 'MEG_CH3COOH', 'MEG_CH3COCH3', 'MEG_HCOOH', 'MEG_HCN', 'MEG_CO', - 'MEG_C2H6', 'MEG_C2H4', 'MEG_C3H8', 'MEG_C3H6', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_TOLUENE', 'Dso4_a1CHM', 'Dso4_a2CHM', - 'Dso4_a3CHM', 'DO3CHM', 'DCOCHM', 'DHNO3CHM', 'DH2O2CHM', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', - 'CO2_CHML', 'AQ_SO2', 'GS_SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', - 'SOAG3_CHMP', 'SOAG4_CHMP', 'IVOC_CHMP', 'SVOC_CHML', 'MASS', 'ABSORB', 'WD_H2SO4', 'WD_IVOC', 'WD_SO2', - 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'DF_CO', 'DF_IVOC', 'DF_O3', - 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'SO2_CLXF', 'SVOC_CLXF', - 'SFISOP', 'SFMTERP', 'SFCH3OH', 'SFCH3COCH3', 'SFCO', 'SFIVOC', 'SFSVOC', 'DO3CHM', 'DCOCHM', - 'O3_CHMP', 'O3_CHML', 'CH4_CHML', 'CO_CHMP', 'CO_CHML', 'CH3CCL3_CHML', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', - 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', - 'r_HO2_O3', 'r_OH_O3', 'r_OH_O', 'r_O1D_H2O', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', - 'jo3_a', 'jno2', 'jpan', 'jh2o2', 'jcl2o2', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', - 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', - 'so4_a3', 'soa1_a1', 'soa2_a1', 'soa3_a1', 'soa4_a1', 'soa5_a1', 'soa1_a2', 'soa2_a2', 'soa3_a2', - 'soa4_a2', 'soa5_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', - 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa1_c1', 'soa2_c1', - 'soa3_c1', 'soa4_c1', 'soa5_c1', 'soa1_c2', 'soa2_c2', 'soa3_c2', 'soa4_c2', 'soa5_c2', - 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', - 'bc_a1SFWET', 'bc_a4SFWET', 'dst_a1SFWET', 'dst_a2SFWET', 'dst_a3SFWET', 'ncl_a1SFWET', 'ncl_a2SFWET', 'ncl_a3SFWET', 'pom_a1SFWET', 'pom_a4SFWET', - 'so4_a1SFWET', 'so4_a2SFWET', 'so4_a3SFWET', 'soa1_a1SFWET', 'soa1_a2SFWET', 'soa2_a1SFWET', 'soa2_a2SFWET', 'soa3_a1SFWET', 'soa3_a2SFWET', - 'soa4_a1SFWET', 'soa4_a2SFWET', 'soa5_a1SFWET', 'soa5_a2SFWET', 'bc_c1SFWET', 'bc_c4SFWET', 'dst_c1SFWET', 'dst_c2SFWET', 'dst_c3SFWET', - 'ncl_c1SFWET', 'ncl_c2SFWET', 'ncl_c3SFWET', 'pom_c1SFWET', 'pom_c4SFWET', 'so4_c1SFWET', 'so4_c2SFWET', 'so4_c3SFWET', 'soa1_c1SFWET', - 'soa1_c2SFWET', 'soa2_c1SFWET', 'soa2_c2SFWET', 'soa3_c1SFWET', 'soa3_c2SFWET', 'soa4_c1SFWET', 'soa4_c2SFWET', 'soa5_c1SFWET', 'soa5_c2SFWET', - 'bc_a1DDF', 'bc_a4DDF', 'dst_a1DDF', 'dst_a2DDF', 'dst_a3DDF', 'ncl_a1DDF', 'ncl_a2DDF', 'ncl_a3DDF', 'pom_a1DDF', - 'pom_a4DDF', 'so4_a1DDF', 'so4_a2DDF', 'so4_a3DDF', 'soa1_a1DDF', 'soa1_a2DDF', 'soa2_a1DDF', 'soa2_a2DDF', 'soa3_a1DDF', - 'soa3_a2DDF', 'soa4_a1DDF', 'soa4_a2DDF', 'soa5_a1DDF', 'soa5_a2DDF', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', - 'dst_c3DDF', 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'so4_c1DDF', 'so4_c2DDF', 'so4_c3DDF', - 'soa1_c1DDF', 'soa1_c2DDF', 'soa2_c1DDF', 'soa2_c2DDF', 'soa3_c1DDF', 'soa3_c2DDF', 'soa4_c1DDF', 'soa4_c2DDF', 'soa5_c1DDF', - 'soa5_c2DDF', 'num_a1DDF', 'num_a2DDF', 'num_a3DDF', 'num_a4DDF', 'num_c1DDF', 'num_c2DDF', 'num_c3DDF', 'num_c4DDF', - 'bc_a4_CLXF', 'pom_a4_CLXF', 'so4_a1_CLXF', 'so4_a2_CLXF', 'num_a1_CLXF', 'num_a2_CLXF', 'SFbc_a4', 'SFpom_a4', 'SFso4_a1', - 'SFso4_a2', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'so4_a1_sfgaex1', 'so4_a2_sfgaex1', 'so4_a3_sfgaex1', 'soa1_a1_sfgaex1', 'soa1_a2_sfgaex1', - 'soa2_a1_sfgaex1', 'soa2_a2_sfgaex1', 'soa3_a1_sfgaex1', 'soa3_a2_sfgaex1', 'soa4_a1_sfgaex1', 'soa4_a2_sfgaex1', 'soa5_a1_sfgaex1', 'soa5_a2_sfgaex1', 'so4_a2_sfnnuc1', - 'so4_c1AQH2SO4', 'so4_c2AQH2SO4', 'so4_c3AQH2SO4', 'so4_c1AQSO4', 'so4_c2AQSO4', 'so4_c3AQSO4', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', - 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'soa1_a1_CHML', 'soa2_a1_CHML', 'soa3_a1_CHML', 'soa4_a1_CHML', 'soa5_a1_CHML', 'soa1_a2_CHML', - 'soa2_a2_CHML', 'soa3_a2_CHML', 'soa4_a2_CHML', 'soa5_a2_CHML', 'so4_a1_CHMP', 'so4_a2_CHMP', 'so4_a3_CHMP', 'soa1_a1_CHMP', 'soa2_a1_CHMP', - 'soa3_a1_CHMP', 'soa4_a1_CHMP', 'soa5_a1_CHMP', 'soa1_a2_CHMP', 'soa2_a2_CHMP', 'soa3_a2_CHMP', 'soa4_a2_CHMP', 'soa5_a2_CHMP', 'r_jsoa1_a1', - 'r_jsoa2_a1', 'r_jsoa3_a1', 'r_jsoa4_a1', 'r_jsoa5_a1', 'r_jsoa1_a2', 'r_jsoa2_a2', 'r_jsoa3_a2', 'r_jsoa4_a2', 'r_jsoa5_a2', - 'r_GLYOXAL_aer', 'H2SO4_sfnnuc1', 'num_a2_sfnnuc1', 'TMOCS', 'TMSO2', 'TMDMS', 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', - 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BURDENSEASALTdn','BURDENBCdn', 'PM25', - 'O3_Prod','O3_Loss','O3S_Loss','RO2_NO_sum','O3_alkenes','RO2_NO3_sum','RO2_HO2_sum','RO2_RO2_sum','RCO2_NO2_sum', - 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', - 'Ox_Prod','Ox_Loss' + 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', + 'BTTGWSPEC', 'BTTGWSDF', 'BTTGWSKE', 'CONCLD', 'CME', 'CMFDQ', 'CMFMC', 'CMFMC_DP', + 'CH3CCL3_CHML', 'CH4_CHML', 'CO2_CHML', 'CO_CHML', 'IVOC_CHML', 'N2O_CHML', 'O3_CHML', 'SO2_CHML', + 'CO_CHMP', 'O3_CHMP', 'SO2_CHMP', 'TMDMS', 'TMOCS', 'TMSO2','TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'soa1_a1_CHML', 'soa1_a2_CHML', 'soa2_a1_CHML', 'soa2_a2_CHML', 'soa3_a1_CHML', 'soa3_a2_CHML', + 'soa4_a1_CHML', 'soa4_a2_CHML', 'soa5_a1_CHML', 'soa5_a2_CHML', 'SVOC_CHML', + 'so4_a1_CHMP','so4_a2_CHMP', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'TOTH', 'TOT_CLD_VISTAU', + 'TREFHTMN', 'TREFHTMX', 'TROP_P', 'TROP_T', 'TROP_Z', 'TTEND_TOT', 'TTGWORO', 'TTGWSDF', 'TTGWSDFORO', 'TTGWSKE', 'TTGWSKEORO', + 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', + 'ABSORB', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODdn_aitken', 'AODdn_accum', 'AODdn_coarse', + 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', + 'AODVISdn', 'AODVISstdn', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'FLDSC', 'FLNR', 'FSNR', + 'CME', 'CMFDQ', 'CMFMC','CMFMC_DP', 'SOLLD', 'SOLSD', 'SSAVIS', 'SST','TAQ', + 'DCOCHM','DH2O2CHM', 'DHNO3CHM', 'DO3CHM', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', + 'FLASHFRQ', 'LNO_COL_PROD', 'LNO_PROD','KVH_CLUBB','MASS', 'PDELDRY', 'NITROP_PD','PM25', 'PRECT', 'PTEQ', 'PTTEND', + 'QRLC', 'QRSC', 'QSNOW', 'QRAIN','GS_SO2', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS','H2SO4M_C', 'H2SO4_sfnnuc1','HCL_GAS', + 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP' 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RHREFHT', + 'EVAPPREC', 'EVAPQZM', 'EVAPTZM', 'FCTL','FREQZM', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU','VEL_NAT2', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', 'dst_c3DDF', + 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'num_c1DDF','num_c2DDF','num_c3DDF','num_c4DDF', + 'so4_a1_sfgaex1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_a2_sfgaex1', 'so4_c2AQH2SO4', 'so4_c2AQSO4', 'so4_c2DDF', + 'so4_a3_sfgaex1', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_a2_sfnnuc1', 'num_a2_sfnnuc1', + 'soa1_a1_sfgaex1','soa1_c1DDF', 'soa1_a2_sfgaex1','soa1_c2DDF', 'soa2_a1_sfgaex1','soa2_c1DDF', 'soa2_a2_sfgaex1','soa2_c2DDF', + 'soa3_a1_sfgaex1','soa3_c1DDF', 'soa3_a2_sfgaex1','soa3_c2DDF', 'soa4_a1_sfgaex1','soa4_c1DDF', 'soa4_a2_sfgaex1','soa4_c2DDF', + 'soa5_a1_sfgaex1','soa5_c1DDF', 'soa5_a2_sfgaex1','soa5_c2DDF', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', + 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_het10', 'r_het11', 'r_het12', 'r_het13', + 'r_het15', 'r_het16', 'r_het17', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', + 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_GLYOXAL_aer', 'r_HO2_O3', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', 'r_OH_O3', 'r_OH_O', + 'O3_Prod','O3_Loss','O3S_Loss','RO2_NO_sum','O3_alkenes','RO2_NO3_sum','RO2_HO2_sum','RO2_RO2_sum','RCO2_NO2_sum', + 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', 'Ox_Prod','Ox_Loss' diff --git a/bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml b/bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml index 81f995f93a..95b9e204db 100644 --- a/bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml +++ b/bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml @@ -37,11 +37,6 @@ atm/waccm/gcrs gcr_prod_NO_1949-2142_c150309.nc - -.false. -atm/waccm/qbo/qbocoefficients_c151023.nc -.true. - atm/waccm/lb/LBC_1765-2100_1.9x2.5_CCMI_RCP60_za_c130313.nc 'SERIAL' @@ -97,7 +92,7 @@ - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml b/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml index 5994ff2bbf..753c2e0035 100644 --- a/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml +++ b/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml @@ -14,7 +14,9 @@ cesm2_init/f.e21.FWmaSD.f09_f09_mg17.cesm2.1-exp011.1978-2015.001/1980-01-01/f.e21.FWmaSD.f09_f09_mg17.cesm2.1-exp011.1978-2015.001.cam.i.1980-01-01-00000.nc +cesm2_init/f.e21.FWmaSD.f09_f09_mg17.cesm2.1-exp011.1978-2015.001/1980-01-01/f.e21.FWmaSD.f09_f09_mg17.cesm2.1-exp011.1978-2015.001.cam.i.1980-01-01-00000.nc cesm2_init/f.e21.FWmadSD.f09_f09_mg17.cesm2.1-exp011.001/2005-01-01/f.e21.FWmadSD.f09_f09_mg17.cesm2.1-exp011.001.cam.i.2005-01-01-00000.nc +cesm2_init/f.e21.FWmadSD.f09_f09_mg17.cesm2.1-exp011.001/2005-01-01/f.e21.FWmadSD.f09_f09_mg17.cesm2.1-exp011.001.cam.i.2005-01-01-00000.nc atm/waccm/ic/f.e21.FWmaSD.f19_f19_mg17.HETALL.001.cam.i.1980-01-02_c190910.nc 50. @@ -25,9 +27,12 @@ atm/cam/met/MERRA2/1.9x2.5 atm/cam/met/MERRA2/1.9x2.5/filenames_list_c190911.txt 1980/MERRA2_0.9x1.25_19800101.nc +1980/MERRA2_0.9x1.25_19800101.nc 2005/MERRA2_0.9x1.25_20050101.nc +2005/MERRA2_0.9x1.25_20050101.nc atm/cam/met/MERRA2/0.9x1.25 atm/cam/met/MERRA2/0.9x1.25/filenames_1975-2017_c190125.txt + 0.84 atm/cam/met/MERRA2/0.9x1.25/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_MERRA2_c171218.nc @@ -66,7 +71,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', @@ -87,7 +92,7 @@ 'BURDENPOMdn', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', - 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', 'soa_c2', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', 'soa_c2', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'LNO_PROD', 'LNO_COL_PROD', 'dry_deposition_NHx_as_N', 'dry_deposition_NOy_as_N', 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N' diff --git a/bld/namelist_files/use_cases/sd_waccm_sulfur.xml b/bld/namelist_files/use_cases/sd_waccm_sulfur.xml index 91ade80442..d035ea8b79 100644 --- a/bld/namelist_files/use_cases/sd_waccm_sulfur.xml +++ b/bld/namelist_files/use_cases/sd_waccm_sulfur.xml @@ -35,13 +35,8 @@ CYCLICAL 2000 - -.false. -' ' -.false. - -.false. +.false. @@ -53,7 +48,7 @@ atm/cam/chem/2000-2100_RCP45/IPCC_emissions_houw_CH2O_2000-2100_1.9x2.5.nc atm/cam/chem/2000-2100_RCP45/IPCC_emissions_houw_CO_2000-2100_1.9x2.5.nc atm/cam/chem/2000-2100_RCP45/IPCC_emissions_houw_NOx_2000-2100_1.9x2.5.nc -atm/cam/chem/2000-2100_RCP45/IPCC_emissions_houw_SO2_2000-2100_1.9x2.5.nc +atm/cam/chem/2000-2100_RCP45/IPCC_emissions_houw_SO2_2000-2100_1.9x2.5.nc 'SERIAL' @@ -70,50 +65,50 @@ 0,-240,-240,-24,-24 'A','I','I','A','A' - + - 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', - 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', - 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', - 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', + 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', + 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', + 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', + 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'H', 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', 'LANDFRAC', 'LHFLX', 'N', 'N2O', 'N2O5', 'NO', 'NO2', 'NO3', 'O', 'O1D', 'O2', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'Q', 'QFLX', 'QPERT', 'QRL', 'QRLNLTE', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', - 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', - 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', 'QNO', 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', - 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'T', 'TREFHT', - 'TTGW', 'U', 'UTGWORO', 'UTGWSPEC', 'V', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'O2_1S', - 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE', 'UI', + 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', + 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', 'QNO', 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', + 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'T', 'TREFHT', + 'TTGW', 'U', 'UTGWORO', 'UTGWSPEC', 'V', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'O2_1S', + 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE', 'UI', 'VI', 'UIONTEND', 'VIONTEND', 'DTCORE', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', - 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', + 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'PS_24_COS', 'PS_24_SIN', 'PS_12_COS', 'PS_12_SIN', 'CLDLIQ','CLDICE','CONCLD', 'FRONTGF:I', 'BUTGWSPEC', 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS','TAUE','TAUW','TAUN','TAUS', 'TAUGWX', 'TAUGWY', 'TAUX','TAUY','SNOWHLND','SNOWHICE','ICEFRAC','FSDSC','SFNO', 'SFCO', 'SFCH2O','CFC11STAR' - + - 'PS', 'Z3', 'T', 'U', 'V', 'FLNT','PSL', + 'PS', 'Z3', 'T', 'U', 'V', 'FLNT','PSL', 'OMEGA','FSDS','FSDSC','CLOUD','CONCLD','SNOWHLND','SNOWHICE', - 'CH3CL', 'CFC11', 'CFC12', 'CFC113', 'HCFC22', 'CCL4', 'CH3CCL3', + 'CH3CL', 'CFC11', 'CFC12', 'CFC113', 'HCFC22', 'CCL4', 'CH3CCL3', 'CH3BR', 'CF3BR', 'CF2CLBR', 'CO', 'CO2', 'CH2O', 'CH3OOH', 'CH4', 'O3', 'O', 'O1D', 'N', 'NO', 'NO2', 'NO3', 'N2O5', 'HNO3', 'HO2NO2', 'NOX', 'NOY', 'N2O', 'H', 'H2', 'OH', 'HO2', 'H2O2', 'H2O', - 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', + 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', 'BR', 'BRO', 'HOBR', 'HBR', 'BRCL', 'BRONO2', 'BROX', 'BROY', 'TCLY', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', - 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', + 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE', 'O2', 'CLDLIQ', 'CLDICE', 'ASDIR', 'VTHzm', 'WTHzm', 'UVzm', 'UWzm', 'TH', 'MSKtem' - + 'PS:B', 'T:B', 'Z3:B', 'U:B', 'V:B', 'CO:B', 'CO2:B', 'H2:B', 'O:B', 'O2:B', 'O3:B', 'H:B', 'OH:B', 'HO2:B', 'H2O:B', @@ -121,11 +116,11 @@ 'Np:B', 'N2p:B', 'Op:B', 'O2p:B', 'NOp:B', 'e:B', 'QRL_TOT:B', 'QRS_TOT:B', 'QJOULE:B', 'jno3_a:B', 'jno3_b:B', 'jcl2o2:B', 'CL2O2:B', 'CLO:B', 'BRO:B', 'NO3:B', 'DTCORE:B', 'DTV:B', 'TTGW:B','OMEGA:B' - + - 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS','FRONTGF:I', 'OMEGA' + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS','FRONTGF:I', 'OMEGA' - + 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' @@ -138,34 +133,10 @@ atm/cam/met/GEOS5 atm/cam/met/GEOS5_filenames_list_c120516.txt - + atm/cam/met/USGS-gtopo30_1.9x2.5_phys_geos5_c100929.nc 1850-2000 - -.false. -1850 -2008 - -atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2008_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2008_c100127.nc -atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2008_c100127.nc -atm/cam/sst/sst_HadOIBl_bc_4x5_1850_2008_c100127.nc -atm/cam/sst/sst_HadOIBl_bc_10x15_1850_2008_c100127.nc - -atm/cam/sst/sst_HadOIBl_bc_128x256_1850_2008_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_64x128_1850_2008_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_48x96_1850_2008_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_32x64_1850_2008_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_8x16_1850_2008_c100128.nc - - -.true. -0 -0 -atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c091020.nc - - diff --git a/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml b/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml index 281956d326..f096415e31 100644 --- a/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +++ b/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml @@ -41,21 +41,12 @@ atm/waccm/ub/tgcm_ubc_1850-2100_c100204.nc 'INTERP_MISSING_MONTHS' - -.true. -.true. -.true. -.false. - - INTERP_MISSING_MONTHS INTERP_MISSING_MONTHS -'noy', 'nhx' - 1, 5, 20, 40, 120, 240, 365, 73, 365 @@ -65,98 +56,91 @@ .true. .false. .false. -.false. +.true. .false. .false. .true. .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' + 'NO2_CMXF' - 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST1', 'AODdnDUST2', - 'AODdnDUST3', 'AODdnMODE1', 'AODdnMODE2', 'AODdnMODE3', 'AODDUST2', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', - 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', - 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', - 'bc_c4SFWET', 'BENZENE', 'BENZO2', 'BENZOOH', 'BEPOMUC', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALD', 'BIGALK', 'BIGENE', + 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', + 'AODdnDUST03', 'AODdn_aitken', 'AODdn_accum', 'AODdn_coarse', 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', + 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', + 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', + 'bc_c4SFWET', 'BENZENE', 'BENZO2', 'BENZOOH', 'BEPOMUC', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALD', 'BIGALK', 'BIGENE', 'BR', 'BRCL', 'BRO', 'BRONO2', 'BROX', 'BROY', 'BRY', 'BTTGWSPEC', 'BTTGWSDF', 'BTTGWSKE', - 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', - 'BURDENSOAdn', 'BUTGWSPEC', 'BZALD', 'BZOO', 'BZOOH', 'C2H2', 'C2H4', 'C2H5O2', 'C2H5OH', 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7O2', - 'C3H7OOH', 'C3H8', 'C6H5O2', 'C6H5OOH', 'CCL4', 'CDNUMC', 'CF2CLBR', 'CF3BR', 'CFC113', 'CFC114', 'CFC115', 'CFC11', 'CFC11STAR', - 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CCL3_CHML', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3CO3', 'CH3COCH3', 'CH3COCHO', - 'CH3COOH', 'CH3COOOH', 'CH3O2', 'CH3OH', 'CH3OOH', 'CH4', 'CH4_CHML', 'CHBR3', 'CL2', 'CL2O2', 'CL', - 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CLOX', 'CLOY', 'CLY', 'CME', 'CMFDQ', 'CMFMC', - 'CMFMCDZM', 'CO2', 'CO2_CHML', 'CO', 'CO_CHML', 'CO_CHMP', 'COF2', 'COFCL', 'CONCLD', 'CRESOL', - 'DCOCHM', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', - 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', - 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', - 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', - 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'DF_NH3', 'DF_NH4', 'DF_NO2', 'DF_NO', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', - 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', - 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', 'DF_XYLENOOH', - 'DF_XYLOLOOH', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'DH2O2CHM', 'DHNO3CHM', 'DICARBO2', 'DMS', 'DO3CHM', 'dry_deposition_NHx_as_N', - 'dry_deposition_NOy_as_N', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'dst_a1', 'dst_a1DDF', 'dst_a1SFWET', 'dst_a2', 'dst_a2DDF', - 'dst_a2SFWET', 'dst_a3', 'dst_a3DDF', 'dst_a3SFWET', 'dst_c1', 'dst_c1DDF', 'dst_c1SFWET', 'dst_c2', 'dst_c2DDF', 'dst_c2SFWET', - 'dst_c3', 'dst_c3DDF', 'dst_c3SFWET', 'DTCORE', 'E90', 'e', 'ENEO2', 'EO2', 'EO', 'EOOH', 'EVAPPREC', - 'EVAPQZM', 'EVAPTZM', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'F', 'FCTL', - 'FLASHFRQ', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FREQI', 'FREQL', 'FREQZM', 'FSDS', - 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'FSNTOAC', 'FSUTOA', 'GLYALD', 'GLYOXAL', - 'GS_SO2', 'H2402', 'H2', 'H2O2', 'H2O', 'H2SO4', 'H2SO4M_C', 'H2SO4_sfnnuc1', 'H', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', 'HCL', - 'HCL_GAS', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS', 'HO2', 'HO2NO2', 'HOBR', 'HOCH2OO', 'HOCL', 'HONITR', - 'HPALD', 'HYAC', 'HYDRALD', 'ICEFRAC', 'IEPOX', 'ISOP', 'ISOPAO2', 'ISOPBO2', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', - 'ISOPNOOH', 'ISOPOOH', 'IVOC', 'IVOC_CHML', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', 'KVH_CLUBB', - 'LANDFRAC', 'LHFLX', 'LNO_COL_PROD', 'LNO_PROD', 'MACR', 'MACRO2', 'MACROOH', 'MALO2', 'MASS', 'MCO3', 'MDIALO2', - 'MEG_BCARY', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_C2H4', 'MEG_C2H5OH', 'MEG_C2H6', 'MEG_C3H6', 'MEG_C3H8', 'MEG_CH2O', - 'MEG_CH3CHO', 'MEG_CH3COCH3', 'MEG_CH3COOH', 'MEG_CH3OH', 'MEG_CO', 'MEG_HCN', 'MEG_HCOOH', 'MEG_ISOP', 'MEG_MTERP', 'MEG_TOLUENE', - 'MEK', 'MEKO2', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', 'N2D', 'N2O5', 'N2O', 'N2O_CHML', 'N2p', 'N', 'NC4CH2OH', - 'NC4CHO', 'ncl_a1', 'ncl_a1DDF', 'ncl_a1SFWET', 'ncl_a2', 'ncl_a2DDF', 'ncl_a2SFWET', 'ncl_a3', 'ncl_a3DDF', 'ncl_a3SFWET', 'ncl_c1', - 'ncl_c1DDF', 'ncl_c1SFWET', 'ncl_c2', 'ncl_c2DDF', 'ncl_c2SFWET', 'ncl_c3', 'ncl_c3DDF', 'ncl_c3SFWET', 'NDEP', 'NH3', 'NH4', 'NH_50', - 'NH_5', 'NHDEP', 'NITROP_PD', 'NO2', 'NO2_CLXF', 'NO3', 'NO', 'NOA', 'NOp', 'NOX', 'NOY', 'Np', 'NTERPO2', 'NTERPOOH', - 'num_a1', 'num_a1_CLXF', 'num_a1DDF', 'num_a2', 'num_a2_CLXF', 'num_a2DDF', 'num_a2_sfnnuc1', 'num_a3', 'num_a3DDF', 'num_a4', - 'num_a4DDF', 'num_c1', 'num_c1DDF', 'num_c2', 'num_c2DDF', 'num_c3', 'num_c3DDF', 'num_c4', 'num_c4DDF', 'NUMLIQ', 'O1D', 'O2_1D', - 'O2_1S', 'O2', 'O2p', 'O3', 'O3S', 'O3_CHML', 'O3_CHMP', 'O', 'OCLO', 'OCS', 'OH', 'OMEGA', 'OMEGAT', 'ONITR', 'Op', - 'PAN', 'PBLH', 'PBZNIT', 'PDELDRY', 'PHENO2', 'PHENO', 'PHENOL', 'PHENOOH', 'PHIS', 'PM25', 'PO2', 'pom_a1', 'pom_a1DDF', 'pom_a1SFWET', - 'pom_a4', 'pom_a4DDF', 'pom_a4SFWET', 'pom_c1', 'pom_c1DDF', 'pom_c1SFWET', 'pom_c4', 'pom_c4DDF', 'pom_c4SFWET', - 'POOH', 'PRECC', 'PRECT', 'PS', 'PSL', 'PTEQ', 'PTTEND', 'Q', 'QFLX', 'QRAIN', 'QREFHT', 'QRL', 'QRLC', 'QRS', - 'QRSC', 'QSNOW', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RELHUM', 'r_GLYOXAL_aer', - 'r_het10', 'r_het11', 'r_het12', 'r_het13', 'r_het15', 'r_het16', 'r_het17', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', - 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_HO2_O3', 'RHREFHT', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', - 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', - 'r_OH_O3', 'r_OH_O', 'ROOH', 'RO2', - 'S', 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP', 'SF6', 'SFbc_a4', 'SFBCARY', - 'SFBENZENE', 'SFBIGALK', 'SFBIGENE', 'SFC2H2', 'SFC2H4', 'SFC2H5OH', 'SFC2H6', 'SFC3H6', 'SFC3H8', 'SFCH2O', 'SFCH3CHO', 'SFCH3CN', - 'SFCH3COCH3', 'SFCH3COCHO', 'SFCH3COOH', 'SFCH3OH', 'SFCO', 'SFDMS', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', 'SFGLYALD', 'SFHCN', 'SFHCOOH', - 'SFISOP', 'SFIVOC', 'SFMEK', 'SFMTERP', 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'SFNH3', 'SFNO2', 'SFNO', 'SFnum_a1', 'SFnum_a2', - 'SFnum_a3', 'SFpom_a4', 'SFSO2', 'SFso4_a1', 'SFso4_a2', 'SFSVOC', 'SFTOLUENE', 'SFXYLENES', 'SHFLX', 'SO2', - 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SO2_XFRC', 'SO3', 'so4_a1', 'so4_a1_CHMP', 'so4_a1_CLXF', 'so4_a1DDF', 'so4_a1_sfgaex1', 'so4_a1SFWET', - 'so4_a2', 'so4_a2_CHMP', 'so4_a2_CLXF', 'so4_a2DDF', 'so4_a2_sfgaex1', 'so4_a2_sfnnuc1', 'so4_a2SFWET', 'so4_a3', - 'so4_a3DDF', 'so4_a3_sfgaex1', 'so4_a3SFWET', 'so4_c1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_c1SFWET', 'so4_c2', 'so4_c2AQH2SO4', - 'so4_c2AQSO4', 'so4_c2DDF', 'so4_c2SFWET', 'so4_c3', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_c3SFWET', 'SO', 'soa1_a1', - 'soa1_a1_CHML', 'soa1_a1DDF', 'soa1_a1_sfgaex1', 'soa1_a1SFWET', 'soa1_a2', 'soa1_a2_CHML', 'soa1_a2DDF', - 'soa1_a2_sfgaex1', 'soa1_a2SFWET', 'soa1_c1', 'soa1_c1DDF', 'soa1_c1SFWET', 'soa1_c2', 'soa1_c2DDF', 'soa1_c2SFWET', 'soa2_a1', 'soa2_a1_CHML', - 'soa2_a1DDF', 'soa2_a1_sfgaex1', 'soa2_a1SFWET', 'soa2_a2', 'soa2_a2_CHML', 'soa2_a2DDF', 'soa2_a2_sfgaex1', - 'soa2_a2SFWET', 'soa2_c1', 'soa2_c1DDF', 'soa2_c1SFWET', 'soa2_c2', 'soa2_c2DDF', 'soa2_c2SFWET', 'soa3_a1', 'soa3_a1_CHML', - 'soa3_a1DDF', 'soa3_a1_sfgaex1', 'soa3_a1SFWET', 'soa3_a2', 'soa3_a2_CHML', 'soa3_a2DDF', 'soa3_a2_sfgaex1', 'soa3_a2SFWET', - 'soa3_c1', 'soa3_c1DDF', 'soa3_c1SFWET', 'soa3_c2', 'soa3_c2DDF', 'soa3_c2SFWET', 'soa4_a1', 'soa4_a1_CHML', 'soa4_a1DDF', - 'soa4_a1_sfgaex1', 'soa4_a1SFWET', 'soa4_a2', 'soa4_a2_CHML', 'soa4_a2DDF', 'soa4_a2_sfgaex1', 'soa4_a2SFWET', 'soa4_c1', - 'soa4_c1DDF', 'soa4_c1SFWET', 'soa4_c2', 'soa4_c2DDF', 'soa4_c2SFWET', 'soa5_a1', 'soa5_a1_CHML', 'soa5_a1DDF', 'soa5_a1_sfgaex1', - 'soa5_a1SFWET', 'soa5_a2', 'soa5_a2_CHML', 'soa5_a2DDF', 'soa5_a2_sfgaex1', 'soa5_a2SFWET', 'soa5_c1', 'soa5_c1DDF', - 'soa5_c1SFWET', 'soa5_c2', 'soa5_c2DDF', 'soa5_c2SFWET', 'SOAG0', 'SOAG0_CHMP', 'SOAG1', 'SOAG1_CHMP', 'SOAG2', 'SOAG2_CHMP', - 'SOAG3', 'SOAG3_CHMP', 'SOAG4', 'SOAG4_CHMP', 'SOLIN', 'SOLLD', 'SOLSD', 'SSAVIS', 'SST', 'ST80_25', 'SVOC', 'SVOC_CHML', - 'T', 'TAQ', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', 'TBRY', 'TCLY', 'TEPOMUC', 'TERP2O2', 'TERP2OOH', - 'TERPNIT', 'TERPO2', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TGCLDIWP', 'TGCLDLWP', 'THzm', 'TMDMS', 'TMOCS', 'TMQ', 'TMSO2', - 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'TOLO2', 'TOLOOH', 'TOLUENE', 'TOT_CLD_VISTAU', 'TOTH', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TROP_P', + 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', + 'BURDENSOAdn', 'BUTGWSPEC', 'BZALD', 'BZOO', 'BZOOH', 'C2H2', 'C2H4', 'C2H5O2', 'C2H5OH', 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7O2', + 'C3H7OOH', 'C3H8', 'C6H5O2', 'C6H5OOH', 'CCL4', 'CDNUMC', 'CF2CLBR', 'CF3BR', 'CFC113', 'CFC114', 'CFC115', 'CFC11', 'CFC11STAR', + 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CCL3_CHML', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3CO3', 'CH3COCH3', 'CH3COCHO', + 'CH3COOH', 'CH3COOOH', 'CH3O2', 'CH3OH', 'CH3OOH', 'CH4', 'CH4_CHML', 'CHBR3', 'CL2', 'CL2O2', 'CL', + 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CLOX', 'CLOY', 'CLY', 'CME', 'CMFDQ', 'CMFMC', + 'CMFMC_DP', 'CO2', 'CO2_CHML', 'CO', 'CO_CHML', 'CO_CHMP', 'COF2', 'COFCL', 'CONCLD', 'CRESOL', + 'DCOCHM', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', + 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', + 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', + 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', + 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'DF_NH3', 'DF_NH4', 'DF_NO2', 'DF_NO', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', + 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', + 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', 'DF_XYLENOOH', + 'DF_XYLOLOOH', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'DH2O2CHM', 'DHNO3CHM', 'DICARBO2', 'DMS', 'DO3CHM', 'dry_deposition_NHx_as_N', + 'dry_deposition_NOy_as_N', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'dst_a1', 'dst_a1DDF', 'dst_a1SFWET', 'dst_a2', 'dst_a2DDF', + 'dst_a2SFWET', 'dst_a3', 'dst_a3DDF', 'dst_a3SFWET', 'dst_c1', 'dst_c1DDF', 'dst_c1SFWET', 'dst_c2', 'dst_c2DDF', 'dst_c2SFWET', + 'dst_c3', 'dst_c3DDF', 'dst_c3SFWET', 'DTCORE', 'E90', 'e', 'ENEO2', 'EO2', 'EO', 'EOOH', 'EVAPPREC', + 'EVAPQZM', 'EVAPTZM', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'F', 'FCTL', + 'FLASHFRQ', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FREQI', 'FREQL', 'FREQZM', 'FSDS', + 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'FSNTOAC', 'FSUTOA', 'GLYALD', 'GLYOXAL', + 'GS_SO2', 'H2402', 'H2', 'H2O2', 'H2O', 'H2SO4', 'H2SO4M_C', 'H2SO4_sfnnuc1', 'H', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', 'HCL', + 'HCL_GAS', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS', 'HO2', 'HO2NO2', 'HOBR', 'HOCH2OO', 'HOCL', 'HONITR', + 'HPALD', 'HYAC', 'HYDRALD', 'ICEFRAC', 'IEPOX', 'ISOP', 'ISOPAO2', 'ISOPBO2', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', + 'ISOPNOOH', 'ISOPOOH', 'IVOC', 'IVOC_CHML', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', 'KVH_CLUBB', + 'LANDFRAC', 'LHFLX', 'LNO_COL_PROD', 'LNO_PROD', 'MACR', 'MACRO2', 'MACROOH', 'MALO2', 'MASS', 'MCO3', 'MDIALO2', + 'MEG_BCARY', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_C2H4', 'MEG_C2H5OH', 'MEG_C2H6', 'MEG_C3H6', 'MEG_C3H8', 'MEG_CH2O', + 'MEG_CH3CHO', 'MEG_CH3COCH3', 'MEG_CH3COOH', 'MEG_CH3OH', 'MEG_CO', 'MEG_HCN', 'MEG_HCOOH', 'MEG_ISOP', 'MEG_MTERP', 'MEG_TOLUENE', + 'MEK', 'MEKO2', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', 'N2D', 'N2O5', 'N2O', 'N2O_CHML', 'N2p', 'N', 'NC4CH2OH', + 'NC4CHO', 'ncl_a1', 'ncl_a1DDF', 'ncl_a1SFWET', 'ncl_a2', 'ncl_a2DDF', 'ncl_a2SFWET', 'ncl_a3', 'ncl_a3DDF', 'ncl_a3SFWET', 'ncl_c1', + 'ncl_c1DDF', 'ncl_c1SFWET', 'ncl_c2', 'ncl_c2DDF', 'ncl_c2SFWET', 'ncl_c3', 'ncl_c3DDF', 'ncl_c3SFWET', 'NDEP', 'NH3', 'NH4', 'NH_50', + 'NH_5', 'NHDEP', 'NITROP_PD', 'NO2', 'NO2_CLXF', 'NO3', 'NO', 'NOA', 'NOp', 'NOX', 'NOY', 'Np', 'NTERPO2', 'NTERPOOH', + 'num_a1', 'num_a1_CLXF', 'num_a1DDF', 'num_a2', 'num_a2_CLXF', 'num_a2DDF', 'num_a2_sfnnuc1', 'num_a3', 'num_a3DDF', 'num_a4', + 'num_a4DDF', 'num_c1', 'num_c1DDF', 'num_c2', 'num_c2DDF', 'num_c3', 'num_c3DDF', 'num_c4', 'num_c4DDF', 'NUMLIQ', 'O1D', 'O2_1D', + 'O2_1S', 'O2', 'O2p', 'O3', 'O3S', 'O3_CHML', 'O3_CHMP', 'O', 'OCLO', 'OCS', 'OH', 'OMEGA', 'OMEGAT', 'ONITR', 'Op', + 'PAN', 'PBLH', 'PBZNIT', 'PDELDRY', 'PHENO2', 'PHENO', 'PHENOL', 'PHENOOH', 'PHIS', 'PM25', 'PO2', 'pom_a1', 'pom_a1DDF', 'pom_a1SFWET', + 'pom_a4', 'pom_a4DDF', 'pom_a4SFWET', 'pom_c1', 'pom_c1DDF', 'pom_c1SFWET', 'pom_c4', 'pom_c4DDF', 'pom_c4SFWET', + 'POOH', 'PRECC', 'PRECT', 'PS', 'PSL', 'PTEQ', 'PTTEND', 'Q', 'QFLX', 'QRAIN', 'QREFHT', 'QRL', 'QRLC', 'QRS', + 'QRSC', 'QSNOW', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RELHUM', 'r_GLYOXAL_aer', + 'r_het10', 'r_het11', 'r_het12', 'r_het13', 'r_het15', 'r_het16', 'r_het17', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', + 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_HO2_O3', 'RHREFHT', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', + 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', + 'r_OH_O3', 'r_OH_O', 'ROOH', 'RO2', + 'S', 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP', 'SF6', 'SFbc_a4', 'SFBCARY', + 'SFBENZENE', 'SFBIGALK', 'SFBIGENE', 'SFC2H2', 'SFC2H4', 'SFC2H5OH', 'SFC2H6', 'SFC3H6', 'SFC3H8', 'SFCH2O', 'SFCH3CHO', 'SFCH3CN', + 'SFCH3COCH3', 'SFCH3COCHO', 'SFCH3COOH', 'SFCH3OH', 'SFCO', 'SFDMS', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', 'SFGLYALD', 'SFHCN', 'SFHCOOH', + 'SFISOP', 'SFIVOC', 'SFMEK', 'SFMTERP', 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'SFNH3', 'SFNO', 'SFnum_a1', 'SFnum_a2', + 'SFnum_a3', 'SFpom_a4', 'SFSO2', 'SFso4_a1', 'SFso4_a2', 'SFSVOC', 'SFTOLUENE', 'SFXYLENES', 'SHFLX', 'SO2', + 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SO2_XFRC', 'SO3', 'so4_a1', 'so4_a1_CHMP', 'so4_a1_CLXF', 'so4_a1DDF', 'so4_a1_sfgaex1', 'so4_a1SFWET', + 'so4_a2', 'so4_a2_CHMP', 'so4_a2_CLXF', 'so4_a2DDF', 'so4_a2_sfgaex1', 'so4_a2_sfnnuc1', 'so4_a2SFWET', 'so4_a3', + 'so4_a3DDF', 'so4_a3_sfgaex1', 'so4_a3SFWET', 'so4_c1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_c1SFWET', 'so4_c2', 'so4_c2AQH2SO4', + 'so4_c2AQSO4', 'so4_c2DDF', 'so4_c2SFWET', 'so4_c3', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_c3SFWET', 'SO', 'soa1_a1', + 'soa1_a1_CHML', 'soa1_a1DDF', 'soa1_a1_sfgaex1', 'soa1_a1SFWET', 'soa1_a2', 'soa1_a2_CHML', 'soa1_a2DDF', + 'soa1_a2_sfgaex1', 'soa1_a2SFWET', 'soa1_c1', 'soa1_c1DDF', 'soa1_c1SFWET', 'soa1_c2', 'soa1_c2DDF', 'soa1_c2SFWET', 'soa2_a1', 'soa2_a1_CHML', + 'soa2_a1DDF', 'soa2_a1_sfgaex1', 'soa2_a1SFWET', 'soa2_a2', 'soa2_a2_CHML', 'soa2_a2DDF', 'soa2_a2_sfgaex1', + 'soa2_a2SFWET', 'soa2_c1', 'soa2_c1DDF', 'soa2_c1SFWET', 'soa2_c2', 'soa2_c2DDF', 'soa2_c2SFWET', 'soa3_a1', 'soa3_a1_CHML', + 'soa3_a1DDF', 'soa3_a1_sfgaex1', 'soa3_a1SFWET', 'soa3_a2', 'soa3_a2_CHML', 'soa3_a2DDF', 'soa3_a2_sfgaex1', 'soa3_a2SFWET', + 'soa3_c1', 'soa3_c1DDF', 'soa3_c1SFWET', 'soa3_c2', 'soa3_c2DDF', 'soa3_c2SFWET', 'soa4_a1', 'soa4_a1_CHML', 'soa4_a1DDF', + 'soa4_a1_sfgaex1', 'soa4_a1SFWET', 'soa4_a2', 'soa4_a2_CHML', 'soa4_a2DDF', 'soa4_a2_sfgaex1', 'soa4_a2SFWET', 'soa4_c1', + 'soa4_c1DDF', 'soa4_c1SFWET', 'soa4_c2', 'soa4_c2DDF', 'soa4_c2SFWET', 'soa5_a1', 'soa5_a1_CHML', 'soa5_a1DDF', 'soa5_a1_sfgaex1', + 'soa5_a1SFWET', 'soa5_a2', 'soa5_a2_CHML', 'soa5_a2DDF', 'soa5_a2_sfgaex1', 'soa5_a2SFWET', 'soa5_c1', 'soa5_c1DDF', + 'soa5_c1SFWET', 'soa5_c2', 'soa5_c2DDF', 'soa5_c2SFWET', 'SOAG0', 'SOAG0_CHMP', 'SOAG1', 'SOAG1_CHMP', 'SOAG2', 'SOAG2_CHMP', + 'SOAG3', 'SOAG3_CHMP', 'SOAG4', 'SOAG4_CHMP', 'SOLIN', 'SOLLD', 'SOLSD', 'SSAVIS', 'SST', 'ST80_25', 'SVOC', 'SVOC_CHML', + 'T', 'TAQ', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', 'TBRY', 'TCLY', 'TEPOMUC', 'TERP2O2', 'TERP2OOH', + 'TERPNIT', 'TERPO2', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TGCLDIWP', 'TGCLDLWP', 'THzm', 'TMDMS', 'TMOCS', 'TMQ', 'TMSO2', + 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'TOLO2', 'TOLOOH', 'TOLUENE', 'TOT_CLD_VISTAU', 'TOTH', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TROP_P', 'TROP_T', 'TROP_Z', 'TS', 'TSMN:M', 'TSMX:X', 'TTEND_TOT', 'TTGWORO', 'TTGWSDF', 'TTGWSDFORO', 'TTGWSKE', 'TTGWSKEORO', 'TTGWSPEC', - 'U10', 'U', 'UTGWORO', 'UTGWSPEC', 'UU', 'UVzm', 'UWzm', 'Uzm', 'V', 'VD01', 'VEL_NAT2', 'VTHzm', 'VV', 'Vzm', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', - 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCH3', 'WD_CH3COCHO', - 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', - 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', - 'WD_HYDRALD', 'WD_IEPOX', 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', - 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', - 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', - 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', - 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'Wzm', 'XO2', 'XOOH', 'XYLENES', 'XYLENO2', 'XYLENOOH', 'XYLOL', 'XYLOLO2', + 'U10', 'U', 'UTGWORO', 'UTGWSPEC', 'UU', 'UVzm', 'UWzm', 'Uzm', 'V', 'VD01', 'VEL_NAT2', 'VTHzm', 'VV', 'Vzm', + 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'Wzm', 'XO2', 'XOOH', 'XYLENES', 'XYLENO2', 'XYLENOOH', 'XYLOL', 'XYLOLO2', 'XYLOLOOH', 'Z3', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU', 'O3_Prod','O3_Loss','O3S_Loss','RO2_NO_sum','O3_alkenes','RO2_NO3_sum','RO2_HO2_sum','RO2_RO2_sum','RCO2_NO2_sum', 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', @@ -164,21 +148,21 @@ - 'ACTNL', 'ACTREL', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BUTGWSPEC', - 'CDNUMC', 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLOUD', 'CMFMC', 'CMFMCDZM', 'FCTL', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', - 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FSDS', 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNTOA', 'FSNTOAC', 'LHFLX', 'MASS', 'O3', 'OMEGA', - 'OMEGA500', 'PBLH', 'PDELDRY', 'PM25_SRF', 'PRECC', 'PRECT', 'PS', 'PSL', 'Q', 'QREFHT', 'QSNOW', 'RELHUM', 'RHREFHT', 'SHFLX', - 'SOLIN', 'SOLLD', 'SOLSD', 'T', 'T500', 'T700', 'T850', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', - 'TGCLDIWP', 'TGCLDLWP', 'TMQ', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TS', 'TSMN:M', 'TSMX:X', 'U', 'U10', 'UTGWORO', 'UTGWSPEC', + 'ACTNL', 'ACTREL', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BUTGWSPEC', + 'CDNUMC', 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLOUD', 'CMFMC', 'CMFMC_DP', 'FCTL', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', + 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FSDS', 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNTOA', 'FSNTOAC', 'LHFLX', 'MASS', 'O3', 'OMEGA', + 'OMEGA500', 'PBLH', 'PDELDRY', 'PM25_SRF', 'PRECC', 'PRECT', 'PS', 'PSL', 'Q', 'QREFHT', 'QSNOW', 'RELHUM', 'RHREFHT', 'SHFLX', + 'SOLIN', 'SOLLD', 'SOLSD', 'T', 'T500', 'T700', 'T850', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'TGCLDIWP', 'TGCLDLWP', 'TMQ', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TS', 'TSMN:M', 'TSMX:X', 'U', 'U10', 'UTGWORO', 'UTGWSPEC', 'V', 'Z3', 'Z500' - + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' - - + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', 'REFF_AERO', 'SAD_AERO', 'NITROP_PD', 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' - + diff --git a/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml b/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml index aa32bc5851..6ec178700a 100644 --- a/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml +++ b/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml @@ -23,11 +23,6 @@ atm/waccm/gcrs gcr_prod_NO_1949-2142_c150309.nc - -.false. -atm/waccm/qbo/qbocoefficients_c151023.nc -.true. - atm/waccm/lb/LBC_1765-2100_1.9x2.5_CCMI_RCP60_za_c130313.nc 'SERIAL' @@ -80,60 +75,60 @@ 0, -1, -24, -24, -120, -24 1, 24, 7, 7, 10, 365 - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2' 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', - 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'QRS_TOT', 'QO3', 'QCO2', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2' 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', + 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'QRS_TOT', 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', - 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', - 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', - 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', - 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO2', 'NO3', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'PHIS', + 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', + 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', + 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO2', 'NO3', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'PHIS', 'PRECC', 'PRECL', 'Q', 'QFLX', 'QPERT', 'QRL', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', 'QTHERMAL', 'QRL_TOT', 'PSL', 'HNO3_STS', 'HNO3_NAT', 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'TREFHT', - 'VERT', 'VTGWORO', 'VTGWSPEC', 'O2_1S', 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', - 'TCLY', 'TOTH', 'UIONTEND', 'VIONTEND', 'DTCORE', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', - 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'VERT', 'VTGWORO', 'VTGWSPEC', 'O2_1S', 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', + 'TCLY', 'TOTH', 'UIONTEND', 'VIONTEND', 'DTCORE', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', + 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', 'TROPP_FD', 'KVH', 'KVM', 'KVT', 'Qbkgndtot', 'Z3GM', 'OpDens', 'EDens' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H' + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', - 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', + 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' - - + + 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN' - - - 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' + + + 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' 0.84 @@ -166,6 +161,6 @@ 2 atm/cam/dst/dst_source2x2tuned-cam4-06132012.nc 1.200D0 -.false. +.false. diff --git a/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml b/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml index 5aaf0216da..6493ed584b 100644 --- a/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml +++ b/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml @@ -15,7 +15,7 @@ 'epp_ion_rates' -atm/waccm/ic/f.c61016.FC6XSD.f09_f09_mg17.test01.cam.i.2000-01-21-00000_c190325.nc +atm/waccm/ic/f.c62004.FC6XSD.f09_f09_mg17.cam.i.1980-01-01-00000_c191211.nc atm/waccm/ic/FC6XSD_f19_f19_mg17_L145_1981-01-01-00000_c190617.nc 50. @@ -45,8 +45,6 @@ -.true. -.false. .true. atm/waccm/qbo/qbocyclic28months.nc @@ -64,62 +62,62 @@ 0, -1, -24, -24, -120, -24, -120, -240 1, 24, 7, 7, 10, 365, 73, 30 - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2' 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', - 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'QRS_TOT', 'QO3', 'QCO2', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2' 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', + 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'QRS_TOT', 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', - 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', - 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', - 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', - 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO2', 'NO3', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'PHIS', + 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', + 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', + 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO2', 'NO3', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'PHIS', 'PRECC', 'PRECL', 'Q', 'QFLX', 'QRL', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', 'QTHERMAL', 'QRL_TOT', 'PSL', 'HNO3_STS', 'HNO3_NAT', 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'TREFHT', - 'VERT', 'VTGWORO', 'VTGWSPEC', 'O2_1S', 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', - 'TCLY', 'TOTH', 'UIONTEND', 'VIONTEND', 'DTCORE', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', - 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'VERT', 'VTGWORO', 'VTGWSPEC', 'O2_1S', 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', + 'TCLY', 'TOTH', 'UIONTEND', 'VIONTEND', 'DTCORE', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', + 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', 'TROPP_FD', 'KVH', 'KVM', 'KVT', 'Qbkgndtot', 'Z3GM', 'OpDens', 'EDens' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H' + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', - 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', + 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' - - + + 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN' - + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' - + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', 'REFF_AERO', 'SAD_AERO', 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'NITROP_PD', @@ -137,7 +135,7 @@ .false. .false. - + 'SolIonRate_Tot = jeuv_1 + jeuv_2 + jeuv_3 + jeuv_4 + jeuv_5 + jeuv_6 + jeuv_7 + jeuv_8 + jeuv_9 + jeuv_10 + jeuv_11 + jeuv_14 + jeuv_15 + jeuv_16 +', 'jeuv_17 + jeuv_18 + jeuv_19 + jeuv_20 + jeuv_21 + jeuv_22 + jeuv_23', diff --git a/bld/namelist_files/use_cases/soa_chem_megan_emis.xml b/bld/namelist_files/use_cases/soa_chem_megan_emis.xml index 512d95fcc9..5497ed52a9 100644 --- a/bld/namelist_files/use_cases/soa_chem_megan_emis.xml +++ b/bld/namelist_files/use_cases/soa_chem_megan_emis.xml @@ -63,7 +63,7 @@ NEU - 'AEROD_v', 'AOA1', 'AOA2', 'CH2O', 'CH3O2', 'CH3OOH', 'CH4', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLOUD', + 'AEROD_v', 'CH2O', 'CH3O2', 'CH3OOH', 'CH4', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLOUD', 'CO', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'H', 'H2', 'H2O2', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'HNO3', 'HO2', 'HO2NO2', 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO', 'NO2', 'NO3', 'O', 'O1D', 'O3', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'Q', 'QRL', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', diff --git a/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml b/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml index db29e12cb0..1429770e8e 100644 --- a/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +++ b/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml @@ -46,13 +46,12 @@ atm/waccm/sulf/SAD_SULF_1849-2100_1.9x2.5_c090817.nc 'SERIAL' - + .false. atm/waccm/qbo/qbocoefficients_c091230.nc' -.true. -.true. +.true. @@ -76,50 +75,50 @@ 0, -240, -240, -24, -24 'A', 'I', 'I', 'A', 'A' - + - 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', - 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', - 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', - 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', + 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', + 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', + 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', + 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'H', 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', 'LANDFRAC', 'LHFLX', 'N', 'N2O', 'N2O5', 'NO', 'NO2', 'NO3', 'O', 'O1D', 'O2', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'Q', 'QFLX', 'QPERT', 'QRL', 'QRLNLTE', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', - 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', - 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', 'QNO', 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', - 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'T', 'TREFHT', - 'TTGW', 'U', 'UTGWORO', 'UTGWSPEC', 'V', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'O2_1S', - 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE', 'UI', + 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', + 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', 'QNO', 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', + 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'T', 'TREFHT', + 'TTGW', 'U', 'UTGWORO', 'UTGWSPEC', 'V', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'O2_1S', + 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE', 'UI', 'VI', 'UIONTEND', 'VIONTEND', 'DTCORE', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', - 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', + 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'PS_24_COS', 'PS_24_SIN', 'PS_12_COS', 'PS_12_SIN', 'CLDLIQ','CLDICE','CONCLD', 'FRONTGF:I', 'BUTGWSPEC', 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS','TAUE','TAUW','TAUN','TAUS', 'TAUGWX', 'TAUGWY', 'TAUX','TAUY','SNOWHLND','SNOWHICE','ICEFRAC','FSDSC','SFNO', 'SFCO', 'SFCH2O','CFC11STAR','TROPP_FD' - + - 'PS', 'Z3', 'T', 'U', 'V', 'FLNT','PSL', + 'PS', 'Z3', 'T', 'U', 'V', 'FLNT','PSL', 'OMEGA','FSDS','FSDSC','CLOUD','CONCLD','SNOWHLND','SNOWHICE', - 'CH3CL', 'CFC11', 'CFC12', 'CFC113', 'HCFC22', 'CCL4', 'CH3CCL3', + 'CH3CL', 'CFC11', 'CFC12', 'CFC113', 'HCFC22', 'CCL4', 'CH3CCL3', 'CH3BR', 'CF3BR', 'CF2CLBR', 'CO', 'CO2', 'CH2O', 'CH3OOH', 'CH4', 'O3', 'O', 'O1D', 'N', 'NO', 'NO2', 'NO3', 'N2O5', 'HNO3', 'HO2NO2', 'NOX', 'NOY', 'N2O', 'H', 'H2', 'OH', 'HO2', 'H2O2', 'H2O', - 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', + 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', 'BR', 'BRO', 'HOBR', 'HBR', 'BRCL', 'BRONO2', 'BROX', 'BROY', 'TCLY', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', - 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', + 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE', 'O2', 'CLDLIQ', 'CLDICE', 'ASDIR', 'VTHzm', 'WTHzm', 'UVzm', 'UWzm', 'TH', 'MSKtem' - + 'PS:B', 'T:B', 'Z3:B', 'U:B', 'V:B', 'CO:B', 'CO2:B', 'H2:B', 'O:B', 'O2:B', 'O3:B', 'H:B', 'OH:B', 'HO2:B', 'H2O:B', @@ -127,11 +126,11 @@ 'Np:B', 'N2p:B', 'Op:B', 'O2p:B', 'NOp:B', 'e:B', 'QRL_TOT:B', 'QRS_TOT:B', 'QJOULE:B', 'jno3_a:B', 'jno3_b:B', 'jcl2o2:B', 'CL2O2:B', 'CLO:B', 'BRO:B', 'NO3:B', 'DTCORE:B', 'DTV:B', 'TTGW:B','OMEGA:B' - + - 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS','FRONTGF:I', 'OMEGA' + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS','FRONTGF:I', 'OMEGA' - + 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' @@ -139,27 +138,4 @@ 1850-2000 - -.false. -1850 -2008 - -atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2008_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2008_c100127.nc -atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2008_c100127.nc -atm/cam/sst/sst_HadOIBl_bc_4x5_1850_2008_c100127.nc -atm/cam/sst/sst_HadOIBl_bc_10x15_1850_2008_c100127.nc - -atm/cam/sst/sst_HadOIBl_bc_128x256_1850_2008_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_64x128_1850_2008_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_48x96_1850_2008_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_32x64_1850_2008_c100128.nc -atm/cam/sst/sst_HadOIBl_bc_8x16_1850_2008_c100128.nc - - -.true. -0 -0 -atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c091020.nc - diff --git a/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml b/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml index 91555c0a4d..fbd7423680 100644 --- a/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml @@ -36,13 +36,6 @@ atm/waccm/ub/tgcm_ubc_1850_c100204.nc CYCLICAL - -.true. -.false. -.false. -atm/waccm/qbo/qbocoefficients_c151023.nc - - @@ -53,8 +46,6 @@ CYCLICAL 1850 -'noy', 'nhx' - 1, 30, 120, 240, 240, 480, 365, 73, 30 @@ -62,7 +53,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', @@ -83,7 +74,7 @@ 'BURDENPOMdn', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', - 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', 'soa_c2', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', 'soa_c2', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', 'CO2', 'H2O', 'N2O', 'CH4', 'N2O5', 'NO2', 'NO', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'LNO_PROD', 'LNO_COL_PROD', 'dry_deposition_NHx_as_N', 'dry_deposition_NOy_as_N', diff --git a/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml b/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml index 8d52814a7b..9ccac8892f 100644 --- a/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml @@ -21,7 +21,6 @@ cesm2_init/f.e22.FWma2000climo.f09_f09_mg17.cam6_2_021.c20200421/0004-01-01/f.e22.FWma2000climo.f09_f09_mg17.cam6_2_021.c20200421.cam.i.0004-01-01-00000.nc cesm2_init/f.e22.FWma2000climo.f19_f19_mg17.cam6_2_021.c20200421/0008-01-01/f.e22.FWma2000climo.f19_f19_mg17.cam6_2_021.c20200421.cam.i.0008-01-01-00000.nc -cesm2_init/f.e22.FWma2000climo.ne30pg3_ne30pg3_mg17.cam6_2_021.c20200421/0004-01-01/f.e22.FWma2000climo.ne30pg3_ne30pg3_mg17.cam6_2_021.c20200421.cam.i.0004-01-01-00000.nc atm/waccm/ic/f2000.waccm-mam3_4x5_L70.cam2.i.0017-01-01.c121113.nc @@ -39,9 +38,6 @@ CYCLICAL -.true. -.false. -.false. .true. atm/waccm/qbo/qbocyclic28months.nc @@ -95,7 +91,6 @@ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_other_surface_2000climo_0.9x1.25_c20170322.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', @@ -127,7 +122,6 @@ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_bc_a4_anthro_surface_2000climo_1.9x2.5_c20200422.nc', 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_bc_a4_bb_surface_2000climo_1.9x2.5_c20200422.nc', 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_DMS_bb_surface_2000climo_1.9x2.5_c20200422.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_DMS_other_surface_2000climo_1.9x2.5_c20200422.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_num_so4_a1_bb_surface_2000climo_1.9x2.5_c20200422.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_1.9x2.5_c20200422.nc', 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_1.9x2.5_c20200422.nc', @@ -156,7 +150,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', @@ -177,7 +171,7 @@ 'BURDENPOMdn', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', - 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', 'soa_c2', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', 'soa_c2', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', 'CO2', 'H2O', 'N2O', 'CH4', 'N2O5', 'NO2', 'NO', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'LNO_PROD', 'LNO_COL_PROD', 'dry_deposition_NHx_as_N', 'dry_deposition_NOy_as_N', diff --git a/bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml b/bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml index a440b39695..e2376e4a70 100644 --- a/bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml +++ b/bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml @@ -24,11 +24,6 @@ atm/waccm/gcrs gcr_prod_NO_1949-2142_c150309.nc - -.false. -atm/waccm/qbo/qbocoefficients_c151023.nc -.true. - atm/waccm/lb/LBC_1765-2100_1.9x2.5_CCMI_RCP60_za_c130313.nc 'SERIAL' @@ -83,7 +78,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml b/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml index c0db076ab1..3bc7948bce 100644 --- a/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml @@ -32,12 +32,6 @@ atm/waccm/ub/tgcm_ubc_1850-2100_c100204.nc 'INTERP_MISSING_MONTHS' - -.true. -.false. -.false. -atm/waccm/qbo/qbocoefficients_c151023.nc - @@ -46,8 +40,6 @@ INTERP_MISSING_MONTHS -'noy', 'nhx' - 1, 30, 120, 240, 240, 480, 365, 73, 30 @@ -55,7 +47,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', @@ -76,7 +68,7 @@ 'BURDENPOMdn', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a1', 'ncl_a2', 'ncl_a3', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2', 'bc_c1', 'bc_c4', 'dst_c1', 'dst_c2', 'dst_c3', 'ncl_c1', 'ncl_c1', - 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', 'soa_c2', + 'ncl_c2', 'ncl_c3', 'pom_c1', 'pom_c4', 'so4_c1', 'so4_c2', 'so4_c3', 'soa_c1', 'soa_c2', 'num_a1','num_a2','num_a3','num_a4','num_c1','num_c2','num_c3','num_c4', 'CO2', 'H2O', 'N2O', 'CH4', 'N2O5', 'NO2', 'NO', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'LNO_PROD', 'LNO_COL_PROD', 'dry_deposition_NHx_as_N', 'dry_deposition_NOy_as_N', diff --git a/bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml b/bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml index 1cfa9c39ab..77184615a1 100644 --- a/bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml @@ -22,12 +22,6 @@ atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc 'CO2','CH4','N2O','CFC11','CFC12','CFC11eq' - -.true. -.false. -.false. -atm/waccm/qbo/qbocoefficients_c151023.nc - CYCLICAL 1850 @@ -66,6 +60,9 @@ CYCLICAL 1850 +CYCLICAL +1850 + .true. .true. @@ -75,7 +72,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', + 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', 'UTGWSPEC', 'VTGWSPEC', 'BUTGWSPEC', 'AODVISstdn', 'AODVISdn', 'KVH_CLUBB', 'KVH', 'TTENDICE', 'QVTENDICE', 'QCTENDICE', 'NCTENDICE', 'FQTENDICE', 'MASS' @@ -87,8 +84,11 @@ 'BTAUN', 'BTAUS', 'BTAUE', 'BTAUW', 'BTAUNET', 'BUTEND1', 'BUTEND2', 'BUTEND3', 'BUTEND4', 'BUTEND5', 'BVTGWSPEC', - 'MAXQ0', 'HDEPTH', 'NETDT', 'TAUN', 'TAUS', 'TAUE', 'TAUW', 'TAUGWX', 'TAUGWY', 'UTEND1', 'UTEND2', 'UTEND3', + 'MAXQ0', 'HDEPTH', 'NETDT', 'TAUN', 'TAUS', 'TAUE', 'TAUW', 'TAUGWX', 'TAUGWY', 'UTEND1', 'UTEND2', 'UTEND3', 'UTEND4', 'UTEND5', 'FRONTGF', 'FRONTGFA', 'EKGW', 'QNO', 'QRLNLTE', 'QRL_TOT', 'DUV', 'DVV', 'TTPXMLC' + +1850 + diff --git a/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml b/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml index 434e30a76c..3edfca3076 100644 --- a/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml +++ b/bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml @@ -41,7 +41,6 @@ .true. atm/waccm/qbo/qbocyclic28months.nc' -.true. atm/waccm/phot/wa_smax_c100517.nc 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 8c0a463b6f..ead1445075 100644 --- a/bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml @@ -11,7 +11,7 @@ atm/cam/solar/SolarForcing1995-2005avg_c160929.nc -cesm2_init/f.e21.FWsc2000climo.f09_f09_mg17.cesm2.1-exp011.001/0003-01-01/f.e21.FWsc2000climo.f09_f09_mg17.cesm2.1-exp011.001.cam.i.0003-01-01-00000.nc +cesm2_init/f.e21.FWsc2000climo.f09_f09_mg17.cesm2.1-exp011.001_v2/0003-01-01/f.e21.FWsc2000climo.f09_f09_mg17.cesm2.1-exp011.001_v2.cam.i.0003-01-01-00000.nc atm/waccm/ic/f2000.waccm-mam3_1.9x2.5_L70.cam2.i.0017-01-01.c120410.nc @@ -20,16 +20,9 @@ atm/waccm/lb/LBC_2000climo_CMIP6_0p5degLat_c180227.nc 'CO2','CH4','N2O','CFC11','CFC12','CFC11eq' - -.true. -.false. -.false. -.false. -atm/waccm/qbo/qbocoefficients_c151023.nc - -FIXED -20000101 +CYCLICAL +2000 SCWACCM_forcing_WACCM6_zm_5day_L70_1975-2014_c191121.nc atm/waccm/waccm_forcing @@ -57,8 +50,8 @@ -CYCLICAL -2000 +CYCLICAL +2000 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ene_vertical_2000climo_0.9x1.25_c20170616.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_a1_so4_contvolcano_vertical_2000climo_0.9x1.25_c20170724.nc', @@ -72,33 +65,41 @@ CYCLICAL 2000 - - 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', - 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_other_surface_2000climo_0.9x1.25_c20170322.nc', - 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', - 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', - 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', - 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', - 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_bb_surface_2000climo_0.9x1.25_c20170509.nc', - 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', - 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ag-ship-res_surface_2000climo_0.9x1.25_c20170616.nc', - 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ene_surface_2000climo_0.9x1.25_c20170616.nc', - 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', - 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', - 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_anthro_surface_2000climo_0.9x1.25_c20170608.nc', - 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SOAGx1.5_biogenic_surface_2000climo_0.9x1.25_c20170322.nc' - + + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', + 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_pom_a4_bb_surface_2000climo_0.9x1.25_c20170509.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_pom_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc ', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ag-ship-res_surface_2000climo_0.9x1.25_c20170616.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_anthro-ene_surface_2000climo_0.9x1.25_c20170616.nc', + 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SO2_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', + 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', + 'SOAE -> 2.5592D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'SOAE -> 2.5592D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_BENZENE_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SOAE -> 0.5954D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_ISOP_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SOAE -> 5.1004D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_MTERP_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SOAE -> 8.2367D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'SOAE -> 8.2367D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_TOLUENE_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SOAE -> 6.5013D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'SOAE -> 6.5013D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_XYLENES_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SOAE -> 8.5371D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'SOAE -> 8.5371D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_IVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc', + 'SOAE -> 16.650D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_anthro_surface_2000climo_0.9x1.25_c20170608.nc', + 'SOAE -> 16.650D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_SVOC_bb_surface_2000climo_0.9x1.25_c20170322.nc' + -.true. +.true. .true. 1, 30, 120, 240, 240, 480, 365, 73, 30 @@ -106,7 +107,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', + 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', 'UTGWSPEC', 'VTGWSPEC', 'BUTGWSPEC', 'AODVISstdn', 'AODVISdn', 'KVH_CLUBB', 'KVH', 'TTENDICE', 'QVTENDICE', 'QCTENDICE', 'NCTENDICE', 'FQTENDICE', 'MASS' @@ -116,9 +117,9 @@ - + 'BTAUN', 'BTAUS', 'BTAUE', 'BTAUW', 'BTAUNET', 'BUTEND1', 'BUTEND2', 'BUTEND3', 'BUTEND4', 'BUTEND5', 'BVTGWSPEC', - 'MAXQ0', 'HDEPTH', 'NETDT', 'TAUN', 'TAUS', 'TAUE', 'TAUW', 'TAUGWX', 'TAUGWY', 'UTEND1', 'UTEND2', 'UTEND3', + 'MAXQ0', 'HDEPTH', 'NETDT', 'TAUN', 'TAUS', 'TAUE', 'TAUW', 'TAUGWX', 'TAUGWY', 'UTEND1', 'UTEND2', 'UTEND3', 'UTEND4', 'UTEND5', 'FRONTGF', 'FRONTGFA', 'EKGW', 'QNO', 'QRLNLTE', 'QRL_TOT', 'DUV', 'DVV', 'TTPXMLC' 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 66b7f3d951..9b168bbef2 100644 --- a/bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml @@ -20,15 +20,9 @@ atm/waccm/lb/LBC_2010climo_CMIP6_0p5degLat_c180227.nc 'CO2','CH4','N2O','CFC11','CFC12','CFC11eq' - -.true. -.false. -.false. -atm/waccm/qbo/qbocoefficients_c151023.nc - -FIXED -20100101 +CYCLICAL +2010 SCWACCM_forcing_WACCM6_zm_5day_L70_1975-2014_c191121.nc atm/waccm/waccm_forcing @@ -56,8 +50,8 @@ -CYCLICAL -2010 +CYCLICAL +2010 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a1_anthro-ene_vertical_2010climo_0.9x1.25_c20180918.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_a1_so4_contvolcano_vertical_2010climo_0.9x1.25_c20170724.nc', @@ -71,11 +65,10 @@ CYCLICAL 2010 - + 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_bc_a4_anthro_surface_2010climo_0.9x1.25_c20180918.nc', 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_bc_a4_bb_surface_2010climo_0.9x1.25_c20180918.nc', 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_DMS_bb_surface_2010climo_0.9x1.25_c20180918.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_DMS_other_surface_2010climo_0.9x1.25_c20180918.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a1_bb_surface_2010climo_0.9x1.25_c20180918.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2010climo_0.9x1.25_c20180918.nc', 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2010climo_0.9x1.25_c20180918.nc', @@ -84,17 +77,29 @@ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_pom_a4_anthro_surface_2010climo_0.9x1.25_c20180918.nc', 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_pom_a4_bb_surface_2010climo_0.9x1.25_c20180918.nc', 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_pom_a4_anthro_surface_2010climo_0.9x1.25_c20180918.nc', - 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_pom_a4_bb_surface_2010climo_0.9x1.25_c20180918.nc', + 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_pom_a4_bb_surface_2010climo_0.9x1.25_c20180918.nc ', 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SO2_anthro-ag-ship-res_surface_2010climo_0.9x1.25_c20180918.nc', 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SO2_anthro-ene_surface_2010climo_0.9x1.25_c20180918.nc', 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SO2_bb_surface_2010climo_0.9x1.25_c20180918.nc', 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_so4_a1_anthro-ag-ship_surface_2010climo_0.9x1.25_c20180918.nc', 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_so4_a1_bb_surface_2010climo_0.9x1.25_c20180918.nc', 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_so4_a2_anthro-res_surface_2010climo_0.9x1.25_c20180918.nc', - 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SOAGx1.5_anthro_surface_2010climo_0.9x1.25_c20180918.nc', - 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SOAGx1.5_bb_surface_2010climo_0.9x1.25_c20180918.nc', - 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SOAGx1.5_biogenic_surface_2010climo_0.9x1.25_c20180918.nc' - + 'SOAE -> 2.5592D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_BENZENE_anthro_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 2.5592D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_BENZENE_bb_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 0.5954D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_ISOP_bb_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 5.1004D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_MTERP_bb_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 8.2367D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_TOLUENE_anthro_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 8.2367D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_TOLUENE_bb_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 6.5013D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_XYLENES_anthro_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 6.5013D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_XYLENES_bb_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 8.5371D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_IVOC_anthro_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 8.5371D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_IVOC_bb_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 16.650D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SVOC_anthro_surface_2010climo_0.9x1.25_c20180918.nc', + 'SOAE -> 16.650D0*$INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_SVOC_bb_surface_2010climo_0.9x1.25_c20180918.nc' + + +CYCLICAL +2010 .true. @@ -105,7 +110,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', + 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', 'UTGWSPEC', 'VTGWSPEC', 'BUTGWSPEC', 'AODVISstdn', 'AODVISdn', 'KVH_CLUBB', 'KVH', 'TTENDICE', 'QVTENDICE', 'QCTENDICE', 'NCTENDICE', 'FQTENDICE', 'MASS' @@ -117,7 +122,7 @@ 'BTAUN', 'BTAUS', 'BTAUE', 'BTAUW', 'BTAUNET', 'BUTEND1', 'BUTEND2', 'BUTEND3', 'BUTEND4', 'BUTEND5', 'BVTGWSPEC', - 'MAXQ0', 'HDEPTH', 'NETDT', 'TAUN', 'TAUS', 'TAUE', 'TAUW', 'TAUGWX', 'TAUGWY', 'UTEND1', 'UTEND2', 'UTEND3', + 'MAXQ0', 'HDEPTH', 'NETDT', 'TAUN', 'TAUS', 'TAUE', 'TAUW', 'TAUGWX', 'TAUGWY', 'UTEND1', 'UTEND2', 'UTEND3', 'UTEND4', 'UTEND5', 'FRONTGF', 'FRONTGFA', 'EKGW', 'QNO', 'QRLNLTE', 'QRL_TOT', 'DUV', 'DVV', 'TTPXMLC' diff --git a/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml b/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml index a7d030ef56..3c2583af96 100644 --- a/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml @@ -19,12 +19,6 @@ 'SERIAL' 'CO2','CH4','N2O','CFC11','CFC12','CFC11eq' - -.true. -.false. -.false. -atm/waccm/qbo/qbocoefficients_c151023.nc - INTERP_MISSING_MONTHS SCWACCM_forcing_zm_L70_1849-2015_CMIP6ensAvg_c181011.nc @@ -54,6 +48,7 @@ INTERP_MISSING_MONTHS +SERIAL .true. @@ -64,7 +59,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', + 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', 'UTGWSPEC', 'VTGWSPEC', 'BUTGWSPEC', 'AODVISstdn', 'AODVISdn', 'KVH_CLUBB', 'KVH', 'TTENDICE', 'QVTENDICE', 'QCTENDICE', 'NCTENDICE', 'FQTENDICE', 'MASS' @@ -76,7 +71,7 @@ 'BTAUN', 'BTAUS', 'BTAUE', 'BTAUW', 'BTAUNET', 'BUTEND1', 'BUTEND2', 'BUTEND3', 'BUTEND4', 'BUTEND5', 'BVTGWSPEC', - 'MAXQ0', 'HDEPTH', 'NETDT', 'TAUN', 'TAUS', 'TAUE', 'TAUW', 'TAUGWX', 'TAUGWY', 'UTEND1', 'UTEND2', 'UTEND3', + 'MAXQ0', 'HDEPTH', 'NETDT', 'TAUN', 'TAUS', 'TAUE', 'TAUW', 'TAUGWX', 'TAUGWY', 'UTEND1', 'UTEND2', 'UTEND3', 'UTEND4', 'UTEND5', 'FRONTGF', 'FRONTGFA', 'EKGW', 'QNO', 'QRLNLTE', 'QRL_TOT', 'DUV', 'DVV', 'TTPXMLC' diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml index 1a501a5d02..eefbf88163 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml @@ -37,13 +37,6 @@ atm/waccm/ub/tgcm_ubc_1850_c100204.nc CYCLICAL - -.true. -.true. -.true. -.false. - - CYCLICAL @@ -52,8 +45,6 @@ CYCLICAL 1850 -'noy', 'nhx' - 1, 5, 20, 40, 120, 240, 365, 73, 365 @@ -63,122 +54,66 @@ .true. .false. .false. -.false. +.true. .false. .false. .true. .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF', 'NO2_CLXF' + 'NO2_CMXF', 'NO2_CLXF' - 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST1', 'AODdnDUST2', - 'AODdnDUST3', 'AODdnMODE1', 'AODdnMODE2', 'AODdnMODE3', 'AODDUST2', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', - 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', - 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', - 'bc_c4SFWET', 'BENZENE', 'BENZO2', 'BENZOOH', 'BEPOMUC', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALD', 'BIGALK', 'BIGENE', - 'BR', 'BRCL', 'BRO', 'BRONO2', 'BROX', 'BROY', 'BRY', 'BTTGWSPEC', 'BTTGWSDF', 'BTTGWSKE', - 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', - 'BURDENSOAdn', 'BUTGWSPEC', 'BZALD', 'BZOO', 'BZOOH', 'C2H2', 'C2H4', 'C2H5O2', 'C2H5OH', 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7O2', - 'C3H7OOH', 'C3H8', 'C6H5O2', 'C6H5OOH', 'CCL4', 'CDNUMC', 'CF2CLBR', 'CF3BR', 'CFC113', 'CFC114', 'CFC115', 'CFC11', 'CFC11STAR', - 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CCL3_CHML', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3CO3', 'CH3COCH3', 'CH3COCHO', - 'CH3COOH', 'CH3COOOH', 'CH3O2', 'CH3OH', 'CH3OOH', 'CH4', 'CH4_CHML', 'CHBR3', 'CL2', 'CL2O2', 'CL', - 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CLOX', 'CLOY', 'CLY', 'CME', 'CMFDQ', 'CMFMC', - 'CMFMCDZM', 'CO2', 'CO2_CHML', 'CO', 'CO_CHML', 'CO_CHMP', 'COF2', 'COFCL', 'CONCLD', 'CRESOL', - 'DCOCHM', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', - 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', - 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', - 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', - 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'DF_NH3', 'DF_NH4', 'DF_NO2', 'DF_NO', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', - 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', - 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', 'DF_XYLENOOH', - 'DF_XYLOLOOH', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'DH2O2CHM', 'DHNO3CHM', 'DICARBO2', 'DMS', 'DO3CHM', 'dry_deposition_NHx_as_N', - 'dry_deposition_NOy_as_N', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'dst_a1', 'dst_a1DDF', 'dst_a1SFWET', 'dst_a2', 'dst_a2DDF', - 'dst_a2SFWET', 'dst_a3', 'dst_a3DDF', 'dst_a3SFWET', 'dst_c1', 'dst_c1DDF', 'dst_c1SFWET', 'dst_c2', 'dst_c2DDF', 'dst_c2SFWET', - 'dst_c3', 'dst_c3DDF', 'dst_c3SFWET', 'DTCORE', 'E90', 'e', 'ENEO2', 'EO2', 'EO', 'EOOH', 'EVAPPREC', - 'EVAPQZM', 'EVAPTZM', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'F', 'FCTL', - 'FLASHFRQ', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FREQI', 'FREQL', 'FREQZM', 'FSDS', - 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'FSNTOAC', 'FSUTOA', 'GLYALD', 'GLYOXAL', - 'GS_SO2', 'H2402', 'H2', 'H2O2', 'H2O', 'H2SO4', 'H2SO4M_C', 'H2SO4_sfnnuc1', 'H', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', 'HCL', - 'HCL_GAS', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS', 'HO2', 'HO2NO2', 'HOBR', 'HOCH2OO', 'HOCL', 'HONITR', - 'HPALD', 'HYAC', 'HYDRALD', 'ICEFRAC', 'IEPOX', 'ISOP', 'ISOPAO2', 'ISOPBO2', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', - 'ISOPNOOH', 'ISOPOOH', 'IVOC', 'IVOC_CHML', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', 'KVH_CLUBB', - 'LANDFRAC', 'LHFLX', 'LNO_COL_PROD', 'LNO_PROD', 'MACR', 'MACRO2', 'MACROOH', 'MALO2', 'MASS', 'MCO3', 'MDIALO2', - 'MEG_BCARY', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_C2H4', 'MEG_C2H5OH', 'MEG_C2H6', 'MEG_C3H6', 'MEG_C3H8', 'MEG_CH2O', - 'MEG_CH3CHO', 'MEG_CH3COCH3', 'MEG_CH3COOH', 'MEG_CH3OH', 'MEG_CO', 'MEG_HCN', 'MEG_HCOOH', 'MEG_ISOP', 'MEG_MTERP', 'MEG_TOLUENE', - 'MEK', 'MEKO2', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', 'N2D', 'N2O5', 'N2O', 'N2O_CHML', 'N2p', 'N', 'NC4CH2OH', - 'NC4CHO', 'ncl_a1', 'ncl_a1DDF', 'ncl_a1SFWET', 'ncl_a2', 'ncl_a2DDF', 'ncl_a2SFWET', 'ncl_a3', 'ncl_a3DDF', 'ncl_a3SFWET', 'ncl_c1', - 'ncl_c1DDF', 'ncl_c1SFWET', 'ncl_c2', 'ncl_c2DDF', 'ncl_c2SFWET', 'ncl_c3', 'ncl_c3DDF', 'ncl_c3SFWET', 'NDEP', 'NH3', 'NH4', 'NH_50', - 'NH_5', 'NHDEP', 'NITROP_PD', 'NO2', 'NO2_CLXF', 'NO3', 'NO', 'NOA', 'NOp', 'NOX', 'NOY', 'Np', 'NTERPO2', 'NTERPOOH', - 'num_a1', 'num_a1_CLXF', 'num_a1DDF', 'num_a2', 'num_a2_CLXF', 'num_a2DDF', 'num_a2_sfnnuc1', 'num_a3', 'num_a3DDF', 'num_a4', - 'num_a4DDF', 'num_c1', 'num_c1DDF', 'num_c2', 'num_c2DDF', 'num_c3', 'num_c3DDF', 'num_c4', 'num_c4DDF', 'NUMLIQ', 'O1D', 'O2_1D', - 'O2_1S', 'O2', 'O2p', 'O3', 'O3S', 'O3_CHML', 'O3_CHMP', 'O', 'OCLO', 'OCS', 'OH', 'OMEGA', 'OMEGAT', 'ONITR', 'Op', - 'PAN', 'PBLH', 'PBZNIT', 'PDELDRY', 'PHENO2', 'PHENO', 'PHENOL', 'PHENOOH', 'PHIS', 'PM25', 'PO2', 'pom_a1', 'pom_a1DDF', 'pom_a1SFWET', - 'pom_a4', 'pom_a4DDF', 'pom_a4SFWET', 'pom_c1', 'pom_c1DDF', 'pom_c1SFWET', 'pom_c4', 'pom_c4DDF', 'pom_c4SFWET', - 'POOH', 'PRECC', 'PRECT', 'PS', 'PSL', 'PTEQ', 'PTTEND', 'Q', 'QFLX', 'QRAIN', 'QREFHT', 'QRL', 'QRLC', 'QRS', - 'QRSC', 'QSNOW', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RELHUM', 'r_GLYOXAL_aer', - 'r_het10', 'r_het11', 'r_het12', 'r_het13', 'r_het15', 'r_het16', 'r_het17', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', - 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_HO2_O3', 'RHREFHT', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', - 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', - 'r_OH_O3', 'r_OH_O', 'ROOH', 'RO2', - 'S', 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP', 'SF6', 'SFbc_a4', 'SFBCARY', - 'SFBENZENE', 'SFBIGALK', 'SFBIGENE', 'SFC2H2', 'SFC2H4', 'SFC2H5OH', 'SFC2H6', 'SFC3H6', 'SFC3H8', 'SFCH2O', 'SFCH3CHO', 'SFCH3CN', - 'SFCH3COCH3', 'SFCH3COCHO', 'SFCH3COOH', 'SFCH3OH', 'SFCO', 'SFDMS', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', 'SFGLYALD', 'SFHCN', 'SFHCOOH', - 'SFISOP', 'SFIVOC', 'SFMEK', 'SFMTERP', 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'SFNH3', 'SFNO2', 'SFNO', 'SFnum_a1', 'SFnum_a2', - 'SFnum_a3', 'SFpom_a4', 'SFSO2', 'SFso4_a1', 'SFso4_a2', 'SFSVOC', 'SFTOLUENE', 'SFXYLENES', 'SHFLX', 'SO2', - 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SO2_XFRC', 'SO3', 'so4_a1', 'so4_a1_CHMP', 'so4_a1_CLXF', 'so4_a1DDF', 'so4_a1_sfgaex1', 'so4_a1SFWET', - 'so4_a2', 'so4_a2_CHMP', 'so4_a2_CLXF', 'so4_a2DDF', 'so4_a2_sfgaex1', 'so4_a2_sfnnuc1', 'so4_a2SFWET', 'so4_a3', - 'so4_a3DDF', 'so4_a3_sfgaex1', 'so4_a3SFWET', 'so4_c1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_c1SFWET', 'so4_c2', 'so4_c2AQH2SO4', - 'so4_c2AQSO4', 'so4_c2DDF', 'so4_c2SFWET', 'so4_c3', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_c3SFWET', 'SO', 'soa1_a1', - 'soa1_a1_CHML', 'soa1_a1DDF', 'soa1_a1_sfgaex1', 'soa1_a1SFWET', 'soa1_a2', 'soa1_a2_CHML', 'soa1_a2DDF', - 'soa1_a2_sfgaex1', 'soa1_a2SFWET', 'soa1_c1', 'soa1_c1DDF', 'soa1_c1SFWET', 'soa1_c2', 'soa1_c2DDF', 'soa1_c2SFWET', 'soa2_a1', 'soa2_a1_CHML', - 'soa2_a1DDF', 'soa2_a1_sfgaex1', 'soa2_a1SFWET', 'soa2_a2', 'soa2_a2_CHML', 'soa2_a2DDF', 'soa2_a2_sfgaex1', - 'soa2_a2SFWET', 'soa2_c1', 'soa2_c1DDF', 'soa2_c1SFWET', 'soa2_c2', 'soa2_c2DDF', 'soa2_c2SFWET', 'soa3_a1', 'soa3_a1_CHML', - 'soa3_a1DDF', 'soa3_a1_sfgaex1', 'soa3_a1SFWET', 'soa3_a2', 'soa3_a2_CHML', 'soa3_a2DDF', 'soa3_a2_sfgaex1', 'soa3_a2SFWET', - 'soa3_c1', 'soa3_c1DDF', 'soa3_c1SFWET', 'soa3_c2', 'soa3_c2DDF', 'soa3_c2SFWET', 'soa4_a1', 'soa4_a1_CHML', 'soa4_a1DDF', - 'soa4_a1_sfgaex1', 'soa4_a1SFWET', 'soa4_a2', 'soa4_a2_CHML', 'soa4_a2DDF', 'soa4_a2_sfgaex1', 'soa4_a2SFWET', 'soa4_c1', - 'soa4_c1DDF', 'soa4_c1SFWET', 'soa4_c2', 'soa4_c2DDF', 'soa4_c2SFWET', 'soa5_a1', 'soa5_a1_CHML', 'soa5_a1DDF', 'soa5_a1_sfgaex1', - 'soa5_a1SFWET', 'soa5_a2', 'soa5_a2_CHML', 'soa5_a2DDF', 'soa5_a2_sfgaex1', 'soa5_a2SFWET', 'soa5_c1', 'soa5_c1DDF', - 'soa5_c1SFWET', 'soa5_c2', 'soa5_c2DDF', 'soa5_c2SFWET', 'SOAG0', 'SOAG0_CHMP', 'SOAG1', 'SOAG1_CHMP', 'SOAG2', 'SOAG2_CHMP', - 'SOAG3', 'SOAG3_CHMP', 'SOAG4', 'SOAG4_CHMP', 'SOLIN', 'SOLLD', 'SOLSD', 'SSAVIS', 'SST', 'ST80_25', 'SVOC', 'SVOC_CHML', - 'T', 'TAQ', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', 'TBRY', 'TCLY', 'TEPOMUC', 'TERP2O2', 'TERP2OOH', - 'TERPNIT', 'TERPO2', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TGCLDIWP', 'TGCLDLWP', 'THzm', 'TMDMS', 'TMOCS', 'TMQ', 'TMSO2', - 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'TOLO2', 'TOLOOH', 'TOLUENE', 'TOT_CLD_VISTAU', 'TOTH', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TROP_P', - 'TROP_T', 'TROP_Z', 'TS', 'TSMN:M', 'TSMX:X', 'TTEND_TOT', 'TTGWORO', 'TTGWSDF', 'TTGWSDFORO', 'TTGWSKE', 'TTGWSKEORO', 'TTGWSPEC', - 'U10', 'U', 'UTGWORO', 'UTGWSPEC', 'UU', 'UVzm', 'UWzm', 'Uzm', 'V', 'VD01', 'VEL_NAT2', 'VTHzm', 'VV', 'Vzm', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', - 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCH3', 'WD_CH3COCHO', - 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', - 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', - 'WD_HYDRALD', 'WD_IEPOX', 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', - 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', - 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', - 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', - 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'Wzm', 'XO2', 'XOOH', 'XYLENES', 'XYLENO2', 'XYLENOOH', 'XYLOL', 'XYLOLO2', - 'XYLOLOOH', 'Z3', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU', + 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', + 'BTTGWSPEC', 'BTTGWSDF', 'BTTGWSKE', 'CONCLD', 'CME', 'CMFDQ', 'CMFMC', 'CMFMC_DP', + 'CH3CCL3_CHML', 'CH4_CHML', 'CO2_CHML', 'CO_CHML', 'IVOC_CHML', 'N2O_CHML', 'O3_CHML', 'SO2_CHML', + 'CO_CHMP', 'O3_CHMP', 'SO2_CHMP', 'TMDMS', 'TMOCS', 'TMSO2','TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'soa1_a1_CHML', 'soa1_a2_CHML', 'soa2_a1_CHML', 'soa2_a2_CHML', 'soa3_a1_CHML', 'soa3_a2_CHML', + 'soa4_a1_CHML', 'soa4_a2_CHML', 'soa5_a1_CHML', 'soa5_a2_CHML', 'SVOC_CHML', + 'so4_a1_CHMP','so4_a2_CHMP', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'TOTH', 'TOT_CLD_VISTAU', + 'TREFHTMN', 'TREFHTMX', 'TROP_P', 'TROP_T', 'TROP_Z', 'TTEND_TOT', 'TTGWORO', 'TTGWSDF', 'TTGWSDFORO', 'TTGWSKE', 'TTGWSKEORO', + 'TS', 'TSMN:M', 'TSMX:X', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', + 'ABSORB', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODdn_aitken', 'AODdn_accum', 'AODdn_coarse', + 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', + 'AODVISdn', 'AODVISstdn', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'FLDSC', 'FLNR', 'FSNR', + 'CME', 'CMFDQ', 'CMFMC','CMFMC_DP', 'SOLLD', 'SOLSD', 'SSAVIS', 'SST','TAQ', + 'DCOCHM','DH2O2CHM', 'DHNO3CHM', 'DO3CHM', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', + 'FLASHFRQ', 'LNO_COL_PROD', 'LNO_PROD','KVH_CLUBB','MASS', 'PDELDRY', 'NITROP_PD','PM25', 'PRECT', 'PTEQ', 'PTTEND', + 'QRLC', 'QRSC', 'QSNOW', 'QRAIN','GS_SO2', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS','H2SO4M_C', 'H2SO4_sfnnuc1','HCL_GAS', + 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP' 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RHREFHT', + 'EVAPPREC', 'EVAPQZM', 'EVAPTZM', 'FCTL','FREQZM', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU','VEL_NAT2', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', 'dst_c3DDF', + 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'num_c1DDF','num_c2DDF','num_c3DDF','num_c4DDF', + 'so4_a1_sfgaex1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_a2_sfgaex1', 'so4_c2AQH2SO4', 'so4_c2AQSO4', 'so4_c2DDF', + 'so4_a3_sfgaex1', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_a2_sfnnuc1', 'num_a2_sfnnuc1', + 'soa1_a1_sfgaex1','soa1_c1DDF', 'soa1_a2_sfgaex1','soa1_c2DDF', 'soa2_a1_sfgaex1','soa2_c1DDF', 'soa2_a2_sfgaex1','soa2_c2DDF', + 'soa3_a1_sfgaex1','soa3_c1DDF', 'soa3_a2_sfgaex1','soa3_c2DDF', 'soa4_a1_sfgaex1','soa4_c1DDF', 'soa4_a2_sfgaex1','soa4_c2DDF', + 'soa5_a1_sfgaex1','soa5_c1DDF', 'soa5_a2_sfgaex1','soa5_c2DDF', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', + 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_het10', 'r_het11', 'r_het12', 'r_het13', + 'r_het15', 'r_het16', 'r_het17', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', + 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_GLYOXAL_aer', 'r_HO2_O3', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', 'r_OH_O3', 'r_OH_O', 'O3_Prod','O3_Loss','O3S_Loss','RO2_NO_sum','O3_alkenes','RO2_NO3_sum','RO2_HO2_sum','RO2_RO2_sum','RCO2_NO2_sum', - 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', - 'Ox_Prod','Ox_Loss' + 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', 'Ox_Prod','Ox_Loss' - 'ACTNL', 'ACTREL', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BUTGWSPEC', - 'CDNUMC', 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLOUD', 'CMFMC', 'CMFMCDZM', 'FCTL', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', - 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FSDS', 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNTOA', 'FSNTOAC', 'LHFLX', 'MASS', 'O3', 'OMEGA', - 'OMEGA500', 'PBLH', 'PDELDRY', 'PM25_SRF', 'PRECC', 'PRECT', 'PS', 'PSL', 'Q', 'QREFHT', 'QSNOW', 'RELHUM', 'RHREFHT', 'SHFLX', - 'SOLIN', 'SOLLD', 'SOLSD', 'T', 'T500', 'T700', 'T850', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', - 'TGCLDIWP', 'TGCLDLWP', 'TMQ', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TS', 'TSMN:M', 'TSMX:X', 'U', 'U10', 'UTGWORO', 'UTGWSPEC', + 'ACTNL', 'ACTREL', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BUTGWSPEC', + 'CDNUMC', 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLOUD', 'CMFMC', 'CMFMC_DP', 'FCTL', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', + 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FSDS', 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNTOA', 'FSNTOAC', 'LHFLX', 'MASS', 'O3', 'OMEGA', + 'OMEGA500', 'PBLH', 'PDELDRY', 'PM25_SRF', 'PRECC', 'PRECT', 'PS', 'PSL', 'Q', 'QREFHT', 'QSNOW', 'RELHUM', 'RHREFHT', 'SHFLX', + 'SOLIN', 'SOLLD', 'SOLSD', 'T', 'T500', 'T700', 'T850', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'TGCLDIWP', 'TGCLDLWP', 'TMQ', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TS', 'TSMN:M', 'TSMX:X', 'U', 'U10', 'UTGWORO', 'UTGWSPEC', 'V', 'Z3', 'Z500' - + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' - + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', 'REFF_AERO', 'SAD_AERO', 'NITROP_PD', 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' - + 1850 diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml index 2577229a4e..fa5848ea40 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml @@ -37,12 +37,9 @@ atm/waccm/ub/tgcm_ubc.2000.c100203.nc CYCLICAL - -.true. -.true. -.true. -.false. - + +.true. +atm/waccm/qbo/qbocyclic28months.nc @@ -146,7 +143,6 @@ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_anthro_surface_2000climo_0.9x1.25_c20170608.nc', 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_bc_a4_bb_surface_2000climo_0.9x1.25_c20170322.nc', 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_bb_surface_2000climo_0.9x1.25_c20170322.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_DMS_other_surface_2000climo_0.9x1.25_c20170322.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_bb_surface_2000climo_0.9x1.25_c20170322.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_0.9x1.25_c20170616.nc', 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_0.9x1.25_c20170616.nc', @@ -229,7 +225,6 @@ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_bc_a4_anthro_surface_2000climo_1.9x2.5_c20200422.nc', 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_bc_a4_bb_surface_2000climo_1.9x2.5_c20200422.nc', 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_DMS_bb_surface_2000climo_1.9x2.5_c20200422.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_DMS_other_surface_2000climo_1.9x2.5_c20200422.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_num_so4_a1_bb_surface_2000climo_1.9x2.5_c20200422.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2000climo_1.9x2.5_c20200422.nc', 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_num_so4_a2_anthro-res_surface_2000climo_1.9x2.5_c20200422.nc', @@ -247,8 +242,6 @@ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2000climo_2deg/emissions-cmip6_so4_a2_anthro-res_surface_2000climo_1.9x2.5_c20200422.nc' -'noy', 'nhx' - 1, 5, 20, 40, 120, 240, 365, 73, 365 @@ -258,120 +251,64 @@ .true. .false. .false. -.false. +.true. .false. .false. .true. .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' + 'NO2_CMXF' - 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST1', 'AODdnDUST2', - 'AODdnDUST3', 'AODdnMODE1', 'AODdnMODE2', 'AODdnMODE3', 'AODDUST2', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', - 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', - 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', - 'bc_c4SFWET', 'BENZENE', 'BENZO2', 'BENZOOH', 'BEPOMUC', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALD', 'BIGALK', 'BIGENE', - 'BR', 'BRCL', 'BRO', 'BRONO2', 'BROX', 'BROY', 'BRY', 'BTTGWSPEC', 'BTTGWSDF', 'BTTGWSKE', - 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', - 'BURDENSOAdn', 'BUTGWSPEC', 'BZALD', 'BZOO', 'BZOOH', 'C2H2', 'C2H4', 'C2H5O2', 'C2H5OH', 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7O2', - 'C3H7OOH', 'C3H8', 'C6H5O2', 'C6H5OOH', 'CCL4', 'CDNUMC', 'CF2CLBR', 'CF3BR', 'CFC113', 'CFC114', 'CFC115', 'CFC11', 'CFC11STAR', - 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CCL3_CHML', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3CO3', 'CH3COCH3', 'CH3COCHO', - 'CH3COOH', 'CH3COOOH', 'CH3O2', 'CH3OH', 'CH3OOH', 'CH4', 'CH4_CHML', 'CHBR3', 'CL2', 'CL2O2', 'CL', - 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CLOX', 'CLOY', 'CLY', 'CME', 'CMFDQ', 'CMFMC', - 'CMFMCDZM', 'CO2', 'CO2_CHML', 'CO', 'CO_CHML', 'CO_CHMP', 'COF2', 'COFCL', 'CONCLD', 'CRESOL', - 'DCOCHM', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', - 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', - 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', - 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', - 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'DF_NH3', 'DF_NH4', 'DF_NO2', 'DF_NO', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', - 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', - 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', 'DF_XYLENOOH', - 'DF_XYLOLOOH', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'DH2O2CHM', 'DHNO3CHM', 'DICARBO2', 'DMS', 'DO3CHM', 'dry_deposition_NHx_as_N', - 'dry_deposition_NOy_as_N', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'dst_a1', 'dst_a1DDF', 'dst_a1SFWET', 'dst_a2', 'dst_a2DDF', - 'dst_a2SFWET', 'dst_a3', 'dst_a3DDF', 'dst_a3SFWET', 'dst_c1', 'dst_c1DDF', 'dst_c1SFWET', 'dst_c2', 'dst_c2DDF', 'dst_c2SFWET', - 'dst_c3', 'dst_c3DDF', 'dst_c3SFWET', 'DTCORE', 'E90', 'e', 'ENEO2', 'EO2', 'EO', 'EOOH', 'EVAPPREC', - 'EVAPQZM', 'EVAPTZM', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'F', 'FCTL', - 'FLASHFRQ', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FREQI', 'FREQL', 'FREQZM', 'FSDS', - 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'FSNTOAC', 'FSUTOA', 'GLYALD', 'GLYOXAL', - 'GS_SO2', 'H2402', 'H2', 'H2O2', 'H2O', 'H2SO4', 'H2SO4M_C', 'H2SO4_sfnnuc1', 'H', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', 'HCL', - 'HCL_GAS', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS', 'HO2', 'HO2NO2', 'HOBR', 'HOCH2OO', 'HOCL', 'HONITR', - 'HPALD', 'HYAC', 'HYDRALD', 'ICEFRAC', 'IEPOX', 'ISOP', 'ISOPAO2', 'ISOPBO2', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', - 'ISOPNOOH', 'ISOPOOH', 'IVOC', 'IVOC_CHML', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', 'KVH_CLUBB', - 'LANDFRAC', 'LHFLX', 'LNO_COL_PROD', 'LNO_PROD', 'MACR', 'MACRO2', 'MACROOH', 'MALO2', 'MASS', 'MCO3', 'MDIALO2', - 'MEG_BCARY', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_C2H4', 'MEG_C2H5OH', 'MEG_C2H6', 'MEG_C3H6', 'MEG_C3H8', 'MEG_CH2O', - 'MEG_CH3CHO', 'MEG_CH3COCH3', 'MEG_CH3COOH', 'MEG_CH3OH', 'MEG_CO', 'MEG_HCN', 'MEG_HCOOH', 'MEG_ISOP', 'MEG_MTERP', 'MEG_TOLUENE', - 'MEK', 'MEKO2', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', 'N2D', 'N2O5', 'N2O', 'N2O_CHML', 'N2p', 'N', 'NC4CH2OH', - 'NC4CHO', 'ncl_a1', 'ncl_a1DDF', 'ncl_a1SFWET', 'ncl_a2', 'ncl_a2DDF', 'ncl_a2SFWET', 'ncl_a3', 'ncl_a3DDF', 'ncl_a3SFWET', 'ncl_c1', - 'ncl_c1DDF', 'ncl_c1SFWET', 'ncl_c2', 'ncl_c2DDF', 'ncl_c2SFWET', 'ncl_c3', 'ncl_c3DDF', 'ncl_c3SFWET', 'NDEP', 'NH3', 'NH4', 'NH_50', - 'NH_5', 'NHDEP', 'NITROP_PD', 'NO2', 'NO2_CLXF', 'NO3', 'NO', 'NOA', 'NOp', 'NOX', 'NOY', 'Np', 'NTERPO2', 'NTERPOOH', - 'num_a1', 'num_a1_CLXF', 'num_a1DDF', 'num_a2', 'num_a2_CLXF', 'num_a2DDF', 'num_a2_sfnnuc1', 'num_a3', 'num_a3DDF', 'num_a4', - 'num_a4DDF', 'num_c1', 'num_c1DDF', 'num_c2', 'num_c2DDF', 'num_c3', 'num_c3DDF', 'num_c4', 'num_c4DDF', 'NUMLIQ', 'O1D', 'O2_1D', - 'O2_1S', 'O2', 'O2p', 'O3', 'O3S', 'O3_CHML', 'O3_CHMP', 'O', 'OCLO', 'OCS', 'OH', 'OMEGA', 'OMEGAT', 'ONITR', 'Op', - 'PAN', 'PBLH', 'PBZNIT', 'PDELDRY', 'PHENO2', 'PHENO', 'PHENOL', 'PHENOOH', 'PHIS', 'PM25', 'PO2', 'pom_a1', 'pom_a1DDF', 'pom_a1SFWET', - 'pom_a4', 'pom_a4DDF', 'pom_a4SFWET', 'pom_c1', 'pom_c1DDF', 'pom_c1SFWET', 'pom_c4', 'pom_c4DDF', 'pom_c4SFWET', - 'POOH', 'PRECC', 'PRECT', 'PS', 'PSL', 'PTEQ', 'PTTEND', 'Q', 'QFLX', 'QRAIN', 'QREFHT', 'QRL', 'QRLC', 'QRS', - 'QRSC', 'QSNOW', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RELHUM', 'r_GLYOXAL_aer', - 'r_het10', 'r_het11', 'r_het12', 'r_het13', 'r_het15', 'r_het16', 'r_het17', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', - 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_HO2_O3', 'RHREFHT', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', - 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', - 'r_OH_O3', 'r_OH_O', 'ROOH', 'RO2', - 'S', 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP', 'SF6', 'SFbc_a4', 'SFBCARY', - 'SFBENZENE', 'SFBIGALK', 'SFBIGENE', 'SFC2H2', 'SFC2H4', 'SFC2H5OH', 'SFC2H6', 'SFC3H6', 'SFC3H8', 'SFCH2O', 'SFCH3CHO', 'SFCH3CN', - 'SFCH3COCH3', 'SFCH3COCHO', 'SFCH3COOH', 'SFCH3OH', 'SFCO', 'SFDMS', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', 'SFGLYALD', 'SFHCN', 'SFHCOOH', - 'SFISOP', 'SFIVOC', 'SFMEK', 'SFMTERP', 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'SFNH3', 'SFNO2', 'SFNO', 'SFnum_a1', 'SFnum_a2', - 'SFnum_a3', 'SFpom_a4', 'SFSO2', 'SFso4_a1', 'SFso4_a2', 'SFSVOC', 'SFTOLUENE', 'SFXYLENES', 'SHFLX', 'SO2', - 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SO2_XFRC', 'SO3', 'so4_a1', 'so4_a1_CHMP', 'so4_a1_CLXF', 'so4_a1DDF', 'so4_a1_sfgaex1', 'so4_a1SFWET', - 'so4_a2', 'so4_a2_CHMP', 'so4_a2_CLXF', 'so4_a2DDF', 'so4_a2_sfgaex1', 'so4_a2_sfnnuc1', 'so4_a2SFWET', 'so4_a3', - 'so4_a3DDF', 'so4_a3_sfgaex1', 'so4_a3SFWET', 'so4_c1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_c1SFWET', 'so4_c2', 'so4_c2AQH2SO4', - 'so4_c2AQSO4', 'so4_c2DDF', 'so4_c2SFWET', 'so4_c3', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_c3SFWET', 'SO', 'soa1_a1', - 'soa1_a1_CHML', 'soa1_a1DDF', 'soa1_a1_sfgaex1', 'soa1_a1SFWET', 'soa1_a2', 'soa1_a2_CHML', 'soa1_a2DDF', - 'soa1_a2_sfgaex1', 'soa1_a2SFWET', 'soa1_c1', 'soa1_c1DDF', 'soa1_c1SFWET', 'soa1_c2', 'soa1_c2DDF', 'soa1_c2SFWET', 'soa2_a1', 'soa2_a1_CHML', - 'soa2_a1DDF', 'soa2_a1_sfgaex1', 'soa2_a1SFWET', 'soa2_a2', 'soa2_a2_CHML', 'soa2_a2DDF', 'soa2_a2_sfgaex1', - 'soa2_a2SFWET', 'soa2_c1', 'soa2_c1DDF', 'soa2_c1SFWET', 'soa2_c2', 'soa2_c2DDF', 'soa2_c2SFWET', 'soa3_a1', 'soa3_a1_CHML', - 'soa3_a1DDF', 'soa3_a1_sfgaex1', 'soa3_a1SFWET', 'soa3_a2', 'soa3_a2_CHML', 'soa3_a2DDF', 'soa3_a2_sfgaex1', 'soa3_a2SFWET', - 'soa3_c1', 'soa3_c1DDF', 'soa3_c1SFWET', 'soa3_c2', 'soa3_c2DDF', 'soa3_c2SFWET', 'soa4_a1', 'soa4_a1_CHML', 'soa4_a1DDF', - 'soa4_a1_sfgaex1', 'soa4_a1SFWET', 'soa4_a2', 'soa4_a2_CHML', 'soa4_a2DDF', 'soa4_a2_sfgaex1', 'soa4_a2SFWET', 'soa4_c1', - 'soa4_c1DDF', 'soa4_c1SFWET', 'soa4_c2', 'soa4_c2DDF', 'soa4_c2SFWET', 'soa5_a1', 'soa5_a1_CHML', 'soa5_a1DDF', 'soa5_a1_sfgaex1', - 'soa5_a1SFWET', 'soa5_a2', 'soa5_a2_CHML', 'soa5_a2DDF', 'soa5_a2_sfgaex1', 'soa5_a2SFWET', 'soa5_c1', 'soa5_c1DDF', - 'soa5_c1SFWET', 'soa5_c2', 'soa5_c2DDF', 'soa5_c2SFWET', 'SOAG0', 'SOAG0_CHMP', 'SOAG1', 'SOAG1_CHMP', 'SOAG2', 'SOAG2_CHMP', - 'SOAG3', 'SOAG3_CHMP', 'SOAG4', 'SOAG4_CHMP', 'SOLIN', 'SOLLD', 'SOLSD', 'SSAVIS', 'SST', 'ST80_25', 'SVOC', 'SVOC_CHML', - 'T', 'TAQ', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', 'TBRY', 'TCLY', 'TEPOMUC', 'TERP2O2', 'TERP2OOH', - 'TERPNIT', 'TERPO2', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TGCLDIWP', 'TGCLDLWP', 'THzm', 'TMDMS', 'TMOCS', 'TMQ', 'TMSO2', - 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'TOLO2', 'TOLOOH', 'TOLUENE', 'TOT_CLD_VISTAU', 'TOTH', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TROP_P', - 'TROP_T', 'TROP_Z', 'TS', 'TSMN:M', 'TSMX:X', 'TTEND_TOT', 'TTGWORO', 'TTGWSDF', 'TTGWSDFORO', 'TTGWSKE', 'TTGWSKEORO', 'TTGWSPEC', - 'U10', 'U', 'UTGWORO', 'UTGWSPEC', 'UU', 'UVzm', 'UWzm', 'Uzm', 'V', 'VD01', 'VEL_NAT2', 'VTHzm', 'VV', 'Vzm', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', - 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCH3', 'WD_CH3COCHO', - 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', - 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', - 'WD_HYDRALD', 'WD_IEPOX', 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', - 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', - 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', - 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', - 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'Wzm', 'XO2', 'XOOH', 'XYLENES', 'XYLENO2', 'XYLENOOH', 'XYLOL', 'XYLOLO2', - 'XYLOLOOH', 'Z3', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU', + 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', + 'BTTGWSPEC', 'BTTGWSDF', 'BTTGWSKE', 'CONCLD', 'CME', 'CMFDQ', 'CMFMC', 'CMFMC_DP', + 'CH3CCL3_CHML', 'CH4_CHML', 'CO2_CHML', 'CO_CHML', 'IVOC_CHML', 'N2O_CHML', 'O3_CHML', 'SO2_CHML', + 'CO_CHMP', 'O3_CHMP', 'SO2_CHMP', 'TMDMS', 'TMOCS', 'TMSO2','TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'soa1_a1_CHML', 'soa1_a2_CHML', 'soa2_a1_CHML', 'soa2_a2_CHML', 'soa3_a1_CHML', 'soa3_a2_CHML', + 'soa4_a1_CHML', 'soa4_a2_CHML', 'soa5_a1_CHML', 'soa5_a2_CHML', 'SVOC_CHML', + 'so4_a1_CHMP','so4_a2_CHMP', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'TOTH', 'TOT_CLD_VISTAU', + 'TREFHTMN', 'TREFHTMX', 'TROP_P', 'TROP_T', 'TROP_Z', 'TTEND_TOT', 'TTGWORO', 'TTGWSDF', 'TTGWSDFORO', 'TTGWSKE', 'TTGWSKEORO', + 'TS', 'TSMN:M', 'TSMX:X', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', + 'ABSORB', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODdn_aitken', 'AODdn_accum', 'AODdn_coarse', + 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', + 'AODVISdn', 'AODVISstdn', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'FLDSC', 'FLNR', 'FSNR', + 'CME', 'CMFDQ', 'CMFMC','CMFMC_DP', 'SOLLD', 'SOLSD', 'SSAVIS', 'SST','TAQ', + 'DCOCHM','DH2O2CHM', 'DHNO3CHM', 'DO3CHM', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', + 'FLASHFRQ', 'LNO_COL_PROD', 'LNO_PROD','KVH_CLUBB','MASS', 'PDELDRY', 'NITROP_PD','PM25', 'PRECT', 'PTEQ', 'PTTEND', + 'QRLC', 'QRSC', 'QSNOW', 'QRAIN','GS_SO2', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS','H2SO4M_C', 'H2SO4_sfnnuc1','HCL_GAS', + 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP' 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RHREFHT', + 'EVAPPREC', 'EVAPQZM', 'EVAPTZM', 'FCTL','FREQZM', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU','VEL_NAT2', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', 'dst_c3DDF', + 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'num_c1DDF','num_c2DDF','num_c3DDF','num_c4DDF', + 'so4_a1_sfgaex1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_a2_sfgaex1', 'so4_c2AQH2SO4', 'so4_c2AQSO4', 'so4_c2DDF', + 'so4_a3_sfgaex1', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_a2_sfnnuc1', 'num_a2_sfnnuc1', + 'soa1_a1_sfgaex1','soa1_c1DDF', 'soa1_a2_sfgaex1','soa1_c2DDF', 'soa2_a1_sfgaex1','soa2_c1DDF', 'soa2_a2_sfgaex1','soa2_c2DDF', + 'soa3_a1_sfgaex1','soa3_c1DDF', 'soa3_a2_sfgaex1','soa3_c2DDF', 'soa4_a1_sfgaex1','soa4_c1DDF', 'soa4_a2_sfgaex1','soa4_c2DDF', + 'soa5_a1_sfgaex1','soa5_c1DDF', 'soa5_a2_sfgaex1','soa5_c2DDF', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', + 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_het10', 'r_het11', 'r_het12', 'r_het13', + 'r_het15', 'r_het16', 'r_het17', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', + 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_GLYOXAL_aer', 'r_HO2_O3', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', 'r_OH_O3', 'r_OH_O', 'O3_Prod','O3_Loss','O3S_Loss','RO2_NO_sum','O3_alkenes','RO2_NO3_sum','RO2_HO2_sum','RO2_RO2_sum','RCO2_NO2_sum', - 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', - 'Ox_Prod','Ox_Loss' + 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', 'Ox_Prod','Ox_Loss' - 'ACTNL', 'ACTREL', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BUTGWSPEC', - 'CDNUMC', 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLOUD', 'CMFMC', 'CMFMCDZM', 'FCTL', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', - 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FSDS', 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNTOA', 'FSNTOAC', 'LHFLX', 'MASS', 'O3', 'OMEGA', - 'OMEGA500', 'PBLH', 'PDELDRY', 'PM25_SRF', 'PRECC', 'PRECT', 'PS', 'PSL', 'Q', 'QREFHT', 'QSNOW', 'RELHUM', 'RHREFHT', 'SHFLX', - 'SOLIN', 'SOLLD', 'SOLSD', 'T', 'T500', 'T700', 'T850', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', - 'TGCLDIWP', 'TGCLDLWP', 'TMQ', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TS', 'TSMN:M', 'TSMX:X', 'U', 'U10', 'UTGWORO', 'UTGWSPEC', + 'ACTNL', 'ACTREL', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BUTGWSPEC', + 'CDNUMC', 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLOUD', 'CMFMC', 'CMFMC_DP', 'FCTL', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', + 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FSDS', 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNTOA', 'FSNTOAC', 'LHFLX', 'MASS', 'O3', 'OMEGA', + 'OMEGA500', 'PBLH', 'PDELDRY', 'PM25_SRF', 'PRECC', 'PRECT', 'PS', 'PSL', 'Q', 'QREFHT', 'QSNOW', 'RELHUM', 'RHREFHT', 'SHFLX', + 'SOLIN', 'SOLLD', 'SOLSD', 'T', 'T500', 'T700', 'T850', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'TGCLDIWP', 'TGCLDLWP', 'TMQ', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TS', 'TSMN:M', 'TSMX:X', 'U', 'U10', 'UTGWORO', 'UTGWSPEC', 'V', 'Z3', 'Z500' - + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' - - + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', 'REFF_AERO', 'SAD_AERO', 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'NITROP_PD', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' - + diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml index 48ee369ae9..ee6715c914 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml @@ -37,13 +37,6 @@ atm/waccm/ub/tgcm_ubc.2000.c100203.nc CYCLICAL - -.true. -.true. -.true. -.false. - - CYCLICAL @@ -132,7 +125,6 @@ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_bc_a4_anthro_surface_2010climo_0.9x1.25_c20180918.nc', 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_bc_a4_bb_surface_2010climo_0.9x1.25_c20180918.nc', 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_DMS_bb_surface_2010climo_0.9x1.25_c20180918.nc', - 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_DMS_other_surface_2010climo_0.9x1.25_c20180918.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a1_bb_surface_2010climo_0.9x1.25_c20180918.nc', 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_2010climo_0.9x1.25_c20180918.nc', 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_num_so4_a2_anthro-res_surface_2010climo_0.9x1.25_c20180918.nc', @@ -150,8 +142,6 @@ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_2010climo/emissions-cmip6_so4_a2_anthro-res_surface_2010climo_0.9x1.25_c20180918.nc' -'noy', 'nhx' - 1, 5, 20, 40, 120, 240, 365, 73, 365 @@ -161,120 +151,64 @@ .true. .false. .false. -.false. +.true. .false. .false. .true. .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' + 'NO2_CMXF' - 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST1', 'AODdnDUST2', - 'AODdnDUST3', 'AODdnMODE1', 'AODdnMODE2', 'AODdnMODE3', 'AODDUST2', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', - 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', - 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', - 'bc_c4SFWET', 'BENZENE', 'BENZO2', 'BENZOOH', 'BEPOMUC', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALD', 'BIGALK', 'BIGENE', - 'BR', 'BRCL', 'BRO', 'BRONO2', 'BROX', 'BROY', 'BRY', 'BTTGWSPEC', 'BTTGWSDF', 'BTTGWSKE', - 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', - 'BURDENSOAdn', 'BUTGWSPEC', 'BZALD', 'BZOO', 'BZOOH', 'C2H2', 'C2H4', 'C2H5O2', 'C2H5OH', 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7O2', - 'C3H7OOH', 'C3H8', 'C6H5O2', 'C6H5OOH', 'CCL4', 'CDNUMC', 'CF2CLBR', 'CF3BR', 'CFC113', 'CFC114', 'CFC115', 'CFC11', 'CFC11STAR', - 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CCL3_CHML', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3CO3', 'CH3COCH3', 'CH3COCHO', - 'CH3COOH', 'CH3COOOH', 'CH3O2', 'CH3OH', 'CH3OOH', 'CH4', 'CH4_CHML', 'CHBR3', 'CL2', 'CL2O2', 'CL', - 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CLOX', 'CLOY', 'CLY', 'CME', 'CMFDQ', 'CMFMC', - 'CMFMCDZM', 'CO2', 'CO2_CHML', 'CO', 'CO_CHML', 'CO_CHMP', 'COF2', 'COFCL', 'CONCLD', 'CRESOL', - 'DCOCHM', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', - 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', - 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', - 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', - 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'DF_NH3', 'DF_NH4', 'DF_NO2', 'DF_NO', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', - 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', - 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', 'DF_XYLENOOH', - 'DF_XYLOLOOH', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'DH2O2CHM', 'DHNO3CHM', 'DICARBO2', 'DMS', 'DO3CHM', 'dry_deposition_NHx_as_N', - 'dry_deposition_NOy_as_N', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'dst_a1', 'dst_a1DDF', 'dst_a1SFWET', 'dst_a2', 'dst_a2DDF', - 'dst_a2SFWET', 'dst_a3', 'dst_a3DDF', 'dst_a3SFWET', 'dst_c1', 'dst_c1DDF', 'dst_c1SFWET', 'dst_c2', 'dst_c2DDF', 'dst_c2SFWET', - 'dst_c3', 'dst_c3DDF', 'dst_c3SFWET', 'DTCORE', 'E90', 'e', 'ENEO2', 'EO2', 'EO', 'EOOH', 'EVAPPREC', - 'EVAPQZM', 'EVAPTZM', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'F', 'FCTL', - 'FLASHFRQ', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FREQI', 'FREQL', 'FREQZM', 'FSDS', - 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'FSNTOAC', 'FSUTOA', 'GLYALD', 'GLYOXAL', - 'GS_SO2', 'H2402', 'H2', 'H2O2', 'H2O', 'H2SO4', 'H2SO4M_C', 'H2SO4_sfnnuc1', 'H', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', 'HCL', - 'HCL_GAS', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS', 'HO2', 'HO2NO2', 'HOBR', 'HOCH2OO', 'HOCL', 'HONITR', - 'HPALD', 'HYAC', 'HYDRALD', 'ICEFRAC', 'IEPOX', 'ISOP', 'ISOPAO2', 'ISOPBO2', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', - 'ISOPNOOH', 'ISOPOOH', 'IVOC', 'IVOC_CHML', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', 'KVH_CLUBB', - 'LANDFRAC', 'LHFLX', 'LNO_COL_PROD', 'LNO_PROD', 'MACR', 'MACRO2', 'MACROOH', 'MALO2', 'MASS', 'MCO3', 'MDIALO2', - 'MEG_BCARY', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_C2H4', 'MEG_C2H5OH', 'MEG_C2H6', 'MEG_C3H6', 'MEG_C3H8', 'MEG_CH2O', - 'MEG_CH3CHO', 'MEG_CH3COCH3', 'MEG_CH3COOH', 'MEG_CH3OH', 'MEG_CO', 'MEG_HCN', 'MEG_HCOOH', 'MEG_ISOP', 'MEG_MTERP', 'MEG_TOLUENE', - 'MEK', 'MEKO2', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', 'N2D', 'N2O5', 'N2O', 'N2O_CHML', 'N2p', 'N', 'NC4CH2OH', - 'NC4CHO', 'ncl_a1', 'ncl_a1DDF', 'ncl_a1SFWET', 'ncl_a2', 'ncl_a2DDF', 'ncl_a2SFWET', 'ncl_a3', 'ncl_a3DDF', 'ncl_a3SFWET', 'ncl_c1', - 'ncl_c1DDF', 'ncl_c1SFWET', 'ncl_c2', 'ncl_c2DDF', 'ncl_c2SFWET', 'ncl_c3', 'ncl_c3DDF', 'ncl_c3SFWET', 'NDEP', 'NH3', 'NH4', 'NH_50', - 'NH_5', 'NHDEP', 'NITROP_PD', 'NO2', 'NO2_CLXF', 'NO3', 'NO', 'NOA', 'NOp', 'NOX', 'NOY', 'Np', 'NTERPO2', 'NTERPOOH', - 'num_a1', 'num_a1_CLXF', 'num_a1DDF', 'num_a2', 'num_a2_CLXF', 'num_a2DDF', 'num_a2_sfnnuc1', 'num_a3', 'num_a3DDF', 'num_a4', - 'num_a4DDF', 'num_c1', 'num_c1DDF', 'num_c2', 'num_c2DDF', 'num_c3', 'num_c3DDF', 'num_c4', 'num_c4DDF', 'NUMLIQ', 'O1D', 'O2_1D', - 'O2_1S', 'O2', 'O2p', 'O3', 'O3S', 'O3_CHML', 'O3_CHMP', 'O', 'OCLO', 'OCS', 'OH', 'OMEGA', 'OMEGAT', 'ONITR', 'Op', - 'PAN', 'PBLH', 'PBZNIT', 'PDELDRY', 'PHENO2', 'PHENO', 'PHENOL', 'PHENOOH', 'PHIS', 'PM25', 'PO2', 'pom_a1', 'pom_a1DDF', 'pom_a1SFWET', - 'pom_a4', 'pom_a4DDF', 'pom_a4SFWET', 'pom_c1', 'pom_c1DDF', 'pom_c1SFWET', 'pom_c4', 'pom_c4DDF', 'pom_c4SFWET', - 'POOH', 'PRECC', 'PRECT', 'PS', 'PSL', 'PTEQ', 'PTTEND', 'Q', 'QFLX', 'QRAIN', 'QREFHT', 'QRL', 'QRLC', 'QRS', - 'QRSC', 'QSNOW', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RELHUM', 'r_GLYOXAL_aer', - 'r_het10', 'r_het11', 'r_het12', 'r_het13', 'r_het15', 'r_het16', 'r_het17', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', - 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_HO2_O3', 'RHREFHT', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', - 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', - 'r_OH_O3', 'r_OH_O', 'ROOH', 'RO2', - 'S', 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP', 'SF6', 'SFbc_a4', 'SFBCARY', - 'SFBENZENE', 'SFBIGALK', 'SFBIGENE', 'SFC2H2', 'SFC2H4', 'SFC2H5OH', 'SFC2H6', 'SFC3H6', 'SFC3H8', 'SFCH2O', 'SFCH3CHO', 'SFCH3CN', - 'SFCH3COCH3', 'SFCH3COCHO', 'SFCH3COOH', 'SFCH3OH', 'SFCO', 'SFDMS', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', 'SFGLYALD', 'SFHCN', 'SFHCOOH', - 'SFISOP', 'SFIVOC', 'SFMEK', 'SFMTERP', 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'SFNH3', 'SFNO2', 'SFNO', 'SFnum_a1', 'SFnum_a2', - 'SFnum_a3', 'SFpom_a4', 'SFSO2', 'SFso4_a1', 'SFso4_a2', 'SFSVOC', 'SFTOLUENE', 'SFXYLENES', 'SHFLX', 'SO2', - 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SO2_XFRC', 'SO3', 'so4_a1', 'so4_a1_CHMP', 'so4_a1_CLXF', 'so4_a1DDF', 'so4_a1_sfgaex1', 'so4_a1SFWET', - 'so4_a2', 'so4_a2_CHMP', 'so4_a2_CLXF', 'so4_a2DDF', 'so4_a2_sfgaex1', 'so4_a2_sfnnuc1', 'so4_a2SFWET', 'so4_a3', - 'so4_a3DDF', 'so4_a3_sfgaex1', 'so4_a3SFWET', 'so4_c1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_c1SFWET', 'so4_c2', 'so4_c2AQH2SO4', - 'so4_c2AQSO4', 'so4_c2DDF', 'so4_c2SFWET', 'so4_c3', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_c3SFWET', 'SO', 'soa1_a1', - 'soa1_a1_CHML', 'soa1_a1DDF', 'soa1_a1_sfgaex1', 'soa1_a1SFWET', 'soa1_a2', 'soa1_a2_CHML', 'soa1_a2DDF', - 'soa1_a2_sfgaex1', 'soa1_a2SFWET', 'soa1_c1', 'soa1_c1DDF', 'soa1_c1SFWET', 'soa1_c2', 'soa1_c2DDF', 'soa1_c2SFWET', 'soa2_a1', 'soa2_a1_CHML', - 'soa2_a1DDF', 'soa2_a1_sfgaex1', 'soa2_a1SFWET', 'soa2_a2', 'soa2_a2_CHML', 'soa2_a2DDF', 'soa2_a2_sfgaex1', - 'soa2_a2SFWET', 'soa2_c1', 'soa2_c1DDF', 'soa2_c1SFWET', 'soa2_c2', 'soa2_c2DDF', 'soa2_c2SFWET', 'soa3_a1', 'soa3_a1_CHML', - 'soa3_a1DDF', 'soa3_a1_sfgaex1', 'soa3_a1SFWET', 'soa3_a2', 'soa3_a2_CHML', 'soa3_a2DDF', 'soa3_a2_sfgaex1', 'soa3_a2SFWET', - 'soa3_c1', 'soa3_c1DDF', 'soa3_c1SFWET', 'soa3_c2', 'soa3_c2DDF', 'soa3_c2SFWET', 'soa4_a1', 'soa4_a1_CHML', 'soa4_a1DDF', - 'soa4_a1_sfgaex1', 'soa4_a1SFWET', 'soa4_a2', 'soa4_a2_CHML', 'soa4_a2DDF', 'soa4_a2_sfgaex1', 'soa4_a2SFWET', 'soa4_c1', - 'soa4_c1DDF', 'soa4_c1SFWET', 'soa4_c2', 'soa4_c2DDF', 'soa4_c2SFWET', 'soa5_a1', 'soa5_a1_CHML', 'soa5_a1DDF', 'soa5_a1_sfgaex1', - 'soa5_a1SFWET', 'soa5_a2', 'soa5_a2_CHML', 'soa5_a2DDF', 'soa5_a2_sfgaex1', 'soa5_a2SFWET', 'soa5_c1', 'soa5_c1DDF', - 'soa5_c1SFWET', 'soa5_c2', 'soa5_c2DDF', 'soa5_c2SFWET', 'SOAG0', 'SOAG0_CHMP', 'SOAG1', 'SOAG1_CHMP', 'SOAG2', 'SOAG2_CHMP', - 'SOAG3', 'SOAG3_CHMP', 'SOAG4', 'SOAG4_CHMP', 'SOLIN', 'SOLLD', 'SOLSD', 'SSAVIS', 'SST', 'ST80_25', 'SVOC', 'SVOC_CHML', - 'T', 'TAQ', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', 'TBRY', 'TCLY', 'TEPOMUC', 'TERP2O2', 'TERP2OOH', - 'TERPNIT', 'TERPO2', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TGCLDIWP', 'TGCLDLWP', 'THzm', 'TMDMS', 'TMOCS', 'TMQ', 'TMSO2', - 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'TOLO2', 'TOLOOH', 'TOLUENE', 'TOT_CLD_VISTAU', 'TOTH', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TROP_P', - 'TROP_T', 'TROP_Z', 'TS', 'TSMN:M', 'TSMX:X', 'TTEND_TOT', 'TTGWORO', 'TTGWSDF', 'TTGWSDFORO', 'TTGWSKE', 'TTGWSKEORO', 'TTGWSPEC', - 'U10', 'U', 'UTGWORO', 'UTGWSPEC', 'UU', 'UVzm', 'UWzm', 'Uzm', 'V', 'VD01', 'VEL_NAT2', 'VTHzm', 'VV', 'Vzm', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', - 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCH3', 'WD_CH3COCHO', - 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', - 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', - 'WD_HYDRALD', 'WD_IEPOX', 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', - 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', - 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', - 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', - 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'Wzm', 'XO2', 'XOOH', 'XYLENES', 'XYLENO2', 'XYLENOOH', 'XYLOL', 'XYLOLO2', - 'XYLOLOOH', 'Z3', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU', + 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', + 'BTTGWSPEC', 'BTTGWSDF', 'BTTGWSKE', 'CONCLD', 'CME', 'CMFDQ', 'CMFMC', 'CMFMC_DP', + 'CH3CCL3_CHML', 'CH4_CHML', 'CO2_CHML', 'CO_CHML', 'IVOC_CHML', 'N2O_CHML', 'O3_CHML', 'SO2_CHML', + 'CO_CHMP', 'O3_CHMP', 'SO2_CHMP', 'TMDMS', 'TMOCS', 'TMSO2','TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'soa1_a1_CHML', 'soa1_a2_CHML', 'soa2_a1_CHML', 'soa2_a2_CHML', 'soa3_a1_CHML', 'soa3_a2_CHML', + 'soa4_a1_CHML', 'soa4_a2_CHML', 'soa5_a1_CHML', 'soa5_a2_CHML', 'SVOC_CHML', + 'so4_a1_CHMP','so4_a2_CHMP', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'TOTH', 'TOT_CLD_VISTAU', + 'TREFHTMN', 'TREFHTMX', 'TROP_P', 'TROP_T', 'TROP_Z', 'TTEND_TOT', 'TTGWORO', 'TTGWSDF', 'TTGWSDFORO', 'TTGWSKE', 'TTGWSKEORO', + 'TS', 'TSMN:M', 'TSMX:X', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', + 'ABSORB', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODdn_aitken', 'AODdn_accum', 'AODdn_coarse', + 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', + 'AODVISdn', 'AODVISstdn', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'FLDSC', 'FLNR', 'FSNR', + 'CME', 'CMFDQ', 'CMFMC','CMFMC_DP', 'SOLLD', 'SOLSD', 'SSAVIS', 'SST','TAQ', + 'DCOCHM','DH2O2CHM', 'DHNO3CHM', 'DO3CHM', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', + 'FLASHFRQ', 'LNO_COL_PROD', 'LNO_PROD','KVH_CLUBB','MASS', 'PDELDRY', 'NITROP_PD','PM25', 'PRECT', 'PTEQ', 'PTTEND', + 'QRLC', 'QRSC', 'QSNOW', 'QRAIN','GS_SO2', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS','H2SO4M_C', 'H2SO4_sfnnuc1','HCL_GAS', + 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP' 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RHREFHT', + 'EVAPPREC', 'EVAPQZM', 'EVAPTZM', 'FCTL','FREQZM', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU','VEL_NAT2', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', 'dst_c3DDF', + 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'num_c1DDF','num_c2DDF','num_c3DDF','num_c4DDF', + 'so4_a1_sfgaex1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_a2_sfgaex1', 'so4_c2AQH2SO4', 'so4_c2AQSO4', 'so4_c2DDF', + 'so4_a3_sfgaex1', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_a2_sfnnuc1', 'num_a2_sfnnuc1', + 'soa1_a1_sfgaex1','soa1_c1DDF', 'soa1_a2_sfgaex1','soa1_c2DDF', 'soa2_a1_sfgaex1','soa2_c1DDF', 'soa2_a2_sfgaex1','soa2_c2DDF', + 'soa3_a1_sfgaex1','soa3_c1DDF', 'soa3_a2_sfgaex1','soa3_c2DDF', 'soa4_a1_sfgaex1','soa4_c1DDF', 'soa4_a2_sfgaex1','soa4_c2DDF', + 'soa5_a1_sfgaex1','soa5_c1DDF', 'soa5_a2_sfgaex1','soa5_c2DDF', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', + 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_het10', 'r_het11', 'r_het12', 'r_het13', + 'r_het15', 'r_het16', 'r_het17', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', + 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_GLYOXAL_aer', 'r_HO2_O3', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', 'r_OH_O3', 'r_OH_O', 'O3_Prod','O3_Loss','O3S_Loss','RO2_NO_sum','O3_alkenes','RO2_NO3_sum','RO2_HO2_sum','RO2_RO2_sum','RCO2_NO2_sum', - 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', - 'Ox_Prod','Ox_Loss' + 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', 'Ox_Prod','Ox_Loss' - 'ACTNL', 'ACTREL', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BUTGWSPEC', - 'CDNUMC', 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLOUD', 'CMFMC', 'CMFMCDZM', 'FCTL', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', - 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FSDS', 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNTOA', 'FSNTOAC', 'LHFLX', 'MASS', 'O3', 'OMEGA', - 'OMEGA500', 'PBLH', 'PDELDRY', 'PM25_SRF', 'PRECC', 'PRECT', 'PS', 'PSL', 'Q', 'QREFHT', 'QSNOW', 'RELHUM', 'RHREFHT', 'SHFLX', - 'SOLIN', 'SOLLD', 'SOLSD', 'T', 'T500', 'T700', 'T850', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', - 'TGCLDIWP', 'TGCLDLWP', 'TMQ', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TS', 'TSMN:M', 'TSMX:X', 'U', 'U10', 'UTGWORO', 'UTGWSPEC', + 'ACTNL', 'ACTREL', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BUTGWSPEC', + 'CDNUMC', 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLOUD', 'CMFMC', 'CMFMC_DP', 'FCTL', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', + 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FSDS', 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNTOA', 'FSNTOAC', 'LHFLX', 'MASS', 'O3', 'OMEGA', + 'OMEGA500', 'PBLH', 'PDELDRY', 'PM25_SRF', 'PRECC', 'PRECT', 'PS', 'PSL', 'Q', 'QREFHT', 'QSNOW', 'RELHUM', 'RHREFHT', 'SHFLX', + 'SOLIN', 'SOLLD', 'SOLSD', 'T', 'T500', 'T700', 'T850', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'TGCLDIWP', 'TGCLDLWP', 'TMQ', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TS', 'TSMN:M', 'TSMX:X', 'U', 'U10', 'UTGWORO', 'UTGWSPEC', 'V', 'Z3', 'Z500' 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' - - + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', 'REFF_AERO', 'SAD_AERO', 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'NITROP_PD', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' - + diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml index 1ac3e6b8b8..623d08bc95 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml @@ -32,21 +32,12 @@ atm/waccm/ub/tgcm_ubc_1850-2100_c100204.nc 'INTERP_MISSING_MONTHS' - -.true. -.true. -.true. -.false. - - INTERP_MISSING_MONTHS INTERP_MISSING_MONTHS -'noy', 'nhx' - 1, 5, 20, 40, 120, 240, 365, 73, 365 @@ -56,118 +47,62 @@ .true. .false. .false. -.false. +.true. .false. .false. .true. .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' + 'NO2_CMXF' - 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST1', 'AODdnDUST2', - 'AODdnDUST3', 'AODdnMODE1', 'AODdnMODE2', 'AODdnMODE3', 'AODDUST2', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', - 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', - 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', - 'bc_c4SFWET', 'BENZENE', 'BENZO2', 'BENZOOH', 'BEPOMUC', 'BIGALD1', 'BIGALD2', 'BIGALD3', 'BIGALD4', 'BIGALD', 'BIGALK', 'BIGENE', - 'BR', 'BRCL', 'BRO', 'BRONO2', 'BROX', 'BROY', 'BRY', 'BTTGWSPEC', 'BTTGWSDF', 'BTTGWSKE', - 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', - 'BURDENSOAdn', 'BUTGWSPEC', 'BZALD', 'BZOO', 'BZOOH', 'C2H2', 'C2H4', 'C2H5O2', 'C2H5OH', 'C2H5OOH', 'C2H6', 'C3H6', 'C3H7O2', - 'C3H7OOH', 'C3H8', 'C6H5O2', 'C6H5OOH', 'CCL4', 'CDNUMC', 'CF2CLBR', 'CF3BR', 'CFC113', 'CFC114', 'CFC115', 'CFC11', 'CFC11STAR', - 'CFC12', 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CCL3_CHML', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3CO3', 'CH3COCH3', 'CH3COCHO', - 'CH3COOH', 'CH3COOOH', 'CH3O2', 'CH3OH', 'CH3OOH', 'CH4', 'CH4_CHML', 'CHBR3', 'CL2', 'CL2O2', 'CL', - 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CLOX', 'CLOY', 'CLY', 'CME', 'CMFDQ', 'CMFMC', - 'CMFMCDZM', 'CO2', 'CO2_CHML', 'CO', 'CO_CHML', 'CO_CHMP', 'COF2', 'COFCL', 'CONCLD', 'CRESOL', - 'DCOCHM', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', - 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', - 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', - 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', - 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'DF_NH3', 'DF_NH4', 'DF_NO2', 'DF_NO', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', - 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', - 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', 'DF_TERPOOH', 'DF_TERPROD1', 'DF_TERPROD2', 'DF_TOLOOH', 'DF_XOOH', 'DF_XYLENOOH', - 'DF_XYLOLOOH', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'DH2O2CHM', 'DHNO3CHM', 'DICARBO2', 'DMS', 'DO3CHM', 'dry_deposition_NHx_as_N', - 'dry_deposition_NOy_as_N', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', 'dst_a1', 'dst_a1DDF', 'dst_a1SFWET', 'dst_a2', 'dst_a2DDF', - 'dst_a2SFWET', 'dst_a3', 'dst_a3DDF', 'dst_a3SFWET', 'dst_c1', 'dst_c1DDF', 'dst_c1SFWET', 'dst_c2', 'dst_c2DDF', 'dst_c2SFWET', - 'dst_c3', 'dst_c3DDF', 'dst_c3SFWET', 'DTCORE', 'E90', 'e', 'ENEO2', 'EO2', 'EO', 'EOOH', 'EVAPPREC', - 'EVAPQZM', 'EVAPTZM', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'F', 'FCTL', - 'FLASHFRQ', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FREQI', 'FREQL', 'FREQZM', 'FSDS', - 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'FSNTOAC', 'FSUTOA', 'GLYALD', 'GLYOXAL', - 'GS_SO2', 'H2402', 'H2', 'H2O2', 'H2O', 'H2SO4', 'H2SO4M_C', 'H2SO4_sfnnuc1', 'H', 'HBR', 'HCFC141B', 'HCFC142B', 'HCFC22', 'HCL', - 'HCL_GAS', 'HCN', 'HCOOH', 'HF', 'HNO3', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS', 'HO2', 'HO2NO2', 'HOBR', 'HOCH2OO', 'HOCL', 'HONITR', - 'HPALD', 'HYAC', 'HYDRALD', 'ICEFRAC', 'IEPOX', 'ISOP', 'ISOPAO2', 'ISOPBO2', 'ISOPNITA', 'ISOPNITB', 'ISOPNO3', - 'ISOPNOOH', 'ISOPOOH', 'IVOC', 'IVOC_CHML', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', 'KVH_CLUBB', - 'LANDFRAC', 'LHFLX', 'LNO_COL_PROD', 'LNO_PROD', 'MACR', 'MACRO2', 'MACROOH', 'MALO2', 'MASS', 'MCO3', 'MDIALO2', - 'MEG_BCARY', 'MEG_BIGALK', 'MEG_BIGENE', 'MEG_C2H4', 'MEG_C2H5OH', 'MEG_C2H6', 'MEG_C3H6', 'MEG_C3H8', 'MEG_CH2O', - 'MEG_CH3CHO', 'MEG_CH3COCH3', 'MEG_CH3COOH', 'MEG_CH3OH', 'MEG_CO', 'MEG_HCN', 'MEG_HCOOH', 'MEG_ISOP', 'MEG_MTERP', 'MEG_TOLUENE', - 'MEK', 'MEKO2', 'MEKOOH', 'MPAN', 'MTERP', 'MVK', 'N2D', 'N2O5', 'N2O', 'N2O_CHML', 'N2p', 'N', 'NC4CH2OH', - 'NC4CHO', 'ncl_a1', 'ncl_a1DDF', 'ncl_a1SFWET', 'ncl_a2', 'ncl_a2DDF', 'ncl_a2SFWET', 'ncl_a3', 'ncl_a3DDF', 'ncl_a3SFWET', 'ncl_c1', - 'ncl_c1DDF', 'ncl_c1SFWET', 'ncl_c2', 'ncl_c2DDF', 'ncl_c2SFWET', 'ncl_c3', 'ncl_c3DDF', 'ncl_c3SFWET', 'NDEP', 'NH3', 'NH4', 'NH_50', - 'NH_5', 'NHDEP', 'NITROP_PD', 'NO2', 'NO2_CLXF', 'NO3', 'NO', 'NOA', 'NOp', 'NOX', 'NOY', 'Np', 'NTERPO2', 'NTERPOOH', - 'num_a1', 'num_a1_CLXF', 'num_a1DDF', 'num_a2', 'num_a2_CLXF', 'num_a2DDF', 'num_a2_sfnnuc1', 'num_a3', 'num_a3DDF', 'num_a4', - 'num_a4DDF', 'num_c1', 'num_c1DDF', 'num_c2', 'num_c2DDF', 'num_c3', 'num_c3DDF', 'num_c4', 'num_c4DDF', 'NUMLIQ', 'O1D', 'O2_1D', - 'O2_1S', 'O2', 'O2p', 'O3', 'O3S', 'O3_CHML', 'O3_CHMP', 'O', 'OCLO', 'OCS', 'OH', 'OMEGA', 'OMEGAT', 'ONITR', 'Op', - 'PAN', 'PBLH', 'PBZNIT', 'PDELDRY', 'PHENO2', 'PHENO', 'PHENOL', 'PHENOOH', 'PHIS', 'PM25', 'PO2', 'pom_a1', 'pom_a1DDF', 'pom_a1SFWET', - 'pom_a4', 'pom_a4DDF', 'pom_a4SFWET', 'pom_c1', 'pom_c1DDF', 'pom_c1SFWET', 'pom_c4', 'pom_c4DDF', 'pom_c4SFWET', - 'POOH', 'PRECC', 'PRECT', 'PS', 'PSL', 'PTEQ', 'PTTEND', 'Q', 'QFLX', 'QRAIN', 'QREFHT', 'QRL', 'QRLC', 'QRS', - 'QRSC', 'QSNOW', 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RELHUM', 'r_GLYOXAL_aer', - 'r_het10', 'r_het11', 'r_het12', 'r_het13', 'r_het15', 'r_het16', 'r_het17', 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', - 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_HO2_O3', 'RHREFHT', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', - 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', - 'r_OH_O3', 'r_OH_O', 'ROOH', 'RO2', - 'S', 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP', 'SF6', 'SFbc_a4', 'SFBCARY', - 'SFBENZENE', 'SFBIGALK', 'SFBIGENE', 'SFC2H2', 'SFC2H4', 'SFC2H5OH', 'SFC2H6', 'SFC3H6', 'SFC3H8', 'SFCH2O', 'SFCH3CHO', 'SFCH3CN', - 'SFCH3COCH3', 'SFCH3COCHO', 'SFCH3COOH', 'SFCH3OH', 'SFCO', 'SFDMS', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', 'SFGLYALD', 'SFHCN', 'SFHCOOH', - 'SFISOP', 'SFIVOC', 'SFMEK', 'SFMTERP', 'SFncl_a1', 'SFncl_a2', 'SFncl_a3', 'SFNH3', 'SFNO2', 'SFNO', 'SFnum_a1', 'SFnum_a2', - 'SFnum_a3', 'SFpom_a4', 'SFSO2', 'SFso4_a1', 'SFso4_a2', 'SFSVOC', 'SFTOLUENE', 'SFXYLENES', 'SHFLX', 'SO2', - 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SO2_XFRC', 'SO3', 'so4_a1', 'so4_a1_CHMP', 'so4_a1_CLXF', 'so4_a1DDF', 'so4_a1_sfgaex1', 'so4_a1SFWET', - 'so4_a2', 'so4_a2_CHMP', 'so4_a2_CLXF', 'so4_a2DDF', 'so4_a2_sfgaex1', 'so4_a2_sfnnuc1', 'so4_a2SFWET', 'so4_a3', - 'so4_a3DDF', 'so4_a3_sfgaex1', 'so4_a3SFWET', 'so4_c1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_c1SFWET', 'so4_c2', 'so4_c2AQH2SO4', - 'so4_c2AQSO4', 'so4_c2DDF', 'so4_c2SFWET', 'so4_c3', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_c3SFWET', 'SO', 'soa1_a1', - 'soa1_a1_CHML', 'soa1_a1DDF', 'soa1_a1_sfgaex1', 'soa1_a1SFWET', 'soa1_a2', 'soa1_a2_CHML', 'soa1_a2DDF', - 'soa1_a2_sfgaex1', 'soa1_a2SFWET', 'soa1_c1', 'soa1_c1DDF', 'soa1_c1SFWET', 'soa1_c2', 'soa1_c2DDF', 'soa1_c2SFWET', 'soa2_a1', 'soa2_a1_CHML', - 'soa2_a1DDF', 'soa2_a1_sfgaex1', 'soa2_a1SFWET', 'soa2_a2', 'soa2_a2_CHML', 'soa2_a2DDF', 'soa2_a2_sfgaex1', - 'soa2_a2SFWET', 'soa2_c1', 'soa2_c1DDF', 'soa2_c1SFWET', 'soa2_c2', 'soa2_c2DDF', 'soa2_c2SFWET', 'soa3_a1', 'soa3_a1_CHML', - 'soa3_a1DDF', 'soa3_a1_sfgaex1', 'soa3_a1SFWET', 'soa3_a2', 'soa3_a2_CHML', 'soa3_a2DDF', 'soa3_a2_sfgaex1', 'soa3_a2SFWET', - 'soa3_c1', 'soa3_c1DDF', 'soa3_c1SFWET', 'soa3_c2', 'soa3_c2DDF', 'soa3_c2SFWET', 'soa4_a1', 'soa4_a1_CHML', 'soa4_a1DDF', - 'soa4_a1_sfgaex1', 'soa4_a1SFWET', 'soa4_a2', 'soa4_a2_CHML', 'soa4_a2DDF', 'soa4_a2_sfgaex1', 'soa4_a2SFWET', 'soa4_c1', - 'soa4_c1DDF', 'soa4_c1SFWET', 'soa4_c2', 'soa4_c2DDF', 'soa4_c2SFWET', 'soa5_a1', 'soa5_a1_CHML', 'soa5_a1DDF', 'soa5_a1_sfgaex1', - 'soa5_a1SFWET', 'soa5_a2', 'soa5_a2_CHML', 'soa5_a2DDF', 'soa5_a2_sfgaex1', 'soa5_a2SFWET', 'soa5_c1', 'soa5_c1DDF', - 'soa5_c1SFWET', 'soa5_c2', 'soa5_c2DDF', 'soa5_c2SFWET', 'SOAG0', 'SOAG0_CHMP', 'SOAG1', 'SOAG1_CHMP', 'SOAG2', 'SOAG2_CHMP', - 'SOAG3', 'SOAG3_CHMP', 'SOAG4', 'SOAG4_CHMP', 'SOLIN', 'SOLLD', 'SOLSD', 'SSAVIS', 'SST', 'ST80_25', 'SVOC', 'SVOC_CHML', - 'T', 'TAQ', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', 'TBRY', 'TCLY', 'TEPOMUC', 'TERP2O2', 'TERP2OOH', - 'TERPNIT', 'TERPO2', 'TERPOOH', 'TERPROD1', 'TERPROD2', 'TGCLDIWP', 'TGCLDLWP', 'THzm', 'TMDMS', 'TMOCS', 'TMQ', 'TMSO2', - 'TMso4_a1', 'TMso4_a2', 'TMso4_a3', 'TOLO2', 'TOLOOH', 'TOLUENE', 'TOT_CLD_VISTAU', 'TOTH', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TROP_P', - 'TROP_T', 'TROP_Z', 'TS', 'TSMN:M', 'TSMX:X', 'TTEND_TOT', 'TTGWORO', 'TTGWSDF', 'TTGWSDFORO', 'TTGWSKE', 'TTGWSKEORO', 'TTGWSPEC', - 'U10', 'U', 'UTGWORO', 'UTGWSPEC', 'UU', 'UVzm', 'UWzm', 'Uzm', 'V', 'VD01', 'VEL_NAT2', 'VTHzm', 'VV', 'Vzm', 'WD_ALKNIT', 'WD_ALKOOH', 'WD_BENZOOH', 'WD_BRONO2', - 'WD_BZOOH', 'WD_C2H5OH', 'WD_C2H5OOH', 'WD_C3H7OOH', 'WD_C6H5OOH', 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCH3', 'WD_CH3COCHO', - 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', - 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', 'WD_HYAC', - 'WD_HYDRALD', 'WD_IEPOX', 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', - 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', - 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', - 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', 'WD_TERPROD2', 'WD_TOLOOH', 'WD_XOOH', 'WD_XYLENOOH', 'WD_XYLOLOOH', - 'wet_deposition_NHx_as_N', 'wet_deposition_NOy_as_N', 'Wzm', 'XO2', 'XOOH', 'XYLENES', 'XYLENO2', 'XYLENOOH', 'XYLOL', 'XYLOLO2', - 'XYLOLOOH', 'Z3', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU', + 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', + 'BTTGWSPEC', 'BTTGWSDF', 'BTTGWSKE', 'CONCLD', 'CME', 'CMFDQ', 'CMFMC', 'CMFMC_DP', + 'CH3CCL3_CHML', 'CH4_CHML', 'CO2_CHML', 'CO_CHML', 'IVOC_CHML', 'N2O_CHML', 'O3_CHML', 'SO2_CHML', + 'CO_CHMP', 'O3_CHMP', 'SO2_CHMP', 'TMDMS', 'TMOCS', 'TMSO2','TMso4_a1', 'TMso4_a2', 'TMso4_a3', + 'soa1_a1_CHML', 'soa1_a2_CHML', 'soa2_a1_CHML', 'soa2_a2_CHML', 'soa3_a1_CHML', 'soa3_a2_CHML', + 'soa4_a1_CHML', 'soa4_a2_CHML', 'soa5_a1_CHML', 'soa5_a2_CHML', 'SVOC_CHML', + 'so4_a1_CHMP','so4_a2_CHMP', 'SOAG0_CHMP', 'SOAG1_CHMP', 'SOAG2_CHMP', 'SOAG3_CHMP', 'SOAG4_CHMP', 'TOTH', 'TOT_CLD_VISTAU', + 'TREFHTMN', 'TREFHTMX', 'TROP_P', 'TROP_T', 'TROP_Z', 'TTEND_TOT', 'TTGWORO', 'TTGWSDF', 'TTGWSDFORO', 'TTGWSKE', 'TTGWSKEORO', + 'TS', 'TSMN:M', 'TSMX:X', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', + 'ABSORB', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODdn_aitken', 'AODdn_accum', 'AODdn_coarse', + 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', + 'AODVISdn', 'AODVISstdn', 'EXTINCTdn', 'EXTINCTNIRdn', 'EXTINCTUVdn', 'EXTxASYMdn', 'FLDSC', 'FLNR', 'FSNR', + 'CME', 'CMFDQ', 'CMFMC','CMFMC_DP', 'SOLLD', 'SOLSD', 'SSAVIS', 'SST','TAQ', + 'DCOCHM','DH2O2CHM', 'DHNO3CHM', 'DO3CHM', 'Dso4_a1CHM', 'Dso4_a2CHM', 'Dso4_a3CHM', + 'FLASHFRQ', 'LNO_COL_PROD', 'LNO_PROD','KVH_CLUBB','MASS', 'PDELDRY', 'NITROP_PD','PM25', 'PRECT', 'PTEQ', 'PTTEND', + 'QRLC', 'QRSC', 'QSNOW', 'QRAIN','GS_SO2', 'HNO3_GAS', 'HNO3_NAT', 'HNO3_STS','H2SO4M_C', 'H2SO4_sfnnuc1','HCL_GAS', + 'SAD_AERO', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'SAD_TROP' 'RAD_ICE', 'RAD_LNAT', 'RAD_SULFC', 'REFF_AERO', 'RHREFHT', + 'EVAPPREC', 'EVAPQZM', 'EVAPTZM', 'FCTL','FREQZM', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU','VEL_NAT2', + 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'bc_c1DDF', 'bc_c4DDF', 'dst_c1DDF', 'dst_c2DDF', 'dst_c3DDF', + 'ncl_c1DDF', 'ncl_c2DDF', 'ncl_c3DDF', 'pom_c1DDF', 'pom_c4DDF', 'num_c1DDF','num_c2DDF','num_c3DDF','num_c4DDF', + 'so4_a1_sfgaex1', 'so4_c1AQH2SO4', 'so4_c1AQSO4', 'so4_c1DDF', 'so4_a2_sfgaex1', 'so4_c2AQH2SO4', 'so4_c2AQSO4', 'so4_c2DDF', + 'so4_a3_sfgaex1', 'so4_c3AQH2SO4', 'so4_c3AQSO4', 'so4_c3DDF', 'so4_a2_sfnnuc1', 'num_a2_sfnnuc1', + 'soa1_a1_sfgaex1','soa1_c1DDF', 'soa1_a2_sfgaex1','soa1_c2DDF', 'soa2_a1_sfgaex1','soa2_c1DDF', 'soa2_a2_sfgaex1','soa2_c2DDF', + 'soa3_a1_sfgaex1','soa3_c1DDF', 'soa3_a2_sfgaex1','soa3_c2DDF', 'soa4_a1_sfgaex1','soa4_c1DDF', 'soa4_a2_sfgaex1','soa4_c2DDF', + 'soa5_a1_sfgaex1','soa5_c1DDF', 'soa5_a2_sfgaex1','soa5_c2DDF', 'jcl2o2', 'jh2o2', 'jno2', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jpan', + 'r_het1', 'r_het2', 'r_het3', 'r_het4', 'r_het5', 'r_het6', 'r_het7', 'r_het8', 'r_het9', 'r_het10', 'r_het11', 'r_het12', 'r_het13', + 'r_het15', 'r_het16', 'r_het17', 'r_jsoa1_a1', 'r_jsoa1_a2', 'r_jsoa2_a1', 'r_jsoa2_a2', 'r_jsoa3_a1', 'r_jsoa3_a2', 'r_jsoa4_a1', + 'r_jsoa4_a2', 'r_jsoa5_a1', 'r_jsoa5_a2', 'r_GLYOXAL_aer', 'r_HO2_O3', 'r_N2O5_aer', 'r_NO2_aer', 'r_NO3_aer', 'r_O1D_H2O', 'r_OH_O3', 'r_OH_O', 'O3_Prod','O3_Loss','O3S_Loss','RO2_NO_sum','O3_alkenes','RO2_NO3_sum','RO2_HO2_sum','RO2_RO2_sum','RCO2_NO2_sum', - 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', - 'Ox_Prod','Ox_Loss' + 'OddOx_Ox_Loss','OddOx_HOx_Loss','OddOx_NOx_Loss','OddOx_CLOxBROx_Loss','OddOx_Loss_Tot','OddOx_Prod_Tot', 'Ox_Prod','Ox_Loss' - 'ACTNL', 'ACTREL', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BUTGWSPEC', - 'CDNUMC', 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLOUD', 'CMFMC', 'CMFMCDZM', 'FCTL', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', - 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FSDS', 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNTOA', 'FSNTOAC', 'LHFLX', 'MASS', 'O3', 'OMEGA', - 'OMEGA500', 'PBLH', 'PDELDRY', 'PM25_SRF', 'PRECC', 'PRECT', 'PS', 'PSL', 'Q', 'QREFHT', 'QSNOW', 'RELHUM', 'RHREFHT', 'SHFLX', - 'SOLIN', 'SOLLD', 'SOLSD', 'T', 'T500', 'T700', 'T850', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', - 'TGCLDIWP', 'TGCLDLWP', 'TMQ', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TS', 'TSMN:M', 'TSMX:X', 'U', 'U10', 'UTGWORO', 'UTGWSPEC', + 'ACTNL', 'ACTREL', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BUTGWSPEC', + 'CDNUMC', 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLOUD', 'CMFMC', 'CMFMC_DP', 'FCTL', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', + 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FSDS', 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNTOA', 'FSNTOAC', 'LHFLX', 'MASS', 'O3', 'OMEGA', + 'OMEGA500', 'PBLH', 'PDELDRY', 'PM25_SRF', 'PRECC', 'PRECT', 'PS', 'PSL', 'Q', 'QREFHT', 'QSNOW', 'RELHUM', 'RHREFHT', 'SHFLX', + 'SOLIN', 'SOLLD', 'SOLSD', 'T', 'T500', 'T700', 'T850', 'TAUBLJX', 'TAUBLJY', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'TGCLDIWP', 'TGCLDLWP', 'TMQ', 'TREFHT', 'TREFHTMN', 'TREFHTMX', 'TS', 'TSMN:M', 'TSMX:X', 'U', 'U10', 'UTGWORO', 'UTGWSPEC', 'V', 'Z3', 'Z500' - + 'MSKtem','PS','PSL','VTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','PHIS' - - + + 'PS', 'PSL', 'U', 'V', 'T', 'Z3', 'PHIS', 'FRONTGF:I', 'OMEGA', 'O3', 'REFF_AERO', 'SAD_AERO', 'so4_a1', 'so4_a2', 'so4_a3', 'AODVISstdn', 'NITROP_PD', 'dgnumwet1', 'dgnumwet2', 'dgnumwet3', 'QRS_TOT', 'CO2', 'H', 'NO', 'O' 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 459aa6e93d..017cc3362e 100644 --- a/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml +++ b/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml @@ -28,7 +28,7 @@ 0.90D0 -atm/waccm/ic/f_2000_waccmx_cesm1_1_beta08.cam.i.2019-01-01-00000_c140827.nc +atm/waccm/ic/f_2000_waccmx_cesm1_1_beta08.cam.i.2019-01-01-00000_c140827.nc atm/cam/topo/USGS-gtopo30_1.9x2.5_remap_c050602.nc @@ -47,13 +47,12 @@ CYCLICAL 2000 - + .true. atm/waccm/qbo/qbocyclic28months.nc' -.true. -.true. +.true. @@ -73,57 +72,56 @@ 0, -3, -24 'A', 'I', 'I' - + - 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', - 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', - 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', - 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', + 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', + 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', + 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', + 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'H', 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', 'LANDFRAC', 'LHFLX', 'N', 'N2O', 'N2O5', 'NO', 'NO2', 'NO3', 'O', 'O1D', 'O2', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'Q', 'QFLX', 'QPERT', 'QRL', 'QRLNLTE', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', - 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', - 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', 'QNO', 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', - 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'T', 'TREFHT', - 'TTGW', 'U', 'UTGWORO', 'UTGWSPEC', 'V', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'O2_1S', - 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE','UI','VI','WI', + 'QTHERMAL', 'QRL_TOT', 'QRS_TOT', 'QJOULE', 'PSL', 'HNO3_STS', 'HNO3_NAT', + 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', 'QNO', 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', + 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'T', 'TREFHT', + 'TTGW', 'U', 'UTGWORO', 'UTGWSPEC', 'V', 'VERT', 'VTGWORO', 'VTGWSPEC', 'Z3', 'O2_1S', + 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', 'TCLY', 'TOTH', 'QJOULE','UI','VI','WI', 'UIONTEND', 'VIONTEND', 'DTCORE', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', - 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', + 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'PS_24_COS', 'PS_24_SIN', 'PS_12_COS', 'PS_12_SIN', 'CLDLIQ','CLDICE','CONCLD', 'FRONTGF:I', 'BUTGWSPEC', 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS','TAUE','TAUW','TAUN','TAUS', 'TAUGWX', 'TAUGWY', 'TAUX','TAUY','SNOWHLND','SNOWHICE','ICEFRAC','FSDSC','SFNO', 'SFCO', 'SFCH2O','CFC11STAR','TROPP_FD', 'Op', 'O2p', 'Np', 'NOp', 'N2p', 'e' - + - 'PS', 'Z3', 'T', 'U', 'V', 'FLNT','PSL', + 'PS', 'Z3', 'T', 'U', 'V', 'FLNT','PSL', 'OMEGA','FSDS','FSDSC','CLOUD','CONCLD','SNOWHLND','SNOWHICE', - 'CH3CL', 'CFC11', 'CFC12', 'CFC113', 'HCFC22', 'CCL4', 'CH3CCL3', + 'CH3CL', 'CFC11', 'CFC12', 'CFC113', 'HCFC22', 'CCL4', 'CH3CCL3', 'CH3BR', 'CF3BR', 'CF2CLBR', 'CO', 'CO2', 'CH2O', 'CH3OOH', 'CH4', 'O3', 'O', 'O1D', 'N', 'NO', 'NO2', 'NO3', 'N2O5', 'HNO3', 'HO2NO2', 'NOX', 'NOY', 'N2O', 'H', 'H2', 'OH', 'HO2', 'H2O2', 'H2O', - 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', + 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', 'BR', 'BRO', 'HOBR', 'HBR', 'BRCL', 'BRONO2', 'BROX', 'BROY', 'TCLY', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', - 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', + 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE', 'O2', 'CLDLIQ', 'CLDICE', 'ASDIR', - 'VTHzm', 'WTHzm', 'UVzm', 'UWzm', 'TH', 'MSKtem', 'O2_1S', 'O2_1D', - 'Op', 'O2p', 'Np', 'NOp', 'N2p', 'e', - 'UIONTEND', 'VIONTEND', 'UTGWSPEC', 'UTGWORO', 'VTGWSPEC', 'VTGWORO', 'TTGW', + 'Op', 'O2p', 'Np', 'NOp', 'N2p', 'e', + 'UIONTEND', 'VIONTEND', 'UTGWSPEC', 'UTGWORO', 'VTGWSPEC', 'VTGWORO', 'TTGW', 'DTV', 'DUV', 'DVV', 'EKGW', 'QJOULE', 'QCP', 'QRL_TOT', 'QRS_TOT', 'UI', 'VI', 'WI' - + - 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', + 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', @@ -150,4 +148,3 @@ 'neutral' - diff --git a/bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml b/bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml index ee39ddedd6..06520cc3fb 100644 --- a/bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml +++ b/bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml @@ -13,13 +13,6 @@ atm/cam/solar/SolarForcing1995-2005avg_c160929.nc epp_ion_rates - -.true. -.false. -.false. -.false. -atm/waccm/qbo/qbocoefficients_c151023.nc - CYCLICAL @@ -49,17 +42,17 @@ 0, -1, -24, -24, -120, -24, -24 1, 24, 7, 7, 10, 1, 365 - - + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', - 'WI', 'ElecColDens', 'PHIM2D', 'PS', 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', + 'WI', 'ElecColDens', 'PHIM2D', 'PS', 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'QRS_TOT', 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'QEN', 'QIN', 'QEI', 'EKGW', 'TTGW', 'UTGW_TOTAL', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', - 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', + 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', - 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', + 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', @@ -75,42 +68,37 @@ 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', 'TROPP_FD', 'KVH', 'KVM', 'KVT', 'Qbkgndtot', 'Z3GM', 'OpDens', 'EDens' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H' + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', - 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', + 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' - - + + 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN' - - - 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' + + + 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' 42 - - 'SolIonRate_Tot = jeuv_1 + jeuv_2 + jeuv_3 + jeuv_4 + jeuv_5 + jeuv_6 + jeuv_7 + jeuv_8 + jeuv_9 + jeuv_10 + jeuv_11 + jeuv_14 + jeuv_15 + jeuv_16 +', - 'jeuv_17 + jeuv_18 + jeuv_19 + jeuv_20 + jeuv_21 + jeuv_22 + jeuv_23', - - diff --git a/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml b/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml index d42aae962d..37ca427cd2 100644 --- a/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml @@ -15,12 +15,6 @@ atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc epp_ion_rates - -.true. -.false. -.false. -atm/waccm/qbo/qbocoefficients_c151023.nc - SERIAL atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc @@ -49,14 +43,14 @@ 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', - 'WI', 'ElecColDens', 'PHIM2D', 'PS', 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', + 'WI', 'ElecColDens', 'PHIM2D', 'PS', 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'QRS_TOT', 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'QEN', 'QIN', 'QEI', 'EKGW', 'TTGW', 'UTGW_TOTAL', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', - 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', + 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', @@ -75,19 +69,19 @@ 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H' + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H' 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' @@ -99,15 +93,10 @@ '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' 42 - - 'SolIonRate_Tot = jeuv_1 + jeuv_2 + jeuv_3 + jeuv_4 + jeuv_5 + jeuv_6 + jeuv_7 + jeuv_8 + jeuv_9 + jeuv_10 + jeuv_11 + jeuv_14 + jeuv_15 + jeuv_16 +', - 'jeuv_17 + jeuv_18 + jeuv_19 + jeuv_20 + jeuv_21 + jeuv_22 + jeuv_23', - - diff --git a/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml b/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml index 0422301e35..5fe9c654dd 100644 --- a/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml +++ b/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml @@ -30,10 +30,9 @@ 2000 - + .true. atm/waccm/qbo/qbocyclic28months.nc -.true. atm/waccm/lb/LBC_1765-2100_1.9x2.5_CCMI_RCP60_za_c130313.nc @@ -54,7 +53,7 @@ 2000 -.true. +.true. atm/cam/chem/trop_mozart_aero/aero @@ -95,63 +94,63 @@ 0, -1, -24, -24, -120, -24 1, 24, 7, 7, 10, 365 - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2' 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', - 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'QRS_TOT', 'QO3', 'QCO2', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2' 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', + 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'QRS_TOT', 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', - 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', - 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', - 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', - 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO2', 'NO3', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'PHIS', + 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', + 'H2', 'H2O', 'H2O2', 'HBR', 'HCFC22', 'HCL', 'HNO3', 'HO2', 'HO2NO2', 'HOBR', 'HOCL', 'HORZ', + 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO2', 'NO3', 'O3', 'OCLO', 'OCNFRAC', 'OH', 'PHIS', 'PRECC', 'PRECL', 'Q', 'QFLX', 'QPERT', 'QRL', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', 'QCP', 'QTHERMAL', 'QRL_TOT', 'PSL', 'HNO3_STS', 'HNO3_NAT', 'HNO3_GAS', 'NO_Aircraft', 'NO_Lightning', 'QRS_AUR', 'QRS_CO2NIR', 'QRS_EUV', 'SAD_ICE', 'SAD_LNAT', 'SAD_SULFC', 'TREFHT', - 'VERT', 'VTGWORO', 'VTGWSPEC', 'O2_1S', 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', - 'TCLY', 'TOTH', 'UIONTEND', 'VIONTEND', 'DTCORE', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', - 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', + 'VERT', 'VTGWORO', 'VTGWSPEC', 'O2_1S', 'O2_1D', 'NOX', 'NOY', 'CLOX', 'CLOY', 'BROX', 'BROY', + 'TCLY', 'TOTH', 'UIONTEND', 'VIONTEND', 'DTCORE', 'CLDLIQ', 'CLDICE', 'CONCLD', 'FRONTGF:I', + 'BTAUE', 'BTAUW', 'BTAUN', 'BTAUS', 'TAUE', 'TAUW', 'TAUN', 'TAUS', 'TAUGWX', 'TAUGWY', 'TAUX', 'TAUY', 'SNOWHLND', 'SNOWHICE', 'ICEFRAC', 'FSDSC', 'SFNO', 'SFCO', 'SFCH2O', 'CFC11STAR', 'TROPP_FD', 'KVH', 'KVM', 'KVT', 'Qbkgndtot', 'Z3GM', 'OpDens', 'EDens' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H' + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'O1D', 'Op2P', 'Op2D', 'Op', 'Np', 'N2p', 'O2p', 'NOp', 'QJOULE', 'SIGMAHAL', 'SIGMAPED', 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' - - - 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', - 'EDYN_ZIGM11_PED', 'EDYN_ZIGM2_HAL', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', - 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', + + + 'Z3', 'T', 'TIon', 'TElec', 'e', 'U', 'V', 'OMEGA', 'UI', 'VI', 'WI', 'ElecColDens', 'PHIM2D', 'PS', + 'PED_CONDUCTANCE', 'HALL_CONDUCTANCE', 'ED1', 'ED2', 'O', 'O2', 'H', 'NO', 'CO2', 'N', 'QRS_TOT', + 'QO3', 'QCO2', 'QNO', 'QO3P', 'QHC2S', 'QJOULE', 'EKGW', 'TTGW', 'UTGW_TOTAL', 'SolIonRate_Tot', 'Z3GM', 'OpDens', 'EDens' - - + + 'T_24_COS', 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN' - - - 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' + + + 'MSKtem', 'PS', 'PSL', 'VTHzm', 'UVzm', 'UWzm', 'Uzm', 'Vzm', 'THzm','Wzm', 'PHIS' -42 +42 '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 +', @@ -172,6 +171,6 @@ atm/cam/dst/dst_source2x2tuned-cam4-06132012.nc atm/cam/topo/USGS-gtopo30_1.9x2.5_remap_c050602.nc 1.200D0 -.false. +.false. diff --git a/bld/perl5lib/Build/ChemNamelist.pm b/bld/perl5lib/Build/ChemNamelist.pm index e415e4a299..7d4f5a6103 100644 --- a/bld/perl5lib/Build/ChemNamelist.pm +++ b/bld/perl5lib/Build/ChemNamelist.pm @@ -1,5 +1,7 @@ package Build::ChemNamelist; +no if $] >= 5.017011, warnings => 'experimental::smartmatch'; + #------------------------------------------------------------------------------------- # generates species lists for chemistry namelist settings #------------------------------------------------------------------------------------- @@ -42,7 +44,7 @@ sub chem_has_species #------------------------------------------------------------------------------- sub set_dep_lists { - my ( $cfgdir, $chem_proc_src, $chem_src_dir, $nl, $print_lvl ) = @_; + my ( $chem, $cfgdir, $chem_proc_src, $chem_src_dir, $nl, $print_lvl ) = @_; my ( $gas_wetdep_list, $aer_wetdep_list, $aer_drydep_list, $aer_sol_facti, $aer_sol_factb, $aer_scav_coef, $gas_drydep_list ) ; @@ -69,13 +71,17 @@ sub set_dep_lists if ($print_lvl>=2) {print "Chemistry species : @species_list \n" ;} if ($print_lvl>=2) {print "Not transported species : @nottransported_list \n" ;} - $gas_wetdep_list = get_gas_wetdep_list( $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); + $gas_wetdep_list = get_gas_wetdep_list( $chem, $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); + if ($print_lvl>=2) {print " gas wet dep list : $gas_wetdep_list \n" ;} - $aer_wetdep_list = get_aer_wetdep_list( $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); + $aer_wetdep_list = get_aer_wetdep_list( $chem, $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); + if ($print_lvl>=2) {print " aer wet dep list : $aer_wetdep_list \n" ;} - $gas_drydep_list = get_gas_drydep_list( $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); + $gas_drydep_list = get_gas_drydep_list( $chem, $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); + if ($print_lvl>=2) {print " dry dep list : $gas_drydep_list \n" ;} - $aer_drydep_list = get_aer_drydep_list( $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); + $aer_drydep_list = get_aer_drydep_list( $chem, $cfgdir, $print_lvl, \@species_list, \@nottransported_list ); + if ($print_lvl>=2) {print " aer dry dep list : $aer_drydep_list \n" ;} # set solubility factors for aerosols if (length($aer_wetdep_list)>2){ @@ -203,9 +209,14 @@ sub print_modal_info #------------------------------------------------------------------------------- sub get_gas_drydep_list { - my ($cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; + my ($chem,$cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; - my $master_file = "$cfg_dir/namelist_files/master_gas_drydep_list.xml"; + my $master_file = ''; + if ($chem =~ /geoschem/) { + $master_file = "$cfg_dir/namelist_files/geoschem_master_gas_drydep_list.xml"; + } else { + $master_file = "$cfg_dir/namelist_files/mozart_master_gas_drydep_list.xml"; + } my $list = get_dep_list($master_file,$print_lvl,$species_list,$nottransported_list); @@ -218,9 +229,14 @@ sub get_gas_drydep_list #------------------------------------------------------------------------------- sub get_aer_drydep_list { - my ($cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; + my ($chem,$cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; - my $master_file = "$cfg_dir/namelist_files/master_aer_drydep_list.xml"; + my $master_file = ''; + if ($chem =~ /geoschem/) { + $master_file = "$cfg_dir/namelist_files/geoschem_master_aer_drydep_list.xml"; + } else { + $master_file = "$cfg_dir/namelist_files/mozart_master_aer_drydep_list.xml"; + } my $list = get_dep_list($master_file,$print_lvl,$species_list,$nottransported_list); @@ -231,10 +247,15 @@ sub get_aer_drydep_list #------------------------------------------------------------------------------- sub get_aer_wetdep_list { - my ($cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; - - my $master_file = "$cfg_dir/namelist_files/master_aer_wetdep_list.xml"; + my ($chem,$cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; + my $master_file = ''; + if ($chem =~ /geoschem/) { + $master_file = "$cfg_dir/namelist_files/geoschem_master_aer_wetdep_list.xml"; + } else { + $master_file = "$cfg_dir/namelist_files/mozart_master_aer_wetdep_list.xml"; + } + my $list = get_dep_list($master_file,$print_lvl,$species_list,$nottransported_list); if ($print_lvl>=2) {print " aer wet dep list : $list \n" ;} @@ -244,9 +265,14 @@ sub get_aer_wetdep_list #------------------------------------------------------------------------------- sub get_gas_wetdep_list { - my ($cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; + my ($chem,$cfg_dir,$print_lvl,$species_list,$nottransported_list) = @_; - my $master_file = "$cfg_dir/namelist_files/master_gas_wetdep_list.xml"; + my $master_file = ''; + if ($chem =~ /geoschem/) { + $master_file = "$cfg_dir/namelist_files/geoschem_master_gas_wetdep_list.xml"; + } else { + $master_file = "$cfg_dir/namelist_files/mozart_master_gas_wetdep_list.xml"; + } my $list = get_dep_list($master_file,$print_lvl,$species_list,$nottransported_list); @@ -284,7 +310,6 @@ sub get_dep_list return ($list); } - #------------------------------------------------------------------------------- sub read_master_list_file { diff --git a/bld/scripts/remapfv2eul.ncl b/bld/scripts/remapfv2eul.ncl deleted file mode 100644 index 884831789c..0000000000 --- a/bld/scripts/remapfv2eul.ncl +++ /dev/null @@ -1,392 +0,0 @@ -;*************************************************************** -; NCL script to copy or remap all variables of an FV netcdf file -; to a rectilinear Gaus grid. -; remapfv2eul.ncl -; John Truesdale, May 2018 -;*************************************************************** -load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl" -load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl" -load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl" -load "$NCARG_ROOT/lib/ncarg/nclscripts/esmf/ESMF_regridding.ncl" - -;************************************************************* -; EX. USAGE -;************************************************************* -;env SRCFILE=/fs/cgd/csm/inputdata/atm/cam/inic/fv/cami-mam3_0000-01-01_0.9x1.25_L32_c141031.nc DSTLATLON=/fs/cgd/csm/inputdata/atm/cam/inic/gaus/cami_0000-01-01_128x256_L26_c030918.nc ncl < remapfv2eul.ncl -;************************************************************ - -begin -;-----The FV source files to be converted -srcFileName = getenv("SRCFILE") - -;-----The destination lat lon template file - any file that has lat lon coordinates -latlontemp = getenv("DSTLATLON") - -outpth="./" - -;----- shouldnt have to modify below here ------------- - -verbose=True ;False -debug=False ;False - -;-----interplation method -map_method=getenv("MAPMETHOD") -if (ismissing(map_method)) then -delete(map_method) -map_method = "bilinear" -end if - -;-----directory to store weights for regridding -WGT_dir=getenv("MAPPATH") -if (ismissing(WGT_dir)) then -delete(WGT_dir) -WGT_dir = systemfunc("pwd") -end if - -src_file=addfile(srcFileName,"r") -dstlatlon_file=addfile(latlontemp,"r") - -; Determine ingrid -srcdnames = getvardims(src_file) ; get level info from source file -srcdsizes = getfiledimsizes(src_file) -srcnlat = srcdsizes(ind(srcdnames.eq."lat" )); -srcnlon = srcdsizes(ind(srcdnames.eq."lon" )); -ingrid="FV_"+tostring(srcnlat)+"x"+tostring(srcnlon) -haveslat=False -if (any(srcdnames.eq."slat")) then - haveslat=True - srcnslat = srcdsizes(ind(srcdnames.eq."slat" )); - ingrid_us="FV_"+tostring(srcnslat)+"x"+tostring(srcnlon) -else - ingrid_us="SLAT_dimension_not_found" -end if -haveslon=False -if (any(srcdnames.eq."slon")) then - haveslon=True - srcnslon = srcdsizes(ind(srcdnames.eq."slon" )); - ingrid_vs="FV_"+tostring(srcnlat)+"x"+tostring(srcnslon) -else - ingrid_vs="SLON_dimension_not_found" -end if - -; Determine outgrid -dstdnames = getvardims(dstlatlon_file) ; get level info from source file -dstdsizes = getfiledimsizes(dstlatlon_file) -dstnlat = dstdsizes(ind(dstdnames.eq."lat" )); -dstnlon = dstdsizes(ind(dstdnames.eq."lon" )); -outgrid="Gaus_"+tostring(dstnlat)+"x"+tostring(dstnlon) - -srcFile=systemfunc("basename "+srcFileName) -suffix = get_file_suffix(srcFile,0) -srcbase= suffix@fBase -dstFileName = outpth+srcbase+".regrid."+outgrid+".nc" -currdate=systemfunc("date +%y%m%d") - - ; 0. Set the source/destination file names, - ; open the source file for reading, - ; create a destination file for regridded data. - ;------------------------------------------------ - - print(" ") - print("Regridding: ") - print("SRC File:"+srcFileName) - print("DST File:"+dstFileName) - if(fileexists(dstFileName)) then - system("rm "+dstFileName) - end if - - setfileoption("nc","Format","LargeFile") - dst_file=addfile(dstFileName,"c") - - -; - ; 1. Generate a description file for the source grid (EUL). - ;--------------------------------------------------- - srcGridName=WGT_dir+"/"+ingrid+"_SCRIP_desc.nc" - srcGridName_us=WGT_dir+"/"+ingrid_us+"_US_SCRIP_desc.nc" - srcGridName_vs=WGT_dir+"/"+ingrid_vs+"_VS_SCRIP_desc.nc" - Opt =True - Opt@ForceOverWrite=True - Opt@Title ="FV Grid" - Opt@Debug =False ; True - Opt@PrintTimings =False ; True - if(isfilepresent(srcGridName)) then - if (verbose) then print("Found srcGrid description "+srcGridName) end if - else - if (verbose) then print("Creating srcGrid description "+srcGridName) end if - rectilinear_to_SCRIP(srcGridName,src_file->lat,src_file->lon,Opt) - end if - if (haveslat) then - if(isfilepresent(srcGridName_us)) then - if (verbose) then print("Found srcGrid description "+srcGridName_us) end if - else - if (verbose) then print("Creating srcGrid description "+srcGridName_us) end if - rectilinear_to_SCRIP(srcGridName_us,src_file->slat,src_file->lon,Opt) - end if - end if - if (haveslon) then - if(isfilepresent(srcGridName_vs)) then - if (verbose) then print("Found srcGrid description "+srcGridName_vs) end if - else - if (verbose) then print("Creating srcGrid description "+srcGridName_vs) end if - rectilinear_to_SCRIP(srcGridName_vs,src_file->lat,src_file->slon,Opt) - end if - end if - delete(Opt) - - ; - ; 2. Generate a description file for the destination grid (EUL). - ;----------------------------------------------------- - dstGridName = WGT_dir+"/"+outgrid+"_SCRIP_desc.nc" - - if(isfilepresent(dstGridName)) then - if (verbose) then print("Found dstGrid description "+dstGridName) end if - else - if (verbose) then print("Creating dstGrid description "+dstGridName) end if - Opt =True - Opt@ForceOverWrite=True - Opt@Debug =False ; True - Opt@PrintTimings =False ; True - rectilinear_to_SCRIP(dstGridName,dstlatlon_file->lat,dstlatlon_file->lon,Opt) - delete(Opt) - end if - - ; - ; 3. Generate the weights file, using the source and - ; destination files created in #1 and #2. - ;----------------------------------------------------- - wgtFileName = WGT_dir+"/map_"+ingrid+"_to_"+outgrid+"_"+map_method+".nc" - wgtFileName_us2u = WGT_dir+"/map_"+ingrid_us+"_US_to_"+outgrid+"_U_"+map_method+".nc" - wgtFileName_vs2v = WGT_dir+"/map_"+ingrid_vs+"_VS_to_"+outgrid+"_V_"+map_method+".nc" - - Opt = True - Opt@InterpMethod =map_method ;"bilinear" "patch", "conserve" - Opt@ForceOverWrite=True - Opt@OverWrite=True - Opt@SrcESMF =False - Opt@DstESMF =False - Opt@Debug =False ; True - Opt@PrintTimings =False ; True - - if(isfilepresent(wgtFileName)) then - if (verbose) then print("Found WeightFiles "+wgtFileName) end if - else - if (verbose) then print("Creating WeightFiles "+wgtFileName) end if - ESMF_regrid_gen_weights(srcGridName,dstGridName,wgtFileName,Opt) - end if - if (haveslat) then - if(isfilepresent(wgtFileName_us2u)) then - if (verbose) then print("Found WeightFiles "+wgtFileName_us2u) end if - else - if (verbose) then print("Creating WeightFile "+wgtFileName_us2u) end if - ESMF_regrid_gen_weights(srcGridName_us,dstGridName,wgtFileName_us2u,Opt) - end if - end if - if (haveslon) then - if(isfilepresent(wgtFileName_vs2v)) then - if (verbose) then print("Found WeightFiles "+wgtFileName_vs2v) end if - else - if (verbose) then print("Creating WeightFile "+wgtFileName_vs2v) end if - ESMF_regrid_gen_weights(srcGridName_vs,dstGridName,wgtFileName_vs2v,Opt) - end if - end if - delete(Opt) - - - ;--- Specify a list of 1D variables on the *source file* that should NOT be copied - var_in_exclude = (/"lat", "lon", "w_stag", "gw", "slat","slon", "area", "date_written", "time_written"/) - - ;--- Specify a list of variables on the source file that should be directly copied - var_in_copy = (/"time_bnds"/) - - ;--- Specify a list of variables to be regridded - var_out = "All_Variables" ; to be regridded - - ;---Read from the weight file the method used to derive the remap weights - wgt_file = addfile(wgtFileName, "r") - dst_grid_dims = wgt_file->dst_grid_dims - dst_mlon = dst_grid_dims(0) - dst_nlat = dst_grid_dims(1) - dst_lat = wgt_file->yc_b(::dst_mlon) - dst_lon = wgt_file->xc_b(:dst_mlon-1) - - ;---Use the destination (EUL) grid info on the weight file to create lat/lon - lat = dst_lat ; get from weight file - lat@long_name = "latitude" - lat!0 = "lat" - lat@units = "degrees_north" - lat&lat = lat - nlat = dimsizes(lat) ; same as dst_nlat - - lon = dst_lon - lon@long_name = "longitude" - lon!0 = "lon" - lon@units = "degrees_east" - lon&lon = lon - mlon = dimsizes(lon) ; same as dst_mlon - - -;---Get all variables on the FV file - var_in = getfilevarnames( src_file ) - nvar_in = dimsizes(var_in) - Opt_RGRD = True - - if (verbose) then print("creating new file by copying variable meta data from "+srcFile) end if - -;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -; PREDEFINE MODE -;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - setfileoption(dst_file,"DefineMode",True) - -;=================================================================== -; create global attributes of the netCDF file containing regridded data -;=================================================================== - global = True - global@separator2= "---------------------------------------" - copy_VarAtts(src_file, global) - global@separator1= "------- SOURCE FILE ATTRIBUTES --------" - - if (isatt(src_file,"title")) then - global@TITLE = "REMAPPED: "+src_file@title - end if - - global@remap = "NCL: ESMF_regrid_with_weights" - global@map_method = map_method - global@creation_date = systemfunc("date") - - fileattdef( dst_file, global ) ; copy file attributes to netCDF file - -;=================================================================== -; predefine the coordinate dimension names and their sizes -;=================================================================== - dNames = getvardims(src_file) ; get level info from source file - dSizes = getfiledimsizes(src_file) - ia = ind(dNames.eq."lev" ) ; # of levels - ib = ind(dNames.eq."ilev") - klev = dSizes(ia) - klevi = dSizes(ib) - ; standard CAM dimensions - dimNames = (/"time", "lat", "lon", "lev", "ilev", "nbnd", "chars", "scalar"/) - dimSizes = (/ -1 , nlat , mlon , klev, klevi , 2 , 8 , 1 /) - dimUnlim = (/ True , False, False, False , False , False,False ,False /) - filedimdef(dst_file,dimNames,dimSizes,dimUnlim) - -;--- The following are explicitly added because they are 'special' - - filevardef(dst_file, "lat", typeof(lat), getvardims(lat)) - filevarattdef(dst_file,"lat" ,lat) - - filevardef(dst_file, "lon", typeof(lon), getvardims(lon)) - filevarattdef(dst_file,"lon" ,lon) - -; filevardef(dst_file, "gw", typeof(gw), getvardims(gw)) -; filevarattdef(dst_file,"gw" ,gw) - -;--- Loop over all variables and predfine meta data -; do nv=0,nvar_in-1 - do nv=0,nvar_in-1 - if (.not.any(var_in(nv).eq.var_in_exclude)) then - if(var_out(0).eq."All_Variables" .or. \ - any(var_in(nv).eq.var_out) .or. \ - any(var_in(nv).eq.var_in_copy) ) then - - rank_in = dimsizes(getfilevardimsizes(src_file, var_in(nv))) - if (debug) then print(rank_in+var_in(nv)) end if - if (rank_in .eq.1 .or. any(var_in(nv).eq.var_in_copy) ) then - if (debug) then print(var_in(nv)+" rank 1") end if - filevardef(dst_file, var_in(nv), getfilevartypes(src_file,var_in(nv)) \ - , getfilevardims(src_file,var_in(nv)) ) - end if - if (rank_in .eq.2 .and. .not.any(var_in(nv).eq.var_in_copy)) then - if (debug) then print(var_in(nv)+" rank 2 lat lon") end if - filevardef(dst_file, var_in(nv), getfilevartypes(src_file,var_in(nv)) \ - , (/"lat", "lon" /) ) - end if - if (rank_in .eq.3 .and. .not.any(var_in(nv).eq.var_in_copy)) then - if (debug) then print(var_in(nv)+" rank 3 time lat lon") end if - filevardef(dst_file, var_in(nv), getfilevartypes(src_file,var_in(nv)) \ - , (/"time","lat", "lon" /) ) - end if - if (rank_in .eq.4.) then - vdims = getfilevardims(src_file, var_in(nv)) - if (debug) then print(var_in(nv)+" rank 4 time lev lat lon") end if - if (var_in(nv).eq."US") then - if (debug) then print("U rank 4 time lev lat lon") end if - filevardef(dst_file, "U", getfilevartypes(src_file,var_in(nv)) \ - , (/ "time", vdims(1), "lat", "lon" /) ) - else if (var_in(nv).eq."VS") then - if (debug) then print("V rank 4 time lev lat lon") end if - filevardef(dst_file, "V", getfilevartypes(src_file,var_in(nv)) \ - , (/ "time", vdims(1), "lat", "lon" /) ) - else - if (debug) then print(var_in(nv)+" rank 4 time lev lat lon") end if - filevardef(dst_file, var_in(nv), getfilevartypes(src_file,var_in(nv)) \ - , (/ "time", vdims(1), "lat", "lon" /) ) - end if - end if - delete(vdims) - end if - dumAtts = new( 1, getfilevartypes(src_file,var_in(nv))) - varAtts = getfilevaratts(src_file, var_in(nv)) - if (.not.ismissing(varAtts(0))) then - nAtts = dimsizes(varAtts) - do na=0,nAtts-1 - dumAtts@$varAtts(na)$ = src_file->$var_in(nv)$@$varAtts(na)$ - end do - if (var_in(nv).eq."US") then - filevarattdef(dst_file, "U" , dumAtts) - else if (var_in(nv).eq."VS") then - filevarattdef(dst_file, "V" , dumAtts) - else - filevarattdef(dst_file, var_in(nv) , dumAtts) - end if - end if - end if - delete([/varAtts, dumAtts/]) ; may change size next iteration - end if - end if - end do ; nv - -;=================================================================== -; explicitly exit file definition mode. **NOT REQUIRED in NCL** -;=================================================================== - setfileoption(dst_file,"DefineMode",False) - -;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -; Write the basic and regridded data values to the predefined structures -;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - if (verbose) then print("regridding all variables ... ") end if - - dst_file->lat = (/ lat /) - dst_file->lon = (/ lon /) -; dst_file->gw = (/ gw /) - - do nv=0,nvar_in-1 - - if (.not.any(var_in(nv).eq.var_in_exclude)) then - if(var_out(0).eq."All_Variables" .or. \ - any(var_in(nv).eq.var_out) .or. \ - any(var_in(nv).eq.var_in_copy) ) then - - rank_in = dimsizes(getfilevardimsizes(src_file, var_in(nv))) - - if (rank_in .eq.1 .or. any(var_in(nv).eq.var_in_copy) ) then - dst_file->$var_in(nv)$ = (/ src_file->$var_in(nv)$ /) - end if - if (rank_in .ge.2 .and. .not.any(var_in(nv).eq.var_in_copy)) then - if (debug) then print(var_in(nv)) end if - if (var_in(nv).eq."VS") then - dst_file->V = (/ ESMF_regrid_with_weights(src_file->$var_in(nv)$,wgtFileName_vs2v,Opt_RGRD) /) - else if (var_in(nv).eq."US") then - dst_file->U = (/ ESMF_regrid_with_weights(src_file->$var_in(nv)$,wgtFileName_us2u,Opt_RGRD) /) - else - dst_file->$var_in(nv)$ = (/ ESMF_regrid_with_weights(src_file->$var_in(nv)$,wgtFileName,Opt_RGRD) /) - end if - end if - end if - end if - end if - if (nv.ne.nvar_in-1) then system("echo -n .") else system("echo .") end if - end do ; nv - if (verbose) then print("Finished!!") end if -end diff --git a/ccs_config b/ccs_config new file mode 160000 index 0000000000..f3cae52b30 --- /dev/null +++ b/ccs_config @@ -0,0 +1 @@ +Subproject commit f3cae52b3096639d767778fa8033efe5e2d79cf0 diff --git a/chem_proc b/chem_proc new file mode 160000 index 0000000000..f923081508 --- /dev/null +++ b/chem_proc @@ -0,0 +1 @@ +Subproject commit f923081508f4264e61fcef2753a9898e55d1598e diff --git a/cime b/cime new file mode 160000 index 0000000000..cdf76d6919 --- /dev/null +++ b/cime @@ -0,0 +1 @@ +Subproject commit cdf76d691961d697feafc14907f81b9c195dfe99 diff --git a/cime_config/SystemTests/mgp.py b/cime_config/SystemTests/mgp.py new file mode 100644 index 0000000000..ab2232eda0 --- /dev/null +++ b/cime_config/SystemTests/mgp.py @@ -0,0 +1,47 @@ +""" +CIME MGP test. This class inherits from SystemTestsCompareTwo + +This is a changing config options test to compare between MG3 and +PUMAS in cam7. The use of MG3 or PUMAS should be bfb. +This is just like an ERC test and it's meant for CAM only +as it only does a single build. + +(1) Do an initial run with microphys setup as MG3 (suffix MG3) +(2) Do an initial run with microphys setup as PUMAS (suffix PUMAS) +""" + +import sys +from CIME.XML.standard_module_setup import * +from CIME.SystemTests.system_tests_compare_two import SystemTestsCompareTwo + +logger = logging.getLogger(__name__) + +class MGP(SystemTestsCompareTwo): + + def __init__(self, case, + separate_builds=True, + run_one_suffix="mg3", + run_two_suffix="pumas", + run_one_description="MG3 microphysics", + run_two_description="PUMAS microphysics", + multisubmit=False, + **kwargs + ): + SystemTestsCompareTwo.__init__(self, case, + separate_builds=separate_builds, + run_one_suffix=run_one_suffix, + run_two_suffix=run_two_suffix, + run_one_description=run_one_description, + run_two_description=run_two_description, + multisubmit=multisubmit, + **kwargs + ) + def _case_one_setup(self): + stop_n = self._case1.get_value("STOP_N") + expect(stop_n >= 3, "STOP_N must be at least 3, STOP_N = {}".format(stop_n)) + self._case.set_value("CAM_CONFIG_OPTS","-phys cam7 -microphys mg3") + + def _case_two_setup(self): + self._case.set_value("CAM_CONFIG_OPTS","-phys cam7 -microphys pumas") + + diff --git a/cime_config/SystemTests/plb.py b/cime_config/SystemTests/plb.py index 8fa36624f2..8ca8a1e840 100644 --- a/cime_config/SystemTests/plb.py +++ b/cime_config/SystemTests/plb.py @@ -2,16 +2,16 @@ Implementation of the CAM physics load balancing test. This is a CAM specific test: -Verifies that changeing pyhysics load balancing doesn't change answers -(1) do a run with the default physics load balancing -(2) Do a run with the new physics load balancing from the namelist change +Verifies that changing physics load balancing doesn't change answers +(1) do a run with the default physics load balancing +(2) Do a run with the new physics load balancing from the namelist change """ from CIME.SystemTests.system_tests_compare_two import SystemTestsCompareTwo from CIME.XML.standard_module_setup import * from CIME.SystemTests.test_utils.user_nl_utils import append_to_user_nl_files -from CIME.utils import append_testlog +from CIME.status import append_testlog logger = logging.getLogger(__name__) @@ -19,8 +19,8 @@ class PLB(SystemTestsCompareTwo): def __init__(self, case): SystemTestsCompareTwo.__init__(self, case, - separate_builds = True, - ignore_fieldlist_diffs = True, + separate_builds = False, + ignore_fieldlist_diffs = False, run_two_suffix = 'default', run_one_description = 'Default phys_loadbalance', run_two_description = 'Changed phys_loadbalance') @@ -29,13 +29,9 @@ def _case_one_setup(self): append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "phys_loadbalance = 2") - comments = "Setting phys_loadbalance to default 2." + comments = "Overriding phys_loadbalance to 2 (usual default)." append_testlog(comments, self._orig_caseroot) def _case_two_setup(self): - CAM_CONFIG_OPTS = self._case1.get_value("CAM_CONFIG_OPTS") - self._case.set_value("CAM_CONFIG_OPTS",CAM_CONFIG_OPTS.replace(' -nadv_tt 5 -cppdefs -DTRACER_CHECK','')) - comments = "Setting phys_loadbalance to value that's set in the testmod." + comments = "Leave phys_loadbalance at value that's set in the testmod." append_testlog(comments, self._orig_caseroot) - - diff --git a/cime_config/SystemTests/sct.py b/cime_config/SystemTests/sct.py index 79700cfae3..66c739e115 100644 --- a/cime_config/SystemTests/sct.py +++ b/cime_config/SystemTests/sct.py @@ -14,7 +14,7 @@ from CIME.XML.standard_module_setup import * from CIME.SystemTests.test_utils.user_nl_utils import append_to_user_nl_files from CIME.test_status import * -from CIME.utils import append_testlog +from CIME.status import append_testlog logger = logging.getLogger(__name__) @@ -30,47 +30,62 @@ 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") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "fincl2='T','Q','TDIFF','QDIFF','LANDFRAC'") - append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "iopfile = '../"+case_name+".cam.h1."+RUN_STARTDATE+"-00000.nc'") + append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "iopfile = '../"+case_name+".cam.h1i."+RUN_STARTDATE+"-00000.nc'") 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) self._case.set_value("ROOTPE_{}".format(comp), 0) - self._case.set_value("PTS_MODE","TRUE") - self._case.set_value("PTS_LAT",-20.0) - self._case.set_value("PTS_LON",140.0) + if self._case.get_value("COMP_INTERFACE") == "mct": + self._case.set_value("PTS_MODE","TRUE") - 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/*h1*8400.nc ') - stat,DIFFs,err=run_cmd('ncdump -ff -p 9,17 -v QDIFF,TDIFF '+netcdf_filename+' | egrep //\.\*DIFF | sed s/^\ \*// | sed s/\[,\;\].\*// | sed s/^0/0.0/ | uniq') + 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]) comments="Checking QDIFF,TDIFF in SCAM run." append_testlog(comments, self._orig_caseroot) - # Test for greater that round off changes. + # Test for greater than round off changes. if answer < 1e-10: self._test_status.set_status("{}_{}_{}".format(COMPARE_PHASE, self._run_one_suffix, self._run_two_suffix), TEST_PASS_STATUS) comments="QDIFF,TDIFF: PASS" @@ -78,3 +93,13 @@ def _component_compare_test(self, suffix1, suffix2, self._test_status.set_status("{}_{}_{}".format(COMPARE_PHASE, self._run_one_suffix, self._run_two_suffix), TEST_FAIL_STATUS) comments="QDIFF,TDIFF: Difference greater than round off." append_testlog(comments, self._orig_caseroot) + + def _case_two_custom_prerun_action(self): + """ On NCAR derecho system the mpibind script causes ESMF in the second job to think it is using 128 tasks when it should only use 1 + changing the env variable PBS_SELECT solves this issue + """ + machine = self._case2.get_value("MACH") + if "derecho" in machine: + os.environ["PBS_SELECT"] = "1:ncpus=1:mpiprocs=1:ompthreads=1:mem=230gb:Qlist=cpu:ngpus=0" + + diff --git a/cime_config/SystemTests/sub.py b/cime_config/SystemTests/sub.py index d35b19e6c0..54ec144d4b 100644 --- a/cime_config/SystemTests/sub.py +++ b/cime_config/SystemTests/sub.py @@ -11,7 +11,7 @@ from CIME.SystemTests.system_tests_compare_two import SystemTestsCompareTwo from CIME.XML.standard_module_setup import * from CIME.SystemTests.test_utils.user_nl_utils import append_to_user_nl_files -from CIME.utils import append_testlog +from CIME.status import append_testlog logger = logging.getLogger(__name__) diff --git a/cime_config/SystemTests/tmc.py b/cime_config/SystemTests/tmc.py index b8d5cde1d7..1e0bc925a2 100644 --- a/cime_config/SystemTests/tmc.py +++ b/cime_config/SystemTests/tmc.py @@ -5,12 +5,11 @@ from CIME.XML.standard_module_setup import * from CIME.SystemTests.system_tests_common import SystemTestsCommon from CIME.test_status import * -from CIME.utils import append_testlog +from CIME.status import append_testlog +from CIME.baselines.performance import get_latest_cpl_logs import glob, gzip -logger = logging.getLogger(__name__) - class TMC(SystemTestsCommon): def __init__(self, case): @@ -21,46 +20,40 @@ def __init__(self, case): def run_phase(self): + with self._test_status: + self._test_status.set_status("COMPARE_MASS", TEST_PEND_STATUS) self.run_indv() - cesmlog = ''.join(self._get_latest_cpl_logs()) - if '.gz' == cesmlog[-3:]: + cpllog = ''.join(get_latest_cpl_logs(self._case)) + atmlog = cpllog.replace("cpl.log","atm.log") + atmlog = atmlog.replace("med.log","atm.log") + if '.gz' == atmlog[-3:]: fopen = gzip.open else: fopen = open - with fopen(cesmlog, "rb") as f: - lines = [line.rstrip('\n') for line in f] - first_val = 0.0 + f = fopen(atmlog,'r') + lines = f.readlines() + first_val = -9.0 with self._test_status: - self._test_status.set_status(RUN_PHASE, TEST_PASS_STATUS) + self._test_status.set_status("COMPARE_MASS", TEST_PASS_STATUS) + use_this_tt_un = False for line in lines: - if re.search('between DRY m=30 name=TT_UN gavg dry, wet, min, max',line): - if first_val == 0.0: - first_val = re.findall('\s*[\d]+ name=TT_UN [^0-9]+([\S]+)',line) - if first_val != re.findall('\s*[\d]+ name=TT_UN [^0-9]+([\S]+)',line): - with self._test_status: - self._test_status.set_status(RUN_PHASE, TEST_FAIL_STATUS) - comments = "CAM mass conservation test FAILED." - CIME.utils.append_testlog(comments, self._orig_caseroot) - first_var = 1.1 - - def _get_latest_cesm_logs(self): - """ - find and return the latest cesm log file in the run directory - """ - coupler_log_path = self._case.get_value("RUNDIR") - cesmlogs = glob.glob(os.path.join(coupler_log_path, 'cesm*.log.*')) - lastcesmlogs = [] - if cesmlogs: - lastcesmlogs.append(max(cesmlogs, key=os.path.getctime)) - basename = os.path.basename(lastcesmlogs[0]) - suffix = basename.split('.',1)[1] - for log in cesmlogs: - if log in lastcesmlogs: - continue - - if log.endswith(suffix): - lastcesmlogs.append(log) - - return lastcesmlogs + if re.search('vvvvv gmean_mass: before tphysbc DRY',line.decode('utf-8')): + use_this_tt_un = True + if re.search('TT_UN ',line.decode('utf-8')) and use_this_tt_un: + tt_un_flt=re.findall("\d+\.\d+",line.decode('utf-8')) + if len(tt_un_flt) > 0: + if first_val == -9.0: + first_val = tt_un_flt[0] + if first_val != tt_un_flt[0]: + with self._test_status: + self._test_status.set_status("COMPARE_MASS", TEST_FAIL_STATUS, comments="Mass Not Conserved") + comments = "CAM mass conservation test FAILED." + append_testlog(comments, self._orig_caseroot) + use_this_tt_un = False + if first_val == -9.0: + with self._test_status: + self._test_status.set_status("COMPARE_MASS", TEST_FAIL_STATUS, comments="Failed to find TT_UN in atm.log") + comments = "CAM mass conservation test FAILED." + append_testlog(comments, self._orig_caseroot) diff --git a/cime_config/buildcpp b/cime_config/buildcpp index 904535b7ab..fac7dcbf68 100644 --- a/cime_config/buildcpp +++ b/cime_config/buildcpp @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """ API for cam's configure @@ -11,11 +11,11 @@ import os, sys, re CIMEROOT = os.environ.get("CIMEROOT") if CIMEROOT is None: raise SystemExit("ERROR: must set CIMEROOT environment variable") -sys.path.append(os.path.join(CIMEROOT, "scripts", "Tools")) +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 @@ -49,21 +49,6 @@ def buildcpp(case): atm_grid = match.groups()[0] nlev = match.groups()[1] - # The following translations are hard-wired to support the differences - # between how the CESM scripts specify the grid and how it is specified - # by CAM's build and run system. - - if atm_grid == 'T5': - atm_grid = '8x16' - if atm_grid == 'T31': - atm_grid = '48x96' - if atm_grid == 'T42': - atm_grid = '64x128' - if atm_grid == 'T85': - atm_grid = '128x256' - if atm_grid == 'T341': - atm_grid = '512x1024' - # Need to relax this error tolerance for the SE variable resolution grids if atm_grid[0:3] == 'ne0': case.set_value("EPS_AAREA", "1.0e-04") @@ -73,13 +58,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? - match = re.match(r'ne[0-9]', atm_grid) - if match: - 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, @@ -88,10 +66,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: @@ -134,7 +108,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 c868340f84..0328e84f2f 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -1,23 +1,25 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """ create the cam library """ -#pylint: disable=multiple-imports, wrong-import-position, wildcard-import -#pylint: disable=unused-wildcard-import, bad-whitespace, too-many-locals -#pylint: disable=invalid-name -import sys, os, filecmp, shutil, imp +# pylint: disable=multiple-imports, wrong-import-position, wildcard-import +# pylint: disable=unused-wildcard-import, bad-whitespace, too-many-locals +# pylint: disable=invalid-name +import sys, os, filecmp, shutil + _CIMEROOT = os.environ.get("CIMEROOT") if _CIMEROOT is None: raise SystemExit("ERROR: must set CIMEROOT environment variable") -_LIBDIR = os.path.join(_CIMEROOT, "scripts", "Tools") +_LIBDIR = os.path.join(_CIMEROOT, "CIME", "Tools") sys.path.append(_LIBDIR) from standard_script_setup import * from CIME.case import Case -from CIME.utils import run_cmd, expect +from CIME.utils import run_sub_or_cmd, expect, run_cmd +from CIME.utils import import_from_file from CIME.buildlib import parse_input from CIME.build import get_standard_makefile_args @@ -25,49 +27,69 @@ logger = logging.getLogger(__name__) ############################################################################### def _build_fms(caseroot, libroot, bldroot): -############################################################################### + ############################################################################### with Case(caseroot) as case: # Only need FMS for fv3 dycore cam_dycore = case.get_value("CAM_DYCORE") - if cam_dycore == 'fv3': + srcroot = case.get_value("SRCROOT") + if cam_dycore == "fv3": + # first check for the external FMS library and build it # Check to see if some other component built it already - if not os.path.exists(os.path.join(libroot,"libfms.a")): - # first check for the external FMS library and build it - srcroot = case.get_value("SRCROOT") - fmsbuildlib = os.path.join(srcroot,"libraries","FMS","buildlib") - fmsbuilddir = os.path.join(case.get_value("EXEROOT"),"FMS") - expect(os.path.exists(fmsbuildlib), "FMS external not found") - stat, _, err = run_cmd("{} {} {} {}".format(fmsbuildlib, case.get_value("EXEROOT"), fmsbuilddir, caseroot), verbose=True) - expect(stat==0, "FMS build Failed {}".format(err)) - - libfms = os.path.join(bldroot,"FMS","libfms.a") - if os.path.exists(libfms): - shutil.copy(libfms, libroot) + fmsbuildlib = os.path.join(srcroot, "libraries", "FMS", "buildlib") + librootfms = os.path.join(libroot, "libfms.a") + if not os.path.exists(librootfms): + if case.get_value("DEBUG"): + strdebug = "debug" + else: + strdebug = "nodebug" + + if case.get_value("BUILD_THREADED"): + strthread = "threads" + else: + strthread = "nothreads" + + mpilib = case.get_value("MPILIB") + sharedpath = os.path.join(case.get_value("COMPILER"), mpilib, + strdebug, strthread) + slr = os.path.abspath(case.get_value("SHAREDLIBROOT")) + fmsbuildroot = os.path.join(slr, sharedpath) + fmsinstallpath = os.path.join(fmsbuildroot, "FMS") + install_libfms = os.path.join(fmsinstallpath, "libfms.a") + + if not os.path.exists(install_libfms): + if not os.path.exists(fmsbuildlib): + #todo: call checkout_externals to get this component + expect(False, "FMS external not found") + else: + stat, _, err = run_cmd(f"{fmsbuildlib} {fmsbuildroot} {fmsinstallpath} {caseroot}", verbose=True) + expect(stat==0, f"FMS build Failed {err}") + + if os.path.exists(install_libfms): + shutil.copy(install_libfms, libroot) ############################################################################### def _build_cam(caseroot, libroot, bldroot): -############################################################################### + ############################################################################### with Case(caseroot, read_only=False) as case: srcroot = case.get_value("SRCROOT") - #------------------------------------------------------- + # ------------------------------------------------------- # Call cam's buildcpp - #------------------------------------------------------- + # ------------------------------------------------------- testpath = os.path.join(srcroot, "components", "cam") if os.path.exists(testpath): srcroot = testpath - cmd = os.path.join(os.path.join(srcroot, - "cime_config", "buildcpp")) + cmd = os.path.join(os.path.join(srcroot, "cime_config", "buildcpp")) logger.info(" ...calling cam buildcpp to set build time options") try: - mod = imp.load_source("buildcpp", cmd) - cam_cppdefs = mod.buildcpp(case) + buildcpp = import_from_file("buildcpp", cmd) + cam_cppdefs = buildcpp.buildcpp(case) except: - raise + raise RuntimeError("CAM's 'buildcpp' script failed to run properly.") with Case(caseroot) as case: @@ -76,16 +98,31 @@ def _build_cam(caseroot, libroot, bldroot): gmake_j = case.get_value("GMAKE_J") gmake = case.get_value("GMAKE") mach = case.get_value("MACH") - - #------------------------------------------------------- + user_incldir = None + cam_dycore = case.get_value("CAM_DYCORE") + if cam_dycore == "fv3": + slr = os.path.abspath(case.get_value("SHAREDLIBROOT")) + compiler = case.get_value("COMPILER") + mpilib = case.get_value("MPILIB") + debug = "debug" if case.get_value("DEBUG") else "nodebug" + 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, "FMS") + user_incldir = '"-I{} -I{} -I{}"'.format( + os.path.join(srcroot, "libraries", "FMS", "src", "include"), + os.path.join(srcroot, "libraries", "FMS", "src", "mpp", "include"), + fmsbuilddir) + + # ------------------------------------------------------- # Filepath is created in caseroot/camconf by the call # to buildcpp - this needs to be copied to bldroot - #------------------------------------------------------- + # ------------------------------------------------------- filesrc = os.path.join(caseroot, "Buildconf", "camconf", "Filepath") filedst = os.path.join(bldroot, "Filepath_tmp") shutil.copy(filesrc, filedst) - filedst = os.path.join(bldroot, "Filepath") + filedst = os.path.join(bldroot, "Filepath") filedst_tmp = os.path.join(bldroot, "Filepath_tmp") if os.path.isfile(filedst): if not filecmp.cmp(filedst_tmp, filedst): @@ -93,28 +130,43 @@ def _build_cam(caseroot, libroot, bldroot): else: shutil.move(filedst_tmp, filedst) - #------------------------------------------------------- + # ------------------------------------------------------- + # fms is needed by fv3 and should have been built by the framework + # ------------------------------------------------------- + if cam_dycore == "fv3": + libfms = os.path.join(fmsbuilddir, "libfms.a") + expect(os.path.isfile(libfms), "FMS library not found {}".format(libfms)) + shutil.copy(libfms, libroot) + + # ------------------------------------------------------- # build the library - #------------------------------------------------------- - complib = os.path.join(libroot, "libatm.a") + # ------------------------------------------------------- + complib = os.path.join(libroot, "libatm.a") makefile = os.path.join(casetools, "Makefile") - cmd = "{} complib -j {} MODEL=cam COMPLIB={} -f {} {} " \ - .format(gmake, gmake_j, complib, makefile, get_standard_makefile_args(case)) + cmd = "{} complib -j {} COMP_NAME=cam COMPLIB={} -f {} {} ".format( + gmake, gmake_j, complib, makefile, get_standard_makefile_args(case) + ) if cam_cppdefs: cmd += " USER_CPPDEFS='{}'".format(cam_cppdefs) + if user_incldir: + cmd += " USER_INCLDIR={}".format(user_incldir) + rc, out, err = run_cmd(cmd) logger.info("%s: \n\n output:\n %s \n\n err:\n\n%s\n", cmd, out, err) expect(rc == 0, "Command %s failed with rc=%s" % (cmd, rc)) + ############################################################################### + def _main_func(): caseroot, libroot, bldroot = parse_input(sys.argv) _build_fms(caseroot, libroot, bldroot) _build_cam(caseroot, libroot, bldroot) + ############################################################################### if __name__ == "__main__": diff --git a/cime_config/buildnml b/cime_config/buildnml index 692e3f7d65..674d1a29ea 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -1,10 +1,10 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """ CAM namelist creator """ # pylint: disable=multiple-imports -import sys, os, shutil, filecmp, imp +import sys, os, shutil, filecmp _CIMEROOT = os.environ.get("CIMEROOT") if _CIMEROOT is None: @@ -19,7 +19,7 @@ from standard_script_setup import * from CIME.XML.standard_module_setup import * from CIME.buildnml import create_namelist_infile, parse_input from CIME.case import Case -from CIME.utils import expect, run_cmd +from CIME.utils import expect, run_cmd, import_from_file logger = logging.getLogger(__name__) @@ -36,6 +36,7 @@ def buildnml(case, caseroot, compname): din_loc_root = case.get_value("DIN_LOC_ROOT") atm_ncpl = case.get_value("ATM_NCPL") CAM_NAMELIST_OPTS = case.get_value("CAM_NAMELIST_OPTS") + CAM_CONFIG_OPTS = case.get_value("CAM_CONFIG_OPTS") CAM_NML_USE_CASE = case.get_value("CAM_NML_USE_CASE") DEBUG = case.get_value("DEBUG") NINST_ATM = case.get_value("NINST_ATM") @@ -45,6 +46,7 @@ def buildnml(case, caseroot, compname): RUN_REFCASE = case.get_value("RUN_REFCASE") RUN_REFDATE = case.get_value("RUN_REFDATE") RUN_REFTOD = case.get_value("RUN_REFTOD") + COMP_INTERFACE = case.get_value("COMP_INTERFACE") testsrc = os.path.join(srcroot, "components", "cam") if os.path.exists(testsrc): @@ -54,27 +56,27 @@ def buildnml(case, caseroot, compname): # call buildcpp to set both cppdefs and config_cache.xml file for generating namelist #-------------------------------------------------------------------- call_buildcpp = False - if not os.path.exists(os.path.join(caseroot,"LockedFiles","env_build.xml")): + camconf = os.path.join(caseroot, "Buildconf", "camconf") + filename = os.path.join(camconf, "config_cache.xml") + if not os.path.isfile(filename): call_buildcpp = True else: file1 = os.path.join(caseroot,"env_build.xml") file2 = os.path.join(caseroot,"LockedFiles","env_build.xml") - if not filecmp.cmp(file1, file2): + if os.path.isfile(file2) and not filecmp.cmp(file1, file2): call_buildcpp = True if call_buildcpp: cmd = os.path.join(os.path.join(srcroot,"cime_config","buildcpp")) logger.info(" ...calling cam buildcpp to set build time options") try: - mod = imp.load_source("buildcpp", cmd) - mod.buildcpp(case) + buildcpp = import_from_file("buildcpp", cmd) + _ = buildcpp.buildcpp(case) except: - raise + logger.warning(" ...cam buildcpp exited with error") # Verify that we have a config_cache file (generated by the call to buildcpp) - camconf = os.path.join(caseroot, "Buildconf", "camconf") - filename = os.path.join(camconf, "config_cache.xml") expect(os.path.isfile(filename), - " Missing config_cache.xml - cannot run build-namelist") + " Missing CAM's config_cache.xml - cannot run build-namelist") #-------------------------------------------------------------------- # Invoke cam build-namelist - output will go in $CASEROOT/Buildconf/camconf @@ -168,6 +170,9 @@ def buildnml(case, caseroot, compname): buildnl_opts += ["-namelist", '" &atmexp ' + CAM_NAMELIST_OPTS + '/" '] + if COMP_INTERFACE == 'nuopc': + buildnl_opts.append("-cmeps") + cmd = os.path.join(srcroot, "bld", "build-namelist") cmd += " " + " ".join(buildnl_opts) @@ -195,6 +200,20 @@ def buildnml(case, caseroot, compname): if (os.path.isfile(file1)) and (not os.path.isfile(file2)): shutil.copy(file1,file2) + # ----------------------------------------------------- + # copy geos-chem config files to rundir if using geos-chem chemistry + # ----------------------------------------------------- + + if os.path.isdir(rundir) \ + and os.path.exists(os.path.join(caseroot, "species_database.yml"))\ + and '-chem geoschem' in CAM_CONFIG_OPTS: + for fname in ['species_database.yml', 'geoschem_config.yml', + 'HISTORY.rc', 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: + file1 = os.path.join(caseroot, fname) + file2 = os.path.join(rundir, fname) + logger.info("GEOS-Chem config file copy: file1 %s file2 %s ", file1, file2) + shutil.copy(file1,file2) + ############################################################################### def _main_func(): diff --git a/cime_config/cam.case_setup.py b/cime_config/cam.case_setup.py new file mode 100755 index 0000000000..e8cb17c5a6 --- /dev/null +++ b/cime_config/cam.case_setup.py @@ -0,0 +1,69 @@ +#! /usr/bin/env python3 + +"""Copy GEOS-Chem configuration files from source to the case directory. +This script is run from CIME when calling case.setup""" + +import logging +import os +import shutil +import sys + +_CIMEROOT = os.environ.get("CIMEROOT") +if _CIMEROOT is None: + raise SystemExit("ERROR: must set CIMEROOT environment variable") +# end if +_LIBDIR = os.path.join(_CIMEROOT, "CIME", "Tools") +sys.path.append(_LIBDIR) +sys.path.insert(0, _CIMEROOT) + +#pylint: disable=wrong-import-position +from CIME.case import Case + +logger = logging.getLogger(__name__) + +if len(sys.argv) != 3: + raise SystemExit(f"Incorrect call to {sys.argv[0]}, need CAM root and case root") +# end if +cam_root = sys.argv[1] +case_root = sys.argv[2] + +with Case(case_root) as case: + cam_config = case.get_value('CAM_CONFIG_OPTS') + # Gather case information (from _build_usernl_files in case_setup.py) + comp_interface = case.get_value("COMP_INTERFACE") + + if comp_interface == "nuopc": + ninst = case.get_value("NINST") + elif ninst == 1: + ninst = case.get_value("NINST_CAM") + # end if +# end with + +# GEOS-Chem only: copy config files to case +if '-chem geoschem' in cam_config: + geoschem_config_src = os.path.join(cam_root, 'src', 'chemistry', + 'geoschem', 'geoschem_src', 'run', 'CESM') + if not os.path.isdir(geoschem_config_src): + raise SystemExit(f"ERROR: Did not find path to GEOS-Chem config files at {geoschem_config_src}") + # end if + for fileName in ['species_database.yml', 'geoschem_config.yml', 'HISTORY.rc', + 'HEMCO_Config.rc', 'HEMCO_Diagn.rc']: + source_file = os.path.join(cam_root, geoschem_config_src, fileName) + if not os.path.exists(source_file): + raise SystemExit(f"ERROR: Did not find source file, {source_file}") + # end if + spaths = os.path.splitext(source_file) + for inst_num in range(ninst): + if ninst > 1: + target_file = f"{spaths[0]}_{inst_num+1:04d}{spaths[1]}" + else: + target_file = os.path.join(case_root, fileName) + # end if + if not os.path.exists(target_file): + logger.info("CAM namelist one-time copy of GEOS-Chem run directory files: source_file %s target_file %s ", + source_file, target_file) + shutil.copy(source_file, target_file) + # end if + # end for + # end for +# end if diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 8ac578b80d..d0bdf4cafc 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -8,11 +8,11 @@ CAM =============== --> - CAM cam6 physics: - CAM cam5 physics: - CAM cam4 physics: - CAM cam3 physics: - CAM simplified and non-versioned physics : + CAM cam7 physics: + CAM cam6 physics: + CAM cam5 physics: + CAM cam4 physics: + CAM simplified and non-versioned physics : - CAM stand-alone single column mode -- need to define usermods directory with IOP settings: + CAM stand-alone single column mode -- user defined IOP settings can be placed under the usermods scam_user directory: CAM specified dynamics is used in finite volume dynamical core: CAM physics is nudged towards prescribed meteorology: - CAM-Chem troposphere/stratosphere chemistry with simplified VBS-SOA: - CAM-Chem troposphere/stratosphere chemistry with simplified VBS-SOA and expanded isoprene and terpene oxidation: + CAM-Chem troposphere/stratosphere chemistry with simplified VBS-SOA: + CAM-Chem troposphere/stratosphere chemistry with simplified VBS-SOA and expanded isoprene and terpene oxidation: + CAM-Chem troposphere/stratosphere simplified chemistry for climate simulations: + GEOS-Chem troposphere/stratosphere chemistry : CAM-Chem troposphere/stratosphere chem with simplified volatility basis set SOA scheme and fire emissons : CAM CLUBB - turned on by default in CAM60: CAM-Chem troposphere/stratosphere chem with extended volatility basis set SOA scheme and modal aersols : + CAM low top model + Modal Aerosol Model composed of 7 modes: + CAM mid top model CAM CO2 ramp: - CAM super-parameterized CAM one moment SAM microphysics - CAM super-parameterized CAM one moment SAM microphysics using CLUBB - CAM super-parameterized CAM double moment m2005 SAM microphysics - CAM super-parameterized CAM double moment m2005 SAM microphysics using CLUBB CAM tropospheric chemistry with bulk aerosols: + + With Harmonized Emissions Component (HEMCO) for chemistry: + CAM dry adiabatic configurarion (no physics forcing): - CAM dry adiabatic baroclinic instability (Polvani et al., 2004): CAM moist Held-Suarez forcing (Thatcher and Jablonowski, 2016): + CAM moist simple model (Frierson, 2006): CAM dry Held-Suarez forcing (Held and Suarez (1994)): CAM moist dynamical core test with Ullrich et al. (2014) baroclinic wave IC, Kessler physics and terminator chemistry: @@ -98,10 +106,9 @@ char - eul,fv,fv3,se,mpas + fv,fv3,se,mpas fv - eul se fv3 mpas @@ -116,57 +123,77 @@ - -phys cam3 -phys cam4 -phys cam5 -phys cam6 + -phys cam7 - -chem trop_strat_mam4_vbs + -chem trop_strat_mam5_vbs + -chem geoschem_mam4 - -chem trop_strat_mam4_vbsext - -chem trop_strat_mam4_ts2 + -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 - -rad rrtmg -chem trop_mam3 -spcam_nx 32 -spcam_ny 1 -spcam_dx 4000 -spcam_dt 20 -phys spcam_m2005 -spcam_clubb_sgs -chem trop_mozart -co2_cycle - -age_of_air_trcs + -age_of_air_trcs -chem waccm_ma - -chem waccm_ma_mam4 - -chem waccm_mad_mam4 + -chem waccm_ma_mam5 + -chem waccm_mad_mam5 -chem waccm_sc_mam4 - -chem waccm_tsmlt_mam4 + -chem waccm_tsmlt_mam5 -chem waccm_mad -waccmx -ionosphere wxie + -waccmx -ionosphere none -chem waccm_ma -chem waccm_ma -chem waccm_mad - -chem waccm_ma_mam4 - -chem waccm_mad_mam4 + -chem waccm_ma_mam5 + -chem waccm_mad_mam5 -offline_dyn -nlev 56 - -nlev 56 + -nlev 56 -nlev 88 -nlev 145 + -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 -phys tj2016 -analytic_ic + -phys grayrad -analytic_ic -phys held_suarez -analytic_ic -phys kessler -chem terminator -analytic_ic -nadv_tt=6 -aquaplanet -aquaplanet + -chem none -offline_drv rad @@ -195,18 +222,22 @@ waccm_tsmlt_1850_cam6 waccm_ma_1850_cam6 waccm_sc_1850_cam6 + 1850_cam_lt + 1850_cam_mt 2000_cam4_trop_chem waccmxie_ma_2000_cam4 + waccmx_ma_2000_cam4 + 2000_cam6 2000_cam6 waccm_tsmlt_2000_cam6 waccm_ma_2000_cam6 waccm_sc_2000_cam6 - 2000_trop_strat_vbs_cam6 + 2000_trop_strat_vbs_cam6 + 2000_geoschem waccmx_ma_2000_cam6 - aquaplanet_cam3 aquaplanet_cam4 aquaplanet_cam4 aquaplanet_cam5 @@ -214,12 +245,14 @@ aquaplanet_cam6 aquaplanet_cam6 aquaplanet_rce_cam6 - aquaplanet_waccm_ma_2000_cam6 + aquaplanet_cam7 + aquaplanet_waccm_2000 2010_cam6 - 2010_trop_strat_vbs_cam6 + 2010_trop_strat_vbs_cam6 waccm_tsmlt_2010_cam6 waccm_sc_2010_cam6 + 2010_geoschem 1850-2005_cam5 1850-2005_cam4 @@ -229,15 +262,21 @@ 1950-2010_ccmi_refc1_waccmx_ma 1850-2005_cam5 hist_cam6 + hist_cam_lt + hist_cam_mt waccm_tsmlt_hist_cam6 waccm_sc_hist_cam6 waccm_ma_hist_cam6 waccm_ma_hist_cam6 waccm_ma_hist_cam4 - hist_trop_strat_vbs_cam6 - hist_trop_strat_nudged_cam6 + hist_trop_strat_vbs_cam6 + hist_trop_strat_t4s_cam7 + 1850_trop_strat_t4s_cam7 + hist_trop_strat_nudged_cam6 hist_trop_strat_vbsext_cam6 hist_trop_strat_vbsfire_cam6 + hist_geoschem + hist_geoschem_nudged waccmx_ma_hist_cam6 1850-PD_cam5 @@ -262,17 +301,14 @@ sd_waccm_ma_cam6 sd_waccm_ma_cam6 sd_waccm_ma_cam4 - sd_trop_strat_vbs_cam6 - sd_trop_strat2_cam6 + sd_trop_strat_vbs_cam6 + sd_trop_strat2_cam6 sd_cam6 - dabi_p2004 held_suarez_1994 dctest_tj2016 + dctest_frierson dctest_baro_kessler - - - run_component_cam env_run.xml @@ -308,6 +344,8 @@ flbc_file='$DIN_LOC_ROOT/atm/waccm/lb/LBC_CMIP6_1pctCO2ramp_y1-165_0p5degLat_c180930.nc' nlte_limit_co2=.true. co2_cycle_rad_passive=.true. + + use_hemco=.true. rearth = 6.37122D6 @@ -327,7 +365,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 1e6c35500a..91301d47dc 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -13,12 +13,12 @@ TIME_ATM[%phys]_LND[%phys]_ICE[%phys]_OCN[%phys]_ROF[%phys]_GLC[%phys]_WAV[%phys][_BGC%phys] Where for the CAM specific compsets below the following is supported TIME = Time period (e.g. 2000, HIST, RCP8...) - ATM = [CAM40, CAM50, CAM60] - LND = [CLM45, CLM50, SLND] + ATM = [CAM40, CAM50, CAM60, CAM70] + LND = [CLM45, CLM50, CLM60, SLND] ICE = [CICE, DICE, SICE] OCN = [DOCN, ,AQUAP, SOCN] ROF = [RTM, SROF] - GLC = [CISM1, CISM2, SGLC] + GLC = [CISM2, SGLC] WAV = [SWAV] BGC = optional BGC scenario @@ -36,75 +36,162 @@ - grid (optional regular expression match for grid to work with the compset) - - - - - - F2000Nuopc - 2000_CAM40_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV - - - F2000climo - 2000_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + 2000_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FHIST - HIST_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + HIST_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + FLTHIST + HIST_CAM70%LT_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + + FMTHIST + HIST_CAM70%MT_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + + FLT1850_TESTINGONLY_v0c + 1850_CAM70%LT_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + + FMT1850_TESTINGONLY_v0c + 1850_CAM70%MT_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + FHIST_BGC - HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - FDABIP04 - 2000_CAM%DABIP04_SLND_SICE_SOCN_SROF_SGLC_SWAV - - - + FHS94 + 2000_CAM%HS94_SLND_SICE_SOCN_SROF_SGLC_SWAV - FSCAM - 2000_CAM60%SCAM_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV - + FKESSLER + 2000_CAM%KESSLER_SLND_SICE_SOCN_SROF_SGLC_SWAV - FCSCAM - 2000_CAM60%SCAM%CCTS_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV - + FTJ16 + 2000_CAM%TJ16_SLND_SICE_SOCN_SROF_SGLC_SWAV - FHS94 - 2000_CAM%HS94_SLND_SICE_SOCN_SROF_SGLC_SWAV - - - + QPRCEMIP + 2000_CAM60_SLND_SICE_DOCN%AQPCONST_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 + - QPC3 - 2000_CAM30_SLND_SICE_DOCN%AQP3_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 + + + + FCSCAM + 2000_CAM60%SCAM%CT1S_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + + + + FADIAB + 2000_CAM%ADIAB_SLND_SICE_SOCN_SROF_SGLC_SWAV + + + + QPC4 2000_CAM40_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV @@ -141,18 +228,13 @@ - QPC6HIST - HIST_CAM60_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - - - - QSPCAMS - 2000_CAM%SPCAMS_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + QPC5M7 + 2000_CAM50%MAM7_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - QPSPCAMM - 2000_CAM%SPCAMM_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + QPC6HIST + HIST_CAM60_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV @@ -163,87 +245,82 @@ - QPHISTC6 - HIST_CAM60_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + QPLT + 2000_CAM70%LT_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - QPC2000climo - 2000_CAM60%CCTS1_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + QPMT + 2000_CAM70%MT_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - QPSCAMC5 - 2000_CAM50%SCAM_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + QPC2000climo + 2000_CAM60%CT1S_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - QPWmaC6 - 2000_CAM60%WCCM_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + QPSCAMC5 + 2000_CAM50%SCAMARM97_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - QSC6 - 2000_CAM60_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV - - + QPWmaC4 + 2000_CAM40%WCCM_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - - - - - - F2010climo - 2010_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + QPWmaC6 + 2000_CAM60%WCCM_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - F1850 - 1850_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + QPWmadC4 + 2000_CAM40%WCMD_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - - FSPCAMM - 2000_CAM%SPCAMM_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + QPWmadC6 + 2000_CAM60%WCMD_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - FSPCAMS - 2000_CAM%SPCAMS_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + QSC6 + 2000_CAM60_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV + + - F1850_BDRD - 1850_CAM60_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV_BGC%BDRD + QSC4 + 2000_CAM40_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV - FHIST_BDRD - HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV_BGC%BDRD + QSC5 + 2000_CAM50_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV - + + + - FADIAB - 2000_CAM%ADIAB_SLND_SICE_SOCN_SROF_SGLC_SWAV + F2010climo + 2010_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - FHIST_DARTC6 - HIST_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + F1850 + 1850_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - FTJ16 - 2000_CAM%TJ16_SLND_SICE_SOCN_SROF_SGLC_SWAV + FHIST_BDRD + HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_BGC%BDRD - FKESSLER - 2000_CAM%KESSLER_SLND_SICE_SOCN_SROF_SGLC_SWAV + F2000dev + 2000_CAM70_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV @@ -266,123 +343,126 @@ - + - FSPCAMCLBS - 2000_CAM%SPCAMCLBS_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + FC2000climo + 2000_CAM60%CT1S_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - FSPCAMCLBM - 2000_CAM%SPCAMCLBM_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + FC2000climo_HCO + 2000_CAM60%CT1S%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - - - - FC2000climo - 2000_CAM60%CCTS1_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + FC2000climo_GC + 2000_CAM60%GEOSCHEM%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FC2010climo - 2010_CAM60%CCTS1_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + 2010_CAM60%CT1S_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + FC2010climo_HCO + 2010_CAM60%CT1S%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + FC2010climo_GC + 2010_CAM60%GEOSCHEM%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FCHIST - HIST_CAM60%CCTS1_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + HIST_CAM60%CT1S_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + FCHIST_GC + HIST_CAM60%GEOSCHEM%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + + - FCvbsxHIST - HIST_CAM60%CVBSX_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + FHISTC_LTt1s + HISTC_CAM70%LT%CT1S_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - FCfireHIST - HIST_CAM60%CFIRE_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + FHISTC_MTt1s + HISTC_CAM70%MT%CT1S_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - FCnudged - HIST_CAM60%CCTS1%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + FHISTC_MTt4s + HISTC_CAM70%MT%CT4S_CLM60%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - FCts2nudged - HIST_CAM60%CCTS2%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + FCvbsxHIST + HIST_CAM60%CVBSX_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - FCSD - HIST_CAM60%CCTS1%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + FCfireHIST + HIST_CAM60%CFIRE_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - FCts2SD - HIST_CAM60%CCTS2%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + FCHIST_HCO + HIST_CAM60%CT1S%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - FSD - HIST_CAM60%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + FCnudged + HIST_CAM60%CT1S%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + + FCnudged_GC + HIST_CAM60%GEOSCHEM%NUDG%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - FMOZ - 2000_CAM40%TMOZ_CLM45%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + FCts2nudged + HIST_CAM60%CT2S%NUDG_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - FSPCAMS - 2000_CAM%SPCAMS_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + FCnudged_HCO + HIST_CAM60%CT1S%NUDG%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - F1850_BDRD - 1850_CAM60_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV_BGC%BDRD + FCts2nudged_HCO + HIST_CAM60%CT2S%NUDG%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - FHIST_BDRD - HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV_BGC%BDRD + FCSD + HIST_CAM60%CT1S%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - - - FADIAB - 2000_CAM%ADIAB_SLND_SICE_SOCN_SROF_SGLC_SWAV + FCts2SD + HIST_CAM60%CT2S%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - - - FHIST_DARTC6 - HIST_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV + FCSD_HCO + HIST_CAM60%CT1S%SDYN%HEMCO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - FTJ16 - 2000_CAM%TJ16_SLND_SICE_SOCN_SROF_SGLC_SWAV + FSD + HIST_CAM60%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - FKESSLER - 2000_CAM%KESSLER_SLND_SICE_SOCN_SROF_SGLC_SWAV + FMOZ + 2000_CAM40%TMOZ_CLM45%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV - QSC4 - 2000_CAM40_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV + F1850_BDRD + 1850_CAM60_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_BGC%BDRD - QSC5 - 2000_CAM50_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV + FHIST_DARTC6 + HIST_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV - QPRCEMIP - 2000_CAM60_SLND_SICE_DOCN%AQPCONST_SROF_SGLC_SWAV + FGRAYRAD + 2000_CAM%GRAYRAD_SLND_SICE_SOCN_SROF_SGLC_SWAV @@ -391,43 +471,43 @@ FWHIST - HIST_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + HIST_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FWHIST_BGC - HIST_CAM60%WCTS_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + HIST_CAM60%WCTS_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FWsc2010climo - 2010_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + 2010_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FWsc2000climo - 2000_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + 2000_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FWsc1850 - 1850_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + 1850_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FWscHIST - HIST_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + HIST_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FW1850 - 1850_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + 1850_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV @@ -437,17 +517,17 @@ FWma2000climo - 2000_CAM60%WCCM_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + 2000_CAM60%WCCM_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FW2000climo - 2000_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + 2000_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV FW2010climo - 2010_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + 2010_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV @@ -455,6 +535,10 @@ HIST_CAM60%WCTS%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + + FW4ma2000 + 2000_CAM40%WCCM_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV + @@ -462,7 +546,7 @@ FWmaHIST - HIST_CAM60%WCCM_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + HIST_CAM60%WCCM_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV @@ -472,7 +556,7 @@ FWmadHIST - HIST_CAM60%WCMD_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV + HIST_CAM60%WCMD_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV @@ -523,15 +607,15 @@ - 1997-06-18 - 1979-01-01 + 1979-01-01 1950-01-01 2000-01-01 2005-01-01 1980-01-01 1850-01-01 - 2010-01-01 - 2013-01-01 + 2010-01-01 + 2015-01-01 + 2013-01-01 1995-01-01 1995-01-01 2005-01-01 @@ -539,15 +623,75 @@ 2010-01-01 1980-01-01 2000-01-01 + 2000-01-01 + 2010-01-01 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 @@ -572,194 +716,6 @@ GREGORIAN - - - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_clim_c050526.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_c061031.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_c040926.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_c061106.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_c110526.nc - - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_1850_2017_c180507.nc - $DIN_LOC_ROOT/atm/cam/sst/"sst_HadOIBl_bc_48x96_1850_2017_c180507.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2017_c180507.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2017_c180507.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2017_c180507.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_1850_2017_c180507.nc - - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_clim_pi_c101029.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_clim_pi_c101028.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_pi_c101028.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_pi_c101028.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_pi_c101028.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c101028.nc - - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_2000climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_2000climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_2000climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_2000climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_2000climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_2000climo_c180511.nc - - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_2010climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_2010climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_2010climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_2010climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_2010climo_c180511.nc - $DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_2010climo_c180511.nc - - - - - - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.48x96_gx3v7_100114.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.1.9x2.5_gx1v6_090403.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.9x1.25_gx1v6_090403.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.47x0.63_gx1v6_090408.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.23x0.31_gx1v6_101108.nc - $DIN_LOC_ROOT/ocn/docn7/domain.ocn.1x1.111007.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.48x96_gx3v7_100114.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.1.9x2.5_gx1v6_090403.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.9x1.25_gx1v6_090403.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.47x0.63_gx1v6_090408.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.23x0.31_gx1v6_101108.nc - $DIN_LOC_ROOT/ocn/docn7/domain.ocn.1x1.111007.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.48x96_gx3v7_100114.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.1.9x2.5_gx1v6_090403.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.9x1.25_gx1v6_090403.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.47x0.63_gx1v6_090408.nc - $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.camocn.0.23x0.31_gx1v6_101108.nc - - - - - 2016 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - - - - - 1 - 1 - - @@ -771,13 +727,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 8761310818..2650843bfe 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -1,73 +1,39 @@ - - - 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 - -1 - -1 - -1 - -1 - -1 - -1 - -1 - -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -109,39 +75,76 @@ + + + + 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 + + + + none - -4 - -4 - -4 - -4 - -4 - -4 - -4 - -4 + -4 + -4 + -4 + -4 + -4 + -4 + -4 + -4 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -151,34 +154,34 @@ none - -4 - -4 - -4 - -4 - -4 - -4 - -4 - -4 + -4 + -4 + -4 + -4 + -4 + -4 + -4 + -4 - 2 - 2 - 2 - 2 - 2 - 2 - 2 - 2 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -188,34 +191,34 @@ none - -40 - -40 - -40 - -40 - -40 - -40 - -40 - -40 + -40 + -40 + -40 + -40 + -40 + -40 + -40 + -40 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -225,41 +228,291 @@ none - 2048 - 2048 - 2048 - 2048 - 2048 - 2048 - 2048 - 2048 + 2048 + 2048 + 2048 + 2048 + 2048 + 2048 + 2048 + 2048 + + + 8 + 8 + 8 + 8 + 8 + 8 + 8 + 8 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + + 360 + 360 + 360 + 360 + 360 + 360 + + + 1 + 1 + 1 + 1 + 1 + 1 + + + + + + + -4 + -4 + -4 + -4 + -4 + -4 + + + 1 + 1 + 1 + 1 + 1 + 1 + + + + + + + + none + + 720 + 720 + 720 + 720 + 720 + 720 + 720 + 720 - 8 - 8 - 8 - 8 - 8 - 8 - 8 - 8 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + none + + -4 + -4 + -4 + -4 + -4 + -4 + + + 1 + 1 + 1 + 1 + 1 + 1 + + + + + + + + none + + 1728 + 1728 + 1728 + 1728 + 1728 + 1728 + 1728 + 1728 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + none + + -16 + -16 + -16 + -16 + -16 + -16 + + + 1 + 1 + 1 + 1 + 1 + 1 + + + + none + + -8 + -8 + -8 + -8 + -8 + -8 + + + 1 + 1 + 1 + 1 + 1 + 1 + + + + none + + -8 + -8 + -8 + -8 + -8 + -8 + + + 1 + 1 + 1 + 1 + 1 + 1 + + + - + + none + + -8 + -8 + -8 + -8 + -8 + -8 + + + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + + + + none + + -12 + -12 + -12 + -12 + -12 + -12 + + + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + + + none -50 @@ -267,8 +520,6 @@ -50 -50 -50 - -50 - -50 -50 @@ -277,8 +528,6 @@ 1 1 1 - 1 - 1 1 @@ -287,46 +536,79 @@ 0 0 0 - 0 - 0 0 + + + none + + 1800 + 1800 + 1800 + 1800 + 1800 + 1800 + 1800 + 1800 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + - none + none - -16 - -16 - -16 - -16 - -16 - -16 - -16 - -16 + -16 + -16 + -16 + -16 + -16 + -16 + -16 + -16 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -336,34 +618,34 @@ none - 4800 - 4800 - 4800 - 4800 - 4800 - 4800 - 4800 - 4800 + 4800 + 4800 + 4800 + 4800 + 4800 + 4800 + 4800 + 4800 - 4 - 4 - 4 - 4 - 4 - 4 - 4 - 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -373,34 +655,34 @@ none - 16384 - 16384 - 16384 - 16384 - 16384 - 16384 - 16384 - 16384 + 16384 + 16384 + 16384 + 16384 + 16384 + 16384 + 16384 + 16384 - 8 - 8 - 8 - 8 - 8 - 8 - 8 - 8 + 8 + 8 + 8 + 8 + 8 + 8 + 8 + 8 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -410,34 +692,34 @@ none - 8192 - 8192 - 8192 - 8192 - 8192 - 8192 - 8192 - 8192 + 8192 + 8192 + 8192 + 8192 + 8192 + 8192 + 8192 + 8192 - 2 - 2 - 2 - 2 - 2 - 2 - 2 - 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -447,34 +729,34 @@ none - -32 - -32 - -32 - -32 - -32 - -32 - -32 - -32 + -32 + -32 + -32 + -32 + -32 + -32 + -32 + -32 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -484,35 +766,95 @@ none - 64 - 64 - 64 - 64 - 64 - 64 - 64 - 64 + 64 + 64 + 64 + 64 + 64 + 64 + 64 + 64 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + 128 + 128 + 128 + 128 + 128 + 128 + 128 + 128 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + none + + -4 + -4 + -4 + -4 + -4 + -4 + -4 + -4 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - @@ -521,34 +863,34 @@ none - -2 - -2 - -2 - -2 - -2 - -2 - -2 - -2 + -2 + -2 + -2 + -2 + -2 + -2 + -2 + -2 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -558,34 +900,34 @@ none - 224 - 224 - 224 - 224 - 224 - 224 - 224 - 224 + 224 + 224 + 224 + 224 + 224 + 224 + 224 + 224 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -595,34 +937,34 @@ none - 192 - 192 - 192 - 192 - 192 - 192 - 192 - 192 + 192 + 192 + 192 + 192 + 192 + 192 + 192 + 192 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -632,34 +974,34 @@ none - 192 - 192 - 192 - 192 - 192 - 192 - 192 - 192 + 192 + 192 + 192 + 192 + 192 + 192 + 192 + 192 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -669,34 +1011,34 @@ none - 240 - 240 - 240 - 240 - 240 - 240 - 240 - 240 + 240 + 240 + 240 + 240 + 240 + 240 + 240 + 240 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -711,10 +1053,10 @@ 360 360 360 - 360 - 360 - 360 - 360 + 360 + 360 + 360 + 360 3 @@ -741,7 +1083,40 @@ - + + none + + 48 + 48 + 48 + 48 + 48 + 48 + 48 + 48 + + + 3 + 3 + 3 + 3 + 3 + 3 + 3 + 3 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + none 144 @@ -808,40 +1183,75 @@ + + + none + + 36 + 36 + 36 + 36 + 36 + 36 + 36 + 36 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + none - 192 - 192 - 192 - 192 - 192 - 192 - 192 - 192 + 192 + 192 + 192 + 192 + 192 + 192 + 192 + 192 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 - + @@ -849,24 +1259,24 @@ none - 288 - 288 - 288 - 288 - 288 - 288 - 288 - 288 + 864 + 864 + 864 + 864 + 864 + 864 + 864 + 864 - 3 - 3 - 3 - 3 - 3 - 3 - 3 - 3 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 0 @@ -880,6 +1290,27 @@ + + + none + + -8 + -8 + -8 + -8 + -8 + -8 + + + 1 + 1 + 1 + 1 + 1 + 1 + + + @@ -887,34 +1318,34 @@ none - -4 - -4 - -4 - -4 - -4 - -4 - -4 - -4 + -4 + -4 + -4 + -4 + -4 + -4 + -4 + -4 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -924,156 +1355,138 @@ none - -208 - -208 - -208 - -208 - -208 - -208 - -208 - -208 + -208 + -208 + -208 + -208 + -208 + -208 + -208 + -208 - 8 - 8 - 8 - 8 - 8 - 8 - 8 - 8 + 8 + 8 + 8 + 8 + 8 + 8 + 8 + 8 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 - + none - 384 - 384 - 384 - 384 - 384 - 384 - 384 - 384 + 384 + 384 + 384 + 384 + 384 + 384 - 3 - 3 - 3 - 3 - 3 - 3 - 3 - 3 + 3 + 3 + 3 + 3 + 3 + 3 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 - - - - + + none - -8 - -8 - -8 - -8 - -8 - -8 - -8 - -8 + -8 + -8 + -8 + -8 + -8 + -8 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - - - + + + + none - 768 - 768 - 768 - 768 - 768 - 768 - 768 - 768 + -8 + -8 + -8 + -8 + -8 + -8 + -8 + -8 - 3 - 3 - 3 - 3 - 3 - 3 - 3 - 3 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 - + + + none - 576 - 576 - 576 - 576 - 576 - 576 - 576 - 576 + 768 + 768 + 768 + 768 + 768 + 768 + 768 + 768 3 @@ -1096,6 +1509,39 @@ 0 + + none + + 1800 + 1800 + 1800 + 1800 + 1800 + 1800 + 1800 + 1800 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + @@ -1103,34 +1549,34 @@ none - 480 - 480 - 480 - 480 - 480 - 480 - 480 - 480 + 480 + 480 + 480 + 480 + 480 + 480 + 480 + 480 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -1140,34 +1586,34 @@ none - -16 - -16 - -16 - -16 - -16 - -16 - -16 - -16 + -16 + -16 + -16 + -16 + -16 + -16 + -16 + -16 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -1177,34 +1623,34 @@ none - 960 - 960 - 960 - 960 - 960 - 960 - 960 - 960 + 960 + 960 + 960 + 960 + 960 + 960 + 960 + 960 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -1214,53 +1660,91 @@ - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + + none + + 36 + 36 + 36 + 36 + 36 + 36 + 36 + 36 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + none - -1 - -1 - -1 - -1 - -1 - -1 - -1 - -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -1271,72 +1755,107 @@ none - -4 - -4 - -4 - -4 - -4 - -4 - -4 - -4 + -4 + -4 + -4 + -4 + -4 + -4 + -4 + -4 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + none + + -3 + -3 + -3 + -3 + -3 + -3 + -3 + -3 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + none - -16 - -16 - -16 - -16 - -16 - -16 - -16 - -16 + -16 + -16 + -16 + -16 + -16 + -16 + -16 + -16 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -1347,34 +1866,34 @@ none - -32 - -32 - -32 - -32 - -32 - -32 - -32 - -32 + -32 + -32 + -32 + -32 + -32 + -32 + -32 + -32 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -1385,34 +1904,34 @@ none - -32 - -32 - -32 - -32 - -32 - -32 - -32 - -32 + -32 + -32 + -32 + -32 + -32 + -32 + -32 + -32 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -1425,34 +1944,34 @@ none - -91 - -91 - -91 - -91 - -91 - -91 - -91 - -91 + -91 + -91 + -91 + -91 + -91 + -91 + -91 + -91 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -1463,34 +1982,34 @@ none - -118 - -118 - -118 - -118 - -118 - -118 - -118 - -118 + -118 + -118 + -118 + -118 + -118 + -118 + -118 + -118 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -1501,34 +2020,34 @@ none - -135 - -135 - -135 - -135 - -135 - -135 - -135 - -135 + -135 + -135 + -135 + -135 + -135 + -135 + -135 + -135 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 @@ -1538,26 +2057,39 @@ - - - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - - - - - 1 - - - 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/config_tests.xml b/cime_config/config_tests.xml index 111cb8371e..da799010f9 100644 --- a/cime_config/config_tests.xml +++ b/cime_config/config_tests.xml @@ -23,6 +23,7 @@ TMC CAM mass conservation test 9 $STOP_OPTION $STOP_N + TRUE @@ -69,5 +70,15 @@ TMC CAM mass conservation test $STOP_N + + CAM test: Verify mg3 and pumas give identical answers + 1 + FALSE + FALSE + nsteps + 7 + $STOP_OPTION + $STOP_N + diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index d5f842037a..17e6432e31 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -7,37 +7,36 @@ - - - - - - + + + + + - + - - + - + - + + - + - + @@ -46,46 +45,55 @@ - - + + - + - - + + - + - - + + - + - - - - + + + + + + + + + + + + + @@ -93,7 +101,7 @@ - + @@ -101,7 +109,7 @@ - + @@ -109,7 +117,7 @@ - + @@ -118,8 +126,8 @@ - - + + @@ -128,8 +136,8 @@ - - + + @@ -138,12 +146,12 @@ - - - + + + - + @@ -151,9 +159,8 @@ - - - + + @@ -161,7 +168,7 @@ - + @@ -169,12 +176,11 @@ - + - @@ -184,9 +190,47 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + @@ -194,7 +238,7 @@ - + @@ -202,7 +246,7 @@ - + @@ -210,31 +254,31 @@ - + - + - + - - - + + + - + - + @@ -242,7 +286,7 @@ - + @@ -250,7 +294,7 @@ - + @@ -259,16 +303,18 @@ - - + + + + - + @@ -276,7 +322,7 @@ - + @@ -287,15 +333,15 @@ - + - - + + @@ -304,66 +350,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -388,6 +374,7 @@ + @@ -417,7 +404,7 @@ - + @@ -447,7 +434,7 @@ - + @@ -468,6 +455,7 @@ + @@ -477,23 +465,13 @@ - + - - - - - - - - - - @@ -507,23 +485,13 @@ - + - - - - - - - - - - @@ -545,7 +513,7 @@ - + @@ -554,474 +522,941 @@ - - + - + - - - + + - - - + - + - - + - - + - + - - + - - + + - + + - + - - + - + - + - - + - + - + - - + + + + - + - - + - + - + - - + + - + - + - - + - + - + - - + + - + + - + - - + - + - + - - + + - + + - + - - + - + - + - - + + - + - + - - + - + - + - - + + - + - + - - + - + - + - - + + - + - + - - + - + - + - - + + - + - + - - + - + - + - - + + - + + - + - + - + - + - - + + + + + + - - + + - - + - - + + + + + - + - - + - + + - + + + + + + + + + + + - - + - - + + - + - - + + - - + + - + - - + - - + + - + - - + + - + - + - - + - + - + - - + - + + + - + - - + - + + - + - - + - + + + - + - - + - + + + - + - - + - + + - + - - + - + + + - + - - + - + + + + - - + - + + + - - - - + - + + + + + + + - + - + + + + + + - + - + + + + + + - + - + + + + + + - + + - + + + + + + - + - + + + + + - + - + + + + - - + - + - - + - - - + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + - - + + + + + @@ -1029,28 +1464,89 @@ - + - - + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - + @@ -1058,7 +1554,7 @@ - + @@ -1066,7 +1562,7 @@ - + @@ -1074,7 +1570,7 @@ - + @@ -1082,7 +1578,15 @@ - + + + + + + + + + @@ -1090,56 +1594,197 @@ - + + + + + + + + + + - + - + + - + - + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - + + + + + + + + + + + - - + + @@ -1147,8 +1792,8 @@ - - + + @@ -1156,7 +1801,7 @@ - + @@ -1164,8 +1809,8 @@ - - + + @@ -1173,8 +1818,8 @@ - - + + @@ -1182,8 +1827,8 @@ - - + + @@ -1191,171 +1836,176 @@ - + - - + + - + - + + + + - + - + - + - - + - + - - + - - - - + - + + - + - - + + - + - + - + + - + - - + + - + - - - - - - + - + - + - - + + - + + - - - - - - - - - + - + - + + - - + - + + - + + - + - + + - + + - + - + - + - + - + - - - + + + + + - + + + - - + + - + + - + - - + + - + - + + + + + + - + + + - + + @@ -1363,9 +2013,9 @@ - + - + @@ -1373,7 +2023,7 @@ - + @@ -1381,7 +2031,7 @@ - + @@ -1389,7 +2039,7 @@ - + @@ -1398,7 +2048,7 @@ - + @@ -1407,7 +2057,7 @@ - + @@ -1416,7 +2066,7 @@ - + @@ -1426,7 +2076,7 @@ - + @@ -1434,7 +2084,7 @@ - + @@ -1443,7 +2093,7 @@ - + @@ -1453,51 +2103,108 @@ - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + + + + + + - - - - - + - - + + - + - + + + + + - + - - + + - + + - - - + + + @@ -1505,8 +2212,8 @@ - - + + @@ -1514,8 +2221,8 @@ - - + + @@ -1523,8 +2230,8 @@ - - + + @@ -1532,8 +2239,8 @@ - - + + @@ -1541,7 +2248,7 @@ - + @@ -1549,7 +2256,7 @@ - + @@ -1557,7 +2264,7 @@ - + @@ -1565,7 +2272,7 @@ - + @@ -1573,8 +2280,8 @@ - - + + @@ -1582,13 +2289,13 @@ - + - - + + @@ -1596,8 +2303,8 @@ - - + + @@ -1605,7 +2312,7 @@ - + @@ -1613,16 +2320,16 @@ - + - + - - + + @@ -1630,67 +2337,100 @@ - + - + - - + + - + - + - + + + + + - - + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - + - - + + - + - + - + - + @@ -1698,7 +2438,7 @@ - + @@ -1706,22 +2446,22 @@ - + - + - + - + @@ -1729,7 +2469,7 @@ - + @@ -1737,7 +2477,7 @@ - + @@ -1745,16 +2485,16 @@ - - + + - + - + @@ -1762,7 +2502,7 @@ - + @@ -1770,39 +2510,42 @@ - + - + - + - + - + - + + + + + + - - @@ -1810,8 +2553,8 @@ - - + + @@ -1819,7 +2562,7 @@ - + @@ -1828,7 +2571,7 @@ - + @@ -1836,7 +2579,7 @@ - + @@ -1844,8 +2587,8 @@ - - + + @@ -1853,23 +2596,23 @@ - + - + - + - - + + @@ -1877,18 +2620,18 @@ - + - + - - + + @@ -1896,8 +2639,8 @@ - - + + @@ -1905,28 +2648,37 @@ - + - - + + + + + + + + + + + - - + + - - + + @@ -1934,36 +2686,81 @@ - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - + + + + + + - + - + + + + + + - + - - + + + + + + - - - + + + @@ -1971,8 +2768,8 @@ - - + + @@ -1986,8 +2783,8 @@ - - + + @@ -1995,18 +2792,27 @@ - - - + + + + + + + + + + + + - + @@ -2019,246 +2825,21 @@ - + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + diff --git a/cime_config/testdefs/testmods_dirs/cam/cam4_port/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/cam4_port/user_nl_cam index 1b86d5d825..1a21d77206 100644 --- a/cime_config/testdefs/testmods_dirs/cam/cam4_port/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/cam4_port/user_nl_cam @@ -13,3 +13,4 @@ rad_data_output = .false. mfilt=100,100 nhtfrq=-120,73 + write_nstep0 = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/cam4_port/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/cam4_port/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam4_port/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/cam4_port5d/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/cam4_port5d/user_nl_cam index 655487485b..0cd7f3d3c3 100644 --- a/cime_config/testdefs/testmods_dirs/cam/cam4_port5d/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/cam4_port5d/user_nl_cam @@ -13,6 +13,7 @@ rad_data_output = .false. mfilt=100,100 nhtfrq=-120,73 + write_nstep0 = .true. ncdata='$DIN_LOC_ROOT/atm/cam/inic/fv/aqua_0006-01-01_1.9x2.5_L26_c161020.nc' use_topo_file=.false. atm_dep_flux=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/cam4_port5d/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/cam4_port5d/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam4_port5d/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/cam5_port_f45/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/cam5_port_f45/user_nl_cam index e42183057a..62e4e75bf4 100644 --- a/cime_config/testdefs/testmods_dirs/cam/cam5_port_f45/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/cam5_port_f45/user_nl_cam @@ -13,3 +13,4 @@ rad_data_output = .false. mfilt=100,100 nhtfrq=-120,73 + write_nstep0 = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/cam5_port_f45/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/cam5_port_f45/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam5_port_f45/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30/user_nl_cam index 150660c7f4..551c1c8aa1 100644 --- a/cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30/user_nl_cam @@ -13,3 +13,4 @@ rad_data_output = .false. mfilt=100,100 nhtfrq=-120,73 + write_nstep0 = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cam index e99e90fc96..bcdd47f3b0 100644 --- a/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cam @@ -13,6 +13,7 @@ rad_data_output = .false. mfilt=100,100 nhtfrq=-120,73 + write_nstep0 = .true. prescribed_strataero_3modes = .true. prescribed_strataero_cycle_yr = 1999 diff --git a/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/shell_commands b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/shell_commands new file mode 100644 index 0000000000..106897a2c6 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/shell_commands @@ -0,0 +1,3 @@ +./xmlchange --append CAM_CONFIG_OPTS="-rad rrtmgp" +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/user_nl_cam new file mode 100644 index 0000000000..fcbd0d438b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/user_nl_cam @@ -0,0 +1,15 @@ + offline_driver_infile = '$DIN_LOC_ROOT/atm/cam/port/base_cam6_3mode_1deg.doubleCO2.cam.h1.0001-01-01-00000_c170526.nc' + rad_data_fdh = .true. + empty_htapes = .true. + avgflag_pertape = 'A','I' + fincl1 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + fincl2 = 'SOLIN', 'QRS', 'FSNS', 'FSNT','FSNSC', 'FSDSC','FSNR','FLNR', + 'FSNTOA', 'FSUTOA', 'FSNTOAC', 'FSNTC', 'FSDSC', 'FSDS', 'SWCF', + 'QRL', 'FLNS', 'FLDS', 'FLNT', 'LWCF', 'FLUT' ,'FLUTC', 'FLNTC', + 'FLNSC', 'FLDSC' + rad_data_output = .false. + mfilt=100,100 + nhtfrq=-120,73 diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_dust/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_dust/shell_commands new file mode 100644 index 0000000000..fc0b1429cc --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_dust/shell_commands @@ -0,0 +1,4 @@ +./xmlchange --append CAM_CONFIG_OPTS="-carma dust" +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL +./xmlchange RUN_STARTDATE="0001-01-01" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam new file mode 100644 index 0000000000..9893ae9a9e --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam @@ -0,0 +1,8 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +history_carma=.true. +fincl2 = 'CRSLERFC' +carma_do_fixedinit=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/idphys/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/idphys/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/shell_commands new file mode 100644 index 0000000000..3e19dac58f --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/shell_commands @@ -0,0 +1,3 @@ +./xmlchange --append CAM_CONFIG_OPTS="-carma meteor_impact" +./xmlchange --append CAM_CONFIG_OPTS="-max_n_rad_cnst=100" +./xmlchange RUN_STARTDATE="0001-01-01" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam new file mode 100644 index 0000000000..ca4ea707ef --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam @@ -0,0 +1,13 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +history_carma=.true. +carma_do_fixedinit=.false. +solar_data_type='FIXED' +solar_data_ymd=20000101 +carma_emis_maxlat = 40. +carma_emis_maxlon = 20. +carma_emis_minlat = -20. +carma_emis_minlon = -80. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/shell_commands new file mode 100644 index 0000000000..4f722eb730 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/shell_commands @@ -0,0 +1,3 @@ +./xmlchange --append CAM_CONFIG_OPTS="-carma meteor_smoke" +./xmlchange --append CAM_CONFIG_OPTS="-max_n_rad_cnst=100" +./xmlchange RUN_STARTDATE="0001-01-01" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam new file mode 100644 index 0000000000..2a81a976e2 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam @@ -0,0 +1,10 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +history_carma=.true. +carma_do_fixedinit=.false. +solar_data_type='FIXED' +solar_data_ymd=20000101 + diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/shell_commands new file mode 100644 index 0000000000..e3d9ef9950 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/shell_commands @@ -0,0 +1,4 @@ +./xmlchange CAM_CONFIG_OPTS=" -phys cam4 -rad rrtmg -chem waccm_ma_sulfur -carma mixed_sulfate" +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL +./xmlchange RUN_STARTDATE="0001-01-01" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam new file mode 100644 index 0000000000..d292329b4c --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam @@ -0,0 +1,13 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +history_carma=.true. +carma_do_fixedinit=.false. +flbc_list = 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'OCS' +solar_data_type='FIXED' +solar_data_ymd=20000101 +carma_maxretries = 40 +ubc_specifier = 'T->MSIS', 'Q->2.d-8vmr', 'CH4->2.d-10vmr', 'H->MSIS', 'N->MSIS', 'O->MSIS', 'O2->MSIS', 'H2->TGCM', 'NO->SNOE' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_WX81/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq3s_WX81/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_pmc/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_pmc/shell_commands new file mode 100644 index 0000000000..13178a406a --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_pmc/shell_commands @@ -0,0 +1,2 @@ +./xmlchange --append CAM_CONFIG_OPTS="-carma pmc" +./xmlchange RUN_STARTDATE="0001-01-01" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam new file mode 100644 index 0000000000..3ec29d7308 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam @@ -0,0 +1,8 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +history_carma=.true. +carma_do_fixedinit=.false. +carma_do_partialinit=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/shell_commands new file mode 100644 index 0000000000..d891e9f762 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/shell_commands @@ -0,0 +1,4 @@ +./xmlchange --append CAM_CONFIG_OPTS="-carma sea_salt" +./xmlchange RUN_STARTDATE="0001-01-01" +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/user_nl_cam new file mode 100644 index 0000000000..bb1512a995 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/user_nl_cam @@ -0,0 +1,7 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +history_carma=.true. +carma_do_fixedinit=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/shell_commands new file mode 100644 index 0000000000..7d218dd64c --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/shell_commands @@ -0,0 +1,4 @@ +./xmlchange CAM_CONFIG_OPTS=" -phys cam4 -chem waccm_ma_sulfur -carma sulfate" +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL +./xmlchange RUN_STARTDATE="0001-01-01" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam new file mode 100644 index 0000000000..e3a93951a0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam @@ -0,0 +1,12 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +history_carma=.true. +carma_do_fixedinit=.false. +flbc_list = 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH4', 'CO2', 'H2', + 'HCFC22', 'N2O', 'OCS' +solar_data_type='FIXED' +solar_data_ymd=20000101 +ubc_specifier = 'T->MSIS', 'Q->2.d-8vmr', 'CH4->2.d-10vmr', 'H->MSIS', 'N->MSIS', 'O->MSIS', 'O2->MSIS', 'H2->TGCM', 'NO->SNOE' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_carma/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq3s_carma/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_growth/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_test_growth/shell_commands new file mode 100644 index 0000000000..6e260fa454 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_growth/shell_commands @@ -0,0 +1,2 @@ +./xmlchange --append CAM_CONFIG_OPTS="-carma test_growth" +./xmlchange RUN_STARTDATE="0001-01-01" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_growth/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_test_growth/user_nl_cam new file mode 100644 index 0000000000..bb1512a995 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_growth/user_nl_cam @@ -0,0 +1,7 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +history_carma=.true. +carma_do_fixedinit=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_growth/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/carma_test_growth/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_growth/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_passive/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_test_passive/shell_commands new file mode 100644 index 0000000000..6dd355afd2 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_passive/shell_commands @@ -0,0 +1,2 @@ +./xmlchange --append CAM_CONFIG_OPTS="-carma test_passive" +./xmlchange RUN_STARTDATE="0001-01-01" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_passive/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_test_passive/user_nl_cam new file mode 100644 index 0000000000..bb1512a995 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_passive/user_nl_cam @@ -0,0 +1,7 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +history_carma=.true. +carma_do_fixedinit=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_passive/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/carma_test_passive/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_passive/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/shell_commands new file mode 100644 index 0000000000..90d10ede79 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/shell_commands @@ -0,0 +1,2 @@ +./xmlchange --append CAM_CONFIG_OPTS="-carma test_radiative" +./xmlchange RUN_STARTDATE="0001-01-01" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/user_nl_cam new file mode 100644 index 0000000000..bb1512a995 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/user_nl_cam @@ -0,0 +1,7 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +history_carma=.true. +carma_do_fixedinit=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/shell_commands new file mode 100644 index 0000000000..be42187c9f --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/shell_commands @@ -0,0 +1,2 @@ +./xmlchange --append CAM_CONFIG_OPTS="-carma test_swelling" +./xmlchange RUN_STARTDATE="0001-01-01" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/user_nl_cam new file mode 100644 index 0000000000..bb1512a995 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/user_nl_cam @@ -0,0 +1,7 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +history_carma=.true. +carma_do_fixedinit=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/shell_commands new file mode 100644 index 0000000000..365b109d76 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/shell_commands @@ -0,0 +1,2 @@ +./xmlchange --append CAM_CONFIG_OPTS="-carma test_tracers" +./xmlchange RUN_STARTDATE="0001-01-01" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/user_nl_cam new file mode 100644 index 0000000000..bb1512a995 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/user_nl_cam @@ -0,0 +1,7 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +history_carma=.true. +carma_do_fixedinit=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/shell_commands b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/shell_commands new file mode 100644 index 0000000000..c98baa29e5 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/shell_commands @@ -0,0 +1,2 @@ +./xmlchange --append CAM_CONFIG_OPTS="-carma test_tracers2" +./xmlchange RUN_STARTDATE="0001-01-01" diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/user_nl_cam new file mode 100644 index 0000000000..bb1512a995 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/user_nl_cam @@ -0,0 +1,7 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3 +inithist='ENDOFRUN' +pbuf_global_allocate=.false. +history_carma=.true. +carma_do_fixedinit=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/co2rmp/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/co2rmp/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/co2rmp/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/co2rmp_1850/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/co2rmp_1850/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/co2rmp_1850/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/dae/shell_commands b/cime_config/testdefs/testmods_dirs/cam/dae/shell_commands deleted file mode 100644 index f091402c1d..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/dae/shell_commands +++ /dev/null @@ -1,6 +0,0 @@ -# Test CAM post-Data Assimilation handling -SRCROOT="`./xmlquery --value COMP_ROOT_DIR_ATM`" -DAFILE="${SRCROOT}/test/system/da_cam_no_data_mod.sh" -./xmlchange DATA_ASSIMILATION_SCRIPT=${DAFILE} -# Turn off any use case -./xmlchange CAM_NML_USE_CASE="UNSET" diff --git a/cime_config/testdefs/testmods_dirs/cam/dae/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/dae/user_nl_cam deleted file mode 100644 index f837808297..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/dae/user_nl_cam +++ /dev/null @@ -1,4 +0,0 @@ -! CAM history files have different names when DA is active so turn them off -nhtfrq = 0,-10000,-10000,-10000,-10000,-10000 -fexcl1 = 'OMEGA','OMEGAT','PHIS','PS','PSL','QRS','T','U','UU','V','VT','VU','VV','Z3' -fexcl2 = 'T','U','V' diff --git a/cime_config/testdefs/testmods_dirs/cam/dartcambigens/shell_commands b/cime_config/testdefs/testmods_dirs/cam/dartcambigens/shell_commands index f487150a19..808d4bad91 100644 --- a/cime_config/testdefs/testmods_dirs/cam/dartcambigens/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/dartcambigens/shell_commands @@ -1,3 +1,5 @@ ./xmlchange CALENDAR=GREGORIAN ./xmlchange PIO_TYPENAME=pnetcdf ./xmlchange ATM_NCPL=48 +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/fire_emis/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/fire_emis/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/fire_emis/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/ghgrmp_e8/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/ghgrmp_e8/user_nl_cam index a7ccd4decc..579aff2cbc 100644 --- a/cime_config/testdefs/testmods_dirs/cam/ghgrmp_e8/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/ghgrmp_e8/user_nl_cam @@ -26,5 +26,3 @@ FINCL4 = 'T:I ','U:I ','V:I ','Q:I ','DTCOND:I ', 'PS:I ','PHIS:I ','FU ','FV ','RELHUM:I ', collect_column_output = .false.,.false.,.true.,.true. - -eul_divdampn=1. diff --git a/cime_config/testdefs/testmods_dirs/cam/ghgrmp_e8/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/ghgrmp_e8/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/ghgrmp_e8/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/idphys/shell_commands b/cime_config/testdefs/testmods_dirs/cam/idphys/shell_commands deleted file mode 100644 index 2b23eabcc9..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/idphys/shell_commands +++ /dev/null @@ -1,5 +0,0 @@ -./xmlchange ROF_NCPL=\$ATM_NCPL -./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange MAX_MPITASKS_PER_NODE="24" -./xmlchange CAM_NML_USE_CASE=UNSET -./xmlchange RUN_STARTDATE="00000101" diff --git a/cime_config/testdefs/testmods_dirs/cam/idphys/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/idphys/user_nl_cam deleted file mode 100644 index b82da1ed1f..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/idphys/user_nl_cam +++ /dev/null @@ -1,4 +0,0 @@ -mfilt=1,1,1,1,1,1 -ndens=1,1,1,1,1,1 -nhtfrq=3,3,3,3,3,3 -fincl2='U:I','V:I','T:I','TTEND_TOT:I','DTCORE:I' diff --git a/cime_config/testdefs/testmods_dirs/cam/nudging/shell_commands b/cime_config/testdefs/testmods_dirs/cam/nudging/shell_commands index c5ec3a63e1..6ff097dbf6 100644 --- a/cime_config/testdefs/testmods_dirs/cam/nudging/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/nudging/shell_commands @@ -1 +1,6 @@ +driver=`./xmlquery --value COMP_INTERFACE` +if [ "$driver" = "nuopc" ]; then + ./xmlchange ROF_NCPL=\$ATM_NCPL + ./xmlchange GLC_NCPL=\$ATM_NCPL +fi ./xmlchange RUN_STARTDATE=2009-01-01 diff --git a/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cam index 81149c52e0..ce798ca005 100644 --- a/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cam @@ -7,6 +7,7 @@ fincl3='U','V','T','Q','PS','Nudge_U','Nudge_V','Nudge_T','Nudge_Q','Target_U','Target_V','Target_T','Target_Q' nhtfrq=0,-6,1 mfilt =1,4,48 + write_nstep0 = .true. ncdata='$DIN_LOC_ROOT/atm/cam/nudging/ERAI_fv09_BILIN/ERAI_fv09_DART2.cam2.i.2009-01-01-00000.nc' / diff --git a/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/nuopc_cap/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/nuopc_cap/user_nl_cpl index c5be78048c..11030b037f 100644 --- a/cime_config/testdefs/testmods_dirs/cam/nuopc_cap/user_nl_cpl +++ b/cime_config/testdefs/testmods_dirs/cam/nuopc_cap/user_nl_cpl @@ -21,3 +21,5 @@ orb_eccen = 0. orb_mvelp = 0. orb_obliq = 0. orb_mode = "fixed_parameters" +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_cam index 1d7042c597..b0d39d2335 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_cam @@ -1,3 +1,4 @@ mfilt=1,1,1,1,1,1 ndens=1,1,1,1,1,1 nhtfrq=-24,-24,-24,-24,-24,-24 +write_nstep0 = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec/shell_commands new file mode 100644 index 0000000000..f881965bfb --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange RUN_STARTDATE=0001-12-14 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec/user_nl_cam new file mode 100644 index 0000000000..6aae219c84 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec/user_nl_cam @@ -0,0 +1,3 @@ +mfilt=1,1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1,1 +nhtfrq=-24,-24,-24,-24,-24,-24,-24,-24,-24,-24 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec/user_nl_clm new file mode 100644 index 0000000000..5634334558 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! 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 = -24 +hist_mfilt = 1 +hist_ndens = 1 + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_amie/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_amie/user_nl_cam index 23fbd163a2..fe00296b34 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_amie/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_amie/user_nl_cam @@ -1,8 +1,15 @@ -mfilt=1,1,1,1,1,1 -ndens=1,1,1,1,1,1 -nhtfrq=-24,-24,-24,-24,-24,-24 +mfilt=1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1 +nhtfrq=-24,-24,-24,-24,-24,-24,-24,-24,-24 +avgflag_pertape = 'A', 'I', 'I', 'A', 'A', 'I', 'A' steady_state_ion_elec_temp=.false. ionos_epotential_amie=.true. -amienh_file = '$DIN_LOC_ROOT/atm/waccm/amie_data/oct27_31_2003_nh.nc' -amiesh_file = '$DIN_LOC_ROOT/atm/waccm/amie_data/oct27_31_2003_sh.nc' -fincl6 = 'amie_phihm','amie_efxm','amie_kevm','amie_efxg','amie_kevg','amie_efx_phys','amie_kev_phys' +amienh_files = '$DIN_LOC_ROOT/atm/waccm/amie_data/oct27_31_2003_nh.nc' +amiesh_files = '$DIN_LOC_ROOT/atm/waccm/amie_data/oct27_31_2003_sh.nc' +fincl6 = 'prescr_phihm','prescr_efxm','prescr_kevm','prescr_efxp','prescr_kevp','amie_efx_phys','amie_kev_phys' +oplus_grid = 144,96 +fv_nsplit = 16 +fv_nspltrac = 4 +fv_nspltvrm = 4 +ionos_xport_nsplit = 10 +dadadj_niter=100 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_amie/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_amie/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_amie/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/shell_commands new file mode 100644 index 0000000000..de6a2792a7 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange --append CAM_CONFIG_OPTS="-age_of_air_trcs" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_cam new file mode 100644 index 0000000000..b0d39d2335 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_cam @@ -0,0 +1,4 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=-24,-24,-24,-24,-24,-24 +write_nstep0 = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_clm new file mode 100644 index 0000000000..5634334558 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! 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 = -24 +hist_mfilt = 1 +hist_ndens = 1 + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_ltr/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_ltr/shell_commands new file mode 100644 index 0000000000..67c212d596 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_ltr/shell_commands @@ -0,0 +1,5 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL +./xmlchange RUN_STARTDATE=2010-08-03 +./xmlchange START_TOD=0 +./xmlchange CLM_FORCE_COLDSTART=on diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_ltr/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_ltr/user_nl_cam new file mode 100644 index 0000000000..aaf99c7cc6 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_ltr/user_nl_cam @@ -0,0 +1,13 @@ +mfilt=1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1 +nhtfrq=-24,-24,-24,-24,-24,-24,-24,-24,-24 +avgflag_pertape = 'A', 'I', 'I', 'A', 'A', 'I', 'A' +inithist='ENDOFRUN' +ionos_epotential_ltr=.true. +ltr_files = '$DIN_LOC_ROOT/atm/waccm/amie_data/REMIX_3-4_Aug_2010_c210302.nc' +fincl6 = 'prescr_phihm','prescr_efxm','prescr_kevm','prescr_efxp','prescr_kevp','ltr_efx_phys','ltr_kev_phys' +fv_nsplit = 16 +fv_nspltrac = 4 +fv_nspltvrm = 4 +ionos_xport_nsplit = 10 +dadadj_niter = 100 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cam index 25a71f377b..faa9ae8747 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cam @@ -1,4 +1,6 @@ mfilt=1,1,1,1,1,1 ndens=1,1,1,1,1,1 nhtfrq=-24,-24,-24,-24,-24,-24 -fincl6='ElecColDens','EPHI3D','ELAM3D' +fincl6='EX','EY','EZ','ED13D','ED23D','ADOTV1_MAG','ADOTV2_MAG','RJAC11','RJAC22', + 'WACCM_UI','WACCM_VI','DPIE_ZHT','EDYN_BE3','OPtm1o' +ionos_debug_hist=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/shell_commands new file mode 100644 index 0000000000..a371a33c20 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/shell_commands @@ -0,0 +1 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/user_nl_cam new file mode 100644 index 0000000000..a5fa13c3a1 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/user_nl_cam @@ -0,0 +1,13 @@ +phys_grid_ctem_nfreq = -12 +phys_grid_ctem_zm_nbas = 120 +phys_grid_ctem_za_nlat = 90 + +fincl1 = ' ' +fexcl1 = ' ' + +fincl2 = 'Uzm','Vzm','Wzm','THzm', 'VTHzm','WTHzm','UVzm','UWzm' + +mfilt=1,1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1,1 +nhtfrq=-24,-24,-24,-24,-24,-24,-24,-24,-24,-24 +inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/user_nl_clm new file mode 100644 index 0000000000..59ebd669f7 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/user_nl_clm @@ -0,0 +1,3 @@ +hist_nhtfrq = -24 +hist_mfilt = 1 +hist_ndens = 1 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/shell_commands deleted file mode 100644 index 8b1fad6d2d..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/shell_commands +++ /dev/null @@ -1,2 +0,0 @@ -./xmlchange RUN_STARTDATE=2013-10-01 -./xmlchange NTASKS=-50 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/user_nl_cam deleted file mode 100644 index 820bcd0e17..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/user_nl_cam +++ /dev/null @@ -1,61 +0,0 @@ - se_phys_dyn_cp = 2 - gw_polar_taper = .true. - - mfilt=1,1,1,1,1,1,1,1,1 - ndens=1,1,1,1,1,1,1,1,1 - nhtfrq=-24,-24,-24,-24,-24,-24,-24,-24,-24 - - inithist='ENDOFRUN' - - ncdata = '$DIN_LOC_ROOT/atm/cam/inic/se/fchist_ne0conus30x8_L32_2012-11-01_c191203.nc' - - fincl2 = 'SFBENZENE','SFBIGALK','SFC2H2','SFCH2O','SFCH3COOH','SFCO','SFNO' - - ext_frc_specifier = - 'bc_a4 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_bc_a4_aircraft_vertical_1750-2015_0.9x1.25_c20170608.nc', - 'NO2 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-EPA_NO2_vertical_anthro_201306-201310_conus_30x8_c190906.nc', - 'num_a1 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a1_anthro-ene_vertical_1750-2015_0.9x1.25_c20170616.nc', - 'num_a1 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', - 'num_a2 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', - 'num_a4 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_bc_a4_aircraft_vertical_1750-2015_0.9x1.25_c20170608.nc', - 'SO2 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-EPA_SO2_vertical_anthro_201306-201310_conus_30x8_c190906.nc', - 'SO2 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', - 'SO2 -> $DIN_LOC_ROOT/atm/cam/chem/stratvolc/VolcanEESMv3.11_SO2_850-2016_Mscale_Zreduc_1deg_c191203.nc', - 'so4_a1 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_anthro-ene_vertical_1750-2015_0.9x1.25_c20170616.nc', - 'so4_a1 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc', - 'so4_a2 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc' - - srf_emis_specifier = - 'BENZENE -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_BENZENE_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'BIGENE -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_BIGENE_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'C2H2 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_C2H2_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'C2H4 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_C2H4_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'C2H6 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_C2H6_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'C3H6 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_C3H6_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'C3H8 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_C3H8_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'CH2O -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_CH2O_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'CH3CHO -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_CH3CHO_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'CH3CN -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_CH3CN_surface_anthro_2012-2014_conus_30x8_c190903.nc', - 'CH3COOH -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_CH3COOH_surface_anthro_2012-2014_conus_30x8_c190903.nc', - 'CO -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_CO_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'E90 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions_E90global_surface_1750-2100_0.9x1.25_c20170322.nc', - 'HCN -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_HCN_surface_anthro_2012-2014_conus_30x8_c190903.nc', - 'HCOOH -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_HCOOH_surface_anthro_2012-2014_conus_30x8_c190903.nc', - 'IVOC -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_IVOC_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', - 'NH3 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_NH3_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'NO -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_NOx_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'SVOC -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SVOC_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', - 'TOLUENE -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_TOLUENE_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'DMS -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_DMS_other_surface_1750-2015_0.9x1.25_c20170322.nc', - 'bc_a4 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_BC_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'num_a1 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a1_bb_surface_1750-2015_0.9x1.25_c20170322.nc', - 'num_a1 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a1_anthro-ag-ship_surface_1750-2015_0.9x1.25_c20170616.nc', - 'num_a2 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_so4_a2_anthro-res_surface_1750-2015_0.9x1.25_c20170616.nc', - 'num_a4 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_num_bc_a4_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'num_a4 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_pom_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', - 'pom_a4 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_pom_a4_anthro_surface_1750-2015_0.9x1.25_c20170608.nc', - 'SO2 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CAM-SE_ne0conus_30x8/emissions-CMIP6_SO2_surface_anthro_2012-2014_masked_conus_30x8_c190903.nc', - 'SO2 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_anthro-ene_surface_1750-2015_0.9x1.25_c20170616.nc', - 'so4_a1 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_anthro-ag-ship_surface_1750-2015_0.9x1.25_c20170616.nc', - 'so4_a1 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_bb_surface_1750-2015_0.9x1.25_c20170322.nc', - 'so4_a2 -> $DIN_LOC_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_anthro-res_surface_1750-2015_0.9x1.25_c20170616.nc' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/user_nl_clm deleted file mode 100644 index e45c51587b..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/user_nl_clm +++ /dev/null @@ -1,33 +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 = -24 -hist_mfilt = 1 -hist_ndens = 1 - -finidat = '$DIN_LOC_ROOT/lnd/clm2/initdata/opt_se_cslam_topo.FCHIST.ne30_ne30_mg17.default_spin_up_TS1.clm2.r.2012-11-01-00000_c190810.nc' -use_init_interp = .true. - -fsurdat = '$DIN_LOC_ROOT/lnd/clm2/surfdata_map/surfdata_ne0CONUSne30x8_hist_16pfts_Irrig_CMIP6_simyr1850_c190814.nc' - -flanduse_timeseries = '$DIN_LOC_ROOT/lnd/clm2/surfdata_map/landuse.timeseries_ne0CONUSne30x8_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c190815.nc' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq24h_port/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq24h_port/shell_commands index aee22f2b06..2284b22d5e 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq24h_port/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq24h_port/shell_commands @@ -1,4 +1,4 @@ ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL ./xmlchange CAM_NML_USE_CASE=UNSET -./xmlchange RUN_STARTDATE="00000101" +./xmlchange RUN_STARTDATE="00010101" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq24h_port/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq24h_port/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq24h_port/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3h/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3h/user_nl_cam index fa95272eca..e7912ac2f0 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3h/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3h/user_nl_cam @@ -1,3 +1,4 @@ mfilt=1,1,1,1,1,1,1,1,1,1 ndens=1,1,1,1,1,1,1,1,1,1 nhtfrq=-3,-3,-3,-3,-3,-3,-3,-3,-3,-3 +write_nstep0 = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3h_fubc/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3h_fubc/shell_commands new file mode 100644 index 0000000000..a371a33c20 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3h_fubc/shell_commands @@ -0,0 +1 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3h_fubc/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3h_fubc/user_nl_cam new file mode 100644 index 0000000000..52694ae6a8 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3h_fubc/user_nl_cam @@ -0,0 +1,14 @@ +mfilt=1,1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1,1 +nhtfrq=-3,-3,-3,-3,-3,-3,-3,-3,-3,-3 +history_chemistry=.true. +fincl2 = 'Q_fubc','NO_fubc','NO2_fubc','NO3_fubc','N2O5_fubc','CH4_UBC','Q_UBC','NO_UBC','NO2_UBC','NO3_UBC','HNO3_UBC','N2O5_UBC' +avgflag_pertape = 'A','A' + +ubc_specifier = 'CH4->1.D-12MMR','Q:H2O->UBC_FILE','NO->UBC_FILE','NO2->UBC_FILE','NO3->UBC_FILE','HNO3->UBC_FILE','N2O5->UBC_FILE' +ubc_file_path='$DIN_LOC_ROOT/atm/cam/chem/ubc/f.e21.FWHISTBgcCrop.f09_f09_mg17.CMIP6-AMIP-WACCM.ensAvg123.cam.h0zm.UBC.195001-201412_c220322.nc' +ubc_file_input_type='CYCLICAL' +ubc_file_cycle_yr = 2000 + +fstrat_list = ' ' +fstrat_file = ' ' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3h_fubc/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq3h_fubc/user_nl_clm new file mode 100644 index 0000000000..8c353ae313 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3h_fubc/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! 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 = -3 +hist_mfilt = 1 +hist_ndens = 1 + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s/user_nl_cam index b8f943cd5f..805f0ab383 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s/user_nl_cam @@ -1,5 +1,6 @@ mfilt=1,1,1,1,1,1 ndens=1,1,1,1,1,1 nhtfrq=3,3,3,3,3,3 +write_nstep0=.true. inithist='ENDOFRUN' pbuf_global_allocate=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_WX81/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_WX81/shell_commands deleted file mode 100644 index 0554b09004..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_WX81/shell_commands +++ /dev/null @@ -1,5 +0,0 @@ -./xmlchange ROF_NCPL=\$ATM_NCPL -./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange --append CAM_CONFIG_OPTS="-ionosphere wxi -nlev 81" -./xmlchange RUN_STARTDATE=1995-01-01 -./xmlchange CAM_NML_USE_CASE=UNSET diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_WX81/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_WX81/user_nl_cam deleted file mode 100644 index 55667f49bc..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_WX81/user_nl_cam +++ /dev/null @@ -1,6 +0,0 @@ -mfilt=1,1,1,1,1,1 -ndens=1,1,1,1,1,1 -nhtfrq=3,3,3,3,3,3 -inithist='ENDOFRUN' -ncdata='$DIN_LOC_ROOT/atm/waccm/ic/WAX3548T08CO_2003top_f2000.waccm_0017bottom_L81_c110906.nc' -pbuf_global_allocate=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_aqw/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_aqw/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_aqw/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ba/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ba/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ba/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_carma/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_carma/shell_commands deleted file mode 100644 index 61d78eb8db..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_carma/shell_commands +++ /dev/null @@ -1,5 +0,0 @@ -./xmlchange --append CAM_CONFIG_OPTS="-carma test_tracers" -./xmlchange ROF_NCPL=\$ATM_NCPL -./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange CAM_NML_USE_CASE=UNSET -./xmlchange RUN_STARTDATE="00000101" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_carma/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_carma/user_nl_cam deleted file mode 100644 index 377cbb2295..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_carma/user_nl_cam +++ /dev/null @@ -1,8 +0,0 @@ -mfilt=1,1,1,1,1,1 -ndens=1,1,1,1,1,1 -nhtfrq=3,3,3,3,3,3 -inithist='ENDOFRUN' -pbuf_global_allocate=.false. -history_carma=.true. -carma_do_fixedinit=.false. -carma_reftfile="camrun.cam.r.carma_reft.nc" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_chemproc/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_chemproc/shell_commands new file mode 100644 index 0000000000..294ff5a5d7 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_chemproc/shell_commands @@ -0,0 +1,3 @@ +./xmlchange --append CAM_CONFIG_OPTS="-usr_mech_infile \$TESTS_MODS_DIR/cam/outfrq3s_chemproc/test_mech.in" +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_chemproc/test_mech.in b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_chemproc/test_mech.in new file mode 100644 index 0000000000..edb29f03bb --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_chemproc/test_mech.in @@ -0,0 +1,350 @@ +* Modified version of trop_mozart chemistry mechanism +* For CAM regression testing ONLY +* + +SPECIES + + Solution + O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2 + CH4, CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH + C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO + C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH + C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH + CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH + BIGENE -> C4H8, ENEO2 -> C4H9O3 + MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3 + BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2 + ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2 + MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO + MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH + MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH + CH3COCHO, XO2 -> HOCH2COOCH3CHOHCHO, XOOH -> HOCH2COOHCH3CHOHCHO + C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3 + TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O5, TOLOOH -> C7H10O5 + XOH -> C7H10O6, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2 + PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2 + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH + CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12 + SO2, DMS -> CH3SCH3, SO4, NH3, NH4, NH4NO3 + SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl + DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5 + Rn, Pb + HCN, CH3CN, C2H2, HCOOH, HOCH2OO + End Solution + + Fixed + M, N2, O2, H2O + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + +End SPECIES + +Solution Classes + Explicit + CH4, N2O, CO, Rn, Pb, H2, HCN, CH3CN + End Explicit + Implicit + O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2 + CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH + C2H4, EO, EO2, CH3COOH, GLYALD + C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH + C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH + BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH + ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3 + HYDRALD, HYAC, CH3COCHO, XO2, XOOH + C10H16, TERPO2, TERPOOH + TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL + PAN, ONIT, MPAN, ISOPNO3, ONITR + SO2, DMS, SO4, NH3, NH4, NH4NO3, SOA + CB1, CB2, OC1, OC2 + C2H2, HCOOH, HOCH2OO + SSLT01, SSLT02, SSLT03, SSLT04 + DST01, DST02, DST03, DST04 + End Implicit +End Solution Classes + +CHEMISTRY + Photolysis + [jo2->,jo2_b] O2 + hv -> 2*O + [jo1d->,jo3_a] O3 + hv -> O1D + O2 + [jn2o] N2O + hv -> O1D + N2 + [jno2] NO2 + hv -> NO + O + [jn2o5->,jn2o5_a] N2O5 + hv -> NO2 + NO3 + [jhno3] HNO3 + hv -> NO2 + OH + [jno3_a] NO3 + hv -> .89*NO2 + .11*NO + .89*O3 + [jno3_b] NO3 + hv -> .89*NO2 + .11*NO + .89*O3 + [jho2no2_a] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2 + [jho2no2_b] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2 + [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH + [jch2o_a] CH2O + hv -> CO + 2 * HO2 + [jch2o_b] CH2O + hv -> CO + H2 + [jh2o2] H2O2 + hv -> 2*OH + [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2 + [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH + [jch3co3h->,.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2 + [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2 + [jmpan->,jpan] MPAN + hv -> MCO3 + NO2 + [jmacr_a] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO + [jmacr_b] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO + [jmvk] MVK + hv -> .7*C3H6 + .7*CO + .3*CH3O2 + .3*CH3CO3 + [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH + [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> .82 * CH3COCH3 + OH + HO2 + [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH + [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2 + [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2 + [jxooh->,jch3ooh] XOOH + hv -> OH + [jonitr->,jch3cho] ONITR + hv -> HO2 + CO + NO2 + CH2O + [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2 + [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O + [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O + [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 + [jbigald->,.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO + [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2 + [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH + [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO + [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD + [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR + End Photolysis + + Reactions + [usr_O_O2] O + O2 + M -> O3 + M + [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115 + [o1d_o2] O1D + O2 -> O + O2 ; 3.30e-11, 55. + [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10 + H2 + O1D -> HO2 + OH ; 1.1e-10 + H2 + OH -> H2O + HO2 ; 2.8e-12, -1800 + O + OH -> HO2 + O2 ; 2.2e-11, 120 + HO2 + O -> OH + O2 ; 3e-11, 200 + [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940 + [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490 + [usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2 + H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 + OH + HO2 -> H2O + O2 ; 4.8e-11, 250 + OH + OH -> H2O + O ; 1.8e-12 + OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6 + N2O + O1D -> N2 + O2 ; 4.9e-11 + N2O + O1D -> 2*NO ; 6.7e-11 + [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250 + NO + O3 -> NO2 + O2 ; 3e-12, -1500 + NO2 + O -> NO + O2 ; 5.1e-12, 210 + NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450 + NO3 + HO2 -> OH + NO2 ; 3.5e-12 + [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6 + [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M + [tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6 + [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O + NO3 + NO -> 2*NO2 ; 1.5e-11, 170 + [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 2.0e-31,3.4, 2.9e-12,1.1, .6 + HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 + [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M + CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775 + CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10 + [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 + CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424 + CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706 + CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750 + CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200 + CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058 + CH2O + OH -> CO + H2O +HO2 ; 9.e-12 + CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6 + [usr_CO_OH_b] CO + OH -> CO2 + HO2 + CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620 + HCOOH + OH -> HO2 + CO2 + H2O ; 4.5e-13 + CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625 + HOCH2OO -> CH2O + HO2 ; 2.4e12, -7000 + HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265 + HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 +*C2 + C2H2 + OH + M -> .65*GLYOXAL + .65*OH + .35*HCOOH + .35*HO2 ; 5.5e-30,0,8.3e-13,-2,.6 + + .35*CO + M + [tag_C2H4_OH] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6 + [ox_l6] C2H4 + O3 -> CH2O + .12*HO2 + .5*CO + .12*OH + .5*HCOOH ; 1.2e-14, -2630 + [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180 + EO + O2 -> GLYALD + HO2 ; 1.e-14 + EO -> 2 * CH2O + HO2 ; 1.6e11,-4150 + C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070 + [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365 + C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700 + C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13 + + .3 * CH3OH + .2 * C2H5OH + C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14 + C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200 + CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270 + CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900 + [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270 + [tag_CH3CO3_NO2] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6 + CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040 + CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500 + CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12 + PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14 + [usr_PAN_M] PAN + M -> CH3CO3 + NO2 + M + CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500 + GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11 + GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11 + CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13 + C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230 + +*C3 + [tag_C3H6_OH] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5 + [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900 + + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH + C3H6 + NO3 -> ONIT ; 4.6e-13,-1156 + [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180 + PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700 + POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200 + C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -665 + [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180 + C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700 + C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40 + C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200 + [usr_CH3COCH3_OH] CH3COCH3 + OH -> RO2 + H2O + [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300 + RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700 + RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 7.1e-13, 500 + + .5*CH3COCHO + .5*CH3OH + ROOH + OH -> RO2 + H2O ; 3.8e-12, 200 + ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13 + CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830 + CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860 + HYAC + OH -> CH3COCHO + HO2 ; 3.e-12 + +*C4 + BIGENE + OH -> ENEO2 ; 5.4e-11 + [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180 + MEK + OH -> MEKO2 ; 2.3e-12, -170 + [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180 + MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700 + MEKOOH + OH -> MEKO2 ; 3.8e-12, 200 + MPAN + OH + M -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 ; 8.e-27,3.5,3.e-11,0.,.5 + + .5*CO2 + M + +*C5 + [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12 + [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180 + + .75*MEK + .9*NO2 + .1*ONIT + ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700 + ALKOOH + OH -> ALKO2 ; 3.8e-12, 200 + ISOP + OH -> ISOPO2 ; 2.54e-11, 410 + [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000 + + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3 + + .2 * MCO3 + .2 * CH3COOH + [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 4.4e-12, 180 + + .23 * MACR + .32 * MVK + .37 * HYDRALD + ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12 + + .35 * MVK + .4 * HYDRALD + ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700 + ISOPOOH + OH -> .8 * XO2 + .2 * ISOPO2 ; 1.52e-11, 200 + ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400 + + .19 * MACR + .26 * MVK + .3 * HYDRALD + ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11 + + .25 * MACR + .35 * MVK + .4 * HYDRALD + ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446 + ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360 + + .039 * MVK + .794 * ONITR + ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12 + + .794 * ONITR + .794 * HO2 + ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700 + + .167 * MACR + .039 * MVK + .794 * ONITR + MVK + OH -> MACRO2 ; 4.13e-12, 452 + [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521 + + .06 * HO2 + .05 * CO + .04 * CH3CHO + MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175 + [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500 + + .7 * CH2O + .215 * OH + [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360 + + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD + + .22 * HYAC + .22 * CO + MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360 + MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12 + + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3 + MACRO2 + HO2 -> MACROOH ; 8.e-13, 700 + MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400 + + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC + MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11 + + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3 + MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200 + [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360 + MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12 + MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040 + MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500 + MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530 + MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530 + [usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M + [usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M + ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11 + ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860 + HYDRALD + OH -> XO2 ; 1.86e-11,175 + [ox_p11] XO2 + NO -> NO2 + HO2 + .5*CO + .25*GLYOXAL ; 2.7e-12, 360. + + .25*HYAC + .25*CH3COCHO + .25*GLYALD + XO2 + NO3 -> NO2 + HO2 + 0.5*CO + .25*HYAC ; 2.40e-12 + + 0.25*GLYOXAL + .25*CH3COCHO + .25*GLYALD + XO2 + HO2 -> XOOH ; 8.e-13, 700 + XO2 + CH3O2 -> .3 * CH3OH + 0.8*HO2 + .7 * CH2O ; 5.00e-13, 400. + + .2 * CO + .1 * HYAC + + .1*GLYOXAL + .1 * CH3COCHO + .1 * GLYALD + XO2 + CH3CO3 -> 0.5*CO + CH3O2 + HO2 + CO2 + .25 GLYOXAL ; 1.30e-12, 640. + + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD + XOOH + OH -> H2O + XO2 ; 1.90e-12, 190 + [usr_XOOH_OH] XOOH + OH -> H2O + OH + +*C7 + [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352 + CRESOL + OH -> XOH ; 3.e-12 + XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11 + [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180 + + .9*NO2 + .9*HO2 + TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700 + TOLOOH + OH -> TOLO2 ; 3.8e-12, 200 + +*C10 + [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444 + [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732 + [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490 + [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180 + TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700 + TERPOOH + OH -> TERPO2 ; 3.8e-12, 200 + + Rn -> Pb ; 2.1e-6 +*het/aerosol rxns + [usr_N2O5_aer] N2O5 -> 2 * HNO3 + [usr_NO3_aer] NO3 -> HNO3 + [usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 + CB1 -> CB2 ; 7.1e-6 + [usr_SO2_OH] SO2 + OH -> SO4 + DMS + OH -> SO2 ; 9.6e-12,-234. + [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 + DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. + NH3 + OH -> H2O ; 1.7e-12, -710. + OC1 -> OC2 ; 7.1e-6 + [usr_HO2_aer] HO2 -> 0.5*H2O2 +*cyanides + HCN + OH + M -> HO2 + M ; 4.28e-33, 0.0, 9.30e-15, -4.42, 0.8 + CH3CN + OH -> HO2 ;7.8e-13, -1050 + End Reactions + + Ext Forcing + NO <- dataset + CO <- dataset + SO2 <- dataset + SO4 <- dataset + End Ext Forcing + + END CHEMISTRY + + SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + + END SIMULATION PARAMETERS diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_chemproc/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_chemproc/user_nl_cam new file mode 100644 index 0000000000..08b599a188 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_chemproc/user_nl_cam @@ -0,0 +1,4 @@ +mfilt=1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3,3,3,3 +inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/shell_commands deleted file mode 100644 index 3a506cfaa1..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/shell_commands +++ /dev/null @@ -1,4 +0,0 @@ -./xmlchange ROF_NCPL=\$ATM_NCPL -./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange CAM_NML_USE_CASE=UNSET -./xmlchange RUN_STARTDATE="19950101" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cam deleted file mode 100644 index f81fb38bfc..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cam +++ /dev/null @@ -1,6 +0,0 @@ -zmconv_microp=.true. -mfilt=1,1,1,1,1,1 -ndens=1,1,1,1,1,1 -nhtfrq=3,3,3,3,3,3 -inithist='ENDOFRUN' -pbuf_global_allocate=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_cosp/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_cosp/shell_commands index 09a1939ddb..11a171a04e 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_cosp/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_cosp/shell_commands @@ -1,8 +1,7 @@ CAM_CONFIG_OPTS=`./xmlquery CAM_CONFIG_OPTS --value` if [[ $CAM_CONFIG_OPTS != *"-cosp"* ]]; then - ./xmlchange -append CAM_CONFIG_OPTS="-cosp" + ./xmlchange --append CAM_CONFIG_OPTS="-cosp" fi ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange CAM_NML_USE_CASE=UNSET ./xmlchange RUN_STARTDATE="19950101" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_cosp/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_cosp/user_nl_cam index ddff96685c..a2a8169e6f 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_cosp/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_cosp/user_nl_cam @@ -2,4 +2,5 @@ mfilt=1,1,1,1,1,1 ndens=1,1,1,1,1,1 nhtfrq=3,3,3,3,3,3 inithist='ENDOFRUN' -fexcl1='CFAD_DBZE94_CS','CLDTOT_CALCS','CLD_CAL_NOTCS','CS_MIXCERT','CS_MIXPOSS','CS_NOPRECIP','CS_PIA','CS_RAINPOSS','CS_RAINPROB' +fexcl1='CFAD_DBZE94_CS','CLDTOT_CALCS','CLD_CAL_NOTCS','CS_MIXCERT','CS_MIXPOSS','CS_NOPRECIP','CS_PIA', + 'CS_RAINPOSS','CS_RAINPROB','CS_SNOWCERT','CS_SNOWPOSS' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_cospsathist/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_cospsathist/user_nl_cam index 801587cedd..e893c96525 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_cospsathist/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_cospsathist/user_nl_cam @@ -1,6 +1,7 @@ ndens=1,1,1,1,1,1 nhtfrq=3,3,3,3,-2,3 mfilt=1,1,1,1,1,1 + write_nstep0=.true. sathist_track_infile='$DIN_LOC_ROOT/atm/cam/sat/satellite_profilelist_20020125_20101030_c110204_noleap.nc' sathist_fincl = 'Q','T','PS','U','V','FV' fincl3 = 'Q','T','PS','FV','UWzm:I' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_diags/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_diags/user_nl_cam index 52fdf6b7f9..1e6c0ad508 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_diags/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_diags/user_nl_cam @@ -1,6 +1,7 @@ mfilt=1,1,1,1,1,1 ndens=2,2,2,2,2,2 nhtfrq=3,3,3,3,3,3 +write_nstep0=.true. inithist='ENDOFRUN' history_amwg=.true. history_aerosol=.true. @@ -12,3 +13,5 @@ history_waccmx=.true. history_chemistry=.true. history_carma=.true. history_clubb=.true. +fincl2='Uzm:I','Vzm:I','Wzm:I','THzm:I' +do_circulation_diags=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_576tsks/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_160x193/shell_commands similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq9s_576tsks/shell_commands rename to cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_160x193/shell_commands diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_160x193/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_160x193/user_nl_cam new file mode 100644 index 0000000000..536b555034 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_160x193/user_nl_cam @@ -0,0 +1,9 @@ +ionos_debug_hist=.true. +fincl6='EX','EY','EZ','ED13D','ED23D','ADOTV1_MAG','ADOTV2_MAG','RJAC11','RJAC22', + 'WACCM_UI','WACCM_VI','DPIE_ZHT','EDYN_BE3','OPtm1o','OPLUS_TE','EXPLICIT0','P_COEFF' +mfilt=1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3,3,3,3 +inithist='ENDOFRUN' +oplus_grid=288,192 +edyn_grid='160x193' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_160x193/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_160x193/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wcm_ne30/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_320x385/shell_commands similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq9s_wcm_ne30/shell_commands rename to cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_320x385/shell_commands diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_320x385/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_320x385/user_nl_cam new file mode 100644 index 0000000000..73ec7ddc5a --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_320x385/user_nl_cam @@ -0,0 +1,7 @@ +fincl6='EX','EY','EZ','ED13D','ED23D' +mfilt=1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3,3,3,3 +inithist='ENDOFRUN' +oplus_grid=576,384 +edyn_grid='320x385' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_tmoz/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_320x385/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq3s_tmoz/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_320x385/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_640x769/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/outfrq3s_edyngrid_640x769/shell_commands diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_640x769/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_640x769/user_nl_cam new file mode 100644 index 0000000000..d7ef3e045e --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_640x769/user_nl_cam @@ -0,0 +1,6 @@ +mfilt=1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3,3,3,3 +inithist='ENDOFRUN' +oplus_grid=576,384 +edyn_grid='640x769' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_waccm_ma/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_640x769/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq3s_waccm_ma/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_640x769/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_eoyttrac/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_eoyttrac/shell_commands index 55acb6dd32..3746e133fa 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_eoyttrac/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_eoyttrac/shell_commands @@ -1,6 +1,6 @@ ./xmlchange -append CAM_CONFIG_OPTS="-nadv_tt 5 -cppdefs -DTRACER_CHECK" ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange RUN_STARTDATE="0000-12-31" +./xmlchange RUN_STARTDATE="0001-12-31" ./xmlchange START_TOD="82800" ./xmlchange CAM_NML_USE_CASE=UNSET diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_eoyttrac/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_eoyttrac/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_eoyttrac/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cam new file mode 100644 index 0000000000..05a64cd2a2 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cam @@ -0,0 +1,45 @@ +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value + + fincl2='U','V','T','Q','PS','Nudge_U','Nudge_V','Nudge_T','Nudge_Q','Target_U','Target_V','Target_T','Target_Q' + nhtfrq=3,3,3,3,3,3,3,3,3,3 + mfilt =1,1,1,1,1,1,1,1,1,1 + ndens =1,1,1,1,1,1,1,1,1,1 + + Nudge_Model =.true. + Nudge_Path ='$DIN_LOC_ROOT/atm/cam/nudging/test_f10/' + Nudge_File_Template='QPC4_f10_met_data_gen01.cam.h1.%y-%m-%d-%s.nc' + Nudge_Force_Opt = 1 + Nudge_TimeScale_Opt = 0 + Nudge_Times_Per_Day=4 + Model_Times_Per_Day=48 + Nudge_Uprof =1 + Nudge_Ucoef =1.00 + Nudge_Vprof =1 + Nudge_Vcoef =1.00 + Nudge_Tprof =1 + Nudge_Tcoef =1.00 + Nudge_Qprof =1 + Nudge_Qcoef =1.00 + Nudge_PSprof =1 + Nudge_PScoef =1.00 + Nudge_Beg_Year =0001 + Nudge_Beg_Month=01 + Nudge_Beg_Day =01 + Nudge_End_Year =0001 + Nudge_End_Month=01 + Nudge_End_Day =02 + Nudge_Hwin_lat0 =0.0 + Nudge_Hwin_latWidth=9999. + Nudge_Hwin_latDelta=1.0 + Nudge_Hwin_lon0 =180. + Nudge_Hwin_lonWidth=9999. + Nudge_Hwin_lonDelta=1. + Nudge_Hwin_Invert =.false. + Nudge_Vwin_Hindex =27. + Nudge_Vwin_Hdelta =0.001 + Nudge_Vwin_Lindex =0. + Nudge_Vwin_Ldelta =0.1 + Nudge_Vwin_Invert =.false. + Nudge_ZonalFilter = .true. + Nudge_ZonalNbasis = 10 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cam new file mode 100644 index 0000000000..4b17143322 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cam @@ -0,0 +1,45 @@ +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value + + fincl2='U','V','T','Q','PS','Nudge_U','Nudge_V','Nudge_T','Nudge_Q','Target_U','Target_V','Target_T','Target_Q' + nhtfrq=3,3,3,3,3,3,3,3,3,3 + mfilt =1,1,1,1,1,1,1,1,1,1 + ndens =1,1,1,1,1,1,1,1,1,1 + + Nudge_Model =.true. + Nudge_Path ='$DIN_LOC_ROOT/atm/cam/nudging/test_ne5/' + Nudge_File_Template='QPC4_ne5_met_data_gen01.cam.h1.%y-%m-%d-%s.nc' + Nudge_Force_Opt = 1 + Nudge_TimeScale_Opt = 0 + Nudge_Times_Per_Day=4 + Model_Times_Per_Day=48 + Nudge_Uprof =1 + Nudge_Ucoef =1.00 + Nudge_Vprof =1 + Nudge_Vcoef =1.00 + Nudge_Tprof =1 + Nudge_Tcoef =1.00 + Nudge_Qprof =1 + Nudge_Qcoef =1.00 + Nudge_PSprof =1 + Nudge_PScoef =1.00 + Nudge_Beg_Year =0001 + Nudge_Beg_Month=01 + Nudge_Beg_Day =01 + Nudge_End_Year =0001 + Nudge_End_Month=01 + Nudge_End_Day =02 + Nudge_Hwin_lat0 =0.0 + Nudge_Hwin_latWidth=9999. + Nudge_Hwin_latDelta=1.0 + Nudge_Hwin_lon0 =180. + Nudge_Hwin_lonWidth=9999. + Nudge_Hwin_lonDelta=1. + Nudge_Hwin_Invert =.false. + Nudge_Vwin_Hindex =27. + Nudge_Vwin_Hdelta =0.001 + Nudge_Vwin_Lindex =0. + Nudge_Vwin_Ldelta =0.1 + Nudge_Vwin_Invert =.false. + Nudge_ZonalFilter = .true. + Nudge_ZonalNbasis = 10 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_physgrid_tem/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_physgrid_tem/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_physgrid_tem/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_physgrid_tem/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_physgrid_tem/user_nl_cam new file mode 100644 index 0000000000..dad2b49ac7 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_physgrid_tem/user_nl_cam @@ -0,0 +1,8 @@ +mfilt=1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1 +nhtfrq=3,3,3,3,3,3,3,3,3 +inithist='ENDOFRUN' +phys_grid_ctem_nfreq=3 +phys_grid_ctem_zm_nbas=16 +phys_grid_ctem_za_nlat=15 +fincl3 = 'Uzm','Vzm','Wzm','THzm', 'VTHzm','WTHzm','UVzm','UWzm' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_physgrid_tem/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_physgrid_tem/user_nl_clm new file mode 100644 index 0000000000..dfd79c6314 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_physgrid_tem/user_nl_clm @@ -0,0 +1,26 @@ +!---------------------------------------------------------------------------------- +! 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 = 3 +hist_mfilt = 1 +hist_ndens = 1 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_sathist/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_sathist/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_sathist/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_subcol/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_subcol/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_subcol/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_tmoz/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_tmoz/shell_commands deleted file mode 100644 index fe960f430f..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_tmoz/shell_commands +++ /dev/null @@ -1,5 +0,0 @@ -./xmlchange ROF_NCPL=\$ATM_NCPL -./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange -append CAM_CONFIG_OPTS="-chem trop_mozart" -./xmlchange CAM_NML_USE_CASE="2000_cam4_trop_chem" -./xmlchange RUN_STARTDATE="19950101" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_tmoz/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_tmoz/user_nl_cam deleted file mode 100644 index b8f943cd5f..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_tmoz/user_nl_cam +++ /dev/null @@ -1,5 +0,0 @@ -mfilt=1,1,1,1,1,1 -ndens=1,1,1,1,1,1 -nhtfrq=3,3,3,3,3,3 -inithist='ENDOFRUN' -pbuf_global_allocate=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/shell_commands index 55acb6dd32..3746e133fa 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/shell_commands @@ -1,6 +1,6 @@ ./xmlchange -append CAM_CONFIG_OPTS="-nadv_tt 5 -cppdefs -DTRACER_CHECK" ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange RUN_STARTDATE="0000-12-31" +./xmlchange RUN_STARTDATE="0001-12-31" ./xmlchange START_TOD="82800" ./xmlchange CAM_NML_USE_CASE=UNSET diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/user_nl_cam index 43ef003dd6..20883325af 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/user_nl_cam @@ -2,3 +2,7 @@ mfilt=1,1,1,1,1,1 ndens=1,1,1,1,1,1 nhtfrq=3,3,3,3,3,3 inithist='ENDOFRUN' +interpolate_output=.false.,.true. +interpolate_nlat=0,30 +interpolate_nlon=0,60 +fincl2='Q:I','T:I','U:I','V:I','Q_gll:I','T_gll:I','U_gll:I','V_gll:I' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac_usecase/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac_usecase/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac_usecase/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_unicon/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_unicon/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_unicon/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_usecase/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_usecase/user_nl_cam index b8f943cd5f..0fd89f084b 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_usecase/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_usecase/user_nl_cam @@ -3,3 +3,4 @@ ndens=1,1,1,1,1,1 nhtfrq=3,3,3,3,3,3 inithist='ENDOFRUN' pbuf_global_allocate=.false. +fincl2='U:I','V:I','T:I','TTEND_TOT:I','DTCORE:I' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_waccm_ma/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_waccm_ma/shell_commands deleted file mode 100644 index 7b5dacf365..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_waccm_ma/shell_commands +++ /dev/null @@ -1,5 +0,0 @@ -./xmlchange ROF_NCPL=\$ATM_NCPL -./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange CAM_CONFIG_OPTS="-phys cam4 -aquaplanet -chem waccm_ma -waccmx -ionosphere none" -./xmlchange CAM_NML_USE_CASE="waccmx_ma_2000_cam4" -./xmlchange RUN_STARTDATE="19950101" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_waccm_ma/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_waccm_ma/user_nl_cam deleted file mode 100644 index b8f943cd5f..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_waccm_ma/user_nl_cam +++ /dev/null @@ -1,5 +0,0 @@ -mfilt=1,1,1,1,1,1 -ndens=1,1,1,1,1,1 -nhtfrq=3,3,3,3,3,3 -inithist='ENDOFRUN' -pbuf_global_allocate=.false. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cam new file mode 100644 index 0000000000..0f8ab5afe8 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cam @@ -0,0 +1,10 @@ +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value + + fincl2='U','V','T','Q','PS','Nudge_U','Nudge_V','Nudge_T','Nudge_Q','Target_U','Target_V','Target_T','Target_Q' + nhtfrq=3,3,3,3,3,3,3,3,3,3 + mfilt =1,1,1,1,1,1,1,1,1,1 + ndens =1,1,1,1,1,1,1,1,1,1 + + Nudge_ZonalFilter = .true. + Nudge_ZonalNbasis = 64 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_cam index 8482082dce..77424c653b 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_cam @@ -1,4 +1,5 @@ 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/outfrq9s_576tsks/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_576tsks/user_nl_cam deleted file mode 100644 index d36b950de1..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_576tsks/user_nl_cam +++ /dev/null @@ -1,5 +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' -npr_yz = 48,12,12,48 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL 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..01d1b71f8f --- /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', 'a2x_NHXDEP','a2x_NOYDEP' + +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/outfrq9s_576tsks/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/outfrq9s_576tsks/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_amie/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_amie/user_nl_cam index 51665098f2..3ff5a2b53f 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_amie/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_amie/user_nl_cam @@ -1,8 +1,11 @@ -mfilt=1,1,1,1,1,1 -ndens=1,1,1,1,1,1 -nhtfrq=9,9,9,9,9,9 +mfilt=1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9,9,9,9 +avgflag_pertape = 'A', 'I', 'I', 'A', 'A', 'I', 'A' inithist='ENDOFRUN' ionos_epotential_amie=.true. -amienh_file = '$DIN_LOC_ROOT/atm/waccm/amie_data/oct27_31_2003_nh.nc' -amiesh_file = '$DIN_LOC_ROOT/atm/waccm/amie_data/oct27_31_2003_sh.nc' -fincl6 = 'amie_phihm','amie_efxm','amie_kevm','amie_efxg','amie_kevg','amie_efx_phys','amie_kev_phys' +amienh_files = '$DIN_LOC_ROOT/atm/waccm/amie_data/oct27_31_2003_nh.nc' +amiesh_files = '$DIN_LOC_ROOT/atm/waccm/amie_data/oct27_31_2003_sh.nc' +fincl6 = 'prescr_phihm','prescr_efxm','prescr_kevm','prescr_efxp','prescr_kevp','amie_efx_phys','amie_kev_phys' +oplus_grid = 144,96 +ionos_npes = 120 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_apmee/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_apmee/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_apmee/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_apmee/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_apmee/user_nl_cam new file mode 100644 index 0000000000..5babfe1d07 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_apmee/user_nl_cam @@ -0,0 +1,12 @@ +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' + +mee_ion_inline=.true. +mee_ion_diagonly=.true. +fincl2 = 'EPP_ionpairs', 'APMEEionprs','N2D_EPP','N4S_EPP','QRLNLTE','QCO2','QO3','QHC2S','ALIARMS_Q' +inithist='ENDOFRUN' +nlte_use_aliarms = .true. +nlte_aliarms_every_X=3 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_camchem_mam4/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_camchem_mam4/shell_commands new file mode 100644 index 0000000000..a272345cec --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_camchem_mam4/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange CAM_CONFIG_OPTS="-phys cam6 -chem trop_strat_mam4_vbs -age_of_air_trcs" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_camchem_mam4/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_camchem_mam4/user_nl_cam new file mode 100644 index 0000000000..5c50ec7f2e --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_camchem_mam4/user_nl_cam @@ -0,0 +1,4 @@ +mfilt=1,1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9,9,9,9,9 +inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wcm_ne30/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_camchem_mam4/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq9s_wcm_ne30/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/outfrq9s_camchem_mam4/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clubbmf/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clubbmf/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_clubbmf/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_contrail/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_contrail/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_contrail/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_contrail/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_contrail/user_nl_cam new file mode 100644 index 0000000000..80bb5f2bf2 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_contrail/user_nl_cam @@ -0,0 +1,8 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9 +inithist='ENDOFRUN' +aircraft_datapath ='$DIN_LOC_ROOT/atm/cam/ggas' +aircraft_specifier = + 'ac_H2O -> ac_H2O_filelist_monthly_2006.txt' + 'ac_SLANT_DIST -> ac_SLANT_DIST_filelist_monthly_2006.txt' diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_contrail/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_contrail/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_eoy/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_eoy/shell_commands new file mode 100644 index 0000000000..0ed4cccb0b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_eoy/shell_commands @@ -0,0 +1,4 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL +./xmlchange RUN_STARTDATE="1999-12-31" +./xmlchange START_TOD="82800" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_eoy/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_eoy/user_nl_cam new file mode 100644 index 0000000000..77424c653b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_eoy/user_nl_cam @@ -0,0 +1,5 @@ +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/outfrq9s_eoy/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_eoy/user_nl_clm new file mode 100644 index 0000000000..0d83b5367b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_eoy/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! 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_gpu_default/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_default/shell_commands new file mode 100644 index 0000000000..eb3720c75f --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_default/shell_commands @@ -0,0 +1,12 @@ +./xmlchange NTASKS=128 +./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 -rad rrtmg' --append +./xmlchange TIMER_DETAIL='6' +./xmlchange TIMER_LEVEL='999' +./xmlchange GPU_TYPE=a100 +./xmlchange OPENACC_GPU_OFFLOAD=TRUE +./xmlchange OVERSUBSCRIBE_GPU=TRUE +./xmlchange NGPUS_PER_NODE=4 \ No newline at end of file diff --git a/cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_default/user_nl_cam similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam rename to cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_default/user_nl_cam diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_default/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/user_nl_clm rename to cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_default/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_pcols760/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_pcols760/shell_commands new file mode 100644 index 0000000000..fa18f065fb --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_pcols760/shell_commands @@ -0,0 +1,12 @@ +./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 -rad rrtmg -pcols 760 ' --append +./xmlchange TIMER_DETAIL='6' +./xmlchange TIMER_LEVEL='999' +./xmlchange GPU_TYPE=a100 +./xmlchange OPENACC_GPU_OFFLOAD=TRUE +./xmlchange OVERSUBSCRIBE_GPU=TRUE +./xmlchange NGPUS_PER_NODE=4 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_pcols760/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_pcols760/user_nl_cam new file mode 100644 index 0000000000..8482082dce --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_pcols760/user_nl_cam @@ -0,0 +1,4 @@ +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_gpu_pcols760/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_pcols760/user_nl_clm new file mode 100644 index 0000000000..12d5a36d2b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_pcols760/user_nl_clm @@ -0,0 +1,26 @@ +!---------------------------------------------------------------------------------- +! 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_kessler/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_kessler/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_kessler/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_leapday/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_leapday/shell_commands index 4c4162a8ba..2805059fe3 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_leapday/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_leapday/shell_commands @@ -1 +1,6 @@ +driver=`./xmlquery --value COMP_INTERFACE` +if [ "$driver" = "nuopc" ]; then + ./xmlchange ROF_NCPL=\$ATM_NCPL + ./xmlchange GLC_NCPL=\$ATM_NCPL +fi ./xmlchange RUN_STARTDATE=2012-02-29 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_ltr/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_ltr/shell_commands new file mode 100644 index 0000000000..a843855d5c --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_ltr/shell_commands @@ -0,0 +1,4 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL +./xmlchange RUN_STARTDATE=2010-08-03 +./xmlchange START_TOD=43200 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_ltr/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_ltr/user_nl_cam new file mode 100644 index 0000000000..88dd573980 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_ltr/user_nl_cam @@ -0,0 +1,9 @@ +mfilt=1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9,9,9,9 +avgflag_pertape = 'A', 'I', 'I', 'A', 'A', 'I', 'A' +inithist='ENDOFRUN' +ionos_epotential_ltr=.true. +ltr_files = '$DIN_LOC_ROOT/atm/waccm/amie_data/REMIX_3-4_Aug_2010_c210302.nc' +fincl6 = 'prescr_phihm','prescr_efxm','prescr_kevm','prescr_efxp','prescr_kevp','ltr_efx_phys','ltr_kev_phys' +ionos_npes = 120 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mee_fluxes/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mee_fluxes/shell_commands new file mode 100644 index 0000000000..3b90619b1d --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mee_fluxes/shell_commands @@ -0,0 +1,4 @@ +./xmlchange RUN_STARTDATE=2015-01-01 +./xmlchange CALENDAR=GREGORIAN +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mee_fluxes/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mee_fluxes/user_nl_cam new file mode 100644 index 0000000000..0c31a14035 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mee_fluxes/user_nl_cam @@ -0,0 +1,11 @@ +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' + +mee_fluxes_filepath='$DIN_LOC_ROOT/atm/waccm/mee/RBSP-ECT_FB_precip_c211124.nc' +mee_fluxes_fillin = .true. +mee_ion_blc = 66.66 +mee_ion_inline=.true. +fincl2 = 'EPP_ionpairs', 'APMEEionprs','N2D_EPP','N4S_EPP' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/shell_commands index d611a3bc78..35e44ac120 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/shell_commands @@ -2,5 +2,5 @@ ./xmlchange GLC_NCPL=\$ATM_NCPL ./xmlchange CAM_CONFIG_OPTS=' -microphys mg3' --append if [ "`./xmlquery ATM_GRID --value`" == "C96" ]; then - ./xmlchange NTASKS=-1 + ./xmlchange NTASKS=-3 fi diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/user_nl_cam index 8482082dce..a8572b28a8 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/user_nl_cam @@ -2,3 +2,82 @@ mfilt=1,1,1,1,1,1 ndens=1,1,1,1,1,1 nhtfrq=9,9,9,9,9,9 inithist='ENDOFRUN' +clubb_history = .true. +clubb_rad_history = .false. +fincl1 = 'Q', 'RHW', 'QRS', 'QRL', 'HR', 'FDL', +'thlm', 'thvm', 'rtm', 'rcm', 'rvm', 'um', 'vm', 'um_ref','vm_ref','ug', 'vg', 'cloud_frac', 'cloud_cover', +'rcm_in_layer', 'rcm_in_cloud', 'p_in_Pa', 'exner', 'rho_ds_zt', 'thv_ds_zt', 'Lscale', 'Lscale_pert_1', +'Lscale_pert_2', 'T_in_K', 'rel_humidity', 'wp3', 'wpthlp2', 'wp2thlp', 'wprtp2', 'wp2rtp', 'Lscale_up', +'Lscale_down', 'tau_zt', 'Kh_zt', 'wp2thvp', 'wp2rcp', 'wprtpthlp', 'sigma_sqd_w_zt', 'rho', 'radht', +'radht_LW', 'radht_SW', 'Ncm', 'Nc_in_cloud', 'Nc_activated', 'snowslope', 'sed_rcm', 'rsat', 'rsati', +'diam', 'mass_ice_cryst', 'rcm_icedfs', 'u_T_cm', 'rtm_bt', 'rtm_ma', 'rtm_ta', 'rtm_mfl', 'thlm_tacl', +'thlm_cl', 'thlm_forcing', 'thlm_sdmp','thlm_mc', 'thlm_old', 'thlm_without_ta', 'thlm_mfl_min', +'thlm_mfl_max', 'thlm_enter_mfl', 'thlm_exit_mfl', 'rtm_old', 'rtm_without_ta', 'rtm_mfl_min', 'rtm_mfl_max', +'rtm_enter_mfl', 'rtm_exit_mfl', 'um_bt', 'um_ma', 'um_gf', 'um_cf', 'um_ta', 'um_f', 'um_sdmp', 'um_ndg', +'vm_bt', 'vm_ma', 'vm_gf', 'vm_cf', 'vm_ta', 'vm_f', 'vm_sdmp', 'vm_ndg', 'wp3_bt', 'wp3_ma', 'wp3_ta', +'wp3_tp', 'wp3_ac', 'wp3_bp1', 'wp3_pr_turb', 'wp3_pr_dfsn', 'wp3_pr1', 'wp3_pr2', 'wp3_dp1', 'wp3_cl', +'mixt_frac', 'w_1', 'w_2', 'varnce_w_1', 'varnce_w_2', 'thl_1', 'thl_2', 'varnce_thl_1', 'varnce_thl_2', +'rt_1', 'rt_2', 'varnce_rt_1', 'varnce_rt_2', 'rc_1', 'rc_2', 'rsatl_1', 'rsatl_2', 'cloud_frac_1', +'cloud_frac_2', 'a3_coef_zt', 'wp3_on_wp2_zt', 'chi_1', 'chi_2', 'stdev_chi_1', 'stdev_chi_2', +'stdev_eta_1', 'stdev_eta_2', 'covar_chi_eta_1', 'covar_chi_eta_2', 'corr_chi_eta_1', 'corr_chi_eta_2', +'corr_rt_thl_1', 'crt_1', 'crt_2', 'cthl_1', 'cthl_2', 'precip_frac', 'precip_frac_1', 'precip_frac_2', +'Ncnm', 'wp2_zt', 'thlp2_zt', 'wpthlp_zt', 'wprtp_zt', 'rtp2_zt', 'rtpthlp_zt', 'up2_zt', 'vp2_zt', +'upwp_zt', 'vpwp_zt', 'C11_Skw_fnc', 'wp2', 'rtp2', 'thlp2', 'rtpthlp', 'wprtp', 'wpthlp', 'wp4', 'up2', +'vp2', 'wpthvp', 'rtpthvp', 'thlpthvp', 'tau_zm', 'Kh_zm', 'wprcp', 'wm_zm', 'thlprcp', 'rtprcp', 'rcp2', +'upwp', 'vpwp', 'rho_zm', 'sigma_sqd_w', 'Skw_velocity', 'gamma_Skw_fnc', 'C6rt_Skw_fnc', 'C6thl_Skw_fnc', +'C7_Skw_fnc', 'C1_Skw_fnc', 'a3_coef', 'wp3_on_wp2', 'rcm_zm', 'rtm_zm', 'thlm_zm', 'cloud_frac_zm', +'rho_ds_zm', 'thv_ds_zm', 'em', 'mean_w_up', 'mean_w_down', 'shear', 'wp3_zm', 'Frad', 'Frad_LW', 'Frad_SW', +'Frad_LW_up', 'Frad_SW_up', 'Frad_LW_down', 'Frad_SW_down', 'Fprec', 'Fcsed', 'wp2_bt', 'wp2_ma', 'wp2_ta', +'wp2_ac', 'wp2_bp', 'wp2_pr1', 'wp2_pr2', 'wp2_pr3', 'wp2_dp1', 'wp2_dp2', 'wp2_cl', 'wp2_pd', 'wp2_sf', +'vp2_bt', 'vp2_ma', 'vp2_ta', 'vp2_tp', 'vp2_dp1', 'vp2_dp2', 'vp2_pr1', 'vp2_pr2', 'vp2_cl', 'vp2_pd', +'vp2_sf', 'up2_bt', 'up2_ma', 'up2_ta', 'up2_tp', 'up2_dp1', 'up2_dp2', 'up2_pr1', 'up2_pr2', 'up2_cl', +'up2_pd', 'up2_sf', 'wprtp_bt', 'wprtp_ma', 'wprtp_ta', 'wprtp_tp', 'wprtp_ac', 'wprtp_bp', 'wprtp_pr1', +'wprtp_pr2', 'wprtp_pr3', 'wprtp_dp1', 'wprtp_mfl', 'wprtp_cl', 'wprtp_sicl', 'wprtp_pd', 'wprtp_forcing', +'wprtp_mc', 'wpthlp_bt', 'wpthlp_ma', 'wpthlp_ta', 'wpthlp_tp', 'wpthlp_ac', 'wpthlp_bp', 'wpthlp_pr1', +'wpthlp_pr2', 'wpthlp_pr3', 'wpthlp_dp1', 'wpthlp_mfl', 'wpthlp_cl', 'wpthlp_sicl', 'wpthlp_forcing', +'wpthlp_mc', 'rtp2_bt', 'rtp2_ma', 'rtp2_ta', 'rtp2_tp', 'rtp2_dp1', 'rtp2_dp2', 'rtp2_cl', 'rtp2_pd', +'rtp2_sf', 'rtp2_forcing', 'rtp2_mc', 'thlp2_bt', 'thlp2_ma', 'thlp2_ta', 'thlp2_tp', 'thlp2_dp1', +'thlp2_dp2', 'thlp2_cl', 'thlp2_pd', 'thlp2_sf', 'thlp2_forcing', 'thlp2_mc', 'rtpthlp_bt', 'rtpthlp_ma', +'rtpthlp_ta', 'rtpthlp_tp1', 'rtpthlp_tp2', 'rtpthlp_dp1', 'rtpthlp_dp2', 'rtpthlp_cl', 'rtpthlp_sf', +'rtpthlp_forcing', 'rtpthlp_mc', 'wpthlp_enter_mfl', 'wpthlp_exit_mfl', 'wprtp_enter_mfl', 'wprtp_exit_mfl', +'wpthlp_mfl_min', 'wpthlp_mfl_max', 'wprtp_mfl_min', 'wprtp_mfl_max', 'shear_sqd' + +clubb_vars_zt ='thlm', 'thvm', 'rtm', 'rcm', 'rvm', 'um', 'vm', 'um_ref','vm_ref','ug', 'vg', 'cloud_frac', +'cloud_cover', 'rcm_in_layer', 'rcm_in_cloud', 'p_in_Pa', 'exner', 'rho_ds_zt', 'thv_ds_zt', 'Lscale', +'Lscale_pert_1', 'Lscale_pert_2', 'T_in_K', 'rel_humidity', 'wp3', 'wpthlp2', 'wp2thlp', 'wprtp2', 'wp2rtp', +'Lscale_up', 'Lscale_down', 'tau_zt', 'Kh_zt', 'wp2thvp', 'wp2rcp', 'wprtpthlp', 'sigma_sqd_w_zt', 'rho', +'radht', 'radht_LW', 'radht_SW', 'Ncm', 'Nc_in_cloud', 'Nc_activated', 'snowslope', 'sed_rcm', 'rsat', +'rsati', 'diam', 'mass_ice_cryst', 'rcm_icedfs', 'u_T_cm', 'rtm_bt', 'rtm_ma', 'rtm_ta', 'rtm_mfl', +'rtm_tacl', 'rtm_cl', 'rtm_forcing', 'rtm_sdmp','rtm_mc', 'rtm_pd', 'rvm_mc', 'rcm_mc', 'rcm_sd_mg_morr', +'thlm_bt', 'thlm_ma', 'thlm_ta', 'thlm_mfl', 'thlm_tacl', 'thlm_cl', 'thlm_forcing', 'thlm_sdmp','thlm_mc', +'thlm_old', 'thlm_without_ta', 'thlm_mfl_min', 'thlm_mfl_max', 'thlm_enter_mfl', 'thlm_exit_mfl', +'rtm_old', 'rtm_without_ta', 'rtm_mfl_min', 'rtm_mfl_max', 'rtm_enter_mfl', 'rtm_exit_mfl', 'um_bt', +'um_ma', 'um_gf', 'um_cf', 'um_ta', 'um_f', 'um_sdmp', 'um_ndg', 'vm_bt', 'vm_ma', 'vm_gf', 'vm_cf', +'vm_ta', 'vm_f', 'vm_sdmp', 'vm_ndg', 'wp3_bt', 'wp3_ma', 'wp3_ta', 'wp3_tp', 'wp3_ac', 'wp3_bp1', +'wp3_pr_turb', 'wp3_pr_dfsn', 'wp3_pr1', 'wp3_pr2', 'wp3_dp1', 'wp3_cl', 'mixt_frac', 'w_1', 'w_2', +'varnce_w_1', 'varnce_w_2', 'thl_1', 'thl_2', 'varnce_thl_1', 'varnce_thl_2', 'rt_1', +'rt_2', 'varnce_rt_1', 'varnce_rt_2', 'rc_1', 'rc_2', 'rsatl_1', 'rsatl_2', 'cloud_frac_1', 'cloud_frac_2', +'a3_coef_zt', 'wp3_on_wp2_zt', 'chi_1', 'chi_2', 'stdev_chi_1', 'stdev_chi_2', 'stdev_eta_1', 'stdev_eta_2', +'covar_chi_eta_1', 'covar_chi_eta_2', 'corr_chi_eta_1', 'corr_chi_eta_2', 'corr_rt_thl_1', 'crt_1', +'crt_2', 'cthl_1', 'cthl_2', 'precip_frac', 'precip_frac_1', 'precip_frac_2', 'Ncnm', 'wp2_zt', 'thlp2_zt', +'wpthlp_zt', 'wprtp_zt', 'rtp2_zt', 'rtpthlp_zt', 'up2_zt', 'vp2_zt', 'upwp_zt', 'vpwp_zt', 'C11_Skw_fnc' + +clubb_vars_zm= 'wp2', 'rtp2', 'thlp2', 'rtpthlp', 'wprtp', 'wpthlp', 'wp4', 'up2', 'vp2', 'wpthvp', +'rtpthvp', 'thlpthvp', 'tau_zm', 'Kh_zm', 'wprcp', 'wm_zm', 'thlprcp', 'rtprcp', 'rcp2', 'upwp', 'vpwp', +'rho_zm', 'sigma_sqd_w', 'Skw_velocity', 'gamma_Skw_fnc', 'C6rt_Skw_fnc', 'C6thl_Skw_fnc', 'C7_Skw_fnc', +'C1_Skw_fnc', 'a3_coef', 'wp3_on_wp2', 'rcm_zm', 'rtm_zm', 'thlm_zm', 'cloud_frac_zm', 'rho_ds_zm', +'thv_ds_zm', 'em', 'mean_w_up', 'mean_w_down', 'shear', 'wp3_zm', 'Frad', 'Frad_LW', 'Frad_SW', +'Frad_LW_up', 'Frad_SW_up', 'Frad_LW_down', 'Frad_SW_down', 'Fprec', 'Fcsed', 'wp2_bt', 'wp2_ma', 'wp2_ta', +'wp2_ac', 'wp2_bp', 'wp2_pr1', 'wp2_pr2', 'wp2_pr3', 'wp2_dp1', 'wp2_dp2', 'wp2_cl', 'wp2_pd', 'wp2_sf', +'vp2_bt', 'vp2_ma', 'vp2_ta', 'vp2_tp', 'vp2_dp1', 'vp2_dp2', 'vp2_pr1', 'vp2_pr2', 'vp2_cl', 'vp2_pd', 'vp2_sf', 'up2_bt', 'up2_ma', 'up2_ta', 'up2_tp', 'up2_dp1', 'up2_dp2', 'up2_pr1', 'up2_pr2', 'up2_cl', 'up2_pd', +'up2_sf', 'wprtp_bt', 'wprtp_ma', 'wprtp_ta', 'wprtp_tp', 'wprtp_ac', 'wprtp_bp', 'wprtp_pr1', 'wprtp_pr2', +'wprtp_pr3', 'wprtp_dp1', 'wprtp_mfl', 'wprtp_cl', 'wprtp_sicl', 'wprtp_pd', 'wprtp_forcing', 'wprtp_mc', +'wpthlp_bt', 'wpthlp_ma', 'wpthlp_ta', 'wpthlp_tp', 'wpthlp_ac', 'wpthlp_bp', 'wpthlp_pr1', 'wpthlp_pr2', +'wpthlp_pr3', 'wpthlp_dp1', 'wpthlp_mfl', 'wpthlp_cl', 'wpthlp_sicl', 'wpthlp_forcing', 'wpthlp_mc', +'rtp2_bt', 'rtp2_ma', 'rtp2_ta', 'rtp2_tp', 'rtp2_dp1', 'rtp2_dp2', 'rtp2_cl', 'rtp2_pd', 'rtp2_sf', +'rtp2_forcing', 'rtp2_mc', 'thlp2_bt', 'thlp2_ma', 'thlp2_ta', 'thlp2_tp', 'thlp2_dp1', 'thlp2_dp2', +'thlp2_cl', 'thlp2_pd', 'thlp2_sf', 'thlp2_forcing', 'thlp2_mc', 'rtpthlp_bt', 'rtpthlp_ma', 'rtpthlp_ta', +'rtpthlp_tp1', 'rtpthlp_tp2', 'rtpthlp_dp1', 'rtpthlp_dp2', 'rtpthlp_cl', 'rtpthlp_sf', 'rtpthlp_forcing', +'rtpthlp_mc', 'wpthlp_enter_mfl', 'wpthlp_exit_mfl', 'wprtp_enter_mfl', 'wprtp_exit_mfl', 'wpthlp_mfl_min', +'wpthlp_mfl_max', 'wprtp_mfl_min', 'wprtp_mfl_max', 'shear_sqd' + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/shell_commands new file mode 100644 index 0000000000..af4c5c8878 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/shell_commands @@ -0,0 +1,8 @@ +./xmlchange NTASKS=128 +./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 -rad rrtmg' --append +./xmlchange TIMER_DETAIL='6' +./xmlchange TIMER_LEVEL='999' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/user_nl_cam new file mode 100644 index 0000000000..8482082dce --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/user_nl_cam @@ -0,0 +1,4 @@ +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_default/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/user_nl_clm new file mode 100644 index 0000000000..12d5a36d2b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/user_nl_clm @@ -0,0 +1,26 @@ +!---------------------------------------------------------------------------------- +! 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_pcols760/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/shell_commands new file mode 100644 index 0000000000..f9424e5025 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/shell_commands @@ -0,0 +1,8 @@ +./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 760 ' --append +./xmlchange TIMER_DETAIL='6' +./xmlchange TIMER_LEVEL='999' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/user_nl_cam new file mode 100644 index 0000000000..8482082dce --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/user_nl_cam @@ -0,0 +1,4 @@ +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_pcols760/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/user_nl_clm new file mode 100644 index 0000000000..12d5a36d2b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760/user_nl_clm @@ -0,0 +1,26 @@ +!---------------------------------------------------------------------------------- +! 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_mpasa120/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa120/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa120/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa120/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa120/user_nl_cam new file mode 100644 index 0000000000..8482082dce --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa120/user_nl_cam @@ -0,0 +1,4 @@ +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_mpasa120/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa120/user_nl_clm new file mode 100644 index 0000000000..c4cb9d28d6 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa120/user_nl_clm @@ -0,0 +1,3 @@ +hist_nhtfrq = 9 +hist_mfilt = 1 +hist_ndens = 1 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/user_nl_cam new file mode 100644 index 0000000000..ccffd8c129 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/user_nl_cam @@ -0,0 +1,6 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9 +inithist='ENDOFRUN' +mpas_cam_coef=1.0D0 +mpas_cam_damping_levels=3 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/user_nl_clm new file mode 100644 index 0000000000..c4cb9d28d6 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/user_nl_clm @@ -0,0 +1,3 @@ +hist_nhtfrq = 9 +hist_mfilt = 1 +hist_ndens = 1 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480_pertlim/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480_pertlim/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480_pertlim/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480_pertlim/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480_pertlim/user_nl_cam new file mode 100644 index 0000000000..3edf536070 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480_pertlim/user_nl_cam @@ -0,0 +1,7 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9 +inithist='ENDOFRUN' +mpas_cam_coef=1.0D0 +mpas_cam_damping_levels=3 +pertlim = 1.e-14 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480_pertlim/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480_pertlim/user_nl_clm new file mode 100644 index 0000000000..c4cb9d28d6 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480_pertlim/user_nl_clm @@ -0,0 +1,3 @@ +hist_nhtfrq = 9 +hist_mfilt = 1 +hist_ndens = 1 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_nochem/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_nochem/shell_commands new file mode 100644 index 0000000000..ce8baae676 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_nochem/shell_commands @@ -0,0 +1,3 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL +./xmlchange --append CAM_CONFIG_OPTS="-chem none" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_nochem/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_nochem/user_nl_cam new file mode 100644 index 0000000000..71d4b658f1 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_nochem/user_nl_cam @@ -0,0 +1,5 @@ +prescribed_strataero_feedback=.true. +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_nochem/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_nochem/user_nl_clm new file mode 100644 index 0000000000..0d83b5367b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_nochem/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! 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_ocnemis/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_ocnemis/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_ocnemis/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_physgrid_tem_1deg/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_physgrid_tem_1deg/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_physgrid_tem_1deg/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_physgrid_tem_1deg/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_physgrid_tem_1deg/user_nl_cam new file mode 100644 index 0000000000..a82b687449 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_physgrid_tem_1deg/user_nl_cam @@ -0,0 +1,8 @@ +mfilt=1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9,9,9,9 +inithist='ENDOFRUN' +phys_grid_ctem_nfreq=-2 +phys_grid_ctem_zm_nbas=120 +phys_grid_ctem_za_nlat=90 +fincl3 = 'Uzm','Vzm','Wzm','THzm', 'VTHzm','WTHzm','UVzm','UWzm' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_physgrid_tem_1deg/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_physgrid_tem_1deg/user_nl_clm new file mode 100644 index 0000000000..0d83b5367b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_physgrid_tem_1deg/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! 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_pumas_emulated/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_emulated/shell_commands new file mode 100644 index 0000000000..d10bce4cdc --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_emulated/shell_commands @@ -0,0 +1,3 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL +./xmlchange CAM_CONFIG_OPTS=' -microphys pumas' --append diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_emulated/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_emulated/user_nl_cam new file mode 100644 index 0000000000..172af9ba82 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_emulated/user_nl_cam @@ -0,0 +1,5 @@ +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_warm_rain='emulated' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_emulated/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_emulated/user_nl_clm new file mode 100644 index 0000000000..12d5a36d2b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_emulated/user_nl_clm @@ -0,0 +1,26 @@ +!---------------------------------------------------------------------------------- +! 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_pumas_rainbows/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/shell_commands new file mode 100644 index 0000000000..d10bce4cdc --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/shell_commands @@ -0,0 +1,3 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL +./xmlchange CAM_CONFIG_OPTS=' -microphys pumas' --append diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/user_nl_cam new file mode 100644 index 0000000000..936d79412d --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/user_nl_cam @@ -0,0 +1,5 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9 +inithist='ENDOFRUN' +fincl1 = 'RBFRAC','RBFREQ','rbSZA' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/user_nl_clm new file mode 100644 index 0000000000..12d5a36d2b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_rainbows/user_nl_clm @@ -0,0 +1,26 @@ +!---------------------------------------------------------------------------------- +! 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_pumas_sb2001/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_sb2001/shell_commands new file mode 100644 index 0000000000..d10bce4cdc --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_sb2001/shell_commands @@ -0,0 +1,3 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL +./xmlchange CAM_CONFIG_OPTS=' -microphys pumas' --append diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_sb2001/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_sb2001/user_nl_cam new file mode 100644 index 0000000000..5caf9ff70d --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_sb2001/user_nl_cam @@ -0,0 +1,5 @@ +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_warm_rain='sb2001' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_sb2001/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_sb2001/user_nl_clm new file mode 100644 index 0000000000..12d5a36d2b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_sb2001/user_nl_clm @@ -0,0 +1,26 @@ +!---------------------------------------------------------------------------------- +! 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_pumas_tau/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_tau/shell_commands new file mode 100644 index 0000000000..d10bce4cdc --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_tau/shell_commands @@ -0,0 +1,3 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL +./xmlchange CAM_CONFIG_OPTS=' -microphys pumas' --append diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_tau/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_tau/user_nl_cam new file mode 100644 index 0000000000..28d485b6bd --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_tau/user_nl_cam @@ -0,0 +1,5 @@ +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_warm_rain='tau' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_tau/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_tau/user_nl_clm new file mode 100644 index 0000000000..12d5a36d2b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_tau/user_nl_clm @@ -0,0 +1,26 @@ +!---------------------------------------------------------------------------------- +! 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_refined_camchem/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/shell_commands deleted file mode 100644 index b95b333a93..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/shell_commands +++ /dev/null @@ -1 +0,0 @@ -./xmlchange NTASKS=-50 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/user_nl_cam deleted file mode 100644 index 19452cff21..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/user_nl_cam +++ /dev/null @@ -1,4 +0,0 @@ - mfilt=1,1,1,1,1,1,1,1,1 - ndens=1,1,1,1,1,1,1,1,1 - nhtfrq=9,9,9,9,9,9,9,9,9 - inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/shell_commands new file mode 100644 index 0000000000..106897a2c6 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/shell_commands @@ -0,0 +1,3 @@ +./xmlchange --append CAM_CONFIG_OPTS="-rad rrtmgp" +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_cam new file mode 100644 index 0000000000..8482082dce --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_cam @@ -0,0 +1,4 @@ +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_rrtmgp/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_clm new file mode 100644 index 0000000000..0d83b5367b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! 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_waccm_ma_mam4/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_ma_mam4/shell_commands new file mode 100644 index 0000000000..85587b0964 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_ma_mam4/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange CAM_CONFIG_OPTS="-phys cam6 -age_of_air_trcs -chem waccm_ma_mam4" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_ma_mam4/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_ma_mam4/user_nl_cam new file mode 100644 index 0000000000..5c50ec7f2e --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_ma_mam4/user_nl_cam @@ -0,0 +1,4 @@ +mfilt=1,1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9,9,9,9,9 +inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_ma_mam4/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_ma_mam4/user_nl_clm new file mode 100644 index 0000000000..0d83b5367b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_ma_mam4/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! 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_waccm_mam4/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_mam4/shell_commands new file mode 100644 index 0000000000..67e20e47c6 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_mam4/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange CAM_CONFIG_OPTS="-phys cam6 -age_of_air_trcs -chem waccm_tsmlt_mam4" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_mam4/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_mam4/user_nl_cam new file mode 100644 index 0000000000..5c50ec7f2e --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_mam4/user_nl_cam @@ -0,0 +1,4 @@ +mfilt=1,1,1,1,1,1,1,1,1,1 +ndens=1,1,1,1,1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9,9,9,9,9 +inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_mam4/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_mam4/user_nl_clm new file mode 100644 index 0000000000..0d83b5367b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_mam4/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! 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_wcm_ne30/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wcm_ne30/user_nl_cam deleted file mode 100644 index 61dcade99c..0000000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_wcm_ne30/user_nl_cam +++ /dev/null @@ -1,12 +0,0 @@ -mfilt=1,1,1,1,1,1,1,1,1 -ndens=1,1,1,1,1,1,1,1,1 -nhtfrq=9,9,9,9,9,9,9,9,9 -inithist='ENDOFRUN' - -se_nsplit = 30 -se_rayk0= 10 -se_raykrange= 5 -se_raytau0=0.002 - -state_debug_checks = .true. - diff --git a/cime_config/testdefs/testmods_dirs/cam/rad_diag/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/rad_diag/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/rad_diag/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/rad_diag_mam/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/rad_diag_mam/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/rad_diag_mam/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/reduced_hist1d/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/reduced_hist1d/user_nl_cam index eeb2417bec..e1205823ee 100644 --- a/cime_config/testdefs/testmods_dirs/cam/reduced_hist1d/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/reduced_hist1d/user_nl_cam @@ -2,6 +2,7 @@ mfilt=1,1,1,1,1,1 ndens=1,1,1,1,1,1 nhtfrq=-24,-24,-24,-24,-24,-24 + write_nstep0=.true. fincl1 = ' ' fincl2 = ' ' diff --git a/cime_config/testdefs/testmods_dirs/cam/reduced_hist3s/shell_commands b/cime_config/testdefs/testmods_dirs/cam/reduced_hist3s/shell_commands new file mode 100644 index 0000000000..150680ec6f --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/reduced_hist3s/shell_commands @@ -0,0 +1,5 @@ +driver=`./xmlquery --value COMP_INTERFACE` +if [ "$driver" = "nuopc" ]; then + ./xmlchange ROF_NCPL=\$ATM_NCPL + ./xmlchange GLC_NCPL=\$ATM_NCPL +fi diff --git a/cime_config/testdefs/testmods_dirs/cam/reduced_hist5d/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/reduced_hist5d/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/reduced_hist5d/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. 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/scm_prep/shell_commands b/cime_config/testdefs/testmods_dirs/cam/scm_prep/shell_commands index 4ed9da64bf..a8888c7e66 100644 --- a/cime_config/testdefs/testmods_dirs/cam/scm_prep/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/scm_prep/shell_commands @@ -1,5 +1,5 @@ ./xmlchange -append CAM_CONFIG_OPTS="-camiop -debug" ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange RUN_STARTDATE="0000-09-01" +./xmlchange RUN_STARTDATE="0001-09-01" ./xmlchange CAM_NML_USE_CASE=UNSET diff --git a/cime_config/testdefs/testmods_dirs/cam/scm_prep/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/scm_prep/user_nl_cam index da53953a7b..24fa6cf2e5 100644 --- a/cime_config/testdefs/testmods_dirs/cam/scm_prep/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/scm_prep/user_nl_cam @@ -2,3 +2,4 @@ NDENS = 1,1 MFILT = 1,10 nhtfrq = 0,1 inithist_all = .true. +write_nstep0 = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/scm_prep/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/scm_prep/user_nl_cpl index 7dfd9c227a..3d0b5a3ee9 100644 --- a/cime_config/testdefs/testmods_dirs/cam/scm_prep/user_nl_cpl +++ b/cime_config/testdefs/testmods_dirs/cam/scm_prep/user_nl_cpl @@ -4,3 +4,5 @@ orb_eccen = 1.e36 orb_obliq = 1.e36 orb_mvelp = 1.e36 orb_mode = "fixed_year" +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/shell_commands b/cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/shell_commands index bc229bc6bf..023126bc8a 100644 --- a/cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/shell_commands @@ -1,5 +1,5 @@ ./xmlchange -append CAM_CONFIG_OPTS="-camiop -debug -noclubb_sgs" ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange RUN_STARTDATE="0000-09-01" +./xmlchange RUN_STARTDATE="0001-09-01" ./xmlchange CAM_NML_USE_CASE=UNSET diff --git a/cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/user_nl_cam index da53953a7b..24fa6cf2e5 100644 --- a/cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/user_nl_cam @@ -2,3 +2,4 @@ NDENS = 1,1 MFILT = 1,10 nhtfrq = 0,1 inithist_all = .true. +write_nstep0 = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/user_nl_cpl index 7dfd9c227a..3d0b5a3ee9 100644 --- a/cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/user_nl_cpl +++ b/cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/user_nl_cpl @@ -4,3 +4,5 @@ orb_eccen = 1.e36 orb_obliq = 1.e36 orb_mvelp = 1.e36 orb_mode = "fixed_year" +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 31a36fb678..3901f7a7b0 100644 --- a/cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands @@ -1,9 +1,7 @@ -./xmlchange -append CAM_CONFIG_OPTS="-scam" ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL ./xmlchange EPS_AAREA=9.0e-4 ./xmlchange EPS_AGRID=9.0e-5 -./xmlchange MPILIB=mpi-serial ./xmlchange REST_OPTION=never ./xmlchange CAM_NML_USE_CASE=UNSET ./xmlchange PTS_LAT=36.6 diff --git a/cime_config/testdefs/testmods_dirs/cam/scmarm/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/scmarm/user_nl_cam index 6dd50018a8..aea4e2f56c 100644 --- a/cime_config/testdefs/testmods_dirs/cam/scmarm/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/scmarm/user_nl_cam @@ -1,3 +1,4 @@ mfilt=1500 nhtfrq = 1 history_budget=.true. +write_nstep0 = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/scmarm/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/scmarm/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/scmarm/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/silhs/shell_commands b/cime_config/testdefs/testmods_dirs/cam/silhs/shell_commands index b8d309158f..fea94fabf2 100644 --- a/cime_config/testdefs/testmods_dirs/cam/silhs/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/silhs/shell_commands @@ -1,4 +1,9 @@ +driver=`./xmlquery --value COMP_INTERFACE` +if [ "$driver" = "nuopc" ]; then + ./xmlchange ROF_NCPL=\$ATM_NCPL + ./xmlchange GLC_NCPL=\$ATM_NCPL +fi ./xmlchange -append CAM_CONFIG_OPTS=" -silhs -psubcols 4" -./xmlchange RUN_STARTDATE="0000-01-01" +./xmlchange RUN_STARTDATE="0001-01-01" ./xmlchange STOP_OPTION=nsteps ./xmlchange STOP_N=9 diff --git a/cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam index 2c1d851a57..13ceac46c1 100644 --- a/cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam @@ -1,5 +1,6 @@ dtime = 1800 nhtfrq = 0,-24,-6,-3 +write_nstep0 = .true. mfilt = 1,5000,5000 ndens = 2,2,2,2,2,2 history_budget = .true. @@ -18,8 +19,7 @@ fincl1 = 'U:A','PS:A','T:A','V:A','OMEGA:A','Z3:A','PRECT:A', 'QIRESO:A','QCRESO:A','PRACSO:A','MPDT:A','MPDQ:A','MPDLIQ:A', 'MPDICE:A','INEGCLPTEND', 'LNEGCLPTEND', 'VNEGCLPTEND', 'QCRAT:A', -'SL', 'Q', 'RHW', 'QRS', 'QRL', 'HR', 'FDL', 'SILHS_CLUBB_PRECIP_FRAC', -'SILHS_CLUBB_ICE_SS_FRAC', +'Q', 'RHW', 'QRS', 'QRL', 'HR', 'FDL', 'SILHS_CLUBB_PRECIP_FRAC', 'SILHS_CLUBB_ICE_SS_FRAC', 'thlm', 'thvm', 'rtm', 'rcm', 'rvm', 'um', 'vm', 'um_ref','vm_ref','ug', 'vg', 'cloud_frac', 'cloud_cover', 'rcm_in_layer', 'rcm_in_cloud', 'p_in_Pa', 'exner', 'rho_ds_zt', 'thv_ds_zt', 'Lscale', 'Lscale_pert_1', 'Lscale_pert_2', 'T_in_K', 'rel_humidity', 'wp3', 'wpthlp2', 'wp2thlp', 'wprtp2', 'wp2rtp', 'Lscale_up', 'Lscale_down', 'tau_zt', 'Kh_zt', 'wp2thvp', 'wp2rcp', 'wprtpthlp', 'sigma_sqd_w_zt', 'rho', 'radht', 'radht_LW', 'radht_SW', 'Ncm', 'Nc_in_cloud', @@ -27,7 +27,8 @@ fincl1 = 'U:A','PS:A','T:A','V:A','OMEGA:A','Z3:A','PRECT:A', 'rtm_tacl', 'rtm_cl', 'rtm_forcing', 'rtm_sdmp','rtm_mc', 'rtm_pd', 'rvm_mc', 'rcm_mc', 'rcm_sd_mg_morr', 'thlm_bt', 'thlm_ma', 'thlm_ta', 'thlm_mfl', 'thlm_tacl', 'thlm_cl', 'thlm_forcing', 'thlm_sdmp','thlm_mc', 'thlm_old', 'thlm_without_ta', 'thlm_mfl_min', 'thlm_mfl_max', 'thlm_enter_mfl', 'thlm_exit_mfl', 'rtm_old', 'rtm_without_ta', 'rtm_mfl_min', 'rtm_mfl_max', 'rtm_enter_mfl', 'rtm_exit_mfl', 'um_bt', 'um_ma', 'um_gf', 'um_cf', 'um_ta', 'um_f', 'um_sdmp', -'um_ndg', 'vm_bt', 'vm_ma', 'vm_gf', 'vm_cf', 'vm_ta', 'vm_f', 'vm_sdmp', 'vm_ndg', 'wp3_bt', 'wp3_ma', 'wp3_ta', 'wp3_tp', 'wp3_ac', 'wp3_bp1', 'wp3_bp2', +'um_ndg', 'vm_bt', 'vm_ma', 'vm_gf', 'vm_cf', 'vm_ta', 'vm_f', 'vm_sdmp', 'vm_ndg', 'wp3_bt', 'wp3_ma', 'wp3_ta', 'wp3_tp', 'wp3_ac', 'wp3_bp1', 'wp3_pr_turb', +'wp3_pr_dfsn', 'wp3_pr1', 'wp3_pr2', 'wp3_dp1', 'wp3_cl', 'mixt_frac', 'w_1', 'w_2', 'varnce_w_1', 'varnce_w_2', 'thl_1', 'thl_2', 'varnce_thl_1', 'varnce_thl_2', 'rt_1', 'rt_2', 'varnce_rt_1', 'varnce_rt_2', 'rc_1', 'rc_2', 'rsatl_1', 'rsatl_2', 'cloud_frac_1', 'cloud_frac_2', 'a3_coef_zt', 'wp3_on_wp2_zt', 'chi_1', 'chi_2', 'stdev_chi_1', 'stdev_chi_2', 'stdev_eta_1', 'stdev_eta_2', 'covar_chi_eta_1', 'covar_chi_eta_2', 'corr_chi_eta_1', 'corr_chi_eta_2', 'corr_rt_thl_1', 'crt_1', @@ -44,8 +45,8 @@ fincl1 = 'U:A','PS:A','T:A','V:A','OMEGA:A','Z3:A','PRECT:A', 'wpthlp_pr3', 'wpthlp_dp1', 'wpthlp_mfl', 'wpthlp_cl', 'wpthlp_sicl', 'wpthlp_forcing', 'wpthlp_mc', 'rtp2_bt', 'rtp2_ma', 'rtp2_ta', 'rtp2_tp', 'rtp2_dp1', 'rtp2_dp2', 'rtp2_cl', 'rtp2_pd', 'rtp2_sf', 'rtp2_forcing', 'rtp2_mc', 'thlp2_bt', 'thlp2_ma', 'thlp2_ta', 'thlp2_tp', 'thlp2_dp1', 'thlp2_dp2', 'thlp2_cl', 'thlp2_pd', 'thlp2_sf', 'thlp2_forcing', 'thlp2_mc', 'rtpthlp_bt', 'rtpthlp_ma', 'rtpthlp_ta', 'rtpthlp_tp1', 'rtpthlp_tp2', 'rtpthlp_dp1', 'rtpthlp_dp2', -'rtpthlp_cl', 'rtpthlp_sf', 'rtpthlp_forcing', 'rtpthlp_mc', 'wpthlp_entermfl', 'wpthlp_exit_mfl', 'wprtp_enter_mfl', 'wprtp_exit_mfl', 'wpthlp_mfl_min', -'wpthlp_mfl_max', 'wprtp_mfl_min', 'wprtp_mfl_max', 'Richardson_num', 'shear_sqd', +'rtpthlp_cl', 'rtpthlp_sf', 'rtpthlp_forcing', 'rtpthlp_mc', 'wpthlp_enter_mfl', 'wpthlp_exit_mfl', 'wprtp_enter_mfl', 'wprtp_exit_mfl', 'wpthlp_mfl_min', +'wpthlp_mfl_max', 'wprtp_mfl_min', 'wprtp_mfl_max', 'shear_sqd' fincl2 = 'CLDTOT', 'CLDST','CDNUMC','CLDLIQ','CLDICE','FLUT', 'LWCF','SWCF','PRECT' clubb_history = .true. @@ -57,7 +58,8 @@ clubb_vars_zt ='thlm', 'thvm', 'rtm', 'rcm', 'rvm', 'um', 'vm', 'um_ref','vm_ref 'rtm_tacl', 'rtm_cl', 'rtm_forcing', 'rtm_sdmp','rtm_mc', 'rtm_pd', 'rvm_mc', 'rcm_mc', 'rcm_sd_mg_morr', 'thlm_bt', 'thlm_ma', 'thlm_ta', 'thlm_mfl', 'thlm_tacl', 'thlm_cl', 'thlm_forcing', 'thlm_sdmp','thlm_mc', 'thlm_old', 'thlm_without_ta', 'thlm_mfl_min', 'thlm_mfl_max', 'thlm_enter_mfl', 'thlm_exit_mfl', 'rtm_old', 'rtm_without_ta', 'rtm_mfl_min', 'rtm_mfl_max', 'rtm_enter_mfl', 'rtm_exit_mfl', 'um_bt', 'um_ma', 'um_gf', 'um_cf', 'um_ta', 'um_f', 'um_sdmp', -'um_ndg', 'vm_bt', 'vm_ma', 'vm_gf', 'vm_cf', 'vm_ta', 'vm_f', 'vm_sdmp', 'vm_ndg', 'wp3_bt', 'wp3_ma', 'wp3_ta', 'wp3_tp', 'wp3_ac', 'wp3_bp1', 'wp3_bp2', +'um_ndg', 'vm_bt', 'vm_ma', 'vm_gf', 'vm_cf', 'vm_ta', 'vm_f', 'vm_sdmp', 'vm_ndg', 'wp3_bt', 'wp3_ma', 'wp3_ta', 'wp3_tp', 'wp3_ac', 'wp3_bp1', 'wp3_pr_turb', +'wp3_pr_dfsn', 'wp3_pr1', 'wp3_pr2', 'wp3_dp1', 'wp3_cl', 'mixt_frac', 'w_1', 'w_2', 'varnce_w_1', 'varnce_w_2', 'thl_1', 'thl_2', 'varnce_thl_1', 'varnce_thl_2', 'rt_1', 'rt_2', 'varnce_rt_1', 'varnce_rt_2', 'rc_1', 'rc_2', 'rsatl_1', 'rsatl_2', 'cloud_frac_1', 'cloud_frac_2', 'a3_coef_zt', 'wp3_on_wp2_zt', 'chi_1', 'chi_2', 'stdev_chi_1', 'stdev_chi_2', 'stdev_eta_1', 'stdev_eta_2', 'covar_chi_eta_1', 'covar_chi_eta_2', 'corr_chi_eta_1', 'corr_chi_eta_2', 'corr_rt_thl_1', 'crt_1', @@ -74,5 +76,5 @@ clubb_vars_zm= 'wp2', 'rtp2', 'thlp2', 'rtpthlp', 'wprtp', 'wpthlp', 'wp4', 'up2 'wpthlp_pr3', 'wpthlp_dp1', 'wpthlp_mfl', 'wpthlp_cl', 'wpthlp_sicl', 'wpthlp_forcing', 'wpthlp_mc', 'rtp2_bt', 'rtp2_ma', 'rtp2_ta', 'rtp2_tp', 'rtp2_dp1', 'rtp2_dp2', 'rtp2_cl', 'rtp2_pd', 'rtp2_sf', 'rtp2_forcing', 'rtp2_mc', 'thlp2_bt', 'thlp2_ma', 'thlp2_ta', 'thlp2_tp', 'thlp2_dp1', 'thlp2_dp2', 'thlp2_cl', 'thlp2_pd', 'thlp2_sf', 'thlp2_forcing', 'thlp2_mc', 'rtpthlp_bt', 'rtpthlp_ma', 'rtpthlp_ta', 'rtpthlp_tp1', 'rtpthlp_tp2', 'rtpthlp_dp1', 'rtpthlp_dp2', -'rtpthlp_cl', 'rtpthlp_sf', 'rtpthlp_forcing', 'rtpthlp_mc', 'wpthlp_entermfl', 'wpthlp_exit_mfl', 'wprtp_enter_mfl', 'wprtp_exit_mfl', 'wpthlp_mfl_min', -'wpthlp_mfl_max', 'wprtp_mfl_min', 'wprtp_mfl_max', 'Richardson_num', 'shear_sqd' +'rtpthlp_cl', 'rtpthlp_sf', 'rtpthlp_forcing', 'rtpthlp_mc', 'wpthlp_enter_mfl', 'wpthlp_exit_mfl', 'wprtp_enter_mfl', 'wprtp_exit_mfl', 'wpthlp_mfl_min', +'wpthlp_mfl_max', 'wprtp_mfl_min', 'wprtp_mfl_max', 'shear_sqd' diff --git a/cime_config/testdefs/testmods_dirs/cam/terminator/shell_commands b/cime_config/testdefs/testmods_dirs/cam/terminator/shell_commands index 0b95361785..bcb27a630b 100644 --- a/cime_config/testdefs/testmods_dirs/cam/terminator/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/terminator/shell_commands @@ -2,4 +2,4 @@ ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL ./xmlchange CAM_NML_USE_CASE=UNSET -./xmlchange RUN_STARTDATE="00000101" +./xmlchange RUN_STARTDATE="00010101" diff --git a/cime_config/testdefs/testmods_dirs/cam/terminator/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/terminator/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/terminator/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal0/shell_commands b/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal0/shell_commands index 2ce35683c9..e09be8b977 100644 --- a/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal0/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal0/shell_commands @@ -1,6 +1,6 @@ ./xmlchange CAM_CONFIG_OPTS="-nadv_tt 5 -cppdefs -DTRACER_CHECK" --append ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange RUN_STARTDATE="0000-12-31" +./xmlchange RUN_STARTDATE="0001-12-31" ./xmlchange START_TOD="82800" ./xmlchange CAM_NML_USE_CASE=UNSET diff --git a/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal0/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal0/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal0/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal1/shell_commands b/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal1/shell_commands index 2ce35683c9..e09be8b977 100644 --- a/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal1/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal1/shell_commands @@ -1,6 +1,6 @@ ./xmlchange CAM_CONFIG_OPTS="-nadv_tt 5 -cppdefs -DTRACER_CHECK" --append ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange RUN_STARTDATE="0000-12-31" +./xmlchange RUN_STARTDATE="0001-12-31" ./xmlchange START_TOD="82800" ./xmlchange CAM_NML_USE_CASE=UNSET diff --git a/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal1/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal1/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal1/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal3/shell_commands b/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal3/shell_commands index 2ce35683c9..e09be8b977 100644 --- a/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal3/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal3/shell_commands @@ -1,6 +1,6 @@ ./xmlchange CAM_CONFIG_OPTS="-nadv_tt 5 -cppdefs -DTRACER_CHECK" --append ./xmlchange ROF_NCPL=\$ATM_NCPL ./xmlchange GLC_NCPL=\$ATM_NCPL -./xmlchange RUN_STARTDATE="0000-12-31" +./xmlchange RUN_STARTDATE="0001-12-31" ./xmlchange START_TOD="82800" ./xmlchange CAM_NML_USE_CASE=UNSET diff --git a/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal3/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal3/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal3/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/volc/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/volc/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/volc/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/shell_commands b/cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/shell_commands index 5b34abfc3e..6515f6694b 100644 --- a/cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/shell_commands @@ -1 +1,2 @@ ./xmlchange RUN_STARTDATE=2005-12-31 +./xmlchange ROF_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/user_nl_cam index d64f9de803..f71e8a9623 100644 --- a/cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/user_nl_cam @@ -4,4 +4,5 @@ nhtfrq = -24,-24,-24,-24,-24,-24,-24,-24,-24 fincl7='UI','VI','WI','PHIM2D','POTEN','QIONSUM','ELECDEN','QJOULE', 'UT_LUNAR','VT_LUNAR' + fincl8='op_dt','amb_diff','dfield','dwind' apply_lunar_tides=.true. diff --git a/cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/user_nl_cpl b/cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/user_nl_cpl new file mode 100644 index 0000000000..398535cf65 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/user_nl_cpl @@ -0,0 +1,2 @@ +reprosum_diffmax=1.0e-14 +reprosum_recompute=.true. diff --git a/cime_config/usermods_dirs/CMIP6_B1850/user_nl_cam b/cime_config/usermods_dirs/CMIP6_B1850/user_nl_cam index 086f1e33e5..7958c8cd03 100644 --- a/cime_config/usermods_dirs/CMIP6_B1850/user_nl_cam +++ b/cime_config/usermods_dirs/CMIP6_B1850/user_nl_cam @@ -1,64 +1,62 @@ -nhtfrq = 0, -24, -6, -3, -1, 1, -24,-120,-240 +nhtfrq = 0, -24, -6, -3, -1, 1, -24,-120,-240 -mfilt = 1, 5, 20, 40, 120, 240, 365, 73, 365 +mfilt = 1, 5, 20, 40, 120, 240, 365, 73, 365 ndens = 2, 2, 2, 2, 2, 2, 1, 1, 1 -fincl1 = 'ABSORB:A', 'ACTREL:A', 'AODABSdn:A', 'AODBCdn:A', 'AODdnDUST1:A', 'AODdnDUST2:A', - 'AODdnDUST3:A', 'AODdnMODE1:A', 'AODdnMODE2:A', 'AODdnMODE3:A', 'AODDUST2:A', 'AODDUST:A', 'AODNIRstdn:A', 'AODPOMdn:A', 'AODSO4dn:A', 'AODSOAdn:A', 'AODSSdn:A', - 'AODUVdn:A', 'AODUVstdn:A', 'AODVIS:A', 'AODVISdn:A', 'AODVISstdn:A', 'AQ_SO2:A', 'AREA:A', 'AREI:A', 'AREL:A', 'bc_a1:A', 'bc_a1DDF:A', - 'bc_a1SFWET:A', 'bc_a4:A', 'bc_a4DDF:A', 'bc_a4SFWET:A', 'bc_c1:A', 'bc_c1DDF:A', 'bc_c1SFWET:A', 'bc_c4:A', 'bc_c4DDF:A', - 'bc_c4SFWET:A', 'BROX:A', 'BROY:A', 'BURDENBCdn', 'BURDENDUSTdn:A', 'BURDENPOMdn:A', 'BURDENSEASALTdn:A', 'BURDENSO4dn:A', - 'BURDENSOAdn:A', 'CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CLOX:A', 'CLOY:A', 'CME:A', 'CMFDQ:A', 'CMFMC:A', - 'CMFMCDZM:A', 'CO2:A', 'CONCLD:A', 'DF_H2O2:A', 'DF_H2SO4:A', - 'DF_SO2:A', 'dgnumwet1:A', 'dgnumwet2:A', 'dgnumwet3:A', 'DH2O2CHM:A', 'DMS:A', 'dry_deposition_NHx_as_N:A', - 'dry_deposition_NOy_as_N:A', 'Dso4_a1CHM:A', 'Dso4_a2CHM:A', 'Dso4_a3CHM:A', 'dst_a1:A', 'dst_a1DDF:A', 'dst_a1SFWET:A', 'dst_a2:A', 'dst_a2DDF:A', - 'dst_a2SFWET:A', 'dst_a3:A', 'dst_a3DDF:A', 'dst_a3SFWET:A', 'dst_c1:A', 'dst_c1DDF:A', 'dst_c1SFWET:A', 'dst_c2:A', 'dst_c2DDF:A', 'dst_c2SFWET:A', - 'dst_c3:A', 'dst_c3DDF:A', 'dst_c3SFWET:A', 'DTCORE:A', 'EVAPPREC:A', - 'EVAPQZM:A', 'EVAPTZM:A', 'EXTINCTdn:A', 'EXTINCTNIRdn:A', 'EXTINCTUVdn:A', 'EXTxASYMdn:A', 'FCTL:A', - 'FLDS:A', 'FLDSC:A', 'FLNR:A', 'FLNS:A', 'FLNSC:A', 'FLNT:A', 'FLNTC:A', 'FLUT:A', 'FLUTC:A', 'FREQI:A', 'FREQL:A', 'FREQZM:A', 'FSDS:A', - 'FSDSC:A', 'FSNR:A', 'FSNS:A', 'FSNSC:A', 'FSNT:A', 'FSNTC:A', 'FSNTOAC:A', 'FSUTOA:A', - 'GS_SO2:A', 'H2O2:A', 'H2O:A', 'H2SO4:A', 'H2SO4M_C:A', 'H2SO4_sfnnuc1:A', +fincl1 = 'ABSORB:A', 'ACTREL:A', 'AODABSdn:A', 'AODBCdn:A', 'AODdnDUST01:A', 'AODdnDUST02:A', + 'AODdnDUST03:A', 'AODdn_aitken:A', 'AODdn_accum:A', 'AODdn_coarse:A', 'AODDUST02:A', 'AODDUST:A', 'AODNIRstdn:A', 'AODPOMdn:A', 'AODSO4dn:A', 'AODSOAdn:A', 'AODSSdn:A', + 'AODUVdn:A', 'AODUVstdn:A', 'AODVIS:A', 'AODVISdn:A', 'AODVISstdn:A', 'AQ_SO2:A', 'AREA:A', 'AREI:A', 'AREL:A', 'bc_a1:A', 'bc_a1DDF:A', + 'bc_a1SFWET:A', 'bc_a4:A', 'bc_a4DDF:A', 'bc_a4SFWET:A', 'bc_c1:A', 'bc_c1DDF:A', 'bc_c1SFWET:A', 'bc_c4:A', 'bc_c4DDF:A', + 'bc_c4SFWET:A', 'BROX:A', 'BROY:A', 'BURDENBCdn', 'BURDENDUSTdn:A', 'BURDENPOMdn:A', 'BURDENSEASALTdn:A', 'BURDENSO4dn:A', + 'BURDENSOAdn:A', 'CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CLOX:A', 'CLOY:A', 'CME:A', 'CMFDQ:A', 'CMFMC:A', + 'CMFMC_DP:A', 'CO2:A', 'CONCLD:A', 'DF_H2O2:A', 'DF_H2SO4:A', + 'DF_SO2:A', 'dgnumwet1:A', 'dgnumwet2:A', 'dgnumwet3:A', 'DH2O2CHM:A', 'DMS:A', 'dry_deposition_NHx_as_N:A', + 'dry_deposition_NOy_as_N:A', 'Dso4_a1CHM:A', 'Dso4_a2CHM:A', 'Dso4_a3CHM:A', 'dst_a1:A', 'dst_a1DDF:A', 'dst_a1SFWET:A', 'dst_a2:A', 'dst_a2DDF:A', + 'dst_a2SFWET:A', 'dst_a3:A', 'dst_a3DDF:A', 'dst_a3SFWET:A', 'dst_c1:A', 'dst_c1DDF:A', 'dst_c1SFWET:A', 'dst_c2:A', 'dst_c2DDF:A', 'dst_c2SFWET:A', + 'dst_c3:A', 'dst_c3DDF:A', 'dst_c3SFWET:A', 'DTCORE:A', 'EVAPPREC:A', + 'EVAPQZM:A', 'EVAPTZM:A', 'EXTINCTdn:A', 'EXTINCTNIRdn:A', 'EXTINCTUVdn:A', 'EXTxASYMdn:A', 'FCTL:A', + 'FLDS:A', 'FLDSC:A', 'FLNR:A', 'FLNS:A', 'FLNSC:A', 'FLNT:A', 'FLNTC:A', 'FLUT:A', 'FLUTC:A', 'FREQI:A', 'FREQL:A', 'FREQZM:A', 'FSDS:A', + 'FSDSC:A', 'FSNR:A', 'FSNS:A', 'FSNSC:A', 'FSNT:A', 'FSNTC:A', 'FSNTOAC:A', 'FSUTOA:A', + 'GS_SO2:A', 'H2O2:A', 'H2O:A', 'H2SO4:A', 'H2SO4M_C:A', 'H2SO4_sfnnuc1:A', 'HCL_GAS:A', 'HNO3_GAS:A', 'HNO3_NAT:A', 'HNO3_STS:A', 'HO2:A', 'ICEFRAC:A','jh2o2:A','KVH_CLUBB:A', 'LANDFRAC:A', 'LHFLX:A', 'MASS:A', - 'ncl_a1:A', 'ncl_a1DDF:A', 'ncl_a1SFWET:A', 'ncl_a2:A', 'ncl_a2DDF:A', 'ncl_a2SFWET:A', 'ncl_a3:A', 'ncl_a3DDF:A', 'ncl_a3SFWET:A', 'ncl_c1:A', + 'ncl_a1:A', 'ncl_a1DDF:A', 'ncl_a1SFWET:A', 'ncl_a2:A', 'ncl_a2DDF:A', 'ncl_a2SFWET:A', 'ncl_a3:A', 'ncl_a3DDF:A', 'ncl_a3SFWET:A', 'ncl_c1:A', 'ncl_c1DDF:A', 'ncl_c1SFWET:A', 'ncl_c2:A', 'ncl_c2DDF:A', 'ncl_c2SFWET:A', 'ncl_c3:A', 'ncl_c3DDF:A', 'ncl_c3SFWET:A', 'NITROP_PD:A', 'NO3:A', 'NOX:A', 'NOY:A', - 'num_a1:A', 'num_a1_CLXF:A', 'num_a1DDF:A', 'num_a2:A', 'num_a2_CLXF:A', 'num_a2DDF:A', 'num_a2_sfnnuc1:A', 'num_a3:A', 'num_a3DDF:A', 'num_a4:A', + 'num_a1:A', 'num_a1_CLXF:A', 'num_a1DDF:A', 'num_a2:A', 'num_a2_CLXF:A', 'num_a2DDF:A', 'num_a2_sfnnuc1:A', 'num_a3:A', 'num_a3DDF:A', 'num_a4:A', 'num_a4DDF:A', 'num_c1:A', 'num_c1DDF:A', 'num_c2:A', 'num_c2DDF:A', 'num_c3:A', 'num_c3DDF:A', 'num_c4:A', 'num_c4DDF:A', 'NUMLIQ:A', 'O3:A', - 'OH:A', 'OMEGA:A', 'OMEGAT:A', 'PBLH:A', 'PDELDRY:A', 'PHIS:A', 'pom_a1:A', 'pom_a1DDF:A', 'pom_a1SFWET:A', - 'pom_a4:A', 'pom_a4DDF:A', 'pom_a4SFWET:A', 'pom_c1:A', 'pom_c1DDF:A', 'pom_c1SFWET:A', 'pom_c4:A', 'pom_c4DDF:A', 'pom_c4SFWET:A', - 'PRECC:A', 'PRECT:A', 'PS:A', 'PSL:A', 'PTEQ:A', 'PTTEND:A', 'Q:A', 'QFLX:A', 'QRAIN:A', 'QREFHT:A', 'QRL:A', 'QRLC:A', 'QRS:A', + 'OH:A', 'OMEGA:A', 'OMEGAT:A', 'PBLH:A', 'PDELDRY:A', 'PHIS:A', 'pom_a1:A', 'pom_a1DDF:A', 'pom_a1SFWET:A', + 'pom_a4:A', 'pom_a4DDF:A', 'pom_a4SFWET:A', 'pom_c1:A', 'pom_c1DDF:A', 'pom_c1SFWET:A', 'pom_c4:A', 'pom_c4DDF:A', 'pom_c4SFWET:A', + 'PRECC:A', 'PRECT:A', 'PS:A', 'PSL:A', 'PTEQ:A', 'PTTEND:A', 'Q:A', 'QFLX:A', 'QRAIN:A', 'QREFHT:A', 'QRL:A', 'QRLC:A', 'QRS:A', 'QRSC:A', 'QSNOW:A', 'RAD_ICE:A', 'RAD_LNAT:A', 'RAD_SULFC:A', 'REFF_AERO:A', 'RELHUM:A', 'RHREFHT:A', 'SAD_AERO:A', 'SAD_ICE:A', 'SAD_LNAT:A', 'SAD_SULFC:A', 'SAD_TROP:A', 'SFbc_a4:A', - 'SFDMS:A', 'SFdst_a1:A', 'SFdst_a2:A', 'SFdst_a3:A', - 'SFncl_a1:A', 'SFncl_a2:A', 'SFncl_a3:A', 'SFnum_a1:A', 'SFnum_a2:A', - 'SFnum_a3:A', 'SFpom_a4:A', 'SFSO2:A', 'SFso4_a1:A', 'SFso4_a2:A', 'SHFLX:A', 'SO2:A', - 'SO2_CHML:A', 'SO2_CHMP:A', 'SO2_CLXF:A', 'SO2_XFRC:A', 'so4_a1:A', 'so4_a1_CHMP:A', 'so4_a1_CLXF:A', 'so4_a1DDF:A', 'so4_a1_sfgaex1:A', 'so4_a1SFWET:A', - 'so4_a2:A', 'so4_a2_CHMP:A', 'so4_a2_CLXF:A', 'so4_a2DDF:A', 'so4_a2_sfgaex1:A', 'so4_a2_sfnnuc1:A', 'so4_a2SFWET:A', 'so4_a3:A', - 'so4_a3DDF:A', 'so4_a3_sfgaex1:A', 'so4_a3SFWET:A', 'so4_c1:A', 'so4_c1AQH2SO4:A', 'so4_c1AQSO4:A', 'so4_c1DDF:A', 'so4_c1SFWET:A', 'so4_c2:A', 'so4_c2AQH2SO4:A', - 'so4_c2AQSO4:A', 'so4_c2DDF:A', 'so4_c2SFWET:A', 'so4_c3:A', 'so4_c3AQH2SO4:A', 'so4_c3AQSO4:A', 'so4_c3DDF:A', 'so4_c3SFWET:A', + 'SFDMS:A', 'SFdst_a1:A', 'SFdst_a2:A', 'SFdst_a3:A', + 'SFncl_a1:A', 'SFncl_a2:A', 'SFncl_a3:A', 'SFnum_a1:A', 'SFnum_a2:A', + 'SFnum_a3:A', 'SFpom_a4:A', 'SFSO2:A', 'SFso4_a1:A', 'SFso4_a2:A', 'SHFLX:A', 'SO2:A', + 'SO2_CHML:A', 'SO2_CHMP:A', 'SO2_CLXF:A', 'SO2_XFRC:A', 'so4_a1:A', 'so4_a1_CHMP:A', 'so4_a1_CLXF:A', 'so4_a1DDF:A', 'so4_a1_sfgaex1:A', 'so4_a1SFWET:A', + 'so4_a2:A', 'so4_a2_CHMP:A', 'so4_a2_CLXF:A', 'so4_a2DDF:A', 'so4_a2_sfgaex1:A', 'so4_a2_sfnnuc1:A', 'so4_a2SFWET:A', 'so4_a3:A', + 'so4_a3DDF:A', 'so4_a3_sfgaex1:A', 'so4_a3SFWET:A', 'so4_c1:A', 'so4_c1AQH2SO4:A', 'so4_c1AQSO4:A', 'so4_c1DDF:A', 'so4_c1SFWET:A', 'so4_c2:A', 'so4_c2AQH2SO4:A', + 'so4_c2AQSO4:A', 'so4_c2DDF:A', 'so4_c2SFWET:A', 'so4_c3:A', 'so4_c3AQH2SO4:A', 'so4_c3AQSO4:A', 'so4_c3DDF:A', 'so4_c3SFWET:A', 'SOLIN:A', 'SOLLD:A', 'SOLSD:A', 'SSAVIS:A', 'SST:A', 'T:A', 'TAQ:A', 'TAUBLJX:A', 'TAUBLJY:A', 'TAUGWX:A', 'TAUGWY:A', 'TAUX:A', 'TAUY:A', 'TBRY:A', 'TCLY:A', - 'TGCLDIWP:A', 'TGCLDLWP:A', 'TMDMS:A', 'TMQ:A', 'TMSO2:A', - 'TMso4_a1:A', 'TMso4_a2:A', 'TMso4_a3:A', 'TOT_CLD_VISTAU:A', 'TOTH:A', 'TREFHT:A', 'TREFHTMN:A', 'TREFHTMX:A', 'TROP_P:A', + 'TGCLDIWP:A', 'TGCLDLWP:A', 'TMDMS:A', 'TMQ:A', 'TMSO2:A', + 'TMso4_a1:A', 'TMso4_a2:A', 'TMso4_a3:A', 'TOT_CLD_VISTAU:A', 'TOTH:A', 'TREFHT:A', 'TREFHTMN:A', 'TREFHTMX:A', 'TROP_P:A', 'TROP_T:A', 'TROP_Z:A', 'TS:A', 'TSMN:M', 'TSMX:X', 'TTEND_TOT:A', 'TTGWORO:A', 'U10:A', 'U:A', 'UTGWORO:A', 'UU:A', 'V:A', 'VD01:A', 'VV:A', 'WD_H2O2:A', 'WD_H2SO4:A', 'WD_SO2:A', 'wet_deposition_NHx_as_N:A', 'wet_deposition_NOy_as_N:A', 'Z3:A', 'ZMDQ:A', 'ZMDT:A', 'ZMMTT:A', 'ZMMU:A' - ! 'dst_a1_SRF:A', 'dst_a3_SRF:A', 'AODABS:A', 'soa_a1:A', 'soa_a2:A', 'soa_c1:A', 'soa_c2:A', + ! 'dst_a1_SRF:A', 'dst_a3_SRF:A', 'AODABS:A', 'soa_a1:A', 'soa_a2:A', 'soa_c1:A', 'soa_c2:A', ! 'soa_a1SFWET:A', 'soa_a2SFWET:A', 'soa_c1SFWET:A', 'soa_c2SFWET:A', 'soa_a1DDF:A', 'soa_a2DDF:A', 'soa_c1DDF:A', 'soa_c2DDF:A', 'bc_a4_CLXF:A', ! 'pom_a4_CLXF:A', 'soa_a1_sfgaex1:A', 'soa_a2_sfgaex1:A', 'ADRAIN:A', 'ADSNOW:A', 'ANRAIN:A', 'ANSNOW:A', 'AQRAIN:A', 'AQSNOW:A', 'AQSO4_H2O2:A', - ! 'AQSO4_O3:A', 'AWNC:A', 'AWNI:A', 'CCN3:A', 'CLDHGH:A', 'CLDLOW:A', 'CLDMED:A', 'FICE:A', 'FREQR:A', 'FREQS:A', 'FSNTOA:A', 'FSNTOA:A', 'H2SO4_sfgaex1:A', - ! 'ICIMR:A', 'ICWMR:A', 'IWC:A', 'LWCF:A', 'PRECL:A', 'PRECSC:A', 'PRECSL:A', 'QT:A', 'RAINQM:A', 'RCM_CLUBB:A', 'RELVAR:A', 'RTP2_CLUBB:A', 'RTPTHLP_CLUBB:A', - ! 'SFSOAG:A', 'SNOWQM:A', 'SWCF:A', 'TGCLDCWP:A', 'UP2_CLUBB:A', 'UPWP_CLUBB:A', 'VP2_CLUBB:A', 'VPWP_CLUBB:A', 'VQ:A', 'VU:A', 'WP2_CLUBB:A', 'WP3_CLUBB:A', + ! 'AQSO4_O3:A', 'AWNC:A', 'AWNI:A', 'CCN3:A', 'CLDHGH:A', 'CLDLOW:A', 'CLDMED:A', 'FICE:A', 'FREQR:A', 'FREQS:A', 'FSNTOA:A', 'FSNTOA:A', 'H2SO4_sfgaex1:A', + ! 'ICIMR:A', 'ICWMR:A', 'IWC:A', 'LWCF:A', 'PRECL:A', 'PRECSC:A', 'PRECSL:A', 'QT:A', 'RAINQM:A', 'RCM_CLUBB:A', 'RELVAR:A', 'RTP2_CLUBB:A', 'RTPTHLP_CLUBB:A', + ! 'SFSOAG:A', 'SNOWQM:A', 'SWCF:A', 'TGCLDCWP:A', 'UP2_CLUBB:A', 'UPWP_CLUBB:A', 'VP2_CLUBB:A', 'VPWP_CLUBB:A', 'VQ:A', 'VU:A', 'WP2_CLUBB:A', 'WP3_CLUBB:A', ! 'WPRCP_CLUBB:A', 'WPRTP_CLUBB:A', 'WPTHLP_CLUBB:A', 'WPTHVP_CLUBB:A', 'WSUB:A', 'bc_a1_SRF:A', 'bc_a4_SRF:A', 'O3colAbove:A' fincl2 = 'ACTNL:A', 'ACTREL:A', 'BURDENBCdn:A', 'BURDENDUSTdn:A', 'BURDENPOMdn:A', 'BURDENSEASALTdn:A', 'BURDENSO4dn:A', 'BURDENSOAdn:A', - 'CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CMFMC:A', 'CMFMCDZM:A', 'FCTL:A', 'FLDS:A', 'FLDSC:A', 'FLNR:A', 'FLNS:A', 'FLNSC:A', - 'FLNT:A', 'FLNTC:A', 'FLUT:A', 'FLUTC:A', 'FSDS:A', 'FSDSC:A', 'FSNR:A', 'FSNS:A', 'FSNSC:A', 'FSNTOA:A', 'FSNTOAC:A', 'LHFLX:A', 'MASS:A', 'OMEGA:A', - 'OMEGA500:A', 'PBLH:A', 'PDELDRY:A', 'PRECC:A', 'PRECT:A', 'PS:A', 'PSL:A', 'Q:A', 'QREFHT:A', 'QSNOW:A', 'RELHUM:A', 'RHREFHT:A', 'SHFLX:A', - 'SOLIN:A', 'SOLLD:A', 'SOLSD:A', 'T:A', 'T500:A', 'T700:A', 'T850:A', 'TAUBLJX:A', 'TAUBLJY:A', 'TAUGWX:A', 'TAUGWY:A', 'TAUX:A', 'TAUY:A', + 'CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CMFMC:A', 'CMFMC_DP:A', 'FCTL:A', 'FLDS:A', 'FLDSC:A', 'FLNR:A', 'FLNS:A', 'FLNSC:A', + 'FLNT:A', 'FLNTC:A', 'FLUT:A', 'FLUTC:A', 'FSDS:A', 'FSDSC:A', 'FSNR:A', 'FSNS:A', 'FSNSC:A', 'FSNTOA:A', 'FSNTOAC:A', 'LHFLX:A', 'MASS:A', 'OMEGA:A', + 'OMEGA500:A', 'PBLH:A', 'PDELDRY:A', 'PRECC:A', 'PRECT:A', 'PS:A', 'PSL:A', 'Q:A', 'QREFHT:A', 'QSNOW:A', 'RELHUM:A', 'RHREFHT:A', 'SHFLX:A', + 'SOLIN:A', 'SOLLD:A', 'SOLSD:A', 'T:A', 'T500:A', 'T700:A', 'T850:A', 'TAUBLJX:A', 'TAUBLJY:A', 'TAUGWX:A', 'TAUGWY:A', 'TAUX:A', 'TAUY:A', 'TGCLDIWP:A', 'TGCLDLWP:A', 'TMQ:A', 'TREFHT:A', 'TREFHTMN:A', 'TREFHTMX:A', 'TS:A', 'TSMN:M', 'TSMX:X', 'U:A', 'U10:A', 'UTGWORO:A', 'V:A', 'Z3:A', 'Z500:A' - - diff --git a/cime_config/usermods_dirs/CMIP6_B1850_WACCM/user_nl_cam b/cime_config/usermods_dirs/CMIP6_B1850_WACCM/user_nl_cam index 6af14edde5..033ae322f8 100644 --- a/cime_config/usermods_dirs/CMIP6_B1850_WACCM/user_nl_cam +++ b/cime_config/usermods_dirs/CMIP6_B1850_WACCM/user_nl_cam @@ -2,7 +2,7 @@ nhtfrq = 0,-24,-6,-3,-1,1,-24,-120,-240 fincl1 = 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', - 'AODBCdn', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODdnMODE1', 'AODdnMODE2', 'AODdnMODE3', 'AODDUST2', 'AODDUST', + 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODdn_aitken', 'AODdn_accum', 'AODdn_coarse', 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', @@ -15,12 +15,12 @@ fincl1 = 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AO 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CCL3_CHML', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3CO3', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', 'CH3COOOH', 'CH3O2', 'CH3OH', 'CH3OOH', 'CH4', 'CH4_CHML', 'CHBR3', 'CL2', 'CL2O2', 'CL', 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLO', 'CLONO2', - 'CLOUD', 'CLOX', 'CLOY', 'CLY', 'CME', 'CMFDQ', 'CMFMC', 'CMFMCDZM', 'CO2', + 'CLOUD', 'CLOX', 'CLOY', 'CLY', 'CME', 'CMFDQ', 'CMFMC', 'CMFMC_DP', 'CO2', 'CO2_CHML', 'CO', 'CO_CHML', 'CO_CHMP', 'COF2', 'COFCL', 'CONCLD', 'CRESOL', 'DCOCHM', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', - 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', + 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOP', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'DF_NH3', 'DF_NH4', 'DF_NO2', 'DF_NO', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', @@ -66,7 +66,7 @@ fincl1 = 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AO 'SFBIGENE', 'SFC2H2', 'SFC2H4', 'SFC2H5OH', 'SFC2H6', 'SFC3H6', 'SFC3H8', 'SFCH2O', 'SFCH3CHO', 'SFCH3CN', 'SFCH3COCH3', 'SFCH3COCHO', 'SFCH3COOH', 'SFCH3OH', 'SFCO', 'SFDMS', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', 'SFGLYALD', 'SFHCN', 'SFHCOOH', 'SFISOP', 'SFIVOC', 'SFMEK', 'SFMTERP', 'SFncl_a1', - 'SFncl_a2', 'SFncl_a3', 'SFNH3', 'SFNO2', 'SFNO', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'SFpom_a4', + 'SFncl_a2', 'SFncl_a3', 'SFNH3', 'SFNO', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'SFpom_a4', 'SFSO2', 'SFso4_a1', 'SFso4_a2', 'SFSVOC', 'SFTOLUENE', 'SFXYLENES', 'SHFLX', 'SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SO2_XFRC', 'SO3', 'so4_a1', 'so4_a1_CHMP', 'so4_a1_CLXF', 'so4_a1DDF', 'so4_a1_sfgaex1', 'so4_a1SFWET', 'so4_a2', 'so4_a2_CHMP', 'so4_a2_CLXF', 'so4_a2DDF', 'so4_a2_sfgaex1', 'so4_a2_sfnnuc1', 'so4_a2SFWET', 'so4_a3', @@ -94,7 +94,7 @@ fincl1 = 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AO 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCH3', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', - 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', + 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOP', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', @@ -103,7 +103,7 @@ fincl1 = 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AO 'ZMDT', 'ZMMTT', 'ZMMU' ! fincl2 = 'ACTNL:A', 'ACTREL:A', 'BURDENBCdn:A', 'BURDENDUSTdn:A', 'BURDENPOMdn:A', 'BURDENSEASALTdn:A', 'BURDENSO4dn:A', 'BURDENSOAdn:A', 'BUTGWSPEC:A', -! 'CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CMFMC:A', 'CMFMCDZM:A', 'FCTL:A', 'FLDS:A', +! 'CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CMFMC:A', 'CMFMC_DP:A', 'FCTL:A', 'FLDS:A', ! 'FLDSC:A', 'FLNR:A', 'FLNS:A', 'FLNSC:A', 'FLNT:A', 'FLNTC:A', 'FLUT:A', 'FLUTC:A', 'FSDS:A', ! 'FSDSC:A', 'FSNR:A', 'FSNS:A', 'FSNSC:A', 'FSNTOA:A', 'FSNTOAC:A', 'LHFLX:A', 'MASS:A', 'OMEGA:A', ! 'OMEGA500:A', 'PBLH:A', 'PDELDRY:A', 'PRECC:A', 'PRECT:A', 'PS:A', 'PSL:A', 'Q:A', 'QREFHT:A', diff --git a/cime_config/usermods_dirs/CMIP6_BHIST/user_nl_cam b/cime_config/usermods_dirs/CMIP6_BHIST/user_nl_cam index 4457839d84..9918e4e878 100644 --- a/cime_config/usermods_dirs/CMIP6_BHIST/user_nl_cam +++ b/cime_config/usermods_dirs/CMIP6_BHIST/user_nl_cam @@ -5,13 +5,13 @@ mfilt = 1, 5, 20, 40, 120, 240, 365, 73, 365 ndens = 2, 2, 2, 2, 2, 2, 1, 1, 1 -fincl1 = 'ABSORB:A', 'ACTREL:A', 'AODABSdn:A', 'AODBCdn:A', 'AODdnDUST1:A', 'AODdnDUST2:A', - 'AODdnDUST3:A', 'AODdnMODE1:A', 'AODdnMODE2:A', 'AODdnMODE3:A', 'AODDUST2:A', 'AODDUST:A', 'AODNIRstdn:A', 'AODPOMdn:A', 'AODSO4dn:A', 'AODSOAdn:A', 'AODSSdn:A', +fincl1 = 'ABSORB:A', 'ACTREL:A', 'AODABSdn:A', 'AODBCdn:A', 'AODdnDUST01:A', 'AODdnDUST02:A', + 'AODdnDUST03:A', 'AODdn_aitken:A', 'AODdn_accum:A', 'AODdn_coarse:A', 'AODDUST02:A', 'AODDUST:A', 'AODNIRstdn:A', 'AODPOMdn:A', 'AODSO4dn:A', 'AODSOAdn:A', 'AODSSdn:A', 'AODUVdn:A', 'AODUVstdn:A', 'AODVIS:A', 'AODVISdn:A', 'AODVISstdn:A', 'AQ_SO2:A', 'AREA:A', 'AREI:A', 'AREL:A', 'bc_a1:A', 'bc_a1DDF:A', 'bc_a1SFWET:A', 'bc_a4:A', 'bc_a4DDF:A', 'bc_a4SFWET:A', 'bc_c1:A', 'bc_c1DDF:A', 'bc_c1SFWET:A', 'bc_c4:A', 'bc_c4DDF:A', 'bc_c4SFWET:A', 'BROX:A', 'BROY:A', 'BURDENBCdn', 'BURDENDUSTdn:A', 'BURDENPOMdn:A', 'BURDENSEASALTdn:A', 'BURDENSO4dn:A', 'BURDENSOAdn:A', 'CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CLOX:A', 'CLOY:A', 'CME:A', 'CMFDQ:A', 'CMFMC:A', - 'CMFMCDZM:A', 'CO2:A', 'CONCLD:A', 'DF_H2O2:A', 'DF_H2SO4:A', + 'CMFMC_DP:A', 'CO2:A', 'CONCLD:A', 'DF_H2O2:A', 'DF_H2SO4:A', 'DF_SO2:A', 'dgnumwet1:A', 'dgnumwet2:A', 'dgnumwet3:A', 'DH2O2CHM:A', 'DMS:A', 'dry_deposition_NHx_as_N:A', 'dry_deposition_NOy_as_N:A', 'Dso4_a1CHM:A', 'Dso4_a2CHM:A', 'Dso4_a3CHM:A', 'dst_a1:A', 'dst_a1DDF:A', 'dst_a1SFWET:A', 'dst_a2:A', 'dst_a2DDF:A', 'dst_a2SFWET:A', 'dst_a3:A', 'dst_a3DDF:A', 'dst_a3SFWET:A', 'dst_c1:A', 'dst_c1DDF:A', 'dst_c1SFWET:A', 'dst_c2:A', 'dst_c2DDF:A', 'dst_c2SFWET:A', @@ -56,7 +56,7 @@ fincl1 = 'ABSORB:A', 'ACTREL:A', 'AODABSdn:A', 'AODBCdn:A', 'AODdnDUST1:A', 'AOD fincl2 = 'ACTNL:A', 'ACTREL:A', 'BURDENBCdn:A', 'BURDENDUSTdn:A', 'BURDENPOMdn:A', 'BURDENSEASALTdn:A', 'BURDENSO4dn:A', 'BURDENSOAdn:A', - 'CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CMFMC:A', 'CMFMCDZM:A', 'FCTL:A', 'FLDS:A', 'FLDSC:A', 'FLNR:A', 'FLNS:A', 'FLNSC:A', + 'CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CMFMC:A', 'CMFMC_DP:A', 'FCTL:A', 'FLDS:A', 'FLDSC:A', 'FLNR:A', 'FLNS:A', 'FLNSC:A', 'FLNT:A', 'FLNTC:A', 'FLUT:A', 'FLUTC:A', 'FSDS:A', 'FSDSC:A', 'FSNR:A', 'FSNS:A', 'FSNSC:A', 'FSNTOA:A', 'FSNTOAC:A', 'LHFLX:A', 'MASS:A', 'OMEGA:A', 'OMEGA500:A', 'PBLH:A', 'PDELDRY:A', 'PRECC:A', 'PRECT:A', 'PS:A', 'PSL:A', 'Q:A', 'QREFHT:A', 'QSNOW:A', 'RELHUM:A', 'RHREFHT:A', 'SHFLX:A', 'SOLIN:A', 'SOLLD:A', 'SOLSD:A', 'T:A', 'T500:A', 'T700:A', 'T850:A', 'TAUBLJX:A', 'TAUBLJY:A', 'TAUGWX:A', 'TAUGWY:A', 'TAUX:A', 'TAUY:A', diff --git a/cime_config/usermods_dirs/CMIP6_BHIST_WACCM/user_nl_cam b/cime_config/usermods_dirs/CMIP6_BHIST_WACCM/user_nl_cam index a1054eab53..36485414c6 100644 --- a/cime_config/usermods_dirs/CMIP6_BHIST_WACCM/user_nl_cam +++ b/cime_config/usermods_dirs/CMIP6_BHIST_WACCM/user_nl_cam @@ -1,8 +1,8 @@ - mfilt = 1, 5, 20, 40, 120, 240, 365, 73, 365 + mfilt = 1, 5, 20, 40, 120, 240, 365, 73, 365 nhtfrq = 0,-24,-6,-3,-1,1,-24,-120,-240 fincl1 = 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', - 'AODBCdn', 'AODdnDUST1', 'AODdnDUST2', 'AODdnDUST3', 'AODdnMODE1', 'AODdnMODE2', 'AODdnMODE3', 'AODDUST2', 'AODDUST', + 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODdn_aitken', 'AODdn_accum', 'AODdn_coarse', 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', @@ -15,12 +15,12 @@ 'CH2BR2', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CCL3_CHML', 'CH3CHO', 'CH3CL', 'CH3CN', 'CH3CO3', 'CH3COCH3', 'CH3COCHO', 'CH3COOH', 'CH3COOOH', 'CH3O2', 'CH3OH', 'CH3OOH', 'CH4', 'CH4_CHML', 'CHBR3', 'CL2', 'CL2O2', 'CL', 'CLDICE', 'CLDLIQ', 'CLDTOT', 'CLO', 'CLONO2', - 'CLOUD', 'CLOX', 'CLOY', 'CLY', 'CME', 'CMFDQ', 'CMFMC', 'CMFMCDZM', 'CO2', + 'CLOUD', 'CLOX', 'CLOY', 'CLY', 'CME', 'CMFDQ', 'CMFMC', 'CMFMC_DP', 'CO2', 'CO2_CHML', 'CO', 'CO_CHML', 'CO_CHMP', 'COF2', 'COFCL', 'CONCLD', 'CRESOL', 'DCOCHM', 'DF_ALKNIT', 'DF_ALKOOH', 'DF_BENZOOH', 'DF_BZOOH', 'DF_C2H5OH', 'DF_C2H5OOH', 'DF_C3H7OOH', 'DF_C6H5OOH', 'DF_CH2O', 'DF_CH3CHO', 'DF_CH3CN', 'DF_CH3COCH3', 'DF_CH3COCHO', 'DF_CH3COOH', 'DF_CH3COOOH', 'DF_CH3OH', 'DF_CH3OOH', 'DF_CO', 'DF_EOOH', 'DF_GLYALD', 'DF_H2O2', 'DF_H2SO4', 'DF_HCN', 'DF_HCOOH', 'DF_HNO3', 'DF_HO2NO2', 'DF_HONITR', - 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOPNO3', 'DF_ISOPNOOH', 'DF_ISOPOOH', + 'DF_HPALD', 'DF_HYAC', 'DF_HYDRALD', 'DF_IEPOX', 'DF_ISOPNITA', 'DF_ISOPNITB', 'DF_ISOP', 'DF_ISOPNOOH', 'DF_ISOPOOH', 'DF_IVOC', 'DF_MACROOH', 'DF_MEKOOH', 'DF_MPAN', 'DF_NC4CH2OH', 'DF_NC4CHO', 'DF_NH3', 'DF_NH4', 'DF_NO2', 'DF_NO', 'DF_NOA', 'DF_NTERPOOH', 'DF_O3', 'DF_ONITR', 'DF_PAN', 'DF_PHENOOH', 'DF_POOH', 'DF_ROOH', 'DF_SO2', 'DF_SOAG0', 'DF_SOAG1', 'DF_SOAG2', 'DF_SOAG3', 'DF_SOAG4', 'DF_SVOC', 'DF_TERP2OOH', 'DF_TERPNIT', @@ -66,7 +66,7 @@ 'SFBIGENE', 'SFC2H2', 'SFC2H4', 'SFC2H5OH', 'SFC2H6', 'SFC3H6', 'SFC3H8', 'SFCH2O', 'SFCH3CHO', 'SFCH3CN', 'SFCH3COCH3', 'SFCH3COCHO', 'SFCH3COOH', 'SFCH3OH', 'SFCO', 'SFDMS', 'SFdst_a1', 'SFdst_a2', 'SFdst_a3', 'SFGLYALD', 'SFHCN', 'SFHCOOH', 'SFISOP', 'SFIVOC', 'SFMEK', 'SFMTERP', 'SFncl_a1', - 'SFncl_a2', 'SFncl_a3', 'SFNH3', 'SFNO2', 'SFNO', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'SFpom_a4', + 'SFncl_a2', 'SFncl_a3', 'SFNH3', 'SFNO', 'SFnum_a1', 'SFnum_a2', 'SFnum_a3', 'SFpom_a4', 'SFSO2', 'SFso4_a1', 'SFso4_a2', 'SFSVOC', 'SFTOLUENE', 'SFXYLENES', 'SHFLX', 'SO2', 'SO2_CHML', 'SO2_CHMP', 'SO2_CLXF', 'SO2_XFRC', 'SO3', 'so4_a1', 'so4_a1_CHMP', 'so4_a1_CLXF', 'so4_a1DDF', 'so4_a1_sfgaex1', 'so4_a1SFWET', 'so4_a2', 'so4_a2_CHMP', 'so4_a2_CLXF', 'so4_a2DDF', 'so4_a2_sfgaex1', 'so4_a2_sfnnuc1', 'so4_a2SFWET', 'so4_a3', @@ -94,7 +94,7 @@ 'WD_CH2O', 'WD_CH3CHO', 'WD_CH3CN', 'WD_CH3COCH3', 'WD_CH3COCHO', 'WD_CH3COOH', 'WD_CH3COOOH', 'WD_CH3OH', 'WD_CH3OOH', 'WD_CLONO2', 'WD_COF2', 'WD_COFCL', 'WD_EOOH', 'WD_GLYALD', 'WD_H2O2', 'WD_H2SO4', 'WD_HBR', 'WD_HCL', 'WD_HCN', 'WD_HCOOH', 'WD_HF', 'WD_HNO3', 'WD_HO2NO2', 'WD_HOBR', 'WD_HOCL', 'WD_HONITR', 'WD_HPALD', - 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOPNO3', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', + 'WD_HYAC', 'WD_HYDRALD', 'WD_IEPOX', 'WD_ISOPNITA', 'WD_ISOPNITB', 'WD_ISOP', 'WD_ISOPNOOH', 'WD_ISOPOOH', 'WD_IVOC', 'WD_MACR', 'WD_MACROOH', 'WD_MEKOOH', 'WD_MVK', 'WD_NC4CH2OH', 'WD_NC4CHO', 'WD_NDEP', 'WD_NH3', 'WD_NH4', 'WD_NHDEP', 'WD_NOA', 'WD_NTERPOOH', 'WD_ONITR', 'WD_PHENOOH', 'WD_POOH', 'WD_ROOH', 'WD_SO2', 'WD_SOAG0', 'WD_SOAG1', 'WD_SOAG2', 'WD_SOAG3', 'WD_SOAG4', 'WD_SVOC', 'WD_TERP2OOH', 'WD_TERPNIT', 'WD_TERPOOH', 'WD_TERPROD1', @@ -102,7 +102,7 @@ 'XOOH', 'XYLENES', 'XYLENO2', 'XYLENOOH', 'XYLOL', 'XYLOLO2', 'XYLOLOOH', 'Z3', 'ZMDQ', 'ZMDT', 'ZMMTT', 'ZMMU' ! fincl2 = 'ACTNL', 'ACTREL', 'BURDENBCdn', 'BURDENDUSTdn', 'BURDENPOMdn', 'BURDENSEASALTdn', 'BURDENSO4dn', 'BURDENSOAdn', 'BUTGWSPEC', 'CDNUMC', 'CLDICE', - ! 'CLDLIQ', 'CLDTOT', 'CLOUD', 'CMFMC', 'CMFMCDZM', 'FCTL', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', + ! 'CLDLIQ', 'CLDTOT', 'CLOUD', 'CMFMC', 'CMFMC_DP', 'FCTL', 'FLDS', 'FLDSC', 'FLNR', 'FLNS', 'FLNSC', ! 'FLNT', 'FLNTC', 'FLUT', 'FLUTC', 'FSDS', 'FSDSC', 'FSNR', 'FSNS', 'FSNSC', 'FSNTOA', 'FSNTOAC', ! 'LHFLX', 'MASS', 'NITROP_PD', 'O3', 'O3_SRF:X', 'OMEGA', 'OMEGA500', 'PBLH', 'PDELDRY', 'PHIS', 'PM25_SRF', ! 'PRECC', 'PRECT', 'PS', 'PSL', 'Q', 'QREFHT', 'QSNOW', 'RELHUM', 'RHREFHT', 'SHFLX', 'SOLIN', diff --git a/cime_config/usermods_dirs/CMIP6_GENERIC/user_nl_cam b/cime_config/usermods_dirs/CMIP6_GENERIC/user_nl_cam index 086f1e33e5..9ae154c7bb 100644 --- a/cime_config/usermods_dirs/CMIP6_GENERIC/user_nl_cam +++ b/cime_config/usermods_dirs/CMIP6_GENERIC/user_nl_cam @@ -4,13 +4,13 @@ mfilt = 1, 5, 20, 40, 120, 240, 365, 73, 365 ndens = 2, 2, 2, 2, 2, 2, 1, 1, 1 -fincl1 = 'ABSORB:A', 'ACTREL:A', 'AODABSdn:A', 'AODBCdn:A', 'AODdnDUST1:A', 'AODdnDUST2:A', - 'AODdnDUST3:A', 'AODdnMODE1:A', 'AODdnMODE2:A', 'AODdnMODE3:A', 'AODDUST2:A', 'AODDUST:A', 'AODNIRstdn:A', 'AODPOMdn:A', 'AODSO4dn:A', 'AODSOAdn:A', 'AODSSdn:A', +fincl1 = 'ABSORB:A', 'ACTREL:A', 'AODABSdn:A', 'AODBCdn:A', 'AODdnDUST01:A', 'AODdnDUST02:A', + 'AODdnDUST03:A', 'AODdn_aitken:A', 'AODdn_accum:A', 'AODdn_coarse:A', 'AODDUST02:A', 'AODDUST:A', 'AODNIRstdn:A', 'AODPOMdn:A', 'AODSO4dn:A', 'AODSOAdn:A', 'AODSSdn:A', 'AODUVdn:A', 'AODUVstdn:A', 'AODVIS:A', 'AODVISdn:A', 'AODVISstdn:A', 'AQ_SO2:A', 'AREA:A', 'AREI:A', 'AREL:A', 'bc_a1:A', 'bc_a1DDF:A', 'bc_a1SFWET:A', 'bc_a4:A', 'bc_a4DDF:A', 'bc_a4SFWET:A', 'bc_c1:A', 'bc_c1DDF:A', 'bc_c1SFWET:A', 'bc_c4:A', 'bc_c4DDF:A', 'bc_c4SFWET:A', 'BROX:A', 'BROY:A', 'BURDENBCdn', 'BURDENDUSTdn:A', 'BURDENPOMdn:A', 'BURDENSEASALTdn:A', 'BURDENSO4dn:A', 'BURDENSOAdn:A', 'CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CLOX:A', 'CLOY:A', 'CME:A', 'CMFDQ:A', 'CMFMC:A', - 'CMFMCDZM:A', 'CO2:A', 'CONCLD:A', 'DF_H2O2:A', 'DF_H2SO4:A', + 'CMFMC_DP:A', 'CO2:A', 'CONCLD:A', 'DF_H2O2:A', 'DF_H2SO4:A', 'DF_SO2:A', 'dgnumwet1:A', 'dgnumwet2:A', 'dgnumwet3:A', 'DH2O2CHM:A', 'DMS:A', 'dry_deposition_NHx_as_N:A', 'dry_deposition_NOy_as_N:A', 'Dso4_a1CHM:A', 'Dso4_a2CHM:A', 'Dso4_a3CHM:A', 'dst_a1:A', 'dst_a1DDF:A', 'dst_a1SFWET:A', 'dst_a2:A', 'dst_a2DDF:A', 'dst_a2SFWET:A', 'dst_a3:A', 'dst_a3DDF:A', 'dst_a3SFWET:A', 'dst_c1:A', 'dst_c1DDF:A', 'dst_c1SFWET:A', 'dst_c2:A', 'dst_c2DDF:A', 'dst_c2SFWET:A', @@ -54,7 +54,7 @@ fincl1 = 'ABSORB:A', 'ACTREL:A', 'AODABSdn:A', 'AODBCdn:A', 'AODdnDUST1:A', 'AOD fincl2 = 'ACTNL:A', 'ACTREL:A', 'BURDENBCdn:A', 'BURDENDUSTdn:A', 'BURDENPOMdn:A', 'BURDENSEASALTdn:A', 'BURDENSO4dn:A', 'BURDENSOAdn:A', - 'CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CMFMC:A', 'CMFMCDZM:A', 'FCTL:A', 'FLDS:A', 'FLDSC:A', 'FLNR:A', 'FLNS:A', 'FLNSC:A', + 'CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CMFMC:A', 'CMFMC_DP:A', 'FCTL:A', 'FLDS:A', 'FLDSC:A', 'FLNR:A', 'FLNS:A', 'FLNSC:A', 'FLNT:A', 'FLNTC:A', 'FLUT:A', 'FLUTC:A', 'FSDS:A', 'FSDSC:A', 'FSNR:A', 'FSNS:A', 'FSNSC:A', 'FSNTOA:A', 'FSNTOAC:A', 'LHFLX:A', 'MASS:A', 'OMEGA:A', 'OMEGA500:A', 'PBLH:A', 'PDELDRY:A', 'PRECC:A', 'PRECT:A', 'PS:A', 'PSL:A', 'Q:A', 'QREFHT:A', 'QSNOW:A', 'RELHUM:A', 'RHREFHT:A', 'SHFLX:A', 'SOLIN:A', 'SOLLD:A', 'SOLSD:A', 'T:A', 'T500:A', 'T700:A', 'T850:A', 'TAUBLJX:A', 'TAUBLJY:A', 'TAUGWX:A', 'TAUGWY:A', 'TAUX:A', 'TAUY:A', 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/shell_commands b/cime_config/usermods_dirs/scam_bomex/shell_commands deleted file mode 100755 index 6d2bb04886..0000000000 --- a/cime_config/usermods_dirs/scam_bomex/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=300. -./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-06-25 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=5 - -# 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_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_camfrc/shell_commands b/cime_config/usermods_dirs/scam_camfrc/shell_commands new file mode 100755 index 0000000000..b12fe28bb0 --- /dev/null +++ b/cime_config/usermods_dirs/scam_camfrc/shell_commands @@ -0,0 +1,16 @@ +# setup SCAM lon and lat for this iop +# this should correspond to the forcing IOP coordinates +./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=1997-01-01 +./xmlchange START_TOD=0 +./xmlchange STOP_OPTION=ndays +./xmlchange STOP_N=1 + +# 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_camfrc/user_nl_cam b/cime_config/usermods_dirs/scam_camfrc/user_nl_cam new file mode 100644 index 0000000000..1dc04efa8e --- /dev/null +++ b/cime_config/usermods_dirs/scam_camfrc/user_nl_cam @@ -0,0 +1,10 @@ +mfilt=2088 +nhtfrq=1 +co2vmr=368.9e-6 +scm_use_obs_uv = .true. +scm_relaxation = .false. +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_cgilsS11/shell_commands b/cime_config/usermods_dirs/scam_cgilsS11/shell_commands deleted file mode 100755 index 37056ed761..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS11/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=231. -./xmlchange PTS_LAT=32. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1997-07-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=30 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam b/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam deleted file mode 100644 index c58ac57499..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/S11_CTL_MixedLayerInit_reduced.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_cgilsS12/shell_commands b/cime_config/usermods_dirs/scam_cgilsS12/shell_commands deleted file mode 100755 index fefce8216e..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS12/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=235. -./xmlchange PTS_LAT=35. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1997-07-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=30 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam b/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam deleted file mode 100644 index 52e9e20093..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/S12_CTL_MixedLayerInit_reduced.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_cgilsS6/shell_commands b/cime_config/usermods_dirs/scam_cgilsS6/shell_commands deleted file mode 100755 index 5ecc09e2a4..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS6/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=211. -./xmlchange PTS_LAT=17. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1997-07-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=30 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam b/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam deleted file mode 100644 index 6b2a0222f4..0000000000 --- a/cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/S6_CTL_reduced.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_dycomsRF01/shell_commands b/cime_config/usermods_dirs/scam_dycomsRF01/shell_commands deleted file mode 100755 index 241e785227..0000000000 --- a/cime_config/usermods_dirs/scam_dycomsRF01/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=238.5 -./xmlchange PTS_LAT=31.5 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1999-07-11 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=144 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam b/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam deleted file mode 100644 index 76a2c10c55..0000000000 --- a/cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/DYCOMSrf01_4day_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_use_obs_T =.true. -scm_relaxation = .true. -scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_dycomsRF02/shell_commands b/cime_config/usermods_dirs/scam_dycomsRF02/shell_commands deleted file mode 100755 index 241e785227..0000000000 --- a/cime_config/usermods_dirs/scam_dycomsRF02/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=238.5 -./xmlchange PTS_LAT=31.5 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1999-07-11 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=144 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam b/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam deleted file mode 100644 index 57ebe708ed..0000000000 --- a/cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/DYCOMSrf02_48hr_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_use_obs_T =.true. -scm_relaxation = .true. -scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_gateIII/shell_commands b/cime_config/usermods_dirs/scam_gateIII/shell_commands deleted file mode 100755 index 03642e292a..0000000000 --- a/cime_config/usermods_dirs/scam_gateIII/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=336.0 -./xmlchange PTS_LAT=9.00 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1974-08-30 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1440 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_gateIII/user_nl_cam b/cime_config/usermods_dirs/scam_gateIII/user_nl_cam deleted file mode 100644 index 96e7b2ddbc..0000000000 --- a/cime_config/usermods_dirs/scam_gateIII/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/GATEIII_4scam_c170809.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-08-01-00000.nc" -mfilt=1440 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_mandatory/shell_commands b/cime_config/usermods_dirs/scam_mandatory/shell_commands index 0772ae5f3c..4fa8390aa5 100755 --- a/cime_config/usermods_dirs/scam_mandatory/shell_commands +++ b/cime_config/usermods_dirs/scam_mandatory/shell_commands @@ -2,14 +2,14 @@ # these are necessary for scam runs. #======================================== # -# SCAM works in SPMD mode with a single task, but the default is to run serially. -./xmlchange MPILIB=mpi-serial +# SCAM works in SPMD mode with a single task. +./xmlchange NTASKS=1 # SCAM doesn't have restart functionality yet. ./xmlchange REST_OPTION=never # Note that clm cannot use initial conditions with SCAM -so will only use specified phenology # Only change if CLM_FORCE_COLDSTART exists. -if [ `./xmlquery --value CLM_FORCE_COLDSTART |& grep -c 'ERROR'` -eq 0 ]; then +if [ `./xmlquery --value CLM_FORCE_COLDSTART 2>&1 | grep -c 'ERROR'` -eq 0 ]; then ./xmlchange CLM_FORCE_COLDSTART='on' fi diff --git a/cime_config/usermods_dirs/scam_micre2017/shell_commands b/cime_config/usermods_dirs/scam_micre2017/shell_commands deleted file mode 100755 index b7b2225466..0000000000 --- a/cime_config/usermods_dirs/scam_micre2017/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON= 141.5 -./xmlchange PTS_LAT= -56.0 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2017-01-01 -./xmlchange START_TOD=0000 -./xmlchange STOP_OPTION=ndays -./xmlchange STOP_N=90 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_micre2017/user_nl_cam b/cime_config/usermods_dirs/scam_micre2017/user_nl_cam deleted file mode 100644 index 675974b5e7..0000000000 --- a/cime_config/usermods_dirs/scam_micre2017/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile='$DIN_LOC_ROOT/atm/cam/scam/iop/micre2017_3mo.macquarie2017.iop.nc' -ncdata ='$DIN_LOC_ROOT/atm/cam/scam/iop/micre2017_3mo.cam.i.2017-01-01-00000.regrid.Gaus_64x128.nc' -mfilt=9000 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_mpace/shell_commands b/cime_config/usermods_dirs/scam_mpace/shell_commands deleted file mode 100755 index d9d0e50837..0000000000 --- a/cime_config/usermods_dirs/scam_mpace/shell_commands +++ /dev/null @@ -1,17 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=206.0 -./xmlchange PTS_LAT=70.5 - - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2004-10-05 -./xmlchange START_TOD=7171 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1242 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_mpace/user_nl_cam b/cime_config/usermods_dirs/scam_mpace/user_nl_cam deleted file mode 100644 index cb3263e871..0000000000 --- a/cime_config/usermods_dirs/scam_mpace/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/MPACE_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-10-01-00000.nc" -mfilt=1242 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_rico/shell_commands b/cime_config/usermods_dirs/scam_rico/shell_commands deleted file mode 100755 index ad424f951b..0000000000 --- a/cime_config/usermods_dirs/scam_rico/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=298.5 -./xmlchange PTS_LAT=18. - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1995-07-15 -./xmlchange START_TOD=0 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=216 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_rico/user_nl_cam b/cime_config/usermods_dirs/scam_rico/user_nl_cam deleted file mode 100644 index 968b1e3c71..0000000000 --- a/cime_config/usermods_dirs/scam_rico/user_nl_cam +++ /dev/null @@ -1,15 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/RICO_3day_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-07-01-00000.nc" -mfilt=2088 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_use_obs_T =.true. -scm_relaxation = .true. -scm_relax_fincl = 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_sparticus/shell_commands b/cime_config/usermods_dirs/scam_sparticus/shell_commands deleted file mode 100755 index 68dbd4467c..0000000000 --- a/cime_config/usermods_dirs/scam_sparticus/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=262.51 -./xmlchange PTS_LAT=36.6 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2010-04-01 -./xmlchange START_TOD=3599 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=2156 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_sparticus/user_nl_cam b/cime_config/usermods_dirs/scam_sparticus/user_nl_cam deleted file mode 100644 index d12c7a3609..0000000000 --- a/cime_config/usermods_dirs/scam_sparticus/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/SPARTICUS_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-04-01-00000.nc" -mfilt=2156 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_togaII/shell_commands b/cime_config/usermods_dirs/scam_togaII/shell_commands deleted file mode 100755 index 6ab21646b1..0000000000 --- a/cime_config/usermods_dirs/scam_togaII/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=154.69 -./xmlchange PTS_LAT=-2.10 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=1992-12-18 -./xmlchange START_TOD=64800 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1512 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_togaII/user_nl_cam b/cime_config/usermods_dirs/scam_togaII/user_nl_cam deleted file mode 100644 index f6a36ad6eb..0000000000 --- a/cime_config/usermods_dirs/scam_togaII/user_nl_cam +++ /dev/null @@ -1,14 +0,0 @@ -iopfile="$DIN_LOC_ROOT/atm/cam/scam/iop/TOGAII_4scam.nc" -ncdata="$DIN_LOC_ROOT/atm/cam/scam/iop/CESM2.F2000climo.IOP_SITES.cam.i.0003-12-01-00000.nc" -mfilt=9 -nhtfrq=1 -scm_use_obs_uv = .true. -scm_relaxation = .true. -scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', - 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', - 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' -scm_relax_bot_p = 105000. -scm_relax_top_p = 200. -scm_relax_linear = .true. -scm_relax_tau_bot_sec = 864000. -scm_relax_tau_top_sec = 172800. diff --git a/cime_config/usermods_dirs/scam_twp06/shell_commands b/cime_config/usermods_dirs/scam_twp06/shell_commands deleted file mode 100755 index 7787ba2453..0000000000 --- a/cime_config/usermods_dirs/scam_twp06/shell_commands +++ /dev/null @@ -1,16 +0,0 @@ -# setup SCAM lon and lat for this iop -# this should correspond to the forcing IOP coordinates -./xmlchange PTS_LON=130.89 -./xmlchange PTS_LAT=-12.32 - -# Specify the starting/ending time for the IOP -# The complete time slice of IOP file is specified below -# but you may simulate any within the IOP start and end times. -./xmlchange RUN_STARTDATE=2006-01-17 -./xmlchange START_TOD=10800 -./xmlchange STOP_OPTION=nsteps -./xmlchange STOP_N=1926 - -# usermods_dir/scam_mandatory will be included for all single column -# runs by default. This usermods directory contains mandatory settings -# for scam and shouldn't be modified by the user. diff --git a/cime_config/usermods_dirs/scam_twp06/user_nl_cam b/cime_config/usermods_dirs/scam_twp06/user_nl_cam deleted file mode 100644 index 0bb56f339d..0000000000 --- a/cime_config/usermods_dirs/scam_twp06/user_nl_cam +++ /dev/null @@ -1,14 +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. diff --git a/components/cdeps b/components/cdeps new file mode 160000 index 0000000000..0750c91753 --- /dev/null +++ b/components/cdeps @@ -0,0 +1 @@ +Subproject commit 0750c9175395d3ba3bf8eba65703dee230d08572 diff --git a/components/cice b/components/cice new file mode 160000 index 0000000000..e51ab1d3f1 --- /dev/null +++ b/components/cice @@ -0,0 +1 @@ +Subproject commit e51ab1d3f12ae2959b7df978f77dc5a1ee0181d3 diff --git a/components/cism b/components/cism new file mode 160000 index 0000000000..41843ef8fe --- /dev/null +++ b/components/cism @@ -0,0 +1 @@ +Subproject commit 41843ef8fed91fcf60e2ea217c4f6f2ee5133c5d diff --git a/components/clm b/components/clm new file mode 160000 index 0000000000..203db121c0 --- /dev/null +++ b/components/clm @@ -0,0 +1 @@ +Subproject commit 203db121c01b593324078ecb55d7535e45723989 diff --git a/components/cmeps b/components/cmeps new file mode 160000 index 0000000000..4b636c6f79 --- /dev/null +++ b/components/cmeps @@ -0,0 +1 @@ +Subproject commit 4b636c6f794ca02d854d15c620e26644751b449b diff --git a/components/mizuRoute b/components/mizuRoute new file mode 160000 index 0000000000..362bee329b --- /dev/null +++ b/components/mizuRoute @@ -0,0 +1 @@ +Subproject commit 362bee329bd6bf1fd45c8f36e006b9c4294bb8ca diff --git a/components/mosart b/components/mosart new file mode 160000 index 0000000000..330574fbd8 --- /dev/null +++ b/components/mosart @@ -0,0 +1 @@ +Subproject commit 330574fbd8a4810b7a168175690cbf7e1a7f6dab diff --git a/components/rtm b/components/rtm new file mode 160000 index 0000000000..6899b55816 --- /dev/null +++ b/components/rtm @@ -0,0 +1 @@ +Subproject commit 6899b55816ee4d9b7cf983d74ba2997b97a13c4d diff --git a/doc/ChangeLog b/doc/ChangeLog index 761cfae2d3..e57931b4cd 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,28401 @@ =============================================================== +Tag name: cam6_4_070 +Originator(s): patcal, nusbaume +Date: 22 February 2025 +One-line Summary: Pertlim fix for MPAS +Github PR URL: https://github.com/ESCOMP/CAM/pull/1114 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Closes #1109 - MPAS-A Pertlim usage is only implemented for ideal initial states + +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: jtruesdal + +List all files eliminated: N/A + +List all files added and what they do: + +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480_pertlim/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480_pertlim/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480_pertlim/user_nl_clm + - Add new MPAS pertlim regression test files. + +List all existing files that have been modified, and describe the changes: + +M src/dynamics/mpas/dyn_comp.F90 + - Allow initial state perturbations with MPAS when reading from the ncdata file. + +M cime_config/testdefs/testlist_cam.xml + - Add new MPAS pertlim regression test files. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failures due to HEMCO not having reproducible results (issues #1018 and #856) + +ERS_D_Ln9.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480_pertlim (Overall: DIFF) + - New test (so no baselines yet) + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: ALL PASS + +izumi/gnu/aux_cam: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: b4b + +=============================================================== +=============================================================== + +Tag name: cam6_4_069 +Originator(s): peverwhee +Date: 20 February 2025 +One-line Summary: Update externals to match beta05; update git-fleximod +Github PR URL: https://github.com/ESCOMP/CAM/pull/1219 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Resolve issue #1213 - Update externals to match alpha05c + +Resolve issue #1258 - share1.1.9 requires change in cam_mpas_subdriver.F90 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +.github/workflows/fleximod_test.yaml + - update fleximod workflow to include check that the checked out externals + match what is expected + +.gitmodules + - update to the following externals: + - ccs_config_cesm1.0.19 + - ctsm5.3.01i7 + - mosart1.1.07 + - cismwrap_2_2_005 + - rtm1_0_84 + - cesm-coupling.n03_v2.2.0 (MizuRoute) + - cime6.1.58 + - cmeps1.0.33 + - share1.1.9 + - add CUPiD external + +.lib/git-fleximod/* + - update git-fleximod to 0.9.4 + +cime_config/testdefs/testlist_cam.xml + - add new ERR test (izumi/gnu/cam7 configuration) to fully test resubmit logic + +src/dynamics/mpas/driver/cam_mpas_subdriver.F90 + - update to comply with new shr_sys_abort interface + +cime/ +share/ +components/cism +components/clm +components/cmeps +components/mizuRoute +components/mosart +components/rtm +tools/CUPiD + - submodule updates + +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 (Overall: NLFAIL) +ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: NLFAIL) +ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa (Overall: NLFAIL) +ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: NLFAIL) +ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) +ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: NLFAIL) +SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: NLFAIL) +SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: NLFAIL) +SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (Overall: NLFAIL) +SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: NLFAIL) +SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: NLFAIL) +SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: NLFAIL) +SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: NLFAIL) +SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: NLFAIL) +SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: NLFAIL) +SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: NLFAIL) +SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: NLFAIL) +- updated CLM namelist variable 'paramfile' + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) +- pre-existing failures due to HEMCO not having reproducible results (issues #1018 and #856) + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failures due to build-namelist error requiring CLM/CTSM external update + +derecho/nvhpc/aux_cam: +ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: NLFAIL) +- updated CLM namelist variable 'paramfile' + +izumi/nag/aux_cam: all PASS + +izumi/gnu/aux_cam: +ERR_D_Ln9.ne3pg3_ne3pg3_mg37.FLTHIST.izumi_gnu.cam-outfrq9s.GC.aux_cam_gnu_20250220125036 (Overall: DIFF) +- new test; does not have baselines to compare to + +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.FLTHIST.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) +ERS_Ln9_P24x1.mpasa480_mpasa480.F2000climo.izumi_gnu.cam-outfrq9s_mpasa480 (Overall: NLFAIL) +SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) +- updated CLM namelist variable 'paramfile' + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: b4b + +=============================================================== + +Tag name: cam6_4_068 +Originator(s): eaton +Date: 19 February 2025 +One-line Summary: remove Eulerian dycore; fix fire emissions +Github PR URL: https://github.com/ESCOMP/CAM/pull/1215 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Resolve issue #1170 - Remove Eulerian dycore from cam_development + +Resolve issue #1148 - Update fire_emissions_factors in hist_trop_strat_vbsfire_cam6 usecase + +Describe any changes made to build system: +. remove option to build 'eul' dycore + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: +. change value of fire_emis_factors_file to + lnd/clm2/firedata/fire_emission_factors_78PFTs_c20240624.nc + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all files eliminated: + +bld/namelist_files/use_cases/dabi_p2004.xml +. only set up for Eul dycore. + +bld/scripts/remapfv2eul.ncl +. only used by SCAM w/ Eulerian dycore. + +src/advection/* +. The SLT advection code was only being used by the Eulerian dycore. + +src/dynamics/eul/* +. remove Eulerian dycore code. + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bld/build-namelist +. remove code specific to eul dycore + +bld/configure +. remove eul as a valid value for -dyn. +. remove code specific to the eul dycore. +. remove src/advection/slt/ and src/dynamics/eul/ from Filepath +. remove setting cpp macros PTRM, PTRN, PTRK + +bld/config_files/definition.xml +. remove eul as valid value for dyn +. remove definitions for trm, trn, trk + +bld/config_files/horiz_grid.xml +. remove eul grid specifications + +bld/namelist_files/namelist_definition.xml +. remove variables eul_* +. remove variables in group spmd_dyn_inparm + +bld/namelist_files/namelist_defaults_cam.xml +. remove defaults for eul dycore +. remove unused vars: bndtvdms, bndtvoxid, bndtvsox, caer_emis + +bld/namelist_files/use_cases/held_suarez_1994.xml +. remove eul specific settings + +bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml +. change value of fire_emis_factors_file to + lnd/clm2/firedata/fire_emission_factors_78PFTs_c20240624.nc + +cime_config/buildcpp +. remove the translations for the Eulerian atm_grid values, e.g., CESM + specified T5 but CAM's configure expected 8x16. + +cime_config/config_compsets.xml +. remove science_support for Gaus grids from FDABIP04, FHS94, and + all FSCAM* compsets +. remove FDABIP04 (_CAM%DABIP04_) +. In the future new tests will be added for FSCAM* compsets using SE + dycore. + +cime_config/config_component.xml +. remove eul as valid value for CAM_DYCORE +. remove modifier %DABIP04 used for FDABIP04 compset + +cime_config/testdefs/testlist_cam.xml +. remove all tests for FDABIP04. They are all set up for Gaussian grids. +. remove all tests on a Gaussian grid. + +cime_config/testdefs/testmods_dirs/cam/ghgrmp_e8/user_nl_cam +. remove setting for eul_divdampn=1. + +src/control/cam_budget.F90 +src/control/history_scam.F90 +src/control/scamMod.F90 +. remove dycore_is('EUL') from conditionals + +src/control/cam_history_support.F90 +. adjust comment to indicate that the Gauss grid is no longer supported. + +src/control/ncdio_atm.F90 +. remove comment about eulerian dycore. + +src/control/cam_control_mod.F90 +. update comment (all dycores are now non-Eulerian). + +src/dynamics/se/dycore/interpolate_mod.F90 +. remove old comment + +src/physics/cam/cam_diagnostics.F90 +src/physics/cam/physpkg.F90 +src/physics/cam7/physpkg.F90 +. remove dycore_is('EUL') from conditional(s) + +src/physics/cam/geopotential.F90 +src/physics/cam/physics_types.F90 +src/physics/camrt/radiation.F90 + . remove old comment(s) for EUL + +src/physics/cam/gw_movmtn.F90 +. add missing _r8 at line 488 + +src/physics/simple/physpkg.F90 +. remove old comment +. remove dycore_is('EUL') from conditional + +src/utils/cam_grid_support.F90 +. remove 'EUL' case and remove old comment + +src/utils/cam_pio_utils.F90 +src/utils/spmd_utils.F90 +. remove old comment(s) + +test/system/TR8.sh +. remove filepaths for eul dycore and advection. +. fix expression at line 33 which should be incrementing rc, not just + setting it with the current value from the carma directory. + +tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_Create_field_Master_List.ncl +tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_ERAI.csh +tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90-EXTEND +tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90-ORIG +tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_procedures.ncl +tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.stub +tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC.ncl +tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90 +tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_extract_analyses_info.ncl +tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_Create_field_Master_List.ncl +tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_se_procedures.ncl +tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/MAKEIC.stub +tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/MAKEIC.f90 +tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_extract_analyses_info.ncl +. remove references to EUL dycore + +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 failures due to HEMCO not having reproducible results (issues #1018 and #856) + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failures due to build-namelist error requiring CLM/CTSM external update + +derecho/nvhpc/aux_cam: All PASS + +izumi/nag/aux_cam: + +ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) +- missing namelist dyn_eul_inparm + +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. Compset FCfireHIST has answer + changes due to updating fire_emis_factors_file. This compset isn't tested + in aux_cam. + +=============================================================== +=============================================================== + +Tag name: cam6_4_067 +Originator(s): eaton +Date: 15 February 2025 +One-line Summary: Remove SP-CAM +Github PR URL: https://github.com/ESCOMP/CAM/pull/1217 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Resolve #1171 - Remove SP-CAM from cam_development + +Describe any changes made to build system: +. remove spcam build options + +Describe any changes made to the namelist: +. remove spcam namelist options + +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: +doc/ReleaseNotes +. This file hasn't been updated since cam5.4. Put this information + somewhere else. + +src/physics/cam/spcam_drivers.F90 +src/physics/spcam/* +src/physics/spcam/crm/* +src/physics/spcam/crm/ADV_MPDATA/* +src/physics/spcam/crm/CLUBB/* +src/physics/spcam/crm/MICRO_M2005/* +src/physics/spcam/crm/MICRO_SAM1MOM/* +src/physics/spcam/crm/SGS_CLUBBkvhkvm/* +src/physics/spcam/crm/SGS_TKE/* +src/physics/spcam/ecpp/* +. remove all SPCAM source and drivers + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bld/build-namelist +. remove dependencies on spcam + +bld/config_files/definition.xml +. remove 'phys' options spcam_sam1mom and spcam_m2005 +. remove 'microphys' options spcam_sam1mom and spcam_m2005 +. remove 'macrophys' options spcam_sam1mom and spcam_m2005 +. remove 'pbl' options spcam_sam1mom and spcam_m2005 +. remove parameters 'spcam_clubb_sgs', 'spcam_nx', 'spcam_ny', 'spcam_nz', + 'spcam_dx', 'spcam_dt' + +bld/configure +. remove -phys options spcam_sam1mom and spcam_m2005 +. remove commandline options -spcam_clubb_sgs, -spcam_nx, -spcam_ny, + -spcam_dx, -spcam_dt +. remove code paths for spcam: + src/physics/spcam/ + src/physics/spcam/crm/ + src/physics/spcam/crm/ADV_MPDATA/ + src/physics/spcam/crm/MICRO_SAM1MOM/ + src/physics/spcam/crm/MICRO_M2005/ + src/physics/spcam/crm/CLUBB/ + src/physics/spcam/crm/SGS_CLUBBkvhkvm/ + src/physics/spcam/crm/SGS_TKE/ + src/physics/spcam/ecpp/ + +bld/namelist_files/namelist_defaults_cam.xml +. remove dependencies on phys, microphys, macrophys, and pbl attributes + spcam_sam1mom and spcam_m2005 +. remove dependencies on spcam_clubb_sgs attribute + +bld/namelist_files/namelist_definition.xml +. remove SPCAM_sam1mom and SPCAM_m2005 as valid values for microp_scheme, + shallow_scheme, and eddy_scheme + +cime_config/config_component.xml +. remove physics options %SPCAMS, %SPCAMCLBS, %SPCAMM, %SPCAMCLBM + +cime_config/config_compsets.xml +. remove F2000Nuopc - not used +. remove QSPCAMS, QPSPCAMM, FSPCAMM, FSPCAMS +. remove FSPCAMCLBS, FSPCAMCLBM +. remove SPCAM settings for NTHRDS_[ATM,CPL,ESP,GLC,ICE,LND,OCN,ROF,WAV] + +cime_config/config_pes.xml +. remove settings for SPCAM* + +cime_config/testdefs/testlist_cam.xml +. remove tests for SPCAM* + +src/chemistry/modal_aero/aero_model.F90 +src/physics/cam/cloud_diagnostics.F90 +src/physics/cam/cloud_fraction.F90 +src/physics/cam/conv_water.F90 +src/physics/cam/convect_deep.F90 +src/physics/cam/convect_shallow.F90 +src/physics/cam/diffusion_solver.F90 +src/physics/cam/microp_driver.F90 +src/physics/cam/ndrop.F90 +src/physics/cam/phys_control.F90 +src/physics/cam/physpkg.F90 +src/physics/cam/pkg_cldoptics.F90 +src/physics/cam/vertical_diffusion.F90 +. remove dependecies on SPCAM_sam1mom and SPCAM_m2005 + +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 failures due to HEMCO not having reproducible results (issues #1018 and #856) + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failures due to build-namelist error requiring CLM/CTSM external update + +derecho/nvhpc/aux_cam: All PASS + +izumi/nag/aux_cam: All PASS + +izumi/gnu/aux_cam: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam6_4_066 +Originator(s): fvitt +Date: 14 Feb 2025 +One-line Summary: Limit extraneous log file messages from aerosol wet deposition +Github PR URL: https://github.com/ESCOMP/CAM/pull/1228 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Ignore the insignificant negative values produced by aerosol wet deposition module. + Report the larger (possibly significant) negative values in the log file and abort + when DEBUG is TRUE. + Issue #1132 -- Extraneous output to cesm.log + +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/aerosol/wetdep.F90 + - limit log messages as described above + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + FAIL SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_4_065_intel: DIFF + - pre-existing failures due to HEMCO not having reproducible results (issues #1018 and #856) + + FAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie SETUP + FAIL SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SETUP + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update + +derecho/nvhpc/aux_cam: All PASS + +izumi/nag/aux_cam: All PASS + +izumi/gnu/aux_cam: + FAIL ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s + - pre-existing failure introduced in cam6_4_065 + +Summarize any changes to answers: Bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_4_065 +Originator(s): cacraig +Date: Feb 11, 2025 +One-line Summary: ZM CCPP'ization round 4 (completes CCPP conversion of ZM) + +Github PR URL: https://github.com/ESCOMP/CAM/pull/1218 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Convert ZM to CCPP and move into atmospheric_physics github repo: https://github.com/ESCOMP/CAM/issues/873 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - Removed zmconv_org namelist as that partially implemented capability has been removed + +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, jimmielin + +List all files eliminated: N/A +D src/physics/cam/wv_sat_methods.F90 +D src/physics/cam/wv_saturation.F90 +D src/utils/error_messages.F90 +D src/utils/namelist_utils.F90 + - Moved to atmospheric_physics (and currently reside in the to_be_ccppized directory) + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M .gitmodules + - update atmospheric_physics to bring in ZM changes + +M bld/build-namelist +M bld/config_files/definition.xml +M bld/configure +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - remove zmconv_org namelist + +M src/physics/cam/cloud_fraction.F90 + - moved cldfrc_fice to atmospheric_physics and ccppized + +M src/physics/cam/clubb_intr.F90 + - removed difzm declarations as no longer needed + +M src/physics/cam/convect_shallow.F90 +M src/physics/cam/macrop_driver.F90 +M src/physics/cam/physpkg.F90 +M src/physics/cam/rk_stratiform.F90 +M src/physics/cam/zm_conv_intr.F90 +M src/physics/cam7/physpkg.F90 +M src/physics/simple/physpkg.F90 + - various mods to get this to work with the routines that are ccppized + +M src/utils/cam_ccpp/ccpp_constituent_prop_mod.F90 + - Add routine: + ccp_set_standard_name to set constituent's standard name + ccp_is_dry to return whether species is dry + ccp_set_dry to set constituent's dry property based on what is passed in + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: all BFB, except: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results (issues #1018 and #856) + + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update + +derecho/nvhpc/aux_cam: BFB + +izumi/nag/aux_cam: BFB + +izumi/gnu/aux_cam: + ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: FAIL) details: + - New failure, but since SPCAM is being removed(PR 1217) will create this new pre-existing failure + +=============================================================== +=============================================================== + +Tag name: cam6_4_064 +Originator(s): sjsprecious, huebleruwm +Date: Feb 10, 2025 +One-line Summary: Fix broken GPU tests for CLUBB code +Github PR URL: https://github.com/ESCOMP/CAM/pull/1226 + +Purpose of changes (include the issue number and title text for each relevant +GitHub issue): + +This PR fixes the broken ERS tests due to the recent GPU changes of CLUBB code +(PR #1175). + +Note that this PR need a new ccs_config tag from ESMCI/ccs_config_cesm#204 to +complete this PR. + +Closes #1220 - GPU test fails restart comparison + +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 + - Update ccs_config submodule to ccs_config_cesm1.0.21 (needed for test fix) + +M src/physics/cam/clubb_intr.F90 + - Move variables from OpenACC create call to copy call to fix restart test. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results (issues #1018 and #856) + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update + +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (Overall: DIFF) + - Missed baseline update from previous CAM tag (cam6_4_063) + +derecho/nvhpc/aux_cam: + +ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: DIFF) + - Expected change in baseline answers. + +izumi/nag/aux_cam: ALL PASS + +izumi/gnu/aux_cam: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam6_4_063 +Originator(s): cacraig, PeterHjortLauritzen +Date: Feb 9, 2025 +One-line Summary: Update namelist settings for beta06 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1252 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Namelist changes for CAM7: https://github.com/ESCOMP/CAM/issues/1251 + - Need new dust-related namelist settings on by default: https://github.com/ESCOMP/CAM/1249 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - Change namelist settings for seasalt_emis_scale, clubb_c8, dust_emis_method and dust_emis_fact + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: PeterHjortLauritzen, adamrher, ekluzek + +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/namelist_defaults_cam.xml + - Change namelist settings for seasalt_emis_scale, clubb_c8, dust_emis_method and dust_emis_fact + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.QPLT.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.QPMT.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (Overall: DIFF) details: + - All CAM7 runs will have answer changes (NLCOMP differences for these runs as well) + +derecho/nvhpc/aux_cam: + ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: FAIL) + - pre-existing failure -- issue #1220 + +izumi/nag/aux_cam: All BFB + +izumi/gnu/aux_cam: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.FLTHIST.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPLT.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPMT.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - All CAM7 runs will have answer changes (NLCOMP differences for these runs as well) + +=============================================================== + +=============================================================== + +Tag name: cam6_4_062 +Originator(s): juliob, cacraig, PeterHjortLauritzen +Date: Feb 7, 2025 +One-line Summary: Phase 2 of GW development +Github PR URL: https://github.com/ESCOMP/CAM/pull/1117 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Continuing development of gravity wave parameterization (//github.com/ESCOMP/CAM/issues/1115) + - Added vorticity calculation to SE dycore. Vorticity is passed to the gravity wave (GW) scheme in + model physics to provide a possible source for ‘moving mountain’ GW, i.e., low-phase speed GW forced + by atmospheric circulations. This provides another forcing option, in addition to boundary layer + momentum flux implemented earlier. Vorticity anomalies as sources for GW have been proposed by other + researchers in published papers. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - Added the following namelist options + - use_gw_rdg_resid + - effgw_movmtn_pbl + - movmtn_source + - movmtn_psteer + - movmtn_plaunch + - effgw_rdg_resid + +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, PeterHjortLauritzen + +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/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - added new GW namelist settings (see above) + +M src/dynamics/se/dp_coupling.F90 +M src/dynamics/se/dyn_comp.F90 +M src/dynamics/se/gravity_waves_sources.F90 +M src/physics/cam/gw_common.F90 +M src/physics/cam/gw_drag.F90 +M src/physics/cam/gw_movmtn.F90 +M src/physics/cam/gw_rdg.F90 + - See description listed above + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.QPLT.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.QPMT.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa (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: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - Answer changes expected for CAM7 runs + +derecho/nvhpc/aux_cam: + ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: FAIL) + - pre-existing failure -- issue #1220 + +izumi/nag/aux_cam: All BFB + +izumi/gnu/aux_cam: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.FLTHIST.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPLT.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPMT.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - Answer changes expected for CAM7 runs + +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): new climate when GW namelists are set + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + - Simulations were made by Julio Bacmeister and were presented at AMWG + - Dave Lawrence presented results to the SCC at their January meeting + +=============================================================== + +=============================================================== + +Tag name: cam6_4_061 +Originator(s): liyptardis, PeterHjortLauritzen, cacraig +Date: Feb 6, 2025 + +One-line Summary: fix heating depth bug for gravity wave parameterization +Github PR URL: https://github.com/ESCOMP/CAM/pull/1232 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Gravity wave scheme fails to catch the right maximum latent heating rate and convective top from the ZM scheme. + This PR fixes that isuue. (Github issue #1229) + +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, liyptardis + +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/gw_convect.F90 + - fix heating depth + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update + + ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.QPLT.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.QPMT.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa (Overall: DIFF) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (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: + 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: + 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.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.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.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (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_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - Expect baseline differences + +derecho/nvhpc/aux_cam: + ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: FAIL) + - pre-existing failure -- issue #1220 + +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.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (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: + ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) details: + ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) details: + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (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_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (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_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (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: + - Expect baseline differences + + +izumi/gnu/aux_cam: + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.FLTHIST.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPLT.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPMT.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x2.f45_f45_mg37.QPWmaC6.izumi_gnu.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - Expect baseline differences + +=============================================================== +=============================================================== + +Tag name: cam6_4_060 +Originator(s): klindsay, PeterHjortLauritzen, cacraig +Date: Feb 5, 2025 +One-line Summary: Preserve constant dry mixing ratios in gw and vertical diffusion code + +Github PR URL: Preserve constant dry mixing ratios in gw_drag and vertical diffusion code (https://github.com/ESCOMP/CAM/pull/1234) + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Keith Lindsay's modifications for preservation of dry constant mixing ratios. (Github issue #1233) + +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/physics/cam/gw_drag.F90 +M src/physics/cam/vertical_diffusion.F90 + - changes to preserve dry mixing ratios + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update + + 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: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa (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: + 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: + 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.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.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (Overall: DIFF) details: + SMS_D_Ln9.T42_T42.FSCAMARM97.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_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.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - expect answer changes for most regression tests + +derecho/nvhpc/aux_cam: + ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: FAIL) details: + - expect answer changes for most regression tests + +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.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (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_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: + - expect answer changes for most regression tests + +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.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.FLTHIST.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x2.f45_f45_mg37.QPWmaC6.izumi_gnu.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ln9_P24x1.mpasa480_mpasa480.F2000climo.izumi_gnu.cam-outfrq9s_mpasa480 (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.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: + - expect answer changes for most regression tests + +=============================================================== +=============================================================== + +Tag name: cam6_4_059 +Originator(s): adamrher, PeterHjortLauritzen, cacraig +Date: Feb 4, 2025 +One-line Summary: cloud frac bug in nucleate_ice_cam.F90 +Github PR URL: issue 1212 bug fix (cloud frac ice+liquid): https://github.com/ESCOMP/CAM/pull/1230 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - ice cloud fraction not set correctly (set to ice+liquid but should only be ice). (Github issue #1212) + +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/physics/cam/nucleate_ice_cam.F90 + - Fix ice cloud fraction + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update + + 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.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa (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.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) 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: + 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: + 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: FAIL) 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.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (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_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: + - Changes expected due to bug fix + +derecho/nvhpc/aux_cam: + ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: FAIL) details: + - Changes expected due to bug fix + +izumi/nag/aux_cam: + 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: + - Changes expected due to bug fix + +izumi/gnu/aux_cam: + ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.FLTHIST.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x2.f45_f45_mg37.QPWmaC6.izumi_gnu.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ln9_P24x1.mpasa480_mpasa480.F2000climo.izumi_gnu.cam-outfrq9s_mpasa480 (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.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + - Changes expected due to bug fix + +=============================================================== +=============================================================== + +Tag name: cam6_4_058 +Originator(s): PeterHjortLauritzen, adamrher, bstephens82, jimmielin, nusbaume +Date: Jan 31 2025 +One-line Summary: Fix Exner bug in CLUBB interface and change CLUBB namelist +Github PR URL: https://github.com/ESCOMP/CAM/pull/1231 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +The computation of the Exner function in the CLUBB interface code currently passes an incorrect version to the PBL utilities. +The PBL utilities expect the "Stull" definition of the Exner function rather than the traditional "atmospheric" Exner function. +(Github issue #1222) + +The CLUBB group has recommended a namelist change to address this issue. +(Github issue #1208) + +Snapshots of tphysbc/tphysac subroutine-level variables are always in the "after" state for both tapes +(Github issue #1241) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +M bld/namelist_files/namelist_defaults_cam.xml + - Turn off 'clubb_l_min_wp2_from_corr_wx' option in CLUBB + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not evaluated + +Code reviewed by: cacraigucar + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M src/physics/cam/cam_snapshot.F90 + - Switch to correct tape for tphysac/tphysbc snapshot + +M src/physics/cam/clubb_intr.F90 + - Replace CLUBB exner with "Stull" Exner, which is what is actually expected. + +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. + +NLCOMP and baseline failures for all applications using CLUBB. + +derecho/intel/aux_cam: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update + +derecho/nvhpc/aux_cam: + +ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: FAIL) + - pre-existing failure -- issue #1220 + +izumi/nag/aux_cam: + +All non-CAM6/CAM7 tests pass (CAM6 and CAM7 differences expected) + +izumi/gnu/aux_cam: + +All non-CAM6/CAM7 tests pass (CAM6 and CAM7 differences expected) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam6_4_057 +Originator(s): brianpm, eaton, nusbaume +Date: Jan 29 2025 +One-line Summary: Restore spectral scaling to RRTMGP +Github PR URL: https://github.com/ESCOMP/CAM/pull/1194 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +resolve issue #1193 - Restore spectral scaling to RRTMGP + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not evaluated + +Code reviewed by: peverwhee + +List all files eliminated: none + +List all files added and what they do: + +src/physics/rrtmgp/rad_solar_var.F90 +. compute scale factors for solar irradiance based on input dataset + +List all existing files that have been modified, and describe the changes: + +bld/build-namelist +. change default setting of solar_htng_spctrl_scl to true for rrtmgp + +src/physics/rrtmgp/radconstants.F90 +. add module data band2gpt_sw and set using kdist_sw%get_band_lims_gpoint() + +src/physics/rrtmgp/radiation.F90 +. radiation_init + - add call to rad_solar_var_init +. radiation_tend + - replace code that scales the solar source based on internal RRTMGP + spectral distribution by a scaling based on distribution from the + solar_irrad_data_file. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.QPLT.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.QPMT.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa (Overall: DIFF) +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (Overall: DIFF) +SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) + - expected NLCOMP (solar_htng_spctrl_scl) and baseline answer changes due to restored RRTMGP spectral scaling. + + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update + +derecho/nvhpc/aux_cam: + +ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: FAIL) + - pre-existing failure -- issue #1220 + +izumi/nag/aux_cam: ALL PASS + +izumi/gnu/aux_cam: + +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.FLTHIST.izumi_gnu.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPLT.izumi_gnu.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPMT.izumi_gnu.cam-outfrq9s (Overall: DIFF) +SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: DIFF) + - expected NLCOMP (solar_htng_spctrl_scl) and baseline answer changes due to restored RRTMGP spectral scaling. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam6_4_056 +Originator(s): fvitt +Date: 16 Jan 2025 +One-line Summary: Nitrogen depostion fluxes to surface models +Github PR URL: https://github.com/ESCOMP/CAM/pull/1216 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Change logical determinations on how to set nitrogen deposition fluxes which are sent to + surface models through the NUOPC mediator. This sets the nitrogen deposition fluxes to + prescribed CDEP input stream fluxes if corresponding namelist options are set. Otherwise, + the nitrogen deposition fluxes set to chemistry computed fluxes if the chemistry is capable + of providing the fluxes. Deprecated ndep_list option in drv_flds_in has been removed. + (Github issue #1196) + + Currently there are no SSP scenario type compsets in CESM3 that use CAM atmosphere component. + Therefore, the specifications of the NDEP stream files for the SSP compsets are carried forward. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + + Removed ndep_list drv_flds_in namelist variable + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: brian-eaton, 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/build-namelist + - change how default ndep_stream namelist options are set + . check if chemistry is capable of producing nitrogen deposition fluxes + . set defaults only if not simple physics nor aqua-planet configuration + . pass sim_year to add_default to select appriate stream_ndep settings + +M bld/namelist_files/namelist_defaults_cam.xml + - add default ndep_stream namelist settings + +M bld/namelist_files/namelist_definition.xml + - remote deprecated ndep_list namelist variable + - updates to stream_ndep_* namelist descriptions + +M bld/namelist_files/use_cases/1850_cam_lt.xml +M bld/namelist_files/use_cases/1850_cam_mt.xml +M bld/namelist_files/use_cases/2010_cam6.xml +M bld/namelist_files/use_cases/hist_cam_lt.xml +M bld/namelist_files/use_cases/hist_cam_mt.xml +M bld/namelist_files/use_cases/sd_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml + - added sim_year + +M bld/namelist_files/use_cases/hist_cam6.xml + - changed sim_year to "1850-2015" + +M bld/namelist_files/use_cases/2010_geoschem.xml +M bld/namelist_files/use_cases/hist_geoschem.xml +M bld/namelist_files/use_cases/hist_geoschem_nudged.xml + - added sim_year + - removed deprecated ndep_list + +M bld/namelist_files/use_cases/2000_geoschem.xml +M bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +M bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml +M bld/namelist_files/use_cases/hist_geoschem.xml +M bld/namelist_files/use_cases/hist_geoschem_nudged.xml +M bld/namelist_files/use_cases/hist_trop_strat_nudged_cam6.xml +M bld/namelist_files/use_cases/hist_trop_strat_vbsext_cam6.xml +M bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml +M bld/namelist_files/use_cases/sd_trop_strat2_cam6.xml +M bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml +M bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml + - removed deprecated ndep_list + +M cime_config/buildnml + - remove the use of CAM_STREAM_NDEP* xml vars to set stream_ndep* namelist options + +M cime_config/config_component.xml + - remove CAM_STREAM_NDEP* xml vars + +M src/chemistry/geoschem/chemistry.F90 +M src/chemistry/pp_none/chemistry.F90 +M src/chemistry/pp_terminator/chemistry.F90 + - add chem_has_ndep_flx flag -- set to .FALSE. for these chem pckgs + +M src/chemistry/mozart/chemistry.F90 + - add chem_has_ndep_flx flag + - add check for prescribed nitrogen depostion fluxes + +M src/chemistry/mozart/mo_chm_diags.F90 + - check for NOy and NHx species in chemistry to determine if + chemistry can produce nitrogen deposition fluxes + +M src/control/camsrfexch.F90 + - allocate cam_out nitro dep flx arrays only if not simple phys and not aqua-planet + +M src/control/runtime_opts.F90 + - invoke stream_ndep_readnl sooner in the initialization phase -- from read_namelist + +M src/cpl/nuopc/atm_import_export.F90 + - set out going ndep fluxes only if not simple physics and not aqua-planet + - set out going ndep fluxes to prescribed ndep stream fields, otherwise, + set chemistry computed fluxes if available. + +M src/cpl/nuopc/atm_stream_ndep.F90 + - add readnl routine -- seperated from init routine which can be invoked from + runtime_opts -- earlier in initialization + - set default use_ndep_stream flag to .false. + +M src/physics/cam/cam_diagnostics.F90 + - add 'a2x_NOYDEP' and 'a2x_NHXDEP' history fields + +M src/utils/srf_field_check.F90 + - removed active_Faxa_nhx and active_Faxa_noy routine flags which were not useful + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + FAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + FAIL SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update + + 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.ne30pg3_ne30pg3_mg17.QPLT.derecho_intel.cam-outfrq3s_cosp + NLFAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.QPMT.derecho_intel.cam-outfrq9s + NLFAIL ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.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_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s + - expected namelist compare failures due to removal of stream_ndep namelist opts + + DIFF ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa + DIFF ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + DIFF SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + DIFF SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase + DIFF SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust + 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_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + DIFF SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - expected differences due to currections to ndep fluxes + +derecho/nvhpc/aux_cam: + + FAIL ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default COMPARE_base_rest + - pre-existing failure -- issue #1220 + +izumi/nag/aux_cam: + + 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_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 + - expected namelist compare failures due to removal of stream_ndep namelist opts + +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.QPLT.izumi_gnu.cam-outfrq9s + NLFAIL ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPMT.izumi_gnu.cam-outfrq9s + NLFAIL ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s + NLFAIL ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s + NLFAIL ERP_Ln9_P24x2.f45_f45_mg37.QPWmaC6.izumi_gnu.cam-outfrq9s_mee_fluxes + 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 + - expected namelist compare failures due to removal of stream_ndep namelist opts + + DIFF SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s + - expected differences due to currections to ndep fluxes + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_4_055 +Originator(s): eaton +Date: 13 January 2025 +One-line Summary: Add QPLT and QPMT compsets, plus misc. +Github PR URL: https://github.com/ESCOMP/CAM/pull/1203 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Issue #814 - Introduce QPC7 and possibly QPS7 aquaplanet compsets + - Analogous to FLT and FMT compset names, create QPLT and QPMT compsets. + - Open new issue to address QPS7. + - The new aquaplanet configurations use '-chem none' to eliminate the + aerosols. This is much faster and requires much less memory than a + configuration that leaves the default chemistry in place and removes + aerosols by zeroing the initial concentrations and emission sources. + +Issue #1159 - Prealpha tests exceeding wallclock + - increased time limit to 20 minutes for these prealpha tests: + ERP_Ln9.f09_f09_mg17.FHIST_BGC.derecho_intel.cam-outfrq9s + ERP_Ln9.f09_f09_mg17.FHIST.derecho_intel.cam-outfrq9s + +Issue #670 - DAE test broken + - ChangeLog indicates that this test has never worked since it was added + in cam6_2_046 (2020-09-01). Test removed. + +Issue #807 - add UT and UQ to cam_diagnostics + - Add UT and UQ. Note that other possible fields mentioned in the issue, + i.e., OMEGA2, OMEGAQ, OMEGAU, and OMEGAV, are already implemented. + OMEGA2 is called OMGAOMGA. + +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: +. add spun up initial files for QPLT compset on ne3pg3 and ne30pg3 grids. + atm/cam/inic/se/QPLT_L58_ne3pg3_c241127.nc + atm/cam/inic/se/QPLT_L58_ne30pg3_c241127.nc + +. add spun up initial files for QPMT compset on ne3pg3 and ne30pg3 grids. + atm/cam/inic/se/QPMT_L93_ne3pg3_c241223.nc + atm/cam/inic/se/QPMT_L93_ne30pg3_c241223.nc + +. add ozone dataset for high top aquaplanet runs + atm/cam/ozone/aquaplanet_ozone_hightop_c20180412.nc + +Describe any substantial timing or memory changes: n/a + +Code reviewed by: cacraig + +List all files eliminated: + +cime_config/testdefs/testmods_dirs/cam/dae/shell_commands +cime_config/testdefs/testmods_dirs/cam/dae/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/dae/user_nl_cpl +test/system/da_cam_no_data_mod.sh +. DAE test removed + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bld/namelist_files/namelist_defaults_cam.xml +. Remove ncdata files for nlev=58 and nlev=93 aquaplanet. Those files are + specified in the aquaplanet_cam7.xml use case file. + +bld/namelist_files/use_cases/aquaplanet_cam7.xml +. use case file for QPLT and QPMT. Same as for QPC6 except: + - set f11vmr=f12vmr=0 to override the non-zero default values from + namelist_defaults_cam.xml. + - set prescribed_aero_file="" and prescribed_aero_specifier="" to + override the default bulk aerosol settings from build-namelist. + - set rad_climate to just make the GHGs radiatively active to override + the default build-namelist setting which includes bulk aerosols. + - Add spun-up IC files. This allows us to remove the ic_ymd attribute + which should not be needed for aquaplanet runs. Removing ic_ymd + enables testing with arbitrary start dates. + - Add ozone dataset for high top aquaplanet configuration + +cime_config/config_component.xml +. CAM_CONFIG_OPTS + - add match for _CAM70.*_SLND_SICE_DOCN%AQP to set '-chem none' +. CAM_NML_USE_CASE + - add match for 2000_CAM70.*_SLND_SICE_DOCN%AQP to use aquaplanet_cam7. + This match will work for both %LT and %MT configs. + +cime_config/config_compsets.xml +. add QPLT = 2000_CAM70%LT_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV +. add QPMT = 2000_CAM70%MT_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + +cime_config/testdefs/testlist_cam.xml +. increase time limit to 20 minutes for these prealpha tests: + ERP_Ln9.f09_f09_mg17.FHIST_BGC.derecho_intel.cam-outfrq9s + ERP_Ln9.f09_f09_mg17.FHIST.derecho_intel.cam-outfrq9s +. remove non-working DAE test +. replace ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s + by ERP_D_Ln9.ne30pg3_ne30pg3_mg17.QPLT.derecho_intel.cam-outfrq3s_cosp +. Add ERP_D_Ln9.ne30pg3_ne30pg3_mg17.QPMT.derecho_intel.cam-outfrq9s +. replace ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp + by ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPLT.izumi_gnu.cam-outfrq9s +. Add ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPMT.izumi_gnu.cam-outfrq9s + +cime_config/testdefs/testmods_dirs/cam/outfrq3s_cosp/shell_commands +. remove "./xmlchange CAM_NML_USE_CASE=UNSET" + +cime_config/testdefs/testmods_dirs/cam/outfrq3s_cosp/user_nl_cam +. add CS_SNOWCERT and CS_SNOWPOSS to fexcl1 + +src/chemistry/mozart/mo_drydep.F90 +. get_landuse_and_soilw_from_file + - restrict the INFO messages to only print from masterproc + +src/physics/cam/cam_diagnostics.F90 +. diag_init_dry + - add addfld call for UT, and corresponding add_default for UT inside the + history_eddy conditional. +. diag_phys_writeout_dry + - add calculation and outfld call for UT +. diag_init_moist + - add addfld call for UQ, and corresponding add_default for UQ inside the + history_eddy conditional. +. diag_phys_writeout_moist + - add calculation and outfld call for UQ + +src/physics/cam/microp_aero.F90 +. microp_aero_run + - add condition that number of bulk aerosols must be > 0 before calling + ndrop_bam_run. + +src/physics/cam/nucleate_ice_cam.F90 +. nucleate_ice_cam_calc + - add conditionals so naer2 array not referenced when there are no + aerosols. + +src/physics/cam/vertical_diffusion.F90 +. vertical_diffusion_init + - fix conditional around add_default call for UFLX and VFLX so those + fields aren't added if they're not computed. + +src/physics/cam7/physpkg.F90 +. tphysbc + - add conditionals so modal aerosol calculations only called when modal + aerosols are present. + +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: + +ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) +- diffs due to changing the test definition (in outfrq3s_cosp) so that the use case file, + aquaplanet_cam6.xml, is no longer ignored. This changes answers. + +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.QPLT.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.QPMT.derecho_intel.cam-outfrq9s (Overall: DIFF) +- There are no baselines for these new tests. + +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.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + +derecho/nvhpc/aux_cam: + +ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: FAIL) +- pre-existing failure -- issue #1220 + +izumi/nag/aux_cam: + +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: +- diffs due to changing the test definition (in outfrq3s_cosp) so that the use case file, + aquaplanet_cam5.xml, is no longer ignored. This changes answers. + +izumi/gnu/aux_cam: + +ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) +- Diff is due to the new diagnostic fields UT and UQ being included in the + test. Otherwise the run is identical with the baseline. + +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPLT.izumi_gnu.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPMT.izumi_gnu.cam-outfrq9s (Overall: DIFF) +- There are no baselines for these new tests. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. Note however that a change in the + test definition for outfrq3s_cosp causes answer changes for tests + using that testmod. + +=============================================================== +=============================================================== + +Tag name: cam6_4_054 +Originator(s): nusbaume +Date: 9 Jan 2025 +One-line Summary: Revert t_sfc limiter in RRTMGP +Github PR URL: https://github.com/ESCOMP/CAM/pull/1211 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +#1188 - Revert t_sfc limiter + - Also updates the CICE tag to fix the original bad temperatures problem. + +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, peverwhee + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M .gitmodules +M components/cice + - Update CICE tag to cesm3_cice6_6_0_6 (Github issue #1185) + +M src/physics/rrtmgp/rrtmgp_inputs.F90 + - Revert t_sfc limiter in RRTMGP (Github PR #1184) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +ALL F-compset answers changed (DIFF) due to the new CICE tag. + +Also any tests with RRTMGP will also have answer changes due +to the removal of the surface temperature limiter. + +derecho/intel/aux_cam: + + All F-compset tests + -NLCOMP and baseline DIFF failures due to the new CICE tag and t_sfc changes + + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failure -- issue #856 + + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + +derecho/nvhpc/aux_cam: + + ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: FAIL) + - pre-existing failure -- issue #1220 + - also had NLCOMP and baseline DIFF failures due to the new CICE tag and t_sfc changes. + +izumi/nag/aux_cam: + + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure -- issue #670 + +izumi/gnu/aux_cam: + + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.FLTHIST.izumi_gnu.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_P24x1.mpasa480_mpasa480.F2000climo.izumi_gnu.cam-outfrq9s_mpasa480 (Overall: DIFF) + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) + - NLCOMP and baseline DIFF failures due to the new CICE tag and t_sfc changes. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: + +=============================================================== +=============================================================== + +Tag name: cam6_4_053 +Originator(s): fvitt +Date: 7 Jan 2025 +One-line Summary: Update CARMA base external tag +Github PR URL: https://github.com/ESCOMP/CAM/pull/1201 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Update CARMA sectional aerosol model base external to tag carma4_09 and update existing CARMA models accordingly + (Update CARMA base external #1181) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - new carma_sulfnuc_method option + +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 + - update carma base tag + +M bld/build-namelist +M bld/namelist_files/namelist_definition.xml + - new carma_sulfnuc_method namelist option + +M cime_config/testdefs/testlist_cam.xml + - adjustments to carma tests + +M cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_test_growth/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_test_passive/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/user_nl_cam + - remove carma_reftfile namelist setting + +M src/physics/cam/carma_flags_mod.F90 + - updates to carma runtime options + +M src/physics/cam/carma_intr.F90 +M src/physics/cam/physpkg.F90 +M src/physics/cam7/physpkg.F90 + - interface changes for including pbuf + +M src/physics/carma/cam/carma_constants_mod.F90 + - add MAXCLDAERDIAG + +M src/physics/carma/cam/carma_intr.F90 + - add "only" to use statements + - add restart routines + - new diags flags + - many other updates needed for the development of trop_strat carma models + +M src/physics/carma/cam/carma_precision_mod.F90 +M src/physics/carma/models/bc_strat/carma_model_mod.F90 +M src/physics/carma/models/cirrus/carma_model_mod.F90 +M src/physics/carma/models/cirrus/growevapl.F90 +M src/physics/carma/models/cirrus_dust/carma_mod.F90 +M src/physics/carma/models/cirrus_dust/carma_model_mod.F90 +M src/physics/carma/models/cirrus_dust/growevapl.F90 +M src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 + - fix end module statements + - include missing real kind specifiers + +M src/physics/carma/models/dust/carma_model_mod.F90 +M src/physics/carma/models/meteor_impact/carma_model_mod.F90 +M src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +M src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 +M src/physics/carma/models/pmc/carma_model_mod.F90 +M src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 +M src/physics/carma/models/sea_salt/carma_model_mod.F90 +M src/physics/carma/models/sulfate/carma_model_mod.F90 +M src/physics/carma/models/test_detrain/carma_model_mod.F90 +M src/physics/carma/models/test_growth/carma_model_mod.F90 +M src/physics/carma/models/test_passive/carma_model_mod.F90 +M src/physics/carma/models/test_radiative/carma_model_mod.F90 +M src/physics/carma/models/test_swelling/carma_model_mod.F90 +M src/physics/carma/models/test_tracers/carma_model_mod.F90 +M src/physics/carma/models/test_tracers2/carma_model_mod.F90 +M src/physics/carma/models/tholin/carma_model_mod.F90 + - update interfaces including optics calculations + - include missing real kind specifiers + +M test/system/TR8.sh + - include physics/carma and subdirectories in the r8 checks + +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 COMPARE_base_rest + - pre-existing failure -- issue #856 + + FAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie SETUP + FAIL SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SETUP + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + +derecho/nvhpc/aux_cam: + FAIL ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default COMPARE_base_rest + - pre-existing failure -- issue #1220 + +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 + - expected differences due to updates to carma base code + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: + CARAM configurations change answers, otherwise bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_4_052 +Originator(s): huebleruwm, nusbaume +Date: 6 Jan 2025 +One-line Summary: clubb_intr GPUization +Github PR URL: https://github.com/ESCOMP/CAM/pull/1175 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Adds OpenACC directives to clubb_intr.F90 to enable GPU offloading of CLUBB. +BFB on CPUs, answer changing (but passes ECT) on GPUs. + +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, katetc, 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/physics/cam/clubb_intr.F90 + - add OpenACC directives for GPU offloading + - add timer calls to evaulate performance + +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: + + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + 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.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + FAIL SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + +derecho/nvhpc/aux_cam: + +ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: FAIL) + - Expected baseline failures due to non-BFB answer changes with new CLUBB GPU-offloading. + +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 + +=============================================================== +=============================================================== + +Tag name: cam6_4_051 +Originator(s): fvitt +Date: 2 Jan 2025 +One-line Summary: Updates to age of air tracers history output +Github PR URL: https://github.com/ESCOMP/CAM/pull/1198 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Changes to age of air output #1197 + . Output age of air tracers mix ratios to history as soon as the tendencies are update, + before the tracers are transported in the time loop + . Rename history field 'AOAMF' as 'AOA1' + +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/physics/cam/aoa_tracers.F90 + - add outfld calls for AOA tracers + - rename 'AOAMF' as 'AOA1' + +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.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + FAIL SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + 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 + + DIFF ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s + DIFF ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa + DIFF ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h + DIFF ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + DIFF SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + DIFF SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase + DIFF SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d + DIFF SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + DIFF SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - expected differences in AOA history fields, otherwise bit-for-bit unchanged + +derecho/nvhpc/aux_cam: All PASS + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure -- issue #670 + + DIFF ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s + DIFF SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + DIFF SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem + - expected differences in AOA history fields, otherwise bit-for-bit unchanged + +izumi/gnu/aux_cam: + DIFF ERP_Ln9_P24x2.f45_f45_mg37.QPWmaC6.izumi_gnu.cam-outfrq9s_mee_fluxes + DIFF SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee + DIFF SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s + - expected differences in AOA history fields, otherwise bit-for-bit unchanged + +Summarize any changes to answers: + Differences in AOA history fields, otherwise bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_4_050 +Originator(s): jimmielin +Date: 31 Dec 2024 +One-line Summary: Implement CCPPized check_energy_chng and check_energy_fix +Github PR URL: https://github.com/ESCOMP/CAM/pull/1180 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- CCPPize check_energy_chng and check_energy_fix (https://github.com/ESCOMP/CAM/issues/1138) + CAM interfaces have been kept in check_energy.F90 instead of a new module because check_tracers is not yet CCPPized, there are other non-CCPPized routines in module, and for compatibility with FV3 external calls +- Save air_composition cp_or_cv_dycore into state snapshot +- Separate out "energy_formula_physics"/"energy_formula_dycore" definitions used in get_hydrostatic_energy from dyn_tests_utils "vcoord" for an eventual change in SIMA. + +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, cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: +- separate out energy formula definitions used in get_hydrostatic_energy from dyn_tests_utils "vcoord" +A src/utils/cam_thermo_formula.F90 + +List all existing files that have been modified, and describe the changes: + +Update atmos_phys external with CCPPized check_energy +M .gitmodules +M bld/configure +M src/atmos_phys + +Save cp_or_cv_dycore in state snapshot +M src/control/cam_snapshot_common.F90 + +New CAM interfaces to CCPPized routines, when available +M src/physics/cam/check_energy.F90 + +Update calls to CCPPized routines, when available +M src/physics/cam/physpkg.F90 +M src/physics/cam/zm_conv_intr.F90 +M src/physics/cam7/physpkg.F90 +M src/physics/simple/physpkg.F90 +M src/physics/spcam/crm_physics.F90 +M src/physics/spcam/spcam_drivers.F90 + +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: + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: PASS) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +derecho/nvhpc/aux_cam: All PASS + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure -- issue #670 + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: B4B + +=============================================================== + +Tag name: cam6_4_049 +Originator(s): peverwhee +Date: 30 December 2024 +One-line Summary: History bugfixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/1163 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- Issue #1149: cam history always chooses first averaging flag when using duplicate fields +- Issue #1150: CAM history erroneously overrides averaging flags for nhtfrq=1 +- Issue #1166: time_bounds array should not be present in history files containing instantaneous output +- Issue #1167: Time shown in history file names is incorrect for instantaneous data +- Issue #1183: Suggested improvement for openfile +- Update git-fleximod to v0.9.3 +- Update archive_baseline.sh modify read permissions on izumi +- Update CIME tag to cime6.1.56 to fix restart issue in CAM + +Describe any changes made to build system: +M bld/namelist_files/use_cases/sd_waccm_sulfur.xml + - Remove bad XML comment line + +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: brian-eaton + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M .gitmodules + - update CIME tag to cime6.1.56 + +M .lib/git-fleximod/* + - updates to move git-fleximod to v0.9.3 + +M src/control/cam_history.F90 + - remove nhtfrq=1 accumulation flag override if sampled_on_subcyle=.true. + - modify list_index routine to optionally check for duplicates/compatibility + - endrun with message including all duplicates found (if flags differ) + - remove time_bounds from instantaneous history files + - override instantaneous file name for monthly files to include full timestep + - also report correct timestamp on inst. files (don't use prev timestamp as + in accumulated files) + +M src/control/cam_history_support.F90 + - add sampled_on_subcycle to field_info object + +M src/physics/cam/cam_diagnostics.F90 +M src/physics/cam/clubb_intr.F90 +M src/physics/cam/hetfrz_classnuc_cam.F90 +M src/physics/cam/macrop_driver.F90 +M src/physics/cam/micro_pumas_cam.F90 +M src/physics/cam/microp_aero.F90 +M src/physics/cam/ndrop.F90 +M src/physics/cam/ndrop_bam.F90 +M src/physics/cam/nucleate_ice_cam.F90 +M src/physics/cam/subcol_SILHS.F90 +M src/physics/cam7/micro_pumas_cam.F90 +M src/physics/cam7/stochastic_emulated_cam.F90 +M src/physics/cam7/stochastic_tau_cam.F90 + - add sampled_on_subcycle=.true. argument to addflds calls for history fields + that are outfld-ed in the macmic loop + +M src/utils/cam_pio_utils.F90 + - move filename logging to before pio call + +M test/system/archive_baseline.sh + - make all baseline files globally readable on izumi + +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: + +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) +ERC_D_Ln9.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator (Overall: DIFF) +ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) +ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) +ERC_D_Ln9.T42_T42_mg17.FDABIP04.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) +ERC_D_Ln9.T42_T42_mg17.FHS94.derecho_intel.cam-outfrq3s_usecase (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.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) +ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa (Overall: DIFF) +ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) +ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined (Overall: DIFF) +ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) +SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep (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_Ld5.f19_f19_mg17.PC4.derecho_intel.cam-cam4_port5d (Overall: DIFF) +SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) +SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_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) +SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (Overall: DIFF) +SMS_D_Ln9.T42_T42.FSCAMARM97.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) +SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) +SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) +SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 (Overall: DIFF) +SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) +SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) +SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) +SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: +SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) +SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) + - fieldlist differences due to removal of time_bounds field from instantaneous file + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +derecho/nvhpc/aux_cam: + +ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: DIFF) + - fieldlist differences due to removal of time_bounds field from instantaneous file + +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.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: +ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (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: +ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) details: +ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) details: +ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: +ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: DIFF) details: +ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: DIFF) details: +PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (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_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (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_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (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: + - fieldlist differences due to removal of time_bounds field from instantaneous file + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure -- issue #670 + +izumi/gnu/aux_cam: + +ERC_D_Ln9.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: DIFF) details: +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: +ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: +ERC_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (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.FLTHIST.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.FHS94.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9_P24x2.f45_f45_mg37.QPWmaC6.izumi_gnu.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: +ERS_Ln9_P24x1.mpasa480_mpasa480.F2000climo.izumi_gnu.cam-outfrq9s_mpasa480 (Overall: DIFF) details: +PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (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_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: DIFF) details: +SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - fieldlist differences due to removal of time_bounds field from instantaneous file + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none + +=============================================================== + +Tag name: cam6_4_048 +Originator(s): jedwards4b, peverwhee +Date: 20 December 2024 +One-line Summary: Timestamp in rpointer name +Github PR URL: https://github.com/ESCOMP/CAM/pull/1147 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +#1146 - Add timestep to rpointer file name +- Updates to externals, nuopc cap, and cam control code to handle timestamp in +rpointer file + +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: brian-eaton + +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 +- update externals for rpointer mods + - cime6.1.49 + - cmeps1.0.32 + - cdeps1.0.61 + - share1.1.6 + - ctsm5.3.016 + +M src/control/cam_initfiles.F90 +- look for new timestamped rpointer file + +M src/control/cam_restart.F90 +- remove unnecessary conditionals for optional variables + +M src/cpl/nuopc/atm_comp_nuopc.F90 +- update variable names coming from coupler + +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: + +ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: NLFAIL) details: +ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: NLFAIL) details: +ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: NLFAIL) details: +ERC_D_Ln9.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator (Overall: NLFAIL) details: +ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: +ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) details: +ERC_D_Ln9.T42_T42_mg17.FDABIP04.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: +ERC_D_Ln9.T42_T42_mg17.FHS94.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: +ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: NLFAIL) details: +ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: +ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: +ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: NLFAIL) details: +ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: +SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep (Overall: NLFAIL) details: +SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: NLFAIL) details: +SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: NLFAIL) details: +SMS_D_Ld5.f19_f19_mg17.PC4.derecho_intel.cam-cam4_port5d (Overall: NLFAIL) details: +SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: +SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: +SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: +SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 (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: + - NL diffs due to CMEPS & CTSM external updates + +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa (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: +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: +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.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.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (Overall: DIFF) details: +SMS_D_Ln9.T42_T42.FSCAMARM97.derecho_intel.cam-outfrq9s (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_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: + - Diffs due to updated CTSM external + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +derecho/nvhpc/aux_cam: +ERS_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_gpu_default (Overall: DIFF) details: + - Diffs due to updated CTSM external + +izumi/nag/aux_cam: izumi tests run 12/21/2024 + +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: NLFAIL) details: +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) details: +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) details: +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) details: +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) details: +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: +ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: +ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: +ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: +ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: +ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: +ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) details: +ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: +ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: +ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: +ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: +ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: +ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: +ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: +ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: +PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: +PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: +PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: +PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: +PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: +PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: +PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: +SMS_D_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: +SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: +SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: NLFAIL) details: +SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) details: +SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) details: +SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: NLFAIL) details: +MS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: +SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) details: +SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: +TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: +TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + - NL diffs due to CMEPS & CTSM external updates + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure -- issue #670 + +izumi/gnu/aux_cam: izumi tests run 12/21/2024 + +ERC_D_Ln9.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: +ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: NLFAIL) details: +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: NLFAIL) details: +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: NLFAIL) details: +ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: +ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: NLFAIL) details: +ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (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: +ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: NLFAIL) details: +ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: NLFAIL) details: +ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: +ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: +ERP_Ln9_P24x2.f45_f45_mg37.QPWmaC6.izumi_gnu.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: +PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: +PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: NLFAIL) details: +PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: NLFAIL) details: +PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: NLFAIL) details: +SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: NLFAIL) details: +SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: NLFAIL) details: +SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: NLFAIL) details: +SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: NLFAIL) details: +SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: NLFAIL) details: +SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: NLFAIL) details: +SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: NLFAIL) details: + - NL diffs due to CMEPS & CTSM external updates + +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.FLTHIST.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: +ERS_Ln9_P24x1.mpasa480_mpasa480.F2000climo.izumi_gnu.cam-outfrq9s_mpasa480 (Overall: DIFF) details: +SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - Diffs due to updated CTSM external + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: answer changes thanks to updated CTSM tag +- ran derecho intel & nvhpc tests on head of cam_development with ctsm5.3.015 vs baselines for +this tag and confirmed that there were no DIFFs + +=============================================================== + +Tag name: cam6_4_047 +Originator(s): jedwards4b, fvitt +Date: 19 November 2024 +One-line Summary: update config component to handle new compset names +Github PR URL: https://github.com/ESCOMP/CAM/pull/1078 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +#1077 - config_component.xml updates needed +- Adds "C" designation for concentration-driven experiments +#1189 - O3 is not invariant +- Updates chemistry use cases for prescribed vs prognosed oxidants +- Removes ISOPNO3 from wet/dry dep lists as it is a short-lived radical +#1191 - remove mct submodule +- Removes MCT submodule + +Describe any changes made to build system: +M cime_config/config_component.xml +- Add new "C" or "E" designation + +Describe any changes made to the namelist: +A bld/namelist_files/use_cases/1850_trop_strat_t4s_cam7.xml +- add new use case + +M bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +M bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml +- remove ISOPNO3 + +M bld/namelist_files/use_cases/hist_trop_strat_t4s_cam7.xml +- renamed from bld/namelist_files/use_cases/hist_trop_strat_ts4_cam7.xml + +M bld/namelist_files/mozart_master_gas_drydep_list.xml +M bld/namelist_files/mozart_master_gas_wetdep_list.xml +- remove ISOPNO3 + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: peverwhee + +List all files eliminated: +D libraries/mct +- remove mct submodule + +List all files added and what they do: +A bld/namelist_files/use_cases/1850_trop_strat_t4s_cam7.xml +- add new use case + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +M bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml +- remove ISOPNO3 + +M bld/namelist_files/use_cases/hist_trop_strat_t4s_cam7.xml +- renamed from bld/namelist_files/use_cases/hist_trop_strat_ts4_cam7.xml + +M cime_config/config_component.xml +- Add new "C" or "E" designation + +M bld/namelist_files/mozart_master_gas_drydep_list.xml +M bld/namelist_files/mozart_master_gas_wetdep_list.xml +- remove ISOPNO3 + +M src/cpl/nuopc/atm_stream_ndep.F90 +- set use_ndep_stream=.false. when stream_ndep_data_filename='UNSET' + +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: + +ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) details: +ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa (Overall: DIFF) details: +ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (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: + - DIFFS and NLCOMP failures because of removal of ISOPNO3 and new "C/E" compset designations + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +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 + +izumi/gnu/aux_cam: + +SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + - DIFFS and NLCOMP failures because of removal of ISOPNO3 and new "C/E" compset designations + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except NL changes + +=============================================================== + +Tag name: cam6_4_046 +Originator(s): sjsprecious +Date: 06 November 2024 +One-line Summary: update GPU regression tests with new XML options +Github PR URL: https://github.com/ESCOMP/CAM/pull/1186 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. GitHub issue: https://github.com/ESCOMP/CAM/issues/1165 + +. As discussed in https://github.com/ESMCI/cime/pull/4687, it is better remove the GPU options from the Python workflow in CIME and use XML files instead to configure a GPU test for CESM. + + The following tags should be brought into CAM together to make the new GPU workflow function properly: + - cmeps1.0.22 or newer + - ccs_config_cesm1.0.8 or newer + - cime6.1.33 or newer + + Once those new tags are merged in, the GPU test definition here (https://github.com/ESCOMP/CAM/blob/cam_development/cime_config/testdefs/testlist_cam.xml#L1493-L1510) needs to be updated accordingly. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: peverwhee + +List all files eliminated: none + +List all files added and what they do: + +. The following files are added to perform a GPU regresesion test with PCOLS=16 and two GPU nodes on Derecho + - cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_default + - shell_commands + - user_nl_cam + - user_nl_clm + +. The following files are added to perform a GPU regresesion test with PCOLS=760 and one GPU node on Derecho + - cime_config/testdefs/testmods_dirs/cam/outfrq9s_gpu_pcols760 + - shell_commands + - user_nl_cam + - user_nl_clm + +List all existing files that have been modified, and describe the changes: + +.gitmodules +. update the tags for the external components + +cime_config/testdefs/testlist_cam.xml +. update the GPU regression tests to use the right setups + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +All tests had differences in the namelist comparision and FIELDLIST field, +otherwise, unless listed below, they were bit-for-bit. + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +derecho/nvhpc/aux_cam: + +A new baseline was generated successfully, and a second test +with that new baseline passed as expected. + +izumi/nag/aux_cam: + +All tests had differences in the namelist comparision and FIELDLIST field, +otherwise, unless listed below, they were bit-for-bit. + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure -- issue #670 + +izumi/gnu/aux_cam: + +All tests had differences in the namelist comparision and FIELDLIST field, +otherwise they were all bit-for-bit. + +CAM tag used for the baseline comparison tests if different than previous +tag: cam6_4_045 + +Summarize any changes to answers: BFB except name anf field list changes. + +=============================================================== + +Tag name: cam6_4_045 +Originator(s): mwaxmonsky +Date: 10/25/2024 +One-line Summary: Start refactoring of vertical diffusion to be CCPPized +Github PR URL: https://github.com/ESCOMP/CAM/pull/1176 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +Start refactoring of vertical diffusion to be CCPPized and outsources solve phase of non-graft decomp solves to atmospheric physics solver. + +Describe any changes made to build system: +- Adds the to_be_ccppized directory in atmospheric_physics to source search path + +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: + +List all files eliminated: +D src/utils/coords_1d.F90 +D src/utils/linear_1d_operators.F90 +- Files were moved to atmospheric_physics + +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 bld/configure +M src/atmos_phys +- Update atmospheric_physics reference and added new atmospheric_physics directory to search path + +M cime_config/config_pes.xml +- Decreasing NTHRDS from 2 to 1 to force single threaded execution as multithreaded execution enables the -smp flag which breaks under OpenMP when running the SE dycore, similar to #1087 + +M src/physics/cam/diffusion_solver.F90 +- Uses new CCPPized interface for decomp that was moved to atmospheric_physics repo to single solve step. + +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: +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + +derecho/nvhpc/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, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): +N/A + +If bitwise differences were observed, how did you show they were no worse +than roundoff? +N/A + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: +N/A + +MSS location of control simulations used to validate new climate: N/A + +URL for AMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== + +Tag name: cam6_4_044 +Originator(s): eaton +Date: 04 November 2024 +One-line Summary: limit surface T to valid range for RRTMGP +Github PR URL: https://github.com/ESCOMP/CAM/pull/1184 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Jim Edwards reported that regression testing of cesm3_0_alpha05a using + the cam6_4_043 tag was encountering failures due to the following error: + + radiation_tend: ERROR: kdist_lw%gas_optics: gas_optics(): array tsfc has values outside range + + t_sfc is computed using input LW surface fluxes from the surface models via: + + t_sfc = sqrt(sqrt(cam_in%lwup(:ncol)/stebol)) + + To work around this problem we have added limiters to keep t_sfc in the + valid range for RRTMGP. Temperatures above the surface are already being + limited to be in RRTMGP's valid range before being passed to the gas + optics code. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: peverwhee, brianpm + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +src/physics/rrtmgp/rrtmgp_inputs.F90 +. limit t_sfc to valid temperature range + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + +derecho/nvhpc/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: cam6_4_043_newnodes_gnu and cam6_4_043_newnodes_nag on izumi + - baselines changed due to node updates between cam6_4_043 and cam6_4_044 + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam6_4_043 +Originator(s): eaton +Date: 25 Oct 2024 +One-line Summary: Make RRTMGP default radiation in CAM7 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1178 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Issue #1143 - turn RRTMGP on by default for CAM7 + some namelist defaults + +. Remove some tests that added rrtmgp to the cam7 configuration. Not + needed since rrtmgp is now the default in cam7. + +. Remove test of old cam7 development configuration (32 levels) which is no + longer needed. + +. Remove 13 month F2000climo test. This was originally created to make + sure we didn't make changes that hurt the performance of our production + configuration for CMIP6 simulations. This is no longer needed. + +. Issue #1154 - Create at least one CAM7 regression test on izumi + - add ERP_D_Ln9.ne3pg3_ne3pg3_mg37.FLTHIST.izumi_gnu.cam-outfrq9s + + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. change default value of seasalt_emis_scale to 0.75 for cam7 (both lt and mt) + This is a cam7 tuning mod from issue #1143 + +. update ubc_file_path for cam7 (lt only) to + atm/cam/chem/ubc/b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensAvg123.cam.h0zm.H2O.1849-2014_c240604.nc + +List any changes to the defaults for the boundary datasets: + +. update ubc_file_path for cam7 (lt only) to + atm/cam/chem/ubc/b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensAvg123.cam.h0zm.H2O.1849-2014_c240604.nc + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig, peverwhee, sjsprecious + +List all files eliminated: + +cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/* +. test removed + +List all files added and what they do: + +cime_config/testdefs/testmods_dirs/cam/outfrq9s_eoy/* +. mods for a test like outfrq9s, but add RUN_STARTDATE="1999-12-31" and + START_TOD="82800" so that the run goes over the end of year boundary. + +List all existing files that have been modified, and describe the changes: + +bld/configure +. set default radiation package for cam7 to rrtmgp + +bld/namelist_files/namelist_defaults_cam.xml +. change default value of seasalt_emis_scale to 0.75 for cam7 (both lt and mt) + This is a cam7 tuning mod from issue #1143 + +bld/namelist_files/use_cases/1850_cam_lt.xml +. update ubc_file_path to + atm/cam/chem/ubc/b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensAvg123.cam.h0zm.H2O.1849-2014_c240604.nc + +cime_config/testdefs/testlist_cam.xml +. These tests which added rrtmgp to cam7 are no longer needed. + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.*_*.cam-outfrq9s_rrtmgp + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.*_*.cam-outfrq9s_rrtmgp +. Remove old cam7 configuration test which is no longer needed + ERS_Ld3.f10_f10_mg37.F1850.izumi_gnu.cam-outfrq1d_14dec_ghg_cam7 +. Move these low resolution tests from derecho to izumi + ERP_Ln9_P24x2.f45_f45_mg37.QPWmaC6.izumi_gnu.cam-outfrq9s_mee_fluxes + ERS_Ln9_P24x1.mpasa480_mpasa480.F2000climo.izumi_gnu.cam-outfrq9s_mpasa480 +. Add this low resolution CAM7-LT test to izumi + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.FLTHIST.izumi_gnu.cam-outfrq9s +. Remove 13 month cam6 test which is no longer needed. + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m + +cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/shell_commands +. add '-rad rrtmg' to CAM_CONFIG_OPTS. This test is using a non-standard + configuration of cam7, and this override is needed since the default + radiation scheme for cam7 has changed to 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 (Overall: DIFF) +ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa (Overall: DIFF) +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust (Overall: DIFF) +- expected diffs due to changes in cam7 configuration/tuning + +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.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + +derecho/nvhpc/aux_cam: + +ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: DIFF) +- expected diff due to changing seasalt_emis_scale for cam7 + +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.FLTHIST.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9_P24x2.f45_f45_mg37.QPWmaC6.izumi_gnu.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: +ERS_Ln9_P24x1.mpasa480_mpasa480.F2000climo.izumi_gnu.cam-outfrq9s_mpasa480 (Overall: DIFF) details: +- new tests are missing baselines + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except for cam7 configurations. + +=============================================================== +=============================================================== + +Tag name: cam6_4_042 +Originator(s): pel, nusbaume +Date: Oct 9, 2024 +One-line Summary: Fix reference pressures in MPAS +Github PR URL: https://github.com/ESCOMP/CAM/pull/1169 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- https://github.com/ESCOMP/CAM/issues/1168 + +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/dynamics/mpas/dyn_grid.F90 +M src/utils/std_atm_profile.F90 + - Use CAM reference pressure instead of standard atmosphere surface pressure. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: PEND) +ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: PEND) +ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: PEND) +SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: PEND) + - pre-existing failures due to resource limits due to being switched to run in the 'develop' queue rather than 'main' + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: PEND) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + +ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) + - Expected answer change due to bug-fix in MPAS surface reference pressure. + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure -- issue #670 + +ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + - Expected answer change due to bug-fix in MPAS surface reference pressure. + +izumi/gnu/aux_cam: ALL PASS + +Summarize any changes to answers: all MPAS tests will likely fail against baselines + +=============================================================== + +Tag name: cam6_4_041 +Originator(s): fvitt +Date: 16 Oct 2024 +One-line Summary: Adjustments to chemistry compset names +Github PR URL: https://github.com/ESCOMP/CAM/pull/1164 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Adjust chemistry compset names to adopt the new naming conventions (Issue #1158). + +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 cime_config/config_component.xml +M cime_config/config_compsets.xml + - %CCTSn replaced with %CTnS for the new chemitry compset naming convention + where n is the tropospheric chemistry version number + - xml reg exp adjustments for new HISTC_ and HISTE_ compset name prefixes + +M cime_config/config_pes.xml + - changes to the xml reg exp's for the new chemistry compset names + +M cime_config/testdefs/testlist_cam.xml + - changes for new compset names + - a fix for ne30 FCHIST test (ne30-->ne30pg3) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + PEND ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes + PEND ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 + PEND ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 + PEND SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m + - pre-existing failures due to resource limits due to being switched to run in the 'develop' queue rather than 'main' + + PEND SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures due to build-namelist error requiring CLM/CTSM external update. + + DIFF ERP_Ld3.ne30pg3_ne30pg3_mg17.FHISTC_MTt4s.derecho_intel.cam-outfrq1d_aoa + DIFF SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FHISTC_MTt1s.derecho_intel.cam-outfrq9s_Leung_dust + - new compset short names + +derecho/nvhpc/aux_cam: All PASS + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure -- issue #670 + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_4_040 +Originator(s): nusbaume +Date: Oct 2, 2024 +One-line Summary: Bring in re-organized atmospheric_physics repo +Github PR URL: https://github.com/ESCOMP/CAM/pull/1160 + +Purpose of changes (include the issue number and title text for each relevant +GitHub issue): + +Fixes #1156 -> Modify CAM build system to handle re-organized +atmospheric_physics repo + +Describe any changes made to build system: + +Updated the 'configure' script to use the new atmospheric_physics directory +locations + +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: + +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 + - Update the atmos_phys external + +M bld/configure + - Update atmos_phys paths to correctly point to new source code locations + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: PEND) +ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: PEND) +ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: PEND) +SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: PEND) +- Running into resource limits due to being switched to run in the 'develop' queue rather than 'main' +- Should be fixed in future CIME/ccs_config update. + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +- build-namelist error requiring CLM/CTSM external update. + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) +- pre-existing failure - issue #670 + +izumi/gnu/aux_cam: ALL PASS + +Summarize any changes to answers: bit-for-bit + +=============================================================== + +Tag name: cam6_4_039 +Originator(s): eaton +Date: 10 October 2024 +One-line Summary: update externals to cesm3_0_alpha03d +Github PR URL: https://github.com/ESCOMP/CAM/pull/1161 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +The externals have been updated as follows: + ccs_config_cesm1.0.0 -> ccs_config_cesm1.0.7 + cime6.1.0 -> cime6.1.29 + cmeps1.0.2 -> cmeps1.0.16 + cdeps1.0.48 -> cdeps1.0.53 + pio2_6_2 -> pio2_6_3 + ctsm5.2.027 -> ctsm5.3.002 + fi_240516 -> fi_240828 + +Issue #1134 - PLB,SCT,SUB, and TMC test need to be updated for cime6.1.12 +. The fix in this issue needs to be applied to this commit since cime6.1.0 + has been updated to cime6.1.29 + +Found during testing: need to modify test_driver.sh to not add the +'--queue main' argument to the create_test command for derecho. This is +due to a change in how the derecho queues are set up. + +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 +. update modules as listed above + +cime_config/SystemTests/plb.py +cime_config/SystemTests/sub.py +cime_config/SystemTests/sct.py +cime_config/SystemTests/tmc.py +. 'from CIME.utils import append_testlog' changed to + 'from CIME.status import append_testlog' + +test/system/test_driver.sh +. remove '--queue ${CAM_BATCHQ}' from commandline args for the create_test + command on derecho. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +- pre-existing failure -- needs fix in CLM external + +ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: PEND) +ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: PEND) +ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: PEND) +SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: PEND) +. new failures to run due to create_test updates - jobs are running into resource + limits due to being switched to run in the 'develop' queue rather than 'main' + +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: PEND) +. new failure due to ctsm update. Appears to be the same CLM + build-namelist failure that happens in the CONUS test. See CTSM issue #2544 + +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_Ld5.f19_f19_mg17.PC4.derecho_intel.cam-cam4_port5d (Overall: NLFAIL) +SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 (Overall: NLFAIL) +. diffs in coupler attributes + +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) +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) +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) +SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep (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.QPC2000climo.derecho_intel.cam-outfrq3s_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) +. diffs in coupler attributes +. diffs in coupler history files + +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) +ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) +ERP_Ld3.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq1d_aoa (Overall: DIFF) +ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) +ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) +SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) +SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) +SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s_Leung_dust (Overall: DIFF) +SMS_D_Ln9.T42_T42.FSCAMARM97.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) +SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) +SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) +SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) 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: +. diffs in coupler attributes and clm namelist +. diffs in cam, cpl, and clm history files + +derecho/nvhpc/aux_cam: + +ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: DIFF) +. diffs in coupler attributes and clm namelist +. diffs in cam, clm, and cpl history files + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure - issue #670 + +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_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (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) +. diffs in coupler attributes + +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.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (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) +ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (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) +PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) +PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) +PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) +SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) +SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) +SMS_D_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) +. diffs in coupler attributes +. diffs in coupler history file + +izumi/gnu/aux_cam: + +ERC_D_Ln9.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) +ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) +ERC_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) +ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) +PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) +SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: NLFAIL) +. diffs in coupler attributes + +ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) +ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) +ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) +ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) +ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) +ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) +PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) +PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) +PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) +SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) +SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) +SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) +SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) +SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) +SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) +. diffs in coupler attributes +. diffs in coupler history file + +SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) +. diffs in coupler attributes and clm namelist +. diffs in cam, clm, and cpl history files + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: + - Simple models and aquaplanet are BFB. + - F compsets have answer changes due to updated CTSM. + +=============================================================== + +Tag name: cam6_4_038 +Originator(s): lizziel +Date: 1 Oct 2024 +One-line Summary: Update to GEOS-Chem 14.4.3 and HEMCO 3.9.0, and add Cloud-J 7.7.3 and HETP 1.0 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1093 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +Update GEOS-Chem and dependencies to newer versions. (issue #959) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: fvitt 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 + - Update GEOS-Chem and HEMCO_CESM versions + - Add new dependencies cloud_j and hetp + +M bld/build-namelist + - Add defaults for GEOS-Chem namelist input directories + +M bld/configure + - Add MODEL_CESM and MODEL_GEOSCHEM to geoschem chem_cppdefs for use in Cloud-J + - Update hard-coded chem_nadv used for GEOS-Chem + +M bld/namelist_files/geoschem_master_gas_drydep_list.xml +M bld/namelist_files/geoschem_master_gas_wetdep_list.xml + - Add new GEOS-Chem deposited species FURA + - Add SO4 which is a non-MAM aerosol species in GEOS-Chem + +M bld/namelist_files/namelist_defaults_cam.xml + - Update default dep_data_file used for GEOS-Chem + - Add two input directories for GEOS-Chem + +M bld/namelist_files/namelist_definition.xml + - Change GEOS-Chem chem inputs directory name + - Add new GEOS-Chem input directory used for Cloud-J + +M bld/namelist_files/use_cases/2000_geoschem.xml +M bld/namelist_files/use_cases/2010_geoschem.xml +M bld/namelist_files/use_cases/hist_geoschem.xml +M bld/namelist_files/use_cases/hist_geoschem_nudged.xml + - Delete GEOS-Chem chem inputs directory since now in defaults + +M cime_config/buildnml + - No-diff cleanup + +M cime_config/config_component.xml + - Remove GEOS-chem from CAM40 and CAM50 options + +M cime_config/config_compsets.xml + - Fix bug in FCnudged_GC where nudging incorrectly specified in compset definition + +M testdefs/testlist_cam.xml + - Move GEOS-Chem tests to be grouped with similar compsets + +A src/chemistry/cloud_j + - tagged version 7.7.3 + +M src/chemistry/geoschem/chem_mods.F90 + - Update hard-coded nTracersMax, gas_pcnst, and nslvd used for + GEOS-Chem compsets + +M src/chemistry/geoschem/chemistry.F90 + - Updates for compatibility with GEOS-Chem 14.3.1 + - Replace hard-coded photolysis inputs directory with namelist value + - Add aerosol distribution fix to deposit SO4 using Neu as gas instead of aerosol + - Update precision modifiers + +M src/chemistry/geoschem/geoschem_diagnostics_mod.F90 + - Update precision modifiers + +M src/chemistry/geoschem/geoschem_emissions_mod.F90 + - Update precision modifiers + +M src/chemistry/geoschem/geoschem_src + - tagged version 14.4.3 + +M src/chemistry/geoschem/mo_sim_dat.F90 + - Add new species to solsym: BUTDI (butendedial) and FURA (furan) + +A src/chemistry/hetp + - tagged version 1.0 + +M src/chemistry/mozart/mo_neu_wetdep.F90 + - Restrict henrys law coefficient assignment error print to masterproc + - Add GEOS-Chem bulk sulfates SO4 and SO4S + +M src/hemco + - tag hemco-cesm2_0_hemco3_9_0 + +M test/system/TR8.sh + - Skip over GEOS-Chem and dependency modules + +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 + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + DIFF SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + - expected baseline failure due to updates to GEOS-Chem + +derecho/nvhpc/aux_cam: All PASS + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: ALL PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== + +Tag name: cam6_4_037 +Originator(s): jimmielin +Date: Sep 30, 2024 +One-line Summary: Implementation of CCPP-compliant tropopause_find +Github PR URL: https://github.com/ESCOMP/CAM/pull/1135 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- CCPP-ization of tropopause_find: https://github.com/ESCOMP/CAM/issues/1121 + +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, 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: + +Update atmos_phys external for tropopause_find (tag atmos_phys0_05_000): +M .gitmodules +M bld/configure +M src/atmos_phys + +CAM interface code for compatibility with CCPP-ized tropopause_find while retaining all existing functionality b4b: +M src/physics/cam/tropopause.F90 + +Updates to subroutine calls for CCPP-ization, including only passing in active columns: +M src/chemistry/geoschem/chemistry.F90 +M src/chemistry/mozart/chemistry.F90 +M src/chemistry/utils/modal_aero_wateruptake.F90 +M src/chemistry/utils/prescribed_strataero.F90 +M src/chemistry/utils/prescribed_volcaero.F90 +M src/physics/cam/aer_rad_props.F90 +M src/physics/cam/aerosol_optics_cam.F90 +M src/physics/cam/clubb_intr.F90 +M src/physics/cam/micro_pumas_cam.F90 +M src/physics/cam/nucleate_ice_cam.F90 +M src/physics/cam/physpkg.F90 +M src/physics/cam/radiation_data.F90 +M src/physics/cam/rk_stratiform.F90 +M src/physics/cam7/micro_pumas_cam.F90 +M src/physics/cam7/physpkg.F90 +M src/physics/camrt/radiation.F90 +M src/physics/carma/models/meteor_impact/carma_model_mod.F90 +M src/physics/carma/models/tholin/carma_model_mod.F90 +M src/physics/rrtmg/radiation.F90 +M src/physics/rrtmgp/radiation.F90 + + +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 + note: the SMS test for FCSD_HCO may fail b4b occasionally and was resubmitted for this tag. + + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) + - pre-existing failures -- need fix in CLM external + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: + + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: ALL PASS + +Summarize any changes to answers: bit-for-bit + +=============================================================== + +Tag name: cam6_4_036 +Originator(s): gdicker +Date: Sep 24, 2024 +One-line Summary: Update MPAS-A to v8.2.1 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1145 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- Update MPAS-A within CAM to 'v8.2.1' https://github.com/ESCOMP/CAM/issue/1144 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M .gitmodules + - Update the mpas fxTag to v8.2.1 + +M src/dynamics/mpas/Makefile + - Add rules to build stream_inquiry and mpas_stream_inquiry + - Pass CPPFLAGS to the registry command + - Edit CPPFLAGS: add MPAS_BUILD_TARGET and add the GIT_VERSION using a shell command + - Also a commented out addition to enable mpi_f08 support in MPAS + +M src/dynamics/mpas/driver/cam_mpas_subdriver.F90 + - Add streamInfo to the MPAS domain_ptr + - Modify function calls for updated variables + - Optional mpi_f08 change + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + FAIL SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d ... DIFF + - 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 + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: + + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: ALL PASS + +Summarize any changes to answers: bit-for-bit + +=============================================================== + +Tag name: cam6_4_035 +Originator(s): fvitt +Date: 23 Sep 2024 +One-line Summary: Generalize aerosol wet removal +Github PR URL: https://github.com/ESCOMP/CAM/pull/1099 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + #1098 Generalize aerosol wet removal processes using the abstract aerosol interfaces + framework which can be extended to other aerosol representations, such as CARMA. + +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 cacraigucar + +List all files eliminated: +D src/chemistry/modal_aero/modal_aero_convproc.F90 + - replaced by generalized aero_convproc module + +List all files added and what they do: +A src/chemistry/aerosol/aero_convproc.F90 + - generalized aerosol convective wet removal processes + +A src/chemistry/aerosol/aero_wetdep_cam.F90 + - generalized cam layer for aerosol wet removal + (stratiform and convective) + + src/chemistry/aerosol/modal_aero_data.F90 + - moved from src/chemistry/modal_aero + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist + - do not set aer_wetdep_list for MAM + +M bld/namelist_files/namelist_definition.xml + - moved aerosol solubility factors to aero_setdep_nl group + +M src/chemistry/aerosol/aerosol_properties_mod.F90 +M src/chemistry/aerosol/modal_aerosol_properties_mod.F90 + - add interfaces for scavenging diameter and resuspention resize + +M src/chemistry/aerosol/aerosol_state_mod.F90 +M src/chemistry/aerosol/modal_aerosol_state_mod.F90 + - add interfaces for convective cloud aerosol activation, below cloud solubility, and wet diameter + +R100 src/chemistry/modal_aero/modal_aero_data.F90 src/chemistry/aerosol/modal_aero_data.F90 + - moved to src/chemistry/aerosol/ + +M src/physics/carma/cam/carma_intr.F90 +M src/chemistry/aerosol/wetdep.F90 + - allow for 3-dimensional solubilities + +M src/chemistry/modal_aero/aero_model.F90 + - moved aerosol wet removal code to generalized aero_wetdep_cam module + +M src/physics/cam/physpkg.F90 +M src/physics/cam7/physpkg.F90 + - wetdep_lq moved to aero_wetdep_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: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + - 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 + + NLFAIL ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp + 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 ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s + NLFAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + NLFAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + NLFAIL ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + NLFAIL ERP_Ld3.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq1d_aoa + NLFAIL ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 + NLFAIL ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes + NLFAIL ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 + NLFAIL ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + NLFAIL ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + NLFAIL ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 + NLFAIL ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 + 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_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + NLFAIL SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + NLFAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + 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.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s_Leung_dust + NLFAIL SMS_D_Ln9.T42_T42.FSCAMARM97.derecho_intel.cam-outfrq9s + NLFAIL SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d + NLFAIL SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d + NLFAIL SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 + NLFAIL SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m + NLFAIL SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging + NLFAIL SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + NLFAIL SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs + NLFAIL SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - aerosol_nl settings moved to aero_wetdep_nl + +derecho/nvhpc/aux_cam: + NLFAIL ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default + - aerosol_nl settings moved to aero_wetdep_nl + +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.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac + 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 ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf + 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_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_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 + - aerosol_nl settings moved to aero_wetdep_nl + +izumi/gnu/aux_cam: + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s + 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.QPC5.izumi_gnu.cam-outfrq9s + 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.QPC6.izumi_gnu.cam-scm_prep_c6 + 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 + - aerosol_nl settings moved to aero_wetdep_nl + +Summarize any changes to answers: bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam6_4_034 +Originator(s): jimmielin +Date: Thu Sep 19 2024 +One-line Summary: Add missing total energy in physics state from dycore in snapshots and cleanup total water +Github PR URL: https://github.com/ESCOMP/CAM/pull/1142 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Save second dimension (dycore formula) of total energy and total water initial and current condition + (fixes #1141) + + Remove second dimension of tw_ini and tw_cur as they are not different between physics and dycore. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M src/control/cam_snapshot_common.F90 +- renamed te_ini -> te_ini_phys, te_cur -> te_cur_phys +- added te_ini_dyn, te_cur_dyn which were missing from snapshot, now fixed +- resized state history buffer size + +M src/physics/cam/check_energy.F90 +M src/physics/cam/physics_types.F90 +- removed incorrect second dimension of tw_ini and tw_cur as they are not different between physics / dycore + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) + - pre-existing failure -- need fix in CLM external + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: + + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: ALL PASS + +Summarize any changes to answers: BFB + +=============================================================== + +Tag name: cam6_4_033 +Originator(s): gdicker1 (gdicker@ucar.edu) +Date: Tue 10 Sep 2024 +One-line Summary: Add updated meshes and topo for v8 MPAS-A dycore +Github PR URL: https://github.com/ESCOMP/CAM/pull/1029 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Add files created by v8 MPAS init_atmosphere model for frontogenesis fields +#995 - Runs with MPAS-A dycore and CAM7 physics fail - missing variables in inic files: https://github.com/ESCOMP/CAM/issues/995 +#1094 - Wrap MPAS-A longitudes to [0,2pi) range: https://github.com/ESCOMP/CAM/issues/1094 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: adamrher, jtruesdal, cacraigucar, mgduda + +List all files eliminated: + +- mpasa120_L32_topo_coords_c201022.nc + +Eliminated, replaced by newer versions: +- mpasa480_L32_notopo_coords_c201125.nc +- mpasa120_L32_notopo_coords_c201216.nc +- mpasa60_L32_notopo_coords_c230707.nc +- mpasa30_L32_notopo_coords_c230707.nc +- mpasa120km.waccm_fulltopo_c220818.nc +- cami_01_01_2000_00Z_mpasa120_L32_CFSR_c210426.nc +- cami_01_01_2000_00Z_mpasa480_L32_CFSR_c211013.nc +- mpas_120_nc3000_Co060_Fi001_MulG_PF_Nsw042_c200921.nc +- mpas_480_nc3000_Co240_Fi001_MulG_PF_Nsw170.nc + +List all files added and what they do: + +New input 32, 58, and 93L without real-data (analytic-ICs only): +- mpasa480_L32_notopo_coords_c240507.nc +- mpasa120_L32_notopo_coords_c240507.nc +- mpasa60_L32_notopo_coords_c240507.nc +- mpasa30_L32_notopo_coords_c240507.nc +- mpasa480_L58_notopo_coords_c240814.nc +- mpasa120_L58_notopo_coords_c240814.nc +- mpasa60_L58_notopo_coords_c240814.nc +- mpasa480_L93_notopo_coords_c240814.nc +- mpasa120_L93_notopo_coords_c240814.nc +- mpasa60_L93_notopo_coords_c240814.nc + +New input L70 file for waccm cases: +- mpasa120_L70.waccm_topography_SC_c240904.nc + +New input data with topology and real-data ICs: +- cami_01-01-2000_00Z_mpasa480_L32_CFSR_c240508.nc +- cami_01-01-2000_00Z_mpasa120_L32_CFSR_c240508.nc +- cami_01-01-2000_00Z_mpasa480_L58_CFSR_c240814.nc +- cami_01-01-2000_00Z_mpasa120_L58_CFSR_c240814.nc +- cami_01-01-2000_00Z_mpasa480_L93_CFSR_c240814.nc +- cami_01-01-2000_00Z_mpasa120_L93_CFSR_c240814.nc + +New bnd_topo files: +- mpasa480_gmted2010_modis_bedmachine_nc3000_Laplace0400_noleak_20240507.nc +- mpasa120_gmted2010_modis_bedmachine_nc3000_Laplace0100_noleak_20240507.nc + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/namelist_defaults_cam.xml + - Add new ncdata and bnd_topo files above so they can be used +M src/dynamics/mpas/dyn_grid.F90 + - Modifies setup_time_invariant to ensure lonCell values are in [0,2pi) range + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) + - pre-existing failure -- need fix in CLM external + + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) + - expected fails of BASELINE and NLCOMP steps, new mpas input data + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: + + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + - expected fails of BASELINE and NLCOMP steps, new mpas input data + +izumi/gnu/aux_cam: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam6_4_032 +Originator(s): eaton +Date: +One-line Summary: Use same cloud water for radiation and COSP. +Github PR URL: https://github.com/ESCOMP/CAM/pull/1084 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Issue #1027 - Radiatively active cloud water missing from COSP. + +The all-cloud liquid and ice mixing ratios calculated in the conv_water module are +used by the radiation code. Use these same quantities in the COSP code by +making them accessable via the physics buffer. + +resolves #1027 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: peverwhee + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +src/control/cam_snapshot_common.F90 +. remove pbuf fields DP_CLDLIQ, DP_CLDICE, SH_CLDLIQ1, SH_CLDICE1 + +src/physics/cam/conv_water.F90 +. add GB_TOTCLDLIQMR, GB_TOTCLDICEMR to pbuf +. remove SH_CLDLIQ1, SH_CLDICE1 from pbuf +. conv_water_4rad + - remove dummy args totg_liq and totg_ice and replace assignment to those + args by assignment to the pbuf variables GB_TOTCLDLIQMR and + GB_TOTCLDICEMR + +src/physics/cam/cloud_diagnostics.F90 +. access the pbuf fields GB_TOTCLDLIQMR and GB_TOTCLDICEMR which are set by + the calls to conv_water_4rad + +src/physics/cam/cospsimulator_intr.F90 +. replace access of pbuf fields DP_CLDLIQ, DP_CLDICE, SH_CLDLIQ1, and + SH_CLDICE1, by GB_TOTCLDLIQMR and GB_TOTCLDICEMR +. assign the total cloud mixing ratios to the arguments for the large scale + values, and set the convective cloud inputs to zero. + +src/physics/cam/zm_conv_intr.F90 +. remove pbuf fields DP_CLDLIQ and DP_CLDICE which were set to 0. and being + used as if they had real data by COSP. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) + - pre-existing failure -- need fix in CLM external + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PASS) + - test failed with error in ESMF on first run, but passed when I reran the tests + - unclear when/why exactly this test began to pass again + + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: All BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. Only COSP diagnostic fields have +differences. + +=============================================================== + +Tag name: cam6_4_031 +Originator(s): jedwards, eaton +Date: Sept 9, 2024 +One-line Summary: fix issues #1108, #1106, #1058, #1051, #1050; merge PR#1101 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1131 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Issue #1108 - More robust logic in gw_drag.F90 when deep_scheme='off' +- Modify build-namelist to set use_gw_convect_dp=.false. when + deep_scheme='off'. In gw_drag::gw_tend check whether field TTEND_DP is + in the pbuf. If so then associate the ttend_dp pointer. If not then + allocate the ttend_dp pointer and set to zero. + +PR #1101 - improved fix for rh write performance +- reorder output fields. Merge Jim's PR into this one. + +Issue #1106 - Report an error if a user uses --model_top with anything other than cam7 +- configure reports this error, but the output in the log file gets + obscured by a stack traceback issued from buildnml which is not useful. + The fix implemented in buildnml replaces the "raise RuntimeError" call with + a warning message in the log file. Then, if a subsequent check for CAM's + config_cache.xml file fails, the execution is terminated by a call to + the CIME.utils "expect()" routine. + +Issue #1058 - Remove unused pbuf variable smaw +- Remove both smaw and turbtype from physics buffer. Neither is used. + Remove the calculation of smaw entirely. Calculation of turbtype + remains. It is used locally, and may be written to history file + (UW_turbtype). + +Issue #1051 - Bad logic in SE dycore "interpolate_vector" subroutines +- These subroutines are not currently used by CAM as they are restricted to + interpolating fields on the GLL grid. Fix the conditional logic and + update the endrun message. + +Issue #1050 - Remove CAM3 as a compset or configure option + +Describe any changes made to build system: + +Describe any changes made to the namelist: +. build-namelist now sets use_gw_convect_dp=.false. when deep_scheme='off'. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: peverwhee, nusbaume + +List all files eliminated: + +bld/namelist_files/use_cases/aquaplanet_cam3.xml +src/physics/cam/cam3_aero_data.F90 +src/physics/cam/cam3_ozone_data.F90 + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +bld/build-namelist +. add check to set use_gw_convect_dp=.false. when deep_scheme='off'. +. remove cam3 conditionals +. remove variables cam3_ozone_data_on, cam3_aero_data_on, bndtvo, bndtvaer +. remove cam3 ozone and aerosols from rad_climate specification. +. remove cam3 aerosol deposition fluxes +. remove add_default for fcrit2 + +bld/configure +. remove cam3 as valid physics package + +bld/config_files/definition.xml +. remove cam3 as valid value for -phys + +bld/namelist_files/namelist_defaults_cam.xml +. remove cam3 bulk aerosol files +. remove cam3 setting for fv_fft_flt + +bld/namelist_files/namelist_definition.xml +. remove definitions for cam3_ozone_data_on, cam3_aero_data_on, bndtvo, + bndtvaer, ozncyc +. remove cam3 as valid value for cam_physpkg +. remove definition for fcrit2 + +cime_config/buildnml +. replace RuntimeError exception with message to logger. + +cime_config/config_compsets.xml +. remove QPC3 + +cime_config/config_component.xml +. remove regexp matches for _CAM30 + +src/chemistry/modal_aero/modal_aero_rename.F90 +. remove cam3 comments + +src/chemistry/utils/prescribed_ozone.F90 +. remove cam3 conditional + +src/control/cam_history.F90 +. The variables in the restart history files are reordered so that the nacs + variables are all written together rather than being next to their + corresponding fields. + +src/control/cam_snapshot_common.F90 +. change npbuf_all from 327 to 314 +. fill_pbuf_info + - remove smaw, turbtype + - remove 11 fields: cam3_* + +src/control/runtime_opts.F90 +. remove refs to cam3_aero_data and cam3_ozone_data + +src/dynamics/fv/cd_core.F90 +src/dynamics/fv/dynamics_vars.F90 +. remove cam3 comments + +src/dynamics/se/dycore/interpolate_mod.F90 +. interpolate_vector2d and interpolate_vector3d + - fix conditional logic and clarify endrun message to indicate that the + input fields must be on the GLL grid. + +src/physics/cam/convect_shallow.F90 +. remove cam3 from conditional + +src/physics/cam/eddy_diff.F90 +. caleddy + - remove intent(out) arg sm_aw + +src/physics/cam/eddy_diff_cam.F90 +. eddy_diff_tend + - remove intent(out) args sm_aw and turbtype +. compute_eddy_diff + - remove intent(out) arg sm_aw + - remove intent(out) arg turbtype. use local storage for turbtype. + +src/physics/cam/gw_common.F90 +. remove cam3 comment + +src/physics/cam/gw_drag.F90 +. check that field TTEND_DP is in the pbuf before trying to associate the + pointer ttend_dp. If TTEND_DP is not in pbuf then allocate the ttend_dp + pointer and fill with zeros. +. remove fcrit2 from the namelist. Hardcode to 1.0 in GWBand call that + sets band_oro, just like all the other calls to GWBand. + +src/physics/cam/rk_stratiform.F90 +. remove cam3 from conditional + +src/physics/cam/uwshcu.F90 +. remove cam3 comment + +src/physics/cam/vertical_diffusion.F90 +. remove smaw and turbtype from physics buffer +. vertical_diffusion_tend + - remove smaw and turbtype as actual args in call to eddy_diff_tend + +src/physics/cam/zm_conv_intr.F90 +. remove cam3 conditional + +src/physics/camrt/radlw.F90 +. remove cam3 conditional + +src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 +. remove cam3 comment + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) + - pre-existing failures -- need fix in CLM external + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: + + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam6_4_030 +Originator(s): eaton, cacraig +Date: Sept 6, 2024 +One-line Summary: fix psl values sent to coupler in cam7 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1128 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Fix issue #1116 - Test SMS_Ld2.ne30pg3_t232.BMT1850.derecho_gnu.allactive-defaultio Fails + - The cam7 version of tphysbc has a call to cpslec added in front of the + call to cam_export so that psl is set consistent with the state sent to + the coupler. + +. Fix issue #805 - cplsec.F90 needs to be in a module. + - Add subroutine cpslec to a new module, src/utils/cam_diagnostic_utils.F90 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all files eliminated: + +src/physics/cam/cpslec.F90 +. subroutine cpslec moved to new module + +List all files added and what they do: + +src/utils/cam_diagnostic_utils.F90 +. subroutine cpslec added to this new module + +List all existing files that have been modified, and describe the changes: + +src/physics/cam/cam_diagnostics.F90 +. add access to cpslec from cam_diagnostic_utils module + +src/physics/cam7/physpkg.F90 +. add calculation of psl to tphysbc right in front of call to cam_export + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + FAIL SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s RUN time=77 + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ld3.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq1d_aoa (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s_Leung_dust (Overall: DIFF) details: + - CPL history file has difference in the atmImp_Sa_pslv field for CAM7 runs + +derecho/nvhpc/aux_cam: + ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: DIFF) details: + - CPL history file has difference in the atmImp_Sa_pslv field for CAM7 runs + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB in F compsets. Answers will change + in B compsets. + +=============================================================== +=============================================================== + +Tag name: cam6_4_029 +Originator(s): fvitt +Date: 5 Sep 2024 +One-line Summary: Updates to age of air diagnostic tracers +Github PR URL: https://github.com/ESCOMP/CAM/pull/1110 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + New age of air tracer (issue #1082): + Implement an age of air diagnostic tracer (AOA1MF) which has a mixing ratio lower + boundary condition which increases 2% per year starting from 1.e-6. Initial mass mixing + ratios. Legacy age of air tracers AOA1 and AOA2 are removed. + + Update upper boundary file in CAM LT use case for simulations that begin in 1850. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_clm + - for testing age-of-air tracers + +List all existing files that have been modified, and describe the changes: +M bld/configure + - change number of advected AOA tracers to 3 + +M bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +M bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml +M bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml +M bld/namelist_files/use_cases/sd_waccm_sulfur.xml +M bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml +M bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml +M bld/namelist_files/use_cases/soa_chem_megan_emis.xml +M bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +M bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml +M bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +M bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml +M bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml +M bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml +M bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml + - remove obsolete AOA tracer fields from fincl lists + +M bld/namelist_files/use_cases/hist_cam_lt.xml + - update UBC file for runs that start in 1850 + +M cime_config/testdefs/testlist_cam.xml + - add new TS4-cam7-MT AOA test + +M src/physics/cam/aoa_tracers.F90 + - implement new AOAMF tracer (described above) + - remove obsolete AOA1 and AOA2 tracers + +M src/physics/cam/physpkg.F90 +M src/physics/cam7/physpkg.F90 + - aoa_tracers_timestep_tend interface change + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + NLFAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + NLFAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + - change in ubc_file_path, otherwise bit-for-bit + + DIFF ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s + DIFF ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Ld3.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq1d_aoa + DIFF ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h + DIFF ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes + DIFF ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + DIFF SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + DIFF SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + DIFF SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase + DIFF SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + DIFF SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + DIFF SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - expect baseline failures -- differences in age-of-air tracers + otherwise bit-for-bit + +derecho/nvhpc/aux_cam: PASS + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + DIFF ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s + DIFF SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + DIFF SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem + - expect baseline failures -- differences in age-of-air tracers + otherwise bit-for-bit + +izumi/gnu/aux_cam: + DIFF SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee + DIFF SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s + - expect baseline failures -- differences in age-of-air tracers + otherwise bit-for-bit + +Summarize any changes to answers: bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam6_4_028 +Originator(s): fvitt +Date: 4 Sep 2024 +One-line Summary: Add capability to use Leung dust emission scheme +Github PR URL: https://github.com/ESCOMP/CAM/pull/1104 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Add the capability to use Leung_2023 land model dust emission scheme. + Zender_2003 is the default scheme for all F compsets. + (issues #141 and #654) + + NOTE: This reverts cam7 compsets back to Zender_2003 dust emissions. + In tag cam6_4_027 cam7 compsets dust emissions scheme defaulted to + Leung_2023 and where not properly scaled. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: ekluzek, cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_clm + - add test for Leung_2023 dust emis scheme + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml + - set default dust emis namelist settings (Zender_2003 is the default scheme) + +M bld/namelist_files/namelist_definition.xml + - new dust emis namelist vars: + . dust_emis_method ('Zender_2003' or 'Leung_2023') + . zend_soil_erod_source ('atm' or 'lnd') + +M cime_config/config_compsets.xml + - override the 'LND_SETS_DUST_EMIS_DRV_FLDS' xml setting to be FALSE for cam7/clm6 F compsets + +M cime_config/testdefs/testlist_cam.xml + - increase time for aux_cam HEMCO test + - regression test Leung_2023 dust emis scheme + +M src/chemistry/bulk_aero/dust_model.F90 +M src/chemistry/modal_aero/dust_model.F90 + - use soil_erod only if Zender scheme is used + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s + - differences due to switching dust emis scheme from Leung_2023 to Zender_2003 + + DIFF SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s_Leung_dust + - new reg test -- no baseline to compare against + + NLFAIL ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp + NLFAIL ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s + NLFAIL ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s + NLFAIL ERC_D_Ln9.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator + NLFAIL ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase + NLFAIL ERC_D_Ln9.T42_T42_mg17.FDABIP04.derecho_intel.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9.T42_T42_mg17.FHS94.derecho_intel.cam-outfrq3s_usecase + NLFAIL ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase + NLFAIL ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s + NLFAIL ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes + NLFAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s + NLFAIL ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined + NLFAIL SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep + NLFAIL SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep + NLFAIL SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase + NLFAIL SMS_D_Ld5.f19_f19_mg17.PC4.derecho_intel.cam-cam4_port5d + NLFAIL SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase + NLFAIL SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s + NLFAIL SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 + NLFAIL SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem + - namelist compare failures due to dust_emis_inparm namelist in drv_flds_in + otherwise bit-for-bit + +derecho/nvhpc/aux_cam: + DIFF ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default + - difference due to switching dust emis scheme from Leung_2023 to Zender_2003 + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s + NLFAIL ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s + NLFAIL ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac + NLFAIL ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase + NLFAIL ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + NLFAIL ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 + NLFAIL ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic + NLFAIL ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic + NLFAIL ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf + NLFAIL ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s + NLFAIL ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s + NLFAIL PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s + NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + NLFAIL SMS_D_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port + NLFAIL SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + NLFAIL SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem + NLFAIL SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm + NLFAIL SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam + NLFAIL SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba + NLFAIL SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s + NLFAIL SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase + NLFAIL SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s + NLFAIL TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + NLFAIL TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 + - namelist compare failures due to dust_emis_inparm namelist in drv_flds_in + otherwise bit-for-bit + +izumi/gnu/aux_cam: + NLFAIL ERC_D_Ln9.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s + NLFAIL ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 + NLFAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba + NLFAIL ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s + NLFAIL ERC_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s + NLFAIL ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp + NLFAIL ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s + NLFAIL ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp + NLFAIL ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s + NLFAIL ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s + NLFAIL PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s + NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 + NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 + NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 + NLFAIL SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 + NLFAIL SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep + NLFAIL SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 + NLFAIL SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc + NLFAIL SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee + NLFAIL SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac + NLFAIL SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp + - namelist compare failures due to dust_emis_inparm namelist in drv_flds_in + otherwise bit-for-bit + +Summarize any changes to answers: larger than roundoff for cam7, otherwise bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam6_4_027 +Originator(s): fvitt +Date: 3 Sep 2024 +One-line Summary: Update land model tag to ctsm5.2.027 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1140 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Update of the CTSM external is needed for new dust emissions capabilities. + Issue #1139 + + The changes which affect CAM are summarized as: + ctsm5.2.016 -- changes answers for clm6_0 for crop grid cells + ctsm5.2.020 -- changes answers for all physics options for MEGAN BGVOC's which will affect CAM-Chem simulations + ctsm5.2.026 -- change answers for clm6_0 over urban grid cells + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M .gitmodules +M components/clm + - update ctsm to ctsm5.2.027 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + DIFF ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h + DIFF ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 + DIFF ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + DIFF ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 + DIFF ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 + DIFF ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 + DIFF SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + DIFF SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + DIFF SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + DIFF SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.T42_T42.FSCAMARM97.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + DIFF SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m + DIFF SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging + DIFF SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + DIFF SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs + DIFF SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem + DIFF SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - expected baseline test failures + +derecho/nvhpc/aux_cam: + DIFF ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default + - expected baseline test failure + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: + DIFF SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s + - expected baseline test failure + +Summarize any changes to answers: larger than roundoff + +=============================================================== +=============================================================== + +Tag name: cam6_4_026 +Originator(s): cacraig +Date: August 29, 2024 +One-line Summary: Neglected to remove the 0.5*timestep call from zm_convr_run - done now +Github PR URL: https://github.com/ESCOMP/CAM/pull/1137 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Last change needed in https://github.com/ESCOMP/CAM/issues/1124 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M src/physics/cam/zm_conv_intr.F90 + - Remove "0.5*timestep" from call and replace with "timestep" + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + - pre-existing failures -- need fix in CLM external + + ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - baseline changes due to change in ZM + +derecho/nvhpc/aux_cam: + ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: DIFF) details: + - baseline change due to change in ZM + +izumi/nag/aux_cam: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + - baseline change due to change in ZM + +izumi/gnu/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure - issue #670 + + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - baseline change due to change in ZM + +Summarize any changes to answers, i.e., + Adam Harrington felt comfortable with the expected answer changes due to his previous run without this change. He felt they would + be round-off differences and authorized this commit. + +=============================================================== +=============================================================== + +Tag name: cam6_4_025 +Originator(s): fvitt, tilmes +Date: 28 Aug 2024 +One-line Summary: Repartition dust deposition fluxes passed to surface models +Github PR URL: https://github.com/ESCOMP/CAM/pull/1096 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Repartition the modal dust deposition fluxes into 4 bulk bins for passing to the surface + models. The aerosol fluxes code was refactored in a generalized way which can easily be + expanded for other aerosol representations, such as CARMA, and aerosol species types. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: +A src/chemistry/aerosol/aero_deposition_cam.F90 + - aerosol model independent module that uses aerosol abstract interface + to prepare deposition fluxes passed to surface models + +List all existing files that have been modified, and describe the changes: +M src/chemistry/aerosol/aerosol_properties_mod.F90 +M src/chemistry/aerosol/modal_aerosol_properties_mod.F90 + - add interface for calculating generalized bulk fluxes + +M src/chemistry/modal_aero/aero_model.F90 + - replace use of modal_aero_deposition with generalized aero_deposition_cam + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + PEND ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + FAIL SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + FAIL SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + DIFF ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 + DIFF ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + DIFF ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 + DIFF ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 + DIFF ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 + DIFF SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + DIFF SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + DIFF SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + DIFF SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.T42_T42.FSCAMARM97.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + DIFF SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m + DIFF SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging + DIFF SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + DIFF SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs + DIFF SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - expected baseline failures due to changes in dust deposition fluxes to surface models + +derecho/nvhpc/aux_cam: + DIFF ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default + - expected baseline failure due to changes in dust deposition fluxes to surface models + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: + larger than roundoff but same climate + +URL for AMWG diagnostics output used to validate new climate: + + https://acomstaff.acom.ucar.edu/tilmes/amwg/cam7/f.e23_beta02.FLTHIST_ne30.surf_flux_1995_2004_vs_f.e23_beta02.FLTHIST_ne30.001_1995_2004/website/index.html + + The land diagnostics are here: + + https://webext.cgd.ucar.edu/FLTHIST/f.e23_beta02.FLTHIST_ne30.surf_flux/lnd/f.e23_beta02.FLTHIST_ne30.surf_flux_1995_2004-f.e23_beta02.FLTHIST_ne30.001_1995_2004/setsIndex.html + +=============================================================== +=============================================================== + +Tag name: cam6_4_024 +Originator(s): eaton +Date: 27 Aug 2024 +One-line Summary: Deposition fixes for aquaplanet and simple model configurations. +Github PR URL: https://github.com/ESCOMP/CAM/pull/1120 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Issue #866 - Aquaplanet cases should not require ndep +PR #910 - No ndep in aquaplanet + +. Don't require the ndep stream for aquaplanet or simple models. Also + remove the ndep datasets from the namelist when they aren't being used. + This prevents cime from downloading large unneeded files. + This doesn't change answers since the ndep fluxes are not used by these + configurations. + +. Don't require a drydep_srf_file for aquaplanet runs on unstructured + grids. This does change answers since currently aquaplanet runs are + using the versions of this file which are meant for a CAM/CLM + configuration and are introducing an incorrect land surface signal into + the drydep calculations. + +resolves #866 +closes #910 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + +. build-namelist is modified to remove the settings of + stream_ndep_data_filename and stream_ndep_mesh_filename when aquaplanet + or simple model configurations are used. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bld/build-namelist +. if simple model or aquaplanet remove the settings of + stream_ndep_data_filename and stream_ndep_mesh_filename +. modify logic so the add_default call for drydep_srf_file is not made for + simple models or aquaplanet + +bld/namelist_files/namelist_definition.xml +. remove the variables in the ndep_stream_nml group. Not used. + +src/chemistry/mozart/chemistry.F90 +. chem_readnl + - add initializer for drydep_srf_file + +src/chemistry/mozart/mo_drydep.F90 +. get_landuse_and_soilw_from_file + - if drydep_srf_file not set, then set fraction_landuse to zero. + +src/cpl/nuopc/atm_import_export.F90 +. export_fields + - When ndep is not computed by WACCM, and the ndep stream isn't used, + then set Faxa_ndep to zero. + +src/cpl/nuopc/atm_stream_ndep.F90 +. add public module variable use_ndep_stream +. stream_ndep_init + - if stream_ndep_data_filename not set, then set variable + use_ndep_stream=.false. (otherwise .true.) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: PEND) +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +- pre-existing pend/failures -- need fix in CLM external + +ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) +ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) +ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) +ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: DIFF) +ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) +SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) +SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) +- expected namelist diffs due to ndep data +- expected diffs in cpl.hi file (atmImp_Faxa_ndep1, atmImp_Faxa_ndep2) + +ERC_D_Ln9.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator (Overall: NLFAIL) +ERC_D_Ln9.T42_T42_mg17.FDABIP04.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) +ERC_D_Ln9.T42_T42_mg17.FHS94.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) +ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined (Overall: NLFAIL) +SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: +- expected namelist diffs due to ndep data + +ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) +ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) +SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) +- expected namelist diffs due to ndep data +- expected diffs in cpl.hi file (atmImp_Faxa_ndep1, atmImp_Faxa_ndep2) +- expected diffs in cam output due to fixing drydep land surface file + +derecho/nvhpc/aux_cam: PASS + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) +- pre-existing failure - issue #670 + +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) +ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) +ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) +ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) +ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) +ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) +PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) +PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) +PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) +SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) +SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) +SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) +SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) +SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) +SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) +SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) +- expected namelist diffs due to ndep data +- expected diffs in cpl.hi file (atmImp_Faxa_ndep1, atmImp_Faxa_ndep2) + +ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) +ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) +ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) +ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) +ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) +PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) +SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) +TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) +TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) +- expected namelist diffs due to ndep data + +ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) +ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) +PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) +PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) +PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) +- expected namelist diffs due to ndep data +- expected diffs in cpl.hi file (atmImp_Faxa_ndep1, atmImp_Faxa_ndep2) +- expected diffs in cam output due to fixing drydep land surface file + +izumi/gnu/aux_cam: + +ERC_D_Ln9.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: +ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: +ERC_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: +ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: +PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: +- expected namelist diffs due to ndep data + +ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: +ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: +ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: +ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: +SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: +SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: +SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: +SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: +- expected namelist diffs due to ndep data +- expected diffs in cpl.hi file (atmImp_Faxa_ndep1, atmImp_Faxa_ndep2) + +ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: +PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: +PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: +PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: +SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: +SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: +- expected namelist diffs due to ndep data +- expected diffs in cpl.hi file (atmImp_Faxa_ndep1, atmImp_Faxa_ndep2) +- expected diffs in cam output due to fixing drydep land surface file + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except CAM5/6 aquaplanet runs on + unstructured grids have answer changes due to fixing the land surface + types used by dry deposition calculations + +=============================================================== +=============================================================== + +Tag name: cam6_4_023 +Originator(s): jet +Date: Aug 26, 2024 +One-line Summary: cam6_4_023: SCAM-SE feature addition plus bugfixes and some refactoring +Github PR URL: https://github.com/ESCOMP/CAM/pull/958 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +This update includes some refactoring of SCAM, a few bugfixes, and adding the capability to use +spectral elements dycore to do vertical transport in the column. The SE feature addition follows +the E3SM implementation where a complete coarse resolution (ne3np4) of the SE dycore is initialized +but only a single element is run through vertical transport. The single column chosen by scmlat, scmlon. + +Like the Eulerian version, SCAM-SE also has a bit for bit test to validate an exact run through +the same physics as the full 3d model. Because SCAM updates the solution using a slightly different +order of operations, the bfb capability is tested by making a special diagnostic run of CAM where +the 3d model derives the phys/dyn tendency each time step and then recalculates the prognostic +solution using the derived tendencies and SCAM's prognostic equation. This new solution (which is +less precise (roundoff) due to the change in order of operations) is substituted for the full 3d +solution at each time step of the model run. The substitution of the roundoff state in the 3d run +allows SCAM to reproduce (BFB) each time step using the captured tendencies in the cam iop history file. + +The SCAM-SE vertical advection skips the horizontal step and derives the floating level tendency +based on the IOP prescribed vertical velocity. The floating levels are subsequently remapped at +the end of the vertically Lagrangian dynamics step. + +Closes Issue SCAM-SE - Allow use of spectral elements dycore in single column mode. #957 +Closes Issue some SCAM IOP's are broken #853 +Closes Issue Unhelpful error message when running SCAM and IOP file is too short #742 + +Describe any changes made to build system: Allow SCAM to be built with spectral element dycore + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets:New boundary data for SE SCM + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-09-01-00000.nc + A atm/cam/inic/se/cami_0000-01-01_ne3np4_L30_c120315.nc + A atm/cam/inic/se/cami_0000-01-01_ne3np4_L26_c120525.nc + A atm/cam/topo/se/ne3np4_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230717.nc + A atm/cam/chem/trop_mam/atmsrf_ne3np4_230718.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-01-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-02-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-04-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-06-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-07-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-08-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-10-01-00000.nc + A atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-12-01-00000.nc + A atm/cam/scam/iop/micre2017_3mo.cam.i.2017-01-01-00000.regrid.ne3np4.nc + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume, cacraig + +List all files eliminated: + + D bld/namelist_files/use_cases/scam_arm95.xml + D bld/namelist_files/use_cases/scam_arm97.xml + D bld/namelist_files/use_cases/scam_gateIII.xml + D bld/namelist_files/use_cases/scam_mpace.xml + D bld/namelist_files/use_cases/scam_sparticus.xml + D bld/namelist_files/use_cases/scam_togaII.xml + D bld/namelist_files/use_cases/scam_twp06.xml + - These are now available via xml defaults + D cime_config/usermods_dirs/scam_arm95/shell_commands + D cime_config/usermods_dirs/scam_arm95/user_nl_cam + D cime_config/usermods_dirs/scam_arm97/shell_commands + D cime_config/usermods_dirs/scam_arm97/user_nl_cam + D cime_config/usermods_dirs/scam_atex/shell_commands + D cime_config/usermods_dirs/scam_atex/user_nl_cam + D cime_config/usermods_dirs/scam_bomex/user_nl_cam + D cime_config/usermods_dirs/scam_cgilsS11/shell_commands + D cime_config/usermods_dirs/scam_cgilsS11/user_nl_cam + D cime_config/usermods_dirs/scam_cgilsS12/shell_commands + D cime_config/usermods_dirs/scam_cgilsS12/user_nl_cam + D cime_config/usermods_dirs/scam_cgilsS6/shell_commands + D cime_config/usermods_dirs/scam_cgilsS6/user_nl_cam + D cime_config/usermods_dirs/scam_dycomsRF01/shell_commands + D cime_config/usermods_dirs/scam_dycomsRF01/user_nl_cam + D cime_config/usermods_dirs/scam_dycomsRF02/shell_commands + D cime_config/usermods_dirs/scam_dycomsRF02/user_nl_cam + D cime_config/usermods_dirs/scam_gateIII/shell_commands + D cime_config/usermods_dirs/scam_gateIII/user_nl_cam + D cime_config/usermods_dirs/scam_micre2017/shell_commands + D cime_config/usermods_dirs/scam_micre2017/user_nl_cam + D cime_config/usermods_dirs/scam_mpace/shell_commands + D cime_config/usermods_dirs/scam_mpace/user_nl_cam + D cime_config/usermods_dirs/scam_rico/shell_commands + D cime_config/usermods_dirs/scam_rico/user_nl_cam + D cime_config/usermods_dirs/scam_SAS/shell_commands + D cime_config/usermods_dirs/scam_SAS/user_nl_cam + D cime_config/usermods_dirs/scam_sparticus/shell_commands + D cime_config/usermods_dirs/scam_sparticus/user_nl_cam + D cime_config/usermods_dirs/scam_togaII/shell_commands + D cime_config/usermods_dirs/scam_togaII/user_nl_cam + D cime_config/usermods_dirs/scam_twp06/shell_commands + D cime_config/usermods_dirs/scam_twp06/user_nl_cam + - replace by xml defaults + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/include_user_mods + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/shell_commands + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cam + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_clm + D cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cpl + - no longer valid for mpace setup + D src/control/history_defaults.F90 + - after moving scam specific code there was nothing left here + + +List all files added and what they do: N/A + A cime_config/usermods_dirs/scam_camfrc/shell_commands + A cime_config/usermods_dirs/scam_camfrc/user_nl_cam + A cime_config/usermods_dirs/scam_mandatory/shell_commands + - template directories for usermods to scam. + + A src/dynamics/se/apply_iop_forcing.F90 + A src/dynamics/se/dycore/se_single_column_mod.F90 + - enable iop forcing for SE SCM + +List all existing files that have been modified, and describe the changes: + M .gitmodules + - update cice to fix scam failure + - update cdeps to fix CDEPS regression test build failures + M bld/build-namelist + - update namelist defaults for scm relaxation. + M bld/config_files/definition.xml + - new configurations option for scam_iops + M bld/configure + - new configure options for SCAM refactor + M bld/namelist_files/namelist_defaults_cam.xml + M bld/namelist_files/namelist_definition.xml + - new configurations option for scam_iops + M cime_config/buildcpp + - setup new build for se SCAM test + M cime_config/config_component.xml + M cime_config/config_compsets.xml + - add scam defaults to cime + M cime_config/config_pes.xml + - add scam se pe defaults + M cime_config/SystemTests/sct.py + - setup new BFB se SCAM test + M cime_config/testdefs/testlist_cam.xml + - fix mpace test and add test_scam category + M cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands + - add new scam se regression tests + M cime_config/usermods_dirs/scam_mandatory/shell_commands + - add warmstart logic + M src/control/cam_comp.F90 + - cleanup some of the BFB_CAM_SCAM_IOP cppdefs + M src/control/cam_history.F90 + - set write_camiop logical if CAMIOP history type is requested by user. + M src/control/getinterpnetcdfdata.F90 + M src/control/history_scam.F90 + - generalize for output on single column grid + M src/control/ncdio_atm.F90 + - add physgrid_scm, scam uses the full physgrid to read data from boundary and + M src/control/scamMod.F90 + - new control parameters for SCAM-SE + M src/dynamics/eul/diag_dynvar_ic.F90 + M src/dynamics/eul/dyn_comp.F90 + M src/dynamics/eul/dynpkg.F90 + - remove more scam CPP defines + M src/dynamics/eul/dyn_grid.F90 + M src/dynamics/eul/iop.F90 + - generalize to use common routines for SE and EUL + M src/dynamics/eul/restart_dynamics.F90 + - remove more scam CPP defines + M src/dynamics/eul/scmforecast.F90 + M src/dynamics/eul/stepon.F90 + M src/dynamics/eul/tfilt_massfix.F90 + - refactor/cleanup + M src/dynamics/se/advect_tend.F90 + - capture SE advective tendencies for BFB testing + M src/dynamics/se/dp_coupling.F90 + - phys/dyn interface additions for SE-SCAM + M src/dynamics/se/dycore/prim_advance_mod.F90 + M src/dynamics/se/dycore/prim_driver_mod.F90 + M src/dynamics/se/dycore/vertremap_mod.F90 + M src/dynamics/se/dycore/viscosity_mod.F90 + - refactor/cleanup + M src/dynamics/se/dyn_comp.F90 + M src/dynamics/se/dyn_grid.F90 + - add SE single column mod + M src/dynamics/se/gravity_waves_sources.F90 + - hvcoord + M src/dynamics/se/stepon.F90 + - add SE SCAM iop update calls + M src/infrastructure/phys_grid.F90 + - update for single column phys grid + M src/physics/cam7/physpkg.F90 + M src/physics/cam/cam_diagnostics.F90 + - clean up BFB cpp defs + M src/physics/cam/check_energy.F90 + - add heat_glob for SE iop + M src/physics/cam/chem_surfvals.F90 + - add column initialization for greenhouse gasses + M src/physics/cam/clubb_intr.F90 + - use model grid box size not arbitrary SCM column size + M src/physics/cam/convect_shallow.F90 + - add DQP diagnostic + M src/physics/cam/phys_grid.F90 + - define scm single column grid for scm history + M src/physics/cam/physpkg.F90 + - clean up BFB cpp defs + M src/utils/cam_grid_support.F90 + - add trim to grid name + M src/utils/hycoef.F90 + - add hvcoord struct + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + - pre-existing pend/failures -- need fix in CLM external + + SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep BFAIL + - New Test; Failure expected (SCAM on spectral element grid) + + SMS_D_Ln9.T42_T42.FSCAMARM97.derecho_intel.cam-outfrq9s BFAIL + - New Test; Failure expected; FSCAM compset named changed to FSCAMARM97 + + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + - Roundoff answer changes expected to existing SCAM prep cases + + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + - Expected differenc due to cice update, only 2 fields different as new cice has annual restarts off. + + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: NLFAIL) details: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: NLFAIL) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: NLFAIL) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: NLFAIL) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: NLFAIL) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: NLFAIL) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: NLFAIL) details: + SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: NLFAIL) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: NLFAIL) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: NLFAIL) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: NLFAIL) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: NLFAIL) details + - Expected failures, In addition to differences these tests also failed namelist comparisons due to the updated cice + +derecho/nvhpc/aux_cam: + ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: NLFAIL) + - Expected failures due to the updated cice + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure - issue #670 + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + - Roundoff answer changes expected to existing SCAM cases + +izumi/gnu/aux_cam: + SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: FAIL) + - New Test Failure expected. + SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + - Roundoff answer changes expected to existing SCAM cases + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + - Expected namelist failure due to cice update. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: SCAM tests +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): new climate - larger changes confined to top levels that were ignored in previous versions. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +=============================================================== +=============================================================== + +Tag name: cam6_4_022 +Originator(s): cacraig +Date: Aug 19, 2024 +One-line Summary: Remove 0.5*timestep from call to ZM +Github PR URL: https://github.com/ESCOMP/CAM/pull/1127 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Remove half timestep from ZM code: https://github.com/ESCOMP/CAM/issues/1124 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M .gitmodules +M src/atmos_phys + - Update atmos_phys tag to bring in the ZM changes from it + +M src/physics/cam/zm_conv_intr.F90 +M src/physics/spcam/crmclouds_camaerosols.F90 + - Change the CAM calls to ZM + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + - pre-existing failures -- need fix in CLM external + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure -- need fix in CICE external + + ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - Roundoff answer changes expected + +derecho/nvhpc/aux_cam: + ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: DIFF) details: + - Roundoff answer changes expected + + +izumi/nag/aux_cam: +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure - issue #670 + + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + - Roundoff answer changes expected + +izumi/gnu/aux_cam: + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - Roundoff answer changes expected + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: All which call ZM +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): roundoff + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + - Conclusion reached by Adam Harrington - See issue for testing details + +=============================================================== +=============================================================== + +Tag name: cam6_4_021 +Originator(s): jet +Date: 16 Aug 2024 +One-line Summary: CCPPize dadadj +Github PR URL: https://github.com/ESCOMP/CAM/pull/1026 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Issue #928 - Convert Dry Adiabatic Adjustment to CCPP and move into the atmospheric_physics github repo + - Bugfix to dadadj although it didn't change answers in the regression suite. + +Describe any changes made to build system: add atmos_phys/dry_adiabatic_adjust directory to build filepath + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, nusbaume + +List all files eliminated: +D physics/cam/dadadj.F90 + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M .gitmodules + - update to atmospheric_physics tag with new dry_adiabatic_adjust ccpp routine + +M bld/configure + - Add dry_adiabatic_adjust to build Filepath +M src/cam_snapshot_common.F90 + - update pbuf_snapshot fields from 250 to 300 +M physics/cam/dadadj_cam.F90 + - CCPP'ize dadadj interface +M physics/physpkg.F90 +M physics/cam7/physpkg.F90 + - update subroutine name for cam dadadj initialization + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +- pre-existing failures -- need fix in CLM external + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure -- need fix in CICE external + +derecho/nvphc/aux_cam: All Pass + +izumi/nag/aux_cam: +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure - issue #670 + + +izumi/gnu/aux_cam: All Pass + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB, as expected + +=============================================================== + +Tag name: cam6_4_020 +Originator(s): fvitt +Date: 14 Aug 2024 +One-line Summary: Correction to aerosol convective removal and other misc fixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/1111 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Fixes to the follow: + . an error in the calculation of dz in the aerosol convective removal code + . issue #1030 -- Incorrect waccm_forcing namelist settings in FWsc2000climo and FWsc2010climo compsets + . issue #1125 -- archive_baselines does not append compiler onto derecho baselines properly + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml + - corrections to waccm_forcing namelist settings + +M src/chemistry/modal_aero/modal_aero_convproc.F90 + - correctly calculate dz + - misc code clean up + +M test/system/archive_baseline.sh + - append compiler name to tag name used in baseline path + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s + - pre-existing failure -- need fix in CICE external + + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + DIFF ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp + DIFF ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase + DIFF ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + DIFF ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s + DIFF ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 + DIFF ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes + DIFF ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 + DIFF ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 + DIFF ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 + DIFF SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + DIFF SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + DIFF SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + DIFF SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase + DIFF SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + DIFF SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m + DIFF SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging + DIFF SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + DIFF SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - expected baseline test failures due to correction in modal_aero_convproc + +derecho/nvhpc/aux_cam: + DIFF ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default + - expected baseline test failure due to correction in modal_aero_convproc + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + DIFF ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am + DIFF ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist + DIFF ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s + DIFF ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s + DIFF ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 + DIFF SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase + - expected baseline test failures due to correction in modal_aero_convproc + +izumi/gnu/aux_cam: + DIFF ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s + DIFF ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp + DIFF SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 + - expected baseline test failures due to correction in modal_aero_convproc + +Summarize any changes to answers: + larger than roundoff but same climate + +URL for AMWG diagnostics output used to validate new climate: + + https://acomstaff.acom.ucar.edu/tilmes/amwg/cam7/f.e23_beta02.FLTHIST_ne30.conv_dz_bug_1995_2004_vs_f.e23_beta02.FLTHIST_ne30.001_1995_2004/website/index.html + https://acomstaff.acom.ucar.edu/tilmes/amwg/cam7/f.cam6_3_160.FMTHIST_ne30.moving_mtn.output.conv7_1996_2004_vs_f.cam6_3_160.FMTHIST_ne30.moving_mtn.output.conv6_1996_2004/website/html_table/mean_tables.html + +=============================================================== +=============================================================== + +Tag name: cam6_4_019 +Originator(s): katec, cacraig, vlarson, bstephens82, huebleruwm, zarzycki, JulioTBacmeister, jedwards4b +Date: 12 August 2024 +One-line Summary: New CLUBB external, new GPU/nvhpc test suite, new CDEPS external +Github PR URL: https://github.com/ESCOMP/CAM/pull/1086 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - New CLUBB external with fixes to support GPU testing #1036 + - part of cam6_4_019: Add GPU regression test suite #1048 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + - Add default vaules for a few new CLUBB namelist parameters: clubb_bv_efold, clubb_wpxp_Ri_exp, and clubb_z_displace + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, sjsprecious, adamrher, bstephens82 + +List all files eliminated: + cime/config/testmods_dirs/cam/outfrq9s_mg3_nondefault/shell_comands + cime/config/testmods_dirs/cam/outfrq9s_mg3_nondefault/user_nl_cam + cime/config/testmods_dirs/cam/outfrq9s_mg3_nondefault/user_nl_clm + - Removed as part of GPU test updates + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + .gitmodules + - Point to new CLUBB external (clubb_4ncar_20240605_73d60f6_gpufixes_posinf) + and new CDEPS external (cdeps1.0.45) + + cime/config/testdefs/testlist_cam.xml + - Add nvhpc gpu test on Derecho, remove Casper tests + + cime/config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/shell_commands + cime/config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/shell_commands + - Change NTASKS for Derecho gpus + + cime/config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/ + - Directory renamed to cime/config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols760 + - Files updated to reflect the change + + doc/ChangeLog_template + - Added space for new derecho/nvhpc required tests + + src/physics/cam/clubb_intr.F90 + src/physics/cam/subcol_SILHS.F90 + - Updates to support the new external + + test/system/archive_baseline.sh + test/system/test_driver.sh + - Updates to require CAM_FC compiler specification on Derecho (either intel or nvhpc) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +- pre-existing failures -- need fix in CLM external + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure -- need fix in CICE external + +ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: +ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: +ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: +ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: +ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: +ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: +ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: +SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: +SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: +SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: +SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: +SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: +SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: +SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: +SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: +SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: +SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: +SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: +SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +- Expected differences due to the new CLUBB external (See PR for discussion) + +derecho/nvphc/aux_cam: + +ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: DIFF) + FAIL ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_4_018_intel: ERROR BFAIL baseline directory '/glade/campaign/cesm/community/amwg/cam_baselines/cam6_4_018_intel/ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default' does not exist +- Expected baseline compare fail due to no baselines stored for GPU tests that didn't exist previously + +izumi/nag/aux_cam: +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure - issue #670 + +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: +ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: +ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: +SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: +SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: +- Expected differences due to the new CLUBB external (See PR for discussion) + +izumi/gnu/aux_cam: +ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +- Expected differences due to the new CLUBB external (See PR for discussion) + +CAM tag used for the baseline comparison tests if different than previous +tag: cam6_4_018 + +Summarize any changes to answers: + All compsets that use CLUBB (cam6+) will have slight answer changes. Discussion in PR. + Nvhpc gpu tests have no stored baseline for comparison. + +=============================================================== + +Tag name: cam6_4_018 +Originator(s): peverwhee, jedwards4b +Date: 30 July 2024 +One-line Summary: Update git-fleximod to 8.4 and add fleximod_test workflow +Github PR URL: https://github.com/ESCOMP/CAM/pull/1107 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Issue #1113 - Add git-fleximod github CI workflow + +Describe any changes made to build system: update git-fleximod + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar + +List all files eliminated: none + +List all files added and what they do: + +A .github/workflows/fleximod_test.yaml + - add git-fleximod test github workflow + +List all existing files that have been modified, and describe the changes: + +M .gitmodules + - fix fxDONOTUSEurl for cice + +M .lib/git-fleximod/git_fleximod/cli.py +M .lib/git-fleximod/git_fleximod/git_fleximod.py +M .lib/git-fleximod/git_fleximod/submodule.py +M .lib/git-fleximod/pyproject.toml +M .lib/git-fleximod/tbump.toml + - update git-fleximod to v8.4 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +- pre-existing failures -- need fix in CLM external + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure -- need fix in CICE external + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure - issue #670 + +izumi/gnu/aux_cam: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB, as expected + +=============================================================== + +Tag name: cam6_4_017 +Originator(s): eaton +Date: 30 July 2024 +One-line Summary: miscellaneous fixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/1112 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Fixes for: +Issue #1087 - Prevent users from turning on OpenMP when using the SE dycore +Issue #1103 - Bug with physprops files for mam4_mode3 for RRTMGP + +Describe any changes made to build system: +. add check in CAM's configure to fail if SMP is specified with the SE dycore. + +Describe any changes made to the namelist: +. fix attributes in namelist defaults to get the correct physprops file for + mam4_mode3 with RRTMGP + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bld/configure +. If smp is on and the dycore is SE, issue message and exit. + +bld/namelist_files/namelist_defaults_cam.xml +. add missing phys="cam6" attribute so cam7 runs get the correct version of + mam4_mode3_file for rrtmgp + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +. diff due to updating the mam4_mode3 physprop file + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +- pre-existing failures -- need fix in CLM external + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure -- need fix in CICE external + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure - issue #670 + +izumi/gnu/aux_cam: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except cam7/rrtmgp configurations +have different answers due to changing the mam4_mode3 physprops file. + +=============================================================== +=============================================================== + +Tag name: cam6_4_016 +Originator(s): brianpm, eaton +Date: 25 July 2024 +One-line Summary: Modify RRTMGP interface for MT configurations. +Github PR URL: https://github.com/ESCOMP/CAM/pull/1100 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Issue #1063 - Possible modification to RRTMG-P for ~80km top model +. Modify the RRTMGP interface for the special case when the minimum valid + pressure for RRTMGP (1 Pa) falls in the top model layer (as it does in + CAM's 93 level MT configuration). The modification is to use the "extra + layer" code path, and add a very thin extra layer just below 1 Pa. The + algorithm to calculate the midpoint pressure in the "extra layer" has + changed from the original (which assumed a model top at 0 Pa). Hence the + change affects answers for the low top model configurations (cam7-LT and cam6) + as well as the cam7-MT configuration. + + Note that this modification is still being tested for scientific validity + in the cam7-MT configuration. + +Issue #1097 - HEMCO reference in .gitmodules is a branch not a tag. +. Modify .gitmodules to resolve #1097 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +.gitmodules +- hemco-cesm1_2_1_hemco3_6_3_cesm_rme => hemco-cesm1_2_1_hemco3_6_3_cesm_rme01 + +src/physics/rrtmgp/radiation.F90 +src/physics/rrtmgp/rrtmgp_inputs.F90 +. Identify special case of 1 Pa pressure level being contained in the top + model layer. Treat that case as though an "extra layer" is needed, and + add a very thin extra layer just below 1 Pa. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +- diffs due to change in RRTMGP interface + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +- pre-existing failures -- need fix in CLM external + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure -- need fix in CICE external + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure - issue #670 + +izumi/gnu/aux_cam: + +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) +SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: DIFF) +- diffs due to change in RRTMGP interface + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except answer changes expected for +configurations using cam7MT, cam7LT, and cam6 with RRTMGP + +=============================================================== +=============================================================== + +Tag name: cam6_4_015 +Originator(s): jedwards, eaton +Date: 23 July 2024 +One-line Summary: misc fixes: buildcpp, check_energy +Github PR URL: https://github.com/ESCOMP/CAM/pull/1072 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Issue #1045 - buildcpp does not report errors reported by cam configure + - modify buildcpp so that error messages from CAM's configure appear in + the log output + +. Issue #1015 - SILHS subcolumns output as all zeros. + - testing for this issue revealed a bug when subcolumns were used with + the SE dycore. A fix is added to check_energy.F90. This doesn't fix + the problem with zeros in the subcolumn output, but that is the same + problem previously reported for COSP in issue #944. The problem only + appears when SE grid output is interpolated. A workaround is to output + the subcolumns on the native SE grid. + +. Issue #1044 - Remove solar_htng_spctrl_scl from aquaplanet use case + - also cleaned up the aquaplanet_rce_cam6.xml file which had duplicated + settings of several variables. The second setting is not used because + the first setting takes precedence. Note that the setting of + solar_htng_spctrl_scl to false in aquaplanet_rce_cam6.xml is needed + because it is overriding the default of true for cam6 with RRTMG. + +. resolves #1045 (and replaces PR #1046) +. resolves #1015 +. resolves #1044 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bld/namelist_files/use_cases/aquaplanet_cam5.xml +bld/namelist_files/use_cases/aquaplanet_cam6.xml +. remove solar_htng_spctrl_scl + +bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml +. remove duplicated (and hence unused) settings for solar_irrad_data_file, + prescribed_ozone_file, and solar_htng_spctrl_scl + +cime_config/buildcpp +. run configure command from run_cmd() rather than run_cmd_no_fail() and + pass error output to logger.warning() + +src/physics/cam/check_energy.F90 +. fix out of bounds array references when subcolumns are used in the SE + specific hydrostatic energy scaling. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +- pre-existing failures -- need fix in CLM external + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failure -- need fix in CICE external + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure - issue #670 + +izumi/gnu/aux_cam: + +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) +- solution diffs because solar_htng_spctrl_scl is now getting the correct + value of .false. (what RRTMGP requires). The use case file was + previously incorrectly setting this value to .true. (what RRTMG requires). + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam6_4_014 +Originator(s): fvitt +Date: 22 Jul 2024 +One-line Summary: Clean up WACCMX use of ESMF gridded component +Github PR URL: https://github.com/ESCOMP/CAM/pull/1069 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Remove the ESMF gridded component layer in WACCMX #1055 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: gold2718 cacraigucar + +List all files eliminated: +D src/ionosphere/waccmx/edyn_grid_comp.F90 + - remove gridded component layer which was needed for MCT component coupling + +List all files added and what they do: +A src/ionosphere/waccmx/edyn_phys_grid.F90 + - manaages the physics grid mesh for ESMF regridding + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml + - default rxn_rate_sums for waccmx + +M bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml +M bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml + - changes for zm history fields + +M cime_config/testdefs/testlist_cam.xml + - multi-instance test + +M src/ionosphere/waccmx/edyn_init.F90 +M src/ionosphere/waccmx/ionosphere_interface.F90 + - invoke dpie_coupling directly + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + NLFAIL ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s + - new namelist includes default rxn_rate_sums for waccmx + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s + - pre-existing failure -- will go away when CICE external is updated post git-fleximod + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + NLFAIL SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + - new namelist includes default rxn_rate_sums for waccmx + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_4_013 +Originator(s): fvitt, tilmes +Date: 21 Jul 2024 +One-line Summary: Aerosol wet removal bug fixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/1085 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Fix aerosol convective wet removal bugs #1024 + . Move adjustment of dcondt to after tendencies are moved to largest mode + when convproc_do_evaprain_atonce is TRUE + . Fix indexing issues in application of resuspension tendencies to + cloud-borne aerosols + . Do convective wet removal before stratoform rain out + . Move calculation of aerosol wet radius from wetdep subroutine to physpkg + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M src/chemistry/bulk_aero/aero_model.F90 + - need wetdep_lq public + +M src/chemistry/modal_aero/aero_model.F90 + - need wetdep_lq public + - add convective wet removal diagnostics + - move calc of wet radius from wetdep subroutine to physpkg + - do convective wet removal before stratoform rain out + - fix indexing issues in application of resuspension tendencies to + cloud-borne aerosols + +M src/chemistry/modal_aero/modal_aero_convproc.F90 + - add convective wet removal diagnostics + - move adjustment of dcondt to after tendencies are moved to largest mode + when convproc_do_evaprain_atonce is TRUE + +M src/physics/cam/physpkg.F90 +M src/physics/cam_dev/physpkg.F90 + - move calc of wet radius from wetdep subroutine to physpkg + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s + - pre-existing failure -- will go away when CICE external is updated post git-fleximod + + DIFF ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp + DIFF ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase + DIFF ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase + DIFF ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + DIFF ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s + DIFF ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 + DIFF ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes + DIFF ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 + DIFF ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 + DIFF ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 + DIFF SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep + DIFF SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase + DIFF SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + DIFF SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + DIFF SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + DIFF SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase + DIFF SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + DIFF SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m + DIFF SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging + DIFF SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + DIFF SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs + DIFF SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - baseline differences due to changes in aersol wet removal + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + DIFF ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt + DIFF ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp + DIFF ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol + DIFF ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am + DIFF ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist + DIFF ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s + DIFF ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s + DIFF ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac + DIFF ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + DIFF ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 + DIFF ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf + DIFF PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + DIFF PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + DIFF SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam + DIFF SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase + DIFF SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s + DIFF TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + DIFF TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 + - baseline differences due to changes in aersol wet removal + +izumi/gnu/aux_cam: + DIFF ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon + DIFF ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s + DIFF ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp + DIFF ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s + DIFF PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 + DIFF SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 + DIFF SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac + - baseline differences due to changes in aersol wet removal + +Summarize any changes to answers: larger than roundoff but same climate + +URL for AMWG diagnostics output used to validate new climate: + https://acomstaff.acom.ucar.edu/tilmes/amwg/cam7/f.cam6_3_160.FMTHIST_ne30.moving_mtn.output.conv6_1996_2005_vs_f.cam6_3_160.FMTHIST_ne30.moving_mtn.output.001_1996_2005/website/index.html + + +=============================================================== +=============================================================== + +Tag name: cam6_4_012 +Originator(s): fvitt, tilmes, lkemmons +Date: 19 Jul 2024 +One-line Summary: Add climate-chemistry compset +Github PR URL: https://github.com/ESCOMP/CAM/pull/1074 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Add climate-chemistry compset (FCts4MTHIST) which uses a simplified chemistry mechanism (trop_strat_mam5_ts4) + (Implement Climate-Chemistry compset #1064). + + Update user defined reaction rates for tagged CO species + (Updates to mo_usrrxt chemistry module #1065). + + Fix issue in cam7 physics where the water paths are not defined before they + are used in cloud optics on the 1st time step. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: +A bld/namelist_files/use_cases/hist_trop_strat_ts4_cam7.xml + - out-of-the box namelist settings for FCts4MTHIST compset + +A src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.doc +A src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.in +A src/chemistry/pp_trop_strat_mam5_ts4/chem_mods.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/m_rxt_id.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/m_spc_id.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_adjrxt.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_exp_sol.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_imp_sol.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_indprd.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_lin_matrix.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_factor.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_solve.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_nln_matrix.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_phtadj.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_prod_loss.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_rxt_rates_conv.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_setrxt.F90 +A src/chemistry/pp_trop_strat_mam5_ts4/mo_sim_dat.F90 + - new climate-chemistry mechanism + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist + - set emissions appropriately for the new climate-chemistry compset + +M bld/config_files/definition.xml +M bld/configure + - new climate-chemistry trop_strat_mam5_ts4 chemisty package + +M bld/namelist_files/namelist_defaults_cam.xml + - rxn_rate_sums for new climate-chemistry trop_strat_mam5_ts4 + - default ne3 IC file for trop_strat_mam5_ts4 + +M cime_config/config_component.xml +M cime_config/config_compsets.xml + - new climate-chemistry compset FCts4MTHIST + +M cime_config/testdefs/testlist_cam.xml + - add tests for FCts4MTHIST + +M src/chemistry/mozart/mo_usrrxt.F90 + - changes for tagged CO reactions + +M src/physics/cam/cloud_diagnostics.F90 +M src/physics/cam/physpkg.F90 +M src/physics/cam7/physpkg.F90 + - initialize water paths to zero before they are used by cloud optics in cam7 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s + - pre-existing failure -- will go away when CICE external is updated post git-fleximod + + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s + - new test for the FCts4MTHIST compset + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: All Pass + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_4_011 +Originator(s): jedwards, eaton, cacraig +Date: July 19, 2024 +One-line Summary: Update submodules, git-fleximod; fix fv3 build; remove mct reference +Github PR URL: https://github.com/ESCOMP/CAM/pull/1089 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +This PR replaces PR #1067 and #1075 by merging them with other updates. + +. update submodules to be consistent with cesm3_0_alpha02a + +. merge in PR #1067 - fix the path to fms for fv3 build, remove mct reference: https://github.com/ESCOMP/CAM/issues/1068 + +. merge in PR #1075 - Git fleximod update0.8.2: https://github.com/ESCOMP/CAM/issues/1076 + +. Fix CLM regression errors due to their upgrade and older version no longer working with CAM7 runs: https://github.com/ESCOMP/CAM/issues/1091 + +. resolves #1076 +. resolves #1068 +. resolves #1091 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +.gitmodules +. remove submodule "mct" +. cismwrap_2_2_001 -> cismwrap_2_2_002 +. rtm1_0_79 -> rtm1_0_80 +. mosart1_0_49 -> mosart1.1.02 +. cesm-coupling.n02_v2.1.2 -> cesm-coupling.n02_v2.1.3 +. ccs_config_cesm0.0.106 -> ccs_config_cesm1.0.0 +. cime6.0.246 -> cime6.1.0 +. cmeps0.14.67 -> cmeps1.0.2 +. cdeps1.0.34 -> cdeps1.0.43 +. share1.0.19 -> share1.1.2 +. ctsm5.2.007 -> ctsm5.2.009 + +cime_config/buildcpp +. remove mct conditional + +cime_config/buildlib +. fix sharedpath and fmsbuilddir + +cime_config/config_compsets.xml +. Change from CLM51 to CLM60 for all CAM7 compsets + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s RUN + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s GENERATE exception + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + - pre-existing failures - need fix in CLM external + + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s RUN time=65 + - Bug in med.F90 - Will go away when CICE external is updated post git-fleximod + + ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - Answer changes due to external updates - FIELDLIST differ only + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + PEND DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure - issue #670 + + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + - Answer changes due to external updates - FIELDLIST differ only + +izumi/gnu/aux_cam: + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - Answer changes due to external updates - FIELDLIST differ only + +Summarize any changes to answers: FIELDLIST differences only + +=============================================================== +=============================================================== + +Tag name: cam6_4_010 +Originator(s): juliob, cacraig +Date: July 18, 2024 +One-line Summary: Initial Gravity Wave moving mountain +Github PR URL: https://github.com/ESCOMP/CAM/pull/1057 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - New gravity wave source - "moving mountains": https://github.com/ESCOMP/CAM/issues/942 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - Introduce: + use_gw_movmtn_pbl - If true, then turns on GW moving mountain from PBL moving mountain source + alpha_gw_movmtn - Tunable parameter controlling proportion of boundary layer momentum flux escaping + as GW momentum flux + gw_drag_file_mm - Relative pathname of lookup table for deep convective moving mountain GW source + NOTE - This file is expected to be replaced, so it has not been committed to the svn repository and + only resides on derecho. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraig, nusbaume + +List all files eliminated: + +List all files added and what they do: +A src/physics/cam/gw_movmtn.F90 + - Moving mountain module + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - Mods for new namelist variables described above + +M src/physics/cam/clubb_intr.F90 +M src/physics/cam/gw_drag.F90 +M src/physics/cam/phys_control.F90 + - Mods to support moving mountains + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s RUN + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s GENERATE exception + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + - pre-existing failures - need fix in CLM external + + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s RUN time=65 + - Bug in med.F90 - Will go away when CICE external is updated post git-fleximod + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + - Baseline differences due to using moving mountains for CAM7 runs (Also had NLCOMP failures for these exact same tests) + + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + PEND DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: all pass + +Summarize any changes to answers, i.e., +- what code configurations: all CAM7 +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): Julio ran FMTHIST for 4 years and approved the results + + +=============================================================== +=============================================================== + +Tag name: cam6_4_009 +Originator(s): bdobbins, fvitt, cacraig +Date: July 11th, 2024 +One-line Summary: replaced outdated log-gamma function with intrinsic +Github PR URL: https://github.com/ESCOMP/CAM/pull/1081 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Cleanup - replacing log-gamma function with F2008 intrinsic in WACCMX code #1080 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: fvitt + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M src/ionosphere/waccmx/wei05sc.F90 + - Replaces calls to a log-gamma function w/ math intrinsic + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + - pre-existing failures - need fix in CLM external + + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s RUN time=41 + - Bug in med.F90 - Will go away when CICE external is updated post git-fleximod + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + PEND DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: None + +=============================================================== +=============================================================== + +Tag name: cam6_4_008 +Originator(s): pel, cacraig +Date: July 10, 2024 +One-line Summary: HB mods + dycore mods +Github PR URL: https://github.com/ESCOMP/CAM/pull/1071 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Possible modification to HB in CAM7: https://github.com/ESCOMP/CAM/issues/1062 + - HB diffusion in CAM6/7 performs mixing for stable conditions (Ri>0) as well as background mixing in addition to unstable + mixing (Ri<0) + - Modify HB in CAM6/7 to only mix for unstable conditions + - add div4 sponge (in SE dycore) in MT configuration for stability + - friction frictional heating in del4 sponge + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraig + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M src/atmos_phys + - Directory which was updated in cam6_4_007, but not committed + +M src/dynamics/se/dycore/global_norms_mod.F90 +M src/dynamics/se/dycore/prim_advance_mod.F90 +M src/physics/cam/hb_diff.F90 +M src/physics/cam/pbl_utils.F90 + - changes as described above + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD RERUN + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD RERUN + - pre-existing failures - need fix in CLM external + + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s RUN time=44 + - Bug in med.F90 - Will go away when CICE external is updated post git-fleximod + + ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - All tests which use CLUBB will have answer changes + + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + PEND DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure - issue #670 + + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + - All tests which use CLUBB will have answer changes + + +izumi/gnu/aux_cam: + ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - All tests which use CLUBB will have answer changes + + +=============================================================== +=============================================================== + +Tag name: cam6_4_007 +Originator(s): Michael Waxmonsky +Date: 7/8/2024 +One-line Summary: cam6_4_007: CCPP-ized TJ2016 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1070 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- Exchanges TJ2016 source from cam/physics/simple to atmospheric_physics +submodule (https://github.com/ESCOMP/atmospheric_physics/pull/92) + +Describe any changes made to build system: +- Adds src/atmos_phys/tj2016 to list of folders to search for compiling in +/bld/atm/obj/Filepath used during ./preview_namelists + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar, nusbaume + +List all files eliminated: + +$ git diff --name-status cam_development..tj2016 | grep ^D +D src/physics/simple/tj2016.F90 + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +$ git diff --name-status cam_development..tj2016 | grep ^M + +M .gitmodules +- Updating atmospheric_physics to tag atmos_phys0_03_000 + +M bld/configure +- See comment to change in build system + +M src/physics/simple/tj2016_cam.F90 +- Updated API into CCPP-ized TJ2016 precip and sfc_plb_hs run functions + (See https://github.com/ESCOMP/atmospheric_physics/pull/92 for API change desciription). + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s +(Overall: FAIL) details: + FAIL SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD time=3 +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s RUN RERUN +- Pre-existing failures + +izumi/nag/aux_cam: +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=12 + PEND DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da +- Pre-existing failure + +izumi/gnu/aux_cam: N/A + +CAM tag used for the baseline comparison tests if different than previous +tag: +- cesm2_3_alpha17g for manually testing FTJ16 compset + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new climate): N/A + +=============================================================== + +Tag name: cam6_4_006 +Originator(s): pel, eaton +Date: 3 July 2024 +One-line Summary: fix clubb interface bug (dry/moist mixing ratio conversion) +Github PR URL: https://github.com/ESCOMP/CAM/pull/1054 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - fix issue described in https://github.com/ESCOMP/CAM/issues/1053 + . refactor set_wet_to_dry and set_dry_to_wet to require specifying which + constituent type the mixing ratio conversion is applied to + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +.gitmodules +- update fv3 from fv3int_053124 to fv3int_061924 + +src/physics/cam/clubb_intr.F90 +- add convert_cnst_type='wet' to arg list for set_wet_to_dry + +src/physics/cam/physics_types.F90 +- refactor set_wet_to_dry and set_dry_to_wet to require specifying which + constituent mixing ratios are being converted. + +src/dynamics/fv3/dp_coupling.F90 +src/dynamics/fv/dp_coupling.F90 +- add convert_cnst_type='dry' to arg list for set_wet_to_dry + +src/physics/cam/gw_drag.F90 +src/physics/cam/physpkg.F90 +src/physics/carma/cam/carma_intr.F90 +src/physics/simple/physpkg.F90 +- add convert_cnst_type='dry' to arg list for set_dry_to_wet + +src/physics/cam/vertical_diffusion.F90 +- add convert_cnst_type='dry' to arg list for set_dry_to_wet + and set_wet_to_dry + +src/physics/carma/models/cirrus/carma_cloudfraction.F90 +src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 +- remove unused association of set_dry_to_wet and set_wet_to_dry + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) +- pre-existing failures + +ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) +ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) +ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) +ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) +ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) +ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) +ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) +ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) +ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) +SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) +SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) +SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) +SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) +SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) +SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) +SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) +SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) +SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) +SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) +SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) +SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) +SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) +- expected baseline differences for cam6/cam7 physics + +izumi/nag/aux_cam: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) +- pre-existing failure + +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) +ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) +ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) +ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) +SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) +SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) +- expected baseline differences for cam6 physics + +izumi/gnu/aux_cam: + +ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) +- expected baseline differences for cam6 physics + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except all tests using CLUBB (i.e., + cam6 and cam7 physics) will have baseline comparison failures. + +=============================================================== +=============================================================== + +Tag name: cam6_4_005 +Originator(s): eaton +Date: 1 July 2024 +One-line Summary: Limit vertical domain used by COSP. +Github PR URL: https://github.com/ESCOMP/CAM/pull/1010 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +The COSP simulator was not working with "FMT" compsets. This compset has a +model top of about 1 Pa which is above where the cloud parameterizations +operate. The COSP interface routine was modified so that COSP operates on +the same vertical domain as the cloud parameterizations which is set by +the namelist variable trop_cloud_top_press (1 mb by default). Changing to +a dynamically determined top required moving the call to COSP's +initialization. In addition a lot of code cleanup was done, and a bug fix +was made for the layer interface values of height and pressure passed from +CAM to COSP. + +. resolves #967- COSP prevents running "FMT" compsets. + +Removed old tools for topo file generation. + +. resolves #1005 - Remove old topo generation software from CAM + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not measured, but COSP +should be less expensive in models with tops above 1 mb. + +Code reviewed by: cacraig, nusbaume + +List all files eliminated: +tools/definehires/* +tools/definesurf/* +tools/topo_tool/* +. these tools for topo file generation have been replaced by + https://github.com/NCAR/Topo + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +src/control/cam_history_support.F90 +. fix log output format + +src/physics/cam/cospsimulator_intr.F90 +. set top of data operated on by COSP using trop_cloud_top_lev +. cospsimulator_intr_register + - move the setcosp2values call here. That routine contains the call to + COSP's initialization. +. cospsimulator_intr_readnl + - move the call to setcosp2values to cospsimulator_intr_register. +. remove outdated and/or unhelpful comments +. remove unused variables +. remove added history fields that had no corresponding outfld calls +. remove array section notation from places where the whole array is used + +src/physics/cam/ref_pres.F90 +. add calls to create vertical coordinate variables for the domain bounded + by trop_cloud_lev_top. Some COSP history fields need this coordinate. + +src/utils/hycoef.F90 +. add comment and fix a comment + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: All PASS except: +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) +SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) +- pre-existing failures + +izumi/nag/aux_cam: All PASS except: +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: PEND) +- pre-existing failure + +izumi/gnu/aux_cam: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. Note that although the regression + tests with COSP diagnostics passed, there are some COSP diagnostic fields that + have answer changes due to a bug fix in the data sent to COSP. + +=============================================================== +=============================================================== + +Tag name: cam6_4_004 +Originator(s): fvitt +Date: 29 Jun 2024 +One-line Summary: Misc corrections for WACCM-X +Github PR URL: https://github.com/ESCOMP/CAM/pull/1023 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Implement corrections to: + - geometric height calculations (issue #987) + - thermosphere heating diagnostics (issue #1013) + - DTVKE vertical diffustion diagnostic + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M src/ionosphere/waccmx/ionosphere_interface.F90 + - Hanli's formulation for geometric height + +M src/physics/cam/vertical_diffusion.F90 + - correction to DTVKE diagnostic + +M src/physics/waccmx/ion_electron_temp.F90 + - corrections to thermosphere heating diagnostics (issue #1013) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures + + DIFF ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s + DIFF ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + DIFF SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + - expected baseline failures in waccmx due to corrections in diagnostices + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure + + DIFF SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + - expected baseline failure in waccmx due to corrections in diagnostices + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_4_003 +Originator(s): adamrher, jet +Date: Thu Jun 28, 2024 +One-line Summary: Corrected L93 default IC files +Github PR URL: https://github.com/ESCOMP/CAM/pull/1040 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + The L93 hybrid coefficients had a discontinuous kink, or offset, creating an anomalously thin layer + in the 300 hPa - 100 hPa altitude range. This region overlaps with the L58 grid, but for some reason + the L58 grid didn't get contaminated like it was in L93. We aren't sure how this happened. + More here: https://github.com/ESCOMP/CAM/issues/1034 + + fixes #1034 - Problematic hybrid coefficients in L99 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: Files with problematic hybrid coeff were + regenerated. + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, jet + +List all files eliminated: + Boundary data defaults eliminated from namelist_defaults_cam.xml (files still exist but will no longer be used) + atm/cam/inic/se/f.cam6_3_112.FCMTHIST_v0c.ne30.non-ogw-ubcT-effgw0.7.001.cam.i.1998-01-01-00000_c230810.nc + atm/cam/inic/se/cam7_FMT_ne30pg3_mg17_L93_c221118.nc + atm/cam/inic/se/cam6_QPC6_topo_ne3pg3_mg37_L93_01-01-31_c221214.nc + atm/cam/inic/se/cam6_QPC6_aqua_ne3pg3_mg37_L93_01-01-31_c221214.nc + +List all files added and what they do: + New files added to data repo and namelist_defaults-cam.xml: + atm/cam/inic/se/f.cam6_3_160.FCMT_ne30.moving_mtn.001.cam.i.1996-01-01-00000_c240618.nc + atm/cam/inic/se/c153_ne30pg3_FMTHIST_x02.cam.i.1990-01-01-00000_c240618.nc + atm/cam/inic/se/cam6_FMTHIST_ne3pg3_mg37_L93_79-02-01_c240517.nc + atm/cam/inic/se/cam6_QPC6_aqua_ne3pg3_mg37_L93_01_02_01_c240518.nc + +List all existing files that have been modified, and describe the changes: + +bld/namelist_files/namelist_defaults_cam.xml +. Replaced problematic 93 level IC defaults with new files. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: BFB except: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failures + +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +- expected change due to new IC default + +izumi/nag/aux_cam: BFB except: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure + +izumi/gnu/aux_cam: BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers: This changes answers for + configurations using new default 93L IC files. + + +=============================================================== +=============================================================== + +Tag name: cam6_4_002 +Originator(s): adamrher, eaton +Date: Wed Jun 26, 2024 +One-line Summary: activate additional clubb diffusion in cam6 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1056 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Resolves #1041 - cam6 should have additional clubb diffusion activated but it doesn't + +. The fix is to set the namelist defaults for clubb_l_do_expldiff_rtm_thlm + the same way that defaults were set for clubb_expldiff before tag cam6_3_059. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +. defaults changed for clubb_l_do_expldiff_rtm_thlm + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, nusbaume + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bld/namelist_files/namelist_defaults_cam.xml +. change defaults for clubb_l_do_expldiff_rtm_thlm to be true when clubb is + used, except when clubb is used with silhs. False otherwise. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: BFB except: + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failures + +SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: +- namelist change for cam6 physics. No answer change for PORT test. + +ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: +ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: +ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: +ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: +ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: +ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: +SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: +SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: +SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: +SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: +SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: +SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: +SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: +SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: +SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: +SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: +SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: +SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +- answer change for cam6 physics + +izumi/nag/aux_cam: BFB except: + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure + +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: +ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: +ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: +ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: +SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: +SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: +- answer change for cam6 physics + +izumi/gnu/aux_cam: BFB except: + +ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: +ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: +- answer changes in cam6 physics + +SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: NLFAIL) details: +- namelist change for cam6 physics. No answer change for this PORT test. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: This changes answers for all + configurations using cam6 physics, except for cam6 with silhs. + +=============================================================== +=============================================================== + +Tag name: cam6_4_001 +Originator(s): eaton +Date: Wed Jun 26, 2024 +One-line Summary: Change name of physics package 'cam_dev' to 'cam7' +Github PR URL: https://github.com/ESCOMP/CAM/pull/1028 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +#813 - Introduce "-phys cam7" and remove "-phys cam_dev". +https://github.com/ESCOMP/CAM/issues/813 + +- The compset tokens CAM%DEV are replaced by CAM70 +- The src/physics/cam_dev/ directory is renamed src/physics/cam7 +- No compset names were changed. + +#1033 - Change DART test to use 128 instead of 108 processors +https://github.com/ESCOMP/CAM/issues/1033 + +- SMS_C80_P108x1_Lh1.f09_f09_mg17.FHIST_DARTC6 + changed to + SMS_C80_P128x1_Lh1.f09_f09_mg17.FHIST_DARTC6 + +Issue #1038 - Replace ne16np4 grid for WACCM HIST test with ne16np4.pg3 +https://github.com/ESCOMP/CAM/issues/1039 + +- SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s + changed to + SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + +Issue #1039 - Change transient ne30np4 cam tests to ne30np4.pg3 #1039 +https://github.com/ESCOMP/CAM/issues/1039 + +- ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s + changed to + ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + +. resolves #813 +. resolves #1033 +. resolves #1038 +. resolves #1039 + +Describe any changes made to build system: + +. The physics package name 'cam_dev' is replaced by 'cam7' +. The compset component 'CAM%DEV' is replaced by 'CAM70' +. No compset names have been changed. + +Describe any changes made to the namelist: + +. cam_physpkg will be set to cam7 instead of cam_dev + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, nusbaume + +List all files eliminated: + +cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/shell_commands +cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/user_nl_clm +src/physics/cam_dev/cam_snapshot.F90 +src/physics/cam_dev/convect_diagnostics.F90 +src/physics/cam_dev/micro_pumas_cam.F90 +src/physics/cam_dev/physpkg.F90 +src/physics/cam_dev/stochastic_emulated_cam.F90 +src/physics/cam_dev/stochastic_tau_cam.F90 +. These files moved from the directories with 'cam_dev' in the name to + directories with 'cam7' in the name. + +List all files added and what they do: + +cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/shell_commands +cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam7/user_nl_clm +. moved from cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev +. shell_commands has cam_dev changed to cam7 + +src/physics/cam7/cam_snapshot.F90 +src/physics/cam7/convect_diagnostics.F90 +src/physics/cam7/micro_pumas_cam.F90 +src/physics/cam7/physpkg.F90 +src/physics/cam7/stochastic_emulated_cam.F90 +src/physics/cam7/stochastic_tau_cam.F90 +. moved from src/physics/cam_dev + +List all existing files that have been modified, and describe the changes: + +.gitmodules +. CMEPS submodule updated to cmeps0.14.67 + +bld/build-namelist +. change 'cam_dev' to 'cam7' +. a consistency check making sure clubb_sgs is used with cam7 is moved to + configure since these settings are known there. +. add check to disallow user setting of do_clubb_sgs + +bld/namelist_files/namelist_defaults_cam.xml +. add default value for cam_physics_mesh for ne16pg3 + +bld/config_files/definition.xml +. change valid_values for 'phys' from 'cam_dev' to 'cam7' + +bld/configure +. change 'cam_dev' to 'cam7' +. the physics package is always specified in the component definition. + Remove the default setting and make sure the -phys option is set. +. set the default chemistry package for cam7 physics to ghg_mam4 +. the setting for 'model_top' was moved to be near the 'nlev' settings. +. change filepath name from src/physics/cam_dev to src/physics/cam7 +. add check that model_top is only specified for cam7 physics. + +bld/namelist_files/namelist_defaults_cam.xml +. change 'cam_dev' to 'cam7' + +bld/namelist_files/namelist_definition.xml +. update description of do_clubb_sgs to indicate that it is not user + settable. + +cime_config/SystemTests/mgp.py +. change 'cam_dev' to 'cam7' + +cime_config/config_component.xml +cime_config/config_compsets.xml +. change 'CAM%DEV' to 'CAM70' +. modify compset matching so that %LT and %MT are only matched for CAM70 + physics. +. remove %GHGMAM4 modifier (default chemistry set in configure) +. F2000dev, FCLTHIST, FCMTHIST - change CLM50 to CLM51. CLM no longer supports CLM50 + with CAM70 physics. + +cime_config/config_pes.xml +. change 'CAM%DEV' to 'CAM70' + +cime_config/testdefs/testlist_cam.xml +. change 'CAM%DEV' to 'CAM70' +. change 'cam_dev' to 'cam7' +. increased walltime limits for several tests that hit time limits on + derecho +. remove F2000dev tests from aux_cam and prealpha categories. Also remove + 2000_CAM70%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV which is + the same as the updated F2000dev. The remaining F2000dev tests will be + updated to use F2000climo once that compset is updated to CAM7. +. Update the following tests which are currently failing due to missing CLM + datasets to use CSLAM grids rather than pure SE + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s +. Change + SMS_C80_P108x1_Lh1.f09_f09_mg17.FHIST_DARTC6 + to + SMS_C80_P128x1_Lh1.f09_f09_mg17.FHIST_DARTC6 +. remove 1 remaining Vmct test + +src/chemistry/mozart/mo_gas_phase_chemdr.F90 +src/physics/cam/nucleate_ice_cam.F90 +src/physics/cam/phys_control.F90 +src/physics/cam/vertical_diffusion.F90 +. change 'cam_dev' to 'cam7' + +src/physics/cam/zm_conv_intr.F90 +. check whether zmconv_parcel_pbl is set true when the bottom layer thickness is + less than 100 m. Issue a warning to the log file if it's not. + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: all PASS except: + +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: +ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: NLFAIL) details: +SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: +- cam_physpkg changed from cam_dev to cam7 + +ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure due to HEMCO not having reproducible results + +ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +- these tests changed to CSLAM grids, so no baseline for comparison + +ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: +- baseline comparisons fail because case name changed from cam_dev to cam7 + +SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: +- pre-existing failures - need fix in CLM external + CLMBuildNamelist::setup_logic_initial_conditions() : use_init_interp is NOT synchronized with init_interp_attributes in the namelist_defaults file, this should be corrected there + +SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: +- expected diff due to changing CLM50 to CLM51 + +SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failure - need fix in CICE external + fails in med.F90 + +izumi/nag/aux_cam: All PASS except + +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure + +izumi/gnu/aux_cam: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB - all diffs are due changing the test + grid, the test case name, or the compset definition (CLM50 -> CLM51). + +=============================================================== +=============================================================== + +Tag name: cam6_3_162 +Originator(s): cacraig, jedwards, nusbaume +Date: June 7, 2024 +One-line Summary: Remove manage externals +Github PR URL: https://github.com/ESCOMP/CAM/pull/1052 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Removes manage_externals/checkout_externals and replaces with git-fleximod (no GitHub issue) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar + +List all files eliminated: +D Externals.cfg +D Externals_CAM.cfg +D manage_externals + - Removed manage_externals functionality + +List all files added and what they do: +A .gitmodules +A .lib/git-fleximod + - Add git-fleximod functionality + +A bin/git-fleximod + - The actual git-fleximod executable + +A ccs_config +A chem_proc +A cime +A components/cdeps +A components/cice +A components/cism +A components/clm +A components/cmeps +A components/mizuRoute +A components/mosart +A components/rtm +A libraries/FMS +A libraries/mct +A libraries/parallelio +A share +A src/atmos_phys +A src/chemistry/geoschem/geoschem_src +A src/dynamics/fv3 +A src/dynamics/mpas/dycore +A src/hemco +A src/physics/ali_arms +A src/physics/carma/base +A src/physics/clubb +A src/physics/cosp2/src +A src/physics/pumas +A src/physics/pumas-frozen +A src/physics/rrtmgp/data +A src/physics/rrtmgp/ext + - Added external directories as required by git-submodule, which git-fleximod is built upon + +List all existing files that have been modified, and describe the changes: + +M .gitignore + - Removed unneeded gitignore lines + +M README.md + - Updated README to reflect new git-fleximod + +M manage_externals/checkout_externals + - Script which tells folks where to find git-fleximod (when they were used to running manage_externals) + +M test/system/TGIT.sh + - modified test to include a check for require .gitmodules file + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +Most tests had the following namelist failures: + ----- +Comparison failed between '/glade/derecho/scratch/cacraig/aux_cam_20240606135848/SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem.GC.aux_cam_20240606135848/CaseDocs/nuopc.runconfig' with '/glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_161/SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem/CaseDocs/nuopc.runconfig' +DRIVER_attributes->PELAYOUT_attributes->ALLCOMP_attributes: +ocn2glc_levels as key not in /glade/derecho/scratch/cacraig/aux_cam_20240606135848/SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem.GC.aux_cam_20240606135848/CaseDocs/nuopc.runconfig + ----- + +derecho/intel/aux_cam: + + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure due to HEMCO not having reproducible results + + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_161: ERROR BFAIL some baseline files were missing + - This test did not run in previous tag due to CTSM tag failure. Is now running, but no baseline to compare against + + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD failed to initialize + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + - These transient grids are no longer supported by CTSM - will update tests in future PR + + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s RUN time=43 + - Bug in med.F90 - Will go away when CICE external is updated post git-fleximod + + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m BASELINE +/glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_161: FIELDLIST field lists differ (otherwise bit-for-bit) + - cice history file has attributes that changed with this run + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_161_gnu: ERROR BFAIL some baseline files were missing + - This test did not run in previous tag due to CTSM tag failure. Is now running, but no baseline to compare against + +=============================================================== +=============================================================== + +Tag name: cam6_3_161 +Originator(s): cacraig +Date: May 16, 2024 +One-line Summary: Update to alpha17 externals +Github PR URL: https://github.com/ESCOMP/CAM/pull/1031 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update externals to match externals which will be used in cesm2_3_beta17: https://github.com/ESCOMP/CAM/issues/985 + - Bring in ccs_config0.0.99: https://github.com/ESCOMP/CAM/issues/1021 + - Unable to compile cam6_3_154 with nvhpc/24.3 on Derecho: https://github.com/ESCOMP/CAM/issues/1025 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update externals to match cesm2_3_beta17 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +NOTE - most tests have namelist differences due to mediator namelist changes + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure + + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: FAIL) details: + - Bug during CREATE_NEWCASE in CTSM code - will go away when CTSM external is updated post git-fleximod + + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - Bug in med.F90 - Will go away when CICE external is updated post git-fleximod + + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD failed to initialize + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: PEND) details: + PEND SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD time=2 + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s SHAREDLIB_BUILD time=1 + - Bugs reported to CTSM and will be fixed when CTSM external is updated post git-fleximod + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - Answer changes due to updated externals + +izumi/nag/aux_cam: all B4B, except: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB except: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: FAIL) details: + - Bug during CREATE_NEWCASE in CTSM code - will go away when CTSM external is updated post git-fleximod + + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - answer changes due to updated externals + + +CAM tag used for the baseline comparison tests if different than previous +tag: cam6_3_159 as cam6_3_160 did not run regression tests + + +=============================================================== +=============================================================== + +Tag name: cam6_3_160 +Originator(s): cacraig, jedwards +Date: April 29, 2024 +One-line Summary: workaround so that sct works on derecho +Github PR URL: https://github.com/ESCOMP/CAM/pull/1019 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Newest ccs_config tag causes the derecho_intel SCT test to fail: https://github.com/ESCOMP/CAM/issues/1017 + + IMPORTANT NOTE: This tag breaks the SCT test on derecho (see below) as it does not bring in the update to ccs_config_cesm0.0.99 + The reason to do this is that this change will be available for the next CESM alpha tag starting today. + In order to not hold up the CESM alpha tag sequence, we do not have time to run the full regression test suite + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume, katec, cacraig + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + M cime_config/SystemTests/sct.py + +TESTING NOTES: Due to time constraints, only the SCT tests were run + +derecho/intel/aux_cam: Only SCT test was run: + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep - Did not even start up with this change when using the + - current ccs_config tag. Error reported in cime-test.o4308193 file: + File "/glade/u/apps/derecho/23.09/opt/._view/dmewvyohndr7lajyom5grftguonqfbdr/lib/python3.10/xml/etree/ElementTree.py", line 580, in parse + self._root = parser._parse_whole(source) + xml.etree.ElementTree.ParseError: not well-formed (invalid token): line 1, column 0 + + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: PASS) details: + - When ccs_config_cesm0.0.99 is used, this test PASSES and is BFB + + +izumi/nag/aux_cam: None run + +izumi/gnu/aux_cam: Only two SCT tests were run and they were BFB and ran fine + +=============================================================== +=============================================================== + +Tag name: cam6_3_159 +Originator(s): katetc, andrewgettelman, sjsprecious +Date: April 26, 2024 +One-line Summary: Diagnostic rainbows and new PUMAS external with fixed GPU directives +Github PR URL: https://github.com/ESCOMP/CAM/pull/702 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Add diagnostic rainbow calculation: https://github.com/ESCOMP/CAM/issues/683 + - Partially addresses Broken PUMAS GPU code and GPU regression test: https://github.com/ESCOMP/CAM/issues/1007 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: sjsprecious, andrewgettelman, cacraigucar, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cgf + - Point to new PUMAS tag + +M cime_config/testdefs/testlist_cam.xml + - Add new test for rainbows output to aux_pumas suite + - Add SCT test to prealpha test suite to ensure it is not broken by the next ccs_config tags + +M cime_config/testdefs/testmods_dir/cam/outfrq9s_pumas_rainbows/shell_comands + cime_config/testdefs/testmods_dir/cam/outfrq9s_pumas_rainbows/user_nl_cam + cime_config/testdefs/testmods_dir/cam/outfrq9s_pumas_rainbows/user_nl_clm + - Added test to the aux_pumas suite to make sure rainbows functionality is maintained + +M src/physics/cam/micro_pumas_cam.F90 + src/physics/cam_dev/micro_pumas_cam.F90 + - Diagnostic rainbows parameterization added identically in both versions of the file. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: all BFB, except: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure + + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_158: DIFF + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_158: DIFF + - Unexpected baseline comparison failures. Documented in ESCOMP/cam issue #1018 + +izumi/nag/aux_cam: all B4B, except: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB + +Summarize any changes to answers: bit-for-bit unchanged except GEOS-Chem and HEMCO tests described in issue #1018 +=============================================================== + +Tag name: cam6_3_158 +Originator(s): cacraig +Date: April 22, 2024 +One-line Summary: ZM clean up round 2 for CAM and cime update for GEOS-Chem +Github PR URL: https://github.com/ESCOMP/CAM/pull/992 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - change zm directory to be zhang_mcfarlane: https://github.com/ESCOMP/CAM/issues/965 + - Reimplement writing within ZM and remove pflx variable: https://github.com/ESCOMP/CAM/issues/978 + - ZM cleanup: https://github.com/ESCOMP/CAM/issues/984 + - Tag cam6_3_157 missing updated .gitignore: https://github.com/ESCOMP/CAM/issues/1012 + - GEOS-Chem compsets will fail due to bugs in CAM and CIME: https://github.com/ESCOMP/CAM/issues/1004 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M .gitignore + - Update FV3 listing + +M externals.cfg + - Update cime to bring in bug fix for GEOS-Chem + +M Externals_CAM.cfg + - Update atmospheric_physics external to bring in changes for ZM + +M bld/configure + - Change directory from zm to zhang-mcfarlane + +M src/physics/cam/cam_snapshot.F90 +M src/physics/cam/convect_deep.F90 +M src/physics/cam/physpkg.F90 +M src/physics/cam_dev/cam_snapshot.F90 +M src/physics/cam_dev/physpkg.F90 + - Remove pflx variable which is not used + +M src/physics/cam/zm_conv_intr.F90 + - Split winds into separate variable + - remove pflx + - reintroduce writing within ZM + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: all BFB, except: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure + + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + - Answer change for HEMCO - approved by Francis and Lizzie due to HEMCO giving different answers when layout changes are made + + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + - no previous baseline + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_157 +Originator(s): jet +Date: Apr 17, 2024 +One-line Summary: Update FV3 FMS externals, added FV3_CAM interface external, now importing core FV3 from GFDL +Github PR URL: https://github.com/ESCOMP/CAM/pull/983 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update FV3 to allow syncing FMS version with CESM + - Ditch NCAR fork of FV3 in favor of pulling in library code from GFDL + - Clean up FV3 makfile + - Closes issue #950 : FMS external version needs to match version used in CESM + +Describe any changes made to build system: + - Replace FV3 fork external with FV3_interface external that inturn imports FV3 from GFDL + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraig, nusbaume, jedwards + +List all files eliminated: + src/dynamics/fv3/dimensions_mod.F90 + src/dynamics/fv3/dp_coupling.F90 + src/dynamics/fv3/dycore_budget.F90 + src/dynamics/fv3/dycore.F90 + src/dynamics/fv3/dyn_comp.F90 + src/dynamics/fv3/dyn_grid.F90 + src/dynamics/fv3/interp_mod.F90 + src/dynamics/fv3/Makefile.in.fv3 + src/dynamics/fv3/pmgrid.F90 + src/dynamics/fv3/restart_dynamics.F90 + src/dynamics/fv3/spmd_dyn.F90 + src/dynamics/fv3/stepon.F90 + src/dynamics/fv3/microphys/gfdl_cloud_microphys.F90 + src/dynamics/fv3/microphys/module_mp_radar.F90 + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - updated FMS tag +M Externals_CAM.cfg + - removed FV3 fork external and replace with FV3_CAM_INTERFACE external +M bld/configure + - add src_override directory for interfacing GFDL lib code to CAM +M cime_config/bldlib + - add bld_fms target to use common FMS library +M cime_config/config_pes.xml + - update FV3 default C96 PE's for Derecho +M cime_config/testdefs/testlist_cam.xml + - add izumi gnu fv3 test +M cime_config/testdefs/testmods_dirs/cam/outfrq9xs_mg3/shell_commands + - fix C96 PE default for derecho +M test/system/TR8.sh + - add ignore for src_override directory of new FV3_CAM_INTERFACE external + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All (coupled) jobs had errors about MEMCOMP failing due to missing files - to +be fixed in upcoming CIME tag + +Many tests also had TPUTCOMP errors which are not reported here. The current +working assumption is that there is an error with the test itself not the CAM code. + +derecho/intel/aux_cam: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - pre-existing failures + + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + - FV3 diff failures are expected due to lack of a baseline file to compare against. + + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: All PASS + +=============================================================== + +Tag name: cam6_3_156 +Originator(s): fvitt +Date: 16 Apr 2024 +One-line Summary: Misc code clean up for WACCM +Github PR URL: https://github.com/ESCOMP/CAM/pull/1001 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Use supported lapack library routine to solve a matrix equation in WACCM physics + efield module (issue #999) + + Misc code clean up in calculations of effective cross section of O2 + + Fix for sd_waccmx_ma_cam6 use case file for waccm_mad_mam5 chemistry + + Minor change to APEX module needed for when NAG compiler '-nan' option is used + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar nusbaume + +List all files eliminated: +D src/chemistry/mozart/sv_decomp.F90 + - remove deprecated matrix solve routines -- replaced by LAPACK DGESV routine + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml + - fix for waccm_mad_mam5 chem + +M src/chemistry/mozart/mo_jshort.F90 + - code clean up in calculations of effective cross section of O2 + +M src/chemistry/utils/apex.F90 + - minor changes for NAG compiler '-nan' option is used + +M src/physics/waccm/efield.F90 + - use LAPACK DGESV routine to solve matrix equation + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + PEND ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 + FAIL SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + - pre-existing failures + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failure -- should be fixed with an external cime update + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_155 +Originator(s): katec,vlarson,bstephens82,huebleruwm,zarzycki,JulioTBacmeister +Date: April 12, 2024 +One-line Summary: Update CLUBB and SILHS to new UWM external +Github PR URL: https://github.com/ESCOMP/CAM/pull/960 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update to new CLUBB external with some taus code modifications https://github.com/ESCOMP/CAM/issues/956 + - Convert CLUBB lat/lon crash remport from radians to degrees https://github.com/ESCOMP/CAM/issues/971 + - Parameter changes related to optimizing CLUBB's taus code for CESM3 https://github.com/ESCOMP/CAM/issues/953 + +Describe any changes made to build system: + - Modify a test to include threading ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s + - Add CLUBB stats output to an ERP or regular aux_cam test via outfrq9s_mg3 test mods + +Describe any changes made to the namelist: + - Add new fields clubb_bv_efold, clubb_wpxp_Ri_exp, clubb_z_displace to default list + - Add default values and namelist definition entries for many CLUBB namelist fields that were previously missing. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: cacraig, adamrher, nusbaume, bstephens + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - Point to new tag for CLUBB and SILHS externals + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - New namelist fields for CLUBB plus improved documentation and specified defaults for some older fields + +M cime_config/testdefs/testlist_cam.xml + - Change one test to be multithreaded + +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/user_nl_cam + - Add CLUBB stats history to tests using these mods + +M cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam + - Update CLUBB stats history to remove Richardson_num which is no longer output + +M cime_config/usermods_dirs/scam_mandatory/shell_commands + - Update shell redirects + +M src/physics/cam/clubb_intr.F90 +M src/physics/cam/subcol_SILHS.F90 + - Updates to support the new CLUBB and SILHS externals + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +Some tests have namelist changes due to changed stream_datafiles name in ice_in + +derecho/intel/aux_cam: + + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failures + + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - Current failure, but should be fixed when cime external is next updated + + SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + - New namelist fields for cam6 but CLUBB not used in Port compset + + ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - All tests using CLUBB will see small answer changes + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + - All tests using CLUBB will see small answer changes + +izumi/gnu/aux_cam: + SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: NLFAIL) details: + - New namelist fields for cam6 but CLUBB not used in Port compset + + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - All tests using CLUBB will see small answer changes + +CAM tag used for the baseline comparison tests if different than previous +tag: previous tag - cam6_3_154 + +Summarize any changes to answers, i.e., +- what code configurations: All configurations that use CLUBB will see answer changes (cam6 and cam_dev) +- what platforms/compilers: All platforms and compilers +- nature of change (roundoff; larger than roundoff but same climate; new +climate): Larger than roundoff but very similar climate (not verified by ECT) + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced: +- Compare cam6_3_154 to development branch in a 1 year F2000dev f09_f09_mg17 case +- Diagnostics here: https://webext.cgd.ucar.edu/F2000climo/newCLUBBtesting/larson_tag_20231115.katemerge.011124-1252.F2000dev.f09_f09_mg17_1_2_vs_larson_tag_control.cam6_3_145.011124-1252.F2000dev.f09_f09_mg17_1_2/ + + +=============================================================== + +Tag name: cam6_3_154 +Originator(s): megandevlan, jedwards, cacraig +Date: April 4, 2024 +One-line Summary: Update U10 to be resolved wind; add variable for U10+gusts +Github PR URL: https://github.com/ESCOMP/CAM/pull/994 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Remove gustiness term from U10/add new variable with gustiness: https://github.com/ESCOMP/CAM/issues/991 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraig + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Bring in updated CMEPS and CDEPS to get U10 changes made in CMEPS + +M src/control/camsrfexch.F90 +M src/cpl/nuopc/atm_import_export.F90 +M src/physics/cam/cam_diagnostics.F90 + - Add U10 with gust variables + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +Some tests have namelist changes due to changed stream_datafiles name in ice_in + +derecho/intel/aux_cam: + + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failures + + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - Current failure, but should be fixed when cime external is next updated + + ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - Answer changes due to U10 output variable changes + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + - Answer changes due to U10 output variable changes + +izumi/gnu/aux_cam: + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - Answer changes due to U10 output variable changes + +=============================================================== +=============================================================== + +Tag name: cam6_3_153 +Originator(s): cacraig, hannay, jedwards, lizziel +Date: March 26, 2023 +One-line Summary: Update namelist settings +Github PR URL: https://github.com/ESCOMP/CAM/pull/981 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Bring in namelist settings which Cecile is using for current testing: https://github.com/ESCOMP/CAM/issues/976 + - Remove README_EXTERNALS: https://github.com/ESCOMP/CAM/issues/954 + - fix so that all three flavors of intel compiler are recognized: https://github.com/ESCOMP/CAM/pull/990 + - CAM no longer builds with intel-oneapi compilers: https://github.com/ESCOMP/CAM/issues/988 + - GEOS-Chem compsets will fail due to bugs in CAM and CIME: https://github.com/ESCOMP/CAM/issues/1004 + - This fixes the CAM bug. The CIME bug will be addressed the next time externals are updated. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: Just change default namelist settings as described below + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume, adamher + +List all files eliminated: +D README_EXTERNALS + - Remove obsolete file (discussed svn externals, which is no longer used) + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M bld/configure + - Fix from Jim to support selecting various intel compilers + +M bld/namelist_files/namelist_defaults_cam.xml + - Change namelist settings to mimic Cecile's settings for cam_dev runs + +M cime_config/buildnml + - Fix typo which prevented GEOS-Chem from finding yml file + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: all BFB except: + + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + - Namelist and baseline differences for all cam_dev runs + + + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failures + + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - Current failure, but should be fixed when cime external is next updated + +izumi/nag/aux_cam: all BFB except + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB except: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - Namelist and baseline differences for all cam_dev runs + +=============================================================== +=============================================================== +Tag name: cam6_3_152 +Originator(s): pel +Date: Jan 30, 2024 +One-line Summary: "science optimization" for SE-CSLAM and stabilize WACCM +Github PR URL: https://github.com/ESCOMP/CAM/pull/968 + +Increase computational throughput of the SE-CSLAM dynamical core by: + + - Reducing se_nsplit to 2 (from 3) in FMT: CSLAM now runs with ~30% longer time-step compared to baseline + - No double advection of thermodynamic active tracers when using CSLAM. Overwrite GLL values of Q, CLDLIQ, + etc. every vertical remapping time-step with CSLAM values (interpolated from physics grid to GLL grid) + - Vertical sponge layer diffusion in physics for WACCM and WACCM-x + - No increased hyperdiffusion in sponge for FLT and FMT + +Provide stable configuration for WACCM with spectral-elements (ne30-pg3 and ne16pg3): namelist changes + +Resolve qneg issue 864 +Resolve issue 552 (read in topo file on GLL grid if available) +Resolve issue 951 (remove namelist defaults for pg4 grids) +Resolve issue 970 (remove deprecated 'imp' module from buildnml and buildlib) + +Describe any changes made to build system: + + - added namelist variable + - modified 'buildnml' and 'buildlib' python scripts + to remove deprecated 'imp' python module. + +Describe any changes made to the namelist: + + - changed bnd_topo file for ne30-pg3 for reading in topography + on the GLL grid (if available) (issue #552) + - remove namelist defaults for pg4 topo files (issue #951) + - added namelist se_dribble_in_rsplit_loop to stabilize ne16pg3 WACCM + - change se_nsplit, se_rsplit and se_hypervis_subcycle for efficiency/stability + - se_hypervis_subcycle_sponge for efficiency/stability + - change se_nu, se_nu_div and se_sponge_del4_nu_div_fac to stabilize + ne16pg3 WACCM + + +List any changes to the defaults for the boundary datasets: + - new default topo file for ne30pg3 + +Describe any substantial timing or memory changes: + + - approximately 30% speed-up of entire CAM model using COMPSET FLTHIST or FMTHIST + +Code reviewed by: nusbaume, fvitt + +List all existing files that have been modified, and describe the changes: + +M bld/build-namelist + - add namelist variable + +M bld/namelist_files/namelist_defaults_cam.xml + - change defaults (see above) + +M bld/namelist_files/namelist_definition.xml + - add namelist variable + +M cime_config/buildlib +M cime_config/buildnml + - remove deprecated "imp" python module + +M cime_config/testdefs/testlist_cam.xml + - replace ne5pg4 FADIAB test with ne5pg3 test + +M src/dynamics/se/dp_coupling.F90 +M src/dynamics/se/dycore/control_mod.F90 +M src/dynamics/se/dycore/fvm_control_volume_mod.F90 +M src/dynamics/se/dycore/fvm_mapping.F90 +M src/dynamics/se/dycore/fvm_mod.F90 +M src/dynamics/se/dycore/fvm_reconstruction_mod.F90 +M src/dynamics/se/dycore/global_norms_mod.F90 +M src/dynamics/se/dycore/prim_advance_mod.F90 +M src/dynamics/se/dycore/prim_advection_mod.F90 +M src/dynamics/se/dycore/prim_driver_mod.F90 +M src/dynamics/se/dyn_comp.F90 +M src/dynamics/se/dyn_grid.F90 +M src/dynamics/se/dycore_budget.F90 + - implement SE dycore improvements + +M src/dynamics/se/gravity_waves_sources.F90 + - fix model top pressure bug + +M src/physics/cam/vertical_diffusion.F90 + - add vertical sponge layer diffusion + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) + - pre-existing failures + + ERC_D_Ln9.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator (Overall: DIFF) + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined (Overall: DIFF) + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) + - expected answer changes + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure + + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) + ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) + ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: DIFF) + ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: DIFF) + PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) + SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) + - expected answer changes + +izumi/gnu/aux_cam: + + ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) + ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) + ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: DIFF) + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) + PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) + - expected answer changes + +Summarize any changes to answers: +All spectral-element tests fail due to baseline differences. + + The SE-CSLAM tests fail because of no double-advection + change as well as default hyperviscosity change + The SE (not CSLAM) tests fail because default + hyperviscosity has changed + All WACCM tests fail due to added sponge layer + vertical diffusion + +=============================================================== +=============================================================== + +Tag name: cam6_3_151 +Originator(s): eaton +Date: Thu 21 Mar 2024 +One-line Summary: Bugfix to allow multiple monthly avg history files +Github PR URL: https://github.com/ESCOMP/CAM/pull/1003 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +#1000 - Output of more than 1 monthly average history file is broken. + +. resolves #1000 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, peverwhee + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +src/control/cam_history.F90 +. subroutine wshist + - add new local variables to store the year, month, and day components of + the time interval midpoint date. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All tests have a MEMCOMP failure which we are ignoring. +Several tests have a TPUTCOMP failure which we are also ignoring. + +derecho/intel/aux_cam: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: FAIL) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + - pre-existing failures + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: + All PASS. + +TESTING NOTE: None of our regression tests use multiple monthly output +files. The fix was tested in a low res FHS94 compset that specified +monthly output for h0, h1, h2, and h3. The 'T' field was output in each +file. A 1 month test was run and all files had identical output. This is +the same configuration that I used to debug the problem. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_150 +Originator(s): megandevlan, peverwhee +Date: Feb 23, 2024 +One-line Summary: Adding convective gustiness to U10: Add UGUST output to CAM +Github PR URL: https://github.com/ESCOMP/CAM/pull/943 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update CMEPS external to bring in gustiness + - Add UGUST output to CAM + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - can now include 'UGUST' in fincl lists (default: Average flag) + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar, peverwhee + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Update CMEPS tag to bring in gustiness + +M src/control/camsrfexch.F90 + - Add ugust to cam_in + +M src/cpl/nuopc/atm_import_export.F90 + - Set ugust + +M src/physics/cam/cam_diagnostics.F90 + - Add UGUST addfld/outfld calls + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All (coupled) jobs had errors about MEMCOMP failing due to missing files - to +be fixed in upcoming CIME tag + +derecho/intel/aux_cam: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - pre-existing failures + + ERC_D_Ln9.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9.T42_T42_mg17.FDABIP04.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9.T42_T42_mg17.FHS94.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + SMS_D_Ld5.f19_f19_mg17.PC4.derecho_intel.cam-cam4_port5d (Overall: NLFAIL) details: + SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + - add_gusts added to nuopc.runconfig + + ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + - failures due to So_ugustOut in cpl.hi and answer changes for cam_dev tests + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + - add_gusts added to nuopc.runconfig + + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + - failures due to So_ugustOut in cpl.hi + +izumi/gnu/aux_cam: + ERC_D_Ln9.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: NLFAIL) details: + - add_gusts added to nuopc.runconfig + + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - failures due to So_ugustOut in cpl.hi and answer changes for cam_dev tests + +=============================================================== +=============================================================== + +Tag name: cam6_3_149 +Originator(s): cacraig, fischer, jedwards +Date: Feb 22, 2024 +One-line Summary: Update externals to match cesm2_3_alpha17a +Github PR URL: https://github.com/ESCOMP/CAM/pull/977 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update externals to match CESM alpha17a tag and the cime external needed to support GEOS-Chem + - Made changes to fix failing regression tests + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Update externals to match cesm2_3_alpha17a + - Update cime tag to newer one to support GEOS-Chem + +M cime_config/SystemTests/tmc.py + - Fix failing TMC test (due to changes in cime) + +M cime_config/buildnml + - Fix failing GEOS-Chem test (due to changes in externals) + +M cime_config/testdefs/testlist_cam.xml + - Remove obsolete _Vnuopc qualifier on tests + - Introduce a few test types to prealpha testing (they had previously been exclusively tested in aux_cam) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All jobs had errors about MEMCOMP and TPUTCOMP failing due to missing files (due to changes in externals now making these files) + +derecho/intel/aux_cam: + ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: FAIL) details: + - pre-existing failures + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - Differences due to changed externals + +izumi/nag/aux_cam: All baselines PASS for nag + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB except: + FAIL SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_148_gnu: DIFF + FAIL SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_148_gnu: DIFF + - Differences due to changed externals + +=============================================================== +=============================================================== + +Tag name: cam6_3_148 +Originator(s): brianpm, courtneyp, eaton +Date: Wed 21 Feb 2024 +One-line Summary: Provide RRTMGP as a radiation parameterization +Github PR URL: https://github.com/ESCOMP/CAM/pull/909 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +#255 - Provide RRTMGP as a radiation parameterization +https://github.com/ESCOMP/CAM/issues/255 + +Miscellaneous: +. The 1850_cam5.xml use case file was added back to the source code to + facilitate running the F1850 compset with CAM5. That discussion is in + issue #393. + +Describe any changes made to build system: +. '-rad' argument to configure accepts the values 'rrtmgp' and 'rrtmgp_gpu' + to build the RRTMGP code for CPUs or for GPUs. + +Describe any changes made to the namelist: +. add variables rrtmgp_coefs_lw_file and rrtmgp_coefs_sw_file to contain + filepaths for the RRTMGP coefficients files. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: +. performance evaluation of RRTMGP has not yet been done. + +Code reviewed by: nusbaume, cacraigucar, sjsprecious + +List all files eliminated: + +src/physics/rrtmg/cloud_rad_props.F90 +src/physics/rrtmg/ebert_curry.F90 +src/physics/rrtmg/oldcloud.F90 +src/physics/rrtmg/slingo.F90 +. these cloud optics files which can be shared by rrtmg and rrtmgp are + moved to src/physics/cam + +List all files added and what they do: + +bld/namelist_files/use_cases/1850_cam5.xml +. use case file for 1850 cam5 physics + +cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/shell_commands +cime_config/testdefs/testmods_dirs/cam/cam6_port_f09_rrtmgp/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/shell_commands +cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq9s_rrtmgp/user_nl_clm +. for adding RRTMGP to tests + +src/physics/cam/cloud_rad_props.F90 +src/physics/cam/ebert_curry_ice_optics.F90 +src/physics/cam/oldcloud_optics.F90 +src/physics/cam/slingo_liq_optics.F90 +. these 4 files are shared cloud optics code moved here from + src/physics/rrtmg/ with the following name changes: + - ebert_curry.F90 -> ebert_curry_ice_optics.F90 + - oldcloud.F90 -> oldcloud_optics.F90 + - slingo.F90 -> slingo_liq_optics.F90 +. remove unused code, cleanup unused vars, improve endrun messages +. module names changed to match file names. + +src/physics/rrtmgp/mcica_subcol_gen.F90 +src/physics/rrtmgp/radconstants.F90 +src/physics/rrtmgp/radiation.F90 +src/physics/rrtmgp/rrtmgp_inputs.F90 +. CAM interface code for RRTMGP. + +List all existing files that have been modified, and describe the changes: + +.gitignore +. add directories src/physics/rrtmgp/{data,ext} + +Externals_CAM.cfg +. add external definition for rte-rrtmgp source +. add external definition for rrtmgp data + +bld/build-namelist +. set the correct filepaths for the coefficient datasets which are checked + out in the source code directory tree. +. generalize logic to include both rrtmgp and rrtmg when appropriate +. add error check for old cloud optics no longer supported + +bld/config_files/definition.xml +. add 'rrtmgp' as valid value for 'rad' configure option + +bld/configure +. add rrtmgp and rrtmgp_gpu as valid values for '-rad' argument. +. '-rad rrtmgp_gpu' sets a flag used to add the filepaths for the GPU code + versions to the Filepath file. The '_gpu' suffix is removed before + setting the parameter value for 'rad' in the config_cache.xml file. +. check to disallow CARMA + RRTMGP + +bld/namelist_files/namelist_defaults_cam.xml +. the aersol and cloud optics datasets for RRTMG are being reused for + RRTMGP for now + +bld/namelist_files/namelist_definition.xml +. add 'rrtmgp' as valid value for 'radiation_scheme' +. add variables rrtmgp_coefs_lw_file and rrtmgp_coefs_sw_file to contain + filepaths for the RRTMGP coefficients files. + +cime_config/testdefs/testlist_cam.xml +. add aux_cam tests: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + ERP_D_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_rrtmgp + SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp +. add prealpha test: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s_rrtmgp + +src/chemistry/utils/solar_data.F90 +. add solar_htng_spctrl_scl to log file output + +src/physics/cam/aer_rad_props.F90 +. nrh, ot_length now accessed from phys_prop + +src/physics/cam/aerosol_optics_cam.F90 +. ot_length now accessed from phys_prop + +src/physics/cam/phys_prop.F90 +. add the public parameter nrh to this module. Was previously in + radconstants. +. turn off old debug output to log file + +src/physics/cam/physpkg.F90 +. reorder initialization of solar_data and radiation modules to allow + reading the spectral band boundaries from the input data rather than + requiring them to be hardcoded. + +src/physics/cam/rad_constituents.F90 +. access ot_length from phys_prop rather than rad_constituents + +src/physics/cam_dev/physpkg.F90 +. reorder initialization of solar_data and radiation modules to allow + reading the wavenumber band boundaries from the input data rather than + requiring them to be hardcoded. + +src/physics/camrt/radconstants.F90 +. parameters ot_length and nrh moved to phys_props + +src/physics/rrtmg/radconstants.F90 +. parameters ot_length and nrh moved to phys_props + +src/physics/rrtmg/radiation.F90 +. ebert_curry -> ebert_curry_ice_optics + +src/physics/simple/radconstants.F90 +. parameters ot_length and nrh moved to phys_props +. add dummy interface for get_sw_spectral_boundaries + +src/physics/spcam/crm/CLUBB/crmx_mt95.f90 +. removed 3 non-ascii characters (in comments) + +test/system/TR8.sh +. add checks for rrtmgp interface code + +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_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d (Overall: PEND) details: +-- pre-existing failures + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + FAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp NLCOMP + FAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_147: ERROR BFAIL baseline directory '/glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_147/ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp' does not exist + SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + FAIL SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp NLCOMP + FAIL SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp BASELINE /glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_147: ERROR BFAIL baseline directory '/glade/campaign/cesm/community/amwg/cam_baselines/cam6_3_147/SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp' does not exist +-- expected diffs - no baselines for new tests + +izumi/nag/aux_cam: + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +-- pre-existing failure + +izumi/gnu/aux_cam: + + ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + FAIL ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp NLCOMP + FAIL ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_147_gnu: ERROR BFAIL baseline directory '/fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_147_gnu/ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp' does not exist + SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp (Overall: DIFF) details: + FAIL SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp NLCOMP + FAIL SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_147_gnu: ERROR BFAIL baseline directory '/fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_147_gnu/SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp' does not exist +-- expected diffs - no baselines for new tests + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: None. + New RRTMGP option changes answers only when enabled. + +=============================================================== +=============================================================== + +Tag name: cam6_3_147 +Originator(s): lizziel, jimmielin, fritzt +Date: 2 Feb 2024 +One-line Summary: Add GEOS-Chem chemistry as new chemistry option in CAM +Github PR URL: https://github.com/ESCOMP/CAM/pull/484 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Include GEOS-Chem 14.1.2 chemistry as alternative to CAM-chem + (issue #424 -- Implementing GEOS-Chem chemistry in CESM (CESM-GC)) + +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, brian-eaton, cacraigucar, gold2718, jedwards4b + +List all files that are renamed and why: +R100 bld/namelist_files/master_aer_drydep_list.xml +R100 bld/namelist_files/master_aer_wetdep_list.xml +R100 bld/namelist_files/master_gas_drydep_list.xml +R100 bld/namelist_files/master_gas_wetdep_list.xml + - Renamed with prefix mozart_ to distinguish from GEOS-Chem lists + +R099 src/chemistry/aerosol/drydep_mod.F90 + - Renamed to aer_drydep_mod.F90 to avoid module conflict name in GEOS-Chem + - Changed module name in file from drydep_mod to aer_drydep_mod + +List all files added and what they do: +A bld/namelist_files/geoschem_master_aer_drydep_list.xml +A bld/namelist_files/geoschem_master_aer_wetdep_list.xml +A bld/namelist_files/geoschem_master_gas_drydep_list.xml +A bld/namelist_files/geoschem_master_gas_wetdep_list.xml + - New deposition lists for use in GEOS-Chem only + +A bld/namelist_files/use_cases/2000_geoschem.xml +A bld/namelist_files/use_cases/2010_geoschem.xml +A bld/namelist_files/use_cases/hist_geoschem.xml +A bld/namelist_files/use_cases/hist_geoschem_nudged.xml + - Use case files for four GEOS-Chem chemistry compsets + +A cime_config/cam.case_setup.py + - Script called during CESM case setup for CAM-specific commands + - Copies GEOS-Chem config files from source to case directory if using GEOS-Chem + +A src/chemistry/geoschem/.exclude + - List of GEOS-Chem source files to skip during build + +A src/chemistry/geoschem/chem_mods.F90 + - GEOS-Chem version of chem_mods.F90 equivalent to Mozart pre-processed files + +A src/chemistry/geoschem/chemistry.F90 + - GEOS-Chem implementation of chemistry module used in CAM + +A src/chemistry/geoschem/geoschem_diagnostics_mod.F90 + - GEOS-Chem diagnostics module + +A src/chemistry/geoschem/geoschem_emissions_mod.F90 + - GEOS-Chem emissions module + +A src/chemistry/geoschem/geoschem_history_mod.F90 + - Interface file to connect GEOS-Chem state arrays to CAM history + +A src/chemistry/geoschem/m_spc_id.F90 + - GEOS-Chem version of m_spc_id.F90 equivalent to Mozart pre-processed files + +A src/chemistry/geoschem/mo_sim_dat.F90 + - GEOS-Chem version of m_spc_id.F90 equivalent to Mozart pre-processed files + +List all existing files that have been modified, and describe the changes: +M .gitignore + - Added GEOS-Chem directory which is its own git repository + +M Externals_CAM.cfg + - Added GEOS-Chem repository, tag 14.1.2 + +M bld/build-namelist + - Updates for GEOS-Chem namelists + +M bld/config_files/definition.xml + - Added geoschem_mam4 to list of chemistry packages + +M bld/configure + - Updates to build GEOS-Chem + +M bld/namelist_files/namelist_defaults_cam.xml + - Set GEOS-Chem default wave params and path to Henry's coeff file for deposition + +M bld/namelist_files/namelist_definition.xml + - Added GEOS-Chem input data path as new entry + - Added geoschem_mam4 to chem package list + +M bld/perl5lib/Build/ChemNamelist.pm + - Added log prints of all deposition species lists + - Updates to use different deposition lists based on chemistry selection + +M cime_config/buildnml + - Copy GEOS-Chem config files from case to run directory if using GEOS-Chem + +M cime_config/config_component.xml + - Added GEOS-Chem as chemistry option + - Set GEOS-Chem compset aliases + +M cime_config/config_compsets.xml + - Defined four GEOS-Chem compsets + +M cime_config/testdefs/testlist_cam.xml + - Added tests for all four GEOS-Chem compsets as category geoschem + - Included FCHIST_GC in aux_cam tests and FCnudged_GC in prealpha tests + +M doc/ChangeLog +M src/chemistry/bulk_aero/aero_model.F90 + - Renamed drydep_mod to aer_drydep_mod in use statements + +M src/chemistry/modal_aero/aero_model.F90 + - Renamed drydep_mod to aer_drydep_mod in use statements + +M src/chemistry/modal_aero/modal_aero_data.F90 + - Distinguish between SOAG and SOAGX since SOAGX a species in GEOS-Chem + +M src/chemistry/modal_aero/modal_aero_gasaerexch.F90 + - Skip MSA tendency if using GEOS-Chem + +M src/chemistry/modal_aero/sox_cldaero_mod.F90 + - Exit prior to in-cloud sulfur oxidation if using GEOS-Chem to avoid double-counting + +M src/chemistry/mozart/chemistry.F90 + - Add call to new subroutine short_lived_species_final + +M src/chemistry/mozart/mo_chem_utls.F90 + - Add optional argument in get_spc_ndx to ignore case in string compariosn + +M src/chemistry/mozart/mo_neu_wetdep.F90 + - Skip aerosol mapping if using GEOS-Chem; assume all species in dep_data_file + +M src/chemistry/mozart/short_lived_species.F90 + - Added array slvd_ref_mmr to store short-lived species reference values + - Initialized short-lived species not found to ref values if available + - Initialized GEOS-Chem short-lived species from slvd_lst not solsym + - Added set/get subroutines for GEOS-Chem short-lived species + - Added new subroutine short_lived_species_final to deallocate new array + +M src/cpl/nuopc/atm_import_export.F90 + - Added So_ustar to atm imports for use in GEOS-Chem dry dep over ocean + +M src/physics/cam/constituents.F90 + - Improved existing error handling messages for clarity + +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_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failures + + FAIL SMS_Ld1_Vnuopc.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + - expected failure due to goeschem config file copy issue + + DIFF ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase + DIFF ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp + DIFF ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s + DIFF ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s + DIFF ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase + DIFF ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s + DIFF ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h + DIFF ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes + DIFF ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 + DIFF ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + DIFF ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev + DIFF ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 + DIFF ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 + DIFF ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep + DIFF SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + DIFF SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + DIFF SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + DIFF SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase + DIFF SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1_Vnuopc.f19_f19.F2000dev.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d + DIFF SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + DIFF SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m + DIFF SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging + DIFF SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + DIFF SMS_Ln9_Vnuopc.f19_f19.F2000climo.derecho_intel.cam-silhs + DIFF SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem + - differences are only in Med_aoflux_atm_So_ustar mediator field resulting from adding + So_ustar to atm imports, otherwise all other fields bit-for-bit + +izumi/nag/aux_cam: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure + + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s + DIFF ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase + DIFF ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase + DIFF ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac + DIFF ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase + DIFF ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + DIFF ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 + DIFF ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf + DIFF PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + DIFF PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + DIFF SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + DIFF SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem + DIFF SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm + DIFF SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam + DIFF SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba + DIFF SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase + DIFF SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s + - differences are only in Med_aoflux_atm_So_ustar mediator field resulting from adding + So_ustar to atm imports, otherwise all other fields bit-for-bit + +izumi/gnu/aux_cam: + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag + DIFF ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s + DIFF ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 + DIFF ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba + DIFF ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp + DIFF ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s + DIFF PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 + DIFF SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep + DIFF SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 + DIFF SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc + DIFF SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s + DIFF SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee + DIFF SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac + DIFF SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s + - differences are only in Med_aoflux_atm_So_ustar mediator field resulting from adding + So_ustar to atm imports, otherwise all other fields bit-for-bit + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_146 +Originator(s): cacraig +Date: Jan 23, 2024 +One-line Summary: ZM clean up in preparation for using via CCPP and remove zmconv_microp feature +Github PR URL: https://github.com/ESCOMP/CAM/pull/890 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Work to make ZM compatible with CCPP conversion process + - Removed CAM3 switch from ZM in move to no longer support CAM3 + - Remove microphysics embedded in ZM: https://github.com/ESCOMP/CAM/issues/889 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - removed zmconv_microp namelist + +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, mwaxmonsky + +List all files eliminated: +D src/physics/cam/zm_microphysics.F90 + - removed zmconv_microp capability as it is not used + +D src/physics/cam/zm_conv.F90 + - moved ZM to ESCOMP/atcmospheric_physics and broke into separate modules + +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/shell_commands +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cam +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_clm +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cpl + - removed test which tested zmconv_microp + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - updated ESCOMP/atmospheric_physics to bring in tag with ZM + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml +M src/physics/cam/clubb_intr.F90 + - removed zmconv_microp namelist and associated code + +M bld/configure + - add location for src/atmos_phys/zm + +M cime_config/testdefs/testlist_cam.xml + - removed test which tested zmconv_microp and CAM3 + +M src/physics/cam/macrop_driver.F90 + - removed zmconv_microp namelist and associated code + - Changes needed to support ZM no longer having pcols dimension + +M src/chemistry/modal_aero/modal_aero_convproc.F90 +M src/physics/cam/cloud_fraction.F90 +M src/physics/cam/convect_shallow.F90 +M src/physics/cam/rk_stratiform.F90 +M src/physics/spcam/crmclouds_camaerosols.F90 + - Changes needed to support ZM no longer having pcols dimension + +M src/physics/cam/zm_conv_intr.F90 + - Changes to prepare this routine to support CCPP conversion + - Pass in variables which were being "use"d in ZM previously + - Only pass :ncol sections of arrays since pcols has been removed from ZM + - removed zmconv_microp namelist and associated code + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: all BFB except: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - preexisting failures + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - preexisting failure + +izumi/gnu/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_145 +Originator(s): katetc, cacraigucar, andrewgettelman +Date: 05 Jan 2024 +One-line Summary: New PUMAS External with adjusted vapor deposition onto snow +Github PR URL: https://github.com/ESCOMP/CAM/pull/938 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + A one-line change in PUMAS resulting in a new tag for the external. Adds a corresponding + limiter for vapor deposition onto snow as used for rain. Also updates the test lists from + Cheyenne to Derecho in all cases. + Resolves Issue 936 - PUMAS update for vapor deposition onto snow + Resolves Issue 947 - Rename all cheyenne tests to derecho + +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: PeterHjortLauritzen, cacraigucar, adamrher + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M Externals_CAM.cfg + - Point to new pumas tag pumas_cam-release_v1.35 + +M cime_config/testdefs/testlist_cam.xml + - Change all Cheyenne to Derecho tests + - Change wallclock time from 00:10:00 to 00:20:00 for Derecho test + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s + +M test/system/archive_baseline.sh + - Change cheyenne to Derecho, remove support for Cheyenne + +M test/system/test_driver.sh + - Remove support for Cheyenne, updates for Derecho + +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_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) + SMS_Ld1_Vnuopc.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) + - Expected answer changes due to PUMAS update + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) + - Expected answer changes due to PUMAS update + +Summarize any changes to answers: + + Small but climate-changing impacts. Discussion and diagnostics here: https://github.com/NCAR/amwg_dev/issues/445 + +=============================================================== + + +=============================================================== + +Tag name: cam6_3_144 +Originator(s): katetc, cacraigucar, andrewgettelman, wkchuang, djgagne +Date: 02 Jan 2024 +One-line Summary: Introduce changes needed to support machine learning in PUMAS microphysics +Github PR URL: https://github.com/ESCOMP/CAM/pull/858 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + PR with the tag for PUMAS now including early support for a machine learning kernel. Fixes #801 + - Bring in Machine Learning warm rain capability. Also includes micro_mg_vtrms namelist for the + CAM7 PPE. Also includes addition of an aux_pumas test suite. + +Describe any changes made to build system: + Added "pumas" as a valid microphysics scheme in the configure script. Currently the "pumas" + option is set to "mg3" in configure, as full support is left for a later tag. + +Describe any changes made to the namelist: + +. Added micro_mg_warm_rain: Choices for the PUMAS warm rain accretion formulation. + Options include sb2001, kk2000, tau and emulated (machine learning). kk2000 is default. +. Added micro_mg_vtrms_factor: A microphysics parameter for adjusting the snow fall speed. Default + is 1.0 to maintain answers in cam_dev. +. Added pumas_stochastic_tau_kernal_filename: Coefficients for the stochastic collection kernel used + by the TAU stochastic collection code, invoked in PUMAS with micro_pumas_warm_rain = 'tau' +. Added stochastic_emulated_filename_quantile: Neural net file for warm_rain machine learning +. Added stochastic_emulated_filename_input_scale: Neural net input scaling values file for warm_rain + machine learning +. Added stochastic_emulated_filename_output_scale: Neural net output scaling values file for warm_rain + machine learning + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar, peverwhee, nusbaume, sjsprecious + +List all files eliminated: N/A + +List all files added and what they do: + +A cime_config/SystemTests/mgp.py + - Added system test to ensure that "pumas" and "mg3" microphysics options give the same answers. + Used in the aux_puams test suite + +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_emulated/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_emulated/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_emulated/user_nl_clm + - Added test for the "emulated" pumas warm rain option, used in aux_pumas test suite + +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_sb2001/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_sb2001/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_sb2001/user_nl_clm + - Added test for the "sb2001" pumas warm rain option, used in aux_pumas test suite + +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_tau/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_tau/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_pumas_tau/user_nl_clm + - Added test for the "tau" pumas warm rain option, used in aux_pumas test suite + +A src/physics/cam_dev/stochastic_emulated_cam.F90 +A src/physics/cam_dev/stochastic_tau_cam.F90 + - Supporting code for the PUMAS warm rain machine learning neural net + +List all existing files that have been modified, and describe the changes: + +M Externals_CAM.cfg + - New PUMAS external with machine learning support and vtrms namelist support + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - Added support for micro_mg_warm_rain, micro_mg_vtrms and pumas_stochastic_tau_kernal_filename. + Also several namelist fields for pumas machine learning, but not set to default + +M bld/config_files/definition.xml +M bld/configure + - Added "pumas" as a valid configure microphysics option. Currently set to mg3 immediately. + +M cime_config/config_tests.xml +M cime_config/testdefs/testlist_cam.xml + - Added support for the mgp test and the aux_pumas test suite + +M src/physics/cam_dev/micro_pumas_cam.F90 + - Support for the machine learning warm rain options for PUMAS, the vtrms_factor namelist field, + adding some history fields related to the machine learning and new warm rain options. + +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_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: FAIL) + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failures + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: NLFAIL) + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_Ld1_Vnuopc.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: NLFAIL) + - Expected namelist differences due to new PUMAS namelist options (in cam_dev) + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) + - Expected namelist differences due to new PUMAS namelist options (in cam_dev) + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== + +=============================================================== + +Tag name: cam6_3_143 +Originator(s): fvitt +Date: 20 Dec 2023 +One-line Summary: Reduce memory footprint of IC file output in SE CSLAM +Github PR URL: https://github.com/ESCOMP/CAM/pull/939 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Implement memory friendly mapping of advected tracers from physics grid to dynamics grid + for output to CAM generated IC file when SE CSLAM dynamics is used. This resolves the + memory issue described in github issue #932 (Memory issues in SE CSLAM when writing IC files). + +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: PeterHjortLauritzen, 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/dynamics/se/dycore/fvm_mapping.F90 + - implement physics-to-dynmics grid mapping routine for a single tracer + +M src/dynamics/se/dycore/fvm_mod.F90 + - implement exchange buffer for a single tracer + +M src/dynamics/se/stepon.F90 + - remap to dynamics grid and output to the cam generated IC one tracer at a time + - add memory allocate checks + +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_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failures + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_142 +Originator(s): jedwards, ekluzek, goldy, bstephens82, eaton +Date: 13 December 2023 +One-line Summary: Resolve miscellaneous issues +Github PR URL: https://github.com/ESCOMP/CAM/pull/937 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. https://github.com/ESCOMP/CAM/issues/863 - Incorrect error message + - remove the code in cam_history that was checking fincl input for the + names of zonal mean fields and writing a message to the atm log file if + the dycore was not FV. These messages are now incorrect and have been + removed. + +. https://github.com/ESCOMP/CAM/issues/837 - Remove setting of CTSM fsurdat + file and LND_DOMAIN_FILE in mpas testmods + - The LND_DOMAIN_FILE is no longer needed. The fsurdat file is now + appropriately set by CTSM. + +. https://github.com/ESCOMP/CAM/pull/792 - changes to fix single-exe option + for PLB tests + - Fix from jedwards + +. https://github.com/ESCOMP/CAM/issues/931 - Bad outfld calls in + cam_development? + - Fix several bad outfld calls. The size of the 1st dimension of the + passed data did not match the size passed as a separate argument. + +. https://github.com/ESCOMP/CAM/pull/855 - Bug fix for SILHS history output + being garbled. + - Fix from bstephens82. + +. resolves #863 +. resolves #837 +. resolves #792 +. resolves #931 +. resolves #855 + + +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 for cam, but +. The fsurdat file has changed for mpasa grids. + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, nusbaume + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml +. add dyn="fv" attribute to fincl7 element so that zonal mean output is only + requested for the FV dycore. + +cime_config/buildnml +cime_config/config_tests.xml +. fix single-exe option for PLB tests (from Jim Edwards) + +cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/shell_commands +cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa120/shell_commands +cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/shell_commands +. remove xmlchange for LND_DOMAIN_FILE. + +cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/user_nl_clm +cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa120/user_nl_clm +cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/user_nl_clm +. remove setting for fsurdat + +src/control/cam_history.F90 +. subroutine fldlst + - remove code that inspects the fincl lists for the zonal mean fields + that used to only be available when using FV dycore. This code removed + these fields from the fincl list and printed a message to the atm log + file. These messages are no longer correct and have been removed. +. subroutine addfld_nd + - fix conditional so that is_subcol gets set correctly for fields + representing subcolumns. + +src/physics/cam/cam_diagnostics.F90 +src/physics/cam/vertical_diffusion.F90 +src/physics/rrtmg/rrtmg_state.F90 +src/physics/spcam/spcam_drivers.F90 +src/physics/waccm/mo_aurora.F90 +. fix several outfld calls - make sure 1st dimension of the data array matches + the value passed as the size of the 1st dimension + +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_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failures + + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: +- fsurdat file changed resulting in baseline comparison failures + + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: +- use_case file modified to exclude the fincl7 list of zonal mean fields. + Previous code was ignoring these fields and printing a message to the + atm.log file. + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure + +izumi/gnu/aux_cam: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except for MPAS tests due to a change +in the fsurdat file specified by CTSM. + +=============================================================== +=============================================================== + +Tag name: cam6_3_141 +Originator(s): eaton +Date: 8 December 2023 +One-line Summary: Improve handling of 0th / initial time in history output +Github PR URL: https://github.com/ESCOMP/CAM/pull/929 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Issue #459 - Improve handling of 0th / initial time in history output + - Add namelist variable, write_nstep0, to control output of nstep==0 time + sample. This output is now turned OFF by default. + +. resolves #459 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +. Add logical variable write_nstep0 to namelist group cam_history_nl. + Default value is .false. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, peverwhee + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bld/namelist_files/namelist_definition.xml +. Add logical variable write_nstep0 to namelist group cam_history_nl. + Default value is .false. + +doc/ChangeLog_template +. remove cheyenne test results section + +cime_config/testdefs/testmods_dirs/cam/cam4_port/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/cam4_port5d/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/cam5_port_f45/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq1d/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq3h/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq3s/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq3s_cospsathist/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq3s_diags/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq9s/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq9s_apmee/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/outfrq9s_mee_fluxes/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/reduced_hist1d/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/scm_prep/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/scmarm/user_nl_cam +cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam +. add write_nstep0=.true. + - This change to the namelist keeps the output files unchanged so + baselines pass. It also keeps the nstep==0 output which is useful for + debugging. + +src/control/cam_history.F90 +. add write_nstep0 to namelist input and echo to atm.log file +. wshist + - add logic for nstep==0 to the code section that determines when history + buffers are written to files. If history buffers are not written at + nstep==0, then zero them. This partial time step from the + initialization process shouldn't be accumulated with subsequent + timestep output. + +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_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: +- pre-existing failures + + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: NLFAIL) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: NLFAIL) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.derecho_intel.cam-cam4_port5d (Overall: NLFAIL) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: NLFAIL) details: +- added write_nstep0=.true. to tests + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +- pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: +- added write_nstep0=.true. to tests + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: NLFAIL) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: NLFAIL) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: +- added write_nstep0=.true. to tests + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_140 +Originator(s): peverwhee +Date: 6 December 2023 +One-line Summary: Separate history tapes into hXi and hXa +Github PR URL: https://github.com/ESCOMP/CAM/pull/903 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Change "time" value for averaged quantities to midpoint of averaging period (#159) + - Modify naming and attributes of time variables on history files to be + consistent with other CESM components (#554) + +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 brian-eaton 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 cime_config/SystemTests/sct.py + - change references to history file to include "i" flag + +M src/control/cam_history.F90 + - change 'time_bnds' to 'time_bounds' + - split history stream into two files: instantaneous and accumulated + - accumulated file has all non-instantaneous fields and 'time', 'date', + 'datesec' fields are the midpoint time + - accumulated file is only generated when one or more accumulated fields + - filename includes 'a' flag + is included in the fincl list + - instantaneous file has all instantaneous fields (including scalars that + are always written) and 'time', 'date', and 'datesec' fields are the end + time + - instantaneous file is always generated (with, at minimum, those + scalars like solar forcing data, current timestep, etc + - filename includes 'i' flag + - change 'cell_methods' to always include 'time: x' attribute to specify flag + - "time: point" for instantaneous fields + +M src/control/cam_history_support.F90 + - add functionality for multiple files per history stream + +M src/control/filenames.F90 + - update interpret_filename_spec to include 'a' or 'i' flag in filename + +M src/control/sat_hist.F90 + - update to comply with new Files array (multiple files per stream) + +M src/utils/cam_grid_support.F90 + - updates to get around logic that prevented fields to be written twice (need + to be written once per file instead of once overall) + + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + - pre-existing failures + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: DIFF) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - Confirmed no fields lost; no field data changed except date, datesec, and + time (now reflect midpoints in 'a' files); field 'time_bnds' changed to 'time_bounds' + +derecho/intel/aux_cam: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failures + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.derecho_intel.cam-cam4_port5d (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 (Overall: DIFF) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - Confirmed no fields lost; no field data changed except date, datesec, and + time (now reflect midpoints in 'a' files); field 'time_bnds' changed to 'time_bounds' + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - preexisting failure + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF)details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: DIFF) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + - Confirmed no fields lost; no field data changed except date, datesec, and + time (now reflect midpoints in 'a' files); field 'time_bnds' changed to 'time_bounds' + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - Confirmed no fields lost; no field data changed except date, datesec, and + time (now reflect midpoints in 'a' files); field 'time_bnds' changed to 'time_bounds' + +Summarize any changes to answers: No answer changes except midpoint time, +date, datesec for accumulated files + +=============================================================== + +Tag name: cam6_3_139 +Originator(s): fvitt, tilmes +Date: 1 Dec 2023 +One-line Summary: Aircraft emissions and derecho PE layouts +Github PR URL: https://github.com/ESCOMP/CAM/pull/925 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Include aircraft emissions for LT and MT compsets (issue #852). + + Provide functional PE layouts for CAMChem and WACCM on ne30 SE grid + which fixes failing regression test in issue #917. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar nusbaume adamrher + +List all files eliminated: +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_wcm_ne30/shell_commands +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_wcm_ne30/user_nl_cam +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_wcm_ne30/user_nl_clm +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_wcm_ne30/user_nl_cpl + - no longer needed + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist + - set default aircraft emissions for ghg_mam chemistry + +M bld/namelist_files/namelist_defaults_cam.xml + - default ne30pg3 aircraft emissions + +M bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml + - fix fincl list + +M bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml + - remove ne30pg IC from use case (not stable) + +M cime_config/config_pes.xml + - default PE layouts for: + . WACCM and CAMChem on ne30 grid + . WACCM(X) and CAMChem on f19 grid + +M cime_config/testdefs/testlist_cam.xml + - adjust tests for waccm on ne30 grids + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failures + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: NLFAIL) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + - expected baseline test failures due to aircraft emissions + + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + - new passing test + +derecho/intel/aux_cam: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failures + + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: NLFAIL) details: + - new derecho PE layouts + + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: NLFAIL) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + - expected baseline test failures due to aircraft emissions + + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + - new passing test + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: larger than roundoff but same climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): cam6_3_132 +- platform/compilers: derecho / intel +- configure commandline: ./create_newcase --compset FMTHIST --res ne30pg3_ne30pg3_mg17 +- build-namelist command (or complete namelist): + case : + /glade/p/cesmdata/cseg/runs/cesm2_0/f.cam6_3_132.FMTHIST_ne30.aircraft +- location of output: + /glade/derecho/scratch/tilmes/archive/f.cam6_3_132.FMTHIST_ne30.aircraft/atm/hist + +URL for AMWG diagnostics output used to validate new climate: +https://webext.cgd.ucar.edu/FMTHIST/f.cam6_3_132.FMTHIST_ne30.aircraft/atm/f.cam6_3_132.FMTHIST_ne30.aircraft_1995_2006_vs_f.cam6_3_132.FMTHIST_ne30.001_1995_2006/ + +=============================================================== +=============================================================== + +Tag name: cam6_3_138 +Originator(s): fvitt, skamaroc +Date: 1 Dec 2023 +One-line Summary: Frontogenesis gravity waves with MPAS dynamical core +Github PR URL: https://github.com/ESCOMP/CAM/pull/688 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Add the capability to generate frontal gravity wave forcings when the MPAS dynamical core + is used. See github issue #400. + +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 brian-eaton jtruesdal 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 bld/namelist_files/namelist_defaults_cam.xml + - default namelist settings for waccm on mpasa120 grid + +M cime_config/config_pes.xml + - working cheyenne and derecho PE layouts for waccm on mpasa120 grid + +M cime_config/testdefs/testlist_cam.xml + - tests for waccm-sc on mpasa120 grid + +M cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/user_nl_cam + - mpas namelist setting moved to namelist_defaults_cam.xml + +M src/dynamics/mpas/dp_coupling.F90 + - implement function for front generated gravity wave forcings + - code cleanup + +M src/dynamics/mpas/driver/cam_mpas_subdriver.F90 + - add MPAS stream fields for cell gradient coeffecients + - code cleanup + +M src/dynamics/mpas/dyn_comp.F90 + - set dyn_out pointers for frontogenesis calculations + - code cleanup + +M src/dynamics/mpas/dyn_grid.F90 + - minor code cleanup + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 MODEL_BUILD time=2 + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_137: DIFF + - pre-existing failures + +derecho/intel/aux_cam: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + PEND ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 SHAREDLIB_BUILD RERUN + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_wcm_ne30 (Overall: PEND) details: + PEND ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_wcm_ne30 RUN + PEND ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_wcm_ne30 COMPARE_base_rest + - pre-existing failures + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + PEND DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_137 +Originator(s): gdicker +Date: Nov 29, 2023 +One-line Summary: Update MPAS-A within CAM to v8.0 +Github PR URL: https://https://github.com/ESCOMP/CAM/pull/908 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update MPAS-A within CAM to v8.0.1: https://github.com/ESCOMP/CAM/issues/861 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - Added new namelist variable mpas_cam_damping_levels. Determines how many layers from + model top to apply CAM-SE-like horizontal diffusion in MPAS. + + +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, jtruesdal, PeterHjortLauritzen + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - Update mpas hash to point a few commits after MPAS-Dev/MPAS-Model 'v8.0.1' tag + +M src/dynamics/mpas/Makefile + - Add MPAS_PIO_SUPPORT to CPPFLAGS to ensure PIO is used instead of the new SMIOL + - Rename diagnostics with "mpas_" prefix that was added + - Add mpas_string_utils, mpas_halo, mpas_atm_halos modules + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - Add mpas_cam_damping_levels namelist argument and update mpas_cam_coef + description + +M src/dynamics/mpas/driver/cam_mpas_subdriver.F90 + - Update arguments for {postread,prewrite}_reindex subroutines + - Add calls to create/destroy mpas halo_groups during init and finalize + - Modify some halo exchange calls to use exchange_halo_group routine pointer + +M src/dynamics/mpas/dyn_comp.F90 + - Add config_halo_exch_method to configs pool with default value 'mpas_halo' + - Add mpas_cam_damping_levels namelist argument + +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/user_nl_cam + - Modify F2000climo test using mpasa480_mpasa480 to test the mpas_cam damping + +M test/system/archive_baseline.sh + - Modify baselinedir path for derecho to point to /glade/campaign location + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + PEND ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 MODEL_BUILD RERUN + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_133: DIFF + - pre-existing failures + + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: NLFAIL) details: + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 NLCOMP + found extra variable: 'mpas_cam_damping_levels' + - expected failure, added mpas_cam_damping_levels to namelist + + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 NLCOMP + found extra variable: 'mpas_cam_damping_levels' + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 BASELINE /glade/ p/cesm/amwg/cesm_baselines/cam6_3_136: DIFF + - expected failure, added mpas_cam_damping_levels to namelist and modified test via outfrq9s_mpasa480/user_nl_cam + +derecho/intel/aux_cam: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + PEND ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 SHAREDLIB_BUILD RERUN + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/derecho_baselines/cam6_3_136: DIFF + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_wcm_ne30 (Overall: PEND) details: + PEND ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_wcm_ne30 RUN + PEND ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_wcm_ne30 COMPARE_base_rest + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/derecho_baselines/cam6_3_136: DIFF + - pre-existing failures + + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: NLFAIL) details: + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 NLCOMP + found extra variable: 'mpas_cam_damping_levels' + - expected failure, added mpas_cam_damping_levels to namelist + + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 NLCOMP + found extra variable: 'mpas_cam_damping_levels' + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 BASELINE /glade/p/cesm/amwg/derecho_baselines/cam6_3_136: DIFF + - expected failure, added mpas_cam_damping_levels to namelist and modified to use mpas_cam damping + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + - pre-existing failure + + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase NLCOMP + found extra variable: 'mpas_cam_damping_levels' + - expected failure, added mpas_cam_damping_levels to namelist + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_136 +Originator(s): cacraig, fischer +Date: Nov 18, 2023 +One-line Summary: Update externals to match cesm2_3_alpha16g and fix failing derecho tests +Github PR URL: https://github.com/ESCOMP/CAM/pull/914 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- Fix failing derecho regression tests: https://github.com/ESCOMP/CAM/issues/892 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update Externals to match cesm2_3_alpha16g + +M cime_config/SystemTests/tmc.py + - Fix from Chris Fischer for failing TMC regression test + +M cime_config/config_pes.xml + - Update derecho PE layouts + +M doc/ChangeLog_template + - Add derecho regression testing + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All tests had namelist changes due to externals update + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 MODEL_BUILD time=3 + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_135: DIFF + - pre-existing failures + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - Differences due to externals updated + +derecho/intel/aux_cam: no baseline comparisons due to being first official testing on derecho + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + PEND ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 SHAREDLIB_BUILD + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + - pre-existing failures on cheyenne + + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_wcm_ne30 (Overall: PEND) details: + PEND ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_wcm_ne30 RUN + PEND ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_wcm_ne30 COMPARE_base_rest + - unknown test failure - repeatable + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=80 + - pre-existing failure + + +izumi/gnu/aux_cam: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - baseline diffs due to externals update + +=============================================================== +=============================================================== + +Tag name: cam6_3_135 +Originator(s): jedwards, nusbaume +Date: 16 Nov 2023 +One-line Summary: removes svn sparse checkout +Github PR URL: https://github.com/ESCOMP/CAM/pull/913 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Use git sparse checkout for all repos, combine clubb and silhs into clubb. +git sparse checkout has been available in manage_externals since version 1.2.1. + +Fixes #912 -> cosp2 svn access to github support is ending soon + +Describe any changes made to build system: + +Build path were modified in the "configure" Perl script, as well +as in the COSP Makefile.in file, in order to account for the +new source code paths. + +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, cacraigucar, gold2718 + +List all files eliminated: N/A + +List all files added and what they do: + +A src/physics/.clubb_sparse_checkout + - Provides information on how to do the git sparse checkout of CLUBB and SILHS + +A src/physics/cosp2/.cosp_sparse_checkout + - Provides information on how to do the git sparse checkout of COSP + +List all existing files that have been modified, and describe the changes: + +M Externals_CAM.cfg + - Change the Github-SVN bridge method to git sparse checkout + +M bld/configure + - Update source code paths for CLUBB, SILHS, and COSP + +M src/physics/cosp2/Makefile.in + - Update source code paths for relevant COSP files. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: + + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 MODEL_BUILD time=3 + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_134: DIFF + - pre-existing failure + +izumi/nag/aux_cam: + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + - pre-existing failure + +izumi/gnu/aux_cam: ALL PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== + +Tag name: cam6_3_134 +Originator(s): nusbaume, jimmielin +Date: 31 Oct 2023 +One-line Summary: Update atmospheric_physics external +Github PR URL: https://github.com/ESCOMP/CAM/pull/891 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +This PR updates the atmospheric_physics external in CAM, +which requires some source modifications on the CAM-side. +There has also been some replacement of CAM code with CCPP +physics routines in order to reduce duplication. + +This PR also fixes a bug found in Kessler where it was using +the wrong pressure when converting to/from potential temperature +via the exner function. + +Finally, this change also brings in a rename of the SE +dycore's 'time_mod' module to 'se_dyn_time_mod' in order +to avoid name collision with GEOS-Chem code. + +Fixes #752 -> Update atmospheric_physics external +Fixes #802 -> Kessler physics using inconsistent reference pressures + +Closes #904 -> Rename SE dycore time_mod to dyn_time_mod (PR) + +Describe any changes made to build system: + +Added the "src/utils/cam_ccpp" and "src/atmos_phys/utilities" directory +to the list of directories used during compilation. + +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, PeterHjortLauritzen, jtruesdal, peverwhee + +List all files eliminated: + +R src/dynamics/se/dycore/time_mod.F90 + - Renamed to 'se_dyn_time_mod' +R src/utils/ccpp_kinds.F90 + - Moved to 'src/utils/cam_ccpp/ccpp_kinds.F90' + +List all files added and what they do: + +A src/utils/cam_ccpp/ccpp_constituent_prop_mod.F90 + - Creates a "CCPP Constituent Properties" object for CAM. + +List all existing files that have been modified, and describe the changes: + +M Externals_CAM.cfg + - Update 'atmospheric_physics' external + +M bld/configure + - Add 'src/utils/cam_ccpp' and 'src/atmos_phys/utilities' to build file paths + +M src/dynamics/se/dp_coupling.F90 + - Use CCPP-ized 'update_dry_static_energy_run' subroutine + +M src/physics/cam/geopotential.F90 + - Use CCPP-ized 'geopotential_temp_run' subroutine + +M src/physics/cam/ref_pres.F90 + - Update comment in order to avoid future confusion + +M src/physics/cam/physpkg.F90 +M src/physics/cam_dev/physpkg.F90 +M src/physics/simple/held_suarez_cam.F90 +M src/physics/simple/physpkg.F90 + - Update physics calls and add new const. prop. DDT to work with new + atmospheric_physics external + +M src/physics/simple/kessler_cam.F90 +- Update physics calls and add new const. prop. DDT to work with new + atmospheric_physics external. Also replace use of "standard pressure" + with "reference pressure" in order to avoid unphysical mismatches. + +M src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 +M src/dynamics/se/dycore/prim_advance_mod.F90 +M src/dynamics/se/dycore/prim_advection_mod.F90 +M src/dynamics/se/dycore/prim_driver_mod.F90 +M src/dynamics/se/dycore/prim_init.F90 +M src/dynamics/se/dycore/prim_state_mod.F90 +M src/dynamics/se/stepon.F90 + - Replace 'time_mod' with 'se_dyn_time_mod' + +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. + +cheyenne/intel/aux_cam: + + All tests have NLCOMP failures due to changes in input data paths on Cheyenne. + + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 MODEL_BUILD time=3 + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h NLCOMP + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_133: DIFF + - pre-existing failure + +izumi/nag/aux_cam: + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=9 + - pre-existing failure + + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_133_nag: DIFF + - expected failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: + All compsets which use Kessler idealized physics + will have larger-than-roundoff answer changes due + to reference pressure bug fix. + +=============================================================== + +Tag name: cam6_3_133 +Originator(s): fvitt +Date: 19 Oct 2023 +One-line Summary: Misc updates for WACCM-X +Github PR URL: https://github.com/ESCOMP/CAM/pull/897 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Introduce a hybrid PGF option in the SE dycore for WACCM-x to be consistent + with PGF used in CAM in the troposphere and traditional PGF formulation above + to solve stability issues with the SE dycore (issue #896) + + Correction to geometric height diagnostic (issue #681) + + Implements PHIHM history field for waccmx -- High Latitude Electric Potential + + Set reasonable default PE layouts for WACCM(x) and CAMChem on derecho. This + solves some of the regression test failures on derecho listed in issue #892 + +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: PeterHjortLauritzen cacraigucar nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M bld/namelist_files/namelist_defaults_cam.xml + - default IC for ne30pg3 L130 waccmx + +M bld/namelist_files/namelist_definition.xml + - add hybrid option for PGF formulation used by waccmx + +M cime_config/config_pes.xml + - default derecho PE layouts for + ne16, ne30 waccmx + f09 waccmx, waccm, and camchem + +M src/control/cam_history.F90 + - deallocate arrays at the end of write_restart_history + +M src/dynamics/se/dycore/global_norms_mod.F90 + - for waccmx set umax to 800 m/s used in stability assessment + +M src/dynamics/se/dycore/prim_advance_mod.F90 + - add hybrid option for PGF formulation used by waccmx + +M src/ionosphere/waccmx/edyn_init.F90 +M src/ionosphere/waccmx/edynamo.F90 + - add PHIHM history field diagnostic + +M src/ionosphere/waccmx/ionosphere_interface.F90 + - correction to Z3GM geometric height diagnostic + - replace "/gravit" with "*rga" in height calc + +M src/physics/cam/vertical_diffusion.F90 + - raise the lid of eddy diffusion for waccmx (ntop_eddy_pres=1.e-7 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. + +cheyenne/intel/aux_cam: + + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 MODEL_BUILD time=3 + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_132: DIFF + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_132: DIFF + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_132: DIFF + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_132: DIFF + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_132: DIFF + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_132: DIFF + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_132: DIFF + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_132: DIFF + - expected failures + +izumi/nag/aux_cam: + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=205 + - pre-existing failure + + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s NLCOMP + FAIL SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_132_nag: DIFF + - expected failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: + larger than roundoff for SE WACCMX, roundoff for FV WACCMX, + otherwise bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name:cam6_3_132 +Originator(s): cacraig, adamher, Thomas Toniazzo, hannay +Date: Oct 18, 2023 +One-line Summary: Bring in changes to match run 51 +Github PR URL: https://github.com/ESCOMP/CAM/pull/900 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update cam_development to match current tuning runs: https://github.com/ESCOMP/CAM/issues/895 + - Discussion also occurred at: https://github.com/NCAR/amwg_dev/discussions/412 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - When running cam_dev, change the values for: + micro_mg_dcs + clubb_gamma_coef + clubb_gamma_coefb + microp_aero_wsub_scale + microp_aero_wsubi_scale + microp_aero_wsub_min + micro_mg_vtrmi_factor + + - New namelists implemented: + microp_aero_wsub_min_asf: min subgrid vertical velocity (after scale factor) See namelist definition for full description + cldfrc2m_do_avg_aist_algs: for small ice cloud concentrations, take the geometric mean of the iceopt=4 and 5 area fractions + cldfrc2m_qist_min: min in-stratus ice IWC constraint + cldfrc2m_qist_max: max in-stratus ice IWC constraint + +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, pel, adamrher + +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/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml +M src/physics/cam/cldfrc2m.F90 +M src/physics/cam/microp_aero.F90 +M src/physics/cam/ndrop.F90 +M src/physics/spcam/crmclouds_camaerosols.F90 + - Change namelist as discussed in the issue/PR and group discussion + +M bld/namelist_files/namelist_definition.xml + - Update descriptions and add new ones + +M cime_config/testdefs/testlist_cam.xml + - Change a few tests to have them work on derecho + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + PEND ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 MODEL_BUILD RERUN + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + - pre-existing failure + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + - expected baseline differences due to removal of cam6 tuning factor for SE dy + + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + - expected baseline differences for cam_dev runs + + SMS_D_Ln9_Vnuopc_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + -Changed layout and hence the testname, so no baselines to compare with + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure + + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + - expected baseline differences due to removal of cam6 tuning factor for SE dy + +izumi/gnu/aux_cam: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - expected baseline differences for cam_dev runs + +NOTE: Most tests have namelist changes + +CAM tag used for the baseline comparison tests if different than previous +tag: N/A + +Summarize any changes to answers, i.e., +- what code configurations: All cam_dev and SE cam6 +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): Tuning changes - Climate changing for cam_dev + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + - Run which was the prelimiary source of the changes: https://github.com/NCAR/amwg_dev/tree/b.e23_alpha16b.BLT1850.ne30_t232.051 + - It is important to note that further changes were made to this tag as discussed in the issue/PR and discussion - Adam ran a test + to verify the final changes. + +=============================================================== + +Tag name: cam6_3_131 +Originator(s): cacraig +Date: Oct 17, 2023 +One-line Summary: Update externals to get job_priority setting on derecho +Github PR URL: https://github.com/ESCOMP/CAM/pull/906 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update externals for job_priority and other derecho enhancements: https://github.com/ESCOMP/CAM/issues/905 + NOTE -- This change brings in an updated CMEPS which is answer changing (see https://github.com/ESCOMP/CMEPS/pull/394) + +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 (and Adam and Cecile gave their approval for this to proceed) + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Update the externals + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 MODEL_BUILD time=2 + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + - pre-existing failure + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - answer changes due to CMEPS update + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=188 + PEND DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + - answer changes due to CMEPS update + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: +DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - answer changes due to CMEPS update + +=============================================================== +=============================================================== + +Tag name: cam6_3_130 +Originator(s): pel, jet, cacraig +Date: Oct 06, 2023 +One-line Summary: WACCMX-FV bug fix (correct calling sequenc of wet/dry species conversion), Derecho archive update +Github PR URL: https://github.com/ESCOMP/CAM/pull/887 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + This tag closes the following issues: + - Add Derecho support for archiving baselines (https://github.com/ESCOMP/CAM/issue/893) + - bug fix: correct timing of wet/dry mixing ratio conversion (https://github.com/ESCOMP/CAM/issues/885) + - bug fix: correct se_sponge_del4_nu_div_fac and se_sponge_del4_lev NL type definitions (https://github.com/ESCOMP/CAM/issues/690) + +Describe any changes made to build system: + Added Derecho support for archiving baselines + +Describe any changes made to the namelist: + Corrected namelist type definitions for se_sponge_del4_nu_div_fac and se_sponge_del4_lev + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraig, nusbaume, pel + +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/namelist_definition.xml + - correct namelist type definitions for se_sponge_del4_nu_div_fac and se_sponge_del4_lev + +M src/dynamics/fv/dp_coupling.F90 + - correct calling sequence for wet/dry constituent conversion + +M test/system/archive_baseline.sh + - Update to archive Derecho baselines + +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. + +cheyenne/intel/aux_cam: All BFB except + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 MODEL_BUILD time=2 + - pre-existing failure + + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) + - pre-existing failure + + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) + - expected failures: WACCMX differences from correcting calling sequence for wet/dry mixing ratio conversion + +izumi/nag/aux_cam: All BFB except + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure + +izumi/gnu/aux_cam: All BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_129 +Originator(s): cacraig, fischer, hplin, jet, jedwards +Date: Oct 04, 2023 +One-line Summary: Update externals to match cesm2_3_alpha16d and bring in test_driver which supports derecho +Github PR URL: https://github.com/ESCOMP/CAM/pull/888 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Add derecho support to test_driver (https://github.com/ESCOMP/CAM/pull/879) + - Fix long line in HEMCO external (https://github.com/ESCOMP/CAM/issues/871) + - Fix building older FMS library (no issue as was discovered during testing, but discussion is in PR#888) + +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, jet, 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 Externals.cfg + - update externals to match cesm2_3_alpha16d (ccs_config external is one tag newer) + +M Externals_CAM.cfg + - update HEMCO tag to get fix for line too long + +M cime_config/buildlib + - Updates for building older FMS library (required with changes in external). NOTE - The regression test + which tests FV3 (C96_C96_mg17) is broken. It was verified that the actual test works, but the regression test + no longer compiles properly due to changes in the SHARED_LIB build process. + +M test/system/test_driver.sh + - add derecho functionality (uses cheyenne aux_cam hooks to determine tests to run) + It is important to note that there are a number of failures when the tests are run on derecho (see + github issue https://github.com/ESCOMP/CAM/issues/892 for details) + +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. + +cheyenne/intel/aux_cam: + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 MODEL_BUILD time=2 + - Failure of FMS library compilation when more than one regression test is made due to changes in SHAREDLIB_BUILD + Was approved at AMP SE/scientist meeting to have this test fail until the upcoming FV3 PR is brought in + + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + - pre-existing failure + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - answer changes due to updated externals + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: + FAIL SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_128_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_128_gnu: DIFF + - answer changes due to updated externals + +All tests had namelist changes as well + +=============================================================== +=============================================================== + +Tag name: cam6_3_128 +Originator(s): fvitt +Date: 13 Sep 2023 +One-line Summary: Enable use of CARMA aerosol packages with unstructured grids +Github PR URL: https://github.com/ESCOMP/CAM/pull/650 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Address issues: + Need capability to run existing CARMA models on unstructured grids #649 + refractive_aerosol_optics_mod.F90 is missing an r8 qualifier #882 + +Describe any changes made to build system: n/a + +Describe any changes made to the namelist: n/a + +List any changes to the defaults for the boundary datasets: n/a + +Describe any substantial timing or memory changes: n/a + +Code reviewed by: cacraigucar nusbaume + +List all files eliminated: n/a + +List all files added and what they do: n/a + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - update CARMA base tag carma4_01 + +M bld/namelist_files/namelist_defaults_cam.xml + - default IC file for QPWmaC6 on ne5 grid + +M cime_config/testdefs/testlist_cam.xml + - new tests carma models, mostly for coarse SE grids + +M cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam + - include CRSLERFC in h1 output + +M cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam + - set wide impact zone for coarse grid testing + +M cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam + - increase carma_maxretries + - specified UBCs + +M src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 + - include "_r8" kind in limit constant + +M src/physics/carma/cam/carma_constants_mod.F90 + - remove commented out line + +M src/physics/carma/cam/carma_intr.F90 + - remove Cartesian coordinate and spacing stuff + - misc clean up and corrections + +M src/physics/carma/models/dust/carma_model_mod.F90 +M src/physics/carma/models/meteor_impact/carma_model_mod.F90 + - changes for generalized grid columns + +M src/physics/carma/models/sea_salt/carma_model_mod.F90 + - removed ununsed lat/lon indices + +M src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +M src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 +M src/physics/carma/models/pmc/carma_model_mod.F90 +M src/physics/carma/models/sulfate/carma_model_mod.F90 +M src/physics/carma/models/test_growth/carma_model_mod.F90 +M src/physics/carma/models/test_passive/carma_model_mod.F90 +M src/physics/carma/models/test_radiative/carma_model_mod.F90 +M src/physics/carma/models/test_swelling/carma_model_mod.F90 +M src/physics/carma/models/test_tracers/carma_model_mod.F90 +M src/physics/carma/models/test_tracers2/carma_model_mod.F90 + - minor clean up -- remove unused "module uses" + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + - pre-existing failures + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_127_nag: DIFF + - round-off level changes in carma base code + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: CARMA round-off level changes, otherwise bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_127 +Originator(s): pel, jet +Date: Sept 12, 2023 +One-line Summary: Option to turn on HB where CLUBB is not active +Github PR URL: https://github.com/ESCOMP/CAM/pull/849 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Free atmosphere Richardson number based mixing (using the free atmosphere + part of the Holtslag-Boville PBL scheme) for those layers where CLUBB is + not active (turned on in cam6 or cam_dev). Also helps stabilize less diffusive + dynamical cores. The issue for this PR is #846 and it will also address issue #772 + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: + - Introduced namelist variable do_hb_above_clubb. Default False unless using cam6 or cam_dev then + Holtslag-Boville PBL scheme will be used above CLUBB top) + - new namelist variable se_pgf_formulation to allow use of older pgf calculation to help with waccm regression errors + Can have an interger value of 1 or 2. + 1: Exner version of pressure gradient force (PGF) + 2: Traditional pressure gradient formulation (grad p) + +List any changes to the defaults for the boundary datasets: N/A + - New Boundary data for ERP and SMS WACCM runs - these runs require a spun up IC. + inputdata/atm/waccm/ic/FW2000.ne30pg3_ne30pg3_nlev70_c230906.nc + +Describe any substantial timing or memory changes: N/A + +Code reviewed by:fvitt, pel, eaton, cacraig, jesse + +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/build-namelist + - Turn on HB scheme where CLUBB not active + +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - add new namelist parameter for do_hb_above_clubb + - add new ic file to fix existing waccm regression test failures + +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_wcm_ne30/user_nl_cam + - use default se_nsplit for waccm runs using new ic file + +M src/dynamics/mpas/dp_coupling.F90 + - bug fix, looping should only be over wet species + +M src/dynamics/se/dp_coupling.F90 + - bug fix, looping should only be over wet species + +M src/dynamics/se/dycore/global_norms_mod.F90 +M src/physics/cam/clubb_intr.F90 + - set pbuf field so that HB scheme is only applied above CLUBB top + +M src/physics/cam/hb_diff.F90 +M src/physics/cam/vertical_diffusion.F90 + - add call to run HB scheme where CLUBB not active + +M src/physics/cam/geopotential.F90 + - bug fix for converting wet to dry mixing ratio + +M src/physics/cam/phys_control.F90 + - do_hb_above_clubb defined here and provided via getopts. + +M src/dynamics/se/dycore/prim_advance_mod.F90 +M src/dynamics/se/dyn_comp.F90 +M src/dynamics/se/dycore/control_mod.F90 + - remove duplicate timing call + - allow use of older pgf formulation to help with waccm regression errors + +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. + +cheyenne/intel/aux_cam: all BFB except: + + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + - expected NLFAIL due to new se_pgf_formulation namelist variable. + + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + - expected NLFAIL due to new do_hb_above_clubb namelist variable. + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - expected diff for cam_dev and cam6 run using do_hb_above_clubb=.true. + + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure + + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: NLFAIL) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + - expected NLFAIL due to new se_pgf_formulation namelist variable. + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + - expected diff for cam_dev/cam6 runs using do_hb_above_clubb=.true. + +izumi/gnu/aux_cam: all BFB except: + + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + - expected NLFAIL due to new se_pgf_formulation namelist variable. + + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) + - expected diff for cam_dev/cam6 runs using do_hb_above_clubb=.true. + +Summarize any changes to answers: climate changing for cam6/cam-dev runs using CLUBB + +=============================================================== +=============================================================== + +Tag name: cam6_3_126 +Originator(s): gdicker +Date: 6 Sep 2023 +One-line Summary: Add MPAS-A 60 and 30km analytic-ic ncdata +Github PR URL: https://github.com/ESCOMP/CAM/pull/848 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Add 60 and 30km MPAS-A meshes w/ 32L for analytic ICs: https://github.com/ESCOMP/CAM/issues/847 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - See specific details below in file section. + +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, jtruesdal, nusbaume + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/namelist_defaults_cam.xml + - Adds two new MPAS-A notopo files to ncdata section for runs with analytic_ic + - Adds mpas_dt for mpasa60 and mpasa30 hgrids + - Adds mpas_len_disp for mpasa60 and mpasa30 hgrids + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + - pre-existing failures + +izumi/nag/aux_cam: + TR8 test FAIL: src/chemistry/aerosol/refractive_aerosol_optics_mod.F90:288 crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev), 1.e-40) + - missing r8 qualifier, see Issue #882 + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_125 +Originator(s): fvitt +Date: 29 Aug 2023 +One-line Summary: Introduce abstract interface to aerosol optics +Github PR URL: https://github.com/ESCOMP/CAM/pull/824 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Issue #816 -- Refactor aerosol optics to use abstract aerosol optics class which can be + extended for different aerosol representations such as MAM and CARMA + +Describe any changes made to build system: n/a + +Describe any changes made to the namelist: + + Namelist group "modal_aer_opt_nl" is renamed as "aerosol_optics_nl" + +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 mattldawson nusbaume + +List all files eliminated: + +D src/physics/cam/modal_aer_opt.F90 + - replaced by generalized aer_rad_props module + +List all files added and what they do: + +A src/chemistry/aerosol/aerosol_optics_mod.F90 + - abstract interface to aerosol optics + +A src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 + - index of refaction based aerosol optics + +A src/physics/cam/aerosol_optics_cam.F90 + - generalized aerosol optics module + +List all existing files that have been modified, and describe the changes: + +M bld/namelist_files/namelist_definition.xml + - modal_aer_opt_nl group renamed as aerosol_optics_nl + +M src/chemistry/aerosol/aerosol_properties_mod.F90 +M src/chemistry/aerosol/modal_aerosol_properties_mod.F90 + - add methods for optical parameters + +M src/chemistry/aerosol/aerosol_state_mod.F90 +M src/chemistry/aerosol/modal_aerosol_state_mod.F90 + - add methods for optics + +M src/control/runtime_opts.F90 + - modal_aer_opt --> aerosol_optics_cam + +M src/physics/cam/aer_rad_props.F90 + - modal_aer_opt --> aerosol_optics_cam + +M src/physics/cam/rad_constituents.F90 + - add opticstype arg to rad_cnst_get_mode_props + +M src/physics/rrtmg/radiation.F90 + - remove modal_aer_opt_init call + +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. + +cheyenne/intel/aux_cam: + + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + - pre-existing failures + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: NLFAIL) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: NLFAIL) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: NLFAIL) details: + - modal_aer_opt_nl namelist group renamed as aerosol_optics_nl + +izumi/nag/aux_cam: + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + - modal_aer_opt_nl namelist group renamed as aerosol_optics_nl + +izumi/gnu/aux_cam: + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: NLFAIL) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + - modal_aer_opt_nl namelist group renamed as aerosol_optics_nl + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_124 +Originator(s): fvitt +Date: 23 Aug 2023 +One-line Summary: Fix issues exposed by FMTHIST; add regression tests for FLTHIST and FMTHIST +Github PR URL: https://github.com/ESCOMP/CAM/pull/872 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Fix memory issue in code that reads input data on the native unstructured model grid. + Fix floating point exception issue in aerosol wet deposition caused by undefined values in + BERGSO (conversion of cloud water to snow) above above pumus active region + + Address github issues: + Increase PE layout for MT runs #812 + Introduce regression tests for FLTHIST and FMTHIST #841 + +Describe any changes made to build system: n/a + +Describe any changes made to the namelist: n/a + +List any changes to the defaults for the boundary datasets: n/a + +Describe any substantial timing or memory changes: n/a + +Code reviewed by: cacraigucar nusbaume + +List all files eliminated: n/a + +List all files added and what they do: n/a + +List all existing files that have been modified, and describe the changes: +M Externals.cfg +M bld/namelist_files/namelist_defaults_cam.xml + - default spun-up IC file for L93 ne30 CAM-Chem-SE + +M cime_config/config_compsets.xml + - remove "_v0d" from FLTHIST and FMTHIST compset short names + +M cime_config/config_pes.xml + - set default PE layouts for FLTHIST and FMTHIST compsets + +M cime_config/testdefs/testlist_cam.xml + - add cheyenne regression tests for FLTHIST and FMTHIST compsets + +M src/chemistry/utils/tracer_data.F90 + - remove unused ps field that was allocated using undefined sizes when + the input file was on the native unsctructured model grid + +M src/dynamics/se/dyn_comp.F90 + - write "Molecular viscosity" message only if masterproc + +M src/physics/cam_dev/micro_pumas_cam.F90 + - zero bergo field above top_lev + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_123: DIFF + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 RUN time=287 + PEND ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 COMPARE_base_rest + - pre-extisting failures + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_123: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_123/ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s' does not exist + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_123: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_123/SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s' does not exist + - new tests + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + - pre-extisting failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_123 +Originator(s): cacraig, jedwards, fvitt +Date: August 16, 2023 +One-line Summary: Fix Derecho bugs +Github PR URL: https://github.com/ESCOMP/CAM/pull/878 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - cam_history field order: https://github.com/ESCOMP/CAM/issues/876 + - build failure on derecho: https://github.com/ESCOMP/ALI-ARMS/issues/2 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - Update ALI-ARMS external + +M src/control/cam_history.F90 + - Improve history writing for derecho + +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. + +cheyenne/intel/aux_cam: all BFB except: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_122: DIFF + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 RUN time=272 + PEND ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 COMPARE_base_rest + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_122: DIFF + - pre-existing failures + +izumi/nag/aux_cam: all BFB + +izumi/gnu/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_122 +Originator(s): fvitt +Date: 11 Aug 2023 +One-line Summary: Aerosol optics updates +Github PR URL: https://github.com/ESCOMP/CAM/pull/868 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Issue #865 -- Aerosol optics answer changes + + Generalization of the aerosol optics has resulted in answer changes. Here these answer changing + code modifications (in modal_aer_opt) are merged in separately which are as follows: + - use table_interp_mod utility rather than binterp subroutine -- answer changing (roundoff) + - use rh2odens parameter -- answer changing (roundoff) + - use model_size_parameters subroutine in modal_aero_lw rather than using separate + code block to compute the chebychev parameters -- answer changing (roundoff) + + Updates to aerosol optics diagnostics: + - generalize history field names that will accumulate multiple bins of a sectional aerosol model + - add short wave diagnostic AODTOT + - add long wave diagnostics AODABSLW (at 10 microns) and TOTABSLW + + Change in results are near roundoff level + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar nusbaume + +List all files eliminated: N/A + +List all files added and what they do: +A src/utils/table_interp_mod.F90 + - utility module for interpolation of aerosol optics tables + +List all existing files that have been modified, and describe the changes: + +M src/physics/cam/modal_aer_opt.F90 + - use table_interp_mod utility rather than binterp subroutine -- answer changing (roundoff) + - use rh2odens parameter -- answer changing (roundoff) + - use model_size_parameters subroutine in modal_aero_lw rather than + using separate code block to compute the chebychev parameters -- answer changing (roundoff) + - generalize history field names that will accumulate multiple bins of a sectional aerosol model + - add AODTOT SW diagnostic + - add AODABSLW (at 10 microns) and TOTABSLW diagnostics + +M src/physics/simple/radconstants.F90 + - add stub subroutine get_lw_spectral_boundaries for building simple models + +M bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +M bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml +M bld/namelist_files/use_cases/hist_trop_strat_nudged_cam6.xml +M bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml +M bld/namelist_files/use_cases/hist_trop_strat_vbsext_cam6.xml +M bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml +M bld/namelist_files/use_cases/sd_trop_strat2_cam6.xml +M bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml +M bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +M cime_config/usermods_dirs/CMIP6_B1850/user_nl_cam +M cime_config/usermods_dirs/CMIP6_B1850_WACCM/user_nl_cam +M cime_config/usermods_dirs/CMIP6_BHIST/user_nl_cam +M cime_config/usermods_dirs/CMIP6_BHIST_WACCM/user_nl_cam +M cime_config/usermods_dirs/CMIP6_GENERIC/user_nl_cam + - adjust history field names + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h NLCOMP + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: PEND) details: + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 NLCOMP + - pre-existing failures + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + FAIL ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + FAIL ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + FAIL SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: DIFF) details: + FAIL SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + FAIL SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_121: DIFF + - expected baseline failures due to changes in aerosol optics + - namelist compare failures due changes in aerosol optics diagnostics field names + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + - pre-existing failures + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + FAIL ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + FAIL ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + FAIL SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + FAIL TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + FAIL TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_nag: DIFF + - expected baseline failures due to changes in aerosol optics + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_gnu: DIFF + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_gnu: DIFF + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_gnu: DIFF + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_gnu: DIFF + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_gnu: DIFF + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_gnu: DIFF + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_gnu: DIFF + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_gnu: DIFF + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_121_gnu: DIFF + - expected baseline failures due to changes in aerosol optics + - namelist compare failures due changes in aerosol optics diagnostics field names + + NOTE: Independent testing showed that the combination of round-off level changes + to modal_aer_opt (listed above) results in near round-off level changes in the + aerosol optics (~12-16 significant digits of agreement). + +Summarize any changes to answers: near roundoff + +=============================================================== +=============================================================== + +Tag name: cam6_3_121 +Originator(s): fvitt +Date: 8 Aug 2023 +One-line Summary: Update SOAE emissions factors +Github PR URL: https://github.com/ESCOMP/CAM/pull/870 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Corrections to default namelist settings for: + - SAOE emissions factors (issue: Need to adjust SAOE emissions factors #860) + - 10x15 CAMChem IC file (issue: Unusable namelist default? #867) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist +M bld/namelist_files/use_cases/2000_cam6.xml +M bld/namelist_files/use_cases/2010_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml + - update SAOE emissions factors + +M bld/namelist_files/namelist_defaults_cam.xml + - correction to default 10x15 CAMChem IC file + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 RUN time=284 + PEND ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 COMPARE_base_rest + - pre-existing failures + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase NLCOMP + FAIL ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + FAIL ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev NLCOMP + FAIL ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 NLCOMP + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 NLCOMP + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m NLCOMP + FAIL SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging NLCOMP + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + FAIL SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs NLCOMP + FAIL SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_120: DIFF + - expected baseline failures due to update SAOE emissions factors + + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + FAIL SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 NLCOMP + - expected namelist compare failures due to update SAOE emissions factors + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=16 + PEND DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_120_nag: DIFF + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_120_nag: DIFF + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_120_nag: DIFF + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_120_nag: DIFF + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + FAIL ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 NLCOMP + FAIL ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_120_nag: DIFF + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase NLCOMP + FAIL SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_120_nag: DIFF + - expected baseline failures due to update SAOE emissions factors + +izumi/gnu/aux_cam: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 NLCOMP + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_120_gnu: DIFF + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_120_gnu: DIFF + - expected baseline failures due to update SAOE emissions factors + +Summarize any changes to answers: larger than roundoff + +=============================================================== +=============================================================== + +Tag name: cam6_3_120 +Originator(s): fvitt +Date: 28 Jul 2023 +One-line Summary: Add O3S diagnostic tracer to WACCM-MA; move gravity wave parameter to namelist +Github PR URL: https://github.com/ESCOMP/CAM/pull/851 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Make frontal gravity wave spectrum half-width a namelist variable (issue #839) + MA chemistry scheme (waccm_ma_mam4) needs O3S (issue #793) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + + New namelist parameter: + front_gaussian_width + Width of gaussian used to create frontogenesis tau profile [m/s]. + Defaults to 30 m/s + +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: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M bld/namelist_files/namelist_definition.xml + - new front_gaussian_width namelist parameter + +M bld/build-namelist + - set default front_gaussian_width + +M bld/namelist_files/namelist_defaults_cam.xml + - namelist defaults: + front_gaussian_width + O3S_Loss for WACCM-MA and SolIonRate_Tot for WACCM-X + +M bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml +M bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml +M bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml + - SolIonRate_Tot set by namelist_defaults_cam.xml + +M src/chemistry/pp_waccm_ma_mam5/chem_mech.doc +M src/chemistry/pp_waccm_ma_mam5/chem_mech.in +M src/chemistry/pp_waccm_ma_mam5/chem_mods.F90 +M src/chemistry/pp_waccm_ma_mam5/m_spc_id.F90 +M src/chemistry/pp_waccm_ma_mam5/mo_indprd.F90 +M src/chemistry/pp_waccm_ma_mam5/mo_lin_matrix.F90 +M src/chemistry/pp_waccm_ma_mam5/mo_nln_matrix.F90 +M src/chemistry/pp_waccm_ma_mam5/mo_prod_loss.F90 +M src/chemistry/pp_waccm_ma_mam5/mo_rxt_rates_conv.F90 +M src/chemistry/pp_waccm_ma_mam5/mo_sim_dat.F90 + - add diagnostic tracer O3S (explicit solver) + +M src/physics/cam/gw_drag.F90 + - move hard-wired parameter front_gaussian_width to namelist + +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. + +cheyenne/intel/aux_cam: + + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 NLCOMP + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 RUN time=291 + - pre-existing failure + + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_119: DIFF + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h NLCOMP + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_119: DIFF + - HEMCO baseline failures due to known issue with HEMCO external + + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + FAIL ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes NLCOMP + FAIL ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_119: FIELDLIST field lists differ (otherwise bit-for-bit) + - new O3S tracer field + + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_119: DIFF + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_119: DIFF + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_119: DIFF + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_119: DIFF + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_119: DIFF + - difference are due to O3S dry dep velocity surface fields, otherwise bit-for-bit + + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + - namelist compare failures due to new front_gaussian_width namelist parameter + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_119_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + - new O3S tracer field + + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: NLFAIL) details: + - namelist compare failures due to new front_gaussian_width namelist parameter + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: NLFAIL) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: NLFAIL) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + - namelist compare failures due to new front_gaussian_width namelist parameter + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_119 +Originator(s): fvitt +Date: 19 Jul 2023 +One-line Summary: CAM-Chem namelist updates and fix issue with maximum number of chemical emissions files +Github PR URL: https://github.com/ESCOMP/CAM/pull/850 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + - Updates to FCHIST and FCnudged compsets #771 + - Issue with maximum number of chemical emissions files #538 + -- fixes bug in SOAE emissions in cam6 configurations + +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: + + FCHIST and FCnudged compsets use SPS585 boundary conditions for FV 0.9x1.25 grid + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M bld/namelist_files/use_cases/hist_trop_strat_nudged_cam6.xml +M bld/namelist_files/use_cases/hist_trop_strat_vbs_cam6.xml + - use SPS585 boundary conditions for FV 0.9x1.25 grid + - history_chemitry=.true. enables shortening of the fincl1 list + +M bld/namelist_files/use_cases/2000_cam4_trop_chem.xml +M bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml + - remove SFNO2 from fincl list -- NO2 does not have surface emissions + +M bld/namelist_files/use_cases/sd_trop_strat_vbs_cam6.xml +M bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml + - history_chemitry=.true. enables shortening of the fincl1 list + +M src/chemistry/mozart/chemistry.F90 + - changes for longer lists of emissions files + - add SF* history fields only if species has surface emissions + +M src/chemistry/mozart/mo_chm_diags.F90 + - add DV_* and DF_* history fields only if species has dry deposition + +M src/chemistry/mozart/mo_srf_emissions.F90 +M src/chemistry/mozart/mo_extfrc.F90 + - changes for longer lists of emissions files + +M src/chemistry/mozart/mo_neu_wetdep.F90 + - remove add_default for DTWR_* history fields + +M src/chemistry/mozart/ocean_emis.F90 + - add ocean_emis_species function + - add_default for OCN_FLUX_* fields if history_chemistry is .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. + +cheyenne/intel/aux_cam: + + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 RUN time=2420 + - pre-existing failure + + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + - expected failures in HEMCO tests due to known restart/reprocibility issues with HECMO + + FAIL ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + - expected baseline differences due to bug fix for SOAE emissions used in cam6 (trop_mam4 chem) + + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: DIFF + - expected baseline differences due to change in namelist settings + + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_118: FIELDLIST field lists differ (otherwise bit-for-bit) + - change in default history fields, otherwise bit-for-bit + +izumi/nag/aux_cam: + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + FAIL SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: DIFF + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: DIFF + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: DIFF + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: DIFF + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: DIFF + FAIL ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: DIFF + - expected baseline differences due to bug fix for SOAE emissions used in cam6 (trop_mam4 chem) + + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + - change in default history fields, otherwise bit-for-bit + +izumi/gnu/aux_cam: + + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_gnu: DIFF + - expected baseline differences due to bug fix for SOAE emissions used in cam6 (trop_mam4 chem) + + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_118_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + - change in default history fields, otherwise bit-for-bit + +Summarize any changes to answers: larger than round off for cam6 + +=============================================================== +=============================================================== + +Tag name: cam6_3_118 +Originator(s): Haipeng Lin (jimmielin hplin@seas.harvard.edu), fvitt +Date: 17 Jul 2023 +One-line Summary: Integration of Harmonized Emissions Component (HEMCO) as emissions infrastructure +Github PR URL: https://github.com/ESCOMP/CAM/pull/560 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Add HEMCO_CESM as interface between CAM to the Harmonized Emissions Component (HEMCO): + https://github.com/ESCOMP/CAM/issues/504 + - Remove MCT test -- MCT coupling is no longer supported + - Remove mpi-serial MPILIB setting for SCAM + +Describe any changes made to build system: + - Adds HEMCO build paths under src/hemco + - Adds pre-processor constants MODEL_, MODEL_CESM, HEMCO_CESM, USE_REAL8 for use + by HEMCO to identify it is running in the CESM model environment and requires + 8-bit precision + +Describe any changes made to the namelist: + - cam_physics_mesh now is defined for all compsets instead of only for WACCMX + ionosphere-enabled compsets + - added %HEMCO component sets FC2000climo_HCO, FC2010climo_HCO, FCHIST_HCO, + FCnudged_HCO, FCts2nudged_HCO, and FCSD_HCO that enable HEMCO by default + - added use_hemco, hemco_config_file, hemco_emission_year, hemco_grid_xdim, + hemco_grid_ydim for configuring HEMCO + - ext_frc_specifier and srf_emis_specifier are ignored if use_hemco is true. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: brian-eaton, cacragucar, nusbaume, fvitt, adamrher, lkemmons + +List all files eliminated: N/A + +List all files added and what they do: +A src/chemistry/mozart/hco_cc_emissions.F90 + - Provides surface emissions and external forcing when HEMCO is enabled + +List all existing files that have been modified, and describe the changes: +M .gitignore +M Externals_CAM.cfg + - Adds HEMCO-CESM external + +M bld/build-namelist +M bld/config_files/definition.xml +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml +M bld/namelist_files/use_cases/2000_cam6.xml +M bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml +M bld/namelist_files/use_cases/2010_cam6.xml +M bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml + - Refer to namelist changes + +M bld/configure + - Refer to build changes + +M cime_config/config_component.xml +M cime_config/config_compsets.xml + - Adds %HEMCO compset modifier and _HCO compsets for CAM-chem compsets + to enable HEMCO by default + +M cime_config/testdefs/testlist_cam.xml + - Adds test for HEMCO on f09 in aux_cam and camchem_hco test sets, ne30 + in prealpha and camchem_hco test sets to test CAM with HEMCO + - Remove MCT tests + +M cime_config/testdefs/testmods_dirs/cam/scmarm/shell_commands +M cime_config/usermods_dirs/scam_mandatory/shell_commands + - Remove mpi-serial MPILIB setting for SCAM + +M src/chemistry/mozart/chemistry.F90 +M src/chemistry/mozart/mo_chemini.F90 +M src/chemistry/mozart/mo_gas_phase_chemdr.F90 +M src/chemistry/mozart/mo_setext.F90 + - Calls HEMCO-provided routines in hco_cc_emissions instead of existing + set_srf_emissions and extfrc_set when HEMCO is enabled + - Adds pbuf argument to chem_emissions subroutine as necessary for + HEMCO-CESM interface to access pbuf to retrieve emissions computed by HEMCO + +M src/chemistry/pp_none/chemistry.F90 +M src/chemistry/pp_terminator/chemistry.F90 + - Subroutine arguments added pbuf for consistent definition as mozart/chemistry.F90 + +M src/control/runtime_opts.F90 + - Read HEMCO namelist + +M src/physics/cam/phys_control.F90 + - Read use_hemco variable from physics namelist + +M src/physics/cam/physpkg.F90 +M src/physics/cam_dev/physpkg.F90 + - Call HEMCO routines in physics phase 2 + +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. + +cheyenne/intel/aux_cam: B4B + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: NLFAIL) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: NLFAIL) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: NLFAIL) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: NLFAIL) details: + - namelist compare failures due to use_hemco new namelist switch + + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_117: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_117/ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s' does not exist + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h NLCOMP + FAIL SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_117: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_117/SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h' does not exist + - new tests + - HEMCO tests are expected for fail due to known issue with reproducibility and restarts + +izumi/nag/aux_cam: B4B + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: NLFAIL) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: NLFAIL) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + - namelist compare failures due to use_hemco new namelist switch + +izumi/gnu/aux_cam: B4B + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: NLFAIL) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + - namelist compare failures due to use_hemco new namelist switch + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_117 +Originator(s): cacraig, patc, islas +Date: June 28, 2023 +One-line Summary: Bring in Frierson Simple Model (gray radiation) +Github PR URL: https://github.com/ESCOMP/CAM/pull/537 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Frierson gray radiation: https://github.com/ESCOMP/CAM/issues/8 + +Describe any changes made to build system: + - Add physics option "grayrad" + +Describe any changes made to the namelist: + - Introduced namelist settings for Frierson Gray radiation (all prepended with "frierson") + +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, peverwhee, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: +A bld/namelist_files/use_cases/dctest_frierson.xml + - Add use_case for Gray radiation model + +A src/physics/simple/frierson.F90 +A src/physics/simple/frierson_cam.F90 + - Bring in Frierson code along with the CAM interface code to it + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist + - introduce grayrad physics option and accompanying namelist values + +M bld/config_files/definition.xml +M bld/configure + - introduce grayrad physics option + +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - introduce grayrad namelist values + +M cime_config/config_component.xml + - introduce %GRAYRAD compset qualifier + +M cime_config/config_compsets.xml + - introduce FGRAYRAD compset + +M cime_config/testdefs/testlist_cam.xml + - introduce prebeta test for FGRAYRAD compset + +M src/control/cam_control_mod.F90 +M src/control/runtime_opts.F90 +M src/physics/simple/physpkg.F90 +M src/physics/simple/restart_physics.F90 + - mods to support gray radiation + +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. + +cheyenne/intel/aux_cam: all BFB except: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + - pre-existing failure + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB + +Isla Simpson analyzed the results from these code mods and approved the release of the Gray Radiation option. + +=============================================================== +=============================================================== + +Tag name:cam6_3_116 +Originator(s): cacraig, hannay, jedwards, eaton +Date: June 23, 2023 +One-line Summary: CAM Tuning "F" and fix derecho CSLAM performance +Github PR URL: https://github.com/ESCOMP/CAM/pull/820 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update tunings for LT and MT based on the "Tuning F": https://github.com/ESCOMP/CAM/issues/818 + - New gw tuning to add to the trunk: https://github.com/ESCOMP/CAM/issues/829 + - More tuning for LT and MT: https://github.com/ESCOMP/CAM/issues/838 + - Derecho CSLAM performance issue: https://github.com/ESCOMP/CAM/discussions/827 + - add pointers for intel performance, remove unused PI variable for nvhpc: https://github.com/ESCOMP/CAM/pull/845 + - Introduce configure options "lt" and "mt" + - Use new ncdata file with required metadata for LT and MT ne30pg3 runs + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - micro_mg_dcs is now set inside build-namelist + - Default settings were changed for: micro_mg_dcs, use_gw_front, use_gw_convect_dp, + eff_rdg_beta, eff_rdg_beta_max, tau_0_ubc, effgw_beres_dp, clubb_C7, clubb_C_uu_shr, + clubb_l_mono_flux_lim_um, clubb_l_mono_flux_lim_vm, clubb_l_predict_upwp_vpwp, + microp_aero_wsubi_scale, micro_mg_vtrmi_factor, dust_emis_fact, seasalt_emis_scale + +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, nusbaume, eaton, adamrher (jtruedal, nusbaume and Peter Lauritzen reveiwed PR#845) + +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/build-namelist + - Add selection for micro_mg_dcs + - Additional settings for tuning "F" + +M bld/config_files/definition.xml +M bld/configure +M cime_config/config_component.xml + - Introduce model_top qualifier with lt and mt options + +M bld/namelist_files/namelist_defaults_cam.xml + - Tuning "F" namelist settings + - Update files to include LT and MT input files which contain metadata + +M bld/namelist_files/use_cases/1850_cam_lt.xml +M bld/namelist_files/use_cases/1850_cam_mt.xml +M bld/namelist_files/use_cases/hist_cam_lt.xml +M bld/namelist_files/use_cases/hist_cam_mt.xml + - Remove ncdata files and use ones from namelist_defaults_cam.xml + +M cime_config/config_compsets.xml + - Update to FLTHIST_v0d and FMTHIST_v0d + +M src/control/cam_history.F90 + - remove unused pi + +M src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 + - Fix derecho performance issue + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +Most tests had namelist differences + +cheyenne/intel/aux_cam: all BFB except: + + Ran FLTHIST and FMTHIST with old and new ncdata file and the results were BFB + + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + - pre-existing failure + + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + - cam_dev tests have answer changes due to namelist changes + + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + - SILHS has answer changes due to namelist changes. Adam Herrington approved changing answers for this configuration + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB except: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - cam_dev tests have answer changes due to namelist changes +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: cam6_3_115 +Originator(s): aherring, jet +Date: June 21, 2023 +One-line Summary: Add support for coarse se grid ne3np4 and additional support for ne5 and ne16 grids +Github PR URL: https://github.com/ESCOMP/CAM/pull/815 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Create coarser grids for SE dycore and use for regression testing: https://github.com/ESCOMP/CAM/issues/726 + +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: New coarse grid SE boundary data. + /glade/p/cesmdata/inputdata/atm/cam/inic/se/cam6_QPC6_aqua_ne3pg3_mg37_L32_01-01-31_c221214.nc + /glade/p/cesmdata/inputdata/atm/cam/inic/se/cam6_QPC6_aqua_ne3pg3_mg37_L58_01-01-31_c221214.nc + /glade/p/cesmdata/inputdata/atm/cam/inic/se/cam6_QPC6_aqua_ne3pg3_mg37_L93_01-01-31_c221214.nc + /glade/p/cesmdata/inputdata/atm/cam/inic/se/cam6_QPC6_topo_ne3pg3_mg37_L32_01-01-31_c221214.nc + /glade/p/cesmdata/inputdata/atm/cam/inic/se/cam6_QPC6_topo_ne3pg3_mg37_L58_01-01-31_c221214.nc + /glade/p/cesmdata/inputdata/atm/cam/inic/se/cam6_QPC6_topo_ne3pg3_mg37_L93_01-01-31_c221214.nc + /glade/p/cesmdata/inputdata/atm/cam/inic/se/F2000climo_ne5pg3_mg37_L32_01-01-31_c230520.nc + /glade/p/cesmdata/inputdata/atm/cam/inic/se/F2000climo_ne5pg3_mg37_L58_01-01-31_c230520.nc + /glade/p/cesmdata/inputdata/atm/cam/topo/se/ne3pg3_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230209.nc + /glade/p/cesmdata/inputdata/atm/cam/chem/trop_mam/atmsrf_ne3np4.pg3_c221214.nc + /glade/p/cesmdata/inputdata/atm/cam/chem/trop_mam/atmsrf_ne5pg3_201105.nc + /glade/p/cesmdata/inputdata/atm/cam/chem/trop_mam/atmsrf_ne16pg3_c230520.nc + +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 bld/namelist_files/namelist_defaults_cam.xml + - New defaults for ne3 ne5 and ne16 boundary data + M cime_config/tsetdefs/testlist_cam.xml + - New test for ne3pg3 grid + M Changelog + +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. + +cheyenne/intel/aux_cam: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: FAIL) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + - pre-existing failures - mpasa480 failure due to corrupted initial condition file. + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + - Expected Difference due to update dry dep surface data file + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - Pre-existing failure + + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + - expected failures due to updated initial condition file. + + ERP_Ln9_Vnuopc.ne3pg3_ne3pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + - expected failure against Baseline because this is a new test + +izumi/gnu/aux_cam: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + - expected failures due to updated initial condition file. +=============================================================== +=============================================================== + +Tag name: cam6_3_114 +Originator(s): cacraig +Date: June 8, 2023 +One-line Summary: Update externals to match cesm2_3_beta14 + +Github PR URL: https://github.com/ESCOMP/CAM/pull/836 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +Update externals to cesm2_3_beta14 + : https://github.com/ESCOMP/CAM/issues/835 +Update to ccs_config_cesm0.0.72: https://github.com/ESCOMP/CAM/issues/834 +Brings in CTSM external needed by https://github.com/ESCOMP/CAM/pull/815 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + Update externals to match cesm2_3_beta14 (plus more recent CTSM and ccs_config as described above) + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: all NL changes + - NUOPC introduces namelist changes + + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + - Answer changes due to CTSM + + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: FAIL) details: + - preexisting failure + +izumi/nag/aux_cam: all BFB, all NL changes + - NUOPC introduces namelist changes + + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + - preexisting failure + + +izumi/gnu/aux_cam: all BFB, all NL changes + - NUOPC introduces namelist changes + +CAM tag used for the baseline comparison tests if different than previous +tag: cam6_3_112 as cam6_3_113 did not have regression tests run for it + +=============================================================== +=============================================================== + +Tag name: cam6_3_113 +Originator(s): cacraig +Date: June 5, 2023 +One-line Summary: Update manage_externals to manic-1.2.22 +Github PR URL: https://github.com/ESCOMP/CAM/pull/833 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update manage_externals to latest version: https://github.com/ESCOMP/CAM/issues/740 + +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 +A manage_externals/.github/workflows/bumpversion.yml +A manage_externals/.github/workflows/tests.yml +A manage_externals/test/repos/README.md + - Updates for manage_externals + +List all existing files that have been modified, and describe the changes: +M manage_externals/.gitignore +M manage_externals/.travis.yml +M manage_externals/README.md +M manage_externals/checkout_externals +M manage_externals/manic/checkout.py +M manage_externals/manic/externals_description.py +M manage_externals/manic/externals_status.py +M manage_externals/manic/repository_factory.py +M manage_externals/manic/repository_git.py +M manage_externals/manic/repository_svn.py +M manage_externals/manic/sourcetree.py +M manage_externals/manic/utils.py +M manage_externals/test/README.md +M manage_externals/test/test_sys_checkout.py +M manage_externals/test/test_sys_repository_git.py +M manage_externals/test/test_unit_externals_description.py +M manage_externals/test/test_unit_externals_status.py +M manage_externals/test/test_unit_repository.py +M manage_externals/test/test_unit_repository_git.py +M manage_externals/test/test_unit_repository_svn.py +M manage_externals/test/test_unit_utils.py + - Updates for manage_externals + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: None run + +izumi/nag/aux_cam: None run + +izumi/gnu/aux_cam: None run + +Ran manage_externals/checkout_externals on cheyenne and izumi and it worked fine + +=============================================================== +=============================================================== + +Tag name: cam6_3_112 +Originator(s): fvitt +Date: 18 May 2023 +One-line Summary: Refactor heterogeneous freezing to use abstract aerosol interfaces +Github PR URL: https://github.com/ESCOMP/CAM/pull/714 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Refactor heterogeneous freezing code to use abstract aerosol interfaces + Issue #738 + +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 tilmes 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/chemistry/aerosol/aerosol_properties_mod.F90 +M src/chemistry/aerosol/aerosol_state_mod.F90 +M src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +M src/chemistry/aerosol/modal_aerosol_state_mod.F90 + - interfaces expanded for heterogeneous freezing + +M src/physics/cam/hetfrz_classnuc.F90 + - refactored to work with an arbitrary number of modes/bins + - treat black carbon modes separately -- differences larger than round off + - use constants from physconst module -- differences larger than round off + +M src/physics/cam/hetfrz_classnuc_cam.F90 + - refactored to use abstract aerosol interfaces + +M src/physics/cam/microp_aero.F90 + - pass aerosol objects to het freeze routines + +M src/utils/physconst.F90 + - moved amu constant from hetfrz_classnuc + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: FAIL) details: + - pre-existing failures + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + - expected baseline differences for cases where use_hetfrz_classnuc is .true. + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + - expected baseline differences for cases where use_hetfrz_classnuc is .true. + +izumi/gnu/aux_cam: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - expected baseline differences for cases where use_hetfrz_classnuc is .true. + +Summarize any changes to answers: larger than roundoff but same climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + source: + git@github.com:fvitt/CAM.git + branch hetfrz_rfctr + hash 2171325 + + platform/compilers: + cheyenne/intel + + configuration: + create_newcase --compset FHIST --res f09_f09_mg17 + case dirs: + /glade/u/home/fvitt/cesm/cases/f.e22.Fnudged.f09_f09_mg17.cam6_3_097.2018.hetfrz.001 + /glade/u/home/fvitt/cesm/cases/f.e22.Fnudged.f09_f09_mg17.cam6_3_097.2018.hetfrz.002 + +MSS location of output: + /glade/campaign/acom/acom-climate/fvitt/archive/f.e22.Fnudged.f09_f09_mg17.cam6_3_097.2018.hetfrz.002 + +MSS location of control simulations used to validate new climate: + /glade/campaign/acom/acom-climate/fvitt/archive/f.e22.Fnudged.f09_f09_mg17.cam6_3_097.2018.hetfrz.001 + +URL for AMWG diagnostics output used to validate new climate: + https://webext.cgd.ucar.edu/FHIST/f.e22.Fnudged.f09_f09_mg17.cam6_3_097.2018.hetfrz.002/atm/ + +=============================================================== +=============================================================== + +Tag name: cam6_3_111 +Originator(s): cacraig, hannay, fvitt +Date: May 17, 2023 +One-line Summary: create CAM LT and MT 1850 use_cases +Github PR URL: https://github.com/ESCOMP/CAM/pull/806 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Add use_cases for 1850 LT and MT compsets: https://github.com/ESCOMP/CAM/issues/804 + + *** IMPORTANT NOTE -- MT compsets do not run successfully for 9 time steps + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - See specific details below in file section: + Updated namelist settings based on discussion in: https://github.com/NCAR/amwg_dev/discussions/261 + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: hannay, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: +A bld/namelist_files/use_cases/1850_cam_lt.xml +A bld/namelist_files/use_cases/1850_cam_mt.xml + - Initial use cases - setup for BLT1850 and BMT1850 to use + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist + - Remove H2O ext_file from ghg_mam runs + +M bld/namelist_files/namelist_defaults_cam.xml + - Added gw_apply_tndmz defaults for ghg_mam4 93 and 58 level + - Added se_hypervis_subcycle default for ne30np4, npg3, 58 level + +M bld/namelist_files/use_cases/hist_cam_lt.xml +M bld/namelist_files/use_cases/hist_cam_mt.xml + - Removed the above settings and others which are set properly via namelist_defaults + +M cime_config/config_component.xml + - Added hooks for 1850 LT and MT use_cases + +M cime_config/config_compsets.xml + - Added for Testing purposes ONLY - FLT1850_TESTINGONLY_v0c and FMT1850_TESTINGONLY_v0c + + +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. + +cheyenne/intel/aux_cam: + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 RUN time=266 + - preexisting failure + + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 RUN time=357 + - This test passed for Brian Eaton when he made cam6_3_110. We retested and Francis Vitt had it fail for + cam6_3_109. Cheryl Craig tested using cam6_3_110 and cam6_3_108 and it failed in both of these version. + Saying this is a preexisting failure and will be researched later + + FAIL ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev BASELINE + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s BASELINE + - expected baselines differences due to namelist changes + + +izumi/nag/aux_cam: all BFB except: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + + +izumi/gnu/aux_cam: all BFB + +ADDITIONAL TESTS RUN: + + Cecile ran FLTHIST and FLT1850 tests with restart and they ran properly (with user_nl_cam, user_nl_clm, CLM SourceMods and + various XML settings): + /glade/scratch/hannay/cases/f.cam6_3_111.FLT1850.001 + /glade/scratch/hannay/cases/f.cam6_3_111.FLTHIST_v0c.001 + + +=============================================================== +=============================================================== + +Tag name: cam6_3_110 +Originator(s): eaton, bstephens +Date: Tue May 9 01:46:34 PM EDT 2023 +One-line Summary: Resolve miscellaneous issues. +Github PR URL: https://github.com/ESCOMP/CAM/pull/797 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Issue #371 - Grid matches in refcases will need to change from + gland4 to gris4 if they are re-enabled + (https://github.com/ESCOMP/CAM/issues/371). + - Resolved by removing entries for old refcases. + +. Issue #741 - Updates to address CLUBB variable-name length limit. + (https://github.com/ESCOMP/CAM/issues/741) + - Use cam_history_support::max_fieldname_len to replace hardcoded 16. + - PR #743 will be resolved by this PR. + +. Issue #608 - Fix path for buildlib/buildnml + (https://github.com/ESCOMP/CAM/issues/608) + - Fix one wrong occurance of the old path 'cime/scripts/Tools'. Don't + see any problem with paths for buildlib/buildnml. + +. Issue #749 - Correct description of low-level wind output + (https://github.com/ESCOMP/CAM/issues/749) + - fix description as suggested + +. Issue #803 - Add missing GHGMAM4 to FMTHIST compset + (https://github.com/ESCOMP/CAM/issues/803) + - add missing %GHGMAM4 to FMTHIST compset + - change FLTHIST_v0b to FLTHIST_v0c + - change FMTHIST_v0b to FMTHIST_v0c + +. resolves #371 +. resolves #741 +. resolves #743 +. resolves #608 +. resolves #749 +. resolves #803 + +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: fvitt, cacraigucar, nusbaume + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bld/namelist_files/namelist_definition.xml +. change type of clubb_vars_* from char*16 to char*35 + +cime_config/config_compsets.xml +. remove commented out lines (575-618) for old refcases +. add missing %GHGMAM4 to FMTHIST compset +. change FLTHIST_v0b to FLTHIST_v0c +. change FMTHIST_v0b to FMTHIST_v0c + +src/physics/cam/cam_diagnostics.F90 +. change descriptions of WSPDSRFMX and WSPDSRFAV from 'at the surface' to + 'at surface layer midpoint' + +src/physics/cam/clubb_intr.F90 +. access max_fieldname_len from cam_history_support +. replace hardcoded 16 by max_fieldname_len in 8 places that set the name + of the variable for an outfld call + +test/system/archive_baseline.sh +. change path of bless_test_results from 'cime/scripts/Tools' to + 'cime/CIME/Tools' + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + - pre-existing failure + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_109 +Originator(s): pel, jet +Date: 28 April 2023 +One-line Summary: Science and infrastructure updates for inline energy/mass budgets +Github PR URL: https://github.com/ESCOMP/CAM/pull/761 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Add inline energy/mass budgets support. (#519) Science changes are + included that help close the mass and energy budgets of physics + and the SE/MPAS dycores (#521) as well as adding all water + constituents to atmospheric mass (pressure) (#520). + + Extra items also included in this PR: + - Bugfix to correctly open an instance version of atm_in (ndep issue #790) + - Update FLTHIST compset and finish implementing initial FMTHIST compset (#789) + + As of this commit energy/mass budgets have been roughed in for + physics and the SE and MPAS dycores. Similar to amwg_diagnostic + functionality, energy/mass budget diagnostic fields will be added + to a history file via the thermo_budget_histfile_num namelist + parameter. Globally averaged energy budget summaries are also + calculated and written to the atm log file every time the budget + history tape is written to. The period over which energy and mass + budgets are averaged is the same as the averaging period of the + history budget file. Thus history budgets can be output/averaged + at timestep, hour, or month resolutions using the nhtfrq variable + specific to the budget history file identified by + thermo_budget_histfile_num. The new namelist logical variable + thermo_buget_history is used to turn budgeting on (.true.) or off + (.false.) The default is .false. (no budgeting) because of the + global gathers needed to create the budgets. + + An energy or mass budget is defined by a mathematical operation + (sum/difference) of two energy/mass snapshots. For instance one + can talk of the energy lost/gained by the physics + parameterizations by comparing snapshots taken before and after + running the physics. + + An energy budget is created, logged and written to the budget history tape in four steps + 1) call cam_budget_em_snapshot to define multiple energy/mass snapshots + 2) call cam_budget_em_budget to define a budget as the difference/sum of two snapshots. + 3) call tot_energy_phys (or tot_energy_dyn) for each named snapshot + 4) setting namelist variables thermo_budget_history, thermo_budget_histfile_num, nhtfrq + + Energy and mass snapshots are defined and added to the history + buffer via the cam_budget_em_snapshot subroutine. The cam_budget_em_snapshot routine + creates a set of vertically integrated energy and mass history + output fields based on the snapshot name parameter prepended with + the types of energy and mass that are carried in cam and defined + in cam_thermo.F90 For example calling cam_budget_em_snapshot with a name of + 'dAP', perhaps standing for an energy snapshot after physics is + called, will create a set of fields that contain kinetic (KE_dAP), + sensible (SE_dAP), potential (PO_dAP) and total (TE_dap) energies + as well as atmospheric vapor (wv_dAP), liquid (wl_dAP) and ice + (wi_dAP) masses. A call to calc_total_energy for the each named + snapshot (here placed after after the physics parameterization) + will calculate and outfld the 9 or so specific energy and mass + snapshots. + + The cam_budget_em_budget routine defines a named budget composed of the + difference or sum of two snapshots. As with cam_budget_em_shapshot the + budget name is prepended with the same energies identifiers as + cam_budget_em_snapshot. All energy/mass snapshots as well as the budgets are + saved to the history buffer and written to the budget history + file. tot_energy_phys and tot_energy_dyn routines exists for both + physics and dynamics to allow snapshots tailored to thermodynamic + needs and data structures of those packages. + + +Describe any changes made to build system: + +Describe any changes made to the namelist: + New budgeting namelist variables have been added. Interface + follows existing functionality to outfld standard diagnostics for + budgeting and diagnosis. + + se_lcp_moist + se_phys_dyn_cp + - removed + + thermo_budget_histfile_num: integer identifing which history file will contain + additional budgeting diagnostic fields + thermo_budget_history: logical that turns history budgeting on and off. + - added + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: + Global gathers are done each time a thermo budgeting field is + written to the history file. The budgeting diagnostics are not + meant to be enabled during a production run. + +Code reviewed by: cacraigucar nusbaume brian-eaton fvitt pel + +List all files eliminated: N/A + +List all files added and what they do: + A src/cam/control/cam_budget.F90 + provides support for energy/mass budgeting using cam_history infrastructure. + +List all existing files that have been modified, and describe the changes: + + M bld/namelist_files/use_cases/hist_cam_mt.xml + - update FLTHIST for coupled runs + + M bld/build_namelist + - Remove se_lcp_moist and se_phys_dyn_cp namelist flags + + M namelist_defaults_cam.xml + - new mpas initial data default for mpasa120 aquaplanet. + - update cam_dev defaults to add Graupel constituent. + + M namelist_definition.xml + - new averaging flag option for budget variables 'N' allows normalization by nsteps. + - nstep normalization is required to properly budget subcycled fields. + - new namelist parameters for budgeting + + M cam_comp.F90 + - add call to print budgets. The print_budget function needs to be defined for all dycores. + + M cam_history.F90 + - new functionality for history buffered fields + - new area weighted global averaging functionality for history fields. + - create new composed hbuf field which is created from a sum/difference operation on + two existing fields. + - restart information added for budgeting. + + M cam_history_buffers.F90 + - new subroutine for nstep field averaging + + M cam_history_support.F90 + - added support for new global average functionality + + M cime_config/config_compsets.xml + - update FLTHIST for coupled runs + + M runtime_opts.F90 + - added budget namelist read + + M atm_comp_nuopc.F90 + - bug fix, support for E/W formatted initial data longitudes spanning -180:180 + + M cpl/nuopc/atm_stream_ndep.F90 + - bug fix to allow opening instance version of atm_in namelist. + + M eul/dp_coupling.F90 + - update calling parameters + + M eul/dycore_budget.F90 + - Dummy routine for printing EUL budget - not fully supported yet. + + M fv/dp_coupling.F90 + - update calling parameters + + M fv/dycore_budget.F90 + - Dummy routine for printing FV budget - not fully supported yet. + + M fv/metdata.F90 + - thermodynamic activespecies variables + + M fv3/dp_coupling.F90 + - update calling parameters + + M fv3/dycore_budget.F90 + - Dummy routine for printing FV3 budget - not fully supported yet. + + M mpas/dp_coupling.F90 + - science updates + - all water constitutents added to pressure + - mods to further reduce bias in energy budget + + M mpas/dycore_budget.F90 + - Routine for printing MPAS budget + + M mpas/dyn_comp.F90 + - Add core budgets for mpas energy and mass - stages + + M mpas/dyn_grid.F90 + - register area weights for mpas grids + + M se/advect_tend.F90 + - refactor statements checking for use of cslam + + M se/dp_coupling.F90 + - science updates + - all water constitutents added to pressure + - mods to further reduce bias in energy budget + + M se/dycore/control_mod.F90 + - remove phys_dyn_cp energy scaling flag + + M se/dycore/control_mod.F90 + - thermal energy scaling of T + + M se/dycore/dimensions_mod.F90 + - get rid of lcp_moist now namelist variable + + M se/dycore/fvm_mod.F90 + - add use_cslam logical in place of if ntrac>0 + + M se/dycore/global_norms_mod.F90 + - new interface for calculating both elem and fvm global integrals (fvm added) + + M se/dycore/hybrid_mod.F90 + - add use_cslam logical in place of if ntrac>0 + + M se/dycore/namelist_mod.F90 + - add use_cslam logical in place of if ntrac>0 + + M se/dycore/prim_advance_mod.F90 + - science updates to close energy budget + - refactor energy calc routine. + - new hydrostatic energy routine with potential energy now split out from SE + + M se/dycore/prim_advection_mod.F90 + - refactor for enthalpy ... internal energy to enthalpy + + M se/dycore/prim_driver_mod.F90 + - rename routine to calculate total energy + + M se/dycore/prim_state_mod.F90 + - add use_cslam logical in place of if ntrac>0 + + M se/dycore/viscosity.F90 + - add use_cslam logical in place of if ntrac>0 + + M se/dycore_budget.F90 + - Routine for printing SE energy/mass budgets + + M se/dyn_comp.F90 + - Add core budget variables for se energy and mass - stages + + M se/dyn_grid.F90 + - register area weights for se grids + - call budget_add for all SE energy/mass budget fields. + + M se/dyn_grid.F90 + - consistent naming of routine that calculates total energy + + M se/restart_dynamics.F90 + - add use_cslam logical in place of if ntrac>0 + + M se/stepon.F90 + - update name calc_tot_energy_dynamics to tot_energy_dyn + + M se/test_fvm_mapping.F90 + - add use_cslam logical in place of if ntrac>0 + + M infrastructure/phys_grid.F90 + - register area weights for physic grid + - call budget_add for all SE energy/mass budget fields. + + M cam_diagnostics.F90 + - register physics energy/mass budgets using budget_add calls + - physics energy/mass variables (physics budget stages) + + M check_energy.F90 + - update calls to get hydrostatic energy (include new potential energy input param) + - update calc energy/mass routine for potential energy calculation. + + M constituents.F90 + - clean up unused variables (NAG) + + M geopotential.F90 + - remove unused routines/variables (NAG) + - add computation of generalized virtual temp to geopotential_t + + M phys_control.F90 + - code cleanup + + M cam/phys_grid.F90 + - register area weights for global integrals + + M physics_types.F90 + - science updates for energy/mass budgets + + M cam/physpkg.F90 + - science updates for energy/mass budgets + - science updates for energy/mass budgets + + M cam_dev/physpkg.F90 + - science updates for energy/mass budgets + + M simple/physpkg.F90 + - science updates for energy/mass budgets (update dme_adjust) + + M utils/air_composition.F90 + - refactor/cleanup/rename + + M utils/grid_support.F90 + - support for global area weighting for budgets + + M utils/cam_thermo.F90 + - energy and mass budget variables and descriptions. + +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. + +cheyenne/intel/aux_cam: Expecting namelist and baseline failures (SE,MPAS,FV3 climate changing, others roundoff) + + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) + - pre-existing failure + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: DIFF) + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: DIFF) + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) + - expecting climate changing differences in SE,MPAS,FV3 + - verified FV,EUL differences are roundoff + + FAIL ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 NLCOMP + FAIL ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d NLCOMP + - expected NLCOMP failures due to removal of se_lcp_moist, se_phys_dyn_cp namelist variables for SE runs + - expected NLCOMP failures from addition of GRAUPEL to water species for cam_dev and FV3 runs + +izumi/nag/aux_cam: Expecting namelist and baseline failures + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: DIFF) + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) + - expecting climate changing differences in SE,MPAS,FV3 + - verified FV,EUL differences are roundoff + + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac NLCOMP + FAIL ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic NLCOMP + FAIL ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic NLCOMP + FAIL ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf NLCOMP + FAIL ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf NLCOMP + FAIL ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s NLCOMP + FAIL PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 NLCOMP + FAIL SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s NLCOMP + FAIL SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem NLCOMP + FAIL SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s NLCOMP + - expected NLCOMP failures due to removal of se_lcp_moist, se_phys_dyn_cp namelist variables for SE runs + +izumi/gnu/aux_cam: Expecting namelist and baseline failures + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) + - expecting climate changing differences in SE,MPAS,FV3 + - verified FV,EUL differences are roundoff + + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase NLCOMP + FAIL ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s NLCOMP + FAIL PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 NLCOMP + FAIL SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac NLCOMP + - expected NLCOMP failures due to removal of se_lcp_moist, se_phys_dyn_cp namelist variables for SE runs + - expected NLCOMP failures from addition of GRAUPEL to water species for cam_dev and FV3 runs + - expected NLCOMP failures due to change in format of water_species_in_air for EUL runs + +Summarize any changes to answers: climate changing for SE,MPAS due to science updates + climate changing for FV3 due to addition of GRAUPEL + roundoff for FV and EUL + +=============================================================== +=============================================================== + +Tag name: cam6_3_108 +Originator(s): fvitt +Date: 27 Apr 2023 +One-line Summary: Ocean emissions bug fix; enable passing lightning flash rates to surface models +Github PR URLs: + + https://github.com/ESCOMP/CAM/pull/795 + https://github.com/ESCOMP/CAM/pull/747 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Fix issue with ocean emissions in B compsets where SSTs are zero over land. #794 + In configurations where SSTs are zeros over land (B compsets) divide by zero + errors have occurred. The where block used to mask the calculations of fluxes + was not preforming as intended to avoid the divide by zero errors. The where + block is replaced with a loop over columns and explicitly check columns for + ocean fraction. The flux calculations are preformed only in columns not over + land. + + Enable passing cloud-to-ground lightning flash rates to surface models. #567 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + + atm_provides_lightning indicator added to drv_flds_in: + If TRUE atmosphere model will provide prognosed lightning flash frequency. + +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 jedwards4b jtruesdal brian-eaton + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M Externals.cfg + - update CMEPS for lightning flash freqencies field + +M bld/build-namelist + - added namelist switch in drv_flds_in for lightning flashes + - set lght_no_prd_factor if chemistry includes NO + +M bld/namelist_files/namelist_definition.xml + - atm_provides lightning switch + +M src/chemistry/mozart/mo_chemini.F90 +M src/chemistry/mozart/chemistry.F90 + - moved reading lightning namelist options to more general location runtime_opts.F90 + +M src/chemistry/mozart/mo_lightning.F90 + - add namelist reader + - provide cloud-to-ground flash rates + - enable use in configurations without chemistry + - calculate NOx production rates only if needed by chemistry + +M src/chemistry/mozart/ocean_emis.F90 + - preform calculations on single columns + - replace where block with loop over columns -- calc fluxes only in columns over ocean + +M src/control/runtime_opts.F90 + - invoke lightning namelist reader + +M src/control/camsrfexch.F90 +M src/cpl/nuopc/atm_import_export.F90 + - add field for export of lightning flash rates + +M src/physics/cam/physpkg.F90 +M src/physics/cam_dev/physpkg.F90 + - call lightning register and init routines + +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. + +cheyenne/intel/aux_cam: all bit-for-bit + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + - NLCOMP failures are due to new lightning_coupling_nl namelist group in drv_flds_in + + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - differences are due to new atmImp_Sa_lightning coupler field -- otherwise all bit-for-bit + - NLCOMP failures are due to new lightning_coupling_nl namelist group in drv_flds_in + +izumi/nag/aux_cam: all bit-for-bit + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: NLFAIL) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: NLFAIL) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + - NLCOMP failures are due to new lightning_coupling_nl namelist group in drv_flds_in + +izumi/gnu/aux_cam: all bit-for-bit + + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - differences are due to new atmImp_Sa_lightning coupler field -- otherwise all bit-for-bit + - NLCOMP failures are due to new lightning_coupling_nl namelist group in drv_flds_in + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + - NLCOMP failures are due to new lightning_coupling_nl namelist group in drv_flds_in + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_107 +Originator(s): eaton +Date: Tue Apr 18 10:27:45 AM EDT 2023 +One-line Summary: Reimplement zonal_mean_mod::Invert_Matrix using LAPACK DGESV +Github PR URL: https://github.com/ESCOMP/CAM/pull/788 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +The Invert_Matrix subroutine in module zonal_mean_mod has been +reimplemented using the LAPACK subroutine DGESV. + +Resolves: +. Replace "Invert_Matrix" subroutine in "zonal_mean_mod.F90" with LAPACK version #736 + (https://github.com/ESCOMP/CAM/issues/736) +. Bug in zonal mean "Invert_Matrix" subroutine #745 + (https://github.com/ESCOMP/CAM/issues/745) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not tested + +Code reviewed by: fvitt, cacraigucar, peverwhee, patcal + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +src/utils/zonal_mean_mod.F90 +. modify subroutine Invert_Matrix to use LAPACK DGESV routine. + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + - pre-existing failure + + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + - the zonal mean (*zm) fields in the h1 file have 2-3 significant digits of agreement + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + - the zonal mean (*zm) fields in the h2 file have 2-3 significant digits of agreement + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + - diffs in all fields in h0 and h1 files. This is expected because the + the nudging uses the zonal_mean_mod code if Nudge_ZonalFilter is true, + which it is in this test. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: + +. The only changes to answers are for runs using nudging with + Nudge_ZonalFilter set to true. + +. The zonal mean diagnostic output only agrees with previous output to a + couple of significant figures. That's because previous output was + produced with a bug in the Invert_Matrix subroutine (issue #745). + Independent testing showed that fixing that bug and comparing with the + new version of Invert_Matrix yields roundoff level differences (15-16 + significant digits of agreement). + +=============================================================== +=============================================================== + +Tag name: cam6_3_106 +Originator(s): cacraig, fvitt, eaton +Date: Thu Apr 6 07:10:24 PM EDT 2023 +One-line Summary: Initialize CO2 when it's missing from initial file. +Github PR URL: https://github.com/ESCOMP/CAM/pull/780 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Fixes: When CO2 is not in IC file, needs to initialize to a non-zero value #779 + https://github.com/ESCOMP/CAM/issues/779 + +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: brian-eaton, fvitt, nusbaume + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +src/chemistry/mozart/chemisty.F90 +. For ghg_chem, add CO2 to the case statement to use chem_surfvals_get + for 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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + - pre-existing failure + + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + - expected diff due to change in CO2 initialization + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - expected diff due to change in CO2 initialization + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except for any run using ghg_mam4 + chemistry and using an initial file that doesn't contain CO2. In that + case the CO2 is now being initialized by chem_surf_vals. Previously it was + zero above the surface layer which is set by the LBC code. + +=============================================================== +=============================================================== + +Tag name: cam6_3_105 +Originator(s): bstephens, eaton +Date: Thu Apr 6 09:51:59 AM EDT 2023 +One-line Summary: fix for COSP with cam_dev physics +Github PR URL: https://github.com/ESCOMP/CAM/pull/777 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Fixes: Add PBUF fields to make cosp compatible with cam_dev #776 + https://github.com/ESCOMP/CAM/issues/776 + Note: the original fix was reimplemented to just check whether or + not fields used by the cosp simulator are present in the pbuf, and + if not then to use local arrays of zeros. + +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: brian-eaton, cacraigucar, adamrher + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +src/physics/cam/cospsimulator_intr.F90 +. remove pbuf_get_index calls for SH_CLDLIQ, SH_CLDICE. The indices were + not being used. +. add optional arg to pbuf_get_index calls for SH_FLXPRC, SH_FLXSNW to + avoid endrun calls if fields not present in the pbuf. In that case + negative value indices are returned and appropriate action can be taken. + In this case the fields are assigned values of zero. + +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. + +cheyenne/intel/aux_cam: +ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: +. expected failure + +izumi/nag/aux_cam: +DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: +. expected failure + +izumi/gnu/aux_cam: All PASS. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_104 +Originator(s): fvitt +Date: 5 Apr 2023 +One-line Summary: Misc bug fixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/785 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Fix issues: + - ghg_mam4 is not working with cam_dev regression tests #773 + - undefined rho values in nucleate_ice_cam_calc #781 + +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: brian-eaton cacraigucar nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M bld/namelist_files/use_cases/2000_cam6.xml + - use appropriate prescribed tracer inputs for trop_mam4 and ghg_mam4 chemistry + -- ghg_mam4 needs HALONS + +M cime_config/testdefs/testlist_cam.xml + - add regression test for GHG chem with cam_dev phys and year 2000 use case + +M src/chemistry/mozart/tracer_cnst.F90 + - add error checking + +M src/physics/cam/nucleate_ice_cam.F90 + - define rho for all model layers + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + - pre-existing failure + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - new test + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_103 +Originator(s): cacraig +Date: Apr 5, 2023 +One-line Summary: Update externals to almost match cesm2_3_alpha12d +Github PR URL: https://github.com/ESCOMP/CAM/pull/783 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - CLM tag is one newer than was used in alpha12d as it contains some of the coarse grid modifications + - FMS is an older version (inherited from cam6_3_102) + - cpl7 is one tag newer (inherited from cam6_3_102) + - Multi-instance is broken with current CMEPS external: https://github.com/ESCOMP/CAM/issues/733 + +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, eaton + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Externals updated as described above + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: + + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: NLFAIL) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + - namelist differences due to 'import_data_fields' added to docn_in and nuopc.runseq run seqeunce modified + + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + - concluded this answer change was most likely due to the change in value of the run sequence in nuopc.runseq having + phases_aofluxes_run being run before the ocn elements + + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) +details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - CTSM has answer changes which expect to change F compsets + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERP_Vnuopc_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + - baseline failure due to new test accidentally introduced in CMEPS + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: NLFAIL) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: NLFAIL) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + - namelist differences due to 'import_data_fields' added to docn_in and nuopc.runseq run seqeunce modified + +=============================================================== +=============================================================== + +Tag name: cam6_3_102 +Originator(s): fvitt +Date: 4 Apr 2023 +One-line Summary: Updates to TEM diagnostics +Github PR URL: https://github.com/ESCOMP/CAM/pull/770 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + - fix issue with TEM diagnostics not implemented in cam_dev physics #769 + - adopt the zm naming convention for the zonal mean outputs + - add 'Uzm','Vzm','Wzm','THzm' output fields + +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: brian-eaton cacraigucar nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_ghg_cam_dev/user_nl_cam + - include namelist options to test TEM output + +M cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/outfrq3s_physgrid_tem/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_physgrid_tem_1deg/user_nl_cam + - use zm history field names for the TEM output + +M src/physics/cam/phys_grid_ctem.F90 + - adopts the zm naming convention for the zonal mean outputs + - add 'Uzm','Vzm','Wzm','THzm' output fields + +M src/physics/cam_dev/physpkg.F90 + - add calls to the phys_grid_ctem interface + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + - pre-existing failure + + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + FAIL ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev NLCOMP + FAIL ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_101: ERROR BFAIL some baseline files were missing + - expected failure -- TEM output added to this test + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + FAIL SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem NLCOMP + FAIL SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_101_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + - change in TEM output field names + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_101 +Originator(s): cacraig, eaton, hannay, Thomas Toniazzo, Vince Larson +Date: March 31, 2023 +One-line Summary: Create FLTHIST_v0a compset +Github PR URL: Create initial FLTHIST and FMTHIST compsets for CAM7: https://github.com/ESCOMP/CAM/pull/767 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Create testing compsets based on FLT,FMT,FW and FX: https://github.com/ESCOMP/CAM/issues/765 + - Partially implements these compsets: FLTHIST_v0a has been worked on with Cecile + FMTHIST_v0a has been started, but is not complete + Other compsets have not been worked on + - Update CLUBB external (fix bug found by Thomas Toniazzo): https://github.com/ESCOMP/CAM/issues/768 + +Describe any changes made to build system: + - Introduce %LT (low_top) %MT (mid_top) and %GHGMAM4 (turn on ghg_mam4 chemistry) + - Remove %L58 and %L93 settings and replace with %LT and %MT + +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: eaton, nusbaume, fvitt + +List all files eliminated: N/A + +List all files added and what they do: +A bld/namelist_files/use_cases/hist_cam_lt.xml + - use_case for FLTHIST_v0a - developed in consultation with Cecile + +A bld/namelist_files/use_cases/hist_cam_mt.xml + - template use_case for FMTHIST_v0a - not completed + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - Bring in CLUBB bug fix tag which fixes small bug in mono_flux_limiter.F90 + +M bld/namelist_files/namelist_defaults_cam.xml + - Add initial condition files for ne30np4, npg=3 for 58 and 93 levels + - Add topo file for ne30np4, npg=3 + +M cime_config/config_component.xml + - Remove %L58 and %L93 + - Introduce %LT, %MT and %GHGMAM4 options + +M cime_config/config_compsets.xml + - Introduce FLTHIST_v0a compset (note that a regression test was not introduced for it yet) + - Create FMTHIST_v0a compset (not completed) + - replace %L58 and %L93 with %LT and %MT + +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. + +cheyenne/intel/aux_cam: all BFB except: + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 NLCOMP + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d NLCOMP + - topo file change + + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s BASELINE + FAIL SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d BASELINE + - expected baseline changes due to new topo file + + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 RUN time=119 + - New failing test - issue https://github.com/ESCOMP/CAM/issues/772 opened + +izumi/nag/aux_cam: all BFB except: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=180 + - pre-existing failure + +izumi/gnu/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_100 +Originator(s): fvitt +Date: 20 Mar 2023 +One-line Summary: Introduce prognostic GHG chemistry mechanism for CAM7 +Github PR URL: https://github.com/ESCOMP/CAM/pull/766 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + New chemistry mechanism for CAM7 prognostic GHGs #762 + +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: brian-eaton jtruesdal cacraigucar nusbaume + +List all files eliminated: N/A + +List all files added and what they do: +A src/chemistry/pp_ghg_mam4/chem_mech.doc +A src/chemistry/pp_ghg_mam4/chem_mech.in +A src/chemistry/pp_ghg_mam4/chem_mods.F90 +A src/chemistry/pp_ghg_mam4/m_rxt_id.F90 +A src/chemistry/pp_ghg_mam4/m_spc_id.F90 +A src/chemistry/pp_ghg_mam4/mo_adjrxt.F90 +A src/chemistry/pp_ghg_mam4/mo_exp_sol.F90 +A src/chemistry/pp_ghg_mam4/mo_imp_sol.F90 +A src/chemistry/pp_ghg_mam4/mo_indprd.F90 +A src/chemistry/pp_ghg_mam4/mo_lin_matrix.F90 +A src/chemistry/pp_ghg_mam4/mo_lu_factor.F90 +A src/chemistry/pp_ghg_mam4/mo_lu_solve.F90 +A src/chemistry/pp_ghg_mam4/mo_nln_matrix.F90 +A src/chemistry/pp_ghg_mam4/mo_phtadj.F90 +A src/chemistry/pp_ghg_mam4/mo_prod_loss.F90 +A src/chemistry/pp_ghg_mam4/mo_rxt_rates_conv.F90 +A src/chemistry/pp_ghg_mam4/mo_setrxt.F90 +A src/chemistry/pp_ghg_mam4/mo_sim_dat.F90 + - add ghg_mam4 chemistry mechanism + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/namelist_definition.xml +M bld/config_files/definition.xml +M bld/configure + - add ghg_mam4 chem option + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml + - default namelist settings for ghg_mam4 chemistry + +M cime_config/testdefs/testlist_cam.xml + - add test for ghg_mam4 + - replace outfrq1d_14dec_L32wsc with outfrq1d_14dec_ghg_cam_dev + -- replaces "-chem waccm_sc_mam4" with "-chem ghg_mam4" + -- this is more relevant for CAM7 development + +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. + +cheyenne/intel/aux_cam: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + - new test which replaces outfrq1d_14dec_L32wsc + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_099 +Originator(s): adamrher, eaton +Date: Thu Mar 16 11:22:00 AM EDT 2023 +One-line Summary: fix drydep emissions for cam_dev physics +Github PR URL: https://github.com/ESCOMP/CAM/pull/763 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Fixes #759 (https://github.com/ESCOMP/CAM/issues/759) + drydep of gas phase species "skipped" in cam_dev + +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: jtruesdal, cacraigucar, fvitt, nusbaume + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +src/chemistry/mozart/chemistry.F90 +. add state%rpdel, state%rpdeldry to actual args in call to + gas_phase_chemdr + +src/chemistry/mozart/mo_gas_phase_chemdr.F90 +. add rpdel, rpdeldry to dummy args for gas_phase_chemdr +. access cam_physpkg_is from phys_control module +. access gravit from physconst +. access cnst_type from constituents +. if cam_dev physics then apply drydep fluxes directly to the species + tendency array, else apply to the emissions array. + + +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. + +cheyenne/intel/aux_cam: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + + - There are baseline diffs in all tests that use cam_dev physics. + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + + - pre-existing failure + +izumi/gnu/aux_cam: + + - All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except for cam_dev physics due to + fix in treatment of drydep fluxes. + +=============================================================== +=============================================================== + +Tag name: cam6_3_098 +Originator(s): mvertens, eaton +Date: Tue Mar 14 09:16:31 MDT 2023 +One-line Summary: always pass NDEP from CAM and remove sst specs +Github PR URL: https://github.com/ESCOMP/CAM/pull/764 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Resolve issue #104 - https://github.com/ESCOMP/CAM/issues/104 + Always send Nitrogen-deposition to surface components. + + This PR enables CAM to read in ndep (using the CDEPS inline API) from + forcing files if it is not computing NDEP prognostically. As a result + CAM will ALWAYS send NDEP to the mediator. + + Right how, CLM is not using the passed NDEP from the streams - since it + is still reading the drv_flds_in for NDEP. + + It is now possible for the drv_flds_in entry for ndep to be removed + and CLM can always accept NDEP from either CAM or DATM. + + New XML variables are introduced to specify the stream forcing. This is + being done in CTSM as well for all of its CDEPS stream specific variables. + + NOTE: that CTSM also needs a new PR in order to accept these new fields + from CAM rather than use its own internal streams. + +. Remove old sst specs from the namelist. This is a cleanup. + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +. The follow variables are in new group ndep_stream_nl which is read in + src/cpl/nuopc/atm_stream_ndep.F90 + stream_ndep_year_first + stream_ndep_year_last + stream_ndep_year_align + stream_ndep_data_filename + stream_ndep_mesh_filename + +List any changes to the defaults for the boundary datasets: +. NDEP datasets are added by cime_config/config_component.xml + +Describe any substantial timing or memory changes: not tested + +Code reviewed by: gold2718, fvitt, cacraigucar, nusbaume, brian-eaton + +List all files eliminated: none + +List all files added and what they do: + +src/cpl/nuopc/atm_stream_ndep.F90 +. Contains methods for reading in nitrogen deposition data file. Also + includes functions for dynamic ndep file handling and interpolation. +. Reads namelist group ndep_stream_nl from the atm_in file. + +List all existing files that have been modified, and describe the changes: +bld/configure +. remove documentation for -ocn option. + +bld/namelist_files/namelist_defaults_cam.xml +. remove old settings for bndtvs, bndtvs_domain, and focndomain. DOM and + DOCN are no longer used. + +bld/namelist_files/namelist_definition.xml +. 5 new variables, stream_ndep_*, are added to group ndep_stream_nl +. bndtvs, focndomain, and bndtvs_domain removed +. 5 new variables, *_ndep, added to group ndep_stream_nml + +bld/namelist_files/use_cases/1850-2005_cam5.xml +bld/namelist_files/use_cases/sd_waccm_sulfur.xml +bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +. remove defaults for stream_year_*, bndtvs, sstcyc + +bld/namelist_files/use_cases/aquaplanet_cam3.xml +bld/namelist_files/use_cases/aquaplanet_cam4.xml +bld/namelist_files/use_cases/aquaplanet_cam5.xml +bld/namelist_files/use_cases/aquaplanet_cam6.xml +bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml +. remove default for aqua_planet (no longer in the namelist definition file) + +cime_config/buildnml +. get values of stream_ndep_* from the corresponding case variables + (CAM_STREAM_NDEP_*). Add the namelist key=value pairs to the string that + is generated to be passed via the -namelist option. + +cime_config/config_component.xml +. add values for the case variables CAM_STREAM_NDEP_* + +src/control/camsrfexch.F90 +. remove conditionals from allocation of cam_out%nhx_nitrogen_flx and + cam_out%noy_nitrogen_flx. CAM always provides this data now. + +src/cpl/nuopc/atm_comp_nuopc.F90 +. add explicit use/only statements for ESMF module +. add ESMF Mesh and clock objects with module scope, and add to the calling + args for export_fields. They are needed to generate streams. + +src/cpl/nuopc/atm_import_export.F90 +. mods so that nhx/noy are always in the list of fields that are exported. + If ndep_nflds=0 then the set_active_Faxa_* flags are set false. +. model_mesh, model_clock added to export_fields arg list +. add code to export_fields to use the stream code to set nhx/noy + deposition if it hasn't been computed. + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase NLCOMP + FAIL ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vmct.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vmct.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + ERC_D_Ln9_Vmct.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vmct.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator NLCOMP + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: DIFF) details: + FAIL ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase NLCOMP + FAIL ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + FAIL ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d NLCOMP + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h NLCOMP + FAIL ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + FAIL ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes NLCOMP + FAIL ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: NLFAIL) details: + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 NLCOMP + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (Overall: DIFF) details: + FAIL ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc NLCOMP + FAIL ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 NLCOMP + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 NLCOMP + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + FAIL ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined NLCOMP + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep NLCOMP + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + FAIL SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase NLCOMP + FAIL SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) details: + FAIL SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d NLCOMP + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s NLCOMP + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday NLCOMP + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s NLCOMP + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s NLCOMP + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s NLCOMP + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + FAIL SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d NLCOMP + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + FAIL SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d NLCOMP + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + FAIL SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 NLCOMP + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m NLCOMP + FAIL SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging NLCOMP + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s NLCOMP + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + FAIL SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs NLCOMP + FAIL SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + FAIL SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem NLCOMP + FAIL SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + +The NLCOMP failures are due to adding the ndep_stream_nl group to atm_in. +The BASELINE test failures are due to different field list in the cpl.hi files. + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae NLCOMP + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=223 + PEND DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase NLCOMP + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + FAIL ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac NLCOMP + FAIL ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + FAIL ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 NLCOMP + FAIL ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + FAIL ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic NLCOMP + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + FAIL ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic NLCOMP + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: + FAIL ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf NLCOMP + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf NLCOMP + FAIL ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s NLCOMP + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s NLCOMP + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + FAIL PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s NLCOMP + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + FAIL SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port NLCOMP + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s NLCOMP + FAIL SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + FAIL SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem NLCOMP + FAIL SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + FAIL SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm NLCOMP + FAIL SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s NLCOMP + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase NLCOMP + FAIL SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s NLCOMP + FAIL SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + FAIL TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac NLCOMP + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + FAIL TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 NLCOMP + +The DAE failure is pre-existing. +The NLCOMP failures are due to adding the ndep_stream_nl group to atm_in. +The BASELINE test failures are due to different field list in the cpl.hi files. + +izumi/gnu/aux_cam: + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator NLCOMP + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s NLCOMP + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s NLCOMP + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + FAIL ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp NLCOMP + FAIL ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s NLCOMP + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + FAIL PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s NLCOMP + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep NLCOMP + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 NLCOMP + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + FAIL SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc NLCOMP + FAIL SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s NLCOMP + FAIL SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + +The NLCOMP failures are due to adding the ndep_stream_nl group to atm_in. +The BASELINE test failures are due to different field list in the cpl.hi files. + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: none. + +=============================================================== +=============================================================== + +Tag name: cam6_3_097 +Originator(s): andrewgettelman, tilmes, fvitt +Date: 13 Mar 2023 +One-line Summary: Heterogeneous freezing science updates and bug fixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/755 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + The following science updates and bug fixes to heterogeneous freezing parameterization + - new namelist parameters for scaling of dust and black carbon contributions + to heterogeneous freezing rates + - use physical approach to calculate species fractions + - use consistent concentrations of cloud-borne and ambient aerosol + - include sulfate in coarse dust fraction calculation + Update PUMAS external + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + + New namelist parameters: + + hetfrz_bc_scalfac + Heterogeneous freezing scaling factor for black carbon aerosols. + Default: 0.01 + + hetfrz_dust_scalfac + Heterogeneous freezing scaling factor for dust aerosols. + Default: 0.05 + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: andrewgettelman, cacraigucar, jtruesdal, adamrher, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - pumas update + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - new hetfrz scaling factors namelist parameters + +M src/physics/cam/hetfrz_classnuc_cam.F90 + - add scaling factor for dust + +M src/physics/cam/hetfrz_classnuc.F90 + - new hetfrz scaling factors namelist parameters for dust and BC + - remove separate interface for collection of cloud-borne aerosols + so that cloud-borne and ambient aerosol concentrations are consistent + - set num_to_mass_in to false (use physical approach to calc species fractions) + and calc primary carbon fraction consistently + - include SO4 in dst3 fraction calculation + +M src/physics/cam/microp_aero.F90 + - remove separate interface for collection of cloud-borne aerosols + so that cloud-borne and ambient aerosol concentrations are consistent + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + - expect different answers in cam6 configurations + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + - expect different answers in cam6 configurations + +izumi/gnu/aux_cam: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + - expect different answers in cam6 configurations + +Summarize any changes to answers: larger than roundoff + +=============================================================== +=============================================================== + +Tag name: cam6_3_096 +Originator(s): tilmes, fvitt +Date: 8 Mar 2023 +One-line Summary: Aqueous chemistry bug fix +Github PR URL: https://github.com/ESCOMP/CAM/pull/760 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Exclude cloud ice from the water constituent input into the aqueous chemistry so that + only cloud liquid is used. + (See issue: Aq.chemistry update #758) + +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, cacraig, tilmes + +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/mozart/chemistry.F90 + - cloud water input is only the cloud liquid constituent + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + - configurations with aqueous chemistry are expected to change answers + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + - configurations with aqueous chemistry are expected to change answers + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - configurations with aqueous chemistry are expected to change answers + +Summarize any changes to answers: larger than roundoff + +=============================================================== +=============================================================== + +Tag name: cam6_3_095 +Originator(s): fvitt +Date: 15 Feb 2023 +One-line Summary: Chemistry updates +Github PR URL: https://github.com/ESCOMP/CAM/pull/737 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Chemistry updates #558 + Use MAM5 as the default aerosols in CAMChem and WACCM + +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, cacraig, lkemmons + +List all files eliminated: + +D cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/shell_commands +D cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/user_nl_cam +D cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/user_nl_cpl +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_f05/shell_commands +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_f05/user_nl_cam +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_f05/user_nl_cpl +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/shell_commands +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/user_nl_cam +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/user_nl_cpl + - remove obsolete test files + +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_wetdep/user_nl_cpl + - reprosum setting were problematic + +D src/chemistry/pp_trop_mam5 + - removed obsolete mechanism + +List all files added and what they do: + +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_camchem_mam4/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_camchem_mam4/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_camchem_mam4/user_nl_clm +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_ma_mam4/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_ma_mam4/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_ma_mam4/user_nl_clm +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_mam4/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_mam4/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_waccm_mam4/user_nl_clm + - for testing mam4 with chemistry + +A src/chemistry/pp_trop_strat_mam5_ts2 +A src/chemistry/pp_trop_strat_mam5_vbsext +A src/chemistry/pp_waccm_ma_mam5 +A src/chemistry/pp_waccm_mad_mam5 +A src/chemistry/pp_waccm_tsmlt_mam4_vbsext +A src/chemistry/pp_waccm_tsmlt_mam5_vbsext + - new chemistry mechanisms with MAM5 aerosols + +List all existing files that have been modified, and describe the changes: + +M bld/build-namelist +M bld/config_files/definition.xml +M bld/configure + - changes for MAM5 chemistry mechanisms + +M bld/namelist_files/namelist_defaults_cam.xml + - updates to default inputs to photolysis + - changes for MAM5 chemistry mechanisms + +M bld/namelist_files/namelist_definition.xml + - changes to valid values of cam_chempkg for MAM5 chemistry mechanisms + +M bld/namelist_files/use_cases/hist_trop_strat_nudged_cam6.xml + - corrections to nudging parameters + +M bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml +M bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml + - changes for MAM5 chemistry mechanisms + +M cime_config/config_component.xml +M cime_config/config_compsets.xml + - default to MAM5 aerosols if the chemistry supports it + - remove CAM-MAM5 compsets + +M cime_config/testdefs/testlist_cam.xml + - remove f05 tests + - remove tests specific for MAM5 + - add CAMChem-MAM4 and WACCM-MAM4 tests + +M src/chemistry/mozart/mo_sad.F90 + - update NAT parameter + +M src/chemistry/mozart/mo_usrrxt.F90 + - updates to user reaction rates + +M src/chemistry/pp_trop_mozart/mo_adjrxt.F90 + - white space changes + +M src/chemistry/pp_trop_strat_mam4_ts2/chem_mech.doc +M src/chemistry/pp_trop_strat_mam4_ts2/chem_mech.in +M src/chemistry/pp_trop_strat_mam4_ts2/chem_mods.F90 +M src/chemistry/pp_trop_strat_mam4_ts2/m_rxt_id.F90 +M src/chemistry/pp_trop_strat_mam4_ts2/mo_adjrxt.F90 +M src/chemistry/pp_trop_strat_mam4_ts2/mo_indprd.F90 +M src/chemistry/pp_trop_strat_mam4_ts2/mo_lin_matrix.F90 +M src/chemistry/pp_trop_strat_mam4_ts2/mo_lu_factor.F90 +M src/chemistry/pp_trop_strat_mam4_ts2/mo_lu_solve.F90 +M src/chemistry/pp_trop_strat_mam4_ts2/mo_nln_matrix.F90 +M src/chemistry/pp_trop_strat_mam4_ts2/mo_prod_loss.F90 +M src/chemistry/pp_trop_strat_mam4_ts2/mo_rxt_rates_conv.F90 +M src/chemistry/pp_trop_strat_mam4_ts2/mo_setrxt.F90 +M src/chemistry/pp_trop_strat_mam4_ts2/mo_sim_dat.F90 +M src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc +M src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in +M src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 +M src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 +M src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 +M src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 +M src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 +M src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 +M src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 +M src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 +M src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 +M src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 +M src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 +M src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 +M src/chemistry/pp_trop_strat_mam4_vbsext/chem_mech.doc +M src/chemistry/pp_trop_strat_mam4_vbsext/chem_mech.in +M src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 +M src/chemistry/pp_trop_strat_mam4_vbsext/m_rxt_id.F90 +M src/chemistry/pp_trop_strat_mam4_vbsext/m_spc_id.F90 +M src/chemistry/pp_trop_strat_mam4_vbsext/mo_adjrxt.F90 +M src/chemistry/pp_trop_strat_mam4_vbsext/mo_indprd.F90 +M src/chemistry/pp_trop_strat_mam4_vbsext/mo_lin_matrix.F90 +M src/chemistry/pp_trop_strat_mam4_vbsext/mo_lu_factor.F90 +M src/chemistry/pp_trop_strat_mam4_vbsext/mo_lu_solve.F90 +M src/chemistry/pp_trop_strat_mam4_vbsext/mo_nln_matrix.F90 +M src/chemistry/pp_trop_strat_mam4_vbsext/mo_prod_loss.F90 +M src/chemistry/pp_trop_strat_mam4_vbsext/mo_rxt_rates_conv.F90 +M src/chemistry/pp_trop_strat_mam4_vbsext/mo_setrxt.F90 +M src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 +M src/chemistry/pp_trop_strat_mam5_vbs/chem_mech.doc +M src/chemistry/pp_trop_strat_mam5_vbs/chem_mech.in +M src/chemistry/pp_trop_strat_mam5_vbs/chem_mods.F90 +M src/chemistry/pp_trop_strat_mam5_vbs/m_rxt_id.F90 +M src/chemistry/pp_trop_strat_mam5_vbs/mo_adjrxt.F90 +M src/chemistry/pp_trop_strat_mam5_vbs/mo_indprd.F90 +M src/chemistry/pp_trop_strat_mam5_vbs/mo_lin_matrix.F90 +M src/chemistry/pp_trop_strat_mam5_vbs/mo_lu_factor.F90 +M src/chemistry/pp_trop_strat_mam5_vbs/mo_lu_solve.F90 +M src/chemistry/pp_trop_strat_mam5_vbs/mo_nln_matrix.F90 +M src/chemistry/pp_trop_strat_mam5_vbs/mo_prod_loss.F90 +M src/chemistry/pp_trop_strat_mam5_vbs/mo_rxt_rates_conv.F90 +M src/chemistry/pp_trop_strat_mam5_vbs/mo_setrxt.F90 +M src/chemistry/pp_trop_strat_mam5_vbs/mo_sim_dat.F90 +M src/chemistry/pp_waccm_ma_mam4/chem_mech.doc +M src/chemistry/pp_waccm_ma_mam4/chem_mech.in +M src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 +M src/chemistry/pp_waccm_ma_mam4/m_rxt_id.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_adjrxt.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_indprd.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_lin_matrix.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_lu_factor.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_lu_solve.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_nln_matrix.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_prod_loss.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_rxt_rates_conv.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_setrxt.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 +M src/chemistry/pp_waccm_ma_sulfur/mo_adjrxt.F90 +M src/chemistry/pp_waccm_mad_mam4/chem_mech.doc +M src/chemistry/pp_waccm_mad_mam4/chem_mech.in +M src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 +M src/chemistry/pp_waccm_mad_mam4/m_rxt_id.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_adjrxt.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_exp_sol.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_imp_sol.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_lin_matrix.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_lu_factor.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_lu_solve.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_nln_matrix.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_prod_loss.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_rxt_rates_conv.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_setrxt.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 +M src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc +M src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in +M src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 +M src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 +M src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 +M src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 +M src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 +M src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 +M src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 +M src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 +M src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 +M src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 +M src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 +M src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 +M src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 +M src/chemistry/pp_waccm_tsmlt_mam5/chem_mech.doc +M src/chemistry/pp_waccm_tsmlt_mam5/chem_mech.in +M src/chemistry/pp_waccm_tsmlt_mam5/chem_mods.F90 +M src/chemistry/pp_waccm_tsmlt_mam5/m_rxt_id.F90 +M src/chemistry/pp_waccm_tsmlt_mam5/m_spc_id.F90 +M src/chemistry/pp_waccm_tsmlt_mam5/mo_adjrxt.F90 +M src/chemistry/pp_waccm_tsmlt_mam5/mo_indprd.F90 +M src/chemistry/pp_waccm_tsmlt_mam5/mo_lin_matrix.F90 +M src/chemistry/pp_waccm_tsmlt_mam5/mo_lu_factor.F90 +M src/chemistry/pp_waccm_tsmlt_mam5/mo_lu_solve.F90 +M src/chemistry/pp_waccm_tsmlt_mam5/mo_nln_matrix.F90 +M src/chemistry/pp_waccm_tsmlt_mam5/mo_prod_loss.F90 +M src/chemistry/pp_waccm_tsmlt_mam5/mo_rxt_rates_conv.F90 +M src/chemistry/pp_waccm_tsmlt_mam5/mo_setrxt.F90 +M src/chemistry/pp_waccm_tsmlt_mam5/mo_sim_dat.F90 + - JPL19 updates + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + - expected failures + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + - expected failures + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - expected differences + +Summarize any changes to answers: larger than roundoff + +=============================================================== +=============================================================== + +Tag name: cam6_3_094 +Originator(s): aherring, cacraig +Date: Feb 9, 202 +One-line Summary: modify CLUBB to operate on dry density / mixing ratios +Github PR URL: https://github.com/ESCOMP/CAM/pull/750 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - CLUBB energy fixer broken in cam6_3_066: https://github.com/ESCOMP/CAM/issues/739 + - Resolved through converting all mixing ratio's in CLUBB to dry basis. +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: jet, fvitt, nusbaume, 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/physics/cam/clubb_intr.F90 + - Convert mixing ratios to dry upon entering clubb_tend_cam. Vertical integrals with dry ratios + - now use dpdry instead of dp; similary for (dry) rho. Convert dentrainment tendencies (dlf) to dry. + - All tendencies are then switched back to moist before applying them to 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. + +cheyenne/intel/aux_cam: all BFB except: + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.FC2000mam5.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - Baseline differences for all jobs which use CLUBB + + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=19 + - pre-exising failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + - Baseline differences for all jobs which use CLUBB + +izumi/gnu/aux_cam: all BFB (no CAM6 jobs which use CLUBB) + + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + -larger than roundoff but same climate +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + -plot evaluating changes to CLUBB's energy corrector due to this PR are posted under the git issue. + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam6_3_093 +Originator(s): fvitt, Duseong Jo (cdswk@ucar.edu) +Date: 7 Feb 2023 +One-line Summary: Update SOA scheme in simplified chemistry configurations +Github PR URL: https://github.com/ESCOMP/CAM/pull/727 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Simple CAM chemistry and DMS emission updates #571 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + + Default to OASISS (ocean) DMS interactive emissions. + + For simeple chemistry schemes, emissions SOA yields have been calculated + based on the VBS yields in CAM-chemm, as discussed in PR #727. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: tilmes, cacraigucar, nusbaume, jtruesdal + +List all files eliminated: +D src/chemistry/mozart/sums_utils.F90 + - replaces by shr_parser_mod + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M Externals.cfg + - update to cmeps0.14.12 and cpl7.0.15 + -- updates to megan_specifier parser + +M bld/build-namelist + - updates to default emissions to include OASISS DMS and MEGAN emissions + +M bld/namelist_files/master_gas_drydep_list.xml +M bld/namelist_files/master_gas_wetdep_list.xml + - include SOAG to default deposition lists + +M bld/namelist_files/namelist_defaults_cam.xml + - default OASISS input files + - update to default effective Henrys coeffs + +M bld/namelist_files/namelist_definition.xml + - limit length of each megan_specifier segment to 512 characters + +M bld/namelist_files/use_cases/1850_cam6.xml + - default settings for OASISS DMS emissions + +M bld/namelist_files/use_cases/2000_cam6.xml + - default settings for OASISS DMS emissions + - default SOAE emissions + +M bld/namelist_files/use_cases/2000_trop_strat_vbs_cam6.xml + - remove DSM other emissions file (OASISS DMS emissions are active) + +M bld/namelist_files/use_cases/2010_cam6.xml + - default settings for OASISS DMS emissions + - remove DSM other emissions file (OASISS DMS emissions are active) + - default SOAE emissions + +M bld/namelist_files/use_cases/2010_trop_strat_vbs_cam6.xml + - remove DSM other emissions file (OASISS DMS emissions are active) + +M bld/namelist_files/use_cases/hist_cam6.xml + - default settings for OASISS DMS emissions + +M bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml + - remove DSM other emissions file (OASISS DMS emissions are active) + +M bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml + - remove DSM other emissions file (OASISS DMS emissions are active) + +M bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml + - default settings for OASISS DMS emissions + +M bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml + - remove DSM other emissions file (OASISS DMS emissions are active) + - default SOAE emissions + +M bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml + - default settings for OASISS DMS emissions + +M bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml + - remove DSM other emissions file (OASISS DMS emissions are active) + +M cime_config/testdefs/testlist_cam.xml + - correct F2000dev test to use outfrq1d namelist mods + +M src/chemistry/modal_aero/modal_aero_gasaerexch.F90 + - update SOA parameters + +M src/chemistry/mozart/chemistry.F90 + - call rate_diags_final and species_sums_final + +M src/chemistry/mozart/rate_diags.F90 +M src/chemistry/mozart/species_sums_diags.F90 + - use shr_expr_parser_mod module + +M src/chemistry/pp_trop_mam4/chem_mech.doc +M src/chemistry/pp_trop_mam4/chem_mech.in +M src/chemistry/pp_trop_mam4/chem_mods.F90 +M src/chemistry/pp_trop_mam4/m_rxt_id.F90 +M src/chemistry/pp_trop_mam4/m_spc_id.F90 +M src/chemistry/pp_trop_mam4/mo_adjrxt.F90 +M src/chemistry/pp_trop_mam4/mo_indprd.F90 +M src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 +M src/chemistry/pp_trop_mam4/mo_lu_factor.F90 +M src/chemistry/pp_trop_mam4/mo_lu_solve.F90 +M src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 +M src/chemistry/pp_trop_mam4/mo_prod_loss.F90 +M src/chemistry/pp_trop_mam4/mo_rxt_rates_conv.F90 +M src/chemistry/pp_trop_mam4/mo_setrxt.F90 +M src/chemistry/pp_trop_mam4/mo_sim_dat.F90 + - update SOA scheme + +M src/chemistry/pp_waccm_sc_mam4/chem_mech.doc +M src/chemistry/pp_waccm_sc_mam4/chem_mech.in +M src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 +M src/chemistry/pp_waccm_sc_mam4/m_rxt_id.F90 +M src/chemistry/pp_waccm_sc_mam4/m_spc_id.F90 +M src/chemistry/pp_waccm_sc_mam4/mo_adjrxt.F90 +M src/chemistry/pp_waccm_sc_mam4/mo_indprd.F90 +M src/chemistry/pp_waccm_sc_mam4/mo_lin_matrix.F90 +M src/chemistry/pp_waccm_sc_mam4/mo_lu_factor.F90 +M src/chemistry/pp_waccm_sc_mam4/mo_lu_solve.F90 +M src/chemistry/pp_waccm_sc_mam4/mo_nln_matrix.F90 +M src/chemistry/pp_waccm_sc_mam4/mo_prod_loss.F90 +M src/chemistry/pp_waccm_sc_mam4/mo_rxt_rates_conv.F90 +M src/chemistry/pp_waccm_sc_mam4/mo_setrxt.F90 +M src/chemistry/pp_waccm_sc_mam4/mo_sim_dat.F90 + - update SOA scheme + +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. + +cheyenne/intel/aux_cam: + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vmct.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: NLFAIL) details: + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: NLFAIL) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.FC2000mam5.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: NLFAIL) details: + - expected changes due to + . changes in SOA chemistry scheme + . default dep_data_file and DMS emissions updates + . inclusion of SOAG in drydep_list + +izumi/nag/aux_cam: + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: NLFAIL) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + - expected changes due to + . changes in SOA chemistry scheme + . default dep_data_file and DMS emissions updates + . inclusion of SOAG in drydep_list + +izumi/gnu/aux_cam: + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + - expected changes due to + . changes in SOA chemistry scheme + . default dep_data_file and DMS emissions updates + . inclusion of SOAG in drydep_list + +Summarize any changes to answers: larger than roundoff + +=============================================================== +=============================================================== + +Tag name: cam6_3_092 +Originator(s): patc, fvitt +Date: 25 Jan 2023 +One-line Summary: Add capability for zonal mean nudging +Github PR URL: https://github.com/ESCOMP/CAM/pull/629 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Add capability for zonal mean nudging in physics for any grid (part of #368) + CONUS prealpha test needs longer time limit #744 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + + Zonal-Mean Nudging options: + + Nudge_ZonalFilter (logical): + Switch to turn on zonal mean filtering nudging. If TRUE, the nudging scheme + filters 3D model and the 3D input target data to zonal mean values, and then + applies nudging to the differences. + Default: FALSE + + Nudge_ZonalNbasis (integer): + Number of zonal mean basis functions (number of m=0 spherical harmonics) used in + zonal mean filtering nudging. + Default: none + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: + +List all files eliminated: N/A + +List all files added and what they do: +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_f10_L26/user_nl_cpl +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_nudging_ne5_L26/user_nl_cpl +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_zmean_nudging/user_nl_cpl + - for regression testing + +List all existing files that have been modified, and describe the changes: + +M bld/namelist_files/namelist_definition.xml + - add zonal mean nudging options (see above) + +M cime_config/testdefs/testlist_cam.xml + - add tests for zonal mean nudging + - increase time limit on CONUS prealpha test + +M src/physics/cam/nudging.F90 + - changes for optional zonal mean nudging + +M src/physics/cam/physpkg.F90 + - call nudging_final + +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. + +cheyenne/intel/aux_cam: All PASS + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing test + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + - new test + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_091 +Originator(s): katec,vlarson,bstephens82,huebleruwm,adamrher,zarzycki,thomas.toniazzo@misu.su.se +Date: 16 Jan 2023 +One-line Summary: Bringing in new CLUBB and SILHS externals. +Github PR URL: https://github.com/ESCOMP/CAM/pull/712 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + Bringing updated code for CLUBB and SILHS that includes tau tuning parameters and + other stability enhancements. Fixes #675 + +Describe any changes made to build system: + None + +Describe any changes made to the namelist: + Added several CLUBB related namelist options, removed the documentation for + variable defaults, rearranged several lists of CLUBB namelists into alphabetical + order. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: + +Code reviewed by: zarzycki, adamrher, cacraigucar, nusbaume, bstephens82 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist + - Add default calls for all new CLUBB namelist parameters. Also added code to set + a series of CLUBB parameters to new values when clubb_Lscale_from_tau is true + (taus code being used). +M bld/namelist_files/namelist_defaults_cam.xml + - Add default values for new CLUBB parameters. Rearranged all CLUBB default entries + into alphabetical order. +M bld/namelist_files/namelist_definition.xml + - Add documentation for new CLUBB parameters. Rearranged all CLUBB entries into + alphabetical order. Removed documentation of default values from this file because + it tends to get out of date quickly and is difficult to update when in active + development. +M cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam + - Update fincl and CLUBB history lists for new variable names. +M src/physics/cam/subcol_SILHS.F90 + - Remove RCM from pbuf and parameter setups. +M src/physics/cam/clubb_intr.F90 + - Added new namelist parameters for taus code tuning options and a few other new + code options. Rearranged namelist lists into alphabetical order. Some code clean + up and whitespace changes as well as changing internal CLUBB variables to size + ncol instead of pcol. Added NorESM/PSU surface flux updating code to reduce high + frequency oscillations. Removed limiter restricting clubb to only the tropopause. + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.FC2000mam5.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - Expected answer changes due to new CLUBB code + + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + - Expected due to namelist changes + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - Pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + - Expected answer changes due to new CLUBB code + +izumi/gnu/aux_cam: + - All Pass (no CAM6 tests) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: Any configuration running cam6 or cam_dev physics +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): New climate, discussed in CAM7 github issues + https://github.com/NCAR/amwg_dev/discussions/212 + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- See CAM 7 development discussions in Github + https://github.com/NCAR/amwg_dev/discussions/212 + +MSS location of control simulations used to validate new climate: +- See CAM 7 development discussions in Github + https://github.com/NCAR/amwg_dev/discussions/212 + +URL for AMWG diagnostics output used to validate new climate: +- See CAM 7 development discussions in Github + https://github.com/NCAR/amwg_dev/discussions/212 + +=============================================================== +=============================================================== + +Tag name: cam6_3_090 +Originator(s): fvitt +Date: 12 Jan 2023 +One-line Summary: Functional support for FHIST on SE refined grids +Github PR URL: https://github.com/ESCOMP/CAM/pull/668 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Provide function support for FHIST on SE refined grids. The emissions + for CAM on refined grids default to the 0.9x1.25 CMIP6 emissions which are + bilinearly interpolated to the physics grid and thus are not mass conserved. + + Address issue: + CONUS FHIST compset does not run out of the box #662 + +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: + + Default emissions for CAM on refined SE grids are the 0.9x1.25 cmip6 emissions. + +Code reviewed by: cacraigucar, nusbaume, adamrher, jtruesdal + +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/namelist_defaults_cam.xml + - restrict default emission files on CONUS grid to CAMChem configuration so that + the default emissions for CAM on refined grids are 0.9x1.25 cmip6 emissions + +M cime_config/testdefs/testlist_cam.xml + - add tests for refined SE grids + +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. + +cheyenne/intel/aux_cam: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + - new test + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-exiting failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: none + +=============================================================== +=============================================================== + +Tag name: cam6_3_089 +Originator(s): fvitt, patc +Date: 10 Jan 2013 +One-line Summary: Introduce zonal mean and Transformed Eulerian Mean diagnostics capabilities on arbitrary grids +Github PR URL: https://github.com/ESCOMP/CAM/pull/677 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Add capability to calculate zonal mean of physics fields on arbatrary grids (structured or unstructured). + The synthesis of zonal mean values is based on m=0 spherical harmonics. (patc) + + Implement TEM circulation diagnostics in physics #653 + Need to add zonal mean grid to history for fields on arbitrary grids #652 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + + Namelist options added: + + phys_grid_ctem_zm_nbas: + Number of zonal mean basis functions (number of m=0 spherical harmonics) used in + Transformed Eulerian Mean (TEM) diagnostics + + phys_grid_ctem_za_nlat: + Number of latitude grid points for zonal average TEM diagnostics history fields + + phys_grid_ctem_nfreq: + Frequency of TEM diagnostics calucation. + If > 0, frequency is specified as number of timesteps. + If < 0, frequency is specified as number of hours. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: + + The physics grid TEM diagnostics is expected have a small impact (on the order of a few percent) + when activated. + +Code reviewed by: peverwhee, cacraigucar, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: + +A src/physics/cam/phys_grid_ctem.F90 + - computes terms of the TEM diags on the physics grid + +A src/utils/zonal_mean_mod.F90 + - computes zonal means on arbitrary physics grids based on m=0 order spherical harmonics + +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_physgrid_tem_mpasa120_wcmsc/user_nl_clm +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_physgrid_tem/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_physgrid_tem/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_physgrid_tem/user_nl_clm +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_physgrid_tem_1deg/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_physgrid_tem_1deg/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_physgrid_tem_1deg/user_nl_clm + - for testing TEM diags on physics grids + +List all existing files that have been modified, and describe the changes: + +M bld/namelist_files/namelist_definition.xml + - new phys_grid_ctem options (see above) + +M bld/namelist_files/namelist_defaults_cam.xml + - update IC file for WACCM-SC on ne30pg3 grid (spun up stable IC file) + +M bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml + - correct IC file path for 0.9x1.25 grid + +M cime_config/testdefs/testlist_cam.xml + - add tests for TEM diags on physics grids + +M src/control/cam_comp.F90 + - invoke phys_grid_ctem_reg + +M src/control/runtime_opts.F90 + - invoke phys_grid_ctem_readnl + +M src/physics/cam/physpkg.F90 + - invoke : + phys_grid_ctem_init + phys_grid_ctem_final + phys_grid_ctem_diags + +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. + +cheyenne/intel/aux_cam: All PASS + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + - new test + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_088 +Originator(s): cacraig +Date: Dec 21, 2022 +One-line Summary: Update externals to match cesm2_3_alpha11a - more or less + +Github PR URL: https://github.com/ESCOMP/CAM/pull/731 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update all externals to match cesm2_3_alpha11a except for a couple externals which are newer and FMS which is older + +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: nusbaumer + +List all files eliminated: N/A + +List all files added and what they do: +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_apmee/shell_commands + - add xmlchange commands to fix error with coupling + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update externals as described above + +M cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/shell_commands +M cime_config/testdefs/testmods_dirs/cam/dartcambigens/shell_commands +M cime_config/testdefs/testmods_dirs/cam/outfrq3s_chemproc/shell_commands +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_mee_fluxes/shell_commands + - add xmlchange commands to fix error with coupling + + +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. + +cheyenne/intel/aux_cam: all BFB except: + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.FC2000mam5.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_087: FIELDLIST field lists differ (otherwise bit-for-bit) + - difference limited to FIELDLIST, but answers are all BFB + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=9 + PEND DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt NLCOMP + - namelist change due to changed coupling size + +izumi/gnu/aux_cam: all BFB except: + FAIL SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee NLCOMP + - namelist change due to changed coupling size + + FAIL SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s BASELINE +/fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_087_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + - difference limited to FIELDLIST, but answers are all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_087 +Originator(s): fvitt, tilmes +Date: 16 Dec 2022 +One-line Summary: Add MAM5 chemistry compsets and change coarse mode size parameters for MAM4 used by cam_dev physics +Github PR URL: + https://github.com/ESCOMP/CAM/pull/669 + https://github.com/ESCOMP/CAM/pull/721 + https://github.com/ESCOMP/CAM/pull/725 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Create MAM5 chemistry compsets FCHIST (58L and 93L) #663 + Change coarse mode size parameters for MAM4 used by cam_dev phys #664 + Address misc issues: + argument should be iulog not shrlogunit #720 + spcam output cleanup #717 + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: peverwhee, cacraigucar, nusbaume + +List all files eliminated: NA + +List all files added and what they do: +A src/chemistry/pp_trop_strat_mam5_vbs/chem_mech.doc +A src/chemistry/pp_trop_strat_mam5_vbs/chem_mech.in +A src/chemistry/pp_trop_strat_mam5_vbs/chem_mods.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/m_rxt_id.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/m_spc_id.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/mo_adjrxt.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/mo_exp_sol.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/mo_imp_sol.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/mo_indprd.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/mo_lin_matrix.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/mo_lu_factor.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/mo_lu_solve.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/mo_nln_matrix.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/mo_phtadj.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/mo_prod_loss.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/mo_rxt_rates_conv.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/mo_setrxt.F90 +A src/chemistry/pp_trop_strat_mam5_vbs/mo_sim_dat.F90 + - new chemistry mechanism with MAM5 aerosols + +List all existing files that have been modified, and describe the changes: + +M bld/build-namelist + - set default MEGAN emis settings for trop_strat_mam5_vbs + +M bld/config_files/definition.xml +M bld/configure + - add trop_strat_mam5_vbs chem option + +M bld/namelist_files/namelist_defaults_cam.xml + - new IC files + - use cam5 version mam4_mode3 physprop file if not cam6 phys (if cam_dev phys) + - defult se_ settings for 93 layer model + +M bld/namelist_files/namelist_definition.xml + - add trop_strat_mam5_vbs to cam_chempkg + +M cime_config/config_component.xml + - set nlev for L58 and L93 + - add trop_strat_mam5_vbs chem config option + +M cime_config/config_compsets.xml + - new compsets for trop_strat_mam5_vbs chem: + FC2000mam5 + FCHISTmam5 + FCLTHIST -- "Low-Top" + FCMTHIST -- "Medium-Top" + +M cime_config/config_pes.xml + - adjustments to pelout for cam-chem and waccm compsets to account for stub GLC and WAV components + +M cime_config/testdefs/testlist_cam.xml + - new regression tests for the new compsets listed above + +M src/cpl/nuopc/atm_comp_nuopc.F90 + - corrections to shr log output unit + +M src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 + - turn off diagnostic output to fort.* files + +M Externals.cfg + - use share1.0.16 -- required by the shr log changes in atm_comp_nuopc.F90 + +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. + +cheyenne/intel/aux_cam: + + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + - change in coarse mode size params (mam4_mode3 physprop file) + + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + - change pelayout for stub components + + SMS_D_Ln9_Vnuopc.f10_f10_mg37.FC2000mam5.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + - new tests + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: larger than roundoff for cam_dev physics + +=============================================================== +=============================================================== + +Tag name: cam6_3_086 +Originator(s): cacraig, stepheba, aherring, jedwards, goldy +Date: Dec 8, 2022 +One-line Summary: PUMAS DDT and various minor fixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/632 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Introduce PUMAS DDT: https://github.com/ESCOMP/CAM/pull/632 + - Fixes initialization for cam_dev: https://github.com/ESCOMP/CAM/pull/703 + - update python paths, only build ali_arms with waccm: https://github.com/ESCOMP/CAM/pull/706 + - reduce the number of times orb_param is printed to log: https://github.com/ESCOMP/CAM/pull/707 + - create_newcase using updated cime does not start jobs on izumi: https://github.com/ESCOMP/CAM/issues/711 + - Reduce number of processors needed for large grid regression tests: https://github.com/ESCOMP/CAM/issues/708 + +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, gettelman, aherring, stephaba, sunjian, courtneyp, nusbaume, katec + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update cime tag to fix create_newcase bug (needed to update mosart tag to work with this cime tag) + +M Externals_CAM.cfg + - update PUMAS tag to bring in the DDT in their library + +M bld/configure +M cime_config/buildcpp +M cime_config/buildlib + - update python paths and only build ali_arms with waccm + +M cime_config/testdefs/testlist_cam.xml + - Reduce number of processors needed for large grid regression tests + +M src/control/cam_history_support.F90 + - Add hist_dimension_values routine, to retrieve the values of a history dimension + +M src/cpl/nuopc/atm_comp_nuopc.F90 + - reduce the number of times orb_param is printed to log + +M src/physics/cam/micro_pumas_cam.F90 + - Initializations which were required for cam_dev were also applied to cam version + +M src/physics/cam_dev/micro_pumas_cam.F90 + - Introduce PUMAS DDT + - Fixes initialization for cam_dev + +M src/physics/rrtmg/cloud_rad_props.F90 +M src/physics/rrtmg/radiation.F90 + - Fixes initialization for cam_dev + + +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. + +cheyenne/intel/aux_cam: all BFB except: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s BASELINE +/glade/p/cesm/amwg/cesm_baselines/cam6_3_085: ERROR BFAIL baseline directory +'/glade/p/cesm/amwg/cesm_baselines/cam6_3_085/SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s' +does not exist + - Changed PE layout changed the directory and filenames. Ran cprnc comparison by hand on previous versions, cam.h0, cam.i, + clm2.h0 and cpl.h0 files and they were BFB + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + PEND DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + +izumi/gnu/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_085 +Originator(s): peverwhee +Date: Nov 28, 2022 +One-line Summary: Update externals to match cesm2_3_alpha10b tag +Github PR URL: https://github.com/ESCOMP/CAM/pull/700 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update CAM externals to match cesm2_3_alpha10b: https://github.com/ESCOMP/CAM/issues/661 + - PE layout of 384x3 on cheyenne fails with updated ESMF library: https://github.com/ESCOMP/CAM/issues/673 + - DAE test broken: https://github.com/ESCOMP/CAM/issues/670 + +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, jtruesdale + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - match cesm2_3_alpha10b tags + - advance CICE & CDEPS tags to more recent tags to resolve PE + layout issue + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: NLFAIL) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: NLFAIL) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (Overall: NLFAIL) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: NLFAIL) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s(Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall:NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: NLFAIL) details: + - namelist differences in nuopc tests due to data assimilation fix in CMEPS + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - preexisting failure + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + - namelist differences in nuopc tests due to data assimilation fix in CMEPS + +izumi/gnu/aux_cam: all BFB + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + - namelist differences in nuopc tests due to data assimilation fix in CMEPS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new climate): + +No answer changes + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam6_3_084 +Originator(s): peverwhee, jimmielin +Date: Nov 18, 2022 +One-line Summary: Fix secondary SE advection bug and update CAM history field length to 32 +Github PR URL: https://github.com/ESCOMP/CAM/pull/685 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Secondary bug in spectral-element advection: https://github.com/ESCOMP/CAM/issues/678 + - Increase history field length from 24 to 32: https://github.com/ESCOMP/CAM/issues/699 + +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, PeterHjortLauritzen, jtruesdale + +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/control/cam_history_support.F90 + - Increase fieldname_len from 24 to 32 +M src/dynamics/se/dycore/prim_driver_mod.F90 + - Fix secondary advection bug (resolve noise over Antarctica) + +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. + +cheyenne/intel/aux_cam: +ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase +(Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + - baseline differences due to answer-changing bugfix for SE + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=9 + - preexisting failure + + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + - baseline differences due to answer-changing bugfix for SE + +izumi/gnu/aux_cam: all BFB + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + - baseline differences due to answer-changing bugfix for SE + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new climate): + + Modest changes to all spectral element cases - fixing noise over Antarctica + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: cam6_3_083 +Originator(s): admarher, fvitt, cacraig +Date: Nov 15, 2022 +One-line Summary:move emissions before CLUBB in cam_dev and fix bad ozone(Sa_o3)values in first coupling time step +Github PR URL: https://github.com/ESCOMP/CAM/pull/694 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Move emissions before turbulence in cam_dev: https://github.com/ESCOMP/CAM/issues/691 + - Bad ozone (Sa_o3) values in first coupling time step: https://github.com/ESCOMP/CAM/issues/693 + +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, cacraig, katetc, courtneyp, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M .gitignore + - Add ali-arms directory to ignore list + +M src/chemistry/mozart/chemistry.F90 + - Add missing initialization for srf_ozone + +M src/physics/cam/clubb_intr.F90 + - Add subroutine for applying tracer emissions + +M src/physics/cam/vertical_diffusion.F90 + - Add logic to disable tracer emissions when running cam_dev + +M src/physics/cam_dev/physpkg.F90 + - Add call to new emissions subroutine + + +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. + +cheyenne/intel/aux_cam: + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE +/glade/p/cesm/amwg/cesm_baselines/cam6_3_082: DIFF + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_082: +DIFF + FAIL ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc BASELINE +/glade/p/cesm/amwg/cesm_baselines/cam6_3_082: DIFF + FAIL SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_082: DIFF + - All tests running cam_dev have expected answer changes + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=9 + - preexisting failure + +izumi/gnu/aux_cam: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new climate): + + Modest changes to climate; larger dust burden and marginal increases in cloud liquid. + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam6_3_082 +Originator(s): fvitt +Date: 1 Nov 2022 +One-line Summary: Refactor ice nucleation code to use generalized aerosol interfaces +Github PR URL: https://github.com/ESCOMP/CAM/pull/656 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Issue #648 -- Refactor ice nucleation code to use abstract aerosol interfaces + + This is a prerequisite incorporating other aerosol models, such as CARMA, + into CAM physics (see issue #495: Merging CARMA aerosol model for troposphere + and stratosphere (trop_strat) into the CESM development version) + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: cacraigucar, nusbaume, peverwhee, gold2718 + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M src/chemistry/aerosol/aerosol_properties_mod.F90 + - overload nspecies method to be able to get number of species for all bins + - define interfaces useful in nucleate_ice_cam + -- amb_num_name + -- amb_mmr_name + -- species_type + -- icenuc_updates_num + -- icenuc_updates_mmr + +M src/chemistry/aerosol/aerosol_state_mod.F90 + - define interfaces useful in nucleate_ice_cam + -- ambient_total_bin_mmr + -- get_ambient_total_mmr + -- get_cldbrne_total_mmr + -- icenuc_size_wght + -- icenuc_type_wght + -- nuclice_get_numdens + +M src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +M src/chemistry/aerosol/modal_aerosol_state_mod.F90 + - modal model specific implementations of the above methods + +M src/physics/cam/microp_aero.F90 + - pass aerosol properties and state objects to nucleate_ice_cam when appropriate + +M src/physics/cam/nucleate_ice_cam.F90 + - refactored to use generic aerosol interfaces + +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. + +cheyenne/intel/aux_cam: All PASS + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_081 +Originator(s): jtruesdal, nusbaume, mvertens, fvitt, peverwhee +Date: October 26, 2022 +One-line Summary: Misc tag +Github PR URL: https://github.com/ESCOMP/CAM/pull/680 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - indexing bug for optional argument PS for get_dp subroutine of cam_thermo.F90: https://github.com/ESCOMP/CAM/issues/679 + - The interpolate_output namelist flag results in bad output values: https://github.com/ESCOMP/CAM/issues/644 + - Interpolation issue for SE dycore output?: https://github.com/ESCOMP/CAM/issues/564 + - More restart non-bit-for-bit occurrences: https://github.com/ESCOMP/CAM/issues/667 + - DAE test broken: https://github.com/ESCOMP/CAM/issues/670 + - convect_shallow.F90 has CIN in an addfld call, but there is no corresponding + outfld call: https://github.com/ESCOMP/CAM/issues/674 + + +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, fvitt, jtruesdal + +List all files eliminated: N/A + +List all files added and what they do: +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec/user_nl_clm +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_L32wsc/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_L32wsc/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_14dec_L32wsc/user_nl_clm + - add testmods for WACCM-SC chemistry restarts across the Dec 16 + boundary + +List all existing files that have been modified, and describe the changes: +M cime_config/testdefs/testlist_cam.xml + - Add new tests for WACCM-SC chemistry restarts across the Dec 16 + boundary + +M src/control/cam_history +M src/dynamics/se/dycore/interpolate_mod.F90 +M src/dynamics/se/interp_mod.F90 + - interpolate_output fixes + +M src/cpl/nuopc/atm_comp_nuopc.F90 + - DAE test fixes + +M src/physics/cam/boundarydata.F90 + - fix bug in data reader used for WACCM-SC loss rates input + +M src/physics/cam/convect_shallow.F90 + - remove CIN addfld call + +M src/utils/cam_thermo.F90 + - fix get_dp indexing bug + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (DIFF) + - expected differences because of WACCMSC fix + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (NLCOMP) + - new test, no baselines to compare to + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (FAIL) + - existing failure, this tag contains some fixes, but not all + +izumi/gnu/aux_cam: All BFB + +=============================================================== + +Tag name: cam6_3_080 +Originator(s): cacraig, Dan Marsh, Alexander Kutepov, Artem Feofilov +Date: October 14, 2022 +One-line Summary: Bring in optional ALI-ARMS (an alternative method for computing non-LTE heating rates in upper atmosphere) +Github PR URL: https://github.com/ESCOMP/CAM/pull/516 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Add the ALI-ARMS non-lte code as an option for high-top versions of CAM: https://github.com/ESCOMP/CAM/issues/306 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - introduce: + -- nlte_use_aliarms - If true, turns on ALI-ARMS calculations + -- nlte_aliarms_every_x - Call ALI-ARMS every X timesteps where X is specified by this variable + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: goldy, courtneyp, nusbaume, fvitt + +List all files eliminated: N/A + +List all files added and what they do: +A src/physics/waccm/nlte_aliarms.F90 + - The interface to the ALI-ARMS code + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - Add external for ALI-ARMS code + +M bld/build-namelist +M bld/namelist_files/namelist_definition.xml + - add nlte_use_aliarms and nlte_aliarms_every_x (described above) + +M bld/configure + - add in directories for ali_arms code + +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_apmee/user_nl_cam + - modify this test to include run for ALI-ARMS + +M src/physics/cam/physpkg.F90 +M src/physics/cam/radheat.F90 +M src/physics/cam/restart_physics.F90 +M src/physics/cam_dev/physpkg.F90 +M src/physics/waccm/nlte_lw.F90 +M src/physics/waccm/radheat.F90 + - Changes needed to interface with ALI-ARMS code + +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. + +cheyenne/intel/aux_cam: all BFB + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=131 + - pre-existing failure + +izumi/gnu/aux_cam: all BFB except: + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_079_gnu: DIFF + - expected failure due to addition of ALI-ARMS calculation to this test + +=============================================================== +=============================================================== + +Tag name: cam6_3_079 +Originator(s): jedwards, cacraig +Date: Oct 14, 2022 +One-line Summary: variable resolution has irreproducible results (intermittent failure) +Github PR URL: https://github.com/ESCOMP/CAM/pull/666 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - irreproducable results in variable resolution: https://github.com/ESCOMP/CAM/issues/631 + - during testing investigations, a problem with nextsw_cday was discovered and is corrected + +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, courtneyp, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update PIO and ccs_config externals to bring in fix for intermittent failure + +M cime_config/testdefs/testlist_cam.xml + - Remove MCT WACCM tests which were have intermittent problems as MCT is being phased out + - Increase time for C96 F2000climo test + +M src/physics/camrt/radiation.F90 +M src/physics/rrtmg/radiation.F90 + - nextsw_cday is a protected variable, but was being modified by an external routine. Fixed + +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. + +cheyenne/intel/aux_cam: all BFB except: + FAIL ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_078: DIFF + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_078: DIFF + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_078: DIFF + FAIL SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_078: DIFF + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_078: DIFF + - Differences are due to ESMF update and were confirmed as discussed in issue ESCOMP/CAM #631 + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=11 + - expected failure + +izumi/gnu/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name:cam6_3_078 +Originator(s): stepheba, cacraig +Date: Sept 28, 2022 +One-line Summary: Correct cam_dev restart issue due to nextsw_cday being an integer instead of a double +Github PR URL: https://github.com/ESCOMP/CAM/pull/660 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - cam_dev is unable to achieve bit-for-bit restarts in numerous configurations: https://github.com/ESCOMP/CAM/issues/655 + +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: jet, fvitt, courtneyp, nusbaume (in PR#659) + +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/camrt/radiation.F90 +M src/physics/rrtmg/radiation.F90 + - Make nextsw_cday a double instead of an integer to fix cam_dev restart issue + +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. + +cheyenne/intel/aux_cam: all BFB + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + - preexisting failure + +izumi/gnu/aux_cam: all BFB + +IMPORTANT NOTE-- This tag is answer changing for restarts which call radiation on the restart time step. None of our tests + were restarting at this time step which is why all the tests are BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_077 +Originator(s): fvitt +Date: 2 Sep 2022 +One-line Summary: Refactor aerosol-cloud interaction code to use generalized aerosol interfaces +Github PR URL: https://github.com/ESCOMP/CAM/pull/546 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Employ abstract aerosol interfaces in aerosol-cloud interaction code (ndrop). + This is a prerequisite incorporating other aerosol models, such as CARMA, + into CAM physics (see issue #495: Merging CARMA aerosol model for troposphere + and stratosphere (trop_strat) into the CESM development version) + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraigucar, nusbaume, peverwhee, gold2718 + +List all files eliminated: none + +List all files added and what they do: + +A src/chemistry/aerosol/aerosol_properties_mod.F90 +A src/chemistry/aerosol/aerosol_state_mod.F90 +A src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +A src/chemistry/aerosol/modal_aerosol_state_mod.F90 + - abstract and concrete classes for aerosol properties and aerosol state + +List all existing files that have been modified, and describe the changes: + +M src/physics/cam/microp_aero.F90 + - instantiate aerosol objects + +M src/physics/cam/ndrop.F90 + - make use of abstract aerosol properties and state interfaces + +M src/dynamics/eul/stepon.F90 +M src/dynamics/fv/stepon.F90 +M src/dynamics/fv3/stepon.F90 +M src/dynamics/mpas/stepon.F90 +M src/dynamics/se/stepon.F90 + - use aerosol interfaces to exchange aerosol state with host model + +M src/physics/cam_dev/physpkg.F90 +M src/physics/cam/physpkg.F90 + - invoke microp_final + - pass phys_state to microp_aero_init + +M src/chemistry/modal_aero/modal_aero_convproc.F90 +M src/physics/cam/zm_microphysics.F90 + - make use of aerosol properties object + +M src/physics/spcam/crm_physics.F90 +M src/physics/spcam/crmclouds_camaerosols.F90 +M src/physics/spcam/ecpp/ecpp_modal_aero_activate.F90 +M src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 +M src/physics/spcam/ecpp/module_ecpp_td2clm.F90 + - make use of aerosol properties and state objects + +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. + +cheyenne/intel/aux_cam: + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + - roundoff differences in CCN3 diagnostic, otherwise bit-for-bit unchanged + +izumi/nag/aux_cam: + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + - roundoff differences in CCN3 diagnostic, otherwise bit-for-bit unchanged + +izumi/gnu/aux_cam: + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + - roundoff differences in CCN3 diagnostic, otherwise bit-for-bit unchanged + +Summarize any changes to answers: + + Roundoff level changes to CCN diagnostics, otherwise bit-for-bit unchanged. + +=============================================================== +=============================================================== + +Tag name: cam6_3_076 +Originator(s): goldy, peverwhee +Date: 29 August 2022 +One-line Summary: CAM Thermo Refactor +Github PR URL: https://github.com/ESCOMP/CAM/pull/615 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Refactor CAM physconst and thermodynamics code: https://github.com/ESCOMP/CAM/issues/542 + +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: goldy, nusbaume, cacraig, fvitt, PeterHjortLauritzen + +List all files eliminated: N/A + +List all files added and what they do: +A src/utils/cam_thermo.F90 + - added to contain the interfaces to compute thermodynamic quantities that + were once in physconst +A src/utils/air_composition.F90 + - added to contain the data and interfaces for quantities which vary with the + composition of the atmosphere that were once in physconst + - get_R interface is not currently used or tested but remains in place for future work + +List all existing files that have been modified, and describe the changes: +M src/utils/physconst.F90 + - modified to now only include data and interfaces for fundamental constants; + remaining code moved to cam_thermo and air_composition +M src/chemistry/mozart/charge_neutrality.F90 +M src/chemistry/mozart/epp_ionization.F90 +M src/chemistry/mozart/mee_ionization.F90 +M src/chemistry/mozart/mo_waccm_hrates.F90 +M src/chemistry/mozart/upper_bc.F90 +M src/control/cam_comp.F90 +M src/control/runtime_opts.F90 +M src/dynamics/eul/dp_coupling.F90 +M src/dynamics/fv/dp_coupling.F90 +M src/dynamics/fv/dyn_comp.F90 +M src/dynamics/fv/stepon.F90 +M src/dynamics/fv/te_map.F90 +M src/dynamics/fv3/dp_coupling.F90 +M src/dynamics/fv3/dyn_comp.F90 +M src/dynamics/mpas/dp_coupling.F90 +M src/dynamics/mpas/dyn_comp.F90 +M src/dynamics/se/dp_coupling.F90 +M src/dynamics/se/dycore/fvm_mapping.F90 +M src/dynamics/se/dycore/fvm_mod.F90 +M src/dynamics/se/dycore/prim_advance_mod.F90 +M src/dynamics/se/dycore/prim_advection_mod.F90 +M src/dynamics/se/dycore/prim_driver_mod.F90 +M src/dynamics/se/dycore/prim_state_mod.F90 +M src/dynamics/se/dyn_comp.F90 +M src/dynamics/se/dyn_grid.F90 +M src/dynamics/se/gravity_waves_sources.F90 +M src/dynamics/se/stepon.F90 +M src/physics/cam/cam_diagnostics.F90 +M src/physics/cam/check_energy.F90 +M src/physics/cam/clubb_intr.F90 +M src/physics/cam/dadadj_cam.F90 +M src/physics/cam/diffusion_solver.F90 +M src/physics/cam/eddy_diff_cam.F90 +M src/physics/cam/gw_drag.F90 +M src/physics/cam/molec_diff.F90 +M src/physics/cam/physics_types.F90 +M src/physics/cam/physpkg.F90 +M src/physics/cam/vertical_diffusion.F90 +M src/physics/cam_dev/physpkg.F90 +M src/physics/simple/held_suarez_cam.F90 +M src/physics/simple/physpkg.F90 +M src/physics/waccm/iondrag.F90 +M src/physics/waccm/nlte_lw.F90 +M src/physics/waccm/radheat.F90 +M src/physics/waccmx/ion_electron_temp.F90 +M src/physics/waccmx/majorsp_diffusion.F90 +M src/physics/waccmx/steady_state_tei.F90 + - update import statements and calls to reflect refactor + +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. + +cheyenne/intel/aux_cam: all BFB + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/gnu/aux_cam: all BFB + +=============================================================== + +Tag name: cam6_3_075 +Originator(s): katec, andrewgettelman +Date: 25 Aug 2022 +One-line Summary: Update PUMAS external tag +Github PR URL: https://github.com/ESCOMP/CAM/pull/645 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + New PUMAS External tag. + + Address github issues: + . Fixes Bug - use_hetfrz_classnuc off not working #216 + . PUMAS issue #47 Bug: Fixing crashes with use_hetfrz_classnuc = False + + Updates to the OpenACC directives in PUMAS for new diagnostics. + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: cacraigucar, nusbaume + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M Externals.cfg + - Change externals PUMAS tag to pumas_cam-release_v1.27 + +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. + +cheyenne/intel/aux_cam: + - All pass +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure +izumi/gnu/aux_cam: + - All pass +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_074 +Originator(s): fvitt +Date: 22 Aug 2022 +One-line Summary: Upper boundary conditions specification via namelist +Github PR URL: https://github.com/ESCOMP/CAM/pull/614 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Address github issues: + . Need to expose species upper boundary conditions as namelist options #216 + . Option to specify upper boundary conditions from a file #533 + + Remove obsolete noy_ubc module + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: + + New namelist options for specifying UBCs (see namelist_definition.xml for details) + ubc_specifier + ubc_file_path + ubc_file_input_type + ubc_file_cycle_yr + ubc_file_fixed_ymd + ubc_file_fixed_tod + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: cacraigucar, nusbaume, peverwhee, gold2718 + +List all files eliminated: + src/chemistry/mozart/noy_ubc.F90 + - obsolete code + +List all files added and what they do: +A src/chemistry/mozart/upper_bc_file.F90 + - manages reading UBCs from file + +A cime_config/testdefs/testmods_dirs/cam/outfrq3h_fubc/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq3h_fubc/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq3h_fubc/user_nl_clm + - for regression tests + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist + - set default UBC specifier if appropriate + - new namelist vars for reading UBCs from file + +M bld/namelist_files/namelist_defaults_cam.xml + - default ubc_specifier for WACCM configurations + +M bld/namelist_files/namelist_definition.xml + - move existing UBC options to "upper_bc_opts" namelist group + - removed obsolete noy_ubc namelist options + +M src/chemistry/mozart/chemistry.F90 + - register constituents as having fixed UBCs according to ubc namelist settings + by use of upper_bc module ubc_fixed_conc utility function + - move existing upper boundary namelist options to upper_bc module + - remove BAB kludge to set upper boundary of H2O in WACCM -- namelist controlled + - removed obsolete noy_ubc references + +M src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - removed obsolete noy_ubc references + +M src/chemistry/mozart/mo_tgcm_ubc.F90 + - remove hard-wired H2O and CH4 UBC settings + +M src/chemistry/mozart/upper_bc.F90 + - add read namelist subroutine + - implement logic for UBC specifier options + - separate out upper boundary fluxes from other upper boundary conditions + +M src/chemistry/utils/mo_msis_ubc.F90 + - code clean up + - correction to diagnostic history fields + +M src/chemistry/utils/tracer_data.F90 + - add ability to vertically interpolate to mid-point of top model layer + +M src/control/runtime_opts.F90 + - call ubc_readnl + +M src/physics/cam/constituents.F90 + - protect cnst_fixed_ubc and cnst_fixed_ubflx arrays + +M src/physics/cam/diffusion_solver.F90 + - explicitly set mmr in top layer for cases where molecular diffusion is not active + +M src/physics/cam/physpkg.F90 + - determine if water vapor constituent has fixed UBC + +M src/physics/cam/vertical_diffusion.F90 + - get upper boundary fluxes separately for WACCMX + +M src/physics/waccmx/majorsp_diffusion.F90 + - ubc_get_vals interface change + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: + ERP_Ld3_Vmct.f09_f09_mg17.HIST_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: NLFAIL) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ln9_Vmct.f09_f09_mg17.1850_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + - expected failures -- ubc_specifier is used in these WACCM tests + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + - expected failure -- ubc_specifier is used in this WACCM test + + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: NLFAIL) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + - expected failures -- ubc_specifier is used in these WACCM tests + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_073 +Originator(s): cacraig, nusbaumer +Date: August 18, 2022 +One-line Summary: CAM answer changing bug fix for thermodynamics +Github PR URL: https://github.com/ESCOMP/CAM/pull/636 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - CAM Thermo answer-changing bug fixes and code clean-up: https://github.com/ESCOMP/CAM/issues/635 + - ERP_Ld3 test fails COMPARE_base_rest: https://github.com/ESCOMP/CAM/issues/638 + +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: goldy, fvitt, nusbaumer, jet + +List all files eliminated: +D cime_config/testdefs/testmods_dirs/cam/outfrq3d/user_nl_cpl + - Removed user_nl_cpl as the reprosum variables were causing problems with runs + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M src/utils/physconst.F90 + - Answer changing thermodynamics changes + + +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. + +cheyenne/intel/aux_cam: all BFB except: + + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + - Answer changes expected in WACCMX runs + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + - Answer changes expected in WACCMX runs + +izumi/gnu/aux_cam: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: all WACCMX +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): fvitt looked at a couple for runs and concluded it was roundoff + +=============================================================== +=============================================================== + +Tag name: cam6_3_072 +Originator(s): cacraig, Peter Lauritzen, Jim Edwards +Date: August 11, 2022 +One-line Summary: CAM SE and SSTICE bug fixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/637 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Bug in spectral-element advection: https://github.com/ESCOMP/CAM/issues/633 + - SSTICE_GRID_FILENAME and SSTICE_DATA_FILENAME do not belong in config_compsets.xml: https://github.com/ESCOMP/CAM/issues/634 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - SSTICE_GRID_FILENAME and SSTICE_DATA_FILENAME are no longer being forced by CAM config_compsets + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: goldy, nusbaume, jet, 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 cime_config/config_compsets.xml + - Remove SSTICE namelist settings + +M src/dynamics/se/dycore/prim_advance_mod.F90 + - Apply fix that Peter provided for CAM SE + +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. + +cheyenne/intel/aux_cam: + + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + - Only namelist failure, no answer changes + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + - Changes due to SE dycore modification (no namelist changes) + + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vmct.f09_f09_mg17.HIST_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist1d +(Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) +details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) +details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - namelist and answer changes - due to combination of SST and SE changes + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + PEND DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - Preexisting failure + + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + - answer changes due to SE dycore fix (no namelist changes) + +izumi/gnu/aux_cam: + + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - namelist and answer changes - due to combination of SST and SE changes + + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + - answer changes due to SE dycore fix (no namelist changes) +=============================================================== +=============================================================== + +Tag name: cam6_3_071 +Originator(s): fvitt +Date: 2 Aug 2022 +One-line Summary: Move Henry's law coefficients to an input file; fix a bug in WACCMX history grids +Github PR URL: + https://github.com/ESCOMP/CAM/pull/602 + https://github.com/ESCOMP/CAM/pull/625 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Read Henrys Law coefficient data from file via share code updates #601 + + WACCMX issue with pio2_5_7 #624 + -- When PIO was advanced to version 2.5.7 (in cam tag cam6_3_068) this + aux_cam test failed: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + It was suggested "that more than one source point in the decomposition map + is going to the same destination point". Changes here mimic what was done + for fv_centers grid and solves the issue with this izumi_nag test. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - new namelist variable "dep_data_file" added to drydep_inparm in drv_flds_in + +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, peverwhee, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M Externals.cfg + - update to following externals tags which read deposition data from file: + cmeps0.13.70 + cpl7.0.14 + share1.0.12 (needed by cmeps0.13.70) + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml + - set default dep_data_file filepath + +M bld/namelist_files/namelist_definition.xml + - new namelist variable "dep_data_file" added to drydep_inparm in drv_flds_in + +M cime_config/config_pes.xml + - bump up number of default MPI tasks for WACCMX on f09 grid + +M cime_config/testdefs/testlist_cam.xml + - move QPX2000 ne5pg3 aux_cam test back to izumi nag + - use 384x3 pelay for f09 waccmx_weimer test on cheyenne + - move FW4madSD f19 aux_cam test to izumi gnu + +M cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/shell_commands + - set ROF_NCPL to match $ATM_NCPL + +M src/chemistry/mozart/mo_chemini.F90 + - remove obsolete DD_XLND and drydep_method references + +M src/chemistry/mozart/mo_drydep.F90 + - replace seq_drydep_mod with shr_drydep_mod + +M src/chemistry/mozart/mo_neu_wetdep.F90 + - replace seq_drydep_mod with shr_drydep_mod + - use pi defined in shr_const_mod + - use 2 dimensional dheff array (defined in seq_drydep_mod) + +M src/control/camsrfexch.F90 +M src/cpl/mct/cam_cpl_indices.F90 + - replace seq_drydep_mod with shr_drydep_mod + - remove obsolete use of lnd_drydep logical + +M src/cpl/mct/atm_import_export.F90 + - replace seq_drydep_mod with shr_drydep_mod + +M src/cpl/nuopc/atm_comp_nuopc.F90 + - read surf fields namelists regardless of presence of mediator + +M src/cpl/nuopc/atm_import_export.F90 + - add "read_surface_fields_namelists" routine + -- this seperates the read namelists from the advertise step which wont + happen if there is no mediator (as in a PORT configuration) + +M src/ionosphere/waccmx/edyn_init.F90 + - Corrections to coordinate maps for geomagnetic and ion transport (oplus grid) grids. + This became a problem with PIO 2.5.7 on izumi built with nag compiler. + +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. + +cheyenne/intel/aux_cam: + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: NLFAIL) details: + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ld3_Vmct.f09_f09_mg17.HIST_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: NLFAIL) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: NLFAIL) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: NLFAIL) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: NLFAIL) details: + SMS_Ln9_Vmct.f09_f09_mg17.1850_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: NLFAIL) details: + - namelist compare failures due to new dep_data_file in drv_flds_in -- otherwise b4b + +izumi/nag/aux_cam: + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae NLCOMP + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + PEND DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + - namelist compare failures due to new dep_data_file in drv_flds_in -- otherwise b4b + + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s NLCOMP + FAIL SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_070_nag: ERROR BFAIL baseline directory '/fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_070_nag/SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s' does not exist + - moved from cheyenne_intel + +izumi/gnu/aux_cam: + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + - namelist compare failures due to new dep_data_file in drv_flds_in -- otherwise b4b + + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s NLCOMP + FAIL SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_070_gnu: ERROR BFAIL baseline directory '/fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_070_gnu/SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s' does not exist + - moved from izumi_nag + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_070 +Originator(s): sacks, cacraig +Date: July 15, 2022 +One-line Summary: Update CTSM tag to dev103 - bug fix tag +Github PR URL: https://github.com/ESCOMP/CAM/pull/622 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Bring in CTSM bug fix tag when it is ready : https://github.com/ESCOMP/CAM/issues/616 + +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: Reviews waived due to nature of changes + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update CTSM external + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + - some answer changes expected due to CTSM update + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + - pre-existing failure + +izumi/gnu/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name:cam6_3_069 +Originator(s): cacraig +Date: July 14, 2022 +One-line Summary: Update CTSM external to ctsm5.1.dev102 +Github PR URL: https://github.com/ESCOMP/CAM/pull/621 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update CTSM externals to ctsm5.1.dev102: https://github.com/ESCOMP/CAM/issues/620 + +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: Reviews waived due to nature of changes + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Update CTSM external to ctsm5.1.dev102 + +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. + +cheyenne/intel/aux_cam: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vmct.f09_f09_mg17.HIST_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vmct.f09_f09_mg17.1850_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - answer changes due to CTSM update + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + PEND DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - preexisting failure + + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s NLCOMP + FAIL SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_06 + - answer changes due to CTSM update + +izumi/gnu/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_068 +Originator(s): cacraig +Date: July 14, 2022 +One-line Summary: Update externals to match cesm2_3_alpha09c +Github PR URL: https://github.com/ESCOMP/CAM/pull/618 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update externals to match cesm2_3_alpha09c: https://github.com/ESCOMP/CAM/issues/617 + - Did not advance FMS external as it caused an issue + - Moved cime forward to cime6.0.46 + +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: Reviews waived due to nature of changes + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update externals to match cesm2_3_alpha09c with exceptions noted above + +M cime_config/testdefs/testlist_cam.xml + - moved test from izumi to cheyenne due to unexplained failure. Was investigated by + Francis Vitt, Chris Fischer, Cheryl Craig, and Steve Goldhaber before making this move. + +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. + +cheyenne/intel/aux_cam: all BFB except: + Moved test from izumi so no baseline comparison: SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.cheyenne_intel.cam-outfrq3s + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=220 + PEND DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - preexisting failure + + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: FAIL) details: + FAIL SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s RUN time=252 + - after various tests were run by multiple SEs, this test was moved to cheyenne + + +izumi/gnu/aux_cam: all BFB + +=============================================================== + +Tag name: cam6_3_067 +Originator(s): fvitt +Date: 8 Jul 2022 +One-line Summary: Move chemistry preprocessor external to github repository +Github PR URL: https://github.com/ESCOMP/CAM/pull/609 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Address issue #607 + -- Migrate the chemistry preprocessor repository to github + +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, peverwhee, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_chemproc/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_chemproc/test_mech.in +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_chemproc/user_nl_cam + - for preprocessor regression test + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - point chem_proc to github repository + +M cime_config/testdefs/testlist_cam.xml + - include test for chemistry preprocessor + +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. + +cheyenne/intel/aux_cam: not run + +izumi/nag/aux_cam: not run + +izumi/gnu/aux_cam: + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + FAIL SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc NLCOMP + FAIL SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_066_gnu: ERROR BFAIL baseline directory '/fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_066_gnu/SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc' does not exist + - new test for chemistry preprocessor + +=============================================================== +=============================================================== + +Tag name: cam6_3_066 +Originator(s): adamrher, cacraig +Date: July 7, 2022 +One-line Summary: cam-clubb interface cleanup and misc bug fixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/598/files + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + CLUBB/CAM interface bug fixes: https://github.com/ESCOMP/CAM/issues/336 + scale sensible heat fluxes in CLUBB by exner function: https://github.com/ESCOMP/CAM/issues/496 + Add diagnostics: CLUBB energy fixer and DQCORE: https://github.com/ESCOMP/CAM/issues/497 + Inline calculation of IVT for AR detection: https://github.com/ESCOMP/CAM/issues/536 + moving CLUBB pdf closure to after advancing the CLUBB equations: https://github.com/ESCOMP/CAM/issues/582 + default clubb_timestep's needlessly small for hi-res: https://github.com/ESCOMP/CAM/issues/604 + Fix to prevent CLDTOP/CLDBOT pbuf variables from crossing: https://github.com/ESCOMP/CAM/issues/605 + + This PR is a continuation of a previous PR: + bugfixes/cleanup clubb_intr, output physics timesteps to log: https://github.com/ESCOMP/CAM/pull/352 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + removed small clubb_timestep values from defaults + changed default for clubb_ipdf_call_placement +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: goldy, nusbaumer, courtneyp, bstephens82 + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/namelist_defaults_cam.xml + namelist defaults described above +M cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam + removed SL vairable from silhs test +M src/physics/cam/cam_diagnostics.F90 + added AR detection iVT variables +M src/physics/cam/check_energy.F90 + added DQCORE diagnostic +M src/physics/cam/clubb_intr.F90 + substantial cleanup and misc bug fixes +M src/physics/cam/convect_shallow.F90 + fix to prevent CLDTOP/CLDBOT diagnostic from crossing +M src/physics/cam/physpkg.F90 + added DQCORE diagnostic +M src/physics/cam/subcol_SILHS.F90 + changed name of RTM_CLUBB/THLM_CLUBB vars in SILHS; introduced these var names in clubb_intr +M src/physics/cam_dev/convect_diagnostics.F90 + fix to prevent CLDTOP/CLDBOT diagnostic from crossing +M src/physics/cam_dev/physpkg.F90 + added DQCORE diagnostics, moved stuff into tphysac_init + +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. + +cheyenne/intel/aux_cam: all BFB except: + + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + - changed namelist setting + + FAIL ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_Ld3_Vmct.f09_f09_mg17.HIST_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_Ln9_Vmct.f09_f09_mg17.1850_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + FAIL SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_065: DIFF + - Tests have changed namelist setting and expected answer changes + + +izumi/nag/aux_cam: all BFB except: + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=9 + - pre-existing failure + + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_065_nag: DIFF + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_065_nag: DIFF + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_065_nag: DIFF + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_065_nag: DIFF + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_065_nag: DIFF + FAIL ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_065_nag: DIFF + FAIL ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_065_nag: DIFF + FAIL ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_065_nag: DIFF + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_065_nag: DIFF + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_065_nag: DIFF + FAIL SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_065_nag: DIFF + - Tests have changed namelist setting and expected answer changes + +izumi/gnu/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_065 +Originator(s): cacraig, juliob, jedwards +Date: July 1, 2022 +One-line Summary: Bug fix for contrail, cam_snapshot and SE dycore writes with gravity wave diagnostic enhancements +Github PR URL: Misc tag for Gravity Wave, contrail, cam_snapshot and SE dycore writes: https://github.com/ESCOMP/CAM/pull/612 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +issues: + - ERP_D_Ln9.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s_contrail does not run for cesm2_3_alpha02d: https://github.com/ESCOMP/CAM/issues/362 + - Correct logic for log print statement: https://github.com/ESCOMP/CAM/issues/610 + - Fix cam_snapshot: https://github.com/ESCOMP/CAM/issues/606 + +PRs merged in: + - Fix for contrail when G <= 0.0.053 and update contrail compset: https://github.com/ESCOMP/CAM/pull/535 + - more GW diags: https://github.com/ESCOMP/CAM/pull/447 + +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: goldy, courtneyp, nusbaume, jtruesdal + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M cime_config/testdefs/testlist_cam.xml + - Update contrail regression test + +M src/control/cam_snapshot_common.F90 + - Fix cam_snapshot (assign snapshot unit numbers to module level variables) + +M src/dynamics/se/dycore/global_norms_mod.F90 + - Remove unneeded print statement and limit others to masterproc + +M src/physics/cam/gw_common.F90 +M src/physics/cam/gw_drag.F90 +M src/physics/cam/gw_rdg.F90 + - Add additional diagnostics to orographic GW parameterization + +M src/physics/cam/ssatcontrail.F90 + - fix for contrail when G <= 0.053 + +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. + +cheyenne/intel/aux_cam: all BFB + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=239 + - preexisting failure + +izumi/gnu/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_064 +Originator(s): fvitt +Date: 14 Jun 2022 +One-line Summary: Improvements to WACCMX AMIE/LTR high-latitiude potential input readers +Github PR URL: https://github.com/ESCOMP/CAM/pull/596 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + WACCMX LTR/GAMERA input reader assumes grid size #592 + WACCMX time interpolation fix for multiple day AMIE input file #562 + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: cacraigucar, nusbaume, peverwhee, gold2718 + +List all files eliminated: NA + +List all files added and what they do: NA + +List all existing files that have been modified, and describe the changes: + +M src/chemistry/utils/input_data_utils.F90 + - added times_check utility + - added capability to use year, month, day, and ut (fractional hour) + for the time coordinate + +M src/ionosphere/waccmx/amie_module.F90 + - use time_coordinate util for time interpolations + +M src/ionosphere/waccmx/ltr_module.F90 + - use time_coordinate util for time interpolations + - read grid dimension sizes from input file + +M cime_config/testdefs/testlist_cam.xml +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_ltr/shell_commands + - adjustments to LTR waccmx tests + +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. + +cheyenne/intel/aux_cam: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_063: DIFF + - expected failure due to changes in AMIE input reader + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - preexisting failure + +izumi/gnu/aux_cam: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: bit-for-bit unchanged except for WACCMX with AMIE or LTR/GAMERA inputs + +=============================================================== +=============================================================== + +Tag name: cam6_3_063 +Originator(s): cacraig, andrew +Date: June 6, 2022 +One-line Summary: Adds number tendencies, cleans up numerics and changes immersion freezing back to Bigg formulation used in CAM5 +Github PR URL: PUMAS updates and fixes: https://github.com/ESCOMP/CAM/pull/597 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - PUMAS Microphyiscs Updates and Fixes: https://github.com/ESCOMP/CAM/issues/593 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: + - Change defaults for cam_dev runs as follows: + - clubb_detice_rad = 61.0D-6 + - micro_mg_precip_fall_corr = .true. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: courtney, nusbaume, katec, adamrher, goldy + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - Update to bring in latest changes in PUMAS external + +M bld/namelist_files/namelist_defaults_cam.xml + - Change default for clubb_detice_rad and micro_mg_precip_fall_corr for cam_dev runs + +M cime_config/testdefs/testlist_cam.xml + - Added tests so that three cam_dev configurations are tested at aux_cam and prealpha levels + +M src/physics/cam_dev/micro_pumas_cam.F90 + - Changes as described in one-line summary + +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. + +cheyenne/intel/aux_cam: all BFB except: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + - Answer changes for cam_dev runs + + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + - No prexisting baselines as these are new tests + +izumi/nag/aux_cam: all BFB except: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - Pre-existing failure + +izumi/gnu/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_062 +Originator(s): fvitt, bardeenc +Date: 31 May 2022 +One-line Summary: Fix for ERA5 driven Specified Dynamics +Github PR URL: https://github.com/ESCOMP/CAM/pull/555 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Fix for SD code to allow use of ERA5 data #207 + +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, peverwhee + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M src/dynamics/fv/metdata.F90 + - check ice fraction for fill value + +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. + +cheyenne/intel/aux_cam: All PASS + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - preexisting failure + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name:cam6_3_061 +Originator(s):manderberg +Date: 26 May 2022 +One-line Summary: Advance the CARMA_base tag used by CAM to CARMA4.00 +Github PR URL: https://github.com/ESCOMP/CAM/pull/575 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + - Advance the CARMA_base tag used by CAM to CARMA4.00 #561 + +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, nusbaume, peverwhee, fvitt + +List all files eliminated: N/A + +List all files added and what they do: + +A src/physics/carma/base/hygroscopicity.F90 + - calculates aerosol hygroscopicity + A src/physics/carma/base/coremasscheck.F90 + - checks if the coremass exceeds the total + + +List all existing files that have been modified, and describe the changes: + +M cime_config/testdefs/testlist_cam.xml + - Changed carma_pmc test from ERC to ERS to get around failure possibly caused by NUOPC coupler +M src/physics/carma/models/test_growth/carma_model_mod.F90 + - replaced q(:, 1) with q(:, plev/4) in lines 436 and 441 + - replaced 100e-9_r8 with 100e-7_r8 in line 436 + + +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. + +cheyenne/intel/aux_cam: ALL PASS + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - preexisting failure + +izumi/gnu/aux_cam: ALL PASS + +=============================================================== +=============================================================== + +Tag name: cam6_3_060 +Originator(s): fvitt +Date: 24 May 2022 +One-line Summary: Corrections to WACCMX conductance diagnostics; updates to fire emissions factors +Github PR URL: https://github.com/ESCOMP/CAM/pull/550 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + - Updates to fire emissions factors #503 + - After updating to cism2_1_76 or later, change compsets involving CISM #340 + - WACCMX Hall and Pedersen conductances #547 + +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, nusbaume, peverwhee + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +M bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml +M bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml +M bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml +M bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml +M bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml + - replace 'EDYN_ZIGM11_PED' and 'EDYN_ZIGM2_HAL' with 'PED_CONDUCTANCE' and 'HALL_CONDUCTANCE' + +M bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml + - update fire emissions namelist settings + +M cime_config/config_compsets.xml + - replace CISM2 with SGLC in MAM5 compsets + +M src/ionosphere/waccmx/edyn_init.F90 + - replace 'EDYN_ZIGM11_PED' and 'EDYN_ZIGM2_HAL' with 'PED_CONDUCTANCE' and 'HALL_CONDUCTANCE' + +M src/ionosphere/waccmx/edyn_mpi.F90 + - increase MPI buffer size + +M src/ionosphere/waccmx/edynamo.F90 + - changes for conductance diagnostics + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_059: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_059: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_059: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_059: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_059: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_059: FIELDLIST field lists differ (otherwise bit-for-bit) + - change in history fields -- otherwise bit-for-bit + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - preexisting failure + + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_059_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + - change in history fields -- otherwise bit-for-bit + +izumi/gnu/aux_cam: All PASS + +Summarize any changes to answers: FCfireHIST, F2000mam5, and FW2000mam5 have larger than roundoff answer changes, + otherwise bit-for-bit unchanged + +=============================================================== +=============================================================== +Tag name: cam6_3_059 +Originator(s): katec,vlarson,huebleruwm,adamrher +Date: 20 May 2022 +One-line Summary: Bringing in the new CLUBB and SILHS Externals. Fixes #515 #467 #461 #572 +Github PR URLs: + https://github.com/ESCOMP/CAM/pull/545 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update to more recent CLUBB code including the inverse taus science and prognostic momentum improvements. + (https://github.com/ESCOMP/CAM/issues/515) + - Add new CLUBB invrs_tau coefs to be set via namelist (https://github.com/ESCOMP/CAM/issues/467) + - DP_FRAC and SH_FRAC not initialized in clubb_intr (https://github.com/ESCOMP/CAM/issues/461) + - CAM crashes when run with SILHS using SE core (https://github.com/ESCOMP/CAM/issues/572) + +Describe any changes made to build system: + + - Changes the source of the CLUBB and SILHS external repos from NCAR managed github repos to UWM public release + repos using svn to pull only specific source code directories (changes in Externals_CAM.cfg) + +Describe any changes made to the namelist: + +- Add mechanism to set default values for several namelist values based on the value of clubb_Lscale_from_tau + in build-namelist +- Added: clubb_do_energyfix, clubb_l_diag_Lscale_from_tau, clubb_C_wp3_pr_turb, clubb_c_K1, clubb_c_K2, clubb_nu2, + clubb_c_K8, clubb_up2_sfc_coef, clubb_ipdf_call_placement, clubb_l_lmm_stepping, clubb_l_e3sm_config, + clubb_l_godunov_upwind_wpxp_ta, clubb_l_godunov_upwind_xpyp_ta, clubb_l_use_shear_Richardson, + clubb_l_use_tke_in_wp3_pr_turb_term, clubb_l_use_tke_in_wp3_pr_turb_term, clubb_l_use_tke_in_wp2_wp3_K_dfsn, + clubb_l_smooth_Heaviside_tau_wpxp, clubb_l_do_expldiff_rtm_thlm, clubb_l_do_expldiff_rtm_thlm, + clubb_C_invrse_tau_bkgnd, clubb_C_invrs_tau_sfc, clubb_C_invrs_tau_shear, clubb_C_invrs_tau_N2, + clubb_C_invrs_tau_N2_wp2, clubb_C_invrs_tau_N2_xp2, clubb_C_invrs_tau_N2_wpxp, + clubb_C_invrs_tau_N2_clear_wp3, clubb_l_use_tke_in_wp3_pr_turb_term, + clubb_l_use_tke_in_wp2_wp3_K_dfsn, clubb_l_smooth_Heaviside_tau_wpxp +- Removed: clubb_expldiff, clubb_up2_vp2_factor, clubb_l_use_ice_latent +- Updated/fixed descriptions or changed default values for: clubb_C_uu_shr, clubb_C_uu_buoy, clubb_l_min_wp2_from_corr_wx, + clubb_l_min_xp2_from_corr_wx, clubb_c14 (silhs only), clubb_l_damp_wp2_using_em, subcol_silhs_l_lh_importance_sampling, + subcol_silhs_l_Lscale_vert_avg, subcol_silhs_l_lh_straight_mc, subcol_silhs_l_lh_clustered_sampling, + subcol_silhs_l_rcm_in_cloud_k_lh_start, subcol_silhs_l_random_k_lh_start, subcol_silhs_l_max_overlap_in_cloud, + subcol_silhs_l_lh_instant_var_covar_src, subcol_silhs_l_lh_limit_weights, subcol_silhs_l_lh_var_frac, + subcol_silhs_l_lh_normalize_weights, clubb_c_K9, clubb_nu9, clubb_wpxp_L_thresh, clubb_gamma_coef, + clubb_C_wp2_splat, clubb_l_call_pdf_closure_twice, clubb_l_rcm_supersat_adj, clubb_l_trapezoidal_rule_zt, + clubb_l_use_cloud_cover, clubb_l_use_thvm_in_bv_freq, clubb_l_vert_avg_closure, clubb_l_damp_wp2_using_em + + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: + No memory or compute time changes large enough to fail a compare test. TPUTCOMP changes between + +9.87% and -17.23% in cheyenne aux_cam test suite. + +Code reviewed by: gold2718, adamrher, huebleruwm, bstephens82, sjsprecious, zarzycki, cacraigucar, vlarson, + peverwhee, nusbaume + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + - Externals_CAM.cfg: Point to new external code for src/physics/clubb and src/physics/silhs + - bld/build-namelist: Add method for setting defaults of many clubb namelist variables based on the value of + clubb_l_diag_Lscale_from_tau. Add default listing for new namelist parameters. + - bld/namelist_files/namelist_defaults_cam.xml: Updates and defaults for new namelist parameters. + - bld/namelist_files/namelist_definition.xml: Updates, typo fixes, better descriptors, and new entries for + new namelist values. + - cime_config/testdefs/testlist_cam.xml: Change mpasa480 test from izumi-intel to cheyenne-intel + - cime_config/testdefs/testmods_dirs/cam/silhs/user_nl_cam: Change output field wp3_bp2 to wp3_pr_turb + - src/physics/cam/clubb_intr.F90: All of the modifications for the new external, new namelist parameters, + updates to clubb_stats arrays, adding support for b4b restarts in pdf_post_placement, other code + refactoring changes. + NOTE: I attempted to add stat checks to all of the allocate calls in clubb_intr but found two nag + tests failed due to NaN values in state%q after this. This is just completely mystifying, and + likely some kind of compiler issue that may work its way out in the future. + - src/physics/cam/physpkg.F90: Check for use_subcol_microp and add init_state_subcol call for silhs + - src/physics/cam/subcol_SILHS.F90: update namelist variable names, new calls for api updates, some + refactoring, add init state subcol function, more bad configuration checks + - src/physics/cam_dev/physpkg.F90: Check for use_subcol_microp and add init_state_subcol call for silhs + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All tests pass with the exception of the following expected differences: + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - Known/Existing Failure + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s (Overall: DIFF) + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) + - Namelist and baseline changes due to new CLUBB code + +izumi/gnu/aux_cam: + All Pass + +cheyenne/intel/aux_cam: + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ld3_Vmct.f09_f09_mg17.HIST_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) + SMS_Ln9_Vmct.f09_f09_mg17.1850_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) + - Expected namelist and baseline answer changes due to new CLUBB code + + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) + - FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_058_caccopy: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_058_caccopy/ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480' does not exist + + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) + - Differences due to new and changed CLUBB namelist variables + +Summarize any changes to answers: + Any compset that invokes CLUBB and/or SILHS code will see answer changes. The new parameterizations are not fully tuned and likely to degrade climate somewhat at this point. + +=============================================================== +Tag name: cam6_3_058 +Originator(s): pel,duda,aherington,neale,jet +Date: 16 May 2022 +One-line Summary: High priority science updates for mom6 coupled runs and bug fixes for issues #506 #530 #543 #551 #563 +Github PR URLs: + https://github.com/ESCOMP/CAM/pull/590 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Noise in derived quantities in ne30pg3 configuration (https://github.com/ESCOMP/CAM/issues/551) + - nvfortran fails to compile MPAS-A dycore due to generic operator interface issues (https://github.com/ESCOMP/CAM/issues/563) + - Divide-by-zero bug on cam_dev L58 grid when DEBUG=TRUE (https://github.com/ESCOMP/CAM/issues/543) + - bug: sponge layer extends to surface in low top (z=~10km) setup (https://github.com/ESCOMP/CAM/issues/530) + - F2000dev bombs out for finite-volume dycores (FV and FV3) (https://github.com/ESCOMP/CAM/issues/506) + - High priority updates needed for science runs (https://github.com/NCAR/amwg_dev/issues/98#issuecomment-1094076161) + +Describe any changes made to build system: + + - The MPAS-A dycore Makefile (src/dynamics/mpas/Makefile) has been updated to + remove references to the mpas_field_accessor module, which no longer exists + in the current MPAS 'develop' branch. + +Describe any changes made to the namelist: + - Removed se_hypervis_dynamic_ref_state + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: TBD + +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: + +* Externals_CAM.cfg + - Update [mpas] external to latest commit on the MPAS 'develop' branch, which + includes a change to mpas_atm_boundaries.F to correct a build issue with + certain versions of the nvhpc compilers. + +* src/dynamics/mpas/Makefile + - Remove references to the mpas_field_accessor.F file, which no longer exists + in the MPAS 'develop' branch + +* src/dynamics/mpas/driver/cam_mpas_subdriver.F90 + - To resolve build errors with certain version of the nvhpc compilers, + explicitly import specific implementations of two operators from the + mpas_timekeeping module. The new 'use' statement is only active when the + __NVCOMPILER macro is defined. + +* src/dynamics/se/dycore/fvm_mapping.F90 + - map PHIS from GLL to physics grid in dp_coupling + +* src/physics/cam/zm_conv.F90 + - fix for ZM parcel wrt issue ESCOMP#543 + +* bld/build-namelist +* bld/namelist_files/namelist_defaults_cam.xml +* bld/namelist_files/namelist_definition.xml +* src/dynamics/se/dycore/dimensions_mod.F90 +* src/dynamics/se/dycore/element_mod.F90 +* src/dynamics/se/dycore/prim_advance_mod.F90 +* src/dynamics/se/dycore/prim_driver_mod.F90 +* src/dynamics/se/dycore/viscosity_mod.F90 + - high priority fix for science runs (mom6 coupled) + (justification https://github.com/NCAR/amwg_dev/issues/98#issuecomment-1094076161) + topo modifications: remove dynamic reference state, + change viscosity and pre-compute reference profiles, + print better profile data to logfile + +* src/dynamics/se/dycore/global_norms_mod.F90 +* src/dynamics/se/dyn_comp.F90 + - Sponge should just be active in top 3 layers for low top applications + +* src/physics/cam_dev/physpkg.F90 + - replace inadvertently deleted line converting dry mixing ratios to wet + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +All tests pass with the exception of the following expected differences: + +cheyenne/intel/aux_cam: + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + - baseline differences in SE regression tests expected due to #551 + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - Known/Existing Failure + + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: DIFF) + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) + - baseline differences in SE regression tests expected due to #551 + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) + - baseline differences in SE regression tests expected due to #551 + +Summarize any changes to answers: SE dycore answers will change due to #551 as SE PHIS updates + are used in prognostic calculations. + +=============================================================== + +Tag name: cam6_3_057 +Originator(s): cacraig, katec +Date: May 8, 2022 +One-line Summary: Remove pack/unpack capabilities from PUMAS and update CICE6 external +Github PR URL: https://github.com/ESCOMP/CAM/pull/580 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Remove pack/unpack from PUMAS interface code #254: https://github.com/ESCOMP/CAM/issues/254 + - SCAM with CICE does not run with NUOPC #591: https://github.com/ESCOMP/CAM/issues/591 + +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: goldy, courtneyp, nusbaume, katec, gettelman + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Update CICE6 tag to bring in fix for SCAM runs using NUOPC + +M cime_config/SystemTests/sct.py + - whitespace change only due to merge (just left it in) + +M src/physics/cam/micro_pumas_cam.F90 +M src/physics/cam_dev/micro_pumas_cam.F90 + - Remove pack/unpack PUMAS capabilities from the interface layer + +M src/physics/cam/nucleate_ice.F90 + - Initalize nuic to zero per recommendation by Andrew Gettelman + +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. + +cheyenne/intel/aux_cam: + + Namelist changes due to CICE6 for all tests run with CICE6: "Found extra namelist: icefields_fsd_nml" + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vmct.f09_f09_mg17.HIST_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vmct.f09_f09_mg17.1850_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + + - non-climate changing answer changes due removing the pack/unpack from PUMAS interface code + +izumi/nag/aux_cam: + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=10 + - Preexisting failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + - non-climate changing answer changes due removing the pack/unpack from PUMAS interface code + +izumi/gnu/aux_cam: + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_056_gnu: DIFF + + - non-climate changing answer changes due removing the pack/unpack from PUMAS interface code + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: All CAM6 runs using PUMAS +- what platforms/compilers: all +- nature of change (roundoff; larger than roundoff but same climate; new + climate): larger than roundoff, but same climate + - Validated by running ensemble consistency tests and a simulation. Both are documented in the PR at https://github.com/ESCOMP/CAM/pull/580 + +=============================================================== + +Tag name: cam6_3_056 +Originator(s): peverwhee +Date: 29 April 2022 +One-line Summary: Update externals to support CICE6 +Github PR URL: https://github.com/ESCOMP/CAM/pull/581 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- Update to cesm2_3_alpha09a externals (https://github.com/ESCOMP/CAM/issues/565) +- CIME update needed for running the pumas codes on GPU and introduce a GPU + regression test suite (https://github.com/ESCOMP/CAM/issues/512) +- F2000climo using C96 grid crashes intermittently (https://github.com/ESCOMP/CAM/issues/573) +- Failing SCT test (https://github.com/ESCOMP/CAM/issues/566) +- PUMAS GPU regression test suite (https://github.com/ESCOMP/CAM/pull/577) +- fixes for SCT tests to pass (https://github.com/ESCOMP/CAM/pull/583) +- SCAM does not work on Izumi with NUOPC driver (https://github.com/ESCOMP/issues/532) +- genf90 moving in cime (https://github.com/ESCOMP/CAM/issues/559) + +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: goldy, cacraig, nusbaume + +List all files eliminated: +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_casper/shell_commands +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_casper/user_nl_cam +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_casper/user_nl_clm + - remove testmods for unused test + +List all files added and what they do: +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg2_default/user_nl_clm +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_default/user_nl_clm +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_nondefault/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_nondefault/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_nondefault/user_nl_clm +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_pcols1536/user_nl_clm + - add testmods for new tests + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update to match cesm2_3_alpha09a tag: + - EXCEPTIONS: + - CMEPS and CDEPS have more recent tags than the alpha tag due to nuopc issues + - ccs_config_cesm has more recent tag to include GPU updates and a CICE-related fix + - CICE also has a more recent tag to fix CICE6 not working with NAG + - cime and share have more recent tags to fix NUOPC/aquaplanaet/SCAM issues +M bld/Makefile.in + - change where Makefile.in is looking for genf90 (changed in CIME) +M cime_config/testdefs/testlist_cam.xml + - use longname for compsets tested with MCT that use CICE since CICE6 doesn't have an MCT cap: + - F2000climo -> 2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV + - FSCAM -> 2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV + - FW1850 -> 1850_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV + - FWHIST -> HIST_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV + - add GPU tests for PUMAS on casper + - remove duplicate MCT tests for SCAM/aquaplanet because NUOPC now works +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3/shell_commands + - increase NTASKS for C96 grid that is crashing intermittently +M cime_config/SystemTests/sct.py + - fix failing SCT test +M src/cpl/nuopc/atm_comp_nuopc.F90 + - remove comment +M src/cpl/nuopc/atm_import_export.F90 + - introduce samegrid_atm_lnd_ocn variable to set flux correction factor (fix for aquaplanet/SCAM) +M test/system/test_driver.sh + - add casper-specific testing +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vmct.f09_f09_mg17.HIST_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vmct.f09_f09_mg17.1850_CAM60%WCTS_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - baseline/namelist failures due to externals updates + +izumi/nag/aux_cam: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + - baseline/namelist failures due to externals updates + + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - existing failure + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + - baseline/namelist failures due to externals updates + +=============================================================== + +Tag name:cam6_3_055 +Originator(s): peverwhee +Date: 6 April 2022 +One-line Summary: Transition tests to NUOPC +Github PR URL: https://github.com/ESCOMP/CAM/pull/556 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- Transition tests to NUOPC (https://github.com/ESCOMP/CAM/issues/423) +- Typo in te_map.F90 (https://github.com/ESCOMP/CAM/issues/422) +- SCAM does not work on Izumi with NUOPC driver (https://github.com/ESCOMP/CAM/532) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: goldy, cacraig, nusbaume + +List all files eliminated: +D cime_config/testdefs/testmods_dirs/cam/idphys/shell_commands +D cime_config/testdefs/testmods_dirs/cam/idphys/user_nl_cam +D cime_config/testdefs/testmods_dirs/cam/idphys/user_nl_clm +D cime_config/testdefs/testmods_dirs/cam/idphys/user_nl_cpl + - removing testmods directory idphys because it is no longer used by + any tests + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update to later ccs_config and cmeps tags + - update to cime branch tag cime6.0.15_scam which contains a fix + for SCAM in aquaplanet cases for NUOPC, but not the cice updates +M doc/Changelog_template + - change "pgi" to "gnu" +M cime_config/SystemTests/sct.py + - only set PTS_MODE if using MCT +M cime_config/SystemTests/tmc.py + - update so atmlog is found with nuopc driver (no cpl log) +M cime_config/testdefs/testlist_cam.xml + - transition all existing tests to NUOPC driver + - duplicate the following tests with MCT: + - ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s + - ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s + - ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf + - ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s + - ERC_D_Ln9_Vmct.f10_f10_mg37.FHS94.izumi_nag.cam-idphys + - ERC_D_Ln9_Vmct.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase + - ERC_D_Ln9_Vmct.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase + - SMS_D_Ln9_Vmct.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s + - SMS_Ln9_Vmct.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s + - ERP_Ld3_Vmct.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/shell_commands + - increase NTASKS and decrease MAX_MPITASKS_PER_NODE for NUOPC runs +M src/cpl/nuopc/atm_comp_nuopc.F90 + - enable single column aquaplanet to run with NUOPC +M src/dynamics/fv/te_map.F90 + - fix typo: NSPLTVRM -> FV_NSPLTVRM +M src/ionosphere/waccmx/dpie_coupling.F90 + - move t_startf call inside if statement to satisfy NUOPC +M test/system/test_driver.sh + - remove default xml_driver so test_driver run without specifying the driver will run both NUOPC and MCT tests + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - namelist and baseline failures resulting from switch to NUOPC driver + + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: FAIL) details: + - Aquaplanet SCAM failure + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - preexisting failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: PASS) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + - namelist and baseline differences resulting from switch to NUOPC driver + + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: FAIL) details: + - Aquaplanet SCAM failure + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase: (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Lin9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + - namelist and baseline failures resulting from switch to NUOPC driver + + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: FAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: FAIL) details: + - Aquaplanet SCAM failures + + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: FAIL) details: + - failure due to incorrect mesh file name; to be fixed in future tag + +=============================================================== + +Tag name:cam6_3_054 +Originator(s): cacraig +Date: 3/23/2022 +One-line Summary: Update externals to match cesm2_3_beta08 +Github PR URL: https://github.com/ESCOMP/CAM/pull/549 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- Update externals to match cesm2_3_beta08 (https://github.com/ESCOMP/CAM/issues/548 +- Update all STARTDATE fields from year 0000 to 0001 (https://github.com/ESCOMP/CAM/issues/553) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: goldy, courtneyp, nusbaume, fvitt + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update externals to match cesm2_3_beta08 + +M cime_config/testdefs/testmods_dirs/cam/idphys/shell_commands +M cime_config/testdefs/testmods_dirs/cam/outfrq24h_port/shell_commands +M cime_config/testdefs/testmods_dirs/cam/outfrq3s_eoyttrac/shell_commands +M cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/shell_commands +M cime_config/testdefs/testmods_dirs/cam/scm_prep/shell_commands +M cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/shell_commands +M cime_config/testdefs/testmods_dirs/cam/silhs/shell_commands +M cime_config/testdefs/testmods_dirs/cam/terminator/shell_commands +M cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal0/shell_commands +M cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal1/shell_commands +M cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal3/shell_commands + - Change STARTDATE to year 0001 from 0000 which it had been previously + + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9_Vmct.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: DIFF) details: + ERP_D_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vmct.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vmct.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_Vmct.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vmct.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vmct.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_Vmct.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vmct.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vmct.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SCT_D_Ln7_Vmct.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ln9_Vmct.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vmct.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vmct.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vmct.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vmct.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + SMS_D_Ln9_Vmct.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vmct.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vmct.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13_Vmct.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vmct.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vmct.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vmct.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - Namelist and baseline failures due to updating externals + +izumi/nag/aux_cam: + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - Preexisting failure + + ERC_D_Ln9_Vmct.f10_f10_mg37.FHS94.izumi_nag.cam-idphys (Overall: DIFF) details: + ERC_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + PLB_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ld2_Vmct.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: DIFF) details: + SMS_D_Ln7_Vmct.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) details: + SMS_P48x1_D_Ln9_Vmct.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + TMC_D_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + - Namelist and baseline failures due to updating externals + + +izumi/pgi/aux_cam: + ERC_D_Ln9_Vmct.f10_f10_mg37.FHS94.izumi_nag.cam-idphys (Overall: DIFF) details: + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7_Vmct.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7_Vmct.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + - Namelist and baseline failures due to updating externals + + +=============================================================== +=============================================================== + +Tag name: cam6_3_053 +Originator(s): peverwhee +Date: 17 March 2022 +One-line Summary: Transition izumi PGI tests to GNU compiler +Github PR URLs: https://github.com/ESCOMP/CAM/pull/541 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + Transition PGI tests to GNU #539 + Migrate the following tests from PGI to GNU: + - all aux_cam pgi tests + - prebeta cheyenne pgi test + - waccmx izumi pgi test + - fv3_cam izumi pgi test + +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, 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 cime_config/testdefs/testlist_cam.xml + - change "pgi" to "gnu" for above tests + +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. + +cheyenne/intel/aux_cam: not run + +izumi/nag/aux_cam: not run + +izumi/gnu/aux_cam: + + ERC_D_Ln9_Vmct.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: DIFF) details: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERC_D_Ln9_Vmct.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vmct.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vmct.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vmct.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_Ln9_Vmct.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PEM_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7_Vmct.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7_Vmct.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln9_Vmct.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + - NLCOMP failures because of case_name change (izumi_gnu instead of izumi_pgi) + - BASELINE compare differences due to compiler change +Summarize any changes to answers: small answer changes due to compiler change + +=============================================================== + +Tag name: cam6_3_052 +Originator(s): fvitt +Date: 1 Mar 2022 +One-line Summary: Remove unused chemistry code; reduce memory footprint of SE dycore restarts +Github PR URLs: + https://github.com/ESCOMP/CAM/pull/473 + https://github.com/ESCOMP/CAM/pull/492 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Remove unused dead code related to deprecated xactive_prates (FTUV) photolysis option. + (Duplicate (possibly inconsistent) Lyman-alpha routines in chemistry/mozart #458) + + Remove unused arrays in dry deposition code. + + Reduce memory footprint of SE dycore read restart code. + (Allocatable arrays are not scalable in SE dycore read restart code #472) + +Describe any changes made to build system: na + +Describe any changes made to the namelist: + Removed deprecated namelist variables: + xactive_prates + tuv_xsect_file + o2_xsect_file + +List any changes to the defaults for the boundary datasets: na + +Describe any substantial timing or memory changes: na + +Code reviewed by: gold2718, cacraigucar, peverwhee, nusbaume + +List all files eliminated: + +D src/chemistry/mozart/mo_lymana.F90 +D src/chemistry/mozart/mo_photoin.F90 +D src/chemistry/mozart/mo_seto2.F90 + - dead code + +List all files added and what they do: na + +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 + - removed deprecated namelist variables: + xactive_prates + tuv_xsect_file + o2_xsect_file + +M src/chemistry/mozart/chemistry.F90 +M src/chemistry/mozart/mo_chemini.F90 + - removed deprecated namelist variables: + xactive_prates + tuv_xsect_file + o2_xsect_file + +M src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - removed dead code related xactive_prates photolysis (FTUV) + +M src/chemistry/mozart/mo_photo.F90 + - removed dead code related xactive_prates photolysis (FTUV) + - removed unused dummy arguments to setcol subroutine + +M src/chemistry/mozart/mo_waccm_hrates.F90 + - removed unused actual arguments to setcol subroutine + +M src/chemistry/mozart/mo_jshort.F90 + - note added regarding the correction to the table + +M src/chemistry/mozart/mo_drydep.F90 + - remove dead code: + -- unused vegetation lat lon arrays + - provide string to endrun calls + +M src/dynamics/se/restart_dynamics.F90 + - reduce size of alloacted arrays + - add memory allocate checks + +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. + +cheyenne/intel/aux_cam: + + ERC_D_Ln9_P144x1_Vmct.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ld3_Vmct.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + ERP_Lh12_Vmct.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: NLFAIL) details: + ERP_Ln9_P24x3_Vmct.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: + ERP_Ln9_Vmct.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9_Vmct.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + ERP_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vmct.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vmct.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: NLFAIL) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: NLFAIL) details: + ERS_Ln9_Vmct.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vmct.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SCT_D_Ln7_Vmct.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) details: + SMS_D_Ld2_Vmct.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + SMS_Ld5_Vmct.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_Lm13_Vmct.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: NLFAIL) details: + SMS_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: NLFAIL) details: + SMS_Ln9_Vmct.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + SMS_Ln9_Vmct.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: NLFAIL) details: + - namelist variable xactive_prates removed, otherwise bit-for-bit unchanged + +izumi/nag/aux_cam: + + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vmct.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: + PLB_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SMS_D_Ld2_Vmct.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln3_Vmct.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln7_Vmct.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_P48x1_D_Ln3_Vmct.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) details: + SMS_P48x1_D_Ln9_Vmct.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + SUB_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + TMC_D_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + TMC_D_Vmct.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + - namelist variable xactive_prates removed, otherwise bit-for-bit unchanged + +izumi/pgi/aux_cam: + + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_pgi.cam-outfrq3s_unicon (Overall: NLFAIL) details: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPSPCAMM.izumi_pgi.cam-outfrq3s (Overall: NLFAIL) details: + ERP_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq9s (Overall: NLFAIL) details: + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SCT_D_Ln7_Vmct.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.f10_f10_mg37.QPWmaC4.izumi_pgi.cam-outfrq9s_apmee (Overall: NLFAIL) details: + SMS_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + - namelist variable xactive_prates removed, otherwise bit-for-bit unchanged + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_051 +Originator(s): fvitt +Date: 25 Feb 2022 +One-line Summary: Inline chemical forcings due to medium energy electrons +Github PR URL: https://github.com/ESCOMP/CAM/pull/478 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Inline chemical forcings due to ionization by medium energy electrons #425 + +Describe any changes made to build system: na + +Describe any changes made to the namelist: + + New namelist options: + + mee_ion_inline + Switch to turn on medium energy electron ionization chemical forcings + computed inline using Ap geomagnetic activity index input data. + Default: FALSE + + mee_ion_blc + Bounce cone loss angle (degrees) for medium energy electrons in radiation belts. + Must range from 0 to 90 degrees. + Default: 80 degrees + + mee_ion_diagonly + If TRUE, compute medium energy electron ionization rates only for output to history stream. + Otherwise, apply the ionization rates as forcings to the chemistry. + Default: FALSE + + mee_fluxes_filepath + Filepath input dataset for radiation belt medium energy electrons fluxes incident + on upper atmosphere. + Default: None. + + mee_fluxes_fillin + If TRUE, fill in missing fluxes with computed fluxes based in Ap index using van de Kamp + method. + Default: FALSE + +List any changes to the defaults for the boundary datasets: na + +Describe any substantial timing or memory changes: na + +Code reviewed by: gold2718, cacraigucar, peverwhee, nusbaume + +List all files eliminated: na + +List all files added and what they do: + +A src/chemistry/mozart/mee_ap_util_mod.F90 +A src/chemistry/mozart/mee_fluxes.F90 +A src/chemistry/mozart/mee_ionization.F90 + - for inline MEE calculations + +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_apmee/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mee_fluxes/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mee_fluxes/user_nl_cam + - added tests for inline MEE calculations + +List all existing files that have been modified, and describe the changes: + +M bld/namelist_files/namelist_defaults_cam.xml + - default IC file for waccm-ma aqua-planet 2 degrees + +M bld/build-namelist + - check for MEE inputs consistency + - set default mee_ion_blc (bounce cone loss angle) + +M bld/namelist_files/namelist_defaults_cam.xml + - default mee_ion_blc (bounce cone loss angle) to 80 degrees + - default IC file for 1.9x2.5 aqua-planet waccm-ma + +M bld/namelist_files/namelist_definition.xml + - new namelist options described above + +M src/chemistry/mozart/chemistry.F90 +M src/chemistry/mozart/mo_setext.F90 +M src/chemistry/utils/input_data_utils.F90 + - for inline MEE calculations + +M cime_config/testdefs/testlist_cam.xml + - added tests for inline MEE calculations + - added time limits to some cheyenne aux_cam tests + +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. + +cheyenne/intel/aux_cam: + ERP_Ln9_P24x3_Vmct.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + FAIL ERP_Ln9_P24x3_Vmct.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes NLCOMP + FAIL ERP_Ln9_P24x3_Vmct.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_050: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_050/ERP_Ln9_P24x3_Vmct.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes' does not exist + - new test + +izumi/nag/aux_cam: + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + +izumi/pgi/aux_cam: + SMS_D_Ln9_Vmct.f10_f10_mg37.QPWmaC4.izumi_pgi.cam-outfrq9s_apmee (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f10_f10_mg37.QPWmaC4.izumi_pgi.cam-outfrq9s_apmee NLCOMP + FAIL SMS_D_Ln9_Vmct.f10_f10_mg37.QPWmaC4.izumi_pgi.cam-outfrq9s_apmee BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_050_pgi: ERROR BFAIL baseline directory '/fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_050_pgi/SMS_D_Ln9_Vmct.f10_f10_mg37.QPWmaC4.izumi_pgi.cam-outfrq9s_apmee' does not exist + - new test + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_050 +Originator(s): manderberg +Date: 10 Feb 2022 +One-line Summary: Added CARMA tests and a new CARMA test category to CAM regression testing +Github PR URL: https://github.com/ESCOMP/CAM/pull/505 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + Address github issue: + . Test different CARMA models in current CAM code #420 + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: cacraigucar, cbardeen, fvitt, gold2718, nusbaume, peverwhee, tilmes + +List all files eliminated: + +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_carma/shell_commands +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_carma/user_nl_cam +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_carma/user_nl_clm +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_carma/user_nl_cpl + - remove directory outfrq3s_carma; using CARMA model directories instead + +List all files added and what they do: + +A cime_config/testdefs/testmods_dirs/cam/carma_dust/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_dust/user_nl_clm +A cime_config/testdefs/testmods_dirs/cam/carma_dust/suser_nl_cpl + - testmods for testing the carma dust model + +A cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_meteor_impact/user_nl_cpl + - testmods for testing the carma meteor_impact model + +A cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_meteor_smoke/user_nl_cpl + - testmods for testing the carma meteor_smoke model + +A cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_clm +A cime_config/testdefs/testmods_dirs/cam/carma_mixed_sulfate/user_nl_cpl + - testmods for testing the carma mixed_sulfate model + +A cime_config/testdefs/testmods_dirs/cam/carma_pmc/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_pmc/user_nl_cpl + - testmods for testing the carma pmc model + +A cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_sea_salt/user_nl_cpl + - testmods for testing the carma sea_salt model + +A cime_config/testdefs/testmods_dirs/cam/carma_sulfate/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_clm +A cime_config/testdefs/testmods_dirs/cam/carma_sulfate/user_nl_cpl + - testmods for testing the carma sulfate model + +A cime_config/testdefs/testmods_dirs/cam/carma_test_growth/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_test_growth/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_test_growth/user_nl_cpl + - testmods for testing the carma test_growth model + +A cime_config/testdefs/testmods_dirs/cam/carma_test_passive/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_test_passive/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_test_passive/user_nl_cpl + - testmods for testing the carma test_passive model + +A cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_test_radiative/user_nl_cpl + - testmods for testing the carma test_radiative model + +A cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_test_swelling/user_nl_cpl + - testmods for testing the carma test_swelling model + +A cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_test_tracers/user_nl_cpl + - testmods for testing the carma test_tracers model + +A cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/shell_commands +A cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/carma_test_tracers2/user_nl_cpl + - testmods for testing the carma test_tracers2 model + + +List all existing files that have been modified, and describe the changes: + +M cime_config/config_compsets.xml +- added compset FW4ma2000 + +M cime_config/testdefs/testlist_cam.xml +- added thirteen (13) carma tests to support CARMA development +- added a new carma test suite to support CARMA development + + +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. + +cheyenne/intel/aux_cam: All PASS + +izumi/nag/aux_cam: + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: FAIL) details: + FAIL ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt NLCOMP + FAIL ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt BASELINE + - expected failure, baseline directory does not exist (new test) + +izumi/pgi/aux_cam: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +============================================================================================================================== + +Tag name: cam6_3_049 +Originator(s): fvitt +Date: 7 Feb 2022 +One-line Summary: Misc updates for WACCM-X +Github PR URL: https://github.com/ESCOMP/CAM/pull/474 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Address github issues: + . D-Region ion chemistry in WACCMX not converging #465 + . WACCM-X conductance field seems to have a "hole" over geographic pole #456 + . WACCM-X history fields EX, EY missing Rearth+z factor #455 + . Need to reduce number of WACCMX history fields in the master field list #457 + + Provide more efficient default PE layouts for WACCM-X on cheyenne + +Describe any changes made to build system: + +Describe any changes made to the namelist: + Added new namelist option "ionos_debug_hist" -- + Switch to add history fields to master field list for the purpose + of debugging ionospheric processes in WACCMX. + Default: FALSE + +List any changes to the defaults for the boundary datasets: na + +Describe any substantial timing or memory changes: na + +Code reviewed by: gold2718, cacraigucar, peverwhee, nusbaume + +List all files eliminated: na + +List all files added and what they do: na + +List all existing files that have been modified, and describe the changes: + +M bld/namelist_files/namelist_definition.xml + - add "ionos_debug_hist" option + +M cime_config/config_pes.xml + - more efficient default PE layouts on cheyenne for WACCMX + +M cime_config/testdefs/testlist_cam.xml + - added f05 waccmx test + +M cime_config/testdefs/testmods_dirs/cam/outfrq1d_amie/user_nl_cam + - increase time step splitting for AMIE test + +M cime_config/testdefs/testmods_dirs/cam/outfrq1d_ltr/user_nl_cam + - use updated inputfile (netcdf format) + - increase time step splitting + +M cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cam + - include EX, EY, EZ and some debugging diagnostics in the history stream + +M cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_160x193/user_nl_cam + - include some debugging diagnostics in the history stream + +M cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_320x385/user_nl_cam + - include EX, EY, EZ, ED13D, and ED23D electric field components in the history stream + +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_amie/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_ltr/user_nl_cam + - increase ionos_npes setting + +M src/ionosphere/waccmx/adotv_mod.F90 + - include geographic poles in calculation of adot factors + +M src/ionosphere/waccmx/getapex.F90 + - initialize factors to NaNs to ensure they get properly set at the geographic poles + +M src/ionosphere/waccmx/edynamo.F90 + - corrections to electric field diagnostics EX, EY, EZ + -- output code variables eex, eey, eez + - implement "hist_debug" option for including diagnostics for debugging purposes + +M src/ionosphere/waccmx/dpie_coupling.F90 +M src/ionosphere/waccmx/edyn_init.F90 +M src/ionosphere/waccmx/oplus.F90 + - implement "hist_debug" option for including diagnostics for debugging purposes + - move corresponding addfld calls to same module where outfld calls reside + +M src/ionosphere/waccmx/ionosphere_interface.F90 + - implement "ionos_debug_hist" namelist option + - rearrange initialization order to ensure history grids are defined before fields are + added to history master field list + +M src/chemistry/pp_waccm_mad_mam4/chem_mech.doc +M src/chemistry/pp_waccm_mad_mam4/chem_mech.in +M src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_lin_matrix.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_lu_factor.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_lu_solve.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_nln_matrix.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_prod_loss.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 + - implicitly solve CO2 + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9_Vmct.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vmct.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vmct.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_048: DIFF + ERS_Ln9_Vmct.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vmct.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vmct.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_048: DIFF + ERS_Ln9_Vmct.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vmct.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vmct.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_048: DIFF + SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie NLCOMP + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_048: DIFF + SMS_D_Ln9_Vmct.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_048: DIFF + SMS_D_Ln9_Vmct.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_048: DIFF + - differences due to geographic pole bug fix (issue #456) + - namelist compare failures due to changes in cheyenne PE layouts + +izumi/nag/aux_cam: + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + + SMS_D_Ln3_Vmct.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL SMS_D_Ln3_Vmct.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_048_nag: DIFF + - difference due to geographic pole bug fix (issue #456) + +izumi/pgi/aux_cam: All PASS + +Summarize any changes to answers: Larger than roundoff for WACCMX + +=============================================================== +=============================================================== + +Tag name: cam6_3_048 +Originator(s): cacraig +Date: Feb 3, 2022 +One-line Summary: Update externals to match cesm2_3_alpha08a +Github PR URL: https://github.com/ESCOMP/CAM/pull/513 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +Add ESMCI/ccs_config_cesm in Externals.cfg: https://github.com/ESCOMP/CAM/issues/502 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: goldy, nusbaume, courtneyp, fvitt + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M .gitignore + - Added new directory ccs_config which should be noted for git to ignore + +M Externals.cfg + - Updated the externals to match cesm2_3_alpha08a + +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. + +cheyenne/intel/aux_cam: all BFB + +izumi/nag/aux_cam: all BFB except: + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - Pre-existing failure + + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase NLCOMP + DRIVER_attributes->PELAYOUT_attributes->ALLCOMP_attributes: + - single_column_lnd_domainfile : UNSET + + single_column_lnd_domainfile : /fs/cgd/csm/inputdata/share/domains/unset + DRIVER_attributes->PELAYOUT_attributes->ALLCOMP_attributes->MED_attributes->CLOCK_attributes->ATM_attributes: + - mesh_atm : UNSET + + mesh_atm : /fs/cgd/csm/inputdata/share/meshes/mpasa480_ESMFmesh-211109.nc + +izumi/pgi/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_047 +Originator(s): fvitt, MiWeim +Date: 2 Feb 2022 +One-line Summary: Combine duplicate WACCMX specific code in dycores; Remove double call of outfld HNO3_GAS +Github PR URL: + https://github.com/ESCOMP/CAM/pull/460 + https://github.com/ESCOMP/CAM/pull/518 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Move WACCM-x code in dp_coupling to common module/subroutine for use by all dycores #444 + Double call of outfld for HNO3_GAS in mo_gas_phase_chemdr.F90 #517 + +Describe any changes made to build system: na + +Describe any changes made to the namelist: na + +List any changes to the defaults for the boundary datasets: na + +Describe any substantial timing or memory changes: na + +Code reviewed by: gold2718, PeterHjortLauritzen, cacraigucar, peverwhee, nusbaume + +List all files eliminated: na + +List all files added and what they do: na + +List all existing files that have been modified, and describe the changes: + +M src/dynamics/fv/dp_coupling.F90 +M src/dynamics/mpas/dp_coupling.F90 +M src/dynamics/se/dp_coupling.F90 + - replace waccmx specific code block with call to phys_cnst_limit + +M src/dynamics/mpas/dyn_comp.F90 +M src/dynamics/se/dyn_comp.F90 + - remove inquiries to get indices to WACCMX major species + +M src/physics/cam/physics_types.F90 + - add phys_cnst_limit routine to apply limiters to WACCMX major species + which is dycore independent + + +M src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - removed second call of routine outfld for HNO3_GAS + +M src/chemistry/mozart/mo_chm_diags.F90 + - added right parantheses to NOY and CLOX output long name variables + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: + + ERP_Lh12_Vmct.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL ERP_Lh12_Vmct.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + ERP_Ln9_Vmct.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + ERS_Ln9_Vmct.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vmct.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + ERS_Ln9_Vmct.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vmct.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + SMS_D_Ln9_Vmct.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + SMS_D_Ln9_Vmct.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + SMS_D_Ln9_Vmct.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + SMS_D_Ln9_Vmct.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + SMS_D_Ln9_Vmct.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + SMS_D_Ln9_Vmct.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + SMS_D_Ln9_Vmct.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + SMS_Ld1_Vmct.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1_Vmct.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_046: DIFF + - differences in the HNO3_GAS diagnostic -- otherwise bit-for-bit unchanged + +izumi/nag/aux_cam: + + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_046_nag: ERROR BFAIL some baseline files were missing + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_046_nag: ERROR BFAIL some baseline files were missing + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_046_nag: ERROR BFAIL some baseline files were missing + - missing baselines -- these did not run seccessfully in the previous tag + + SMS_P48x1_D_Ln9_Vmct.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln9_Vmct.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_046_nag: DIFF + - differences in the HNO3_GAS diagnostic -- otherwise bit-for-bit unchanged + +izumi/pgi/aux_cam: All PASS + +Summarize any changes to answers: + + differences in the HNO3_GAS diagnostic -- otherwise bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_046 +Originator(s): katec, andrewgettelman +Date: 01 Feb 2022 +One-line Summary: PUMAS v1 release to cam_dev +Github PR URL:https://github.com/ESCOMP/CAM/pull/409 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Fixes issue #408 (PUMAS/MG Science updates and bug fixes), and ESCOMP/PUMAS issues #20 and #28 +1. Fixes issue Possible removal of ice number limiter....doesn't work with new ice nucleation. +2. adds in vapor deposition onto snow as a process +3. Fall speed correction for rain/snow/graupel +4. Option for implicit fall speed +5. Option for the accretion to see newly autoconverted rain (liquid only) +-- As part of this update to PUMAS we have renamed many micro_mg files and subroutines to + micro_pumas instead. This occured for the previous pumas code and this new update. + +Describe any changes made to build system: + +The previous code is now in a subdirectory called "pumas-frozen" and the newly released + pumas_v1 code is in the "pumas" directory, but only available with the cam_dev + configure option. + +Describe any changes made to the namelist: + +Two new namelist options: micro_mg_accre_sees_auto and micro_mg_implicit_fall. Both are + set to "true" as default but only available (applicable) in cam_dev pumas + configurations. + +List any changes to the defaults for the boundary datasets: + +None + +Describe any substantial timing or memory changes: + +None + +Code reviewed by: JulioTBacmeister, nusbaume, gold2718, fvitt, cacraigucar, pverwhee + +List all files eliminated: +- micro_mg_cam.F90 renamed to micro_pumas_cam.F90 + +List all files added and what they do: +- micro_pumas_cam.F90 added to src/physics/cam_dev/ + +List all existing files that have been modified, and describe the changes: +M .gitignore +- Added a line for moving the preview PUMAS to a new directory in src/physics/pumas-frozen + +M Externals_CAM.cfg +- Update PUMAS externals tag to pumas_cam-release_v1.22, add + new external directory for previous PUMAS code in src/physics/pumas-frozen, + update tag for previous code to branch tag pumas_cam-release_v1.17_rename + +M bld/build-namelist +- add_default calls for new namelist options (only available to cam_dev physics) + +M bld/configure +- Build filepath for pumas depends on cam_dev configure option. + src/physics/pumas build with cam_dev, otherwise src/physics/pumas-frozen + is used in the build. + +M bld/namelist_files/namelist_defaults_cam.xml +- New namelist options default to true in cam_dev physics (not applicable otherwise) + +M bld/namelist_files/namelist_definition.xml +- Define two new namelist options micro_mg_implicit_fall and micro_mg_accre_sees_auto + +M src/physics/cam/macrop_driver.F90 +- Rename micro_mg to micro_pumas + +M src/physics/cam/micro_pumas_cam.F90 +- Rename micro_mg to micro_pumas, including micro_mg_tend3_0 -> micro_pumas_tend + +M src/physics/cam/microp_driver.F90 +- Rename micro_mg to micro_pumas + +M src/physics/cam/nucleate_ice.F90 +- Add a new optional argument to nucleati that defaults to true. When set to false, + pre-existing ice is not added to the total. In cam_dev (pumas 1.21+) this + is set to false. + +M src/physics/cam/nucleate_ice_cam.F90 +- In cam_dev (pumas 1.21+), several history fields are changed to tendencies. The + names of these fields are changed to include "TEN" in that case. An optional + argument is added for cam_dev physics calls to nucleati such that + add_preexisting_ice_in=false in that configuration. + +M src/physics/cam/physpkg.F90 +- Rename micro_mg to micro_pumas + +M src/physics/cam/zm_microphysics.F90 +- Rename micro_mg to micro_pumas + +M src/physics/cam_dev/physpkg.F90 +- Rename micro_mg to micro_pumas + +M src/physics/spcam/crm_physics.F90 +- Rename micro_mg to micro_pumas + +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. + +cheyenne/intel/aux_cam: + + ERP_D_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_045: DIFF + - Expected changes due to new PUMAS v1.22 microphysics + +izumi/pgi/aux_cam: All PASS + +izumi/nag/aux_cam: + + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: FAIL) details: + FAIL PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 RUN time=276 + PEND PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 COMPARE_base_default + - Known issue with mg_pack_accumulator instability, likely to be resolved in future tags + + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: FAIL) details: + FAIL PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 RUN time=561 + PEND PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 COMPARE_base_default + - Known issue with mg_pack_accumulator instability, likely to be resolved in future tags + + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: FAIL) details: + FAIL PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 RUN time=248 + PEND PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 COMPARE_base_default + - Known issue with mg_pack_accumulator instability, likely to be resolved in future tags + + +=============================================================== + +Tag name: cam6_3_045 +Originator(s): fvitt, billsacks +Date: 19 Jan 2022 +One-line Summary: Pass surface ozone concentrations to coupler +Github PR URL:https://github.com/ESCOMP/CAM/pull/404 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Address issues: + - Pass surface ozone concentrations to the coupler #381 + - NUOPC does not call cam_final #411 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +new namelist option in drv_flds_in + + atm_ozone_frequency: valid_values="subdaily,multiday_average" + Frequency of surface ozone field passed from CAM to surface components. + Surface ozone is passed every coupling interval, but this namelist flag + indicates whether the timestep-level values are interpolated from a + coarser temporal resolution. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: billsacks, nusbaume, gold2718, mvertens, cacraigucar, pverwhee + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M bld/build-namelist + - set atm_ozone_frequency when CMEPS mediator is used + +M bld/namelist_files/namelist_definition.xml + - add atm_ozone_frequency definition + +M cime_config/buildnml + - add cmeps flag when nuopc component coupling is used + +M src/chemistry/mozart/chemistry.F90 + - add SRFOZONE field to physics buffer + +M src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - set SRFOZONE field to physics buffer to prognostic or prescribed ozone + in chemistry if available + +M src/control/camsrfexch.F90 + - set camout%ozone to pbuf SRFOZONE field if available, + otherwise to O3 used by radiation in the surface layer + +M src/cpl/nuopc/atm_comp_nuopc.F90 + - add call to cam_final + +M src/cpl/nuopc/atm_import_export.F90 + - add surface ozone field + +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. + +cheyenne/intel/aux_cam: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 NLCOMP + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_044: FIELDLIST field lists differ (otherwise bit-for-bit) + - differ only in the addition of atmImp_Sa_o3 coupler field + +izumi/nag/aux_cam: + + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase NLCOMP + - namelist compare fails with NUOPC coupling due to new atm_ozone_frequency namelist option + otherwise bit-for-bit + +izumi/pgi/aux_cam: All PASS + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_044 +Originator(s): cacraig, goldy, courtneyp, adamrher +Date: Jan 16, 2022 +One-line Summary: Match cesm2_3_beta07 externals and bug fix for SE WACCM-X +Github PR URL: https://github.com/ESCOMP/CAM/pull/501 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - add value of zmconv_parcel_pbl in the namelist #498 + - Update externals to cesm2_3_beta07 #499 + - default pecount for ne120xx needs to be increased to run "out of the box" #500 + - Update dyn_grid to read from the INI grid if the initial conditions file has dimension ‘ncol.’ Always write using the GLL grid. (no issue opened for this bug) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: goldy, courtneyp, nusbaume + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Update externals to match cesm2_3_beta07, except for FMS which is more recent + - Add comment to FMS to explain why more recent than CESM tag + +M bld/build-namelist + - Write out zmconv_parcel_pbl to atm_in regardless of whether it is set or not + +M cime_config/config_pes.xml + - Increase PE count for ne120 runs on cheyenne + +M src/dynamics/se/dyn_grid.F90 +M src/utils/cam_grid_support.F90 + - Fix SE WACCM-X bug which was uncovered in cam6_3_043 + +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. + +cheyenne/intel/aux_cam: all BFB + +izumi/nag/aux_cam: all BFB except: + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - preexisting failure + +izumi/pgi/aux_cam: all BFB + +Multiple namelist failures: + found extra variable: 'zmconv_parcel_pbl' <- From atm_in -- added in this tag + found extra variable: 'do_transient_urban' <- From lnd_in + +CAM tag used for the baseline comparison tests if different than previous +tag: Used cam6_3_042 for NAG runs (so had comparison for WACCM-X failed test) PGI and Intel used cam6_3_043 + +=============================================================== +=============================================================== + +Tag name: cam6_3_043 +Originator(s): peverwhee +Date: 11 Jan 2022 +One-line Summary: Enable use of initial data file with either horizontal +dimension name "ncol" or "ncol_d" + +Github PR URL: https://github.com/ESCOMP/CAM/pull/489 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Fixes issue #339 -- SE dycore not reading default ncdata for ne30np4 F2000 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: gold2718, cacraigucar, fvitt, nusbaume + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M src/dynamics/se/dyn_comp.F90 + - use grid dimension name variable from dyn_grid + +M src/dynamics/se/dyn_grid.F90 + - make grid dimension name variable publicly available + - add logic to add '_d' to attributes lat, lon, and area if the dimension is 'ncol_d' + - make get_hdim_name dummy variables generic + +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. + +cheyenne/intel/aux_cam: ALL PASS + +izumi/nag/aux_cam: + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall:FAIL) details: + - pre-existing failure + +izumi/pgi/aux_cam: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: None, all BFB + +=============================================================== + +Tag name: cam6_3_042 +Originator(s): fvitt, tilmes, emmons +Date: 10 Jan 2022 +One-line Summary: Corrections to aerosol fire emissions +Github PR URL: https://github.com/ESCOMP/CAM/pull/452 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Fixes issue #405 -- Bug fix needed for interactive fire compsets and capability + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + + Update to fire_emis_factors_file + +Describe any substantial timing or memory changes: + +Code reviewed by: gold2718, cacraigucar, peverwhee, nusbaume + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M bld/namelist_files/use_cases/hist_trop_strat_vbsfire_cam6.xml + - include emissions of number densities of modal aerosols + - corrections to fire_emis_specifier + - point to updated fire_emis_factors_file file + - correction to specification of surface emissions files + +M src/chemistry/mozart/fire_emissions.F90 + - correction to units of aerosols number densities surface fluxes diagnostics + +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. + +cheyenne/intel/aux_cam: All PASS + +izumi/nag/aux_cam: + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/pgi/aux_cam: All PASS + +Summarize any changes to answers: + + Compset FCfireHIST changed, otherwise bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_041 +Originator(s): adamrher, rneale, mverten, cacraig +Date: Jan 7, 2022 +One-line Summary: Fix a couple of issues with recent ZM changes, mods to pass cam_dev ERP tests, misc cam_dev bug fixes,removed unused memory allocation +Github PR URL: https://github.com/ESCOMP/CAM/pull/490 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Bug when setting zmconv_parcel_pbl=true and using debug #479 + - cam_dev is failing ERP test #491 + - Remove global non-scalable array allocation from mo_drydep #485 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: adamrher, rneale, goldy, nusbaume, courtneyp, fvitt + +List all files eliminated: + +List all files added and what they do: +M cime_config/testdefs/testlist_cam.xml + - Changed test to debug now that it is working in this mode + +M src/chemistry/mozart/mo_drydep.F90 + - Remove unused allocate + +M src/cpl/mct/atm_comp_mct.F90 + - Remove nextsw_cday function calls in init +M src/cpl/nuopc/atm_comp_nuopc.F90 + - Remove nextsw_cday function calls in init +M src/physics/cam/micro_mg_cam.F90 + - Intialize 2pbuf vars to zero, used by radiation +M src/physics/cam_dev/physpkg.F90 + - Fix indexing for 1pbuf var, pull reserve liquid from tphysbc into tphysac +M src/physics/camrt/radiation.F90 + - Write/read nextsw_cday to/from restarts for exact restarts +M src/physics/rrtmg/radiation.F90 + - Write/read nextsw_cday to/from restarts for exact restarts +M src/physics/simple/radiation.F90 + - Remove nextsw_cday function as mct/nuopc caps will no longer use it + +M src/physics/cam/zm_conv.F90 + - Fix bug when setting zmconv_parcel_pbl=true and using debug + +List all existing files that have been modified, and describe the changes: + +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. + +cheyenne/intel/aux_cam: all BFB except: + ERP_D_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_040: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_040/ERP_D_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s' does not exist + - Changed test to debug, so namelist and baseline are expected failures + +izumi/nag/aux_cam: DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae TPUTCOMP Error: TPUTCOMP: Computation time increase > 25% from baseline + - preexisting failure + +izumi/pgi/aux_cam: all BFB +=============================================================== +=============================================================== +Tag name: cam6_3_040 +Originator(s): jet +Date: 22 Dec 2021 +One-line Summary:Mid-level pressure computation changed to the arithmetic mean of hydrostatic interface pressures +Github PR URL: https://github.com/ESCOMP/CAM/pull/481 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +Fix MPAS CAM Crash with 58 levels and higher horiz resolution and correct error in energy diagnostics calculation. + (see issue #442) + (see issue #487) + +Describe any changes made to build system: +NA + +Describe any changes made to the namelist: +NA + +List any changes to the defaults for the boundary datasets: +NA + +Describe any substantial timing or memory changes: +NA + +Code reviewed by: + +List all files eliminated: +NA + +List all files added and what they do: +NA + +List all existing files that have been modified, and describe the changes: + +M src/dynamics/mpas/dp_coupling + - pmid computation changed to the arithmetic mean of hydrostatic interface pressures + - correct swapped indices in calculation of energy diagnostics + +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. + +cheyenne/intel/aux_cam: + + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) + - expect MPAS tests to show baseline differences due to modified pmid calculation + ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: FAIL) COMPARE_base_rest + - pre-existing failure + +izumi/nag/aux_cam: + + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + - expected failure due to MPAS pressure fix + +izumi/pgi/aux_cam: all PASS + +Summarize any changes to answers: Larger than roundoff. We are not supporting + an MPAS climate at this point. + +=============================================================== + + +=============================================================== +Tag name: cam6_3_039 +Originator(s): herrington, cacraig +Date: Dec 21, 2021 +One-line Summary: move macro/micro/wetdep/radiation from tphysbc to tphysac +Github PR URL: https://github.com/ESCOMP/CAM/pull/387 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + #342:numerical oscillations in near surface winds + +Describe any changes made to build system: + - Introduce cam_dev option for phys + +Describe any changes made to the namelist: + - cam_dev options have been added to configure and build-namelist + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig, goldy, nusbaume, courtneyp, mvertens, gettelman + +List all files eliminated: +D src/control/cam_snapshot.F90 + - broken into 3 modules (see below) + +List all files added and what they do: +A src/physics/cam/cam_snapshot.F90 + - cam_snapshot routines specific to cam physics package + +A src/physics/cam_dev/cam_snapshot.F90 + - cam_snapshot routines specific for the cam_dev physics package + +A src/control/cam_snapshot_common.F90 + - cam_snapshot routines common to all CAM implementations + +A src/physics/cam_dev/convect_diagnostics.F90 + - convection diagnostic to be called after convection routines + +A src/physics/cam_dev/physpkg.F90 + - this physpkg.F90 moves clubb and everything after it in tphysbc, to tphysac + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - Update CTSM tag to bring in changes required for cam_dev (increase skip_steps by one) + +M bld/build-namelist + - set cam_dev to have cam6 namelists, exit if using cam_dev w/o clubb + +M bld/config_files/definition.xml + - added cam_dev config flag + +M bld/configure + - rules for cam_dev config flag to prioritize mods in src/cam_dev + +M bld/namelist_files/namelist_defaults_cam.xml + - add default settings for cam_dev (with this commit is mainly a copy of cam6 settings for cam_dev) + +M bld/namelist_files/namelist_definition.xml + - add convect_diagnostics_calc as a valid value for cam_take_snapshot_before and cam_take_snapshot_after + +M bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +M cime_config/usermods_dirs/CMIP6_B1850/user_nl_cam +M cime_config/usermods_dirs/CMIP6_B1850_WACCM/user_nl_cam +M cime_config/usermods_dirs/CMIP6_BHIST/user_nl_cam +M cime_config/usermods_dirs/CMIP6_BHIST_WACCM/user_nl_cam +M cime_config/usermods_dirs/CMIP6_GENERIC/user_nl_cam + - Change fldlst name from CMFMCDZM to CMFMC_DP + +M cime_config/config_component.xml + - add a dev modifier for cam_dev physics + +M cime_config/config_compsets.xml + - add F2000dev compset that uses cam_dev physics + +M cime_config/testdefs/testlist_cam.xml + - add a test for cam_dev physics + +M src/control/cam_comp.F90 +M src/physics/cam/physpkg.F90 +M src/physics/simple/physpkg.F90 + - change use location to cam_snapshot_common + +M src/cpl/mct/atm_comp_mct.F90 +M src/cpl/nuopc/atm_comp_nuopc.F90 + - move nextsw_cday calculation out of atm_comp_xxx + +M src/physics/cam/phys_control.F90 + - add exit statements for phys options incompatible w/ cam_dev + +M src/physics/cam/zm_conv_intr.F90 + - make convective mass fluxes a pbuf variable + +M src/physics/camrt/radiation.F90 +M src/physics/rrtmg/radiation.F90 +M src/physics/simple/radiation.F90 + - move nextsw_cday calculation into radiation code + +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. + +cheyenne/intel/aux_cam: all BFB except: + ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + FAIL ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s COMPARE_base_rest + FAIL ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_038: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_038/ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s' does not exist + - New test + ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 NLCOMP + FAIL ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_038: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_038: FIELDLIST field lists differ (otherwise bit-for-bit) + FAIL SMS_Ld5_Vmct.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 MEMCOMP Error: Memory usage increase > 10% from baseline + - Both had output fieldname change from CMFMCDZM to CMFMC_DP + +izumi/nag/aux_cam: all BFB except: + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - Preexisting failure + +izumi/pgi/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_038 +Originator(s): katec, sacks, fischer +Date: 15 Dec 2021 +One-line Summary: Change CISM%NOEVOLVE to SGLC in all F compsets, update cime to support new network for Izumi +Github PR URL: https://github.com/ESCOMP/CAM/pull/480 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + - Changes compsets that use CISM%NOEVOLVE to use SGLC in the F-compsets managed by CAM. https://github.com/ESCOMP/CAM/issues/204 + - Update to cime tag that supports the new name Izumi.cgd.ucar.edu + +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: + - Compsets with CISM replaced by stub glacier will use significantly fewer resources + +Code reviewed by: gold2718, billsacks, fvitt, cacraigucar, adamrher + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M Externals.cfg +- Updated cime external from cime6.0.11 to cime6.0.12 +M cime_config/config_compsets.xml +- Changed compsets using CISM2%NOEVOLVE to SGLC + +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. + +cheyenne/intel/aux_cam: + + ERP_Ld3_Vmct.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3_Vmct.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3_Vmct.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + ERP_Ln9_Vmct.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vmct.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + ERP_Ln9_Vmct.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + ERP_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + ERP_Ln9_Vmct.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vmct.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + ERP_Ln9_Vmct.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vmct.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 NLCOMP + FAIL ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 NLCOMP + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + SMS_D_Ln9_Vmct.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + SMS_D_Ln9_Vmct.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + SMS_D_Ln9_Vmct.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem NLCOMP + FAIL SMS_D_Ln9_Vmct.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + SMS_Ld1_Vmct.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1_Vmct.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1_Vmct.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + SMS_Lm13_Vmct.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13_Vmct.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m NLCOMP + FAIL SMS_Lm13_Vmct.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + SMS_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + FAIL SMS_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging NLCOMP + FAIL SMS_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + SMS_Ln9_Vmct.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + FAIL SMS_Ln9_Vmct.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s NLCOMP + FAIL SMS_Ln9_Vmct.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + SMS_Ln9_Vmct.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + FAIL SMS_Ln9_Vmct.f19_f19.F2000climo.cheyenne_intel.cam-silhs NLCOMP + FAIL SMS_Ln9_Vmct.f19_f19.F2000climo.cheyenne_intel.cam-silhs BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + + SMS_Ln9_Vmct.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + FAIL SMS_Ln9_Vmct.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem NLCOMP + FAIL SMS_Ln9_Vmct.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_037: DIFF + +izumi/nag/aux_cam: + + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/pgi/aux_cam: all PASS + +Summarize any changes to answers: All compsets that were changed from CISM2%NOEVOLVE to SGLC will have answer changes. These are seen in the baseline differences in the test listed above. + + +=============================================================== +=============================================================== + +Tag name: cam6_3_037 +Originator(s): fvitt +Date: 8 Dec 2021 +One-line Summary: Add stratospheric sulfate mode (MAM5) +Github PR URL: https://github.com/ESCOMP/CAM/pull/445 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Add a mode for coarse stratospheric sulfate to the modal aerosol model. + (see issue #141 -- MAM5 and updates to dust emis) + +Describe any changes made to build system: + + chem options added: + trop_mam5 + waccm_tsmlt_mam5 + +Describe any changes made to the namelist: + + cam_chempkg options added: + trop_mam5 + waccm_tsmlt_mam5 + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: gold2718, cacraigucar, peverwhee, nusbaume + +List all files eliminated: + +List all files added and what they do: + +A src/chemistry/pp_trop_mam5/chem_mech.doc +A src/chemistry/pp_trop_mam5/chem_mech.in +A src/chemistry/pp_trop_mam5/chem_mods.F90 +A src/chemistry/pp_trop_mam5/m_rxt_id.F90 +A src/chemistry/pp_trop_mam5/m_spc_id.F90 +A src/chemistry/pp_trop_mam5/mo_adjrxt.F90 +A src/chemistry/pp_trop_mam5/mo_exp_sol.F90 +A src/chemistry/pp_trop_mam5/mo_imp_sol.F90 +A src/chemistry/pp_trop_mam5/mo_indprd.F90 +A src/chemistry/pp_trop_mam5/mo_lin_matrix.F90 +A src/chemistry/pp_trop_mam5/mo_lu_factor.F90 +A src/chemistry/pp_trop_mam5/mo_lu_solve.F90 +A src/chemistry/pp_trop_mam5/mo_nln_matrix.F90 +A src/chemistry/pp_trop_mam5/mo_phtadj.F90 +A src/chemistry/pp_trop_mam5/mo_prod_loss.F90 +A src/chemistry/pp_trop_mam5/mo_rxt_rates_conv.F90 +A src/chemistry/pp_trop_mam5/mo_setrxt.F90 +A src/chemistry/pp_trop_mam5/mo_sim_dat.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/chem_mech.doc +A src/chemistry/pp_waccm_tsmlt_mam5/chem_mech.in +A src/chemistry/pp_waccm_tsmlt_mam5/chem_mods.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/m_rxt_id.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/m_spc_id.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/mo_adjrxt.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/mo_exp_sol.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/mo_imp_sol.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/mo_indprd.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/mo_lin_matrix.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/mo_lu_factor.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/mo_lu_solve.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/mo_nln_matrix.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/mo_phtadj.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/mo_prod_loss.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/mo_rxt_rates_conv.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/mo_setrxt.F90 +A src/chemistry/pp_waccm_tsmlt_mam5/mo_sim_dat.F90 + - chemical mechanisms with MAM5 aerosols + +List all existing files that have been modified, and describe the changes: + +M bld/build-namelist + - add MAM5 settings + +M bld/namelist_files/namelist_definition.xml +M bld/config_files/definition.xml +M bld/configure + - add MAM5 mechanisms to the chem option + +M bld/namelist_files/namelist_defaults_cam.xml + - add MAM5 phys props files + +M cime_config/config_component.xml +M cime_config/config_compsets.xml + - add MAM5 compsets + +M cime_config/testdefs/testlist_cam.xml + - add tests for MAM5 compsets + +M src/chemistry/modal_aero/dust_model.F90 +M src/chemistry/modal_aero/modal_aero_coag.F90 +M src/chemistry/modal_aero/modal_aero_data.F90 +M src/chemistry/modal_aero/modal_aero_rename.F90 +M src/physics/cam/hetfrz_classnuc_cam.F90 +M src/physics/cam/nucleate_ice_cam.F90 +M src/physics/cam/rad_constituents.F90 + - add stratosphere coarse mode (MAM5) + +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. + +cheyenne/intel/aux_cam: all PASS + +izumi/nag/aux_cam: + + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + SMS_D_Ln9_Vmct.f10_f10_mg37.QPMAM5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + - new MAM5 test + +izumi/pgi/aux_cam: all PASS + +Summarize any changes to answers: bit-for-bit unchanged + + +=============================================================== +=============================================================== + +Tag name:cam6_3_036 +Originator(s): cacraig +Date: Dec 1, 2021 +One-line Summary: Update to cesm2_3_alpha07b externals with CTSM being dev064 +Github PR URL: https://github.com/ESCOMP/CAM/pull/477 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - update externals to cesm2_3_alpha07b+ : https://github.com/ESCOMP/CAM/issues/476 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: adamher, courtneyp, nusbaume + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update externals to cesm2_3_alpha07b (with CTSM being dev064) + +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. + +** Namelist changes due to changes in external components + +cheyenne/intel/aux_cam: + ERP_Ld3_Vmct.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3_Vmct.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + ERP_Lh12_Vmct.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL ERP_Lh12_Vmct.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + ERP_Ln9_Vmct.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + ERP_Ln9_Vmct.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + ERP_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + ERP_Ln9_Vmct.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vmct.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + ERP_Ln9_Vmct.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + ERS_Ln9_Vmct.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vmct.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + ERS_Ln9_Vmct.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vmct.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + ERS_Ln9_Vmct.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vmct.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_D_Ln9_Vmct.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_D_Ln9_Vmct.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_D_Ln9_Vmct.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_D_Ln9_Vmct.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_D_Ln9_Vmct.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vmct.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_D_Ln9_Vmct.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_Ld1_Vmct.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1_Vmct.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_Lm13_Vmct.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13_Vmct.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + FAIL SMS_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_Ln9_Vmct.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + FAIL SMS_Ln9_Vmct.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_Ln9_Vmct.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + FAIL SMS_Ln9_Vmct.f19_f19.F2000climo.cheyenne_intel.cam-silhs BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + SMS_Ln9_Vmct.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + FAIL SMS_Ln9_Vmct.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_035: DIFF + +izumi/nag/aux_cam: all BFB except: + SMS_P48x1_D_Ln9_Vmct.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln9_Vmct.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_nag: DIFF + - baseline difference due to changes to external componenents + + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + +izumi/pgi/aux_cam: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC4.izumi_pgi.cam-outfrq3s_diags (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vmct.f10_f10_mg37.QPC4.izumi_pgi.cam-outfrq3s_diags BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_pgi.cam-outfrq3s_unicon (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_pgi.cam-outfrq3s_unicon BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_pgi.cam-rad_diag (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_pgi.cam-rad_diag BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + ERC_D_Ln9_Vmct.f10_f10_mg37.QPSPCAMM.izumi_pgi.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vmct.f10_f10_mg37.QPSPCAMM.izumi_pgi.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + ERC_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq3s_ba (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq3s_ba BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + ERC_D_Ln9_Vmct.T5_T5_mg37.QPC3.izumi_pgi.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vmct.T5_T5_mg37.QPC3.izumi_pgi.cam-outfrq3s_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + ERI_D_Ln18_Vmct.T5_T5_mg37.QPC4.izumi_pgi.cam-co2rmp (Overall: DIFF) details: + FAIL ERI_D_Ln18_Vmct.T5_T5_mg37.QPC4.izumi_pgi.cam-co2rmp BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + ERP_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + SCT_D_Ln7_Vmct.T42_T42_mg17.QPC4.izumi_pgi.cam-scm_prep (Overall: DIFF) details: + FAIL SCT_D_Ln7_Vmct.T42_T42_mg17.QPC4.izumi_pgi.cam-scm_prep BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + SCT_D_Ln7_Vmct.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 (Overall: DIFF) details: + FAIL SCT_D_Ln7_Vmct.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + SMS_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_035_pgi: DIFF + - baseline difference due to changes to external componenents + +=============================================================== +=============================================================== + +Tag name: cam6_3_035 +Originator(s): cacraig, mcurry, adamher, goldy, jedwards, nusbaume, zyuying, katec +Date: Nov 29, 2021 +One-line Summary: Bring in numerous minor changes +Github PR URL: https://github.com/ESCOMP/CAM/pull/469 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Reduce clubb stdout message: https://github.com/ESCOMP/CAM/issues/454 + - CLUBB supersaturation issue: https://github.com/ESCOMP/CAM/issues/351 + - Memory leak in CAM diagnostics: https://github.com/ESCOMP/CAM/issues/126 + - Add descriptive long names to CLDLOW, CLDMED and CLDHGH: https://github.com/ESCOMP/CAM/issues/360 + - Bug in cam_pio_fileexists: https://github.com/ESCOMP/CAM/issues/365 + - FCHIST test fails for ocnemis: https://github.com/ESCOMP/CAM/issues/214 + - outfrq9s_multi multi modifier not required: https://github.com/ESCOMP/CAM/issues/358 + - FV nudging module contains endrun calls without messages: https://github.com/ESCOMP/CAM/issues/375 + - Typo in cam_diagnostics.F90: https://github.com/ESCOMP/CAM/issues/421 + - Remove extra snapshot calls: https://github.com/ESCOMP/CAM/issues/437 + - bug in the lidar simulator (COSP1.4 and COSP2): https://github.com/ESCOMP/CAM/issues/262 + - Adding zmconv_tau to CAM namelist options (no Issue, parameter should have been in PPE PR #398) + - Remove debug write which writes on all tasks: https://github.com/ESCOMP/CAM/issues/471 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + - zmconv_tau is added: Convective adjustment timescale in units of (s) + - clubb_l_trapezoidal_rule_zm default value changed to false + - clubb_l_trapezoidal_rule_zt default value changed to false + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: katec, goldy, mcurry, jedwards, fvitt, courtneyp, aherring, numsbaume + +List all files eliminated: +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_multi/shell_commands +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_multi/user_nl_cam +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_multi/user_nl_clm + - Using the _C2 testing qualifier to do mulitinstance testing and no need for these specialized testmods + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M bld/build-namelist + - Bug fix to bring in ocnemis file when it needs to be imported from the inputdata repository + - Adding zmconv_tau to CAM namelist options + +M src/cpl/nuopc/atm_comp_nuopc.F90 + - Remove debug write which writes on all tasks + +M bld/namelist_files/namelist_defaults_cam.xml + - Change a couple of CLUBB namelist settings for supersaturation issue + - Adding zmconv_tau to CAM namelist options + +M bld/namelist_files/namelist_definition.xml + - Adding zmconv_tau to CAM namelist options + +M cime_config/testdefs/testlist_cam.xml + - Use the C2 testing qualifier + +M src/dynamics/fv/metdata.F90 + - Add information to look in atm.log for endrun calls which had no message + +M src/physics/cam/cam_diagnostics.F90 + - Fix description for Q200 to say 200 mbar instead of 700 + +M src/physics/cam/cloud_cover_diags.F90 + - Add information about the ranges for the CLDLOW/CLDMED/CLDHGH variables in the description written in the file + +M src/physics/cam/clubb_intr.F90 + - Limit print_clubb_config_files_api to only the masterproc + +M src/physics/cam/physpkg.F90 + - Fix memory leak when phys_run2 returns quickly + - Remove extraneous cam_snapshot call around physics_dme_adjust which is just being run for diagnostics + +M src/physics/cosp2/optics/cosp_optics.F90 + - Fix COSP bug to include snow variable + +M src/physics/simple/physpkg.F90 + - Remove extraneous cam_snapshot call around physics_dme_adjust which is just being run for diagnostics + +M src/physics/cam/zm_conv.F90 +M src/physics/cam/zm_conv_intr.F90 + - Adding zmconv_tau to CAM namelist options + +M src/utils/cam_pio_utils.F90 + - Fix bug in cam_pio_fileexists + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +** All regression tests were run without the changed settings to clubb_l_trapezoidal_rule_zm and clubb_l_trapezoidal_rule_zt on + on cheyenne/intel, izumi/nag and izumi/pgi. All tests were BFB + +cheyenne/intel/aux_cam: + FAIL ERC_D_Ln9_P144x1_Vmct.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERC_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERP_Ld3_Vmct.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERP_Ln9_Vmct.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERP_Ln9_Vmct.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERP_Ln9_Vmct.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERP_Ln9_Vmct.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERS_Ln9_Vmct.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL ERS_Ln9_Vmct.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_D_Ln9_Vmct.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_D_Ln9_Vmct.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_D_Ln9_Vmct.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_Ld1_Vmct.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_Lm13_Vmct.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_Ln9_Vmct.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + FAIL SMS_Ln9_Vmct.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_034: DIFF + - Answers changed due to change in setting of clubb_l_trapezoidal_rule_zm and clubb_l_trapezoidal_rule_zt + + ** Most tests had namelist failures due to the namelist changes in this tag + +izumi/nag/aux_cam: + + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - Known failure from previous tag + + FAIL ERC_D_Ln9_Vmct.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_034_nag: DIFF + FAIL ERC_D_Ln9_Vmct.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_034_nag: DIFF + FAIL ERC_D_Ln9_Vmct.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_034_nag: DIFF + FAIL ERC_D_Ln9_Vmct.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_034_nag: DIFF + FAIL ERC_D_Ln9_Vmct.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_034_nag: DIFF + FAIL ERI_D_Ln18_Vmct.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_034_nag: DIFF + FAIL ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_034_nag: DIFF + FAIL SMS_D_Ln9_Vmct.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_034_nag: DIFF + FAIL SMS_P48x1_D_Ln3_Vmct.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_034_nag: DIFF + - Answers changed due to change in setting of clubb_l_trapezoidal_rule_zm and clubb_l_trapezoidal_rule_zt + + ** Most tests had namelist failures due to the namelist changes in this tag + +izumi/pgi/aux_cam: all BFB (no CAM6 tests) + ** Most tests had namelist failures due to the namelist changes in this tag + +=============================================================== +=============================================================== + +Tag name: cam6_3_034 +Originator(s): rneale, cacraig +Date: Nov 23, 2021 +One-line Summary: CAM6 Zhang-McFarlane option for parcel properties to be based on PBL Depth +Github PR URL: https://github.com/ESCOMP/CAM/pull/451 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Modify Launch Parcel Definition for ZM Deep Convection (option): https://github.com/ESCOMP/CAM/issues/383 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - Introduce zmconv_parcel_pbl logical + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: goldy, nusbaume, cacraig + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - Introduce zmconv_parcel_pbl logical namelist + +M cime_config/testdefs/testlist_cam.xml + - FX2000 consistently ran out of time - increased the permitted time + +M src/physics/cam/zm_conv.F90 +M src/physics/cam/zm_conv_intr.F90 + - Changes to modify launch parcel defintion for ZM deep convection + +M test/system/test_driver.sh + - Add "module load python" for cheyenne runs + +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. + +cheyenne/intel/aux_cam: all BFB + +izumi/nag/aux_cam: all BFB except know failure: + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + +izumi/pgi/aux_cam: all BFB + +=============================================================== + +Tag name: cam6_3_033 +Originator(s): fvitt +Date: 20 Oct 2021 +One-line Summary: Transport CL, BR; max solar zenth angle; waccmx pelayout; fix leap day issue +Github PR URL: https://github.com/ESCOMP/CAM/pull/449 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Address github issues: + . error in mo_srf_emissions using ESMF library with leap year #317 + . Need to transport CL and BR #314 + . photolysis maximum solar zenith #321 + . Failing WACCMX test #446 + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: + New photo_max_zen namelist option: + Maximum zenith angle (degrees) used for photolysis. + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: gold2718, nusbaume, peverwhee + +List all files eliminated: + + bld/namelist_files/use_cases/aquaplanet_waccm_ma_2000_cam6.xml + - obsolete + + cime_config/testdefs/testmods_dirs/cam/outfrq9s_576tsks/shell_commands + cime_config/testdefs/testmods_dirs/cam/outfrq9s_576tsks/user_nl_cam + cime_config/testdefs/testmods_dirs/cam/outfrq9s_576tsks/user_nl_clm + cime_config/testdefs/testmods_dirs/cam/outfrq9s_576tsks/user_nl_cpl + - directory renamed as outfrq9s_f05 + +List all files added and what they do: + + cime_config/testdefs/testmods_dirs/cam/outfrq9s_f05/shell_commands + cime_config/testdefs/testmods_dirs/cam/outfrq9s_f05/user_nl_cam + cime_config/testdefs/testmods_dirs/cam/outfrq9s_f05/user_nl_clm + cime_config/testdefs/testmods_dirs/cam/outfrq9s_f05/user_nl_cpl + - for waccmx 0.5 degree tests + +A bld/namelist_files/use_cases/aquaplanet_waccm_2000.xml + - for aqua-planet waccm + +List all existing files that have been modified, and describe the changes: + +M .gitignore + - ignore libraries/mct, libraries/parallelio, and share externals + +M bld/build-namelist + - add logic to set max solar zenith angle for photolysis + +M bld/namelist_files/namelist_defaults_cam.xml + - increase se_hypervis_subcycle_sponge to 20 for waccmx + - use np4 ic file for waccmx cslam ne30pg3 + +M bld/namelist_files/namelist_definition.xml + - add photo_max_zen namelist option + +M cime_config/config_component.xml +M cime_config/config_compsets.xml + - aquaplanet waccm compsets added: + . QPmaC4 + . QPmadc4 + . QPmadc6 + +M cime_config/config_pes.xml + - increase tasks in default PE layouts for WACCMX on cheyenne + +M cime_config/testdefs/testlist_cam.xml + - add tests for aquaplanet waccm + - remove _P modifier for waccmx tests + +M src/chemistry/mozart/chemistry.F90 +M src/chemistry/mozart/mo_chemini.F90 +M src/chemistry/mozart/mo_photo.F90 + - changes for photo_max_zen namelist option + +M src/chemistry/pp_waccm_ma/chem_mech.doc +M src/chemistry/pp_waccm_ma/chem_mech.in +M src/chemistry/pp_waccm_ma/chem_mods.F90 +M src/chemistry/pp_waccm_ma/m_spc_id.F90 +M src/chemistry/pp_waccm_ma/mo_adjrxt.F90 +M src/chemistry/pp_waccm_ma/mo_indprd.F90 +M src/chemistry/pp_waccm_ma/mo_lin_matrix.F90 +M src/chemistry/pp_waccm_ma/mo_lu_factor.F90 +M src/chemistry/pp_waccm_ma/mo_lu_solve.F90 +M src/chemistry/pp_waccm_ma/mo_nln_matrix.F90 +M src/chemistry/pp_waccm_ma/mo_prod_loss.F90 +M src/chemistry/pp_waccm_ma/mo_rxt_rates_conv.F90 +M src/chemistry/pp_waccm_ma/mo_sim_dat.F90 + - remove CL and BR from the not-transported list + - add HO2 to the not-transported to be consistent with other waccm mechanisms + - change order of species + +M src/chemistry/pp_waccm_ma_mam4/chem_mech.doc +M src/chemistry/pp_waccm_ma_mam4/chem_mech.in +M src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 +M src/chemistry/pp_waccm_ma_mam4/m_rxt_id.F90 +M src/chemistry/pp_waccm_ma_mam4/m_spc_id.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_adjrxt.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_indprd.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_lin_matrix.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_lu_factor.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_lu_solve.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_nln_matrix.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_prod_loss.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_rxt_rates_conv.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_setrxt.F90 +M src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 + - remove CL and BR from the not-transported list + - change order of species and reactions + +M src/chemistry/pp_waccm_mad/chem_mech.doc +M src/chemistry/pp_waccm_mad/chem_mech.in +M src/chemistry/pp_waccm_mad/chem_mods.F90 +M src/chemistry/pp_waccm_mad/m_spc_id.F90 +M src/chemistry/pp_waccm_mad/mo_adjrxt.F90 +M src/chemistry/pp_waccm_mad/mo_exp_sol.F90 +M src/chemistry/pp_waccm_mad/mo_imp_sol.F90 +M src/chemistry/pp_waccm_mad/mo_indprd.F90 +M src/chemistry/pp_waccm_mad/mo_lin_matrix.F90 +M src/chemistry/pp_waccm_mad/mo_lu_factor.F90 +M src/chemistry/pp_waccm_mad/mo_lu_solve.F90 +M src/chemistry/pp_waccm_mad/mo_nln_matrix.F90 +M src/chemistry/pp_waccm_mad/mo_prod_loss.F90 +M src/chemistry/pp_waccm_mad/mo_rxt_rates_conv.F90 +M src/chemistry/pp_waccm_mad/mo_setrxt.F90 +M src/chemistry/pp_waccm_mad/mo_sim_dat.F90 + - remove CL and BR from the not-transported list + - add HO2 to the not-transported to be consistent with other waccm mechanisms + - explicitly solve CO2 to be consistent with other waccm mechanisms + - use scalar solver for d-region ion chemistry mechanisms (mad) + - change order of species + +M src/chemistry/pp_waccm_mad_mam4/chem_mech.doc +M src/chemistry/pp_waccm_mad_mam4/chem_mech.in +M src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 +M src/chemistry/pp_waccm_mad_mam4/m_rxt_id.F90 +M src/chemistry/pp_waccm_mad_mam4/m_spc_id.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_adjrxt.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_exp_sol.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_imp_sol.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_lin_matrix.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_lu_factor.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_lu_solve.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_nln_matrix.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_prod_loss.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_rxt_rates_conv.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_setrxt.F90 +M src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 + - remove CL and BR from the not-transported list + - use scalar solver for d-region ion chemistry mechanisms (mad) + - change order of species and reactions + +M src/utils/time_manager.F90 + - fix for leap days in cases when interp_missing_months 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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9_P144x1_Vmct.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) + ERC_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) + ERC_D_Ln9_Vmct.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9_Vmct.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ld3_Vmct.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) + ERP_Ln9_Vmct.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) + ERP_Ln9_Vmct.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) + ERP_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9_Vmct.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9_Vmct.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: NLFAIL) + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: NLFAIL) + SCT_D_Ln7_Vmct.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) + SMS_D_Ld2_Vmct.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) + SMS_D_Ln9_Vmct.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_D_Ln9_Vmct.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_D_Ln9_Vmct.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) + SMS_Ld5_Vmct.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) + SMS_Lm13_Vmct.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: NLFAIL) + SMS_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: NLFAIL) + SMS_Ln9_Vmct.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) + SMS_Ln9_Vmct.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: NLFAIL) + - new "photo_max_zen" namelist variable caused namelist compare test to fail + + ERP_Ln9_Vmct.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vmct.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) + SMS_D_Ln9_Vmct.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vmct.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) + SMS_D_Ln9_Vmct.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) + SMS_D_Ln9_Vmct.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_Ld1_Vmct.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + - differences are due to increased max solar zenith angle in CAM-Chem + + ERC_D_Ln9_Vmct.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) + ERP_Lh12_Vmct.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) + ERS_Ln9_Vmct.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_Vmct.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vmct.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) + SMS_D_Ln9_Vmct.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + - differences are due to updates in middle-atmosphere chemistry mechanisms + +izumi/nag/aux_cam: + DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure + + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_carma (Overall: NLFAIL) + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: NLFAIL) + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) + ERI_D_Ln18_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) + ERI_D_Ln18_Vmct.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) + PLB_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) + PLB_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) + PLB_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) + PLB_D_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) + SMS_D_Ld2_Vmct.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) + SMS_D_Ln7_Vmct.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) + SMS_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) + SMS_P48x1_D_Ln3_Vmct.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) + SUB_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) + TMC_D_Vmct.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) + TMC_D_Vmct.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) + - new "photo_max_zen" namelist variable caused namelist compare test to fail + + ERC_D_Ln9_Vmct.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) + SMS_D_Ln3_Vmct.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) + - differences are due to updates in middle-atmosphere chemistry mechanisms + +izumi/pgi/aux_cam: + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC4.izumi_pgi.cam-outfrq3s_diags (Overall: NLFAIL) + ERC_D_Ln9_Vmct.f10_f10_mg37.QPC5.izumi_pgi.cam-outfrq3s_unicon (Overall: NLFAIL) + ERC_D_Ln9_Vmct.f10_f10_mg37.QPSPCAMM.izumi_pgi.cam-outfrq3s (Overall: NLFAIL) + ERP_Ln9_Vmct.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq9s (Overall: NLFAIL) + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal0 (Overall: NLFAIL) + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal1 (Overall: NLFAIL) + PLB_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal3 (Overall: NLFAIL) + SCT_D_Ln7_Vmct.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 (Overall: NLFAIL) + SMS_D_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac (Overall: NLFAIL) + - new "photo_max_zen" namelist variable caused namelist compare test to fail + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: + larger than roundoff for CAM-Chem and middle-atmosphere chemistry configurations + +=============================================================== +=============================================================== + +Tag name: cam6_3_032 +Originator(s): pel, jet +Date: July 12, 2021 +One-line Summary: Full-physics physics-dynamics coupling with MPAS dynamical core (issues #388 #399) +Github PR URL:https://github.com/ESCOMP/CAM/pull/403 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +These mods are for enabling full physics climate simulations with the MPAS dynamical core, +issue #399 Full-physics physics-dynamics coupling with MPAS dynamical core + +. add total energy diagnostics in MPAS dp_coupling layer (addfld's in dyn_comp.F90) +. make dry air mass namelist - see scale_dry_air_mass +. introduce dry air mass scaling in MPAS (dyn_comp.F90) +. change physics-dynamics coupling to be more consistent with CAM (in terms of total energy conservation/consistency) + + +Describe any changes made to build system: + - + +Describe any changes made to the namelist: + Added scale_dry_air_mass to initial_conditions namelist + Specifiy whether and how to perform dry surface pressure scaling. + If less than or equal to 0.0 do not perform scaling. If greater + than 0.0, perform scaling but use scale_dry_air_mass value (in Pa) + as the average dry surface pressure target. + Default: set by build_namelist + +List any changes to the defaults for the boundary datasets: + . updated default mpasa120 ncdata file using Peter's 120-km topography + and interpolated from the 1 January 2000 0000 UTC CFSR fields. + new file is atm/cam/inic/mpas/mpasa120.CFSR.L32.nc + +Describe any substantial timing or memory changes: + +Code reviewed by: goldy, cacraig, peverwhee, nusbaume, mgduda, mcurry, fvitt + +List all files eliminated: + +List all files added and what they do: + A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa120/shell_commands + A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa120/user_nl_cam + A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa120/user_nl_clm + . new mpasa120 full physics regression test + A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/shell_commands + A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/user_nl_cam + A cime_config/testdefs/testmods_dirs/cam/outfrq9s_mpasa480/user_nl_clm + . new mpasa480 full physics regression test + +List all existing files that have been modified, and describe the changes: + M ChangeLog + . updated for cam6_3_032 + M Externals.cfg + . FMS external library back to xanadu to fix broken FV3 due to cam6_3_031 + M bld/build-namelist + . add scale_dry_air_mass namelist parameter as default + M bld/namelist_files/namelist_defaults_cam.xml + . new mpasa120/mpasa480 initial condition file interpolated from CFSF 1 jan 2000 + . new mpasa120/mpasa480 topo data + . scale_dry_air_mass default values for full and simple physics cases + . update rayleigh damping from 3 levels to 5 levels for stability + M bld/namelist_files/namelist_definition.xml + . add definition of scale_dry_air_mass + Specify whether and how to perform dry surface pressure scaling. If + less than or equal to 0.0, do not perform scaling. If greater than 0.0, + perform scaling to scale_dry_air_mass value (in Pa) as the average + dry surface pressure target. + M cime_config/testdefs/testlist_cam.xml + . new regression tests for full physics mpas (mpas120/chey mpas480/izumi) + M src/control/cam_initfiles.F90 + . define/read/distribute scale_dry_air_mass variable and add to cam_initfiles_nl + M src/cpl/nuopc/atm_comp_nuopc.F90 + . lower tolerance for lat/lon residual of calculated and values read off dataset + M src/dynamics/eul/dyn_comp.F90 + . add scale_dry_air_mass functionality to eul dycore + M src/dynamics/fv/dryairm.F90 + . add scale_dry_air_mass functionality to fv dycore + M src/dynamics/fv/dyn_comp.F90 + . add/initialize thermodynamic species indicies to fv + M src/dynamics/fv/stepon.F90 + . call to scale dry air mass if requested via namelist + M src/dynamics/fv3/dyn_comp.F90 + . initialize vertical coordinate call to scale dry air mass if requested + M src/dynamics/mpas/dp_coupling.F90 + . thermodynamic refactor to ensure energy conservation + . add new total energy diagnostics + . update cpairv, rairv, mbarv and cappav as const dependent vars + M src/dynamics/mpas/driver/cam_mpas_subdriver.F90 + . new function for global sum on dynamics grid + M src/dynamics/mpas/dyn_comp.F90 + . thermodynamic refactor to ensure energy conservation + . set vertical coordinate type + . new energy diagnostics + . scaling of dry air mass for MPAS dycore + M src/dynamics/mpas/dyn_grid.F90 + . remove excess white space + M src/dynamics/se/dyn_comp.F90 + . initialize new physconst thermodynamic species indicies + . set vertical coordinate info for SE dycore + . new energy diagnostics + M src/dynamics/tests/dyn_tests_utils.F90 + . log vertical coordinate info + M src/physics/cam/cam_diagnostics.F90 + . new diagnostics for energy conservation + M src/physics/cam/check_energy.F90 + . refactor code to better diagnose cam physics total energy + . add energy calculation for height based coord (MPAS) + M src/physics/cam/physics_types.F90 + . increase dimensionality of global arrays of energy and water + to carry integrals of both physics and dynamics + Second dimension is (phys_te_idx) CAM physics total energy and + (dyn_te_idx) dycore total energy computed in physics + M src/physics/cam/physpkg.F90 + . refactor physics dme adjust functionality to account for increased + dimensionality of global energy integrals + M src/physics/simple/physpkg.F90 + . refactor simple physics dme adjust functionality to account for increased + dimensionality of global energy integrals + M src/utils/physconst.F90 + . new routine for vertically integrated total energy + . define/initialize/log thermodynamic indicies for liquid and ice species + . call logging of vertical coord info + M test/system/test_driver.sh + . mods to allow nuopc test in testlist_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. + +cheyenne/intel/aux_cam: + SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie RUN time=125 + - Known failure in previous tag not sure of the cause. This test aborts during run. + + ERP_Ln9_Vmct.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) + - Known failure in previous tag due to FMS interface update. FV3 functionality + corrected with this update. New Baselines created. + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) + - New Cheyenne MPAS regression test, no previous baselines + ERC_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) + ERC_D_Ln9.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) + ERC_D_Ln9.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) + ERC_D_Ln9.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) + ERI_D_Ln18.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: NLFAIL) + ERP_D_Ln9.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) + ERP_Lh12.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: NLFAIL) + ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) + ERP_Ln9.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) + ERP_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: NLFAIL) + ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERS_Ln9.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) + SCT_D_Ln7.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) + SMS_D_Ld2.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) + SMS_D_Ld5.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: NLFAIL) + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_D_Ln9.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: NLFAIL) + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) + SMS_D_Ln9.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_D_Ln9.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: NLFAIL) + SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_Ld1.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) + SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) + SMS_Lm13.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: NLFAIL) + SMS_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: NLFAIL) + SMS_Ln9.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) + SMS_Ln9.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: NLFAIL) + SMS_Ln9.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: NLFAIL) + - Namelist comparisons are failing due to the addition of scale_dry_air_mass variable + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + - New Izumi MPAS regression test, no previous baselines + ERC_D_Ln9.f10_f10_mg37.FHS94.izumi_nag.cam-idphys (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_carma (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) + ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) + ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (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) + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (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) + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) + SMS_D_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: NLFAIL) + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) + SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: NLFAIL) + SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s (Overall: NLFAIL) + SUB_D_Ln9.f10_f10_mg37.QPC5.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) + - Namelist comparisons are failing due to the addition of scale_dry_air_mass variable + +izumi/pgi/aux_cam: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_pgi.cam-rad_diag (Overall: DIFF) + - Roundoff difference due to difference in order of sums for internal energy + + ERC_D_Ln9.f10_f10_mg37.FADIAB.izumi_pgi.cam-terminator (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_pgi.cam-outfrq3s_diags (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_pgi.cam-outfrq3s_unicon (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_pgi.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq3s_ba (Overall: NLFAIL) + ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_pgi.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.ne5pg4_ne5pg4_mg37.FADIAB.izumi_pgi.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.T5_T5_mg37.QPC3.izumi_pgi.cam-outfrq3s_usecase (Overall: NLFAIL) + ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_pgi.cam-co2rmp (Overall: NLFAIL) + ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_pgi.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq9s (Overall: NLFAIL) + PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_pgi.cam-outfrq3s (Overall: NLFAIL) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal0 (Overall: NLFAIL) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal1 (Overall: NLFAIL) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal3 (Overall: NLFAIL) + SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_pgi.cam-scm_prep (Overall: NLFAIL) + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 (Overall: NLFAIL) + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac (Overall: NLFAIL) + - Namelist comparisons are failing due to the addition of scale_dry_air_mass variable +=============================================================== +=============================================================== +Tag name: cam6_3_031 +Originator(s): goldy +Date: 2021-09-03 +One-line Summary: Update externals to cesm2_3_alpha05c +Github PR URL: https://github.com/ESCOMP/CAM/pull/427 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): Update externals to match https://github.com/ESCOMP/CAM/pull/427 + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: cacraigucar, peverwhee, nusbaume + +List all files eliminated: NA + +List all files added and what they do: NA + +List all existing files that have been modified, and describe the changes: + +M Externals.cfg + - Updated externals to match cesm2_3_alpha05c + - Made the new CICE6 external optional +M doc/ChangeLog +- Documented all the CTSM changes we have been ignoring +M test/system/test_driver.sh +- Added option about which driver (MCT or NUOPC) to run + +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. + +cheyenne/intel/aux_cam: + FAIL ERP_Ld3_Vmct.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3_Vmct.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL ERP_Lh12_Vmct.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h NLCOMP + FAIL ERP_Lh12_Vmct.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL ERP_Ln9_Vmct.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL ERP_Ln9_Vmct.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vmct.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL ERP_Ln9_Vmct.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vmct.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL ERP_Ln9_Vmct.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vmct.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 NLCOMP + FAIL ERP_Ln9_Vmct.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL ERS_Ln9_Vmct.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vmct.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL ERS_Ln9_Vmct.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vmct.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL ERS_Ln9_Vmct.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vmct.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL SMS_D_Ln9_Vmct.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vmct.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday NLCOMP + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vmct.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie NLCOMP + FAIL SMS_D_Ln9_Vmct.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie RUN time=113 + FAIL SMS_D_Ln9_Vmct.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem NLCOMP + FAIL SMS_D_Ln9_Vmct.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL SMS_D_Ln9_Vmct.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vmct.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE exception + FAIL SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1_Vmct.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL SMS_Ld1_Vmct.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1_Vmct.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL SMS_Lm13_Vmct.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m NLCOMP + FAIL SMS_Lm13_Vmct.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL SMS_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging NLCOMP + FAIL SMS_Ln9_Vmct.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL SMS_Ln9_Vmct.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s NLCOMP + FAIL SMS_Ln9_Vmct.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL SMS_Ln9_Vmct.f19_f19.F2000climo.cheyenne_intel.cam-silhs NLCOMP + FAIL SMS_Ln9_Vmct.f19_f19.F2000climo.cheyenne_intel.cam-silhs BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + FAIL SMS_Ln9_Vmct.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem NLCOMP + FAIL SMS_Ln9_Vmct.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_030_mct: DIFF + - Namelist and small baseline changes due to answer-changing CTSM tags (ctsm5.1.dev033 and/or ctsm5.1.dev053) + +izumi/nag/aux_cam: + FAIL DAE_Vmct.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing, expected failure + FAIL SMS_P48x1_D_Ln9_Vmct.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s NLCOMP + FAIL SMS_P48x1_D_Ln9_Vmct.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s BASELINE /fs/cgd/csm/mode + - Namelist and small baseline changes due to answer-changing CTSM tags (ctsm5.1.dev033 and/or ctsm5.1.dev053) + +izumi/pgi/aux_cam: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers, i.e., +- what code configurations: F compsets which include active land component +- what platforms/compilers: Izumi (Nag), Cheyenne (Intel) +- nature of change (roundoff; larger than roundoff but same climate; new + climate): larger than roundoff but same climate + +=============================================================== +=============================================================== +Tag name: cam6_3_030 +Originator(s): mgduda +Date: 31 August 2021 +One-line Summary: Update the MPAS-A dycore to stable hash on MPAS-Model 'develop' branch +Github PR URL: https://github.com/ESCOMP/CAM/pull/418 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Update the MPAS-A dycore in CAM to MPAS-Atmosphere v7+, Issue #417 + Update the MPAS-A dycore to a stable hash on the MPAS-Model 'develop' branch, + and introduce changes to the MPAS-Atmosphere dycore interface needed for + compatibility with the 'develop' dycore code. + +Describe any changes made to build system: + +. The script and XML files for building namelists have been updated to add two + new namelist options, mpas_apply_lbcs and mpas_jedi_da, required by the + updated MPAS-Atmosphere dycore. + +Describe any changes made to the namelist: + +. Two new namelist options have been added: + - mpas_apply_lbcs the new &limited_area group (default value: false) + - mpas_jedi_da in the new &assimilation group (default value: false) + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: gold2718, fvitt, cacraigucar, peverwhee, nusbaume + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +Externals_CAM.cfg +. Update the MPAS-A dycore external to ba25bd07 (the merge commit in + the MPAS-Model that integrates all CAM-MPAS changes into the main + development branch) + +bld/build-namelist +. Add two new namelist options, mpas_apply_lbcs and mpas_jedi_da + +bld/namelist_files/namelist_defaults_cam.xml +. Add two new namelist options, mpas_apply_lbcs and mpas_jedi_da + +bld/namelist_files/namelist_definition.xml +. Add two new namelist options, mpas_apply_lbcs and mpas_jedi_da + +src/dynamics/mpas/Makefile +. Add a dependency of mpas_atm_time_integration.o on mpas_atm_boundaries.o + +src/dynamics/mpas/driver/cam_mpas_subdriver.F90 +. Add calls to mpas_atm_dynamics_init and mpas_atm_dynamics_finalize +. Initialize the domainID member of the domain_ptr instance after allocation + in the cam_mpas_init_phase1 routine +. Remove tend_ru_physics, tend_rtheta_physics, and tend_rho_physics from + the set of fields written to and read from restart files + +src/dynamics/mpas/dyn_comp.F90 +. Move calls to get pointers to tend_ru_physics, tend_rtheta_physics, and + tend_rho_physics after the call to cam_mpas_init_phase4, through which these + fields are allocated +. Add code to read namelist options mpas_apply_lbcs and mpas_jedi_da + in the cam_mpas_namelist_read routine + +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. + +cheyenne/intel/aux_cam: + FAIL ERC_D_Ln9.mpasa120z32_mpasa120.FKESSLER.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + * New namelist options have been added in this PR + + FAIL ERC_D_Ln9.mpasa120z32_mpasa120.FKESSLER.cheyenne_intel.cam-outfrq3s_usecase BASELINE +/glade/p/cesm/amwg/cesm_baselines/cam6_3_027: FIELDLIST field lists differ (otherwise bit-for-bit) + * The fields tend_ru_physics, tend_rtheta_physics, and tend_rho_physics are no longer + written to restart files, but these fields are not required for exact restarts. + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + * pre-existing failure + +izumi/pgi/aux_cam: + * No failures. + +Summarize any changes to answers, i.e., +- No changes to answers + +=============================================================== +=============================================================== +Tag name: cam6_3_029 +Originator(s):mlander +Date: 26 Aug 2021 +One-line Summary: Replace svn with git in carma section of Externals_CAM.cfg +Github PR URL: https://github.com/ESCOMP/CAM/pull/415 + +Purpose of changes (include the issue number and title text for each +relevant GitHub issue): + Point CAM to the CARMA_base github repository instead of the SVN + repository. This PR will close issue #414. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: gold2718, fvitt, peverwhee, nusbaume, cacraigucar + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - replaced the following lines (lines 10 & 11) + protocol = svn + repo_url = https://svn-ccsm-models.cgd.ucar.edu/carma/release_tags + with + protocol = git + repo_url = https://github.com/ESCOMP/CARMA_base.git + +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. + +cheyenne/intel/aux_cam: All are BFB + +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 COMPARE_base_da + - pre-existing failure + +izumi/pgi/aux_cam: All are BFB + +=============================================================== +=============================================================== +Tag name: cam6_3_028 +Originator(s): pel,jet +Date: Aug 19, 2021 +One-line Summary:Science Updates for CESM2.2 release and cam_development +Github PR URL:https://github.com/ESCOMP/CAM/pull/401 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- These mods are necessary to fix science bugs, improve algorithms and numerical stability of SE dycore. + Namelist default changes to the gravity wave parameterization and updates to the Test Tracers will + also affect the other dycores. This PR will close issue #392. + +Describe any changes made to build system: + +Describe any changes made to the namelist: +- namelist variables have been removed: + se_raytau0 + se_raykrange + se_rayk0 +- namelist variables with new defaults + effgw_beres_dp defaults + se_hypervis_scaling + se_hypervis_subcycle + se_hypervis_subcycle_sponge + se_nu + se_nu_div + se_nu_p + se_nu_top + se_molecular_diff + se_nsplit + se_rsplit + cld_macmic_num_steps +- namelist variables added for better sponge layer setup + se_sponge_del4_nu_fac + . Hyperviscosity coefficient se_nu [m^4/s] for u,v, T is increased to + se_nu_p*se_sponge_del4_nu_fac following a hyperbolic tangent function + centered around pressure at vertical index se_sponge_del4_lev: + 0.5_r8*(1.0_r8+tanh(2.0_r8*log(pmid(se_sponge_del4_lev)/press))) + where press is pressure + If less than 0, se_sponge_del4_nu_fac is automatically set based on model top location. + se_sponge_del4_nu_div_fac + . Divergence damping hyperviscosity coefficient se_nu_div [m^4/s] for u,v is increased to + se_nu_p*se_sponge_del4_nu_div_fac following a hyperbolic tangent function + centered around pressure at vertical index se_sponge_del4_lev: + 0.5_r8*(1.0_r8+tanh(2.0_r8*log(pmid(se_sponge_del4_lev)/press))) + where press is pressure + If less than 0, se_sponge_del4_nu_div_fac is automatically set based on model top location. + se_sponge_del4_lev + . Level index around which increased del4 damping is centered. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: pel,fvitt,nusbaume,peverwhee,gold2718,cacraigucar + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +. bld/build-namelist + - Remove SE Rayleigh Friction Parameterization +. bld/namelist_files/namelist_defaults_cam.xml + - Thermodynamic consistency between pressure based physics and height based dynamics +. bld/namelist_files/namelist_definition.xml + - Remove SE Rayleigh Friction Parameterization + - New namelist variables for sponge layer configuration +. cime_config/testdefs/testmods_dirs/cam/outfrq9s_wcm_ne30/user_nl_cam + - Remove SE Rayleigh Friction Parameterization +. src/dynamics/se/dp_coupling.F90 + - Thermodynamic consistency between pressure based physics and height based dynamics +. src/dynamics/se/dycore/control_mod.F90 + - Thermodynamic consistency between pressure based physics and height based dynamics +. src/dynamics/se/dycore/dimensions_mod.F90 + - new del4 T damping variable and removed unused variables +. src/dynamics/se/dycore/global_norms_mod.F90 + - improve level dependent del4 (sponge layer) damping for hitop +. src/dynamics/se/dycore/prim_advance_mod.F90 + - Add reference temperature profile correction + - Remove SE Rayleigh Friction Parameterization + - Updated defaults for full physics, new sponge layer setup (new se_sponge... namelists parameters) +. src/dynamics/se/dycore/viscosity_mod.F90 + - add p correction to approximate Laplace on pressure surfaces +. src/dynamics/se/dyn_comp.F90 + - Remove SE Rayleigh Friction Parameterization +. src/physics/cam/check_energy.F90 + - initialize angular momentum diagnostic variables. +. src/physics/cam/geopotential.F90 + - fix dycore dependent calculation of hydrostatic elements +. src/physics/cam/physpkg.F90 + - new angular moment diagnostics +. src/physics/cam/tracers.F90 + - Changes to TT_CCOSB TT_COSB and TT_lCCOSB for idealized testing of + dynamical cores (change to Lauritzen and Thuburn,2012, QJRMS, formulation). +. src/physics/simple/physpkg.F90 + - new angular moment diagnostics +. src/utils/physconst.F90 + - correct mid-level pressure computation for SE in physconst.F90 + +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. + +cheyenne/intel/aux_cam: +All tests running. Differences Expected due to namelist updates + + DIFF ERC_D_Ln9.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s + DIFF ERP_Lh12.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h + DIFF ERP_Ln9.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie + BASE: effgw_beres_dp = 0.1D0 + COMP: effgw_beres_dp = 0.7D0 + + DIFF ERC_D_Ln9.mpasa120z32_mpasa120.FKESSLER.cheyenne_intel.cam-outfrq3s_usecase + test tracer differences + + DIFF ERC_D_Ln9.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator + DIFF ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase + DIFF ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s + DIFF SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d + DIFF ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase + BASE: se_nu_top = 5.0e5 + COMP: se_nu_top = 1.25e5 + + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 + BASE: se_hypervis_subcycle = 1 + COMP: se_hypervis_subcycle = 2 + BASE: se_molecular_diff = 100.0 + COMP: se_molecular_diff = 0.0 + BASE: se_nu_top = 0.0 + COMP: se_nu_top = 1.25e5 + BASE: effgw_beres_dp = 0.325D0 + COMP: effgw_beres_dp = 0.5D0 + + DIFF ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined + BASE: se_hypervis_scaling = 3.0D0 + COMP: se_hypervis_scaling = 3.22D0 + BASE: se_hypervis_subcycle = 2 + COMP: se_hypervis_subcycle = 3 + BASE: se_hypervis_subcycle_sponge = 4 + COMP: se_hypervis_subcycle_sponge = 2 + BASE: se_nu_top = 2.0e5 + COMP: se_nu_top = 1.25e5 + + DIFF SMS_D_Ln9.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem + BASE: se_hypervis_scaling = 3.0D0 + COMP: se_hypervis_scaling = 3.22D0 + BASE: se_hypervis_subcycle = 2 + COMP: se_hypervis_subcycle = 3 + BASE: se_hypervis_subcycle_sponge = 4 + COMP: se_hypervis_subcycle_sponge = 2 + BASE: se_nu_top = 2.0e5 + COMP: se_nu_top = 1.25e5 + BASE: cld_macmic_num_steps = 3 + COMP: cld_macmic_num_steps = 1 + + DIFF SMS_D_Ln9.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s + BASE: se_hypervis_subcycle = 1 + COMP: se_hypervis_subcycle = 2 + BASE: se_molecular_diff = 0.0 + COMP: se_molecular_diff = 1.0 + BASE: effgw_beres_dp = 0.1D0 + COMP: effgw_beres_dp = 0.7D0 + BASE: se_hypervis_subcycle_sponge = 2 + COMP: se_hypervis_subcycle_sponge = 5 + +izumi/nag/aux_cam: all BFB except: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + DIFF ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s + DIFF ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase + DIFF ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase + DIFF ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac + DIFF ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic + DIFF ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic + DIFF ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf + DIFF ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s + DIFF ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s + DIFF PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s + 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.ne5_ne5_mg37.QPC4X.izumi_nag.cam-outfrq9s + DIFF SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s + DIFF SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s + - Diff due to namelist updates - see comments for cheyenne testing + +izumi/pgi/aux_cam: + DIFF ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_pgi.cam-outfrq3s_diags + DIFF ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq3s_ba + DIFF ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_pgi.cam-outfrq3s + DIFF ERC_D_Ln9.ne5pg4_ne5pg4_mg37.FADIAB.izumi_pgi.cam-outfrq3s + DIFF ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_pgi.cam-outfrq9s + DIFF ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq9s + DIFF PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_pgi.cam-outfrq3s + DIFF PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal0 + DIFF PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal1 + DIFF PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal3 + DIFF SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac + - Diff due to namelist updates - see comments for cheyenne testing + +Summarize any changes to answers, i.e., +- what code configurations: Configurations using SE and FV dycores +- what platforms/compilers: All +- nature of change: new climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source: git clone https://github.com/jtruesdal/CAM-1.git cam6_3_019_plus_CESM2.2 + cd cam6_3_019_plus_CESM2.2 + git checkout cam6_3_019_plus_CESM2.2 +- platform/compilers: cheyenne/intel +- archived case directory: /glade/p/cesmdata/cseg/runs/cesm2_0/f.e21.FWscHIST.f09_L32_cam6_3_019_plus_CESM2.2.001.hf + +URL for AMWG diagnostics output used to validate new climate: + https://webext.cgd.ucar.edu/FWscHIST/f.e21.FWscHIST.ne30_L32_cam6_3_019_plus_CESM2.2.001.hf/atm/f.e21.FWscHIST.ne30_L32_cam6_3_019_plus_CESM2.2.001.hf_yrs1980-1989-f.e21.FWscHIST.ne30_L32_cam6_3_019.001.hf_yrs1980-1989/ +=============================================================== +=============================================================== +Tag name: cam6_3_027 +Originator(s): fvitt +Date: 20 Jul 2021 +One-line Summary: Misc bug fixes for WACCM-X +Github PR URL: https://github.com/ESCOMP/CAM/pull/382 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Fix the following issues: + - array out of bounds issue in electric potential solver when compiled with some compilers + (array out of bounds errors in WACCMX e-potential direct solver #363) + - error writing physics buffer fields to restart file in large simulations + (Error writing pbuf fields to restart file at ne120 282 layer resolution #376) + - initialization of ion and electron temperatures when not read from IC file + (WACCMX ion and electron temperatures are initialized to zero when not read from IC file #377) + - do not attempt to advect N2 when SE CSLAM is used + (addfld error when SE CSLAM is used in WACCMX #379) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: CAM code review team + +List all files eliminated: + +List all files added and what they do: + +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_160x193/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_160x193/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_160x193/user_nl_clm +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_320x385/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_320x385/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_320x385/user_nl_clm +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_640x769/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_640x769/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq3s_edyngrid_640x769/user_nl_clm + - for testing higher resolution magnetic grids + +List all existing files that have been modified, and describe the changes: + +M bld/namelist_files/namelist_defaults_cam.xml + - add aux_cam waccm ne5pg3 nag test + - other adjustments for waccmx + +M src/dynamics/se/dyn_comp.F90 + - correction to history field longname for forcings on GLL grid + +M src/ionosphere/waccmx/edyn_geogrid.F90 + - need sufficient number of oplus grid latitudes per mpi task. + +M src/ionosphere/waccmx/edyn_mudcom.F90 + - replace old style of dummy argument array dimensions with assumed size specifier + -- needed to run when compiled PGI and NAG when electric potential solver + does not converge + - removed dead code + - cleanup + +M src/ionosphere/waccmx/edyn_solve.F90 + - initialize phisolv to zero + +M src/physics/cam/physpkg.F90 +M src/physics/cam/waccmx_phys_intr.F90 + - call ion_electron_temp_timestep_init + +M src/physics/waccmx/ion_electron_temp.F90 + - initialize Te and Ti to nuetral T (state%t) at the beginning of the initial + time step if not able to initialize from initial conditions file + +M src/utils/cam_map_utils.F90 + - fix integer kind on the product of array dimensions to aviod errros in writing + large restart files + +M src/utils/physconst.F90 + - changes to avoid advection of derived N2 species when SE-CSLAM is used + +M cime_config/testdefs/testlist_cam.xml + - add default mesh file for ne5 np4 pg3 SE-CSLAM grid + +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. + +cheyenne/intel/aux_cam: All PASS + +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 COMPARE_base_da + - pre-existing failure + + SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s NLCOMP + FAIL SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_026_nag: ERROR BFAIL baseline directory '/fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_026_nag/SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s' does not exist + - new test for waccmx + +izumi/pgi/aux_cam: All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: All B4B + +=============================================================== +============================================================== + +Tag name: cam6_3_026 +Originator(s): katetc,andrewgettelman,trudeeidhammer +Date: July 15, 2021 +One-line Summary: Support for the CAM Perturbed Parameter Ensemble (PPE) +Github PR URL: https://github.com/ESCOMP/CAM/pull/398 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- Adding in namelist parameters and supporting code to be used in the CAM PPE (issue #313) + +Describe any changes made to build system: +- None + +Describe any changes made to the namelist: +- Added parameters to micro_mg_nl, clubb_nl, microp_aero_nl, zm_conv_nl for the PPE + +List any changes to the defaults for the boundary datasets: +- None + +Describe any substantial timing or memory changes: +- None + +Code reviewed by: +- nusbaume, gold2718, cacraigucar, peverwhee + +List all files eliminated: +- None + +List all files added and what they do: +- None + +List all existing files that have been modified, and describe the changes: +. Externals_CAM.cfg + - Point to new PUMAS external pumas_cam-release_v1.17 +. bld/build-namelist + - Add default lines to namelists for new pumas namelist parameters, + new microp_aero parameters, new clubb parameters, and new zm_conv + parameters +. bld/namelist_files/namelist_defaults_cam.xml + - Add default values to namelists for new pumas namelist parameters, + new microp_aero parameters, new clubb parameters, and new zm_conv + parameters +. bld/namelist_files/namelist_definition.xml + - Add default values and documentation for new pumas namelist parameters, + new microp_aero parameters, new clubb parameters, and new zm_conv + parameters +. cime_config/usermods_dirs/scam_twp06/user_nl_cam + - Increase frequency of radiation calls in the TWP-ICE case +. src/physics/cam/cloud_fraction.F90 + - Make dp1 and dp2 parameters public so they can be used in clubb +. src/physics/cam/clubb_intr.F90 + - Add namelist parameters for the PPE, make meltpt_temp a parameter, + hookup dp1 and dp2 hard-coded values to cloud_fraction +. src/physics/cam/micro_mg_cam.F90 + - Add namelist parameters for the PPE, pass values into pumas +. src/physics/cam/microp_aero.F90 + - Add namelist parameters for the PPE +. src/physics/cam/ndrop.F90 + - Initialize tendnd to zero to avoid NaNs later +. src/physics/cam/zm_conv_intr.F90 + - Added namelist parameters for the PPE, pass values into zm_conv +. src/physics/cam/zm_conv.F90 + - Set parameters based on namelist values, make no_deep_pbl_in not + optional + + +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. + +cheyenne/intel/aux_cam: + +- Baseline compare fail as expected due to changes in microphysics and clubb: + ERC_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) + ERP_D_Ln9.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) + ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) + ERP_Ln9.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) + ERP_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) + ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) + SMS_D_Ln9.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) + SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_Ld1.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + SMS_Lm13.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) + SMS_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) + SMS_Ln9.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) + SMS_Ln9.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) + SMS_Ln9.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) + +- Namelist compare fail as expected due to new namelist options: + + ERC_D_Ln9.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.mpasa120z32_mpasa120.FKESSLER.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) + ERC_D_Ln9.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) + ERC_D_Ln9.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) + ERC_D_Ln9.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) + ERI_D_Ln18.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: NLFAIL) + ERP_Lh12.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: NLFAIL) + ERS_Ln9.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) + SCT_D_Ln7.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) + SMS_D_Ld2.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) + SMS_D_Ld5.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) + SMS_D_Ln9.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) + SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) + +izumi/nag/aux_cam: + +- Expected failure from previous tags: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + +- Baseline compare fail as expected due to changes in microphysics and clubb: + 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_convmic (Overall: DIFF) + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) + +- Namelist compare fail as expected due to new namelist options: + ERC_D_Ln9.f10_f10_mg37.FHS94.izumi_nag.cam-idphys (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_carma (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) + ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) + ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) + ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (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) + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) + SMS_D_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) + SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) + SMS_D_Ln9.ne5_ne5_mg37.QPC4X.izumi_nag.cam-outfrq9s (Overall: NLFAIL) + SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s (Overall: NLFAIL) + SUB_D_Ln9.f10_f10_mg37.QPC5.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) + +izumi/pgi/aux_cam: + +- Baseline compare fail as expected due to changes in microphysics and clubb: + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 (Overall: DIFF) + +- Namelist compare fail as expected due to new namelist options: + ERC_D_Ln9.f10_f10_mg37.FADIAB.izumi_pgi.cam-terminator (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_pgi.cam-outfrq3s_diags (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_pgi.cam-outfrq3s_unicon (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_pgi.cam-rad_diag (Overall: NLFAIL) + ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_pgi.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq3s_ba (Overall: NLFAIL) + ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_pgi.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.ne5pg4_ne5pg4_mg37.FADIAB.izumi_pgi.cam-outfrq3s (Overall: NLFAIL) + ERC_D_Ln9.T5_T5_mg37.QPC3.izumi_pgi.cam-outfrq3s_usecase (Overall: NLFAIL) + ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_pgi.cam-co2rmp (Overall: NLFAIL) + ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_pgi.cam-outfrq9s (Overall: NLFAIL) + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq9s (Overall: NLFAIL) + PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_pgi.cam-outfrq3s (Overall: NLFAIL) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal0 (Overall: NLFAIL) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal1 (Overall: NLFAIL) + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal3 (Overall: NLFAIL) + SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_pgi.cam-scm_prep (Overall: NLFAIL) + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac (Overall: NLFAIL) + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: Any configurations using PUMAS (MG2 or MG3) + microphysics and CLUBB +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): Larger than roundoff, same climate + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam6_3_025 +Originator(s): cacraig +Date: July 5, 2021 +One-line Summary: Update cime_config scripts to python3 +Github PR URL: https://github.com/ESCOMP/CAM/pull/397 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update cime_config/buildlib, buildnml and buildcpp to use python3 https://github.com/ESCOMP/CAM/issues/394 + +Describe any changes made to build system: + - cime_config scripts now use python3 + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: nusbaume, courtneyp + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M cime_config/buildcpp +M cime_config/buildlib +M cime_config/buildnml + - update to use python3 + +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. + +cheyenne/intel/aux_cam:all BFB + +izumi/nag/aux_cam: all BFB except: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - pre-existing failure + +izumi/pgi/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_024 +Originator(s): fvitt +Date: 28 Jun 2021 +One-line Summary: Correction to WACCMX electron heat flux +Github PR URL: https://github.com/ESCOMP/CAM/pull/390 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + correction to waccmx heat flux formulation #353 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: CAM code review team + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M src/physics/waccmx/ion_electron_temp.F90 + - correction to electron flux formulation + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_023: DIFF + ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_023: DIFF + ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_023: DIFF + SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_023: DIFF + SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_023: DIFF + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_023: DIFF + - expected baseline 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 COMPARE_base_da + - pre-existing failure + +izumi/pgi/aux_cam: All PASS + +Summarize any changes to answers: Larger than roundoff for WACCMX + +=============================================================== +=============================================================== +Tag name: cam6_3_023 +Originator(s): jet, duda +Date: 23 Jun 2021 +One-line Summary: Fix MPAS base/rest regression test failure (issue #389) allow MPAS NUOPC build +Github PR URLs: https://github.com/ESCOMP/CAM/pull/391 + + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +MPAS base/rest regression test fails due to differences in "extra" neighbors of the + IC files (issue #389) MPAS-Model PR #143 corrects this problem and was merged + onto MPAS-Dev/MPAS-Model and the resulting dycore hash was added to Externals_CAM.cfg + The MPAS build routines were modified to recognize the NUOPC driver and allow the + MPAS dycore library to link to the CESM ESMF library. + +Describe any changes made to build system: + bld/configure passes NUOPC cpl information to the MPAS Makefile + src/dynamics/mpas/Makefile recognizes NUOPC cpl driver and sets CPP + defines to allow linking with the CESM ESMF library. + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: CAM SEs + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M Externals_CAM.cfg + - updated MPAS external which corrects base/rest regression test failure + +M bld/configure +M src/dynamics/mpas/Makefile + - set MPAS CPP defines for linking using CESM ESMF library. + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9.mpasa120z32_mpasa120.FKESSLER.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + - Expected difference with baseline due to new initialization of extra neighbor cells. All + prognostic fiels are BFB. + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + +izumi/pgi/aux_cam: + - All pass + +Summarize any changes to answers: + Only changes to extra neighbor cells not used in prognostic field calculations. + With the exception of edgesOnCell, edgesOnEdge, cellsOnCell, and verticesOnCell fields + all other history fields are BFB. + +=============================================================== +=============================================================== + +Tag name: cam6_3_022 +Originator(s): fvitt, cacraig +Date: 22 Jun 2021 +One-line Summary: Update H2O2+OH reaction rate; use CCPP version of Held-Suarez +Github PR URLs: + https://github.com/ESCOMP/CAM/pull/380 + https://github.com/ESCOMP/CAM/pull/386 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + gas phase reaction rate in pp_trop_mam3 and mam4 is out of date #372 + Get Held_Suarez from atmospheric_physics repository #267 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: CAM SEs + +List all files eliminated: + +D src/physics/simple/held_suarez.F90 + - replaced with CCPP'ized Held-Suarez physics + +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_tmoz/shell_commands +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_tmoz/user_nl_cam +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_tmoz/user_nl_clm + - replaced with QPMOZ test + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + + +M src/chemistry/pp_trop_mam3/chem_mech.doc +M src/chemistry/pp_trop_mam3/chem_mech.in +M src/chemistry/pp_trop_mam3/mo_setrxt.F90 + - update H2O2 + OH -> H2O + HO2 reaction rate to JPL database + +M src/chemistry/pp_trop_mam4/chem_mech.doc +M src/chemistry/pp_trop_mam4/chem_mech.in +M src/chemistry/pp_trop_mam4/chem_mods.F90 +M src/chemistry/pp_trop_mam4/m_rxt_id.F90 +M src/chemistry/pp_trop_mam4/m_spc_id.F90 +M src/chemistry/pp_trop_mam4/mo_adjrxt.F90 +M src/chemistry/pp_trop_mam4/mo_indprd.F90 +M src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 +M src/chemistry/pp_trop_mam4/mo_lu_factor.F90 +M src/chemistry/pp_trop_mam4/mo_lu_solve.F90 +M src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 +M src/chemistry/pp_trop_mam4/mo_prod_loss.F90 +M src/chemistry/pp_trop_mam4/mo_rxt_rates_conv.F90 +M src/chemistry/pp_trop_mam4/mo_setrxt.F90 +M src/chemistry/pp_trop_mam4/mo_sim_dat.F90 + - update H2O2 + OH -> H2O + HO2 reaction rate to JPL database + - use Chemistry Cafe generated mechanism file + +M src/chemistry/pp_trop_mam7/chem_mech.doc +M src/chemistry/pp_trop_mam7/chem_mech.in +M src/chemistry/pp_trop_mam7/mo_setrxt.F90 + - update H2O2 + OH -> H2O + HO2 reaction rate to JPL database + +M src/chemistry/pp_waccm_sc_mam4/chem_mech.doc +M src/chemistry/pp_waccm_sc_mam4/chem_mech.in +M src/chemistry/pp_waccm_sc_mam4/mo_setrxt.F90 + - update H2O2 + OH -> H2O + HO2 reaction rate to JPL database + +M Externals_CAM.cfg +M bld/configure +M src/physics/simple/held_suarez_cam.F90 + - CCPP'ized Held-Suarez physics + +M cime_config/config_component.xml +M cime_config/config_compsets.xml + - add MAM7 compset QPC5M7 + +M cime_config/testdefs/testlist_cam.xml + - updates to regression tests + -- add QPMOZ and QPC5M7 tests + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9.mpasa120z32_mpasa120.FKESSLER.cheyenne_intel.cam-outfrq3s_usecase (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERP_D_Ln9.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_Lm13.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + - expected failures due to update to H2O2 + OH -> H2O + HO2 reaction rate + +izumi/nag/aux_cam: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure + + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_carma (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_convmic (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.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (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: NLFAIL) 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_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) 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_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: + - expected failures due to update to H2O2 + OH -> H2O + HO2 reaction rate + +izumi/pgi/aux_cam: + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_pgi.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_pgi.cam-outfrq3s (Overall: DIFF) details: + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq9s (Overall: NLFAIL) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac (Overall: DIFF) details: + - expected failures due to update to H2O2 + OH -> H2O + HO2 reaction rate + +Summarize any changes to answers: + larger than roundoff but same climate + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source: /glade/work/emmons/src_cesm2.2.0 +- platform/compilers: cheyenne/intel +- configure commandline: + create_newcase --case /glade/u/home/emmons/cesm22_cases/f.e22.F2000climo.f09.cesm220.newrate --compset F2000climo --res f09_f09_mg17 + +- Archive location of output: + /glade/campaign/acom/acom-weather/emmons/newrate_H2O2_OH/f.e22.F2000climo.f09.cesm220.newrate + +Archive location of control simulations used to validate new climate: + /glade/campaign/acom/acom-weather/emmons/newrate_H2O2_OH/f.e22.F2000climo.f09.cesm220.orig + +URL for AMWG diagnostics output used to validate new climate: + https://acomstaff.acom.ucar.edu/emmons/cesm/f.e22.F2000climo.f09.cesm220.newrate.0002_2-f.e22.F2000climo.f09.cesm220.orig.0002_2/ + +=============================================================== +=============================================================== +Tag name:cam6_3_021 +Originator(s):katetc,sjsprecious,johnmauff,andrewgettelman +Date: 04 June 2021 +One-line Summary: Update CAM codes for Casper and the execution of qsat* subroutines on GPU +Github PR URL:https://github.com/ESCOMP/CAM/pull/366 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Change the tag of stable PUMAS codes to pumas_cam-release_v1.16 . +. Update configuration files pgi and nvhpc compilers to accommodate the changes in the CIME repo. +. Add some CPU and GPU tests for Casper to the test list, as well as their configurations. +. Add OpenACC directives to the qsat* subroutines to enable their execution on GPU. +. Change the svp_water and svp_ice subroutines to scalar functions in the zm_microphysics.F90 +subroutine, avoiding the non-stridded access to the t and es array in the previous version. +. Add in PUMAS bug fixes from v1.13 that were supposed to go in v1.12. +. Fixed issue #367 Unsupported execution of qsat* subroutines on GPU and missing settings for +Casper machine +. Fix TMC tests on Izumi/nag and removed extra equals from test_driver.sh that was causing +the TGIT test to inappropriately fail. + +Describe any changes made to build system: + +. Adding FC_TYPE support for nvhpc, pgi-gpu, and nvhpc-gpu compilers in the Makefile.in and + build xml config definition.xml file. +. Added fc and cc options for nvhpc and nvc in the configure script. +. Added default PE layouts for Casper. + +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: nusbaume, gold2718, fvitt, cacraigucar, peverwhee + +List all files eliminated: None. + +List all files added and what they do: + +. cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_casper/shell_commands + - Adding xmlchange commands for the new mg3_casper test + +. cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_casper/user_nl_cam + - Adding cam namelist settings for the new mg3_casper test + +. cime_config/testdefs/testmods_dirs/cam/outfrq9s_mg3_casper/user_nl_clm + - Adding clm namelist settings for the new mg3_casper test + +List all existing files that have been modified, and describe the changes: + +. Externals.cfg + - Change cime tag from cime5.8.42 to cime5.8.44 + +. Externals_CAM.cfg + - Change PUMAS tag from pumas_cam-release_v1.12 to pumas_cam-release_v1.16 + +. bld/Makefile.in + - Add flags for NVHPC compilers + +. bld/config_files/definition.xml + - Add support for fc_type as nvhpc,pgi-gpu,nvhpc-gpu + +. bld/configure + - Add options for fc_type nvhpc + +. cime_config/SystemTests/tmc.py + - Fix py2 fopen error, Fix test to appropriately FAIL due to change in mass + as read from logs + +. cime_config/config_pes.xml + - Add a default PE layout for Casper + +. cime_config/testdefs/testlist_cam.xml + - Add tests for Casper for each cpu and gpu compiler + - Add test_release 2 degree QPC and QSC tests + +. src/physics/cam/clubb_inter.F90 + - Replace wv_sat_qsat_ice_vect call with wv_sat_qsat_ice (origional) for now + +. src/physics/cam/macrop_driver.F90 + - Add acc directives for wv_sat_qsat_water_vect + +. src/physics/cam/micro_mg_cam.F90 + - Add acc directives for size_dist_param_liq and size_dist_param_basic + +. src/physics/cam/wv_sat_methods.F90 + - Make VLENS a parameter + - Remove OldGoffGratch and log_ps parameter + - Remove elemental from Bolton_svp_water + - Add acc directives for all other water vapor subroutines + +. src/physics/cam/wv_saturation.F90 + - Make VLENS a parameter + - Add some logical "present" variables to reduce calls in loops for several subroutines + - Add acc directives for all saturation subroutines + +. src/physics/cam/zm_microphysics.F90 + - Add back in calls to svp_water and svp_ice + +. test/system/test_driver.sh + - Remove extra equal sign on line 457 that caused TGIT test to crash + +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. + +cheyenne/intel/aux_cam: + - Failed due to changes in cam6_3_020. Unable to address the problem in this tag. + See issue #389 + ERC_D_Ln9.mpasa120z32_mpasa120.FKESSLER.cheyenne_intel.cam-outfrq3s_usecase (Overall: FAIL) details: + FAIL ERC_D_Ln9.mpasa120z32_mpasa120.FKESSLER.cheyenne_intel.cam-outfrq3s_usecase COMPARE_base_rest + + - Slight answer changes due to bug fix in MG3/PUMAS + ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_020: DIFF + + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_020: DIFF + +izumi/nag/aux_cam: + - pre-existing / known failure + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + +izumi/pgi/aux_cam: + - None + +CAM tag used for the baseline comparison tests if different than previous +tag: cam6_3_020 + +Summarize any changes to answers, i.e., +- what code configurations: Slight answer changes when using MG3 +- what platforms/compilers: All +- nature of change (roundoff; larger than roundoff but same climate; new + climate): larger than roundoff but same climate (validated with ensemble test) + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + + +=============================================================== +Tag name:cam6_3_020 +Originator(s):eaton,pel,mgduda,jet +Date: 04 June 2021 +One-line Summary:MPAS development updates, bug fixes, performance enhancements, refactor/cleanup +Github PR URL:https://github.com/ESCOMP/CAM/pull/303 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Remove unused code in build-namelist for generating MPAS streams files. + +. Fix to allow MPAS to run with 1 task. + +. Fix to allow MPAS to run with NAG/debug. + +. Replace bad grid file for running 480-km res with no topo. + +. Fix for bug when MPAS dycore is substepping during physics timestep. + +. Update calculation of hydrostatic pressure from MPAS state. + +. Add ability to write initial file when using MPAS dycore. + +. Correct interface error when calculating CAM pressures from MPAS height. + +. update the MPAS-A dycore tag and CAM files associated with namelists in order + to support building with the ESMF/NUOPC driver and to introduce two new + absorbing layer options + + 1. A diffusion scheme similar to CAM-SE. Using a mpas_cam_coef = 1.0 will give + a damping coefficient of 0.2216E7, 0.6482E6, 0.1927E6 in the top-most three layers on + the dynamics variables u, w, and theta. The top 3 damping coefficients scale + linearly with mpas_cam_coef. + + This option is controlled by the namelist variable mpas_cam_coef. + + 2. A Rayleigh damping on the horizontal momentum with a user-specified damping + timescale and a linear ramp over a user-specified number of levels from + the model top. + + This option is controlled by the namelist variables mpas_rayleigh_damp_u, + mpas_rayleigh_damp_u_timescale_days, and mpas_number_rayleigh_damp_u_levels. + +. Add calls to MPAS framework routines to write out detailed timers + for individual components of the MPAS-A dycore at the end of a simulation. This + can be helpful in comparing the runtime performance of CAM-MPAS with stand- + alone MPAS-Atmosphere, which already had detailed timers. + +. Port weak scaling mods to MPAS + +Describe any changes made to build system: + +. The script and XML files for building namelists have been updated to + accommodate four new namelist options associated with the two new upper + absorbing layers. + +Describe any changes made to the namelist: + +. Four new namelist options have been added to the &damping group: + mpas_cam_coef, mpas_rayleigh_damp_u, mpas_rayleigh_damp_u_timescale_days, and + mpas_number_rayleigh_damp_u_levels. + +List any changes to the defaults for the boundary datasets: +. New 120km and 480km defaults for mpas dry deposition + atm/cam/chem/trop_mam/atmsrf_mpasa120_c090720.nc + atm/cam/chem/trop_mam/atmsrf_mpasa480_c090720.nc + +Describe any substantial timing or memory changes: + +Code reviewed by:MiCurry, mgduda, cacraigucar, gold2718, fvitt, peverwhee, nusbaume + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +Externals_CAM.cfg +. Update the MPAS-A dycore external to 224740a hash includes changes for NUOPC + +Externals.cfg +. Update to cime5.8.42 from 5.8.37 + +bld/build-namelist +. remove code that executes the mpas streams_gen utility. It's not being + used. +. Add add_default calls for new namelist options. + +bld/configure +. modified the configure for mpas to include the weak scaling mods in the infrastructure directory + +bld/namelist_files/namelist_defaults_cam.xml +. replace mpas grid file mpasa480_L32_v6.1.grid_c190924.nc by + mpasa480_L32_notopo_grid_c201125.nc +. add a topo file for analytic FAMIP starts + mpasa120_L32_topo_coords_c201022.nc +. new defaults: longer time step, change 3rd-order scalar transport upwind coefficient + mpas_dt 600s => 900s + mpas_coef_3rd_order 0.25 => 1.0 +. Add default values for new namelist options. + +bld/namelist_files/namelist_definition.xml +. Add definitions of new namelist options. + - mpas_cam_coef: A fixed, second-order horizontal diffusion in the top-most three layers on + the dynamics variables u, w, and theta. + - mpas_rayleigh_damp_u: apply rayleigh damping to u + - mpas_rayleigh_damp_u_timescale_days: rayleigh damping timescale + - mpas_number_rayleigh_damp_u_levels: number of levels to damp starting from the top layer. + +src/dynamics/mpas/Makefile +. Add CPP define for use of external ESMF library when running with NUOPC driver + +src/dynamics/mpas/dp_coupling.F90 +. fix calculation of CAM pressure from MPAS height coordinate. +. sub: d_p_coupling - weak scaling mods for MPAS. +. sub: p_d_coupling - weak scaling mods for MPAS. + +src/dynamics/mpas/driver/cam_mpas_subdriver.F90 +. Start a root timer ("total time") in cam_mpas_init_phase2, after the MPAS + timer module has been initialized by a call to mpas_framework_init_phase2, and + stop the root timer in cam_mpas_finalize. All other timers need to be nested + within this root timer. +. Make calls to write out MPAS timers to the CAM log file in cam_mpas_finalize. +. Also in cam_mpas_finalize, add a missing call to mpas_log_finalize and + deallocate the MPAS corelist. + +src/dynamics/mpas/dyn_comp.F90 +. Add target attribute to the module data arrays for height which are + pointed to by the hist_coords objects in the cam_history_support module. + NAG/debug requires this. +. remove the variable swap_time_level_ptrs + sub: cam_mpas_namelist_read + - allow the &decomposition namelist group to be missing by removing the + endrun call. When running with 1 task the partition file specified in + this group is not read. + - Add Fortran code to read new namelist options and add them to the MPAS config pool. + sub: dyn_init + - change the dyn_out components with 2 time levels to point to the same + memory locations as the dyn_in components + - remove the code that copied dyn_in to dyn_out. The dyn_out pointers now point + to the same memory locations as the dyn_in pointers. + - remove setting swap_time_level_ptrs + sub: dyn_run + - after call to cam_mpas_run update the dyn_in/dyn_out pointers to point + to the MPAS current state in pool arrays with timeLevel=1 + sub:pread_inidat + - update computation of hydrostatic pressure profiles. + sub: set_base_state + - update computation of hydrostatic pressure used by base state. + +src/dynamics/mpas/dyn_grid.F90 + sub:dyn_grid_init - MPAS weak scaling mods + sub:get_dyn_grid_info - new subroutine to implement weak scaling + - get_dyn_grid_info fills out an array of physics_column_t used + to translate between physics and dynamics columns. +src/physics/cam/cam_diagnostics.F90 +. add PMID PINT as MPAS defaults to help interpolating history from height to pressure levels + +src/physics/cam/geopotential.F90 +. refactor calculation of hydrostatic elements to make explicit the algorithm + used by each dycore. BFB with older code just cleaner. + +src/dynamics/mpas/stepon.F90 + sub: stepon_run1 + - remove code to swap pointers after d_p_coupling + sub: shift_time_levels + - remove this routine. no longer needed. + sub: write_initial_file + - new subroutine to generate the initial filename, open a pio filehandle + to that file, and call the same mpas routines that are used to write to + the restart file. + sub: write_dynvar + - add conditional using write_inithist to call write_initial_file and + have MPAS write the initial file. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: + - expected failures due to mpas namelist updates + ERC_D_Ln9.mpasa120z32_mpasa120.FKESSLER.cheyenne_intel.cam-outfrq3s_usecase (Overall: FAIL) details: + FAIL ERC_D_Ln9.mpasa120z32_mpasa120.FKESSLER.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9.mpasa120z32_mpasa120.FKESSLER.cheyenne_intel.cam-outfrq3s_usecase COMPARE_base_rest + FAIL ERC_D_Ln9.mpasa120z32_mpasa120.FKESSLER.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_019: DIFF + + - The following coupled (mostly FCASE) tests had fieldlist differences but were + otherwise identical (considered a PASS). + Fieldlist differences were from the coupler and clm. + These differences were due to the update of cime from 5.8.37 + to 5.8.42. All tests pass without fieldlist differences under cime5.8.37 + According to Bill Sacks + "those CLM field list diffs are considered okay (as noted by the "IDENTICAL" + the end of the file). The distinction is whether the fields are time-varying + or time-constant. We allow differences in time-constant fields between the + two cases, because this is sometimes expected when comparing a restart + segment with an initial segment (since the time-constant fields are only + on the first history file in a run)." + + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + +izumi/nag/aux_cam: + - pre-existing failure + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + +izumi/pgi/aux_cam: + +Summarize any changes to answers, i.e., +- what code configurations: MPAS dycore +- what platforms/compilers: All +- nature of change: Larger than roundoff + +=============================================================== +=============================================================== + +Tag name: cam6_3_019 +Originator(s): fvitt, cacraig +Date: 12 May 2021 +One-line Summary: Fix indexing issue in reaction rates; remove duplicate pbuf_ snapshot names +Github PR URLs: + https://github.com/ESCOMP/CAM/pull/369 + https://github.com/ESCOMP/CAM/pull/374 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + error in MPAN+M reaction #364 + snapshot has output names with an extra pbuf_ in them #373 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: CAM SEs + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M src/chemistry/mozart/mo_usrrxt.F90 + - set tag_MCO3_NO2_ndx to usr_MCO3_NO2_ndx when tag_MCO3_NO2_ndx is not set + +M src/control/cam_snapshot.F90 + - remove 'pbuf_' prefix from names + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9.f19_f19_mg17.QPC4.cheyenne_intel.cam-outfrq3s_tmoz (Overall: DIFF) details: + FAIL ERC_D_Ln9.f19_f19_mg17.QPC4.cheyenne_intel.cam-outfrq3s_tmoz BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_018: DIFF + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_018: DIFF + ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_018: DIFF + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + FAIL ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_018: DIFF + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_018: DIFF + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL SMS_D_Ln9.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_018: DIFF + SMS_D_Ln9.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_018: DIFF + SMS_Ld1.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_018: DIFF + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_018: DIFF + SMS_Ln9.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + FAIL SMS_Ln9.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_018: DIFF + - expected CAM-Chem and WACCM failures due to correction to reaction rate constant + +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 COMPARE_base_da + - pre-existing failure + +izumi/pgi/aux_cam: All PASS + +Summarize any changes to answers, i.e., +- what code configurations: CAM-Chem and WACCMX tsmlt +- what platforms/compilers: All +- nature of change: Larger than roundoff + +=============================================================== +=============================================================== + +Tag name: cam6_3_018 +Originator(s): fvitt, tilmes +Date: 22 Apr 2021 +One-line Summary: Turn on aerosol convective processes and SOA bug fix +Github PR URL: https://github.com/ESCOMP/CAM/pull/315 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Correction to surface area densities + -- #298: Code fix in aero_model.F90 + Corrections to molecular weights + -- #299: Bug report and suggested change modal_aero_data.F90 + and in modal_aero_gasaerexch.F90 + Turn on aerosol convective processes for cam6 physics when ZM deep convection is used + -- #322: convective wet scavening namelist changes + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + Default to the following settings for cam6 physics configurations + that use ZM deep convection scheme: + convproc_do_aer = .true. + convproc_do_evaprain_atonce = .true. + convproc_pom_spechygro = 0.2D0 + convproc_wup_max = 4.0D0 + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: CAM review team + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M src/chemistry/modal_aero/aero_model.F90 + - include p-organics in index_chm_mass -- issue #298 + +M src/chemistry/modal_aero/modal_aero_data.F90 + - use cnst_mw to set molecular weights for all configurations + -- remove hard wired molecular weights + +M src/chemistry/modal_aero/modal_aero_gasaerexch.F90 + - remove hard wired values of SOA molecular weights + +M bld/build-namelist + - set default namelists for aerosol convective processes if physics is cam6 + and deep_scheme is 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. + +cheyenne/intel/aux_cam: + + ERC_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + FAIL ERC_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp NLCOMP + FAIL ERC_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase NLCOMP + FAIL ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERP_D_Ln9.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d NLCOMP + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERP_Ln9.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERP_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERP_Ln9.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + FAIL ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 NLCOMP + FAIL ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SCT_D_Ln7.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + FAIL SCT_D_Ln7.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_D_Ld2.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + FAIL SMS_D_Ld2.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + FAIL SMS_D_Ln9.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_D_Ln9.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie NLCOMP + FAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_D_Ln9.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL SMS_D_Ln9.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_D_Ln9.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE exception + SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_Ld1.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + FAIL SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 NLCOMP + FAIL SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 MEMCOMP Error: Memory usage increase > 10% from baseline + SMS_Lm13.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m NLCOMP + FAIL SMS_Lm13.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + FAIL SMS_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging NLCOMP + FAIL SMS_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_Ln9.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + FAIL SMS_Ln9.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s NLCOMP + FAIL SMS_Ln9.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_Ln9.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + FAIL SMS_Ln9.f19_f19.F2000climo.cheyenne_intel.cam-silhs BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_017: DIFF + SMS_Ln9.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: NLFAIL) details: + FAIL SMS_Ln9.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem NLCOMP + - expected failures in MAM configurations due to changes to convective processes, molecular weights and surface area densities + +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 COMPARE_base_da + - pre-existing failure + + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_carma (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_carma BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am NLCOMP + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic NLCOMP + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist NLCOMP + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + FAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + FAIL ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + FAIL ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 NLCOMP + FAIL ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + FAIL ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + FAIL SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + FAIL SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: NLFAIL) details: + FAIL SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba NLCOMP + SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase NLCOMP + FAIL SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_nag: DIFF + - expected baseline failures in MAM configurations due to changes to convective processes, molecular weights and surface area densities + +izumi/pgi/aux_cam: + + ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_pgi.cam-outfrq3s_unicon (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_pgi.cam-outfrq3s_unicon BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_pgi: DIFF + ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_pgi.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_pgi.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_pgi: DIFF + ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_pgi: DIFF + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_pgi: DIFF + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_pgi: DIFF + PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_pgi: DIFF + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 (Overall: DIFF) details: + FAIL SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 NLCOMP + FAIL SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_pgi: DIFF + SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_017_pgi: DIFF + - expected baseline failures in MAM configurations due to changes to convective processes, molecular weights and surface area densities + +Summarize any changes to answers: larger than roundoff and climate changing + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + +on cheyenne: + ./create_newcase --compset F2000climo --project P19010000 -res f09_f09_mg17 + + cases: + /glade/p/cesm/chwg_dev/tilmes/cases/cesm2_ch/f.e22.F2000.f09_f09_mg17.cam_cesm2_2_rel_02.control + /glade/p/cesm/chwg_dev/tilmes/cases/cesm2_ch/f.e22.F2000.f09_f09_mg17.cam_cesm2_2_rel_02.soafix + /glade/p/cesm/chwg_dev/tilmes/cases/cesm2_ch/f.e22.F2000.f09_f09_mg17.cam_cesm2_2_rel_02.soafix2 + +Campaign storage location of the simulations used to validate new climate: + + /glade/campaign/acom/acom-climate/tilmes/CESM2/f.e22.F2000.f09_f09_mg17.cam_cesm2_2_rel_02.control + /glade/campaign/acom/acom-climate/tilmes/CESM2/f.e22.F2000.f09_f09_mg17.cam_cesm2_2_rel_02.soafix + /glade/campaign/acom/acom-climate/tilmes/CESM2/f.e22.F2000.f09_f09_mg17.cam_cesm2_2_rel_02.soafix2 + +URLs for AMWG diagnostics output used to validate new climate: + + with code clean up, change molecular weights and soa bug fix; without changes to convective wet removal: + https://acomstaff.acom.ucar.edu/tilmes/amwg/aerosol/f.e22.F2000.f09_f09_mg17.cam_cesm2_2_rel_02.soafix.2_11-f.e22.F2000.f09_f09_mg17.cam_cesm2_2_rel_02.control.2_11/ + + with above changes including convective wet removal: + https://acomstaff.acom.ucar.edu/tilmes/amwg/aerosol/f.e22.F2000.f09_f09_mg17.cam_cesm2_2_rel_02.soafix2.2_11-f.e22.F2000.f09_f09_mg17.cam_cesm2_2_rel_02.control.2_11/ + +=============================================================== +=============================================================== + +Tag name: cam6_3_017 +Originator(s): katetc, andrewgettelman, sjsprecious +Date: 12 April 2021 +One-line Summary: Changes to CAM physics and PUMAS microphysics to optimize for GPU offloading. +Github PR URL: + https://github.com/ESCOMP/CAM/pull/323 + https://github.com/ESCOMP/CAM/pull/324 + https://github.com/ESCOMP/CAM/pull/350 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + We are working with CISL engineers to prepare the microphysics code for GPU usage. The two + first pull requests vectorize routines in the PUMAS/MG code and the water vapor saturation + code used throughout CAM physics. This pull request also fixes some bugs in PUMAS and two + tests in the CAM test_driver suite. The pull requests were broken into two parts to make + any code reviews easier. + + The izumi-Nag test suite had a problem with one test that would PASS when run individually, + but FAIL when run as part of the suite. This test would fail at runtime with a bad floating + point operation in mg_postproc_accumulate. After discussions with SEs and scientists, we + decided to update the test to a more modern configuration. The following test: + ERI_D_Ln18.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 + Has now been updated to: + ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 + This does include a change in dycore as there is no CAM6 ncdata file for the global Eularian + dycore. The test now reliably passes. There are plans to remove and rework the mg_postprocess + code in a near future timeframe. + + Github Issues: + PUMAS (Microphysics) Bug Fixes #329 + Modify conditionals to avoid potential divide by zero in micro_mg_cam #309 + Bug in FSCAM with GNU compilers in DEBUG mode #257 + TR8 test gives incorrect summary #341 + +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: + gold2718, fvitt, cacraigucar, peverwhee, nusbaume + +List all files eliminated: + None + +List all files added and what they do: + None + +List all existing files that have been modified, and describe the changes: + +M Externals_CAM.cfg + - Update PUMAS tag to v1.12 +M cime_config/testdefs/testlist_cam.xml + - Changed ERI_D_Ln18 ghgrmp_e8 test to QPC6 on f19_f19_mg17 +M src/chemistry/bulk_aero/seasalt_model.F90 + - Vectorized call to qsat +M src/chemistry/modal_aero/modal_aero_newnuc.F90 + - Vectorized call to qsat +M src/chemistry/mozart/mo_gas_phase_chemdr.F90 + - Vectorized call to qsat +M src/chemistry/utils/modal_aero_wateruptake.F90 + - Update call to qsat to use new vector param list +M src/physics/cam/aer_rad_props.F90 + - Vectorized call to qsat +M src/physics/cam/cam_diagnostics.F90 + - Vectorized call to qsat and svp_ice +M src/physics/cam/cldfrc2m.F90 + - Vectorized call to qsat_water, svp_water and svp_ice +M src/physics/cam/cldwat.F90 + - Vectorized call to qsat +M src/physics/cam/cldwat2m_macro.F90 + - Vectorized call to qsat_water and qsat_ice +M src/physics/cam/cloud_fraction.F90 + - Vectorized call to qsat, qsat_water and svp_ice +M src/physics/cam/clubb_intr.F90 + - Vectorized ice_macro_tend and liquid_macro_tend +M src/physics/cam/convect_shallow.F90 + - Vectorized call to qsat +M src/physics/cam/cospsimulator_intr.F90 + - Vectorized call to qsat_water +M src/physics/cam/eddy_diff.F90 + - Vectorized call to qsat +M src/physics/cam/hetfrz_classnuc_cam.F90 + - Vectorized svp_water and svp_ice +M src/physics/cam/hk_conv.F90 + - Vectorized call to qsat +M src/physics/cam/macrop_driver.F90 + - Vectorized call to wv_sat_qsat_ice and wv_sat_qsat_water +M src/physics/cam/micro_mg_cam.F90 + - Vectorized size_dist_param_liq and size_dist_param_basic +M src/physics/cam/nucleate_ice_cam.F90 + - Small change to call to qsat_water +M src/physics/cam/vertical_diffusion.F90 + - Vectorized calls to qsat +M src/physics/cam/wv_sat_methods.F90 + - Added vectorized versions of wv_sat_qsat_water, wv_sat_qsat_ice, + wv_sat_svp_trans, wv_sat_svp_to_qsat, wv_sat_svp_water, and + wv_sat_svp_ice to be used in other functions. Cleaned up some + code in wv_sat functions that didn't need to be calculated each + time through the loop. Added log_ps as a module parameter. +M src/physics/cam/wv_saturation.F90 + - Added a vectorized version of qsat, qsat_water, svp_water, svp_ice, + svp_to_qsat, svp_trans, estblf, tq_enthalpy, no_ip_hltalt, + calc_hltalt, deriv_outputs and findsp +M src/physics/cam/zm_conv.F90 + - Vectorized qsat and change qsat_hPa from elemental to subroutine +M src/physics/spcam/crmclouds_camaerosols.F90 + - Vectorized call to qsat_water + + +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. + +cheyenne/intel/aux_cam: + +- Expected Baseline compare failures for configurations using CAM5 and CAM6 physics due to answer-changing changes in MG/PUMAS microphysics: + +ERC_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + FAIL ERC_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERP_D_Ln9.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + FAIL ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERP_Ln9.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERP_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERP_Ln9.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERP_Ln9.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + FAIL ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SCT_D_Ln7.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + FAIL SCT_D_Ln7.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_D_Ld2.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + FAIL SMS_D_Ld2.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_D_Ln9.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + FAIL SMS_D_Ln9.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_D_Ln9.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_D_Ln9.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_D_Ln9.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL SMS_D_Ln9.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_D_Ln9.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_Ld1.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_Lm13.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + FAIL SMS_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_Ln9.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + FAIL SMS_Ln9.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +SMS_Ln9.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + FAIL SMS_Ln9.f19_f19.F2000climo.cheyenne_intel.cam-silhs BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + FAIL SMS_Ln9.f19_f19.F2000climo.cheyenne_intel.cam-silhs TPUTCOMP Error: TPUTCOMP: Computation time increase > 25% from baseline + +SMS_Ln9.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + FAIL SMS_Ln9.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_016: DIFF + +izumi/nag/aux_cam: + +- Expected Failure: +DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + +- Expected Baseline compare failures in CAM5 and CAM6 physics due to answer-changing changes in microphysics: + +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_carma (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_carma BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic TPUTCOMP Error: TPUTCOMP: Computation time increase > 25% from baseline + +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + FAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + FAIL ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + FAIL ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + FAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 TPUTCOMP Error: TPUTCOMP: Computation time increase > 25% from baseline + +PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + FAIL SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + FAIL SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: DIFF + +- Test Updated; no previous baselines: + +ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + FAIL ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag: ERROR BFAIL baseline directory '/fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_nag/ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8' does not exist + + +izumi/pgi/aux_cam: + +- Expected Baseline compare failures in CAM5 and CAM6 physics due to answer-changing changes in microphysics: + +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_pgi.cam-outfrq3s_unicon (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_pgi.cam-outfrq3s_unicon BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_pgi: DIFF + +ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_pgi.cam-rad_diag (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_pgi.cam-rad_diag BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_pgi: DIFF + +ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_pgi.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_pgi.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_pgi: DIFF + +ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq3s_ba (Overall: DIFF) details: + FAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq3s_ba BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_pgi: DIFF + +ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_pgi.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_pgi: DIFF + +PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_pgi: DIFF + +PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_pgi: DIFF + +PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_pgi: DIFF + +SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 (Overall: DIFF) details: + FAIL SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_pgi: DIFF + +SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_016_pgi: DIFF + +Summarize any changes to answers: + - All configurations that use CAM5 and CAM6 physics will have new climate changing answers. These apply to all platforms and all compilers. Andrew verfied the changes but the diagnostics output was not saved. + + +=============================================================== + +Tag name: cam6_3_016 +Originator(s): fvitt, goldy, jedwards +Date: 31 Mar 2021 +One-line Summary: Generalize coupling of WACCMX ionosphere to CAM physics; CMEPS/NUOPC threading +Github PR URL: + https://github.com/ESCOMP/CAM/pull/264 + https://github.com/ESCOMP/CAM/pull/348 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + ESMF regridding utilities are used to regrid fields between independent ion transport + geographic and electro-dynamo geomagnetic grids and a generalized cam physics grid mesh. + The use of an ESMF gridded component to contain the ion transport and electro-dynamo + ionosphere components allows the ionosphere to be executed on a subset of CAM's MPI + tasks and for multi-instance WACCMX configurations (a requirement for WACCMX-DART). + + Github issues: + WACCMX ionosphere to CAM physics coupling #84 + WACCMX missing efield diagnostics #223 + WACCMX dies in initialization if you double the out-of-the-box processor count #151 + Add threading for CMEPS driver #349 (jedwards4b) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + + - new namelist vars: + . cam_physics_mesh + . oplus_grid + . edyn_grid + . ionos_npes + - prescribed high-latitude potential settings (for multiple files): + . ionos_epotential_amie + . amienh_files + . amiesh_files + . ionos_epotential_ltr + . ltr_files + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: CAM review team + +List all files eliminated: + +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_WX81/shell_commands +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_WX81/user_nl_cam +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_WX81/user_nl_clm +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_waccm_ma/shell_commands +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_waccm_ma/user_nl_cam +D cime_config/testdefs/testmods_dirs/cam/outfrq3s_waccm_ma/user_nl_clm + - obsolete -- removed + +D src/ionosphere/waccmx/amie.F90 + - replaced with amie_module.F90 + +List all files added and what they do: + +A src/ionosphere/waccmx/edyn_grid_comp.F90 + - ESMF gridded component for edynamo and oplus transport to + allow for running ionosphere on a subset of CAM's MPI tasks + and allows for multi-instance simulations + +A src/ionosphere/waccmx/regridder.F90 + - encapsulates 2D and 3D field mappings between physics, magnetic, and oplus grids + +A src/ionosphere/waccmx/adotv_mod.F90 + - calculate dot products on the oplus grid -- extracted from edynamo.F90 + +A src/ionosphere/waccmx/amie_module.F90 +A src/ionosphere/waccmx/ltr_module.F90 + - prescribed high-latitude potential + +A src/ionosphere/waccmx/utils_mod.F90 + - code shared between ltr_module and amie_module + +A src/ionosphere/waccmx/edyn_solver_coefs.F90 + - added to workaround circular dependency issue + +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_ltr/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_ltr/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_ltr/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_ltr/user_nl_cam + - test tests for magnetosphere model high-latitude inputs + +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_multi/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_multi/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_multi/user_nl_clm + - multi-instance test + +List all existing files that have been modified, and describe the changes: + +M bld/build-namelist + - remove wxi ionosphere option + - allow waccmx with any dycore + - set defaults for cam physics mesh file, oplus and edyn grid resolutions + +M bld/config_files/definition.xml + - remove wxi ionosphere option + +M bld/configure + - remove wxi ionosphere option + - remove 81 level configuration + - allow any dycore + - remove WACCMX_EDYN_ESMF and WACCMX_IONOS cpp variables + +M bld/namelist_files/namelist_defaults_cam.xml + - add defaults for SE WACCMX + - add defaults for cam physics mesh file, oplus and edyn grid resolutions + - update IC files + +M bld/namelist_files/namelist_definition.xml + - new namelist vars: + . cam_physics_mesh + . oplus_grid + . edyn_grid + . ionos_npes + - prescribed high-latitude potential settings (for multiple files): + . ionos_epotential_amie + . amienh_files + . amiesh_files + . ionos_epotential_ltr + . ltr_files + +M bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml + - update IC file + +M bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml + - IC for 81 levels + +M bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml + - fincl7 only for FV dycore + - dev24del2flag only for FV dycore + +M cime_config/config_component.xml +M cime_config/config_pes.xml + - set default PE layouts for WACCMX SE + - change cheyenne default PE layouts for WACCMX FV + +M cime_config/testdefs/testlist_cam.xml + - add tests for WACCMX SE + - add multi-instance test + - misc adjustments to WACCMX FV tests + +M cime_config/testdefs/testmods_dirs/cam/outfrq1d_amie/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_576tsks/shell_commands +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_576tsks/user_nl_clm +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_amie/user_nl_cam +M cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/user_nl_cam + + +M src/chemistry/mozart/short_lived_species.F90 + - replace WACCMX_IONOS with WACCMX_PHYS + - clean up + +M src/control/cam_comp.F90 + - remove dyn_in from ionosphere_run2 arguments + +M src/dynamics/se/dycore/prim_advance_mod.F90 + - allow SE dycore with species dependent thermodynamics in waccmx + +M src/dynamics/se/dycore/prim_advection_mod.F90 + - expand the write format for small pressures near the top of WACCMX + +M src/ionosphere/ionosphere_interface.F90 + - remove dyn_in from ionosphere_run2 arguments + +M src/ionosphere/waccmx/ionosphere_interface.F90 +M src/ionosphere/waccmx/dpie_coupling.F90 +M src/ionosphere/waccmx/edyn_esmf.F90 +M src/ionosphere/waccmx/edyn_init.F90 +M src/ionosphere/waccmx/edyn_maggrid.F90 +M src/ionosphere/waccmx/edyn_geogrid.F90 +M src/ionosphere/waccmx/edyn_mpi.F90 +M src/ionosphere/waccmx/edynamo.F90 + - infrastructure changes to be independent of CAM's dycore + -- couple ionophere to physics via ESMF regridding tools + to map between physics mesh and oplus grid and + magnetic grid + +M src/ionosphere/waccmx/edyn_mud.F90 +M src/ionosphere/waccmx/edyn_mudcom.F90 +M src/ionosphere/waccmx/edyn_mudmod.F90 +M src/ionosphere/waccmx/edyn_muh2cr.F90 +M src/ionosphere/waccmx/edyn_solve.F90 + - runtime configurable magnetic grid resolution + - put mud solver routines inside modules + +M src/ionosphere/waccmx/edyn_params.F90 +M src/ionosphere/waccmx/getapex.F90 +M src/ionosphere/waccmx/heelis.F90 +M src/ionosphere/waccmx/wei05sc.F90 + - misc clean up + +M src/ionosphere/waccmx/oplus.F90 + - include term analysis diagnostics + - misc clean up + +M src/ionosphere/waccmx/savefield_waccm.F90 + - removed deprecated re-arranger + +M src/physics/cam/cam_diagnostics.F90 + - add CPAIRV and RAIRV diagnostics + +M src/physics/cam/phys_control.F90 + - add cam_physics_mesh + +M src/physics/cam/rk_stratiform.F90 + - set only ncol columns in dlat (dlat(:ncol)=...) + +M src/physics/waccm/aurora_params.F90 + - amie_period --> prescribed_period + +M src/physics/waccm/mo_aurora.F90 + - amie_period --> prescribed_period (for AMIE and LTR inputs) + - initialize AurIPRateSum pbuf field to zero + +M src/utils/physconst.F90 + - bug fix in get_mbarv (factor indexing) + +M src/cpl/nuopc/atm_comp_nuopc.F90 +M src/physics/cam/physics_types.F90 + - fixes for threading in CMEPS/NUOPC component coupling (jedwards4b) + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_015: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_015/ERC_D_Ln9.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s' does not exist + ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_015: DIFF + ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_015: DIFF + SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie NLCOMP + FAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_015: DIFF + SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_015: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_015/SMS_D_Ln9.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s' does not exist + - expected baseline failures for WACCMX + + SMS_D_Ln9.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_015: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_015/SMS_D_Ln9.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s' does not exist + - new WACCMX test + +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 COMPARE_base_da + - pre-existing failure + + SMS_D_Ln9.ne5_ne5_mg37.QPC4X.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9.ne5_ne5_mg37.QPC4X.izumi_nag.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9.ne5_ne5_mg37.QPC4X.izumi_nag.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_015_nag: ERROR BFAIL baseline directory '/fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_015_nag/SMS_D_Ln9.ne5_ne5_mg37.QPC4X.izumi_nag.cam-outfrq9s' does not exist + - expected failure -- new test for WACCMX + +izumi/pgi/aux_cam: all PASS + +Summarize any changes to answers: bit-for-bit unchanged except for WACCMX configurations + +=============================================================== +=============================================================== + +Tag name: cam6_3_015 +Originator(s): mvertens, goldy +Date: 2021-03-24 +One-line Summary: New changes for single column functionality in CMEPS/NUOPC +Github PR URL: https://github.com/ESCOMP/CAM/pull/346/files + +Purpose of changes: + #347: Add single column functionality to NUOPC cap + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: goldy + +List all files eliminated: NA + +List all files added and what they do: NA + +List all existing files that have been modified, and describe the changes: +cime_config/buildcpp + - Added comment describing NUOPC handling of grids +cime_config/testdefs/testlist_cam.xml + - Increased wallclock time for 2 degree FXHIST prealpha test +cime_config/testdefs/testmods_dirs/cam/nudging/shell_commands +cime_config/testdefs/testmods_dirs/cam/outfrq9s_leapday/shell_commands +cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/shell_commands +cime_config/testdefs/testmods_dirs/cam/reduced_hist3s/shell_commands +cime_config/testdefs/testmods_dirs/cam/silhs/shell_commands + - Increase run frequency for ROF and GLC components to every ATM interval + for NUOPC driver tests. +doc/ChangeLog + - Highlights, film at 11 +src/cpl/nuopc/atm_comp_nuopc.F90 +src/cpl/nuopc/atm_import_export.F90 + - Updates to support single column mode + +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. + +cheyenne/intel/aux_cam: ALL PASS + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - Existing failure + +izumi/pgi/aux_cam: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers: NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced: NA + +=============================================================== + +Tag name: cam6_3_014 +Originator(s): cchen, cacraig +Date: March 23, 2021 +One-line Summary: Contrail parametrization added to CAM +Github PR URL: https://github.com/ESCOMP/CAM/pull/277 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +Contrail Parameterization: https://github.com/ESCOMP/CAM/issues/274 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - "aircraft_specifier" can now take the values ac_SLANT_DIST and/or ac_TRACK_DIST to signal a contrail run + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig, goldy, fvitt, nusbaume + +List all files eliminated: + +List all files added and what they do: +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_contrail/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_contrail/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_contrail/user_nl_clm + - introduce test for contrail + +A src/physics/cam/ssatcontrail.F90 + - Actual code to process contrails + +List all existing files that have been modified, and describe the changes: +M cime_config/testdefs/testlist_cam.xml + - Add prealpha contrail test + +M src/chemistry/utils/aircraft_emit.F90 + - Adds logic to setup contrail run if either or both of ac_SLANT_DIST and ac_TRACK_DIST are in + the aircraft_specifier list + +M src/chemistry/utils/horizontal_interpolate.F90 + - add additional logic for using flight distance and making additional calculations + +M src/chemistry/utils/tracer_data.F90 + - add additional logic if a contrail run is specified + +M src/physics/cam/physpkg.F90 + - add call to ssatcontrail_d0 (which returns immediately if not a contrail run) + +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. + +cheyenne/intel/aux_cam: all BFB + +izumi/nag/aux_cam: all BFB except: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_carma TPUTCOMP Error: TPUTCOMP: Computation time increase > 25% from baseline + - Known failure from previous tag + +izumi/pgi/aux_cam: all BFB +=============================================================== +=============================================================== + +Tag name: cam6_3_013 +Originator(s): courtneyp, cacraig, mvertens, nusbaume, sacks +Date: March 19, 2021 +One-line Summary: miscellaneous updates & fixes, including fixing cam_snapshot with CLUBB and nuopc cap changes +Github PR URL: https://github.com/ESCOMP/CAM/pull/343 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + #265, #333: update nhtfrq namelist definition + #285: remove support for CISM1 + #286, #296: fix cam_snapshot not working with CLUBB and rename output fields to contain structure + #304: bring nuopc cap changes to cam development + #283: remove test_release category from CAM's testing + #319: remove duplicate compset definitions + #112: consider adding a license file + +Describe any changes made to build system: + - update to test_driver.sh to include --xml-driver argument + - update to cime_config/buildcpp to enable nuopc build + - fix snapshot in build-namelist + +Describe any changes made to the namelist: + - nhtfrq namelist definition corrected + +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, fvitt, goldy, mvertens, nusbaume, sacks + +List all files eliminated: +D src/cpl/nuopc/atm_shr_methods.F90 + - remove; using nuopc_shr_methods instead + +List all files added and what they do: +A LICENSE + - address "consider adding a license file" (#112); pulled from CTSM + +List all existing files that have been modified, and describe the changes: +NHTFRQ NAMELIST DEFINITION (#265, #333) +M bld/namelist_files/namelist_definition.xml + - remove incorrect text + +REMOVE SUPPORT FOR CISM1 (#285) +M cime_config/config_compsets.xml +M cime_config/config_pes.xml + - remove CISM1 + +CAM_SNAPSHOT (#286, #296) +M bld/build-namelist +M src/control/cam_snapshot.F90 + - fix cam snapshot & rename output fields to contain structure + +NUOPC CAP (#304) +M Externals.cfg + - add cmeps and cdeps for nuopc cap + +M cime_config/buildcpp + - add conditional for VECT_MAP set (MCT only) + +M cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/shell_commands +M cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/shell_commands + - fix test failures + +M src/cpl/nuopc/atm_comp_nuopc.F90 +M src/cpl/nuopc/atm_import_export.F90 + - updates to enable nuopc infrastructure & cleanup + +REMOVE TEST_RELEASE CATEGORY (#283) +M cime_config/testdefs/testlist_cam.xml + - remove test_release category + - migrate test that is only in test_release category (FTJ16) to prealpha + +REMOVE DUPLICATE COMPSET DEFINITIONS (#319) +M cime_config/config_compsets.xml +M cime_config/testdefs/testlist_cam.xml + - remove duplicate compsets + - rename QPHISTC6 to QPC6HIST for consistency + +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. + +cheyenne/intel/aux_cam: All BFB + +izumi/pgi/aux_cam: All BFB + +izumi/nag/aux_cam: All BFB except: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - Known failing test from a previous commit + SMS.P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) details: + FAIL SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase NLCOMP + - Expected failure; case_name / compset name change (QPHISTC6 -> QPC6HIST) + +Additional test: +izumi/intel/FKESSLER built and ran successfully with NUOPC (Externals updated +to mvertens/bugfixes_auxcam branch of CIME, 1c49a4b hash of cmeps, +8517ebb hash of cdeps) + +=============================================================== + +Tag name: cam6_3_012 +Originator(s): ckruse, cacraig +Date: March 3, 2021 +One-line Summary: Add Horizontal Momentum Tendency Budget Variables +Github PR URL: https://github.com/ESCOMP/CAM/pull/232 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Add Horizontal Momemntum Tendency Budget Variables (#226) + - Output U and V tendencies after every physics parameterization when history_budget is set to true. For ease + of use, all tendencies are output, even if they are zero or are output under a different name. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + - "history_budget" now also outputs the horizontal momentum tendency variables after every physics parameterization + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: cacraig, goldy, fvitt, nusbaume + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M src/physics/cam/cam_diagnostics.F90 +M src/physics/cam/check_energy.F90 +M src/physics/cam/physpkg.F90 + - Add logic to output horizontal momementum tendencies after every physics parameterization + +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. + +cheyenne/intel/aux_cam: all BFB + +izumi/nag/aux_cam: + SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + FAIL SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_011_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + - expected new output fields + + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_011_nag: ERROR BFAIL some baseline files were missing + - continued known failing test + +izumi/pgi/aux_cam: + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_pgi.cam-outfrq3s_diags (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_pgi.cam-outfrq3s_diags BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_011_pgi: FIELDLIST field lists differ (otherwise bit-for-bit) + - expected new output fields + +=============================================================== +=============================================================== + +Tag name: cam6_3_011 +Originator(s): jet +Date: 1 Mar 2021 +One-line Summary: MPAS build bug in CESM, update namelist defaults +Github PR URL: https://github.com/ESCOMP/CAM/pull/338 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + This addresses issue #337:MPAS fails to build in a CESM tag and MPAS regression test fail + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + updated MPAS initial condition defaults for analytic test. Renamed MPAS coordinate only files + for analytic testing to be consistent with _vcoord_ files for other dycores. + mpasa480_L32_notopo_grid_c201125.nc renamed mpasa480_L32_notopo_coords_c201125.nc + mpasa120_L32_topo_grid_c201022.nc renamed mpasa120_L32_topo_coords_c201125.nc +Describe any substantial timing or memory changes: + +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/namelist_defaults_cam.xml + - Updated analytic IC, code now requires two additional fields be present. + + bld/configure + - environment variable pointing to MPAS source updated to work with both + standalone CAM and CESM directory structures. + +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. + + - Ran a standalone CESM MPAS regression test to verify that these mods + fixed issue #337 + + ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.cheyenne_intel.cam-outfrq3s (Overall: PASS) + +cheyenne/intel/aux_cam: all BFB except: + FAIL ERC_D_Ln9.mpasa120z32_mpasa120.FKESSLER.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + - Expected due to renaming analytic initial condition files to be + consistent with the other coordinate only (_vcoord_) files. + + +izumi/nag/aux_cam: all BFB except: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - Known failing test from a previous commit + +izumi/pgi/aux_cam: all BFB + +Summarize any changes to answers: bit-for-bit unchanged + +=============================================================== +=============================================================== + +Tag name: cam6_3_010 +Originator(s): fvitt +Date: 23 Feb 2021 +One-line Summary: Refactor QBO namelist settings; fix "-chem none" issue; remove reprosum settings from FSD test +Github PR URL: https://github.com/ESCOMP/CAM/pull/330 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + To address issues + #169: refactor WACCM settings for qbo_use_forcing + #261: ability to use "-chem none" configure option in CAM6 compsets + #334: remove reprosum namelist settings from FSD prealpha test + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all files eliminated: +D cime_config/testdefs/testmods_dirs/cam/outfrq9s_sd/user_nl_cpl + - remove reprosum namelist settings + +List all files added and what they do: + +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_nochem/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_nochem/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_nochem/user_nl_clm + - new "-chem none" test + +List all existing files that have been modified, and describe the changes: + +M bld/build-namelist + - set default qbo_use_forcing to .true. only if dycore is FV and the grid is coarse, + otherwise set to .false. + - set default qbo_cyclic to .false. + - turn on cam6 volcanic forcings only if chemistry includes prognostic MAM + +M bld/namelist_files/namelist_defaults_cam.xml + - update default qbo_forcing_file + - update phys props files of the volcanic aerosols to have unique aerosol names + +M bld/namelist_files/use_cases/aquaplanet_waccm_ma_2000_cam6.xml +M bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +M bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml +M bld/namelist_files/use_cases/sd_waccm_sulfur.xml +M bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml +M bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml +M bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml +M bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +M bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml +M bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml + - use default QBO settings + +M bld/namelist_files/use_cases/waccm_sc_2000_cam4.xml +M bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +M bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml +M bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +M bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml + - use cyclic QBO forcing if QBO forcing is applied + +M cime_config/testdefs/testlist_cam.xml + - add new aux_cam test for "-chem none" configure option with FHIST compset + +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. + +cheyenne/intel/aux_cam: + ERC_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) details: + FAIL ERC_D_Ln9.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp NLCOMP + ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase NLCOMP + ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + FAIL ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + ERP_Ln9.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: NLFAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + ERP_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_Ln9.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: NLFAIL) details: + FAIL ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 NLCOMP + ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + SMS_D_Ln9.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s NLCOMP + SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s NLCOMP + SMS_Ld1.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + FAIL SMS_Ld1.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d NLCOMP + SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + FAIL SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 NLCOMP + SMS_Lm13.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: NLFAIL) details: + FAIL SMS_Lm13.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m NLCOMP + SMS_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: NLFAIL) details: + FAIL SMS_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging NLCOMP + SMS_Ln9.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: NLFAIL) details: + FAIL SMS_Ln9.f19_f19.F2000climo.cheyenne_intel.cam-silhs NLCOMP + - the namelist compare failures are expected due to updated physics property files for cam6 volcanic aerosols + + ERC_D_Ln9.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s_WX81 (Overall: DIFF) details: + FAIL ERC_D_Ln9.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s_WX81 NLCOMP + FAIL ERC_D_Ln9.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s_WX81 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_009: DIFF + - expected baseline failure due to default QBO namelist settings added to this WACCMX test + + SMS_Ln9.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + FAIL SMS_Ln9.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem NLCOMP + FAIL SMS_Ln9.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_009: ERROR BFAIL baseline directory '/glade/p/cesm/amwg/cesm_baselines/cam6_3_009/SMS_Ln9.f19_f19_mg17.FHI + - new test -- no baselines to compare with + +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 COMPARE_base_da + -pre-existing failure + + ERC_D_Ln9.f10_f10_mg37.QPC4X.izumi_nag.cam-outfrq3s_newyear (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC4X.izumi_nag.cam-outfrq3s_newyear NLCOMP + FAIL ERC_D_Ln9.f10_f10_mg37.QPC4X.izumi_nag.cam-outfrq3s_newyear BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_009_nag: DIFF + ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_009_nag: DIFF + - expected baseline failures due to default QBO namelist settings added + + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am NLCOMP + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: NLFAIL) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic NLCOMP + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist NLCOMP + ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s NLCOMP + SMS_P48x1_D_Ln3.f09_f09_mg17.QPHISTC6.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) details: + FAIL SMS_P48x1_D_Ln3.f09_f09_mg17.QPHISTC6.izumi_nag.cam-outfrq3s_co2cycle_usecase NLCOMP + - the namelist compare failures are expected due to updated physics property files for cam6 volcanic aerosols + +izumi/pgi/aux_cam: + ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_pgi.cam-outfrq3s_diags (Overall: DIFF) details: + FAIL ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_pgi.cam-outfrq3s_diags NLCOMP + FAIL ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_pgi.cam-outfrq3s_diags BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_009_pgi: DIFF + - default QBO settings added to this waccm-sc test -- baseline differences are expected + + SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 (Overall: NLFAIL) details: + FAIL SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 NLCOMP + - updated physics property files for cam6 volcanic aerosols are updated + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: mostly bit-for-bit unchanged except for a few unsupported test cases + +=============================================================== +=============================================================== + +Tag name: cam6_3_009 +Originator(s): cacraig, goldy, jedwards, fvitt +Date: Feb 8, 2021 +One-line Summary: Update externals to match cesm2_3_alpha02a and bug fixes +Github PR URL: https://github.com/ESCOMP/pull/312 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Update externals to match externals in cesm2_3_alpha02a (https://github.com/ESCOMP/CAM/issues/307) + (note this brings in PIO2 functionality) + - Bug fixes for bugs discovered during testing + - Perform some explicit conversions + - add missing fill values for mdims + - add initialization for fields immediately prior to writing + - add missing call to pio_freedecomp + - fix no_fill bug + - fix bug with sathist + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: nusbaume,goldy + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M Externals.cfg + - update the Externals to match cesm2_3_alpha02a + +M src/control/cam_history.F90 + - perform explicit conversions from r8 to r4 + - set fillset and fill value for mdims + - allocate and initialize 2d fields for non-restart files + +M src/control/cam_history_support.F90 + - add diagnostic writes + +M src/control/sat_hist.F90 + - remove fillvalue from pio_write_darray call + - Refactor subroutine dump_columns to use pio_put_var rather than pio_write_darray. + With the use of PIO2, the unlimited column dimension was problematic in writing highly irregular distributed + sampled columns. Here we gather the sampled columns onto all tasks and the output uniform gridded data + using pio_put_var. + +M src/physics/cam/physics_buffer.F90.in + - limit diagnostic to debug runs + +M src/physics/cam/subcol_pack_mod.F90.in + - initialize data to zero for nsubcol2d array + - add diagnostic write + +M src/physics/cam/subcol_tstcp.F90 + - change write from formatted to list directed + +M src/utils/cam_grid_support.F90 + - add missing pio_feedecomp call + +M src/utils/cam_pio_utils.F90 + - fix the no_fill logic + +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. + +Tests have the following namelist changes due to updated externals: +pio_rearranger, info_taskmap_model, paramfile, dribble_crophrv_xsmrpool_2atm + +Additional change for just ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined +Differences in namelist 'cime_pes': + BASE: info_taskmap_model = 0 + COMP: info_taskmap_model = 1 + found extra variable: 'info_mprof' + found extra variable: 'info_mprof_dt' + BASE: start_type = 'continue' + COMP: start_type = 'startup' +Differences in namelist 'seq_timemgr_inparm': + BASE: restart_n = 3 + COMP: restart_n = 5 + BASE: restart_option = 'never' + COMP: restart_option = 'nsteps' + BASE: stop_n = 4 + COMP: stop_n = 9 + +cheyenne/intel/aux_cam: + ERP_Ld3.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: DIFF) details: + ERS_Ln9.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem (Overall: DIFF) details: + SMS_D_Ln9.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Lm13.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + Changes are most likely due to answer changes in the CTSM updated external + While the answer changes are numerous, it was not apparent that any were indicative of the behavior which was seen + with differences due to PIO2 errors + +izumi/nag/aux_cam: all BFB except: + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - Known failing test from previous commit + + SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_nag.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_008_nag: + - goldy and cacraig both inspected the differences and the differences do not seem to indicate an error due to PIO2 + It is assumed that the answer changes are due to the updated externals + +izumi/pgi/aux_cam: all BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_008 +Originator(s): patcal, jedwards, goldy +Date: 2020-01-10 +One-line Summary: Fixes for PIO2 plus nudging I/O update +Github PR URL: https://github.com/ESCOMP/CAM/pull/310 + +Purpose of changes (include the issue number and title text for each +relevant GitHub issue): +#237: Replace deprecated physics grid interfaces in nudging input +#248: scam tests don't work with pio2 +#263: attempt to initialize variable prior to calling intent(out) subroutine +#282: ambiguous dof when writing FV zonal mean values + +Describe any changes made to build system: NA + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: cacraig, fvitt, goldy, nusbaume + +List all files eliminated: NA + +List all files added and what they do: NA + +List all existing files that have been modified, and describe the changes: + +doc/ChangeLog + - This is what has become of my aspiring rap career +src/chemistry/mozart/mo_drydep.F90 + - Pass file_desc_t instead of file handle +src/control/cam_history.F90 + - Add fill value info required by PIO2 + - Explicitly handle conversion to 4-byte reals (req. by PIO2) +src/control/cam_restart.F90 + - Call cam_pio_set_fill for the restart file +src/control/ncdio_atm.F90 + - Return the fill value as an optional output + - Pass file_desc_t instead of file handle +src/dynamics/fv/dyn_grid.F90 + - Make sure that zonal mean grid has no duplicate points +src/dynamics/se/dyn_comp.F90 + - Detect fillvalue in input fields for reset to zero +src/physics/cam/nudging.F90 + - Use infld instead of raw NetCDF for data input + - Code cleanup +src/utils/cam_pio_utils.F90 + - Added interfaces for cam_pio_inq_var_fill and cam_pio_set_fill + These interfaces encapsulate PIO1 / PIO2 fill functionality + +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. + +cheyenne/intel/aux_cam: + + FAIL ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_007: ERROR BFAIL some baseline files were missing + - This is an expected fail because this test failed to run in cam6_3_007 + (fix is part of this PR). The baseline was verified by running this test + standalone with a compare to cam6_3_006. + +izumi/nag/aux_cam: + + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - Known (pre-existing) failure + +izumi/pgi/aux_cam: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: NA + +Summarize any changes to answers): BFB + +=============================================================== +=============================================================== + +Tag name: cam6_3_007 +Originator(s): goldy +Date: 2020-12-06 +One-line Summary: Weak scaling infrastructure and bug fixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/287 + +Purpose of changes: +#127: Fix weak scaling issues in physics decomp +#259: _Fillvalue in cam history files (remove fill value for coordinates) + +Describe any changes made to build system: + - Add weak scaling directory to override several files (see below) + +Describe any changes made to the namelist: NA + +List any changes to the defaults for the boundary datasets: NA + +Describe any substantial timing or memory changes: NA + +Code reviewed by: cacraigucar, brian-eaton, fvitt, nusbaume, PeterHjortLauritzen + +List all files eliminated: NA + +List all files added and what they do: +src/infrastructure/phys_grid.F90 + - New, scalable physics interfaces and physics grid initialization + - Uses new local-only dycore column data structure + - Note: Still contains some deprecated interfaces to allow builds during + the transition period. These interfaces are non-functional +src/infrastructure/physics_column_type.F90 + - New DDT containing local column information for dyn <==> phys coupling + +List all existing files that have been modified, and describe the changes: +bld/build-namelist +bld/config_files/definition.xml +bld/namelist_files/namelist_defaults_cam.xml + - whitespace cleanup +bld/configure + - Add src/infrastructure to Filepath for SE dycore +bld/namelist_files/namelist_definition.xml + - Improve comment and whitespace cleanup +cime_config/SystemTests/plb.py + - Use one build (same configuration for both runs) +cime_config/testdefs/testlist_cam.xml + - Remove old comment +cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/user_nl_cam + - Add a new history file with interpolated output (new baseline). +cime_config/testdefs/testmods_dirs/cam/outfrq3s_diags/user_nl_cam + - Add zonal mean output file plus do_circulation_diags=.true. +cime_config/testdefs/testmods_dirs/cam/cam4_port/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/cam4_port5d/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/cam5_port_f45/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/cam5_port_ne30/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/cam6_port_f09/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/co2rmp/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/co2rmp_1850/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/dae/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/dartcambigens/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/fire_emis/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/ghgrmp_e8/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/idphys/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/nudging/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/nuopc_cap/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq1d_amie/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq1d_newyear/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq1d_refined_camchem/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq24h_port/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq3d/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq3s_aqw/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq3s_ba/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq3s_carma/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq3s_convmic/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq3s_eoyttrac/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq3s_refined/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq3s_sathist/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq3s_subcol/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq3s_ttrac_usecase/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq3s_unicon/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq9s_576tsks/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq9s_clubbmf/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq9s_kessler/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq9s_ocnemis/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq9s_refined_camchem/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq9s_sd/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq9s_wcm_ne30/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/outfrq9s_wetdep/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/rad_diag/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/rad_diag_mam/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/reduced_hist5d/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/scam_mpace_outfrq9s/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/scm_prep/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/scm_prep_c6/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/scmarm/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/terminator/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal0/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal1/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/ttrac_loadbal3/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/volc/user_nl_cpl +cime_config/testdefs/testmods_dirs/cam/waccmx_weimer/user_nl_cpl + - Add shr_reprosum difference check +doc/ChangeLog + - Waxed poetic about modifying code +src/chemistry/mozart/epp_ionization.F90 + - Use pcols, begchunk, etc. from ppgrid (see phys_grid below for explanation) +src/chemistry/mozart/mo_airplane.F90 + - Remove ngcols_p import (not used and not always available with weak scaling) +src/chemistry/utils/tracer_data.F90 + - Use pcols, begchunk, etc. from ppgrid (see phys_grid below for explanation) +src/control/cam_comp.F90 + - Fixed module description + - Removed useless timing calls +src/control/cam_control_mod.F90 + - Removed unused local variables +src/control/cam_history_support.F90 + - Increase max_string_len to support longer filenames +src/cpl/mct/atm_comp_mct.F90 + - Remove unused imports and variables + - Use num_global_phys_cols which is the replacement for ngcols_p + - Get grid dimensions from get_grid_dims interface + - These changes allow this module to work with / without the new infrastructure +src/cpl/nuopc/atm_comp_nuopc.F90 + - Remove unused imports and variables + - Get grid dimensions from get_grid_dims interface + - These changes allow this module to work with / without the new infrastructure +src/dynamics/se/dp_coupling.F90 + - Weak scaling version of dp_coupling + - Note: Load balancing not currently supported +src/dynamics/se/dp_mapping.F90 + - Weak scaling version + - Replace dp_replicated_init with dp_allocate and dp_deallocate + - This allows creating global memory just for the dp_write routine +src/dynamics/se/dyn_comp.F90 + - Fix logic to avoid divide by zero condition (no short-circuit logic) + - Clean up logging of coordinate errors +src/dynamics/se/dyn_grid.F90 + - Weak scaling version of SE dynamics grid + - Note: Still needs some cleanup when other code is fixed +src/dynamics/se/interp_mod.F90 + - Weak scaling version of interp_mod. Use new physics grid interfaces +src/ionosphere/ionosphere_interface.F90 + - begchunk and endchunk are no longer forwarded from phys_grid +src/physics/cam/hk_conv.F90 + - Do not load deprecated phys_grid interfaces for normal builds. +src/physics/cam/phys_control.F90 + - Whitespace cleanup +src/physics/cam/phys_debug_util.F90 + - Add checks to phys_debug_lat and phys_debug_lon + - Remove unused imports + - Make unitialized default value less confusing +src/physics/cam/phys_gmean.F90 + - Write log messages to atm logfile (not cesm) + - Code and comment cleanup +src/physics/cam/phys_grid.F90 + - Add timing calls and optional memory usage logging to initialization + - Add interfaces to allow most code to work with / without new infrastructure + - Modernize boolean operators (e.g., ".eq." ==> "==") +src/physics/cam/physics_buffer.F90.in + - Added check for physics grid initialization + - Limit pbuf1d_print to output to CAM log (i.e., from masterproc) +src/physics/cam/physpkg.F90 + - Whitespace cleanup +src/physics/cam/qneg_module.F90 + - Remove commented use statement +src/physics/cam/zm_conv_intr.F90 + - Remove unused imports +src/utils/cam_abortutils.F90 + - Add handle_allocate_error to trap and abort on any allocation error +src/utils/cam_grid_support.F90 + - Remove _FillValue attribute from grid coordinate variables +src/utils/cam_map_utils.F90 + - Improve error outputs +src/utils/cam_pio_utils.F90 + - Use len=SHR_KIND_CL instead of len=256 +src/utils/gmean_mod.F90 + - Add test function and overall timing +src/utils/spmd_utils.F90 + - Add DDT for communicating column and for field redistribution + - column_redist_t: used for scalable gmean algorithm + - spmd_col_trans: To be used for physics load balancing +test/system/TR8.sh + - Add src/infrastructure directory +test/system/test_driver.sh + - Save TR8 and TGIT test output to log file + - Only run TR8 and TGIT for Nag tests + +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. + +cheyenne/intel/aux_cam: +FAIL ERC_D_Ln9.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator NLCOMP +FAIL ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase NLCOMP +FAIL ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 NLCOMP +FAIL ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined NLCOMP +FAIL SCT_D_Ln7.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep NLCOMP +FAIL SMS_D_Ld5.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d NLCOMP +FAIL SMS_D_Ln9.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s_refined_camchem NLCOMP +FAIL SMS_Ld5.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 NLCOMP +FAIL SMS_Ln9.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging NLCOMP +Namelist change due to addition of cam_repro_sum=.true. +FAIL ERP_Ln9.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s RUN time=39 +Nudging code is using global interfaces not supported for weak scaling. +This error should be fixed with PR #241 + +izumi/nag/aux_cam: +FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + - Known (pre-existing) failure +FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae NLCOMP +FAIL ERC_D_Ln9.f10_f10_mg37.FHS94.izumi_nag.cam-idphys NLCOMP +FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_carma NLCOMP +FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol NLCOMP +FAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic NLCOMP +FAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac NLCOMP +FAIL ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac NLCOMP +FAIL ERI_D_Ln18.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 NLCOMP +FAIL ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf NLCOMP +FAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 NLCOMP +FAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 NLCOMP +FAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 NLCOMP +FAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 NLCOMP +FAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 NLCOMP +FAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 NLCOMP +FAIL SMS_D_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port NLCOMP +FAIL SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm NLCOMP +FAIL SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam NLCOMP +FAIL SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba NLCOMP +FAIL TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac NLCOMP +FAIL TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 NLCOMP + - Namelist change due to addition of cam_repro_sum=.true. + +FAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac NLCOMP +FAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_006_nag: ERROR BFAIL some baseline files were missing + - Added an interpolated-output history file test + +izumi/pgi/aux_cam: +FAIL ERC_D_Ln9.f10_f10_mg37.FADIAB.izumi_pgi.cam-terminator NLCOMP +FAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_pgi.cam-rad_diag NLCOMP +FAIL ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_pgi.cam-co2rmp NLCOMP +FAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal0 NLCOMP +FAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-ttrac_loadbal3 NLCOMP +FAIL SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_pgi.cam-scm_prep NLCOMP +FAIL SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_pgi.cam-scm_prep_c6 NLCOMP +FAIL SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac NLCOMP + - Namelist change due to addition of cam_repro_sum=.true. + +FAIL ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_pgi.cam-outfrq3s_diags NLCOMP +FAIL ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_pgi.cam-outfrq3s_diags BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_006_pgi: MULTIPLE ISSUES: field lists differ and some baseline files were missing + - Added a zonal-mean history file test + +FAIL SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac NLCOMP +FAIL SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_pgi.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_006_pgi: ERROR BFAIL some baseline files were missing + - Added an interpolated-output history file test + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: NA + +If bitwise differences were observed, how did you show they were no worse +than roundoff? NA + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced: NA + +=============================================================== +=============================================================== + Tag name: cam6_3_006 Originator(s): herrington, cacraig Date: Dec 3, 2020 @@ -15,7 +28411,7 @@ Purpose of changes (include the issue number and title text for each relevant Gi Describe any changes made to build system: NA Describe any changes made to the namelist: - - created namelist group clubb_mf_nl and added namelist variables: do_clubb_mf, do_clubb_mf_diag, lubb_mf_L0, + - created namelist group clubb_mf_nl and added namelist variables: do_clubb_mf, do_clubb_mf_diag, lubb_mf_L0, clubb_mf_ent0 and clubb_mf_nup - removed scmlat/scmlon declarations in user_nl_cam for scam cases in cime_config/usermods_dirs/scam_xxx diff --git a/doc/ChangeLog_template b/doc/ChangeLog_template index 9dea71bdae..f646f24e78 100644 --- a/doc/ChangeLog_template +++ b/doc/ChangeLog_template @@ -29,11 +29,13 @@ 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. -cheyenne/intel/aux_cam: +derecho/intel/aux_cam: + +derecho/nvhpc/aux_cam: izumi/nag/aux_cam: -izumi/pgi/aux_cam: +izumi/gnu/aux_cam: CAM tag used for the baseline comparison tests if different than previous tag: diff --git a/doc/ReleaseNotes b/doc/ReleaseNotes deleted file mode 100644 index c8ababd26a..0000000000 --- a/doc/ReleaseNotes +++ /dev/null @@ -1,300 +0,0 @@ -------------------------------------------------- -New features in CAM-5.4 -------------------------------------------------- - -## CAM-SE -* Update SE dycore tuning parameters (XXEaton) - - Change time stepping method to RK5 (Kinnmark & Gray Runga-Kutta 5 - stage; 3rd order accurate in time) - - Set the namelists variables as recommended for RK5 in: - http://www.cgd.ucar.edu/cms/pel/software/cam-se-dt-table.pdf - - Add "tstep_type" namelist option for SE dycore - - Turn on the FV energy fixer. - - Remove the variable "energy_fixer" from the cam namelist. - - Reformulated total energy as applied in physics_update and the energy fixers for CAM-FV and CAM-SE dycores. - -## CAM-FV -* Vertical remapping is now applied to temperature instead of energy. This - primarily affects WACCM by reducing numerical artifacts near the model top. - - Reformulated total energy as applied in physics_update and the energy fixers for CAM-FV and CAM-SE dycores. - -## CARMA -* Add six new CARMA models: - - cirrus_dust - - meteor_impact - - mixed_sulfate - - pmc_sulfate - - tholin - - test_tracers2 - -* Further development of CARMA-CAM integration, including: - - New sulfate model features. - - "Fractal" code for soot. - - Port to the NAG compiler. - -## CLUBB -* Update the version of CLUBB used -* Add features to the interface (all options, controlled by namelist switches) - - rain evaportation-turbulence feedback - - advection of CLUBB's moments - - cloud top radiational cooling parameterization - - explicit diffusion on CLUBBs prognostic temperature and total water - - provide support for CLUBB/microphysics sub-stepping - -## CHEMISTRY - -* Added ability to use wild fire emissions produced by CLM4.5 - -* Added option for external forcing of H2O from CH4 oxidation when running - low-top CAM5 without chemistry. CH4 oxidation is an important source of - H2O in the stratosphere. - -* Reaction constants updated to JPL10 - -* Added functionality to provide rate groupings (summations) diagnostics - -* Corrections to aerosol surface area - -* NEU wet deposition changes - . set TICE to 263 - . disable wet deposition poleward of 60 degrees and pressures < 200 mbar - . correction Henry's Law parameters used for SO2 deposition (in seq_drydep_mod) - . correction in units of NEU wet deposition diagnostics - -* Chemistry preprocessor updates: - . enthalpies for chemical potential heating now specified in mechanism files - . added ability to put comments at the end of reactions in mechanism file following '#' or '!' - . bug fixes for species names longer than 8 characters (up to 16 characters) - - -## COSP - . Update from COSP1.3 (version used for CMIP5) to COSP1.4 (version endorsed for CMIP6) - - includes code optimizations, new CALIPSO cloud phase diagnostics, new timing variables - - retains radiatively active snow in all simulators (merged from CESM version of COSP1.3) - - fixes bug affecting convective ice input into COSP - -## AEROSOLS - -* Added 4-mode modal aerosol model (MAM4) - -* Enhancements to emission specifications (surface and elevated): - . ability to specify emissions from multiple input files for any given species - . optional global attribute 'input_method' (set to: 'SERIAL', 'CYCLICAL', - or 'INTERP_MISSING_MONTHS') in the emissions input file which overrides the - corresponding *type namelist option on a file-by-file basis - . optional multiplier proceeding the emissions filepath, e.g.: - 'NAME -> 0.5*/path.../filename.nc' - -* Prognostic Modal Aerosols: Provide the capability to prognose modal aerosols in the stratosphere. This - gives CAM5 and WACCM5 the ability to simulate aerosols in the stratosphere - which originate from volcanic eruptions. To this end, accumulation to coarse - mode exchange is allowed and the widths and edges of the modes are modified - -* Added options to use different then default values for solubility factors for - BULK aerosols - -## DUST - -* Defaults changed for soil_erod and dust_emis_fact. - . All grids except the 0.9x1.25 FV and a few low resolution grid now use - the soid_erod dataset generated for the 1.9x2.5 FV grid. - . The value of dust_emis_fact has been changed for FV 1/2 and 1/4 degree - grids to 0.45 based on tuning done at PNNL. The value for FV 1 degree - was not changed since that will require retuning the production configuration. - -* Tuned following Albani et al., 2014 to best match observations - -* New soil erodibility file from Albani which specifically improves the dust in the Middle East - -## Radiation - -* New optical properties with less absorbing optics for MAM3 and MAM4 (use aeronet dust optics and dust in the aitken mode 2) - -* Added option to calculate solar insolation using the mean of cosz in a radiation time step. When this option is turned on, - it eliminates the spurious zonal oscillation of daily insolation caused by discrete time sampling. - -## Microphysics - -* New microphysics scheme: MG version 2 adds prognostic precipitation and has - a cleaner implementation compared to the original MG scheme. - -* It is now possible to control both the number of microphysics substeps per - physics time step, and joint macrophysics/microphysics substepping, via the - namelist. - -* Add pre-existing ice option to nucleate_ice code. - -* Add option for Hoose heterogeneous freezing parameterization. - -* Add option to specify/parameterize precipitation fraction - -* Add option to use a different dehydration threshold (rhmin) for in the polar stratosphere. - -* New switch to use alternative autoconversion scheme in MG2 (following Seifert and Behang 2001): when active this - uses a different autoconversion and accretion scheme for liquid in MG2 - -* Add Song and Zhang 2012 version of MG 2-moment microphysics in ZM convective scheme as an option - -## Macrophysics - -* Add option for a ice supersaturation closure (supported in both CAM5 and CAM-CLUBB) - -## Deep convection - -* Minor improvements to the ZM scheme improve robustness for some inputs - (e.g. unusually high temperatures). - -* Add option for convective organization in ZM (based on Mapes and Neale 2010) - -## Sub-columns -* Modifications to pbuf and history to support sub-columns - -* Introduced sub-column interface and utlities routines - -* Microphysics now has the ability to be run on grid(usual) or subcolumns - -## Gravity waves - -* New AMIP configuration with a high vertical resolution uses spectral - gravity waves in the low top model. - -* A long-wavelength inertial gravity wave spectrum has been added, and - frontogenesis can now trigger waves in this spectrum. - -* Gravity waves can be triggered from shallow, as well as deep, convection. - -* The entire gravity wave scheme has been audited to correct conservation - issues, internal inconsistencies, and problems with hard-coded parameters. - This should result in more accurate and less noisy output. - -* WACCM's gravity wave functionality can now be enabled in non-WACCM runs, - and can be enabled/disabled at run time via the namelist. - -* Most gravity wave parameters that were previously hard-coded are now - set by the namelist instead. - -* Added "tau_0_ubc" option, to enforce an upper boundary condition of tau = 0 - in the gravity wave parameterization. - -## WACCM - -* WACCM5 with prognostic modal aerosols in the stratosphere - -* Reaction constants updated to JPL10 - -* Background ionization from star light added to WACCM - -* New specification of stratospheric aerosols (volcanic) - -* New treatment of stratospheric aerosol chemistry - -* Corrections to age-of-air tracers - -* Bug fixes and usability improvements for SC-WACCM and WACCM5 that were - also added between CESM 1.2.1 and CESM 1.2.2. - -* Include SC-WACCM5 which has prognostic modal aerosols - -* WACCM-X now has an option to turn on the extended ionosphere including - calculation of electron and ion temperatur and ion transport ambipolar - diffusion - -## SCAM - -## SPCAM -* Super-parameterized CAM (SPCAM) implements a 2D cloud resolving model (the - System for Atmospheric Modeling SAM, version 6.8.2) in CAM. When it is turned on, - it replaces CAM's parameterization for moist convection and large-scale condensation - with this alternate model. - -* The SPCAM package allows CLUBB to be used or not. It is important to note that there is - a SPCAM-specific version of CLUBB within the CRM package and it is not the same CLUBB being - used by CAM - -## AQUAPLANET -* CESM-aquaplanet is now supported out-of-the-box via prescribed-SST (QPCx) and - slab-ocean (QSCx) compsets (where x is CAM version). - - -------------------------------------------------- -CODE CLEANUP AND REFACTORING -------------------------------------------------- - -* CARMA and the MG microphysics interface now use micro_mg_utils to get - size distribution parameters for cloud droplets, ice, and precipitation. - Previously this was done with duplicated code. - -* The chemistry-aerosol model interface was refactored to provide a more - extendable framework. This will ease incorporation of other aerosol - models (e.g., a sectional aerosol model) - -* The SE dycore now uses Pa instead of hPa, which is consistent with CAM's - physics. - -* The CAM and WACCM gravity wave modules have been merged together, and the - result was extensively refactored. The CAM interface (gw_drag.F90) has been - separated from a new set of modules that constitute a portable layer, and - the routines for the wave sources, wave propagation, and effective diffusion - have been separated from each other as well. - -* Removed the WACCM_PHYS preprocessor macro, and brought WACCM physics modules - up to date with current CAM conventions: - - - qbo, radheat, and iondrag have their own namelists. If WACCM is off, we - compile in stubs rather than using the WACCM_PHYS macro. - - Molecular diffusion is turned on/off at run time based on the namelist and - the extent of the vertical grid. - - Each type of gravity wave source is turned on/off via the namelist. - - WACCM-specific fields set by the dycore are now communicated via the physics - buffer rather than the physics_state object, and are only set if needed. - -* Remove restriction that radiation diagnostic calculations reuse the water - uptake and wet radius values calculated for the climate affecting modes. - These quantities are now recomputed for the diagnostic modes. - -* satellite history output was refactored to improve run-time performance - -- find nearest neighbor operation was parallelized - -* The vertical diffusion code was refactored to use new tridiagonal matrix - types, which represent operators in the diffusion equation. - -------------------------------------------------- -CAM INFRASTRUCTURE CHANGES -------------------------------------------------- - -* Improve the microp_aero driver by removing code that belonged in a CAM - specific interface for the nucleate_ice parameterization and adding the - missing CAM interface layer (nucleate_ice_cam). - -* Add two new functions to the rad_constituents interfaces to make it - easier to access the mode and specie indices for specific modes and - specie types. - -* Type descriptions in namelist_definitions.xml can now include variables - as dimensions. For instance, both "integer(n)" and "integer(2)" can be - used for a 1-D integer array. - -* The rad_climate and rad_diag_* arrays can now be set to a larger size - using the new "-max_n_rad_cnst" configure option. - -* Turning on CESM's DEBUG mode now also turns on state_debug_checks. - -* The Lahey compiler is no longer supported because it doesn't support Fortran - 2003 features. - -* Added a new namelist variable, history_aero_optics, to add modal aerosol - optics diagnostics to the default history fields. The existing - history_aerosol variable turns on diagnostics related to the aerosol - production and removal tendencies. - -* Preliminary implementation of further flags to control default history - outputs, including: - - history_waccm - - history_waccmx - - history_chemistry - - history_carma - - history_clubb - -* CAM history changes: - . increased number of fields in fincls from 750 to 1000 - . can have up to 10 simultaneous history files (or streams) diff --git a/libraries/FMS b/libraries/FMS new file mode 160000 index 0000000000..2ababb52d7 --- /dev/null +++ b/libraries/FMS @@ -0,0 +1 @@ +Subproject commit 2ababb52d7f25113d547a03d88ee1c78b14137ec diff --git a/libraries/parallelio b/libraries/parallelio new file mode 160000 index 0000000000..6539ef05ae --- /dev/null +++ b/libraries/parallelio @@ -0,0 +1 @@ +Subproject commit 6539ef05ae7584ec570a56fdab9f7dfb336c2b80 diff --git a/manage_externals/.dir_locals.el b/manage_externals/.dir_locals.el deleted file mode 100644 index a370490e92..0000000000 --- a/manage_externals/.dir_locals.el +++ /dev/null @@ -1,12 +0,0 @@ -; -*- mode: Lisp -*- - -((python-mode - . ( - ;; fill the paragraph to 80 columns when using M-q - (fill-column . 80) - - ;; Use 4 spaces to indent in Python - (python-indent-offset . 4) - (indent-tabs-mode . nil) - ))) - diff --git a/manage_externals/.github/ISSUE_TEMPLATE.md b/manage_externals/.github/ISSUE_TEMPLATE.md deleted file mode 100644 index 8ecb2ae64b..0000000000 --- a/manage_externals/.github/ISSUE_TEMPLATE.md +++ /dev/null @@ -1,6 +0,0 @@ -### Summary of Issue: -### Expected behavior and actual behavior: -### Steps to reproduce the problem (should include model description file(s) or link to publi c repository): -### What is the changeset ID of the code, and the machine you are using: -### have you modified the code? If so, it must be committed and available for testing: -### Screen output or log file showing the error message and context: diff --git a/manage_externals/.github/PULL_REQUEST_TEMPLATE.md b/manage_externals/.github/PULL_REQUEST_TEMPLATE.md deleted file mode 100644 index b68b1fb5e2..0000000000 --- a/manage_externals/.github/PULL_REQUEST_TEMPLATE.md +++ /dev/null @@ -1,17 +0,0 @@ -[ 50 character, one line summary ] - -[ Description of the changes in this commit. It should be enough - information for someone not following this development to understand. - Lines should be wrapped at about 72 characters. ] - -User interface changes?: [ No/Yes ] -[ If yes, describe what changed, and steps taken to ensure backward compatibilty ] - -Fixes: [Github issue #s] And brief description of each issue. - -Testing: - test removed: - unit tests: - system tests: - manual testing: - diff --git a/manage_externals/.gitignore b/manage_externals/.gitignore deleted file mode 100644 index 411de5d96e..0000000000 --- a/manage_externals/.gitignore +++ /dev/null @@ -1,14 +0,0 @@ -# directories that are checked out by the tool -cime/ -cime_config/ -components/ - -# generated local files -*.log - -# editor files -*~ -*.bak - -# generated python files -*.pyc diff --git a/manage_externals/.travis.yml b/manage_externals/.travis.yml deleted file mode 100644 index 1990cb9604..0000000000 --- a/manage_externals/.travis.yml +++ /dev/null @@ -1,19 +0,0 @@ -language: python -os: linux -python: - - "2.7" - - "3.4" - - "3.5" - - "3.6" - - "3.7" - - "3.8" -install: - - pip install -r test/requirements.txt -before_script: - - git --version -script: - - cd test; make test - - cd test; make lint -after_success: - - cd test; make coverage - - cd test; coveralls diff --git a/manage_externals/LICENSE.txt b/manage_externals/LICENSE.txt deleted file mode 100644 index 665ee03fbc..0000000000 --- a/manage_externals/LICENSE.txt +++ /dev/null @@ -1,34 +0,0 @@ -Copyright (c) 2017-2018, University Corporation for Atmospheric Research (UCAR) -All rights reserved. - -Developed by: - University Corporation for Atmospheric Research - National Center for Atmospheric Research - https://www2.cesm.ucar.edu/working-groups/sewg - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the "Software"), -to deal with the Software without restriction, including without limitation -the rights to use, copy, modify, merge, publish, distribute, sublicense, -and/or sell copies of the Software, and to permit persons to whom -the Software is furnished to do so, subject to the following conditions: - - - Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimers. - - Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimers in the documentation - and/or other materials provided with the distribution. - - Neither the names of [Name of Development Group, UCAR], - nor the names of its contributors may be used to endorse or promote - products derived from this Software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE -LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. diff --git a/manage_externals/README.md b/manage_externals/README.md deleted file mode 100644 index c931c8e213..0000000000 --- a/manage_externals/README.md +++ /dev/null @@ -1,226 +0,0 @@ --- AUTOMATICALLY GENERATED FILE. DO NOT EDIT -- - -[![Build Status](https://travis-ci.org/ESMCI/manage_externals.svg?branch=master)](https://travis-ci.org/ESMCI/manage_externals)[![Coverage Status](https://coveralls.io/repos/github/ESMCI/manage_externals/badge.svg?branch=master)](https://coveralls.io/github/ESMCI/manage_externals?branch=master) -``` -usage: checkout_externals [-h] [-e [EXTERNALS]] [-o] [-S] [-v] [--backtrace] - [-d] [--no-logging] - -checkout_externals manages checking out groups of externals from revision -control based on a externals description file. By default only the -required externals are checkout out. - -Operations performed by manage_externals utilities are explicit and -data driven. checkout_externals will always make the working copy *exactly* -match what is in the externals file when modifying the working copy of -a repository. - -If checkout_externals isn't doing what you expected, double check the contents -of the externals description file. - -Running checkout_externals without the '--status' option will always attempt to -synchronize the working copy to exactly match the externals description. - -optional arguments: - -h, --help show this help message and exit - -e [EXTERNALS], --externals [EXTERNALS] - The externals description filename. Default: - Externals.cfg. - -o, --optional By default only the required externals are checked - out. This flag will also checkout the optional - externals. - -S, --status Output status of the repositories managed by - checkout_externals. By default only summary - information is provided. Use verbose output to see - details. - -v, --verbose Output additional information to the screen and log - file. This flag can be used up to two times, - increasing the verbosity level each time. - --backtrace DEVELOPER: show exception backtraces as extra - debugging output - -d, --debug DEVELOPER: output additional debugging information to - the screen and log file. - --no-logging DEVELOPER: disable logging. - -``` -NOTE: checkout_externals *MUST* be run from the root of the source tree it -is managing. For example, if you cloned a repository with: - - $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev - -Then the root of the source tree is /path/to/some-project-dev. If you -obtained a sub-project via a checkout of another project: - - $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev - -and you need to checkout the sub-project externals, then the root of the -source tree is /path/to/some-project-dev. Do *NOT* run checkout_externals -from within /path/to/some-project-dev/sub-project - -The root of the source tree will be referred to as `${SRC_ROOT}` below. - -# Supported workflows - - * Checkout all required components from the default externals - description file: - - $ cd ${SRC_ROOT} - $ ./manage_externals/checkout_externals - - * To update all required components to the current values in the - externals description file, re-run checkout_externals: - - $ cd ${SRC_ROOT} - $ ./manage_externals/checkout_externals - - If there are *any* modifications to *any* working copy according - to the git or svn 'status' command, checkout_externals - will not update any external repositories. Modifications - include: modified files, added files, removed files, or missing - files. - - To avoid this safety check, edit the externals description file - and comment out the modified external block. - - * Checkout all required components from a user specified externals - description file: - - $ cd ${SRC_ROOT} - $ ./manage_externals/checkout_externals --externals my-externals.cfg - - * Status summary of the repositories managed by checkout_externals: - - $ cd ${SRC_ROOT} - $ ./manage_externals/checkout_externals --status - - ./cime - s ./components/cism - ./components/mosart - e-o ./components/rtm - M ./src/fates - e-o ./tools/PTCLM - - where: - * column one indicates the status of the repository in relation - to the externals description file. - * column two indicates whether the working copy has modified files. - * column three shows how the repository is managed, optional or required - - Column one will be one of these values: - * s : out-of-sync : repository is checked out at a different commit - compared with the externals description - * e : empty : directory does not exist - checkout_externals has not been run - * ? : unknown : directory exists but .git or .svn directories are missing - - Column two will be one of these values: - * M : Modified : modified, added, deleted or missing files - * : blank / space : clean - * - : dash : no meaningful state, for empty repositories - - Column three will be one of these values: - * o : optional : optionally repository - * : blank / space : required repository - - * Detailed git or svn status of the repositories managed by checkout_externals: - - $ cd ${SRC_ROOT} - $ ./manage_externals/checkout_externals --status --verbose - -# Externals description file - - The externals description contains a list of the external - repositories that are used and their version control locations. The - file format is the standard ini/cfg configuration file format. Each - external is defined by a section containing the component name in - square brackets: - - * name (string) : component name, e.g. [cime], [cism], etc. - - Each section has the following keyword-value pairs: - - * required (boolean) : whether the component is a required checkout, - 'true' or 'false'. - - * local_path (string) : component path *relative* to where - checkout_externals is called. - - * protoctol (string) : version control protocol that is used to - manage the component. Valid values are 'git', 'svn', - 'externals_only'. - - Switching an external between different protocols is not - supported, e.g. from svn to git. To switch protocols, you need to - manually move the old working copy to a new location. - - Note: 'externals_only' will only process the external's own - external description file without trying to manage a repository - for the component. This is used for retreiving externals for - standalone components like cam and clm. If the source root of the - externals_only component is the same as the main source root, then - the local path must be set to '.', the unix current working - directory, e. g. 'local_path = .' - - * repo_url (string) : URL for the repository location, examples: - * https://svn-ccsm-models.cgd.ucar.edu/glc - * git@github.com:esmci/cime.git - * /path/to/local/repository - * . - - NOTE: To operate on only the local clone and and ignore remote - repositories, set the url to '.' (the unix current path), - i.e. 'repo_url = .' . This can be used to checkout a local branch - instead of the upstream branch. - - If a repo url is determined to be a local path (not a network url) - then user expansion, e.g. ~/, and environment variable expansion, - e.g. $HOME or $REPO_ROOT, will be performed. - - Relative paths are difficult to get correct, especially for mixed - use repos. It is advised that local paths expand to absolute paths. - If relative paths are used, they should be relative to one level - above local_path. If local path is 'src/foo', the the relative url - should be relative to 'src'. - - * tag (string) : tag to checkout - - * hash (string) : the git hash to checkout. Only applies to git - repositories. - - * branch (string) : branch to checkout from the specified - repository. Specifying a branch on a remote repository means that - checkout_externals will checkout the version of the branch in the remote, - not the the version in the local repository (if it exists). - - Note: one and only one of tag, branch hash must be supplied. - - * externals (string) : used to make manage_externals aware of - sub-externals required by an external. This is a relative path to - the external's root directory. For example, the main externals - description has an external checkout out at 'src/useful_library'. - useful_library requires additional externals to be complete. - Those additional externals are managed from the source root by the - externals description file pointed 'useful_library/sub-xternals.cfg', - Then the main 'externals' field in the top level repo should point to - 'sub-externals.cfg'. - - * from_submodule (True / False) : used to pull the repo_url, local_path, - and hash properties for this external from the .gitmodules file in - this repository. Note that the section name (the entry in square - brackets) must match the name in the .gitmodules file. - If from_submodule is True, the protocol must be git and no repo_url, - local_path, hash, branch, or tag entries are allowed. - Default: False - - * sparse (string) : used to control a sparse checkout. This optional - entry should point to a filename (path relative to local_path) that - contains instructions on which repository paths to include (or - exclude) from the working tree. - See the "SPARSE CHECKOUT" section of https://git-scm.com/docs/git-read-tree - Default: sparse checkout is disabled - - * Lines begining with '#' or ';' are comments and will be ignored. - -# Obtaining this tool, reporting issues, etc. - - The master repository for manage_externals is - https://github.com/ESMCI/manage_externals. Any issues with this tool - should be reported there. diff --git a/manage_externals/README_FIRST b/manage_externals/README_FIRST deleted file mode 100644 index c8a47d7806..0000000000 --- a/manage_externals/README_FIRST +++ /dev/null @@ -1,54 +0,0 @@ -CESM is comprised of a number of different components that are -developed and managed independently. Each component may have -additional 'external' dependancies and optional parts that are also -developed and managed independently. - -The checkout_externals.py tool manages retreiving and updating the -components and their externals so you have a complete set of source -files for the model. - -checkout_externals.py relies on a model description file that -describes what components are needed, where to find them and where to -put them in the source tree. The default file is called "CESM.xml" -regardless of whether you are checking out CESM or a standalone -component. - -checkout_externals requires access to git and svn repositories that -require authentication. checkout_externals may pass through -authentication requests, but it will not cache them for you. For the -best and most robust user experience, you should have svn and git -working without password authentication. See: - - https://help.github.com/articles/connecting-to-github-with-ssh/ - - ?svn ref? - -NOTE: checkout_externals.py *MUST* be run from the root of the source -tree it is managing. For example, if you cloned CLM with: - - $ git clone git@github.com/ncar/clm clm-dev - -Then the root of the source tree is /path/to/cesm-dev. If you obtained -CLM via an svn checkout of CESM and you need to checkout the CLM -externals, then the root of the source tree for CLM is: - - /path/to/cesm-dev/components/clm - -The root of the source tree will be referred to as ${SRC_ROOT} below. - -To get started quickly, checkout all required components from the -default model description file: - - $ cd ${SRC_ROOT} - $ ./checkout_cesm/checkout_externals.py - -For additional information about using checkout model, please see: - - ${SRC_ROOT}/checkout_cesm/README - -or run: - - $ cd ${SRC_ROOT} - $ ./checkout_cesm/checkout_externals.py --help - - diff --git a/manage_externals/checkout_externals b/manage_externals/checkout_externals index a0698baef0..ac6b718ee0 100755 --- a/manage_externals/checkout_externals +++ b/manage_externals/checkout_externals @@ -1,36 +1,3 @@ -#!/usr/bin/env python - -"""Main driver wrapper around the manic/checkout utility. - -Tool to assemble external respositories represented in an externals -description file. - -""" -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import sys -import traceback - -import manic - -if sys.hexversion < 0x02070000: - print(70 * '*') - print('ERROR: {0} requires python >= 2.7.x. '.format(sys.argv[0])) - print('It appears that you are running python {0}'.format( - '.'.join(str(x) for x in sys.version_info[0:3]))) - print(70 * '*') - sys.exit(1) - - -if __name__ == '__main__': - ARGS = manic.checkout.commandline_arguments() - try: - RET_STATUS, _ = manic.checkout.main(ARGS) - sys.exit(RET_STATUS) - except Exception as error: # pylint: disable=broad-except - manic.printlog(str(error)) - if ARGS.backtrace: - traceback.print_exc() - sys.exit(1) +echo "Error: manage_externals/checkout_externals is no longer supported" +echo " It has been replaced by bin/git-fleximod" +echo " Please refer to the README.md file in the home directory of a CAM checkout for more information" diff --git a/manage_externals/manic/__init__.py b/manage_externals/manic/__init__.py deleted file mode 100644 index 11badedd3b..0000000000 --- a/manage_externals/manic/__init__.py +++ /dev/null @@ -1,9 +0,0 @@ -"""Public API for the manage_externals library -""" - -from manic import checkout -from manic.utils import printlog - -__all__ = [ - 'checkout', 'printlog', -] diff --git a/manage_externals/manic/checkout.py b/manage_externals/manic/checkout.py deleted file mode 100755 index edc5655954..0000000000 --- a/manage_externals/manic/checkout.py +++ /dev/null @@ -1,424 +0,0 @@ -#!/usr/bin/env python - -""" -Tool to assemble repositories represented in a model-description file. - -If loaded as a module (e.g., in a component's buildcpp), it can be used -to check the validity of existing subdirectories and load missing sources. -""" -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import argparse -import logging -import os -import os.path -import sys - -from manic.externals_description import create_externals_description -from manic.externals_description import read_externals_description_file -from manic.externals_status import check_safe_to_update_repos -from manic.sourcetree import SourceTree -from manic.utils import printlog, fatal_error -from manic.global_constants import VERSION_SEPERATOR, LOG_FILE_NAME - -if sys.hexversion < 0x02070000: - print(70 * '*') - print('ERROR: {0} requires python >= 2.7.x. '.format(sys.argv[0])) - print('It appears that you are running python {0}'.format( - VERSION_SEPERATOR.join(str(x) for x in sys.version_info[0:3]))) - print(70 * '*') - sys.exit(1) - - -# --------------------------------------------------------------------- -# -# User input -# -# --------------------------------------------------------------------- -def commandline_arguments(args=None): - """Process the command line arguments - - Params: args - optional args. Should only be used during systems - testing. - - Returns: processed command line arguments - """ - description = ''' - -%(prog)s manages checking out groups of externals from revision -control based on an externals description file. By default only the -required externals are checkout out. - -Running %(prog)s without the '--status' option will always attempt to -synchronize the working copy to exactly match the externals description. -''' - - epilog = ''' -``` -NOTE: %(prog)s *MUST* be run from the root of the source tree it -is managing. For example, if you cloned a repository with: - - $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev - -Then the root of the source tree is /path/to/some-project-dev. If you -obtained a sub-project via a checkout of another project: - - $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev - -and you need to checkout the sub-project externals, then the root of the -source tree remains /path/to/some-project-dev. Do *NOT* run %(prog)s -from within /path/to/some-project-dev/sub-project - -The root of the source tree will be referred to as `${SRC_ROOT}` below. - - -# Supported workflows - - * Checkout all required components from the default externals - description file: - - $ cd ${SRC_ROOT} - $ ./manage_externals/%(prog)s - - * To update all required components to the current values in the - externals description file, re-run %(prog)s: - - $ cd ${SRC_ROOT} - $ ./manage_externals/%(prog)s - - If there are *any* modifications to *any* working copy according - to the git or svn 'status' command, %(prog)s - will not update any external repositories. Modifications - include: modified files, added files, removed files, or missing - files. - - To avoid this safety check, edit the externals description file - and comment out the modified external block. - - * Checkout all required components from a user specified externals - description file: - - $ cd ${SRC_ROOT} - $ ./manage_externals/%(prog)s --externals my-externals.cfg - - * Status summary of the repositories managed by %(prog)s: - - $ cd ${SRC_ROOT} - $ ./manage_externals/%(prog)s --status - - ./cime - s ./components/cism - ./components/mosart - e-o ./components/rtm - M ./src/fates - e-o ./tools/PTCLM - - - where: - * column one indicates the status of the repository in relation - to the externals description file. - * column two indicates whether the working copy has modified files. - * column three shows how the repository is managed, optional or required - - Column one will be one of these values: - * s : out-of-sync : repository is checked out at a different commit - compared with the externals description - * e : empty : directory does not exist - %(prog)s has not been run - * ? : unknown : directory exists but .git or .svn directories are missing - - Column two will be one of these values: - * M : Modified : modified, added, deleted or missing files - * : blank / space : clean - * - : dash : no meaningful state, for empty repositories - - Column three will be one of these values: - * o : optional : optionally repository - * : blank / space : required repository - - * Detailed git or svn status of the repositories managed by %(prog)s: - - $ cd ${SRC_ROOT} - $ ./manage_externals/%(prog)s --status --verbose - -# Externals description file - - The externals description contains a list of the external - repositories that are used and their version control locations. The - file format is the standard ini/cfg configuration file format. Each - external is defined by a section containing the component name in - square brackets: - - * name (string) : component name, e.g. [cime], [cism], etc. - - Each section has the following keyword-value pairs: - - * required (boolean) : whether the component is a required checkout, - 'true' or 'false'. - - * local_path (string) : component path *relative* to where - %(prog)s is called. - - * protoctol (string) : version control protocol that is used to - manage the component. Valid values are 'git', 'svn', - 'externals_only'. - - Switching an external between different protocols is not - supported, e.g. from svn to git. To switch protocols, you need to - manually move the old working copy to a new location. - - Note: 'externals_only' will only process the external's own - external description file without trying to manage a repository - for the component. This is used for retrieving externals for - standalone components like cam and ctsm which also serve as - sub-components within a larger project. If the source root of the - externals_only component is the same as the main source root, then - the local path must be set to '.', the unix current working - directory, e. g. 'local_path = .' - - * repo_url (string) : URL for the repository location, examples: - * https://svn-ccsm-models.cgd.ucar.edu/glc - * git@github.com:esmci/cime.git - * /path/to/local/repository - * . - - NOTE: To operate on only the local clone and and ignore remote - repositories, set the url to '.' (the unix current path), - i.e. 'repo_url = .' . This can be used to checkout a local branch - instead of the upstream branch. - - If a repo url is determined to be a local path (not a network url) - then user expansion, e.g. ~/, and environment variable expansion, - e.g. $HOME or $REPO_ROOT, will be performed. - - Relative paths are difficult to get correct, especially for mixed - use repos. It is advised that local paths expand to absolute paths. - If relative paths are used, they should be relative to one level - above local_path. If local path is 'src/foo', the the relative url - should be relative to 'src'. - - * tag (string) : tag to checkout - - * hash (string) : the git hash to checkout. Only applies to git - repositories. - - * branch (string) : branch to checkout from the specified - repository. Specifying a branch on a remote repository means that - %(prog)s will checkout the version of the branch in the remote, - not the the version in the local repository (if it exists). - - Note: one and only one of tag, branch hash must be supplied. - - * externals (string) : used to make manage_externals aware of - sub-externals required by an external. This is a relative path to - the external's root directory. For example, if LIBX is often used - as a sub-external, it might have an externals file (for its - externals) called Externals_LIBX.cfg. To use libx as a standalone - checkout, it would have another file, Externals.cfg with the - following entry: - - [ libx ] - local_path = . - protocol = externals_only - externals = Externals_LIBX.cfg - required = True - - Now, %(prog)s will process Externals.cfg and also process - Externals_LIBX.cfg as if it was a sub-external. - - * from_submodule (True / False) : used to pull the repo_url, local_path, - and hash properties for this external from the .gitmodules file in - this repository. Note that the section name (the entry in square - brackets) must match the name in the .gitmodules file. - If from_submodule is True, the protocol must be git and no repo_url, - local_path, hash, branch, or tag entries are allowed. - Default: False - - * sparse (string) : used to control a sparse checkout. This optional - entry should point to a filename (path relative to local_path) that - contains instructions on which repository paths to include (or - exclude) from the working tree. - See the "SPARSE CHECKOUT" section of https://git-scm.com/docs/git-read-tree - Default: sparse checkout is disabled - - * Lines beginning with '#' or ';' are comments and will be ignored. - -# Obtaining this tool, reporting issues, etc. - - The master repository for manage_externals is - https://github.com/ESMCI/manage_externals. Any issues with this tool - should be reported there. - -# Troubleshooting - -Operations performed by manage_externals utilities are explicit and -data driven. %(prog)s will always attempt to make the working copy -*exactly* match what is in the externals file when modifying the -working copy of a repository. - -If %(prog)s is not doing what you expected, double check the contents -of the externals description file or examine the output of -./manage_externals/%(prog)s --status - -''' - - parser = argparse.ArgumentParser( - description=description, epilog=epilog, - formatter_class=argparse.RawDescriptionHelpFormatter) - - # - # user options - # - parser.add_argument("components", nargs="*", - help="Specific component(s) to checkout. By default, " - "all required externals are checked out.") - - parser.add_argument('-e', '--externals', nargs='?', - default='Externals.cfg', - help='The externals description filename. ' - 'Default: %(default)s.') - - parser.add_argument('-o', '--optional', action='store_true', default=False, - help='By default only the required externals ' - 'are checked out. This flag will also checkout the ' - 'optional externals.') - - parser.add_argument('-S', '--status', action='store_true', default=False, - help='Output the status of the repositories managed by ' - '%(prog)s. By default only summary information ' - 'is provided. Use the verbose option to see details.') - - parser.add_argument('-v', '--verbose', action='count', default=0, - help='Output additional information to ' - 'the screen and log file. This flag can be ' - 'used up to two times, increasing the ' - 'verbosity level each time.') - - parser.add_argument('--svn-ignore-ancestry', action='store_true', default=False, - help='By default, subversion will abort if a component is ' - 'already checked out and there is no common ancestry with ' - 'the new URL. This flag passes the "--ignore-ancestry" flag ' - 'to the svn switch call. (This is not recommended unless ' - 'you are sure about what you are doing.)') - - # - # developer options - # - parser.add_argument('--backtrace', action='store_true', - help='DEVELOPER: show exception backtraces as extra ' - 'debugging output') - - parser.add_argument('-d', '--debug', action='store_true', default=False, - help='DEVELOPER: output additional debugging ' - 'information to the screen and log file.') - - logging_group = parser.add_mutually_exclusive_group() - - logging_group.add_argument('--logging', dest='do_logging', - action='store_true', - help='DEVELOPER: enable logging.') - logging_group.add_argument('--no-logging', dest='do_logging', - action='store_false', default=False, - help='DEVELOPER: disable logging ' - '(this is the default)') - - if args: - options = parser.parse_args(args) - else: - options = parser.parse_args() - return options - - -# --------------------------------------------------------------------- -# -# main -# -# --------------------------------------------------------------------- -def main(args): - """ - Function to call when module is called from the command line. - Parse externals file and load required repositories or all repositories if - the --all option is passed. - - Returns a tuple (overall_status, tree_status). overall_status is 0 - on success, non-zero on failure. tree_status gives the full status - *before* executing the checkout command - i.e., the status that it - used to determine if it's safe to proceed with the checkout. - """ - if args.do_logging: - logging.basicConfig(filename=LOG_FILE_NAME, - format='%(levelname)s : %(asctime)s : %(message)s', - datefmt='%Y-%m-%d %H:%M:%S', - level=logging.DEBUG) - - program_name = os.path.basename(sys.argv[0]) - logging.info('Beginning of %s', program_name) - - load_all = False - if args.optional: - load_all = True - - root_dir = os.path.abspath(os.getcwd()) - external_data = read_externals_description_file(root_dir, args.externals) - external = create_externals_description( - external_data, components=args.components) - - for comp in args.components: - if comp not in external.keys(): - fatal_error( - "No component {} found in {}".format( - comp, args.externals)) - - source_tree = SourceTree(root_dir, external, svn_ignore_ancestry=args.svn_ignore_ancestry) - printlog('Checking status of externals: ', end='') - tree_status = source_tree.status() - printlog('') - - if args.status: - # user requested status-only - for comp in sorted(tree_status.keys()): - tree_status[comp].log_status_message(args.verbose) - else: - # checkout / update the external repositories. - safe_to_update = check_safe_to_update_repos(tree_status) - if not safe_to_update: - # print status - for comp in sorted(tree_status.keys()): - tree_status[comp].log_status_message(args.verbose) - # exit gracefully - msg = """The external repositories labeled with 'M' above are not in a clean state. - -The following are two options for how to proceed: - -(1) Go into each external that is not in a clean state and issue either - an 'svn status' or a 'git status' command. Either revert or commit - your changes so that all externals are in a clean state. (Note, - though, that it is okay to have untracked files in your working - directory.) Then rerun {program_name}. - -(2) Alternatively, you do not have to rely on {program_name}. Instead, you - can manually update out-of-sync externals (labeled with 's' above) - as described in the configuration file {config_file}. - - -The external repositories labeled with '?' above are not under version -control using the expected protocol. If you are sure you want to switch -protocols, and you don't have any work you need to save from this -directory, then run "rm -rf [directory]" before re-running the -checkout_externals tool. -""".format(program_name=program_name, config_file=args.externals) - - printlog('-' * 70) - printlog(msg) - printlog('-' * 70) - else: - if not args.components: - source_tree.checkout(args.verbose, load_all) - for comp in args.components: - source_tree.checkout(args.verbose, load_all, load_comp=comp) - printlog('') - - logging.info('%s completed without exceptions.', program_name) - # NOTE(bja, 2017-11) tree status is used by the systems tests - return 0, tree_status diff --git a/manage_externals/manic/externals_description.py b/manage_externals/manic/externals_description.py deleted file mode 100644 index b0c4f736a7..0000000000 --- a/manage_externals/manic/externals_description.py +++ /dev/null @@ -1,794 +0,0 @@ -#!/usr/bin/env python - -"""Model description - -Model description is the representation of the various externals -included in the model. It processes in input data structure, and -converts it into a standard interface that is used by the rest of the -system. - -To maintain backward compatibility, externals description files should -follow semantic versioning rules, http://semver.org/ - - - -""" -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import logging -import os -import os.path -import re - -# ConfigParser in python2 was renamed to configparser in python3. -# In python2, ConfigParser returns byte strings, str, instead of unicode. -# We need unicode to be compatible with xml and json parser and python3. -try: - # python2 - from ConfigParser import SafeConfigParser as config_parser - from ConfigParser import MissingSectionHeaderError - from ConfigParser import NoSectionError, NoOptionError - - USE_PYTHON2 = True - - def config_string_cleaner(text): - """convert strings into unicode - """ - return text.decode('utf-8') -except ImportError: - # python3 - from configparser import ConfigParser as config_parser - from configparser import MissingSectionHeaderError - from configparser import NoSectionError, NoOptionError - - USE_PYTHON2 = False - - def config_string_cleaner(text): - """Python3 already uses unicode strings, so just return the string - without modification. - - """ - return text - -from .utils import printlog, fatal_error, str_to_bool, expand_local_url -from .utils import execute_subprocess -from .global_constants import EMPTY_STR, PPRINTER, VERSION_SEPERATOR - -# -# Globals -# -DESCRIPTION_SECTION = 'externals_description' -VERSION_ITEM = 'schema_version' - - -def read_externals_description_file(root_dir, file_name): - """Read a file containing an externals description and - create its internal representation. - - """ - root_dir = os.path.abspath(root_dir) - msg = 'In directory : {0}'.format(root_dir) - logging.info(msg) - printlog('Processing externals description file : {0}'.format(file_name)) - - file_path = os.path.join(root_dir, file_name) - if not os.path.exists(file_name): - if file_name.lower() == "none": - msg = ('INTERNAL ERROR: Attempt to read externals file ' - 'from {0} when not configured'.format(file_path)) - else: - msg = ('ERROR: Model description file, "{0}", does not ' - 'exist at path:\n {1}\nDid you run from the root of ' - 'the source tree?'.format(file_name, file_path)) - - fatal_error(msg) - - externals_description = None - if file_name == ExternalsDescription.GIT_SUBMODULES_FILENAME: - externals_description = read_gitmodules_file(root_dir, file_name) - else: - try: - config = config_parser() - config.read(file_path) - externals_description = config - except MissingSectionHeaderError: - # not a cfg file - pass - - if externals_description is None: - msg = 'Unknown file format!' - fatal_error(msg) - - return externals_description - -class LstripReader(object): - "LstripReader formats .gitmodules files to be acceptable for configparser" - def __init__(self, filename): - with open(filename, 'r') as infile: - lines = infile.readlines() - self._lines = list() - self._num_lines = len(lines) - self._index = 0 - for line in lines: - self._lines.append(line.lstrip()) - - def readlines(self): - """Return all the lines from this object's file""" - return self._lines - - def readline(self, size=-1): - """Format and return the next line or raise StopIteration""" - try: - line = self.next() - except StopIteration: - line = '' - - if (size > 0) and (len(line) < size): - return line[0:size] - - return line - - def __iter__(self): - """Begin an iteration""" - self._index = 0 - return self - - def next(self): - """Return the next line or raise StopIteration""" - if self._index >= self._num_lines: - raise StopIteration - - self._index = self._index + 1 - return self._lines[self._index - 1] - - def __next__(self): - return self.next() - -def git_submodule_status(repo_dir): - """Run the git submodule status command to obtain submodule hashes. - """ - # This function is here instead of GitRepository to avoid a dependency loop - cwd = os.getcwd() - os.chdir(repo_dir) - cmd = ['git', 'submodule', 'status'] - git_output = execute_subprocess(cmd, output_to_caller=True) - submodules = {} - submods = git_output.split('\n') - for submod in submods: - if submod: - status = submod[0] - items = submod[1:].split(' ') - if len(items) > 2: - tag = items[2] - else: - tag = None - - submodules[items[1]] = {'hash':items[0], 'status':status, 'tag':tag} - - os.chdir(cwd) - return submodules - -def parse_submodules_desc_section(section_items, file_path): - """Find the path and url for this submodule description""" - path = None - url = None - for item in section_items: - name = item[0].strip().lower() - if name == 'path': - path = item[1].strip() - elif name == 'url': - url = item[1].strip() - else: - msg = 'WARNING: Ignoring unknown {} property, in {}' - msg = msg.format(item[0], file_path) # fool pylint - logging.warning(msg) - - return path, url - -def read_gitmodules_file(root_dir, file_name): - # pylint: disable=deprecated-method - # Disabling this check because the method is only used for python2 - """Read a .gitmodules file and convert it to be compatible with an - externals description. - """ - root_dir = os.path.abspath(root_dir) - msg = 'In directory : {0}'.format(root_dir) - logging.info(msg) - printlog('Processing submodules description file : {0}'.format(file_name)) - - file_path = os.path.join(root_dir, file_name) - if not os.path.exists(file_name): - msg = ('ERROR: submodules description file, "{0}", does not ' - 'exist at path:\n {1}'.format(file_name, file_path)) - fatal_error(msg) - - submodules_description = None - externals_description = None - try: - config = config_parser() - if USE_PYTHON2: - config.readfp(LstripReader(file_path), filename=file_name) - else: - config.read_file(LstripReader(file_path), source=file_name) - - submodules_description = config - except MissingSectionHeaderError: - # not a cfg file - pass - - if submodules_description is None: - msg = 'Unknown file format!' - fatal_error(msg) - else: - # Convert the submodules description to an externals description - externals_description = config_parser() - # We need to grab all the commit hashes for this repo - submods = git_submodule_status(root_dir) - for section in submodules_description.sections(): - if section[0:9] == 'submodule': - sec_name = section[9:].strip(' "') - externals_description.add_section(sec_name) - section_items = submodules_description.items(section) - path, url = parse_submodules_desc_section(section_items, - file_path) - - if path is None: - msg = 'Submodule {} missing path'.format(sec_name) - fatal_error(msg) - - if url is None: - msg = 'Submodule {} missing url'.format(sec_name) - fatal_error(msg) - - externals_description.set(sec_name, - ExternalsDescription.PATH, path) - externals_description.set(sec_name, - ExternalsDescription.PROTOCOL, 'git') - externals_description.set(sec_name, - ExternalsDescription.REPO_URL, url) - externals_description.set(sec_name, - ExternalsDescription.REQUIRED, 'True') - git_hash = submods[sec_name]['hash'] - externals_description.set(sec_name, - ExternalsDescription.HASH, git_hash) - - # Required items - externals_description.add_section(DESCRIPTION_SECTION) - externals_description.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.0.0') - - return externals_description - -def create_externals_description( - model_data, model_format='cfg', components=None, parent_repo=None): - """Create the a externals description object from the provided data - """ - externals_description = None - if model_format == 'dict': - externals_description = ExternalsDescriptionDict( - model_data, components=components) - elif model_format == 'cfg': - major, _, _ = get_cfg_schema_version(model_data) - if major == 1: - externals_description = ExternalsDescriptionConfigV1( - model_data, components=components, parent_repo=parent_repo) - else: - msg = ('Externals description file has unsupported schema ' - 'version "{0}".'.format(major)) - fatal_error(msg) - else: - msg = 'Unknown model data format "{0}"'.format(model_format) - fatal_error(msg) - return externals_description - - -def get_cfg_schema_version(model_cfg): - """Extract the major, minor, patch version of the config file schema - - Params: - model_cfg - config parser object containing the externas description data - - Returns: - major = integer major version - minor = integer minor version - patch = integer patch version - """ - semver_str = '' - try: - semver_str = model_cfg.get(DESCRIPTION_SECTION, VERSION_ITEM) - except (NoSectionError, NoOptionError): - msg = ('externals description file must have the required ' - 'section: "{0}" and item "{1}"'.format(DESCRIPTION_SECTION, - VERSION_ITEM)) - fatal_error(msg) - - # NOTE(bja, 2017-11) Assume we don't care about the - # build/pre-release metadata for now! - version_list = re.split(r'[-+]', semver_str) - version_str = version_list[0] - version = version_str.split(VERSION_SEPERATOR) - try: - major = int(version[0].strip()) - minor = int(version[1].strip()) - patch = int(version[2].strip()) - except ValueError: - msg = ('Config file schema version must have integer digits for ' - 'major, minor and patch versions. ' - 'Received "{0}"'.format(version_str)) - fatal_error(msg) - return major, minor, patch - - -class ExternalsDescription(dict): - """Base externals description class that is independent of the user input - format. Different input formats can all be converted to this - representation to provide a consistent represtentation for the - rest of the objects in the system. - - NOTE(bja, 2018-03): do NOT define _schema_major etc at the class - level in the base class. The nested/recursive nature of externals - means different schema versions may be present in a single run! - - All inheriting classes must overwrite: - self._schema_major and self._input_major - self._schema_minor and self._input_minor - self._schema_patch and self._input_patch - - where _schema_x is the supported schema, _input_x is the user - input value. - - """ - # keywords defining the interface into the externals description data - EXTERNALS = 'externals' - BRANCH = 'branch' - SUBMODULE = 'from_submodule' - HASH = 'hash' - NAME = 'name' - PATH = 'local_path' - PROTOCOL = 'protocol' - REPO = 'repo' - REPO_URL = 'repo_url' - REQUIRED = 'required' - TAG = 'tag' - SPARSE = 'sparse' - - PROTOCOL_EXTERNALS_ONLY = 'externals_only' - PROTOCOL_GIT = 'git' - PROTOCOL_SVN = 'svn' - GIT_SUBMODULES_FILENAME = '.gitmodules' - KNOWN_PRROTOCOLS = [PROTOCOL_GIT, PROTOCOL_SVN, PROTOCOL_EXTERNALS_ONLY] - - # v1 xml keywords - _V1_TREE_PATH = 'TREE_PATH' - _V1_ROOT = 'ROOT' - _V1_TAG = 'TAG' - _V1_BRANCH = 'BRANCH' - _V1_REQ_SOURCE = 'REQ_SOURCE' - - _source_schema = {REQUIRED: True, - PATH: 'string', - EXTERNALS: 'string', - SUBMODULE : True, - REPO: {PROTOCOL: 'string', - REPO_URL: 'string', - TAG: 'string', - BRANCH: 'string', - HASH: 'string', - SPARSE: 'string', - } - } - - def __init__(self, parent_repo=None): - """Convert the xml into a standardized dict that can be used to - construct the source objects - - """ - dict.__init__(self) - - self._schema_major = None - self._schema_minor = None - self._schema_patch = None - self._input_major = None - self._input_minor = None - self._input_patch = None - self._parent_repo = parent_repo - - def _verify_schema_version(self): - """Use semantic versioning rules to verify we can process this schema. - - """ - known = '{0}.{1}.{2}'.format(self._schema_major, - self._schema_minor, - self._schema_patch) - received = '{0}.{1}.{2}'.format(self._input_major, - self._input_minor, - self._input_patch) - - if self._input_major != self._schema_major: - # should never get here, the factory should handle this correctly! - msg = ('DEV_ERROR: version "{0}" parser received ' - 'version "{1}" input.'.format(known, received)) - fatal_error(msg) - - if self._input_minor > self._schema_minor: - msg = ('Incompatible schema version:\n' - ' User supplied schema version "{0}" is too new."\n' - ' Can only process version "{1}" files and ' - 'older.'.format(received, known)) - fatal_error(msg) - - if self._input_patch > self._schema_patch: - # NOTE(bja, 2018-03) ignoring for now... Not clear what - # conditions the test is needed. - pass - - def _check_user_input(self): - """Run a series of checks to attempt to validate the user input and - detect errors as soon as possible. - - NOTE(bja, 2018-03) These checks are called *after* the file is - read. That means the schema check can not occur here. - - Note: the order is important. check_optional will create - optional with null data. run check_data first to ensure - required data was provided correctly by the user. - - """ - self._check_data() - self._check_optional() - self._validate() - - def _check_data(self): - # pylint: disable=too-many-branches,too-many-statements - """Check user supplied data is valid where possible. - """ - for ext_name in self.keys(): - if (self[ext_name][self.REPO][self.PROTOCOL] - not in self.KNOWN_PRROTOCOLS): - msg = 'Unknown repository protocol "{0}" in "{1}".'.format( - self[ext_name][self.REPO][self.PROTOCOL], ext_name) - fatal_error(msg) - - if (self[ext_name][self.REPO][self.PROTOCOL] == - self.PROTOCOL_SVN): - if self.HASH in self[ext_name][self.REPO]: - msg = ('In repo description for "{0}". svn repositories ' - 'may not include the "hash" keyword.'.format( - ext_name)) - fatal_error(msg) - - if ((self[ext_name][self.REPO][self.PROTOCOL] != self.PROTOCOL_GIT) - and (self.SUBMODULE in self[ext_name])): - msg = ('self.SUBMODULE is only supported with {0} protocol, ' - '"{1}" is defined as an {2} repository') - fatal_error(msg.format(self.PROTOCOL_GIT, ext_name, - self[ext_name][self.REPO][self.PROTOCOL])) - - if (self[ext_name][self.REPO][self.PROTOCOL] != - self.PROTOCOL_EXTERNALS_ONLY): - ref_count = 0 - found_refs = '' - if self.TAG in self[ext_name][self.REPO]: - ref_count += 1 - found_refs = '"{0} = {1}", {2}'.format( - self.TAG, self[ext_name][self.REPO][self.TAG], - found_refs) - if self.BRANCH in self[ext_name][self.REPO]: - ref_count += 1 - found_refs = '"{0} = {1}", {2}'.format( - self.BRANCH, self[ext_name][self.REPO][self.BRANCH], - found_refs) - if self.HASH in self[ext_name][self.REPO]: - ref_count += 1 - found_refs = '"{0} = {1}", {2}'.format( - self.HASH, self[ext_name][self.REPO][self.HASH], - found_refs) - if (self.SUBMODULE in self[ext_name] and - self[ext_name][self.SUBMODULE]): - ref_count += 1 - found_refs = '"{0} = {1}", {2}'.format( - self.SUBMODULE, - self[ext_name][self.SUBMODULE], found_refs) - - if ref_count > 1: - msg = 'Model description is over specified! ' - if self.SUBMODULE in self[ext_name]: - msg += ('from_submodule is not compatible with ' - '"tag", "branch", or "hash" ') - else: - msg += (' Only one of "tag", "branch", or "hash" ' - 'may be specified ') - - msg += 'for repo description of "{0}".'.format(ext_name) - msg = '{0}\nFound: {1}'.format(msg, found_refs) - fatal_error(msg) - elif ref_count < 1: - msg = ('Model description is under specified! One of ' - '"tag", "branch", or "hash" must be specified for ' - 'repo description of "{0}"'.format(ext_name)) - fatal_error(msg) - - if (self.REPO_URL not in self[ext_name][self.REPO] and - (self.SUBMODULE not in self[ext_name] or - not self[ext_name][self.SUBMODULE])): - msg = ('Model description is under specified! Must have ' - '"repo_url" in repo ' - 'description for "{0}"'.format(ext_name)) - fatal_error(msg) - - if (self.SUBMODULE in self[ext_name] and - self[ext_name][self.SUBMODULE]): - if self.REPO_URL in self[ext_name][self.REPO]: - msg = ('Model description is over specified! ' - 'from_submodule keyword is not compatible ' - 'with {0} keyword for'.format(self.REPO_URL)) - msg = '{0} repo description of "{1}"'.format(msg, - ext_name) - fatal_error(msg) - - if self.PATH in self[ext_name]: - msg = ('Model description is over specified! ' - 'from_submodule keyword is not compatible with ' - '{0} keyword for'.format(self.PATH)) - msg = '{0} repo description of "{1}"'.format(msg, - ext_name) - fatal_error(msg) - - if self.REPO_URL in self[ext_name][self.REPO]: - url = expand_local_url( - self[ext_name][self.REPO][self.REPO_URL], ext_name) - self[ext_name][self.REPO][self.REPO_URL] = url - - def _check_optional(self): - # pylint: disable=too-many-branches - """Some fields like externals, repo:tag repo:branch are - (conditionally) optional. We don't want the user to be - required to enter them in every externals description file, but - still want to validate the input. Check conditions and add - default values if appropriate. - - """ - submod_desc = None # Only load submodules info once - for field in self: - # truely optional - if self.EXTERNALS not in self[field]: - self[field][self.EXTERNALS] = EMPTY_STR - - # git and svn repos must tags and branches for validation purposes. - if self.TAG not in self[field][self.REPO]: - self[field][self.REPO][self.TAG] = EMPTY_STR - if self.BRANCH not in self[field][self.REPO]: - self[field][self.REPO][self.BRANCH] = EMPTY_STR - if self.HASH not in self[field][self.REPO]: - self[field][self.REPO][self.HASH] = EMPTY_STR - if self.REPO_URL not in self[field][self.REPO]: - self[field][self.REPO][self.REPO_URL] = EMPTY_STR - if self.SPARSE not in self[field][self.REPO]: - self[field][self.REPO][self.SPARSE] = EMPTY_STR - - # from_submodule has a complex relationship with other fields - if self.SUBMODULE in self[field]: - # User wants to use submodule information, is it available? - if self._parent_repo is None: - # No parent == no submodule information - PPRINTER.pprint(self[field]) - msg = 'No parent submodule for "{0}"'.format(field) - fatal_error(msg) - elif self._parent_repo.protocol() != self.PROTOCOL_GIT: - PPRINTER.pprint(self[field]) - msg = 'Parent protocol, "{0}", does not support submodules' - fatal_error(msg.format(self._parent_repo.protocol())) - else: - args = self._repo_config_from_submodule(field, submod_desc) - repo_url, repo_path, ref_hash, submod_desc = args - - if repo_url is None: - msg = ('Cannot checkout "{0}" as a submodule, ' - 'repo not found in {1} file') - fatal_error(msg.format(field, - self.GIT_SUBMODULES_FILENAME)) - # Fill in submodule fields - self[field][self.REPO][self.REPO_URL] = repo_url - self[field][self.REPO][self.HASH] = ref_hash - self[field][self.PATH] = repo_path - - if self[field][self.SUBMODULE]: - # We should get everything from the parent submodule - # configuration. - pass - # No else (from _submodule = False is the default) - else: - # Add the default value (not using submodule information) - self[field][self.SUBMODULE] = False - - def _repo_config_from_submodule(self, field, submod_desc): - """Find the external config information for a repository from - its submodule configuration information. - """ - if submod_desc is None: - repo_path = os.getcwd() # Is this always correct? - submod_file = self._parent_repo.submodules_file(repo_path=repo_path) - if submod_file is None: - msg = ('Cannot checkout "{0}" from submodule information\n' - ' Parent repo, "{1}" does not have submodules') - fatal_error(msg.format(field, self._parent_repo.name())) - - submod_file = read_gitmodules_file(repo_path, submod_file) - submod_desc = create_externals_description(submod_file) - - # Can we find our external? - repo_url = None - repo_path = None - ref_hash = None - for ext_field in submod_desc: - if field == ext_field: - ext = submod_desc[ext_field] - repo_url = ext[self.REPO][self.REPO_URL] - repo_path = ext[self.PATH] - ref_hash = ext[self.REPO][self.HASH] - break - - return repo_url, repo_path, ref_hash, submod_desc - - def _validate(self): - """Validate that the parsed externals description contains all necessary - fields. - - """ - def print_compare_difference(data_a, data_b, loc_a, loc_b): - """Look through the data structures and print the differences. - - """ - for item in data_a: - if item in data_b: - if not isinstance(data_b[item], type(data_a[item])): - printlog(" {item}: {loc} = {val} ({val_type})".format( - item=item, loc=loc_a, val=data_a[item], - val_type=type(data_a[item]))) - printlog(" {item} {loc} = {val} ({val_type})".format( - item=' ' * len(item), loc=loc_b, val=data_b[item], - val_type=type(data_b[item]))) - else: - printlog(" {item}: {loc} = {val} ({val_type})".format( - item=item, loc=loc_a, val=data_a[item], - val_type=type(data_a[item]))) - printlog(" {item} {loc} missing".format( - item=' ' * len(item), loc=loc_b)) - - def validate_data_struct(schema, data): - """Compare a data structure against a schema and validate all required - fields are present. - - """ - is_valid = False - in_ref = True - valid = True - if isinstance(schema, dict) and isinstance(data, dict): - # Both are dicts, recursively verify that all fields - # in schema are present in the data. - for key in schema: - in_ref = in_ref and (key in data) - if in_ref: - valid = valid and ( - validate_data_struct(schema[key], data[key])) - - is_valid = in_ref and valid - else: - # non-recursive structure. verify data and schema have - # the same type. - is_valid = isinstance(data, type(schema)) - - if not is_valid: - printlog(" Unmatched schema and input:") - if isinstance(schema, dict): - print_compare_difference(schema, data, 'schema', 'input') - print_compare_difference(data, schema, 'input', 'schema') - else: - printlog(" schema = {0} ({1})".format( - schema, type(schema))) - printlog(" input = {0} ({1})".format(data, type(data))) - - return is_valid - - for field in self: - valid = validate_data_struct(self._source_schema, self[field]) - if not valid: - PPRINTER.pprint(self._source_schema) - PPRINTER.pprint(self[field]) - msg = 'ERROR: source for "{0}" did not validate'.format(field) - fatal_error(msg) - - -class ExternalsDescriptionDict(ExternalsDescription): - """Create a externals description object from a dictionary using the API - representations. Primarily used to simplify creating model - description files for unit testing. - - """ - - def __init__(self, model_data, components=None): - """Parse a native dictionary into a externals description. - """ - ExternalsDescription.__init__(self) - self._schema_major = 1 - self._schema_minor = 0 - self._schema_patch = 0 - self._input_major = 1 - self._input_minor = 0 - self._input_patch = 0 - self._verify_schema_version() - if components: - for key in model_data.items(): - if key not in components: - del model_data[key] - - self.update(model_data) - self._check_user_input() - - -class ExternalsDescriptionConfigV1(ExternalsDescription): - """Create a externals description object from a config_parser object, - schema version 1. - - """ - - def __init__(self, model_data, components=None, parent_repo=None): - """Convert the config data into a standardized dict that can be used to - construct the source objects - - """ - ExternalsDescription.__init__(self, parent_repo=parent_repo) - self._schema_major = 1 - self._schema_minor = 1 - self._schema_patch = 0 - self._input_major, self._input_minor, self._input_patch = \ - get_cfg_schema_version(model_data) - self._verify_schema_version() - self._remove_metadata(model_data) - self._parse_cfg(model_data, components=components) - self._check_user_input() - - @staticmethod - def _remove_metadata(model_data): - """Remove the metadata section from the model configuration file so - that it is simpler to look through the file and construct the - externals description. - - """ - model_data.remove_section(DESCRIPTION_SECTION) - - def _parse_cfg(self, cfg_data, components=None): - """Parse a config_parser object into a externals description. - """ - def list_to_dict(input_list, convert_to_lower_case=True): - """Convert a list of key-value pairs into a dictionary. - """ - output_dict = {} - for item in input_list: - key = config_string_cleaner(item[0].strip()) - value = config_string_cleaner(item[1].strip()) - if convert_to_lower_case: - key = key.lower() - output_dict[key] = value - return output_dict - - for section in cfg_data.sections(): - name = config_string_cleaner(section.lower().strip()) - if components and name not in components: - continue - self[name] = {} - self[name].update(list_to_dict(cfg_data.items(section))) - self[name][self.REPO] = {} - loop_keys = self[name].copy().keys() - for item in loop_keys: - if item in self._source_schema: - if isinstance(self._source_schema[item], bool): - self[name][item] = str_to_bool(self[name][item]) - elif item in self._source_schema[self.REPO]: - self[name][self.REPO][item] = self[name][item] - del self[name][item] - else: - msg = ('Invalid input: "{sect}" contains unknown ' - 'item "{item}".'.format(sect=name, item=item)) - fatal_error(msg) diff --git a/manage_externals/manic/externals_status.py b/manage_externals/manic/externals_status.py deleted file mode 100644 index d3d238f289..0000000000 --- a/manage_externals/manic/externals_status.py +++ /dev/null @@ -1,164 +0,0 @@ -"""ExternalStatus - -Class to store status and state information about repositories and -create a string representation. - -""" -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -from .global_constants import EMPTY_STR -from .utils import printlog, indent_string -from .global_constants import VERBOSITY_VERBOSE, VERBOSITY_DUMP - - -class ExternalStatus(object): - """Class to represent the status of a given source repository or tree. - - Individual repositories determine their own status in the - Repository objects. This object is just resposible for storing the - information and passing it up to a higher level for reporting or - global decisions. - - There are two states of concern: - - * If the repository is in-sync with the externals description file. - - * If the repostiory working copy is clean and there are no pending - transactions (e.g. add, remove, rename, untracked files). - - """ - DEFAULT = '-' - UNKNOWN = '?' - EMPTY = 'e' - MODEL_MODIFIED = 's' # a.k.a. out-of-sync - DIRTY = 'M' - - STATUS_OK = ' ' - STATUS_ERROR = '!' - - # source types - OPTIONAL = 'o' - STANDALONE = 's' - MANAGED = ' ' - - def __init__(self): - self.sync_state = self.DEFAULT - self.clean_state = self.DEFAULT - self.source_type = self.DEFAULT - self.path = EMPTY_STR - self.current_version = EMPTY_STR - self.expected_version = EMPTY_STR - self.status_output = EMPTY_STR - - def log_status_message(self, verbosity): - """Write status message to the screen and log file - """ - self._default_status_message() - if verbosity >= VERBOSITY_VERBOSE: - self._verbose_status_message() - if verbosity >= VERBOSITY_DUMP: - self._dump_status_message() - - def _default_status_message(self): - """Return the default terse status message string - """ - msg = '{sync}{clean}{src_type} {path}'.format( - sync=self.sync_state, clean=self.clean_state, - src_type=self.source_type, path=self.path) - printlog(msg) - - def _verbose_status_message(self): - """Return the verbose status message string - """ - clean_str = self.DEFAULT - if self.clean_state == self.STATUS_OK: - clean_str = 'clean sandbox' - elif self.clean_state == self.DIRTY: - clean_str = 'modified sandbox' - - sync_str = 'on {0}'.format(self.current_version) - if self.sync_state != self.STATUS_OK: - sync_str = '{current} --> {expected}'.format( - current=self.current_version, expected=self.expected_version) - msg = ' {clean}, {sync}'.format(clean=clean_str, sync=sync_str) - printlog(msg) - - def _dump_status_message(self): - """Return the dump status message string - """ - msg = indent_string(self.status_output, 12) - printlog(msg) - - def safe_to_update(self): - """Report if it is safe to update a repository. Safe is defined as: - - * If a repository is empty, it is safe to update. - - * If a repository exists and has a clean working copy state - with no pending transactions. - - """ - safe_to_update = False - repo_exists = self.exists() - if not repo_exists: - safe_to_update = True - else: - # If the repo exists, it must be in ok or modified - # sync_state. Any other sync_state at this point - # represents a logic error that should have been handled - # before now! - sync_safe = ((self.sync_state == ExternalStatus.STATUS_OK) or - (self.sync_state == ExternalStatus.MODEL_MODIFIED)) - if sync_safe: - # The clean_state must be STATUS_OK to update. Otherwise we - # are dirty or there was a missed error previously. - if self.clean_state == ExternalStatus.STATUS_OK: - safe_to_update = True - return safe_to_update - - def exists(self): - """Determine if the repo exists. This is indicated by: - - * sync_state is not EMPTY - - * if the sync_state is empty, then the valid states for - clean_state are default, empty or unknown. Anything else - and there was probably an internal logic error. - - NOTE(bja, 2017-10) For the moment we are considering a - sync_state of default or unknown to require user intervention, - but we may want to relax this convention. This is probably a - result of a network error or internal logic error but more - testing is needed. - - """ - is_empty = (self.sync_state == ExternalStatus.EMPTY) - clean_valid = ((self.clean_state == ExternalStatus.DEFAULT) or - (self.clean_state == ExternalStatus.EMPTY) or - (self.clean_state == ExternalStatus.UNKNOWN)) - - if is_empty and clean_valid: - exists = False - else: - exists = True - return exists - - -def check_safe_to_update_repos(tree_status): - """Check if *ALL* repositories are in a safe state to update. We don't - want to do a partial update of the repositories then die, leaving - the model in an inconsistent state. - - Note: if there is an update to do, the repositories will by - definiation be out of synce with the externals description, so we - can't use that as criteria for updating. - - """ - safe_to_update = True - for comp in tree_status: - stat = tree_status[comp] - safe_to_update &= stat.safe_to_update() - - return safe_to_update diff --git a/manage_externals/manic/global_constants.py b/manage_externals/manic/global_constants.py deleted file mode 100644 index 0e91cffc90..0000000000 --- a/manage_externals/manic/global_constants.py +++ /dev/null @@ -1,18 +0,0 @@ -"""Globals shared across modules -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import pprint - -EMPTY_STR = '' -LOCAL_PATH_INDICATOR = '.' -VERSION_SEPERATOR = '.' -LOG_FILE_NAME = 'manage_externals.log' -PPRINTER = pprint.PrettyPrinter(indent=4) - -VERBOSITY_DEFAULT = 0 -VERBOSITY_VERBOSE = 1 -VERBOSITY_DUMP = 2 diff --git a/manage_externals/manic/repository.py b/manage_externals/manic/repository.py deleted file mode 100644 index ea4230fb7b..0000000000 --- a/manage_externals/manic/repository.py +++ /dev/null @@ -1,98 +0,0 @@ -"""Base class representation of a repository -""" - -from .externals_description import ExternalsDescription -from .utils import fatal_error -from .global_constants import EMPTY_STR - - -class Repository(object): - """ - Class to represent and operate on a repository description. - """ - - def __init__(self, component_name, repo): - """ - Parse repo externals description - """ - self._name = component_name - self._protocol = repo[ExternalsDescription.PROTOCOL] - self._tag = repo[ExternalsDescription.TAG] - self._branch = repo[ExternalsDescription.BRANCH] - self._hash = repo[ExternalsDescription.HASH] - self._url = repo[ExternalsDescription.REPO_URL] - self._sparse = repo[ExternalsDescription.SPARSE] - - if self._url is EMPTY_STR: - fatal_error('repo must have a URL') - - if ((self._tag is EMPTY_STR) and (self._branch is EMPTY_STR) and - (self._hash is EMPTY_STR)): - fatal_error('{0} repo must have a branch, tag or hash element') - - ref_count = 0 - if self._tag is not EMPTY_STR: - ref_count += 1 - if self._branch is not EMPTY_STR: - ref_count += 1 - if self._hash is not EMPTY_STR: - ref_count += 1 - if ref_count != 1: - fatal_error('repo {0} must have exactly one of ' - 'tag, branch or hash.'.format(self._name)) - - def checkout(self, base_dir_path, repo_dir_name, verbosity, recursive): # pylint: disable=unused-argument - """ - If the repo destination directory exists, ensure it is correct (from - correct URL, correct branch or tag), and possibly update the source. - If the repo destination directory does not exist, checkout the correce - branch or tag. - NB: is include as an argument for compatibility with - git functionality (repository_git.py) - """ - msg = ('DEV_ERROR: checkout method must be implemented in all ' - 'repository classes! {0}'.format(self.__class__.__name__)) - fatal_error(msg) - - def status(self, stat, repo_dir_path): # pylint: disable=unused-argument - """Report the status of the repo - - """ - msg = ('DEV_ERROR: status method must be implemented in all ' - 'repository classes! {0}'.format(self.__class__.__name__)) - fatal_error(msg) - - def submodules_file(self, repo_path=None): - # pylint: disable=no-self-use,unused-argument - """Stub for use by non-git VC systems""" - return None - - def url(self): - """Public access of repo url. - """ - return self._url - - def tag(self): - """Public access of repo tag - """ - return self._tag - - def branch(self): - """Public access of repo branch. - """ - return self._branch - - def hash(self): - """Public access of repo hash. - """ - return self._hash - - def name(self): - """Public access of repo name. - """ - return self._name - - def protocol(self): - """Public access of repo protocol. - """ - return self._protocol diff --git a/manage_externals/manic/repository_factory.py b/manage_externals/manic/repository_factory.py deleted file mode 100644 index 80a92a9d8a..0000000000 --- a/manage_externals/manic/repository_factory.py +++ /dev/null @@ -1,29 +0,0 @@ -"""Factory for creating and initializing the appropriate repository class -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -from .repository_git import GitRepository -from .repository_svn import SvnRepository -from .externals_description import ExternalsDescription -from .utils import fatal_error - - -def create_repository(component_name, repo_info, svn_ignore_ancestry=False): - """Determine what type of repository we have, i.e. git or svn, and - create the appropriate object. - - """ - protocol = repo_info[ExternalsDescription.PROTOCOL].lower() - if protocol == 'git': - repo = GitRepository(component_name, repo_info) - elif protocol == 'svn': - repo = SvnRepository(component_name, repo_info, ignore_ancestry=svn_ignore_ancestry) - elif protocol == 'externals_only': - repo = None - else: - msg = 'Unknown repo protocol "{0}"'.format(protocol) - fatal_error(msg) - return repo diff --git a/manage_externals/manic/repository_git.py b/manage_externals/manic/repository_git.py deleted file mode 100644 index f986051001..0000000000 --- a/manage_externals/manic/repository_git.py +++ /dev/null @@ -1,819 +0,0 @@ -"""Class for interacting with git repositories -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import copy -import os - -from .global_constants import EMPTY_STR, LOCAL_PATH_INDICATOR -from .global_constants import VERBOSITY_VERBOSE -from .repository import Repository -from .externals_status import ExternalStatus -from .externals_description import ExternalsDescription, git_submodule_status -from .utils import expand_local_url, split_remote_url, is_remote_url -from .utils import fatal_error, printlog -from .utils import execute_subprocess - - -class GitRepository(Repository): - """Class to represent and operate on a repository description. - - For testing purpose, all system calls to git should: - - * be isolated in separate functions with no application logic - * of the form: - - cmd = ['git', ...] - - value = execute_subprocess(cmd, output_to_caller={T|F}, - status_to_caller={T|F}) - - return value - * be static methods (not rely on self) - * name as _git_subcommand_args(user_args) - - This convention allows easy unit testing of the repository logic - by mocking the specific calls to return predefined results. - - """ - - def __init__(self, component_name, repo): - """ - Parse repo (a XML element). - """ - Repository.__init__(self, component_name, repo) - self._gitmodules = None - self._submods = None - - # ---------------------------------------------------------------- - # - # Public API, defined by Repository - # - # ---------------------------------------------------------------- - def checkout(self, base_dir_path, repo_dir_name, verbosity, recursive): - """ - If the repo destination directory exists, ensure it is correct (from - correct URL, correct branch or tag), and possibly update the source. - If the repo destination directory does not exist, checkout the correct - branch or tag. - """ - repo_dir_path = os.path.join(base_dir_path, repo_dir_name) - repo_dir_exists = os.path.exists(repo_dir_path) - if (repo_dir_exists and not os.listdir( - repo_dir_path)) or not repo_dir_exists: - self._clone_repo(base_dir_path, repo_dir_name, verbosity) - self._checkout_ref(repo_dir_path, verbosity, recursive) - gmpath = os.path.join(repo_dir_path, - ExternalsDescription.GIT_SUBMODULES_FILENAME) - if os.path.exists(gmpath): - self._gitmodules = gmpath - self._submods = git_submodule_status(repo_dir_path) - else: - self._gitmodules = None - self._submods = None - - def status(self, stat, repo_dir_path): - """ - If the repo destination directory exists, ensure it is correct (from - correct URL, correct branch or tag), and possibly update the source. - If the repo destination directory does not exist, checkout the correct - branch or tag. - """ - self._check_sync(stat, repo_dir_path) - if os.path.exists(repo_dir_path): - self._status_summary(stat, repo_dir_path) - - def submodules_file(self, repo_path=None): - if repo_path is not None: - gmpath = os.path.join(repo_path, - ExternalsDescription.GIT_SUBMODULES_FILENAME) - if os.path.exists(gmpath): - self._gitmodules = gmpath - self._submods = git_submodule_status(repo_path) - - return self._gitmodules - - # ---------------------------------------------------------------- - # - # Internal work functions - # - # ---------------------------------------------------------------- - def _clone_repo(self, base_dir_path, repo_dir_name, verbosity): - """Prepare to execute the clone by managing directory location - """ - cwd = os.getcwd() - os.chdir(base_dir_path) - self._git_clone(self._url, repo_dir_name, verbosity) - os.chdir(cwd) - - def _current_ref(self): - """Determine the *name* associated with HEAD. - - If we're on a branch, then returns the branch name; otherwise, - if we're on a tag, then returns the tag name; otherwise, returns - the current hash. Returns an empty string if no reference can be - determined (e.g., if we're not actually in a git repository). - """ - ref_found = False - - # If we're on a branch, then use that as the current ref - branch_found, branch_name = self._git_current_branch() - if branch_found: - current_ref = branch_name - ref_found = True - - if not ref_found: - # Otherwise, if we're exactly at a tag, use that as the - # current ref - tag_found, tag_name = self._git_current_tag() - if tag_found: - current_ref = tag_name - ref_found = True - - if not ref_found: - # Otherwise, use current hash as the current ref - hash_found, hash_name = self._git_current_hash() - if hash_found: - current_ref = hash_name - ref_found = True - - if not ref_found: - # If we still can't find a ref, return empty string. This - # can happen if we're not actually in a git repo - current_ref = '' - - return current_ref - - def _check_sync(self, stat, repo_dir_path): - """Determine whether a git repository is in-sync with the model - description. - - Because repos can have multiple remotes, the only criteria is - whether the branch or tag is the same. - - """ - if not os.path.exists(repo_dir_path): - # NOTE(bja, 2017-10) condition should have been determined - # by _Source() object and should never be here! - stat.sync_state = ExternalStatus.STATUS_ERROR - else: - git_dir = os.path.join(repo_dir_path, '.git') - if not os.path.exists(git_dir): - # NOTE(bja, 2017-10) directory exists, but no git repo - # info.... Can't test with subprocess git command - # because git will move up directory tree until it - # finds the parent repo git dir! - stat.sync_state = ExternalStatus.UNKNOWN - else: - self._check_sync_logic(stat, repo_dir_path) - - def _check_sync_logic(self, stat, repo_dir_path): - """Compare the underlying hashes of the currently checkout ref and the - expected ref. - - Output: sets the sync_state as well as the current and - expected ref in the input status object. - - """ - def compare_refs(current_ref, expected_ref): - """Compare the current and expected ref. - - """ - if current_ref == expected_ref: - status = ExternalStatus.STATUS_OK - else: - status = ExternalStatus.MODEL_MODIFIED - return status - - cwd = os.getcwd() - os.chdir(repo_dir_path) - - # get the full hash of the current commit - _, current_ref = self._git_current_hash() - - if self._branch: - if self._url == LOCAL_PATH_INDICATOR: - expected_ref = self._branch - else: - remote_name = self._determine_remote_name() - if not remote_name: - # git doesn't know about this remote. by definition - # this is a modified state. - expected_ref = "unknown_remote/{0}".format(self._branch) - else: - expected_ref = "{0}/{1}".format(remote_name, self._branch) - elif self._hash: - expected_ref = self._hash - elif self._tag: - expected_ref = self._tag - else: - msg = 'In repo "{0}": none of branch, hash or tag are set'.format( - self._name) - fatal_error(msg) - - # record the *names* of the current and expected branches - stat.current_version = self._current_ref() - stat.expected_version = copy.deepcopy(expected_ref) - - if current_ref == EMPTY_STR: - stat.sync_state = ExternalStatus.UNKNOWN - else: - # get the underlying hash of the expected ref - revparse_status, expected_ref_hash = self._git_revparse_commit( - expected_ref) - if revparse_status: - # We failed to get the hash associated with - # expected_ref. Maybe we should assign this to some special - # status, but for now we're just calling this out-of-sync to - # remain consistent with how this worked before. - stat.sync_state = ExternalStatus.MODEL_MODIFIED - else: - # compare the underlying hashes - stat.sync_state = compare_refs(current_ref, expected_ref_hash) - - os.chdir(cwd) - - def _determine_remote_name(self): - """Return the remote name. - - Note that this is for the *future* repo url and branch, not - the current working copy! - - """ - git_output = self._git_remote_verbose() - git_output = git_output.splitlines() - remote_name = '' - for line in git_output: - data = line.strip() - if not data: - continue - data = data.split() - name = data[0].strip() - url = data[1].strip() - if self._url == url: - remote_name = name - break - return remote_name - - def _create_remote_name(self): - """The url specified in the externals description file was not known - to git. We need to add it, which means adding a unique and - safe name.... - - The assigned name needs to be safe for git to use, e.g. can't - look like a path 'foo/bar' and work with both remote and local paths. - - Remote paths include but are not limited to: git, ssh, https, - github, gitlab, bitbucket, custom server, etc. - - Local paths can be relative or absolute. They may contain - shell variables, e.g. ${REPO_ROOT}/repo_name, or username - expansion, i.e. ~/ or ~someuser/. - - Relative paths must be at least one layer of redirection, i.e. - container/../ext_repo, but may be many layers deep, e.g. - container/../../../../../ext_repo - - NOTE(bja, 2017-11) - - The base name below may not be unique, for example if the - user has local paths like: - - /path/to/my/repos/nice_repo - /path/to/other/repos/nice_repo - - But the current implementation should cover most common - use cases for remotes and still provide usable names. - - """ - url = copy.deepcopy(self._url) - if is_remote_url(url): - url = split_remote_url(url) - else: - url = expand_local_url(url, self._name) - url = url.split('/') - repo_name = url[-1] - base_name = url[-2] - # repo name should nominally already be something that git can - # deal with. We need to remove other possibly troublesome - # punctuation, e.g. /, $, from the base name. - unsafe_characters = '!@#$%^&*()[]{}\\/,;~' - for unsafe in unsafe_characters: - base_name = base_name.replace(unsafe, '') - remote_name = "{0}_{1}".format(base_name, repo_name) - return remote_name - - def _checkout_ref(self, repo_dir, verbosity, submodules): - """Checkout the user supplied reference - if is True, recursively initialize and update - the repo's submodules - """ - # import pdb; pdb.set_trace() - cwd = os.getcwd() - os.chdir(repo_dir) - if self._url.strip() == LOCAL_PATH_INDICATOR: - self._checkout_local_ref(verbosity, submodules) - else: - self._checkout_external_ref(verbosity, submodules) - - if self._sparse: - self._sparse_checkout(repo_dir, verbosity) - os.chdir(cwd) - - - def _checkout_local_ref(self, verbosity, submodules): - """Checkout the reference considering the local repo only. Do not - fetch any additional remotes or specify the remote when - checkout out the ref. - if is True, recursively initialize and update - the repo's submodules - """ - if self._tag: - ref = self._tag - elif self._branch: - ref = self._branch - else: - ref = self._hash - - self._check_for_valid_ref(ref) - self._git_checkout_ref(ref, verbosity, submodules) - - def _checkout_external_ref(self, verbosity, submodules): - """Checkout the reference from a remote repository - if is True, recursively initialize and update - the repo's submodules - """ - if self._tag: - ref = self._tag - elif self._branch: - ref = self._branch - else: - ref = self._hash - - remote_name = self._determine_remote_name() - if not remote_name: - remote_name = self._create_remote_name() - self._git_remote_add(remote_name, self._url) - self._git_fetch(remote_name) - - # NOTE(bja, 2018-03) we need to send separate ref and remote - # name to check_for_vaild_ref, but the combined name to - # checkout_ref! - self._check_for_valid_ref(ref, remote_name) - - if self._branch: - ref = '{0}/{1}'.format(remote_name, ref) - self._git_checkout_ref(ref, verbosity, submodules) - - def _sparse_checkout(self, repo_dir, verbosity): - """Use git read-tree to thin the working tree.""" - cwd = os.getcwd() - - cmd = ['cp', self._sparse, os.path.join(repo_dir, - '.git/info/sparse-checkout')] - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) - os.chdir(repo_dir) - self._git_sparse_checkout(verbosity) - - os.chdir(cwd) - - def _check_for_valid_ref(self, ref, remote_name=None): - """Try some basic sanity checks on the user supplied reference so we - can provide a more useful error message than calledprocess - error... - - """ - is_tag = self._ref_is_tag(ref) - is_branch = self._ref_is_branch(ref, remote_name) - is_hash = self._ref_is_hash(ref) - - is_valid = is_tag or is_branch or is_hash - if not is_valid: - msg = ('In repo "{0}": reference "{1}" does not appear to be a ' - 'valid tag, branch or hash! Please verify the reference ' - 'name (e.g. spelling), is available from: {2} '.format( - self._name, ref, self._url)) - fatal_error(msg) - - if is_tag: - is_unique_tag, msg = self._is_unique_tag(ref, remote_name) - if not is_unique_tag: - msg = ('In repo "{0}": tag "{1}" {2}'.format( - self._name, self._tag, msg)) - fatal_error(msg) - - return is_valid - - def _is_unique_tag(self, ref, remote_name): - """Verify that a reference is a valid tag and is unique (not a branch) - - Tags may be tag names, or SHA id's. It is also possible that a - branch and tag have the some name. - - Note: values returned by git_showref_* and git_revparse are - shell return codes, which are zero for success, non-zero for - error! - - """ - is_tag = self._ref_is_tag(ref) - is_branch = self._ref_is_branch(ref, remote_name) - is_hash = self._ref_is_hash(ref) - - msg = '' - is_unique_tag = False - if is_tag and not is_branch: - # unique tag - msg = 'is ok' - is_unique_tag = True - elif is_tag and is_branch: - msg = ('is both a branch and a tag. git may checkout the branch ' - 'instead of the tag depending on your version of git.') - is_unique_tag = False - elif not is_tag and is_branch: - msg = ('is a branch, and not a tag. If you intended to checkout ' - 'a branch, please change the externals description to be ' - 'a branch. If you intended to checkout a tag, it does not ' - 'exist. Please check the name.') - is_unique_tag = False - else: # not is_tag and not is_branch: - if is_hash: - # probably a sha1 or HEAD, etc, we call it a tag - msg = 'is ok' - is_unique_tag = True - else: - # undetermined state. - msg = ('does not appear to be a valid tag, branch or hash! ' - 'Please check the name and repository.') - is_unique_tag = False - - return is_unique_tag, msg - - def _ref_is_tag(self, ref): - """Verify that a reference is a valid tag according to git. - - Note: values returned by git_showref_* and git_revparse are - shell return codes, which are zero for success, non-zero for - error! - """ - is_tag = False - value = self._git_showref_tag(ref) - if value == 0: - is_tag = True - return is_tag - - def _ref_is_branch(self, ref, remote_name=None): - """Verify if a ref is any kind of branch (local, tracked remote, - untracked remote). - - """ - local_branch = False - remote_branch = False - if remote_name: - remote_branch = self._ref_is_remote_branch(ref, remote_name) - local_branch = self._ref_is_local_branch(ref) - - is_branch = False - if local_branch or remote_branch: - is_branch = True - return is_branch - - def _ref_is_local_branch(self, ref): - """Verify that a reference is a valid branch according to git. - - show-ref branch returns local branches that have been - previously checked out. It will not necessarily pick up - untracked remote branches. - - Note: values returned by git_showref_* and git_revparse are - shell return codes, which are zero for success, non-zero for - error! - - """ - is_branch = False - value = self._git_showref_branch(ref) - if value == 0: - is_branch = True - return is_branch - - def _ref_is_remote_branch(self, ref, remote_name): - """Verify that a reference is a valid branch according to git. - - show-ref branch returns local branches that have been - previously checked out. It will not necessarily pick up - untracked remote branches. - - Note: values returned by git_showref_* and git_revparse are - shell return codes, which are zero for success, non-zero for - error! - - """ - is_branch = False - value = self._git_lsremote_branch(ref, remote_name) - if value == 0: - is_branch = True - return is_branch - - def _ref_is_commit(self, ref): - """Verify that a reference is a valid commit according to git. - - This could be a tag, branch, sha1 id, HEAD and potentially others... - - Note: values returned by git_showref_* and git_revparse are - shell return codes, which are zero for success, non-zero for - error! - """ - is_commit = False - value, _ = self._git_revparse_commit(ref) - if value == 0: - is_commit = True - return is_commit - - def _ref_is_hash(self, ref): - """Verify that a reference is a valid hash according to git. - - Git doesn't seem to provide an exact way to determine if user - supplied reference is an actual hash. So we verify that the - ref is a valid commit and return the underlying commit - hash. Then check that the commit hash begins with the user - supplied string. - - Note: values returned by git_showref_* and git_revparse are - shell return codes, which are zero for success, non-zero for - error! - - """ - is_hash = False - status, git_output = self._git_revparse_commit(ref) - if status == 0: - if git_output.strip().startswith(ref): - is_hash = True - return is_hash - - def _status_summary(self, stat, repo_dir_path): - """Determine the clean/dirty status of a git repository - - """ - cwd = os.getcwd() - os.chdir(repo_dir_path) - git_output = self._git_status_porcelain_v1z() - is_dirty = self._status_v1z_is_dirty(git_output) - if is_dirty: - stat.clean_state = ExternalStatus.DIRTY - else: - stat.clean_state = ExternalStatus.STATUS_OK - - # Now save the verbose status output incase the user wants to - # see it. - stat.status_output = self._git_status_verbose() - os.chdir(cwd) - - @staticmethod - def _status_v1z_is_dirty(git_output): - """Parse the git status output from --porcelain=v1 -z and determine if - the repo status is clean or dirty. Dirty means: - - * modified files - * missing files - * added files - * removed - * renamed - * unmerged - - Whether untracked files are considered depends on how the status - command was run (i.e., whether it was run with the '-u' option). - - NOTE: Based on the above definition, the porcelain status - should be an empty string to be considered 'clean'. Of course - this assumes we only get an empty string from an status - command on a clean checkout, and not some error - condition... Could alse use 'git diff --quiet'. - - """ - is_dirty = False - if git_output: - is_dirty = True - return is_dirty - - # ---------------------------------------------------------------- - # - # system call to git for information gathering - # - # ---------------------------------------------------------------- - @staticmethod - def _git_current_hash(): - """Return the full hash of the currently checked-out version. - - Returns a tuple, (hash_found, hash), where hash_found is a - logical specifying whether a hash was found for HEAD (False - could mean we're not in a git repository at all). (If hash_found - is False, then hash is ''.) - """ - status, git_output = GitRepository._git_revparse_commit("HEAD") - hash_found = not status - if not hash_found: - git_output = '' - return hash_found, git_output - - @staticmethod - def _git_current_branch(): - """Determines the name of the current branch. - - Returns a tuple, (branch_found, branch_name), where branch_found - is a logical specifying whether a branch name was found for - HEAD. (If branch_found is False, then branch_name is ''.) - """ - cmd = ['git', 'symbolic-ref', '--short', '-q', 'HEAD'] - status, git_output = execute_subprocess(cmd, - output_to_caller=True, - status_to_caller=True) - branch_found = not status - if branch_found: - git_output = git_output.strip() - else: - git_output = '' - return branch_found, git_output - - @staticmethod - def _git_current_tag(): - """Determines the name tag corresponding to HEAD (if any). - - Returns a tuple, (tag_found, tag_name), where tag_found is a - logical specifying whether we found a tag name corresponding to - HEAD. (If tag_found is False, then tag_name is ''.) - """ - # git describe --exact-match --tags HEAD - cmd = ['git', 'describe', '--exact-match', '--tags', 'HEAD'] - status, git_output = execute_subprocess(cmd, - output_to_caller=True, - status_to_caller=True) - tag_found = not status - if tag_found: - git_output = git_output.strip() - else: - git_output = '' - return tag_found, git_output - - @staticmethod - def _git_showref_tag(ref): - """Run git show-ref check if the user supplied ref is a tag. - - could also use git rev-parse --quiet --verify tagname^{tag} - """ - cmd = ['git', 'show-ref', '--quiet', '--verify', - 'refs/tags/{0}'.format(ref), ] - status = execute_subprocess(cmd, status_to_caller=True) - return status - - @staticmethod - def _git_showref_branch(ref): - """Run git show-ref check if the user supplied ref is a local or - tracked remote branch. - - """ - cmd = ['git', 'show-ref', '--quiet', '--verify', - 'refs/heads/{0}'.format(ref), ] - status = execute_subprocess(cmd, status_to_caller=True) - return status - - @staticmethod - def _git_lsremote_branch(ref, remote_name): - """Run git ls-remote to check if the user supplied ref is a remote - branch that is not being tracked - - """ - cmd = ['git', 'ls-remote', '--exit-code', '--heads', - remote_name, ref, ] - status = execute_subprocess(cmd, status_to_caller=True) - return status - - @staticmethod - def _git_revparse_commit(ref): - """Run git rev-parse to detect if a reference is a SHA, HEAD or other - valid commit. - - """ - cmd = ['git', 'rev-parse', '--quiet', '--verify', - '{0}^{1}'.format(ref, '{commit}'), ] - status, git_output = execute_subprocess(cmd, status_to_caller=True, - output_to_caller=True) - git_output = git_output.strip() - return status, git_output - - @staticmethod - def _git_status_porcelain_v1z(): - """Run git status to obtain repository information. - - This is run with '--untracked=no' to ignore untracked files. - - The machine-portable format that is guaranteed not to change - between git versions or *user configuration*. - - """ - cmd = ['git', 'status', '--untracked-files=no', '--porcelain', '-z'] - git_output = execute_subprocess(cmd, output_to_caller=True) - return git_output - - @staticmethod - def _git_status_verbose(): - """Run the git status command to obtain repository information. - """ - cmd = ['git', 'status'] - git_output = execute_subprocess(cmd, output_to_caller=True) - return git_output - - @staticmethod - def _git_remote_verbose(): - """Run the git remote command to obtain repository information. - """ - cmd = ['git', 'remote', '--verbose'] - git_output = execute_subprocess(cmd, output_to_caller=True) - return git_output - - @staticmethod - def has_submodules(repo_dir_path=None): - """Return True iff the repository at (or the current - directory if is None) has a '.gitmodules' file - """ - if repo_dir_path is None: - fname = ExternalsDescription.GIT_SUBMODULES_FILENAME - else: - fname = os.path.join(repo_dir_path, - ExternalsDescription.GIT_SUBMODULES_FILENAME) - - return os.path.exists(fname) - - # ---------------------------------------------------------------- - # - # system call to git for sideffects modifying the working tree - # - # ---------------------------------------------------------------- - @staticmethod - def _git_clone(url, repo_dir_name, verbosity): - """Run git clone for the side effect of creating a repository. - """ - cmd = ['git', 'clone', '--quiet'] - subcmd = None - - cmd.extend([url, repo_dir_name]) - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) - if subcmd is not None: - os.chdir(repo_dir_name) - execute_subprocess(subcmd) - - @staticmethod - def _git_remote_add(name, url): - """Run the git remote command for the side effect of adding a remote - """ - cmd = ['git', 'remote', 'add', name, url] - execute_subprocess(cmd) - - @staticmethod - def _git_fetch(remote_name): - """Run the git fetch command for the side effect of updating the repo - """ - cmd = ['git', 'fetch', '--quiet', '--tags', remote_name] - execute_subprocess(cmd) - - @staticmethod - def _git_checkout_ref(ref, verbosity, submodules): - """Run the git checkout command for the side effect of updating the repo - - Param: ref is a reference to a local or remote object in the - form 'origin/my_feature', or 'tag1'. - - """ - cmd = ['git', 'checkout', '--quiet', ref] - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) - if submodules: - GitRepository._git_update_submodules(verbosity) - - @staticmethod - def _git_sparse_checkout(verbosity): - """Configure repo via read-tree.""" - cmd = ['git', 'config', 'core.sparsecheckout', 'true'] - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) - cmd = ['git', 'read-tree', '-mu', 'HEAD'] - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) - - @staticmethod - def _git_update_submodules(verbosity): - """Run git submodule update for the side effect of updating this - repo's submodules. - """ - # First, verify that we have a .gitmodules file - if os.path.exists(ExternalsDescription.GIT_SUBMODULES_FILENAME): - cmd = ['git', 'submodule', 'update', '--init', '--recursive'] - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - - execute_subprocess(cmd) diff --git a/manage_externals/manic/repository_svn.py b/manage_externals/manic/repository_svn.py deleted file mode 100644 index 408ed84676..0000000000 --- a/manage_externals/manic/repository_svn.py +++ /dev/null @@ -1,283 +0,0 @@ -"""Class for interacting with svn repositories -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import os -import re -import xml.etree.ElementTree as ET - -from .global_constants import EMPTY_STR, VERBOSITY_VERBOSE -from .repository import Repository -from .externals_status import ExternalStatus -from .utils import fatal_error, indent_string, printlog -from .utils import execute_subprocess - - -class SvnRepository(Repository): - """ - Class to represent and operate on a repository description. - - For testing purpose, all system calls to svn should: - - * be isolated in separate functions with no application logic - * of the form: - - cmd = ['svn', ...] - - value = execute_subprocess(cmd, output_to_caller={T|F}, - status_to_caller={T|F}) - - return value - * be static methods (not rely on self) - * name as _svn_subcommand_args(user_args) - - This convention allows easy unit testing of the repository logic - by mocking the specific calls to return predefined results. - - """ - RE_URLLINE = re.compile(r'^URL:') - - def __init__(self, component_name, repo, ignore_ancestry=False): - """ - Parse repo (a XML element). - """ - Repository.__init__(self, component_name, repo) - self._ignore_ancestry = ignore_ancestry - if self._branch: - self._url = os.path.join(self._url, self._branch) - elif self._tag: - self._url = os.path.join(self._url, self._tag) - else: - msg = "DEV_ERROR in svn repository. Shouldn't be here!" - fatal_error(msg) - - # ---------------------------------------------------------------- - # - # Public API, defined by Repository - # - # ---------------------------------------------------------------- - def checkout(self, base_dir_path, repo_dir_name, verbosity, recursive): # pylint: disable=unused-argument - """Checkout or update the working copy - - If the repo destination directory exists, switch the sandbox to - match the externals description. - - If the repo destination directory does not exist, checkout the - correct branch or tag. - NB: is include as an argument for compatibility with - git functionality (repository_git.py) - - """ - repo_dir_path = os.path.join(base_dir_path, repo_dir_name) - if os.path.exists(repo_dir_path): - cwd = os.getcwd() - os.chdir(repo_dir_path) - self._svn_switch(self._url, self._ignore_ancestry, verbosity) - # svn switch can lead to a conflict state, but it gives a - # return code of 0. So now we need to make sure that we're - # in a clean (non-conflict) state. - self._abort_if_dirty(repo_dir_path, - "Expected clean state following switch") - os.chdir(cwd) - else: - self._svn_checkout(self._url, repo_dir_path, verbosity) - - def status(self, stat, repo_dir_path): - """ - Check and report the status of the repository - """ - self._check_sync(stat, repo_dir_path) - if os.path.exists(repo_dir_path): - self._status_summary(stat, repo_dir_path) - - # ---------------------------------------------------------------- - # - # Internal work functions - # - # ---------------------------------------------------------------- - def _check_sync(self, stat, repo_dir_path): - """Check to see if repository directory exists and is at the expected - url. Return: status object - - """ - if not os.path.exists(repo_dir_path): - # NOTE(bja, 2017-10) this state should have been handled by - # the source object and we never get here! - stat.sync_state = ExternalStatus.STATUS_ERROR - else: - svn_output = self._svn_info(repo_dir_path) - if not svn_output: - # directory exists, but info returned nothing. .svn - # directory removed or incomplete checkout? - stat.sync_state = ExternalStatus.UNKNOWN - else: - stat.sync_state, stat.current_version = \ - self._check_url(svn_output, self._url) - stat.expected_version = '/'.join(self._url.split('/')[3:]) - - def _abort_if_dirty(self, repo_dir_path, message): - """Check if the repo is in a dirty state; if so, abort with a - helpful message. - - """ - - stat = ExternalStatus() - self._status_summary(stat, repo_dir_path) - if stat.clean_state != ExternalStatus.STATUS_OK: - status = self._svn_status_verbose(repo_dir_path) - status = indent_string(status, 4) - errmsg = """In directory - {cwd} - -svn status now shows: -{status} - -ERROR: {message} - -One possible cause of this problem is that there may have been untracked -files in your working directory that had the same name as tracked files -in the new revision. - -To recover: Clean up the above directory (resolving conflicts, etc.), -then rerun checkout_externals. -""".format(cwd=repo_dir_path, message=message, status=status) - - fatal_error(errmsg) - - @staticmethod - def _check_url(svn_output, expected_url): - """Determine the svn url from svn info output and return whether it - matches the expected value. - - """ - url = None - for line in svn_output.splitlines(): - if SvnRepository.RE_URLLINE.match(line): - url = line.split(': ')[1].strip() - break - if not url: - status = ExternalStatus.UNKNOWN - elif url == expected_url: - status = ExternalStatus.STATUS_OK - else: - status = ExternalStatus.MODEL_MODIFIED - - if url: - current_version = '/'.join(url.split('/')[3:]) - else: - current_version = EMPTY_STR - - return status, current_version - - def _status_summary(self, stat, repo_dir_path): - """Report whether the svn repository is in-sync with the model - description and whether the sandbox is clean or dirty. - - """ - svn_output = self._svn_status_xml(repo_dir_path) - is_dirty = self.xml_status_is_dirty(svn_output) - if is_dirty: - stat.clean_state = ExternalStatus.DIRTY - else: - stat.clean_state = ExternalStatus.STATUS_OK - - # Now save the verbose status output incase the user wants to - # see it. - stat.status_output = self._svn_status_verbose(repo_dir_path) - - @staticmethod - def xml_status_is_dirty(svn_output): - """Parse svn status xml output and determine if the working copy is - clean or dirty. Dirty is defined as: - - * modified files - * added files - * deleted files - * missing files - - Unversioned files do not affect the clean/dirty status. - - 'external' is also an acceptable state - - """ - # pylint: disable=invalid-name - SVN_EXTERNAL = 'external' - SVN_UNVERSIONED = 'unversioned' - # pylint: enable=invalid-name - - is_dirty = False - try: - xml_status = ET.fromstring(svn_output) - except BaseException: - fatal_error( - "SVN returned invalid XML message {}".format(svn_output)) - xml_target = xml_status.find('./target') - entries = xml_target.findall('./entry') - for entry in entries: - status = entry.find('./wc-status') - item = status.get('item') - if item == SVN_EXTERNAL: - continue - if item == SVN_UNVERSIONED: - continue - is_dirty = True - break - return is_dirty - - # ---------------------------------------------------------------- - # - # system call to svn for information gathering - # - # ---------------------------------------------------------------- - @staticmethod - def _svn_info(repo_dir_path): - """Return results of svn info command - """ - cmd = ['svn', 'info', repo_dir_path] - output = execute_subprocess(cmd, output_to_caller=True) - return output - - @staticmethod - def _svn_status_verbose(repo_dir_path): - """capture the full svn status output - """ - cmd = ['svn', 'status', repo_dir_path] - svn_output = execute_subprocess(cmd, output_to_caller=True) - return svn_output - - @staticmethod - def _svn_status_xml(repo_dir_path): - """ - Get status of the subversion sandbox in repo_dir - """ - cmd = ['svn', 'status', '--xml', repo_dir_path] - svn_output = execute_subprocess(cmd, output_to_caller=True) - return svn_output - - # ---------------------------------------------------------------- - # - # system call to svn for sideffects modifying the working tree - # - # ---------------------------------------------------------------- - @staticmethod - def _svn_checkout(url, repo_dir_path, verbosity): - """ - Checkout a subversion repository (repo_url) to checkout_dir. - """ - cmd = ['svn', 'checkout', '--quiet', url, repo_dir_path] - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) - - @staticmethod - def _svn_switch(url, ignore_ancestry, verbosity): - """ - Switch branches for in an svn sandbox - """ - cmd = ['svn', 'switch', '--quiet'] - if ignore_ancestry: - cmd.append('--ignore-ancestry') - cmd.append(url) - if verbosity >= VERBOSITY_VERBOSE: - printlog(' {0}'.format(' '.join(cmd))) - execute_subprocess(cmd) diff --git a/manage_externals/manic/sourcetree.py b/manage_externals/manic/sourcetree.py deleted file mode 100644 index b9c9c21082..0000000000 --- a/manage_externals/manic/sourcetree.py +++ /dev/null @@ -1,353 +0,0 @@ -""" - -FIXME(bja, 2017-11) External and SourceTree have a circular dependancy! -""" - -import errno -import logging -import os - -from .externals_description import ExternalsDescription -from .externals_description import read_externals_description_file -from .externals_description import create_externals_description -from .repository_factory import create_repository -from .repository_git import GitRepository -from .externals_status import ExternalStatus -from .utils import fatal_error, printlog -from .global_constants import EMPTY_STR, LOCAL_PATH_INDICATOR -from .global_constants import VERBOSITY_VERBOSE - -class _External(object): - """ - _External represents an external object inside a SourceTree - """ - - # pylint: disable=R0902 - - def __init__(self, root_dir, name, ext_description, svn_ignore_ancestry): - """Parse an external description file into a dictionary of externals. - - Input: - - root_dir : string - the root directory path where - 'local_path' is relative to. - - name : string - name of the ext_description object. may or may not - correspond to something in the path. - - ext_description : dict - source ExternalsDescription object - - svn_ignore_ancestry : bool - use --ignore-externals with svn switch - - """ - self._name = name - self._repo = None - self._externals = EMPTY_STR - self._externals_sourcetree = None - self._stat = ExternalStatus() - self._sparse = None - # Parse the sub-elements - - # _path : local path relative to the containing source tree - self._local_path = ext_description[ExternalsDescription.PATH] - # _repo_dir : full repository directory - repo_dir = os.path.join(root_dir, self._local_path) - self._repo_dir_path = os.path.abspath(repo_dir) - # _base_dir : base directory *containing* the repository - self._base_dir_path = os.path.dirname(self._repo_dir_path) - # repo_dir_name : base_dir_path + repo_dir_name = rep_dir_path - self._repo_dir_name = os.path.basename(self._repo_dir_path) - assert(os.path.join(self._base_dir_path, self._repo_dir_name) - == self._repo_dir_path) - - self._required = ext_description[ExternalsDescription.REQUIRED] - self._externals = ext_description[ExternalsDescription.EXTERNALS] - # Treat a .gitmodules file as a backup externals config - if not self._externals: - if GitRepository.has_submodules(self._repo_dir_path): - self._externals = ExternalsDescription.GIT_SUBMODULES_FILENAME - - repo = create_repository( - name, ext_description[ExternalsDescription.REPO], - svn_ignore_ancestry=svn_ignore_ancestry) - if repo: - self._repo = repo - - if self._externals and (self._externals.lower() != 'none'): - self._create_externals_sourcetree() - - def get_name(self): - """ - Return the external object's name - """ - return self._name - - def get_local_path(self): - """ - Return the external object's path - """ - return self._local_path - - def status(self): - """ - If the repo destination directory exists, ensure it is correct (from - correct URL, correct branch or tag), and possibly update the external. - If the repo destination directory does not exist, checkout the correce - branch or tag. - If load_all is True, also load all of the the externals sub-externals. - """ - - self._stat.path = self.get_local_path() - if not self._required: - self._stat.source_type = ExternalStatus.OPTIONAL - elif self._local_path == LOCAL_PATH_INDICATOR: - # LOCAL_PATH_INDICATOR, '.' paths, are standalone - # component directories that are not managed by - # checkout_externals. - self._stat.source_type = ExternalStatus.STANDALONE - else: - # managed by checkout_externals - self._stat.source_type = ExternalStatus.MANAGED - - ext_stats = {} - - if not os.path.exists(self._repo_dir_path): - self._stat.sync_state = ExternalStatus.EMPTY - msg = ('status check: repository directory for "{0}" does not ' - 'exist.'.format(self._name)) - logging.info(msg) - self._stat.current_version = 'not checked out' - # NOTE(bja, 2018-01) directory doesn't exist, so we cannot - # use repo to determine the expected version. We just take - # a best-guess based on the assumption that only tag or - # branch should be set, but not both. - if not self._repo: - self._stat.expected_version = 'unknown' - else: - self._stat.expected_version = self._repo.tag() + self._repo.branch() - else: - if self._repo: - self._repo.status(self._stat, self._repo_dir_path) - - if self._externals and self._externals_sourcetree: - # we expect externals and they exist - cwd = os.getcwd() - # SourceTree expects to be called from the correct - # root directory. - os.chdir(self._repo_dir_path) - ext_stats = self._externals_sourcetree.status(self._local_path) - os.chdir(cwd) - - all_stats = {} - # don't add the root component because we don't manage it - # and can't provide useful info about it. - if self._local_path != LOCAL_PATH_INDICATOR: - # store the stats under tha local_path, not comp name so - # it will be sorted correctly - all_stats[self._stat.path] = self._stat - - if ext_stats: - all_stats.update(ext_stats) - - return all_stats - - def checkout(self, verbosity, load_all): - """ - If the repo destination directory exists, ensure it is correct (from - correct URL, correct branch or tag), and possibly update the external. - If the repo destination directory does not exist, checkout the correct - branch or tag. - If load_all is True, also load all of the the externals sub-externals. - """ - if load_all: - pass - # Make sure we are in correct location - - if not os.path.exists(self._repo_dir_path): - # repository directory doesn't exist. Need to check it - # out, and for that we need the base_dir_path to exist - try: - os.makedirs(self._base_dir_path) - except OSError as error: - if error.errno != errno.EEXIST: - msg = 'Could not create directory "{0}"'.format( - self._base_dir_path) - fatal_error(msg) - - if self._stat.source_type != ExternalStatus.STANDALONE: - if verbosity >= VERBOSITY_VERBOSE: - # NOTE(bja, 2018-01) probably do not want to pass - # verbosity in this case, because if (verbosity == - # VERBOSITY_DUMP), then the previous status output would - # also be dumped, adding noise to the output. - self._stat.log_status_message(VERBOSITY_VERBOSE) - - if self._repo: - if self._stat.sync_state == ExternalStatus.STATUS_OK: - # If we're already in sync, avoid showing verbose output - # from the checkout command, unless the verbosity level - # is 2 or more. - checkout_verbosity = verbosity - 1 - else: - checkout_verbosity = verbosity - - self._repo.checkout(self._base_dir_path, self._repo_dir_name, - checkout_verbosity, self.clone_recursive()) - - def checkout_externals(self, verbosity, load_all): - """Checkout the sub-externals for this object - """ - if self.load_externals(): - if self._externals_sourcetree: - # NOTE(bja, 2018-02): the subtree externals objects - # were created during initial status check. Updating - # the external may have changed which sub-externals - # are needed. We need to delete those objects and - # re-read the potentially modified externals - # description file. - self._externals_sourcetree = None - self._create_externals_sourcetree() - self._externals_sourcetree.checkout(verbosity, load_all) - - def load_externals(self): - 'Return True iff an externals file should be loaded' - load_ex = False - if os.path.exists(self._repo_dir_path): - if self._externals: - if self._externals.lower() != 'none': - load_ex = os.path.exists(os.path.join(self._repo_dir_path, - self._externals)) - - return load_ex - - def clone_recursive(self): - 'Return True iff any .gitmodules files should be processed' - # Try recursive unless there is an externals entry - recursive = not self._externals - - return recursive - - def _create_externals_sourcetree(self): - """ - """ - if not os.path.exists(self._repo_dir_path): - # NOTE(bja, 2017-10) repository has not been checked out - # yet, can't process the externals file. Assume we are - # checking status before code is checkoud out and this - # will be handled correctly later. - return - - cwd = os.getcwd() - os.chdir(self._repo_dir_path) - if self._externals.lower() == 'none': - msg = ('Internal: Attempt to create source tree for ' - 'externals = none in {}'.format(self._repo_dir_path)) - fatal_error(msg) - - if not os.path.exists(self._externals): - if GitRepository.has_submodules(): - self._externals = ExternalsDescription.GIT_SUBMODULES_FILENAME - - if not os.path.exists(self._externals): - # NOTE(bja, 2017-10) this check is redundent with the one - # in read_externals_description_file! - msg = ('External externals description file "{0}" ' - 'does not exist! In directory: {1}'.format( - self._externals, self._repo_dir_path)) - fatal_error(msg) - - externals_root = self._repo_dir_path - model_data = read_externals_description_file(externals_root, - self._externals) - externals = create_externals_description(model_data, - parent_repo=self._repo) - self._externals_sourcetree = SourceTree(externals_root, externals) - os.chdir(cwd) - -class SourceTree(object): - """ - SourceTree represents a group of managed externals - """ - - def __init__(self, root_dir, model, svn_ignore_ancestry=False): - """ - Build a SourceTree object from a model description - """ - self._root_dir = os.path.abspath(root_dir) - self._all_components = {} - self._required_compnames = [] - for comp in model: - src = _External(self._root_dir, comp, model[comp], svn_ignore_ancestry) - self._all_components[comp] = src - if model[comp][ExternalsDescription.REQUIRED]: - self._required_compnames.append(comp) - - def status(self, relative_path_base=LOCAL_PATH_INDICATOR): - """Report the status components - - FIXME(bja, 2017-10) what do we do about situations where the - user checked out the optional components, but didn't add - optional for running status? What do we do where the user - didn't add optional to the checkout but did add it to the - status. -- For now, we run status on all components, and try - to do the right thing based on the results.... - - """ - load_comps = self._all_components.keys() - - summary = {} - for comp in load_comps: - printlog('{0}, '.format(comp), end='') - stat = self._all_components[comp].status() - stat_final = {} - for name in stat.keys(): - # check if we need to append the relative_path_base to - # the path so it will be sorted in the correct order. - if stat[name].path.startswith(relative_path_base): - # use as is, without any changes to path - stat_final[name] = stat[name] - else: - # append relative_path_base to path and store under key = updated path - modified_path = os.path.join(relative_path_base, - stat[name].path) - stat_final[modified_path] = stat[name] - stat_final[modified_path].path = modified_path - summary.update(stat_final) - - return summary - - def checkout(self, verbosity, load_all, load_comp=None): - """ - Checkout or update indicated components into the the configured - subdirs. - - If load_all is True, recursively checkout all externals. - If load_all is False, load_comp is an optional set of components to load. - If load_all is True and load_comp is None, only load the required externals. - """ - if verbosity >= VERBOSITY_VERBOSE: - printlog('Checking out externals: ') - else: - printlog('Checking out externals: ', end='') - - if load_all: - load_comps = self._all_components.keys() - elif load_comp is not None: - load_comps = [load_comp] - else: - load_comps = self._required_compnames - - # checkout the primary externals - for comp in load_comps: - if verbosity < VERBOSITY_VERBOSE: - printlog('{0}, '.format(comp), end='') - else: - # verbose output handled by the _External object, just - # output a newline - printlog(EMPTY_STR) - self._all_components[comp].checkout(verbosity, load_all) - printlog('') - - # now give each external an opportunitity to checkout it's externals. - for comp in load_comps: - self._all_components[comp].checkout_externals(verbosity, load_all) diff --git a/manage_externals/manic/utils.py b/manage_externals/manic/utils.py deleted file mode 100644 index f57f43930c..0000000000 --- a/manage_externals/manic/utils.py +++ /dev/null @@ -1,330 +0,0 @@ -#!/usr/bin/env python -""" -Common public utilities for manic package - -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import logging -import os -import subprocess -import sys -from threading import Timer - -from .global_constants import LOCAL_PATH_INDICATOR - -# --------------------------------------------------------------------- -# -# screen and logging output and functions to massage text for output -# -# --------------------------------------------------------------------- - - -def log_process_output(output): - """Log each line of process output at debug level so it can be - filtered if necessary. By default, output is a single string, and - logging.debug(output) will only put log info heading on the first - line. This makes it hard to filter with grep. - - """ - output = output.split('\n') - for line in output: - logging.debug(line) - - -def printlog(msg, **kwargs): - """Wrapper script around print to ensure that everything printed to - the screen also gets logged. - - """ - logging.info(msg) - if kwargs: - print(msg, **kwargs) - else: - print(msg) - sys.stdout.flush() - - -def last_n_lines(the_string, n_lines, truncation_message=None): - """Returns the last n lines of the given string - - Args: - the_string: str - n_lines: int - truncation_message: str, optional - - Returns a string containing the last n lines of the_string - - If truncation_message is provided, the returned string begins with - the given message if and only if the string is greater than n lines - to begin with. - """ - - lines = the_string.splitlines(True) - if len(lines) <= n_lines: - return_val = the_string - else: - lines_subset = lines[-n_lines:] - str_truncated = ''.join(lines_subset) - if truncation_message: - str_truncated = truncation_message + '\n' + str_truncated - return_val = str_truncated - - return return_val - - -def indent_string(the_string, indent_level): - """Indents the given string by a given number of spaces - - Args: - the_string: str - indent_level: int - - Returns a new string that is the same as the_string, except that - each line is indented by 'indent_level' spaces. - - In python3, this can be done with textwrap.indent. - """ - - lines = the_string.splitlines(True) - padding = ' ' * indent_level - lines_indented = [padding + line for line in lines] - return ''.join(lines_indented) - -# --------------------------------------------------------------------- -# -# error handling -# -# --------------------------------------------------------------------- - - -def fatal_error(message): - """ - Error output function - """ - logging.error(message) - raise RuntimeError("{0}ERROR: {1}".format(os.linesep, message)) - - -# --------------------------------------------------------------------- -# -# Data conversion / manipulation -# -# --------------------------------------------------------------------- -def str_to_bool(bool_str): - """Convert a sting representation of as boolean into a true boolean. - - Conversion should be case insensitive. - """ - value = None - str_lower = bool_str.lower() - if str_lower in ('true', 't'): - value = True - elif str_lower in ('false', 'f'): - value = False - if value is None: - msg = ('ERROR: invalid boolean string value "{0}". ' - 'Must be "true" or "false"'.format(bool_str)) - fatal_error(msg) - return value - - -REMOTE_PREFIXES = ['http://', 'https://', 'ssh://', 'git@'] - - -def is_remote_url(url): - """check if the user provided a local file path instead of a - remote. If so, it must be expanded to an absolute - path. - - """ - remote_url = False - for prefix in REMOTE_PREFIXES: - if url.startswith(prefix): - remote_url = True - return remote_url - - -def split_remote_url(url): - """check if the user provided a local file path or a - remote. If remote, try to strip off protocol info. - - """ - remote_url = is_remote_url(url) - if not remote_url: - return url - - for prefix in REMOTE_PREFIXES: - url = url.replace(prefix, '') - - if '@' in url: - url = url.split('@')[1] - - if ':' in url: - url = url.split(':')[1] - - return url - - -def expand_local_url(url, field): - """check if the user provided a local file path instead of a - remote. If so, it must be expanded to an absolute - path. - - Note: local paths of LOCAL_PATH_INDICATOR have special meaning and - represent local copy only, don't work with the remotes. - - """ - remote_url = is_remote_url(url) - if not remote_url: - if url.strip() == LOCAL_PATH_INDICATOR: - pass - else: - url = os.path.expandvars(url) - url = os.path.expanduser(url) - if not os.path.isabs(url): - msg = ('WARNING: Externals description for "{0}" contains a ' - 'url that is not remote and does not expand to an ' - 'absolute path. Version control operations may ' - 'fail.\n\nurl={1}'.format(field, url)) - printlog(msg) - else: - url = os.path.normpath(url) - return url - - -# --------------------------------------------------------------------- -# -# subprocess -# -# --------------------------------------------------------------------- - -# Give the user a helpful message if we detect that a command seems to -# be hanging. -_HANGING_SEC = 300 - - -def _hanging_msg(working_directory, command): - print(""" - -Command '{command}' -from directory {working_directory} -has taken {hanging_sec} seconds. It may be hanging. - -The command will continue to run, but you may want to abort -manage_externals with ^C and investigate. A possible cause of hangs is -when svn or git require authentication to access a private -repository. On some systems, svn and git requests for authentication -information will not be displayed to the user. In this case, the program -will appear to hang. Ensure you can run svn and git manually and access -all repositories without entering your authentication information. - -""".format(command=command, - working_directory=working_directory, - hanging_sec=_HANGING_SEC)) - - -def execute_subprocess(commands, status_to_caller=False, - output_to_caller=False): - """Wrapper around subprocess.check_output to handle common - exceptions. - - check_output runs a command with arguments and waits - for it to complete. - - check_output raises an exception on a nonzero return code. if - status_to_caller is true, execute_subprocess returns the subprocess - return code, otherwise execute_subprocess treats non-zero return - status as an error and raises an exception. - - """ - cwd = os.getcwd() - msg = 'In directory: {0}\nexecute_subprocess running command:'.format(cwd) - logging.info(msg) - commands_str = ' '.join(commands) - logging.info(commands_str) - return_to_caller = status_to_caller or output_to_caller - status = -1 - output = '' - hanging_timer = Timer(_HANGING_SEC, _hanging_msg, - kwargs={"working_directory": cwd, - "command": commands_str}) - hanging_timer.start() - try: - output = subprocess.check_output(commands, stderr=subprocess.STDOUT, - universal_newlines=True) - log_process_output(output) - status = 0 - except OSError as error: - msg = failed_command_msg( - 'Command execution failed. Does the executable exist?', - commands) - logging.error(error) - fatal_error(msg) - except ValueError as error: - msg = failed_command_msg( - 'DEV_ERROR: Invalid arguments trying to run subprocess', - commands) - logging.error(error) - fatal_error(msg) - except subprocess.CalledProcessError as error: - # Only report the error if we are NOT returning to the - # caller. If we are returning to the caller, then it may be a - # simple status check. If returning, it is the callers - # responsibility determine if an error occurred and handle it - # appropriately. - if not return_to_caller: - msg_context = ('Process did not run successfully; ' - 'returned status {0}'.format(error.returncode)) - msg = failed_command_msg(msg_context, commands, - output=error.output) - logging.error(error) - logging.error(msg) - log_process_output(error.output) - fatal_error(msg) - status = error.returncode - finally: - hanging_timer.cancel() - - if status_to_caller and output_to_caller: - ret_value = (status, output) - elif status_to_caller: - ret_value = status - elif output_to_caller: - ret_value = output - else: - ret_value = None - - return ret_value - - -def failed_command_msg(msg_context, command, output=None): - """Template for consistent error messages from subprocess calls. - - If 'output' is given, it should provide the output from the failed - command - """ - - if output: - output_truncated = last_n_lines(output, 20, - truncation_message='[... Output truncated for brevity ...]') - errmsg = ('Failed with output:\n' + - indent_string(output_truncated, 4) + - '\nERROR: ') - else: - errmsg = '' - - command_str = ' '.join(command) - errmsg += """In directory - {cwd} -{context}: - {command} -""".format(cwd=os.getcwd(), context=msg_context, command=command_str) - - if output: - errmsg += 'See above for output from failed command.\n' - - return errmsg diff --git a/manage_externals/test/.coveragerc b/manage_externals/test/.coveragerc deleted file mode 100644 index 8b681888b8..0000000000 --- a/manage_externals/test/.coveragerc +++ /dev/null @@ -1,7 +0,0 @@ -[run] -branch = True -omit = test_unit_*.py - test_sys_*.py - /usr/* - .local/* - */site-packages/* \ No newline at end of file diff --git a/manage_externals/test/.gitignore b/manage_externals/test/.gitignore deleted file mode 100644 index dd5795998f..0000000000 --- a/manage_externals/test/.gitignore +++ /dev/null @@ -1,7 +0,0 @@ -# virtual environments -env_python* - -# python code coverage tool output -.coverage -htmlcov - diff --git a/manage_externals/test/.pylint.rc b/manage_externals/test/.pylint.rc deleted file mode 100644 index 64abd03e42..0000000000 --- a/manage_externals/test/.pylint.rc +++ /dev/null @@ -1,426 +0,0 @@ -[MASTER] - -# A comma-separated list of package or module names from where C extensions may -# be loaded. Extensions are loading into the active Python interpreter and may -# run arbitrary code -extension-pkg-whitelist= - -# Add files or directories to the blacklist. They should be base names, not -# paths. -ignore=.git,.svn,env2 - -# Add files or directories matching the regex patterns to the blacklist. The -# regex matches against base names, not paths. -ignore-patterns= - -# Python code to execute, usually for sys.path manipulation such as -# pygtk.require(). -#init-hook= - -# Use multiple processes to speed up Pylint. -jobs=1 - -# List of plugins (as comma separated values of python modules names) to load, -# usually to register additional checkers. -load-plugins= - -# Pickle collected data for later comparisons. -persistent=yes - -# Specify a configuration file. -#rcfile= - -# Allow loading of arbitrary C extensions. Extensions are imported into the -# active Python interpreter and may run arbitrary code. -unsafe-load-any-extension=no - - -[MESSAGES CONTROL] - -# Only show warnings with the listed confidence levels. Leave empty to show -# all. Valid levels: HIGH, INFERENCE, INFERENCE_FAILURE, UNDEFINED -confidence= - -# Disable the message, report, category or checker with the given id(s). You -# can either give multiple identifiers separated by comma (,) or put this -# option multiple times (only on the command line, not in the configuration -# file where it should appear only once).You can also use "--disable=all" to -# disable everything first and then reenable specific checks. For example, if -# you want to run only the similarities checker, you can use "--disable=all -# --enable=similarities". If you want to run only the classes checker, but have -# no Warning level messages displayed, use"--disable=all --enable=classes -# --disable=W" -disable=bad-continuation,useless-object-inheritance - - -# Enable the message, report, category or checker with the given id(s). You can -# either give multiple identifier separated by comma (,) or put this option -# multiple time (only on the command line, not in the configuration file where -# it should appear only once). See also the "--disable" option for examples. -enable= - - -[REPORTS] - -# Python expression which should return a note less than 10 (10 is the highest -# note). You have access to the variables errors warning, statement which -# respectively contain the number of errors / warnings messages and the total -# number of statements analyzed. This is used by the global evaluation report -# (RP0004). -evaluation=10.0 - ((float(5 * error + warning + refactor + convention) / statement) * 10) - -# Template used to display messages. This is a python new-style format string -# used to format the message information. See doc for all details -msg-template={msg_id}:{line:3d},{column:2d}: {msg} ({symbol}) - -# Set the output format. Available formats are text, parseable, colorized, json -# and msvs (visual studio).You can also give a reporter class, eg -# mypackage.mymodule.MyReporterClass. -output-format=text - -# Tells whether to display a full report or only the messages -#reports=yes - -# Activate the evaluation score. -score=yes - - -[REFACTORING] - -# Maximum number of nested blocks for function / method body -max-nested-blocks=5 - - -[BASIC] - -# Naming hint for argument names -argument-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Regular expression matching correct argument names -argument-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Naming hint for attribute names -attr-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Regular expression matching correct attribute names -attr-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Bad variable names which should always be refused, separated by a comma -bad-names=foo,bar,baz,toto,tutu,tata - -# Naming hint for class attribute names -class-attribute-name-hint=([A-Za-z_][A-Za-z0-9_]{2,30}|(__.*__))$ - -# Regular expression matching correct class attribute names -class-attribute-rgx=([A-Za-z_][A-Za-z0-9_]{2,30}|(__.*__))$ - -# Naming hint for class names -class-name-hint=[A-Z_][a-zA-Z0-9]+$ - -# Regular expression matching correct class names -class-rgx=[A-Z_][a-zA-Z0-9]+$ - -# Naming hint for constant names -const-name-hint=(([A-Z_][A-Z0-9_]*)|(__.*__))$ - -# Regular expression matching correct constant names -const-rgx=(([A-Z_][A-Z0-9_]*)|(__.*__))$ - -# Minimum line length for functions/classes that require docstrings, shorter -# ones are exempt. -docstring-min-length=-1 - -# Naming hint for function names -function-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Regular expression matching correct function names -function-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Good variable names which should always be accepted, separated by a comma -good-names=i,j,k,ex,Run,_ - -# Include a hint for the correct naming format with invalid-name -include-naming-hint=no - -# Naming hint for inline iteration names -inlinevar-name-hint=[A-Za-z_][A-Za-z0-9_]*$ - -# Regular expression matching correct inline iteration names -inlinevar-rgx=[A-Za-z_][A-Za-z0-9_]*$ - -# Naming hint for method names -method-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Regular expression matching correct method names -method-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Naming hint for module names -module-name-hint=(([a-z_][a-z0-9_]*)|([A-Z][a-zA-Z0-9]+))$ - -# Regular expression matching correct module names -module-rgx=(([a-z_][a-z0-9_]*)|([A-Z][a-zA-Z0-9]+))$ - -# Colon-delimited sets of names that determine each other's naming style when -# the name regexes allow several styles. -name-group= - -# Regular expression which should only match function or class names that do -# not require a docstring. -no-docstring-rgx=^_ - -# List of decorators that produce properties, such as abc.abstractproperty. Add -# to this list to register other decorators that produce valid properties. -property-classes=abc.abstractproperty - -# Naming hint for variable names -variable-name-hint=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - -# Regular expression matching correct variable names -variable-rgx=(([a-z][a-z0-9_]{2,30})|(_[a-z0-9_]*))$ - - -[FORMAT] - -# Expected format of line ending, e.g. empty (any line ending), LF or CRLF. -expected-line-ending-format= - -# Regexp for a line that is allowed to be longer than the limit. -ignore-long-lines=^\s*(# )??$ - -# Number of spaces of indent required inside a hanging or continued line. -indent-after-paren=4 - -# String used as indentation unit. This is usually " " (4 spaces) or "\t" (1 -# tab). -indent-string=' ' - -# Maximum number of characters on a single line. -max-line-length=100 - -# Maximum number of lines in a module -max-module-lines=1000 - -# List of optional constructs for which whitespace checking is disabled. `dict- -# separator` is used to allow tabulation in dicts, etc.: {1 : 1,\n222: 2}. -# `trailing-comma` allows a space between comma and closing bracket: (a, ). -# `empty-line` allows space-only lines. -no-space-check=trailing-comma,dict-separator - -# Allow the body of a class to be on the same line as the declaration if body -# contains single statement. -single-line-class-stmt=no - -# Allow the body of an if to be on the same line as the test if there is no -# else. -single-line-if-stmt=no - - -[LOGGING] - -# Logging modules to check that the string format arguments are in logging -# function parameter format -logging-modules=logging - - -[MISCELLANEOUS] - -# List of note tags to take in consideration, separated by a comma. -notes=FIXME,XXX,TODO - - -[SIMILARITIES] - -# Ignore comments when computing similarities. -ignore-comments=yes - -# Ignore docstrings when computing similarities. -ignore-docstrings=yes - -# Ignore imports when computing similarities. -ignore-imports=no - -# Minimum lines number of a similarity. -min-similarity-lines=4 - - -[SPELLING] - -# Spelling dictionary name. Available dictionaries: none. To make it working -# install python-enchant package. -spelling-dict= - -# List of comma separated words that should not be checked. -spelling-ignore-words= - -# A path to a file that contains private dictionary; one word per line. -spelling-private-dict-file= - -# Tells whether to store unknown words to indicated private dictionary in -# --spelling-private-dict-file option instead of raising a message. -spelling-store-unknown-words=no - - -[TYPECHECK] - -# List of decorators that produce context managers, such as -# contextlib.contextmanager. Add to this list to register other decorators that -# produce valid context managers. -contextmanager-decorators=contextlib.contextmanager - -# List of members which are set dynamically and missed by pylint inference -# system, and so shouldn't trigger E1101 when accessed. Python regular -# expressions are accepted. -generated-members= - -# Tells whether missing members accessed in mixin class should be ignored. A -# mixin class is detected if its name ends with "mixin" (case insensitive). -ignore-mixin-members=yes - -# This flag controls whether pylint should warn about no-member and similar -# checks whenever an opaque object is returned when inferring. The inference -# can return multiple potential results while evaluating a Python object, but -# some branches might not be evaluated, which results in partial inference. In -# that case, it might be useful to still emit no-member and other checks for -# the rest of the inferred objects. -ignore-on-opaque-inference=yes - -# List of class names for which member attributes should not be checked (useful -# for classes with dynamically set attributes). This supports the use of -# qualified names. -ignored-classes=optparse.Values,thread._local,_thread._local - -# List of module names for which member attributes should not be checked -# (useful for modules/projects where namespaces are manipulated during runtime -# and thus existing member attributes cannot be deduced by static analysis. It -# supports qualified module names, as well as Unix pattern matching. -ignored-modules= - -# Show a hint with possible names when a member name was not found. The aspect -# of finding the hint is based on edit distance. -missing-member-hint=yes - -# The minimum edit distance a name should have in order to be considered a -# similar match for a missing member name. -missing-member-hint-distance=1 - -# The total number of similar names that should be taken in consideration when -# showing a hint for a missing member. -missing-member-max-choices=1 - - -[VARIABLES] - -# List of additional names supposed to be defined in builtins. Remember that -# you should avoid to define new builtins when possible. -additional-builtins= - -# Tells whether unused global variables should be treated as a violation. -allow-global-unused-variables=yes - -# List of strings which can identify a callback function by name. A callback -# name must start or end with one of those strings. -callbacks=cb_,_cb - -# A regular expression matching the name of dummy variables (i.e. expectedly -# not used). -dummy-variables-rgx=_+$|(_[a-zA-Z0-9_]*[a-zA-Z0-9]+?$)|dummy|^ignored_|^unused_ - -# Argument names that match this expression will be ignored. Default to name -# with leading underscore -ignored-argument-names=_.*|^ignored_|^unused_ - -# Tells whether we should check for unused import in __init__ files. -init-import=no - -# List of qualified module names which can have objects that can redefine -# builtins. -redefining-builtins-modules=six.moves,future.builtins - - -[CLASSES] - -# List of method names used to declare (i.e. assign) instance attributes. -defining-attr-methods=__init__,__new__,setUp - -# List of member names, which should be excluded from the protected access -# warning. -exclude-protected=_asdict,_fields,_replace,_source,_make - -# List of valid names for the first argument in a class method. -valid-classmethod-first-arg=cls - -# List of valid names for the first argument in a metaclass class method. -valid-metaclass-classmethod-first-arg=mcs - - -[DESIGN] - -# Maximum number of arguments for function / method -max-args=5 - -# Maximum number of attributes for a class (see R0902). -max-attributes=7 - -# Maximum number of boolean expressions in a if statement -max-bool-expr=5 - -# Maximum number of branch for function / method body -max-branches=12 - -# Maximum number of locals for function / method body -max-locals=15 - -# Maximum number of parents for a class (see R0901). -max-parents=7 - -# Maximum number of public methods for a class (see R0904). -max-public-methods=20 - -# Maximum number of return / yield for function / method body -max-returns=6 - -# Maximum number of statements in function / method body -max-statements=50 - -# Minimum number of public methods for a class (see R0903). -min-public-methods=2 - - -[IMPORTS] - -# Allow wildcard imports from modules that define __all__. -allow-wildcard-with-all=no - -# Analyse import fallback blocks. This can be used to support both Python 2 and -# 3 compatible code, which means that the block might have code that exists -# only in one or another interpreter, leading to false positives when analysed. -analyse-fallback-blocks=no - -# Deprecated modules which should not be used, separated by a comma -deprecated-modules=regsub,TERMIOS,Bastion,rexec - -# Create a graph of external dependencies in the given file (report RP0402 must -# not be disabled) -ext-import-graph= - -# Create a graph of every (i.e. internal and external) dependencies in the -# given file (report RP0402 must not be disabled) -import-graph= - -# Create a graph of internal dependencies in the given file (report RP0402 must -# not be disabled) -int-import-graph= - -# Force import order to recognize a module as part of the standard -# compatibility libraries. -known-standard-library= - -# Force import order to recognize a module as part of a third party library. -known-third-party=enchant - - -[EXCEPTIONS] - -# Exceptions that will emit a warning when being caught. Defaults to -# "Exception" -overgeneral-exceptions=Exception diff --git a/manage_externals/test/Makefile b/manage_externals/test/Makefile deleted file mode 100644 index 293e360757..0000000000 --- a/manage_externals/test/Makefile +++ /dev/null @@ -1,124 +0,0 @@ -python = not-set -verbose = not-set -debug = not-set - -ifneq ($(python), not-set) -PYTHON=$(python) -else -PYTHON=python -endif - -# we need the python path to point one level up to access the package -# and executables -PYPATH=PYTHONPATH=..: - -# common args for running tests -TEST_ARGS=-m unittest discover - -ifeq ($(debug), not-set) - ifeq ($(verbose), not-set) - # summary only output - TEST_ARGS+=--buffer - else - # show individual test summary - TEST_ARGS+=--buffer --verbose - endif -else - # show detailed test output - TEST_ARGS+=--verbose -endif - - -# auto reformat the code -AUTOPEP8=autopep8 -AUTOPEP8_ARGS=--aggressive --in-place - -# run lint -PYLINT=pylint -PYLINT_ARGS=-j 2 --rcfile=.pylint.rc - -# code coverage -COVERAGE=coverage -COVERAGE_ARGS=--rcfile=.coveragerc - -# source files -SRC = \ - ../checkout_externals \ - ../manic/*.py - -CHECKOUT_EXE = ../checkout_externals - -TEST_DIR = . - -README = ../README.md - -# -# testing -# -.PHONY : utest -utest : FORCE - $(PYPATH) $(PYTHON) $(TEST_ARGS) --pattern 'test_unit_*.py' - -.PHONY : stest -stest : FORCE - $(PYPATH) $(PYTHON) $(TEST_ARGS) --pattern 'test_sys_*.py' - -.PHONY : test -test : utest stest - -# -# documentation -# -.PHONY : readme -readme : $(CHECKOUT_EXE) - printf "%s\n\n" "-- AUTOMATICALLY GENERATED FILE. DO NOT EDIT --" > $(README) - printf "%s" '[![Build Status](https://travis-ci.org/ESMCI/manage_externals.svg?branch=master)](https://travis-ci.org/ESMCI/manage_externals)' >> $(README) - printf "%s" '[![Coverage Status](https://coveralls.io/repos/github/ESMCI/manage_externals/badge.svg?branch=master)](https://coveralls.io/github/ESMCI/manage_externals?branch=master)' >> $(README) - printf "\n%s\n" '```' >> $(README) - $(CHECKOUT_EXE) --help >> $(README) - -# -# coding standards -# -.PHONY : style -style : FORCE - $(AUTOPEP8) $(AUTOPEP8_ARGS) --recursive $(SRC) $(TEST_DIR)/test_*.py - -.PHONY : lint -lint : FORCE - $(PYLINT) $(PYLINT_ARGS) $(SRC) $(TEST_DIR)/test_*.py - -.PHONY : stylint -stylint : style lint - -.PHONY : coverage -# Need to use a single coverage run with a single pattern rather than -# using two separate commands with separate patterns for test_unit_*.py -# and test_sys_*.py: The latter clobbers some results from the first -# run, even if we use the --append flag to 'coverage run'. -coverage : FORCE - $(PYPATH) $(COVERAGE) erase - $(PYPATH) $(COVERAGE) run $(COVERAGE_ARGS) $(TEST_ARGS) --pattern 'test_*.py' - $(PYPATH) $(COVERAGE) html - -# -# virtual environment creation -# -.PHONY : env -env : FORCE - $(PYPATH) virtualenv --python $(PYTHON) $@_$(PYTHON) - . $@_$(PYTHON)/bin/activate; pip install -r requirements.txt - -# -# utilites -# -.PHONY : clean -clean : FORCE - -rm -rf *~ *.pyc tmp fake htmlcov - -.PHONY : clobber -clobber : clean - -rm -rf env_* - -FORCE : - diff --git a/manage_externals/test/README.md b/manage_externals/test/README.md deleted file mode 100644 index 938a900eec..0000000000 --- a/manage_externals/test/README.md +++ /dev/null @@ -1,77 +0,0 @@ -# Testing for checkout_externals - -NOTE: Python2 is the supported runtime environment. Python3 compatibility is -in progress, complicated by the different proposed input methods -(yaml, xml, cfg/ini, json) and their different handling of strings -(unicode vs byte) in python2. Full python3 compatibility will be -possible once the number of possible input formats has been narrowed. - -## Setup development environment - -Development environments should be setup for python2 and python3: - -```SH - cd checkout_externals/test - make python=python2 env - make python=python3 env -``` - -## Unit tests - -Tests should be run for both python2 and python3. It is recommended -that you have seperate terminal windows open python2 and python3 -testing to avoid errors activating and deactivating environments. - -```SH - cd checkout_externals/test - . env_python2/bin/activate - make utest - deactivate -``` - -```SH - cd checkout_externals/test - . env_python2/bin/activate - make utest - deactivate -``` - -## System tests - -Not yet implemented. - -## Static analysis - -checkout_externals is difficult to test thoroughly because it relies -on git and svn, and svn requires a live network connection and -repository. Static analysis will help catch bugs in code paths that -are not being executed, but it requires conforming to community -standards and best practices. autopep8 and pylint should be run -regularly for automatic code formatting and linting. - -```SH - cd checkout_externals/test - . env_python2/bin/activate - make lint - deactivate -``` - -The canonical formatting for the code is whatever autopep8 -generates. All issues identified by pylint should be addressed. - - -## Code coverage - -All changes to the code should include maintaining existing tests and -writing new tests for new or changed functionality. To ensure test -coverage, run the code coverage tool: - -```SH - cd checkout_externals/test - . env_python2/bin/activate - make coverage - open -a Firefox.app htmlcov/index.html - deactivate -``` - - diff --git a/manage_externals/test/doc/.gitignore b/manage_externals/test/doc/.gitignore deleted file mode 100644 index d4e11e5ea0..0000000000 --- a/manage_externals/test/doc/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -_build - diff --git a/manage_externals/test/doc/Makefile b/manage_externals/test/doc/Makefile deleted file mode 100644 index 18f4d5bf99..0000000000 --- a/manage_externals/test/doc/Makefile +++ /dev/null @@ -1,20 +0,0 @@ -# Minimal makefile for Sphinx documentation -# - -# You can set these variables from the command line. -SPHINXOPTS = -SPHINXBUILD = sphinx-build -SPHINXPROJ = ManageExternals -SOURCEDIR = . -BUILDDIR = _build - -# Put it first so that "make" without argument is like "make help". -help: - @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) - -.PHONY: help Makefile - -# Catch-all target: route all unknown targets to Sphinx using the new -# "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). -%: Makefile - @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) \ No newline at end of file diff --git a/manage_externals/test/doc/conf.py b/manage_externals/test/doc/conf.py deleted file mode 100644 index 469c0b0dc5..0000000000 --- a/manage_externals/test/doc/conf.py +++ /dev/null @@ -1,172 +0,0 @@ -# -*- coding: utf-8 -*- -# -# Manage Externals documentation build configuration file, created by -# sphinx-quickstart on Wed Nov 29 10:53:25 2017. -# -# This file is execfile()d with the current directory set to its -# containing dir. -# -# Note that not all possible configuration values are present in this -# autogenerated file. -# -# All configuration values have a default; values that are commented out -# serve to show the default. - -# If extensions (or modules to document with autodoc) are in another directory, -# add these directories to sys.path here. If the directory is relative to the -# documentation root, use os.path.abspath to make it absolute, like shown here. -# -# import os -# import sys -# sys.path.insert(0, os.path.abspath('.')) - - -# -- General configuration ------------------------------------------------ - -# If your documentation needs a minimal Sphinx version, state it here. -# -# needs_sphinx = '1.0' - -# Add any Sphinx extension module names here, as strings. They can be -# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom -# ones. -extensions = ['sphinx.ext.autodoc', - 'sphinx.ext.todo', - 'sphinx.ext.coverage', - 'sphinx.ext.viewcode', - 'sphinx.ext.githubpages'] - -# Add any paths that contain templates here, relative to this directory. -templates_path = ['_templates'] - -# The suffix(es) of source filenames. -# You can specify multiple suffix as a list of string: -# -# source_suffix = ['.rst', '.md'] -source_suffix = '.rst' - -# The master toctree document. -master_doc = 'index' - -# General information about the project. -project = u'Manage Externals' -copyright = u'2017, CSEG at NCAR' -author = u'CSEG at NCAR' - -# The version info for the project you're documenting, acts as replacement for -# |version| and |release|, also used in various other places throughout the -# built documents. -# -# The short X.Y version. -version = u'1.0.0' -# The full version, including alpha/beta/rc tags. -release = u'1.0.0' - -# The language for content autogenerated by Sphinx. Refer to documentation -# for a list of supported languages. -# -# This is also used if you do content translation via gettext catalogs. -# Usually you set "language" from the command line for these cases. -language = None - -# List of patterns, relative to source directory, that match files and -# directories to ignore when looking for source files. -# This patterns also effect to html_static_path and html_extra_path -exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store'] - -# The name of the Pygments (syntax highlighting) style to use. -pygments_style = 'sphinx' - -# If true, `todo` and `todoList` produce output, else they produce nothing. -todo_include_todos = True - - -# -- Options for HTML output ---------------------------------------------- - -# The theme to use for HTML and HTML Help pages. See the documentation for -# a list of builtin themes. -# -html_theme = 'alabaster' - -# Theme options are theme-specific and customize the look and feel of a theme -# further. For a list of options available for each theme, see the -# documentation. -# -# html_theme_options = {} - -# Add any paths that contain custom static files (such as style sheets) here, -# relative to this directory. They are copied after the builtin static files, -# so a file named "default.css" will overwrite the builtin "default.css". -html_static_path = ['_static'] - -# Custom sidebar templates, must be a dictionary that maps document names -# to template names. -# -# This is required for the alabaster theme -# refs: http://alabaster.readthedocs.io/en/latest/installation.html#sidebars -html_sidebars = { - '**': [ - 'relations.html', # needs 'show_related': True theme option to display - 'searchbox.html', - ] -} - - -# -- Options for HTMLHelp output ------------------------------------------ - -# Output file base name for HTML help builder. -htmlhelp_basename = 'ManageExternalsdoc' - - -# -- Options for LaTeX output --------------------------------------------- - -latex_elements = { - # The paper size ('letterpaper' or 'a4paper'). - # - # 'papersize': 'letterpaper', - - # The font size ('10pt', '11pt' or '12pt'). - # - # 'pointsize': '10pt', - - # Additional stuff for the LaTeX preamble. - # - # 'preamble': '', - - # Latex figure (float) alignment - # - # 'figure_align': 'htbp', -} - -# Grouping the document tree into LaTeX files. List of tuples -# (source start file, target name, title, -# author, documentclass [howto, manual, or own class]). -latex_documents = [ - (master_doc, 'ManageExternals.tex', u'Manage Externals Documentation', - u'CSEG at NCAR', 'manual'), -] - - -# -- Options for manual page output --------------------------------------- - -# One entry per manual page. List of tuples -# (source start file, name, description, authors, manual section). -man_pages = [ - (master_doc, 'manageexternals', u'Manage Externals Documentation', - [author], 1) -] - - -# -- Options for Texinfo output ------------------------------------------- - -# Grouping the document tree into Texinfo files. List of tuples -# (source start file, target name, title, author, -# dir menu entry, description, category) -texinfo_documents = [ - (master_doc, 'ManageExternals', u'Manage Externals Documentation', - author, 'ManageExternals', 'One line description of project.', - 'Miscellaneous'), -] - - - diff --git a/manage_externals/test/doc/develop.rst b/manage_externals/test/doc/develop.rst deleted file mode 100644 index b817b7b093..0000000000 --- a/manage_externals/test/doc/develop.rst +++ /dev/null @@ -1,202 +0,0 @@ -Developer Guidelines -==================== - -The manage externals utilities are a light weight replacement for svn -externals that will work with git repositories pulling in a mixture of -git and svn dependencies. - -Given an externals description and a working copy: - -* *checkout_externals* attempts to make the working copy agree with the - externals description - -* *generate_externals* attempts to make the externals description agree - with the working copy. - -For these operations utilities should: - -* operate consistently across git and svn - -* operate simply with minimal user complexity - -* robustly across a wide range of repository states - -* provide explicit error messages when a problem occurs - -* leave the working copy in a valid state - -The utilities in manage externals are **NOT** generic wrappers around -revision control operations or a replacement for common tasks. Users -are expected to: - -* create branches prior to starting development - -* add remotes and push changes - -* create tags - -* delete branches - -These types of tasks are often highly workflow dependent, e.g. branch -naming conventions may vary between repositories, have the potential -to destroy user data, introduce significant code complexit and 'edge -cases' that are extremely difficult to detect and test, and often -require subtle decision making, especially if a problem occurs. - -Users who want to automate these types are encouraged to create their -own tools. The externals description files are explicitly versioned -and the internal APIs are intended to be stable for these purposes. - -Core Design Principles ------------------------ - -1. Users can, and are actively encouraged to, modify the externals - directories using revision control outside of manage_externals - tools. You can't make any assumptions about the state of the - working copy. Examples: adding a remote, creating a branch, - switching to a branch, deleting the directory entirely. - -2. Give that the user can do anything, the manage externals library - can not preserve state between calls. The only information it can - rely on is what it expectes based on the content of the externals - description file, and what the actual state of the directory tree - is. - -3. Do *not* do anything that will possibly destroy user data! - - a. Do not remove files from the file system. We are operating on - user supplied input. If you don't call 'rm', you can't - accidentally remove the user's data. Thinking of calling - ``shutil.rmtree(user_input)``? What if the user accidentally - specified user_input such that it resolves to their home - directory.... Yeah. Don't go there. - - b. Rely on git and svn to do their job as much as possible. Don't - duplicate functionality. Examples: - - i. We require the working copies to be 'clean' as reported by - ``git status`` and ``svn status``. What if there are misc - editor files floating around that prevent an update? Use the - git and svn ignore functionality so they are not - reported. Don't try to remove them from manage_externals or - determine if they are 'safe' to ignore. - - ii. Do not use '--force'. Ever. This is a sign you are doing - something dangerous, it may not be what the user - wants. Remember, they are encouraged to modify their repo. - -4. There are often multiple ways to obtain a particular piece of - information from git. Scraping screen output is brittle and - generally not considered a stable API across different versions of - git. Given a choice between: - - a. a lower level git 'plumbing' command that processes a - specific request and returns a sucess/failure status. - - b. high level git command that produces a bunch of output - that must be processed. - - We always prefer the former. It almost always involves - writing and maintaining less code and is more likely to be - stable. - -5. Backward compatibility is critical. We have *nested* - repositories. They are trivially easy to change versions. They may - have very different versions of the top level manage_externals. The - ability to read and work with old model description files is - critical to avoid problems for users. We also have automated tools - (testdb) that must generate and read external description - files. Backward compatibility will make staging changes vastly - simpler. - -Model Users ------------ - -Consider the needs of the following model userswhen developing manage_externals: - -* Users who will checkout the code once, and never change versions. - -* Users who will checkout the code once, then work for several years, - never updating. before trying to update or request integration. - -* Users develope code but do not use revision control beyond the - initial checkout. If they have modified or untracked files in the - repo, they may be irreplacable. Don't destroy user data. - -* Intermediate users who are working with multiple repos or branches - on a regular basis. They may only use manage_externals weekly or - monthly. Keep the user interface and documentation simple and - explicit. The more command line options they have to remember or - look up, the more frustrated they git. - -* Software engineers who use the tools multiple times a day. It should - get out of their way. - -User Interface --------------- - -Basic operation for the most standard use cases should be kept as -simple as possible. Many users will only rarely run the manage -utilities. Even advanced users don't like reading a lot of help -documentation or struggling to remember commands and piece together -what they need to run. Having many command line options, even if not -needed, is exteremly frustrating and overwhelming for most users. A few -simple, explicitly named commands are better than a single command -with many options. - -How will users get help if something goes wrong? This is a custom, -one-off solution. Searching the internet for manage_externals, will -only return the user doc for this project at best. There isn't likely -to be a stackoverflow question or blog post where someone else already -answered a user's question. And very few people outside this community -will be able to provide help if something goes wrong. The sooner we -kick users out of these utilities and into standard version control -tools, the better off they are going to be if they run into a problem. - -Repositories ------------- - -There are three basic types of repositories that must be considered: - -* container repositories - repositories that are always top level - repositories, and have a group of externals that must be managed. - -* simple repositories - repositories that are externals to another - repository, and do not have any of their own externals that will be - managed. - -* mixed use repositories - repositories that can act as a top level - container repository or as an external to a top level - container. They may also have their own sub-externals that are - required. They may have different externals needs depening on - whether they are top level or not. - -Repositories must be able to checkout and switch to both branches and -tags. - -Development -=========== - -The functionality to manage externals is broken into a library of core -functionality and applications built with the library. - -The core library is called 'manic', pseduo-homophone of (man)age -(ex)ternals that is: short, pronounceable and spell-checkable. It is -also no more or less meaningful to an unfamiliar user than a random -jumble of letters forming an acronym. - -The core architecture of manic is: - -* externals description - an abstract description on an external, - including of how to obtain it, where to obtain it, where it goes in - the working tree. - -* externals - the software object representing an external. - -* source trees - collection of externals - -* repository wrappers - object oriented wrappers around repository - operations. So the higher level management of the soure tree and - external does not have to be concerned with how a particular - external is obtained and managed. - diff --git a/manage_externals/test/doc/index.rst b/manage_externals/test/doc/index.rst deleted file mode 100644 index 9ab287ad8c..0000000000 --- a/manage_externals/test/doc/index.rst +++ /dev/null @@ -1,22 +0,0 @@ -.. Manage Externals documentation master file, created by - sphinx-quickstart on Wed Nov 29 10:53:25 2017. - You can adapt this file completely to your liking, but it should at least - contain the root `toctree` directive. - -Welcome to Manage Externals's documentation! -============================================ - -.. toctree:: - :maxdepth: 2 - :caption: Contents: - - - develop.rst - testing.rst - -Indices and tables -================== - -* :ref:`genindex` -* :ref:`modindex` -* :ref:`search` diff --git a/manage_externals/test/doc/testing.rst b/manage_externals/test/doc/testing.rst deleted file mode 100644 index 623f0e431c..0000000000 --- a/manage_externals/test/doc/testing.rst +++ /dev/null @@ -1,123 +0,0 @@ -Testing -======= - -The manage_externals package has an automated test suite. All pull -requests are expected to pass 100% of the automated tests, as well as -be pep8 and lint 'clean' and maintain approximately constant (at a -minimum) level of code coverage. - -Quick Start ------------ - -Do nothing approach -~~~~~~~~~~~~~~~~~~~ - -When you create a pull request on GitHub, Travis-CI continuous -integration testing will run the test suite in both python2 and -python3. Test results, lint results, and code coverage results are -available online. - -Do something approach -~~~~~~~~~~~~~~~~~~~~~ - -In the test directory, run: - -.. code-block:: shell - - make env - make lint - make test - make coverage - - -Automated Testing ------------------ - -The manage_externals manic library and executables are developed to be -python2 and python3 compatible using only the standard library. The -test suites meet the same requirements. But additional tools are -required to provide lint and code coverage metrics and generate -documentation. The requirements are maintained in the requirements.txt -file, and can be automatically installed into an isolated environment -via Makefile. - -Bootstrap requirements: - -* python2 - version 2.7.x or later - -* python3 - version 3.6 tested other versions may work - -* pip and virtualenv for python2 and python3 - -Note: all make rules can be of the form ``make python=pythonX rule`` -or ``make rule`` depending if you want to use the default system -python or specify a specific version. - -The Makefile in the test directory has the following rules: - -* ``make python=pythonX env`` - create a python virtual environment - for python2 or python3 and install all required packages. These - packages are required to run lint or coverage. - -* ``make style`` - runs autopep8 - -* ``make lint`` - runs autopep8 and pylint - -* ``make test`` - run the full test suite - -* ``make utest`` - run jus the unit tests - -* ``make stest`` - run jus the system integration tests - -* ``make coverage`` - run the full test suite through the code - coverage tool and generate an html report. - -* ``make readme`` - automatically generate the README files. - -* ``make clean`` - remove editor and pyc files - -* ``make clobber`` - remove all generated test files, including - virtual environments, coverage reports, and temporary test - repository directories. - -Unit Tests ----------- - -Unit tests are probably not 'true unit tests' for the pedantic, but -are pragmatic unit tests. They cover small practicle code blocks: -functions, class methods, and groups of functions and class methods. - -System Integration Tests ------------------------- - -NOTE(bja, 2017-11) The systems integration tests currently do not include svn repositories. - -The manage_externals package is extremely tedious and error prone to test manually. - -Combinations that must be tested to ensure basic functionality are: - -* container repository pulling in simple externals - -* container repository pulling in mixed externals with sub-externals. - -* mixed repository acting as a container, pulling in simple externals and sub-externals - -Automatic system tests are handled the same way manual testing is done: - -* clone a test repository - -* create an externals description file for the test - -* run the executable with the desired args - -* check the results - -* potentially modify the repo (checkout a different branch) - -* rerun and test - -* etc - -The automated system stores small test repositories in the main repo -by adding them as bare repositories. These repos are cloned via a -subprocess call to git and manipulated during the tests. diff --git a/manage_externals/test/repos/container.git/HEAD b/manage_externals/test/repos/container.git/HEAD deleted file mode 100644 index cb089cd89a..0000000000 --- a/manage_externals/test/repos/container.git/HEAD +++ /dev/null @@ -1 +0,0 @@ -ref: refs/heads/master diff --git a/manage_externals/test/repos/container.git/config b/manage_externals/test/repos/container.git/config deleted file mode 100644 index e6da231579..0000000000 --- a/manage_externals/test/repos/container.git/config +++ /dev/null @@ -1,6 +0,0 @@ -[core] - repositoryformatversion = 0 - filemode = true - bare = true - ignorecase = true - precomposeunicode = true diff --git a/manage_externals/test/repos/container.git/description b/manage_externals/test/repos/container.git/description deleted file mode 100644 index 498b267a8c..0000000000 --- a/manage_externals/test/repos/container.git/description +++ /dev/null @@ -1 +0,0 @@ -Unnamed repository; edit this file 'description' to name the repository. diff --git a/manage_externals/test/repos/container.git/info/exclude b/manage_externals/test/repos/container.git/info/exclude deleted file mode 100644 index a5196d1be8..0000000000 --- a/manage_externals/test/repos/container.git/info/exclude +++ /dev/null @@ -1,6 +0,0 @@ -# git ls-files --others --exclude-from=.git/info/exclude -# Lines that start with '#' are comments. -# For a project mostly in C, the following would be a good set of -# exclude patterns (uncomment them if you want to use them): -# *.[oa] -# *~ diff --git a/manage_externals/test/repos/container.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 b/manage_externals/test/repos/container.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 deleted file mode 100644 index f65234e17f..0000000000 Binary files a/manage_externals/test/repos/container.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 and /dev/null differ diff --git a/manage_externals/test/repos/container.git/objects/71/5b8f3e4afe1802a178e1d603af404ba45d59de b/manage_externals/test/repos/container.git/objects/71/5b8f3e4afe1802a178e1d603af404ba45d59de deleted file mode 100644 index 9759965b1b..0000000000 Binary files a/manage_externals/test/repos/container.git/objects/71/5b8f3e4afe1802a178e1d603af404ba45d59de and /dev/null differ diff --git a/manage_externals/test/repos/container.git/objects/b0/f87705e2b9601cb831878f3d51efa78b910d7b b/manage_externals/test/repos/container.git/objects/b0/f87705e2b9601cb831878f3d51efa78b910d7b deleted file mode 100644 index d9976cc442..0000000000 Binary files a/manage_externals/test/repos/container.git/objects/b0/f87705e2b9601cb831878f3d51efa78b910d7b and /dev/null differ diff --git a/manage_externals/test/repos/container.git/objects/f9/e08370a737e941de6f6492e3f427c2ef4c1a03 b/manage_externals/test/repos/container.git/objects/f9/e08370a737e941de6f6492e3f427c2ef4c1a03 deleted file mode 100644 index 460fd77819..0000000000 Binary files a/manage_externals/test/repos/container.git/objects/f9/e08370a737e941de6f6492e3f427c2ef4c1a03 and /dev/null differ diff --git a/manage_externals/test/repos/container.git/refs/heads/master b/manage_externals/test/repos/container.git/refs/heads/master deleted file mode 100644 index 3ae00f3af0..0000000000 --- a/manage_externals/test/repos/container.git/refs/heads/master +++ /dev/null @@ -1 +0,0 @@ -715b8f3e4afe1802a178e1d603af404ba45d59de diff --git a/manage_externals/test/repos/error/readme.txt b/manage_externals/test/repos/error/readme.txt deleted file mode 100644 index 6b5753377e..0000000000 --- a/manage_externals/test/repos/error/readme.txt +++ /dev/null @@ -1,3 +0,0 @@ -Invalid or corrupted git repository (.git dir exists, but is empty) for error -testing. - diff --git a/manage_externals/test/repos/mixed-cont-ext.git/HEAD b/manage_externals/test/repos/mixed-cont-ext.git/HEAD deleted file mode 100644 index cb089cd89a..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/HEAD +++ /dev/null @@ -1 +0,0 @@ -ref: refs/heads/master diff --git a/manage_externals/test/repos/mixed-cont-ext.git/config b/manage_externals/test/repos/mixed-cont-ext.git/config deleted file mode 100644 index e6da231579..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/config +++ /dev/null @@ -1,6 +0,0 @@ -[core] - repositoryformatversion = 0 - filemode = true - bare = true - ignorecase = true - precomposeunicode = true diff --git a/manage_externals/test/repos/mixed-cont-ext.git/description b/manage_externals/test/repos/mixed-cont-ext.git/description deleted file mode 100644 index 498b267a8c..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/description +++ /dev/null @@ -1 +0,0 @@ -Unnamed repository; edit this file 'description' to name the repository. diff --git a/manage_externals/test/repos/mixed-cont-ext.git/info/exclude b/manage_externals/test/repos/mixed-cont-ext.git/info/exclude deleted file mode 100644 index a5196d1be8..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/info/exclude +++ /dev/null @@ -1,6 +0,0 @@ -# git ls-files --others --exclude-from=.git/info/exclude -# Lines that start with '#' are comments. -# For a project mostly in C, the following would be a good set of -# exclude patterns (uncomment them if you want to use them): -# *.[oa] -# *~ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/00/437ac2000d5f06fb8a572a01a5bbdae98b17cb b/manage_externals/test/repos/mixed-cont-ext.git/objects/00/437ac2000d5f06fb8a572a01a5bbdae98b17cb deleted file mode 100644 index 145a6990a8..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/00/437ac2000d5f06fb8a572a01a5bbdae98b17cb and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/01/97458f2dbe5fcd6bc44fa46983be0a30282379 b/manage_externals/test/repos/mixed-cont-ext.git/objects/01/97458f2dbe5fcd6bc44fa46983be0a30282379 deleted file mode 100644 index 032f4b1ca6..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/01/97458f2dbe5fcd6bc44fa46983be0a30282379 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/06/ea30b03ffa2f8574705f8b9583f7ca7e2dccf7 b/manage_externals/test/repos/mixed-cont-ext.git/objects/06/ea30b03ffa2f8574705f8b9583f7ca7e2dccf7 deleted file mode 100644 index 13d15a96a5..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/06/ea30b03ffa2f8574705f8b9583f7ca7e2dccf7 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/14/368b701616a8c53820b610414a4b9a07540cf6 b/manage_externals/test/repos/mixed-cont-ext.git/objects/14/368b701616a8c53820b610414a4b9a07540cf6 deleted file mode 100644 index 53c4e79ed0..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/objects/14/368b701616a8c53820b610414a4b9a07540cf6 +++ /dev/null @@ -1 +0,0 @@ -x50S0A1FMWiRh-iitjz h#F+|m"rFd <;s̱۬OEQE}TLU<,9}]IiP. 9ze vA$8#DK \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/15/2b57e1cf23721cd17ff681cb9276e3fb9fc091 b/manage_externals/test/repos/mixed-cont-ext.git/objects/15/2b57e1cf23721cd17ff681cb9276e3fb9fc091 deleted file mode 100644 index d09c006f07..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/objects/15/2b57e1cf23721cd17ff681cb9276e3fb9fc091 +++ /dev/null @@ -1,2 +0,0 @@ -xKn0 )xEӛP"eCuzb0Su)!h9.!<ے,s$P0/f.M_ɅKjc٧$03Ytz:|HK.p缏BUxzL`N2M2J]K۾># -MPtM0v&>Kci8V; \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/1f/01fa46c17b1f38b37e6259f6e9d041bda3144f b/manage_externals/test/repos/mixed-cont-ext.git/objects/1f/01fa46c17b1f38b37e6259f6e9d041bda3144f deleted file mode 100644 index 7bacde68db..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/1f/01fa46c17b1f38b37e6259f6e9d041bda3144f and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/37/f0e70b609adc90f4c09ee21d82ed1d79c81d69 b/manage_externals/test/repos/mixed-cont-ext.git/objects/37/f0e70b609adc90f4c09ee21d82ed1d79c81d69 deleted file mode 100644 index 8c6b04837a..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/37/f0e70b609adc90f4c09ee21d82ed1d79c81d69 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/38/9a2b876b8965d3c91a3db8d28a483eaf019d5c b/manage_externals/test/repos/mixed-cont-ext.git/objects/38/9a2b876b8965d3c91a3db8d28a483eaf019d5c deleted file mode 100644 index 1a35b74d47..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/38/9a2b876b8965d3c91a3db8d28a483eaf019d5c and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 b/manage_externals/test/repos/mixed-cont-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 deleted file mode 100644 index f65234e17f..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/6e/9f4baa6e94a0af4e094836c2eb55ccedef5fc4 b/manage_externals/test/repos/mixed-cont-ext.git/objects/6e/9f4baa6e94a0af4e094836c2eb55ccedef5fc4 deleted file mode 100644 index 6b2146cae4..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/6e/9f4baa6e94a0af4e094836c2eb55ccedef5fc4 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/6f/c379457ecb4e576a13c7610ae1fa73f845ee6a b/manage_externals/test/repos/mixed-cont-ext.git/objects/6f/c379457ecb4e576a13c7610ae1fa73f845ee6a deleted file mode 100644 index 852a051139..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/objects/6f/c379457ecb4e576a13c7610ae1fa73f845ee6a +++ /dev/null @@ -1 +0,0 @@ -xAN09sʎ;~2J^M,'8ԝھ_yyR3؍lmvƕPBFC>y*bla-n^]D,xfv2p׭ }GzxNvq~Zc y+QTt;]C:AgA( XAG*=i\_^' \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/93/a159deb9175bfeb2820a0006ddd92d78131332 b/manage_externals/test/repos/mixed-cont-ext.git/objects/93/a159deb9175bfeb2820a0006ddd92d78131332 deleted file mode 100644 index 682d799898..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/93/a159deb9175bfeb2820a0006ddd92d78131332 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/95/80ecc12f16334ce44e42287d5d46f927bb7b75 b/manage_externals/test/repos/mixed-cont-ext.git/objects/95/80ecc12f16334ce44e42287d5d46f927bb7b75 deleted file mode 100644 index 33c9f6cdf1..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/objects/95/80ecc12f16334ce44e42287d5d46f927bb7b75 +++ /dev/null @@ -1 +0,0 @@ -xKN0YcȟLlK7鴟5#{OzғmW%ӓv8&eFٱ$/UɞzRJ%ZY |YSC/'*}A7Cۑϋ1^L0f7c b/Jo5-Ů;҅AH:XADZ:ڇ8M^ \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/a9/288dcd8a719a1f4ed3cba43a2a387ae7cd60fd b/manage_externals/test/repos/mixed-cont-ext.git/objects/a9/288dcd8a719a1f4ed3cba43a2a387ae7cd60fd deleted file mode 100644 index 73e7cbfbc8..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/a9/288dcd8a719a1f4ed3cba43a2a387ae7cd60fd and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/e8/ea32a11d30ee703f6f661ae7c2376f4ab84d38 b/manage_externals/test/repos/mixed-cont-ext.git/objects/e8/ea32a11d30ee703f6f661ae7c2376f4ab84d38 deleted file mode 100644 index 189ed85bb3..0000000000 Binary files a/manage_externals/test/repos/mixed-cont-ext.git/objects/e8/ea32a11d30ee703f6f661ae7c2376f4ab84d38 and /dev/null differ diff --git a/manage_externals/test/repos/mixed-cont-ext.git/objects/fd/15a5ad5204356229c60a831d2a8120a43ac901 b/manage_externals/test/repos/mixed-cont-ext.git/objects/fd/15a5ad5204356229c60a831d2a8120a43ac901 deleted file mode 100644 index 619e38ee78..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/objects/fd/15a5ad5204356229c60a831d2a8120a43ac901 +++ /dev/null @@ -1,2 +0,0 @@ -x=;0 :v =rJf`) noW)zgA >.pA -! w4ݵQ=äZ90k G)* \ No newline at end of file diff --git a/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/master b/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/master deleted file mode 100644 index 1e0eef1ea3..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/master +++ /dev/null @@ -1 +0,0 @@ -6fc379457ecb4e576a13c7610ae1fa73f845ee6a diff --git a/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/new-feature b/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/new-feature deleted file mode 100644 index 607e80d1bc..0000000000 --- a/manage_externals/test/repos/mixed-cont-ext.git/refs/heads/new-feature +++ /dev/null @@ -1 +0,0 @@ -9580ecc12f16334ce44e42287d5d46f927bb7b75 diff --git a/manage_externals/test/repos/simple-ext-fork.git/HEAD b/manage_externals/test/repos/simple-ext-fork.git/HEAD deleted file mode 100644 index cb089cd89a..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/HEAD +++ /dev/null @@ -1 +0,0 @@ -ref: refs/heads/master diff --git a/manage_externals/test/repos/simple-ext-fork.git/config b/manage_externals/test/repos/simple-ext-fork.git/config deleted file mode 100644 index 04eba17870..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/config +++ /dev/null @@ -1,8 +0,0 @@ -[core] - repositoryformatversion = 0 - filemode = true - bare = true - ignorecase = true - precomposeunicode = true -[remote "origin"] - url = /Users/andreb/projects/ncar/git-conversion/checkout-model-dev/cesm-demo-externals/manage_externals/test/repos/simple-ext.git diff --git a/manage_externals/test/repos/simple-ext-fork.git/description b/manage_externals/test/repos/simple-ext-fork.git/description deleted file mode 100644 index 498b267a8c..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/description +++ /dev/null @@ -1 +0,0 @@ -Unnamed repository; edit this file 'description' to name the repository. diff --git a/manage_externals/test/repos/simple-ext-fork.git/info/exclude b/manage_externals/test/repos/simple-ext-fork.git/info/exclude deleted file mode 100644 index a5196d1be8..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/info/exclude +++ /dev/null @@ -1,6 +0,0 @@ -# git ls-files --others --exclude-from=.git/info/exclude -# Lines that start with '#' are comments. -# For a project mostly in C, the following would be a good set of -# exclude patterns (uncomment them if you want to use them): -# *.[oa] -# *~ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f b/manage_externals/test/repos/simple-ext-fork.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f deleted file mode 100644 index ae28c037e5..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 b/manage_externals/test/repos/simple-ext-fork.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 deleted file mode 100644 index 32d6896e3c..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/0b/67df4e7e8e6e1c6e401542738b352d18744677 b/manage_externals/test/repos/simple-ext-fork.git/objects/0b/67df4e7e8e6e1c6e401542738b352d18744677 deleted file mode 100644 index db51ce1953..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/0b/67df4e7e8e6e1c6e401542738b352d18744677 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c b/manage_externals/test/repos/simple-ext-fork.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c deleted file mode 100644 index 564e7bba63..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c +++ /dev/null @@ -1,2 +0,0 @@ -x%K -0@]se&DԛL!l).u.@_J0lM~v:mLiY*/@p W J&)* \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/16/5506a7408a482f50493434e13fffeb44af893f b/manage_externals/test/repos/simple-ext-fork.git/objects/16/5506a7408a482f50493434e13fffeb44af893f deleted file mode 100644 index 0d738af68b..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/16/5506a7408a482f50493434e13fffeb44af893f and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/24/4386e788c9bc608613e127a329c742450a60e4 b/manage_externals/test/repos/simple-ext-fork.git/objects/24/4386e788c9bc608613e127a329c742450a60e4 deleted file mode 100644 index b6284f8413..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/24/4386e788c9bc608613e127a329c742450a60e4 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/32/7e97d86e941047d809dba58f2804740c6c30cf b/manage_externals/test/repos/simple-ext-fork.git/objects/32/7e97d86e941047d809dba58f2804740c6c30cf deleted file mode 100644 index 0999f0d4b9..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/32/7e97d86e941047d809dba58f2804740c6c30cf and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 b/manage_externals/test/repos/simple-ext-fork.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 deleted file mode 100644 index 9da8434f65..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/3d/7099c35404ae6c8640ce263b38bef06e98cc26 b/manage_externals/test/repos/simple-ext-fork.git/objects/3d/7099c35404ae6c8640ce263b38bef06e98cc26 deleted file mode 100644 index 22065ba543..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/3d/7099c35404ae6c8640ce263b38bef06e98cc26 +++ /dev/null @@ -1,2 +0,0 @@ -xmQ -0EQq $LހO_* t0J8͡bE?؋g4Nmbag[b{_Ic>`}0M؇Bs0/}:: \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/3d/ec1fdf8e2f5edba28148c5db2fe8d7a842360b b/manage_externals/test/repos/simple-ext-fork.git/objects/3d/ec1fdf8e2f5edba28148c5db2fe8d7a842360b deleted file mode 100644 index 9a31c7ef2e..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/3d/ec1fdf8e2f5edba28148c5db2fe8d7a842360b +++ /dev/null @@ -1,2 +0,0 @@ -xKn0 )x,IEџA#t7o۶vp.zS&od8xLd@̋C6f% -pt$m&JdhݗVxp7^/o7dK1GDs#뿏{o?Z 7,\grPkSkJ^ \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/a4/2fe9144f5707bc1e9515ce1b44681f7aba6f95 b/manage_externals/test/repos/simple-ext-fork.git/objects/a4/2fe9144f5707bc1e9515ce1b44681f7aba6f95 deleted file mode 100644 index d8ba654548..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/a4/2fe9144f5707bc1e9515ce1b44681f7aba6f95 +++ /dev/null @@ -1,3 +0,0 @@ -xU[ -0a@%Is+;c/DqV> wWJ ژ>8!!&'S=)CF+I2OTs^Xn`2Bcw'w -\NqݛF)83(2:0x-<׍!6,i 9 \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/b9/3737be3ea6b19f6255983748a0a0f4d622f936 b/manage_externals/test/repos/simple-ext-fork.git/objects/b9/3737be3ea6b19f6255983748a0a0f4d622f936 deleted file mode 100644 index 9b40a0afa0..0000000000 Binary files a/manage_externals/test/repos/simple-ext-fork.git/objects/b9/3737be3ea6b19f6255983748a0a0f4d622f936 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/c5/32bc8fde96fa63103a52057f0baffcc9f00c6b b/manage_externals/test/repos/simple-ext-fork.git/objects/c5/32bc8fde96fa63103a52057f0baffcc9f00c6b deleted file mode 100644 index 3019d2bac0..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/c5/32bc8fde96fa63103a52057f0baffcc9f00c6b +++ /dev/null @@ -1 +0,0 @@ -x5 Dќb*dni Yl YX%bۖ,`W8 .G&ר-T$vڳp,=:-O}3u:]8慴k{|0 \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 b/manage_externals/test/repos/simple-ext-fork.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 deleted file mode 100644 index 1d27accb58..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 +++ /dev/null @@ -1 +0,0 @@ -x @TeV`p ;vɼ&מi+b%Ns(G7/nǩ-UlGjV&Y+!| \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/objects/f2/68d4e56d067da9bd1d85e55bdc40a8bd2b0bca b/manage_externals/test/repos/simple-ext-fork.git/objects/f2/68d4e56d067da9bd1d85e55bdc40a8bd2b0bca deleted file mode 100644 index 3e945cdeb1..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/objects/f2/68d4e56d067da9bd1d85e55bdc40a8bd2b0bca +++ /dev/null @@ -1 +0,0 @@ -x 1ENӀcf+cFBw-ˁù2v0mzO^4rv7"̉z&sb$>D}D>Nv{ZMI?jps8gӽqڥZqo jfJ{]յOm/3$Q_@H \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext-fork.git/packed-refs b/manage_externals/test/repos/simple-ext-fork.git/packed-refs deleted file mode 100644 index b8f9e86308..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/packed-refs +++ /dev/null @@ -1,5 +0,0 @@ -# pack-refs with: peeled fully-peeled sorted -36418b4e5665956a90725c9a1b5a8e551c5f3d48 refs/heads/feature2 -9b75494003deca69527bb64bcaa352e801611dd2 refs/heads/master -11a76e3d9a67313dec7ce1230852ab5c86352c5c refs/tags/tag1 -^9b75494003deca69527bb64bcaa352e801611dd2 diff --git a/manage_externals/test/repos/simple-ext-fork.git/refs/heads/feature2 b/manage_externals/test/repos/simple-ext-fork.git/refs/heads/feature2 deleted file mode 100644 index d223b0362d..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/refs/heads/feature2 +++ /dev/null @@ -1 +0,0 @@ -f268d4e56d067da9bd1d85e55bdc40a8bd2b0bca diff --git a/manage_externals/test/repos/simple-ext-fork.git/refs/tags/abandoned-feature b/manage_externals/test/repos/simple-ext-fork.git/refs/tags/abandoned-feature deleted file mode 100644 index 8a18bf08e9..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/refs/tags/abandoned-feature +++ /dev/null @@ -1 +0,0 @@ -a42fe9144f5707bc1e9515ce1b44681f7aba6f95 diff --git a/manage_externals/test/repos/simple-ext-fork.git/refs/tags/forked-feature-v1 b/manage_externals/test/repos/simple-ext-fork.git/refs/tags/forked-feature-v1 deleted file mode 100644 index 2764b552d5..0000000000 --- a/manage_externals/test/repos/simple-ext-fork.git/refs/tags/forked-feature-v1 +++ /dev/null @@ -1 +0,0 @@ -8d2b3b35126224c975d23f109aa1e3cbac452989 diff --git a/manage_externals/test/repos/simple-ext.git/HEAD b/manage_externals/test/repos/simple-ext.git/HEAD deleted file mode 100644 index cb089cd89a..0000000000 --- a/manage_externals/test/repos/simple-ext.git/HEAD +++ /dev/null @@ -1 +0,0 @@ -ref: refs/heads/master diff --git a/manage_externals/test/repos/simple-ext.git/config b/manage_externals/test/repos/simple-ext.git/config deleted file mode 100644 index e6da231579..0000000000 --- a/manage_externals/test/repos/simple-ext.git/config +++ /dev/null @@ -1,6 +0,0 @@ -[core] - repositoryformatversion = 0 - filemode = true - bare = true - ignorecase = true - precomposeunicode = true diff --git a/manage_externals/test/repos/simple-ext.git/description b/manage_externals/test/repos/simple-ext.git/description deleted file mode 100644 index 498b267a8c..0000000000 --- a/manage_externals/test/repos/simple-ext.git/description +++ /dev/null @@ -1 +0,0 @@ -Unnamed repository; edit this file 'description' to name the repository. diff --git a/manage_externals/test/repos/simple-ext.git/info/exclude b/manage_externals/test/repos/simple-ext.git/info/exclude deleted file mode 100644 index a5196d1be8..0000000000 --- a/manage_externals/test/repos/simple-ext.git/info/exclude +++ /dev/null @@ -1,6 +0,0 @@ -# git ls-files --others --exclude-from=.git/info/exclude -# Lines that start with '#' are comments. -# For a project mostly in C, the following would be a good set of -# exclude patterns (uncomment them if you want to use them): -# *.[oa] -# *~ diff --git a/manage_externals/test/repos/simple-ext.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f b/manage_externals/test/repos/simple-ext.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f deleted file mode 100644 index ae28c037e5..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/00/fd13e76189f9134b0506b4b8ed3172723b467f and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/09/0e1034746b2c865f7b0280813dbf4061a700e8 b/manage_externals/test/repos/simple-ext.git/objects/09/0e1034746b2c865f7b0280813dbf4061a700e8 deleted file mode 100644 index e5255047bf..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/09/0e1034746b2c865f7b0280813dbf4061a700e8 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 b/manage_externals/test/repos/simple-ext.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 deleted file mode 100644 index 32d6896e3c..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/0b/15e8af3d4615b42314216efeae3fff184046a8 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c b/manage_externals/test/repos/simple-ext.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c deleted file mode 100644 index 564e7bba63..0000000000 --- a/manage_externals/test/repos/simple-ext.git/objects/11/a76e3d9a67313dec7ce1230852ab5c86352c5c +++ /dev/null @@ -1,2 +0,0 @@ -x%K -0@]se&DԛL!l).u.@_J0lM~v:mLiY*/@p W J&)* \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/14/2711fdbbcb8034d7cad6bae6801887b12fe61d b/manage_externals/test/repos/simple-ext.git/objects/14/2711fdbbcb8034d7cad6bae6801887b12fe61d deleted file mode 100644 index acaf7889b4..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/14/2711fdbbcb8034d7cad6bae6801887b12fe61d and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/31/dbcd6de441e671a467ef317146539b7ffabb11 b/manage_externals/test/repos/simple-ext.git/objects/31/dbcd6de441e671a467ef317146539b7ffabb11 deleted file mode 100644 index 0f0db6797f..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/31/dbcd6de441e671a467ef317146539b7ffabb11 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 b/manage_externals/test/repos/simple-ext.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 deleted file mode 100644 index 9da8434f65..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/36/418b4e5665956a90725c9a1b5a8e551c5f3d48 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 b/manage_externals/test/repos/simple-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 deleted file mode 100644 index f65234e17f..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/41/1de5d96ee418c1c55f3e96e6e6e7c06bb95801 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/60/7ec299c17dd285c029edc41a0109e49d441380 b/manage_externals/test/repos/simple-ext.git/objects/60/7ec299c17dd285c029edc41a0109e49d441380 deleted file mode 100644 index 3f6959cc54..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/60/7ec299c17dd285c029edc41a0109e49d441380 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/60/b1cc1a38d63a4bcaa1e767262bbe23dbf9f5f5 b/manage_externals/test/repos/simple-ext.git/objects/60/b1cc1a38d63a4bcaa1e767262bbe23dbf9f5f5 deleted file mode 100644 index 68a86c24ea..0000000000 --- a/manage_externals/test/repos/simple-ext.git/objects/60/b1cc1a38d63a4bcaa1e767262bbe23dbf9f5f5 +++ /dev/null @@ -1,2 +0,0 @@ -xQ {XXdc7Y`ۚo=/3uoPw6YB9MĜc&iښy˦KK9() -Raq$)+| ȧ nMᜟik(|GFkN{]X+, xoC# \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/63/a99393d1baff97ccef967af30380659867b139 b/manage_externals/test/repos/simple-ext.git/objects/63/a99393d1baff97ccef967af30380659867b139 deleted file mode 100644 index efe17af8fd..0000000000 --- a/manage_externals/test/repos/simple-ext.git/objects/63/a99393d1baff97ccef967af30380659867b139 +++ /dev/null @@ -1 +0,0 @@ -x5 B1=W b@bf!7dWE0LVmýc᲏N=09%l~hP?rPkևЏ)]5yB.mg4ns$* \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/95/3256da5612fcd9263590a353bc18c6f224e74f b/manage_externals/test/repos/simple-ext.git/objects/95/3256da5612fcd9263590a353bc18c6f224e74f deleted file mode 100644 index 6187628628..0000000000 --- a/manage_externals/test/repos/simple-ext.git/objects/95/3256da5612fcd9263590a353bc18c6f224e74f +++ /dev/null @@ -1 +0,0 @@ -x ʱ 0 DԚ&HeO$Edd/] lXe\A7h#wTN){Js-k)=jh2^kH$ \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/9b/75494003deca69527bb64bcaa352e801611dd2 b/manage_externals/test/repos/simple-ext.git/objects/9b/75494003deca69527bb64bcaa352e801611dd2 deleted file mode 100644 index ba1b51f515..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/9b/75494003deca69527bb64bcaa352e801611dd2 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/a2/2a5da9119328ea6d693f88861457c07e14ac04 b/manage_externals/test/repos/simple-ext.git/objects/a2/2a5da9119328ea6d693f88861457c07e14ac04 deleted file mode 100644 index fb5feb96c2..0000000000 --- a/manage_externals/test/repos/simple-ext.git/objects/a2/2a5da9119328ea6d693f88861457c07e14ac04 +++ /dev/null @@ -1 +0,0 @@ -x 0 @;ś?Z&nǕnM kt"a.a-Ѡ>rPkSkJ^ \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/b7/692b6d391899680da7b9b6fd8af4c413f06fe7 b/manage_externals/test/repos/simple-ext.git/objects/b7/692b6d391899680da7b9b6fd8af4c413f06fe7 deleted file mode 100644 index 1b3b272442..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/b7/692b6d391899680da7b9b6fd8af4c413f06fe7 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 b/manage_externals/test/repos/simple-ext.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 deleted file mode 100644 index 1d27accb58..0000000000 --- a/manage_externals/test/repos/simple-ext.git/objects/c5/b315915742133dbdfbeed0753e481b55c1d364 +++ /dev/null @@ -1 +0,0 @@ -x @TeV`p ;vɼ&מi+b%Ns(G7/nǩ-UlGjV&Y+!| \ No newline at end of file diff --git a/manage_externals/test/repos/simple-ext.git/objects/d1/163870d19c3dee34fada3a76b785cfa2a8424b b/manage_externals/test/repos/simple-ext.git/objects/d1/163870d19c3dee34fada3a76b785cfa2a8424b deleted file mode 100644 index 04e760363a..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/d1/163870d19c3dee34fada3a76b785cfa2a8424b and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/d8/ed2f33179d751937f8fde2e33921e4827babf4 b/manage_externals/test/repos/simple-ext.git/objects/d8/ed2f33179d751937f8fde2e33921e4827babf4 deleted file mode 100644 index f08ae820c9..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/d8/ed2f33179d751937f8fde2e33921e4827babf4 and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/objects/df/312890f93ba4d2c694208599b665c4a08afeff b/manage_externals/test/repos/simple-ext.git/objects/df/312890f93ba4d2c694208599b665c4a08afeff deleted file mode 100644 index 4018ea5914..0000000000 Binary files a/manage_externals/test/repos/simple-ext.git/objects/df/312890f93ba4d2c694208599b665c4a08afeff and /dev/null differ diff --git a/manage_externals/test/repos/simple-ext.git/refs/heads/feature2 b/manage_externals/test/repos/simple-ext.git/refs/heads/feature2 deleted file mode 100644 index 01a0dd6e23..0000000000 --- a/manage_externals/test/repos/simple-ext.git/refs/heads/feature2 +++ /dev/null @@ -1 +0,0 @@ -36418b4e5665956a90725c9a1b5a8e551c5f3d48 diff --git a/manage_externals/test/repos/simple-ext.git/refs/heads/feature3 b/manage_externals/test/repos/simple-ext.git/refs/heads/feature3 deleted file mode 100644 index dd24079fce..0000000000 --- a/manage_externals/test/repos/simple-ext.git/refs/heads/feature3 +++ /dev/null @@ -1 +0,0 @@ -090e1034746b2c865f7b0280813dbf4061a700e8 diff --git a/manage_externals/test/repos/simple-ext.git/refs/heads/master b/manage_externals/test/repos/simple-ext.git/refs/heads/master deleted file mode 100644 index adf1ccb002..0000000000 --- a/manage_externals/test/repos/simple-ext.git/refs/heads/master +++ /dev/null @@ -1 +0,0 @@ -607ec299c17dd285c029edc41a0109e49d441380 diff --git a/manage_externals/test/repos/simple-ext.git/refs/tags/tag1 b/manage_externals/test/repos/simple-ext.git/refs/tags/tag1 deleted file mode 100644 index ee595be8bd..0000000000 --- a/manage_externals/test/repos/simple-ext.git/refs/tags/tag1 +++ /dev/null @@ -1 +0,0 @@ -11a76e3d9a67313dec7ce1230852ab5c86352c5c diff --git a/manage_externals/test/repos/simple-ext.git/refs/tags/tag2 b/manage_externals/test/repos/simple-ext.git/refs/tags/tag2 deleted file mode 100644 index 4160b6c494..0000000000 --- a/manage_externals/test/repos/simple-ext.git/refs/tags/tag2 +++ /dev/null @@ -1 +0,0 @@ -b7692b6d391899680da7b9b6fd8af4c413f06fe7 diff --git a/manage_externals/test/requirements.txt b/manage_externals/test/requirements.txt deleted file mode 100644 index d66f6f1e67..0000000000 --- a/manage_externals/test/requirements.txt +++ /dev/null @@ -1,5 +0,0 @@ -pylint>=1.7.0 -autopep8>=1.3.0 -coverage>=4.4.0 -coveralls>=1.2.0 -sphinx>=1.6.0 diff --git a/manage_externals/test/test_sys_checkout.py b/manage_externals/test/test_sys_checkout.py deleted file mode 100644 index df726f2b70..0000000000 --- a/manage_externals/test/test_sys_checkout.py +++ /dev/null @@ -1,1919 +0,0 @@ -#!/usr/bin/env python - -"""Unit test driver for checkout_externals - -Note: this script assume the path to the manic and -checkout_externals module is already in the python path. This is -usually handled by the makefile. If you call it directly, you may need -to adjust your path. - -NOTE(bja, 2017-11) If a test fails, we want to keep the repo for that -test. But the tests will keep running, so we need a unique name. Also, -tearDown is always called after each test. I haven't figured out how -to determine if an assertion failed and whether it is safe to clean up -the test repos. - -So the solution is: - -* assign a unique id to each test repo. - -* never cleanup during the run. - -* Erase any existing repos at the begining of the module in -setUpModule. - -""" - -# NOTE(bja, 2017-11) pylint complains that the module is too big, but -# I'm still working on how to break up the tests and still have the -# temporary directory be preserved.... -# pylint: disable=too-many-lines - - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import logging -import os -import os.path -import shutil -import unittest - -from manic.externals_description import ExternalsDescription -from manic.externals_description import DESCRIPTION_SECTION, VERSION_ITEM -from manic.externals_description import git_submodule_status -from manic.externals_status import ExternalStatus -from manic.repository_git import GitRepository -from manic.utils import printlog, execute_subprocess -from manic.global_constants import LOCAL_PATH_INDICATOR, VERBOSITY_DEFAULT -from manic.global_constants import LOG_FILE_NAME -from manic import checkout - -# ConfigParser was renamed in python2 to configparser. In python2, -# ConfigParser returns byte strings, str, instead of unicode. We need -# unicode to be compatible with xml and json parser and python3. -try: - # python2 - from ConfigParser import SafeConfigParser as config_parser -except ImportError: - # python3 - from configparser import ConfigParser as config_parser - -# --------------------------------------------------------------------- -# -# Global constants -# -# --------------------------------------------------------------------- - -# environment variable names -MANIC_TEST_BARE_REPO_ROOT = 'MANIC_TEST_BARE_REPO_ROOT' -MANIC_TEST_TMP_REPO_ROOT = 'MANIC_TEST_TMP_REPO_ROOT' - -# directory names -TMP_REPO_DIR_NAME = 'tmp' -BARE_REPO_ROOT_NAME = 'repos' -CONTAINER_REPO_NAME = 'container.git' -MIXED_REPO_NAME = 'mixed-cont-ext.git' -SIMPLE_REPO_NAME = 'simple-ext.git' -SIMPLE_FORK_NAME = 'simple-ext-fork.git' -SIMPLE_LOCAL_ONLY_NAME = '.' -ERROR_REPO_NAME = 'error' -EXTERNALS_NAME = 'externals' -SUB_EXTERNALS_PATH = 'src' -CFG_NAME = 'externals.cfg' -CFG_SUB_NAME = 'sub-externals.cfg' -README_NAME = 'readme.txt' -REMOTE_BRANCH_FEATURE2 = 'feature2' - -SVN_TEST_REPO = 'https://github.com/escomp/cesm' - -# Disable too-many-public-methods error -# pylint: disable=R0904 - -def setUpModule(): # pylint: disable=C0103 - """Setup for all tests in this module. It is called once per module! - """ - logging.basicConfig(filename=LOG_FILE_NAME, - format='%(levelname)s : %(asctime)s : %(message)s', - datefmt='%Y-%m-%d %H:%M:%S', - level=logging.DEBUG) - repo_root = os.path.join(os.getcwd(), TMP_REPO_DIR_NAME) - repo_root = os.path.abspath(repo_root) - # delete if it exists from previous runs - try: - shutil.rmtree(repo_root) - except BaseException: - pass - # create clean dir for this run - os.mkdir(repo_root) - # set into the environment so var will be expanded in externals - # filess when executables are run - os.environ[MANIC_TEST_TMP_REPO_ROOT] = repo_root - - -class GenerateExternalsDescriptionCfgV1(object): - """Class to provide building blocks to create - ExternalsDescriptionCfgV1 files. - - Includes predefined files used in tests. - - """ - - def __init__(self): - self._schema_version = '1.1.0' - self._config = None - - def container_full(self, dest_dir): - """Create the full container config file with simple and mixed use - externals - - """ - self.create_config() - self.create_section(SIMPLE_REPO_NAME, 'simp_tag', - tag='tag1') - - self.create_section(SIMPLE_REPO_NAME, 'simp_branch', - branch=REMOTE_BRANCH_FEATURE2) - - self.create_section(SIMPLE_REPO_NAME, 'simp_opt', - tag='tag1', required=False) - - self.create_section(MIXED_REPO_NAME, 'mixed_req', - branch='master', externals=CFG_SUB_NAME) - - self.write_config(dest_dir) - - def container_simple_required(self, dest_dir): - """Create a container externals file with only simple externals. - - """ - self.create_config() - self.create_section(SIMPLE_REPO_NAME, 'simp_tag', - tag='tag1') - - self.create_section(SIMPLE_REPO_NAME, 'simp_branch', - branch=REMOTE_BRANCH_FEATURE2) - - self.create_section(SIMPLE_REPO_NAME, 'simp_hash', - ref_hash='60b1cc1a38d63') - - self.write_config(dest_dir) - - def container_simple_optional(self, dest_dir): - """Create a container externals file with optional simple externals - - """ - self.create_config() - self.create_section(SIMPLE_REPO_NAME, 'simp_req', - tag='tag1') - - self.create_section(SIMPLE_REPO_NAME, 'simp_opt', - tag='tag1', required=False) - - self.write_config(dest_dir) - - def container_simple_svn(self, dest_dir): - """Create a container externals file with only simple externals. - - """ - self.create_config() - self.create_section(SIMPLE_REPO_NAME, 'simp_tag', tag='tag1') - - self.create_svn_external('svn_branch', branch='trunk') - self.create_svn_external('svn_tag', tag='tags/cesm2.0.beta07') - - self.write_config(dest_dir) - - def container_sparse(self, dest_dir): - """Create a container with a full external and a sparse external - - """ - # Create a file for a sparse pattern match - sparse_filename = 'sparse_checkout' - with open(os.path.join(dest_dir, sparse_filename), 'w') as sfile: - sfile.write('readme.txt') - - self.create_config() - self.create_section(SIMPLE_REPO_NAME, 'simp_tag', - tag='tag2') - - sparse_relpath = '../../{}'.format(sparse_filename) - self.create_section(SIMPLE_REPO_NAME, 'simp_sparse', - tag='tag2', sparse=sparse_relpath) - - self.write_config(dest_dir) - - def mixed_simple_base(self, dest_dir): - """Create a mixed-use base externals file with only simple externals. - - """ - self.create_config() - self.create_section_ext_only('mixed_base') - self.create_section(SIMPLE_REPO_NAME, 'simp_tag', - tag='tag1') - - self.create_section(SIMPLE_REPO_NAME, 'simp_branch', - branch=REMOTE_BRANCH_FEATURE2) - - self.create_section(SIMPLE_REPO_NAME, 'simp_hash', - ref_hash='60b1cc1a38d63') - - self.write_config(dest_dir) - - def mixed_simple_sub(self, dest_dir): - """Create a mixed-use sub externals file with only simple externals. - - """ - self.create_config() - self.create_section(SIMPLE_REPO_NAME, 'simp_tag', - tag='tag1', path=SUB_EXTERNALS_PATH) - - self.create_section(SIMPLE_REPO_NAME, 'simp_branch', - branch=REMOTE_BRANCH_FEATURE2, - path=SUB_EXTERNALS_PATH) - - self.write_config(dest_dir, filename=CFG_SUB_NAME) - - def write_config(self, dest_dir, filename=CFG_NAME): - """Write the configuration file to disk - - """ - dest_path = os.path.join(dest_dir, filename) - with open(dest_path, 'w') as configfile: - self._config.write(configfile) - - def create_config(self): - """Create an config object and add the required metadata section - - """ - self._config = config_parser() - self.create_metadata() - - def create_metadata(self): - """Create the metadata section of the config file - """ - self._config.add_section(DESCRIPTION_SECTION) - - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, - self._schema_version) - - def create_section(self, repo_type, name, tag='', branch='', - ref_hash='', required=True, path=EXTERNALS_NAME, - externals='', repo_path=None, from_submodule=False, - sparse=''): - # pylint: disable=too-many-branches - """Create a config section with autofilling some items and handling - optional items. - - """ - # pylint: disable=R0913 - self._config.add_section(name) - if not from_submodule: - self._config.set(name, ExternalsDescription.PATH, - os.path.join(path, name)) - - self._config.set(name, ExternalsDescription.PROTOCOL, - ExternalsDescription.PROTOCOL_GIT) - - # from_submodules is incompatible with some other options, turn them off - if (from_submodule and - ((repo_path is not None) or tag or ref_hash or branch)): - printlog('create_section: "from_submodule" is incompatible with ' - '"repo_url", "tag", "hash", and "branch" options;\n' - 'Ignoring those options for {}'.format(name)) - repo_url = None - tag = '' - ref_hash = '' - branch = '' - - if repo_path is not None: - repo_url = repo_path - else: - repo_url = os.path.join('${MANIC_TEST_BARE_REPO_ROOT}', repo_type) - - if not from_submodule: - self._config.set(name, ExternalsDescription.REPO_URL, repo_url) - - self._config.set(name, ExternalsDescription.REQUIRED, str(required)) - - if tag: - self._config.set(name, ExternalsDescription.TAG, tag) - - if branch: - self._config.set(name, ExternalsDescription.BRANCH, branch) - - if ref_hash: - self._config.set(name, ExternalsDescription.HASH, ref_hash) - - if externals: - self._config.set(name, ExternalsDescription.EXTERNALS, externals) - - if sparse: - self._config.set(name, ExternalsDescription.SPARSE, sparse) - - if from_submodule: - self._config.set(name, ExternalsDescription.SUBMODULE, "True") - - def create_section_ext_only(self, name, - required=True, externals=CFG_SUB_NAME): - """Create a config section with autofilling some items and handling - optional items. - - """ - # pylint: disable=R0913 - self._config.add_section(name) - self._config.set(name, ExternalsDescription.PATH, LOCAL_PATH_INDICATOR) - - self._config.set(name, ExternalsDescription.PROTOCOL, - ExternalsDescription.PROTOCOL_EXTERNALS_ONLY) - - self._config.set(name, ExternalsDescription.REPO_URL, - LOCAL_PATH_INDICATOR) - - self._config.set(name, ExternalsDescription.REQUIRED, str(required)) - - if externals: - self._config.set(name, ExternalsDescription.EXTERNALS, externals) - - def create_svn_external(self, name, tag='', branch=''): - """Create a config section for an svn repository. - - """ - self._config.add_section(name) - self._config.set(name, ExternalsDescription.PATH, - os.path.join(EXTERNALS_NAME, name)) - - self._config.set(name, ExternalsDescription.PROTOCOL, - ExternalsDescription.PROTOCOL_SVN) - - self._config.set(name, ExternalsDescription.REPO_URL, SVN_TEST_REPO) - - self._config.set(name, ExternalsDescription.REQUIRED, str(True)) - - if tag: - self._config.set(name, ExternalsDescription.TAG, tag) - - if branch: - self._config.set(name, ExternalsDescription.BRANCH, branch) - - @staticmethod - def create_branch(dest_dir, repo_name, branch, with_commit=False): - """Update a repository branch, and potentially the remote. - """ - # pylint: disable=R0913 - cwd = os.getcwd() - repo_root = os.path.join(dest_dir, EXTERNALS_NAME) - repo_root = os.path.join(repo_root, repo_name) - os.chdir(repo_root) - cmd = ['git', 'checkout', '-b', branch, ] - execute_subprocess(cmd) - if with_commit: - msg = 'start work on {0}'.format(branch) - with open(README_NAME, 'a') as handle: - handle.write(msg) - cmd = ['git', 'add', README_NAME, ] - execute_subprocess(cmd) - cmd = ['git', 'commit', '-m', msg, ] - execute_subprocess(cmd) - os.chdir(cwd) - - @staticmethod - def create_commit(dest_dir, repo_name, local_tracking_branch=None): - """Make a commit on whatever is currently checked out. - - This is used to test sync state changes from local commits on - detached heads and tracking branches. - - """ - cwd = os.getcwd() - repo_root = os.path.join(dest_dir, EXTERNALS_NAME) - repo_root = os.path.join(repo_root, repo_name) - os.chdir(repo_root) - if local_tracking_branch: - cmd = ['git', 'checkout', '-b', local_tracking_branch, ] - execute_subprocess(cmd) - - msg = 'work on great new feature!' - with open(README_NAME, 'a') as handle: - handle.write(msg) - cmd = ['git', 'add', README_NAME, ] - execute_subprocess(cmd) - cmd = ['git', 'commit', '-m', msg, ] - execute_subprocess(cmd) - os.chdir(cwd) - - def update_branch(self, dest_dir, name, branch, repo_type=None, - filename=CFG_NAME): - """Update a repository branch, and potentially the remote. - """ - # pylint: disable=R0913 - self._config.set(name, ExternalsDescription.BRANCH, branch) - - if repo_type: - if repo_type == SIMPLE_LOCAL_ONLY_NAME: - repo_url = SIMPLE_LOCAL_ONLY_NAME - else: - repo_url = os.path.join('${MANIC_TEST_BARE_REPO_ROOT}', - repo_type) - self._config.set(name, ExternalsDescription.REPO_URL, repo_url) - - try: - # remove the tag if it existed - self._config.remove_option(name, ExternalsDescription.TAG) - except BaseException: - pass - - self.write_config(dest_dir, filename) - - def update_svn_branch(self, dest_dir, name, branch, filename=CFG_NAME): - """Update a repository branch, and potentially the remote. - """ - # pylint: disable=R0913 - self._config.set(name, ExternalsDescription.BRANCH, branch) - - try: - # remove the tag if it existed - self._config.remove_option(name, ExternalsDescription.TAG) - except BaseException: - pass - - self.write_config(dest_dir, filename) - - def update_tag(self, dest_dir, name, tag, repo_type=None, - filename=CFG_NAME, remove_branch=True): - """Update a repository tag, and potentially the remote - - NOTE(bja, 2017-11) remove_branch=False should result in an - overspecified external with both a branch and tag. This is - used for error condition testing. - - """ - # pylint: disable=R0913 - self._config.set(name, ExternalsDescription.TAG, tag) - - if repo_type: - repo_url = os.path.join('${MANIC_TEST_BARE_REPO_ROOT}', repo_type) - self._config.set(name, ExternalsDescription.REPO_URL, repo_url) - - try: - # remove the branch if it existed - if remove_branch: - self._config.remove_option(name, ExternalsDescription.BRANCH) - except BaseException: - pass - - self.write_config(dest_dir, filename) - - def update_underspecify_branch_tag(self, dest_dir, name, - filename=CFG_NAME): - """Update a repository protocol, and potentially the remote - """ - # pylint: disable=R0913 - try: - # remove the branch if it existed - self._config.remove_option(name, ExternalsDescription.BRANCH) - except BaseException: - pass - - try: - # remove the tag if it existed - self._config.remove_option(name, ExternalsDescription.TAG) - except BaseException: - pass - - self.write_config(dest_dir, filename) - - def update_underspecify_remove_url(self, dest_dir, name, - filename=CFG_NAME): - """Update a repository protocol, and potentially the remote - """ - # pylint: disable=R0913 - try: - # remove the repo url if it existed - self._config.remove_option(name, ExternalsDescription.REPO_URL) - except BaseException: - pass - - self.write_config(dest_dir, filename) - - def update_protocol(self, dest_dir, name, protocol, repo_type=None, - filename=CFG_NAME): - """Update a repository protocol, and potentially the remote - """ - # pylint: disable=R0913 - self._config.set(name, ExternalsDescription.PROTOCOL, protocol) - - if repo_type: - repo_url = os.path.join('${MANIC_TEST_BARE_REPO_ROOT}', repo_type) - self._config.set(name, ExternalsDescription.REPO_URL, repo_url) - - self.write_config(dest_dir, filename) - - -class BaseTestSysCheckout(unittest.TestCase): - """Base class of reusable systems level test setup for - checkout_externals - - """ - # NOTE(bja, 2017-11) pylint complains about long method names, but - # it is hard to differentiate tests without making them more - # cryptic. - # pylint: disable=invalid-name - - status_args = ['--status'] - checkout_args = [] - optional_args = ['--optional'] - verbose_args = ['--status', '--verbose'] - - def setUp(self): - """Setup for all individual checkout_externals tests - """ - # directory we want to return to after the test system and - # checkout_externals are done cd'ing all over the place. - self._return_dir = os.getcwd() - - self._test_id = self.id().split('.')[-1] - - # path to the executable - self._checkout = os.path.join('../checkout_externals') - self._checkout = os.path.abspath(self._checkout) - - # directory where we have test repositories - self._bare_root = os.path.join(os.getcwd(), BARE_REPO_ROOT_NAME) - self._bare_root = os.path.abspath(self._bare_root) - - # set into the environment so var will be expanded in externals files - os.environ[MANIC_TEST_BARE_REPO_ROOT] = self._bare_root - - # set the input file generator - self._generator = GenerateExternalsDescriptionCfgV1() - # set the input file generator for secondary externals - self._sub_generator = GenerateExternalsDescriptionCfgV1() - - def tearDown(self): - """Tear down for individual tests - """ - # remove the env var we added in setup - del os.environ[MANIC_TEST_BARE_REPO_ROOT] - - # return to our common starting point - os.chdir(self._return_dir) - - def setup_test_repo(self, parent_repo_name, dest_dir_in=None): - """Setup the paths and clone the base test repo - - """ - # unique repo for this test - test_dir_name = self._test_id - print("Test repository name: {0}".format(test_dir_name)) - - parent_repo_dir = os.path.join(self._bare_root, parent_repo_name) - if dest_dir_in is None: - dest_dir = os.path.join(os.environ[MANIC_TEST_TMP_REPO_ROOT], - test_dir_name) - else: - dest_dir = dest_dir_in - - # pylint: disable=W0212 - GitRepository._git_clone(parent_repo_dir, dest_dir, VERBOSITY_DEFAULT) - return dest_dir - - @staticmethod - def _add_file_to_repo(under_test_dir, filename, tracked): - """Add a file to the repository so we can put it into a dirty state - - """ - cwd = os.getcwd() - os.chdir(under_test_dir) - with open(filename, 'w') as tmp: - tmp.write('Hello, world!') - - if tracked: - # NOTE(bja, 2018-01) brittle hack to obtain repo dir and - # file name - path_data = filename.split('/') - repo_dir = os.path.join(path_data[0], path_data[1]) - os.chdir(repo_dir) - tracked_file = path_data[2] - cmd = ['git', 'add', tracked_file] - execute_subprocess(cmd) - - os.chdir(cwd) - - @staticmethod - def execute_cmd_in_dir(under_test_dir, args): - """Extecute the checkout command in the appropriate repo dir with the - specified additional args - - Note that we are calling the command line processing and main - routines and not using a subprocess call so that we get code - coverage results! - - """ - cwd = os.getcwd() - checkout_path = os.path.abspath('{0}/../../checkout_externals') - os.chdir(under_test_dir) - cmdline = ['--externals', CFG_NAME, ] - cmdline += args - repo_root = 'MANIC_TEST_BARE_REPO_ROOT={root}'.format( - root=os.environ[MANIC_TEST_BARE_REPO_ROOT]) - manual_cmd = ('Test cmd:\npushd {cwd}; {env} {checkout} {args}'.format( - cwd=under_test_dir, env=repo_root, checkout=checkout_path, - args=' '.join(cmdline))) - printlog(manual_cmd) - options = checkout.commandline_arguments(cmdline) - overall_status, tree_status = checkout.main(options) - os.chdir(cwd) - return overall_status, tree_status - - # ---------------------------------------------------------------- - # - # Check results for generic perturbation of states - # - # ---------------------------------------------------------------- - def _check_generic_empty_default_required(self, tree, name): - self.assertEqual(tree[name].sync_state, ExternalStatus.EMPTY) - self.assertEqual(tree[name].clean_state, ExternalStatus.DEFAULT) - self.assertEqual(tree[name].source_type, ExternalStatus.MANAGED) - - def _check_generic_ok_clean_required(self, tree, name): - self.assertEqual(tree[name].sync_state, ExternalStatus.STATUS_OK) - self.assertEqual(tree[name].clean_state, ExternalStatus.STATUS_OK) - self.assertEqual(tree[name].source_type, ExternalStatus.MANAGED) - - def _check_generic_ok_dirty_required(self, tree, name): - self.assertEqual(tree[name].sync_state, ExternalStatus.STATUS_OK) - self.assertEqual(tree[name].clean_state, ExternalStatus.DIRTY) - self.assertEqual(tree[name].source_type, ExternalStatus.MANAGED) - - def _check_generic_modified_ok_required(self, tree, name): - self.assertEqual(tree[name].sync_state, ExternalStatus.MODEL_MODIFIED) - self.assertEqual(tree[name].clean_state, ExternalStatus.STATUS_OK) - self.assertEqual(tree[name].source_type, ExternalStatus.MANAGED) - - def _check_generic_empty_default_optional(self, tree, name): - self.assertEqual(tree[name].sync_state, ExternalStatus.EMPTY) - self.assertEqual(tree[name].clean_state, ExternalStatus.DEFAULT) - self.assertEqual(tree[name].source_type, ExternalStatus.OPTIONAL) - - def _check_generic_ok_clean_optional(self, tree, name): - self.assertEqual(tree[name].sync_state, ExternalStatus.STATUS_OK) - self.assertEqual(tree[name].clean_state, ExternalStatus.STATUS_OK) - self.assertEqual(tree[name].source_type, ExternalStatus.OPTIONAL) - - # ---------------------------------------------------------------- - # - # Check results for individual named externals - # - # ---------------------------------------------------------------- - def _check_simple_tag_empty(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_tag'.format(directory) - self._check_generic_empty_default_required(tree, name) - - def _check_simple_tag_ok(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_tag'.format(directory) - self._check_generic_ok_clean_required(tree, name) - - def _check_simple_tag_dirty(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_tag'.format(directory) - self._check_generic_ok_dirty_required(tree, name) - - def _check_simple_tag_modified(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_tag'.format(directory) - self._check_generic_modified_ok_required(tree, name) - - def _check_simple_branch_empty(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_branch'.format(directory) - self._check_generic_empty_default_required(tree, name) - - def _check_simple_branch_ok(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_branch'.format(directory) - self._check_generic_ok_clean_required(tree, name) - - def _check_simple_branch_modified(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_branch'.format(directory) - self._check_generic_modified_ok_required(tree, name) - - def _check_simple_hash_empty(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_hash'.format(directory) - self._check_generic_empty_default_required(tree, name) - - def _check_simple_hash_ok(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_hash'.format(directory) - self._check_generic_ok_clean_required(tree, name) - - def _check_simple_hash_modified(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_hash'.format(directory) - self._check_generic_modified_ok_required(tree, name) - - def _check_simple_req_empty(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_req'.format(directory) - self._check_generic_empty_default_required(tree, name) - - def _check_simple_req_ok(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_req'.format(directory) - self._check_generic_ok_clean_required(tree, name) - - def _check_simple_opt_empty(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_opt'.format(directory) - self._check_generic_empty_default_optional(tree, name) - - def _check_simple_opt_ok(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_opt'.format(directory) - self._check_generic_ok_clean_optional(tree, name) - - def _check_mixed_ext_branch_empty(self, tree, directory=EXTERNALS_NAME): - name = './{0}/mixed_req'.format(directory) - self._check_generic_empty_default_required(tree, name) - - def _check_mixed_ext_branch_ok(self, tree, directory=EXTERNALS_NAME): - name = './{0}/mixed_req'.format(directory) - self._check_generic_ok_clean_required(tree, name) - - def _check_mixed_ext_branch_modified(self, tree, directory=EXTERNALS_NAME): - name = './{0}/mixed_req'.format(directory) - self._check_generic_modified_ok_required(tree, name) - - def _check_simple_sparse_empty(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_sparse'.format(directory) - self._check_generic_empty_default_required(tree, name) - - def _check_simple_sparse_ok(self, tree, directory=EXTERNALS_NAME): - name = './{0}/simp_sparse'.format(directory) - self._check_generic_ok_clean_required(tree, name) - - # ---------------------------------------------------------------- - # - # Check results for groups of externals under specific conditions - # - # ---------------------------------------------------------------- - def _check_container_simple_required_pre_checkout(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_empty(tree) - self._check_simple_branch_empty(tree) - self._check_simple_hash_empty(tree) - - def _check_container_simple_required_checkout(self, overall, tree): - # Note, this is the internal tree status just before checkout - self.assertEqual(overall, 0) - self._check_simple_tag_empty(tree) - self._check_simple_branch_empty(tree) - self._check_simple_hash_empty(tree) - - def _check_container_simple_required_post_checkout(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_ok(tree) - self._check_simple_branch_ok(tree) - self._check_simple_hash_ok(tree) - - def _check_container_simple_required_out_of_sync(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_modified(tree) - self._check_simple_branch_modified(tree) - self._check_simple_hash_modified(tree) - - def _check_container_simple_optional_pre_checkout(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_req_empty(tree) - self._check_simple_opt_empty(tree) - - def _check_container_simple_optional_checkout(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_req_empty(tree) - self._check_simple_opt_empty(tree) - - def _check_container_simple_optional_post_checkout(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_req_ok(tree) - self._check_simple_opt_empty(tree) - - def _check_container_simple_optional_post_optional(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_req_ok(tree) - self._check_simple_opt_ok(tree) - - def _check_container_simple_required_sb_modified(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_ok(tree) - self._check_simple_branch_modified(tree) - self._check_simple_hash_ok(tree) - - def _check_container_simple_optional_st_dirty(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_dirty(tree) - self._check_simple_branch_ok(tree) - - def _check_container_full_pre_checkout(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_empty(tree) - self._check_simple_branch_empty(tree) - self._check_simple_opt_empty(tree) - self._check_mixed_ext_branch_required_pre_checkout(overall, tree) - - def _check_container_component_post_checkout(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_opt_ok(tree) - self._check_simple_tag_empty(tree) - self._check_simple_branch_empty(tree) - - def _check_container_component_post_checkout2(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_opt_ok(tree) - self._check_simple_tag_empty(tree) - self._check_simple_branch_ok(tree) - - def _check_container_full_post_checkout(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_ok(tree) - self._check_simple_branch_ok(tree) - self._check_simple_opt_empty(tree) - self._check_mixed_ext_branch_required_post_checkout(overall, tree) - - def _check_container_full_pre_checkout_ext_change(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_ok(tree) - self._check_simple_branch_ok(tree) - self._check_simple_opt_empty(tree) - self._check_mixed_ext_branch_required_pre_checkout_ext_change( - overall, tree) - - def _check_container_full_post_checkout_subext_modified( - self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_ok(tree) - self._check_simple_branch_ok(tree) - self._check_simple_opt_empty(tree) - self._check_mixed_ext_branch_required_post_checkout_subext_modified( - overall, tree) - - def _check_mixed_ext_branch_required_pre_checkout(self, overall, tree): - # Note, this is the internal tree status just before checkout - self.assertEqual(overall, 0) - self._check_mixed_ext_branch_empty(tree, directory=EXTERNALS_NAME) - # NOTE: externals/mixed_req/src should not exist in the tree - # since this is the status before checkout of mixed_req. - - def _check_mixed_ext_branch_required_post_checkout(self, overall, tree): - # Note, this is the internal tree status just before checkout - self.assertEqual(overall, 0) - self._check_mixed_ext_branch_ok(tree, directory=EXTERNALS_NAME) - check_dir = "{0}/{1}/{2}".format(EXTERNALS_NAME, "mixed_req", - SUB_EXTERNALS_PATH) - self._check_simple_branch_ok(tree, directory=check_dir) - - def _check_mixed_ext_branch_required_pre_checkout_ext_change( - self, overall, tree): - # Note, this is the internal tree status just after change the - # externals description file, but before checkout - self.assertEqual(overall, 0) - self._check_mixed_ext_branch_modified(tree, directory=EXTERNALS_NAME) - check_dir = "{0}/{1}/{2}".format(EXTERNALS_NAME, "mixed_req", - SUB_EXTERNALS_PATH) - self._check_simple_branch_ok(tree, directory=check_dir) - - def _check_mixed_ext_branch_required_post_checkout_subext_modified( - self, overall, tree): - # Note, this is the internal tree status just after change the - # externals description file, but before checkout - self.assertEqual(overall, 0) - self._check_mixed_ext_branch_ok(tree, directory=EXTERNALS_NAME) - check_dir = "{0}/{1}/{2}".format(EXTERNALS_NAME, "mixed_req", - SUB_EXTERNALS_PATH) - self._check_simple_branch_modified(tree, directory=check_dir) - - def _check_mixed_cont_simple_required_pre_checkout(self, overall, tree): - # Note, this is the internal tree status just before checkout - self.assertEqual(overall, 0) - self._check_simple_tag_empty(tree, directory=EXTERNALS_NAME) - self._check_simple_branch_empty(tree, directory=EXTERNALS_NAME) - self._check_simple_branch_empty(tree, directory=SUB_EXTERNALS_PATH) - - def _check_mixed_cont_simple_required_checkout(self, overall, tree): - # Note, this is the internal tree status just before checkout - self.assertEqual(overall, 0) - self._check_simple_tag_empty(tree, directory=EXTERNALS_NAME) - self._check_simple_branch_empty(tree, directory=EXTERNALS_NAME) - self._check_simple_branch_empty(tree, directory=SUB_EXTERNALS_PATH) - - def _check_mixed_cont_simple_required_post_checkout(self, overall, tree): - # Note, this is the internal tree status just before checkout - self.assertEqual(overall, 0) - self._check_simple_tag_ok(tree, directory=EXTERNALS_NAME) - self._check_simple_branch_ok(tree, directory=EXTERNALS_NAME) - self._check_simple_branch_ok(tree, directory=SUB_EXTERNALS_PATH) - - def _check_container_sparse_pre_checkout(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_empty(tree) - self._check_simple_sparse_empty(tree) - - def _check_container_sparse_post_checkout(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_ok(tree) - self._check_simple_sparse_ok(tree) - - def _check_file_exists(self, repo_dir, pathname): - "Check that exists in " - self.assertTrue(os.path.exists(os.path.join(repo_dir, pathname))) - - def _check_file_absent(self, repo_dir, pathname): - "Check that does not exist in " - self.assertFalse(os.path.exists(os.path.join(repo_dir, pathname))) - -class TestSysCheckout(BaseTestSysCheckout): - """Run systems level tests of checkout_externals - - """ - # NOTE(bja, 2017-11) pylint complains about long method names, but - # it is hard to differentiate tests without making them more - # cryptic. - # pylint: disable=invalid-name - - # ---------------------------------------------------------------- - # - # Run systems tests - # - # ---------------------------------------------------------------- - def test_container_simple_required(self): - """Verify that a container with simple subrepos - generates the correct initial status. - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # status of empty repo - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_pre_checkout(overall, tree) - - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_required_checkout(overall, tree) - - # status clean checked out - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_post_checkout(overall, tree) - - def test_container_simple_optional(self): - """Verify that container with an optional simple subrepos - generates the correct initial status. - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_optional(under_test_dir) - - # check status of empty repo - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_optional_pre_checkout(overall, tree) - - # checkout required - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_optional_checkout(overall, tree) - - # status - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_optional_post_checkout(overall, tree) - - # checkout optional - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.optional_args) - self._check_container_simple_optional_post_checkout(overall, tree) - - # status - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_optional_post_optional(overall, tree) - - def test_container_simple_verbose(self): - """Verify that container with simple subrepos runs with verbose status - output and generates the correct initial status. - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_required_checkout(overall, tree) - - # check verbose status - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.verbose_args) - self._check_container_simple_required_post_checkout(overall, tree) - - def test_container_simple_dirty(self): - """Verify that a container with simple subrepos - and a dirty status exits gracefully. - - """ - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_required_checkout(overall, tree) - - # add a file to the repo - tracked = True - self._add_file_to_repo(under_test_dir, 'externals/simp_tag/tmp.txt', - tracked) - - # checkout: pre-checkout status should be dirty, did not - # modify working copy. - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_optional_st_dirty(overall, tree) - - # verify status is still dirty - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_optional_st_dirty(overall, tree) - - def test_container_simple_untracked(self): - """Verify that a container with simple subrepos and a untracked files - is not considered 'dirty' and will attempt an update. - - """ - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_required_checkout(overall, tree) - - # add a file to the repo - tracked = False - self._add_file_to_repo(under_test_dir, 'externals/simp_tag/tmp.txt', - tracked) - - # checkout: pre-checkout status should be clean, ignoring the - # untracked file. - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_required_post_checkout(overall, tree) - - # verify status is still clean - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_post_checkout(overall, tree) - - def test_container_simple_detached_sync(self): - """Verify that a container with simple subrepos generates the correct - out of sync status when making commits from a detached head - state. - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # status of empty repo - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_pre_checkout(overall, tree) - - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_required_checkout(overall, tree) - - # make a commit on the detached head of the tag and hash externals - self._generator.create_commit(under_test_dir, 'simp_tag') - self._generator.create_commit(under_test_dir, 'simp_hash') - self._generator.create_commit(under_test_dir, 'simp_branch') - - # status of repo, branch, tag and hash should all be out of sync! - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_out_of_sync(overall, tree) - - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - # same pre-checkout out of sync status - self._check_container_simple_required_out_of_sync(overall, tree) - - # now status should be in-sync - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_post_checkout(overall, tree) - - def test_container_remote_branch(self): - """Verify that a container with remote branch change works - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_required_checkout(overall, tree) - - # update the config file to point to a different remote with - # the same branch - self._generator.update_branch(under_test_dir, 'simp_branch', - REMOTE_BRANCH_FEATURE2, SIMPLE_FORK_NAME) - - # status of simp_branch should be out of sync - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_sb_modified(overall, tree) - - # checkout new externals - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_required_sb_modified(overall, tree) - - # status should be synced - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_post_checkout(overall, tree) - - def test_container_remote_tag_same_branch(self): - """Verify that a container with remote tag change works. The new tag - should not be in the original repo, only the new remote - fork. The new tag is automatically fetched because it is on - the branch. - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_required_checkout(overall, tree) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.update_tag(under_test_dir, 'simp_branch', - 'forked-feature-v1', SIMPLE_FORK_NAME) - - # status of simp_branch should be out of sync - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_sb_modified(overall, tree) - - # checkout new externals - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_required_sb_modified(overall, tree) - - # status should be synced - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_post_checkout(overall, tree) - - def test_container_remote_tag_fetch_all(self): - """Verify that a container with remote tag change works. The new tag - should not be in the original repo, only the new remote - fork. It should also not be on a branch that will be fetch, - and therefore not fetched by default with 'git fetch'. It will - only be retreived by 'git fetch --tags' - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_required_checkout(overall, tree) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.update_tag(under_test_dir, 'simp_branch', - 'abandoned-feature', SIMPLE_FORK_NAME) - - # status of simp_branch should be out of sync - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_sb_modified(overall, tree) - - # checkout new externals - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_required_sb_modified(overall, tree) - - # status should be synced - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_post_checkout(overall, tree) - - def test_container_preserve_dot(self): - """Verify that after inital checkout, modifying an external git repo - url to '.' and the current branch will leave it unchanged. - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_required_checkout(overall, tree) - - # update the config file to point to a different remote with - # the same branch - self._generator.update_branch(under_test_dir, 'simp_branch', - REMOTE_BRANCH_FEATURE2, SIMPLE_FORK_NAME) - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - - # verify status is clean and unmodified - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_post_checkout(overall, tree) - - # update branch to point to a new branch that only exists in - # the local fork - self._generator.create_branch(under_test_dir, 'simp_branch', - 'private-feature', with_commit=True) - self._generator.update_branch(under_test_dir, 'simp_branch', - 'private-feature', - SIMPLE_LOCAL_ONLY_NAME) - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - - # verify status is clean and unmodified - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_required_post_checkout(overall, tree) - - def test_container_full(self): - """Verify that 'full' container with simple and mixed subrepos - generates the correct initial status. - - The mixed subrepo has a sub-externals file with different - sub-externals on different branches. - - """ - # create the test repository - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - - # create the top level externals file - self._generator.container_full(under_test_dir) - - # inital checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_full_pre_checkout(overall, tree) - - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_full_post_checkout(overall, tree) - - # Check existance of some files - subrepo_path = os.path.join('externals', 'simp_tag') - self._check_file_exists(under_test_dir, - os.path.join(subrepo_path, 'readme.txt')) - self._check_file_absent(under_test_dir, os.path.join(subrepo_path, - 'simple_subdir', - 'subdir_file.txt')) - - # update the mixed-use repo to point to different branch - self._generator.update_branch(under_test_dir, 'mixed_req', - 'new-feature', MIXED_REPO_NAME) - - # check status out of sync for mixed_req, but sub-externals - # are still in sync - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_full_pre_checkout_ext_change(overall, tree) - - # run the checkout. Now the mixed use external and it's - # sub-exterals should be changed. Returned status is - # pre-checkout! - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_full_pre_checkout_ext_change(overall, tree) - - # check status out of sync for mixed_req, and sub-externals - # are in sync. - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_full_post_checkout(overall, tree) - - def test_container_component(self): - """Verify that optional component checkout works - """ - # create the test repository - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - - # create the top level externals file - self._generator.container_full(under_test_dir) - - # inital checkout, first try a nonexistant component argument noref - checkout_args = ['simp_opt', 'noref'] - checkout_args.extend(self.checkout_args) - - with self.assertRaises(RuntimeError): - self.execute_cmd_in_dir(under_test_dir, checkout_args) - - checkout_args = ['simp_opt'] - checkout_args.extend(self.checkout_args) - - overall, tree = self.execute_cmd_in_dir(under_test_dir, - checkout_args) - - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_component_post_checkout(overall, tree) - checkout_args.append('simp_branch') - overall, tree = self.execute_cmd_in_dir(under_test_dir, - checkout_args) - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_component_post_checkout2(overall, tree) - - def test_mixed_simple(self): - """Verify that a mixed use repo can serve as a 'full' container, - pulling in a set of externals and a seperate set of sub-externals. - - """ - #import pdb; pdb.set_trace() - # create repository - under_test_dir = self.setup_test_repo(MIXED_REPO_NAME) - # create top level externals file - self._generator.mixed_simple_base(under_test_dir) - # NOTE: sub-externals file is already in the repo so we can - # switch branches during testing. Since this is a mixed-repo - # serving as the top level container repo, we can't switch - # during this test. - - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_mixed_cont_simple_required_checkout(overall, tree) - - # verify status is clean and unmodified - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_mixed_cont_simple_required_post_checkout(overall, tree) - - def test_container_sparse(self): - """Verify that 'full' container with simple subrepo - can run a sparse checkout and generate the correct initial status. - - """ - # create the test repository - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - - # create the top level externals file - self._generator.container_sparse(under_test_dir) - - # inital checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_sparse_pre_checkout(overall, tree) - - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_sparse_post_checkout(overall, tree) - - # Check existance of some files - subrepo_path = os.path.join('externals', 'simp_tag') - self._check_file_exists(under_test_dir, - os.path.join(subrepo_path, 'readme.txt')) - self._check_file_exists(under_test_dir, os.path.join(subrepo_path, - 'simple_subdir', - 'subdir_file.txt')) - subrepo_path = os.path.join('externals', 'simp_sparse') - self._check_file_exists(under_test_dir, - os.path.join(subrepo_path, 'readme.txt')) - self._check_file_absent(under_test_dir, os.path.join(subrepo_path, - 'simple_subdir', - 'subdir_file.txt')) - - -class TestSysCheckoutSVN(BaseTestSysCheckout): - """Run systems level tests of checkout_externals accessing svn repositories - - SVN tests - these tests use the svn repository interface. Since - they require an active network connection, they are significantly - slower than the git tests. But svn testing is critical. So try to - design the tests to only test svn repository functionality - (checkout, switch) and leave generic testing of functionality like - 'optional' to the fast git tests. - - Example timing as of 2017-11: - - * All other git and unit tests combined take between 4-5 seconds - - * Just checking if svn is available for a single test takes 2 seconds. - - * The single svn test typically takes between 10 and 25 seconds - (depending on the network)! - - NOTE(bja, 2017-11) To enable CI testing we can't use a real remote - repository that restricts access and it seems inappropriate to hit - a random open source repo. For now we are just hitting one of our - own github repos using the github svn server interface. This - should be "good enough" for basic checkout and swich - functionality. But if additional svn functionality is required, a - better solution will be necessary. I think eventually we want to - create a small local svn repository on the fly (doesn't require an - svn server or network connection!) and use it for testing. - - """ - - def _check_svn_branch_ok(self, tree, directory=EXTERNALS_NAME): - name = './{0}/svn_branch'.format(directory) - self._check_generic_ok_clean_required(tree, name) - - def _check_svn_branch_dirty(self, tree, directory=EXTERNALS_NAME): - name = './{0}/svn_branch'.format(directory) - self._check_generic_ok_dirty_required(tree, name) - - def _check_svn_tag_ok(self, tree, directory=EXTERNALS_NAME): - name = './{0}/svn_tag'.format(directory) - self._check_generic_ok_clean_required(tree, name) - - def _check_svn_tag_modified(self, tree, directory=EXTERNALS_NAME): - name = './{0}/svn_tag'.format(directory) - self._check_generic_modified_ok_required(tree, name) - - def _check_container_simple_svn_post_checkout(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_ok(tree) - self._check_svn_branch_ok(tree) - self._check_svn_tag_ok(tree) - - def _check_container_simple_svn_sb_dirty_st_mod(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_ok(tree) - self._check_svn_tag_modified(tree) - self._check_svn_branch_dirty(tree) - - def _check_container_simple_svn_sb_clean_st_mod(self, overall, tree): - self.assertEqual(overall, 0) - self._check_simple_tag_ok(tree) - self._check_svn_tag_modified(tree) - self._check_svn_branch_ok(tree) - - @staticmethod - def have_svn_access(): - """Check if we have svn access so we can enable tests that use svn. - - """ - have_svn = False - cmd = ['svn', 'ls', SVN_TEST_REPO, ] - try: - execute_subprocess(cmd) - have_svn = True - except BaseException: - pass - return have_svn - - def skip_if_no_svn_access(self): - """Function decorator to disable svn tests when svn isn't available - """ - have_svn = self.have_svn_access() - if not have_svn: - raise unittest.SkipTest("No svn access") - - def test_container_simple_svn(self): - """Verify that a container repo can pull in an svn branch and svn tag. - - """ - self.skip_if_no_svn_access() - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_svn(under_test_dir) - - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - - # verify status is clean and unmodified - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_svn_post_checkout(overall, tree) - - # update description file to make the tag into a branch and - # trigger a switch - self._generator.update_svn_branch(under_test_dir, 'svn_tag', 'trunk') - - # checkout - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - - # verify status is clean and unmodified - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.status_args) - self._check_container_simple_svn_post_checkout(overall, tree) - - # add an untracked file to the repo - tracked = False - self._add_file_to_repo(under_test_dir, - 'externals/svn_branch/tmp.txt', tracked) - - # run a no-op checkout: pre-checkout status should be clean, - # ignoring the untracked file. - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_svn_post_checkout(overall, tree) - - # update description file to make the branch into a tag and - # trigger a modified sync status - self._generator.update_svn_branch(under_test_dir, 'svn_tag', - 'tags/cesm2.0.beta07') - - # checkout: pre-checkout status should be clean and modified, - # will modify working copy. - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.checkout_args) - self._check_container_simple_svn_sb_clean_st_mod(overall, tree) - - # verify status is still clean and unmodified, last - # checkout modified the working dir state. - overall, tree = self.execute_cmd_in_dir(under_test_dir, - self.verbose_args) - self._check_container_simple_svn_post_checkout(overall, tree) - -class TestSubrepoCheckout(BaseTestSysCheckout): - # Need to store information at setUp time for checking - # pylint: disable=too-many-instance-attributes - """Run tests to ensure proper handling of repos with submodules. - - By default, submodules in git repositories are checked out. A git - repository checked out as a submodule is treated as if it was - listed in an external with the same properties as in the source - .gitmodules file. - """ - - def setUp(self): - """Setup for all submodule checkout tests - Create a repo with two submodule repositories. - """ - - # Run the basic setup - super(TestSubrepoCheckout, self).setUp() - # create test repo - # We need to do this here (rather than have a static repo) because - # git submodules do not allow for variables in .gitmodules files - self._test_repo_name = 'test_repo_with_submodules' - self._bare_branch_name = 'subrepo_branch' - self._config_branch_name = 'subrepo_config_branch' - self._container_extern_name = 'externals_container.cfg' - self._my_test_dir = os.path.join(os.environ[MANIC_TEST_TMP_REPO_ROOT], - self._test_id) - self._repo_dir = os.path.join(self._my_test_dir, self._test_repo_name) - self._checkout_dir = 'repo_with_submodules' - check_dir = self.setup_test_repo(CONTAINER_REPO_NAME, - dest_dir_in=self._repo_dir) - self.assertTrue(self._repo_dir == check_dir) - # Add the submodules - cwd = os.getcwd() - fork_repo_dir = os.path.join(self._bare_root, SIMPLE_FORK_NAME) - simple_repo_dir = os.path.join(self._bare_root, SIMPLE_REPO_NAME) - self._simple_ext_fork_name = SIMPLE_FORK_NAME.split('.')[0] - self._simple_ext_name = SIMPLE_REPO_NAME.split('.')[0] - os.chdir(self._repo_dir) - # Add a branch with a subrepo - cmd = ['git', 'branch', self._bare_branch_name, 'master'] - execute_subprocess(cmd) - cmd = ['git', 'checkout', self._bare_branch_name] - execute_subprocess(cmd) - cmd = ['git', 'submodule', 'add', fork_repo_dir] - execute_subprocess(cmd) - cmd = ['git', 'commit', '-am', "'Added simple-ext-fork as a submodule'"] - execute_subprocess(cmd) - # Save the fork repo hash for comparison - os.chdir(self._simple_ext_fork_name) - self._fork_hash_check = self.get_git_hash() - os.chdir(self._repo_dir) - # Now, create a branch to test from_sbmodule - cmd = ['git', 'branch', - self._config_branch_name, self._bare_branch_name] - execute_subprocess(cmd) - cmd = ['git', 'checkout', self._config_branch_name] - execute_subprocess(cmd) - cmd = ['git', 'submodule', 'add', simple_repo_dir] - execute_subprocess(cmd) - # Checkout feature2 - os.chdir(self._simple_ext_name) - cmd = ['git', 'branch', 'feature2', 'origin/feature2'] - execute_subprocess(cmd) - cmd = ['git', 'checkout', 'feature2'] - execute_subprocess(cmd) - # Save the fork repo hash for comparison - self._simple_hash_check = self.get_git_hash() - os.chdir(self._repo_dir) - self.create_externals_file(filename=self._container_extern_name, - dest_dir=self._repo_dir, from_submodule=True) - cmd = ['git', 'add', self._container_extern_name] - execute_subprocess(cmd) - cmd = ['git', 'commit', '-am', "'Added simple-ext as a submodule'"] - execute_subprocess(cmd) - # Reset to master - cmd = ['git', 'checkout', 'master'] - execute_subprocess(cmd) - os.chdir(cwd) - - @staticmethod - def get_git_hash(revision="HEAD"): - """Return the hash for """ - cmd = ['git', 'rev-parse', revision] - git_out = execute_subprocess(cmd, output_to_caller=True) - return git_out.strip() - - def create_externals_file(self, name='', filename=CFG_NAME, dest_dir=None, - branch_name=None, sub_externals=None, - from_submodule=False): - # pylint: disable=too-many-arguments - """Create a container externals file with only simple externals. - - """ - self._generator.create_config() - - if dest_dir is None: - dest_dir = self._my_test_dir - - if from_submodule: - self._generator.create_section(SIMPLE_FORK_NAME, - self._simple_ext_fork_name, - from_submodule=True) - self._generator.create_section(SIMPLE_REPO_NAME, - self._simple_ext_name, - branch='feature3', path='', - from_submodule=False) - else: - if branch_name is None: - branch_name = 'master' - - self._generator.create_section(self._test_repo_name, - self._checkout_dir, - branch=branch_name, - path=name, externals=sub_externals, - repo_path=self._repo_dir) - - self._generator.write_config(dest_dir, filename=filename) - - def idempotence_check(self, checkout_dir): - """Verify that calling checkout_externals and - checkout_externals --status does not cause errors""" - cwd = os.getcwd() - os.chdir(checkout_dir) - overall, _ = self.execute_cmd_in_dir(self._my_test_dir, - self.checkout_args) - self.assertTrue(overall == 0) - overall, _ = self.execute_cmd_in_dir(self._my_test_dir, - self.status_args) - self.assertTrue(overall == 0) - os.chdir(cwd) - - def test_submodule_checkout_bare(self): - """Verify that a git repo with submodule is properly checked out - This test if for where there is no 'externals' keyword in the - parent repo. - Correct behavior is that the submodule is checked out using - normal git submodule behavior. - """ - simple_ext_fork_tag = "(tag1)" - simple_ext_fork_status = " " - self.create_externals_file(branch_name=self._bare_branch_name) - overall, _ = self.execute_cmd_in_dir(self._my_test_dir, - self.checkout_args) - self.assertTrue(overall == 0) - cwd = os.getcwd() - checkout_dir = os.path.join(self._my_test_dir, self._checkout_dir) - fork_file = os.path.join(checkout_dir, - self._simple_ext_fork_name, "readme.txt") - self.assertTrue(os.path.exists(fork_file)) - os.chdir(checkout_dir) - submods = git_submodule_status(checkout_dir) - self.assertEqual(len(submods.keys()), 1) - self.assertTrue(self._simple_ext_fork_name in submods) - submod = submods[self._simple_ext_fork_name] - self.assertTrue('hash' in submod) - self.assertEqual(submod['hash'], self._fork_hash_check) - self.assertTrue('status' in submod) - self.assertEqual(submod['status'], simple_ext_fork_status) - self.assertTrue('tag' in submod) - self.assertEqual(submod['tag'], simple_ext_fork_tag) - os.chdir(cwd) - self.idempotence_check(checkout_dir) - - def test_submodule_checkout_none(self): - """Verify that a git repo with submodule is properly checked out - This test is for when 'externals=None' is in parent repo's - externals cfg file. - Correct behavior is the submodle is not checked out. - """ - self.create_externals_file(branch_name=self._bare_branch_name, - sub_externals="none") - overall, _ = self.execute_cmd_in_dir(self._my_test_dir, - self.checkout_args) - self.assertTrue(overall == 0) - cwd = os.getcwd() - checkout_dir = os.path.join(self._my_test_dir, self._checkout_dir) - fork_file = os.path.join(checkout_dir, - self._simple_ext_fork_name, "readme.txt") - self.assertFalse(os.path.exists(fork_file)) - os.chdir(cwd) - self.idempotence_check(checkout_dir) - - def test_submodule_checkout_config(self): # pylint: disable=too-many-locals - """Verify that a git repo with submodule is properly checked out - This test if for when the 'from_submodule' keyword is used in the - parent repo. - Correct behavior is that the submodule is checked out using - normal git submodule behavior. - """ - tag_check = None # Not checked out as submodule - status_check = "-" # Not checked out as submodule - self.create_externals_file(branch_name=self._config_branch_name, - sub_externals=self._container_extern_name) - overall, _ = self.execute_cmd_in_dir(self._my_test_dir, - self.checkout_args) - self.assertTrue(overall == 0) - cwd = os.getcwd() - checkout_dir = os.path.join(self._my_test_dir, self._checkout_dir) - fork_file = os.path.join(checkout_dir, - self._simple_ext_fork_name, "readme.txt") - self.assertTrue(os.path.exists(fork_file)) - os.chdir(checkout_dir) - # Check submodule status - submods = git_submodule_status(checkout_dir) - self.assertEqual(len(submods.keys()), 2) - self.assertTrue(self._simple_ext_fork_name in submods) - submod = submods[self._simple_ext_fork_name] - self.assertTrue('hash' in submod) - self.assertEqual(submod['hash'], self._fork_hash_check) - self.assertTrue('status' in submod) - self.assertEqual(submod['status'], status_check) - self.assertTrue('tag' in submod) - self.assertEqual(submod['tag'], tag_check) - self.assertTrue(self._simple_ext_name in submods) - submod = submods[self._simple_ext_name] - self.assertTrue('hash' in submod) - self.assertEqual(submod['hash'], self._simple_hash_check) - self.assertTrue('status' in submod) - self.assertEqual(submod['status'], status_check) - self.assertTrue('tag' in submod) - self.assertEqual(submod['tag'], tag_check) - # Check fork repo status - os.chdir(self._simple_ext_fork_name) - self.assertEqual(self.get_git_hash(), self._fork_hash_check) - os.chdir(checkout_dir) - os.chdir(self._simple_ext_name) - hash_check = self.get_git_hash('origin/feature3') - self.assertEqual(self.get_git_hash(), hash_check) - os.chdir(cwd) - self.idempotence_check(checkout_dir) - -class TestSysCheckoutErrors(BaseTestSysCheckout): - """Run systems level tests of error conditions in checkout_externals - - Error conditions - these tests are designed to trigger specific - error conditions and ensure that they are being handled as - runtime errors (and hopefully usefull error messages) instead of - the default internal message that won't mean anything to the - user, e.g. key error, called process error, etc. - - These are not 'expected failures'. They are pass when a - RuntimeError is raised, fail if any other error is raised (or no - error is raised). - - """ - - # NOTE(bja, 2017-11) pylint complains about long method names, but - # it is hard to differentiate tests without making them more - # cryptic. - # pylint: disable=invalid-name - - def test_error_unknown_protocol(self): - """Verify that a runtime error is raised when the user specified repo - protocol is not known. - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.update_protocol(under_test_dir, 'simp_branch', - 'this-protocol-does-not-exist') - - with self.assertRaises(RuntimeError): - self.execute_cmd_in_dir(under_test_dir, self.checkout_args) - - def test_error_switch_protocol(self): - """Verify that a runtime error is raised when the user switches - protocols, git to svn. - - TODO(bja, 2017-11) This correctly results in an error, but it - isn't a helpful error message. - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.update_protocol(under_test_dir, 'simp_branch', 'svn') - with self.assertRaises(RuntimeError): - self.execute_cmd_in_dir(under_test_dir, self.checkout_args) - - def test_error_unknown_tag(self): - """Verify that a runtime error is raised when the user specified tag - does not exist. - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.update_tag(under_test_dir, 'simp_branch', - 'this-tag-does-not-exist', SIMPLE_REPO_NAME) - - with self.assertRaises(RuntimeError): - self.execute_cmd_in_dir(under_test_dir, self.checkout_args) - - def test_error_overspecify_tag_branch(self): - """Verify that a runtime error is raised when the user specified both - tag and a branch - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.update_tag(under_test_dir, 'simp_branch', - 'this-tag-does-not-exist', SIMPLE_REPO_NAME, - remove_branch=False) - - with self.assertRaises(RuntimeError): - self.execute_cmd_in_dir(under_test_dir, self.checkout_args) - - def test_error_underspecify_tag_branch(self): - """Verify that a runtime error is raised when the user specified - neither a tag or a branch - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.update_underspecify_branch_tag(under_test_dir, - 'simp_branch') - - with self.assertRaises(RuntimeError): - self.execute_cmd_in_dir(under_test_dir, self.checkout_args) - - def test_error_missing_url(self): - """Verify that a runtime error is raised when the user specified - neither a tag or a branch - - """ - # create repo - under_test_dir = self.setup_test_repo(CONTAINER_REPO_NAME) - self._generator.container_simple_required(under_test_dir) - - # update the config file to point to a different remote with - # the tag instead of branch. Tag MUST NOT be in the original - # repo! - self._generator.update_underspecify_remove_url(under_test_dir, - 'simp_branch') - - with self.assertRaises(RuntimeError): - self.execute_cmd_in_dir(under_test_dir, self.checkout_args) - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_sys_repository_git.py b/manage_externals/test/test_sys_repository_git.py deleted file mode 100644 index f6dbf84284..0000000000 --- a/manage_externals/test/test_sys_repository_git.py +++ /dev/null @@ -1,238 +0,0 @@ -#!/usr/bin/env python - -"""Tests of some of the functionality in repository_git.py that actually -interacts with git repositories. - -We're calling these "system" tests because we expect them to be a lot -slower than most of the unit tests. - -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import os -import shutil -import tempfile -import unittest - -from manic.repository_git import GitRepository -from manic.externals_description import ExternalsDescription -from manic.externals_description import ExternalsDescriptionDict -from manic.utils import execute_subprocess - -# NOTE(wjs, 2018-04-09) I find a mix of camel case and underscores to be -# more readable for unit test names, so I'm disabling pylint's naming -# convention check -# pylint: disable=C0103 - -# Allow access to protected members -# pylint: disable=W0212 - - -class GitTestCase(unittest.TestCase): - """Adds some git-specific unit test functionality on top of TestCase""" - - def assertIsHash(self, maybe_hash): - """Assert that the string given by maybe_hash really does look - like a git hash. - """ - - # Ensure it is non-empty - self.assertTrue(maybe_hash, msg="maybe_hash is empty") - - # Ensure it has a single string - self.assertEqual(1, len(maybe_hash.split()), - msg="maybe_hash has multiple strings: {}".format(maybe_hash)) - - # Ensure that the only characters in the string are ones allowed - # in hashes - allowed_chars_set = set('0123456789abcdef') - self.assertTrue(set(maybe_hash) <= allowed_chars_set, - msg="maybe_hash has non-hash characters: {}".format(maybe_hash)) - - -class TestGitTestCase(GitTestCase): - """Tests GitTestCase""" - - def test_assertIsHash_true(self): - """Ensure that assertIsHash passes for something that looks - like a hash""" - self.assertIsHash('abc123') - - def test_assertIsHash_empty(self): - """Ensure that assertIsHash raises an AssertionError for an - empty string""" - with self.assertRaises(AssertionError): - self.assertIsHash('') - - def test_assertIsHash_multipleStrings(self): - """Ensure that assertIsHash raises an AssertionError when - given multiple strings""" - with self.assertRaises(AssertionError): - self.assertIsHash('abc123 def456') - - def test_assertIsHash_badChar(self): - """Ensure that assertIsHash raises an AssertionError when given a - string that has a character that doesn't belong in a hash - """ - with self.assertRaises(AssertionError): - self.assertIsHash('abc123g') - - -class TestGitRepositoryGitCommands(GitTestCase): - """Test some git commands in RepositoryGit - - It's silly that we need to create a repository in order to test - these git commands. Much or all of the git functionality that is - currently in repository_git.py should eventually be moved to a - separate module that is solely responsible for wrapping git - commands; that would allow us to test it independently of this - repository class. - """ - - # ======================================================================== - # Test helper functions - # ======================================================================== - - def setUp(self): - # directory we want to return to after the test system and - # checkout_externals are done cd'ing all over the place. - self._return_dir = os.getcwd() - - self._tmpdir = tempfile.mkdtemp() - os.chdir(self._tmpdir) - - self._name = 'component' - rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: - '/path/to/local/repo', - ExternalsDescription.TAG: - 'tag1', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: 'junk', - ExternalsDescription.EXTERNALS: '', - ExternalsDescription.REPO: rdata, - }, - } - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = GitRepository('test', repo) - - def tearDown(self): - # return to our common starting point - os.chdir(self._return_dir) - - shutil.rmtree(self._tmpdir, ignore_errors=True) - - @staticmethod - def make_git_repo(): - """Turn the current directory into an empty git repository""" - execute_subprocess(['git', 'init']) - - @staticmethod - def add_git_commit(): - """Add a git commit in the current directory""" - with open('README', 'a') as myfile: - myfile.write('more info') - execute_subprocess(['git', 'add', 'README']) - execute_subprocess(['git', 'commit', '-m', 'my commit message']) - - @staticmethod - def checkout_git_branch(branchname): - """Checkout a new branch in the current directory""" - execute_subprocess(['git', 'checkout', '-b', branchname]) - - @staticmethod - def make_git_tag(tagname): - """Make a lightweight tag at the current commit""" - execute_subprocess(['git', 'tag', '-m', 'making a tag', tagname]) - - @staticmethod - def checkout_ref(refname): - """Checkout the given refname in the current directory""" - execute_subprocess(['git', 'checkout', refname]) - - # ======================================================================== - # Begin actual tests - # ======================================================================== - - def test_currentHash_returnsHash(self): - """Ensure that the _git_current_hash function returns a hash""" - self.make_git_repo() - self.add_git_commit() - hash_found, myhash = self._repo._git_current_hash() - self.assertTrue(hash_found) - self.assertIsHash(myhash) - - def test_currentHash_outsideGitRepo(self): - """Ensure that the _git_current_hash function returns False when - outside a git repository""" - hash_found, myhash = self._repo._git_current_hash() - self.assertFalse(hash_found) - self.assertEqual('', myhash) - - def test_currentBranch_onBranch(self): - """Ensure that the _git_current_branch function returns the name - of the branch""" - self.make_git_repo() - self.add_git_commit() - self.checkout_git_branch('foo') - branch_found, mybranch = self._repo._git_current_branch() - self.assertTrue(branch_found) - self.assertEqual('foo', mybranch) - - def test_currentBranch_notOnBranch(self): - """Ensure that the _git_current_branch function returns False - when not on a branch""" - self.make_git_repo() - self.add_git_commit() - self.make_git_tag('mytag') - self.checkout_ref('mytag') - branch_found, mybranch = self._repo._git_current_branch() - self.assertFalse(branch_found) - self.assertEqual('', mybranch) - - def test_currentBranch_outsideGitRepo(self): - """Ensure that the _git_current_branch function returns False - when outside a git repository""" - branch_found, mybranch = self._repo._git_current_branch() - self.assertFalse(branch_found) - self.assertEqual('', mybranch) - - def test_currentTag_onTag(self): - """Ensure that the _git_current_tag function returns the name of - the tag""" - self.make_git_repo() - self.add_git_commit() - self.make_git_tag('some_tag') - tag_found, mytag = self._repo._git_current_tag() - self.assertTrue(tag_found) - self.assertEqual('some_tag', mytag) - - def test_currentTag_notOnTag(self): - """Ensure tha the _git_current_tag function returns False when - not on a tag""" - self.make_git_repo() - self.add_git_commit() - self.make_git_tag('some_tag') - self.add_git_commit() - tag_found, mytag = self._repo._git_current_tag() - self.assertFalse(tag_found) - self.assertEqual('', mytag) - - def test_currentTag_outsideGitRepo(self): - """Ensure that the _git_current_tag function returns False when - outside a git repository""" - tag_found, mytag = self._repo._git_current_tag() - self.assertFalse(tag_found) - self.assertEqual('', mytag) - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_unit_externals_description.py b/manage_externals/test/test_unit_externals_description.py deleted file mode 100644 index 637f760ee5..0000000000 --- a/manage_externals/test/test_unit_externals_description.py +++ /dev/null @@ -1,401 +0,0 @@ -#!/usr/bin/env python - -"""Unit test driver for checkout_externals - -Note: this script assume the path to the checkout_externals.py module is -already in the python path. - -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import os -import os.path -import shutil -import unittest - -try: - # python2 - from ConfigParser import SafeConfigParser as config_parser - - def config_string_cleaner(text): - """convert strings into unicode - """ - return text.decode('utf-8') -except ImportError: - # python3 - from configparser import ConfigParser as config_parser - - def config_string_cleaner(text): - """Python3 already uses unicode strings, so just return the string - without modification. - - """ - return text - -from manic.externals_description import DESCRIPTION_SECTION, VERSION_ITEM -from manic.externals_description import ExternalsDescription -from manic.externals_description import ExternalsDescriptionDict -from manic.externals_description import ExternalsDescriptionConfigV1 -from manic.externals_description import get_cfg_schema_version -from manic.externals_description import read_externals_description_file -from manic.externals_description import create_externals_description - -from manic.global_constants import EMPTY_STR - - -class TestCfgSchemaVersion(unittest.TestCase): - """Test that schema identification for the externals description - returns the correct results. - - """ - - def setUp(self): - """Reusable config object - """ - self._config = config_parser() - self._config.add_section('section1') - self._config.set('section1', 'keword', 'value') - - self._config.add_section(DESCRIPTION_SECTION) - - def test_schema_version_valid(self): - """Test that schema identification returns the correct version for a - valid tag. - - """ - version_str = '2.1.3' - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, version_str) - major, minor, patch = get_cfg_schema_version(self._config) - expected_major = 2 - expected_minor = 1 - expected_patch = 3 - self.assertEqual(expected_major, major) - self.assertEqual(expected_minor, minor) - self.assertEqual(expected_patch, patch) - - def test_schema_section_missing(self): - """Test that an error is returned if the schema section is missing - from the input file. - - """ - self._config.remove_section(DESCRIPTION_SECTION) - with self.assertRaises(RuntimeError): - get_cfg_schema_version(self._config) - - def test_schema_version_missing(self): - """Test that a externals description file without a version raises a - runtime error. - - """ - # Note: the default setup method shouldn't include a version - # keyword, but remove it just to be future proof.... - self._config.remove_option(DESCRIPTION_SECTION, VERSION_ITEM) - with self.assertRaises(RuntimeError): - get_cfg_schema_version(self._config) - - def test_schema_version_not_int(self): - """Test that a externals description file a version that doesn't - decompose to integer major, minor and patch versions raises - runtime error. - - """ - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, 'unknown') - with self.assertRaises(RuntimeError): - get_cfg_schema_version(self._config) - - -class TestModelDescritionConfigV1(unittest.TestCase): - """Test that parsing config/ini fileproduces a correct dictionary - for the externals description. - - """ - # pylint: disable=R0902 - - def setUp(self): - """Boiler plate construction of string containing xml for multiple components. - """ - self._comp1_name = 'comp1' - self._comp1_path = 'path/to/comp1' - self._comp1_protocol = 'svn' - self._comp1_url = 'https://svn.somewhere.com/path/of/comp1' - self._comp1_tag = 'a_nice_tag_v1' - self._comp1_is_required = 'True' - self._comp1_externals = '' - - self._comp2_name = 'comp2' - self._comp2_path = 'path/to/comp2' - self._comp2_protocol = 'git' - self._comp2_url = '/local/clone/of/comp2' - self._comp2_branch = 'a_very_nice_branch' - self._comp2_is_required = 'False' - self._comp2_externals = 'path/to/comp2.cfg' - - def _setup_comp1(self, config): - """Boiler plate construction of xml string for componet 1 - """ - config.add_section(self._comp1_name) - config.set(self._comp1_name, 'local_path', self._comp1_path) - config.set(self._comp1_name, 'protocol', self._comp1_protocol) - config.set(self._comp1_name, 'repo_url', self._comp1_url) - config.set(self._comp1_name, 'tag', self._comp1_tag) - config.set(self._comp1_name, 'required', self._comp1_is_required) - - def _setup_comp2(self, config): - """Boiler plate construction of xml string for componet 2 - """ - config.add_section(self._comp2_name) - config.set(self._comp2_name, 'local_path', self._comp2_path) - config.set(self._comp2_name, 'protocol', self._comp2_protocol) - config.set(self._comp2_name, 'repo_url', self._comp2_url) - config.set(self._comp2_name, 'branch', self._comp2_branch) - config.set(self._comp2_name, 'required', self._comp2_is_required) - config.set(self._comp2_name, 'externals', self._comp2_externals) - - @staticmethod - def _setup_externals_description(config): - """Add the required exernals description section - """ - - config.add_section(DESCRIPTION_SECTION) - config.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.0.1') - - def _check_comp1(self, model): - """Test that component one was constructed correctly. - """ - self.assertTrue(self._comp1_name in model) - comp1 = model[self._comp1_name] - self.assertEqual(comp1[ExternalsDescription.PATH], self._comp1_path) - self.assertTrue(comp1[ExternalsDescription.REQUIRED]) - repo = comp1[ExternalsDescription.REPO] - self.assertEqual(repo[ExternalsDescription.PROTOCOL], - self._comp1_protocol) - self.assertEqual(repo[ExternalsDescription.REPO_URL], self._comp1_url) - self.assertEqual(repo[ExternalsDescription.TAG], self._comp1_tag) - self.assertEqual(EMPTY_STR, comp1[ExternalsDescription.EXTERNALS]) - - def _check_comp2(self, model): - """Test that component two was constucted correctly. - """ - self.assertTrue(self._comp2_name in model) - comp2 = model[self._comp2_name] - self.assertEqual(comp2[ExternalsDescription.PATH], self._comp2_path) - self.assertFalse(comp2[ExternalsDescription.REQUIRED]) - repo = comp2[ExternalsDescription.REPO] - self.assertEqual(repo[ExternalsDescription.PROTOCOL], - self._comp2_protocol) - self.assertEqual(repo[ExternalsDescription.REPO_URL], self._comp2_url) - self.assertEqual(repo[ExternalsDescription.BRANCH], self._comp2_branch) - self.assertEqual(self._comp2_externals, - comp2[ExternalsDescription.EXTERNALS]) - - def test_one_tag_required(self): - """Test that a component source with a tag is correctly parsed. - """ - config = config_parser() - self._setup_comp1(config) - self._setup_externals_description(config) - model = ExternalsDescriptionConfigV1(config) - print(model) - self._check_comp1(model) - - def test_one_branch_externals(self): - """Test that a component source with a branch is correctly parsed. - """ - config = config_parser() - self._setup_comp2(config) - self._setup_externals_description(config) - model = ExternalsDescriptionConfigV1(config) - print(model) - self._check_comp2(model) - - def test_two_sources(self): - """Test that multiple component sources are correctly parsed. - """ - config = config_parser() - self._setup_comp1(config) - self._setup_comp2(config) - self._setup_externals_description(config) - model = ExternalsDescriptionConfigV1(config) - print(model) - self._check_comp1(model) - self._check_comp2(model) - - def test_cfg_v1_reject_unknown_item(self): - """Test that a v1 description object will reject unknown items - """ - config = config_parser() - self._setup_comp1(config) - self._setup_externals_description(config) - config.set(self._comp1_name, 'junk', 'foobar') - with self.assertRaises(RuntimeError): - ExternalsDescriptionConfigV1(config) - - def test_cfg_v1_reject_v2(self): - """Test that a v1 description object won't try to parse a v2 file. - """ - config = config_parser() - self._setup_comp1(config) - self._setup_externals_description(config) - config.set(DESCRIPTION_SECTION, VERSION_ITEM, '2.0.1') - with self.assertRaises(RuntimeError): - ExternalsDescriptionConfigV1(config) - - def test_cfg_v1_reject_v1_too_new(self): - """Test that a v1 description object won't try to parse a v2 file. - """ - config = config_parser() - self._setup_comp1(config) - self._setup_externals_description(config) - config.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.100.0') - with self.assertRaises(RuntimeError): - ExternalsDescriptionConfigV1(config) - - -class TestReadExternalsDescription(unittest.TestCase): - """Test the application logic of read_externals_description_file - """ - TMP_FAKE_DIR = 'fake' - - def setUp(self): - """Setup directory for tests - """ - if not os.path.exists(self.TMP_FAKE_DIR): - os.makedirs(self.TMP_FAKE_DIR) - - def tearDown(self): - """Cleanup tmp stuff on the file system - """ - if os.path.exists(self.TMP_FAKE_DIR): - shutil.rmtree(self.TMP_FAKE_DIR) - - def test_no_file_error(self): - """Test that a runtime error is raised when the file does not exist - - """ - root_dir = os.getcwd() - filename = 'this-file-should-not-exist' - with self.assertRaises(RuntimeError): - read_externals_description_file(root_dir, filename) - - def test_no_dir_error(self): - """Test that a runtime error is raised when the file does not exist - - """ - root_dir = '/path/to/some/repo' - filename = 'externals.cfg' - with self.assertRaises(RuntimeError): - read_externals_description_file(root_dir, filename) - - def test_no_invalid_error(self): - """Test that a runtime error is raised when the file format is invalid - - """ - root_dir = os.getcwd() - filename = 'externals.cfg' - file_path = os.path.join(root_dir, filename) - file_path = os.path.abspath(file_path) - contents = """ - -invalid file format -""" - with open(file_path, 'w') as fhandle: - fhandle.write(contents) - with self.assertRaises(RuntimeError): - read_externals_description_file(root_dir, filename) - os.remove(file_path) - - -class TestCreateExternalsDescription(unittest.TestCase): - """Test the application logic of creat_externals_description - """ - - def setUp(self): - """Create config object used as basis for all tests - """ - self._config = config_parser() - self._gmconfig = config_parser() - self.setup_config() - - def setup_config(self): - """Boiler plate construction of xml string for componet 1 - """ - # Create a standard externals config with a single external - name = 'test' - self._config.add_section(name) - self._config.set(name, ExternalsDescription.PATH, 'externals') - self._config.set(name, ExternalsDescription.PROTOCOL, 'git') - self._config.set(name, ExternalsDescription.REPO_URL, '/path/to/repo') - self._config.set(name, ExternalsDescription.TAG, 'test_tag') - self._config.set(name, ExternalsDescription.REQUIRED, 'True') - - self._config.add_section(DESCRIPTION_SECTION) - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.0.0') - - # Create a .gitmodules test - name = 'submodule "gitmodules_test"' - self._gmconfig.add_section(name) - self._gmconfig.set(name, "path", 'externals/test') - self._gmconfig.set(name, "url", '/path/to/repo') - # NOTE(goldy, 2019-03) Should test other possible keywords such as - # fetchRecurseSubmodules, ignore, and shallow - - def test_cfg_v1_ok(self): - """Test that a correct cfg v1 object is created by create_externals_description - - """ - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.0.3') - ext = create_externals_description(self._config, model_format='cfg') - self.assertIsInstance(ext, ExternalsDescriptionConfigV1) - - def test_cfg_v1_unknown_version(self): - """Test that a config file with unknown schema version is rejected by - create_externals_description. - - """ - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, '100.0.3') - with self.assertRaises(RuntimeError): - create_externals_description(self._config, model_format='cfg') - - def test_dict(self): - """Test that a correct cfg v1 object is created by create_externals_description - - """ - rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: '/path/to/repo', - ExternalsDescription.TAG: 'tagv1', - } - - desc = { - 'test': { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: '../fake', - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdata, }, - } - - ext = create_externals_description(desc, model_format='dict') - self.assertIsInstance(ext, ExternalsDescriptionDict) - - def test_cfg_unknown_version(self): - """Test that a runtime error is raised when an unknown file version is - received - - """ - self._config.set(DESCRIPTION_SECTION, VERSION_ITEM, '123.456.789') - with self.assertRaises(RuntimeError): - create_externals_description(self._config, model_format='cfg') - - def test_cfg_unknown_format(self): - """Test that a runtime error is raised when an unknown format string is - received - - """ - with self.assertRaises(RuntimeError): - create_externals_description(self._config, model_format='unknown') - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_unit_externals_status.py b/manage_externals/test/test_unit_externals_status.py deleted file mode 100644 index f8e953f756..0000000000 --- a/manage_externals/test/test_unit_externals_status.py +++ /dev/null @@ -1,299 +0,0 @@ -#!/usr/bin/env python - -"""Unit test driver for the manic external status reporting module. - -Note: this script assumes the path to the manic package is already in -the python path. - -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import unittest - -from manic.externals_status import ExternalStatus - - -class TestStatusObject(unittest.TestCase): - """Verify that the Status object behaives as expected. - """ - - def test_exists_empty_all(self): - """If the repository sync-state is empty (doesn't exist), and there is no - clean state, then it is considered not to exist. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.EMPTY - stat.clean_state = ExternalStatus.DEFAULT - exists = stat.exists() - self.assertFalse(exists) - - stat.clean_state = ExternalStatus.EMPTY - exists = stat.exists() - self.assertFalse(exists) - - stat.clean_state = ExternalStatus.UNKNOWN - exists = stat.exists() - self.assertFalse(exists) - - # this state represtens an internal logic error in how the - # repo status was determined. - stat.clean_state = ExternalStatus.STATUS_OK - exists = stat.exists() - self.assertTrue(exists) - - # this state represtens an internal logic error in how the - # repo status was determined. - stat.clean_state = ExternalStatus.DIRTY - exists = stat.exists() - self.assertTrue(exists) - - def test_exists_default_all(self): - """If the repository sync-state is default, then it is considered to exist - regardless of clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.DEFAULT - stat.clean_state = ExternalStatus.DEFAULT - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.EMPTY - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.UNKNOWN - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.STATUS_OK - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.DIRTY - exists = stat.exists() - self.assertTrue(exists) - - def test_exists_unknown_all(self): - """If the repository sync-state is unknown, then it is considered to exist - regardless of clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.UNKNOWN - stat.clean_state = ExternalStatus.DEFAULT - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.EMPTY - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.UNKNOWN - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.STATUS_OK - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.DIRTY - exists = stat.exists() - self.assertTrue(exists) - - def test_exists_modified_all(self): - """If the repository sync-state is modified, then it is considered to exist - regardless of clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.MODEL_MODIFIED - stat.clean_state = ExternalStatus.DEFAULT - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.EMPTY - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.UNKNOWN - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.STATUS_OK - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.DIRTY - exists = stat.exists() - self.assertTrue(exists) - - def test_exists_ok_all(self): - """If the repository sync-state is ok, then it is considered to exist - regardless of clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.STATUS_OK - stat.clean_state = ExternalStatus.DEFAULT - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.EMPTY - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.UNKNOWN - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.STATUS_OK - exists = stat.exists() - self.assertTrue(exists) - - stat.clean_state = ExternalStatus.DIRTY - exists = stat.exists() - self.assertTrue(exists) - - def test_update_ok_all(self): - """If the repository in-sync is ok, then it is safe to - update only if clean state is ok - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.STATUS_OK - stat.clean_state = ExternalStatus.DEFAULT - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.EMPTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.UNKNOWN - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.STATUS_OK - safe_to_update = stat.safe_to_update() - self.assertTrue(safe_to_update) - - stat.clean_state = ExternalStatus.DIRTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - def test_update_modified_all(self): - """If the repository in-sync is modified, then it is safe to - update only if clean state is ok - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.MODEL_MODIFIED - stat.clean_state = ExternalStatus.DEFAULT - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.EMPTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.UNKNOWN - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.STATUS_OK - safe_to_update = stat.safe_to_update() - self.assertTrue(safe_to_update) - - stat.clean_state = ExternalStatus.DIRTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - def test_update_unknown_all(self): - """If the repository in-sync is unknown, then it is not safe to - update, regardless of the clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.UNKNOWN - stat.clean_state = ExternalStatus.DEFAULT - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.EMPTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.UNKNOWN - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.STATUS_OK - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.DIRTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - def test_update_default_all(self): - """If the repository in-sync is default, then it is not safe to - update, regardless of the clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.UNKNOWN - stat.clean_state = ExternalStatus.DEFAULT - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.EMPTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.UNKNOWN - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.STATUS_OK - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.DIRTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - def test_update_empty_all(self): - """If the repository in-sync is empty, then it is not safe to - update, regardless of the clean state. - - """ - stat = ExternalStatus() - stat.sync_state = ExternalStatus.UNKNOWN - stat.clean_state = ExternalStatus.DEFAULT - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.EMPTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.UNKNOWN - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.STATUS_OK - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - stat.clean_state = ExternalStatus.DIRTY - safe_to_update = stat.safe_to_update() - self.assertFalse(safe_to_update) - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_unit_repository.py b/manage_externals/test/test_unit_repository.py deleted file mode 100644 index 5b9c242fd3..0000000000 --- a/manage_externals/test/test_unit_repository.py +++ /dev/null @@ -1,208 +0,0 @@ -#!/usr/bin/env python - -"""Unit test driver for checkout_externals - -Note: this script assume the path to the checkout_externals.py module is -already in the python path. - -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import unittest - -from manic.repository_factory import create_repository -from manic.repository_git import GitRepository -from manic.repository_svn import SvnRepository -from manic.repository import Repository -from manic.externals_description import ExternalsDescription -from manic.global_constants import EMPTY_STR - - -class TestCreateRepositoryDict(unittest.TestCase): - """Test the create_repository functionality to ensure it returns the - propper type of repository and errors for unknown repository - types. - - """ - - def setUp(self): - """Common data needed for all tests in this class - """ - self._name = 'test_name' - self._repo = {ExternalsDescription.PROTOCOL: None, - ExternalsDescription.REPO_URL: 'junk_root', - ExternalsDescription.TAG: 'junk_tag', - ExternalsDescription.BRANCH: EMPTY_STR, - ExternalsDescription.HASH: EMPTY_STR, - ExternalsDescription.SPARSE: EMPTY_STR, } - - def test_create_repo_git(self): - """Verify that several possible names for the 'git' protocol - create git repository objects. - - """ - protocols = ['git', 'GIT', 'Git', ] - for protocol in protocols: - self._repo[ExternalsDescription.PROTOCOL] = protocol - repo = create_repository(self._name, self._repo) - self.assertIsInstance(repo, GitRepository) - - def test_create_repo_svn(self): - """Verify that several possible names for the 'svn' protocol - create svn repository objects. - """ - protocols = ['svn', 'SVN', 'Svn', ] - for protocol in protocols: - self._repo[ExternalsDescription.PROTOCOL] = protocol - repo = create_repository(self._name, self._repo) - self.assertIsInstance(repo, SvnRepository) - - def test_create_repo_externals_only(self): - """Verify that an externals only repo returns None. - """ - protocols = ['externals_only', ] - for protocol in protocols: - self._repo[ExternalsDescription.PROTOCOL] = protocol - repo = create_repository(self._name, self._repo) - self.assertEqual(None, repo) - - def test_create_repo_unsupported(self): - """Verify that an unsupported protocol generates a runtime error. - """ - protocols = ['not_a_supported_protocol', ] - for protocol in protocols: - self._repo[ExternalsDescription.PROTOCOL] = protocol - with self.assertRaises(RuntimeError): - create_repository(self._name, self._repo) - - -class TestRepository(unittest.TestCase): - """Test the externals description processing used to create the Repository - base class shared by protocol specific repository classes. - - """ - - def test_tag(self): - """Test creation of a repository object with a tag - """ - name = 'test_repo' - protocol = 'test_protocol' - url = 'test_url' - tag = 'test_tag' - repo_info = {ExternalsDescription.PROTOCOL: protocol, - ExternalsDescription.REPO_URL: url, - ExternalsDescription.TAG: tag, - ExternalsDescription.BRANCH: EMPTY_STR, - ExternalsDescription.HASH: EMPTY_STR, - ExternalsDescription.SPARSE: EMPTY_STR, } - repo = Repository(name, repo_info) - print(repo.__dict__) - self.assertEqual(repo.tag(), tag) - self.assertEqual(repo.url(), url) - - def test_branch(self): - """Test creation of a repository object with a branch - """ - name = 'test_repo' - protocol = 'test_protocol' - url = 'test_url' - branch = 'test_branch' - repo_info = {ExternalsDescription.PROTOCOL: protocol, - ExternalsDescription.REPO_URL: url, - ExternalsDescription.BRANCH: branch, - ExternalsDescription.TAG: EMPTY_STR, - ExternalsDescription.HASH: EMPTY_STR, - ExternalsDescription.SPARSE: EMPTY_STR, } - repo = Repository(name, repo_info) - print(repo.__dict__) - self.assertEqual(repo.branch(), branch) - self.assertEqual(repo.url(), url) - - def test_hash(self): - """Test creation of a repository object with a hash - """ - name = 'test_repo' - protocol = 'test_protocol' - url = 'test_url' - ref = 'deadc0de' - sparse = EMPTY_STR - repo_info = {ExternalsDescription.PROTOCOL: protocol, - ExternalsDescription.REPO_URL: url, - ExternalsDescription.BRANCH: EMPTY_STR, - ExternalsDescription.TAG: EMPTY_STR, - ExternalsDescription.HASH: ref, - ExternalsDescription.SPARSE: sparse, } - repo = Repository(name, repo_info) - print(repo.__dict__) - self.assertEqual(repo.hash(), ref) - self.assertEqual(repo.url(), url) - - def test_tag_branch(self): - """Test creation of a repository object with a tag and branch raises a - runtimer error. - - """ - name = 'test_repo' - protocol = 'test_protocol' - url = 'test_url' - branch = 'test_branch' - tag = 'test_tag' - ref = EMPTY_STR - sparse = EMPTY_STR - repo_info = {ExternalsDescription.PROTOCOL: protocol, - ExternalsDescription.REPO_URL: url, - ExternalsDescription.BRANCH: branch, - ExternalsDescription.TAG: tag, - ExternalsDescription.HASH: ref, - ExternalsDescription.SPARSE: sparse, } - with self.assertRaises(RuntimeError): - Repository(name, repo_info) - - def test_tag_branch_hash(self): - """Test creation of a repository object with a tag, branch and hash raises a - runtimer error. - - """ - name = 'test_repo' - protocol = 'test_protocol' - url = 'test_url' - branch = 'test_branch' - tag = 'test_tag' - ref = 'deadc0de' - sparse = EMPTY_STR - repo_info = {ExternalsDescription.PROTOCOL: protocol, - ExternalsDescription.REPO_URL: url, - ExternalsDescription.BRANCH: branch, - ExternalsDescription.TAG: tag, - ExternalsDescription.HASH: ref, - ExternalsDescription.SPARSE: sparse, } - with self.assertRaises(RuntimeError): - Repository(name, repo_info) - - def test_no_tag_no_branch(self): - """Test creation of a repository object without a tag or branch raises a - runtimer error. - - """ - name = 'test_repo' - protocol = 'test_protocol' - url = 'test_url' - branch = EMPTY_STR - tag = EMPTY_STR - ref = EMPTY_STR - sparse = EMPTY_STR - repo_info = {ExternalsDescription.PROTOCOL: protocol, - ExternalsDescription.REPO_URL: url, - ExternalsDescription.BRANCH: branch, - ExternalsDescription.TAG: tag, - ExternalsDescription.HASH: ref, - ExternalsDescription.SPARSE: sparse, } - with self.assertRaises(RuntimeError): - Repository(name, repo_info) - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_unit_repository_git.py b/manage_externals/test/test_unit_repository_git.py deleted file mode 100644 index 4a0a334bb1..0000000000 --- a/manage_externals/test/test_unit_repository_git.py +++ /dev/null @@ -1,808 +0,0 @@ -#!/usr/bin/env python - -"""Unit test driver for checkout_externals - -Note: this script assume the path to the checkout_externals.py module is -already in the python path. - -""" -# pylint: disable=too-many-lines,protected-access - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import os -import shutil -import unittest - -from manic.repository_git import GitRepository -from manic.externals_status import ExternalStatus -from manic.externals_description import ExternalsDescription -from manic.externals_description import ExternalsDescriptionDict -from manic.global_constants import EMPTY_STR - -# NOTE(bja, 2017-11) order is important here. origin should be a -# subset of other to trap errors on processing remotes! -GIT_REMOTE_OUTPUT_ORIGIN_UPSTREAM = ''' -upstream /path/to/other/repo (fetch) -upstream /path/to/other/repo (push) -other /path/to/local/repo2 (fetch) -other /path/to/local/repo2 (push) -origin /path/to/local/repo (fetch) -origin /path/to/local/repo (push) -''' - - -class TestGitRepositoryCurrentRef(unittest.TestCase): - """test the current_ref command on a git repository - """ - - def setUp(self): - self._name = 'component' - rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: - '/path/to/local/repo', - ExternalsDescription.TAG: - 'tag1', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: 'junk', - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdata, - }, - } - - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = GitRepository('test', repo) - - # - # mock methods replacing git system calls - # - @staticmethod - def _git_current_branch(branch_found, branch_name): - """Return a function that takes the place of - repo._git_current_branch, which returns the given output.""" - def my_git_current_branch(): - """mock function that can take the place of repo._git_current_branch""" - return branch_found, branch_name - return my_git_current_branch - - @staticmethod - def _git_current_tag(tag_found, tag_name): - """Return a function that takes the place of - repo._git_current_tag, which returns the given output.""" - def my_git_current_tag(): - """mock function that can take the place of repo._git_current_tag""" - return tag_found, tag_name - return my_git_current_tag - - @staticmethod - def _git_current_hash(hash_found, hash_name): - """Return a function that takes the place of - repo._git_current_hash, which returns the given output.""" - def my_git_current_hash(): - """mock function that can take the place of repo._git_current_hash""" - return hash_found, hash_name - return my_git_current_hash - - # ------------------------------------------------------------------------ - # Begin tests - # ------------------------------------------------------------------------ - - def test_ref_branch(self): - """Test that we correctly identify we are on a branch - """ - self._repo._git_current_branch = self._git_current_branch( - True, 'feature3') - self._repo._git_current_tag = self._git_current_tag(True, 'foo_tag') - self._repo._git_current_hash = self._git_current_hash(True, 'abc123') - expected = 'feature3' - result = self._repo._current_ref() - self.assertEqual(result, expected) - - def test_ref_detached_tag(self): - """Test that we correctly identify that the ref is detached at a tag - """ - self._repo._git_current_branch = self._git_current_branch(False, '') - self._repo._git_current_tag = self._git_current_tag(True, 'foo_tag') - self._repo._git_current_hash = self._git_current_hash(True, 'abc123') - expected = 'foo_tag' - result = self._repo._current_ref() - self.assertEqual(result, expected) - - def test_ref_detached_hash(self): - """Test that we can identify ref is detached at a hash - - """ - self._repo._git_current_branch = self._git_current_branch(False, '') - self._repo._git_current_tag = self._git_current_tag(False, '') - self._repo._git_current_hash = self._git_current_hash(True, 'abc123') - expected = 'abc123' - result = self._repo._current_ref() - self.assertEqual(result, expected) - - def test_ref_none(self): - """Test that we correctly identify that we're not in a git repo. - """ - self._repo._git_current_branch = self._git_current_branch(False, '') - self._repo._git_current_tag = self._git_current_tag(False, '') - self._repo._git_current_hash = self._git_current_hash(False, '') - result = self._repo._current_ref() - self.assertEqual(result, EMPTY_STR) - - -class TestGitRepositoryCheckSync(unittest.TestCase): - """Test whether the GitRepository _check_sync_logic functionality is - correct. - - Note: there are a lot of combinations of state: - - - external description - tag, branch - - - working copy - - doesn't exist (not checked out) - - exists, no git info - incorrect protocol, e.g. svn, or tarball? - - exists, git info - - as expected: - - different from expected: - - detached tag, - - detached hash, - - detached branch (compare remote and branch), - - tracking branch (compare remote and branch), - - same remote - - different remote - - untracked branch - - Test list: - - doesn't exist - - exists no git info - - - num_external * (working copy expected + num_working copy different) - - total tests = 16 - - """ - - # NOTE(bja, 2017-11) pylint complains about long method names, but - # it is hard to differentiate tests without making them more - # cryptic. Also complains about too many public methods, but it - # doesn't really make sense to break this up. - # pylint: disable=invalid-name,too-many-public-methods - - TMP_FAKE_DIR = 'fake' - TMP_FAKE_GIT_DIR = os.path.join(TMP_FAKE_DIR, '.git') - - def setUp(self): - """Setup reusable git repository object - """ - self._name = 'component' - rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: - '/path/to/local/repo', - ExternalsDescription.TAG: 'tag1', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: self.TMP_FAKE_DIR, - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdata, - }, - } - - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = GitRepository('test', repo) - # The unit tests here don't care about the result of - # _current_ref, but we replace it here so that we don't need to - # worry about calling a possibly slow and possibly - # error-producing command (since _current_ref calls various git - # functions): - self._repo._current_ref = self._current_ref_empty - self._create_tmp_git_dir() - - def tearDown(self): - """Cleanup tmp stuff on the file system - """ - self._remove_tmp_git_dir() - - def _create_tmp_git_dir(self): - """Create a temporary fake git directory for testing purposes. - """ - if not os.path.exists(self.TMP_FAKE_GIT_DIR): - os.makedirs(self.TMP_FAKE_GIT_DIR) - - def _remove_tmp_git_dir(self): - """Remove the temporary fake git directory - """ - if os.path.exists(self.TMP_FAKE_DIR): - shutil.rmtree(self.TMP_FAKE_DIR) - - # - # mock methods replacing git system calls - # - @staticmethod - def _current_ref_empty(): - """Return an empty string. - """ - return EMPTY_STR - - @staticmethod - def _git_remote_origin_upstream(): - """Return an info string that is a checkout hash - """ - return GIT_REMOTE_OUTPUT_ORIGIN_UPSTREAM - - @staticmethod - def _git_remote_none(): - """Return an info string that is a checkout hash - """ - return EMPTY_STR - - @staticmethod - def _git_current_hash(myhash): - """Return a function that takes the place of repo._git_current_hash, - which returns the given hash - """ - def my_git_current_hash(): - """mock function that can take the place of repo._git_current_hash""" - return 0, myhash - return my_git_current_hash - - def _git_revparse_commit(self, expected_ref, mystatus, myhash): - """Return a function that takes the place of - repo._git_revparse_commit, which returns a tuple: - (mystatus, myhash). - - Expects the passed-in ref to equal expected_ref - - status = 0 implies success, non-zero implies failure - """ - def my_git_revparse_commit(ref): - """mock function that can take the place of repo._git_revparse_commit""" - self.assertEqual(expected_ref, ref) - return mystatus, myhash - return my_git_revparse_commit - - # ---------------------------------------------------------------- - # - # Tests where working copy doesn't exist or is invalid - # - # ---------------------------------------------------------------- - def test_sync_dir_not_exist(self): - """Test that a directory that doesn't exist returns an error status - - Note: the Repository classes should be prevented from ever - working on an empty directory by the _Source object. - - """ - stat = ExternalStatus() - self._repo._check_sync(stat, 'invalid_directory_name') - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_ERROR) - # check_dir should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_sync_dir_exist_no_git_info(self): - """Test that a non-existent git repo returns an unknown status - """ - stat = ExternalStatus() - # Now we over-ride the _git_remote_verbose method on the repo to return - # a known value without requiring access to git. - self._repo._git_remote_verbose = self._git_remote_origin_upstream - self._repo._tag = 'tag1' - self._repo._git_current_hash = self._git_current_hash('') - self._repo._git_revparse_commit = self._git_revparse_commit( - 'tag1', 1, '') - self._repo._check_sync(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.UNKNOWN) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - # ------------------------------------------------------------------------ - # - # Tests where version in configuration file is not a valid reference - # - # ------------------------------------------------------------------------ - - def test_sync_invalid_reference(self): - """Test that an invalid reference returns out-of-sync - """ - stat = ExternalStatus() - self._repo._git_remote_verbose = self._git_remote_origin_upstream - self._repo._tag = 'tag1' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = self._git_revparse_commit( - 'tag1', 1, '') - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - # ---------------------------------------------------------------- - # - # Tests where external description specifies a tag - # - # ---------------------------------------------------------------- - def test_sync_tag_on_same_hash(self): - """Test expect tag on same hash --> status ok - - """ - stat = ExternalStatus() - self._repo._git_remote_verbose = self._git_remote_origin_upstream - self._repo._tag = 'tag1' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = self._git_revparse_commit( - 'tag1', 0, 'abc123') - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_sync_tag_on_different_hash(self): - """Test expect tag on a different hash --> status modified - - """ - stat = ExternalStatus() - self._repo._git_remote_verbose = self._git_remote_origin_upstream - self._repo._tag = 'tag1' - self._repo._git_current_hash = self._git_current_hash('def456') - self._repo._git_revparse_commit = self._git_revparse_commit( - 'tag1', 0, 'abc123') - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - # ---------------------------------------------------------------- - # - # Tests where external description specifies a hash - # - # ---------------------------------------------------------------- - def test_sync_hash_on_same_hash(self): - """Test expect hash on same hash --> status ok - - """ - stat = ExternalStatus() - self._repo._git_remote_verbose = self._git_remote_origin_upstream - self._repo._tag = '' - self._repo._hash = 'abc' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = self._git_revparse_commit( - 'abc', 0, 'abc123') - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_sync_hash_on_different_hash(self): - """Test expect hash on a different hash --> status modified - - """ - stat = ExternalStatus() - self._repo._git_remote_verbose = self._git_remote_origin_upstream - self._repo._tag = '' - self._repo._hash = 'abc' - self._repo._git_current_hash = self._git_current_hash('def456') - self._repo._git_revparse_commit = self._git_revparse_commit( - 'abc', 0, 'abc123') - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - # ---------------------------------------------------------------- - # - # Tests where external description specifies a branch - # - # ---------------------------------------------------------------- - def test_sync_branch_on_same_hash(self): - """Test expect branch on same hash --> status ok - - """ - stat = ExternalStatus() - self._repo._git_remote_verbose = self._git_remote_origin_upstream - self._repo._branch = 'feature-2' - self._repo._tag = '' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = ( - self._git_revparse_commit('origin/feature-2', 0, 'abc123')) - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_sync_branch_on_diff_hash(self): - """Test expect branch on diff hash --> status modified - - """ - stat = ExternalStatus() - self._repo._git_remote_verbose = self._git_remote_origin_upstream - self._repo._branch = 'feature-2' - self._repo._tag = '' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = ( - self._git_revparse_commit('origin/feature-2', 0, 'def456')) - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_sync_branch_diff_remote(self): - """Test _determine_remote_name with a different remote - - """ - stat = ExternalStatus() - self._repo._git_remote_verbose = self._git_remote_origin_upstream - self._repo._branch = 'feature-2' - self._repo._tag = '' - self._repo._url = '/path/to/other/repo' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = ( - self._git_revparse_commit('upstream/feature-2', 0, 'def456')) - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - # The test passes if _git_revparse_commit is called with the - # expected argument - - def test_sync_branch_diff_remote2(self): - """Test _determine_remote_name with a different remote - - """ - stat = ExternalStatus() - self._repo._git_remote_verbose = self._git_remote_origin_upstream - self._repo._branch = 'feature-2' - self._repo._tag = '' - self._repo._url = '/path/to/local/repo2' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = ( - self._git_revparse_commit('other/feature-2', 0, 'def789')) - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - # The test passes if _git_revparse_commit is called with the - # expected argument - - def test_sync_branch_on_unknown_remote(self): - """Test expect branch, but remote is unknown --> status modified - - """ - stat = ExternalStatus() - self._repo._git_remote_verbose = self._git_remote_origin_upstream - self._repo._branch = 'feature-2' - self._repo._tag = '' - self._repo._url = '/path/to/unknown/repo' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = ( - self._git_revparse_commit('unknown_remote/feature-2', 1, '')) - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_sync_branch_on_untracked_local(self): - """Test expect branch, on untracked branch in local repo --> status ok - - Setting the externals description to '.' indicates that the - user only wants to consider the current local repo state - without fetching from remotes. This is required to preserve - the current branch of a repository during an update. - - """ - stat = ExternalStatus() - self._repo._git_remote_verbose = self._git_remote_origin_upstream - self._repo._branch = 'feature3' - self._repo._tag = '' - self._repo._url = '.' - self._repo._git_current_hash = self._git_current_hash('abc123') - self._repo._git_revparse_commit = ( - self._git_revparse_commit('feature3', 0, 'abc123')) - self._repo._check_sync_logic(stat, self.TMP_FAKE_DIR) - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) - # check_sync should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - -class TestGitStatusPorcelain(unittest.TestCase): - """Test parsing of output from git status --porcelain=v1 -z - """ - # pylint: disable=C0103 - GIT_STATUS_PORCELAIN_V1_ALL = ( - r' D INSTALL\0MM Makefile\0M README.md\0R cmakelists.txt\0' - r'CMakeLists.txt\0D commit-message-template.txt\0A stuff.txt\0' - r'?? junk.txt') - - GIT_STATUS_PORCELAIN_CLEAN = r'' - - def test_porcelain_status_dirty(self): - """Verify that git status output is considered dirty when there are - listed files. - - """ - git_output = self.GIT_STATUS_PORCELAIN_V1_ALL - is_dirty = GitRepository._status_v1z_is_dirty(git_output) - self.assertTrue(is_dirty) - - def test_porcelain_status_clean(self): - """Verify that git status output is considered clean when there are no - listed files. - - """ - git_output = self.GIT_STATUS_PORCELAIN_CLEAN - is_dirty = GitRepository._status_v1z_is_dirty(git_output) - self.assertFalse(is_dirty) - - -class TestGitCreateRemoteName(unittest.TestCase): - """Test the create_remote_name method on the GitRepository class - """ - - def setUp(self): - """Common infrastructure for testing _create_remote_name - """ - self._rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: - 'empty', - ExternalsDescription.TAG: - 'very_useful_tag', - ExternalsDescription.BRANCH: EMPTY_STR, - ExternalsDescription.HASH: EMPTY_STR, - ExternalsDescription.SPARSE: EMPTY_STR, } - self._repo = GitRepository('test', self._rdata) - - def test_remote_git_proto(self): - """Test remote with git protocol - """ - self._repo._url = 'git@git.github.com:very_nice_org/useful_repo' - remote_name = self._repo._create_remote_name() - self.assertEqual(remote_name, 'very_nice_org_useful_repo') - - def test_remote_https_proto(self): - """Test remote with git protocol - """ - self._repo._url = 'https://www.github.com/very_nice_org/useful_repo' - remote_name = self._repo._create_remote_name() - self.assertEqual(remote_name, 'very_nice_org_useful_repo') - - def test_remote_local_abs(self): - """Test remote with git protocol - """ - self._repo._url = '/path/to/local/repositories/useful_repo' - remote_name = self._repo._create_remote_name() - self.assertEqual(remote_name, 'repositories_useful_repo') - - def test_remote_local_rel(self): - """Test remote with git protocol - """ - os.environ['TEST_VAR'] = '/my/path/to/repos' - self._repo._url = '${TEST_VAR}/../../useful_repo' - remote_name = self._repo._create_remote_name() - self.assertEqual(remote_name, 'path_useful_repo') - del os.environ['TEST_VAR'] - - -class TestVerifyTag(unittest.TestCase): - """Test logic verifying that a tag exists and is unique - - """ - - def setUp(self): - """Setup reusable git repository object - """ - self._name = 'component' - rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: - '/path/to/local/repo', - ExternalsDescription.TAG: 'tag1', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: 'tmp', - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdata, - }, - } - - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = GitRepository('test', repo) - - @staticmethod - def _shell_true(url, remote=None): - _ = url - _ = remote - return 0 - - @staticmethod - def _shell_false(url, remote=None): - _ = url - _ = remote - return 1 - - @staticmethod - def _mock_function_true(ref): - _ = ref - return (TestValidRef._shell_true, '97ebc0e0deadc0de') - - @staticmethod - def _mock_function_false(ref): - _ = ref - return (TestValidRef._shell_false, '97ebc0e0deadc0de') - - def test_tag_not_tag_branch_commit(self): - """Verify a non-tag returns false - """ - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_function_false - self._repo._tag = 'something' - remote_name = 'origin' - received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name) - self.assertFalse(received) - - def test_tag_not_tag(self): - """Verify a non-tag, untracked remote returns false - """ - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_true - self._repo._git_lsremote_branch = self._shell_true - self._repo._git_revparse_commit = self._mock_function_false - self._repo._tag = 'tag1' - remote_name = 'origin' - received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name) - self.assertFalse(received) - - def test_tag_indeterminant(self): - """Verify an indeterminant tag/branch returns false - """ - self._repo._git_showref_tag = self._shell_true - self._repo._git_showref_branch = self._shell_true - self._repo._git_lsremote_branch = self._shell_true - self._repo._git_revparse_commit = self._mock_function_true - self._repo._tag = 'something' - remote_name = 'origin' - received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name) - self.assertFalse(received) - - def test_tag_is_unique(self): - """Verify a unique tag match returns true - """ - self._repo._git_showref_tag = self._shell_true - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_function_true - self._repo._tag = 'tag1' - remote_name = 'origin' - received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name) - self.assertTrue(received) - - def test_tag_is_not_hash(self): - """Verify a commit hash is not classified as a tag - """ - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_function_true - self._repo._tag = '97ebc0e0' - remote_name = 'origin' - received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name) - self.assertFalse(received) - - def test_hash_is_commit(self): - """Verify a commit hash is not classified as a tag - """ - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_function_true - self._repo._tag = '97ebc0e0' - remote_name = 'origin' - received, _ = self._repo._is_unique_tag(self._repo._tag, remote_name) - self.assertFalse(received) - - -class TestValidRef(unittest.TestCase): - """Test logic verifying that a reference is a valid tag, branch or sha1 - - """ - - def setUp(self): - """Setup reusable git repository object - """ - self._name = 'component' - rdata = {ExternalsDescription.PROTOCOL: 'git', - ExternalsDescription.REPO_URL: - '/path/to/local/repo', - ExternalsDescription.TAG: 'tag1', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: 'tmp', - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdata, - }, - } - - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = GitRepository('test', repo) - - @staticmethod - def _shell_true(url, remote=None): - _ = url - _ = remote - return 0 - - @staticmethod - def _shell_false(url, remote=None): - _ = url - _ = remote - return 1 - - @staticmethod - def _mock_function_false(ref): - _ = ref - return (TestValidRef._shell_false, '') - - @staticmethod - def _mock_function_true(ref): - _ = ref - return (TestValidRef._shell_true, '') - - def test_valid_ref_is_invalid(self): - """Verify an invalid reference raises an exception - """ - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_function_false - self._repo._tag = 'invalid_ref' - with self.assertRaises(RuntimeError): - self._repo._check_for_valid_ref(self._repo._tag) - - def test_valid_tag(self): - """Verify a valid tag return true - """ - self._repo._git_showref_tag = self._shell_true - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_function_true - self._repo._tag = 'tag1' - received = self._repo._check_for_valid_ref(self._repo._tag) - self.assertTrue(received) - - def test_valid_branch(self): - """Verify a valid tag return true - """ - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_true - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = self._mock_function_true - self._repo._tag = 'tag1' - received = self._repo._check_for_valid_ref(self._repo._tag) - self.assertTrue(received) - - def test_valid_hash(self): - """Verify a valid hash return true - """ - def _mock_revparse_commit(ref): - _ = ref - return (0, '56cc0b539426eb26810af9e') - - self._repo._git_showref_tag = self._shell_false - self._repo._git_showref_branch = self._shell_false - self._repo._git_lsremote_branch = self._shell_false - self._repo._git_revparse_commit = _mock_revparse_commit - self._repo._hash = '56cc0b5394' - received = self._repo._check_for_valid_ref(self._repo._hash) - self.assertTrue(received) - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_unit_repository_svn.py b/manage_externals/test/test_unit_repository_svn.py deleted file mode 100644 index 7ff31c4218..0000000000 --- a/manage_externals/test/test_unit_repository_svn.py +++ /dev/null @@ -1,501 +0,0 @@ -#!/usr/bin/env python - -"""Unit test driver for checkout_externals - -Note: this script assume the path to the checkout_externals.py module is -already in the python path. - -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import unittest - -from manic.repository_svn import SvnRepository -from manic.externals_status import ExternalStatus -from manic.externals_description import ExternalsDescription -from manic.externals_description import ExternalsDescriptionDict -from manic.global_constants import EMPTY_STR - -# pylint: disable=W0212 - -SVN_INFO_MOSART = """Path: components/mosart -Working Copy Root Path: /Users/andreb/projects/ncar/git-conversion/clm-dev-experimental/components/mosart -URL: https://svn-ccsm-models.cgd.ucar.edu/mosart/trunk_tags/mosart1_0_26 -Relative URL: ^/mosart/trunk_tags/mosart1_0_26 -Repository Root: https://svn-ccsm-models.cgd.ucar.edu -Repository UUID: fe37f545-8307-0410-aea5-b40df96820b5 -Revision: 86711 -Node Kind: directory -Schedule: normal -Last Changed Author: erik -Last Changed Rev: 86031 -Last Changed Date: 2017-07-07 12:28:10 -0600 (Fri, 07 Jul 2017) -""" -SVN_INFO_CISM = """ -Path: components/cism -Working Copy Root Path: /Users/andreb/projects/ncar/git-conversion/clm-dev-experimental/components/cism -URL: https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism2_1_37 -Relative URL: ^/glc/trunk_tags/cism2_1_37 -Repository Root: https://svn-ccsm-models.cgd.ucar.edu -Repository UUID: fe37f545-8307-0410-aea5-b40df96820b5 -Revision: 86711 -Node Kind: directory -Schedule: normal -Last Changed Author: sacks -Last Changed Rev: 85704 -Last Changed Date: 2017-06-15 05:59:28 -0600 (Thu, 15 Jun 2017) -""" - - -class TestSvnRepositoryCheckURL(unittest.TestCase): - """Verify that the svn_check_url function is working as expected. - """ - - def setUp(self): - """Setup reusable svn repository object - """ - self._name = 'component' - rdata = {ExternalsDescription.PROTOCOL: 'svn', - ExternalsDescription.REPO_URL: - 'https://svn-ccsm-models.cgd.ucar.edu/', - ExternalsDescription.TAG: - 'mosart/trunk_tags/mosart1_0_26', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: 'junk', - ExternalsDescription.EXTERNALS: '', - ExternalsDescription.REPO: rdata, - }, - } - - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = SvnRepository('test', repo) - - def test_check_url_same(self): - """Test that we correctly identify that the correct URL. - """ - svn_output = SVN_INFO_MOSART - expected_url = self._repo.url() - result, current_version = \ - self._repo._check_url(svn_output, expected_url) - self.assertEqual(result, ExternalStatus.STATUS_OK) - self.assertEqual(current_version, 'mosart/trunk_tags/mosart1_0_26') - - def test_check_url_different(self): - """Test that we correctly reject an incorrect URL. - """ - svn_output = SVN_INFO_CISM - expected_url = self._repo.url() - result, current_version = \ - self._repo._check_url(svn_output, expected_url) - self.assertEqual(result, ExternalStatus.MODEL_MODIFIED) - self.assertEqual(current_version, 'glc/trunk_tags/cism2_1_37') - - def test_check_url_none(self): - """Test that we can handle an empty string for output, e.g. not an svn - repo. - - """ - svn_output = EMPTY_STR - expected_url = self._repo.url() - result, current_version = \ - self._repo._check_url(svn_output, expected_url) - self.assertEqual(result, ExternalStatus.UNKNOWN) - self.assertEqual(current_version, '') - - -class TestSvnRepositoryCheckSync(unittest.TestCase): - """Test whether the SvnRepository svn_check_sync functionality is - correct. - - """ - - def setUp(self): - """Setup reusable svn repository object - """ - self._name = "component" - rdata = {ExternalsDescription.PROTOCOL: 'svn', - ExternalsDescription.REPO_URL: - 'https://svn-ccsm-models.cgd.ucar.edu/', - ExternalsDescription.TAG: - 'mosart/trunk_tags/mosart1_0_26', - } - - data = {self._name: - { - ExternalsDescription.REQUIRED: False, - ExternalsDescription.PATH: 'junk', - ExternalsDescription.EXTERNALS: EMPTY_STR, - ExternalsDescription.REPO: rdata, - }, - } - - model = ExternalsDescriptionDict(data) - repo = model[self._name][ExternalsDescription.REPO] - self._repo = SvnRepository('test', repo) - - @staticmethod - def _svn_info_empty(*_): - """Return an empty info string. Simulates svn info failing. - """ - return '' - - @staticmethod - def _svn_info_synced(*_): - """Return an info sting that is synced with the setUp data - """ - return SVN_INFO_MOSART - - @staticmethod - def _svn_info_modified(*_): - """Return and info string that is modified from the setUp data - """ - return SVN_INFO_CISM - - def test_repo_dir_not_exist(self): - """Test that a directory that doesn't exist returns an error status - - Note: the Repository classes should be prevented from ever - working on an empty directory by the _Source object. - - """ - stat = ExternalStatus() - self._repo._check_sync(stat, 'junk') - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_ERROR) - # check_dir should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_repo_dir_exist_no_svn_info(self): - """Test that an empty info string returns an unknown status - """ - stat = ExternalStatus() - # Now we over-ride the _svn_info method on the repo to return - # a known value without requiring access to svn. - self._repo._svn_info = self._svn_info_empty - self._repo._check_sync(stat, '.') - self.assertEqual(stat.sync_state, ExternalStatus.UNKNOWN) - # check_dir should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_repo_dir_synced(self): - """Test that a valid info string that is synced to the repo in the - externals description returns an ok status. - - """ - stat = ExternalStatus() - # Now we over-ride the _svn_info method on the repo to return - # a known value without requiring access to svn. - self._repo._svn_info = self._svn_info_synced - self._repo._check_sync(stat, '.') - self.assertEqual(stat.sync_state, ExternalStatus.STATUS_OK) - # check_dir should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - def test_repo_dir_modified(self): - """Test that a valid svn info string that is out of sync with the - externals description returns a modified status. - - """ - stat = ExternalStatus() - # Now we over-ride the _svn_info method on the repo to return - # a known value without requiring access to svn. - self._repo._svn_info = self._svn_info_modified - self._repo._check_sync(stat, '.') - self.assertEqual(stat.sync_state, ExternalStatus.MODEL_MODIFIED) - # check_dir should only modify the sync_state, not clean_state - self.assertEqual(stat.clean_state, ExternalStatus.DEFAULT) - - -class TestSVNStatusXML(unittest.TestCase): - """Test parsing of svn status xml output - """ - SVN_STATUS_XML_DIRTY_ALL = ''' - - - - - -sacks -2017-06-15T11:59:00.355419Z - - - - - - -sacks -2013-02-07T16:17:56.412878Z - - - - - - -sacks -2017-05-01T16:48:27.893741Z - - - - - - - - - - - - - - - - -''' - - SVN_STATUS_XML_DIRTY_MISSING = ''' - - - - - -sacks -2017-06-15T11:59:00.355419Z - - - - - - - - -''' - - SVN_STATUS_XML_DIRTY_MODIFIED = ''' - - - - - -sacks -2013-02-07T16:17:56.412878Z - - - - - - - - -''' - - SVN_STATUS_XML_DIRTY_DELETED = ''' - - - - - -sacks -2017-05-01T16:48:27.893741Z - - - - - - - - -''' - - SVN_STATUS_XML_DIRTY_UNVERSION = ''' - - - - - - - - - - - -''' - - SVN_STATUS_XML_DIRTY_ADDED = ''' - - - - - - - - - - - -''' - - SVN_STATUS_XML_CLEAN = ''' - - - - - - - - - - - -''' - - def test_xml_status_dirty_missing(self): - """Verify that svn status output is consindered dirty when there is a - missing file. - - """ - svn_output = self.SVN_STATUS_XML_DIRTY_MISSING - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertTrue(is_dirty) - - def test_xml_status_dirty_modified(self): - """Verify that svn status output is consindered dirty when there is a - modified file. - """ - svn_output = self.SVN_STATUS_XML_DIRTY_MODIFIED - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertTrue(is_dirty) - - def test_xml_status_dirty_deleted(self): - """Verify that svn status output is consindered dirty when there is a - deleted file. - """ - svn_output = self.SVN_STATUS_XML_DIRTY_DELETED - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertTrue(is_dirty) - - def test_xml_status_dirty_unversion(self): - """Verify that svn status output ignores unversioned files when making - the clean/dirty decision. - - """ - svn_output = self.SVN_STATUS_XML_DIRTY_UNVERSION - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertFalse(is_dirty) - - def test_xml_status_dirty_added(self): - """Verify that svn status output is consindered dirty when there is a - added file. - """ - svn_output = self.SVN_STATUS_XML_DIRTY_ADDED - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertTrue(is_dirty) - - def test_xml_status_dirty_all(self): - """Verify that svn status output is consindered dirty when there are - multiple dirty files.. - - """ - svn_output = self.SVN_STATUS_XML_DIRTY_ALL - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertTrue(is_dirty) - - def test_xml_status_dirty_clean(self): - """Verify that svn status output is consindered clean when there are - no 'dirty' files. This means accepting untracked and externals. - - """ - svn_output = self.SVN_STATUS_XML_CLEAN - is_dirty = SvnRepository.xml_status_is_dirty( - svn_output) - self.assertFalse(is_dirty) - - -if __name__ == '__main__': - unittest.main() diff --git a/manage_externals/test/test_unit_utils.py b/manage_externals/test/test_unit_utils.py deleted file mode 100644 index c994e58ebe..0000000000 --- a/manage_externals/test/test_unit_utils.py +++ /dev/null @@ -1,350 +0,0 @@ -#!/usr/bin/env python - -"""Unit test driver for checkout_externals - -Note: this script assume the path to the checkout_externals.py module is -already in the python path. - -""" - -from __future__ import absolute_import -from __future__ import unicode_literals -from __future__ import print_function - -import os -import unittest - -from manic.utils import last_n_lines, indent_string -from manic.utils import str_to_bool, execute_subprocess -from manic.utils import is_remote_url, split_remote_url, expand_local_url - - -class TestExecuteSubprocess(unittest.TestCase): - """Test the application logic of execute_subprocess wrapper - """ - - def test_exesub_return_stat_err(self): - """Test that execute_subprocess returns a status code when caller - requests and the executed subprocess fails. - - """ - cmd = ['false'] - status = execute_subprocess(cmd, status_to_caller=True) - self.assertEqual(status, 1) - - def test_exesub_return_stat_ok(self): - """Test that execute_subprocess returns a status code when caller - requests and the executed subprocess succeeds. - - """ - cmd = ['true'] - status = execute_subprocess(cmd, status_to_caller=True) - self.assertEqual(status, 0) - - def test_exesub_except_stat_err(self): - """Test that execute_subprocess raises an exception on error when - caller doesn't request return code - - """ - cmd = ['false'] - with self.assertRaises(RuntimeError): - execute_subprocess(cmd, status_to_caller=False) - - -class TestLastNLines(unittest.TestCase): - """Test the last_n_lines function. - - """ - - def test_last_n_lines_short(self): - """With a message with <= n lines, result of last_n_lines should - just be the original message. - - """ - mystr = """three -line -string -""" - - mystr_truncated = last_n_lines( - mystr, 3, truncation_message='[truncated]') - self.assertEqual(mystr, mystr_truncated) - - def test_last_n_lines_long(self): - """With a message with > n lines, result of last_n_lines should - be a truncated string. - - """ - mystr = """a -big -five -line -string -""" - expected = """[truncated] -five -line -string -""" - - mystr_truncated = last_n_lines( - mystr, 3, truncation_message='[truncated]') - self.assertEqual(expected, mystr_truncated) - - -class TestIndentStr(unittest.TestCase): - """Test the indent_string function. - - """ - - def test_indent_string_singleline(self): - """Test the indent_string function with a single-line string - - """ - mystr = 'foo' - result = indent_string(mystr, 4) - expected = ' foo' - self.assertEqual(expected, result) - - def test_indent_string_multiline(self): - """Test the indent_string function with a multi-line string - - """ - mystr = """hello -hi -goodbye -""" - result = indent_string(mystr, 2) - expected = """ hello - hi - goodbye -""" - self.assertEqual(expected, result) - - -class TestStrToBool(unittest.TestCase): - """Test the string to boolean conversion routine. - - """ - - def test_case_insensitive_true(self): - """Verify that case insensitive variants of 'true' returns the True - boolean. - - """ - values = ['true', 'TRUE', 'True', 'tRuE', 't', 'T', ] - for value in values: - received = str_to_bool(value) - self.assertTrue(received) - - def test_case_insensitive_false(self): - """Verify that case insensitive variants of 'false' returns the False - boolean. - - """ - values = ['false', 'FALSE', 'False', 'fAlSe', 'f', 'F', ] - for value in values: - received = str_to_bool(value) - self.assertFalse(received) - - def test_invalid_str_error(self): - """Verify that a non-true/false string generates a runtime error. - """ - values = ['not_true_or_false', 'A', '1', '0', - 'false_is_not_true', 'true_is_not_false'] - for value in values: - with self.assertRaises(RuntimeError): - str_to_bool(value) - - -class TestIsRemoteURL(unittest.TestCase): - """Crude url checking to determine if a url is local or remote. - - """ - - def test_url_remote_git(self): - """verify that a remote git url is identified. - """ - url = 'git@somewhere' - is_remote = is_remote_url(url) - self.assertTrue(is_remote) - - def test_url_remote_ssh(self): - """verify that a remote ssh url is identified. - """ - url = 'ssh://user@somewhere' - is_remote = is_remote_url(url) - self.assertTrue(is_remote) - - def test_url_remote_http(self): - """verify that a remote http url is identified. - """ - url = 'http://somewhere' - is_remote = is_remote_url(url) - self.assertTrue(is_remote) - - def test_url_remote_https(self): - """verify that a remote https url is identified. - """ - url = 'https://somewhere' - is_remote = is_remote_url(url) - self.assertTrue(is_remote) - - def test_url_local_user(self): - """verify that a local path with '~/path/to/repo' gets rejected - - """ - url = '~/path/to/repo' - is_remote = is_remote_url(url) - self.assertFalse(is_remote) - - def test_url_local_var_curly(self): - """verify that a local path with env var '${HOME}' gets rejected - """ - url = '${HOME}/path/to/repo' - is_remote = is_remote_url(url) - self.assertFalse(is_remote) - - def test_url_local_var(self): - """verify that a local path with an env var '$HOME' gets rejected - """ - url = '$HOME/path/to/repo' - is_remote = is_remote_url(url) - self.assertFalse(is_remote) - - def test_url_local_abs(self): - """verify that a local abs path gets rejected - """ - url = '/path/to/repo' - is_remote = is_remote_url(url) - self.assertFalse(is_remote) - - def test_url_local_rel(self): - """verify that a local relative path gets rejected - """ - url = '../../path/to/repo' - is_remote = is_remote_url(url) - self.assertFalse(is_remote) - - -class TestSplitRemoteURL(unittest.TestCase): - """Crude url checking to determine if a url is local or remote. - - """ - - def test_url_remote_git(self): - """verify that a remote git url is identified. - """ - url = 'git@somewhere.com:org/repo' - received = split_remote_url(url) - self.assertEqual(received, "org/repo") - - def test_url_remote_ssh(self): - """verify that a remote ssh url is identified. - """ - url = 'ssh://user@somewhere.com/path/to/repo' - received = split_remote_url(url) - self.assertEqual(received, 'somewhere.com/path/to/repo') - - def test_url_remote_http(self): - """verify that a remote http url is identified. - """ - url = 'http://somewhere.org/path/to/repo' - received = split_remote_url(url) - self.assertEqual(received, 'somewhere.org/path/to/repo') - - def test_url_remote_https(self): - """verify that a remote http url is identified. - """ - url = 'http://somewhere.gov/path/to/repo' - received = split_remote_url(url) - self.assertEqual(received, 'somewhere.gov/path/to/repo') - - def test_url_local_url_unchanged(self): - """verify that a local path is unchanged - - """ - url = '/path/to/repo' - received = split_remote_url(url) - self.assertEqual(received, url) - - -class TestExpandLocalURL(unittest.TestCase): - """Crude url checking to determine if a url is local or remote. - - Remote should be unmodified. - - Local, should perform user and variable expansion. - - """ - - def test_url_local_user1(self): - """verify that a local path with '~/path/to/repo' gets expanded to an - absolute path. - - NOTE(bja, 2017-11) we can't test for something like: - '~user/path/to/repo' because the user has to be in the local - machine password directory and we don't know a user name that - is valid on every system....? - - """ - field = 'test' - url = '~/path/to/repo' - received = expand_local_url(url, field) - print(received) - self.assertTrue(os.path.isabs(received)) - - def test_url_local_expand_curly(self): - """verify that a local path with '${HOME}' gets expanded to an absolute path. - """ - field = 'test' - url = '${HOME}/path/to/repo' - received = expand_local_url(url, field) - self.assertTrue(os.path.isabs(received)) - - def test_url_local_expand_var(self): - """verify that a local path with '$HOME' gets expanded to an absolute path. - """ - field = 'test' - url = '$HOME/path/to/repo' - received = expand_local_url(url, field) - self.assertTrue(os.path.isabs(received)) - - def test_url_local_env_missing(self): - """verify that a local path with env var that is missing gets left as-is - - """ - field = 'test' - url = '$TMP_VAR/path/to/repo' - received = expand_local_url(url, field) - print(received) - self.assertEqual(received, url) - - def test_url_local_expand_env(self): - """verify that a local path with another env var gets expanded to an - absolute path. - - """ - field = 'test' - os.environ['TMP_VAR'] = '/some/absolute' - url = '$TMP_VAR/path/to/repo' - received = expand_local_url(url, field) - del os.environ['TMP_VAR'] - print(received) - self.assertTrue(os.path.isabs(received)) - self.assertEqual(received, '/some/absolute/path/to/repo') - - def test_url_local_normalize_rel(self): - """verify that a local path with another env var gets expanded to an - absolute path. - - """ - field = 'test' - url = '/this/is/a/long/../path/to/a/repo' - received = expand_local_url(url, field) - print(received) - self.assertEqual(received, '/this/is/a/path/to/a/repo') - - -if __name__ == '__main__': - unittest.main() diff --git a/share b/share new file mode 160000 index 0000000000..14338bef3f --- /dev/null +++ b/share @@ -0,0 +1 @@ +Subproject commit 14338bef3fa604d49160e376257264db1d3313e5 diff --git a/src/advection/slt/bandij.F90 b/src/advection/slt/bandij.F90 deleted file mode 100644 index 5e0fa303f2..0000000000 --- a/src/advection/slt/bandij.F90 +++ /dev/null @@ -1,85 +0,0 @@ - -subroutine bandij(dlam ,phib ,lamp ,phip ,iband , & - jband ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate longitude and latitude indices that identify the -! intervals on the extended grid that contain the departure points. -! Upon entry, all dep. points should be within jintmx intervals of the -! Northern- and Southern-most model latitudes. Note: the algorithm -! relies on certain relationships of the intervals in the Gaussian grid. -! -! Method: -! dlam Length of increment in equally spaced longitude grid (rad.) -! phib Latitude values for the extended grid. -! lamp Longitude coordinates of the points. It is assumed that -! 0.0 .le. lamp(i) .lt. 2*pi . -! phip Latitude coordinates of the points. -! iband Longitude index of the points. This index points into -! the extended arrays, e.g., -! lam(iband(i)) .le. lamp(i) .lt. lam(iband(i)+1) . -! jband Latitude index of the points. This index points into -! the extended arrays, e.g., -! phib(jband(i)) .le. phip(i) .lt. phib(jband(i)+1) . -! -! Author: J. Olson -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev - use scanslt, only: platd, i1 - - implicit none - -!------------------------------Arguments-------------------------------- - real(r8), intent(in) :: dlam(platd) ! longitude increment - real(r8), intent(in) :: phib(platd) ! latitude coordinates of model grid - real(r8), intent(in) :: lamp(plon,plev) ! longitude coordinates of dep. points - real(r8), intent(in) :: phip(plon,plev) ! latitude coordinates of dep. points - integer , intent(in) :: nlon ! number of longitudes - integer , intent(out) :: iband(plon,plev,4) ! longitude index of dep. points - integer , intent(out) :: jband(plon,plev) ! latitude index of dep. points -!----------------------------------------------------------------------- -! -!---------------------------Local workspace----------------------------- -! - integer i,j,k ! indices - real(r8) dphibr ! reciprocal of an approximate del phi - real(r8) phibs ! latitude of southern-most latitude - real(r8) rdlam(platd) ! reciprocal of longitude increment -! -!----------------------------------------------------------------------- -! - dphibr = 1._r8/( phib(platd/2+1) - phib(platd/2) ) - phibs = phib(1) - do j = 1,platd - rdlam(j) = 1._r8/dlam(j) - end do -! -! Loop over level and longitude - -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i = 1,nlon -! -! Latitude indices. -! - jband(i,k) = int ( (phip(i,k) - phibs)*dphibr + 1._r8 ) - if( phip(i,k) >= phib(jband(i,k)+1) ) then - jband(i,k) = jband(i,k) + 1 - end if -! -! Longitude indices. -! - iband(i,k,1) = i1 + int( lamp(i,k)*rdlam(jband(i,k)-1)) - iband(i,k,2) = iband(i,k,1) - iband(i,k,3) = iband(i,k,1) - iband(i,k,4) = iband(i,k,1) - end do - end do - - return -end subroutine bandij diff --git a/src/advection/slt/basdy.F90 b/src/advection/slt/basdy.F90 deleted file mode 100644 index f5a9a235f6..0000000000 --- a/src/advection/slt/basdy.F90 +++ /dev/null @@ -1,55 +0,0 @@ - -subroutine basdy(phi ,lbasdy ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Compute weights for the calculation of derivative estimates at the two -! center points of the four point stencil for each interval in the -! unequally spaced latitude grid. Estimates are from differentiating -! a Lagrange cubic polynomial through the four point stencil. -! -! Method: -! phi Latitude values in the extended grid. -! lbasdy Weights for derivative estimates based on Lagrange cubic -! polynomial on the unequally spaced latitude grid. -! If grid interval j (in extended grid) is surrounded by -! a 4 point stencil, then the derivative at the "bottom" -! of the interval uses the weights lbasdy(1,1,j), -! lbasdy(2,1,j), lbasdy(3,1,j), and lbasdy(4,1,j). -! The derivative at the "top" of the interval -! uses lbasdy(1,2,j), lbasdy(2,2,j), lbasdy(3,2,j), -! and lbasdy(4,2,j). -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! - use shr_kind_mod, only: r8 => shr_kind_r8 - use scanslt, only: nxpt, platd - implicit none - -!------------------------------Parameters------------------------------- - integer, parameter :: jfirst = nxpt + 1 ! first index to be computed - integer, parameter :: jlast = platd - nxpt - 1 ! last index to be computed -!----------------------------------------------------------------------- - -!------------------------------Arguments-------------------------------- - real(r8), intent(in) :: phi(platd) ! latitude coordinates of model grid - real(r8), intent(out) :: lbasdy(4,2,platd) ! derivative estimate weights -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer jj ! index -!----------------------------------------------------------------------- -! - do jj = jfirst,jlast - call lcdbas( phi(jj-1), lbasdy(1,1,jj), lbasdy(1,2,jj) ) - end do -! - return -end subroutine basdy - diff --git a/src/advection/slt/basdz.F90 b/src/advection/slt/basdz.F90 deleted file mode 100644 index cd6ee79343..0000000000 --- a/src/advection/slt/basdz.F90 +++ /dev/null @@ -1,53 +0,0 @@ - -subroutine basdz(pkdim ,sig ,lbasdz ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Compute weights for the calculation of derivative estimates at two -! center points of the four point stencil for each interval in the -! unequally spaced vertical grid (as defined by the array sig). -! Estimates are from differentiating a Lagrange cubic polynomial -! through the four point stencil. -! -! Method: -! pkdim Number of grid points in vertical grid. -! sig Sigma values in the vertical grid. -! lbasdz Weights for derivative estimates based on Lagrange cubic -! polynomial on the unequally spaced vertical grid. -! If grid interval j is surrounded by a 4 point stencil, -! then the derivative at the "top" of the interval (smaller -! sigma value) uses the weights lbasdz(1,1,j),lbasdz(2,1,j), -! lbasdz(3,1,j), and lbasdz(4,1,j). The derivative at the -! "bottom" of the interval uses lbasdz(1,2,j), lbasdz(2,2,j), -! lbasdz(3,2,j), and lbasdz(4,2,j). (Recall the vertical -! level indices increase from the top of the atmosphere -! towards the bottom.) -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: pkdim ! vertical dimension - real(r8), intent(in) :: sig(pkdim) ! sigma levels (actually a generic vert. coord) - real(r8), intent(out):: lbasdz(4,2,pkdim) ! vertical interpolation weights -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer kk ! index -!----------------------------------------------------------------------- -! - do kk = 2,pkdim-2 - call lcdbas( sig(kk-1), lbasdz(1,1,kk), lbasdz(1,2,kk) ) - end do -! - return -end subroutine basdz - diff --git a/src/advection/slt/basiy.F90 b/src/advection/slt/basiy.F90 deleted file mode 100644 index c3036bfd3c..0000000000 --- a/src/advection/slt/basiy.F90 +++ /dev/null @@ -1,44 +0,0 @@ - -subroutine basiy(phi ,lbasiy ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Compute weights used in Lagrange cubic polynomial interpolation in -! the central interval of a four point stencil. Done for each interval -! in the unequally spaced latitude grid. -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! - use shr_kind_mod, only: r8 => shr_kind_r8 - use scanslt, only: nxpt, platd - implicit none - -!------------------------------Parameters------------------------------- - integer, parameter :: jfirst = nxpt + 1 ! first index to be computed - integer, parameter :: jlast = platd - nxpt - 1 ! last index to be computed -!----------------------------------------------------------------------- - -!------------------------------Arguments-------------------------------- - real(r8), intent(in) :: phi(platd) ! grid values in extended grid - real(r8), intent(out) :: lbasiy(4,2,platd) ! Weights for Lagrange cubic interp -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer jj ! index -!----------------------------------------------------------------------- -! - do jj = jfirst,jlast - call lcbas( phi(jj-1),lbasiy(1,1,jj),lbasiy(1,2,jj) ) - end do -! - return -end subroutine basiy - diff --git a/src/advection/slt/difcor.F90 b/src/advection/slt/difcor.F90 deleted file mode 100644 index f0c9bdb501..0000000000 --- a/src/advection/slt/difcor.F90 +++ /dev/null @@ -1,115 +0,0 @@ - -subroutine difcor(klev ,ztodt ,delps ,u ,v , & - qsave ,pdel ,pint ,t ,tdif , & - udif ,vdif ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Add correction term to t and q horizontal diffusions and -! determine the implied heating rate due to momentum diffusion. -! -! Method: -! 1. Add correction term to t and q horizontal diffusions. This term -! provides a partial correction of horizontal diffusion on hybrid (sigma) -! surfaces to horizontal diffusion on pressure surfaces. The appropriate -! function of surface pressure (delps, which already contains the diffusion -! coefficient and the time step) is computed during the transform -! from spherical harmonic coefficients to grid point values. This term -! can only be applied in the portion of the vertical domain in which -! biharmonic horizontal diffusion is employed. In addition, the term is -! unnecessary on pure pressure levels. -! -! 2. Determine the implied heating rate due to momentum diffusion in order -! to conserve total energy and add it to the temperature. -! Reduce complex matrix (ac) to upper Hessenburg matrix (ac) -! -! Author: D. Williamson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plev, plevp, plon - use physconst, only: cpair, cpvir - use hycoef, only: hybi - use cam_control_mod, only : ideal_phys, adiabatic - implicit none - -!------------------------------Arguments-------------------------------- - - integer , intent(in) :: klev ! k-index of top hybrid level - integer , intent(in) :: nlon ! longitude dimension - real(r8), intent(in) :: ztodt ! twice time step unless nstep = 0 - real(r8), intent(in) :: delps(plon) ! srf press function for correction - real(r8), intent(in) :: u(plon,plev) ! u-wind - real(r8), intent(in) :: v(plon,plev) ! v-wind - real(r8), intent(in) :: qsave(plon,plev) ! moisture fm prv fcst - real(r8), intent(in) :: pdel(plon,plev) ! pdel(k) = pint(k+1) - pint(k) - real(r8), intent(in) :: pint(plon,plevp) ! pressure at model interfaces - real(r8), intent(inout) :: t(plon,plev) ! temperature - real(r8), intent(inout) :: tdif(plon,plev) ! initial/final temperature diffusion - real(r8), intent(inout) :: udif(plon,plev) ! initial/final u-momentum diffusion - real(r8), intent(inout) :: vdif(plon,plev) ! initial/final v-momentum diffusion - -!---------------------------Local workspace----------------------------- - - integer i,k ! longitude, level indices - real(r8) tcor(plon,plev) ! temperature correction term -!----------------------------------------------------------------------- -! -! Compute the pressure surface correction term for horizontal diffusion of -! temperature. -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=klev,plev - if (k==1) then - do i=1,nlon - tcor(i,k) = delps(i)*0.5_r8/pdel(i,k)*(hybi(k+1)*(t(i,k+1)-t(i,k)))*pint(i,plevp) - end do - else if (k==plev) then - do i=1,nlon - tcor(i,k) = delps(i)*0.5_r8/pdel(i,k)*(hybi(k)*(t(i,k)-t(i,k-1)))*pint(i,plevp) - end do - else - do i=1,nlon - tcor(i,k) = delps(i)*0.5_r8/pdel(i,k)*(hybi(k+1)*(t(i,k+1)-t(i,k)) + & - hybi(k )*(t(i,k)-t(i,k-1)))*pint(i,plevp) - end do - end if - end do -! -! Add the temperture diffusion correction to the diffusive heating term -! and to the temperature. -! - if (.not.adiabatic .and. .not.ideal_phys) then -!$OMP PARALLEL DO PRIVATE (K, I) - do k=klev,plev - do i=1,nlon - tdif(i,k) = tdif(i,k) + tcor(i,k)/ztodt - t(i,k) = t(i,k) + tcor(i,k) - end do - end do -! -! Convert momentum diffusion tendencies to heating rates in order to -! conserve internal energy. Add the heating to the temperature and to -! diffusive heating term. -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i=1,nlon - t(i,k) = t(i,k) - ztodt * (u(i,k)*udif(i,k) + v(i,k)*vdif(i,k)) / & - (cpair*(1._r8 + cpvir*qsave(i,k))) - tdif(i,k) = tdif(i,k) - (u(i,k)*udif(i,k) + v(i,k)*vdif(i,k)) / & - (cpair*(1._r8 + cpvir*qsave(i,k))) - end do - end do - end if - - return -end subroutine difcor - diff --git a/src/advection/slt/engy_tdif.F90 b/src/advection/slt/engy_tdif.F90 deleted file mode 100644 index a3826b19cb..0000000000 --- a/src/advection/slt/engy_tdif.F90 +++ /dev/null @@ -1,58 +0,0 @@ - -subroutine engy_tdif(cwava ,w ,t ,tm1 ,pdel , & - difft ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate contribution of current latitude to del-T integral -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- -! - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plev, plon - implicit none -! -!------------------------------Arguments-------------------------------- -! - integer , intent(in) :: nlon ! longitude dimension - real(r8), intent(in) :: cwava ! normalization factor l/(g*plon) - real(r8), intent(in) :: w ! gaussian weight this latitude - real(r8), intent(in) :: t (plon,plev) ! temperature - real(r8), intent(in) :: tm1 (plon,plev) ! temperature (previous timestep) - real(r8), intent(in) :: pdel(plon,plev) ! pressure diff between interfaces - real(r8), intent(out) :: difft ! accumulator -! -!---------------------------Local variables----------------------------- -! - integer i,k ! longitude, level indices - real(r8) const ! temporary constant -! -!----------------------------------------------------------------------- -! -! Integration factor (the 0.5 factor arises because gaussian weights sum to 2) -! - const = cwava*w*0.5_r8 - difft = 0._r8 -! -! Compute mass integral -! - do k=1,plev - do i=1,nlon - difft = difft + pdel(i,k) - end do - end do - - difft = difft*const - - return -end subroutine engy_tdif diff --git a/src/advection/slt/engy_te.F90 b/src/advection/slt/engy_te.F90 deleted file mode 100644 index 138f4acb9c..0000000000 --- a/src/advection/slt/engy_te.F90 +++ /dev/null @@ -1,64 +0,0 @@ - -subroutine engy_te(cwava ,w ,t ,u ,v , & - phis ,pdel ,ps ,engy , nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate contribution of current latitude to total energy -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- -! - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plev, plon - use physconst, only: cpair - - implicit none -! -!------------------------------Arguments-------------------------------- -! - integer , intent(in) :: nlon ! longitude dimension - real(r8), intent(in) :: cwava ! normalization factor l/(g*plon) - real(r8), intent(in) :: w ! gaussian weight this latitude - real(r8), intent(in) :: t (plon,plev) ! temperature - real(r8), intent(in) :: u (plon,plev) ! u-component - real(r8), intent(in) :: v (plon,plev) ! v-component - real(r8), intent(in) :: phis(plon) ! Geopotential - real(r8), intent(in) :: pdel(plon,plev) ! pressure diff between interfaces - real(r8), intent(in) :: ps (plon ) ! Surface pressure - real(r8), intent(out) :: engy ! accumulator -! -!---------------------------Local variables----------------------------- -! - integer i,k ! longitude, level indices - real(r8) const ! temporary constant -! -!----------------------------------------------------------------------- -! -! Integration factor (the 0.5 factor arises because gaussian weights sum to 2) -! - const = cwava*w*0.5_r8 - engy = 0._r8 -! - do k=1,plev - do i=1,nlon - engy = engy + ( cpair*t(i,k) + 0.5_r8*( u(i,k)*u(i,k) + v(i,k)*v(i,k) ) )*pdel(i,k) - end do - end do - do i=1,nlon - engy = engy + phis(i)*ps(i) - end do - - engy = engy*const - - return -end subroutine engy_te diff --git a/src/advection/slt/extx.F90 b/src/advection/slt/extx.F90 deleted file mode 100644 index c76eee27b9..0000000000 --- a/src/advection/slt/extx.F90 +++ /dev/null @@ -1,66 +0,0 @@ - -subroutine extx (pkcnst, pkdim, fb, kloop) - -!----------------------------------------------------------------------- -! -! Purpose: -! Copy data to the longitude extensions of the extended array -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use scanslt, only: plond, beglatex, endlatex, nxpt, nlonex - implicit none - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: pkcnst ! dimension construct for 3-D arrays - integer , intent(in) :: pkdim ! vertical dimension - real(r8), intent(inout) :: fb(plond,pkdim*pkcnst,beglatex:endlatex) ! constituents - integer, intent(in) :: kloop ! Limit extent of loop of pkcnst -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i ! longitude index - integer j ! latitude index - integer k ! vertical index - integer nlond ! extended longitude dim - integer i2pi ! start of eastern long. extension - integer pk ! k extent to loop over -!----------------------------------------------------------------------- -! -! Fill west edge points. -! - pk = pkdim*kloop - if(nxpt >= 1) then - do j=beglatex,endlatex - do i=1,nxpt - do k=1,pk - fb(i,k,j) = fb(i+nlonex(j),k,j) - end do - end do - end do - end if -! -! Fill east edge points -! - do j=beglatex,endlatex - i2pi = nxpt + nlonex(j) + 1 - nlond = nlonex(j) + 1 + 2*nxpt - do i=i2pi,nlond - do k=1,pk - fb(i,k,j) = fb(i-nlonex(j),k,j) - end do - end do - end do - - return -end subroutine extx diff --git a/src/advection/slt/extys.F90 b/src/advection/slt/extys.F90 deleted file mode 100644 index 3a99920c0c..0000000000 --- a/src/advection/slt/extys.F90 +++ /dev/null @@ -1,137 +0,0 @@ - -subroutine extys(pkcnst ,pkdim ,fb ,kloop) - -!----------------------------------------------------------------------- -! -! Purpose: -! Fill latitude extensions of a scalar extended array and -! Copy data to the longitude extensions of the extended array -! -! Method: -! This is done in 2 steps: -! 1) interpolate to the pole points; use the mean field value on the -! Gaussian latitude closest to the pole. -! 2) add latitude lines beyond the poles. -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat - use scanslt, only: nxpt, plond, beglatex, endlatex, platd, nlonex, & - jintmx - implicit none - -!------------------------------Parameters------------------------------- - integer, parameter :: istart = nxpt+1 ! index to start computation - integer, parameter :: js = 1 + nxpt + jintmx ! index of southernmost model lat - integer, parameter :: jn = plat + nxpt + jintmx ! index of northernmost model lat -!----------------------------------------------------------------------- - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: pkcnst ! dimensioning construct for 3-D arrays - integer , intent(in) :: pkdim ! vertical dimension - real(r8), intent(inout) :: fb(plond,pkdim*pkcnst,beglatex:endlatex) ! Output is same as on entry - !except with the pole latitude and extensions beyond it filled. - integer, intent(in) :: kloop ! If you want to limit the extent of looping over pcnst -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i,j,k ! indices - integer istop ! index to stop computation - integer nlon2 ! half the number of real longitudes - real(r8) zave ! accumulator for zonal averaging - integer pk ! dimension to loop over -!----------------------------------------------------------------------- -! -! Fill north pole line. -! - pk = pkdim*kloop -#if ( defined SPMD ) - if (jn+1<=endlatex) then -#endif - do k=1,pkdim*pkcnst - zave = 0.0_r8 - istop = nxpt + nlonex(jn) - do i=istart,istop - zave = zave + fb(i,k,jn ) - end do - zave = zave/nlonex(jn) - istop = nxpt + nlonex(jn+1) - do i=istart,istop - fb(i,k,jn+1) = zave - end do - end do -#if ( defined SPMD ) - end if -#endif -! -! Fill northern lines beyond pole line. -! - if( jn+2 <= platd )then - do j=jn+2,platd -#if ( defined SPMD ) - if (j<=endlatex) then -#endif - nlon2 = nlonex(j)/2 - do k=1,pk - do i=istart,istart+nlon2-1 - fb( i,k,j) = fb(nlon2+i,k,2*jn+2-j) - fb(nlon2+i,k,j) = fb( i,k,2*jn+2-j) - end do - end do -#if ( defined SPMD ) - end if -#endif - end do - end if -! -! Fill south pole line. -! -#if ( defined SPMD ) - if (js-1>=beglatex) then -#endif - do k=1,pk - zave = 0.0_r8 - istop = nxpt + nlonex(js) - do i = istart,istop - zave = zave + fb(i,k,js ) - end do - zave = zave/nlonex(js) - istop = nxpt + nlonex(js-1) - do i=istart,istop - fb(i,k,js-1) = zave - end do - end do -#if ( defined SPMD ) - end if -#endif -! -! Fill southern lines beyond pole line. -! - if( js-2 >= 1 )then - do j=1,js-2 -#if ( defined SPMD ) - if (j>=beglatex) then -#endif - nlon2 = nlonex(j)/2 - do k=1,pk - do i=istart,istart+nlon2-1 - fb( i,k,j) = fb(nlon2+i,k,2*js-2-j) - fb(nlon2+i,k,j) = fb( i,k,2*js-2-j) - end do - end do -#if ( defined SPMD ) - end if -#endif - end do - end if - - return -end subroutine extys diff --git a/src/advection/slt/extyv.F90 b/src/advection/slt/extyv.F90 deleted file mode 100644 index e60125c6d5..0000000000 --- a/src/advection/slt/extyv.F90 +++ /dev/null @@ -1,177 +0,0 @@ - -subroutine extyv(pkcnst ,pkdim ,coslam ,sinlam ,ub , & - vb ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Fill latitude extensions of a vector component extended array. -! -! Method: -! This is done in 2 steps: -! 1) interpolate to the pole points; -! use coefficients for zonal wave number 1 on the Gaussian -! latitude closest to the pole. -! 2) add latitude lines beyond the poles. -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat - use scanslt, only: nxpt, platd, nlonex, beglatex, endlatex, plond, & - jintmx - implicit none - -!------------------------------Parameters------------------------------- - integer, parameter :: istart = nxpt+1 ! index to start computation - integer, parameter :: js = 1 + nxpt + jintmx ! index of southernmost model lat - integer, parameter :: jn = plat + nxpt + jintmx ! index of northernmost model lat -!----------------------------------------------------------------------- - -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer , intent(in) :: pkcnst ! dimensioning construct for 3-D arrays - integer , intent(in) :: pkdim ! vertical dimension - real(r8), intent(in) :: coslam(plond,platd) ! Cos of long at x-grid points (global grid) - real(r8), intent(in) :: sinlam(plond,platd) ! Sin of long at x-grid points (global grid) - real(r8), intent(inout):: ub(plond,pkdim*pkcnst,beglatex:endlatex) ! U-wind with extents - real(r8), intent(inout):: vb(plond,pkdim*pkcnst,beglatex:endlatex) ! V-wind with extents -! -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i ! index - integer ig ! index - integer j ! index - integer k ! index - integer nlon2 ! half the number of real longitudes - integer istop ! index to stop computation - real(r8) zavecv ! accumulator for wavenumber 1 of v - real(r8) zavesv ! accumulator for wavenumber 1 of v - real(r8) zavecu ! accumulator for wavenumber 1 of u - real(r8) zavesu ! accumulator for wavenumber 1 of u - real(r8) zaucvs ! used to couple u and v (wavenumber 1) - real(r8) zavcus ! used to couple u and v (wavenumber 1) -!----------------------------------------------------------------------- -! -! Fill north pole line. -! -#if ( defined SPMD ) - if (jn+1<=endlatex) then ! north pole is on-processor -#endif - do k = 1,pkdim - zavecv = 0.0_r8 - zavesv = 0.0_r8 - zavecu = 0.0_r8 - zavesu = 0.0_r8 - ig = 0 - istop = nxpt + nlonex(jn) - do i = istart,istop - ig = ig + 1 - zavecv = zavecv + vb(i,k,jn )*coslam(ig,jn) - zavesv = zavesv + vb(i,k,jn )*sinlam(ig,jn) - zavecu = zavecu + ub(i,k,jn )*coslam(ig,jn) - zavesu = zavesu + ub(i,k,jn )*sinlam(ig,jn) - end do - zavcus = (zavecv + zavesu)/nlonex(jn) - zaucvs = (zavecu - zavesv)/nlonex(jn) - ig = 0 - istop = nxpt + nlonex(jn+1) - do i = istart,istop - ig = ig + 1 - vb(i,k,jn+1) = zavcus*coslam(ig,jn+1) - zaucvs*sinlam(ig,jn+1) - ub(i,k,jn+1) = zaucvs*coslam(ig,jn+1) + zavcus*sinlam(ig,jn+1) - end do - end do -#if ( defined SPMD ) - end if -#endif -! -! Fill northern lines beyond pole line. -! - if( jn+2 <= platd )then - do j = jn+2,platd -#if ( defined SPMD ) - if (j<=endlatex) then -#endif - nlon2 = nlonex(j)/2 - do k = 1,pkdim - do i = istart,istart+nlon2-1 - vb( i,k,j) = -vb(nlon2+i,k,2*jn+2-j) - vb(nlon2+i,k,j) = -vb( i,k,2*jn+2-j) - ub( i,k,j) = -ub(nlon2+i,k,2*jn+2-j) - ub(nlon2+i,k,j) = -ub( i,k,2*jn+2-j) - end do - end do -#if ( defined SPMD ) - end if -#endif - end do - end if -! -! Fill south pole line. -! -#if ( defined SPMD ) - if (js-1>=beglatex) then ! south pole is on-processor -#endif - do k = 1,pkdim - zavecv = 0.0_r8 - zavesv = 0.0_r8 - zavecu = 0.0_r8 - zavesu = 0.0_r8 - ig = 0 - istop = nxpt + nlonex(js) - do i = istart,istop - ig = ig + 1 - zavecv = zavecv + vb(i,k,js )*coslam(ig,js) - zavesv = zavesv + vb(i,k,js )*sinlam(ig,js) - zavecu = zavecu + ub(i,k,js )*coslam(ig,js) - zavesu = zavesu + ub(i,k,js )*sinlam(ig,js) - end do - zavcus = (zavecv - zavesu)/nlonex(js) - zaucvs = (zavecu + zavesv)/nlonex(js) - ig = 0 - istop = nxpt + nlonex(js-1) - do i = istart,istop - ig = ig + 1 - vb(i,k,js-1) = zavcus*coslam(ig,js-1) + zaucvs*sinlam(ig,js-1) - ub(i,k,js-1) = zaucvs*coslam(ig,js-1) - zavcus*sinlam(ig,js-1) - end do - end do -#if ( defined SPMD ) - end if -#endif -! -! Fill southern lines beyond pole line. -! - if( js-2 >= 1 )then - do j = 1,js-2 -#if ( defined SPMD ) - if (j>=beglatex) then -#endif - nlon2 = nlonex(j)/2 - do k = 1,pkdim - do i = istart,istart+nlon2-1 - vb( i,k,j) = -vb(nlon2+i,k,2*js-2-j) - vb(nlon2+i,k,j) = -vb( i,k,2*js-2-j) - ub( i,k,j) = -ub(nlon2+i,k,2*js-2-j) - ub(nlon2+i,k,j) = -ub( i,k,2*js-2-j) - end do - end do -#if ( defined SPMD ) - end if -#endif - end do - end if -! - return -end subroutine extyv diff --git a/src/advection/slt/flxint.F90 b/src/advection/slt/flxint.F90 deleted file mode 100644 index 804824f96f..0000000000 --- a/src/advection/slt/flxint.F90 +++ /dev/null @@ -1,45 +0,0 @@ - -subroutine flxint (w ,flx ,flxlat ,nlon ) -!----------------------------------------------------------------------- -! -! Purpose: Calculate contribution of current latitude to energy flux integral -! -! Method: -! -! Author: Jerry Olson -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -! -! Arguments -! - real(r8), intent(in) :: w ! gaussian weight this latitude - real(r8), intent(in) :: flx(plon) ! energy field - - integer, intent(in) :: nlon ! number of longitudes - - real(r8), intent(out) :: flxlat ! accumulator for given latitude -! -! Local variables -! - integer :: i ! longitude index -! -!----------------------------------------------------------------------- -! - flxlat = 0._r8 -! - do i=1,nlon - flxlat = flxlat + flx(i) - end do -! -! Integration factor (the 0.5 factor arises because gaussian weights -! sum to 2) -! - flxlat = flxlat*w*0.5_r8/real(nlon,r8) -! - return -end subroutine flxint diff --git a/src/advection/slt/grdxy.F90 b/src/advection/slt/grdxy.F90 deleted file mode 100644 index 4ab40cb3db..0000000000 --- a/src/advection/slt/grdxy.F90 +++ /dev/null @@ -1,124 +0,0 @@ - -subroutine grdxy(dlam ,lam ,phi ,w ,sinlam , & - coslam ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Define the "extended" grid used in the semi-Lagrangian transport -! scheme. The longitudes are equally spaced and the latitudes are -! Gaussian. The global grid is extended to include "wraparound" points -! on all sides. -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat - use scanslt, only: nxpt, jintmx, plond, platd, nlonex - use gauaw_mod, only: gauaw - implicit none - -!------------------------------Parameters------------------------------- - integer, parameter :: istart = nxpt+1 ! index for first model long. - integer, parameter :: jstart = nxpt+jintmx+1 ! index for first model lat. - integer, parameter :: jstop = jstart-1+plat ! index for last model lat. -!----------------------------------------------------------------------- - -!------------------------------Arguments-------------------------------- - real(r8), intent(out) :: dlam(platd) ! longitudinal increment - real(r8), intent(out) :: lam (plond,platd) ! long. coords. in extended grid - real(r8), intent(out) :: phi (platd) ! lat. coords. in extended grid - real(r8), intent(out) :: w (plat) ! Gaussian weights - real(r8), intent(out) :: sinlam(plond,platd) ! sin(lam) - real(r8), intent(out) :: coslam(plond,platd) ! cos(lam) -! -! dlam Length of increment in longitude grid. -! lam Longitude values in the extended grid. -! phi Latitude values in the extended grid. -! w Gauss weights for latitudes in the global grid. (These sum -! to 2.0 like the ones in CCM1.) -! sinlam Sine of longitudes in global grid (no extension points). -! coslam Cosine of longitudes in global grid (no extension points). -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i,j,ig ! indices - integer nlond ! extended long dim - real(r8) lam0 ! lamda = 0 - real(r8) pi ! 3.14... - real(r8) wrk(platd) ! work space -!----------------------------------------------------------------------- -! - lam0 = 0.0_r8 - pi = 4._r8*atan(1._r8) -! -! Interval length in equally spaced longitude grid. -! - do j=1,platd - dlam(j) = 2._r8*pi/real(nlonex(j),r8) -! -! Longitude values on extended grid. -! - nlond = nlonex(j) + 1 + 2*nxpt - do i = 1,nlond - lam(i,j) = real(i-istart,r8)*dlam(j) + lam0 - end do - end do -! -! Compute Gauss latitudes and weights. On return; phi contains the -! sine of the latitudes starting closest to the north pole and going -! toward the south; w contains the corresponding Gauss weights. -! - call gauaw(phi ,w ,plat ) -! -! Reorder and compute latitude values. -! - do j = jstart,jstop - wrk(j) = asin( phi(jstop-j+1) ) - end do - phi(jstart:jstop) = wrk(jstart:jstop) -! -! North and south poles. -! - phi(jstart-1) = -pi/2.0_r8 - phi(jstop +1) = pi/2.0_r8 -! -! Extend Gauss latitudes below south pole so that the spacing above -! the pole is symmetric, and phi is decreasing, i.e., phi < -pi/2 -! - if( jstart > 2 )then - do j = 1,jstart-2 - phi(j) = -pi - phi(2*jstart-2-j) - end do - end if -! -! Analogously for Northern Hemisphere -! - if( platd > jstop+1 )then - do j = jstop+2,platd - phi(j) = pi - phi(2*jstop+2-j) - end do - end if -! -! Sine and cosine of longitude. -! - do j=1,platd - ig = 0 - do i = istart,nlonex(j)+nxpt - ig = ig + 1 - sinlam(ig,j) = sin( lam(i,j) ) - coslam(ig,j) = cos( lam(i,j) ) - end do - end do - - return -end subroutine grdxy diff --git a/src/advection/slt/hadvtest.h b/src/advection/slt/hadvtest.h deleted file mode 100644 index 9cd2534a6a..0000000000 --- a/src/advection/slt/hadvtest.h +++ /dev/null @@ -1,2 +0,0 @@ -common/savit/usave(plon,plev,plat), vsave(plon,plev,plat), pssave(plon,plat) -real(r8) usave, vsave, pssave diff --git a/src/advection/slt/hordif1.F90 b/src/advection/slt/hordif1.F90 deleted file mode 100644 index fad8996807..0000000000 --- a/src/advection/slt/hordif1.F90 +++ /dev/null @@ -1,92 +0,0 @@ - -subroutine hordif1(rearth,phi) - -!----------------------------------------------------------------------- -! -! Purpose: -! Horizontal diffusion of z,d,t,q -! -! Method: -! 1. implicit del**2 form above level kmnhd4 -! 2. implicit del**4 form at level kmnhd4 and below -! 3. courant number based truncation at level kmxhdc and above -! 4. increased del**2 coefficient at level kmxhd2 and above -! -! Computational note: this routine is multitasked by level, hence it -! is called once for each k -! -! Author: -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 - use pspect - use comspe - implicit none - -!------------------------------Arguments-------------------------------- - real(r8), intent(in) :: rearth ! radius of earth - real(r8), intent(inout) :: phi(psp) ! used in spectral truncation of phis -!----------------------------------------------------------------------- - -!---------------------------Local workspace----------------------------- - integer ir,ii ! spectral indices - integer mr,mc ! spectral indices - real(r8) k42 ! Nominal Del^4 diffusion coeff at T42 - real(r8) k63 ! Nominal Del^4 diffusion coeff at T63 - real(r8) knn ! Computed Del^4 diffusion coeff at TNN - real(r8) tmp ! temp space - real(r8) hdfst4(pnmax) - integer expon - integer m ! spectral indices - integer(i8) n ! spectral indices -!----------------------------------------------------------------------- -! -! Compute Del^4 diffusion coefficient -! - k42 = 1.e+16_r8 - k63 = 5.e+15_r8 - expon = 25 - - if(pmax-1 <= 42) then - knn = k42 - elseif(pmax-1 == 63) then - knn = k63 - else - if(pmax-1 < 63) then - tmp = log(k42/k63)/log(63._r8*64._r8/42._r8/43._r8) - else - tmp = 2._r8 - endif - knn = k63*(63._r8*64._r8/real(pmax,r8)/real(pmax-1,r8))**tmp - endif -! -! Set the Del^4 diffusion coefficients for each wavenumber -! - hdfst4(1) = 0._r8 - do n=2,pnmax - hdfst4(n) = knn * (n*(n-1)*n*(n-1) ) / rearth**4 - end do -! -! Set the horizontal diffusion factors for each wavenumer at this level -! del^4 diffusion is to be applied and compute time-split implicit -! factors. -! - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=1,nlen(m) - ir = mc + 2*n - 1 - ii = ir + 1 - phi(ir) = phi(ir)/(1._r8 + 3600._r8*hdfst4(n+m-1))**expon - phi(ii) = phi(ii)/(1._r8 + 3600._r8*hdfst4(n+m-1))**expon - end do - end do - - return -end subroutine hordif1 diff --git a/src/advection/slt/kdpfnd.F90 b/src/advection/slt/kdpfnd.F90 deleted file mode 100644 index 24e229b359..0000000000 --- a/src/advection/slt/kdpfnd.F90 +++ /dev/null @@ -1,66 +0,0 @@ - -subroutine kdpfnd(pkdim ,pmap ,sig ,sigdp ,kdpmap , & - kdp ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Determine vertical departure point indices that point into a grid -! containing the full or half sigma levels. Use an artificial evenly -! spaced vertical grid to map into the true model levels. -! -! Method: -! Indices are computed assuming the the sigdp values have -! been constrained so that sig(1) .le. sigdp(i,j) .lt. sig(pkdim). -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev - implicit none - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: pkdim ! dimension of "sig" - integer , intent(in) :: pmap ! dimension of "kdpmap" - real(r8), intent(in) :: sig (pkdim) ! vertical grid coordinates - integer , intent(in) :: kdpmap(pmap) ! array of model grid indices which - real(r8), intent(in) :: sigdp(plon,plev) ! vertical coords. of departure points - integer , intent(out):: kdp(plon,plev) ! vertical index for each dep. pt. - integer , intent(in) :: nlon ! longitude dimensio -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i,k,ii ! indices - real(r8) rdel ! recip. of interval in artificial grid - real(r8) sig1ln ! ln (sig(1)) -!----------------------------------------------------------------------- -! - rdel = real(pmap,r8)/( log(sig(pkdim)) - log(sig(1)) ) - sig1ln = log( sig(1) ) -! -!$OMP PARALLEL DO PRIVATE (K, I, II) - do k=1,plev - do i=1,nlon -! -! First guess of the departure point's location in the model grid -! - ii = max0(1,min0(pmap,int((log(sigdp(i,k))-sig1ln)*rdel+1._r8))) - kdp(i,k) = kdpmap(ii) -! -! Determine if location is in next interval -! - if(sigdp(i,k) >= sig(kdp(i,k)+1)) then - kdp(i,k) = kdp(i,k) + 1 - end if - end do - end do - - return -end subroutine kdpfnd diff --git a/src/advection/slt/lcbas.F90 b/src/advection/slt/lcbas.F90 deleted file mode 100644 index 93848804ed..0000000000 --- a/src/advection/slt/lcbas.F90 +++ /dev/null @@ -1,58 +0,0 @@ - -subroutine lcbas (grd, bas1, bas2) - -!----------------------------------------------------------------------- -! -! Purpose: -! Evaluate the partial Lagrangian cubic basis functions (denominator -! only ) for the grid points and gather grid values -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - -!------------------------------Arguments-------------------------------- - real(r8), intent(in) :: grd(4) ! grid stencil - real(r8), intent(out):: bas1(4) ! grid values on stencil - real(r8), intent(out):: bas2(4) ! lagrangian basis functions -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - real(r8) x0mx1 ! | - real(r8) x0mx2 ! | - real(r8) x0mx3 ! |- grid value differences used in weights - real(r8) x1mx2 ! | - real(r8) x1mx3 ! | - real(r8) x2mx3 ! | -!----------------------------------------------------------------------- -! - x0mx1 = grd(1) - grd(2) - x0mx2 = grd(1) - grd(3) - x0mx3 = grd(1) - grd(4) - x1mx2 = grd(2) - grd(3) - x1mx3 = grd(2) - grd(4) - x2mx3 = grd(3) - grd(4) - - bas1(1) = grd(1) - bas1(2) = grd(2) - bas1(3) = grd(3) - bas1(4) = grd(4) - - bas2(1) = 1._r8/ ( x0mx1 * x0mx2 * x0mx3 ) - bas2(2) = -1._r8/ ( x0mx1 * x1mx2 * x1mx3 ) - bas2(3) = 1._r8/ ( x0mx2 * x1mx2 * x2mx3 ) - bas2(4) = -1._r8/ ( x0mx3 * x1mx3 * x2mx3 ) - - return -end subroutine lcbas - diff --git a/src/advection/slt/lcdbas.F90 b/src/advection/slt/lcdbas.F90 deleted file mode 100644 index d3fd1d3f01..0000000000 --- a/src/advection/slt/lcdbas.F90 +++ /dev/null @@ -1,71 +0,0 @@ - -subroutine lcdbas(grd ,dbas2 ,dbas3 ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate weights used to evaluate derivative estimates at the -! inner grid points of a four point stencil based on Lagrange -! cubic polynomial through four unequally spaced points. -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - -!------------------------------Arguments-------------------------------- - real(r8), intent(in) :: grd(4) ! grid stencil - real(r8), intent(out):: dbas2(4) ! derivatives at grid point 2. - real(r8), intent(out):: dbas3(4) ! derivatives at grid point 3. -! -! grd Coordinate values of four points in stencil. -! dbas2 Derivatives of the four basis functions at grid point 2. -! dbas3 Derivatives of the four basis functions at grid point 3. -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - real(r8) x1 ! | - real(r8) x2 ! |- grid values - real(r8) x3 ! | - real(r8) x4 ! | - real(r8) x1mx2 ! | - real(r8) x1mx3 ! | - real(r8) x1mx4 ! |- differences of grid values - real(r8) x2mx3 ! | - real(r8) x2mx4 ! | - real(r8) x3mx4 ! | -!----------------------------------------------------------------------- -! - x1 = grd(1) - x2 = grd(2) - x3 = grd(3) - x4 = grd(4) - x1mx2 = x1 - x2 - x1mx3 = x1 - x3 - x1mx4 = x1 - x4 - x2mx3 = x2 - x3 - x2mx4 = x2 - x4 - x3mx4 = x3 - x4 - - dbas2(1) = x2mx3 * x2mx4 / ( x1mx2 * x1mx3 * x1mx4 ) - dbas2(2) = -1._r8/x1mx2 + 1._r8/x2mx3 + 1._r8/x2mx4 - dbas2(3) = - x1mx2 * x2mx4 / ( x1mx3 * x2mx3 * x3mx4 ) - dbas2(4) = x1mx2 * x2mx3 / ( x1mx4 * x2mx4 * x3mx4 ) - - dbas3(1) = - x2mx3 * x3mx4 / ( x1mx2 * x1mx3 * x1mx4 ) - dbas3(2) = x1mx3 * x3mx4 / ( x1mx2 * x2mx3 * x2mx4 ) - dbas3(3) = -1._r8/x1mx3 - 1._r8/x2mx3 + 1._r8/x3mx4 - dbas3(4) = - x1mx3 * x2mx3 / ( x1mx4 * x2mx4 * x3mx4 ) - - return -end subroutine lcdbas - diff --git a/src/advection/slt/omcalc.F90 b/src/advection/slt/omcalc.F90 deleted file mode 100644 index c785fa730c..0000000000 --- a/src/advection/slt/omcalc.F90 +++ /dev/null @@ -1,146 +0,0 @@ - -subroutine omcalc(rcoslat ,d ,u ,v ,dpsl , & - dpsm ,pmid ,pdel ,rpmid ,pbot , & - omga ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate vertical pressure velocity (omga = dp/dt) -! -! Method: -! First evaluate the expressions for omega/p, then rescale to omega at -! the end. -! -! Author: CCM1 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plev, plon, plevp - use pspect - use hycoef, only: hybm, hybd, nprlev - implicit none - - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: nlon ! lonitude dimension - real(r8), intent(in) :: rcoslat(nlon) ! 1 / cos(lat) - real(r8), intent(in) :: d(plon,plev) ! divergence - real(r8), intent(in) :: u(plon,plev) ! zonal wind * cos(lat) - real(r8), intent(in) :: v(plon,plev) ! meridional wind * cos(lat) - real(r8), intent(in) :: dpsl(plon) ! longitudinal component of grad ln(ps) - real(r8), intent(in) :: dpsm(plon) ! latitudinal component of grad ln(ps) - real(r8), intent(in) :: pmid(plon,plev) ! mid-level pressures - real(r8), intent(in) :: pdel(plon,plev) ! layer thicknesses (pressure) - real(r8), intent(in) :: rpmid(plon,plev) ! 1./pmid - real(r8), intent(in) :: pbot(plon) ! bottom interface pressure - real(r8), intent(out):: omga(plon,plev) ! vertical pressure velocity -!----------------------------------------------------------------------- - -!---------------------------Local workspace----------------------------- - integer i,k ! longitude, level indices - real(r8) d_i(plev) ! divergence (single colummn) - real(r8) u_i(plev) ! zonal wind * cos(lat) (single colummn) - real(r8) v_i(plev) ! meridional wind * cos(lat) (single colummn) - real(r8) pmid_i(plev) ! mid-level pressures (single colummn) - real(r8) pdel_i(plev) ! layer thicknesses (pressure) (single colummn) - real(r8) rpmid_i(plev) ! 1./pmid (single colummn) - real(r8) omga_i(plev) ! vertical pressure velocity (single colummn) - real(r8) hkk ! diagonal element of hydrostatic matrix - real(r8) hlk ! super diagonal element - real(r8) suml ! partial sum over l = (1, k-1) - real(r8) vgpk ! v dot grad ps - real(r8) tmp ! vector temporary -!----------------------------------------------------------------------- -! -!$OMP PARALLEL DO PRIVATE (I, SUML, D_I, U_I, V_I, PMID_I, PDEL_I, RPMID_I, & -!$OMP OMGA_I, HKK, VGPK, TMP, HLK) - do i=1,nlon -! -! Zero partial sum -! - suml = 0._r8 -! -! Collect column data -! - d_i = d(i,:) - u_i = u(i,:) - v_i = v(i,:) - pmid_i = pmid(i,:) - pdel_i = pdel(i,:) - rpmid_i = rpmid(i,:) -! -! Pure pressure part: top level -! - hkk = 0.5_r8*rpmid_i(1) - omga_i(1) = -hkk*d_i(1)*pdel_i(1) - suml = suml + d_i(1)*pdel_i(1) -! -! sum(k)(v(j)*ps*grad(lnps)*db(j)) part. Not normally invoked since -! the top layer is normally a pure pressure layer. -! - if (1>=nprlev) then - vgpk = rcoslat(i)*(u_i(1)*dpsl(i) + v_i(1)*dpsm(i))*pbot(i) - tmp = vgpk*hybd(1) - omga_i(1) = omga_i(1) + hybm(1)*rpmid_i(1)*vgpk - hkk*tmp - suml = suml + tmp - end if -! -! Integrals to level above bottom -! - do k=2,plev-1 -! -! Pure pressure part -! - hkk = 0.5_r8*rpmid_i(k) - hlk = rpmid_i(k) - omga_i(k) = -hkk*d_i(k)*pdel_i(k) - hlk*suml - suml = suml + d_i(k)*pdel_i(k) -! -! v(j)*grad(lnps) part -! - if (k>=nprlev) then - vgpk = rcoslat(i)*(u_i(k)*dpsl(i) + v_i(k)*dpsm(i))*pbot(i) - tmp = vgpk*hybd(k) - omga_i(k) = omga_i(k) + hybm(k)*rpmid_i(k)*vgpk - hkk*tmp - suml = suml + tmp - end if - end do -! -! Pure pressure part: bottom level -! - hkk = 0.5_r8*rpmid_i(plev) - hlk = rpmid_i(plev) - omga_i(plev) = -hkk*d_i(plev)*pdel_i(plev) - hlk*suml -! -! v(j)*grad(lnps) part. Normally invoked, but omitted if the model is -! running in pure pressure coordinates throughout (e.g. stratospheric -! mechanistic model). -! - if (plev>=nprlev) then - vgpk = rcoslat(i)*(u_i(plev)*dpsl(i) + v_i(plev)*dpsm(i))* pbot(i) - omga_i(plev) = omga_i(plev) + hybm(plev)*rpmid_i(plev)*vgpk - & - hkk*vgpk*hybd(plev) - end if -! -! The above expressions give omega/p. Rescale to omega. -! - do k=1,plev - omga_i(k) = omga_i(k)*pmid_i(k) - end do -! -! Save results -! - omga(i,:) = omga_i(:) -! - end do -! - return -end subroutine omcalc - diff --git a/src/advection/slt/pdelb0.F90 b/src/advection/slt/pdelb0.F90 deleted file mode 100644 index b378430127..0000000000 --- a/src/advection/slt/pdelb0.F90 +++ /dev/null @@ -1,49 +0,0 @@ - -subroutine pdelb0(ps ,pdelb ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Compute the pressure intervals between the interfaces for the "B" -! (surface pressure dependent) portion of the hybrid grid only. -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plev, plon - use hycoef, only: hybd - implicit none - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: nlon ! longitude dimension - real(r8), intent(in) :: ps(plon) ! surface Pressure - real(r8), intent(out):: pdelb(plon,plev) ! pressure difference between interfaces - ! (pressure defined using the "B" part - ! of the hybrid grid only) -!----------------------------------------------------------------------- - -!---------------------------Local workspace----------------------------- - integer i,k ! longitude, level indices -!----------------------------------------------------------------------- -! -! Compute del P(B) -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k = 1,plev - do i = 1,nlon - pdelb(i,k) = hybd(k)*ps(i) - end do - end do - - return -end subroutine pdelb0 - diff --git a/src/advection/slt/phcs.F90 b/src/advection/slt/phcs.F90 deleted file mode 100644 index 41e72b1c92..0000000000 --- a/src/advection/slt/phcs.F90 +++ /dev/null @@ -1,238 +0,0 @@ - -subroutine phcs(pmn ,hmn ,ix ,x1) - -!----------------------------------------------------------------------- -! -! Purpose: -! Compute associated Legendre functions of the first kind of order m and -! degree n, and the associated derivatives for arg x1. - -! Method: -! Compute associated Legendre functions of the first kind of order m and -! degree n, and the associated derivatives for arg x1. The associated -! Legendre functions are evaluated using relationships contained in -! "Tables of Normalized Associated Legendre Polynomials", -! S. L. Belousov (1962). Both the functions and their derivatives are -! ordered in a linear stored rectangular array (with a large enough -! domain to contain the particular wavenumber truncation defined in the -! pspect common block) by column. m = 0->ptrm, and n = m->ptrn + m -! m -! The functions P (x) are normalized such that -! n -! / m 2 -! | [P (x)] dx = 1/2 -! / n -! __ -! and must be multiplied by |2 to match Belousov tables. -! \| -! m -! The derivatives H (x) are defined as -! n m 2 m -! H (x) = -(1-x ) dP (x)/dx -! n n -! -! and are evaluated using the recurrence relationship -! _________________________ -! m m | 2 2 m -! H (x) = nx P (x) - |(n - m )(2n + 1)/(2n - 1) P (x) -! n n \| n-1 -! -! Modified 1/23/97 by Jim Rosinski to use real*16 arithmetic in order to -! achieve (nearly) identical values on all machines. -! -! Author: CCM1 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 - use pspect - implicit none - -#ifdef NO_R16 - integer,parameter :: r16= selected_real_kind(12) ! 8 byte real -#else - integer,parameter :: r16= selected_real_kind(24) ! 16 byte real -#endif - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: ix ! Dimension of Legendre funct arrays - real(r8), intent(in) :: x1 ! sin of latitude, [sin(phi), or mu] - real(r8), intent(out) :: pmn(ix) ! Legendre function array - real(r8), intent(out) :: hmn(ix) ! Derivative array -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer jmax ! Loop limit (N+1=> 2D wavenumber limit +1) - integer nmax ! Large enough n to envelope truncation - integer(i8) n ! 2-D wavenumber index (up/down column) - integer ml ! intermediate scratch variable - integer k ! counter on terms in trig series expansion - integer(i8) n2 ! 2*n - integer m ! zonal wavenumber index - integer nto ! intermediate scratch variable - integer mto ! intermediate scratch variable - integer j ! 2-D wavenumber index in recurrence evaluation - integer nmaxm ! loop limit in recurrence evaluation - - real(r16) xtemp(3,pmmax+ptrn+1) ! Workspace for evaluating recurrence -! ! relation where xtemp(m-2,n) and -! ! xtemp(m-1,n) contain Pmn's required -! ! to evaluate xtemp(m,n) (i.e.,always -! ! contains three adjacent columns of -! ! the Pmn data structure) -! - real(r16) xx1 ! x1 in extended precision - real(r16) xte ! cosine latitude [cos(phi)] - real(r16) teta ! pi/2 - latitute (colatitude) - real(r16) an ! coefficient on trig. series expansion - real(r16) sinpar ! accumulator in trig. series expansion - real(r16) cospar ! accumulator in trig. series expansion - real(r16) p ! 2-D wavenumber (series expansion) - real(r16) q ! intermediate variable in series expansion - real(r16) r ! zonal wavenumber (recurrence evaluation) - real(r16) p2 ! intermediate variable in series expansion - real(r16) rr ! twice the zonal wavenumber (recurrence) - real(r16) sqp ! intermediate variable in series expansion - real(r16) cosfak ! coef. on cos term in series expansion - real(r16) sinfak ! coef. on sin term in series expansion - real(r16) ateta ! intermediate variable in series expansion - real(r16) costet ! cos term in trigonometric series expansion - real(r16) sintet ! sin term in trigonometric series expansion -! - real(r16) t ! intermediate variable (recurrence evaluation) - real(r16) wm2 ! intermediate variable (recurrence evaluation) - real(r16) wmq2 ! intermediate variable (recurrence evaluation) - real(r16) w ! intermediate variable (recurrence evaluation) - real(r16) wq ! intermediate variable (recurrence evaluation) - real(r16) q2 ! intermediate variable (recurrence evaluation) - real(r16) wt ! intermediate variable (recurrence evaluation) - real(r16) q2d ! intermediate variable (recurrence evaluation) - real(r16) cmn ! cmn recurrence coefficient (see Belousov) - real(r16) xdmn ! dmn recurrence coefficient (see Belousov) - real(r16) emn ! emn recurrence coefficient (see Belousov) - real(r16) n2m1 ! n2 - 1 in extended precision - real(r16) n2m3 ! n2 - 3 in extended precision - real(r16) n2p1nnm1 ! (n2+1)*(n*n-1) in extended precision - real(r16) twopmq ! p + p - q in extended precision -!----------------------------------------------------------------------- -! -! Begin procedure by evaluating the first two columns of the Legendre -! function matrix (i.e., all n for m=0,1) via a trigonometric series -! expansion (see eqs. 19 and 21 in Belousov, 1962). Note that indexing -! is offset by one (e.g., m index for wavenumber m=0 is 1 and so on) -! Setup first ... -! - xx1 = x1 - jmax = ptrn + 1 - nmax = pmmax + jmax - xte = (1._r16-xx1*xx1)**0.5_r16 - teta = acos(xx1) - an = 1._r16 - xtemp(1,1) = 0.5_r16 ! P00 -! -! begin loop over n (2D wavenumber, or degree of associated Legendre -! function) beginning with n=1 (i.e., P00 was assigned above) -! note n odd/even distinction yielding 2 results per n cycle -! - do n=2,nmax - sinpar = 0._r16 - cospar = 0._r16 - ml = n - p = n - 1 - p2 = p*p - sqp = 1._r16/(p2+p)**0.5_r16 - an = an*(1._r16 - 1._r16/(4._r16*p2))**0.5_r16 - cosfak = 1._r16 - sinfak = p*sqp - do k=1,ml,2 - q = k - 1 - twopmq = p + p - q - ateta = (p-q)*teta - costet = cos(ateta) - sintet = sin(ateta) - if (n==k) costet = costet*0.5_r16 - if (k/=1) then - cosfak = (q-1._r16)/q*(twopmq+2._r16)/(twopmq+1._r16)*cosfak - sinfak = cosfak*(p-q)*sqp - end if - cospar = cospar + costet*cosfak - sinpar = sinpar + sintet*sinfak - end do - xtemp(1,n) = an*cospar ! P0n vector - xtemp(2,n-1) = an*sinpar ! P1n vector - end do -! -! Assign Legendre functions and evaluate derivatives for all n and m=0,1 -! - pmn(1) = 0.5_r16 - pmn(1+jmax) = xtemp(2,1) - hmn(1) = 0._r16 - hmn(1+jmax) = xx1*xtemp(2,1) - do n=2,jmax - pmn(n) = xtemp(1,n) - pmn(n+jmax) = xtemp(2,n) - n2 = n + n - n2m1 = n2 - 1 - n2m3 = n2 - 3 - n2p1nnm1 = (n2+1)*(n*n-1) - hmn(n) = (n-1)*(xx1*xtemp(1,n)-(n2m1/n2m3)**0.5_r16*xtemp(1,n-1)) - hmn(n+jmax) = n*xx1*xtemp(2,n)-(n2p1nnm1/n2m1)**0.5_r16*xtemp(2,n-1) - end do -! -! Evaluate recurrence relationship for remaining Legendre functions -! (i.e., m=2 ... PTRM) and associated derivatives (see eq 17, Belousov) -! - do m=3,pmmax - r = m - 1 - rr = r + r - xtemp(3,1) = (1._r16+1._r16/rr)**0.5_r16*xte*xtemp(2,1) - nto = (m-1)*jmax - pmn(nto+1) = xtemp(3,1) - hmn(nto+1) = r*xx1*xtemp(3,1) - nmaxm = nmax - m -! -! Loop over 2-D wavenumber (i.e., degree of Legendre function) -! Pmn's and Hmn's for current zonal wavenumber, r -! - do j=2,nmaxm - mto = nto + j - t = j - 1 - q = rr + t - 1 - wm2 = q + t - w = wm2 + 2 - wq = w*q - q2 = q*q - 1 - wmq2 = wm2*q2 - wt = w*t - q2d = q2 + q2 - cmn = ((wq*(q-2._r16))/(wmq2-q2d))**0.5_r16 - xdmn = ((wq*(t+1._r16))/wmq2)**0.5_r16 - emn = (wt/((q+1._r16)*wm2))**0.5_r16 - xtemp(3,j) = cmn*xtemp(1,j) - xx1*(xdmn*xtemp(1,j+1)-emn*xtemp(3,j-1)) - pmn(mto) = xtemp(3,j) - hmn(mto) = (r+t)*xx1*xtemp(3,j) - (wt*(q+1._r16)/wm2)**0.5_r16*xtemp(3,j-1) - end do -! -! shift Pmn's to left in workspace (setup for next recurrence pass) -! -!++pjr -! not initialized above - xtemp(2,nmax) = 0._r16 - do j=nmaxm,nmax - xtemp(3,j) = 0._r16 - end do -!--pjr - do n=1,nmax - xtemp(1,n) = xtemp(2,n) - xtemp(2,n) = xtemp(3,n) - end do - end do - - return -end subroutine phcs - diff --git a/src/advection/slt/plevs0.F90 b/src/advection/slt/plevs0.F90 deleted file mode 100644 index f43df7587e..0000000000 --- a/src/advection/slt/plevs0.F90 +++ /dev/null @@ -1,63 +0,0 @@ - -subroutine plevs0 (ncol , ncold ,nver ,ps ,pint , & - pmid ,pdel) - -!----------------------------------------------------------------------- -! -! Purpose: -! Define the pressures of the interfaces and midpoints from the -! coordinate definitions and the surface pressure. -! -! Method: -! -! Author: B. Boville -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plev, plevp - use hycoef, only: hyai, hybi, ps0, hyam, hybm - implicit none - - -!----------------------------------------------------------------------- - integer , intent(in) :: ncol ! Longitude dimension - integer , intent(in) :: ncold ! Declared longitude dimension - integer , intent(in) :: nver ! vertical dimension - real(r8), intent(in) :: ps(ncold) ! Surface pressure (pascals) - real(r8), intent(out) :: pint(ncold,nver+1) ! Pressure at model interfaces - real(r8), intent(out) :: pmid(ncold,nver) ! Pressure at model levels - real(r8), intent(out) :: pdel(ncold,nver) ! Layer thickness (pint(k+1) - pint(k)) -!----------------------------------------------------------------------- - -!---------------------------Local workspace----------------------------- - integer i,k ! Longitude, level indices -!----------------------------------------------------------------------- -! -! Set interface pressures -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,nver+1 - do i=1,ncol - pint(i,k) = hyai(k)*ps0 + hybi(k)*ps(i) - end do - end do -! -! Set midpoint pressures and layer thicknesses -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,nver - do i=1,ncol - pmid(i,k) = hyam(k)*ps0 + hybm(k)*ps(i) - pdel(i,k) = pint(i,k+1) - pint(i,k) - end do - end do - - return -end subroutine plevs0 - diff --git a/src/advection/slt/qmassa.F90 b/src/advection/slt/qmassa.F90 deleted file mode 100644 index dc6055c47b..0000000000 --- a/src/advection/slt/qmassa.F90 +++ /dev/null @@ -1,111 +0,0 @@ -module qmassa - - -contains - -subroutine qmassarun(cwava ,w ,q3 ,pdel ,hw1lat , & - nlon ,q0 ,lat ,pdeld ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate contribution of current latitude to mass of constituents -! being advected by slt. -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plev, plon - use constituents, only: pcnst, cnst_get_type_byind - use dycore, only: dycore_is - use cam_abortutils, only: endrun - - implicit none - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: nlon ! longitude dimension - real(r8), intent(in) :: cwava ! normalization factor l/(g*plon) - real(r8), intent(in) :: w ! gaussian weight this latitude - real(r8), intent(in) :: q3(plon,plev,pcnst) ! constituents - real(r8), intent(in) :: q0(plon,plev,pcnst) ! constituents at begining of time step - real(r8), intent(in) :: pdel(plon,plev) ! pressure diff between interfaces - real(r8), intent(out) :: hw1lat(pcnst) ! accumulator - real(r8), intent(in),optional :: pdeld(:,:) ! dry pressure difference for dry-type constituents - ! only used when called from eularian dynamics - - - integer lat -!----------------------------------------------------------------------- -! -!---------------------------Local variables----------------------------- - integer i,k,m ! longitude, level, constituent indices - real(r8) const ! temporary constant -!----------------------------------------------------------------------- -! -! Integration factor (the 0.5 factor arises because gaussian weights sum to 2) -! - const = cwava*w*0.5_r8 - do m=1,pcnst - hw1lat(m) = 0._r8 - end do - -!$OMP PARALLEL DO PRIVATE (M, K, I) - do m=1,pcnst - if (m == 1) then -! -! Compute mass integral for water -! - do k=1,plev - do i=1,nlon - hw1lat(1) = hw1lat(1) + q3(i,k,1)*pdel(i,k) - end do - end do -! -! Compute mass integral for non-water constituents (on either WET or DRY basis) -! - elseif (cnst_get_type_byind(m).eq.'dry' ) then ! dry type constituents - if ( dycore_is ('EUL') ) then ! EUL dycore computes pdeld in time filter - if ( .not. present(pdeld) ) & - call endrun('for dry type cnst with eul dycore, qmassa requires pdeld argument') - do k=1,plev - do i=1,nlon - hw1lat(m) = hw1lat(m) + q3(i,k,m)*pdeld(i,k) - end do - end do - else !dycore SLD - do k=1,plev - do i=1,nlon - hw1lat(m) = hw1lat(m) + q3(i,k,m)*(1._r8 - q0(i,k,1))*pdel(i,k) - end do - end do - endif ! dycore - else !wet type constituents - do k=1,plev - do i=1,nlon - hw1lat(m) = hw1lat(m) + q3(i,k,m)*(1._r8 - q3(i,k,1))*pdel(i,k) - end do - end do - end if !dry or wet - end do - - do m = 1,pcnst - hw1lat(m) = hw1lat(m)*const - end do - - return -end subroutine qmassarun - -end module qmassa - - - - diff --git a/src/advection/slt/qmassd.F90 b/src/advection/slt/qmassd.F90 deleted file mode 100644 index b8650270b2..0000000000 --- a/src/advection/slt/qmassd.F90 +++ /dev/null @@ -1,69 +0,0 @@ - -subroutine qmassd(cwava ,etamid ,w ,q1 ,q2 , & - pdel ,hwn ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Compute comtribution of current latitude to global integral of -! q2*|q2 - q1|*eta -! This is a measure of the difference between the fields before and -! after the SLT "forecast" weighted by the approximate mass of the tracer. -! It is used in the "fixer" which enforces conservation in constituent -! fields transport via SLT. -! -! Method: -! Reference Rasch and Williamson, 1991, Rasch, Boville and Brasseur, 1995 -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plev, plon - use constituents, only: pcnst - - implicit none - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: nlon ! longitude dimension - real(r8), intent(in) :: cwava ! normalization factor - real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints - real(r8), intent(in) :: w ! gaussian weight this latitude - real(r8), intent(in) :: q1(plon,plev) ! constituents (pre -SLT) - real(r8), intent(in) :: q2(plon,plev) ! constituents (post-SLT) - real(r8), intent(in) :: pdel(plon,plev) ! pressure diff between interfaces - real(r8), intent(inout) :: hwn(pcnst) ! accumulator for global integrals -! -! cwava l/(g*plon) -! w Gaussian weight. -! q1 Untransported q-field. -! q2 Transported q-field. -! pdel array of pressure differences between layer interfaces (used for mass weighting) -! hwn Mass averaged constituent in units of kg/m**2. -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i,k ! longitude and level indices - real(r8) hwava ! accumulator -!----------------------------------------------------------------------- -! - hwava = 0.0_r8 - do k=1,plev - do i=1,nlon - hwava = hwava + (q2(i,k)* etamid(k)*(abs(q1(i,k) - q2(i,k))))*pdel(i,k) - end do - end do -! -! The 0.5 factor arises because gaussian weights sum to 2 -! - hwn(1) = hwn(1) + cwava*w*hwava*0.5_r8 - - return -end subroutine qmassd - diff --git a/src/advection/slt/reordp.F90 b/src/advection/slt/reordp.F90 deleted file mode 100644 index a830a9f5e1..0000000000 --- a/src/advection/slt/reordp.F90 +++ /dev/null @@ -1,57 +0,0 @@ - -subroutine reordp(irow ,iy ,zalp ,zdalp ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Renormalize associated Legendre polynomials and their derivatives. -! -! Method: -! Reorder associated Legendre polynomials and their derivatives from -! column rectangular storage to diagonal pentagonal storage. The -! reordered polynomials and derivatives are returned via common/comspe/ -! -! Author: CCM1 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pspect - use comspe - implicit none - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: irow ! latitude pair index - integer , intent(in) :: iy ! dimension of input polynomials - real(r8), intent(in) :: zalp(iy) ! Legendre polynomial - real(r8), intent(in) :: zdalp(iy) ! Legendre polynomial derivative -!----------------------------------------------------------------------- - -!---------------------------Local workspace----------------------------- - integer mr ! spectral index - integer m ! index along diagonal and row - integer n ! index of diagonal - real(r8) sqrt2 ! sqrt(2) -!----------------------------------------------------------------------- -! -! Multiply ALP and DALP by SQRT(2.) in order to get proper -! normalization. DALP is multiplied by -1 to correct for - sign -! in Copenhagen definition. -! - sqrt2 = sqrt(2._r8) - do m=1,pmmax - mr = nstart(m) - do n=1,nlen(m) - alp(mr+n,irow) = zalp((m-1)*pmax + n)*sqrt2 - dalp(mr+n,irow) = -zdalp((m-1)*pmax + n)*sqrt2 - end do - end do - - return -end subroutine reordp - diff --git a/src/advection/slt/scm0.F90 b/src/advection/slt/scm0.F90 deleted file mode 100644 index 8810c180dc..0000000000 --- a/src/advection/slt/scm0.F90 +++ /dev/null @@ -1,57 +0,0 @@ - -subroutine scm0(n ,deli ,df1 ,df2 ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Apply SCM0 limiter to derivative estimates. -! See Rasch and Williamson (1990) -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: n ! length of vectors - real(r8), intent(in) :: deli(n) ! discrete derivative - real(r8), intent(inout) :: df1(n) ! limited left -edge derivative - real(r8), intent(inout) :: df2(n) ! limited right-edge derivative -! -! n Dimension of input arrays. -! deli deli(i) is the discrete derivative on interval i, i.e., -! deli(i) = ( f(i+1) - f(i) )/( x(i+1) - x(i) ). -! df1 df1(i) is the limited derivative at the left edge of interval -! df2 df2(i) is the limited derivative at the right edge of interval -!----------------------------------------------------------------------- - - -!---------------------------Local variables----------------------------- - integer i ! index - real(r8) fac ! factor applied in limiter - real(r8) tmp1 ! derivative factor - real(r8) tmp2 ! abs(tmp1) -!----------------------------------------------------------------------- -! - fac = 3._r8*(1._r8 - 10._r8*epsilon(fac)) - do i = 1,n - tmp1 = fac*deli(i) - tmp2 = abs( tmp1 ) - if( deli(i)*df1(i) <= 0.0_r8 ) df1(i) = 0._r8 - if( deli(i)*df2(i) <= 0.0_r8 ) df2(i) = 0._r8 - if( abs( df1(i) ) > tmp2 ) df1(i) = tmp1 - if( abs( df2(i) ) > tmp2 ) df2(i) = tmp1 - end do - - return -end subroutine scm0 - diff --git a/src/advection/slt/xqmass.F90 b/src/advection/slt/xqmass.F90 deleted file mode 100644 index 5db28ff606..0000000000 --- a/src/advection/slt/xqmass.F90 +++ /dev/null @@ -1,150 +0,0 @@ - -subroutine xqmass(cwava ,etamid ,w ,qo ,qn , & - xo ,xn ,pdela ,pdelb ,hwxal , & - hwxbl ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Compute comtribution of current latitude to global integrals necessary -! to compute the fixer for the non-water constituents. -! -! Method: -! -! Author: J. Olson, March 1994 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plev, plon - use constituents, only: pcnst, cnst_get_type_byind - - implicit none - -!---------------------------Arguments----------------------------------- - real(r8), intent(in) :: cwava ! normalization factor - real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints - real(r8), intent(in) :: w ! gaussian weight this latitude - real(r8), intent(in) :: qo(plon,plev ) ! q old (pre -SLT) - real(r8), intent(in) :: qn(plon,plev ) ! q new (post-SLT) - real(r8), intent(in) :: xo(plon,plev,pcnst) ! old constituents (pre -SLT) - real(r8), intent(in) :: xn(plon,plev,pcnst) ! new constituents (post-SLT) - real(r8), intent(in) :: pdela(plon,plev) ! pressure diff between interfaces - integer , intent(in) :: nlon ! number of longitudes - ! based pure pressure part of hybrid grid - real(r8), intent(in) :: pdelb(plon,plev) ! pressure diff between interfaces - ! based sigma part of hybrid grid - real(r8), intent(inout) :: hwxal(pcnst,4) ! partial integrals (weighted by pure - ! pressure part of hybrid pressures) - real(r8), intent(inout) :: hwxbl(pcnst,4) ! partial integrals (weighted by sigma - ! part of hybrid pressures) -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i ! longitude index - integer k ! level index - integer m ! constituent index - integer n ! index for partial integral - real(r8) a ! integral constant - real(r8) xdx,xq1,xqdq,xdxq1 ! work elements - real(r8) xdxqdq ! work elements - real(r8) hwak(4),hwbk(4) ! work arrays - real(r8) q1 (plon,plev) ! work array - real(r8) qdq(plon,plev) ! work array - real(r8) hwalat(4) ! partial integrals (weighted by pure -! ! pressure part of hybrid pressures) - real(r8) hwblat(4) ! partial integrals (weighted by sigma -! ! part of hybrid pressures) - real(r8) etamsq(plev) ! etamid*etamid - real(r8) xnt(plon) ! temp version of xn - character*3 cnst_type ! 'dry' or 'wet' mixing ratio -!----------------------------------------------------------------------- -! - a = cwava*w*0.5_r8 - do k = 1,plev - etamsq(k) = etamid(k)*etamid(k) - end do -! -! Compute terms involving water vapor mixing ratio -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k = 1,plev - do i = 1,nlon - q1 (i,k) = 1._r8 - qn(i,k) - qdq(i,k) = qn(i,k)*abs(qn(i,k) - qo(i,k)) - end do - end do -! -! Compute partial integrals for non-water constituents -! -!$OMP PARALLEL DO PRIVATE (M, CNST_TYPE, N, HWALAT, HWBLAT, K, HWAK, HWBK, & -!$OMP I, XNT, XDX, XQ1, XQDQ, XDXQ1, XDXQDQ) - do m = 2,pcnst - cnst_type = cnst_get_type_byind(m) - do n = 1,4 - hwalat(n) = 0._r8 - hwblat(n) = 0._r8 - end do - do k = 1,plev - do n = 1,4 - hwak(n) = 0._r8 - hwbk(n) = 0._r8 - end do - - if (cnst_type.eq.'dry' ) then - do i = 1, nlon - if (abs(xn(i,k,m) - xo(i,k,m)) & - .lt.1.0e-13_r8 * max(abs(xn(i,k,m)), abs(xo(i,k,m)))) then - xnt(i) = xo(i,k,m) - else - xnt(i) = xn(i,k,m) - end if - end do - else - do i = 1, nlon - xnt(i) = xn(i,k,m) - end do - end if - - do i = 1,nlon - xdx = xnt(i)*abs(xn(i,k,m) - xo(i,k,m)) - xq1 = xnt(i)*q1 (i,k) - xqdq = xnt(i)*qdq(i,k) - xdxq1 = xdx *q1 (i,k) - xdxqdq = xdx *qdq(i,k) - - hwak(1) = hwak(1) + xq1 *pdela(i,k) - hwbk(1) = hwbk(1) + xq1 *pdelb(i,k) - hwak(2) = hwak(2) + xqdq *pdela(i,k) - hwbk(2) = hwbk(2) + xqdq *pdelb(i,k) - hwak(3) = hwak(3) + xdxq1 *pdela(i,k) - hwbk(3) = hwbk(3) + xdxq1 *pdelb(i,k) - hwak(4) = hwak(4) + xdxqdq*pdela(i,k) - hwbk(4) = hwbk(4) + xdxqdq*pdelb(i,k) - end do - - hwalat(1) = hwalat(1) + hwak(1) - hwblat(1) = hwblat(1) + hwbk(1) - hwalat(2) = hwalat(2) + hwak(2)*etamid(k) - hwblat(2) = hwblat(2) + hwbk(2)*etamid(k) - hwalat(3) = hwalat(3) + hwak(3)*etamid(k) - hwblat(3) = hwblat(3) + hwbk(3)*etamid(k) - hwalat(4) = hwalat(4) + hwak(4)*etamsq(k) - hwblat(4) = hwblat(4) + hwbk(4)*etamsq(k) - end do -! -! The 0.5 factor arises because Gaussian weights sum to 2 -! - do n = 1,4 - hwxal(m,n) = hwxal(m,n) + hwalat(n)*a - hwxbl(m,n) = hwxbl(m,n) + hwblat(n)*a - end do - end do - - return -end subroutine xqmass diff --git a/src/atmos_phys b/src/atmos_phys new file mode 160000 index 0000000000..89b628646b --- /dev/null +++ b/src/atmos_phys @@ -0,0 +1 @@ +Subproject commit 89b628646b1506f36b35e67038552f09fb0662e6 diff --git a/src/chemistry/aerosol/aer_drydep_mod.F90 b/src/chemistry/aerosol/aer_drydep_mod.F90 new file mode 100644 index 0000000000..512a8bdc5b --- /dev/null +++ b/src/chemistry/aerosol/aer_drydep_mod.F90 @@ -0,0 +1,268 @@ +module aer_drydep_mod + + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid + + ! Shared Data for dry deposition calculation. + + real(r8) rair ! Gas constant for dry air (J/K/kg) + real(r8) gravit ! Gravitational acceleration +! real(r8), allocatable :: phi(:) ! grid latitudes (radians)11 + +contains + +!############################################################################## + +! $Id$ + + subroutine inidrydep( xrair, xgravit) !, xphi ) + +! Initialize dry deposition parameterization. + + implicit none + +! Input arguments: + real(r8), intent(in) :: xrair ! Gas constant for dry air + real(r8), intent(in) :: xgravit ! Gravitational acceleration +! real(r8), intent(in) :: xphi(:) ! grid latitudes (radians) + +! Local variables: + integer i, j, ncid, vid, ns +!----------------------------------------------------------------------- +! ns = size(xphi) +! allocate(phi(ns)) + rair = xrair + gravit = xgravit +! do j = 1, ns +! phi(j) = xphi(j) +! end do + + return + end subroutine inidrydep + +!############################################################################## + + subroutine setdvel( ncol, landfrac, icefrac, ocnfrac, vgl, vgo, vgsi, vg ) + +! Set the deposition velocity depending on whether we are over +! land, ocean, and snow/ice + + + implicit none + +! Input arguments: + + integer, intent(in) :: ncol + real (r8), intent(in) :: landfrac(pcols) ! land fraction + real (r8), intent(in) :: icefrac(pcols) ! ice fraction + real (r8), intent(in) :: ocnfrac(pcols) ! ocean fraction + + real(r8), intent(in) :: vgl ! dry deposition velocity in m/s (land) + real(r8), intent(in) :: vgo ! dry deposition velocity in m/s (ocean) + real(r8), intent(in) :: vgsi ! dry deposition velocity in m/s (snow/ice) + +! Output arguments: + real(r8), intent(out) :: vg(pcols) ! dry deposition velocity in m/s + +! Local variables: + + integer i + real(r8) a + + + do i = 1, ncol + vg(i) = landfrac(i)*vgl + ocnfrac(i)*vgo + icefrac(i)*vgsi +! if (ioro(i).eq.0) then +! vg(i) = vgo +! else if (ioro(i).eq.1) then +! vg(i) = vgl +! else +! vg(i) = vgsi +! endif + end do + + return + end subroutine setdvel + +!############################################################################## + + subroutine ddflux( ncol, vg, q, p, tv, flux ) + +! Compute surface flux due to dry deposition processes. + + + implicit none + +! Input arguments: + integer , intent(in) :: ncol + real(r8), intent(in) :: vg(pcols) ! dry deposition velocity in m/s + real(r8), intent(in) :: q(pcols) ! tracer conc. in surface layer (kg tracer/kg moist air) + real(r8), intent(in) :: p(pcols) ! midpoint pressure in surface layer (Pa) + real(r8), intent(in) :: tv(pcols) ! midpoint virtual temperature in surface layer (K) + +! Output arguments: + + real(r8), intent(out) :: flux(pcols) ! flux due to dry deposition in kg/m^s/sec + +! Local variables: + + integer i + + do i = 1, ncol + flux(i) = -vg(i) * q(i) * p(i) /(tv(i) * rair) + end do + + return + end subroutine ddflux + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: subroutine d3ddflux +! +! !INTERFACE: +! + subroutine d3ddflux ( ncol, vlc_dry, q,pmid,pdel, tv, dep_dry,dep_dry_tend,dt) +! Description: +!Do 3d- settling deposition calculations following Zender's dust codes, Dec 02. +! +! Author: Natalie Mahowald +! + implicit none + +! Input arguments: + integer , intent(in) :: ncol + real(r8), intent(in) :: vlc_dry(pcols,pver) ! dry deposition velocity in m/s + real(r8), intent(in) :: q(pcols,pver) ! tracer conc. in surface layer (kg tracer/kg moist air) + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressure in surface layer (Pa) + real(r8), intent(in) :: pdel(pcols,pver) ! delta pressure across level (Pa) + real(r8), intent(in) :: tv(pcols,pver) ! midpoint virtual temperature in surface layer (K) + real(r8), intent(in) :: dt ! time step + +! Output arguments: + + real(r8), intent(out) :: dep_dry(pcols) ! flux due to dry deposition in kg /m^s/sec + real(r8), intent(out) :: dep_dry_tend(pcols,pver) ! flux due to dry deposition in kg /m^s/sec + +! Local variables: + + real(r8) :: flux(pcols,0:pver) ! downward flux at each level: kg/m2/s + integer i,k + do i=1,ncol + flux(i,0)=0._r8 + enddo + do k=1,pver + do i = 1, ncol + flux(i,k) = -min(vlc_dry(i,k) * q(i,k) * pmid(i,k) /(tv(i,k) * rair), & + q(i,k)*pdel(i,k)/gravit/dt) + dep_dry_tend(i,k)=(flux(i,k)-flux(i,k-1))/pdel(i,k)*gravit !kg/kg/s + + end do + enddo +! surface flux: + do i=1,ncol + dep_dry(i)=flux(i,pver) + enddo + return + end subroutine d3ddflux + + + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: subroutine Calcram +! +! !INTERFACE: +! + + subroutine calcram(ncol,landfrac,icefrac,ocnfrac,obklen,& + ustar,ram1in,ram1,t,pmid,& + pdel,fvin,fv) + ! + ! !DESCRIPTION: + ! + ! Calc aerodynamic resistance over oceans and sea ice (comes in from land model) + ! from Seinfeld and Pandis, p.963. + ! + ! Author: Natalie Mahowald + ! + implicit none + integer, intent(in) :: ncol + real(r8),intent(in) :: ram1in(pcols) !aerodynamical resistance (s/m) + real(r8),intent(in) :: fvin(pcols) ! sfc frc vel from land + real(r8),intent(out) :: ram1(pcols) !aerodynamical resistance (s/m) + real(r8),intent(out) :: fv(pcols) ! sfc frc vel from land + real(r8), intent(in) :: obklen(pcols) ! obklen + real(r8), intent(in) :: ustar(pcols) ! sfc fric vel + real(r8), intent(in) :: landfrac(pcols) ! land fraction + real(r8), intent(in) :: icefrac(pcols) ! ice fraction + real(r8), intent(in) :: ocnfrac(pcols) ! ocean fraction + real(r8), intent(in) :: t(pcols) !atm temperature (K) + real(r8), intent(in) :: pmid(pcols) !atm pressure (Pa) + real(r8), intent(in) :: pdel(pcols) !atm pressure (Pa) + real(r8), parameter :: zzocen = 0.0001_r8 ! Ocean aerodynamic roughness length + real(r8), parameter :: zzsice = 0.0400_r8 ! Sea ice aerodynamic roughness length + real(r8), parameter :: xkar = 0.4_r8 ! Von Karman constant + + ! local variables + real(r8) :: z,psi,psi0,nu,nu0,temp,ram + integer :: i + ! write(iulog,*) rair,zzsice,zzocen,gravit,xkar + + + do i=1,ncol + z=pdel(i)*rair*t(i)/pmid(i)/gravit/2.0_r8 !use half the layer height like Ganzefeld and Lelieveld, 1995 + if(obklen(i).eq.0) then + psi=0._r8 + psi0=0._r8 + else + psi=min(max(z/obklen(i),-1.0_r8),1.0_r8) + psi0=min(max(zzocen/obklen(i),-1.0_r8),1.0_r8) + endif + temp=z/zzocen + if(icefrac(i) > 0.5_r8) then + if(obklen(i).gt.0) then + psi0=min(max(zzsice/obklen(i),-1.0_r8),1.0_r8) + else + psi0=0.0_r8 + endif + temp=z/zzsice + endif + if(psi> 0._r8) then + ram=1/xkar/ustar(i)*(log(temp)+4.7_r8*(psi-psi0)) + else + nu=(1.00_r8-15.000_r8*psi)**(.25_r8) + nu0=(1.000_r8-15.000_r8*psi0)**(.25_r8) + if(ustar(i).ne.0._r8) then + ram=1/xkar/ustar(i)*(log(temp) & + +log(((nu0**2+1.00_r8)*(nu0+1.0_r8)**2)/((nu**2+1.0_r8)*(nu+1.00_r8)**2)) & + +2.0_r8*(atan(nu)-atan(nu0))) + else + ram=0._r8 + endif + endif + if(landfrac(i) < 0.000000001_r8) then + fv(i)=ustar(i) + ram1(i)=ram + else + fv(i)=fvin(i) + ram1(i)=ram1in(i) + endif + ! write(iulog,*) i,pdel(i),t(i),pmid(i),gravit,obklen(i),psi,psi0,icefrac(i),nu,nu0,ram,ustar(i),& + ! log(((nu0**2+1.00)*(nu0+1.0)**2)/((nu**2+1.0)*(nu+1.00)**2)),2.0*(atan(nu)-atan(nu0)) + + enddo + + ! fvitt -- fv == 0 causes a floating point exception in + ! dry dep of sea salts and dust + where ( fv(:ncol) == 0._r8 ) + fv(:ncol) = 1.e-12_r8 + endwhere + + return + end subroutine calcram + + +!############################################################################## +end module aer_drydep_mod diff --git a/src/chemistry/aerosol/aero_convproc.F90 b/src/chemistry/aerosol/aero_convproc.F90 new file mode 100644 index 0000000000..1915e295ad --- /dev/null +++ b/src/chemistry/aerosol/aero_convproc.F90 @@ -0,0 +1,2146 @@ +module aero_convproc +!--------------------------------------------------------------------------------- +! Purpose: +! +! CAM interface to aerosol/trace-gas convective cloud processing scheme +! +! currently these routines assume stratiform and convective clouds only interact +! through the detrainment of convective cloudborne material into stratiform clouds +! +! thus the stratiform-cloudborne aerosols (in the qqcw array) are not processed +! by the convective up/downdrafts, but are affected by the detrainment +! +! Author: R. C. Easter +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use shr_kind_mod, only: shr_kind_cs + +use spmd_utils, only: masterproc +use physconst, only: gravit, rair +use ppgrid, only: pver, pcols, pverp +use constituents, only: pcnst, cnst_get_ind +use constituents, only: cnst_species_class, cnst_spec_class_aerosol +use phys_control, only: phys_getopts + +use physics_types, only: physics_state, physics_ptend +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field +use time_manager, only: get_nstep +use cam_history, only: outfld, addfld, add_default, horiz_only +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +use aerosol_properties_mod, only: aerosol_properties +use aerosol_state_mod, only: aerosol_state, ptr2d_t + +implicit none +private + +public :: aero_convproc_readnl +public :: aero_convproc_init +public :: aero_convproc_intr + +! namelist options +! NOTE: These are the defaults for CAM6. +logical, protected, public :: deepconv_wetdep_history = .true. +logical, protected, public :: convproc_do_deep = .true. +! NOTE: These are the defaults for the Eaton/Wang parameterization. +logical, protected, public :: convproc_do_evaprain_atonce = .false. +real(r8), protected, public :: convproc_pom_spechygro = -1._r8 +real(r8), protected, public :: convproc_wup_max = 4.0_r8 + +logical, parameter :: use_cwaer_for_activate_maxsat = .false. +logical, parameter :: apply_convproc_tend_to_ptend = .true. + +real(r8) :: hund_ovr_g ! = 100.0_r8/gravit +! used with zm_conv mass fluxes and delta-p +! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s] +! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2] + +! method1_activate_nlayers = number of layers (including cloud base) where activation is applied +integer, parameter :: method1_activate_nlayers = 2 +! method2_activate_smaxmax = the uniform or peak supersat value (as 0-1 fraction = percent*0.01) +real(r8), parameter :: method2_activate_smaxmax = 0.003_r8 + +! method_reduce_actfrac = 1 -- multiply activation fractions by factor_reduce_actfrac +! (this works ok with convproc_method_activate = 1 but not for ... = 2) +! = 2 -- do 2 iterations to get an overall reduction by factor_reduce_actfrac +! (this works ok with convproc_method_activate = 1 or 2) +! = other -- do nothing involving reduce_actfrac +integer, parameter :: method_reduce_actfrac = 0 +real(r8), parameter :: factor_reduce_actfrac = 0.5_r8 + +! convproc_method_activate - 1=apply abdulrazzak-ghan to entrained aerosols for lowest nlayers +! 2=do secondary activation with prescribed supersat +integer, parameter :: convproc_method_activate = 2 + +logical :: convproc_do_aer + +! physics buffer indices +integer :: fracis_idx = 0 + +integer :: rprddp_idx = 0 +integer :: rprdsh_idx = 0 +integer :: nevapr_shcu_idx = 0 +integer :: nevapr_dpcu_idx = 0 + +integer :: icwmrdp_idx = 0 +integer :: icwmrsh_idx = 0 +integer :: sh_frac_idx = 0 +integer :: dp_frac_idx = 0 + +integer :: zm_eu_idx = 0 +integer :: zm_du_idx = 0 +integer :: zm_ed_idx = 0 +integer :: zm_dp_idx = 0 +integer :: zm_jt_idx = 0 +integer :: zm_maxg_idx = 0 +integer :: zm_ideep_idx = 0 + +integer :: cmfmc_sh_idx = 0 +integer :: sh_e_ed_ratio_idx = 0 + +integer :: istat + +integer :: nbins = 0 +integer :: ncnstaer = 0 + +integer, allocatable :: aer_cnst_ndx(:) + +character(len=32), allocatable :: cnst_name_extd(:,:) ! (2,ncnstaer) + +contains + +!========================================================================================= +subroutine aero_convproc_readnl(nlfile) + + use namelist_utils, only: find_group_name + use spmd_utils, only: mpicom, masterprocid, mpi_real8, mpi_logical + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'aero_convproc_readnl' + + namelist /aerosol_convproc_opts/ deepconv_wetdep_history, convproc_do_deep, & + convproc_do_evaprain_atonce, convproc_pom_spechygro, convproc_wup_max + + ! Read namelist + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'aerosol_convproc_opts', status=ierr) + if (ierr == 0) then + read(unitn, aerosol_convproc_opts, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast( deepconv_wetdep_history, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast( convproc_do_deep, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast( convproc_do_evaprain_atonce, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast( convproc_pom_spechygro, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast( convproc_wup_max, 1, mpi_real8, masterprocid, mpicom, ierr) + + if (masterproc) then + write(iulog,*) subname//': deepconv_wetdep_history = ',deepconv_wetdep_history + write(iulog,*) subname//': convproc_do_deep = ',convproc_do_deep + write(iulog,*) subname//': convproc_do_evaprain_atonce = ',convproc_do_evaprain_atonce + write(iulog,*) subname//': convproc_pom_spechygro = ',convproc_pom_spechygro + write(iulog,*) subname//': convproc_wup_max = ', convproc_wup_max + end if + +end subroutine aero_convproc_readnl + +!========================================================================================= + +subroutine aero_convproc_init(aero_props) + + class(aerosol_properties), intent(in) :: aero_props + + integer :: m, mm, l, ndx, astat + integer :: npass_calc_updraft + logical :: history_aerosol + character(len=32) :: name_a, name_c + + character(len=*), parameter :: prefix = 'aero_convproc_init: ' + + hund_ovr_g = 100.0_r8/gravit + ! used with zm_conv mass fluxes and delta-p + ! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s] + ! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2] + + nbins = aero_props%nbins() + ncnstaer = aero_props%ncnst_tot() + + allocate(aer_cnst_ndx(ncnstaer),stat=astat) + if (astat/=0) then + call endrun(prefix//'aer_cnst_ndx allocation error') + end if + allocate(cnst_name_extd(2,ncnstaer),stat=astat) + if (astat/=0) then + call endrun(prefix//'cnst_name_extd allocation error') + end if + + aer_cnst_ndx(:) = -1 + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + if (l==0) then + call aero_props%num_names(m, name_a, name_c) + else + call aero_props%mmr_names(m,l, name_a, name_c) + endif + cnst_name_extd(1,mm) = name_a + cnst_name_extd(2,mm) = name_c + + call cnst_get_ind(trim(name_a), ndx, abort=.false.) + aer_cnst_ndx(mm) = ndx + end do + end do + + call phys_getopts( history_aerosol_out=history_aerosol, & + convproc_do_aer_out = convproc_do_aer ) + + call addfld('DP_MFUP_MAX', horiz_only, 'A', 'kg/m2', & + 'Deep conv. column-max updraft mass flux' ) + 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' ) + + ! output wet deposition fields to history + ! I = in-cloud removal; E = precip-evap resuspension + ! C = convective (total); D = deep convective + ! note that the precip-evap resuspension includes that resulting from + ! below-cloud removal, calculated in mz_aero_wet_intr + if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + ndx = aer_cnst_ndx(mm) + + if ( deepconv_wetdep_history ) then + call addfld (trim(cnst_name_extd(1,mm))//'SFSID', & + horiz_only, 'A','kg/m2/s','Wet deposition flux (incloud, deep convective) at surface') + call addfld (trim(cnst_name_extd(1,mm))//'SFSED', & + horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, deep convective) at surface') + if (history_aerosol) then + call add_default(trim(cnst_name_extd(1,mm))//'SFSID', 1, ' ') + call add_default(trim(cnst_name_extd(1,mm))//'SFSED', 1, ' ') + end if + end if + + end do + end do + end if + + if ( history_aerosol .and. convproc_do_aer ) then + call add_default( 'DP_MFUP_MAX', 1, ' ' ) + call add_default( 'DP_WCLDBASE', 1, ' ' ) + call add_default( 'DP_KCLDBASE', 1, ' ' ) + end if + + fracis_idx = pbuf_get_index('FRACIS') + + rprddp_idx = pbuf_get_index('RPRDDP') + rprdsh_idx = pbuf_get_index('RPRDSH') + nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') + nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') + + icwmrdp_idx = pbuf_get_index('ICWMRDP') + icwmrsh_idx = pbuf_get_index('ICWMRSH') + dp_frac_idx = pbuf_get_index('DP_FRAC') + sh_frac_idx = pbuf_get_index('SH_FRAC') + + zm_eu_idx = pbuf_get_index('ZM_EU') + zm_du_idx = pbuf_get_index('ZM_DU') + zm_ed_idx = pbuf_get_index('ZM_ED') + zm_dp_idx = pbuf_get_index('ZM_DP') + zm_jt_idx = pbuf_get_index('ZM_JT') + zm_maxg_idx = pbuf_get_index('ZM_MAXG') + zm_ideep_idx = pbuf_get_index('ZM_IDEEP') + + cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') + sh_e_ed_ratio_idx = pbuf_get_index('SH_E_ED_RATIO', istat) + + if (masterproc ) then + + write(iulog,'(a,l12)') 'aero_convproc_init - convproc_do_aer = ', & + convproc_do_aer + write(iulog,'(a,l12)') 'aero_convproc_init - use_cwaer_for_activate_maxsat = ', & + use_cwaer_for_activate_maxsat + write(iulog,'(a,l12)') 'aero_convproc_init - apply_convproc_tend_to_ptend = ', & + apply_convproc_tend_to_ptend + write(iulog,'(a,i12)') 'aero_convproc_init - convproc_method_activate = ', & + convproc_method_activate + write(iulog,'(a,i12)') 'aero_convproc_init - method1_activate_nlayers = ', & + method1_activate_nlayers + write(iulog,'(a,1pe12.4)') 'aero_convproc_init - method2_activate_smaxmax = ', & + method2_activate_smaxmax + write(iulog,'(a,i12)') 'aero_convproc_init - method_reduce_actfrac = ', & + method_reduce_actfrac + write(iulog,'(a,1pe12.4)') 'aero_convproc_init - factor_reduce_actfrac = ', & + factor_reduce_actfrac + + npass_calc_updraft = 1 + if ( (method_reduce_actfrac == 2) .and. & + (factor_reduce_actfrac >= 0.0_r8) .and. & + (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2 + write(iulog,'(a,i12)') 'aero_convproc_init - npass_calc_updraft = ', & + npass_calc_updraft + + end if + +end subroutine aero_convproc_init + +!========================================================================================= + +subroutine aero_convproc_intr( aero_props, aero_state, state, ptend, pbuf, ztodt, & + nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, & + aerdepwetis, dcondt_resusp3d ) +!----------------------------------------------------------------------- +! +! Convective cloud processing (transport, activation/resuspension, +! wet removal) of aerosols and trace gases. +! (Currently no aqueous chemistry and no trace-gas wet removal) +! Does aerosols when convproc_do_aer is .true. +! +! Does deep convection +! Uses mass fluxes, cloud water, precip production from the +! convective cloud routines +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + + ! Arguments + class(aerosol_properties), intent(in) :: aero_props + class(aerosol_state), intent(in) :: aero_state + + type(physics_state),target,intent(in ) :: state ! Physics state variables + type(physics_ptend), intent(inout) :: ptend ! %lq set in aero_model_wetdep + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) + + integer, intent(in) :: nsrflx_mzaer2cnvpr + real(r8), intent(in) :: qsrflx_mzaer2cnvpr(pcols,ncnstaer,nsrflx_mzaer2cnvpr) + real(r8), intent(inout) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial) + real(r8), intent(inout) :: dcondt_resusp3d(ncnstaer,pcols,pver) + + ! Local variables + integer, parameter :: nsrflx = 5 ! last dimension of qsrflx + integer :: l, m, mm, ndx, lchnk + integer :: ncol + + real(r8) :: dqdt(pcols,pver,ncnstaer) + real(r8) :: dt + + + + real(r8) :: q(pcols,pver,ncnstaer) + real(r8) :: qsrflx(pcols,ncnstaer,nsrflx) + real(r8), pointer :: qptr(:,:) + + real(r8) :: sflxic(pcols,ncnstaer) + real(r8) :: sflxid(pcols,ncnstaer) + real(r8) :: sflxec(pcols,ncnstaer) + real(r8) :: sflxed(pcols,ncnstaer) + + type(ptr2d_t) :: raer(ncnstaer) ! aerosol mass, number mixing ratios + type(ptr2d_t) :: qqcw(ncnstaer) + + logical :: dotend(pcnst) + logical :: applytend + + !------------------------------------------------------------------------------------------------- + + dotend = .false. + + ! Initialize + lchnk = state%lchnk + ncol = state%ncol + dt = ztodt + + sflxic(:,:) = 0.0_r8 + sflxid(:,:) = 0.0_r8 + sflxec(:,:) = 0.0_r8 + sflxed(:,:) = 0.0_r8 + + call aero_state%get_states( aero_props, raer, qqcw ) + + ! prepare for deep conv processing + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + + mm = aero_props%indexer(m,l) + ndx = aer_cnst_ndx(mm) + + sflxec(1:ncol,mm) = qsrflx_mzaer2cnvpr(1:ncol,mm,1) + sflxed(1:ncol,mm) = qsrflx_mzaer2cnvpr(1:ncol,mm,2) + + applytend = .false. + if ( ndx > 0 ) then + applytend = ptend%lq(ndx) + dotend(ndx) = applytend + endif + + qptr => raer(mm)%fld + + if ( applytend ) then + ! calc new q (after calcaersize and mz_aero_wet_intr) + q(1:ncol,:,mm) = max( 0.0_r8, qptr(1:ncol,:) + dt*ptend%q(1:ncol,:,ndx) ) + else + ! use old q + q(1:ncol,:,mm) = qptr(1:ncol,:) + end if + + end do + end do + + dqdt(:,:,:) = 0.0_r8 + qsrflx(:,:,:) = 0.0_r8 + + if (convproc_do_aer) then + + ! do deep conv processing + if (convproc_do_deep) then + call aero_convproc_dp_intr( aero_props, & + state, pbuf, dt, & + q, dqdt, nsrflx, qsrflx, dcondt_resusp3d ) + + ! apply deep conv processing tendency + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + ndx = aer_cnst_ndx(mm) + + if ( apply_convproc_tend_to_ptend ) then + ! add dqdt onto ptend%q and set ptend%lq + if (ndx>0) then ! advected species + ptend%q(1:ncol,:,ndx) = ptend%q(1:ncol,:,ndx) + dqdt(1:ncol,:,mm) + else + raer(mm)%fld(1:ncol,:) = max( 0.0_r8, raer(mm)%fld(1:ncol,:) + dqdt(1:ncol,:,mm) * dt ) + end if + end if + + ! these used for history file wetdep diagnostics + sflxic(1:ncol,mm) = sflxic(1:ncol,mm) + qsrflx(1:ncol,mm,4) + sflxid(1:ncol,mm) = sflxid(1:ncol,mm) + qsrflx(1:ncol,mm,4) + sflxec(1:ncol,mm) = sflxec(1:ncol,mm) + qsrflx(1:ncol,mm,5) + sflxed(1:ncol,mm) = sflxed(1:ncol,mm) + qsrflx(1:ncol,mm,5) + + ! this used for surface coupling + if (ndx>0) then + aerdepwetis(1:ncol,ndx) = aerdepwetis(1:ncol,ndx) & + + qsrflx(1:ncol,mm,4) + qsrflx(1:ncol,mm,5) + end if + end do + end do + + end if + + end if ! (convproc_do_aer) then + + if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + ndx = aer_cnst_ndx(mm) + + if (ndx>0) call outfld( trim(cnst_name_extd(1,mm))//'SFWET', aerdepwetis(:,ndx), pcols, lchnk ) + call outfld( trim(cnst_name_extd(1,mm))//'SFSIC', sflxic(:,mm), pcols, lchnk ) + call outfld( trim(cnst_name_extd(1,mm))//'SFSEC', sflxec(:,mm), pcols, lchnk ) + + if ( deepconv_wetdep_history ) then + call outfld( trim(cnst_name_extd(1,mm))//'SFSID', sflxid(:,mm), pcols, lchnk ) + call outfld( trim(cnst_name_extd(1,mm))//'SFSED', sflxed(:,mm), pcols, lchnk ) + end if + end do + end do + + end if + +end subroutine aero_convproc_intr + +!========================================================================================= + +subroutine aero_convproc_dp_intr( aero_props, & + state, pbuf, dt, & + q, dqdt, nsrflx, qsrflx, dcondt_resusp3d) +!----------------------------------------------------------------------- +! +! Convective cloud processing (transport, activation/resuspension, +! wet removal) of aerosols and trace gases. +! (Currently no aqueous chemistry and no trace-gas wet removal) +! Does aerosols when convproc_do_aer is .true. +! +! This routine does deep convection +! Uses mass fluxes, cloud water, precip production from the +! convective cloud routines +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + ! Arguments + class(aerosol_properties), intent(in) :: aero_props + + type(physics_state), intent(in ) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(in) :: dt ! delta t (model time increment) + + real(r8), intent(in) :: q(pcols,pver,ncnstaer) + real(r8), intent(inout) :: dqdt(pcols,pver,ncnstaer) + integer, intent(in) :: nsrflx + real(r8), intent(inout) :: qsrflx(pcols,ncnstaer,nsrflx) + real(r8), intent(inout) :: dcondt_resusp3d(ncnstaer,pcols,pver) + + integer :: i + integer :: lchnk + integer :: nstep + + real(r8) :: dpdry(pcols,pver) ! layer delta-p-dry (mb) + real(r8) :: fracice(pcols,pver) ! Ice fraction of cloud droplets + real(r8) :: xx_mfup_max(pcols), xx_wcldbase(pcols), xx_kcldbase(pcols) + + ! physics buffer fields + real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble + real(r8), pointer :: rprddp(:,:) ! Deep conv precip production (kg/kg/s - grid avg) + real(r8), pointer :: evapcdp(:,:) ! Deep conv precip evaporation (kg/kg/s - grid avg) + real(r8), pointer :: icwmrdp(:,:) ! Deep conv cloud condensate (kg/kg - in cloud) + real(r8), pointer :: dp_frac(:,:) ! Deep conv cloud frac (0-1) + + ! deep conv variables + real(r8), pointer :: du(:,:) ! Mass detrain rate from updraft (pcols,pver) + real(r8), pointer :: eu(:,:) ! Mass entrain rate into updraft (pcols,pver) + real(r8), pointer :: ed(:,:) ! Mass entrain rate into downdraft (pcols,pver) + ! eu, ed, du are "d(massflux)/dp" and are all positive + real(r8), pointer :: dp(:,:) ! Delta pressure between interfaces (pcols,pver) + integer, pointer :: jt(:) ! Index of cloud top for each column (pcols) + integer, pointer :: maxg(:) ! Index of cloud bottom for each column (pcols) + integer, pointer :: ideep(:) ! Gathering array (pcols) + integer :: lengath ! Gathered min lon indices over which to operate + + ! Initialize + + lchnk = state%lchnk + nstep = get_nstep() + + ! Associate pointers with physics buffer fields + call pbuf_get_field(pbuf, rprddp_idx, rprddp) + call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp) + call pbuf_get_field(pbuf, icwmrdp_idx, icwmrdp) + call pbuf_get_field(pbuf, dp_frac_idx, dp_frac) + call pbuf_get_field(pbuf, fracis_idx, fracis) + call pbuf_get_field(pbuf, zm_eu_idx, eu) + call pbuf_get_field(pbuf, zm_du_idx, du) + call pbuf_get_field(pbuf, zm_ed_idx, ed) + call pbuf_get_field(pbuf, zm_dp_idx, dp) + call pbuf_get_field(pbuf, zm_jt_idx, jt) + call pbuf_get_field(pbuf, zm_maxg_idx, maxg) + call pbuf_get_field(pbuf, zm_ideep_idx, ideep) + + lengath = count(ideep > 0) + + fracice(:,:) = 0.0_r8 + + ! initialize dpdry (units=mb), which is used for tracers of dry mixing ratio type + dpdry = 0._r8 + do i = 1, lengath + dpdry(i,:) = state%pdeldry(ideep(i),:)/100._r8 + end do + + call aero_convproc_tend( aero_props, 'deep', lchnk, dt, & + state%t, state%pmid, q, du, eu, & + ed, dp, dpdry, jt, & + maxg, ideep, 1, lengath, & + dp_frac, icwmrdp, rprddp, evapcdp, & + fracice, dqdt, nsrflx, qsrflx, & + xx_mfup_max, xx_wcldbase, xx_kcldbase, & + dcondt_resusp3d ) + + call outfld( 'DP_MFUP_MAX', xx_mfup_max, pcols, lchnk ) + call outfld( 'DP_WCLDBASE', xx_wcldbase, pcols, lchnk ) + call outfld( 'DP_KCLDBASE', xx_kcldbase, pcols, lchnk ) + +end subroutine aero_convproc_dp_intr + +!========================================================================================= + +subroutine aero_convproc_tend( aero_props, convtype, lchnk, dt, & + t, pmid, q, du, eu, & + ed, dp, dpdry, jt, & + mx, ideep, il1g, il2g, & + cldfrac, icwmr, rprd, evapc, & + fracice, dqdt, nsrflx, qsrflx, & + xx_mfup_max, xx_wcldbase, xx_kcldbase, & + dcondt_resusp3d ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Convective transport of trace species. +! The trace species need not be conservative, and source/sink terms for +! activation, resuspension, aqueous chemistry and gas uptake, and +! wet removal are all applied. +! Currently this works with the ZM deep convection, but we should be able +! to adapt it for both Hack and McCaa shallow convection +! +! Compare to subr convproc which does conservative trace species. +! +! Method: +! Computes tracer mixing ratios in updraft and downdraft "cells" in a +! Lagrangian manner, with source/sinks applied in the updraft other. +! Then computes grid-cell-mean tendencies by considering +! updraft and downdraft fluxes across layer boundaries +! environment subsidence/lifting fluxes across layer boundaries +! sources and sinks in the updraft +! resuspension of activated species in the grid-cell as a whole +! +! Note1: A better estimate or calculation of either the updraft velocity +! or fractional area is needed. +! Note2: If updraft area is a small fraction of over cloud area, +! then aqueous chemistry is underestimated. These are both +! research areas. +! +! Authors: O. Seland and R. Easter, based on convtran by P. Rasch +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! +! Input arguments +! + class(aerosol_properties), intent(in) :: aero_props + + character(len=*), intent(in) :: convtype ! identifies the type of + ! convection ("deep", "shcu") + integer, intent(in) :: lchnk ! chunk identifier + real(r8), intent(in) :: dt ! Model timestep + real(r8), intent(in) :: t(pcols,pver) ! Temperature + real(r8), intent(in) :: pmid(pcols,pver) ! Pressure at model levels + real(r8), intent(in) :: q(pcols,pver,ncnstaer) ! Tracer array including moisture + + real(r8), intent(in) :: du(pcols,pver) ! Mass detrain rate from updraft + real(r8), intent(in) :: eu(pcols,pver) ! Mass entrain rate into updraft + real(r8), intent(in) :: ed(pcols,pver) ! Mass entrain rate into downdraft +! *** note1 - mu, md, eu, ed, du, dp, dpdry are GATHERED ARRAYS *** +! *** note2 - mu and md units are (mb/s), which is used in the zm_conv code +! - eventually these should be changed to (kg/m2/s) +! *** note3 - eu, ed, du are "d(massflux)/dp" (with dp units = mb), and are all >= 0 + + real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces (mb) + real(r8), intent(in) :: dpdry(pcols,pver) ! Delta dry-pressure (mb) + integer, intent(in) :: jt(pcols) ! Index of cloud top for each column + integer, intent(in) :: mx(pcols) ! Index of cloud bottom for each column + integer, intent(in) :: ideep(pcols) ! Gathering array indices + integer, intent(in) :: il1g ! Gathered min lon indices over which to operate + integer, intent(in) :: il2g ! Gathered max lon indices over which to operate +! *** note4 -- for il1g <= i <= il2g, icol = ideep(i) is the "normal" chunk column index + + real(r8), intent(in) :: cldfrac(pcols,pver) ! Convective cloud fractional area + real(r8), intent(in) :: icwmr(pcols,pver) ! Convective cloud water from zhang + real(r8), intent(in) :: rprd(pcols,pver) ! Convective precipitation formation rate + real(r8), intent(in) :: evapc(pcols,pver) ! Convective precipitation evaporation rate + real(r8), intent(in) :: fracice(pcols,pver) ! Ice fraction of cloud droplets + + real(r8), intent(out):: dqdt(pcols,pver,ncnstaer) ! Tracer tendency array + integer, intent(in) :: nsrflx ! last dimension of qsrflx + real(r8), intent(out):: qsrflx(pcols,ncnstaer,nsrflx) + ! process-specific column tracer tendencies + ! (1=activation, 2=resuspension, 3=aqueous rxn, + ! 4=wet removal, 5=renaming) + real(r8), intent(out) :: xx_mfup_max(pcols) + real(r8), intent(out) :: xx_wcldbase(pcols) + real(r8), intent(out) :: xx_kcldbase(pcols) + real(r8), intent(inout) :: dcondt_resusp3d(ncnstaer,pcols,pver) + +!--------------------------Local Variables------------------------------ + +! cloudborne aerosol, so the arrays are dimensioned with pcnst_extd = pcnst*2 + + integer :: i, icol ! Work index + integer :: iconvtype ! 1=deep, 2=uw shallow + integer :: iflux_method ! 1=as in convtran (deep), 2=simpler + integer :: ipass_calc_updraft + integer :: jtsub ! Work index + integer :: k ! Work index + integer :: kactcnt ! Counter for no. of levels having activation + integer :: kactcntb ! Counter for activation diagnostic output + integer :: kactfirst ! Lowest layer with activation (= cloudbase) + integer :: kbot ! Cloud-flux bottom layer for current i (=mx(i)) + integer :: kbot_prevap ! Lowest layer for doing resuspension from evaporating precip + integer :: ktop ! Cloud-flux top layer for current i (=jt(i)) + ! Layers between kbot,ktop have mass fluxes + ! but not all have cloud water, because the + ! updraft starts below the cloud base + integer :: km1, km1x ! Work index + integer :: kp1, kp1x ! Work index + integer :: l, mm ! Work index + integer :: m, n, ndx ! Work index + integer :: nerr ! number of errors for entire run + integer :: nerrmax ! maximum number of errors to report + integer :: npass_calc_updraft + integer :: ntsub ! + + logical do_act_this_lev ! flag for doing activation at current level + + real(r8) aqfrac(2,ncnstaer) ! aqueous fraction of constituent in updraft + real(r8) cldfrac_i(pver) ! cldfrac at current i (with adjustments) + + real(r8) chat(2,ncnstaer,pverp) ! mix ratio in env at interfaces + real(r8) cond(2,ncnstaer,pverp) ! mix ratio in downdraft at interfaces + real(r8) const(2,ncnstaer,pver) ! gathered tracer array + real(r8) conu(2,ncnstaer,pverp) ! mix ratio in updraft at interfaces + + real(r8) dcondt(2,ncnstaer,pver) ! grid-average TMR tendency for current column + real(r8) dcondt_prevap(2,ncnstaer,pver) ! portion of dcondt from precip evaporation + real(r8) dcondt_resusp(2,ncnstaer,pver) ! portion of dcondt from resuspension + + real(r8) dcondt_wetdep(2,ncnstaer,pver) ! portion of dcondt from wet deposition + real(r8) dconudt_activa(2,ncnstaer,pverp) ! d(conu)/dt by activation + real(r8) dconudt_aqchem(2,ncnstaer,pverp) ! d(conu)/dt by aqueous chem + real(r8) dconudt_wetdep(2,ncnstaer,pverp) ! d(conu)/dt by wet removal + + real(r8) maxflux(2,ncnstaer) ! maximum (over layers) of fluxin and fluxout + real(r8) maxflux2(2,ncnstaer) ! ditto but computed using method-2 fluxes + real(r8) maxprevap(2,ncnstaer) ! maximum (over layers) of dcondt_prevap*dp + real(r8) maxresusp(2,ncnstaer) ! maximum (over layers) of dcondt_resusp*dp + real(r8) maxsrce(2,ncnstaer) ! maximum (over layers) of netsrce + + real(r8) sumflux(2,ncnstaer) ! sum (over layers) of netflux + real(r8) sumflux2(2,ncnstaer) ! ditto but computed using method-2 fluxes + real(r8) sumsrce(2,ncnstaer) ! sum (over layers) of dp*netsrce + real(r8) sumchng(2,ncnstaer) ! sum (over layers) of dp*dcondt + real(r8) sumchng3(2,ncnstaer) ! ditto but after call to resusp_conv + real(r8) sumprevap(2,ncnstaer) ! sum (over layers) of dp*dcondt_prevap + real(r8) sumwetdep(2,ncnstaer) ! sum (over layers) of dp*dconudt_wetdep + + real(r8) cabv ! mix ratio of constituent above + real(r8) cbel ! mix ratio of constituent below + real(r8) cdifr ! normalized diff between cabv and cbel + real(r8) cdt(pver) ! (in-updraft first order wet removal rate) * dt + real(r8) clw_cut ! threshold clw value for doing updraft + ! transformation and removal + real(r8) courantmax ! maximum courant no. + real(r8) dddp(pver) ! dd(i,k)*dp(i,k) at current i + real(r8) dp_i(pver) ! dp(i,k) at current i + real(r8) dt_u(pver) ! lagrangian transport time in the updraft + real(r8) dudp(pver) ! du(i,k)*dp(i,k) at current i + real(r8) dqdt_i(pver,ncnstaer) ! dqdt(i,k,m) at current i + real(r8) dtsub ! dt/ntsub + real(r8) dz ! working layer thickness (m) + real(r8) eddp(pver) ! ed(i,k)*dp(i,k) at current i + real(r8) eudp(pver) ! eu(i,k)*dp(i,k) at current i + real(r8) expcdtm1 ! a work variable + real(r8) fa_u(pver) ! fractional area of in the updraft + real(r8) fa_u_dp ! current fa_u(k)*dp_i(k) + real(r8) f_ent ! fraction of the "before-detrainment" updraft + ! massflux at k/k-1 interface resulting from + ! entrainment of level k air + real(r8) fluxin ! a work variable + real(r8) fluxout ! a work variable + real(r8) maxc ! a work variable + real(r8) mbsth ! Threshold for mass fluxes + real(r8) minc ! a work variable + real(r8) md_m_eddp ! a work variable + real(r8) md_i(pverp) ! md(i,k) at current i (note pverp dimension) + real(r8) md_x(pverp) ! md(i,k) at current i (note pverp dimension) + real(r8) mu_i(pverp) ! mu(i,k) at current i (note pverp dimension) + real(r8) mu_x(pverp) ! mu(i,k) at current i (note pverp dimension) + ! md_i, md_x, mu_i, mu_x are all "dry" mass fluxes + ! the mu_x/md_x are initially calculated from the incoming mu/md by applying dp/dpdry + ! the mu_i/md_i are next calculated by applying the mbsth threshold + real(r8) mu_p_eudp(pver) ! = mu_i(kp1) + eudp(k) + real(r8) netflux ! a work variable + real(r8) netsrce ! a work variable + real(r8) q_i(pver,ncnstaer) ! q(i,k,m) at current i + real(r8) qsrflx_i(ncnstaer,nsrflx) ! qsrflx(i,m,n) at current i + real(r8) rhoair_i(pver) ! air density at current i + real(r8) small ! a small number + real(r8) tmpa ! work variables + real(r8) tmpf ! work variables + real(r8) xinv_ntsub ! 1.0/ntsub + real(r8) wup(pver) ! working updraft velocity (m/s) + real(r8) conu2(pcols,pver,2,ncnstaer) + real(r8) dcondt2(pcols,pver,2,ncnstaer) + + !Fractional area of ensemble mean updrafts in ZM scheme set to 0.01 + !Chosen to reproduce vertical velocities in GATEIII GIGALES (Khairoutdinov etal 2009, JAMES) + real(r8), parameter :: zm_areafrac = 0.01_r8 + +!----------------------------------------------------------------------- +! + iconvtype = -1 + iflux_method = -1 + + if (convtype == 'deep') then + iconvtype = 1 + iflux_method = 1 + else if (convtype == 'uwsh') then + iconvtype = 2 + iflux_method = 2 + else + call endrun( '*** aero_convproc_tend -- convtype is not |deep| or |uwsh|' ) + end if + + nerr = 0 + nerrmax = 99 + + dcondt_resusp3d(:,:,:) = 0._r8 + + small = 1.e-36_r8 +! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s) + mbsth = 1.e-15_r8 + + qsrflx(:,:,:) = 0.0_r8 + dqdt(:,:,:) = 0.0_r8 + xx_mfup_max(:) = 0.0_r8 + xx_wcldbase(:) = 0.0_r8 + xx_kcldbase(:) = 0.0_r8 + + wup(:) = 0.0_r8 + + dcondt2 = 0.0_r8 + conu2 = 0.0_r8 + aqfrac = 0.0_r8 + +! inititialize aqfrac to 1.0 for activated aerosol species, 0.0 otherwise + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + aqfrac(2,mm) = 1.0_r8 + enddo + enddo + +! Loop ever each column that has convection +! *** i is index to gathered arrays; ideep(i) is index to "normal" chunk arrays +i_loop_main_aa: & + do i = il1g, il2g + icol = ideep(i) + + + if ( (jt(i) <= 0) .and. (mx(i) <= 0) .and. (iconvtype /= 1) ) then +! shallow conv case with jt,mx <= 0, which means there is no shallow conv +! in this column -- skip this column + cycle i_loop_main_aa + + else if ( (jt(i) < 1) .or. (mx(i) > pver) .or. (jt(i) > mx(i)) ) then +! invalid cloudtop and cloudbase indices -- skip this column + write(*,9010) 'illegal jt, mx', convtype, lchnk, icol, i, & + jt(i), mx(i) +9010 format( '*** aero_convproc_tend error -- ', a, 5x, 'convtype = ', a / & + '*** lchnk, icol, il, jt, mx = ', 5(1x,i10) ) + cycle i_loop_main_aa + + else if (jt(i) == mx(i)) then +! cloudtop = cloudbase (1 layer cloud) -- skip this column + write(*,9010) 'jt == mx', convtype, lchnk, icol, i, jt(i), mx(i) + cycle i_loop_main_aa + + end if + + +! +! cloudtop and cloudbase indices are valid so proceed with calculations +! + +! Load dp_i and cldfrac_i, and calc rhoair_i + do k = 1, pver + dp_i(k) = dpdry(i,k) + cldfrac_i(k) = cldfrac(icol,k) + rhoair_i(k) = pmid(icol,k)/(rair*t(icol,k)) + end do + +! Calc dry mass fluxes +! This is approximate because the updraft air is has different temp and qv than +! the grid mean, but the whole convective parameterization is highly approximate + mu_x(:) = 0.0_r8 + md_x(:) = 0.0_r8 +! (eu-du) = d(mu)/dp -- integrate upwards, multiplying by dpdry + do k = pver, 1, -1 + mu_x(k) = mu_x(k+1) + (eu(i,k)-du(i,k))*dp_i(k) + xx_mfup_max(icol) = max( xx_mfup_max(icol), mu_x(k) ) + end do +! (ed) = d(md)/dp -- integrate downwards, multiplying by dpdry + do k = 2, pver + md_x(k) = md_x(k-1) - ed(i,k-1)*dp_i(k-1) + end do + +! Load mass fluxes over cloud layers +! (Note - use of arrays dimensioned k=1,pver+1 simplifies later coding) +! Zero out values below threshold +! Zero out values at "top of cloudtop", "base of cloudbase" + ktop = jt(i) + kbot = mx(i) +! usually the updraft ( & downdraft) start ( & end ) at kbot=pver, but sometimes kbot < pver +! transport, activation, resuspension, and wet removal only occur between kbot >= k >= ktop +! resuspension from evaporating precip can occur at k > kbot when kbot < pver + kbot_prevap = pver + mu_i(:) = 0.0_r8 + md_i(:) = 0.0_r8 + do k = ktop+1, kbot + mu_i(k) = mu_x(k) + if (mu_i(k) <= mbsth) mu_i(k) = 0.0_r8 + md_i(k) = md_x(k) + if (md_i(k) >= -mbsth) md_i(k) = 0.0_r8 + end do + mu_i(ktop) = 0.0_r8 + md_i(ktop) = 0.0_r8 + mu_i(kbot+1) = 0.0_r8 + md_i(kbot+1) = 0.0_r8 + +! Compute updraft and downdraft "entrainment*dp" from eu and ed +! Compute "detrainment*dp" from mass conservation + eudp(:) = 0.0_r8 + dudp(:) = 0.0_r8 + eddp(:) = 0.0_r8 + dddp(:) = 0.0_r8 + courantmax = 0.0_r8 + do k = ktop, kbot + if ((mu_i(k) > 0) .or. (mu_i(k+1) > 0)) then + if (du(i,k) <= 0.0_r8) then + eudp(k) = mu_i(k) - mu_i(k+1) + else + eudp(k) = max( eu(i,k)*dp_i(k), 0.0_r8 ) + dudp(k) = (mu_i(k+1) + eudp(k)) - mu_i(k) + if (dudp(k) < 1.0e-12_r8*eudp(k)) then + eudp(k) = mu_i(k) - mu_i(k+1) + dudp(k) = 0.0_r8 + end if + end if + end if + if ((md_i(k) < 0) .or. (md_i(k+1) < 0)) then + eddp(k) = max( ed(i,k)*dp_i(k), 0.0_r8 ) + dddp(k) = (md_i(k+1) + eddp(k)) - md_i(k) + if (dddp(k) < 1.0e-12_r8*eddp(k)) then + eddp(k) = md_i(k) - md_i(k+1) + dddp(k) = 0.0_r8 + end if + end if + courantmax = max( courantmax, ( mu_i(k+1)+eudp(k)-md_i(k)+eddp(k) )*dt/dp_i(k) ) + end do ! k + +! number of time substeps needed to maintain "courant number" <= 1 + ntsub = 1 + if (courantmax > (1.0_r8 + 1.0e-6_r8)) then + ntsub = 1 + int( courantmax ) + end if + xinv_ntsub = 1.0_r8/ntsub + dtsub = dt*xinv_ntsub + courantmax = courantmax*xinv_ntsub + +! load tracer mixing ratio array, which will be updated at the end of each jtsub interation + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + q_i(1:pver,mm) = q(icol,1:pver,mm) + conu2(icol,1:pver,1,mm) = q(icol,1:pver,mm) + end do + 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) + npass_calc_updraft = 1 + if ( (method_reduce_actfrac == 2) .and. & + (factor_reduce_actfrac >= 0.0_r8) .and. & + (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2 + + +jtsub_loop_main_aa: & + do jtsub = 1, ntsub + + +ipass_calc_updraft_loop: & + do ipass_calc_updraft = 1, npass_calc_updraft + + qsrflx_i(:,:) = 0.0_r8 + dqdt_i(:,:) = 0.0_r8 + + const = 0.0_r8 ! zero cloud-phase species + chat = 0.0_r8 ! zero cloud-phase species + conu = 0.0_r8 + cond = 0.0_r8 + + dcondt = 0.0_r8 + dcondt_resusp = 0.0_r8 + dcondt_wetdep = 0.0_r8 + dcondt_prevap = 0.0_r8 + dconudt_aqchem = 0.0_r8 + dconudt_wetdep = 0.0_r8 + +! only initialize the activation tendency on ipass=1 + if (ipass_calc_updraft == 1) dconudt_activa = 0.0_r8 + + ! initialize mixing ratio arrays (chat, const, conu, cond) + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + const(1,mm,:) = q_i(:,mm) + + ! From now on work only with gathered data + ! Interpolate environment tracer values to interfaces + do k = 1,pver + km1 = max(1,k-1) + minc = min(const(1,mm,km1),const(1,mm,k)) + maxc = max(const(1,mm,km1),const(1,mm,k)) + if (minc < 0) then + cdifr = 0._r8 + else + cdifr = abs(const(1,mm,k)-const(1,mm,km1))/max(maxc,small) + endif + + ! If the two layers differ significantly use a geometric averaging procedure + ! But only do that for deep convection. For shallow, use the simple + ! averaging which is used in subr cmfmca + if (iconvtype /= 1) then + chat(1,mm,k) = 0.5_r8* (const(1,mm,k)+const(1,mm,km1)) + else if (cdifr > 1.E-6_r8) then + cabv = max(const(1,mm,km1),maxc*1.e-12_r8) + cbel = max(const(1,mm,k),maxc*1.e-12_r8) + chat(1,mm,k) = log(cabv/cbel)/(cabv-cbel)*cabv*cbel + else ! Small diff, so just arithmetic mean + chat(1,mm,k) = 0.5_r8* (const(1,mm,k)+const(1,mm,km1)) + end if + + ! Set provisional up and down draft values, and tendencies + conu(1,mm,k) = chat(1,mm,k) + cond(1,mm,k) = chat(1,mm,k) + end do ! k + + ! Values at surface inferface == values in lowest layer + chat(1,mm,pver+1) = const(1,mm,pver) + conu(1,mm,pver+1) = const(1,mm,pver) + cond(1,mm,pver+1) = const(1,mm,pver) + end do ! l + end do ! m + + + +! Compute updraft mixing ratios from cloudbase to cloudtop +! No special treatment is needed at k=pver because arrays +! are dimensioned 1:pver+1 +! A time-split approach is used. First, entrainment is applied to produce +! an initial conu(m,k) from conu(m,k+1). Next, chemistry/physics are +! applied to the initial conu(m,k) to produce a final conu(m,k). +! Detrainment from the updraft uses this final conu(m,k). +! Note that different time-split approaches would give somewhat different +! results + kactcnt = 0 ; kactcntb = 0 ; kactfirst = 1 +k_loop_main_bb: & + do k = kbot, ktop, -1 + kp1 = k+1 + +! cldfrac = conv cloud fractional area. This could represent anvil cirrus area, +! and may not useful for aqueous chem and wet removal calculations + cldfrac_i(k) = max( cldfrac_i(k), 0.005_r8 ) +! mu_p_eudp(k) = updraft massflux at k, without detrainment between kp1,k + mu_p_eudp(k) = mu_i(kp1) + eudp(k) + + fa_u(k) = 0.0_r8 !BSINGH(10/15/2014): Initialized so that it has a value if the following "if" check yeilds .false. + if (mu_p_eudp(k) > mbsth) then +! if (mu_p_eudp(k) <= mbsth) the updraft mass flux is negligible at base and top +! of current layer, +! so current layer is a "gap" between two unconnected updrafts, +! so essentially skip all the updraft calculations for this layer + +! First apply changes from entrainment + f_ent = eudp(k)/mu_p_eudp(k) + f_ent = max( 0.0_r8, min( 1.0_r8, f_ent ) ) + tmpa = 1.0_r8 - f_ent + do n = 1,2 ! phase + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + conu(n,mm,k) = tmpa*conu(n,mm,kp1) + f_ent*const(n,mm,k) + end do + end do + end do + +! estimate updraft velocity (wup) + if (iconvtype /= 1) then +! shallow - wup = (mup in kg/m2/s) / [rhoair * (updraft area)] + wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & + / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) + else +! deep - as in shallow, but assumed constant updraft_area with height zm_areafrac + wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & + / (rhoair_i(k) * zm_areafrac) + end if + +! 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)) + + +! Now apply transformation and removal changes +! Skip levels where icwmr(icol,k) <= clw_cut (= 1.0e-6) to eliminate +! occasional very small icwmr values from the ZM module + clw_cut = 1.0e-6_r8 + + + if (convproc_method_activate <= 1) then +! aerosol activation - method 1 +! skip levels that are completely glaciated (fracice(icol,k) == 1.0) +! when kactcnt=1 (first/lowest layer with cloud water) apply +! activatation to the entire updraft +! when kactcnt>1 apply activatation to the amount entrained at this level + if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0_r8)) then + kactcnt = kactcnt + 1 + + if ((kactcnt == 1) .or. (f_ent > 0.0_r8)) then + kactcntb = kactcntb + 1 + end if + + if (kactcnt == 1) then + ! diagnostic fields + ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac + xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & + / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) + xx_kcldbase(icol) = k + + kactfirst = k + tmpa = 1.0_r8 + call activate_convproc( aero_props, & + conu(:,:,k), dconudt_activa(:,:,k), conu(:,:,k), & + tmpa, dt_u(k), wup(k), & + t(icol,k), rhoair_i(k), ipass_calc_updraft ) + else if (f_ent > 0.0_r8) then + ! current layer is above cloud base (=first layer with activation) + ! only allow activation at k = kactfirst thru kactfirst-(method1_activate_nlayers-1) + if (k >= kactfirst-(method1_activate_nlayers-1)) then + call activate_convproc( aero_props, & + conu(:,:,k), dconudt_activa(:,:,k), const(:,:,k), & + f_ent, dt_u(k), wup(k), & + t(icol,k), rhoair_i(k), ipass_calc_updraft ) + end if + end if +! the following was for cam2 shallow convection (hack), +! but is not appropriate for cam5 (uwshcu) +! else if ((kactcnt > 0) .and. (iconvtype /= 1)) then +! ! for shallow conv, when you move from activation occuring to +! ! not occuring, reset kactcnt=0, because the hack scheme can +! ! produce multiple "1.5 layer clouds" separated by clear air +! kactcnt = 0 +! end if + end if ! ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then + + else ! (convproc_method_activate >= 2) +! aerosol activation - method 2 +! skip levels that are completely glaciated (fracice(icol,k) == 1.0) +! when kactcnt=1 (first/lowest layer with cloud water) +! apply "primary" activatation to the entire updraft +! when kactcnt>1 +! apply secondary activatation to the entire updraft +! do this for all levels above cloud base (even if completely glaciated) +! (this is something for sensitivity testing) + do_act_this_lev = .false. + if (kactcnt <= 0) then + if (icwmr(icol,k) > clw_cut) then + do_act_this_lev = .true. + kactcnt = 1 + kactfirst = k + ! diagnostic fields + ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac + xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & + / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) + xx_kcldbase(icol) = k + end if + else +! if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then + do_act_this_lev = .true. + kactcnt = kactcnt + 1 +! end if + end if + + if ( do_act_this_lev ) then + kactcntb = kactcntb + 1 + + call activate_convproc_method2( aero_props, & + conu(:,:,k), dconudt_activa(:,:,k), & + f_ent, dt_u(k), wup(k), & + t(icol,k), rhoair_i(k), k, & + kactfirst, ipass_calc_updraft ) + + end if + conu2(icol,k,:,:) = conu(:,:,k) + + end if ! (convproc_method_activate <= 1) + +! aqueous chemistry +! do glaciated levels as aqchem_conv will eventually do acid vapor uptake +! to ice, and aqchem_conv module checks fracice before doing liquid wtr stuff +! if (icwmr(icol,k) > clw_cut) then +! call aqchem_conv( conu(1,k), dconudt_aqchem(1,k), aqfrac, & +! t(icol,k), fracice(icol,k), icwmr(icol,k), rhoair_i(k), & +! lh2o2(icol,k), lo3(icol,k), dt_u(k) ) +! end if + +! wet removal +! +! mirage2 +! rprd = precip formation as a grid-cell average (kgW/kgA/s) +! icwmr = cloud water MR within updraft area (kgW/kgA) +! fupdr = updraft fractional area (--) +! A = rprd/fupdr = precip formation rate within updraft area (kgW/kgA/s) +! B = A/icwmr = rprd/(icwmr*fupdr) +! = first-order removal rate (1/s) +! C = dp/(mup/fupdr) = updraft air residence time in the layer (s) +! +! fraction removed = (1.0 - exp(-cdt)) where +! cdt = B*C = (dp/mup)*rprd/icwmr +! +! Note1: fupdr cancels out in cdt, so need not be specified +! Note2: dp & mup units need only be consistent (e.g., mb & mb/s) +! Note3: for shallow conv, cdt = 1-beta (beta defined in Hack scheme) +! Note4: the "dp" in C above and code below should be the moist dp +! +! cam5 +! clw_preloss = cloud water MR before loss to precip +! = icwmr + dt*(rprd/fupdr) +! B = A/clw_preloss = (rprd/fupdr)/(icwmr + dt*rprd/fupdr) +! = rprd/(fupdr*icwmr + dt*rprd) +! = first-order removal rate (1/s) +! +! fraction removed = (1.0 - exp(-cdt)) where +! cdt = B*C = (fupdr*dp/mup)*[rprd/(fupdr*icwmr + dt*rprd)] +! +! Note1: *** cdt is now sensitive to fupdr, which we do not really know, +! and is not the same as the convective cloud fraction +! Note2: dt is appropriate in the above cdt expression, not dtsub +! +! Apply wet removal at levels where +! icwmr(icol,k) > clw_cut AND rprd(icol,k) > 0.0 +! as wet removal occurs in both liquid and ice clouds +! + cdt(k) = 0.0_r8 + if ((icwmr(icol,k) > clw_cut) .and. (rprd(icol,k) > 0.0_r8)) then +! if (iconvtype == 1) then + tmpf = 0.5_r8*cldfrac_i(k) + cdt(k) = (tmpf*dp(i,k)/mu_p_eudp(k)) * rprd(icol,k) / & + (tmpf*icwmr(icol,k) + dt*rprd(icol,k)) +! else if (k < pver) then +! if (eudp(k+1) > 0) cdt(k) = & +! rprd(icol,k)*dp(i,k)/(icwmr(icol,k)*eudp(k+1)) +! end if + end if + if (cdt(k) > 0.0_r8) then + expcdtm1 = exp(-cdt(k)) - 1.0_r8 + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + do n = 1,2 + dconudt_wetdep(n,mm,k) = conu(n,mm,k)*aqfrac(n,mm)*expcdtm1 + conu(n,mm,k) = conu(n,mm,k) + dconudt_wetdep(n,mm,k) + dconudt_wetdep(n,mm,k) = dconudt_wetdep(n,mm,k) / dt_u(k) + conu2(icol,k,n,mm) = conu(n,mm,k) + enddo + enddo + enddo + + end if + + end if ! "(mu_p_eudp(k) > mbsth)" + end do k_loop_main_bb ! "k = kbot, ktop, -1" + +! when doing updraft calcs twice, only need to go this far on the first pass + if ( (ipass_calc_updraft == 1) .and. & + (npass_calc_updraft == 2) ) cycle ipass_calc_updraft_loop + + +! Compute downdraft mixing ratios from cloudtop to cloudbase +! No special treatment is needed at k=2 +! No transformation or removal is applied in the downdraft + do k = ktop, kbot + kp1 = k + 1 +! md_m_eddp = downdraft massflux at kp1, without detrainment between k,kp1 + md_m_eddp = md_i(k) - eddp(k) + if (md_m_eddp < -mbsth) then + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + do n = 1,2 + cond(n,mm,kp1) = ( md_i(k)*cond(n,mm,k) & + - eddp(k)*const(n,mm,k) ) / md_m_eddp + end do + end do + end do + end if + end do ! k + + +! Now computes fluxes and tendencies +! NOTE: The approach used in convtran applies to inert tracers and +! must be modified to include source and sink terms + sumflux = 0.0_r8 + sumflux2 = 0.0_r8 + sumsrce = 0.0_r8 + sumchng = 0.0_r8 + sumchng3 = 0.0_r8 + sumwetdep = 0.0_r8 + sumprevap = 0.0_r8 + + maxflux = 0.0_r8 + maxflux2 = 0.0_r8 + maxresusp = 0.0_r8 + maxsrce = 0.0_r8 + maxprevap = 0.0_r8 + +k_loop_main_cc: & + do k = ktop, kbot + kp1 = k+1 + km1 = k-1 + kp1x = min( kp1, pver ) + km1x = max( km1, 1 ) + fa_u_dp = fa_u(k)*dp_i(k) + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + do n = 1,2 + + ! First compute fluxes using environment subsidence/lifting and + ! entrainment/detrainment into up/downdrafts, + ! to provide an additional mass balance check + ! (this could be deleted after the code is well tested) + fluxin = mu_i(k)*min(chat(n,mm,k),const(n,mm,km1x)) & + - md_i(kp1)*min(chat(n,mm,kp1),const(n,mm,kp1x)) & + + dudp(k)*conu(n,mm,k) + dddp(k)*cond(n,mm,kp1) + fluxout = mu_i(kp1)*min(chat(n,mm,kp1),const(n,mm,k)) & + - md_i(k)*min(chat(n,mm,k),const(n,mm,k)) & + + (eudp(k) + eddp(k))*const(n,mm,k) + + netflux = fluxin - fluxout + + sumflux2(n,mm) = sumflux2(n,mm) + netflux + maxflux2(n,mm) = max( maxflux2(n,mm), abs(fluxin), abs(fluxout) ) + + ! Now compute fluxes as in convtran, and also source/sink terms + ! (version 3 limit fluxes outside convection to mass in appropriate layer + ! (these limiters are probably only safe for positive definite quantitities + ! (it assumes that mu and md already satify a courant number limit of 1) + if (iflux_method /= 2) then + fluxin = mu_i(kp1)*conu(n,mm,kp1) & + + mu_i(k )*min(chat(n,mm,k ),const(n,mm,km1x)) & + - ( md_i(k )*cond(n,mm,k) & + + md_i(kp1)*min(chat(n,mm,kp1),const(n,mm,kp1x)) ) + fluxout = mu_i(k )*conu(n,mm,k) & + + mu_i(kp1)*min(chat(n,mm,kp1),const(n,mm,k )) & + - ( md_i(kp1)*cond(n,mm,kp1) & + + md_i(k )*min(chat(n,mm,k ),const(n,mm,k )) ) + else + fluxin = mu_i(kp1)*conu(n,mm,kp1) & + - ( md_i(k )*cond(n,mm,k) ) + fluxout = mu_i(k )*conu(n,mm,k) & + - ( md_i(kp1)*cond(n,mm,kp1) ) + + ! new method -- simple upstream method for the env subsidence + ! tmpa = net env mass flux (positive up) at top of layer k + tmpa = -( mu_i(k ) + md_i(k ) ) + if (tmpa <= 0.0_r8) then + fluxin = fluxin - tmpa*const(n,mm,km1x) + else + fluxout = fluxout + tmpa*const(n,mm,k ) + end if + ! tmpa = net env mass flux (positive up) at base of layer k + tmpa = -( mu_i(kp1) + md_i(kp1) ) + if (tmpa >= 0.0_r8) then + fluxin = fluxin + tmpa*const(n,mm,kp1x) + else + fluxout = fluxout - tmpa*const(n,mm,k ) + end if + end if + + netflux = fluxin - fluxout + netsrce = fa_u_dp*(dconudt_aqchem(n,mm,k) + & + dconudt_activa(n,mm,k) + dconudt_wetdep(n,mm,k)) + dcondt(n,mm,k) = (netflux+netsrce)/dp_i(k) + + dcondt_wetdep(n,mm,k) = fa_u_dp*dconudt_wetdep(n,mm,k)/dp_i(k) + sumwetdep(n,mm) = sumwetdep(n,mm) + fa_u_dp*dconudt_wetdep(n,mm,k) + + dcondt2(icol,k,n,mm) = dcondt(n,mm,k) + + end do + end do + + end do + end do k_loop_main_cc ! "k = ktop, kbot" + +! calculate effects of precipitation evaporation + call precpevap_convproc( aero_props, dcondt, dcondt_wetdep, dcondt_prevap, & + rprd, evapc, dp_i, & + icol, ktop ) + +! make adjustments to dcondt for activated & unactivated aerosol species +! pairs to account any (or total) resuspension of convective-cloudborne aerosol + call resuspend_convproc( aero_props, dcondt, dcondt_resusp, ktop, kbot_prevap ) + + ! Do resuspension of aerosols from rain only when the rain has + ! totally evaporated. + if (convproc_do_evaprain_atonce) then + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + dcondt_resusp3d(mm,icol,:) = dcondt_resusp(2,mm,:) + end do + end do + + dcondt_resusp(2,:,:) = 0._r8 + end if + +! calculate new column-tendency variables + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + do n = 1,2 + do k = ktop, kbot_prevap + sumprevap(n,mm) = sumprevap(n,mm) + dcondt_prevap(n,mm,k)*dp_i(k) + end do + end do + end do + end do + +! +! note again the aero_convproc_tend does not apply convective cloud processing +! to the stratiform-cloudborne aerosol +! within this routine, cloudborne aerosols are convective-cloudborne +! +! before tendencies (dcondt, which is loaded into dqdt) are returned, +! the convective-cloudborne aerosol tendencies must be combined +! with the interstitial tendencies +! resuspend_convproc has already done this for the dcondt +! +! the individual process column tendencies (sumwetdep, sumprevap, ...) +! are just diagnostic fields that can be written to history +! tendencies for interstitial and convective-cloudborne aerosol could +! both be passed back and output, if desired +! currently, however, the interstitial and convective-cloudborne tendencies +! are combined (in the next code block) before being passed back (in qsrflx) +! + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + sumwetdep(1,mm) = sumwetdep(1,mm) + sumwetdep(2,mm) + sumprevap(1,mm) = sumprevap(1,mm) + sumprevap(2,mm) + enddo + enddo + +! +! scatter overall tendency back to full array +! + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + ndx = aer_cnst_ndx(mm) + do k = ktop, kbot_prevap + dqdt_i(k,mm) = dcondt(1,mm,k) + dqdt(icol,k,mm) = dqdt(icol,k,mm) + dqdt_i(k,mm)*xinv_ntsub + end do + + end do + end do ! m + +! scatter column burden tendencies for various processes to qsrflx + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + qsrflx_i(mm,4) = sumwetdep(1,mm)*hund_ovr_g + qsrflx_i(mm,5) = sumprevap(1,mm)*hund_ovr_g + qsrflx(icol,mm,1:5) = qsrflx(icol,mm,1:5) + qsrflx_i(mm,1:5)*xinv_ntsub + end do + end do + + if (jtsub < ntsub) then + ! update the q_i for the next interation of the jtsub loop + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + ndx = aer_cnst_ndx(mm) + do k = ktop, kbot_prevap + q_i(k,mm) = max( (q_i(k,mm) + dqdt_i(k,mm)*dtsub), 0.0_r8 ) + end do + end do + end do + end if + + end do ipass_calc_updraft_loop + + end do jtsub_loop_main_aa ! of the main "do jtsub = 1, ntsub" loop + + + end do i_loop_main_aa ! of the main "do i = il1g, il2g" loop + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + call outfld( trim(cnst_name_extd(1,mm))//'WETC', dcondt2(:,:,1,mm), pcols, lchnk ) + call outfld( trim(cnst_name_extd(1,mm))//'CONU', conu2(:,:,1,mm), pcols, lchnk ) + call outfld( trim(cnst_name_extd(2,mm))//'WETC', dcondt2(:,:,2,mm), pcols, lchnk ) + call outfld( trim(cnst_name_extd(2,mm))//'CONU', conu2(:,:,2,mm), pcols, lchnk ) + + end do + end do + +end subroutine aero_convproc_tend + +!========================================================================================= + subroutine precpevap_convproc( aero_props, & + dcondt, dcondt_wetdep, dcondt_prevap, & + rprd, evapc, dp_i, & + icol, ktop ) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate resuspension of wet-removed aerosol species resulting +! from precip evaporation +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! arguments +! (note: TMR = tracer mixing ratio) + + class(aerosol_properties), intent(in) :: aero_props + real(r8), intent(inout) :: dcondt(2,ncnstaer,pver) + ! overall TMR tendency from convection + real(r8), intent(in) :: dcondt_wetdep(2,ncnstaer,pver) + ! portion of TMR tendency due to wet removal + real(r8), intent(inout) :: dcondt_prevap(2,ncnstaer,pver) + ! portion of TMR tendency due to precip evaporation + ! (actually, due to the adjustments made here) + ! (on entry, this is 0.0) + + real(r8), intent(in) :: rprd(pcols,pver) ! conv precip production rate (gathered) + real(r8), intent(in) :: evapc(pcols,pver) ! conv precip evaporation rate (gathered) + real(r8), intent(in) :: dp_i(pver) ! pressure thickness of level (in mb) + + integer, intent(in) :: icol ! normal (ungathered) i index for current column + integer, intent(in) :: ktop ! index of top cloud level for current column + +!----------------------------------------------------------------------- +! local variables + integer :: k, l, m, mm, n + real(r8) :: del_pr_flux_prod ! change to precip flux from production [(kg/kg/s)*mb] + real(r8) :: del_pr_flux_evap ! change to precip flux from evaporation [(kg/kg/s)*mb] + real(r8) :: del_wd_flux_evap ! change to wet deposition flux from evaporation [(kg/kg/s)*mb] + real(r8) :: fdel_pr_flux_evap ! fractional change to precip flux from evaporation + real(r8) :: pr_flux ! precip flux at base of current layer [(kg/kg/s)*mb] + real(r8) :: pr_flux_old + real(r8) :: tmpdp ! delta-pressure (mb) + real(r8) :: wd_flux(2,ncnstaer) ! tracer wet deposition flux at base of current layer [(kg/kg/s)*mb] +!----------------------------------------------------------------------- + + pr_flux = 0.0_r8 + wd_flux = 0.0_r8 + + do k = ktop, pver + tmpdp = dp_i(k) + + pr_flux_old = pr_flux + del_pr_flux_prod = tmpdp*max(0.0_r8, rprd(icol,k)) + pr_flux = pr_flux_old + del_pr_flux_prod + + del_pr_flux_evap = min( pr_flux, tmpdp*max(0.0_r8, evapc(icol,k)) ) + + ! Do resuspension of aerosols from rain only when the rain has + ! totally evaporated in one layer. + if (convproc_do_evaprain_atonce .and. & + (del_pr_flux_evap.ne.pr_flux)) del_pr_flux_evap = 0._r8 + + fdel_pr_flux_evap = del_pr_flux_evap / max(pr_flux, 1.0e-35_r8) + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + do n = 1,2 + + ! use -dcondt_wetdep(m,k) as it is negative (or zero) + wd_flux(n,mm) = wd_flux(n,mm) + tmpdp*max(0.0_r8, -dcondt_wetdep(n,mm,k)) + del_wd_flux_evap = wd_flux(n,mm)*fdel_pr_flux_evap + + dcondt_prevap(n,mm,k) = del_wd_flux_evap/tmpdp + + end do + end do + end do + + ! resuspension --> create larger aerosols + if (convproc_do_evaprain_atonce) then + call aero_props%resuspension_resize( dcondt_prevap(1,:,k) ) + endif + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + do n = 1,2 + dcondt(n,mm,k) = dcondt(n,mm,k) + dcondt_prevap(n,mm,k) + end do + end do + end do + + pr_flux = max( 0.0_r8, pr_flux-del_pr_flux_evap ) + + end do ! k + + end subroutine precpevap_convproc + +!========================================================================================= + subroutine activate_convproc( aero_props, & + conu, dconudt, conent, & + f_ent, dt_u, wup, & + tair, rhoair, ipass_calc_updraft ) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate activation of aerosol species in convective updraft +! for a single column and level +! +! Method: +! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface +! conent(l) = TMR of air that is entrained into the updraft from level k +! f_ent = Fraction of the "before-detrainment" updraft massflux at +! k/k-1 interface" resulting from entrainment of level k air +! (where k is the current level in subr aero_convproc_tend) +! +! On entry to this routine, the conu(l) represents the updraft TMR +! after entrainment, but before chemistry/physics and detrainment, +! and is equal to +! conu(l) = f_ent*conent(l) + (1.0-f_ent)*conu_below(l) +! where +! conu_below(l) = updraft TMR at the k+1/k interface, and +! f_ent = (eudp/mu_p_eudp) is the fraction of the updraft massflux +! from level k entrainment +! +! This routine applies aerosol activation to the entrained tracer, +! then adjusts the conu so that on exit, +! conu(la) = conu_incoming(la) - f_ent*conent(la)*f_act(la) +! conu(lc) = conu_incoming(lc) + f_ent*conent(la)*f_act(la) +! where +! la, lc = indices for an unactivated/activated aerosol component pair +! f_act = fraction of conent(la) that is activated. The f_act are +! calculated with the Razzak-Ghan activation parameterization. +! The f_act differ for each mode, and for number/surface/mass. +! +! Note: At the lowest layer with cloud water, subr convproc calls this +! routine with conent==conu and f_ent==1.0, with the result that +! activation is applied to the entire updraft tracer flux +! +! *** The updraft velocity used for activation calculations is rather +! uncertain and needs more work. However, an updraft of 1-3 m/s +! will activate essentially all of accumulation and coarse mode particles. +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + use ndrop, only: activate_aerosol + +!----------------------------------------------------------------------- +! arguments (note: TMR = tracer mixing ratio) + + class(aerosol_properties), intent(in) :: aero_props + + ! conu = tracer mixing ratios in updraft at top of this (current) level + ! The conu are changed by activation + real(r8), intent(inout) :: conu(2,ncnstaer) + ! conent = TMRs in the entrained air at this level + real(r8), intent(in) :: conent(2,ncnstaer) + real(r8), intent(inout) :: dconudt(2,ncnstaer) ! TMR tendencies due to activation + + real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was + ! entrained across this layer == eudp/mu_p_eudp + real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the + ! updraft at current level + real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s) + ! at current level updraft + + real(r8), intent(in) :: tair ! Temperature in Kelvin + real(r8), intent(in) :: rhoair ! air density (kg/m3) + + integer, intent(in) :: ipass_calc_updraft + +!----------------------------------------------------------------------- +! local variables + integer :: l, m, mm + + real(r8) :: delact ! working variable + real(r8) :: dt_u_inv ! 1.0/dt_u + real(r8) :: fluxm(nbins) ! to understand this, see subr activate_aerosol + real(r8) :: fluxn(nbins) ! to understand this, see subr activate_aerosol + real(r8) :: flux_fullact ! to understand this, see subr activate_aerosol + real(r8) :: fm(nbins) ! mass fraction of aerosols activated + real(r8) :: fn(nbins) ! number fraction of aerosols activated + real(r8) :: hygro(nbins) ! current hygroscopicity for int+act + real(r8) :: naerosol(nbins) ! interstitial+activated number conc (#/m3) + real(r8) :: sigw ! standard deviation of updraft velocity (cm/s) + real(r8) :: tmp_fact ! working variable + real(r8) :: vaerosol(nbins) ! int+act volume (m3/m3) + real(r8) :: wbar ! mean updraft velocity (cm/s) + real(r8) :: wdiab ! diabatic vertical velocity (cm/s) + real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s) + + real(r8) :: spec_hygro + real(r8) :: spec_dens + character(len=32) :: spec_type + + real(r8) :: tmpa, tmpb, tmpc ! working variable + real(r8) :: naerosol_a(1) ! number conc (1/m3) + real(r8) :: vaerosol_a(1) ! volume conc (m3/m3) + +!----------------------------------------------------------------------- + +! when ipass_calc_updraft == 2, apply the activation tendencies +! from pass 1, but multiplied by factor_reduce_actfrac +! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2) + if (ipass_calc_updraft == 2) then + + dt_u_inv = 1.0_r8/dt_u + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + delact = dconudt(2,mm)*dt_u * factor_reduce_actfrac + delact = min( delact, conu(1,mm) ) + delact = max( delact, 0.0_r8 ) + conu(1,mm) = conu(1,mm) - delact + conu(2,mm) = conu(2,mm) + delact + dconudt(1,mm) = -delact*dt_u_inv + dconudt(2,mm) = delact*dt_u_inv + + end do + end do + + return + + end if ! (ipass_calc_updraft == 2) + +! check f_ent > 0 + if (f_ent <= 0.0_r8) return + + hygro = 0.0_r8 + vaerosol = 0.0_r8 + naerosol = 0.0_r8 + + do m = 1, nbins +! compute a (or a+cw) volume and hygroscopicity + tmpa = 0.0_r8 + tmpb = 0.0_r8 + do l = 1, aero_props%nmasses(m) + + mm = aero_props%indexer(m,l) + + call aero_props%get(m, l, spectype=spec_type, density=spec_dens, hygro=spec_hygro) + + tmpc = max( conent(1,mm), 0.0_r8 ) + if ( use_cwaer_for_activate_maxsat ) & + tmpc = tmpc + max( conent(2,mm), 0.0_r8 ) + tmpc = tmpc / spec_dens + tmpa = tmpa + tmpc + tmpb = tmpb + tmpc * spec_hygro + end do + vaerosol(m) = tmpa * rhoair + if (tmpa < 1.0e-35_r8) then + hygro(m) = 0.2_r8 + else + hygro(m) = tmpb/tmpa + end if + +! load a (or a+cw) number and bound it + tmpa = max( conent(1,mm), 0.0_r8 ) + if ( use_cwaer_for_activate_maxsat ) & + tmpa = tmpa + max( conent(2,mm), 0.0_r8 ) + naerosol(m) = tmpa * rhoair + + naerosol_a(1) = naerosol(m) + vaerosol_a(1) = vaerosol(m) + + call aero_props%apply_number_limits( naerosol_a, vaerosol_a, 1, 1, m ) + + naerosol(m) = naerosol_a(1) + end do + +! call Razzak-Ghan activation routine with single updraft + wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now + sigw = 0.0_r8 + wdiab = 0.0_r8 + wminf = wbar + wmaxf = wbar + + call activate_aerosol( & + wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + naerosol, nbins, vaerosol, hygro, aero_props, & + fn, fm, fluxn, fluxm, flux_fullact ) + +! apply the activation fractions to the updraft aerosol mixing ratios + dt_u_inv = 1.0_r8/dt_u + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + if ( (method_reduce_actfrac == 1) .and. & + (factor_reduce_actfrac >= 0.0_r8) .and. & + (factor_reduce_actfrac < 1.0_r8) ) & + tmp_fact = tmp_fact * factor_reduce_actfrac + + delact = min( conent(1,mm)*tmp_fact*f_ent, conu(1,mm) ) + delact = max( delact, 0.0_r8 ) + conu(1,mm) = conu(1,mm) - delact + conu(2,mm) = conu(2,mm) + delact + dconudt(1,mm) = -delact*dt_u_inv + dconudt(2,mm) = delact*dt_u_inv + end do + end do + + end subroutine activate_convproc + +!========================================================================================= + subroutine activate_convproc_method2( aero_props, & + conu, dconudt, & + f_ent, dt_u, wup, & + tair, rhoair, k, & + kactfirst, ipass_calc_updraft ) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate activation of aerosol species in convective updraft +! for a single column and level +! +! Method: +! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface +! f_ent = Fraction of the "before-detrainment" updraft massflux at +! k/k-1 interface" resulting from entrainment of level k air +! (where k is the current level in subr aero_convproc_tend) +! +! On entry to this routine, the conu(l) represents the updraft TMR +! after entrainment, but before chemistry/physics and detrainment. +! +! This routine applies aerosol activation to the conu tracer mixing ratios, +! then adjusts the conu so that on exit, +! conu(la) = conu_incoming(la) - conu(la)*f_act(la) +! conu(lc) = conu_incoming(lc) + conu(la)*f_act(la) +! where +! la, lc = indices for an unactivated/activated aerosol component pair +! f_act = fraction of conu(la) that is activated. The f_act are +! calculated with the Razzak-Ghan activation parameterization. +! The f_act differ for each mode, and for number/surface/mass. +! +! At cloud base (k==kactfirst), primary activation is done using the +! "standard" code in subr activate do diagnose maximum supersaturation. +! Above cloud base, secondary activation is done using a +! prescribed supersaturation. +! +! *** The updraft velocity used for activation calculations is rather +! uncertain and needs more work. However, an updraft of 1-3 m/s +! will activate essentially all of accumulation and coarse mode particles. +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + use ndrop, only: activate_aerosol + +!----------------------------------------------------------------------- +! arguments (note: TMR = tracer mixing ratio) + + class(aerosol_properties), intent(in) :: aero_props + + ! conu = tracer mixing ratios in updraft at top of this (current) level + ! The conu are changed by activation + real(r8), intent(inout) :: conu(2,ncnstaer) + real(r8), intent(inout) :: dconudt(2,ncnstaer) ! TMR tendencies due to activation + + real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was + ! entrained across this layer == eudp/mu_p_eudp + real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the + ! updraft at current level + real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s) + ! at current level updraft + + real(r8), intent(in) :: tair ! Temperature in Kelvin + real(r8), intent(in) :: rhoair ! air density (kg/m3) + ! used as in-cloud wet removal rate + integer, intent(in) :: k ! level index + integer, intent(in) :: kactfirst ! k at cloud base + integer, intent(in) :: ipass_calc_updraft + +!----------------------------------------------------------------------- +! local variables + integer :: l, m, mm + + real(r8) :: delact ! working variable + real(r8) :: dt_u_inv ! 1.0/dt_u + real(r8) :: fluxm(nbins) ! to understand this, see subr activate_aerosol + real(r8) :: fluxn(nbins) ! to understand this, see subr activate_aerosol + real(r8) :: flux_fullact ! to understand this, see subr activate_aerosol + real(r8) :: fm(nbins) ! mass fraction of aerosols activated + real(r8) :: fn(nbins) ! number fraction of aerosols activated + real(r8) :: hygro(nbins) ! current hygroscopicity for int+act + real(r8) :: naerosol(nbins) ! interstitial+activated number conc (#/m3) + real(r8) :: sigw ! standard deviation of updraft velocity (cm/s) + real(r8) :: smax_prescribed ! prescribed supersaturation for secondary activation (0-1 fraction) + real(r8) :: tmp_fact ! working variable + real(r8) :: vaerosol(nbins) ! int+act volume (m3/m3) + real(r8) :: wbar ! mean updraft velocity (cm/s) + real(r8) :: wdiab ! diabatic vertical velocity (cm/s) + real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s) + + real(r8) :: spec_hygro + real(r8) :: spec_dens + character(len=32) :: spec_type + + real(r8) :: tmpa, tmpb, tmpc ! working variable + real(r8) :: naerosol_a(1) ! number conc (1/m3) + real(r8) :: vaerosol_a(1) ! volume conc (m3/m3) + +!----------------------------------------------------------------------- + +! when ipass_calc_updraft == 2, apply the activation tendencies +! from pass 1, but multiplied by factor_reduce_actfrac +! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2) + + if (ipass_calc_updraft == 2) then + + dt_u_inv = 1.0_r8/dt_u + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + delact = dconudt(2,mm)*dt_u * factor_reduce_actfrac + delact = min( delact, conu(1,mm) ) + delact = max( delact, 0.0_r8 ) + conu(1,mm) = conu(1,mm) - delact + conu(2,mm) = conu(2,mm) + delact + dconudt(1,mm) = -delact*dt_u_inv + dconudt(2,mm) = delact*dt_u_inv + end do + end do ! "n = 1, ntot_amode" + return + + end if ! (ipass_calc_updraft == 2) + +! check f_ent > 0 + if (f_ent <= 0.0_r8) return + + hygro = 0.0_r8 + vaerosol = 0.0_r8 + naerosol = 0.0_r8 + + do m = 1, nbins +! compute a (or a+cw) volume and hygroscopicity + tmpa = 0.0_r8 + tmpb = 0.0_r8 + do l = 1, aero_props%nspecies(m) + + mm = aero_props%indexer(m,l) + + call aero_props%get(m, l, spectype=spec_type, density=spec_dens, hygro=spec_hygro) + + tmpc = max( conu(1,mm), 0.0_r8 ) + if ( use_cwaer_for_activate_maxsat ) & + tmpc = tmpc + max( conu(2,mm), 0.0_r8 ) + tmpc = tmpc / spec_dens + tmpa = tmpa + tmpc + + ! Change the hygroscopicity of POM based on the discussion with Prof. + ! Xiaohong Liu. Some observational studies found that the primary organic + ! material from biomass burning emission shows very high hygroscopicity. + ! Also, found that BC mass will be overestimated if all the aerosols in + ! the primary mode are free to be removed. Therefore, set the hygroscopicity + ! of POM here as 0.2 to enhance the wet scavenge of primary BC and POM. + + if (spec_type=='p-organic' .and. convproc_pom_spechygro>0._r8) then + tmpb = tmpb + tmpc * convproc_pom_spechygro + else + tmpb = tmpb + tmpc * spec_hygro + end if + end do + vaerosol(m) = tmpa * rhoair + if (tmpa < 1.0e-35_r8) then + hygro(m) = 0.2_r8 + else + hygro(m) = tmpb/tmpa + end if + + mm = aero_props%indexer(m,0) + +! load a (or a+cw) number and bound it + tmpa = max( conu(1,mm), 0.0_r8 ) + if ( use_cwaer_for_activate_maxsat ) & + tmpa = tmpa + max( conu(2,mm), 0.0_r8 ) + naerosol(m) = tmpa * rhoair + + naerosol_a(1) = naerosol(m) + vaerosol_a(1) = vaerosol(m) + + call aero_props%apply_number_limits( naerosol_a, vaerosol_a, 1, 1, m ) + + naerosol(m) = naerosol_a(1) + + end do + +! call Razzak-Ghan activation routine with single updraft + wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now + sigw = 0.0_r8 + wdiab = 0.0_r8 + wminf = wbar + wmaxf = wbar + + if (k == kactfirst) then + + call activate_aerosol( & + wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + naerosol, nbins, vaerosol, hygro, aero_props, & + fn, fm, fluxn, fluxm, flux_fullact ) + + + else +! above cloud base - do secondary activation with prescribed supersat +! that is constant with height + smax_prescribed = method2_activate_smaxmax + call activate_aerosol( & + wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + naerosol, nbins, vaerosol, hygro, aero_props, & + fn, fm, fluxn, fluxm, flux_fullact, smax_prescribed ) + end if + +! apply the activation fractions to the updraft aerosol mixing ratios + dt_u_inv = 1.0_r8/dt_u + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + if (l==0) then + tmp_fact = fn(m) + else + tmp_fact = fm(m) + end if + + if ( (method_reduce_actfrac == 1) .and. & + (factor_reduce_actfrac >= 0.0_r8) .and. & + (factor_reduce_actfrac < 1.0_r8) ) & + tmp_fact = tmp_fact * factor_reduce_actfrac + + delact = min( conu(1,mm)*tmp_fact, conu(1,mm) ) + delact = max( delact, 0.0_r8 ) + conu(1,mm) = conu(1,mm) - delact + conu(2,mm) = conu(2,mm) + delact + dconudt(1,mm) = -delact*dt_u_inv + dconudt(2,mm) = delact*dt_u_inv + end do + end do + + end subroutine activate_convproc_method2 + +!========================================================================================= + subroutine resuspend_convproc( aero_props, & + dcondt, dcondt_resusp, ktop, kbot_prevap ) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate resuspension of activated aerosol species resulting from both +! detrainment from updraft and downdraft into environment +! subsidence and lifting of environment, which may move air from +! levels with large-scale cloud to levels with no large-scale cloud +! +! Method: +! Three possible approaches were considered: +! +! 1. Ad-hoc #1 approach. At each level, adjust dcondt for the activated +! and unactivated portions of a particular aerosol species so that the +! ratio of dcondt (activated/unactivate) is equal to the ratio of the +! mixing ratios before convection. +! THIS WAS IMPLEMENTED IN MIRAGE2 +! +! 2. Ad-hoc #2 approach. At each level, adjust dcondt for the activated +! and unactivated portions of a particular aerosol species so that the +! change to the activated portion is minimized (zero if possible). The +! would minimize effects of convection on the large-scale cloud. +! THIS IS CURRENTLY IMPLEMENTED IN CAM5 where we assume that convective +! clouds have no impact on the stratiform-cloudborne aerosol +! +! 3. Mechanistic approach that treats the details of interactions between +! the large-scale and convective clouds. (Something for the future.) +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! arguments +! (note: TMR = tracer mixing ratio) + + class(aerosol_properties), intent(in) :: aero_props + real(r8), intent(inout) :: dcondt(2,ncnstaer,pver) + ! overall TMR tendency from convection + real(r8), intent(inout) :: dcondt_resusp(2,ncnstaer,pver) + ! portion of TMR tendency due to resuspension + ! (actually, due to the adjustments made here) + integer, intent(in) :: ktop, kbot_prevap ! indices of top and bottom cloud levels + +!----------------------------------------------------------------------- +! local variables + integer :: k, l, m, mm + real(r8) :: qdota, qdotc, qdotac ! working variables (MR tendencies) + !----------------------------------------------------------------------- + + ! apply adjustments to dcondt for pairs of unactivated and + ! activated aerosol species + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + do k = ktop, kbot_prevap + if (convproc_do_evaprain_atonce) then + dcondt_resusp(1,mm,k) = dcondt(1,mm,k) + dcondt_resusp(2,mm,k) = dcondt(2,mm,k) + else + qdota = dcondt(1,mm,k) + qdotc = dcondt(2,mm,k) + qdotac = qdota + qdotc + + dcondt(1,mm,k) = qdotac + dcondt(2,mm,k) = 0.0_r8 + + dcondt_resusp(1,mm,k) = (dcondt(1,mm,k) - qdota) + dcondt_resusp(2,mm,k) = (dcondt(2,mm,k) - qdotc) + end if + end do + + end do + end do + + end subroutine resuspend_convproc + +!========================================================================================= + +end module aero_convproc 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/aero_wetdep_cam.F90 b/src/chemistry/aerosol/aero_wetdep_cam.F90 new file mode 100644 index 0000000000..4a8a4e1ac4 --- /dev/null +++ b/src/chemistry/aerosol/aero_wetdep_cam.F90 @@ -0,0 +1,1189 @@ +module aero_wetdep_cam + use shr_kind_mod, only: r8 => shr_kind_r8 + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use camsrfexch, only: cam_out_t + use physics_buffer,only: physics_buffer_desc, pbuf_get_index, pbuf_set_field, pbuf_get_field + use constituents, only: pcnst, cnst_name, cnst_get_ind + use phys_control, only: phys_getopts + use ppgrid, only: pcols, pver + use physconst, only: gravit + + use cam_abortutils,only: endrun + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use infnan, only: nan, assignment(=) + + use cam_history, only: addfld, add_default, horiz_only, outfld + use wetdep, only: wetdep_init + + use rad_constituents, only: rad_cnst_get_info + + use aerosol_properties_mod, only: aero_name_len + use aerosol_properties_mod, only: aerosol_properties + use modal_aerosol_properties_mod, only: modal_aerosol_properties + + use aerosol_state_mod, only: aerosol_state, ptr2d_t + use modal_aerosol_state_mod, only: modal_aerosol_state + + use aero_convproc, only: aero_convproc_readnl, aero_convproc_init, aero_convproc_intr + use aero_convproc, only: convproc_do_evaprain_atonce + use aero_convproc, only: deepconv_wetdep_history + + use infnan, only: nan, assignment(=) + use perf_mod, only: t_startf, t_stopf + + implicit none + private + + public :: aero_wetdep_readnl + public :: aero_wetdep_init + public :: aero_wetdep_tend + + real(r8), parameter :: NOTSET = -huge(1._r8) + real(r8) :: sol_facti_cloud_borne = NOTSET + real(r8) :: sol_factb_interstitial = NOTSET + real(r8) :: sol_factic_interstitial = NOTSET + + integer :: fracis_idx = -1 + integer :: rprddp_idx = -1 + integer :: rprdsh_idx = -1 + integer :: nevapr_shcu_idx = -1 + integer :: nevapr_dpcu_idx = -1 + + logical :: wetdep_active = .false. + integer :: nwetdep = 0 + logical :: convproc_do_aer = .false. + logical,allocatable :: aero_cnst_lq(:,:) + integer,allocatable :: aero_cnst_id(:,:) + logical, public, protected :: wetdep_lq(pcnst) ! set flags true for constituents with non-zero tendencies + + ! variables for table lookup of aerosol impaction/interception scavenging rates + integer, parameter :: nimptblgrow_mind=-7, nimptblgrow_maxd=12 + real(r8) :: dlndg_nimptblgrow + real(r8),allocatable :: scavimptblnum(:,:) + real(r8),allocatable :: scavimptblvol(:,:) + + integer :: nmodes=0 + integer :: nspec_max=0 + integer :: nele_tot ! total number of aerosol elements + class(aerosol_properties), pointer :: aero_props=>null() + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine aero_wetdep_readnl(nlfile) + use namelist_utils, only: find_group_name + use spmd_utils, only: mpicom, masterprocid, mpi_character, mpi_real8, mpi_integer, mpi_success + use spmd_utils, only: mpi_logical + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + integer :: unitn, ierr + character(len=*), parameter :: subname = 'aero_wetdep_readnl' + + ! =================== + ! Namelist definition + ! =================== + namelist /aero_wetdep_nl/ sol_facti_cloud_borne, sol_factb_interstitial, sol_factic_interstitial + + ! ============= + ! Read namelist + ! ============= + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'aero_wetdep_nl', status=ierr) + if (ierr == 0) then + read(unitn, aero_wetdep_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + + ! ============================ + ! Log namelist options + ! ============================ + write(iulog,*) subname,' namelist settings: ' + write(iulog,*) ' sol_facti_cloud_borne : ',sol_facti_cloud_borne + write(iulog,*) ' sol_factb_interstitial : ',sol_factb_interstitial + write(iulog,*) ' sol_factic_interstitial: ',sol_factic_interstitial + end if + + ! ============================ + ! Broadcast namelist variables + ! ============================ + call mpi_bcast(sol_facti_cloud_borne, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: sol_facti_cloud_borne') + end if + call mpi_bcast(sol_factb_interstitial, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: sol_factb_interstitial') + end if + call mpi_bcast(sol_factic_interstitial, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: sol_factic_interstitial') + end if + + call mpi_bcast(nwetdep, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: nwetdep') + end if + + wetdep_active = .true. !nwetdep>0 + + if (masterproc) then + write(iulog,*) subname,' wetdep_active = ',wetdep_active,' nwetdep = ',nwetdep + endif + + call aero_convproc_readnl(nlfile) + + end subroutine aero_wetdep_readnl + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine aero_wetdep_init( ) + + character(len=*), parameter :: subrname = 'aero_wetdep_init' + + character(len=2) :: unit_basename ! Units 'kg' or '1' + character(len=aero_name_len) :: tmpname + character(len=aero_name_len) :: tmpname_cw + + logical :: history_aerosol ! Output MAM or SECT aerosol tendencies + logical :: history_chemistry + + integer :: l,m, id, astat + character(len=2) :: binstr + + fracis_idx = pbuf_get_index('FRACIS') + rprddp_idx = pbuf_get_index('RPRDDP') + rprdsh_idx = pbuf_get_index('RPRDSH') + nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') + nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') + + if (.not.wetdep_active) return + + call phys_getopts(history_aerosol_out = history_aerosol, & + history_chemistry_out=history_chemistry, & + convproc_do_aer_out = convproc_do_aer) + + call rad_cnst_get_info(0, nmodes=nmodes) + + if (nmodes>0) then + aero_props => modal_aerosol_properties() + if (.not.associated(aero_props)) then + call endrun(subrname//' : construction of aero_props modal_aerosol_properties object failed') + end if + else + call endrun(subrname//' : cannot determine aerosol model') + endif + + nele_tot = aero_props%ncnst_tot() + + allocate(aero_cnst_lq(aero_props%nbins(),0:maxval(aero_props%nmasses())), stat=astat) + if (astat/=0) then + call endrun(subrname//' : not able to allocate aero_cnst_lq array') + end if + aero_cnst_lq(:,:) = .false. + + allocate(aero_cnst_id(aero_props%nbins(),0:maxval(aero_props%nmasses())), stat=astat) + if (astat/=0) then + call endrun(subrname//' : not able to allocate aero_cnst_id array') + end if + aero_cnst_id(:,:) = -1 + + wetdep_lq = .false. + + do m = 1, aero_props%nbins() + write(binstr,'(i2.2)') m + call addfld('SOLFACTB'//binstr, (/ 'lev' /), 'A', '1', 'below cld sol fact') + + do l = 0, aero_props%nmasses(m) + + if (l == 0) then ! number + call aero_props%num_names( m, tmpname, tmpname_cw) + else + call aero_props%mmr_names( m,l, tmpname, tmpname_cw) + end if + + call cnst_get_ind(tmpname, id, abort=.false.) + aero_cnst_id(m,l) = id + aero_cnst_lq(m,l) = id > 0 + if (id > 0) then + wetdep_lq(id) = .true. + end if + + ! units -- + if (l==0) then + unit_basename = ' 1' ! for num + else + unit_basename = 'kg' + endif + + call add_hist_fields(tmpname, unit_basename) + call add_hist_fields(tmpname_cw, unit_basename) + + call addfld( trim(tmpname_cw)//'RSPTD', (/ 'lev' /), 'A', unit_basename//'/kg/s', & + trim(tmpname_cw)//' resuspension tendency') + + end do + end do + + allocate(scavimptblnum(nimptblgrow_mind:nimptblgrow_maxd, aero_props%nbins()), stat=astat) + if (astat/=0) then + call endrun(subrname//' : not able to allocate scavimptblnum array') + end if + allocate(scavimptblvol(nimptblgrow_mind:nimptblgrow_maxd, aero_props%nbins()), stat=astat) + if (astat/=0) then + call endrun(subrname//' : not able to allocate scavimptblvol array') + end if + scavimptblnum = nan + scavimptblvol = nan + + call wetdep_init() + + nspec_max = maxval(aero_props%nspecies()) + 2 + + call init_bcscavcoef() + + if (convproc_do_aer) then + call aero_convproc_init(aero_props) + end if + + contains + + subroutine add_hist_fields(name,baseunits) + character(len=*), intent(in) :: name + character(len=*), intent(in) :: baseunits + + call addfld (trim(name)//'SFWET', & + horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux at surface') + call addfld (trim(name)//'SFSIC', & + horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux (incloud, convective) at surface') + call addfld (trim(name)//'SFSIS', & + horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux (incloud, stratiform) at surface') + call addfld (trim(name)//'SFSBC', & + horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux (belowcloud, convective) at surface') + call addfld (trim(name)//'SFSBS', & + horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux (belowcloud, stratiform) at surface') + + if (convproc_do_aer) then + call addfld (trim(name)//'SFSEC', & + horiz_only, 'A',unit_basename//'/m2/s','Wet deposition flux (precip evap, convective) at surface') + call addfld (trim(name)//'SFSES', & + horiz_only, 'A',unit_basename//'/m2/s','Wet deposition flux (precip evap, stratiform) at surface') + call addfld (trim(name)//'SFSBD', & + horiz_only, 'A',unit_basename//'/m2/s','Wet deposition flux (belowcloud, deep convective) at surface') + call addfld (trim(name)//'WETC', & + (/ 'lev' /), 'A',unit_basename//'/kg/s ','wet deposition tendency') + call addfld (trim(name)//'CONU', & + (/ 'lev' /), 'A',unit_basename//'/kg ','updraft mixing ratio') + end if + + call addfld (trim(name)//'WET',(/ 'lev' /), 'A',baseunits//'/kg/s ','wet deposition tendency') + call addfld (trim(name)//'INS',(/ 'lev' /), 'A',baseunits//'/kg/s ','insol frac') + + call addfld (trim(name)//'SIC',(/ 'lev' /), 'A',baseunits//'/kg/s ', & + trim(name)//' ic wet deposition') + call addfld (trim(name)//'SIS',(/ 'lev' /), 'A',baseunits//'/kg/s ', & + trim(name)//' is wet deposition') + call addfld (trim(name)//'SBC',(/ 'lev' /), 'A',baseunits//'/kg/s ', & + trim(name)//' bc wet deposition') + call addfld (trim(name)//'SBS',(/ 'lev' /), 'A',baseunits//'/kg/s ', & + trim(name)//' bs wet deposition') + + if ( history_aerosol .or. history_chemistry ) then + call add_default (trim(name)//'SFWET', 1, ' ') + endif + if ( history_aerosol ) then + call add_default (trim(name)//'SFSEC', 1, ' ') + call add_default (trim(name)//'SFSIC', 1, ' ') + call add_default (trim(name)//'SFSIS', 1, ' ') + call add_default (trim(name)//'SFSBC', 1, ' ') + call add_default (trim(name)//'SFSBS', 1, ' ') + if (convproc_do_aer) then + call add_default (trim(name)//'SFSES', 1, ' ') + call add_default (trim(name)//'SFSBD', 1, ' ') + end if + endif + + end subroutine add_hist_fields + + end subroutine aero_wetdep_init + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine aero_wetdep_tend( state, dt, dlf, cam_out, ptend, pbuf) + use wetdep, only: wetdepa_v2, wetdep_inputs_set, wetdep_inputs_t + use aerodep_flx, only: aerodep_flx_prescribed + use aero_deposition_cam, only: aero_deposition_cam_setwet + + type(physics_state), target, intent(in) :: state ! Physics state variables + real(r8), intent(in) :: dt ! time step + real(r8), intent(in) :: dlf(:,:) ! shallow+deep convective detrainment [kg/kg/s] + type(cam_out_t), intent(inout) :: cam_out ! export state + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) + + character(len=*), parameter :: subrname = 'aero_wetdep_tend' + type(wetdep_inputs_t) :: dep_inputs + real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble (pcols, pver, pcnst) + real(r8), target :: fracis_nadv(pcols,pver) ! fraction of not-transported aerosols + + real(r8) :: scavcoefnv(pcols,pver,0:2) ! Dana and Hales coefficient (/mm) for + ! cloud-borne num & vol (0), + ! interstitial num (1), interstitial vol (2) + integer :: jnv ! index for scavcoefnv 3rd dimension + integer :: lphase ! index for interstitial / cloudborne aerosol + integer :: strt_loop, end_loop, stride_loop !loop indices for the lphase loop + + real(r8) :: sol_factb(pcols, pver) + real(r8) :: sol_facti(pcols, pver) + real(r8) :: sol_factic(pcols,pver) + + real(r8) :: dqdt_tmp(pcols,pver) ! temporary array to hold tendency for 1 species + real(r8) :: rcscavt(pcols, pver) + real(r8) :: rsscavt(pcols, pver) + real(r8) :: iscavt(pcols, pver) + real(r8) :: icscavt(pcols, pver) + real(r8) :: isscavt(pcols, pver) + real(r8) :: bcscavt(pcols, pver) + real(r8) :: bsscavt(pcols, pver) + + real(r8) :: diam_wet(state%ncol, pver) + logical :: isprx(pcols,pver) ! true if precipation + real(r8) :: prec(pcols) ! precipitation rate + + real(r8) :: rtscavt(pcols, pver, 0:nspec_max) + + integer :: ncol, lchnk, m, ndx,mm, l + integer :: i,k + + real(r8), pointer :: insolfr_ptr(:,:) + real(r8) :: q_tmp(pcols,pver) ! temporary array to hold "most current" mixing ratio for 1 species + logical :: cldbrn + + type(ptr2d_t) :: raer(nele_tot) + type(ptr2d_t) :: qqcw(nele_tot) + + real(r8) :: sflx(pcols) + character(len=aero_name_len) :: aname, cname, name + + real(r8) :: qqcw_in(pcols,pver), qqcw_sav(pcols,pver,0:nspec_max) + real(r8) :: f_act_conv(pcols,pver) ! prescribed aerosol activation fraction for convective cloud ! rce 2010/05/01 + + character(len=2) :: binstr + real(r8) :: aerdepwetcw(pcols,pcnst) ! aerosol wet deposition (cloud water) + real(r8) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial) + real(r8) :: dcondt_resusp3d(nele_tot,pcols,pver) + + integer, parameter :: nsrflx_mzaer2cnvpr = 2 + real(r8) :: qsrflx_mzaer2cnvpr(pcols,nele_tot,nsrflx_mzaer2cnvpr) + + real(r8), pointer :: rprddp(:,:) ! rain production, deep convection + real(r8), pointer :: rprdsh(:,:) ! rain production, shallow convection + real(r8), pointer :: evapcdp(:,:) ! Evaporation rate of deep convective precipitation >=0. + real(r8), pointer :: evapcsh(:,:) ! Evaporation rate of shallow convective precipitation >=0. + + real(r8) :: rprddpsum(pcols) + real(r8) :: rprdshsum(pcols) + real(r8) :: evapcdpsum(pcols) + real(r8) :: evapcshsum(pcols) + + real(r8) :: tmp_resudp, tmp_resush + real(r8) :: tmpa, tmpb + real(r8) :: sflxec(pcols), sflxecdp(pcols) ! deposition flux + real(r8) :: sflxic(pcols), sflxicdp(pcols) ! deposition flux + real(r8) :: sflxbc(pcols), sflxbcdp(pcols) ! deposition flux + + class(aerosol_state), pointer :: aero_state + + nullify(aero_state) + + if (.not.wetdep_active) return + + dcondt_resusp3d(:,:,:) = 0._r8 + + if (nmodes>0) then + aero_state => modal_aerosol_state(state,pbuf) + if (.not.associated(aero_state)) then + call endrun(subrname//' : construction of aero_state modal_aerosol_state object failed') + end if + else + call endrun(subrname//' : cannot determine aerosol model') + endif + + lchnk = state%lchnk + ncol = state%ncol + + call physics_ptend_init(ptend, state%psetcols, subrname, lq=wetdep_lq) + + call wetdep_inputs_set( state, pbuf, dep_inputs ) + + call pbuf_get_field(pbuf, fracis_idx, fracis) + + call aero_state%get_states( aero_props, raer, qqcw ) + + qsrflx_mzaer2cnvpr(:,:,:) = 0.0_r8 + aerdepwetis(:,:) = 0.0_r8 + aerdepwetcw(:,:) = 0.0_r8 + + if (convproc_do_aer) then + !Do cloudborne first for unified convection scheme so that the resuspension of cloudborne + !can be saved then applied to interstitial + strt_loop = 2 + end_loop = 1 + stride_loop = -1 + else + ! Counters for "without" unified convective treatment (i.e. default case) + strt_loop = 1 + end_loop = 2 + stride_loop = 1 + endif + + prec(:ncol)=0._r8 + do k=1,pver + where (prec(:ncol) >= 1.e-7_r8) + isprx(:ncol,k) = .true. + elsewhere + isprx(:ncol,k) = .false. + endwhere + prec(:ncol) = prec(:ncol) + (dep_inputs%prain(:ncol,k) + dep_inputs%cmfdqr(:ncol,k) - dep_inputs%evapr(:ncol,k)) & + *state%pdel(:ncol,k)/gravit + end do + + f_act_conv = 0._r8 + scavcoefnv = nan + qqcw_sav = nan + + if (convproc_do_aer) then + + call t_startf('aero_convproc') + call aero_convproc_intr( aero_props, aero_state, state, ptend, pbuf, dt, & + nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, aerdepwetis, dcondt_resusp3d ) + + if (convproc_do_evaprain_atonce) then + + do m = 1,aero_props%nbins() + do l = 0,aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + if (l == 0) then ! number + call aero_props%num_names(m, aname, cname) + else + call aero_props%mmr_names(m,l, aname, cname) + end if + + call outfld( trim(cname)//'RSPTD', dcondt_resusp3d(mm,:ncol,:), ncol, lchnk ) + + do k = 1,pver + do i = 1,ncol + qqcw(mm)%fld(i,k) = max(0._r8, qqcw(mm)%fld(i,k) + dcondt_resusp3d(mm,i,k)*dt) + end do + end do + + end do + end do + end if + call t_stopf('aero_convproc') + + end if + + bins_loop: do m = 1,aero_props%nbins() + + phase_loop: do lphase = strt_loop,end_loop, stride_loop ! loop over interstitial (1) and cloud-borne (2) forms + + cldbrn = lphase==2 + + sol_factb = nan + sol_facti = nan + sol_factic = nan + + if (lphase == 1) then ! interstial aerosol + + sol_facti = 0.0_r8 ! strat in-cloud scav totally OFF for institial + + sol_factic = sol_factic_interstitial + + else ! cloud-borne aerosol (borne by stratiform cloud drops) + + sol_factb = 0.0_r8 ! all below-cloud scav OFF (anything cloud-borne is located "in-cloud") + sol_facti = sol_facti_cloud_borne ! strat in-cloud scav cloud-borne tuning factor + sol_factic = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean + ! that conv precip collects strat droplets) + f_act_conv = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean + + end if + if (convproc_do_aer .and. lphase == 1) then + ! if modal aero convproc is turned on for aerosols, then + ! turn off the convective in-cloud removal for interstitial aerosols + ! (but leave the below-cloud on, as convproc only does in-cloud) + ! and turn off the outfld SFWET, SFSIC, SFSID, SFSEC, and SFSED calls + ! for (stratiform)-cloudborne aerosols, convective wet removal + ! (all forms) is zero, so no action is needed + sol_factic = 0.0_r8 + endif + + diam_wet = aero_state%wet_diameter(m,ncol,pver) + + scavcoefnv = 0.0_r8 + + if (lphase == 1) then ! interstial aerosol + call get_bcscavcoefs( m, ncol, isprx, diam_wet, scavcoefnv(:,:,1), scavcoefnv(:,:,2) ) + + if ( sol_factb_interstitial /= NOTSET ) then + sol_factb(:ncol,:) = sol_factb_interstitial ! all below-cloud scav + else + sol_factb(:ncol,:) = aero_state%sol_factb_interstitial( m, ncol, pver, aero_props ) + end if + + write(binstr,'(i2.2)') m + call outfld('SOLFACTB'//binstr,sol_factb, pcols, lchnk) + + end if + + masses_loop: do l = 0,aero_props%nmasses(m) + + ndx = aero_cnst_id(m,l) + + if (.not. cldbrn .and. ndx>0) then + insolfr_ptr => fracis(:,:,ndx) + else + insolfr_ptr => fracis_nadv + endif + + mm = aero_props%indexer(m,l) + + if (l == 0) then ! number + call aero_props%num_names( m, aname, cname) + else + call aero_props%mmr_names( m,l, aname, cname) + end if + + if (cldbrn) then + q_tmp(1:ncol,:) = qqcw(mm)%fld(1:ncol,:) + jnv = 0 + if (convproc_do_aer) then + qqcw_sav(:ncol,:,l) = q_tmp(1:ncol,:) + endif + name = cname + qqcw_in = nan + f_act_conv = nan + else ! interstial aerosol + q_tmp(1:ncol,:) = raer(mm)%fld(1:ncol,:) + ptend%q(1:ncol,:,ndx)*dt + if (l==0) then + jnv = 1 + else + jnv = 2 + end if + if(convproc_do_aer) then + !Feed in the saved cloudborne mixing ratios from phase 2 + qqcw_in(:ncol,:) = qqcw_sav(:ncol,:,l) + else + qqcw_in(:ncol,:) = qqcw(mm)%fld(:ncol,:) + end if + + f_act_conv(:ncol,:) = aero_state%convcld_actfrac( m, l, ncol, pver) + name = aname + end if + + dqdt_tmp(1:ncol,:) = 0.0_r8 + + call wetdepa_v2(state%pmid, state%q(:,:,1), state%pdel, & + dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, & + dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, & + dep_inputs%evapr, dep_inputs%totcond, q_tmp, dt, & + dqdt_tmp, iscavt, dep_inputs%cldvcu, dep_inputs%cldvst, & + dlf, insolfr_ptr, sol_factb, ncol, & + scavcoefnv(:,:,jnv), & + is_strat_cloudborne=cldbrn, & + qqcw=qqcw_in(:,:), f_act_conv=f_act_conv, & + icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, & + convproc_do_aer=convproc_do_aer, rcscavt=rcscavt, rsscavt=rsscavt, & + sol_facti_in=sol_facti, sol_factic_in=sol_factic, & + convproc_do_evaprain_atonce_in=convproc_do_evaprain_atonce, & + bergso_in=dep_inputs%bergso ) + + if(convproc_do_aer) then + if(cldbrn) then + ! save resuspension of cloudborne species + rtscavt(1:ncol,:,l) = rcscavt(1:ncol,:) + rsscavt(1:ncol,:) + ! wetdepa_v2 adds the resuspension of cloudborne to the dqdt of cloudborne (as a source) + ! undo this, so the resuspension of cloudborne can be added to the dqdt of interstitial (above) + dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) - rtscavt(1:ncol,:,l) + else + ! add resuspension of cloudborne species to dqdt of interstitial species + dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) + rtscavt(1:ncol,:,l) + end if + endif + + if (cldbrn .or. ndx<0) then + do k = 1,pver + do i = 1,ncol + if ( (qqcw(mm)%fld(i,k) + dqdt_tmp(i,k) * dt) .lt. 0.0_r8 ) then + dqdt_tmp(i,k) = - qqcw(mm)%fld(i,k) / dt + end if + end do + end do + + qqcw(mm)%fld(1:ncol,:) = qqcw(mm)%fld(1:ncol,:) + dqdt_tmp(1:ncol,:) * dt + + else + ptend%q(1:ncol,:,ndx) = ptend%q(1:ncol,:,ndx) + dqdt_tmp(1:ncol,:) + end if + + call outfld( trim(name)//'WET', dqdt_tmp(:,:), pcols, lchnk) + call outfld( trim(name)//'SIC', icscavt, pcols, lchnk) + call outfld( trim(name)//'SIS', isscavt, pcols, lchnk) + call outfld( trim(name)//'SBC', bcscavt, pcols, lchnk) + call outfld( trim(name)//'SBS', bsscavt, pcols, lchnk) + + call outfld( trim(name)//'INS', insolfr_ptr, pcols, lchnk) + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit + enddo + enddo + if (cldbrn) then + call outfld( trim(name)//'SFWET', sflx, pcols, lchnk) + if (ndx>0) aerdepwetcw(:ncol,ndx) = sflx(:ncol) + else + if (.not.convproc_do_aer) call outfld( trim(name)//'SFWET', sflx, pcols, lchnk) + if (ndx>0) aerdepwetis(:ncol,ndx) = aerdepwetis(:ncol,ndx) + sflx(:ncol) + end if + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + if (cldbrn) then + call outfld( trim(name)//'SFSIC', sflx, pcols, lchnk) + else + if (.not.convproc_do_aer) call outfld( trim(name)//'SFSIC', sflx, pcols, lchnk) + if (convproc_do_aer) sflxic = sflx + end if + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+isscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(name)//'SFSIS', sflx, pcols, lchnk) + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+bcscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(name)//'SFSBC', sflx, pcols, lchnk) + if (convproc_do_aer) sflxbc = sflx + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+bsscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(name)//'SFSBS', sflx, pcols, lchnk) + + if(convproc_do_aer) then + + sflx(:)=0.0_r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+rsscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(name)//'SFSES', sflx, pcols, lchnk) + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+rcscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + if (.not.convproc_do_aer) call outfld( trim(name)//'SFSEC', sflx, pcols, lchnk) + sflxec = sflx + + if(.not.cldbrn) then + + ! apportion convective surface fluxes to deep and shallow conv + ! this could be done more accurately in subr wetdepa + ! since deep and shallow rarely occur simultaneously, and these + ! fields are just diagnostics, this approximate method is adequate + ! only do this for interstitial aerosol, because conv clouds to not + ! affect the stratiform-cloudborne aerosol + if ( deepconv_wetdep_history) then + + call pbuf_get_field(pbuf, rprddp_idx, rprddp ) + call pbuf_get_field(pbuf, rprdsh_idx, rprdsh ) + call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp ) + call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh ) + + rprddpsum(:) = 0.0_r8 + rprdshsum(:) = 0.0_r8 + evapcdpsum(:) = 0.0_r8 + evapcshsum(:) = 0.0_r8 + + do k = 1, pver + rprddpsum(:ncol) = rprddpsum(:ncol) + rprddp(:ncol,k)*state%pdel(:ncol,k)/gravit + rprdshsum(:ncol) = rprdshsum(:ncol) + rprdsh(:ncol,k)*state%pdel(:ncol,k)/gravit + evapcdpsum(:ncol) = evapcdpsum(:ncol) + evapcdp(:ncol,k)*state%pdel(:ncol,k)/gravit + evapcshsum(:ncol) = evapcshsum(:ncol) + evapcsh(:ncol,k)*state%pdel(:ncol,k)/gravit + end do + + do i = 1, ncol + rprddpsum(i) = max( rprddpsum(i), 1.0e-35_r8 ) + rprdshsum(i) = max( rprdshsum(i), 1.0e-35_r8 ) + evapcdpsum(i) = max( evapcdpsum(i), 0.1e-35_r8 ) + evapcshsum(i) = max( evapcshsum(i), 0.1e-35_r8 ) + + ! assume that in- and below-cloud removal are proportional to column precip production + tmpa = rprddpsum(i) / (rprddpsum(i) + rprdshsum(i)) + tmpa = max( 0.0_r8, min( 1.0_r8, tmpa ) ) + sflxicdp(i) = sflxic(i)*tmpa + sflxbcdp(i) = sflxbc(i)*tmpa + + ! assume that resuspension is proportional to (wet removal)*[(precip evap)/(precip production)] + tmp_resudp = tmpa * min( (evapcdpsum(i)/rprddpsum(i)), 1.0_r8 ) + tmp_resush = (1.0_r8 - tmpa) * min( (evapcshsum(i)/rprdshsum(i)), 1.0_r8 ) + tmpb = max( tmp_resudp, 1.0e-35_r8 ) / max( (tmp_resudp+tmp_resush), 1.0e-35_r8 ) + tmpb = max( 0.0_r8, min( 1.0_r8, tmpb ) ) + sflxecdp(i) = sflxec(i)*tmpb + end do + call outfld( trim(name)//'SFSBD', sflxbcdp, pcols, lchnk) + else + sflxec(1:ncol) = 0.0_r8 + sflxecdp(1:ncol) = 0.0_r8 + end if + + ! when ma_convproc_intr is used, convective in-cloud wet removal is done there + ! the convective (total and deep) precip-evap-resuspension includes in- and below-cloud + ! contributions + ! so pass the below-cloud contribution to ma_convproc_intr + qsrflx_mzaer2cnvpr(1:ncol,mm,1) = sflxec( 1:ncol) + qsrflx_mzaer2cnvpr(1:ncol,mm,2) = sflxecdp(1:ncol) + + end if + end if + + end do masses_loop + end do phase_loop + + end do bins_loop + + if (associated(aero_state)) then + deallocate(aero_state) + nullify(aero_state) + end if + + ! 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 aero_deposition_cam_setwet(aerdepwetis, aerdepwetcw, cam_out) + endif + + contains + + ! below cloud impaction scavenging coefs + subroutine get_bcscavcoefs( m, ncol, isprx, diam_wet, scavcoefnum, scavcoefvol ) + + integer,intent(in) :: m, ncol + logical,intent(in):: isprx(:,:) + real(r8), intent(in) :: diam_wet(:,:) + real(r8), intent(out) :: scavcoefnum(:,:), scavcoefvol(:,:) + + integer i, k, jgrow + real(r8) dumdgratio, xgrow, dumfhi, dumflo, scavimpvol, scavimpnum + + do k = 1, pver + do i = 1, ncol + + ! do only if no precip + if ( isprx(i,k) .and. diam_wet(i,k)>0.0_r8) then + ! + ! interpolate table values using log of (actual-wet-size)/(base-dry-size) + + dumdgratio = diam_wet(i,k)/aero_props%scav_diam(m) + if ((dumdgratio >= 0.99_r8) .and. (dumdgratio <= 1.01_r8)) then + scavimpvol = scavimptblvol(0,m) + scavimpnum = scavimptblnum(0,m) + else + xgrow = log( dumdgratio ) / dlndg_nimptblgrow + jgrow = int( xgrow ) + if (xgrow < 0._r8) jgrow = jgrow - 1 + if (jgrow < nimptblgrow_mind) then + jgrow = nimptblgrow_mind + xgrow = jgrow + else + jgrow = min( jgrow, nimptblgrow_maxd-1 ) + end if + + dumfhi = xgrow - jgrow + dumflo = 1._r8 - dumfhi + + scavimpvol = dumflo*scavimptblvol(jgrow,m) + & + dumfhi*scavimptblvol(jgrow+1,m) + scavimpnum = dumflo*scavimptblnum(jgrow,m) + & + dumfhi*scavimptblnum(jgrow+1,m) + + end if + + ! impaction scavenging removal amount for volume + scavcoefvol(i,k) = exp( scavimpvol ) + ! impaction scavenging removal amount to number + scavcoefnum(i,k) = exp( scavimpnum ) + + else + scavcoefvol(i,k) = 0._r8 + scavcoefnum(i,k) = 0._r8 + end if + + end do + end do + + end subroutine get_bcscavcoefs + + end subroutine aero_wetdep_tend + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine init_bcscavcoef( ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Computes lookup table for aerosol impaction/interception scavenging rates + ! + ! Authors: R. Easter + ! Simone Tilmes Nov 2021 + ! added modifications for bin model, assuming sigma = 1. + ! + !----------------------------------------------------------------------- + + use mo_constants, only: pi + + ! local variables + integer nnfit_maxd + parameter (nnfit_maxd=27) + + integer m, jgrow, nnfit + integer lunerr + + real(r8) dg0, dg0_cgs, press, dg0_base, & + rhodryaero, rhowetaero, rhowetaero_cgs, & + scavratenum, scavratevol, logsig, & + temp, wetdiaratio, wetvolratio + + real(r8) :: xxfitnum(1,nnfit_maxd), yyfitnum(nnfit_maxd) + real(r8) :: xxfitvol(1,nnfit_maxd), yyfitvol(nnfit_maxd) + + character(len=*), parameter :: subname = 'aero_wetdep_cam::init_bcscavcoef' + + lunerr = iulog + dlndg_nimptblgrow = log( 1.25_r8 ) + + ! bin model: main loop over aerosol bins + + modeloop: do m = 1, aero_props%nbins() + + ! for setting up the lookup table, use the dry density of the first species + ! -- assume the first species of the mode/bin is the dominate species + call aero_props%get(m,1,density=rhodryaero) + + dg0_base = aero_props%scav_diam(m) + + logsig = aero_props%alogsig(m) + + growloop: do jgrow = nimptblgrow_mind, nimptblgrow_maxd + + wetdiaratio = exp( jgrow*dlndg_nimptblgrow ) + dg0 = dg0_base*wetdiaratio + + wetvolratio = exp( jgrow*dlndg_nimptblgrow*3._r8 ) + rhowetaero = 1.0_r8 + (rhodryaero-1.0_r8)/wetvolratio + rhowetaero = min( rhowetaero, rhodryaero ) + + ! + ! compute impaction scavenging rates at 1 temp-press pair and save + ! + nnfit = 0 + + temp = 273.16_r8 + press = 0.75e6_r8 ! dynes/cm2 + rhowetaero = rhodryaero + + dg0_cgs = dg0*1.0e2_r8 ! m to cm + + rhowetaero_cgs = rhowetaero*1.0e-3_r8 ! kg/m3 to g/cm3 + + call calc_1_impact_rate( & + dg0_cgs, logsig, rhowetaero_cgs, temp, press, & + scavratenum, scavratevol, lunerr ) + + nnfit = nnfit + 1 + if (nnfit > nnfit_maxd) then + write(lunerr,9110) + call endrun(subname//' : nnfit > nnfit_maxd') + end if +9110 format( '*** subr. init_bcscavcoef -- nnfit too big' ) + + xxfitnum(1,nnfit) = 1._r8 + yyfitnum(nnfit) = log( scavratenum ) + + xxfitvol(1,nnfit) = 1._r8 + yyfitvol(nnfit) = log( scavratevol ) + + !depends on both bins and different species + scavimptblnum(jgrow,m) = yyfitnum(1) + scavimptblvol(jgrow,m) = yyfitvol(1) + + enddo growloop + enddo modeloop + + contains + + !=============================================================================== + subroutine calc_1_impact_rate( & + dg0, logsig, rhoaero, temp, press, & + scavratenum, scavratevol, lunerr ) + ! + ! routine computes a single impaction scavenging rate + ! for precipitation rate of 1 mm/h + ! + ! dg0 = geometric mean diameter of aerosol number size distrib. (cm) + ! sigmag = geometric standard deviation of size distrib. + ! rhoaero = density of aerosol particles (g/cm^3) + ! temp = temperature (K) + ! press = pressure (dyne/cm^2) + ! scavratenum = number scavenging rate (1/h) + ! scavratevol = volume or mass scavenging rate (1/h) + ! lunerr = logical unit for error message + ! + use mo_constants, only: boltz_cgs, pi, rhowater => rhoh2o_cgs, rgas => rgas_cgs + + implicit none + + ! subr. parameters + integer, intent(in) :: lunerr + real(r8), intent(in) :: dg0, logsig, rhoaero, temp, press + real(r8), intent(out) :: scavratenum, scavratevol + + ! local variables + integer nrainsvmax + parameter (nrainsvmax=50) + real(r8) rrainsv(nrainsvmax), xnumrainsv(nrainsvmax),& + vfallrainsv(nrainsvmax) + + integer naerosvmax + parameter (naerosvmax=51) + real(r8) aaerosv(naerosvmax), & + ynumaerosv(naerosvmax), yvolaerosv(naerosvmax) + + integer i, ja, jr, na, nr + real(r8) a, aerodiffus, aeromass, ag0, airdynvisc, airkinvisc + real(r8) anumsum, avolsum, cair, chi + real(r8) d, dr, dum, dumfuchs, dx + real(r8) ebrown, eimpact, eintercept, etotal, freepath + real(r8) precip, precipmmhr, precipsum + real(r8) r, rainsweepout, reynolds, rhi, rhoair, rlo, rnumsum + real(r8) scavsumnum, scavsumnumbb + real(r8) scavsumvol, scavsumvolbb + real(r8) schmidt, sqrtreynolds, sstar, stokes, sx + real(r8) taurelax, vfall, vfallstp + real(r8) x, xg0, xg3, xhi, xlo, xmuwaterair + + rlo = .005_r8 + rhi = .250_r8 + dr = 0.005_r8 + nr = 1 + nint( (rhi-rlo)/dr ) + if (nr > nrainsvmax) then + write(lunerr,9110) + call endrun(subname//' : nr > nrainsvmax') + end if + +9110 format( '*** subr. calc_1_impact_rate -- nr > nrainsvmax' ) + + precipmmhr = 1.0_r8 + precip = precipmmhr/36000._r8 + + ag0 = dg0/2._r8 + sx = logsig + xg0 = log( ag0 ) + xg3 = xg0 + 3._r8*sx*sx + + xlo = xg3 - 4._r8*sx + xhi = xg3 + 4._r8*sx + dx = 0.2_r8*sx + + dx = max( 0.2_r8*sx, 0.01_r8 ) + xlo = xg3 - max( 4._r8*sx, 2._r8*dx ) + xhi = xg3 + max( 4._r8*sx, 2._r8*dx ) + + na = 1 + nint( (xhi-xlo)/dx ) + if (na > naerosvmax) then + write(lunerr,9120) + call endrun(subname//' : na > naerosvmax') + end if + +9120 format( '*** subr. calc_1_impact_rate -- na > naerosvmax' ) + + ! air molar density + cair = press/(rgas*temp) + ! air mass density + rhoair = 28.966_r8*cair + ! molecular freepath + freepath = 2.8052e-10_r8/cair + ! air dynamic viscosity + airdynvisc = 1.8325e-4_r8 * (416.16_r8/(temp+120._r8)) * & + ((temp/296.16_r8)**1.5_r8) + ! air kinemaic viscosity + airkinvisc = airdynvisc/rhoair + ! ratio of water viscosity to air viscosity (from Slinn) + xmuwaterair = 60.0_r8 + + ! + ! compute rain drop number concentrations + ! rrainsv = raindrop radius (cm) + ! xnumrainsv = raindrop number concentration (#/cm^3) + ! (number in the bin, not number density) + ! vfallrainsv = fall velocity (cm/s) + ! + precipsum = 0._r8 + do i = 1, nr + r = rlo + (i-1)*dr + rrainsv(i) = r + xnumrainsv(i) = exp( -r/2.7e-2_r8 ) + + d = 2._r8*r + if (d <= 0.007_r8) then + vfallstp = 2.88e5_r8 * d**2._r8 + else if (d <= 0.025_r8) then + vfallstp = 2.8008e4_r8 * d**1.528_r8 + else if (d <= 0.1_r8) then + vfallstp = 4104.9_r8 * d**1.008_r8 + else if (d <= 0.25_r8) then + vfallstp = 1812.1_r8 * d**0.638_r8 + else + vfallstp = 1069.8_r8 * d**0.235_r8 + end if + + vfall = vfallstp * sqrt(1.204e-3_r8/rhoair) + vfallrainsv(i) = vfall + precipsum = precipsum + vfall*(r**3)*xnumrainsv(i) + end do + precipsum = precipsum*pi*1.333333_r8 + + rnumsum = 0._r8 + do i = 1, nr + xnumrainsv(i) = xnumrainsv(i)*(precip/precipsum) + rnumsum = rnumsum + xnumrainsv(i) + end do + + ! + ! compute aerosol concentrations + ! aaerosv = particle radius (cm) + ! fnumaerosv = fraction of total number in the bin (--) + ! fvolaerosv = fraction of total volume in the bin (--) + ! + anumsum = 0._r8 + avolsum = 0._r8 + do i = 1, na + x = xlo + (i-1)*dx + a = exp( x ) + aaerosv(i) = a + dum = (x - xg0)/sx + ynumaerosv(i) = exp( -0.5_r8*dum*dum ) + yvolaerosv(i) = ynumaerosv(i)*1.3333_r8*pi*a*a*a + anumsum = anumsum + ynumaerosv(i) + avolsum = avolsum + yvolaerosv(i) + end do + + do i = 1, na + ynumaerosv(i) = ynumaerosv(i)/anumsum + yvolaerosv(i) = yvolaerosv(i)/avolsum + end do + + ! + ! compute scavenging + ! + scavsumnum = 0._r8 + scavsumvol = 0._r8 + ! + ! outer loop for rain drop radius + ! + jr_loop: do jr = 1, nr + + r = rrainsv(jr) + vfall = vfallrainsv(jr) + + reynolds = r * vfall / airkinvisc + sqrtreynolds = sqrt( reynolds ) + + ! + ! inner loop for aerosol particle radius + ! + scavsumnumbb = 0._r8 + scavsumvolbb = 0._r8 + + ja_loop: do ja = 1, na + + a = aaerosv(ja) + + chi = a/r + + dum = freepath/a + dumfuchs = 1._r8 + 1.246_r8*dum + 0.42_r8*dum*exp(-0.87_r8/dum) + taurelax = 2._r8*rhoaero*a*a*dumfuchs/(9._r8*rhoair*airkinvisc) + + aeromass = 4._r8*pi*a*a*a*rhoaero/3._r8 + aerodiffus = boltz_cgs*temp*taurelax/aeromass + + schmidt = airkinvisc/aerodiffus + stokes = vfall*taurelax/r + + ebrown = 4._r8*(1._r8 + 0.4_r8*sqrtreynolds*(schmidt**0.3333333_r8)) / & + (reynolds*schmidt) + + dum = (1._r8 + 2._r8*xmuwaterair*chi) / & + (1._r8 + xmuwaterair/sqrtreynolds) + eintercept = 4._r8*chi*(chi + dum) + + dum = log( 1._r8 + reynolds ) + sstar = (1.2_r8 + dum/12._r8) / (1._r8 + dum) + eimpact = 0._r8 + if (stokes > sstar) then + dum = stokes - sstar + eimpact = (dum/(dum+0.6666667_r8)) ** 1.5_r8 + end if + + etotal = ebrown + eintercept + eimpact + etotal = min( etotal, 1.0_r8 ) + + rainsweepout = xnumrainsv(jr)*4._r8*pi*r*r*vfall + + scavsumnumbb = scavsumnumbb + rainsweepout*etotal*ynumaerosv(ja) + scavsumvolbb = scavsumvolbb + rainsweepout*etotal*yvolaerosv(ja) + + enddo ja_loop + + scavsumnum = scavsumnum + scavsumnumbb + scavsumvol = scavsumvol + scavsumvolbb + + enddo jr_loop + + scavratenum = scavsumnum*3600._r8 + scavratevol = scavsumvol*3600._r8 + + end subroutine calc_1_impact_rate + + end subroutine init_bcscavcoef + +end module aero_wetdep_cam diff --git a/src/chemistry/aerosol/aerosol_optics_mod.F90 b/src/chemistry/aerosol/aerosol_optics_mod.F90 new file mode 100644 index 0000000000..ae2a04bfb1 --- /dev/null +++ b/src/chemistry/aerosol/aerosol_optics_mod.F90 @@ -0,0 +1,58 @@ +module aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + private + public :: aerosol_optics + + !> aerosol_optics defines interfaces to optical properties of any aerosol package + !! + !! Each aerosol optics type must extend the abstract aerosol_optics class + !! to define details of how aerosol optics properties are derived from + !! aerosol states. + type, abstract :: aerosol_optics + + contains + + procedure(aeropts_sw_props),deferred :: sw_props + procedure(aeropts_lw_props),deferred :: lw_props + + end type aerosol_optics + + abstract interface + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine aeropts_sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + import :: aerosol_optics, r8 + + class(aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized asymmetry factor + real(r8),intent(out) :: pasm(ncol) ! parameterized single scattering albedo + + end subroutine aeropts_sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine aeropts_lw_props(self, ncol, ilev, iwav, pabs) + import :: aerosol_optics, r8 + + class(aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + end subroutine aeropts_lw_props + + end interface + +end module aerosol_optics_mod diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 new file mode 100644 index 0000000000..e7cea68ad4 --- /dev/null +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -0,0 +1,713 @@ +module aerosol_properties_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + private + + public :: aerosol_properties + + !> aerosol_properties defines the configuration of any aerosol package (using + !! any aerosol representation) based on user specification. These values are + !! set during initialization and do not vary during the simulation. + !! + !! Each aerosol package (e.g., MAM, CARMA, etc) must extend the abstract + !! aerosol_properties class to define the details of their configuration. Any + !! package must implement each of the deferred procedures of the abstract + !! aerosol_properties class, may include additional private data members and + !! type-bound procedures, and may override functions of the abstract class. + !! + !! Please see the modal_aerosol_properties module for an example of how the + !! aerosol_properties class can be extended for a specific aerosol package. + type, abstract :: aerosol_properties + private + integer :: nbins_ = 0 ! number of aerosol bins + integer :: ncnst_tot_ = 0 ! total number of constituents + integer, allocatable :: nmasses_(:) ! number of species masses + integer, allocatable :: nspecies_(:) ! number of species + integer, allocatable :: indexer_(:,:) ! unique indices of the aerosol elements + real(r8), allocatable :: alogsig_(:) ! natural log of geometric deviation of the number distribution for aerosol bin + real(r8), allocatable :: f1_(:) ! eq 28 Abdul-Razzak et al 1998 + real(r8), allocatable :: f2_(:) ! eq 29 Abdul-Razzak et al 1998 + ! Abdul-Razzak, H., S.J. Ghan, and C. Rivera-Carpio, A parameterization of aerosol activation, + ! 1, Singleaerosoltype. J. Geophys. Res., 103, 6123-6132, 1998. + real(r8) :: soa_equivso4_factor_ = -huge(1._r8) + real(r8) :: pom_equivso4_factor_ = -huge(1._r8) + contains + procedure :: initialize => aero_props_init + procedure,private :: nbins_0list + procedure(aero_nbins_rlist), deferred :: nbins_rlist + generic :: nbins => nbins_0list,nbins_rlist + procedure :: ncnst_tot + procedure,private :: nspecies_per_bin + procedure(aero_nspecies_rlist), deferred :: nspecies_per_bin_rlist + procedure,private :: nspecies_all_bins + generic :: nspecies => nspecies_all_bins,nspecies_per_bin,nspecies_per_bin_rlist + procedure,private :: n_masses_all_bins + procedure,private :: n_masses_per_bin + generic :: nmasses => n_masses_all_bins,n_masses_per_bin + procedure :: indexer + procedure :: maxsat + procedure(aero_amcube), deferred :: amcube + procedure :: alogsig_0list + procedure(aero_alogsig_rlist), deferred :: alogsig_rlist + generic :: alogsig => alogsig_0list,alogsig_rlist + procedure(aero_number_transported), deferred :: number_transported + procedure(aero_props_get), deferred :: get + procedure(aero_actfracs), deferred :: actfracs + procedure(aero_num_names), deferred :: num_names + procedure(aero_mmr_names), deferred :: mmr_names + procedure(aero_amb_num_name), deferred :: amb_num_name + procedure(aero_amb_mmr_name), deferred :: amb_mmr_name + procedure(aero_species_type), deferred :: species_type + procedure(aero_icenuc_updates_num), deferred :: icenuc_updates_num + procedure(aero_icenuc_updates_mmr), deferred :: icenuc_updates_mmr + procedure(aero_apply_num_limits), deferred :: apply_number_limits + procedure(aero_hetfrz_species), deferred :: hetfrz_species + procedure :: soa_equivso4_factor ! SOA Hygroscopicity / Sulfate Hygroscopicity + procedure :: pom_equivso4_factor ! POM Hygroscopicity / Sulfate Hygroscopicity + procedure(aero_soluble), deferred :: soluble + 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_scav_diam), deferred :: scav_diam + procedure(aero_resuspension_resize), deferred :: resuspension_resize + procedure(aero_rebin_bulk_fluxes), deferred :: rebin_bulk_fluxes + procedure(aero_hydrophilic), deferred :: hydrophilic + + procedure :: final=>aero_props_final + end type aerosol_properties + + integer,public, parameter :: aero_name_len = 32 ! common length of aersols names, species, etc + + abstract interface + + !------------------------------------------------------------------------------ + ! returns number of transported aerosol constituents + !------------------------------------------------------------------------------ + integer function aero_number_transported(self) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + end function aero_number_transported + + !------------------------------------------------------------------------ + ! returns aerosol properties: + ! 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, specname, specmorph, refindex_sw, refindex_lw) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: species_ndx ! species index + integer, optional, intent(in) :: list_ndx ! climate or a diagnostic list number + 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 + + end subroutine aero_props_get + + !------------------------------------------------------------------------ + ! returns optics type and table parameters + !------------------------------------------------------------------------ + subroutine aero_optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, asmpsw, absplw, & + refrtabsw, refitabsw, refrtablw, refitablw, ncoef, prefr, prefi, sw_hygro_ext_wtp, & + sw_hygro_ssa_wtp, sw_hygro_asm_wtp, lw_hygro_ext_wtp, wgtpct, nwtp, & + sw_hygro_coreshell_ext, sw_hygro_coreshell_ssa, sw_hygro_coreshell_asm, lw_hygro_coreshell_ext, & + corefrac, bcdust, kap, relh, nfrac, nbcdust, nkap, nrelh ) + + import :: aerosol_properties, r8 + + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: list_ndx ! rad climate/diags list + + character(len=*), optional, intent(out) :: opticstype + + ! refactive index table parameters + real(r8), optional, pointer :: extpsw(:,:,:,:) ! short wave specific extinction + real(r8), optional, pointer :: abspsw(:,:,:,:) ! short wave specific absorption + real(r8), optional, pointer :: asmpsw(:,:,:,:) ! short wave asymmetry factor + real(r8), optional, pointer :: absplw(:,:,:,:) ! long wave specific absorption + real(r8), optional, pointer :: refrtabsw(:,:) ! table of short wave real refractive indices for aerosols + real(r8), optional, pointer :: refitabsw(:,:) ! table of short wave imaginary refractive indices for aerosols + real(r8), optional, pointer :: refrtablw(:,:) ! table of long wave real refractive indices for aerosols + real(r8), optional, pointer :: refitablw(:,:) ! table of long wave imaginary refractive indices for aerosols + integer, optional, intent(out) :: ncoef ! number of chebychev polynomials + integer, optional, intent(out) :: prefr ! number of real refractive indices in table + integer, optional, intent(out) :: prefi ! number of imaginary refractive indices in table + + ! hygrowghtpct table parameters + real(r8), optional, pointer :: sw_hygro_ext_wtp(:,:) ! short wave extinction table + real(r8), optional, pointer :: sw_hygro_ssa_wtp(:,:) ! short wave single-scatter albedo table + real(r8), optional, pointer :: sw_hygro_asm_wtp(:,:) ! short wave asymmetry table + real(r8), optional, pointer :: lw_hygro_ext_wtp(:,:) ! long wave absorption table + real(r8), optional, pointer :: wgtpct(:) ! weight precent of H2SO4/H2O solution + integer, optional, intent(out) :: nwtp ! number of weight precent values + + ! hygrocoreshell table parameters + real(r8), optional, pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) ! short wave extinction table + real(r8), optional, pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:) ! short wave single-scatter albedo table + real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) ! short wave asymmetry table + real(r8), optional, pointer :: lw_hygro_coreshell_ext(:,:,:,:,:) ! long wave absorption table + real(r8), optional, pointer :: corefrac(:) ! core fraction dimension values + real(r8), optional, pointer :: bcdust(:) ! bc/(bc + dust) fraction dimension values + real(r8), optional, pointer :: kap(:) ! hygroscopicity dimension values + real(r8), optional, pointer :: relh(:) ! relative humidity dimension values + integer, optional, intent(out) :: nfrac ! core fraction dimension size + integer, optional, intent(out) :: nbcdust ! bc/(bc + dust) fraction dimension size + integer, optional, intent(out) :: nkap ! hygroscopicity dimension size + integer, optional, intent(out) :: nrelh ! relative humidity dimension size + + end subroutine aero_optics_params + + !------------------------------------------------------------------------ + ! returns species type + !------------------------------------------------------------------------ + subroutine aero_species_type(self, bin_ndx, species_ndx, spectype) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: spectype ! species type + + end subroutine aero_species_type + + !------------------------------------------------------------------------ + ! returns mass and number activation fractions + !------------------------------------------------------------------------ + subroutine aero_actfracs(self, bin_ndx, smc, smax, fn, fm ) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8),intent(in) :: smc ! critical supersaturation for particles of bin radius + real(r8),intent(in) :: smax ! maximum supersaturation for multiple competing aerosols + real(r8),intent(out) :: fn ! activation fraction for aerosol number + real(r8),intent(out) :: fm ! activation fraction for aerosol mass + + end subroutine aero_actfracs + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine aero_num_names(self, bin_ndx, name_a, name_c) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol number dens + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol number dens + end subroutine aero_num_names + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine aero_mmr_names(self, bin_ndx, species_ndx, name_a, name_c) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol MMR + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol MMR + end subroutine aero_mmr_names + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine aero_amb_num_name(self, bin_ndx, name) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol number dens + + end subroutine aero_amb_num_name + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine aero_amb_mmr_name(self, bin_ndx, species_ndx, name) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol MMR + + end subroutine aero_amb_mmr_name + + !------------------------------------------------------------------------------ + ! returns radius^3 (m3) of a given bin number + !------------------------------------------------------------------------------ + pure elemental real(r8) function aero_amcube(self, bin_ndx, volconc, numconc) + import :: aerosol_properties, r8 + + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + real(r8), intent(in) :: volconc ! volume conc (m3/m3) + real(r8), intent(in) :: numconc ! number conc (1/m3) + + end function aero_amcube + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to given aerosol bin number + !------------------------------------------------------------------------------ + function aero_icenuc_updates_num(self, bin_ndx) result(res) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + logical :: res + + end function aero_icenuc_updates_num + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to a given species within a bin + !------------------------------------------------------------------------------ + function aero_icenuc_updates_mmr(self, bin_ndx, species_ndx) result(res) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + logical :: res + + end function aero_icenuc_updates_mmr + + !------------------------------------------------------------------------------ + ! apply max / min to number concentration + !------------------------------------------------------------------------------ + subroutine aero_apply_num_limits( self, naerosol, vaerosol, istart, istop, m ) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: naerosol(:) ! number conc (1/m3) + real(r8), intent(in) :: vaerosol(:) ! volume conc (m3/m3) + integer, intent(in) :: istart ! start column index (1 <= istart <= istop <= pcols) + integer, intent(in) :: istop ! stop column index + integer, intent(in) :: m ! mode or bin index + + end subroutine aero_apply_num_limits + + !------------------------------------------------------------------------------ + ! returns TRUE if species `spc_ndx` in aerosol subset `bin_ndx` contributes to + ! the particles' ability to act as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function aero_hetfrz_species(self, bin_ndx, spc_ndx) result(res) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: spc_ndx ! species number + + logical :: res + + end function aero_hetfrz_species + + !------------------------------------------------------------------------------ + ! returns minimum mass mean radius (meters) + !------------------------------------------------------------------------------ + function aero_min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + real(r8) :: minrad ! meters + + end function aero_min_mass_mean_rad + + !------------------------------------------------------------------------------ + ! returns TRUE if soluble + !------------------------------------------------------------------------------ + logical function aero_soluble(self,bin_ndx) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + end function aero_soluble + + !------------------------------------------------------------------------------ + ! returns the total number of bins for a given radiation list index + !------------------------------------------------------------------------------ + function aero_nbins_rlist(self, list_ndx) result(res) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + + integer :: res + + end function aero_nbins_rlist + + !------------------------------------------------------------------------------ + ! returns number of species in a bin for a given radiation list index + !------------------------------------------------------------------------------ + function aero_nspecies_rlist(self, list_ndx, bin_ndx) result(res) + import :: aerosol_properties + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + integer :: res + + end function aero_nspecies_rlist + + !------------------------------------------------------------------------------ + ! returns the natural log of geometric standard deviation of the number + ! distribution for radiation list number and aerosol bin + !------------------------------------------------------------------------------ + function aero_alogsig_rlist(self, list_ndx, bin_ndx) result(res) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: res + + end function aero_alogsig_rlist + + !------------------------------------------------------------------------------ + ! returns name for a given radiation list number and aerosol bin + !------------------------------------------------------------------------------ + function aero_bin_name(self, list_ndx, bin_ndx) result(name) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + character(len=32) name + + end function aero_bin_name + + !------------------------------------------------------------------------------ + ! returns scavenging diameter for a given aerosol bin number + !------------------------------------------------------------------------------ + function aero_scav_diam(self, bin_ndx) result(diam) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: diam + + end function aero_scav_diam + + !------------------------------------------------------------------------------ + ! adjust aerosol concentration tendencies to create larger sizes of aerosols + ! during resuspension + !------------------------------------------------------------------------------ + subroutine aero_resuspension_resize(self, dcondt) + import :: aerosol_properties, r8 + + class(aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: dcondt(:) + + end subroutine aero_resuspension_resize + + !------------------------------------------------------------------------------ + ! 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 + + !------------------------------------------------------------------------------ + ! object initializer + !------------------------------------------------------------------------------ + subroutine aero_props_init(self, nbin, ncnst, nspec, nmasses, alogsig, f1,f2, ierr ) + class(aerosol_properties), intent(inout) :: self + integer, intent(in) :: nbin ! number of bins + integer, intent(in) :: ncnst ! total number of constituents + integer, intent(in) :: nspec(nbin) ! number of species in each bin + integer, intent(in) :: nmasses(nbin) ! number of masses in each bin + real(r8),intent(in) :: alogsig(nbin) ! natural log of the standard deviation (sigma) of the aerosol bins + real(r8),intent(in) :: f1(nbin) ! eq 28 Abdul-Razzak et al 1998 + real(r8),intent(in) :: f2(nbin) ! eq 29 Abdul-Razzak et al 1998 + integer,intent(out) :: ierr + + integer :: imas,ibin,indx + character(len=*),parameter :: prefix = 'aerosol_properties::aero_props_init: ' + + real(r8), parameter :: spechygro_so4 = 0.507_r8 ! Sulfate hygroscopicity + real(r8), parameter :: spechygro_soa = 0.14_r8 ! SOA hygroscopicity + real(r8), parameter :: spechygro_pom = 0.1_r8 ! POM hygroscopicity + + ierr = 0 + + allocate(self%nspecies_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + allocate(self%nmasses_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + allocate(self%alogsig_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + allocate(self%f1_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + allocate(self%f2_(nbin),stat=ierr) + if( ierr /= 0 ) then + return + end if + + allocate( self%indexer_(nbin,0:maxval(nmasses)),stat=ierr ) + if( ierr /= 0 ) then + return + end if + + ! Local indexing compresses the mode and number/mass indices into one index. + ! This indexing is used by the pointer arrays used to reference state and pbuf + ! fields. We add number = 0, total mass = 1 (if available), and mass from each + ! constituency into mm. + + self%indexer_ = -1 + indx = 0 + + do ibin=1,nbin + do imas = 0,nmasses(ibin) + indx = indx+1 + self%indexer_(ibin,imas) = indx + end do + end do + + self%nbins_ = nbin + self%ncnst_tot_ = ncnst + self%nmasses_(:) = nmasses(:) + self%nspecies_(:) = nspec(:) + self%alogsig_(:) = alogsig(:) + self%f1_(:) = f1(:) + self%f2_(:) = f2(:) + + self%soa_equivso4_factor_ = spechygro_soa/spechygro_so4 + self%pom_equivso4_factor_ = spechygro_pom/spechygro_so4 + + end subroutine aero_props_init + + !------------------------------------------------------------------------------ + ! Object clean + !------------------------------------------------------------------------------ + subroutine aero_props_final(self) + class(aerosol_properties), intent(inout) :: self + + if (allocated(self%nspecies_)) then + deallocate(self%nspecies_) + end if + if (allocated(self%nmasses_)) then + deallocate(self%nmasses_) + end if + if (allocated(self%indexer_)) then + deallocate(self%indexer_) + endif + if (allocated(self%alogsig_)) then + deallocate(self%alogsig_) + endif + if (allocated(self%f1_)) then + deallocate(self%f1_) + endif + if (allocated(self%f2_)) then + deallocate(self%f2_) + endif + + self%nbins_ = 0 + self%ncnst_tot_ = 0 + + end subroutine aero_props_final + + !------------------------------------------------------------------------------ + ! returns number of species in a bin + !------------------------------------------------------------------------------ + pure function nspecies_per_bin(self,bin_ndx) result(val) + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer :: val + + val = self%nspecies_(bin_ndx) + end function nspecies_per_bin + + !------------------------------------------------------------------------------ + ! returns number of species for all bins + !------------------------------------------------------------------------------ + pure function nspecies_all_bins(self) result(arr) + class(aerosol_properties), intent(in) :: self + integer :: arr(self%nbins_) + + arr(:) = self%nspecies_(:) + + end function nspecies_all_bins + + !------------------------------------------------------------------------------ + ! returns number of species masses in a given bin number + !------------------------------------------------------------------------------ + pure function n_masses_per_bin(self,bin_ndx) result(val) + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer :: val + + val = self%nmasses_(bin_ndx) + end function n_masses_per_bin + + !------------------------------------------------------------------------------ + ! returns an array of number of species masses for all bins + !------------------------------------------------------------------------------ + pure function n_masses_all_bins(self) result(arr) + class(aerosol_properties), intent(in) :: self + integer :: arr(self%nbins_) + + arr(:) = self%nmasses_(:) + end function n_masses_all_bins + + !------------------------------------------------------------------------------ + ! returns a single index for given bin and species + !------------------------------------------------------------------------------ + pure integer function indexer(self,bin_ndx,species_ndx) + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + indexer = self%indexer_(bin_ndx,species_ndx) + end function indexer + + !------------------------------------------------------------------------------ + ! returns the total number of bins + !------------------------------------------------------------------------------ + pure function nbins_0list(self) result(nbins) + class(aerosol_properties), intent(in) :: self + integer :: nbins + + nbins = self%nbins_ + end function nbins_0list + + !------------------------------------------------------------------------------ + ! returns number of constituents (or elements) totaled across all bins + !------------------------------------------------------------------------------ + pure integer function ncnst_tot(self) + class(aerosol_properties), intent(in) :: self + + ncnst_tot = self%ncnst_tot_ + end function ncnst_tot + + !------------------------------------------------------------------------------ + ! returns the natural log of geometric standard deviation of the number distribution for aerosol bin + !------------------------------------------------------------------------------ + pure real(r8) function alogsig_0list(self, bin_ndx) + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + alogsig_0list = self%alogsig_(bin_ndx) + end function alogsig_0list + + !------------------------------------------------------------------------------ + ! returns maximum supersaturation + !------------------------------------------------------------------------------ + function maxsat(self, zeta,eta,smc) result(smax) + + !------------------------------------------------------------------------- + ! Calculates maximum supersaturation for multiple competing aerosols. + ! + ! Abdul-Razzak and Ghan, A parameterization of aerosol activation. + ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844., 2000 + !------------------------------------------------------------------------- + + class(aerosol_properties), intent(in) :: self + real(r8), intent(in) :: zeta(self%nbins_) ! Abdul-Razzak and Ghan eq 10 + real(r8), intent(in) :: eta(self%nbins_) ! Abdul-Razzak and Ghan eq 11 + real(r8), intent(in) :: smc(self%nbins_) ! critical supersaturation + + real(r8) :: smax ! maximum supersaturation + + integer :: m + integer :: nbins + real(r8) :: sum, g1, g2, g1sqrt, g2sqrt + + real(r8), parameter :: small_maxsat = 1.e-20_r8 ! for weak forcing + real(r8), parameter :: large_maxsat = 1.e20_r8 ! for small eta + + smax=0.0_r8 + nbins = self%nbins_ + + check_loop: do m=1,nbins + if((zeta(m) > 1.e5_r8*eta(m)) .or. (smc(m)*smc(m) > 1.e5_r8*eta(m))) then + ! weak forcing -- essentially none activated + smax=small_maxsat + else + ! significant activation of this mode -- calc activation all modes + exit check_loop + endif + ! No significant activation in any mode. Do nothing. + if (m == nbins) return + enddo check_loop + + sum=0.0_r8 + + do m=1,nbins + if(eta(m) > 1.e-20_r8)then + ! from Abdul-Razzak and Ghan 2000 + g1=zeta(m)/eta(m) + g1sqrt=sqrt(g1) + g1=g1sqrt*g1 + g2=smc(m)/sqrt(eta(m)+3._r8*zeta(m)) + g2sqrt=sqrt(g2) + g2=g2sqrt*g2 + sum=sum+(self%f1_(m)*g1+self%f2_(m)*g2)/(smc(m)*smc(m)) + else + sum=large_maxsat + endif + enddo + + smax=1._r8/sqrt(sum) + + end function maxsat + + !------------------------------------------------------------------------------ + ! returns the ratio of SOA Hygroscopicity / Sulfate Hygroscopicity + !------------------------------------------------------------------------------ + pure real(r8) function soa_equivso4_factor(self) + class(aerosol_properties), intent(in) :: self + + soa_equivso4_factor = self%soa_equivso4_factor_ + + end function soa_equivso4_factor + + !------------------------------------------------------------------------------ + ! returns the ratio of POM Hygroscopicity / Sulfate Hygroscopicity + !------------------------------------------------------------------------------ + pure real(r8) function pom_equivso4_factor(self) + class(aerosol_properties), intent(in) :: self + + pom_equivso4_factor = self%pom_equivso4_factor_ + + end function pom_equivso4_factor + +end module aerosol_properties_mod diff --git a/src/chemistry/aerosol/aerosol_state_mod.F90 b/src/chemistry/aerosol/aerosol_state_mod.F90 new file mode 100644 index 0000000000..363ce7ac99 --- /dev/null +++ b/src/chemistry/aerosol/aerosol_state_mod.F90 @@ -0,0 +1,964 @@ +module aerosol_state_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use aerosol_properties_mod, only: aerosol_properties, aero_name_len + use physconst, only: pi + + implicit none + + private + + public :: aerosol_state + public :: ptr2d_t + + !> aerosol_state defines the interface to the time-varying aerosol state + !! variables (e.g., mixing ratios, number concentrations). This includes the + !! aerosol portion of the overall model state. + !! + !! Each aerosol package (e.g., MAM, CARMA, etc) must extend the aerosol_state + !! class to allow access to the state information (transported and not transported) + !! of the aerosol package. Any package must implement each of the deferred + !! procedures of the abstract aerosol_state class, may include additional private + !! data members and type-bound procedures, and may override functions of the + !! abstract class. + !! + !! Please see the modal_aerosol_state module for an example of how the aerosol_state + !! class can be extended for a specific aerosol package. + type, abstract :: aerosol_state + contains + procedure(aero_get_transported), deferred :: get_transported + procedure(aero_set_transported), deferred :: set_transported + procedure(aero_get_amb_total_bin_mmr), deferred :: ambient_total_bin_mmr + procedure(aero_get_state_mmr), deferred :: get_ambient_mmr_0list + procedure(aero_get_list_mmr), deferred :: get_ambient_mmr_rlist + generic :: get_ambient_mmr=>get_ambient_mmr_0list,get_ambient_mmr_rlist + procedure(aero_get_state_mmr), deferred :: get_cldbrne_mmr + procedure(aero_get_state_num), deferred :: get_ambient_num + procedure(aero_get_state_num), deferred :: get_cldbrne_num + procedure(aero_get_states), deferred :: get_states + procedure(aero_update_bin), deferred :: update_bin + procedure :: loadaer + procedure(aero_icenuc_size_wght_arr), deferred :: icenuc_size_wght_arr + procedure(aero_icenuc_size_wght_val), deferred :: icenuc_size_wght_val + generic :: icenuc_size_wght => icenuc_size_wght_arr,icenuc_size_wght_val + procedure :: icenuc_type_wght_base + procedure :: icenuc_type_wght => icenuc_type_wght_base + procedure :: nuclice_get_numdens + procedure :: get_amb_species_numdens + procedure :: get_cld_species_numdens + procedure :: coated_frac + procedure :: mass_mean_radius + procedure :: watact_mfactor + procedure(aero_hetfrz_size_wght), deferred :: hetfrz_size_wght + procedure(aero_hygroscopicity), deferred :: hygroscopicity + procedure(aero_water_uptake), deferred :: water_uptake + procedure :: refractive_index_sw + procedure :: refractive_index_lw + procedure(aero_volume), deferred :: dry_volume + procedure(aero_volume), deferred :: wet_volume + procedure(aero_volume), deferred :: water_volume + procedure(aero_wet_diam), deferred :: wet_diameter + procedure :: convcld_actfrac + procedure :: sol_factb_interstitial + end type aerosol_state + + ! for state fields + type ptr2d_t + real(r8), pointer :: fld(:,:) + end type ptr2d_t + + real(r8), parameter :: per_cm3 = 1.e-6_r8 ! factor for m-3 to cm-3 conversions + real(r8), parameter :: per_m3 = 1.e6_r8 ! factor for cm-3 to m-3 conversions + real(r8), parameter :: kg2mug = 1.e9_r8 ! factor for kg to micrograms (mug) conversions + + abstract interface + + !------------------------------------------------------------------------ + ! Total aerosol mass mixing ratio for a bin in a given grid box location (column and layer) + !------------------------------------------------------------------------ + function aero_get_amb_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) result(mmr_tot) + import :: aerosol_state, aerosol_properties, r8 + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + + real(r8) :: mmr_tot ! mass mixing ratios totaled for all species + + end function aero_get_amb_total_bin_mmr + + !------------------------------------------------------------------------ + ! returns aerosol mass mixing ratio for a given species index and bin index + !------------------------------------------------------------------------ + subroutine aero_get_state_mmr(self, species_ndx, bin_ndx, mmr) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + end subroutine aero_get_state_mmr + + !------------------------------------------------------------------------ + ! returns aerosol mass mixing ratio for a given species index, bin index + ! and raditaion climate or diagnsotic list number + !------------------------------------------------------------------------ + subroutine aero_get_list_mmr(self, list_ndx, species_ndx, bin_ndx, mmr) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: list_ndx ! rad climate/diagnostic list index + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + end subroutine aero_get_list_mmr + + !------------------------------------------------------------------------ + ! returns aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------ + subroutine aero_get_state_num(self, bin_ndx, num) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: num(:,:) ! number densities (ncol,nlev) + end subroutine aero_get_state_num + + !------------------------------------------------------------------------ + ! returns interstitial and cloud-borne aerosol states + !------------------------------------------------------------------------ + subroutine aero_get_states( self, aero_props, raer, qqcw ) + import :: aerosol_state, aerosol_properties, ptr2d_t + + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props ! properties of the aerosol model + type(ptr2d_t), intent(out) :: raer(:) ! state of interstitial aerosols + type(ptr2d_t), intent(out) :: qqcw(:) ! state of cloud-borne aerosols + + end subroutine aero_get_states + + !------------------------------------------------------------------------------ + ! sets transported components + ! This updates the aerosol model state from the host transported aerosol constituents array. + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine aero_set_transported( self, transported_array ) + import :: aerosol_state, r8 + class(aerosol_state), intent(inout) :: self + real(r8), intent(in) :: transported_array(:,:,:) + end subroutine aero_set_transported + + !------------------------------------------------------------------------------ + ! returns transported components + ! This updates the transported aerosol constituent array to match the aerosol model state. + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine aero_get_transported( self, transported_array ) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + real(r8), intent(out) :: transported_array(:,:,:) + end subroutine aero_get_transported + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin + !------------------------------------------------------------------------------ + subroutine aero_icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_preexisting_ice, wght) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght(:,:) + + end subroutine aero_icenuc_size_wght_arr + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin, column and vertical layer + !------------------------------------------------------------------------------ + subroutine aero_icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, use_preexisting_ice, wght) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght + + end subroutine aero_icenuc_size_wght_val + + !------------------------------------------------------------------------------ + ! updates state and tendency + !------------------------------------------------------------------------------ + subroutine aero_update_bin( self, bin_ndx, col_ndx, lyr_ndx, delmmr_sum, delnum_sum, tnd_ndx, dtime, tend ) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + real(r8),intent(in) :: delmmr_sum ! mass mixing ratio change summed over all species in bin + real(r8),intent(in) :: delnum_sum ! number mixing ratio change summed over all species in bin + integer, intent(in) :: tnd_ndx ! tendency index + real(r8),intent(in) :: dtime ! time step size (sec) + real(r8),intent(inout) :: tend(:,:,:) ! tendency + + end subroutine aero_update_bin + + !------------------------------------------------------------------------------ + ! returns the volume-weighted fractions of aerosol subset `bin_ndx` that can act + ! as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function aero_hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + + real(r8) :: wght(ncol,nlev) + + end function aero_hetfrz_size_wght + + !------------------------------------------------------------------------------ + ! returns hygroscopicity for a given radiation diagnostic list number and + ! bin number + !------------------------------------------------------------------------------ + function aero_hygroscopicity(self, list_ndx, bin_ndx) result(kappa) + import :: aerosol_state, r8 + class(aerosol_state), intent(in) :: self + integer, intent(in) :: list_ndx ! rad climate/diagnostic list index + integer, intent(in) :: bin_ndx ! bin number + + real(r8), pointer :: kappa(:,:) ! hygroscopicity (ncol,nlev) + + end function aero_hygroscopicity + + !------------------------------------------------------------------------------ + ! returns aerosol wet diameter and aerosol water concentration for a given + ! radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + subroutine aero_water_uptake(self, aero_props, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat) + import :: aerosol_state, aerosol_properties, r8 + + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m) + real(r8),intent(out) :: qaerwat(ncol,nlev) ! aerosol water concentration (g/g) + + end subroutine aero_water_uptake + + !------------------------------------------------------------------------------ + ! aerosol volume interface + !------------------------------------------------------------------------------ + function aero_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + import :: aerosol_state, aerosol_properties, r8 + + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + end function aero_volume + + !------------------------------------------------------------------------------ + ! aerosol wet diameter + !------------------------------------------------------------------------------ + function aero_wet_diam(self, bin_idx, ncol, nlev) result(diam) + import :: aerosol_state, r8 + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: diam(ncol,nlev) + + end function aero_wet_diam + + end interface + +contains + + !------------------------------------------------------------------------------ + ! returns aerosol number, volume concentrations, and bulk hygroscopicity + !------------------------------------------------------------------------------ + subroutine loadaer( self, aero_props, istart, istop, k, m, cs, phase, & + naerosol, vaerosol, hygro, errnum, errstr, pom_hygro) + + use aerosol_properties_mod, only: aerosol_properties + + ! input arguments + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: istart ! start column index (1 <= istart <= istop <= pcols) + integer, intent(in) :: istop ! stop column index + integer, intent(in) :: k ! level index + integer, intent(in) :: m ! mode or bin index + real(r8), intent(in) :: cs(:,:) ! air density (kg/m3) + integer, intent(in) :: phase ! phase of aerosol: 1 for interstitial, 2 for cloud-borne, 3 for sum + + ! output arguments + real(r8), intent(out) :: naerosol(:) ! number conc (1/m3) + real(r8), intent(out) :: vaerosol(:) ! volume conc (m3/m3) + real(r8), intent(out) :: hygro(:) ! bulk hygroscopicity of mode + + integer , intent(out) :: errnum + character(len=*), intent(out) :: errstr + + real(r8), optional, intent(in) :: pom_hygro ! POM hygroscopicity override + + ! internal + real(r8), pointer :: raer(:,:) ! interstitial aerosol mass, number mixing ratios + real(r8), pointer :: qqcw(:,:) ! cloud-borne aerosol mass, number mixing ratios + real(r8) :: specdens, spechygro + character(len=aero_name_len) :: spectype + + real(r8) :: vol(istart:istop) ! aerosol volume mixing ratio + integer :: i, l + !------------------------------------------------------------------------------- + errnum = 0 + + do i = istart, istop + vaerosol(i) = 0._r8 + hygro(i) = 0._r8 + end do + + do l = 1, aero_props%nspecies(m) + + call self%get_ambient_mmr(l,m, raer) + call self%get_cldbrne_mmr(l,m, qqcw) + call aero_props%get(m,l, density=specdens, hygro=spechygro, spectype=spectype) + if (present(pom_hygro)) then + if (spectype=='p-organic'.and.pom_hygro>0._r8) then + spechygro=pom_hygro + endif + endif + + if (phase == 3) then + do i = istart, istop + vol(i) = max(raer(i,k) + qqcw(i,k), 0._r8)/specdens + end do + else if (phase == 2) then + do i = istart, istop + vol(i) = max(qqcw(i,k), 0._r8)/specdens + end do + else if (phase == 1) then + do i = istart, istop + vol(i) = max(raer(i,k), 0._r8)/specdens + end do + else + errnum = -1 + write(errstr,*)'phase = ',phase,' in aerosol_state::loadaer not recognized' + return + end if + + do i = istart, istop + vaerosol(i) = vaerosol(i) + vol(i) + hygro(i) = hygro(i) + vol(i)*spechygro + end do + + end do + + do i = istart, istop + if (vaerosol(i) > 1.0e-30_r8) then + hygro(i) = hygro(i)/(vaerosol(i)) + vaerosol(i) = vaerosol(i)*cs(i,k) + else + hygro(i) = 0.0_r8 + vaerosol(i) = 0.0_r8 + end if + end do + + ! aerosol number mixing ratios (#/kg) + call self%get_ambient_num(m, raer) + call self%get_cldbrne_num(m, qqcw) + if (phase == 3) then + do i = istart, istop + naerosol(i) = (raer(i,k) + qqcw(i,k))*cs(i,k) ! #/kg -> #/m3 + end do + else if (phase == 2) then + do i = istart, istop + naerosol(i) = qqcw(i,k)*cs(i,k) + end do + else + do i = istart, istop + naerosol(i) = raer(i,k)*cs(i,k) + end do + end if + + ! adjust number + call aero_props%apply_number_limits( naerosol, vaerosol, istart, istop, m ) + + end subroutine loadaer + + !------------------------------------------------------------------------------ + ! returns ambient aerosol number density for a given bin number and species type + !------------------------------------------------------------------------------ + subroutine get_amb_species_numdens(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, numdens) + use aerosol_properties_mod, only: aerosol_properties + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: numdens(:,:) ! species number densities (#/cm^3) + + real(r8), pointer :: num(:,:) + real(r8) :: type_wght(ncol,nlev) + real(r8) :: size_wght(ncol,nlev) + + size_wght = self%hetfrz_size_wght(bin_ndx, ncol, nlev) + + call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, type_wght) + + call self%get_ambient_num(bin_ndx, num) + + numdens(:ncol,:) = num(:ncol,:)*rho(:ncol,:)*type_wght(:ncol,:)*size_wght(:ncol,:)*per_cm3 + + end subroutine get_amb_species_numdens + + !------------------------------------------------------------------------------ + ! returns cloud-borne aerosol number density for a given bin number and species type + !------------------------------------------------------------------------------ + subroutine get_cld_species_numdens(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, numdens) + use aerosol_properties_mod, only: aerosol_properties + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: numdens(:,:) ! number densities (#/cm^3) + + real(r8), pointer :: num(:,:) + real(r8) :: type_wght(ncol,nlev) + real(r8) :: size_wght(ncol,nlev) + + size_wght = self%hetfrz_size_wght(bin_ndx, ncol, nlev) + + call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, type_wght, cloud_borne=.true.) + + call self%get_cldbrne_num(bin_ndx, num) + + numdens(:ncol,:) = num(:ncol,:)*rho(:ncol,:)*type_wght(:ncol,:)*size_wght(:ncol,:)*per_cm3 + + end subroutine get_cld_species_numdens + + !------------------------------------------------------------------------------ + ! returns aerosol type weights for a given aerosol type and bin + !------------------------------------------------------------------------------ + subroutine icenuc_type_wght_base(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne) + + use aerosol_properties_mod, only: aerosol_properties + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: wght(:,:) ! type weights + logical, optional, intent(in) :: cloud_borne ! if TRUE cloud-borne aerosols are used + ! otherwise ambient aerosols are used + + real(r8) :: mass(ncol,nlev) + real(r8) :: totalmass(ncol,nlev) + real(r8), pointer :: aer_bin(:,:) + + character(len=aero_name_len) :: spectype, sptype + integer :: ispc + logical :: cldbrne + + if (present(cloud_borne)) then + cldbrne = cloud_borne + else + cldbrne = .false. + end if + + wght(:,:) = 0._r8 + totalmass(:,:) = 0._r8 + mass(:,:) = 0._r8 + + if (species_type=='sulfate_strat') then + sptype = 'sulfate' + else + sptype = species_type + end if + + do ispc = 1, aero_props%nspecies(bin_ndx) + + if (cldbrne) then + call self%get_cldbrne_mmr(ispc, bin_ndx, aer_bin) + else + call self%get_ambient_mmr(ispc, bin_ndx, aer_bin) + end if + call aero_props%species_type(bin_ndx, ispc, spectype=spectype) + + totalmass(:ncol,:) = totalmass(:ncol,:) + aer_bin(:ncol,:)*rho(:ncol,:) + + if (trim(spectype) == trim(sptype)) then + mass(:ncol,:) = mass(:ncol,:) + aer_bin(:ncol,:)*rho(:ncol,:) + end if + + end do + + where (totalmass(:ncol,:) > 0._r8) + wght(:ncol,:) = mass(:ncol,:)/totalmass(:ncol,:) + end where + + end subroutine icenuc_type_wght_base + + !------------------------------------------------------------------------------ + subroutine nuclice_get_numdens(self, aero_props, use_preexisting_ice, ncol, nlev, rho, dust_num_col, sulf_num_col, soot_num_col, sulf_num_tot_col ) + + class(aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + + logical, intent(in) :: use_preexisting_ice + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: dust_num_col(:,:) ! dust number densities (#/cm^3) + real(r8), intent(out) :: sulf_num_col(:,:) ! sulfate number densities (#/cm^3) + real(r8), intent(out) :: soot_num_col(:,:) ! soot number densities (#/cm^3) + real(r8), intent(out) :: sulf_num_tot_col(:,:) ! stratopsheric sulfate number densities (#/cm^3) + + integer :: ibin,ispc + character(len=aero_name_len) :: spectype + real(r8) :: size_wghts(ncol,nlev) + real(r8) :: type_wghts(ncol,nlev) + + real(r8), pointer :: num_col(:,:) + + dust_num_col(:,:) = 0._r8 + sulf_num_col(:,:) = 0._r8 + soot_num_col(:,:) = 0._r8 + sulf_num_tot_col(:,:) = 0._r8 + + ! collect number densities (#/cm^3) for dust, sulfate, and soot + do ibin = 1,aero_props%nbins() + + call self%get_ambient_num(ibin, num_col) + + do ispc = 1,aero_props%nspecies(ibin) + + call aero_props%species_type(ibin, ispc, spectype) + + call self%icenuc_size_wght(ibin, ncol, nlev, spectype, use_preexisting_ice, size_wghts) + + call self%icenuc_type_wght(ibin, ncol, nlev, spectype, aero_props, rho, type_wghts) + + select case ( trim(spectype) ) + case('dust') + dust_num_col(:ncol,:) = dust_num_col(:ncol,:) & + + size_wghts(:ncol,:)*type_wghts(:ncol,:)*num_col(:ncol,:)*rho(:ncol,:)*per_cm3 + case('sulfate') + ! This order of ops gives bit-for-bit results for cam5 phys ( use_preexisting_ice = .false. ) + sulf_num_col(:ncol,:) = sulf_num_col(:ncol,:) & + + num_col(:ncol,:)*rho(:ncol,:)*per_cm3 * size_wghts(:ncol,:)*type_wghts(:ncol,:) + case('black-c') + soot_num_col(:ncol,:) = soot_num_col(:ncol,:) & + + size_wghts(:ncol,:)*type_wghts(:ncol,:)*num_col(:ncol,:)*rho(:ncol,:)*per_cm3 + end select + + enddo + + ! stratospheric sulfates -- special case not included in the species loop above + call self%icenuc_size_wght(ibin, ncol, nlev, 'sulfate_strat', use_preexisting_ice, size_wghts) + call self%icenuc_type_wght(ibin, ncol, nlev, 'sulfate_strat', aero_props, rho, type_wghts) + sulf_num_tot_col(:ncol,:) = sulf_num_tot_col(:ncol,:) & + + size_wghts(:ncol,:)*type_wghts(:ncol,:)*num_col(:ncol,:)*rho(:ncol,:)*per_cm3 + + enddo + + end subroutine nuclice_get_numdens + + !------------------------------------------------------------------------------ + ! returns the fraction of particle surface area of aerosol subset `bin_ndx` covered + ! by at least a monolayer of species `species_type` [0-1] + !------------------------------------------------------------------------------ + function coated_frac(self, bin_ndx, species_type, ncol, nlev, aero_props, radius) result(frac) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(in) :: species_type ! species type + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: radius(:,:) ! m + + real(r8) :: frac(ncol,nlev) ! coated fraction + + !------------coated variables-------------------- + real(r8), parameter :: n_so4_monolayers_dust = 1.0_r8 ! number of so4(+nh4) monolayers needed to coat a dust particle + real(r8), parameter :: dr_so4_monolayers_dust = n_so4_monolayers_dust * 4.76e-10_r8 + real(r8) :: vol_shell(ncol,nlev) + real(r8) :: vol_core(ncol,nlev) + real(r8) :: alnsg, fac_volsfc + real(r8) :: tmp1(ncol,nlev), tmp2(ncol,nlev) + real(r8),pointer :: sulf_mmr(:,:) + real(r8),pointer :: soa_mmr(:,:) + real(r8),pointer :: pom_mmr(:,:) + real(r8),pointer :: aer_mmr(:,:) + + integer :: sulf_ndx + integer :: soa_ndx + integer :: pom_ndx + integer :: species_ndx + + real(r8) :: specdens_so4 + real(r8) :: specdens_pom + real(r8) :: specdens_soa + real(r8) :: specdens + + character(len=aero_name_len) :: spectype + integer :: ispc + + frac = -huge(1._r8) + + sulf_ndx = -1 + pom_ndx = -1 + soa_ndx = -1 + species_ndx = -1 + + do ispc = 1, aero_props%nspecies(bin_ndx) + call aero_props%species_type(bin_ndx, ispc, spectype) + + select case ( trim(spectype) ) + case('sulfate') + sulf_ndx = ispc + case('p-organic') + pom_ndx = ispc + case('s-organic') + soa_ndx = ispc + end select + if (spectype==species_type) then + species_ndx = ispc + end if + end do + + vol_shell(:ncol,:) = 0._r8 + + if (sulf_ndx>0) then + call aero_props%get(bin_ndx, sulf_ndx, density=specdens_so4) + call self%get_ambient_mmr(sulf_ndx, bin_ndx, sulf_mmr) + vol_shell(:ncol,:) = vol_shell(:ncol,:) + sulf_mmr(:ncol,:)/specdens_so4 + end if + if (pom_ndx>0) then + call aero_props%get(bin_ndx, pom_ndx, density=specdens_pom) + call self%get_ambient_mmr(pom_ndx, bin_ndx, pom_mmr) + vol_shell(:ncol,:) = vol_shell(:ncol,:) + pom_mmr(:ncol,:)*aero_props%pom_equivso4_factor()/specdens_pom + end if + if (soa_ndx>0) then + call aero_props%get(bin_ndx, soa_ndx, density=specdens_soa) + call self%get_ambient_mmr(soa_ndx, bin_ndx, soa_mmr) + vol_shell(:ncol,:) = vol_shell(:ncol,:) + soa_mmr(:ncol,:)*aero_props%soa_equivso4_factor()/specdens_soa + end if + + call aero_props%get(bin_ndx, species_ndx, density=specdens) + call self%get_ambient_mmr(species_ndx, bin_ndx, aer_mmr) + vol_core(:ncol,:) = aer_mmr(:ncol,:)/specdens + + alnsg = aero_props%alogsig(bin_ndx) + fac_volsfc = exp(2.5_r8*alnsg**2) + + tmp1(:ncol,:) = vol_shell(:ncol,:)*(radius(:ncol,:)*2._r8)*fac_volsfc + tmp2(:ncol,:) = max(6.0_r8*dr_so4_monolayers_dust*vol_core(:ncol,:), 0.0_r8) + + where(tmp1(:ncol,:)>0._r8 .and. tmp2(:ncol,:)>0._r8) + frac(:ncol,:) = tmp1(:ncol,:)/tmp2(:ncol,:) + elsewhere + frac(:ncol,:) = 0.001_r8 + end where + + where(frac(:ncol,:)>1._r8) + frac(:ncol,:) = 1._r8 + end where + where(frac(:ncol,:) < 0.001_r8) + frac(:ncol,:) = 0.001_r8 + end where + + end function coated_frac + + !------------------------------------------------------------------------------ + ! returns the radius [m] of particles in aerosol subset `bin_ndx` assuming all particles are + ! the same size and only species `species_ndx` contributes to the particle volume + !------------------------------------------------------------------------------ + function mass_mean_radius(self, bin_ndx, species_ndx, ncol, nlev, aero_props, rho) result(radius) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + + real(r8) :: radius(ncol,nlev) ! m + + character(len=aero_name_len) :: species_type + real(r8) :: aer_numdens(ncol,nlev) ! kg/m3 + real(r8) :: aer_massdens(ncol,nlev) ! kg/m3 + real(r8),pointer :: aer_mmr(:,:) ! kg/kg + + real(r8) :: specdens,minrad + real(r8) :: wght(ncol,nlev) + integer :: i,k + + wght = self%hetfrz_size_wght(bin_ndx, ncol, nlev) + + call aero_props%species_type(bin_ndx, species_ndx, spectype=species_type) + + call aero_props%get(bin_ndx, species_ndx, density=specdens) ! kg/m3 + call self%get_ambient_mmr(species_ndx, bin_ndx, aer_mmr) ! kg/kg + call self%get_amb_species_numdens(bin_ndx, ncol, nlev, species_type, aero_props, rho, aer_numdens) ! #/cm3 + + aer_massdens(:ncol,:) = aer_mmr(:ncol,:)*rho(:ncol,:)*wght(:ncol,:) ! kg/m3 + + minrad = aero_props%min_mass_mean_rad(bin_ndx, species_ndx) + + do k = 1,nlev + do i = 1,ncol + if (aer_massdens(i,k)*1.0e-3_r8 > 1.0e-30_r8 .and. aer_numdens(i,k) > 1.0e-3_r8) then + radius(i,k) = (3._r8/(4*pi*specdens)*aer_massdens(i,k)/(aer_numdens(i,k)*per_m3))**(1._r8/3._r8) ! m + else + radius(i,k) = minrad + end if + end do + end do + + end function mass_mean_radius + + !------------------------------------------------------------------------------ + ! calculates water activity mass factor -- density*(1.-(OC+BC)/(OC+BC+SO4)) [mug m-3] + ! of species `species_type` in subset `bin_ndx` + !------------------------------------------------------------------------------ + subroutine watact_mfactor(self, bin_ndx, species_type, ncol, nlev, aero_props, rho, wact_factor) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(in) :: species_type ! species type + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: wact_factor(:,:) ! water activity factor -- density*(1.-(OC+BC)/(OC+BC+SO4)) [mug m-3] + + real(r8), pointer :: aer_mmr(:,:) + real(r8), pointer :: bin_num(:,:) + real(r8) :: tot2_mmr(ncol,nlev) + real(r8) :: tot1_mmr(ncol,nlev) + real(r8) :: aer_numdens(ncol,nlev) + integer :: ispc + character(len=aero_name_len) :: spectype + + real(r8) :: awcam(ncol,nlev) ! mass density [mug m-3] + real(r8) :: awfacm(ncol,nlev) ! mass factor ! (OC+BC)/(OC+BC+SO4) + + tot2_mmr = 0.0_r8 + tot1_mmr = 0.0_r8 + + if (aero_props%soluble(bin_ndx)) then + + do ispc = 1, aero_props%nspecies(bin_ndx) + + call aero_props%species_type(bin_ndx, ispc, spectype) + + if (trim(spectype)=='black-c' .or. trim(spectype)=='p-organic' .or. trim(spectype)=='s-organic') then + call self%get_ambient_mmr(ispc, bin_ndx, aer_mmr) + tot2_mmr(:ncol,:) = tot2_mmr(:ncol,:) + aer_mmr(:ncol,:) + end if + if (trim(spectype)=='sulfate') then + call self%get_ambient_mmr(ispc, bin_ndx, aer_mmr) + tot1_mmr(:ncol,:) = tot1_mmr(:ncol,:) + aer_mmr(:ncol,:) + end if + end do + + end if + + tot1_mmr(:ncol,:) = tot1_mmr(:ncol,:) + tot2_mmr(:ncol,:) + + call self%get_amb_species_numdens(bin_ndx, ncol, nlev, species_type, aero_props, rho, aer_numdens) ! #/cm3 + call self%get_ambient_num(bin_ndx, bin_num) ! #/kg + + where(bin_num(:ncol,:)>0._r8) + awcam(:ncol,:) = ((aer_numdens(:ncol,:)*per_m3/bin_num(:ncol,:)) * tot1_mmr(:ncol,:)) * kg2mug ! [mug m-3] + elsewhere + awcam(:ncol,:) = 0._r8 + end where + + where(tot1_mmr(:ncol,:)>0) + awfacm(:ncol,:) = tot2_mmr(:ncol,:) / tot1_mmr(:ncol,:) + elsewhere + awfacm(:ncol,:) = 0._r8 + end where + + wact_factor(:ncol,:) = awcam(:ncol,:)*(1._r8-awfacm(:ncol,:)) + + end subroutine watact_mfactor + + !------------------------------------------------------------------------------ + ! aerosol short wave refactive index + !------------------------------------------------------------------------------ + function refractive_index_sw(self, ncol, ilev, ilist, ibin, iwav, aero_props) result(crefin) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: ncol ! number of columes + integer, intent(in) :: ilev ! level index + integer, intent(in) :: ilist ! radiation diagnostics list index + integer, intent(in) :: ibin ! bin index + integer, intent(in) :: iwav ! wave length index + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + + complex(r8) :: crefin(ncol) ! complex refractive index + + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + complex(r8), pointer :: specrefindex(:) ! species refractive index + real(r8) :: specdens ! species density (kg/m3) + integer :: ispec, icol + real(r8) :: vol(ncol) + + crefin(:ncol) = (0._r8, 0._r8) + + do ispec = 1, aero_props%nspecies(ilist,ibin) + + call self%get_ambient_mmr(ilist,ispec,ibin,specmmr) + call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens, refindex_sw=specrefindex) + + do icol = 1, ncol + vol(icol) = specmmr(icol,ilev)/specdens + crefin(icol) = crefin(icol) + vol(icol)*specrefindex(iwav) + end do + end do + + end function refractive_index_sw + + !------------------------------------------------------------------------------ + ! aerosol long wave refactive index + !------------------------------------------------------------------------------ + function refractive_index_lw(self, ncol, ilev, ilist, ibin, iwav, aero_props) result(crefin) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: ncol ! number of columes + integer, intent(in) :: ilev ! level index + integer, intent(in) :: ilist ! radiation diagnostics list index + integer, intent(in) :: ibin ! bin index + integer, intent(in) :: iwav ! wave length index + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + + complex(r8) :: crefin(ncol) ! complex refractive index + + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + complex(r8), pointer :: specrefindex(:) ! species refractive index + real(r8) :: specdens ! species density (kg/m3) + integer :: ispec, icol + real(r8) :: vol(ncol) + + crefin(:ncol) = (0._r8, 0._r8) + + do ispec = 1, aero_props%nspecies(ilist,ibin) + + call self%get_ambient_mmr(ilist,ispec,ibin,specmmr) + call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens, refindex_lw=specrefindex) + + do icol = 1, ncol + vol(icol) = specmmr(icol,ilev)/specdens + crefin(icol) = crefin(icol) + vol(icol)*specrefindex(iwav) + end do + end do + + end function refractive_index_lw + + !------------------------------------------------------------------------------ + ! prescribed aerosol activation fraction for convective cloud + !------------------------------------------------------------------------------ + function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: ibin ! bin index + integer, intent(in) :: ispc ! species index + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + + real(r8) :: frac(ncol,nlev) + + frac = 0.8_r8 ! rce 2010/05/02 + + end function convcld_actfrac + + !------------------------------------------------------------------------------ + ! below cloud solubility factor for interstitial aerosols + !------------------------------------------------------------------------------ + function sol_factb_interstitial(self, bin_ndx, ncol, nlev, aero_props) result(sol_factb) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + + real(r8) :: sol_factb(ncol,nlev) + + real(r8), pointer :: aer_mmr(:,:) + real(r8) :: totmmr(ncol,nlev) + real(r8) :: solmmr(ncol,nlev) + integer :: ispc + character(len=aero_name_len) :: spectype + + sol_factb(:,:) = 0.0_r8 + + totmmr(:,:) = 0._r8 + solmmr(:,:) = 0._r8 + + do ispc = 1, aero_props%nspecies(bin_ndx) + + call aero_props%species_type(bin_ndx, ispc, spectype) + call self%get_ambient_mmr(ispc, bin_ndx, aer_mmr) + + totmmr(:ncol,:) = totmmr(:ncol,:) + aer_mmr(:ncol,:) + + if (trim(spectype) == 'sulfate') then + solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.5_r8 + end if + if (trim(spectype) == 'p-organic') then + solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.2_r8 + end if + if (trim(spectype) == 's-organic') then + solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.2_r8 + end if + if (trim(spectype) == 'dust') then + solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.1_r8 + end if + if (trim(spectype) == 'seasalt') then + solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.8_r8 + end if + + end do !nspec + + where ( totmmr > 0._r8 ) + sol_factb = solmmr/totmmr + end where + + where ( sol_factb > 0.8_r8 ) + sol_factb = 0.8_r8 + end where + where ( sol_factb < 0.1_r8 ) + sol_factb = 0.1_r8 + end where + + end function sol_factb_interstitial + + +end module aerosol_state_mod diff --git a/src/chemistry/aerosol/drydep_mod.F90 b/src/chemistry/aerosol/drydep_mod.F90 deleted file mode 100644 index 1e83641d71..0000000000 --- a/src/chemistry/aerosol/drydep_mod.F90 +++ /dev/null @@ -1,268 +0,0 @@ -module drydep_mod - - use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid - - ! Shared Data for dry deposition calculation. - - real(r8) rair ! Gas constant for dry air (J/K/kg) - real(r8) gravit ! Gravitational acceleration -! real(r8), allocatable :: phi(:) ! grid latitudes (radians)11 - -contains - -!############################################################################## - -! $Id$ - - subroutine inidrydep( xrair, xgravit) !, xphi ) - -! Initialize dry deposition parameterization. - - implicit none - -! Input arguments: - real(r8), intent(in) :: xrair ! Gas constant for dry air - real(r8), intent(in) :: xgravit ! Gravitational acceleration -! real(r8), intent(in) :: xphi(:) ! grid latitudes (radians) - -! Local variables: - integer i, j, ncid, vid, ns -!----------------------------------------------------------------------- -! ns = size(xphi) -! allocate(phi(ns)) - rair = xrair - gravit = xgravit -! do j = 1, ns -! phi(j) = xphi(j) -! end do - - return - end subroutine inidrydep - -!############################################################################## - - subroutine setdvel( ncol, landfrac, icefrac, ocnfrac, vgl, vgo, vgsi, vg ) - -! Set the deposition velocity depending on whether we are over -! land, ocean, and snow/ice - - - implicit none - -! Input arguments: - - integer, intent(in) :: ncol - real (r8), intent(in) :: landfrac(pcols) ! land fraction - real (r8), intent(in) :: icefrac(pcols) ! ice fraction - real (r8), intent(in) :: ocnfrac(pcols) ! ocean fraction - - real(r8), intent(in) :: vgl ! dry deposition velocity in m/s (land) - real(r8), intent(in) :: vgo ! dry deposition velocity in m/s (ocean) - real(r8), intent(in) :: vgsi ! dry deposition velocity in m/s (snow/ice) - -! Output arguments: - real(r8), intent(out) :: vg(pcols) ! dry deposition velocity in m/s - -! Local variables: - - integer i - real(r8) a - - - do i = 1, ncol - vg(i) = landfrac(i)*vgl + ocnfrac(i)*vgo + icefrac(i)*vgsi -! if (ioro(i).eq.0) then -! vg(i) = vgo -! else if (ioro(i).eq.1) then -! vg(i) = vgl -! else -! vg(i) = vgsi -! endif - end do - - return - end subroutine setdvel - -!############################################################################## - - subroutine ddflux( ncol, vg, q, p, tv, flux ) - -! Compute surface flux due to dry deposition processes. - - - implicit none - -! Input arguments: - integer , intent(in) :: ncol - real(r8), intent(in) :: vg(pcols) ! dry deposition velocity in m/s - real(r8), intent(in) :: q(pcols) ! tracer conc. in surface layer (kg tracer/kg moist air) - real(r8), intent(in) :: p(pcols) ! midpoint pressure in surface layer (Pa) - real(r8), intent(in) :: tv(pcols) ! midpoint virtual temperature in surface layer (K) - -! Output arguments: - - real(r8), intent(out) :: flux(pcols) ! flux due to dry deposition in kg/m^s/sec - -! Local variables: - - integer i - - do i = 1, ncol - flux(i) = -vg(i) * q(i) * p(i) /(tv(i) * rair) - end do - - return - end subroutine ddflux - -!------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: subroutine d3ddflux -! -! !INTERFACE: -! - subroutine d3ddflux ( ncol, vlc_dry, q,pmid,pdel, tv, dep_dry,dep_dry_tend,dt) -! Description: -!Do 3d- settling deposition calculations following Zender's dust codes, Dec 02. -! -! Author: Natalie Mahowald -! - implicit none - -! Input arguments: - integer , intent(in) :: ncol - real(r8), intent(in) :: vlc_dry(pcols,pver) ! dry deposition velocity in m/s - real(r8), intent(in) :: q(pcols,pver) ! tracer conc. in surface layer (kg tracer/kg moist air) - real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressure in surface layer (Pa) - real(r8), intent(in) :: pdel(pcols,pver) ! delta pressure across level (Pa) - real(r8), intent(in) :: tv(pcols,pver) ! midpoint virtual temperature in surface layer (K) - real(r8), intent(in) :: dt ! time step - -! Output arguments: - - real(r8), intent(out) :: dep_dry(pcols) ! flux due to dry deposition in kg /m^s/sec - real(r8), intent(out) :: dep_dry_tend(pcols,pver) ! flux due to dry deposition in kg /m^s/sec - -! Local variables: - - real(r8) :: flux(pcols,0:pver) ! downward flux at each level: kg/m2/s - integer i,k - do i=1,ncol - flux(i,0)=0._r8 - enddo - do k=1,pver - do i = 1, ncol - flux(i,k) = -min(vlc_dry(i,k) * q(i,k) * pmid(i,k) /(tv(i,k) * rair), & - q(i,k)*pdel(i,k)/gravit/dt) - dep_dry_tend(i,k)=(flux(i,k)-flux(i,k-1))/pdel(i,k)*gravit !kg/kg/s - - end do - enddo -! surface flux: - do i=1,ncol - dep_dry(i)=flux(i,pver) - enddo - return - end subroutine d3ddflux - - - -!------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: subroutine Calcram -! -! !INTERFACE: -! - - subroutine calcram(ncol,landfrac,icefrac,ocnfrac,obklen,& - ustar,ram1in,ram1,t,pmid,& - pdel,fvin,fv) - ! - ! !DESCRIPTION: - ! - ! Calc aerodynamic resistance over oceans and sea ice (comes in from land model) - ! from Seinfeld and Pandis, p.963. - ! - ! Author: Natalie Mahowald - ! - implicit none - integer, intent(in) :: ncol - real(r8),intent(in) :: ram1in(pcols) !aerodynamical resistance (s/m) - real(r8),intent(in) :: fvin(pcols) ! sfc frc vel from land - real(r8),intent(out) :: ram1(pcols) !aerodynamical resistance (s/m) - real(r8),intent(out) :: fv(pcols) ! sfc frc vel from land - real(r8), intent(in) :: obklen(pcols) ! obklen - real(r8), intent(in) :: ustar(pcols) ! sfc fric vel - real(r8), intent(in) :: landfrac(pcols) ! land fraction - real(r8), intent(in) :: icefrac(pcols) ! ice fraction - real(r8), intent(in) :: ocnfrac(pcols) ! ocean fraction - real(r8), intent(in) :: t(pcols) !atm temperature (K) - real(r8), intent(in) :: pmid(pcols) !atm pressure (Pa) - real(r8), intent(in) :: pdel(pcols) !atm pressure (Pa) - real(r8), parameter :: zzocen = 0.0001_r8 ! Ocean aerodynamic roughness length - real(r8), parameter :: zzsice = 0.0400_r8 ! Sea ice aerodynamic roughness length - real(r8), parameter :: xkar = 0.4_r8 ! Von Karman constant - - ! local variables - real(r8) :: z,psi,psi0,nu,nu0,temp,ram - integer :: i - ! write(iulog,*) rair,zzsice,zzocen,gravit,xkar - - - do i=1,ncol - z=pdel(i)*rair*t(i)/pmid(i)/gravit/2.0_r8 !use half the layer height like Ganzefeld and Lelieveld, 1995 - if(obklen(i).eq.0) then - psi=0._r8 - psi0=0._r8 - else - psi=min(max(z/obklen(i),-1.0_r8),1.0_r8) - psi0=min(max(zzocen/obklen(i),-1.0_r8),1.0_r8) - endif - temp=z/zzocen - if(icefrac(i) > 0.5_r8) then - if(obklen(i).gt.0) then - psi0=min(max(zzsice/obklen(i),-1.0_r8),1.0_r8) - else - psi0=0.0_r8 - endif - temp=z/zzsice - endif - if(psi> 0._r8) then - ram=1/xkar/ustar(i)*(log(temp)+4.7_r8*(psi-psi0)) - else - nu=(1.00_r8-15.000_r8*psi)**(.25_r8) - nu0=(1.000_r8-15.000_r8*psi0)**(.25_r8) - if(ustar(i).ne.0._r8) then - ram=1/xkar/ustar(i)*(log(temp) & - +log(((nu0**2+1.00_r8)*(nu0+1.0_r8)**2)/((nu**2+1.0_r8)*(nu+1.00_r8)**2)) & - +2.0_r8*(atan(nu)-atan(nu0))) - else - ram=0._r8 - endif - endif - if(landfrac(i) < 0.000000001_r8) then - fv(i)=ustar(i) - ram1(i)=ram - else - fv(i)=fvin(i) - ram1(i)=ram1in(i) - endif - ! write(iulog,*) i,pdel(i),t(i),pmid(i),gravit,obklen(i),psi,psi0,icefrac(i),nu,nu0,ram,ustar(i),& - ! log(((nu0**2+1.00)*(nu0+1.0)**2)/((nu**2+1.0)*(nu+1.00)**2)),2.0*(atan(nu)-atan(nu0)) - - enddo - - ! fvitt -- fv == 0 causes a floating point exception in - ! dry dep of sea salts and dust - where ( fv(:ncol) == 0._r8 ) - fv(:ncol) = 1.e-12_r8 - endwhere - - return - end subroutine calcram - - -!############################################################################## -end module drydep_mod diff --git a/src/chemistry/modal_aero/modal_aero_data.F90 b/src/chemistry/aerosol/modal_aero_data.F90 similarity index 96% rename from src/chemistry/modal_aero/modal_aero_data.F90 rename to src/chemistry/aerosol/modal_aero_data.F90 index 2a503f53e9..15b247584d 100644 --- a/src/chemistry/modal_aero/modal_aero_data.F90 +++ b/src/chemistry/aerosol/modal_aero_data.F90 @@ -16,7 +16,7 @@ module modal_aero_data use spmd_utils, only: masterproc use ppgrid, only: pcols, pver, begchunk, endchunk use mo_tracname, only: solsym - use chem_mods, only: gas_pcnst + use chem_mods, only: gas_pcnst use radconstants, only: nswbands, nlwbands use shr_const_mod, only: pi => shr_const_pi use rad_constituents,only: rad_cnst_get_info, rad_cnst_get_aer_props, rad_cnst_get_mode_props @@ -40,7 +40,7 @@ module modal_aero_data ! ! definitions for aerosol chemical components ! - + real(r8), public, protected, allocatable :: specmw_amode(:,:) character(len=16), public, protected, allocatable :: modename_amode(:) @@ -59,7 +59,7 @@ module modal_aero_data real(r8), public, protected, allocatable :: dgnumlo_amode(:) real(r8), public, protected, allocatable :: dgnumhi_amode(:) integer, public, protected, allocatable :: mode_size_order(:) - + ! input sigmag_amode real(r8), public, protected, allocatable :: sigmag_amode(:) @@ -98,7 +98,7 @@ module modal_aero_data modeptr_ufine, modeptr_coarse, & modeptr_pcarbon, & modeptr_finedust, modeptr_fineseas, & - modeptr_coardust, modeptr_coarseas + modeptr_coardust, modeptr_coarseas, modeptr_stracoar !2D lptr variables added by RCE to access speciated species integer, public, protected, allocatable :: & @@ -140,7 +140,7 @@ module modal_aero_data real(r8) :: qneg3_worst_thresh_amode(pcnst) integer :: qqcw(pcnst)=-1 ! Remaps modal_aero indices into pbuf - + logical :: convproc_do_aer logical :: cam_do_aero_conv = .true. contains @@ -250,7 +250,7 @@ subroutine modal_aero_data_reg if (xname_massptr(l,m)(:3) == 'so4') nSO4=nSO4+1 enddo enddo - + allocate( & lmassptr_amode( nspec_max, ntot_amode ),& lmassptrcw_amode( nspec_max, ntot_amode ),& @@ -428,7 +428,7 @@ subroutine modal_aero_data_init(pbuf2d) dgnumhi=dgnumhi_amode(m), rhcrystal=rhcrystal_amode(m), rhdeliques=rhdeliques_amode(m)) mode_size_order(m) = m - + ! compute frequently used parameters: ln(sigmag), ! volume-to-number and volume-to-surface conversions, ... alnsg_amode(m) = log( sigmag_amode(m) ) @@ -455,11 +455,11 @@ subroutine modal_aero_data_init(pbuf2d) endif enddo enddo - + lptr2_soa_g_amode(:) = -1 soa_ndx = 0 do i = 1, pcnst - if (cnst_name(i)(:4) == 'SOAG') then + if (cnst_name(i)(:4) == 'SOAG' .and. cnst_name(i)(:5) /= 'SOAGX') then soa_ndx = soa_ndx+1 lptr2_soa_g_amode(soa_ndx) = i endif @@ -467,7 +467,7 @@ subroutine modal_aero_data_init(pbuf2d) if (.not.any(lptr2_soa_g_amode>0)) call endrun('modal_aero_data_init: lptr2_soa_g_amode is not set properly') ! Properties of mode specie types. - ! values from Koepke, Hess, Schult and Shettle, Global Aerosol Data Set + ! values from Koepke, Hess, Schult and Shettle, Global Aerosol Data Set ! Report #243, Max-Planck Institute for Meteorology, 1997a ! See also Hess, Koepke and Schult, Optical Properties of Aerosols and Clouds (OPAC) ! BAMS, 1998. @@ -493,31 +493,8 @@ subroutine modal_aero_data_init(pbuf2d) density_aer=specdens_amode(l,m), & hygro_aer=spechygro(l,m) ) - if ( soa_multi_species ) then - ! Molecular weight for the species - specmw_amode(l,m) = cnst_mw(qArrIndex) - else ! the follow preserves the molecular weights historically used in MAM - call rad_cnst_get_info(0, m, l, spec_type=spec_type ) - select case( spec_type ) - case('sulfate') - if (ntot_amode==7) then - specmw_amode(l,m) = 96._r8 - else - specmw_amode(l,m) = 115._r8 - endif - case('ammonium') - specmw_amode(l,m) = 18._r8 - case('p-organic','s-organic','black-c') - specmw_amode(l,m) = 12._r8 - case('seasalt') - specmw_amode(l,m) = 58.5_r8 - case('dust') - specmw_amode(l,m) = 135._r8 - case default - call endrun('modal_aero_data_init: species type not recognized: '//trim(spec_type)) - end select - endif - + specmw_amode(l,m) = cnst_mw(qArrIndex) + if(masterproc) then write(iulog,9212) ' name : ', cnst_name(qArrIndex) write(iulog,9213) ' density, MW : ', specdens_amode(l,m), specmw_amode(l,m) @@ -553,7 +530,7 @@ subroutine modal_aero_data_init(pbuf2d) ! set threshold for reporting negatives from subr qneg3 ! for aerosol number species set this to ! 1e3 #/kg ~= 1e-3 #/cm3 for accum, aitken, pcarbon, ufine modes - ! 3e1 #/kg ~= 3e-5 #/cm3 for fineseas and finedust modes + ! 3e1 #/kg ~= 3e-5 #/cm3 for fineseas and finedust modes ! 1e0 #/kg ~= 1e-6 #/cm3 for other modes which are coarse ! for other species, set this to zero so that it will be ignored ! by qneg3 @@ -606,7 +583,7 @@ end subroutine modal_aero_data_init !-------------------------------------------------------------- subroutine qqcw_set_ptr(index, iptr) use cam_abortutils, only : endrun - + integer, intent(in) :: index, iptr @@ -633,13 +610,13 @@ function qqcw_get_field(pbuf, index, lchnk, errorhandle) nullify(qqcw_get_field) error = .false. if (index>0 .and. index <= pcnst) then - if (qqcw(index)>0) then + if (qqcw(index)>0) then call pbuf_get_field(pbuf, qqcw(index), qqcw_get_field) else error = .true. endif else - error = .true. + error = .true. end if if (error .and. .not. present(errorhandle)) then @@ -828,7 +805,7 @@ subroutine search_list_of_names( & character(len=*), intent(in):: name_to_find, list_of_names(:) integer, intent(in) :: list_length integer, intent(out) :: name_id - + integer :: i name_id = -999888777 if (name_to_find .ne. ' ') then @@ -873,6 +850,8 @@ subroutine initaermodes_setspecptrs modeptr_finedust = init_val modeptr_coarseas = init_val modeptr_coardust = init_val + modeptr_stracoar = init_val + do m = 1, ntot_amode if (modename_amode(m) .eq. 'accum') then modeptr_accum = m @@ -892,6 +871,8 @@ subroutine initaermodes_setspecptrs modeptr_coarseas = m else if (modename_amode(m) .eq. 'coarse_dust') then modeptr_coardust = m + else if (modename_amode(m) .eq. 'coarse_strat') then + modeptr_stracoar = m end if end do @@ -981,7 +962,7 @@ subroutine initaermodes_setspecptrs dumname = trim(adjustl(xname_massptr(l,m))) tmpch3 = trim(adjustl(dumname(:3))) if(trim(adjustl(tmpch3)) == 'so4' .or. trim(adjustl(tmpch3)) == 'SO4') then - specmw_so4_amode = specmw_amode(l,m) + specmw_so4_amode = specmw_amode(l,m) endif enddo enddo @@ -1000,7 +981,8 @@ subroutine initaermodes_setspecptrs write(iulog,*) 'modeptr_finedust =', modeptr_finedust write(iulog,*) 'modeptr_coarseas =', modeptr_coarseas write(iulog,*) 'modeptr_coardust =', modeptr_coardust - + write(iulog,*) 'modeptr_stracoar =', modeptr_stracoar + dumname = 'none' write(iulog,9240) write(iulog,9000) 'sulfate ' @@ -1049,7 +1031,7 @@ subroutine initaermodes_setspecptrs write(iulog,'(i4,2x,i12,2x,a,20x,a,i2.2,a)') i, l, cnst_name(l), 'lptr2_soa', i, '_g' end do - write(iulog,9000) 'black-c ' + write(iulog,9000) 'black-c ' do m = 1, ntot_amode do i = 1, nbc write(dumname,'(a,i2.2)') 'bc', i @@ -1206,5 +1188,3 @@ subroutine initaermodes_set_cnstnamecw end subroutine initaermodes_set_cnstnamecw end module modal_aero_data - - diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 new file mode 100644 index 0000000000..828b54ed99 --- /dev/null +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -0,0 +1,1044 @@ +module modal_aerosol_properties_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use physconst, only: pi + use aerosol_properties_mod, only: aerosol_properties, aero_name_len + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_props, rad_cnst_get_aer_props + + implicit none + + private + + public :: modal_aerosol_properties + + type, extends(aerosol_properties) :: modal_aerosol_properties + private + real(r8), allocatable :: exp45logsig_(:) + real(r8), allocatable :: voltonumblo_(:) + real(r8), allocatable :: voltonumbhi_(:) + integer, allocatable :: sulfate_mode_ndxs_(:) + integer, allocatable :: dust_mode_ndxs_(:) + integer, allocatable :: ssalt_mode_ndxs_(:) + integer, allocatable :: ammon_mode_ndxs_(:) + integer, allocatable :: nitrate_mode_ndxs_(:) + integer, allocatable :: msa_mode_ndxs_(:) + integer, allocatable :: bcarbon_mode_ndxs_(:,:) + integer, allocatable :: porganic_mode_ndxs_(:,:) + integer, allocatable :: sorganic_mode_ndxs_(:,:) + integer :: num_soa_ = 0 + integer :: num_poa_ = 0 + integer :: num_bc_ = 0 + contains + procedure :: number_transported + procedure :: get + procedure :: amcube + procedure :: actfracs + procedure :: num_names + procedure :: mmr_names + procedure :: amb_num_name + procedure :: amb_mmr_name + procedure :: species_type + procedure :: icenuc_updates_num + procedure :: icenuc_updates_mmr + procedure :: apply_number_limits + procedure :: hetfrz_species + procedure :: optics_params + procedure :: nbins_rlist + procedure :: nspecies_per_bin_rlist + procedure :: alogsig_rlist + procedure :: soluble + procedure :: min_mass_mean_rad + procedure :: bin_name + procedure :: scav_diam + procedure :: resuspension_resize + procedure :: rebin_bulk_fluxes + procedure :: hydrophilic + + final :: destructor + end type modal_aerosol_properties + + interface modal_aerosol_properties + procedure :: constructor + end interface modal_aerosol_properties + + logical, parameter :: debug = .false. + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor() result(newobj) + + type(modal_aerosol_properties), pointer :: newobj + + integer :: l, m, nmodes, ncnst_tot, mm + real(r8) :: dgnumlo + real(r8) :: dgnumhi + integer,allocatable :: nspecies(:) + real(r8),allocatable :: sigmag(:) + real(r8),allocatable :: alogsig(:) + real(r8),allocatable :: f1(:) + real(r8),allocatable :: f2(:) + integer :: ierr + + character(len=aero_name_len) :: spectype + + integer :: npoa, nsoa, nbc + + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + call rad_cnst_get_info(0, nmodes=nmodes) + + allocate(nspecies(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(alogsig(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate( f1(nmodes),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate( f2(nmodes),stat=ierr ) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + allocate(sigmag(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%exp45logsig_(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%voltonumblo_(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%voltonumbhi_(nmodes),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + ncnst_tot = 0 + + do m = 1, nmodes + call rad_cnst_get_info(0, m, nspec=nspecies(m)) + + ncnst_tot = ncnst_tot + nspecies(m) + 1 + + call rad_cnst_get_mode_props(0, m, sigmag=sigmag(m), & + dgnumhi=dgnumhi, dgnumlo=dgnumlo ) + + alogsig(m) = log(sigmag(m)) + + newobj%exp45logsig_(m) = exp(4.5_r8*alogsig(m)*alogsig(m)) + + f1(m) = 0.5_r8*exp(2.5_r8*alogsig(m)*alogsig(m)) + f2(m) = 1._r8 + 0.25_r8*alogsig(m) + + newobj%voltonumblo_(m) = 1._r8 / ( (pi/6._r8)* & + (dgnumlo**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) ) + newobj%voltonumbhi_(m) = 1._r8 / ( (pi/6._r8)* & + (dgnumhi**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) ) + + end do + + call newobj%initialize(nmodes,ncnst_tot,nspecies,nspecies,alogsig,f1,f2,ierr) + + npoa = 0 + nsoa = 0 + nbc = 0 + + m = 1 + do l = 1,newobj%nspecies(m) + mm = newobj%indexer(m,l) + call newobj%species_type(m, l, spectype) + select case ( trim(spectype) ) + case('p-organic') + npoa = npoa + 1 + case('s-organic') + nsoa = nsoa + 1 + case('black-c') + nbc = nbc + 1 + end select + end do + + newobj%num_soa_ = nsoa + newobj%num_poa_ = npoa + newobj%num_bc_ = nbc + + allocate(newobj%sulfate_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%dust_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%ssalt_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%ammon_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%nitrate_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%msa_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + newobj%sulfate_mode_ndxs_ = 0 + newobj%dust_mode_ndxs_ = 0 + newobj%ssalt_mode_ndxs_ = 0 + newobj%ammon_mode_ndxs_ = 0 + newobj%nitrate_mode_ndxs_ = 0 + newobj%msa_mode_ndxs_ = 0 + + allocate(newobj%porganic_mode_ndxs_(newobj%nbins(),npoa),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%sorganic_mode_ndxs_(newobj%nbins(),nsoa),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%bcarbon_mode_ndxs_(newobj%nbins(),nbc),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + newobj%porganic_mode_ndxs_ = 0._r8 + newobj%sorganic_mode_ndxs_ = 0._r8 + newobj%bcarbon_mode_ndxs_ = 0._r8 + + do m = 1,newobj%nbins() + npoa = 0 + nsoa = 0 + nbc = 0 + + do l = 1,newobj%nspecies(m) + mm = newobj%indexer(m,l) + call newobj%species_type(m, l, spectype) + + select case ( trim(spectype) ) + case('sulfate') + newobj%sulfate_mode_ndxs_(m) = mm + case('dust') + newobj%dust_mode_ndxs_(m) = mm + case('nitrate') + newobj%nitrate_mode_ndxs_(m) = mm + case('ammonium') + newobj%ammon_mode_ndxs_(m) = mm + case('seasalt') + newobj%ssalt_mode_ndxs_(m) = mm + case('msa') + newobj%msa_mode_ndxs_(m) = mm + case('p-organic') + npoa = npoa + 1 + newobj%porganic_mode_ndxs_(m,npoa) = mm + case('s-organic') + nsoa = nsoa + 1 + newobj%sorganic_mode_ndxs_(m,nsoa) = mm + case('black-c') + nbc = nbc + 1 + newobj%bcarbon_mode_ndxs_(m,nbc) = mm + end select + + end do + end do + + if( ierr /= 0 ) then + nullify(newobj) + return + end if + deallocate(nspecies) + deallocate(alogsig) + deallocate(sigmag) + deallocate(f1) + deallocate(f2) + + end function constructor + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + type(modal_aerosol_properties), intent(inout) :: self + + if (allocated(self%exp45logsig_)) then + deallocate(self%exp45logsig_) + end if + if (allocated(self%voltonumblo_)) then + deallocate(self%voltonumblo_) + end if + if (allocated(self%voltonumbhi_)) then + deallocate(self%voltonumbhi_) + end if + + if (allocated(self%sulfate_mode_ndxs_)) then + deallocate(self%sulfate_mode_ndxs_) + end if + if (allocated(self%dust_mode_ndxs_)) then + deallocate(self%dust_mode_ndxs_) + end if + if (allocated(self%ssalt_mode_ndxs_)) then + deallocate(self%ssalt_mode_ndxs_) + end if + if (allocated(self%ammon_mode_ndxs_)) then + deallocate(self%ammon_mode_ndxs_) + end if + if (allocated(self%nitrate_mode_ndxs_)) then + deallocate(self%nitrate_mode_ndxs_) + end if + if (allocated(self%msa_mode_ndxs_)) then + deallocate(self%msa_mode_ndxs_) + end if + if (allocated(self%porganic_mode_ndxs_)) then + deallocate(self%porganic_mode_ndxs_) + end if + if (allocated(self%sorganic_mode_ndxs_)) then + deallocate(self%sorganic_mode_ndxs_) + end if + if (allocated(self%bcarbon_mode_ndxs_)) then + deallocate(self%bcarbon_mode_ndxs_) + end if + + call self%final() + + end subroutine destructor + + !------------------------------------------------------------------------------ + ! returns number of transported aerosol constituents + !------------------------------------------------------------------------------ + integer function number_transported(self) + class(modal_aerosol_properties), intent(in) :: self + ! to be implemented later + number_transported = -1 + end function number_transported + + !------------------------------------------------------------------------ + ! returns aerosol properties: + ! 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, specname, specmorph, refindex_sw, refindex_lw) + + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: species_ndx ! species index + integer, optional, intent(in) :: list_ndx ! climate or a diagnostic list number + 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 + + integer :: ilist + + if (present(list_ndx)) then + ilist = list_ndx + else + ilist = 0 + end if + + call rad_cnst_get_aer_props(ilist, bin_ndx, species_ndx, & + 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 + + end subroutine get + + !------------------------------------------------------------------------ + ! returns optics type and table parameters + !------------------------------------------------------------------------ + subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, asmpsw, absplw, & + refrtabsw, refitabsw, refrtablw, refitablw, ncoef, prefr, prefi, sw_hygro_ext_wtp, & + sw_hygro_ssa_wtp, sw_hygro_asm_wtp, lw_hygro_ext_wtp, wgtpct, nwtp, & + sw_hygro_coreshell_ext, sw_hygro_coreshell_ssa, sw_hygro_coreshell_asm, lw_hygro_coreshell_ext, & + corefrac, bcdust, kap, relh, nfrac, nbcdust, nkap, nrelh ) + + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: list_ndx ! rad climate/diags list + + character(len=*), optional, intent(out) :: opticstype + + ! refactive index table parameters + real(r8), optional, pointer :: extpsw(:,:,:,:) ! short wave specific extinction + real(r8), optional, pointer :: abspsw(:,:,:,:) ! short wave specific absorption + real(r8), optional, pointer :: asmpsw(:,:,:,:) ! short wave asymmetry factor + real(r8), optional, pointer :: absplw(:,:,:,:) ! long wave specific absorption + real(r8), optional, pointer :: refrtabsw(:,:) ! table of short wave real refractive indices for aerosols + real(r8), optional, pointer :: refitabsw(:,:) ! table of short wave imaginary refractive indices for aerosols + real(r8), optional, pointer :: refrtablw(:,:) ! table of long wave real refractive indices for aerosols + real(r8), optional, pointer :: refitablw(:,:) ! table of long wave imaginary refractive indices for aerosols + integer, optional, intent(out) :: ncoef ! number of chebychev polynomials + integer, optional, intent(out) :: prefr ! number of real refractive indices in table + integer, optional, intent(out) :: prefi ! number of imaginary refractive indices in table + + ! hygrowghtpct table parameters + real(r8), optional, pointer :: sw_hygro_ext_wtp(:,:) ! short wave extinction table + real(r8), optional, pointer :: sw_hygro_ssa_wtp(:,:) ! short wave single-scatter albedo table + real(r8), optional, pointer :: sw_hygro_asm_wtp(:,:) ! short wave asymmetry table + real(r8), optional, pointer :: lw_hygro_ext_wtp(:,:) ! long wave absorption table + real(r8), optional, pointer :: wgtpct(:) ! weight precent of H2SO4/H2O solution + integer, optional, intent(out) :: nwtp ! number of weight precent values + + ! hygrocoreshell table parameters + real(r8), optional, pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) ! short wave extinction table + real(r8), optional, pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:) ! short wave single-scatter albedo table + real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) ! short wave asymmetry table + real(r8), optional, pointer :: lw_hygro_coreshell_ext(:,:,:,:,:) ! long wave absorption table + real(r8), optional, pointer :: corefrac(:) ! core fraction dimension values + real(r8), optional, pointer :: bcdust(:) ! bc/(bc + dust) fraction dimension values + real(r8), optional, pointer :: kap(:) ! hygroscopicity dimension values + real(r8), optional, pointer :: relh(:) ! relative humidity dimension values + integer, optional, intent(out) :: nfrac ! core fraction dimension size + integer, optional, intent(out) :: nbcdust ! bc/(bc + dust) fraction dimension size + integer, optional, intent(out) :: nkap ! hygroscopicity dimension size + integer, optional, intent(out) :: nrelh ! relative humidity dimension size + + ! refactive index table parameters + call rad_cnst_get_mode_props(list_ndx, bin_ndx, & + opticstype=opticstype, & + extpsw=extpsw, & + abspsw=abspsw, & + asmpsw=asmpsw, & + absplw=absplw, & + refrtabsw=refrtabsw, & + refitabsw=refitabsw, & + refrtablw=refrtablw, & + refitablw=refitablw, & + ncoef=ncoef, & + prefr=prefr, & + prefi=prefi) + + ! hygrowghtpct table parameters + if (present(sw_hygro_ext_wtp)) then + nullify(sw_hygro_ext_wtp) + end if + if (present(sw_hygro_ssa_wtp)) then + nullify(sw_hygro_ssa_wtp) + end if + if (present(sw_hygro_asm_wtp)) then + nullify(sw_hygro_asm_wtp) + end if + if (present(lw_hygro_ext_wtp)) then + nullify(lw_hygro_ext_wtp) + end if + if (present(wgtpct)) then + nullify(wgtpct) + end if + if (present(nwtp)) then + nwtp = -1 + end if + + ! hygrocoreshell table parameters + if (present(sw_hygro_coreshell_ext)) then + nullify(sw_hygro_coreshell_ext) + end if + if (present(sw_hygro_coreshell_ssa)) then + nullify(sw_hygro_coreshell_ssa) + end if + if (present(sw_hygro_coreshell_asm)) then + nullify(sw_hygro_coreshell_asm) + end if + if (present(lw_hygro_coreshell_ext)) then + nullify(lw_hygro_coreshell_ext) + end if + if (present(corefrac)) then + nullify(corefrac) + end if + if (present(bcdust)) then + nullify(bcdust) + end if + if (present(kap)) then + nullify(kap) + end if + if (present(relh)) then + nullify(relh) + end if + if (present(nfrac)) then + nfrac = -1 + end if + if (present(nbcdust)) then + nbcdust = -1 + end if + if (present(nkap)) then + nkap = -1 + end if + if (present(nrelh)) then + nrelh = -1 + end if + + end subroutine optics_params + + !------------------------------------------------------------------------------ + ! returns radius^3 (m3) of a given bin number + !------------------------------------------------------------------------------ + pure elemental real(r8) function amcube(self, bin_ndx, volconc, numconc) + + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + real(r8), intent(in) :: volconc ! volume conc (m3/m3) + real(r8), intent(in) :: numconc ! number conc (1/m3) + + amcube = (3._r8*volconc/(4._r8*pi*self%exp45logsig_(bin_ndx)*numconc)) + + end function amcube + + !------------------------------------------------------------------------------ + ! returns mass and number activation fractions + !------------------------------------------------------------------------------ + subroutine actfracs(self, bin_ndx, smc, smax, fn, fm ) + use shr_spfn_mod, only: erf => shr_spfn_erf + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8),intent(in) :: smc ! critical supersaturation for particles of bin radius + real(r8),intent(in) :: smax ! maximum supersaturation for multiple competing aerosols + real(r8),intent(out) :: fn ! activation fraction for aerosol number + real(r8),intent(out) :: fm ! activation fraction for aerosol mass + + real(r8) :: x,y + real(r8), parameter :: twothird = 2._r8/3._r8 + real(r8), parameter :: sq2 = sqrt(2._r8) + + x=twothird*(log(smc)-log(smax))/(sq2*self%alogsig(bin_ndx)) + y=x-1.5_r8*sq2*self%alogsig(bin_ndx) + + fn = 0.5_r8*(1._r8-erf(x)) + fm = 0.5_r8*(1._r8-erf(y)) + + end subroutine actfracs + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine num_names(self, bin_ndx, name_a, name_c) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol number dens + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol number dens + + call rad_cnst_get_info(0,bin_ndx, num_name=name_a, num_name_cw=name_c) + end subroutine num_names + + !------------------------------------------------------------------------ + ! returns constituents names of aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine mmr_names(self, bin_ndx, species_ndx, name_a, name_c) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol MMR + character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol MMR + + call rad_cnst_get_info(0, bin_ndx, species_ndx, spec_name=name_a, spec_name_cw=name_c) + end subroutine mmr_names + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol number mixing ratios + !------------------------------------------------------------------------ + subroutine amb_num_name(self, bin_ndx, name) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol number dens + + call rad_cnst_get_info(0,bin_ndx, num_name=name) + + end subroutine amb_num_name + + !------------------------------------------------------------------------ + ! returns constituent name of ambient aerosol mass mixing ratios + !------------------------------------------------------------------------ + subroutine amb_mmr_name(self, bin_ndx, species_ndx, name) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: name ! constituent name of ambient aerosol MMR + + call rad_cnst_get_info(0, bin_ndx, species_ndx, spec_name=name) + + end subroutine amb_mmr_name + + !------------------------------------------------------------------------ + ! returns species type + !------------------------------------------------------------------------ + subroutine species_type(self, bin_ndx, species_ndx, spectype) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + character(len=*), intent(out) :: spectype ! species type + + call rad_cnst_get_info(0, bin_ndx, species_ndx, spec_type=spectype) + + end subroutine species_type + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to given aerosol bin number + !------------------------------------------------------------------------------ + function icenuc_updates_num(self, bin_ndx) result(res) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + logical :: res + + character(len=aero_name_len) :: spectype + character(len=aero_name_len) :: modetype + integer :: spc_ndx + + res = .false. + + call rad_cnst_get_info(0, bin_ndx, mode_type=modetype) + if (.not.(modetype=='coarse' .or. modetype=='coarse_dust')) then + return + end if + + do spc_ndx = 1, self%nspecies(bin_ndx) + call self%species_type( bin_ndx, spc_ndx, spectype) + if (spectype=='dust') res = .true. + end do + + end function icenuc_updates_num + + !------------------------------------------------------------------------------ + ! returns TRUE if Ice Nucleation tendencies are applied to a given species within a bin + !------------------------------------------------------------------------------ + function icenuc_updates_mmr(self, bin_ndx, species_ndx) result(res) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + logical :: res + + character(len=32) :: spectype + character(len=32) :: modetype + + res = .false. + + if (species_ndx>0) then + + call rad_cnst_get_info(0, bin_ndx, mode_type=modetype) + if (.not.(modetype=='coarse' .or. modetype=='coarse_dust')) then + return + end if + + call self%species_type( bin_ndx, species_ndx, spectype) + if (spectype=='dust') res = .true. + end if + + end function icenuc_updates_mmr + + !------------------------------------------------------------------------------ + ! apply max / min to number concentration + !------------------------------------------------------------------------------ + subroutine apply_number_limits( self, naerosol, vaerosol, istart, istop, m ) + class(modal_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: naerosol(:) ! number conc (1/m3) + real(r8), intent(in) :: vaerosol(:) ! volume conc (m3/m3) + integer, intent(in) :: istart ! start column index (1 <= istart <= istop <= pcols) + integer, intent(in) :: istop ! stop column index + integer, intent(in) :: m ! mode or bin index + + integer :: i + + ! adjust number so that dgnumlo < dgnum < dgnumhi + ! -- the diameter falls within the lower and upper limits which are + ! represented by voltonumhi and voltonumblo values, respectively + do i = istart, istop + naerosol(i) = max(naerosol(i), vaerosol(i)*self%voltonumbhi_(m)) + naerosol(i) = min(naerosol(i), vaerosol(i)*self%voltonumblo_(m)) + end do + + end subroutine apply_number_limits + + !------------------------------------------------------------------------------ + ! returns TRUE if species `spc_ndx` in aerosol subset `bin_ndx` contributes to + ! the particles' ability to act as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function hetfrz_species(self, bin_ndx, spc_ndx) result(res) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: spc_ndx ! species number + + logical :: res + + character(len=aero_name_len) :: mode_name, species_type + + res = .false. + + call rad_cnst_get_info(0, bin_ndx, mode_type=mode_name) + + if ((trim(mode_name)/='aitken')) then + + call self%species_type(bin_ndx, spc_ndx, species_type) + + if ((trim(species_type)=='black-c').or.(trim(species_type)=='dust')) then + + res = .true. + + end if + + end if + + end function hetfrz_species + + !------------------------------------------------------------------------------ + ! returns TRUE if soluble + !------------------------------------------------------------------------------ + logical function soluble(self,bin_ndx) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + character(len=aero_name_len) :: mode_name + + call rad_cnst_get_info(0, bin_ndx, mode_type=mode_name) + + soluble = trim(mode_name)/='primary_carbon' + + end function soluble + + !------------------------------------------------------------------------------ + ! returns minimum mass mean radius (meters) + !------------------------------------------------------------------------------ + function min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: species_ndx ! species number + + real(r8) :: minrad ! meters + + integer :: nmodes + character(len=aero_name_len) :: species_type, mode_type + + call self%species_type(bin_ndx, species_ndx, spectype=species_type) + select case ( trim(species_type) ) + case('dust') + call rad_cnst_get_info(0, bin_ndx, mode_type=mode_type) + select case ( trim(mode_type) ) + case ('accum','fine_dust') + minrad = 0.258e-6_r8 + case ('coarse','coarse_dust') + minrad = 1.576e-6_r8 + case default + minrad = -huge(1._r8) + end select + case('black-c') + call rad_cnst_get_info(0, nmodes=nmodes) + if (nmodes==3) then + minrad = 0.04e-6_r8 + else + minrad = 0.067e-6_r8 ! from emission size + endif + case default + minrad = -huge(1._r8) + end select + + end function min_mass_mean_rad + + !------------------------------------------------------------------------------ + ! returns the total number of bins for a given radiation list index + !------------------------------------------------------------------------------ + function nbins_rlist(self, list_ndx) result(res) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + + integer :: res + + call rad_cnst_get_info(list_ndx, nmodes=res) + + end function nbins_rlist + + !------------------------------------------------------------------------------ + ! returns number of species in a bin for a given radiation list index + !------------------------------------------------------------------------------ + function nspecies_per_bin_rlist(self, list_ndx, bin_ndx) result(res) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + integer :: res + + call rad_cnst_get_info(list_ndx, bin_ndx, nspec=res) + + end function nspecies_per_bin_rlist + + !------------------------------------------------------------------------------ + ! returns the natural log of geometric standard deviation of the number + ! distribution for radiation list number and aerosol bin + !------------------------------------------------------------------------------ + function alogsig_rlist(self, list_ndx, bin_ndx) result(res) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: res + + real(r8) :: sig + + call rad_cnst_get_mode_props(list_ndx, bin_ndx, sigmag=sig) + res = log(sig) + + end function alogsig_rlist + + !------------------------------------------------------------------------------ + ! returns name for a given radiation list number and aerosol bin + !------------------------------------------------------------------------------ + function bin_name(self, list_ndx, bin_ndx) result(name) + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: list_ndx ! radiation list number + integer, intent(in) :: bin_ndx ! bin number + + character(len=32) name + + call rad_cnst_get_info(list_ndx, bin_ndx, mode_type=name) + + end function bin_name + + !------------------------------------------------------------------------------ + ! returns scavenging diameter (cm) for a given aerosol bin number + !------------------------------------------------------------------------------ + function scav_diam(self, bin_ndx) result(diam) + use modal_aero_data, only: dgnum_amode + + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: diam + + diam = dgnum_amode(bin_ndx) + + end function scav_diam + + !------------------------------------------------------------------------------ + ! adjust aerosol concentration tendencies to create larger sizes of aerosols + ! during resuspension + !------------------------------------------------------------------------------ + subroutine resuspension_resize(self, dcondt) + + use modal_aero_data, only: mode_size_order + + class(modal_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: dcondt(:) + + integer :: i + character(len=4) :: spcstr + + call accumulate_to_larger_mode( 'SO4', self%sulfate_mode_ndxs_, dcondt ) + call accumulate_to_larger_mode( 'DUST',self%dust_mode_ndxs_,dcondt ) + call accumulate_to_larger_mode( 'NACL',self%ssalt_mode_ndxs_,dcondt ) + call accumulate_to_larger_mode( 'MSA', self%msa_mode_ndxs_, dcondt ) + call accumulate_to_larger_mode( 'NH4', self%ammon_mode_ndxs_, dcondt ) + call accumulate_to_larger_mode( 'NO3', self%nitrate_mode_ndxs_, dcondt ) + + spcstr = ' ' + do i = 1,self%num_soa_ + write(spcstr,'(i4)') i + call accumulate_to_larger_mode( 'SOA'//adjustl(spcstr), self%sorganic_mode_ndxs_(:,i), dcondt ) + enddo + spcstr = ' ' + do i = 1,self%num_poa_ + write(spcstr,'(i4)') i + call accumulate_to_larger_mode( 'POM'//adjustl(spcstr), self%porganic_mode_ndxs_(:,i), dcondt ) + enddo + spcstr = ' ' + do i = 1,self%num_bc_ + write(spcstr,'(i4)') i + call accumulate_to_larger_mode( 'BC'//adjustl(spcstr), self%bcarbon_mode_ndxs_(:,i), dcondt ) + enddo + + contains + + !------------------------------------------------------------------------------ + subroutine accumulate_to_larger_mode( spc_name, lptr, prevap ) + + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + + character(len=*), intent(in) :: spc_name + integer, intent(in) :: lptr(:) + real(r8), intent(inout) :: prevap(:) + + integer :: m,n, nl,ns + + logical, parameter :: debug = .false. + + ! find constituent index of the largest mode for the species + loop1: do m = 1,self%nbins()-1 + nl = lptr(mode_size_order(m)) + if (nl>0) exit loop1 + end do loop1 + + if (.not. nl>0) return + + ! accumulate the smaller modes into the largest mode + do n = m+1,self%nbins() + ns = lptr(mode_size_order(n)) + if (ns>0) then + prevap(nl) = prevap(nl) + prevap(ns) + prevap(ns) = 0._r8 + if (masterproc .and. debug) then + write(iulog,'(a,i3,a,i3)') trim(spc_name)//' mode number accumulate ',ns,'->',nl + endif + endif + end do + + end subroutine accumulate_to_larger_mode + !------------------------------------------------------------------------------ + + end subroutine resuspension_resize + + !------------------------------------------------------------------------------ + ! 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/aerosol/modal_aerosol_state_mod.F90 b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 new file mode 100644 index 0000000000..819f20d1f0 --- /dev/null +++ b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 @@ -0,0 +1,687 @@ +module modal_aerosol_state_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_spfn_mod, only: erf => shr_spfn_erf + use aerosol_state_mod, only: aerosol_state, ptr2d_t + use rad_constituents, only: rad_cnst_get_aer_mmr, rad_cnst_get_mode_num, rad_cnst_get_info + use rad_constituents, only: rad_cnst_get_mode_props + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index + use physics_types, only: physics_state + use aerosol_properties_mod, only: aerosol_properties, aero_name_len + use physconst, only: rhoh2o + + implicit none + + private + + public :: modal_aerosol_state + + type, extends(aerosol_state) :: modal_aerosol_state + private + type(physics_state), pointer :: state => null() + type(physics_buffer_desc), pointer :: pbuf(:) => null() + contains + + procedure :: get_transported + procedure :: set_transported + procedure :: ambient_total_bin_mmr + procedure :: get_ambient_mmr_0list + procedure :: get_ambient_mmr_rlist + procedure :: get_cldbrne_mmr + procedure :: get_ambient_num + procedure :: get_cldbrne_num + procedure :: get_states + procedure :: icenuc_size_wght_arr + procedure :: icenuc_size_wght_val + procedure :: icenuc_type_wght + procedure :: update_bin + procedure :: hetfrz_size_wght + procedure :: hygroscopicity + procedure :: water_uptake + procedure :: dry_volume + procedure :: wet_volume + procedure :: water_volume + procedure :: wet_diameter + procedure :: convcld_actfrac + + final :: destructor + + end type modal_aerosol_state + + interface modal_aerosol_state + procedure :: constructor + end interface modal_aerosol_state + + real(r8), parameter :: rh2odens = 1._r8/rhoh2o + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(state,pbuf) result(newobj) + type(physics_state), target :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + type(modal_aerosol_state), pointer :: newobj + + integer :: ierr + + allocate(newobj,stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + newobj%state => state + newobj%pbuf => pbuf + + end function constructor + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + type(modal_aerosol_state), intent(inout) :: self + + nullify(self%state) + nullify(self%pbuf) + + end subroutine destructor + + !------------------------------------------------------------------------------ + ! sets transported components + ! This aerosol model with the state of the transported aerosol constituents + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine set_transported( self, transported_array ) + class(modal_aerosol_state), intent(inout) :: self + real(r8), intent(in) :: transported_array(:,:,:) + ! to be implemented later + end subroutine set_transported + + !------------------------------------------------------------------------------ + ! returns transported components + ! This returns to current state of the transported aerosol constituents + ! (mass mixing ratios or number mixing ratios) + !------------------------------------------------------------------------------ + subroutine get_transported( self, transported_array ) + class(modal_aerosol_state), intent(in) :: self + real(r8), intent(out) :: transported_array(:,:,:) + ! to be implemented later + end subroutine get_transported + + !------------------------------------------------------------------------ + ! Total aerosol mass mixing ratio for a bin in a given grid box location (column and layer) + !------------------------------------------------------------------------ + function ambient_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) result(mmr_tot) + class(modal_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: bin_ndx ! bin index + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + + real(r8) :: mmr_tot ! mass mixing ratios totaled for all species + real(r8),pointer :: mmrptr(:,:) + integer :: spec_ndx + + mmr_tot = 0._r8 + + do spec_ndx=1,aero_props%nspecies(bin_ndx) + call rad_cnst_get_aer_mmr(0, bin_ndx, spec_ndx, 'a', self%state, self%pbuf, mmrptr) + mmr_tot = mmr_tot + mmrptr(col_ndx,lyr_ndx) + end do + + end function ambient_total_bin_mmr + + !------------------------------------------------------------------------------ + ! returns ambient aerosol mass mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_ambient_mmr_0list(self, species_ndx, bin_ndx, mmr) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + + call rad_cnst_get_aer_mmr(0, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr) + end subroutine get_ambient_mmr_0list + + !------------------------------------------------------------------------------ + ! returns ambient aerosol mass mixing ratio for a given radiation diagnostics + ! list index, species index and bin index + !------------------------------------------------------------------------------ + subroutine get_ambient_mmr_rlist(self, list_ndx, species_ndx, bin_ndx, mmr) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: list_ndx ! rad climate list index + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + + call rad_cnst_get_aer_mmr(list_ndx, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr) + end subroutine get_ambient_mmr_rlist + + !------------------------------------------------------------------------------ + ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_cldbrne_mmr(self, species_ndx, bin_ndx, mmr) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: species_ndx ! species index + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev) + + call rad_cnst_get_aer_mmr(0, bin_ndx, species_ndx, 'c', self%state, self%pbuf, mmr) + end subroutine get_cldbrne_mmr + + !------------------------------------------------------------------------------ + ! returns ambient aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_ambient_num(self, bin_ndx, num) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: num(:,:) ! number densities + + call rad_cnst_get_mode_num(0, bin_ndx, 'a', self%state, self%pbuf, num) + end subroutine get_ambient_num + + !------------------------------------------------------------------------------ + ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index + !------------------------------------------------------------------------------ + subroutine get_cldbrne_num(self, bin_ndx, num) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin index + real(r8), pointer :: num(:,:) + + call rad_cnst_get_mode_num(0, bin_ndx, 'c', self%state, self%pbuf, num) + end subroutine get_cldbrne_num + + !------------------------------------------------------------------------------ + ! returns interstitial and cloud-borne aerosol states + !------------------------------------------------------------------------------ + subroutine get_states( self, aero_props, raer, qqcw ) + class(modal_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + type(ptr2d_t), intent(out) :: raer(:) + type(ptr2d_t), intent(out) :: qqcw(:) + + integer :: ibin,ispc, indx + + do ibin = 1, aero_props%nbins() + indx = aero_props%indexer(ibin, 0) + call self%get_ambient_num(ibin, raer(indx)%fld) + call self%get_cldbrne_num(ibin, qqcw(indx)%fld) + do ispc = 1, aero_props%nspecies(ibin) + indx = aero_props%indexer(ibin, ispc) + call self%get_ambient_mmr(ispc,ibin, raer(indx)%fld) + call self%get_cldbrne_mmr(ispc,ibin, qqcw(indx)%fld) + end do + end do + + end subroutine get_states + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin + !------------------------------------------------------------------------------ + subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_preexisting_ice, wght) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght(:,:) + + character(len=aero_name_len) :: modetype + real(r8), pointer :: dgnum(:,:,:) ! mode dry radius + real(r8) :: sigmag_aitken + integer :: i,k + + call rad_cnst_get_info(0, bin_ndx, mode_type=modetype) + + wght = 0._r8 + + select case ( trim(species_type) ) + case('dust') + if (modetype=='coarse' .or. modetype=='coarse_dust') then + wght(:ncol,:) = 1._r8 + end if + case('sulfate') + if (modetype=='aitken') then + if ( use_preexisting_ice ) then + wght(:ncol,:) = 1._r8 + else + call rad_cnst_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken) + call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUM' ), dgnum) + do k = 1,nlev + do i = 1,ncol + if (dgnum(i,k,bin_ndx) > 0._r8) then + ! only allow so4 with D>0.1 um in ice nucleation + wght(i,k) = max(0._r8,(0.5_r8 - 0.5_r8* & + erf(log(0.1e-6_r8/dgnum(i,k,bin_ndx))/ & + (2._r8**0.5_r8*log(sigmag_aitken))) )) + end if + end do + end do + endif + endif + case('black-c') + if (modetype=='accum') then + wght(:ncol,:) = 1._r8 + endif + case('sulfate_strat') + if (modetype=='accum' .or. modetype=='coarse' .or. modetype=='coarse_strat') then + wght(:ncol,:) = 1._r8 + endif + end select + + end subroutine icenuc_size_wght_arr + + !------------------------------------------------------------------------------ + ! return aerosol bin size weights for a given bin, column and vertical layer + !------------------------------------------------------------------------------ + subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, use_preexisting_ice, wght) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + character(len=*), intent(in) :: species_type ! species type + logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag + real(r8), intent(out) :: wght + + character(len=aero_name_len) :: modetype + real(r8), pointer :: dgnum(:,:,:) ! mode dry radius + real(r8) :: sigmag_aitken + + wght = 0._r8 + + call rad_cnst_get_info(0, bin_ndx, mode_type=modetype) + + select case ( trim(species_type) ) + case('dust') + if (modetype=='coarse' .or. modetype=='coarse_dust') then + wght = 1._r8 + end if + case('sulfate') + if (modetype=='aitken') then + if ( use_preexisting_ice ) then + wght = 1._r8 + else + call rad_cnst_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken) + call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUM' ), dgnum) + + if (dgnum(col_ndx,lyr_ndx,bin_ndx) > 0._r8) then + ! only allow so4 with D>0.1 um in ice nucleation + wght = max(0._r8,(0.5_r8 - 0.5_r8* & + erf(log(0.1e-6_r8/dgnum(col_ndx,lyr_ndx,bin_ndx))/ & + (2._r8**0.5_r8*log(sigmag_aitken))) )) + + end if + endif + endif + case('black-c') + if (modetype=='accum') then + wght = 1._r8 + endif + case('sulfate_strat') + if (modetype=='accum' .or. modetype=='coarse' .or. modetype=='coarse_strat') then + wght = 1._r8 + endif + end select + + end subroutine icenuc_size_wght_val + + !------------------------------------------------------------------------------ + ! returns aerosol type weights for a given aerosol type and bin + !------------------------------------------------------------------------------ + subroutine icenuc_type_wght(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne) + + use aerosol_properties_mod, only: aerosol_properties + + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + character(len=*), intent(in) :: species_type ! species type + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + real(r8), intent(in) :: rho(:,:) ! air density (kg m-3) + real(r8), intent(out) :: wght(:,:) ! type weights + logical, optional, intent(in) :: cloud_borne ! if TRUE cloud-borne aerosols are used + ! otherwise ambient aerosols are used + + character(len=aero_name_len) :: modetype + + call rad_cnst_get_info(0, bin_ndx, mode_type=modetype) + + wght = 0._r8 + + if (species_type == 'dust') then + if (modetype=='coarse_dust') then + wght(:ncol,:) = 1._r8 + else + call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne) + end if + else if (species_type == 'sulfate_strat') then + if (modetype=='accum') then + wght(:ncol,:) = 1._r8 + elseif ( modetype=='coarse' .or. modetype=='coarse_strat') then + call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne) + endif + else + wght(:ncol,:) = 1._r8 + end if + + end subroutine icenuc_type_wght + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine update_bin( self, bin_ndx, col_ndx, lyr_ndx, delmmr_sum, delnum_sum, tnd_ndx, dtime, tend ) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: col_ndx ! column index + integer, intent(in) :: lyr_ndx ! vertical layer index + real(r8),intent(in) :: delmmr_sum ! mass mixing ratio change summed over all species in bin + real(r8),intent(in) :: delnum_sum ! number mixing ratio change summed over all species in bin + integer, intent(in) :: tnd_ndx ! tendency index + real(r8),intent(in) :: dtime ! time step size (sec) + real(r8),intent(inout) :: tend(:,:,:) ! tendency + + real(r8), pointer :: amb_num(:,:) + real(r8), pointer :: cld_num(:,:) + + call self%get_ambient_num(bin_ndx, amb_num) + call self%get_cldbrne_num(bin_ndx, cld_num) + + ! if there is no bin mass compute updates/tendencies for bin number + ! -- apply the total number change to bin number + if (tnd_ndx>0) then + tend(col_ndx,lyr_ndx,tnd_ndx) = -delnum_sum/dtime + else + amb_num(col_ndx,lyr_ndx) = amb_num(col_ndx,lyr_ndx) - delnum_sum + end if + + ! apply the total number change to bin number + cld_num(col_ndx,lyr_ndx) = cld_num(col_ndx,lyr_ndx) + delnum_sum + + end subroutine update_bin + + !------------------------------------------------------------------------------ + ! returns the volume-weighted fractions of aerosol subset `bin_ndx` that can act + ! as heterogeneous freezing nuclei + !------------------------------------------------------------------------------ + function hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + + real(r8) :: wght(ncol,nlev) + + character(len=aero_name_len) :: modetype + + wght(:,:) = 1._r8 + + call rad_cnst_get_info(0, bin_ndx, mode_type=modetype) + + if (trim(modetype) == 'aitken') then + wght(:,:) = 0._r8 + end if + + end function hetfrz_size_wght + + !------------------------------------------------------------------------------ + ! returns hygroscopicity for a given radiation diagnostic list number and + ! bin number + !------------------------------------------------------------------------------ + function hygroscopicity(self, list_ndx, bin_ndx) result(kappa) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: list_ndx ! rad climate list number + integer, intent(in) :: bin_ndx ! bin number + + real(r8), pointer :: kappa(:,:) ! hygroscopicity (ncol,nlev) + + nullify(kappa) + + end function hygroscopicity + + !------------------------------------------------------------------------------ + ! returns aerosol wet diameter and aerosol water concentration for a given + ! radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + subroutine water_uptake(self, aero_props, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat) + use modal_aero_wateruptake, only: modal_aero_wateruptake_dr + use modal_aero_calcsize, only: modal_aero_calcsize_diag + + class(modal_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m) + real(r8),intent(out) :: qaerwat(ncol,nlev) ! aerosol water concentration (g/g) + + integer :: istat, nmodes + real(r8), pointer :: dgnumdry_m(:,:,:) ! number mode dry diameter for all modes + real(r8), pointer :: dgnumwet_m(:,:,:) ! number mode wet diameter for all modes + real(r8), pointer :: qaerwat_m(:,:,:) ! aerosol water (g/g) for all modes + real(r8), pointer :: wetdens_m(:,:,:) ! + real(r8), pointer :: hygro_m(:,:,:) ! + real(r8), pointer :: dryvol_m(:,:,:) ! + real(r8), pointer :: dryrad_m(:,:,:) ! + real(r8), pointer :: drymass_m(:,:,:) ! + real(r8), pointer :: so4dryvol_m(:,:,:) ! + real(r8), pointer :: naer_m(:,:,:) ! + + nmodes = aero_props%nbins() + + if (list_idx == 0) then + ! water uptake and wet radius for the climate list has already been calculated + call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUMWET'), dgnumwet_m) + call pbuf_get_field(self%pbuf, pbuf_get_index('QAERWAT'), qaerwat_m) + + dgnumwet(:ncol,:nlev) = dgnumwet_m(:ncol,:nlev,bin_idx) + qaerwat (:ncol,:nlev) = qaerwat_m(:ncol,:nlev,bin_idx) + + else + ! If doing a diagnostic calculation then need to calculate the wet radius + ! and water uptake for the diagnostic modes + allocate(dgnumdry_m(ncol,nlev,nmodes), dgnumwet_m(ncol,nlev,nmodes), & + qaerwat_m(ncol,nlev,nmodes), wetdens_m(ncol,nlev,nmodes), & + hygro_m(ncol,nlev,nmodes), dryvol_m(ncol,nlev,nmodes), & + dryrad_m(ncol,nlev,nmodes), drymass_m(ncol,nlev,nmodes), & + so4dryvol_m(ncol,nlev,nmodes), naer_m(ncol,nlev,nmodes), stat=istat) + if (istat > 0) then + dgnumwet = -huge(1._r8) + qaerwat = -huge(1._r8) + return + end if + call modal_aero_calcsize_diag(self%state, self%pbuf, list_idx, dgnumdry_m, hygro_m, & + dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) + call modal_aero_wateruptake_dr(self%state, self%pbuf, list_idx, dgnumdry_m, dgnumwet_m, & + qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_m, & + drymass_m, so4dryvol_m, naer_m) + + dgnumwet(:ncol,:nlev) = dgnumwet_m(:ncol,:nlev,bin_idx) + qaerwat (:ncol,:nlev) = qaerwat_m(:ncol,:nlev,bin_idx) + + deallocate(dgnumdry_m) + deallocate(dgnumwet_m) + deallocate(qaerwat_m) + deallocate(wetdens_m) + deallocate(hygro_m) + deallocate(dryvol_m) + deallocate(dryrad_m) + deallocate(drymass_m) + deallocate(so4dryvol_m) + deallocate(naer_m) + endif + + + end subroutine water_uptake + + !------------------------------------------------------------------------------ + ! aerosol dry volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function dry_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + + class(modal_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + real(r8), pointer :: mmr(:,:) + real(r8) :: specdens ! species density (kg/m3) + + integer :: ispec + + vol(:,:) = 0._r8 + + do ispec = 1, aero_props%nspecies(list_idx,bin_idx) + call self%get_ambient_mmr(list_idx, ispec, bin_idx, mmr) + call aero_props%get(bin_idx, ispec, list_ndx=list_idx, density=specdens) + vol(:ncol,:) = vol(:ncol,:) + mmr(:ncol,:)/specdens + end do + + end function dry_volume + + !------------------------------------------------------------------------------ + ! aerosol wet volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function wet_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + + class(modal_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + real(r8) :: dryvol(ncol,nlev) + real(r8) :: watervol(ncol,nlev) + + dryvol = self%dry_volume(aero_props, list_idx, bin_idx, ncol, nlev) + watervol = self%water_volume(aero_props, list_idx, bin_idx, ncol, nlev) + + vol = watervol + dryvol + + end function wet_volume + + !------------------------------------------------------------------------------ + ! aerosol water volume (m3/kg) for given radiation diagnostic list number and bin number + !------------------------------------------------------------------------------ + function water_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol) + + class(modal_aerosol_state), intent(in) :: self + class(aerosol_properties), intent(in) :: aero_props + + integer, intent(in) :: list_idx ! rad climate/diags list number + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: vol(ncol,nlev) ! m3/kg + + real(r8) :: dgnumwet(ncol,nlev) + real(r8) :: qaerwat(ncol,nlev) + + call self%water_uptake(aero_props, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat) + + vol(:ncol,:nlev) = qaerwat(:ncol,:nlev)*rh2odens + where (vol<0._r8) + vol = 0._r8 + end where + + end function water_volume + + !------------------------------------------------------------------------------ + ! aerosol wet diameter + !------------------------------------------------------------------------------ + function wet_diameter(self, bin_idx, ncol, nlev) result(diam) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: diam(ncol,nlev) + + real(r8), pointer :: dgnumwet(:,:,:) + + call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUMWET'), dgnumwet) + + diam(:ncol,:nlev) = dgnumwet(:ncol,:nlev,bin_idx) + + end function wet_diameter + + !------------------------------------------------------------------------------ + ! prescribed aerosol activation fraction for convective cloud + !------------------------------------------------------------------------------ + function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) + + use modal_aero_data + + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: ibin ! bin index + integer, intent(in) :: ispc ! species index + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + + real(r8) :: frac(ncol,nlev) + + real(r8) :: f_act_conv_coarse(ncol,nlev) + real(r8) :: f_act_conv_coarse_dust, f_act_conv_coarse_nacl + real(r8) :: tmpdust, tmpnacl + integer :: lcoardust, lcoarnacl + integer :: i,k + + f_act_conv_coarse(:,:) = 0.60_r8 + f_act_conv_coarse_dust = 0.40_r8 + f_act_conv_coarse_nacl = 0.80_r8 + if (modeptr_coarse > 0) then + lcoardust = lptr_dust_a_amode(modeptr_coarse) + lcoarnacl = lptr_nacl_a_amode(modeptr_coarse) + if ((lcoardust > 0) .and. (lcoarnacl > 0)) then + do k = 1, nlev + do i = 1, ncol + tmpdust = max( 0.0_r8, self%state%q(i,k,lcoardust) ) + tmpnacl = max( 0.0_r8, self%state%q(i,k,lcoarnacl) ) + if ((tmpdust+tmpnacl) > 1.0e-30_r8) then + f_act_conv_coarse(i,k) = (f_act_conv_coarse_dust*tmpdust & + + f_act_conv_coarse_nacl*tmpnacl)/(tmpdust+tmpnacl) + end if + end do + end do + end if + end if + + if (ibin == modeptr_pcarbon) then + frac = 0.0_r8 + else if ((ibin == modeptr_finedust) .or. (ibin == modeptr_coardust)) then + frac = 0.4_r8 + else + frac = 0.8_r8 + end if + + ! set f_act_conv for interstitial (lphase=1) coarse mode species + ! for the convective in-cloud, we conceptually treat the coarse dust and seasalt + ! as being externally mixed, and apply f_act_conv = f_act_conv_coarse_dust/nacl to dust/seasalt + ! number and sulfate are conceptually partitioned to the dust and seasalt + ! on a mass basis, so the f_act_conv for number and sulfate are + ! mass-weighted averages of the values used for dust/seasalt + if (ibin == modeptr_coarse) then + frac = f_act_conv_coarse + if (ispc>0) then + if (lmassptr_amode(ispc,ibin) == lptr_dust_a_amode(ibin)) then + frac = f_act_conv_coarse_dust + else if (lmassptr_amode(ispc,ibin) == lptr_nacl_a_amode(ibin)) then + frac = f_act_conv_coarse_nacl + end if + end if + end if + + end function convcld_actfrac + +end module modal_aerosol_state_mod diff --git a/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 new file mode 100644 index 0000000000..e1289a8790 --- /dev/null +++ b/src/chemistry/aerosol/refractive_aerosol_optics_mod.F90 @@ -0,0 +1,384 @@ +module refractive_aerosol_optics_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use aerosol_optics_mod, only: aerosol_optics + use physconst, only: rhoh2o + use aerosol_state_mod, only: aerosol_state + use aerosol_properties_mod, only: aerosol_properties + + use table_interp_mod, only: table_interp, table_interp_wghts, table_interp_calcwghts + + implicit none + + private + public :: refractive_aerosol_optics + + !> refractive_aerosol_optics + !! Table look up implementation of aerosol_optics to parameterize aerosol radiative properties in terms of + !! surface mode wet radius and wet refractive index using chebychev polynomials + type, extends(aerosol_optics) :: refractive_aerosol_optics + + integer :: ibin, ilist + class(aerosol_state), pointer :: aero_state ! aerosol_state object + class(aerosol_properties), pointer :: aero_props ! aerosol_properties object + + real(r8), allocatable :: watervol(:,:) ! volume concentration of water in each mode (m3/kg) + real(r8), allocatable :: wetvol(:,:) ! volume concentration of wet mode (m3/kg) + real(r8), allocatable :: cheb(:,:,:) ! chebychev polynomials + real(r8), allocatable :: radsurf(:,:) ! aerosol surface mode radius + real(r8), allocatable :: logradsurf(:,:) ! log(aerosol surface mode radius) + + ! refractive index for water read in read_water_refindex + complex(r8), allocatable :: crefwsw(:) ! complex refractive index for water visible + complex(r8), allocatable :: crefwlw(:) ! complex refractive index for water infrared + + real(r8), pointer :: extpsw(:,:,:,:) => null() ! specific extinction + real(r8), pointer :: abspsw(:,:,:,:) => null() ! specific absorption + real(r8), pointer :: asmpsw(:,:,:,:) => null() ! asymmetry factor + real(r8), pointer :: absplw(:,:,:,:) => null() ! specific absorption + + real(r8), pointer :: refrtabsw(:,:) => null() ! table of real refractive indices for aerosols + real(r8), pointer :: refitabsw(:,:) => null() ! table of imag refractive indices for aerosols + real(r8), pointer :: refrtablw(:,:) => null() ! table of real refractive indices for aerosols + real(r8), pointer :: refitablw(:,:) => null() ! table of imag refractive indices for aerosols + + ! Dimension sizes in coefficient arrays used to parameterize aerosol radiative properties + ! in terms of refractive index and wet radius + integer :: ncoef = -1 ! number of chebychev coeficients + integer :: prefr = -1 ! number of real refractive indices + integer :: prefi = -1 ! number of imaginary refractive indices + + contains + + procedure :: sw_props + procedure :: lw_props + + final :: destructor + + end type refractive_aerosol_optics + + interface refractive_aerosol_optics + procedure :: constructor + end interface refractive_aerosol_optics + + ! radius limits (m) + real(r8), parameter :: radmin = 0.01e-6_r8 ! min aerosol surface mode radius (m) + real(r8), parameter :: radmax = 25.e-6_r8 ! max aerosol surface mode radius (m) + real(r8), parameter :: xrmin=log(radmin) ! min log(aerosol surface mode radius) + real(r8), parameter :: xrmax=log(radmax) ! max log(aerosol surface mode radius) + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + function constructor(aero_props, aero_state, ilist, ibin, ncol, nlev, nsw, nlw, crefwsw, crefwlw) & + result(newobj) + + class(aerosol_properties),intent(in), target :: aero_props ! aerosol_properties object + class(aerosol_state),intent(in), target :: aero_state ! aerosol_state object + integer, intent(in) :: ilist ! climate or a diagnostic list number + integer, intent(in) :: ibin ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + integer, intent(in) :: nsw ! number of short wave lengths + integer, intent(in) :: nlw ! number of long wave lengths + complex(r8), intent(in) :: crefwsw(nsw) ! complex refractive index for water visible + complex(r8), intent(in) :: crefwlw(nlw) ! complex refractive index for water infrared + + type(refractive_aerosol_optics), pointer :: newobj + + integer :: ierr, icol, ilev, ispec, nspec + real(r8) :: vol(ncol) ! volume concentration of aerosol species (m3/kg) + real(r8) :: dryvol(ncol) ! volume concentration of aerosol mode (m3/kg) + real(r8) :: specdens ! species density (kg/m3) + real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio + real(r8) :: logsigma ! geometric standard deviation of number distribution + + real(r8) :: dgnumwet(ncol,nlev) ! aerosol wet number mode diameter (m) + real(r8) :: qaerwat(ncol,nlev) ! aerosol water (g/g) + + real(r8), parameter :: rh2odens = 1._r8/rhoh2o + + allocate(newobj, stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + ! get mode properties + call aero_props%optics_params(ilist, ibin, & + refrtabsw=newobj%refrtabsw, refitabsw=newobj%refitabsw, & + refrtablw=newobj%refrtablw, refitablw=newobj%refitablw,& + extpsw=newobj%extpsw, abspsw=newobj%abspsw, asmpsw=newobj%asmpsw, & + absplw=newobj%absplw, ncoef=newobj%ncoef, prefr=newobj%prefr, prefi=newobj%prefi) + + allocate(newobj%watervol(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + allocate(newobj%wetvol(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + allocate(newobj%cheb(newobj%ncoef,ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + allocate(newobj%radsurf(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + allocate(newobj%logradsurf(ncol,nlev),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + + allocate(newobj%crefwlw(nlw),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + newobj%crefwlw(:) = crefwlw(:) + + allocate(newobj%crefwsw(nsw),stat=ierr) + if (ierr/=0) then + nullify(newobj) + return + end if + newobj%crefwsw(:) = crefwsw(:) + + call aero_state%water_uptake(aero_props, ilist, ibin, ncol, nlev, dgnumwet, qaerwat) + + nspec = aero_props%nspecies(ilist,ibin) + + logsigma=aero_props%alogsig(ilist,ibin) + + ! calc size parameter for all columns + call modal_size_parameters(newobj%ncoef, ncol, nlev, logsigma, dgnumwet, & + newobj%radsurf, newobj%logradsurf, newobj%cheb) + + do ilev = 1, nlev + dryvol(:ncol) = 0._r8 + do ispec = 1, nspec + call aero_state%get_ambient_mmr(ilist,ispec,ibin,specmmr) + call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens) + + do icol = 1, ncol + vol(icol) = specmmr(icol,ilev)/specdens + dryvol(icol) = dryvol(icol) + vol(icol) + + newobj%watervol(icol,ilev) = qaerwat(icol,ilev)*rh2odens + newobj%wetvol(icol,ilev) = newobj%watervol(icol,ilev) + dryvol(icol) + if (newobj%watervol(icol,ilev) < 0._r8) then + newobj%watervol(icol,ilev) = 0._r8 + newobj%wetvol(icol,ilev) = dryvol(icol) + end if + end do + end do + end do + + newobj%aero_state => aero_state + newobj%aero_props => aero_props + newobj%ilist = ilist + newobj%ibin = ibin + + end function constructor + + !------------------------------------------------------------------------------ + ! returns short wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine sw_props(self, ncol, ilev, iwav, pext, pabs, palb, pasm) + + class(refractive_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pext(ncol) ! parameterized specific extinction (m2/kg) + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + real(r8),intent(out) :: palb(ncol) ! parameterized asymmetry factor + real(r8),intent(out) :: pasm(ncol) ! parameterized single scattering albedo + + real(r8) :: refr(ncol) ! real part of refractive index + real(r8) :: refi(ncol) ! imaginary part of refractive index + real(r8) :: cext(self%ncoef,ncol), cabs(self%ncoef,ncol), casm(self%ncoef,ncol) + + complex(r8) :: crefin(ncol) ! complex refractive index + integer :: icol,icoef + + type(table_interp_wghts) :: wghtsr(ncol) + type(table_interp_wghts) :: wghtsi(ncol) + + crefin(:ncol) = self%aero_state%refractive_index_sw(ncol, ilev, self%ilist, self%ibin, iwav, self%aero_props) + + do icol = 1, ncol + crefin(icol) = crefin(icol) + self%watervol(icol,ilev)*self%crefwsw(iwav) + crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev),1.e-60_r8) + refr(icol) = real(crefin(icol)) + refi(icol) = abs(aimag(crefin(icol))) + end do + + ! interpolate coefficients linear in refractive index + + wghtsr = table_interp_calcwghts( self%prefr, self%refrtabsw(:,iwav), ncol, refr(:ncol) ) + wghtsi = table_interp_calcwghts( self%prefi, self%refitabsw(:,iwav), ncol, refi(:ncol) ) + + cext(:,:ncol)= table_interp( self%ncoef,ncol, self%prefr,self%prefi, wghtsr,wghtsi, self%extpsw(:,:,:,iwav)) + cabs(:,:ncol)= table_interp( self%ncoef,ncol, self%prefr,self%prefi, wghtsr,wghtsi, self%abspsw(:,:,:,iwav)) + casm(:,:ncol)= table_interp( self%ncoef,ncol, self%prefr,self%prefi, wghtsr,wghtsi, self%asmpsw(:,:,:,iwav)) + + do icol = 1,ncol + + if (self%logradsurf(icol,ilev) <= xrmax) then + pext(icol) = 0.5_r8*cext(1,icol) + do icoef = 2, self%ncoef + pext(icol) = pext(icol) + self%cheb(icoef,icol,ilev)*cext(icoef,icol) + enddo + pext(icol) = exp(pext(icol)) + else + pext(icol) = 1.5_r8/(self%radsurf(icol,ilev)*rhoh2o) ! geometric optics + endif + + ! convert from m2/kg water to m2/kg aerosol + pext(icol) = pext(icol)*self%wetvol(icol,ilev)*rhoh2o + pabs(icol) = 0.5_r8*cabs(1,icol) + pasm(icol) = 0.5_r8*casm(1,icol) + do icoef = 2, self%ncoef + pabs(icol) = pabs(icol) + self%cheb(icoef,icol,ilev)*cabs(icoef,icol) + pasm(icol) = pasm(icol) + self%cheb(icoef,icol,ilev)*casm(icoef,icol) + enddo + pabs(icol) = pabs(icol)*self%wetvol(icol,ilev)*rhoh2o + pabs(icol) = max(0._r8,pabs(icol)) + pabs(icol) = min(pext(icol),pabs(icol)) + + palb(icol) = 1._r8-pabs(icol)/max(pext(icol),1.e-40_r8) + + end do + + end subroutine sw_props + + !------------------------------------------------------------------------------ + ! returns long wave aerosol optics properties + !------------------------------------------------------------------------------ + subroutine lw_props(self, ncol, ilev, iwav, pabs) + + class(refractive_aerosol_optics), intent(in) :: self + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: ilev ! vertical level index + integer, intent(in) :: iwav ! wave length index + real(r8),intent(out) :: pabs(ncol) ! parameterized specific absorption (m2/kg) + + real(r8) :: refr(ncol) ! real part of refractive index + real(r8) :: refi(ncol) ! imaginary part of refractive index + real(r8) :: cabs(self%ncoef,ncol) + + complex(r8) :: crefin(ncol) ! complex refractive index + integer :: icol, icoef + + type(table_interp_wghts) :: wghtsr(ncol) + type(table_interp_wghts) :: wghtsi(ncol) + + crefin(:ncol) = self%aero_state%refractive_index_lw(ncol, ilev, self%ilist, self%ibin, iwav, self%aero_props) + + do icol = 1, ncol + crefin(icol) = crefin(icol) + self%watervol(icol,ilev)*self%crefwlw(iwav) + crefin(icol) = crefin(icol)/max(self%wetvol(icol,ilev), 1.e-40_r8) + + refr(icol) = real(crefin(icol)) + refi(icol) = aimag(crefin(icol)) + + end do + + ! interpolate coefficients linear in refractive index + + wghtsr = table_interp_calcwghts( self%prefr, self%refrtablw(:,iwav), ncol, refr(:ncol) ) + wghtsi = table_interp_calcwghts( self%prefi, self%refitablw(:,iwav), ncol, refi(:ncol) ) + + cabs(:,:ncol)= table_interp( self%ncoef,ncol, self%prefr,self%prefi, wghtsr,wghtsi, self%absplw(:,:,:,iwav)) + + do icol = 1,ncol + pabs(icol) = 0.5_r8*cabs(1,icol) + do icoef = 2, self%ncoef + pabs(icol) = pabs(icol) + self%cheb(icoef,icol,ilev)*cabs(icoef,icol) + end do + pabs(icol) = pabs(icol)*self%wetvol(icol,ilev)*rhoh2o + pabs(icol) = max(0._r8,pabs(icol)) + end do + + end subroutine lw_props + + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine destructor(self) + + type(refractive_aerosol_optics), intent(inout) :: self + + deallocate(self%watervol) + deallocate(self%wetvol) + deallocate(self%cheb) + deallocate(self%radsurf) + deallocate(self%logradsurf) + deallocate(self%crefwsw) + deallocate(self%crefwlw) + + nullify(self%aero_state) + nullify(self%aero_props) + nullify(self%extpsw) + nullify(self%abspsw) + nullify(self%asmpsw) + nullify(self%absplw) + nullify(self%refrtabsw) + nullify(self%refitabsw) + nullify(self%refrtablw) + nullify(self%refitablw) + + end subroutine destructor + + + ! Private routines + !=============================================================================== + + !=============================================================================== + + subroutine modal_size_parameters(ncoef,ncol,nlev, alnsg_amode, dgnumwet, radsurf, logradsurf, cheb) + + integer, intent(in) :: ncoef,ncol,nlev + real(r8), intent(in) :: alnsg_amode ! geometric standard deviation of number distribution + real(r8), intent(in) :: dgnumwet(:,:) ! aerosol wet number mode diameter (m) + real(r8), intent(out) :: radsurf(:,:) ! aerosol surface mode radius + real(r8), intent(out) :: logradsurf(:,:) ! log(aerosol surface mode radius) + real(r8), intent(out) :: cheb(:,:,:) + + integer :: i, k, nc + real(r8) :: explnsigma + real(r8) :: xrad(ncol) ! normalized aerosol radius + + !------------------------------------------------------------------------------- + + explnsigma = exp(2.0_r8*alnsg_amode*alnsg_amode) + + do k = 1, nlev + do i = 1, ncol + ! convert from number mode diameter to surface area + radsurf(i,k) = max(0.5_r8*dgnumwet(i,k)*explnsigma,radmin) + logradsurf(i,k) = log(radsurf(i,k)) + ! normalize size parameter + xrad(i) = max(logradsurf(i,k),xrmin) + xrad(i) = min(xrad(i),xrmax) + xrad(i) = (2._r8*xrad(i)-xrmax-xrmin)/(xrmax-xrmin) + ! chebyshev polynomials + cheb(1,i,k) = 1._r8 + cheb(2,i,k) = xrad(i) + do nc = 3, ncoef + cheb(nc,i,k) = 2._r8*xrad(i)*cheb(nc-1,i,k)-cheb(nc-2,i,k) + end do + end do + end do + + end subroutine modal_size_parameters + +end module refractive_aerosol_optics_mod diff --git a/src/chemistry/aerosol/wetdep.F90 b/src/chemistry/aerosol/wetdep.F90 index 810e063e1a..a1f80d9deb 100644 --- a/src/chemistry/aerosol/wetdep.F90 +++ b/src/chemistry/aerosol/wetdep.F90 @@ -1,9 +1,9 @@ module wetdep -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! ! Wet deposition routines for both aerosols and gas phase constituents. -! +! !----------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 @@ -44,23 +44,23 @@ module wetdep real(r8) :: totcond(pcols, pver) ! total condensate real(r8) :: cldv(pcols,pver) ! cloudy volume undergoing wet chem and 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) :: cldvst(pcols,pver) ! Stratiform precipitation area at the top interface of current layer end type wetdep_inputs_t integer :: cld_idx = 0 -integer :: qme_idx = 0 -integer :: prain_idx = 0 -integer :: bergso_idx = 0 -integer :: nevapr_idx = 0 - -integer :: icwmrdp_idx = 0 -integer :: icwmrsh_idx = 0 -integer :: rprddp_idx = 0 -integer :: rprdsh_idx = 0 -integer :: sh_frac_idx = 0 -integer :: dp_frac_idx = 0 -integer :: nevapr_shcu_idx = 0 -integer :: nevapr_dpcu_idx = 0 +integer :: qme_idx = 0 +integer :: prain_idx = 0 +integer :: bergso_idx = 0 +integer :: nevapr_idx = 0 + +integer :: icwmrdp_idx = 0 +integer :: icwmrsh_idx = 0 +integer :: rprddp_idx = 0 +integer :: rprdsh_idx = 0 +integer :: sh_frac_idx = 0 +integer :: dp_frac_idx = 0 +integer :: nevapr_shcu_idx = 0 +integer :: nevapr_dpcu_idx = 0 integer :: ixcldice, ixcldliq !============================================================================== @@ -75,20 +75,20 @@ subroutine wetdep_init() integer :: ierr - cld_idx = pbuf_get_index('CLD') - qme_idx = pbuf_get_index('QME') - prain_idx = pbuf_get_index('PRAIN') - bergso_idx = pbuf_get_index('BERGSO', errcode=ierr ) - nevapr_idx = pbuf_get_index('NEVAPR') + cld_idx = pbuf_get_index('CLD') + qme_idx = pbuf_get_index('QME') + prain_idx = pbuf_get_index('PRAIN') + bergso_idx = pbuf_get_index('BERGSO', errcode=ierr ) + nevapr_idx = pbuf_get_index('NEVAPR') - icwmrdp_idx = pbuf_get_index('ICWMRDP') - rprddp_idx = pbuf_get_index('RPRDDP') - icwmrsh_idx = pbuf_get_index('ICWMRSH') - rprdsh_idx = pbuf_get_index('RPRDSH') + icwmrdp_idx = pbuf_get_index('ICWMRDP') + rprddp_idx = pbuf_get_index('RPRDDP') + icwmrsh_idx = pbuf_get_index('ICWMRSH') + rprdsh_idx = pbuf_get_index('RPRDSH') sh_frac_idx = pbuf_get_index('SH_FRAC' ) - dp_frac_idx = pbuf_get_index('DP_FRAC') - nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') - nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') + dp_frac_idx = pbuf_get_index('DP_FRAC') + nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') + nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') call cnst_get_ind('CLDICE', ixcldice) call cnst_get_ind('CLDLIQ', ixcldliq) @@ -177,22 +177,22 @@ subroutine clddiag(t, pmid, pdel, cmfdqr, evapc, & prain, cldv, cldvcu, cldvst, rain, & ncol) - ! ------------------------------------------------------------------------------------ + ! ------------------------------------------------------------------------------------ ! Estimate the cloudy volume which is occupied by rain or cloud water as ! the max between the local cloud amount or the ! sum above of (cloud*positive precip production) sum total precip from above ! ---------------------------------- x ------------------------ ! sum above of (positive precip ) sum positive precip from above ! Author: P. Rasch - ! Sungsu Park. Mar.2010 + ! Sungsu Park. Mar.2010 ! ------------------------------------------------------------------------------------ ! Input arguments: real(r8), intent(in) :: t(pcols,pver) ! temperature (K) real(r8), intent(in) :: pmid(pcols,pver) ! pressure at layer midpoints real(r8), intent(in) :: pdel(pcols,pver) ! pressure difference across layers - real(r8), intent(in) :: cmfdqr(pcols,pver) ! dq/dt due to convective rainout - real(r8), intent(in) :: evapc(pcols,pver) ! Evaporation rate of convective precipitation ( >= 0 ) + real(r8), intent(in) :: cmfdqr(pcols,pver) ! dq/dt due to convective rainout + real(r8), intent(in) :: evapc(pcols,pver) ! Evaporation rate of convective precipitation ( >= 0 ) real(r8), intent(in) :: cldt(pcols,pver) ! total cloud fraction real(r8), intent(in) :: cldcu(pcols,pver) ! Cumulus cloud fraction real(r8), intent(in) :: cldst(pcols,pver) ! Stratus cloud fraction @@ -202,7 +202,7 @@ subroutine clddiag(t, pmid, pdel, cmfdqr, evapc, & integer, intent(in) :: ncol ! Output arguments: - real(r8), intent(out) :: cldv(pcols,pver) ! fraction occupied by rain or cloud water + real(r8), intent(out) :: cldv(pcols,pver) ! fraction occupied by rain or cloud water real(r8), intent(out) :: cldvcu(pcols,pver) ! Convective precipitation volume real(r8), intent(out) :: cldvst(pcols,pver) ! Stratiform precipitation volume real(r8), intent(out) :: rain(pcols,pver) ! mixing ratio of rain (kg/kg) @@ -299,10 +299,10 @@ subroutine wetdepa_v2( & convproc_do_aer, rcscavt, rsscavt, & sol_facti_in, sol_factic_in, convproc_do_evaprain_atonce_in, bergso_in ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ! scavenging code for very soluble aerosols - ! + ! !----------------------------------------------------------------------- real(r8), intent(in) ::& @@ -314,7 +314,7 @@ subroutine wetdepa_v2( & cmfdqr(pcols,pver), &! rate of production of convective precip evapc(pcols,pver), &! Evaporation rate of convective precipitation conicw(pcols,pver), &! convective cloud water - cwat(pcols,pver), &! cloud water amount + cwat(pcols,pver), &! cloud water amount precs(pcols,pver), &! rate of production of stratiform precip conds(pcols,pver), &! rate of production of condensate evaps(pcols,pver), &! rate of evaporation of precip @@ -330,11 +330,11 @@ subroutine wetdepa_v2( & ! sol_fact is used for below cloud scavenging ! sol_facti is used for in cloud scavenging - real(r8), intent(in) :: sol_fact + real(r8), intent(in) :: sol_fact(pcols,pver) integer, intent(in) :: ncol real(r8), intent(in) :: scavcoef(pcols,pver) ! Dana and Hales coefficient (/mm) (0.1 if not MODAL_AERO) real(r8), intent(out) ::& - scavt(pcols,pver), &! scavenging tend + scavt(pcols,pver), &! scavenging tend iscavt(pcols,pver), &! incloud scavenging tends fracis(pcols,pver) ! fraction of species not scavenged @@ -344,13 +344,13 @@ subroutine wetdepa_v2( & ! Setting is_strat_cloudborne=.false. is being used to indicate that the tracers are the ! interstitial modal aerosols. In this case the optional qqcw (the cloud borne mixing ratio ! corresponding to the interstitial aerosol) must be provided, as well as the optional f_act_conv. - logical, intent(in), optional :: is_strat_cloudborne + logical, intent(in), optional :: is_strat_cloudborne real(r8), intent(in), optional :: qqcw(pcols,pver) real(r8), intent(in), optional :: f_act_conv(pcols,pver) - real(r8), intent(in), optional :: sol_facti_in ! solubility factor (frac of aerosol scavenged in cloud) + real(r8), intent(in), optional :: sol_facti_in(pcols,pver) ! solubility factor (frac of aerosol scavenged in cloud) real(r8), intent(in), optional :: sol_factic_in(pcols,pver) ! sol_facti_in for convective clouds - + real(r8), intent(out), optional :: icscavt(pcols,pver) ! incloud, convective real(r8), intent(out), optional :: isscavt(pcols,pver) ! incloud, stratiform @@ -405,8 +405,8 @@ subroutine wetdepa_v2( & ! For convective cloud, cloudborne aerosol is not treated explicitly, ! and sol_factic is 1.0 for both cloudborne and interstitial. - real(r8) :: sol_facti ! in cloud fraction of aerosol scavenged - real(r8) :: sol_factb ! below cloud fraction of aerosol scavenged + real(r8) :: sol_facti(pcols,pver) ! in cloud fraction of aerosol scavenged + real(r8) :: sol_factb(pcols,pver) ! below cloud fraction of aerosol scavenged real(r8) :: sol_factic(pcols,pver) ! in cloud fraction of aerosol scavenged for convective clouds real(r8) :: rdeltat @@ -447,7 +447,7 @@ subroutine wetdepa_v2( & ! the assumption is that within the cloud that ! all the tracer is in the cloud water ! - ! for both convective and stratiform clouds, + ! for both convective and stratiform clouds, ! the fraction of cloud water converted to precip defines ! the amount of tracer which is pulled out. @@ -465,11 +465,11 @@ subroutine wetdepa_v2( & rdeltat = 1.0_r8/deltat ! ****************** Evaporation ************************** - ! calculate the fraction of strat precip from above + ! calculate the fraction of strat precip from above ! which evaporates within this layer fracev(i) = evaps(i,k)*pdog(i) & /max(1.e-12_r8,precabs(i)) - + ! If resuspending aerosol only when all the rain has totally ! evaporated then zero out any aerosol tendency for partial ! evaporation. @@ -486,7 +486,7 @@ subroutine wetdepa_v2( & ! ****************** Convection *************************** ! - ! set odds proportional to fraction of the grid box that is swept by the + ! set odds proportional to fraction of the grid box that is swept by the ! precipitation =precabc/rhoh20*(area of sphere projected on plane ! /volume of sphere)*deltat ! assume the radius of a raindrop is 1 e-3 m from Rogers and Yau, @@ -527,7 +527,7 @@ subroutine wetdepa_v2( & fracp(i) = max( 0._r8, min(1._r8, fracp(i)) ) - st_scav_ic(i) = sol_facti *fracp(i)*tracer(i,k)*rdeltat + st_scav_ic(i) = sol_facti(i,k) *fracp(i)*tracer(i,k)*rdeltat st_scav_bc(i) = 0._r8 @@ -548,7 +548,7 @@ subroutine wetdepa_v2( & odds(i) = precabc(i)/max(cldvcu(i,k),1.e-5_r8)*scavcoef(i,k)*deltat odds(i) = max(min(1._r8,odds(i)),0._r8) - conv_scav_bc(i) = sol_factb *cldvcu(i,k)*odds(i)*tracer_mean(i)*rdeltat + conv_scav_bc(i) = sol_factb(i,k) *cldvcu(i,k)*odds(i)*tracer_mean(i)*rdeltat ! stratiform scavenging @@ -557,7 +557,7 @@ subroutine wetdepa_v2( & odds(i) = precabs(i)/max(cldvst(i,k),1.e-5_r8)*scavcoef(i,k)*deltat odds(i) = max(min(1._r8,odds(i)),0._r8) - st_scav_bc(i) = sol_factb *cldvst(i,k)*odds(i)*tracer_mean(i)*rdeltat + st_scav_bc(i) = sol_factb(i,k) *cldvst(i,k)*odds(i)*tracer_mean(i)*rdeltat end if @@ -569,7 +569,7 @@ subroutine wetdepa_v2( & odds(i) = precabc(i)/max(cldvcu(i,k), 1.e-5_r8)*scavcoef(i,k)*deltat odds(i) = max( min(1._r8, odds(i)), 0._r8) - conv_scav_bc(i) = sol_factb*cldvcu(i,k)*odds(i)*tracer(i,k)*rdeltat + conv_scav_bc(i) = sol_factb(i,k)*cldvcu(i,k)*odds(i)*tracer(i,k)*rdeltat ! stratiform scavenging @@ -579,13 +579,13 @@ subroutine wetdepa_v2( & fracp(i) = precs(i,k)*deltat / & max( 1.e-12_r8, cwat(i,k) + precs(i,k)*deltat ) fracp(i) = max( 0._r8, min( 1._r8, fracp(i) ) ) - + ! assume the corresponding amnt of tracer is removed - st_scav_ic(i) = sol_facti*clds(i)*fracp(i)*tracer(i,k)*rdeltat + st_scav_ic(i) = sol_facti(i,k)*clds(i)*fracp(i)*tracer(i,k)*rdeltat odds(i) = precabs(i)/max(cldvst(i,k),1.e-5_r8)*scavcoef(i,k)*deltat odds(i) = max(min(1._r8,odds(i)),0._r8) - st_scav_bc(i) =sol_factb*(cldvst(i,k)*odds(i)) *tracer(i,k)*rdeltat + st_scav_bc(i) =sol_factb(i,k)*(cldvst(i,k)*odds(i)) *tracer(i,k)*rdeltat end if @@ -606,7 +606,7 @@ subroutine wetdepa_v2( & endif srct(i) = (srcc(i)+srcs(i))*omsm - + ! fraction that is not removed within the cloud ! (assumed to be interstitial, and subject to convective transport) fracp(i) = deltat*srct(i)/max(cldvst(i,k)*tracer(i,k),1.e-36_r8) ! amount removed @@ -628,7 +628,7 @@ subroutine wetdepa_v2( & if (present(bsscavt)) bsscavt(i,k) = -(srcs(i) * (1-fins(i))) * omsm + & fracev(i)*scavab(i)*rpdog(i) else - bcscavt(i,k) = -(srcc(i) * (1-finc(i))) * omsm + bcscavt(i,k) = -(srcc(i) * (1-finc(i))) * omsm rcscavt(i,k) = fracev_cu(i)*scavabc(i)*rpdog(i) bsscavt(i,k) = -(srcs(i) * (1-fins(i))) * omsm @@ -645,22 +645,22 @@ subroutine wetdepa_v2( & end do ! End of i = 1, ncol +#ifdef DEBUG + ! only check in debug mode which aborts when larger negative values are found found = .false. do i = 1,ncol - if ( dblchek(i) < 0._r8 ) then + ! catch the larger negative values, ignore insignificant small negaive values + if (dblchek(i) < -1.e-10_r8) then found = .true. - exit - end if + write(iulog,*) ' wetdapa_v2: negative value ', i, k, tracer(i,k), & + dblchek(i), scavt(i,k), srct(i), rat(i), fracev(i) + endif end do - if ( found ) then - do i = 1,ncol - if (dblchek(i) < 0._r8) then - write(iulog,*) ' wetdapa: negative value ', i, k, tracer(i,k), & - dblchek(i), scavt(i,k), srct(i), rat(i), fracev(i) - endif - end do - endif + if (found) then + call endrun('wetdapa_v2: negative values found') + end if +#endif end do ! End of k = 1, pver @@ -680,10 +680,10 @@ subroutine wetdepa_v1( t, p, q, pdel, & sol_facti_in, sol_factbi_in, sol_factii_in, & sol_factic_in, sol_factiic_in ) - !----------------------------------------------------------------------- - ! Purpose: + !----------------------------------------------------------------------- + ! Purpose: ! scavenging code for very soluble aerosols - ! + ! ! Author: P. Rasch ! Modified by T. Bond 3/2003 to track different removals !----------------------------------------------------------------------- @@ -699,7 +699,7 @@ subroutine wetdepa_v1( t, p, q, pdel, & cldc(pcols,pver), &! convective cloud fraction cmfdqr(pcols,pver), &! rate of production of convective precip conicw(pcols,pver), &! convective cloud water - cwat(pcols,pver), &! cloud water amount + cwat(pcols,pver), &! cloud water amount precs(pcols,pver), &! rate of production of stratiform precip conds(pcols,pver), &! rate of production of condensate evaps(pcols,pver), &! rate of evaporation of precip @@ -718,11 +718,11 @@ subroutine wetdepa_v1( t, p, q, pdel, & real(r8), intent(in), optional :: sol_factic_in(pcols,pver) ! sol_facti_in for convective clouds real(r8), intent(in), optional :: sol_factiic_in ! sol_factii_in for convective clouds real(r8), intent(in) :: scavcoef(pcols,pver) ! Dana and Hales coefficient (/mm) (0.1 if not MODAL_AERO) - + integer, intent(in) :: ncol real(r8), intent(out) ::& - scavt(pcols,pver), &! scavenging tend + scavt(pcols,pver), &! scavenging tend iscavt(pcols,pver), &! incloud scavenging tends fracis(pcols,pver) ! fraction of species not scavenged @@ -738,8 +738,8 @@ subroutine wetdepa_v1( t, p, q, pdel, & real(r8) adjfac ! factor stolen from cmfmca real(r8) aqfrac ! fraction of tracer in aqueous phase - real(r8) cwatc ! local convective total water amount - real(r8) cwats ! local stratiform total water amount + real(r8) cwatc ! local convective total water amount + real(r8) cwats ! local stratiform total water amount real(r8) cwatp ! local water amount falling from above precip real(r8) fracev(pcols) ! fraction of precip from above that is evaporating real(r8) fracp ! fraction of cloud water converted to precip @@ -779,7 +779,7 @@ subroutine wetdepa_v1( t, p, q, pdel, & real(r8) sol_factii, sol_factbi ! in cloud and below cloud fraction of aerosol scavenged by ice real(r8) sol_factic(pcols,pver) ! sol_facti for convective clouds real(r8) sol_factiic ! sol_factii for convective clouds - ! sol_factic & solfact_iic added for MODAL_AERO. + ! sol_factic & solfact_iic added for MODAL_AERO. ! For stratiform cloud, cloudborne aerosol is treated explicitly, ! and sol_facti is 1.0 for cloudborne, 0.0 for interstitial. ! For convective cloud, cloudborne aerosol is not treated explicitly, @@ -809,7 +809,7 @@ subroutine wetdepa_v1( t, p, q, pdel, & ! the assumption is that within the cloud that ! all the tracer is in the cloud water ! - ! for both convective and stratiform clouds, + ! for both convective and stratiform clouds, ! the fraction of cloud water converted to precip defines ! the amount of tracer which is pulled out. ! @@ -833,7 +833,7 @@ subroutine wetdepa_v1( t, p, q, pdel, & pdog = pdel(i,k)/gravit ! ****************** Evaporation ************************** - ! calculate the fraction of strat precip from above + ! calculate the fraction of strat precip from above ! which evaporates within this layer fracev(i) = evaps(i,k)*pdel(i,k)/gravit & /max(1.e-12_r8,precabs(i)) @@ -844,7 +844,7 @@ subroutine wetdepa_v1( t, p, q, pdel, & ! ****************** Convection *************************** ! now do the convective scavenging - ! set odds proportional to fraction of the grid box that is swept by the + ! set odds proportional to fraction of the grid box that is swept by the ! precipitation =precabc/rhoh20*(area of sphere projected on plane ! /volume of sphere)*deltat ! assume the radius of a raindrop is 1 e-3 m from Rogers and Yau, @@ -860,7 +860,7 @@ subroutine wetdepa_v1( t, p, q, pdel, & ! srcs1 = cldt(i,k)*odds*tracer(i,k)*(1.-weight) & ! srcs1 = cldv(i,k)*odds*tracer(i,k)*(1.-weight) & !srcs1 = cldc(i,k)*odds*tracer(i,k)*(1.-weight) & - ! /deltat + ! /deltat ! fraction of convective cloud water converted to rain fracp = cmfdqr(i,k)*deltat/max(1.e-8_r8,conicw(i,k)) @@ -905,7 +905,7 @@ subroutine wetdepa_v1( t, p, q, pdel, & ! fracp = 0. ! for debug ! assume the corresponding amnt of tracer is removed - !++mcb -- remove cldc; change cldt to cldv + !++mcb -- remove cldc; change cldt to cldv ! srcs1 = (cldt(i,k)-cldc(i,k))*fracp*tracer(i,k)/deltat ! srcs1 = cldv(i,k)*fracp*tracer(i,k)/deltat & ! srcs1 = cldt(i,k)*fracp*tracer(i,k)/deltat ! all condensate @@ -938,7 +938,7 @@ subroutine wetdepa_v1( t, p, q, pdel, & endif srct(i) = (srcc+srcs)*omsm - + ! fraction that is not removed within the cloud ! (assumed to be interstitial, and subject to convective transport) fracp = deltat*srct(i)/max(cldmabs(i)*tracer(i,k),1.e-36_r8) ! amount removed @@ -966,22 +966,22 @@ subroutine wetdepa_v1( t, p, q, pdel, & end do +#ifdef DEBUG + ! only check in debug mode which aborts when larger negative values are found found = .false. do i = 1,ncol - if ( dblchek(i) < 0._r8 ) then + ! catch the larger negative values, ignore insignificant small negaive values + if (dblchek(i) < -1.e-10_r8) then found = .true. - exit - end if + write(iulog,*) ' wetdapa_v1: negative value ', i, k, tracer(i,k), & + dblchek(i), scavt(i,k), srct(i), rat(i), fracev(i) + endif end do - if ( found ) then - do i = 1,ncol - if (dblchek(i) < 0._r8) then - write(iulog,*) ' wetdapa: negative value ', i, k, tracer(i,k), & - dblchek(i), scavt(i,k), srct(i), rat(i), fracev(i) - endif - end do - endif + if (found) then + call endrun('wetdapa_v1: negative values found') + end if +#endif end do @@ -998,10 +998,10 @@ subroutine wetdepg( t, p, q, pdel, & solconst, scavt, iscavt, cldv, icwmr1, & icwmr2, fracis, ncol ) - !----------------------------------------------------------------------- - ! Purpose: + !----------------------------------------------------------------------- + ! Purpose: ! scavenging of gas phase constituents by henry's law - ! + ! ! Author: P. Rasch !----------------------------------------------------------------------- @@ -1014,12 +1014,12 @@ subroutine wetdepg( t, p, q, pdel, & cldc(pcols,pver), &! convective cloud fraction cmfdqr(pcols,pver), &! rate of production of convective precip rain (pcols,pver), &! total rainwater mixing ratio - cwat(pcols,pver), &! cloud water amount + cwat(pcols,pver), &! cloud water amount precs(pcols,pver), &! rate of production of stratiform precip evaps(pcols,pver), &! rate of evaporation of precip ! Sungsu evapc(pcols,pver), &! Rate of evaporation of convective precipitation -! Sungsu +! Sungsu cldv(pcols,pver), &! estimate of local volume occupied by clouds icwmr1 (pcols,pver), &! in cloud water mixing ration for zhang scheme icwmr2 (pcols,pver), &! in cloud water mixing ration for hack scheme @@ -1033,7 +1033,7 @@ subroutine wetdepg( t, p, q, pdel, & solconst(pcols,pver) ! Henry's law coefficient real(r8), intent(out) ::& - scavt(pcols,pver), &! scavenging tend + scavt(pcols,pver), &! scavenging tend iscavt(pcols,pver), &! incloud scavenging tends fracis(pcols, pver) ! fraction of constituent that is insoluble @@ -1044,12 +1044,12 @@ subroutine wetdepg( t, p, q, pdel, & real(r8) adjfac ! factor stolen from cmfmca real(r8) aqfrac ! fraction of tracer in aqueous phase - real(r8) cwatc ! local convective total water amount - real(r8) cwats ! local stratiform total water amount - real(r8) cwatl ! local cloud liq water amount + real(r8) cwatc ! local convective total water amount + real(r8) cwats ! local stratiform total water amount + real(r8) cwatl ! local cloud liq water amount real(r8) cwatp ! local water amount falling from above precip real(r8) cwatpl ! local water amount falling from above precip (liq) - real(r8) cwatt ! local sum of strat + conv total water amount + real(r8) cwatt ! local sum of strat + conv total water amount real(r8) cwatti ! cwatt/cldv = cloudy grid volume mixing ratio real(r8) fracev ! fraction of precip from above that is evaporating real(r8) fracp ! fraction of cloud water converted to precip @@ -1105,17 +1105,17 @@ subroutine wetdepg( t, p, q, pdel, & ! partitioning coefs for gas and aqueous phase ! take as a cloud water amount, the sum of the stratiform amount - ! plus the convective rain water amount + ! plus the convective rain water amount ! convective amnt is just the local precip rate from the hack scheme ! since there is no storage of water, this ignores that falling from above ! cwatc = cmfdqr(i,k)*deltat/adjfac !++mcb -- test cwatc cwatc = (icwmr1(i,k) + icwmr2(i,k)) * (1._r8-weight) - !--mcb + !--mcb ! strat cloud water amount and also ignore the part falling from above - cwats = cwat(i,k) + cwats = cwat(i,k) ! cloud water as liq !++mcb -- add cwatc later (in cwatti) @@ -1127,7 +1127,7 @@ subroutine wetdepg( t, p, q, pdel, & ! total suspended condensate as liquid cwatt = cwatl + rain(i,k) - ! incloud version + ! incloud version !++mcb -- add cwatc here cwatti = cwatt/max(cldv(i,k), 0.00001_r8) + cwatc @@ -1143,14 +1143,14 @@ subroutine wetdepg( t, p, q, pdel, & part = patm*gafrac*tracer(i,k)*molwta/molwt ! use henrys law to give moles tracer /liter of water - ! in this volume + ! in this volume ! then convert to kg tracer /liter of water (kg tracer / kg water) mplb = solconst(i,k)*part*molwt/1000._r8 pdog = pdel(i,k)/gravit - ! this part of precip will be carried downward but at a new molarity of mpl + ! this part of precip will be carried downward but at a new molarity of mpl precic = pdog*(precs(i,k) + cmfdqr(i,k)) ! we cant take out more than entered, plus that available in the cloud @@ -1203,7 +1203,7 @@ subroutine wetdepg( t, p, q, pdel, & !--mcb ! now update the amount leaving the layer - scavbl = scavab(i) - scavt(i,k)*pdog + scavbl = scavab(i) - scavt(i,k)*pdog ! in cloud amount is that formed locally over the total flux out bottom fins = scavin/(scavin + scavbc + 1.e-36_r8) @@ -1212,11 +1212,11 @@ subroutine wetdepg( t, p, q, pdel, & scavab(i) = scavbl precab(i) = max(precxx + precic,1.e-36_r8) - - + + end do end do - + end subroutine wetdepg !############################################################################## diff --git a/src/chemistry/bulk_aero/aero_model.F90 b/src/chemistry/bulk_aero/aero_model.F90 index 4c3d0ab80e..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 @@ -124,16 +126,16 @@ end subroutine aero_model_register !============================================================================= subroutine aero_model_init( pbuf2d ) - use mo_chem_utls, only: get_inv_ndx, get_spc_ndx - use cam_history, only: addfld, add_default, horiz_only - use phys_control, only: phys_getopts - use mo_aerosols, only: aerosols_inti - use mo_setsoa, only: soa_inti - use dust_model, only: dust_init - use seasalt_model, only: seasalt_init - use drydep_mod, only: inidrydep - use wetdep, only: wetdep_init - use mo_setsox, only: has_sox + use mo_chem_utls, only: get_inv_ndx, get_spc_ndx + use cam_history, only: addfld, add_default, horiz_only + use phys_control, only: phys_getopts + use mo_aerosols, only: aerosols_inti + use mo_setsoa, only: soa_inti + use dust_model, only: dust_init + use seasalt_model, only: seasalt_init + use aer_drydep_mod, only: inidrydep + use wetdep, only: wetdep_init + use mo_setsox, only: has_sox ! args type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -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' @@ -384,13 +386,13 @@ end subroutine aero_model_init subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, ptend ) use dust_sediment_mod, only: dust_sediment_tend - use drydep_mod, only: d3ddflux, calcram + use aer_drydep_mod, only: d3ddflux, calcram 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/bulk_aero/seasalt_model.F90 b/src/chemistry/bulk_aero/seasalt_model.F90 index 0d16d40e57..c7104757bc 100644 --- a/src/chemistry/bulk_aero/seasalt_model.F90 +++ b/src/chemistry/bulk_aero/seasalt_model.F90 @@ -107,8 +107,9 @@ subroutine seasalt_depvel( temp, pmid, q, ram1, fv, ncol, lchnk, vlc_dry,vlc_trb real(r8), parameter :: sslt_smt_vwr(seasalt_nbin) = (/0.52e-6_r8,2.38e-6_r8,4.86e-6_r8,15.14e-6_r8/) !----------------------------------------------------------------------- - - call qsat(temp(:ncol,:),pmid(:ncol,:),es(:ncol,:),qs(:ncol,:)) + do k = 1, pver + call qsat(temp(1:ncol,k),pmid(1:ncol,k),es(1:ncol,k),qs(1:ncol,k),ncol) + end do RH(:ncol,:)=q(:ncol,:)/qs(:ncol,:) RH(:ncol,:)=max(0.01_r8,min(0.99_r8,RH(:ncol,:))) ! set stokes correction to 1.0 for now not a bad assumption for our size range) diff --git a/src/chemistry/cloud_j b/src/chemistry/cloud_j new file mode 160000 index 0000000000..d20050f1ef --- /dev/null +++ b/src/chemistry/cloud_j @@ -0,0 +1 @@ +Subproject commit d20050f1ef9e3895d58f3041efd2da59ce1ed421 diff --git a/src/chemistry/geoschem/.exclude b/src/chemistry/geoschem/.exclude new file mode 100644 index 0000000000..3629106b6e --- /dev/null +++ b/src/chemistry/geoschem/.exclude @@ -0,0 +1,20 @@ +geoschem_src/GeosCore/regrid_a2a_mod.F90 +geoschem_src/GeosCore/transport_mod.F90 +geoschem_src/GeosCore/tpcore_window_mod.F90 +geoschem_src/GeosCore/tpcore_fvdas_mod.F90 +geoschem_src/GeosCore/flexgrid_read_mod.F90 +geoschem_src/GeosCore/get_met_mod.F90 +geoschem_src/GeosCore/planeflight_mod.F90 +geoschem_src/GeosCore/diag1.F90 +geoschem_src/GeosCore/diag03_mod.F90 +geoschem_src/GeosCore/diag3.F90 +geoschem_src/GeosCore/diag51_mod.F90 +geoschem_src/GeosCore/diag51b_mod.F90 +geoschem_src/GeosCore/diag53_mod.F90 +geoschem_src/GeosCore/emissions_mod.F90 +geoschem_src/GeosCore/gamap_mod.F90 +geoschem_src/GeosCore/gosat_ch4_mod.F90 +geoschem_src/GeosCore/tccon_ch4_mod.F90 +geoschem_src/GeosCore/initialize.F90 +geoschem_src/GeosCore/cleanup.F90 +geoschem_src/Interfaces/GC-Classic/main.F90 diff --git a/src/chemistry/geoschem/chem_mods.F90 b/src/chemistry/geoschem/chem_mods.F90 new file mode 100644 index 0000000000..7ce98d2ab5 --- /dev/null +++ b/src/chemistry/geoschem/chem_mods.F90 @@ -0,0 +1,110 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use constituents, only : pcnst + implicit none + save + + INTEGER, PARAMETER :: nTracersMax = 269 ! = chem_nadv in cam/bld/configure + INTEGER :: nTracers + REAL(r8) :: ref_MMR(pcnst) + + CHARACTER(LEN=shr_kind_cl) :: tracerNames(nTracersMax) + CHARACTER(LEN=shr_kind_cl) :: tracerLongNames(nTracersMax) + + ! Index of first constituent + INTEGER :: iFirstCnst + + ! Short-lived species (i.e. not advected) + INTEGER, PARAMETER :: nSlsMax = 500 ! UNadvected species only + INTEGER :: nSls + + CHARACTER(LEN=shr_kind_cl) :: slsNames(nSlsMax) + CHARACTER(LEN=shr_kind_cl) :: slsLongnames(nSlsMax) + + ! Mapping between constituents and GEOS-Chem tracers + INTEGER :: map2GC(pcnst) + INTEGER :: map2GCinv(nTracersMax) + INTEGER :: map2GC_Sls(nSlsMax) + + ! Mapping constituent onto chemical species (as listed in solsym) + INTEGER :: mapCnst(pcnst) + + ! Aerosols + INTEGER, PARAMETER :: nAerMax = 35 + INTEGER :: nAer + CHARACTER(LEN=16) :: aerNames(nAerMax) + REAL(r8) :: aerAdvMass(nAerMax) + + !----------------------------- + ! Aerosol index mapping + !----------------------------- + ! map2MAM4 maps aerNames onto the GEOS-Chem Species array such + ! that + ! State_Chm%Species(1,:,:,map2MAM4(:,:)) = state%q(:,:,MAM4_Indices) + INTEGER, ALLOCATABLE :: map2MAM4(:,:) + + !----------------------------- + ! Dry deposition index mapping + !----------------------------- + ! drySpc_ndx maps drydep_list onto tracerNames such that + ! tracerNames(drySpc_ndx(:)) = drydep_list(:) + INTEGER, ALLOCATABLE :: drySpc_ndx(:) + + ! map2GC_dryDep maps drydep_list onto the GEOS-Chem dry deposition + ! velocity arrays such that + ! State_Chm%DryDepVel(1,:,map2GC_dryDep(:)) = cam_in%depVel(:,:) + INTEGER, ALLOCATABLE :: map2GC_dryDep(:) + + INTEGER, PARAMETER :: phtcnt = 40, & ! number of photolysis reactions + rxntot = 212, & ! number of total reactions + gascnt = 172, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 357, & ! number of "gas phase" species (=solsym length) + ! Includes GC advected species, MAM aerosols, + ! and CO2, and any non-advected species added + ! to solsym within mo_sim_dat.F90. + nfs = 6, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 824, & ! number of non-zero matrix entries + extcnt = 34, & ! number of species with external forcing, aka 3-D emissions + clscnt1 = 8, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 95, & ! 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 = 4, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 0, & ! number of tagged reactions (unused in GEOS-Chem) + enthalpy_cnt = 0, & + nslvd = 88 ! number of short-lived (non-advected) species minus CO2 + 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=16), 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=shr_kind_cl), allocatable :: slvd_lst(:) + + ! Mapping between chemical species and GEOS-Chem species/other tracers + INTEGER :: map2chm(gas_pcnst) + + end module chem_mods diff --git a/src/chemistry/geoschem/chemistry.F90 b/src/chemistry/geoschem/chemistry.F90 new file mode 100644 index 0000000000..e46bda2c4e --- /dev/null +++ b/src/chemistry/geoschem/chemistry.F90 @@ -0,0 +1,4782 @@ +module chemistry + + ! CAM modules + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + use chem_mods, only : nTracersMax, nTracers, tracerNames + use chem_mods, only : gas_pcnst, adv_mass, ref_MMR, iFirstCnst + use chem_mods, only : nSlsMax, nSls, slsNames, nSlvd, slvd_Lst + use chem_mods, only : nAerMax, nAer, aerNames, aerAdvMass + use chem_mods, only : map2GC, map2GCinv, map2GC_Sls + use chem_mods, only : mapCnst, map2chm, map2MAM4 + use constituents, only : pcnst, cnst_add, cnst_get_ind, cnst_name + use mo_tracname, only : solsym + use physics_buffer, only : physics_buffer_desc + use physics_types, only : physics_state, physics_ptend, physics_ptend_init + use ppgrid, only : begchunk, endchunk, pcols, pver, pverp + use shr_const_mod, only : molw_dryair=>SHR_CONST_MWDAIR + use shr_drydep_mod, only : nddvels => n_drydep, drydep_list + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use spmd_utils, only : MasterProc, myCPU=>Iam, nCPUs=>npes + use string_utils, only : to_upper +#if defined( MODAL_AERO ) + use modal_aero_data, only : ntot_amode +#endif + + ! GEOS-Chem derived types + USE DiagList_Mod, ONLY : DgnList ! Diagnostics list object + use GeosChem_History_Mod, ONLY : HistoryConfigObj ! History diagnostic object + USE Input_Opt_Mod, ONLY : OptInput ! Input Options + USE Species_Mod, ONLY : Species ! Species object + USE State_Chm_Mod, ONLY : ChmState ! Chemistry State object + USE State_Diag_Mod, ONLY : DgnState ! Diagnostics State object + USE State_Grid_Mod, ONLY : GrdState ! Grid State object + USE State_Met_Mod, ONLY : MetState ! Meteorology State object + USE TaggedDiagList_Mod, ONLY : TaggedDgnList ! Ragged diagnostics list + + ! GEOS-Chem utilities + USE ErrCode_Mod, ONLY : GC_SUCCESS, GC_FAILURE + USE ErrCode_Mod, ONLY : GC_Error, GC_CheckVar, GC_Warning + USE Error_Mod, ONLY : Error_Stop + USE Precision_Mod, ONLY : fp, f4 ! Flexible precision + + IMPLICIT NONE + PRIVATE + SAVE + + ! Public interfaces + public :: chem_is ! identify which chemistry is being used + public :: chem_register ! register consituents + public :: chem_is_active ! returns true if this package is active (ghg_chem=.true.) + public :: chem_implements_cnst ! returns true if consituent is implemented by this package + public :: chem_init_cnst ! initialize mixing ratios if not read from initial file + public :: chem_init ! initialize (history) variables + public :: chem_timestep_tend ! interface to tendency computation + public :: chem_final + public :: chem_write_restart + public :: chem_read_restart + public :: chem_init_restart + public :: chem_readnl ! read chem namelist + public :: chem_emissions + public :: chem_timestep_init + public :: chem_has_ndep_flx + + ! + ! Private routines: + ! + private :: sect02_mam4 + private :: erfc_num_recipes + + ! Location of valid geoschem_config.yml and species_database.yml + ! Use local files in run folder + CHARACTER(LEN=500) :: gcConfig = 'geoschem_config.yml' + CHARACTER(LEN=500) :: speciesDB = 'species_database.yml' + + CHARACTER(LEN=shr_kind_cl) :: geoschem_chem_inputs + CHARACTER(LEN=shr_kind_cl) :: geoschem_aeropt_inputs + CHARACTER(LEN=shr_kind_cl) :: geoschem_photol_inputs + + ! Debugging + LOGICAL :: debug = .TRUE. + + ! Compile-time logical controls. These options are usually not expected + ! to change from run to run and significantly affect the behavior + ! of the model and thus are not read through the namelist. + + ! Use SOA initial conditions from MAM4 (soaX_aY) or GEOS-Chem (SOA*) + ! in the initial conditions (ncdata) / restart file? + LOGICAL :: useSOAICfromMAM4 = .TRUE. + + ! Map back SOAs from MAM4 at the beginning of every chemistry timestep? + ! There are several implications: + ! - MAM4 will perform deposition of SOAs, changing the bulk mass; + ! if disabled, only one-way mapping of GC aerosols to MAM4 is done. + ! deposition of SOAs will still be performed but based on GEOS-Chem species. + ! Either approach is scientifically valid. + LOGICAL :: useMAM4mapBackSOA = .FALSE. + + ! Prescribe aerosol size distributions based on Feng et al. (2021) GMD? + ! This is intended to stabilize the model if only for gas-phase chemistry + ! purposes and will provide a more reasonable radiative/cloud properties. + ! However, it will complicate climate/geoengineering simulations as MAM4 + ! will lose control of the sulfate size distribution. + LOGICAL :: usePrescribedAerDistribution = .FALSE. + + + ! Derived type objects + TYPE(OptInput) :: Input_Opt ! Input Options object + TYPE(ChmState),ALLOCATABLE :: State_Chm(:) ! Chemistry State object + TYPE(DgnState),ALLOCATABLE :: State_Diag(:) ! Diagnostics State object + TYPE(GrdState),ALLOCATABLE :: State_Grid(:) ! Grid State object + TYPE(MetState),ALLOCATABLE :: State_Met(:) ! Meteorology State object + TYPE(DgnList ) :: Diag_List ! Diagnostics list object + TYPE(TaggedDgnList ) :: TaggedDiag_List ! Tagged diagnostics list object + TYPE(HistoryConfigObj), POINTER :: HistoryConfig ! HistoryConfig object for History diagn. + type(physics_buffer_desc), POINTER :: hco_pbuf2d(:,:) ! Pointer to 2D pbuf + + ! Mimic code in sfcvmr_mod.F90 + TYPE :: SfcMrObj + CHARACTER(LEN=63) :: FldName ! Field name + INTEGER :: SpcID ! ID in species database + TYPE(SfcMrObj), POINTER :: Next ! Next element in list + END TYPE SfcMrObj + + ! Heat of linked list with SfcMrObj objects + TYPE(SfcMrObj), POINTER :: SfcMrHead => NULL() + + ! Field prefix + CHARACTER(LEN=63), PARAMETER :: Prefix_SfcVMR = 'VMR_' + + ! Indices of critical species in GEOS-Chem + INTEGER :: iH2O, iO3, iCO2, iSO4 + INTEGER :: iO, iH, iO2 + REAL(r8) :: MWO3 + ! Indices of critical species in the constituent list + INTEGER :: cQ, cH2O, cH2SO4 + ! Indices of critical species in the solsym list + INTEGER :: l_H2SO4, l_SO4 +#if defined( MODAL_AERO ) + INTEGER, ALLOCATABLE :: iSulf(:) +#endif + + ! Indices in the physics buffer + INTEGER :: NDX_PBLH ! PBL height [m] + INTEGER :: NDX_FSDS ! Downward shortwave flux at surface [W/m2] + INTEGER :: NDX_CLDTOP ! Cloud top height [index] + INTEGER :: NDX_CLDFRC ! Cloud fraction [-] + INTEGER :: NDX_PRAIN ! Rain production rate [kg/kg/s] + INTEGER :: NDX_NEVAPR ! Total rate of precipitation evaporation [kg/kg/s] + INTEGER :: NDX_LSFLXPRC ! Large-scale precip. at interface (liq + snw) [kg/m2/s] + INTEGER :: NDX_LSFLXSNW ! Large-scale precip. at interface (snow only) [kg/m2/s] + INTEGER :: NDX_CMFDQR ! Convective total precip. production rate [kg/kg/s] + + ! Get constituent indices + INTEGER :: ixCldLiq ! Cloud liquid water + INTEGER :: ixCldIce ! Cloud ice + INTEGER :: ixNDrop ! Cloud droplet number index + + ! ghg + LOGICAL :: ghg_chem = .false. ! .true. => use ghg chem package + CHARACTER(len=shr_kind_cl) :: bndtvg = ' ' ! pathname for greenhouse gas loss rate + CHARACTER(len=shr_kind_cl) :: h2orates = ' ' ! pathname for greenhouse gas (lyman-alpha H2O loss) + + ! Strings + CHARACTER(LEN=shr_kind_cl) :: ThisLoc + CHARACTER(LEN=shr_kind_cl) :: ErrMsg + + ! For dry deposition + character(len=shr_kind_cl) :: depvel_lnd_file = 'depvel_lnd_file' + + ! for nitrogen deposition fluxes to surface models + logical, parameter :: chem_has_ndep_flx = .false. + +contains + + !================================================================================================ + ! function chem_is + !================================================================================================ + function chem_is (name) result (chem_name_is) + + ! CAM modules + use string_utils, only : to_lower + + character(len=*), intent(in) :: name + logical :: chem_name_is + + chem_name_is = (( to_lower(name) == 'geoschem' ) .or. & + ( to_lower(name) == 'geos-chem' )) + + end function chem_is + + !================================================================================================ + ! subroutine chem_register + !================================================================================================ + subroutine chem_register + + ! CAM modules + use chem_mods, only : drySpc_ndx + use mo_chem_utls, only : get_spc_ndx + use physconst, only : MWDry + use physics_buffer, only : pbuf_add_field, dtype_r8 + use short_lived_species, only : Register_Short_Lived_Species +#if defined( MODAL_AERO ) + use aero_model, only : aero_model_register + use modal_aero_data, only : nspec_max + use modal_aero_data, only : ntot_amode, nspec_amode + use rad_constituents, only : rad_cnst_get_info +#endif + + ! GEOS-Chem interface modules in CAM + use mo_sim_dat, only : set_sim_dat + + ! GEOS-Chem modules + use GC_Environment_Mod, ONLY : GC_Init_Grid + use Input_Opt_Mod, only : Set_Input_Opt, Cleanup_Input_Opt + use State_Chm_Mod, only : Init_State_Chm, Cleanup_State_Chm, Ind_ + use State_Grid_Mod, only : Init_State_Grid, Cleanup_State_Grid + + !----------------------------------------------------------------------- + ! + ! Purpose: register advected constituents for chemistry + ! + !----------------------------------------------------------------------- + ! Need to generate a temporary species database + TYPE(ChmState) :: SC + TYPE(GrdState) :: SG + TYPE(OptInput) :: IO + TYPE(Species), POINTER :: ThisSpc + + INTEGER :: I, N, M, L + INTEGER :: nIgnored + INTEGER :: tmpIdx + REAL(r8) :: cptmp + REAL(r8) :: MWTmp + REAL(r8) :: qmin + REAL(r8) :: refmmr, refvmr + REAL(r8), ALLOCATABLE :: slvd_refmmr(:) + CHARACTER(LEN=128) :: mixtype + CHARACTER(LEN=128) :: molectype + CHARACTER(LEN=128) :: lngName + CHARACTER(LEN=64) :: cnstName + CHARACTER(LEN=64) :: trueName + CHARACTER(LEN=64) :: aerName + LOGICAL :: camout + LOGICAL :: ic_from_cam2 + LOGICAL :: has_fixed_ubc + LOGICAL :: has_fixed_ubflx + + INTEGER :: RC, IERR + + ! Assume a successful return until otherwise + RC = GC_SUCCESS + + ! For error trapping + ErrMsg = '' + ThisLoc = ' -> at GEOS-Chem (in chemistry/geoschem/chemistry.F90)' + + ! Initialize pointer + ThisSpc => NULL() + + if (debug .and. masterproc) write(iulog,'(a)') 'chem_register: registering advected constituents for GEOS-Chem chemistry' + + ! SDE 2018-05-02: This seems to get called before anything else + ! that includes CHEM_INIT + ! At this point, mozart calls SET_SIM_DAT, which is specified by each + ! mechanism separately (ie mozart/chemistry.F90 calls the subroutine + ! set_sim_dat which is in pp_[mechanism]/mo_sim_dat.F90. That sets a lot of + ! data in other places, notably in "chem_mods" + + ! hplin 2020-05-16: Call set_sim_dat to populate chemistry constituent information + ! from mo_sim_dat.F90 in other places. This is needed for HEMCO_CESM. + CALL Set_sim_dat() + + ! Prevent Reporting + IO%amIRoot = .False. + IO%thisCpu = MyCPU + + CALL Set_Input_Opt( am_I_Root = MasterProc, & + Input_Opt = IO, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Could not generate reference input options object!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Options needed by Init_State_Chm + IO%ITS_A_FULLCHEM_SIM = .True. + IO%LLinoz = .True. + IO%Verbose = .False. + IO%N_Advect = nTracers + DO I = 1, nTracers + IO%AdvectSpc_Name(I) = TRIM(tracerNames(I)) + ENDDO + IO%SALA_rEdge_um(1) = 0.01e+0_fp + IO%SALA_rEdge_um(2) = 0.50e+0_fp + IO%SALC_rEdge_um(1) = 0.50e+0_fp + IO%SALC_rEdge_um(2) = 8.00e+0_fp + + IO%SpcDatabaseFile = TRIM(speciesDB) + + CALL Init_State_Grid( Input_Opt = IO, & + State_Grid = SG, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Init_State_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + SG%NX = 1 + SG%NY = 1 + SG%NZ = 1 + + CALL GC_Init_Grid( Input_Opt = IO, & + State_Grid = SG, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error in GC_Init_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Init_CMN_SIZE"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Init_State_Chm( Input_Opt = IO, & + State_Chm = SC, & + State_Grid = SG, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Init_State_Chm"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + iFirstCnst = -1 + mapCnst = -1 + map2GC = -1 + map2GCinv = -1 + map2chm = -1 + ref_MMR(:) = 0.0e+0_r8 + + ! nTracersMax must be # advected species in geoschem_config.yml (nTracers) plus + ! # aerosols (nAer) plus 1 (for CO2). It is set in chem_mods.F90. + DO I = 1, nTracersMax + IF ( I .LE. nTracers ) THEN + cnstName = to_upper(TRIM(tracerNames(I))) + trueName = cnstName + N = Ind_(cnstName) + ThisSpc => SC%SpcData(N)%Info + lngName = TRIM(ThisSpc%FullName) + MWTmp = REAL(ThisSpc%MW_g,r8) + refvmr = REAL(ThisSpc%BackgroundVV,r8) + refmmr = refvmr / (MWDry / MWTmp) + ! Make sure that solsym is following the list of tracers as listed + ! geoschem_config.yml + IF ( to_upper(TRIM(tracerNames(I))) /= to_upper(TRIM(solsym(I))) ) THEN + Write(iulog,*) "tracerNames (", TRIM(tracerNames(I)), ") /= solsym (", & + TRIM(solsym(I)), ")" + CALL ENDRUN('Solsym must be following GEOS-Chem tracer. Check geoschem/mo_sim.dat') + ENDIF + ! Nullify pointer + ThisSpc => NULL() + ELSEIF ( I .LE. (nTracers + nAer) ) THEN + ! Add MAM4 aerosols + cnstName = TRIM(aerNames(I - nTracers)) + trueName = cnstName + lngName = cnstName + MWTmp = aerAdvMass(I - nTracers) + refmmr = 1.0e-38_r8 + ELSEIF ( I .EQ. (nTracers + nAer + 1) ) THEN + ! Add CO2 (which is not a GEOS-Chem tracer) + cnstName = 'CO2' + trueName = cnstName + lngName = cnstName + MWTmp = 44.009800_r8 + refmmr = 1.0e-38_r8 + ELSE + cnstName = TRIM(tracerNames(I)) + trueName = cnstName + lngName = cnstName + MWTmp = 1000.0e+0_r8 * (0.001e+0_r8) + refmmr = 1.0e-38_r8 + ENDIF + + ! dummy value for specific heat of constant pressure (Cp) + cptmp = 666._r8 + ! minimum mixing ratio + qmin = 1.e-38_r8 + ! mixing ratio type + mixtype = 'dry' + ! Used for ionospheric WACCM (WACCM-X) + molectype = 'minor' + ! Is an output field (?) + camout = .false. + ! Not true for O2(1-delta) or O2(1-sigma) + ic_from_cam2 = .true. + ! Use a fixed value at the upper boundary + has_fixed_ubc = .false. + ! Use a fixed flux condition at the upper boundary + has_fixed_ubflx = .false. + + ! TMMF - 8/20/2020 + ! Note: I had to modify the IC file to rename variables such as + ! CH3COCH3 into ACET. Using that new IC file, we can thus remove + ! the unnecessary special handlings. + ! Another option would have been to modify cnst_add and read_inidat + ! to use a load_name the first time IC are read. Constituent names + ! would be stored in cnst_name, while read_inidat would load from + ! load_name. load_name would be an optional argument to cnst_add, such + ! that, by default, load_name = cnst_name. + ! However, this would be tricky to handle with restart files that + ! would save cnst_name rather than load_name. + + ! Special handlings + IF ( cnstName == 'HCHO' ) THEN + cnstName = 'CH2O' + !ELSEIF ( cnstName == 'HNO4' ) THEN + ! cnstName = 'HO2NO2' + !ELSEIF ( cnstName == 'HNO2' ) THEN + ! cnstName = 'HONO' + !ELSEIF ( cnstName == 'ACET' ) THEN + ! cnstName = 'CH3COCH3' + !ELSEIF ( cnstName == 'ALD2' ) THEN + ! cnstName = 'CH3CHO' + !ELSEIF ( cnstName == 'PRPE' ) THEN + ! cnstName = 'C3H6' + !ELSEIF ( cnstName == 'MP' ) THEN + ! cnstName = 'CH3OOH' + !ELSEIF ( cnstName == 'HAC' ) THEN + ! cnstName = 'HYAC' + !ELSEIF ( cnstName == 'GLYC' ) THEN + ! cnstName = 'GLYALD' + !ELSEIF ( cnstName == 'MAP' ) THEN + ! cnstName = 'CH3COOOH' + !ELSEIF ( cnstName == 'EOH' ) THEN + ! cnstName = 'C2H5OH' + !ELSEIF ( cnstName == 'MGLY' ) THEN + ! cnstName = 'CH3COCHO' + !ELSEIF ( cnstName == 'GLYX' ) THEN + ! cnstName = 'GLYOXAL' + !ELSEIF ( cnstName == 'ACTA' ) THEN + ! cnstName = 'CH3COOH' + !ELSEIF ( cnstName == 'TOLU' ) THEN + ! cnstName = 'TOLUENE' + ENDIF + + CALL cnst_add( cnstName, MWtmp, cptmp, qmin, N, & + readiv=ic_from_cam2, mixtype=mixtype, & + cam_outfld=camout, molectype=molectype, & + fixed_ubc=has_fixed_ubc, & + fixed_ubflx=has_fixed_ubflx, & + longname=TRIM(lngName) ) + + IF ( iFirstCnst < 0 ) iFirstCnst = N + + ref_MMR(N) = refmmr + + ! Add to GC mapping. When starting a timestep, we will want to update the + ! concentration of State_Chm(x)%Species(m)%Conc(1,iCol,iLev) with data from + ! constituent n + M = Ind_(TRIM(trueName)) + IF ( M > 0 ) THEN + ! Map constituent onto GEOS-Chem tracer as indexed in State_Chm(LCHNK)%Species + map2GC(N) = M + ! Map GEOS-Chem tracer onto constituent + map2GCinv(M) = N + ENDIF + ! Map constituent onto chemically-active species (aka as indexed in solsym) + M = get_spc_ndx(TRIM(trueName), ignore_case=.true.) + IF ( M > 0 ) THEN + mapCnst(N) = M + ENDIF + ENDDO + + ! Now unadvected species + map2GC_Sls = 0 + ALLOCATE(slvd_refmmr(nslvd), STAT=IERR) + slvd_refmmr(:) = 0.0e+0_r8 + IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate map2MAM4') + DO I = 1, nSlvd + N = Ind_(slsNames(I)) + IF ( N .GT. 0 ) THEN + ThisSpc => SC%SpcData(N)%Info + MWTmp = REAL(ThisSpc%MW_g,r8) + refvmr = REAL(ThisSpc%BackgroundVV,r8) + lngName = TRIM(ThisSpc%FullName) + slvd_refmmr(I) = refvmr / (MWDry / MWTmp) + map2GC_Sls(I) = N + ThisSpc => NULL() + ENDIF + ENDDO + CALL Register_Short_Lived_Species(slvd_refmmr) + DEALLOCATE(slvd_refmmr) + ! More information: + ! http://www.cesm.ucar.edu/models/atm-cam/docs/phys-interface/node5.html + + if (debug .and. masterproc) write(iulog,'(a,i4,a)') 'chem_register: looping over gas_pcnst (length', gas_pcnst, ') to map solsym onto GEOS-Chem species' + + DO N = 1, gas_pcnst + ! Map solsym onto GEOS-Chem species + map2chm(N) = Ind_(TRIM(solsym(N))) + IF ( map2chm(N) < 0 ) THEN + ! This is not a GEOS-Chem species and we thus map to constituents list. + ! Most likely, these will be MAM aerosols + ! We store the index as the opposite to not confuse with GEOS-Chem + ! indices. + CALL cnst_get_ind(TRIM(solsym(N)), I, abort=.True.) + map2chm(N) = -I + if (debug .and. masterproc) write(iulog,'(a,a,a,I4,a,I4)') ' -> solsym species ', trim(solsym(N)), ' (index ', N, ') is not a GEOS-Chem species. Mapping to negative constituent index: ', map2chm(N) + ELSE + if (debug .and. masterproc) write(iulog,'(a,a,a,I4,a,I4)') ' -> solsym species ', trim(solsym(N)), ' (index ', N, ') mapped to GEOS-Chem species ', map2chm(N) + ENDIF + ENDDO + ! Get constituent index of specific humidity + CALL cnst_get_ind('Q', cQ, abort=.True.) + CALL cnst_get_ind('H2O', cH2O, abort=.True.) + CALL cnst_get_ind('H2SO4', cH2SO4, abort=.True.) + + !------------------------------------------------------------ + ! Get mapping between dry deposition species and species set + !------------------------------------------------------------ + + nIgnored = 0 + + if (debug .and. masterproc) write(iulog,'(a,i4,a)') 'chem_register: looping over gas dry deposition list with ', nddvels, ' species' + + DO N = 1, nddvels + + ! The species names need to be convert to upper case as, + ! for instance, BR2 != Br2 + drySpc_ndx(N) = get_spc_ndx( to_upper(drydep_list(N)), ignore_case=.true. ) + + if (debug .and. masterproc) write(iulog,'(a,a,a,i4,a,i4)') ' -> species ', trim(drydep_list(N)), ' in dry deposition list at index ', N, ' maps to species in solsym at index ', drySpc_ndx(N) + + IF ( MasterProc .and. ( drySpc_ndx(N) < 0 ) ) THEN + Write(iulog,'(a,a)') ' ## Ignoring dry deposition of ', & + TRIM(drydep_list(N)) + nIgnored = nIgnored + 1 + ENDIF + ENDDO + + IF ( MasterProc .AND. ( nIgnored > 0 ) ) THEN + Write(iulog,'(a,a)') ' The species listed above have dry', & + ' deposition turned off for one of the following reasons:' + Write(iulog,'(a)') ' - They are not present in the GEOS-Chem tracer list.' + Write(iulog,'(a)') ' - They have a synonym (e.g. CH2O and HCHO).' + ENDIF + +#if defined( MODAL_AERO_4MODE ) + ! add fields to pbuf needed by aerosol models + CALL aero_model_register() + + ! Mode | \sigma_g | Dry diameter (micrometers) + ! -----------------------|----------|-------------------------- + ! a2 - Aitken mode | 1.6 | 0.015 - 0.053 + ! a1 - Accumulation mode | 1.8 | 0.058 - 0.27 + ! a3 - Coarse mode | 1.8 | 0.80 - 3.65 + ! a4 - Primary carbon | 1.6 | 0.039 - 0.13 + ! -----------------------|----------|-------------------------- + ! Ref: Liu, Xiaohong, et al. "Toward a minimal representation of aerosols in + ! climate models: Description and evaluation in the Community Atmosphere + ! Model CAM5." Geoscientific Model Development 5.3 (2012): 709. + + ALLOCATE(map2MAM4(nspec_max,ntot_amode), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate map2MAM4') + + ALLOCATE(iSulf(ntot_amode), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate iSulf') + + ! Initialize indices + map2MAM4(:,:) = -1 + iSulf(:) = -1 + + ! ewl notes: xname_massptr returns a name. The select case subsets characters? e.g. 1:3, 4:5, 5:6. + ! so want to get a name give an L and M. Need anything else??? + + DO M = 1, ntot_amode + DO L = 1, nspec_amode(M) + call rad_cnst_get_info(0,M,L,spec_name=aername) + SELECT CASE ( to_upper(aername(:3)) ) + CASE ( 'BC_' ) + SELECT CASE ( to_upper(aername(4:5)) ) + CASE ( 'A1' ) + CALL cnst_get_ind( 'BCPI', map2MAM4(L,M) ) + CASE ( 'A4' ) + CALL cnst_get_ind( 'BCPO', map2MAM4(L,M) ) + END SELECT + CASE ( 'DST' ) + SELECT CASE ( to_upper(aername(5:6)) ) + ! DST1 - Dust aerosol, Reff = 0.7 micrometers + ! DST2 - Dust aerosol, Reff = 1.4 micrometers + ! DST3 - Dust aerosol, Reff = 2.4 micrometers + ! DST4 - Dust aerosol, Reff = 4.5 micrometers + CASE ( 'A1' ) + CALL cnst_get_ind( 'DST1', map2MAM4(L,M) ) + CASE ( 'A2' ) + CALL cnst_get_ind( 'DST1', map2MAM4(L,M) ) + CASE ( 'A3' ) + CALL cnst_get_ind( 'DST4', map2MAM4(L,M) ) + END SELECT + !CASE ( 'SOA' ) + ! CALL cnst_get_ind( 'SOAS', map2MAM4(L,M) ) + CASE ( 'SO4' ) + CALL cnst_get_ind( 'SO4', map2MAM4(L,M) ) + iSulf(M) = L + CASE ( 'NCL' ) + SELECT CASE ( to_upper(aername(5:6)) ) + ! SALA - Fine (0.01-0.05 micros) sea salt aerosol + ! SALC - Coarse (0.5-8 micros) sea salt aerosol + CASE ( 'A1' ) + CALL cnst_get_ind( 'SALA', map2MAM4(L,M) ) + CASE ( 'A2' ) + CALL cnst_get_ind( 'SALA', map2MAM4(L,M) ) + CASE ( 'A3' ) + CALL cnst_get_ind( 'SALC', map2MAM4(L,M) ) + END SELECT + CASE ( 'POM' ) + SELECT CASE ( to_upper(aername(5:6)) ) + CASE ( 'A1' ) + CALL cnst_get_ind( 'OCPI', map2MAM4(L,M) ) + CASE ( 'A4' ) + CALL cnst_get_ind( 'OCPO', map2MAM4(L,M) ) + END SELECT + END SELECT + ENDDO + ENDDO + +#endif + + ! Print summary + IF ( MasterProc ) THEN + Write(iulog,'(/, a)') '### Summary of GEOS-Chem species (end of chem_register): ' + Write(iulog,'( a)') REPEAT( '-', 50 ) + Write(iulog,'( a)') '+ List of advected species: ' + Write(iulog,100) 'ID', 'Tracer', ''!'Dry deposition (T/F)' + DO N = 1, nTracers + Write(iulog,120) N, TRIM(tracerNames(N))!, ANY(drySpc_ndx .eq. N) + ENDDO + IF ( nAer > 0 ) THEN + Write(iulog,'(/, a)') '+ List of aerosols: ' + Write(iulog,110) 'ID', 'MAM4 Aerosol' + DO N = 1, nAer + Write(iulog,130) N, TRIM(aerNames(N)) + ENDDO + ENDIF + Write(iulog,'(/, a)') '+ List of short-lived species: ' + DO N = 1, nSls + Write(iulog,130) N, TRIM(slsNames(N)) + ENDDO + ENDIF + +100 FORMAT( 1x, A3, 3x, A10, 1x, A25 ) +110 FORMAT( 1x, A3, 3x, A15 ) +!120 FORMAT( 1x, I3, 3x, A10, 1x, L15 ) +120 FORMAT( 1x, I3, 3x, A10 ) +130 FORMAT( 1x, I3, 3x, A10 ) + + ! Clean up + Call Cleanup_State_Chm ( SC, RC ) + Call Cleanup_State_Grid( SG, RC ) + Call Cleanup_Input_Opt ( IO, RC ) + + ! Add data for HEMCO extensions to buffers + call pbuf_add_field('HCO_IN_JNO2', 'global', dtype_r8, (/pcols/), tmpIdx) + call pbuf_add_field('HCO_IN_JOH', 'global', dtype_r8, (/pcols/), tmpIdx) + + if (debug .and. masterproc) write(iulog,'(a)') 'chem_register: advected constituent registration for GEOS-Chem chemistry complete ' + + end subroutine chem_register + + !================================================================================================ + ! subroutine chem_readnl + !================================================================================================ + subroutine chem_readnl(nlfile) + + ! CAM modules + use cam_abortutils, only : endrun + use chem_mods, only : drySpc_ndx + use gas_wetdep_opts, only : gas_wetdep_readnl + use gckpp_Model, only : nSpec, Spc_Names + use namelist_utils, only : find_group_name + use mo_lightning, only : lightning_readnl + use spmd_utils, only : mpicom, masterprocid, mpi_success + use spmd_utils, only : mpi_character, mpi_integer, mpi_logical + use units, only : getunit, freeunit +#if defined( MODAL_AERO ) + use aero_model, only : aero_model_readnl + use dust_model, only : dust_readnl +#endif + ! For dry deposition on unstructured grids + use mo_drydep, only : drydep_srf_file + + ! args + CHARACTER(LEN=*), INTENT(IN) :: nlfile ! filepath for file containing namelist input + + ! Local variables + INTEGER :: I, N + INTEGER :: UNITN, IERR, RC + CHARACTER(LEN=500) :: line + CHARACTER(LEN=63) :: substrs(2) + CHARACTER(LEN=*), PARAMETER :: subname = 'chem_readnl' + LOGICAL :: validSLS, v_bool + + namelist /chem_inparm/ depvel_lnd_file + namelist /chem_inparm/ drydep_srf_file + + ! ghg chem + namelist /chem_inparm/ bndtvg, h2orates, ghg_chem + + if (debug .and. masterproc) write(iulog,'(a)') 'chem_readnl: reading namelists for GEOS-Chem chemistry' + + ! Assume a successful return until otherwise + RC = GC_SUCCESS + + ALLOCATE(drySpc_ndx(nddvels), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate drySpc_ndx') + +#if defined( MODAL_AERO_4MODE ) + ! Get names and molar weights of aerosols in MAM4 + + nAer = 33 + + aerNames(:nAer) = (/ '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 ','soa1_a1 ', & + 'soa1_a2 ','soa2_a1 ','soa2_a2 ', & + 'soa3_a1 ','soa3_a2 ','soa4_a1 ', & + 'soa4_a2 ','soa5_a1 ','soa5_a2 ', & + 'H2SO4 ','SOAG0 ','SOAG1 ', & + 'SOAG2 ','SOAG3 ','SOAG4 ' /) + + aerAdvMass(:nAer) = (/ 12.011000_r8, 12.011000_r8, 135.064039_r8, & + 135.064039_r8, 135.064039_r8, 58.442468_r8, & + 58.442468_r8, 58.442468_r8, 1.007400_r8, & + 1.007400_r8, 1.007400_r8, 1.007400_r8, & + 12.011000_r8, 12.011000_r8, 115.107340_r8, & + 115.107340_r8, 115.107340_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 98.078400_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8 /) + + CALL aero_model_readnl(nlfile) + CALL dust_readnl(nlfile) +#endif + + DO I = (nAer+1), nAerMax + aerNames(I) = 'EMPTY_AER ' + aerAdvMass(I) = -1.00_r8 + ENDDO + + CALL gas_wetdep_readnl(nlfile) + + CALL lightning_readnl(nlfile) + + CALL geoschem_readnl(nlfile) + + IF ( MasterProc ) THEN + + Write(iulog,'(/,a)') REPEAT( '=', 50 ) + Write(iulog,'(a)') REPEAT( '=', 50 ) + Write(iulog,'(a)') 'This is the GEOS-CHEM / CESM interface' + Write(iulog,'(a)') REPEAT( '=', 50 ) + Write(iulog,'(a)') ' + Routines written by Thibaud M. Fritz' + Write(iulog,'(a)') ' + Laboratory for Aviation and the Environment,' + Write(iulog,'(a)') ' + Department of Aeronautics and Astronautics,' + Write(iulog,'(a)') ' + Massachusetts Institute of Technology' + Write(iulog,'(a)') REPEAT( '=', 50 ) + + Write(iulog,'(/,a,/)') 'Now defining GEOS-Chem tracers and dry deposition mapping...' + + !---------------------------------------------------------- + ! Read GEOS-Chem advected species from geoschem_config.yml + !---------------------------------------------------------- + + unitn = getunit() + + OPEN( unitn, FILE=TRIM(gcConfig), STATUS='OLD', IOSTAT=IERR ) + IF (IERR .NE. 0) THEN + CALL ENDRUN('chem_readnl: ERROR opening geoschem_config.yml') + ENDIF + + ! Find the transported species section + DO + READ( unitn, '(a)', IOSTAT=IERR ) line + IF ( IERR .NE. 0 ) CALL ENDRUN('chem_readnl: error finding adv spc list') + LINE = ADJUSTL( ADJUSTR( LINE ) ) + IF ( INDEX( LINE, 'transported_species' ) > 0 ) EXIT + ENDDO + + if (debug) write(iulog,'(a)') 'chem_readnl: reading advected species list from geoschem_config.yml' + + ! Read in all advected species names and add them to tracer names list + nTracers = 0 + DO WHILE ( LEN_TRIM( line ) > 0 ) + READ(unitn,'(a)', IOSTAT=IERR) line + IF ( IERR .NE. 0 ) CALL ENDRUN('chem_readnl: error setting adv spc list') + line = ADJUSTL( ADJUSTR( line ) ) + IF ( INDEX( line, 'passive_species' ) > 0 ) EXIT + IF ( INDEX( LINE, '-' ) > 0 ) THEN + substrs(1) = LINE(3:) + substrs(1) = ADJUSTL( ADJUSTR( substrs(1) ) ) + + ! Remove quotes (i.e. 'NO' -> NO) + I = INDEX( substrs(1), "'" ) + IF ( I > 0 ) THEN + substrs(1) = substrs(1)(I+1:) + I = INDEX( substrs(1), "'" ) + IF ( I > 0 ) substrs(1) = substrs(1)(1:I-1) + ENDIF + + nTracers = nTracers + 1 + tracerNames(nTracers) = TRIM(substrs(1)) + + write(iulog,'(a,i4,a,a)') ' ', nTracers, ' ', TRIM(substrs(1)) + ENDIF + ENDDO + CLOSE(unitn) + CALL freeunit(unitn) + + ! Assign remaining tracers dummy names + DO I = (nTracers+1), nTracersMax + WRITE(tracerNames(I),'(a,I0.4)') 'GCTRC_', I + ENDDO + + !---------------------------------------------------------- + ! Now go through the KPP mechanism and add any species not + ! implemented by the tracer list in geoschem_config.yml + !---------------------------------------------------------- + + IF ( nSpec > nSlsMax ) THEN + CALL ENDRUN('chem_readnl: too many species - increase nSlsmax') + ENDIF + + if (debug .and. masterproc) write(iulog,'(a)') 'chem_readnl: getting non-advected (short-lived) species list from KPP' + if (debug .and. masterproc) write(iulog,'(a)') 'NOTE: does not include CO2 even if CO2 is not advected' + + nSls = 0 + DO I = 1, nSpec + ! Get the name of the species from KPP + line = ADJUSTL(TRIM(Spc_Names(I))) + ! Only add short-lived KPP species, except from CO2 + validSLS = (( .NOT. ANY(TRIM(line) .EQ. tracerNames) ) & + .AND. TRIM(line) /= 'CO2' ) + IF ( validSLS ) THEN + ! Genuine new short-lived species + nSls = nSls + 1 + slsNames(nSls) = TRIM(line) + write(iulog,'(a,i4,a,a)') ' ', nSls, ' ', TRIM(slsNames(nSls)) + ENDIF + ENDDO + + unitn = getunit() + OPEN( unitn, FILE=TRIM(nlfile), STATUS='old', IOSTAT=IERR ) + IF (IERR .NE. 0) THEN + CALL ENDRUN('chem_readnl: ERROR opening '//TRIM(nlfile)) + ENDIF + + CALL find_group_name(unitn, 'chem_inparm', STATUS=IERR) + IF (IERR == 0) THEN + READ(unitn, chem_inparm, IOSTAT=IERR) + IF (IERR /= 0) THEN + CALL endrun('chem_readnl: ERROR reading namelist chem_inparm') + ENDIF + ENDIF + CLOSE(unitn) + CALL freeunit(unitn) + + ENDIF + + !---------------------------------------------------------- + ! Broadcast to all processors + !---------------------------------------------------------- + CALL mpi_bcast(nTracers, 1, mpi_integer, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: nTracers') + ENDIF + CALL mpi_bcast(tracerNames, LEN(tracerNames(1))*nTracersMax, mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: tracerNames') + ENDIF + CALL mpi_bcast(nSls, 1, mpi_integer, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: nSls') + ENDIF + CALL mpi_bcast(slsNames, LEN(slsNames(1))*nSlsMax, mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: slsNames') + ENDIF + + ! Broadcast namelist variables + CALL mpi_bcast(depvel_lnd_file, LEN(depvel_lnd_file), mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: depvel_lnd_file') + ENDIF + CALL mpi_bcast(drydep_srf_file, LEN(drydep_srf_file), mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: drydep_srf_file') + ENDIF + CALL mpi_bcast(ghg_chem, 1, mpi_logical, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: ghg_chem') + ENDIF + CALL mpi_bcast(bndtvg, LEN(bndtvg), mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: bndtvg') + ENDIF + CALL mpi_bcast(h2orates, LEN(h2orates), mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: h2orates') + ENDIF + + IF ( nSls .NE. nSlvd ) THEN + write(iulog,'(a,i4)') 'nSlvd in geoschem/chem_mods.F90 does not match # non-advected KPP species. Set nSlvd to ', nSls + CALL ENDRUN('Failure while allocating slvd_Lst') + ENDIF + + ALLOCATE(slvd_Lst(nSlvd), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating slvd_Lst') + DO I = 1, nSls + slvd_Lst(I) = TRIM(slsNames(I)) + ENDDO + + if (debug .and. masterproc) write(iulog,'(a)') 'chem_readnl: reading GEOS-Chem chemistry namelists complete' + + end subroutine chem_readnl + + !================================================================================================ + ! function chem_is_active + !================================================================================================ + function chem_is_active() + + logical :: chem_is_active + + chem_is_active = .true. + + end function chem_is_active + + !================================================================================================ + ! function chem_implements_cnst + !================================================================================================ + function chem_implements_cnst(name) + ! Purpose: return true if specified constituent is implemented by this package + ! Author: B. Eaton + + IMPLICIT NONE + + CHARACTER(LEN=*), INTENT(IN) :: name ! constituent name + LOGICAL :: chem_implements_cnst ! return value + INTEGER :: M + + chem_implements_cnst = .false. + DO M = 1, gas_pcnst + IF (TRIM(solsym(M)) .eq. TRIM(name)) THEN + chem_implements_cnst = .true. + EXIT + ENDIF + ENDDO + + end function chem_implements_cnst + + !================================================================================================ + ! subroutine chem_init + !================================================================================================ + subroutine chem_init(phys_state, pbuf2d) + !----------------------------------------------------------------------- + ! + ! Purpose: initialize GEOS-Chem parts (state objects, mainly) + ! (and declare history variables) + ! + !----------------------------------------------------------------------- + + ! CAM modules + use cam_abortutils, only : endrun + use chem_mods, only : map2GC_dryDep, drySpc_ndx + use gas_wetdep_opts, only : gas_wetdep_method + use hycoef, only : ps0, hyai, hybi, hyam + use mo_chem_utls, only : get_spc_ndx + use mo_ghg_chem, only : ghg_chem_init + use mo_mean_mass, only : init_mean_mass + use mo_neu_wetdep, only : neu_wetdep_init + use mo_setinv, only : setinv_inti + use Phys_Grid, only : get_Area_All_p + use physics_buffer, only : physics_buffer_desc, pbuf_get_index + use spmd_utils, only : mpicom, masterprocid, mpi_real8, mpi_success + use tracer_cnst, only : tracer_cnst_init + use tracer_srcs, only : tracer_srcs_init +#if defined( MODAL_AERO ) + use aero_model, only : aero_model_init + use mo_setsox, only : sox_inti + use mo_drydep, only : drydep_inti + use modal_aero_data, only : ntot_amode, nspec_amode +#endif + + ! GEOS-Chem interface modules in CAM + use geoschem_diagnostics_mod, only : GC_Diagnostics_Init + use geoschem_emissions_mod, only : GC_Emissions_Init + use geoschem_history_mod, only : HistoryExports_SetServices + + ! GEOS-Chem modules + use DiagList_Mod, only : Init_DiagList, Print_DiagList + use Drydep_Mod, only : depName, Ndvzind + use Error_Mod, only : Init_Error + use GC_Environment_Mod, only : GC_Init_Grid, GC_Init_StateObj + use GC_Environment_Mod, only : GC_Init_Extra, GC_Allocate_All + use GC_Grid_Mod, only : SetGridFromCtrEdges + use Input_Mod, only : Read_Input_File, Validate_Directories + use Input_Opt_Mod, only : Set_Input_Opt + use Aerosol_Thermodynamics_Mod, only : Init_ATE + use Linear_Chem_Mod, only : Init_Linear_Chem + use Linoz_Mod, only : Linoz_Read + use Photolysis_Mod, only : Init_Photolysis + use PhysConstants, only : PI, PI_180, Re + use Pressure_Mod, only : Accept_External_ApBp + use State_Chm_Mod, only : Ind_ + use State_Grid_Mod, only : Init_State_Grid, Cleanup_State_Grid + use TaggedDiagList_Mod, only : Init_TaggedDiagList, Print_TaggedDiagList + use Time_Mod, only : Accept_External_Date_Time + use Ucx_Mod, only : Init_Ucx + use Unitconv_Mod, only : MOLES_SPECIES_PER_MOLES_DRY_AIR + use Vdiff_Mod, only : Max_PblHt_For_Vdiff + + TYPE(physics_state), INTENT(IN ) :: phys_state(BEGCHUNK:ENDCHUNK) + TYPE(physics_buffer_desc), POINTER, INTENT(INOUT) :: pbuf2d(:,:) + + ! Local variables + + !---------------------------- + ! Scalars + !---------------------------- + + ! Integers + INTEGER :: LCHNK(BEGCHUNK:ENDCHUNK), NCOL(BEGCHUNK:ENDCHUNK) + INTEGER :: IWAIT, IERR + INTEGER :: nX, nY, nZ + INTEGER :: nStrat, nTrop + INTEGER :: I, J, L, N, M + INTEGER :: RC + INTEGER :: nLinoz + + ! Logicals + LOGICAL :: prtDebug + LOGICAL :: Found + + ! Strings + CHARACTER(LEN=shr_kind_cl) :: historyConfigFile + CHARACTER(LEN=shr_kind_cl) :: SpcName + CHARACTER(LEN=*), PARAMETER :: subname = 'chem_init' + + ! Objects + TYPE(Species), POINTER :: SpcInfo + + ! Grid setup + REAL(fp) :: lonVal, latVal + REAL(fp) :: dLonFix, dLatFix + REAL(f4), ALLOCATABLE :: lonMidArr(:,:), latMidArr(:,:) + REAL(f4), ALLOCATABLE :: lonEdgeArr(:,:), latEdgeArr(:,:) + REAL(r8), ALLOCATABLE :: linozData(:,:,:,:) + + ! Grid with largest number of columns + TYPE(GrdState) :: maxGrid ! Grid State object + + REAL(r8), ALLOCATABLE :: Col_Area(:) + REAL(fp), ALLOCATABLE :: Ap_CAM_Flip(:), Bp_CAM_Flip(:) + + !REAL(r8), POINTER :: SlsPtr(:,:,:) + + ! Assume a successful return until otherwise + RC = GC_SUCCESS + + ! For error trapping + ErrMsg = '' + ThisLoc = ' -> at GEOS-Chem (in chemistry/geoschem/chemistry.F90)' + + ! Initialize pointers + SpcInfo => NULL() + + if (debug .and. masterproc) write(iulog,'(a)') 'chem_init: initializing GEOS-Chem chemistry' + + ! LCHNK: which chunks we have on this process + LCHNK = phys_state%LCHNK + ! NCOL: number of atmospheric columns for each chunk + NCOL = phys_state%NCOL + + ! The GEOS-Chem grids on every "chunk" will all be the same size, to avoid + ! the possibility of having differently-sized chunks + nX = 1 + !nY = MAXVAL(NCOL) + nY = PCOLS + nZ = PVER + + !! Add short lived speies to buffers + !CALL Pbuf_add_field(Trim(SLSBuffer),'global',dtype_r8,(/PCOLS,PVER,nSls/),Sls_Pbf_Idx) + !! Initialize + !ALLOCATE(SlsPtr(PCOLS,PVER,BEGCHUNK:ENDCHUNK), STAT=IERR) + !IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating SlsPtr') + !SlsPtr(:,:,:) = 0.0e+0_r8 + !DO I=1,nSls + ! SlsPtr(:,:,:) = sls_ref_MMR(I) + ! CALL pbuf_set_field(pbuf2d,Sls_Pbf_Idx,SlsPtr,start=(/1,1,i/),kount=(/PCOLS,PVER,1/)) + !ENDDO + !DEALLOCATE(SlsPtr) + + ! This ensures that each process allocates everything needed for its chunks + ALLOCATE(State_Chm(BEGCHUNK:ENDCHUNK) , STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Chm') + ALLOCATE(State_Diag(BEGCHUNK:ENDCHUNK) , STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Diag') + ALLOCATE(State_Grid(BEGCHUNK:ENDCHUNK), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Grid') + ALLOCATE(State_Met(BEGCHUNK:ENDCHUNK) , STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating State_Met') + + ! Initialize fields of the Input Options object + CALL Set_Input_Opt( am_I_Root = MasterProc, & + Input_Opt = Input_Opt, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Set_Input_Opt"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Find maximum tropopause level, set at 40 hPa (based on GEOS-Chem 72 and 47 + ! layer grids) + nTrop = nZ + DO WHILE ( hyam(nZ+1-nTrop) * ps0 < 4000.0_r8 ) + nTrop = nTrop-1 + ENDDO + ! Find stratopause level, defined at 1 hPa + nStrat = nZ + DO WHILE ( hyam(nZ+1-nStrat) * ps0 < 100.0_r8 ) + nStrat = nStrat-1 + ENDDO + + ! Initialize grid with largest number of columns + ! This is required as State_Grid(LCHNK) can have different + ! number of columns, but GEOS-Chem arrays are defined based + ! on State_Grid(BEGCHUNK). + ! To go around this, we define all of GEOS-Chem arrays with + ! size PCOLS x PVER, which is the largest possible number of + ! grid cells. + CALL Init_State_Grid( Input_Opt = Input_Opt, & + State_Grid = maxGrid, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Init_State_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + maxGrid%NX = nX + maxGrid%NY = nY + maxGrid%NZ = nZ + + Input_Opt%thisCPU = myCPU + Input_Opt%amIRoot = MasterProc + + CALL Read_Input_File( Input_Opt = Input_Opt, & + State_Grid = maxGrid, & + RC = RC ) + + ! First setup directories. FAST-JX directory is still used for + ! optical properties of aerosols outside of Cloud-J. + Input_Opt%Chem_Inputs_Dir = TRIM(geoschem_chem_inputs) + Input_Opt%SpcDatabaseFile = TRIM(speciesDB) + Input_Opt%FAST_JX_DIR = TRIM(geoschem_aeropt_inputs) + Input_Opt%CLOUDJ_DIR = TRIM(geoschem_photol_inputs) + + !---------------------------------------------------------- + ! CESM-specific input flags + !---------------------------------------------------------- + + ! onlineAlbedo -> True (use CLM albedo) + ! -> False (read monthly-mean albedo from HEMCO) + Input_Opt%onlineAlbedo = .true. + + ! applyQtend: apply tendencies of water vapor to specific humidity + Input_Opt%applyQtend = .False. + + ! correctConvUTLS: Apply photolytic correction for convective scavenging of soluble tracers? + Input_Opt%correctConvUTLS = .true. + + IF ( .NOT. Input_Opt%LSOA ) THEN + CALL ENDRUN('CESM2-GC requires the complex SOA option to be on!') + ENDIF + + CALL Validate_Directories( Input_Opt, RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Validate_Directories"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Initialize GEOS-Chem horizontal grid structure + CALL GC_Init_Grid( Input_Opt = Input_Opt, & + State_Grid = maxGrid, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "GC_Init_Grid" (1 - maxGrid)!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Define more variables for maxGrid + maxGrid%MaxTropLev = nTrop + maxGrid%MaxStratLev = nStrat + maxGrid%MaxChemLev = maxGrid%MaxStratLev + + DO I = BEGCHUNK, ENDCHUNK + + ! Initialize fields of the Grid State object + CALL Init_State_Grid( Input_Opt = Input_Opt, & + State_Grid = State_Grid(I), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "Init_State_Grid"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Set grid metadata. This has to be after State_Grid is initialized. + State_Grid(I)%CPU_Subdomain_ID = I + State_Grid(I)%CPU_Subdomain_FirstID = BEGCHUNK + + State_Grid(I)%NX = nX + State_Grid(I)%NY = NCOL(I) + State_Grid(I)%NZ = nZ + + ! Initialize GEOS-Chem horizontal grid structure + CALL GC_Init_Grid( Input_Opt = Input_Opt, & + State_Grid = State_Grid(I), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "GC_Init_Grid" (2 - chunk)!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Define more variables for State_Grid + State_Grid(I)%MaxTropLev = nTrop + State_Grid(I)%MaxStratLev = nStrat + + ! Set maximum number of levels in the chemistry grid + State_Grid(I)%MaxChemLev = State_Grid(I)%MaxStratLev + + ENDDO + + ! Note - this is called AFTER chem_readnl, after X, and after + ! every constituent has had its initial conditions read. Any + ! constituent which is not found in the CAM restart file will + ! then have already had a call to chem_implements_cnst, and will + ! have then had a call to chem_init_cnst to set a default VMR + ! Call the routine GC_Allocate_All (located in module file + ! GeosCore/gc_environment_mod.F90) to allocate all lat/lon + ! allocatable arrays used by GEOS-Chem. + CALL GC_Allocate_All ( Input_Opt = Input_Opt, & + State_Grid = maxGrid, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "GC_Allocate_All"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Read in data for Linoz. All CPUs allocate one array to hold the data. Only + ! the root CPU reads in the data; then we copy it out to a temporary array, + ! broadcast to all other CPUs, and finally duplicate the data into every + ! copy of Input_Opt + IF ( Input_Opt%LLinoz ) THEN + ! Allocate array for broadcast + nLinoz = Input_Opt%Linoz_NLevels * & + Input_Opt%Linoz_NLat * & + Input_Opt%Linoz_NMonths * & + Input_Opt%Linoz_NFields + ALLOCATE( linozData( Input_Opt%Linoz_NLevels, & + Input_Opt%Linoz_NLat, & + Input_Opt%Linoz_NMonths, & + Input_Opt%Linoz_NFields ), STAT=IERR) + IF (IERR .NE. 0) CALL ENDRUN('Failure while allocating linozData') + linozData = 0.0e+0_r8 + + IF ( MasterProc ) THEN + ! Read data in to Input_Opt%Linoz_TParm + CALL Linoz_Read( Input_Opt, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Linoz_Read"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ! Copy the data to a temporary array + linozData = REAL(Input_Opt%LINOZ_TPARM, r8) + ENDIF + CALL mpi_bcast(linozData, nLinoz, mpi_real8, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: linozData') + ENDIF + IF ( .NOT. MasterProc ) THEN + Input_Opt%LINOZ_TPARM = REAL(linozData,fp) + ENDIF + IF ( ALLOCATED( linozData ) ) DEALLOCATE(linozData) + ENDIF + + ! Note: The following calculations do not setup the gridcell areas. + ! In any case, we will need to be constantly updating this grid + ! to compensate for the "multiple chunks per processor" element + ALLOCATE(lonMidArr(maxGrid%nX,maxGrid%nY), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating lonMidArr') + ALLOCATE(lonEdgeArr(maxGrid%nX+1,maxGrid%nY+1), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating lonEdgeArr') + ALLOCATE(latMidArr(maxGrid%nX,maxGrid%nY), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating latMidArr') + ALLOCATE(latEdgeArr(maxGrid%nX+1,maxGrid%nY+1), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating latEdgeArr') + + ! We could try and get the data from CAM.. but the goal is to make this GC + ! component completely grid independent. So for now, we set to arbitrary + ! values + ! TODO: This needs more refinement. For now, this generates identical + ! State_Grid for all chunks + DO L = BEGCHUNK, ENDCHUNK + lonMidArr = 0.0e+0_f4 + latMidArr = 0.0e+0_f4 + dLonFix = 360.0e+0_fp / REAL(nX,fp) + dLatFix = 180.0e+0_fp / REAL(NCOL(L),fp) + DO I = 1, nX + ! Center of box, assuming dateline edge + lonVal = -180.0e+0_fp + (REAL(I-1,fp)*dLonFix) + DO J = 1, NCOL(L) + ! Center of box, assuming regular cells + latVal = -90.0e+0_fp + (REAL(J-1,fp)*dLatFix) + lonMidArr(I,J) = REAL((lonVal + (0.5e+0_fp * dLonFix)) * PI_180, f4) + latMidArr(I,J) = REAL((latVal + (0.5e+0_fp * dLatFix)) * PI_180, f4) + + ! Edges of box, assuming regular cells + lonEdgeArr(I,J) = REAL(lonVal * PI_180, f4) + latEdgeArr(I,J) = REAL(latVal * PI_180, f4) + ENDDO + ! Edges of box, assuming regular cells + lonEdgeArr(I,NCOL(L)+1) = REAL((lonVal + dLonFix) * PI_180, f4) + latEdgeArr(I,NCOL(L)+1) = REAL((latVal + dLatFix) * PI_180, f4) + ENDDO + DO J = 1, NCOL(L)+1 + ! Edges of box, assuming regular cells + latVal = -90.0e+0_fp + (REAL(J-1,fp)*dLatFix) + lonEdgeArr(nX+1,J) = REAL((lonVal + dLonFix) * PI_180, f4) + latEdgeArr(nX+1,J) = REAL((latVal) * PI_180, f4) + ENDDO + + CALL SetGridFromCtrEdges( Input_Opt = Input_Opt, & + State_Grid = State_Grid(L), & + lonCtr = lonMidArr, & + latCtr = latMidArr, & + lonEdge = lonEdgeArr, & + latEdge = latEdgeArr, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "SetGridFromCtrEdges"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ENDDO + IF ( ALLOCATED( lonMidArr ) ) DEALLOCATE( lonMidArr ) + IF ( ALLOCATED( latMidArr ) ) DEALLOCATE( latMidArr ) + IF ( ALLOCATED( lonEdgeArr ) ) DEALLOCATE( lonEdgeArr ) + IF ( ALLOCATED( latEdgeArr ) ) DEALLOCATE( latEdgeArr ) + + ! Set the times held by "time_mod" + CALL Accept_External_Date_Time( value_NYMDb = Input_Opt%NYMDb, & + value_NHMSb = Input_Opt%NHMSb, & + value_NYMDe = Input_Opt%NYMDe, & + value_NHMSe = Input_Opt%NHMSe, & + value_NYMD = Input_Opt%NYMDb, & + value_NHMS = Input_Opt%NHMSb, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Accept_External_Date_Time"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Start by setting some dummy timesteps + CALL GC_Update_Timesteps(300.0E+0_r8) + + ! Initialize error module + CALL Init_Error( Input_Opt, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Error"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Set a flag to denote if we should print ND70 debug output + prtDebug = ( Input_Opt%Verbose .and. MasterProc ) + + historyConfigFile = 'HISTORY.rc' + ! This requires geoschem_config.yml and HISTORY.rc to be in the run directory + ! This is the current way chosen to diagnose photolysis rates! + CALL Init_DiagList( MasterProc, historyConfigFile, Diag_List, RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_DiagList"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Initialize the TaggedDiag_List (list of wildcards/tags per diagnostic) + CALL Init_TaggedDiagList( Input_Opt%amIroot, Diag_List, & + TaggedDiag_List, RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_TaggedDiagList"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + IF ( prtDebug ) THEN + CALL Print_DiagList( Input_Opt%amIRoot, Diag_List, RC ) + CALL Print_TaggedDiagList( Input_Opt%amIRoot, TaggedDiag_List, RC ) + ENDIF + + ! There are actually two copies of the history configuration, one is contained + ! within HistoryConfig to mimic the properties of GCHP. + ! + ! The above original implementation is similar to GC-Classic and WRF-GC, + ! and is used by geoschem_diagnostics_mod for lookups for certain diagnostic + ! fields for compatibility with CAM-chem outputs. + ! (hplin, 10/31/22) + CALL HistoryExports_SetServices(am_I_Root = masterproc, & + config_file = historyConfigFile, & + HistoryConfig = HistoryConfig, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "HistoryExports_SetServices"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + DO I = BEGCHUNK, ENDCHUNK + ! Restrict prints to one thread only + Input_Opt%amIRoot = (MasterProc .AND. (I == BEGCHUNK)) + + CALL GC_Init_StateObj( Diag_List = Diag_List, & ! Diagnostic list obj + TaggedDiag_List = TaggedDiag_List, & ! TaggedDiag list obj + Input_Opt = Input_Opt, & ! Input Options + State_Chm = State_Chm(I), & ! Chemistry State + State_Diag = State_Diag(I), & ! Diagnostics State + State_Grid = maxGrid, & ! Grid State + State_Met = State_Met(I), & ! Meteorology State + RC = RC ) ! Success or failure + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "GC_Init_StateObj"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Start with v/v dry (CAM standard) + DO N = 1, State_Chm(I)%nSpecies + State_Chm(I)%Species(N)%Units = MOLES_SPECIES_PER_MOLES_DRY_AIR + ENDDO + + ENDDO + Input_Opt%amIRoot = MasterProc + + CALL GC_Init_Extra( Diag_List = Diag_List, & ! Diagnostic list obj + & Input_Opt = Input_Opt, & ! Input Options + & State_Chm = State_Chm(BEGCHUNK), & ! Chemistry State + & State_Diag = State_Diag(BEGCHUNK), & ! Diagnostics State + & State_Grid = maxGrid, & ! Grid State + & RC = RC ) ! Success or failure + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "GC_Init_Extra"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + IF ( Input_Opt%LDryD ) THEN + !---------------------------------------------------------- + ! Get mapping between CESM dry deposited species and the + ! indices of State_Chm%DryDepVel. This needs to be done after + ! Init_Drydep + ! Thibaud M. Fritz - 04 Mar 2020 + !---------------------------------------------------------- + + ALLOCATE(map2GC_dryDep(nddvels), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failed to allocate map2GC_dryDep') + + DO N = 1, nddvels + ! Initialize index to -1 + map2GC_dryDep(N) = -1 + + IF ( drySpc_ndx(N) > 0 ) THEN + + ! Convert to upper case + SpcName = to_upper(drydep_list(N)) + + DO I = 1, State_Chm(BEGCHUNK)%nDryDep + IF ( TRIM( SpcName ) == TRIM( to_upper(depName(I)) ) ) THEN + map2GC_dryDep(N) = nDVZind(I) + EXIT + ENDIF + ENDDO + + ! Print out debug information + IF ( masterProc ) THEN + IF ( N == 1 ) Write(iulog,*) " ++ GEOS-Chem Dry deposition ++ " + IF ( map2GC_dryDep(N) > 0 ) THEN + Write(iulog,*) " CESM species: ", TRIM(drydep_list(N)), & + ' is matched with ', depName(map2GC_dryDep(N)) + ELSE + Write(iulog,*) " CESM species: ", TRIM(drydep_list(N)), & + ' has no match' + ENDIF + ENDIF + + ENDIF + ENDDO + ENDIF + +#if defined( MODAL_AERO ) + ! Initialize aqueous chem + CALL SOx_inti() + + ! Initialize aerosols + CALL aero_model_init( pbuf2d ) + + ! Initialize drydep + CALL drydep_inti( depvel_lnd_file ) +#endif + + IF ( gas_wetdep_method == 'NEU' ) THEN + ! Initialize MOZART's wet deposition + CALL Neu_wetdep_init() + ENDIF + + ! Set grid-cell area + DO N = BEGCHUNK, ENDCHUNK + ALLOCATE(Col_Area(State_Grid(N)%nY), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating Col_Area') + + CALL Get_Area_All_p(N, State_Grid(N)%nY, Col_Area) + + ! Set default value (in case of chunks with fewer columns) + State_Grid(N)%Area_M2 = 1.0e+10_fp + DO I = 1, State_Grid(N)%nX + DO J = 1, State_Grid(N)%nY + State_Grid(N)%Area_M2(I,J) = REAL(Col_Area(J) * Re**2,fp) + State_Met(N)%Area_M2(I,J) = State_Grid(N)%Area_M2(I,J) + ENDDO + ENDDO + + IF ( ALLOCATED( Col_Area ) ) DEALLOCATE(Col_Area) + ENDDO + + ! Initialize (mostly unused) diagnostic arrays + ! WARNING: This routine likely calls on modules which are currently + ! excluded from the GC-CESM build (eg diag03) + ! CALL Initialize( MasterProc, Input_Opt, 2, RC ) + ! CALL Initialize( Masterproc, Input_Opt, 3, RC ) + + ! Get Ap and Bp from CAM at pressure edges + ALLOCATE(Ap_CAM_Flip(nZ+1), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating Ap_CAM_Flip') + ALLOCATE(Bp_CAM_Flip(nZ+1), STAT=IERR) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating Bp_CAM_Flip') + + Ap_CAM_Flip = 0.0e+0_fp + Bp_CAM_Flip = 0.0e+0_fp + DO I = 1, nZ+1 + Ap_CAM_Flip(I) = hyai(nZ+2-I) * ps0 * 0.01e+0_r8 + Bp_CAM_Flip(I) = hybi(nZ+2-I) + ENDDO + + !----------------------------------------------------------------- + ! Pass external Ap and Bp to GEOS-Chem's Pressure_Mod + !----------------------------------------------------------------- + CALL Accept_External_ApBp( State_Grid = maxGrid, & ! Grid State + ApIn = Ap_CAM_Flip, & ! "A" term for hybrid grid + BpIn = Bp_CAM_Flip, & ! "B" term for hybrid grid + RC = RC ) ! Success or failure + + ! Print vertical coordinates + IF ( MasterProc ) THEN + WRITE( 6, '(a)' ) REPEAT( '=', 79 ) + WRITE( 6, '(a,/)' ) 'V E R T I C A L G R I D S E T U P' + WRITE( 6, '( ''Ap '', /, 6(f11.6,1x) )' ) Ap_CAM_Flip(1:maxGrid%nZ+1) + WRITE( 6, '(a)' ) + WRITE( 6, '( ''Bp '', /, 6(f11.6,1x) )' ) Bp_CAM_Flip(1:maxGrid%nZ+1) + WRITE( 6, '(a)' ) REPEAT( '=', 79 ) + ENDIF + + ! Trapping errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Accept_External_ApBp"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + IF ( ALLOCATED( Ap_CAM_Flip ) ) DEALLOCATE( Ap_CAM_Flip ) + IF ( ALLOCATED( Bp_CAM_Flip ) ) DEALLOCATE( Bp_CAM_Flip ) + + ! Once the initial met fields have been read in, we need to find + ! the maximum PBL level for the non-local mixing algorithm. + CALL Max_PblHt_For_Vdiff( Input_Opt = Input_Opt, & + State_Grid = State_Grid(BEGCHUNK), & + State_Met = State_Met(BEGCHUNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Max_PblHt_for_Vdiff"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Initialize photolysis, including reading files for optical properties. + IF ( Input_Opt%ITS_A_FULLCHEM_SIM .or. & + Input_Opt%ITS_AN_AEROSOL_SIM ) THEN + DO I = BEGCHUNK, ENDCHUNK + CALL Init_Photolysis( Input_Opt = Input_Opt, & + State_Grid = State_Grid(I), & + State_Chm = State_Chm(I), & + State_Diag = State_Diag(I), & + RC = RC ) + + ! Only the root chunk (on all CPUs) should be reading the data + ! in State_Chm%Phot%OREF and State_Chm%Phot%TREF, and the rest should be copied. + ! This fixes a hang condition in the ne30 (SE dycore) compsets. (hplin, 7/3/24) + IF( I .ne. BEGCHUNK ) THEN + State_Chm(I)%Phot%TREF = State_Chm(BEGCHUNK)%Phot%TREF + State_Chm(I)%Phot%OREF = State_Chm(BEGCHUNK)%Phot%OREF + ENDIF + ENDDO + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Photolysis"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + ! hplin 3/3/23: note, since we moved UCX module variables to + ! individual State_Chm variables, Init_UCX has to be called + ! for all chunks (all State_Chm) to properly initialize all + ! variables. + IF ( Input_Opt%LChem ) THEN + DO I = BEGCHUNK, ENDCHUNK + CALL Init_UCX( Input_Opt = Input_Opt, & + State_Chm = State_Chm(I), & + State_Diag = State_Diag(I), & + State_Grid = State_Grid(I) ) + + ! Because not all CPUs in the communicator have the same amount of chunks, + ! it is only guaranteed that the first chunk in all CPUs can participate in + ! MPI_bcast of the NOXCOEFF array. So only the root CPU & root chunk will + ! read the NOXCOEFF array from disk, then broadcast to all other CPU's first + ! chunks, then remaining chunks can be copied locally without MPI. (hplin, 10/17/23) + IF( I == BEGCHUNK ) THEN + CALL mpi_bcast( State_Chm(I)%NOXCOEFF, size(State_Chm(I)%NOXCOEFF), mpi_real8, masterprocid, mpicom, ierr ) + IF ( ierr /= mpi_success ) CALL endrun('Error in mpi_bcast of NOXCOEFF in first chunk') + ELSE + State_Chm(I)%NOXCOEFF = State_Chm(BEGCHUNK)%NOXCOEFF + ENDIF + ENDDO + ENDIF + + IF ( Input_Opt%Linear_Chem ) THEN + CALL Init_Linear_Chem( Input_Opt = Input_Opt, & + State_Chm = State_Chm(BEGCHUNK), & + State_Met = State_Met(BEGCHUNK), & + State_Grid = maxGrid, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Init_Linear_Chem"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + IF ( Input_Opt%LSSalt ) THEN + CALL INIT_ATE( State_Grid = maxGrid ) + ENDIF + + ! Get some indices + iH2O = Ind_('H2O') + iO3 = Ind_('O3') + iCO2 = Ind_('CO2') + iSO4 = Ind_('SO4') + ! The following indices are needed to compute invariants + iO = Ind_('O') + iH = Ind_('H') + iO2 = Ind_('O2') + + ! This is used to compute overhead ozone column + SpcInfo => State_Chm(BEGCHUNK)%SpcData(iO3)%Info + MWO3 = REAL(SpcInfo%MW_g,r8) + ! Free pointer + SpcInfo => NULL() + + l_H2SO4 = get_spc_ndx('H2SO4', ignore_case=.true.) + l_SO4 = get_spc_ndx('SO4', ignore_case=.true.) + + ! Get indices for physical fields in physics buffer + NDX_PBLH = pbuf_get_index('pblh' ) + NDX_FSDS = pbuf_get_index('FSDS' ) + NDX_CLDTOP = pbuf_get_index('CLDTOP' ) + NDX_CLDFRC = pbuf_get_index('CLD' ) + NDX_PRAIN = pbuf_get_index('PRAIN' ) + NDX_NEVAPR = pbuf_get_index('NEVAPR' ) + NDX_LSFLXPRC = pbuf_get_index('LS_FLXPRC') + NDX_LSFLXSNW = pbuf_get_index('LS_FLXSNW') + NDX_CMFDQR = pbuf_get_index('RPRDTOT' ) + + ! Get cloud water indices + CALL cnst_get_ind( 'CLDLIQ', ixCldLiq) + CALL cnst_get_ind( 'CLDICE', ixCldIce) + CALL cnst_get_ind( 'NUMLIQ', ixNDrop, abort=.False. ) + + CALL init_mean_mass() + CALL setinv_inti() + + !----------------------------------------------------------------------- + ! ... initialize tracer modules + !----------------------------------------------------------------------- + CALL tracer_cnst_init() + CALL tracer_srcs_init() + + IF ( ghg_chem ) THEN + CALL ghg_chem_init(phys_state, bndtvg, h2orates) + ENDIF + + ! Initialize diagnostics interface + CALL GC_Diagnostics_Init( Input_Opt = Input_Opt, & + State_Chm = State_Chm(BEGCHUNK), & + State_Met = State_Met(BEGCHUNK) ) + + ! Initialize emissions interface + CALL GC_Emissions_Init( ) + + hco_pbuf2d => pbuf2d + + ! Cleanup + Call Cleanup_State_Grid( maxGrid, RC ) + + if (masterproc) write(iulog,'(a)') 'chem_init: GEOS-Chem chemistry initialization complete' + + end subroutine chem_init + + !================================================================================================ + ! chem_timestep_init + !================================================================================================ + subroutine chem_timestep_init(phys_state, pbuf2d) + + ! CAM modules + use mo_flbc, only : flbc_chk + use mo_ghg_chem, only : ghg_chem_timestep_init + use physics_buffer, only : physics_buffer_desc + + TYPE(physics_state), INTENT(IN):: phys_state(begchunk:endchunk) + TYPE(physics_buffer_desc), POINTER :: pbuf2d(:,:) + + ! Not sure what we would realistically do here rather than in tend + + !----------------------------------------------------------------------- + ! Set fixed lower boundary timing factors + !----------------------------------------------------------------------- + CALL flbc_chk + + IF ( ghg_chem ) THEN + CALL ghg_chem_timestep_init(phys_state) + ENDIF + + end subroutine chem_timestep_init + + !================================================================================================ + ! subroutine gc_update_timesteps + !================================================================================================ + subroutine gc_update_timesteps(DT) + + ! GEOS-Chem modules + use Time_Mod, only : Set_Timesteps + + REAL(r8), INTENT(IN) :: DT + INTEGER :: DT_MIN + INTEGER, SAVE :: DT_MIN_LAST = -1 + + DT_MIN = NINT(DT) + + Input_Opt%TS_CHEM = DT_MIN + Input_Opt%TS_EMIS = DT_MIN + Input_Opt%TS_CONV = DT_MIN + Input_Opt%TS_DYN = DT_MIN + Input_Opt%TS_RAD = DT_MIN + + ! Only bother updating the module information if there's been a change + IF (DT_MIN .NE. DT_MIN_LAST) THEN + CALL Set_Timesteps( Input_Opt = Input_Opt, & + CHEMISTRY = DT_MIN, & + EMISSION = DT_MIN, & + DYNAMICS = DT_MIN, & + UNIT_CONV = DT_MIN, & + CONVECTION = DT_MIN, & + DIAGNOS = DT_MIN, & + RADIATION = DT_MIN ) + DT_MIN_LAST = DT_MIN + ENDIF + + end subroutine gc_update_timesteps + + !================================================================================================ + ! subroutine geoschem_readnl + !================================================================================================ + subroutine geoschem_readnl(nlfile) + ! Purpose: reads the namelist from cam/src/control/runtime_opts + + ! CAM modules + use spmd_utils, only : mpicom, masterprocid, mpi_character, mpi_success + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + integer :: unitn, ierr + character(len=*), parameter :: subname = 'geoschem_readnl' + + namelist /geoschem_nl/ geoschem_chem_inputs + namelist /geoschem_nl/ geoschem_aeropt_inputs + namelist /geoschem_nl/ geoschem_photol_inputs + + ! Read namelist + IF ( MasterProc ) THEN + unitn = getunit() + OPEN( unitn, FILE=TRIM(nlfile), STATUS='old' ) + CALL find_group_name(unitn, 'geoschem_nl', STATUS=ierr) + IF ( ierr == 0 ) THEN + READ(unitn, geoschem_nl, IOSTAT=ierr) + IF ( ierr /= 0 ) THEN + CALL ENDRUN(subname // ':: ERROR reading namelist') + ENDIF + ENDIF + CLOSE(unitn) + CALL freeunit(unitn) + ENDIF + + ! Broadcast namelist variables + CALL mpi_bcast(geoschem_chem_inputs, LEN(geoschem_chem_inputs), mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: geoschem_chem_inputs') + ENDIF + + CALL mpi_bcast(geoschem_aeropt_inputs, LEN(geoschem_aeropt_inputs), mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: geoschem_aeropt_inputs') + ENDIF + + CALL mpi_bcast(geoschem_photol_inputs, LEN(geoschem_photol_inputs), mpi_character, masterprocid, mpicom, ierr) + IF ( ierr /= mpi_success ) then + CALL endrun(subname//': MPI_BCAST ERROR: geoschem_photol_inputs') + ENDIF + + end subroutine geoschem_readnl + + !================================================================================================ + ! subroutine chem_timestep_tend + !================================================================================================ + subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dT, pbuf, fh2o ) + + ! CAM modules + use cam_history, only : outfld, hist_fld_active + use camsrfexch, only : cam_in_t, cam_out_t + use chem_mods, only : drySpc_ndx, map2GC_dryDep + use chem_mods, only : nfs, indexm, gas_pcnst + use gas_wetdep_opts, only : gas_wetdep_method + use mo_chem_utls, only : get_spc_ndx + use mo_flbc, only : flbc_set + use mo_ghg_chem, only : ghg_chem_set_flbc + use mo_mean_mass, only : set_mean_mass + use mo_neu_wetdep, only : neu_wetdep_tend + use mo_setinv, only : setinv + use orbit, only : zenith ! For computing SZA + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx + use physics_buffer, only : pbuf_get_chunk, pbuf_get_index + use perf_mod, only : t_startf, t_stopf + use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p + use phys_grid, only : get_area_all_p, get_lat_all_p, get_lon_all_p + use physconst, only : MWDry, Gravit + use rad_constituents, only : rad_cnst_get_info + use short_lived_species, only : get_short_lived_species_gc, set_short_lived_species_gc + use spmd_utils, only : masterproc + use time_manager, only : Get_Curr_Calday, Get_Curr_Date ! For computing SZA + use tropopause, only : Tropopause_findChemTrop + use wv_saturation, only : QSat +#if defined( MODAL_AERO ) + use aero_model, only : aero_model_gasaerexch ! Aqueous chemistry and aerosol growth + use modal_aero_data, only : ntot_amode, nspec_amode + use modal_aero_data, only : nspec_max, nsoa + use modal_aero_data, only : lmassptr_amode, numptr_amode + use modal_aero_data, only : lptr_so4_a_amode + use modal_aero_data, only : lptr2_soa_a_amode, lptr2_soa_g_amode +#endif + + ! GEOS-Chem interface modules in CAM + use GeosChem_Emissions_Mod, only : GC_Emissions_Calc + use GeosChem_Diagnostics_Mod, only : GC_Diagnostics_Calc, wetdep_name, wtrate_name + use GeosChem_History_Mod, only : HistoryExports_SetDataPointers, CopyGCStates2Exports + + ! GEOS-Chem modules + use Calc_Met_Mod, only : Set_Dry_Surface_Pressure, AirQnt + use Chemistry_Mod, only : Do_Chemistry + use CMN_Size_Mod, only : NSURFTYPE, PTop + use Diagnostics_Mod, only : Zero_Diagnostics_StartOfTimestep, Set_Diagnostics_EndofTimestep + use Diagnostics_Mod, only : Set_AerMass_Diagnostic + use Drydep_Mod, only : Do_Drydep, DEPNAME, NDVZIND, Update_DryDepFreq + use GC_Grid_Mod, only : SetGridFromCtr + use HCO_Interface_GC_Mod,only : Compute_Sflx_For_Vdiff + use Linear_Chem_Mod, only : TrID_GC, GC_Bry_TrID, NSCHEM + use Linear_Chem_Mod, only : BrPtrDay, BrPtrNight, PLVEC, GMI_OH + use Olson_Landmap_Mod, only : Compute_Olson_Landmap + use Modis_LAI_Mod, only : Compute_XLAI + use PBL_Mix_Mod, only : Compute_PBL_Height + use PhysConstants, only : PI, PI_180, g0, AVO, Re, g0_100 + use Pressure_Mod, only : Set_Floating_Pressures, Accept_External_Pedge + use State_Chm_Mod, only : Ind_ + use State_Diag_Mod, only : get_TagInfo + use Time_Mod, only : Accept_External_Date_Time + use Toms_Mod, only : Compute_Overhead_O3 + use UCX_Mod, only : Set_H2O_Trac + use Unitconv_Mod, only : Convert_Spc_Units, UNIT_STR + use Unitconv_Mod, only : KG_SPECIES_PER_KG_DRY_AIR, KG_SPECIES_PER_M2 + use Wetscav_Mod, only : Setup_Wetscav + + REAL(r8), INTENT(IN) :: dT ! Time step + TYPE(physics_state), INTENT(IN) :: state ! Physics State variables + TYPE(physics_ptend), INTENT(OUT) :: ptend ! indivdual parameterization tendencies + TYPE(cam_in_t), INTENT(INOUT) :: cam_in + TYPE(cam_out_t), INTENT(IN) :: cam_out + TYPE(physics_buffer_desc), POINTER :: pbuf(:) + REAL(r8), OPTIONAL, INTENT(OUT) :: fh2o(PCOLS) ! h2o flux to balance source from chemistry + + ! Initial MMR for all species + REAL(r8) :: MMR_Beg(PCOLS,PVER,MAXVAL(map2GC(:))) + REAL(r8) :: MMR_End(PCOLS,PVER,MAXVAL(map2GC(:))) + + ! Logical to apply tendencies to mixing ratios + LOGICAL :: lq(pcnst) + + ! Indexing + INTEGER :: K, N, M, P, SM, ND + INTEGER :: I, J, L, nX, nY, nZ + + INTEGER :: LCHNK, NCOL + + REAL(r8), DIMENSION(state%NCOL) :: & + CSZA, & ! Cosine of solar zenith angle + CSZAmid, & ! Cosine of solar zenith angle at the mid timestep + Rlats, Rlons ! Chunk latitudes and longitudes (radians) + + REAL(fp) :: O3col(state%NCOL) ! Overhead O3 column (DU) + + REAL(r8), POINTER :: PblH(:) ! PBL height on each chunk [m] + REAL(r8), POINTER :: cldTop(:) ! Cloud top height [?] + REAL(r8), POINTER :: cldFrc(:,:) ! Cloud fraction [-] + REAL(r8), POINTER :: Fsds(:) ! Downward shortwave flux at surface [W/m2] + REAL(r8), POINTER :: PRain(:,:) ! Total stratiform precip. prod. (rain + snow) [kg/kg/s] + REAL(r8), POINTER :: NEvapr(:,:) ! Evaporation of total precipitation (rain + snow) [kg/kg/s] + REAL(r8), POINTER :: LsFlxPrc(:,:) ! Large-scale downward precip. flux at interface (rain + snow) [kg/m2/s] + REAL(r8), POINTER :: LsFlxSnw(:,:) ! Large-scale downward precip. flux at interface (snow only) [kg/m2/s] + REAL(r8), POINTER :: cmfdqr(:,:) ! Total convective precip. prod. (rain + snow) [kg/kg/s] + + REAL(r8) :: tmpMass + REAL(r8) :: cldW (state%NCOL,PVER) ! Cloud water (kg/kg) + REAL(r8) :: nCldWtr(state%NCOL,PVER) ! Droplet number concentration (#/kg) + + REAL(r8) :: relHum (state%NCOL,PVER) ! Relative humidity [0-1] + REAL(r8) :: satV (state%NCOL,PVER) ! Work arrays + REAL(r8) :: satQ (state%NCOL,PVER) ! Work arrays + REAL(r8) :: qH2O (state%NCOL,PVER) ! Specific humidity [kg/kg] + REAL(r8) :: h2ovmr (state%NCOL,PVER) ! H2O volume mixing ratio + REAL(r8) :: mBar (state%NCOL,PVER) ! Mean wet atmospheric mass [amu] + REAL(r8) :: invariants(state%NCOL,PVER,nfs) + REAL(r8) :: reaction_rates(1,1,1) ! Reaction rates (unused) + + ! For aerosol formation + REAL(r8) :: del_h2so4_gasprod(state%NCOL,PVER) + + REAL(r8) :: vmr0(state%NCOL,PVER,gas_pcnst) + REAL(r8) :: vmr1(state%NCOL,PVER,gas_pcnst) + REAL(r8) :: vmr2(state%NCOL,PVER,gas_pcnst) + + REAL(r8) :: wetdepflx(pcols,pcnst) ! Wet deposition fluxes (kg/m2/s) + +#if defined( MODAL_AERO ) + REAL(r8) :: binRatio(nspec_max,ntot_amode,state%NCOL,PVER) + + REAL(r8) :: SO4_gasRatio(state%NCOL,PVER) + + ! For SOA mapping + REAL(r8) :: totMass(state%NCOL,PVER) + REAL(r8) :: bulkMass(state%NCOL,PVER) + REAL(r8) :: tmpMW_g + CHARACTER(LEN=64) :: speciesName_1, speciesName_2, speciesName_3, speciesName_4 + INTEGER :: speciesId_1, speciesId_2, speciesId_3, speciesId_4 + INTEGER :: iMap, nMapping, iBin, binSOA_1, binSOA_2 + INTEGER :: K1, K2, K3, K4 + LOGICAL :: isSOA_aerosol + CHARACTER(LEN=64) :: aerName + + ! For prescribed aerosol distributions. + REAL(r8) :: prescr_aer_xnum(3) + REAL(r8) :: prescr_aer_xmas(3) + REAL(r8) :: vmr_so4_sum(state%ncol, pver) + REAL(r8) :: prescr_aer_lbnd, prescr_aer_abnd, prescr_aer_cbnd, prescr_aer_ubnd + REAL(r8), POINTER :: dgncur_a(:,:,:) + +#endif + + ! For emissions + REAL(r8) :: eflx(pcols,pver,pcnst) ! 3-D emissions in kg/m2/s + + ! For GEOS-Chem diagnostics + REAL(r8) :: mmr_tend(state%NCOL,PVER,gas_pcnst) + REAL(r8) :: wk_out(state%NCOL) + LOGICAL :: Found + + CHARACTER(LEN=shr_kind_cl) :: tagName + + REAL(r8), PARAMETER :: zlnd = 0.01_r8 ! Roughness length for soil [m] + REAL(r8), PARAMETER :: zslnd = 0.0024_r8 ! Roughness length for snow [m] + REAL(r8), PARAMETER :: zsice = 0.0400_r8 ! Roughness length for sea ice [m] + REAL(r8), PARAMETER :: zocn = 0.0001_r8 ! Roughness length for oean [m] + + REAL(f4) :: lonMidArr(1,PCOLS), latMidArr(1,PCOLS) + INTEGER :: iMaxLoc(1) + + REAL(r8) :: Col_Area(state%NCOL) + + ! Intermediate arrays + INTEGER :: Trop_Lev (PCOLS) + REAL(r8) :: Trop_P (PCOLS) + REAL(r8) :: Trop_T (PCOLS) + REAL(r8) :: Trop_Ht (PCOLS) + REAL(r8) :: SnowDepth(PCOLS) + REAL(r8) :: cld2D (PCOLS) + REAL(r8) :: Z0 (PCOLS) + REAL(r8) :: Sd_Ice, Sd_Lnd, Sd_Avg, Frc_Ice + + ! Estimating cloud optical depth + REAL(r8) :: TauCli(PCOLS,PVER) + REAL(r8) :: TauClw(PCOLS,PVER) + REAL(r8), PARAMETER :: re_m = 1.0e-05_r8 ! Cloud drop radius in m + REAL(r8), PARAMETER :: cldMin = 1.0e-02_r8 ! Minimum cloud cover + REAL(r8), PARAMETER :: cnst = 1.5e+00_r8 / (re_m * 1.0e+03_r8 * g0) + + ! Calculating SZA + REAL(r8) :: Calday + + CHARACTER(LEN=shr_kind_cl) :: SpcName + CHARACTER(LEN=shr_kind_cl) :: Prefix, FieldName + + LOGICAL :: FND + INTEGER :: SpcId + TYPE(Species), POINTER :: SpcInfo + TYPE(SfcMrObj), POINTER :: iSfcMrObj + + INTEGER :: previous_units + + REAL(r8) :: SlsData(PCOLS, PVER, nSls) + + INTEGER :: currYr, currMo, currDy, currTOD + INTEGER :: currYMD, currHMS, currHr, currMn, currSc + REAL(f4) :: currUTC + + TYPE(physics_buffer_desc), POINTER :: pbuf_chnk(:) ! slice of pbuf in chnk + REAL(r8), POINTER :: pbuf_ik(:,:) ! ptr to pbuf data (/pcols,pver/) + REAL(r8), POINTER :: pbuf_i(:) ! ptr to pbuf data (/pcols/) horizontal only (horiz_only) + INTEGER :: tmpIdx ! pbuf field id + + INTEGER :: TIM_NDX + INTEGER :: IERR + + INTEGER, SAVE :: iStep = 0 + LOGICAL, SAVE :: FIRST = .TRUE. + LOGICAL :: rootChunk + LOGICAL :: lastChunk + INTEGER :: RC + + call t_startf('GEOSChem_All_Tend') + + ! Initialize pointers + SpcInfo => NULL() + PblH => NULL() + cldTop => NULL() + cldFrc => NULL() + Fsds => NULL() + PRain => NULL() + NEvapr => NULL() + LsFlxPrc => NULL() + LsFlxSnw => NULL() + cmfdqr => NULL() + pbuf_chnk=> NULL() + pbuf_ik => NULL() + pbuf_i => NULL() + + call t_startf('GEOSChem_CAM_Interfacing') + ! LCHNK: which chunk we have on this process + LCHNK = state%LCHNK + ! NCOL: number of atmospheric columns on this chunk + NCOL = state%NCOL + + ! Root Chunk + rootChunk = ( MasterProc .and. (LCHNK==BEGCHUNK) ) + ! Last Chunk + lastChunk = ( MasterProc .and. (LCHNK==ENDCHUNK) ) + + ! Count the number of steps which have passed + IF ( LCHNK .EQ. BEGCHUNK ) iStep = iStep + 1 + + ! Need to update the timesteps throughout the code + CALL GC_Update_Timesteps(dT) + + ! For safety's sake + PTop = state%pint(1,1)*0.01e+0_fp + + ! Need to be super careful that the module arrays are updated and correctly + ! set. NOTE: First thing - you'll need to flip all the data vertically + + nX = 1 + nY = NCOL + nZ = PVER + + ! Update the grid lat/lons since they are module variables + ! Assume (!) that area hasn't changed for now, as GEOS-Chem will + ! retrieve this from State_Met which is chunked + !CALL get_rlat_all_p( LCHNK, NCOL, Rlats ) + !CALL get_rlon_all_p( LCHNK, NCOL, Rlons ) + Rlats(1:nY) = state%Lat(1:nY) + Rlons(1:nY) = state%Lon(1:nY) + + lonMidArr = 0.0e+0_f4 + latMidArr = 0.0e+0_f4 + DO I = 1, nX + DO J = 1, nY + lonMidArr(I,J) = REAL(Rlons(J), f4) + latMidArr(I,J) = REAL(Rlats(J), f4) + ENDDO + ENDDO + + ! Update the grid + CALL SetGridFromCtr( Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + lonCtr = lonMidArr, & + latCtr = latMidArr, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered within call to "SetGridFromCtr"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Set area + CALL Get_Area_All_p( LCHNK, nY, Col_Area ) + + ! Field : AREA_M2 + ! Description: Grid box surface area + ! Unit : - + ! Dimensions : nX, nY + ! Note : Set default value (in case of chunks with fewer columns) + State_Grid(LCHNK)%Area_M2 = -1.0e+10_fp + State_Met(LCHNK)%Area_M2 = -1.0e+10_fp + State_Grid(LCHNK)%Area_M2(1,:nY) = REAL(Col_Area(:nY) * Re**2,fp) + State_Met(LCHNK)%Area_M2(1,:nY) = State_Grid(LCHNK)%Area_M2(1,:nY) + + ! 2. Copy tracers into State_Chm + ! Data was received in kg/kg dry + ! Initialize ALL State_Chm species data to zero, not just tracer + DO N = 1, State_Chm(LCHNK)%nSpecies + State_Chm(LCHNK)%Species(N)%Units = KG_SPECIES_PER_KG_DRY_AIR + State_Chm(LCHNK)%Species(N)%Conc = 0.0e+0_fp + ENDDO + + lq(:) = .False. + + ! Map and flip gaseous species + MMR_Beg = 0.0e+0_r8 + MMR_End = 0.0e+0_r8 + DO N = 1, pcnst + IF ( mapCnst(N) > 0 ) lq(N) = .True. + M = map2GC(N) + IF ( M <= 0 ) CYCLE + MMR_Beg(:nY,:nZ,M) = state%q(:nY,nZ:1:-1,N) + State_Chm(LCHNK)%Species(M)%Conc(1,:nY,:nZ) = REAL(MMR_Beg(:nY,:nZ,M),fp) + ENDDO + + ! We need to let CAM know that 'H2O' and 'Q' are identical + MMR_Beg(:nY,:nZ,iH2O) = state%q(:nY,nZ:1:-1,cQ) + State_Chm(LCHNK)%Species(iH2O)%Conc(1,:nY,:nZ) = REAL(MMR_Beg(:nY,:nZ,iH2O),fp) + + ! Retrieve previous value of species data + SlsData(:,:,:) = 0.0e+0_r8 + CALL get_short_lived_species_gc( SlsData, LCHNK, nY, pbuf ) + + IF ( iStep == 1 ) THEN + ! Retrieve list of species with surface boundary conditions (copied from + ! sfcvmr_mod.F90) + + ! Head of linked list + SfcMrHead => NULL() + iSfcMrObj => NULL() + SpcInfo => NULL() + + ! Loop over all species + DO N = 1, State_Chm(BEGCHUNK)%nSpecies + ! Species information + SpcInfo => State_Chm(BEGCHUNK)%SpcData(N)%Info + + ! Check if field exists (note: this needs to be less than 16 + ! characters long) + FieldName = 'HCO_'//TRIM(Prefix_SfcVMR)//TRIM(to_upper(SpcInfo%Name)) + M = pbuf_get_index(FieldName, RC) + IF ( M > 0 ) THEN + + ! Must have positive, non-zero MW + IF ( SpcInfo%MW_g <= 0.0_fp ) THEN + ErrMsg = 'Cannot use surface boundary condition for species ' & + // TRIM(SpcInfo%Name) // ' due to invalid MW!' + CALL ENDRUN(TRIM(ErrMsg)) + ENDIF + + ! Create new object, add to list + ALLOCATE( iSfcMrObj, STAT=RC ) + CALL GC_CheckVar( 'sfcvmr_mod.F90:iSfcMrObj', 0, RC ) + IF ( RC /= GC_SUCCESS ) CALL ENDRUN('Failure while allocating iSfcMrObj') + + iSfcMrObj%SpcID = N + iSfcMrObj%FldName = FieldName + iSfcMrObj%Next => SfcMrHead + SfcMrHead => iSfcMrObj + IF ( rootChunk ) THEN + WRITE( 6, 110 ) TRIM( SpcInfo%Name ), TRIM( iSfcMrObj%FldName ) + 110 FORMAT( '--> ', a, ' will use prescribed surface boundary ', & + 'conditions from field ', a ) + ENDIF + + ! Free the pointer + iSfcMrObj => NULL() + ENDIF + ENDDO + ENDIF + + !----------------------------------------------------------------------- + ! ... Reset certain GEOS-Chem diagnostics at start of timestep + !----------------------------------------------------------------------- + CALL Zero_Diagnostics_StartOfTimestep( Input_Opt = Input_Opt, & + State_Diag = State_Diag(LCHNK), & + RC = RC ) + + !----------------------------------------------------------------------- + ! ... Set atmosphere mean mass + !----------------------------------------------------------------------- + ! This is not meant for simulations of the ionosphere. mBar will then just + ! be set to mwdry and does not require to pass anything besides NCOL. We + ! can then just past a dummy array as the second argument + !CALL Set_mean_mass( NCOL, mmr, mBar ) + CALL Set_mean_mass( NCOL, vmr0, mBar ) + + ! Map and flip gaseous short-lived species + DO N = 1, nSls + M = map2GC_Sls(N) + IF ( M <= 0 ) CYCLE + State_Chm(LCHNK)%Species(M)%Conc(1,:nY,:nZ) = REAL(SlsData(:nY,nZ:1:-1,N),fp) + ENDDO + + call t_stopf('GEOSChem_CAM_Interfacing') + + ! We want to put t_startf timers outside of C-preprocessor flags + ! in order to always have these timers present even if zero. (hplin, 4/30/24) + call t_startf('GEOSChem_MAM_Interfacing') +#if defined( MODAL_AERO ) + ! NOTE: GEOS-Chem bulk aerosol concentrations (BCPI, BCPO, SO4, ...) are ZEROED OUT + ! here in order to be reconstructed from the modal concentrations. + ! + ! This means that any changes to the BULK mass will be ignored between the end + ! of the gas_phase_chemdr and the beginning of the next!! + ! + ! First reset State_Chm%Species to zero out MAM-inherited GEOS-Chem aerosols + DO M = 1, ntot_amode + DO SM = 1, nspec_amode(M) + P = map2MAM4(SM,M) ! Constituent index for GEOS-Chem + IF ( P > 0 ) K = map2GC(P) ! Index in State_Chm + + ! do not zero out sulfate aerosol here since aerosol distribution for sulfate + ! will be prescribed (hplin, 5/9/23) + call rad_cnst_get_info(0,M,SM,spec_name=aerName) + IF ( to_upper(aerName(:3)) == "SO4" ) CYCLE + + IF ( K > 0 ) State_Chm(LCHNK)%Species(K)%Conc(1,:nY,:nZ) = 0.0e+00_fp + ENDDO + ENDDO + + ! Map and vertically flip aerosols + DO M = 1, ntot_amode + DO SM = 1, nspec_amode(M) + P = map2MAM4(SM,M) ! Constituent index for GEOS-Chem + IF ( P <= 0 ) CYCLE + N = lmassptr_amode(SM,M) + K = map2GC(P) ! Index in State_Chm + ! /!\ MAM aerosols (with cnst index N) is mapped onto GEOS-Chem + ! species (with cnst index P, which corresponds to index K in + ! State_Chm) + + ! do not zero out sulfate aerosol here since aerosol distribution for sulfate + ! will be prescribed (hplin, 5/9/23) + call rad_cnst_get_info(0,M,SM,spec_name=aerName) + IF ( to_upper(aerName(:3)) == "SO4" ) CYCLE + + ! Multiple MAM4 bins are mapped to same GEOS-Chem species + State_Chm(LCHNK)%Species(K)%Conc(1,:nY,:nZ) = State_Chm(LCHNK)%Species(K)%Conc(1,:nY,:nZ) & + + REAL(state%q(:nY,nZ:1:-1,N),fp) * & + adv_mass(mapCnst(P)) / & + adv_mass(mapCnst(N)) + ENDDO + ENDDO + + ! Compute ratios of bin to bulk mass + !------------------------------------------------------------------------------------------ + ! Notes for the indices used here (hplin 3/3/23): + ! + ! K = GEOS-Chem species index in State_Chm%Species(K). + ! P = constituent index for BULK lumped tracer in GEOS-Chem (BCPI, BCPO, DST1, DST4, SO4, SALA, SALC, OCPI, OCPO) + ! N = constituent index for MODAL tracer in MAM4 (bc_a1, bc_a4, ...) + ! each combination of species and mode is described by (SM, M) + ! SM = species (i.e., bc, dst, so4, ncl, pom) in mode M + ! M = mode number + ! constituent indices are used in state%q(column number,level number,constituent index) + ! chemical tracer index (NOT constituent index) is used in mo_sim_dat, e.g., adv_mass(tracer index) + ! + ! Mapping functions: maps from... ...to + ! mapCnst(constituent index) constituent index chemical tracer index + ! lmassptr_amode(SM, M) SM, M constituent index (modal) + ! map2GC(bulk constituent index) constituent index (bulk) GEOS-Chem species index (bulk) + ! map2MAM4(SM, M) SM, M (modal) constituent index (bulk) + ! (map2MAM4 is a N to 1 operation) + ! Query functions: + ! xname_massptr(SM, M) SM, M NAME of modal aer (bc_a1, bc_a4, ...) + !------------------------------------------------------------------------------------------ + binRatio = 0.0e+00_r8 + DO M = 1, ntot_amode + DO SM = 1, nspec_amode(M) + P = map2MAM4(SM,M) + IF ( P <= 0 ) CYCLE + K = map2GC(P) ! Index in State_Chm + N = lmassptr_amode(SM,M) + IF ( N < 0 ) CYCLE + DO J = 1, nY + DO L = 1, nZ + IF ( State_Chm(LCHNK)%Species(K)%Conc(1,J,nZ+1-L) > 0.0e+00_r8 ) THEN + binRatio(SM,M,J,L) = state%q(J,L,N) & + * adv_mass(mapCnst(P)) / adv_mass(mapCnst(N)) & + / REAL(State_Chm(LCHNK)%Species(K)%Conc(1,J,nZ+1-L), r8) + ENDIF + ENDDO + ENDDO + ! Overwrite MMR_Beg with value from MAM + MMR_Beg(:nY,:nZ,K) = State_Chm(LCHNK)%Species(K)%Conc(1,:nY,:nZ) + ENDDO + ENDDO + + ! Deal with secondary organic aerosols (SOAs). This mapping is using the + ! complex SOA option in GEOS-Chem. + ! MAM uses five volatility bins spanning saturation concentrations from 0.01 + ! to 100 ug/m3 (logarithmically). The complex SOA option has four volatility + ! bins that 0.1 to 100 ug/m3. We lump the lowest two bins in CESM2 to the + ! lowest bin in GEOS-Chem. + ! + ! The mapping goes as follows: + ! TSOA0 + ASOAN + SOAIE + SOAGX <- soa1_a* + soa2_a* + ! TSOA1 + ASOA1 <- soa3_a* + ! TSOA2 + ASOA2 <- soa4_a* + ! TSOA3 + ASOA3 <- soa5_a* + ! TSOG0 <- SOAG0 + SOAG1 + ! TSOG1 + ASOG1 <- SOAG2 + ! TSOG2 + ASOG2 <- SOAG3 + ! TSOG3 + ASOG3 <- SOAG4 + + nMapping = 8 + DO iMap = 1, nMapping + speciesName_1 = '' + speciesName_2 = '' + speciesName_3 = '' + speciesName_4 = '' + IF ( iMap == 1 ) THEN + binSOA_1 = 1 + binSOA_2 = 2 + speciesName_1 = 'TSOA0' + speciesName_2 = 'ASOAN' + speciesName_3 = 'SOAIE' + speciesName_4 = 'SOAGX' + ELSEIF ( iMap == 2 ) THEN + binSOA_1 = 3 + binSOA_2 = 3 + speciesName_1 = 'TSOA1' + speciesName_2 = 'ASOA1' + ELSEIF ( iMap == 3 ) THEN + binSOA_1 = 4 + binSOA_2 = 4 + speciesName_1 = 'TSOA2' + speciesName_2 = 'ASOA2' + ELSEIF ( iMap == 4 ) THEN + binSOA_1 = 5 + binSOA_2 = 5 + speciesName_1 = 'TSOA3' + speciesName_2 = 'ASOA3' + ELSEIF ( iMap == 5 ) THEN + binSOA_1 = 1 + binSOA_2 = 2 + speciesName_1 = 'TSOG0' + speciesName_2 = 'TSOG0' + ELSEIF ( iMap == 6 ) THEN + binSOA_1 = 3 + binSOA_2 = 3 + speciesName_1 = 'TSOG1' + speciesName_2 = 'ASOG1' + ELSEIF ( iMap == 7 ) THEN + binSOA_1 = 4 + binSOA_2 = 4 + speciesName_1 = 'TSOG2' + speciesName_2 = 'ASOG2' + ELSEIF ( iMap == 8 ) THEN + binSOA_1 = 5 + binSOA_2 = 5 + speciesName_1 = 'TSOG3' + speciesName_2 = 'ASOG3' + ELSE + CALL ENDRUN('Unknown SOA mapping!') + ENDIF + isSOA_aerosol = .False. + IF ( iMap <= 4 ) isSOA_aerosol = .True. + + ! Compute total mass from GEOS-Chem species. This sets the ratio between + ! speciesId_1 and speciesId_2 + totMass(:nY,:nZ) = 0.0e+00_r8 + + CALL cnst_get_ind( speciesName_1, speciesId_1, abort=.True. ) + CALL cnst_get_ind( speciesName_2, speciesId_2, abort=.False. ) + CALL cnst_get_ind( speciesName_3, speciesId_3, abort=.False. ) + CALL cnst_get_ind( speciesName_4, speciesId_4, abort=.False. ) + IF ( speciesId_1 > 0 ) totMass(:nY,:nZ) = totMass(:nY,:nZ) + state%q(:nY,:nZ,speciesId_1) + IF ( speciesId_2 > 0 ) totMass(:nY,:nZ) = totMass(:nY,:nZ) + state%q(:nY,:nZ,speciesId_2) + IF ( speciesId_3 > 0 ) totMass(:nY,:nZ) = totMass(:nY,:nZ) + state%q(:nY,:nZ,speciesId_3) + IF ( speciesId_4 > 0 ) totMass(:nY,:nZ) = totMass(:nY,:nZ) + state%q(:nY,:nZ,speciesId_4) + + K1 = Ind_(speciesName_1) + K2 = Ind_(speciesName_2) + K3 = Ind_(speciesName_3) + K4 = Ind_(speciesName_4) + + ! Check whether to overwrite GEOS-Chem SOAs using concentrations from MAM4. + IF ( (useMAM4mapBackSOA .or. (iStep == 1 .and. useSOAICfromMAM4)) .and. & ! If MAM4 should map back SOAs, then + (useSOAICfromMAM4 .or. iStep > 1) ) THEN ! If use IC, run at all times; otherwise, only run after 1st step to overwrite GC SOAs from soaX_aY + ! Compute total bulk mass from MAM + bulkMass(:nY,:nZ) = 0.0e+00_r8 + IF ( isSOA_aerosol ) THEN + DO iBin = binSOA_1, binSOA_2 + DO M = 1, ntot_amode + N = lptr2_soa_a_amode(M,iBin) + IF ( N <= 0 ) CYCLE + tmpMW_g = adv_mass(mapCnst(N)) + bulkMass(:nY,:nZ) = bulkMass(:nY,:nZ) + state%q(:nY,:nZ,N) + ENDDO + ENDDO + ELSE + DO iBin = binSOA_1, binSOA_2 + N = lptr2_soa_g_amode(iBin) + IF ( N <= 0 ) CYCLE + tmpMW_g = adv_mass(mapCnst(N)) + bulkMass(:nY,:nZ) = bulkMass(:nY,:nZ) + state%q(:nY,:nZ,N) + ENDDO + ENDIF + + DO J = 1, nY + DO L = 1, nZ + ! Total SOA aerosol masses from GC are available. Partition according to the ratio given in speciesId_N to totMass summed above. + IF ( totMass(J,L) > 0.0e+00_r8 ) THEN + IF ( K1 > 0 ) State_Chm(LCHNK)%Species(K1)%Conc(1,J,L) = state%q(J,nZ+1-L,speciesId_1) / totMass(J,nZ+1-L) * bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_1)) / tmpMW_g + IF ( K2 > 0 ) State_Chm(LCHNK)%Species(K2)%Conc(1,J,L) = state%q(J,nZ+1-L,speciesId_2) / totMass(J,nZ+1-L) * bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_2)) / tmpMW_g + IF ( K3 > 0 ) State_Chm(LCHNK)%Species(K3)%Conc(1,J,L) = state%q(J,nZ+1-L,speciesId_3) / totMass(J,nZ+1-L) * bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_3)) / tmpMW_g + IF ( K4 > 0 ) State_Chm(LCHNK)%Species(K4)%Conc(1,J,L) = state%q(J,nZ+1-L,speciesId_4) / totMass(J,nZ+1-L) * bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_4)) / tmpMW_g + ELSE + ! Total SOA aerosol masses from GC are unknown. In this case partition the bulkMass by 1/2 to K1 and K2. + IF ( K1 == K2 ) THEN + ! ... go in same bin. This actually does not exist in the partitioning above. + State_Chm(LCHNK)%Species(K1)%Conc(1,J,L) = bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_1)) / tmpMW_g + ELSE + State_Chm(LCHNK)%Species(K1)%Conc(1,J,L) = bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_1)) / tmpMW_g / 2.0_r8 + State_Chm(LCHNK)%Species(K2)%Conc(1,J,L) = bulkMass(J,nZ+1-L) * adv_mass(mapCnst(speciesId_2)) / tmpMW_g / 2.0_r8 + ENDIF + ENDIF + ENDDO + ENDDO + ENDIF + + ! Regardless of whether MAM4 will overwrite GEOS-Chem SOA, this part must run, as MMR_Beg is used + ! for computing the flux. If this step is skipped in the first time step, then MMR_Beg is taken + ! as zero and this will result in the entire mass to be provided to the GEOS-Chem species as flux, + ! doubling the species MMRs. + ! + ! Thus, the short-circuiting of the MAM4 to GEOS-Chem mapping must only be done above. (hplin, 5/11/23) + IF ( K1 > 0 ) MMR_Beg(:nY,:nZ,K1) = State_Chm(LCHNK)%Species(K1)%Conc(1,:nY,:nZ) + IF ( K2 > 0 ) MMR_Beg(:nY,:nZ,K2) = State_Chm(LCHNK)%Species(K2)%Conc(1,:nY,:nZ) + IF ( K3 > 0 ) MMR_Beg(:nY,:nZ,K3) = State_Chm(LCHNK)%Species(K3)%Conc(1,:nY,:nZ) + IF ( K4 > 0 ) MMR_Beg(:nY,:nZ,K4) = State_Chm(LCHNK)%Species(K4)%Conc(1,:nY,:nZ) + ENDDO + + ! Add gas-phase H2SO4 to GEOS-Chem SO4 (which lumps SO4 aerosol and gaseous) + K = iSO4 + N = cH2SO4 + IF ( K > 0 .AND. N > 0 .AND. l_SO4 > 0 ) THEN + State_Chm(LCHNK)%Species(K)%Conc(1,:nY,:nZ) = & + State_Chm(LCHNK)%Species(K)%Conc(1,:nY,:nZ) & + + REAL(state%q(:nY,nZ:1:-1,N),fp) * & + adv_mass(l_SO4) / adv_mass(mapCnst(N)) + ! SO4_gasRatio is in mol/mol + SO4_gasRatio(:nY,:nZ) = state%q(:nY,:nZ,N) & + * adv_mass(l_SO4) / adv_mass(mapCnst(N)) & + / State_Chm(LCHNK)%Species(K)%Conc(1,:nY,nZ:1:-1) + MMR_Beg(:nY,:nZ,K) = State_Chm(LCHNK)%Species(K)%Conc(1,:nY,:nZ) + ENDIF +#endif + + ! Convert mass fluxes to VMR as needed for MAM4 aerosols (these operate on vmr0 - initial and vmr1 - end of timestep) + DO N = 1, gas_pcnst + ! See definition of map2chm + M = map2chm(N) + IF ( M > 0 ) THEN + ! Is a GEOS-Chem species? + vmr0(:nY,:nZ,N) = State_Chm(LCHNK)%Species(M)%Conc(1,:nY,nZ:1:-1) * & + MWDry / adv_mass(N) + ! We'll substract concentrations after chemistry later + mmr_tend(:nY,:nZ,N) = REAL(State_Chm(LCHNK)%Species(M)%Conc(1,:nY,nZ:1:-1),r8) + ELSEIF ( M < 0 ) THEN + ! Is a MAM4 species? Get VMR from state%q directly. + vmr0(:nY,:nZ,N) = state%q(:nY,:nZ,-M) * & + MWDry / adv_mass(N) + mmr_tend(:nY,:nZ,N) = state%q(:nY,:nZ,-M) + ENDIF + ENDDO + call t_stopf('GEOSChem_MAM_Interfacing') + + call t_startf('GEOSChem_CAM_Interfacing') + ! If H2O tendencies are propagated to specific humidity, then make sure + ! that Q actually applies tendencies + IF ( Input_Opt%applyQtend ) lq(cQ) = .True. + + IF ( ghg_chem ) lq(1) = .True. + + ! Initialize tendency array + CALL Physics_ptend_init(ptend, state%psetcols, 'chemistry', lq=lq) + + ! Reset chemical tendencies + ptend%q(:,:,:) = 0.0e+0_r8 + + ! Determine current date and time + CALL Get_Curr_Date( yr = currYr, & + mon = currMo, & + day = currDy, & + tod = currTOD ) + + currYMD = (currYr*1000) + (currMo*100) + (currDy) + ! Deal with subdaily + currUTC = REAL(currTOD,f4)/3600.0e+0_f4 + currSc = 0 + currMn = 0 + currHr = 0 + DO WHILE (currTOD >= 3600) + currTOD = currTOD - 3600 + currHr = currHr + 1 + ENDDO + DO WHILE (currTOD >= 60) + currTOD = currTOD - 60 + currMn = currMn + 1 + ENDDO + currSc = currTOD + currHMS = (currHr*1000) + (currMn*100) + (currSc) + + ! Calculate COS(SZA) + Calday = Get_Curr_Calday( INT(dT/2) ) + CALL Zenith( Calday, Rlats, Rlons, CSZAmid, nY ) + + Calday = Get_Curr_Calday( ) + CALL Zenith( Calday, Rlats, Rlons, CSZA, nY ) + + ! Get all required data from physics buffer + TIM_NDX = pbuf_old_tim_idx() + CALL pbuf_get_field( pbuf, NDX_PBLH, PblH ) + CALL pbuf_get_field( pbuf, NDX_FSDS, Fsds ) + CALL pbuf_get_field( pbuf, NDX_CLDTOP, cldTop ) + CALL pbuf_get_field( pbuf, NDX_CLDFRC, cldFrc, START=(/1,1,TIM_NDX/), KOUNT=(/NCOL,PVER,1/) ) + CALL pbuf_get_field( pbuf, NDX_NEVAPR, NEvapr, START=(/1,1/), KOUNT=(/NCOL,PVER/)) + CALL pbuf_get_field( pbuf, NDX_PRAIN, PRain, START=(/1,1/), KOUNT=(/NCOL,PVER/)) + CALL pbuf_get_field( pbuf, NDX_LSFLXPRC, LsFlxPrc, START=(/1,1/), KOUNT=(/NCOL,PVERP/)) + CALL pbuf_get_field( pbuf, NDX_LSFLXSNW, LsFlxSnw, START=(/1,1/), KOUNT=(/NCOL,PVERP/)) + CALL pbuf_get_field( pbuf, NDX_CMFDQR, cmfdqr, START=(/1,1/), KOUNT=(/NCOL,PVER/)) + + ! Get VMR and MMR of H2O + h2ovmr = 0.0e0_fp + qH2O = 0.0e0_fp + ! Note MWDry = 28.966 g/mol + DO J = 1, nY + DO L = 1, nZ + qH2O(J,L) = REAL(state%q(J,L,cQ),r8) + ! Set GEOS-Chem's H2O mixing ratio to CAM's specific humidity 'q' + State_Chm(LCHNK)%Species(iH2O)%Conc(1,J,nZ+1-L) = qH2O(J,L) + h2ovmr(J,L) = qH2O(J,L) * MWDry / 18.016e+0_fp + ENDDO + ENDDO + + !----------------------------------------------------------------------- + ! ... Set the "invariants" + !----------------------------------------------------------------------- + CALL Setinv( invariants, state%t(:,:), h2ovmr, vmr0, & + state%pmid(:,:), nY, LCHNK, pbuf ) + + ! Calculate RH (range 0-1, note still level 1 = TOA) + relHum(:,:) = 0.0e+0_r8 + CALL QSat(state%t(:nY,:), state%pmid(:nY,:), satV, satQ, state%NCOL,PVER) + DO J = 1, nY + DO L = 1, nZ + relHum(J,L) = 0.622e+0_r8 * h2ovmr(J,L) / satQ(J,L) + relHum(J,L) = MAX( 0.0e+0_r8, MIN( 1.0e+0_r8, relHum(J,L) ) ) + ENDDO + ENDDO + + Z0 = 0.0e+0_r8 + DO J = 1, nY + Z0(J) = cam_in%landFrac(J) * zlnd & + + cam_in%iceFrac(J) * zsice & + + cam_in%ocnFrac(J) * zocn + IF (( cam_in%snowhLand(J) > 0.01_r8 ) .OR. & + ( cam_in%snowhIce(J) > 0.01_r8 )) THEN + ! Land is covered in snow + Z0(J) = zslnd + ENDIF + ENDDO + + ! Estimate cloud liquid water content and OD + TauCli = 0.0e+0_r8 + TauClw = 0.0e+0_r8 + + cldW(:nY,:nZ) = state%q(:nY,:nZ,ixCldLiq) + state%q(:nY,:nZ,ixCldIce) + IF ( ixNDrop > 0 ) nCldWtr(:nY,:nZ) = state%q(:nY,:nZ,ixNDrop) + + DO J = 1, nY + DO L = nZ, 1, -1 + ! ================================================================= + ! =========== Compute cloud optical depth based on ============ + ! =========== Liao et al. JGR, 104, 23697, 1999 ============ + ! ================================================================= + ! + ! Tau = 3/2 * LWC * dZ / ( \rho_w * r_e ) + ! dZ = - dP / ( \rho_air * g ) + ! since Pint is ascending, we can neglect the minus sign + ! + ! Tau = 3/2 * LWC * dP / ( \rho_air * r_e * \rho_w * g ) + ! LWC / \rho_air = Q + ! + ! Tau = 3/2 * Q * dP / ( r_e * rho_w * g ) + ! Tau(L) = 3/2 * Q(L) * (Pint(L+1) - Pint(L)) / (re * rho_w * g ) + ! Tau(L) = Q(L) * (Pint(L+1) - Pint(L)) * Cnst + ! Then divide by cloud fraction to get the in-cloud optical depth + + ! Unit check: | + ! Q : [kg H2O/kg air] | + ! Pint : [Pa]=[kg air/m/s^2] | + ! re : [m] | = 1.0e-5 + ! rho_w: [kg H2O/m^3] | = 1.0e+3 + ! g : [m/s^2] | = 9.81 + IF ( cldFrc(J,L) > cldMin ) THEN + TauClw(J,L) = state%q(J,L,ixCldLiq) & + * (state%pint(J,L+1)-state%pint(J,L)) & + * cnst / cldFrc(J,L) + TauClw(J,L) = MAX(TauClw(J,L), 0.0e+00_r8) + TauCli(J,L) = state%q(J,L,ixCldIce) & + * (state%pint(J,L+1)-state%pint(J,L)) & + * cnst / cldFrc(J,L) + TauCli(J,L) = MAX(TauCli(J,L), 0.0e+00_r8) + ENDIF + ENDDO + ENDDO + + ! Retrieve tropopause level + Trop_Lev = 0 + CALL Tropopause_FindChemTrop(state, Trop_Lev) + ! Back out the pressure + Trop_P = 1000.0e+0_r8 + DO J = 1, nY + Trop_P(J) = state%pmid(J,Trop_Lev(J)) * 0.01e+0_r8 + ENDDO + + ! Calculate snow depth + snowDepth = 0.0e+0_r8 + DO J = 1, nY + Sd_Ice = MAX(0.0e+0_r8,cam_in%snowhIce(J)) + Sd_Lnd = MAX(0.0e+0_r8,cam_in%snowhLand(J)) + Frc_Ice = MAX(0.0e+0_r8,cam_in%iceFrac(J)) + IF (Frc_Ice > 0.0e+0_r8) THEN + Sd_Avg = (Sd_Lnd*(1.0e+0_r8 - Frc_Ice)) + (Sd_Ice * Frc_Ice) + ELSE + Sd_Avg = Sd_Lnd + ENDIF + snowDepth(J) = Sd_Avg + ENDDO + + ! Field : ALBD + ! Description: Visible surface albedo + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%ALBD (1,:nY) = cam_in%asdir(:nY) + + ! Field : CLDFRC + ! Description: Column cloud fraction + ! Unit : - + ! Dimensions : nX, nY + ! Note : Estimate column cloud fraction as the maximum cloud + ! fraction in the column (pessimistic assumption) + DO J = 1, nY + State_Met(LCHNK)%CLDFRC(1,J) = MAXVAL(cldFrc(J,:)) + ENDDO + + ! Field : EFLUX, HFLUX + ! Description: Latent heat flux, sensible heat flux + ! Unit : W/m^2 + ! Dimensions : nX, nY + State_Met(LCHNK)%EFLUX (1,:nY) = cam_in%Lhf(:nY) + State_Met(LCHNK)%HFLUX (1,:nY) = cam_in%Shf(:nY) + + ! Field : LandTypeFrac + ! Description: Olson fraction per type + ! Unit : - (between 0 and 1) + ! Dimensions : nX, nY, NSURFTYPE + ! Note : Index 1 is water + DO N = 1, NSURFTYPE + Write(FieldName, '(a,i2.2)') 'HCO_LANDTYPE', N-1 + tmpIdx = pbuf_get_index(FieldName, rc) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + ELSE + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) + DO J = 1, nY + State_Met(LCHNK)%LandTypeFrac(1,J,N) = pbuf_i(J) + ENDDO + pbuf_i => NULL() + ENDIF + + Write(FieldName, '(a,i2.2)') 'HCO_XLAI', N-1 + tmpIdx = pbuf_get_index(FieldName, rc) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + ELSE + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) + DO J = 1, nY + State_Met(LCHNK)%XLAI_NATIVE(1,J,N) = pbuf_i(J) + ENDDO + pbuf_i => NULL() + ENDIF + ENDDO + + ! Field : FRCLND, FRLAND, FROCEAN, FRSEAICE, FRLAKE, FRLANDICE + ! Description: Olson land fraction + ! Fraction of land + ! Fraction of ocean + ! Fraction of sea ice + ! Fraction of lake + ! Fraction of land ice + ! Fraction of snow + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%FRCLND (1,:ny) = 1.e+0_fp - & + State_Met(LCHNK)%LandTypeFrac(1,:nY,1) ! Olson Land Fraction + State_Met(LCHNK)%FRLAND (1,:nY) = cam_in%landFrac(:nY) + State_Met(LCHNK)%FROCEAN (1,:nY) = cam_in%ocnFrac(:nY) + cam_in%iceFrac(:nY) + State_Met(LCHNK)%FRSEAICE (1,:nY) = cam_in%iceFrac(:nY) + State_Met(LCHNK)%FRLAKE (1,:nY) = 0.0e+0_fp + State_Met(LCHNK)%FRLANDICE (1,:nY) = 0.0e+0_fp + State_Met(LCHNK)%FRSNOW (1,:nY) = 0.0e+0_fp + + ! Field : GWETROOT, GWETTOP + ! Description: Root and top soil moisture + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%GWETROOT (1,:nY) = 0.0e+0_fp + State_Met(LCHNK)%GWETTOP (1,:nY) = 0.0e+0_fp + + ! Field : LAI + ! Description: Leaf area index + ! Unit : m^2/m^2 + ! Dimensions : nX, nY + State_Met(LCHNK)%LAI (1,:nY) = 0.0e+0_fp + + ! Field : PARDR, PARDF + ! Description: Direct and diffuse photosynthetically active radiation + ! Unit : W/m^2 + ! Dimensions : nX, nY + State_Met(LCHNK)%PARDR (1,:nY) = 0.0e+0_fp + State_Met(LCHNK)%PARDF (1,:nY) = 0.0e+0_fp + + ! Field : PBLH + ! Description: PBL height + ! Unit : m + ! Dimensions : nX, nY + State_Met(LCHNK)%PBLH (1,:nY) = PblH(:nY) + + ! Field : PHIS + ! Description: Surface geopotential height + ! Unit : m + ! Dimensions : nX, nY + State_Met(LCHNK)%PHIS (1,:nY) = state%Phis(:nY) + + ! Field : PRECANV, PRECCON, PRECLSC, PRECTOT + ! Description: Anvil precipitation @ ground + ! Convective precipitation @ ground + ! Large-scale precipitation @ ground + ! Total precipitation @ ground + ! Unit : kg/m^2/s + ! Dimensions : nX, nY + State_Met(LCHNK)%PRECANV (1,:nY) = 0.0e+0_fp + State_Met(LCHNK)%PRECCON (1,:nY) = cam_out%Precc(:nY) + State_Met(LCHNK)%PRECLSC (1,:nY) = cam_out%Precl(:nY) + State_Met(LCHNK)%PRECTOT (1,:nY) = cam_out%Precc(:nY) + cam_out%Precl(:nY) + + ! Field : TROPP + ! Description: Tropopause pressure + ! Unit : hPa + ! Dimensions : nX, nY + State_Met(LCHNK)%TROPP (1,:nY) = Trop_P(:nY) + + ! Field : PS1_WET, PS2_WET + ! Description: Wet surface pressure at start and end of timestep + ! Unit : hPa + ! Dimensions : nX, nY + State_Met(LCHNK)%PS1_WET (1,:nY) = state%ps(:nY)*0.01e+0_fp + State_Met(LCHNK)%PS2_WET (1,:nY) = state%ps(:nY)*0.01e+0_fp + + ! Field : SLP + ! Description: Sea level pressure + ! Unit : hPa + ! Dimensions : nX, nY + State_Met(LCHNK)%SLP (1,:nY) = state%ps(:nY)*0.01e+0_fp + + ! Field : TS + ! Description: Surface temperature + ! Unit : K + ! Dimensions : nX, nY + State_Met(LCHNK)%TS (1,:nY) = cam_in%TS(:nY) + + ! Field : TSKIN + ! Description: Surface skin temperature + ! Remarks : NOT to be confused with TS (T at 2m) (hplin, 3/20/23) + ! Unit : K + ! Dimensions : nX, nY + State_Met(LCHNK)%TSKIN (1,:nY) = cam_in%SST(:nY) + + ! Field : SWGDN + ! Description: Incident radiation @ ground + ! Unit : W/m^2 + ! Dimensions : nX, nY + State_Met(LCHNK)%SWGDN (1,:nY) = fsds(:nY) + + ! Field : SNODP, SNOMAS + ! Description: Snow depth, snow mass + ! Unit : m, kg/m^2 + ! Dimensions : nX, nY + ! Note : Conversion from m to kg/m^2 + ! \rho_{ice} = 916.7 kg/m^3 + State_Met(LCHNK)%SNODP (1,:nY) = snowDepth(:nY) + State_Met(LCHNK)%SNOMAS (1,:nY) = snowDepth(:nY) * 916.7e+0_r8 + + ! Field : SUNCOS, SUNCOSmid + ! Description: COS(solar zenith angle) at current time and midpoint + ! of chemistry timestep + ! Unit : - + ! Dimensions : nX, nY + State_Met(LCHNK)%SUNCOS (1,:nY) = CSZA(:nY) + State_Met(LCHNK)%SUNCOSmid (1,:nY) = CSZAmid(:nY) + + ! Field : UVALBEDO + ! Description: UV surface albedo + ! Unit : - + ! Dimensions : nX, nY + IF ( Input_Opt%onlineAlbedo ) THEN + State_Met(LCHNK)%UVALBEDO(1,:nY) = cam_in%asdir(:nY) + ELSE + FieldName = 'HCO_UV_ALBEDO' + tmpIdx = pbuf_get_index(FieldName, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + State_Met(LCHNK)%UVALBEDO(1,:nY) = 0.0e+0_fp + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + State_Met(LCHNK)%UVALBEDO(1,:nY) = pbuf_i(:nY) + pbuf_chnk => NULL() + pbuf_i => NULL() + ENDIF + ENDIF + + ! Field : U10M, V10M + ! Description: E/W and N/S wind speed @ 10m height + ! Unit : m/s + ! Dimensions : nX, nY + State_Met(LCHNK)%U10M (1,:nY) = state%U(:nY,nZ) + State_Met(LCHNK)%V10M (1,:nY) = state%V(:nY,nZ) + + ! Field : USTAR + ! Description: Friction velocity + ! Unit : m/s + ! Dimensions : nX, nY + ! Note : We here combine the land friction velocity (fv) with + ! the ocean friction velocity (ustar) + DO J = 1, nY + State_Met(LCHNK)%USTAR (1,J) = & + cam_in%fv(J) * ( cam_in%landFrac(J)) & + + cam_in%uStar(J) * ( 1.0e+0_fp - cam_in%landFrac(J)) + ENDDO + + ! Field : Z0 + ! Description: Surface roughness length + ! Unit : m + ! Dimensions : nX, nY + State_Met(LCHNK)%Z0 (1,:nY) = Z0(:nY) + + ! Field : IODIDE + ! Description: Surface iodide concentration + ! Unit : nM + ! Dimensions : nX, nY + FieldName = 'HCO_iodide' + tmpIdx = pbuf_get_index(FieldName, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + State_Chm(LCHNK)%IODIDE(1,:nY) = 0.0e+0_fp + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + State_Chm(LCHNK)%IODIDE(1,:nY) = pbuf_i(:nY) + pbuf_chnk => NULL() + pbuf_i => NULL() + ENDIF + + ! Field : SALINITY + ! Description: Ocean salinity + ! Unit : PSU + ! Dimensions : nX, nY + ! Note : Possibly get ocean salinity from POP? + FieldName = 'HCO_salinity' + tmpIdx = pbuf_get_index(FieldName, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + State_Chm(LCHNK)%SALINITY(1,:nY) = 0.0e+0_fp + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + State_Chm(LCHNK)%SALINITY(1,:nY) = pbuf_i(:nY) + pbuf_chnk => NULL() + pbuf_i => NULL() + ENDIF + + ! Field : OMOC + ! Description: OM/OC ratio + ! Unit : - + ! Dimensions : nX, nY + IF ( currMo == 12 .or. currMo == 1 .or. currMo == 2 ) THEN + FieldName = 'HCO_OMOC_DJF' + ELSE IF ( currMo == 3 .or. currMo == 4 .or. currMo == 5 ) THEN + FieldName = 'HCO_OMOC_MAM' + ELSE IF ( currMo == 6 .or. currMo == 7 .or. currMo == 8 ) THEN + FieldName = 'HCO_OMOC_JJA' + ELSE IF ( currMo == 9 .or. currMo == 10 .or. currMo == 11 ) THEN + FieldName = 'HCO_OMOC_SON' + ENDIF + tmpIdx = pbuf_get_index(FieldName, rc) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + ! there is an error here and the field was not found + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + ELSE + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) + DO J = 1, nY + State_Chm(LCHNK)%OMOC(1,J) = pbuf_i(J) + ENDDO + pbuf_i => NULL() + ENDIF + + ! Three-dimensional fields on level edges + DO J = 1, nY + DO L = 1, nZ+1 + ! Field : PEDGE + ! Description: Wet air pressure at (vertical) level edges + ! Unit : hPa + ! Dimensions : nX, nY, nZ+1 + State_Met(LCHNK)%PEDGE (1,J,L) = state%pint(J,nZ+2-L)*0.01e+0_fp + + ! Field : CMFMC + ! Description: Upward moist convective mass flux + ! Unit : kg/m^2/s + ! Dimensions : nX, nY, nZ+1 + State_Met(LCHNK)%CMFMC (1,J,L) = 0.0e+0_fp + + ! Field : PFICU, PFLCU + ! Description: Downward flux of ice/liquid precipitation (convective) + ! Unit : kg/m^2/s + ! Dimensions : nX, nY, nZ+1 + State_Met(LCHNK)%PFICU (1,J,L) = 0.0e+0_fp + State_Met(LCHNK)%PFLCU (1,J,L) = 0.0e+0_fp + + ! Field : PFILSAN, PFLLSAN + ! Description: Downward flux of ice/liquid precipitation (Large-scale & anvil) + ! Unit : kg/m^2/s + ! Dimensions : nX, nY, nZ+1 + State_Met(LCHNK)%PFILSAN (1,J,L) = LsFlxSnw(J,nZ+2-L) ! kg/m2/s + State_Met(LCHNK)%PFLLSAN (1,J,L) = MAX(0.0e+0_fp,LsFlxPrc(J,nZ+2-L) - LsFlxSnw(J,nZ+2-L)) ! kg/m2/s + ENDDO + ENDDO + + DO J = 1, nY + ! Field : CLDTOPS + ! Description: Max cloud top height + ! Unit : level + ! Dimensions : nX, nY + State_Met(LCHNK)%CLDTOPS(1,J) = nZ + 1 - NINT(cldTop(J)) + ENDDO + + ! Three-dimensional fields on level centers + DO J = 1, nY + DO L = 1, nZ + ! Field : U, V + ! Description: E/W and N/S component of wind + ! Unit : m/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%U (1,J,L) = state%U(J,nZ+1-L) + State_Met(LCHNK)%V (1,J,L) = state%V(J,nZ+1-L) + + ! Field : OMEGA + ! Description: Updraft velocity + ! Unit : Pa/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%OMEGA (1,J,L) = state%Omega(J,nZ+1-L) + + ! Field : CLDF + ! Description: 3-D cloud fraction + ! Unit : - + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%CLDF (1,J,L) = cldFrc(J,nZ+1-L) + + ! Field : DTRAIN + ! Description: Detrainment flux + ! Unit : kg/m^2/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%DTRAIN (1,J,L) = 0.0e+0_fp ! Used in convection + + ! Field : DQRCU + ! Description: Convective precipitation production rate + ! Unit : kg/kg dry air/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%DQRCU (1,J,L) = 0.0e+0_fp ! Used in convection + + ! Field : DQRLSAN + ! Description: Large-scale precipitation production rate + ! Unit : kg/kg dry air/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%DQRLSAN (1,J,L) = PRain(J,nZ+1-L) ! kg/kg/s + + ! Field : QI, QL + ! Description: Cloud ice/water mixing ratio + ! Unit : kg/kg dry air + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%QI (1,J,L) = MAX(1.0e-10_fp, state%q(J,nZ+1-L,ixCldIce)) ! kg ice / kg dry air + State_Met(LCHNK)%QL (1,J,L) = MAX(1.0e-10_fp, state%q(J,nZ+1-L,ixCldLiq)) ! kg water / kg dry air + + ! Field : RH + ! Description: Relative humidity + ! Unit : % + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%RH (1,J,L) = relHum(J,nZ+1-L) * 100.0e+0_fp + + ! Field : TAUCLI, TAUCLW + ! Description: Optical depth of ice/H2O clouds + ! Unit : - + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%TAUCLI (1,J,L) = TauCli(J,nZ+1-L) + State_Met(LCHNK)%TAUCLW (1,J,L) = TauClw(J,nZ+1-L) + + ! Field : REEVAPCN + ! Description: Evaporation of convective precipitation + ! (w/r/t dry air) + ! Unit : kg + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%REEVAPCN (1,J,L) = 0.0e+0_fp + + ! Field : REEVAPLS + ! Description: Evaporation of large-scale + anvil precipitation + ! (w/r/t dry air) + ! Unit : kg/kg/s + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%REEVAPLS (1,J,L) = NEvapr(J,nZ+1-L) ! kg/kg/s + + ! Field : SPHU1, SPHU2 + ! Description: Specific humidity at current and next timestep + ! Unit : g H2O/ kg air + ! Dimensions : nX, nY, nZ + ! Note : Since we are using online meteorology, we do not have + ! access to the data at the next time step + ! Compute tendency in g H2O/kg air/s (tmmf, 1/13/20) ? + State_Met(LCHNK)%SPHU1 (1,J,L) = qH2O(J,nZ+1-L) * 1.0e+3_fp ! g/kg + State_Met(LCHNK)%SPHU2 (1,J,L) = qH2O(J,nZ+1-L) * 1.0e+3_fp ! g/kg + + ! Field : TMPU1, TMPU2 + ! Description: Temperature at current and next timestep + ! Unit : K + ! Dimensions : nX, nY, nZ + ! Note : Since we are using online meteorology, we do not have + ! access to the data at the next time step + ! Compute tendency in K/s (tmmf, 1/13/20) ? + State_Met(LCHNK)%TMPU1 (1,J,L) = state%t(J,nZ+1-L) + State_Met(LCHNK)%TMPU2 (1,J,L) = state%t(J,nZ+1-L) + ENDDO + ENDDO + ! Note: Setting DQRLSAN to zero in the top layer prevents upcoming NaNs + ! in the GEOS-Chem wet deposition routines. Given the altitude, it should + ! be zero anyway, this is just to prevent any numerical artifacts from + ! creeping in. + State_Met(LCHNK)%DQRLSAN (1,:nY,nZ) = 0.0e+00_fp + + ! Field : T + ! Description: Temperature at current time + ! Unit : K + ! Dimensions : nX, nY, nZ + ! Note : Since we are using online meteorology, we do not have + ! access to the data at the next time step + ! Compute tendency in K/s (tmmf, 1/13/20) ? + State_Met(LCHNK)%T = (State_Met(LCHNK)%TMPU1 + State_Met(LCHNK)%TMPU2)*0.5e+0_fp + + ! Field : SPHU + ! Description: Specific humidity at current time + ! Unit : g H2O/ kg air + ! Dimensions : nX, nY, nZ + ! Note : Since we are using online meteorology, we do not have + ! access to the data at the next time step + ! Compute tendency in g H2O/kg air/s (tmmf, 1/13/20) ? + State_Met(LCHNK)%SPHU = (State_Met(LCHNK)%SPHU1 + State_Met(LCHNK)%SPHU2)*0.5e+0_fp + + ! Field : OPTD + ! Description: Total in-cloud optical depth (visible band) + ! Unit : - + ! Dimensions : nX, nY, nZ + State_Met(LCHNK)%OPTD = State_Met(LCHNK)%TAUCLI + State_Met(LCHNK)%TAUCLW + + ! Pass time values obtained from the ESMF environment to GEOS-Chem + CALL Accept_External_Date_Time( value_NYMD = currYMD, & + value_NHMS = currHMS, & + value_YEAR = currYr, & + value_MONTH = currMo, & + value_DAY = currDy, & + value_DAYOFYR = INT(FLOOR(Calday)), & + value_HOUR = currHr, & + value_MINUTE = currMn, & + value_HELAPSED = 0.0e+0_f4, & + value_UTC = currUTC, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Failed to update time in GEOS-Chem!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Accept_External_PEdge( State_Met = State_Met(LCHNK), & + State_Grid = State_Grid(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Failed to update pressure edges!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Field : PS1_DRY, PS2_DRY + ! Description: Dry surface pressure at current and next timestep + ! Unit : hPa + ! Dimensions : nX, nY, nZ+1 + ! Note : 1. Use the CAM PSDry fields instead of using the + ! GEOS-Chem calculation + ! 2. As we are using online meteorology, we do not + ! have access to the fields at the next time step + ! Compute Pa/s tendency? (tmmf, 1/13/20) + State_Met(LCHNK)%PS1_DRY (1,:nY) = state%PSDry(:nY) * 0.01e+0_fp + State_Met(LCHNK)%PS2_DRY (1,:nY) = state%PSDry(:nY) * 0.01e+0_fp + + ! Field : PSC2_WET, PSC2_DRY + ! Description: Interpolated wet and dry surface pressure at the + ! current time + ! Unit : hPa + ! Dimensions : nX, nY, nZ+1 + ! Note : As we are using online meteorology, we do not + ! have access to the fields at the next time step + ! Compute Pa/s tendency? (tmmf, 1/13/20) + State_Met(LCHNK)%PSC2_WET = State_Met(LCHNK)%PS1_WET + State_Met(LCHNK)%PSC2_DRY = State_Met(LCHNK)%PS1_DRY + + CALL Set_Floating_Pressures( State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Failed to set floating pressures!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Set quantities of interest but do not change VMRs + ! This function updates: + ! ==================================================================== + ! (1) PEDGE : Moist air pressure at grid box bottom [hPa] + ! (2) PEDGE_DRY : Dry air partial pressure at box bottom [hPa] + ! (3) PMID : Moist air pressure at grid box centroid [hPa] + ! (4) PMID_DRY : Dry air partial pressure at box centroid [hPa] + ! (5) PMEAN : Altitude-weighted mean moist air pressure [hPa] + ! (6) PMEAN_DRY : Alt-weighted mean dry air partial pressure [hPa] + ! (7) DELP : Delta-P extent of grid box [hPa] + ! (Same for both moist and dry air since we + ! assume constant water vapor pressure + ! across box) + ! (8) AIRDEN : Mean grid box dry air density [kg/m^3] + ! (defined as total dry air mass/box vol) + ! (9) AIRNUMDEN : Mean grid box dry air number density [molec/m^3] + ! (10) MAIRDEN : Mean grid box moist air density [kg/m^3] + ! (defined as total moist air mass/box vol) + ! (11) AD : Total dry air mass in grid box [kg] + ! (12) ADMOIST : Total moist air mass in grid box [kg] + ! (13) BXHEIGHT : Vertical height of grid box [m] + ! (14) AIRVOL : Volume of grid box [m^3] + ! (15) MOISTMW : Molecular weight of moist air in box [g/mol] + ! (16) IsLand : Logical for grid cells over land [-] + ! (17) IsWater : Logical for grid cells over water [-] + ! (18) IsIce : Logical for grid cells over ice [-] + ! (19) IsSnow : Logical for grid cells over snow [-] + ! (20) InTroposph: Logical for tropospheric grid cells [-] + ! (21) InStratMes: Logical for non-tropospheric grid cells [-] + ! (22) InStratosp: Logical for stratospheric grid cells [-] + ! (23) InChemGrid: Logical for chemistry grid cells [-] + ! (24) LocalSolar: Local solar time [-] + ! (25) IsLocalNoo: Logical for local noon [-] + ! (26) TropLev : Maximum tropopause level [-] + ! (27) TropHt : Maximum tropopause height [km] + ! ==================================================================== + CALL AirQnt( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC, & + Update_Mixing_Ratio = .False. ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Failed to calculate air properties!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! SDE 05/28/13: Set H2O to State_Chm tracer if relevant and, + ! if LSETH2O=F and LACTIVEH2O=T, update specific humidity + ! in the stratosphere + ! + ! NOTE: Specific humidity may change in SET_H2O_TRAC and + ! therefore this routine may call AIRQNT again to update + ! air quantities and tracer concentrations (ewl, 10/28/15) + IF ( Input_Opt%Its_A_Fullchem_Sim .and. iH2O > 0 ) THEN + CALL Set_H2O_Trac( SETSTRAT = Input_Opt%LSETH2O, & + Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Set_H2O_Trac" #1!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Only force strat once if using UCX + IF (Input_Opt%LSETH2O) Input_Opt%LSETH2O = .FALSE. + ENDIF + + ! Do this after AirQnt, such that we overwrite GEOS-Chem isLand, isWater and + ! isIce, which are based on albedo. Rather, we use CLM landFranc, ocnFrac + ! and iceFrac. We also compute isSnow + DO J = 1, nY + iMaxLoc = MAXLOC( (/ State_Met(LCHNK)%FRLAND(1,J) + & + State_Met(LCHNK)%FRLANDICE(1,J) + & + State_Met(LCHNK)%FRLAKE(1,J), & + State_Met(LCHNK)%FRSEAICE(1,J), & + State_Met(LCHNK)%FROCEAN(1,J) - & + State_Met(LCHNK)%FRSEAICE(1,J) /) ) + IF ( iMaxLoc(1) == 3 ) iMaxLoc(1) = 0 + ! reset ocean to 0 + + IF ( iMaxLoc(1) == 0 ) THEN + State_Met(LCHNK)%isLand(1,J) = .False. + State_Met(LCHNK)%isWater(1,J) = .True. + State_Met(LCHNK)%isIce(1,J) = .False. + ELSEIF ( iMaxLoc(1) == 1 ) THEN + State_Met(LCHNK)%isLand(1,J) = .True. + State_Met(LCHNK)%isWater(1,J) = .False. + State_Met(LCHNK)%isIce(1,J) = .False. + ELSEIF ( iMaxLoc(1) == 2 ) THEN + State_Met(LCHNK)%isLand(1,J) = .False. + State_Met(LCHNK)%isWater(1,J) = .False. + State_Met(LCHNK)%isIce(1,J) = .True. + ELSE + Write(iulog,*) " iMaxLoc gets value: ", iMaxLoc + ErrMsg = 'Failed to figure out land/water' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + State_Met(LCHNK)%isSnow(1,J) = & + ( State_Met(LCHNK)%FRSEAICE(1,J) > 0.0e+0_fp & + .or. State_Met(LCHNK)%SNODP(1,J) > 0.01_fp ) + + ENDDO + + ! Do this after AirQnt in order to use AIRDEN and BXHEIGHT + DO J = 1, nY + O3col(J) = 0.0e+0_fp + DO L = 1, nZ + O3col(J) = O3col(J) & + + State_Chm(LCHNK)%Species(iO3)%Conc(1,J,L) & + * State_Met(LCHNK)%AIRDEN(1,J,L) & + * State_Met(LCHNK)%BXHEIGHT(1,J,L) + ENDDO + O3col(J) = O3col(J) * ( AVO / MWO3 ) / 1e+1_fp / 2.69e+16_fp + ENDDO + + ! Field : TO3 + ! Description: Total overhead ozone column + ! Unit : DU + ! Dimensions : nX, nY + State_Met(LCHNK)%TO3 (1,:nY) = O3col(:nY) + + IF ( Input_Opt%Linear_Chem .AND. & + State_Grid(LCHNK)%MaxChemLev /= State_Grid(LCHNK)%nZ ) THEN + IF ( iStep == 1 ) THEN + ALLOCATE( BrPtrDay ( 6 ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating BrPtrDay') + ALLOCATE( BrPtrNight( 6 ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating BrPtrNight') + DO N = 1, 6 + ! Skip if species is not defined + IF ( GC_Bry_TrID(N) <= 0 ) CYCLE + + ! Get Bry name + SpcName = State_Chm(LCHNK)%SpcData(GC_Bry_TrID(N))%Info%Name + + ! Construct field name using Bry name + PREFIX = 'GEOSCCM_'//TRIM(SpcName) + + ALLOCATE( BrPtrDay(N)%MR(1,PCOLS,nZ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating BrPtrDay%MR') + ALLOCATE( BrPtrNight(N)%MR(1,PCOLS,nZ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating BrPtrNight%MR') + + ! Get pointer to this field. These are the mixing ratios (pptv). + + ! Day + FieldName = TRIM(PREFIX) // '_DAY' + tmpIdx = pbuf_get_index(FieldName, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + BrPtrDay(N)%MR(1,:nY,nZ:1:-1) = 0.0e+0_f4 + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + BrPtrDay(N)%MR(1,:nY,nZ:1:-1) = REAL(pbuf_ik(:nY,:nZ), f4) + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + + ! Night + FieldName = TRIM(PREFIX) // '_NIGHT' + tmpIdx = pbuf_get_index(FieldName, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + BrPtrDay(N)%MR(1,:nY,nZ:1:-1) = 0.0e+0_f4 + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + BrPtrNight(N)%MR(1,:nY,nZ:1:-1) = REAL(pbuf_ik(:nY,:nZ), f4) + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + + ENDDO + + DO N = 1,NSCHEM + + ! Get GEOS-Chem species index + M = TrID_GC(N) + + ! Skip if species is not defined + IF ( M <= 0 ) CYCLE + + ! Get species name + SpcName = State_Chm(LCHNK)%SpcData(M)%Info%Name + + ! --------------------------------------------------------------- + ! Get pointers to fields + ! --------------------------------------------------------------- + + ! Production rates [v/v/s] + FieldName = 'GMI_PROD_'//TRIM(SpcName) + + ALLOCATE( PLVEC(N)%PROD(1,PCOLS,nZ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating PLVEC%PROD') + ALLOCATE( PLVEC(N)%LOSS(1,PCOLS,nZ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating PLVEC%PROD') + + ! Get pointer from HEMCO + tmpIdx = pbuf_get_index(FieldName, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + PLVEC(N)%PROD(1,:nY,nZ:1:-1) = 0.0e+0_f4 + FND = .False. + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + PLVEC(N)%PROD(1,:nY,nZ:1:-1) = REAL(pbuf_ik(:nY,:nZ),f4) + FND = .True. + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + + ! Warning message + IF ( .NOT. FND .AND. Input_Opt%amIRoot ) THEN + ErrMsg = 'Cannot find archived production rates for ' // & + TRIM(SpcName) // ' - will use value of 0.0. ' // & + 'To use archived rates, add the following field ' // & + 'to the HEMCO configuration file: '// TRIM( FieldName ) + CALL GC_Warning( ErrMsg, RC, ThisLoc ) + ENDIF + + ! Loss frequency [s-1] + FieldName = 'GMI_LOSS_'//TRIM(SpcName) + + ! Get pointer from HEMCO + tmpIdx = pbuf_get_index(FieldName, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + PLVEC(N)%LOSS(1,:nY,nZ:1:-1) = 0.0e+0_f4 + FND = .False. + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + PLVEC(N)%LOSS(1,:nY,nZ:1:-1) = REAL(pbuf_ik(:nY,:nZ), f4) + FND = .True. + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + + ! Warning message + IF ( .NOT. FND .AND. Input_Opt%amIRoot ) THEN + ErrMsg= 'Cannot find archived loss frequencies for ' // & + TRIM(SpcName) // ' - will use value of 0.0. ' // & + 'To use archived rates, add the following field ' // & + 'to the HEMCO configuration file: '//TRIM(FieldName) + CALL GC_Warning( ErrMsg, RC, ThisLoc ) + ENDIF + + ENDDO !N + + ! Get pointer to GMI_OH + + ALLOCATE( GMI_OH(1,PCOLS,nZ), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating GMI_OH') + + tmpIdx = pbuf_get_index(FieldName, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + GMI_OH(1,:nY,nZ:1:-1) = 0.0e+0_f4 + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + GMI_OH(1,:nY,nZ:1:-1) = REAL(pbuf_ik(:nY,:nZ), f4) + pbuf_chnk => NULL() + pbuf_ik => NULL() + ENDIF + ENDIF + + ENDIF + call t_stopf('GEOSChem_CAM_Interfacing') + + ! This is not necessary as we prescribe CH4 surface mixing ratios + ! through CAM. + !! Prescribe methane surface concentrations throughout PBL + !IF ( ITS_A_FULLCHEM_SIM .and. id_CH4 > 0 ) THEN + ! + ! ! Set CH4 concentrations + ! CALL SET_CH4( Input_Opt = Input_Opt, & + ! State_Chm = State_Chm(LCHNK), & + ! State_Diag = State_Diag(LCHNK), & + ! State_Grid = State_Grid(LCHNK), & + ! State_Met = State_Met(LCHNK), & + ! RC = RC ) + ! + ! ! Trap potential errors + ! IF ( RC /= GC_SUCCESS ) THEN + ! ErrMsg = 'Error encountered in call to "SET_CH4"!' + ! CALL Error_Stop( ErrMsg, ThisLoc ) + ! ENDIF + !ENDIF + + ! Eventually initialize/reset wetdep + IF ( Input_Opt%LConv .OR. Input_Opt%LChem .OR. Input_Opt%LWetD ) THEN + CALL Setup_WetScav( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Setup_WetScav"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + !============================================================== + ! ***** C O M P U T E P B L H E I G H T etc. ***** + !============================================================== + ! Move this call from the PBL mixing routines because the PBL + ! height is used by drydep and some of the emissions routines. + ! (ckeller, 3/5/15) + ! This function updates: + ! ==================================================================== + ! (1) InPbl : Logical indicating if we are in the PBL [-] + ! (2) PBL_TOP_L : Number of layers in the PBL [-] + ! (3) PBL_TOP_hPa: Pressure at the top of the PBL [hPa] + ! (4) PBL_TOP_m : PBL height [m] + ! (5) PBL_THICK : PBL thickness [hPa] + ! (6) F_OF_PBL : Fraction of grid box within the PBL [-] + ! (7) F_UNDER_PBLTOP: Fraction of grid box underneath the PBL top [-] + ! (8) PBL_MAX_L : Model level where PBL top occurs [-] + ! ==================================================================== + CALL Compute_PBL_Height( Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_PBL_Height"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + !-------------------------------------------------------------- + ! Test for emission timestep + ! Now always do emissions here, even for full-mixing + ! (ckeller, 3/5/15) + !-------------------------------------------------------------- + !================================================================== + ! ***** D R Y D E P O S I T I O N ***** + !================================================================== + !================================================================== + ! Compute dry deposition velocities + ! + ! CLM computes dry deposition velocities but only for gas-phase + ! species and only over land. We therefore need to both pass the + ! the CLM dry deposition velocities as well as compute them using + ! the GEOS-Chem dry deposition module. If using the CLM velocities, + ! then scale them with the ocean fraction; otherwise use GEOS-Chem + ! computed velocities. + ! + ! drydep_method must be set to DD_XLND. + ! + !================================================================== + ! + ! State_Chm expects dry deposition velocities in m/s, whereas + ! CLM returns land deposition velocities in cm/s! + ! + ! For now, dry deposition velocities are only computed for gases + ! (which is what CLM deals with). Dry deposition for aerosols is + ! work in progress. + ! + ! Thibaud M. Fritz - 27 Feb 2020 + !================================================================== + + call t_startf('GEOSChem_DryDep') + + IF ( Input_Opt%LDryD ) THEN + ! Compute the Olson landmap fields of State_Met + ! (e.g. State_Met%IREG, State_Met%ILAND, etc.) + CALL Compute_Olson_Landmap( Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_Olson_Landmap"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Compute State_Met%XLAI (for drydep) and State_Met%MODISLAI, + ! which is the average LAI per grid box (for soil NOx emissions) + CALL Compute_Xlai( Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_Xlai"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ! Compute drydep velocities and update State_Chm%DryDepVel + CALL Do_Drydep( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Do_Drydep"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + DO N = 1, nddvels + + !! Print debug + !IF ( rootChunk ) THEN + ! IF ( N == 1 ) THEN + ! Write(iulog,*) "Number of GC dry deposition species = ", & + ! SIZE(State_Chm(LCHNK)%DryDepVel(:,:,:),3) + ! Write(iulog,*) "Number of CESM dry deposition species = ", & + ! nddvels + ! ENDIF + ! Write(iulog,*) "N = ", N + ! Write(iulog,*) "drySpc_ndx = ", drySpc_ndx(N) + ! Write(iulog,*) "GC index = ", map2GC_dryDep(N) + ! IF ( map2GC_dryDep(N) > 0 ) THEN + ! Write(iulog,*) "GC name = ", TRIM(DEPNAME(map2GC_dryDep(N))) + ! ENDIF + ! Write(iulog,*) "dry Species= ", TRIM(drydep_list(N)) + ! IF ( drySpc_ndx(N) > 0 ) THEN + ! Write(iulog,*) "tracerName = ", TRIM(tracerNames(drySpc_ndx(N))) + ! ENDIF + ! Write(iulog,*) "CLM-depVel = ", & + ! MAXVAL(cam_in%depvel(:nY,N)) * 1.0e-02_fp, " [m/s]" + ! IF ( map2GC_dryDep(N) > 0 ) THEN + ! Write(iulog,*) "GC-depVel = ", & + ! MAXVAL(State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N))), " [m/s]" + ! ENDIF + !ENDIF + + IF ( map2GC_dryDep(N) > 0 ) THEN + ! State_Chm%DryDepVel is in m/s + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) = & + ! This first bit corresponds to the dry deposition + ! velocities over land as computed from CLM and + ! converted to m/s. This is scaled by the fraction + ! of land. + cam_in%depVel(:nY,N) * 1.0e-02_fp & + * MAX(0._fp, 1.0_fp - State_Met(LCHNK)%FROCEAN(1,:nY)) & + ! This second bit corresponds to the dry deposition + ! velocities over ocean and sea ice as computed from + ! GEOS-Chem. This is scaled by the fraction of ocean + ! and sea ice. + + State_Chm(LCHNK)%DryDepVel(1,:nY,map2GC_dryDep(N)) & + * State_Met(LCHNK)%FROCEAN(1,:nY) + ENDIF + ENDDO + + CALL Update_DryDepFreq( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ENDIF + + !=========================================================== + ! ***** S U R F A C E F L U X E S ***** + ! Note: Turbulence (PBL mixing) is NOT done by GEOS-Chem routines + ! and is handled by CAM. But we reuse GEOS-Chem code here to compute + ! the surface *deposition-only* fluxes (-dflx) to merge with the CAM + ! fluxes passed to turbulence. (hplin, 4/30/24) + !=========================================================== + + ! Updates from Bob Yantosca, 06/2020 + ! Compute the surface flux for the non-local mixing, + ! (which means getting emissions & drydep from HEMCO) + ! and store it in State_Chm%Surface_Flux + ! + ! For CESM-GC, Surface_Flux will be equal to the opposite of the + ! dry deposition flux since emissions are loaded externally + ! ( SurfaceFlux = eflx - dflx = - dflx ) + IF ( Input_Opt%LTURB .and. Input_Opt%LNLPBL ) THEN + CALL Compute_Sflx_For_Vdiff( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_Sflx_for_Vdiff"!' + CALL Error_Stop( errMsg, thisLoc ) + ENDIF + ENDIF + + ! This dry deposition timer intentionally ends after Compute_Sflx_For_Vdiff + ! because the SurfaceFlux is only the GEOS-Chem deposition flux. (hplin, 4/30/24) + call t_stopf('GEOSChem_DryDep') + + !----------------------------------------------------------------------- + ! Get emissions from HEMCO + Lightning + Fire + ! Add surface emissions to cam_in + !----------------------------------------------------------------------- + + call t_startf('GEOSChem_Emissions') + CALL GC_Emissions_Calc( state = state, & + hco_pbuf2d = hco_pbuf2d, & + State_Met = State_Met(LCHNK), & + cam_in = cam_in, & + eflx = eflx, & + iStep = iStep ) + call t_stopf('GEOSChem_Emissions') + + !----------------------------------------------------------------------- + ! Add dry deposition flux from GEOS-Chem State_Chm%SurfaceFlux + ! (stored as SurfaceFlux = -dflx) + !----------------------------------------------------------------------- + + call t_startf('GEOSChem_DryDep') + IF ( Input_Opt%LDryD ) THEN + DO ND = 1, State_Chm(BEGCHUNK)%nDryDep + ! Get the species ID from the drydep ID + N = State_Chm(BEGCHUNK)%Map_DryDep(ND) + IF ( N <= 0 ) CYCLE + + M = map2GCinv(N) + IF ( M <= 0 ) CYCLE + + cam_in%cflx(1:nY,M) = cam_in%cflx(1:nY,M) & + + State_Chm(LCHNK)%SurfaceFlux(1,1:nY,N) + ENDDO + ENDIF + call t_stopf('GEOSChem_DryDep') + + !----------------------------------------------------------------------- + ! Add non-surface emissions + !----------------------------------------------------------------------- + + call t_startf('GEOSChem_Emissions') + + ! Use units of kg/m2 as State_Chm%Species to add emissions fluxes + CALL Convert_Spc_Units( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + new_units = KG_SPECIES_PER_M2, & + previous_units = previous_units, & + RC = RC ) + + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Convert_Spc_Units"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + DO N = 1, pcnst + M = map2GC(N) + IF ( M > 0 ) THEN + ! Add to GEOS-Chem species + State_Chm(LCHNK)%Species(M)%Conc(1,:nY,:nZ) = State_Chm(LCHNK)%Species(M)%Conc(1,:nY,:nZ) & + + eflx(:nY,nZ:1:-1,N) * dT + ELSEIF ( M < 0 ) THEN + ! Add to constituent (mostly for MAM4 aerosols) + ! Convert from kg/m2/s to kg/kg/s + ptend%q(:nY,nZ:1:-1,N) = ptend%q(:nY,nZ:1:-1,N) & + + eflx(:nY,nZ:1:-1,N) & + / ( g0_100 * State_Met(LCHNK)%DELP_DRY(1,:nY,:nZ) ) + ENDIF + ENDDO + + ! Convert back to original unit + CALL Convert_Spc_Units( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + new_units = previous_units, & + RC = RC ) + + ! Convert State_Chm%Species back to original units + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Convert_Spc_Units"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + call t_stopf('GEOSChem_Emissions') + + !============================================================== + ! ***** C H E M I S T R Y ***** + !============================================================== + + call t_startf( 'chemdr' ) + + ! Get the overhead column O3 for computing J-values + IF ( Input_Opt%Its_A_FullChem_Sim .OR. & + Input_Opt%Its_An_Aerosol_Sim ) THEN + + IF ( Input_Opt%LChem ) THEN + CALL Compute_Overhead_O3( Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + State_Chm = State_Chm(LCHNK), & + DAY = currDy, & + USE_O3_FROM_MET = Input_Opt%Use_O3_From_Met, & + TO3 = State_Met(LCHNK)%TO3, & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Compute_Overhead_O3"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + ENDIF + + IF ( Input_Opt%Its_A_Fullchem_Sim .and. iH2O > 0 ) THEN + CALL Set_H2O_Trac( SETSTRAT = .False. , & + Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + ! Trap potential errors + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Set_H2O_Trac" #2!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + ENDIF + + ! Here, we apply surface mixing ratios for long-lived species + ! (copied from sfcvmr_mod.F90) + ! Loop over all objects + iSfcMrObj => SfcMrHead + DO WHILE( ASSOCIATED( iSfcMrObj ) ) + + ! Get concentration for this species + tmpIdx = pbuf_get_index(TRIM(iSfcMrObj%FldName), RC) + IF ( tmpIdx < 0 .OR. (iStep == 1) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(iSfcMrObj%FldName) + ELSE + CALL pbuf_get_field(pbuf, tmpIdx, pbuf_i) + + ! Set mixing ratio in PBL + SpcInfo => State_Chm(LCHNK)%SpcData(iSfcMrObj%SpcID)%Info + N = SpcInfo%ModelID + IF ( N > 0 ) THEN + DO L = 1, nZ + DO J = 1, nY + IF ( State_Met(LCHNK)%F_UNDER_PBLTOP(1,J,L) > 0.0_fp ) THEN + State_Chm(LCHNK)%Species(N)%Conc(1,J,L) = & + ( pbuf_i(J) * 1.0e-9_fp ) & + / ( MWDry / SpcInfo%MW_g ) + ENDIF ! end selection of PBL boxes + ENDDO + ENDDO + ENDIF + ENDIF + + ! Point to next element in list + iSfcMrObj => iSfcMrObj%Next + ENDDO + + call t_startf('GEOSChem_Fullchem') + + ! Reset photolysis rates + State_Chm(LCHNK)%Phot%ZPJ = 0.0e+0_r8 + + ! Perform chemistry + CALL Do_Chemistry( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Do_Chemistry"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + call t_stopf('GEOSChem_Fullchem') + + ! GEOS-Chem considers CO2 as a dead species and resets its concentration + ! internally. Right after the call to `Do_Chemistry`, State_Chm%Species(iCO2) + ! corresponds to the chemically-produced CO2. The real CO2 concentration + ! is thus the concentration before chemistry + the chemically-produced CO2. + State_Chm(LCHNK)%Species(iCO2)%Conc(1,:nY,:nZ) = State_Chm(LCHNK)%Species(iCO2)%Conc(1,:nY,:nZ) & + + MMR_Beg(:nY,:nZ,iCO2) + + ! Make sure State_Chm(LCHNK) is back in kg/kg dry! Just check first species. + IF ( State_Chm(LCHNK)%Species(1)%Units /= KG_SPECIES_PER_KG_DRY_AIR ) THEN + Write(iulog,*) 'Current unit = ', TRIM(UNIT_STR(State_Chm(LCHNK)%Species(1)%Units)) + Write(iulog,*) 'Expected unit = ', TRIM(UNIT_STR(KG_SPECIES_PER_KG_DRY_AIR)) + CALL ENDRUN('Incorrect unit in GEOS-Chem State_Chm%Species') + ENDIF + + call t_stopf( 'chemdr' ) + + ! Save and write J-values to pbuf for HEMCO + ! in HCO_IN_JNO2, HCO_IN_JOH + FieldName = 'HCO_IN_JNO2' + tmpIdx = pbuf_get_index(FieldName, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + + ! RXN_NO2: NO2 + hv --> NO + O + pbuf_i(:nY) = State_Chm(LCHNK)%Phot%ZPJ(1,State_Chm(LCHNK)%Phot%RXN_NO2,1,:nY) + + pbuf_chnk => NULL() + pbuf_i => NULL() + ENDIF + + FieldName = 'HCO_IN_JOH' + tmpIdx = pbuf_get_index(FieldName, RC) + IF ( tmpIdx < 0 .or. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,*) "chem_timestep_tend: Field not found ", TRIM(FieldName) + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + + ! RXN_O3_1: O3 + hv --> O2 + O + pbuf_i(:nY) = State_Chm(LCHNK)%Phot%ZPJ(1,State_Chm(LCHNK)%Phot%RXN_O3_1,1,:nY) + pbuf_chnk => NULL() + pbuf_i => NULL() + ENDIF + + DO N = 1, gas_pcnst + ! See definition of map2chm + M = map2chm(N) + IF ( M > 0 ) THEN + vmr1(:nY,:nZ,N) = State_Chm(LCHNK)%Species(M)%Conc(1,:nY,nZ:1:-1) * & + MWDry / adv_mass(N) + ELSEIF ( M < 0 ) THEN + vmr1(:nY,:nZ,N) = state%q(:nY,:nZ,-M) * & + MWDry / adv_mass(N) + ENDIF + ENDDO + + !============================================================== + ! ***** M A M G A S - A E R O S O L E X C H A N G E ***** + !============================================================== + +#if defined( MODAL_AERO ) + call t_startf('GEOSChem_MAM_Interfacing') + ! Construct dgncur_a array for the dry geometric mean diameter [m] + ! of given number distribution. (hplin, 3/6/23) + ! Requires a pbuf field DGNUM + call pbuf_get_field(pbuf, pbuf_get_index('DGNUM'), dgncur_a) + + ! Amount of chemically-produced H2SO4 (mol/mol) + ! This is archived from fullchem_mod.F90 using SO2 + OH rate from KPP (hplin, 1/25/23) + del_h2so4_gasprod(:nY,:nZ) = State_Chm(LCHNK)%H2SO4_PRDR(1,:nY,nZ:1:-1) + + ! Prescribe aerosol size distribution using the method in Feng et al., 2021? + ! If yes, then vmr1 is overwritten with prescribed values for sulfate distribution + ! rather than using values from within MAM4. + ! + ! There are two approaches to where to put in this prescribed value. + ! Either before aero_model_gasaerexch, simulating the change in distribution as chem fluxes (1) + ! or after, directly overwriting any distribution information coming out of aero_model_gasaerexch (2). + ! + ! Testing needs to be done to see if 1 or 2 is 'better' (more reasonable vs. CC and obs.) + if(usePrescribedAerDistribution) then + ! Assume all chemically-produced SO4 is in the gas-phase + ! and use MAM4 to partition into a1, a2, a3. Later, the bins can be prescribed. (hplin, 3/16/23) + ! This will allow total sulfur to be correctly conserved and H2SO4 partitioning is still held. + vmr1(:nY,:nZ,l_H2SO4) = vmr0(:nY,:nZ,l_H2SO4) + State_Chm(LCHNK)%H2SO4_PRDR(1,:nY,nZ:1:-1) + DO M = 1, ntot_amode + N = lptr_so4_a_amode(M) + IF ( N <= 0 ) CYCLE + P = mapCnst(N) + vmr1(:nY,:nZ,P) = vmr0(:nY,:nZ,P) + ENDDO + + ! sect02_new only takes dlo and dhi and auto-computes bin spacing. + ! it may be necessary to prescribe the bin spacing as well to fit a1-3 definitions + ! D < 0.05 is aitken mode, 0.05 to 2 is accumulation mode, D > 2um is coarse. + + prescr_aer_lbnd = 0.0_r8 + prescr_aer_ubnd = 10.0_r8 + + ! First, sum all the available VMRs + vmr_so4_sum(:nY,:nZ) = vmr0(:nY,:nZ,mapCnst(lptr_so4_a_amode(1))) + & + vmr0(:nY,:nZ,mapCnst(lptr_so4_a_amode(2))) + & + vmr0(:nY,:nZ,mapCnst(lptr_so4_a_amode(3)) ) + + ! Loop through chunks as geometric mean dia is different... + DO J = 1, nY + DO L = 1, nZ + ! Get geometric mean diameters of all aerosol bins before further MAM4 calculation + prescr_aer_abnd = (dgncur_a(J, L, 1) + dgncur_a(J, L, 2)) * 1e6_r8 / 2.0_r8 + prescr_aer_cbnd = (dgncur_a(J, L, 1) + dgncur_a(J, L, 3)) * 1e6_r8 / 2.0_r8 + + ! thus, sect02_mam4 is developed for this use. + call sect02_mam4(dgnum_um = 0.14_r8, & ! SO4 geometric mean dia. of log-normal distr [um] + sigmag = 1.6_r8, & ! sigma + duma = 1.0_r8, & ! (unknown scaling factor) + nbin = 3, & ! put into a1, a2, a3 three 'bins' + dlo_sect = (/prescr_aer_lbnd, prescr_aer_abnd, prescr_aer_cbnd/), & ! diameter bounds [um] + dhi_sect = (/prescr_aer_abnd, prescr_aer_cbnd, prescr_aer_ubnd/), & ! diameter bounds [um] + !dlo_sect = (/0.0390625_r8, 0.1_r8, 2.0_r8/), & ! diameter bounds [um] + !dhi_sect = (/0.1_r8, 2.0_r8, 10.0_r8/), & ! diameter bounds [um] + !dlo_um = 0.0390625_r8, & ! lower bound um + !dhi_um = 10.0_r8, & ! upper bound um + xnum_sect= prescr_aer_xnum, & ! prescribed aerosol number ratios + xmas_sect= prescr_aer_xmas) ! prescribed aerosol mass ratios + + ! apply the ratios into the distribution + ! (currently there is no good way to allocate the numbers - thus, this process + ! must be done as "chemical fluxes" and ask gasaerexch to do two hard things here: + ! - partition H2SO4 into the total aer-phase sulfate + ! - readjust num_aX according to changes in SO4 fluxes?) TBD hplin 5/8/23 + + ! use prescr_aer_xnum to scale since we are dealing with mol/mol and not mass quantities. + + ! so4_a3 (coarse mode) + ! ensure that total num molec is conserved. otherwise, this will be a silent sulfate sink. + ! note that prescr_xnum(2) is large, so for maximum precision, use 1.0 to minus it first. + prescr_aer_xnum(3) = (1.0_r8 - prescr_aer_xnum(2)) - prescr_aer_xnum(1) + prescr_aer_xmas(3) = (1.0_r8 - prescr_aer_xmas(2)) - prescr_aer_xmas(1) + + ! there may also be the case that presc_aer_x(3) is lower than 0 (!) which would be unphysical. + ! for safety sake, ensure that coarse sulfate ratio is no lower than 0.01. + ! we can compensate from x(2) (accumulation mode) which is generally the greatest. + if(prescr_aer_xnum(3) .lt. 0.01_r8) then + prescr_aer_xnum(3) = 0.01_r8 + prescr_aer_xnum(2) = 1.0_r8 - prescr_aer_xnum(3) - prescr_aer_xnum(1) + endif + + if(prescr_aer_xmas(3) .lt. 0.01_r8) then + prescr_aer_xmas(3) = 0.01_r8 + prescr_aer_xmas(2) = 1.0_r8 - prescr_aer_xmas(3) - prescr_aer_xmas(1) + endif + + ! so4_a2 (aitken mode) -- note this is smallest even though its a2! + vmr1(:nY,:nZ,mapCnst(lptr_so4_a_amode(2))) = vmr_so4_sum(:nY,:nZ) * prescr_aer_xnum(1) + + ! so4_a1 (accumulation mode) + vmr1(:nY,:nZ,mapCnst(lptr_so4_a_amode(1))) = vmr_so4_sum(:nY,:nZ) * prescr_aer_xnum(2) + + vmr1(:nY,:nZ,mapCnst(lptr_so4_a_amode(3))) = vmr_so4_sum(:nY,:nZ) * prescr_aer_xnum(3) + + ! write out? + ! if(masterproc .and. J .eq. 1 .and. L .eq. nZ) then + ! write(iulog,*) "prescribe aer (so4): L = ", L, " dgncur_a (um) = ", dgncur_a(J, L, :) * 1e6_r8 + ! write(iulog,*) "prescribe aer (so4): L = ", L, " prescr_aer_xnum = ", prescr_aer_xnum + ! write(iulog,*) "prescribe aer (so4): L = ", L, " prescr_aer_xmas = ", prescr_aer_xmas + ! endif + ENDDO + ENDDO + ELSE + ! Original approach: no prescribing aerosol size distribution. + ! Repartition SO4 into H2SO4 and so4_a* + IF ( l_H2SO4 > 0 .AND. l_SO4 > 0 ) THEN + P = l_H2SO4 + ! SO4_gasRatio is mol(SO4) (gaseous) / mol(SO4) (gaseous+aerosol) + vmr1(:nY,:nZ,P) = SO4_gasRatio(:nY,:nZ) * vmr1(:nY,:nZ,l_SO4) + ! binRatio is mol(SO4) (current bin) / mol(SO4) (all bins) + DO M = 1, ntot_amode + N = lptr_so4_a_amode(M) + IF ( N <= 0 ) CYCLE + P = mapCnst(N) + vmr1(:nY,:nZ,P) = vmr1(:nY,:nZ,l_SO4) & + * ( 1.0_r8 - SO4_gasRatio(:nY,:nZ) ) & + * binRatio(iSulf(M),M,:nY,:nZ) + ENDDO + ENDIF + ENDIF + + call t_stopf('GEOSChem_MAM_Interfacing') + call t_startf('GEOSChem_MAM_GasAerExch') + + call aero_model_gasaerexch( loffset = iFirstCnst - 1, & + ncol = NCOL, & + lchnk = LCHNK, & + troplev = Trop_Lev(:), & + delt = dT, & + reaction_rates = reaction_rates, & + tfld = state%t(:,:), & + pmid = state%pmid(:,:), & + pdel = state%pdel(:,:), & + mbar = mBar, & + relhum = relHum(:,:), & + zm = state%zm(:,:), & + qh2o = qH2O(:,:), & + cwat = cldW, & + cldfr = cldFrc, & + cldnum = nCldWtr, & + airdens = invariants(:,:,indexm), & + invariants = invariants, & + del_h2so4_gasprod = del_h2so4_gasprod, & + vmr0 = vmr0, & + vmr = vmr1, & + pbuf = pbuf ) + + call t_stopf('GEOSChem_MAM_GasAerExch') + call t_startf('GEOSChem_MAM_Interfacing') + + ! Repartition MAM SOAs following mapping: + ! TSOA0 + ASOAN + SOAIE + SOAGX -> soa1_a* + soa2_a* + ! TSOA1 + ASOA1 -> soa3_a* + ! TSOA2 + ASOA2 -> soa4_a* + ! TSOA3 + ASOA3 -> soa5_a* + ! TSOG0 -> SOAG0 + SOAG1 + ! TSOG1 + ASOG1 -> SOAG2 + ! TSOG2 + ASOG2 -> SOAG3 + ! TSOG3 + ASOG3 -> SOAG4 + + ! Deal with aerosol SOA species + ! First deal with lowest two volatility bins + ! Only map TOSA0 (K1) and ASOAN (K2) to soa1_ and soa2_, according to Fritz et al. + ! SOAIE (K3) and SOAGX (K4) were mapped in the code but are inconsistent with the model description paper. + speciesName_1 = 'TSOA0' + speciesName_2 = 'ASOAN' + speciesName_3 = 'SOAIE' + speciesName_4 = 'SOAGX' + K1 = get_spc_ndx(TRIM(speciesName_1), ignore_case=.true.) + K2 = get_spc_ndx(TRIM(speciesName_2), ignore_case=.true.) + K3 = get_spc_ndx(TRIM(speciesName_3), ignore_case=.true.) + K4 = get_spc_ndx(TRIM(speciesName_4), ignore_case=.true.) + bulkMass(:nY,:nZ) = 0.0e+00_r8 + DO iBin = 1, 2 + DO M = 1, ntot_amode + N = lptr2_soa_a_amode(M,iBin) + IF ( N <= 0 ) CYCLE + bulkMass(:nY,:nZ) = bulkMass(:nY,:nZ) + state%q(:nY,:nZ,N) + ENDDO + ENDDO + DO iBin = 1, 2 + DO M = 1, ntot_amode + N = lptr2_soa_a_amode(M,iBin) + IF ( N <= 0 ) CYCLE + P = mapCnst(N) + IF ( P > 0 .AND. K1 > 0 .AND. K2 > 0 ) THEN + vmr1(:nY,:nZ,P) = state%q(:nY,:nZ,N) / bulkMass(:nY,:nZ) & + * (vmr1(:nY,:nZ,K1) + vmr1(:nY,:nZ,K2)) + ENDIF + ENDDO + ENDDO + + ! Now deal with other volatility bins + DO iBin = 3, nsoa + IF ( iBin == 3 ) THEN + speciesName_1 = 'TSOA1' + speciesName_2 = 'ASOA1' + ELSEIF ( iBin == 4 ) THEN + speciesName_1 = 'TSOA2' + speciesName_2 = 'ASOA2' + ELSEIF ( iBin == 5 ) THEN + speciesName_1 = 'TSOA3' + speciesName_2 = 'ASOA3' + ENDIF + K1 = get_spc_ndx(TRIM(speciesName_1), ignore_case=.true. ) + K2 = get_spc_ndx(TRIM(speciesName_2), ignore_case=.true. ) + bulkMass(:nY,:nZ) = 0.0e+00_r8 + DO M = 1, ntot_amode + N = lptr2_soa_a_amode(M,iBin) + IF ( N <= 0 ) CYCLE + bulkMass(:nY,:nZ) = bulkMass(:nY,:nZ) + state%q(:nY,:nZ,N) + ENDDO + DO M = 1, ntot_amode + N = lptr2_soa_a_amode(M,iBin) + IF ( N <= 0 ) CYCLE + P = mapCnst(N) + IF ( P > 0 .AND. K1 > 0 .AND. K2 > 0 ) THEN + vmr1(:nY,:nZ,P) = state%q(:nY,:nZ,N) / bulkMass(:nY,:nZ) & + * (vmr1(:nY,:nZ,K1) + vmr1(:nY,:nZ,K2)) + ENDIF + ENDDO + ENDDO + + ! Now deal with gaseous SOA species + ! Deal with lowest two volatility bins - TSOG0 corresponds to SOAG0 and SOAG1 + speciesName_1 = 'TSOG0' + K1 = get_spc_ndx(TRIM(speciesName_1), ignore_case=.true.) + N = lptr2_soa_g_amode(1) + P = mapCnst(N) + ! current mode other modes (this mapping was verified to be correct.) + vmr1(:nY,:nZ,P) = vmr0(:nY,:nZ,P) / (vmr0(:nY,:nZ,P) + vmr0(:nY,:nZ,mapCnst(lptr2_soa_g_amode(2)))) & + * vmr1(:nY,:nZ,K1) + N = lptr2_soa_g_amode(2) + P = mapCnst(N) + vmr1(:nY,:nZ,P) = vmr0(:nY,:nZ,P) / (vmr0(:nY,:nZ,P) + vmr0(:nY,:nZ,mapCnst(lptr2_soa_g_amode(1)))) & + * vmr1(:nY,:nZ,K1) + + ! Deal with other volatility bins + DO iBin = 3, nsoa + N = lptr2_soa_g_amode(iBin) + P = mapCnst(N) + IF ( iBin == 3 ) THEN + speciesName_1 = 'TSOG1' + speciesName_2 = 'ASOG1' + ELSEIF ( iBin == 4 ) THEN + speciesName_1 = 'TSOG2' + speciesName_2 = 'ASOG2' + ELSEIF ( iBin == 5 ) THEN + speciesName_1 = 'TSOG3' + speciesName_2 = 'ASOG3' + ENDIF + K1 = get_spc_ndx(TRIM(speciesName_1), ignore_case=.true.) + K2 = get_spc_ndx(TRIM(speciesName_2), ignore_case=.true.) + IF ( P > 0 .AND. K1 > 0 .AND. K2 > 0 ) vmr1(:nY,:nZ,P) = vmr1(:nY,:nZ,K1) + vmr1(:nY,:nZ,K2) + ENDDO + +#endif + call t_stopf('GEOSChem_MAM_Interfacing') + + !============================================================== + ! ***** W E T D E P O S I T I O N (rainout + washout) ***** + !============================================================== + call t_startf('GEOSChem_Neu_Wetdep') + IF ( Input_Opt%LWetD ) THEN + + IF ( gas_wetdep_method == 'NEU' ) THEN + CALL Neu_wetdep_tend( LCHNK = LCHNK, & + NCOL = NCOL, & + mmr = state%q, & + pmid = state%pmid, & + pdel = state%pdel, & + zint = state%zi, & + tfld = state%t, & + delt = dT, & + prain = PRain, & + nevapr = NEvapr, & + cld = cldFrc, & + cmfdqr = cmfdqr, & + wd_tend = ptend%q, & + wd_tend_int = wetdepflx ) + ELSE + ErrMsg = 'Unknown gas_wetdep_method '//TRIM(gas_wetdep_method) + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + ENDIF + call t_stopf('GEOSChem_Neu_Wetdep') + + !============================================================== + ! ***** B O U N D A R Y C O N D I T I O N S ***** + !============================================================== + ! Set boundary conditions of long-lived species (most likely + ! CH4, OCS, N2O, CFC11, CFC12). + ! Note: This will overwrite the UCX boundary conditions + + CALL flbc_set( vmr1(:nY,:nZ,:), nY, LCHNK, mapCnst ) + + IF ( ghg_chem ) THEN + CALL ghg_chem_set_flbc( vmr1, nY ) + ENDIF + + DO N = 1, gas_pcnst + ! See definition of map2chm + M = map2chm(N) + IF ( M <= 0 ) CYCLE + State_Chm(LCHNK)%Species(M)%Conc(1,:nY,nZ:1:-1) = vmr1(:nY,:nZ,N) * & + adv_mass(N) / MWDry + ENDDO + + ! Make sure State_Chm(LCHNK) is back in kg/kg dry! Only check first species. + IF ( State_Chm(LCHNK)%Species(1)%Units /= KG_SPECIES_PER_KG_DRY_AIR ) THEN + Write(iulog,*) 'Current unit = ', TRIM(UNIT_STR(State_Chm(LCHNK)%Species(1)%Units)) + Write(iulog,*) 'Expected unit = ', TRIM(UNIT_STR(KG_SPECIES_PER_KG_DRY_AIR)) + CALL ENDRUN('Incorrect unit in GEOS-Chem State_Chm%Species') + ENDIF + + ! Reset H2O MMR to the initial value (no chemistry tendency in H2O just yet) + State_Chm(LCHNK)%Species(iH2O)%Conc(1,:,:) = MMR_Beg(:,:,iH2O) + + ! Store unadvected species data + SlsData = 0.0e+0_r8 + DO N = 1, nSls + M = map2GC_Sls(N) + IF ( M <= 0 ) CYCLE + SlsData(:nY,nZ:1:-1,N) = REAL(State_Chm(LCHNK)%Species(M)%Conc(1,:nY,:nZ),r8) + ENDDO + CALL set_short_lived_species_gc( SlsData, LCHNK, nY, pbuf ) + + ! Apply tendencies to GEOS-Chem species + DO N = 1, pcnst + M = map2GC(N) + IF ( M <= 0 ) CYCLE + ! Add change in mass mixing ratio to tendencies. + ! For NEU wet deposition, the wet removal rates are added to + ! ptend. + MMR_End(:nY,:nZ,M) = REAL(State_Chm(LCHNK)%Species(M)%Conc(1,:nY,:nZ),r8) + ptend%q(:nY,nZ:1:-1,N) = ptend%q(:nY,nZ:1:-1,N) & + + (MMR_End(:nY,:nZ,M)-MMR_Beg(:nY,:nZ,M))/dT + ENDDO + +#if defined( MODAL_AERO ) + call t_startf('GEOSChem_MAM_Interfacing') + ! Here apply tendencies to MAM aerosols + ! Initial mass in bin SM is stored as state%q(N) + ! Final mass in bin SM is stored as binRatio(SM,M) * State_Chm(P) + ! + ! We decide to apply chemical tendencies to all MAM aerosols, + ! except so4, for which the chemically-produced sulfate gets + ! partitioned in aero_model_gasaerexch. + DO M = 1, ntot_amode + DO SM = 1, nspec_amode(M) + N = lmassptr_amode(SM,M) + P = mapCnst(N) + IF ( P <= 0 ) CYCLE + ! Apply tendency from MAM gasaerexch + ptend%q(:nY,:nZ,N) = ptend%q(:nY,:nZ,N) & + + (vmr1(:nY,:nZ,P) - vmr0(:nY,:nZ,P))/dT & + * adv_mass(P) / MWDry + P = map2MAM4(SM,M) + IF ( P <= 0 ) CYCLE + K = map2GC(P) + IF ( K <= 0 .or. K == iSO4 ) CYCLE + ! Apply MAM4 chemical tendencies owing to GEOS-Chem aerosol processing + ptend%q(:nY,:nZ,N) = ptend%q(:nY,:nZ,N) & + + (binRatio(SM,M,:nY,:nZ) * & + REAL(State_Chm(LCHNK)%Species(K)%Conc(1,:nY,nZ:1:-1),r8) & + * adv_mass(mapCnst(N)) / adv_mass(mapCnst(P)) & + - state%q(:nY,:nZ,N))/dT + ENDDO + N = numptr_amode(M) + P = mapCnst(N) + IF ( P <= 0 ) CYCLE + ptend%q(:nY,:nZ,N) = ptend%q(:nY,:nZ,N) & + + (vmr1(:nY,:nZ,P) - vmr0(:nY,:nZ,P))/dT & + * adv_mass(P) / MWDry + ENDDO + N = cH2SO4 + P = l_H2SO4 + IF ( P > 0 ) THEN + ptend%q(:nY,:nZ,N) = ptend%q(:nY,:nZ,N) & + + (vmr1(:nY,:nZ,P) - vmr0(:nY,:nZ,P))/dT & + * adv_mass(P) / MWDry + ENDIF + DO iBin = 1, nsoa + N = lptr2_soa_g_amode(iBin) + P = mapCnst(N) + IF ( P > 0 ) THEN + ptend%q(:nY,:nZ,N) = ptend%q(:nY,:nZ,N) & + + (vmr1(:nY,:nZ,P) - vmr0(:nY,:nZ,P))/dT & + * adv_mass(P) / MWDry + ENDIF + ENDDO + call t_stopf('GEOSChem_MAM_Interfacing') +#endif + + DO N = 1, gas_pcnst + ! See definition of map2chm + M = map2chm(N) + IF ( M > 0 ) THEN + mmr_tend(:nY,:nZ,N) = ( REAL(State_Chm(LCHNK)%Species(M)%Conc(1,:nY,nZ:1:-1),r8) - mmr_tend(:nY,:nZ,N) ) / dT + ELSEIF ( M < 0 ) THEN + mmr_tend(:nY,:nZ,N) = ptend%q(:nY,:nZ,-M) + ENDIF + ENDDO + + IF ( Input_Opt%applyQtend ) THEN + ! Apply GEOS-Chem's H2O mixing ratio tendency to CAM's specific humidity + ! This requires to set lq(cQ) = lq(cH2O) ( = .True. ) + ptend%q(:,:,cQ) = ptend%q(:,:,cH2O) + ENDIF + + call t_startf('GEOSChem_Diagnostics') + CALL GC_Diagnostics_Calc( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + cam_in = cam_in, & + state = state, & + mmr_tend = mmr_tend, & + LCHNK = LCHNK ) + + CALL Set_Diagnostics_EndofTimestep( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + + + IF ( State_Diag(LCHNK)%Archive_AerMass ) THEN + CALL Set_AerMass_Diagnostic( Input_Opt = Input_Opt, & + State_Chm = State_Chm(LCHNK), & + State_Diag = State_Diag(LCHNK), & + State_Grid = State_Grid(LCHNK), & + State_Met = State_Met(LCHNK), & + RC = RC ) + ENDIF + + ! Compute new GEOS-Chem diagnostics into CESM History (hplin, 10/31/22) + ! Note that the containers (data pointers) actually need to be updated every time step, + ! because the State_Chm(LCHNK) target changes. There is some registry lookup overhead + ! but mitigated by a check to the history field activeness. (hplin, 11/1/22) + CALL HistoryExports_SetDataPointers(rootChunk, & + HistoryConfig, State_Chm(LCHNK), & + State_Grid(LCHNK), & + State_Diag(LCHNK), State_Met(LCHNK), & + RC) + + CALL CopyGCStates2Exports( am_I_Root = rootChunk, & + Input_Opt = Input_Opt, & + State_Grid = State_Grid(LCHNK), & + HistoryConfig = HistoryConfig, & + LCHNK = LCHNK, & + RC = RC ) + call t_stopf('GEOSChem_Diagnostics') + + IF ( ghg_chem ) THEN + ptend%lq(1) = .True. + CALL outfld( 'CT_H2O_GHG', ptend%q(:,:,1), PCOLS, LCHNK ) + ENDIF + + !! Debug statements + !! Ozone tendencies + !IF ( rootChunk ) THEN + ! Write(iulog,*) " MMR_Beg = ", MMR_Beg(1,:,iO3) + ! Write(iulog,*) " MMR_End = ", MMR_End(1,:,iO3) + !ENDIF + + IF (PRESENT(fh2o)) THEN + fh2o(:nY) = 0.0e+0_r8 + !DO L = 1, nZ + ! fh2o(:nY) = fh2o(:nY) + ptend%q(:nY,L,iH2O)*state%pdel(:nY,L)/Gravit + !ENDDO + ENDIF + + ! Nullify all pointers + Nullify(PblH ) + Nullify(Fsds ) + Nullify(PRain ) + Nullify(LsFlxSnw) + Nullify(LsFlxPrc) + Nullify(cldTop ) + Nullify(cldFrc ) + Nullify(NEvapr ) + Nullify(cmfdqr ) + + IF ( rootChunk ) WRITE(iulog,*) 'GEOS-Chem Chemistry step ', iStep, ' completed' + IF ( lastChunk ) WRITE(iulog,*) 'Chemistry completed on all chunks of root CPU' + IF ( FIRST ) THEN + FIRST = .false. + ENDIF + + call t_stopf('GEOSChem_All_Tend') + + end subroutine chem_timestep_tend + + !================================================================================================ + ! subroutine chem_init_cnst + !================================================================================================ + subroutine chem_init_cnst(name, latvals, lonvals, mask, q) + + CHARACTER(LEN=*), INTENT(IN) :: name ! constituent name + REAL(r8), INTENT(IN) :: latvals(:) ! lat in degrees (NCOL) + REAL(r8), INTENT(IN) :: lonvals(:) ! lon in degrees (NCOL) + LOGICAL, INTENT(IN) :: mask(:) ! Only initialize where .true. + REAL(r8), INTENT(OUT) :: q(:,:) ! kg tracer/kg dry air (NCOL, PVER) + ! Used to initialize tracer fields if desired. + ! Will need a simple mapping structure as well as the CAM tracer registration + ! routines. + + INTEGER :: ilev, nlev, M + REAL(r8) :: QTemp, Min_MMR + + nlev = SIZE(q, 2) + + ! Retrieve a "background value" for this from the database + Min_MMR = 1.0e-38_r8 + CALL cnst_get_ind(TRIM(name), M, abort=.False.) + IF ( M > 0 ) Min_MMR = ref_MMR(M) + + DO ilev = 1, nlev + WHERE(mask) + ! Set to the minimum mixing ratio + q(:,ilev) = Min_MMR + END WHERE + ENDDO + + end subroutine chem_init_cnst + + !================================================================================================ + ! subroutine chem_final + !================================================================================================ + subroutine chem_final + + ! CAM modules + use short_lived_species, only : short_lived_species_final + + ! GEOS-Chem interface modules in CAM + use geoschem_emissions_mod, only : GC_Emissions_Final + use geoschem_history_mod, only : Destroy_HistoryConfig + + ! GEOS-Chem modules + use Carbon_Mod, only : Cleanup_Carbon + use Drydep_Mod, only : Cleanup_Drydep + use Dust_Mod, only : Cleanup_Dust + use Error_Mod, only : Cleanup_Error + use Fullchem_Mod, only : Cleanup_FullChem + use Input_Opt_Mod, only : Cleanup_Input_Opt + use Linear_Chem_Mod, only : Cleanup_Linear_Chem + use Pressure_Mod, only : Cleanup_Pressure + use Seasalt_Mod, only : Cleanup_Seasalt + use State_Chm_Mod, only : Cleanup_State_Chm + use State_Diag_Mod, only : Cleanup_State_Diag + use State_Grid_Mod, only : Cleanup_State_Grid + use State_Met_Mod, only : Cleanup_State_Met + use Sulfate_Mod, only : Cleanup_Sulfate + + ! Local variables + INTEGER :: I, RC + + ! Destroy the history interface between GC States and CAM exports + CALL Destroy_HistoryConfig(masterproc, HistoryConfig, RC) + + ! Finalize GEOS-Chem + + CALL Cleanup_Carbon + CALL Cleanup_Drydep + CALL Cleanup_Dust + CALL Cleanup_FullChem( RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Cleanup_FullChem"!' + CALL Error_Stop( ErrMsg, ThisLoc ) + ENDIF + + CALL Cleanup_Pressure + CALL Cleanup_Seasalt + CALL Cleanup_Sulfate + CALL Cleanup_Linear_Chem + + CALL GC_Emissions_Final + + CALL short_lived_species_final() + + ! Cleanup Input_Opt + CALL Cleanup_Input_Opt( Input_Opt, RC ) + + ! Loop over each chunk and cleanup the variables + DO I = BEGCHUNK, ENDCHUNK + CALL Cleanup_State_Chm ( State_Chm(I), RC ) + CALL Cleanup_State_Diag( State_Diag(I), RC ) + CALL Cleanup_State_Grid( State_Grid(I), RC ) + CALL Cleanup_State_Met ( State_Met(I), RC ) + ENDDO + CALL Cleanup_Error + + ! Finally deallocate state variables + IF ( ALLOCATED( State_Chm ) ) DEALLOCATE( State_Chm ) + IF ( ALLOCATED( State_Diag ) ) DEALLOCATE( State_Diag ) + IF ( ALLOCATED( State_Grid ) ) DEALLOCATE( State_Grid ) + IF ( ALLOCATED( State_Met ) ) DEALLOCATE( State_Met ) + + IF ( ALLOCATED( slvd_Lst ) ) DEALLOCATE( slvd_Lst ) + + RETURN + + end subroutine chem_final + + !================================================================================================ + ! subroutine chem_init_restart + !================================================================================================ + subroutine chem_init_restart(File) + + ! CAM modules + use pio, only : file_desc_t + use tracer_cnst, only : init_tracer_cnst_restart + use tracer_srcs, only : init_tracer_srcs_restart + + IMPLICIT NONE + + TYPE(file_desc_t) :: File + + WRITE(iulog,'(a)') 'chem_init_restart: init restarts for tracer sources and offline fields' + + ! + ! data for offline tracers + ! + call init_tracer_cnst_restart(File) + call init_tracer_srcs_restart(File) + !call init_linoz_data_restart(File) + + end subroutine chem_init_restart + + !================================================================================================ + ! subroutine chem_write_restart + !================================================================================================ + subroutine chem_write_restart( File ) + + ! CAM modules + use pio, only : file_desc_t + use tracer_cnst, only : write_tracer_cnst_restart + use tracer_srcs, only : write_tracer_srcs_restart + + IMPLICIT NONE + + TYPE(file_desc_t) :: File + + WRITE(iulog,'(a)') 'chem_write_restart: writing restarts for tracer sources and offline fields' + + ! data for offline tracers + call write_tracer_cnst_restart(File) + call write_tracer_srcs_restart(File) + + end subroutine chem_write_restart + + !================================================================================================ + ! subroutine chem_read_restart + !================================================================================================ + subroutine chem_read_restart( File ) + + ! CAM modules + use pio, only : file_desc_t + use tracer_cnst, only : read_tracer_cnst_restart + use tracer_srcs, only : read_tracer_srcs_restart + + IMPLICIT NONE + + TYPE(file_desc_t) :: File + + WRITE(iulog,'(a)') 'GCCALL CHEM_READ_RESTART' + + ! data for offline tracers + call read_tracer_cnst_restart(File) + call read_tracer_srcs_restart(File) + + end subroutine chem_read_restart + + !================================================================================================ + ! subroutine chem_emissions + !================================================================================================ + subroutine chem_emissions( state, cam_in, pbuf ) + + ! CAM modules + use camsrfexch, only : cam_in_t + use physics_buffer, only : physics_buffer_desc + + TYPE(physics_state), INTENT(IN) :: state ! Physics state variables + TYPE(cam_in_t), INTENT(INOUT) :: cam_in ! import state + TYPE(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer in chunk, for HEMCO + + INTEGER :: M, N + INTEGER :: nY + LOGICAL :: rootChunk + + nY = state%NCOL ! number of atmospheric columns on this chunk + rootChunk = ( MasterProc .and. (state%LCHNK .eq. BEGCHUNK) ) + + ! Reset surface fluxes + DO M = iFirstCnst, pcnst + !N = map2chm(M) + !IF ( N > 0 ) cam_in%cflx(1:nY,N) = 0.0e+0_r8 + cam_in%cflx(1:nY,M) = 0.0e+0_r8 + ENDDO + + end subroutine chem_emissions +! +! P R E S C R I B E A E R O S O L D I S T R I B U T I O N +! +! Based on code from Feng et al., 2021 GMD (WRF-GC v2.0), by Xu Feng et al. +! in module_diag_aero_size_info.F, originally based from WRF-Chem. +! +! Reference: +! Feng, X., Lin, H., Fu, T.-M., Sulprizio, M. P., Zhuang, J., Jacob, D. J., Tian, H., Ma, Y., Zhang, L., Wang, X., Chen, Q., and Han, Z.: WRF-GC (v2.0): online two-way coupling of WRF (v3.9.1.1) and GEOS-Chem (v12.7.2) for modeling regional atmospheric chemistry–meteorology interactions, Geosci. Model Dev., 14, 3741–3768, https://doi.org/10.5194/gmd-14-3741-2021, 2021. +! + + real(8) function erfc_num_recipes( x ) + ! + ! from press et al, numerical recipes, 1990, page 164 + ! + implicit none + real(r8) :: x, erfc_dbl, dum, t, z + z = abs(x) + t = 1.0_r8/(1.0_r8 + 0.5_r8*z) + dum = ( -z*z - 1.26551223_r8 + t*(1.00002368_r8 + t*(0.37409196_r8 + & + t*(0.09678418_r8 + t*(-0.18628806_r8 + t*(0.27886807_r8 + & + t*(-1.13520398_r8 + & + t*(1.48851587_r8 + t*(-0.82215223_r8 + t*0.17087277_r8 ))))))))) + erfc_dbl = t * exp(dum) + if (x .lt. 0.0_r8) erfc_dbl = 2.0_r8 - erfc_dbl + erfc_num_recipes = erfc_dbl + return + end function erfc_num_recipes + + ! sect02_mam4 is based off sect02_new in WRF-GC, which is based off + ! sect02 in WRF-Chem chem/module_optical_averaging.F. + ! + ! user specifies a single log-normal mode and a set of section boundaries + ! prog calculates mass and number for each section. + subroutine sect02_mam4(dgnum_um, sigmag, duma, nbin, dlo_sect, dhi_sect, & + xnum_sect, xmas_sect) + ! INPUT PARAMETERS: + ! dgnum_um *diameter* geometric mean of log-normal distribution [um] + ! sigmag geometric standard deviation of log-normal dist. [unitless] + ! duma 1.0 ? + ! nbin # of target bins (wrf-gc = 4, MAM4 = 3) [count] + ! dlo_sect(nbin) low diameter limit (wrf-gc = 0.0390625) [um] + ! dhi_sect(nbin) high diameter limit (wrf-gc = 10.0) [um] + + ! OUTPUT PARAMETERS: + ! xnum_sect(nbin) aerosol number per bin, ratio of total [unitless] + ! xmas_sect(bin) aerosol mass per bin, ratio of total [unitless] + + implicit none + real(8), dimension(nbin), intent(out) :: xnum_sect, xmas_sect + integer :: n, nbin + real(8) :: dgnum, dgnum_um, dhi, & + dlo, duma, dumfrac, & + dx, sigmag, & + sx, sxroot2, thi, tlo, x0, x3, & + xhi, xlo, xmtot, xntot + real(8), intent(in) :: dlo_sect(nbin), dhi_sect(nbin) + real(8) :: my_dlo_sect(nbin), my_dhi_sect(nbin) + real(8) :: pi + parameter (pi = 3.141592653589_r8) + + xmtot = duma + xntot = duma + + ! Compute bins based on number of bins. Originally sect02_new. + ! For MAM4, we prescribe the bin ranges as well. + ! dlo = dlo_um*1.0E-4_r8 + ! dhi = dhi_um*1.0E-4_r8 + ! xlo = log( dlo ) + ! xhi = log( dhi ) + ! dx = (xhi - xlo)/nbin + ! do n = 1, nbin + ! dlo_sect(n) = exp( xlo + dx*(n-1) ) + ! dhi_sect(n) = exp( xlo + dx*n ) + ! end do + + ! dlo_sect and dhi_sect have to be scaled by 1e-4 + ! in order to fit parameters in the above calculation, if they are prescribed. + + my_dlo_sect(:) = dlo_sect(:) * 1.0e-4_r8 + my_dhi_sect(:) = dhi_sect(:) * 1.0e-4_r8 + + dgnum = dgnum_um*1.0E-4_r8 + sx = log( sigmag ) + x0 = log( dgnum ) + x3 = x0 + 3.0_r8*sx*sx + sxroot2 = sx * sqrt( 2.0_r8 ) + do n = 1, nbin + xlo = log( my_dlo_sect(n) ) + xhi = log( my_dhi_sect(n) ) + tlo = (xlo - x0)/sxroot2 + thi = (xhi - x0)/sxroot2 + if (tlo .le. 0.0_r8) then + dumfrac = 0.5_r8*( erfc_num_recipes(-thi) - erfc_num_recipes(-tlo) ) + else + dumfrac = 0.5_r8*( erfc_num_recipes(tlo) - erfc_num_recipes(thi) ) + end if + xnum_sect(n) = xntot*dumfrac + tlo = (xlo - x3)/sxroot2 + thi = (xhi - x3)/sxroot2 + if (tlo .le. 0.0_r8) then + dumfrac = 0.5_r8*( erfc_num_recipes(-thi) - erfc_num_recipes(-tlo) ) + else + dumfrac = 0.5_r8*( erfc_num_recipes(tlo) - erfc_num_recipes(thi) ) + endif + xmas_sect(n) = xmtot*dumfrac + enddo + end subroutine sect02_mam4 +end module chemistry diff --git a/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 b/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 new file mode 100644 index 0000000000..5da738038c --- /dev/null +++ b/src/chemistry/geoschem/geoschem_diagnostics_mod.F90 @@ -0,0 +1,1374 @@ +MODULE GeosChem_Diagnostics_Mod + + ! CAM modules + use cam_history, only : fieldname_len + use cam_logfile, only : iulog + use chem_mods, only : gas_pcnst, map2chm, iFirstCnst + use constituents, only : pcnst + use mo_tracname, only : solsym + use ppgrid, only : begchunk, pver + use shr_const_mod, only : pi => shr_const_pi + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use spmd_utils, only : MasterProc + use string_utils, only : to_upper + + ! GEOS-Chem modules + use ErrCode_Mod, only : GC_SUCCESS + + IMPLICIT NONE + + PRIVATE + + PUBLIC :: GC_Diagnostics_Init + PUBLIC :: GC_Diagnostics_Calc + PUBLIC :: wetdep_name, wtrate_name, dtchem_name + + CHARACTER(LEN=fieldname_len) :: srcnam(gas_pcnst) ! Names of source/sink tendencies + CHARACTER(LEN=fieldname_len) :: wetdep_name(gas_pcnst) ! Wet deposition tendencies + CHARACTER(LEN=fieldname_len) :: wtrate_name(gas_pcnst) ! Column tendencies for wet dep + CHARACTER(LEN=fieldname_len) :: dtchem_name(gas_pcnst) ! Chemical tendencies + + INTEGER :: aer_species(gas_pcnst) + + ! Chemical families + INTEGER :: NOx_species(3) + INTEGER :: NOy_species(62) + INTEGER :: HOx_species(4) + INTEGER :: ClOx_species(6) + INTEGER :: ClOy_species(11) + INTEGER :: tCly_species(30) + INTEGER :: BrOx_species(4) + INTEGER :: BrOy_species(9) + INTEGER :: tBry_species(18) + INTEGER :: SOx_species(2) + INTEGER :: NHx_species(2) + INTEGER :: TOTH_species(3) + REAL(r8) :: NOx_MWs(3) + REAL(r8) :: NOy_MWs(62) + REAL(r8) :: HOx_MWs(4) + REAL(r8) :: ClOx_MWs(6) + REAL(r8) :: ClOy_MWs(11) + REAL(r8) :: tCly_MWs(30) + REAL(r8) :: BrOx_MWs(4) + REAL(r8) :: BrOy_MWs(9) + REAL(r8) :: tBry_MWs(18) + REAL(r8) :: SOx_MWs(2) + REAL(r8) :: NHx_MWs(2) + REAL(r8) :: TOTH_MWs(3) + + REAL(r8), PARAMETER :: MW_NIT = 62.01_r8 + REAL(r8), PARAMETER :: MW_HNO3 = 63.01_r8 + REAL(r8), PARAMETER :: MW_HCl = 36.45_r8 + REAL(r8), PARAMETER :: MW_H2O = 18.02_r8 + + ! NOx species + INTEGER :: i_NO, i_NO2, i_N + ! NOy \ NOx species + INTEGER :: i_BrNO2, i_BrNO3, i_ClNO2, i_ClNO3, i_ETHLN, i_ETNO3, & + i_HNO2, i_HNO3, i_HNO4, i_ICN, i_ICNOO, i_IDHNBOO, & + i_IDHNDOO1, i_IDN, i_IDNOO, i_IHN1, i_IHN2, & + i_IHN3, i_IHN4, i_IHPNBOO, i_IHPNDOO, i_INA, i_INO, & + i_INO2B, i_INO2D, i_INPB, i_INPD, i_IONO, i_IONO2, & + i_IPRNO3, i_ISOPNOO1, i_ISOPNOO2, i_ITCN, i_ITHN, & + i_MACRNO2, i_MCRHN, i_MCRHNB, i_MENO3, i_MONITS, i_MONITU, & + i_MPAN, i_MPN, i_MVKN, i_N2O5, i_NO3, i_NPRNO3, i_OLND, & + i_OLNN, i_PAN, i_PPN, i_PRN1, i_PROPNN, i_PRPN, i_R4N1, & + i_R4N2, i_HONIT, i_IONITA, i_NIT, i_NITs + ! HOx + INTEGER :: i_H, i_OH, i_HO2, i_H2O2 + ! ClOx + INTEGER :: i_Cl, i_ClO, i_HOCl, i_Cl2, i_Cl2O2, i_OClO + ! tCly \ ClOx + INTEGER :: i_ClOO, i_HCl, i_BrCl, i_ICl, i_H1211, & + i_CFC115, i_CH3Cl, i_HCFC142b, i_HCFC22, i_CH2ICl, & + i_CFC114, i_CFC12, i_HCFC141b, i_HCFC123, i_CH2Cl2, & + i_CFC11, i_CH3CCl3, i_CHCl3, i_CCl4, i_CFC113, i_SALACL, & + i_SALCCL !ClNO2, ClNO3 already defined in NOy_species + ! BrOx + INTEGER :: i_Br, i_BrO, i_HOBr !BrCl already defined in tCly_species + ! Bry \ BrOx + INTEGER :: i_HBr, i_IBr, i_Br2, i_CH3Br, & + i_H1301, i_H2402, i_CH2Br2, i_CHBr3, i_BrSALA, i_BrSALC, & + i_CH2IBr + !BrNO2, BrNO3 already defined in NOy_speies + !H1211 already defined in tCly_species + ! SOx + INTEGER :: i_SO2, i_SO4 + ! NHx + INTEGER :: i_NH3, i_NH4 + ! TOTH + INTEGER :: i_CH4, i_H2O, i_H2 + + + ! Index in solsym + integer :: id_no,id_no3 + integer :: id_cfc11,id_cfc12 + integer :: id_ch4,id_h2o + integer :: id_o,id_o2,id_h,id_n2o + integer :: id_co2,id_o3,id_oh,id_ho2,id_so4_a1,id_so4_a2,id_so4_a3 + integer :: id_num_a2,id_num_a3,id_dst_a3,id_ncl_a3 + +! !REVISION HISTORY: +! 28 Oct 2020 - T. M. Fritz - Initial version + +CONTAINS + + SUBROUTINE GC_Diagnostics_Init( Input_Opt, State_Chm, State_Met ) + + ! CAM modules + use cam_history, only : addfld, add_default, horiz_only + use constituents, only : cnst_name, sflxnam, cnst_get_ind + use mo_chem_utls, only : get_spc_ndx + use phys_control, only : phys_getopts + + ! GEOS-Chem modules + use Input_Opt_Mod, only : OptInput + use State_Chm_Mod, only : ChmState + use State_Met_Mod, only : MetState + use State_Diag_Mod, only : get_TagInfo + use Species_Mod, only : Species + use Registry_Mod, only : MetaRegItem, RegItem + use State_Chm_Mod, only : Ind_ + use DryDep_Mod, only : depName + + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input options + TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object + TYPE(MetState), INTENT(IN) :: State_Met ! Meteorology State object + + INTEGER :: M, N, K, SM + INTEGER :: idx + INTEGER :: RC + INTEGER :: bulkaero_species(20) + INTEGER :: id_so4, id_nh4no3 + INTEGER :: id_dst01, id_dst02, id_dst03, id_dst04 + INTEGER :: id_sslt01, id_sslt02, id_sslt03, id_sslt04 + INTEGER :: id_soa, id_oc1, id_oc2, id_cb1, id_cb2 + INTEGER :: id_soam,id_soai,id_soat,id_soab,id_soax + INTEGER :: id_bry, id_cly + INTEGER :: history_budget_histfile_num ! output history file number + ! for budget fields + + LOGICAL :: Found + LOGICAL :: history_aerosol ! Output the MAM aerosol + ! tendencies + LOGICAL :: history_chemistry + LOGICAL :: history_cesm_forcing + LOGICAL :: history_scwaccm_forcing + LOGICAL :: history_chemspecies_srf ! Output the chemistry + ! constituents species + ! in the surface layer + LOGICAL :: history_dust + LOGICAL :: history_budget ! output tendencies and state + ! variables for CAM + ! temperature, water vapor, + ! cloud ice and cloud + ! liquid budgets. + + CHARACTER(LEN=shr_kind_cl) :: SpcName + CHARACTER(LEN=shr_kind_cl) :: tagName + CHARACTER(LEN=shr_kind_cl) :: ThisLoc + CHARACTER(LEN=shr_kind_cl) :: ErrMsg + CHARACTER(LEN=2) :: unit_basename ! Units 'kg' or '1' + + ! Objects + TYPE(Species), POINTER :: SpcInfo + TYPE(MetaRegItem), POINTER :: Current + TYPE(RegItem ), POINTER :: Item + + !================================================================= + ! GC_Diagnostics_Init begins here! + !================================================================= + + ! Initialize pointers + SpcInfo => NULL() + Current => NULL() + Item => NULL() + + ! Assume a successful return until otherwise + RC = GC_SUCCESS + + CALL phys_getopts( history_aerosol_out = history_aerosol, & + history_chemistry_out = history_chemistry, & + history_chemspecies_srf_out = history_chemspecies_srf, & + history_budget_out = history_budget , & + history_budget_histfile_num_out = history_budget_histfile_num, & + history_cesm_forcing_out = history_cesm_forcing, & + history_scwaccm_forcing_out = history_scwaccm_forcing, & + history_dust_out = history_dust ) + + id_no3 = get_spc_ndx( 'NO3', ignore_case=.true. ) + id_o3 = get_spc_ndx( 'O3', ignore_case=.true. ) + id_oh = get_spc_ndx( 'OH', ignore_case=.true. ) + id_ho2 = get_spc_ndx( 'HO2', ignore_case=.true. ) + id_so4_a1 = get_spc_ndx( 'so4_a1', ignore_case=.true. ) + id_so4_a2 = get_spc_ndx( 'so4_a2', ignore_case=.true. ) + id_so4_a3 = get_spc_ndx( 'so4_a3', ignore_case=.true. ) + id_num_a2 = get_spc_ndx( 'num_a2', ignore_case=.true. ) + id_num_a3 = get_spc_ndx( 'num_a3', ignore_case=.true. ) + id_dst_a3 = get_spc_ndx( 'dst_a3', ignore_case=.true. ) + id_ncl_a3 = get_spc_ndx( 'ncl_a3', ignore_case=.true. ) + id_co2 = get_spc_ndx( 'CO2', ignore_case=.true. ) + id_no = get_spc_ndx( 'NO', ignore_case=.true. ) + id_h = get_spc_ndx( 'H', ignore_case=.true. ) + id_o = get_spc_ndx( 'O', ignore_case=.true. ) + id_o2 = get_spc_ndx( 'O2', ignore_case=.true. ) + id_ch4 = get_spc_ndx( 'CH4', ignore_case=.true. ) + id_h2o = get_spc_ndx( 'H2O', ignore_case=.true. ) + id_n2o = get_spc_ndx( 'N2O', ignore_case=.true. ) + id_cfc11 = get_spc_ndx( 'CFC11', ignore_case=.true. ) + id_cfc12 = get_spc_ndx( 'CFC12', ignore_case=.true. ) + + id_bry = get_spc_ndx( 'BRY', ignore_case=.true. ) + id_cly = get_spc_ndx( 'CLY', ignore_case=.true. ) + + id_dst01 = get_spc_ndx( 'DST01', ignore_case=.true. ) + id_dst02 = get_spc_ndx( 'DST02', ignore_case=.true. ) + id_dst03 = get_spc_ndx( 'DST03', ignore_case=.true. ) + id_dst04 = get_spc_ndx( 'DST04', ignore_case=.true. ) + id_sslt01 = get_spc_ndx( 'SSLT01', ignore_case=.true. ) + id_sslt02 = get_spc_ndx( 'SSLT02', ignore_case=.true. ) + id_sslt03 = get_spc_ndx( 'SSLT03', ignore_case=.true. ) + id_sslt04 = get_spc_ndx( 'SSLT04', ignore_case=.true. ) + id_soa = get_spc_ndx( 'SOA', ignore_case=.true. ) + !id_so4 = get_spc_ndx( 'SO4', ignore_case=.true. )i + id_so4 = -1 ! Don't pick up GEOS-Chem's SO4! + id_oc1 = get_spc_ndx( 'OC1', ignore_case=.true. ) + id_oc2 = get_spc_ndx( 'OC2', ignore_case=.true. ) + id_cb1 = get_spc_ndx( 'CB1', ignore_case=.true. ) + id_cb2 = get_spc_ndx( 'CB2', ignore_case=.true. ) + id_nh4no3 = get_spc_ndx( 'NH4NO3', ignore_case=.true. ) + id_soam = get_spc_ndx( 'SOAM', ignore_case=.true. ) + id_soai = get_spc_ndx( 'SOAI', ignore_case=.true. ) + id_soat = get_spc_ndx( 'SOAT', ignore_case=.true. ) + id_soab = get_spc_ndx( 'SOAB', ignore_case=.true. ) + id_soax = get_spc_ndx( 'SOAX', ignore_case=.true. ) + + bulkaero_species(:) = -1 + bulkaero_species(1:20) = (/ id_dst01, id_dst02, id_dst03, id_dst04, & + id_sslt01, id_sslt02, id_sslt03, id_sslt04, & + id_soa, id_so4, id_oc1, id_oc2, id_cb1, id_cb2, id_nh4no3, & + id_soam,id_soai,id_soat,id_soab,id_soax /) + aer_species(:) = -1 + n = 1 + do m = 1,gas_pcnst + k=0 + if ( any(bulkaero_species(:)==m) ) k=1 + if ( k==0 ) k = index(trim(solsym(m)), '_a') + if ( k==0 ) k = index(trim(solsym(m)), '_c') + if ( k>0 ) then ! must be aerosol species + aer_species(n) = m + n = n+1 + endif + enddo + + CALL Addfld( 'MASS', (/ 'lev' /), 'A', 'kg', 'Mass of grid box' ) + CALL Addfld( 'AREA', horiz_only, 'A', 'm2', 'Area of grid box' ) + CALL Addfld( 'HEIGHT', (/ 'ilev' /),'A','m', 'Geopotential height above surface at interfaces' ) + + ! Note that constituents are already output by default + ! Add all species as output fields if desired + DO N = 1, gas_pcnst + IF ( ANY( aer_species == N ) ) THEN + SpcName = TRIM(solsym(N)) + unit_basename = 'kg' + IF ( SpcName(1:3) == 'num' ) unit_basename = ' 1' + CALL AddFld( TRIM(SpcName), (/ 'lev' /), 'A', unit_basename//'/kg', & + TRIM(SpcName)//' concentration' ) + CALL AddFld( TRIM(SpcName)//'_SRF', horiz_only, 'A', unit_basename//'/kg', & + TRIM(SpcName)//' in bottom layer' ) + ELSE + M = map2chm(N) + SpcName = TRIM(solsym(N)) + CALL AddFld( TRIM(SpcName), (/ 'lev' /), 'A', 'mol/mol', & + TRIM(SpcName)//' volume mixing ratio') + CALL AddFld( TRIM(SpcName)//'_SRF', horiz_only, 'A', 'mol/mol', & + TRIM(SpcName)//' in bottom layer') + ENDIF + IF ( ( N /= id_cly ) .AND. ( N /= id_bry ) ) THEN + IF ( history_aerosol .OR. history_chemistry ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF + IF ( history_chemspecies_srf ) THEN + CALL Add_Default( TRIM(SpcName)//'_SRF', 1, ' ' ) + ENDIF + ENDIF + + IF ( history_cesm_forcing ) THEN + IF ( N == id_o3 ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_oh ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_no3 ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_ho2 ) CALL Add_Default( TRIM(SpcName), 1, ' ') + + IF ( N == id_o3 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_so4_a1 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_so4_a2 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_so4_a3 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + + IF ( N == id_num_a2 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_num_a3 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_dst_a3 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_ncl_a3 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + + ENDIF + IF ( history_scwaccm_forcing ) THEN + IF ( N == id_co2 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_h ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_no ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_o ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_o2 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_o3 ) CALL Add_Default( TRIM(SpcName), 8, ' ') + IF ( N == id_h2o ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_ch4 ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_n2o ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_cfc11 ) CALL Add_Default( TRIM(SpcName), 1, ' ') + IF ( N == id_cfc12 ) CALL Add_Default( TRIM(SpcName), 1, ' ') + ENDIF + + IF (history_dust .AND. (index(TRIM(SpcName),'dst_') > 0)) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ') + ENDIF + ENDDO + + IF ( Input_Opt%LDryD ) THEN + DO N = 1, State_Chm%nDryDep + SpcName = 'DV_'//to_upper(TRIM(depName(N))) + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'm/s', & + TRIM(SpcName)//' dry deposition velocity') + ENDDO + + DO N = 1, State_Chm%nAdvect + ! Get the species ID from the advected species ID + M = State_Chm%Map_Advect(N) + + ! Get info about this species from the species database + SpcInfo => State_Chm%SpcData(M)%Info + SpcName = 'DF_'//to_upper(TRIM(SpcInfo%Name)) + CALL AddFld( TRIM(SpcName), horiz_only, 'A', 'kg/m2/s', & + TRIM(SpcName)//' dry deposition flux') + IF ( history_chemistry ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF + + ! Free pointer + SpcInfo => NULL() + ENDDO + ENDIF + + ! Chemical tendencies and surface fluxes + DO N = 1, gas_pcnst + IF ( map2chm(N) > 0 ) THEN + ! If this is a GEOS-Chem species then capitalize. This avoids + ! issues where Br2 /= BR2 + srcnam(N) = 'CT_'//to_upper(TRIM(solsym(N))) ! chem tendency (source/sink) + ELSE + ! For MAM aerosols, keep as it is (i.e. bc_a1) + srcnam(N) = 'CT_'//TRIM(solsym(N)) ! chem tendency (source/sink) + ENDIF + SpcName = srcnam(N) + CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', 'kg/kg/s', TRIM(SpcName)//' source/sink' ) + + SpcName = TRIM(solsym(N)) + CALL cnst_get_ind( SpcName, M, abort=.false. ) + IF ( M > 0 ) THEN + IF (sflxnam(M)(3:5) == 'num') THEN ! name is in the form of "SF****" + unit_basename = ' 1' + ELSE + unit_basename = 'kg' + ENDIF + SpcName = sflxnam(M) + CALL Addfld ( TRIM(SpcName), horiz_only, 'A', unit_basename//'/m2/s', & + TRIM(solsym(N))//' surface flux') + IF ( history_aerosol .OR. history_chemistry ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF + + IF ( history_cesm_forcing ) THEN + IF ( TRIM(SpcName(3:)) == 'NO' .OR. TRIM(SpcName(3:)) == 'NH3' ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF + ENDIF + ENDIF + ENDDO + + ! Add chemical tendency of water vapor to water budget output + IF ( history_budget ) THEN + CALL Add_Default ('CT_H2O' , history_budget_histfile_num, ' ') + ENDIF + + ! Chemical tendencies + DO N = 1, gas_pcnst + M = map2chm(N) + IF ( M > 0 ) THEN + dtchem_name(N) = 'D'//to_upper(TRIM(solsym(N)))//'CHM' + ELSE + dtchem_name(N) = 'D'//TRIM(solsym(N))//'CHM' + ENDIF + SpcName = TRIM(dtchem_name(N)) + CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', 'kg/s', & + 'net tendency from chemistry' ) + ENDDO + + i_NO = Ind_('NO') + i_NO2 = Ind_('NO2') + i_N = Ind_('N') + i_BrNO2 = Ind_('BrNO2') + i_BrNO3 = Ind_('BrNO3') + i_ClNO2 = Ind_('ClNO2') + i_ClNO3 = Ind_('ClNO3') + i_ETHLN = Ind_('ETHLN') + i_ETNO3 = Ind_('ETNO3') + i_HNO2 = Ind_('HNO2') + i_HNO3 = Ind_('HNO3') + i_HNO4 = Ind_('HNO4') + i_ICN = Ind_('ICN') + i_ICNOO = Ind_('ICNOO') + i_IDHNBOO = Ind_('IDHNBOO') + i_IDHNDOO1 = Ind_('IDHNDOO1') + i_IDN = Ind_('IDN') + i_IDNOO = Ind_('IDNOO') + i_IHN1 = Ind_('IHN1') + i_IHN2 = Ind_('IHN2') + i_IHN3 = Ind_('IHN3') + i_IHN4 = Ind_('IHN4') + i_IHPNBOO = Ind_('IHPNBOO') + i_IHPNDOO = Ind_('IHPNDOO') + i_INA = Ind_('INA') + i_INO = Ind_('INO') + i_INO2B = Ind_('INO2B') + i_INO2D = Ind_('INO2D') + i_INPB = Ind_('INPB') + i_INPD = Ind_('INPD') + i_IONO = Ind_('IONO') + i_IONO2 = Ind_('IONO2') + i_IPRNO3 = Ind_('IPRNO3') + i_ISOPNOO1 = Ind_('ISOPNOO1') + i_ISOPNOO2 = Ind_('ISOPNOO2') + i_ITCN = Ind_('ITCN') + i_ITHN = Ind_('ITHN') + i_MACRNO2 = Ind_('MACRNO2') + i_MCRHN = Ind_('MCRHN') + i_MCRHNB = Ind_('MCRHNB') + i_MENO3 = Ind_('MENO3') + i_MONITS = Ind_('MONITS') + i_MONITU = Ind_('MONITU') + i_MPAN = Ind_('MPAN') + i_MPN = Ind_('MPN') + i_MVKN = Ind_('MVKN') + i_N2O5 = Ind_('N2O5') + i_NO3 = Ind_('NO3') + i_NPRNO3 = Ind_('NPRNO3') + i_OLND = Ind_('OLND') + i_OLNN = Ind_('OLNN') + i_PAN = Ind_('PAN') + i_PPN = Ind_('PPN') + i_PRN1 = Ind_('PRN1') + i_PROPNN = Ind_('PROPNN') + i_PRPN = Ind_('PRPN') + i_R4N1 = Ind_('R4N1') + i_R4N2 = Ind_('R4N2') + i_HONIT = Ind_('HONIT') + i_IONITA = Ind_('IONITA') + i_NIT = Ind_('NIT') + i_NITs = Ind_('NITs') + i_H = Ind_('H') + i_OH = Ind_('OH') + i_HO2 = Ind_('HO2') + i_H2O2 = Ind_('H2O2') + i_Cl = Ind_('Cl') + i_ClO = Ind_('ClO') + i_HOCl = Ind_('HOCl') + i_Cl2 = Ind_('Cl2') + i_Cl2O2 = Ind_('Cl2O2') + i_OClO = Ind_('OClO') + i_ClOO = Ind_('ClOO') + i_HCl = Ind_('HCl') + i_ClNO2 = Ind_('ClNO2') + i_ClNO3 = Ind_('ClNO3') + i_BrCl = Ind_('BrCl') + i_ICl = Ind_('ICl') + i_H1211 = Ind_('H1211') + i_CFC115 = Ind_('CFC115') + i_CH3Cl = Ind_('CH3Cl') + i_HCFC142b = Ind_('HCFC142b') + i_HCFC22 = Ind_('HCFC22') + i_CH2ICl = Ind_('CH2ICl') + i_CFC114 = Ind_('CFC114') + i_CFC12 = Ind_('CFC12') + i_HCFC141b = Ind_('HCFC141b') + i_HCFC123 = Ind_('HCFC123') + i_CH2Cl2 = Ind_('CH2Cl2') + i_CFC11 = Ind_('CFC11') + i_CH3CCl3 = Ind_('CH3CCl3') + i_CHCl3 = Ind_('CHCl3') + i_CCl4 = Ind_('CCl4') + i_CFC113 = Ind_('CFC113') + i_SALACL = Ind_('SALACL') + i_SALCCL = Ind_('SALCCL') + i_Br = Ind_('Br') + i_BrO = Ind_('BrO') + i_BrCl = Ind_('BrCl') + i_HOBr = Ind_('HOBr') + i_HBr = Ind_('HBr') + i_BrNO2 = Ind_('BrNO2') + i_BrNO3 = Ind_('BrNO3') + i_IBr = Ind_('IBr') + i_Br2 = Ind_('Br2') + i_CH3Br = Ind_('CH3Br') + i_H1211 = Ind_('H1211') + i_H1301 = Ind_('H1301') + i_H2402 = Ind_('H2402') + i_CH2Br2 = Ind_('CH2Br2') + i_CHBr3 = Ind_('CHBr3') + i_BrSALA = Ind_('BrSALA') + i_BrSALC = Ind_('BrSALC') + i_CH2IBr = Ind_('CH2IBr') + i_SO2 = Ind_('SO2') + i_SO4 = Ind_('SO4') + i_NH3 = Ind_('NH3') + i_NH4 = Ind_('NH4') + i_CH4 = Ind_('CH4') + i_H2O = Ind_('H2O') + i_H2 = Ind_('H2') + + NOx_species = (/ i_N, i_NO, i_NO2 /) + NOy_species = (/ i_N, i_NO, i_NO2, i_BrNO2, i_BrNO3, i_ClNO2, i_ClNO3,& + i_ETHLN, i_ETNO3, i_HNO2, i_HNO3, i_HNO4, i_ICN, & + i_ICNOO, i_IDHNBOO, i_IDHNDOO1, i_IDN, & + i_IDNOO, i_IHN1, i_IHN2, i_IHN3, i_IHN4, i_IHPNBOO, & + i_IHPNDOO, i_INA, i_INO, i_INO2B, i_INO2D, i_INPB, & + i_INPD, i_IONO, i_IONO2, i_IPRNO3, i_ISOPNOO1, & + i_ISOPNOO2, i_ITCN, i_ITHN, i_MACRNO2, i_MCRHN, & + i_MCRHNB, i_MENO3, i_MONITS, i_MONITU, i_MPAN, i_MPN,& + i_MVKN, i_N2O5, i_NO3, i_NPRNO3, i_OLND, i_OLNN, & + i_PAN, i_PPN, i_PRN1, i_PROPNN, i_PRPN, i_R4N1, & + i_R4N2, i_HONIT, i_IONITA, i_NIT, i_NITs /) + HOx_species = (/ i_H, i_OH, i_HO2, i_H2O2 /) + ClOx_species = (/ i_Cl, i_ClO, i_HOCl, i_Cl2, i_Cl2O2, i_OClO /) + ClOy_species = (/ i_Cl, i_ClO, i_HOCl, i_Cl2, i_Cl2O2, i_OClO, & + i_HCl, i_ClNO3, i_BrCl, i_ICl, i_ClNO2 /) + tCly_species = (/ i_Cl, i_ClO, i_HOCl, i_Cl2, i_Cl2O2, i_OClO, i_ClOO, & + i_HCl, i_ClNO2, i_ClNO3, i_BrCl, i_ICl, i_H1211, & + i_CFC115, i_CH3Cl, i_HCFC142b, i_HCFC22, i_CH2ICl, & + i_CFC114, i_CFC12, i_HCFC141b, i_HCFC123, i_CH2Cl2, & + i_CFC11, i_CH3CCl3, i_CHCl3, i_CCl4, i_CFC113, & + i_SALACL, i_SALCCL /) + BrOx_species = (/ i_Br, i_BrO, i_BrCl, i_HOBr /) + BrOy_species = (/ i_Br, i_BrO, i_BrCl, i_HOBr, i_HBr, i_BrNO2, & + i_BrNO3, i_IBr, i_Br2 /) + tBry_species = (/ i_Br, i_BrO, i_BrCl, i_HOBr, i_HBr, i_BrNO2, & + i_BrNO3, i_IBr, i_Br2, i_CH3Br, i_H1211, i_H1301, & + i_H2402, i_CH2Br2, i_CHBr3, i_BrSALA, i_BrSALC, & + i_CH2IBr /) + SOx_species = (/ i_SO2, i_SO4 /) + NHx_species = (/ i_NH3, i_NH4 /) + TOTH_species = (/ i_CH4, i_H2O, i_H2 /) + + DO N = 1, SIZE(NOx_species) + idx = NOx_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + NOx_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + NOx_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(NOy_species) + idx = NOy_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + NOy_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + NOy_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(HOx_species) + idx = HOx_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + HOx_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + HOx_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(ClOx_species) + idx = ClOx_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + ClOx_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + ClOx_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(ClOy_species) + idx = ClOy_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + ClOy_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + ClOy_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(tCly_species) + idx = tCly_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + tCly_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + tCly_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(BrOx_species) + idx = BrOx_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + BrOx_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + BrOx_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(BrOy_species) + idx = BrOy_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + BrOy_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + BrOy_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(tBry_species) + idx = tBry_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + tBry_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + tBry_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(SOx_species) + idx = SOx_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + SOx_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + SOx_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(NHx_species) + idx = NHx_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + NHx_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + NHx_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + DO N = 1, SIZE(TOTH_species) + idx = TOTH_species(N) + IF ( idx > 0 ) THEN + SpcInfo => State_Chm%SpcData(idx)%Info + TOTH_MWs(N) = REAL(SpcInfo%MW_g,r8) + SpcInfo => NULL() + ELSE + TOTH_MWs(N) = -1.0e+00_r8 + ENDIF + ENDDO + + IF ( ANY(NOx_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "NOx indices: ", NOx_species + ENDIF + IF ( ANY(NOy_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "NOy indices: ", NOy_species + ENDIF + IF ( ANY(HOx_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "HOx indices: ", HOx_species + ENDIF + IF ( ANY(ClOx_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "ClOx indices: ", ClOx_species + ENDIF + IF ( ANY(ClOy_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "ClOy indices: ", ClOy_species + ENDIF + IF ( ANY(tCly_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "tCly indices: ", tCly_species + ENDIF + IF ( ANY(BrOx_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "BrOx indices: ", BrOx_species + ENDIF + IF ( ANY(BrOy_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "BrOy indices: ", BrOy_species + ENDIF + IF ( ANY(tBry_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "tBry indices: ", tBry_species + ENDIF + IF ( ANY(SOx_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "SOx indices: ", SOx_species + ENDIF + IF ( ANY(NHx_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "NHx indices: ", NHx_species + ENDIF + IF ( ANY(TOTH_species <= 0 ) ) THEN + IF ( MasterProc ) Write(iulog,*) "TOTH indices: ", TOTH_species + ENDIF + + CALL Addfld( 'NOX', (/ 'lev' /), 'A', 'mol/mol', & + 'NOx molar mixing ratio' ) + CALL Addfld( 'NOY', (/ 'lev' /), 'A', 'mol/mol', & + 'NOy molar mixing ratio' ) + CALL Addfld( 'NOY_mmr', (/ 'lev' /), 'A', 'kg/kg', & + 'NOy mass mixing ratio' ) + CALL Addfld( 'NOY_SRF', horiz_only, 'A', 'mol/mol', & + 'Surface NOy molar mixing ratio' ) + CALL Addfld( 'HOX', (/ 'lev' /), 'A', 'mol/mol', & + 'HOx molar mixing ratio' ) + CALL Addfld( 'CLOX', (/ 'lev' /), 'A', 'mol/mol', & + 'ClOx molar mixing ratio' ) + CALL Addfld( 'CLOY', (/ 'lev' /), 'A', 'mol/mol', & + 'Total inorganic chlorine (ClOy) molar mixing ratio' ) + CALL Addfld( 'TCLY', (/ 'lev' /), 'A', 'mol/mol', & + 'Total Cl molar mixing ratio' ) + CALL Addfld( 'BROX', (/ 'lev' /), 'A', 'mol/mol', & + 'BrOx molar mixing ratio' ) + CALL Addfld( 'BROY', (/ 'lev' /), 'A', 'mol/mol', & + 'Total inorganic bromine (BrOy) molar mixing ratio' ) + CALL Addfld( 'TBRY', (/ 'lev' /), 'A', 'mol/mol', & + 'Total Br molar mixing ratio' ) + CALL Addfld( 'SOX', (/ 'lev' /), 'A', 'mol/mol', & + 'SOx molar mixing ratio' ) + CALL Addfld( 'SOX_mmr', (/ 'lev' /), 'A', 'kg/kg', & + 'SOx mass mixing ratio' ) + CALL Addfld( 'NHX', (/ 'lev' /), 'A', 'mol/mol', & + 'NHx molar mixing ratio' ) + CALL Addfld( 'NHX_mmr', (/ 'lev' /), 'A', 'kg/kg', & + 'NHx mass mixing ratio' ) + CALL Addfld( 'TOTH', (/ 'lev' /), 'A', 'mol/mol', & + 'Total H2 molar mixing ratio' ) + + CALL Addfld( 'SAD_STRAT', (/ 'lev' /), 'I', 'cm2/cm3', 'Stratospheric aerosol SAD' ) + CALL Addfld( 'SAD_SULFC', (/ 'lev' /), 'I', 'cm2/cm3', 'Chemical sulfate aerosol SAD' ) + CALL Addfld( 'SAD_PSC', (/ 'lev' /), 'I', 'cm2/cm3', 'PSC aerosol SAD' ) + CALL Addfld( 'RAD_SULFC', (/ 'lev' /), 'I', 'cm', 'Chemical sulfate radius' ) + CALL Addfld( 'RAD_PSC', (/ 'lev' /), 'I', 'cm', 'PSC aerosol radius' ) + CALL Addfld( 'SAD_TROP', (/ 'lev' /), 'I', 'cm2/cm3', 'Tropospheric aerosol SAD' ) + CALL Addfld( 'SAD_AERO', (/ 'lev' /), 'I', 'cm2/cm3', 'Aerosol surface area density' ) + IF ( history_cesm_forcing ) THEN + CALL Add_Default( 'SAD_AERO', 8, ' ' ) + ENDIF + CALL Addfld( 'REFF_AERO', (/ 'lev' /), 'I', 'cm', 'Aerosol effective radius') + CALL Addfld( 'SULF_TROP', (/ 'lev' /), 'I', 'cm2/cm3', 'Tropospheric sulfate area density') + + CALL Addfld( 'HNO3_TOTAL', (/ 'lev' /), 'I', 'mol/mol', 'Total HNO3' ) + CALL Addfld( 'HNO3_STS', (/ 'lev' /), 'I', 'mol/mol', 'STS condensed HNO3' ) + CALL Addfld( 'HNO3_NAT', (/ 'lev' /), 'I', 'mol/mol', 'NAT condensed HNO3' ) + CALL Addfld( 'HNO3_GAS', (/ 'lev' /), 'I', 'mol/mol', 'Gas phase HNO3' ) + CALL Addfld( 'H2O_GAS', (/ 'lev' /), 'I', 'mol/mol', 'Gas phase H2O' ) + CALL Addfld( 'HCL_TOTAL', (/ 'lev' /), 'I', 'mol/mol', 'Total HCl' ) + CALL Addfld( 'HCL_GAS', (/ 'lev' /), 'I', 'mol/mol', 'Gas phase HCl' ) + CALL Addfld( 'HCL_STS', (/ 'lev' /), 'I', 'mol/mol', 'STS condensend HCl' ) + + CALL Addfld( 'SZA', horiz_only, 'I', 'degrees', 'Solar Zenith Angle' ) + CALL Addfld( 'U_SRF', horiz_only, 'I', 'm/s', 'Horizontal wind velocity' ) + CALL Addfld( 'V_SRF', horiz_only, 'I', 'm/s', 'Vertical wind velocity' ) + CALL Addfld( 'Q_SRF', horiz_only, 'I', 'kg/kg', 'Specific humidity' ) + + CALL Addfld( 'CT_H2O_GHG', (/ 'lev' /), 'A','kg/kg/s', 'ghg-chem h2o source/sink' ) + + + ! Cleanup + Current => NULL() + Item => NULL() + + END SUBROUTINE GC_Diagnostics_Init + + SUBROUTINE GC_Diagnostics_Calc( Input_Opt, State_Chm, State_Diag, & + State_Grid, State_Met, cam_in, state, & + mmr_tend, LCHNK ) + + ! CAM modules + use cam_history, only : outfld, hist_fld_active + use camsrfexch, only : cam_in_t + use chem_mods, only : adv_mass + use constituents, only : cnst_name, sflxnam + use physconst, only : MWDry + use physics_types, only : physics_state + use spmd_utils, only : MasterProc + + ! GEOS-Chem modules + use CMN_Size_Mod, only : NDUST + use DryDep_Mod, only : depName, Ndvzind + use Input_Opt_Mod, only : OptInput + use Precision_Mod, only : f8 + use Species_Mod, only : Species + use State_Chm_Mod, only : ChmState + use State_Diag_Mod, only : DgnState, get_TagInfo + use State_Grid_Mod, only : GrdState + use State_Met_Mod, only : MetState + use Registry_Mod, only : MetaRegItem, RegItem, Registry_Lookup + use UCX_Mod, only : GET_STRAT_OPT + + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input options + TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State object + TYPE(DgnState), INTENT(IN) :: State_Diag ! Diag State object + TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object + TYPE(MetState), INTENT(IN) :: State_Met ! Meteorology State object + TYPE(cam_in_t), INTENT(IN) :: cam_in ! import state + TYPE(physics_state), INTENT(IN) :: state ! Physics state variables + REAL(r8), INTENT(IN) :: mmr_tend(state%ncol,pver,gas_pcnst) + ! Net tendency from chemistry in kg/s + INTEGER, INTENT(IN) :: LCHNK ! Chunk number + + ! Integers + INTEGER :: I, J, L, M, N, ND, SM + INTEGER :: idx + INTEGER :: RC + INTEGER :: Rank ! Size of data + + INTEGER :: nY, nZ + + ! Logicals + LOGICAL :: Found + LOGICAL :: rootChunk + LOGICAL :: OnLevelEdges ! Is the data defined + ! on level edges (T/F) + + ! Strings + CHARACTER(LEN=shr_kind_cl) :: ThisLoc + CHARACTER(LEN=shr_kind_cl) :: ErrMsg + CHARACTER(LEN=shr_kind_cl) :: SpcName + CHARACTER(LEN=shr_kind_cl) :: tagName + + ! Real + REAL(r8) :: wgt + REAL(r8) :: MW + REAL(r8) :: RAER, REFF, SADSTRAT, XSASTRAT + + ! Arrays + REAL(r8) :: outTmp(State_Grid%nY,State_Grid%nZ) + REAL(r8) :: radTmp(State_Grid%nY,State_Grid%nZ) + + ! Floating-point data pointers (8-byte precision) + REAL(f8), POINTER :: Ptr0d_8 ! 0D 8-byte data + REAL(f8), POINTER :: Ptr1d_8(: ) ! 1D 8-byte data + REAL(f8), POINTER :: Ptr2d_8(:,: ) ! 2D 8-byte data + REAL(f8), POINTER :: Ptr3d_8(:,:,:) ! 3D 8-byte data + + ! Objects + TYPE(Species), POINTER :: SpcInfo + TYPE(MetaRegItem), POINTER :: Current + TYPE(RegItem ), POINTER :: Item + + !================================================================= + ! GC_Diagnostics_Calc begins here! + !================================================================= + + nY = State_Grid%nY + nZ = State_Grid%nZ + + ! Initialize pointers + SpcInfo => NULL() + Current => NULL() + Item => NULL() + + ! For error trapping + ErrMsg = '' + ThisLoc = ' -> at GC_Diagnostics_Calc (in chemistry/geoschem/geoschem_diagnostics_mod.F90)' + + ! Define rootChunk + rootChunk = ( MasterProc.and.(LCHNK==BEGCHUNK) ) + + CALL OutFld( 'AREA', State_Grid%Area_M2(1,:nY), nY, LCHNK) + CALL OutFld( 'MASS', State_Met%AD(1,:nY,nZ:1:-1), nY, LCHNK) + CALL Outfld( 'HEIGHT', state%zi(:nY,:), nY, LCHNK ) + + ! =============================================== + ! Diagnose chemical species (constituents and short-lived) + ! =============================================== + + DO N = 1, gas_pcnst + M = map2chm(N) + SpcName = TRIM(solsym(N)) + outTmp = 0.0e+00_r8 + IF ( adv_mass(N) > 0.0e+00_r8 .AND. M /= 0 .AND. & + (hist_fld_active(TRIM(SpcName)) .OR. hist_fld_active(TRIM(SpcName)//'_SRF')) ) THEN + IF ( M > 0 ) THEN + ! mol/mol + outTmp(:nY,:) = REAL(State_Chm%Species(M)%Conc(1,:nY,nZ:1:-1),r8) * MWDry / adv_mass(N) + ELSEIF ( ANY( aer_species == N ) ) THEN + ! kg/kg + outTmp(:nY,:) = state%q(:nY,:nZ,-M) + ELSE + ! mol/mol + outTmp(:nY,:) = state%q(:nY,:nZ,-M) * MWDry / adv_mass(N) + ENDIF + CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + CALL OutFld( TRIM(SpcName)//'_SRF', outTmp(:nY,nZ), nY, LCHNK ) + ENDIF + ENDDO + + ! =============================================== + ! Diagnose chemical families (NOx, NOy, ...) + ! =============================================== + + SpcName = 'NOX' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(NOx_species) + idx = NOx_species(N) + MW = NOx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'NOY' + IF ( hist_fld_active(TRIM(SpcName)) .OR. hist_fld_active(TRIM(SpcName)//'_SRF') ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(NOy_species) + idx = NOy_species(N) + MW = NOy_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_N2O5 .OR. idx == i_IDN .OR. idx == i_IDNOO ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + SpcName = 'NOY_SRF' + IF ( hist_fld_active(TRIM(SpcName)) ) CALL Outfld( TRIM(SpcName), outTmp(:nY,nZ), nY, LCHNK ) + + SpcName = 'NOY_mmr' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(NOy_species) + idx = NOy_species(N) + MW = NOy_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_N2O5 .OR. idx == i_IDN .OR. idx == i_IDNOO ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'HOX' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(HOx_species) + idx = HOx_species(N) + MW = HOx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_H2O2 ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'CLOX' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(ClOx_species) + idx = ClOx_species(N) + MW = ClOx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_Cl2 .OR. idx == i_Cl2O2 ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'CLOY' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(ClOy_species) + idx = ClOy_species(N) + MW = ClOy_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_Cl2 .OR. idx == i_Cl2O2 ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'TCLY' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(tCly_species) + idx = tCly_species(N) + MW = tCly_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_Cl2 .OR. idx == i_Cl2O2 .OR. idx == i_CFC114 .OR. & + idx == i_CFC12 .OR. idx == i_CH2Cl2 .OR. idx == i_HCFC123 .OR. & + idx == i_HCFC141b ) THEN + wgt = 2.0E+00_r8 + ELSEIF ( idx == i_CFC11 .OR. idx == i_CFC113 .OR. idx == i_CH3CCl3 .OR. & + idx == i_CHCl3 ) THEN + wgt = 3.0E+00_r8 + ELSEIF ( idx == i_CCl4 ) THEN + wgt = 4.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'BROX' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(BrOx_species) + idx = BrOx_species(N) + MW = BrOx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'BROY' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(BrOy_species) + idx = BrOy_species(N) + MW = BrOy_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_Br2 ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'TBRY' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(tBry_species) + idx = tBry_species(N) + MW = tBry_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_Br2 .OR. idx == i_H2402 .OR. idx == i_CH2Br2 ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'SOX' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(SOx_species) + idx = SOx_species(N) + MW = SOx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'SOX_mmr' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(SOx_species) + idx = SOx_species(N) + MW = SOx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + outTmp(:nY,:) = outTmp(:nY,:) + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'NHX' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(NHx_species) + idx = NHx_species(N) + MW = NHx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'NHX_mmr' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(NHx_species) + idx = NHx_species(N) + MW = NHx_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + outTmp(:nY,:) = outTmp(:nY,:) + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + SpcName = 'TOTH' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp = 0.0e+00_r8 + DO N = 1, SIZE(TOTH_species) + idx = TOTH_species(N) + MW = TOTH_MWs(N) + IF ( idx <= 0 .OR. MW <= 0.0e+00_r8 ) CYCLE + wgt = 1.0E+00_r8 + IF ( idx == i_CH4 ) THEN + wgt = 2.0E+00_r8 + ENDIF + outTmp(:nY,:) = outTmp(:nY,:) & + + wgt * REAL(State_Chm%Species(idx)%Conc(1,:nY,nZ:1:-1),r8) * MWDry / MW + ENDDO + CALL Outfld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDIF + + ! =============================================== + ! Diagnose GEOS-Chem aerosol quantities + ! =============================================== + + IF ( hist_fld_active('SAD_PSC') .OR. hist_fld_active('RAD_PSC') ) THEN + outTmp = 0.0e+00_r8 + radTmp = 0.0e+00_r8 + DO J = 1, nY + DO L = 1, nZ + CALL GET_STRAT_OPT(State_Chm,1,J,L,1,RAER,REFF,SADSTRAT,XSASTRAT) + outTmp(J,nZ+1-L) = SADSTRAT + radTmp(J,nZ+1-L) = RAER + ENDDO + ENDDO + CALL Outfld( 'SAD_PSC', outTmp(:nY,:), nY, LCHNK ) + CALL Outfld( 'RAD_PSC', radTmp(:nY,:), nY, LCHNK ) + ENDIF + + IF ( hist_fld_active('SAD_SULFC') .OR. hist_fld_active('RAD_SULFC') ) THEN + outTmp = 0.0e+00_r8 + DO J = 1, nY + DO L = 1, nZ + CALL GET_STRAT_OPT(State_Chm,1,J,L,2,RAER,REFF,SADSTRAT,XSASTRAT) + outTmp(J,nZ+1-L) = SADSTRAT + radTmp(J,nZ+1-L) = RAER + ENDDO + ENDDO + CALL Outfld( 'SAD_SULFC', outTmp(:nY,:), nY, LCHNK ) + CALL Outfld( 'RAD_SULFC', radTmp(:nY,:), nY, LCHNK ) + ENDIF + + IF ( hist_fld_active('SAD_AERO') .OR. hist_fld_active('SAD_TROP') ) THEN + outTmp(:nY,:) = SUM(State_Chm%AeroArea(1,:nY,nZ:1:-1,:), DIM=3) + CALL Outfld( 'SAD_AERO', outTmp(:nY,:), nY, LCHNK ) + ENDIF + + IF ( hist_fld_active('SAD_TROP') ) THEN + DO J = 1, nY + DO L = 1, nZ + IF ( .NOT. State_Met%InTroposphere(1,J,nZ+1-L) ) THEN + outTmp(J,L) = 0.0e+00_r8 + ENDIF + ENDDO + ENDDO + CALL Outfld( 'SAD_TROP', outTmp(:nY,:), nY, LCHNK ) + ENDIF + + IF ( hist_fld_active('REFF_AERO') ) THEN + !outTmp(:nY,:) = State_Chm%AeroRadi(1,:nY,nZ:1:-1,:) + !CALL Outfld( 'REFF_AERO', outTmp(:nY,:), nY, LCHNK ) + ENDIF + + IF ( hist_fld_active('SULF_TROP') ) THEN + outTmp(:nY,:) = State_Chm%AeroArea(1,:nY,nZ:1:-1,NDUST+1) + CALL Outfld( 'SULF_TROP', outTmp(:nY,:), nY, LCHNK ) + ENDIF + + ! =============================================== + ! Diagnose stratospheric quantities + ! =============================================== + + outTmp(:nY,:) = State_Chm%Species(i_HNO3)%Conc(1,:nY,nZ:1:-1) * MWDry / MW_HNO3 + CALL Outfld( 'HNO3_GAS', outTmp(:nY,:), nY, LCHNK ) + + ! TMMF, this requires to have access to the AERFRAC variable in ucx_mod. + !outTmp(:nY,:) = AERFRAC(1,:nY,nZ:1:-1,2) + !CALL Outfld( 'HNO3_STS', outTmp(:nY,:), nY, LCHNK ) + + outTmp = 0.0e+00_r8 + DO J = 1, nY + DO L = 1, nZ + IF ( State_Met%InTroposphere(1,J,nZ+1-L) ) CYCLE + outTmp(J,L) = State_Chm%Species(i_NIT)%Conc(1,J,nZ+1-L) * MWDry / MW_NIT + ENDDO + ENDDO + CALL Outfld( 'HNO3_NAT', outTmp(:nY,:), nY, LCHNK ) + + outTmp(:nY,:) = outTmp(:nY,:) + & + ! AERFRAC(1,:nY,nZ:1:-1,2) + & + State_Chm%Species(i_HNO3)%Conc(1,:nY,nZ:1:-1) * MWDry / MW_HNO3 + CALL Outfld( 'HNO3_TOTAL', outTmp(:nY,:), nY, LCHNK ) + + outTmp(:nY,:) = State_Chm%Species(i_H2O)%Conc(1,:nY,nZ:1:-1) * MWDry / MW_H2O + CALL Outfld( 'H2O_GAS', outTmp(:nY,:), nY, LCHNK ) + + outTmp(:nY,:) = State_Chm%Species(i_HCl)%Conc(1,:nY,nZ:1:-1) * MWDry / MW_HCl + CALL Outfld( 'HCL_GAS', outTmp(:nY,:), nY, LCHNK ) + + !outTmp(:nY,:) = AERFRAC(1,:nY,nZ:1:-1,3) + !CALL Outfld( 'HCL_STS', outTmp(:nY,:), nY, LCHNK ) + + outTmp(:nY,:) = 0.0e+00_r8 + !outTmp(:nY,:) = AERFRAC(1,:nY,nZ:1:-1,3) + outTmp(:nY,:) = outTmp(:nY,:) + & + State_Chm%Species(i_HCl)%Conc(1,:nY,nZ:1:-1) * MWDry / MW_HCl + CALL Outfld( 'HCL_TOTAL', outTmp(:nY,:), nY, LCHNK ) + + ! =============================================== + ! Diagnose dry deposition velocities and fluxes + ! =============================================== + + IF ( Input_Opt%LDryD ) THEN + DO N = 1, State_Chm%nDryDep + ND = NDVZIND(N) + SpcName = 'DV_'//to_upper(TRIM(depName(N))) + IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE + CALL OutFld( TRIM(SpcName), State_Chm%DryDepVel(1,:nY,ND), nY, LCHNK ) + ENDDO + + DO N = 1, State_Chm%nAdvect + ! Get the species ID from the advected species ID + L = State_Chm%Map_Advect(N) + + ! Get info about this species from the species database + SpcInfo => State_Chm%SpcData(L)%Info + SpcName = 'DF_'//to_upper(TRIM(SpcInfo%Name)) + + IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE + ! SurfaceFlux is Emissions - Drydep, but Emissions = 0, as it is applied + ! externally + CALL OutFld( TRIM(SpcName), -State_Chm%SurfaceFlux(1,:nY,N), nY, LCHNK ) + + ! Free pointer + SpcInfo => NULL() + ENDDO + ENDIF + + ! =============================================== + ! Diagnose surface fluxes (emissions - drydep) + ! =============================================== + + DO N = iFirstCnst, pcnst + SpcName = TRIM(sflxnam(N)) + IF ( TRIM(SpcName) == '' ) CYCLE + IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE + CALL OutFld( TRIM(SpcName), cam_in%cflx(:nY,N), nY, LCHNK ) + ENDDO + + ! =============================================== + ! Diagnose chemical tendencies + ! =============================================== + + ! Chemical tendencies in kg/kg/s + DO N = 1, gas_pcnst + SpcName = TRIM(srcnam(N)) + IF ( TRIM(SpcName) == '' ) CYCLE + IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE + CALL OutFld( TRIM(SpcName), mmr_tend(:nY,:nZ,N), nY, LCHNK ) + ENDDO + + ! Chemical tendencies in kg/s + DO N = 1, gas_pcnst + SpcName = TRIM(dtchem_name(N)) + IF ( .NOT. hist_fld_active(TRIM(SpcName)) ) CYCLE + outTmp = 0.0e+0_r8 + outTmp(:nY,:nZ) = mmr_tend(:nY,:nZ,N) * REAL(State_Met%AD(1,:nY,nZ:1:-1),r8) + CALL OutFld( TRIM(SpcName), outTmp(:nY,:), nY, LCHNK ) + ENDDO + + ! =============================================== + ! Diagnose fields corresponding to State_Met + ! =============================================== + + SpcName = 'SZA' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp(:nY,1) = ACOS(MIN(MAX(State_Met%SUNCOS(1,:nY),-1._r8),1._r8))/pi*180.e+0_r8 + CALL Outfld( TRIM(SpcName), outTmp(:nY,1) , nY, LCHNK ) + ENDIF + + SpcName = 'U_SRF' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp(:nY,:) = state%u(:nY,:) + CALL Outfld( TRIM(SpcName), outTmp(:nY,:) , nY, LCHNK ) + ENDIF + + SpcName = 'V_SRF' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp(:nY,:) = state%v(:nY,:) + CALL Outfld( TRIM(SpcName), outTmp(:nY,:) , nY, LCHNK ) + ENDIF + + SpcName = 'Q_SRF' + IF ( hist_fld_active(TRIM(SpcName)) ) THEN + outTmp(:nY,:) = State_Chm%Species(i_H2O)%Conc(1,:nY,nZ:1:-1) + CALL Outfld( TRIM(SpcName), outTmp(:nY,:) , nY, LCHNK ) + ENDIF + + ! Cleanup + Current => NULL() + Item => NULL() + Ptr0d_8 => NULL() + Ptr1d_8 => NULL() + Ptr2d_8 => NULL() + Ptr3d_8 => NULL() + + END SUBROUTINE GC_Diagnostics_Calc + + END MODULE GeosChem_Diagnostics_Mod + diff --git a/src/chemistry/geoschem/geoschem_emissions_mod.F90 b/src/chemistry/geoschem/geoschem_emissions_mod.F90 new file mode 100644 index 0000000000..dc674775ba --- /dev/null +++ b/src/chemistry/geoschem/geoschem_emissions_mod.F90 @@ -0,0 +1,532 @@ +! Module geoschem_emissions_mod contains routines which retrieve +! emission fluxes from HEMCO and transfers it back to the CESM-GC interface +! 07 Oct 2020 - T. M. Fritz - Initial version +MODULE GeosChem_Emissions_Mod + + ! CAM modules + use cam_abortutils, only : endrun + use cam_logfile, only : iulog + use chem_mods, only : iFirstCnst + use constituents, only : pcnst, cnst_name + use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use shr_megan_mod, only : shr_megan_mechcomps, shr_megan_mechcomps_n + use spmd_utils, only : MasterProc + + IMPLICIT NONE + + PRIVATE + + PUBLIC :: GC_Emissions_Init + PUBLIC :: GC_Emissions_Calc + PUBLIC :: GC_Emissions_Final + + ! Constituent number for NO + INTEGER :: iNO + + ! Aerosol constituent number + INTEGER :: iBC1 + INTEGER :: iBC4 + INTEGER :: iH2SO4 + + INTEGER :: iBCPI + INTEGER :: iBCPO + INTEGER :: iOCPI + INTEGER :: iOCPO + INTEGER :: iSO4 + + ! MEGAN Emissions + INTEGER, ALLOCATABLE :: megan_indices_map(:) + REAL(r8), ALLOCATABLE :: megan_wght_factors(:) + + ! Cache for is_extfrc? + LOGICAL, ALLOCATABLE :: pcnst_is_extfrc(:) ! no idea why the indexing is not 1:gas_pcnst or why iFirstCnst can be < 0 + +CONTAINS + + SUBROUTINE GC_Emissions_Init( ) + + ! CAM modules + use cam_history, only : addfld, add_default, horiz_only + use chem_mods, only : adv_mass + use constituents, only : cnst_get_ind + use fire_emissions, only : fire_emissions_init + use infnan, only : NaN, assignment(=) + use mo_chem_utls, only : get_spc_ndx, get_extfrc_ndx + use phys_control, only : phys_getopts + use physics_types, only : physics_state + + ! Integers + INTEGER :: IERR + INTEGER :: N, II + + ! Logicals + LOGICAL :: history_aerosol + LOGICAL :: history_chemistry + LOGICAL :: history_cesm_forcing + + ! Strings + CHARACTER(LEN=shr_kind_cl) :: SpcName + CHARACTER(LEN=shr_kind_cl) :: Description + + ! Real + REAL(r8) :: MW + + CALL phys_getopts( history_aerosol_out = history_aerosol, & + history_chemistry_out = history_chemistry, & + history_cesm_forcing_out = history_cesm_forcing ) + + ! Get constituent index for NO + CALL cnst_get_ind('NO', iNO, abort=.True.) + + !----------------------------------------------------------------------- + ! ... MEGAN emissions + !----------------------------------------------------------------------- + IF ( shr_megan_mechcomps_n > 0 ) THEN + + ALLOCATE( megan_indices_map(shr_megan_mechcomps_n), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating megan_indices_map') + ALLOCATE( megan_wght_factors(shr_megan_mechcomps_n), STAT=IERR ) + IF ( IERR .NE. 0 ) CALL ENDRUN('Failure while allocating megan_wght_factors') + megan_wght_factors(:) = NaN + + DO N = 1, shr_megan_mechcomps_n + SpcName = TRIM(shr_megan_mechcomps(N)%name) + + ! Special handlings for GEOS-Chem species + IF ( TRIM(SpcName) == 'HCN' ) THEN + SpcName = 'None' + MW = 27.025140_r8 ! Taken from pp_trop_strat_mam4_vbs + ELSEIF ( TRIM(SpcName) == 'C2H4' ) THEN + SpcName = 'None' + MW = 28.051600_r8 ! Taken from pp_trop_strat_mam4_vbs + ENDIF + !IF ( TRIM(SpcName) == 'MTERP' ) THEN + ! SpcName = 'MTPA' + !ELSEIF ( TRIM(SpcName) == 'BCARY' ) THEN + ! SpcName = 'None' + ! MW = 204.342600_r8 ! Taken from pp_trop_strat_mam4_vbs + !ELSEIF ( TRIM(SpcName) == 'CH3OH' ) THEN + ! SpcName = 'MOH' + !ELSEIF ( TRIM(SpcName) == 'C2H5OH' ) THEN + ! SpcName = 'EOH' + !ELSEIF ( TRIM(SpcName) == 'CH3CHO' ) THEN + ! SpcName = 'ALD2' + !ELSEIF ( TRIM(SpcName) == 'CH3COOH' ) THEN + ! SpcName = 'ACTA' + !ELSEIF ( TRIM(SpcName) == 'CH3COCH3' ) THEN + ! SpcName = 'ACET' + !ELSEIF ( TRIM(SpcName) == 'HCN' ) THEN + ! SpcName = 'None' + ! MW = 27.025140_r8 ! Taken from pp_trop_strat_mam4_vbs + !ELSEIF ( TRIM(SpcName) == 'C2H4' ) THEN + ! SpcName = 'None' + ! MW = 28.051600_r8 ! Taken from pp_trop_strat_mam4_vbs + !ELSEIF ( TRIM(SpcName) == 'C3H6' ) THEN + ! SpcName = 'PRPE' + !ELSEIF ( TRIM(SpcName) == 'BIGALK' ) THEN + ! ! BIGALK = Pentane + Hexane + Heptane + Tricyclene + ! SpcName = 'ALK4' + !ELSEIF ( TRIM(SpcName) == 'BIGENE' ) THEN + ! ! BIGENE = butene (C4H8) + ! SpcName = 'PRPE' ! Lumped >= C3 alkenes + !ELSEIF ( TRIM(SpcName) == 'TOLUENE' ) THEN + ! SpcName = 'TOLU' + !ENDIF + + CALL cnst_get_ind (SpcName, megan_indices_map(N), abort=.False.) + + II = get_spc_ndx(SpcName) + IF ( II > 0 ) THEN + SpcName = TRIM(shr_megan_mechcomps(N)%name) + megan_wght_factors(N) = adv_mass(II)*1.e-3_r8 ! kg/moles (to convert moles/m2/sec to kg/m2/sec) + Description = TRIM(SpcName)//' MEGAN emissions flux (released as '//TRIM(SpcName)//' in GEOS-Chem)' + ELSEIF ( TRIM(SpcName) == 'None' ) THEN + SpcName = TRIM(shr_megan_mechcomps(N)%name) + megan_wght_factors(N) = MW*1.e-3_r8 ! kg/moles + IF ( MasterProc ) Write(iulog,*) " MEGAN ", TRIM(SpcName), & + " emissions will be ignored as no species match in GEOS-Chem." + Description = TRIM(SpcName)//' MEGAN emissions flux (not released in GEOS-Chem)' + ELSE + SpcName = TRIM(shr_megan_mechcomps(N)%name) + CALL ENDRUN( 'chem_init: MEGAN compound not in chemistry mechanism : '//TRIM(SpcName)) + ENDIF + + ! MEGAN history fields + CALL Addfld( 'MEG_'//TRIM(SpcName), horiz_only, 'A', 'kg/m2/s', & + Description ) + + IF ( history_chemistry ) THEN + CALL Add_default('MEG_'//TRIM(SpcName), 1, ' ') + ENDIF + ENDDO + ENDIF + + DO N = iFirstCnst, pcnst + SpcName = TRIM(cnst_name(N))//'_XFRC' + CALL Addfld( TRIM(SpcName), (/ 'lev' /), 'A', 'molec/cm3/s', & + 'External forcing for '//TRIM(cnst_name(N))) + SpcName = TRIM(cnst_name(N))//'_CLXF' + CALL Addfld( TRIM(SpcName), horiz_only, 'A', 'molec/cm2/s', & + 'Vertically-integrated external forcing for '//TRIM(cnst_name(N))) + IF ( history_aerosol .OR. history_chemistry ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF + IF ( history_cesm_forcing .AND. TRIM(cnst_name(N)) == 'NO2' ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF + SpcName = TRIM(cnst_name(N))//'_CMXF' + CALL Addfld( TRIM(SpcName), horiz_only, 'A', 'kg/m2/s', & + 'Vertically-integrated external forcing for '//TRIM(cnst_name(N))) + IF ( history_aerosol .OR. history_chemistry ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF + IF ( history_cesm_forcing .AND. TRIM(cnst_name(N)) == 'NO2' ) THEN + CALL Add_Default( TRIM(SpcName), 1, ' ' ) + ENDIF + ENDDO + + CALL Addfld( 'NO_Lightning', (/ 'lev' /), 'A','molec/cm3/s', & + 'lightning NO source' ) + + !----------------------------------------------------------------------- + ! ... Fire emissions + !----------------------------------------------------------------------- + CALL fire_emissions_init() + + ! Initialize pcnst_is_extfrc cache to avoid lengthy lookups in future timesteps + ! on the get_extfrc_ndx routine. (hplin 1/20/23) + if(.not. allocated(pcnst_is_extfrc)) then + allocate(pcnst_is_extfrc(pcnst - iFirstCnst + 1)) + endif + do n = iFirstCnst, pcnst + pcnst_is_extfrc(n - iFirstCnst + 1) = (get_extfrc_ndx(trim(cnst_name(n))) > 0) + enddo + + END SUBROUTINE GC_Emissions_Init + + SUBROUTINE GC_Emissions_Calc( state, hco_pbuf2d, State_Met, cam_in, eflx, iStep ) + ! Subroutine GC_Emissions_Calc retrieves emission fluxes + ! from HEMCO and returns a 3-D array of emission flux to the CESM-GC + ! interface. On top of passing data, this routine handles a number of checks. + + ! CAM modules + use aero_model, only : aero_model_emissions ! Aerosol emissions + use cam_history, only : outfld + use camsrfexch, only : cam_in_t + use constituents, only : cnst_get_ind, cnst_mw + use fire_emissions, only : fire_emissions_srf, fire_emissions_vrt ! Fire emissions + use mo_lightning, only : prod_NO! Lightning emissions + use physconst, only : rga, avogad + use physics_buffer, only : pbuf_get_index, pbuf_get_chunk + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + use physics_types, only : physics_state + use ppgrid, only : pcols, pver, begchunk + use srf_field_check, only : active_Fall_flxvoc ! MEGAN emissions + use string_utils, only : to_upper + + ! GEOS-Chem modules + use PhysConstants, only : AVO, PI + use State_Met_Mod, only : MetState + + TYPE(physics_state), INTENT(IN ) :: state ! Physics state variables + TYPE(physics_buffer_desc), POINTER, INTENT(IN ) :: hco_pbuf2d(:,:) ! Pointer to 2-D pbuf + TYPE(MetState), INTENT(IN ) :: State_Met ! Meteorology State object + INTEGER, INTENT(IN ) :: iStep + + TYPE(cam_in_t), INTENT(INOUT) :: cam_in ! import state + REAL(r8), INTENT( OUT) :: eflx(pcols,pver,pcnst) ! 3-D emissions in kg/m2/s + + ! Integers + INTEGER :: LCHNK + INTEGER :: nY, nZ + INTEGER :: J, L, N + INTEGER :: RC ! return code + INTEGER :: tmpIdx ! pbuf field id + + INTEGER :: id_O3, id_HNO3 ! Species IDs for reuse + + ! Logical + LOGICAL :: rootChunk + + ! Objects + TYPE(physics_buffer_desc), POINTER :: pbuf_chnk(:) ! slice of pbuf in current chunk + + ! Real + REAL(r8), POINTER :: pbuf_ik(:,:) ! pointer to pbuf data (/pcols,pver/) + REAL(r8), POINTER :: pbuf_i(:) ! pointer to 2-D (1-D in CAM) data (/pcols/) + REAL(r8), DIMENSION(state%NCOL,PVER+1) :: zint ! Interface geopotential in km + REAL(r8), DIMENSION(state%NCOL) :: zsurf ! Surface height + REAL(r8) :: SCALFAC ! Multiplying factor + REAL(r8) :: megflx(pcols) ! For MEGAN emissions + REAL(r8), PARAMETER :: m2km = 1.e-3_r8 + + ! Strings + CHARACTER(LEN=shr_kind_cl) :: SpcName + CHARACTER(LEN=shr_kind_cl) :: fldname_ns ! field name HCO_* + + + ! Initialize pointers + pbuf_chnk => NULL() + pbuf_ik => NULL() + pbuf_i => NULL() + + ! LCHNK: which chunk we have on this process + LCHNK = state%LCHNK + ! nY: number of atmospheric columns on this chunk + nY = state%NCOL + nZ = PVER + rootChunk = ( MasterProc .AND. ( LCHNK.EQ.BEGCHUNK ) ) + + ! Initialize emission flux + eflx(:,:,:) = 0.0e+0_r8 + + DO N = iFirstCnst, pcnst + fldname_ns = 'HCO_'//TRIM(cnst_name(N)) + tmpIdx = pbuf_get_index(fldname_ns, RC) + + IF ( tmpIdx < 0 .OR. ( iStep == 1 ) ) THEN + IF ( rootChunk ) Write(iulog,'(a,a)') " GC_Emissions_Calc: Field not found ", & + TRIM(fldname_ns) + ELSE + ! This is already in chunk, retrieve it + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + + ! Check if we need to get 3-D, or 2-D data + IF (pcnst_is_extfrc(N - iFirstCnst + 1)) THEN + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik) + + IF ( .NOT. ASSOCIATED(pbuf_ik) ) THEN ! Sanity check + CALL ENDRUN("GC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_ik not associated (E-1)") + ENDIF + + eflx(1:nY,:nZ,N) = pbuf_ik(1:nY,:nZ) + + ! Reset pointers + pbuf_ik => NULL() + ELSE ! 2-D + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + + IF ( .NOT. ASSOCIATED(pbuf_i) ) THEN ! Sanity check + CALL ENDRUN("GC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_i not associated (E-2)") + ENDIF + + ! note: write to nZ level here as this is surface + eflx(1:nY,nZ,N) = pbuf_i(1:nY) + + ! Reset pointers + pbuf_i => NULL() + ENDIF + + pbuf_chnk => NULL() + + !IF ( MINVAL(eflx(:nY,:nZ,N)) < 0.0e+00_r8 ) THEN + ! Write(iulog,*) " GC_Emissions_Calc: HEMCO emission flux is negative for ", & + ! TRIM(cnst_name(N)), " with value ", MINVAL(eflx(:nY,:nZ,N)), " at ", & + ! MINLOC(eflx(:nY,:nZ,N)) + !ENDIF + + IF ( rootChunk .AND. (iStep == 2) .AND. ( MAXVAL(eflx(:nY,:nZ,N)) > 0.0e+0_r8 ) ) THEN + ! Only print this once + Write(iulog,'(a,a,a,a)') " GC_Emissions_Calc: HEMCO flux ", & + TRIM(fldname_ns), " added to ", TRIM(cnst_name(N)) + Write(iulog,'(a,a,E16.4)') " GC_Emissions_Calc: Maximum flux ", & + TRIM(fldname_ns), MAXVAL(eflx(:nY,:nZ,N)) + ENDIF + ENDIF + ENDDO + + !----------------------------------------------------------------------- + ! Deposition fluxes from HEMCO + !----------------------------------------------------------------------- + + ! Deposition velocities in HEMCO are now handled within HEMCO_CESM for a + ! hardcoded list of species, primarily for the SeaFlux extension. + ! This is not to be confused with dry deposition fluxes which are not + ! handled by HEMCO. + + ! Part 2: Handle special deposition fluxes for the ParaNOx extension + ! for PAR_O3_DEP and PAR_HNO3_DEP + CALL cnst_get_ind('O3', id_O3) + CALL cnst_get_ind('HNO3', id_HNO3) + + ! write(iulog,*) 'id_O3, cnst_name, id_HNO3, cnst_name', id_O3, cnst_name(id_O3), id_HNO3, cnst_name(id_HNO3) + + tmpIdx = pbuf_get_index('HCO_PAR_O3_DEP', RC) + IF(tmpIdx < 0 .OR. ( iStep == 1 )) then + ! No ParaNOx dep flux for O3 + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + + IF ( .NOT. ASSOCIATED(pbuf_i) ) THEN ! Sanity check + CALL ENDRUN("GC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_i not associated (2)") + ENDIF + + ! apply loss flux to surface (level nZ) + eflx(1:NY,nZ,id_O3) = eflx(1:NY,nZ,id_O3) - pbuf_i(1:nY) + + !IF ( MINVAL(eflx(:nY,nZ,id_O3)) < 0.0e+00_r8 ) THEN + ! Write(iulog,*) " GC_Emissions_Calc: HEMCO sfc flux after ParaNOx is negative for O3 with value ", MINVAL(eflx(:nY,:nZ,id_O3)), " at ", & + ! MINLOC(eflx(:nY,nZ,id_O3)) + !ENDIF + + IF ( rootChunk .and. ( MINVAL(pbuf_i(1:nY)) < 0.0e+0_r8 ) ) THEN + Write(iulog,'(a,a,a,a)') " GC_Emissions_Calc: HEMCO dflx(paranox) O3 added to ", TRIM(cnst_name(id_O3)) + Write(iulog,'(a,a,E16.4)') " GC_Emissions_Calc: Minval dflx(paranox), eflx(sfc) O3 ", MINVAL(pbuf_i(1:nY)), MINVAL(eflx(:nY,nZ,id_O3)) + ENDIF + + ! Reset pointers + pbuf_i => NULL() + pbuf_chnk => NULL() + ENDIF + + tmpIdx = pbuf_get_index('HCO_PAR_HNO3_DEP', RC) + IF(tmpIdx < 0 .OR. ( iStep == 1 )) then + ! No ParaNOx dep flux for HNO3 + ELSE + pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, LCHNK) + CALL pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i) + + IF ( .NOT. ASSOCIATED(pbuf_i) ) THEN ! Sanity check + CALL ENDRUN("GC_Emissions_Calc: FATAL - tmpIdx > 0 but pbuf_i not associated (3)") + ENDIF + + eflx(1:NY,nZ,id_HNO3) = eflx(1:NY,nZ,id_HNO3) - pbuf_i(1:nY) + + !IF ( MINVAL(eflx(:nY,nZ,id_HNO3)) < 0.0e+00_r8 ) THEN + ! Write(iulog,*) " GC_Emissions_Calc: HEMCO sfc flux after ParaNOx is negative for HNO3 with value ", MINVAL(eflx(:nY,nZ,id_HNO3)), " at ", & + ! MINLOC(eflx(:nY,nZ,id_HNO3)) + !ENDIF + + IF ( rootChunk .and. ( MINVAL(pbuf_i(1:nY)) < 0.0e+0_r8 ) ) THEN + Write(iulog,'(a,a,a,a)') " GC_Emissions_Calc: HEMCO dflx(paranox) HNO3 added to ", TRIM(cnst_name(id_HNO3)) + Write(iulog,'(a,a,E16.4)') " GC_Emissions_Calc: Minval dflx(paranox), eflx(sfc) HNO3 ", MINVAL(pbuf_i(1:nY)), MINVAL(eflx(:nY,nZ,id_HNO3)) + ENDIF + + ! Reset pointers + pbuf_i => NULL() + pbuf_chnk => NULL() + ENDIF + +#if defined( MODAL_AERO ) + + !----------------------------------------------------------------------- + ! Aerosol emissions (dust + seasalt) ... + !----------------------------------------------------------------------- + call aero_model_emissions( state, cam_in ) + + ! Since GEOS-Chem DST* aerosols are inherited from MAM's DST, we do not + ! need to feed MAM dust emissions into the GEOS-Chem DST* constituents + ! Same thing applies for sea salt. + + ! HEMCO aerosol emissions are fed to MAM through the HEMCO_Config.rc + ! where all GEOS-Chem aerosols (BCPI, BCPO, OCPI, OCPO, SO4) have been + ! replaced with the corresponding MAM aerosols + +#endif + + ! Output fields before lightning NO emissions are applied to eflx + ! Make sure that we do not include surface emissions in the diagnostics! + DO N = iFirstCnst, pcnst + SpcName = TRIM(cnst_name(N))//'_XFRC' + ! Convert from kg/m2/s to molec/cm3/s + ! Note 1: cnst_mw is in kg/kmole + ! Note 2: avogad is in molecules/kmole + CALL Outfld( TRIM(SpcName), eflx(:nY,:nZ,N) / State_Met%BXHEIGHT(1,:nY,nZ:1:-1) * 1.0E-06_r8 / cnst_mw(N) * avogad, nY, LCHNK ) + + SpcName = TRIM(cnst_name(N))//'_CLXF' + ! Convert from kg/m2/s to molec/cm2/s + ! Note 1: cnst_mw is in kg/kmole + ! Note 2: avogad is in molecules/kmole + CALL Outfld( TRIM(SpcName), SUM(eflx(:nY,:nZ-1,N), DIM=2) * 1.0E-04_r8 / cnst_mw(N) * avogad, nY, LCHNK ) + + SpcName = TRIM(cnst_name(N))//'_CMXF' + CALL Outfld( TRIM(SpcName), SUM(eflx(:nY,:nZ-1,N), DIM=2), nY, LCHNK ) + ENDDO + + !----------------------------------------------------------------------- + ! Lightning NO emissions + !----------------------------------------------------------------------- + N = iNO + + ! prod_NO is in atom N cm^-3 s^-1 <=> molec cm^-3 s^-1 + ! We need to convert this to kg NO/m2/s + ! Multiply by MWNO * BXHEIGHT * 1.0E+06 / AVO + ! = mole/molec * kg NO/mole * m * cm^3/m^3 + ! cnst_mw(N) is in g/mole + SCALFAC = cnst_mw(N) * 1.0E-03_r8 * 1.0E+06_r8 / AVO + DO J = 1, nY + DO L = 1, nZ + eflx(J,L,N) = eflx(J,L,N) & + + prod_NO(J,L,LCHNK) & + * State_Met%BXHEIGHT(1,J,nZ+1-L) & + * SCALFAC + ENDDO + ENDDO + + CALL Outfld( 'NO_Lightning', prod_NO(:nY,:nZ,LCHNK), nY, LCHNK ) + + !----------------------------------------------------------------------- + ! MEGAN emissions ... + !----------------------------------------------------------------------- + + IF ( active_Fall_flxvoc .AND. shr_megan_mechcomps_n > 0 ) THEN + ! set MEGAN fluxes + DO N = 1, shr_megan_mechcomps_n + DO J = 1, nY + megflx(J) = -cam_in%meganflx(J,N) * megan_wght_factors(N) + ENDDO + IF ( ( megan_indices_map(N) > 0 ) .AND. ( megan_wght_factors(N) > 0.0e+00_r8 ) ) THEN + DO J = 1, nY + cam_in%cflx(J,megan_indices_map(N)) = cam_in%cflx(J,megan_indices_map(N)) & + + megflx(J) + ENDDO + ENDIF + ! output MEGAN emis fluxes to history + CALL Outfld('MEG_'//TRIM(shr_megan_mechcomps(N)%name), megflx(:nY), nY, LCHNK) + ENDDO + ENDIF + + !----------------------------------------------------------------------- + ! Fire surface emissions if not elevated forcing + !----------------------------------------------------------------------- + + CALL fire_emissions_srf( LCHNK, nY, cam_in%fireflx, cam_in%cflx ) + + !----------------------------------------------------------------------- + ! Apply CLM emissions (for elevated forcing) + !----------------------------------------------------------------------- + + ! Compute geopotential height in km (needed for vertical distribution of + ! fire emissions + zsurf(:nY) = rga * state%phis(:nY) + DO L = 1, nZ + zint(:nY,L) = m2km * ( state%zi(:nY,L) + zsurf(:nY) ) + ENDDO + L = nZ+1 + zint(:nY,L) = m2km * ( state%zi(:nY,L) + zsurf(:nY) ) + + ! Distributed fire emissions if elevated forcing + ! extfrc is in molec/cm3/s + ! TMMF - vertical distribution of fire emissions is not implemented yet + !CALL fire_emissions_vrt( nY, LCHNK, zint, cam_in%fireflx, cam_in%fireztop, extfrc ) + + ! Near-surface emissions are now emitted directly to GEOS-Chem Species array + ! for consistency with CAM-chem implementation of HEMCO + ! (but not with GEOS-Chem standalone, where fluxes are mixed by the turbulence routines) + ! Refer to discussion here: https://github.com/ESCOMP/CAM/pull/560#discussion_r1084559191 + ! + ! To replicate old behavior, uncomment these two lines below: + ! cam_in%cflx(1:nY,:) = cam_in%cflx(1:nY,:) + eflx(1:nY,nZ,:) + ! eflx(1:nY,nZ,:) = 0.0e+00_r8 + + END SUBROUTINE GC_Emissions_Calc + + SUBROUTINE GC_Emissions_Final + + IF ( ALLOCATED( megan_indices_map ) ) DEALLOCATE( megan_indices_map ) + IF ( ALLOCATED( megan_wght_factors ) ) DEALLOCATE( megan_wght_factors ) + + END SUBROUTINE GC_Emissions_Final + +END MODULE GeosChem_Emissions_Mod diff --git a/src/chemistry/geoschem/geoschem_history_mod.F90 b/src/chemistry/geoschem/geoschem_history_mod.F90 new file mode 100644 index 0000000000..ef4c2044e1 --- /dev/null +++ b/src/chemistry/geoschem/geoschem_history_mod.F90 @@ -0,0 +1,1202 @@ +#define _ASSERT(cond,msg) if(.not.cond) then; print *, "assertion error: ", Iam, __LINE__; call endrun("assertion error - look above - in geoschem_history_mod.F90"); endif +#define _Iam_(name) character(len=255) :: Iam=name +#define __Iam__(name) integer :: STATUS; _Iam_(name) +! Above are compatibility shorthands to avoid excessive divergence from +! MAPL-based code. (hplin, 10/19/22) +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: geoschem_history_mod.F90 +! +! !DESCRIPTION: Module GeosChem\_History\_Mod interfaces between the CAM history +! component, the HISTORY.rc configuration file, and the GEOS-Chem State registry. +! This module is based off GCHP\_HistoryExports\_Mod originally developed by +! Lizzie Lundgren for GCHP. +!\\ +!\\ +! !INTERFACE: +! +MODULE GeosChem_History_Mod +! +! !USES: +! + ! CAM modules + USE cam_abortutils, ONLY : endrun + + ! GEOS-Chem modules + USE DiagList_Mod, ONLY : DgnItem, DgnList + USE DiagList_Mod, ONLY : Init_DiagList, Print_DiagList + USE ErrCode_Mod, ONLY : GC_SUCCESS, GC_FAILURE, GC_ERROR + USE Precision_Mod, ONLY : fp, f4, f8 + USE TaggedDiagList_Mod, ONLY : TaggedDgnList + USE TaggedDiagList_Mod, ONLY : Init_TaggedDiagList, Print_TaggedDiagList + + IMPLICIT NONE + PRIVATE +! +! !PUBLIC MEMBER FUNCTIONS: +! + PUBLIC :: HistoryExports_SetServices + PUBLIC :: HistoryExports_SetDataPointers + PUBLIC :: CopyGCStates2Exports + PUBLIC :: Destroy_HistoryConfig +! +! !PRIVATE: +! + PRIVATE :: Init_HistoryConfig + PRIVATE :: Init_HistoryExport + PRIVATE :: Init_HistoryExportsList + PRIVATE :: Append_HistoryExportsList + PRIVATE :: Check_HistoryExportsList + PRIVATE :: Print_HistoryExportsList + ! +! !PUBLIC TYPES +! + ! History Configuration Object + TYPE, PUBLIC :: HistoryConfigObj + + CHARACTER(LEN=255) :: ROOT ! TODO: needed? + CHARACTER(LEN=255) :: ConfigFileName + LOGICAL :: ConfigFileRead + TYPE(HistoryExportsListObj), POINTER :: HistoryExportsList + TYPE(DgnList) :: DiagList + TYPE(TaggedDgnList) :: TaggedDiagList + + END TYPE HistoryConfigObj +! +! !PRIVATE TYPES +! + ! History Exports Linked List + TYPE :: HistoryExportsListObj + + TYPE(HistoryExportObj), POINTER :: head + INTEGER :: numExports + + END TYPE HistoryExportsListObj + + ! History Export Object + TYPE :: HistoryExportObj + + CHARACTER(LEN=255) :: name + CHARACTER(LEN=255) :: metadataID + CHARACTER(LEN=255) :: registryID + CHARACTER(LEN=255) :: long_name + CHARACTER(LEN=255) :: units + INTEGER :: vloc + INTEGER :: rank + INTEGER :: type + LOGICAL :: isMet + LOGICAL :: isChem + LOGICAL :: isDiag + TYPE(HistoryExportObj), POINTER :: next + + ! Pointers to temporaries for CAM Export and GEOS-Chem State + ! TODO: for now, include all possible data types in the registry. + REAL(fp), POINTER :: GCStateData0d + REAL(fp), POINTER :: GCStateData1d(:) + REAL(fp), POINTER :: GCStateData2d(:,:) + REAL(fp), POINTER :: GCStateData3d(:,:,:) + REAL(f4), POINTER :: GCStateData0d_4 + REAL(f4), POINTER :: GCStateData1d_4(:) + REAL(f4), POINTER :: GCStateData2d_4(:,:) + REAL(f4), POINTER :: GCStateData3d_4(:,:,:) + REAL(f8), POINTER :: GCStateData0d_8 + REAL(f8), POINTER :: GCStateData1d_8(:) + REAL(f8), POINTER :: GCStateData2d_8(:,:) + REAL(f8), POINTER :: GCStateData3d_8(:,:,:) + INTEGER, POINTER :: GCStateData0d_I + INTEGER, POINTER :: GCStateData1d_I(:) + INTEGER, POINTER :: GCStateData2d_I(:,:) + INTEGER, POINTER :: GCStateData3d_I(:,:,:) + + END TYPE HistoryExportObj +! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version for GCHP/GEOS +! 19 Oct 2022 - H.P. Lin - Adapted for CESM +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC + +CONTAINS +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Init_HistoryConfig +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Init_HistoryConfig ( am_I_Root, HistoryConfig, configFile, RC ) +! +! !USES: +! +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root + CHARACTER(LEN=*), INTENT(IN) :: configFile +! +! !OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig + INTEGER, INTENT(OUT) :: RC +! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC + __Iam__('Init_HistoryConfig (geoschem_history_mod.F90)') + RC = GC_SUCCESS + ALLOCATE(HistoryConfig) + HistoryConfig%ROOT = '' + HistoryConfig%ConfigFileName = TRIM(configFile) + HistoryConfig%ConfigFileRead = .FALSE. + + CALL Init_DiagList( am_I_Root, configFile, HistoryConfig%DiagList, RC ) + IF ( RC == GC_FAILURE ) THEN + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + ! Optional debugging + ! CALL Print_DiagList( am_I_Root, HistoryConfig%DiagList, RC ) + + CALL Init_TaggedDiagList( am_I_Root, HistoryConfig%DiagList, & + HistoryConfig%TaggedDiagList, RC ) + IF ( RC == GC_FAILURE ) THEN + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + ! Optional debugging + ! CALL Print_TaggedDiagList( am_I_Root, HistoryConfig%TaggedDiagList, RC ) + + + CALL Init_HistoryExportsList( am_I_Root, HistoryConfig, RC ) + IF ( RC == GC_FAILURE ) THEN + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + + ! Optional debugging + ! CALL Print_HistoryExportsList( am_I_Root, HistoryConfig, RC ) + + END SUBROUTINE Init_HistoryConfig +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Init_HistoryExportsList +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Init_HistoryExportsList ( am_I_Root, HistoryConfig, RC ) +! +! !USES: +! + ! GEOS-Chem modules + USE State_Chm_Mod, ONLY : Get_Metadata_State_Chm + USE State_Diag_Mod, ONLY : Get_Metadata_State_Diag + USE State_Met_Mod, ONLY : Get_Metadata_State_Met +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC +! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + INTEGER :: N, rank, vloc, type + CHARACTER(LEN=255) :: ErrMsg, desc, units, tag + LOGICAL :: isMet, isChem, isDiag, found + TYPE(HistoryExportObj), POINTER :: NewHistExp + TYPE(DgnItem), POINTER :: current + + ! ================================================================ + ! Init_HistoryExportsList begins here + ! ================================================================ + __Iam__('Init_HistoryExportsList (geoschem_history_mod.F90)') + RC = GC_SUCCESS + + ! Init + NewHistExp => NULL() + + ! Create HistoryExportsList object + ALLOCATE(HistoryConfig%HistoryExportsList) + HistoryConfig%HistoryExportsList%numExports = 0 + HistoryConfig%HistoryExportsList%head => NULL() + + ! Loop over entries in DiagList + current => HistoryConfig%DiagList%head + DO WHILE ( ASSOCIATED( current ) ) + + ! Skip diagnostics handled by HEMCO, non-standard for GEOS, + ! or species in the GCHP/GEOS internal state. + ! See diaglist_mod.F90 for criteria for assigning diagnostic state. + IF ( INDEX( current%state, 'HEMCO' ) == 1 .OR. & + INDEX( current%state, 'GEOS' ) == 1 .OR. & + INDEX( current%state, 'INTERNAL' ) == 1 ) THEN + current => current%next + CYCLE + ENDIF + + ! Check history exports list to see if already added (unless wildcard) + IF ( .NOT. current%isWildcard ) THEN + CALL Check_HistoryExportsList( am_I_Root, current%name, & + HistoryConfig%HistoryExportsList, & + found, RC ) + IF ( found ) THEN + current => current%next + CYCLE + ENDIF + ENDIF + + ! Get metadata using metadataID and state + ! If isTagged, then append to description + ! If isWildcard, shouldn't get here + ! The name of the export is simply name + Found = .TRUE. + isMet = .FALSE. + isChem = .FALSE. + isDiag = .FALSE. + IF ( TRIM(current%state) == 'MET' ) THEN + isMet = .TRUE. + CALL Get_Metadata_State_Met( am_I_Root, current%metadataID, & + Found, RC, desc=desc, units=units, & + rank=rank, type=type, vloc=vloc ) + ! TODO: need to add found to outputs of get_metadata_state_met + ELSEIF ( TRIM(current%state) == 'CHEM' ) THEN + isCHEM = .TRUE. + CALL Get_Metadata_State_Chm( am_I_Root, current%metadataID, & + Found, RC, desc=desc, units=units, & + rank=rank, type=type, vloc=vloc ) + ELSEIF ( TRIM(current%state) == 'DIAG' ) THEN + isDIAG = .TRUE. + CALL Get_Metadata_State_Diag( am_I_Root, current%metadataID, & + Found, RC, desc=desc, units=units, & + rank=rank, srcType=type, vloc=vloc ) + ELSE + RC = GC_FAILURE + ErrMsg = "Unknown state of item " // TRIM(current%name) // & + " in DiagList: " // TRIM(current%state) + EXIT + ENDIF + + IF ( .NOT. Found ) THEN + RC = GC_FAILURE + ErrMsg = "Metadata not found for " // TRIM(current%name) // & + " in state " // TRIM(current%state) + EXIT + ENDIF + + ! If wildcard is present + IF ( current%isWildcard ) THEN + ! Do nothing. This should never happen at this point since + ! Init_DiagList will exit with an error if wildcard is + ! encountered in HISTORY.rc while compiling with ESMF_. + + ! When it comes time to implement, create exports in a loop, + ! either for all species or for advected species only. Include + ! a check that the export was not already created. Loop over + ! AdvNames if wildcard is ADV. Loop over SpecNames for all other + ! cases, passing not found = OK so that not all are necessarily + ! output. Later on, after species database is initialized, exports + ! for only species in the specific wildcard will be associated + ! with data and thus included in the output file. + + ! If the meantime, skip wildcards if it gets here. + current => current%next + CYCLE + ENDIF + + ! If this item is for a specific tag, append description. + ! This will need revisiting since there may be tag-dependent + ! strings to append to long names + IF ( current%isTagged ) THEN + desc = TRIM(desc) // " for " // TRIM(current%tag) + ENDIF + + ! Create a new HistoryExportObj object + CALL Init_HistoryExport( am_I_Root, NewHistExp, & + name=current%name, & + metadataID=current%metadataID, & + registryID=current%registryID, & + long_name=desc, & + units=units, & + vloc=vloc, & + rank=rank, & + type=type, & + isMet=isMet, & + isChem=isChem, & + isDiag=isDiag, & + RC=RC ) + IF ( RC == GC_FAILURE ) THEN + ErrMsg = "History export init fail for " // TRIM(current%name) + EXIT + ENDIF + + ! Add new HistoryExportObj to linked list + CALL Append_HistoryExportsList( am_I_Root, NewHistExp, & + HistoryConfig, RC ) + IF ( RC == GC_FAILURE ) THEN + ErrMsg = "History export append fail for " // TRIM(current%name) + EXIT + ENDIF + + ! Set up for next item in DiagList + current => current%next + + ENDDO + current => NULL() + + IF ( RC == GC_SUCCESS ) THEN + HistoryConfig%ConfigFileRead = .TRUE. + ELSE + CALL GC_ERROR( ErrMsg, RC, Iam ) + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + + END SUBROUTINE Init_HistoryExportsList +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Init_HistoryExport +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Init_HistoryExport ( am_I_Root, NewHistExp, name, & + metadataID, registryID, long_name, & + units, vloc, rank, & + type, isMet, isChem, & + isDiag, RC ) +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root +! +! !OUTPUT PARAMETERS: +! + TYPE(HistoryExportObj), POINTER :: NewHistExp + CHARACTER(LEN=*), OPTIONAL :: name + CHARACTER(LEN=*), OPTIONAL :: metadataID + CHARACTER(LEN=*), OPTIONAL :: registryID + CHARACTER(LEN=*), OPTIONAL :: long_name + CHARACTER(LEN=*), OPTIONAL :: units + INTEGER, OPTIONAL :: vloc + INTEGER, OPTIONAL :: rank + INTEGER, OPTIONAL :: type + LOGICAL, OPTIONAL :: isMet + LOGICAL, OPTIONAL :: isChem + LOGICAL, OPTIONAL :: isDiag + INTEGER, OPTIONAL :: RC +! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC + __Iam__('Init_HistoryExport (geoschem_history_mod.F90)') + RC = GC_SUCCESS + ALLOCATE(NewHistExp) + + IF ( PRESENT( name ) ) THEN + NewHistExp%name = TRIM(name) + ELSE + NewHistExp%name = '' + ENDIF + + IF ( PRESENT( metaDataId ) ) THEN + NewHistExp%metadataID = TRIM(metadataID) + ELSE + NewHistExp%metadataID = '' + ENDIF + + IF ( PRESENT( registryId ) ) THEN + NewHistExp%registryID = TRIM(registryID) + ELSE + NewHistExp%registryId = '' + ENDIF + + IF ( PRESENT( long_name ) ) THEN + NewHistExp%long_name = TRIM(long_name) + ELSE + NewHistExp%long_name = '' + ENDIF + + IF ( PRESENT( units ) ) THEN + NewHistExp%units = TRIM(units) + ELSE + NewHistExp%units = '' + ENDIF + + IF ( PRESENT( vloc ) ) THEN + NewHistExp%vloc = vloc + ELSE + NewHistExp%vloc = -1 + ENDIF + + IF ( PRESENT( rank ) ) THEN + NewHistExp%rank = rank + ELSE + NewHistExp%rank = -1 + ENDIF + + IF ( PRESENT( type ) ) THEN + NewHistExp%type = type + ELSE + NewHistExp%type = -1 + ENDIF + + IF ( PRESENT( isMet ) ) THEN + NewHistExp%isMet = isMet + ELSE + NewHistExp%isMet = .FALSE. + ENDIF + + IF ( PRESENT( isChem ) ) THEN + NewHistExp%isChem = isChem + ELSE + NewHistExp%isChem = .FALSE. + ENDIF + + IF ( PRESENT( isDiag ) ) THEN + NewHistExp%isDiag = isDiag + ELSE + NewHistExp%isDiag = .FALSE. + ENDIF + + NewHistExp%next => NULL() + NewHistExp%GCStateData0d => NULL() + NewHistExp%GCStateData1d => NULL() + NewHistExp%GCStateData2d => NULL() + NewHistExp%GCStateData3d => NULL() + NewHistExp%GCStateData0d_4 => NULL() + NewHistExp%GCStateData1d_4 => NULL() + NewHistExp%GCStateData2d_4 => NULL() + NewHistExp%GCStateData3d_4 => NULL() + NewHistExp%GCStateData0d_8 => NULL() + NewHistExp%GCStateData1d_8 => NULL() + NewHistExp%GCStateData2d_8 => NULL() + NewHistExp%GCStateData3d_8 => NULL() + NewHistExp%GCStateData0d_I => NULL() + NewHistExp%GCStateData1d_I => NULL() + NewHistExp%GCStateData2d_I => NULL() + NewHistExp%GCStateData3d_I => NULL() + + END SUBROUTINE Init_HistoryExport +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Append_HistoryExportsList +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Append_HistoryExportsList ( am_I_Root, HistoryExport, & + HistoryConfig, RC ) +! +! !USES: +! +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root + TYPE(HistoryExportObj), POINTER :: HistoryExport +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC +! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + TYPE(HistoryExportObj), POINTER :: NewHistExp + + ! ================================================================ + ! Append_HistoryExportsList begins here + ! ================================================================ + __Iam__('Append_HistoryExportsList (geoschem_history_mod.F90)') + RC = GC_SUCCESS + + ! Add new object to the beginning of the linked list + HistoryExport%next => HistoryConfig%HistoryExportsList%head + HistoryConfig%HistoryExportsList%head => HistoryExport + + ! Update # of list items + HistoryConfig%HistoryExportsList%numExports = & + HistoryConfig%HistoryExportsList%numExports + 1 + + END SUBROUTINE Append_HistoryExportsList +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Check_HistoryExportsList +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Check_HistoryExportsList ( am_I_Root, name, & + ExportsList, found, RC ) +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root + CHARACTER(LEN=*), INTENT(IN) :: name + TYPE(HistoryExportsListObj), POINTER :: ExportsList +! +! !OUTPUT PARAMETERS: +! + LOGICAL, INTENT(OUT) :: found + INTEGER, INTENT(OUT) :: RC +! +! !REVISION HISTORY: +! 12 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + TYPE(HistoryExportObj), POINTER :: current + + __Iam__('Check_HistoryExportsList (geoschem_history_mod.F90)') + RC = GC_SUCCESS + + ! Assume not found + found = .False. + + current => ExportsList%head + DO WHILE ( ASSOCIATED( current ) ) + IF ( current%name == name ) THEN + found = .TRUE. + RETURN + ENDIF + current => current%next + ENDDO + current => NULL() + + END SUBROUTINE Check_HistoryExportsList +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: HistoryExports_SetServices +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE HistoryExports_SetServices( am_I_Root, config_file, & + HistoryConfig, RC ) +! +! !USES: +! + ! CAM modules + USE cam_history, ONLY : addfld, add_default, horiz_only + + ! GEOS-Chem modules + USE Registry_Params_Mod, ONLY : VLocationCenter, VLocationEdge +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root + CHARACTER(LEN=*), INTENT(IN) :: config_file +! +! !INPUT AND OUTPUT PARAMETERS: +! + +! +! !OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig ! History config object + INTEGER, INTENT(OUT) :: RC +! +! !REMARKS: +! ! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version for GCHP/GEOS +! 19 Oct 2022 - H.P. Lin - Adapted for CESM +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=255) :: ErrMsg + TYPE(HistoryExportObj), POINTER :: current + + ! ================================================================ + ! HistoryExports_SetServices begins here + ! ================================================================ + + ! For error handling (defines Iam and STATUS) + __Iam__('HistoryExports_SetServices (geoschem_history_mod.F90)') + RC = GC_SUCCESS + + ! Create a config object if it does not already exist + IF ( .NOT. ASSOCIATED(HistoryConfig) ) THEN + CALL Init_HistoryConfig( am_I_Root, HistoryConfig, config_file, RC ) + IF ( RC == GC_FAILURE ) THEN + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + ENDIF + + ! Loop over the History Exports list to add one export per item + IF ( am_I_Root ) THEN + WRITE(6,*) " " + WRITE(6,*) "Adding history variables to CAM History State:" + ENDIF + current => HistoryConfig%HistoryExportsList%head + DO WHILE ( ASSOCIATED( current ) ) + IF ( am_I_Root ) PRINT *, "adding export: ", TRIM(current%name) + ! Create an export for this item + IF ( current%rank == 3 ) THEN + IF ( current%vloc == VLocationCenter ) THEN + CALL addfld(trim(current%name), & + (/'lev'/), & + 'I', & + trim(current%units), & + trim(current%long_name) ) + IF ( RC == GC_FAILURE ) THEN + ErrMsg = "Problem adding 3D export for " // TRIM(current%name) + EXIT + ENDIF + ELSEIF ( current%vloc == VLocationEdge ) THEN + CALL addfld(trim(current%name), & + (/'ilev'/), & + 'I', & + trim(current%units), & + trim(current%long_name) ) + ELSE + IF ( am_I_Root ) THEN + PRINT *, "Unknown vertical location for ", & + TRIM(current%name) + ENDIF + ENDIF + ELSEIF ( current%rank == 2 ) THEN + CALL addfld(trim(current%name), & + horiz_only, & + 'I', & + trim(current%units), & + trim(current%long_name) ) + IF ( RC == GC_FAILURE ) THEN + ErrMsg = "Problem adding 2D export for " // TRIM(current%name) + EXIT + ENDIF + ELSE + RC = GC_FAILURE + ErrMsg = "Problem adding export for " // TRIM(current%name) // & + ". Rank is only implemented for 2 or 3!" + EXIT + ENDIF + + current => current%next + ENDDO + current => NULL() + + IF ( RC == GC_FAILURE ) THEN + CALL GC_ERROR( ErrMsg, RC, Iam ) + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + + END SUBROUTINE HistoryExports_SetServices +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: CopyGCStates2Exports +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE CopyGCStates2Exports( am_I_Root, Input_Opt, State_Grid, HistoryConfig, LCHNK, RC ) +! +! !USES: +! + ! CAM modules + USE cam_history, ONLY : hist_fld_active, outfld + USE shr_kind_mod, ONLY : shr_kind_r8 + + ! GEOS-Chem modules + USE HCO_Interface_GC_Mod, ONLY : HCOI_GC_WriteDiagn + USE Input_Opt_Mod, ONLY : OptInput + USE State_Grid_Mod, ONLY : GrdState +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root + TYPE(OptInput), INTENT(IN) :: Input_Opt + TYPE(GrdState), INTENT(IN) :: State_Grid + INTEGER, INTENT(IN) :: LCHNK ! Chunk number for CESM +! +! !INPUT AND OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig ! History config object +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC +! +! !REMARKS: +! ! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version for GCHP/GEOS +! 19 Oct 2022 - H.P. Lin - Adapted for CESM +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + INTEGER :: LMAX + CHARACTER(LEN=255) :: ErrMsg + TYPE(HistoryExportObj), POINTER :: current + + ! Temporaries for CAM exports. + ! Note that in CESM, State_Grid%NX is always length 1. (hplin, 11/16/22) + REAL(shr_kind_r8) :: outTmp_3D(State_Grid%NY, State_Grid%NZ) + REAL(shr_kind_r8) :: outTmp_2D(State_Grid%NY) + + ! ================================================================ + ! CopyGCStates2Exports begins here + ! ================================================================ + __Iam__('CopyGCStates2Exports (geoschem_history_mod.F90)') + RC = GC_SUCCESS + + ! Loop over the History Exports list + current => HistoryConfig%HistoryExportsList%head + DO WHILE ( ASSOCIATED( current ) ) + ! Skip if not active + if(.not. hist_fld_active(trim(current%name))) then + current => current%next + cycle + endif + + ! if (am_I_Root) THEN + ! print *, ' Copying ' // TRIM(current%name) + ! endif + IF ( current%rank == 2 ) THEN + IF ( ASSOCIATED( current%GCStateData2d ) ) THEN + outTmp_2D(1:State_Grid%NY) = current%GCStateData2d(1,1:State_Grid%NY) + ELSE IF ( ASSOCIATED( current%GCStateData2d_4 ) ) THEN + outTmp_2D(1:State_Grid%NY) = current%GCStateData2d_4(1,1:State_Grid%NY) + ELSE IF ( ASSOCIATED( current%GCStateData2d_8 ) ) THEN + outTmp_2D(1:State_Grid%NY) = current%GCStateData2d_8(1,1:State_Grid%NY) + ELSE IF ( ASSOCIATED( current%GCStateData2d_I ) ) THEN + ! Convert integer to float (integers not allowed in MAPL exports) + outTmp_2D(1:State_Grid%NY) = FLOAT(current%GCStateData2d_I(1,1:State_Grid%NY)) + ELSE + RC = GC_FAILURE + ErrMsg = "No GC 2D pointer found for " // TRIM(current%name) + EXIT + ENDIF + + ! Now call outfld to output for this chunk + call outfld(trim(current%name), & + outTmp_2D, & ! Chunk width always 1 + State_Grid%NY, & + LCHNK ) + ELSEIF ( current%rank == 3 ) THEN + IF ( ASSOCIATED( current%GCStateData3d ) ) THEN + outTmp_3D(1:State_Grid%NY, :) = current%GCStateData3d(1,1:State_Grid%NY,:) + ELSE IF ( ASSOCIATED( current%GCStateData3d_4 ) ) THEN + outTmp_3D(1:State_Grid%NY, :) = current%GCStateData3d_4(1,1:State_Grid%NY,:) + ELSE IF ( ASSOCIATED( current%GCStateData3d_8 ) ) THEN + outTmp_3D(1:State_Grid%NY, :) = current%GCStateData3d_8(1,1:State_Grid%NY,:) + ELSE IF ( ASSOCIATED( current%GCStateData3d_I ) ) THEN + outTmp_3D(1:State_Grid%NY, :) = FLOAT(current%GCStateData3d_I(1,1:State_Grid%NY,:)) + ELSE + RC = GC_FAILURE + ErrMsg = "No GC 3D pointer found for " // TRIM(current%name) + EXIT + ENDIF +#if defined( MODEL_CESM ) + ! If using GEOS-5, flip the data vertically to match model + ! convention + ! Also do this in CESM. (hplin, 10/31/22) + LMAX = SIZE(outTmp_3D, 2) + outTmp_3D(:,1:LMAX) = outTmp_3D(:,LMAX:1:-1) +#endif + + ! Now call outfld to output for this chunk + call outfld(trim(current%name), & + outTmp_3D, & ! Chunk width always 1. TOA is 1 + State_Grid%NY, & + LCHNK ) + ENDIF + + current => current%next + ENDDO + current => NULL() + + ! Error handling + IF ( RC == GC_FAILURE ) THEN + CALL GC_ERROR( ErrMsg, RC, Iam ) + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + END SUBROUTINE CopyGCStates2Exports +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Print_HistoryExportsList +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Print_HistoryExportsList( am_I_Root, HistoryConfig, RC ) +! +! !USES: +! +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root +! +! !INPUT AND OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig ! History config object +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC +! +! !REMARKS: +! ! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + TYPE(HistoryExportObj), POINTER :: current + + ! ================================================================ + ! Print_HistoryExportsList begins here + ! ================================================================ + __Iam__('Print_HistoryExportsList (geoschem_history_mod.F90)') + RC = GC_SUCCESS + + ! Loop over the History Exports list + current => HistoryConfig%HistoryExportsList%head + IF ( am_I_Root ) PRINT *, '===========================' + IF ( am_I_Root ) PRINT *, 'History Exports List:' + IF ( am_I_Root ) PRINT *, ' ' + DO WHILE ( ASSOCIATED( current ) ) + IF ( am_I_Root ) THEN + PRINT *, "Name: ", TRIM(current%name) + PRINT *, " MetadataID: ", TRIM(current%metadataID) + PRINT *, " RegistryID: ", TRIM(current%registryID) + PRINT *, " Long name: ", TRIM(current%long_name) + PRINT *, " Units: ", TRIM(current%units) + PRINT *, " Vert loc: ", current%vloc + PRINT *, " Rank: ", current%rank + PRINT *, " Type: ", current%type + PRINT *, " isMet: ", current%isMet + PRINT *, " isChem: ", current%isChem + PRINT *, " isDiag: ", current%isDiag + PRINT *, " " + ENDIF + current => current%next + ENDDO + IF ( am_I_Root ) PRINT *, '===========================' + current => NULL() + + END SUBROUTINE Print_HistoryExportsList +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: HistoryExports_SetDataPointers +! +! !DESCRIPTION: +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE HistoryExports_SetDataPointers( am_I_Root, & + HistoryConfig, State_Chm, & + State_Grid, & + State_Diag, State_Met, & + RC ) +! +! !USES: +! + ! CAM modules + USE cam_history, ONLY : hist_fld_active + + ! GEOS-Chem modules + USE Registry_Mod, ONLY : Registry_Lookup + USE State_Chm_Mod, ONLY : ChmState + USE State_Diag_Mod, ONLY : DgnState + USE State_Grid_Mod, ONLY : GrdState + USE State_Met_Mod, ONLY : MetState +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root +! +! !INPUT AND OUTPUT PARAMETERS: +! + TYPE(HistoryConfigObj), POINTER :: HistoryConfig ! History config obj + TYPE(GrdState), INTENT(INOUT) :: State_Grid ! Grid State obj + TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State obj + TYPE(MetState), INTENT(INOUT) :: State_Met ! Meteorology State obj + TYPE(DgnState), INTENT(INOUT) :: State_Diag ! Diagnostics State obj +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC +! +! !REMARKS: +! ! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=255) :: ErrMsg + TYPE(HistoryExportObj), POINTER :: current + + ! ================================================================ + ! HistoryExports_SetDataPointers begins here + ! ================================================================ + __Iam__('HistoryExports_SetDataPointers') + RC = GC_SUCCESS + + IF ( am_I_Root ) THEN + WRITE(6,*) " " + WRITE(6,*) "Setting history variable pointers to GC and Export States" + ENDIF + + ! Loop over the History Exports list + current => HistoryConfig%HistoryExportsList%head + DO WHILE ( ASSOCIATED( current ) ) + ! Skip if not active + if(.not. hist_fld_active(trim(current%name))) then + current => current%next + cycle + endif + + ! Get pointer to GC state data + !IF ( am_I_Root ) WRITE(6,*) current%name + IF ( current%isMET ) THEN + CALL Registry_Lookup( am_I_Root = am_I_Root, & + Registry = State_Met%Registry, & + RegDict = State_Met%RegDict, & + State = State_Met%State, & + Variable = current%registryID, & + Ptr2d_4 = current%GCStateData2d_4, & + Ptr2d_8 = current%GCStateData2d_8, & + Ptr2d_I = current%GCStateData2d_I, & + Ptr3d_4 = current%GCStateData3d_4, & + Ptr3d_8 = current%GCStateData3d_8, & + Ptr3d_I = current%GCStateData3d_I, & + RC = RC ) + ELSEIF ( current%isChem ) THEN + CALL Registry_Lookup( am_I_Root = am_I_Root, & + Registry = State_Chm%Registry, & + RegDict = State_Chm%RegDict, & + State = State_Chm%State, & + Variable = current%registryID, & + Ptr2d_4 = current%GCStateData2d_4, & + Ptr2d_8 = current%GCStateData2d_8, & + Ptr2d_I = current%GCStateData2d_I, & + Ptr3d_4 = current%GCStateData3d_4, & + Ptr3d_8 = current%GCStateData3d_8, & + Ptr3d_I = current%GCStateData3d_I, & + RC = RC ) + ELSEIF ( current%isDiag ) THEN + CALL Registry_Lookup( am_I_Root = am_I_Root, & + Registry = State_Diag%Registry, & + RegDict = State_Diag%RegDict, & + State = State_Diag%State, & + Variable = current%registryID, & + Ptr2d_4 = current%GCStateData2d_4, & + Ptr2d_8 = current%GCStateData2d_8, & + Ptr2d_I = current%GCStateData2d_I, & + Ptr3d_4 = current%GCStateData3d_4, & + Ptr3d_8 = current%GCStateData3d_8, & + Ptr3d_I = current%GCStateData3d_I, & + RC = RC ) + ENDIF + IF ( RC == GC_FAILURE ) THEN + ErrMsg = "Registry pointer not found for " // TRIM(current%name) // & + ". Check that the tag (e.g. species) is valid " // & + "for this diagnostic." + EXIT + ENDIF + + !! debugging + !IF ( Am_I_Root) THEN + ! WRITE(6,*) TRIM(current%name) + !ENDIF + + current => current%next + ENDDO + current => NULL() + + ! Optional debugging + !WRITE(6,*) "hplin debug: after HistoryExports_SetDataPointers" + !CALL Print_HistoryExportsList( am_I_Root, HistoryConfig, RC ) + + IF ( RC == GC_FAILURE ) THEN + CALL GC_ERROR( ErrMsg, RC, Iam ) + _ASSERT(.FALSE., 'informative message here') + RETURN + ENDIF + + END SUBROUTINE HistoryExports_SetDataPointers +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Destroy_HistoryConfig +! +! !DESCRIPTION: Subroutine Destroy_HistoryConfig deallocates a HistoryConfig +! object and all of its member objects including the linked list of +! HistoryExport objects. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Destroy_HistoryConfig ( am_I_Root, HistoryConfig, RC ) +! +! !INPUT PARAMETERS: +! + LOGICAL, INTENT(IN) :: am_I_Root ! root CPU? + TYPE(HistoryConfigObj), POINTER :: HistoryConfig +! +! !INPUT/OUTPUT PARAMETERS: +! + INTEGER, INTENT(INOUT) :: RC ! Success? +! +! !REVISION HISTORY: +! 01 Sep 2017 - E. Lundgren - Initial version +! See https://github.com/geoschem/geos-chem for history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + TYPE(HistoryExportObj), POINTER :: current + TYPE(HistoryExportObj), POINTER :: next + + ! ================================================================ + ! Destroy_HistoryConfig begins here + ! ================================================================ + __Iam__('Destroy_HistoryConfig (geoschem_history_mod.F90)') + + current => NULL() + next => NULL() + + ! Destroy each item in the linked list of HistoryExport objects + current => HistoryConfig%HistoryExportsList%head + IF ( ASSOCIATED( current ) ) next => current%next + DO WHILE ( ASSOCIATED( current ) ) + DEALLOCATE( current, STAT=RC ) + _ASSERT( RC == GC_SUCCESS, 'informative message here' ) + IF ( .NOT. ASSOCIATED ( next ) ) EXIT + current => next + next => current%next + ENDDO + + ! Deallocate the HistoryExportsList object + DEALLOCATE( HistoryConfig%HistoryExportsList, STAT=RC ) + _ASSERT( RC == GC_SUCCESS, 'informative message here' ) + + ! Deallocate the HistoryConfig object + DEALLOCATE( HistoryConfig, STAT=RC ) + _ASSERT( RC == GC_SUCCESS, 'informative message here' ) + + ! Final cleanup + current => NULL() + next => NULL() + + END SUBROUTINE Destroy_HistoryConfig +!EOC +END MODULE GeosChem_History_Mod diff --git a/src/chemistry/geoschem/geoschem_src b/src/chemistry/geoschem/geoschem_src new file mode 160000 index 0000000000..bef56c605e --- /dev/null +++ b/src/chemistry/geoschem/geoschem_src @@ -0,0 +1 @@ +Subproject commit bef56c605e018eecbd91646a51ce82c7cd77f56a diff --git a/src/chemistry/geoschem/m_spc_id.F90 b/src/chemistry/geoschem/m_spc_id.F90 new file mode 100644 index 0000000000..14a949048d --- /dev/null +++ b/src/chemistry/geoschem/m_spc_id.F90 @@ -0,0 +1,3 @@ + module m_spc_id + implicit none + end module m_spc_id diff --git a/src/chemistry/geoschem/mo_sim_dat.F90 b/src/chemistry/geoschem/mo_sim_dat.F90 new file mode 100644 index 0000000000..0d52edc2e3 --- /dev/null +++ b/src/chemistry/geoschem/mo_sim_dat.F90 @@ -0,0 +1,458 @@ + + 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(:) = (/ 30, 0, 0, 191, 0 /) + + ! cls_rxt_cnt(:,1) = (/ 37, 61, 0, 30 /) + ! cls_rxt_cnt(:,4) = (/ 23, 174, 326, 191 /) + + ! GEOS-Chem tracers (advected species) are placed before MAM + ! aerosols which are also constituents. MAM requires that there + ! is a linear mapping between solsym and constituents + + ! note: + ! - solsym and adv_mass here, + ! - gas_pcnst, nTracersMax, nSlvd in chem_mods.F90, + ! - chem_nadv in bld/configure (clean all needed after change) + ! and .xml files for dry and wet deposition lists, should be updated + ! programmatically using https://github.com/jimmielin/geos-chem-coupling-tools + ! from a species .yml file generated by a corresponding GEOS-Chem "Classic" simulation. + ! + ! editing of these lists manually may be error prone. + ! solsym contains, in order: + ! - GEOS-Chem advected species. The order of these must match exactly as specified in + ! geoschem_config.yml. + ! - MAM aerosols (33 in MAM4; hardcoded in chem_readnl of geoschem/chemistry.F90) + ! these are the 4 modes for bc (black carbon), dst (dust), ncl (NaCl, seasalt), + ! pom (primary organic matter), SOA, SO4 (sulfate), and + ! number concentration, + ! plus H2SO4, SOAG0-4, for MAM4. + ! - CO2, and + ! - GEOS-Chem non-advected species, as specified in gckpp_Parameters.F90. (hplin, 6/24/24) + solsym(:357) = (/ & + 'ACET ', 'ACTA ', 'AERI ', & + 'ALD2 ', 'ALK4 ', 'AONITA ', & + 'AROMP4 ', 'AROMP5 ', 'ASOA1 ', & + 'ASOA2 ', 'ASOA3 ', 'ASOAN ', & + 'ASOG1 ', 'ASOG2 ', 'ASOG3 ', & + 'ATOOH ', 'BALD ', 'BCPI ', & + 'BCPO ', 'BENZ ', 'BENZP ', & + 'BR ', 'BR2 ', 'BRCL ', & + 'BRNO2 ', 'BRNO3 ', 'BRO ', & + 'BRSALA ', 'BRSALC ', 'BUTDI ', & + 'BZCO3H ', 'BZPAN ', 'C2H2 ', & + 'C2H4 ', 'C2H6 ', 'C3H8 ', & + 'CCL4 ', 'CFC11 ', 'CFC113 ', & + 'CFC114 ', 'CFC115 ', 'CFC12 ', & + 'CH2BR2 ', 'CH2CL2 ', 'CH2I2 ', & + 'CH2IBR ', 'CH2ICL ', 'CH2O ', & + 'CH3BR ', 'CH3CCL3 ', 'CH3CL ', & + 'CH3I ', 'CH4 ', 'CHBR3 ', & + 'CHCL3 ', 'CL ', 'CL2 ', & + 'CL2O2 ', 'CLNO2 ', 'CLNO3 ', & + 'CLO ', 'CLOO ', 'CLOCK ', & + 'CO ', 'CSL ', 'DMS ', & + 'DST1 ', 'DST2 ', 'DST3 ', & + 'DST4 ', 'EOH ', 'ETHLN ', & + 'ETHN ', 'ETHP ', 'ETNO3 ', & + 'ETP ', 'FURA ', 'GLYC ', & + 'GLYX ', 'H1211 ', 'H1301 ', & + 'H2402 ', 'H2O ', 'H2O2 ', & + 'HAC ', 'HBR ', 'HC5A ', & + 'HCFC123 ', 'HCFC141B ', 'HCFC142B ', & + 'HCFC22 ', 'HCL ', 'HCOOH ', & + 'HI ', 'HMHP ', 'HMML ', & + 'HMS ', 'HNO2 ', 'HNO3 ', & + 'HNO4 ', 'HOBR ', 'HOCL ', & + 'HOI ', 'HONIT ', 'HPALD1 ', & + 'HPALD2 ', 'HPALD3 ', 'HPALD4 ', & + 'HPETHNL ', 'I ', 'I2 ', & + 'I2O2 ', 'I2O3 ', 'I2O4 ', & + 'IBR ', 'ICHE ', 'ICL ', & + 'ICN ', 'ICPDH ', 'IDC ', & + 'IDCHP ', 'IDHDP ', 'IDHPE ', & + 'IDN ', 'IEPOXA ', 'IEPOXB ', & + 'IEPOXD ', 'IHN1 ', 'IHN2 ', & + 'IHN3 ', 'IHN4 ', 'INDIOL ', & + 'INO ', 'INPB ', 'INPD ', & + 'IO ', 'IONITA ', 'IONO ', & + 'IONO2 ', 'IPRNO3 ', 'ISALA ', & + 'ISALC ', 'ISOP ', 'ITCN ', & + 'ITHN ', 'LIMO ', 'LVOC ', & + 'LVOCOA ', 'MACR ', 'MACR1OOH ', & + 'MAP ', 'MCRDH ', 'MCRENOL ', & + 'MCRHN ', 'MCRHNB ', 'MCRHP ', & + 'MCT ', 'MEK ', 'MENO3 ', & + 'MGLY ', 'MOH ', 'MONITA ', & + 'MONITS ', 'MONITU ', 'MP ', & + 'MPAN ', 'MPN ', 'MSA ', & + 'MTPA ', 'MTPO ', 'MVK ', & + 'MVKDH ', 'MVKHC ', 'MVKHCB ', & + 'MVKHP ', 'MVKN ', 'MVKPC ', & + 'N2O ', 'N2O5 ', 'NH3 ', & + 'NH4 ', 'NIT ', 'NITS ', & + 'NO ', 'NO2 ', 'NO3 ', & + 'NPHEN ', 'NPRNO3 ', 'O3 ', & + 'OCLO ', 'OCPI ', 'OCPO ', & + 'OCS ', 'OIO ', 'PAN ', & + 'PFE ', 'PHEN ', 'PIP ', & + 'PP ', 'PPN ', 'PROPNN ', & + 'PRPE ', 'PRPN ', 'PYAC ', & + 'R4N2 ', 'R4P ', 'RA3P ', & + 'RB3P ', 'RCHO ', 'RIPA ', & + 'RIPB ', 'RIPC ', 'RIPD ', & + 'RP ', 'SALA ', 'SALAAL ', & + 'SALACL ', 'SALC ', 'SALCAL ', & + 'SALCCL ', 'SO2 ', 'SO4 ', & + 'SO4S ', 'SOAGX ', 'SOAIE ', & + 'TOLU ', 'TSOA0 ', 'TSOA1 ', & + 'TSOA2 ', 'TSOA3 ', 'TSOG0 ', & + 'TSOG1 ', 'TSOG2 ', 'TSOG3 ', & + 'XYLE ', '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 ', & + 'soa1_a1 ', 'soa1_a2 ', 'soa2_a1 ', & + 'soa2_a2 ', 'soa3_a1 ', 'soa3_a2 ', & + 'soa4_a1 ', 'soa4_a2 ', 'soa5_a1 ', & + 'soa5_a2 ', 'H2SO4 ', 'SOAG0 ', & + 'SOAG1 ', 'SOAG2 ', 'SOAG3 ', & + 'SOAG4 ', 'A3O2 ', 'AROMRO2 ', & + 'ATO2 ', 'B3O2 ', 'BENZO ', & + 'BENZO2 ', 'BRO2 ', 'BZCO3 ', & + 'C4HVP1 ', 'C4HVP2 ', 'CH2OO ', & + 'CH3CHOO ', 'CO2 ', 'ETO ', & + 'ETO2 ', 'ETOO ', 'H ', & + 'H2 ', 'HO2 ', 'HPALD1OO ', & + 'HPALD2OO ', 'ICHOO ', 'ICNOO ', & + 'IDHNBOO ', 'IDHNDOO1 ', 'IDHNDOO2 ', & + 'IDNOO ', 'IEPOXAOO ', 'IEPOXBOO ', & + 'IHOO1 ', 'IHOO4 ', 'IHPNBOO ', & + 'IHPNDOO ', 'IHPOO1 ', 'IHPOO2 ', & + 'IHPOO3 ', 'INA ', 'INO2B ', & + 'INO2D ', 'ISOPNOO1 ', 'ISOPNOO2 ', & + 'KO2 ', 'LBRO2H ', 'LBRO2N ', & + 'LCH4 ', 'LCO ', 'LIMO2 ', & + 'LISOPNO3 ', 'LISOPOH ', 'LNRO2H ', & + 'LNRO2N ', 'LOX ', 'LTRO2H ', & + 'LTRO2N ', 'LXRO2H ', 'LXRO2N ', & + 'MACR1OO ', 'MACRNO2 ', 'MCO3 ', & + 'MCROHOO ', 'MO2 ', 'MVKOHOO ', & + 'N ', 'N2 ', 'NAP ', & + 'NRO2 ', 'O ', 'O1D ', & + 'O2 ', 'OH ', 'OLND ', & + 'OLNN ', 'OTHRO2 ', 'PCO ', & + 'PH2O2 ', 'PH2SO4 ', 'PIO2 ', & + 'PO2 ', 'POX ', 'PRN1 ', & + 'PSO4 ', 'PSO4AQ ', 'R4N1 ', & + 'R4O2 ', 'RCO3 ', 'RCOOH ', & + 'ROH ', 'TRO2 ', 'XRO2 ' & + /) + + inv_lst(: 6) = (/ 'M ', 'N2 ', 'O2 ', & + 'H2 ', 'MOH ', 'RCOOH ' /) + + fix_mass(: 6) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 2.020000_r8, 32.050000_r8, & + 74.090000_r8 /) + + adv_mass(:357) = (/ & + 58.09_r8, 60.06_r8, 126.9_r8, & + 44.06_r8, 58.12_r8, 189.12_r8, & + 68.08_r8, 98.1_r8, 150.0_r8, & + 150.0_r8, 150.0_r8, 150.0_r8, & + 150.0_r8, 150.0_r8, 150.0_r8, & + 90.09_r8, 106.12_r8, 12.01_r8, & + 12.01_r8, 78.12_r8, 110.11_r8, & + 79.9_r8, 159.8_r8, 115.45_r8, & + 125.91_r8, 141.91_r8, 95.9_r8, & + 79.9_r8, 79.9_r8, 84.07_r8, & + 138.12_r8, 183.12_r8, 26.05_r8, & + 28.05_r8, 30.08_r8, 44.11_r8, & + 153.82_r8, 137.37_r8, 187.38_r8, & + 170.92_r8, 154.47_r8, 120.91_r8, & + 173.83_r8, 84.93_r8, 267.84_r8, & + 220.84_r8, 176.38_r8, 30.03_r8, & + 94.94_r8, 133.35_r8, 50.45_r8, & + 141.94_r8, 16.04_r8, 252.73_r8, & + 119.35_r8, 35.45_r8, 70.9_r8, & + 102.91_r8, 81.45_r8, 97.45_r8, & + 51.45_r8, 67.45_r8, 1.0_r8, & + 28.01_r8, 108.14_r8, 62.13_r8, & + 29.0_r8, 29.0_r8, 29.0_r8, & + 29.0_r8, 46.07_r8, 105.06_r8, & + 107.07_r8, 78.07_r8, 91.08_r8, & + 62.08_r8, 68.07_r8, 60.06_r8, & + 58.04_r8, 165.36_r8, 148.91_r8, & + 259.82_r8, 18.02_r8, 34.02_r8, & + 74.08_r8, 80.91_r8, 100.13_r8, & + 152.93_r8, 116.94_r8, 100.5_r8, & + 86.47_r8, 36.45_r8, 46.03_r8, & + 127.91_r8, 64.05_r8, 102.1_r8, & + 111.1_r8, 47.01_r8, 63.01_r8, & + 79.01_r8, 96.91_r8, 52.45_r8, & + 143.89_r8, 215.0_r8, 116.13_r8, & + 116.13_r8, 116.13_r8, 116.13_r8, & + 76.06_r8, 126.9_r8, 253.8_r8, & + 285.8_r8, 301.8_r8, 317.8_r8, & + 206.9_r8, 116.13_r8, 162.45_r8, & + 145.13_r8, 150.15_r8, 98.11_r8, & + 148.13_r8, 168.17_r8, 150.15_r8, & + 192.15_r8, 106.14_r8, 106.14_r8, & + 106.14_r8, 147.15_r8, 147.15_r8, & + 147.15_r8, 147.15_r8, 102.0_r8, & + 156.91_r8, 163.15_r8, 163.15_r8, & + 142.9_r8, 14.01_r8, 172.91_r8, & + 188.91_r8, 105.11_r8, 126.9_r8, & + 126.9_r8, 68.13_r8, 195.15_r8, & + 197.17_r8, 136.26_r8, 154.19_r8, & + 154.19_r8, 70.1_r8, 102.1_r8, & + 76.06_r8, 104.12_r8, 86.1_r8, & + 149.11_r8, 149.11_r8, 120.12_r8, & + 124.0_r8, 72.11_r8, 77.05_r8, & + 72.07_r8, 32.05_r8, 14.01_r8, & + 215.28_r8, 215.28_r8, 48.05_r8, & + 147.1_r8, 93.05_r8, 96.1_r8, & + 136.26_r8, 136.26_r8, 70.09_r8, & + 105.13_r8, 102.1_r8, 102.1_r8, & + 120.12_r8, 149.12_r8, 118.1_r8, & + 44.02_r8, 108.02_r8, 17.04_r8, & + 18.05_r8, 62.01_r8, 31.4_r8, & + 30.01_r8, 46.01_r8, 62.01_r8, & + 139.11_r8, 105.11_r8, 48.0_r8, & + 67.45_r8, 12.01_r8, 12.01_r8, & + 60.07_r8, 158.9_r8, 121.06_r8, & + 55.85_r8, 94.11_r8, 186.28_r8, & + 92.11_r8, 135.08_r8, 119.08_r8, & + 42.09_r8, 137.11_r8, 88.07_r8, & + 119.1_r8, 90.14_r8, 76.11_r8, & + 76.11_r8, 58.09_r8, 118.15_r8, & + 118.15_r8, 118.15_r8, 118.15_r8, & + 90.09_r8, 31.4_r8, 31.4_r8, & + 35.45_r8, 31.4_r8, 31.4_r8, & + 35.45_r8, 64.04_r8, 96.06_r8, & + 31.4_r8, 58.04_r8, 118.15_r8, & + 92.15_r8, 150.0_r8, 150.0_r8, & + 150.0_r8, 150.0_r8, 150.0_r8, & + 150.0_r8, 150.0_r8, 150.0_r8, & + 106.18_r8, 12.011_r8, 12.011_r8, & + 135.064039_r8, 135.064039_r8, 135.064039_r8, & + 58.442468_r8, 58.442468_r8, 58.442468_r8, & + 1.0074_r8, 1.0074_r8, 1.0074_r8, & + 1.0074_r8, 12.011_r8, 12.011_r8, & + 115.10734_r8, 115.10734_r8, 115.10734_r8, & + 250.445_r8, 250.445_r8, 250.445_r8, & + 250.445_r8, 250.445_r8, 250.445_r8, & + 250.445_r8, 250.445_r8, 250.445_r8, & + 250.445_r8, 98.0784_r8, 250.445_r8, & + 250.445_r8, 250.445_r8, 250.445_r8, & + 250.445_r8, 75.1_r8, 127.0_r8, & + 89.08_r8, 75.1_r8, 93.0_r8, & + 109.0_r8, 159.13_r8, 137.0_r8, & + 103.11_r8, 103.11_r8, 46.03_r8, & + 60.06_r8, 44.01_r8, 61.06_r8, & + 61.07_r8, 77.06_r8, 1.01_r8, & + 2.02_r8, 33.01_r8, 147.12_r8, & + 147.12_r8, 149.14_r8, 194.14_r8, & + 196.16_r8, 196.16_r8, 196.16_r8, & + 241.14_r8, 149.14_r8, 149.14_r8, & + 117.14_r8, 117.14_r8, 212.16_r8, & + 212.16_r8, 167.16_r8, 167.16_r8, & + 167.16_r8, 146.14_r8, 162.14_r8, & + 162.14_r8, 196.16_r8, 196.16_r8, & + 101.09_r8, 159.13_r8, 159.13_r8, & + 16.04_r8, 28.01_r8, 185.27_r8, & + 68.13_r8, 68.13_r8, 159.17_r8, & + 159.17_r8, 48.0_r8, 173.16_r8, & + 173.16_r8, 187.19_r8, 187.19_r8, & + 101.09_r8, 180.1_r8, 75.05_r8, & + 119.11_r8, 47.04_r8, 119.11_r8, & + 14.01_r8, 28.02_r8, 128.18_r8, & + 159.17_r8, 16.0_r8, 16.0_r8, & + 32.0_r8, 17.01_r8, 230.27_r8, & + 230.27_r8, 61.07_r8, 28.01_r8, & + 34.02_r8, 96.06_r8, 185.27_r8, & + 91.1_r8, 48.0_r8, 136.09_r8, & + 96.06_r8, 96.06_r8, 150.13_r8, & + 89.13_r8, 89.08_r8, 74.09_r8, & + 60.11_r8, 173.16_r8, 187.19_r8 & + /) + + ! extfrc_lst contains a list of species that have 3-D emissions (distributed in the vertical by HEMCO) + ! frc_from_dataset (set to false) and extcnt in chem_mods.F90 also needs to be updated. (hplin, 6/24/24) + extfrc_lst(: 34) = (/ 'NO ', 'CO ', 'SO2 ', 'SO4 ', & + 'NH3 ', 'ACET ', 'ALD2 ', 'ALK4 ', & + 'C2H6 ', 'C3H8 ', 'CH2O ', 'PRPE ', & + 'MACR ', 'RCHO ', 'BCPI ', 'OCPI ', & + 'HNO2 ', 'NO2 ', 'so4_a1 ', 'num_a1 ', & + 'H2O ', 'bc_a4 ', 'pom_a4 ', 'num_a4 ', & + 'MEK ', 'POG1 ', 'POG2 ', 'MTPA ', & + 'BENZ ', 'TOLU ', 'XYLE ', 'NAP ', & + 'EOH ', 'MOH ' /) + + frc_from_dataset(: 34) = (/ .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false., .false., .false., & + .false., .false. /) + + ! crb_mass(:221) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + ! 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, 60.055000_r8, & + ! 48.044000_r8, 60.055000_r8, 60.055000_r8, 72.066000_r8, 60.055000_r8, & + ! 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + ! 0.000000_r8, 84.077000_r8, 84.077000_r8, 24.022000_r8, 24.022000_r8, & + ! 24.022000_r8, 24.022000_r8, 24.022000_r8, 36.033000_r8, 36.033000_r8, & + ! 36.033000_r8, 72.066000_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, 24.022000_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, 12.011000_r8, 12.011000_r8, & + ! 84.077000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + ! 12.011000_r8, 24.022000_r8, 0.000000_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, & + ! 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + ! 0.000000_r8, 0.000000_r8, 48.044000_r8, 60.055000_r8, 36.033000_r8, & + ! 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + ! 60.055000_r8, 60.055000_r8, 60.055000_r8, 156.143000_r8, 48.044000_r8, & + ! 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 120.110000_r8, & + ! 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 60.055000_r8, & + ! 60.055000_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, 120.110000_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, 84.077000_r8, 72.066000_r8, & + ! 72.066000_r8, 72.066000_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, 180.165000_r8, & + ! 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + ! 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + ! 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 12.011000_r8, & + ! 264.242000_r8, 84.077000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, & + ! 120.110000_r8, 108.099000_r8, 84.077000_r8, 84.077000_r8, 60.055000_r8, & + ! 96.088000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, 0.000000_r8, & + ! 0.000000_r8, 84.077000_r8, 60.055000_r8, 72.066000_r8, 84.077000_r8, & + ! 24.022000_r8, 36.033000_r8, 72.066000_r8, 24.022000_r8, 12.011000_r8, & + ! 60.055000_r8, 48.044000_r8, 24.022000_r8, 24.022000_r8, 0.000000_r8, & + ! 12.011000_r8, 60.055000_r8, 60.055000_r8, 48.044000_r8, 48.044000_r8, & + ! 48.044000_r8, 48.044000_r8, 48.044000_r8, 120.110000_r8, 0.000000_r8, & + ! 0.000000_r8, 72.066000_r8, 36.033000_r8, 36.033000_r8, 120.110000_r8, & + ! 120.110000_r8, 84.077000_r8, 60.055000_r8, 96.088000_r8, 96.088000_r8, & + ! 0.000000_r8 /) + + ! fix_mass(: 3) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8 /) + + ! clsmap(: 30,1) = (/ 3, 21, 33, 34, 35, 36, 37, 38, 39, 40, & + ! 41, 43, 44, 46, 54, 55, 61, 63, 71, 78, & + ! 82, 83, 84, 113, 122, 123, 148, 170, 185, 186 /) + ! clsmap(:191,4) = (/ 1, 2, 4, 5, 6, 7, 8, 9, 10, 11, & + ! 12, 13, 14, 15, 16, 17, 18, 19, 20, 22, & + ! 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, & + ! 42, 45, 47, 48, 49, 50, 51, 52, 53, 56, & + ! 57, 58, 59, 60, 62, 64, 65, 66, 67, 68, & + ! 69, 70, 72, 73, 74, 75, 76, 77, 79, 80, & + ! 81, 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, 114, & + ! 115, 116, 117, 118, 119, 120, 121, 124, 125, 126, & + ! 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, & + ! 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, & + ! 147, 149, 150, 151, 152, 153, 154, 155, 156, 157, & + ! 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, & + ! 168, 169, 171, 172, 173, 174, 175, 176, 177, 178, & + ! 179, 180, 181, 182, 183, 184, 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 /) + + ! permute(:191,4) = (/ 121, 120, 1, 2, 144, 46, 85, 47, 86, 96, & + ! 68, 117, 75, 60, 81, 174, 61, 187, 110, 62, & + ! 78, 70, 111, 64, 79, 71, 149, 90, 39, 65, & + ! 189, 161, 38, 147, 166, 108, 102, 134, 91, 184, & + ! 45, 36, 183, 148, 155, 40, 50, 52, 69, 3, & + ! 4, 5, 41, 132, 151, 142, 176, 162, 114, 42, & + ! 138, 177, 49, 133, 57, 175, 83, 131, 136, 154, & + ! 58, 156, 72, 43, 139, 113, 107, 164, 89, 123, & + ! 34, 165, 73, 104, 74, 106, 145, 169, 82, 67, & + ! 84, 152, 6, 7, 8, 37, 9, 190, 185, 179, & + ! 141, 87, 10, 11, 12, 13, 188, 186, 76, 80, & + ! 59, 97, 44, 98, 48, 77, 14, 15, 109, 88, & + ! 103, 167, 140, 63, 16, 17, 18, 19, 20, 21, & + ! 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, & + ! 32, 33, 35, 53, 115, 118, 99, 150, 153, 116, & + ! 51, 54, 55, 124, 56, 92, 105, 146, 100, 93, & + ! 137, 135, 119, 173, 182, 129, 112, 66, 125, 178, & + ! 94, 168, 171, 170, 126, 172, 143, 122, 159, 180, & + ! 181, 95, 130, 160, 158, 157, 127, 163, 128, 101, & + ! 191 /) + + ! diag_map(:191) = (/ 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, 39, 45, 46, 49, 52, 55, 59, & + ! 62, 65, 68, 71, 74, 81, 87, 91, 96, 100, & + ! 109, 116, 121, 125, 134, 142, 147, 150, 155, 158, & + ! 161, 164, 168, 172, 176, 180, 184, 190, 193, 199, & + ! 205, 211, 214, 219, 224, 229, 234, 240, 245, 250, & + ! 258, 266, 272, 278, 284, 290, 296, 302, 308, 314, & + ! 320, 326, 334, 340, 347, 353, 356, 363, 367, 376, & + ! 384, 391, 397, 403, 409, 415, 423, 431, 435, 443, & + ! 451, 459, 467, 476, 483, 494, 503, 507, 515, 522, & + ! 533, 544, 552, 563, 576, 583, 594, 610, 621, 630, & + ! 640, 649, 657, 661, 666, 677, 687, 695, 709, 726, & + ! 732, 739, 744, 761, 787, 809, 819, 827, 841, 856, & + ! 865, 874, 886, 898, 911, 915, 928, 950, 969, 985, & + ! 996,1007,1024,1044,1060,1072,1083,1108,1130,1153, & + ! 1186,1205,1236,1250,1263,1276,1296,1390,1448,1473, & + ! 1621,1672,1699,1734,1776,1837,1862,1893,1917,1996, & + ! 2022 /) + + ! slvd_lst(: 34) = (/ 'ACBZO2 ', 'ALKO2 ', 'BENZO2 ', 'BZOO ', 'C2H5O2 ', & + ! 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', 'CH3O2 ', 'DICARBO2 ', & + ! 'ENEO2 ', 'EO ', 'EO2 ', 'HO2 ', 'HOCH2OO ', & + ! 'ISOPAO2 ', 'ISOPBO2 ', 'MACRO2 ', 'MALO2 ', 'MCO3 ', & + ! 'MDIALO2 ', 'MEKO2 ', 'NTERPO2 ', 'O1D ', 'OH ', & + ! 'PHENO2 ', 'PO2 ', 'RO2 ', 'TERP2O2 ', 'TERPO2 ', & + ! 'TOLO2 ', 'XO2 ', 'XYLENO2 ', 'XYLOLO2 ' /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/hetp b/src/chemistry/hetp new file mode 160000 index 0000000000..2a99b24625 --- /dev/null +++ b/src/chemistry/hetp @@ -0,0 +1 @@ +Subproject commit 2a99b24625ed26cf87ae88697ddd6cf8bbdec812 diff --git a/src/chemistry/modal_aero/aero_model.F90 b/src/chemistry/modal_aero/aero_model.F90 index ff83ed5053..d75730c2ff 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 @@ -46,27 +47,27 @@ module aero_model public :: calc_1_impact_rate public :: nimptblgrow_mind, nimptblgrow_maxd - ! Accessor functions + ! Accessor functions public :: get_scavimptblvol, get_scavimptblnum, get_dlndg_nimptblgrow - ! Misc private data + ! Misc private data ! number of modes integer :: nmodes integer :: pblh_idx = 0 integer :: dgnum_idx = 0 integer :: dgnumwet_idx = 0 - integer :: rate1_cw2pr_st_idx = 0 + integer :: rate1_cw2pr_st_idx = 0 integer :: wetdens_ap_idx = 0 integer :: qaerwat_idx = 0 integer :: fracis_idx = 0 integer :: prain_idx = 0 - integer :: rprddp_idx = 0 - integer :: rprdsh_idx = 0 - integer :: nevapr_shcu_idx = 0 - integer :: nevapr_dpcu_idx = 0 + integer :: rprddp_idx = 0 + integer :: rprdsh_idx = 0 + integer :: nevapr_shcu_idx = 0 + integer :: nevapr_dpcu_idx = 0 integer :: sulfeq_idx = -1 @@ -79,7 +80,7 @@ module aero_model real(r8),allocatable :: scavimptblnum(:,:) real(r8),allocatable :: scavimptblvol(:,:) - ! for surf_area_dens + ! for surf_area_dens integer,allocatable :: num_idx(:) integer,allocatable :: index_tot_mass(:,:) integer,allocatable :: index_chm_mass(:,:) @@ -88,26 +89,19 @@ module aero_model character(len=fieldname_len), allocatable :: dgnum_name(:), dgnumwet_name(:) ! Namelist variables - character(len=16) :: wetdep_list(pcnst) = ' ' character(len=16) :: drydep_list(pcnst) = ' ' - real(r8) :: sol_facti_cloud_borne = 1._r8 - real(r8) :: sol_factb_interstitial = 0.1_r8 - real(r8) :: sol_factic_interstitial = 0.4_r8 - real(r8) :: seasalt_emis_scale + real(r8) :: seasalt_emis_scale integer :: ndrydep = 0 integer,allocatable :: drydep_indices(:) - integer :: nwetdep = 0 - integer,allocatable :: wetdep_indices(:) logical :: drydep_lq(pcnst) - logical :: wetdep_lq(pcnst) logical :: modal_accum_coarse_exch = .false. - logical :: convproc_do_aer + type(modal_aerosol_properties), pointer :: aero_props=>null() contains - + !============================================================================= ! reads aerosol namelist options !============================================================================= @@ -116,7 +110,7 @@ subroutine aero_model_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit use mpishorthand - use modal_aero_convproc, only: ma_convproc_readnl + use aero_wetdep_cam, only: aero_wetdep_readnl character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -125,11 +119,9 @@ subroutine aero_model_readnl(nlfile) character(len=*), parameter :: subname = 'aero_model_readnl' ! Namelist variables - character(len=16) :: aer_wetdep_list(pcnst) = ' ' character(len=16) :: aer_drydep_list(pcnst) = ' ' - namelist /aerosol_nl/ aer_wetdep_list, aer_drydep_list, sol_facti_cloud_borne, & - sol_factb_interstitial, sol_factic_interstitial, modal_strat_sulfate, modal_accum_coarse_exch, seasalt_emis_scale + namelist /aerosol_nl/ aer_drydep_list, modal_strat_sulfate, modal_accum_coarse_exch, seasalt_emis_scale !----------------------------------------------------------------------------- @@ -150,21 +142,16 @@ subroutine aero_model_readnl(nlfile) #ifdef SPMD ! Broadcast namelist variables - call mpibcast(aer_wetdep_list, len(aer_wetdep_list(1))*pcnst, mpichar, 0, mpicom) call mpibcast(aer_drydep_list, len(aer_drydep_list(1))*pcnst, mpichar, 0, mpicom) - call mpibcast(sol_facti_cloud_borne, 1, mpir8, 0, mpicom) - call mpibcast(sol_factb_interstitial, 1, mpir8, 0, mpicom) - call mpibcast(sol_factic_interstitial, 1, mpir8, 0, mpicom) call mpibcast(modal_strat_sulfate, 1, mpilog, 0, mpicom) call mpibcast(seasalt_emis_scale, 1, mpir8, 0, mpicom) call mpibcast(modal_accum_coarse_exch, 1, mpilog, 0, mpicom) #endif - wetdep_list = aer_wetdep_list drydep_list = aer_drydep_list - call ma_convproc_readnl(nlfile) - + call aero_wetdep_readnl(nlfile) + end subroutine aero_model_readnl !============================================================================= @@ -182,22 +169,21 @@ subroutine aero_model_init( pbuf2d ) use mo_chem_utls, only: get_inv_ndx use cam_history, only: addfld, add_default, horiz_only - use mo_chem_utls, only: get_rxt_ndx, get_spc_ndx + use mo_chem_utls, only: get_spc_ndx use modal_aero_data, only: cnst_name_cw use modal_aero_data, only: modal_aero_data_init use rad_constituents,only: rad_cnst_get_info use dust_model, only: dust_init, dust_names, dust_active, dust_nbin, dust_nnum use seasalt_model, only: seasalt_init, seasalt_names, seasalt_active,seasalt_nbin - use drydep_mod, only: inidrydep - use wetdep, only: wetdep_init - + use aer_drydep_mod, only: inidrydep + use aero_wetdep_cam, only: aero_wetdep_init + 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 - use modal_aero_convproc, only: ma_convproc_init ! args type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -214,7 +200,7 @@ subroutine aero_model_init( pbuf2d ) character(len=6) :: test_name character(len=64) :: errmes - character(len=2) :: unit_basename ! Units 'kg' or '1' + character(len=2) :: unit_basename ! Units 'kg' or '1' integer :: errcode character(len=fieldname_len) :: field_name @@ -225,20 +211,19 @@ subroutine aero_model_init( pbuf2d ) dgnum_idx = pbuf_get_index('DGNUM') dgnumwet_idx = pbuf_get_index('DGNUMWET') - fracis_idx = pbuf_get_index('FRACIS') - prain_idx = pbuf_get_index('PRAIN') - rprddp_idx = pbuf_get_index('RPRDDP') - rprdsh_idx = pbuf_get_index('RPRDSH') - nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') - nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') + fracis_idx = pbuf_get_index('FRACIS') + prain_idx = pbuf_get_index('PRAIN') + rprddp_idx = pbuf_get_index('RPRDDP') + rprdsh_idx = pbuf_get_index('RPRDSH') + nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') + nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') sulfeq_idx = pbuf_get_index('MAMH2SO4EQ',errcode) - + call phys_getopts(history_aerosol_out = history_aerosol, & history_chemistry_out=history_chemistry, & history_cesm_forcing_out=history_cesm_forcing, & - history_dust_out=history_dust, & - convproc_do_aer_out = convproc_do_aer) - + history_dust_out=history_dust) + call rad_cnst_get_info(0, nmodes=nmodes) call modal_aero_data_init(pbuf2d) @@ -252,34 +237,24 @@ 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 - endif - - if (convproc_do_aer) then - call ma_convproc_init() + aero_props => modal_aerosol_properties() + call aero_deposition_cam_init(aero_props) endif call dust_init() call seasalt_init(seasalt_emis_scale) - call wetdep_init() - nwetdep = 0 ndrydep = 0 count_species: do m = 1,pcnst - if ( len_trim(wetdep_list(m)) /= 0 ) then - nwetdep = nwetdep+1 - endif if ( len_trim(drydep_list(m)) /= 0 ) then ndrydep = ndrydep+1 endif enddo count_species - - if (nwetdep>0) & - allocate(wetdep_indices(nwetdep)) + if (ndrydep>0) & allocate(drydep_indices(ndrydep)) @@ -295,18 +270,6 @@ subroutine aero_model_init( pbuf2d ) write(iulog,*) subrname//': '//drydep_list(m)//' will have drydep applied' endif enddo - do m = 1,nwetdep - call cnst_get_ind ( wetdep_list(m), id, abort=.false. ) - if (id>0) then - wetdep_indices(m) = id - 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 if (ndrydep>0) then @@ -314,12 +277,12 @@ subroutine aero_model_init( pbuf2d ) 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 @@ -351,7 +314,7 @@ subroutine aero_model_init( pbuf2d ) endif if (seasalt_active) then - + dummy = 'SSTSFMBL' call addfld (dummy,horiz_only, 'A','kg/m2/s','Mobilization flux at surface') if (history_aerosol) then @@ -368,35 +331,28 @@ subroutine aero_model_init( pbuf2d ) endif - + ! 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 - ! set flags for wetdep tendencies - wetdep_lq(:) = .false. - do m=1,nwetdep - id = wetdep_indices(m) - wetdep_lq(id) = .true. - enddo - wetdens_ap_idx = pbuf_get_index('WETDENS_AP') qaerwat_idx = pbuf_get_index('QAERWAT') pblh_idx = pbuf_get_index('pblh') - rate1_cw2pr_st_idx = pbuf_get_index('RATE1_CW2PR_ST') + rate1_cw2pr_st_idx = pbuf_get_index('RATE1_CW2PR_ST') call pbuf_set_field(pbuf2d, rate1_cw2pr_st_idx, 0.0_r8) do m = 1,ndrydep - - ! units + + ! units if (drydep_list(m)(1:3) == 'num') then unit_basename = ' 1' else - unit_basename = 'kg' + unit_basename = 'kg' endif call addfld (trim(drydep_list(m))//'DDF', horiz_only, 'A',unit_basename//'/m2/s ', & @@ -410,85 +366,32 @@ subroutine aero_model_init( pbuf2d ) call addfld (trim(drydep_list(m))//'DDV', (/ 'lev' /), 'A','m/s', & trim(drydep_list(m))//' deposition velocity') - if ( history_aerosol.or.history_chemistry ) then + if ( history_aerosol.or.history_chemistry ) then call add_default (trim(drydep_list(m))//'DDF', 1, ' ') endif - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (trim(drydep_list(m))//'TBF', 1, ' ') call add_default (trim(drydep_list(m))//'GVF', 1, ' ') endif enddo - do m = 1,nwetdep - - ! units - if (wetdep_list(m)(1:3) == 'num') then - unit_basename = ' 1' - else - unit_basename = 'kg' - endif - - call addfld (trim(wetdep_list(m))//'SFWET', & - horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux at surface') - call addfld (trim(wetdep_list(m))//'SFSIC', & - horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (incloud, convective) at surface') - call addfld (trim(wetdep_list(m))//'SFSIS', & - horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (incloud, stratiform) at surface') - call addfld (trim(wetdep_list(m))//'SFSBC', & - horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (belowcloud, convective) at surface') - call addfld (trim(wetdep_list(m))//'SFSBS', & - horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (belowcloud, stratiform) at surface') - - if (convproc_do_aer) then - call addfld (trim(wetdep_list(m))//'SFSES', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, stratiform) at surface') - call addfld (trim(wetdep_list(m))//'SFSBD', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (belowcloud, deep convective) at surface') - end if - - call addfld (trim(wetdep_list(m))//'WET',(/ 'lev' /), 'A',unit_basename//'/kg/s ','wet deposition tendency') - call addfld (trim(wetdep_list(m))//'SIC',(/ 'lev' /), 'A',unit_basename//'/kg/s ', & - trim(wetdep_list(m))//' ic wet deposition') - call addfld (trim(wetdep_list(m))//'SIS',(/ 'lev' /), 'A',unit_basename//'/kg/s ', & - trim(wetdep_list(m))//' is wet deposition') - call addfld (trim(wetdep_list(m))//'SBC',(/ 'lev' /), 'A',unit_basename//'/kg/s ', & - trim(wetdep_list(m))//' bc wet deposition') - call addfld (trim(wetdep_list(m))//'SBS',(/ 'lev' /), 'A',unit_basename//'/kg/s ', & - trim(wetdep_list(m))//' bs wet deposition') - - if ( history_aerosol .or. history_chemistry ) then - call add_default (trim(wetdep_list(m))//'SFWET', 1, ' ') - endif - if ( history_aerosol ) then - call add_default (trim(wetdep_list(m))//'SFSIC', 1, ' ') - call add_default (trim(wetdep_list(m))//'SFSIS', 1, ' ') - call add_default (trim(wetdep_list(m))//'SFSBC', 1, ' ') - call add_default (trim(wetdep_list(m))//'SFSBS', 1, ' ') - if (convproc_do_aer) then - call add_default (trim(wetdep_list(m))//'SFSES', 1, ' ') - call add_default (trim(wetdep_list(m))//'SFSBD', 1, ' ') - end if - endif - - enddo - do m = 1,gas_pcnst if ( solsym(m)(1:3) == 'num') then - unit_basename = ' 1' ! Units 'kg' or '1' + unit_basename = ' 1' ! Units 'kg' or '1' else - unit_basename = 'kg' ! Units 'kg' or '1' + unit_basename = 'kg' ! Units 'kg' or '1' end if call addfld( 'GS_'//trim(solsym(m)),horiz_only, 'A', unit_basename//'/m2/s ', & trim(solsym(m))//' gas chemistry/wet removal (for gas species)') call addfld( 'AQ_'//trim(solsym(m)),horiz_only, 'A', unit_basename//'/m2/s ', & trim(solsym(m))//' aqueous chemistry (for gas species)') - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default( 'AQ_'//trim(solsym(m)), 1, ' ') endif - + enddo do n = 1,pcnst if( .not. (cnst_name_cw(n) == ' ') ) then @@ -496,55 +399,25 @@ subroutine aero_model_init( pbuf2d ) if (cnst_name_cw(n)(1:3) == 'num') then unit_basename = ' 1' else - unit_basename = 'kg' + unit_basename = 'kg' endif call addfld( cnst_name_cw(n), (/ 'lev' /), 'A', unit_basename//'/kg ', & trim(cnst_name_cw(n))//' in cloud water') - call addfld (trim(cnst_name_cw(n))//'SFWET', horiz_only, 'A', unit_basename//'/m2/s ', & - trim(cnst_name_cw(n))//' wet deposition flux at surface') - call addfld (trim(cnst_name_cw(n))//'SFSIC', horiz_only, 'A', unit_basename//'/m2/s ', & - trim(cnst_name_cw(n))//' wet deposition flux (incloud, convective) at surface') - call addfld (trim(cnst_name_cw(n))//'SFSIS', horiz_only, 'A', unit_basename//'/m2/s ', & - trim(cnst_name_cw(n))//' wet deposition flux (incloud, stratiform) at surface') - call addfld (trim(cnst_name_cw(n))//'SFSBC', horiz_only, 'A', unit_basename//'/m2/s ', & - trim(cnst_name_cw(n))//' wet deposition flux (belowcloud, convective) at surface') - call addfld (trim(cnst_name_cw(n))//'SFSBS', horiz_only, 'A', unit_basename//'/m2/s ', & - trim(cnst_name_cw(n))//' wet deposition flux (belowcloud, stratiform) at surface') call addfld (trim(cnst_name_cw(n))//'DDF', horiz_only, 'A', unit_basename//'/m2/s ', & trim(cnst_name_cw(n))//' dry deposition flux at bottom (grav + turb)') call addfld (trim(cnst_name_cw(n))//'TBF', horiz_only, 'A', unit_basename//'/m2/s ', & trim(cnst_name_cw(n))//' turbulent dry deposition flux') call addfld (trim(cnst_name_cw(n))//'GVF', horiz_only, 'A', unit_basename//'/m2/s ', & - trim(cnst_name_cw(n))//' gravitational dry deposition flux') - - if (convproc_do_aer) then - call addfld (trim(cnst_name_cw(n))//'SFSEC', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, convective) at surface') - call addfld (trim(cnst_name_cw(n))//'SFSES', & - 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 + trim(cnst_name_cw(n))//' gravitational dry deposition flux') - - if ( history_aerosol.or. history_chemistry ) then + if ( history_aerosol.or. history_chemistry ) then call add_default( cnst_name_cw(n), 1, ' ' ) - call add_default (trim(cnst_name_cw(n))//'SFWET', 1, ' ') endif if ( history_aerosol ) then call add_default (trim(cnst_name_cw(n))//'GVF', 1, ' ') call add_default (trim(cnst_name_cw(n))//'TBF', 1, ' ') call add_default (trim(cnst_name_cw(n))//'DDF', 1, ' ') - call add_default (trim(cnst_name_cw(n))//'SFSBS', 1, ' ') - call add_default (trim(cnst_name_cw(n))//'SFSIC', 1, ' ') - call add_default (trim(cnst_name_cw(n))//'SFSBC', 1, ' ') - call add_default (trim(cnst_name_cw(n))//'SFSIS', 1, ' ') - if (convproc_do_aer) then - call add_default (trim(cnst_name_cw(n))//'SFSEC', 1, ' ') - call add_default (trim(cnst_name_cw(n))//'SFSES', 1, ' ') - call add_default (trim(cnst_name_cw(n))//'SFSBD', 1, ' ') - end if endif endif enddo @@ -557,33 +430,33 @@ subroutine aero_model_init( pbuf2d ) write(dgnumwet_name(n),fmt='(a,i1)') 'dgnumwet',n call addfld( dgnum_name(n), (/ 'lev' /), 'I', 'm', 'Aerosol mode dry diameter' ) call addfld( dgnumwet_name(n), (/ 'lev' /), 'I', 'm', 'Aerosol mode wet diameter' ) - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default( dgnum_name(n), 1, ' ' ) call add_default( dgnumwet_name(n), 1, ' ' ) endif if ( history_cesm_forcing .and. n<4 ) then call add_default( dgnumwet_name(n), 8, ' ' ) endif - + if (modal_strat_sulfate) then field_name = ' ' write(field_name,fmt='(a,i1)') 'wtpct_a',n call addfld( field_name, (/ 'lev' /), 'I', '%', 'Aerosol mode weight percent H2SO4' ) - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (field_name, 0, 'I') endif field_name = ' ' write(field_name,fmt='(a,i1)') 'sulfeq_a',n call addfld( field_name, (/ 'lev' /), 'I', 'kg/kg', 'H2SO4 equilibrium mixing ratio' ) - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (field_name, 0, 'I') endif field_name = ' ' write(field_name,fmt='(a,i1)') 'sulden_a',n call addfld( field_name, (/ 'lev' /), 'I', 'g/cm3', 'Sulfate aerosol particle mass density' ) - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default (field_name, 0, 'I') endif @@ -614,8 +487,8 @@ subroutine aero_model_init( pbuf2d ) index_tot_mass = -1 index_chm_mass = -1 - ! for surf_area_dens - ! define indeces associated with the various aerosol types + ! for surf_area_dens + ! define indices associated with the various aerosol types do n = 1,nmodes call rad_cnst_get_info(0, n, mode_type=mode_type, nspec=nspec) if ( trim(mode_type) /= 'primary_carbon') then ! ignore the primary_carbon mode @@ -624,6 +497,7 @@ subroutine aero_model_init( pbuf2d ) index_tot_mass(n,l) = get_spc_ndx(spec_name) if ( trim(spec_type) == 'sulfate' .or. & trim(spec_type) == 's-organic' .or. & + trim(spec_type) == 'p-organic' .or. & trim(spec_type) == 'black-c' .or. & trim(spec_type) == 'ammonium') then index_chm_mass(n,l) = get_spc_ndx(spec_name) @@ -662,6 +536,8 @@ subroutine aero_model_init( pbuf2d ) endif endif + call aero_wetdep_init() + end subroutine aero_model_init !============================================================================= @@ -669,7 +545,7 @@ end subroutine aero_model_init subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, ptend ) use dust_sediment_mod, only: dust_sediment_tend - use drydep_mod, only: d3ddflux, calcram + use aer_drydep_mod, only: d3ddflux, calcram use modal_aero_data, only: qqcw_get_field use modal_aero_data, only: cnst_name_cw use modal_aero_data, only: alnsg_amode @@ -679,11 +555,11 @@ 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 + ! 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 @@ -751,15 +627,15 @@ 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) - call pbuf_get_field(pbuf, dgnumwet_idx, dgncur_awet, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) - call pbuf_get_field(pbuf, wetdens_ap_idx, wetdens, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) - call pbuf_get_field(pbuf, qaerwat_idx, qaerwat, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) + call pbuf_get_field(pbuf, dgnumwet_idx, dgncur_awet, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) + call pbuf_get_field(pbuf, wetdens_ap_idx, wetdens, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) + call pbuf_get_field(pbuf, qaerwat_idx, qaerwat, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) tvs(:ncol,:) = state%t(:ncol,:)!*(1+state%q(:ncol,k) rho(:ncol,:)= state%pmid(:ncol,:)/(rair*state%t(:ncol,:)) @@ -797,11 +673,11 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, sg_aer(1:ncol,:) = sigmag_amode(m) jvlc = 1 - call modal_aero_depvel_part( ncol, state%t(:,:), state%pmid(:,:), ram1, fv, & + call modal_aero_depvel_part( ncol, state%t(:,:), state%pmid(:,:), ram1, fv, & vlc_dry(:,:,jvlc), vlc_trb(:,jvlc), vlc_grv(:,:,jvlc), & rad_aer(:,:), dens_aer(:,:), sg_aer(:,:), 0, lchnk) jvlc = 2 - call modal_aero_depvel_part( ncol, state%t(:,:), state%pmid(:,:), ram1, fv, & + call modal_aero_depvel_part( ncol, state%t(:,:), state%pmid(:,:), ram1, fv, & vlc_dry(:,:,jvlc), vlc_trb(:,jvlc), vlc_grv(:,:,jvlc), & rad_aer(:,:), dens_aer(:,:), sg_aer(:,:), 3, lchnk) end if @@ -954,10 +830,10 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, enddo ! lphase = 1, 2 enddo ! m = 1, ntot_amode - ! 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 - call set_srf_drydep(aerdepdryis, aerdepdrycw, cam_out) + call aero_deposition_cam_setdry(aerdepdryis, aerdepdrycw, cam_out) endif endsubroutine aero_model_drydep @@ -966,12 +842,7 @@ 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_wetdep_cam, only: aero_wetdep_tend ! args @@ -982,677 +853,9 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies type(physics_buffer_desc), pointer :: pbuf(:) - ! local vars - - integer :: m ! tracer index - - integer :: lchnk ! chunk identifier - integer :: ncol ! number of atmospheric columns - - real(r8) :: iscavt(pcols, pver) - - integer :: mm - integer :: i,k - - real(r8) :: icscavt(pcols, pver) - real(r8) :: isscavt(pcols, pver) - real(r8) :: bcscavt(pcols, pver) - real(r8) :: bsscavt(pcols, pver) - real(r8) :: sol_factb, sol_facti - real(r8) :: sol_factic(pcols,pver) - - real(r8) :: sflx(pcols) ! deposition flux - - integer :: jnv ! index for scavcoefnv 3rd dimension - integer :: lphase ! index for interstitial / cloudborne aerosol - integer :: strt_loop, end_loop, stride_loop !loop indices for the lphase loop - integer :: lspec ! index for aerosol number / chem-mass / water-mass - integer :: lcoardust, lcoarnacl ! indices for coarse mode dust and seasalt masses - real(r8) :: dqdt_tmp(pcols,pver) ! temporary array to hold tendency for 1 species - real(r8) :: f_act_conv(pcols,pver) ! prescribed aerosol activation fraction for convective cloud ! rce 2010/05/01 - real(r8) :: f_act_conv_coarse(pcols,pver) ! similar but for coarse mode ! rce 2010/05/02 - real(r8) :: f_act_conv_coarse_dust, f_act_conv_coarse_nacl ! rce 2010/05/02 - real(r8) :: fracis_cw(pcols,pver) - real(r8) :: hygro_sum_old(pcols,pver) ! before removal [sum of (mass*hydro/dens)] - real(r8) :: hygro_sum_del(pcols,pver) ! removal change to [sum of (mass*hydro/dens)] - real(r8) :: hygro_sum_old_ik, hygro_sum_new_ik - real(r8) :: prec(pcols) ! precipitation rate - real(r8) :: q_tmp(pcols,pver) ! temporary array to hold "most current" mixing ratio for 1 species - real(r8) :: scavcoefnv(pcols,pver,0:2) ! Dana and Hales coefficient (/mm) for - ! cloud-borne num & vol (0), - ! interstitial num (1), interstitial vol (2) - real(r8) :: tmpa, tmpb - real(r8) :: tmpdust, tmpnacl - real(r8) :: water_old, water_new ! temporary old/new aerosol water mix-rat - logical :: isprx(pcols,pver) ! true if precipation - real(r8) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial) - real(r8) :: aerdepwetcw(pcols,pcnst) ! aerosol wet deposition (cloud water) - - ! For unified convection scheme - logical, parameter :: do_aero_water_removal = .false. ! True if aerosol water reduction by wet removal is to be calculated - ! (this has not been fully tested, so best to leave it off) - logical :: do_hygro_sum_del, do_lphase1, do_lphase2 - - real(r8), pointer :: rprddp(:,:) ! rain production, deep convection - real(r8), pointer :: rprdsh(:,:) ! rain production, shallow convection - real(r8), pointer :: evapcdp(:,:) ! Evaporation rate of deep convective precipitation >=0. - real(r8), pointer :: evapcsh(:,:) ! Evaporation rate of shallow convective precipitation >=0. - - real(r8) :: rprddpsum(pcols) - real(r8) :: rprdshsum(pcols) - real(r8) :: evapcdpsum(pcols) - real(r8) :: evapcshsum(pcols) - - real(r8) :: tmp_resudp, tmp_resush - - real(r8) :: sflxec(pcols), sflxecdp(pcols) ! deposition flux - real(r8) :: sflxic(pcols), sflxicdp(pcols) ! deposition flux - real(r8) :: sflxbc(pcols), sflxbcdp(pcols) ! deposition flux - real(r8) :: rcscavt(pcols, pver) - real(r8) :: rsscavt(pcols, pver) - real(r8) :: qqcw_in(pcols,pver), qqcw_sav(pcols,pver,0:nspec_max) ! temporary array to hold qqcw for the current mode - real(r8) :: rtscavt(pcols, pver, 0:nspec_max) - - integer, parameter :: nsrflx_mzaer2cnvpr = 2 - real(r8) :: qsrflx_mzaer2cnvpr(pcols,pcnst,nsrflx_mzaer2cnvpr) - ! End unified convection scheme - - real(r8), pointer :: fldcw(:,:) - - real(r8), pointer :: dgnumwet(:,:,:) - real(r8), pointer :: qaerwat(:,:,:) ! aerosol water - - real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble - - type(wetdep_inputs_t) :: dep_inputs - - real(r8) :: dcondt_resusp3d(2*pcnst,pcols, pver) - - lchnk = state%lchnk - ncol = state%ncol - - dcondt_resusp3d(:,:,:) = 0._r8 - - 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 ) - - call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) - call pbuf_get_field(pbuf, qaerwat_idx, qaerwat, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) - call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) - - prec(:ncol)=0._r8 - do k=1,pver - where (prec(:ncol) >= 1.e-7_r8) - isprx(:ncol,k) = .true. - elsewhere - isprx(:ncol,k) = .false. - endwhere - prec(:ncol) = prec(:ncol) + (dep_inputs%prain(:ncol,k) + dep_inputs%cmfdqr(:ncol,k) - dep_inputs%evapr(:ncol,k)) & - *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 - - ! calculate the mass-weighted sol_factic for coarse mode species - ! sol_factic_coarse(:,:) = 0.30_r8 ! tuned 1/4 - f_act_conv_coarse(:,:) = 0.60_r8 ! rce 2010/05/02 - f_act_conv_coarse_dust = 0.40_r8 ! rce 2010/05/02 - f_act_conv_coarse_nacl = 0.80_r8 ! rce 2010/05/02 - if (modeptr_coarse > 0) then - lcoardust = lptr_dust_a_amode(modeptr_coarse) - lcoarnacl = lptr_nacl_a_amode(modeptr_coarse) - 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 ) - 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 & - + f_act_conv_coarse_nacl*tmpnacl)/(tmpdust+tmpnacl) ! rce 2010/05/02 - end if - end do - end do - end if - end if - - scavcoefnv(:,:,0) = 0.0_r8 ! below-cloud scavcoef = 0.0 for cloud-borne species - - ! Counters for "without" unified convective treatment (i.e. default case) - strt_loop = 1 - end_loop = 2 - stride_loop = 1 - if (convproc_do_aer) then - !Do cloudborne first for unified convection scheme so that the resuspension of cloudborne - !can be saved then applied to interstitial - strt_loop = 2 - end_loop = 1 - stride_loop = -1 - endif + call aero_wetdep_tend(state, dt, dlf, cam_out, ptend, pbuf) - 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 - - ! sol_factb and sol_facti values - ! sol_factb - currently this is basically a tuning factor - ! sol_facti & sol_factic - currently has a physical basis, and reflects activation fraction - ! - ! 2008-mar-07 rce - sol_factb (interstitial) changed from 0.3 to 0.1 - ! - sol_factic (interstitial, dust modes) changed from 1.0 to 0.5 - ! - sol_factic (cloud-borne, pcarb modes) no need to set it to 0.0 - ! because the cloud-borne pcarbon == 0 (no activation) - ! - ! rce 2010/05/02 - ! prior to this date, sol_factic was used for convective in-cloud wet removal, - ! and its value reflected a combination of an activation fraction (which varied between modes) - ! and a tuning factor - ! from this date forward, two parameters are used for convective in-cloud wet removal - ! f_act_conv is the activation fraction - ! note that "non-activation" of aerosol in air entrained into updrafts should - ! be included here - ! eventually we might use the activate routine (with w ~= 1 m/s) to calculate - ! this, but there is still the entrainment issue - ! sol_factic is strictly a tuning factor - ! - if (lphase == 1) then ! interstial aerosol - hygro_sum_old(:,:) = 0.0_r8 - hygro_sum_del(:,:) = 0.0_r8 - call modal_aero_bcscavcoef_get( m, ncol, isprx, dgnumwet, & - scavcoefnv(:,:,1), scavcoefnv(:,:,2) ) - - sol_factb = sol_factb_interstitial ! all below-cloud scav ON (0.1 "tuning factor") - - sol_facti = 0.0_r8 ! strat in-cloud scav totally OFF for institial - - sol_factic = sol_factic_interstitial - - if (m == modeptr_pcarbon) then - ! sol_factic = 0.0_r8 ! conv in-cloud scav OFF (0.0 activation fraction) - f_act_conv = 0.0_r8 ! rce 2010/05/02 - else if ((m == modeptr_finedust) .or. (m == modeptr_coardust)) then - ! sol_factic = 0.2_r8 ! conv in-cloud scav ON (0.5 activation fraction) ! tuned 1/4 - f_act_conv = 0.4_r8 ! rce 2010/05/02 - else - ! sol_factic = 0.4_r8 ! conv in-cloud scav ON (1.0 activation fraction) ! tuned 1/4 - f_act_conv = 0.8_r8 ! rce 2010/05/02 - end if - - else ! cloud-borne aerosol (borne by stratiform cloud drops) - - sol_factb = 0.0_r8 ! all below-cloud scav OFF (anything cloud-borne is located "in-cloud") - sol_facti = sol_facti_cloud_borne ! strat in-cloud scav cloud-borne tuning factor - sol_factic = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean - ! that conv precip collects strat droplets) - f_act_conv = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean - - end if - if (convproc_do_aer .and. lphase == 1) then - ! if modal aero convproc is turned on for aerosols, then - ! turn off the convective in-cloud removal for interstitial aerosols - ! (but leave the below-cloud on, as convproc only does in-cloud) - ! and turn off the outfld SFWET, SFSIC, SFSID, SFSEC, and SFSED calls - ! for (stratiform)-cloudborne aerosols, convective wet removal - ! (all forms) is zero, so no action is needed - sol_factic = 0.0_r8 - endif - - ! - ! rce 2010/05/03 - ! wetdepa has "sol_fact" parameters: - ! sol_facti, sol_factic, sol_factb for liquid cloud - - 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) - jnv = 1 - else - mm = numptrcw_amode(m) - jnv = 0 - endif - else if (lspec <= nspec_amode(m)) then ! non-water mass - if (lphase == 1) then - mm = lmassptr_amode(lspec,m) - jnv = 2 - else - mm = lmassptrcw_amode(lspec,m) - jnv = 0 - endif - else ! water mass - ! bypass wet removal of aerosol water - if(convproc_do_aer) then - if ( .not. do_aero_water_removal ) cycle - else - cycle - endif - if (lphase == 1) then - mm = 0 - ! mm = lwaterptr_amode(m) - jnv = 2 - else - mm = 0 - jnv = 0 - endif - endif - - if (mm <= 0) cycle - - - ! set f_act_conv for interstitial (lphase=1) coarse mode species - ! for the convective in-cloud, we conceptually treat the coarse dust and seasalt - ! as being externally mixed, and apply f_act_conv = f_act_conv_coarse_dust/nacl to dust/seasalt - ! number and sulfate are conceptually partitioned to the dust and seasalt - ! on a mass basis, so the f_act_conv for number and sulfate are - ! mass-weighted averages of the values used for dust/seasalt - if ((lphase == 1) .and. (m == modeptr_coarse)) then - ! sol_factic = sol_factic_coarse - f_act_conv = f_act_conv_coarse ! rce 2010/05/02 - if (lspec > 0) then - if (lmassptr_amode(lspec,m) == lptr_dust_a_amode(m)) then - ! sol_factic = 0.2_r8 ! tuned 1/4 - f_act_conv = f_act_conv_coarse_dust ! rce 2010/05/02 - else if (lmassptr_amode(lspec,m) == lptr_nacl_a_amode(m)) then - ! sol_factic = 0.4_r8 ! tuned 1/6 - f_act_conv = f_act_conv_coarse_nacl ! rce 2010/05/02 - end if - end if - end if - - 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(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 - qqcw_in(:,:) = qqcw_sav(:,:,lspec) - else - fldcw => qqcw_get_field(pbuf, mm,lchnk) - qqcw_in(:,:) = fldcw(:,:) - endif - - call wetdepa_v2( state%pmid, state%q(:,:,1), state%pdel, & - dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, & - dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, & - dep_inputs%evapr, dep_inputs%totcond, q_tmp, dt, & - dqdt_tmp, iscavt, dep_inputs%cldvcu, dep_inputs%cldvst, & - dlf, fracis(:,:,mm), sol_factb, ncol, & - scavcoefnv(:,:,jnv), & - is_strat_cloudborne=.false., & - qqcw=qqcw_in(:,:), & - f_act_conv=f_act_conv, & - icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, & - convproc_do_aer=convproc_do_aer, rcscavt=rcscavt, rsscavt=rsscavt, & - sol_facti_in=sol_facti, sol_factic_in=sol_factic, & - convproc_do_evaprain_atonce_in=convproc_do_evaprain_atonce ) - - do_hygro_sum_del = .false. - if ( lspec > 0 ) do_hygro_sum_del = .true. - - if(convproc_do_aer) then - do_hygro_sum_del = .false. - ! add resuspension of cloudborne species to dqdt of interstitial species - dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) + rtscavt(1:ncol,:,lspec) - if ( (lspec > 0) .and. do_aero_water_removal ) then - do_hygro_sum_del = .true. - endif - endif - - 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) - call outfld( trim(cnst_name(mm))//'SIS', isscavt, pcols, lchnk) - call outfld( trim(cnst_name(mm))//'SBC', bcscavt, pcols, lchnk) - call outfld( trim(cnst_name(mm))//'SBS', bsscavt, pcols, lchnk) - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit - enddo - enddo - if (.not.convproc_do_aer) call outfld( trim(cnst_name(mm))//'SFWET', sflx, pcols, lchnk) - aerdepwetis(:ncol,mm) = sflx(:ncol) - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - if (.not.convproc_do_aer) call outfld( trim(cnst_name(mm))//'SFSIC', sflx, pcols, lchnk) - if (convproc_do_aer) sflxic = sflx - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+isscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name(mm))//'SFSIS', sflx, pcols, lchnk) - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+bcscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name(mm))//'SFSBC', sflx, pcols, lchnk) - if (convproc_do_aer)sflxbc = sflx - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+bsscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name(mm))//'SFSBS', sflx, pcols, lchnk) - - if (convproc_do_aer) then - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+rcscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - sflxec = sflx - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+rsscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name(mm))//'SFSES', sflx, pcols, lchnk) - - ! apportion convective surface fluxes to deep and shallow conv - ! this could be done more accurately in subr wetdepa - ! since deep and shallow rarely occur simultaneously, and these - ! fields are just diagnostics, this approximate method is adequate - ! only do this for interstitial aerosol, because conv clouds to not - ! affect the stratiform-cloudborne aerosol - if ( deepconv_wetdep_history) then - - call pbuf_get_field(pbuf, rprddp_idx, rprddp ) - call pbuf_get_field(pbuf, rprdsh_idx, rprdsh ) - call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp ) - call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh ) - - rprddpsum(:) = 0.0_r8 - rprdshsum(:) = 0.0_r8 - evapcdpsum(:) = 0.0_r8 - evapcshsum(:) = 0.0_r8 - - do k = 1, pver - rprddpsum(:ncol) = rprddpsum(:ncol) + rprddp(:ncol,k)*state%pdel(:ncol,k)/gravit - rprdshsum(:ncol) = rprdshsum(:ncol) + rprdsh(:ncol,k)*state%pdel(:ncol,k)/gravit - evapcdpsum(:ncol) = evapcdpsum(:ncol) + evapcdp(:ncol,k)*state%pdel(:ncol,k)/gravit - evapcshsum(:ncol) = evapcshsum(:ncol) + evapcsh(:ncol,k)*state%pdel(:ncol,k)/gravit - end do - - do i = 1, ncol - rprddpsum(i) = max( rprddpsum(i), 1.0e-35_r8 ) - rprdshsum(i) = max( rprdshsum(i), 1.0e-35_r8 ) - evapcdpsum(i) = max( evapcdpsum(i), 0.1e-35_r8 ) - evapcshsum(i) = max( evapcshsum(i), 0.1e-35_r8 ) - - ! assume that in- and below-cloud removal are proportional to column precip production - tmpa = rprddpsum(i) / (rprddpsum(i) + rprdshsum(i)) - tmpa = max( 0.0_r8, min( 1.0_r8, tmpa ) ) - sflxicdp(i) = sflxic(i)*tmpa - sflxbcdp(i) = sflxbc(i)*tmpa - - ! assume that resuspension is proportional to (wet removal)*[(precip evap)/(precip production)] - tmp_resudp = tmpa * min( (evapcdpsum(i)/rprddpsum(i)), 1.0_r8 ) - tmp_resush = (1.0_r8 - tmpa) * min( (evapcshsum(i)/rprdshsum(i)), 1.0_r8 ) - tmpb = max( tmp_resudp, 1.0e-35_r8 ) / max( (tmp_resudp+tmp_resush), 1.0e-35_r8 ) - tmpb = max( 0.0_r8, min( 1.0_r8, tmpb ) ) - sflxecdp(i) = sflxec(i)*tmpb - end do - call outfld( trim(cnst_name(mm))//'SFSBD', sflxbcdp, pcols, lchnk) - else - sflxec(1:ncol) = 0.0_r8 - sflxecdp(1:ncol) = 0.0_r8 - end if - - ! when ma_convproc_intr is used, convective in-cloud wet removal is done there - ! the convective (total and deep) precip-evap-resuspension includes in- and below-cloud - ! contributions - ! so pass the below-cloud contribution to ma_convproc_intr - qsrflx_mzaer2cnvpr(1:ncol,mm,1) = sflxec( 1:ncol) - qsrflx_mzaer2cnvpr(1:ncol,mm,2) = sflxecdp(1:ncol) - - endif - - if (do_hygro_sum_del) then - tmpa = spechygro(lspec,m)/ & - specdens_amode(lspec,m) - tmpb = tmpa*dt - hygro_sum_old(1:ncol,:) = hygro_sum_old(1:ncol,:) & - + tmpa*q_tmp(1:ncol,:) - hygro_sum_del(1:ncol,:) = hygro_sum_del(1:ncol,:) & - + tmpb*dqdt_tmp(1:ncol,:) - end if - - else if ((lphase == 1) .and. (lspec == nspec_amode(m)+1)) then - do_lphase1 = .true. - if(convproc_do_aer) then - do_lphase1 = .false. - if(do_aero_water_removal)do_lphase1 = .true. - endif - if(do_lphase1) then - ! aerosol water -- because of how wetdepa treats evaporation of stratiform - ! precip, it is not appropriate to apply wetdepa to aerosol water - ! instead, "hygro_sum" = [sum of (mass*hygro/dens)] is calculated before and - ! after wet removal, and new water is calculated using - ! new_water = old_water*min(10,(hygro_sum_new/hygro_sum_old)) - ! the "min(10,...)" is to avoid potential problems when hygro_sum_old ~= 0 - ! also, individual wet removal terms (ic,is,bc,bs) are not output to history - ! ptend%lq(mm) = .TRUE. - ! dqdt_tmp(:,:) = 0.0_r8 - do k = 1, pver - do i = 1, ncol - ! water_old = max( 0.0_r8, state%q(i,k,mm)+ptend%q(i,k,mm)*dt ) - water_old = max( 0.0_r8, qaerwat(i,k,mm) ) - hygro_sum_old_ik = max( 0.0_r8, hygro_sum_old(i,k) ) - hygro_sum_new_ik = max( 0.0_r8, hygro_sum_old_ik+hygro_sum_del(i,k) ) - if (hygro_sum_new_ik >= 10.0_r8*hygro_sum_old_ik) then - water_new = 10.0_r8*water_old - else - water_new = water_old*(hygro_sum_new_ik/hygro_sum_old_ik) - end if - ! dqdt_tmp(i,k) = (water_new - water_old)/dt - qaerwat(i,k,mm) = water_new - end do - end do - - ! ptend%q(1:ncol,:,mm) = ptend%q(1:ncol,:,mm) + dqdt_tmp(1:ncol,:) - - ! call outfld( trim(cnst_name(mm)) - - ! sflx(:)=0._r8 - ! do k=1,pver - ! do i=1,ncol - ! sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit - ! enddo - ! enddo - ! call outfld( trim(cnst_name(mm)) - endif - - elseif (lphase == 2) then - - do_lphase2 = .true. - if (convproc_do_aer) then - do_lphase2 = .false. - if (lspec <= nspec_amode(m)) do_lphase2 = .true. - endif - - if (do_lphase2) then - - dqdt_tmp(:,:) = 0.0_r8 - - if (convproc_do_aer) then - fldcw => qqcw_get_field(pbuf,mm,lchnk) - qqcw_sav(1:ncol,:,lspec) = fldcw(1:ncol,:) - else - fldcw => qqcw_get_field(pbuf, mm,lchnk) - endif - - call wetdepa_v2(state%pmid, state%q(:,:,1), state%pdel, & - dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, & - dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, & - dep_inputs%evapr, dep_inputs%totcond, fldcw, dt, & - dqdt_tmp, iscavt, dep_inputs%cldvcu, dep_inputs%cldvst, & - dlf, fracis_cw, sol_factb, ncol, & - scavcoefnv(:,:,jnv), & - is_strat_cloudborne=.true., & - icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, & - convproc_do_aer=convproc_do_aer, rcscavt=rcscavt, rsscavt=rsscavt, & - sol_facti_in=sol_facti, sol_factic_in=sol_factic, & - convproc_do_evaprain_atonce_in=convproc_do_evaprain_atonce, & - bergso_in=dep_inputs%bergso ) - - if(convproc_do_aer) then - ! save resuspension of cloudborne species - rtscavt(1:ncol,:,lspec) = rcscavt(1:ncol,:) + rsscavt(1:ncol,:) - ! wetdepa_v2 adds the resuspension of cloudborne to the dqdt of cloudborne (as a source) - ! undo this, so the resuspension of cloudborne can be added to the dqdt of interstitial (above) - dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) - rtscavt(1:ncol,:,lspec) - endif - - - fldcw(1:ncol,:) = fldcw(1:ncol,:) + dqdt_tmp(1:ncol,:) * dt - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name_cw(mm))//'SFWET', sflx, pcols, lchnk) - aerdepwetcw(:ncol,mm) = sflx(:ncol) - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name_cw(mm))//'SFSIC', sflx, pcols, lchnk) - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+isscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name_cw(mm))//'SFSIS', sflx, pcols, lchnk) - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+bcscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name_cw(mm))//'SFSBC', sflx, pcols, lchnk) - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+bsscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name_cw(mm))//'SFSBS', sflx, pcols, lchnk) - - if(convproc_do_aer) then - sflx(:)=0.0_r8 - do k=1,pver - sflx(1:ncol)=sflx(1:ncol)+rcscavt(1:ncol,k)*state%pdel(1:ncol,k)/gravit - enddo - call outfld( trim(cnst_name_cw(mm))//'SFSEC', sflx, pcols, lchnk) - - sflx(:)=0.0_r8 - do k=1,pver - sflx(1:ncol)=sflx(1:ncol)+rsscavt(1:ncol,k)*state%pdel(1:ncol,k)/gravit - enddo - call outfld( trim(cnst_name_cw(mm))//'SFSES', sflx, pcols, lchnk) - endif - endif - endif - - enddo ! lspec = 0, nspec_amode(m)+1 - 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) - endif - - endsubroutine aero_model_wetdep + end subroutine aero_model_wetdep !------------------------------------------------------------------------- ! provides wet tropospheric aerosol surface area info for modal aerosols @@ -1766,19 +969,19 @@ 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 + integer :: n, m integer :: i,k,l integer :: nstep @@ -1803,7 +1006,6 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ real(r8), pointer :: fldcw(:,:) real(r8), pointer :: sulfeq(:,:,:) - logical :: is_spcam_m2005 ! ! ... initialize nh3 ! @@ -1811,7 +1013,6 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ nh3_beg = vmr(1:ncol,:,nh3_ndx) end if ! - is_spcam_m2005 = cam_physpkg_is('spcam_m2005') call pbuf_get_field(pbuf, dgnum_idx, dgnum) call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet ) @@ -1843,14 +1044,13 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ ! call qqcw2vmr( lchnk, vmrcw, mbar, ncol, loffset, pbuf ) - if (.not. is_spcam_m2005) then ! regular CAM - dvmrdt(:ncol,:,:) = vmr(:ncol,:,:) - dvmrcwdt(:ncol,:,:) = vmrcw(:ncol,:,:) + dvmrdt(:ncol,:,:) = vmr(:ncol,:,:) + dvmrcwdt(:ncol,:,:) = vmrcw(:ncol,:,:) ! aqueous chemistry ... - if( has_sox ) then - call setsox( & + if( has_sox ) then + call setsox( & ncol, & lchnk, & loffset, & @@ -1873,21 +1073,21 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ aqso4_o3 & ) - do n = 1, ntot_amode - l = lptr_so4_cw_amode(n) - if (l > 0) then - call outfld( trim(cnst_name_cw(l))//'AQSO4', aqso4(:ncol,n), ncol, lchnk) - call outfld( trim(cnst_name_cw(l))//'AQH2SO4', aqh2so4(:ncol,n), ncol, lchnk) - end if - end do + do n = 1, ntot_amode + l = lptr_so4_cw_amode(n) + if (l > 0) then + call outfld( trim(cnst_name_cw(l))//'AQSO4', aqso4(:ncol,n), ncol, lchnk) + call outfld( trim(cnst_name_cw(l))//'AQH2SO4', aqh2so4(:ncol,n), ncol, lchnk) + end if + end do - call outfld( 'AQSO4_H2O2', aqso4_h2o2(:ncol), ncol, lchnk) - call outfld( 'AQSO4_O3', aqso4_o3(:ncol), ncol, lchnk) - call outfld( 'XPH_LWC', xphlwc(:ncol,:), ncol, lchnk ) + call outfld( 'AQSO4_H2O2', aqso4_h2o2(:ncol), ncol, lchnk) + call outfld( 'AQSO4_O3', aqso4_o3(:ncol), ncol, lchnk) + call outfld( 'XPH_LWC', xphlwc(:ncol,:), ncol, lchnk ) - endif + endif -! Tendency due to aqueous chemistry + ! Tendency due to aqueous chemistry dvmrdt = (vmr - dvmrdt) / delt dvmrcwdt = (vmrcw - dvmrcwdt) / delt do m = 1, gas_pcnst @@ -1899,15 +1099,6 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ call outfld( name, wrk(:ncol), ncol, lchnk ) enddo - else if (is_spcam_m2005) then ! SPCAM ECPP -! when ECPP is used, aqueous chemistry is done in ECPP, -! and not updated here. -! Minghuai Wang, 2010-02 (Minghuai.Wang@pnl.gov) -! - dvmrdt = 0.0_r8 - dvmrcwdt = 0.0_r8 - endif - ! do gas-aerosol exchange (h2so4, msa, nh3 condensation) if (ndx_h2so4 > 0) then @@ -1917,7 +1108,7 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ endif call t_startf('modal_gas-aer_exchng') - + if ( sulfeq_idx>0 ) then call pbuf_get_field( pbuf, sulfeq_idx, sulfeq ) else @@ -1969,7 +1160,7 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, reaction_ call vmr2qqcw( lchnk, vmrcw, mbar, ncol, loffset, pbuf ) - ! diagnostics for cloud-borne aerosols... + ! diagnostics for cloud-borne aerosols... do n = 1,pcnst fldcw => qqcw_get_field(pbuf,n,lchnk,errorhandle=.true.) if(associated(fldcw)) then @@ -2075,7 +1266,7 @@ subroutine surf_area_dens( ncol, mmr, pmid, temp, diam, beglev, endlev, sad, ref real(r8) :: sad_mode(pcols,pver,ntot_amode),radeff(pcols,pver) real(r8) :: vol(pcols,pver),vol_mode(pcols,pver,ntot_amode) real(r8) :: rho_air - integer :: i,k,l,m + integer :: i,k,l,m real(r8) :: chm_mass, tot_mass ! @@ -2110,7 +1301,7 @@ subroutine surf_area_dens( ncol, mmr, pmid, temp, diam, beglev, endlev, sad, ref * mmr(i,k,num_idx(l))*rho_air*pi*diam(i,k,l)**2._r8 & * exp(2._r8*alnsg_amode(l)**2._r8) ! m^2/m^3 sad_mode(i,k,l) = 1.e-2_r8 * sad_mode(i,k,l) ! cm^2/cm^3 - + ! volume calculation, for use in effective radius calculation vol_mode(i,k,l) = chm_mass/tot_mass & * mmr(i,k,num_idx(l))*rho_air*pi/6._r8*diam(i,k,l)**3._r8 & @@ -2128,7 +1319,7 @@ subroutine surf_area_dens( ncol, mmr, pmid, temp, diam, beglev, endlev, sad, ref enddo if (present(sfc)) then - sfc(:,:,:) = sad_mode(:,:,:) + sfc(:,:,:) = sad_mode(:,:,:) endif end subroutine surf_area_dens @@ -2144,7 +1335,7 @@ subroutine modal_aero_bcscavcoef_init ! Authors: R. Easter ! !----------------------------------------------------------------------- - + use shr_kind_mod, only: r8 => shr_kind_r8 use modal_aero_data use cam_abortutils, only: endrun @@ -2168,7 +1359,7 @@ subroutine modal_aero_bcscavcoef_init allocate(scavimptblnum(nimptblgrow_mind:nimptblgrow_maxd, ntot_amode)) allocate(scavimptblvol(nimptblgrow_mind:nimptblgrow_maxd, ntot_amode)) - + lunerr = 6 dlndg_nimptblgrow = log( 1.25_r8 ) @@ -2309,7 +1500,7 @@ subroutine modal_aero_depvel_part( ncol, t, pmid, ram1, fv, vlc_dry, vlc_trb, vl ! data gamma/0.54d+00, 0.56d+00, 0.57d+00, 0.54d+00, 0.54d+00, & ! 0.56d+00, 0.54d+00, 0.54d+00, 0.54d+00, 0.56d+00, & ! 0.50d+00/ - data gamma/0.56e+00_r8, 0.54e+00_r8, 0.54e+00_r8, 0.56e+00_r8, 0.56e+00_r8, & + data gamma/0.56e+00_r8, 0.54e+00_r8, 0.54e+00_r8, 0.56e+00_r8, 0.56e+00_r8, & 0.56e+00_r8, 0.50e+00_r8, 0.54e+00_r8, 0.54e+00_r8, 0.54e+00_r8, & 0.54e+00_r8/ save gamma @@ -2345,7 +1536,7 @@ subroutine modal_aero_depvel_part( ncol, t, pmid, ram1, fv, vlc_dry, vlc_trb, vl vlc_trb = 0._r8 vlc_grv = 0._r8 vlc_dry = 0._r8 - + !------------------------------------------------------------------------ do k=top_lev,pver ! radius_part is not defined above top_lev do i=1,ncol @@ -2397,7 +1588,7 @@ subroutine modal_aero_depvel_part( ncol, t, pmid, ram1, fv, vlc_dry, vlc_trb, vl stk_nbr = vlc_grv(i,k) * fv(i) * fv(i) / (gravit*vsc_knm_atm(i,k)) ![frc] SeP97 p.965 interception = 0.0_r8 endif - impaction = (stk_nbr/(alpha(lt)+stk_nbr))**2.0_r8 + impaction = (stk_nbr/(alpha(lt)+stk_nbr))**2.0_r8 if (iwet(lt) > 0) then stickfrac = 1.0_r8 @@ -2538,11 +1729,11 @@ subroutine calc_1_impact_rate( & real(r8) r, rainsweepout, reynolds, rhi, rhoair, rlo, rnumsum real(r8) scavsumnum, scavsumnumbb real(r8) scavsumvol, scavsumvolbb - real(r8) schmidt, sqrtreynolds, sstar, stokes, sx + real(r8) schmidt, sqrtreynolds, sstar, stokes, sx real(r8) taurelax, vfall, vfallstp - real(r8) x, xg0, xg3, xhi, xlo, xmuwaterair + real(r8) x, xg0, xg3, xhi, xlo, xmuwaterair + - rlo = .005_r8 rhi = .250_r8 dr = 0.005_r8 @@ -2728,7 +1919,7 @@ subroutine calc_1_impact_rate( & return end subroutine calc_1_impact_rate - + !============================================================================= !============================================================================= subroutine qqcw2vmr(lchnk, vmr, mbar, ncol, im, pbuf) @@ -2813,7 +2004,7 @@ subroutine vmr2qqcw( lchnk, vmr, mbar, ncol, im, pbuf ) end subroutine vmr2qqcw function get_dlndg_nimptblgrow() result (dlndg_nimptblgrow_ret) - real(r8) :: dlndg_nimptblgrow_ret + real(r8) :: dlndg_nimptblgrow_ret dlndg_nimptblgrow_ret = dlndg_nimptblgrow end function get_dlndg_nimptblgrow diff --git a/src/chemistry/modal_aero/dust_model.F90 b/src/chemistry/modal_aero/dust_model.F90 index 122fed7ff1..6213c47636 100644 --- a/src/chemistry/modal_aero/dust_model.F90 +++ b/src/chemistry/modal_aero/dust_model.F90 @@ -1,11 +1,13 @@ !=============================================================================== ! Dust for Modal 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 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 @@ -104,7 +125,7 @@ subroutine dust_init() if ( ntot_amode == 3 ) then dust_dmt_grd(:) = (/ 0.1e-6_r8, 1.0e-6_r8, 10.0e-6_r8/) dust_emis_sclfctr(:) = (/ 0.011_r8,0.989_r8 /) - elseif ( ntot_amode == 4 ) then + elseif ( ntot_amode == 4 .or. ntot_amode == 5 ) then dust_dmt_grd(:) = (/ 0.01e-6_r8, 0.1e-6_r8, 1.0e-6_r8, 10.0e-6_r8 /) ! Aitken dust dust_emis_sclfctr(:) = (/ 1.65E-05_r8, 0.011_r8, 0.989_r8 /) ! Aitken dust else if( ntot_amode == 7 ) then @@ -130,8 +151,10 @@ 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_coag.F90 b/src/chemistry/modal_aero/modal_aero_coag.F90 index 4e3219ed97..5c6806ff94 100644 --- a/src/chemistry/modal_aero/modal_aero_coag.F90 +++ b/src/chemistry/modal_aero/modal_aero_coag.F90 @@ -24,7 +24,7 @@ module modal_aero_coag ! !PUBLIC DATA MEMBERS: integer, parameter :: pcnstxx = gas_pcnst -#if ( defined MODAL_AERO_7MODE || defined MODAL_AERO_4MODE ) +#if ( defined MODAL_AERO_7MODE || defined MODAL_AERO_4MODE || defined MODAL_AERO_5MODE) integer, parameter, public :: pair_option_acoag = 3 #elif ( defined MODAL_AERO_3MODE ) integer, parameter, public :: pair_option_acoag = 1 diff --git a/src/chemistry/modal_aero/modal_aero_convproc.F90 b/src/chemistry/modal_aero/modal_aero_convproc.F90 deleted file mode 100644 index d9636daf8c..0000000000 --- a/src/chemistry/modal_aero/modal_aero_convproc.F90 +++ /dev/null @@ -1,2975 +0,0 @@ - -module modal_aero_convproc -!--------------------------------------------------------------------------------- -! Purpose: -! -! CAM interface to aerosol/trace-gas convective cloud processing scheme -! -! currently these routines assume stratiform and convective clouds only interact -! through the detrainment of convective cloudborne material into stratiform clouds -! -! thus the stratiform-cloudborne aerosols (in the qqcw array) are not processed -! by the convective up/downdrafts, but are affected by the detrainment -! -! Author: R. C. Easter -! -!--------------------------------------------------------------------------------- - -use shr_kind_mod, only: r8=>shr_kind_r8 -use spmd_utils, only: masterproc -use physconst, only: gravit, rair -use ppgrid, only: pver, pcols, pverp -use constituents, only: pcnst, cnst_name -use constituents, only: cnst_species_class, cnst_spec_class_aerosol, cnst_spec_class_gas -use phys_control, only: phys_getopts - -use physics_types, only: physics_state, physics_ptend -use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field - -use time_manager, only: get_nstep -use cam_history, only: outfld, addfld, add_default, horiz_only -use cam_logfile, only: iulog -use cam_abortutils, only: endrun - -use modal_aero_data, only: lmassptr_amode, nspec_amode, ntot_amode, numptr_amode -use modal_aero_data, only: lptr_so4_a_amode, lptr_dust_a_amode, lptr_nacl_a_amode, mode_size_order -use modal_aero_data, only: lptr2_pom_a_amode, lptr2_soa_a_amode, lptr2_bc_a_amode, nsoa, npoa, nbc -use modal_aero_data, only: lptr_msa_a_amode, lptr_nh4_a_amode, lptr_no3_a_amode - -implicit none -private -save - -public :: & - ma_convproc_register, & - ma_convproc_init, & - ma_convproc_intr, & - ma_convproc_readnl - -! namelist options -! NOTE: These are the defaults for CAM6. -logical, protected, public :: convproc_do_gas = .false. -logical, protected, public :: deepconv_wetdep_history = .true. -logical, protected, public :: convproc_do_deep = .true. -! NOTE: Shallow convection processing does not currently work with CLUBB. -logical, protected, public :: convproc_do_shallow = .false. -! NOTE: These are the defaults for the Eaton/Wang parameterization. -logical, protected, public :: convproc_do_evaprain_atonce = .false. -real(r8), protected, public :: convproc_pom_spechygro = -1._r8 -real(r8), protected, public :: convproc_wup_max = 4.0_r8 - -logical, parameter :: use_cwaer_for_activate_maxsat = .false. -logical, parameter :: apply_convproc_tend_to_ptend = .true. - -real(r8) :: hund_ovr_g ! = 100.0_r8/gravit -! used with zm_conv mass fluxes and delta-p -! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s] -! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2] - -! method1_activate_nlayers = number of layers (including cloud base) where activation is applied -integer, parameter :: method1_activate_nlayers = 2 -! method2_activate_smaxmax = the uniform or peak supersat value (as 0-1 fraction = percent*0.01) -real(r8), parameter :: method2_activate_smaxmax = 0.003_r8 - -! method_reduce_actfrac = 1 -- multiply activation fractions by factor_reduce_actfrac -! (this works ok with convproc_method_activate = 1 but not for ... = 2) -! = 2 -- do 2 iterations to get an overall reduction by factor_reduce_actfrac -! (this works ok with convproc_method_activate = 1 or 2) -! = other -- do nothing involving reduce_actfrac -integer, parameter :: method_reduce_actfrac = 0 -real(r8), parameter :: factor_reduce_actfrac = 0.5_r8 - -! convproc_method_activate - 1=apply abdulrazzak-ghan to entrained aerosols for lowest nlayers -! 2=do secondary activation with prescribed supersat -integer, parameter :: convproc_method_activate = 2 - -logical :: convproc_do_aer - -! physics buffer indices -integer :: fracis_idx = 0 - -integer :: rprddp_idx = 0 -integer :: rprdsh_idx = 0 -integer :: nevapr_shcu_idx = 0 -integer :: nevapr_dpcu_idx = 0 - -integer :: icwmrdp_idx = 0 -integer :: icwmrsh_idx = 0 -integer :: sh_frac_idx = 0 -integer :: dp_frac_idx = 0 - -integer :: zm_mu_idx = 0 -integer :: zm_eu_idx = 0 -integer :: zm_du_idx = 0 -integer :: zm_md_idx = 0 -integer :: zm_ed_idx = 0 -integer :: zm_dp_idx = 0 -integer :: zm_dsubcld_idx = 0 -integer :: zm_jt_idx = 0 -integer :: zm_maxg_idx = 0 -integer :: zm_ideep_idx = 0 - -integer :: cmfmc_sh_idx = 0 -integer :: sh_e_ed_ratio_idx = 0 - -integer :: istat - -logical, parameter :: debug=.false. - -!========================================================================================= -contains -!========================================================================================= - -subroutine ma_convproc_register - -end subroutine ma_convproc_register - -!========================================================================================= -subroutine ma_convproc_readnl(nlfile) - - use namelist_utils, only: find_group_name - use spmd_utils, only: mpicom, masterprocid, mpi_real8, mpi_logical - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'ma_convproc_readnl' - - namelist /aerosol_convproc_opts/ convproc_do_gas, deepconv_wetdep_history, convproc_do_deep, & - convproc_do_shallow, convproc_do_evaprain_atonce, convproc_pom_spechygro, convproc_wup_max - - ! Read namelist - if (masterproc) then - open( newunit=unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'aerosol_convproc_opts', status=ierr) - if (ierr == 0) then - read(unitn, aerosol_convproc_opts, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - end if - - ! Broadcast namelist variables - call mpi_bcast( convproc_do_gas, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast( deepconv_wetdep_history, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast( convproc_do_deep, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast( convproc_do_shallow, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast( convproc_do_evaprain_atonce, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast( convproc_pom_spechygro, 1, mpi_real8, masterprocid, mpicom, ierr) - call mpi_bcast( convproc_wup_max, 1, mpi_real8, masterprocid, mpicom, ierr) - - if (masterproc) then - write(iulog,*) subname//': convproc_do_gas = ', convproc_do_gas - write(iulog,*) subname//': deepconv_wetdep_history = ',deepconv_wetdep_history - write(iulog,*) subname//': convproc_do_deep = ',convproc_do_deep - write(iulog,*) subname//': convproc_do_shallow = ',convproc_do_shallow - write(iulog,*) subname//': convproc_do_evaprain_atonce = ',convproc_do_evaprain_atonce - write(iulog,*) subname//': convproc_pom_spechygro = ',convproc_pom_spechygro - write(iulog,*) subname//': convproc_wup_max = ', convproc_wup_max - end if - -end subroutine ma_convproc_readnl - -!========================================================================================= - -subroutine ma_convproc_init - - integer :: n, l, ll - integer :: npass_calc_updraft - logical :: history_aerosol - - call phys_getopts( history_aerosol_out=history_aerosol, & - convproc_do_aer_out = convproc_do_aer ) - - call addfld('SH_MFUP_MAX', horiz_only, 'A', 'kg/m2', & - 'Shallow conv. column-max updraft mass flux' ) - call addfld('SH_WCLDBASE', horiz_only, 'A', 'm/s', & - 'Shallow conv. cloudbase vertical velocity' ) - call addfld('SH_KCLDBASE', horiz_only, 'A', '1', & - 'Shallow conv. cloudbase level index' ) - - call addfld('DP_MFUP_MAX', horiz_only, 'A', 'kg/m2', & - 'Deep conv. column-max updraft mass flux' ) - 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' ) - - ! output wet deposition fields to history - ! I = in-cloud removal; E = precip-evap resuspension - ! C = convective (total); D = deep convective - ! note that the precip-evap resuspension includes that resulting from - ! below-cloud removal, calculated in mz_aero_wet_intr - if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then - do n = 1, ntot_amode - do ll = 0, nspec_amode(n) - if (ll == 0) then - l = numptr_amode(n) - else - l = lmassptr_amode(ll,n) - end if - - call addfld (trim(cnst_name(l))//'SFSEC', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, convective) at surface') - if (history_aerosol) then - call add_default(trim(cnst_name(l))//'SFSEC', 1, ' ') - end if - - if ( deepconv_wetdep_history ) then - call addfld (trim(cnst_name(l))//'SFSID', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (incloud, deep convective) at surface') - call addfld (trim(cnst_name(l))//'SFSED', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, deep convective) at surface') - if (history_aerosol) then - call add_default(trim(cnst_name(l))//'SFSID', 1, ' ') - call add_default(trim(cnst_name(l))//'SFSED', 1, ' ') - end if - end if - end do - end do - end if - - 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, ' ' ) - end if - - fracis_idx = pbuf_get_index('FRACIS') - - rprddp_idx = pbuf_get_index('RPRDDP') - rprdsh_idx = pbuf_get_index('RPRDSH') - nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') - nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') - - icwmrdp_idx = pbuf_get_index('ICWMRDP') - icwmrsh_idx = pbuf_get_index('ICWMRSH') - dp_frac_idx = pbuf_get_index('DP_FRAC') - sh_frac_idx = pbuf_get_index('SH_FRAC') - - zm_mu_idx = pbuf_get_index('ZM_MU') - zm_eu_idx = pbuf_get_index('ZM_EU') - zm_du_idx = pbuf_get_index('ZM_DU') - zm_md_idx = pbuf_get_index('ZM_MD') - zm_ed_idx = pbuf_get_index('ZM_ED') - zm_dp_idx = pbuf_get_index('ZM_DP') - zm_dsubcld_idx = pbuf_get_index('ZM_DSUBCLD') - zm_jt_idx = pbuf_get_index('ZM_JT') - zm_maxg_idx = pbuf_get_index('ZM_MAXG') - zm_ideep_idx = pbuf_get_index('ZM_IDEEP') - - cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') - sh_e_ed_ratio_idx = pbuf_get_index('SH_E_ED_RATIO', istat) - - if (masterproc ) then - - write(iulog,'(a,l12)') 'ma_convproc_init - convproc_do_aer = ', & - convproc_do_aer - write(iulog,'(a,l12)') 'ma_convproc_init - convproc_do_gas = ', & - convproc_do_gas - write(iulog,'(a,l12)') 'ma_convproc_init - use_cwaer_for_activate_maxsat = ', & - use_cwaer_for_activate_maxsat - write(iulog,'(a,l12)') 'ma_convproc_init - apply_convproc_tend_to_ptend = ', & - apply_convproc_tend_to_ptend - write(iulog,'(a,i12)') 'ma_convproc_init - convproc_method_activate = ', & - convproc_method_activate - write(iulog,'(a,i12)') 'ma_convproc_init - method1_activate_nlayers = ', & - method1_activate_nlayers - write(iulog,'(a,1pe12.4)') 'ma_convproc_init - method2_activate_smaxmax = ', & - method2_activate_smaxmax - write(iulog,'(a,i12)') 'ma_convproc_init - method_reduce_actfrac = ', & - method_reduce_actfrac - write(iulog,'(a,1pe12.4)') 'ma_convproc_init - factor_reduce_actfrac = ', & - factor_reduce_actfrac - - npass_calc_updraft = 1 - if ( (method_reduce_actfrac == 2) .and. & - (factor_reduce_actfrac >= 0.0_r8) .and. & - (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2 - write(iulog,'(a,i12)') 'ma_convproc_init - npass_calc_updraft = ', & - npass_calc_updraft - - end if - -end subroutine ma_convproc_init - -!========================================================================================= - -subroutine ma_convproc_intr( state, ptend, pbuf, ztodt, & - nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, & - aerdepwetis, dcondt_resusp3d ) -!----------------------------------------------------------------------- -! -! Convective cloud processing (transport, activation/resuspension, -! wet removal) of aerosols and trace gases. -! (Currently no aqueous chemistry and no trace-gas wet removal) -! Does aerosols when convproc_do_aer is .true. -! Does trace gases when convproc_do_gas is .true. -! -! Does deep and shallow convection -! Uses mass fluxes, cloud water, precip production from the -! convective cloud routines -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - - - ! Arguments - type(physics_state), intent(in ) :: state ! Physics state variables - type(physics_ptend), intent(inout) :: ptend ! %lq set in aero_model_wetdep - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) - - integer, intent(in) :: nsrflx_mzaer2cnvpr - real(r8), intent(in) :: qsrflx_mzaer2cnvpr(pcols,pcnst,nsrflx_mzaer2cnvpr) - real(r8), intent(inout) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial) - real(r8), intent(inout) :: dcondt_resusp3d(2*pcnst,pcols,pver) - - ! Local variables - integer, parameter :: nsrflx = 5 ! last dimension of qsrflx - integer :: l, ll, lchnk - integer :: n, ncol - - real(r8) :: dqdt(pcols,pver,pcnst) - real(r8) :: dt - real(r8) :: qa(pcols,pver,pcnst), qb(pcols,pver,pcnst) - real(r8) :: qsrflx(pcols,pcnst,nsrflx) - real(r8) :: sflxic(pcols,pcnst) - real(r8) :: sflxid(pcols,pcnst) - real(r8) :: sflxec(pcols,pcnst) - real(r8) :: sflxed(pcols,pcnst) - - logical :: dotend(pcnst) - !------------------------------------------------------------------------------------------------- - - ! Initialize - lchnk = state%lchnk - ncol = state%ncol - dt = ztodt - - hund_ovr_g = 100.0_r8/gravit - ! used with zm_conv mass fluxes and delta-p - ! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s] - ! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2] - - sflxic(:,:) = 0.0_r8 - sflxid(:,:) = 0.0_r8 - sflxec(:,:) = 0.0_r8 - sflxed(:,:) = 0.0_r8 - do l = 1, pcnst - if ( (cnst_species_class(l) == cnst_spec_class_aerosol) .and. ptend%lq(l) ) then - sflxec(1:ncol,l) = qsrflx_mzaer2cnvpr(1:ncol,l,1) - sflxed(1:ncol,l) = qsrflx_mzaer2cnvpr(1:ncol,l,2) - end if - end do - - ! prepare for deep conv processing - do l = 1, pcnst - if ( ptend%lq(l) ) then - ! calc new q (after calcaersize and mz_aero_wet_intr) - qa(1:ncol,:,l) = state%q(1:ncol,:,l) + dt*ptend%q(1:ncol,:,l) - qb(1:ncol,:,l) = max( 0.0_r8, qa(1:ncol,:,l) ) - else - ! use old q - qb(1:ncol,:,l) = state%q(1:ncol,:,l) - end if - end do - dqdt(:,:,:) = 0.0_r8 - qsrflx(:,:,:) = 0.0_r8 - - if (convproc_do_aer .or. convproc_do_gas) then - - ! do deep conv processing - if (convproc_do_deep) then - call ma_convproc_dp_intr( & - state, pbuf, dt, & - qb, dqdt, dotend, nsrflx, qsrflx, dcondt_resusp3d ) - - - ! apply deep conv processing tendency and prepare for shallow conv processing - do l = 1, pcnst - if ( .not. dotend(l) ) cycle - - ! calc new q (after ma_convproc_dp_intr) - qa(1:ncol,:,l) = qb(1:ncol,:,l) + dt*dqdt(1:ncol,:,l) - qb(1:ncol,:,l) = max( 0.0_r8, qa(1:ncol,:,l) ) - - if ( apply_convproc_tend_to_ptend ) then - ! add dqdt onto ptend%q and set ptend%lq - ptend%q(1:ncol,:,l) = ptend%q(1:ncol,:,l) + dqdt(1:ncol,:,l) - ptend%lq(l) = .true. - end if - - if ((cnst_species_class(l) == cnst_spec_class_aerosol) .or. & - (cnst_species_class(l) == cnst_spec_class_gas )) then - ! these used for history file wetdep diagnostics - sflxic(1:ncol,l) = sflxic(1:ncol,l) + qsrflx(1:ncol,l,4) - sflxid(1:ncol,l) = sflxid(1:ncol,l) + qsrflx(1:ncol,l,4) - sflxec(1:ncol,l) = sflxec(1:ncol,l) + qsrflx(1:ncol,l,5) - sflxed(1:ncol,l) = sflxed(1:ncol,l) + qsrflx(1:ncol,l,5) - end if - - if (cnst_species_class(l) == cnst_spec_class_aerosol) then - ! this used for surface coupling - aerdepwetis(1:ncol,l) = aerdepwetis(1:ncol,l) & - + qsrflx(1:ncol,l,4) + qsrflx(1:ncol,l,5) - end if - end do - end if - - dqdt(:,:,:) = 0.0_r8 - qsrflx(:,:,:) = 0.0_r8 - if (convproc_do_shallow) then - call ma_convproc_sh_intr( & - state, pbuf, dt, & - qb, dqdt, dotend, nsrflx, qsrflx, dcondt_resusp3d ) - - ! apply shallow conv processing tendency - do l = 1, pcnst - if ( .not. dotend(l) ) cycle - - ! calc new q (after ma_convproc_sh_intr) - qa(1:ncol,:,l) = qb(1:ncol,:,l) + dt*dqdt(1:ncol,:,l) - qb(1:ncol,:,l) = max( 0.0_r8, qa(1:ncol,:,l) ) - - if ( apply_convproc_tend_to_ptend ) then - ! add dqdt onto ptend%q and set ptend%lq - ptend%q(1:ncol,:,l) = ptend%q(1:ncol,:,l) + dqdt(1:ncol,:,l) - ptend%lq(l) = .true. - end if - - if ((cnst_species_class(l) == cnst_spec_class_aerosol) .or. & - (cnst_species_class(l) == cnst_spec_class_gas )) then - sflxic(1:ncol,l) = sflxic(1:ncol,l) + qsrflx(1:ncol,l,4) - sflxec(1:ncol,l) = sflxec(1:ncol,l) + qsrflx(1:ncol,l,5) - end if - - if (cnst_species_class(l) == cnst_spec_class_aerosol) then - aerdepwetis(1:ncol,l) = aerdepwetis(1:ncol,l) & - + qsrflx(1:ncol,l,4) + qsrflx(1:ncol,l,5) - end if - - end do - end if - - end if ! (convproc_do_aer .or. convproc_do_gas) then - - - if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then - do n = 1, ntot_amode - do ll = 0, nspec_amode(n) - if (ll == 0) then - l = numptr_amode(n) - else - l = lmassptr_amode(ll,n) - end if - - call outfld( trim(cnst_name(l))//'SFWET', aerdepwetis(:,l), pcols, lchnk ) - call outfld( trim(cnst_name(l))//'SFSIC', sflxic(:,l), pcols, lchnk ) - call outfld( trim(cnst_name(l))//'SFSEC', sflxec(:,l), pcols, lchnk ) - - if ( deepconv_wetdep_history ) then - call outfld( trim(cnst_name(l))//'SFSID', sflxid(:,l), pcols, lchnk ) - call outfld( trim(cnst_name(l))//'SFSED', sflxed(:,l), pcols, lchnk ) - end if - end do - end do - end if - -end subroutine ma_convproc_intr - -!========================================================================================= - -subroutine ma_convproc_dp_intr( & - state, pbuf, dt, & - q, dqdt, dotend, nsrflx, qsrflx, dcondt_resusp3d) -!----------------------------------------------------------------------- -! -! Convective cloud processing (transport, activation/resuspension, -! wet removal) of aerosols and trace gases. -! (Currently no aqueous chemistry and no trace-gas wet removal) -! Does aerosols when convproc_do_aer is .true. -! Does trace gases when convproc_do_gas is .true. -! -! This routine does deep convection -! Uses mass fluxes, cloud water, precip production from the -! convective cloud routines -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - - - ! Arguments - type(physics_state), intent(in ) :: state ! Physics state variables - type(physics_buffer_desc), pointer :: pbuf(:) - - real(r8), intent(in) :: dt ! delta t (model time increment) - - real(r8), intent(in) :: q(pcols,pver,pcnst) - real(r8), intent(inout) :: dqdt(pcols,pver,pcnst) - logical, intent(out) :: dotend(pcnst) - integer, intent(in) :: nsrflx - real(r8), intent(inout) :: qsrflx(pcols,pcnst,nsrflx) - real(r8), intent(inout) :: dcondt_resusp3d(pcnst*2,pcols,pver) - - integer :: i - integer :: itmpveca(pcols) - integer :: l, lchnk, lun - integer :: nstep - - real(r8) :: dpdry(pcols,pver) ! layer delta-p-dry (mb) - real(r8) :: fracice(pcols,pver) ! Ice fraction of cloud droplets - real(r8) :: qaa(pcols,pver,pcnst) - real(r8) :: xx_mfup_max(pcols), xx_wcldbase(pcols), xx_kcldbase(pcols) - - ! physics buffer fields - real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble - real(r8), pointer :: rprddp(:,:) ! Deep conv precip production (kg/kg/s - grid avg) - real(r8), pointer :: evapcdp(:,:) ! Deep conv precip evaporation (kg/kg/s - grid avg) - real(r8), pointer :: icwmrdp(:,:) ! Deep conv cloud condensate (kg/kg - in cloud) - real(r8), pointer :: dp_frac(:,:) ! Deep conv cloud frac (0-1) - ! mu, md, ..., ideep, lengath are all deep conv variables - real(r8), pointer :: mu(:,:) ! Updraft mass flux (positive) (pcols,pver) - real(r8), pointer :: md(:,:) ! Downdraft mass flux (negative) (pcols,pver) - real(r8), pointer :: du(:,:) ! Mass detrain rate from updraft (pcols,pver) - real(r8), pointer :: eu(:,:) ! Mass entrain rate into updraft (pcols,pver) - real(r8), pointer :: ed(:,:) ! Mass entrain rate into downdraft (pcols,pver) - ! eu, ed, du are "d(massflux)/dp" and are all positive - real(r8), pointer :: dp(:,:) ! Delta pressure between interfaces (pcols,pver) - real(r8), pointer :: dsubcld(:) ! Delta pressure from cloud base to sfc (pcols) - - integer, pointer :: jt(:) ! Index of cloud top for each column (pcols) - integer, pointer :: maxg(:) ! Index of cloud top for each column (pcols) - integer, pointer :: ideep(:) ! Gathering array (pcols) - integer :: lengath ! Gathered min lon indices over which to operate - - - ! Initialize - - lchnk = state%lchnk - nstep = get_nstep() - lun = iulog - - ! Associate pointers with physics buffer fields - call pbuf_get_field(pbuf, fracis_idx, fracis) - call pbuf_get_field(pbuf, rprddp_idx, rprddp) - call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp) - call pbuf_get_field(pbuf, icwmrdp_idx, icwmrdp) - call pbuf_get_field(pbuf, dp_frac_idx, dp_frac) - call pbuf_get_field(pbuf, fracis_idx, fracis) - call pbuf_get_field(pbuf, zm_mu_idx, mu) - call pbuf_get_field(pbuf, zm_eu_idx, eu) - call pbuf_get_field(pbuf, zm_du_idx, du) - call pbuf_get_field(pbuf, zm_md_idx, md) - call pbuf_get_field(pbuf, zm_ed_idx, ed) - call pbuf_get_field(pbuf, zm_dp_idx, dp) - call pbuf_get_field(pbuf, zm_dsubcld_idx, dsubcld) - call pbuf_get_field(pbuf, zm_jt_idx, jt) - call pbuf_get_field(pbuf, zm_maxg_idx, maxg) - call pbuf_get_field(pbuf, zm_ideep_idx, ideep) - - lengath = count(ideep > 0) - - fracice(:,:) = 0.0_r8 - - ! initialize dpdry (units=mb), which is used for tracers of dry mixing ratio type - dpdry = 0._r8 - do i = 1, lengath - dpdry(i,:) = state%pdeldry(ideep(i),:)/100._r8 - end do - - qaa = q - - ! turn on/off calculations for aerosols and trace gases - do l = 1, pcnst - dotend(l) = .false. - if (cnst_species_class(l) == cnst_spec_class_aerosol) then - if (convproc_do_aer) dotend(l) = .true. - else if (cnst_species_class(l) == cnst_spec_class_gas) then - if (convproc_do_gas) dotend(l) = .true. - end if - end do - - itmpveca(:) = -1 - - call ma_convproc_tend( & - 'deep', & - lchnk, pcnst, nstep, dt, & - state%t, state%pmid, state%pdel, qaa, & - mu, md, du, eu, & - ed, dp, dpdry, jt, & - maxg, ideep, 1, lengath, & - dp_frac, icwmrdp, rprddp, evapcdp, & - fracice, & - dqdt, dotend, nsrflx, qsrflx, & - xx_mfup_max, xx_wcldbase, xx_kcldbase, & - lun, itmpveca, dcondt_resusp3d ) - - call outfld( 'DP_MFUP_MAX', xx_mfup_max, pcols, lchnk ) - call outfld( 'DP_WCLDBASE', xx_wcldbase, pcols, lchnk ) - call outfld( 'DP_KCLDBASE', xx_kcldbase, pcols, lchnk ) - -end subroutine ma_convproc_dp_intr - - - -!========================================================================================= -subroutine ma_convproc_sh_intr( & - state, pbuf, dt, & - q, dqdt, dotend, nsrflx, qsrflx, dcondt_resusp3d ) -!----------------------------------------------------------------------- -! -! Purpose: -! Convective cloud processing (transport, activation/resuspension, -! wet removal) of aerosols and trace gases. -! (Currently no aqueous chemistry and no trace-gas wet removal) -! Does aerosols when convproc_do_aer is .true. -! Does trace gases when convproc_do_gas is .true. -! -! This routine does shallow convection -! Uses mass fluxes, cloud water, precip production from the -! convective cloud routines -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - -! Arguments - type(physics_state), intent(in ) :: state ! Physics state variables - type(physics_buffer_desc), pointer :: pbuf(:) - - real(r8), intent(in) :: dt ! delta t (model time increment) - - real(r8), intent(in) :: q(pcols,pver,pcnst) - real(r8), intent(inout) :: dqdt(pcols,pver,pcnst) - logical, intent(out) :: dotend(pcnst) - integer, intent(in) :: nsrflx - real(r8), intent(inout) :: qsrflx(pcols,pcnst,nsrflx) - real(r8), intent(inout) :: dcondt_resusp3d(pcnst*2,pcols,pver) - - integer :: i - integer :: itmpveca(pcols) - integer :: k, kaa, kbb, kk - integer :: l, lchnk, lun - integer :: maxg_minval - integer :: ncol, nstep - - real(r8) :: dpdry(pcols,pver) ! layer delta-p-dry (mb) - real(r8) :: fracice(pcols,pver) ! Ice fraction of cloud droplets - real(r8) :: qaa(pcols,pver,pcnst) - real(r8) :: tmpa, tmpb - real(r8) :: xx_mfup_max(pcols), xx_wcldbase(pcols), xx_kcldbase(pcols) - - ! variables that mimic the zm-deep counterparts - real(r8) :: mu(pcols,pver) ! Updraft mass flux (positive) - real(r8) :: md(pcols,pver) ! Downdraft mass flux (negative) - real(r8) :: du(pcols,pver) ! Mass detrain rate from updraft - real(r8) :: eu(pcols,pver) ! Mass entrain rate into updraft - real(r8) :: ed(pcols,pver) ! Mass entrain rate into downdraft - ! eu, ed, du are "d(massflux)/dp" and are all positive - real(r8) :: dp(pcols,pver) ! Delta pressure between interfaces - - integer :: jt(pcols) ! Index of cloud top for each column - integer :: maxg(pcols) ! Index of cloud bot for each column - integer :: ideep(pcols) ! Gathering array - integer :: lengath ! Gathered min lon indices over which to operate - - ! physics buffer fields - real(r8), pointer :: rprdsh(:,:) ! Shallow conv precip production (kg/kg/s - grid avg) - real(r8), pointer :: evapcsh(:,:) ! Shal conv precip evaporation (kg/kg/s - grid avg) - real(r8), pointer :: icwmrsh(:,:) ! Shal conv cloud condensate (kg/kg - in cloud) - real(r8), pointer :: sh_frac(:,:) ! Shal conv cloud frac (0-1) - - real(r8), pointer :: cmfmcsh(:,:) ! Shallow conv mass flux (pcols,pverp) (kg/m2/s) - real(r8), pointer :: sh_e_ed_ratio(:,:) ! shallow conv [ent/(ent+det)] ratio (pcols,pver) - - ! Initialize - - lchnk = state%lchnk - ncol = state%ncol - nstep = get_nstep() - lun = iulog - - ! Associate pointers with physics buffer fields - call pbuf_get_field(pbuf, rprdsh_idx, rprdsh) - call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh) - call pbuf_get_field(pbuf, icwmrsh_idx, icwmrsh) - call pbuf_get_field(pbuf, sh_frac_idx, sh_frac) - call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmcsh) - if (sh_e_ed_ratio_idx .gt. 0) then - call pbuf_get_field(pbuf, sh_e_ed_ratio_idx, sh_e_ed_ratio) - end if - - fracice(:,:) = 0.0_r8 - - ! create mass flux, entrainment, detrainment, and delta-p arrays - ! with same units as the zm-deep - mu(:,:) = 0.0_r8 - md(:,:) = 0.0_r8 - du(:,:) = 0.0_r8 - eu(:,:) = 0.0_r8 - ed(:,:) = 0.0_r8 - jt(:) = -1 - maxg(:) = -1 - ideep(:) = -1 - lengath = ncol - maxg_minval = pver*2 - - ! these dp and dpdry have units of mb - dpdry(1:ncol,:) = state%pdeldry(1:ncol,:)/100._r8 - dp( 1:ncol,:) = state%pdel( 1:ncol,:)/100._r8 - - do i = 1, ncol - ideep(i) = i - - ! load updraft mass flux from cmfmcsh - kk = 0 - do k = 2, pver - ! if mass-flux < 1e-7 kg/m2/s ~= 1e-7 m/s ~= 1 cm/day, treat as zero - if (cmfmcsh(i,k) >= 1.0e-7_r8) then - ! mu has units of mb/s - mu(i,k) = cmfmcsh(i,k) / hund_ovr_g - kk = kk + 1 - if (kk == 1) jt(i) = k - 1 - maxg(i) = k - end if - end do - if (kk <= 0) cycle ! current column has no convection - - ! extend below-cloud source region downwards (how far?) - maxg_minval = min( maxg_minval, maxg(i) ) - kaa = maxg(i) - kbb = min( kaa+4, pver ) - ! kbb = pver - if (kbb > kaa) then - tmpa = sum( dpdry(i,kaa:kbb) ) - do k = kaa+1, kbb - mu(i,k) = mu(i,kaa)*sum( dpdry(i,k:kbb) )/tmpa - end do - maxg(i) = kbb - end if - - ! calc ent / detrainment, using the [ent/(ent+det)] ratio from uw scheme - ! which is equal to [fer_out/(fer_out+fdr_out)] (see uwshcu.F90) - ! - ! note that the ratio is set to -1.0 (invalid) when both fer and fdr are very small - ! and the ratio values are often strange (??) at topmost layer - ! - ! for initial testing, impose a limit of - ! entrainment <= 4 * (net entrainment), OR - ! detrainment <= 4 * (net detrainment) - do k = jt(i), maxg(i) - if (k < pver) then - tmpa = (mu(i,k) - mu(i,k+1))/dpdry(i,k) - else - tmpa = mu(i,k)/dpdry(i,k) - end if - if (sh_e_ed_ratio_idx .gt. 0) then - tmpb = sh_e_ed_ratio(i,k) - else - tmpb = -1.0_r8 ! force ent only or det only - end if - if (tmpb < -1.0e-5_r8) then - ! do ent only or det only - if (tmpa >= 0.0_r8) then - ! net entrainment - eu(i,k) = tmpa - else - ! net detrainment - du(i,k) = -tmpa - end if - else - if (tmpa >= 0.0_r8) then - ! net entrainment - if (k >= kaa .or. tmpb < 0.0_r8) then - ! layers at/below initial maxg, or sh_e_ed_ratio is invalid - eu(i,k) = tmpa - else - tmpb = max( tmpb, 0.571_r8 ) - eu(i,k) = tmpa*(tmpb/(2.0_r8*tmpb - 1.0_r8)) - du(i,k) = eu(i,k) - tmpa - end if - else - ! net detrainment - tmpa = -tmpa - if (k <= jt(i) .or. tmpb < 0.0_r8) then - ! layers at/above jt (where ratio is strange??), or sh_e_ed_ratio is invalid - du(i,k) = tmpa - else - tmpb = min( tmpb, 0.429_r8 ) - du(i,k) = tmpa*(1.0_r8 - tmpb)/(1.0_r8 - 2.0_r8*tmpb) - eu(i,k) = du(i,k) - tmpa - end if - end if - end if - end do ! k - - end do ! i - - qaa = q - - ! turn on/off calculations for aerosols and trace gases - do l = 1, pcnst - dotend(l) = .false. - if (cnst_species_class(l) == cnst_spec_class_aerosol) then - if (convproc_do_aer) dotend(l) = .true. - else if (cnst_species_class(l) == cnst_spec_class_gas) then - if (convproc_do_gas) dotend(l) = .true. - end if - end do - - - itmpveca(:) = -1 - - call ma_convproc_tend( & - 'uwsh', & - lchnk, pcnst, nstep, dt, & - state%t, state%pmid, state%pdel, qaa, & - mu, md, du, eu, & - ed, dp, dpdry, jt, & - maxg, ideep, 1, lengath, & - sh_frac, icwmrsh, rprdsh, evapcsh, & - fracice, & - dqdt, dotend, nsrflx, qsrflx, & - xx_mfup_max, xx_wcldbase, xx_kcldbase, & - lun, itmpveca, dcondt_resusp3d) - - call outfld( 'SH_MFUP_MAX', xx_mfup_max, pcols, lchnk ) - call outfld( 'SH_WCLDBASE', xx_wcldbase, pcols, lchnk ) - call outfld( 'SH_KCLDBASE', xx_kcldbase, pcols, lchnk ) - -end subroutine ma_convproc_sh_intr - -!========================================================================================= - -subroutine ma_convproc_tend( & - convtype, & - lchnk, ncnst, nstep, dt, & - t, pmid, pdel, q, & - mu, md, du, eu, & - ed, dp, dpdry, jt, & - mx, ideep, il1g, il2g, & - cldfrac, icwmr, rprd, evapc, & - fracice, & - dqdt, doconvproc, nsrflx, qsrflx, & - xx_mfup_max, xx_wcldbase, xx_kcldbase, & - lun, idiag_in, dcondt_resusp3d ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Convective transport of trace species. -! The trace species need not be conservative, and source/sink terms for -! activation, resuspension, aqueous chemistry and gas uptake, and -! wet removal are all applied. -! Currently this works with the ZM deep convection, but we should be able -! to adapt it for both Hack and McCaa shallow convection -! -! -! Compare to subr convproc which does conservative trace species. -! -! A distinction between "moist" and "dry" mixing ratios is not currently made. -! (P. Rasch comment: Note that we are still assuming that the tracers are -! in a moist mixing ratio this will change soon) - -! -! Method: -! Computes tracer mixing ratios in updraft and downdraft "cells" in a -! Lagrangian manner, with source/sinks applied in the updraft other. -! Then computes grid-cell-mean tendencies by considering -! updraft and downdraft fluxes across layer boundaries -! environment subsidence/lifting fluxes across layer boundaries -! sources and sinks in the updraft -! resuspension of activated species in the grid-cell as a whole -! -! Note1: A better estimate or calculation of either the updraft velocity -! or fractional area is needed. -! Note2: If updraft area is a small fraction of over cloud area, -! then aqueous chemistry is underestimated. These are both -! research areas. -! -! Authors: O. Seland and R. Easter, based on convtran by P. Rasch -! -!----------------------------------------------------------------------- - - use modal_aero_data, only: cnst_name_cw, & - lmassptr_amode, lmassptrcw_amode, & - ntot_amode, ntot_amode, & - nspec_amode, numptr_amode, numptrcw_amode - - implicit none - -!----------------------------------------------------------------------- -! -! Input arguments -! - character(len=*), intent(in) :: convtype ! identifies the type of - ! convection ("deep", "shcu") - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncnst ! number of tracers to transport - integer, intent(in) :: nstep ! Time step index - real(r8), intent(in) :: dt ! Model timestep - real(r8), intent(in) :: t(pcols,pver) ! Temperature - real(r8), intent(in) :: pmid(pcols,pver) ! Pressure at model levels - real(r8), intent(in) :: pdel(pcols,pver) ! Pressure thickness of levels - real(r8), intent(in) :: q(pcols,pver,ncnst) ! Tracer array including moisture - - real(r8), intent(in) :: mu(pcols,pver) ! Updraft mass flux (positive) - real(r8), intent(in) :: md(pcols,pver) ! Downdraft mass flux (negative) - real(r8), intent(in) :: du(pcols,pver) ! Mass detrain rate from updraft - real(r8), intent(in) :: eu(pcols,pver) ! Mass entrain rate into updraft - real(r8), intent(in) :: ed(pcols,pver) ! Mass entrain rate into downdraft -! *** note1 - mu, md, eu, ed, du, dp, dpdry are GATHERED ARRAYS *** -! *** note2 - mu and md units are (mb/s), which is used in the zm_conv code -! - eventually these should be changed to (kg/m2/s) -! *** note3 - eu, ed, du are "d(massflux)/dp" (with dp units = mb), and are all >= 0 - - real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces (mb) - real(r8), intent(in) :: dpdry(pcols,pver) ! Delta dry-pressure (mb) -! real(r8), intent(in) :: dsubcld(pcols) ! Delta pressure from cloud base to sfc - integer, intent(in) :: jt(pcols) ! Index of cloud top for each column - integer, intent(in) :: mx(pcols) ! Index of cloud top for each column - integer, intent(in) :: ideep(pcols) ! Gathering array indices - integer, intent(in) :: il1g ! Gathered min lon indices over which to operate - integer, intent(in) :: il2g ! Gathered max lon indices over which to operate -! *** note4 -- for il1g <= i <= il2g, icol = ideep(i) is the "normal" chunk column index - - real(r8), intent(in) :: cldfrac(pcols,pver) ! Convective cloud fractional area - real(r8), intent(in) :: icwmr(pcols,pver) ! Convective cloud water from zhang - real(r8), intent(in) :: rprd(pcols,pver) ! Convective precipitation formation rate - real(r8), intent(in) :: evapc(pcols,pver) ! Convective precipitation evaporation rate - real(r8), intent(in) :: fracice(pcols,pver) ! Ice fraction of cloud droplets - - real(r8), intent(out):: dqdt(pcols,pver,ncnst) ! Tracer tendency array - logical, intent(in) :: doconvproc(ncnst) ! flag for doing convective transport - integer, intent(in) :: nsrflx ! last dimension of qsrflx - real(r8), intent(out):: qsrflx(pcols,pcnst,nsrflx) - ! process-specific column tracer tendencies - ! (1=activation, 2=resuspension, 3=aqueous rxn, - ! 4=wet removal, 5=renaming) - real(r8), intent(out) :: xx_mfup_max(pcols) - real(r8), intent(out) :: xx_wcldbase(pcols) - real(r8), intent(out) :: xx_kcldbase(pcols) - integer, intent(in) :: lun ! unit number for diagnostic output - integer, intent(in) :: idiag_in(pcols) ! flag for diagnostic output - real(r8), intent(inout) :: dcondt_resusp3d(pcnst*2,pcols,pver) - -!--------------------------Local Variables------------------------------ - -! cloudborne aerosol, so the arrays are dimensioned with pcnst_extd = pcnst*2 - integer, parameter :: pcnst_extd = pcnst*2 - - integer :: i, icol ! Work index - integer :: iconvtype ! 1=deep, 2=uw shallow - integer :: idiag_act ! Work index - integer :: iflux_method ! 1=as in convtran (deep), 2=simpler - integer :: ipass_calc_updraft - integer :: itmpa, itmpb ! Work variable - integer :: j, jtsub ! Work index - integer :: k ! Work index - integer :: kactcnt ! Counter for no. of levels having activation - integer :: kactcntb ! Counter for activation diagnostic output - integer :: kactfirst ! Lowest layer with activation (= cloudbase) - integer :: kbot ! Cloud-flux bottom layer for current i (=mx(i)) - integer :: kbot_prevap ! Lowest layer for doing resuspension from evaporating precip - integer :: ktop ! Cloud-flux top layer for current i (=jt(i)) - ! Layers between kbot,ktop have mass fluxes - ! but not all have cloud water, because the - ! updraft starts below the cloud base - integer :: km1, km1x ! Work index - integer :: kp1, kp1x ! Work index - integer :: l, ll, la, lc ! Work index - integer :: m, n ! Work index - integer :: merr ! number of errors (i.e., failed diagnostics) - ! for current column - integer :: nerr ! number of errors for entire run - integer :: nerrmax ! maximum number of errors to report - integer :: ncnst_extd - integer :: npass_calc_updraft - integer :: ntsub ! - - logical do_act_this_lev ! flag for doing activation at current level - logical doconvproc_extd(pcnst_extd) ! flag for doing convective transport - - real(r8) aqfrac(pcnst_extd) ! aqueous fraction of constituent in updraft - real(r8) cldfrac_i(pver) ! cldfrac at current i (with adjustments) - - real(r8) chat(pcnst_extd,pverp) ! mix ratio in env at interfaces - real(r8) cond(pcnst_extd,pverp) ! mix ratio in downdraft at interfaces - real(r8) const(pcnst_extd,pver) ! gathered tracer array - real(r8) conu(pcnst_extd,pverp) ! mix ratio in updraft at interfaces - - real(r8) dcondt(pcnst_extd,pver) ! grid-average TMR tendency for current column - real(r8) dcondt_prevap(pcnst_extd,pver) ! portion of dcondt from precip evaporation - real(r8) dcondt_resusp(pcnst_extd,pver) ! portion of dcondt from resuspension - - real(r8) dcondt_wetdep(pcnst_extd,pver) ! portion of dcondt from wet deposition - real(r8) dconudt_activa(pcnst_extd,pverp) ! d(conu)/dt by activation - real(r8) dconudt_aqchem(pcnst_extd,pverp) ! d(conu)/dt by aqueous chem - real(r8) dconudt_wetdep(pcnst_extd,pverp) ! d(conu)/dt by wet removal - - real(r8) maxflux(pcnst_extd) ! maximum (over layers) of fluxin and fluxout - real(r8) maxflux2(pcnst_extd) ! ditto but computed using method-2 fluxes - real(r8) maxprevap(pcnst_extd) ! maximum (over layers) of dcondt_prevap*dp - real(r8) maxresusp(pcnst_extd) ! maximum (over layers) of dcondt_resusp*dp - real(r8) maxsrce(pcnst_extd) ! maximum (over layers) of netsrce - - real(r8) sumflux(pcnst_extd) ! sum (over layers) of netflux - real(r8) sumflux2(pcnst_extd) ! ditto but computed using method-2 fluxes - real(r8) sumsrce(pcnst_extd) ! sum (over layers) of dp*netsrce - real(r8) sumchng(pcnst_extd) ! sum (over layers) of dp*dcondt - real(r8) sumchng3(pcnst_extd) ! ditto but after call to resusp_conv - real(r8) sumactiva(pcnst_extd) ! sum (over layers) of dp*dconudt_activa - real(r8) sumaqchem(pcnst_extd) ! sum (over layers) of dp*dconudt_aqchem - real(r8) sumprevap(pcnst_extd) ! sum (over layers) of dp*dcondt_prevap - real(r8) sumresusp(pcnst_extd) ! sum (over layers) of dp*dcondt_resusp - real(r8) sumwetdep(pcnst_extd) ! sum (over layers) of dp*dconudt_wetdep - - real(r8) cabv ! mix ratio of constituent above - real(r8) cbel ! mix ratio of constituent below - real(r8) cdifr ! normalized diff between cabv and cbel - real(r8) cdt(pver) ! (in-updraft first order wet removal rate) * dt - real(r8) clw_cut ! threshold clw value for doing updraft - ! transformation and removal - real(r8) courantmax ! maximum courant no. - real(r8) dddp(pver) ! dd(i,k)*dp(i,k) at current i - real(r8) dp_i(pver) ! dp(i,k) at current i - real(r8) dt_u(pver) ! lagrangian transport time in the updraft - real(r8) dudp(pver) ! du(i,k)*dp(i,k) at current i - real(r8) dqdt_i(pver,pcnst) ! dqdt(i,k,m) at current i - real(r8) dtsub ! dt/ntsub - real(r8) dz ! working layer thickness (m) - real(r8) eddp(pver) ! ed(i,k)*dp(i,k) at current i - real(r8) eudp(pver) ! eu(i,k)*dp(i,k) at current i - real(r8) expcdtm1 ! a work variable - real(r8) fa_u(pver) ! fractional area of in the updraft - real(r8) fa_u_dp ! current fa_u(k)*dp_i(k) - real(r8) f_ent ! fraction of the "before-detrainment" updraft - ! massflux at k/k-1 interface resulting from - ! entrainment of level k air - real(r8) fluxin ! a work variable - real(r8) fluxout ! a work variable - real(r8) maxc ! a work variable - real(r8) mbsth ! Threshold for mass fluxes - real(r8) minc ! a work variable - real(r8) md_m_eddp ! a work variable - real(r8) md_i(pverp) ! md(i,k) at current i (note pverp dimension) - real(r8) md_x(pverp) ! md(i,k) at current i (note pverp dimension) - real(r8) mu_i(pverp) ! mu(i,k) at current i (note pverp dimension) - real(r8) mu_x(pverp) ! mu(i,k) at current i (note pverp dimension) - ! md_i, md_x, mu_i, mu_x are all "dry" mass fluxes - ! the mu_x/md_x are initially calculated from the incoming mu/md by applying dp/dpdry - ! the mu_i/md_i are next calculated by applying the mbsth threshold - real(r8) mu_p_eudp(pver) ! = mu_i(kp1) + eudp(k) - real(r8) netflux ! a work variable - real(r8) netsrce ! a work variable - real(r8) q_i(pver,pcnst) ! q(i,k,m) at current i - real(r8) qsrflx_i(pcnst,nsrflx) ! qsrflx(i,m,n) at current i - real(r8) relerr_cut ! relative error criterion for diagnostics - real(r8) rhoair_i(pver) ! air density at current i - real(r8) small ! a small number - real(r8) tmpa, tmpb ! work variables - real(r8) tmpf ! work variables - real(r8) tmpveca(pcnst_extd) ! work variables - 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) - - character(len=16) :: cnst_name_extd(pcnst_extd) - - !Fractional area of ensemble mean updrafts in ZM scheme set to 0.01 - !Chosen to reproduce vertical vecocities in GATEIII GIGALES (Khairoutdinov etal 2009, JAMES) - real(r8), parameter :: zm_areafrac = 0.01_r8 -!----------------------------------------------------------------------- -! - -! if (nstep > 1) call endrun() - - if (convtype == 'deep') then - iconvtype = 1 - iflux_method = 1 - else if (convtype == 'uwsh') then - iconvtype = 2 - iflux_method = 2 - else - call endrun( '*** ma_convproc_tend -- convtype is not |deep| or |uwsh|' ) - end if - - nerr = 0 - nerrmax = 99 - - ncnst_extd = pcnst_extd - dcondt_resusp3d(:,:,:) = 0._r8 - - small = 1.e-36_r8 -! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s) - mbsth = 1.e-15_r8 - - qsrflx(:,:,:) = 0.0_r8 - dqdt(:,:,:) = 0.0_r8 - xx_mfup_max(:) = 0.0_r8 - xx_wcldbase(:) = 0.0_r8 - xx_kcldbase(:) = 0.0_r8 - - wup(:) = 0.0_r8 - -! set doconvproc_extd (extended array) values -! inititialize aqfrac to 1.0 for activated aerosol species, 0.0 otherwise - doconvproc_extd(:) = .false. - doconvproc_extd(2:ncnst) = doconvproc(2:ncnst) - aqfrac(:) = 0.0_r8 - 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 - if ( doconvproc(la) ) then - doconvproc_extd(lc) = .true. - aqfrac(lc) = 1.0_r8 - end if - enddo - enddo ! n - - do l = 1, pcnst_extd - if (l <= pcnst) then - cnst_name_extd(l) = cnst_name(l) - else - cnst_name_extd(l) = trim(cnst_name(l-pcnst)) // '_cw' - end if - end do - - -! Loop ever each column that has convection -! *** i is index to gathered arrays; ideep(i) is index to "normal" chunk arrays -i_loop_main_aa: & - do i = il1g, il2g - icol = ideep(i) - - - if ( (jt(i) <= 0) .and. (mx(i) <= 0) .and. (iconvtype /= 1) ) then -! shallow conv case with jt,mx <= 0, which means there is no shallow conv -! in this column -- skip this column - cycle i_loop_main_aa - - else if ( (jt(i) < 1) .or. (mx(i) > pver) .or. (jt(i) > mx(i)) ) then -! invalid cloudtop and cloudbase indices -- skip this column - write(lun,9010) 'illegal jt, mx', convtype, lchnk, icol, i, & - jt(i), mx(i) -9010 format( '*** ma_convproc_tend error -- ', a, 5x, 'convtype = ', a / & - '*** lchnk, icol, il, jt, mx = ', 5(1x,i10) ) - cycle i_loop_main_aa - - else if (jt(i) == mx(i)) then -! cloudtop = cloudbase (1 layer cloud) -- skip this column - write(lun,9010) 'jt == mx', convtype, lchnk, icol, i, jt(i), mx(i) - cycle i_loop_main_aa - - end if - - -! -! cloudtop and cloudbase indices are valid so proceed with calculations -! - -! Load dp_i and cldfrac_i, and calc rhoair_i - do k = 1, pver - dp_i(k) = dpdry(i,k) - cldfrac_i(k) = cldfrac(icol,k) - rhoair_i(k) = pmid(icol,k)/(rair*t(icol,k)) - end do - -! Calc dry mass fluxes -! This is approximate because the updraft air is has different temp and qv than -! the grid mean, but the whole convective parameterization is highly approximate - mu_x(:) = 0.0_r8 - md_x(:) = 0.0_r8 -! (eu-du) = d(mu)/dp -- integrate upwards, multiplying by dpdry - do k = pver, 1, -1 - mu_x(k) = mu_x(k+1) + (eu(i,k)-du(i,k))*dp_i(k) - xx_mfup_max(icol) = max( xx_mfup_max(icol), mu_x(k) ) - end do -! (ed) = d(md)/dp -- integrate downwards, multiplying by dpdry - do k = 2, pver - md_x(k) = md_x(k-1) - ed(i,k-1)*dp_i(k-1) - end do - -! Load mass fluxes over cloud layers -! (Note - use of arrays dimensioned k=1,pver+1 simplifies later coding) -! Zero out values below threshold -! Zero out values at "top of cloudtop", "base of cloudbase" - ktop = jt(i) - kbot = mx(i) -! usually the updraft ( & downdraft) start ( & end ) at kbot=pver, but sometimes kbot < pver -! transport, activation, resuspension, and wet removal only occur between kbot >= k >= ktop -! resuspension from evaporating precip can occur at k > kbot when kbot < pver - kbot_prevap = pver - mu_i(:) = 0.0_r8 - md_i(:) = 0.0_r8 - do k = ktop+1, kbot - mu_i(k) = mu_x(k) - if (mu_i(k) <= mbsth) mu_i(k) = 0.0_r8 - md_i(k) = md_x(k) - if (md_i(k) >= -mbsth) md_i(k) = 0.0_r8 - end do - mu_i(ktop) = 0.0_r8 - md_i(ktop) = 0.0_r8 - mu_i(kbot+1) = 0.0_r8 - md_i(kbot+1) = 0.0_r8 - -! Compute updraft and downdraft "entrainment*dp" from eu and ed -! Compute "detrainment*dp" from mass conservation - eudp(:) = 0.0_r8 - dudp(:) = 0.0_r8 - eddp(:) = 0.0_r8 - dddp(:) = 0.0_r8 - courantmax = 0.0_r8 - do k = ktop, kbot - if ((mu_i(k) > 0) .or. (mu_i(k+1) > 0)) then - if (du(i,k) <= 0.0_r8) then - eudp(k) = mu_i(k) - mu_i(k+1) - else - eudp(k) = max( eu(i,k)*dp_i(k), 0.0_r8 ) - dudp(k) = (mu_i(k+1) + eudp(k)) - mu_i(k) - if (dudp(k) < 1.0e-12_r8*eudp(k)) then - eudp(k) = mu_i(k) - mu_i(k+1) - dudp(k) = 0.0_r8 - end if - end if - end if - if ((md_i(k) < 0) .or. (md_i(k+1) < 0)) then - eddp(k) = max( ed(i,k)*dp_i(k), 0.0_r8 ) - dddp(k) = (md_i(k+1) + eddp(k)) - md_i(k) - if (dddp(k) < 1.0e-12_r8*eddp(k)) then - eddp(k) = md_i(k) - md_i(k+1) - dddp(k) = 0.0_r8 - end if - end if -! courantmax = max( courantmax, (eudp(k)+eddp(k))*dt/dp_i(k) ) ! old version - incorrect - courantmax = max( courantmax, ( mu_i(k+1)+eudp(k)-md_i(k)+eddp(k) )*dt/dp_i(k) ) - end do ! k - -! number of time substeps needed to maintain "courant number" <= 1 - ntsub = 1 - if (courantmax > (1.0_r8 + 1.0e-6_r8)) then - ntsub = 1 + int( courantmax ) - end if - xinv_ntsub = 1.0_r8/ntsub - 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) - -! -! when method_reduce_actfrac = 2, need to do the updraft calc twice -! (1st to get non-adjusted activation amount, 2nd to apply reduction factor) - npass_calc_updraft = 1 - if ( (method_reduce_actfrac == 2) .and. & - (factor_reduce_actfrac >= 0.0_r8) .and. & - (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2 - - -jtsub_loop_main_aa: & - do jtsub = 1, ntsub - - -ipass_calc_updraft_loop: & - do ipass_calc_updraft = 1, npass_calc_updraft - - - if (idiag_in(icol) > 0) & - write(lun,'(/a,3x,a,1x,i9,5i5)') 'qakr - convtype,lchnk,i,jt,mx,jtsub,ipass=', & - trim(convtype), lchnk, icol, jt(i), mx(i), jtsub, ipass_calc_updraft - - qsrflx_i(:,:) = 0.0_r8 - dqdt_i(:,:) = 0.0_r8 - - const(:,:) = 0.0_r8 ! zero cloud-phase species - chat(:,:) = 0.0_r8 ! zero cloud-phase species - conu(:,:) = 0.0_r8 - cond(:,:) = 0.0_r8 - - dcondt(:,:) = 0.0_r8 - dcondt_resusp(:,:) = 0.0_r8 - dcondt_wetdep(:,:) = 0.0_r8 - dcondt_prevap(:,:) = 0.0_r8 - dconudt_aqchem(:,:) = 0.0_r8 - dconudt_wetdep(:,:) = 0.0_r8 -! only initialize the activation tendency on ipass=1 - if (ipass_calc_updraft == 1) dconudt_activa(:,:) = 0.0_r8 - -! initialize mixing ratio arrays (chat, const, conu, cond) - do m = 2, ncnst - if ( doconvproc_extd(m) ) then - -! Gather up the constituent - do k = 1,pver - const(m,k) = q_i(k,m) - end do - -! From now on work only with gathered data -! Interpolate environment tracer values to interfaces - do k = 1,pver - km1 = max(1,k-1) - minc = min(const(m,km1),const(m,k)) - maxc = max(const(m,km1),const(m,k)) - if (minc < 0) then - cdifr = 0._r8 - else - cdifr = abs(const(m,k)-const(m,km1))/max(maxc,small) - endif - -! If the two layers differ significantly use a geometric averaging procedure -! But only do that for deep convection. For shallow, use the simple -! averaging which is used in subr cmfmca - if (iconvtype /= 1) then - chat(m,k) = 0.5_r8* (const(m,k)+const(m,km1)) - else if (cdifr > 1.E-6_r8) then -! if (cdifr > 1.E-6) then - cabv = max(const(m,km1),maxc*1.e-12_r8) - cbel = max(const(m,k),maxc*1.e-12_r8) - chat(m,k) = log(cabv/cbel)/(cabv-cbel)*cabv*cbel - else ! Small diff, so just arithmetic mean - chat(m,k) = 0.5_r8* (const(m,k)+const(m,km1)) - end if - -! Set provisional up and down draft values, and tendencies - conu(m,k) = chat(m,k) - cond(m,k) = chat(m,k) - end do ! k - -! Values at surface inferface == values in lowest layer - chat(m,pver+1) = const(m,pver) - conu(m,pver+1) = const(m,pver) - cond(m,pver+1) = const(m,pver) - end if - end do ! m - - - - -! Compute updraft mixing ratios from cloudbase to cloudtop -! No special treatment is needed at k=pver because arrays -! are dimensioned 1:pver+1 -! A time-split approach is used. First, entrainment is applied to produce -! an initial conu(m,k) from conu(m,k+1). Next, chemistry/physics are -! applied to the initial conu(m,k) to produce a final conu(m,k). -! Detrainment from the updraft uses this final conu(m,k). -! Note that different time-split approaches would give somewhat different -! results - kactcnt = 0 ; kactcntb = 0 ; kactfirst = 1 -k_loop_main_bb: & - do k = kbot, ktop, -1 - kp1 = k+1 - -! cldfrac = conv cloud fractional area. This could represent anvil cirrus area, -! and may not useful for aqueous chem and wet removal calculations - cldfrac_i(k) = max( cldfrac_i(k), 0.005_r8 ) -! mu_p_eudp(k) = updraft massflux at k, without detrainment between kp1,k - mu_p_eudp(k) = mu_i(kp1) + eudp(k) - - fa_u(k) = 0.0_r8 !BSINGH(10/15/2014): Initialized so that it has a value if the following "if" check yeilds .false. - if (mu_p_eudp(k) > mbsth) then -! if (mu_p_eudp(k) <= mbsth) the updraft mass flux is negligible at base and top -! of current layer, -! so current layer is a "gap" between two unconnected updrafts, -! so essentially skip all the updraft calculations for this layer - -! First apply changes from entrainment - f_ent = eudp(k)/mu_p_eudp(k) - f_ent = max( 0.0_r8, min( 1.0_r8, f_ent ) ) - tmpa = 1.0_r8 - f_ent - do m = 2, ncnst_extd - if (doconvproc_extd(m)) then - conu(m,k) = tmpa*conu(m,kp1) + f_ent*const(m,k) - end if - end do - -! estimate updraft velocity (wup) - if (iconvtype /= 1) then -! shallow - wup = (mup in kg/m2/s) / [rhoair * (updraft area)] - wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & - / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) - else -! deep - as in shallow, but assumed constant updraft_area with height zm_areafrac - wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & - / (rhoair_i(k) * zm_areafrac) - end if - -! 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) - 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)) - - -! Now apply transformation and removal changes -! Skip levels where icwmr(icol,k) <= clw_cut (= 1.0e-6) to eliminate -! occasional very small icwmr values from the ZM module - clw_cut = 1.0e-6_r8 - - - if (convproc_method_activate <= 1) then -! aerosol activation - method 1 -! skip levels that are completely glaciated (fracice(icol,k) == 1.0) -! when kactcnt=1 (first/lowest layer with cloud water) apply -! activatation to the entire updraft -! when kactcnt>1 apply activatation to the amount entrained at this level - if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0_r8)) then - kactcnt = kactcnt + 1 - - idiag_act = idiag_in(icol) - if ((kactcnt == 1) .or. (f_ent > 0.0_r8)) then - kactcntb = kactcntb + 1 - if ((kactcntb == 1) .and. (idiag_act > 0)) then - write(lun,'(/a,i9,2i4)') & - 'qaku act_conv lchnk,i,jtsub', lchnk, icol, jtsub - end if - end if - - if (kactcnt == 1) then - ! diagnostic fields - ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac - xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & - / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) - xx_kcldbase(icol) = k - - kactfirst = k - tmpa = 1.0_r8 - call ma_activate_convproc( & - conu(:,k), dconudt_activa(:,k), conu(:,k), & - tmpa, dt_u(k), wup(k), & - t(icol,k), rhoair_i(k), fracice(icol,k), & - pcnst_extd, lun, idiag_act, & - lchnk, icol, k, & - ipass_calc_updraft ) - else if (f_ent > 0.0_r8) then - ! current layer is above cloud base (=first layer with activation) - ! only allow activation at k = kactfirst thru kactfirst-(method1_activate_nlayers-1) - if (k >= kactfirst-(method1_activate_nlayers-1)) then - call ma_activate_convproc( & - conu(:,k), dconudt_activa(:,k), const(:,k), & - f_ent, dt_u(k), wup(k), & - t(icol,k), rhoair_i(k), fracice(icol,k), & - pcnst_extd, lun, idiag_act, & - lchnk, icol, k, & - ipass_calc_updraft ) - end if - end if -! the following was for cam2 shallow convection (hack), -! but is not appropriate for cam5 (uwshcu) -! else if ((kactcnt > 0) .and. (iconvtype /= 1)) then -! ! for shallow conv, when you move from activation occuring to -! ! not occuring, reset kactcnt=0, because the hack scheme can -! ! produce multiple "1.5 layer clouds" separated by clear air -! kactcnt = 0 -! end if - end if ! ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then - - else ! (convproc_method_activate >= 2) -! aerosol activation - method 2 -! skip levels that are completely glaciated (fracice(icol,k) == 1.0) -! when kactcnt=1 (first/lowest layer with cloud water) -! apply "primary" activatation to the entire updraft -! when kactcnt>1 -! apply secondary activatation to the entire updraft -! do this for all levels above cloud base (even if completely glaciated) -! (this is something for sensitivity testing) - do_act_this_lev = .false. - if (kactcnt <= 0) then - if (icwmr(icol,k) > clw_cut) then - do_act_this_lev = .true. - kactcnt = 1 - kactfirst = k - ! diagnostic fields - ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac - xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & - / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) - xx_kcldbase(icol) = k - end if - else -! if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then - do_act_this_lev = .true. - kactcnt = kactcnt + 1 -! end if - end if - - idiag_act = idiag_in(icol) - if ( do_act_this_lev ) then - kactcntb = kactcntb + 1 - if ((kactcntb == 1) .and. (idiag_act > 0)) then - write(lun,'(/a,i9,2i4)') & - 'qaku act_conv lchnk,i,jtsub', lchnk, icol, jtsub - end if - - call ma_activate_convproc_method2( & - conu(:,k), dconudt_activa(:,k), & - f_ent, dt_u(k), wup(k), & - t(icol,k), rhoair_i(k), fracice(icol,k), & - pcnst_extd, lun, idiag_act, & - lchnk, icol, k, & - kactfirst, ipass_calc_updraft ) - end if - - end if ! (convproc_method_activate <= 1) - -! aqueous chemistry -! do glaciated levels as aqchem_conv will eventually do acid vapor uptake -! to ice, and aqchem_conv module checks fracice before doing liquid wtr stuff - if (icwmr(icol,k) > clw_cut) then -! call aqchem_conv( conu(1,k), dconudt_aqchem(1,k), aqfrac, & -! t(icol,k), fracice(icol,k), icwmr(icol,k), rhoair_i(k), & -! lh2o2(icol,k), lo3(icol,k), dt_u(k) ) - end if - -! wet removal -! -! mirage2 -! rprd = precip formation as a grid-cell average (kgW/kgA/s) -! icwmr = cloud water MR within updraft area (kgW/kgA) -! fupdr = updraft fractional area (--) -! A = rprd/fupdr = precip formation rate within updraft area (kgW/kgA/s) -! B = A/icwmr = rprd/(icwmr*fupdr) -! = first-order removal rate (1/s) -! C = dp/(mup/fupdr) = updraft air residence time in the layer (s) -! -! fraction removed = (1.0 - exp(-cdt)) where -! cdt = B*C = (dp/mup)*rprd/icwmr -! -! Note1: fupdr cancels out in cdt, so need not be specified -! Note2: dp & mup units need only be consistent (e.g., mb & mb/s) -! Note3: for shallow conv, cdt = 1-beta (beta defined in Hack scheme) -! Note4: the "dp" in C above and code below should be the moist dp -! -! cam5 -! clw_preloss = cloud water MR before loss to precip -! = icwmr + dt*(rprd/fupdr) -! B = A/clw_preloss = (rprd/fupdr)/(icwmr + dt*rprd/fupdr) -! = rprd/(fupdr*icwmr + dt*rprd) -! = first-order removal rate (1/s) -! -! fraction removed = (1.0 - exp(-cdt)) where -! cdt = B*C = (fupdr*dp/mup)*[rprd/(fupdr*icwmr + dt*rprd)] -! -! Note1: *** cdt is now sensitive to fupdr, which we do not really know, -! and is not the same as the convective cloud fraction -! Note2: dt is appropriate in the above cdt expression, not dtsub -! -! Apply wet removal at levels where -! icwmr(icol,k) > clw_cut AND rprd(icol,k) > 0.0 -! as wet removal occurs in both liquid and ice clouds -! - cdt(k) = 0.0_r8 - if ((icwmr(icol,k) > clw_cut) .and. (rprd(icol,k) > 0.0_r8)) then -! if (iconvtype == 1) then - tmpf = 0.5_r8*cldfrac_i(k) - cdt(k) = (tmpf*dp(i,k)/mu_p_eudp(k)) * rprd(icol,k) / & - (tmpf*icwmr(icol,k) + dt*rprd(icol,k)) -! else if (k < pver) then -! if (eudp(k+1) > 0) cdt(k) = & -! rprd(icol,k)*dp(i,k)/(icwmr(icol,k)*eudp(k+1)) -! end if - end if - if (cdt(k) > 0.0_r8) then - expcdtm1 = exp(-cdt(k)) - 1.0_r8 - do m = 2, ncnst_extd - if (doconvproc_extd(m)) then - 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) - end if - enddo - end if - - end if ! "(mu_p_eudp(k) > mbsth)" - end do k_loop_main_bb ! "k = kbot, ktop, -1" - -! when doing updraft calcs twice, only need to go this far on the first pass - if ( (ipass_calc_updraft == 1) .and. & - (npass_calc_updraft == 2) ) cycle ipass_calc_updraft_loop - - if (idiag_in(icol) > 0) then - ! do wet removal diagnostics here - do k = kbot, ktop, -1 - if (mu_p_eudp(k) > mbsth) & - write(lun,'(a,i9,3i4,1p,6e10.3)') & - 'qakr - l,i,k,jt; cdt, cldfrac, icwmr, rprd, ...', lchnk, icol, k, jtsub, & - cdt(k), cldfrac_i(k), icwmr(icol,k), rprd(icol,k), dp(i,k), mu_p_eudp(k) - end do - end if - - -! Compute downdraft mixing ratios from cloudtop to cloudbase -! No special treatment is needed at k=2 -! No transformation or removal is applied in the downdraft - do k = ktop, kbot - kp1 = k + 1 -! md_m_eddp = downdraft massflux at kp1, without detrainment between k,kp1 - md_m_eddp = md_i(k) - eddp(k) - if (md_m_eddp < -mbsth) then - do m = 2, ncnst_extd - if (doconvproc_extd(m)) then - cond(m,kp1) = ( md_i(k)*cond(m,k) & - - eddp(k)*const(m,k) ) / md_m_eddp - endif - end do - end if - end do ! k - - -! Now computes fluxes and tendencies -! NOTE: The approach used in convtran applies to inert tracers and -! must be modified to include source and sink terms - sumflux(:) = 0.0_r8 - sumflux2(:) = 0.0_r8 - sumsrce(:) = 0.0_r8 - sumchng(:) = 0.0_r8 - sumchng3(:) = 0.0_r8 - sumactiva(:) = 0.0_r8 - sumaqchem(:) = 0.0_r8 - sumwetdep(:) = 0.0_r8 - sumresusp(:) = 0.0_r8 - sumprevap(:) = 0.0_r8 - - maxflux(:) = 0.0_r8 - maxflux2(:) = 0.0_r8 - maxresusp(:) = 0.0_r8 - maxsrce(:) = 0.0_r8 - maxprevap(:) = 0.0_r8 - -k_loop_main_cc: & - do k = ktop, kbot - kp1 = k+1 - km1 = k-1 - kp1x = min( kp1, pver ) - km1x = max( km1, 1 ) - fa_u_dp = fa_u(k)*dp_i(k) - do m = 2, ncnst_extd - if (doconvproc_extd(m)) then - -! First compute fluxes using environment subsidence/lifting and -! entrainment/detrainment into up/downdrafts, -! to provide an additional mass balance check -! (this could be deleted after the code is well tested) - fluxin = mu_i(k)*min(chat(m,k),const(m,km1x)) & - - md_i(kp1)*min(chat(m,kp1),const(m,kp1x)) & - + dudp(k)*conu(m,k) + dddp(k)*cond(m,kp1) - fluxout = mu_i(kp1)*min(chat(m,kp1),const(m,k)) & - - md_i(k)*min(chat(m,k),const(m,k)) & - + (eudp(k) + eddp(k))*const(m,k) - - netflux = fluxin - fluxout - - sumflux2(m) = sumflux2(m) + netflux - maxflux2(m) = max( maxflux2(m), abs(fluxin), abs(fluxout) ) - -! Now compute fluxes as in convtran, and also source/sink terms -! (version 3 limit fluxes outside convection to mass in appropriate layer -! (these limiters are probably only safe for positive definite quantitities -! (it assumes that mu and md already satify a courant number limit of 1) - if (iflux_method /= 2) then - fluxin = mu_i(kp1)*conu(m,kp1) & - + mu_i(k )*min(chat(m,k ),const(m,km1x)) & - - ( md_i(k )*cond(m,k) & - + md_i(kp1)*min(chat(m,kp1),const(m,kp1x)) ) - fluxout = mu_i(k )*conu(m,k) & - + mu_i(kp1)*min(chat(m,kp1),const(m,k )) & - - ( md_i(kp1)*cond(m,kp1) & - + md_i(k )*min(chat(m,k ),const(m,k )) ) - else - fluxin = mu_i(kp1)*conu(m,kp1) & - - ( md_i(k )*cond(m,k) ) - fluxout = mu_i(k )*conu(m,k) & - - ( md_i(kp1)*cond(m,kp1) ) - tmpveca(1) = fluxin ; tmpveca(4) = -fluxout - - ! new method -- simple upstream method for the env subsidence - ! tmpa = net env mass flux (positive up) at top of layer k - tmpa = -( mu_i(k ) + md_i(k ) ) - if (tmpa <= 0.0_r8) then - fluxin = fluxin - tmpa*const(m,km1x) - else - fluxout = fluxout + tmpa*const(m,k ) - end if - tmpveca(2) = fluxin ; tmpveca(5) = -fluxout - ! tmpa = net env mass flux (positive up) at base of layer k - tmpa = -( mu_i(kp1) + md_i(kp1) ) - if (tmpa >= 0.0_r8) then - fluxin = fluxin + tmpa*const(m,kp1x) - else - fluxout = fluxout - tmpa*const(m,k ) - end if - tmpveca(3) = fluxin ; tmpveca(6) = -fluxout - end if - - netflux = fluxin - fluxout - netsrce = fa_u_dp*(dconudt_aqchem(m,k) + & - dconudt_activa(m,k) + dconudt_wetdep(m,k)) - dcondt(m,k) = (netflux+netsrce)/dp_i(k) - - dcondt_wetdep(m,k) = fa_u_dp*dconudt_wetdep(m,k)/dp_i(k) - - sumflux(m) = sumflux(m) + netflux - maxflux(m) = max( maxflux(m), abs(fluxin), abs(fluxout) ) - sumsrce(m) = sumsrce(m) + netsrce - maxsrce(m) = max( maxsrce(m), & - fa_u_dp*max( abs(dconudt_aqchem(m,k)), & - abs(dconudt_activa(m,k)), abs(dconudt_wetdep(m,k)) ) ) - sumchng(m) = sumchng(m) + dcondt(m,k)*dp_i(k) - sumactiva(m) = sumactiva(m) + fa_u_dp*dconudt_activa(m,k) - sumaqchem(m) = sumaqchem(m) + fa_u_dp*dconudt_aqchem(m,k) - sumwetdep(m) = sumwetdep(m) + fa_u_dp*dconudt_wetdep(m,k) - - if ( idiag_in(icol)>0 .and. k==26 .and. & - (m==16 .or. m==23 .or. m==16+pcnst .or. m==23+pcnst) ) then - if (m==16) & - write(lun,'(a,i9,4i4,1p,22x, 2x,11x, 2x,6e11.3)') & - 'qakww0-'//convtype(1:4), lchnk, icol, k, -1, jtsub, & - dtsub*mu_i(k+1)/dp_i(k), dtsub*mu_i(k)/dp_i(k), dtsub*eudp(k)/dp_i(k), & - dtsub*md_i(k+1)/dp_i(k), dtsub*md_i(k)/dp_i(k), dtsub*eddp(k)/dp_i(k) - - write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,6e11.3)') & - 'qakww1-'//convtype(1:4), lchnk, icol, k, m, jtsub, & - const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k), & - dtsub*fluxin/dp_i(k), -dtsub*fluxout/dp_i(k), & - dtsub*fa_u_dp*dconudt_aqchem(m,k)/dp_i(k), & - dtsub*fa_u_dp*dconudt_activa(m,k)/dp_i(k), & - dtsub*fa_u_dp*dconudt_wetdep(m,k)/dp_i(k) - write(lun,'(a,i9,4i4,1p,22x, 2x,11x, 2x,6e11.3)') & - 'qakww1-'//convtype(1:4), lchnk, icol, k, m, jtsub, & - dtsub*tmpveca(1:6)/dp_i(k) - end if - - end if ! "(doconvproc_extd(m))" - end do ! "m = 2,ncnst_extd" - end do k_loop_main_cc ! "k = ktop, kbot" - - -! calculate effects of precipitation evaporation - call ma_precpevap_convproc( dcondt, dcondt_wetdep, dcondt_prevap, & - rprd, evapc, dp_i, & - icol, ktop, pcnst_extd, & - lun, idiag_in(icol), lchnk, & - doconvproc_extd ) - if ( idiag_in(icol)>0 ) then - k = 26 - do m = 16, 23, 7 - write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') & - 'qakww2-'//convtype(1:4), lchnk, icol, k, m, jtsub, & - const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k) - end do - do m = 16+pcnst, 23+pcnst, 7 - write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') & - 'qakww2-'//convtype(1:4), lchnk, icol, k, m, jtsub, & - const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k) - end do - end if - - - -! make adjustments to dcondt for activated & unactivated aerosol species -! pairs to account any (or total) resuspension of convective-cloudborne aerosol - call ma_resuspend_convproc( dcondt, dcondt_resusp, & - const, dp_i, ktop, kbot_prevap, pcnst_extd ) - - ! Do resuspension of aerosols from rain only when the rain has - ! totally evaporated. - if (convproc_do_evaprain_atonce) then - dcondt_resusp3d(pcnst+1:pcnst_extd,icol,:) = dcondt_resusp(pcnst+1:pcnst_extd,:) - dcondt_resusp(pcnst+1:pcnst_extd,:) = 0._r8 - end if - - if ( idiag_in(icol)>0 ) then - k = 26 - do m = 16, 23, 7 - write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') & - 'qakww3-'//convtype(1:4), lchnk, icol, k, m, jtsub, & - const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k) - end do - do m = 16+pcnst, 23+pcnst, 7 - write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') & - 'qakww3-'//convtype(1:4), lchnk, icol, k, m, jtsub, & - const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k) - end do - end if - - -! calculate new column-tendency variables - do m = 2, ncnst_extd - if (doconvproc_extd(m)) then - do k = ktop, kbot_prevap - sumchng3(m) = sumchng3(m) + dcondt(m,k)*dp_i(k) - sumresusp(m) = sumresusp(m) + dcondt_resusp(m,k)*dp_i(k) - maxresusp(m) = max( maxresusp(m), & - abs(dcondt_resusp(m,k)*dp_i(k)) ) - sumprevap(m) = sumprevap(m) + dcondt_prevap(m,k)*dp_i(k) - maxprevap(m) = max( maxprevap(m), & - abs(dcondt_prevap(m,k)*dp_i(k)) ) - end do - end if - end do ! m - - -! do checks for mass conservation -! do not expect errors > 1.0e-14, but use a conservative 1.0e-10 here, -! as an error of this size is still not a big concern - relerr_cut = 1.0e-10_r8 - if (nerr < nerrmax) then - merr = 0 - if (courantmax > (1.0_r8 + 1.0e-6_r8)) then - write(lun,9161) '-', trim(convtype), courantmax - merr = merr + 1 - end if - do m = 2, ncnst_extd - if (doconvproc_extd(m)) then - itmpa = 0 - ! sumflux should be ~=0.0 because fluxout of one layer cancels - ! fluxin to adjacent layer - tmpa = sumflux(m) - tmpb = max( maxflux(m), small ) - if (abs(tmpa) > relerr_cut*tmpb) then - write(lun,9151) '1', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb) - itmpa = itmpa + 1 - end if - ! sumflux2 involve environment fluxes and entrainment/detrainment - ! to up/downdrafts, and it should be equal to sumchng, - ! and so (sumflux2 - sumsrce) should be ~=0.0 - tmpa = sumflux2(m) - sumsrce(m) - tmpb = max( maxflux2(m), maxsrce(m), small ) - if (abs(tmpa) > relerr_cut*tmpb) then - write(lun,9151) '2', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb) - itmpa = itmpa + 10 - end if - ! sunchng = sumflux + sumsrce, so (sumchng - sumsrc) should be ~=0.0 - tmpa = sumchng(m) - sumsrce(m) - tmpb = max( maxflux(m), maxsrce(m), small ) - if (abs(tmpa) > relerr_cut*tmpb) then - write(lun,9151) '3', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb) - itmpa = itmpa + 100 - end if - ! sumchng3 = sumchng + sumresusp + sumprevap, - ! so tmpa (below) should be ~=0.0 - ! NOTE: This check needs to be redone if the rain is being - ! evaporated all at once. Until then, skip this check for that case. - if (.not. convproc_do_evaprain_atonce) then - tmpa = sumchng3(m) - (sumsrce(m) + sumresusp(m) + sumprevap(m)) - tmpb = max( maxflux(m), maxsrce(m), maxresusp(m), maxprevap(m), small ) - - if (abs(tmpa) > relerr_cut*tmpb) then - write(lun,9151) '4', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb) - itmpa = itmpa + 1000 - end if - end if - - if (itmpa > 0) merr = merr + 1 - end if - end do ! m - if (merr > 0) write(lun,9181) convtype, lchnk, icol, i, jt(i), mx(i) - nerr = nerr + merr - if (nerr >= nerrmax) write(lun,9171) nerr - end if ! (nerr < nerrmax) then - -9151 format( '*** ma_convproc_tend error, massbal', a, 1x, i5,1x,a, & - ' -- maxflux, sumflux, relerr =', 3(1pe14.6) ) -9161 format( '*** ma_convproc_tend error, courantmax', 2a, 3x, 1pe14.6 ) -9171 format( '*** ma_convproc_tend error, stopping messages after nerr =', i10 ) - -9181 format( '*** ma_convproc_tend error -- convtype, lchnk, icol, il, jt, mx = ', a,2x,5(1x,i10) ) - - -! -! note again the ma_convproc_tend does not apply convective cloud processing -! to the stratiform-cloudborne aerosol -! within this routine, cloudborne aerosols are convective-cloudborne -! -! before tendencies (dcondt, which is loaded into dqdt) are returned, -! the convective-cloudborne aerosol tendencies must be combined -! with the interstitial tendencies -! ma_resuspend_convproc has already done this for the dcondt -! -! the individual process column tendencies (sumwetdep, sumprevap, ...) -! are just diagnostic fields that can be written to history -! tendencies for interstitial and convective-cloudborne aerosol could -! both be passed back and output, if desired -! currently, however, the interstitial and convective-cloudborne tendencies -! are combined (in the next code block) before being passed back (in qsrflx) -! - 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 - if (doconvproc(la)) then - sumactiva(la) = sumactiva(la) + sumactiva(lc) - sumresusp(la) = sumresusp(la) + sumresusp(lc) - sumaqchem(la) = sumaqchem(la) + sumaqchem(lc) - sumwetdep(la) = sumwetdep(la) + sumwetdep(lc) - sumprevap(la) = sumprevap(la) + sumprevap(lc) -! if (n==1 .and. ll==1) then -! write(lun,*) 'la, sumaqchem(la) =', la, sumaqchem(la) -! endif - end if - enddo ! ll - enddo ! n - -! -! scatter overall tendency back to full array -! - do m = 2, ncnst - if (doconvproc(m)) then - do k = ktop, kbot_prevap - dqdt_i(k,m) = dcondt(m,k) - dqdt(icol,k,m) = dqdt(icol,k,m) + dqdt_i(k,m)*xinv_ntsub - end do -! dqdt_i(:,m) = 0. - end if - end do ! m - -! scatter column burden tendencies for various processes to qsrflx - do m = 2, ncnst - if (doconvproc(m)) then - qsrflx_i(m,1) = sumactiva(m)*hund_ovr_g - qsrflx_i(m,2) = sumresusp(m)*hund_ovr_g - qsrflx_i(m,3) = sumaqchem(m)*hund_ovr_g - qsrflx_i(m,4) = sumwetdep(m)*hund_ovr_g - qsrflx_i(m,5) = sumprevap(m)*hund_ovr_g -! qsrflx_i(m,1:4) = 0. - qsrflx(icol,m,1:5) = qsrflx(icol,m,1:5) + qsrflx_i(m,1:5)*xinv_ntsub - end if - end do ! m - - -! diagnostic output of profiles before - if (idiag_in(icol) > 0) then - write(lun, '(/3a,i9,2i4)' ) 'qakr-', trim(convtype), ' - lchnk,i,jtsub', lchnk, icol, jtsub - n = 1 - - do j = 1, 2 - if (j == 1) then - write(lun, '(4a,i4)' ) & - 'qakr-', trim(convtype), ' - k, mu,md; then mode-1 ', & - 'numb & numbcw for q, const, conu, cond, delq(a/c/ac noresu)', jtsub - else - write(lun, '(/4a,i4)' ) & - 'qakr-', trim(convtype), ' - k, mu,md; then mode-1 ', & - 'mass & masscw for q, const, conu, cond, delq(a/c/ac noresu)', jtsub - end if - - do k = 10, pver - tmpveca(:) = 0.0_r8 - do ll = 1, nspec_amode(n) - if (j == 1) then - la = numptr_amode(n) - lc = numptr_amode(n) + pcnst - else - la = lmassptr_amode(ll,n) - lc = lmassptr_amode(ll,n) + pcnst - end if - tmpveca(1) = tmpveca(1) + q_i(k,la) - tmpveca(2) = tmpveca(2) + const(la,k) - tmpveca(3) = tmpveca(3) + const(lc,k) - tmpveca(4) = tmpveca(4) + conu( la,k) - tmpveca(5) = tmpveca(5) + conu( lc,k) - tmpveca(6) = tmpveca(6) + cond( la,k) - tmpveca(7) = tmpveca(7) + cond( lc,k) - tmpveca(8) = tmpveca(8) + (dcondt(la,k)-dcondt_resusp(la,k))*dtsub - tmpveca(9) = tmpveca(9) + (dcondt(lc,k)-dcondt_resusp(lc,k))*dtsub - tmpveca(10) = tmpveca(8) + tmpveca(9) - if (j == 1) exit - end do ! ll - if ((k > 15) .and. (mod(k,5) == 1)) write(lun,'(a)') - write(lun, '(a,i3,1p,2e10.2, e11.2, 3(2x,2e9.2), 2x,3e10.2 )' ) 'qakr', k, & - mu_i(k), md_i(k), tmpveca(1:10) - end do ! k - end do ! j - - if (pcnst < 0) then - write(lun, '(/a,i4)' ) & - 'qakr - name; burden; qsrflx tot, activa,resusp,aqchem,wetdep,resid', jtsub - do m = 2, ncnst - if ( .not. doconvproc(m) ) cycle - tmpveca(1) = sum( q_i(:,m)*dp_i(:) ) * hund_ovr_g - tmpveca(2) = sum( dqdt_i(:,m)*dp_i(:) ) * hund_ovr_g - tmpveca(3:6) = qsrflx_i(m,1:4) - tmpveca(7) = tmpveca(2) - sum( tmpveca(3:6) ) - write(lun, '(2a,1p,2(2x,e11.3),2x,4e11.3,2x,e11.3)' ) & - 'qakr ', cnst_name_extd(m)(1:10), tmpveca(1:7) - end do ! m - end if ! (pcnst < 0) then - - write(lun, '(/3a,i4)' ) 'qakr-', trim(convtype), & - ' - name; burden; sumchng3, sumactiva,resusp,aqchem,wetdep, resid,resid*dt/burden', jtsub -! write(lun, '(/2a)' ) & -! 'qakr - name; burden; sumchng3; ', & -! 'sumactiva,resusp,aqchem,wetdep,prevap; resid,resid*dtsub/burden' - tmpb = 0.0_r8 - itmpb = 0 - do m = 2, pcnst - if ( .not. doconvproc_extd(m) ) cycle - - tmpmata(:,:) = 0.0_r8 - do j = 1, 3 - l = m - if (j == 3) l = m + pcnst - if ( .not. doconvproc_extd(l) ) cycle - - if (j == 1) then - tmpmata(1,j) = sum( q_i(:,l)*dp_i(:) ) * hund_ovr_g - tmpmata(2,j) = sum( dqdt_i(:,l)*dp_i(:) ) * hund_ovr_g - tmpmata(3:7,j) = qsrflx_i(l,1:5) - else - tmpmata(1,j) = sum( const(l,1:pver)*dp_i(1:pver) ) * hund_ovr_g - tmpmata(2,j) = sumchng3( l) * hund_ovr_g - tmpmata(3,j) = sumactiva(l) * hund_ovr_g - tmpmata(4,j) = sumresusp(l) * hund_ovr_g - tmpmata(5,j) = sumaqchem(l) * hund_ovr_g - tmpmata(6,j) = sumwetdep(l) * hund_ovr_g - tmpmata(7,j) = sumprevap(l) * hund_ovr_g - end if - end do ! j - - tmpmata(3:7,2) = tmpmata(3:7,2) - tmpmata(3:7,3) ! because lc values were added onto la - do j = 1, 3 - tmpmata(8,j) = tmpmata(2,j) - sum( tmpmata(3:7,j) ) ! residual - tmpa = max( tmpmata(1,min(j,2)), 1.0e-20_r8 ) - tmpmata(9,j) = tmpmata(8,j) * dtsub / tmpa - if (abs(tmpmata(9,j)) > tmpb) then - tmpb = abs(tmpmata(9,j)) - itmpb = m - end if - end do - -! write(lun, '(/2a,1p,2(2x,e11.3),2x,4e11.3,2x,2e11.3)' ) & -! 'qakr1 ', cnst_name_extd(m)(1:10), tmpmata(1:6,1), tmpmata(8:9,1) - write(lun, '(/2a,1p,2(2x,e11.3),2x,5e11.3,2x,2e11.3)' ) & - 'qakr1 ', cnst_name_extd(m)(1:10), tmpmata(1:9,1) -! write(lun, '( 2a,1p,2(2x,e11.3),2x,4e11.3,2x,2e11.3)' ) & -! 'qakr2 ', cnst_name_extd(m)(1:10), tmpmata(1:6,2), tmpmata(8:9,2) - write(lun, '( 2a,1p,2(2x,e11.3),2x,5e11.3,2x,2e11.3)' ) & - 'qakr2 ', cnst_name_extd(m)(1:10), tmpmata(1:9,2) - if ( .not. doconvproc_extd(l) ) cycle -! write(lun, '( 2a,1p,2(2x,e11.3),2x,4e11.3,2x,2e11.3)' ) & -! 'qakr3 ', cnst_name_cw(m)(1:10), tmpmata(1:6,3), tmpmata(8:9,3) - write(lun, '( 2a,1p,2(2x,e11.3),2x,5e11.3,2x,2e11.3)' ) & - 'qakr3 ', cnst_name_cw(m)(1:10), tmpmata(1:9,3) - end do ! m - write(lun, '(/3a,2i4,1p,e11.2)' ) 'qakr-', trim(convtype), & - ' - max(resid*dt/burden)', jtsub, itmpb, tmpb - - end if ! (idiag_in(icol) > 0) then - - - if (jtsub < ntsub) then - ! update the q_i for the next interation of the jtsub loop - do m = 2, ncnst - if (doconvproc(m)) then - do k = ktop, kbot_prevap - q_i(k,m) = max( (q_i(k,m) + dqdt_i(k,m)*dtsub), 0.0_r8 ) - end do - end if - end do ! m - end if - - end do ipass_calc_updraft_loop - - end do jtsub_loop_main_aa ! of the main "do jtsub = 1, ntsub" loop - - - end do i_loop_main_aa ! of the main "do i = il1g, il2g" loop - - return -end subroutine ma_convproc_tend - - - -!========================================================================================= - subroutine ma_precpevap_convproc( & - dcondt, dcondt_wetdep, dcondt_prevap, & - rprd, evapc, dp_i, & - icol, ktop, pcnst_extd, & - lun, idiag_prevap, lchnk, & - doconvproc_extd ) -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate resuspension of wet-removed aerosol species resulting -! precip evaporation -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - - use modal_aero_data, only: & - lmassptrcw_amode, nspec_amode, numptrcw_amode - - implicit none - -!----------------------------------------------------------------------- -! arguments -! (note: TMR = tracer mixing ratio) - integer, intent(in) :: pcnst_extd - - real(r8), intent(inout) :: dcondt(pcnst_extd,pver) - ! overall TMR tendency from convection - real(r8), intent(in) :: dcondt_wetdep(pcnst_extd,pver) - ! portion of TMR tendency due to wet removal - real(r8), intent(inout) :: dcondt_prevap(pcnst_extd,pver) - ! portion of TMR tendency due to precip evaporation - ! (actually, due to the adjustments made here) - ! (on entry, this is 0.0) - - real(r8), intent(in) :: rprd(pcols,pver) ! conv precip production rate (gathered) - real(r8), intent(in) :: evapc(pcols,pver) ! conv precip evaporation rate (gathered) - real(r8), intent(in) :: dp_i(pver) ! pressure thickness of level (in mb) - - integer, intent(in) :: icol ! normal (ungathered) i index for current column - integer, intent(in) :: ktop ! index of top cloud level for current column - integer, intent(in) :: lun ! logical unit for diagnostic output - integer, intent(in) :: idiag_prevap ! flag for diagnostic output - integer, intent(in) :: lchnk ! chunk index - - logical, intent(in) :: doconvproc_extd(pcnst_extd) ! indicates which species to process - -!----------------------------------------------------------------------- -! local variables - integer :: k, l, ll, m, n - real(r8) :: del_pr_flux_prod ! change to precip flux from production [(kg/kg/s)*mb] - real(r8) :: del_pr_flux_evap ! change to precip flux from evaporation [(kg/kg/s)*mb] - real(r8) :: del_wd_flux_evap ! change to wet deposition flux from evaporation [(kg/kg/s)*mb] - real(r8) :: fdel_pr_flux_evap ! fractional change to precip flux from evaporation - real(r8) :: pr_flux ! precip flux at base of current layer [(kg/kg/s)*mb] - real(r8) :: pr_flux_old - real(r8) :: tmpa, tmpb, tmpc, tmpd - real(r8) :: tmpdp ! delta-pressure (mb) - real(r8) :: wd_flux(pcnst_extd) ! tracer wet deposition flux at base of current layer [(kg/kg/s)*mb] - integer :: i - character(len=4) :: spcstr -!----------------------------------------------------------------------- - - - pr_flux = 0.0_r8 - wd_flux(:) = 0.0_r8 - - if (idiag_prevap > 0) then - write(lun,'(a,i9,i4,5x,a)') 'qakx - lchnk,i', lchnk, icol, & - '// k; pr_flux old,new; delprod,devap; mode-1 numb wetdep,prevap; mass ...' - end if - - do k = ktop, pver - tmpdp = dp_i(k) - - pr_flux_old = pr_flux - del_pr_flux_prod = tmpdp*max(0.0_r8, rprd(icol,k)) - pr_flux = pr_flux_old + del_pr_flux_prod - - del_pr_flux_evap = min( pr_flux, tmpdp*max(0.0_r8, evapc(icol,k)) ) - - ! Do resuspension of aerosols from rain only when the rain has - ! totally evaporated in one layer. - if (convproc_do_evaprain_atonce .and. & - (del_pr_flux_evap.ne.pr_flux)) del_pr_flux_evap = 0._r8 - - fdel_pr_flux_evap = del_pr_flux_evap / max(pr_flux, 1.0e-35_r8) - - do m = 2, pcnst_extd - if ( doconvproc_extd(m) ) then - ! 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 - - ! Do resuspension of aerosol species from rain to coarse mode (large particle) rather - ! than to individual modes. - if (convproc_do_evaprain_atonce) then - - call accumulate_to_larger_mode( 'SO4', lptr_so4_a_amode, dcondt_prevap(:,k) ) - call accumulate_to_larger_mode( 'DUST',lptr_dust_a_amode,dcondt_prevap(:,k) ) - call accumulate_to_larger_mode( 'NACL',lptr_nacl_a_amode,dcondt_prevap(:,k) ) - call accumulate_to_larger_mode( 'MSA', lptr_msa_a_amode, dcondt_prevap(:,k) ) - call accumulate_to_larger_mode( 'NH4', lptr_nh4_a_amode, dcondt_prevap(:,k) ) - call accumulate_to_larger_mode( 'NO3', lptr_no3_a_amode, dcondt_prevap(:,k) ) - - spcstr = ' ' - do i = 1,nsoa - if (nsoa>1) write(spcstr,'(i4)') i - call accumulate_to_larger_mode( 'SOA'//adjustl(spcstr), lptr2_soa_a_amode(:,i), dcondt_prevap(:,k) ) - enddo - spcstr = ' ' - do i = 1,npoa - if (npoa>1) write(spcstr,'(i4)') i - call accumulate_to_larger_mode( 'POM'//adjustl(spcstr), lptr2_pom_a_amode(:,i), dcondt_prevap(:,k) ) - enddo - spcstr = ' ' - do i = 1,nbc - if (nbc>1) write(spcstr,'(i4)') i - call accumulate_to_larger_mode( 'BC'//adjustl(spcstr), lptr2_bc_a_amode(:,i), dcondt_prevap(:,k) ) - enddo - - end if - - pr_flux = max( 0.0_r8, pr_flux-del_pr_flux_evap ) - - if (idiag_prevap > 0) then - n = 1 - l = numptrcw_amode(n) + pcnst - tmpa = dcondt_wetdep(l,k) - tmpb = dcondt_prevap(l,k) - tmpc = 0.0_r8 - tmpd = 0.0_r8 - do ll = 1, nspec_amode(n) - l = lmassptrcw_amode(ll,n) + pcnst - tmpc = tmpc + dcondt_wetdep(l,k) - tmpd = tmpd + dcondt_prevap(l,k) - end do - write(lun,'(a,i4,1p,4(2x,2e10.2))') 'qakx', k, & - pr_flux_old, pr_flux, del_pr_flux_prod, -del_pr_flux_evap, & - -tmpa, tmpb, -tmpc, tmpd - end if - end do ! k - - return - end subroutine ma_precpevap_convproc - -!========================================================================================= - subroutine accumulate_to_larger_mode( spc_name, lptr, prevap ) - - character(len=*), intent(in) :: spc_name - integer, intent(in) :: lptr(:) - real(r8), intent(inout) :: prevap(:) - - integer :: m,n, nl,ns - - ! find constituent index of the largest mode for the species - loop1: do m = 1,ntot_amode-1 - nl = lptr(mode_size_order(m)) - if (nl>0) exit loop1 - end do loop1 - - if (.not. nl>0) return - - ! accumulate the smaller modes into the largest mode - do n = m+1,ntot_amode - ns = lptr(mode_size_order(n)) - if (ns>0) then - prevap(nl) = prevap(nl) + prevap(ns) - prevap(ns) = 0._r8 - if (masterproc .and. debug) then - write(iulog,'(a,i3,a,i3)') trim(spc_name)//' mode number accumulate ',ns,'->',nl - endif - endif - end do - - end subroutine accumulate_to_larger_mode - -!========================================================================================= - subroutine ma_activate_convproc( & - conu, dconudt, conent, & - f_ent, dt_u, wup, & - tair, rhoair, fracice, & - pcnst_extd, lun, idiag_act, & - lchnk, i, k, & - ipass_calc_updraft ) -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate activation of aerosol species in convective updraft -! for a single column and level -! -! Method: -! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface -! conent(l) = TMR of air that is entrained into the updraft from level k -! f_ent = Fraction of the "before-detrainment" updraft massflux at -! k/k-1 interface" resulting from entrainment of level k air -! (where k is the current level in subr ma_convproc_tend) -! -! On entry to this routine, the conu(l) represents the updraft TMR -! after entrainment, but before chemistry/physics and detrainment, -! and is equal to -! conu(l) = f_ent*conent(l) + (1.0-f_ent)*conu_below(l) -! where -! conu_below(l) = updraft TMR at the k+1/k interface, and -! f_ent = (eudp/mu_p_eudp) is the fraction of the updraft massflux -! from level k entrainment -! -! This routine applies aerosol activation to the entrained tracer, -! then adjusts the conu so that on exit, -! conu(la) = conu_incoming(la) - f_ent*conent(la)*f_act(la) -! conu(lc) = conu_incoming(lc) + f_ent*conent(la)*f_act(la) -! where -! la, lc = indices for an unactivated/activated aerosol component pair -! f_act = fraction of conent(la) that is activated. The f_act are -! calculated with the Razzak-Ghan activation parameterization. -! The f_act differ for each mode, and for number/surface/mass. -! -! Note: At the lowest layer with cloud water, subr convproc calls this -! routine with conent==conu and f_ent==1.0, with the result that -! activation is applied to the entire updraft tracer flux -! -! *** The updraft velocity used for activation calculations is rather -! uncertain and needs more work. However, an updraft of 1-3 m/s -! will activate essentially all of accumulation and coarse mode particles. -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - - use ndrop, only: activate_modal - - use modal_aero_data, only: lmassptr_amode, lmassptrcw_amode, & - ntot_amode, & - nspec_amode, ntot_amode, numptr_amode, numptrcw_amode, & - specdens_amode, spechygro, & - voltonumblo_amode, voltonumbhi_amode - - implicit none - -!----------------------------------------------------------------------- -! arguments (note: TMR = tracer mixing ratio) - integer, intent(in) :: pcnst_extd - ! conu = tracer mixing ratios in updraft at top of this (current) level - ! The conu are changed by activation - real(r8), intent(inout) :: conu(pcnst_extd) - ! conent = TMRs in the entrained air at this level - real(r8), intent(in) :: conent(pcnst_extd) - real(r8), intent(inout) :: dconudt(pcnst_extd) ! TMR tendencies due to activation - - real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was - ! entrained across this layer == eudp/mu_p_eudp - real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the - ! updraft at current level - real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s) - ! at current level updraft - - real(r8), intent(in) :: tair ! Temperature in Kelvin - real(r8), intent(in) :: rhoair ! air density (kg/m3) - - real(r8), intent(in) :: fracice ! Fraction of ice within the cloud - ! used as in-cloud wet removal rate - integer, intent(in) :: lun ! logical unit for diagnostic output - integer, intent(in) :: idiag_act ! flag for diagnostic output - integer, intent(in) :: lchnk ! chunk index - integer, intent(in) :: i ! column index - integer, intent(in) :: k ! level index - integer, intent(in) :: ipass_calc_updraft - -!----------------------------------------------------------------------- -! local variables - integer :: ll, la, lc, n - - real(r8) :: delact ! working variable - real(r8) :: dt_u_inv ! 1.0/dt_u - real(r8) :: fluxm(ntot_amode) ! to understand this, see subr activate_modal - real(r8) :: fluxn(ntot_amode) ! to understand this, see subr activate_modal - real(r8) :: flux_fullact ! to understand this, see subr activate_modal - real(r8) :: fm(ntot_amode) ! mass fraction of aerosols activated - real(r8) :: fn(ntot_amode) ! number fraction of aerosols activated - real(r8) :: hygro(ntot_amode) ! current hygroscopicity for int+act - real(r8) :: naerosol(ntot_amode) ! interstitial+activated number conc (#/m3) - real(r8) :: sigw ! standard deviation of updraft velocity (cm/s) - real(r8) :: tmpa, tmpb, tmpc ! working variable - real(r8) :: tmp_fact ! working variable - real(r8) :: vaerosol(ntot_amode) ! int+act volume (m3/m3) - real(r8) :: wbar ! mean updraft velocity (cm/s) - real(r8) :: wdiab ! diabatic vertical velocity (cm/s) - real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s) - - -!----------------------------------------------------------------------- - - -! when ipass_calc_updraft == 2, apply the activation tendencies -! from pass 1, but multiplied by factor_reduce_actfrac -! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2) - if (ipass_calc_updraft == 2) then - - dt_u_inv = 1.0_r8/dt_u - 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 - - delact = dconudt(lc)*dt_u * factor_reduce_actfrac - delact = min( delact, conu(la) ) - delact = max( delact, 0.0_r8 ) - conu(la) = conu(la) - delact - conu(lc) = conu(lc) + delact - dconudt(la) = -delact*dt_u_inv - dconudt(lc) = delact*dt_u_inv - end do - end do ! "n = 1, ntot_amode" - return - - end if ! (ipass_calc_updraft == 2) - - -! check f_ent > 0 - if (f_ent <= 0.0_r8) return - - - do n = 1, ntot_amode -! compute a (or a+cw) volume and hygroscopicity - tmpa = 0.0_r8 - tmpb = 0.0_r8 - do ll = 1, nspec_amode(n) - tmpc = max( conent(lmassptr_amode(ll,n)), 0.0_r8 ) - if ( use_cwaer_for_activate_maxsat ) & - tmpc = tmpc + max( conent(lmassptrcw_amode(ll,n)+pcnst), 0.0_r8 ) - tmpc = tmpc / specdens_amode(ll,n) - tmpa = tmpa + tmpc - tmpb = tmpb + tmpc * spechygro(ll,n) - end do - vaerosol(n) = tmpa * rhoair - if (tmpa < 1.0e-35_r8) then - hygro(n) = 0.2_r8 - else - hygro(n) = tmpb/tmpa - end if - -! load a (or a+cw) number and bound it - tmpa = max( conent(numptr_amode(n)), 0.0_r8 ) - if ( use_cwaer_for_activate_maxsat ) & - tmpa = tmpa + max( conent(numptrcw_amode(n)+pcnst), 0.0_r8 ) - naerosol(n) = tmpa * rhoair - naerosol(n) = max( naerosol(n), & - vaerosol(n)*voltonumbhi_amode(n) ) - naerosol(n) = min( naerosol(n), & - vaerosol(n)*voltonumblo_amode(n) ) - -! diagnostic output for testing/development -! if (lun > 0) then -! if (n == 1) then -! write(lun,9500) -! write(lun,9510) (cnst_name(l), conu(l), l=1,pcnst_extd) -! write(lun,9520) tair, rhoaircgs, airconcgs -! end if -! write(lun,9530) n, ntype(n), vaerosol -! write(lun,9540) naerosol(n), tmp*airconcgs, & -! voltonumbhi_amode(n), voltonumblo_amode(n) -! write(lun,9550) (maerosol(l,n), l=1,ntype(n)) -!9500 format( / 'activate_conv output -- conu values' ) -!9510 format( 3( a, 1pe11.3, 4x ) ) -!9520 format( 'ta, rhoa, acon ', 3(1pe11.3) ) -!9530 format( 'n, ntype, sg, vol ', i6, i5, 2(1pe11.3) ) -!9540 format( 'num, num0, v2nhi&lo', 4(1pe11.3) ) -!9550 format( 'masses ', 6(1pe11.3) ) -! end if - - end do - - -! call Razzak-Ghan activation routine with single updraft - wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now - sigw = 0.0_r8 - wdiab = 0.0_r8 - wminf = wbar - wmaxf = wbar - - call activate_modal( & - wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & - naerosol, ntot_amode, vaerosol, hygro, & - fn, fm, fluxn, fluxm, flux_fullact ) - - - -! diagnostic output for testing/development - if (idiag_act > 0) then - n = min( ntot_amode, 3 ) - write(lun, '(a,i3,2f6.3, 1p,2(2x,3e10.2), 0p,3(2x,3f6.3) )' ) & - 'qaku k,w,qn,qm,hy,fn,fm', k, wup, wbar, & - naerosol(1:n)/rhoair, vaerosol(1:n)*1.8e3_r8/rhoair, & - hygro(1:n), fn(1:n), fm(1:n) - ! convert naer, vaer to number and (approx) mass TMRs - end if -! if (lun > 0) then -! write(lun,9560) (fn(n), n=1,ntot_amode) -! write(lun,9570) (fm(n), n=1,ntot_amode) -!9560 format( 'fnact values ', 6(1pe11.3) ) -!9570 format( 'fmact values ', 6(1pe11.3) ) -! end if - - -! apply the activation fractions to the updraft aerosol mixing ratios - dt_u_inv = 1.0_r8/dt_u - - do n = 1, ntot_amode - do ll = 0, nspec_amode(n) - if (ll == 0) then - la = numptr_amode(n) - lc = numptrcw_amode(n) + pcnst - tmp_fact = fn(n) - else - la = lmassptr_amode(ll,n) - lc = lmassptrcw_amode(ll,n) + pcnst - tmp_fact = fm(n) - end if - - if ( (method_reduce_actfrac == 1) .and. & - (factor_reduce_actfrac >= 0.0_r8) .and. & - (factor_reduce_actfrac < 1.0_r8) ) & - tmp_fact = tmp_fact * factor_reduce_actfrac - - delact = min( conent(la)*tmp_fact*f_ent, conu(la) ) - delact = max( delact, 0.0_r8 ) - conu(la) = conu(la) - delact - conu(lc) = conu(lc) + delact - dconudt(la) = -delact*dt_u_inv - dconudt(lc) = delact*dt_u_inv - end do - end do ! "n = 1, ntot_amode" - - return - end subroutine ma_activate_convproc - - - -!========================================================================================= - subroutine ma_activate_convproc_method2( & - conu, dconudt, & - f_ent, dt_u, wup, & - tair, rhoair, fracice, & - pcnst_extd, lun, idiag_act, & - lchnk, i, k, & - kactfirst, ipass_calc_updraft ) -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate activation of aerosol species in convective updraft -! for a single column and level -! -! Method: -! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface -! f_ent = Fraction of the "before-detrainment" updraft massflux at -! k/k-1 interface" resulting from entrainment of level k air -! (where k is the current level in subr ma_convproc_tend) -! -! On entry to this routine, the conu(l) represents the updraft TMR -! after entrainment, but before chemistry/physics and detrainment. -! -! This routine applies aerosol activation to the conu tracer mixing ratios, -! then adjusts the conu so that on exit, -! conu(la) = conu_incoming(la) - conu(la)*f_act(la) -! conu(lc) = conu_incoming(lc) + conu(la)*f_act(la) -! where -! la, lc = indices for an unactivated/activated aerosol component pair -! f_act = fraction of conu(la) that is activated. The f_act are -! calculated with the Razzak-Ghan activation parameterization. -! The f_act differ for each mode, and for number/surface/mass. -! -! At cloud base (k==kactfirst), primary activation is done using the -! "standard" code in subr activate do diagnose maximum supersaturation. -! Above cloud base, secondary activation is done using a -! prescribed supersaturation. -! -! *** The updraft velocity used for activation calculations is rather -! uncertain and needs more work. However, an updraft of 1-3 m/s -! will activate essentially all of accumulation and coarse mode particles. -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - - use ndrop, only: activate_modal - - use modal_aero_data, only: lmassptr_amode, lmassptrcw_amode, & - ntot_amode, & - nspec_amode, ntot_amode, numptr_amode, numptrcw_amode, & - specdens_amode, spechygro, & - voltonumblo_amode, voltonumbhi_amode - - use rad_constituents,only: rad_cnst_get_info - - implicit none - -!----------------------------------------------------------------------- -! arguments (note: TMR = tracer mixing ratio) - integer, intent(in) :: pcnst_extd - ! conu = tracer mixing ratios in updraft at top of this (current) level - ! The conu are changed by activation - real(r8), intent(inout) :: conu(pcnst_extd) - real(r8), intent(inout) :: dconudt(pcnst_extd) ! TMR tendencies due to activation - - real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was - ! entrained across this layer == eudp/mu_p_eudp - real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the - ! updraft at current level - real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s) - ! at current level updraft - - real(r8), intent(in) :: tair ! Temperature in Kelvin - real(r8), intent(in) :: rhoair ! air density (kg/m3) - - real(r8), intent(in) :: fracice ! Fraction of ice within the cloud - ! used as in-cloud wet removal rate - integer, intent(in) :: lun ! logical unit for diagnostic output - integer, intent(in) :: idiag_act ! flag for diagnostic output - integer, intent(in) :: lchnk ! chunk index - integer, intent(in) :: i ! column index - integer, intent(in) :: k ! level index - integer, intent(in) :: kactfirst ! k at cloud base - integer, intent(in) :: ipass_calc_updraft - -!----------------------------------------------------------------------- -! local variables - integer :: ll, la, lc, n - - real(r8) :: delact ! working variable - real(r8) :: dt_u_inv ! 1.0/dt_u - real(r8) :: fluxm(ntot_amode) ! to understand this, see subr activate_modal - real(r8) :: fluxn(ntot_amode) ! to understand this, see subr activate_modal - real(r8) :: flux_fullact ! to understand this, see subr activate_modal - real(r8) :: fm(ntot_amode) ! mass fraction of aerosols activated - real(r8) :: fn(ntot_amode) ! number fraction of aerosols activated - real(r8) :: hygro(ntot_amode) ! current hygroscopicity for int+act - real(r8) :: naerosol(ntot_amode) ! interstitial+activated number conc (#/m3) - real(r8) :: sigw ! standard deviation of updraft velocity (cm/s) - real(r8) :: smax_prescribed ! prescribed supersaturation for secondary activation (0-1 fraction) - real(r8) :: tmpa, tmpb, tmpc ! working variable - real(r8) :: tmp_fact ! working variable - real(r8) :: vaerosol(ntot_amode) ! int+act volume (m3/m3) - real(r8) :: wbar ! mean updraft velocity (cm/s) - real(r8) :: wdiab ! diabatic vertical velocity (cm/s) - real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s) - - character(len=32) :: spec_type - -!----------------------------------------------------------------------- - - -! when ipass_calc_updraft == 2, apply the activation tendencies -! from pass 1, but multiplied by factor_reduce_actfrac -! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2) - if (ipass_calc_updraft == 2) then - - dt_u_inv = 1.0_r8/dt_u - 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 - - delact = dconudt(lc)*dt_u * factor_reduce_actfrac - delact = min( delact, conu(la) ) - delact = max( delact, 0.0_r8 ) - conu(la) = conu(la) - delact - conu(lc) = conu(lc) + delact - dconudt(la) = -delact*dt_u_inv - dconudt(lc) = delact*dt_u_inv - end do - end do ! "n = 1, ntot_amode" - return - - end if ! (ipass_calc_updraft == 2) - - -! check f_ent > 0 - if (f_ent <= 0.0_r8) return - - - do n = 1, ntot_amode -! compute a (or a+cw) volume and hygroscopicity - tmpa = 0.0_r8 - tmpb = 0.0_r8 - do ll = 1, nspec_amode(n) - tmpc = max( conu(lmassptr_amode(ll,n)), 0.0_r8 ) - if ( use_cwaer_for_activate_maxsat ) & - tmpc = tmpc + max( conu(lmassptrcw_amode(ll,n)+pcnst), 0.0_r8 ) - tmpc = tmpc / specdens_amode(ll,n) - tmpa = tmpa + tmpc - - ! Change the hygroscopicity of POM based on the discussion with Prof. - ! Xiaohong Liu. Some observational studies found that the primary organic - ! material from biomass burning emission shows very high hygroscopicity. - ! Also, found that BC mass will be overestimated if all the aerosols in - ! the primary mode are free to be removed. Therefore, set the hygroscopicity - ! of POM here as 0.2 to enhance the wet scavenge of primary BC and POM. - - call rad_cnst_get_info(0, n, ll, spec_type=spec_type) - if (spec_type=='p-organic' .and. convproc_pom_spechygro>0._r8) then - tmpb = tmpb + tmpc * convproc_pom_spechygro - else - tmpb = tmpb + tmpc * spechygro(ll,n) - end if - end do - vaerosol(n) = tmpa * rhoair - if (tmpa < 1.0e-35_r8) then - hygro(n) = 0.2_r8 - else - hygro(n) = tmpb/tmpa - end if - -! load a (or a+cw) number and bound it - tmpa = max( conu(numptr_amode(n)), 0.0_r8 ) - if ( use_cwaer_for_activate_maxsat ) & - tmpa = tmpa + max( conu(numptrcw_amode(n)+pcnst), 0.0_r8 ) - naerosol(n) = tmpa * rhoair - naerosol(n) = max( naerosol(n), & - vaerosol(n)*voltonumbhi_amode(n) ) - naerosol(n) = min( naerosol(n), & - vaerosol(n)*voltonumblo_amode(n) ) - -! diagnostic output for testing/development -! if (lun > 0) then -! if (n == 1) then -! write(lun,9500) -! write(lun,9510) (cnst_name(l), conu(l), l=1,pcnst_extd) -! write(lun,9520) tair, rhoaircgs, airconcgs -! end if -! write(lun,9530) n, ntype(n), vaerosol -! write(lun,9540) naerosol(n), tmp*airconcgs, & -! voltonumbhi_amode(n), voltonumblo_amode(n) -! write(lun,9550) (maerosol(l,n), l=1,ntype(n)) -!9500 format( / 'activate_conv output -- conu values' ) -!9510 format( 3( a, 1pe11.3, 4x ) ) -!9520 format( 'ta, rhoa, acon ', 3(1pe11.3) ) -!9530 format( 'n, ntype, sg, vol ', i6, i5, 2(1pe11.3) ) -!9540 format( 'num, num0, v2nhi&lo', 4(1pe11.3) ) -!9550 format( 'masses ', 6(1pe11.3) ) -! end if - - end do - - -! call Razzak-Ghan activation routine with single updraft - wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now - sigw = 0.0_r8 - wdiab = 0.0_r8 - wminf = wbar - wmaxf = wbar - - if (k == kactfirst) then - - call activate_modal( & - wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & - naerosol, ntot_amode, vaerosol, hygro, & - fn, fm, fluxn, fluxm, flux_fullact ) - - - else -! above cloud base - do secondary activation with prescribed supersat -! that is constant with height - smax_prescribed = method2_activate_smaxmax - call activate_modal( & - wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & - naerosol, ntot_amode, vaerosol, hygro, & - fn, fm, fluxn, fluxm, flux_fullact, smax_prescribed ) - end if - - -! diagnostic output for testing/development - if (idiag_act > 0) then - n = min( ntot_amode, 3 ) - write(lun, '(a,i3,2f6.3, 1p,2(2x,3e10.2), 0p,3(2x,3f6.3) )' ) & - 'qaku k,w,qn,qm,hy,fn,fm', k, wup, wbar, & - naerosol(1:n)/rhoair, vaerosol(1:n)*1.8e3_r8/rhoair, & - hygro(1:n), fn(1:n), fm(1:n) - ! convert naer, vaer to number and (approx) mass TMRs - end if -! if (lun > 0) then -! write(lun,9560) (fn(n), n=1,ntot_amode) -! write(lun,9570) (fm(n), n=1,ntot_amode) -!9560 format( 'fnact values ', 6(1pe11.3) ) -!9570 format( 'fmact values ', 6(1pe11.3) ) -! end if - - -! apply the activation fractions to the updraft aerosol mixing ratios - dt_u_inv = 1.0_r8/dt_u - - do n = 1, ntot_amode - do ll = 0, nspec_amode(n) - if (ll == 0) then - la = numptr_amode(n) - lc = numptrcw_amode(n) + pcnst - tmp_fact = fn(n) - else - la = lmassptr_amode(ll,n) - lc = lmassptrcw_amode(ll,n) + pcnst - tmp_fact = fm(n) - end if - - if ( (method_reduce_actfrac == 1) .and. & - (factor_reduce_actfrac >= 0.0_r8) .and. & - (factor_reduce_actfrac < 1.0_r8) ) & - tmp_fact = tmp_fact * factor_reduce_actfrac - - delact = min( conu(la)*tmp_fact, conu(la) ) - delact = max( delact, 0.0_r8 ) - conu(la) = conu(la) - delact - conu(lc) = conu(lc) + delact - dconudt(la) = -delact*dt_u_inv - dconudt(lc) = delact*dt_u_inv - end do - end do ! "n = 1, ntot_amode" - - return - end subroutine ma_activate_convproc_method2 - - - -!========================================================================================= - subroutine ma_resuspend_convproc( & - dcondt, dcondt_resusp, & - const, dp_i, ktop, kbot_prevap, pcnst_extd ) -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate resuspension of activated aerosol species resulting from both -! detrainment from updraft and downdraft into environment -! subsidence and lifting of environment, which may move air from -! levels with large-scale cloud to levels with no large-scale cloud -! -! Method: -! Three possible approaches were considered: -! -! 1. Ad-hoc #1 approach. At each level, adjust dcondt for the activated -! and unactivated portions of a particular aerosol species so that the -! ratio of dcondt (activated/unactivate) is equal to the ratio of the -! mixing ratios before convection. -! THIS WAS IMPLEMENTED IN MIRAGE2 -! -! 2. Ad-hoc #2 approach. At each level, adjust dcondt for the activated -! and unactivated portions of a particular aerosol species so that the -! change to the activated portion is minimized (zero if possible). The -! would minimize effects of convection on the large-scale cloud. -! THIS IS CURRENTLY IMPLEMENTED IN CAM5 where we assume that convective -! clouds have no impact on the stratiform-cloudborne aerosol -! -! 3. Mechanistic approach that treats the details of interactions between -! the large-scale and convective clouds. (Something for the future.) -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - - use modal_aero_data, only: lmassptr_amode, lmassptrcw_amode, & - nspec_amode, ntot_amode, numptr_amode, numptrcw_amode - - implicit none - -!----------------------------------------------------------------------- -! arguments -! (note: TMR = tracer mixing ratio) - integer, intent(in) :: pcnst_extd - real(r8), intent(inout) :: dcondt(pcnst_extd,pver) - ! overall TMR tendency from convection - real(r8), intent(inout) :: dcondt_resusp(pcnst_extd,pver) - ! portion of TMR tendency due to resuspension - ! (actually, due to the adjustments made here) - real(r8), intent(in) :: const(pcnst_extd,pver) ! TMRs before convection - - real(r8), intent(in) :: dp_i(pver) ! pressure thickness of level (in mb) - integer, intent(in) :: ktop, kbot_prevap ! indices of top and bottom cloud levels - -!----------------------------------------------------------------------- -! local variables - integer :: k, ll, la, lc, n - real(r8) :: qa, qc, qac ! working variables (mixing ratios) - real(r8) :: qdota, qdotc, qdotac ! working variables (MR tendencies) -!----------------------------------------------------------------------- - - - 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 - -! apply adjustments to dcondt for pairs of unactivated (la) and -! activated (lc) aerosol species - if ( (la <= 0) .or. (la > pcnst_extd) ) cycle - if ( (lc <= 0) .or. (lc > pcnst_extd) ) cycle - - do k = ktop, kbot_prevap - qdota = dcondt(la,k) - qdotc = dcondt(lc,k) - qdotac = qdota + qdotc - -! mirage2 approach -! qa = max( const(la,k), 0.0_r8 ) -! qc = max( const(lc,k), 0.0_r8 ) -! qac = qa + qc -! if (qac <= 0.0) then -! dcondt(la,k) = qdotac -! dcondt(lc,k) = 0.0 -! else -! dcondt(la,k) = qdotac*(qa/qac) -! dcondt(lc,k) = qdotac*(qc/qac) -! end if - -! cam5 approach - if (convproc_do_evaprain_atonce) then - dcondt(la,k) = qdota - dcondt(lc,k) = qdotc - - dcondt_resusp(la,k) = dcondt(la,k) - dcondt_resusp(lc,k) = dcondt(lc,k) - else - dcondt(la,k) = qdotac - dcondt(lc,k) = 0.0_r8 - - dcondt_resusp(la,k) = (dcondt(la,k) - qdota) - dcondt_resusp(lc,k) = (dcondt(lc,k) - qdotc) - end if - end do - - end do ! "ll = -1, nspec_amode(n)" - end do ! "n = 1, ntot_amode" - - return - end subroutine ma_resuspend_convproc - - - -!========================================================================================= - - - -end module modal_aero_convproc diff --git a/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 b/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 index aa7155a78a..d45b0d46af 100644 --- a/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 +++ b/src/chemistry/modal_aero/modal_aero_gasaerexch.F90 @@ -98,6 +98,8 @@ subroutine modal_aero_gasaerexch_sub( & use modal_aero_data, only: lptr_so4_a_amode,lptr_nh4_a_amode use modal_aero_data, only: modeptr_pcarbon,nspec_amode,specmw_amode,specdens_amode use modal_aero_rename, only: modal_aero_rename_sub +use rad_constituents, only: rad_cnst_get_info +use constituents, only: pcnst, cnst_mw use cam_history, only: outfld, fieldname_len use chem_mods, only: adv_mass @@ -106,7 +108,7 @@ subroutine modal_aero_gasaerexch_sub( & use physconst, only: gravit, mwdry, rair use cam_abortutils, only: endrun use spmd_utils, only: iam, masterproc - +use phys_control, only: cam_chempkg_is implicit none @@ -122,13 +124,13 @@ subroutine modal_aero_gasaerexch_sub( & ! *** MUST BE #/kmol-air for number ! *** MUST BE mol/mol-air for mass ! *** NOTE ncol dimension - real(r8), intent(inout) :: qqcw(ncol,pver,pcnstxx) + real(r8), intent(inout) :: qqcw(ncol,pver,pcnstxx) ! like q but for cloud-borner tracers - real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) + real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) ! TMR tendency from other continuous ! growth processes (aqchem, soa??) ! *** NOTE ncol dimension - real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) + real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) ! like dqdt_other but for cloud-borner tracers real(r8), intent(in) :: t(pcols,pver) ! temperature at model levels (K) real(r8), intent(in) :: pmid(pcols,pver) ! pressure at model levels (Pa) @@ -140,7 +142,7 @@ subroutine modal_aero_gasaerexch_sub( & ! dry & wet geo. mean dia. (m) of number distrib. -! !DESCRIPTION: +! !DESCRIPTION: ! computes TMR (tracer mixing ratio) tendencies for gas condensation ! onto aerosol particles ! @@ -151,7 +153,7 @@ subroutine modal_aero_gasaerexch_sub( & ! aerosol MSA is not distinguished from aerosol SO4 ! gas NH3 (if present) goes to aerosol NH4 ! if gas NH3 is not present, then ???? -! +! ! ! !REVISION HISTORY: ! RCE 07.04.13: Adapted from MIRAGE2 code @@ -183,7 +185,8 @@ subroutine modal_aero_gasaerexch_sub( & logical :: is_dorename_atik, dorename_atik(ncol,pver) character(len=fieldname_len+3) :: fieldname - character(len=100) :: msg !BSINGH - msg string for endrun calls + character(len=100) :: msg ! string for endrun calls + character(len=32) :: spec_type real (r8) :: avg_uprt_nh4, avg_uprt_so4, avg_uprt_soa(nsoa) real (r8) :: deltatxx @@ -211,9 +214,9 @@ subroutine modal_aero_gasaerexch_sub( & real (r8) :: tmp_kxt, tmp_pxt real (r8) :: tmp_so4a_bgn, tmp_so4a_end real (r8) :: tmp_so4g_avg, tmp_so4g_bgn, tmp_so4g_equ - real (r8) :: uptkrate(ntot_amode,pcols,pver) + real (r8) :: uptkrate(ntot_amode,pcols,pver) real (r8) :: uptkratebb(ntot_amode) - real (r8) :: uptkrate_soa(ntot_amode,nsoa) + real (r8) :: uptkrate_soa(ntot_amode,nsoa) ! gas-to-aerosol mass transfer rates (1/s) real (r8) :: vol_core, vol_shell real (r8) :: xferfrac_pcage, xferfrac_max @@ -236,7 +239,7 @@ subroutine modal_aero_gasaerexch_sub( & real(r8) :: dqdt(ncol,pver,pcnstxx) ! TMR "delta q" array - NOTE dims real(r8) :: dqqcwdt(ncol,pver,pcnstxx) ! like dqdt but for cloud-borner tracers real(r8) :: qsrflx(pcols,pcnstxx,nsrflx) - ! process-specific column tracer tendencies + ! process-specific column tracer tendencies ! (1=renaming, 2=gas condensation) real(r8) :: qconff(pcols,pver),qevapff(pcols,pver) real(r8) :: qconbb(pcols,pver),qevapbb(pcols,pver) @@ -260,7 +263,11 @@ subroutine modal_aero_gasaerexch_sub( & ! set gas species indices call cnst_get_ind( 'H2SO4', l_so4g, .false. ) call cnst_get_ind( 'NH3', l_nh4g, .false. ) - call cnst_get_ind( 'MSA', l_msag, .false. ) + if ( .not. cam_chempkg_is('geoschem_mam4') ) then + call cnst_get_ind( 'MSA', l_msag, .false. ) + else + l_msag = 0 + endif l_so4g = l_so4g - loffset l_nh4g = l_nh4g - loffset l_msag = l_msag - loffset @@ -453,7 +460,7 @@ subroutine modal_aero_gasaerexch_sub( & end if uptkrate_soa(n,jsoa) = fgain_soa(n,jsoa) end do ! jsoa - ! in previous code versions with nsoa=1, + ! in previous code versions with nsoa=1, ! qold_poa was non-zero (i.e., loaded from q) only when ido_soaa(n)=1 ! thus qold_poa=0 for the primary carbon mode which has ido_soaa=2 ! this is probably not how it should be @@ -551,7 +558,7 @@ subroutine modal_aero_gasaerexch_sub( & end do ! do not allow msa condensation in stratosphere ! ( Note that the code for msa has never been used. - ! The plan was to simulate msa(g), treat it as non-volatile (like h2so4(g)), + ! The plan was to simulate msa(g), treat it as non-volatile (like h2so4(g)), ! and treat condensed msa as sulfate, so just one additional tracer. ) if ( do_msag ) sum_dqdt_msa = 0.0_r8 @@ -588,8 +595,19 @@ subroutine modal_aero_gasaerexch_sub( & do jsoa = 1, nsoa qold_soag(jsoa) = q(i,k,l_soag(jsoa)) end do - mw_poa_host = 12.0_r8 - mw_soa_host = 250.0_r8 + + ! get molecular weight from the host model + do n = 1, ntot_amode + do l = 1, nspec_amode(n) + call rad_cnst_get_info(0, n, l, spec_type=spec_type ) + select case( spec_type ) + case('s-organic') + mw_soa_host(:) = specmw_amode(l,n) + case('p-organic') + mw_poa_host(:) = specmw_amode(l,n) + end select + end do + end do call modal_aero_soaexch( deltat, t(i,k), pmid(i,k), & niter, niter_max, ntot_amode, ntot_soamode, npoa, nsoa, & @@ -670,7 +688,7 @@ subroutine modal_aero_gasaerexch_sub( & end if end do end do ! n - + ! compute TMR tendencies for h2so4, nh3, and msa gas ! due to simple gas uptake l = l_so4g @@ -697,7 +715,7 @@ subroutine modal_aero_gasaerexch_sub( & qsrflx(i,l,jsrf) = qsrflx(i,l,jsrf) + dqdt(i,k,l)*pdel_fac end if end do - + ! compute TMR tendencies associated with primary carbon aging if (modefrm_pcage > 0) then n = modeptr_pcarbon @@ -712,16 +730,16 @@ subroutine modal_aero_gasaerexch_sub( & vol_core = vol_core + & q(i,k,lmassptr_amode(l,n)-loffset)*fac_m2v_pcarbon(l) end do -! ratio1 = vol_shell/vol_core = +! ratio1 = vol_shell/vol_core = ! actual hygroscopic-shell-volume/carbon-core-volume after gas uptake ! ratio2 = 6.0_r8*dr_so4_monolayers_pcage/(dgncur_a*fac_volsfc_pcarbon) -! = (shell-volume corresponding to n_so4_monolayers_pcage)/core-volume +! = (shell-volume corresponding to n_so4_monolayers_pcage)/core-volume ! The 6.0/(dgncur_a*fac_volsfc_pcarbon) = (mode-surface-area/mode-volume) ! Note that vol_shell includes both so4+nh4 AND soa as "equivalent so4", ! The soa_equivso4_factor accounts for the lower hygroscopicity of soa. ! ! Define xferfrac_pcage = min( 1.0, ratio1/ratio2) -! But ratio1/ratio2 == tmp1/tmp2, and coding below avoids possible overflow +! But ratio1/ratio2 == tmp1/tmp2, and coding below avoids possible overflow ! tmp1 = vol_shell*dgncur_a(i,k,n)*fac_volsfc_pcarbon tmp2 = max( 6.0_r8*dr_so4_monolayers_pcage*vol_core, 0.0_r8 ) @@ -821,7 +839,7 @@ subroutine modal_aero_gasaerexch_sub( & ! diagnostics start ------------------------------------------------------- !!$ if (ldiag3 > 0) then -!!$ if (icol_diag > 0) then +!!$ if (icol_diag > 0) then !!$ i = icol_diag !!$ write(*,'(a,3i5)') 'gasaerexch ppp nstep,lat,lon', nstep, latndx(i), lonndx(i) !!$ write(*,'(2i5,3(2x,a))') 0, 0, 'ppp', 'pdel for all k' @@ -901,7 +919,7 @@ subroutine modal_aero_gasaerexch_sub( & else if (jsrf == jsrflx_rename) then if ( .not. dotendrn(l) ) cycle fieldname = trim(cnst_name(lb)) // '_sfgaex2' - else + else cycle end if do i = 1, ncol @@ -914,7 +932,7 @@ subroutine modal_aero_gasaerexch_sub( & else if (jsrf == jsrflx_rename) then if ( .not. dotendqqcwrn(l) ) cycle fieldname = trim(cnst_name_cw(lb)) // '_sfgaex2' - else + else cycle end if do i = 1, ncol @@ -925,7 +943,7 @@ subroutine modal_aero_gasaerexch_sub( & end do ! jac = ... end do ! jsrf = ... end do ! l = ... - + return end subroutine modal_aero_gasaerexch_sub @@ -963,11 +981,11 @@ subroutine gas_aer_uptkrates( ncol, loffset, & real(r8), intent(in) :: pmid(pcols,pver) ! Air pressure in Pa real(r8), intent(in) :: dgncur_awet(pcols,pver,ntot_amode) - real(r8), intent(out) :: uptkrate(ntot_amode,pcols,pver) + real(r8), intent(out) :: uptkrate(ntot_amode,pcols,pver) ! gas-to-aerosol mass transfer rates (1/s) -! local +! local integer, parameter :: nghq = 2 integer :: i, iq, k, l1, l2, la, n @@ -1022,7 +1040,7 @@ subroutine gas_aer_uptkrates( ncol, loffset, & !! "bounded" number conc. (#/m3) ! num_a = dryvol_a(i,k)*v2ncur_a(i,k,n)*aircon -! number conc. (#/m3) -- note q(i,k,numptr) is (#/kmol-air) +! number conc. (#/m3) -- note q(i,k,numptr) is (#/kmol-air) ! so need aircon in (kmol-air/m3) aircon = rhoair/mwdry ! (kmol-air/m3) num_a = q(i,k,numptr_amode(n)-loffset)*aircon @@ -1038,7 +1056,7 @@ subroutine gas_aer_uptkrates( ncol, loffset, & lnsg = log( sigmag_amode(n) ) lndpgn = log( dgncur_awet(i,k,n) ) ! (m) const = tworootpi * num_a * exp(beta*lndpgn + 0.5_r8*(beta*lnsg)**2) - + ! sum over gauss-hermite quadrature points sumghq = 0.0_r8 do iq = 1, nghq @@ -1056,7 +1074,7 @@ subroutine gas_aer_uptkrates( ncol, loffset, & (knudsen*(1.184_r8 + knudsen) + 0.4875_r8) sumghq = sumghq + wghq(iq)*dp*fuchs_sutugin/(dp**beta) end do - uptkrate(n,i,k) = const * gasdiffus * sumghq + uptkrate(n,i,k) = const * gasdiffus * sumghq end do ! "do i = 1, ncol" end do ! "do k = 1, pver" @@ -1080,7 +1098,7 @@ subroutine modal_aero_soaexch( dtfull, temp, pres, & ! ! Purpose: ! -! calculates condensation/evaporation of "soa gas" +! calculates condensation/evaporation of "soa gas" ! to/from multiple aerosol modes in 1 grid cell ! ! key assumptions @@ -1090,7 +1108,7 @@ subroutine modal_aero_soaexch( dtfull, temp, pres, & ! particle surface is given by raoults law in the form ! g_star = g0_soa*[a_soa/(a_soa + a_opoa)] ! (3) (oxidized poa)/(total poa) is equal to frac_opoa (constant) -! +! ! ! Author: R. Easter and R. Zaveri ! Additions to run with multiple BC, SOA and POM's: Shrivastava et al., 2015 @@ -1121,7 +1139,7 @@ subroutine modal_aero_soaexch( dtfull, temp, pres, & integer :: ll integer :: m,k - + logical :: skip_soamode(ntot_amode) ! true if this mode does not have soa real(r8), parameter :: a_min1 = 1.0e-20_r8 @@ -1162,13 +1180,13 @@ subroutine modal_aero_soaexch( dtfull, temp, pres, & ! New SOA properties added by Manish Shrivastava on 09/27/2012 if (ntot_soaspec ==1) then - p0_soa_298(:) = 1.0e-10_r8 - delh_vap_soa(:) = 156.0e3_r8 - opoa_frac(:) = 0.1_r8 - elseif (ntot_soaspec ==2) then + p0_soa_298(:) = 9.7831E-11_r8 + delh_vap_soa(:) = 131.0e3_r8 + opoa_frac(:) = 0.0_r8 + elseif (ntot_soaspec ==2) then ! same for anthropogenic and biomass burning species p0_soa_298 (1) = 1.0e-10_r8 - p0_soa_298 (2) = 1.0e-10_r8 + p0_soa_298 (2) = 1.0e-10_r8 delh_vap_soa(:) = 156.0e3_r8 elseif(ntot_soaspec ==5) then ! 5 volatility bins for each of the a combined SOA classes ( including biomass burning, fossil fuel, biogenic) @@ -1184,7 +1202,7 @@ subroutine modal_aero_soaexch( dtfull, temp, pres, & delh_vap_soa(4) = 120.0e3_r8 delh_vap_soa(5) = 109.0e3_r8 elseif(ntot_soaspec ==15) then - ! + ! ! 5 volatility bins for each of the 3 SOA classes ( biomass burning, fossil fuel, biogenic) ! SOA species 1-5 are for anthropogenic while 6-10 are for biomass burning SOA ! SOA species 11-15 are for biogenic SOA, based on Cappa et al., Reference needs to be updated @@ -1242,7 +1260,7 @@ subroutine modal_aero_soaexch( dtfull, temp, pres, & ! convert incoming mixing ratios from mol/mol at the "host-code" molec. weight (12.0 in cam5) ! to mol/mol at the "actual" molec. weight (currently assumed to be 250.0) - ! also + ! also ! force things to be non-negative ! calc tot_soa(ll) ! calc a_opoa (always slightly >0) @@ -1257,14 +1275,11 @@ subroutine modal_aero_soaexch( dtfull, temp, pres, & end do end do - tmpf = mw_poa_host(1)/mw_poa(1) do m = 1, ntot_soamode if ( skip_soamode(m) ) cycle a_opoa(m) = 0.0_r8 do ll = 1, ntot_poaspec - tmpf = mw_poa_host(ll)/mw_poa(ll) a_opoa(m) = opoa_frac(ll)*a_poa_in(m,ll) - a_opoa(m) = max( a_opoa(m), 1.0e-20_r8 ) ! force to small non-zero value end do end do @@ -1274,12 +1289,6 @@ subroutine modal_aero_soaexch( dtfull, temp, pres, & exp( -(delh_vap_soa(ll)/rgas)*((1.0_r8/temp)-(1.0_r8/298.0_r8)) ) g0_soa(ll) = 1.01325e5_r8*p0_soa(ll)/pres end do - ! IF mw of soa EQ 12 (as in the MAM3 default case), this has to be in - ! should actully talk the mw from the chemistry mechanism and substitute with 12.0 - if (.not.soa_multi_species) then - g0_soa = g0_soa*(150.0_r8/12.0_r8) - else - end if niter = 0 tcur = 0.0_r8 @@ -1292,7 +1301,7 @@ subroutine modal_aero_soaexch( dtfull, temp, pres, & ! write(luna,'(3a)') & ! 'niter, tcur, dtcur, phi(:), ', & ! 'g_star(:), ', & -! 'a_soa(:), g_soa' +! 'a_soa(:), g_soa' ! write(luna,'(3a)') & ! ' sat(:), ', & ! 'sat(:)*a_soa(:) ', & @@ -1473,9 +1482,9 @@ subroutine modal_aero_gasaerexch_init logical :: history_aerosol ! Output the MAM aerosol tendencies logical :: history_aerocom ! Output the aerocom history !----------------------------------------------------------------------- - + call phys_getopts( history_aerosol_out = history_aerosol ) - + maxspec_pcage = nspec_max allocate(lspecfrm_pcage(maxspec_pcage)) allocate(lspectoo_pcage(maxspec_pcage)) @@ -1486,7 +1495,7 @@ subroutine modal_aero_gasaerexch_init ! ! define "from mode" and "to mode" for primary carbon aging ! -! skip (turn off) aging if either is absent, +! skip (turn off) aging if either is absent, ! or if accum mode so4 is absent ! modefrm_pcage = -999888777 @@ -1501,7 +1510,7 @@ subroutine modal_aero_gasaerexch_init ! ! define species involved in each primary carbon aging pairing ! (include aerosol water) -! +! ! mfrm = modefrm_pcage mtoo = modetoo_pcage @@ -1589,7 +1598,7 @@ subroutine modal_aero_gasaerexch_init write(lunout,*) - end if ! ( masterproc ) + end if ! ( masterproc ) 9310 format( / 'subr. modal_aero_gasaerexch_init - primary carbon aging pointers' ) 9320 format( 'pair', i3, 5x, 'mode', i3, ' ---> mode', i3 ) @@ -1715,7 +1724,7 @@ subroutine modal_aero_gasaerexch_init if ( history_aerosol ) then call add_default( fieldname, 1, ' ' ) endif - if ( masterproc ) write(*,'(3(a,3x))') 'qevapbg addfld', fieldname, unit + if ( masterproc ) write(*,'(3(a,3x))') 'qevapbg addfld', fieldname, unit fieldname=trim('qcon_gaex') long_name = trim('3D fields for SOA condensation') @@ -1731,7 +1740,7 @@ subroutine modal_aero_gasaerexch_init if ( history_aerosol ) then call add_default( fieldname, 1, ' ' ) endif - if ( masterproc ) write(*,'(3(a,3x))') 'qevap addfld', fieldname, unit + if ( masterproc ) write(*,'(3(a,3x))') 'qevap addfld', fieldname, unit !------------------------------------------------------------------------------ ! define history fields for basic gas-aer exchange @@ -1744,7 +1753,7 @@ subroutine modal_aero_gasaerexch_init long_name = trim(tmpnamea) // ' gas-aerosol-exchange primary column tendency' unit = 'kg/m2/s' call addfld( fieldname, horiz_only, 'A', unit, long_name ) - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default( fieldname, 1, ' ' ) endif if ( masterproc ) write(*,'(3(a,3x))') 'gasaerexch addfld', fieldname, unit @@ -1791,7 +1800,7 @@ subroutine modal_aero_gasaerexch_init if ((tmpnamea(1:3) == 'num') .or. & (tmpnamea(1:3) == 'NUM')) unit = '#/m2/s' call addfld( fieldname, horiz_only, 'A', unit, long_name ) - if ( history_aerosol ) then + if ( history_aerosol ) then call add_default( fieldname, 1, ' ' ) endif if ( masterproc ) write(*,'(3(a,3x))') 'gasaerexch addfld', fieldname, unit @@ -1799,7 +1808,7 @@ subroutine modal_aero_gasaerexch_init end do ! l = ... -! set for used in aging calcs: +! set for used in aging calcs: ! fac_m2v_so4, fac_m2v_nh4, fac_m2v_soa(:) ! soa_equivso4_factor(:) soa_equivso4_factor = 0.0_r8 @@ -1878,4 +1887,3 @@ end subroutine modal_aero_gasaerexch_init !---------------------------------------------------------------------- end module modal_aero_gasaerexch - diff --git a/src/chemistry/modal_aero/modal_aero_newnuc.F90 b/src/chemistry/modal_aero/modal_aero_newnuc.F90 index 7e5bfc4085..5bb93be655 100644 --- a/src/chemistry/modal_aero/modal_aero_newnuc.F90 +++ b/src/chemistry/modal_aero/modal_aero_newnuc.F90 @@ -237,10 +237,9 @@ subroutine modal_aero_newnuc_sub( & mass1p_aithi = tmpa*(dphim_mode(1)**3) ! compute qv_sat = saturation specific humidity - call qsat(t(1:ncol, 1:pver), pmid(1:ncol, 1:pver), & - ev_sat(1:ncol, 1:pver), qv_sat(1:ncol, 1:pver)) - - + do k = 1, pver + call qsat(t(1:ncol,k), pmid(1:ncol,k), ev_sat(1:ncol,k), qv_sat(1:ncol,k), ncol) + end do ! ! loop over levels and columns to calc the renaming ! diff --git a/src/chemistry/modal_aero/modal_aero_rename.F90 b/src/chemistry/modal_aero/modal_aero_rename.F90 index 985b7805dc..9ff3a2c87d 100644 --- a/src/chemistry/modal_aero/modal_aero_rename.F90 +++ b/src/chemistry/modal_aero/modal_aero_rename.F90 @@ -20,8 +20,10 @@ module modal_aero_rename use modal_aero_data, only: alnsg_amode, voltonumblo_amode, voltonumbhi_amode, dgnum_amode, nspec_amode use modal_aero_data, only: specmw_amode, specdens_amode, lmassptr_amode, lmassptrcw_amode use modal_aero_data, only: numptr_amode, numptrcw_amode, modeptr_coarse, modeptr_accum + use modal_aero_data, only: modeptr_stracoar use modal_aero_data, only: specmw_amode, specdens_amode, lmassptr_amode, lmassptrcw_amode, numptr_amode, numptrcw_amode use modal_aero_data, only: dgnumhi_amode, dgnumlo_amode, cnst_name_cw, modeptr_aitken + use rad_constituents,only: rad_cnst_get_mode_idx implicit none private @@ -33,23 +35,15 @@ module modal_aero_rename ! !PUBLIC DATA MEMBERS: integer, parameter :: pcnstxx = gas_pcnst -! *** select one of the 3 following options -! *** for maxpair_renamexf = 2 or 3, use mode definition files with -! dgnumhi_amode(modeptr_accum) = 1.1e-6 m -! dgnumlo_amode(modeptr_coarse) = 0.9e-6 m - -! integer, parameter, public :: maxpair_renamexf = 1 -! integer, parameter, public :: ipair_select_renamexf(maxpair_renamexf) = (/ 2001 /) - -! integer, parameter, public :: maxpair_renamexf = 2 -! integer, parameter, public :: ipair_select_renamexf(maxpair_renamexf) = (/ 2001, 1003 /) - integer, parameter, public :: maxpair_renamexf = 3 - integer, parameter, public :: ipair_select_renamexf(maxpair_renamexf) = (/ 2001, 1003, 3001 /) + + integer, protected, public :: ipair_select_renamexf(maxpair_renamexf) ! ipair_select_renamexf defines the mode_from and mode_too for each renaming pair ! 2001 = aitken --> accum ! 1003 = accum --> coarse ! 3001 = coarse --> accum +! 1005 = accum --> stracoar +! 5001 = stracoar --> accum integer, parameter, public :: method_optbb_renamexf = 2 @@ -108,7 +102,19 @@ module modal_aero_rename !------------------------------------------------------------------ subroutine modal_aero_rename_init(modal_accum_coarse_exch_in) logical, optional, intent(in) :: modal_accum_coarse_exch_in - + + ! ipair_select_renamexf defines the mode_from and mode_too for each renaming pair + ! 2001 = aitken --> accum + ! 1003 = accum --> coarse + ! 3001 = coarse --> accum + ! 1005 = accum --> stracoar + ! 5001 = stracoar --> accum + if( rad_cnst_get_mode_idx(0,'coarse_strat') > 0 ) then + ipair_select_renamexf(1:maxpair_renamexf) = (/ 2001, 1005, 5001 /) + else + ipair_select_renamexf(1:maxpair_renamexf) = (/ 2001, 1003, 3001 /) + endif + allocate( lspecfrma_renamexf(maxspec_renamexf,maxpair_renamexf) ) allocate( lspecfrmc_renamexf(maxspec_renamexf,maxpair_renamexf) ) allocate( lspectooa_renamexf(maxspec_renamexf,maxpair_renamexf) ) @@ -170,18 +176,15 @@ subroutine modal_aero_rename_sub( & real(r8), intent(in) :: qqcw(ncol,pver,pcnstxx) ! like q but for cloud-borne species real(r8), intent(inout) :: dqdt(ncol,pver,pcnstxx) ! TMR tendency array; - ! incoming dqdt = tendencies for the - ! "fromwhere" continuous growth process + ! incoming dqdt = tendencies for the + ! "fromwhere" continuous growth process ! the renaming tendencies are added on ! *** NOTE ncol and pcnstxx dimensions real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx) - real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) - ! tendencies for "other" continuous growth process - ! currently in cam3 - ! dqdt is from gas (h2so4, nh3) condensation - ! dqdt_other is from aqchem and soa + real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) + ! tendencies for "other" continuous growth process ! *** NOTE ncol and pcnstxx dimensions - real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) + real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) logical, intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which ! renaming dqdt is computed logical, intent(inout) :: dotendqqcwrn(pcnstxx) @@ -193,7 +196,7 @@ subroutine modal_aero_rename_sub( & integer, intent(in) :: nsrflx ! last dimension of qsrflx real(r8), intent(inout) :: qsrflx(pcols,pcnstxx,nsrflx) - ! process-specific column tracer tendencies + ! process-specific column tracer tendencies real(r8), intent(inout) :: qqcwsrflx(pcols,pcnstxx,nsrflx) real(r8), optional, intent(out) & :: dqdt_rnpos(ncol,pver,pcnstxx) @@ -273,18 +276,15 @@ subroutine modal_aero_rename_no_acc_crs_sub( & real(r8), intent(in) :: qqcw(ncol,pver,pcnstxx) ! like q but for cloud-borne species real(r8), intent(inout) :: dqdt(ncol,pver,pcnstxx) ! TMR tendency array; - ! incoming dqdt = tendencies for the - ! "fromwhere" continuous growth process + ! incoming dqdt = tendencies for the + ! "fromwhere" continuous growth process ! the renaming tendencies are added on ! *** NOTE ncol and pcnstxx dimensions real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx) - real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) - ! tendencies for "other" continuous growth process - ! currently in cam3 - ! dqdt is from gas (h2so4, nh3) condensation - ! dqdt_other is from aqchem and soa + real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) + ! tendencies for "other" continuous growth process ! *** NOTE ncol and pcnstxx dimensions - real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) + real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) logical, intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which ! renaming dqdt is computed logical, intent(inout) :: dotendqqcwrn(pcnstxx) @@ -296,10 +296,10 @@ subroutine modal_aero_rename_no_acc_crs_sub( & integer, intent(in) :: nsrflx ! last dimension of qsrflx real(r8), intent(inout) :: qsrflx(pcols,pcnstxx,nsrflx) - ! process-specific column tracer tendencies + ! process-specific column tracer tendencies real(r8), intent(inout) :: qqcwsrflx(pcols,pcnstxx,nsrflx) -! !DESCRIPTION: +! !DESCRIPTION: ! computes TMR (tracer mixing ratio) tendencies for "mode renaming" ! during a continuous growth process ! currently this transfers number and mass (and surface) from the aitken @@ -465,7 +465,7 @@ subroutine modal_aero_rename_no_acc_crs_sub( & mfrm = modefrm_renamexf(ipair) mtoo = modetoo_renamexf(ipair) -! dryvol_t_old is the old total (a+c) dry-volume for the "from" mode +! dryvol_t_old is the old total (a+c) dry-volume for the "from" mode ! in m^3-AP/kmol-air ! dryvol_t_new is the new total dry-volume ! (old/new = before/after the continuous growth) @@ -486,7 +486,7 @@ subroutine modal_aero_rename_no_acc_crs_sub( & num_t_oldbnd = min( dryvol_t_oldbnd*v2nlorlx(mfrm), num_t_old ) num_t_oldbnd = max( dryvol_t_oldbnd*v2nhirlx(mfrm), num_t_oldbnd ) -! no renaming if dgnum < "base" dgnum, +! no renaming if dgnum < "base" dgnum, dgn_t_new = (dryvol_t_new/(num_t_oldbnd*factoraa(mfrm)))**onethird if (dgn_t_new .le. dgnum_amode(mfrm)) cycle mainloop1_ipair @@ -501,7 +501,7 @@ subroutine modal_aero_rename_no_acc_crs_sub( & ! compute old fraction of number and mass in the tail (dp > dp_cut) dgn_t_old = & (dryvol_t_oldbnd/(num_t_oldbnd*factoraa(mfrm)))**onethird -! if dgn_t_new exceeds dp_cut, use the minimum of dgn_t_old and +! if dgn_t_new exceeds dp_cut, use the minimum of dgn_t_old and ! dp_belowcut to guarantee some transfer if (dgn_t_new .ge. dp_cut(ipair)) then dgn_t_old = min( dgn_t_old, dp_belowcut(ipair) ) @@ -519,7 +519,7 @@ subroutine modal_aero_rename_no_acc_crs_sub( & if (dum .le. 0.0_r8) cycle mainloop1_ipair xferfrac_vol = min( dum, dryvol_t_new )/dryvol_t_new - xferfrac_vol = min( xferfrac_vol, xferfrac_max ) + xferfrac_vol = min( xferfrac_vol, xferfrac_max ) xferfrac_num = tailfr_numnew - tailfr_numold xferfrac_num = max( 0.0_r8, min( xferfrac_num, xferfrac_vol ) ) @@ -865,18 +865,15 @@ subroutine modal_aero_rename_acc_crs_sub( & real(r8), intent(in) :: qqcw(ncol,pver,pcnstxx) ! like q but for cloud-borne species real(r8), intent(inout) :: dqdt(ncol,pver,pcnstxx) ! TMR tendency array; - ! incoming dqdt = tendencies for the - ! "fromwhere" continuous growth process + ! incoming dqdt = tendencies for the + ! "fromwhere" continuous growth process ! the renaming tendencies are added on ! *** NOTE ncol and pcnstxx dimensions real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx) - real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) - ! tendencies for "other" continuous growth process - ! currently in cam3 - ! dqdt is from gas (h2so4, nh3) condensation - ! dqdt_other is from aqchem and soa + real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) + ! tendencies for "other" continuous growth process ! *** NOTE ncol and pcnstxx dimensions - real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) + real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) logical, intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which ! renaming dqdt is computed logical, intent(inout) :: dotendqqcwrn(pcnstxx) @@ -888,13 +885,13 @@ subroutine modal_aero_rename_acc_crs_sub( & integer, intent(in) :: nsrflx ! last dimension of qsrflx real(r8), intent(inout) :: qsrflx(pcols,pcnstxx,nsrflx) - ! process-specific column tracer tendencies + ! process-specific column tracer tendencies real(r8), intent(inout) :: qqcwsrflx(pcols,pcnstxx,nsrflx) real(r8), optional, intent(out) & :: dqdt_rnpos(ncol,pver,pcnstxx) ! the positive (production) part of the renaming tendency -! !DESCRIPTION: +! !DESCRIPTION: ! computes TMR (tracer mixing ratio) tendencies for "mode renaming" ! during a continuous growth process ! currently this transfers number and mass (and surface) from the aitken @@ -987,9 +984,9 @@ subroutine modal_aero_rename_acc_crs_sub( & mfrm = modefrm_renamexf(ipair) mtoo = modetoo_renamexf(ipair) - flagaa_shrink = .false. - if ((mfrm==modeptr_coarse) .and. (mtoo==modeptr_accum)) & - flagaa_shrink = .true. + flagaa_shrink = & + ((mfrm==modeptr_coarse) .and. (mtoo==modeptr_accum)) .or. & + ((mfrm==modeptr_stracoar) .and. (mtoo==modeptr_accum)) ! ! compute aerosol dry-volume for the "from mode" of each renaming pair @@ -1062,7 +1059,7 @@ subroutine modal_aero_rename_acc_crs_sub( & end if -! dryvol_t_old is the old total (a+c) dry-volume for the "from" mode +! dryvol_t_old is the old total (a+c) dry-volume for the "from" mode ! in m^3-AP/kmol-air ! dryvol_t_new is the new total dry-volume ! (old/new = before/after the continuous growth) @@ -1111,7 +1108,7 @@ subroutine modal_aero_rename_acc_crs_sub( & end if else if (dgn_t_new .ge. dp_cut(ipair)) then -! if dgn_t_new exceeds dp_cut, use the minimum of dgn_t_oldb and +! if dgn_t_new exceeds dp_cut, use the minimum of dgn_t_oldb and ! dp_belowcut to guarantee some transfer dgn_t_oldb = min( dgn_t_oldb, dp_belowcut(ipair) ) end if @@ -1149,7 +1146,7 @@ subroutine modal_aero_rename_acc_crs_sub( & xferfrac_vol = 1.0_r8 xferfrac_num = 1.0_r8 else - xferfrac_vol = min( xferfrac_vol, xferfrac_max ) + xferfrac_vol = min( xferfrac_vol, xferfrac_max ) xferfrac_num = tailfr_numnew - tailfr_numold xferfrac_num = max( 0.0_r8, min( xferfrac_num, xferfrac_vol ) ) end if @@ -1179,7 +1176,7 @@ subroutine modal_aero_rename_acc_crs_sub( & ! no renaming if (dryvol_t_old ~ 0) if (dryvol_t_old .le. dryvol_smallest(mfrm)) cycle mainloop1_i -! when (delta_dryvol is very small or positive), +! when (delta_dryvol is very small or positive), ! which means particles are not evaporating, ! only do renaming if [(flagaa_shrink true) and (in stratosphere)]], ! and set flagbb_shrink true to identify this special case @@ -1244,7 +1241,7 @@ subroutine modal_aero_rename_acc_crs_sub( & xferfrac_vol = 1.0_r8 xferfrac_num = 1.0_r8 else - xferfrac_vol = min( xferfrac_vol, xferfrac_max ) + xferfrac_vol = min( xferfrac_vol, xferfrac_max ) ! transfer fraction for number cannot be less than that of volume xferfrac_num = max( xferfrac_num, xferfrac_vol ) xferfrac_num = min( xferfrac_max, xferfrac_num ) @@ -1405,58 +1402,70 @@ subroutine modal_aero_rename_acc_crs_init ! define "from mode" and "to mode" for each tail-xfer pairing ! using the values in ipair_select_renamexf(:) ! - npair_renamexf = 0 - do ipair = 1, maxpair_renamexf - itmpa = ipair_select_renamexf(ipair) - if (itmpa == 0) then - exit - else if (itmpa == 2001) then - mfrm = modeptr_aitken - mtoo = modeptr_accum - igrow_shrink_renamexf(ipair) = 1 - ixferable_all_needed_renamexf(ipair) = 1 - strat_only_renamexf(ipair) = .false. - else if (itmpa == 1003) then - mfrm = modeptr_accum - mtoo = modeptr_coarse - igrow_shrink_renamexf(ipair) = 1 - ixferable_all_needed_renamexf(ipair) = 0 - strat_only_renamexf(ipair) = .true. - else if (itmpa == 3001) then - mfrm = modeptr_coarse - mtoo = modeptr_accum - igrow_shrink_renamexf(ipair) = -1 - ixferable_all_needed_renamexf(ipair) = 0 - strat_only_renamexf(ipair) = .true. - else - write(lunout,'(/2a,3(1x,i12))') & - '*** subr. modal_aero_rename_acc_crs_init', & - 'bad ipair_select_renamexf', ipair, itmpa - call endrun( 'modal_aero_rename_acc_crs_init error' ) - end if - - do i = 1, ipair-1 - if (itmpa .eq. ipair_select_renamexf(i)) then - write(lunout,'(/2a/10(1x,i12))') & - '*** subr. modal_aero_rename_acc_crs_init', & - 'duplicates in ipair_select_renamexf', & - ipair_select_renamexf(1:ipair) - call endrun( 'modal_aero_rename_acc_crs_init error' ) - end if - end do - - if ( (mfrm .ge. 1) .and. (mfrm .le. ntot_amode) .and. & - (mtoo .ge. 1) .and. (mtoo .le. ntot_amode) ) then - npair_renamexf = ipair - modefrm_renamexf(ipair) = mfrm - modetoo_renamexf(ipair) = mtoo - else - write(lunout,'(/2a,3(1x,i12))') & - '*** subr. modal_aero_rename_acc_crs_init', & - 'bad mfrm or mtoo', ipair, mfrm, mtoo - call endrun( 'modal_aero_rename_acc_crs_init error' ) - end if - end do ! ipair + npair_renamexf = 0 + do ipair = 1, maxpair_renamexf + itmpa = ipair_select_renamexf(ipair) + if (itmpa == 0) then + exit + else if (itmpa == 2001) then !both mam4 and mam5 + mfrm = modeptr_aitken + mtoo = modeptr_accum + igrow_shrink_renamexf(ipair) = 1 + ixferable_all_needed_renamexf(ipair) = 1 + strat_only_renamexf(ipair) = .false. + else if (itmpa == 1003) then + mfrm = modeptr_accum + mtoo = modeptr_coarse + igrow_shrink_renamexf(ipair) = 1 + ixferable_all_needed_renamexf(ipair) = 0 + strat_only_renamexf(ipair) = .true. + else if (itmpa == 1005) then + mfrm = modeptr_accum + mtoo = modeptr_stracoar + igrow_shrink_renamexf(ipair) = 1 + ixferable_all_needed_renamexf(ipair) = 0 + strat_only_renamexf(ipair) = .true. + else if (itmpa == 3001) then + mfrm = modeptr_coarse + mtoo = modeptr_accum + igrow_shrink_renamexf(ipair) = -1 + ixferable_all_needed_renamexf(ipair) = 0 + strat_only_renamexf(ipair) = .true. + else if (itmpa == 5001) then + mfrm = modeptr_stracoar + mtoo = modeptr_accum + igrow_shrink_renamexf(ipair) = -1 + ixferable_all_needed_renamexf(ipair) = 0 + strat_only_renamexf(ipair) = .true. + else + write(lunout,'(/2a,3(1x,i12))') & + '*** subr. modal_aero_rename_acc_crs_init', & + 'bad ipair_select_renamexf', ipair, itmpa + call endrun( 'modal_aero_rename_acc_crs_init error' ) + end if + + do i = 1, ipair-1 + if (itmpa .eq. ipair_select_renamexf(i)) then + write(lunout,'(/2a/10(1x,i12))') & + '*** subr. modal_aero_rename_acc_crs_init', & + 'duplicates in ipair_select_renamexf', & + ipair_select_renamexf(1:ipair) + call endrun( 'modal_aero_rename_acc_crs_init error' ) + end if + end do + + if ( (mfrm .ge. 1) .and. (mfrm .le. ntot_amode) .and. & + (mtoo .ge. 1) .and. (mtoo .le. ntot_amode) ) then + npair_renamexf = ipair + modefrm_renamexf(ipair) = mfrm + modetoo_renamexf(ipair) = mtoo + else + write(lunout,'(/2a,3(1x,i12))') & + '*** subr. modal_aero_rename_acc_crs_init', & + 'bad mfrm or mtoo', ipair, mfrm, mtoo + call endrun( 'modal_aero_rename_acc_crs_init error' ) + end if + end do ! ipair if (npair_renamexf .le. 0) then write(lunout,'(/a/a,3(1x,i12))') & @@ -1631,31 +1640,32 @@ subroutine modal_aero_rename_acc_crs_init ! dryvol_smallest is a very small volume mixing ratio (m3-AP/kmol-air) ! used for avoiding overflow. it corresponds to dp = 1 nm ! and number = 1e-5 #/mg-air ~= 1e-5 #/cm3-air - dryvol_smallest(mfrm) = 1.0e-25_r8 - v2nlorlx(mfrm) = voltonumblo_amode(mfrm)*frelax - v2nhirlx(mfrm) = voltonumbhi_amode(mfrm)/frelax + dryvol_smallest(mfrm) = 1.0e-25_r8 + v2nlorlx(mfrm) = voltonumblo_amode(mfrm)*frelax + v2nhirlx(mfrm) = voltonumbhi_amode(mfrm)/frelax factor_3alnsg2(ipair) = 3.0_r8 * (alnsg_amode(mfrm)**2) - dp_cut(ipair) = sqrt( & - dgnum_amode(mfrm)*exp(1.5_r8*(alnsg_amode(mfrm)**2)) * & - dgnum_amode(mtoo)*exp(1.5_r8*(alnsg_amode(mtoo)**2)) ) + dp_cut(ipair) = sqrt( & + dgnum_amode(mfrm)*exp(1.5_r8*(alnsg_amode(mfrm)**2)) * & + dgnum_amode(mtoo)*exp(1.5_r8*(alnsg_amode(mtoo)**2)) ) dp_xferall_thresh(ipair) = dgnum_amode(mtoo) dp_xfernone_threshaa(ipair) = dgnum_amode(mfrm) - - if ((mfrm == modeptr_accum) .and. (mtoo == modeptr_coarse)) then - dp_cut(ipair) = 4.4e-7_r8 - dp_xfernone_threshaa(ipair) = 1.6e-7_r8 - dp_xferall_thresh(ipair) = 4.7e-7_r8 - else if ((mfrm == modeptr_coarse) .and. (mtoo == modeptr_accum)) then - dp_cut(ipair) = 4.4e-7_r8 - dp_xfernone_threshaa(ipair) = 4.4e-7_r8 - dp_xferall_thresh(ipair) = 4.1e-7_r8 - end if + if (((mfrm == modeptr_accum) .and. (mtoo == modeptr_coarse)).or.& + ((mfrm == modeptr_accum) .and. (mtoo == modeptr_stracoar))) then + dp_cut(ipair) = 4.4e-7_r8 + dp_xfernone_threshaa(ipair) = 1.6e-7_r8 + dp_xferall_thresh(ipair) = 4.7e-7_r8 + else if (((mfrm == modeptr_coarse) .and. (mtoo == modeptr_accum)).or.& + ((mfrm == modeptr_stracoar) .and. (mtoo == modeptr_accum))) then + dp_cut(ipair) = 4.4e-7_r8 + dp_xfernone_threshaa(ipair) = 4.4e-7_r8 + dp_xferall_thresh(ipair) = 4.1e-7_r8 + end if lndp_cut(ipair) = log( dp_cut(ipair) ) dp_belowcut(ipair) = 0.99_r8*dp_cut(ipair) - end do + end do ! diff --git a/src/chemistry/modal_aero/sox_cldaero_mod.F90 b/src/chemistry/modal_aero/sox_cldaero_mod.F90 index bacf94246c..2500aa37e5 100644 --- a/src/chemistry/modal_aero/sox_cldaero_mod.F90 +++ b/src/chemistry/modal_aero/sox_cldaero_mod.F90 @@ -13,7 +13,7 @@ module sox_cldaero_mod use modal_aero_data, only : cnst_name_cw, specmw_so4_amode use chem_mods, only : adv_mass use physconst, only : gravit - use phys_control, only : phys_getopts + use phys_control, only : phys_getopts, cam_chempkg_is use cldaero_mod, only : cldaero_uptakerate use chem_mods, only : gas_pcnst @@ -229,6 +229,12 @@ subroutine sox_cldaero_update( & dqdt_aqhprxn(:,:) = 0.0_r8 dqdt_aqo3rxn(:,:) = 0.0_r8 + ! Avoid double counting in-cloud sulfur oxidation when running with + ! GEOS-Chem. If running with GEOS-Chem then sulfur oxidation + ! is performed internally to GEOS-Chem. Here, we just return to the + ! parent routine and thus we do not apply tendencies calculated by MAM. + if ( cam_chempkg_is('geoschem_mam4') ) return + lev_loop: do k = 1,pver col_loop: do i = 1,ncol cloud: if (cldfrc(i,k) >= 1.0e-5_r8) then diff --git a/src/chemistry/mozart/charge_neutrality.F90 b/src/chemistry/mozart/charge_neutrality.F90 index 9ab13588f7..685ed8215b 100644 --- a/src/chemistry/mozart/charge_neutrality.F90 +++ b/src/chemistry/mozart/charge_neutrality.F90 @@ -87,7 +87,7 @@ end subroutine charge_fix_vmr subroutine charge_fix_mmr(state, pbuf) use constituents, only : cnst_get_ind - use physconst, only : mbarv ! Constituent dependent mbar + use air_composition, only : mbarv ! Constituent dependent mbar use short_lived_species, only : slvd_index,slvd_pbf_ndx => pbf_idx ! Routines to access short lived species in pbuf use chem_mods, only : adv_mass use physics_buffer, only : pbuf_get_field,physics_buffer_desc ! Needed to get variables from physics buffer diff --git a/src/chemistry/mozart/chemistry.F90 b/src/chemistry/mozart/chemistry.F90 index c315e1dabe..6527b0ccc1 100644 --- a/src/chemistry/mozart/chemistry.F90 +++ b/src/chemistry/mozart/chemistry.F90 @@ -14,14 +14,17 @@ module chemistry use spmd_utils, only : masterproc use cam_logfile, only : iulog use mo_gas_phase_chemdr, only : map2chm - use shr_megan_mod, only : shr_megan_mechcomps, shr_megan_mechcomps_n + use shr_megan_mod, only : shr_megan_mechcomps, shr_megan_mechcomps_n use srf_field_check, only : active_Fall_flxvoc use tracer_data, only : MAXTRCRS use gcr_ionization, only : gcr_ionization_readnl, gcr_ionization_init, gcr_ionization_adv use epp_ionization, only : epp_ionization_readnl, epp_ionization_adv + use mee_ionization, only : mee_ion_readnl use mo_apex, only : mo_apex_readnl use ref_pres, only : ptop_ref use phys_control, only : waccmx_is ! WACCM-X switch query function + use phys_control, only : use_hemco ! HEMCO switch logical + use mo_chm_diags, only : chem_has_ndep_flx => chm_prod_ndep_flx implicit none private @@ -32,7 +35,7 @@ module chemistry !--------------------------------------------------------------------------------- public :: chem_is ! identify which chemistry is being used public :: chem_register ! register consituents - public :: chem_readnl ! read chem namelist + public :: chem_readnl ! read chem namelist public :: chem_is_active ! returns true public :: chem_implements_cnst ! returns true if consituent is implemented by this package public :: chem_init_cnst ! initialize mixing ratios if not read from initial file @@ -44,13 +47,14 @@ module chemistry public :: chem_read_restart public :: chem_init_restart public :: chem_emissions + public :: chem_has_ndep_flx integer, public :: imozart = -1 ! index of 1st constituent - + ! Namelist variables - + ! control - + integer :: chem_freq = 1 ! time steps ! ghg @@ -58,36 +62,30 @@ module chemistry character(len=shr_kind_cl) :: bndtvg = ' ' ! pathname for greenhouse gas loss rate character(len=shr_kind_cl) :: h2orates = ' ' ! pathname for greenhouse gas (lyman-alpha H2O loss) - ! lightning - - real(r8) :: lght_no_prd_factor = 1._r8 - ! photolysis - logical :: xactive_prates = .false. character(len=shr_kind_cl) :: rsf_file = 'rsf_file' character(len=shr_kind_cl) :: exo_coldens_file = '' - character(len=shr_kind_cl) :: tuv_xsect_file = 'tuv_xsect_file' - character(len=shr_kind_cl) :: o2_xsect_file = 'o2_xsect_file' character(len=shr_kind_cl) :: xs_coef_file = 'xs_coef_file' character(len=shr_kind_cl) :: xs_short_file = 'xs_short_file' character(len=shr_kind_cl) :: xs_long_file = 'xs_long_file' character(len=shr_kind_cl) :: electron_file = 'electron_file' character(len=shr_kind_cl) :: euvac_file = 'NONE' + real(r8) :: photo_max_zen=-huge(1._r8) ! solar / geomag data character(len=shr_kind_cl) :: photon_file = 'photon_file' ! dry dep - + character(len=shr_kind_cl) :: depvel_lnd_file = 'depvel_lnd_file' ! emis - + integer, parameter :: max_num_emis_files = max(100,2*pcnst) character(len=shr_kind_cl) :: airpl_emis_file = '' ! airplane emissions - character(len=shr_kind_cl) :: srf_emis_specifier(pcnst) = '' - character(len=shr_kind_cl) :: ext_frc_specifier(pcnst) = '' + character(len=shr_kind_cl) :: srf_emis_specifier(max_num_emis_files) = '' + character(len=shr_kind_cl) :: ext_frc_specifier(max_num_emis_files) = '' character(len=24) :: srf_emis_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS' integer :: srf_emis_cycle_yr = 0 @@ -100,7 +98,7 @@ module chemistry integer :: ext_frc_fixed_tod = 0 ! fixed stratosphere - + character(len=shr_kind_cl) :: fstrat_file = 'fstrat_file' character(len=16) :: fstrat_list(pcnst) = '' @@ -111,7 +109,7 @@ module chemistry character(len=fieldname_len) :: srcnam(gas_pcnst) ! names of source/sink tendencies - integer :: ixcldliq, ixcldice ! indicies of liquid and ice cloud water + integer :: ixcldliq ! index of liquid cloud water integer :: ndx_cld integer :: ndx_cmfdqr integer :: ndx_nevapr @@ -128,13 +126,16 @@ module chemistry character(len=32) :: chem_name = 'NONE' logical :: chem_rad_passive = .false. - + ! for MEGAN emissions - integer, allocatable :: megan_indices_map(:) + integer, allocatable :: megan_indices_map(:) real(r8),allocatable :: megan_wght_factors(:) logical :: chem_use_chemtrop = .false. + integer :: srf_ozone_pbf_ndx = -1 + logical :: srf_emis_diag(pcnst) = .false. + !================================================================================================ contains !================================================================================================ @@ -150,21 +151,23 @@ end function chem_is !================================================================================================ subroutine chem_register -!----------------------------------------------------------------------- -! +!----------------------------------------------------------------------- +! ! Purpose: register advected constituents and physics buffer fields -! +! !----------------------------------------------------------------------- use mo_sim_dat, only : set_sim_dat use chem_mods, only : gas_pcnst, adv_mass use mo_tracname, only : solsym - use mo_chem_utls, only : get_spc_ndx + use mo_chem_utls, only : get_spc_ndx, get_inv_ndx use short_lived_species, only : slvd_index, short_lived_map=>map, register_short_lived_species use cfc11star, only : register_cfc11star use mo_photo, only : photo_register use mo_aurora, only : aurora_register use aero_model, only : aero_model_register + use physics_buffer, only : pbuf_add_field, dtype_r8 + use upper_bc, only : ubc_fixed_conc implicit none @@ -176,7 +179,7 @@ subroutine chem_register logical :: ic_from_cam2 ! wrk variable for initial cond input logical :: has_fixed_ubc ! wrk variable for upper bndy cond logical :: has_fixed_ubflx ! wrk variable for upper bndy flux - integer :: ch4_ndx, n2o_ndx, o3_ndx + integer :: ch4_ndx, n2o_ndx, o3_ndx, o3_inv_ndx, ndx integer :: cfc11_ndx, cfc12_ndx, o2_1s_ndx, o2_1d_ndx, o2_ndx integer :: n_ndx, no_ndx, h_ndx, h2_ndx, o_ndx, e_ndx, np_ndx integer :: op_ndx, o1d_ndx, n2d_ndx, nop_ndx, n2p_ndx, o2p_ndx @@ -194,6 +197,7 @@ subroutine chem_register call set_sim_dat o3_ndx = get_spc_ndx('O3') + o3_inv_ndx= get_inv_ndx('O3') ch4_ndx = get_spc_ndx('CH4') n2o_ndx = get_spc_ndx('N2O') @@ -220,35 +224,33 @@ subroutine chem_register f_ndx = get_spc_ndx('F') hf_ndx = get_spc_ndx('HF') + if (o3_ndx>0 .or. o3_inv_ndx>0) then + call pbuf_add_field('SRFOZONE','global',dtype_r8,(/pcols/),srf_ozone_pbf_ndx) + endif !----------------------------------------------------------------------- ! Set names of diffused variable tendencies and declare them as history variables !----------------------------------------------------------------------- !---------------------------------------------------------------------------------- ! For WACCM-X, change variable has_fixed_ubc from .true. to .false. which is a flag - ! used later to check for a fixed upper boundary condition for species. + ! used later to check for a fixed upper boundary condition for species. !---------------------------------------------------------------------------------- do m = 1,gas_pcnst ! setting of these variables is for registration of transported species ic_from_cam2 = .true. - has_fixed_ubc = .false. + has_fixed_ubc = ubc_fixed_conc(solsym(m)) has_fixed_ubflx = .false. lng_name = trim( solsym(m) ) molectype = 'minor' qmin = 1.e-36_r8 - + if ( lng_name(1:5) .eq. 'num_a' ) then ! aerosol number density qmin = 1.e-5_r8 else if ( m == o3_ndx ) then qmin = 1.e-12_r8 else if ( m == ch4_ndx ) then qmin = 1.e-12_r8 - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - has_fixed_ubc = .false. ! diffusive equilibrium at UB - else - has_fixed_ubc = .true. - endif else if ( m == n2o_ndx ) then qmin = 1.e-15_r8 else if( m == cfc11_ndx .or. m == cfc12_ndx ) then @@ -260,14 +262,10 @@ subroutine chem_register else lng_name = 'O2(1-sigma)' end if - else if ( m==o2_ndx .or. m==n_ndx .or. m==no_ndx .or. m==h_ndx .or. m==h2_ndx .or. m==o_ndx .or. m==hf_ndx & - .or. m==f_ndx ) then - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - has_fixed_ubc = .false. ! diffusive equilibrium at UB + else if ( m==o2_ndx .or. m==o_ndx .or. m==h_ndx ) then + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then if ( m == h_ndx ) has_fixed_ubflx = .true. ! fixed flux value for H at UB if ( m == o2_ndx .or. m == o_ndx ) molectype = 'major' - else - has_fixed_ubc = .true. endif else if( m == e_ndx ) then lng_name = 'electron concentration' @@ -310,22 +308,22 @@ subroutine chem_register endif end do - + call register_short_lived_species() call register_cfc11star() - if ( waccmx_is('ionosphere') ) then + if ( waccmx_is('ionosphere') ) then call photo_register() call aurora_register() endif - + ! add fields to pbuf needed by aerosol models call aero_model_register() end subroutine chem_register !================================================================================================ - + subroutine chem_readnl(nlfile) ! Read chem namelist group. @@ -340,9 +338,7 @@ subroutine chem_readnl(nlfile) use aero_model, only: aero_model_readnl use dust_model, only: dust_readnl use gas_wetdep_opts, only: gas_wetdep_readnl - use upper_bc, only: ubc_defaultopts, ubc_setopts use mo_drydep, only: drydep_srf_file - use noy_ubc, only: noy_ubc_readnl use mo_sulf, only: sulf_readnl use species_sums_diags,only: species_sums_readnl use ocean_emis, only: ocean_emis_readnl @@ -357,9 +353,9 @@ subroutine chem_readnl(nlfile) ! trop_mozart prescribed constituent concentratons character(len=shr_kind_cl) :: tracer_cnst_file ! prescribed data file character(len=shr_kind_cl) :: tracer_cnst_filelist ! list of prescribed data files (series of files) - character(len=shr_kind_cl) :: tracer_cnst_datapath ! absolute path of prescribed data files + character(len=shr_kind_cl) :: tracer_cnst_datapath ! absolute path of prescribed data files character(len=24) :: tracer_cnst_type ! 'INTERP_MISSING_MONTHS' | 'CYCLICAL' | 'SERIAL' (default) - character(len=shr_kind_cl) :: tracer_cnst_specifier(MAXTRCRS) ! string array where each + character(len=shr_kind_cl) :: tracer_cnst_specifier(MAXTRCRS) ! string array where each logical :: tracer_cnst_rmfile ! remove data file from local disk (default .false.) integer :: tracer_cnst_cycle_yr integer :: tracer_cnst_fixed_ymd @@ -368,31 +364,19 @@ subroutine chem_readnl(nlfile) ! trop_mozart prescribed constituent sourrces/sinks character(len=shr_kind_cl) :: tracer_srcs_file ! prescribed data file character(len=shr_kind_cl) :: tracer_srcs_filelist ! list of prescribed data files (series of files) - character(len=shr_kind_cl) :: tracer_srcs_datapath ! absolute path of prescribed data files + character(len=shr_kind_cl) :: tracer_srcs_datapath ! absolute path of prescribed data files character(len=24) :: tracer_srcs_type ! 'INTERP_MISSING_MONTHS' | 'CYCLICAL' | 'SERIAL' (default) - character(len=shr_kind_cl) :: tracer_srcs_specifier(MAXTRCRS) ! string array where each + character(len=shr_kind_cl) :: tracer_srcs_specifier(MAXTRCRS) ! string array where each logical :: tracer_srcs_rmfile ! remove data file from local disk (default .false.) integer :: tracer_srcs_cycle_yr integer :: tracer_srcs_fixed_ymd integer :: tracer_srcs_fixed_tod - ! Upper boundary conditions - character(len=shr_kind_cl) :: tgcm_ubc_file - integer :: tgcm_ubc_cycle_yr - integer :: tgcm_ubc_fixed_ymd - integer :: tgcm_ubc_fixed_tod - character(len=32) :: tgcm_ubc_data_type - character(len=shr_kind_cl) :: snoe_ubc_file - ! Upper boundary conditions - real(r8) :: t_pert_ubc ! temperature perturbation at ubc - real(r8) :: no_xfac_ubc ! no multiplicative factor at ubc - namelist /chem_inparm/ chem_freq, airpl_emis_file, & euvac_file, photon_file, electron_file, & xs_coef_file, xs_short_file, & - exo_coldens_file, tuv_xsect_file, o2_xsect_file, & - xs_long_file, rsf_file, & - lght_no_prd_factor, xactive_prates, & + exo_coldens_file, & + xs_long_file, rsf_file, photo_max_zen, & depvel_lnd_file, drydep_srf_file, & srf_emis_type, srf_emis_cycle_yr, srf_emis_fixed_ymd, srf_emis_fixed_tod, srf_emis_specifier, & fstrat_file, fstrat_list, & @@ -412,11 +396,7 @@ subroutine chem_readnl(nlfile) tracer_srcs_file, tracer_srcs_filelist, tracer_srcs_datapath, & tracer_srcs_type, tracer_srcs_specifier, & tracer_cnst_rmfile, tracer_cnst_cycle_yr, tracer_cnst_fixed_ymd, tracer_cnst_fixed_tod, & - tracer_srcs_rmfile, tracer_srcs_cycle_yr, tracer_srcs_fixed_ymd, tracer_srcs_fixed_tod - - ! upper boundary conditions - namelist /chem_inparm/ tgcm_ubc_file, tgcm_ubc_data_type, tgcm_ubc_cycle_yr, tgcm_ubc_fixed_ymd, tgcm_ubc_fixed_tod, & - snoe_ubc_file, t_pert_ubc, no_xfac_ubc + tracer_srcs_rmfile, tracer_srcs_cycle_yr, tracer_srcs_fixed_ymd, tracer_srcs_fixed_tod ! tropopause level control namelist /chem_inparm/ chem_use_chemtrop @@ -432,7 +412,7 @@ subroutine chem_readnl(nlfile) tracer_cnst_rmfile_out = tracer_cnst_rmfile, & tracer_cnst_cycle_yr_out = tracer_cnst_cycle_yr, & tracer_cnst_fixed_ymd_out = tracer_cnst_fixed_ymd, & - tracer_cnst_fixed_tod_out = tracer_cnst_fixed_tod ) + tracer_cnst_fixed_tod_out = tracer_cnst_fixed_tod ) call tracer_srcs_defaultopts( & tracer_srcs_file_out = tracer_srcs_file, & tracer_srcs_filelist_out = tracer_srcs_filelist, & @@ -444,16 +424,7 @@ subroutine chem_readnl(nlfile) tracer_srcs_fixed_ymd_out = tracer_srcs_fixed_ymd, & tracer_srcs_fixed_tod_out = tracer_srcs_fixed_tod ) - ! Upper boundary conditions - call ubc_defaultopts( & - snoe_ubc_file_out =snoe_ubc_file, & - t_pert_ubc_out =t_pert_ubc, & - no_xfac_ubc_out =no_xfac_ubc, & - tgcm_ubc_file_out = tgcm_ubc_file, & - tgcm_ubc_data_type_out = tgcm_ubc_data_type, & - tgcm_ubc_cycle_yr_out = tgcm_ubc_cycle_yr, & - tgcm_ubc_fixed_ymd_out = tgcm_ubc_fixed_ymd, & - tgcm_ubc_fixed_tod_out = tgcm_ubc_fixed_tod ) + drydep_srf_file = ' ' if (masterproc) then unitn = getunit() @@ -484,20 +455,14 @@ subroutine chem_readnl(nlfile) call mpibcast (bndtvg, len(bndtvg), mpichar, 0, mpicom) call mpibcast (h2orates, len(h2orates), mpichar, 0, mpicom) - ! lightning - - call mpibcast (lght_no_prd_factor,1, mpir8, 0, mpicom) - ! photolysis call mpibcast (rsf_file, len(rsf_file), mpichar, 0, mpicom) call mpibcast (exo_coldens_file, len(exo_coldens_file), mpichar, 0, mpicom) - call mpibcast (tuv_xsect_file, len(tuv_xsect_file), mpichar, 0, mpicom) - call mpibcast (o2_xsect_file, len(o2_xsect_file), mpichar, 0, mpicom) call mpibcast (xs_coef_file, len(xs_coef_file), mpichar, 0, mpicom) call mpibcast (xs_short_file, len(xs_short_file), mpichar, 0, mpicom) call mpibcast (xs_long_file, len(xs_long_file), mpichar, 0, mpicom) - call mpibcast (xactive_prates, 1, mpilog, 0, mpicom) + call mpibcast (photo_max_zen, 1, mpir8, 0, mpicom) call mpibcast (electron_file, len(electron_file), mpichar, 0, mpicom) call mpibcast (euvac_file, len(euvac_file), mpichar, 0, mpicom) @@ -530,17 +495,6 @@ subroutine chem_readnl(nlfile) call mpibcast (fstrat_file, len(fstrat_file), mpichar, 0, mpicom) call mpibcast (fstrat_list, len(fstrat_list(1))*pcnst, mpichar, 0, mpicom) - ! upper boundary - call mpibcast (tgcm_ubc_file, len(tgcm_ubc_file), mpichar, 0, mpicom) - call mpibcast (tgcm_ubc_data_type, len(tgcm_ubc_data_type),mpichar, 0, mpicom) - call mpibcast (tgcm_ubc_cycle_yr, 1, mpiint, 0, mpicom) - call mpibcast (tgcm_ubc_fixed_ymd, 1, mpiint, 0, mpicom) - call mpibcast (tgcm_ubc_fixed_tod, 1, mpiint, 0, mpicom) - - call mpibcast (snoe_ubc_file, len(snoe_ubc_file), mpichar, 0, mpicom) - call mpibcast (t_pert_ubc, 1, mpir8, 0, mpicom) - call mpibcast (no_xfac_ubc, 1, mpir8, 0, mpicom) - ! prescribed chemical tracers call mpibcast (tracer_cnst_specifier, len(tracer_cnst_specifier(1))*MAXTRCRS, mpichar, 0, mpicom) @@ -590,25 +544,14 @@ subroutine chem_readnl(nlfile) tracer_srcs_fixed_ymd_in = tracer_srcs_fixed_ymd, & tracer_srcs_fixed_tod_in = tracer_srcs_fixed_tod ) - ! Upper boundary conditions - call ubc_setopts( & - snoe_ubc_file_in =snoe_ubc_file, & - t_pert_ubc_in =t_pert_ubc, & - no_xfac_ubc_in =no_xfac_ubc, & - tgcm_ubc_file_in =tgcm_ubc_file, & - tgcm_ubc_data_type_in = tgcm_ubc_data_type, & - tgcm_ubc_cycle_yr_in = tgcm_ubc_cycle_yr, & - tgcm_ubc_fixed_ymd_in = tgcm_ubc_fixed_ymd, & - tgcm_ubc_fixed_tod_in = tgcm_ubc_fixed_tod ) - call aero_model_readnl(nlfile) - call dust_readnl(nlfile) + call dust_readnl(nlfile) ! call gas_wetdep_readnl(nlfile) call gcr_ionization_readnl(nlfile) call epp_ionization_readnl(nlfile) + call mee_ion_readnl(nlfile) call mo_apex_readnl(nlfile) - call noy_ubc_readnl(nlfile) call sulf_readnl(nlfile) call species_sums_readnl(nlfile) call ocean_emis_readnl(nlfile) @@ -618,7 +561,7 @@ end subroutine chem_readnl !================================================================================================ function chem_is_active() -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Purpose: return true if this package is active !----------------------------------------------------------------------- logical :: chem_is_active @@ -629,12 +572,12 @@ end function chem_is_active !================================================================================================ function chem_implements_cnst(name) -!----------------------------------------------------------------------- -! +!----------------------------------------------------------------------- +! ! Purpose: return true if specified constituent is implemented by this package -! +! ! Author: B. Eaton -! +! !----------------------------------------------------------------------- use chem_mods, only : gas_pcnst, inv_lst, nfs use mo_tracname, only : solsym @@ -648,7 +591,7 @@ function chem_implements_cnst(name) ! ... local variables !----------------------------------------------------------------------- integer :: m - + chem_implements_cnst = .false. do m = 1,gas_pcnst if( trim(name) /= 'H2O' ) then @@ -671,60 +614,62 @@ end function chem_implements_cnst subroutine chem_init(phys_state, pbuf2d) -!----------------------------------------------------------------------- -! +!----------------------------------------------------------------------- +! ! Purpose: initialize parameterized greenhouse gas chemistry ! (declare history variables) -! -! Method: -! -! -! +! +! Method: +! +! +! ! Author: NCAR CMS -! +! !----------------------------------------------------------------------- - use physics_buffer, only : physics_buffer_desc, pbuf_get_index - + use physics_buffer, only : physics_buffer_desc, pbuf_get_index, pbuf_set_field + use time_manager, only : is_first_step use constituents, only : cnst_get_ind use cam_history, only : addfld, add_default, horiz_only, fieldname_len use chem_mods, only : gas_pcnst use mo_chemini, only : chemini use mo_ghg_chem, only : ghg_chem_init use mo_tracname, only : solsym - use cfc11star, only : init_cfc11star - use phys_control, only : phys_getopts - use chem_mods, only : adv_mass - use infnan, only : nan, assignment(=) - use mo_chem_utls, only : get_spc_ndx - use cam_abortutils, only : endrun - use aero_model, only : aero_model_init - use mo_setsox, only : sox_inti - use constituents, only : sflxnam - use noy_ubc, only : noy_ubc_init + use cfc11star, only : init_cfc11star + use phys_control, only : phys_getopts + use chem_mods, only : adv_mass + use infnan, only : nan, assignment(=) + use mo_chem_utls, only : get_spc_ndx + use cam_abortutils, only : endrun + use aero_model, only : aero_model_init + use mo_setsox, only : sox_inti + use constituents, only : sflxnam use fire_emissions, only : fire_emissions_init use short_lived_species, only : short_lived_species_initic - use ocean_emis, only : ocean_emis_init - + use ocean_emis, only : ocean_emis_init, ocean_emis_species + use mo_srf_emissions, only : has_emis + type(physics_buffer_desc), pointer :: pbuf2d(:,:) type(physics_state), intent(in):: phys_state(begchunk:endchunk) - + !----------------------------------------------------------------------- ! Local variables !----------------------------------------------------------------------- integer :: m ! tracer indicies character(len=fieldname_len) :: spc_name - integer :: n, ii + integer :: n, ii, ierr logical :: history_aerosol logical :: history_chemistry logical :: history_cesm_forcing - character(len=2) :: unit_basename ! Units 'kg' or '1' + character(len=2) :: unit_basename ! Units 'kg' or '1' logical :: history_budget ! output tendencies and state variables for CAM ! temperature, water vapor, cloud ice and cloud ! liquid budgets. integer :: history_budget_histfile_num ! output history file number for budget fields + character(len=*), parameter :: prefix = 'chem_init: ' + call phys_getopts( cam_chempkg_out=chem_name, & history_aerosol_out=history_aerosol , & history_chemistry_out=history_chemistry , & @@ -742,7 +687,6 @@ subroutine chem_init(phys_state, pbuf2d) ! Get liq and ice cloud water indicies !----------------------------------------------------------------------- call cnst_get_ind( 'CLDLIQ', ixcldliq ) - call cnst_get_ind( 'CLDICE', ixcldice ) call cnst_get_ind( 'NUMLIQ', ixndrop, abort=.false. ) !----------------------------------------------------------------------- @@ -759,58 +703,6 @@ subroutine chem_init(phys_state, pbuf2d) call addfld( 'HEIGHT', (/ 'ilev' /),'A','m', 'geopotential height above surface at interfaces (m)' ) call addfld( 'CT_H2O_GHG', (/ 'lev' /), 'A','kg/kg/s', 'ghg-chem h2o source/sink' ) -!----------------------------------------------------------------------- -! Set names of chemistry variable tendencies and declare them as history variables -!----------------------------------------------------------------------- - do m = 1,gas_pcnst - spc_name = solsym(m) - srcnam(m) = 'CT_' // spc_name ! chem tendancy (source/sink) - - call addfld( srcnam(m), (/ 'lev' /), 'A', 'kg/kg/s', trim(spc_name)//' source/sink' ) - call cnst_get_ind(solsym(m), n, abort=.false. ) - if ( n > 0 ) then - - if (sflxnam(n)(3:5) == 'num') then ! name is in the form of "SF****" - unit_basename = ' 1' - else - unit_basename = 'kg' - endif - - call addfld (sflxnam(n),horiz_only, 'A', unit_basename//'/m2/s',trim(solsym(m))//' surface flux') - if ( history_aerosol .or. history_chemistry ) then - call add_default( sflxnam(n), 1, ' ' ) - endif - - if ( history_cesm_forcing ) then - if ( spc_name == 'NO' .or. spc_name == 'NH3' ) then - call add_default( sflxnam(n), 1, ' ' ) - endif - endif - - endif - end do - - ! Add chemical tendency of water vapor to water budget output - if ( history_budget ) then - call add_default ('CT_H2O' , history_budget_histfile_num, ' ') - endif - - !----------------------------------------------------------------------- - ! BAB: 2004-09-01 kludge to define a fixed ubc for water vapor - ! required because water vapor is not declared by chemistry but - ! has a fixed ubc only if WACCM chemistry is running. - !----------------------------------------------------------------------- - ! this is moved out of chem_register because we need to know where (what pressure) - ! the upper boundary is to determine if this is a high top configuration -- after - ! initialization of ref_pres ... - if ( 1.e-2_r8 >= ptop_ref .and. ptop_ref > 1.e-5_r8 ) then ! around waccm top, below top of waccmx - cnst_fixed_ubc(1) = .true. - else if ( 1.e1_r8 > ptop_ref .and. ptop_ref > 1.e-2_r8 ) then ! well above top of cam and below top of waccm - call endrun('chem_init: do not know how to set water vapor upper boundary when model top is near mesopause') - endif - - if ( masterproc ) write(iulog,*) 'chem_init: addfld done' - !----------------------------------------------------------------------- ! Initialize chemistry modules !----------------------------------------------------------------------- @@ -823,6 +715,7 @@ subroutine chem_init(phys_state, pbuf2d) , xs_coef_file & , xs_short_file & , xs_long_file & + , photo_max_zen & , rsf_file & , fstrat_file & , fstrat_list & @@ -836,69 +729,130 @@ subroutine chem_init(phys_state, pbuf2d) , ext_frc_cycle_yr & , ext_frc_fixed_ymd & , ext_frc_fixed_tod & - , xactive_prates & , exo_coldens_file & - , tuv_xsect_file & - , o2_xsect_file & - , lght_no_prd_factor & + , use_hemco & , pbuf2d & ) - if ( ghg_chem ) then - call ghg_chem_init(phys_state, bndtvg, h2orates) - endif - - call init_cfc11star(pbuf2d) - - ! MEGAN emissions initialize - if (shr_megan_mechcomps_n>0) then - - allocate( megan_indices_map(shr_megan_mechcomps_n) ) - allocate( megan_wght_factors(shr_megan_mechcomps_n) ) - megan_wght_factors(:) = nan - - do n=1,shr_megan_mechcomps_n - call cnst_get_ind (shr_megan_mechcomps(n)%name, megan_indices_map(n), abort=.false.) - ii = get_spc_ndx(shr_megan_mechcomps(n)%name) - if (ii>0) then - megan_wght_factors(n) = adv_mass(ii)*1.e-3_r8 ! kg/moles (to convert moles/m2/sec to kg/m2/sec) - else - call endrun( 'gas_phase_chemdr_inti: MEGAN compound not in chemistry mechanism : '& - //trim(shr_megan_mechcomps(n)%name)) - endif - - ! MEGAN history fields - call addfld( 'MEG_'//trim(shr_megan_mechcomps(n)%name),horiz_only,'A','kg/m2/sec',& - trim(shr_megan_mechcomps(n)%name)//' MEGAN emissions flux') - if (history_chemistry) then - call add_default('MEG_'//trim(shr_megan_mechcomps(n)%name), 1, ' ') - endif - - enddo - endif - - call noy_ubc_init() - - ! Galatic Cosmic Rays ... - call gcr_ionization_init() - - ! Fire emissions ... - call fire_emissions_init() - - call short_lived_species_initic() - - call ocean_emis_init() - + if ( ghg_chem ) then + call ghg_chem_init(phys_state, bndtvg, h2orates) + endif + + call init_cfc11star(pbuf2d) + + ! MEGAN emissions initialize + if (shr_megan_mechcomps_n>0) then + + allocate( megan_indices_map(shr_megan_mechcomps_n), stat=ierr) + if( ierr /= 0 ) then + call endrun(prefix//'failed to allocate megan_indices_map') + end if + allocate( megan_wght_factors(shr_megan_mechcomps_n), stat=ierr) + if( ierr /= 0 ) then + call endrun(prefix//'failed to allocate megan_indices_map') + end if + megan_wght_factors(:) = nan + + do n=1,shr_megan_mechcomps_n + call cnst_get_ind (shr_megan_mechcomps(n)%name, megan_indices_map(n), abort=.false.) + ii = get_spc_ndx(shr_megan_mechcomps(n)%name) + if (ii>0) then + megan_wght_factors(n) = adv_mass(ii)*1.e-3_r8 ! kg/moles (to convert moles/m2/sec to kg/m2/sec) + else + call endrun( 'gas_phase_chemdr_inti: MEGAN compound not in chemistry mechanism : '& + //trim(shr_megan_mechcomps(n)%name)) + endif + + ! MEGAN history fields + call addfld( 'MEG_'//trim(shr_megan_mechcomps(n)%name),horiz_only,'A','kg/m2/sec',& + trim(shr_megan_mechcomps(n)%name)//' MEGAN emissions flux') + if (history_chemistry) then + call add_default('MEG_'//trim(shr_megan_mechcomps(n)%name), 1, ' ') + endif + + srf_emis_diag(megan_indices_map(n)) = .true. + enddo + endif + + ! Galatic Cosmic Rays ... + call gcr_ionization_init() + + ! Fire emissions ... + call fire_emissions_init() + + call short_lived_species_initic() + + call ocean_emis_init() + + !----------------------------------------------------------------------- + ! Set names of chemistry variable tendencies and declare them as history variables + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + spc_name = solsym(m) + srcnam(m) = 'CT_' // spc_name ! chem tendancy (source/sink) + + call addfld( srcnam(m), (/ 'lev' /), 'A', 'kg/kg/s', trim(spc_name)//' source/sink' ) + call cnst_get_ind(solsym(m), n, abort=.false.) + + if ( n>0 ) then + if (has_emis(m) .or. aero_has_emis(solsym(m)) .or. ocean_emis_species(solsym(m)) .or. srf_emis_diag(n)) then + srf_emis_diag(n) = .true. + + if (sflxnam(n)(3:5) == 'num') then ! name is in the form of "SF****" + unit_basename = ' 1' + else + unit_basename = 'kg' + endif + + call addfld (sflxnam(n),horiz_only, 'A', unit_basename//'/m2/s',trim(solsym(m))//' surface flux') + if ( history_aerosol .or. history_chemistry ) then + call add_default( sflxnam(n), 1, ' ' ) + endif + + if ( history_cesm_forcing ) then + if ( spc_name == 'NO' .or. spc_name == 'NH3' ) then + call add_default( sflxnam(n), 1, ' ' ) + endif + endif + + endif + endif + end do + + ! Add chemical tendency of water vapor to water budget output + if ( history_budget ) then + call add_default ('CT_H2O' , history_budget_histfile_num, ' ') + endif + + ! initialize srf ozone to zero + if (is_first_step() .and. srf_ozone_pbf_ndx>0) then + call pbuf_set_field(pbuf2d, srf_ozone_pbf_ndx, 0._r8) + end if + + contains + + pure logical function aero_has_emis(spcname) + use seasalt_model, only: seasalt_names + use dust_model, only: dust_names + + character(len=*),intent(in) :: spcname + + aero_has_emis = any(seasalt_names(:) == spcname).or.any(dust_names(:) == spcname) + + end function aero_has_emis + end subroutine chem_init !================================================================================ !================================================================================ - subroutine chem_emissions( state, cam_in ) + subroutine chem_emissions( state, cam_in, pbuf ) + use physics_buffer, only: physics_buffer_desc use aero_model, only: aero_model_emissions - use camsrfexch, only: cam_in_t + use camsrfexch, only: cam_in_t use constituents, only: sflxnam use cam_history, only: outfld use mo_srf_emissions, only: set_srf_emissions + use hco_cc_emissions, only: hco_set_srf_emissions use fire_emissions, only: fire_emissions_srf use ocean_emis, only: ocean_emis_getflux @@ -906,32 +860,33 @@ subroutine chem_emissions( state, cam_in ) type(physics_state), intent(in) :: state ! Physics state variables type(cam_in_t), intent(inout) :: cam_in ! import state + type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer in chunk, for HEMCO ! local vars integer :: lchnk, ncol - integer :: i, m,n + integer :: i, m,n real(r8) :: sflx(pcols,gas_pcnst) real(r8) :: megflx(pcols) lchnk = state%lchnk ncol = state%ncol - + ! initialize chemistry constituent surface fluxes to zero do m = 2,pcnst n = map2chm(m) - if (n>0) cam_in%cflx(:,m) = 0._r8 + if (n>0) cam_in%cflx(:,m) = 0._r8 enddo ! aerosol emissions ... call aero_model_emissions( state, cam_in ) ! MEGAN emissions ... - + if ( active_Fall_flxvoc .and. shr_megan_mechcomps_n>0 ) then - ! set MEGAN fluxes + ! set MEGAN fluxes do n = 1,shr_megan_mechcomps_n do i =1,ncol megflx(i) = -cam_in%meganflx(i,n) * megan_wght_factors(n) @@ -944,18 +899,29 @@ subroutine chem_emissions( state, cam_in ) endif - ! prescribed emissions from file ... + if ( use_hemco ) then + ! prescribed emissions from HEMCO ... - !----------------------------------------------------------------------- - ! ... Set surface emissions - !----------------------------------------------------------------------- - call set_srf_emissions( lchnk, ncol, sflx(:,:) ) + !----------------------------------------------------------------------- + ! ... Set surface emissions using HEMCO compatibility API + !----------------------------------------------------------------------- + call hco_set_srf_emissions( lchnk, ncol, sflx(:,:), pbuf ) + else + ! prescribed emissions from file ... + + !----------------------------------------------------------------------- + ! ... Set surface emissions + !----------------------------------------------------------------------- + call set_srf_emissions( lchnk, ncol, sflx(:,:) ) + endif do m = 1,pcnst n = map2chm(m) if ( n /= h2o_ndx .and. n > 0 ) then cam_in%cflx(:ncol,m) = cam_in%cflx(:ncol,m) + sflx(:ncol,n) - call outfld( sflxnam(m), cam_in%cflx(:ncol,m), ncol,lchnk ) + if (srf_emis_diag(m)) then + call outfld( sflxnam(m), cam_in%cflx(:ncol,m), ncol,lchnk ) + endif endif enddo @@ -970,11 +936,11 @@ end subroutine chem_emissions !================================================================================ subroutine chem_init_cnst( name, latvals, lonvals, mask, q) -!----------------------------------------------------------------------- -! -! Purpose: +!----------------------------------------------------------------------- +! +! Purpose: ! Specify initial mass mixing ratios -! +! !----------------------------------------------------------------------- use chem_mods, only : inv_lst @@ -996,7 +962,7 @@ subroutine chem_init_cnst( name, latvals, lonvals, mask, q) !----------------------------------------------------------------------- ! Local variables !----------------------------------------------------------------------- - + real(r8) :: rmwn2o != mwn2o/mwdry ! ratio of mol weight n2o to dry air real(r8) :: rmwch4 != mwch4/mwdry ! ratio of mol weight ch4 to dry air real(r8) :: rmwf11 != mwf11/mwdry ! ratio of mol weight cfc11 to dry air @@ -1007,10 +973,10 @@ subroutine chem_init_cnst( name, latvals, lonvals, mask, q) ! initialize local variables !----------------------------------------------------------------------- - rmwn2o = mwn2o/mwdry - rmwch4 = mwch4/mwdry - rmwf11 = mwf11/mwdry - rmwf12 = mwf12/mwdry + rmwn2o = mwn2o/mwdry + rmwch4 = mwch4/mwdry + rmwf11 = mwf11/mwdry + rmwf12 = mwf12/mwdry !----------------------------------------------------------------------- ! Get initial mixing ratios @@ -1049,6 +1015,10 @@ subroutine chem_init_cnst( name, latvals, lonvals, mask, q) where(mask) q(:,ilev) = rmwf12 * chem_surfvals_get('F12VMR') end where + case ('CO2') + where(mask) + q(:,ilev) = chem_surfvals_get('CO2MMR') + end where end select end do end if @@ -1069,15 +1039,15 @@ subroutine chem_timestep_init(phys_state,pbuf2d) use mo_aurora, only : aurora_timestep_init use mo_photo, only : photo_timestep_init - use noy_ubc, only : noy_ubc_advance use cfc11star, only : update_cfc11star use physics_buffer, only : physics_buffer_desc use ocean_emis, only : ocean_emis_advance + use mee_fluxes, only : mee_fluxes_adv implicit none - type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) !----------------------------------------------------------------------- @@ -1116,11 +1086,6 @@ subroutine chem_timestep_init(phys_state,pbuf2d) !----------------------------------------------------------------------- call flbc_chk - !----------------------------------------------------------------------- - ! NOy upper boundary conditions for low top model - !----------------------------------------------------------------------- - call noy_ubc_advance(pbuf2d, phys_state) - !----------------------------------------------------------------------- ! Set fixed offline tracers !----------------------------------------------------------------------- @@ -1134,7 +1099,7 @@ subroutine chem_timestep_init(phys_state,pbuf2d) if ( ghg_chem ) then call ghg_chem_timestep_init(phys_state) endif - + !----------------------------------------------------------------------- ! Set up aurora !----------------------------------------------------------------------- @@ -1146,42 +1111,46 @@ subroutine chem_timestep_init(phys_state,pbuf2d) call photo_timestep_init( calday ) call update_cfc11star( pbuf2d, phys_state ) - + ! Galatic Cosmic Rays ... call gcr_ionization_adv( pbuf2d, phys_state ) call epp_ionization_adv() + ! medium energy electron flux data ... + call mee_fluxes_adv() + call ocean_emis_advance( pbuf2d, phys_state ) end subroutine chem_timestep_init subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o) -!----------------------------------------------------------------------- -! -! Purpose: +!----------------------------------------------------------------------- +! +! Purpose: ! Interface to parameterized greenhouse gas chemisty (source/sink). -! -! Method: -! -! -! +! +! Method: +! +! +! ! Author: B.A. Boville -! +! !----------------------------------------------------------------------- use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx use cam_history, only : outfld use time_manager, only : get_curr_calday use mo_gas_phase_chemdr, only : gas_phase_chemdr - use camsrfexch, only : cam_in_t, cam_out_t + use camsrfexch, only : cam_in_t, cam_out_t use perf_mod, only : t_startf, t_stopf - use tropopause, only : tropopause_findChemTrop, tropopause_find + use tropopause, only : tropopause_findChemTrop, tropopause_find_cam use mo_drydep, only : drydep_update use mo_neu_wetdep, only : neu_wetdep_tend use aerodep_flx, only : aerodep_flx_prescribed use short_lived_species, only : short_lived_species_writeic - + use atm_stream_ndep, only : ndep_stream_active + implicit none !----------------------------------------------------------------------- @@ -1193,7 +1162,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o) type(cam_in_t), intent(inout) :: cam_in type(cam_out_t), intent(inout) :: cam_out real(r8), intent(out) :: fh2o(pcols) ! h2o flux to balance source from chemistry - + type(physics_buffer_desc), pointer :: pbuf(:) @@ -1243,7 +1212,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o) if ( ghg_chem ) lq(1) = .true. call physics_ptend_init(ptend, state%psetcols, 'chemistry', lq=lq) - + call drydep_update( state, cam_in ) !----------------------------------------------------------------------- @@ -1254,11 +1223,15 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o) !----------------------------------------------------------------------- ! get tropopause level !----------------------------------------------------------------------- + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + tropLev(:) = 0 + tropLevChem(:) = 0 + !REMOVECAM_END if (.not.chem_use_chemtrop) then - call tropopause_find(state,tropLev) + call tropopause_find_cam(state,tropLev) tropLevChem=tropLev else - call tropopause_find(state,tropLev) + call tropopause_find_cam(state,tropLev) call tropopause_findChemTrop(state, tropLevChem) endif @@ -1282,25 +1255,26 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o) !----------------------------------------------------------------------- call t_startf( 'chemdr' ) do k = 1,pver - cldw(:ncol,k) = state%q(:ncol,k,ixcldliq) + state%q(:ncol,k,ixcldice) + cldw(:ncol,k) = state%q(:ncol,k,ixcldliq) if (ixndrop>0) & ncldwtr(:ncol,k) = state%q(:ncol,k,ixndrop) end do call gas_phase_chemdr(lchnk, ncol, imozart, state%q, & state%phis, state%zm, state%zi, calday, & - state%t, state%pmid, state%pdel, state%pint, & - cldw, tropLev, tropLevChem, ncldwtr, state%u, state%v, & - chem_dt, state%ps, xactive_prates, & + state%t, state%pmid, state%pdel, state%pint, state%rpdel, state%rpdeldry, & + cldw, tropLev, tropLevChem, ncldwtr, state%u, state%v, chem_dt, state%ps, & fsds, cam_in%ts, cam_in%asdir, cam_in%ocnfrac, cam_in%icefrac, & cam_out%precc, cam_out%precl, cam_in%snowhland, ghg_chem, state%latmapback, & drydepflx, wetdepflx, cam_in%cflx, cam_in%fireflx, cam_in%fireztop, & - nhx_nitrogen_flx, noy_nitrogen_flx, ptend%q, pbuf ) - if (associated(cam_out%nhx_nitrogen_flx)) then - cam_out%nhx_nitrogen_flx(:ncol) = nhx_nitrogen_flx(:ncol) - endif - if (associated(cam_out%noy_nitrogen_flx)) then - cam_out%noy_nitrogen_flx(:ncol) = noy_nitrogen_flx(:ncol) + nhx_nitrogen_flx, noy_nitrogen_flx, use_hemco, ptend%q, pbuf ) + if (.not.ndep_stream_active) then + if (associated(cam_out%nhx_nitrogen_flx)) then + cam_out%nhx_nitrogen_flx(:ncol) = nhx_nitrogen_flx(:ncol) + endif + if (associated(cam_out%noy_nitrogen_flx)) then + cam_out%noy_nitrogen_flx(:ncol) = noy_nitrogen_flx(:ncol) + endif endif call t_stopf( 'chemdr' ) @@ -1315,7 +1289,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o) call outfld( srcnam(m), ptend%q(:,:,n), pcols, lchnk ) end if - ! 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 fluxes in the export state @@ -1361,12 +1335,22 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o) do k = 1,pver fh2o(:ncol) = fh2o(:ncol) + ptend%q(:ncol,k,1)*state%pdel(:ncol,k)/gravit end do - + end subroutine chem_timestep_tend !------------------------------------------------------------------- !------------------------------------------------------------------- - subroutine chem_final + subroutine chem_final() + use mee_ionization, only: mee_ion_final + use rate_diags, only: rate_diags_final + use species_sums_diags, only: species_sums_final + use short_lived_species, only: short_lived_species_final + + call mee_ion_final() + call rate_diags_final() + call species_sums_final() + call short_lived_species_final() + end subroutine chem_final !------------------------------------------------------------------- diff --git a/src/chemistry/mozart/epp_ionization.F90 b/src/chemistry/mozart/epp_ionization.F90 index e0734e6c7c..e5617501fe 100644 --- a/src/chemistry/mozart/epp_ionization.F90 +++ b/src/chemistry/mozart/epp_ionization.F90 @@ -8,7 +8,8 @@ module epp_ionization use spmd_utils, only : masterproc use cam_abortutils, only : endrun use cam_logfile, only : iulog - use phys_grid, only : pcols, pver, begchunk, endchunk, get_ncols_p + use ppgrid, only : pcols, pver, begchunk, endchunk + use phys_grid, only : get_ncols_p use pio, only : var_desc_t, file_desc_t use pio, only : pio_get_var, pio_inq_varid, pio_get_att use pio, only : pio_inq_varndims, pio_inq_vardimid, pio_inq_dimname, pio_inq_dimlen @@ -123,7 +124,7 @@ subroutine epp_ionization_init() character(len=32) :: fldunits fldunits = '' - + if (epp_all_filepath /= 'NONE') then epp_in => create_input_obj(epp_all_filepath,epp_all_varname) fldunits = trim(epp_in%units) @@ -203,7 +204,7 @@ subroutine epp_ionization_ionpairs( ncol, lchnk, pmid, temp, ionpairs ) if ( associated(epp_in) ) then ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, epp_in ) - else + else if ( associated(spe_in) ) then ionpairs(:ncol,:) = ionpairs(:ncol,:) + interp_ionpairs( ncol, lchnk, pmid, temp, spe_in ) endif @@ -250,7 +251,7 @@ end subroutine read_next_data !----------------------------------------------------------------------------- function interp_ionpairs( ncol, lchnk, pmid, temp, input ) result( ionpairs ) use interpolate_data, only : lininterp, lininterp_init, lininterp_finish, extrap_method_zero, interp_type - use physconst, only : rairv + use air_composition, only : rairv use cam_history, only : outfld integer, intent(in) :: ncol, lchnk @@ -258,7 +259,7 @@ function interp_ionpairs( ncol, lchnk, pmid, temp, input ) result( ionpairs ) real(r8), intent(in) :: temp(:,:) ! K type(input_obj_t), pointer :: input real(r8) :: ionpairs(ncol,pver) - + real(r8) :: fctr1, fctr2 real(r8) :: wrk(ncol,input%nlevs) real(r8) :: ions_diags(ncol,pver) ! for diagnostics @@ -284,9 +285,9 @@ function interp_ionpairs( ncol, lchnk, pmid, temp, input ) result( ionpairs ) call lininterp( wrk(i,:input%nlevs), input%nlevs, & ionpairs(i,:pver), pver, interp_wgts ) call lininterp_finish(interp_wgts) - + ions_diags(i,:pver) = ionpairs(i,:pver) - + if ( index(trim(input%units), 'g^-1') > 0 ) then ! convert to ionpairs/cm3/sec ionpairs(i,:pver) = ionpairs(i,:pver) *(1.e-3_r8*pmid(i,:pver)/(rairv(i,:pver,lchnk)*temp(i,:pver))) @@ -298,7 +299,7 @@ function interp_ionpairs( ncol, lchnk, pmid, temp, input ) result( ionpairs ) end function interp_ionpairs !----------------------------------------------------------------------------- - ! read 2D profile (geomag-lat vs press) and transfer to geographic grid + ! read 2D profile (geomag-lat vs press) and transfer to geographic grid !----------------------------------------------------------------------------- subroutine read_2d_profile( input ) @@ -443,13 +444,13 @@ function create_input_obj( path, varname ) result(in_obj) allocate( in_obj%press(in_obj%nlevs) ) ierr = pio_get_var( in_obj%fid, pres_vid, in_obj%press ) endif - if (glat_did>0) then + if (glat_did>0) then ierr = pio_inq_dimlen( in_obj%fid, glat_did, in_obj%nglats ) allocate( in_obj%glats(in_obj%nglats) ) ierr = pio_get_var( in_obj%fid, glat_vid, in_obj%glats ) allocate( in_obj%glatn(pcols,begchunk:endchunk) ) endif - + allocate( in_obj%gwght(pcols,begchunk:endchunk) ) if (in_obj%time_coord%time_interp) then diff --git a/src/chemistry/mozart/fire_emissions.F90 b/src/chemistry/mozart/fire_emissions.F90 index 10344524e9..301c5af9f6 100644 --- a/src/chemistry/mozart/fire_emissions.F90 +++ b/src/chemistry/mozart/fire_emissions.F90 @@ -3,7 +3,7 @@ !================================================================================ module fire_emissions - use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl + use shr_kind_mod, only : r8 => shr_kind_r8 use shr_fire_emis_mod, only : shr_fire_emis_mechcomps, shr_fire_emis_mechcomps_n, shr_fire_emis_elevated use srf_field_check, only : active_Fall_flxfire use shr_const_mod, only : pi => SHR_CONST_PI @@ -27,7 +27,7 @@ module fire_emissions public :: fire_emissions_vrt ! for surface emissions - integer, allocatable :: fire_emis_indices_map(:) + integer, allocatable :: fire_emis_indices_map(:) ! for vertically distributed forcings integer, allocatable :: frc_spc_map(:) @@ -48,26 +48,25 @@ module fire_emissions !------------------------------------------------------------------------------ subroutine fire_emissions_init() - ! local vars - integer :: n, ii - - integer :: frc_ndx, spc_ndx, ndx + integer :: n, ii + + integer :: frc_ndx, spc_ndx integer :: mode, spec character(len=16) :: name - character(len=32) :: spc_name character(len=32) :: num_name - real(r8), parameter :: demis_acc = 0.134e-6_r8 ! meters + real(r8), parameter :: demis_acc = 0.134e-6_r8 ! meters ! volume-mean emissions diameter of primary BC/OM aerosols, see : - ! Liu et al, Toward a minimal representation of aerosols in climate models: - ! Description and evaluation in the Community Atmosphere Model CAM5. + ! Liu et al, Toward a minimal representation of aerosols in climate models: + ! Description and evaluation in the Community Atmosphere Model CAM5. ! Geosci. Model Dev., 5, 709–739, doi:10.5194/gmd-5-709-2012 ! and Table S1 in Supplement: http://www.geosci-model-dev.net/5/709/2012/gmd-5-709-2012-supplement.pdf - real(r8), parameter :: x_numfact = 1.e-6_r8 * avogad * 6.0_r8 / (pi*(demis_acc**3)) ! 1.e-6 converts m-3 to cm-3. + real(r8), parameter :: x_numfact = 1.e-6_r8 * avogad * 6.0_r8 / (pi*(demis_acc**3)) ! 1.e-6 converts m-3 to cm-3. real(r8) :: specdens ! kg/m3 logical :: found + character(len=12) :: units if (shr_fire_emis_mechcomps_n<1) return @@ -114,10 +113,10 @@ subroutine fire_emissions_init() call endrun('fire_emissions_init: not able to map '//trim(name)//' to chem species/forcing ') endif - spc_mass_factor(n) = 1.e-6_r8 * avogad / adv_mass(spc_ndx) ! 1.e-6 converts m-3 to cm-3. + spc_mass_factor(n) = 1.e-6_r8 * avogad / adv_mass(spc_ndx) ! 1.e-6 converts m-3 to cm-3. ! (molecules/kmole) / (g/mole) --> molecules/kg - ! for MAM need to include cooresponding forcings of number densities + ! for MAM need to include cooresponding forcings of number densities found = rad_cnst_num_name(0, name, num_name, mode_out=mode, spec_out=spec ) @@ -126,7 +125,7 @@ subroutine fire_emissions_init() frc_ndx = get_extfrc_ndx( num_name ) call rad_cnst_get_aer_props(0, mode, spec, density_aer=specdens) - frc_num_map(n) = frc_ndx + frc_num_map(n) = frc_ndx num_mass_factor(n) = x_numfact / specdens fire_numfrc_name(n) = 'FireFrc_'//trim(name)//'_'//trim(num_name) @@ -150,8 +149,14 @@ subroutine fire_emissions_init() //trim(shr_fire_emis_mechcomps(n)%name)) endif + if (index(shr_fire_emis_mechcomps(n)%name,'num_')>0) then + units = '1/m2/sec' + else + units = 'kg/m2/sec' + endif + ! Fire emis history fields - call addfld( 'FireSF_'//trim(shr_fire_emis_mechcomps(n)%name),horiz_only,'A','kg/m2/sec',& + call addfld( 'FireSF_'//trim(shr_fire_emis_mechcomps(n)%name),horiz_only,'A',units,& trim(shr_fire_emis_mechcomps(n)%name)//' Fire emissions flux') enddo @@ -161,7 +166,7 @@ subroutine fire_emissions_init() end subroutine fire_emissions_init !------------------------------------------------------------------------------ - ! sets surface emissions + ! sets surface emissions !------------------------------------------------------------------------------ subroutine fire_emissions_srf( lchnk, ncol, fireflx, sflx ) @@ -180,7 +185,7 @@ subroutine fire_emissions_srf( lchnk, ncol, fireflx, sflx ) do i =1,ncol do n = 1,shr_fire_emis_mechcomps_n sflx(i,fire_emis_indices_map(n)) & - = sflx(i,fire_emis_indices_map(n)) + fireflx(i,n) + = sflx(i,fire_emis_indices_map(n)) + fireflx(i,n) enddo end do @@ -195,7 +200,7 @@ end subroutine fire_emissions_srf !------------------------------------------------------------------------------ ! sets vertical emissions (forcings) - ! vertically distributes wild fire emissions + ! vertically distributes wild fire emissions !------------------------------------------------------------------------------ subroutine fire_emissions_vrt( ncol, lchnk, zint, fire_sflx, fire_ztop, frcing ) @@ -245,7 +250,7 @@ subroutine fire_emissions_vrt( ncol, lchnk, zint, fire_sflx, fire_ztop, frcing ) ! vertical intergration of the forcing should get back the surface flux sflx(:) = 0._r8 do k = 1,pver - sflx(:ncol) = sflx(:ncol) + 1.e5_r8*(zint(:ncol,k)-zint(:ncol,k+1))*fire_frc(:ncol,k) ! molecules/cm3/s --> molecules/cm2/sec + sflx(:ncol) = sflx(:ncol) + 1.e5_r8*(zint(:ncol,k)-zint(:ncol,k+1))*fire_frc(:ncol,k) ! molecules/cm3/s --> molecules/cm2/sec enddo sflx(:ncol) = sflx(:ncol) * 1.e4_r8 * adv_mass(chm_spc_map(n))/avogad ! molecules/cm2/sec --> kg/m2/sec ! / avogad --> kmoles/cm2/sec @@ -254,15 +259,15 @@ subroutine fire_emissions_vrt( ncol, lchnk, zint, fire_sflx, fire_ztop, frcing ) call outfld( fire_vflx_name(n), sflx(:ncol ), ncol, lchnk ) call outfld( fire_sflx_name(n), fire_sflx(:ncol,n), ncol, lchnk ) - ! for MAM need to include corresponding forcings of number densities + ! for MAM need to include corresponding forcings of number densities if (frc_num_map(n)>0) then do k = 1,pver - fire_frc(:ncol,k) = fire_sflx(:ncol,n) * vertical_fire(:ncol,k) * num_mass_factor(n) ! molecules/cm3/s + fire_frc(:ncol,k) = fire_sflx(:ncol,n) * vertical_fire(:ncol,k) * num_mass_factor(n) ! molecules/cm3/s enddo call outfld( fire_numfrc_name(n), fire_frc, ncol, lchnk ) frcing(:ncol,:,frc_num_map(n)) = frcing(:ncol,:,frc_num_map(n)) + fire_frc(:ncol,:) endif - + enddo call outfld( 'Fire_ZTOP', fire_ztop(:ncol), ncol, lchnk ) diff --git a/src/chemistry/mozart/hco_cc_emissions.F90 b/src/chemistry/mozart/hco_cc_emissions.F90 new file mode 100644 index 0000000000..5cd98c6ba6 --- /dev/null +++ b/src/chemistry/mozart/hco_cc_emissions.F90 @@ -0,0 +1,384 @@ +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: hco_cc_emissions +! +! !DESCRIPTION: Module hco\_cc\_emissions provides emissions to CAM-chem in CESM. +! This module replaces mo\_extfrc and mo\_srf\_emissions in CAM-chem +! when HEMCO is enabled, otherwise they are not called if HEMCO-CESM is not +! enabled at runtime. +! +! These subroutines emulate the behavior of extfrc\_set (3-D emissions) +! and set\_srf\_emissions in CAM-chem for API compatibility. +!\\ +!\\ +! !INTERFACE: +! +module hco_cc_emissions +! +! !USES: +! + ! CESM types + use shr_kind_mod, only: r8 => shr_kind_r8 + + ! Run control + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + + ! Grid information + use ppgrid, only: pver, pverp + + ! Chemistry mechanism properties + use chem_mods, only: gas_pcnst + use mo_tracname, only: solsym + + ! Physics buffer operations + use physics_buffer, only: physics_buffer_desc + use physics_buffer, only: pbuf_get_field, pbuf_get_index + + ! Compat with XFRC diagn + use cam_history, only: outfld + use cam_history_support, only: max_fieldname_len + + implicit none + private +! +! !PUBLIC MEMBER FUNCTIONS: +! + public :: hco_extfrc_inti + public :: hco_set_srf_emissions, hco_set_extfrc +! +! !REMARKS: +! None +! +! !REVISION HISTORY: +! 08 Aug 2022 - H.P. Lin - Initial version +! 04 Nov 2022 - H.P. Lin - Now initialize extfrc fields in here +!EOP +!------------------------------------------------------------------------------ +!BOC + logical :: pcnst_is_extfrc(gas_pcnst) ! Is external forcing? (3-D data) + integer :: pcnst_extfrc_ndx(gas_pcnst) ! External forcing index from get_extfrc_ndx + integer :: hco_pbuf_idx(gas_pcnst) ! Physics buffer indices for HCO_* fields from HEMCO +contains +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: hco_set_srf_emissions +! +! !DESCRIPTION: Sets surface level emissions (note, TOA is level 1, so this is level pver) +! for this latitude slice (chunk). +!\\ +!\\ +! !INTERFACE: +! + subroutine hco_set_srf_emissions( lchnk, ncol, sflx, pbuf ) +! +! !USES: +! + implicit none +! +! !INPUT PARAMETERS: +! + integer, intent(in) :: ncol ! columns in chunk + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(out) :: sflx(:,:) ! surface emissions ( kg/m^2/s ) + type(physics_buffer_desc), pointer :: pbuf(:) ! pbuf in chunk +! +! !REVISION HISTORY: +! 08 Aug 2022 - H.P. Lin - Initial version +! 12 Jan 2023 - H.P. Lin - Check if pbuf is 2-D or 3-D first +! 09 Feb 2023 - H.P. Lin - For 3-D pbuf, no longer set cflx and use 3-D forcing only. +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + integer :: n + + real(r8), pointer :: pbuf_ptr_3d(:,:) ! ptr to pbuf data (/pcols,pver/) + real(r8), pointer :: pbuf_ptr_2d(:) ! ptr to pbuf data (/pcols/) + integer :: tmpIdx ! pbuf field id + + ! reset sflx here. (same as mo_srf_emissions.F90) + ! sflx is defined in chem_emissions (chemistry.F90) but without default values, and is + ! later added to cam_in%cflx. it must be initialized in this subroutine. + sflx(:,:) = 0._r8 + + !-------------------------------------------------------- + ! ... set HEMCO emissions + ! hplin 7/19/20 + !-------------------------------------------------------- + + ! for every species index retrieve the species name, compute the pbuf name, + ! and write it into sflx(col, n) + ! where n is spc_ndx + + ! if the pbuf exists, set has_emis(1:gas_pcnst) to .true. + ! this process is supposed to be set by srf_emissions_inti but it is just + ! used below, so we shunt it here and decide later + + ! ncol: # of columns in chunk + ! lchnk: chunk number + + ! sflx is given in (pcols, gas_pcnst) so it is a in-chunk slice of the + ! srf flux specifier. maybe this loop needs to be done higher up so + ! we loop over the pbuf to prevent inquiries. tbd hplin 7/19/20 + + do n = 1, gas_pcnst + tmpIdx = hco_pbuf_idx(n) + if(tmpIdx > 0) then + if(pcnst_is_extfrc(n)) then ! 3-D data + ! if species is 3-D data, then all forcings set through 3-D. no longer process + ! their emissions here. + else ! 2-D data + call pbuf_get_field(pbuf, tmpIdx, pbuf_ptr_2d) + + ! for each col retrieve data from pbuf_ptr(I, K) + sflx(1:ncol,n) = pbuf_ptr_2d(1:ncol) + + pbuf_ptr_2d => null() + endif + endif + enddo + + end subroutine hco_set_srf_emissions +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: hco_set_extfrc +! +! !DESCRIPTION: Set 3-D emissions apart from surface level. +!\\ +!\\ +! !INTERFACE: +! + subroutine hco_set_extfrc( lchnk, zint, frcing, ncol, pbuf ) +! +! !USES: +! + use mo_chem_utls, only: get_spc_ndx + + ! Check list whether this species has external forcing from dataset - this is a CAM-chem flag + ! and this is CAM-chem specific. + use chem_mods, only: frc_from_dataset, extfrc_lst + use chem_mods, only: extcnt, adv_mass + + use mo_constants, only: avogadro + implicit none +! +! !INPUT PARAMETERS: +! + integer, intent(in) :: ncol ! columns in chunk + integer, intent(in) :: lchnk ! chunk index + real(r8), intent(in) :: zint(ncol, pverp) ! interface geopot above surface (km) + real(r8), intent(inout) :: frcing(ncol,pver,extcnt) ! insitu forcings (molec/cm^3/s) + type(physics_buffer_desc), pointer :: pbuf(:) ! pbuf in chunk +! +! !REVISION HISTORY: +! 08 Aug 2022 - H.P. Lin - Initial version based on original from 14 Nov 2020 +! 09 Feb 2023 - H.P. Lin - Use full 3-D emissions, including surface, if available +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + real(r8), parameter :: cm2_to_m2 = 1.e4_r8 + real(r8), parameter :: kg_to_g = 1.e-3_r8 + real(r8), parameter :: km_to_cm = 1.e5_r8 + + ! Loop idxs + integer :: m, n, k + + ! For compatibility with XFRC_ diagnostic in CAM-chem + real(r8) :: frcing_col(1:ncol), frcing_col_kg(1:ncol) + character(len=max_fieldname_len) :: xfcname + real(r8) :: molec_to_kg + integer :: spc_ndx + + + real(r8), pointer :: pbuf_ik(:,:) ! ptr to pbuf data (/pcols,pver/) + integer :: tmpIdx ! pbuf field id + real(r8) :: kg_to_molec + + ! for every species index retrieve the species name, compute the pbuf name, + ! and write it into frcing(col, lev, n) + ! where n is FRC_IDX -- + ! + + !****************************************************************************************************** + ! WARNING: ONLY SPECIES THAT ARE EXTERNALLY FORCED AND SPECIFIED IN mo_sim_dat.F90 + ! CAN HAVE 3-D EMISSIONS, OTHERWISE THEY WILL BE IGNORED!!! + ! + ! the n = frc_idx comes from get_extfrc_ndx( spc_name ). + ! it is too computationally expensive to check all fields to see if they are 3-d emitted + ! + ! so PLEASE verify that all your species are in mo_sim_dat.F90:: extfrc_lst before attempting + ! to have 3-D emissions for them. + ! + ! I will still loop through all species, get its symbol and attempt to inject extfrc emissions + ! for it, but it may not be guaranteed to be done. + !****************************************************************************************************** + + ! if the pbuf exists, set has_emis(1:gas_pcnst) to .true. + ! this process is supposed to be set by srf_emissions_inti but it is just + ! used below, so we shunt it here and decide later + + ! ncol: # of columns in chunk + ! lchnk: chunk number + + ! Zero out frcing to be consistent with mo_extfrc + frcing(:,:,:) = 0._r8 + + do n = 1, gas_pcnst + ! check if extfrc available? + if(pcnst_is_extfrc(n)) then + ! add extfrc + ! "external insitu forcing" (1/cm^3/s) + m = pcnst_extfrc_ndx(n) + tmpIdx = hco_pbuf_idx(n) + if(tmpIdx > 0) then + ! Note: units coming out of HEMCO are in kg/m2/s, so unit conversion must be done + ! + ! using species factor... + ! (kg_to_g is actually kg/g...) + ! + ! 1 / (kg/molec cm2/m2) = molec/kg m2/cm2 + ! + ! kg/m2/s * molec/kg m2/cm2 = molec/cm2/s + ! now divide by z-interface height (in CM!) for each height to get the right answer! + ! (hplin, 11/14/20) + kg_to_molec = 1/(adv_mass(n) / avogadro * cm2_to_m2 * kg_to_g) + + ! this is already in chunk, retrieve it. + ! if the field does not exist, pbuf_get_field will return an error, so sanity check for pbuf_ik is not needed. + call pbuf_get_field(pbuf, tmpIdx, pbuf_ik) + + ! for each col retrieve data from pbuf_ik(I, K) + ! this includes surface layer. + do k = 1, pver + frcing(:ncol,k,m) = frcing(:ncol,k,m) + pbuf_ik(1:ncol,k) * kg_to_molec / ((zint(:ncol,k)-zint(:ncol,k+1)) * km_to_cm) + enddo + + if ( frc_from_dataset(m) ) then + xfcname = trim(extfrc_lst(m))//'_XFRC' + call outfld( xfcname, frcing(:ncol,:,n), ncol, lchnk ) + spc_ndx = get_spc_ndx( extfrc_lst(m) ) + molec_to_kg = adv_mass( spc_ndx ) / avogadro * cm2_to_m2 * kg_to_g + + frcing_col(:ncol) = 0._r8 + frcing_col_kg(:ncol) = 0._r8 + do k = 1, pver + frcing_col(:ncol) = frcing_col(:ncol) + frcing(:ncol,k,m)*(zint(:ncol,k)-zint(:ncol,k+1))*km_to_cm + frcing_col_kg(:ncol) = frcing_col_kg(:ncol) + frcing(:ncol,k,m)*(zint(:ncol,k)-zint(:ncol,k+1))*km_to_cm*molec_to_kg + enddo + + xfcname = trim(extfrc_lst(m))//'_CLXF' + call outfld( xfcname, frcing_col(:ncol), ncol, lchnk ) + xfcname = trim(extfrc_lst(m))//'_CMXF' + call outfld( xfcname, frcing_col_kg(:ncol), ncol, lchnk ) + endif + endif + endif + enddo + + end subroutine hco_set_extfrc +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: hco_extfrc_inti +! +! !DESCRIPTION: Initialize external forcing related diagnostic fields +!\\ +!\\ +! !INTERFACE: +! + subroutine hco_extfrc_inti( ) +! +! !USES: +! + use chem_mods, only: frc_from_dataset, extcnt, extfrc_lst + use cam_history, only: addfld, add_default, horiz_only + use phys_control, only: phys_getopts + use mo_chem_utls, only: get_extfrc_ndx + implicit none +! +! !REVISION HISTORY: +! 04 Nov 2022 - H.P. Lin - Initial version based on extfrc_inti +! 10 Apr 2023 - H.P. Lin - Now move pcnst_is_extfrc initialization here +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + logical :: history_aerosol + logical :: history_chemistry + logical :: history_cesm_forcing + character(len=16) :: spc_name + integer :: n + + character(len=255) :: fldname_ns ! field name HCO_NH3 + integer :: RC ! return code (dummy) + + ! for first run, cache results of 3-D or 2-D scan within pcnst_is_extfrc + ! to avoid lengthy lookups in future timesteps. hplin 1/12/23 + do n = 1, gas_pcnst + pcnst_extfrc_ndx(n) = get_extfrc_ndx(trim(solsym(n))) + pcnst_is_extfrc(n) = (pcnst_extfrc_ndx(n) > 0) + + ! construct information about HCO_* corresponding pbuf location + fldname_ns = 'HCO_' // trim(solsym(n)) + hco_pbuf_idx(n) = pbuf_get_index(fldname_ns, RC) + enddo + + if(masterproc) then + write(iulog,*) "hco_set_srf_emissions: first run pcnst_is_extfrc cache, extfrc_ndx:" + do n = 1, gas_pcnst + write(iulog,*) trim(solsym(n)), ' : ', pcnst_is_extfrc(n), pcnst_extfrc_ndx(n) + end do + endif + + ! Replicate functionality in extfrc_inti to create _XFRC... diagnostics + call phys_getopts( & + history_aerosol_out = history_aerosol, & + history_chemistry_out = history_chemistry, & + history_cesm_forcing_out = history_cesm_forcing ) + + do n= 1,extcnt + if (frc_from_dataset(n)) then + spc_name = extfrc_lst(n) + call addfld( trim(spc_name)//'_XFRC', (/ 'lev' /), 'A', 'molec/cm3/s', & + 'external forcing for '//trim(spc_name) ) + call addfld( trim(spc_name)//'_CLXF', horiz_only, 'A', 'molec/cm2/s', & + 'vertically intergrated external forcing for '//trim(spc_name) ) + call addfld( trim(spc_name)//'_CMXF', horiz_only, 'A', 'kg/m2/s', & + 'vertically intergrated external forcing for '//trim(spc_name) ) + if ( history_aerosol .or. history_chemistry ) then + call add_default( trim(spc_name)//'_CLXF', 1, ' ' ) + call add_default( trim(spc_name)//'_CMXF', 1, ' ' ) + endif + if ( history_cesm_forcing .and. spc_name == 'NO2' ) then + call add_default( trim(spc_name)//'_CLXF', 1, ' ' ) + call add_default( trim(spc_name)//'_CMXF', 1, ' ' ) + endif + endif + enddo + + end subroutine hco_extfrc_inti +!EOC +end module hco_cc_emissions diff --git a/src/chemistry/mozart/mee_ap_util_mod.F90 b/src/chemistry/mozart/mee_ap_util_mod.F90 new file mode 100644 index 0000000000..ef0ee345c3 --- /dev/null +++ b/src/chemistry/mozart/mee_ap_util_mod.F90 @@ -0,0 +1,376 @@ +!------------------------------------------------------------------------------ +! Utility routines for medium energy electron ionization base on Ap +! geomagnetic activity index or observed electron fluxes +!------------------------------------------------------------------------------ +module mee_ap_util_mod + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_const_mod, only: pi => shr_const_pi + use mee_fluxes, only: mee_fluxes_nenergy, mee_fluxes_energy, mee_fluxes_denergy + use mee_fluxes, only: mee_fluxes_active, mee_fluxes_extract + use cam_abortutils, only : endrun + + implicit none + + private + public :: mee_ap_iprs + public :: mee_ap_init + public :: mee_ap_final + public :: mee_ap_error + public :: mee_ap_noerror + + integer, parameter :: mee_ap_error=-1 + integer, parameter :: mee_ap_noerror=0 + + integer :: nbins=0 + + real(r8),pointer :: energies(:) => null() ! energy bins + real(r8),pointer :: denergies(:) => null() ! width of each energy bin + real(r8) :: solid_angle_factor = -huge(1._r8) + real(r8),allocatable :: fang_coefs(:,:) + +contains + + !----------------------------------------------------------------------------- + ! Sets up energy spectrum grid for medium energy electrons in earth's + ! radiation belt + !----------------------------------------------------------------------------- + subroutine mee_ap_init(loss_cone_angle, status) + + real(r8), intent(in) :: loss_cone_angle ! Bounce Loss Cone angle (degrees) + integer, intent(out) :: status ! error status + + integer :: ierr + character(len=*), parameter :: subname = 'mee_ap_init: ' + + status = mee_ap_noerror + if ( loss_cone_angle<0._r8 .or. loss_cone_angle>90._r8 ) then + status = mee_ap_error + return + endif + + ! The area of the BLC in sr is 2pi(1-cos(BLC)) + solid_angle_factor = 2._r8*pi*(1._r8-cos(loss_cone_angle*pi/180._r8)) + + if (mee_fluxes_active) then + nbins=mee_fluxes_nenergy + energies=>mee_fluxes_energy + denergies=>mee_fluxes_denergy + else + nbins=100 + allocate(energies(nbins), stat=ierr) + if (ierr/=0) call endrun(subname//'not able to allocate energies') + allocate(denergies(nbins), stat=ierr) + if (ierr/=0) call endrun(subname//'not able to allocate denergies') + call gen_energy_grid(nbins, energies, denergies) + endif + + call init_fang_coefs() + + end subroutine mee_ap_init + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine mee_ap_final() + + deallocate(fang_coefs) + + if (.not.mee_fluxes_active) then + deallocate(energies) + deallocate(denergies) + endif + nullify(energies) + nullify(denergies) + + end subroutine mee_ap_final + + !----------------------------------------------------------------------------- + ! Computes ion pair production rates base on Ap geomagnetic activity index + ! or observed electron fluxes + !----------------------------------------------------------------------------- + subroutine mee_ap_iprs( ncols, nlyrs, airden, scaleh, Ap, ionpairs, status, maglat, lshell) + + integer ,intent(in) :: ncols, nlyrs + real(r8),intent(in) :: airden(ncols,nlyrs) ! g/cm3 + real(r8),intent(in) :: scaleh(ncols,nlyrs) ! cm + real(r8),intent(in) :: Ap ! geomagnetic activity index + real(r8),intent(out) :: ionpairs(ncols,nlyrs) ! pairs/cm3/sec + integer, intent(out) :: status ! error status + real(r8),intent(in), optional :: maglat(ncols) ! magnetic latitude (radians) + real(r8),intent(in), optional :: lshell(ncols) ! magnetosphere L-Shells + + integer :: i,k + real(r8) :: flux_sd(nbins) + logical :: valid(nbins) + real(r8) :: flux(nbins) + real(r8) :: ipr(nbins,nlyrs) + real(r8) :: l_shells(ncols) + + status = 0 + + if (present(lshell)) then + l_shells(:) = lshell(:) + elseif (present(maglat)) then + ! get L-shell values corresponeding to the column geo-mag latitudes + l_shells = maglat2lshell( maglat ) + else + ionpairs(:,:) = -huge(1._r8) + status = mee_ap_error + return + endif + + ionpairs(:,:) = 0._r8 + + do i = 1,ncols + + if ( l_shells(i) >= 2._r8 .and. l_shells(i) <= 10._r8 ) then + + valid(:) = .false. + flux_sd(:) = 0._r8 + + if (mee_fluxes_active) then + ! use prescribed top-of-atmosphere fluxes + call mee_fluxes_extract( l_shells(i), flux_sd, valid ) + end if + + where ( (.not.valid(:)) .and. (energies(:)>=30._r8) .and. (energies(:)<=1000._r8) ) + ! calculate the top of the atmosphere energetic electron energy spectrum + ! van de Kamp is per steradian (electrons / (cm2 sr s keV)) + flux_sd(:) = FluxSpectrum(energies(:), l_shells(i), Ap) + end where + + ! assume flux is isotropic inside a nominal bounce loss cone (BLC) angle. + ! The area of the BLC in sr is 2pi(1-cosd(BLC)) + flux(:) = solid_angle_factor*flux_sd(:) + + ! calculate the IPR as a function of height and energy + ipr(:,:) = iprmono(energies, flux, airden(i,:), scaleh(i,:)) + + ! integrate across the energy range to get total IPR + do k=1,nlyrs + ionpairs(i,k) = sum(ipr(:,k)*denergies(:)) + end do + + end if + + end do + + end subroutine mee_ap_iprs + + !------------------------------------------------------------------------------ + ! Electron fluxes for a specific L-shell and Ap + ! + ! Based on: + ! + ! van de Kamp, M., Seppala, A., Clilverd, M. A., Rodger, C. J., Verronen, P. T., and Whittaker, I. C. (2016), + ! A model providing long‐term datasets of energetic electron precipitation during geomagnetic storms, + ! J. Geophys. Res. Atmos., 121, 12,520– 12,540, + ! [doi:10.1002/2015JD024212](https://agupubs.onlinelibrary.wiley.com/doi/full/10.1002/2015JD024212) + !------------------------------------------------------------------------------ + pure function FluxSpectrum( en, lshell, Ap ) result(flux) + + real(r8), intent(in) :: en(:) ! electron energy bins (keV) + real(r8), intent(in) :: lshell ! magnetosphere L-Shell number + real(r8), intent(in) :: Ap ! geomagnetic activity index + + real(r8) :: flux(size(en)) + + real(r8) :: lpp + real(r8) :: Spp + real(r8) :: A + real(r8) :: b + real(r8) :: c + real(r8) :: s + real(r8) :: d + real(r8) :: F30 + real(r8) :: E + real(r8) :: bk + real(r8) :: sk + real(r8) :: k + real(r8) :: x + + lpp = -0.7430_r8*log(Ap) + 6.5257_r8 + Spp = lshell - lpp + + ! vdK2016 eqn.(8) + + A = 8.2091_r8*Ap**(0.16255_r8) + b = 1.3754_r8*Ap**(0.33042_r8) + c = 0.13334_r8*Ap**(0.42616_r8) + s = 2.2833_r8*Ap**(-0.22990_r8) + d = 2.7563e-4_r8*Ap**(2.6116_r8) + + F30 = exp(A) / (exp(-b*(Spp-s)) + exp(c*(Spp-s)) + d) + + ! vdK2016 eqn.(9) + + E = 3.3777_r8*Ap**(-1.7038_r8) + 0.15_r8 + bk = 3.7632_r8*Ap**(-0.16034_r8) + sk = 12.184_r8*Ap**(-0.30111_r8) + + k = -1.0_r8 / (E*exp(-bk*Spp) + 0.30450_r8*cosh(0.20098_r8*(Spp-sk))) - 1._r8 + + x=k+1 + c = F30*x / ((1e3_r8**x) - (30._r8**x)) + flux(:) = c * (en(:)**k) + + end function FluxSpectrum + + !------------------------------------------------------------------------------ + ! Calculate how energy from top of atmosphere is deposited in rest of atmosphere + ! + ! The function takes the energy spectrum at the top of the atmosphere and + ! calculates how that energy is deposited in the atmosphere using the parameterization + ! described in [Fang et al., (2010)](https://opensky.ucar.edu/islandora/object/articles:10653) + ! + ! Fang, X., C. E. Randall, D. Lummerzheim, W. Wang, G. Lu, S. C. Solomon, + ! and R. A. Frahm (2010), Parameterization of monoenergetic electron impact + ! ionization, Geophys. Res. Lett., 37, L22106, [doi:10.1029/2010GL045406.] + ! (https://agupubs.onlinelibrary.wiley.com/doi/10.1029/2010GL045406) + ! + ! Application of the new parameterization requires the following steps: + ! + ! 1. Fang coefficients using equation (5) and Table 1. are calculated at initialization time + ! 2. Calculate the y values throughout the atmosphere using equation (1). + ! 3. Calculate the normalized energy dissipation f values using equation (4). + ! 4. Obtain the altitude profile of qtot by substituting the f values into equation (3). + ! + !------------------------------------------------------------------------------ + function iprmono(e, flux, rho, scaleh) result(ipr) + real(r8), intent(in) :: e(:) ! electron energy bins (keV) + real(r8), intent(in) :: flux(:) ! top of atmos electron fluxes (electrons / (cm2 sr s keV)) + real(r8), intent(in) :: rho(:) ! density of atmos (g/cm3) + real(r8), intent(in) :: scaleh(:) ! scale height (cm) + + real(r8) :: ipr(size(e),size(rho)) + integer :: nenergies, n + integer :: nlayers, k + + real(r8) :: y(size(rho)) + real(r8) :: f(size(rho)) + real(r8) :: Qmono + + ! assign constants + real(r8), parameter :: epsilon = 0.035_r8 ! keV energy loss per ion pair produced + + ipr = 0._r8 + nenergies = size(e) + nlayers = size(rho) + + do n = 1,nenergies + + ! step 1. (eq. 1) + y(:) = (2/e(n))*(rho(:)*scaleh(:)/6.0e-6_r8)**0.7_r8 + + do k = 1,nlayers + f(k) = fang(y(k), n) + end do + + ! calculate ipr (qtot) using eq. (3) for a specified flux at ea. energy + Qmono = flux(n)*e(n) ! (keV cm−2 s−1) + ipr(n,:) = f(:)*Qmono/(epsilon*scaleh(:)) + end do + + contains + + pure function fang(y,n) result(f) + real(r8), intent(in) :: y + integer, intent(in) :: n ! energy ndx + + real(r8) :: f + ! Input: + ! y - normalized atmospheric column mass as a function of vertical location (z) + ! Emono - is incident electron energy (keV) + ! Output: + ! f - quanity calculated by eqn. (4) + + + ! eq. (4) - Normalized energy deposition + f = fang_coefs(1,n) * (y**fang_coefs(2,n)) * exp(-fang_coefs(3,n)*y**fang_coefs(4,n)) & + + fang_coefs(5,n) * (y**fang_coefs(6,n)) * exp(-fang_coefs(7,n)*y**fang_coefs(8,n)) + + end function fang + + end function iprmono + + !------------------------------------------------------------------------------ + ! initializes the coeffs used in the fang function in iprmono + !------------------------------------------------------------------------------ + subroutine init_fang_coefs + + integer :: n,i, ierr + + real(r8) :: lne, lne2, lne3 + ! Table 1. of Fang et al., 2010 + ! (https://agupubs.onlinelibrary.wiley.com/doi/10.1029/2010GL045406) + real(r8), parameter :: p1(8,4) = reshape( & + (/ 1.24616E+0_r8, 1.45903E+0_r8, -2.42269E-1_r8, 5.95459E-2_r8, & + 2.23976E+0_r8, -4.22918E-7_r8, 1.36458E-2_r8, 2.53332E-3_r8, & + 1.41754E+0_r8, 1.44597E-1_r8, 1.70433E-2_r8, 6.39717E-4_r8, & + 2.48775E-1_r8, -1.50890E-1_r8, 6.30894E-9_r8, 1.23707E-3_r8, & + -4.65119E-1_r8, -1.05081E-1_r8, -8.95701E-2_r8, 1.22450E-2_r8, & + 3.86019E-1_r8, 1.75430E-3_r8, -7.42960E-4_r8, 4.60881E-4_r8, & + -6.45454E-1_r8, 8.49555E-4_r8, -4.28581E-2_r8, -2.99302E-3_r8, & + 9.48930E-1_r8, 1.97385E-1_r8, -2.50660E-3_r8, -2.06938E-3_r8 /), & + shape=(/8,4/),order=(/2,1/)) + + allocate(fang_coefs(8,nbins), stat=ierr) + if (ierr/=0) call endrun('init_fang_coefs: not able to allocate fang_coefs') + + do n = 1,nbins + ! terms in eq. (5) + lne = log(energies(n)) + lne2 = lne*lne + lne3 = lne*lne2 + + ! step 2. calculate the C array in (5) + do i = 1,8 + fang_coefs(i,n) = exp(p1(i,1) + p1(i,2)*lne + p1(i,3)*lne2 + p1(i,4)*lne3) + end do + + end do + end subroutine init_fang_coefs + + !------------------------------------------------------------------------------ + ! Generate a grid of energy bins for the flux spectrum. + ! The energy range of the spectrum is 30-1000 keV, + ! with nbins of logarithmically spaced grid points. + !------------------------------------------------------------------------------ + subroutine gen_energy_grid(nbins, energies, deltas) + integer, intent(in) :: nbins + real(r8),intent(out) :: energies(nbins) + real(r8),intent(out) :: deltas(nbins) + + integer :: i + real(r8) :: low,med,hig + + ! for energy bins ranging from 30 keV to 1000 keV + real(r8), parameter :: e1 = log10(30._r8) + real(r8), parameter :: e2 = log10(1000._r8) + + do i = 1,nbins + low = e1 + (e2-e1)*(i-1.0_r8)/nbins + med = e1 + (e2-e1)*(i-0.5_r8)/nbins + hig = e1 + (e2-e1)*(i)/nbins + + energies(i) = 10**med + deltas(i) = (10**hig)-(10**low) + end do + + end subroutine gen_energy_grid + + !------------------------------------------------------------------------------ + ! returns L-Shell number for a given magnetic latitude (radians) + !------------------------------------------------------------------------------ + pure elemental function maglat2lshell( rmaglat ) result(lshell) + real(r8), intent(in) :: rmaglat ! mag latitude in radians + real(r8) :: lshell ! magnetosphere L-Shell number + + ! lshell = r/(cos(rmaglat)**2) (https://en.wikipedia.org/wiki/L-shell) + ! where r is the radial distance (in planetary radii) to a point on the line. + ! r = 1.01 corresponds to an altitude in the lower mesosphere (~64 km) + ! where medium-energy electrons typically deposit their energy. + lshell = 1.01_r8/(cos(rmaglat)**2) + + end function maglat2lshell + +end module mee_ap_util_mod diff --git a/src/chemistry/mozart/mee_fluxes.F90 b/src/chemistry/mozart/mee_fluxes.F90 new file mode 100644 index 0000000000..e8c761ba37 --- /dev/null +++ b/src/chemistry/mozart/mee_fluxes.F90 @@ -0,0 +1,262 @@ +!-------------------------------------------------------------------------------- +! Provids electron fluxes read from input data set +!-------------------------------------------------------------------------------- +module mee_fluxes + use shr_kind_mod, only : r8 => shr_kind_r8, cl=> shr_kind_cl + use spmd_utils, only : masterproc + use cam_logfile, only : iulog + use cam_abortutils, only : endrun + use input_data_utils, only : time_coordinate + use pio, only : file_desc_t, var_desc_t, pio_get_var, pio_inq_varid + use pio, only : PIO_NOWRITE, pio_inq_dimid, pio_inq_dimlen + use infnan, only: isnan + + implicit none + + private + public :: mee_fluxes_readnl + public :: mee_fluxes_init + public :: mee_fluxes_final + public :: mee_fluxes_adv ! read and time interpolate fluxes + public :: mee_fluxes_extract ! interpolate flux to column L-shell + public :: mee_fluxes_active ! true when input flux file is specified + public :: mee_fluxes_denergy ! energy bin widths + public :: mee_fluxes_energy ! center of each energy bin + public :: mee_fluxes_nenergy ! number of energy bins + + real(r8),protected, pointer :: mee_fluxes_denergy(:) => null() + real(r8),protected, pointer :: mee_fluxes_energy(:) => null() + integer, protected :: mee_fluxes_nenergy + logical, protected :: mee_fluxes_active = .false. + + real(r8), allocatable :: lshell(:) + real(r8), allocatable :: indata(:,:,:) + real(r8), allocatable :: influx(:,:) + logical , allocatable :: valflx(:,:) + + character(len=cl) :: mee_fluxes_filepath = 'NONE' + logical :: mee_fluxes_fillin = .false. + + type(time_coordinate) :: time_coord + integer :: nlshells + + type(file_desc_t) :: file_id + type(var_desc_t) :: flux_var_id + +contains + + !----------------------------------------------------------------------------- + ! read namelist options + !----------------------------------------------------------------------------- + subroutine mee_fluxes_readnl(nlfile) + + use namelist_utils, only: find_group_name + use spmd_utils, only: mpicom, mpi_character, mpi_logical, masterprocid + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'mee_fluxes_readnl' + + namelist /mee_fluxes_opts/ mee_fluxes_filepath, mee_fluxes_fillin + + ! Read namelist + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'mee_fluxes_opts', status=ierr) + if (ierr == 0) then + read(unitn, mee_fluxes_opts, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(mee_fluxes_filepath, len(mee_fluxes_filepath), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(mee_fluxes_fillin, 1, mpi_logical, masterprocid, mpicom, ierr) + + mee_fluxes_active = mee_fluxes_filepath /= 'NONE' + + if ( masterproc ) then + if ( mee_fluxes_active ) then + write(iulog,*) subname//':: Input electron fluxes filepath: '//trim(mee_fluxes_filepath) + write(iulog,*) subname//':: Fill in missing fluxes with vdk-derived fluxes: ', mee_fluxes_fillin + else + write(iulog,*) subname//':: Electron fluxes are not prescribed' + end if + end if + + end subroutine mee_fluxes_readnl + + !----------------------------------------------------------------------------- + ! intialize -- allocate memory and read coordinate data + !----------------------------------------------------------------------------- + subroutine mee_fluxes_init() + use cam_pio_utils, only : cam_pio_openfile + use ioFileMod, only : getfil + + character(len=cl) :: filen + integer :: ierr, dimid, varid + real(r8), allocatable :: logdelta(:) + character(len=*), parameter :: subname = 'mee_fluxes_init: ' + + if (.not.mee_fluxes_active) return + + call time_coord%initialize( mee_fluxes_filepath, force_time_interp=.true. ) + + call getfil( mee_fluxes_filepath, filen, 0 ) + call cam_pio_openfile( file_id, filen, PIO_NOWRITE ) + + ierr = pio_inq_dimid(file_id, 'energy', dimid) + ierr = pio_inq_dimlen(file_id, dimid, mee_fluxes_nenergy ) + + ierr = pio_inq_dimid(file_id, 'lshell', dimid) + ierr = pio_inq_dimlen(file_id, dimid, nlshells ) + + ierr = pio_inq_varid(file_id, 'RBSP_flux_scaled', flux_var_id) + + allocate( indata( mee_fluxes_nenergy, nlshells, 2 ), stat=ierr) + if (ierr/=0) call endrun(subname//'not able to allocate indata') + allocate( influx( mee_fluxes_nenergy, nlshells ), stat=ierr ) + if (ierr/=0) call endrun(subname//'not able to allocate influx') + allocate( valflx( mee_fluxes_nenergy, nlshells ), stat=ierr ) + if (ierr/=0) call endrun(subname//'not able to allocate valflx') + allocate( mee_fluxes_energy( mee_fluxes_nenergy ), stat=ierr ) + if (ierr/=0) call endrun(subname//'not able to allocate mee_fluxes_energy') + allocate( mee_fluxes_denergy( mee_fluxes_nenergy ), stat=ierr ) + if (ierr/=0) call endrun(subname//'not able to allocate mee_fluxes_denergy') + allocate( logdelta( mee_fluxes_nenergy ), stat=ierr ) + if (ierr/=0) call endrun(subname//'not able to allocate logdelta') + allocate( lshell( nlshells ), stat=ierr ) + if (ierr/=0) call endrun(subname//'not able to allocate lshell') + + + ierr = pio_inq_varid(file_id, 'energy', varid) + ierr = pio_get_var( file_id, varid, mee_fluxes_energy) + + ierr = pio_inq_varid(file_id, 'lshell', varid) + ierr = pio_get_var( file_id, varid, lshell) + + logdelta(2:) = log(mee_fluxes_energy(2:mee_fluxes_nenergy))-log(mee_fluxes_energy(1:mee_fluxes_nenergy-1)) + logdelta(1) = logdelta(2) + mee_fluxes_denergy(:) = exp( log(mee_fluxes_energy(:)) + 0.5_r8*logdelta(:) ) & + - exp( log(mee_fluxes_energy(:)) - 0.5_r8*logdelta(:) ) + + deallocate(logdelta) + + call read_fluxes() + + end subroutine mee_fluxes_init + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine mee_fluxes_final() + use cam_pio_utils, only : cam_pio_closefile + + if (.not.mee_fluxes_active) return + + call cam_pio_closefile(file_id) + + deallocate(indata) + deallocate(influx) + deallocate(valflx) + deallocate(lshell) + + deallocate(mee_fluxes_energy) + deallocate(mee_fluxes_denergy) + + nullify(mee_fluxes_energy) + nullify(mee_fluxes_denergy) + + end subroutine mee_fluxes_final + + !----------------------------------------------------------------------------- + ! time interpolate the input fluxes + ! reads data as needed + !----------------------------------------------------------------------------- + subroutine mee_fluxes_adv + + if (.not.mee_fluxes_active) return + + call time_coord%advance() + + if ( time_coord%read_more() ) then + call read_fluxes( ) + endif + + influx(:,:) = 0._r8 + + valflx(:,:) = (.not.isnan(indata(:,:,1))) .and. (.not.isnan(indata(:,:,2))) + where ( valflx(:,:) ) + influx(:,:) = time_coord%wghts(1)*indata(:,:,1) + time_coord%wghts(2)*indata(:,:,2) + end where + + if (any(isnan(influx))) then + call endrun('mee_fluxes_adv -- influx has NaNs') + end if + + end subroutine mee_fluxes_adv + + !----------------------------------------------------------------------------- + ! linear interpolate fluxes in L-shell where the fluxes are valid + !----------------------------------------------------------------------------- + subroutine mee_fluxes_extract( l_shell, fluxes, valid ) + + real(r8), intent(in) :: l_shell + real(r8), intent(out) :: fluxes(mee_fluxes_nenergy) + logical, intent(out) :: valid(mee_fluxes_nenergy) + + integer :: i, ndx1, ndx2 + logical :: found + real(r8) :: wght1,wght2 + + valid(:) = .not. mee_fluxes_fillin + fluxes(:) = 0._r8 + + if (.not.mee_fluxes_active) return + + found = .false. + + findloop: do i = 1,nlshells-1 + if ( l_shell>=lshell(i) .and. l_shell<=lshell(i+1) ) then + ndx1=i + ndx2=i+1 + wght2 = (l_shell-lshell(ndx1))/(lshell(ndx2)-lshell(ndx1)) + wght1 = 1._r8 - wght2 + found = .true. + exit findloop + endif + end do findloop + + if (found) then + if (mee_fluxes_fillin) then + valid(:) = valflx(:,ndx1) .and. valflx(:,ndx2) + end if + where( valid(:) ) + fluxes(:) = wght1*influx(:,ndx1) + wght2*influx(:,ndx2) + end where + end if + + end subroutine mee_fluxes_extract + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine read_fluxes() + + ! local vars + integer :: ierr, cnt(4), start(4) + + cnt = (/1, mee_fluxes_nenergy, nlshells, 2/) + + ! use the 50 percentile level data ( index 3 ) + start = (/3, 1, 1, time_coord%indxs(1)/) + + ! float RBSP_flux_scaled(time, lshell, energy, percentiles) ; + ierr = pio_get_var( file_id, flux_var_id, start, cnt, indata ) + + end subroutine read_fluxes + +end module mee_fluxes diff --git a/src/chemistry/mozart/mee_ionization.F90 b/src/chemistry/mozart/mee_ionization.F90 new file mode 100644 index 0000000000..5e7adacb2c --- /dev/null +++ b/src/chemistry/mozart/mee_ionization.F90 @@ -0,0 +1,163 @@ +!-------------------------------------------------------------------------- +! CAM interface layer for inline computation of atmosphere ionization rates +! due to medium energy electrons in the magnetosphere radiation belts impacting +! the atmosphere. Fluxes of electrons incident on the upper atmosphere can +! be computed based on Ap or read from file. +!-------------------------------------------------------------------------- +module mee_ionization + use shr_kind_mod, only: r8 => shr_kind_r8 + use solar_parms_data, only: Ap=>solar_parms_ap ! geomag activity index + use mo_apex, only: alatm ! mag latitude at each column (radians) + use ppgrid, only: pcols, pver + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use mee_ap_util_mod,only: mee_ap_init, mee_ap_error, mee_ap_iprs + + implicit none + + private + public :: mee_ion_readnl + public :: mee_ion_init + public :: mee_ion_final + public :: mee_ionpairs + + logical :: mee_ion_inline = .false. + logical :: mee_ion_diagonly = .false. + real(r8) :: mee_ion_blc = -huge(1._r8) ! bounce cone angle (degrees) + +contains + + !----------------------------------------------------------------------------- + ! reads namelist options + !----------------------------------------------------------------------------- + subroutine mee_ion_readnl(nlfile) + + use namelist_utils, only: find_group_name + use spmd_utils, only: mpicom, mpi_logical, mpi_real8, masterprocid + use mee_fluxes, only: mee_fluxes_readnl + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'mee_ion_readnl' + + namelist /mee_ion_nl/ mee_ion_inline, mee_ion_blc, mee_ion_diagonly + + + ! Read namelist + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'mee_ion_nl', status=ierr) + if (ierr == 0) then + read(unitn, mee_ion_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(mee_ion_inline, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(mee_ion_blc, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(mee_ion_diagonly, 1, mpi_logical, masterprocid, mpicom, ierr) + if ( masterproc ) then + write(iulog,*) subname//':: mee_ion_inline = ', mee_ion_inline + if (mee_ion_inline) then + write(iulog,*) subname//':: mee_ion_blc = ', mee_ion_blc + write(iulog,*) subname//':: mee_ion_diagonly = ', mee_ion_diagonly + endif + endif + + if (mee_ion_inline) then + call mee_fluxes_readnl(nlfile) + end if + + end subroutine mee_ion_readnl + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine mee_ion_init() + use cam_history, only: addfld + use mee_fluxes, only: mee_fluxes_init + + integer :: err + + if (.not.mee_ion_inline) return + + call mee_fluxes_init() + call mee_ap_init(mee_ion_blc,err) + if (err==mee_ap_error) then + call endrun('mee_ion_init: not able to initialize Ap based MEE ionization') + endif + + call addfld( 'APMEEionprs', (/ 'lev' /), 'A', 'pairs/cm3/sec', 'Ap generated MEE ionization rate' ) + end subroutine mee_ion_init + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine mee_ion_final() + use mee_fluxes, only: mee_fluxes_final + use mee_ap_util_mod, only: mee_ap_final + + if (.not.mee_ion_inline) return + + call mee_fluxes_final() + call mee_ap_final() + + end subroutine mee_ion_final + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine mee_ionpairs(ncol, lchnk, pmid, alt, temp, ionpairs) + + use air_composition, only: mbarv ! kg/kmole + use physconst, only: gravit + use air_composition, only: rairv ! composition dependent gas constant (J/K/kg) + use physconst, only: boltz ! Boltzman's constant (J/K/molecule) + use physconst, only: avogad ! Avogadro's number (molecules/kmole) + use physconst, only: rearth ! radius of earth (m) + use cam_history, only: outfld + + integer, intent(in) :: ncol,lchnk + real(r8), intent(in) :: pmid(:,:) + real(r8), intent(in) :: alt(:,:) ! meters + real(r8), intent(in) :: temp(:,:) + real(r8), intent(out) :: ionpairs(:,:) ! ion pairs /cm3/sec + + real(r8) :: rho(pcols,pver) + real(r8) :: scaleh(pcols,pver) + real(r8) :: grvty(pcols,pver) + integer :: err + + if (.not.mee_ion_inline) then + ionpairs(:,:) = 0._r8 + return + end if + + rho(:ncol,:) = pmid(:ncol,:)/(rairv(:ncol,:,lchnk)*temp(:ncol,:)) ! kg/m3 + rho(:ncol,:) = rho(:ncol,:)*1.0e-3_r8 ! kg/m3 --> g/cm3 + + grvty(:ncol,:) = gravit * ( (rearth/(rearth+alt(:ncol,:)))**2 ) + + scaleh(:ncol,:) = avogad * boltz*temp(:ncol,:)/(mbarv(:ncol,:,lchnk)*grvty(:ncol,:)) ! m + scaleh(:ncol,:) = scaleh(:ncol,:) * 1.0e2_r8 ! m -> cm + + call mee_ap_iprs(ncol, pver, rho(:ncol,:), scaleh(:ncol,:), Ap, ionpairs(:ncol,:), & + status=err, maglat=alatm(:ncol,lchnk)) + if (err==mee_ap_error) then + call endrun('mee_ionpairs: error in Ap based MEE ionization calculation') + end if + + call outfld( 'APMEEionprs', ionpairs(:ncol,:), ncol, lchnk ) + + if (mee_ion_diagonly) then + ionpairs(:,:) = 0._r8 + end if + + end subroutine mee_ionpairs + + +end module mee_ionization diff --git a/src/chemistry/mozart/mo_airplane.F90 b/src/chemistry/mozart/mo_airplane.F90 index 5c4a9a3369..635e6fefc8 100644 --- a/src/chemistry/mozart/mo_airplane.F90 +++ b/src/chemistry/mozart/mo_airplane.F90 @@ -131,7 +131,7 @@ subroutine airpl_src( airpl_emis_file ) use chem_mods, only : adv_mass use ioFileMod, only : getfil use mo_chem_utls, only : get_spc_ndx, get_extfrc_ndx - use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p, ngcols_p + use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p use ppgrid, only : begchunk, endchunk, pcols use mo_constants, only : pi, d2r, rearth use gmean_mod, only : gmean @@ -146,7 +146,7 @@ subroutine airpl_src( airpl_emis_file ) ! ... Local variables !----------------------------------------------------------------------- real(r8), parameter :: msq2cmsq = 1.e4_r8, zero=0._r8, twopi=2._r8*pi - integer :: ios, k, j + integer :: k integer :: nlat, nlon, nlev, ndims integer :: ierr type(file_desc_t) :: piofile diff --git a/src/chemistry/mozart/mo_apex.F90 b/src/chemistry/mozart/mo_apex.F90 index b38d26df4f..f42d8060df 100644 --- a/src/chemistry/mozart/mo_apex.F90 +++ b/src/chemistry/mozart/mo_apex.F90 @@ -4,19 +4,19 @@ module mo_apex ! Purpose: ! ! Calculate apex coordinates and magnetic field magnitudes -! at global geographic grid for year of current model run. +! at global geographic grid for year of current model run. ! -! Method: +! Method: ! ! The magnetic field parameters output by this module are time and height -! independent. They are chunked for waccm physics, i.e., allocated as +! independent. They are chunked for waccm physics, i.e., allocated as ! (pcols,begchunk:endchunk) ! Interface sub apexmag is called once per run from sub inti. ! Sub apexmag may be called for years 1900 through 2005. ! This module is dependent on routines in apex_subs.F (modified IGRF model). ! Apex_subs has several authors, but has been modified and maintained ! in recent years by Roy Barnes (bozo@ucar.edu). -! Subs apxmka and apxmall are called with the current lat x lon grid +! Subs apxmka and apxmall are called with the current lat x lon grid ! resolution. ! ! Author: Ben Foster, foster@ucar.edu (Nov, 2003) @@ -110,7 +110,7 @@ end subroutine mo_apex_readnl !====================================================================== subroutine mo_apex_init1() use time_manager, only: get_curr_date - use dyn_grid, only: get_horiz_grid_dim_d + use phys_grid, only: get_grid_dims integer :: i, j, ist ! indices @@ -155,7 +155,7 @@ subroutine mo_apex_init1() ! Initialize APEX with a regular lat/lon grid ... ! (Note apex_mka expects longitudes in -180 -> +180) !------------------------------------------------------------------------------- - call get_horiz_grid_dim_d(hdim1_d,hdim2_d) + call get_grid_dims(hdim1_d,hdim2_d) ngcols = hdim1_d*hdim2_d if ( ngcols < 1000 ) then ! 10-degrees nglats = 19 @@ -205,7 +205,7 @@ end subroutine mo_apex_init1 !====================================================================== subroutine mo_apex_init(phys_state) !------------------------------------------------------------------------------- -! Driver for apex code to calculate apex magnetic coordinates at +! Driver for apex code to calculate apex magnetic coordinates at ! current geographic spatial resolution for given year. This calls ! routines in apex_subs.F. ! @@ -311,7 +311,7 @@ subroutine mo_apex_init(phys_state) maglon0 = -alon*dtr ! (radians) geograghic latitude where the geomagnetic latitude is zero ! where longitude ranges from -180E to 180E - call apex_dypol( colatp, elonp, rdum ) ! get geomagnetic dipole north pole + call apex_dypol( colatp, elonp, rdum ) ! get geomagnetic dipole north pole if (masterproc) then write(iulog, "('mo_apex_init: colatp,elonp ', 2f12.6)") colatp, elonp diff --git a/src/chemistry/mozart/mo_chem_utls.F90 b/src/chemistry/mozart/mo_chem_utls.F90 index 1620422e12..dbed06c9e8 100644 --- a/src/chemistry/mozart/mo_chem_utls.F90 +++ b/src/chemistry/mozart/mo_chem_utls.F90 @@ -8,29 +8,43 @@ module mo_chem_utls contains - integer function get_spc_ndx( spc_name ) + integer function get_spc_ndx( spc_name, ignore_case ) !----------------------------------------------------------------------- ! ... return overall species index associated with spc_name !----------------------------------------------------------------------- use chem_mods, only : gas_pcnst use mo_tracname, only : tracnam => solsym + use string_utils, only : to_upper implicit none !----------------------------------------------------------------------- ! ... dummy arguments !----------------------------------------------------------------------- - character(len=*), intent(in) :: spc_name + character(len=*), intent(in) :: spc_name + logical, intent(in), optional :: ignore_case !----------------------------------------------------------------------- ! ... local variables !----------------------------------------------------------------------- integer :: m + logical :: convert_to_upper + logical :: match + + convert_to_upper = .false. + if ( present( ignore_case ) ) then + convert_to_upper = ignore_case + endif get_spc_ndx = -1 do m = 1,gas_pcnst - if( trim( spc_name ) == trim( tracnam(m) ) ) then + if ( .not. convert_to_upper ) then + match = trim( spc_name ) == trim( tracnam(m) ) + else + match = trim( to_upper( spc_name ) ) == trim( to_upper( tracnam(m) ) ) + endif + if( match ) then get_spc_ndx = m exit end if diff --git a/src/chemistry/mozart/mo_chemini.F90 b/src/chemistry/mozart/mo_chemini.F90 index 2b0a3d6cee..0f4005be96 100644 --- a/src/chemistry/mozart/mo_chemini.F90 +++ b/src/chemistry/mozart/mo_chemini.F90 @@ -21,6 +21,7 @@ subroutine chemini & , xs_coef_file & , xs_short_file & , xs_long_file & + , photo_max_zen & , rsf_file & , fstrat_file & , fstrat_list & @@ -34,11 +35,8 @@ subroutine chemini & , ext_frc_cycle_yr & , ext_frc_fixed_ymd & , ext_frc_fixed_tod & - , xactive_prates & , exo_coldens_file & - , tuv_xsect_file & - , o2_xsect_file & - , lght_no_prd_factor & + , use_hemco & , pbuf2d & ) @@ -50,23 +48,21 @@ subroutine chemini & use mo_srf_emissions, only : srf_emissions_inti use mo_sulf, only : sulf_inti use mo_photo, only : photo_inti - use mo_lightning, only : lightning_inti use mo_drydep, only : drydep_inti - use seq_drydep_mod, only : DD_XLND, drydep_method use mo_imp_sol, only : imp_slv_inti use mo_exp_sol, only : exp_sol_inti use spmd_utils, only : iam use mo_fstrat, only : fstrat_inti use mo_sethet, only : sethet_inti use mo_usrrxt, only : usrrxt_inti + use hco_cc_emissions, only : hco_extfrc_inti use mo_extfrc, only : extfrc_inti use mo_setext, only : setext_inti use mo_setinv, only : setinv_inti use mo_gas_phase_chemdr,only: gas_phase_chemdr_inti - + use tracer_cnst, only : tracer_cnst_init use tracer_srcs, only : tracer_srcs_init - use mo_chem_utls, only : get_spc_ndx use mo_airglow, only : init_airglow use mo_mean_mass, only : init_mean_mass use mo_mass_xforms, only : init_mass_xforms @@ -78,7 +74,7 @@ subroutine chemini & use mo_waccm_hrates, only : init_hrates use mo_aurora, only : aurora_inti use clybry_fam, only : clybry_fam_init - use mo_neu_wetdep, only : neu_wetdep_init + use mo_neu_wetdep, only : neu_wetdep_init use physics_buffer, only : physics_buffer_desc use cam_abortutils, only : endrun @@ -91,16 +87,13 @@ subroutine chemini & character(len=*), intent(in) :: xs_coef_file character(len=*), intent(in) :: xs_short_file character(len=*), intent(in) :: xs_long_file + real(r8), intent(in) :: photo_max_zen character(len=*), intent(in) :: rsf_file character(len=*), intent(in) :: fstrat_file character(len=*), intent(in) :: fstrat_list(:) character(len=*), dimension(:), intent(in) :: srf_emis_specifier character(len=*), dimension(:), intent(in) :: ext_frc_specifier - logical, intent(in) :: xactive_prates character(len=*), intent(in) :: exo_coldens_file - character(len=*), intent(in) :: tuv_xsect_file - character(len=*), intent(in) :: o2_xsect_file - real(r8), intent(in) :: lght_no_prd_factor character(len=*), intent(in) :: ext_frc_type integer, intent(in) :: ext_frc_cycle_yr integer, intent(in) :: ext_frc_fixed_ymd @@ -109,6 +102,7 @@ subroutine chemini & integer, intent(in) :: srf_emis_cycle_yr integer, intent(in) :: srf_emis_fixed_ymd integer, intent(in) :: srf_emis_fixed_tod + logical, intent(in) :: use_hemco type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -155,8 +149,15 @@ subroutine chemini & ! ... initialize external forcings module !----------------------------------------------------------------------- call setext_inti() - call extfrc_inti(ext_frc_specifier, ext_frc_type, ext_frc_cycle_yr, ext_frc_fixed_ymd, ext_frc_fixed_tod) - if (masterproc) write(iulog,*) 'chemini: after extfrc_inti on node ',iam + + if ( use_hemco ) then + ! Initialize HEMCO version of extfrc_inti + call hco_extfrc_inti() + if (masterproc) write(iulog,*) 'chemini: after hco_extfrc_inti on node ',iam + else + call extfrc_inti(ext_frc_specifier, ext_frc_type, ext_frc_cycle_yr, ext_frc_fixed_ymd, ext_frc_fixed_tod) + if (masterproc) write(iulog,*) 'chemini: after extfrc_inti on node ',iam + endif call sulf_inti() if (masterproc) write(iulog,*) 'chemini: after sulf_inti on node ',iam @@ -167,20 +168,10 @@ subroutine chemini & call sad_inti(pbuf2d) if (masterproc) write(iulog,*) 'chemini: after sad_inti on node ',iam - !----------------------------------------------------------------------- - ! ... initialize the lightning module - !----------------------------------------------------------------------- - call lightning_inti(lght_no_prd_factor) - if (masterproc) write(iulog,*) 'chemini: after lightning_inti on node ',iam - !----------------------------------------------------------------------- ! ... initialize the dry deposition module !----------------------------------------------------------------------- - if ( drydep_method == DD_XLND ) then - call drydep_inti(depvel_lnd_file) - else - call endrun('chemini: drydep_method must equal DD_XLND') - endif + call drydep_inti(depvel_lnd_file) if (masterproc) write(iulog,*) 'chemini: after drydep_inti on node ',iam @@ -206,7 +197,7 @@ subroutine chemini & call photo_inti( xs_coef_file, xs_short_file, xs_long_file, rsf_file, & photon_file, electron_file, & - exo_coldens_file, tuv_xsect_file, o2_xsect_file, xactive_prates ) + exo_coldens_file, photo_max_zen ) if (masterproc) write(iulog,*) 'chemini: after photo_inti on node ',iam diff --git a/src/chemistry/mozart/mo_chm_diags.F90 b/src/chemistry/mozart/mo_chm_diags.F90 index 920e4942d3..1a11b2b39d 100644 --- a/src/chemistry/mozart/mo_chm_diags.F90 +++ b/src/chemistry/mozart/mo_chm_diags.F90 @@ -10,6 +10,7 @@ module mo_chm_diags use cam_history, only : fieldname_len use mo_jeuv, only : neuv use gas_wetdep_opts,only : gas_wetdep_method + use mo_drydep, only : has_drydep implicit none private @@ -17,6 +18,7 @@ module mo_chm_diags public :: chm_diags_inti public :: chm_diags public :: het_diags + public :: chm_prod_ndep_flx integer :: id_n,id_no,id_no2,id_no3,id_n2o5,id_hno3,id_ho2no2,id_clono2,id_brono2 integer :: id_isopfdn, id_isopfdnc, id_terpfdn !these are dinitrates @@ -54,6 +56,8 @@ module mo_chm_diags real(r8), parameter :: N_molwgt = 14.00674_r8 real(r8), parameter :: S_molwgt = 32.066_r8 + logical, protected :: chm_prod_ndep_flx =.false. + contains subroutine chm_diags_inti @@ -64,13 +68,12 @@ subroutine chm_diags_inti use cam_history, only : addfld, add_default, horiz_only use constituents, only : cnst_get_ind, cnst_longname use phys_control, only : phys_getopts - use mo_drydep, only : has_drydep use species_sums_diags, only : species_sums_init integer :: j, k, m, n character(len=16) :: jname, spc_name, attr character(len=2) :: jchar - character(len=2) :: unit_basename ! Units 'kg' or '1' + character(len=2) :: unit_basename ! Units 'kg' or '1' integer :: id_pan, id_onit, id_mpan, id_isopno3, id_onitr, id_nh4no3 integer :: id_so2, id_so4, id_h2so4 @@ -89,7 +92,7 @@ subroutine chm_diags_inti integer :: id_dst01, id_dst02, id_dst03, id_dst04, id_sslt01, id_sslt02, id_sslt03, id_sslt04 integer :: id_soa, id_oc1, id_oc2, id_cb1, id_cb2 integer :: id_soam,id_soai,id_soat,id_soab,id_soax - integer :: id_bry, id_cly + integer :: id_bry, id_cly integer :: id_isopn2b, id_isopn3b, id_isopn1d, id_isopn4d, id_isopnbno3 integer :: id_isopfnp, id_isopnoohb, id_isopnoohd, id_inheb, id_inhed integer :: id_no3ch2cho, id_macrn, id_mvkn, id_isopfnc, id_terpns @@ -195,17 +198,17 @@ subroutine chm_diags_inti id_onitr = get_spc_ndx( 'ONITR' ) id_nh4no3 = get_spc_ndx( 'NH4NO3' ) - id_honitr = get_spc_ndx( 'HONITR' ) - id_alknit = get_spc_ndx( 'ALKNIT' ) - id_isopnita = get_spc_ndx( 'ISOPNITA' ) - id_isopnitb = get_spc_ndx( 'ISOPNITB' ) - id_isopnooh = get_spc_ndx( 'ISOPNOOH' ) - id_nc4ch2oh = get_spc_ndx( 'NC4CH2OH' ) - id_nc4cho = get_spc_ndx( 'NC4CHO' ) - id_noa = get_spc_ndx( 'NOA' ) - id_nterpooh = get_spc_ndx( 'NTERPOOH' ) + id_honitr = get_spc_ndx( 'HONITR' ) + id_alknit = get_spc_ndx( 'ALKNIT' ) + id_isopnita = get_spc_ndx( 'ISOPNITA' ) + id_isopnitb = get_spc_ndx( 'ISOPNITB' ) + id_isopnooh = get_spc_ndx( 'ISOPNOOH' ) + id_nc4ch2oh = get_spc_ndx( 'NC4CH2OH' ) + id_nc4cho = get_spc_ndx( 'NC4CHO' ) + id_noa = get_spc_ndx( 'NOA' ) + id_nterpooh = get_spc_ndx( 'NTERPOOH' ) id_pbznit = get_spc_ndx( 'PBZNIT' ) - id_terpnit = get_spc_ndx( 'TERPNIT' ) + id_terpnit = get_spc_ndx( 'TERPNIT' ) id_ndep = get_spc_ndx( 'NDEP' ) id_nhdep = get_spc_ndx( 'NHDEP' ) @@ -278,9 +281,9 @@ subroutine chm_diags_inti noy_species = (/ id_n, id_no, id_no2, id_no3, id_n2o5, id_hno3, id_ho2no2, id_clono2, & id_brono2, id_pan, id_onit, id_mpan, id_isopno3, id_onitr, id_nh4no3, & id_honitr, id_alknit, id_isopnita, id_isopnitb, id_isopnooh, id_nc4ch2oh, & - id_nc4cho, id_noa, id_nterpooh, id_pbznit, id_terpnit, & + id_nc4cho, id_noa, id_nterpooh, id_pbznit, id_terpnit, & id_isopn2b, id_isopn3b, id_isopn1d, id_isopn4d, id_isopnbno3, & - id_isopfdn, id_isopfdnc, id_terpfdn, & + id_isopfdn, id_isopfdnc, id_terpfdn, & id_isopfnp, id_isopnoohb, id_isopnoohd, id_inheb, id_inhed, & id_no3ch2cho, id_macrn, id_mvkn, id_isopfnc, id_terpns, & id_terpnt, id_terpnt1, id_terpns1, id_terpnpt, id_terpnps, & @@ -330,9 +333,11 @@ subroutine chm_diags_inti toth_species = (/ id_ch4, id_h2o, id_h2 /) + chm_prod_ndep_flx = any(noy_species>0) .or. any(nhx_species>0) + call addfld( 'NOX', (/ 'lev' /), 'A', 'mol/mol', 'nox (N+NO+NO2)' ) call addfld( 'NOY', (/ 'lev' /), 'A', 'mol/mol', & - 'noy = total nitrogen (N+NO+NO2+NO3+2N2O5+HNO3+HO2NO2+ORGNOY+NH4NO3' ) + 'noy = total nitrogen (N+NO+NO2+NO3+2N2O5+HNO3+HO2NO2+ORGNOY+NH4NO3)' ) call addfld( 'NOY_SRF', horiz_only, 'A', 'mol/mol', 'surface noy volume mixing ratio' ) call addfld( 'HOX', (/ 'lev' /), 'A', 'mol/mol', 'HOx (H+OH+HO2+2H2O2)' ) @@ -340,7 +345,7 @@ subroutine chm_diags_inti call addfld( 'BROY', (/ 'lev' /), 'A', 'mol/mol', 'total inorganic bromine (Br+BrO+HOBr+BrONO2+HBr+BrCl)' ) call addfld( 'TBRY', (/ 'lev' /), 'A', 'mol/mol', 'total Br (ORG+INORG) volume mixing ratio' ) - call addfld( 'CLOX', (/ 'lev' /), 'A', 'mol/mol', 'clox (Cl+CLO+HOCl+2Cl2+2Cl2O2+OClO' ) + call addfld( 'CLOX', (/ 'lev' /), 'A', 'mol/mol', 'clox (Cl+CLO+HOCl+2Cl2+2Cl2O2+OClO)' ) call addfld( 'CLOY', (/ 'lev' /), 'A', 'mol/mol', 'total inorganic chlorine (Cl+ClO+2Cl2+2Cl2O2+OClO+HOCl+ClONO2+HCl+BrCl)' ) call addfld( 'TCLY', (/ 'lev' /), 'A', 'mol/mol', 'total Cl (ORG+INORG) volume mixing ratio' ) @@ -402,16 +407,17 @@ subroutine chm_diags_inti attr = spc_name endif - depvel_name(m) = 'DV_'//trim(spc_name) - depflx_name(m) = 'DF_'//trim(spc_name) dtchem_name(m) = 'D'//trim(spc_name)//'CHM' - - call addfld( depvel_name(m), horiz_only, 'A', 'cm/s', 'deposition velocity ' ) - call addfld( depflx_name(m), horiz_only, 'A', 'kg/m2/s', 'dry deposition flux ' ) call addfld( dtchem_name(m), (/ 'lev' /), 'A', 'kg/s', 'net tendency from chem' ) - if (has_drydep(spc_name).and.history_chemistry) then - call add_default( depflx_name(m), 1, ' ' ) + depvel_name(m) = 'DV_'//trim(spc_name) + depflx_name(m) = 'DF_'//trim(spc_name) + if (has_drydep(spc_name)) then + call addfld( depvel_name(m), horiz_only, 'A', 'cm/s', 'deposition velocity ' ) + call addfld( depflx_name(m), horiz_only, 'A', 'kg/m2/s', 'dry deposition flux ' ) + if (history_chemistry) then + call add_default( depflx_name(m), 1, ' ' ) + endif endif if (gas_wetdep_method=='MOZ') then @@ -439,7 +445,7 @@ subroutine chm_diags_inti if ((m /= id_cly) .and. (m /= id_bry)) then if (history_aerosol.or.history_chemistry) then call add_default( spc_name, 1, ' ' ) - endif + endif if (history_chemspecies_srf) then call add_default( trim(spc_name)//'_SRF', 1, ' ' ) endif @@ -510,7 +516,7 @@ subroutine chm_diags( lchnk, ncol, vmr, mmr, rxt_rates, invariants, depvel, depf !-------------------------------------------------------------------- ! ... utility routine to output chemistry diagnostic variables !-------------------------------------------------------------------- - + use cam_history, only : outfld use phys_grid, only : get_area_all_p use species_sums_diags, only : species_sums_output @@ -546,7 +552,7 @@ subroutine chm_diags( lchnk, ncol, vmr, mmr, rxt_rates, invariants, depvel, depf ! real(r8) :: tmp(ncol,pver) ! real(r8) :: m(ncol,pver) real(r8) :: un2(ncol) - + real(r8), dimension(ncol,pver) :: vmr_nox, vmr_noy, vmr_clox, vmr_cloy, vmr_tcly, vmr_brox, vmr_broy, vmr_toth real(r8), dimension(ncol,pver) :: vmr_tbry, vmr_foy, vmr_tfy real(r8), dimension(ncol,pver) :: mmr_noy, mmr_sox, mmr_nhx, net_chem @@ -673,7 +679,7 @@ subroutine chm_diags( lchnk, ncol, vmr, mmr, rxt_rates, invariants, depvel, depf if ( any( hox_species == m ) ) then vmr_hox(:ncol,:) = vmr_hox(:ncol,:) + wgt * vmr(:ncol,:,m) endif - + if ( any( aer_species == m ) ) then call outfld( solsym(m), mmr(:ncol,:,m), ncol ,lchnk ) call outfld( trim(solsym(m))//'_SRF', mmr(:ncol,pver,m), ncol ,lchnk ) @@ -682,8 +688,10 @@ subroutine chm_diags( lchnk, ncol, vmr, mmr, rxt_rates, invariants, depvel, depf call outfld( trim(solsym(m))//'_SRF', vmr(:ncol,pver,m), ncol ,lchnk ) endif - call outfld( depvel_name(m), depvel(:ncol,m), ncol ,lchnk ) - call outfld( depflx_name(m), depflx(:ncol,m), ncol ,lchnk ) + if (has_drydep(solsym(m))) then + call outfld( depvel_name(m), depvel(:ncol,m), ncol ,lchnk ) + call outfld( depflx_name(m), depflx(:ncol,m), ncol ,lchnk ) + endif if ( any( noy_species == m ) ) then df_noy(:ncol) = df_noy(:ncol) + wgt * depflx(:ncol,m)*N_molwgt/adv_mass(m) @@ -705,15 +713,15 @@ subroutine chm_diags( lchnk, ncol, vmr, mmr, rxt_rates, invariants, depvel, depf ! add contribution from non-conservation tracers ! if ( id_ndep == m ) then - wd_noy(:ncol) = wd_noy(:ncol) + wgt * wetdepflx(:ncol,m)*N_molwgt/adv_mass(m) + wd_noy(:ncol) = wd_noy(:ncol) + wgt * wetdepflx(:ncol,m)*N_molwgt/adv_mass(m) end if if ( id_nhdep == m ) then - wd_nhx(:ncol) = wd_nhx(:ncol) + wgt * wetdepflx(:ncol,m)*N_molwgt/adv_mass(m) + wd_nhx(:ncol) = wd_nhx(:ncol) + wgt * wetdepflx(:ncol,m)*N_molwgt/adv_mass(m) end if do k=1,pver do i=1,ncol - net_chem(i,k) = mmr_tend(i,k,m) * mass(i,k) + net_chem(i,k) = mmr_tend(i,k,m) * mass(i,k) end do end do call outfld( dtchem_name(m), net_chem(:ncol,:), ncol, lchnk ) @@ -769,7 +777,7 @@ subroutine chm_diags( lchnk, ncol, vmr, mmr, rxt_rates, invariants, depvel, depf call outfld( 'DF_SOX', df_sox(:ncol), ncol ,lchnk ) call outfld( 'dry_deposition_NHx_as_N', df_nhx(:ncol), ncol ,lchnk ) if (gas_wetdep_method=='NEU') then - wd_noy(:ncol) = -wd_noy(:ncol) ! downward is possitive + wd_noy(:ncol) = -wd_noy(:ncol) ! downward is possitive wd_nhx(:ncol) = -wd_nhx(:ncol) call outfld( 'wet_deposition_NOy_as_N', wd_noy(:ncol), ncol, lchnk ) call outfld( 'wet_deposition_NHx_as_N', wd_nhx(:ncol), ncol, lchnk ) @@ -903,7 +911,7 @@ subroutine het_diags( het_rates, mmr, pdel, lchnk, ncol ) ! wrk_wd(:ncol) = 0._r8 do k = 1,pver - wrk_wd(:ncol) = wrk_wd(:ncol) + het_rates(:ncol,k,m) * mmr(:ncol,k,m) * pdel(:ncol,k) + wrk_wd(:ncol) = wrk_wd(:ncol) + het_rates(:ncol,k,m) * mmr(:ncol,k,m) * pdel(:ncol,k) end do ! wrk_wd(:ncol) = wrk_wd(:ncol) * rgrav * wght(:ncol) * rearth**2 diff --git a/src/chemistry/mozart/mo_drydep.F90 b/src/chemistry/mozart/mo_drydep.F90 index 60e084d3db..12e1d3e0a9 100644 --- a/src/chemistry/mozart/mo_drydep.F90 +++ b/src/chemistry/mozart/mo_drydep.F90 @@ -1,7 +1,7 @@ module mo_drydep !--------------------------------------------------------------------- - ! ... Dry deposition + ! ... Dry deposition !--------------------------------------------------------------------- use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl @@ -18,7 +18,7 @@ module mo_drydep use dyn_grid, only : get_dyn_grid_parm, get_horiz_grid_d use scamMod, only : single_column - use seq_drydep_mod, only : nddvels => n_drydep, drydep_list, mapping + use shr_drydep_mod, only : nddvels => n_drydep, drydep_list, mapping use physconst, only : karman use infnan, only : nan, assignment(=) @@ -69,8 +69,6 @@ module mo_drydep real(r8), parameter :: ph_inv = 1._r8/ph real(r8), parameter :: rovcp = r/cp - integer, pointer :: index_season_lai(:,:) - logical, public :: has_dvel(gas_pcnst) = .false. integer :: map_dvel(gas_pcnst) = 0 @@ -80,7 +78,7 @@ module mo_drydep integer, parameter :: n_land_type = 11 integer, allocatable :: spc_ndx(:) ! nddvels - real(r8), public :: crb + real(r8), public :: crb type lnd_dvel_type real(r8), pointer :: dvel(:,:) ! deposition velocity over land (cm/s) @@ -93,7 +91,7 @@ module mo_drydep !--------------------------------------------------------------------------- !--------------------------------------------------------------------------- - subroutine dvel_inti_fromlnd + subroutine dvel_inti_fromlnd use mo_chem_utls, only : get_spc_ndx use cam_abortutils, only : endrun @@ -120,10 +118,10 @@ subroutine dvel_inti_fromlnd !------------------------------------------------------------------------------------- subroutine drydep_update( state, cam_in ) use physics_types, only : physics_state - use camsrfexch, only : cam_in_t + use camsrfexch, only : cam_in_t type(physics_state), intent(in) :: state ! Physics state variables - type(cam_in_t), intent(in) :: cam_in + type(cam_in_t), intent(in) :: cam_in if (nddvels<1) return @@ -137,15 +135,15 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & wind_speed, spec_hum, air_temp, pressure_10m, rain, & snow, solar_flux, dvelocity, dflx, mmr, & tv, ncol, lchnk ) - + !------------------------------------------------------------------------------------- - ! combines the deposition velocities provided by the land model with deposition - ! velocities over ocean and sea ice + ! combines the deposition velocities provided by the land model with deposition + ! velocities over ocean and sea ice !------------------------------------------------------------------------------------- use ppgrid, only : pcols use chem_mods, only : gas_pcnst - + #if (defined OFFLINE_DYN) use metdata, only: get_met_fields #endif @@ -154,8 +152,8 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & ! ... dummy arguments !------------------------------------------------------------------------------------- - real(r8), intent(in) :: icefrac(pcols) - real(r8), intent(in) :: ocnfrac(pcols) + real(r8), intent(in) :: icefrac(pcols) + real(r8), intent(in) :: ocnfrac(pcols) integer, intent(in) :: ncol integer, intent(in) :: lchnk ! chunk number real(r8), intent(in) :: sfc_temp(pcols) ! surface temperature (K) @@ -164,7 +162,7 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & real(r8), intent(in) :: spec_hum(pcols) ! specific humidity (kg/kg) real(r8), intent(in) :: air_temp(pcols) ! surface air temperature (K) real(r8), intent(in) :: pressure_10m(pcols) ! 10 meter pressure (Pa) - real(r8), intent(in) :: rain(pcols) + real(r8), intent(in) :: rain(pcols) real(r8), intent(in) :: snow(pcols) ! snow height (m) real(r8), intent(in) :: solar_flux(pcols) ! direct shortwave radiation at surface (W/m^2) real(r8), intent(in) :: tv(pcols) ! potential temperature @@ -180,17 +178,17 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & real(r8), dimension(ncol) :: term ! work array integer :: ispec - real(r8) :: lndfrac(pcols) + real(r8) :: lndfrac(pcols) #if (defined OFFLINE_DYN) real(r8) :: met_ocnfrac(pcols) - real(r8) :: met_icefrac(pcols) + real(r8) :: met_icefrac(pcols) #endif integer :: i lndfrac(:ncol) = 1._r8 - ocnfrac(:ncol) - icefrac(:ncol) - where( lndfrac(:ncol) < 0._r8 ) - lndfrac(:ncol) = 0._r8 + where( lndfrac(:ncol) < 0._r8 ) + lndfrac(:ncol) = 0._r8 endwhere #if (defined OFFLINE_DYN) @@ -201,7 +199,7 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & ! ... initialize !------------------------------------------------------------------------------------- dvelocity(:,:) = 0._r8 - + !------------------------------------------------------------------------------------- ! ... compute the dep velocities over ocean and sea ice ! land type 7 is used for ocean @@ -226,7 +224,7 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & dvelocity(:ncol,spc_ndx(ispec)) = lnd(lchnk)%dvel(:ncol,ispec)*lndfrac(:ncol) & + ocnice_dvel(:ncol,spc_ndx(ispec)) enddo - + !------------------------------------------------------------------------------------- ! ... special adjustments !------------------------------------------------------------------------------------- @@ -249,11 +247,11 @@ subroutine drydep_fromlnd( ocnfrac, icefrac, sfc_temp, pressure_sfc, & dvelocity(:ncol,hcooh_ndx) = dvelocity(:ncol,ch3cooh_ndx) end if end if - + !------------------------------------------------------------------------------------- ! ... assign CO tags to CO - ! put this kludge in for now ... - ! -- should be able to set all these via the table mapping in seq_drydep_mod + ! put this kludge in for now ... + ! -- should be able to set all these via the table mapping in shr_drydep_mod !------------------------------------------------------------------------------------- if( cohc_ndx>0 .and. co_ndx>0 ) then dvelocity(:ncol,cohc_ndx) = dvelocity(:ncol,co_ndx) @@ -312,9 +310,7 @@ subroutine dvel_inti_xactive( depvel_lnd_file ) real(r8), allocatable :: urban(:,:) real(r8), allocatable :: lake(:,:) real(r8), allocatable :: wetland(:,:) - real(r8), allocatable :: lon_veg(:) real(r8), allocatable :: lon_veg_edge(:) - real(r8), allocatable :: lat_veg(:) real(r8), allocatable :: lat_veg_edge(:) character(len=32) :: test_name @@ -401,12 +397,12 @@ subroutine dvel_inti_xactive( depvel_lnd_file ) allocate( dep_ra(pcols,n_land_type,begchunk:endchunk),stat=astat ) if( astat /= 0 ) then write(iulog,*) 'dvel_inti: failed to allocate dep_ra; error = ',astat - call endrun + call endrun('dvel_inti: failed to allocate dep_ra') end if allocate( dep_rb(pcols,n_land_type,begchunk:endchunk),stat=astat ) if( astat /= 0 ) then write(iulog,*) 'dvel_inti: failed to allocate dep_rb; error = ',astat - call endrun + call endrun('dvel_inti: failed to allocate dep_rb') end if if (.not.prog_modal_aero) then @@ -416,7 +412,7 @@ subroutine dvel_inti_xactive( depvel_lnd_file ) allocate( fraction_landuse(pcols,n_land_type, begchunk:endchunk),stat=astat ) if( astat /= 0 ) then write(iulog,*) 'dvel_inti: failed to allocate fraction_landuse; error = ',astat - call endrun + call endrun('dvel_inti: failed to allocate fraction_landuse') end if fraction_landuse = nan @@ -425,19 +421,7 @@ subroutine dvel_inti_xactive( depvel_lnd_file ) if(dycore_is('UNSTRUCTURED') ) then call get_landuse_and_soilw_from_file() - allocate( index_season_lai(plon,12),stat=astat ) - index_season_lai = -huge(1) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate index_season_lai; error = ',astat - call endrun - end if else - allocate( index_season_lai(plat,12),stat=astat ) - index_season_lai = -huge(1) - if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate index_season_lai; error = ',astat - call endrun - end if !--------------------------------------------------------------------------- ! ... read landuse map !--------------------------------------------------------------------------- @@ -457,20 +441,19 @@ subroutine dvel_inti_xactive( depvel_lnd_file ) !--------------------------------------------------------------------------- allocate( vegetation_map(nlon_veg,nlat_veg,npft_veg), work(nlon_veg,nlat_veg), stat=astat ) if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat - call endrun + write(iulog,*) 'dvel_inti: failed to allocate vegetation_map; error = ',astat + call endrun('dvel_inti: failed to allocate vegetation_map') end if allocate( urban(nlon_veg,nlat_veg), lake(nlon_veg,nlat_veg), & landmask(nlon_veg,nlat_veg), wetland(nlon_veg,nlat_veg), stat=astat ) if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat - call endrun + write(iulog,*) 'dvel_inti: failed to allocate vegetation_map; error = ',astat + call endrun('dvel_inti: failed to allocate vegetation_map') end if - allocate( lon_veg(nlon_veg), lat_veg(nlat_veg), & - lon_veg_edge(nlon_veg+1), lat_veg_edge(nlat_veg+1), stat=astat ) + allocate( lon_veg_edge(nlon_veg+1), lat_veg_edge(nlat_veg+1), stat=astat ) if( astat /= 0 ) then - write(iulog,*) 'dvel_inti: failed to allocate vegation lon, lat arrays; error = ',astat - call endrun + write(iulog,*) 'dvel_inti: failed to allocate vegetation lon, lat arrays; error = ',astat + call endrun('dvel_inti: failed to allocate vegetation lon, lat arrays') end if !--------------------------------------------------------------------------- ! ... read the vegetation map and landmask @@ -509,20 +492,18 @@ subroutine dvel_inti_xactive( depvel_lnd_file ) !--------------------------------------------------------------------------- ! ... define lat-lon of vegetation map (1x1) !--------------------------------------------------------------------------- - lat_veg(:) = (/ (-89.5_r8 + (i-1),i=1,nlat_veg ) /) - lon_veg(:) = (/ ( 0.5_r8 + (i-1),i=1,nlon_veg ) /) lat_veg_edge(:) = (/ (-90.0_r8 + (i-1),i=1,nlat_veg+1) /) lon_veg_edge(:) = (/ ( 0.0_r8 + (i-1),i=1,nlon_veg+1) /) !--------------------------------------------------------------------------- ! ... regrid to model grid !--------------------------------------------------------------------------- - call interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_veg_edge, & - lon_veg, lon_veg_edge, landmask, urban, lake, & + call interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg_edge, & + lon_veg_edge, landmask, urban, lake, & wetland, vegetation_map ) deallocate( vegetation_map, work, stat=astat ) - deallocate( lon_veg, lat_veg, lon_veg_edge, lat_veg_edge, stat=astat ) + deallocate( lon_veg_edge, lat_veg_edge, stat=astat ) deallocate( landmask, urban, lake, wetland, stat=astat ) endif ! Unstructured grid @@ -533,11 +514,23 @@ subroutine get_landuse_and_soilw_from_file() use ncdio_atm, only : infld logical :: readvar - + type(file_desc_t) :: piofile character(len=shr_kind_cl) :: locfn logical :: lexist - + + if (len_trim(drydep_srf_file) == 0) then + if (masterproc) 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,*)'**************************************' + end if + 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) @@ -545,12 +538,14 @@ subroutine get_landuse_and_soilw_from_file() call infld('fraction_landuse', piofile, 'ncol','class',1,pcols,1,n_land_type, begchunk,endchunk, & fraction_landuse, readvar, gridname='physgrid') if (.not. readvar) then - write(iulog,*)'**************************************' - write(iulog,*)'get_landuse_and_soilw_from_file: INFO:' - write(iulog,*)' fraction_landuse not read from file: ' - write(iulog,*)' ', trim(locfn) - write(iulog,*)' setting all values to zero' - write(iulog,*)'**************************************' + if (masterproc) then + write(iulog,*)'**************************************' + write(iulog,*)'get_landuse_and_soilw_from_file: INFO:' + write(iulog,*)' fraction_landuse not read from file: ' + write(iulog,*)' ', trim(locfn) + write(iulog,*)' setting all values to zero' + write(iulog,*)'**************************************' + end if fraction_landuse = 0._r8 end if @@ -563,8 +558,8 @@ subroutine get_landuse_and_soilw_from_file() end subroutine get_landuse_and_soilw_from_file !------------------------------------------------------------------------------------- - subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_veg_edge, & - lon_veg, lon_veg_edge, landmask, urban, lake, & + subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg_edge, & + lon_veg_edge, landmask, urban, lake, & wetland, vegetation_map ) use mo_constants, only : r2d @@ -583,9 +578,7 @@ subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_ve real(r8), intent(in) :: lake(nlon_veg,nlat_veg) real(r8), intent(in) :: wetland(nlon_veg,nlat_veg) real(r8), intent(in) :: vegetation_map(nlon_veg,nlat_veg,npft_veg) - real(r8), intent(in) :: lon_veg(nlon_veg) real(r8), intent(in) :: lon_veg_edge(nlon_veg+1) - real(r8), intent(in) :: lat_veg(nlat_veg) real(r8), intent(in) :: lat_veg_edge(nlat_veg+1) !------------------------------------------------------------------------------------- @@ -630,10 +623,10 @@ subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_ve if (single_column) then if (scm_cambfb_mode) then piofile => initial_file_get_id() - call shr_scam_getCloseLatLon(piofile%fh,scmlat,scmlon,closelat,closelon,latidx,lonidx) + call shr_scam_getCloseLatLon(piofile,scmlat,scmlon,closelat,closelon,latidx,lonidx) ploniop=size(loniop) platiop=size(latiop) - else + else latidx=1 lonidx=1 ploniop=1 @@ -697,7 +690,7 @@ subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_ve write(iulog,*) 'interp_map : mapping_ext ',mapping_ext #endif do j = 1,plon+1 - lon1 = lon_edge(j) + lon1 = lon_edge(j) do i = -veg_ext,nlon_veg+veg_ext dx = lon_veg_edge_ext(i ) - lon1 dy = lon_veg_edge_ext(i+1) - lon1 @@ -729,17 +722,17 @@ subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_ve fraction = 0._r8 do jj = ind_lat(j),ind_lat(j+1) y1 = max( lat_edge(j),lat_veg_edge(jj) ) - y2 = min( lat_edge(j+1),lat_veg_edge(jj+1) ) + y2 = min( lat_edge(j+1),lat_veg_edge(jj+1) ) dy = (y2 - y1)/(lat_veg_edge(jj+1) - lat_veg_edge(jj)) do ii =ind_lon(i),ind_lon(i+1) i_ndx = mapping_ext(ii) x1 = max( lon_edge(i),lon_veg_edge_ext(ii) ) - x2 = min( lon_edge(i+1),lon_veg_edge_ext(ii+1) ) + x2 = min( lon_edge(i+1),lon_veg_edge_ext(ii+1) ) dx = (x2 - x1)/(lon_veg_edge_ext(ii+1) - lon_veg_edge_ext(ii)) area = dx * dy total_area = total_area + area !----------------------------------------------------------------- - ! ... special case for ocean grid point + ! ... special case for ocean grid point !----------------------------------------------------------------- if( nint(landmask(i_ndx,jj)) == 0 ) then fraction(npft_veg+1) = fraction(npft_veg+1) + area @@ -790,7 +783,7 @@ subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_ve tmp_frac_lu(i,11, j) = sum(fraction(10:12)) end do lon_loop end do lat_loop - + do lchnk = begchunk, endchunk ncol = get_ncols_p(lchnk) call get_rlat_all_p(lchnk, ncol, rlats(:ncol)) @@ -819,7 +812,7 @@ subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_ve end do end subroutine interp_map - + !------------------------------------------------------------------------------------- !------------------------------------------------------------------------------------- subroutine drydep_xactive( sfc_temp, pressure_sfc, & @@ -846,8 +839,8 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & ! modified by JFL to be used in MOZART-2 (October 2002) !------------------------------------------------------------------------------------- - use seq_drydep_mod, only: z0, rgso, rgss, ri, rclo, rcls, rlu, rac - use seq_drydep_mod, only: seq_drydep_setHCoeff, foxd, drat + use shr_drydep_mod, only: z0, rgso, rgss, ri, rclo, rcls, rlu, rac + use shr_drydep_mod, only: shr_drydep_setHCoeff, foxd, drat use physconst, only: tmelt !------------------------------------------------------------------------------------- @@ -860,7 +853,7 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & real(r8), intent(in) :: spec_hum(pcols) ! specific humidity (kg/kg) real(r8), intent(in) :: air_temp(pcols) ! surface air temperature (K) real(r8), intent(in) :: pressure_10m(pcols) ! 10 meter pressure (Pa) - real(r8), intent(in) :: rain(pcols) + real(r8), intent(in) :: rain(pcols) real(r8), intent(in) :: snow(pcols) ! snow height (m) real(r8), intent(in) :: solar_flux(pcols) ! direct shortwave radiation at surface (W/m^2) @@ -874,8 +867,8 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & integer, intent(in), optional :: beglandtype integer, intent(in), optional :: endlandtype - real(r8), intent(in), optional :: ocnfrc(pcols) - real(r8), intent(in), optional :: icefrc(pcols) + real(r8), intent(in), optional :: ocnfrc(pcols) + real(r8), intent(in), optional :: icefrc(pcols) !------------------------------------------------------------------------------------- ! ... local variables @@ -952,7 +945,7 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & logical :: fr_lnduse(ncol,n_land_type) ! wrking array real(r8) :: dewm ! multiplier for rs when dew occurs - real(r8) :: lcl_frc_landuse(ncol,n_land_type) + real(r8) :: lcl_frc_landuse(ncol,n_land_type) integer :: beglt, endlt @@ -966,16 +959,16 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & 0.005_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.075_r8, 0.002_r8 /) if (present( beglandtype)) then - beglt = beglandtype + beglt = beglandtype else beglt = 1 endif if (present( endlandtype)) then - endlt = endlandtype + endlt = endlandtype else endlt = n_land_type endif - + !------------------------------------------------------------------------------------- ! initialize !------------------------------------------------------------------------------------- @@ -990,7 +983,7 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & !------------------------------------------------------------------------------------- ! define species-dependent parameters (temperature dependent) !------------------------------------------------------------------------------------- - call seq_drydep_setHCoeff( ncol, sfc_temp, heff ) + call shr_drydep_setHCoeff( ncol, sfc_temp, heff ) do lt = 1,n_land_type dep_ra (:,lt,lchnk) = 0._r8 @@ -1001,7 +994,7 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & !------------------------------------------------------------------------------------- ! season index only for ocn and sea ice !------------------------------------------------------------------------------------- - index_season = 4 + index_season = 4 !------------------------------------------------------------------------------------- ! special case for snow covered terrain !------------------------------------------------------------------------------------- @@ -1141,7 +1134,7 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & !------------------------------------------------------------------------------------- ! revise calculation of friction velocity and z0 over water !------------------------------------------------------------------------------------- - lt = 7 + lt = 7 do i = 1,ncol if( fr_lnduse(i,lt) ) then if( unstable(i) ) then @@ -1386,7 +1379,7 @@ subroutine drydep_xactive( sfc_temp, pressure_sfc, & if( lt == 7 ) then where( fr_lnduse(:ncol,lt) ) ! assume no surface resistance for SO2 over water` - wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk)) + wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk)) endwhere else where( fr_lnduse(:ncol,lt) ) diff --git a/src/chemistry/mozart/mo_extfrc.F90 b/src/chemistry/mozart/mo_extfrc.F90 index 2438f47414..c1ca05aed3 100644 --- a/src/chemistry/mozart/mo_extfrc.F90 +++ b/src/chemistry/mozart/mo_extfrc.F90 @@ -5,7 +5,7 @@ module mo_extfrc use shr_kind_mod, only : r8 => shr_kind_r8 use ppgrid, only : pver, pverp - use chem_mods, only : gas_pcnst, extcnt, extfrc_lst, frc_from_dataset, adv_mass + use chem_mods, only : extcnt, extfrc_lst, frc_from_dataset, adv_mass use spmd_utils, only : masterproc use cam_abortutils,only : endrun use cam_history, only : addfld, outfld, add_default, horiz_only @@ -78,11 +78,11 @@ subroutine extfrc_inti( extfrc_specifier, extfrc_type_in, extfrc_cycle_yr, extfr integer :: astat integer :: j, l, m, n, i,mm ! Indices character(len=16) :: spc_name - character(len=256) :: frc_fnames(gas_pcnst) - real(r8) :: frc_scalefactor(gas_pcnst) - character(len=16) :: frc_species(gas_pcnst) - integer :: frc_indexes(gas_pcnst) - integer :: indx(gas_pcnst) + character(len=256) :: frc_fnames(size(extfrc_specifier)) + real(r8) :: frc_scalefactor(size(extfrc_specifier)) + character(len=16) :: frc_species(size(extfrc_specifier)) + integer :: frc_indexes(size(extfrc_specifier)) + integer :: indx(size(extfrc_specifier)) integer :: vid, ndims, nvars, isec, ierr, num_dims_xfrc, dimid logical, allocatable :: is_sector(:) @@ -105,7 +105,7 @@ subroutine extfrc_inti( extfrc_specifier, extfrc_type_in, extfrc_cycle_yr, extfr character(len=256) :: locfn !----------------------------------------------------------------------- - + call phys_getopts( & history_aerosol_out = history_aerosol, & history_chemistry_out = history_chemistry, & @@ -119,7 +119,7 @@ subroutine extfrc_inti( extfrc_specifier, extfrc_type_in, extfrc_cycle_yr, extfr mm = 0 indx(:) = 0 - count_emis: do n=1,gas_pcnst + count_emis: do n=1,size(extfrc_specifier) if ( len_trim(extfrc_specifier(n) ) == 0 ) then exit count_emis @@ -127,7 +127,7 @@ subroutine extfrc_inti( extfrc_specifier, extfrc_type_in, extfrc_cycle_yr, extfr i = scan(extfrc_specifier(n),'->') spc_name = trim(adjustl(extfrc_specifier(n)(:i-1))) - + ! need to parse out scalefactor ... tmp_string = adjustl(extfrc_specifier(n)(i+2:)) j = scan( tmp_string, '*' ) @@ -179,7 +179,7 @@ subroutine extfrc_inti( extfrc_specifier, extfrc_type_in, extfrc_cycle_yr, extfr end if !----------------------------------------------------------------------- - ! Sort the input files so that the emissions sources are summed in the + ! Sort the input files so that the emissions sources are summed in the ! same order regardless of the order of the input files in the namelist !----------------------------------------------------------------------- if (n_frc_files > 0) then @@ -189,14 +189,14 @@ subroutine extfrc_inti( extfrc_specifier, extfrc_type_in, extfrc_cycle_yr, extfr !----------------------------------------------------------------------- ! ... setup the forcing type array !----------------------------------------------------------------------- - do m=1,n_frc_files + do m=1,n_frc_files forcings(m)%frc_ndx = frc_indexes(indx(m)) forcings(m)%species = frc_species(indx(m)) forcings(m)%filename = frc_fnames(indx(m)) forcings(m)%scalefactor = frc_scalefactor(indx(m)) enddo - - do n= 1,extcnt + + do n= 1,extcnt if (frc_from_dataset(n)) then spc_name = extfrc_lst(n) call addfld( trim(spc_name)//'_XFRC', (/ 'lev' /), 'A', 'molec/cm3/s', & @@ -205,7 +205,7 @@ subroutine extfrc_inti( extfrc_specifier, extfrc_type_in, extfrc_cycle_yr, extfr 'vertically intergrated external forcing for '//trim(spc_name) ) call addfld( trim(spc_name)//'_CMXF', horiz_only, 'A', 'kg/m2/s', & 'vertically intergrated external forcing for '//trim(spc_name) ) - if ( history_aerosol .or. history_chemistry ) then + if ( history_aerosol .or. history_chemistry ) then call add_default( trim(spc_name)//'_CLXF', 1, ' ' ) call add_default( trim(spc_name)//'_CMXF', 1, ' ' ) endif @@ -250,6 +250,10 @@ subroutine extfrc_inti( extfrc_specifier, extfrc_type_in, extfrc_cycle_yr, extfr forcings(m)%nsectors = 0 + if (masterproc) then + write(iulog,'(a,i3,a)') 'extfrc_inti m: ',m,' init file : '//trim(forcings(m)%filename) + endif + call getfil (forcings(m)%filename, locfn, 0) call cam_pio_openfile ( ncid, trim(locfn), PIO_NOWRITE) ierr = pio_inquire (ncid, nVariables=nvars) @@ -261,7 +265,7 @@ subroutine extfrc_inti( extfrc_specifier, extfrc_type_in, extfrc_cycle_yr, extfr allocate(is_sector(nvars)) is_sector(:) = .false. - + do vid = 1,nvars ierr = pio_inq_varndims (ncid, vid, ndims) @@ -282,7 +286,7 @@ subroutine extfrc_inti( extfrc_specifier, extfrc_type_in, extfrc_cycle_yr, extfr forcings(m)%nsectors = forcings(m)%nsectors+1 is_sector(vid)=.true. - + enddo allocate( forcings(m)%sectors(forcings(m)%nsectors), stat=astat ) @@ -301,7 +305,7 @@ subroutine extfrc_inti( extfrc_specifier, extfrc_type_in, extfrc_cycle_yr, extfr deallocate(is_sector) ! Global attribute 'input_method' overrides the ext_frc_type namelist setting on - ! a file-by-file basis. If the ext_frc file does not contain the 'input_method' + ! a file-by-file basis. If the ext_frc file does not contain the 'input_method' ! attribute then the ext_frc_type namelist setting is used. call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) ierr = pio_get_att(ncid, PIO_GLOBAL, 'input_method', file_interp_type) @@ -341,7 +345,7 @@ subroutine extfrc_timestep_init( pbuf2d, state ) implicit none - type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_state), intent(in):: state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) !----------------------------------------------------------------------- diff --git a/src/chemistry/mozart/mo_gas_phase_chemdr.F90 b/src/chemistry/mozart/mo_gas_phase_chemdr.F90 index f051042a2f..0575b2f8c0 100644 --- a/src/chemistry/mozart/mo_gas_phase_chemdr.F90 +++ b/src/chemistry/mozart/mo_gas_phase_chemdr.F90 @@ -6,7 +6,6 @@ module mo_gas_phase_chemdr use cam_history, only : fieldname_len use chem_mods, only : phtcnt, rxntot, gas_pcnst use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map, extcnt, num_rnts - use dust_model, only : dust_names, ndust => dust_nbin use ppgrid, only : pcols, pver use phys_control, only : phys_getopts use carma_flags_mod, only : carma_hetchem_feedback @@ -16,13 +15,13 @@ module mo_gas_phase_chemdr save private - public :: gas_phase_chemdr, gas_phase_chemdr_inti + public :: gas_phase_chemdr, gas_phase_chemdr_inti public :: map2chm integer :: map2chm(pcnst) = 0 ! index map to/from chemistry/constituents list - integer :: so4_ndx, h2o_ndx, o2_ndx, o_ndx, hno3_ndx, hcl_ndx, dst_ndx, cldice_ndx, snow_ndx - integer :: o3_ndx, o3s_ndx + integer :: so4_ndx, h2o_ndx, o2_ndx, o_ndx, hno3_ndx, hcl_ndx, cldice_ndx, snow_ndx + integer :: o3_ndx, o3s_ndx, o3_inv_ndx, srf_ozone_pbf_ndx=-1 integer :: het1_ndx integer :: ndx_cldfr, ndx_cmfdqr, ndx_nevapr, ndx_cldtop, ndx_prain integer :: ndx_h2so4 @@ -49,11 +48,15 @@ module mo_gas_phase_chemdr logical :: convproc_do_aer integer :: ele_temp_ndx, ion_temp_ndx + ! for HEMCO-CESM ... passing J-values to ParaNOx ship plume extension + integer :: hco_jno2_idx, hco_joh_idx + integer :: rxt_jno2_idx, rxt_joh_idx + contains subroutine gas_phase_chemdr_inti() - use mo_chem_utls, only : get_spc_ndx, get_extfrc_ndx, get_rxt_ndx + use mo_chem_utls, only : get_spc_ndx, get_extfrc_ndx, get_rxt_ndx, get_inv_ndx use cam_history, only : addfld,add_default,horiz_only use mo_chm_diags, only : chm_diags_inti use constituents, only : cnst_get_ind @@ -71,7 +74,7 @@ subroutine gas_phase_chemdr_inti() call phys_getopts( history_scwaccm_forcing_out = history_scwaccm_forcing ) call phys_getopts( convproc_do_aer_out = convproc_do_aer, history_cesm_forcing_out=history_cesm_forcing ) - + ndx_h2so4 = get_spc_ndx('H2SO4') ! ! CCMI @@ -101,12 +104,12 @@ subroutine gas_phase_chemdr_inti() pm25_srf_diag = cb1_ndx>0 .and. cb2_ndx>0 .and. oc1_ndx>0 .and. oc2_ndx>0 & .and. dst1_ndx>0 .and. dst2_ndx>0 .and. sslt1_ndx>0 .and. sslt2_ndx>0 & - .and. soa_ndx>0 + .and. soa_ndx>0 pm25_srf_diag_soa = cb1_ndx>0 .and. cb2_ndx>0 .and. oc1_ndx>0 .and. oc2_ndx>0 & .and. dst1_ndx>0 .and. dst2_ndx>0 .and. sslt1_ndx>0 .and. sslt2_ndx>0 & .and. soam_ndx>0 .and. soai_ndx>0 .and. soat_ndx>0 .and. soab_ndx>0 .and. soax_ndx>0 - + if ( pm25_srf_diag .or. pm25_srf_diag_soa) then call addfld('PM25_SRF',horiz_only,'I','kg/kg','bottom layer PM2.5 mixing ratio' ) endif @@ -116,6 +119,7 @@ subroutine gas_phase_chemdr_inti() ! het1_ndx= get_rxt_ndx('het1') o3_ndx = get_spc_ndx('O3') + o3_inv_ndx = get_inv_ndx( 'O3' ) o3s_ndx = get_spc_ndx('O3S') o_ndx = get_spc_ndx('O') o2_ndx = get_spc_ndx('O2') @@ -123,10 +127,12 @@ subroutine gas_phase_chemdr_inti() h2o_ndx = get_spc_ndx('H2O') hno3_ndx = get_spc_ndx('HNO3') hcl_ndx = get_spc_ndx('HCL') - dst_ndx = get_spc_ndx( dust_names(1) ) call cnst_get_ind( 'CLDICE', cldice_ndx ) call cnst_get_ind( 'SNOWQM', snow_ndx, abort=.false. ) + if (o3_ndx>0 .or. o3_inv_ndx>0) then + srf_ozone_pbf_ndx = pbuf_get_index('SRFOZONE') + endif do m = 1,extcnt WRITE(UNIT=string, FMT='(I2.2)') m @@ -160,16 +166,6 @@ subroutine gas_phase_chemdr_inti() endif enddo - call addfld( 'DTCBS', horiz_only, 'I', ' ','photolysis diagnostic black carbon OD' ) - call addfld( 'DTOCS', horiz_only, 'I', ' ','photolysis diagnostic organic carbon OD' ) - call addfld( 'DTSO4', horiz_only, 'I', ' ','photolysis diagnostic SO4 OD' ) - call addfld( 'DTSOA', horiz_only, 'I', ' ','photolysis diagnostic SOA OD' ) - call addfld( 'DTANT', horiz_only, 'I', ' ','photolysis diagnostic NH4SO4 OD' ) - call addfld( 'DTSAL', horiz_only, 'I', ' ','photolysis diagnostic salt OD' ) - call addfld( 'DTDUST', horiz_only, 'I', ' ','photolysis diagnostic dust OD' ) - call addfld( 'DTTOTAL', horiz_only, 'I', ' ','photolysis diagnostic total aerosol OD' ) - call addfld( 'FRACDAY', horiz_only, 'I', ' ','photolysis diagnostic fraction of day' ) - call addfld( 'QDSAD', (/ 'lev' /), 'I', '/s', 'water vapor sad delta' ) call addfld( 'SAD_STRAT', (/ 'lev' /), 'I', 'cm2/cm3', 'stratospheric aerosol SAD' ) call addfld( 'SAD_SULFC', (/ 'lev' /), 'I', 'cm2/cm3', 'chemical sulfate aerosol SAD' ) @@ -217,7 +213,7 @@ subroutine gas_phase_chemdr_inti() sad_pbf_ndx= pbuf_get_index('VOLC_SAD',errcode=err) ! prescribed strat aerosols (volcanic) if (.not.sad_pbf_ndx>0) sad_pbf_ndx = pbuf_get_index('SADSULF',errcode=err) ! CARMA's version of strat aerosols - ele_temp_ndx = pbuf_get_index('TElec',errcode=err)! electron temperature index + ele_temp_ndx = pbuf_get_index('TElec',errcode=err)! electron temperature index ion_temp_ndx = pbuf_get_index('TIon',errcode=err) ! ion temperature index ! diagnostics for stratospheric heterogeneous reactions @@ -233,6 +229,23 @@ subroutine gas_phase_chemdr_inti() call chem_prod_loss_diags_init + ! diagnostics for HEMCO ParaNOx extension + hco_jno2_idx = pbuf_get_index('HCO_IN_JNO2',errcode=err) + hco_joh_idx = pbuf_get_index('HCO_IN_JOH',errcode=err) + + !-------------------------- HEMCO_CESM --------------------------------- + ! ... save photo rxn rates for HEMCO ParaNOx, chem_mech rxns: + ! jo3_b ( 8) O3 + hv -> O + O2 + ! jno2 ( 16) NO2 + hv -> NO + O + ! + ! The reactions jo2 and jo3_b exist in the mechanisms that would use + ! the ParaNOx ship plume extension. If they do not exist, then the indices + ! would not be found and the HCO_IN_JNO2 and HCO_IN_JOH fields would not + ! be zero and the extension would have no effect. + !----------------------------------------------------------------------- + rxt_jno2_idx = get_rxt_ndx( 'jno2' ) + rxt_joh_idx = get_rxt_ndx( 'jo3_b' ) + end subroutine gas_phase_chemdr_inti @@ -240,13 +253,14 @@ end subroutine gas_phase_chemdr_inti !----------------------------------------------------------------------- subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & phis, zm, zi, calday, & - tfld, pmid, pdel, pint, & + tfld, pmid, pdel, pint, rpdel, rpdeldry, & cldw, troplev, troplevchem, & ncldwtr, ufld, vfld, & - delt, ps, xactive_prates, & + delt, ps, & fsds, ts, asdir, ocnfrac, icefrac, & precc, precl, snowhland, ghg_chem, latmapback, & - drydepflx, wetdepflx, cflx, fire_sflx, fire_ztop, nhx_nitrogen_flx, noy_nitrogen_flx, qtend, pbuf) + drydepflx, wetdepflx, cflx, fire_sflx, fire_ztop, nhx_nitrogen_flx, noy_nitrogen_flx, & + use_hemco, qtend, pbuf) !----------------------------------------------------------------------- ! ... Chem_solver advances the volumetric mixing ratio @@ -254,9 +268,10 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & ! ebi, hov, fully implicit, and/or rodas algorithms. !----------------------------------------------------------------------- + use phys_control, only : cam_physpkg_is use chem_mods, only : nabscol, nfs, indexm, clscnt4 - use physconst, only : rga - use mo_photo, only : set_ub_col, setcol, table_photo, xactive_photo + use physconst, only : rga, gravit + use mo_photo, only : set_ub_col, setcol, table_photo use mo_exp_sol, only : exp_sol use mo_imp_sol, only : imp_sol use mo_setrxt, only : setrxt @@ -271,13 +286,12 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & use mo_sethet, only : sethet use mo_drydep, only : drydep use mo_fstrat, only : set_fstrat_vals, set_fstrat_h2o - use noy_ubc, only : noy_ubc_set use mo_flbc, only : flbc_set use phys_grid, only : get_rlat_all_p, get_rlon_all_p use mo_mean_mass, only : set_mean_mass use cam_history, only : outfld use wv_saturation, only : qsat - use constituents, only : cnst_mw + use constituents, only : cnst_mw, cnst_type use mo_ghg_chem, only : ghg_chem_set_rates, ghg_chem_set_flbc use mo_sad, only : sad_strat_calc use charge_neutrality, only : charge_balance @@ -295,6 +309,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & use rate_diags, only : rate_diags_calc, rate_diags_o3s_loss use mo_mass_xforms, only : mmr2vmr, vmr2mmr, h2o_to_vmr, mmr2vmri use orbit, only : zenith + ! ! for aqueous chemistry and aerosol growth ! @@ -315,6 +330,8 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & real(r8),target,intent(in) :: tfld(pcols,pver) ! midpoint temperature (K) real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures (Pa) real(r8), intent(in) :: pdel(pcols,pver) ! pressure delta about midpoints (Pa) + real(r8), intent(in) :: rpdel(pcols,pver) ! reciprocal pressure delta about midpoints (Pa) + real(r8), intent(in) :: rpdeldry(pcols,pver) ! reciprocal dry pressure delta about midpoints (Pa) real(r8), intent(in) :: ufld(pcols,pver) ! zonal velocity (m/s) real(r8), intent(in) :: vfld(pcols,pver) ! meridional velocity (m/s) real(r8), intent(in) :: cldw(pcols,pver) ! cloud water (kg/kg) @@ -325,7 +342,6 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & real(r8), intent(in) :: q(pcols,pver,pcnst) ! species concentrations (kg/kg) real(r8),pointer, intent(in) :: fire_sflx(:,:) ! fire emssions surface flux (kg/m^2/s) real(r8),pointer, intent(in) :: fire_ztop(:) ! top of vertical distribution of fire emssions (m) - logical, intent(in) :: xactive_prates real(r8), intent(in) :: fsds(pcols) ! longwave down at sfc real(r8), intent(in) :: icefrac(pcols) ! sea-ice areal fraction real(r8), intent(in) :: ocnfrac(pcols) ! ocean areal fraction @@ -334,7 +350,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & real(r8), intent(in) :: precc(pcols) ! real(r8), intent(in) :: precl(pcols) ! real(r8), intent(in) :: snowhland(pcols) ! - logical, intent(in) :: ghg_chem + logical, intent(in) :: ghg_chem integer, intent(in) :: latmapback(pcols) integer, intent(in) :: troplev(pcols) ! trop/strat separation vertical index integer, intent(in) :: troplevchem(pcols) ! trop/strat chemistry separation vertical index @@ -344,6 +360,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & real(r8), intent(in) :: wetdepflx(pcols,pcnst) ! wet deposition flux (kg/m^2/s) real(r8), intent(out) :: nhx_nitrogen_flx(pcols) real(r8), intent(out) :: noy_nitrogen_flx(pcols) + logical, intent(in) :: use_hemco ! use Harmonized Emissions Component (HEMCO) type(physics_buffer_desc), pointer :: pbuf(:) @@ -375,7 +392,6 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & h2ovmr, & ! water vapor volume mixing ratio mbar, & ! mean wet atmospheric mass ( amu ) zmid, & ! midpoint geopotential in km - zmidr, & ! midpoint geopotential in km realitive to surf sulfate, & ! trop sulfate aerosols pmb ! pressure at midpoints ( hPa ) real(r8), dimension(ncol,pver) :: & @@ -408,9 +424,6 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & real(r8) :: prect(pcols) real(r8) :: sflx(pcols,gas_pcnst) real(r8) :: wetdepflx_diag(pcols,gas_pcnst) - real(r8) :: dust_vmr(ncol,pver,ndust) - real(r8) :: dt_diag(pcols,8) ! od diagnostics - real(r8) :: fracday(pcols) ! fraction of day real(r8) :: o2mmr(ncol,pver) ! o2 concentration (kg/kg) real(r8) :: ommr(ncol,pver) ! o concentration (kg/kg) real(r8) :: mmr(pcols,pver,gas_pcnst) ! chem working concentrations (kg/kg) @@ -428,10 +441,13 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & real(r8) :: qh2o(pcols,pver) ! specific humidity (kg/kg) real(r8) :: delta - ! for aerosol formation.... + ! for aerosol formation.... real(r8) :: del_h2so4_gasprod(ncol,pver) real(r8) :: vmr0(ncol,pver,gas_pcnst) + ! for HEMCO-CESM ... passing J-values to ParaNOx ship plume extension + real(r8), pointer :: hco_j_tmp_fld(:) ! J-value pointer (sfc only) [1/s] + ! ! CCMI ! @@ -455,6 +471,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & real(r8) :: loss_out(ncol,pver,max(1,clscnt4)) real(r8) :: o3s_loss(ncol,pver) + real(r8), pointer :: srf_ozone_fld(:) if ( ele_temp_ndx>0 .and. ion_temp_ndx>0 ) then call pbuf_get_field(pbuf, ele_temp_ndx, ele_temp_fld) @@ -468,9 +485,9 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & reaction_rates(:,:,:) = nan delt_inverse = 1._r8 / delt - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Get chunck latitudes and longitudes - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call get_rlat_all_p( lchnk, ncol, rlats ) call get_rlon_all_p( lchnk, ncol, rlons ) tim_ndx = pbuf_old_tim_idx() @@ -484,24 +501,23 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & dlats(:) = rlats(:)*rad2deg ! convert to degrees - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Calculate cosine of zenith angle ! then cast back to angle (radians) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call zenith( calday, rlats, rlons, zen_angle, ncol ) zen_angle(:) = acos( zen_angle(:) ) sza(:) = zen_angle(:) * rad2deg call outfld( 'SZA', sza, ncol, lchnk ) - !----------------------------------------------------------------------- - ! ... Xform geopotential height from m to km + !----------------------------------------------------------------------- + ! ... Xform geopotential height from m to km ! and pressure from Pa to mb - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- zsurf(:ncol) = rga * phis(:ncol) do k = 1,pver zintr(:ncol,k) = m2km * zi(:ncol,k) - zmidr(:ncol,k) = m2km * zm(:ncol,k) zmid(:ncol,k) = m2km * (zm(:ncol,k) + zsurf(:ncol)) zint(:ncol,k) = m2km * (zi(:ncol,k) + zsurf(:ncol)) pmb(:ncol,k) = Pa2mb * pmid(:ncol,k) @@ -509,9 +525,9 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & zint(:ncol,pver+1) = m2km * (zi(:ncol,pver+1) + zsurf(:ncol)) zintr(:ncol,pver+1)= m2km * zi(:ncol,pver+1) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... map incoming concentrations to working array - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- do m = 1,pcnst n = map2chm(m) if( n > 0 ) then @@ -521,24 +537,24 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & call get_short_lived_species( mmr, lchnk, ncol, pbuf ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Set atmosphere mean mass - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call set_mean_mass( ncol, mmr, mbar ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Xform from mmr to vmr - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call mmr2vmr( mmr(:ncol,:,:), vmr(:ncol,:,:), mbar(:ncol,:), ncol ) - + ! ! CCMI ! ! reset STE tracer to specific vmr of 200 ppbv ! - if ( st80_25_ndx > 0 ) then + if ( st80_25_ndx > 0 ) then where ( pmid(:ncol,:) < 80.e+2_r8 ) - vmr(:ncol,:,st80_25_ndx) = 200.e-9_r8 + vmr(:ncol,:,st80_25_ndx) = 200.e-9_r8 end where end if ! @@ -578,35 +594,35 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & end if if (h2o_ndx>0) then - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... store water vapor in wrk variable - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- qh2o(:ncol,:) = mmr(:ncol,:,h2o_ndx) h2ovmr(:ncol,:) = vmr(:ncol,:,h2o_ndx) else qh2o(:ncol,:) = q(:ncol,:,1) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Xform water vapor from mmr to vmr and set upper bndy values - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call h2o_to_vmr( q(:ncol,:,1), h2ovmr(:ncol,:), mbar(:ncol,:), ncol ) call set_fstrat_h2o( h2ovmr, pmid, troplev, calday, ncol, lchnk ) endif - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... force ion/electron balance - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call charge_balance( ncol, vmr ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Set the "invariants" - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call setinv( invariants, tfld, h2ovmr, vmr, pmid, ncol, lchnk, pbuf ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... stratosphere aerosol surface area - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- if (sad_pbf_ndx>0) then call pbuf_get_field(pbuf, sad_pbf_ndx, strato_sad) else @@ -619,11 +635,11 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & endif stratochem: if ( has_strato_chem ) then - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... initialize condensed and gas phases; all hno3 to gas - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- hcl_cond(:,:) = 0.0_r8 - hcl_gas (:,:) = 0.0_r8 + hcl_gas (:,:) = 0.0_r8 do k = 1,pver hno3_gas(:,k) = vmr(:,k,hno3_ndx) h2o_gas(:,k) = h2ovmr(:,k) @@ -643,9 +659,9 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & call mmr2vmri( cldice(:ncol,:), h2o_cond(:ncol,:), mbar(:ncol,:), cnst_mw(cldice_ndx), ncol ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... call SAD routine - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call sad_strat_calc( lchnk, invariants(:ncol,:,indexm), pmb, tfld, hno3_gas, & hno3_cond, h2o_gas, h2o_cond, hcl_gas, hcl_cond, strato_sad(:ncol,:), radius_strat, & sad_strat, ncol, pbuf ) @@ -680,9 +696,9 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & call outfld( 'HCL_GAS', hcl_gas (:,:), ncol ,lchnk ) call outfld( 'HCL_STS', hcl_cond(:,:), ncol ,lchnk ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... call aerosol reaction rates - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call ratecon_sfstrat( ncol, invariants(:,:,indexm), pmid, tfld, & radius_strat(:,:,1), sad_strat(:,:,1), sad_strat(:,:,2), & sad_strat(:,:,3), h2ovmr, vmr, reaction_rates, & @@ -699,22 +715,22 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & endif stratochem -! NOTE: For gas-phase solver only. +! NOTE: For gas-phase solver only. ! ratecon_sfstrat needs total hcl. if (hcl_ndx>0) then vmr(:,:,hcl_ndx) = hcl_gas(:,:) endif - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Set the column densities at the upper boundary - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call set_ub_col( col_delta, vmr, invariants, pint(:,1), pdel, ncol, lchnk) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Set rates for "tabular" and user specified reactions - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call setrxt( reaction_rates, tfld, invariants(1,1,indexm), ncol ) - + sulfate(:,:) = 0._r8 if ( .not. carma_hetchem_feedback ) then if( so4_ndx < 1 ) then ! get offline so4 field if not prognostic @@ -723,7 +739,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & sulfate(:,:) = vmr(:,:,so4_ndx) endif endif - + !----------------------------------------------------------------- ! ... zero out sulfate above tropopause !----------------------------------------------------------------- @@ -740,13 +756,15 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & !----------------------------------------------------------------- ! ... compute the relative humidity !----------------------------------------------------------------- - call qsat(tfld(:ncol,:), pmid(:ncol,:), satv, satq) + do k = 1, pver + call qsat(tfld(1:ncol,k), pmid(1:ncol,k), satv(1:ncol,k), satq(1:ncol,k), ncol) + end do do k = 1,pver relhum(:,k) = .622_r8 * h2ovmr(:,k) / satq(:,k) relhum(:,k) = max( 0._r8,min( 1._r8,relhum(:,k) ) ) end do - + cwat(:ncol,:pver) = cldw(:ncol,:pver) call usrrxt( reaction_rates, tfld, ion_temp_fld, ele_temp_fld, invariants, h2ovmr, & @@ -762,7 +780,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & ! Add trop/strat components of effective radius for output reff(:ncol,:)=reff(:ncol,:)+reff_strat(:ncol,:) call outfld( 'REFF_AERO', reff(:ncol,:), ncol, lchnk ) - + if (het1_ndx>0) then call outfld( 'het1_total', reaction_rates(:,:,het1_ndx), ncol, lchnk ) endif @@ -779,67 +797,59 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & !----------------------------------------------------------------------- ! ... Compute the photolysis rates at time = t(n+1) - !----------------------------------------------------------------------- - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Set the column densities - !----------------------------------------------------------------------- - call setcol( col_delta, col_dens, vmr, pdel, ncol ) + !----------------------------------------------------------------------- + call setcol( col_delta, col_dens ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Calculate the photodissociation rates - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- esfact = 1._r8 call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr , & delta, esfact ) - - if ( xactive_prates ) then - if ( dst_ndx > 0 ) then - dust_vmr(:ncol,:,1:ndust) = vmr(:ncol,:,dst_ndx:dst_ndx+ndust-1) - else - dust_vmr(:ncol,:,:) = 0._r8 - endif - - !----------------------------------------------------------------- - ! ... compute the photolysis rates - !----------------------------------------------------------------- - call xactive_photo( reaction_rates, vmr, tfld, cwat, cldfr, & - pmid, zmidr, col_dens, zen_angle, asdir, & - invariants(1,1,indexm), ps, ts, & - esfact, relhum, dust_vmr, dt_diag, fracday, ncol, lchnk ) - - call outfld('DTCBS', dt_diag(:ncol,1), ncol, lchnk ) - call outfld('DTOCS', dt_diag(:ncol,2), ncol, lchnk ) - call outfld('DTSO4', dt_diag(:ncol,3), ncol, lchnk ) - call outfld('DTANT', dt_diag(:ncol,4), ncol, lchnk ) - call outfld('DTSAL', dt_diag(:ncol,5), ncol, lchnk ) - call outfld('DTDUST', dt_diag(:ncol,6), ncol, lchnk ) - call outfld('DTSOA', dt_diag(:ncol,7), ncol, lchnk ) - call outfld('DTTOTAL', dt_diag(:ncol,8), ncol, lchnk ) - call outfld('FRACDAY', fracday(:ncol), ncol, lchnk ) - - else - !----------------------------------------------------------------- - ! ... lookup the photolysis rates from table - !----------------------------------------------------------------- - call table_photo( reaction_rates, pmid, pdel, tfld, zmid, zint, & - col_dens, zen_angle, asdir, cwat, cldfr, & - esfact, vmr, invariants, ncol, lchnk, pbuf ) - endif + !----------------------------------------------------------------- + ! ... lookup the photolysis rates from table + !----------------------------------------------------------------- + call table_photo( reaction_rates, pmid, pdel, tfld, zmid, zint, & + col_dens, zen_angle, asdir, cwat, cldfr, & + esfact, vmr, invariants, ncol, lchnk, pbuf ) do i = 1,phtcnt call outfld( tag_names(i), reaction_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) enddo - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Adjust the photodissociation rates - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call phtadj( reaction_rates, invariants, invariants(:,:,indexm), ncol,pver ) + if ( use_hemco ) then + !-------------------------- HEMCO_CESM --------------------------------- + ! ... save photo rxn rates for HEMCO ParaNOx, chem_mech rxns: + ! jo3_b ( 8) O3 + hv -> O + O2 + ! jno2 ( 16) NO2 + hv -> NO + O + !----------------------------------------------------------------------- + ! get the rxn rate [1/s] and write to pbuf + if(rxt_jno2_idx > 0 .and. hco_jno2_idx > 0) then + call pbuf_get_field(pbuf, hco_jno2_idx, hco_j_tmp_fld) + ! this is already in chunk, write /pcols/ at surface + hco_j_tmp_fld(:ncol) = reaction_rates(:ncol,pver,rxt_jno2_idx) + endif + + if(rxt_joh_idx > 0 .and. hco_joh_idx > 0) then + call pbuf_get_field(pbuf, hco_joh_idx, hco_j_tmp_fld) + ! this is already in chunk, write /pcols/ at surface + hco_j_tmp_fld(:ncol) = reaction_rates(:ncol,pver,rxt_joh_idx) + endif + endif + !----------------------------------------------------------------------- ! ... Compute the extraneous frcing at time = t(n+1) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- if ( o2_ndx > 0 .and. o_ndx > 0 ) then do k = 1,pver o2mmr(:ncol,k) = mmr(:ncol,k,o2_ndx) @@ -863,7 +873,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & !----------------------------------------------------------------------- ! ... Form the washout rates - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- if ( gas_wetdep_method=='MOZ' ) then call sethet( het_rates, pmid, zmid, phis, tfld, & cmfdqr, prain, nevapr, delt, invariants(:,:,indexm), & @@ -950,17 +960,16 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & invariants(:,:,indexm), invariants, del_h2so4_gasprod, & vmr0, vmr, pbuf ) - if ( has_strato_chem ) then + if ( has_strato_chem ) then wrk(:ncol,:) = (vmr(:ncol,:,h2o_ndx) - wrk(:ncol,:))*delt_inverse call outfld( 'QDCHEM', wrk(:ncol,:), ncol, lchnk ) - call outfld( 'HNO3_GAS', vmr(:ncol,:,hno3_ndx), ncol ,lchnk ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... aerosol settling ! first settle hno3(2) using radius ice ! secnd settle hno3(3) using radius large nat - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- wrk(:,:) = vmr(:,:,h2o_ndx) #ifdef ALT_SETTL where( h2o_cond(:,:) > 0._r8 ) @@ -983,17 +992,17 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & hno3_cond(1,1,2), radius_strat(1,1,2), ncol, lchnk, 2 ) #endif - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... reform total hno3 and hcl = gas + all condensed - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! NOTE: vmr for hcl and hno3 is gas-phase at this point. ! hno3_cond(:,k,1) = STS; hno3_cond(:,k,2) = NAT - + do k = 1,pver vmr(:,k,hno3_ndx) = vmr(:,k,hno3_ndx) + hno3_cond(:,k,1) & - + hno3_cond(:,k,2) - vmr(:,k,hcl_ndx) = vmr(:,k,hcl_ndx) + hcl_cond(:,k) - + + hno3_cond(:,k,2) + vmr(:,k,hcl_ndx) = vmr(:,k,hcl_ndx) + hcl_cond(:,k) + end do wrk(:,:) = (vmr(:,:,h2o_ndx) - wrk(:,:))*delt_inverse @@ -1001,46 +1010,41 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & endif - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Check for negative values and reset to zero - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call negtrc( 'After chemistry ', vmr, ncol ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Set upper boundary mmr values - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call set_fstrat_vals( vmr, pmid, pint, troplev, calday, ncol,lchnk ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Set fixed lower boundary mmr values - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call flbc_set( vmr, ncol, lchnk, map2chm ) - !----------------------------------------------------------------------- - ! set NOy UBC - !----------------------------------------------------------------------- - call noy_ubc_set( lchnk, ncol, vmr ) - if ( ghg_chem ) then call ghg_chem_set_flbc( vmr, ncol ) endif !----------------------------------------------------------------------- ! force ion/electron balance -- ext forcings likely do not conserve charge - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call charge_balance( ncol, vmr ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Xform from vmr to mmr - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- call vmr2mmr( vmr(:ncol,:,:), mmr_tend(:ncol,:,:), mbar(:ncol,:), ncol ) call set_short_lived_species( mmr_tend, lchnk, ncol, pbuf ) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! ... Form the tendencies - !----------------------------------------------------------------------- - do m = 1,gas_pcnst + !----------------------------------------------------------------------- + do m = 1,gas_pcnst mmr_new(:ncol,:,m) = mmr_tend(:ncol,:,m) mmr_tend(:ncol,:,m) = (mmr_tend(:ncol,:,m) - mmr(:ncol,:,m))*delt_inverse enddo @@ -1048,7 +1052,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & do m = 1,pcnst n = map2chm(m) if( n > 0 ) then - qtend(:ncol,:,m) = qtend(:ncol,:,m) + mmr_tend(:ncol,:,n) + qtend(:ncol,:,m) = qtend(:ncol,:,m) + mmr_tend(:ncol,:,n) end if end do @@ -1068,12 +1072,31 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, & do m = 1,pcnst n = map2chm( m ) if ( n > 0 ) then - cflx(:ncol,m) = cflx(:ncol,m) - sflx(:ncol,n) + if (cam_physpkg_is("cam7")) then + ! apply to qtend array + if (cnst_type(m).eq.'dry') then + qtend(:ncol,pver,m) = qtend(:ncol,pver,m) - sflx(:ncol,n)*rpdeldry(:ncol,pver)*gravit + else + qtend(:ncol,pver,m) = qtend(:ncol,pver,m) - sflx(:ncol,n)*rpdel(:ncol,pver)*gravit + end if + else + ! apply to emissions array + cflx(:ncol,m) = cflx(:ncol,m) - sflx(:ncol,n) + end if drydepflx(:ncol,m) = sflx(:ncol,n) wetdepflx_diag(:ncol,n) = wetdepflx(:ncol,m) endif end do + if (srf_ozone_pbf_ndx>0) then + call pbuf_get_field(pbuf, srf_ozone_pbf_ndx, srf_ozone_fld) + if (o3_ndx>0) then + srf_ozone_fld(:ncol) = vmr(:ncol,pver,o3_ndx) + else + srf_ozone_fld(:ncol) = invariants(:ncol,pver,o3_inv_ndx)/invariants(:ncol,pver,indexm) + endif + endif + call chm_diags( lchnk, ncol, vmr(:ncol,:,:), mmr_new(:ncol,:,:), & reaction_rates(:ncol,:,:), invariants(:ncol,:,:), depvel(:ncol,:), sflx(:ncol,:), & mmr_tend(:ncol,:,:), pdel(:ncol,:), pmid(:ncol,:), troplev(:ncol), wetdepflx_diag(:ncol,:), & diff --git a/src/chemistry/mozart/mo_jshort.F90 b/src/chemistry/mozart/mo_jshort.F90 index e6b635c7be..97ec5f1375 100644 --- a/src/chemistry/mozart/mo_jshort.F90 +++ b/src/chemistry/mozart/mo_jshort.F90 @@ -71,12 +71,15 @@ module mo_jshort real(r8), allocatable :: xs_o3b(:) real(r8), allocatable :: xs_wl(:,:) + real(r8), parameter :: lno2_llimit = 38._r8 ! ln(NO2) lower limit + real(r8), parameter :: lno2_ulimit = 56._r8 ! ln(NO2) upper limit + contains subroutine jshort_init( xs_coef_file, xs_short_file, sht_indexer ) !------------------------------------------------------------------------------ ! ... initialize photorates for 120nm <= lambda <= 200nm -!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ use mo_util, only : rebin use solar_irrad_data, only : data_nbins=>nbins, data_we => we, data_etf => sol_etf @@ -85,7 +88,7 @@ subroutine jshort_init( xs_coef_file, xs_short_file, sht_indexer ) !------------------------------------------------------------------------------ ! ... dummy arguments -!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ character(len=*), intent(in) :: xs_coef_file, xs_short_file integer, intent(inout) :: sht_indexer(:) @@ -211,18 +214,18 @@ subroutine get_crs( xs_short_file, sht_indexer ) do m = 1,phtcnt if( pht_alias_lst(m,1) == ' ' ) then ierr = pio_inq_varid( ncid, rxt_tag_lst(m), varid ) - if( ierr == PIO_noerr ) then + if( ierr == PIO_noerr ) then sht_indexer(m) = varid end if else if( pht_alias_lst(m,1) == 'userdefined' ) then sht_indexer(m) = -1 else ierr = pio_inq_varid( ncid, pht_alias_lst(m,1), varid ) - if( ierr == PIO_noerr ) then + if( ierr == PIO_noerr ) then sht_indexer(m) = varid else write(iulog,*) 'get_crs : ',rxt_tag_lst(m)(:len_trim(rxt_tag_lst(m))),' alias ', & - pht_alias_lst(m,1)(:len_trim(pht_alias_lst(m,1))),' not in dataset' + pht_alias_lst(m,1)(:len_trim(pht_alias_lst(m,1))),' not in dataset' call endrun end if end if @@ -252,39 +255,39 @@ subroutine get_crs( xs_short_file, sht_indexer ) ! ... allocate arrays !------------------------------------------------------------------------------ allocate( wc(nw),stat=ierr ) - if( ierr /= 0 ) then + if( ierr /= 0 ) then call alloc_err( ierr, 'get_crs', 'wc', nw ) end if allocate( we(nw+1),stat=ierr ) - if( ierr /= 0 ) then + if( ierr /= 0 ) then call alloc_err( ierr, 'get_crs', 'we', nw+1 ) end if allocate( wlintv(nw),stat=ierr ) - if( ierr /= 0 ) then + if( ierr /= 0 ) then call alloc_err( ierr, 'get_crs', 'wlintv', nw ) end if allocate( etfphot(nw),stat=ierr ) - if( ierr /= 0 ) then + if( ierr /= 0 ) then call alloc_err( ierr, 'get_crs', 'etfphot', nw ) end if allocate( bde_o2_a(nw),bde_o2_b(nw),bde_o3_a(nw),bde_o3_b(nw),stat=ierr ) - if( ierr /= 0 ) then + if( ierr /= 0 ) then call alloc_err( ierr, 'get_crs', 'bde_o2_a ... bde_o3_b', nw ) end if allocate( etfphot_ms93(nw_ms93),stat=ierr ) - if( ierr /= 0 ) then + if( ierr /= 0 ) then call alloc_err( ierr, 'get_crs', 'etfphot_ms93', nw_ms93 ) end if allocate( xs_o2src(nw),stat=ierr ) - if( ierr /= 0 ) then + if( ierr /= 0 ) then call alloc_err( ierr, 'get_crs', 'xs_o2src', nw ) end if allocate( xs_o3a(nw),xs_o3b(nw),stat=ierr ) - if( ierr /= 0 ) then + if( ierr /= 0 ) then call alloc_err( ierr, 'get_crs', 'xs_o3a,xs_o3b', nw ) end if allocate( xs_species(nw),xs_wl(nw,nj),stat=ierr ) - if( ierr /= 0 ) then + if( ierr /= 0 ) then call alloc_err( ierr, 'get_crs', 'xs_species,xs_wl', nw*nj ) end if @@ -371,7 +374,7 @@ subroutine xs_init(xs_coef_file) !------------------------------------------------------------------------------ ! ... Dummy arguments -!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ character(len=*), intent(in) :: xs_coef_file !------------------------------------------------------------- @@ -1227,7 +1230,7 @@ subroutine sphers( nlev, z, zenith_angle, dsdh, nid ) !------------------------------------------------------------------------------ ! Find index of layer in which the screening height lies !------------------------------------------------------------------------------ - id = i + id = i if( zenith_angle > 90._r8 ) then do j = 1,nlayer if( rpsinz < (zd(j-1) + re) .and. rpsinz >= (zd(j) + re) ) then @@ -1236,7 +1239,7 @@ subroutine sphers( nlev, z, zenith_angle, dsdh, nid ) end if end do end if - + do j = 1,id sm = 1._r8 if( j == id .and. id == i .and. zenith_angle > 90._r8 ) then @@ -1329,7 +1332,7 @@ subroutine slant_col( nlev, delz, dsdh, nid, absden, scol ) ! height needs to be increased for higher model top !------------------------------------------------------------------------------ if (nlev==pver) then - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then hscale = 20.e5_r8 else hscale = 10.e5_r8 @@ -1372,7 +1375,8 @@ subroutine lymana( nlev, o2scol, rm, ro2 ) ! bands and an effective O2 optical depth at all altitudes. Parameterized ! ! after: Chabrillat, S., and G. Kockarts, Simple parameterization of the ! ! absorption of the solar Lyman-Alpha line, Geophysical Research Letters, ! -! Vol.24, No.21, pp 2659-2662, 1997. ! +! Vol.24, No.21, pp 2659-2662, 1997. doi:10.1029/97GL52690 (note there is a ! +! correction to this paper - the table was missing minuses in the exponents)! !-----------------------------------------------------------------------------! ! PARAMETERS: ! ! nz - INTEGER, number of specified altitude levels in the working (I) ! @@ -1384,7 +1388,7 @@ subroutine lymana( nlev, o2scol, rm, ro2 ) ! xso2la - REAL, molecular absorption cross section in LA bands (O) ! !-----------------------------------------------------------------------------! ! EDIT HISTORY: ! -! 01/15/2002 Taken from Sasha Madronich's TUV Version 4.1a, Doug Kinnison ! ! +! 01/15/2002 Taken from Sasha Madronich's TUV Version 4.1a, Doug Kinnison ! ! 01/15/2002 Upgraded to F90, DK ! !-----------------------------------------------------------------------------! @@ -1491,17 +1495,17 @@ subroutine calc_o2srb( nlev, nid, o2col, tlev, tsrb, xscho2 ) do k = 1,nlev x = log( o2col(k) ) - if( x >= 38._r8 .and. x <= 56._r8 ) then + if( x >= lno2_llimit .and. x <= lno2_ulimit ) then call effxs( x, tlev(k), xs ) xscho2(k,:) = xs(:) - else if( x < 38._r8 ) then + else if( x < lno2_llimit ) then ktop1 = k-1 ktop = min( ktop1,ktop ) - else if( x > 56._r8 ) then + else if( x > lno2_ulimit ) then kbot = k end if end do - + if ( kbot == nlev ) then tsrb(:,:) = 0._r8 xscho2(:,:) = 0._r8 @@ -1511,9 +1515,9 @@ subroutine calc_o2srb( nlev, nid, o2col, tlev, tsrb, xscho2 ) ! ... Fill in cross section where X is out of range ! by repeating edge table values !------------------------------------------------------- - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - ! Need to be careful with nlev values for kbot and ktop. + ! Need to be careful with nlev values for kbot and ktop. ! This was handled by Hanli Liu fix. if ( kbot < nlev ) then do k = 1,kbot @@ -1544,7 +1548,7 @@ subroutine calc_o2srb( nlev, nid, o2col, tlev, tsrb, xscho2 ) !------------------------------------------------------- ! ... Calculate incremental optical depths !------------------------------------------------------- - do i = 1,nsrbtuv + do i = 1,nsrbtuv do k = 1,nlev-1 if( nid(nlev-k) /= -1 ) then !------------------------------------------------------- @@ -1600,9 +1604,9 @@ subroutine effxs( x, t, xs ) ! method: ! ln(xs) = A(X)[T-220]+B(X) ! X = log of slant column of O2 -! A,B calculated from chebyshev polynomial coeffs -! AC and BC using NR routine chebev. Assume interval -! is 38lno2_ulimit) then + call endrun('mo_jshort::calc_params of O2 abs xs: x is not in the valid range. ') + end if + !------------------------------------------------------------- -! ... call chebyshev evaluation routine to calc a and b from -! set of 20 coeficients for each wavelength +! ... evaluate at each wavelength +! for a set of 20 Chebyshev coeficients !------------------------------------------------------------- do i = 1,nsrbtuv - a(i) = jchebev( 38._r8, 56._r8, ac(1,i), 20, x ) - b(i) = jchebev( 38._r8, 56._r8, bc(1,i), 20, x ) + a(i) = evalchebpoly( ac(:,i), x ) + b(i) = evalchebpoly( bc(:,i), x ) end do contains - function jchebev( a, b, c, m, x ) -!------------------------------------------------------------- -! Chebyshev evaluation algorithm -! See Numerical recipes p193 -!------------------------------------------------------------- + ! Use Clenshaw summation algorithm to evaluate Chebyshev polynomial at point + ! [pnt - (lno2_ulimit + lno2_llimit)/2]/[(lno2_ulimit - lno2_llimit)/2] + ! given coefficients coefs within limits lim1 and lim2 + pure function evalchebpoly( coefs, pnt ) result(cval) + real(r8), intent(in) :: coefs(:) + real(r8), intent(in) :: pnt -!------------------------------------------------------------- -! ... Dummy arguments -!------------------------------------------------------------- - integer, intent(in) :: m - real(r8), intent(in) :: a, b, x - real(r8), intent(in) :: c(m) + real(r8) :: cval + real(r8) :: fac(2) + real(r8) :: csum(2) ! Clenshaw summation + integer :: ndx + integer :: ncoef - real(r8) :: jchebev -!------------------------------------------------------------- -! ... Local variables -!------------------------------------------------------------- - integer :: j - real(r8) :: d, dd, sv, y, y2 + ncoef = size(coefs) - if( (x - a)*(x - b) > 0._r8 ) then - write(iulog,*) 'x not in range in chebev', x - jchebev = 0._r8 - return - end if + fac(1) = (2._r8*pnt-lno2_llimit-lno2_ulimit)/(lno2_ulimit-lno2_llimit) + fac(2) = 2._r8*fac(1) - d = 0._r8 - dd = 0._r8 - y = (2._r8*x - a - b)/(b - a) - y2 = 2._r8*y - do j = m,2,-1 - sv = d - d = y2*d - dd + c(j) - dd = sv - end do + ! Clenshaw recurrence summation + csum(:) = 0.0_r8 + do ndx = ncoef, 2, -1 + cval = csum(1) + csum(1) = fac(2)*csum(1) - csum(2) + coefs(ndx) + csum(2) = cval + end do - jchebev = y*d - dd + .5_r8*c(1) + cval = fac(1)*csum(1) - csum(2) + 0.5_r8*coefs(1) - end function jchebev + end function evalchebpoly end subroutine calc_params diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 index b3747f7e75..4ef18fbaf6 100644 --- a/src/chemistry/mozart/mo_lightning.F90 +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -5,145 +5,210 @@ module mo_lightning use shr_kind_mod, only : r8 => shr_kind_r8 use ppgrid, only : begchunk, endchunk, pcols, pver - use phys_grid, only : ngcols_p + use phys_grid, only : ngcols_p => num_global_phys_cols use cam_abortutils, only : endrun use cam_logfile, only : iulog use spmd_utils, only : masterproc, mpicom + use physics_buffer, only : pbuf_get_index, physics_buffer_desc, pbuf_get_field, pbuf_get_chunk + use physics_buffer, only : pbuf_add_field, pbuf_set_field, dtype_r8 + implicit none private - public :: lightning_inti + + public :: lightning_readnl + public :: lightning_register + public :: lightning_init public :: lightning_no_prod public :: prod_no - save + real(r8),protected, allocatable :: prod_no(:,:,:) real(r8) :: factor = 0.1_r8 ! user-controlled scaling factor to achieve arbitrary no prod. - real(r8) :: geo_factor ! grid cell area factor - real(r8) :: vdist(16,3) ! vertical distribution of lightning - real(r8), allocatable :: prod_no(:,:,:) - real(r8), allocatable :: glob_prod_no_col(:,:) - real(r8), allocatable :: flash_freq(:,:) - integer :: no_ndx,xno_ndx - logical :: has_no_lightning_prod = .false. + real(r8) :: geo_factor = -huge(1._r8) ! grid cell area factor + real(r8), allocatable :: vdist(:,:) ! vertical distribution of lightning + + logical :: calc_nox_prod = .false. + logical :: calc_lightning = .false. + + integer :: flsh_frq_ndx = -1 + integer :: cldtop_ndx = -1, cldbot_ndx = -1 + + ! namelist parameter + real(r8) :: lght_no_prd_factor = -huge(1._r8) contains - subroutine lightning_inti( lght_no_prd_factor ) + !------------------------------------------------------------------------- + ! Read namelist options + !------------------------------------------------------------------------- + subroutine lightning_readnl(nlfile) + use namelist_utils, only : find_group_name + use spmd_utils, only : mpicom, masterprocid, mpi_real8, mpi_success + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + integer :: unitn, ierr + character(len=*), parameter :: subname = 'lightning_readnl' + + ! =================== + ! Namelist definition + ! =================== + namelist /lightning_nl/ lght_no_prd_factor + + ! ============= + ! Read namelist + ! ============= + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'lightning_nl', status=ierr) + if (ierr == 0) then + read(unitn, lightning_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + end if + + ! ============================ + ! Broadcast namelist variables + ! ============================ + call mpi_bcast(lght_no_prd_factor, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: lght_no_prd_factor') + end if + + if (masterproc) then + write(iulog,*) subname,' lght_no_prd_factor: ',lght_no_prd_factor + end if + + if( lght_no_prd_factor /= 1._r8 ) then + factor = factor*lght_no_prd_factor + end if + + end subroutine lightning_readnl + + !------------------------------------------------------------------------- + ! register phys buffer field for cloud to ground lightning flash frequency + ! to pass to the mediator for land model + !------------------------------------------------------------------------- + subroutine lightning_register() + + call pbuf_add_field('LGHT_FLASH_FREQ','global',dtype_r8,(/pcols/),flsh_frq_ndx) ! per minute + + end subroutine lightning_register + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + subroutine lightning_init( pbuf2d ) !---------------------------------------------------------------------- ! ... initialize the lightning module !---------------------------------------------------------------------- use mo_constants, only : pi - use mo_chem_utls, only : get_spc_ndx use cam_history, only : addfld, add_default, horiz_only use phys_control, only : phys_getopts - - implicit none + use time_manager, only : is_first_step !---------------------------------------------------------------------- ! ... dummy args !---------------------------------------------------------------------- - real(r8), intent(in) :: lght_no_prd_factor ! lightning no production factor + type(physics_buffer_desc), pointer :: pbuf2d(:,:) !---------------------------------------------------------------------- ! ... local variables !---------------------------------------------------------------------- - integer :: astat + integer :: astat, err logical :: history_cesm_forcing + character(len=*),parameter :: prefix = 'lightning_init: ' + + cldtop_ndx = pbuf_get_index('CLDTOP',errcode=err) + cldbot_ndx = pbuf_get_index('CLDBOT',errcode=err) + calc_lightning = cldtop_ndx>0 .and. cldbot_ndx>0 + + if (.not.calc_lightning) return + + calc_nox_prod = lght_no_prd_factor>0._r8 + + if (calc_nox_prod) then + + if (masterproc) write(iulog,*) prefix,'lightning no production scaling factor = ',factor + + !---------------------------------------------------------------------- + ! ... vdist(kk,itype) = % of lightning nox between (kk-1) and (kk) + ! km for profile itype + !---------------------------------------------------------------------- + allocate(vdist(16,3),stat=astat) + if( astat /= 0 ) then + write(iulog,*) prefix,'failed to allocate vdist; error = ',astat + call endrun(prefix//'failed to allocate vdist') + end if + vdist(:,1) = (/ 3.0_r8, 3.0_r8, 3.0_r8, 3.0_r8, 3.4_r8, 3.5_r8, 3.6_r8, 4.0_r8, & ! midlat cont + 5.0_r8, 7.0_r8, 9.0_r8, 14.0_r8, 16.0_r8, 14.0_r8, 8.0_r8, 0.5_r8 /) + vdist(:,2) = (/ 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 6.1_r8, & ! trop marine + 17.0_r8, 15.4_r8, 14.5_r8, 13.0_r8, 12.5_r8, 2.8_r8, 0.9_r8, 0.3_r8 /) + vdist(:,3) = (/ 2.0_r8, 2.0_r8, 2.0_r8, 1.5_r8, 1.5_r8, 1.5_r8, 3.0_r8, 5.8_r8, & ! trop cont + 7.6_r8, 9.6_r8, 11.0_r8, 14.0_r8, 14.0_r8, 14.0_r8, 8.2_r8, 2.3_r8 /) + + allocate( prod_no(pcols,pver,begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) prefix, 'failed to allocate prod_no; error = ',astat + call endrun(prefix//'failed to allocate prod_no') + end if + geo_factor = ngcols_p/(4._r8*pi) + + call addfld( 'LNO_COL_PROD', horiz_only, 'I', 'Tg N yr-1', 'lightning column NO source' ) + call addfld( 'LNO_PROD', (/ 'lev' /), 'I', 'molecules/cm3/s', 'lightning insitu NO source' ) + call addfld( 'FLASHENGY', horiz_only, 'I', 'J', 'lightning flash energy' ) ! flash energy + + call phys_getopts( history_cesm_forcing_out = history_cesm_forcing ) + if ( history_cesm_forcing ) then + call add_default('LNO_COL_PROD',1,' ') + endif + + if (is_first_step()) then + call pbuf_set_field(pbuf2d, flsh_frq_ndx, 0.0_r8) + endif - call phys_getopts( history_cesm_forcing_out = history_cesm_forcing ) - - no_ndx = get_spc_ndx('NO') - xno_ndx = get_spc_ndx('XNO') - - has_no_lightning_prod = no_ndx>0 .or. xno_ndx>0 - if (.not.has_no_lightning_prod) return - - - if( lght_no_prd_factor /= 1._r8 ) then - factor = factor*lght_no_prd_factor - end if - - - if (masterproc) write(iulog,*) 'lght_inti: lightning no production scaling factor = ',factor - - !---------------------------------------------------------------------- - ! ... vdist(kk,itype) = % of lightning nox between (kk-1) and (kk) - ! km for profile itype - !---------------------------------------------------------------------- - vdist(:,1) = (/ 3.0_r8, 3.0_r8, 3.0_r8, 3.0_r8, 3.4_r8, 3.5_r8, 3.6_r8, 4.0_r8, & ! midlat cont - 5.0_r8, 7.0_r8, 9.0_r8, 14.0_r8, 16.0_r8, 14.0_r8, 8.0_r8, 0.5_r8 /) - vdist(:,2) = (/ 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 6.1_r8, & ! trop marine - 17.0_r8, 15.4_r8, 14.5_r8, 13.0_r8, 12.5_r8, 2.8_r8, 0.9_r8, 0.3_r8 /) - vdist(:,3) = (/ 2.0_r8, 2.0_r8, 2.0_r8, 1.5_r8, 1.5_r8, 1.5_r8, 3.0_r8, 5.8_r8, & ! trop cont - 7.6_r8, 9.6_r8, 11.0_r8, 14.0_r8, 14.0_r8, 14.0_r8, 8.2_r8, 2.3_r8 /) - - allocate( prod_no(pcols,pver,begchunk:endchunk),stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'lght_inti: failed to allocate prod_no; error = ',astat - call endrun - end if - allocate( flash_freq(pcols,begchunk:endchunk),stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'lght_inti: failed to allocate flash_freq; error = ',astat - call endrun - end if - allocate( glob_prod_no_col(pcols,begchunk:endchunk),stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'lght_inti: failed to allocate glob_prod_no_col; error = ',astat - call endrun - end if - prod_no(:,:,:) = 0._r8 - flash_freq(:,:) = 0._r8 - geo_factor = ngcols_p/(4._r8*pi) - - - call addfld( 'LNO_COL_PROD', horiz_only, 'I', 'TG N/YR', 'lighting column NO source' ) - call addfld( 'LNO_PROD', (/ 'lev' /), 'I', '/cm3/s', 'lighting insitu NO source' ) - call addfld( 'FLASHFRQ', horiz_only, 'I', '1/MIN', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) - call addfld( 'FLASHENGY', horiz_only, 'I', ' ', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) - call addfld( 'CLDHGT', horiz_only, 'I', 'KM', 'cloud top height' ) ! cloud top height - call addfld( 'DCHGZONE', horiz_only, 'I', 'KM', 'depth of discharge zone' ) ! depth of discharge zone - call addfld( 'CGIC', horiz_only, 'I', 'RATIO', 'ratio of cloud-ground/intracloud discharges' ) ! ratio of cloud-ground/intracloud discharges - - if ( history_cesm_forcing ) then - call add_default('LNO_COL_PROD',1,' ') endif - end subroutine lightning_inti + call addfld( 'FLASHFRQ', horiz_only, 'I', 'min-1', 'lightning flash rate' ) ! flash frequency in grid box per minute (PPP) + call addfld( 'CLDHGT', horiz_only, 'I', 'km', 'cloud top height' ) ! cloud top height + call addfld( 'DCHGZONE', horiz_only, 'I', 'km', 'depth of discharge zone' ) ! depth of discharge zone + call addfld( 'CGIC', horiz_only, 'I', '1', 'ratio of cloud-ground/intracloud discharges' ) ! ratio of cloud-ground/intracloud discharges + call addfld( 'LGHTNG_CLD2GRND', horiz_only, 'I', 'min-1', 'clound-to-ground lightning flash rate') ! clound to ground flash frequency + end subroutine lightning_init + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- subroutine lightning_no_prod( state, pbuf2d, cam_in ) !---------------------------------------------------------------------- ! ... set no production from lightning !---------------------------------------------------------------------- use physics_types, only : physics_state - - use physics_buffer, only : pbuf_get_index, physics_buffer_desc, pbuf_get_field, pbuf_get_chunk use physconst, only : rga use phys_grid, only : get_rlat_all_p, get_wght_all_p use cam_history, only : outfld use camsrfexch, only : cam_in_t use shr_reprosum_mod, only : shr_reprosum_calc - use mo_constants, only : rearth, d2r - implicit none + use mo_constants, only : rearth, d2r !---------------------------------------------------------------------- ! ... dummy args !---------------------------------------------------------------------- type(physics_state), intent(in) :: state(begchunk:endchunk) ! physics state - type(physics_buffer_desc), pointer :: pbuf2d(:,:) type(cam_in_t), intent(in) :: cam_in(begchunk:endchunk) ! physics state !---------------------------------------------------------------------- ! ... local variables !---------------------------------------------------------------------- - real(r8), parameter :: land = 1._r8 - real(r8), parameter :: secpyr = 365._r8 * 8.64e4_r8 + real(r8), parameter :: land = 1._r8 + real(r8), parameter :: secpyr = 365._r8 * 8.64e4_r8 - integer :: i, c integer :: cldtind ! level index for cloud top integer :: cldbind ! level index for cloud base > 273k integer :: k, kk, zlow_ind, zhigh_ind, itype @@ -162,16 +227,20 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) real(r8) :: flash_energy(pcols,begchunk:endchunk) ! energy of flashes per second real(r8) :: prod_no_col(pcols,begchunk:endchunk) ! global no production rate for diagnostics real(r8) :: wrk, wrk1, wrk2(1) + integer :: icol ! column index integer :: ncol ! columns per chunk - integer :: lchnk ! columns per chunk + integer :: lchnk ! chunk index real(r8),pointer :: cldtop(:) ! cloud top level index real(r8),pointer :: cldbot(:) ! cloud bottom level index real(r8) :: zmid(pcols,pver) ! geopot height above surface at midpoints (m) real(r8) :: zint(pcols,pver+1,begchunk:endchunk) ! geopot height above surface at interfaces (m) real(r8) :: zsurf(pcols) ! geopot height above surface at interfaces (m) - real(r8) :: rlats(pcols,begchunk:endchunk) ! column latitudes in chunks + real(r8) :: rlats(pcols) ! column latitudes in chunks real(r8) :: wght(pcols) + real(r8) :: glob_prod_no_col(pcols,begchunk:endchunk) + real(r8) :: flash_freq(pcols,begchunk:endchunk) + !---------------------------------------------------------------------- ! ... parameters to determine cg/ic ratio [price and rind, 1993] !---------------------------------------------------------------------- @@ -184,26 +253,29 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) real(r8), parameter :: m2km = 1.e-3_r8 real(r8), parameter :: km2cm = 1.e5_r8 real(r8), parameter :: lat25 = 25._r8*d2r ! 25 degrees latitude in radians - integer :: cldtop_ndx, cldbot_ndx + real(r8) :: flash_freq_land, flash_freq_ocn + real(r8), pointer :: cld2grnd_flash_freq(:) + + if (.not.calc_lightning) return - if (.not.has_no_lightning_prod) return + nullify(cld2grnd_flash_freq) !---------------------------------------------------------------------- ! ... initialization !---------------------------------------------------------------------- flash_freq(:,:) = 0._r8 - prod_no(:,:,:) = 0._r8 - prod_no_col(:,:) = 0._r8 cldhgt(:,:) = 0._r8 dchgzone(:,:) = 0._r8 cgic(:,:) = 0._r8 flash_energy(:,:) = 0._r8 - glob_prod_no_col(:,:) = 0._r8 - cldtop_ndx = pbuf_get_index('CLDTOP') - cldbot_ndx = pbuf_get_index('CLDBOT') + if (calc_nox_prod) then + prod_no(:,:,:) = 0._r8 + prod_no_col(:,:) = 0._r8 + glob_prod_no_col(:,:) = 0._r8 + end if !-------------------------------------------------------------------------------- ! ... estimate flash frequency and resulting no emissions @@ -223,29 +295,30 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) ! with 1e17 n atoms per j. the total number of n atoms is then distributed ! over the complete column of grid boxes. !-------------------------------------------------------------------------------- - Chunk_loop : do c = begchunk,endchunk - ncol = state(c)%ncol - lchnk = state(c)%lchnk + Chunk_loop : do lchnk = begchunk,endchunk + ncol = state(lchnk)%ncol + call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), flsh_frq_ndx, cld2grnd_flash_freq ) call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldtop_ndx, cldtop ) call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldbot_ndx, cldbot ) - zsurf(:ncol) = state(c)%phis(:ncol)*rga - call get_rlat_all_p(c, ncol, rlats(1,c) ) - call get_wght_all_p(c, ncol, wght) + zsurf(:ncol) = state(lchnk)%phis(:ncol)*rga + call get_wght_all_p(lchnk, pcols, wght) do k = 1,pver - zmid(:ncol,k) = state(c)%zm(:ncol,k) + zsurf(:ncol) - zint(:ncol,k,c) = state(c)%zi(:ncol,k) + zsurf(:ncol) + zmid(:ncol,k) = state(lchnk)%zm(:ncol,k) + zsurf(:ncol) + zint(:ncol,k,lchnk) = state(lchnk)%zi(:ncol,k) + zsurf(:ncol) end do - zint(:ncol,pver+1,c) = state(c)%zi(:ncol,pver+1) + zsurf(:ncol) + zint(:ncol,pver+1,lchnk) = state(lchnk)%zi(:ncol,pver+1) + zsurf(:ncol) + + cld2grnd_flash_freq(:) = 0.0_r8 - col_loop : do i = 1,ncol + col_loop : do icol = 1,ncol !-------------------------------------------------------------------------------- ! ... find cloud top and bottom level above 273k !-------------------------------------------------------------------------------- - cldtind = nint( cldtop(i) ) - cldbind = nint( cldbot(i) ) + cldtind = nint( cldtop(icol) ) + cldbind = nint( cldbot(icol) ) do - if( cldbind <= cldtind .or. state(c)%t(i,cldbind) < t0 ) then + if( cldbind <= cldtind .or. state(lchnk)%t(icol,cldbind) < t0 ) then exit end if cldbind = cldbind - 1 @@ -254,58 +327,77 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) !-------------------------------------------------------------------------------- ! ... compute cloud top height and depth of charging zone !-------------------------------------------------------------------------------- - cldhgt(i,c) = m2km*max( 0._r8,zint(i,cldtind,c) ) - dchgz = cldhgt(i,c) - m2km*zmid(i,cldbind) - dchgzone(i,c) = dchgz + cldhgt(icol,lchnk) = m2km*max( 0._r8,zint(icol,cldtind,lchnk) ) + dchgz = cldhgt(icol,lchnk) - m2km*zmid(icol,cldbind) + dchgzone(icol,lchnk) = dchgz !-------------------------------------------------------------------------------- ! ... compute flash frequency for given cloud top height ! (flashes storm^-1 min^-1) !-------------------------------------------------------------------------------- - flash_freq_land = 3.44e-5_r8 * cldhgt(i,c)**4.9_r8 - flash_freq_ocn = 6.40e-4_r8 * cldhgt(i,c)**1.7_r8 - flash_freq(i,c) = cam_in(c)%landfrac(i)*flash_freq_land + & - cam_in(c)%ocnfrac(i) *flash_freq_ocn + flash_freq_land = 3.44e-5_r8 * cldhgt(icol,lchnk)**4.9_r8 + flash_freq_ocn = 6.40e-4_r8 * cldhgt(icol,lchnk)**1.7_r8 + flash_freq(icol,lchnk) = cam_in(lchnk)%landfrac(icol)*flash_freq_land + & + cam_in(lchnk)%ocnfrac(icol) *flash_freq_ocn !-------------------------------------------------------------------------------- - ! ... compute cg/ic ratio - ! cgic = proportion of cg flashes (=pg from ppp paper) + ! cgic = proportion of cloud-to-ground flashes + ! NOx from lightning 1. Global distribution based on lightning physics, C Price et al + ! JOURNAL OF GEOPHYSICAL RESEARCH, VOL. 102, NO. D5, PAGES 5929-5941, MARCH 20, 1997 + ! (https://agupubs.onlinelibrary.wiley.com/doi/epdf/10.1029/96JD03504) + ! eq 14 !-------------------------------------------------------------------------------- - cgic(i,c) = 1._r8/((((ca*dchgz + cb)*dchgz + cc) *dchgz + cd)*dchgz + ce) + cgic(icol,lchnk) = 1._r8/((((ca*dchgz + cb)*dchgz + cc) *dchgz + cd)*dchgz + ce) if( dchgz < 5.5_r8 ) then - cgic(i,c) = 0._r8 + cgic(icol,lchnk) = 0._r8 else if( dchgz > 14._r8 ) then - cgic(i,c) = .02_r8 + cgic(icol,lchnk) = .02_r8 end if - !-------------------------------------------------------------------------------- - ! ... compute flash energy (cg*6.7e9 + ic*6.7e8) - ! and convert to total energy per second - ! set ic = cg - !-------------------------------------------------------------------------------- - flash_energy(i,c) = 6.7e9_r8 * flash_freq(i,c)/60._r8 - !-------------------------------------------------------------------------------- - ! ... LKE Aug 23, 2005: scale production to account for different grid - ! box sizes. This requires a reduction in the overall fudge factor - ! (e.g., from 1.2 to 0.5) - !-------------------------------------------------------------------------------- - flash_energy(i,c) = flash_energy(i,c) * wght(i) * geo_factor - !-------------------------------------------------------------------------------- - ! ... compute number of n atoms produced per second - ! and convert to n atoms per second per cm2 and apply fudge factor - !-------------------------------------------------------------------------------- - prod_no_col(i,c) = 1.e17_r8*flash_energy(i,c)/(1.e4_r8*rearth*rearth*wght(i)) * factor - - !-------------------------------------------------------------------------------- - ! ... compute global no production rate in tgn/yr: - ! tgn per second: * 14.00674 * 1.65979e-24 * 1.e-12 - ! nb: 1.65979e-24 = 1/avo - ! tgn per year: * secpyr - !-------------------------------------------------------------------------------- - glob_prod_no_col(i,c) = 1.e17_r8*flash_energy(i,c) & - * 14.00674_r8 * 1.65979e-24_r8 * 1.e-12_r8 * secpyr * factor + cld2grnd_flash_freq(icol) = cam_in(lchnk)%landfrac(icol)*flash_freq_land*cgic(icol,lchnk) ! cld-to-grnd flash frq (per min) + + if (calc_nox_prod) then + !-------------------------------------------------------------------------------- + ! ... compute flash energy (cg*6.7e9 + ic*6.7e8) + ! and convert to total energy per second + ! set ic = cg + !-------------------------------------------------------------------------------- + flash_energy(icol,lchnk) = 6.7e9_r8 * flash_freq(icol,lchnk)/60._r8 + !-------------------------------------------------------------------------------- + ! ... LKE Aug 23, 2005: scale production to account for different grid + ! box sizes. This requires a reduction in the overall fudge factor + ! (e.g., from 1.2 to 0.5) + !-------------------------------------------------------------------------------- + flash_energy(icol,lchnk) = flash_energy(icol,lchnk) * wght(icol) * geo_factor + !-------------------------------------------------------------------------------- + ! ... compute number of n atoms produced per second + ! and convert to n atoms per second per cm2 and apply fudge factor + !-------------------------------------------------------------------------------- + prod_no_col(icol,lchnk) = 1.e17_r8*flash_energy(icol,lchnk)/(1.e4_r8*rearth*rearth*wght(icol)) * factor + + !-------------------------------------------------------------------------------- + ! ... compute global no production rate in tgn/yr: + ! tgn per second: * 14.00674 * 1.65979e-24 * 1.e-12 + ! nb: 1.65979e-24 = 1/avo + ! tgn per year: * secpyr + !-------------------------------------------------------------------------------- + glob_prod_no_col(icol,lchnk) = 1.e17_r8*flash_energy(icol,lchnk) & + * 14.00674_r8 * 1.65979e-24_r8 * 1.e-12_r8 * secpyr * factor + end if end if cloud_layer end do Col_loop + + call outfld( 'LGHTNG_CLD2GRND', cld2grnd_flash_freq, pcols, lchnk ) end do Chunk_loop + + do lchnk = begchunk,endchunk + call outfld( 'FLASHFRQ', flash_freq(:,lchnk), pcols, lchnk ) + call outfld( 'CGIC', cgic(:,lchnk), pcols, lchnk ) + call outfld( 'CLDHGT', cldhgt(:,lchnk), pcols, lchnk ) + call outfld( 'DCHGZONE', dchgzone(:,lchnk), pcols, lchnk ) + enddo + + if (.not.calc_nox_prod) return + !-------------------------------------------------------------------------------- ! ... Accumulate global total, convert to flashes per second ! ... Accumulate global NO production rate @@ -325,29 +417,29 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) !-------------------------------------------------------------------------------- ! ... Distribute production up to cloud top [Pickering et al., 1998 (JGR)] !-------------------------------------------------------------------------------- - do c = begchunk,endchunk - ncol = state(c)%ncol - lchnk = state(c)%lchnk + do lchnk = begchunk,endchunk + call get_rlat_all_p(lchnk, pcols, rlats) + ncol = state(lchnk)%ncol call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldtop_ndx, cldtop ) - do i = 1,ncol - cldtind = nint( cldtop(i) ) - if( prod_no_col(i,c) > 0._r8 ) then - if( cldhgt(i,c) > 0._r8 ) then - if( abs( rlats(i,c) ) > lat25 ) then - itype = 1 ! midlatitude continental - else if( nint( cam_in(c)%landfrac(i) ) == land ) then - itype = 3 ! tropical continental + do icol = 1,ncol + cldtind = nint( cldtop(icol) ) + if( prod_no_col(icol,lchnk) > 0._r8 ) then + if( cldhgt(icol,lchnk) > 0._r8 ) then + if( abs( rlats(icol) ) > lat25 ) then + itype = 1 ! midlatitude continental + else if( nint( cam_in(lchnk)%landfrac(icol) ) == land ) then + itype = 3 ! tropical continental else - itype = 2 ! topical marine + itype = 2 ! topical marine end if frac_sum = 0._r8 do k = cldtind,pver - zlow = zint(i,k+1,c) * m2km ! lower interface height (km) - zlow_scal = zlow * 16._r8/cldhgt(i,c) ! scale to 16 km convection height - zlow_ind = max( 1,INT(zlow_scal)+1 ) ! lowest vdist index to include in layer - zhigh = zint(i,k,c) * m2km ! upper interface height (km) - zhigh_scal = zhigh * 16._r8/cldhgt(i,c) ! height (km) scaled to 16km convection height - zhigh_ind = max( 1,MIN( 16,INT(zhigh_scal)+1 ) ) ! highest vdist index to include in layer + zlow = zint(icol,k+1,lchnk) * m2km ! lower interface height (km) + zlow_scal = zlow * 16._r8/cldhgt(icol,lchnk) ! scale to 16 km convection height + zlow_ind = max( 1,INT(zlow_scal)+1 ) ! lowest vdist index to include in layer + zhigh = zint(icol,k,lchnk) * m2km ! upper interface height (km) + zhigh_scal = zhigh * 16._r8/cldhgt(icol,lchnk) ! height (km) scaled to 16km convection height + zhigh_ind = max( 1,MIN( 16,INT(zhigh_scal)+1 ) ) ! highest vdist index to include in layer do kk = zlow_ind,zhigh_ind wrk = kk wrk1 = kk - 1 @@ -355,11 +447,11 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) - max( zlow_scal,wrk1 ) fraction = max( 0._r8, min( 1._r8,fraction ) ) frac_sum = frac_sum + fraction*vdist(kk,itype) - prod_no(i,k,c) = prod_no(i,k,c) & ! sum the fraction of column NOx in layer k + prod_no(icol,k,lchnk) = prod_no(icol,k,lchnk) & ! sum the fraction of column NOx in layer k + fraction*vdist(kk,itype)*.01_r8 end do - prod_no(i,k,c) = prod_no_col(i,c) * prod_no(i,k,c) & ! multiply fraction by column amount - / (km2cm*(zhigh - zlow)) ! and convert to atom N cm^-3 s^-1 + prod_no(icol,k,lchnk) = prod_no_col(icol,lchnk) * prod_no(icol,k,lchnk) & ! multiply fraction by column amount + / (km2cm*(zhigh - zlow)) ! and convert to atom N cm^-3 s^-1 end do end if end if @@ -370,15 +462,10 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) !-------------------------------------------------------------------------------- ! ... output lightning no production to history file !-------------------------------------------------------------------------------- - do c = begchunk,endchunk - lchnk = state(c)%lchnk - call outfld( 'LNO_PROD', prod_no(:,:,c), pcols, lchnk ) - call outfld( 'LNO_COL_PROD', glob_prod_no_col(:,c), pcols, lchnk ) - call outfld( 'FLASHFRQ', flash_freq(:,c), pcols, lchnk ) - call outfld( 'FLASHENGY', flash_energy(:,c), pcols, lchnk ) - call outfld( 'CLDHGT', cldhgt(:,c), pcols, lchnk ) - call outfld( 'DCHGZONE', dchgzone(:,c), pcols, lchnk ) - call outfld( 'CGIC', cgic(:,c), pcols, lchnk ) + do lchnk = begchunk,endchunk + call outfld( 'LNO_PROD', prod_no(:,:,lchnk), pcols, lchnk ) + call outfld( 'LNO_COL_PROD', glob_prod_no_col(:,lchnk), pcols, lchnk ) + call outfld( 'FLASHENGY', flash_energy(:,lchnk), pcols, lchnk ) enddo end subroutine lightning_no_prod diff --git a/src/chemistry/mozart/mo_lymana.F90 b/src/chemistry/mozart/mo_lymana.F90 deleted file mode 100644 index 71db02ab30..0000000000 --- a/src/chemistry/mozart/mo_lymana.F90 +++ /dev/null @@ -1,97 +0,0 @@ - - module mo_lymana - - use shr_kind_mod, only : r8 => shr_kind_r8 - - implicit none - - integer, parameter :: nla = 2 - - contains - - subroutine lymana( o2col, secchi, dto2la, xso2la ) -!----------------------------------------------------------------------------- -! purpose: -! calculate the effective absorption cross section of o2 in the lyman-alpha -! bands and an effective o2 optical depth at all altitudes. parameterized -! after: chabrillat, s., and g. kockarts, simple parameterization of the -! absorption of the solar lyman-alpha line, geophysical research letters, -! vol.24, no.21, pp 2659-2662, 1997. -!----------------------------------------------------------------------------- -! parameters: -! nz - integer, number of specified altitude levels in the working (i) -! grid -! o2col - real, slant overhead o2 column (molec/cc) at each specified (i) -! altitude -! dto2la - real, optical depth due to o2 absorption at each specified (o) -! vertical layer -! xso2la - real, molecular absorption cross section in la bands (o) -!----------------------------------------------------------------------------- - - use mo_params - use ppgrid, only: pver, pverp - - implicit none - -!----------------------------------------------------------------------------- -! ... dummy arguments -!----------------------------------------------------------------------------- - real(r8), intent(in) :: o2col(pverp) - real(r8), intent(in) :: secchi(pverp) - real(r8), intent(out) :: dto2la(pver,nla-1) - real(r8), intent(out) :: xso2la(pverp,nla-1) - -!----------------------------------------------------------------------------- -! ... local variables -!----------------------------------------------------------------------------- - integer :: i, k, kp1 - real(r8), dimension(pverp) :: rm, ro2 - real(r8), save :: b(3), c(3), d(3), e(3) - - data b / 6.8431e-01_r8, 2.29841e-01_r8, 8.65412e-02_r8/, & - c /8.22114e-21_r8, 1.77556e-20_r8, 8.22112e-21_r8/, & - d / 6.0073e-21_r8, 4.28569e-21_r8, 1.28059e-20_r8/, & - e /8.21666e-21_r8, 1.63296e-20_r8, 4.85121e-17_r8/ - -!----------------------------------------------------------------------------- -! ... calculate reduction factors at every altitude -!----------------------------------------------------------------------------- - rm(:) = 0._r8 - ro2(:) = 0._r8 - do k = 1,pverp - do i = 1,3 - rm(k) = rm(k) + b(i) * exp( -c(i)*o2col(k) ) - ro2(k) = ro2(k) + d(i) * exp( -e(i)*o2col(k) ) - end do - end do - -!----------------------------------------------------------------------------- -! ... calculate effective o2 optical depths and effective o2 cross sections -!----------------------------------------------------------------------------- - do k = 1,pver - if( rm(k) > 1.e-100_r8 ) then - kp1 = k + 1 - if( rm(kp1) > 0._r8 ) then - dto2la(k,1) = log( rm(kp1) )/secchi(kp1) - log( rm(k) )/secchi(k) - else - dto2la(k,1) = 1000._r8 - end if - else - dto2la(k,1) = 1000._r8 - end if - end do - do k = 1,pverp - if( rm(k) > 1.e-100_r8 ) then - if( ro2(k) > 1.e-100_r8 ) then - xso2la(k,1) = ro2(k)/rm(k) - else - xso2la(k,1) = 0._r8 - end if - else - xso2la(k,1) = 0._r8 - end if - end do - - end subroutine lymana - - end module mo_lymana diff --git a/src/chemistry/mozart/mo_neu_wetdep.F90 b/src/chemistry/mozart/mo_neu_wetdep.F90 index a0ad421536..f6d94a6bcc 100644 --- a/src/chemistry/mozart/mo_neu_wetdep.F90 +++ b/src/chemistry/mozart/mo_neu_wetdep.F90 @@ -12,7 +12,7 @@ module mo_neu_wetdep use constituents, only : pcnst use spmd_utils, only : masterproc use cam_abortutils, only : endrun - use seq_drydep_mod, only : n_species_table, species_name_table, dheff + use shr_drydep_mod, only : n_species_table, species_name_table, dheff use gas_wetdep_opts, only : gas_wetdep_method, gas_wetdep_list, gas_wetdep_cnt ! implicit none @@ -27,6 +27,7 @@ module mo_neu_wetdep real(r8),allocatable, dimension(:) :: mol_weight logical ,allocatable, dimension(:) :: ice_uptake integer :: index_cldice,index_cldliq,nh3_ndx,co2_ndx,so2_ndx + integer :: so4_ndx,so4s_ndx ! geos-chem logical :: debug = .false. integer :: hno3_ndx = 0 ! @@ -51,7 +52,7 @@ subroutine neu_wetdep_init ! use constituents, only : cnst_get_ind,cnst_mw use cam_history, only : addfld, add_default, horiz_only - use phys_control, only : phys_getopts + use phys_control, only : phys_getopts, cam_chempkg_is ! integer :: m,l character*20 :: test_name @@ -85,6 +86,9 @@ subroutine neu_wetdep_init ! mapping based on the MOZART4 wet removal subroutine; ! this might need to be redone (JFL: Sep 2010) ! +! Skip mapping if using GEOS-Chem; all GEOS-Chem species are in dep_data_file +! (heff table) specified in namelist drv_flds_in (EWL: Dec 2022) + if ( .not. cam_chempkg_is('geoschem_mam4') ) then select case( trim(test_name) ) ! ! CCMI: added SO2t and NH_50W @@ -108,6 +112,7 @@ subroutine neu_wetdep_init case( 'SOAGbb4' ) test_name = 'SOAGff4' end select + endif ! do l = 1,n_species_table ! @@ -138,6 +143,12 @@ subroutine neu_wetdep_init if ( trim(test_name) == 'SO2' ) then so2_ndx = m end if + if ( trim(test_name) == 'SO4' ) then ! GEOS-Chem bulk sulfate + so4_ndx = m + end if + if ( trim(test_name) == 'SO4S' ) then ! GEOS-Chem bulk sulfate on surface seasalt + so4s_ndx = m + end if ! end do @@ -188,7 +199,6 @@ subroutine neu_wetdep_init call addfld ('WD_'//trim(gas_wetdep_list(m)),horiz_only, 'A','kg/m2/s','vertical integrated wet deposition flux') call addfld ('HEFF_'//trim(gas_wetdep_list(m)),(/ 'lev' /), 'A','M/atm','Effective Henrys Law coeff.') if (history_chemistry) then - call add_default('DTWR_'//trim(gas_wetdep_list(m)), 1, ' ') call add_default('WD_'//trim(gas_wetdep_list(m)), 1, ' ') end if end do @@ -214,10 +224,10 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & prain, nevapr, cld, cmfdqr, wd_tend, wd_tend_int) ! use ppgrid, only : pcols, pver -!!DEK use phys_grid, only : get_area_all_p, get_rlat_all_p use shr_const_mod, only : SHR_CONST_REARTH,SHR_CONST_G use cam_history, only : outfld + use shr_const_mod, only : pi => shr_const_pi ! implicit none ! @@ -238,7 +248,7 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & ! ! local arrays and variables ! - integer :: i,k,l,kk,m,id + integer :: i,k,l,kk,m real(r8), parameter :: rearth = SHR_CONST_REARTH ! radius earth (m) real(r8), parameter :: gravit = SHR_CONST_G ! m/s^2 real(r8), dimension(ncol) :: area, wk_out @@ -260,14 +270,13 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & real(r8), parameter :: ph_inv = 1._r8/ph real(r8) :: e298, dhr real(r8), dimension(ncol) :: dk1s,dk2s,wrk -!!DEK - real(r8) :: pi real(r8) :: lats(pcols) + + real(r8), parameter :: rad2deg = 180._r8/pi + ! ! from cam/src/physics/cam/stratiform.F90 ! -!!DEK - pi = 4._r8*atan(1.0_r8) if (.not.do_neu_wetdep) return ! @@ -330,7 +339,6 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & end do ! ! compute effective Henry's law coefficients -! code taken from models/drv/shr/seq_drydep_mod.F90 ! heff = 0._r8 do k=1,pver @@ -342,14 +350,13 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & do m=1,gas_wetdep_cnt ! l = mapping_to_heff(m) - id = 6*(l - 1) - e298 = dheff(id+1) - dhr = dheff(id+2) + e298 = dheff(1,l) + dhr = dheff(2,l) heff(:,k,m) = e298*exp( dhr*wrk(:) ) test_flag = -99 - if( dheff(id+3) /= 0._r8 .and. dheff(id+5) == 0._r8 ) then - e298 = dheff(id+3) - dhr = dheff(id+4) + if( dheff(3,l) /= 0._r8 .and. dheff(5,l) == 0._r8 ) then + e298 = dheff(3,l) + dhr = dheff(4,l) dk1s(:) = e298*exp( dhr*wrk(:) ) where( heff(:,k,m) /= 0._r8 ) heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph_inv) @@ -363,21 +370,21 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & write(iulog, '(a,i4)') 'heff for m=',m endif ! - if( dheff(id+5) /= 0._r8 ) then - if( nh3_ndx > 0 .or. co2_ndx > 0 .or. so2_ndx > 0 ) then - e298 = dheff(id+3) - dhr = dheff(id+4) + if( dheff(5,l) /= 0._r8 ) then + if( nh3_ndx > 0 .or. co2_ndx > 0 .or. so2_ndx > 0 .or. so4_ndx > 0 .or. so4s_ndx > 0 ) then + e298 = dheff(3,l) + dhr = dheff(4,l) dk1s(:) = e298*exp( dhr*wrk(:) ) - e298 = dheff(id+5) - dhr = dheff(id+6) + e298 = dheff(5,l) + dhr = dheff(6,l) dk2s(:) = e298*exp( dhr*wrk(:) ) - if( m == co2_ndx .or. m == so2_ndx ) then + if( m == co2_ndx .or. m == so2_ndx .or. m == so4_ndx .or. m == so4s_ndx ) then heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph_inv*(1._r8 + dk2s(:)*ph_inv)) else if( m == nh3_ndx ) then heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph/dk2s(:)) else - write(iulog,*) 'error in assigning henrys law coefficients' - write(iulog,*) 'species ',m + if ( masterproc ) write(iulog,*) 'error in assigning henrys law coefficients' + if ( masterproc ) write(iulog,*) 'species ',m end if end if end if @@ -424,11 +431,11 @@ subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, & dtwr(1:ncol,:,:) = wd_mmr(1:ncol,:,:) - dtwr(1:ncol,:,:) dtwr(1:ncol,:,:) = dtwr(1:ncol,:,:) / delt -!!DEK polarward of 60S, 60N and <200hPa set to zero! +! polarward of 60S, 60N and <200hPa set to zero! call get_rlat_all_p(lchnk, pcols, lats ) do k = 1, pver do i= 1, ncol - if ( abs( lats(i)*180._r8/pi ) > 60._r8 ) then + if ( abs( lats(i)*rad2deg ) > 60._r8 ) then if ( pmid(i,k) < 20000._r8) then dtwr(i,k,:) = 0._r8 endif diff --git a/src/chemistry/mozart/mo_photo.F90 b/src/chemistry/mozart/mo_photo.F90 index d02570d5b0..5ef22df875 100644 --- a/src/chemistry/mozart/mo_photo.F90 +++ b/src/chemistry/mozart/mo_photo.F90 @@ -4,24 +4,23 @@ module mo_photo !---------------------------------------------------------------------- use shr_kind_mod, only : r8 => shr_kind_r8 - use ppgrid, only : pcols, pver, pverp, begchunk, endchunk + use ppgrid, only : pcols, pver, begchunk, endchunk use cam_abortutils, only : endrun - use mo_constants, only : pi,r2d,boltz,d2r - use ref_pres, only : num_pr_lev, ptop_ref + use mo_constants, only : r2d,d2r + use ref_pres, only : num_pr_lev, ptop_ref use pio use cam_pio_utils, only : cam_pio_openfile use spmd_utils, only : masterproc use cam_logfile, only : iulog - use phys_control, only : waccmx_is use solar_parms_data, only : f107=>solar_parms_f107, f107a=>solar_parms_f107a implicit none private - public :: photo_inti, table_photo, xactive_photo + public :: photo_inti, table_photo public :: set_ub_col - public :: setcol + public :: setcol public :: photo_timestep_init public :: photo_register @@ -33,15 +32,8 @@ module mo_photo integer :: jno_ndx integer :: jonitr_ndx integer :: jho2no2_ndx - integer :: jch3cho_a_ndx, jch3cho_b_ndx, jch3cho_c_ndx integer :: jo2_a_ndx, jo2_b_ndx integer :: ox_ndx, o3_ndx, o3_inv_ndx, o3rad_ndx - integer :: oc1_ndx, oc2_ndx - integer :: cb1_ndx, cb2_ndx - integer :: soa_ndx - integer :: ant_ndx - integer :: so4_ndx - integer :: sa1_ndx, sa2_ndx, sa3_ndx, sa4_ndx integer :: n2_ndx, no_ndx, o2_ndx, o_ndx integer, allocatable :: lng_indexer(:) integer, allocatable :: sht_indexer(:) @@ -71,21 +63,18 @@ module mo_photo integer :: jhno3_ndx, jno3_ndx, jpan_ndx, jmpan_ndx integer :: jo1da_ndx, jo3pa_ndx, jno2a_ndx, jn2o5a_ndx, jn2o5b_ndx - integer :: jhno3a_ndx, jno3a_ndx, jpana_ndx, jmpana_ndx, jho2no2a_ndx + integer :: jhno3a_ndx, jno3a_ndx, jpana_ndx, jmpana_ndx, jho2no2a_ndx integer :: jonitra_ndx integer :: jppi_ndx, jepn1_ndx, jepn2_ndx, jepn3_ndx, jepn4_ndx, jepn6_ndx integer :: jepn7_ndx, jpni1_ndx, jpni2_ndx, jpni3_ndx, jpni4_ndx, jpni5_ndx logical :: do_jeuv = .false. logical :: do_jshort = .false. -#ifdef DEBUG - logical :: do_diag = .false. -#endif integer :: ion_rates_idx = -1 contains - + !---------------------------------------------------------------------- !---------------------------------------------------------------------- subroutine photo_register @@ -94,7 +83,7 @@ subroutine photo_register ! add photo-ionization rates to phys buffer for waccmx ionosphere module - call pbuf_add_field('IonRates' , 'physpkg', dtype_r8, (/pcols,pver,nIonRates/), ion_rates_idx) ! Ionization rates for O+,O2+,N+,N2+,NO+ + call pbuf_add_field('IonRates' , 'physpkg', dtype_r8, (/pcols,pver,nIonRates/), ion_rates_idx) ! Ionization rates for O+,O2+,N+,N2+,NO+ endsubroutine photo_register @@ -102,15 +91,11 @@ subroutine photo_register !---------------------------------------------------------------------- subroutine photo_inti( xs_coef_file, xs_short_file, xs_long_file, rsf_file, & photon_file, electron_file, & - exo_coldens_file, tuv_xsect_file, o2_xsect_file, xactive_prates ) + exo_coldens_file, maxzen ) !---------------------------------------------------------------------- ! ... initialize photolysis module !---------------------------------------------------------------------- - use mo_photoin, only : photoin_inti - use mo_tuv_inti, only : tuv_inti - use mo_tuv_inti, only : nlng - use mo_seto2, only : o2_xsect_inti use interpolate_data, only: lininterp_init, lininterp, lininterp_finish, interp_type use chem_mods, only : phtcnt use chem_mods, only : ncol_abs => nabscol @@ -119,10 +104,9 @@ subroutine photo_inti( xs_coef_file, xs_short_file, xs_long_file, rsf_file, & use ioFileMod, only : getfil use mo_chem_utls, only : get_spc_ndx, get_rxt_ndx, get_inv_ndx use mo_jlong, only : jlong_init - use seasalt_model, only : sslt_names=>seasalt_names, sslt_ncnst=>seasalt_nbin use mo_jshort, only : jshort_init use mo_jeuv, only : jeuv_init, neuv - use phys_grid, only : get_ncols_p, get_rlat_all_p + use phys_grid, only : get_ncols_p, get_rlat_all_p use solar_irrad_data,only : has_spectrum use photo_bkgrnd, only : photo_bkgrnd_init use cam_history, only : addfld @@ -134,10 +118,8 @@ subroutine photo_inti( xs_coef_file, xs_short_file, xs_long_file, rsf_file, & !---------------------------------------------------------------------- character(len=*), intent(in) :: xs_long_file, rsf_file character(len=*), intent(in) :: exo_coldens_file - character(len=*), intent(in) :: tuv_xsect_file - character(len=*), intent(in) :: o2_xsect_file - logical, intent(in) :: xactive_prates - ! waccm + real(r8), intent(in) :: maxzen + ! waccm character(len=*), intent(in) :: xs_coef_file character(len=*), intent(in) :: xs_short_file character(len=*), intent(in) :: photon_file @@ -173,25 +155,22 @@ subroutine photo_inti( xs_coef_file, xs_short_file, xs_long_file, rsf_file, & return end if - !---------------------------------------------------------------------------- - ! Need a larger maximum zenith angle for WACCM-X extended to high altitudes - !---------------------------------------------------------------------------- - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - max_zen_angle = 116._r8 - else if ( ptop_ref < 10._r8 ) then - max_zen_angle = 97.01_r8 ! degrees - else - max_zen_angle = 88.85_r8 ! degrees - endif + ! maximum solar zenith angle for which photo-chemical rates are computed + max_zen_angle = maxzen + if (.not. max_zen_angle>0._r8) then + write(iulog,*) 'photo_inti: max_zen_angle = ',max_zen_angle + call endrun ('photo_inti: max_zen_angle must be greater then zero') + end if + - ! jeuv_1,,, jeuv_25 --> need euv calculations --> must be waccm + ! jeuv_1,,, jeuv_25 --> need euv calculations --> must be waccm ! how to determine if shrt calc is needed ?? -- use top level pressure => waccm = true ? false if ( .not. has_spectrum ) then write(iulog,*) 'photo_inti: solar_irrad_data file needs to contain irradiance spectrum' call endrun('photo_inti: ERROR -- solar irradiance spectrum is missing') endif - + !---------------------------------------------------------------------- ! ... allocate indexers !---------------------------------------------------------------------- @@ -287,37 +266,27 @@ subroutine photo_inti( xs_coef_file, xs_short_file, xs_long_file, rsf_file, & end if do_jshort = o_ndx>0 .and. o2_ndx>0 .and. (o3_ndx>0.or.o3_inv_ndx>0) .and. n2_ndx>0 .and. no_ndx>0 - + call jeuv_init( photon_file, electron_file, euv_indexer ) do_jeuv = any(euv_indexer(:)>0) !---------------------------------------------------------------------- ! ... call module initializers !---------------------------------------------------------------------- - is_xactive : if( xactive_prates ) then - do_jshort = .false. - jch3cho_a_ndx = get_rxt_ndx( 'jch3cho_a' ) - jch3cho_b_ndx = get_rxt_ndx( 'jch3cho_b' ) - jch3cho_c_ndx = get_rxt_ndx( 'jch3cho_c' ) - jonitr_ndx = get_rxt_ndx( 'jonitr' ) - jho2no2_ndx = get_rxt_ndx( 'jho2no2' ) - call tuv_inti( pverp, tuv_xsect_file, lng_indexer ) - else is_xactive - call jlong_init( xs_long_file, rsf_file, lng_indexer ) - if (do_jeuv) then - call photo_bkgrnd_init() - call addfld('Qbkgndtot', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) - call addfld('Qbkgnd_o1', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) - call addfld('Qbkgnd_o2', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) - call addfld('Qbkgnd_n2', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) - call addfld('Qbkgnd_n1', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) - call addfld('Qbkgnd_no', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) - endif - if (do_jshort) then - call jshort_init( xs_coef_file, xs_short_file, sht_indexer ) - endif - jho2no2_ndx = get_rxt_ndx( 'jho2no2_b' ) - end if is_xactive + call jlong_init( xs_long_file, rsf_file, lng_indexer ) + if (do_jeuv) then + call photo_bkgrnd_init() + call addfld('Qbkgndtot', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) + call addfld('Qbkgnd_o1', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) + call addfld('Qbkgnd_o2', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) + call addfld('Qbkgnd_n2', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) + call addfld('Qbkgnd_n1', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) + call addfld('Qbkgnd_no', (/ 'lev' /), 'A','cm-3 sec-1', 'background ionization rate ' ) + endif + if (do_jshort) then + call jshort_init( xs_coef_file, xs_short_file, sht_indexer ) + endif + jho2no2_ndx = get_rxt_ndx( 'jho2no2_b' ) !---------------------------------------------------------------------- ! ... check that each photorate is in short or long datasets @@ -380,11 +349,6 @@ subroutine photo_inti( xs_coef_file, xs_short_file, xs_long_file, rsf_file, & write(iulog,*) ' ' endif - if( xactive_prates ) then - call o2_xsect_inti( o2_xsect_file ) - call photoin_inti( nlng, lng_indexer ) - end if - !---------------------------------------------------------------------- ! ... check for o2, o3 absorber columns !---------------------------------------------------------------------- @@ -417,20 +381,6 @@ subroutine photo_inti( xs_coef_file, xs_short_file, xs_long_file, rsf_file, & has_o3_col = .false. endif - oc1_ndx = get_spc_ndx( 'OC1' ) - oc2_ndx = get_spc_ndx( 'OC2' ) - cb1_ndx = get_spc_ndx( 'CB1' ) - cb2_ndx = get_spc_ndx( 'CB2' ) - soa_ndx = get_spc_ndx( 'SOA' ) - ant_ndx = get_spc_ndx( 'NH4NO3' ) - so4_ndx = get_spc_ndx( 'SO4' ) - if (sslt_ncnst == 4) then - sa1_ndx = get_spc_ndx( sslt_names(1) ) - sa2_ndx = get_spc_ndx( sslt_names(2) ) - sa3_ndx = get_spc_ndx( sslt_names(3) ) - sa4_ndx = get_spc_ndx( sslt_names(4) ) - endif - has_abs_columns : if( has_o2_col .or. has_o3_col ) then !----------------------------------------------------------------------- ! ... open exo coldens file @@ -645,7 +595,7 @@ subroutine table_photo( photos, pmid, pdel, temper, zmid, zint, & real(r8), allocatable :: lng_prates(:,:) ! photorates matrix (1/s) real(r8), allocatable :: sht_prates(:,:) ! photorates matrix (1/s) real(r8), allocatable :: euv_prates(:,:) ! photorates matrix (1/s) - + real(r8), allocatable :: zarg(:) real(r8), allocatable :: tline(:) ! vertical temperature array @@ -682,7 +632,7 @@ subroutine table_photo( photos, pmid, pdel, temper, zmid, zint, & if ((.not.do_jshort) .or. (ptop_ref < 10._r8)) then n_jshrt_levs = pver - p1 = 1 + p1 = 1 p2 = pver else n_jshrt_levs = pver+1 @@ -714,7 +664,7 @@ subroutine table_photo( photos, pmid, pdel, temper, zmid, zint, & end if endif endif - + if (nsht>0) then allocate( sht_prates(n_jshrt_levs,nsht),stat=astat ) if( astat /= 0 ) then @@ -787,7 +737,7 @@ subroutine table_photo( photos, pmid, pdel, temper, zmid, zint, & lwc_line(:) = lwc(i,:) cld_line(:) = clouds(i,:) - + tline(p1:p2) = temper(i,:pver) zarg(p1:p2) = zmid(i,:pver) @@ -805,7 +755,7 @@ subroutine table_photo( photos, pmid, pdel, temper, zmid, zint, & if (jpni3_ndx > 0 ) photos(i,:,jpni3_ndx) = photos(i,:,jpni3_ndx) + esfact * 0.15_r8 if (jpni4_ndx > 0 ) photos(i,:,jpni4_ndx) = photos(i,:,jpni4_ndx) + esfact * 6.2e-3_r8 ! added to v02 - if (jpni5_ndx > 0 ) photos(i,:,jpni5_ndx) = photos(i,:,jpni5_ndx) + esfact * 1.0_r8 + if (jpni5_ndx > 0 ) photos(i,:,jpni5_ndx) = photos(i,:,jpni5_ndx) + esfact * 1.0_r8 endif if (do_jshort) then if ( ptop_ref > 10._r8 ) then @@ -840,7 +790,7 @@ subroutine table_photo( photos, pmid, pdel, temper, zmid, zint, & ! ... short wave length component !----------------------------------------------------------------- call jshort( n_jshrt_levs, sza, n2_den, o2_den, o3_den, & - no_den, tline, zarg, jo2_sht, jno_sht, sht_prates ) + no_den, tline, zarg, jo2_sht, jno_sht, sht_prates ) do m = 1,phtcnt if( sht_indexer(m) > 0 ) then @@ -880,7 +830,7 @@ subroutine table_photo( photos, pmid, pdel, temper, zmid, zint, & !----------------------------------------------------------------- ! ... long wave length component !----------------------------------------------------------------- - call jlong( pver, sza, eff_alb, parg, tline, colo3, lng_prates ) + call jlong( pver, sza, eff_alb, parg, tline, colo3, lng_prates ) do m = 1,phtcnt if( lng_indexer(m) > 0 ) then alias_factor = pht_alias_mult(m,2) @@ -912,9 +862,9 @@ subroutine table_photo( photos, pmid, pdel, temper, zmid, zint, & ! Save photo-ionization rates to physics buffer accessed in ionosphere module for WACCMX if (ion_rates_idx>0) then - + ionRates(i,1:pver,1:nIonRates) = esfact * euv_prates(1:pver,1:nIonRates) - + endif end if daylight @@ -930,7 +880,7 @@ subroutine table_photo( photos, pmid, pdel, temper, zmid, zint, & endif end do col_loop - + if ( do_jeuv ) then qbktot(:ncol,:) = qbko1(:ncol,:)+qbko2(:ncol,:)+qbkn2(:ncol,:)+qbkn1(:ncol,:)+qbkno(:ncol,:) call outfld( 'Qbkgndtot', qbktot(:ncol,:),ncol, lchnk ) @@ -959,321 +909,6 @@ subroutine table_photo( photos, pmid, pdel, temper, zmid, zint, & end subroutine table_photo - subroutine xactive_photo( photos, vmr, temper, cwat, cldfr, & - pmid, zmid, col_dens, zen_angle, srf_alb, & - tdens, ps, ts, esfact, relhum, dust_vmr, & - dt_diag, fracday, & - ncol, lchnk ) - !----------------------------------------------------------------- - ! ... fast online photo rates - !----------------------------------------------------------------- - - use ppgrid, only : pver, pverp - use chem_mods, only : ncol_abs => nabscol, pcnstm1 => gas_pcnst, phtcnt - use chem_mods, only : pht_alias_mult - use mo_params, only : kw - use mo_wavelen, only : nw - use mo_photoin, only : photoin - use mo_tuv_inti, only : nlng - use time_manager, only : get_curr_date - use dust_model, only : dust_nbin - use phys_grid, only : get_rlat_all_p, get_rlon_all_p - - implicit none - - !---------------------------------------------------------------- - ! ... dummy arguments - !----------------------------------------------------------------- - integer, intent(in) :: ncol, lchnk - real(r8), intent(in) :: esfact ! earth sun distance factor - real(r8), intent(in) :: ps(pcols) ! surface pressure (Pa) - real(r8), intent(in) :: ts(ncol) ! surface temperature (K) - real(r8), intent(in) :: col_dens(ncol,pver,ncol_abs) ! column densities (molecules/cm^2) - real(r8), intent(in) :: zen_angle(ncol) ! solar zenith angle (radians) - real(r8), intent(in) :: srf_alb(pcols) ! surface albedo - real(r8), intent(in) :: tdens(ncol,pver) ! total atms density (molecules/cm^3) - real(r8), intent(in) :: vmr(ncol,pver,pcnstm1) ! species concentration (mol/mol) - real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressure (Pa) - real(r8), intent(in) :: zmid(ncol,pver) ! midpoint height (m) - real(r8), intent(in) :: temper(pcols,pver) ! midpoint temperature (K) - real(r8), intent(in) :: relhum(ncol,pver) ! relative humidity - real(r8), intent(in) :: cwat(ncol,pver) ! cloud water (kg/kg) - real(r8), intent(in) :: cldfr(ncol,pver) ! cloud fraction - real(r8), intent(in) :: dust_vmr(ncol,pver,dust_nbin)! dust concentration (mol/mol) - real(r8), intent(inout) :: photos(ncol,pver,phtcnt) ! photodissociation rates (1/s) - real(r8), intent(out) :: dt_diag(pcols,8) ! od diagnostics - real(r8), intent(out) :: fracday(pcols) ! fraction of day - !----------------------------------------------------------------- - ! ... local variables - !----------------------------------------------------------------- - integer, parameter :: k_diag = 3 - real(r8), parameter :: secant_limit = 50._r8 - - integer :: astat - integer :: i ! index - integer :: k ! index - integer :: m ! index - integer :: ndx ! index - integer :: spc_ndx ! index - integer :: yr, mon, day, tod ! time of day (seconds past 0Z) - integer :: ncdate ! current date(yyyymmdd) - - real(r8) :: sza - real(r8) :: secant - real(r8) :: alias_factor - real(r8) :: alat - real(r8) :: along - real(r8) :: ut - real(r8) :: fac1(pver) ! work space for j(no) calc - real(r8) :: fac2(pver) ! work space for j(no) calc - real(r8) :: tlay(pver) ! vertical temperature array at layer midpoint - real(r8) :: tline(pverp) ! vertical temperature array - real(r8) :: xlwc(pverp) ! cloud water (kg/kg) - real(r8) :: xfrc(pverp) ! cloud fraction xuexi - real(r8) :: airdens(pverp) ! atmospheric density - real(r8) :: o3line(pverp) ! vertical o3 vmr - real(r8) :: aerocs1(pverp) - real(r8) :: aerocs2(pverp) - real(r8) :: aercbs1(pverp) - real(r8) :: aercbs2(pverp) - real(r8) :: aersoa(pverp) - real(r8) :: aerant(pverp) - real(r8) :: aerso4(pverp) - real(r8) :: aerds(4,pverp) - real(r8) :: rh(pverp) - real(r8) :: zarg(pverp) ! vertical height array - real(r8) :: aersal(pverp,4) - real(r8) :: albedo(kw) ! wavelenght dependent albedo - real(r8) :: dt_xdiag(8) ! wrk array - real(r8), allocatable :: prates(:,:) ! photorates matrix - - logical :: zagtz(ncol) ! zenith angle > 0 flag array - real(r8), dimension(ncol) :: rlats, rlons ! chunk latitudes and longitudes (radians) - - call get_rlat_all_p( lchnk, ncol, rlats ) - call get_rlon_all_p( lchnk, ncol, rlons ) - - !----------------------------------------------------------------- - ! ... any photorates ? - !----------------------------------------------------------------- - if( phtcnt < 1 ) then - return - end if - - !----------------------------------------------------------------- - ! ... zero all photorates - !----------------------------------------------------------------- - do m = 1,phtcnt - do k = 1,pver - photos(:,k,m) = 0._r8 - end do - end do - -!----------------------------------------------------------------- -! ... allocate "working" rate array -!----------------------------------------------------------------- - allocate( prates(pverp,nlng), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'xactive_photo: failed to allocate prates; error = ',astat - call endrun - end if - - zagtz(:) = zen_angle(:) < .99_r8*pi/2._r8 .and. zen_angle(:) > 0._r8 !! daylight - fracday(:) = 0._r8 - dt_diag(:,:) = 0._r8 - - call get_curr_date(yr, mon, day, tod, 0) - ncdate = yr*10000 + mon*100 + day - ut = real(tod)/3600._r8 -#ifdef DEBUG - if (masterproc) then - write(iulog,*) 'photo: nj = ',nlng - write(iulog,*) 'photo: esfact = ',esfact - endif -#endif - col_loop : do i = 1,ncol -daylight : & - if( zagtz(i) ) then - sza = zen_angle(i)*r2d - secant = 1._r8 / cos( zen_angle(i) ) -secant_in_bounds : & - if( secant <= secant_limit ) then - fracday(i) = 1._r8 - zarg(pverp:2:-1) = zmid(i,:) - zarg(1) = 0._r8 - airdens(pverp:2:-1) = tdens(i,:) - airdens(1) = 10._r8 * ps(i) / (boltz*ts(i)) - if( o3rad_ndx > 0 ) then - spc_ndx = o3rad_ndx - else - spc_ndx = ox_ndx - end if - if( spc_ndx < 1 ) then - spc_ndx = o3_ndx - end if - if( spc_ndx > 0 ) then - o3line(pverp:2:-1) = vmr(i,:,spc_ndx) - else - o3line(pverp:2:-1) = 0._r8 - end if - o3line(1) = o3line(2) - tline(pverp:2:-1) = temper(i,:) - tline(1) = tline(2) - rh(pverp:2:-1) = relhum(i,:) - rh(1) = rh(2) - xlwc(pverp:2:-1) = cwat(i,:) * pmid(i,:)/(temper(i,:)*287._r8) * kg2g !! TIE - xlwc(1) = xlwc(2) - xfrc(pverp:2:-1) = cldfr(i,:) ! cloud fraction - xfrc(1) = xfrc(2) - tlay(1:pver) = .5_r8*(tline(1:pver) + tline(2:pverp)) - albedo(1:nw) = srf_alb(i) - - alat = rlats(i) - along= rlons(i) - - if( oc1_ndx > 0 ) then - aerocs1(pverp:2:-1) = vmr(i,:,oc1_ndx) - else - aerocs1(pverp:2:-1) = 0._r8 - end if - aerocs1(1) = aerocs1(2) - if( oc2_ndx > 0 ) then - aerocs2(pverp:2:-1) = vmr(i,:,oc2_ndx) - else - aerocs2(pverp:2:-1) = 0._r8 - end if - aerocs2(1) = aerocs2(2) - if( cb1_ndx > 0 ) then - aercbs1(pverp:2:-1) = vmr(i,:,cb1_ndx) - else - aercbs1(pverp:2:-1) = 0._r8 - end if - aercbs1(1) = aercbs1(2) - if( cb2_ndx > 0 ) then - aercbs2(pverp:2:-1) = vmr(i,:,cb2_ndx) - else - aercbs2(pverp:2:-1) = 0._r8 - end if - aercbs2(1) = aercbs2(2) - if( soa_ndx > 0 ) then - aersoa(pverp:2:-1) = vmr(i,:,soa_ndx) - else - aersoa(pverp:2:-1) = 0._r8 - end if - aersoa(1) = aersoa(2) - if( ant_ndx > 0 ) then - aerant(pverp:2:-1) = vmr(i,:,ant_ndx) - else - aerant(pverp:2:-1) = 0._r8 - end if - aerant(1) = aerant(2) - if( so4_ndx > 0 ) then - aerso4(pverp:2:-1) = vmr(i,:,so4_ndx) - else - aerso4(pverp:2:-1) = 0._r8 - end if - aerso4(1) = aerso4(2) - if ( dust_nbin == 4 ) then - do ndx = 1,4 - aerds(ndx,pverp:2:-1) = dust_vmr(i,:,ndx) - end do - else - do ndx = 1,4 - aerds(ndx,pverp:2:-1) = 0._r8 - end do - endif - aerds(1,1) = aerds(1,2) - aerds(2,1) = aerds(2,2) - aerds(3,1) = aerds(3,2) - aerds(4,1) = aerds(4,2) - if( sa1_ndx > 0 ) then - aersal(pverp:2:-1,1) = vmr(i,:,sa1_ndx) - else - aersal(pverp:2:-1,1) = 0._r8 - end if - if( sa2_ndx > 0 ) then - aersal(pverp:2:-1,2) = vmr(i,:,sa2_ndx) - else - aersal(pverp:2:-1,2) = 0._r8 - end if - if( sa3_ndx > 0 ) then - aersal(pverp:2:-1,3) = vmr(i,:,sa3_ndx) - else - aersal(pverp:2:-1,3) = 0._r8 - end if - if( sa4_ndx > 0 ) then - aersal(pverp:2:-1,4) = vmr(i,:,sa4_ndx) - else - aersal(pverp:2:-1,4) = 0._r8 - end if - aersal(1,:) = aersal(2,:) - call photoin( ncdate, alat, along, & - ut, esfact, col_dens(i,1,1), col_dens(i,1,2), albedo, & - zarg, tline, tlay, xlwc, xfrc, & - airdens, aerocs1, aerocs2, aercbs1, aercbs2, & - aersoa, aerant, aerso4, aersal, aerds, o3line, rh, & - prates, sza, nw, dt_xdiag ) - dt_diag(i,:) = dt_xdiag(:) - - do m = 1,phtcnt - if( lng_indexer(m) > 0 ) then - alias_factor = pht_alias_mult(m,2) - if( alias_factor == 1._r8 ) then - photos(i,:,m) = prates(1:pver,lng_indexer(m)) - else - photos(i,:,m) = alias_factor * prates(1:pver,lng_indexer(m)) - end if - end if - -#ifdef DEBUG - if( do_diag ) then - write(iulog,'(''xactive_photo: prates('',i2,'',.)'')') m - write(iulog,'(1p,5e21.13)') photos(i,:pver,m) - write(iulog,*) ' ' - end if -#endif - - end do -!----------------------------------------------------------------- -! ... set j(onitr) -!----------------------------------------------------------------- - if( jonitr_ndx > 0 ) then - if( jch3cho_a_ndx > 0 ) then - photos(i,1:pver,jonitr_ndx) = photos(i,1:pver,jch3cho_a_ndx) - end if - if( jch3cho_b_ndx > 0 ) then - photos(i,1:pver,jonitr_ndx) = photos(i,1:pver,jonitr_ndx) + photos(i,1:pver,jch3cho_b_ndx) - end if - if( jch3cho_c_ndx > 0 ) then - photos(i,1:pver,jonitr_ndx) = photos(i,1:pver,jonitr_ndx) + photos(i,1:pver,jch3cho_c_ndx) - end if - end if -!----------------------------------------------------------------- -! ... calculate j(no) from formula -!----------------------------------------------------------------- - if( jno_ndx > 0 ) then - if( has_o2_col .and. has_o3_col ) then - fac1(:) = 1.e-8_r8 * (col_dens(i,:,2)/cos(zen_angle(i)))**.38_r8 - fac2(:) = 5.e-19_r8 * col_dens(i,:,1) / cos(zen_angle(i)) - photos(i,:,jno_ndx) = 4.5e-6_r8 * exp( -(fac1(:) + fac2(:)) ) - end if - end if -!----------------------------------------------------------------- -! ... add near IR correction to j(ho2no2) -!----------------------------------------------------------------- - if( jho2no2_ndx > 0 ) then - photos(i,:,jho2no2_ndx) = photos(i,:,jho2no2_ndx) + 1.e-5_r8 - endif - end if secant_in_bounds - end if daylight - end do col_loop - - call set_xnox_photo( photos, ncol ) - - deallocate( prates ) - - end subroutine xactive_photo - subroutine cloud_mod( zen_angle, clouds, lwc, delp, srf_alb, & eff_alb, cld_mult ) !----------------------------------------------------------------------- @@ -1444,7 +1079,7 @@ subroutine set_ub_col( col_delta, vmr, invariants, ptop, pdel, ncol, lchnk ) real(r8) :: o2_exo_col(ncol) real(r8) :: o3_exo_col(ncol) integer :: i - + !--------------------------------------------------------------- ! ... assign column density at the upper boundary ! the first column is o3 and the second is o2. @@ -1466,8 +1101,8 @@ subroutine set_ub_col( col_delta, vmr, invariants, ptop, pdel, ncol, lchnk ) + delp * (o2_exo_coldens(ki,i,lchnk,next) & - o2_exo_coldens(kl,i,lchnk,next)) else - tint_vals(1) = o2_exo_coldens( 1,i,lchnk,last) - tint_vals(2) = o2_exo_coldens( 1,i,lchnk,next) + tint_vals(1) = o2_exo_coldens( 1,i,lchnk,last) + tint_vals(2) = o2_exo_coldens( 1,i,lchnk,next) endif o2_exo_col(i) = tint_vals(1) + dels * (tint_vals(2) - tint_vals(1)) end do @@ -1484,8 +1119,8 @@ subroutine set_ub_col( col_delta, vmr, invariants, ptop, pdel, ncol, lchnk ) + delp * (o3_exo_coldens(ki,i,lchnk,next) & - o3_exo_coldens(kl,i,lchnk,next)) else - tint_vals(1) = o3_exo_coldens( 1,i,lchnk,last) - tint_vals(2) = o3_exo_coldens( 1,i,lchnk,next) + tint_vals(1) = o3_exo_coldens( 1,i,lchnk,last) + tint_vals(2) = o3_exo_coldens( 1,i,lchnk,next) endif o3_exo_col(i) = tint_vals(1) + dels * (tint_vals(2) - tint_vals(1)) end do @@ -1615,21 +1250,18 @@ subroutine p_interp( lchnk, ncol, ptop, o2_exo_col, o3_exo_col ) end subroutine p_interp - subroutine setcol( col_delta, col_dens, vmr, pdel, ncol ) + subroutine setcol( col_delta, col_dens ) !--------------------------------------------------------------- ! ... set the column densities !--------------------------------------------------------------- - use chem_mods, only : ncol_abs=>nabscol, gas_pcnst + use chem_mods, only : ncol_abs=>nabscol implicit none !--------------------------------------------------------------- ! ... dummy arguments !--------------------------------------------------------------- - integer, intent(in) :: ncol ! no. of columns in current chunk - real(r8), intent(in) :: vmr(ncol,pver,gas_pcnst) ! xported species vmr - real(r8), intent(in) :: pdel(pcols,pver) ! delta about midpoints real(r8), intent(in) :: col_delta(:,0:,:) ! layer column densities (molecules/cm^2) real(r8), intent(out) :: col_dens(:,:,:) ! column densities ( /cm**2 ) @@ -1721,7 +1353,7 @@ subroutine photo_timestep_init( calday ) ! Set jlong etf !----------------------------------------------------------------------- call jlong_timestep_init - + if ( do_jshort ) then !----------------------------------------------------------------------- ! Set jshort etf diff --git a/src/chemistry/mozart/mo_photoin.F90 b/src/chemistry/mozart/mo_photoin.F90 deleted file mode 100644 index fed1d1f6cf..0000000000 --- a/src/chemistry/mozart/mo_photoin.F90 +++ /dev/null @@ -1,463 +0,0 @@ - -module mo_photoin - - use shr_kind_mod, only : r8 => shr_kind_r8 - use cam_logfile, only : iulog - use cam_abortutils, only : endrun - - implicit none - - save - - public :: photoin_inti - public :: photoin - private - - integer :: jo2_ndx = 0 - - logical, allocatable :: z_dep(:) - character(len=32), allocatable :: pht_tag(:) - -contains - - subroutine photoin_inti( nlng, lng_indexer ) - !------------------------------------------------------------- - ! ... assign use masks - !------------------------------------------------------------- - - use mo_params, only : largest - use mo_setcld, only : setcld_inti - use chem_mods, only : phtcnt, rxt_tag_lst - - implicit none - - !------------------------------------------------------------- - ! ... dummy arguments - !------------------------------------------------------------- - - integer, intent(in) :: nlng - integer, intent(in) :: lng_indexer(:) - - !------------------------------------------------------------- - ! ... local variables - !------------------------------------------------------------- - integer :: astat - integer :: m - integer :: ndx - character(len=32) :: jname - - !------------------------------------------------------------- - ! ... allocate module arrays - !------------------------------------------------------------- - has_photorates : if( nlng > 0 ) then - allocate( z_dep(nlng), pht_tag(nlng), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'photoin_inti: failed to allocate z_dep; error = ',astat - call endrun - end if - ndx = 0 - do m = 1,phtcnt - if( lng_indexer(m) > 0 ) then - if( any( lng_indexer(:m-1) == lng_indexer(m) ) ) then - cycle - end if - ndx = ndx + 1 - pht_tag(ndx) = trim( rxt_tag_lst(m)) - end if - end do - if( ndx /= nlng ) then - write(iulog,*) 'photoin_inti: corrupted lng_indexer' - call endrun - end if - write(iulog,*) ' ' - write(iulog,*) 'photoin_inti: lng_indexer name mapping' - write(iulog,'(5a)') pht_tag(:) - write(iulog,*) ' ' - !------------------------------------------------------------- - ! ... search for jo2 - !------------------------------------------------------------- - do m = 1,nlng - if( pht_tag(m) == 'jo2' ) then - jo2_ndx = m - exit - end if - end do - write(iulog,*) ' ' - write(iulog,*) 'photoin_inti: jo2 index = ',jo2_ndx - write(iulog,*) ' ' - !------------------------------------------------------------- - ! ... set altitude dependence logical array - !------------------------------------------------------------- - z_dep(:) = .true. - do m = 1,nlng - jname = pht_tag(m) - select case( jname ) - case( 'jno2', 'jno3', 'jho2', 'jhno2', 'jho2no2' ) - z_dep(m) = .false. - case( 'jc2h5cho', 'jchocho', 'jch3ooh' ) - z_dep(m) = .false. - end select - end do - - !------------------------------------------------------------- - ! ... intialize cloud layer module - !------------------------------------------------------------- - call setcld_inti - - end if has_photorates - - end subroutine photoin_inti - - subroutine photoin( idate, alat, along, & - ut, esfact, o3top, o2top, albedo, & - z, tlev, tlay, xlwc, xfrc, & - airlev, aocs1, aocs2, acbs1, acbs2, & - asoa, aant, aso4, asal, ads, o3, rh, & - prate, zen, nw, dt_xdiag ) - !---------------------------------------------------------- - ! ... interactive photolysis interface routine - !---------------------------------------------------------- - - use mo_tuv_inti, only : nlng - use mo_params, only : kj, kw - use mo_wavelen, only : deltaw, sflx, wc, wl, wu - use mo_wavelab , only : sj - use mo_zadj, only : adj_coeffs - use mo_setair, only : setair - use mo_setozo, only : setozo - use mo_pchem, only : pchem - use mo_sphers, only : sphers - use mo_airmas, only : airmas - use mo_setz, only : setz - use mo_seto2, only : set_o2_xsect - use mo_rtlink, only : rtlink - use mo_setcld, only : setcld !, mreg - use mo_setaer, only : setaer - use ppgrid, only : pver, pverp - - implicit none - - !---------------------------------------------------------- - ! ... dummy arguments - !---------------------------------------------------------- - integer, intent(in) :: idate - integer, intent(in) :: nw - real(r8), intent(in) :: alat, along, o3top, o2top - real(r8), intent(in) :: ut, esfact - real(r8), intent(in) :: zen - real(r8), intent(in) :: albedo(kw) - real(r8), intent(in) :: tlay(pver) - real(r8), intent(in) :: xlwc(pverp) ! cloud water (g/m3) - real(r8), intent(in) :: xfrc(pverp) ! cloud fraction - real(r8), intent(in) :: tlev(pverp) - real(r8), intent(in) :: airlev(pverp) - real(r8), intent(in) :: z(pverp) - real(r8), intent(in) :: aocs1(pverp) - real(r8), intent(in) :: aocs2(pverp) - real(r8), intent(in) :: acbs1(pverp) - real(r8), intent(in) :: acbs2(pverp) - real(r8), intent(in) :: asoa(pverp) - real(r8), intent(in) :: aant(pverp) - real(r8), intent(in) :: aso4(pverp) - real(r8), intent(in) :: asal(pverp,4) - real(r8), intent(in) :: ads(4,pverp) - real(r8), intent(in) :: rh(pverp) - real(r8), intent(inout) :: o3(pverp) - real(r8), intent(out) :: prate(pverp,nlng) - real(r8), intent(out) :: dt_xdiag(:) - - !---------------------------------------------------------- - ! ... local variables - !---------------------------------------------------------- - integer :: i, j, k, km, wn, n, astat - real(r8) :: factor, delzint - real(r8) :: wcen - real(r8), allocatable :: xs(:,:,:) - real(r8), allocatable :: adjcoe(:,:) ! ftuv adjustment factor - - !---------------------------------------------------------- - ! ... altitude grid - !---------------------------------------------------------- - real(r8) :: colinc(pverp) - real(r8) :: vcol(pverp) - real(r8) :: scol(pverp) - real(r8) :: to3(pverp) - - !---------------------------------------------------------- - ! ... solar zenith angle - ! slant pathlengths in spherical geometry - !---------------------------------------------------------- - integer :: nid(0:pver) - real(r8) :: dsdh(0:pver,pver) - - !---------------------------------------------------------- - ! ... extra terrestrial solar flux and earth-sun distance ^-2 - !---------------------------------------------------------- - real(r8) :: etf(nw) - real(r8) :: delw(nw) - real(r8) :: xsec(nw) - - !-------------------------------------------------------------- - ! ... atmospheric optical parameters: - !-------------------------------------------------------------- - integer, parameter :: mreg = 16 - integer :: nreg ! regions at each grid - real(r8) :: dtrl(pver,nw) - real(r8) :: dto3(pver,nw) - real(r8) :: dto2(pver,nw) - real(r8) :: dtcld(pver,nw) - real(r8) :: omcld(pver,nw) - real(r8) :: gcld(pver,nw) - - real(r8) :: dtcbs1(pver,nw) - real(r8) :: dtcbs2(pver,nw) - real(r8) :: omcbs1(pver,nw) - real(r8) :: omcbs2(pver,nw) - real(r8) :: gcbs1(pver,nw) - real(r8) :: gcbs2(pver,nw) - - real(r8) :: dtocs1(pver,nw) - real(r8) :: dtocs2(pver,nw) - real(r8) :: omocs1(pver,nw) - real(r8) :: omocs2(pver,nw) - real(r8) :: gocs1(pver,nw) - real(r8) :: gocs2(pver,nw) - - real(r8) :: dtant(pver,nw) - real(r8) :: omant(pver,nw) - real(r8) :: gant(pver,nw) - - real(r8) :: dtsoa(pver,nw) - real(r8) :: dtso4(pver,nw) - real(r8) :: omso4(pver,nw) - real(r8) :: gso4(pver,nw) - - real(r8) :: dtsal(pver,nw,4) - real(r8) :: omsal(pver,nw,4) - real(r8) :: gsal(pver,nw,4) - - real(r8) :: dtds1(pver,nw) - real(r8) :: dtds2(pver,nw) - real(r8) :: dtds3(pver,nw) - real(r8) :: dtds4(pver,nw) - real(r8) :: omds1(pver,nw) - real(r8) :: omds2(pver,nw) - real(r8) :: omds3(pver,nw) - real(r8) :: omds4(pver,nw) - real(r8) :: gds1(pver,nw) - real(r8) :: gds2(pver,nw) - real(r8) :: gds3(pver,nw) - real(r8) :: gds4(pver,nw) - - real(r8) :: optr(pver,mreg) ! cld opt (z dependent) at each region - real(r8) :: fp(mreg) ! probability at each region - - real(r8) :: xso2(nw,pverp) - - !-------------------------------------------------------------- - ! ... spectral irradiance and actinic flux (scalar irradiance): - !-------------------------------------------------------------- - real(r8) :: radfld(pverp,nw) - real(r8) :: radxx(pverp,nw) - - !------------------------------------------------------------- - ! ... j-values: - !------------------------------------------------------------- - integer :: jn, m - - !------------------------------------------------------------- - ! ... location and time - !------------------------------------------------------------- - integer :: iyear, imonth, iday - real(r8) :: dtime, ut0 - - !------------------------------------------------------------- - ! ... allocate wrking xsection array - !------------------------------------------------------------- - allocate( xs(nw,pverp,nlng), adjcoe(pverp,nlng), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'photoin: failed to allocate xs, adjcoe; error = ',astat - call endrun - end if - - etf(1:nw) = sflx(1:nw) * esfact ! earth-sun distance effect - !------------------------------------------------------- - ! ... air profile and rayleigh optical depths (inter-face) - !------------------------------------------------------- - call setair( z, nw, wc, airlev, dtrl, colinc, o2top ) - - !------------------------------------------------------------- - ! ... ozone optical depths (must give temperature) (inter-face) - !------------------------------------------------------------- - call setozo( z, nw, wl, tlay, dto3, to3, o3, airlev, o3top ) - - !------------------------------------------------------------- - ! ... cloud optical depths - !------------------------------------------------------------- - call setcld( z, xlwc, xfrc, nreg, fp, optr ) - - !------------------------------------------------------------- - ! ... aerosol optical depths - !------------------------------------------------------------- - call setaer( z, airlev, rh, aocs1, aocs2, & - acbs1, acbs2,& - aant, aso4, asal, ads, asoa, & - dtcbs1, dtcbs2, omcbs1, omcbs2, gcbs1, gcbs2, & - dtocs1, dtocs2, omocs1, omocs2, gocs1, gocs2, & - dtant, omant, gant, & - dtso4, omso4, gso4, & - dtsal, omsal, gsal, & - dtds1, dtds2, dtds3, dtds4, & - omds1, omds2, omds3, omds4, & - gds1, gds2, gds3, gds4, dtsoa, nw ) - dt_xdiag(1) = sum( dtcbs1(:,16) + dtcbs2(:,16) ) - dt_xdiag(2) = sum( dtocs1(:,16) + dtocs2(:,16) ) - dt_xdiag(3) = sum( dtso4(:,16) ) - dt_xdiag(4) = sum( dtant(:,16) ) - dt_xdiag(5) = sum( dtsal(:,16,1) + dtsal(:,16,2) + dtsal(:,16,3) + dtsal(:,16,4) ) - dt_xdiag(6) = sum( dtds1(:,16) + dtds2(:,16) + dtds3(:,16) + dtds4(:,16) ) - dt_xdiag(7) = sum( dtsoa(:,16) ) - dt_xdiag(8) = sum( dt_xdiag(1:6) ) - - !------------------------------------------------------------ - ! ... photo-chemical and photo-biological weigting functions. - ! for pchem, need to know temperature and pressure profiles. - ! output: - ! from pchem: sj(kj,kz,kw) - for each reaction - !------------------------------------------------------------- - xs(:,:,1:nlng) = sj(:,:,1:nlng) - call pchem( nw, wl, wc, tlev, & - airlev, nlng, pht_tag, xs ) - - !------------------------------------------------------------- - ! ... slant path lengths for spherical geometry - !------------------------------------------------------------- - call sphers( z, zen, dsdh, nid ) - call airmas( z, zen, dsdh, nid, colinc, vcol, scol ) - - !--------------------------------------------------------------- - ! ... modification of coefficent of j-vales function of to3 and zenith - !--------------------------------------------------------------- - call setz( to3, tlev, adj_coeffs, zen, adjcoe, pht_tag ) - - !------------------------------------------------------------------ - ! ... effective o2 optical depth (sr bands, must know zenith angle!) - ! assign o2 cross section to sj(1,*,*) - !------------------------------------------------------------------ - call set_o2_xsect( z, nw, wl, colinc, vcol, scol, dto2, xso2 ) - if( jo2_ndx > 0 ) then - xs(:,:,jo2_ndx) = xso2(:,:) - end if - - delw(:nw) = deltaw(:nw) * etf(:nw) - - !--------------------------------------------------- - ! ... monochromatic radiative transfer: - ! outputs are fdir, fdn, fup - !--------------------------------------------------- - - ! set for cloud only - - do wn = 1,nw - radfld(:,wn) = 0._r8 - omcld(:,wn) = .9999_r8 - gcld (:,wn) = .85_r8 - end do - - Cld_reg_loop : do n = 1,nreg - factor = fp(n) - do wn = 1,nw - dtcld(:,wn) = optr(:,n) - end do - -#ifdef NO_AEROSOL - dtcbs1(:,:) = 0._r8 - dtcbs2(:,:) = 0._r8 - dtocs1(:,:) = 0._r8 - dtocs2(:,:) = 0._r8 - dtant(:,:) = 0._r8 - dtso4(:,:) = 0._r8 - dtsal(:,:,:) = 0._r8 - dtds1(:,:) = 0._r8 - dtds2(:,:) = 0._r8 - dtds3(:,:) = 0._r8 - dtds4(:,:) = 0._r8 - - omcbs1(:,:) = 0._r8 - omcbs2(:,:) = 0._r8 - omocs1(:,:) = 0._r8 - omocs2(:,:) = 0._r8 - omant(:,:) = 0._r8 - omso4(:,:) = 0._r8 - omsal(:,:,:) = 0._r8 - omds1(:,:) = 0._r8 - omds2(:,:) = 0._r8 - omds3(:,:) = 0._r8 - omds4(:,:) = 0._r8 - - gcbs1(:,:) = 0._r8 - gcbs2(:,:) = 0._r8 - gocs1(:,:) = 0._r8 - gocs2(:,:) = 0._r8 - gant(:,:) = 0._r8 - gso4(:,:) = 0._r8 - gsal(:,:,:) = 0._r8 - gds1(:,:) = 0._r8 - gds2(:,:) = 0._r8 - gds3(:,:) = 0._r8 - gds4(:,:) = 0._r8 -#endif - call rtlink( z, nw, albedo, zen, dsdh, & - nid, dtrl, dto3, dto2, & - dtcld, omcld, gcld, & - dtcbs1, omcbs1, gcbs1, & - dtcbs2, omcbs2, gcbs2, & - dtocs1, omocs1, gocs1, & - dtocs2, omocs2, gocs2, & - dtant, omant, gant, & - dtso4, omso4, gso4, & - dtsal, omsal, gsal, & - dtds1, omds1, gds1, & - dtds2, omds2, gds2, & - dtds3, omds3, gds3, & - dtds4, omds4, gds4, radxx ) - do wn = 1,nw - radfld(:,wn) = radfld(:,wn) + radxx(:,wn)*factor - end do - end do Cld_reg_loop - - !---------------------------------------------------------- - ! ... interplation at the top level - !---------------------------------------------------------- - delzint = (z(pver-1) - z(pver-2))/(z(pver) - z(pver-1)) - do wn = 1,nw - radfld(1,wn) = radfld(2,wn) + (radfld(2,wn) - radfld(3,wn))*delzint - radfld(1,wn) = max( radfld(1,wn),radfld(2,wn) ) - end do - - !---------------------------------------------------------- - ! ... j-val calculation - ! spherical irradiance (actinic flux) - ! as a function of altitude - ! convert to quanta s-1 nm-1 cm-2 - ! (1.e-4 * (wc*1e-9) / (hc = 6.62e-34 * 2.998e8)) - !---------------------------------------------------------- - rate_loop : do m = 1,nlng - if( .not. z_dep(m) ) then - xsec(:nw) = xs(:nw,1,m) * delw(:nw) - prate(:pverp,m) = matmul( radfld, xsec ) - else - do k = 1,pverp - km = pverp - k + 1 - xsec(:nw) = xs(:nw,km,m) * delw(:nw) - prate(k,m) = dot_product( radfld(k,:nw), xsec(:nw) ) - end do - end if - prate(1:pverp,m) = prate(1:pverp,m) * adjcoe(pverp:1:-1,m) - end do rate_loop - - deallocate( xs, adjcoe ) - - end subroutine photoin - -end module mo_photoin diff --git a/src/chemistry/mozart/mo_sad.F90 b/src/chemistry/mozart/mo_sad.F90 index 01197efd37..2f694659a9 100644 --- a/src/chemistry/mozart/mo_sad.F90 +++ b/src/chemistry/mozart/mo_sad.F90 @@ -6,7 +6,7 @@ module mo_sad use m_sad_data, only : a, b use cam_logfile, only : iulog use spmd_utils, only : masterproc - + implicit none @@ -26,7 +26,7 @@ module mo_sad integer :: sad_topp contains - + subroutine sad_inti(pbuf2d) !---------------------------------------------------------------------- @@ -41,14 +41,14 @@ subroutine sad_inti(pbuf2d) type(physics_buffer_desc), pointer :: pbuf2d(:,:) -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- ! ... Local variables -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- integer :: k -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- ! ... find level where etamids are all > 1 hPa -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- sad_top = 0 do k = pver,1,-1 if( (pref_mid_norm(k)) < .001_r8 ) then @@ -77,17 +77,19 @@ end subroutine sad_inti ! Modified by ! Stacy Walters ! 1 November 1999 -! Modified by +! Modified by ! Doug Kinnison ! 1 September 2004; Condensed phase H2O passed in from CAM ! 2 November 2004; New treatment of denitrificatoin (NAT) ! 14 November 2004; STS mode of operation. ! 27 March 2008; Using original NAT approach. -! 08 November 2010; STS Approach (HNO3 => STS; then HNO3 => NAT) +! 08 November 2010; STS Approach (HNO3 => STS; then HNO3 => NAT) ! 24 March 2011; updated mask logic and removed sm NAT logic ! 14 April 2011; updated EQUIL logic ! 19 December 2012; updated using Wegner et al., JGR, 2013a,b. ! 25 April 2013; Removed volcanic heating logic. +! 6 April 2022; update nat_part_dens from 1e-02 to 5.0e-4 +! (Wilka et al., ACP, 2021, doi:10.5194/acp-21-15771-2021) ! ! DESCRIPTION ! @@ -104,7 +106,7 @@ end subroutine sad_inti ! see Binkowski et al., JGR, 100, 26191-26209, 1995. The Volume Density ! is substituted into the SAD equation so that the SAD is dependent on ! the # of particles cm-3, the width of the distribution (sigma), and -! the volume density of the aerosol. This approach is discussed in +! the volume density of the aerosol. This approach is discussed in ! Considine et al., 2000 and Kinnison et al., 2007. ! ! NOTE2: For the ternary solution calculation @@ -112,36 +114,36 @@ end subroutine sad_inti ! has been previously used in Considine et al., JGR, 1999. The thermodynamic ! models used in this routine are from A. Tabazedeh et al, 1994. ! -! NOTE3: Updates to the PSC scheme is discussed in Wegner et al., 2013a. -! 80% of the total HNO3 is allowed to see STS, 20% NAT. The number density of -! the NAT and ICE particles are is set to 0.01 and 0.1 particle cm-3 respectively. +! NOTE3: Updates to the PSC scheme is discussed in Wegner et al., 2013a. +! 80% of the total HNO3 is allowed to see STS, 20% NAT. The number density of +! the NAT and ICE particles are is set to 0.01 and 0.1 particle cm-3 respectively. ! -! NOTE4: The HCl solubility (in STS) has been added and evalutede in Wegner et al., 2013b. +! NOTE4: The HCl solubility (in STS) has been added and evalutede in Wegner et al., 2013b. ! This solubility is based on Carslaw et al., 1995. ! ! REFERENCES for this PSC module: -! Considine, D. B., A. R. Douglass, P. S. Connell, D. E. Kinnison, and D. A., Rotman, -! A polar stratospheric cloud parameterization for the three dimensional model of -! the global modeling initiative and its response to stratospheric aircraft, +! Considine, D. B., A. R. Douglass, P. S. Connell, D. E. Kinnison, and D. A., Rotman, +! A polar stratospheric cloud parameterization for the three dimensional model of +! the global modeling initiative and its response to stratospheric aircraft, ! J. Geophys. Res., 105, 3955-3975, 2000. ! -! Kinnison, D. E.,et al., Sensitivity of chemical tracers to meteorological -! parameters in the MOZART-3 chemical transport model, J. Geophys. Res., +! Kinnison, D. E.,et al., Sensitivity of chemical tracers to meteorological +! parameters in the MOZART-3 chemical transport model, J. Geophys. Res., ! 112, D20302, doi:10.1029/2006JD007879, 2007. ! -! Wegner, T, D. E. Kinnison, R. R. Garcia, S. Madronich, S. Solomon, and M. von Hobe, -! On the depletion of HCl in the Antarctic polar vortex, +! Wegner, T, D. E. Kinnison, R. R. Garcia, S. Madronich, S. Solomon, and M. von Hobe, +! On the depletion of HCl in the Antarctic polar vortex, ! in review J. Geophys. Res., 2013. ! -! Wegner, T, D. E. Kinnison, R. R. Garcia, S. Madronich, and S. Solomon, +! Wegner, T, D. E. Kinnison, R. R. Garcia, S. Madronich, and S. Solomon, ! Polar Stratospheric Clouds in SD-WACCM4, in review J. Geophys. Res., 2013. ! ! Tabazedeh, A., R. P. Turco, K. Drdla, M. Z. Jacobson, and O. B, Toon, A study -! of the type I polar stratosphere cloud formation, +! of the type I polar stratosphere cloud formation, ! Geophys. Res. Lett., 21, 1619-1622, 1994. ! ! Carslaw, K. S., S. L. Clegg, and P. Brimblecombe, A thermodynamic model of the -! system HCl-HNO3-H2SO4-H2O, including solubilities of HBr, from <200 to 328K, +! system HCl-HNO3-H2SO4-H2O, including solubilities of HBr, from <200 to 328K, ! J. Phys. Chem., 99, 11,557-11,574, doi:1021/100029a039, 1995. ! ! @@ -163,12 +165,12 @@ end subroutine sad_inti ! ! OUTPUT: ! -! hno3_gas = Gas-phase HNO3 Used in chemical solver. +! hno3_gas = Gas-phase HNO3 Used in chemical solver. ! hno3_cond(1) = Condensed HNO3 from STS Not used in mo_aero_settling.F90 ! hno3_cond(2) = Condensed HNO3 from NAT Used in mo_aero_settling.F90 ! -! hcl_gas = Gas-phase HCL Used in chemical solver. -! hcl_cond = Condensed HCl from STS +! hcl_gas = Gas-phase HCL Used in chemical solver. +! hcl_cond = Condensed HCl from STS ! ! SAD_strat(1) = Sulfate Aerosol... Used in mo_strato_rates.F90 ! SAD_strat(2) = NAT Aerosol.... Used in mo_strato_rates.F90 @@ -305,7 +307,7 @@ subroutine sad_strat_calc( lchnk, m, press, temper, hno3_gas, & hcl_total (:,k) = 0._r8 hcl_cond_sulf (:,k) = 0._r8 hcl_gas_sulf (:,k) = 0._r8 - end do + end do !---------------------------------------------------------------------- ! ... limit temperature !---------------------------------------------------------------------- @@ -318,7 +320,7 @@ subroutine sad_strat_calc( lchnk, m, press, temper, hno3_gas, & ! ... total HNO3 and H2O gas and condensed phases !---------------------------------------------------------------------- do k = sad_topp,pver - hno3_total(:,k) = hno3_gas(:,k) + hno3_cond(:,k,1) + hno3_cond(:,k,2) + hno3_total(:,k) = hno3_gas(:,k) + hno3_cond(:,k,1) + hno3_cond(:,k,2) h2o_total(:,k) = h2o_gas(:,k) + h2o_cond(:,k) hcl_total (:,k) = hcl_gas(:,k) + hcl_cond(:,k) end do @@ -327,7 +329,7 @@ subroutine sad_strat_calc( lchnk, m, press, temper, hno3_gas, & !====================================================================== ! ... Set SAD to SAGEII if Temperature is GT 200K and Return ! -! ... mask_lbs = true .... T > 200K or SAD_SULF <= 1e-15 or +! ... mask_lbs = true .... T > 200K or SAD_SULF <= 1e-15 or ! P < 2hPa or P > 300hPa ! ... mask_sts = false .... .not. mask_lbs ! ... mask_nat = false .... T <= TSAT_NAT @@ -376,7 +378,7 @@ subroutine sad_strat_calc( lchnk, m, press, temper, hno3_gas, & ! ... Logic for deriving ICE ! Ice formation occurs here if condensed phase H2O exists. ! -! mask_lbs = false.... T > 200K or SAD_SULF < 1e-15 or +! mask_lbs = false.... T > 200K or SAD_SULF < 1e-15 or ! P >2hPa or P <300hPa ! mask_ice = true .... H2O_COND > 0.0 !====================================================================== @@ -399,7 +401,7 @@ subroutine sad_strat_calc( lchnk, m, press, temper, hno3_gas, & endwhere end do !---------------------------------------------------------------------- -! ... ICE +! ... ICE !---------------------------------------------------------------------- call ice_sad_calc( ncol, press, temp, m, h2o_avail, & sad_ice, radius_ice, mask_ice ) @@ -414,9 +416,9 @@ subroutine sad_strat_calc( lchnk, m, press, temper, hno3_gas, & !====================================================================== !====================================================================== -! ... LOGIC for STS and NAT +! ... LOGIC for STS and NAT ! -! mask_lbs = false .... T > 200K or SAD_SULF <= 1e-15 or +! mask_lbs = false .... T > 200K or SAD_SULF <= 1e-15 or ! P < 2hPa or P >300hPa ! mask_sts = true .... not mask_lbs ! mask_nat = true .... T <= TSAT_NAT and mask_sts = true @@ -590,7 +592,7 @@ subroutine nat_sat_temp( ncol, hno3_total, h2o_avail, press, tsat_nat, mask ) ! ... Calculate NAT Saturation Threshold Temperature ! Hanson and Mauersberger: GRL, Vol.15, 8, p855-858, 1988. ! Substitute m(T) and b(T) into Equation (1). Rearrange and -! solve quadratic eqation. +! solve quadratic eqation. !---------------------------------------------------------------------- tmp = log10( ph2o ) wrk = 1._r8 / (ee + bb*tmp) @@ -720,13 +722,13 @@ subroutine sulfate_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, hcl_avail real(r8), intent(in) :: m (ncol,pver) real(r8), intent(in) :: h2o_avail (ncol,pver) real(r8), intent(in) :: hno3_avail (ncol,pver) - real(r8), intent(in) :: hcl_avail (ncol,pver) + real(r8), intent(in) :: hcl_avail (ncol,pver) real(r8), intent(in) :: sad_sage (ncol,pver) real(r8), intent(out) :: hno3_gas (ncol,pver) ! Gas-phase HNO3, mole fraction real(r8), intent(out) :: hno3_cond (ncol,pver) ! Condensed phase HNO3, mole fraction real(r8), intent(out) :: hcl_gas (ncol,pver) ! Gas-phase HCL, mole fraction real(r8), intent(out) :: hcl_cond (ncol,pver) ! Condensed phase HCL, mole fraction - real(r8), intent(out) :: sad_sulfate(ncol,pver) + real(r8), intent(out) :: sad_sulfate(ncol,pver) real(r8), intent(out) :: radius_sulfate(ncol,pver) real(r8), intent(inout) :: h2so4m (ncol,pver) ! mass per volume, micro grams m-3 logical, intent(in) :: is_chem ! chemistry calc switch @@ -758,13 +760,13 @@ subroutine sulfate_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, hcl_avail real(r8) :: molh2so4 (ncol,pver) ! Equil molality of H2SO4 in STS real(r8) :: molhno3 (ncol,pver) ! Equil molality of HNO3 in STS real(r8) :: AD (ncol,pver) ! air density (molecules cm-3) - real(r8) :: xmf (ncol,pver) ! + real(r8) :: xmf (ncol,pver) ! real(r8) :: hhcl (ncol,pver) ! henry's solubility of hcl in binary real(r8) :: phcl0 (ncol,pver) ! partial pressure of hcl (hPa) real(r8) :: h2so4vmr (ncol,pver) ! atmospheric mole fraction of H2SO4 - real(r8) :: nsul (ncol,pver) ! moles / m3- H2SO4 pure liquid + real(r8) :: nsul (ncol,pver) ! moles / m3- H2SO4 pure liquid real(r8) :: mcl (ncol,pver) ! molality of hcl in ? - real(r8) :: wtcl (ncol,pver) ! + real(r8) :: wtcl (ncol,pver) ! real(r8) :: phcl (ncol,pver) ! partial pressure of hcl (over aerosol) real(r8) :: parthcl (ncol,pver) ! fraction of HCl in gas-phase ! @@ -786,7 +788,7 @@ subroutine sulfate_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, hcl_avail !---------------------------------------------------------------------- ! ... derive H2SO4 (micro grams / m3) from SAGEII SAD !---------------------------------------------------------------------- - call sad2h2so4( h2o_avail, press, sad_sage, temp, sulfate_vol_dens, & + call sad2h2so4( h2o_avail, press, sad_sage, temp, sulfate_vol_dens, & h2so4_aer_dens, h2so4m, mask, ncol ) !---------------------------------------------------------------------- @@ -823,10 +825,10 @@ subroutine sulfate_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, hcl_avail !---------------------------------------------------------------------- if( do_equil ) then - call equil( temp, h2so4m, hno3_avail, h2o_avail, press, & + call equil( temp, h2so4m, hno3_avail, h2o_avail, press, & hno3_cond, h2so4_cond, wts, wtn, wts0, molh2so4, molhno3, mask_lt, ncol, & - lchnk, flag, is_chem, converged ) - + lchnk, flag, is_chem, converged ) + do k = sad_topp,pver where( ( mask_lt(:ncol,k) ) .AND. ( converged(:ncol,k) ) ) @@ -847,12 +849,12 @@ subroutine sulfate_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, hcl_avail !---------------------------------------------------------------------- ! .... Partition HCl (gas/condensed) *** Carslaw !---------------------------------------------------------------------- -! THE SOLUBILITY OF HCL +! THE SOLUBILITY OF HCL ! HHCl (MOL/KG/ATM) taken form Shi et al., JGR 2001 ! -! .... Convert weight % to weight fraction - wtn(:ncol,k) = wtn(:ncol,k) * 0.01_r8 +! .... Convert weight % to weight fraction + wtn(:ncol,k) = wtn(:ncol,k) * 0.01_r8 wts0(:ncol,k) = wts0(:ncol,k) * 0.01_r8 ! .... Derive xmf (mole fraction H2SO4 in LBS ) @@ -861,7 +863,7 @@ subroutine sulfate_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, hcl_avail ! .... Derive hhcl (henry's solubility of hcl in binary) hhcl(:ncol,k) = (0.094_r8-0.61_r8*xmf(:ncol,k)+1.2_r8*xmf(:ncol,k)**2.0_r8) & - *exp(-8.68_r8+(8515.0_r8-10718.0_r8*xmf(:ncol,k)**(0.7_r8))/temp(:ncol,k)) + *exp(-8.68_r8+(8515.0_r8-10718.0_r8*xmf(:ncol,k)**(0.7_r8))/temp(:ncol,k)) ! .... Derive phcl0 (partial pressure of hcl( hPa)) phcl0(:ncol,k) = hcl_avail(:ncol,k)*press(:ncol,k) / 1013.26_r8 @@ -876,13 +878,13 @@ subroutine sulfate_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, hcl_avail ! .... Derive mcl (molality of hcl) mcl(:ncol,k) = (1.0_r8/8.314e-5_r8/temp(:ncol,k)*phcl0(:ncol,k))/(nsul(:ncol,k)/molh2so4(:ncol,k) + & - 1.0_r8/(8.314e-5_r8)/temp(:ncol,k)/hhcl(:ncol,k)) + 1.0_r8/(8.314e-5_r8)/temp(:ncol,k)/hhcl(:ncol,k)) ! .... Derive wtcl ( ) - wtcl(:ncol,k) = mcl(:ncol,k)*36.5_r8/(1000.0_r8 + 98.12_r8*molh2so4(:ncol,k) + 63.03_r8*molhno3(:ncol,k)) + wtcl(:ncol,k) = mcl(:ncol,k)*36.5_r8/(1000.0_r8 + 98.12_r8*molh2so4(:ncol,k) + 63.03_r8*molhno3(:ncol,k)) ! .... Derive phcl (partial pressure over the aerosol) - phcl(:ncol,k) = mcl(:ncol,k)/hhcl(:ncol,k) + phcl(:ncol,k) = mcl(:ncol,k)/hhcl(:ncol,k) ! .... Derive parhcl (fraction of HCl in gas-phase) where(phcl0(:ncol,k)>0._r8) @@ -891,7 +893,7 @@ subroutine sulfate_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, hcl_avail parthcl(:ncol,k) = 0._r8 endwhere -! .... Partition HCl (gas/condensed) +! .... Partition HCl (gas/condensed) hcl_gas (:ncol,k) = hcl_avail(:ncol,k) * parthcl(:ncol,k) hcl_cond(:ncol,k) = hcl_avail(:ncol,k) - hcl_gas(:ncol,k) @@ -944,7 +946,7 @@ subroutine nat_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, m, & real(r8), intent(in) :: hno3_avail(ncol,pver) real(r8), intent(out) :: hno3_cond (ncol,pver) ! HNO3 in condensed phase (mole fraction) real(r8), intent(out) :: hno3_gas (ncol,pver) ! HNO3 in gas-phase (mole fraction) - real(r8), intent(out) :: sad_nat (ncol,pver) + real(r8), intent(out) :: sad_nat (ncol,pver) real(r8), intent(out) :: radius_nat(ncol,pver) logical, intent(in) :: mask(ncol,pver) ! grid mask @@ -954,14 +956,14 @@ subroutine nat_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, m, & integer :: k, i real(r8) :: nat_dens_condphase(ncol, pver) ! Condensed phase NAT, molec cm-3 real(r8) :: voldens_nat (ncol, pver) ! Volume Density, um3 cm-3 - real(r8) :: hno3_cond_total (ncol, pver) ! Total Condensed phase HNO3 + real(r8) :: hno3_cond_total (ncol, pver) ! Total Condensed phase HNO3 !---------------------------------------------------------------------- ! ... parameters !---------------------------------------------------------------------- real(r8), parameter :: avo_num = 6.02214e23_r8, & nat_mass_dens = 1.6_r8, & - nat_part_dens = 1.0e-2_r8, & + nat_part_dens = 5.0e-4_r8, & mwnat = 117._r8, & sigma_nat = 1.6_r8, & nat_dens_aer = nat_mass_dens / (mwnat/avo_num), & @@ -976,7 +978,7 @@ subroutine nat_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, m, & do k = sad_topp,pver do i = 1,ncol masked : if( mask(i,k) ) then - + !---------------------------------------------------------------------- ! .... Set Condensed phase for return arguments !---------------------------------------------------------------------- @@ -1003,7 +1005,7 @@ subroutine nat_sad_calc( ncol, press, temp, h2o_avail, hno3_avail, m, & !---------------------------------------------------------------------- ! .... Calculate the radius of NAT from log normal distribution -! .... Assuming sigma and nat_part_dens (# particles per cm3 +! .... Assuming sigma and nat_part_dens (# particles per cm3 ! .... of air) !---------------------------------------------------------------------- radius_nat(i,k) = (3._r8*nat_dens_condphase(i,k) & @@ -1050,14 +1052,14 @@ subroutine nat_cond( ncol, press, temp, h2o_avail, hno3_avail, & real(r8) :: phno3 ! hno3 partial pressure real(r8) :: ph2o ! h2o partial pressure real(r8) :: phno3_eq ! partial pressure above NAT - real(r8) :: wrk - + real(r8) :: wrk + do k = sad_topp,pver do i = 1,ncol !---------------------------------------------------------------------- ! .... Derive HNO3 and H2O partial pressure (torr) ! where: 0.7501 = 760/1013. -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- if( mask(i,k) ) then wrk = press(i,k) * .7501_r8 phno3 = hno3_avail(i,k) * wrk @@ -1065,13 +1067,13 @@ subroutine nat_cond( ncol, press, temp, h2o_avail, hno3_avail, & !---------------------------------------------------------------------- ! Calculating the temperature coefficients for the variation of HNO3 ! and H2O vapor pressure (torr) over a trihydrate solution of HNO3/H2O -! The coefficients are taken from Hanson and Mauersberger: +! The coefficients are taken from Hanson and Mauersberger: ! GRL, Vol.15, 8, p855-858, 1988. !---------------------------------------------------------------------- t = temp(i,k) bt = cc + dd/t + ee*t mt = aa + bb*t - + logphno3 = mt*log10( ph2o ) + bt phno3_eq = 10._r8**logphno3 @@ -1115,7 +1117,7 @@ subroutine sad2h2so4( h2o, press, sad_sage, temp, lbs_vol_dens, & real(r8), parameter :: t_floor = 180._r8 integer :: i, k, l - real(r8) :: wts0 + real(r8) :: wts0 real(r8) :: p ! pressure, torr real(r8) :: tr ! inverse temperature real(r8) :: c(6) @@ -1135,7 +1137,7 @@ subroutine sad2h2so4( h2o, press, sad_sage, temp, lbs_vol_dens, & !---------------------------------------------------------------------- p = h2o(i,k) * press(i,k) * .7501_r8 tr = 1._r8 / max( t_floor,temp(i,k) ) - + do l = 1,6 c(l) = exp( a(1,l) + tr*(a(2,l) + tr*(a(3,l) + tr*(a(4,l) + tr*a(5,l)))) ) end do @@ -1158,7 +1160,7 @@ subroutine sad2h2so4( h2o, press, sad_sage, temp, lbs_vol_dens, & end if end do end do - + end subroutine sad2h2so4 !====================================================================== @@ -1197,27 +1199,27 @@ subroutine equil( temper, h2so4m, hno3_avail, h2o_avail, press, & lchnk, flag, is_chem, converged) !---------------------------------------------------------------------- ! Written by Azadeh Tabazadeh (1993) -! (modified from EQUISOLV -- M. Z. Jacobson -- see below) +! (modified from EQUISOLV -- M. Z. Jacobson -- see below) ! NASA Ames Research Center , Tel. (415) 604 - 1096 ! -! This program solves the equilibrium composition for the ternary -! system of H2SO4/HNO3/H2O under typical stratospheric conditions. -! The formulation of this work is described by Tabazadeh, A., -! Turco, R. P., and Jacobson, M. Z. (1994), "A model for studying -! the composition and chemical effects of stratospheric aerosols," +! This program solves the equilibrium composition for the ternary +! system of H2SO4/HNO3/H2O under typical stratospheric conditions. +! The formulation of this work is described by Tabazadeh, A., +! Turco, R. P., and Jacobson, M. Z. (1994), "A model for studying +! the composition and chemical effects of stratospheric aerosols," ! J. Geophys. Res., 99, 12,897, 1994. * ! -! The solution mechanism for the equilibrium equations is des- -! cribed by Jacobson, M. Z., Turco, R. P., and Tabazadeh, A. -! (1994), "Simulating Equilibrium within aerosols and non-equil- -! ibrium between gases and aerosols," J. Geophys. Res., in review. -! The mechanism is also codified in the fortran program, EQUISOLV, -! by M.Z. Jacobson (1991-3). EQUISOLV solves any number of -! gas / liquid / solid / ionic equilibrium equations simultan- -! eously and includes treatment of the water equations and act- -! ivity coefficients. The activity coeffients currently in -! EQUISOLV are valid for tropospheric temperatures. The acitiv- -! ities listed here are valid for stratospheric temperatures only. +! The solution mechanism for the equilibrium equations is des- +! cribed by Jacobson, M. Z., Turco, R. P., and Tabazadeh, A. +! (1994), "Simulating Equilibrium within aerosols and non-equil- +! ibrium between gases and aerosols," J. Geophys. Res., in review. +! The mechanism is also codified in the fortran program, EQUISOLV, +! by M.Z. Jacobson (1991-3). EQUISOLV solves any number of +! gas / liquid / solid / ionic equilibrium equations simultan- +! eously and includes treatment of the water equations and act- +! ivity coefficients. The activity coeffients currently in +! EQUISOLV are valid for tropospheric temperatures. The acitiv- +! ities listed here are valid for stratospheric temperatures only. ! ! DEFINING PARAMETERS ! @@ -1269,13 +1271,13 @@ subroutine equil( temper, h2so4m, hno3_avail, h2o_avail, press, & integer, intent(in) :: lchnk integer, intent(in) :: flag integer, intent(in) :: ncol ! columns in chunk - real(r8), intent(in) :: h2so4m(ncol,pver) - real(r8), intent(in) :: hno3_avail(ncol,pver) - real(r8), intent(in) :: h2o_avail(ncol,pver) + real(r8), intent(in) :: h2so4m(ncol,pver) + real(r8), intent(in) :: hno3_avail(ncol,pver) + real(r8), intent(in) :: h2o_avail(ncol,pver) real(r8), intent(in) :: press(ncol,pver) real(r8), intent(in) :: temper(pcols,pver) - real(r8), intent(out) :: hno3_cond(ncol,pver) - real(r8), intent(out) :: ch2so4(ncol,pver) + real(r8), intent(out) :: hno3_cond(ncol,pver) + real(r8), intent(out) :: ch2so4(ncol,pver) real(r8), intent(out) :: wts(ncol,pver) real(r8), intent(out) :: wtn(ncol,pver) real(r8), intent(out) :: wts0(ncol,pver) @@ -1323,7 +1325,7 @@ subroutine equil( temper, h2so4m, hno3_avail, h2o_avail, press, & real(r8) :: wrk_h2so4 real(r8) :: cphno3new real(r8) :: con_val - real(r8) :: t, t1, t2, f, f1, f2, ymix, hplus, wtotal, ratio + real(r8) :: t, t1, t2, f, f1, f2, ymix, hplus, wtotal, ratio real(r8) :: con_crit real(r8) :: h2o_cond(ncol,pver) real(r8) :: fratio(0:itermax) @@ -1591,7 +1593,7 @@ end subroutine equil ! den Density of the Binary Solution (g cm-3) ! !====================================================================== - + function density( temp, w ) implicit none diff --git a/src/chemistry/mozart/mo_setext.F90 b/src/chemistry/mozart/mo_setext.F90 index 350215c3d8..a2c6ed7095 100644 --- a/src/chemistry/mozart/mo_setext.F90 +++ b/src/chemistry/mozart/mo_setext.F90 @@ -1,6 +1,5 @@ - module mo_setext - + use shr_kind_mod, only : r8 => shr_kind_r8 use shr_const_mod,only : pi => shr_const_pi use cam_logfile, only : iulog @@ -26,6 +25,7 @@ subroutine setext_inti use mo_chem_utls, only : get_extfrc_ndx, get_spc_ndx use cam_history, only : addfld use spmd_utils, only : masterproc + use mee_ionization,only : mee_ion_init implicit none @@ -59,8 +59,8 @@ subroutine setext_inti call addfld( 'EPP_ionpairs', (/ 'lev' /), 'A', 'pairs/cm3/s', 'EPP ionization forcing' ) call addfld( 'GCR_ionpairs', (/ 'lev' /), 'A', 'pairs/cm3/s', 'GCR ionization forcing' ) - - if (.not.has_dregion_ions) then + + if (.not.has_dregion_ions) then if ( n2d_ndx > 0 .and. n_ndx>0 ) then call addfld( 'N4S_EPP', (/ 'lev' /), 'I', 'molec/cm3/s', 'solar proton event N(4S) source' ) call addfld( 'N2D_EPP', (/ 'lev' /), 'I', 'molec/cm3/s', 'solar proton event N(2D) source' ) @@ -84,6 +84,8 @@ subroutine setext_inti call addfld('AOA_NH_XFRC', (/ 'lev' /), 'A', 'molec/cm3/s', 'external forcing for AOA_NH' ) endif + call mee_ion_init() + end subroutine setext_inti subroutine setext( extfrc, zint_abs, zint_rel, cldtop, & @@ -104,6 +106,7 @@ subroutine setext( extfrc, zint_abs, zint_rel, cldtop, & use mo_lightning, only : prod_no use mo_extfrc, only : extfrc_set + use hco_cc_emissions, only : hco_set_extfrc use chem_mods, only : extcnt use tracer_srcs, only : num_tracer_srcs, tracer_src_flds, get_srcs_data use mo_chem_utls, only : get_extfrc_ndx @@ -111,10 +114,13 @@ subroutine setext( extfrc, zint_abs, zint_rel, cldtop, & use mo_aurora, only : aurora use gcr_ionization, only : gcr_ionization_ionpairs use epp_ionization, only : epp_ionization_ionpairs + use mee_ionization, only : mee_ionpairs use spehox, only : hox_prod_factor use physics_buffer, only : physics_buffer_desc + use phys_control, only : use_hemco ! Use Harmonized Emissions Component (HEMCO) + implicit none !-------------------------------------------------------- @@ -156,15 +162,26 @@ subroutine setext( extfrc, zint_abs, zint_rel, cldtop, & real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor real(r8) :: xlat + real(r8) :: mee_ap_ipr(ncol,pver) ! ion pairs production rate from Ap formulation + + call mee_ionpairs(ncol, lchnk, pmid, zmid*1.e3_r8, tfld, mee_ap_ipr) + extfrc(:,:,:) = 0._r8 no_lgt(:,:) = 0._r8 - !-------------------------------------------------------- - ! ... set frcing from datasets - !-------------------------------------------------------- - call extfrc_set( lchnk, zint_rel, extfrc, ncol ) - + if(use_hemco) then + !-------------------------------------------------------- + ! ... set frcing from datasets (HEMCO) + !-------------------------------------------------------- + call hco_set_extfrc( lchnk, zint_rel, extfrc, ncol, pbuf ) + else + !-------------------------------------------------------- + ! ... set frcing from datasets + !-------------------------------------------------------- + call extfrc_set( lchnk, zint_rel, extfrc, ncol ) + endif + !-------------------------------------------------------- ! ... set nox production from lighting ! note: from ground to cloud top production is c shaped @@ -243,8 +260,8 @@ subroutine setext( extfrc, zint_abs, zint_rel, cldtop, & !--------------------------------------------------------------------- ! ... set SPE NOx and HOx production - ! Jackman et al., JGR, 2005 - ! production of 1.25 Nitrogen atoms/ion pair with branching ratios + ! Jackman et al., JGR, 2005 + ! production of 1.25 Nitrogen atoms/ion pair with branching ratios ! of 0.55 N(4S) and 0.7 N(2D). !--------------------------------------------------------------------- !--------------------------------------------------------------------- @@ -259,9 +276,9 @@ subroutine setext( extfrc, zint_abs, zint_rel, cldtop, & call epp_ionization_ionpairs( ncol, lchnk, pmid, tfld, epp_ipr ) call outfld( 'EPP_ionpairs', epp_ipr, ncol, lchnk ) - epp_ipr(:ncol,:pver) = epp_ipr(:ncol,:) + gcr_ipr(:ncol,:) + epp_ipr(:ncol,:pver) = epp_ipr(:ncol,:) + gcr_ipr(:ncol,:) + mee_ap_ipr(:ncol,:) - if (has_dregion_ions) then + if (has_dregion_ions) then ! D-region ion chemistry is active ... ! N2p production extfrc(:ncol,:pver,n2p_ndx) = extfrc(:ncol,:pver,n2p_ndx) + 0.585_r8 * epp_ipr(:ncol,:pver) @@ -278,7 +295,7 @@ subroutine setext( extfrc, zint_abs, zint_rel, cldtop, & ! O extfrc(:ncol,:pver,o_ndx) = extfrc(:ncol,:pver,o_ndx) + 1.074_r8 * epp_ipr(:ncol,:pver) - else + else ! D-region ion chemistry is NOT active if ( n2d_ndx>0 .and. n_ndx>0 ) then extfrc(:ncol,:pver,n2d_ndx) = extfrc(:ncol,:pver,n2d_ndx) + 0.7_r8*epp_ipr(:ncol,:pver) @@ -286,7 +303,7 @@ subroutine setext( extfrc, zint_abs, zint_rel, cldtop, & call outfld( 'N2D_EPP', 0.7_r8*epp_ipr(:ncol,:), ncol, lchnk ) ! N(2D) produciton (molec/cm3/s) call outfld( 'N4S_EPP',0.55_r8*epp_ipr(:ncol,:), ncol, lchnk ) ! N(4S) produciton (molec/cm3/s) elseif ( no_ndx>0 .and. n_ndx>0 ) then - ! for mechanisms that do not include N2D -- the EPP produce NO + ! for mechanisms that do not include N2D -- the EPP produce NO extfrc(:ncol,:pver, no_ndx) = extfrc(:ncol,:pver, no_ndx) + 0.7_r8*epp_ipr(:ncol,:pver) extfrc(:ncol,:pver, n_ndx) = extfrc(:ncol,:pver, n_ndx) + 0.55_r8*epp_ipr(:ncol,:pver) call outfld( 'NO_EPP', 0.7_r8*epp_ipr(:ncol,:), ncol, lchnk ) ! NO produciton (molec/cm3/s) @@ -315,7 +332,7 @@ subroutine setext( extfrc, zint_abs, zint_rel, cldtop, & call outfld( 'P_N2p', extfrc(:,:,n2p_ndx), ncol, lchnk ) call outfld( 'P_IONS',extfrc(:,:,e_ndx), ncol, lchnk ) end if - + end subroutine setext end module mo_setext diff --git a/src/chemistry/mozart/mo_seto2.F90 b/src/chemistry/mozart/mo_seto2.F90 deleted file mode 100644 index c4c8886030..0000000000 --- a/src/chemistry/mozart/mo_seto2.F90 +++ /dev/null @@ -1,394 +0,0 @@ - - module mo_seto2 - - use shr_kind_mod, only : r8 => shr_kind_r8 - use cam_abortutils, only : endrun - use spmd_utils, only : masterproc - use cam_logfile, only : iulog - - implicit none - - private - public :: o2_xsect_inti - public :: set_o2_xsect - - save - - integer :: nsrc - integer :: ngast - integer :: nla - integer :: nwint - real(r8), allocatable :: wlint(:) - real(r8), allocatable :: xso2int(:) - real(r8), allocatable :: wlla(:) - real(r8), allocatable :: wlgast(:) - - contains - - subroutine o2_xsect_inti( o2_xsect_file ) -!----------------------------------------------------------------------------- -! purpose: -! compute equivalent optical depths for o2 absorption, parameterized in -! the sr bands and the lyman-alpha line. -!----------------------------------------------------------------------------- -! parameters: -! nz - integer, number of specified altitude levels in the working (i) -! grid -! z - real(r8), specified altitude working grid (km) (i) -! nw - integer, number of specified intervals + 1 in working (i) -! wavelength grid -! wl - real(r8), vector of lower limits of wavelength intervals in (i) -! working wavelength grid -! cz - real(r8), number of air molecules per cm^2 at each specified (i) -! altitude layer -! zen - real(r8), solar zenith angle (i) -! dto2 - real(r8), optical depth due to o2 absorption at each specified (o) -! vertical layer at each specified wavelength -! xso2 - real(r8), molecular absorption cross section in sr bands at (o) -! each specified altitude and wavelength. includes herzberg -! continuum. -!----------------------------------------------------------------------------- - - use mo_params, only : deltax - use mo_inter, only : inter2 - use mo_inter, only : inter_inti - use mo_wavelen, only : nw, wl - use ioFileMod, only : getfil - use cam_pio_utils, only : cam_pio_openfile - use pio, only : file_desc_t, pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, & - pio_get_var, pio_closefile, pio_nowrite - - implicit none - -!----------------------------------------------------------------------------- -! ... dummy arguments -!----------------------------------------------------------------------------- - character(len=*), intent(in) :: o2_xsect_file - -!----------------------------------------------------------------------------- -! ... local variables -!----------------------------------------------------------------------------- - type(file_desc_t) :: ncid - integer :: dimid - integer :: vid - integer :: astat - integer :: iret - integer :: i, wn, n - integer :: wrk_ind(4) - real(r8), allocatable :: x1(:) - real(r8), allocatable :: y1(:) - character(len=256) :: filespec - character(len=256) :: locfn - integer :: ierr -!----------------------------------------------------------------------------- -! ... cross section data for use outside the sr-bands (combined from -! brasseur and solomon and the jpl 1994 recommendation) -!----------------------------------------------------------------------------- - -!----------------------------------------------------------------------------- -! ... read o2 cross section data outside sr-bands -!----------------------------------------------------------------------------- -! ... o2 absorption cross sections: -! from 116 nm to 245 nm, including schumann-runge continumm -! from brasseur and solomon 1986. -!----------------------------------------------------------------------------- - filespec = trim( o2_xsect_file ) - call getfil( filespec, locfn, 0 ) - call cam_pio_openfile( ncid, trim( locfn ), PIO_NOWRITE ) -!--------------------------------------------------------------------------- -! ... get the dimensions -!--------------------------------------------------------------------------- - ierr = pio_inq_dimid( ncid, 'nosr', dimid ) - ierr = pio_inq_dimlen( ncid, dimid, nsrc ) - ierr = pio_inq_dimid( ncid, 'ngast', dimid ) - ierr = pio_inq_dimlen( ncid, dimid, ngast ) - ierr = pio_inq_dimid( ncid, 'nla', dimid ) - ierr = pio_inq_dimlen( ncid, dimid, nla ) -!--------------------------------------------------------------------------- -! ... allocate arrays -!--------------------------------------------------------------------------- - allocate( wlint(nsrc), xso2int(nsrc), x1(nsrc), y1(nsrc), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'o2_xsect_inti: failed to allocate wlint ... y1; error = ',astat - call endrun - end if - allocate( wlgast(ngast), wlla(nla), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'o2_xsect_inti: failed to allocate wlgast, wlla; error = ',astat - call endrun - end if -!--------------------------------------------------------------------------- -! ... read the wave bin coordinates -!--------------------------------------------------------------------------- - ierr = pio_inq_varid( ncid, 'wl_src', vid ) - ierr = pio_get_var( ncid, vid, x1 ) - ierr = pio_inq_varid( ncid, 'xs_src', vid ) - ierr = pio_get_var( ncid, vid, y1 ) - ierr = pio_inq_varid( ncid, 'wl_gast', vid ) - ierr = pio_get_var( ncid, vid, wlgast ) - ierr = pio_inq_varid( ncid, 'wl_lym', vid ) - ierr = pio_get_var( ncid, vid, wlla ) - call pio_closefile( ncid ) -!----------------------------------------------------------------------------- -! ... put together the internal grid by "pasting" the lyman-alpha grid and -! kockarts grid into the combination of brasseur/solomon and jpl grid -!----------------------------------------------------------------------------- - wlint(1:9) = x1(1:9) - nwint = 9 - wlint(nwint+1:nwint+2) = wlla(1:2) - nwint = 11 - wlint(nwint+1:nwint+36) = x1(12:47) - nwint = 47 - wlint(nwint+1:nwint+ngast) = wlgast(1:ngast) - nwint = nwint + ngast - wlint(nwint+1:nwint+41) = x1(65:105) - nwint = nwint + 41 - wrk_ind(1:4) = (/ nsrc, ngast, nla, nwint /) -!----------------------------------------------------------------------------- -! ... initialize interpolation module -!----------------------------------------------------------------------------- - call inter_inti( nw+1, wl, nsrc, wlint ) -!----------------------------------------------------------------------------- -! ... interpolate brasseur/solomon and jpl data onto internal grid -!----------------------------------------------------------------------------- - call inter2( nsrc, wlint, xso2int, nsrc, x1, y1, iret ) - deallocate( x1, y1 ) - - - end subroutine o2_xsect_inti - - subroutine set_o2_xsect( z, nw, wl, cz, & - vcol, scol, dto2, xso2 ) -!----------------------------------------------------------------------------- -! purpose: -! compute equivalent optical depths for o2 absorption, parameterized in -! the sr bands and the lyman-alpha line. -!----------------------------------------------------------------------------- -! parameters: -! nz - integer, number of specified altitude levels in the working (i) -! grid -! z - real(r8), specified altitude working grid (km) -! nw - integer, number of specified intervals + 1 in working -! wavelength grid -! wl - real(r8), vector of lower limits of wavelength intervals in -! working wavelength grid -! cz - real(r8), number of air molecules per cm^2 at each specified -! altitude layer -! zen - real(r8), solar zenith angle -! dto2 - real(r8), optical depth due to o2 absorption at each specified (o) -! vertical layer at each specified wavelength -! xso2 - real(r8), molecular absorption cross section in sr bands at (o) -! each specified altitude and wavelength. includes herzberg -! continuum. -!----------------------------------------------------------------------------- -! edit history: -! 02/98 included lyman-alpha parameterization -! 03/97 fix dto2 problem at top level (nz) -! 02/97 changed offset for grid-end interpolation to relative number -! (x * (1 +- deltax)) -! 08/96 modified for early exit, no redundant read of data and smaller -! internal grid if possible; internal grid uses user grid points -! whenever possible -! 07/96 modified to work on internal grid and interpolate final values -! onto the user-defined grid -!----------------------------------------------------------------------------- - - use mo_params, only : kw - use mo_wavelen, only : delw_bin - use mo_inter, only : inter3 - use mo_schu, only : schu - use mo_lymana, only : lymana - use ppgrid, only : pver, pverp - - implicit none - -!----------------------------------------------------------------------------- -! ... dummy arguments -!----------------------------------------------------------------------------- - integer, intent(in) :: nw - real(r8), intent(in) :: wl(kw) - real(r8), intent(in) :: cz(pverp) - real(r8), intent(in) :: z(pverp) - real(r8), intent(in) :: vcol(pverp) - real(r8), intent(in) :: scol(pverp) - real(r8), intent(out) :: dto2(pver,nw) - real(r8), intent(out) :: xso2(nw,pverp) - -!----------------------------------------------------------------------------- -! ... local variables -!----------------------------------------------------------------------------- - integer :: wn, k, igast - integer :: astat - real(r8) :: secchi(pverp) - -!----------------------------------------------------------------------------- -! ... o2 optical depth and equivalent cross section on kockarts grid -!----------------------------------------------------------------------------- - real(r8), allocatable :: dto2k(:,:) - real(r8), allocatable :: xso2k(:,:) -!----------------------------------------------------------------------------- -! ... o2 optical depth and equivalent cross section in the lyman-alpha region -!----------------------------------------------------------------------------- - real(r8), allocatable :: dto2la(:,:) - real(r8), allocatable :: xso2la(:,:) -!----------------------------------------------------------------------------- -! ... temporary one-dimensional storage for optical depth and cross section values -! xxtmp - on internal grid -! xxuser - on user defined grid -!----------------------------------------------------------------------------- - real(r8), dimension(2*kw) :: dttmp, xstmp - real(r8) :: dtuser(kw) - real(r8) :: xsuser(kw) - real(r8) :: o2col(pverp) - - real(r8) :: x, y - real(r8) :: delo2 - -!----------------------------------------------------------------------------- -! ... allocate local variables -!----------------------------------------------------------------------------- - allocate( dto2k(pver,ngast-1), xso2k(pverp,ngast-1), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'set_o2_xsect: failed to allocate dto2k,xso2k; error = ',astat - call endrun - end if - allocate( dto2la(pver,nla-1), xso2la(pverp,nla-1), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'set_o2_xsect: failed to allocate dto2k,xso2k; error = ',astat - call endrun - end if -!----------------------------------------------------------------------------- -! ... check, whether user grid is in the o2 absorption band at all... -! if not, set cross section and optical depth values to zero and return -!----------------------------------------------------------------------------- - dto2(:pver,:nw) = 0._r8 - xso2(:nw,:pverp) = 0._r8 - if( wl(1) > 243._r8 ) then - return - end if - -!----------------------------------------------------------------------------- -! ... sec xhi or chapman calculation -! for zen > 95 degrees, use zen = 95. (this is only to compute effective o2 -! cross sections. still, better than setting dto2 = 0. as was done up to -! version 4.0) sm 1/2000 -! in future could replace with mu2(iz) (but mu2 is also wavelength-depenedent) -! or imporved chapman function -!----------------------------------------------------------------------------- - -!----------------------------------------------------------------------------- -! ... slant o2 column -!----------------------------------------------------------------------------- - o2col(1:pverp) = 0.2095_r8 * scol(1:pverp) - -!----------------------------------------------------------------------------- -! ... effective secant of solar zenith angle. use 2.0 if no direct sun. -! for nz, use value at nz-1 -!----------------------------------------------------------------------------- - secchi(1:pver) = scol(1:pver)/vcol(1:pver) - where( secchi(1:pver) == 0._r8 ) - secchi(1:pver) = 2._r8 - endwhere - secchi(pverp) = secchi(pver) - -!----------------------------------------------------------------------------- -! ... if necessary: -! kockarts parameterization of the sr bands, output values of o2 -! optical depth and o2 equivalent cross section are on his grid -!----------------------------------------------------------------------------- - if( wl(1) < wlgast(ngast) .and. wl(nw+1) > wlgast(1) ) then - call schu( o2col, secchi, dto2k, xso2k ) - else - dto2k(:,:) = 0._r8 - xso2k(:,:) = 0._r8 - end if - -!----------------------------------------------------------------------------- -! ... lyman-alpha parameterization, output values of o2 opticaldepth -! and o2 effective (equivalent) cross section -!----------------------------------------------------------------------------- - if( wl(1) <= wlla(nla) .and. wl(nw+1) >= wlla(1) ) then - call lymana( o2col, secchi, dto2la, xso2la ) - else - dto2la(:,:) = 0._r8 - xso2la(:,:) = 0._r8 - end if - -!----------------------------------------------------------------------------- -! ... loop through the altitude levels -!----------------------------------------------------------------------------- -level_loop : & - do k = 1,pverp - igast = 0 -!----------------------------------------------------------------------------- -! ... loop through the internal wavelength grid -!----------------------------------------------------------------------------- - do wn = 1,nwint-1 -!----------------------------------------------------------------------------- -! ... if outside kockarts grid and outside lyman-alpha, use the -! jpl/brasseur+solomon data, if inside -! kockarts grid, use the parameterized values from the call to schu, -! if inside lyman-alpha, use the paraemterized values from call to lymana -!----------------------------------------------------------------------------- - if( wlint(wn+1) <= wlgast(1) .or. wlint(wn) >= wlgast(ngast) ) then - if( wlint(wn+1) <= wlla(1) .or. wlint(wn) >= wlla(nla) ) then - xstmp(wn) = xso2int(wn) - else - xstmp(wn) = xso2la(k,1) - end if - else - igast = igast + 1 - xstmp(wn) = xso2k(k,igast) - end if -!----------------------------------------------------------------------------- -! ... compute the area in each bin (for correct interpolation purposes only!) -!----------------------------------------------------------------------------- - xstmp(wn) = xstmp(wn) * (wlint(wn+1) - wlint(wn)) - end do -!----------------------------------------------------------------------------- -! ... interpolate o2 cross section from the internal grid onto the user grid -!----------------------------------------------------------------------------- - call inter3( nw+1, wl, xsuser, nwint, wlint, xstmp ) - xso2(:nw,k) = xsuser(:nw) * delw_bin(:nw) - end do level_loop - - do k = 1,pver - igast = 0 - delo2 = .2095_r8 * cz(k) ! vertical o2 column -!----------------------------------------------------------------------------- -! ... loop through the internal wavelength grid -!----------------------------------------------------------------------------- - do wn = 1,nwint-1 -!----------------------------------------------------------------------------- -! ... if outside kockarts grid and outside lyman-alpha, use the -! jpl/brasseur+solomon data, if inside -! kockarts grid, use the parameterized values from the call to schu, -! if inside lyman-alpha, use the paraemterized values from call to lymana -!----------------------------------------------------------------------------- - if( wlint(wn+1) <= wlgast(1) .or. wlint(wn) >= wlgast(ngast) ) then - if( wlint(wn+1) <= wlla(1) .or. wlint(wn) >= wlla(nla) ) then - dttmp(wn) = xso2int(wn) * delo2 - else - dttmp(wn) = dto2la(k,1) - end if - else - igast = igast + 1 - dttmp(wn) = dto2k(k,igast) - end if -!----------------------------------------------------------------------------- -! ... compute the area in each bin (for correct interpolation purposes only!) -!----------------------------------------------------------------------------- - dttmp(wn) = dttmp(wn) * (wlint(wn+1) - wlint(wn)) - end do -!----------------------------------------------------------------------------- -! ... interpolate o2 optical depth from the internal grid onto the user grid -!----------------------------------------------------------------------------- - call inter3( nw+1, wl, dtuser, nwint, wlint, dttmp ) - dto2(k,:nw) = dtuser(:nw) * delw_bin(:nw) - end do - - deallocate( dto2k, xso2k, dto2la, xso2la ) - - end subroutine set_o2_xsect - - end module mo_seto2 diff --git a/src/chemistry/mozart/mo_srf_emissions.F90 b/src/chemistry/mozart/mo_srf_emissions.F90 index e0d80ef1b1..80afe7f474 100644 --- a/src/chemistry/mozart/mo_srf_emissions.F90 +++ b/src/chemistry/mozart/mo_srf_emissions.F90 @@ -28,14 +28,13 @@ module mo_srf_emissions private - public :: srf_emissions_inti, set_srf_emissions, set_srf_emissions_time + public :: srf_emissions_inti, set_srf_emissions, set_srf_emissions_time - save + logical, public, protected :: has_emis(gas_pcnst) = .false. real(r8), parameter :: amufac = 1.65979e-23_r8 ! 1.e4* kg / amu - logical :: has_emis(gas_pcnst) type(emission), allocatable :: emissions(:) - integer :: n_emis_files + integer :: n_emis_files integer :: c10h16_ndx, isop_ndx contains @@ -47,7 +46,7 @@ subroutine srf_emissions_inti( srf_emis_specifier, emis_type_in, emis_cycle_yr, !----------------------------------------------------------------------- use chem_mods, only : adv_mass - use mo_chem_utls, only : get_spc_ndx + use mo_chem_utls, only : get_spc_ndx use tracer_data, only : trcdata_init use cam_pio_utils, only : cam_pio_openfile use pio, only : pio_inquire, pio_nowrite, pio_closefile, pio_inq_varndims @@ -77,11 +76,11 @@ subroutine srf_emissions_inti( srf_emis_specifier, emis_type_in, emis_cycle_yr, character(len=16) :: spc_name character(len=256) :: filename - character(len=16) :: emis_species(gas_pcnst) - character(len=256) :: emis_filenam(gas_pcnst) - integer :: emis_indexes(gas_pcnst) - integer :: indx(gas_pcnst) - real(r8) :: emis_scalefactor(gas_pcnst) + character(len=16) :: emis_species(size(srf_emis_specifier)) + character(len=256) :: emis_filenam(size(srf_emis_specifier)) + integer :: emis_indexes(size(srf_emis_specifier)) + integer :: indx(size(srf_emis_specifier)) + real(r8) :: emis_scalefactor(size(srf_emis_specifier)) integer :: vid, nvars, isec, num_dims_emis integer :: vndims @@ -101,19 +100,19 @@ subroutine srf_emissions_inti( srf_emis_specifier, emis_type_in, emis_cycle_yr, real(r8) :: xdbl integer :: time_dimid, ncol_dimid integer, allocatable :: dimids(:) - + has_emis(:) = .false. nn = 0 indx(:) = 0 - count_emis: do n=1,gas_pcnst + count_emis: do n=1,size(srf_emis_specifier) if ( len_trim(srf_emis_specifier(n) ) == 0 ) then exit count_emis endif i = scan(srf_emis_specifier(n),'->') spc_name = trim(adjustl(srf_emis_specifier(n)(:i-1))) - + ! need to parse out scalefactor ... tmp_string = adjustl(srf_emis_specifier(n)(i+2:)) j = scan( tmp_string, '*' ) @@ -130,7 +129,7 @@ subroutine srf_emissions_inti( srf_emis_specifier, emis_type_in, emis_cycle_yr, if (m > 0) then has_emis(m) = .true. - else + else write(iulog,*) 'srf_emis_inti: spc_name ',spc_name,' is not included in the simulation' call endrun('srf_emis_inti: invalid surface emission specification') endif @@ -161,7 +160,7 @@ subroutine srf_emissions_inti( srf_emis_specifier, emis_type_in, emis_cycle_yr, end if !----------------------------------------------------------------------- - ! Sort the input files so that the emissions sources are summed in the + ! Sort the input files so that the emissions sources are summed in the ! same order regardless of the order of the input files in the namelist !----------------------------------------------------------------------- if (n_emis_files > 0) then @@ -171,7 +170,7 @@ subroutine srf_emissions_inti( srf_emis_specifier, emis_type_in, emis_cycle_yr, !----------------------------------------------------------------------- ! ... setup the emission type array !----------------------------------------------------------------------- - do m=1,n_emis_files + do m=1,n_emis_files emissions(m)%spc_ndx = emis_indexes(indx(m)) emissions(m)%units = 'Tg/y' emissions(m)%species = emis_species(indx(m)) @@ -186,7 +185,11 @@ subroutine srf_emissions_inti( srf_emis_specifier, emis_type_in, emis_cycle_yr, spc_loop: do m = 1, n_emis_files emissions(m)%nsectors = 0 - + + if (masterproc) then + write(iulog,'(a,i3,a)') 'srf_emissions_inti m: ',m,' init file : '//trim(emissions(m)%filename) + endif + call getfil (emissions(m)%filename, locfn, 0) call cam_pio_openfile ( ncid, trim(locfn), PIO_NOWRITE) ierr = pio_inquire (ncid, nVariables=nvars) @@ -198,7 +201,7 @@ subroutine srf_emissions_inti( srf_emis_specifier, emis_type_in, emis_cycle_yr, allocate(is_sector(nvars)) is_sector(:) = .false. - + if (unstructured) then ierr = pio_inq_dimid( ncid, 'time', time_dimid ) end if @@ -254,7 +257,7 @@ subroutine srf_emissions_inti( srf_emis_specifier, emis_type_in, emis_cycle_yr, deallocate(is_sector) ! Global attribute 'input_method' overrides the srf_emis_type namelist setting on - ! a file-by-file basis. If the emis file does not contain the 'input_method' + ! a file-by-file basis. If the emis file does not contain the 'input_method' ! attribute then the srf_emis_type namelist setting is used. call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) ierr = pio_get_att(ncid, PIO_GLOBAL, 'input_method', file_interp_type) @@ -297,7 +300,7 @@ subroutine set_srf_emissions_time( pbuf2d, state ) implicit none - type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_state), intent(in):: state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) !----------------------------------------------------------------------- @@ -364,7 +367,7 @@ subroutine set_srf_emissions( lchnk, ncol, sflx ) "kg/m^2/sec " /) character(len=12) :: units - real(r8), dimension(ncol) :: rlats, rlons + real(r8), dimension(ncol) :: rlats, rlons sflx(:,:) = 0._r8 diff --git a/src/chemistry/mozart/mo_tgcm_ubc.F90 b/src/chemistry/mozart/mo_tgcm_ubc.F90 index 3f88b229e9..3f4bd2d5fd 100644 --- a/src/chemistry/mozart/mo_tgcm_ubc.F90 +++ b/src/chemistry/mozart/mo_tgcm_ubc.F90 @@ -51,7 +51,7 @@ subroutine tgcm_ubc_inti( tgcm_ubc_file, tgcm_ubc_data_type, tgcm_ubc_cycle_yr, ! local vars - integer :: vid, i,ii + integer :: vid, i,ii, ierr character(len=256), parameter :: filelist = ' ' character(len=256), parameter :: datapath = ' ' @@ -60,14 +60,16 @@ subroutine tgcm_ubc_inti( tgcm_ubc_file, tgcm_ubc_data_type, tgcm_ubc_cycle_yr, character(len=4), parameter :: species(nubc) = (/'H2 '/) character(len=4) :: specifier(nubc) = ' ' + character(len=*), parameter :: prefix = 'tgcm_ubc_inti: ' + ii = 0 - + do i = 1,nubc call cnst_get_ind( species(i), vid, abort=.false. ) if( vid > 0 ) then if( cnst_fixed_ubc(vid) ) then ii = ii+1 - specifier(ii) = species(i) ! set specifier to the species that actually + specifier(ii) = species(i) ! set specifier to the species that actually ! are registered to have a specified upper bounary ! so that the species mapping is correct ubc_from_tgcm(vid) = .true. @@ -82,7 +84,8 @@ subroutine tgcm_ubc_inti( tgcm_ubc_file, tgcm_ubc_data_type, tgcm_ubc_cycle_yr, if (ub_nspecies > 0) then file%top_bndry = .true. - allocate(file%in_pbuf(size(specifier))) + allocate(file%in_pbuf(size(specifier)), stat=ierr) + if (ierr /= 0) call endrun(prefix//'allocate error : file%in_pbuf') file%in_pbuf(:) = .false. call trcdata_init( specifier, tgcm_ubc_file, filelist, datapath, fields, file, & rmv_file, tgcm_ubc_cycle_yr, tgcm_ubc_fixed_ymd, tgcm_ubc_fixed_tod, tgcm_ubc_data_type) @@ -100,7 +103,6 @@ subroutine tgcm_timestep_init(pbuf2d, state ) !-------------------------------------------------------------------- ! ... Advance ub values !-------------------------------------------------------------------- - implicit none ! args type(physics_state), intent(in):: state(begchunk:endchunk) @@ -112,65 +114,34 @@ subroutine tgcm_timestep_init(pbuf2d, state ) end subroutine tgcm_timestep_init - subroutine set_tgcm_ubc( lchunk, ncol, mmr, mw_dry ) + subroutine set_tgcm_ubc( lchunk, ncol, mmr ) !-------------------------------------------------------------------- ! ... Set the upper boundary values h2o, h2, and h !-------------------------------------------------------------------- - - use ppgrid, only : pcols - use constituents, only : cnst_get_ind, cnst_mw - use cam_history, only : outfld - - implicit none + use ppgrid, only : pcols + use cam_history, only : outfld !-------------------------------------------------------------------- ! ... dummy args !-------------------------------------------------------------------- integer, intent(in) :: lchunk ! chunk id integer, intent(in) :: ncol ! columns in chunk - real(r8), intent(in) :: mw_dry(pcols) ! mean mass at top model level real(r8), intent(inout) :: mmr(pcols,pcnst) !-------------------------------------------------------------------- ! ... local variables !-------------------------------------------------------------------- - real(r8), parameter :: h2o_ubc_vmr = 2.e-8_r8 ! fixed ub h2o concentration (kg/kg) - real(r8), parameter :: ch4_ubc_vmr = 2.e-10_r8 ! fixed ub ch4 concentration (kg/kg) - integer :: m,n if (ub_nspecies > 0) then do m = 1,ub_nspecies -!--------------------------------------------------------------- -! ... tgcm upper bndy values -!--------------------------------------------------------------- - n = map(m) mmr(:ncol,n) = fields(m)%data(:ncol,1,lchunk) call outfld( ubc_name(m), mmr(:ncol,n), ncol, lchunk ) enddo endif - !-------------------------------------------------------- - ! ... special section to set h2o and ch4 ub concentrations - !-------------------------------------------------------- - mmr(:ncol,1) = cnst_mw(1)*h2o_ubc_vmr/mw_dry(:ncol) - call cnst_get_ind( 'CH4', m, abort=.false. ) - if( m > 0 ) then - mmr(:ncol,m) = cnst_mw(m)*ch4_ubc_vmr/mw_dry(:ncol) - end if - -#ifdef TGCM_DIAGS - call cnst_get_ind( 'H2', m, abort=.false. ) - if( m > 0 ) then - write(iulog,*) 'set_ub_vals: diagnostics for chunk = ',lchunk - write(iulog,*) 'last,next,dels = ',last,next,dels - write(iulog,*) 'h2 mmr at level ',k - write(iulog,'(1x,1p,10g12.5)') mmr(:ncol,m)) - end if -#endif - end subroutine set_tgcm_ubc end module mo_tgcm_ubc diff --git a/src/chemistry/mozart/mo_usrrxt.F90 b/src/chemistry/mozart/mo_usrrxt.F90 index b6ac6552c1..f37b45c92c 100644 --- a/src/chemistry/mozart/mo_usrrxt.F90 +++ b/src/chemistry/mozart/mo_usrrxt.F90 @@ -19,6 +19,7 @@ module mo_usrrxt integer :: usr_N2O5_aer_ndx integer :: usr_NO3_aer_ndx integer :: usr_NO2_aer_ndx + integer :: usr_CO_OH_ndx integer :: usr_CO_OH_a_ndx integer :: usr_CO_OH_b_ndx integer :: usr_PAN_M_ndx @@ -257,11 +258,17 @@ subroutine usrrxt_inti usr_N2O5_aer_ndx = get_rxt_ndx( 'usr_N2O5_aer' ) usr_NO3_aer_ndx = get_rxt_ndx( 'usr_NO3_aer' ) usr_NO2_aer_ndx = get_rxt_ndx( 'usr_NO2_aer' ) + usr_CO_OH_ndx = get_rxt_ndx( 'usr_CO_OH' ) usr_CO_OH_a_ndx = get_rxt_ndx( 'usr_CO_OH_a' ) usr_CO_OH_b_ndx = get_rxt_ndx( 'usr_CO_OH_b' ) usr_PAN_M_ndx = get_rxt_ndx( 'usr_PAN_M' ) usr_CH3COCH3_OH_ndx = get_rxt_ndx( 'usr_CH3COCH3_OH' ) usr_MCO3_NO2_ndx = get_rxt_ndx( 'usr_MCO3_NO2' ) + tag_MCO3_NO2_ndx = get_rxt_ndx( 'tag_MCO3_NO2' ) + if( tag_MCO3_NO2_ndx<0 .and. usr_MCO3_NO2_ndx>0 ) then + tag_MCO3_NO2_ndx = usr_MCO3_NO2_ndx + endif + usr_MPAN_M_ndx = get_rxt_ndx( 'usr_MPAN_M' ) usr_XOOH_OH_ndx = get_rxt_ndx( 'usr_XOOH_OH' ) usr_SO2_OH_ndx = get_rxt_ndx( 'usr_SO2_OH' ) @@ -340,7 +347,6 @@ subroutine usrrxt_inti usr_ISOPNOOHDO2_NOa_ndx = get_rxt_ndx( 'usr_ISOPNOOHDO2_NOa' ) usr_NC4CHOO2_NOn_ndx = get_rxt_ndx( 'usr_NC4CHOO2_NOn' ) usr_NC4CHOO2_NOa_ndx = get_rxt_ndx( 'usr_NC4CHOO2_NOa' ) - tag_MCO3_NO2_ndx = get_rxt_ndx( 'tag_MCO3_NO2' ) tag_TERPACO3_NO2_ndx = get_rxt_ndx( 'tag_TERPACO3_NO2' ) usr_TERPAPAN_M_ndx = get_rxt_ndx( 'usr_TERPAPAN_M' ) tag_TERPA2CO3_NO2_ndx = get_rxt_ndx( 'tag_TERPA2CO3_NO2' ) @@ -638,10 +644,10 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & !----------------------------------------------------------------- ! ... reaction probabilities for heterogeneous reactions !----------------------------------------------------------------- - real(r8), parameter :: gamma_n2o5 = 0.10_r8 ! from Jacob, Atm Env, 34, 2131, 2000 - real(r8), parameter :: gamma_ho2 = 0.20_r8 ! - real(r8), parameter :: gamma_no2 = 0.0001_r8 ! - real(r8), parameter :: gamma_no3 = 0.001_r8 ! + real(r8), parameter :: gamma_n2o5 = 0.02_r8 ! JPL19 + real(r8), parameter :: gamma_ho2 = 0.10_r8 ! Gaubert et al., https://doi.org/10.5194/acp-20-14617-2020 + real(r8), parameter :: gamma_no2 = 8.0e-6_r8 ! Liu et al., Environ.Sci.&Tech, 53, 3517, 2019 doi:10.1021/acs.est.8b06367 + real(r8), parameter :: gamma_no3 = 0.002_r8 ! JPL19 real(r8), parameter :: gamma_glyoxal = 2.0e-4_r8 ! Washenfelder et al, JGR, 2011 !TS1 species real(r8), parameter :: gamma_isopnita = 0.005_r8 ! from Fisher et al., ACP, 2016 @@ -912,7 +918,22 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & end if end if !----------------------------------------------------------------- -! co + oh --> co2 + ho2 (combined branches - do not use with CO_OH_b) +! ... co + oh --> co2 + ho2 (new single reaction for combined branches [JPL19]) +!----------------------------------------------------------------- + if( usr_CO_OH_ndx > 0 ) then + ko (:) = 6.9e-33_r8 * ( 298._r8 / temp(:ncol,k) )**(2.1_r8) + kinf(:) = 1.1e-12_r8 * ( 298._r8 / temp(:ncol,k) )**(-1.3_r8) + + term2(:) = (1 + (log10( ko(:)*m(:,k) / kinf(:) ))**2)**(-1) + + term1(:) = (kinf(:) * ko(:)*m(:,k)) / (kinf(:) + ko(:)*m(:,k)) * (0.6_r8)**term2(:) + + rxt(:ncol,k,usr_CO_OH_ndx) = term1(:) + 1.85e-13_r8 * exp(-65._r8/temp(:ncol,k)) * (1._r8 - term1(:)/kinf(:)) + + end if +!----------------------------------------------------------------- +! ... co + oh --> co2 + ho2 (combined branches - do not use with CO_OH_b) +! note: for mechanisms prior to Dec 2022 !----------------------------------------------------------------- if( usr_CO_OH_a_ndx > 0 ) then rxt(:,k,usr_CO_OH_a_ndx) = 1.5e-13_r8 * & @@ -920,6 +941,7 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & end if !----------------------------------------------------------------- ! ... co + oh --> co2 + h (second branch JPL15-10, with CO+OH+M) +! note: for mechanisms prior to Dec 2022 !----------------------------------------------------------------- if( usr_CO_OH_b_ndx > 0 ) then kinf(:) = 2.1e+09_r8 * (temp(:ncol,k)/ t0)**(6.1_r8) @@ -1061,12 +1083,14 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & !----------------------------------------------------------------- ! ... DMS + OH --> .5 * SO2 +! JPL15-10 (use [O2] = 0.21*[M]) +! k = 8.2E-39 * exp(5376/T) * [O2] / (1 + 1.05E-5 *([O2]/[M]) * exp(3644/T)) !----------------------------------------------------------------- if( usr_DMS_OH_ndx > 0 ) then - call comp_exp( exp_fac, 7460._r8*tinv, ncol ) - ko(:) = 1._r8 + 5.5e-31_r8 * exp_fac * m(:,k) * 0.21_r8 - call comp_exp( exp_fac, 7810._r8*tinv, ncol ) - rxt(:,k,usr_DMS_OH_ndx) = 1.7e-42_r8 * exp_fac * m(:,k) * 0.21_r8 / ko(:) + call comp_exp( exp_fac, 3644._r8*tinv, ncol ) + ko(:) = 1._r8 + 1.05e-5_r8 * exp_fac * 0.21_r8 + call comp_exp( exp_fac, 5376._r8*tinv, ncol ) + rxt(:,k,usr_DMS_OH_ndx) = 8.2e-39_r8 * exp_fac * m(:,k) * 0.21_r8 / ko(:) end if !----------------------------------------------------------------- @@ -2007,138 +2031,141 @@ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, & !----------------------------------------------------------------- ! ... CO tags !----------------------------------------------------------------- - if( usr_CO_OH_b_ndx > 0 ) then + if( usr_CO_OH_b_ndx > 0 .and. usr_CO_OH_ndx < 0 ) then + usr_CO_OH_ndx = usr_CO_OH_b_ndx + end if + if( usr_CO_OH_ndx > 0 ) then if( usr_COhc_OH_ndx > 0 ) then - rxt(:ncol,:,usr_COhc_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_COhc_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_COme_OH_ndx > 0 ) then - rxt(:ncol,:,usr_COme_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_COme_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO01_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO01_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO01_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO02_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO02_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO02_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO03_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO03_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO03_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO04_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO04_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO04_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO05_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO05_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO05_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO06_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO06_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO06_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO07_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO07_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO07_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO08_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO08_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO08_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO09_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO09_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO09_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO10_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO10_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO10_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO11_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO11_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO11_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO12_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO12_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO12_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO13_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO13_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO13_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO14_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO14_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO14_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO15_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO15_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO15_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO16_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO16_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO16_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO17_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO17_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO17_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO18_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO18_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO18_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO19_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO19_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO19_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO20_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO20_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO20_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO21_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO21_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO21_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO22_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO22_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO22_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO23_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO23_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO23_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO24_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO24_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO24_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO25_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO25_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO25_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO26_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO26_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO26_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO27_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO27_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO27_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO28_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO28_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO28_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO29_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO29_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO29_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO30_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO30_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO30_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO31_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO31_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO31_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO32_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO32_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO32_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO33_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO33_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO33_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO34_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO34_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO34_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO35_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO35_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO35_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO36_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO36_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO36_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO37_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO37_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO37_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO38_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO38_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO38_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO39_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO39_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO39_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO40_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO40_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO40_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO41_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO41_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO41_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if if( usr_CO42_OH_ndx > 0 ) then - rxt(:ncol,:,usr_CO42_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx) + rxt(:ncol,:,usr_CO42_OH_ndx) = rxt(:ncol,:,usr_CO_OH_ndx) end if end if !lke-- diff --git a/src/chemistry/mozart/mo_waccm_hrates.F90 b/src/chemistry/mozart/mo_waccm_hrates.F90 index dcfc319c3e..4f368c749f 100644 --- a/src/chemistry/mozart/mo_waccm_hrates.F90 +++ b/src/chemistry/mozart/mo_waccm_hrates.F90 @@ -93,7 +93,8 @@ subroutine waccm_hrates(ncol, state, asdir, bot_mlt_lev, qrs_tot, pbuf ) use chem_mods, only : nabscol, nfs, gas_pcnst, rxntot, indexm use ppgrid, only : pcols, pver - use physconst, only : rga, mbarv, cpairv + use physconst, only : rga + use air_composition, only : mbarv, cpairv use constituents, only : pcnst use mo_gas_phase_chemdr,only: map2chm use mo_photo, only : set_ub_col, setcol @@ -332,7 +333,7 @@ subroutine waccm_hrates(ncol, state, asdir, bot_mlt_lev, qrs_tot, pbuf ) !----------------------------------------------------------------------- ! ... set the column densities !----------------------------------------------------------------------- - call setcol( col_delta, col_dens, vmr, state%pdel, ncol ) + call setcol( col_delta, col_dens ) !----------------------------------------------------------------------- ! ... compute the thermal heating rates !----------------------------------------------------------------------- diff --git a/src/chemistry/mozart/noy_ubc.F90 b/src/chemistry/mozart/noy_ubc.F90 deleted file mode 100644 index 37974670aa..0000000000 --- a/src/chemistry/mozart/noy_ubc.F90 +++ /dev/null @@ -1,247 +0,0 @@ -!======================================================================== -! NOy at upper boundary for CAM-Chem -!======================================================================== - -module noy_ubc - - use shr_kind_mod, only : r8 => shr_kind_r8 - use spmd_utils, only : masterproc - use cam_abortutils, only : endrun - use cam_logfile, only : iulog - - use tracer_data, only : trfld,trfile,MAXTRCRS - use cam_history, only : addfld, horiz_only - - implicit none - - private - public :: noy_ubc_init - public :: noy_ubc_set - public :: noy_ubc_advance - public :: noy_ubc_readnl - - save - - type(trfld), pointer :: fields(:) - type(trfile) :: file - - integer :: ub_nspecies - character(len=16) :: ubc_name(MAXTRCRS) - integer :: map(MAXTRCRS) = -1 - - character(len=256) :: noy_ubc_filename = 'NONE' - character(len=256) :: noy_ubc_filelist = ' ' - character(len=256) :: noy_ubc_datapath = ' ' - character(len=32) :: noy_ubc_datatype = 'SERIAL' - logical :: noy_ubc_rmv_file = .false. - integer :: noy_ubc_cycle_yr = 0 - integer :: noy_ubc_fixed_ymd = 0 - integer :: noy_ubc_fixed_tod = 0 - - real(r8) :: fac_relax - - logical :: has_noy_ubc = .false. - -contains - - !====================================================================== - !====================================================================== - subroutine noy_ubc_readnl(nlfile) - - use namelist_utils, only : find_group_name - use units, only : getunit, freeunit - use spmd_utils, only : mpicom, masterprocid, mpi_character, mpi_integer - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'noy_ubc_readnl' - - namelist /noy_ubc_nl/ & - noy_ubc_filename, noy_ubc_filelist, noy_ubc_datapath, noy_ubc_datatype, & - noy_ubc_cycle_yr, noy_ubc_fixed_ymd, noy_ubc_fixed_tod - - ! Read namelist - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'noy_ubc_nl', status=ierr) - if (ierr == 0) then - read(unitn, noy_ubc_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - - ! Broadcast namelist variables - call mpi_bcast(noy_ubc_filename, len(noy_ubc_filename), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(noy_ubc_filelist, len(noy_ubc_filelist), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(noy_ubc_datapath, len(noy_ubc_datapath), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(noy_ubc_datatype, len(noy_ubc_datatype), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(noy_ubc_cycle_yr, 1, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(noy_ubc_fixed_ymd, 1, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(noy_ubc_fixed_tod, 1, mpi_integer, masterprocid, mpicom, ierr) - - has_noy_ubc = len_trim(noy_ubc_filename) > 0 .and. noy_ubc_filename.ne.'NONE' - - end subroutine noy_ubc_readnl - - !====================================================================== - !====================================================================== - subroutine noy_ubc_init() - - !------------------------------------------------------------------ - ! ... initialize upper boundary values - !------------------------------------------------------------------ - use tracer_data, only : trcdata_init - use mo_chem_utls, only : get_spc_ndx - - !------------------------------------------------------------------ - ! ... dummy args - !------------------------------------------------------------------ - - ! local vars - integer :: vid, i,ii - - integer, parameter :: nubc = 4 - character(len=4), parameter :: species(nubc) = (/'NO ','NO2 ','HNO3','N2O5'/) - character(len=4) :: specifier(nubc) = ' ' - - if (.not.has_noy_ubc) return - - ii = 0 - - do i = 1,nubc - vid = get_spc_ndx(species(i)) - if( vid > 0 ) then - ii = ii+1 - specifier(ii) = species(i) ! set specifier to the species that actually - ! are in the simulation so that the species mapping is correct - map(ii) = vid - ubc_name(ii) = trim(specifier(i))//'_ubc' - call addfld( ubc_name(ii), horiz_only, 'I', 'mol/mol', 'upper boundary vmr' ) - - end if - enddo - - ub_nspecies = count( map(:)>0 ) - - if (ub_nspecies > 0) then - file%top_bndry = .true. - allocate(file%in_pbuf(size(specifier))) - file%in_pbuf(:) = .false. - call trcdata_init( specifier, noy_ubc_filename, noy_ubc_filelist, noy_ubc_datapath, fields, file, & - noy_ubc_rmv_file, noy_ubc_cycle_yr, noy_ubc_fixed_ymd, noy_ubc_fixed_tod, noy_ubc_datatype) - endif - - end subroutine noy_ubc_init - - !====================================================================== - !====================================================================== - subroutine noy_ubc_advance(pbuf2d, state) - - use tracer_data, only : advance_trcdata - use physics_types, only : physics_state - use physics_buffer, only : physics_buffer_desc - use time_manager, only : get_step_size - - !-------------------------------------------------------------------- - ! ... Advance ub values - !-------------------------------------------------------------------- - implicit none - - ! args - type(physics_state), intent(in) :: state(:) - type(physics_buffer_desc), pointer :: pbuf2d(:,:) -! - integer :: dtime ! model time step (s) - real(r8), parameter :: tau_relax = 864000._r8 ! 10 days - - if (.not.has_noy_ubc) return -! -! define relaxation factor -! - dtime = get_step_size() - fac_relax = 1._r8 - exp( -real(dtime)/tau_relax ) -! - if (ub_nspecies > 0) then - call advance_trcdata( fields, file, state, pbuf2d ) - endif - - end subroutine noy_ubc_advance - - !====================================================================== - ! ... Set the upper boundary values - !====================================================================== - subroutine noy_ubc_set( lchnk, ncol, vmr ) - use cam_history, only : outfld - - implicit none - - !-------------------------------------------------------------------- - ! ... dummy args - !-------------------------------------------------------------------- - integer, intent(in) :: lchnk ! chunk id - integer, intent(in) :: ncol ! columns in chunk - real(r8), intent(inout) :: vmr(:,:,:) - - integer :: m,n,m1,m2,i - real(r8) :: xno,xno2,xnox,rno,dtime - real(r8) :: yno,yno2,ynox - - if (.not.has_noy_ubc) return -! -! only update model top layer (index=1) -! - if (ub_nspecies > 0) then - do m = 1,ub_nspecies - if ( trim(fields(m)%fldnam) == 'NO' .or. trim(fields(m)%fldnam) == 'NO2' ) cycle - n = map(m) - vmr(:ncol,1,n) = fields(m)%data(:ncol,1,lchnk) - call outfld( ubc_name(m), vmr(:ncol,1,n), ncol, lchnk ) - enddo - endif -! -! special case for NO & NO2 -! - m1 = -99 - m2 = -99 - do m=1,ub_nspecies - if ( trim(fields(m)%fldnam) == 'NO' ) m1 = m - if ( trim(fields(m)%fldnam) == 'NO2' ) m2 = m - end do - if ( m1 > 0 .and. m2 > 0 ) then -! - do i=1,ncol -! - xno = vmr(i,1,map(m1)) - xno2 = vmr(i,1,map(m2)) - xnox = xno + xno2 - rno = xno/xnox -! - yno = fields(m1)%data(i,1,lchnk) - yno2 = fields(m2)%data(i,1,lchnk) - ynox = yno + yno2 -! -! relax model NOx towards the specified values -! - xnox = xnox + (ynox - xnox) * fac_relax -! -! use original ratio to redistribute updated NOx between NO and NO2 -! - vmr(i,1,map(m1)) = rno * xnox - vmr(i,1,map(m2)) = (1._r8-rno) * xnox -! - end do -! - call outfld( ubc_name(m1), vmr(:ncol,1,map(m1)), ncol, lchnk ) - call outfld( ubc_name(m2), vmr(:ncol,1,map(m2)), ncol, lchnk ) - end if -! - end subroutine noy_ubc_set - -end module noy_ubc diff --git a/src/chemistry/mozart/ocean_emis.F90 b/src/chemistry/mozart/ocean_emis.F90 index 26819fd846..d8179d42b8 100644 --- a/src/chemistry/mozart/ocean_emis.F90 +++ b/src/chemistry/mozart/ocean_emis.F90 @@ -3,23 +3,23 @@ ! Ref: Carpenter et al Chem Soc Rev (2012); Johnson, Ocean sci (2010) ! ------------------------------------------------------------------------------------ ! Required inputs for the air-sea flux module: -! - Seawater concentration (nanomoles per liter) and Sea surface salinity +! - Seawater concentration (nanomoles per liter) and Sea surface salinity ! (parts per thousand) read from namelist (netCDF) ! - Concentration in the gas-phase (pptv), air temperature (K), 10m windspeed (m/s), ! surface pressure (atm), sea surface temperature (K): all from other modules ! ------------------------------------------------------------------------------------ ! Key subroutines: -! ocean_emis_readnl(..): Read salinity from namelist (user_nl_cam). +! ocean_emis_readnl(..): Read salinity from namelist (user_nl_cam). ! Salinity not time-dependent. Flux depends very weakly on it -! ocean_emis_init(...): Interpolate salinity, initialize the library for the flux +! ocean_emis_init(...): Interpolate salinity, initialize the library for the flux ! reading time-dependent seawater conc. from user_nl_cam ! ocean_emis_advance(...): process the seawater concentration -! ocean_emis_getflux(...): calculate the air-sea flux (upward or downward), +! ocean_emis_getflux(...): calculate the air-sea flux (upward or downward), ! then add to total surface flux (sflx) ! ------------------------------------------------------------------------------------ ! Last built: 9 March 2018. ! Written by: Siyuan Wang (ACOM/NCAR) siyuan@ucar.edu -! Acknowledgement: Francis Vitt (NCAR). and of course Dr. Peppurr too +! Acknowledgement: Francis Vitt (NCAR). and of course Dr. Peppurr too ! ==================================================================================== module ocean_emis @@ -28,12 +28,12 @@ module ocean_emis use ppgrid, only : pcols, begchunk,endchunk use spmd_utils, only : masterproc use cam_abortutils, only : endrun - use cam_history, only : addfld, horiz_only, outfld + use cam_history, only : addfld, add_default, horiz_only, outfld use constituents, only : cnst_get_ind use tracer_data, only : trfld,trfile use chem_mods, only : gas_pcnst use cam_logfile, only : iulog - use ioFileMod, only : getfil + use ioFileMod, only : getfil implicit none @@ -42,6 +42,7 @@ module ocean_emis public :: ocean_emis_init public :: ocean_emis_getflux public :: ocean_emis_advance + public :: ocean_emis_species type :: Csw integer :: spc_ndx @@ -57,9 +58,9 @@ module ocean_emis logical :: switch_bubble type(Csw), allocatable :: Csw_nM(:) - integer :: n_Csw_files + integer :: n_Csw_files = 0 - real(r8), allocatable :: salinity(:,:) + real(r8), allocatable :: salinity(:,:) ! ================ ! Air-sea exchange @@ -69,32 +70,32 @@ module ocean_emis Integer, Parameter :: HowManySalts = 5 ! Change this number if you wanna add more salts Integer, Parameter :: HowManySaltProperties = 7 ! Don't touch this (unless you wanna add more fields) - Type GasLib + Type GasLib Character(16) :: CmpdName Real(r8), Dimension(HowManyProperties) :: CmpdProperties End Type GasLib - Type SaltLib + Type SaltLib Character(16) :: SaltName - Real(r8), Dimension(HowManySaltProperties) :: SaltProperties + Real(r8), Dimension(HowManySaltProperties) :: SaltProperties End Type SaltLib Type(GasLib), Dimension(HowManyMolecules) :: GasList ! Library for the trace gas properties Type(SaltLib), Dimension(HowManySalts) :: SaltList ! Library for the salt properties - ! =========================== + ! =========================== ! seawater concentration: ! =========================== - character(len=cl) :: csw_specifier(gas_pcnst) = '' + character(len=cl) :: csw_specifier(gas_pcnst) = '' character(len=24) :: csw_time_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS' integer :: csw_cycle_yr = 0 - logical :: bubble_mediated_transfer = .false. + logical :: bubble_mediated_transfer = .false. character(len=cl) :: ocean_salinity_file = 'NONE' contains -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- subroutine ocean_emis_readnl(nlfile) use namelist_utils, only : find_group_name @@ -105,7 +106,7 @@ subroutine ocean_emis_readnl(nlfile) integer :: unitn, ierr character(len=*), parameter :: subname = 'ocean_emis_readnl' - ! =================== + ! =================== ! Namelist definition ! =================== namelist /ocean_emis_nl/ ocean_salinity_file @@ -125,7 +126,7 @@ subroutine ocean_emis_readnl(nlfile) end if close(unitn) end if - + ! ============================ ! Broadcast namelist variables ! ============================ @@ -151,7 +152,7 @@ subroutine ocean_emis_init() use pio, only : file_desc_t, pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, pio_get_var use pio, only : PIO_NOWRITE, PIO_NOERR use pio, only : pio_seterrorhandling, PIO_BCAST_ERROR, pio_closefile - use phys_grid, only : get_ncols_p, get_rlon_all_p, get_rlat_all_p + use phys_grid, only : get_ncols_p, get_rlon_all_p, get_rlat_all_p use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish use mo_constants, only : pi @@ -162,19 +163,19 @@ subroutine ocean_emis_init() real(r8), allocatable :: file_lats(:), file_lons(:) real(r8), allocatable :: wrk2d(:,:) real(r8) :: to_lats(pcols), to_lons(pcols) - type(interp_type) :: lon_wgts, lat_wgts + type(interp_type) :: lon_wgts, lat_wgts real(r8), parameter :: zero=0_r8, twopi=2_r8*pi, degs2rads = pi/180._r8 character(len=*), parameter :: subname = 'ocean_emis_init' - + if (trim(ocean_salinity_file) == 'NONE') return call getfil( ocean_salinity_file, filen, 0 ) call cam_pio_openfile( fid, filen, PIO_NOWRITE) - + call pio_seterrorhandling(fid, PIO_BCAST_ERROR) - + ierr = pio_inq_dimid( fid, 'lon', dimid ) if (ierr /= PIO_NOERR) then call endrun(subname//': pio_inq_dimid lon FAILED') @@ -225,6 +226,7 @@ subroutine ocean_emis_init() endif allocate(salinity(pcols,begchunk:endchunk)) + salinity = 0._r8 do c=begchunk,endchunk @@ -235,17 +237,22 @@ subroutine ocean_emis_init() call lininterp_init(file_lons, file_nlon, to_lons, ncols, 2, lon_wgts, zero, twopi) call lininterp_init(file_lats, file_nlat, to_lats, ncols, 1, lat_wgts) - call lininterp(wrk2d, file_nlon, file_nlat, salinity(1:ncols,c), ncols, lon_wgts, lat_wgts) + call lininterp(wrk2d, file_nlon, file_nlat, salinity(1:ncols,c), ncols, lon_wgts, lat_wgts) call lininterp_finish(lon_wgts) call lininterp_finish(lat_wgts) end do + ! fill in missing values with climatology for modern-day + where(salinity < 0._r8) + salinity = 33.0_r8 + end where + deallocate( file_lons, file_lats ) deallocate( wrk2d ) - call addfld('OCN_SALINITY', horiz_only, 'A', 'parts per thousands', 'ocean salinity' ) + call addfld('OCN_SALINITY', horiz_only, 'A', 'parts per thousands', 'ocean salinity' ) ! ====================================================== ! initializing the libraries for the air-sea flux module @@ -253,17 +260,17 @@ subroutine ocean_emis_init() Call CmpLibInitialization() Call SaltLibInitialization() - ! --------------------------------------------- + ! --------------------------------------------- ! Read seawater concentration: WSY ! --------------------------------------------- call cseawater_ini() call pio_closefile (fid) - + end subroutine ocean_emis_init -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- subroutine ocean_emis_advance( pbuf2d, state ) ! ------------------------------- ! check serial case for time span @@ -274,7 +281,7 @@ subroutine ocean_emis_advance( pbuf2d, state ) use tracer_data, only : advance_trcdata use physics_buffer, only : physics_buffer_desc - type(physics_state), intent(in) :: state(begchunk:endchunk) + type(physics_state), intent(in) :: state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer :: m @@ -286,12 +293,12 @@ subroutine ocean_emis_advance( pbuf2d, state ) end subroutine ocean_emis_advance -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- subroutine ocean_emis_getflux(lchnk, ncol, state, u10, sst, ocnfrac, icefrac, sflx) use physics_types, only : physics_state - use ppgrid, only : pver + use ppgrid, only : pver integer, intent(in) :: lchnk, ncol type(physics_state), target, intent(in) :: state ! Physics state variables @@ -301,13 +308,13 @@ subroutine ocean_emis_getflux(lchnk, ncol, state, u10, sst, ocnfrac, icefrac, sf real(r8), intent(in) :: icefrac(:) ! Ice fraction real(r8), intent(inout) :: sflx(:,:) ! Surface emissions (kg/m^2/s) - integer :: m, isec, SpeciesID - real(r8) :: Csw_col(ncol) - real(r8) :: MW_species - real(r8) :: oceanflux_kg_m2_s(ncol) + integer :: i, m, isec, SpeciesID + real(r8) :: Csw_col(ncol) + real(r8) :: MW_species + real(r8) :: oceanflux_kg_m2_s(ncol) if (trim(ocean_salinity_file) == 'NONE') return - + ! ================================================== ! Get seawater concentrations and calculate the flux ! ================================================== @@ -317,28 +324,30 @@ subroutine ocean_emis_getflux(lchnk, ncol, state, u10, sst, ocnfrac, icefrac, sf isec = 1 Csw_col(:ncol) = Csw_nM(m)%scalefactor*Csw_nM(m)%fields(isec)%data(:ncol,1,lchnk) - MW_species = MolecularWeight(SpeciesIndex( Csw_nM(m)%species )) + MW_species = MolecularWeight(SpeciesIndex( Csw_nM(m)%species )) call cnst_get_ind( trim(Csw_nM(m)%species), SpeciesID, abort=.true. ) oceanflux_kg_m2_s = 0.0_r8 - where (ocnfrac(:ncol) >= 0.2_r8 .and. Csw_col(:ncol) >= 0._r8) ! calculate flux only for ocean - oceanflux_kg_m2_s(:ncol) = Flux_kg_m2_s( & - Csw_nM(m)%species, & ! name of species - state%q(:ncol,pver,SpeciesID) * (28.97_r8/MW_species) * 1.0e+12_r8, & ! air concentration (ppt) - Csw_col(:ncol), & ! sea water concentration (nM) - state%t(:ncol,pver), & ! air temperature (K) - u10(:ncol), & ! wind speed at 10m (m/s) <- should use this - state%ps(:ncol) / 101325.0_r8, & ! surface pressure (atm) - sst(:ncol), & ! sea surface temperautre (K) - salinity(:ncol,lchnk), & ! ocean salinity (parts per thousands) - switch_bubble, & ! bubble-mediated transfer: on or off - ncol ) - end where + do i = 1,ncol + if (ocnfrac(i) >= 0.2_r8 .and. Csw_col(i) >= 0._r8) then + ! calculate flux only for ocean + oceanflux_kg_m2_s(i) = Flux_kg_m2_s( & + Csw_nM(m)%species, & ! name of species + state%q(i,pver,SpeciesID) * (28.97_r8/MW_species) * 1.0e+12_r8, & ! air concentration (ppt) + Csw_col(i), & ! sea water concentration (nM) + state%t(i,pver), & ! air temperature (K) + u10(i), & ! wind speed at 10m (m/s) <- should use this + state%ps(i) / 101325.0_r8, & ! surface pressure (atm) + sst(i), & ! sea surface temperautre (K) + salinity(i,lchnk), & ! ocean salinity (parts per thousands) + switch_bubble ) ! bubble-mediated transfer: on or off + end if + end do ! =========================================================================== - ! Add the ocean flux to the other fluxes + ! Add the ocean flux to the other fluxes ! Make sure this ocean module is called after other surface emissions are set ! =========================================================================== sflx(:ncol,SpeciesID) = sflx(:ncol,SpeciesID) + oceanflux_kg_m2_s(:ncol) * ocnfrac(:ncol) @@ -355,10 +364,8 @@ subroutine ocean_emis_getflux(lchnk, ncol, state, u10, sst, ocnfrac, icefrac, sf end subroutine ocean_emis_getflux - -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- - + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- Subroutine CmpLibInitialization() ! ===================================================================================== ! This is the lookup table for molecular weight, Vb, and Henry's law constant @@ -377,7 +384,7 @@ Subroutine CmpLibInitialization() GasList(2) = GasLib('C2H5OH', (/ 46.07_r8, 2.0_r8, 6.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, & 0.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 190.0_r8, 6500.0_r8 /)) GasList(3) = GasLib('CH2O', (/ 30.03_r8, 1.0_r8, 2.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, & - 0.0_r8, 0.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 3230.0_r8, 7100.0_r8 /)) + 0.0_r8, 0.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 3230.0_r8, 7100.0_r8 /)) GasList(4) = GasLib('CH3CHO', (/ 44.05_r8, 2.0_r8, 4.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, & 0.0_r8, 0.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 12.9_r8, 5890.0_r8/)) GasList(5) = GasLib('PROPANAL', (/ 58.08_r8, 3.0_r8, 6.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, & @@ -409,10 +416,12 @@ Subroutine CmpLibInitialization() ! -------------------------------------------------------------------------------- End Subroutine CmpLibInitialization + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- Subroutine SaltLibInitialization() ! ================================================================================ - ! This is the lookup table for common solutes in seawater and the parameters to - ! calculate the dynamic viscosity of seawater. + ! This is the lookup table for common solutes in seawater and the parameters to + ! calculate the dynamic viscosity of seawater. ! You may add other solutes or change the mass fractions. ! -------------------------------------------------------------------------------- ! Col 1: mass fraction of solute @@ -431,6 +440,8 @@ Subroutine SaltLibInitialization() ! --------------------------------------------- End Subroutine SaltLibInitialization + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- Function SpeciesIndex(SpeciesName) ! ============================================== ! This function is to look for the species index @@ -439,7 +450,7 @@ Function SpeciesIndex(SpeciesName) Character(Len=16) :: SpeciesName SpeciesIndex = -1 ! return -1 if species is not found - + Do i = 1, HowManyMolecules If (trim(SpeciesName) == trim(GasList(i)%CmpdName)) Then SpeciesIndex = i @@ -448,13 +459,15 @@ Function SpeciesIndex(SpeciesName) End Do End Function SpeciesIndex - Function Flux_kg_m2_s(SpeciesName,Cgas_ppt,Cwater_nM,T_air_K,u10_m_s,P_atm,T_water_K,& - Salinity_PartsPerThousand,switch_bubble,ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function Flux_kg_m2_s(SpeciesName,Cgas_ppt,Cwater_nM,T_air_K,u10_m_s,P_atm,T_water_K,& + Salinity_PartsPerThousand,switch_bubble) ! =========================================================================== ! This is the main module function. Input variables: ! --------------------------------------------------------------------------- ! - SpeciesName: name of species - ! - Cgas_ppt: mixing ratio (parts per trillion) of trace gas of interest + ! - Cgas_ppt: mixing ratio (parts per trillion) of trace gas of interest ! in the gas-phase (lowest modeling layer) ! - Cwater_nM: concentration of trace gas of interest in the surface ocean ! - T_air_K: temperature in the lowest modeling layer @@ -463,52 +476,51 @@ Function Flux_kg_m2_s(SpeciesName,Cgas_ppt,Cwater_nM,T_air_K,u10_m_s,P_atm,T_wat ! - T_water_K: sea surface temperature ! - Salinity_PartsPerThousand: surface ocean salinity ! - switch_bubble: bubble-mediated transfer switch - ! All must be 1D arrays with same dimension(ncol, so CESM-compatible) ! =========================================================================== - Integer :: ncol, SpeciesID - Character(16) :: SpeciesName - Real(r8), Dimension(ncol) :: Flux_kg_m2_s - Real(r8), Dimension(ncol) :: Cgas_ppt, Cwater_nM, T_air_K, u10_m_s, P_atm, T_water_K, Salinity_PartsPerThousand - Real(r8), Dimension(ncol) :: H_gas_over_liquid_dimless, kt_m_s - Logical :: switch_bubble + Character(16),intent(in) :: SpeciesName + Real(r8),intent(in) :: Cgas_ppt, Cwater_nM, T_air_K, u10_m_s, P_atm, T_water_K, Salinity_PartsPerThousand + Logical ,intent(in) :: switch_bubble - where(Salinity_PartsPerThousand .lt. 0.0_r8) Salinity_PartsPerThousand = 33.0_r8 + Integer :: SpeciesID + Real(r8) :: H_gas_over_liquid_dimless, kt_m_s - SpeciesID = SpeciesIndex(SpeciesName) - H_gas_over_liquid_dimless = 1.0_r8/(Henry_M_atm(SpeciesID,T_water_K,Salinity_PartsPerThousand,ncol)*& + SpeciesID = SpeciesIndex(SpeciesName) + H_gas_over_liquid_dimless = 1.0_r8/(Henry_M_atm(SpeciesID,T_water_K,Salinity_PartsPerThousand)*& 0.082_r8*T_water_K) If (switch_bubble) then ! -------------------------------------------------------- ! k_water parameterization with bubble-induced enhancement ! -------------------------------------------------------- kt_m_s = (1.0_r8/k_water_m_s_bubble(SpeciesID, T_water_K, Salinity_PartsPerThousand, & - u10_m_s, Cgas_ppt, P_atm, T_air_K, ncol) & - + 1.0_r8/k_air_m_s(SpeciesID, u10_m_s, T_air_K, P_atm, ncol)& + u10_m_s, Cgas_ppt, P_atm, T_air_K) & + + 1.0_r8/k_air_m_s(SpeciesID, u10_m_s, T_air_K, P_atm)& /H_gas_over_liquid_dimless)**(-1.0_r8) else ! ------------------------------------------------ ! Original k_water parameterization, scaled to CO2 ! ------------------------------------------------ - kt_m_s = (1.0_r8/k_water_m_s(SpeciesID, T_water_K, Salinity_PartsPerThousand, u10_m_s, ncol) & - + 1.0_r8/k_air_m_s(SpeciesID, u10_m_s, T_air_K, P_atm, ncol)/H_gas_over_liquid_dimless)**(-1.0_r8) + kt_m_s = (1.0_r8/k_water_m_s(SpeciesID, T_water_K, Salinity_PartsPerThousand, u10_m_s) & + + 1.0_r8/k_air_m_s(SpeciesID, u10_m_s, T_air_K, P_atm)/H_gas_over_liquid_dimless)**(-1.0_r8) endif Flux_kg_m2_s = kt_m_s * (Cwater_nM*1E-9_r8*1000.0_r8 & - Cgas_ppt*1E-12_r8*(101325.0_r8*P_atm)/8.314_r8/T_air_K/H_gas_over_liquid_dimless) & ! g/m2/s * MolecularWeight(SpeciesIndex(SpeciesName)) / 1000.0_r8 ! convert to kg/m2/s End Function Flux_kg_m2_s - - Function k_air_m_s(SpeciesIndex, u10_m_s, T_air_K, P_atm, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function k_air_m_s(SpeciesIndex, u10_m_s, T_air_K, P_atm) use shr_const_mod, only: vonKarman=>SHR_CONST_KARMAN ! ============================================================================= - ! Air-side transfer velocity. Slightly modified NOAA COARE (Fairall et al 2003; - ! Feffery et al 2010), as recommended by Johnson Ocean Sci. 2010. + ! Air-side transfer velocity. Slightly modified NOAA COARE (Fairall et al 2003; + ! Feffery et al 2010), as recommended by Johnson Ocean Sci. 2010. ! Dynamic viscosity of air: Tsilingiris 2008 ! ============================================================================= - Integer :: ncol, SpeciesIndex - Real(r8), Dimension(ncol) :: k_air_m_s - Real(r8), Dimension(ncol) :: u10_m_s, T_air_K, P_atm, ustar_m_s, DragCoeff - Real(r8), Dimension(ncol) :: DynamicViscosityAir_kg_m_s, DensityAir_kg_m3, DiffusivityInAir, SchmidtNumberInAir + Integer ,intent(in) :: SpeciesIndex + Real(r8),intent(in) :: u10_m_s, T_air_K, P_atm + + Real(r8) :: ustar_m_s, DragCoeff + Real(r8) :: DynamicViscosityAir_kg_m_s, DensityAir_kg_m3, DiffusivityInAir, SchmidtNumberInAir ! WSY: If local friction velocity is available from the model, might as well use that? ustar_m_s = u10_m_s * sqrt(6.1E-4_r8 + 6.3E-5_r8 * u10_m_s) @@ -516,53 +528,53 @@ Function k_air_m_s(SpeciesIndex, u10_m_s, T_air_K, P_atm, ncol) DynamicViscosityAir_kg_m_s = 1.715747771E-5_r8 + 4.722402075E-8_r8 * (T_air_K-273.15_r8) & - 3.663027156E-10_r8 * ((T_air_K-273.15_r8)**2.0_r8) & + 1.873236686E-12_r8 * ((T_air_K-273.15_r8)**3.0_r8) & - - 8.050218737E-14_r8 * ((T_air_K-273.15_r8)**4.0_r8) + - 8.050218737E-14_r8 * ((T_air_K-273.15_r8)**4.0_r8) DensityAir_kg_m3 = 1.293393662_r8 - 5.538444326e-3_r8 * (T_air_K-273.15_r8) & + 3.860201577e-5_r8 * (T_air_K-273.15_r8)**2.0_r8 & - 5.2536065e-7_r8 * (T_air_K-273.15_r8)**3.0_r8 - DiffusivityInAir = DiffusivityInAir_cm2_s(SpeciesIndex, T_air_K, P_atm, ncol) - SchmidtNumberInAir = DynamicViscosityAir_kg_m_s / DensityAir_kg_m3 / (DiffusivityInAir/10000.0_r8) + DiffusivityInAir = DiffusivityInAir_cm2_s(SpeciesIndex, T_air_K, P_atm) + SchmidtNumberInAir = DynamicViscosityAir_kg_m_s / DensityAir_kg_m3 / (DiffusivityInAir/10000.0_r8) k_air_m_s = 1E-3_r8 + ustar_m_s / (13.3_r8*(SchmidtNumberInAir**0.5_r8)+(DragCoeff**(-0.5_r8))-& 5.0_r8+log(SchmidtNumberInAir)/2.0_r8/vonKarman) End Function k_air_m_s - - - - Function k_water_m_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, u10_m_s, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function k_water_m_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, u10_m_s) ! ================================================================================ ! Water-side transfer velocity. Ref: Nightingale et al (2000). Salinity considered ! ================================================================================ - Integer :: ncol, SpeciesIndex - Real(r8), Dimension(ncol) :: k_water_m_s - Real(r8), Dimension(ncol) :: T_water_K, Salinity_PartsPerThousand, u10_m_s - Real(r8), Dimension(ncol) :: DiffusivityInWater, SchmidtNumberInWater - Real(r8) :: SchmidtNumberInWater_CO2ref + Integer ,intent(in) :: SpeciesIndex + Real(r8),intent(in) :: T_water_K, Salinity_PartsPerThousand, u10_m_s + + Real(r8) :: DiffusivityInWater, SchmidtNumberInWater + Real(r8) :: SchmidtNumberInWater_CO2ref + SchmidtNumberInWater_CO2ref = 660.0_r8 ! this is the Schmidt number of CO2 at 20 degC in fresh water - DiffusivityInWater = DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, ncol) - SchmidtNumberInWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand, ncol) / 1000.0_r8 & - / DensityWater_kg_m3(T_water_K,Salinity_PartsPerThousand,ncol)/(DiffusivityInWater/10000.0_r8) + DiffusivityInWater = DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand) + SchmidtNumberInWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand) / 1000.0_r8 & + / DensityWater_kg_m3(T_water_K,Salinity_PartsPerThousand)/(DiffusivityInWater/10000.0_r8) k_water_m_s = ((0.222_r8*(u10_m_s**2.0_r8)+0.333_r8*u10_m_s)*& ((SchmidtNumberInWater/SchmidtNumberInWater_CO2ref)**(-0.5_r8)))/360000.0_r8 End Function k_water_m_s - - - - Function k_water_m_s_bubble(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, u10_m_s, Cgas_ppt, P_atm, T_air_K, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function k_water_m_s_bubble(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, u10_m_s, Cgas_ppt, P_atm, T_air_K) ! ============================================================== ! Water-side transfer velocity. Ref: Asher and Wanninkhof (1998). ! ============================================================== - Integer :: ncol, SpeciesIndex - Real(r8), Dimension(ncol) :: k_water_m_s_bubble - Real(r8), Dimension(ncol) :: T_water_K, Salinity_PartsPerThousand, u10_m_s, Cgas_ppt, P_atm, T_air_K - Real(r8), Dimension(ncol) :: DiffusivityInWater, SchmidtNumberInWater - Real(r8), Dimension(ncol) :: FracCoverage_WhiteCaps, OstwaldSolubilityCoefficient - DiffusivityInWater = DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, ncol) - SchmidtNumberInWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand, ncol) / 1000.0_r8 & - / DensityWater_kg_m3(T_water_K,Salinity_PartsPerThousand,ncol)/(DiffusivityInWater/10000.0_r8) - FracCoverage_WhiteCaps = 2.56e-6_r8 * (u10_m_s - 1.77_r8)**3.0_r8 - OstwaldSolubilityCoefficient = Henry_M_atm(SpeciesIndex,T_water_K,Salinity_PartsPerThousand,ncol) ! just Henry's law (M/atm) + Integer, intent(in) :: SpeciesIndex + Real(r8),intent(in) :: T_water_K, Salinity_PartsPerThousand, u10_m_s, Cgas_ppt, P_atm, T_air_K + + Real(r8) :: DiffusivityInWater, SchmidtNumberInWater + Real(r8) :: FracCoverage_WhiteCaps, OstwaldSolubilityCoefficient + + DiffusivityInWater = DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand) + SchmidtNumberInWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand) / 1000.0_r8 & + / DensityWater_kg_m3(T_water_K,Salinity_PartsPerThousand)/(DiffusivityInWater/10000.0_r8) + FracCoverage_WhiteCaps = 2.56e-6_r8 * (u10_m_s - 1.77_r8)**3.0_r8 + OstwaldSolubilityCoefficient = Henry_M_atm(SpeciesIndex,T_water_K,Salinity_PartsPerThousand) ! just Henry's law (M/atm) OstwaldSolubilityCoefficient = OstwaldSolubilityCoefficient * (Cgas_ppt*1.0E-12_r8*P_atm) ! mol / L OstwaldSolubilityCoefficient = OstwaldSolubilityCoefficient * 0.082_r8 * T_air_K / P_atm ! L / L k_water_m_s_bubble = ((47.0_r8*u10_m_s + FracCoverage_WhiteCaps*(115200.0_r8 - 47.0_r8* u10_m_s)) & @@ -570,40 +582,46 @@ Function k_water_m_s_bubble(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, + FracCoverage_WhiteCaps * (-37.0_r8/OstwaldSolubilityCoefficient & + 6120.0_r8*(OstwaldSolubilityCoefficient**(-0.37_r8)) *(SchmidtNumberInWater**(-0.18_r8)))) & * 2.8e-6_r8 - End Function k_water_m_s_bubble - - + End Function k_water_m_s_bubble - Function DiffusivityInAir_cm2_s(SpeciesIndex, T_air_K, P_atm, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function DiffusivityInAir_cm2_s(SpeciesIndex, T_air_K, P_atm) ! ============================ ! Ref: Johnson Ocean Sci. 2010 ! ============================ - Integer :: ncol, SpeciesIndex - Real(r8), Dimension(ncol) :: DiffusivityInAir_cm2_s, T_air_K, P_atm + Integer ,intent(in) :: SpeciesIndex + Real(r8),intent(in) :: T_air_K, P_atm + Real(r8), parameter :: MW_air = 28.97_r8 ! molecular weight for air Real(r8), parameter :: Va = 20.1_r8 ! molar volume for air Real(r8) :: Vb, MW_species + Vb = LiquidMolarVolume_cm3_mol(SpeciesIndex) MW_species = MolecularWeight(SpeciesIndex) DiffusivityInAir_cm2_s = 0.001_r8 * (T_air_K**1.75_r8) & ! oh f* me * (((MW_air + MW_species)/(MW_air*MW_species))**0.5_r8) & / ((P_atm*(Va**(1.0_r8/3.0_r8)+Vb**(1.0_r8/3.0_r8)))**2.0_r8) - End Function DiffusivityInAir_cm2_s - + End Function DiffusivityInAir_cm2_s - Function DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand) ! ================================================= ! Ref: Johnson Ocean Sci. 2010. Salinity considered ! ================================================= - Integer :: ncol, SpeciesIndex - Real(r8), Dimension(ncol) :: DiffusivityInWater_cm2_s, DynamicViscosityWater, T_water_K, Salinity_PartsPerThousand + Integer, intent(in) :: SpeciesIndex + Real(r8),intent(in) :: T_water_K, Salinity_PartsPerThousand + Real(r8), parameter :: AssociationFactor = 2.6_r8 ! ... for water - Real(r8) :: Vb, MW_species + Real(r8) :: DynamicViscosityWater, Vb, MW_species + Vb = LiquidMolarVolume_cm3_mol(SpeciesIndex) MW_species = MolecularWeight(SpeciesIndex) - DynamicViscosityWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand, ncol) + + DynamicViscosityWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand) ! ------------------------------------------------- ! Wilke and Chang 1955: this seems to be a bit high ! ------------------------------------------------- @@ -617,47 +635,51 @@ Function DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThou End Function DiffusivityInWater_cm2_s - - Function DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand) ! ================================================= ! Ref: Johnson Ocean Sci. 2010. Salinity considered ! ================================================= - Integer :: ncol - Real(r8), Dimension(ncol) :: DynamicViscosityWater_g_m_s, T_water_K, Salinity_PartsPerThousand - Real(r8), Dimension(ncol) :: MassFrac_water, DynamicViscosityPureWater_g_m_s, SaltViscosity, sum_w_ln_SaltViscosity - Integer :: j, n + Real(r8),intent(in) :: T_water_K, Salinity_PartsPerThousand + + Real(r8) :: MassFrac_water, DynamicViscosityPureWater_g_m_s, SaltViscosity, sum_w_ln_SaltViscosity + Integer :: n + sum_w_ln_SaltViscosity = 0.0_r8 MassFrac_water = 1.0_r8 - Salinity_PartsPerThousand / 1000.0_r8 DynamicViscosityPureWater_g_m_s = ((T_water_K-273.15_r8)+246.0_r8) & - / (0.05594_r8*(T_water_K-273.15_r8)**2.0_r8+5.2842_r8*(T_water_K-273.15_r8)+137.37_r8) - Do j = 1, ncol - If (Salinity_PartsPerThousand(j) == 0.0_r8) Then ! pure water - DynamicViscosityWater_g_m_s(j) = DynamicViscosityPureWater_g_m_s(j) + / (0.05594_r8*(T_water_K-273.15_r8)**2.0_r8+5.2842_r8*(T_water_K-273.15_r8)+137.37_r8) + + If (Salinity_PartsPerThousand == 0.0_r8) Then ! pure water + DynamicViscosityWater_g_m_s = DynamicViscosityPureWater_g_m_s Else ! salty water Do n = 1, HowManySalts - SaltViscosity(j) = exp((SaltList(n)%SaltProperties(2) * & - (Salinity_PartsPerThousand(j)/1000.0_r8)**SaltList(n)%SaltProperties(3) & + SaltViscosity = exp((SaltList(n)%SaltProperties(2) * & + (Salinity_PartsPerThousand/1000.0_r8)**SaltList(n)%SaltProperties(3) & + SaltList(n)%SaltProperties(4)) & - / (SaltList(n)%SaltProperties(5)*(T_water_K(j)-273.15_r8) + 1.0_r8)) & - / (SaltList(n)%SaltProperties(6) * (Salinity_PartsPerThousand(j) / & + / (SaltList(n)%SaltProperties(5)*(T_water_K-273.15_r8) + 1.0_r8)) & + / (SaltList(n)%SaltProperties(6) * (Salinity_PartsPerThousand / & 1000.0_r8)**SaltList(n)%SaltProperties(7) + 1.0_r8) - sum_w_ln_SaltViscosity(j) = sum_w_ln_SaltViscosity(j) + (Salinity_PartsPerThousand(j)/1000.0_r8) & - * SaltList(n)%SaltProperties(1) * log(SaltViscosity(j)) + sum_w_ln_SaltViscosity = sum_w_ln_SaltViscosity + (Salinity_PartsPerThousand/1000.0_r8) & + * SaltList(n)%SaltProperties(1) * log(SaltViscosity) End Do - DynamicViscosityWater_g_m_s(j) = exp(MassFrac_water(j) & - * log(DynamicViscosityPureWater_g_m_s(j)) + sum_w_ln_SaltViscosity(j)) + DynamicViscosityWater_g_m_s = exp(MassFrac_water & + * log(DynamicViscosityPureWater_g_m_s) + sum_w_ln_SaltViscosity) Endif - End Do - End Function DynamicViscosityWater_g_m_s + End Function DynamicViscosityWater_g_m_s - Function DensityWater_kg_m3(T_water_K, Salinity_PartsPerThousand, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function DensityWater_kg_m3(T_water_K, Salinity_PartsPerThousand) ! ==================================================== ! Ref: Millero and Poisson (1981). Salinity considered ! ==================================================== - Integer :: ncol - Real(r8), Dimension(ncol) :: DensityWater_kg_m3, T_water_K, Salinity_PartsPerThousand - Real(r8), Dimension(ncol) :: DensityPureWater_kg_m3, FactorA, FactorB, FactorC + Real(r8), intent(in) :: T_water_K, Salinity_PartsPerThousand + + Real(r8) :: DensityPureWater_kg_m3, FactorA, FactorB, FactorC + DensityPureWater_kg_m3 = 999.842594_r8 + 0.06793952_r8*(T_water_K-273.15_r8) & - 0.00909529_r8*((T_water_K-273.15_r8)**2.0_r8) & + 0.0001001685_r8*((T_water_K-273.15_r8)**3.0_r8) & @@ -669,41 +691,46 @@ Function DensityWater_kg_m3(T_water_K, Salinity_PartsPerThousand, ncol) FactorC = 0.00048314_r8 DensityWater_kg_m3 = DensityPureWater_kg_m3 + FactorA*Salinity_PartsPerThousand & + FactorB*(Salinity_PartsPerThousand**(2.0_r8/3.0_r8)) + FactorC*Salinity_PartsPerThousand - End Function DensityWater_kg_m3 + End Function DensityWater_kg_m3 - Function Henry_M_atm(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function Henry_M_atm(SpeciesIndex, T_water_K, Salinity_PartsPerThousand) ! ========================================================================================= ! Ref: Sander compilation 2015. Salt-in or salt-out estimated based on Setschenow constants ! ========================================================================================= - Integer :: ncol, j - Integer :: SpeciesIndex - Real(r8), Dimension(ncol) :: Henry_M_atm, T_water_K, Salinity_PartsPerThousand - Real(r8), Dimension(ncol) :: Heff_M_atm_PureWater, Setschenow, Heff_M_atm_SaltyWater + Integer, intent(in) :: SpeciesIndex + Real(r8), intent(in) :: T_water_K, Salinity_PartsPerThousand + + Real(r8) :: Heff_M_atm_PureWater, Setschenow, Heff_M_atm_SaltyWater + Heff_M_atm_PureWater = GasList(SpeciesIndex)%CmpdProperties(15) * & exp(GasList(SpeciesIndex)%CmpdProperties(16) * (1.0_r8/T_water_K - 1.0_r8/298.0_r8)) - Do j = 1, ncol - If (Salinity_PartsPerThousand(j)==0.0_r8) Then - Henry_M_atm(j) = Heff_M_atm_PureWater(j) - Else - Setschenow(j) = log(LiquidMolarVolume_cm3_mol(SpeciesIndex)) * & - (7.33532E-4_r8 + 3.39615E-5_r8 * log(Heff_M_atm_PureWater(j)) & - - 2.40888E-6_r8 * ((log(Heff_M_atm_PureWater(j)))**2.0_r8) & - + 1.57114E-7_r8 * ((log(Heff_M_atm_PureWater(j)))**3.0_r8)) - Heff_M_atm_SaltyWater(j) = Heff_M_atm_PureWater(j) * 10.0_r8**(Setschenow(j)*Salinity_PartsPerThousand(j)) - Henry_M_atm(j) = Heff_M_atm_SaltyWater(j) - Endif - End Do - End Function Henry_M_atm + If (Salinity_PartsPerThousand==0.0_r8) Then + Henry_M_atm = Heff_M_atm_PureWater + Else + Setschenow = log(LiquidMolarVolume_cm3_mol(SpeciesIndex)) * & + (7.33532E-4_r8 + 3.39615E-5_r8 * log(Heff_M_atm_PureWater) & + - 2.40888E-6_r8 * ((log(Heff_M_atm_PureWater))**2.0_r8) & + + 1.57114E-7_r8 * ((log(Heff_M_atm_PureWater))**3.0_r8)) + Heff_M_atm_SaltyWater = Heff_M_atm_PureWater * 10.0_r8**(Setschenow*Salinity_PartsPerThousand) + Henry_M_atm = Heff_M_atm_SaltyWater + Endif + + End Function Henry_M_atm + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- Function MolecularWeight(SpeciesIndex) Real(r8) :: MolecularWeight Integer :: SpeciesIndex MolecularWeight = GasList(SpeciesIndex)%CmpdProperties(1) End Function MolecularWeight - + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- Function LiquidMolarVolume_cm3_mol(SpeciesIndex) ! =========================================================================== ! If no measurements available, i.e. GasList(SpeciesIndex)%CmpdProperties(14) @@ -712,7 +739,7 @@ Function LiquidMolarVolume_cm3_mol(SpeciesIndex) Real(r8) :: LiquidMolarVolume_cm3_mol Integer :: SpeciesIndex - If (GasList(SpeciesIndex)%CmpdProperties(14)/=0.0_r8) Then + If (GasList(SpeciesIndex)%CmpdProperties(14)/=0.0_r8) Then LiquidMolarVolume_cm3_mol = GasList(SpeciesIndex)%CmpdProperties(14) Else LiquidMolarVolume_cm3_mol = 7.0_r8*GasList(SpeciesIndex)%CmpdProperties(2) ! C @@ -731,18 +758,21 @@ Function LiquidMolarVolume_cm3_mol(SpeciesIndex) End Function LiquidMolarVolume_cm3_mol + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- subroutine cseawater_ini() - use mo_chem_utls, only : get_spc_ndx - use tracer_data, only : trcdata_init - use cam_pio_utils, only : cam_pio_openfile + use mo_chem_utls, only : get_spc_ndx + use tracer_data, only : trcdata_init + use cam_pio_utils, only : cam_pio_openfile use pio, only : pio_inquire, pio_nowrite, pio_closefile, pio_inq_varndims use pio, only : pio_inq_varname, file_desc_t, pio_get_att, PIO_NOERR, PIO_GLOBAL - use pio, only : pio_seterrorhandling, PIO_BCAST_ERROR - use string_utils, only : GLC + use pio, only : pio_seterrorhandling, PIO_BCAST_ERROR + use string_utils, only : GLC + use phys_control, only : phys_getopts integer :: i, j, l, m, n, nn, astat, vid, ierr, nvars, isec - integer :: indx(gas_pcnst) + integer :: indx(gas_pcnst) type(file_desc_t) :: ncid character(len=16) :: csw_species(gas_pcnst) character(len=256) :: csw_filenam(gas_pcnst) @@ -766,7 +796,10 @@ subroutine cseawater_ini() character(len=*), parameter :: subname = 'cseawater_ini' - ! ======================================================== + logical :: history_chemistry + call phys_getopts(history_chemistry_out=history_chemistry) + + ! ======================================================== ! Read sea water concentration specifier from the namelist ! ======================================================== @@ -827,7 +860,7 @@ subroutine cseawater_ini() ! ------------------------------------------- ! Setup the seawater concentration type array ! ------------------------------------------- - do m=1,n_Csw_files + do m=1,n_Csw_files Csw_nM(m)%spc_ndx = csw_indexes(indx(m)) Csw_nM(m)%units = 'nM' Csw_nM(m)%species = csw_species(indx(m)) @@ -898,9 +931,9 @@ subroutine cseawater_ini() deallocate(vndims) ! Global attribute 'input_method' overrides the srf_emis_type namelist setting on - ! a file-by-file basis. If the emis file does not contain the 'input_method' + ! a file-by-file basis. If the emis file does not contain the 'input_method' ! attribute then the srf_emis_type namelist setting is used. - ierr = pio_get_att(ncid, PIO_GLOBAL, 'input_method', file_interp_type) + ierr = pio_get_att(ncid, PIO_GLOBAL, 'input_method', file_interp_type) if ( ierr == PIO_NOERR) then l = GLC(file_interp_type) csw_time_type(1:l) = file_interp_type(1:l) @@ -928,9 +961,30 @@ subroutine cseawater_ini() 'ocean flux ' // trim(Csw_nM(m)%species) ) call addfld('Csw_' // trim(Csw_nM(m)%species), horiz_only, 'A', 'nanomole per liter (nM)', & 'seeawater concentration ' // trim(Csw_nM(m)%species) ) + if (history_chemistry) then + call add_default('OCN_FLUX_' // trim(Csw_nM(m)%species), 1, ' ') + end if end do end subroutine cseawater_ini + !-------------------------------------------------------------------------------- + ! returns TRUE if species has ocean emissions + !-------------------------------------------------------------------------------- + pure logical function ocean_emis_species(name) + character(len=*), intent(in) :: name + + integer :: m + + ocean_emis_species = .false. + + spc_loop: do m = 1, n_Csw_files + if (trim(name) == trim(Csw_nM(m)%species)) then + ocean_emis_species = .true. + exit spc_loop + end if + end do spc_loop + + end function ocean_emis_species end module ocean_emis diff --git a/src/chemistry/mozart/rate_diags.F90 b/src/chemistry/mozart/rate_diags.F90 index f3cc490044..ebeef3a0c3 100644 --- a/src/chemistry/mozart/rate_diags.F90 +++ b/src/chemistry/mozart/rate_diags.F90 @@ -11,20 +11,21 @@ module rate_diags use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map use ppgrid, only : pver use spmd_utils, only : masterproc + use cam_logfile, only : iulog use cam_abortutils, only : endrun - use sums_utils, only : sums_grp_t, parse_sums + use shr_expr_parser_mod , only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy implicit none - private + private public :: rate_diags_init public :: rate_diags_calc public :: rate_diags_readnl public :: rate_diags_o3s_loss + public :: rate_diags_final character(len=fieldname_len) :: rate_names(rxt_tag_cnt) - integer :: ngrps = 0 - type(sums_grp_t), allocatable :: grps(:) + type(shr_exp_item_t), pointer :: grps_list => null() integer, parameter :: maxlines = 200 character(len=CL), allocatable :: rxn_rate_sums(:) @@ -41,7 +42,7 @@ subroutine rate_diags_readnl(nlfile) use units, only: getunit, freeunit use spmd_utils, only: mpicom, mpi_character, masterprocid - ! args + ! args character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input ! Local variables @@ -77,9 +78,10 @@ subroutine rate_diags_init use phys_control, only : phys_getopts use mo_chem_utls, only : get_spc_ndx - integer :: i, len, pos + integer :: i,j, len, pos character(len=64) :: name logical :: history_scwaccm_forcing + type(shr_exp_item_t), pointer :: grp call phys_getopts( history_scwaccm_forcing_out = history_scwaccm_forcing ) @@ -103,11 +105,26 @@ subroutine rate_diags_init enddo ! parse the terms of the summations - call parse_sums(rxn_rate_sums, ngrps, grps) + grps_list => shr_exp_parse( rxn_rate_sums ) deallocate( rxn_rate_sums ) - do i = 1, ngrps - call addfld( grps(i)%name, (/ 'lev' /),'A', 'molecules/cm3/sec','reaction rate group') + if (masterproc) write(iulog,*) 'rate_diags_init :' + + grp => grps_list + do while(associated(grp)) + + if (masterproc) then + write(iulog,*) ' grp name : ',trim(grp%name) + + do j = 1, grp%n_terms + write(iulog,'(f12.4,a,a)') grp%coeffs(j),' * ',trim(grp%vars(j)) + end do + end if + + call addfld( grp%name, (/ 'lev' /),'A', 'molecules/cm3/sec','reaction rate group') + + grp => grp%next_item + enddo o3_ndx = get_spc_ndx('O3') @@ -127,10 +144,11 @@ subroutine rate_diags_calc( rxt_rates, vmr, m, ncol, lchnk ) integer :: i, j, ndx real(r8) :: group_rate(ncol,pver) + type(shr_exp_item_t), pointer :: grp call set_rates( rxt_rates, vmr, ncol ) - ! output individual tagged rates + ! output individual tagged rates do i = 1, rxt_tag_cnt ! convert from vmr/sec to molecules/cm3/sec rxt_rates(:ncol,:,rxt_tag_map(i)) = rxt_rates(:ncol,:,rxt_tag_map(i)) * m(:ncol,:) @@ -138,13 +156,19 @@ subroutine rate_diags_calc( rxt_rates, vmr, m, ncol, lchnk ) enddo ! output rate groups ( or families ) - do i = 1, ngrps + + grp => grps_list + do while(associated(grp)) + group_rate(:,:) = 0._r8 - do j = 1, grps(i)%nmembers - ndx = lookup_tag_ndx(grps(i)%term(j)) - group_rate(:ncol,:) = group_rate(:ncol,:) + grps(i)%multipler(j)*rxt_rates(:ncol,:,ndx) - enddo - call outfld( grps(i)%name, group_rate(:ncol,:), ncol, lchnk ) + do j = 1, grp%n_terms + ndx = lookup_tag_ndx(grp%vars(j)) + group_rate(:ncol,:) = group_rate(:ncol,:) + grp%coeffs(j)*rxt_rates(:ncol,:,ndx) + enddo + call outfld( grp%name, group_rate(:ncol,:), ncol, lchnk ) + + grp => grp%next_item + end do end subroutine rate_diags_calc @@ -161,9 +185,10 @@ function rate_diags_o3s_loss( rxt_rates, vmr, ncol ) result(o3s_loss) real(r8) :: o3s_loss(ncol,pver) ! /sec - integer :: i, j, ndx + integer :: j, ndx real(r8) :: group_rate(ncol,pver) real(r8) :: lcl_rxt_rates(ncol,pver,rxntot) + type(shr_exp_item_t), pointer :: grp o3s_loss(:,:) = 0._r8 @@ -171,20 +196,33 @@ function rate_diags_o3s_loss( rxt_rates, vmr, ncol ) result(o3s_loss) lcl_rxt_rates(:ncol,:,:) = rxt_rates(:ncol,:,:) call set_rates( lcl_rxt_rates, vmr, ncol ) - do i = 1, ngrps - if (trim(grps(i)%name)=='O3S_Loss') then + grp => grps_list + loop: do while(associated(grp)) + + if (trim(grp%name)=='O3S_Loss') then group_rate(:,:) = 0._r8 - do j = 1, grps(i)%nmembers - ndx = lookup_tag_ndx(grps(i)%term(j)) - group_rate(:ncol,:) = group_rate(:ncol,:) + grps(i)%multipler(j)*lcl_rxt_rates(:ncol,:,ndx) + do j = 1, grp%n_terms + ndx = lookup_tag_ndx(grp%vars(j)) + group_rate(:ncol,:) = group_rate(:ncol,:) + grp%coeffs(j)*lcl_rxt_rates(:ncol,:,ndx) enddo o3s_loss(:ncol,:) = group_rate(:ncol,:)/vmr(:ncol,:,o3_ndx) + exit loop endif - end do + grp => grp%next_item + + end do loop endif end function rate_diags_o3s_loss +!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- + subroutine rate_diags_final + + if (associated(grps_list)) call shr_exp_list_destroy(grps_list) + + end subroutine rate_diags_final + !------------------------------------------------------------------- ! Private routines : !------------------------------------------------------------------- @@ -211,7 +249,7 @@ function lookup_tag_ndx( name ) result( ndx ) if (ndx<0) then call endrun('rate_diags: not able to find rxn tag name: '//trim(name)) endif - + end function lookup_tag_ndx end module rate_diags diff --git a/src/chemistry/mozart/short_lived_species.F90 b/src/chemistry/mozart/short_lived_species.F90 index 16fa03da9b..37a43d90bb 100644 --- a/src/chemistry/mozart/short_lived_species.F90 +++ b/src/chemistry/mozart/short_lived_species.F90 @@ -11,7 +11,6 @@ module short_lived_species use cam_logfile, only : iulog use ppgrid, only : pcols, pver, begchunk, endchunk use spmd_utils, only : masterproc - implicit none @@ -23,28 +22,36 @@ module short_lived_species public :: short_lived_species_writeic public :: initialize_short_lived_species public :: set_short_lived_species + public :: set_short_lived_species_gc ! for GEOS-Chem chemistry public :: get_short_lived_species + public :: get_short_lived_species_gc ! for GEOS-Chem chemistry public :: slvd_index public :: pbf_idx + public :: short_lived_species_final integer :: pbf_idx integer :: map(nslvd) - character(len=16), parameter :: pbufname = 'ShortLivedSpecies' + character(len=*), parameter :: pbufname = 'ShortLivedSpecies' + + real(r8), allocatable :: slvd_ref_mmr(:) contains !--------------------------------------------------------------------- !--------------------------------------------------------------------- - subroutine register_short_lived_species + subroutine register_short_lived_species (ref_mmr) use physics_buffer, only : pbuf_add_field, dtype_r8 - implicit none - - integer :: m + real(r8), optional :: ref_mmr(nslvd) if ( nslvd < 1 ) return + if ( present(ref_mmr) ) then + allocate(slvd_ref_mmr(nslvd)) + slvd_ref_mmr = ref_mmr + endif + call pbuf_add_field(pbufname,'global',dtype_r8,(/pcols,pver,nslvd/),pbf_idx) end subroutine register_short_lived_species @@ -52,7 +59,7 @@ end subroutine register_short_lived_species !--------------------------------------------------------------------- !--------------------------------------------------------------------- subroutine short_lived_species_initic -#ifdef WACCMX_IONOS +#ifdef WACCMX_PHYS use cam_history, only : addfld, add_default integer :: m @@ -74,11 +81,11 @@ subroutine short_lived_species_writeic( lchnk, pbuf ) integer , intent(in) :: lchnk ! chunk identifier type(physics_buffer_desc), pointer :: pbuf(:) -#ifdef WACCMX_IONOS +#ifdef WACCMX_PHYS real(r8),pointer :: tmpptr(:,:) integer :: m character(len=24) :: varname - + if ( write_inithist() ) then do m=1,nslvd varname = trim(slvd_lst(m))//'&IC' @@ -98,20 +105,20 @@ subroutine initialize_short_lived_species(ncid_ini, pbuf2d) use mo_tracname, only : solsym use ncdio_atm, only : infld use pio, only : file_desc_t - use physics_buffer, only : physics_buffer_desc, pbuf_set_field, pbuf_get_chunk, pbuf_get_field + use phys_control, only : cam_chempkg_is + use physics_buffer, only : physics_buffer_desc, pbuf_set_field implicit none type(file_desc_t), intent(inout) :: ncid_ini type(physics_buffer_desc), pointer :: pbuf2d(:,:) - integer :: m,n,lchnk + integer :: m,n integer :: grid_id character(len=8) :: fieldname character(len=4) :: dim1name, dim2name logical :: found real(r8),pointer :: tmpptr(:,:,:) ! temporary pointer - real(r8),pointer :: tmpptr2(:,:,:) ! temporary pointer character(len=*), parameter :: subname='INITIALIZE_SHORT_LIVED_SPECIES' if ( nslvd < 1 ) return @@ -129,19 +136,31 @@ subroutine initialize_short_lived_species(ncid_ini, pbuf2d) allocate(tmpptr(pcols,pver,begchunk:endchunk)) do m=1,nslvd - n = map(m) - fieldname = solsym(n) + + if (cam_chempkg_is('geoschem_mam4')) then + fieldname = trim(slvd_lst(m)) + else + n = map(m) + fieldname = solsym(n) + end if + call infld( fieldname,ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & tmpptr, found, gridname='physgrid') if (.not.found) then - tmpptr(:,:,:) = 1.e-36_r8 + if ( allocated(slvd_ref_mmr) ) then + tmpptr(:,:,:) = slvd_ref_mmr(m) + else + tmpptr(:,:,:) = 1.e-36_r8 + endif endif call pbuf_set_field(pbuf2d, pbf_idx, tmpptr, start=(/1,1,m/),kount=(/pcols,pver,1/)) - + if (masterproc) write(iulog,*) fieldname, ' is set to short-lived' - + + if ( allocated(slvd_ref_mmr) .and. masterproc) write(iulog,'(a, E16.5E4)') ' --> reference MMR: ', slvd_ref_mmr(m) + enddo deallocate(tmpptr) @@ -154,7 +173,7 @@ subroutine set_short_lived_species( q, lchnk, ncol, pbuf ) use physics_buffer, only : physics_buffer_desc, pbuf_set_field - implicit none + implicit none real(r8), intent(in) :: q(pcols,pver,gas_pcnst) integer, intent(in) :: lchnk, ncol @@ -171,12 +190,35 @@ subroutine set_short_lived_species( q, lchnk, ncol, pbuf ) end subroutine set_short_lived_species +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine set_short_lived_species_gc( q, lchnk, ncol, pbuf ) + + use physics_buffer, only : physics_buffer_desc, pbuf_set_field + + implicit none + + ! 3rd dimension of out array is nslvd if using GEOS-Chem chemistry + real(r8), intent(in) :: q(pcols,pver,nslvd) + integer, intent(in) :: lchnk, ncol + type(physics_buffer_desc), pointer :: pbuf(:) + + integer :: m + + if ( nslvd < 1 ) return + + do m=1,nslvd + call pbuf_set_field(pbuf, pbf_idx, q(:,:,m), start=(/1,1,m/),kount=(/pcols,pver,1/)) + enddo + + end subroutine set_short_lived_species_gc + !--------------------------------------------------------------------- !--------------------------------------------------------------------- subroutine get_short_lived_species( q, lchnk, ncol, pbuf ) use physics_buffer, only : physics_buffer_desc, pbuf_get_field - implicit none + implicit none real(r8), intent(inout) :: q(pcols,pver,gas_pcnst) integer, intent(in) :: lchnk, ncol @@ -184,7 +226,7 @@ subroutine get_short_lived_species( q, lchnk, ncol, pbuf ) real(r8),pointer :: tmpptr(:,:) - integer :: m,n + integer :: m,n if ( nslvd < 1 ) return @@ -196,6 +238,31 @@ subroutine get_short_lived_species( q, lchnk, ncol, pbuf ) endsubroutine get_short_lived_species +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine get_short_lived_species_gc( q, lchnk, ncol, pbuf ) + use physics_buffer, only : physics_buffer_desc, pbuf_get_field + + implicit none + + ! 3rd dimension of out array is nslvd if using GEOS-Chem chemistry + real(r8), intent(inout) :: q(pcols,pver,nslvd) + integer, intent(in) :: lchnk, ncol + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8),pointer :: tmpptr(:,:) + + + integer :: m + + if ( nslvd < 1 ) return + + do m=1,nslvd + call pbuf_get_field(pbuf, pbf_idx, tmpptr, start=(/1,1,m/), kount=(/ pcols,pver,1 /)) + q(:ncol,:,m) = tmpptr(:ncol,:) + enddo + + endsubroutine get_short_lived_species_gc + !--------------------------------------------------------------------- !--------------------------------------------------------------------- function slvd_index( name ) @@ -213,10 +280,18 @@ function slvd_index( name ) do m=1,nslvd if ( name == slvd_lst(m) ) then slvd_index = m - return + return endif enddo endfunction slvd_index +!--------------------------------------------------------------------- +!--------------------------------------------------------------------- + subroutine short_lived_species_final + + if ( allocated(slvd_ref_mmr) ) deallocate(slvd_ref_mmr) + + end subroutine short_lived_species_final + end module short_lived_species diff --git a/src/chemistry/mozart/species_sums_diags.F90 b/src/chemistry/mozart/species_sums_diags.F90 index 20431e952c..b5bb75fb39 100644 --- a/src/chemistry/mozart/species_sums_diags.F90 +++ b/src/chemistry/mozart/species_sums_diags.F90 @@ -10,19 +10,19 @@ module species_sums_diags use ppgrid, only : pver use spmd_utils, only : masterproc use cam_abortutils, only : endrun + use cam_logfile, only : iulog use mo_chem_utls, only : get_spc_ndx - use sums_utils, only : sums_grp_t, parse_sums + use shr_expr_parser_mod , only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy implicit none - private + private public :: species_sums_init public :: species_sums_output public :: species_sums_readnl + public :: species_sums_final - integer :: n_vmr_grps = 0 - type(sums_grp_t), allocatable :: vmr_grps(:) - integer :: n_mmr_grps = 0 - type(sums_grp_t), allocatable :: mmr_grps(:) + type(shr_exp_item_t), pointer :: vmr_grps => null() + type(shr_exp_item_t), pointer :: mmr_grps => null() integer, parameter :: maxlines = 200 character(len=CL), allocatable :: vmr_sums(:) @@ -38,11 +38,11 @@ subroutine species_sums_readnl(nlfile) use units, only: getunit, freeunit use spmd_utils, only: mpicom, mpi_character, masterprocid - ! args + ! args character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input ! Local variables - integer :: unitn, ierr + integer :: unitn, ierr, n,i namelist /species_sums_nl/ vmr_sums, mmr_sums @@ -70,25 +70,72 @@ subroutine species_sums_readnl(nlfile) call mpi_bcast(vmr_sums,len(vmr_sums(1))*maxlines, mpi_character, masterprocid, mpicom, ierr) call mpi_bcast(mmr_sums,len(mmr_sums(1))*maxlines, mpi_character, masterprocid, mpicom, ierr) + if (masterproc) then + + write(iulog,*) ' ' + write(iulog,*) 'species_sums_readnl -- vmr_sums :' + n = count(len_trim(vmr_sums)>0) + do i=1,n + write(iulog,*) trim(vmr_sums(i)) + end do + + write(iulog,*) ' ' + write(iulog,*) 'species_sums_readnl -- mmr_sums :' + n = count(len_trim(mmr_sums)>0) + do i=1,n + write(iulog,*) trim(mmr_sums(i)) + end do + + end if + + end subroutine species_sums_readnl !-------------------------------------------------------------------------------- !-------------------------------------------------------------------------------- subroutine species_sums_init - integer :: i + type(shr_exp_item_t), pointer :: grp => null() + + integer :: j ! parse the terms of the summations - call parse_sums(vmr_sums, n_vmr_grps, vmr_grps) + vmr_grps => shr_exp_parse( vmr_sums ) deallocate( vmr_sums ) - call parse_sums(mmr_sums, n_mmr_grps, mmr_grps) + mmr_grps => shr_exp_parse( mmr_sums ) deallocate( mmr_sums ) ! add history fields - do i = 1, n_vmr_grps - call addfld( vmr_grps(i)%name, (/ 'lev' /),'A', 'mole/mole','summation of species volume mixing ratios') + + if (masterproc) write(iulog,*) 'species_sums_init -- VMR SUMS:' + grp => vmr_grps + do while(associated(grp)) + + if (masterproc) then + write(iulog,*) ' grp name : ',trim(grp%name) + + do j = 1, grp%n_terms + write(iulog,'(f12.4,a,a)') grp%coeffs(j),' * ',trim(grp%vars(j)) + end do + end if + + call addfld( trim(grp%name), (/ 'lev' /),'A', 'mole/mole','summation of species volume mixing ratios') + grp => grp%next_item enddo - do i = 1, n_mmr_grps - call addfld( mmr_grps(i)%name, (/ 'lev' /),'A', 'kg/kg','summation of species mass mixing ratios') + + if (masterproc) write(iulog,*) 'species_sums_init -- MMR SUMS:' + grp => mmr_grps + do while(associated(grp)) + + if (masterproc) then + write(iulog,*) ' grp name : ',trim(grp%name) + + do j = 1, grp%n_terms + write(iulog,'(f12.4,a,a)') grp%coeffs(j),' * ',trim(grp%vars(j)) + end do + end if + + call addfld( trim(grp%name), (/ 'lev' /),'A', 'kg/kg','summation of species mass mixing ratios') + grp => grp%next_item enddo end subroutine species_sums_init @@ -101,38 +148,53 @@ subroutine species_sums_output( vmr, mmr, ncol, lchnk ) real(r8), intent(in) :: mmr(:,:,:) integer, intent(in) :: ncol, lchnk - integer :: i, j, spc_ndx + integer :: j, spc_ndx real(r8) :: group_sum(ncol,pver) character(len=16) :: spc_name - + type(shr_exp_item_t), pointer :: grp + ! output species groups ( or families ) - do i = 1, n_vmr_grps + grp => vmr_grps + do while(associated(grp)) ! look up the corresponding species index ... group_sum(:,:) = 0._r8 - do j = 1, vmr_grps(i)%nmembers - spc_name = vmr_grps(i)%term(j) + do j = 1, grp%n_terms + spc_name = grp%vars(j) spc_ndx = get_spc_ndx( spc_name ) if ( spc_ndx < 1 ) then call endrun('species_sums_output species name not found : '//trim(spc_name)) endif - group_sum(:ncol,:) = group_sum(:ncol,:) + vmr_grps(i)%multipler(j)*vmr(:ncol,:,spc_ndx) + group_sum(:ncol,:) = group_sum(:ncol,:) + grp%coeffs(j)*vmr(:ncol,:,spc_ndx) enddo - call outfld( vmr_grps(i)%name, group_sum(:ncol,:), ncol, lchnk ) + call outfld( trim(grp%name), group_sum(:ncol,:), ncol, lchnk ) + grp => grp%next_item end do - do i = 1, n_mmr_grps + + grp => mmr_grps + do while(associated(grp)) ! look up the corresponding species index ... group_sum(:,:) = 0._r8 - do j = 1, mmr_grps(i)%nmembers - spc_name = mmr_grps(i)%term(j) + do j = 1, grp%n_terms + spc_name = grp%vars(j) spc_ndx = get_spc_ndx( spc_name ) if ( spc_ndx < 1 ) then call endrun('species_sums_output species name not found : '//trim(spc_name)) endif - group_sum(:ncol,:) = group_sum(:ncol,:) + mmr_grps(i)%multipler(j)*mmr(:ncol,:,spc_ndx) + group_sum(:ncol,:) = group_sum(:ncol,:) + grp%coeffs(j)*mmr(:ncol,:,spc_ndx) enddo - call outfld( mmr_grps(i)%name, group_sum(:ncol,:), ncol, lchnk ) + call outfld( trim(grp%name), group_sum(:ncol,:), ncol, lchnk ) + grp => grp%next_item end do end subroutine species_sums_output +!-------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------- + subroutine species_sums_final + + if (associated(vmr_grps)) call shr_exp_list_destroy(vmr_grps) + if (associated(mmr_grps)) call shr_exp_list_destroy(mmr_grps) + + end subroutine species_sums_final + end module species_sums_diags diff --git a/src/chemistry/mozart/sums_utils.F90 b/src/chemistry/mozart/sums_utils.F90 deleted file mode 100644 index e0dcb339e9..0000000000 --- a/src/chemistry/mozart/sums_utils.F90 +++ /dev/null @@ -1,125 +0,0 @@ -!------------------------------------------------------------------- -! shared utilities for diagnostics summations -!------------------------------------------------------------------- -module sums_utils - use shr_kind_mod, only : r8 => shr_kind_r8 - use shr_kind_mod, only : CL => SHR_KIND_CL - use shr_kind_mod, only : CXX => SHR_KIND_CXX - - implicit none - - !------------------------------------------------------------------- - ! object which holds the terms of a summation - !------------------------------------------------------------------- - type sums_grp_t - character(len=64) :: name - integer :: nmembers = 0 - character(len=64), allocatable :: term(:) - real(r8), allocatable :: multipler(:) - endtype sums_grp_t - -contains - - !------------------------------------------------------------------- - ! parses summation strings - !------------------------------------------------------------------- - subroutine parse_sums(sums, ngrps, grps) - - character(len=CL), intent(in ) :: sums(:) - integer, intent(out) :: ngrps - type(sums_grp_t), allocatable, intent(out) :: grps(:) - - integer :: ndxs(512) - integer :: nelem, i,j,k - character(len=CXX) :: tmp_str, tmp_name - - character(len=8) :: xchr ! multipler - real(r8) :: xdbl - - logical :: more_to_come - integer, parameter :: maxgrps = 100 - character(len=CXX) :: sums_grps(maxgrps) - - character(len=CXX) :: sum_string - - sums_grps(:) = ' ' - - ! combine lines that have a trailing "+" with the next line - i=1 - j=1 - do while( len_trim(sums(i)) > 0 ) - - k = scan(sums(i), '+', back=.true. ) - more_to_come = k == len_trim(sums(i)) ! line ends with "+" - - if ( more_to_come ) then - sums_grps(j) = trim(sums_grps(j)) // trim(adjustl(sums(i))) - else - sums_grps(j) = trim(sums_grps(j)) // trim(adjustl(sums(i))) - j = j+1 - endif - i = i+1 - - end do - - ngrps = j-1 - - ! a group is a summation of terms - - ! parse the individual sum strings... and form the groupings - has_grps: if (ngrps>0) then - - allocate( grps(ngrps) ) - - ! from shr_megan_mod ... should be generalized and shared... - grploop: do i = 1,ngrps - - ! parse out the term names - ! from first parsing out the terms in the summation equation ("+" separates the terms) - - sum_string = sums_grps(i) - j = scan( sum_string, '=' ) - nelem = 1 - ndxs(nelem) = j ! ndxs stores the index of each term of the equation - - ! find indices of all the terms in the equation - tmp_str = trim( sum_string(j+1:) ) - j = scan( tmp_str, '+' ) - do while(j>0) - nelem = nelem+1 - ndxs(nelem) = ndxs(nelem-1) + j - tmp_str = tmp_str(j+1:) - j = scan( tmp_str, '+' ) - enddo - ndxs(nelem+1) = len(sum_string)+1 - - grps(i)%nmembers = nelem ! number of terms - grps(i)%name = trim(adjustl( sum_string(:ndxs(1)-1))) ! thing to the left of the "=" is used as the name of the group - - ! now that we have the number of terms in the summation allocate memory for the terms - allocate(grps(i)%term(nelem)) - allocate(grps(i)%multipler(nelem)) - - ! now parse out the multiplier from the terms - elmloop: do k = 1,nelem - - grps(i)%multipler(k) = 1._r8 - ! get the term name which follows the '*' operator if the is one - tmp_name = adjustl(sum_string(ndxs(k)+1:ndxs(k+1)-1)) - j = scan( tmp_name, '*' ) - if (j>0) then - xchr = tmp_name(1:j-1) ! get the multipler (left of the '*') - read( xchr, * ) xdbl ! convert the string to a real - grps(i)%multipler(k) = xdbl ! store the multiplier - tmp_name = adjustl(tmp_name(j+1:)) ! get the term name (right of the '*') - endif - grps(i)%term(k) = trim(tmp_name) - - enddo elmloop - enddo grploop - endif has_grps - - end subroutine parse_sums - - -end module sums_utils diff --git a/src/chemistry/mozart/sv_decomp.F90 b/src/chemistry/mozart/sv_decomp.F90 deleted file mode 100644 index 0540f1f575..0000000000 --- a/src/chemistry/mozart/sv_decomp.F90 +++ /dev/null @@ -1,364 +0,0 @@ -!------------------------------------------------------------------------- -! purpose: singular value decomposition -! -! method: -! given a matrix a(1:m,1:n), with physical dimensions mp by np, -! this routine computes its singular value decomposition, -! the matrix u replaces a on output. the -! diagonal matrix of singular values w is output as a vector -! w(1:n). the matrix v (not the transpose v^t) is output as -! v(1:n,1:n). -! -! author: a. maute dec 2003 -! (* copyright (c) 1985 numerical recipes software -- svdcmp *! -! from numerical recipes 1986 pp. 60 or can be find on web-sites -!------------------------------------------------------------------------- - - module sv_decomp - - use shr_kind_mod, only : r8 => shr_kind_r8 - - implicit none - - private - public :: svdcmp - public :: svbksb - - integer, parameter :: nmax = 1600 - - contains - - subroutine svdcmp( a, m, n, mp, np, w, v ) -!------------------------------------------------------------------------- -! ... dummy arguments -!------------------------------------------------------------------------- - integer, intent(in) :: m - integer, intent(in) :: n - integer, intent(in) :: mp - integer, intent(in) :: np - real(r8), intent(inout) :: a(mp,np) - real(r8), intent(out) :: v(np,np) - real(r8), intent(out) :: w(np) - -!------------------------------------------------------------------------- -! ... local variables -!------------------------------------------------------------------------- - integer :: i, its, j, k, l, nm - real(r8) :: anorm - real(r8) :: c - real(r8) :: f - real(r8) :: g - real(r8) :: h - real(r8) :: s - real(r8) :: scale - real(r8) :: x, y, z - real(r8) :: rv1(nmax) - logical :: cnd1 - logical :: cnd2 - - g = 0.0_r8 - scale = 0.0_r8 - anorm = 0.0_r8 - -loop1 : & - do i = 1,n - l = i + 1 - rv1(i) = scale*g - g = 0.0_r8 - s = 0.0_r8 - scale = 0.0_r8 - if( i <= m ) then - do k = i,m - scale = scale + abs(a(k,i)) - end do - if( scale /= 0.0_r8 ) then - do k = i,m - a(k,i) = a(k,i)/scale - s = s + a(k,i)*a(k,i) - end do - f = a(i,i) - g = -sign(sqrt(s),f) - h = f*g - s - a(i,i) = f - g - if( i /= n ) then - do j = l,n - s = 0.0_r8 - do k = i,m - s = s + a(k,i)*a(k,j) - end do - f = s/h - do k = i,m - a(k,j) = a(k,j) + f*a(k,i) - end do - end do - end if - do k = i,m - a(k,i) = scale*a(k,i) - end do - endif - endif - w(i) = scale *g - g = 0.0_r8 - s = 0.0_r8 - scale = 0.0_r8 - if( i <= m .and. i /= n ) then - do k = l,n - scale = scale + abs(a(i,k)) - end do - if( scale /= 0.0_r8 ) then - do k = l,n - a(i,k) = a(i,k)/scale - s = s + a(i,k)*a(i,k) - end do - f = a(i,l) - g = -sign(sqrt(s),f) - h = f*g - s - a(i,l) = f - g - do k = l,n - rv1(k) = a(i,k)/h - end do - if( i /= m ) then - do j = l,m - s = 0.0_r8 - do k = l,n - s = s + a(j,k)*a(i,k) - end do - do k = l,n - a(j,k) = a(j,k) + s*rv1(k) - end do - end do - end if - do k = l,n - a(i,k) = scale*a(i,k) - end do - end if - end if - anorm = max( anorm,(abs(w(i)) + abs(rv1(i))) ) - end do loop1 - - do i = n,1,-1 - if( i < n ) then - if( g /= 0.0_r8 ) then - do j = l,n - v(j,i) = (a(i,j)/a(i,l))/g - end do - do j = l,n - s = 0.0_r8 - do k = l,n - s = s + a(i,k)*v(k,j) - end do - do k = l,n - v(k,j) = v(k,j) + s*v(k,i) - end do - end do - end if - do j = l,n - v(i,j) = 0.0_r8 - v(j,i) = 0.0_r8 - end do - end if - v(i,i) = 1.0_r8 - g = rv1(i) - l = i - end do - - do i = n,1,-1 - l = i + 1 - g = w(i) - if( i < n ) then - do j = l,n - a(i,j) = 0.0_r8 - end do - end if - if( g /= 0.0_r8 ) then - g = 1.0_r8/g - if( i /= n ) then - do j = l,n - s = 0.0_r8 - do k = l,m - s = s + a(k,i)*a(k,j) - end do - f = (s/a(i,i))*g - do k = i,m - a(k,j) = a(k,j) + f*a(k,i) - end do - end do - end if - do j = i,m - a(j,i) = a(j,i)*g - end do - else - do j = i,m - a(j,i) = 0.0_r8 - end do - end if - a(i,i) = a(i,i) + 1.0_r8 - end do - - do k = n,1,-1 -loop2 : do its = 1,30 - do l = k,1,-1 - nm = l - 1 - cnd1 = abs( rv1(l) ) + anorm == anorm - if( cnd1 ) then - cnd2 = .false. - exit - end if - cnd2 = abs( w(nm) ) + anorm == anorm - if( cnd2 ) then - cnd1 = .true. - exit - else if( l == 1 ) then - cnd1 = .true. - cnd2 = .true. - end if - end do - - if( cnd2 ) then - c = 0.0_r8 - s = 1.0_r8 - do i = l,k - f = s*rv1(i) - if( (abs(f) + anorm) /= anorm ) then - g = w(i) - h = sqrt(f*f + g*g) - w(i) = h - h = 1.0_r8/h - c = (g*h) - s = -(f*h) - do j = 1,m - y = a(j,nm) - z = a(j,i) - a(j,nm) = (y*c) + (z*s) - a(j,i) = -(y*s) + (z*c) - end do - end if - end do - end if - - if( cnd1 ) then - z = w(k) - if( l == k ) then - if( z < 0.0_r8 ) then - w(k) = -z - do j = 1,n - v(j,k) = -v(j,k) - end do - end if - exit loop2 - end if - end if - - x = w(l) - nm = k - 1 - y = w(nm) - g = rv1(nm) - h = rv1(k) - f = ((y - z)*(y + z) + (g - h)*(g + h))/(2.0_r8*h*y) - g = sqrt( f*f + 1.0_r8 ) - f = ((x - z)*(x + z) + h*((y/(f + sign(g,f))) - h))/x - c = 1.0_r8 - s = 1.0_r8 - do j = l,nm - i = j + 1 - g = rv1(i) - y = w(i) - h = s*g - g = c*g - z = sqrt( f*f + h*h ) - rv1(j) = z - c = f/z - s = h/z - f = (x*c)+(g*s) - g = -(x*s)+(g*c) - h = y*s - y = y*c - do nm = 1,n - x = v(nm,j) - z = v(nm,i) - v(nm,j) = (x*c)+(z*s) - v(nm,i) = -(x*s)+(z*c) - end do - z = sqrt( f*f + h*h ) - w(j) = z - if( z /= 0.0_r8 ) then - z = 1.0_r8/z - c = f*z - s = h*z - end if - f = (c*g)+(s*y) - x = -(s*g)+(c*y) - do nm = 1,m - y = a(nm,j) - z = a(nm,i) - a(nm,j) = (y*c)+(z*s) - a(nm,i) = -(y*s)+(z*c) - end do - end do - rv1(l) = 0.0_r8 - rv1(k) = f - w(k) = x - end do loop2 - end do - - end subroutine svdcmp - -!------------------------------------------------------------------------- -! purpose: solves a*x = b -! -! method: -! solves a*x = b for a vector x, where a is specified by the arrays -! u,w,v as returned by svdcmp. m and n -! are the logical dimensions of a, and will be equal for square matrices. -! mp and np are the physical dimensions of a. b(1:m) is the input right-hand -! side. x(1:n) is the output solution vector. no input quantities are -! destroyed, so the routine may be called sequentially with different b -! -! author: a. maute dec 2002 -! (* copyright (c) 1985 numerical recipes software -- svbksb *! -! from numerical recipes 1986 pp. 57 or can be find on web-sites -!------------------------------------------------------------------------- - - subroutine svbksb( u, w, v, m, n, mp, np, b, x ) -!------------------------------------------------------------------------- -! ... dummy arguments -!------------------------------------------------------------------------- - integer, intent(in) :: m - integer, intent(in) :: n - integer, intent(in) :: mp - integer, intent(in) :: np - real(r8), intent(in) :: u(mp,np) - real(r8), intent(in) :: w(np) - real(r8), intent(in) :: v(np,np) - real(r8), intent(in) :: b(mp) - real(r8), intent(out) :: x(np) - -!------------------------------------------------------------------------- -! ... local variables -!------------------------------------------------------------------------- - integer :: i, j, jj - real(r8) :: s - real(r8) :: tmp(nmax) - - do j = 1,n - s = 0._r8 - if( w(j) /= 0._r8 ) then - do i = 1,m - s = s + u(i,j)*b(i) - end do - s = s/w(j) - endif - tmp(j) = s - end do - - do j = 1,n - s = 0._r8 - do jj = 1,n - s = s + v(j,jj)*tmp(jj) - end do - x(j) = s - end do - - end subroutine svbksb - - end module sv_decomp diff --git a/src/chemistry/mozart/tracer_cnst.F90 b/src/chemistry/mozart/tracer_cnst.F90 index 803e3e1061..9c51b6cec8 100644 --- a/src/chemistry/mozart/tracer_cnst.F90 +++ b/src/chemistry/mozart/tracer_cnst.F90 @@ -13,7 +13,7 @@ module tracer_cnst implicit none private ! all unless made public - save + save public :: tracer_cnst_init public :: num_tracer_cnst @@ -94,7 +94,7 @@ subroutine tracer_cnst_init() call addfld(trim(fields(i)%fldnam), (/ 'lev' /), & 'I','mol/mol', 'prescribed tracer constituent' ) - enddo + enddo allocate(data_q(pcols,pver,num_tracer_cnst,begchunk:endchunk), stat=istat) call handle_err(istat, 'tracer_cnst_init: ERROR allocating data_q') @@ -169,7 +169,7 @@ subroutine tracer_cnst_defaultopts( & tracer_cnst_cycle_yr_out, & tracer_cnst_fixed_ymd_out,& tracer_cnst_fixed_tod_out & - ) + ) implicit none @@ -231,7 +231,7 @@ subroutine tracer_cnst_adv( pbuf2d, state ) implicit none - type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_state), intent(in):: state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer :: i,ind,c,ncol @@ -311,12 +311,13 @@ subroutine get_cnst_data_ptr(name, state, q, pbuf) integer :: lchnk integer :: ncol integer :: inv_id, idx + character(len=80) :: error_str lchnk = state%lchnk ncol = state%ncol ! make sure the requested constituent can be provided - inv_id = get_inv_ndx(name) + inv_id = get_inv_ndx(name) if (.not. inv_id > 0) then if (masterproc) then write(iulog,*) 'get_cnst_data_ptr: '//name//' is not a prescribed tracer constituent' @@ -326,6 +327,13 @@ subroutine get_cnst_data_ptr(name, state, q, pbuf) call get_fld_ndx( fields, name, idx ) + if (idx<1) then + write(error_str,*) 'get_cnst_data_ptr: ',trim(name),' not found ... idx : ',idx + if (masterproc) then + write(iulog,*) error_str + end if + call endrun(error_str) + end if call get_fld_data( fields, name, data_q(:,:,idx,lchnk), ncol, lchnk, pbuf ) data_q(:ncol,:,idx,lchnk) = data_q(:ncol,:,idx,lchnk)*fix_mass(inv_id)/mwdry ! vmr->mmr diff --git a/src/chemistry/mozart/upper_bc.F90 b/src/chemistry/mozart/upper_bc.F90 index 71a4a65b0c..c760f3b3e1 100644 --- a/src/chemistry/mozart/upper_bc.F90 +++ b/src/chemistry/mozart/upper_bc.F90 @@ -1,24 +1,27 @@ - module upper_bc !--------------------------------------------------------------------------------- -! Module to compute the upper boundary condition for temperature (dry static energy) -! and trace gases. Uses the MSIS model, and SNOE and TIME GCM data. -! -! original code by Stacy Walters -! adapted by B. A. Boville +! Module to compute the upper boundary conditions for temperature (dry static energy) +! and trace gases. Uses the MSIS model, and SNOE and TIME GCM and general prescribed UBC data. !--------------------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_kind_mod, only: cl => shr_kind_cl use shr_const_mod,only: grav => shr_const_g, & ! gravitational constant (m/s^2) kboltz => shr_const_boltz, & ! Boltzmann constant pi => shr_const_pi, & ! pi - rEarth => shr_const_rearth ! Earth radius + rEarth => shr_const_rearth ! Earth radius use ppgrid, only: pcols, pver, pverp use constituents, only: pcnst use cam_logfile, only: iulog use spmd_utils, only: masterproc - use ref_pres, only: ptop_ref + use ref_pres, only: do_molec_diff, ptop_ref + use shr_kind_mod, only: cx=>SHR_KIND_CX + use cam_abortutils,only: endrun + use cam_history, only: addfld, horiz_only, outfld, fieldname_len + + use upper_bc_file, only: upper_bc_file_readnl, upper_bc_file_specified, upper_bc_file_adv, upper_bc_file_get + use infnan, only: nan, assignment(=) implicit none private @@ -26,125 +29,184 @@ module upper_bc ! ! Public interfaces ! - public :: ubc_defaultopts ! set default values of namelist variables - public :: ubc_setopts ! get namelist input + public :: ubc_readnl ! read namelist options for UBCs public :: ubc_init ! global initialization public :: ubc_timestep_init ! time step initialization public :: ubc_get_vals ! get ubc values for this step + public :: ubc_get_flxs ! get ub fluxes for this step + public :: ubc_fixed_conc ! returns true for constituents that have fixed UBC + public :: ubc_fixed_temp ! true if temperature at upper boundary is fixed + + character(len=64) :: ubc_specifier(pcnst) = 'NOTSET' + + character(len=16) :: ubc_flds(pcnst) = 'NOTSET' + character(len=16) :: ubc_file_spfr(pcnst) = ' ' + character(len=32) :: ubc_source(pcnst) = ' ' + + integer :: n_fixed_mmr=0 + integer :: n_fixed_vmr=0 + + integer, allocatable :: fixed_mmr_ndx(:) + integer, allocatable :: fixed_vmr_ndx(:) + real(r8), allocatable :: fixed_mmr(:) + real(r8), allocatable :: fixed_vmr(:) + + integer :: num_infile = 0 + integer :: num_fixed = 0 + character(len=2), parameter :: msis_flds(5) = & + (/ 'H ','N ','O ','O2','T ' /) + character(len=2), parameter :: tgcm_flds(1) = & + (/ 'H2' /) + character(len=2), parameter :: snoe_flds(1) = & + (/ 'NO' /) + + logical, protected :: ubc_fixed_temp =.false. + logical :: msis_active =.false. + logical :: tgcm_active =.false. + logical :: snoe_active =.false. ! Namelist variables - character(len=256) :: snoe_ubc_file = ' ' - real(r8) :: t_pert_ubc = 0._r8 - real(r8) :: no_xfac_ubc = 1._r8 + character(len=cl) :: snoe_ubc_file = 'NONE' + real(r8) :: t_pert_ubc = 0._r8 + real(r8) :: no_xfac_ubc = 1._r8 + + integer :: h_ndx=-1 + integer :: h_msis_ndx=-1, n_msis_ndx=-1, o_msis_ndx=-1, o2_msis_ndx=-1 - character(len=256) :: tgcm_ubc_file = ' ' - integer :: tgcm_ubc_cycle_yr = 0 - integer :: tgcm_ubc_fixed_ymd = 0 - integer :: tgcm_ubc_fixed_tod = 0 - integer :: f_ndx, hf_ndx - character(len=32) :: tgcm_ubc_data_type = 'CYCLICAL' + character(len=cl) :: tgcm_ubc_file = 'NONE' + integer :: tgcm_ubc_cycle_yr = 0 + integer :: tgcm_ubc_fixed_ymd = 0 + integer :: tgcm_ubc_fixed_tod = 0 + character(len=32) :: tgcm_ubc_data_type = 'CYCLICAL' logical :: apply_upper_bc = .false. + integer, allocatable :: file_spc_ndx(:) + integer, allocatable :: spc_ndx(:) + character(len=fieldname_len), allocatable :: hist_names(:) + !================================================================================================ contains !================================================================================================ -subroutine ubc_defaultopts(tgcm_ubc_file_out, tgcm_ubc_data_type_out, tgcm_ubc_cycle_yr_out, tgcm_ubc_fixed_ymd_out, & - tgcm_ubc_fixed_tod_out, snoe_ubc_file_out, t_pert_ubc_out, no_xfac_ubc_out) -!----------------------------------------------------------------------- -! Purpose: Return default runtime options -!----------------------------------------------------------------------- - - real(r8), intent(out), optional :: t_pert_ubc_out - real(r8), intent(out), optional :: no_xfac_ubc_out - character(len=*), intent(out), optional :: tgcm_ubc_file_out - character(len=*), intent(out), optional :: snoe_ubc_file_out - integer , intent(out), optional :: tgcm_ubc_cycle_yr_out - integer , intent(out), optional :: tgcm_ubc_fixed_ymd_out - integer , intent(out), optional :: tgcm_ubc_fixed_tod_out - character(len=*), intent(out), optional :: tgcm_ubc_data_type_out - !----------------------------------------------------------------------- - - if ( present(tgcm_ubc_file_out) ) then - tgcm_ubc_file_out = tgcm_ubc_file - endif - if ( present(tgcm_ubc_data_type_out) ) then - tgcm_ubc_data_type_out = tgcm_ubc_data_type - endif - if ( present(tgcm_ubc_cycle_yr_out) ) then - tgcm_ubc_cycle_yr_out = tgcm_ubc_cycle_yr - endif - if ( present(tgcm_ubc_fixed_ymd_out) ) then - tgcm_ubc_fixed_ymd_out = tgcm_ubc_fixed_ymd - endif - if ( present(tgcm_ubc_fixed_tod_out) ) then - tgcm_ubc_fixed_tod_out = tgcm_ubc_fixed_tod - endif - if ( present(snoe_ubc_file_out) ) then - snoe_ubc_file_out = snoe_ubc_file - endif - if ( present(t_pert_ubc_out) ) then - t_pert_ubc_out = t_pert_ubc - endif - if ( present(no_xfac_ubc_out) ) then - no_xfac_ubc_out = no_xfac_ubc - endif - -end subroutine ubc_defaultopts - -!================================================================================================ - -subroutine ubc_setopts(tgcm_ubc_file_in, tgcm_ubc_data_type_in, tgcm_ubc_cycle_yr_in, tgcm_ubc_fixed_ymd_in, & - tgcm_ubc_fixed_tod_in, snoe_ubc_file_in, t_pert_ubc_in, no_xfac_ubc_in) -!----------------------------------------------------------------------- -! Purpose: Set runtime options !----------------------------------------------------------------------- + subroutine ubc_readnl(nlfile) + use namelist_utils, only : find_group_name + use spmd_utils, only : mpicom, masterprocid, mpi_character, mpi_integer, mpi_real8 + use string_utils, only : to_lower + + character(len=*), intent(in) :: nlfile + integer :: unitn, ierr, m, n, ndx_co, ndx_ar + + character(len=*), parameter :: prefix = 'ubc_readnl: ' + + namelist /upper_bc_opts/ tgcm_ubc_file,tgcm_ubc_data_type,tgcm_ubc_cycle_yr,tgcm_ubc_fixed_ymd, & + tgcm_ubc_fixed_tod, snoe_ubc_file, no_xfac_ubc, t_pert_ubc + namelist /upper_bc_opts/ ubc_specifier + + if (masterproc) then + ! read namelist + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'upper_bc_opts', status=ierr) + if (ierr == 0) then + read(unitn, upper_bc_opts, iostat=ierr) + if (ierr /= 0) then + call endrun(prefix//'upper_bc_opts: ERROR reading namelist') + end if + end if + close(unitn) + + ! log the UBC options + write(iulog,*) prefix//'tgcm_ubc_file = '//trim(tgcm_ubc_file) + write(iulog,*) prefix//'tgcm_ubc_data_type = '//trim(tgcm_ubc_data_type) + write(iulog,*) prefix//'tgcm_ubc_cycle_yr = ', tgcm_ubc_cycle_yr + write(iulog,*) prefix//'tgcm_ubc_fixed_ymd = ', tgcm_ubc_fixed_ymd + write(iulog,*) prefix//'tgcm_ubc_fixed_tod = ', tgcm_ubc_fixed_tod + write(iulog,*) prefix//'snoe_ubc_file = '//trim(snoe_ubc_file) + write(iulog,*) prefix//'t_pert_ubc = ', t_pert_ubc + write(iulog,*) prefix//'no_xfac_ubc = ', no_xfac_ubc + write(iulog,*) prefix//'ubc_specifier : ' + + n=1 + m=1 + do while(ubc_specifier(n)/='NOTSET') + write(iulog,'(i4,a)') n,' '//trim(ubc_specifier(n)) + + ndx_ar = index(ubc_specifier(n),'->') + + if (ndx_ar<1) then + call endrun(prefix//'ubc_specifier "'//trim(ubc_specifier(n))//'" must include "->"') + endif + + ubc_source(n) = trim(to_lower(adjustl(ubc_specifier(n)(ndx_ar+2:)))) + + if (trim(ubc_source(n))=='ubc_file') then + ubc_file_spfr(m) = trim(ubc_specifier(n)(:ndx_ar-1)) + m=m+1 + endif + if (index(ubc_source(n),'mmr')>0) then + n_fixed_mmr=n_fixed_mmr+1 + else if (index(ubc_source(n),'vmr')>0) then + n_fixed_vmr=n_fixed_vmr+1 + end if + + ndx_co = index(ubc_specifier(n),':') + + if (ndx_co>0) then + ubc_flds(n) = ubc_specifier(n)(:ndx_co-1) + else + ubc_flds(n) = ubc_specifier(n)(:ndx_ar-1) + end if + + n=n+1 + end do + num_fixed=n-1 + num_infile=m-1 + end if - use cam_abortutils, only : endrun - - real(r8), intent(in), optional :: t_pert_ubc_in - real(r8), intent(in), optional :: no_xfac_ubc_in - character(len=*), intent(in), optional :: tgcm_ubc_file_in - character(len=*), intent(in), optional :: snoe_ubc_file_in - integer , intent(in), optional :: tgcm_ubc_cycle_yr_in - integer , intent(in), optional :: tgcm_ubc_fixed_ymd_in - integer , intent(in), optional :: tgcm_ubc_fixed_tod_in - character(len=*), intent(in), optional :: tgcm_ubc_data_type_in -!----------------------------------------------------------------------- + ! broadcast to all MPI tasks + call mpi_bcast(num_fixed, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : num_fixed') + call mpi_bcast(num_infile, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : num_infile') + call mpi_bcast(n_fixed_mmr, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : n_fixed_mmr') + call mpi_bcast(n_fixed_vmr, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : n_fixed_vmr') + call mpi_bcast(tgcm_ubc_file, len(tgcm_ubc_file), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : tgcm_ubc_file') + call mpi_bcast(tgcm_ubc_data_type, len(tgcm_ubc_data_type),mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : tgcm_ubc_data_type') + call mpi_bcast(tgcm_ubc_cycle_yr, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : tgcm_ubc_cycle_yr') + call mpi_bcast(tgcm_ubc_fixed_ymd, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : tgcm_ubc_fixed_ymd') + call mpi_bcast(tgcm_ubc_fixed_tod, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : tgcm_ubc_fixed_tod') + call mpi_bcast(snoe_ubc_file, len(snoe_ubc_file), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : snoe_ubc_file') + call mpi_bcast(t_pert_ubc, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : t_pert_ubc') + call mpi_bcast(no_xfac_ubc,1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : no_xfac_ubc') + call mpi_bcast(ubc_specifier, pcnst*len(ubc_specifier(1)), mpi_character,masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_specifier') + call mpi_bcast(ubc_flds, pcnst*len(ubc_flds(1)), mpi_character,masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_flds') + call mpi_bcast(ubc_file_spfr, pcnst*len(ubc_file_spfr(1)), mpi_character,masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_file_spfr') + call mpi_bcast(ubc_source, pcnst*len(ubc_source(1)), mpi_character,masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_source') + + apply_upper_bc = num_fixed>0 + + if (apply_upper_bc) then + call upper_bc_file_readnl(nlfile) + end if - if ( present(tgcm_ubc_file_in) ) then - tgcm_ubc_file = tgcm_ubc_file_in - endif - if ( present(tgcm_ubc_data_type_in) ) then - tgcm_ubc_data_type = tgcm_ubc_data_type_in - endif - if ( present(tgcm_ubc_cycle_yr_in) ) then - tgcm_ubc_cycle_yr = tgcm_ubc_cycle_yr_in - endif - if ( present(tgcm_ubc_fixed_ymd_in) ) then - tgcm_ubc_fixed_ymd = tgcm_ubc_fixed_ymd_in - endif - if ( present(tgcm_ubc_fixed_tod_in) ) then - tgcm_ubc_fixed_tod = tgcm_ubc_fixed_tod_in - endif - if ( present(snoe_ubc_file_in) ) then - snoe_ubc_file = snoe_ubc_file_in - endif - if ( present(t_pert_ubc_in) ) then - t_pert_ubc = t_pert_ubc_in - endif - if ( present(no_xfac_ubc_in) ) then - no_xfac_ubc = no_xfac_ubc_in - if( no_xfac_ubc < 0._r8 ) then - write(iulog,*) 'ubc_setopts: no_xfac_ubc = ',no_xfac_ubc,' must be >= 0' - call endrun - end if - endif - -end subroutine ubc_setopts + end subroutine ubc_readnl !=============================================================================== @@ -157,39 +219,167 @@ subroutine ubc_init() use mo_snoe, only: snoe_inti use mo_msis_ubc, only: msis_ubc_inti use constituents,only: cnst_get_ind + use upper_bc_file, only: upper_bc_file_init -!---------------------------Local workspace----------------------------- - logical :: zonal_avg -!----------------------------------------------------------------------- - apply_upper_bc = ptop_ref<1._r8 ! Pa + !---------------------------Local workspace----------------------------- + logical, parameter :: zonal_avg = .false. + integer :: m, mm, ierr + integer :: mmrndx, vmrndx, m_mmr, m_vmr + + real(r8) :: val + character(len=32) :: str + character(len=*), parameter :: prefix = 'ubc_init: ' + !----------------------------------------------------------------------- + + call cnst_get_ind('H', h_ndx, abort=.false.) ! for H fluxes UBC (WACCMX) if (.not.apply_upper_bc) return - call cnst_get_ind('F', f_ndx, abort=.false.) - call cnst_get_ind('HF', hf_ndx, abort=.false.) + if (num_infile>0) then + call upper_bc_file_init( ubc_file_spfr(:num_infile) ) + endif - zonal_avg = .false. + ! possible MSIS, TGCM, SNOE and ubc_file inputs -!----------------------------------------------------------------------- -! ... initialize the tgcm upper boundary module -!----------------------------------------------------------------------- - call tgcm_ubc_inti( tgcm_ubc_file, tgcm_ubc_data_type, tgcm_ubc_cycle_yr, tgcm_ubc_fixed_ymd, tgcm_ubc_fixed_tod) - if (masterproc) write(iulog,*) 'ubc_init: after tgcm_ubc_inti' + mm=1 -!----------------------------------------------------------------------- -! ... initialize the snoe module -!----------------------------------------------------------------------- - call snoe_inti(snoe_ubc_file) - if (masterproc) write(iulog,*) 'ubc_init: after snoe_inti' + allocate(hist_names(num_fixed), stat=ierr) + if (ierr /= 0) call endrun(prefix//'allocate error : hist_names') + allocate(spc_ndx(num_fixed), stat=ierr) + if (ierr /= 0) call endrun(prefix//'allocate error : spc_ndx') + spc_ndx=-1 + if (num_infile>0) then + allocate(file_spc_ndx(num_infile), stat=ierr) + if (ierr /= 0) call endrun(prefix//'allocate error : file_spc_ndx') + file_spc_ndx=-1 + end if + if (n_fixed_mmr>0) then + allocate(fixed_mmr_ndx(n_fixed_mmr), stat=ierr) + if (ierr /= 0) call endrun(prefix//'allocate error : fixed_mmr_ndx') + allocate(fixed_mmr(n_fixed_mmr), stat=ierr) + if (ierr /= 0) call endrun(prefix//'allocate error : fixed_mmr') + fixed_mmr_ndx=-1 + fixed_mmr = nan + end if + if (n_fixed_vmr>0) then + allocate(fixed_vmr_ndx(n_fixed_vmr), stat=ierr) + if (ierr /= 0) call endrun(prefix//'allocate error : fixed_vmr_ndx') + allocate(fixed_vmr(n_fixed_vmr), stat=ierr) + if (ierr /= 0) call endrun(prefix//'allocate error : fixed_vmr') + fixed_vmr_ndx=-1 + fixed_vmr = nan + end if -!----------------------------------------------------------------------- -! ... initialize the msis module -!----------------------------------------------------------------------- - call msis_ubc_inti( zonal_avg ) - if (masterproc) write(iulog,*) 'ubc_init: after msis_ubc_inti' + m_mmr = 0 + m_vmr = 0 + + do m = 1,num_fixed + hist_names(m) = trim(ubc_flds(m))//'_UBC' + if (ubc_flds(m)=='T') then + ubc_fixed_temp=.true. + spc_ndx(m) = -1 + call addfld(hist_names(m), horiz_only, 'I', 'K', trim(ubc_flds(m))//' at upper boundary' ) + else + call cnst_get_ind(ubc_flds(m), spc_ndx(m), abort=.true.) + call addfld(hist_names(m), horiz_only, 'I', 'kg/kg', trim(ubc_flds(m))//' at upper boundary' ) + end if + + if (trim(ubc_source(m))=='msis') then + if (do_molec_diff .and. any(msis_flds==ubc_flds(m))) then + msis_active = .true. + if (trim(ubc_flds(m))=='H') h_msis_ndx=spc_ndx(m) + if (trim(ubc_flds(m))=='N') n_msis_ndx=spc_ndx(m) + if (trim(ubc_flds(m))=='O') o_msis_ndx=spc_ndx(m) + if (trim(ubc_flds(m))=='O2') o2_msis_ndx=spc_ndx(m) + else + call endrun(prefix//'MSIS is not allowed in this configuration') + end if + else if (trim(ubc_source(m))=='tgcm') then + if (do_molec_diff .and. any(tgcm_flds==ubc_flds(m))) then + tgcm_active = .true. + else + call endrun(prefix//'TGCM is not allowed in this configuration') + end if + else if (trim(ubc_source(m))=='snoe') then + if (do_molec_diff .and. any(snoe_flds==ubc_flds(m))) then + snoe_active = .true. + else + call endrun(prefix//'SNOE is not allowed in this configuration') + end if + else if (trim(ubc_source(m))=='ubc_file') then + file_spc_ndx(mm) = spc_ndx(m) + mm = mm+1 + else + mmrndx = index(trim(ubc_source(m)),'mmr') + vmrndx = index(trim(ubc_source(m)),'vmr') + if (mmrndx>0 .and. vmrndx>0) then + call endrun(prefix//'incorrect units in UBC source: '//trim(ubc_source(m))) + end if + if (mmrndx>0) then + str = ubc_source(m)(:mmrndx-1) + read(str,*) val + m_mmr = m_mmr + 1 + fixed_mmr(m_mmr) = val + fixed_mmr_ndx(m_mmr) = spc_ndx(m) + else if (vmrndx>0) then + str = ubc_source(m)(:vmrndx-1) + read(str,*) val + m_vmr = m_vmr + 1 + fixed_vmr(m_vmr) = val + fixed_vmr_ndx(m_vmr) = spc_ndx(m) + else + call endrun(prefix//'unrecognized UBC source: '//trim(ubc_source(m))) + end if + end if + end do + + if (tgcm_active) then + !----------------------------------------------------------------------- + ! ... initialize the tgcm upper boundary module + !----------------------------------------------------------------------- + call tgcm_ubc_inti( tgcm_ubc_file, tgcm_ubc_data_type, tgcm_ubc_cycle_yr, & + tgcm_ubc_fixed_ymd, tgcm_ubc_fixed_tod) + if (masterproc) write(iulog,*) 'ubc_init: after tgcm_ubc_inti' + endif + + if (snoe_active) then + !----------------------------------------------------------------------- + ! ... initialize the snoe module + !----------------------------------------------------------------------- + call snoe_inti(snoe_ubc_file) + if (masterproc) write(iulog,*) 'ubc_init: after snoe_inti' + endif + + if (msis_active) then + !----------------------------------------------------------------------- + ! ... initialize the msis module + !----------------------------------------------------------------------- + call msis_ubc_inti( zonal_avg, n_msis_ndx,h_msis_ndx,o_msis_ndx,o2_msis_ndx ) + if (masterproc) write(iulog,*) 'ubc_init: after msis_ubc_inti' + endif end subroutine ubc_init +!=============================================================================== +!=============================================================================== + + pure logical function ubc_fixed_conc(name) + + character(len=*), intent(in) :: name + + integer :: m + + ubc_fixed_conc = .false. + + do m = 1,num_fixed + if ( trim(ubc_flds(m)) == trim(name) ) then + ubc_fixed_conc = .true. + return + endif + end do + + end function ubc_fixed_conc + !=============================================================================== subroutine ubc_timestep_init(pbuf2d, state) @@ -206,21 +396,29 @@ subroutine ubc_timestep_init(pbuf2d, state) use ppgrid, only: begchunk, endchunk use physics_buffer, only: physics_buffer_desc - type(physics_state), intent(in) :: state(begchunk:endchunk) + type(physics_state), intent(in) :: state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) if (.not.apply_upper_bc) return - call msis_timestep_init( ap, f107p, f107a ) - call tgcm_timestep_init( pbuf2d, state ) - call snoe_timestep_init( kp, f107 ) + if (num_infile>0) then + call upper_bc_file_adv( pbuf2d, state ) + end if + if (msis_active) then + call msis_timestep_init( ap, f107p, f107a ) + end if + if (tgcm_active) then + call tgcm_timestep_init( pbuf2d, state ) + end if + if (snoe_active) then + call snoe_timestep_init( kp, f107 ) + end if end subroutine ubc_timestep_init !=============================================================================== - subroutine ubc_get_vals (lchnk, ncol, pint, zi, t, q, omega, phis, & - msis_temp, ubc_mmr, ubc_flux) + subroutine ubc_get_vals (lchnk, ncol, pint, zi, ubc_temp, ubc_mmr) !----------------------------------------------------------------------- ! interface routine for vertical diffusion and pbl scheme @@ -229,124 +427,63 @@ subroutine ubc_get_vals (lchnk, ncol, pint, zi, t, q, omega, phis, & use mo_snoe, only: set_no_ubc, ndx_no use mo_tgcm_ubc, only: set_tgcm_ubc use cam_abortutils, only: endrun - use physconst, only: avogad, rairv, mbarv, rga ! Avogadro, gas constant, mean mass, universal gas constant - use phys_control, only: waccmx_is - use constituents, only: cnst_get_ind, cnst_mw, cnst_fixed_ubc ! Needed for ubc_flux + use air_composition, only: rairv, mbarv ! gas constant, mean mass + use constituents, only: cnst_mw ! Needed for ubc_flux !------------------------------Arguments-------------------------------- integer, intent(in) :: lchnk ! chunk identifier integer, intent(in) :: ncol ! number of atmospheric columns real(r8), intent(in) :: pint(pcols,pverp) ! interface pressures real(r8), intent(in) :: zi(pcols,pverp) ! interface geoptl height above sfc - real(r8), intent(in) :: t(pcols,pver) ! midpoint temperature - real(r8), intent(in),target :: q(pcols,pver,pcnst) ! contituent mixing ratios (kg/kg) - real(r8), intent(in) :: omega(pcols,pver) ! Vertical pressure velocity (Pa/s) - real(r8), intent(in) :: phis(pcols) ! Surface geopotential (m2/s2) - real(r8), intent(out) :: msis_temp(pcols) ! upper bndy temperature (K) + real(r8), intent(out) :: ubc_temp(pcols) ! upper bndy temperature (K) real(r8), intent(out) :: ubc_mmr(pcols,pcnst) ! upper bndy mixing ratios (kg/kg) - real(r8), intent(out) :: ubc_flux(pcols,pcnst) ! upper bndy flux (kg/s/m^2) -!---------------------------Local storage------------------------------- + !---------------------------Local storage------------------------------- integer :: m ! constituent index - integer :: ierr ! error flag for allocates - integer :: indx_H ! cnst index for H - integer :: indx_HE ! cnst index for He - integer :: iCol ! column loop counter - - real(r8), parameter :: m2km = 1.e-3_r8 ! meter to km real(r8) :: rho_top(pcols) ! density at top interface real(r8) :: z_top(pcols) ! height of top interface (km) + real(r8) :: vals(pcols,num_infile) - real(r8), parameter :: hfluxlimitfac = 0.72_r8 ! Hydrogen upper boundary flux limiting factor - - real(r8) :: nmbartop ! Top level density (rho) - real(r8) :: zkt ! Factor for H Jean's escape flux calculation - real(r8) :: nDensHETop ! Helium number density (kg/m3) - real(r8) :: pScaleHeight ! Scale height (m) - real(r8) :: wN2 ! Neutral vertical velocity second level (m/s) - real(r8) :: wN3 ! Neutral vertical velocity at third level (m/s) - real(r8) :: wNTop ! Neutral vertical velocity at top level (m/s) + real(r8), parameter :: m2km = 1.e-3_r8 ! meter to km - real(r8), pointer :: qh_top(:) ! Top level hydrogen mixing ratio (kg/kg) -!----------------------------------------------------------------------- + !----------------------------------------------------------------------- ubc_mmr(:,:) = 0._r8 - ubc_flux(:,:) = 0._r8 - msis_temp(:) = 0._r8 + ubc_temp(:) = nan if (.not. apply_upper_bc) return - call get_msis_ubc( lchnk, ncol, msis_temp, ubc_mmr ) - if( t_pert_ubc /= 0._r8 ) then - msis_temp(:ncol) = msis_temp(:ncol) + t_pert_ubc - if( any( msis_temp(:ncol) < 0._r8 ) ) then - write(iulog,*) 'ubc_get_vals: msis temp < 0 after applying offset = ',t_pert_ubc - call endrun + ! UBC_FILE + if (num_infile>0) then + call upper_bc_file_get(lchnk, ncol, vals) + do m = 1,num_infile + if (file_spc_ndx(m)>0) then + ubc_mmr(:ncol,file_spc_ndx(m)) = vals(:ncol,m) + else + ubc_temp(:ncol) = vals(:ncol,m) + end if + + end do + + endif + + ! MSIS + if (msis_active) then + call get_msis_ubc( lchnk, ncol, ubc_temp, ubc_mmr ) + if( t_pert_ubc /= 0._r8 ) then + ubc_temp(:ncol) = ubc_temp(:ncol) + t_pert_ubc + if( any( ubc_temp(:ncol) < 0._r8 ) ) then + write(iulog,*) 'ubc_get_vals: msis temp < 0 after applying offset = ',t_pert_ubc + call endrun('ubc_get_vals: msis temp < 0 after applying t_pert_ubc') + end if end if end if - - !-------------------------------------------------------------------------------------------- - ! For WACCM-X, calculate upper boundary H flux - !-------------------------------------------------------------------------------------------- - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - - call cnst_get_ind('H', indx_H) - qh_top => q(:,1,indx_H) - - do iCol = 1, ncol - !-------------------------------------------------- - ! Get total density (rho) at top level - !-------------------------------------------------- - nmbartop = 0.5_r8 * (pint(iCol,1) + pint(iCol,2)) / ( rairv(iCol,1,lchnk) * t(iCol,1) ) - - !--------------------------------------------------------------------- - ! Calculate factor for Jean's escape flux once here, used twice below - !--------------------------------------------------------------------- - zkt = (rEarth + ( 0.5_r8 * ( zi(iCol,1) + zi(iCol,2) ) + rga * phis(iCol) ) ) * & - cnst_mw(indx_H) / avogad * grav / ( kboltz * t(iCol,1) ) - - ubc_flux(iCol,indx_H) = hfluxlimitfac * SQRT(kboltz/(2.0_r8 * pi * cnst_mw(indx_H) / avogad)) * & - qh_top(iCol) * nmbartop * & - SQRT(t(iCol,1)) * (1._r8 + zkt) * EXP(-zkt) - - ubc_flux(iCol,indx_H) = ubc_flux(iCol,indx_H) * & - (2.03E-13_r8 * qh_top(iCol) * nmbartop / (cnst_mw(indx_H) / avogad) * t(iCol,1)) - - !-------------------------------------------------------------------------------------------------------------- - ! Need to get helium number density (SI units) from mass mixing ratio. mbarv is kg/mole, same as rMass units - ! kg/kg * (kg/mole)/(kg/mole) * (Pa or N/m*m)/((Joules/K or N*m/K) * (K)) = m-3 - !--------------------------------------------------------------------------------------------------------------- -! nDensHETop = qhe_top(iCol) * mbarv(iCol,1,lchnk) / cnst_mw(indx_HE) * & -! 0.5_r8 * (pint(iCol,1) + pint(iCol,2)) / (kboltz * t(iCol,1)) -! -! !------------------------------------------------------------------------------------------------------ -! ! Get midpoint vertical velocity for top level by extrapolating from two levels below top (Pa/s)*P -! !------------------------------------------------------------------------------------------------------ -! -! pScaleHeight = .5_r8*(rairv(iCol,2,lchnk)*t(iCol,1) + rairv(iCol,1,lchnk)*t(iCol,1)) / grav -! wN2 = -omega(iCol,2) / 0.5_r8 * (pint(iCol,1) + pint(iCol,2)) * pScaleHeight -! -! pScaleHeight = .5_r8 * (rairv(iCol,3,lchnk)*t(iCol,2) + rairv(iCol,2,lchnk)*t(iCol,2)) / grav -! wN3 = -omega(iCol,3) / 0.5_r8 * (pint(iCol,1) + pint(iCol,2)) * pScaleHeight -! -! !---------------------------------------------------- -! ! Get top midpoint level vertical velocity -! !---------------------------------------------------- -! wNTop = 1.5_r8 * wN2 - 0.5_r8 * wN3 -! -! !----------------------------------------------------------------------------------------------------------------- -! ! Helium upper boundary flux is just helium density multiplied by vertical velocity (kg*/m3)*(m/s) = kg/s/m^2) -! !----------------------------------------------------------------------------------------------------------------- -! ubc_flux(iCol,indx_HE) = -ndensHETop * wNTop -! - enddo - ubc_mmr(:ncol,ndx_no) = 0.0_r8 + ! SNOE + if (snoe_active) then - else ! for waccm - - rho_top(:ncol) = pint(:ncol,1) / (rairv(:ncol,1,lchnk)*msis_temp(:ncol)) + rho_top(:ncol) = pint(:ncol,1) / (rairv(:ncol,1,lchnk)*ubc_temp(:ncol)) z_top(:ncol) = m2km * zi(:ncol,1) call set_no_ubc ( lchnk, ncol, z_top, ubc_mmr, rho_top ) @@ -356,22 +493,89 @@ subroutine ubc_get_vals (lchnk, ncol, pint, zi, t, q, omega, phis, & endif - call set_tgcm_ubc( lchnk, ncol, ubc_mmr, mbarv(:,1,lchnk)) - - if (f_ndx .GT. 0) then - ubc_mmr(:ncol, f_ndx) = 1.0e-15_r8 - endif - if (hf_ndx .GT. 0) then - ubc_mmr(:ncol, hf_ndx) = 1.0e-15_r8 + ! TIE-GCM + if (tgcm_active) then + call set_tgcm_ubc( lchnk, ncol, ubc_mmr ) endif - ! Zero out constituent ubc's that are not used. - do m = 1, pcnst - if (.not. cnst_fixed_ubc(m)) then - ubc_mmr(:,m) = 0._r8 + ! fixed values + do m = 1,n_fixed_mmr + ubc_mmr(:ncol,fixed_mmr_ndx(m)) = fixed_mmr(m) + end do + do m = 1,n_fixed_vmr + ubc_mmr(:ncol,fixed_vmr_ndx(m)) = cnst_mw(fixed_vmr_ndx(m))*fixed_vmr(m)/mbarv(:ncol,1,lchnk) + end do + + ! diagnostic output + do m = 1,num_fixed + if (ubc_flds(m)=='T') then + call outfld(hist_names(m),ubc_temp(:ncol),ncol,lchnk) + else + call outfld(hist_names(m),ubc_mmr(:ncol,spc_ndx(m)),ncol,lchnk) end if end do end subroutine ubc_get_vals +!=============================================================================== + + subroutine ubc_get_flxs (lchnk, ncol, pint, zi, t, q, phis, ubc_flux) + + use physconst, only: avogad, rga + use air_composition, only: rairv + use constituents, only: cnst_mw +!------------------------------Arguments-------------------------------- + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: ncol ! number of atmospheric columns + real(r8), intent(in) :: pint(pcols,pverp) ! interface pressures + real(r8), intent(in) :: zi(pcols,pverp) ! interface geoptl height above sfc + real(r8), intent(in) :: t(pcols,pver) ! midpoint temperature + real(r8), intent(in),target :: q(pcols,pver,pcnst) ! contituent mixing ratios (kg/kg) + real(r8), intent(in) :: phis(pcols) ! Surface geopotential (m2/s2) + + real(r8), intent(out) :: ubc_flux(pcols,pcnst) ! upper bndy flux (kg/s/m^2) + +!---------------------------Local storage------------------------------- + integer :: iCol ! column loop counter + + real(r8), parameter :: h_escape_flx_factor = 2.03e-13_r8 ! for hydrogen escape flux due to charge exchange + ! adopted from TIME-GCM (R. G. Roble, pp. 1-21, AGU Geophys. Monogr. Ser 87, 1995) following + ! Liu, S.C., and T. M. Donahue, Mesospheric hydrogen related to exospheric escape mechanisms, J. Atmos. Sci., + ! 31, 1466-1470, 1974. (Equation 4 there). DOI: 10.1175/1520-0469(1974)031<1466:Mhrtee>2.0.Co;2 + ! https://journals.ametsoc.org/view/journals/atsc/31/5/1520-0469_1974_031_1466_mhrtee_2_0_co_2.xml + + real(r8), parameter :: hfluxlimitfac = 0.72_r8 ! Hydrogen upper boundary flux limiting factor + + real(r8) :: nmbartop ! Top level density (rho) + real(r8) :: zkt ! Factor for H Jean's escape flux calculation + + real(r8), pointer :: qh_top(:) ! Top level hydrogen mixing ratio (kg/kg) + + ubc_flux(:,:) = nan + + qh_top => q(:,1,h_ndx) + + do iCol = 1, ncol + !-------------------------------------------------- + ! Get total density (rho) at top level + !-------------------------------------------------- + nmbartop = 0.5_r8 * (pint(iCol,1) + pint(iCol,2)) / ( rairv(iCol,1,lchnk) * t(iCol,1) ) + + !--------------------------------------------------------------------- + ! Calculate factor for Jean's escape flux once here, used twice below + !--------------------------------------------------------------------- + zkt = (rEarth + ( 0.5_r8 * ( zi(iCol,1) + zi(iCol,2) ) + rga * phis(iCol) ) ) * & + cnst_mw(h_ndx) / avogad * grav / ( kboltz * t(iCol,1) ) + + ubc_flux(iCol,h_ndx) = hfluxlimitfac * SQRT(kboltz/(2.0_r8 * pi * cnst_mw(h_ndx) / avogad)) * & + qh_top(iCol) * nmbartop * & + SQRT(t(iCol,1)) * (1._r8 + zkt) * EXP(-zkt) + + ubc_flux(iCol,h_ndx) = ubc_flux(iCol,h_ndx) * & + (h_escape_flx_factor * qh_top(iCol) * nmbartop / (cnst_mw(h_ndx) / avogad) * t(iCol,1)) + + enddo + + end subroutine ubc_get_flxs + end module upper_bc diff --git a/src/chemistry/mozart/upper_bc_file.F90 b/src/chemistry/mozart/upper_bc_file.F90 new file mode 100644 index 0000000000..6650fec8af --- /dev/null +++ b/src/chemistry/mozart/upper_bc_file.F90 @@ -0,0 +1,197 @@ +!------------------------------------------------------------------------------- +! Manages reading Upper Boundary Conditions (UBCs) from file +!------------------------------------------------------------------------------- +module upper_bc_file + + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_kind_mod, only: cx => shr_kind_cx ! 512 + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use cam_abortutils,only: endrun + use cam_history, only: addfld, horiz_only, outfld, fieldname_len + + use tracer_data, only: trfld,trfile,MAXTRCRS + + implicit none + private + + public :: upper_bc_file_readnl ! read namelist options + public :: upper_bc_file_init ! initialize + public :: upper_bc_file_adv ! advance data reader + public :: upper_bc_file_get ! returns UBC values + public :: upper_bc_file_specified ! TRUE if UBC file is specified + + logical, protected :: upper_bc_file_specified = .false. + + ! private data members + character(len=cx) :: ubc_file_path = 'NONE' + character(len=32) :: ubc_file_input_type = 'NONE' + integer :: ubc_file_cycle_yr = -huge(1) + integer :: ubc_file_fixed_ymd = -huge(1) + integer :: ubc_file_fixed_tod = -huge(1) + + type(trfld), pointer :: fields(:) => null() + type(trfile) :: file + + integer :: num_ubc_flds = 0 + real(r8), allocatable :: ubc_fact(:) + character(len=fieldname_len), allocatable :: hist_names(:) + +contains + + !--------------------------------------------------------------------------- + ! read namelist options + !--------------------------------------------------------------------------- + subroutine upper_bc_file_readnl(nlfile) + use namelist_utils, only : find_group_name + use spmd_utils, only : mpicom, masterprocid, mpi_character, mpi_integer + + character(len=*), intent(in) :: nlfile + + integer :: unitn, ierr + character(len=*), parameter :: prefix = 'upper_bc_file_readnl: ' + + namelist /upper_bc_file_opts/ ubc_file_path, ubc_file_input_type + namelist /upper_bc_file_opts/ ubc_file_cycle_yr, ubc_file_fixed_ymd, ubc_file_fixed_tod + + if (masterproc) then + ! read namelist + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'upper_bc_file_opts', status=ierr) + if (ierr == 0) then + read(unitn, upper_bc_file_opts, iostat=ierr) + if (ierr /= 0) then + call endrun(prefix//'upper_bc_file_opts: ERROR reading namelist') + end if + end if + close(unitn) + end if + + call mpi_bcast(ubc_file_path, len(ubc_file_path), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_file_path') + call mpi_bcast(ubc_file_input_type, len(ubc_file_input_type), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_file_input_type') + call mpi_bcast(ubc_file_fixed_ymd, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_file_fixed_ymd') + call mpi_bcast(ubc_file_fixed_tod, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_file_fixed_tod') + call mpi_bcast(ubc_file_cycle_yr, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_file_cycle_yr') + + upper_bc_file_specified = ubc_file_path /= 'NONE' + + if (masterproc) then + write(iulog,*) prefix,'upper_bc_file_specified: ',upper_bc_file_specified + write(iulog,*) prefix,'ubc_file_path = '//trim(ubc_file_path) + write(iulog,*) prefix,'ubc_file_input_type = '//trim(ubc_file_input_type) + write(iulog,*) prefix,'ubc_file_cycle_yr = ',ubc_file_cycle_yr + write(iulog,*) prefix,'ubc_file_fixed_ymd = ',ubc_file_fixed_ymd + write(iulog,*) prefix,'ubc_file_fixed_tod = ',ubc_file_fixed_tod + end if + + end subroutine upper_bc_file_readnl + + !--------------------------------------------------------------------------- + ! initialize + !--------------------------------------------------------------------------- + subroutine upper_bc_file_init( flds_list ) + use tracer_data, only: trcdata_init + use constituents,only: cnst_get_ind, cnst_mw + use physconst, only: mwdry + use string_utils,only: to_lower + use ref_pres, only: do_molec_diff + + character(len=*), intent(in) :: flds_list(:) ! flds specifier list + + integer :: m, ndx, ierr + character(len=*), parameter :: prefix = 'upper_bc_file_init: ' + + num_ubc_flds = size(flds_list) + upper_bc_file_specified = upper_bc_file_specified .and. (num_ubc_flds>0) + + if (.not.upper_bc_file_specified) return + + allocate( ubc_fact(num_ubc_flds), stat=ierr ) + if (ierr /= 0) call endrun(prefix//'allocate error : ubc_fact') + ubc_fact(:) = -huge(1._r8) + + allocate(file%in_pbuf(num_ubc_flds), stat=ierr) + if (ierr /= 0) call endrun(prefix//'allocate error : file%in_pbuf') + file%in_pbuf(:) = .false. + + call trcdata_init( flds_list, ubc_file_path, ' ', ' ', fields, file, .false., & + ubc_file_cycle_yr, ubc_file_fixed_ymd, ubc_file_fixed_tod, ubc_file_input_type) + + if (do_molec_diff) then + file%top_bndry = .true. + else + file%top_layer = .true. + endif + + allocate(hist_names(num_ubc_flds), stat=ierr) + if (ierr /= 0) call endrun(prefix//'allocate error : hist_names') + hist_names = ' ' + + do m = 1,num_ubc_flds + + call cnst_get_ind(trim(fields(m)%fldnam), ndx, abort=.true.) + + select case ( to_lower(trim(fields(m)%units)) ) + case ('k','kg/kg','kg kg-1','mmr') + ubc_fact(m) = 1._r8 + case ('mol/mol','mole/mole','mol mol-1','vmr') + ubc_fact(m) = cnst_mw(ndx)/mwdry + case default + call endrun('upper_bc_file_get: units are not recognized') + end select + + hist_names(m) = trim(fields(m)%fldnam)//'_fubc' + if ( to_lower(trim(fields(m)%units)) == 'k' ) then + call addfld(hist_names(m), horiz_only, 'I', 'K', trim(fields(m)%fldnam)//' at upper boundary' ) + else + call addfld(hist_names(m), horiz_only, 'I', 'kg/kg', trim(fields(m)%fldnam)//' at upper boundary' ) + end if + + end do + + end subroutine upper_bc_file_init + + !--------------------------------------------------------------------------- + ! advance data reader + !--------------------------------------------------------------------------- + subroutine upper_bc_file_adv(pbuf2d, state) + use tracer_data, only : advance_trcdata + use physics_types, only : physics_state + use physics_buffer, only : physics_buffer_desc + + ! args + type(physics_state), intent(in) :: state(:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + if (.not.upper_bc_file_specified) return + + call advance_trcdata( fields, file, state, pbuf2d ) + + end subroutine upper_bc_file_adv + + !--------------------------------------------------------------------------- + ! returns UBC values + !--------------------------------------------------------------------------- + subroutine upper_bc_file_get(lchnk, ncol, val) + + integer, intent(in) :: ncol, lchnk + real(r8), intent(out) :: val(:,:) + + integer :: m + + if (.not.upper_bc_file_specified) return + + do m = 1,num_ubc_flds + val(:ncol,m) = ubc_fact(m)*fields(m)%data(:ncol,1,lchnk) + call outfld( trim(hist_names(m)), val(:ncol,m), ncol, lchnk ) + enddo + + + end subroutine upper_bc_file_get + +end module upper_bc_file diff --git a/src/chemistry/pp_ghg_mam4/chem_mech.doc b/src/chemistry/pp_ghg_mam4/chem_mech.doc new file mode 100644 index 0000000000..5c976202f5 --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/chem_mech.doc @@ -0,0 +1,161 @@ + + + Solution species + ( 1) bc_a1 (C) + ( 2) bc_a4 (C) + ( 3) CFC11 (CFCl3) + ( 4) CFC12 (CF2Cl2) + ( 5) CH4 + ( 6) CO2 + ( 7) DMS (CH3SCH3) + ( 8) dst_a1 (AlSiO5) + ( 9) dst_a2 (AlSiO5) + ( 10) dst_a3 (AlSiO5) + ( 11) H2O2 + ( 12) H2SO4 + ( 13) N2O + ( 14) ncl_a1 (NaCl) + ( 15) ncl_a2 (NaCl) + ( 16) ncl_a3 (NaCl) + ( 17) num_a1 (H) + ( 18) num_a2 (H) + ( 19) num_a3 (H) + ( 20) num_a4 (H) + ( 21) pom_a1 (C) + ( 22) pom_a4 (C) + ( 23) SO2 + ( 24) so4_a1 (NH4HSO4) + ( 25) so4_a2 (NH4HSO4) + ( 26) so4_a3 (NH4HSO4) + ( 27) soa_a1 (C) + ( 28) soa_a2 (C) + ( 29) SOAE (C) + ( 30) SOAG (C) + ( 31) H2O + + + Invariant species + ( 1) M + ( 2) O2 + ( 3) N2 + ( 4) HO2 + ( 5) OH + ( 6) NO3 + ( 7) O3 + ( 8) HALONS + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) CO2 + + Implicit + -------- + ( 1) bc_a1 + ( 2) bc_a4 + ( 3) CFC11 + ( 4) CFC12 + ( 5) CH4 + ( 6) DMS + ( 7) dst_a1 + ( 8) dst_a2 + ( 9) dst_a3 + ( 10) H2O2 + ( 11) H2SO4 + ( 12) N2O + ( 13) ncl_a1 + ( 14) ncl_a2 + ( 15) ncl_a3 + ( 16) num_a1 + ( 17) num_a2 + ( 18) num_a3 + ( 19) num_a4 + ( 20) pom_a1 + ( 21) pom_a4 + ( 22) SO2 + ( 23) so4_a1 + ( 24) so4_a2 + ( 25) so4_a3 + ( 26) soa_a1 + ( 27) soa_a2 + ( 28) SOAE + ( 29) SOAG + ( 30) H2O + + Photolysis + jh2o2 ( 1) H2O2 + hv -> 2*OH rate = ** User defined ** ( 1) + jsoa_a1 ( 2) soa_a1 + hv -> (No products) rate = ** User defined ** ( 2) + jsoa_a2 ( 3) soa_a2 + hv -> (No products) rate = ** User defined ** ( 3) + + Reactions + lyman_alpha ( 1) H2O -> (No products) rate = ** User defined ** ( 4) + OH_H2O2 ( 2) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 ( 5) + usr_HO2_HO2 ( 3) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** ( 6) + n2o_loss ( 4) N2O -> (No products) rate = ** User defined ** ( 7) + cfc11_loss ( 5) CFC11 -> (No products) rate = ** User defined ** ( 8) + cfc12_loss ( 6) CFC12 -> (No products) rate = ** User defined ** ( 9) + ch4_loss ( 7) CH4 -> 2*H2O rate = ** User defined ** ( 10) + DMS_NO3 ( 8) DMS + NO3 -> SO2 + {HNO3} rate = 1.90E-13*exp( 520./t) ( 11) + DMS_OHa ( 9) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) ( 12) + SO2_OH_M ( 10) SO2 + OH + M -> H2SO4 troe : ko=2.90E-31*(300/t)**4.10 ( 13) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + usr_DMS_OH ( 11) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** ( 14) + SOAE_tau ( 12) SOAE -> SOAG rate = 1.16E-05 ( 15) + +Extraneous prod/loss species + ( 1) bc_a1 (dataset) + ( 2) bc_a4 (dataset) + ( 3) H2O (dataset) + ( 4) num_a1 (dataset) + ( 5) num_a2 (dataset) + ( 6) num_a4 (dataset) + ( 7) pom_a1 (dataset) + ( 8) pom_a4 (dataset) + ( 9) SO2 (dataset) + (10) so4_a1 (dataset) + (11) so4_a2 (dataset) + + + Equation Report + + d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(CFC11)/dt = - r5*CFC11 + d(CFC12)/dt = - r6*CFC12 + d(CH4)/dt = - r7*CH4 + d(CO2)/dt = 0 + d(DMS)/dt = - r8*NO3*DMS - r9*OH*DMS - r11*OH*DMS + d(dst_a1)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(H2O2)/dt = r3 + - j1*H2O2 - r2*OH*H2O2 + d(H2SO4)/dt = r10*OH*M*SO2 + d(N2O)/dt = - r4*N2O + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 + d(ncl_a3)/dt = 0 + d(num_a1)/dt = 0 + d(num_a2)/dt = 0 + d(num_a3)/dt = 0 + d(num_a4)/dt = 0 + d(pom_a1)/dt = 0 + d(pom_a4)/dt = 0 + d(SO2)/dt = r8*NO3*DMS + r9*OH*DMS + .5*r11*OH*DMS + - r10*OH*M*SO2 + d(so4_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(so4_a3)/dt = 0 + d(soa_a1)/dt = - j2*soa_a1 + d(soa_a2)/dt = - j3*soa_a2 + d(SOAE)/dt = - r12*SOAE + d(SOAG)/dt = r12*SOAE + d(H2O)/dt = r2*OH*H2O2 + 2*r7*CH4 + - r1*H2O diff --git a/src/chemistry/pp_ghg_mam4/chem_mech.in b/src/chemistry/pp_ghg_mam4/chem_mech.in new file mode 100644 index 0000000000..2d0365a8a5 --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/chem_mech.in @@ -0,0 +1,179 @@ +* Comments +* User-given Tag Description: WACCM_SC_MAM4 +* Tag database identifier : MZ312_WACCM_SC_MAM4_20221214 +* Tag created by : lke +* Tag created from branch : WACCM_SC_MAM4 +* Tag created on : 2022-12-14 15:17:17.723566-07 +* Comments for this tag follow: +* lke : 2022-12-14 : Specified chemistry (SC) WACCM mechanism, with updated simple SOA. +* fvitt : 2023-03-17 : Copied from waccm_sc_mam4 to ghg_mam4 and add CO2 for CAM7 prognostic GHGs + + SPECIES + + Solution + bc_a1 -> C, + bc_a4 -> C, + CFC11 -> CFCl3, + CFC12 -> CF2Cl2, + CH4, + CO2, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + H2O2, + H2SO4, + N2O, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + num_a1 -> H, + num_a2 -> H, + num_a3 -> H, + num_a4 -> H, + pom_a1 -> C, + pom_a4 -> C, + SO2, + so4_a1 -> NH4HSO4, + so4_a2 -> NH4HSO4, + so4_a3 -> NH4HSO4, + soa_a1 -> C, + soa_a2 -> C, + SOAE -> C, + SOAG -> C, + H2O + End Solution + + + Fixed + M, O2, N2, HO2, OH, NO3, O3, HALONS->CFCl3 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + + End Not-Transported + + END Species + + + Solution classes + Explicit + CO2 + End Explicit + + Implicit + bc_a1 + bc_a4 + CFC11 + CFC12 + CH4 + DMS + dst_a1 + dst_a2 + dst_a3 + H2O2 + H2SO4 + N2O + ncl_a1 + ncl_a2 + ncl_a3 + num_a1 + num_a2 + num_a3 + num_a4 + pom_a1 + pom_a4 + SO2 + so4_a1 + so4_a2 + so4_a3 + soa_a1 + soa_a2 + SOAE + SOAG + H2O + End Implicit + + End Solution classes + + + CHEMISTRY + Photolysis +********************************* +*** odd-oxygen +********************************* +[jh2o2] H2O2 + hv -> 2*OH +********************************* +*** soa +********************************* +[jsoa_a1->,.0004*jno2] soa_a1 + hv -> +[jsoa_a2->,.0004*jno2] soa_a2 + hv -> + End Photolysis + + Reactions +********************************* +*** odd-hydrogen +********************************* +[lyman_alpha] H2O -> +[OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.8e-12 +[usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2 +********************************* +*** odd-nitrogen +********************************* +[n2o_loss] N2O -> +********************************* +*** odd-chlorine +********************************* +[cfc11_loss] CFC11 -> +[cfc12_loss] CFC12 -> +********************************* +*** C1 +********************************* +[ch4_loss] CH4 -> 2*H2O +********************************* +*** Sulfur +********************************* +[DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 +[DMS_OHa] DMS + OH -> SO2 ; 1.1e-11, -280 +[SO2_OH_M] SO2 + OH + M -> H2SO4 ; 2.9e-31, 4.1, 1.7e-12, -0.2, 0.6 +[usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 +********************************* +*** SOA +********************************* +[SOAE_tau] SOAE -> SOAG ; 1.157e-05 + End Reactions + + Ext Forcing + bc_a1 <- dataset + bc_a4 <- dataset + H2O <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset + pom_a1 <- dataset + pom_a4 <- dataset + SO2 <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + End Ext Forcing + + End Chemistry + +SIMULATION PARAMETERS + + Version Options + model = cam + machine = intel + architecture = hybrid + vec_ftns = on + multitask = on + namemod = on + modules = on + End Version Options + +End Simulation Parameters diff --git a/src/chemistry/pp_ghg_mam4/chem_mods.F90 b/src/chemistry/pp_ghg_mam4/chem_mods.F90 new file mode 100644 index 0000000000..a6f3071ca0 --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/chem_mods.F90 @@ -0,0 +1,50 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 3, & ! number of photolysis reactions + rxntot = 15, & ! number of total reactions + gascnt = 12, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 31, & ! number of "gas phase" species + nfs = 8, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 35, & ! number of non-zero matrix entries + extcnt = 11, & ! number of species with external forcing + clscnt1 = 1, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 30, & ! 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 = 15, & + enthalpy_cnt = 0, & + nslvd = 0 + 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)) + end module chem_mods diff --git a/src/chemistry/pp_ghg_mam4/m_rxt_id.F90 b/src/chemistry/pp_ghg_mam4/m_rxt_id.F90 new file mode 100644 index 0000000000..2c6a0ed8db --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/m_rxt_id.F90 @@ -0,0 +1,18 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o2 = 1 + integer, parameter :: rid_jsoa_a1 = 2 + integer, parameter :: rid_jsoa_a2 = 3 + integer, parameter :: rid_lyman_alpha = 4 + integer, parameter :: rid_OH_H2O2 = 5 + integer, parameter :: rid_usr_HO2_HO2 = 6 + integer, parameter :: rid_n2o_loss = 7 + integer, parameter :: rid_cfc11_loss = 8 + integer, parameter :: rid_cfc12_loss = 9 + integer, parameter :: rid_ch4_loss = 10 + integer, parameter :: rid_DMS_NO3 = 11 + integer, parameter :: rid_DMS_OHa = 12 + integer, parameter :: rid_SO2_OH_M = 13 + integer, parameter :: rid_usr_DMS_OH = 14 + integer, parameter :: rid_SOAE_tau = 15 + end module m_rxt_id diff --git a/src/chemistry/pp_ghg_mam4/m_spc_id.F90 b/src/chemistry/pp_ghg_mam4/m_spc_id.F90 new file mode 100644 index 0000000000..c4bfbe7ef3 --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/m_spc_id.F90 @@ -0,0 +1,34 @@ + module m_spc_id + implicit none + integer, parameter :: id_bc_a1 = 1 + integer, parameter :: id_bc_a4 = 2 + integer, parameter :: id_CFC11 = 3 + integer, parameter :: id_CFC12 = 4 + integer, parameter :: id_CH4 = 5 + integer, parameter :: id_CO2 = 6 + integer, parameter :: id_DMS = 7 + integer, parameter :: id_dst_a1 = 8 + integer, parameter :: id_dst_a2 = 9 + integer, parameter :: id_dst_a3 = 10 + integer, parameter :: id_H2O2 = 11 + integer, parameter :: id_H2SO4 = 12 + integer, parameter :: id_N2O = 13 + integer, parameter :: id_ncl_a1 = 14 + integer, parameter :: id_ncl_a2 = 15 + integer, parameter :: id_ncl_a3 = 16 + integer, parameter :: id_num_a1 = 17 + integer, parameter :: id_num_a2 = 18 + integer, parameter :: id_num_a3 = 19 + integer, parameter :: id_num_a4 = 20 + integer, parameter :: id_pom_a1 = 21 + integer, parameter :: id_pom_a4 = 22 + integer, parameter :: id_SO2 = 23 + integer, parameter :: id_so4_a1 = 24 + integer, parameter :: id_so4_a2 = 25 + integer, parameter :: id_so4_a3 = 26 + integer, parameter :: id_soa_a1 = 27 + integer, parameter :: id_soa_a2 = 28 + integer, parameter :: id_SOAE = 29 + integer, parameter :: id_SOAG = 30 + integer, parameter :: id_H2O = 31 + end module m_spc_id diff --git a/src/chemistry/pp_ghg_mam4/mo_adjrxt.F90 b/src/chemistry/pp_ghg_mam4/mo_adjrxt.F90 new file mode 100644 index 0000000000..09ad314f66 --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/mo_adjrxt.F90 @@ -0,0 +1,28 @@ + 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) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + real(r8) :: im(ncol,nlev) + im(:,:) = 1._r8 / m(:,:) + rate(:,:, 5) = rate(:,:, 5) * inv(:,:, 5) + rate(:,:, 11) = rate(:,:, 11) * inv(:,:, 6) + rate(:,:, 12) = rate(:,:, 12) * inv(:,:, 5) + rate(:,:, 14) = rate(:,:, 14) * inv(:,:, 5) + rate(:,:, 6) = rate(:,:, 6) * inv(:,:, 4) * inv(:,:, 4) * im(:,:) + rate(:,:, 13) = rate(:,:, 13) * inv(:,:, 5) * inv(:,:, 1) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_ghg_mam4/mo_exp_sol.F90 b/src/chemistry/pp_ghg_mam4/mo_exp_sol.F90 new file mode 100644 index 0000000000..cfde22391a --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/mo_exp_sol.F90 @@ -0,0 +1,79 @@ +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 ppgrid, only : pver + 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 + real(r8), dimension(ncol,pver,clscnt1) :: & + prod, & + loss, & + ind_prd + real(r8), dimension(ncol,pver) :: wrk + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, ncol ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) + !----------------------------------------------------------------------- + ! ... 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_ghg_mam4/mo_imp_sol.F90 b/src/chemistry/pp_ghg_mam4/mo_imp_sol.F90 new file mode 100644 index 0000000000..d885728ba4 --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/mo_imp_sol.F90 @@ -0,0 +1,392 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap + 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 :: 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 small l1 cache machines such as + ! the intel pentium and itanium cpus + !----------------------------------------------------------------------- + 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, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt + integer :: nstep + real(r8) :: interval_done, dt, dti + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd + logical :: convergence + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 + !----------------------------------------------------------------------- + ! ... 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, ncol ) + else + do m = 1,max(1,clscnt4) + ind_prd(:,:,m) = 0._r8 + end do + end if + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,m) + end do + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) + end do + end if + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt + !----------------------------------------------------------------------- + ! ... transfer from base to local work arrays + !----------------------------------------------------------------------- + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) + 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 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) + end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + 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( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if + end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) + end do + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if + end if + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt + end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) + end do + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop + !----------------------------------------------------------------------- + ! ... Transfer latest solution back to base array + !----------------------------------------------------------------------- + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_ghg_mam4/mo_indprd.F90 b/src/chemistry/pp_ghg_mam4/mo_indprd.F90 new file mode 100644 index 0000000000..6906fcf304 --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/mo_indprd.F90 @@ -0,0 +1,61 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: ncol + integer, intent(in) :: nprod + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,:,1) = 0._r8 +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,:,1) = + extfrc(:,:,1) + prod(:,:,2) = + extfrc(:,:,2) + prod(:,:,3) = 0._r8 + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) =rxt(:,:,6) + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = + extfrc(:,:,4) + prod(:,:,17) = + extfrc(:,:,5) + prod(:,:,18) = 0._r8 + prod(:,:,19) = + extfrc(:,:,6) + prod(:,:,20) = + extfrc(:,:,7) + prod(:,:,21) = + extfrc(:,:,8) + prod(:,:,22) = + extfrc(:,:,9) + prod(:,:,23) = + extfrc(:,:,10) + prod(:,:,24) = + extfrc(:,:,11) + prod(:,:,25) = 0._r8 + prod(:,:,26) = 0._r8 + prod(:,:,27) = 0._r8 + prod(:,:,28) = 0._r8 + prod(:,:,29) = 0._r8 + prod(:,:,30) = + extfrc(:,:,3) + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_ghg_mam4/mo_lin_matrix.F90 b/src/chemistry/pp_ghg_mam4/mo_lin_matrix.F90 new file mode 100644 index 0000000000..7b32b664f5 --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/mo_lin_matrix.F90 @@ -0,0 +1,71 @@ + module mo_lin_matrix + private + public :: linmat + contains + subroutine linmat01( 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 +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(1) = -( het_rates(1) ) + mat(2) = -( het_rates(2) ) + mat(3) = -( rxt(8) + het_rates(3) ) + mat(4) = -( rxt(9) + het_rates(4) ) + mat(5) = -( rxt(10) + het_rates(5) ) + mat(7) = -( rxt(11) + rxt(12) + rxt(14) + het_rates(7) ) + mat(9) = -( het_rates(8) ) + mat(10) = -( het_rates(9) ) + mat(11) = -( het_rates(10) ) + mat(12) = -( rxt(1) + rxt(5) + het_rates(11) ) + mat(14) = -( het_rates(12) ) + mat(25) = rxt(13) + mat(15) = -( rxt(7) + het_rates(13) ) + mat(16) = -( het_rates(14) ) + mat(17) = -( het_rates(15) ) + mat(18) = -( het_rates(16) ) + mat(19) = -( het_rates(17) ) + mat(20) = -( het_rates(18) ) + mat(21) = -( het_rates(19) ) + mat(22) = -( het_rates(20) ) + mat(23) = -( het_rates(21) ) + mat(24) = -( het_rates(22) ) + mat(26) = -( rxt(13) + het_rates(23) ) + mat(8) = rxt(11) + rxt(12) + .500_r8*rxt(14) + mat(27) = -( het_rates(24) ) + mat(28) = -( het_rates(25) ) + mat(29) = -( het_rates(26) ) + mat(30) = -( rxt(2) + het_rates(27) ) + mat(31) = -( rxt(3) + het_rates(28) ) + mat(32) = -( rxt(15) + het_rates(29) ) + mat(34) = -( het_rates(30) ) + mat(33) = rxt(15) + mat(35) = -( rxt(4) + het_rates(31) ) + mat(13) = rxt(5) + mat(6) = 2.000_r8*rxt(10) + end subroutine linmat01 + subroutine linmat( 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 +!---------------------------------------------- + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_ghg_mam4/mo_lu_factor.F90 b/src/chemistry/pp_ghg_mam4/mo_lu_factor.F90 new file mode 100644 index 0000000000..d981e77137 --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/mo_lu_factor.F90 @@ -0,0 +1,56 @@ + module mo_lu_factor + private + public :: lu_fac + contains + subroutine lu_fac01( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = 1._r8 / lu(2) + lu(3) = 1._r8 / lu(3) + lu(4) = 1._r8 / lu(4) + lu(5) = 1._r8 / lu(5) + lu(6) = lu(6) * lu(5) + lu(7) = 1._r8 / lu(7) + lu(8) = lu(8) * lu(7) + lu(9) = 1._r8 / lu(9) + lu(10) = 1._r8 / lu(10) + lu(11) = 1._r8 / lu(11) + lu(12) = 1._r8 / lu(12) + lu(13) = lu(13) * lu(12) + lu(14) = 1._r8 / lu(14) + lu(15) = 1._r8 / lu(15) + lu(16) = 1._r8 / lu(16) + lu(17) = 1._r8 / lu(17) + lu(18) = 1._r8 / lu(18) + lu(19) = 1._r8 / lu(19) + lu(20) = 1._r8 / lu(20) + lu(21) = 1._r8 / lu(21) + lu(22) = 1._r8 / lu(22) + lu(23) = 1._r8 / lu(23) + lu(24) = 1._r8 / lu(24) + lu(26) = 1._r8 / lu(26) + lu(27) = 1._r8 / lu(27) + lu(28) = 1._r8 / lu(28) + lu(29) = 1._r8 / lu(29) + lu(30) = 1._r8 / lu(30) + lu(31) = 1._r8 / lu(31) + lu(32) = 1._r8 / lu(32) + lu(33) = lu(33) * lu(32) + lu(34) = 1._r8 / lu(34) + lu(35) = 1._r8 / lu(35) + end subroutine lu_fac01 + subroutine lu_fac( lu ) + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_ghg_mam4/mo_lu_solve.F90 b/src/chemistry/pp_ghg_mam4/mo_lu_solve.F90 new file mode 100644 index 0000000000..574861e9b1 --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/mo_lu_solve.F90 @@ -0,0 +1,87 @@ + module mo_lu_solve + private + public :: lu_slv + contains + subroutine lu_slv01( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + b(30) = b(30) - lu(6) * b(5) + b(22) = b(22) - lu(8) * b(6) + b(30) = b(30) - lu(13) * b(10) + b(29) = b(29) - lu(33) * b(28) + end subroutine lu_slv01 + subroutine lu_slv02( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(30) = b(30) * lu(35) + b(29) = b(29) * lu(34) + b(28) = b(28) * lu(32) + b(27) = b(27) * lu(31) + b(26) = b(26) * lu(30) + b(25) = b(25) * lu(29) + b(24) = b(24) * lu(28) + b(23) = b(23) * lu(27) + b(22) = b(22) * lu(26) + b(11) = b(11) - lu(25) * b(22) + b(21) = b(21) * lu(24) + b(20) = b(20) * lu(23) + b(19) = b(19) * lu(22) + b(18) = b(18) * lu(21) + b(17) = b(17) * lu(20) + b(16) = b(16) * lu(19) + b(15) = b(15) * lu(18) + b(14) = b(14) * lu(17) + b(13) = b(13) * lu(16) + b(12) = b(12) * lu(15) + b(11) = b(11) * lu(14) + b(10) = b(10) * lu(12) + b(9) = b(9) * lu(11) + b(8) = b(8) * lu(10) + b(7) = b(7) * lu(9) + b(6) = b(6) * lu(7) + b(5) = b(5) * lu(5) + b(4) = b(4) * lu(4) + b(3) = b(3) * lu(3) + b(2) = b(2) * lu(2) + b(1) = b(1) * lu(1) + end subroutine lu_slv02 + subroutine lu_slv( lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_ghg_mam4/mo_nln_matrix.F90 b/src/chemistry/pp_ghg_mam4/mo_nln_matrix.F90 new file mode 100644 index 0000000000..c48389b422 --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/mo_nln_matrix.F90 @@ -0,0 +1,100 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: nlnmat + contains + subroutine nlnmat( mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat_finit( mat, lmat, dti ) + end subroutine nlnmat + subroutine nlnmat_finit( mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = lmat( 4) + mat( 5) = lmat( 5) + mat( 6) = lmat( 6) + mat( 7) = lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = lmat( 12) + mat( 13) = lmat( 13) + mat( 14) = lmat( 14) + mat( 15) = lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = lmat( 17) + mat( 18) = lmat( 18) + mat( 19) = lmat( 19) + mat( 20) = lmat( 20) + mat( 21) = lmat( 21) + mat( 22) = lmat( 22) + mat( 23) = lmat( 23) + mat( 24) = lmat( 24) + mat( 25) = lmat( 25) + mat( 26) = lmat( 26) + mat( 27) = lmat( 27) + mat( 28) = lmat( 28) + mat( 29) = lmat( 29) + mat( 30) = lmat( 30) + mat( 31) = lmat( 31) + mat( 32) = lmat( 32) + mat( 33) = lmat( 33) + mat( 34) = lmat( 34) + mat( 35) = lmat( 35) + mat( 1) = mat( 1) - dti + mat( 2) = mat( 2) - dti + mat( 3) = mat( 3) - dti + mat( 4) = mat( 4) - dti + mat( 5) = mat( 5) - dti + mat( 7) = mat( 7) - dti + mat( 9) = mat( 9) - dti + mat( 10) = mat( 10) - dti + mat( 11) = mat( 11) - dti + mat( 12) = mat( 12) - dti + mat( 14) = mat( 14) - dti + mat( 15) = mat( 15) - dti + mat( 16) = mat( 16) - dti + mat( 17) = mat( 17) - dti + mat( 18) = mat( 18) - dti + mat( 19) = mat( 19) - dti + mat( 20) = mat( 20) - dti + mat( 21) = mat( 21) - dti + mat( 22) = mat( 22) - dti + mat( 23) = mat( 23) - dti + mat( 24) = mat( 24) - dti + mat( 26) = mat( 26) - dti + mat( 27) = mat( 27) - dti + mat( 28) = mat( 28) - dti + mat( 29) = mat( 29) - dti + mat( 30) = mat( 30) - dti + mat( 31) = mat( 31) - dti + mat( 32) = mat( 32) - dti + mat( 34) = mat( 34) - dti + mat( 35) = mat( 35) - dti + end subroutine nlnmat_finit + end module mo_nln_matrix diff --git a/src/chemistry/pp_ghg_mam4/mo_phtadj.F90 b/src/chemistry/pp_ghg_mam4/mo_phtadj.F90 new file mode 100644 index 0000000000..aaa43829fe --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/mo_phtadj.F90 @@ -0,0 +1,24 @@ + 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 + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_ghg_mam4/mo_prod_loss.F90 b/src/chemistry/pp_ghg_mam4/mo_prod_loss.F90 new file mode 100644 index 0000000000..d502e216a3 --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/mo_prod_loss.F90 @@ -0,0 +1,101 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:,:,:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + loss(:,:,1) = ( + het_rates(:,:,6))* y(:,:,6) + prod(:,:,1) = 0._r8 + end subroutine exp_prod_loss + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + real(r8), dimension(:), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + loss(1) = ( + het_rates(1))* y(1) + prod(1) = 0._r8 + loss(2) = ( + het_rates(2))* y(2) + prod(2) = 0._r8 + loss(3) = ( + rxt(8) + het_rates(3))* y(3) + prod(3) = 0._r8 + loss(4) = ( + rxt(9) + het_rates(4))* y(4) + prod(4) = 0._r8 + loss(5) = ( + rxt(10) + het_rates(5))* y(5) + prod(5) = 0._r8 + loss(6) = ( + rxt(11) + rxt(12) + rxt(14) + het_rates(7))* y(7) + prod(6) = 0._r8 + loss(7) = ( + het_rates(8))* y(8) + prod(7) = 0._r8 + loss(8) = ( + het_rates(9))* y(9) + prod(8) = 0._r8 + loss(9) = ( + het_rates(10))* y(10) + prod(9) = 0._r8 + loss(10) = ( + rxt(1) + rxt(5) + het_rates(11))* y(11) + prod(10) = 0._r8 + loss(11) = ( + het_rates(12))* y(12) + prod(11) =rxt(13)*y(23) + loss(12) = ( + rxt(7) + het_rates(13))* y(13) + prod(12) = 0._r8 + loss(13) = ( + het_rates(14))* y(14) + prod(13) = 0._r8 + loss(14) = ( + het_rates(15))* y(15) + prod(14) = 0._r8 + loss(15) = ( + het_rates(16))* y(16) + prod(15) = 0._r8 + loss(16) = ( + het_rates(17))* y(17) + prod(16) = 0._r8 + loss(17) = ( + het_rates(18))* y(18) + prod(17) = 0._r8 + loss(18) = ( + het_rates(19))* y(19) + prod(18) = 0._r8 + loss(19) = ( + het_rates(20))* y(20) + prod(19) = 0._r8 + loss(20) = ( + het_rates(21))* y(21) + prod(20) = 0._r8 + loss(21) = ( + het_rates(22))* y(22) + prod(21) = 0._r8 + loss(22) = ( + rxt(13) + het_rates(23))* y(23) + prod(22) = (rxt(11) +rxt(12) +.500_r8*rxt(14))*y(7) + loss(23) = ( + het_rates(24))* y(24) + prod(23) = 0._r8 + loss(24) = ( + het_rates(25))* y(25) + prod(24) = 0._r8 + loss(25) = ( + het_rates(26))* y(26) + prod(25) = 0._r8 + loss(26) = ( + rxt(2) + het_rates(27))* y(27) + prod(26) = 0._r8 + loss(27) = ( + rxt(3) + het_rates(28))* y(28) + prod(27) = 0._r8 + loss(28) = ( + rxt(15) + het_rates(29))* y(29) + prod(28) = 0._r8 + loss(29) = ( + het_rates(30))* y(30) + prod(29) =rxt(15)*y(29) + loss(30) = ( + rxt(4) + het_rates(31))* y(31) + prod(30) =2.000_r8*rxt(10)*y(5) +rxt(5)*y(11) + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_ghg_mam4/mo_rxt_rates_conv.F90 b/src/chemistry/pp_ghg_mam4/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..0030b06714 --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/mo_rxt_rates_conv.F90 @@ -0,0 +1,27 @@ +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,:, 11) ! rate_const*H2O2 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 27) ! rate_const*soa_a1 + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 28) ! rate_const*soa_a2 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 31) ! rate_const*H2O + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 11) ! rate_const*OH*H2O2 + ! rate_const + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 13) ! rate_const*N2O + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 3) ! rate_const*CFC11 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 4) ! rate_const*CFC12 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 5) ! rate_const*CH4 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 7) ! rate_const*NO3*DMS + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 7) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 23) ! rate_const*OH*M*SO2 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 7) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 29) ! rate_const*SOAE + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_ghg_mam4/mo_setrxt.F90 b/src/chemistry/pp_ghg_mam4/mo_setrxt.F90 new file mode 100644 index 0000000000..6b94705faa --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/mo_setrxt.F90 @@ -0,0 +1,85 @@ + + 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 : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + 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,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + real(r8) :: ko(ncol,pver) + real(r8) :: kinf(ncol,pver) + + rate(:,:,5) = 1.8e-12_r8 + rate(:,:,15) = 1.157e-05_r8 + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) + n = ncol*pver + rate(:,:,11) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) ) + rate(:,:,12) = 1.1e-11_r8 * exp( -280._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 2.9e-31_r8 * itemp(:,:)**4.1_r8 + kinf(:,:) = 1.7e-12_r8 * itemp(:,:)**(-0.2_r8) + call jpl( rate(1,1,13), m, 0.6_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 + 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,rxntot) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + 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) + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_ghg_mam4/mo_sim_dat.F90 b/src/chemistry/pp_ghg_mam4/mo_sim_dat.F90 new file mode 100644 index 0000000000..04177a1f6e --- /dev/null +++ b/src/chemistry/pp_ghg_mam4/mo_sim_dat.F90 @@ -0,0 +1,146 @@ + + 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 = .true. + is_vector = .false. + + clscnt(:) = (/ 1, 0, 0, 30, 0 /) + + cls_rxt_cnt(:,1) = (/ 0, 0, 0, 1 /) + cls_rxt_cnt(:,4) = (/ 1, 14, 0, 30 /) + + solsym(: 31) = (/ 'bc_a1 ','bc_a4 ','CFC11 ','CFC12 ','CH4 ', & + 'CO2 ','DMS ','dst_a1 ','dst_a2 ','dst_a3 ', & + 'H2O2 ','H2SO4 ','N2O ','ncl_a1 ','ncl_a2 ', & + 'ncl_a3 ','num_a1 ','num_a2 ','num_a3 ','num_a4 ', & + 'pom_a1 ','pom_a4 ','SO2 ','so4_a1 ','so4_a2 ', & + 'so4_a3 ','soa_a1 ','soa_a2 ','SOAE ','SOAG ', & + 'H2O ' /) + + adv_mass(: 31) = (/ 12.011000_r8, 12.011000_r8, 137.367503_r8, 120.913206_r8, 16.040600_r8, & + 44.009800_r8, 62.132400_r8, 135.064039_r8, 135.064039_r8, 135.064039_r8, & + 34.013600_r8, 98.078400_r8, 44.012880_r8, 58.442468_r8, 58.442468_r8, & + 58.442468_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, & + 12.011000_r8, 12.011000_r8, 64.064800_r8, 115.107340_r8, 115.107340_r8, & + 115.107340_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 18.014200_r8 /) + + crb_mass(: 31) = (/ 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_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, 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, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 0.000000_r8 /) + + fix_mass(: 8) = (/ 0.00000000_r8, 31.9988000_r8, 28.0134800_r8, 33.0062000_r8, 17.0068000_r8, & + 62.0049400_r8, 47.9982000_r8, 137.367503_r8 /) + + clsmap(: 1,1) = (/ 6 /) + clsmap(: 30,4) = (/ 1, 2, 3, 4, 5, 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 /) + + permute(: 30,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 /) + + diag_map(: 30) = (/ 1, 2, 3, 4, 5, 7, 9, 10, 11, 12, & + 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, & + 24, 26, 27, 28, 29, 30, 31, 32, 34, 35 /) + + extfrc_lst(: 11) = (/ 'bc_a1 ','bc_a4 ','H2O ','num_a1 ','num_a2 ', & + 'num_a4 ','pom_a1 ','pom_a4 ','SO2 ','so4_a1 ', & + 'so4_a2 ' /) + + frc_from_dataset(: 11) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true. /) + + inv_lst(: 8) = (/ 'M ', 'O2 ', 'N2 ', 'HO2 ', 'OH ', & + 'NO3 ', 'O3 ', 'HALONS ' /) + + 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: 15) = (/ 'jh2o2 ', 'jsoa_a1 ', & + 'jsoa_a2 ', 'lyman_alpha ', & + 'OH_H2O2 ', 'usr_HO2_HO2 ', & + 'n2o_loss ', 'cfc11_loss ', & + 'cfc12_loss ', 'ch4_loss ', & + 'DMS_NO3 ', 'DMS_OHa ', & + 'SO2_OH_M ', 'usr_DMS_OH ', & + 'SOAE_tau ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15 /) + 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) = (/ ' ', ' ', ' ' /) + pht_alias_lst(:,2) = (/ ' ', 'jno2 ', 'jno2 ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, .0004_r8, .0004_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(:) = (/ 1, 2, 2, 1, 1, 1, 1, 2, 2, 3, & + 2, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_none/chemistry.F90 b/src/chemistry/pp_none/chemistry.F90 index bdb8c9ae0b..9da9aa0852 100644 --- a/src/chemistry/pp_none/chemistry.F90 +++ b/src/chemistry/pp_none/chemistry.F90 @@ -7,7 +7,7 @@ module chemistry use shr_kind_mod, only: r8 => shr_kind_r8 use physics_types, only: physics_state, physics_ptend use ppgrid, only: begchunk, endchunk, pcols - + implicit none private @@ -27,9 +27,10 @@ module chemistry public :: chem_write_restart public :: chem_read_restart public :: chem_init_restart - public :: chem_readnl ! read chem namelist + public :: chem_readnl ! read chem namelist public :: chem_reset_fluxes public :: chem_emissions + public :: chem_has_ndep_flx interface chem_write_restart module procedure chem_write_restart_bin @@ -40,6 +41,8 @@ module chemistry module procedure chem_read_restart_pio end interface + logical, parameter :: chem_has_ndep_flx = .false. + ! Private data !================================================================================================ @@ -61,10 +64,10 @@ end function chem_is subroutine chem_register use aero_model, only : aero_model_register - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: register advected constituents for parameterized greenhouse gas chemistry - ! + ! !----------------------------------------------------------------------- ! for prescribed aerosols @@ -95,12 +98,12 @@ end function chem_is_active !================================================================================================ function chem_implements_cnst(name) - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: return true if specified constituent is implemented by this package - ! + ! ! Author: B. Eaton - ! + ! !----------------------------------------------------------------------- implicit none !-----------------------------Arguments--------------------------------- @@ -115,11 +118,11 @@ end function chem_implements_cnst !=============================================================================== subroutine chem_init(phys_state, pbuf2d) - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: initialize parameterized greenhouse gas chemistry ! (declare history variables) - ! + ! !----------------------------------------------------------------------- use physics_buffer, only : physics_buffer_desc use aero_model, only : aero_model_init @@ -138,7 +141,7 @@ subroutine chem_timestep_init(phys_state, pbuf2d) use physics_buffer, only : physics_buffer_desc use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & is_perpetual - type(physics_state), intent(in):: phys_state(begchunk:endchunk) + type(physics_state), intent(in):: phys_state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -162,7 +165,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o) type(cam_out_t), intent(in) :: cam_out type(physics_buffer_desc), pointer :: pbuf(:) real(r8), optional, intent(out) :: fh2o(pcols) ! h2o flux to balance source from chemistry - + return end subroutine chem_timestep_tend @@ -215,20 +218,22 @@ subroutine chem_init_restart(File) end subroutine chem_init_restart !================================================================================ subroutine chem_reset_fluxes( fptr, cam_in ) - use camsrfexch, only : cam_in_t + use camsrfexch, only : cam_in_t real(r8), pointer :: fptr(:,:) ! pointer into array data type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) end subroutine chem_reset_fluxes !================================================================================ - subroutine chem_emissions( state, cam_in ) - use camsrfexch, only: cam_in_t + subroutine chem_emissions( state, cam_in, pbuf ) + use camsrfexch, only: cam_in_t + use physics_buffer, only: physics_buffer_desc ! Arguments: type(physics_state), intent(in) :: state ! Physics state variables type(cam_in_t), intent(inout) :: cam_in ! import state + type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer in chunk, for HEMCO end subroutine chem_emissions end module chemistry diff --git a/src/chemistry/pp_terminator/chemistry.F90 b/src/chemistry/pp_terminator/chemistry.F90 index 20d24047a5..b1e82d8d65 100644 --- a/src/chemistry/pp_terminator/chemistry.F90 +++ b/src/chemistry/pp_terminator/chemistry.F90 @@ -32,9 +32,10 @@ module chemistry public :: chem_write_restart public :: chem_read_restart public :: chem_init_restart - public :: chem_readnl ! read chem namelist + public :: chem_readnl ! read chem namelist public :: chem_reset_fluxes public :: chem_emissions + public :: chem_has_ndep_flx interface chem_write_restart module procedure chem_write_restart_bin @@ -45,9 +46,11 @@ module chemistry module procedure chem_read_restart_pio end interface + logical, parameter :: chem_has_ndep_flx = .false. + ! Private data integer, parameter :: nspecies = 3 - + integer :: idx_cl =-1 integer :: idx_cl2=-1 @@ -75,10 +78,10 @@ end function chem_is !================================================================================================ subroutine chem_register - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: register advected constituents for parameterized greenhouse gas chemistry - ! + ! !----------------------------------------------------------------------- real(r8), parameter :: cptmp = 666._r8 @@ -86,10 +89,10 @@ subroutine chem_register logical :: camout integer :: i, n - + do i = 1, nspecies camout = trim(species(i)) .eq. 'RHO' - call cnst_add( species(i), adv_mass(i), cptmp, qmin, n, & + call cnst_add( species(i), adv_mass(i), cptmp, qmin, n, & readiv=.true.,mixtype='dry',cam_outfld=camout) indices(i) = n map2chm(n) = i @@ -123,12 +126,12 @@ end function chem_is_active !================================================================================================ function chem_implements_cnst(name) - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: return true if specified constituent is implemented by this package - ! + ! ! Author: B. Eaton - ! + ! !----------------------------------------------------------------------- implicit none !-----------------------------Arguments--------------------------------- @@ -137,7 +140,7 @@ function chem_implements_cnst(name) logical :: chem_implements_cnst ! return value integer :: i - + chem_implements_cnst = .false. do i = 1, nspecies @@ -150,13 +153,13 @@ function chem_implements_cnst(name) end function chem_implements_cnst !=============================================================================== - + subroutine chem_init(phys_state, pbuf2d) - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: initialize parameterized greenhouse gas chemistry ! (declare history variables) - ! + ! !----------------------------------------------------------------------- use physics_buffer, only: physics_buffer_desc use cam_history, only: addfld, add_default, horiz_only @@ -196,7 +199,7 @@ end subroutine chem_init subroutine chem_timestep_init(phys_state, pbuf2d) use physics_buffer, only: physics_buffer_desc - type(physics_state), intent(in):: phys_state(begchunk:endchunk) + type(physics_state), intent(in):: phys_state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) end subroutine chem_timestep_init @@ -222,7 +225,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o ) real(r8), optional, intent(out) :: fh2o(pcols) ! h2o flux to balance source from chemistry real(r8) :: a(pver),b(pver),c(pver),d(pver) - + real(r8) :: k1(pcols) real(r8) :: k2(pcols) @@ -278,7 +281,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o ) l(i,:) = (1._r8 - e(i,:))/det(i,:)/dt elsewhere l(i,:) = 4._r8*k2(i) - endwhere + endwhere cl_f(i,:) = -l(i,:)*(cl(i,:) - det(i,:) + r(i) )*(cl(i,:) + det(i,:) + r(i)) / ( 1._r8 +e(i,:) + dt*l(i,:)*(cl(i,:) + r(i))) cl2_f(i,:) = -cl_f(i,:) / 2._r8 @@ -325,7 +328,7 @@ subroutine chem_init_cnst(name, latvals, lonvals, mask, q) real(r8) :: q_vmr(size(q, 1)) ! volume mixing ratio (ncol) real(r8) :: det(size(q, 1)) real(r8) :: krat(size(q, 1)) - + real(r8) :: k1(size(q, 1)) real(r8) :: k2(size(q, 1)) @@ -347,7 +350,7 @@ subroutine chem_init_cnst(name, latvals, lonvals, mask, q) krat(:) = k1(:) / (4._r8 * k2(:)) h = init_vmr_cl + 2._r8 * init_vmr_cl2 - + det(:) = sqrt(krat(:) * krat(:) + 2._r8 * h * krat(:)) if (trim(name) == trim(species(1)) ) then @@ -412,20 +415,22 @@ subroutine chem_init_restart(File) end subroutine chem_init_restart !================================================================================ subroutine chem_reset_fluxes( fptr, cam_in ) - use camsrfexch, only : cam_in_t + use camsrfexch, only : cam_in_t real(r8), pointer :: fptr(:,:) ! pointer into array data type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) end subroutine chem_reset_fluxes !================================================================================ - subroutine chem_emissions( state, cam_in ) - use camsrfexch, only: cam_in_t + subroutine chem_emissions( state, cam_in, pbuf ) + use camsrfexch, only: cam_in_t + use physics_buffer, only: physics_buffer_desc ! Arguments: type(physics_state), intent(in) :: state ! Physics state variables type(cam_in_t), intent(inout) :: cam_in ! import state + type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer in chunk, for HEMCO end subroutine chem_emissions diff --git a/src/chemistry/pp_trop_mam3/chem_mech.doc b/src/chemistry/pp_trop_mam3/chem_mech.doc index e5769cb859..1ef4eb8658 100644 --- a/src/chemistry/pp_trop_mam3/chem_mech.doc +++ b/src/chemistry/pp_trop_mam3/chem_mech.doc @@ -70,7 +70,7 @@ Class List Reactions usr_HO2_HO2 ( 1) HO2 + HO2 -> H2O2 rate = ** User defined ** ( 2) - ( 2) H2O2 + OH -> H2O + HO2 rate = 2.90E-12*exp( -160./t) ( 3) + ( 2) H2O2 + OH -> H2O + HO2 rate = 1.80E-12 ( 3) usr_SO2_OH ( 3) SO2 + OH -> H2SO4 rate = ** User defined ** ( 4) ( 4) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) ( 5) usr_DMS_OH ( 5) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** ( 6) diff --git a/src/chemistry/pp_trop_mam3/chem_mech.in b/src/chemistry/pp_trop_mam3/chem_mech.in index b6584d0ff2..9474c4d8a1 100644 --- a/src/chemistry/pp_trop_mam3/chem_mech.in +++ b/src/chemistry/pp_trop_mam3/chem_mech.in @@ -47,7 +47,7 @@ Reactions [usr_HO2_HO2] HO2 + HO2 -> H2O2 - H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 + H2O2 + OH -> H2O + HO2 ; 1.8e-12 [usr_SO2_OH] SO2 + OH -> H2SO4 DMS + OH -> SO2 ; 9.6e-12, -234. [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 diff --git a/src/chemistry/pp_trop_mam3/mo_setrxt.F90 b/src/chemistry/pp_trop_mam3/mo_setrxt.F90 index 261e09cf50..f73dcfea9d 100644 --- a/src/chemistry/pp_trop_mam3/mo_setrxt.F90 +++ b/src/chemistry/pp_trop_mam3/mo_setrxt.F90 @@ -33,9 +33,9 @@ subroutine setrxt( rate, temp, m, ncol ) real(r8) :: itemp(ncol,pver) real(r8) :: exp_fac(ncol,pver) + rate(:,:,3) = 1.8e-12_r8 itemp(:ncol,:) = 1._r8 / temp(:ncol,:) n = ncol*pver - rate(:,:,3) = 2.9e-12_r8 * exp( -160._r8 * itemp(:,:) ) rate(:,:,5) = 9.6e-12_r8 * exp( -234._r8 * itemp(:,:) ) rate(:,:,7) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) ) diff --git a/src/chemistry/pp_trop_mam4/chem_mech.doc b/src/chemistry/pp_trop_mam4/chem_mech.doc index e2158e70f9..66cc96de5c 100644 --- a/src/chemistry/pp_trop_mam4/chem_mech.doc +++ b/src/chemistry/pp_trop_mam4/chem_mech.doc @@ -1,41 +1,42 @@ Solution species - ( 1) H2O2 - ( 2) H2SO4 - ( 3) SO2 - ( 4) DMS (CH3SCH3) - ( 5) SOAG (C) - ( 6) so4_a1 (NH4HSO4) - ( 7) pom_a1 (C) - ( 8) soa_a1 (C) - ( 9) bc_a1 (C) - ( 10) dst_a1 (AlSiO5) - ( 11) ncl_a1 (NaCl) + ( 1) bc_a1 (C) + ( 2) bc_a4 (C) + ( 3) DMS (CH3SCH3) + ( 4) dst_a1 (AlSiO5) + ( 5) dst_a2 (AlSiO5) + ( 6) dst_a3 (AlSiO5) + ( 7) H2O2 + ( 8) H2SO4 + ( 9) ncl_a1 (NaCl) + ( 10) ncl_a2 (NaCl) + ( 11) ncl_a3 (NaCl) ( 12) num_a1 (H) - ( 13) so4_a2 (NH4HSO4) - ( 14) dst_a2 (AlSiO5) - ( 15) soa_a2 (C) - ( 16) ncl_a2 (NaCl) - ( 17) num_a2 (H) - ( 18) dst_a3 (AlSiO5) - ( 19) ncl_a3 (NaCl) - ( 20) so4_a3 (NH4HSO4) - ( 21) num_a3 (H) - ( 22) pom_a4 (C) - ( 23) bc_a4 (C) - ( 24) num_a4 (H) - ( 25) H2O + ( 13) num_a2 (H) + ( 14) num_a3 (H) + ( 15) num_a4 (H) + ( 16) pom_a1 (C) + ( 17) pom_a4 (C) + ( 18) SO2 + ( 19) so4_a1 (NH4HSO4) + ( 20) so4_a2 (NH4HSO4) + ( 21) so4_a3 (NH4HSO4) + ( 22) soa_a1 (C) + ( 23) soa_a2 (C) + ( 24) SOAE (C) + ( 25) SOAG (C) + ( 26) H2O Invariant species ( 1) M - ( 2) N2 - ( 3) O2 + ( 2) O2 + ( 3) OH ( 4) O3 - ( 5) OH - ( 6) NO3 - ( 7) HO2 + ( 5) NO3 + ( 6) HO2 + ( 7) N2 Column integrals @@ -47,42 +48,48 @@ Class List Implicit -------- - ( 1) H2O2 - ( 2) H2SO4 - ( 3) SO2 - ( 4) DMS - ( 5) SOAG - ( 6) so4_a1 - ( 7) pom_a1 - ( 8) soa_a1 - ( 9) bc_a1 - ( 10) dst_a1 - ( 11) ncl_a1 + ( 1) bc_a1 + ( 2) bc_a4 + ( 3) DMS + ( 4) dst_a1 + ( 5) dst_a2 + ( 6) dst_a3 + ( 7) H2O2 + ( 8) H2SO4 + ( 9) ncl_a1 + ( 10) ncl_a2 + ( 11) ncl_a3 ( 12) num_a1 - ( 13) so4_a2 - ( 14) soa_a2 - ( 15) ncl_a2 - ( 16) dst_a2 - ( 17) num_a2 - ( 18) dst_a3 - ( 19) ncl_a3 - ( 20) so4_a3 - ( 21) num_a3 - ( 22) pom_a4 - ( 23) bc_a4 - ( 24) num_a4 - ( 25) H2O + ( 13) num_a2 + ( 14) num_a3 + ( 15) num_a4 + ( 16) pom_a1 + ( 17) pom_a4 + ( 18) SO2 + ( 19) so4_a1 + ( 20) so4_a2 + ( 21) so4_a3 + ( 22) soa_a1 + ( 23) soa_a2 + ( 24) SOAE + ( 25) SOAG + ( 26) H2O Photolysis - jh2o2 ( 1) H2O2 + hv -> (No products) rate = ** User defined ** ( 1) + jh2o2 ( 1) H2O2 + hv -> 2*OH rate = ** User defined ** ( 1) + jsoa_a1 ( 2) soa_a1 + hv -> (No products) rate = ** User defined ** ( 2) + jsoa_a2 ( 3) soa_a2 + hv -> (No products) rate = ** User defined ** ( 3) Reactions - usr_HO2_HO2 ( 1) HO2 + HO2 -> H2O2 rate = ** User defined ** ( 2) - ( 2) H2O2 + OH -> H2O + HO2 rate = 2.90E-12*exp( -160./t) ( 3) - usr_SO2_OH ( 3) SO2 + OH -> H2SO4 rate = ** User defined ** ( 4) - ( 4) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) ( 5) - usr_DMS_OH ( 5) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** ( 6) - ( 6) DMS + NO3 -> SO2 + {HNO3} rate = 1.90E-13*exp( 520./t) ( 7) + OH_H2O2 ( 1) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 ( 4) + usr_HO2_HO2 ( 2) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** ( 5) + DMS_NO3 ( 3) DMS + NO3 -> SO2 + {HNO3} rate = 1.90E-13*exp( 520./t) ( 6) + DMS_OHa ( 4) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) ( 7) + SO2_OH_M ( 5) SO2 + OH + M -> H2SO4 troe : ko=2.90E-31*(300/t)**4.10 ( 8) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + usr_DMS_OH ( 6) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** ( 9) + SOAE_tau ( 7) SOAE -> SOAG rate = 1.16E-05 ( 10) Extraneous prod/loss species ( 1) SO2 (dataset) @@ -90,38 +97,39 @@ Extraneous prod/loss species ( 3) so4_a2 (dataset) ( 4) pom_a4 (dataset) ( 5) bc_a4 (dataset) - ( 6) num_a1 (dataset) - ( 7) num_a2 (dataset) - ( 8) num_a4 (dataset) - ( 9) H2O (dataset) + ( 6) H2O (dataset) + ( 7) num_a1 (dataset) + ( 8) num_a2 (dataset) + ( 9) num_a4 (dataset) Equation Report - d(H2O2)/dt = r1 - - j1*H2O2 - r2*OH*H2O2 - d(H2SO4)/dt = r3*OH*SO2 - d(SO2)/dt = r4*OH*DMS + .5*r5*OH*DMS + r6*NO3*DMS - - r3*OH*SO2 - d(DMS)/dt = - r4*OH*DMS - r5*OH*DMS - r6*NO3*DMS - d(SOAG)/dt = 0 - d(so4_a1)/dt = 0 - d(pom_a1)/dt = 0 - d(soa_a1)/dt = 0 d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(DMS)/dt = - r3*NO3*DMS - r4*OH*DMS - r6*OH*DMS d(dst_a1)/dt = 0 - d(ncl_a1)/dt = 0 - d(num_a1)/dt = 0 - d(so4_a2)/dt = 0 d(dst_a2)/dt = 0 - d(soa_a2)/dt = 0 - d(ncl_a2)/dt = 0 - d(num_a2)/dt = 0 d(dst_a3)/dt = 0 + d(H2O2)/dt = r2 + - j1*H2O2 - r1*OH*H2O2 + d(H2SO4)/dt = r5*OH*M*SO2 + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 d(ncl_a3)/dt = 0 - d(so4_a3)/dt = 0 + d(num_a1)/dt = 0 + d(num_a2)/dt = 0 d(num_a3)/dt = 0 - d(pom_a4)/dt = 0 - d(bc_a4)/dt = 0 d(num_a4)/dt = 0 - d(H2O)/dt = r2*OH*H2O2 + d(pom_a1)/dt = 0 + d(pom_a4)/dt = 0 + d(SO2)/dt = r3*NO3*DMS + r4*OH*DMS + .5*r6*OH*DMS + - r5*OH*M*SO2 + d(so4_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(so4_a3)/dt = 0 + d(soa_a1)/dt = - j2*soa_a1 + d(soa_a2)/dt = - j3*soa_a2 + d(SOAE)/dt = - r7*SOAE + d(SOAG)/dt = r7*SOAE + d(H2O)/dt = r1*OH*H2O2 diff --git a/src/chemistry/pp_trop_mam4/chem_mech.in b/src/chemistry/pp_trop_mam4/chem_mech.in index 9b7d3e5948..1906798c76 100644 --- a/src/chemistry/pp_trop_mam4/chem_mech.in +++ b/src/chemistry/pp_trop_mam4/chem_mech.in @@ -1,24 +1,47 @@ - SPECIES +* Comments +* User-given Tag Description: CAM_MAM4 +* Tag database identifier : MZ311_CAM_MAM4_20221214 +* Tag created by : lke +* Tag created from branch : CAM_MAM4 +* Tag created on : 2022-12-14 14:27:19.958014-07 +* Comments for this tag follow: +* lke : 2022-12-14 : updated simple SOA for CAM + + SPECIES Solution - H2O2, H2SO4, SO2, DMS -> CH3SCH3, SOAG -> C - so4_a1 -> NH4HSO4 - pom_a1 -> C, soa_a1 -> C, bc_a1 -> C - dst_a1 -> AlSiO5, ncl_a1 -> NaCl - num_a1 -> H - so4_a2 -> NH4HSO4, dst_a2 -> AlSiO5 - soa_a2 -> C, ncl_a2 -> NaCl - num_a2 -> H - dst_a3 -> AlSiO5, ncl_a3 -> NaCl - so4_a3 -> NH4HSO4 - num_a3 -> H - pom_a4 -> C, bc_a4 -> C - num_a4 -> H + bc_a1 -> C, + bc_a4 -> C, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + H2O2, + H2SO4, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + num_a1 -> H, + num_a2 -> H, + num_a3 -> H, + num_a4 -> H, + pom_a1 -> C, + pom_a4 -> C, + SO2, + so4_a1 -> NH4HSO4, + so4_a2 -> NH4HSO4, + so4_a3 -> NH4HSO4, + soa_a1 -> C, + soa_a2 -> C, + SOAE -> C, + SOAG -> C, H2O + End Solution + Fixed - M, N2, O2, O3, OH, NO3, HO2 + M, O2, OH, O3, NO3, HO2, N2 End Fixed Col-int @@ -26,54 +49,99 @@ O2 = 0. End Col-int - End SPECIES + Not-Transported + + End Not-Transported + + END Species + - Solution Classes + Solution classes Explicit + End Explicit + Implicit - H2O2, H2SO4, SO2, DMS, SOAG - so4_a1, pom_a1 - soa_a1, bc_a1, dst_a1, ncl_a1 - num_a1 - so4_a2, soa_a2, ncl_a2, dst_a2, num_a2 - dst_a3, ncl_a3, so4_a3, num_a3 - pom_a4, bc_a4, num_a4 - H2O + bc_a1 + bc_a4 + DMS + dst_a1 + dst_a2 + dst_a3 + H2O2 + H2SO4 + ncl_a1 + ncl_a2 + ncl_a3 + num_a1 + num_a2 + num_a3 + num_a4 + pom_a1 + pom_a4 + SO2 + so4_a1 + so4_a2 + so4_a3 + soa_a1 + soa_a2 + SOAE + SOAG + H2O End Implicit - End Solution Classes + + End Solution classes + CHEMISTRY Photolysis - [jh2o2] H2O2 + hv -> +********************************* +*** odd-oxygen +********************************* +[jh2o2] H2O2 + hv -> 2*OH +********************************* +*** soa +********************************* +[jsoa_a1->,.0004*jno2] soa_a1 + hv -> +[jsoa_a2->,.0004*jno2] soa_a2 + hv -> End Photolysis Reactions - [usr_HO2_HO2] HO2 + HO2 -> H2O2 - H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 - [usr_SO2_OH] SO2 + OH -> H2SO4 - DMS + OH -> SO2 ; 9.6e-12, -234. - [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 - DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. +********************************* +*** odd-hydrogen +********************************* +[OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.8e-12 +[usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2 +********************************* +*** Sulfur +********************************* +[DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 +[DMS_OHa] DMS + OH -> SO2 ; 1.1e-11, -280 +[SO2_OH_M] SO2 + OH + M -> H2SO4 ; 2.9e-31, 4.1, 1.7e-12, -0.2, 0.6 +[usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 +********************************* +*** SOA +********************************* +[SOAE_tau] SOAE -> SOAG ; 1.157e-05 End Reactions Ext Forcing - SO2 <- dataset - so4_a1 <- dataset - so4_a2 <- dataset - pom_a4 <- dataset - bc_a4 <- dataset - num_a1 <- dataset - num_a2 <- dataset - num_a4 <- dataset - H2O <- dataset + SO2 <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + pom_a4 <- dataset + bc_a4 <- dataset + H2O <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset End Ext Forcing - END CHEMISTRY + End Chemistry - SIMULATION PARAMETERS +SIMULATION PARAMETERS - Version Options + Version Options model = cam machine = intel architecture = hybrid @@ -81,6 +149,6 @@ multitask = on namemod = on modules = on - End Version Options + End Version Options - END SIMULATION PARAMETERS +End Simulation Parameters diff --git a/src/chemistry/pp_trop_mam4/chem_mods.F90 b/src/chemistry/pp_trop_mam4/chem_mods.F90 index abde1282ad..51a8b76379 100644 --- a/src/chemistry/pp_trop_mam4/chem_mods.F90 +++ b/src/chemistry/pp_trop_mam4/chem_mods.F90 @@ -5,25 +5,25 @@ module chem_mods use shr_kind_mod, only : r8 => shr_kind_r8 implicit none save - integer, parameter :: phtcnt = 1, & ! number of photolysis reactions - rxntot = 7, & ! number of total reactions - gascnt = 6, & ! number of gas phase reactions + integer, parameter :: phtcnt = 3, & ! number of photolysis reactions + rxntot = 10, & ! number of total reactions + gascnt = 7, & ! number of gas phase reactions nabscol = 2, & ! number of absorbing column densities - gas_pcnst = 25, & ! number of "gas phase" species + gas_pcnst = 26, & ! number of "gas phase" species nfs = 7, & ! number of "fixed" species relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members - nzcnt = 28, & ! number of non-zero matrix entries + nzcnt = 30, & ! number of non-zero matrix entries extcnt = 9, & ! number of species with external forcing clscnt1 = 0, & ! number of species in explicit class clscnt2 = 0, & ! number of species in hov class clscnt3 = 0, & ! number of species in ebi class - clscnt4 = 25, & ! number of species in implicit class + clscnt4 = 26, & ! 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 = 4, & + rxt_tag_cnt = 10, & enthalpy_cnt = 0, & nslvd = 0 integer :: clscnt(5) = 0 diff --git a/src/chemistry/pp_trop_mam4/m_rxt_id.F90 b/src/chemistry/pp_trop_mam4/m_rxt_id.F90 index 0eff5755d9..00b2a5c046 100644 --- a/src/chemistry/pp_trop_mam4/m_rxt_id.F90 +++ b/src/chemistry/pp_trop_mam4/m_rxt_id.F90 @@ -1,10 +1,13 @@ module m_rxt_id implicit none integer, parameter :: rid_jh2o2 = 1 - integer, parameter :: rid_usr_HO2_HO2 = 2 - integer, parameter :: rid_usr_SO2_OH = 4 - integer, parameter :: rid_usr_DMS_OH = 6 - integer, parameter :: rid_r0003 = 3 - integer, parameter :: rid_r0005 = 5 - integer, parameter :: rid_r0007 = 7 + integer, parameter :: rid_jsoa_a1 = 2 + integer, parameter :: rid_jsoa_a2 = 3 + integer, parameter :: rid_OH_H2O2 = 4 + integer, parameter :: rid_usr_HO2_HO2 = 5 + integer, parameter :: rid_DMS_NO3 = 6 + integer, parameter :: rid_DMS_OHa = 7 + integer, parameter :: rid_SO2_OH_M = 8 + integer, parameter :: rid_usr_DMS_OH = 9 + integer, parameter :: rid_SOAE_tau = 10 end module m_rxt_id diff --git a/src/chemistry/pp_trop_mam4/m_spc_id.F90 b/src/chemistry/pp_trop_mam4/m_spc_id.F90 index 7450960c34..297933b893 100644 --- a/src/chemistry/pp_trop_mam4/m_spc_id.F90 +++ b/src/chemistry/pp_trop_mam4/m_spc_id.F90 @@ -1,28 +1,29 @@ module m_spc_id implicit none - integer, parameter :: id_H2O2 = 1 - integer, parameter :: id_H2SO4 = 2 - integer, parameter :: id_SO2 = 3 - integer, parameter :: id_DMS = 4 - integer, parameter :: id_SOAG = 5 - integer, parameter :: id_so4_a1 = 6 - integer, parameter :: id_pom_a1 = 7 - integer, parameter :: id_soa_a1 = 8 - integer, parameter :: id_bc_a1 = 9 - integer, parameter :: id_dst_a1 = 10 - integer, parameter :: id_ncl_a1 = 11 + integer, parameter :: id_bc_a1 = 1 + integer, parameter :: id_bc_a4 = 2 + integer, parameter :: id_DMS = 3 + integer, parameter :: id_dst_a1 = 4 + integer, parameter :: id_dst_a2 = 5 + integer, parameter :: id_dst_a3 = 6 + integer, parameter :: id_H2O2 = 7 + integer, parameter :: id_H2SO4 = 8 + integer, parameter :: id_ncl_a1 = 9 + integer, parameter :: id_ncl_a2 = 10 + integer, parameter :: id_ncl_a3 = 11 integer, parameter :: id_num_a1 = 12 - integer, parameter :: id_so4_a2 = 13 - integer, parameter :: id_dst_a2 = 14 - integer, parameter :: id_soa_a2 = 15 - integer, parameter :: id_ncl_a2 = 16 - integer, parameter :: id_num_a2 = 17 - integer, parameter :: id_dst_a3 = 18 - integer, parameter :: id_ncl_a3 = 19 - integer, parameter :: id_so4_a3 = 20 - integer, parameter :: id_num_a3 = 21 - integer, parameter :: id_pom_a4 = 22 - integer, parameter :: id_bc_a4 = 23 - integer, parameter :: id_num_a4 = 24 - integer, parameter :: id_H2O = 25 + integer, parameter :: id_num_a2 = 13 + integer, parameter :: id_num_a3 = 14 + integer, parameter :: id_num_a4 = 15 + integer, parameter :: id_pom_a1 = 16 + integer, parameter :: id_pom_a4 = 17 + integer, parameter :: id_SO2 = 18 + integer, parameter :: id_so4_a1 = 19 + integer, parameter :: id_so4_a2 = 20 + integer, parameter :: id_so4_a3 = 21 + integer, parameter :: id_soa_a1 = 22 + integer, parameter :: id_soa_a2 = 23 + integer, parameter :: id_SOAE = 24 + integer, parameter :: id_SOAG = 25 + integer, parameter :: id_H2O = 26 end module m_spc_id diff --git a/src/chemistry/pp_trop_mam4/mo_adjrxt.F90 b/src/chemistry/pp_trop_mam4/mo_adjrxt.F90 index f58daf1689..403ae754d9 100644 --- a/src/chemistry/pp_trop_mam4/mo_adjrxt.F90 +++ b/src/chemistry/pp_trop_mam4/mo_adjrxt.F90 @@ -18,11 +18,11 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) !-------------------------------------------------------------------- real(r8) :: im(ncol,nlev) im(:,:) = 1._r8 / m(:,:) - rate(:,:, 3) = rate(:,:, 3) * inv(:,:, 5) - rate(:,:, 4) = rate(:,:, 4) * inv(:,:, 5) - rate(:,:, 5) = rate(:,:, 5) * inv(:,:, 5) + rate(:,:, 4) = rate(:,:, 4) * inv(:,:, 3) rate(:,:, 6) = rate(:,:, 6) * inv(:,:, 5) - rate(:,:, 7) = rate(:,:, 7) * inv(:,:, 6) - rate(:,:, 2) = rate(:,:, 2) * inv(:,:, 7) * inv(:,:, 7) * im(:,:) + rate(:,:, 7) = rate(:,:, 7) * inv(:,:, 3) + rate(:,:, 9) = rate(:,:, 9) * inv(:,:, 3) + rate(:,:, 5) = rate(:,:, 5) * inv(:,:, 6) * inv(:,:, 6) * im(:,:) + rate(:,:, 8) = rate(:,:, 8) * inv(:,:, 3) * inv(:,:, 1) end subroutine adjrxt end module mo_adjrxt diff --git a/src/chemistry/pp_trop_mam4/mo_indprd.F90 b/src/chemistry/pp_trop_mam4/mo_indprd.F90 index 90cfc291ba..986610a261 100644 --- a/src/chemistry/pp_trop_mam4/mo_indprd.F90 +++ b/src/chemistry/pp_trop_mam4/mo_indprd.F90 @@ -21,31 +21,32 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) ! ... "independent" production for Implicit species !-------------------------------------------------------------------- if( class == 4 ) then - prod(:,:,1) =rxt(:,:,2) - prod(:,:,2) = 0._r8 - prod(:,:,3) = + extfrc(:,:,1) + prod(:,:,1) = 0._r8 + prod(:,:,2) = + extfrc(:,:,5) + prod(:,:,3) = 0._r8 prod(:,:,4) = 0._r8 prod(:,:,5) = 0._r8 - prod(:,:,6) = + extfrc(:,:,2) - prod(:,:,7) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) =rxt(:,:,5) prod(:,:,8) = 0._r8 prod(:,:,9) = 0._r8 prod(:,:,10) = 0._r8 prod(:,:,11) = 0._r8 - prod(:,:,12) = + extfrc(:,:,6) - prod(:,:,13) = + extfrc(:,:,3) + prod(:,:,12) = + extfrc(:,:,7) + prod(:,:,13) = + extfrc(:,:,8) prod(:,:,14) = 0._r8 - prod(:,:,15) = 0._r8 + prod(:,:,15) = + extfrc(:,:,9) prod(:,:,16) = 0._r8 - prod(:,:,17) = + extfrc(:,:,7) - prod(:,:,18) = 0._r8 - prod(:,:,19) = 0._r8 - prod(:,:,20) = 0._r8 + prod(:,:,17) = + extfrc(:,:,4) + prod(:,:,18) = + extfrc(:,:,1) + prod(:,:,19) = + extfrc(:,:,2) + prod(:,:,20) = + extfrc(:,:,3) prod(:,:,21) = 0._r8 - prod(:,:,22) = + extfrc(:,:,4) - prod(:,:,23) = + extfrc(:,:,5) - prod(:,:,24) = + extfrc(:,:,8) - prod(:,:,25) = + extfrc(:,:,9) + prod(:,:,22) = 0._r8 + prod(:,:,23) = 0._r8 + prod(:,:,24) = 0._r8 + prod(:,:,25) = 0._r8 + prod(:,:,26) = + extfrc(:,:,6) end if end subroutine indprd end module mo_indprd diff --git a/src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 b/src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 index 7f07f8dab2..a1fe59cc5a 100644 --- a/src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 +++ b/src/chemistry/pp_trop_mam4/mo_lin_matrix.F90 @@ -16,34 +16,36 @@ subroutine linmat01( mat, y, rxt, het_rates ) real(r8), intent(in) :: rxt(rxntot) real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) real(r8), intent(inout) :: mat(nzcnt) - mat(1) = -( rxt(1) + rxt(3) + het_rates(1) ) - mat(3) = -( het_rates(2) ) - mat(4) = rxt(4) - mat(5) = -( rxt(4) + het_rates(3) ) - mat(6) = rxt(5) + .500_r8*rxt(6) + rxt(7) - mat(7) = -( rxt(5) + rxt(6) + rxt(7) + het_rates(4) ) - mat(8) = -( het_rates(5) ) - mat(9) = -( het_rates(6) ) - mat(10) = -( het_rates(7) ) - mat(11) = -( het_rates(8) ) - mat(12) = -( het_rates(9) ) - mat(13) = -( het_rates(10) ) - mat(14) = -( het_rates(11) ) - mat(15) = -( het_rates(12) ) - mat(16) = -( het_rates(13) ) + mat(1) = -( het_rates(1) ) + mat(2) = -( het_rates(2) ) + mat(3) = -( rxt(6) + rxt(7) + rxt(9) + het_rates(3) ) + mat(5) = -( het_rates(4) ) + mat(6) = -( het_rates(5) ) + mat(7) = -( het_rates(6) ) + mat(8) = -( rxt(1) + rxt(4) + het_rates(7) ) + mat(10) = -( het_rates(8) ) + mat(20) = rxt(8) + mat(11) = -( het_rates(9) ) + mat(12) = -( het_rates(10) ) + mat(13) = -( het_rates(11) ) + mat(14) = -( het_rates(12) ) + mat(15) = -( het_rates(13) ) + mat(16) = -( het_rates(14) ) mat(17) = -( het_rates(15) ) mat(18) = -( het_rates(16) ) - mat(19) = -( het_rates(14) ) - mat(20) = -( het_rates(17) ) - mat(21) = -( het_rates(18) ) + mat(19) = -( het_rates(17) ) + mat(21) = -( rxt(8) + het_rates(18) ) + mat(4) = rxt(6) + rxt(7) + .500_r8*rxt(9) mat(22) = -( het_rates(19) ) mat(23) = -( het_rates(20) ) mat(24) = -( het_rates(21) ) - mat(25) = -( het_rates(22) ) - mat(26) = -( het_rates(23) ) - mat(27) = -( het_rates(24) ) - mat(28) = -( het_rates(25) ) - mat(2) = rxt(3) + mat(25) = -( rxt(2) + het_rates(22) ) + mat(26) = -( rxt(3) + het_rates(23) ) + mat(27) = -( rxt(10) + het_rates(24) ) + mat(29) = -( het_rates(25) ) + mat(28) = rxt(10) + mat(30) = -( het_rates(26) ) + mat(9) = rxt(4) end subroutine linmat01 subroutine linmat( mat, y, rxt, het_rates ) !---------------------------------------------- diff --git a/src/chemistry/pp_trop_mam4/mo_lu_factor.F90 b/src/chemistry/pp_trop_mam4/mo_lu_factor.F90 index 63b64c2ee2..29756586d9 100644 --- a/src/chemistry/pp_trop_mam4/mo_lu_factor.F90 +++ b/src/chemistry/pp_trop_mam4/mo_lu_factor.F90 @@ -10,12 +10,14 @@ subroutine lu_fac01( lu ) !----------------------------------------------------------------------- real(r8), intent(inout) :: lu(:) lu(1) = 1._r8 / lu(1) - lu(2) = lu(2) * lu(1) + lu(2) = 1._r8 / lu(2) lu(3) = 1._r8 / lu(3) + lu(4) = lu(4) * lu(3) lu(5) = 1._r8 / lu(5) + lu(6) = 1._r8 / lu(6) lu(7) = 1._r8 / lu(7) lu(8) = 1._r8 / lu(8) - lu(9) = 1._r8 / lu(9) + lu(9) = lu(9) * lu(8) lu(10) = 1._r8 / lu(10) lu(11) = 1._r8 / lu(11) lu(12) = 1._r8 / lu(12) @@ -26,7 +28,6 @@ subroutine lu_fac01( lu ) lu(17) = 1._r8 / lu(17) lu(18) = 1._r8 / lu(18) lu(19) = 1._r8 / lu(19) - lu(20) = 1._r8 / lu(20) lu(21) = 1._r8 / lu(21) lu(22) = 1._r8 / lu(22) lu(23) = 1._r8 / lu(23) @@ -34,7 +35,9 @@ subroutine lu_fac01( lu ) lu(25) = 1._r8 / lu(25) lu(26) = 1._r8 / lu(26) lu(27) = 1._r8 / lu(27) - lu(28) = 1._r8 / lu(28) + lu(28) = lu(28) * lu(27) + lu(29) = 1._r8 / lu(29) + lu(30) = 1._r8 / lu(30) end subroutine lu_fac01 subroutine lu_fac( lu ) use shr_kind_mod, only : r8 => shr_kind_r8 diff --git a/src/chemistry/pp_trop_mam4/mo_lu_solve.F90 b/src/chemistry/pp_trop_mam4/mo_lu_solve.F90 index 17204afd5f..7b304d0f8d 100644 --- a/src/chemistry/pp_trop_mam4/mo_lu_solve.F90 +++ b/src/chemistry/pp_trop_mam4/mo_lu_solve.F90 @@ -17,7 +17,9 @@ subroutine lu_slv01( lu, b ) !----------------------------------------------------------------------- ! ... solve L * y = b !----------------------------------------------------------------------- - b(25) = b(25) - lu(2) * b(1) + b(18) = b(18) - lu(4) * b(3) + b(26) = b(26) - lu(9) * b(7) + b(25) = b(25) - lu(28) * b(24) end subroutine lu_slv01 subroutine lu_slv02( lu, b ) use shr_kind_mod, only : r8 => shr_kind_r8 @@ -37,7 +39,8 @@ subroutine lu_slv02( lu, b ) !----------------------------------------------------------------------- ! ... Solve U * x = y !----------------------------------------------------------------------- - b(25) = b(25) * lu(28) + b(26) = b(26) * lu(30) + b(25) = b(25) * lu(29) b(24) = b(24) * lu(27) b(23) = b(23) * lu(26) b(22) = b(22) * lu(25) @@ -45,24 +48,23 @@ subroutine lu_slv02( lu, b ) b(20) = b(20) * lu(23) b(19) = b(19) * lu(22) b(18) = b(18) * lu(21) - b(17) = b(17) * lu(20) - b(16) = b(16) * lu(19) - b(15) = b(15) * lu(18) - b(14) = b(14) * lu(17) - b(13) = b(13) * lu(16) - b(12) = b(12) * lu(15) - b(11) = b(11) * lu(14) - b(10) = b(10) * lu(13) - b(9) = b(9) * lu(12) - b(8) = b(8) * lu(11) - b(7) = b(7) * lu(10) - b(6) = b(6) * lu(9) - b(5) = b(5) * lu(8) - b(4) = b(4) * lu(7) - b(3) = b(3) - lu(6) * b(4) - b(3) = b(3) * lu(5) - b(2) = b(2) - lu(4) * b(3) - b(2) = b(2) * lu(3) + b(8) = b(8) - lu(20) * b(18) + b(17) = b(17) * lu(19) + b(16) = b(16) * lu(18) + b(15) = b(15) * lu(17) + b(14) = b(14) * lu(16) + b(13) = b(13) * lu(15) + b(12) = b(12) * lu(14) + b(11) = b(11) * lu(13) + b(10) = b(10) * lu(12) + b(9) = b(9) * lu(11) + b(8) = b(8) * lu(10) + b(7) = b(7) * lu(8) + b(6) = b(6) * lu(7) + b(5) = b(5) * lu(6) + b(4) = b(4) * lu(5) + b(3) = b(3) * lu(3) + b(2) = b(2) * lu(2) b(1) = b(1) * lu(1) end subroutine lu_slv02 subroutine lu_slv( lu, b ) diff --git a/src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 b/src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 index b4f1e41c20..81cc0b2055 100644 --- a/src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 +++ b/src/chemistry/pp_trop_mam4/mo_nln_matrix.F90 @@ -59,12 +59,15 @@ subroutine nlnmat_finit( mat, lmat, dti ) mat( 26) = lmat( 26) mat( 27) = lmat( 27) mat( 28) = lmat( 28) + mat( 29) = lmat( 29) + mat( 30) = lmat( 30) mat( 1) = mat( 1) - dti + mat( 2) = mat( 2) - dti mat( 3) = mat( 3) - dti mat( 5) = mat( 5) - dti + mat( 6) = mat( 6) - dti mat( 7) = mat( 7) - dti mat( 8) = mat( 8) - dti - mat( 9) = mat( 9) - dti mat( 10) = mat( 10) - dti mat( 11) = mat( 11) - dti mat( 12) = mat( 12) - dti @@ -75,7 +78,6 @@ subroutine nlnmat_finit( mat, lmat, dti ) mat( 17) = mat( 17) - dti mat( 18) = mat( 18) - dti mat( 19) = mat( 19) - dti - mat( 20) = mat( 20) - dti mat( 21) = mat( 21) - dti mat( 22) = mat( 22) - dti mat( 23) = mat( 23) - dti @@ -83,6 +85,7 @@ subroutine nlnmat_finit( mat, lmat, dti ) mat( 25) = mat( 25) - dti mat( 26) = mat( 26) - dti mat( 27) = mat( 27) - dti - mat( 28) = mat( 28) - dti + mat( 29) = mat( 29) - dti + mat( 30) = mat( 30) - dti end subroutine nlnmat_finit end module mo_nln_matrix diff --git a/src/chemistry/pp_trop_mam4/mo_prod_loss.F90 b/src/chemistry/pp_trop_mam4/mo_prod_loss.F90 index cdca283d11..cbc7374898 100644 --- a/src/chemistry/pp_trop_mam4/mo_prod_loss.F90 +++ b/src/chemistry/pp_trop_mam4/mo_prod_loss.F90 @@ -32,22 +32,22 @@ subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) !-------------------------------------------------------------------- ! ... loss and production for Implicit method !-------------------------------------------------------------------- - loss(1) = ( + rxt(1) + rxt(3) + het_rates(1))* y(1) + loss(1) = ( + het_rates(1))* y(1) prod(1) = 0._r8 loss(2) = ( + het_rates(2))* y(2) - prod(2) =rxt(4)*y(3) - loss(3) = ( + rxt(4) + het_rates(3))* y(3) - prod(3) = (rxt(5) +.500_r8*rxt(6) +rxt(7))*y(4) - loss(4) = ( + rxt(5) + rxt(6) + rxt(7) + het_rates(4))* y(4) + prod(2) = 0._r8 + loss(3) = ( + rxt(6) + rxt(7) + rxt(9) + het_rates(3))* y(3) + prod(3) = 0._r8 + loss(4) = ( + het_rates(4))* y(4) prod(4) = 0._r8 loss(5) = ( + het_rates(5))* y(5) prod(5) = 0._r8 loss(6) = ( + het_rates(6))* y(6) prod(6) = 0._r8 - loss(7) = ( + het_rates(7))* y(7) + loss(7) = ( + rxt(1) + rxt(4) + het_rates(7))* y(7) prod(7) = 0._r8 loss(8) = ( + het_rates(8))* y(8) - prod(8) = 0._r8 + prod(8) =rxt(8)*y(18) loss(9) = ( + het_rates(9))* y(9) prod(9) = 0._r8 loss(10) = ( + het_rates(10))* y(10) @@ -58,29 +58,31 @@ subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) prod(12) = 0._r8 loss(13) = ( + het_rates(13))* y(13) prod(13) = 0._r8 - loss(14) = ( + het_rates(15))* y(15) + loss(14) = ( + het_rates(14))* y(14) prod(14) = 0._r8 - loss(15) = ( + het_rates(16))* y(16) + loss(15) = ( + het_rates(15))* y(15) prod(15) = 0._r8 - loss(16) = ( + het_rates(14))* y(14) + loss(16) = ( + het_rates(16))* y(16) prod(16) = 0._r8 loss(17) = ( + het_rates(17))* y(17) prod(17) = 0._r8 - loss(18) = ( + het_rates(18))* y(18) - prod(18) = 0._r8 + loss(18) = ( + rxt(8) + het_rates(18))* y(18) + prod(18) = (rxt(6) +rxt(7) +.500_r8*rxt(9))*y(3) loss(19) = ( + het_rates(19))* y(19) prod(19) = 0._r8 loss(20) = ( + het_rates(20))* y(20) prod(20) = 0._r8 loss(21) = ( + het_rates(21))* y(21) prod(21) = 0._r8 - loss(22) = ( + het_rates(22))* y(22) + loss(22) = ( + rxt(2) + het_rates(22))* y(22) prod(22) = 0._r8 - loss(23) = ( + het_rates(23))* y(23) + loss(23) = ( + rxt(3) + het_rates(23))* y(23) prod(23) = 0._r8 - loss(24) = ( + het_rates(24))* y(24) + loss(24) = ( + rxt(10) + het_rates(24))* y(24) prod(24) = 0._r8 loss(25) = ( + het_rates(25))* y(25) - prod(25) =rxt(3)*y(1) + prod(25) =rxt(10)*y(24) + loss(26) = ( + het_rates(26))* y(26) + prod(26) =rxt(4)*y(7) end subroutine imp_prod_loss end module mo_prod_loss diff --git a/src/chemistry/pp_trop_mam4/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_mam4/mo_rxt_rates_conv.F90 index 703c6c35a4..d8123b5eb4 100644 --- a/src/chemistry/pp_trop_mam4/mo_rxt_rates_conv.F90 +++ b/src/chemistry/pp_trop_mam4/mo_rxt_rates_conv.F90 @@ -8,12 +8,15 @@ 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,:, 1) ! rate_const*H2O2 + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 7) ! rate_const*H2O2 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 22) ! rate_const*soa_a1 + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 23) ! rate_const*soa_a2 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 7) ! rate_const*OH*H2O2 ! rate_const - rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 1) ! rate_const*OH*H2O2 - rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 3) ! rate_const*OH*SO2 - rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 4) ! rate_const*OH*DMS - rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 4) ! rate_const*OH*DMS - rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 4) ! rate_const*NO3*DMS + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 3) ! rate_const*NO3*DMS + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 3) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 18) ! rate_const*OH*M*SO2 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 3) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 24) ! rate_const*SOAE end subroutine set_rates end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_mam4/mo_setrxt.F90 b/src/chemistry/pp_trop_mam4/mo_setrxt.F90 index 261e09cf50..064b240e66 100644 --- a/src/chemistry/pp_trop_mam4/mo_setrxt.F90 +++ b/src/chemistry/pp_trop_mam4/mo_setrxt.F90 @@ -32,12 +32,21 @@ subroutine setrxt( rate, temp, m, ncol ) integer :: n real(r8) :: itemp(ncol,pver) real(r8) :: exp_fac(ncol,pver) + real(r8) :: ko(ncol,pver) + real(r8) :: kinf(ncol,pver) + rate(:,:,4) = 1.8e-12_r8 + rate(:,:,10) = 1.157e-05_r8 itemp(:ncol,:) = 1._r8 / temp(:ncol,:) n = ncol*pver - rate(:,:,3) = 2.9e-12_r8 * exp( -160._r8 * itemp(:,:) ) - rate(:,:,5) = 9.6e-12_r8 * exp( -234._r8 * itemp(:,:) ) - rate(:,:,7) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) ) + rate(:,:,6) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) ) + rate(:,:,7) = 1.1e-11_r8 * exp( -280._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 2.9e-31_r8 * itemp(:,:)**4.1_r8 + kinf(:,:) = 1.7e-12_r8 * itemp(:,:)**(-0.2_r8) + call jpl( rate(1,1,8), m, 0.6_r8, ko, kinf, n ) end subroutine setrxt @@ -66,6 +75,9 @@ subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) integer :: n 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) end subroutine setrxt_hrates diff --git a/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 b/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 index e8811864db..3c908a82b3 100644 --- a/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 +++ b/src/chemistry/pp_trop_mam4/mo_sim_dat.F90 @@ -31,51 +31,54 @@ subroutine set_sim_dat is_scalar = .true. is_vector = .false. - clscnt(:) = (/ 0, 0, 0, 25, 0 /) + clscnt(:) = (/ 0, 0, 0, 26, 0 /) - cls_rxt_cnt(:,4) = (/ 1, 6, 0, 25 /) + cls_rxt_cnt(:,4) = (/ 1, 9, 0, 26 /) - solsym(: 25) = (/ 'H2O2 ','H2SO4 ','SO2 ','DMS ','SOAG ', & - 'so4_a1 ','pom_a1 ','soa_a1 ','bc_a1 ','dst_a1 ', & - 'ncl_a1 ','num_a1 ','so4_a2 ','dst_a2 ','soa_a2 ', & - 'ncl_a2 ','num_a2 ','dst_a3 ','ncl_a3 ','so4_a3 ', & - 'num_a3 ','pom_a4 ','bc_a4 ','num_a4 ','H2O ' /) + solsym(: 26) = (/ 'bc_a1 ','bc_a4 ','DMS ','dst_a1 ','dst_a2 ', & + 'dst_a3 ','H2O2 ','H2SO4 ','ncl_a1 ','ncl_a2 ', & + 'ncl_a3 ','num_a1 ','num_a2 ','num_a3 ','num_a4 ', & + 'pom_a1 ','pom_a4 ','SO2 ','so4_a1 ','so4_a2 ', & + 'so4_a3 ','soa_a1 ','soa_a2 ','SOAE ','SOAG ', & + 'H2O ' /) - adv_mass(: 25) = (/ 34.013600_r8, 98.078400_r8, 64.064800_r8, 62.132400_r8, 12.011000_r8, & - 115.107340_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 135.064039_r8, & - 58.442468_r8, 1.007400_r8, 115.107340_r8, 135.064039_r8, 12.011000_r8, & - 58.442468_r8, 1.007400_r8, 135.064039_r8, 58.442468_r8, 115.107340_r8, & - 1.007400_r8, 12.011000_r8, 12.011000_r8, 1.007400_r8, 18.014200_r8 /) + adv_mass(: 26) = (/ 12.011000_r8, 12.011000_r8, 62.132400_r8, 135.064039_r8, 135.064039_r8, & + 135.064039_r8, 34.013600_r8, 98.078400_r8, 58.442468_r8, 58.442468_r8, & + 58.442468_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, & + 12.011000_r8, 12.011000_r8, 64.064800_r8, 115.107340_r8, 115.107340_r8, & + 115.107340_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 18.014200_r8 /) - crb_mass(: 25) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_r8, 12.011000_r8, & - 0.000000_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, & + crb_mass(: 26) = (/ 12.011000_r8, 12.011000_r8, 24.022000_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, 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, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 0.000000_r8 /) - fix_mass(: 7) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 47.9982000_r8, 17.0068000_r8, & - 62.0049400_r8, 33.0062000_r8 /) + fix_mass(: 7) = (/ 0.00000000_r8, 31.9988000_r8, 17.0068000_r8, 47.9982000_r8, 62.0049400_r8, & + 33.0062000_r8, 28.0134800_r8 /) - clsmap(: 25,4) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & - 11, 12, 13, 15, 16, 14, 17, 18, 19, 20, & - 21, 22, 23, 24, 25 /) + clsmap(: 26,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 /) - permute(: 25,4) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + permute(: 26,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 /) + 21, 22, 23, 24, 25, 26 /) - diag_map(: 25) = (/ 1, 3, 5, 7, 8, 9, 10, 11, 12, 13, & - 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, & - 24, 25, 26, 27, 28 /) + diag_map(: 26) = (/ 1, 2, 3, 5, 6, 7, 8, 10, 11, 12, & + 13, 14, 15, 16, 17, 18, 19, 21, 22, 23, & + 24, 25, 26, 27, 29, 30 /) extfrc_lst(: 9) = (/ 'SO2 ','so4_a1 ','so4_a2 ','pom_a4 ','bc_a4 ', & - 'num_a1 ','num_a2 ','num_a4 ','H2O ' /) + 'H2O ','num_a1 ','num_a2 ','num_a4 ' /) frc_from_dataset(: 9) = (/ .true., .true., .true., .true., .true., & .true., .true., .true., .true. /) - inv_lst(: 7) = (/ 'M ', 'N2 ', 'O2 ', 'O3 ', 'OH ', & - 'NO3 ', 'HO2 ' /) + inv_lst(: 7) = (/ 'M ', 'O2 ', 'OH ', 'O3 ', 'NO3 ', & + 'HO2 ', 'N2 ' /) if( allocated( rxt_tag_lst ) ) then deallocate( rxt_tag_lst ) @@ -93,9 +96,12 @@ subroutine set_sim_dat write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios call endrun end if - rxt_tag_lst( 1: 4) = (/ 'jh2o2 ', 'usr_HO2_HO2 ', & - 'usr_SO2_OH ', 'usr_DMS_OH ' /) - rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 4, 6 /) + rxt_tag_lst( 1: 10) = (/ 'jh2o2 ', 'jsoa_a1 ', & + 'jsoa_a2 ', 'OH_H2O2 ', & + 'usr_HO2_HO2 ', 'DMS_NO3 ', & + 'DMS_OHa ', 'SO2_OH_M ', & + 'usr_DMS_OH ', 'SOAE_tau ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 /) if( allocated( pht_alias_lst ) ) then deallocate( pht_alias_lst ) end if @@ -112,16 +118,16 @@ subroutine set_sim_dat write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios call endrun end if - pht_alias_lst(:,1) = (/ ' ' /) - pht_alias_lst(:,2) = (/ ' ' /) - pht_alias_mult(:,1) = (/ 1._r8 /) - pht_alias_mult(:,2) = (/ 1._r8 /) + pht_alias_lst(:,1) = (/ ' ', ' ', ' ' /) + pht_alias_lst(:,2) = (/ ' ', 'jno2 ', 'jno2 ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, .0004_r8, .0004_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 /) + num_rnts(:) = (/ 2, 2, 2, 2, 3, 2, 1 /) end subroutine set_sim_dat diff --git a/src/chemistry/pp_trop_mam7/chem_mech.doc b/src/chemistry/pp_trop_mam7/chem_mech.doc index a09ea3279e..7315a262e5 100644 --- a/src/chemistry/pp_trop_mam7/chem_mech.doc +++ b/src/chemistry/pp_trop_mam7/chem_mech.doc @@ -104,7 +104,7 @@ Class List Reactions usr_HO2_HO2 ( 1) HO2 + HO2 -> H2O2 rate = ** User defined ** ( 2) - ( 2) H2O2 + OH -> H2O + HO2 rate = 2.90E-12*exp( -160./t) ( 3) + ( 2) H2O2 + OH -> H2O + HO2 rate = 1.80E-12 ( 3) usr_SO2_OH ( 3) SO2 + OH -> H2SO4 rate = ** User defined ** ( 4) ( 4) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) ( 5) usr_DMS_OH ( 5) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** ( 6) diff --git a/src/chemistry/pp_trop_mam7/chem_mech.in b/src/chemistry/pp_trop_mam7/chem_mech.in index 1dd94178da..0245f7759e 100644 --- a/src/chemistry/pp_trop_mam7/chem_mech.in +++ b/src/chemistry/pp_trop_mam7/chem_mech.in @@ -1,38 +1,38 @@ SPECIES Solution - H2O2, H2SO4, SO2, DMS -> CH3SCH3, NH3, + H2O2, H2SO4, SO2, DMS -> CH3SCH3, NH3, SOAG -> C - so4_a1 -> SO4, + so4_a1 -> SO4, nh4_a1 -> NH4 - pom_a1 -> C, - soa_a1 -> C, - bc_a1 -> C, + pom_a1 -> C, + soa_a1 -> C, + bc_a1 -> C, ncl_a1 -> NaCl num_a1 -> H - so4_a2 -> SO4, + so4_a2 -> SO4, nh4_a2 -> NH4 - soa_a2 -> C, + soa_a2 -> C, ncl_a2 -> NaCl num_a2 -> H - pom_a3 -> C, + pom_a3 -> C, bc_a3 -> C num_a3 -> H - ncl_a4 -> NaCl, + ncl_a4 -> NaCl, so4_a4 -> SO4 - nh4_a4 -> NH4, + nh4_a4 -> NH4, num_a4 -> H - dst_a5 -> AlSiO5, + dst_a5 -> AlSiO5, so4_a5 -> SO4 - nh4_a5 -> NH4, + nh4_a5 -> NH4, num_a5 -> H - ncl_a6 -> NaCl, + ncl_a6 -> NaCl, so4_a6 -> SO4 - nh4_a6 -> NH4, + nh4_a6 -> NH4, num_a6 -> H - dst_a7 -> AlSiO5, + dst_a7 -> AlSiO5, so4_a7 -> SO4 - nh4_a7 -> NH4, + nh4_a7 -> NH4, num_a7 -> H H2O End Solution @@ -73,7 +73,7 @@ Reactions [usr_HO2_HO2] HO2 + HO2 -> H2O2 - H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 + H2O2 + OH -> H2O + HO2 ; 1.8e-12 [usr_SO2_OH] SO2 + OH -> H2SO4 DMS + OH -> SO2 ; 9.6e-12, -234. [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 diff --git a/src/chemistry/pp_trop_mam7/mo_setrxt.F90 b/src/chemistry/pp_trop_mam7/mo_setrxt.F90 index 072fd7f544..d738b34272 100644 --- a/src/chemistry/pp_trop_mam7/mo_setrxt.F90 +++ b/src/chemistry/pp_trop_mam7/mo_setrxt.F90 @@ -33,9 +33,9 @@ subroutine setrxt( rate, temp, m, ncol ) real(r8) :: itemp(ncol,pver) real(r8) :: exp_fac(ncol,pver) + rate(:,:,3) = 1.8e-12_r8 itemp(:ncol,:) = 1._r8 / temp(:ncol,:) n = ncol*pver - rate(:,:,3) = 2.9e-12_r8 * exp( -160._r8 * itemp(:,:) ) rate(:,:,5) = 9.6e-12_r8 * exp( -234._r8 * itemp(:,:) ) rate(:,:,7) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) ) rate(:,:,8) = 1.7e-12_r8 * exp( -710._r8 * itemp(:,:) ) diff --git a/src/chemistry/pp_trop_mozart/mo_adjrxt.F90 b/src/chemistry/pp_trop_mozart/mo_adjrxt.F90 index e92846d77b..087044d8c1 100644 --- a/src/chemistry/pp_trop_mozart/mo_adjrxt.F90 +++ b/src/chemistry/pp_trop_mozart/mo_adjrxt.F90 @@ -26,13 +26,13 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) rate(:,:, 89) = rate(:,:, 89) * inv(:,:, 1) rate(:,:, 90) = rate(:,:, 90) * inv(:,:, 1) rate(:,:, 93) = rate(:,:, 93) * inv(:,:, 3) - rate(:,:,104) = rate(:,:,104) * inv(:,:, 1) - rate(:,:,109) = rate(:,:,109) * inv(:,:, 1) - rate(:,:,115) = rate(:,:,115) * inv(:,:, 1) - rate(:,:,141) = rate(:,:,141) * inv(:,:, 1) - rate(:,:,175) = rate(:,:,175) * inv(:,:, 1) - rate(:,:,176) = rate(:,:,176) * inv(:,:, 1) - rate(:,:,211) = rate(:,:,211) * inv(:,:, 1) + rate(:,:, 104) = rate(:,:, 104) * inv(:,:, 1) + rate(:,:, 109) = rate(:,:, 109) * inv(:,:, 1) + rate(:,:, 115) = rate(:,:, 115) * inv(:,:, 1) + rate(:,:, 141) = rate(:,:, 141) * inv(:,:, 1) + rate(:,:, 175) = rate(:,:, 175) * inv(:,:, 1) + rate(:,:, 176) = rate(:,:, 176) * inv(:,:, 1) + rate(:,:, 211) = rate(:,:, 211) * inv(:,:, 1) rate(:,:, 41) = rate(:,:, 41) * inv(:,:, 3) * inv(:,:, 1) rate(:,:, 42) = rate(:,:, 42) * m(:,:) rate(:,:, 46) = rate(:,:, 46) * m(:,:) @@ -84,109 +84,109 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) rate(:,:, 97) = rate(:,:, 97) * m(:,:) rate(:,:, 98) = rate(:,:, 98) * m(:,:) rate(:,:, 99) = rate(:,:, 99) * m(:,:) - rate(:,:,100) = rate(:,:,100) * 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(:,:,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(:,:,117) = rate(:,:,117) * 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(:,:,135) = rate(:,:,135) * m(:,:) - rate(:,:,136) = rate(:,:,136) * 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(:,:,172) = rate(:,:,172) * m(:,:) - rate(:,:,173) = rate(:,:,173) * m(:,:) - rate(:,:,174) = rate(:,:,174) * m(:,:) - rate(:,:,175) = rate(:,:,175) * 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(:,:,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(:,:,211) = rate(:,:,211) * m(:,:) - rate(:,:,212) = rate(:,:,212) * m(:,:) + rate(:,:, 100) = rate(:,:, 100) * 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(:,:, 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(:,:, 117) = rate(:,:, 117) * 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(:,:, 135) = rate(:,:, 135) * m(:,:) + rate(:,:, 136) = rate(:,:, 136) * 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(:,:, 172) = rate(:,:, 172) * m(:,:) + rate(:,:, 173) = rate(:,:, 173) * m(:,:) + rate(:,:, 174) = rate(:,:, 174) * m(:,:) + rate(:,:, 175) = rate(:,:, 175) * 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(:,:, 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(:,:, 211) = rate(:,:, 211) * m(:,:) + rate(:,:, 212) = rate(:,:, 212) * m(:,:) end subroutine adjrxt end module mo_adjrxt diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/chem_mech.doc b/src/chemistry/pp_trop_strat_mam4_ts2/chem_mech.doc index 53bb589e55..4e5e791f53 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/chem_mech.doc +++ b/src/chemistry/pp_trop_strat_mam4_ts2/chem_mech.doc @@ -334,326 +334,326 @@ Class List ========== Explicit -------- - ( 1) AOA_NH - ( 2) BRY - ( 3) CCL4 - ( 4) CF2CLBR - ( 5) CF3BR - ( 6) CFC11 - ( 7) CFC113 - ( 8) CFC114 - ( 9) CFC115 - ( 10) CFC12 - ( 11) CH2BR2 - ( 12) CH3BR - ( 13) CH3CCL3 - ( 14) CH3CL - ( 15) CH4 - ( 16) CHBR3 - ( 17) CLY - ( 18) CO2 - ( 19) E90 - ( 20) H2402 - ( 21) HCFC141B - ( 22) HCFC142B - ( 23) HCFC22 - ( 24) N2O - ( 25) NH_5 - ( 26) NH_50 - ( 27) O3S - ( 28) SF6 - ( 29) ST80_25 - ( 30) NHDEP - ( 31) NDEP + ( 1) NHDEP + ( 2) NDEP Implicit -------- ( 1) ALKNIT ( 2) ALKOOH - ( 3) APIN - ( 4) bc_a1 - ( 5) bc_a4 - ( 6) BCARY - ( 7) BENZENE - ( 8) BENZOOH - ( 9) BEPOMUC - ( 10) BIGALD1 - ( 11) BIGALD2 - ( 12) BIGALD3 - ( 13) BIGALD4 - ( 14) BIGALK - ( 15) BIGENE - ( 16) BPIN - ( 17) BR - ( 18) BRCL - ( 19) BRO - ( 20) BRONO2 - ( 21) BZALD - ( 22) BZOOH - ( 23) C2H2 - ( 24) C2H4 - ( 25) C2H5OH - ( 26) C2H5OOH - ( 27) C2H6 - ( 28) C3H6 - ( 29) C3H7OOH - ( 30) C3H8 - ( 31) C6H5OOH - ( 32) CH2O - ( 33) CH3CHO - ( 34) CH3CN - ( 35) CH3COCH3 - ( 36) CH3COCHO - ( 37) CH3COOH - ( 38) CH3COOOH - ( 39) CH3OH - ( 40) CH3OOH - ( 41) CL - ( 42) CL2 - ( 43) CL2O2 - ( 44) CLO - ( 45) CLONO2 - ( 46) CO - ( 47) COF2 - ( 48) COFCL - ( 49) CRESOL - ( 50) DHPMPAL - ( 51) DMS - ( 52) dst_a1 - ( 53) dst_a2 - ( 54) dst_a3 - ( 55) EOOH - ( 56) F - ( 57) GLYALD - ( 58) GLYOXAL - ( 59) H - ( 60) H2 - ( 61) H2O2 - ( 62) H2SO4 - ( 63) HBR - ( 64) HCL - ( 65) HCN - ( 66) HCOCH2OOH - ( 67) HCOOH - ( 68) HF - ( 69) HMHP - ( 70) HNO3 - ( 71) HO2NO2 - ( 72) HOBR - ( 73) HOCL - ( 74) HONITR - ( 75) HPALD1 - ( 76) HPALD4 - ( 77) HPALDB1C - ( 78) HPALDB4C - ( 79) HYAC - ( 80) HYDRALD - ( 81) HYPERACET - ( 82) ICHE - ( 83) IEPOX - ( 84) INHEB - ( 85) INHED - ( 86) ISOP - ( 87) ISOPFDN - ( 88) ISOPFDNC - ( 89) ISOPFNC - ( 90) ISOPFNP - ( 91) ISOPHFP - ( 92) ISOPN1D - ( 93) ISOPN2B - ( 94) ISOPN3B - ( 95) ISOPN4D - ( 96) ISOPNBNO3 - ( 97) ISOPNOOHB - ( 98) ISOPNOOHD - ( 99) ISOPOH - (100) ISOPOOH - (101) IVOC - (102) LIMON - (103) MACR - (104) MACRN - (105) MACROOH - (106) MEK - (107) MEKOOH - (108) MPAN - (109) MVK - (110) MVKN - (111) MVKOOH - (112) MYRC - (113) N - (114) N2O5 - (115) NC4CHO - (116) ncl_a1 - (117) ncl_a2 - (118) ncl_a3 - (119) NH3 - (120) NH4 - (121) NO - (122) NO2 - (123) NO3 - (124) NO3CH2CHO - (125) NOA - (126) num_a1 - (127) num_a2 - (128) num_a3 - (129) num_a4 - (130) O - (131) O3 - (132) OCLO - (133) OCS - (134) ONITR - (135) PAN - (136) PBZNIT - (137) PHENO - (138) PHENOL - (139) PHENOOH - (140) pom_a1 - (141) pom_a4 - (142) POOH - (143) ROOH - (144) S - (145) SO - (146) SO2 - (147) SO3 - (148) so4_a1 - (149) so4_a2 - (150) so4_a3 - (151) soa1_a1 - (152) soa1_a2 - (153) soa2_a1 - (154) soa2_a2 - (155) soa3_a1 - (156) soa3_a2 - (157) soa4_a1 - (158) soa4_a2 - (159) soa5_a1 - (160) soa5_a2 - (161) SOAG0 - (162) SOAG1 - (163) SOAG2 - (164) SOAG3 - (165) SOAG4 - (166) SQTN - (167) SVOC - (168) TEPOMUC - (169) TERP1OOH - (170) TERP2AOOH - (171) TERPA - (172) TERPA2 - (173) TERPA2PAN - (174) TERPA3 - (175) TERPA3PAN - (176) TERPACID - (177) TERPACID2 - (178) TERPACID3 - (179) TERPAPAN - (180) TERPDHDP - (181) TERPF1 - (182) TERPF2 - (183) TERPFDN - (184) TERPHFN - (185) TERPK - (186) TERPNPS - (187) TERPNPS1 - (188) TERPNPT - (189) TERPNPT1 - (190) TERPNS - (191) TERPNS1 - (192) TERPNT - (193) TERPNT1 - (194) TERPOOH - (195) TERPOOHL - (196) TOLOOH - (197) TOLUENE - (198) XYLENES - (199) XYLENOOH - (200) XYLOL - (201) XYLOLOOH - (202) ACBZO2 - (203) ALKO2 - (204) APINNO3 - (205) APINO2 - (206) APINO2VBS - (207) BCARYNO3 - (208) BCARYO2 - (209) BCARYO2VBS - (210) BENZO2 - (211) BENZO2VBS - (212) BPINNO3 - (213) BPINO2 - (214) BPINO2VBS - (215) BZOO - (216) C2H5O2 - (217) C3H7O2 - (218) C6H5O2 - (219) CH3CO3 - (220) CH3O2 - (221) DICARBO2 - (222) ENEO2 - (223) EO - (224) EO2 - (225) HO2 - (226) HOCH2OO - (227) IEPOXOO - (228) ISOPB1O2 - (229) ISOPB4O2 - (230) ISOPC1C - (231) ISOPC1T - (232) ISOPC4C - (233) ISOPC4T - (234) ISOPED1O2 - (235) ISOPED4O2 - (236) ISOPN1DO2 - (237) ISOPN2BO2 - (238) ISOPN3BO2 - (239) ISOPN4DO2 - (240) ISOPNBNO3O2 - (241) ISOPNO3 - (242) ISOPNOOHBO2 - (243) ISOPNOOHDO2 - (244) ISOPO2VBS - (245) ISOPZD1O2 - (246) ISOPZD4O2 - (247) IVOCO2VBS - (248) LIMONNO3 - (249) LIMONO2 - (250) LIMONO2VBS - (251) MACRO2 - (252) MALO2 - (253) MCO3 - (254) MDIALO2 - (255) MEKO2 - (256) MVKO2 - (257) MYRCNO3 - (258) MYRCO2 - (259) MYRCO2VBS - (260) NC4CHOO2 - (261) O1D - (262) OH - (263) PHENO2 - (264) PO2 - (265) RO2 - (266) TERP1OOHO2 - (267) TERP2OOHO2 - (268) TERPA1O2 - (269) TERPA2CO3 - (270) TERPA2O2 - (271) TERPA3CO3 - (272) TERPA3O2 - (273) TERPA4O2 - (274) TERPACO3 - (275) TERPF1O2 - (276) TERPF2O2 - (277) TERPNPS1O2 - (278) TERPNPT1O2 - (279) TERPNS1O2 - (280) TERPNT1O2 - (281) TOLO2 - (282) TOLUO2VBS - (283) XYLENO2 - (284) XYLEO2VBS - (285) XYLOLO2 - (286) H2O + ( 3) AOA_NH + ( 4) APIN + ( 5) bc_a1 + ( 6) bc_a4 + ( 7) BCARY + ( 8) BENZENE + ( 9) BENZOOH + ( 10) BEPOMUC + ( 11) BIGALD1 + ( 12) BIGALD2 + ( 13) BIGALD3 + ( 14) BIGALD4 + ( 15) BIGALK + ( 16) BIGENE + ( 17) BPIN + ( 18) BR + ( 19) BRCL + ( 20) BRO + ( 21) BRONO2 + ( 22) BRY + ( 23) BZALD + ( 24) BZOOH + ( 25) C2H2 + ( 26) C2H4 + ( 27) C2H5OH + ( 28) C2H5OOH + ( 29) C2H6 + ( 30) C3H6 + ( 31) C3H7OOH + ( 32) C3H8 + ( 33) C6H5OOH + ( 34) CCL4 + ( 35) CF2CLBR + ( 36) CF3BR + ( 37) CFC11 + ( 38) CFC113 + ( 39) CFC114 + ( 40) CFC115 + ( 41) CFC12 + ( 42) CH2BR2 + ( 43) CH2O + ( 44) CH3BR + ( 45) CH3CCL3 + ( 46) CH3CHO + ( 47) CH3CL + ( 48) CH3CN + ( 49) CH3COCH3 + ( 50) CH3COCHO + ( 51) CH3COOH + ( 52) CH3COOOH + ( 53) CH3OH + ( 54) CH3OOH + ( 55) CH4 + ( 56) CHBR3 + ( 57) CL + ( 58) CL2 + ( 59) CL2O2 + ( 60) CLO + ( 61) CLONO2 + ( 62) CLY + ( 63) CO + ( 64) CO2 + ( 65) COF2 + ( 66) COFCL + ( 67) CRESOL + ( 68) DHPMPAL + ( 69) DMS + ( 70) dst_a1 + ( 71) dst_a2 + ( 72) dst_a3 + ( 73) E90 + ( 74) EOOH + ( 75) F + ( 76) GLYALD + ( 77) GLYOXAL + ( 78) H + ( 79) H2 + ( 80) H2402 + ( 81) H2O2 + ( 82) H2SO4 + ( 83) HBR + ( 84) HCFC141B + ( 85) HCFC142B + ( 86) HCFC22 + ( 87) HCL + ( 88) HCN + ( 89) HCOCH2OOH + ( 90) HCOOH + ( 91) HF + ( 92) HMHP + ( 93) HNO3 + ( 94) HO2NO2 + ( 95) HOBR + ( 96) HOCL + ( 97) HONITR + ( 98) HPALD1 + ( 99) HPALD4 + (100) HPALDB1C + (101) HPALDB4C + (102) HYAC + (103) HYDRALD + (104) HYPERACET + (105) ICHE + (106) IEPOX + (107) INHEB + (108) INHED + (109) ISOP + (110) ISOPFDN + (111) ISOPFDNC + (112) ISOPFNC + (113) ISOPFNP + (114) ISOPHFP + (115) ISOPN1D + (116) ISOPN2B + (117) ISOPN3B + (118) ISOPN4D + (119) ISOPNBNO3 + (120) ISOPNOOHB + (121) ISOPNOOHD + (122) ISOPOH + (123) ISOPOOH + (124) IVOC + (125) LIMON + (126) MACR + (127) MACRN + (128) MACROOH + (129) MEK + (130) MEKOOH + (131) MPAN + (132) MVK + (133) MVKN + (134) MVKOOH + (135) MYRC + (136) N + (137) N2O + (138) N2O5 + (139) NC4CHO + (140) ncl_a1 + (141) ncl_a2 + (142) ncl_a3 + (143) NH3 + (144) NH4 + (145) NH_5 + (146) NH_50 + (147) NO + (148) NO2 + (149) NO3 + (150) NO3CH2CHO + (151) NOA + (152) num_a1 + (153) num_a2 + (154) num_a3 + (155) num_a4 + (156) O + (157) O3 + (158) O3S + (159) OCLO + (160) OCS + (161) ONITR + (162) PAN + (163) PBZNIT + (164) PHENO + (165) PHENOL + (166) PHENOOH + (167) pom_a1 + (168) pom_a4 + (169) POOH + (170) ROOH + (171) S + (172) SF6 + (173) SO + (174) SO2 + (175) SO3 + (176) so4_a1 + (177) so4_a2 + (178) so4_a3 + (179) soa1_a1 + (180) soa1_a2 + (181) soa2_a1 + (182) soa2_a2 + (183) soa3_a1 + (184) soa3_a2 + (185) soa4_a1 + (186) soa4_a2 + (187) soa5_a1 + (188) soa5_a2 + (189) SOAG0 + (190) SOAG1 + (191) SOAG2 + (192) SOAG3 + (193) SOAG4 + (194) SQTN + (195) ST80_25 + (196) SVOC + (197) TEPOMUC + (198) TERP1OOH + (199) TERP2AOOH + (200) TERPA + (201) TERPA2 + (202) TERPA2PAN + (203) TERPA3 + (204) TERPA3PAN + (205) TERPACID + (206) TERPACID2 + (207) TERPACID3 + (208) TERPAPAN + (209) TERPDHDP + (210) TERPF1 + (211) TERPF2 + (212) TERPFDN + (213) TERPHFN + (214) TERPK + (215) TERPNPS + (216) TERPNPS1 + (217) TERPNPT + (218) TERPNPT1 + (219) TERPNS + (220) TERPNS1 + (221) TERPNT + (222) TERPNT1 + (223) TERPOOH + (224) TERPOOHL + (225) TOLOOH + (226) TOLUENE + (227) XYLENES + (228) XYLENOOH + (229) XYLOL + (230) XYLOLOOH + (231) ACBZO2 + (232) ALKO2 + (233) APINNO3 + (234) APINO2 + (235) APINO2VBS + (236) BCARYNO3 + (237) BCARYO2 + (238) BCARYO2VBS + (239) BENZO2 + (240) BENZO2VBS + (241) BPINNO3 + (242) BPINO2 + (243) BPINO2VBS + (244) BZOO + (245) C2H5O2 + (246) C3H7O2 + (247) C6H5O2 + (248) CH3CO3 + (249) CH3O2 + (250) DICARBO2 + (251) ENEO2 + (252) EO + (253) EO2 + (254) HO2 + (255) HOCH2OO + (256) IEPOXOO + (257) ISOPB1O2 + (258) ISOPB4O2 + (259) ISOPC1C + (260) ISOPC1T + (261) ISOPC4C + (262) ISOPC4T + (263) ISOPED1O2 + (264) ISOPED4O2 + (265) ISOPN1DO2 + (266) ISOPN2BO2 + (267) ISOPN3BO2 + (268) ISOPN4DO2 + (269) ISOPNBNO3O2 + (270) ISOPNO3 + (271) ISOPNOOHBO2 + (272) ISOPNOOHDO2 + (273) ISOPO2VBS + (274) ISOPZD1O2 + (275) ISOPZD4O2 + (276) IVOCO2VBS + (277) LIMONNO3 + (278) LIMONO2 + (279) LIMONO2VBS + (280) MACRO2 + (281) MALO2 + (282) MCO3 + (283) MDIALO2 + (284) MEKO2 + (285) MVKO2 + (286) MYRCNO3 + (287) MYRCO2 + (288) MYRCO2VBS + (289) NC4CHOO2 + (290) O1D + (291) OH + (292) PHENO2 + (293) PO2 + (294) RO2 + (295) TERP1OOHO2 + (296) TERP2OOHO2 + (297) TERPA1O2 + (298) TERPA2CO3 + (299) TERPA2O2 + (300) TERPA3CO3 + (301) TERPA3O2 + (302) TERPA4O2 + (303) TERPACO3 + (304) TERPF1O2 + (305) TERPF2O2 + (306) TERPNPS1O2 + (307) TERPNPT1O2 + (308) TERPNS1O2 + (309) TERPNT1O2 + (310) TOLO2 + (311) TOLUO2VBS + (312) XYLENO2 + (313) XYLEO2VBS + (314) XYLOLO2 + (315) H2O Photolysis jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) @@ -862,8 +862,8 @@ Class List H_HO2 ( 11) H + HO2 -> H2 + O2 rate = 6.90E-12 (178) H_HO2a ( 12) H + HO2 -> 2*OH rate = 7.20E-11 (179) H_HO2b ( 13) H + HO2 -> H2O + O rate = 1.60E-12 (180) - H_O2 ( 14) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (181) - ki=7.50E-11*(300/t)**-0.20 + H_O2 ( 14) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (181) + ki=9.50E-11*(300/t)**-0.40 f=0.60 HO2_O ( 15) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (182) HO2_O3 ( 16) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (183) @@ -878,23 +878,23 @@ Class List ki=2.60E-11 f=0.60 usr_HO2_HO2 ( 25) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (192) - HO2NO2_OH ( 26) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (193) + HO2NO2_OH ( 26) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (193) N_NO ( 27) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (194) N_NO2a ( 28) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (195) N_NO2b ( 29) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (196) N_NO2c ( 30) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (197) - N_O2 ( 31) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (198) + N_O2 ( 31) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (198) NO2_O ( 32) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (199) NO2_O3 ( 33) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (200) NO2_O_M ( 34) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (201) ki=2.20E-11*(300/t)**0.70 f=0.60 NO3_HO2 ( 35) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (202) - NO3_NO ( 36) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (203) - NO3_O ( 37) NO3 + O -> NO2 + O2 rate = 1.00E-11 (204) + NO3_NO ( 36) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (203) + NO3_O ( 37) NO3 + O -> NO2 + O2 rate = 1.30E-11 (204) NO3_OH ( 38) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (205) N_OH ( 39) N + OH -> NO + H rate = 5.00E-11 (206) - NO_HO2 ( 40) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (207) + NO_HO2 ( 40) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (207) NO_O3 ( 41) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (208) NO_O_M ( 42) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (209) ki=3.00E-11 @@ -1010,751 +1010,751 @@ Class List CH3OH_OH (139) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (306) CH3OOH_OH (140) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (307) CH4_OH (141) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (308) - CO_OH_M (142) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.00 (309) - ki=1.10E-12*(300/t)**-1.30 - f=0.60 - HCN_OH (143) HCN + OH + M -> HO2 + M troe : ko=4.28E-33 (310) - ki=9.30E-15*(300/t)**-4.42 + HCN_OH (142) HCN + OH + M -> HO2 + M troe : ko=6.10E-33*(300/t)**1.50 (309) + ki=9.80E-15*(300/t)**-4.60 f=0.80 - HCOOH_OH (144) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (311) - HMHP_OH (145) HMHP + OH -> 0.5*CH2O + 0.5*HO2 + 0.5*HCOOH + 0.5*OH + H2O rate = 1.30E-12*exp( 500./t) (312) - HOCH2OO_HO2 (146) HOCH2OO + HO2 -> 0.5*HMHP + 0.5*HCOOH + 0.3*H2O + 0.2*HO2 + 0.2*OH rate = 5.60E-15*exp( 2300./t) (313) - HOCH2OO_M (147) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (314) - HOCH2OO_NO (148) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (315) - O1D_CH4a (149) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (316) - O1D_CH4b (150) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (317) - O1D_CH4c (151) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (318) - O1D_HCN (152) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (319) - usr_CO_OH_b (153) CO + OH -> CO2 + H rate = ** User defined ** (320) - C2H2_CL_M (154) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (321) + HCOOH_OH (143) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (310) + HMHP_OH (144) HMHP + OH -> 0.5*CH2O + 0.5*HO2 + 0.5*HCOOH + 0.5*OH + H2O rate = 1.30E-12*exp( 500./t) (311) + HOCH2OO_HO2 (145) HOCH2OO + HO2 -> 0.5*HMHP + 0.5*HCOOH + 0.3*H2O + 0.2*HO2 + 0.2*OH rate = 5.60E-15*exp( 2300./t) (312) + HOCH2OO_M (146) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (313) + HOCH2OO_NO (147) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (314) + O1D_CH4a (148) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (315) + O1D_CH4b (149) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (316) + O1D_CH4c (150) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (317) + O1D_HCN (151) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (318) + usr_CO_OH (152) CO + OH -> CO2 + HO2 rate = ** User defined ** (319) + C2H2_CL_M (153) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (320) ki=2.20E-10*(300/t)**0.70 f=0.60 - C2H2_OH_M (155) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (322) + C2H2_OH_M (154) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (321) + 0.35*CO + M ki=8.30E-13*(300/t)**-2.00 f=0.60 - C2H4_CL_M (156) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (323) + C2H4_CL_M (155) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (322) ki=3.10E-10*(300/t) f=0.60 - C2H4_O3 (157) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (324) - C2H5O2_C2H5O2 (158) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (325) - C2H5O2_CH3O2 (159) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (326) + C2H4_O3 (156) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (323) + C2H5O2_C2H5O2 (157) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (324) + C2H5O2_CH3O2 (158) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (325) + 0.2*C2H5OH - C2H5O2_HO2 (160) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (327) - C2H5O2_NO (161) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (328) - C2H5OH_OH (162) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (329) - C2H5OOH_OH (163) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (330) - C2H6_CL (164) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (331) - C2H6_OH (165) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (332) - CH3CHO_NO3 (166) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (333) - CH3CHO_OH (167) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (334) - CH3CN_OH (168) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (335) - CH3CO3_CH3CO3 (169) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (336) - CH3CO3_CH3O2 (170) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (337) + C2H5O2_HO2 (159) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (326) + C2H5O2_NO (160) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (327) + C2H5OH_OH (161) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (328) + C2H5OOH_OH (162) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (329) + C2H6_CL (163) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (330) + C2H6_OH (164) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (331) + CH3CHO_NO3 (165) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (332) + CH3CHO_OH (166) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (333) + CH3CN_OH (167) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (334) + CH3CO3_CH3CO3 (168) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (335) + CH3CO3_CH3O2 (169) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (336) + 0.1*CH3COOH - CH3CO3_HO2 (171) CH3CO3 + HO2 -> 0.36*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.49*OH rate = 4.30E-13*exp( 1040./t) (338) + CH3CO3_HO2 (170) CH3CO3 + HO2 -> 0.36*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.49*OH rate = 4.30E-13*exp( 1040./t) (337) + 0.49*CH3O2 + 0.49*CO2 - CH3CO3_NO (172) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (339) - CH3COOH_OH (173) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 7.00E-13 (340) - CH3COOOH_OH (174) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (341) - EO2_HO2 (175) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (342) - EO2_NO (176) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (343) - EO_M (177) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (344) - EO_O2 (178) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (345) - GLYALD_OH (179) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (346) - GLYOXAL_OH (180) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (347) - HCOCH2OOH_OH (181) HCOCH2OOH + OH -> 0.89*GLYOXAL + 0.89*OH + 0.11*CH2O + 0.11*HO2 rate = 3.30E-11 (348) + CH3CO3_NO (171) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (338) + CH3COOH_OH (172) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 3.15E-14*exp( 920./t) (339) + CH3COOOH_OH (173) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (340) + EO2_HO2 (174) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (341) + EO2_NO (175) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (342) + EO_M (176) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (343) + EO_O2 (177) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (344) + GLYALD_OH (178) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (345) + GLYOXAL_OH (179) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (346) + HCOCH2OOH_OH (180) HCOCH2OOH + OH -> 0.89*GLYOXAL + 0.89*OH + 0.11*CH2O + 0.11*HO2 rate = 3.30E-11 (347) + 0.11*CO - NO3CH2CHO_OH (182) NO3CH2CHO + OH -> CO2 + CH2O + NO2 rate = 3.40E-12 (349) - PAN_OH (183) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (350) - tag_C2H4_OH (184) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (351) + NO3CH2CHO_OH (181) NO3CH2CHO + OH -> CO2 + CH2O + NO2 rate = 3.40E-12 (348) + PAN_OH (182) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (349) + tag_C2H4_OH (183) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (350) ki=9.00E-12*(300/t)**0.85 f=0.48 - tag_CH3CO3_NO2 (185) CH3CO3 + NO2 + M -> PAN + M troe : ko=9.70E-29*(300/t)**5.60 (352) - ki=9.30E-12*(300/t)**1.50 + tag_CH3CO3_NO2 (184) CH3CO3 + NO2 + M -> PAN + M troe : ko=7.30E-29*(300/t)**4.10 (351) + ki=9.50E-12*(300/t)**1.60 f=0.60 - usr_PAN_M (186) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (353) - C3H6_NO3 (187) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (354) - C3H6_O3 (188) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (355) + usr_PAN_M (185) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (352) + C3H6_NO3 (186) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (353) + C3H6_O3 (187) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (354) + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + 0.36*OH - C3H7O2_CH3O2 (189) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (356) - C3H7O2_HO2 (190) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (357) - C3H7O2_NO (191) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (358) - C3H7OOH_OH (192) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (359) - C3H8_OH (193) C3H8 + OH -> C3H7O2 + H2O rate = 8.70E-12*exp( -615./t) (360) - CH3COCHO_NO3 (194) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (361) - CH3COCHO_OH (195) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (362) - HYAC_OH (196) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (363) - HYPERACET_OH (197) HYPERACET + OH -> 0.3*CH3CO3 + 0.3*CH2O + 0.7*CH3COCHO + 0.7*OH rate = 1.20E-11 (364) - NOA_OH (198) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (365) - PO2_HO2 (199) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (366) - PO2_NO (200) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (367) - POOH_OH (201) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (368) - RO2_CH3O2 (202) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (369) + C3H7O2_CH3O2 (188) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (355) + C3H7O2_HO2 (189) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (356) + C3H7O2_NO (190) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (357) + C3H7OOH_OH (191) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (358) + C3H8_OH (192) C3H8 + OH -> C3H7O2 + H2O rate = 9.19E-12*exp( -630./t) (359) + CH3COCHO_NO3 (193) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (360) + CH3COCHO_OH (194) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (361) + HYAC_OH (195) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (362) + HYPERACET_OH (196) HYPERACET + OH -> 0.3*CH3CO3 + 0.3*CH2O + 0.7*CH3COCHO + 0.7*OH rate = 1.20E-11 (363) + NOA_OH (197) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (364) + PO2_HO2 (198) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (365) + PO2_NO (199) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (366) + POOH_OH (200) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (367) + RO2_CH3O2 (201) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (368) + 0.5*CH3COCHO + 0.5*CH3OH - RO2_HO2 (203) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (370) - RO2_NO (204) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (371) - ROOH_OH (205) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (372) - tag_C3H6_OH (206) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (373) + RO2_HO2 (202) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (369) + RO2_NO (203) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (370) + ROOH_OH (204) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (371) + tag_C3H6_OH (205) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (372) ki=3.00E-11 f=0.50 - usr_CH3COCH3_OH (207) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (374) - BIGENE_NO3 (208) BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 rate = 3.50E-13 (375) - BIGENE_OH (209) BIGENE + OH -> ENEO2 rate = 5.40E-11 (376) - DHPMPAL_OH (210) DHPMPAL + OH -> HYPERACET + CO + OH rate = 3.77E-11 (377) - ENEO2_NO (211) ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 rate = 4.80E-12*exp( 120./t) (378) - ENEO2_NOb (212) ENEO2 + NO -> HONITR rate = 5.10E-14*exp( 693./t) (379) - HONITR_OH (213) HONITR + OH -> ONITR + HO2 rate = 2.00E-12 (380) - MACRN_OH (214) MACRN + OH -> CO + 0.5*HO2 + 0.5*NOA + 0.5*NO2 + 0.5*HYAC rate = 1.29E-11 (381) - MACRO2_CH3CO3 (215) MACRO2 + CH3CO3 -> HO2 + 0.86*HYAC + 0.86*CO + 0.14*CH2O rate = 2.00E-12*exp( 500./t) (382) + usr_CH3COCH3_OH (206) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (373) + BIGENE_NO3 (207) BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 rate = 3.50E-13 (374) + BIGENE_OH (208) BIGENE + OH -> ENEO2 rate = 5.40E-11 (375) + DHPMPAL_OH (209) DHPMPAL + OH -> HYPERACET + CO + OH rate = 3.77E-11 (376) + ENEO2_NO (210) ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 rate = 4.80E-12*exp( 120./t) (377) + ENEO2_NOb (211) ENEO2 + NO -> HONITR rate = 5.10E-14*exp( 693./t) (378) + HONITR_OH (212) HONITR + OH -> ONITR + HO2 rate = 2.00E-12 (379) + MACRN_OH (213) MACRN + OH -> CO + 0.5*HO2 + 0.5*NOA + 0.5*NO2 + 0.5*HYAC rate = 1.29E-11 (380) + MACRO2_CH3CO3 (214) MACRO2 + CH3CO3 -> HO2 + 0.86*HYAC + 0.86*CO + 0.14*CH2O rate = 2.00E-12*exp( 500./t) (381) + 0.14*CH3COCHO + CO2 + CH3O2 - MACRO2_CH3O2 (216) MACRO2 + CH3O2 -> 0.9*HYAC + 0.9*CO + 1.5*HO2 + 0.1*CH3COCH3 rate = 4.50E-14 (383) + MACRO2_CH3O2 (215) MACRO2 + CH3O2 -> 0.9*HYAC + 0.9*CO + 1.5*HO2 + 0.1*CH3COCH3 rate = 4.50E-14 (382) + 1.1*CH2O - MACRO2_HO2 (217) MACRO2 + HO2 -> 0.41*MACROOH + 0.59*OH + 0.59*HO2 + 0.51*HYAC rate = 2.11E-13*exp( 1300./t) (384) + MACRO2_HO2 (216) MACRO2 + HO2 -> 0.41*MACROOH + 0.59*OH + 0.59*HO2 + 0.51*HYAC rate = 2.11E-13*exp( 1300./t) (383) + 0.51*CO + 0.08*CH3COCHO + 0.08*CH2O - MACRO2_isom (218) MACRO2 -> HYAC + CO + OH rate = 2.90E+07*exp( -5297./t) (385) - MACR_O3 (219) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (386) + MACRO2_isom (217) MACRO2 -> HYAC + CO + OH rate = 2.90E+07*exp( -5297./t) (384) + MACR_O3 (218) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (385) + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 - MACR_OH (220) MACR + OH -> 0.55*MACRO2 + 0.45*H2O + 0.45*MCO3 rate = 9.60E-12*exp( 360./t) (387) - MACROOH_OH (221) MACROOH + OH -> HYAC + CO + OH rate = 3.77E-11 (388) - MCO3_CH3CO3 (222) MCO3 + CH3CO3 -> 2*CO2 + 0.35*CH3CO3 + CH2O + 1.65*CH3O2 + 0.65*CO rate = 2.90E-12*exp( 500./t) (389) - MCO3_CH3O2 (223) MCO3 + CH3O2 -> CO2 + 0.35*CH3CO3 + 2*CH2O + 0.65*CH3O2 + 0.65*CO rate = 2.00E-12*exp( 500./t) (390) + MACR_OH (219) MACR + OH -> 0.55*MACRO2 + 0.45*H2O + 0.45*MCO3 rate = 9.60E-12*exp( 360./t) (386) + MACROOH_OH (220) MACROOH + OH -> HYAC + CO + OH rate = 3.77E-11 (387) + MCO3_CH3CO3 (221) MCO3 + CH3CO3 -> 2*CO2 + 0.35*CH3CO3 + CH2O + 1.65*CH3O2 + 0.65*CO rate = 2.90E-12*exp( 500./t) (388) + MCO3_CH3O2 (222) MCO3 + CH3O2 -> CO2 + 0.35*CH3CO3 + 2*CH2O + 0.65*CH3O2 + 0.65*CO rate = 2.00E-12*exp( 500./t) (389) + HO2 - MCO3_HO2 (224) MCO3 + HO2 -> 0.49*CH2O + 0.49*OH + 0.49*CO2 + 0.17*CH3CO3 rate = 4.30E-13*exp( 1040./t) (391) + MCO3_HO2 (223) MCO3 + HO2 -> 0.49*CH2O + 0.49*OH + 0.49*CO2 + 0.17*CH3CO3 rate = 4.30E-13*exp( 1040./t) (390) + 0.32*CH3O2 + 0.32*CO + 0.15*O3 + 0.15*CH3COOH + 0.36*CH3COOOH - MCO3_MCO3 (225) MCO3 + MCO3 -> 2*CO2 + 0.7*CH3CO3 + 2*CH2O + 1.3*CH3O2 + 1.3*CO rate = 2.90E-12*exp( 500./t) (392) - MCO3_NO (226) MCO3 + NO -> NO2 + CO2 + 0.35*CH3CO3 + CH2O + 0.65*CH3O2 + 0.65*CO rate = 8.10E-12*exp( 270./t) (393) - MCO3_NO3 (227) MCO3 + NO3 -> NO2 + CO2 + 0.35*CH3CO3 + CH2O + 0.65*CH3O2 + 0.65*CO rate = 4.00E-12 (394) - MEKO2_HO2 (228) MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 rate = 7.50E-13*exp( 700./t) (395) - MEKO2_NO (229) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (396) - MEK_OH (230) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (397) - MEKOOH_OH (231) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (398) - MPAN_OH_M (232) MPAN + OH + M -> 0.25*HYAC + NO3 + 0.25*CO + M troe : ko=8.00E-27*(300/t)**3.50 (399) + MCO3_MCO3 (224) MCO3 + MCO3 -> 2*CO2 + 0.7*CH3CO3 + 2*CH2O + 1.3*CH3O2 + 1.3*CO rate = 2.90E-12*exp( 500./t) (391) + MCO3_NO (225) MCO3 + NO -> NO2 + CO2 + 0.35*CH3CO3 + CH2O + 0.65*CH3O2 + 0.65*CO rate = 8.10E-12*exp( 270./t) (392) + MCO3_NO3 (226) MCO3 + NO3 -> NO2 + CO2 + 0.35*CH3CO3 + CH2O + 0.65*CH3O2 + 0.65*CO rate = 4.00E-12 (393) + MEKO2_HO2 (227) MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 rate = 7.50E-13*exp( 700./t) (394) + MEKO2_NO (228) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (395) + MEK_OH (229) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (396) + MEKOOH_OH (230) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (397) + MPAN_OH_M (231) MPAN + OH + M -> 0.25*HYAC + NO3 + 0.25*CO + M troe : ko=8.00E-27*(300/t)**3.50 (398) ki=3.00E-11 f=0.50 - MVKN_OH (233) MVKN + OH -> HO2 + 0.5*ONITR + 0.5*CO + 0.5*NOA rate = 1.78E-12 (400) - MVKO2_CH3CO3 (234) MVKO2 + CH3CO3 -> CH3O2 + CO2 + 0.75*GLYALD + 0.75*CH3CO3 rate = 2.00E-12*exp( 500./t) (401) + MVKN_OH (232) MVKN + OH -> HO2 + 0.5*ONITR + 0.5*CO + 0.5*NOA rate = 1.78E-12 (399) + MVKO2_CH3CO3 (233) MVKO2 + CH3CO3 -> CH3O2 + CO2 + 0.75*GLYALD + 0.75*CH3CO3 rate = 2.00E-12*exp( 500./t) (400) + 0.25*CH2O + 0.25*HO2 + 0.25*CH3COCHO - MVKO2_CH3O2 (235) MVKO2 + CH3O2 -> 0.25*CH3OH + CO + 0.87*CH2O + 0.62*HO2 rate = 6.10E-13 (402) + MVKO2_CH3O2 (234) MVKO2 + CH3O2 -> 0.25*CH3OH + CO + 0.87*CH2O + 0.62*HO2 rate = 6.10E-13 (401) + 0.38*GLYALD + 0.88*CH3CO3 + 0.12*CH3COCHO - MVKO2_HO2 (236) MVKO2 + HO2 -> 0.46*MVKOOH + 0.54*OH + 0.36*GLYALD + 0.49*CH3CO3 rate = 2.11E-13*exp( 1300./t) (403) + MVKO2_HO2 (235) MVKO2 + HO2 -> 0.46*MVKOOH + 0.54*OH + 0.36*GLYALD + 0.49*CH3CO3 rate = 2.11E-13*exp( 1300./t) (402) + 0.26*CO + 0.18*HO2 + 0.05*CH3COCHO + 0.05*CH2O - MVK_O3 (237) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (404) + MVK_O3 (236) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (403) + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH - MVK_OH (238) MVK + OH -> MVKO2 rate = 2.70E-12*exp( 580./t) (405) - MVKOOH_OH (239) MVKOOH + OH -> 1.56*CO + 0.44*HO2 + 0.44*CH3COCHO + 0.56*CH3CO3 rate = 4.80E-11 (406) - tag_MCO3_NO2 (240) MCO3 + NO2 + M -> MPAN + M troe : ko=9.70E-29*(300/t)**5.60 (407) + MVK_OH (237) MVK + OH -> MVKO2 rate = 2.70E-12*exp( 580./t) (404) + MVKOOH_OH (238) MVKOOH + OH -> 1.56*CO + 0.44*HO2 + 0.44*CH3COCHO + 0.56*CH3CO3 rate = 4.80E-11 (405) + tag_MCO3_NO2 (239) MCO3 + NO2 + M -> MPAN + M troe : ko=9.70E-29*(300/t)**5.60 (406) ki=9.30E-12*(300/t)**1.50 f=0.60 - usr_MPAN_M (241) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (408) - ALKNIT_OH (242) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (409) - ALKO2_HO2 (243) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (410) - ALKO2_NO (244) ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK rate = 6.70E-12 (411) + usr_MPAN_M (240) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (407) + ALKNIT_OH (241) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (408) + ALKO2_HO2 (242) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (409) + ALKO2_NO (243) ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK rate = 6.70E-12 (410) + NO2 - ALKO2_NOb (245) ALKO2 + NO -> ALKNIT rate = 5.40E-14*exp( 870./t) (412) - ALKOOH_OH (246) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (413) - BIGALK_OH (247) BIGALK + OH -> ALKO2 rate = 3.50E-12 (414) - HPALD1_OH (248) HPALD1 + OH -> 0.51*HO2 + 1.06*CO + 0.38*CH3COCHO + 0.54*CO2 rate = 1.17E-11*exp( 450./t) (415) + ALKO2_NOb (244) ALKO2 + NO -> ALKNIT rate = 5.40E-14*exp( 870./t) (411) + ALKOOH_OH (245) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (412) + BIGALK_OH (246) BIGALK + OH -> ALKO2 rate = 3.50E-12 (413) + HPALD1_OH (247) HPALD1 + OH -> 0.51*HO2 + 1.06*CO + 0.38*CH3COCHO + 0.54*CO2 rate = 1.17E-11*exp( 450./t) (414) + 0.06*CH3O2 + 0.06*CH3CO3 + 0.08*ICHE + 0.07*DHPMPAL + 0.43*OH + 0.35*MVK - HPALD4_OH (249) HPALD4 + OH -> 0.41*HO2 + 0.76*CO + 0.03*CH3COCHO + 0.54*CO2 rate = 1.17E-11*exp( 450./t) (416) + HPALD4_OH (248) HPALD4 + OH -> 0.41*HO2 + 0.76*CO + 0.03*CH3COCHO + 0.54*CO2 rate = 1.17E-11*exp( 450./t) (415) + 0.06*CH3O2 + 0.06*CH3CO3 + 0.15*HYPERACET + 0.18*ICHE + 0.17*DHPMPAL + 0.35*MACR + 0.53*OH - HPALDB1C_OH (250) HPALDB1C + OH -> 0.58*ICHE + OH + 0.42*CO + 0.23*MVK + 0.19*MVKOOH rate = 2.20E-11*exp( 390./t) (417) - HPALDB4C_OH (251) HPALDB4C + OH -> 0.77*ICHE + OH + 0.23*CO + 0.14*MACR rate = 3.50E-11*exp( 390./t) (418) + HPALDB1C_OH (249) HPALDB1C + OH -> 0.58*ICHE + OH + 0.42*CO + 0.23*MVK + 0.19*MVKOOH rate = 2.20E-11*exp( 390./t) (416) + HPALDB4C_OH (250) HPALDB4C + OH -> 0.77*ICHE + OH + 0.23*CO + 0.14*MACR rate = 3.50E-11*exp( 390./t) (417) + 0.09*MACROOH - HYDRALD_OH (252) HYDRALD + OH -> 1.08*OH + CO + 0.36*CO2 + 0.46*CH3COCHO rate = 6.42E-11 (419) + HYDRALD_OH (251) HYDRALD + OH -> 1.08*OH + CO + 0.36*CO2 + 0.46*CH3COCHO rate = 6.42E-11 (418) + 0.32*IEPOXOO + 0.22*HYAC + 0.32*HO2 - ICHE_OH (253) ICHE + OH -> OH + 1.5*CO + 0.5*HYAC + 0.5*CH3COCHO + 0.5*CH2O rate = 9.85E-12*exp( 410./t) (420) - IEPOX_OH (254) IEPOX + OH -> 0.19*ICHE + 0.19*HO2 + 0.81*IEPOXOO rate = 4.43E-11*exp( -400./t) (421) - IEPOXOO_HO2 (255) IEPOXOO + HO2 -> 0.35*ISOPHFP + 0.65*OH + 0.65*HO2 + 0.26*CO rate = 2.38E-13*exp( 1300./t) (422) + ICHE_OH (252) ICHE + OH -> OH + 1.5*CO + 0.5*HYAC + 0.5*CH3COCHO + 0.5*CH2O rate = 9.85E-12*exp( 410./t) (419) + IEPOX_OH (253) IEPOX + OH -> 0.19*ICHE + 0.19*HO2 + 0.81*IEPOXOO rate = 4.43E-11*exp( -400./t) (420) + IEPOXOO_HO2 (254) IEPOXOO + HO2 -> 0.35*ISOPHFP + 0.65*OH + 0.65*HO2 + 0.26*CO rate = 2.38E-13*exp( 1300./t) (421) + 0.37*GLYALD + 0.46*CH3COCHO + 0.15*GLYOXAL + 0.19*HYAC - INHEB_OH (256) INHEB + OH -> 0.2*INHEB + 0.4*NC4CHOO2 + 0.4*CH3COCHO + 0.4*HCOOH rate = 4.43E-11*exp( -400./t) (423) + INHEB_OH (255) INHEB + OH -> 0.2*INHEB + 0.4*NC4CHOO2 + 0.4*CH3COCHO + 0.4*HCOOH rate = 4.43E-11*exp( -400./t) (422) + 0.4*CH2O + 0.4*NO2 - INHED_OH (257) INHED + OH -> 0.35*NOA + 0.35*CO + 0.4*HO2 + 0.59*CH2O rate = 3.22E-11*exp( -400./t) (424) + INHED_OH (256) INHED + OH -> 0.35*NOA + 0.35*CO + 0.4*HO2 + 0.59*CH2O rate = 3.22E-11*exp( -400./t) (423) + 0.35*NC4CHOO2 + 0.06*INHED + 0.19*HYAC + 0.19*CO2 + 0.19*NO2 + 0.05*MVKN - ISOPB1O2_CH3CO3 (258) ISOPB1O2 + CH3CO3 -> MVK + CH2O + HO2 + CO2 + CH3O2 rate = 2.00E-12*exp( 500./t) (425) - ISOPB1O2_CH3O2 (259) ISOPB1O2 + CH3O2 -> 1.75*CH2O + 0.25*ISOPOH + 0.75*MVK + 1.5*HO2 rate = 1.60E-13 (426) - ISOPB1O2_HO2 (260) ISOPB1O2 + HO2 -> 0.06*MVK + 0.06*CH2O + 0.06*OH + 0.06*HO2 rate = 2.12E-13*exp( 1300./t) (427) + ISOPB1O2_CH3CO3 (257) ISOPB1O2 + CH3CO3 -> MVK + CH2O + HO2 + CO2 + CH3O2 rate = 2.00E-12*exp( 500./t) (424) + ISOPB1O2_CH3O2 (258) ISOPB1O2 + CH3O2 -> 1.75*CH2O + 0.25*ISOPOH + 0.75*MVK + 1.5*HO2 rate = 1.60E-13 (425) + ISOPB1O2_HO2 (259) ISOPB1O2 + HO2 -> 0.06*MVK + 0.06*CH2O + 0.06*OH + 0.06*HO2 rate = 2.12E-13*exp( 1300./t) (426) + 0.94*ISOPOOH - ISOPB1O2_I (261) ISOPB1O2 -> MVK + CH2O + OH rate = 1.04E+11*exp( -9746./t) (428) - ISOPB1O2_M_C (262) ISOPB1O2 -> ISOPC1C + O2 rate = 2.24E+15*exp( -10865./t) (429) - ISOPB1O2_M_T (263) ISOPB1O2 -> ISOPC1T + O2 rate = 2.22E+15*exp( -10355./t) (430) - ISOPB4O2_CH3CO3 (264) ISOPB4O2 + CH3CO3 -> MACR + CH2O + HO2 + CO2 + CH3O2 rate = 2.00E-12*exp( 500./t) (431) - ISOPB4O2_CH3O2 (265) ISOPB4O2 + CH3O2 -> 0.25*CH3OH + 0.25*HYDRALD + 0.25*ISOPOH rate = 1.40E-12 (432) + ISOPB1O2_I (260) ISOPB1O2 -> MVK + CH2O + OH rate = 1.04E+11*exp( -9746./t) (427) + ISOPB1O2_M_C (261) ISOPB1O2 -> ISOPC1C + O2 rate = 2.24E+15*exp( -10865./t) (428) + ISOPB1O2_M_T (262) ISOPB1O2 -> ISOPC1T + O2 rate = 2.22E+15*exp( -10355./t) (429) + ISOPB4O2_CH3CO3 (263) ISOPB4O2 + CH3CO3 -> MACR + CH2O + HO2 + CO2 + CH3O2 rate = 2.00E-12*exp( 500./t) (430) + ISOPB4O2_CH3O2 (264) ISOPB4O2 + CH3O2 -> 0.25*CH3OH + 0.25*HYDRALD + 0.25*ISOPOH rate = 1.40E-12 (431) + 1.25*CH2O + HO2 + 0.5*MACR - ISOPB4O2_HO2 (266) ISOPB4O2 + HO2 -> 0.06*MACR + 0.06*CH2O + 0.06*OH + 0.06*HO2 rate = 2.12E-13*exp( 1300./t) (433) + ISOPB4O2_HO2 (265) ISOPB4O2 + HO2 -> 0.06*MACR + 0.06*CH2O + 0.06*OH + 0.06*HO2 rate = 2.12E-13*exp( 1300./t) (432) + 0.94*ISOPOOH - ISOPB4O2_I (267) ISOPB4O2 -> MACR + CH2O + OH rate = 1.88E+11*exp( -9752./t) (434) - ISOPB4O2_M_C (268) ISOPB4O2 -> ISOPC4C + O2 rate = 2.49E+15*exp( -11112./t) (435) - ISOPB4O2_M_T (269) ISOPB4O2 -> ISOPC4T + O2 rate = 2.49E+15*exp( -10890./t) (436) - ISOPC1C_O2_B (270) O2 + ISOPC1C -> ISOPB1O2 rate = 7.50E-13 (437) - ISOPC1C_O2_D (271) ISOPC1C + O2 -> ISOPZD1O2 rate = 1.40E-13 (438) - ISOPC1T_O2_B (272) ISOPC1T + O2 -> ISOPB1O2 rate = 7.50E-13 (439) - ISOPC1T_O2_D (273) ISOPC1T + O2 -> ISOPED1O2 rate = 3.60E-13 (440) - ISOPC4C_O2_B (274) ISOPC4C + O2 -> ISOPB4O2 rate = 6.50E-13 (441) - ISOPC4C_O2_D (275) ISOPC4C + O2 -> ISOPZD4O2 rate = 2.10E-13 (442) - ISOPC4T_O2_B (276) ISOPC4T + O2 -> ISOPB4O2 rate = 6.50E-13 (443) - ISOPC4T_O2_D (277) ISOPC4T + O2 -> ISOPED4O2 rate = 4.90E-13 (444) - ISOPED1O2_CH3CO3 (278) ISOPED1O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH rate = 2.00E-12*exp( 500./t) (445) + ISOPB4O2_I (266) ISOPB4O2 -> MACR + CH2O + OH rate = 1.88E+11*exp( -9752./t) (433) + ISOPB4O2_M_C (267) ISOPB4O2 -> ISOPC4C + O2 rate = 2.49E+15*exp( -11112./t) (434) + ISOPB4O2_M_T (268) ISOPB4O2 -> ISOPC4T + O2 rate = 2.49E+15*exp( -10890./t) (435) + ISOPC1C_O2_B (269) O2 + ISOPC1C -> ISOPB1O2 rate = 7.50E-13 (436) + ISOPC1C_O2_D (270) ISOPC1C + O2 -> ISOPZD1O2 rate = 1.40E-13 (437) + ISOPC1T_O2_B (271) ISOPC1T + O2 -> ISOPB1O2 rate = 7.50E-13 (438) + ISOPC1T_O2_D (272) ISOPC1T + O2 -> ISOPED1O2 rate = 3.60E-13 (439) + ISOPC4C_O2_B (273) ISOPC4C + O2 -> ISOPB4O2 rate = 6.50E-13 (440) + ISOPC4C_O2_D (274) ISOPC4C + O2 -> ISOPZD4O2 rate = 2.10E-13 (441) + ISOPC4T_O2_B (275) ISOPC4T + O2 -> ISOPB4O2 rate = 6.50E-13 (442) + ISOPC4T_O2_D (276) ISOPC4T + O2 -> ISOPED4O2 rate = 4.90E-13 (443) + ISOPED1O2_CH3CO3 (277) ISOPED1O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH rate = 2.00E-12*exp( 500./t) (444) + 0.55*MVKOOH + CO2 + CH3O2 - ISOPED1O2_CH3O2 (279) ISOPED1O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O rate = 1.20E-12 (446) + ISOPED1O2_CH3O2 (278) ISOPED1O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O rate = 1.20E-12 (445) + 0.72*HO2 + 0.28*CO + 0.28*OH + 0.28*MVKOOH + 0.47*HYDRALD - ISOPED1O2_HO2 (280) ISOPED1O2 + HO2 -> ISOPOOH rate = 2.12E-13*exp( 1300./t) (447) - ISOPED1O2_M_C (281) ISOPED1O2 -> ISOPC1T + O2 rate = 1.83E+14*exp( -8930./t) (448) - ISOPED4O2_CH3CO3 (282) ISOPED4O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH rate = 2.00E-12*exp( 500./t) (449) + ISOPED1O2_HO2 (279) ISOPED1O2 + HO2 -> ISOPOOH rate = 2.12E-13*exp( 1300./t) (446) + ISOPED1O2_M_C (280) ISOPED1O2 -> ISOPC1T + O2 rate = 1.83E+14*exp( -8930./t) (447) + ISOPED4O2_CH3CO3 (281) ISOPED4O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH rate = 2.00E-12*exp( 500./t) (448) + 0.55*MACROOH + CO2 + CH3O2 - ISOPED4O2_CH3O2 (283) ISOPED4O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O rate = 9.80E-13 (450) + ISOPED4O2_CH3O2 (282) ISOPED4O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O rate = 9.80E-13 (449) + 0.72*HO2 + 0.28*CO + 0.28*OH + 0.28*MACROOH + 0.47*HYDRALD - ISOPED4O2_HO2 (284) ISOPED4O2 + HO2 -> ISOPOOH rate = 2.12E-13*exp( 1300./t) (451) - ISOPED4O2_M (285) ISOPED4O2 -> ISOPC4T + O2 rate = 2.08E+14*exp( -9400./t) (452) - ISOPFDNC_OH (286) ISOPFDNC + OH -> CO + NO2 + 0.5*MACRN + 0.5*MVKN rate = 1.85E-11 (453) - ISOPFDN_OH (287) ISOPFDN + OH -> ISOPFDNC + HO2 rate = 1.63E-12 (454) - ISOPFNC_OH (288) ISOPFNC + OH -> CO + 0.5*NO2 + 0.5*OH + 0.25*MACRN + 0.25*MVKN rate = 2.50E-11 (455) + ISOPED4O2_HO2 (283) ISOPED4O2 + HO2 -> ISOPOOH rate = 2.12E-13*exp( 1300./t) (450) + ISOPED4O2_M (284) ISOPED4O2 -> ISOPC4T + O2 rate = 2.08E+14*exp( -9400./t) (451) + ISOPFDNC_OH (285) ISOPFDNC + OH -> CO + NO2 + 0.5*MACRN + 0.5*MVKN rate = 1.85E-11 (452) + ISOPFDN_OH (286) ISOPFDN + OH -> ISOPFDNC + HO2 rate = 1.63E-12 (453) + ISOPFNC_OH (287) ISOPFNC + OH -> CO + 0.5*NO2 + 0.5*OH + 0.25*MACRN + 0.25*MVKN rate = 2.50E-11 (454) + 0.25*MACROOH + 0.25*MVKOOH - ISOPFNP_OH (289) ISOPFNP + OH -> ISOPFNC + HO2 rate = 1.10E-11 (456) - ISOPHFP_OH (290) ISOPHFP + OH -> 2*CO + OH + 0.72*CH3COCHO + 0.28*HYAC rate = 3.30E-11 (457) - ISOPN1DO2_HO2 (291) ISOPN1DO2 + HO2 -> 0.42*ISOPFNP + 0.58*OH + 0.58*HO2 + 0.55*NOA rate = 2.60E-13*exp( 1300./t) (458) + ISOPFNP_OH (288) ISOPFNP + OH -> ISOPFNC + HO2 rate = 1.10E-11 (455) + ISOPHFP_OH (289) ISOPHFP + OH -> 2*CO + OH + 0.72*CH3COCHO + 0.28*HYAC rate = 3.30E-11 (456) + ISOPN1DO2_HO2 (290) ISOPN1DO2 + HO2 -> 0.42*ISOPFNP + 0.58*OH + 0.58*HO2 + 0.55*NOA rate = 2.60E-13*exp( 1300./t) (457) + 0.55*GLYALD + 0.03*MACRN + 0.03*CH2O - ISOPN1DO2_I (292) ISOPN1DO2 -> ISOPFNP + HO2 rate = 1.26E+13*exp( -10000./t) (459) - ISOPN1D_O3 (293) ISOPN1D + O3 -> 0.66*H2O2 + 0.83*GLYALD + 0.83*NOA + 0.34*OH rate = 2.80E-17 (460) + ISOPN1DO2_I (291) ISOPN1DO2 -> ISOPFNP + HO2 rate = 1.26E+13*exp( -10000./t) (458) + ISOPN1D_O3 (292) ISOPN1D + O3 -> 0.66*H2O2 + 0.83*GLYALD + 0.83*NOA + 0.34*OH rate = 2.80E-17 (459) + 0.17*NO2 + 0.17*CH3COCHO + 0.17*GLYOXAL + 0.17*HO2 - ISOPN1D_OH (294) ISOPN1D + OH -> 0.08*IEPOX + 0.08*NO2 + 0.04*NC4CHO + 0.04*HO2 rate = 8.00E-11 (461) + ISOPN1D_OH (293) ISOPN1D + OH -> 0.08*IEPOX + 0.08*NO2 + 0.04*NC4CHO + 0.04*HO2 rate = 8.00E-11 (460) + 0.06*MACRN + 0.06*OH + 0.06*CO + 0.82*ISOPN1DO2 - ISOPN2BO2_HO2 (295) ISOPN2BO2 + HO2 -> 0.48*ISOPFNP + 0.52*OH + 0.06*MACRN + 0.06*CH2O rate = 2.60E-13*exp( 1300./t) (462) + ISOPN2BO2_HO2 (294) ISOPN2BO2 + HO2 -> 0.48*ISOPFNP + 0.52*OH + 0.06*MACRN + 0.06*CH2O rate = 2.60E-13*exp( 1300./t) (461) + 0.06*HO2 + 0.46*HYAC + 0.46*NO2 + 0.46*GLYALD - ISOPN2BO2_I (296) ISOPN2BO2 -> ISOPFNC + HO2 rate = 1.88E+13*exp( -10000./t) (463) - ISOPN2B_OH (297) ISOPN2B + OH -> 0.15*IEPOX + 0.15*NO2 + 0.85*ISOPN2BO2 rate = 3.00E-11 (464) - ISOPN3BO2_HO2 (298) ISOPN3BO2 + HO2 -> 0.4*ISOPFNP + 0.6*OH + 0.6*MVKN + 0.6*CH2O rate = 2.60E-13*exp( 1300./t) (465) + ISOPN2BO2_I (295) ISOPN2BO2 -> ISOPFNC + HO2 rate = 1.88E+13*exp( -10000./t) (462) + ISOPN2B_OH (296) ISOPN2B + OH -> 0.15*IEPOX + 0.15*NO2 + 0.85*ISOPN2BO2 rate = 3.00E-11 (463) + ISOPN3BO2_HO2 (297) ISOPN3BO2 + HO2 -> 0.4*ISOPFNP + 0.6*OH + 0.6*MVKN + 0.6*CH2O rate = 2.60E-13*exp( 1300./t) (464) + 0.6*HO2 - ISOPN3BO2_I (299) ISOPN3BO2 -> ISOPFNC + HO2 rate = 1.88E+13*exp( -10000./t) (466) - ISOPN3B_OH (300) ISOPN3B + OH -> 0.13*IEPOX + 0.13*NO2 + 0.87*ISOPN3BO2 rate = 4.20E-11 (467) - ISOPN4DO2_HO2 (301) ISOPN4DO2 + HO2 -> 0.5*ISOPFNP + 0.5*OH + 0.5*HO2 + 0.06*MVKN rate = 2.60E-13*exp( 1300./t) (468) + ISOPN3BO2_I (298) ISOPN3BO2 -> ISOPFNC + HO2 rate = 1.88E+13*exp( -10000./t) (465) + ISOPN3B_OH (299) ISOPN3B + OH -> 0.13*IEPOX + 0.13*NO2 + 0.87*ISOPN3BO2 rate = 4.20E-11 (466) + ISOPN4DO2_HO2 (300) ISOPN4DO2 + HO2 -> 0.5*ISOPFNP + 0.5*OH + 0.5*HO2 + 0.06*MVKN rate = 2.60E-13*exp( 1300./t) (467) + 0.06*CH2O + 0.44*HYAC + 0.44*NO3CH2CHO - ISOPN4DO2_I (302) ISOPN4DO2 -> ISOPFNP + HO2 rate = 5.09E+12*exp( -10000./t) (469) - ISOPN4D_O3 (303) ISOPN4D + O3 -> 0.66*H2O2 + 0.83*NO3CH2CHO + 0.83*HYAC + 0.34*OH rate = 2.80E-17 (470) + ISOPN4DO2_I (301) ISOPN4DO2 -> ISOPFNP + HO2 rate = 5.09E+12*exp( -10000./t) (468) + ISOPN4D_O3 (302) ISOPN4D + O3 -> 0.66*H2O2 + 0.83*NO3CH2CHO + 0.83*HYAC + 0.34*OH rate = 2.80E-17 (469) + 0.17*NO2 + 0.17*GLYOXAL + 0.17*CH3COCHO + 0.17*HO2 - ISOPN4D_OH (304) ISOPN4D + OH -> 0.04*IEPOX + 0.04*NO2 + 0.03*NC4CHO + 0.03*HO2 rate = 1.10E-10 (471) + ISOPN4D_OH (303) ISOPN4D + OH -> 0.04*IEPOX + 0.04*NO2 + 0.03*NC4CHO + 0.03*HO2 rate = 1.10E-10 (470) + 0.04*MVKN + 0.04*CO + 0.04*OH + 0.89*ISOPN4DO2 - ISOPNBNO3O2_HO2 (305) ISOPNBNO3O2 + HO2 -> 0.6*ISOPFNP + 0.4*OH + 0.4*HO2 + 0.06*MACRN rate = 2.60E-13*exp( 1300./t) (472) + ISOPNBNO3O2_HO2 (304) ISOPNBNO3O2 + HO2 -> 0.6*ISOPFNP + 0.4*OH + 0.4*HO2 + 0.06*MACRN rate = 2.60E-13*exp( 1300./t) (471) + 0.04*MVKN + 0.1*CH2O + 0.15*NOA + 0.15*GLYALD + 0.15*HYAC + 0.15*NO3CH2CHO - ISOPNBNO3_OH (306) ISOPNBNO3 + OH -> 0.03*INHED + 0.03*OH + 0.05*NC4CHO + 0.05*HO2 rate = 3.90E-11 (473) + ISOPNBNO3_OH (305) ISOPNBNO3 + OH -> 0.03*INHED + 0.03*OH + 0.05*NC4CHO + 0.05*HO2 rate = 3.90E-11 (472) + 0.92*ISOPNBNO3O2 - ISOP_NO3 (307) ISOP + NO3 -> ISOPNO3 rate = 2.95E-12*exp( -450./t) (474) - ISOPNO3_CH3CO3 (308) ISOPNO3 + CH3CO3 -> CH3O2 + CO2 + 0.46*NO2 + 0.46*CH2O rate = 2.00E-12*exp( 500./t) (475) + ISOP_NO3 (306) ISOP + NO3 -> ISOPNO3 rate = 2.95E-12*exp( -450./t) (473) + ISOPNO3_CH3CO3 (307) ISOPNO3 + CH3CO3 -> CH3O2 + CO2 + 0.46*NO2 + 0.46*CH2O rate = 2.00E-12*exp( 500./t) (474) + 0.54*NC4CHO + 0.54*HO2 + 0.42*MVK + 0.04*MACR - ISOPNO3_CH3O2 (309) ISOPNO3 + CH3O2 -> 0.07*ISOPNBNO3 + 0.71*CH2O + 0.05*MVK + 0.07*NO2 rate = 1.30E-12 (476) + ISOPNO3_CH3O2 (308) ISOPNO3 + CH3O2 -> 0.07*ISOPNBNO3 + 0.71*CH2O + 0.05*MVK + 0.07*NO2 rate = 1.30E-12 (475) + 0.4*HO2 + 0.02*MACR + 0.53*NC4CHO + 0.36*CH3OH + 0.28*ISOPN1D + 0.05*ISOPN4D - ISOPNO3_HO2 (310) ISOPNO3 + HO2 -> 0.23*ISOPNOOHB + 0.53*ISOPNOOHD + 0.22*MVK rate = 2.47E-13*exp( 1300./t) (477) + ISOPNO3_HO2 (309) ISOPNO3 + HO2 -> 0.23*ISOPNOOHB + 0.53*ISOPNOOHD + 0.22*MVK rate = 2.47E-13*exp( 1300./t) (476) + 0.02*MACR + 0.24*CH2O + 0.24*OH + 0.24*NO2 - ISOPNO3_ISOPNO3 (311) ISOPNO3 + ISOPNO3 -> 1.07*NC4CHO + 0.4*HO2 + 0.16*MACR + 0.16*CH2O rate = 5.00E-12 (478) + ISOPNO3_ISOPNO3 (310) ISOPNO3 + ISOPNO3 -> 1.07*NC4CHO + 0.4*HO2 + 0.16*MACR + 0.16*CH2O rate = 5.00E-12 (477) + 0.16*NO2 + 0.53*ISOPN1D + 0.09*ISOPN4D + 0.15*ISOPNBNO3 - ISOPNO3_NO3 (312) ISOPNO3 + NO3 -> 1.46*NO2 + 0.46*CH2O + 0.54*NC4CHO + 0.54*HO2 rate = 2.30E-12 (479) + ISOPNO3_NO3 (311) ISOPNO3 + NO3 -> 1.46*NO2 + 0.46*CH2O + 0.54*NC4CHO + 0.54*HO2 rate = 2.30E-12 (478) + 0.42*MVK + 0.04*MACR - ISOPNOOHBO2_HO2 (313) ISOPNOOHBO2 + HO2 -> 0.49*ISOPFNP + 0.85*OH + 0.17*CH2O + 0.17*HO2 rate = 2.64E-13*exp( 1300./t) (480) + ISOPNOOHBO2_HO2 (312) ISOPNOOHBO2 + HO2 -> 0.49*ISOPFNP + 0.85*OH + 0.17*CH2O + 0.17*HO2 rate = 2.64E-13*exp( 1300./t) (479) + 0.15*MACRN + 0.02*MVKN + 0.28*NOA + 0.28*GLYALD + 0.06*HYAC + 0.06*NO3CH2CHO - ISOPNOOHBO2_I (314) ISOPNOOHBO2 -> OH + ISOPFNP rate = 8.72E+12*exp( -10000./t) (481) - ISOPNOOHB_OH (315) ISOPNOOHB + OH -> 0.17*ISOPNO3 + 0.02*NC4CHO + 0.4*INHEB + 0.42*OH rate = 3.90E-11 (482) + ISOPNOOHBO2_I (313) ISOPNOOHBO2 -> OH + ISOPFNP rate = 8.72E+12*exp( -10000./t) (480) + ISOPNOOHB_OH (314) ISOPNOOHB + OH -> 0.17*ISOPNO3 + 0.02*NC4CHO + 0.4*INHEB + 0.42*OH rate = 3.90E-11 (481) + 0.41*ISOPNOOHBO2 - ISOPNOOHDO2_HO2 (316) ISOPNOOHDO2 + HO2 -> 0.17*ISOPFNP + 0.86*OH + 0.03*CH2O rate = 2.64E-13*exp( 1300./t) (483) + ISOPNOOHDO2_HO2 (315) ISOPNOOHDO2 + HO2 -> 0.17*ISOPFNP + 0.86*OH + 0.03*CH2O rate = 2.64E-13*exp( 1300./t) (482) + 0.02*MACRN + 0.01*MVKN + 0.68*NOA + 0.68*HCOCH2OOH + 0.12*HYPERACET + 0.12*NO3CH2CHO + 0.8*HO2 - ISOPNOOHDO2_I (317) ISOPNOOHDO2 -> OH + ISOPFNP rate = 6.55E+12*exp( -10000./t) (484) - ISOPNOOHD_O3 (318) ISOPNOOHD + O3 -> 0.66*H2O2 + 0.7*HCOCH2OOH + 0.13*HYPERACET rate = 2.80E-17 (485) + ISOPNOOHDO2_I (316) ISOPNOOHDO2 -> OH + ISOPFNP rate = 6.55E+12*exp( -10000./t) (483) + ISOPNOOHD_O3 (317) ISOPNOOHD + O3 -> 0.66*H2O2 + 0.7*HCOCH2OOH + 0.13*HYPERACET rate = 2.80E-17 (484) + 0.7*NOA + 0.13*NO3CH2CHO + 0.51*OH + 0.17*NO2 + 0.17*CH3COCHO + 0.17*GLYOXAL - ISOPNOOHD_OH (319) ISOPNOOHD + OH -> 0.07*ISOPNO3 + 0.09*NC4CHO + 0.29*OH + 0.2*INHED rate = 9.20E-11 (486) + ISOPNOOHD_OH (318) ISOPNOOHD + OH -> 0.07*ISOPNO3 + 0.09*NC4CHO + 0.29*OH + 0.2*INHED rate = 9.20E-11 (485) + 0.07*IEPOX + 0.07*NO2 + 0.57*ISOPNOOHDO2 - ISOP_O3 (320) ISOP + O3 -> 0.25*OH + 0.41*MACR + 0.17*MVK + 0.33*HMHP + 0.03*H2O2 rate = 1.03E-14*exp( -1995./t) (487) + ISOP_O3 (319) ISOP + O3 -> 0.25*OH + 0.41*MACR + 0.17*MVK + 0.33*HMHP + 0.03*H2O2 rate = 1.03E-14*exp( -1995./t) (486) + 0.22*HCOOH + 1.01*CH2O + 0.42*CO2 + 0.42*HO2 + 0.21*CH3O2 + 0.07*CH3CO3 + 0.35*CO - ISOP_OH (321) ISOP + OH -> 0.315*ISOPC1T + 0.315*ISOPC1C + 0.111*ISOPC4T rate = 2.70E-11*exp( 390./t) (488) + ISOP_OH (320) ISOP + OH -> 0.315*ISOPC1T + 0.315*ISOPC1C + 0.111*ISOPC4T rate = 2.70E-11*exp( 390./t) (487) + 0.259*ISOPC4C - ISOPOH_OH (322) ISOPOH + OH -> HYAC + GLYALD + HO2 rate = 3.85E-11 (489) - ISOPOOH_OH_abs (323) ISOPOOH + OH -> 0.53*ISOPB1O2 + 0.16*ISOPB4O2 + 0.13*HYDRALD rate = 5.53E-12*exp( 200./t) (490) + ISOPOH_OH (321) ISOPOH + OH -> HYAC + GLYALD + HO2 rate = 3.85E-11 (488) + ISOPOOH_OH_abs (322) ISOPOOH + OH -> 0.53*ISOPB1O2 + 0.16*ISOPB4O2 + 0.13*HYDRALD rate = 5.53E-12*exp( 200./t) (489) + 0.13*OH + 0.09*HPALDB1C + 0.09*HPALDB4C + 0.18*HO2 - ISOPOOH_OH_add (324) ISOPOOH + OH -> 0.85*IEPOX + 0.92*OH + 0.07*GLYALD + 0.07*HYAC rate = 2.08E-11*exp( 390./t) (491) + ISOPOOH_OH_add (323) ISOPOOH + OH -> 0.85*IEPOX + 0.92*OH + 0.07*GLYALD + 0.07*HYAC rate = 2.08E-11*exp( 390./t) (490) + 0.08*ISOPHFP - ISOPZD1O2_CH3CO3 (325) ISOPZD1O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH rate = 2.00E-12*exp( 500./t) (492) + ISOPZD1O2_CH3CO3 (324) ISOPZD1O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH rate = 2.00E-12*exp( 500./t) (491) + 0.55*MVKOOH + CO2 + CH3O2 - ISOPZD1O2_CH3O2 (326) ISOPZD1O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O rate = 1.20E-12 (493) + ISOPZD1O2_CH3O2 (325) ISOPZD1O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O rate = 1.20E-12 (492) + 0.72*HO2 + 0.28*CO + 0.28*OH + 0.28*MVKOOH + 0.47*HYDRALD - ISOPZD1O2_HO2 (327) ISOPZD1O2 + HO2 -> ISOPOOH rate = 2.12E-13*exp( 1300./t) (494) - ISOPZD1O2_M (328) ISOPZD1O2 -> ISOPC1C + O2 rate = 1.79E+14*exp( -8830./t) (495) - ISOPZD4O2_CH3CO3 (329) ISOPZD4O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH rate = 2.00E-12*exp( 500./t) (496) + ISOPZD1O2_HO2 (326) ISOPZD1O2 + HO2 -> ISOPOOH rate = 2.12E-13*exp( 1300./t) (493) + ISOPZD1O2_M (327) ISOPZD1O2 -> ISOPC1C + O2 rate = 1.79E+14*exp( -8830./t) (494) + ISOPZD4O2_CH3CO3 (328) ISOPZD4O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH rate = 2.00E-12*exp( 500./t) (495) + 0.55*MACROOH + CO2 + CH3O2 - ISOPZD4O2_CH3O2 (330) ISOPZD4O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O rate = 9.80E-13 (497) + ISOPZD4O2_CH3O2 (329) ISOPZD4O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O rate = 9.80E-13 (496) + 0.72*HO2 + 0.28*CO + 0.28*OH + 0.28*MACROOH + 0.47*HYDRALD - ISOPZD4O2_HO2 (331) ISOPZD4O2 + HO2 -> ISOPOOH rate = 2.12E-13*exp( 1300./t) (498) - ISOPZD4O2_M_C (332) ISOPZD4O2 -> ISOPC4C + O2 rate = 1.75E+14*exp( -9054./t) (499) - NC4CHOO2_HO2 (333) NC4CHOO2 + HO2 -> 0.2*ISOPFNP + 0.8*OH + 0.8*HO2 + 0.1*NOA rate = 2.60E-13*exp( 1300./t) (500) + ISOPZD4O2_HO2 (330) ISOPZD4O2 + HO2 -> ISOPOOH rate = 2.12E-13*exp( 1300./t) (497) + ISOPZD4O2_M_C (331) ISOPZD4O2 -> ISOPC4C + O2 rate = 1.75E+14*exp( -9054./t) (498) + NC4CHOO2_HO2 (332) NC4CHOO2 + HO2 -> 0.2*ISOPFNP + 0.8*OH + 0.8*HO2 + 0.1*NOA rate = 2.60E-13*exp( 1300./t) (499) + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*NO3CH2CHO + 0.29*MACRN + 0.31*MVKN + 0.6*CO - NC4CHOO2_isom (334) NC4CHOO2 -> 0.51*MACRN + 0.49*MVKN + CO + OH rate = 1.00E+07*exp( -5000./t) (501) - NC4CHO_O3 (335) NC4CHO + O3 -> 0.66*H2O2 + 0.66*GLYOXAL + 0.34*CH3COCHO + 0.61*NOA rate = 4.40E-18 (502) + NC4CHOO2_isom (333) NC4CHOO2 -> 0.51*MACRN + 0.49*MVKN + CO + OH rate = 1.00E+07*exp( -5000./t) (500) + NC4CHO_O3 (334) NC4CHO + O3 -> 0.66*H2O2 + 0.66*GLYOXAL + 0.34*CH3COCHO + 0.61*NOA rate = 4.40E-18 (501) + 0.22*NO3CH2CHO + 0.34*OH + 0.17*NO2 + 0.3*CO + 0.13*HO2 + 0.04*CH3CO3 - NC4CHO_OH (336) NC4CHO + OH -> 0.45*CO2 + 0.1*CH3CO3 + 0.1*NO3CH2CHO + 0.35*NOA rate = 3.60E-11 (503) + NC4CHO_OH (335) NC4CHO + OH -> 0.45*CO2 + 0.1*CH3CO3 + 0.1*NO3CH2CHO + 0.35*NOA rate = 3.60E-11 (502) + 0.04*NO2 + 0.04*ICHE + 0.24*MACRN + 0.04*MVKN + 0.63*CO + 0.63*HO2 + 0.23*NC4CHOO2 - usr_IEPOXOO_NOa (337) IEPOXOO + NO -> NO2 + HO2 + 0.57*GLYALD + 0.71*CH3COCHO + 0.4*CO rate = ** User defined ** (504) + usr_IEPOXOO_NOa (336) IEPOXOO + NO -> NO2 + HO2 + 0.57*GLYALD + 0.71*CH3COCHO + 0.4*CO rate = ** User defined ** (503) + 0.23*GLYOXAL + 0.29*HYAC - usr_IEPOXOO_NOn (338) IEPOXOO + NO -> ISOPFNC rate = ** User defined ** (505) - usr_ISOPB1O2_NOa (339) ISOPB1O2 + NO -> NO2 + MVK + CH2O + HO2 rate = ** User defined ** (506) - usr_ISOPB1O2_NOn (340) ISOPB1O2 + NO -> ISOPN2B rate = ** User defined ** (507) - usr_ISOPB4O2_NOa (341) ISOPB4O2 + NO -> NO2 + MACR + CH2O + HO2 rate = ** User defined ** (508) - usr_ISOPB4O2_NOn (342) ISOPB4O2 + NO -> ISOPN3B rate = ** User defined ** (509) - usr_ISOPED1O2_NO (343) ISOPED1O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MVKOOH rate = ** User defined ** (510) + usr_IEPOXOO_NOn (337) IEPOXOO + NO -> ISOPFNC rate = ** User defined ** (504) + usr_ISOPB1O2_NOa (338) ISOPB1O2 + NO -> NO2 + MVK + CH2O + HO2 rate = ** User defined ** (505) + usr_ISOPB1O2_NOn (339) ISOPB1O2 + NO -> ISOPN2B rate = ** User defined ** (506) + usr_ISOPB4O2_NOa (340) ISOPB4O2 + NO -> NO2 + MACR + CH2O + HO2 rate = ** User defined ** (507) + usr_ISOPB4O2_NOn (341) ISOPB4O2 + NO -> ISOPN3B rate = ** User defined ** (508) + usr_ISOPED1O2_NO (342) ISOPED1O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MVKOOH rate = ** User defined ** (509) + 0.55*CO + 0.55*OH - usr_ISOPED1O2_NO (344) ISOPED1O2 + NO -> ISOPN4D rate = ** User defined ** (511) - usr_ISOPED4O2_NO (345) ISOPED4O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MACROOH rate = ** User defined ** (512) + usr_ISOPED1O2_NO (343) ISOPED1O2 + NO -> ISOPN4D rate = ** User defined ** (510) + usr_ISOPED4O2_NO (344) ISOPED4O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MACROOH rate = ** User defined ** (511) + 0.55*CO + 0.55*OH - usr_ISOPED4O2_NO (346) ISOPED4O2 + NO -> ISOPN1D rate = ** User defined ** (513) - usr_ISOPN1DO2_NO (347) ISOPN1DO2 + NO -> NO2 + HO2 + 0.94*NOA + 0.94*GLYALD + 0.06*MACRN rate = ** User defined ** (514) + usr_ISOPED4O2_NO (345) ISOPED4O2 + NO -> ISOPN1D rate = ** User defined ** (512) + usr_ISOPN1DO2_NO (346) ISOPN1DO2 + NO -> NO2 + HO2 + 0.94*NOA + 0.94*GLYALD + 0.06*MACRN rate = ** User defined ** (513) + 0.06*CH2O - usr_ISOPN1DO2_NO (348) ISOPN1DO2 + NO -> ISOPFDN rate = ** User defined ** (515) - usr_ISOPN2BO2_NO (349) ISOPN2BO2 + NO -> 1.73*NO2 + 0.27*MACRN + 0.27*CH2O + 0.27*HO2 rate = ** User defined ** (516) + usr_ISOPN1DO2_NO (347) ISOPN1DO2 + NO -> ISOPFDN rate = ** User defined ** (514) + usr_ISOPN2BO2_NO (348) ISOPN2BO2 + NO -> 1.73*NO2 + 0.27*MACRN + 0.27*CH2O + 0.27*HO2 rate = ** User defined ** (515) + 0.73*HYAC + 0.73*GLYALD - usr_ISOPN2BO2_NO (350) ISOPN2BO2 + NO -> ISOPFDN rate = ** User defined ** (517) - usr_ISOPN3BO2_NO (351) ISOPN3BO2 + NO -> NO2 + MVKN + CH2O + HO2 rate = ** User defined ** (518) - usr_ISOPN3BO2_NO (352) ISOPN3BO2 + NO -> ISOPFDN rate = ** User defined ** (519) - usr_ISOPN4DO2_NO (353) ISOPN4DO2 + NO -> NO2 + HO2 + 0.13*MVKN + 0.13*CH2O + 0.87*HYAC rate = ** User defined ** (520) + usr_ISOPN2BO2_NO (349) ISOPN2BO2 + NO -> ISOPFDN rate = ** User defined ** (516) + usr_ISOPN3BO2_NO (350) ISOPN3BO2 + NO -> NO2 + MVKN + CH2O + HO2 rate = ** User defined ** (517) + usr_ISOPN3BO2_NO (351) ISOPN3BO2 + NO -> ISOPFDN rate = ** User defined ** (518) + usr_ISOPN4DO2_NO (352) ISOPN4DO2 + NO -> NO2 + HO2 + 0.13*MVKN + 0.13*CH2O + 0.87*HYAC rate = ** User defined ** (519) + 0.87*NO3CH2CHO - usr_ISOPN4DO2_NO (354) ISOPN4DO2 + NO -> ISOPFDN rate = ** User defined ** (521) - usr_ISOPNBNO3O2_ (355) ISOPNBNO3O2 + NO -> NO2 + HO2 + 0.21*MACRN + 0.12*MVKN + 0.33*CH2O rate = ** User defined ** (522) + usr_ISOPN4DO2_NO (353) ISOPN4DO2 + NO -> ISOPFDN rate = ** User defined ** (520) + usr_ISOPNBNO3O2_ (354) ISOPNBNO3O2 + NO -> NO2 + HO2 + 0.21*MACRN + 0.12*MVKN + 0.33*CH2O rate = ** User defined ** (521) + 0.34*NOA + 0.34*GLYALD + 0.33*HYAC + 0.33*NO3CH2CHO - usr_ISOPNBNO3O2_ (356) ISOPNBNO3O2 + NO -> ISOPFDN rate = ** User defined ** (523) - usr_ISOPNO3_NOa (357) ISOPNO3 + NO -> 1.46*NO2 + 0.46*CH2O + 0.54*NC4CHO + 0.54*HO2 rate = ** User defined ** (524) + usr_ISOPNBNO3O2_ (355) ISOPNBNO3O2 + NO -> ISOPFDN rate = ** User defined ** (522) + usr_ISOPNO3_NOa (356) ISOPNO3 + NO -> 1.46*NO2 + 0.46*CH2O + 0.54*NC4CHO + 0.54*HO2 rate = ** User defined ** (523) + 0.42*MVK + 0.04*MACR - usr_ISOPNO3_NOn (358) ISOPNO3 + NO -> ISOPFDN rate = ** User defined ** (525) - usr_ISOPNOOHBO2_ (359) ISOPNOOHBO2 + NO -> NO2 + 0.53*CH2O + 0.53*HO2 + 0.49*MACRN rate = ** User defined ** (526) + usr_ISOPNO3_NOn (357) ISOPNO3 + NO -> ISOPFDN rate = ** User defined ** (524) + usr_ISOPNOOHBO2_ (358) ISOPNOOHBO2 + NO -> NO2 + 0.53*CH2O + 0.53*HO2 + 0.49*MACRN rate = ** User defined ** (525) + 0.04*MVKN + 0.4*NOA + 0.4*GLYALD + 0.07*HYAC + 0.07*NO3CH2CHO + 0.47*OH - usr_ISOPNOOHBO2_ (360) ISOPNOOHBO2 + NO -> ISOPFDN rate = ** User defined ** (527) - usr_ISOPNOOHDO2_ (361) ISOPNOOHDO2 + NO -> NO2 + 0.04*CH2O + 0.04*OH + 0.02*MACRN rate = ** User defined ** (528) + usr_ISOPNOOHBO2_ (359) ISOPNOOHBO2 + NO -> ISOPFDN rate = ** User defined ** (526) + usr_ISOPNOOHDO2_ (360) ISOPNOOHDO2 + NO -> NO2 + 0.04*CH2O + 0.04*OH + 0.02*MACRN rate = ** User defined ** (527) + 0.02*MVKN + 0.81*NOA + 0.81*HCOCH2OOH + 0.15*HYPERACET + 0.15*NO3CH2CHO + 0.96*HO2 - usr_ISOPNOOHDO2_ (362) ISOPNOOHDO2 + NO -> ISOPFDN rate = ** User defined ** (529) - usr_ISOPZD1O2 (363) ISOPZD1O2 -> 0.15*HPALDB1C + 0.25*HPALD1 + 0.4*HO2 + 0.6*OH rate = ** User defined ** (530) + usr_ISOPNOOHDO2_ (361) ISOPNOOHDO2 + NO -> ISOPFDN rate = ** User defined ** (528) + usr_ISOPZD1O2 (362) ISOPZD1O2 -> 0.15*HPALDB1C + 0.25*HPALD1 + 0.4*HO2 + 0.6*OH rate = ** User defined ** (529) + 0.6*DHPMPAL + 0.6*CO - usr_ISOPZD1O2_NO (364) ISOPZD1O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MVKOOH rate = ** User defined ** (531) + usr_ISOPZD1O2_NO (363) ISOPZD1O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MVKOOH rate = ** User defined ** (530) + 0.55*CO + 0.55*OH - usr_ISOPZD1O2_NO (365) ISOPZD1O2 + NO -> ISOPN4D rate = ** User defined ** (532) - usr_ISOPZD4O2 (366) ISOPZD4O2 -> 0.15*HPALDB4C + 0.25*HPALD4 + 0.4*HO2 + 0.6*OH rate = ** User defined ** (533) + usr_ISOPZD1O2_NO (364) ISOPZD1O2 + NO -> ISOPN4D rate = ** User defined ** (531) + usr_ISOPZD4O2 (365) ISOPZD4O2 -> 0.15*HPALDB4C + 0.25*HPALD4 + 0.4*HO2 + 0.6*OH rate = ** User defined ** (532) + 0.6*DHPMPAL + 0.6*CO - usr_ISOPZD4O2_NO (367) ISOPZD4O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MACROOH rate = ** User defined ** (534) + usr_ISOPZD4O2_NO (366) ISOPZD4O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MACROOH rate = ** User defined ** (533) + 0.55*CO + 0.55*OH - usr_ISOPZD4O2_NO (368) ISOPZD4O2 + NO -> ISOPN1D rate = ** User defined ** (535) - usr_MACRO2_NOa (369) MACRO2 + NO -> NO2 + HO2 + 0.86*HYAC + 0.86*CO + 0.14*CH2O rate = ** User defined ** (536) + usr_ISOPZD4O2_NO (367) ISOPZD4O2 + NO -> ISOPN1D rate = ** User defined ** (534) + usr_MACRO2_NOa (368) MACRO2 + NO -> NO2 + HO2 + 0.86*HYAC + 0.86*CO + 0.14*CH2O rate = ** User defined ** (535) + 0.14*CH3COCHO - usr_MACRO2_NOn (370) MACRO2 + NO -> MACRN rate = ** User defined ** (537) - usr_MVKO2_NOa (371) MVKO2 + NO -> NO2 + 0.24*HO2 + 0.24*CH2O + 0.76*CH3CO3 rate = ** User defined ** (538) + usr_MACRO2_NOn (369) MACRO2 + NO -> MACRN rate = ** User defined ** (536) + usr_MVKO2_NOa (370) MVKO2 + NO -> NO2 + 0.24*HO2 + 0.24*CH2O + 0.76*CH3CO3 rate = ** User defined ** (537) + 0.76*GLYALD + 0.24*CH3COCHO - usr_MVKO2_NOn (372) MVKO2 + NO -> MVKN rate = ** User defined ** (539) - usr_NC4CHOO2_NOa (373) NC4CHOO2 + NO -> NO2 + HO2 + 0.13*NOA + 0.13*GLYOXAL rate = ** User defined ** (540) + usr_MVKO2_NOn (371) MVKO2 + NO -> MVKN rate = ** User defined ** (538) + usr_NC4CHOO2_NOa (372) NC4CHOO2 + NO -> NO2 + HO2 + 0.13*NOA + 0.13*GLYOXAL rate = ** User defined ** (539) + 0.12*CH3COCHO + 0.12*NO3CH2CHO + 0.39*MACRN + 0.36*MVKN + 0.75*CO - usr_NC4CHOO2_NOn (374) NC4CHOO2 + NO -> ISOPFDNC rate = ** User defined ** (541) - ACBZO2_HO2 (375) ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH rate = 4.30E-13*exp( 1040./t) (542) - ACBZO2_NO (376) ACBZO2 + NO -> C6H5O2 + NO2 rate = 7.50E-12*exp( 290./t) (543) - BENZENE_OH (377) BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 rate = 2.30E-12*exp( -193./t) (544) - BENZO2_HO2 (378) BENZO2 + HO2 -> BENZOOH rate = 7.50E-13*exp( 700./t) (545) - BENZO2_NO (379) BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 rate = 2.60E-12*exp( 365./t) (546) - BENZOOH_OH (380) BENZOOH + OH -> BENZO2 rate = 3.80E-12*exp( 200./t) (547) - BZALD_OH (381) BZALD + OH -> ACBZO2 rate = 5.90E-12*exp( 225./t) (548) - BZOO_HO2 (382) BZOO + HO2 -> BZOOH rate = 7.50E-13*exp( 700./t) (549) - BZOOH_OH (383) BZOOH + OH -> BZOO rate = 3.80E-12*exp( 200./t) (550) - BZOO_NO (384) BZOO + NO -> BZALD + NO2 + HO2 rate = 2.60E-12*exp( 365./t) (551) - C6H5O2_HO2 (385) C6H5O2 + HO2 -> C6H5OOH rate = 7.50E-13*exp( 700./t) (552) - C6H5O2_NO (386) C6H5O2 + NO -> PHENO + NO2 rate = 2.60E-12*exp( 365./t) (553) - C6H5OOH_OH (387) C6H5OOH + OH -> C6H5O2 rate = 3.80E-12*exp( 200./t) (554) - CRESOL_OH (388) CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO rate = 4.70E-11 (555) - DICARBO2_HO2 (389) DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO rate = 4.30E-13*exp( 1040./t) (556) + usr_NC4CHOO2_NOn (373) NC4CHOO2 + NO -> ISOPFDNC rate = ** User defined ** (540) + ACBZO2_HO2 (374) ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH rate = 4.30E-13*exp( 1040./t) (541) + ACBZO2_NO (375) ACBZO2 + NO -> C6H5O2 + NO2 rate = 7.50E-12*exp( 290./t) (542) + BENZENE_OH (376) BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 rate = 2.30E-12*exp( -193./t) (543) + BENZO2_HO2 (377) BENZO2 + HO2 -> BENZOOH rate = 7.50E-13*exp( 700./t) (544) + BENZO2_NO (378) BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 rate = 2.60E-12*exp( 365./t) (545) + BENZOOH_OH (379) BENZOOH + OH -> BENZO2 rate = 3.80E-12*exp( 200./t) (546) + BZALD_OH (380) BZALD + OH -> ACBZO2 rate = 5.90E-12*exp( 225./t) (547) + BZOO_HO2 (381) BZOO + HO2 -> BZOOH rate = 7.50E-13*exp( 700./t) (548) + BZOOH_OH (382) BZOOH + OH -> BZOO rate = 3.80E-12*exp( 200./t) (549) + BZOO_NO (383) BZOO + NO -> BZALD + NO2 + HO2 rate = 2.60E-12*exp( 365./t) (550) + C6H5O2_HO2 (384) C6H5O2 + HO2 -> C6H5OOH rate = 7.50E-13*exp( 700./t) (551) + C6H5O2_NO (385) C6H5O2 + NO -> PHENO + NO2 rate = 2.60E-12*exp( 365./t) (552) + C6H5OOH_OH (386) C6H5OOH + OH -> C6H5O2 rate = 3.80E-12*exp( 200./t) (553) + CRESOL_OH (387) CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO rate = 4.70E-11 (554) + DICARBO2_HO2 (388) DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO rate = 4.30E-13*exp( 1040./t) (555) + 0.33*CH3O2 - DICARBO2_NO (390) DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO rate = 7.50E-12*exp( 290./t) (557) + DICARBO2_NO (389) DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO rate = 7.50E-12*exp( 290./t) (556) + 0.83*CH3O2 - DICARBO2_NO2 (391) DICARBO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (558) + DICARBO2_NO2 (390) DICARBO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (557) ki=9.30E-12*(300/t)**1.50 f=0.60 - MALO2_HO2 (392) MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO rate = 4.30E-13*exp( 1040./t) (559) - MALO2_NO (393) MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 rate = 7.50E-12*exp( 290./t) (560) - MALO2_NO2 (394) MALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (561) + MALO2_HO2 (391) MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO rate = 4.30E-13*exp( 1040./t) (558) + MALO2_NO (392) MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 rate = 7.50E-12*exp( 290./t) (559) + MALO2_NO2 (393) MALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (560) ki=9.30E-12*(300/t)**1.50 f=0.60 - MDIALO2_HO2 (395) MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO rate = 4.30E-13*exp( 1040./t) (562) + MDIALO2_HO2 (394) MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO rate = 4.30E-13*exp( 1040./t) (561) + 0.07*CH3O2 + 0.07*GLYOXAL - MDIALO2_NO (396) MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO rate = 7.50E-12*exp( 290./t) (563) + MDIALO2_NO (395) MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO rate = 7.50E-12*exp( 290./t) (562) + 0.17*CH3O2 + 0.17*GLYOXAL - MDIALO2_NO2 (397) MDIALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (564) + MDIALO2_NO2 (396) MDIALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (563) ki=9.30E-12*(300/t)**1.50 f=0.60 - PHENO2_HO2 (398) PHENO2 + HO2 -> PHENOOH rate = 7.50E-13*exp( 700./t) (565) - PHENO2_NO (399) PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 rate = 2.60E-12*exp( 365./t) (566) - PHENOL_OH (400) PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO rate = 4.70E-13*exp( 1220./t) (567) - PHENO_NO2 (401) PHENO + NO2 -> NDEP rate = 2.10E-12 (568) - PHENO_O3 (402) PHENO + O3 -> C6H5O2 rate = 2.80E-13 (569) - PHENOOH_OH (403) PHENOOH + OH -> PHENO2 rate = 3.80E-12*exp( 200./t) (570) - tag_ACBZO2_NO2 (404) ACBZO2 + NO2 + M -> PBZNIT + M troe : ko=9.70E-29*(300/t)**5.60 (571) + PHENO2_HO2 (397) PHENO2 + HO2 -> PHENOOH rate = 7.50E-13*exp( 700./t) (564) + PHENO2_NO (398) PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 rate = 2.60E-12*exp( 365./t) (565) + PHENOL_OH (399) PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO rate = 4.70E-13*exp( 1220./t) (566) + PHENO_NO2 (400) PHENO + NO2 -> NDEP rate = 2.10E-12 (567) + PHENO_O3 (401) PHENO + O3 -> C6H5O2 rate = 2.80E-13 (568) + PHENOOH_OH (402) PHENOOH + OH -> PHENO2 rate = 3.80E-12*exp( 200./t) (569) + tag_ACBZO2_NO2 (403) ACBZO2 + NO2 + M -> PBZNIT + M troe : ko=9.70E-29*(300/t)**5.60 (570) ki=9.30E-12*(300/t)**1.50 f=0.60 - TOLO2_HO2 (405) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (572) - TOLO2_NO (406) TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = 2.60E-12*exp( 365./t) (573) + TOLO2_HO2 (404) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (571) + TOLO2_NO (405) TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = 2.60E-12*exp( 365./t) (572) + 0.2*BIGALD2 + 0.2*BIGALD3 - TOLOOH_OH (407) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (574) - TOLUENE_OH (408) TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 rate = 1.70E-12*exp( 352./t) (575) + TOLOOH_OH (406) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (573) + TOLUENE_OH (407) TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 rate = 1.70E-12*exp( 352./t) (574) + 0.28*HO2 - usr_PBZNIT_M (409) PBZNIT + M -> ACBZO2 + NO2 + M rate = ** User defined ** (576) - XYLENES_OH (410) XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO rate = 1.70E-11 (577) + usr_PBZNIT_M (408) PBZNIT + M -> ACBZO2 + NO2 + M rate = ** User defined ** (575) + XYLENES_OH (409) XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO rate = 1.70E-11 (576) + 0.56*XYLENO2 + 0.38*HO2 - XYLENO2_HO2 (411) XYLENO2 + HO2 -> XYLENOOH rate = 7.50E-13*exp( 700./t) (578) - XYLENO2_NO (412) XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = 2.60E-12*exp( 365./t) (579) + XYLENO2_HO2 (410) XYLENO2 + HO2 -> XYLENOOH rate = 7.50E-13*exp( 700./t) (577) + XYLENO2_NO (411) XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = 2.60E-12*exp( 365./t) (578) + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 - XYLENOOH_OH (413) XYLENOOH + OH -> XYLENO2 rate = 3.80E-12*exp( 200./t) (580) - XYLOLO2_HO2 (414) XYLOLO2 + HO2 -> XYLOLOOH rate = 7.50E-13*exp( 700./t) (581) - XYLOLO2_NO (415) XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO rate = 2.60E-12*exp( 365./t) (582) - XYLOL_OH (416) XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO rate = 8.40E-11 (583) - XYLOLOOH_OH (417) XYLOLOOH + OH -> XYLOLO2 rate = 3.80E-12*exp( 200./t) (584) - APIN_NO3 (418) APIN + NO3 -> APINNO3 rate = 1.20E-12*exp( 490./t) (585) - APINNO3_APINNO3 (419) APINNO3 + APINNO3 -> 0.27*TERPNT + 0.09*TERPNS + 1.64*NO2 rate = 5.30E-13 (586) + XYLENOOH_OH (412) XYLENOOH + OH -> XYLENO2 rate = 3.80E-12*exp( 200./t) (579) + XYLOLO2_HO2 (413) XYLOLO2 + HO2 -> XYLOLOOH rate = 7.50E-13*exp( 700./t) (580) + XYLOLO2_NO (414) XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO rate = 2.60E-12*exp( 365./t) (581) + XYLOL_OH (415) XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO rate = 8.40E-11 (582) + XYLOLOOH_OH (416) XYLOLOOH + OH -> XYLOLO2 rate = 3.80E-12*exp( 200./t) (583) + APIN_NO3 (417) APIN + NO3 -> APINNO3 rate = 1.20E-12*exp( 490./t) (584) + APINNO3_APINNO3 (418) APINNO3 + APINNO3 -> 0.27*TERPNT + 0.09*TERPNS + 1.64*NO2 rate = 5.30E-13 (585) + 1.64*TERPA - APINNO3_CH3CO3 (420) APINNO3 + CH3CO3 -> NO2 + TERPA + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (587) - APINNO3_CH3O2 (421) APINNO3 + CH3O2 -> 0.09*TERPNT + 0.09*TERPNS + 0.95*CH2O rate = 2.00E-12 (588) + APINNO3_CH3CO3 (419) APINNO3 + CH3CO3 -> NO2 + TERPA + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (586) + APINNO3_CH3O2 (420) APINNO3 + CH3O2 -> 0.09*TERPNT + 0.09*TERPNS + 0.95*CH2O rate = 2.00E-12 (587) + 0.05*CH3OH + 0.82*HO2 + 0.82*NO2 + 0.82*TERPA - APINNO3_HO2 (422) APINNO3 + HO2 -> 0.3*TERPNPT + 0.7*TERPA + 0.7*NO2 + 0.7*OH rate = 2.71E-13*exp( 1300./t) (589) - APINNO3_NO (423) APINNO3 + NO -> 1.86*NO2 + 0.07*TERPFDN + 0.93*TERPA rate = 2.70E-12*exp( 360./t) (590) - APINNO3_NO3 (424) APINNO3 + NO3 -> 2*NO2 + TERPA rate = 2.30E-12 (591) - APINNO3_TERPA2CO (425) APINNO3 + TERPA2CO3 -> NO2 + TERPA + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (592) - APINNO3_TERPA3CO (426) APINNO3 + TERPA3CO3 -> NO2 + TERPA + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (593) - APINNO3_TERPACO3 (427) APINNO3 + TERPACO3 -> NO2 + TERPA + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (594) - APINO2_CH3CO3 (428) APINO2 + CH3CO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH rate = 2.00E-12*exp( 500./t) (595) + APINNO3_HO2 (421) APINNO3 + HO2 -> 0.3*TERPNPT + 0.7*TERPA + 0.7*NO2 + 0.7*OH rate = 2.71E-13*exp( 1300./t) (588) + APINNO3_NO (422) APINNO3 + NO -> 1.86*NO2 + 0.07*TERPFDN + 0.93*TERPA rate = 2.70E-12*exp( 360./t) (589) + APINNO3_NO3 (423) APINNO3 + NO3 -> 2*NO2 + TERPA rate = 2.30E-12 (590) + APINNO3_TERPA2CO (424) APINNO3 + TERPA2CO3 -> NO2 + TERPA + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (591) + APINNO3_TERPA3CO (425) APINNO3 + TERPA3CO3 -> NO2 + TERPA + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (592) + APINNO3_TERPACO3 (426) APINNO3 + TERPACO3 -> NO2 + TERPA + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (593) + APINO2_CH3CO3 (427) APINO2 + CH3CO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH rate = 2.00E-12*exp( 500./t) (594) + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + HO2 + CH3O2 + CO2 - APINO2_CH3O2 (429) APINO2 + CH3O2 -> 0.83*CH2O + 0.14*TERPF1 + 0.42*TERPA + 0.2*TERPA3 rate = 2.00E-12 (596) + APINO2_CH3O2 (428) APINO2 + CH3O2 -> 0.83*CH2O + 0.14*TERPF1 + 0.42*TERPA + 0.2*TERPA3 rate = 2.00E-12 (595) + 0.13*TERP1OOH + 0.17*CH3OH + 0.11*TERPK + 0.06*CH3COCH3 + 1.16*HO2 - APINO2_HO2 (430) APINO2 + HO2 -> 0.06*CH3COCH3 + 0.06*TERPF1 + 0.08*CH2O rate = 2.60E-13*exp( 1300./t) (597) + APINO2_HO2 (429) APINO2 + HO2 -> 0.06*CH3COCH3 + 0.06*TERPF1 + 0.08*CH2O rate = 2.60E-13*exp( 1300./t) (596) + 0.25*TERP1OOH + 0.48*HO2 + 0.4*TERPOOH + 0.29*TERPA + 0.35*OH - APINO2_NO (431) APINO2 + NO -> 0.01*TERPHFN + 0.02*TERPNS1 + 0.1*TERPNS rate = 2.70E-12*exp( 360./t) (598) + APINO2_NO (430) APINO2 + NO -> 0.01*TERPHFN + 0.02*TERPNS1 + 0.1*TERPNS rate = 2.70E-12*exp( 360./t) (597) + 0.05*TERPNT + 0.05*TERPNT1 + 0.77*NO2 + 0.77*HO2 + 0.3*TERPA + 0.27*TERPA3 + 0.09*CH3COCH3 + 0.09*TERPF1 + 0.21*CH2O + 0.11*TERP1OOH - APINO2_NO3 (432) APINO2 + NO3 -> NO2 + HO2 + 0.39*TERPA + 0.35*TERPA3 rate = 2.30E-12 (599) + APINO2_NO3 (431) APINO2 + NO3 -> NO2 + HO2 + 0.39*TERPA + 0.35*TERPA3 rate = 2.30E-12 (598) + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + 0.14*TERP1OOH - APINO2_TERPA2CO3 (433) APINO2 + TERPA2CO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH rate = 2.00E-12*exp( 500./t) (600) + APINO2_TERPA2CO3 (432) APINO2 + TERPA2CO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH rate = 2.00E-12*exp( 500./t) (599) + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + HO2 + TERPA2O2 + CO2 - APINO2_TERPA3CO3 (434) APINO2 + TERPA3CO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH rate = 2.00E-12*exp( 500./t) (601) + APINO2_TERPA3CO3 (433) APINO2 + TERPA3CO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH rate = 2.00E-12*exp( 500./t) (600) + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + HO2 + TERPA4O2 + CO2 - APINO2_TERPACO3 (435) APINO2 + TERPACO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH rate = 2.00E-12*exp( 500./t) (602) + APINO2_TERPACO3 (434) APINO2 + TERPACO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH rate = 2.00E-12*exp( 500./t) (601) + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + HO2 + TERPA1O2 + CO2 - APIN_O3 (436) APIN + O3 -> 0.77*OH + 0.33*TERPA2O2 + 0.22*H2O2 + 0.22*TERPA rate = 8.05E-16*exp( -640./t) (603) + APIN_O3 (435) APIN + O3 -> 0.77*OH + 0.33*TERPA2O2 + 0.22*H2O2 + 0.22*TERPA rate = 8.05E-16*exp( -640./t) (602) + 0.01*TERPACID + 0.17*TERPA2 + 0.17*HO2 + 0.17*CO + 0.27*CH2O + 0.27*TERPA2CO3 - APIN_OH (437) APIN + OH -> APINO2 rate = 1.34E-11*exp( 410./t) (604) - BCARY_NO3 (438) BCARY + NO3 -> BCARYNO3 rate = 1.90E-11 (605) - BCARYNO3_BCARYNO (439) BCARYNO3 + BCARYNO3 -> 0.36*SQTN + 1.64*NO2 + 1.64*TERPF2 rate = 5.30E-13 (606) - BCARYNO3_CH3CO3 (440) BCARYNO3 + CH3CO3 -> CH3O2 + CO2 + NO2 + TERPF2 rate = 2.00E-12*exp( 500./t) (607) - BCARYNO3_CH3O2 (441) BCARYNO3 + CH3O2 -> 0.18*SQTN + 0.95*CH2O + 0.82*TERPF2 + 0.82*NO2 rate = 2.00E-12 (608) + APIN_OH (436) APIN + OH -> APINO2 rate = 1.34E-11*exp( 410./t) (603) + BCARY_NO3 (437) BCARY + NO3 -> BCARYNO3 rate = 1.90E-11 (604) + BCARYNO3_BCARYNO (438) BCARYNO3 + BCARYNO3 -> 0.36*SQTN + 1.64*NO2 + 1.64*TERPF2 rate = 5.30E-13 (605) + BCARYNO3_CH3CO3 (439) BCARYNO3 + CH3CO3 -> CH3O2 + CO2 + NO2 + TERPF2 rate = 2.00E-12*exp( 500./t) (606) + BCARYNO3_CH3O2 (440) BCARYNO3 + CH3O2 -> 0.18*SQTN + 0.95*CH2O + 0.82*TERPF2 + 0.82*NO2 rate = 2.00E-12 (607) + 0.82*HO2 + 0.05*CH3OH - BCARYNO3_HO2 (442) BCARYNO3 + HO2 -> 0.5*SQTN + 0.5*OH + 0.5*NO2 + 0.5*TERPF2 rate = 2.78E-13*exp( 1300./t) (609) - BCARYNO3_NO (443) BCARYNO3 + NO -> 0.07*SQTN + 1.86*NO2 + 0.93*TERPF2 rate = 2.70E-12*exp( 360./t) (610) - BCARYNO3_NO3 (444) BCARYNO3 + NO3 -> 2*NO2 + TERPF2 rate = 2.30E-12 (611) - BCARYNO3_TERPA2C (445) BCARYNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + NO2 + TERPF2 rate = 2.00E-12*exp( 500./t) (612) - BCARYNO3_TERPA3C (446) BCARYNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + NO2 + TERPF2 rate = 2.00E-12*exp( 500./t) (613) - BCARYNO3_TERPACO (447) BCARYNO3 + TERPACO3 -> TERPA1O2 + CO2 + NO2 + TERPF2 rate = 2.00E-12*exp( 500./t) (614) - BCARYO2_CH3CO3 (448) BCARYO2 + CH3CO3 -> TERPF2 + HO2 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (615) - BCARYO2_CH3O2 (449) BCARYO2 + CH3O2 -> 0.25*CH3OH + TERPF2 + 0.75*CH2O + HO2 rate = 2.00E-12 (616) - BCARYO2_HO2 (450) BCARYO2 + HO2 -> 0.9*TERP2AOOH + 0.1*OH + 0.1*HO2 + 0.1*TERPF2 rate = 2.75E-13*exp( 1300./t) (617) - BCARYO2_NO (451) BCARYO2 + NO -> 0.3*SQTN + 0.7*NO2 + 0.7*HO2 + 0.7*TERPF2 rate = 2.70E-12*exp( 360./t) (618) - BCARYO2_NO3 (452) BCARYO2 + NO3 -> NO2 + HO2 + TERPF2 rate = 2.30E-12 (619) - BCARYO2_TERPA2CO (453) BCARYO2 + TERPA2CO3 -> TERPF2 + HO2 + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (620) - BCARYO2_TERPA3CO (454) BCARYO2 + TERPA3CO3 -> TERPF2 + HO2 + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (621) - BCARYO2_TERPACO3 (455) BCARYO2 + TERPACO3 -> TERPF2 + HO2 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (622) - BCARY_O3 (456) BCARY + O3 -> 0.13*TERPACID + 0.17*H2O2 + 0.08*OH + 0.08*HO2 rate = 1.20E-14 (623) + BCARYNO3_HO2 (441) BCARYNO3 + HO2 -> 0.5*SQTN + 0.5*OH + 0.5*NO2 + 0.5*TERPF2 rate = 2.78E-13*exp( 1300./t) (608) + BCARYNO3_NO (442) BCARYNO3 + NO -> 0.07*SQTN + 1.86*NO2 + 0.93*TERPF2 rate = 2.70E-12*exp( 360./t) (609) + BCARYNO3_NO3 (443) BCARYNO3 + NO3 -> 2*NO2 + TERPF2 rate = 2.30E-12 (610) + BCARYNO3_TERPA2C (444) BCARYNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + NO2 + TERPF2 rate = 2.00E-12*exp( 500./t) (611) + BCARYNO3_TERPA3C (445) BCARYNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + NO2 + TERPF2 rate = 2.00E-12*exp( 500./t) (612) + BCARYNO3_TERPACO (446) BCARYNO3 + TERPACO3 -> TERPA1O2 + CO2 + NO2 + TERPF2 rate = 2.00E-12*exp( 500./t) (613) + BCARYO2_CH3CO3 (447) BCARYO2 + CH3CO3 -> TERPF2 + HO2 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (614) + BCARYO2_CH3O2 (448) BCARYO2 + CH3O2 -> 0.25*CH3OH + TERPF2 + 0.75*CH2O + HO2 rate = 2.00E-12 (615) + BCARYO2_HO2 (449) BCARYO2 + HO2 -> 0.9*TERP2AOOH + 0.1*OH + 0.1*HO2 + 0.1*TERPF2 rate = 2.75E-13*exp( 1300./t) (616) + BCARYO2_NO (450) BCARYO2 + NO -> 0.3*SQTN + 0.7*NO2 + 0.7*HO2 + 0.7*TERPF2 rate = 2.70E-12*exp( 360./t) (617) + BCARYO2_NO3 (451) BCARYO2 + NO3 -> NO2 + HO2 + TERPF2 rate = 2.30E-12 (618) + BCARYO2_TERPA2CO (452) BCARYO2 + TERPA2CO3 -> TERPF2 + HO2 + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (619) + BCARYO2_TERPA3CO (453) BCARYO2 + TERPA3CO3 -> TERPF2 + HO2 + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (620) + BCARYO2_TERPACO3 (454) BCARYO2 + TERPACO3 -> TERPF2 + HO2 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (621) + BCARY_O3 (455) BCARY + O3 -> 0.13*TERPACID + 0.17*H2O2 + 0.08*OH + 0.08*HO2 rate = 1.20E-14 (622) + 0.08*CH2O + 0.87*TERPF2 - BCARY_OH (457) BCARY + OH -> BCARYO2 rate = 2.00E-10 (624) - BPIN_NO3 (458) BPIN + NO3 -> BPINNO3 rate = 2.50E-12 (625) - BPINNO3_BPINNO3 (459) BPINNO3 + BPINNO3 -> 0.94*NO2 + 0.92*TERPNS + 0.9*TERPA3 rate = 5.30E-13 (626) + BCARY_OH (456) BCARY + OH -> BCARYO2 rate = 2.00E-10 (623) + BPIN_NO3 (457) BPIN + NO3 -> BPINNO3 rate = 2.50E-12 (624) + BPINNO3_BPINNO3 (458) BPINNO3 + BPINNO3 -> 0.94*NO2 + 0.92*TERPNS + 0.9*TERPA3 rate = 5.30E-13 (625) + 0.04*TERPK + 0.04*CH2O + 0.14*TERPNT + 0.94*HO2 - BPINNO3_CH3CO3 (460) BPINNO3 + CH3CO3 -> CH3O2 + CO2 + 0.5*NO2 + 0.45*TERPNS rate = 2.00E-12*exp( 500./t) (627) + BPINNO3_CH3CO3 (459) BPINNO3 + CH3CO3 -> CH3O2 + CO2 + 0.5*NO2 + 0.45*TERPNS rate = 2.00E-12*exp( 500./t) (626) + 0.48*TERPA3 + 0.02*TERPK + 0.02*CH2O + 0.05*TERPNT + 0.5*HO2 - BPINNO3_CH3O2 (461) BPINNO3 + CH3O2 -> 0.56*TERPNS + 0.08*TERPNT + 0.02*TERPK rate = 2.00E-12 (628) + BPINNO3_CH3O2 (460) BPINNO3 + CH3O2 -> 0.56*TERPNS + 0.08*TERPNT + 0.02*TERPK rate = 2.00E-12 (627) + 0.34*TERPA3 + 0.36*NO2 + 1.1*HO2 + 0.99*CH2O + 0.03*CH3OH - BPINNO3_HO2 (462) BPINNO3 + HO2 -> 0.47*OH + 0.45*TERPNPS + 0.22*TERPA3 + 0.02*TERPK rate = 2.71E-13*exp( 1300./t) (629) + BPINNO3_HO2 (461) BPINNO3 + HO2 -> 0.47*OH + 0.45*TERPNPS + 0.22*TERPA3 + 0.02*TERPK rate = 2.71E-13*exp( 1300./t) (628) + 0.08*TERPNPT + 0.24*NO2 + 0.02*CH2O + 0.23*TERPNS - BPINNO3_NO (463) BPINNO3 + NO -> 0.07*TERPFDN + 1.39*NO2 + 0.42*TERPNS + 0.44*TERPA3 rate = 2.70E-12*exp( 360./t) (630) + BPINNO3_NO (462) BPINNO3 + NO -> 0.07*TERPFDN + 1.39*NO2 + 0.42*TERPNS + 0.44*TERPA3 rate = 2.70E-12*exp( 360./t) (629) + 0.02*TERPK + 0.02*CH2O + 0.05*TERPNT + 0.47*HO2 - BPINNO3_NO3 (464) BPINNO3 + NO3 -> 1.5*NO2 + 0.45*TERPNS + 0.48*TERPA3 + 0.02*TERPK rate = 2.30E-12 (631) + BPINNO3_NO3 (463) BPINNO3 + NO3 -> 1.5*NO2 + 0.45*TERPNS + 0.48*TERPA3 + 0.02*TERPK rate = 2.30E-12 (630) + 0.02*CH2O + 0.05*TERPNT + 0.5*HO2 - BPINNO3_TERPA2CO (465) BPINNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + 0.5*NO2 + 0.45*TERPNS rate = 2.00E-12*exp( 500./t) (632) + BPINNO3_TERPA2CO (464) BPINNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + 0.5*NO2 + 0.45*TERPNS rate = 2.00E-12*exp( 500./t) (631) + 0.48*TERPA3 + 0.02*TERPK + 0.02*CH2O + 0.05*TERPNT + 0.5*HO2 - BPINNO3_TERPA3CO (466) BPINNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + 0.5*NO2 + 0.45*TERPNS rate = 2.00E-12*exp( 500./t) (633) + BPINNO3_TERPA3CO (465) BPINNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + 0.5*NO2 + 0.45*TERPNS rate = 2.00E-12*exp( 500./t) (632) + 0.48*TERPA3 + 0.02*TERPK + 0.02*CH2O + 0.05*TERPNT + 0.5*HO2 - BPINNO3_TERPACO3 (467) BPINNO3 + TERPACO3 -> TERPA1O2 + CO2 + 0.5*NO2 + 0.45*TERPNS rate = 2.00E-12*exp( 500./t) (634) + BPINNO3_TERPACO3 (466) BPINNO3 + TERPACO3 -> TERPA1O2 + CO2 + 0.5*NO2 + 0.45*TERPNS rate = 2.00E-12*exp( 500./t) (633) + 0.48*TERPA3 + 0.02*TERPK + 0.02*CH2O + 0.05*TERPNT + 0.5*HO2 - BPINO2_CH3CO3 (468) BPINO2 + CH3CO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 rate = 2.00E-12*exp( 500./t) (635) + BPINO2_CH3CO3 (467) BPINO2 + CH3CO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 rate = 2.00E-12*exp( 500./t) (634) + 0.11*CH3COCH3 + 0.65*CH2O + HO2 + CH3O2 + CO2 - BPINO2_CH3O2 (469) BPINO2 + CH3O2 -> 1.4*CH2O + 0.37*TERPF1 + 0.32*TERPK + 1.5*HO2 rate = 2.00E-12 (636) + BPINO2_CH3O2 (468) BPINO2 + CH3O2 -> 1.4*CH2O + 0.37*TERPF1 + 0.32*TERPK + 1.5*HO2 rate = 2.00E-12 (635) + 0.08*CH3COCH3 + 0.31*TERPA3 - BPINO2_HO2 (470) BPINO2 + HO2 -> 0.68*TERP1OOH + 0.03*OH + 0.03*TERPK + 0.03*CH2O rate = 2.60E-13*exp( 1300./t) (637) + BPINO2_HO2 (469) BPINO2 + HO2 -> 0.68*TERP1OOH + 0.03*OH + 0.03*TERPK + 0.03*CH2O rate = 2.60E-13*exp( 1300./t) (636) + 0.03*HO2 + 0.29*TERPOOH - BPINO2_NO (471) BPINO2 + NO -> 0.08*CH3COCH3 + 0.49*CH2O + 0.2*TERPF1 + 0.24*TERPK rate = 2.70E-12*exp( 360./t) (638) + BPINO2_NO (470) BPINO2 + NO -> 0.08*CH3COCH3 + 0.49*CH2O + 0.2*TERPF1 + 0.24*TERPK rate = 2.70E-12*exp( 360./t) (637) + 0.04*TERPNS1 + 0.02*TERPNS + 0.06*TERPNT + 0.13*TERPNT1 + 0.31*TERPA3 + 0.75*HO2 + 0.75*NO2 - BPINO2_NO3 (472) BPINO2 + NO3 -> 0.11*CH3COCH3 + 0.65*CH2O + 0.27*TERPF1 rate = 2.30E-12 (639) + BPINO2_NO3 (471) BPINO2 + NO3 -> 0.11*CH3COCH3 + 0.65*CH2O + 0.27*TERPF1 rate = 2.30E-12 (638) + 0.32*TERPK + 0.41*TERPA3 + HO2 + NO2 - BPINO2_TERPA2CO3 (473) BPINO2 + TERPA2CO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 rate = 2.00E-12*exp( 500./t) (640) + BPINO2_TERPA2CO3 (472) BPINO2 + TERPA2CO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 rate = 2.00E-12*exp( 500./t) (639) + 0.11*CH3COCH3 + 0.65*CH2O + HO2 + TERPA2O2 + CO2 - BPINO2_TERPA3CO3 (474) BPINO2 + TERPA3CO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 rate = 2.00E-12*exp( 500./t) (641) + BPINO2_TERPA3CO3 (473) BPINO2 + TERPA3CO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 rate = 2.00E-12*exp( 500./t) (640) + 0.11*CH3COCH3 + 0.65*CH2O + HO2 + TERPA4O2 + CO2 - BPINO2_TERPACO3 (475) BPINO2 + TERPACO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 rate = 2.00E-12*exp( 500./t) (642) + BPINO2_TERPACO3 (474) BPINO2 + TERPACO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 rate = 2.00E-12*exp( 500./t) (641) + 0.11*CH3COCH3 + 0.65*CH2O + HO2 + TERPA1O2 + CO2 - BPIN_O3 (476) BPIN + O3 -> 0.51*TERPK + 0.3*OH + 0.3*TERPA2CO3 + 0.32*H2O2 rate = 1.35E-15*exp( -1270./t) (643) + BPIN_O3 (475) BPIN + O3 -> 0.51*TERPK + 0.3*OH + 0.3*TERPA2CO3 + 0.32*H2O2 rate = 1.35E-15*exp( -1270./t) (642) + 0.19*BIGALK + 0.19*CO2 + 0.81*CH2O + 0.11*HMHP + 0.08*HCOOH - BPIN_OH (477) BPIN + OH -> BPINO2 rate = 1.62E-11*exp( 460./t) (644) - LIMON_NO3 (478) LIMON + NO3 -> LIMONNO3 rate = 1.20E-11 (645) - LIMONNO3_CH3CO3 (479) LIMONNO3 + CH3CO3 -> CH3O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 rate = 2.00E-12*exp( 500./t) (646) + BPIN_OH (476) BPIN + OH -> BPINO2 rate = 1.62E-11*exp( 460./t) (643) + LIMON_NO3 (477) LIMON + NO3 -> LIMONNO3 rate = 1.20E-11 (644) + LIMONNO3_CH3CO3 (478) LIMONNO3 + CH3CO3 -> CH3O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 rate = 2.00E-12*exp( 500./t) (645) + 0.19*TERPNT1 + 0.35*TERPNS1 + 0.54*HO2 - LIMONNO3_CH3O2 (480) LIMONNO3 + CH3O2 -> 0.27*TERPNT1 + 0.91*CH2O + 0.09*CH3OH rate = 2.00E-12 (647) + LIMONNO3_CH3O2 (479) LIMONNO3 + CH3O2 -> 0.27*TERPNT1 + 0.91*CH2O + 0.09*CH3OH rate = 2.00E-12 (646) + 1.01*HO2 + 0.31*TERPF1 + 0.31*NO2 + 0.42*TERPNS1 - LIMONNO3_HO2 (481) LIMONNO3 + HO2 -> 0.18*TERPNPT1 + 0.32*TERPNPS1 + 0.5*OH rate = 2.71E-13*exp( 1300./t) (648) + LIMONNO3_HO2 (480) LIMONNO3 + HO2 -> 0.18*TERPNPT1 + 0.32*TERPNPS1 + 0.5*OH rate = 2.71E-13*exp( 1300./t) (647) + 0.23*TERPF1 + 0.23*NO2 + 0.18*TERPNS1 + 0.09*TERPNT1 + 0.27*HO2 - LIMONNO3_LIMONNO (482) LIMONNO3 + LIMONNO3 -> 0.42*TERPNT1 + 0.99*HO2 + 0.86*TERPF1 rate = 5.30E-13 (649) + LIMONNO3_LIMONNO (481) LIMONNO3 + LIMONNO3 -> 0.42*TERPNT1 + 0.99*HO2 + 0.86*TERPF1 rate = 5.30E-13 (648) + 0.86*NO2 + 0.72*TERPNS1 - LIMONNO3_NO (483) LIMONNO3 + NO -> 0.07*TERPFDN + 1.36*NO2 + 0.43*TERPF1 rate = 2.70E-12*exp( 360./t) (650) + LIMONNO3_NO (482) LIMONNO3 + NO -> 0.07*TERPFDN + 1.36*NO2 + 0.43*TERPF1 rate = 2.70E-12*exp( 360./t) (649) + 0.17*TERPNT1 + 0.33*TERPNS1 + 0.5*HO2 - LIMONNO3_NO3 (484) LIMONNO3 + NO3 -> 1.46*NO2 + 0.46*TERPF1 + 0.19*TERPNT1 rate = 2.30E-12 (651) + LIMONNO3_NO3 (483) LIMONNO3 + NO3 -> 1.46*NO2 + 0.46*TERPF1 + 0.19*TERPNT1 rate = 2.30E-12 (650) + 0.35*TERPNS1 + 0.54*HO2 - LIMONNO3_TERPA2C (485) LIMONNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 rate = 2.00E-12*exp( 500./t) (652) + LIMONNO3_TERPA2C (484) LIMONNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 rate = 2.00E-12*exp( 500./t) (651) + 0.19*TERPNT1 + 0.35*TERPNS1 + 0.54*HO2 - LIMONNO3_TERPA3C (486) LIMONNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 rate = 2.00E-12*exp( 500./t) (653) + LIMONNO3_TERPA3C (485) LIMONNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 rate = 2.00E-12*exp( 500./t) (652) + 0.19*TERPNT1 + 0.35*TERPNS1 + 0.54*HO2 - LIMONNO3_TERPACO (487) LIMONNO3 + TERPACO3 -> TERPA1O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 rate = 2.00E-12*exp( 500./t) (654) + LIMONNO3_TERPACO (486) LIMONNO3 + TERPACO3 -> TERPA1O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 rate = 2.00E-12*exp( 500./t) (653) + 0.19*TERPNT1 + 0.35*TERPNS1 + 0.54*HO2 - LIMONO2_CH3CO3 (488) LIMONO2 + CH3CO3 -> TERPF1 + 0.56*CH2O + HO2 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (655) - LIMONO2_CH3O2 (489) LIMONO2 + CH3O2 -> 0.25*CH3OH + TERPF1 + 1.03*CH2O + HO2 rate = 2.00E-12 (656) - LIMONO2_HO2 (490) LIMONO2 + HO2 -> 0.9*TERP1OOH + 0.1*TERPF1 + 0.1*OH + 0.1*HO2 rate = 2.60E-13*exp( 1300./t) (657) + LIMONO2_CH3CO3 (487) LIMONO2 + CH3CO3 -> TERPF1 + 0.56*CH2O + HO2 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (654) + LIMONO2_CH3O2 (488) LIMONO2 + CH3O2 -> 0.25*CH3OH + TERPF1 + 1.03*CH2O + HO2 rate = 2.00E-12 (655) + LIMONO2_HO2 (489) LIMONO2 + HO2 -> 0.9*TERP1OOH + 0.1*TERPF1 + 0.1*OH + 0.1*HO2 rate = 2.60E-13*exp( 1300./t) (656) + 0.06*CH2O - LIMONO2_NO (491) LIMONO2 + NO -> 0.17*TERPNT1 + 0.06*TERPNS1 + 0.77*NO2 rate = 2.70E-12*exp( 360./t) (658) + LIMONO2_NO (490) LIMONO2 + NO -> 0.17*TERPNT1 + 0.06*TERPNS1 + 0.77*NO2 rate = 2.70E-12*exp( 360./t) (657) + 0.77*TERPF1 + 0.77*HO2 + 0.43*CH2O - LIMONO2_NO3 (492) LIMONO2 + NO3 -> NO2 + TERPF1 + HO2 + 0.56*CH2O rate = 2.30E-12 (659) - LIMONO2_TERPA2CO (493) LIMONO2 + TERPA2CO3 -> TERPF1 + 0.56*CH2O + HO2 + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (660) - LIMONO2_TERPA3CO (494) LIMONO2 + TERPA3CO3 -> TERPF1 + 0.56*CH2O + HO2 + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (661) - LIMONO2_TERPACO3 (495) LIMONO2 + TERPACO3 -> TERPF1 + 0.56*CH2O + HO2 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (662) - LIMON_O3 (496) LIMON + O3 -> 0.66*OH + 0.66*TERPF1 + 0.33*CH3CO3 + 0.33*CH2O rate = 2.80E-15*exp( -770./t) (663) + LIMONO2_NO3 (491) LIMONO2 + NO3 -> NO2 + TERPF1 + HO2 + 0.56*CH2O rate = 2.30E-12 (658) + LIMONO2_TERPA2CO (492) LIMONO2 + TERPA2CO3 -> TERPF1 + 0.56*CH2O + HO2 + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (659) + LIMONO2_TERPA3CO (493) LIMONO2 + TERPA3CO3 -> TERPF1 + 0.56*CH2O + HO2 + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (660) + LIMONO2_TERPACO3 (494) LIMONO2 + TERPACO3 -> TERPF1 + 0.56*CH2O + HO2 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (661) + LIMON_O3 (495) LIMON + O3 -> 0.66*OH + 0.66*TERPF1 + 0.33*CH3CO3 + 0.33*CH2O rate = 2.80E-15*exp( -770./t) (662) + 0.33*TERPA3CO3 + 0.33*H2O2 + 0.01*TERPACID - LIMON_OH (497) LIMON + OH -> LIMONO2 rate = 3.41E-11*exp( 470./t) (664) - MYRC_NO3 (498) MYRC + NO3 -> MYRCNO3 rate = 1.10E-11 (665) - MYRCNO3_CH3CO3 (499) MYRCNO3 + CH3CO3 -> CH3O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 rate = 2.00E-12*exp( 500./t) (666) + LIMON_OH (496) LIMON + OH -> LIMONO2 rate = 3.41E-11*exp( 470./t) (663) + MYRC_NO3 (497) MYRC + NO3 -> MYRCNO3 rate = 1.10E-11 (664) + MYRCNO3_CH3CO3 (498) MYRCNO3 + CH3CO3 -> CH3O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 rate = 2.00E-12*exp( 500./t) (665) + 0.04*CH2O + 0.05*TERPNS1 + 0.05*HO2 + 0.91*CH3COCH3 - MYRCNO3_CH3O2 (500) MYRCNO3 + CH3O2 -> 0.14*TERPNS1 + 0.98*CH2O + 0.77*TERPF2 rate = 2.00E-12 (667) + MYRCNO3_CH3O2 (499) MYRCNO3 + CH3O2 -> 0.14*TERPNS1 + 0.98*CH2O + 0.77*TERPF2 rate = 2.00E-12 (666) + 0.77*NO2 + 0.87*HO2 + 0.74*CH3COCH3 + 0.09*TERPNT1 + 0.05*CH3OH - MYRCNO3_HO2 (501) MYRCNO3 + HO2 -> 0.48*OH + 0.48*TERPF2 + 0.02*CH2O + 0.48*NO2 rate = 2.71E-13*exp( 1300./t) (668) + MYRCNO3_HO2 (500) MYRCNO3 + HO2 -> 0.48*OH + 0.48*TERPF2 + 0.02*CH2O + 0.48*NO2 rate = 2.71E-13*exp( 1300./t) (667) + 0.46*CH3COCH3 + 0.36*TERPNPS1 + 0.16*TERPNPT1 - MYRCNO3_MYRCNO3 (502) MYRCNO3 + MYRCNO3 -> 0.19*TERPNS1 + 0.27*TERPNT1 + 1.54*NO2 rate = 5.30E-13 (669) + MYRCNO3_MYRCNO3 (501) MYRCNO3 + MYRCNO3 -> 0.19*TERPNS1 + 0.27*TERPNT1 + 1.54*NO2 rate = 5.30E-13 (668) + 1.54*TERPF2 + 1.48*CH3COCH3 + 0.06*CH2O - MYRCNO3_NO (503) MYRCNO3 + NO -> 0.07*TERPFDN + 1.82*NO2 + 0.89*TERPF2 + 0.04*CH2O rate = 2.70E-12*exp( 360./t) (670) + MYRCNO3_NO (502) MYRCNO3 + NO -> 0.07*TERPFDN + 1.82*NO2 + 0.89*TERPF2 + 0.04*CH2O rate = 2.70E-12*exp( 360./t) (669) + 0.04*TERPNS1 + 0.04*HO2 + 0.85*CH3COCH3 - MYRCNO3_NO3 (504) MYRCNO3 + NO3 -> 1.95*NO2 + 0.95*TERPF2 + 0.04*CH2O + 0.05*TERPNS1 rate = 2.30E-12 (671) + MYRCNO3_NO3 (503) MYRCNO3 + NO3 -> 1.95*NO2 + 0.95*TERPF2 + 0.04*CH2O + 0.05*TERPNS1 rate = 2.30E-12 (670) + 0.05*HO2 + 0.91*CH3COCH3 - MYRCNO3_TERPA2CO (505) MYRCNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 rate = 2.00E-12*exp( 500./t) (672) + MYRCNO3_TERPA2CO (504) MYRCNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 rate = 2.00E-12*exp( 500./t) (671) + 0.04*CH2O + 0.05*TERPNS1 + 0.05*HO2 + 0.91*CH3COCH3 - MYRCNO3_TERPA3CO (506) MYRCNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 rate = 2.00E-12*exp( 500./t) (673) + MYRCNO3_TERPA3CO (505) MYRCNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 rate = 2.00E-12*exp( 500./t) (672) + 0.04*CH2O + 0.05*TERPNS1 + 0.05*HO2 + 0.91*CH3COCH3 - MYRCNO3_TERPACO3 (507) MYRCNO3 + TERPACO3 -> TERPA1O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 rate = 2.00E-12*exp( 500./t) (674) + MYRCNO3_TERPACO3 (506) MYRCNO3 + TERPACO3 -> TERPA1O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 rate = 2.00E-12*exp( 500./t) (673) + 0.04*CH2O + 0.05*TERPNS1 + 0.05*HO2 + 0.91*CH3COCH3 - MYRCO2_CH3CO3 (508) MYRCO2 + CH3CO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O + CH3O2 rate = 2.00E-12*exp( 500./t) (675) + MYRCO2_CH3CO3 (507) MYRCO2 + CH3CO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O + CH3O2 rate = 2.00E-12*exp( 500./t) (674) + CO2 - MYRCO2_CH3O2 (509) MYRCO2 + CH3O2 -> 0.25*CH3OH + TERPF2 + 0.75*CH2O + HO2 rate = 2.00E-12 (676) - MYRCO2_HO2 (510) MYRCO2 + HO2 -> 0.9*TERP2AOOH + 0.1*TERPF2 + 0.1*OH + 0.1*HO2 rate = 2.60E-13*exp( 1300./t) (677) + MYRCO2_CH3O2 (508) MYRCO2 + CH3O2 -> 0.25*CH3OH + TERPF2 + 0.75*CH2O + HO2 rate = 2.00E-12 (675) + MYRCO2_HO2 (509) MYRCO2 + HO2 -> 0.9*TERP2AOOH + 0.1*TERPF2 + 0.1*OH + 0.1*HO2 rate = 2.60E-13*exp( 1300./t) (676) + 0.05*CH3COCH3 + 0.04*CH2O - MYRCO2_NO (511) MYRCO2 + NO -> 0.1*TERPNS1 + 0.19*TERPNT1 + 0.71*NO2 + 0.71*TERPF2 rate = 2.70E-12*exp( 360./t) (678) + MYRCO2_NO (510) MYRCO2 + NO -> 0.1*TERPNS1 + 0.19*TERPNT1 + 0.71*NO2 + 0.71*TERPF2 rate = 2.70E-12*exp( 360./t) (677) + 0.33*CH3COCH3 + 0.3*CH2O + 0.71*HO2 - MYRCO2_NO3 (512) MYRCO2 + NO3 -> NO2 + TERPF2 + 0.46*CH3COCH3 + 0.42*CH2O + HO2 rate = 2.30E-12 (679) - MYRCO2_TERPA2CO3 (513) MYRCO2 + TERPA2CO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O rate = 2.00E-12*exp( 500./t) (680) + MYRCO2_NO3 (511) MYRCO2 + NO3 -> NO2 + TERPF2 + 0.46*CH3COCH3 + 0.42*CH2O + HO2 rate = 2.30E-12 (678) + MYRCO2_TERPA2CO3 (512) MYRCO2 + TERPA2CO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O rate = 2.00E-12*exp( 500./t) (679) + TERPA2O2 + CO2 - MYRCO2_TERPA3CO3 (514) MYRCO2 + TERPA3CO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O rate = 2.00E-12*exp( 500./t) (681) + MYRCO2_TERPA3CO3 (513) MYRCO2 + TERPA3CO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O rate = 2.00E-12*exp( 500./t) (680) + TERPA4O2 + CO2 - MYRCO2_TERPACO3 (515) MYRCO2 + TERPACO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O rate = 2.00E-12*exp( 500./t) (682) + MYRCO2_TERPACO3 (514) MYRCO2 + TERPACO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O rate = 2.00E-12*exp( 500./t) (681) + TERPA1O2 + CO2 - MYRC_O3 (516) MYRC + O3 -> TERPF2 + 0.63*OH + 0.63*HO2 + 0.25*CH3COCH3 rate = 2.65E-15*exp( -520./t) (683) + MYRC_O3 (515) MYRC + O3 -> TERPF2 + 0.63*OH + 0.63*HO2 + 0.25*CH3COCH3 rate = 2.65E-15*exp( -520./t) (682) + 0.39*CH2O + 0.18*HYAC - MYRC_OH (517) MYRC + OH -> MYRCO2 rate = 2.10E-10 (684) - tag_TERPA2CO3_NO (518) TERPA2CO3 + NO2 + M -> TERPA2PAN + M troe : ko=9.70E-29*(300/t)**5.60 (685) + MYRC_OH (516) MYRC + OH -> MYRCO2 rate = 2.10E-10 (683) + tag_TERPA2CO3_NO (517) TERPA2CO3 + NO2 + M -> TERPA2PAN + M troe : ko=9.70E-29*(300/t)**5.60 (684) ki=9.30E-12*(300/t)**1.50 f=0.60 - tag_TERPA3CO3_NO (519) TERPA3CO3 + NO2 + M -> TERPA3PAN + M troe : ko=9.70E-29*(300/t)**5.60 (686) + tag_TERPA3CO3_NO (518) TERPA3CO3 + NO2 + M -> TERPA3PAN + M troe : ko=9.70E-29*(300/t)**5.60 (685) ki=9.30E-12*(300/t)**1.50 f=0.60 - tag_TERPACO3_NO2 (520) TERPACO3 + NO2 + M -> TERPAPAN + M troe : ko=9.70E-29*(300/t)**5.60 (687) + tag_TERPACO3_NO2 (519) TERPACO3 + NO2 + M -> TERPAPAN + M troe : ko=9.70E-29*(300/t)**5.60 (686) ki=9.30E-12*(300/t)**1.50 f=0.60 - TERP1OOHO2_HO2 (521) TERP1OOHO2 + HO2 -> 0.82*TERPDHDP + 0.18*TERPOOHL + 0.18*OH rate = 2.71E-13*exp( 1300./t) (688) + TERP1OOHO2_HO2 (520) TERP1OOHO2 + HO2 -> 0.82*TERPDHDP + 0.18*TERPOOHL + 0.18*OH rate = 2.71E-13*exp( 1300./t) (687) + 0.18*HO2 + 0.08*CH2O - TERP1OOHO2_NO (522) TERP1OOHO2 + NO -> 0.3*TERPHFN + 0.7*NO2 + 0.7*TERPOOHL + 0.31*CH2O rate = 2.70E-12*exp( 360./t) (689) + TERP1OOHO2_NO (521) TERP1OOHO2 + NO -> 0.3*TERPHFN + 0.7*NO2 + 0.7*TERPOOHL + 0.31*CH2O rate = 2.70E-12*exp( 360./t) (688) + 0.7*HO2 - TERP1OOH_OH (523) TERP1OOH + OH -> TERP1OOHO2 rate = 8.90E-11 (690) - TERP2AOOH_OH (524) TERP2AOOH + OH -> TERP2OOHO2 rate = 8.90E-11 (691) - TERP2OOHO2_HO2 (525) TERP2OOHO2 + HO2 -> 0.82*TERPDHDP + 0.18*TERP1OOH + 0.18*OH rate = 2.71E-13*exp( 1300./t) (692) + TERP1OOH_OH (522) TERP1OOH + OH -> TERP1OOHO2 rate = 8.90E-11 (689) + TERP2AOOH_OH (523) TERP2AOOH + OH -> TERP2OOHO2 rate = 8.90E-11 (690) + TERP2OOHO2_HO2 (524) TERP2OOHO2 + HO2 -> 0.82*TERPDHDP + 0.18*TERP1OOH + 0.18*OH rate = 2.71E-13*exp( 1300./t) (691) + 0.18*HO2 - TERP2OOHO2_NO (526) TERP2OOHO2 + NO -> 0.3*TERPHFN + 0.7*NO2 + 0.7*TERP1OOH + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (693) - TERPA1O2_CH3CO3 (527) TERPA1O2 + CH3CO3 -> TERPA2O2 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (694) - TERPA1O2_CH3O2 (528) TERPA1O2 + CH3O2 -> 0.25*CH3OH + 0.75*CH2O + 0.5*HO2 + 0.5*TERPA2 rate = 2.00E-12 (695) + TERP2OOHO2_NO (525) TERP2OOHO2 + NO -> 0.3*TERPHFN + 0.7*NO2 + 0.7*TERP1OOH + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (692) + TERPA1O2_CH3CO3 (526) TERPA1O2 + CH3CO3 -> TERPA2O2 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (693) + TERPA1O2_CH3O2 (527) TERPA1O2 + CH3O2 -> 0.25*CH3OH + 0.75*CH2O + 0.5*HO2 + 0.5*TERPA2 rate = 2.00E-12 (694) + 0.5*TERPA2O2 - TERPA1O2_HO2 (529) TERPA1O2 + HO2 -> TERPOOH rate = 2.54E-13*exp( 1300./t) (696) - TERPA1O2_NO (530) TERPA1O2 + NO -> 0.3*TERPNS + 0.7*NO2 + 0.7*TERPA2O2 rate = 2.70E-12*exp( 360./t) (697) - TERPA1O2_NO3 (531) TERPA1O2 + NO3 -> NO2 + TERPA2O2 rate = 2.30E-12 (698) - TERPA1O2_TERPA2C (532) TERPA1O2 + TERPA2CO3 -> 2*TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (699) - TERPA1O2_TERPA3C (533) TERPA1O2 + TERPA3CO3 -> TERPA2O2 + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (700) - TERPA1O2_TERPACO (534) TERPA1O2 + TERPACO3 -> TERPA2O2 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (701) - TERPA2CO3_CH3CO3 (535) TERPA2CO3 + CH3CO3 -> 2*CO2 + TERPA2O2 + CH3O2 rate = 2.90E-12*exp( 500./t) (702) - TERPA2CO3_CH3O2 (536) TERPA2CO3 + CH3O2 -> CO2 + TERPA2O2 + CH2O + HO2 rate = 2.00E-12*exp( 500./t) (703) - TERPA2CO3_HO2 (537) TERPA2CO3 + HO2 -> 0.15*O3 + 0.51*TERPACID2 + 0.49*OH + 0.49*CO2 rate = 4.30E-13*exp( 1040./t) (704) + TERPA1O2_HO2 (528) TERPA1O2 + HO2 -> TERPOOH rate = 2.54E-13*exp( 1300./t) (695) + TERPA1O2_NO (529) TERPA1O2 + NO -> 0.3*TERPNS + 0.7*NO2 + 0.7*TERPA2O2 rate = 2.70E-12*exp( 360./t) (696) + TERPA1O2_NO3 (530) TERPA1O2 + NO3 -> NO2 + TERPA2O2 rate = 2.30E-12 (697) + TERPA1O2_TERPA2C (531) TERPA1O2 + TERPA2CO3 -> 2*TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (698) + TERPA1O2_TERPA3C (532) TERPA1O2 + TERPA3CO3 -> TERPA2O2 + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (699) + TERPA1O2_TERPACO (533) TERPA1O2 + TERPACO3 -> TERPA2O2 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (700) + TERPA2CO3_CH3CO3 (534) TERPA2CO3 + CH3CO3 -> 2*CO2 + TERPA2O2 + CH3O2 rate = 2.90E-12*exp( 500./t) (701) + TERPA2CO3_CH3O2 (535) TERPA2CO3 + CH3O2 -> CO2 + TERPA2O2 + CH2O + HO2 rate = 2.00E-12*exp( 500./t) (702) + TERPA2CO3_HO2 (536) TERPA2CO3 + HO2 -> 0.15*O3 + 0.51*TERPACID2 + 0.49*OH + 0.49*CO2 rate = 4.30E-13*exp( 1040./t) (703) + 0.49*TERPA2O2 - TERPA2CO3_NO (538) TERPA2CO3 + NO -> NO2 + CO2 + TERPA2O2 rate = 8.10E-12*exp( 270./t) (705) - TERPA2CO3_NO3 (539) TERPA2CO3 + NO3 -> NO2 + CO2 + TERPA2O2 rate = 4.00E-12 (706) - TERPA2CO3_TERPA2 (540) TERPA2CO3 + TERPA2CO3 -> 2*CO2 + 2*TERPA2O2 rate = 2.90E-12*exp( 500./t) (707) - TERPA2CO3_TERPAC (541) TERPA2CO3 + TERPACO3 -> 2*CO2 + TERPA2O2 + TERPA1O2 rate = 2.90E-12*exp( 500./t) (708) - TERPA2_NO3 (542) TERPA2 + NO3 -> HNO3 + TERPA2CO3 rate = 2.00E-14 (709) - TERPA2O2_CH3CO3 (543) TERPA2O2 + CH3CO3 -> TERPA3O2 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (710) - TERPA2O2_CH3O2 (544) TERPA2O2 + CH3O2 -> TERPA3O2 + CH2O + HO2 rate = 2.00E-12 (711) - TERPA2O2_HO2 (545) TERPA2O2 + HO2 -> 0.62*TERPOOH + 0.38*TERPA3O2 + 0.38*OH rate = 2.62E-13*exp( 1300./t) (712) - TERPA2O2_NO (546) TERPA2O2 + NO -> 0.17*TERPNT + 0.83*NO2 + 0.83*TERPA3O2 rate = 2.70E-12*exp( 360./t) (713) - TERPA2O2_NO3 (547) TERPA2O2 + NO3 -> NO2 + TERPA3O2 rate = 2.30E-12 (714) - TERPA2O2_TERPA2C (548) TERPA2O2 + TERPA2CO3 -> TERPA3O2 + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (715) - TERPA2O2_TERPA3C (549) TERPA2O2 + TERPA3CO3 -> TERPA3O2 + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (716) - TERPA2O2_TERPACO (550) TERPA2O2 + TERPACO3 -> TERPA3O2 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (717) - TERPA2_OH (551) TERPA2 + OH -> TERPA2CO3 rate = 5.20E-12*exp( 600./t) (718) - TERPA2PAN_OH (552) TERPA2PAN + OH -> CH3COCH3 + 2*CO2 + 2*CH2O + NO2 + 2*CO + HO2 rate = 2.52E-11 (719) - TERPA3CO3_CH3CO3 (553) TERPA3CO3 + CH3CO3 -> 2*CO2 + TERPA4O2 + CH3O2 rate = 2.90E-12*exp( 500./t) (720) - TERPA3CO3_CH3O2 (554) TERPA3CO3 + CH3O2 -> CO2 + TERPA4O2 + CH2O + HO2 rate = 2.00E-12*exp( 500./t) (721) - TERPA3CO3_HO2 (555) TERPA3CO3 + HO2 -> 0.15*O3 + 0.51*TERPACID3 + 0.49*OH + 0.49*CO2 rate = 4.30E-13*exp( 1040./t) (722) + TERPA2CO3_NO (537) TERPA2CO3 + NO -> NO2 + CO2 + TERPA2O2 rate = 8.10E-12*exp( 270./t) (704) + TERPA2CO3_NO3 (538) TERPA2CO3 + NO3 -> NO2 + CO2 + TERPA2O2 rate = 4.00E-12 (705) + TERPA2CO3_TERPA2 (539) TERPA2CO3 + TERPA2CO3 -> 2*CO2 + 2*TERPA2O2 rate = 2.90E-12*exp( 500./t) (706) + TERPA2CO3_TERPAC (540) TERPA2CO3 + TERPACO3 -> 2*CO2 + TERPA2O2 + TERPA1O2 rate = 2.90E-12*exp( 500./t) (707) + TERPA2_NO3 (541) TERPA2 + NO3 -> HNO3 + TERPA2CO3 rate = 2.00E-14 (708) + TERPA2O2_CH3CO3 (542) TERPA2O2 + CH3CO3 -> TERPA3O2 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (709) + TERPA2O2_CH3O2 (543) TERPA2O2 + CH3O2 -> TERPA3O2 + CH2O + HO2 rate = 2.00E-12 (710) + TERPA2O2_HO2 (544) TERPA2O2 + HO2 -> 0.62*TERPOOH + 0.38*TERPA3O2 + 0.38*OH rate = 2.62E-13*exp( 1300./t) (711) + TERPA2O2_NO (545) TERPA2O2 + NO -> 0.17*TERPNT + 0.83*NO2 + 0.83*TERPA3O2 rate = 2.70E-12*exp( 360./t) (712) + TERPA2O2_NO3 (546) TERPA2O2 + NO3 -> NO2 + TERPA3O2 rate = 2.30E-12 (713) + TERPA2O2_TERPA2C (547) TERPA2O2 + TERPA2CO3 -> TERPA3O2 + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (714) + TERPA2O2_TERPA3C (548) TERPA2O2 + TERPA3CO3 -> TERPA3O2 + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (715) + TERPA2O2_TERPACO (549) TERPA2O2 + TERPACO3 -> TERPA3O2 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (716) + TERPA2_OH (550) TERPA2 + OH -> TERPA2CO3 rate = 5.20E-12*exp( 600./t) (717) + TERPA2PAN_OH (551) TERPA2PAN + OH -> CH3COCH3 + 2*CO2 + 2*CH2O + NO2 + 2*CO + HO2 rate = 2.52E-11 (718) + TERPA3CO3_CH3CO3 (552) TERPA3CO3 + CH3CO3 -> 2*CO2 + TERPA4O2 + CH3O2 rate = 2.90E-12*exp( 500./t) (719) + TERPA3CO3_CH3O2 (553) TERPA3CO3 + CH3O2 -> CO2 + TERPA4O2 + CH2O + HO2 rate = 2.00E-12*exp( 500./t) (720) + TERPA3CO3_HO2 (554) TERPA3CO3 + HO2 -> 0.15*O3 + 0.51*TERPACID3 + 0.49*OH + 0.49*CO2 rate = 4.30E-13*exp( 1040./t) (721) + 0.49*TERPA4O2 - TERPA3CO3_NO (556) TERPA3CO3 + NO -> NO2 + CO2 + TERPA4O2 rate = 8.10E-12*exp( 270./t) (723) - TERPA3CO3_NO3 (557) TERPA3CO3 + NO3 -> NO2 + CO2 + TERPA4O2 rate = 4.00E-12 (724) - TERPA3CO3_TERPA2 (558) TERPA3CO3 + TERPA2CO3 -> 2*CO2 + TERPA4O2 + TERPA2O2 rate = 2.90E-12*exp( 500./t) (725) - TERPA3CO3_TERPA3 (559) TERPA3CO3 + TERPA3CO3 -> 2*CO2 + 2*TERPA4O2 rate = 2.90E-12*exp( 500./t) (726) - TERPA3CO3_TERPAC (560) TERPA3CO3 + TERPACO3 -> 2*CO2 + TERPA4O2 + TERPA1O2 rate = 2.90E-12*exp( 500./t) (727) - TERPA3_NO3 (561) TERPA3 + NO3 -> HNO3 + TERPA3CO3 rate = 2.00E-14 (728) - TERPA3O2_CH3CO3 (562) TERPA3O2 + CH3CO3 -> TERPA4O2 + CH3COCH3 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (729) - TERPA3O2_CH3O2 (563) TERPA3O2 + CH3O2 -> TERPA4O2 + CH3COCH3 + CH2O + HO2 rate = 2.00E-12 (730) - TERPA3O2_HO2 (564) TERPA3O2 + HO2 -> 0.85*TERPOOHL + 0.15*TERPA4O2 + 0.15*OH rate = 2.66E-13*exp( 1300./t) (731) + TERPA3CO3_NO (555) TERPA3CO3 + NO -> NO2 + CO2 + TERPA4O2 rate = 8.10E-12*exp( 270./t) (722) + TERPA3CO3_NO3 (556) TERPA3CO3 + NO3 -> NO2 + CO2 + TERPA4O2 rate = 4.00E-12 (723) + TERPA3CO3_TERPA2 (557) TERPA3CO3 + TERPA2CO3 -> 2*CO2 + TERPA4O2 + TERPA2O2 rate = 2.90E-12*exp( 500./t) (724) + TERPA3CO3_TERPA3 (558) TERPA3CO3 + TERPA3CO3 -> 2*CO2 + 2*TERPA4O2 rate = 2.90E-12*exp( 500./t) (725) + TERPA3CO3_TERPAC (559) TERPA3CO3 + TERPACO3 -> 2*CO2 + TERPA4O2 + TERPA1O2 rate = 2.90E-12*exp( 500./t) (726) + TERPA3_NO3 (560) TERPA3 + NO3 -> HNO3 + TERPA3CO3 rate = 2.00E-14 (727) + TERPA3O2_CH3CO3 (561) TERPA3O2 + CH3CO3 -> TERPA4O2 + CH3COCH3 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (728) + TERPA3O2_CH3O2 (562) TERPA3O2 + CH3O2 -> TERPA4O2 + CH3COCH3 + CH2O + HO2 rate = 2.00E-12 (729) + TERPA3O2_HO2 (563) TERPA3O2 + HO2 -> 0.85*TERPOOHL + 0.15*TERPA4O2 + 0.15*OH rate = 2.66E-13*exp( 1300./t) (730) + 0.15*CH3COCH3 - TERPA3O2_NO (565) TERPA3O2 + NO -> 0.3*TERPNT + 0.7*NO2 + 0.7*TERPA4O2 + 0.7*CH3COCH3 rate = 2.70E-12*exp( 360./t) (732) - TERPA3O2_NO3 (566) TERPA3O2 + NO3 -> NO2 + TERPA4O2 + CH3COCH3 rate = 2.30E-12 (733) - TERPA3O2_TERPA2C (567) TERPA3O2 + TERPA2CO3 -> TERPA4O2 + CH3COCH3 + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (734) - TERPA3O2_TERPA3C (568) TERPA3O2 + TERPA3CO3 -> 2*TERPA4O2 + CH3COCH3 + CO2 rate = 2.00E-12*exp( 500./t) (735) - TERPA3O2_TERPACO (569) TERPA3O2 + TERPACO3 -> TERPA4O2 + CH3COCH3 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (736) - TERPA3_OH (570) TERPA3 + OH -> 0.75*TERPA3CO3 + 0.25*TERPA4O2 rate = 5.20E-12*exp( 600./t) (737) - TERPA3PAN_OH (571) TERPA3PAN + OH -> CO + NO2 + 3*CO2 + 2*CH3CO3 + CH2O + HO2 rate = 1.92E-11 (738) - TERPA4O2_CH3CO3 (572) TERPA4O2 + CH3CO3 -> CH3CO3 + HO2 + 2*CH2O + CO + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (739) - TERPA4O2_CH3O2 (573) TERPA4O2 + CH3O2 -> CH3CO3 + 2*HO2 + 3*CH2O + CO rate = 2.00E-12 (740) - TERPA4O2_HO2 (574) TERPA4O2 + HO2 -> 0.47*TERPOOHL + 0.53*CH3CO3 + 0.53*HO2 rate = 2.51E-13*exp( 1300./t) (741) + TERPA3O2_NO (564) TERPA3O2 + NO -> 0.3*TERPNT + 0.7*NO2 + 0.7*TERPA4O2 + 0.7*CH3COCH3 rate = 2.70E-12*exp( 360./t) (731) + TERPA3O2_NO3 (565) TERPA3O2 + NO3 -> NO2 + TERPA4O2 + CH3COCH3 rate = 2.30E-12 (732) + TERPA3O2_TERPA2C (566) TERPA3O2 + TERPA2CO3 -> TERPA4O2 + CH3COCH3 + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (733) + TERPA3O2_TERPA3C (567) TERPA3O2 + TERPA3CO3 -> 2*TERPA4O2 + CH3COCH3 + CO2 rate = 2.00E-12*exp( 500./t) (734) + TERPA3O2_TERPACO (568) TERPA3O2 + TERPACO3 -> TERPA4O2 + CH3COCH3 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (735) + TERPA3_OH (569) TERPA3 + OH -> 0.75*TERPA3CO3 + 0.25*TERPA4O2 rate = 5.20E-12*exp( 600./t) (736) + TERPA3PAN_OH (570) TERPA3PAN + OH -> CO + NO2 + 3*CO2 + 2*CH3CO3 + CH2O + HO2 rate = 1.92E-11 (737) + TERPA4O2_CH3CO3 (571) TERPA4O2 + CH3CO3 -> CH3CO3 + HO2 + 2*CH2O + CO + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (738) + TERPA4O2_CH3O2 (572) TERPA4O2 + CH3O2 -> CH3CO3 + 2*HO2 + 3*CH2O + CO rate = 2.00E-12 (739) + TERPA4O2_HO2 (573) TERPA4O2 + HO2 -> 0.47*TERPOOHL + 0.53*CH3CO3 + 0.53*HO2 rate = 2.51E-13*exp( 1300./t) (740) + 1.06*CH2O + 0.53*CO + 0.53*OH - TERPA4O2_NO (575) TERPA4O2 + NO -> 0.09*TERPNS + 0.91*NO2 + 0.91*CH3CO3 + 0.91*HO2 rate = 2.70E-12*exp( 360./t) (742) + TERPA4O2_NO (574) TERPA4O2 + NO -> 0.09*TERPNS + 0.91*NO2 + 0.91*CH3CO3 + 0.91*HO2 rate = 2.70E-12*exp( 360./t) (741) + 1.82*CH2O + 0.91*CO - TERPA4O2_NO3 (576) TERPA4O2 + NO3 -> NO2 + CH3CO3 + HO2 + 2*CH2O + CO rate = 2.30E-12 (743) - TERPA4O2_TERPA2C (577) TERPA4O2 + TERPA2CO3 -> CH3CO3 + HO2 + 2*CH2O + CO + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (744) - TERPA4O2_TERPA3C (578) TERPA4O2 + TERPA3CO3 -> CH3CO3 + HO2 + 2*CH2O + CO + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (745) - TERPA4O2_TERPACO (579) TERPA4O2 + TERPACO3 -> CH3CO3 + HO2 + 2*CH2O + CO + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (746) - TERPACID2_OH (580) TERPACID2 + OH -> 0.71*TERPA2CO3 + 0.29*CO2 + 0.29*TERPA2O2 rate = 8.80E-12 (747) - TERPACID3_OH (581) TERPACID3 + OH -> 0.71*TERPA3CO3 + 0.29*CO2 + 0.29*TERPA4O2 rate = 8.80E-12 (748) - TERPACID_OH (582) TERPACID + OH -> 0.71*TERPACO3 + 0.29*CO2 + 0.29*TERPA1O2 rate = 8.80E-12 (749) - TERPACO3_CH3CO3 (583) TERPACO3 + CH3CO3 -> 2*CO2 + TERPA1O2 + CH3O2 rate = 2.90E-12*exp( 500./t) (750) - TERPACO3_CH3O2 (584) TERPACO3 + CH3O2 -> CO2 + TERPA1O2 + CH2O + HO2 rate = 2.00E-12*exp( 500./t) (751) - TERPACO3_HO2 (585) TERPACO3 + HO2 -> 0.15*O3 + 0.51*TERPACID + 0.49*OH + 0.49*CO2 rate = 4.30E-13*exp( 1040./t) (752) + TERPA4O2_NO3 (575) TERPA4O2 + NO3 -> NO2 + CH3CO3 + HO2 + 2*CH2O + CO rate = 2.30E-12 (742) + TERPA4O2_TERPA2C (576) TERPA4O2 + TERPA2CO3 -> CH3CO3 + HO2 + 2*CH2O + CO + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (743) + TERPA4O2_TERPA3C (577) TERPA4O2 + TERPA3CO3 -> CH3CO3 + HO2 + 2*CH2O + CO + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (744) + TERPA4O2_TERPACO (578) TERPA4O2 + TERPACO3 -> CH3CO3 + HO2 + 2*CH2O + CO + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (745) + TERPACID2_OH (579) TERPACID2 + OH -> 0.71*TERPA2CO3 + 0.29*CO2 + 0.29*TERPA2O2 rate = 8.80E-12 (746) + TERPACID3_OH (580) TERPACID3 + OH -> 0.71*TERPA3CO3 + 0.29*CO2 + 0.29*TERPA4O2 rate = 8.80E-12 (747) + TERPACID_OH (581) TERPACID + OH -> 0.71*TERPACO3 + 0.29*CO2 + 0.29*TERPA1O2 rate = 8.80E-12 (748) + TERPACO3_CH3CO3 (582) TERPACO3 + CH3CO3 -> 2*CO2 + TERPA1O2 + CH3O2 rate = 2.90E-12*exp( 500./t) (749) + TERPACO3_CH3O2 (583) TERPACO3 + CH3O2 -> CO2 + TERPA1O2 + CH2O + HO2 rate = 2.00E-12*exp( 500./t) (750) + TERPACO3_HO2 (584) TERPACO3 + HO2 -> 0.15*O3 + 0.51*TERPACID + 0.49*OH + 0.49*CO2 rate = 4.30E-13*exp( 1040./t) (751) + 0.49*TERPA1O2 - TERPACO3_NO (586) TERPACO3 + NO -> NO2 + CO2 + TERPA1O2 rate = 8.10E-12*exp( 270./t) (753) - TERPACO3_NO3 (587) TERPACO3 + NO3 -> NO2 + CO2 + TERPA1O2 rate = 4.00E-12 (754) - TERPACO3_TERPACO (588) TERPACO3 + TERPACO3 -> 2*CO2 + 2*TERPA1O2 rate = 2.90E-12*exp( 500./t) (755) - TERPA_NO3 (589) TERPA + NO3 -> HNO3 + TERPACO3 rate = 2.00E-14 (756) - TERPA_OH (590) TERPA + OH -> 0.77*TERPACO3 + 0.23*TERPA2O2 rate = 5.20E-12*exp( 600./t) (757) - TERPAPAN_OH (591) TERPAPAN + OH -> TERPA2 + NO2 + CO rate = 3.66E-12 (758) - TERPDHDP_OH (592) TERPDHDP + OH -> TERPOOH + OH rate = 2.80E-11 (759) - TERPF1_NO3 (593) TERPF1 + NO3 -> NO2 + 0.44*CH2O + TERPA3 rate = 2.60E-13 (760) - TERPF1O2_HO2 (594) TERPF1O2 + HO2 -> 0.9*TERPOOHL + 0.1*OH + 0.1*HO2 + 0.1*TERPA3 rate = 2.68E-13*exp( 1300./t) (761) + TERPACO3_NO (585) TERPACO3 + NO -> NO2 + CO2 + TERPA1O2 rate = 8.10E-12*exp( 270./t) (752) + TERPACO3_NO3 (586) TERPACO3 + NO3 -> NO2 + CO2 + TERPA1O2 rate = 4.00E-12 (753) + TERPACO3_TERPACO (587) TERPACO3 + TERPACO3 -> 2*CO2 + 2*TERPA1O2 rate = 2.90E-12*exp( 500./t) (754) + TERPA_NO3 (588) TERPA + NO3 -> HNO3 + TERPACO3 rate = 2.00E-14 (755) + TERPA_OH (589) TERPA + OH -> 0.77*TERPACO3 + 0.23*TERPA2O2 rate = 5.20E-12*exp( 600./t) (756) + TERPAPAN_OH (590) TERPAPAN + OH -> TERPA2 + NO2 + CO rate = 3.66E-12 (757) + TERPDHDP_OH (591) TERPDHDP + OH -> TERPOOH + OH rate = 2.80E-11 (758) + TERPF1_NO3 (592) TERPF1 + NO3 -> NO2 + 0.44*CH2O + TERPA3 rate = 2.60E-13 (759) + TERPF1O2_HO2 (593) TERPF1O2 + HO2 -> 0.9*TERPOOHL + 0.1*OH + 0.1*HO2 + 0.1*TERPA3 rate = 2.68E-13*exp( 1300./t) (760) + 0.04*CH2O - TERPF1O2_NO (595) TERPF1O2 + NO -> 0.3*TERPHFN + 0.7*NO2 + 0.7*HO2 + 0.7*TERPA3 rate = 2.70E-12*exp( 360./t) (762) + TERPF1O2_NO (594) TERPF1O2 + NO -> 0.3*TERPHFN + 0.7*NO2 + 0.7*HO2 + 0.7*TERPA3 rate = 2.70E-12*exp( 360./t) (761) + 0.31*CH2O - TERPF1_O3 (596) TERPF1 + O3 -> 0.09*OH + TERPA3 + 0.62*CH2O + 0.23*HMHP + 0.02*H2O2 rate = 8.30E-18 (763) + TERPF1_O3 (595) TERPF1 + O3 -> 0.09*OH + TERPA3 + 0.62*CH2O + 0.23*HMHP + 0.02*H2O2 rate = 8.30E-18 (762) + 0.15*HCOOH - TERPF1_OH (597) TERPF1 + OH -> 0.83*TERPF1O2 + 0.17*TERPA3CO3 rate = 1.10E-10 (764) - TERPF2_NO3 (598) TERPF2 + NO3 -> 0.5*TERPNS1 + 0.5*HO2 + 0.5*TERPF1 + 0.5*CH2O rate = 2.95E-12*exp( -450./t) (765) + TERPF1_OH (596) TERPF1 + OH -> 0.83*TERPF1O2 + 0.17*TERPA3CO3 rate = 1.10E-10 (763) + TERPF2_NO3 (597) TERPF2 + NO3 -> 0.5*TERPNS1 + 0.5*HO2 + 0.5*TERPF1 + 0.5*CH2O rate = 2.95E-12*exp( -450./t) (764) + 0.5*NO2 - TERPF2O2_HO2 (599) TERPF2O2 + HO2 -> 0.9*TERP1OOH + 0.1*OH + 0.1*HO2 + 0.1*TERPF1 rate = 2.47E-13*exp( 1300./t) (766) - TERPF2O2_NO (600) TERPF2O2 + NO -> 0.18*TERPNT1 + 0.12*TERPNS1 + 0.7*NO2 + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (767) + TERPF2O2_HO2 (598) TERPF2O2 + HO2 -> 0.9*TERP1OOH + 0.1*OH + 0.1*HO2 + 0.1*TERPF1 rate = 2.47E-13*exp( 1300./t) (765) + TERPF2O2_NO (599) TERPF2O2 + NO -> 0.18*TERPNT1 + 0.12*TERPNS1 + 0.7*NO2 + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (766) + 0.7*TERPF1 - TERPF2_O3 (601) TERPF2 + O3 -> TERPF1 + 0.34*CH2O + 0.4*HMHP + 0.04*H2O2 rate = 1.10E-16 (768) + TERPF2_O3 (600) TERPF2 + O3 -> TERPF1 + 0.34*CH2O + 0.4*HMHP + 0.04*H2O2 rate = 1.10E-16 (767) + 0.26*HCOOH - TERPF2_OH (602) TERPF2 + OH -> TERPF2O2 rate = 2.70E-11*exp( 390./t) (769) - TERPFDN_OH (603) TERPFDN + OH -> NO2 + TERPNS rate = 3.64E-12 (770) - TERPHFN_OH (604) TERPHFN + OH -> TERPNS + OH rate = 2.80E-11 (771) - TERPK_OH (605) TERPK + OH -> 0.14*TERPA2CO3 + 0.86*TERPA1O2 rate = 1.70E-11 (772) - TERPNPS1O2_HO2 (606) TERPNPS1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNPS + 0.1*HO2 rate = 2.76E-13*exp( 1300./t) (773) - TERPNPS1O2_NO (607) TERPNPS1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNPS + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (774) - TERPNPS1_OH (608) TERPNPS1 + OH -> TERPNPS1O2 rate = 1.10E-10 (775) - TERPNPS_OH (609) TERPNPS + OH -> H2O + BPINNO3 rate = 9.58E-12 (776) - TERPNPT1O2_HO2 (610) TERPNPT1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNPT + 0.1*HO2 rate = 2.76E-13*exp( 1300./t) (777) - TERPNPT1O2_NO (611) TERPNPT1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNPT + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (778) - TERPNPT1_OH (612) TERPNPT1 + OH -> TERPNPT1O2 rate = 1.10E-10 (779) - TERPNPT_OH (613) TERPNPT + OH -> TERPNT + H2O + OH rate = 1.23E-11 (780) - TERPNS1O2_HO2 (614) TERPNS1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNS + 0.1*HO2 rate = 2.75E-13*exp( 1300./t) (781) - TERPNS1O2_NO (615) TERPNS1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNS + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (782) - TERPNS1_OH (616) TERPNS1 + OH -> TERPNS1O2 rate = 1.10E-10 (783) - TERPNS_OH (617) TERPNS + OH -> TERPA + NO2 rate = 3.64E-12 (784) - TERPNT1O2_HO2 (618) TERPNT1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNT + 0.1*HO2 rate = 2.75E-13*exp( 1300./t) (785) - TERPNT1O2_NO (619) TERPNT1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNT + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (786) - TERPNT1_OH (620) TERPNT1 + OH -> TERPNT1O2 rate = 1.10E-10 (787) - TERPNT_OH (621) TERPNT + OH -> TERPA + NO2 rate = 5.50E-12 (788) - TERPOOHL_OH (622) TERPOOHL + OH -> TERPA3 + OH rate = 4.65E-11 (789) - TERPOOH_OH (623) TERPOOH + OH -> TERPA + OH rate = 2.80E-11 (790) - usr_TERPA2PAN_M (624) TERPA2PAN + M -> M + TERPA2CO3 + NO2 rate = ** User defined ** (791) - usr_TERPA3PAN_M (625) TERPA3PAN + M -> TERPA3CO3 + NO2 + M rate = ** User defined ** (792) - usr_TERPAPAN_M (626) TERPAPAN + M -> TERPACO3 + NO2 + M rate = ** User defined ** (793) - DMS_NO3 (627) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (794) - DMS_OHa (628) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (795) - OCS_O (629) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (796) - OCS_OH (630) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (797) - S_O2 (631) S + O2 -> SO + O rate = 2.30E-12 (798) + TERPF2_OH (601) TERPF2 + OH -> TERPF2O2 rate = 2.70E-11*exp( 390./t) (768) + TERPFDN_OH (602) TERPFDN + OH -> NO2 + TERPNS rate = 3.64E-12 (769) + TERPHFN_OH (603) TERPHFN + OH -> TERPNS + OH rate = 2.80E-11 (770) + TERPK_OH (604) TERPK + OH -> 0.14*TERPA2CO3 + 0.86*TERPA1O2 rate = 1.70E-11 (771) + TERPNPS1O2_HO2 (605) TERPNPS1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNPS + 0.1*HO2 rate = 2.76E-13*exp( 1300./t) (772) + TERPNPS1O2_NO (606) TERPNPS1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNPS + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (773) + TERPNPS1_OH (607) TERPNPS1 + OH -> TERPNPS1O2 rate = 1.10E-10 (774) + TERPNPS_OH (608) TERPNPS + OH -> H2O + BPINNO3 rate = 9.58E-12 (775) + TERPNPT1O2_HO2 (609) TERPNPT1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNPT + 0.1*HO2 rate = 2.76E-13*exp( 1300./t) (776) + TERPNPT1O2_NO (610) TERPNPT1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNPT + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (777) + TERPNPT1_OH (611) TERPNPT1 + OH -> TERPNPT1O2 rate = 1.10E-10 (778) + TERPNPT_OH (612) TERPNPT + OH -> TERPNT + H2O + OH rate = 1.23E-11 (779) + TERPNS1O2_HO2 (613) TERPNS1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNS + 0.1*HO2 rate = 2.75E-13*exp( 1300./t) (780) + TERPNS1O2_NO (614) TERPNS1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNS + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (781) + TERPNS1_OH (615) TERPNS1 + OH -> TERPNS1O2 rate = 1.10E-10 (782) + TERPNS_OH (616) TERPNS + OH -> TERPA + NO2 rate = 3.64E-12 (783) + TERPNT1O2_HO2 (617) TERPNT1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNT + 0.1*HO2 rate = 2.75E-13*exp( 1300./t) (784) + TERPNT1O2_NO (618) TERPNT1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNT + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (785) + TERPNT1_OH (619) TERPNT1 + OH -> TERPNT1O2 rate = 1.10E-10 (786) + TERPNT_OH (620) TERPNT + OH -> TERPA + NO2 rate = 5.50E-12 (787) + TERPOOHL_OH (621) TERPOOHL + OH -> TERPA3 + OH rate = 4.65E-11 (788) + TERPOOH_OH (622) TERPOOH + OH -> TERPA + OH rate = 2.80E-11 (789) + usr_TERPA2PAN_M (623) TERPA2PAN + M -> M + TERPA2CO3 + NO2 rate = ** User defined ** (790) + usr_TERPA3PAN_M (624) TERPA3PAN + M -> TERPA3CO3 + NO2 + M rate = ** User defined ** (791) + usr_TERPAPAN_M (625) TERPAPAN + M -> TERPACO3 + NO2 + M rate = ** User defined ** (792) + DMS_NO3 (626) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (793) + DMS_OHa (627) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (794) + OCS_O (628) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (795) + OCS_OH (629) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (796) + S_O2 (630) S + O2 -> SO + O rate = 2.30E-12 (797) + SO2_OH_M (631) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (798) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 S_O3 (632) S + O3 -> SO + O2 rate = 1.20E-11 (799) SO_BRO (633) SO + BRO -> SO2 + BR rate = 5.70E-11 (800) SO_CLO (634) SO + CLO -> SO2 + CL rate = 2.80E-11 (801) @@ -1763,181 +1763,177 @@ Class List SO_O2 (637) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (804) SO_O3 (638) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (805) SO_OCLO (639) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (806) - SO_OH (640) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (807) + SO_OH (640) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (807) usr_DMS_OH (641) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (808) - usr_SO2_OH (642) SO2 + OH -> SO3 + HO2 rate = ** User defined ** (809) - usr_SO3_H2O (643) SO3 + H2O -> H2SO4 rate = ** User defined ** (810) - NH3_OH (644) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (811) - usr_GLYOXAL_aer (645) GLYOXAL -> SOAG0 rate = ** User defined ** (812) - usr_HO2_aer (646) HO2 -> 0.5*H2O2 rate = ** User defined ** (813) - usr_HONITR_aer (647) HONITR -> HNO3 rate = ** User defined ** (814) - usr_ICHE_aer (648) ICHE -> (No products) rate = ** User defined ** (815) - usr_IEPOX_aer (649) IEPOX -> (No products) rate = ** User defined ** (816) - usr_INHEB_aer (650) INHEB -> HNO3 rate = ** User defined ** (817) - usr_INHED_aer (651) INHED -> HNO3 rate = ** User defined ** (818) - usr_INOOHD_aer (652) ISOPNOOHD -> HNO3 rate = ** User defined ** (819) - usr_ISOPFDN_aer (653) ISOPFDN -> HNO3 rate = ** User defined ** (820) - usr_ISOPFDNC_aer (654) ISOPFDNC -> HNO3 rate = ** User defined ** (821) - usr_ISOPFNC_aer (655) ISOPFNC -> (No products) rate = ** User defined ** (822) - usr_ISOPFNP_aer (656) ISOPFNP -> (No products) rate = ** User defined ** (823) - usr_ISOPHFP_aer (657) ISOPHFP -> (No products) rate = ** User defined ** (824) - usr_ISOPN1D_aer (658) ISOPN1D -> HNO3 rate = ** User defined ** (825) - usr_ISOPN2B_aer (659) ISOPN2B -> HNO3 rate = ** User defined ** (826) - usr_ISOPN4D_aer (660) ISOPN4D -> HNO3 rate = ** User defined ** (827) - usr_N2O5_aer (661) N2O5 -> 2*HNO3 rate = ** User defined ** (828) - usr_NC4CHO_aer (662) NC4CHO -> HNO3 rate = ** User defined ** (829) - usr_NH4_strat_ta (663) NH4 -> NHDEP rate = 6.34E-08 (830) - usr_NO2_aer (664) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (831) - usr_NO3_aer (665) NO3 -> HNO3 rate = ** User defined ** (832) - usr_ONITR_aer (666) ONITR -> HNO3 rate = ** User defined ** (833) - usr_SQTN_aer (667) SQTN -> (No products) rate = ** User defined ** (834) - usr_TERPDHDP_aer (668) TERPDHDP -> (No products) rate = ** User defined ** (835) - usr_TERPFDN_aer (669) TERPFDN -> HNO3 rate = ** User defined ** (836) - usr_TERPHFN_aer (670) TERPHFN -> (No products) rate = ** User defined ** (837) - usr_TERPNPT1_aer (671) TERPNPT1 -> HNO3 rate = ** User defined ** (838) - usr_TERPNPT_aer (672) TERPNPT -> HNO3 rate = ** User defined ** (839) - usr_TERPNT1_aer (673) TERPNT1 -> HNO3 rate = ** User defined ** (840) - usr_TERPNT_aer (674) TERPNT -> HNO3 rate = ** User defined ** (841) - APIN_NO3_vbs (675) APIN + NO3 -> APIN + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.20E-12*exp( 490./t) (842) - APINO2_HO2_vbs (676) APINO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 2.60E-13*exp( 1300./t) (843) + usr_SO3_H2O (642) SO3 + H2O -> H2SO4 rate = ** User defined ** (809) + NH3_OH (643) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (810) + usr_GLYOXAL_aer (644) GLYOXAL -> SOAG0 rate = ** User defined ** (811) + usr_HO2_aer (645) HO2 -> H2O rate = ** User defined ** (812) + usr_HONITR_aer (646) HONITR -> HNO3 rate = ** User defined ** (813) + usr_ICHE_aer (647) ICHE -> (No products) rate = ** User defined ** (814) + usr_IEPOX_aer (648) IEPOX -> (No products) rate = ** User defined ** (815) + usr_INHEB_aer (649) INHEB -> HNO3 rate = ** User defined ** (816) + usr_INHED_aer (650) INHED -> HNO3 rate = ** User defined ** (817) + usr_INOOHD_aer (651) ISOPNOOHD -> HNO3 rate = ** User defined ** (818) + usr_ISOPFDN_aer (652) ISOPFDN -> HNO3 rate = ** User defined ** (819) + usr_ISOPFDNC_aer (653) ISOPFDNC -> HNO3 rate = ** User defined ** (820) + usr_ISOPFNC_aer (654) ISOPFNC -> (No products) rate = ** User defined ** (821) + usr_ISOPFNP_aer (655) ISOPFNP -> (No products) rate = ** User defined ** (822) + usr_ISOPHFP_aer (656) ISOPHFP -> (No products) rate = ** User defined ** (823) + usr_ISOPN1D_aer (657) ISOPN1D -> HNO3 rate = ** User defined ** (824) + usr_ISOPN2B_aer (658) ISOPN2B -> HNO3 rate = ** User defined ** (825) + usr_ISOPN4D_aer (659) ISOPN4D -> HNO3 rate = ** User defined ** (826) + usr_N2O5_aer (660) N2O5 -> 2*HNO3 rate = ** User defined ** (827) + usr_NC4CHO_aer (661) NC4CHO -> HNO3 rate = ** User defined ** (828) + usr_NH4_strat_ta (662) NH4 -> NHDEP rate = 6.34E-08 (829) + usr_NO2_aer (663) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (830) + usr_NO3_aer (664) NO3 -> HNO3 rate = ** User defined ** (831) + usr_ONITR_aer (665) ONITR -> HNO3 rate = ** User defined ** (832) + usr_SQTN_aer (666) SQTN -> (No products) rate = ** User defined ** (833) + usr_TERPDHDP_aer (667) TERPDHDP -> (No products) rate = ** User defined ** (834) + usr_TERPFDN_aer (668) TERPFDN -> HNO3 rate = ** User defined ** (835) + usr_TERPHFN_aer (669) TERPHFN -> (No products) rate = ** User defined ** (836) + usr_TERPNPT1_aer (670) TERPNPT1 -> HNO3 rate = ** User defined ** (837) + usr_TERPNPT_aer (671) TERPNPT -> HNO3 rate = ** User defined ** (838) + usr_TERPNT1_aer (672) TERPNT1 -> HNO3 rate = ** User defined ** (839) + usr_TERPNT_aer (673) TERPNT -> HNO3 rate = ** User defined ** (840) + APIN_NO3_vbs (674) APIN + NO3 -> APIN + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.20E-12*exp( 490./t) (841) + APINO2_HO2_vbs (675) APINO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 2.60E-13*exp( 1300./t) (842) + 0.0554*SOAG3 + 0.1278*SOAG4 - APINO2_NO_vbs (677) APINO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (844) + APINO2_NO_vbs (676) APINO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (843) + 0.0332*SOAG3 + 0.13*SOAG4 - APIN_O3_vbs (678) APIN + O3 -> APIN + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 8.05E-16*exp( -640./t) (845) + APIN_O3_vbs (677) APIN + O3 -> APIN + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 8.05E-16*exp( -640./t) (844) + 0.0554*SOAG3 + 0.1278*SOAG4 - APIN_OH_vbs (679) APIN + OH -> APIN + OH + APINO2VBS rate = 1.34E-11*exp( 410./t) (846) - BCARY_NO3_vbs (680) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.90E-11 (847) - BCARYO2_HO2_vbs (681) BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 2.75E-13*exp( 1300./t) (848) + APIN_OH_vbs (678) APIN + OH -> APIN + OH + APINO2VBS rate = 1.34E-11*exp( 410./t) (845) + BCARY_NO3_vbs (679) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.90E-11 (846) + BCARYO2_HO2_vbs (680) BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 2.75E-13*exp( 1300./t) (847) + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 - BCARYO2_NO_vbs (682) BCARYO2VBS + NO -> NO + 0.1279*SOAG0 + 0.1792*SOAG1 + 0.0676*SOAG2 rate = 2.70E-12*exp( 360./t) (849) + BCARYO2_NO_vbs (681) BCARYO2VBS + NO -> NO + 0.1279*SOAG0 + 0.1792*SOAG1 + 0.0676*SOAG2 rate = 2.70E-12*exp( 360./t) (848) + 0.079*SOAG3 + 0.1254*SOAG4 - BCARY_O3_vbs (683) BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 1.20E-14 (850) + BCARY_O3_vbs (682) BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 1.20E-14 (849) + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 - BCARY_OH_vbs (684) BCARY + OH -> BCARY + OH + BCARYO2VBS rate = 2.00E-10 (851) - BENZENE_OH_vbs (685) BENZENE + OH -> BENZENE + OH + BENZO2VBS rate = 2.30E-12*exp( -193./t) (852) - BENZO2_HO2_vbs (686) BENZO2VBS + HO2 -> HO2 + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 rate = 7.50E-13*exp( 700./t) (853) + BCARY_OH_vbs (683) BCARY + OH -> BCARY + OH + BCARYO2VBS rate = 2.00E-10 (850) + BENZENE_OH_vbs (684) BENZENE + OH -> BENZENE + OH + BENZO2VBS rate = 2.30E-12*exp( -193./t) (851) + BENZO2_HO2_vbs (685) BENZO2VBS + HO2 -> HO2 + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 rate = 7.50E-13*exp( 700./t) (852) + 0.0443*SOAG3 + 0.1621*SOAG4 - BENZO2_NO_vbs (687) BENZO2VBS + NO -> NO + 0.0097*SOAG0 + 0.0034*SOAG1 + 0.1579*SOAG2 rate = 2.60E-12*exp( 365./t) (854) + BENZO2_NO_vbs (686) BENZO2VBS + NO -> NO + 0.0097*SOAG0 + 0.0034*SOAG1 + 0.1579*SOAG2 rate = 2.60E-12*exp( 365./t) (853) + 0.0059*SOAG3 + 0.0536*SOAG4 - BPIN_NO3_vbs (688) BPIN + NO3 -> BPIN + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 2.50E-12 (855) - BPINO2_HO2_vbs (689) BPINO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 2.60E-13*exp( 1300./t) (856) + BPIN_NO3_vbs (687) BPIN + NO3 -> BPIN + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 2.50E-12 (854) + BPINO2_HO2_vbs (688) BPINO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 2.60E-13*exp( 1300./t) (855) + 0.0554*SOAG3 + 0.1278*SOAG4 - BPINO2_NO_vbs (690) BPINO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (857) + BPINO2_NO_vbs (689) BPINO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (856) + 0.0332*SOAG3 + 0.13*SOAG4 - BPIN_O3_vbs (691) BPIN + O3 -> BPIN + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 1.35E-15*exp( -1270./t) (858) + BPIN_O3_vbs (690) BPIN + O3 -> BPIN + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 1.35E-15*exp( -1270./t) (857) + 0.0554*SOAG3 + 0.1278*SOAG4 - BPIN_OH_vbs (692) BPIN + OH -> BPIN + OH + BPINO2VBS rate = 1.62E-11*exp( 460./t) (859) - ISOP_NO3_vbs (693) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 rate = 2.95E-12*exp( -450./t) (860) - ISOPO2_HO2_vbs (694) ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 rate = 2.12E-13*exp( 1300./t) (861) + BPIN_OH_vbs (691) BPIN + OH -> BPIN + OH + BPINO2VBS rate = 1.62E-11*exp( 460./t) (858) + ISOP_NO3_vbs (692) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 rate = 2.95E-12*exp( -450./t) (859) + ISOPO2_HO2_vbs (693) ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 rate = 2.12E-13*exp( 1300./t) (860) + 0.0271*SOAG3 + 0.0474*SOAG4 - ISOPO2_NO_vbs (695) ISOPO2VBS + NO -> NO + 0.0003*SOAG0 + 0.0003*SOAG1 + 0.0073*SOAG2 rate = 2.70E-12*exp( 360./t) (862) + ISOPO2_NO_vbs (694) ISOPO2VBS + NO -> NO + 0.0003*SOAG0 + 0.0003*SOAG1 + 0.0073*SOAG2 rate = 2.70E-12*exp( 360./t) (861) + 0.0057*SOAG3 + 0.0623*SOAG4 - ISOP_O3_vbs (696) ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 rate = 1.03E-14*exp( -1995./t) (863) - ISOP_OH_vbs (697) ISOP + OH -> ISOP + OH + ISOPO2VBS rate = 2.70E-11*exp( 390./t) (864) - IVOCO2_HO2_vbs (698) IVOCO2VBS + HO2 -> HO2 + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 rate = 7.50E-13*exp( 700./t) (865) + ISOP_O3_vbs (695) ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 rate = 1.03E-14*exp( -1995./t) (862) + ISOP_OH_vbs (696) ISOP + OH -> ISOP + OH + ISOPO2VBS rate = 2.70E-11*exp( 390./t) (863) + IVOCO2_HO2_vbs (697) IVOCO2VBS + HO2 -> HO2 + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 rate = 7.50E-13*exp( 700./t) (864) + 0.0076*SOAG3 + 0.0113*SOAG4 - IVOCO2_NO_vbs (699) IVOCO2VBS + NO -> NO + 0.1056*SOAG0 + 0.1026*SOAG1 + 0.0521*SOAG2 rate = 2.60E-12*exp( 365./t) (866) + IVOCO2_NO_vbs (698) IVOCO2VBS + NO -> NO + 0.1056*SOAG0 + 0.1026*SOAG1 + 0.0521*SOAG2 rate = 2.60E-12*exp( 365./t) (865) + 0.0143*SOAG3 + 0.0166*SOAG4 - IVOC_OH_vbs (700) IVOC + OH -> OH + IVOCO2VBS rate = 1.34E-11 (867) - LIMON_NO3_vbs (701) LIMON + NO3 -> LIMON + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.20E-11 (868) - LIMONO2_HO2_vbs (702) LIMONO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 2.60E-13*exp( 1300./t) (869) + IVOC_OH_vbs (699) IVOC + OH -> OH + IVOCO2VBS rate = 1.34E-11 (866) + LIMON_NO3_vbs (700) LIMON + NO3 -> LIMON + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.20E-11 (867) + LIMONO2_HO2_vbs (701) LIMONO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 2.60E-13*exp( 1300./t) (868) + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 - LIMONO2_NO_vbs (703) LIMONO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (870) + LIMONO2_NO_vbs (702) LIMONO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (869) + 0.0332*SOAG3 + 0.13*SOAG4 - LIMON_O3_vbs (704) LIMON + O3 -> LIMON + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 2.80E-15*exp( -770./t) (871) + LIMON_O3_vbs (703) LIMON + O3 -> LIMON + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 2.80E-15*exp( -770./t) (870) + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 - LIMON_OH_vbs (705) LIMON + OH -> LIMON + OH + LIMONO2VBS rate = 3.41E-11*exp( 470./t) (872) - MYRC_NO3_vbs (706) MYRC + NO3 -> MYRC + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.10E-11 (873) - MYRCO2_HO2_vbs (707) MYRCO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 2.60E-13*exp( 1300./t) (874) + LIMON_OH_vbs (704) LIMON + OH -> LIMON + OH + LIMONO2VBS rate = 3.41E-11*exp( 470./t) (871) + MYRC_NO3_vbs (705) MYRC + NO3 -> MYRC + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.10E-11 (872) + MYRCO2_HO2_vbs (706) MYRCO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 2.60E-13*exp( 1300./t) (873) + 0.0554*SOAG3 + 0.1278*SOAG4 - MYRCO2_NO_vbs (708) MYRCO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (875) + MYRCO2_NO_vbs (707) MYRCO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (874) + 0.0332*SOAG3 + 0.13*SOAG4 - MYRC_O3_vbs (709) MYRC + O3 -> MYRC + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 2.65E-15*exp( -520./t) (876) + MYRC_O3_vbs (708) MYRC + O3 -> MYRC + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 2.65E-15*exp( -520./t) (875) + 0.0554*SOAG3 + 0.1278*SOAG4 - MYRC_OH_vbs (710) MYRC + OH -> MYRC + OH + MYRCO2VBS rate = 2.10E-10 (877) - SVOC_OH (711) SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 rate = 1.34E-11 (878) + MYRC_OH_vbs (709) MYRC + OH -> MYRC + OH + MYRCO2VBS rate = 2.10E-10 (876) + SVOC_OH (710) SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 rate = 1.34E-11 (877) + 0.0085*SOAG3 + 0.0128*SOAG4 - TOLUENE_OH_vbs (712) TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS rate = 1.70E-12*exp( 352./t) (879) - TOLUO2_HO2_vbs (713) TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 rate = 7.50E-13*exp( 700./t) (880) + TOLUENE_OH_vbs (711) TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS rate = 1.70E-12*exp( 352./t) (878) + TOLUO2_HO2_vbs (712) TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 rate = 7.50E-13*exp( 700./t) (879) + 0.2157*SOAG3 + 0.0738*SOAG4 - TOLUO2_NO_vbs (714) TOLUO2VBS + NO -> NO + 0.0154*SOAG0 + 0.0452*SOAG1 + 0.0966*SOAG2 rate = 2.60E-12*exp( 365./t) (881) + TOLUO2_NO_vbs (713) TOLUO2VBS + NO -> NO + 0.0154*SOAG0 + 0.0452*SOAG1 + 0.0966*SOAG2 rate = 2.60E-12*exp( 365./t) (880) + 0.0073*SOAG3 + 0.238*SOAG4 - XYLENES_OH_vbs (715) XYLENES + OH -> XYLENES + OH + XYLEO2VBS rate = 1.70E-11 (882) - XYLEO2_HO2_vbs (716) XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 rate = 7.50E-13*exp( 700./t) (883) + XYLENES_OH_vbs (714) XYLENES + OH -> XYLENES + OH + XYLEO2VBS rate = 1.70E-11 (881) + XYLEO2_HO2_vbs (715) XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 rate = 7.50E-13*exp( 700./t) (882) + 0.0512*SOAG3 + 0.1598*SOAG4 - XYLEO2_NO_vbs (717) XYLEO2VBS + NO -> NO + 0.0063*SOAG0 + 0.0237*SOAG1 + 0.0025*SOAG2 rate = 2.60E-12*exp( 365./t) (884) + XYLEO2_NO_vbs (716) XYLEO2VBS + NO -> NO + 0.0063*SOAG0 + 0.0237*SOAG1 + 0.0025*SOAG2 rate = 2.60E-12*exp( 365./t) (883) + 0.011*SOAG3 + 0.1185*SOAG4 - het1 (718) N2O5 -> 2*HNO3 rate = ** User defined ** (885) - het10 (719) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (886) - het11 (720) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (887) - het12 (721) N2O5 -> 2*HNO3 rate = ** User defined ** (888) - het13 (722) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (889) - het14 (723) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (890) - het15 (724) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (891) - het16 (725) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (892) - het17 (726) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (893) - het2 (727) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (894) - het3 (728) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (895) - het4 (729) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (896) - het5 (730) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (897) - het6 (731) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (898) - het7 (732) N2O5 -> 2*HNO3 rate = ** User defined ** (899) - het8 (733) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (900) - het9 (734) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (901) - E90_tau (735) E90 -> {sink} rate = 1.29E-07 (902) - NH_50_tau (736) NH_50 -> (No products) rate = 2.31E-07 (903) - NH_5_tau (737) NH_5 -> (No products) rate = 2.31E-06 (904) - ST80_25_tau (738) ST80_25 -> (No products) rate = 4.63E-07 (905) + het1 (717) N2O5 -> 2*HNO3 rate = ** User defined ** (884) + het10 (718) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (885) + het11 (719) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (886) + het12 (720) N2O5 -> 2*HNO3 rate = ** User defined ** (887) + het13 (721) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (888) + het14 (722) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (889) + het15 (723) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (890) + het16 (724) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (891) + het17 (725) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (892) + het2 (726) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (893) + het3 (727) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (894) + het4 (728) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (895) + het5 (729) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (896) + het6 (730) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (897) + het7 (731) N2O5 -> 2*HNO3 rate = ** User defined ** (898) + het8 (732) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (899) + het9 (733) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (900) + E90_tau (734) E90 -> {sink} rate = 1.29E-07 (901) + NH_50_tau (735) NH_50 -> (No products) rate = 2.31E-07 (902) + NH_5_tau (736) NH_5 -> (No products) rate = 2.31E-06 (903) + ST80_25_tau (737) ST80_25 -> (No products) rate = 4.63E-07 (904) Extraneous prod/loss species - ( 1) so4_a2 (dataset) - ( 2) NO (dataset) - ( 3) NO2 (dataset) - ( 4) SO2 (dataset) - ( 5) SVOC (dataset) - ( 6) pom_a1 (dataset) - ( 7) pom_a4 (dataset) - ( 8) so4_a1 (dataset) + ( 1) num_a4 (dataset) + ( 2) pom_a4 (dataset) + ( 3) bc_a4 (dataset) + ( 4) SVOC (dataset) + ( 5) SO2 (dataset) + ( 6) NO2 (dataset) + ( 7) so4_a1 (dataset) + ( 8) so4_a2 (dataset) ( 9) CO (dataset) - (10) bc_a1 (dataset) - (11) bc_a4 (dataset) - (12) num_a1 (dataset) - (13) num_a2 (dataset) - (14) num_a4 (dataset) - (15) OH - (16) N - (17) AOA_NH + (10) num_a1 (dataset) + (11) num_a2 (dataset) + (12) NO + (13) N + (14) OH Equation Report - d(ALKNIT)/dt = r245*ALKO2*NO - - j19*ALKNIT - r242*OH*ALKNIT - d(ALKOOH)/dt = r243*ALKO2*HO2 - - j20*ALKOOH - r246*OH*ALKOOH + d(ALKNIT)/dt = r244*ALKO2*NO + - j19*ALKNIT - r241*OH*ALKNIT + d(ALKOOH)/dt = r242*ALKO2*HO2 + - j20*ALKOOH - r245*OH*ALKOOH d(AOA_NH)/dt = 0 - d(APIN)/dt = - r418*NO3*APIN - r436*O3*APIN - r437*OH*APIN + d(APIN)/dt = - r417*NO3*APIN - r435*O3*APIN - r436*OH*APIN d(bc_a1)/dt = 0 d(bc_a4)/dt = 0 - d(BCARY)/dt = - r438*NO3*BCARY - r456*O3*BCARY - r457*OH*BCARY - d(BENZENE)/dt = - r377*OH*BENZENE - d(BENZOOH)/dt = r378*BENZO2*HO2 - - j21*BENZOOH - r380*OH*BENZOOH - d(BEPOMUC)/dt = .12*r377*BENZENE*OH + d(BCARY)/dt = - r437*NO3*BCARY - r455*O3*BCARY - r456*OH*BCARY + d(BENZENE)/dt = - r376*OH*BENZENE + d(BENZOOH)/dt = r377*BENZO2*HO2 + - j21*BENZOOH - r379*OH*BENZOOH + d(BEPOMUC)/dt = .12*r376*BENZENE*OH - j22*BEPOMUC - d(BIGALD1)/dt = .5*j21*BENZOOH + j22*BEPOMUC + .2*j115*TOLOOH + .06*j116*XYLENOOH + .5*r379*BENZO2*NO - + .2*r406*TOLO2*NO + .06*r412*XYLENO2*NO + d(BIGALD1)/dt = .5*j21*BENZOOH + j22*BEPOMUC + .2*j115*TOLOOH + .06*j116*XYLENOOH + .5*r378*BENZO2*NO + + .2*r405*TOLO2*NO + .06*r411*XYLENO2*NO - j23*BIGALD1 - d(BIGALD2)/dt = .2*j115*TOLOOH + .2*j116*XYLENOOH + .2*r406*TOLO2*NO + .2*r412*XYLENO2*NO + d(BIGALD2)/dt = .2*j115*TOLOOH + .2*j116*XYLENOOH + .2*r405*TOLO2*NO + .2*r411*XYLENO2*NO - j24*BIGALD2 - d(BIGALD3)/dt = .2*j115*TOLOOH + .15*j116*XYLENOOH + .2*r406*TOLO2*NO + .15*r412*XYLENO2*NO + d(BIGALD3)/dt = .2*j115*TOLOOH + .15*j116*XYLENOOH + .2*r405*TOLO2*NO + .15*r411*XYLENO2*NO - j25*BIGALD3 - d(BIGALD4)/dt = .21*j116*XYLENOOH + .21*r412*XYLENO2*NO + d(BIGALD4)/dt = .21*j116*XYLENOOH + .21*r411*XYLENO2*NO - j26*BIGALD4 - d(BIGALK)/dt = .19*r476*BPIN*O3 - - r247*OH*BIGALK - d(BIGENE)/dt = - r208*NO3*BIGENE - r209*OH*BIGENE - d(BPIN)/dt = - r458*NO3*BPIN - r476*O3*BPIN - r477*OH*BPIN + d(BIGALK)/dt = .19*r475*BPIN*O3 + - r246*OH*BIGALK + d(BIGENE)/dt = - r207*NO3*BIGENE - r208*OH*BIGENE + d(BPIN)/dt = - r457*NO3*BPIN - r475*O3*BPIN - r476*OH*BPIN d(BR)/dt = j118*BRCL + j119*BRO + j121*BRONO2 + j123*CF2CLBR + j124*CF3BR + 2*j130*CH2BR2 + j131*CH3BR + 3*j134*CHBR3 + 2*j142*H2402 + j143*HBR + j149*HOBR + r77*O1D*CF2CLBR + 2*r90*BRO*BRO + r91*BRO*CLO + r92*BRO*CLO + r95*BRO*NO + r98*BRO*O + r99*BRO*OH + r100*HBR*O + r101*HBR*OH @@ -1945,32 +1941,32 @@ Extraneous prod/loss species + 2*r115*CH2BR2*OH + r116*CH3BR*CL + r117*CH3BR*OH + 3*r121*CHBR3*CL + 3*r122*CHBR3*OH + 2*r126*O1D*CH2BR2 + r127*O1D*CH3BR + r633*SO*BRO - r87*CH2O*BR - r88*HO2*BR - r89*O3*BR - d(BRCL)/dt = r93*BRO*CLO + r726*HOBR*HCL + r731*HOBR*HCL + d(BRCL)/dt = r93*BRO*CLO + r725*HOBR*HCL + r730*HOBR*HCL - j118*BRCL d(BRO)/dt = j120*BRONO2 + r89*BR*O3 + r97*BRONO2*O + r102*HOBR*O + r107*O1D*HBR - j119*BRO - 2*r90*BRO*BRO - r91*CLO*BRO - r92*CLO*BRO - r93*CLO*BRO - r94*HO2*BRO - r95*NO*BRO - r96*M*NO2*BRO - r98*O*BRO - r99*OH*BRO - r633*SO*BRO d(BRONO2)/dt = r96*M*BRO*NO2 - - j120*BRONO2 - j121*BRONO2 - r720*BRONO2 - r723*BRONO2 - r728*BRONO2 - r97*O*BRONO2 + - j120*BRONO2 - j121*BRONO2 - r719*BRONO2 - r722*BRONO2 - r727*BRONO2 - r97*O*BRONO2 d(BRY)/dt = 0 - d(BZALD)/dt = j27*BZOOH + r384*BZOO*NO - - r381*OH*BZALD - d(BZOOH)/dt = r382*BZOO*HO2 - - j27*BZOOH - r383*OH*BZOOH - d(C2H2)/dt = - r154*M*CL*C2H2 - r155*M*OH*C2H2 - d(C2H4)/dt = - r156*M*CL*C2H4 - r157*O3*C2H4 - r184*M*OH*C2H4 - d(C2H5OH)/dt = .4*r158*C2H5O2*C2H5O2 + .2*r159*C2H5O2*CH3O2 - - r162*OH*C2H5OH - d(C2H5OOH)/dt = r160*C2H5O2*HO2 - - j28*C2H5OOH - r163*OH*C2H5OOH - d(C2H6)/dt = - r164*CL*C2H6 - r165*OH*C2H6 + d(BZALD)/dt = j27*BZOOH + r383*BZOO*NO + - r380*OH*BZALD + d(BZOOH)/dt = r381*BZOO*HO2 + - j27*BZOOH - r382*OH*BZOOH + d(C2H2)/dt = - r153*M*CL*C2H2 - r154*M*OH*C2H2 + d(C2H4)/dt = - r155*M*CL*C2H4 - r156*O3*C2H4 - r183*M*OH*C2H4 + d(C2H5OH)/dt = .4*r157*C2H5O2*C2H5O2 + .2*r158*C2H5O2*CH3O2 + - r161*OH*C2H5OH + d(C2H5OOH)/dt = r159*C2H5O2*HO2 + - j28*C2H5OOH - r162*OH*C2H5OOH + d(C2H6)/dt = - r163*CL*C2H6 - r164*OH*C2H6 d(C3H6)/dt = .7*j79*MVK - - r187*NO3*C3H6 - r188*O3*C3H6 - r206*M*OH*C3H6 - d(C3H7OOH)/dt = r190*C3H7O2*HO2 - - j29*C3H7OOH - r192*OH*C3H7OOH - d(C3H8)/dt = - r193*OH*C3H8 - d(C6H5OOH)/dt = r385*C6H5O2*HO2 - - j30*C6H5OOH - r387*OH*C6H5OOH + - r186*NO3*C3H6 - r187*O3*C3H6 - r205*M*OH*C3H6 + d(C3H7OOH)/dt = r189*C3H7O2*HO2 + - j29*C3H7OOH - r191*OH*C3H7OOH + d(C3H8)/dt = - r192*OH*C3H8 + d(C6H5OOH)/dt = r384*C6H5O2*HO2 + - j30*C6H5OOH - r386*OH*C6H5OOH d(CCL4)/dt = - j122*CCL4 - r76*O1D*CCL4 d(CF2CLBR)/dt = - j123*CF2CLBR - r77*O1D*CF2CLBR d(CF3BR)/dt = - j124*CF3BR - r103*O1D*CF3BR @@ -1984,109 +1980,109 @@ Extraneous prod/loss species + j45*HCOCH2OOH + j46*HMHP + .33*j47*HONITR + j52*HYAC + j55*HYPERACET + j56*HYPERACET + j65*ISOPN2B + j66*ISOPN3B + j68*ISOPNBNO3 + j69*ISOPNOOHB + j71*ISOPOOH + j72*MACR + .25*j74*MACRN + .14*j75*MACROOH + .25*j80*MVKN + .44*j81*MVKOOH + j83*NO3CH2CHO + j84*NOA - + j88*POOH + j89*ROOH + r147*HOCH2OO + 2*r177*EO + r261*ISOPB1O2 + r267*ISOPB4O2 + + j88*POOH + j89*ROOH + r146*HOCH2OO + 2*r176*EO + r260*ISOPB1O2 + r266*ISOPB4O2 + r58*CLO*CH3O2 + 2*r135*CH3O2*CH3O2 + r136*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH - + .3*r140*CH3OOH*OH + .5*r145*HMHP*OH + r150*O1D*CH4 + r151*O1D*CH4 + r157*C2H4*O3 - + .7*r159*C2H5O2*CH3O2 + r170*CH3CO3*CH3O2 + .5*r174*CH3COOOH*OH + .5*r176*EO2*NO - + .8*r179*GLYALD*OH + .11*r181*HCOCH2OOH*OH + r182*NO3CH2CHO*OH + r183*PAN*OH + .5*r188*C3H6*O3 - + r189*C3H7O2*CH3O2 + .3*r197*HYPERACET*OH + r200*PO2*NO + .8*r202*RO2*CH3O2 + .15*r203*RO2*HO2 - + r204*RO2*NO + .5*r208*BIGENE*NO3 + .5*r211*ENEO2*NO + .14*r215*MACRO2*CH3CO3 - + 1.1*r216*MACRO2*CH3O2 + .08*r217*MACRO2*HO2 + .12*r219*MACR*O3 + r222*MCO3*CH3CO3 - + 2*r223*MCO3*CH3O2 + .49*r224*MCO3*HO2 + 2*r225*MCO3*MCO3 + r226*MCO3*NO + r227*MCO3*NO3 - + .25*r234*MVKO2*CH3CO3 + .87*r235*MVKO2*CH3O2 + .05*r236*MVKO2*HO2 + .6*r237*MVK*O3 - + .4*r242*ALKNIT*OH + .1*r244*ALKO2*NO + .5*r253*ICHE*OH + .4*r256*INHEB*OH + .59*r257*INHED*OH - + r258*ISOPB1O2*CH3CO3 + 1.75*r259*ISOPB1O2*CH3O2 + .06*r260*ISOPB1O2*HO2 + r264*ISOPB4O2*CH3CO3 - + 1.25*r265*ISOPB4O2*CH3O2 + .06*r266*ISOPB4O2*HO2 + .75*r279*ISOPED1O2*CH3O2 - + .75*r283*ISOPED4O2*CH3O2 + .03*r291*ISOPN1DO2*HO2 + .06*r295*ISOPN2BO2*HO2 - + .6*r298*ISOPN3BO2*HO2 + .06*r301*ISOPN4DO2*HO2 + .1*r305*ISOPNBNO3O2*HO2 - + .46*r308*ISOPNO3*CH3CO3 + .71*r309*ISOPNO3*CH3O2 + .24*r310*ISOPNO3*HO2 - + .16*r311*ISOPNO3*ISOPNO3 + .46*r312*ISOPNO3*NO3 + .17*r313*ISOPNOOHBO2*HO2 - + .03*r316*ISOPNOOHDO2*HO2 + 1.01*r320*ISOP*O3 + .75*r326*ISOPZD1O2*CH3O2 - + .75*r330*ISOPZD4O2*CH3O2 + r339*ISOPB1O2*NO + r341*ISOPB4O2*NO + .06*r347*ISOPN1DO2*NO - + .27*r349*ISOPN2BO2*NO + r351*ISOPN3BO2*NO + .13*r353*ISOPN4DO2*NO + .33*r355*ISOPNBNO3O2*NO - + .46*r357*ISOPNO3*NO + .53*r359*ISOPNOOHBO2*NO + .04*r361*ISOPNOOHDO2*NO + .14*r369*MACRO2*NO - + .24*r371*MVKO2*NO + .95*r421*APINNO3*CH3O2 + .27*r428*APINO2*CH3CO3 + .83*r429*APINO2*CH3O2 - + .08*r430*APINO2*HO2 + .21*r431*APINO2*NO + .27*r432*APINO2*NO3 + .27*r433*APINO2*TERPA2CO3 - + .27*r434*APINO2*TERPA3CO3 + .27*r435*APINO2*TERPACO3 + .27*r436*APIN*O3 - + .95*r441*BCARYNO3*CH3O2 + .75*r449*BCARYO2*CH3O2 + .08*r456*BCARY*O3 + .04*r459*BPINNO3*BPINNO3 - + .02*r460*BPINNO3*CH3CO3 + .99*r461*BPINNO3*CH3O2 + .02*r462*BPINNO3*HO2 + .02*r463*BPINNO3*NO - + .02*r464*BPINNO3*NO3 + .02*r465*BPINNO3*TERPA2CO3 + .02*r466*BPINNO3*TERPA3CO3 - + .02*r467*BPINNO3*TERPACO3 + .65*r468*BPINO2*CH3CO3 + 1.4*r469*BPINO2*CH3O2 - + .03*r470*BPINO2*HO2 + .49*r471*BPINO2*NO + .65*r472*BPINO2*NO3 + .65*r473*BPINO2*TERPA2CO3 - + .65*r474*BPINO2*TERPA3CO3 + .65*r475*BPINO2*TERPACO3 + .81*r476*BPIN*O3 - + .91*r480*LIMONNO3*CH3O2 + .56*r488*LIMONO2*CH3CO3 + 1.03*r489*LIMONO2*CH3O2 - + .06*r490*LIMONO2*HO2 + .43*r491*LIMONO2*NO + .56*r492*LIMONO2*NO3 + .56*r493*LIMONO2*TERPA2CO3 - + .56*r494*LIMONO2*TERPA3CO3 + .56*r495*LIMONO2*TERPACO3 + .33*r496*LIMON*O3 - + .04*r499*MYRCNO3*CH3CO3 + .98*r500*MYRCNO3*CH3O2 + .02*r501*MYRCNO3*HO2 - + .06*r502*MYRCNO3*MYRCNO3 + .04*r503*MYRCNO3*NO + .04*r504*MYRCNO3*NO3 - + .04*r505*MYRCNO3*TERPA2CO3 + .04*r506*MYRCNO3*TERPA3CO3 + .04*r507*MYRCNO3*TERPACO3 - + .42*r508*MYRCO2*CH3CO3 + .75*r509*MYRCO2*CH3O2 + .04*r510*MYRCO2*HO2 + .3*r511*MYRCO2*NO - + .42*r512*MYRCO2*NO3 + .42*r513*MYRCO2*TERPA2CO3 + .42*r514*MYRCO2*TERPA3CO3 - + .42*r515*MYRCO2*TERPACO3 + .39*r516*MYRC*O3 + .08*r521*TERP1OOHO2*HO2 + .31*r522*TERP1OOHO2*NO - + .75*r528*TERPA1O2*CH3O2 + r536*TERPA2CO3*CH3O2 + r544*TERPA2O2*CH3O2 + 2*r552*TERPA2PAN*OH - + r554*TERPA3CO3*CH3O2 + r563*TERPA3O2*CH3O2 + r571*TERPA3PAN*OH + 2*r572*TERPA4O2*CH3CO3 - + 3*r573*TERPA4O2*CH3O2 + 1.0599999*r574*TERPA4O2*HO2 + 1.8200001*r575*TERPA4O2*NO - + 2*r576*TERPA4O2*NO3 + 2*r577*TERPA4O2*TERPA2CO3 + 2*r578*TERPA4O2*TERPA3CO3 - + 2*r579*TERPA4O2*TERPACO3 + r584*TERPACO3*CH3O2 + .44*r593*TERPF1*NO3 + .04*r594*TERPF1O2*HO2 - + .31*r595*TERPF1O2*NO + .62*r596*TERPF1*O3 + .5*r598*TERPF2*NO3 + .34*r601*TERPF2*O3 + + .3*r140*CH3OOH*OH + .5*r144*HMHP*OH + r149*O1D*CH4 + r150*O1D*CH4 + r156*C2H4*O3 + + .7*r158*C2H5O2*CH3O2 + r169*CH3CO3*CH3O2 + .5*r173*CH3COOOH*OH + .5*r175*EO2*NO + + .8*r178*GLYALD*OH + .11*r180*HCOCH2OOH*OH + r181*NO3CH2CHO*OH + r182*PAN*OH + .5*r187*C3H6*O3 + + r188*C3H7O2*CH3O2 + .3*r196*HYPERACET*OH + r199*PO2*NO + .8*r201*RO2*CH3O2 + .15*r202*RO2*HO2 + + r203*RO2*NO + .5*r207*BIGENE*NO3 + .5*r210*ENEO2*NO + .14*r214*MACRO2*CH3CO3 + + 1.1*r215*MACRO2*CH3O2 + .08*r216*MACRO2*HO2 + .12*r218*MACR*O3 + r221*MCO3*CH3CO3 + + 2*r222*MCO3*CH3O2 + .49*r223*MCO3*HO2 + 2*r224*MCO3*MCO3 + r225*MCO3*NO + r226*MCO3*NO3 + + .25*r233*MVKO2*CH3CO3 + .87*r234*MVKO2*CH3O2 + .05*r235*MVKO2*HO2 + .6*r236*MVK*O3 + + .4*r241*ALKNIT*OH + .1*r243*ALKO2*NO + .5*r252*ICHE*OH + .4*r255*INHEB*OH + .59*r256*INHED*OH + + r257*ISOPB1O2*CH3CO3 + 1.75*r258*ISOPB1O2*CH3O2 + .06*r259*ISOPB1O2*HO2 + r263*ISOPB4O2*CH3CO3 + + 1.25*r264*ISOPB4O2*CH3O2 + .06*r265*ISOPB4O2*HO2 + .75*r278*ISOPED1O2*CH3O2 + + .75*r282*ISOPED4O2*CH3O2 + .03*r290*ISOPN1DO2*HO2 + .06*r294*ISOPN2BO2*HO2 + + .6*r297*ISOPN3BO2*HO2 + .06*r300*ISOPN4DO2*HO2 + .1*r304*ISOPNBNO3O2*HO2 + + .46*r307*ISOPNO3*CH3CO3 + .71*r308*ISOPNO3*CH3O2 + .24*r309*ISOPNO3*HO2 + + .16*r310*ISOPNO3*ISOPNO3 + .46*r311*ISOPNO3*NO3 + .17*r312*ISOPNOOHBO2*HO2 + + .03*r315*ISOPNOOHDO2*HO2 + 1.01*r319*ISOP*O3 + .75*r325*ISOPZD1O2*CH3O2 + + .75*r329*ISOPZD4O2*CH3O2 + r338*ISOPB1O2*NO + r340*ISOPB4O2*NO + .06*r346*ISOPN1DO2*NO + + .27*r348*ISOPN2BO2*NO + r350*ISOPN3BO2*NO + .13*r352*ISOPN4DO2*NO + .33*r354*ISOPNBNO3O2*NO + + .46*r356*ISOPNO3*NO + .53*r358*ISOPNOOHBO2*NO + .04*r360*ISOPNOOHDO2*NO + .14*r368*MACRO2*NO + + .24*r370*MVKO2*NO + .95*r420*APINNO3*CH3O2 + .27*r427*APINO2*CH3CO3 + .83*r428*APINO2*CH3O2 + + .08*r429*APINO2*HO2 + .21*r430*APINO2*NO + .27*r431*APINO2*NO3 + .27*r432*APINO2*TERPA2CO3 + + .27*r433*APINO2*TERPA3CO3 + .27*r434*APINO2*TERPACO3 + .27*r435*APIN*O3 + + .95*r440*BCARYNO3*CH3O2 + .75*r448*BCARYO2*CH3O2 + .08*r455*BCARY*O3 + .04*r458*BPINNO3*BPINNO3 + + .02*r459*BPINNO3*CH3CO3 + .99*r460*BPINNO3*CH3O2 + .02*r461*BPINNO3*HO2 + .02*r462*BPINNO3*NO + + .02*r463*BPINNO3*NO3 + .02*r464*BPINNO3*TERPA2CO3 + .02*r465*BPINNO3*TERPA3CO3 + + .02*r466*BPINNO3*TERPACO3 + .65*r467*BPINO2*CH3CO3 + 1.4*r468*BPINO2*CH3O2 + + .03*r469*BPINO2*HO2 + .49*r470*BPINO2*NO + .65*r471*BPINO2*NO3 + .65*r472*BPINO2*TERPA2CO3 + + .65*r473*BPINO2*TERPA3CO3 + .65*r474*BPINO2*TERPACO3 + .81*r475*BPIN*O3 + + .91*r479*LIMONNO3*CH3O2 + .56*r487*LIMONO2*CH3CO3 + 1.03*r488*LIMONO2*CH3O2 + + .06*r489*LIMONO2*HO2 + .43*r490*LIMONO2*NO + .56*r491*LIMONO2*NO3 + .56*r492*LIMONO2*TERPA2CO3 + + .56*r493*LIMONO2*TERPA3CO3 + .56*r494*LIMONO2*TERPACO3 + .33*r495*LIMON*O3 + + .04*r498*MYRCNO3*CH3CO3 + .98*r499*MYRCNO3*CH3O2 + .02*r500*MYRCNO3*HO2 + + .06*r501*MYRCNO3*MYRCNO3 + .04*r502*MYRCNO3*NO + .04*r503*MYRCNO3*NO3 + + .04*r504*MYRCNO3*TERPA2CO3 + .04*r505*MYRCNO3*TERPA3CO3 + .04*r506*MYRCNO3*TERPACO3 + + .42*r507*MYRCO2*CH3CO3 + .75*r508*MYRCO2*CH3O2 + .04*r509*MYRCO2*HO2 + .3*r510*MYRCO2*NO + + .42*r511*MYRCO2*NO3 + .42*r512*MYRCO2*TERPA2CO3 + .42*r513*MYRCO2*TERPA3CO3 + + .42*r514*MYRCO2*TERPACO3 + .39*r515*MYRC*O3 + .08*r520*TERP1OOHO2*HO2 + .31*r521*TERP1OOHO2*NO + + .75*r527*TERPA1O2*CH3O2 + r535*TERPA2CO3*CH3O2 + r543*TERPA2O2*CH3O2 + 2*r551*TERPA2PAN*OH + + r553*TERPA3CO3*CH3O2 + r562*TERPA3O2*CH3O2 + r570*TERPA3PAN*OH + 2*r571*TERPA4O2*CH3CO3 + + 3*r572*TERPA4O2*CH3O2 + 1.0599999*r573*TERPA4O2*HO2 + 1.8200001*r574*TERPA4O2*NO + + 2*r575*TERPA4O2*NO3 + 2*r576*TERPA4O2*TERPA2CO3 + 2*r577*TERPA4O2*TERPA3CO3 + + 2*r578*TERPA4O2*TERPACO3 + r583*TERPACO3*CH3O2 + .44*r592*TERPF1*NO3 + .04*r593*TERPF1O2*HO2 + + .31*r594*TERPF1O2*NO + .62*r595*TERPF1*O3 + .5*r597*TERPF2*NO3 + .34*r600*TERPF2*O3 - j31*CH2O - j32*CH2O - r51*CL*CH2O - r87*BR*CH2O - r131*HO2*CH2O - r132*NO3*CH2O - r133*O*CH2O - r134*OH*CH2O d(CH3BR)/dt = - j131*CH3BR - r116*CL*CH3BR - r117*OH*CH3BR - r127*O1D*CH3BR d(CH3CCL3)/dt = - j132*CH3CCL3 - r118*OH*CH3CCL3 d(CH3CHO)/dt = .4*j19*ALKNIT + .4*j20*ALKOOH + j28*C2H5OOH + .33*j47*HONITR + j77*MEKOOH + j88*POOH - + 1.6*r158*C2H5O2*C2H5O2 + .8*r159*C2H5O2*CH3O2 + r161*C2H5O2*NO + r162*C2H5OH*OH - + .5*r163*C2H5OOH*OH + .5*r188*C3H6*O3 + .27*r191*C3H7O2*NO + r200*PO2*NO + r208*BIGENE*NO3 - + r211*ENEO2*NO + .2*r228*MEKO2*HO2 + r229*MEKO2*NO + .1*r237*MVK*O3 + .8*r242*ALKNIT*OH - + .4*r244*ALKO2*NO - - j33*CH3CHO - r166*NO3*CH3CHO - r167*OH*CH3CHO + + 1.6*r157*C2H5O2*C2H5O2 + .8*r158*C2H5O2*CH3O2 + r160*C2H5O2*NO + r161*C2H5OH*OH + + .5*r162*C2H5OOH*OH + .5*r187*C3H6*O3 + .27*r190*C3H7O2*NO + r199*PO2*NO + r207*BIGENE*NO3 + + r210*ENEO2*NO + .2*r227*MEKO2*HO2 + r228*MEKO2*NO + .1*r236*MVK*O3 + .8*r241*ALKNIT*OH + + .4*r243*ALKO2*NO + - j33*CH3CHO - r165*NO3*CH3CHO - r166*OH*CH3CHO d(CH3CL)/dt = - j133*CH3CL - r119*CL*CH3CL - r120*OH*CH3CL - d(CH3CN)/dt = - r168*OH*CH3CN - d(CH3COCH3)/dt = .25*j19*ALKNIT + .25*j20*ALKOOH + .82*j29*C3H7OOH + .17*j47*HONITR + .82*r189*C3H7O2*CH3O2 - + .82*r191*C3H7O2*NO + .5*r208*BIGENE*NO3 + .5*r211*ENEO2*NO + .1*r216*MACRO2*CH3O2 - + .8*r242*ALKNIT*OH + .25*r244*ALKO2*NO + .12*r428*APINO2*CH3CO3 + .06*r429*APINO2*CH3O2 - + .06*r430*APINO2*HO2 + .09*r431*APINO2*NO + .12*r432*APINO2*NO3 + .12*r433*APINO2*TERPA2CO3 - + .12*r434*APINO2*TERPA3CO3 + .12*r435*APINO2*TERPACO3 + .11*r468*BPINO2*CH3CO3 - + .08*r469*BPINO2*CH3O2 + .08*r471*BPINO2*NO + .11*r472*BPINO2*NO3 - + .11*r473*BPINO2*TERPA2CO3 + .11*r474*BPINO2*TERPA3CO3 + .11*r475*BPINO2*TERPACO3 - + .91*r499*MYRCNO3*CH3CO3 + .74*r500*MYRCNO3*CH3O2 + .46*r501*MYRCNO3*HO2 - + 1.48*r502*MYRCNO3*MYRCNO3 + .85*r503*MYRCNO3*NO + .91*r504*MYRCNO3*NO3 - + .91*r505*MYRCNO3*TERPA2CO3 + .91*r506*MYRCNO3*TERPA3CO3 + .91*r507*MYRCNO3*TERPACO3 - + .46*r508*MYRCO2*CH3CO3 + .05*r510*MYRCO2*HO2 + .33*r511*MYRCO2*NO + .46*r512*MYRCO2*NO3 - + .46*r513*MYRCO2*TERPA2CO3 + .46*r514*MYRCO2*TERPA3CO3 + .46*r515*MYRCO2*TERPACO3 - + .25*r516*MYRC*O3 + r552*TERPA2PAN*OH + r562*TERPA3O2*CH3CO3 + r563*TERPA3O2*CH3O2 - + .15*r564*TERPA3O2*HO2 + .7*r565*TERPA3O2*NO + r566*TERPA3O2*NO3 + r567*TERPA3O2*TERPA2CO3 - + r568*TERPA3O2*TERPA3CO3 + r569*TERPA3O2*TERPACO3 - - j34*CH3COCH3 - r207*OH*CH3COCH3 + d(CH3CN)/dt = - r167*OH*CH3CN + d(CH3COCH3)/dt = .25*j19*ALKNIT + .25*j20*ALKOOH + .82*j29*C3H7OOH + .17*j47*HONITR + .82*r188*C3H7O2*CH3O2 + + .82*r190*C3H7O2*NO + .5*r207*BIGENE*NO3 + .5*r210*ENEO2*NO + .1*r215*MACRO2*CH3O2 + + .8*r241*ALKNIT*OH + .25*r243*ALKO2*NO + .12*r427*APINO2*CH3CO3 + .06*r428*APINO2*CH3O2 + + .06*r429*APINO2*HO2 + .09*r430*APINO2*NO + .12*r431*APINO2*NO3 + .12*r432*APINO2*TERPA2CO3 + + .12*r433*APINO2*TERPA3CO3 + .12*r434*APINO2*TERPACO3 + .11*r467*BPINO2*CH3CO3 + + .08*r468*BPINO2*CH3O2 + .08*r470*BPINO2*NO + .11*r471*BPINO2*NO3 + + .11*r472*BPINO2*TERPA2CO3 + .11*r473*BPINO2*TERPA3CO3 + .11*r474*BPINO2*TERPACO3 + + .91*r498*MYRCNO3*CH3CO3 + .74*r499*MYRCNO3*CH3O2 + .46*r500*MYRCNO3*HO2 + + 1.48*r501*MYRCNO3*MYRCNO3 + .85*r502*MYRCNO3*NO + .91*r503*MYRCNO3*NO3 + + .91*r504*MYRCNO3*TERPA2CO3 + .91*r505*MYRCNO3*TERPA3CO3 + .91*r506*MYRCNO3*TERPACO3 + + .46*r507*MYRCO2*CH3CO3 + .05*r509*MYRCO2*HO2 + .33*r510*MYRCO2*NO + .46*r511*MYRCO2*NO3 + + .46*r512*MYRCO2*TERPA2CO3 + .46*r513*MYRCO2*TERPA3CO3 + .46*r514*MYRCO2*TERPACO3 + + .25*r515*MYRC*O3 + r551*TERPA2PAN*OH + r561*TERPA3O2*CH3CO3 + r562*TERPA3O2*CH3O2 + + .15*r563*TERPA3O2*HO2 + .7*r564*TERPA3O2*NO + r565*TERPA3O2*NO3 + r566*TERPA3O2*TERPA2CO3 + + r567*TERPA3O2*TERPA3CO3 + r568*TERPA3O2*TERPACO3 + - j34*CH3COCH3 - r206*OH*CH3COCH3 d(CH3COCHO)/dt = j26*BIGALD4 + .5*j41*DHPMPAL + .68*j48*HPALD1 + .67*j49*HPALD4 + j54*HYDRALD + .5*j60*ISOPFDNC + .5*j61*ISOPFNC + .72*j63*ISOPHFP + .25*j74*MACRN + .14*j75*MACROOH + .25*j80*MVKN + .44*j81*MVKOOH + .4*j115*TOLOOH + .54*j116*XYLENOOH + .51*j117*XYLOLOOH - + r196*HYAC*OH + .7*r197*HYPERACET*OH + r198*NOA*OH + .5*r202*RO2*CH3O2 - + .14*r215*MACRO2*CH3CO3 + .08*r217*MACRO2*HO2 + .88*r219*MACR*O3 + .25*r234*MVKO2*CH3CO3 - + .12*r235*MVKO2*CH3O2 + .05*r236*MVKO2*HO2 + .5*r237*MVK*O3 + .44*r239*MVKOOH*OH - + .38*r248*HPALD1*OH + .03*r249*HPALD4*OH + .46*r252*HYDRALD*OH + .5*r253*ICHE*OH - + .46*r255*IEPOXOO*HO2 + .4*r256*INHEB*OH + .72*r290*ISOPHFP*OH + .17*r293*ISOPN1D*O3 - + .17*r303*ISOPN4D*O3 + .17*r318*ISOPNOOHD*O3 + .1*r333*NC4CHOO2*HO2 + .34*r335*NC4CHO*O3 - + .71*r337*IEPOXOO*NO + .14*r369*MACRO2*NO + .24*r371*MVKO2*NO + .12*r373*NC4CHOO2*NO - + .07*r389*DICARBO2*HO2 + .17*r390*DICARBO2*NO + .07*r395*MDIALO2*HO2 + .17*r396*MDIALO2*NO - + .4*r406*TOLO2*NO + .54*r412*XYLENO2*NO + .51*r415*XYLOLO2*NO - - j35*CH3COCHO - r194*NO3*CH3COCHO - r195*OH*CH3COCHO - d(CH3COOH)/dt = .1*r170*CH3CO3*CH3O2 + .15*r171*CH3CO3*HO2 + .12*r188*C3H6*O3 + .15*r224*MCO3*HO2 - - r173*OH*CH3COOH - d(CH3COOOH)/dt = .36*r171*CH3CO3*HO2 + .36*r224*MCO3*HO2 - - j36*CH3COOOH - r174*OH*CH3COOOH - d(CH3OH)/dt = r136*CH3O2*CH3O2 + .3*r159*C2H5O2*CH3O2 + .5*r202*RO2*CH3O2 + .25*r235*MVKO2*CH3O2 - + .25*r265*ISOPB4O2*CH3O2 + .25*r279*ISOPED1O2*CH3O2 + .25*r283*ISOPED4O2*CH3O2 - + .36*r309*ISOPNO3*CH3O2 + .25*r326*ISOPZD1O2*CH3O2 + .25*r330*ISOPZD4O2*CH3O2 - + .05*r421*APINNO3*CH3O2 + .17*r429*APINO2*CH3O2 + .05*r441*BCARYNO3*CH3O2 - + .25*r449*BCARYO2*CH3O2 + .03*r461*BPINNO3*CH3O2 + .09*r480*LIMONNO3*CH3O2 - + .25*r489*LIMONO2*CH3O2 + .05*r500*MYRCNO3*CH3O2 + .25*r509*MYRCO2*CH3O2 - + .25*r528*TERPA1O2*CH3O2 + + r195*HYAC*OH + .7*r196*HYPERACET*OH + r197*NOA*OH + .5*r201*RO2*CH3O2 + + .14*r214*MACRO2*CH3CO3 + .08*r216*MACRO2*HO2 + .88*r218*MACR*O3 + .25*r233*MVKO2*CH3CO3 + + .12*r234*MVKO2*CH3O2 + .05*r235*MVKO2*HO2 + .5*r236*MVK*O3 + .44*r238*MVKOOH*OH + + .38*r247*HPALD1*OH + .03*r248*HPALD4*OH + .46*r251*HYDRALD*OH + .5*r252*ICHE*OH + + .46*r254*IEPOXOO*HO2 + .4*r255*INHEB*OH + .72*r289*ISOPHFP*OH + .17*r292*ISOPN1D*O3 + + .17*r302*ISOPN4D*O3 + .17*r317*ISOPNOOHD*O3 + .1*r332*NC4CHOO2*HO2 + .34*r334*NC4CHO*O3 + + .71*r336*IEPOXOO*NO + .14*r368*MACRO2*NO + .24*r370*MVKO2*NO + .12*r372*NC4CHOO2*NO + + .07*r388*DICARBO2*HO2 + .17*r389*DICARBO2*NO + .07*r394*MDIALO2*HO2 + .17*r395*MDIALO2*NO + + .4*r405*TOLO2*NO + .54*r411*XYLENO2*NO + .51*r414*XYLOLO2*NO + - j35*CH3COCHO - r193*NO3*CH3COCHO - r194*OH*CH3COCHO + d(CH3COOH)/dt = .1*r169*CH3CO3*CH3O2 + .15*r170*CH3CO3*HO2 + .12*r187*C3H6*O3 + .15*r223*MCO3*HO2 + - r172*OH*CH3COOH + d(CH3COOOH)/dt = .36*r170*CH3CO3*HO2 + .36*r223*MCO3*HO2 + - j36*CH3COOOH - r173*OH*CH3COOOH + d(CH3OH)/dt = r136*CH3O2*CH3O2 + .3*r158*C2H5O2*CH3O2 + .5*r201*RO2*CH3O2 + .25*r234*MVKO2*CH3O2 + + .25*r264*ISOPB4O2*CH3O2 + .25*r278*ISOPED1O2*CH3O2 + .25*r282*ISOPED4O2*CH3O2 + + .36*r308*ISOPNO3*CH3O2 + .25*r325*ISOPZD1O2*CH3O2 + .25*r329*ISOPZD4O2*CH3O2 + + .05*r420*APINNO3*CH3O2 + .17*r428*APINO2*CH3O2 + .05*r440*BCARYNO3*CH3O2 + + .25*r448*BCARYO2*CH3O2 + .03*r460*BPINNO3*CH3O2 + .09*r479*LIMONNO3*CH3O2 + + .25*r488*LIMONO2*CH3O2 + .05*r499*MYRCNO3*CH3O2 + .25*r508*MYRCO2*CH3O2 + + .25*r527*TERPA1O2*CH3O2 - r139*OH*CH3OH d(CH3OOH)/dt = r137*CH3O2*HO2 - j37*CH3OOH - r140*OH*CH3OOH - d(CH4)/dt = .1*r188*C3H6*O3 - - j38*CH4 - j39*CH4 - r52*CL*CH4 - r108*F*CH4 - r141*OH*CH4 - r149*O1D*CH4 - r150*O1D*CH4 - - r151*O1D*CH4 + d(CH4)/dt = .1*r187*C3H6*O3 + - j38*CH4 - j39*CH4 - r52*CL*CH4 - r108*F*CH4 - r141*OH*CH4 - r148*O1D*CH4 - r149*O1D*CH4 + - r150*O1D*CH4 d(CHBR3)/dt = - j134*CHBR3 - r104*O1D*CHBR3 - r121*CL*CHBR3 - r122*OH*CHBR3 d(CL)/dt = j118*BRCL + 4*j122*CCL4 + j123*CF2CLBR + 2*j125*CFC11 + 2*j126*CFC113 + 2*j127*CFC114 + j128*CFC115 + 2*j129*CFC12 + 3*j132*CH3CCL3 + j133*CH3CL + 2*j135*CL2 + 2*j136*CL2O2 @@ -2098,9 +2094,9 @@ Extraneous prod/loss species + r125*HCFC22*OH + r128*O1D*HCFC141B + r129*O1D*HCFC142B + r130*O1D*HCFC22 + r634*SO*CLO - r51*CH2O*CL - r52*CH4*CL - r53*H2*CL - r54*H2O2*CL - r55*HO2*CL - r56*HO2*CL - r57*O3*CL - r64*CLONO2*CL - r73*HOCL*CL - r114*CH2BR2*CL - r116*CH3BR*CL - r119*CH3CL*CL - r121*CHBR3*CL - - r164*C2H6*CL - d(CL2)/dt = r60*CLO*CLO + r64*CLONO2*CL + r719*HOCL*HCL + r724*CLONO2*HCL + r725*HOCL*HCL + r729*CLONO2*HCL - + r730*HOCL*HCL + r734*CLONO2*HCL + - r163*C2H6*CL + d(CL2)/dt = r60*CLO*CLO + r64*CLONO2*CL + r718*HOCL*HCL + r723*CLONO2*HCL + r724*HOCL*HCL + r728*CLONO2*HCL + + r729*HOCL*HCL + r733*CLONO2*HCL - j135*CL2 d(CL2O2)/dt = r85*M*CLO*CLO - j136*CL2O2 - r86*M*CL2O2 @@ -2110,69 +2106,69 @@ Extraneous prod/loss species - r63*NO*CLO - r65*M*NO2*CLO - r68*O*CLO - r69*OH*CLO - r70*OH*CLO - 2*r85*M*CLO*CLO - r91*BRO*CLO - r92*BRO*CLO - r93*BRO*CLO - r634*SO*CLO d(CLONO2)/dt = r65*M*CLO*NO2 - - j138*CLONO2 - j139*CLONO2 - r722*CLONO2 - r727*CLONO2 - r733*CLONO2 - r64*CL*CLONO2 - - r66*O*CLONO2 - r67*OH*CLONO2 - r724*HCL*CLONO2 - r729*HCL*CLONO2 - r734*HCL*CLONO2 + - j138*CLONO2 - j139*CLONO2 - r721*CLONO2 - r726*CLONO2 - r732*CLONO2 - r64*CL*CLONO2 + - r66*O*CLONO2 - r67*OH*CLONO2 - r723*HCL*CLONO2 - r728*HCL*CLONO2 - r733*HCL*CLONO2 d(CLY)/dt = 0 d(CO)/dt = 1.5*j22*BEPOMUC + .6*j25*BIGALD3 + j26*BIGALD4 + j31*CH2O + j32*CH2O + j33*CH3CHO + j35*CH3COCHO + .38*j39*CH4 + j40*CO2 + .5*j41*DHPMPAL + j43*GLYALD + 2*j44*GLYOXAL + j45*HCOCH2OOH + .33*j47*HONITR + 1.3200001*j48*HPALD1 + 1.74*j49*HPALD4 + j50*HPALDB1C + j51*HPALDB4C + 1.5*j53*HYDRALD + j54*HYDRALD + .55*j64*ISOPN1D + .55*j67*ISOPN4D + j72*MACR + .65*j72*MACR + .75*j74*MACRN + .86*j75*MACROOH + .7*j79*MVK + j83*NO3CH2CHO + 1.5*j90*TEPOMUC + j93*TERPA - + j94*TERPA2 + j96*TERPA3 + j154*OCS + r218*MACRO2 + r334*NC4CHOO2 + .6*r363*ISOPZD1O2 - + .6*r366*ISOPZD4O2 + r51*CL*CH2O + r87*BR*CH2O + r119*CH3CL*CL + r132*CH2O*NO3 + r133*CH2O*O - + r134*CH2O*OH + .35*r155*M*C2H2*OH + .63*r157*C2H4*O3 + r180*GLYOXAL*OH + .11*r181*HCOCH2OOH*OH - + .56*r188*C3H6*O3 + r194*CH3COCHO*NO3 + r195*CH3COCHO*OH + r210*DHPMPAL*OH + r214*MACRN*OH - + .86*r215*MACRO2*CH3CO3 + .9*r216*MACRO2*CH3O2 + .51*r217*MACRO2*HO2 + .65*r219*MACR*O3 - + r221*MACROOH*OH + .65*r222*MCO3*CH3CO3 + .65*r223*MCO3*CH3O2 + .32*r224*MCO3*HO2 - + 1.3*r225*MCO3*MCO3 + .65*r226*MCO3*NO + .65*r227*MCO3*NO3 + .25*r232*M*MPAN*OH + .5*r233*MVKN*OH - + r235*MVKO2*CH3O2 + .26*r236*MVKO2*HO2 + .56*r237*MVK*O3 + 1.5599999*r239*MVKOOH*OH - + 1.0599999*r248*HPALD1*OH + .76*r249*HPALD4*OH + .42*r250*HPALDB1C*OH + .23*r251*HPALDB4C*OH - + r252*HYDRALD*OH + 1.5*r253*ICHE*OH + .26*r255*IEPOXOO*HO2 + .35*r257*INHED*OH - + .55*r278*ISOPED1O2*CH3CO3 + .28*r279*ISOPED1O2*CH3O2 + .55*r282*ISOPED4O2*CH3CO3 - + .28*r283*ISOPED4O2*CH3O2 + r286*ISOPFDNC*OH + r288*ISOPFNC*OH + 2*r290*ISOPHFP*OH - + .06*r294*ISOPN1D*OH + .04*r304*ISOPN4D*OH + .35*r320*ISOP*O3 + .55*r325*ISOPZD1O2*CH3CO3 - + .28*r326*ISOPZD1O2*CH3O2 + .55*r329*ISOPZD4O2*CH3CO3 + .28*r330*ISOPZD4O2*CH3O2 - + .6*r333*NC4CHOO2*HO2 + .3*r335*NC4CHO*O3 + .63*r336*NC4CHO*OH + .4*r337*IEPOXOO*NO - + .55*r343*ISOPED1O2*NO + .55*r345*ISOPED4O2*NO + .55*r364*ISOPZD1O2*NO + .55*r367*ISOPZD4O2*NO - + .86*r369*MACRO2*NO + .75*r373*NC4CHOO2*NO + .07*r389*DICARBO2*HO2 + .17*r390*DICARBO2*NO - + .16*r392*MALO2*HO2 + .4*r393*MALO2*NO + .14*r395*MDIALO2*HO2 + .35*r396*MDIALO2*NO - + .17*r436*APIN*O3 + 2*r552*TERPA2PAN*OH + r571*TERPA3PAN*OH + r572*TERPA4O2*CH3CO3 - + r573*TERPA4O2*CH3O2 + .53*r574*TERPA4O2*HO2 + .91*r575*TERPA4O2*NO + r576*TERPA4O2*NO3 - + r577*TERPA4O2*TERPA2CO3 + r578*TERPA4O2*TERPA3CO3 + r579*TERPA4O2*TERPACO3 + r591*TERPAPAN*OH - + r629*OCS*O + r630*OCS*OH - - r142*M*OH*CO - r153*OH*CO + + j94*TERPA2 + j96*TERPA3 + j154*OCS + r217*MACRO2 + r333*NC4CHOO2 + .6*r362*ISOPZD1O2 + + .6*r365*ISOPZD4O2 + r51*CL*CH2O + r87*BR*CH2O + r119*CH3CL*CL + r132*CH2O*NO3 + r133*CH2O*O + + r134*CH2O*OH + .35*r154*M*C2H2*OH + .63*r156*C2H4*O3 + r179*GLYOXAL*OH + .11*r180*HCOCH2OOH*OH + + .56*r187*C3H6*O3 + r193*CH3COCHO*NO3 + r194*CH3COCHO*OH + r209*DHPMPAL*OH + r213*MACRN*OH + + .86*r214*MACRO2*CH3CO3 + .9*r215*MACRO2*CH3O2 + .51*r216*MACRO2*HO2 + .65*r218*MACR*O3 + + r220*MACROOH*OH + .65*r221*MCO3*CH3CO3 + .65*r222*MCO3*CH3O2 + .32*r223*MCO3*HO2 + + 1.3*r224*MCO3*MCO3 + .65*r225*MCO3*NO + .65*r226*MCO3*NO3 + .25*r231*M*MPAN*OH + .5*r232*MVKN*OH + + r234*MVKO2*CH3O2 + .26*r235*MVKO2*HO2 + .56*r236*MVK*O3 + 1.5599999*r238*MVKOOH*OH + + 1.0599999*r247*HPALD1*OH + .76*r248*HPALD4*OH + .42*r249*HPALDB1C*OH + .23*r250*HPALDB4C*OH + + r251*HYDRALD*OH + 1.5*r252*ICHE*OH + .26*r254*IEPOXOO*HO2 + .35*r256*INHED*OH + + .55*r277*ISOPED1O2*CH3CO3 + .28*r278*ISOPED1O2*CH3O2 + .55*r281*ISOPED4O2*CH3CO3 + + .28*r282*ISOPED4O2*CH3O2 + r285*ISOPFDNC*OH + r287*ISOPFNC*OH + 2*r289*ISOPHFP*OH + + .06*r293*ISOPN1D*OH + .04*r303*ISOPN4D*OH + .35*r319*ISOP*O3 + .55*r324*ISOPZD1O2*CH3CO3 + + .28*r325*ISOPZD1O2*CH3O2 + .55*r328*ISOPZD4O2*CH3CO3 + .28*r329*ISOPZD4O2*CH3O2 + + .6*r332*NC4CHOO2*HO2 + .3*r334*NC4CHO*O3 + .63*r335*NC4CHO*OH + .4*r336*IEPOXOO*NO + + .55*r342*ISOPED1O2*NO + .55*r344*ISOPED4O2*NO + .55*r363*ISOPZD1O2*NO + .55*r366*ISOPZD4O2*NO + + .86*r368*MACRO2*NO + .75*r372*NC4CHOO2*NO + .07*r388*DICARBO2*HO2 + .17*r389*DICARBO2*NO + + .16*r391*MALO2*HO2 + .4*r392*MALO2*NO + .14*r394*MDIALO2*HO2 + .35*r395*MDIALO2*NO + + .17*r435*APIN*O3 + 2*r551*TERPA2PAN*OH + r570*TERPA3PAN*OH + r571*TERPA4O2*CH3CO3 + + r572*TERPA4O2*CH3O2 + .53*r573*TERPA4O2*HO2 + .91*r574*TERPA4O2*NO + r575*TERPA4O2*NO3 + + r576*TERPA4O2*TERPA2CO3 + r577*TERPA4O2*TERPA3CO3 + r578*TERPA4O2*TERPACO3 + r590*TERPAPAN*OH + + r628*OCS*O + r629*OCS*OH + - r152*OH*CO d(CO2)/dt = j36*CH3COOOH + .44*j39*CH4 + .17*j48*HPALD1 + .28*j49*HPALD4 + j54*HYDRALD + .4*j86*PAN - + j98*TERPACID + j99*TERPACID2 + j100*TERPACID3 + r142*M*CO*OH + r144*HCOOH*OH + r153*CO*OH - + 2*r169*CH3CO3*CH3CO3 + .9*r170*CH3CO3*CH3O2 + .49*r171*CH3CO3*HO2 + r172*CH3CO3*NO - + r173*CH3COOH*OH + .5*r174*CH3COOOH*OH + .8*r179*GLYALD*OH + r180*GLYOXAL*OH + r182*NO3CH2CHO*OH - + .2*r188*C3H6*O3 + r215*MACRO2*CH3CO3 + 2*r222*MCO3*CH3CO3 + r223*MCO3*CH3O2 + .49*r224*MCO3*HO2 - + 2*r225*MCO3*MCO3 + r226*MCO3*NO + r227*MCO3*NO3 + r234*MVKO2*CH3CO3 + .1*r237*MVK*O3 - + .54*r248*HPALD1*OH + .54*r249*HPALD4*OH + .36*r252*HYDRALD*OH + .19*r257*INHED*OH - + r258*ISOPB1O2*CH3CO3 + r264*ISOPB4O2*CH3CO3 + r278*ISOPED1O2*CH3CO3 + r282*ISOPED4O2*CH3CO3 - + r308*ISOPNO3*CH3CO3 + .42*r320*ISOP*O3 + r325*ISOPZD1O2*CH3CO3 + r329*ISOPZD4O2*CH3CO3 - + .45*r336*NC4CHO*OH + r420*APINNO3*CH3CO3 + r425*APINNO3*TERPA2CO3 + r426*APINNO3*TERPA3CO3 - + r427*APINNO3*TERPACO3 + r428*APINO2*CH3CO3 + r433*APINO2*TERPA2CO3 + r434*APINO2*TERPA3CO3 - + r435*APINO2*TERPACO3 + r440*BCARYNO3*CH3CO3 + r445*BCARYNO3*TERPA2CO3 + r446*BCARYNO3*TERPA3CO3 - + r447*BCARYNO3*TERPACO3 + r448*BCARYO2*CH3CO3 + r453*BCARYO2*TERPA2CO3 + r454*BCARYO2*TERPA3CO3 - + r455*BCARYO2*TERPACO3 + r460*BPINNO3*CH3CO3 + r465*BPINNO3*TERPA2CO3 + r466*BPINNO3*TERPA3CO3 - + r467*BPINNO3*TERPACO3 + r468*BPINO2*CH3CO3 + r473*BPINO2*TERPA2CO3 + r474*BPINO2*TERPA3CO3 - + r475*BPINO2*TERPACO3 + .19*r476*BPIN*O3 + r479*LIMONNO3*CH3CO3 + r485*LIMONNO3*TERPA2CO3 - + r486*LIMONNO3*TERPA3CO3 + r487*LIMONNO3*TERPACO3 + r488*LIMONO2*CH3CO3 + r493*LIMONO2*TERPA2CO3 - + r494*LIMONO2*TERPA3CO3 + r495*LIMONO2*TERPACO3 + r499*MYRCNO3*CH3CO3 + r505*MYRCNO3*TERPA2CO3 - + r506*MYRCNO3*TERPA3CO3 + r507*MYRCNO3*TERPACO3 + r508*MYRCO2*CH3CO3 + r513*MYRCO2*TERPA2CO3 - + r514*MYRCO2*TERPA3CO3 + r515*MYRCO2*TERPACO3 + r527*TERPA1O2*CH3CO3 + r532*TERPA1O2*TERPA2CO3 - + r533*TERPA1O2*TERPA3CO3 + r534*TERPA1O2*TERPACO3 + 2*r535*TERPA2CO3*CH3CO3 - + r536*TERPA2CO3*CH3O2 + .49*r537*TERPA2CO3*HO2 + r538*TERPA2CO3*NO + r539*TERPA2CO3*NO3 - + 2*r540*TERPA2CO3*TERPA2CO3 + 2*r541*TERPA2CO3*TERPACO3 + r543*TERPA2O2*CH3CO3 - + r548*TERPA2O2*TERPA2CO3 + r549*TERPA2O2*TERPA3CO3 + r550*TERPA2O2*TERPACO3 + 2*r552*TERPA2PAN*OH - + 2*r553*TERPA3CO3*CH3CO3 + r554*TERPA3CO3*CH3O2 + .49*r555*TERPA3CO3*HO2 + r556*TERPA3CO3*NO - + r557*TERPA3CO3*NO3 + 2*r558*TERPA3CO3*TERPA2CO3 + 2*r559*TERPA3CO3*TERPA3CO3 - + 2*r560*TERPA3CO3*TERPACO3 + r562*TERPA3O2*CH3CO3 + r567*TERPA3O2*TERPA2CO3 - + r568*TERPA3O2*TERPA3CO3 + r569*TERPA3O2*TERPACO3 + 3*r571*TERPA3PAN*OH + r572*TERPA4O2*CH3CO3 - + r577*TERPA4O2*TERPA2CO3 + r578*TERPA4O2*TERPA3CO3 + r579*TERPA4O2*TERPACO3 - + .29*r580*TERPACID2*OH + .29*r581*TERPACID3*OH + .29*r582*TERPACID*OH + 2*r583*TERPACO3*CH3CO3 - + r584*TERPACO3*CH3O2 + .49*r585*TERPACO3*HO2 + r586*TERPACO3*NO + r587*TERPACO3*NO3 - + 2*r588*TERPACO3*TERPACO3 + + j98*TERPACID + j99*TERPACID2 + j100*TERPACID3 + r143*HCOOH*OH + r152*CO*OH + + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + .49*r170*CH3CO3*HO2 + r171*CH3CO3*NO + + r172*CH3COOH*OH + .5*r173*CH3COOOH*OH + .8*r178*GLYALD*OH + r179*GLYOXAL*OH + r181*NO3CH2CHO*OH + + .2*r187*C3H6*O3 + r214*MACRO2*CH3CO3 + 2*r221*MCO3*CH3CO3 + r222*MCO3*CH3O2 + .49*r223*MCO3*HO2 + + 2*r224*MCO3*MCO3 + r225*MCO3*NO + r226*MCO3*NO3 + r233*MVKO2*CH3CO3 + .1*r236*MVK*O3 + + .54*r247*HPALD1*OH + .54*r248*HPALD4*OH + .36*r251*HYDRALD*OH + .19*r256*INHED*OH + + r257*ISOPB1O2*CH3CO3 + r263*ISOPB4O2*CH3CO3 + r277*ISOPED1O2*CH3CO3 + r281*ISOPED4O2*CH3CO3 + + r307*ISOPNO3*CH3CO3 + .42*r319*ISOP*O3 + r324*ISOPZD1O2*CH3CO3 + r328*ISOPZD4O2*CH3CO3 + + .45*r335*NC4CHO*OH + r419*APINNO3*CH3CO3 + r424*APINNO3*TERPA2CO3 + r425*APINNO3*TERPA3CO3 + + r426*APINNO3*TERPACO3 + r427*APINO2*CH3CO3 + r432*APINO2*TERPA2CO3 + r433*APINO2*TERPA3CO3 + + r434*APINO2*TERPACO3 + r439*BCARYNO3*CH3CO3 + r444*BCARYNO3*TERPA2CO3 + r445*BCARYNO3*TERPA3CO3 + + r446*BCARYNO3*TERPACO3 + r447*BCARYO2*CH3CO3 + r452*BCARYO2*TERPA2CO3 + r453*BCARYO2*TERPA3CO3 + + r454*BCARYO2*TERPACO3 + r459*BPINNO3*CH3CO3 + r464*BPINNO3*TERPA2CO3 + r465*BPINNO3*TERPA3CO3 + + r466*BPINNO3*TERPACO3 + r467*BPINO2*CH3CO3 + r472*BPINO2*TERPA2CO3 + r473*BPINO2*TERPA3CO3 + + r474*BPINO2*TERPACO3 + .19*r475*BPIN*O3 + r478*LIMONNO3*CH3CO3 + r484*LIMONNO3*TERPA2CO3 + + r485*LIMONNO3*TERPA3CO3 + r486*LIMONNO3*TERPACO3 + r487*LIMONO2*CH3CO3 + r492*LIMONO2*TERPA2CO3 + + r493*LIMONO2*TERPA3CO3 + r494*LIMONO2*TERPACO3 + r498*MYRCNO3*CH3CO3 + r504*MYRCNO3*TERPA2CO3 + + r505*MYRCNO3*TERPA3CO3 + r506*MYRCNO3*TERPACO3 + r507*MYRCO2*CH3CO3 + r512*MYRCO2*TERPA2CO3 + + r513*MYRCO2*TERPA3CO3 + r514*MYRCO2*TERPACO3 + r526*TERPA1O2*CH3CO3 + r531*TERPA1O2*TERPA2CO3 + + r532*TERPA1O2*TERPA3CO3 + r533*TERPA1O2*TERPACO3 + 2*r534*TERPA2CO3*CH3CO3 + + r535*TERPA2CO3*CH3O2 + .49*r536*TERPA2CO3*HO2 + r537*TERPA2CO3*NO + r538*TERPA2CO3*NO3 + + 2*r539*TERPA2CO3*TERPA2CO3 + 2*r540*TERPA2CO3*TERPACO3 + r542*TERPA2O2*CH3CO3 + + r547*TERPA2O2*TERPA2CO3 + r548*TERPA2O2*TERPA3CO3 + r549*TERPA2O2*TERPACO3 + 2*r551*TERPA2PAN*OH + + 2*r552*TERPA3CO3*CH3CO3 + r553*TERPA3CO3*CH3O2 + .49*r554*TERPA3CO3*HO2 + r555*TERPA3CO3*NO + + r556*TERPA3CO3*NO3 + 2*r557*TERPA3CO3*TERPA2CO3 + 2*r558*TERPA3CO3*TERPA3CO3 + + 2*r559*TERPA3CO3*TERPACO3 + r561*TERPA3O2*CH3CO3 + r566*TERPA3O2*TERPA2CO3 + + r567*TERPA3O2*TERPA3CO3 + r568*TERPA3O2*TERPACO3 + 3*r570*TERPA3PAN*OH + r571*TERPA4O2*CH3CO3 + + r576*TERPA4O2*TERPA2CO3 + r577*TERPA4O2*TERPA3CO3 + r578*TERPA4O2*TERPACO3 + + .29*r579*TERPACID2*OH + .29*r580*TERPACID3*OH + .29*r581*TERPACID*OH + 2*r582*TERPACO3*CH3CO3 + + r583*TERPACO3*CH3O2 + .49*r584*TERPACO3*HO2 + r585*TERPACO3*NO + r586*TERPACO3*NO3 + + 2*r587*TERPACO3*TERPACO3 - j40*CO2 d(COF2)/dt = j123*CF2CLBR + j124*CF3BR + j126*CFC113 + 2*j127*CFC114 + 2*j128*CFC115 + j129*CFC12 + 2*j142*H2402 + j145*HCFC142B + j146*HCFC22 + r77*O1D*CF2CLBR + r79*O1D*CFC113 @@ -2182,50 +2178,48 @@ Extraneous prod/loss species d(COFCL)/dt = j125*CFC11 + j126*CFC113 + j144*HCFC141B + r78*O1D*CFC11 + r79*O1D*CFC113 + r123*HCFC141B*OH + r128*O1D*HCFC141B - j141*COFCL - r113*O1D*COFCL - d(CRESOL)/dt = .18*r408*TOLUENE*OH - - r388*OH*CRESOL - d(DHPMPAL)/dt = .6*r363*ISOPZD1O2 + .6*r366*ISOPZD4O2 + .07*r248*HPALD1*OH + .17*r249*HPALD4*OH - - j41*DHPMPAL - r210*OH*DHPMPAL - d(DMS)/dt = - r627*NO3*DMS - r628*OH*DMS - r641*OH*DMS + d(CRESOL)/dt = .18*r407*TOLUENE*OH + - r387*OH*CRESOL + d(DHPMPAL)/dt = .6*r362*ISOPZD1O2 + .6*r365*ISOPZD4O2 + .07*r247*HPALD1*OH + .17*r248*HPALD4*OH + - j41*DHPMPAL - r209*OH*DHPMPAL + d(DMS)/dt = - r626*NO3*DMS - r627*OH*DMS - r641*OH*DMS d(dst_a1)/dt = 0 d(dst_a2)/dt = 0 d(dst_a3)/dt = 0 - d(E90)/dt = - r735*E90 - d(EOOH)/dt = r175*EO2*HO2 + d(E90)/dt = - r734*E90 + d(EOOH)/dt = r174*EO2*HO2 - j42*EOOH d(F)/dt = j124*CF3BR + j128*CFC115 + 2*j140*COF2 + j141*COFCL + j148*HF + r81*O1D*CFC115 + r103*O1D*CF3BR + 2*r112*O1D*COF2 + r113*O1D*COFCL - r108*CH4*F - r109*H2*F - r110*H2O*F - r111*HNO3*F d(GLYALD)/dt = .33*j47*HONITR + .5*j53*HYDRALD + j59*ISOPFDN + .5*j60*ISOPFDNC + .5*j61*ISOPFNC + j62*ISOPFNP - + .72*j63*ISOPHFP + .5*j80*MVKN + .56*j81*MVKOOH + r178*O2*EO + .75*r234*MVKO2*CH3CO3 - + .38*r235*MVKO2*CH3O2 + .36*r236*MVKO2*HO2 + .37*r255*IEPOXOO*HO2 + .55*r291*ISOPN1DO2*HO2 - + .83*r293*ISOPN1D*O3 + .46*r295*ISOPN2BO2*HO2 + .15*r305*ISOPNBNO3O2*HO2 - + .28*r313*ISOPNOOHBO2*HO2 + r322*ISOPOH*OH + .07*r324*ISOPOOH*OH + .57*r337*IEPOXOO*NO - + .94*r347*ISOPN1DO2*NO + .73*r349*ISOPN2BO2*NO + .34*r355*ISOPNBNO3O2*NO - + .4*r359*ISOPNOOHBO2*NO + .76*r371*MVKO2*NO - - j43*GLYALD - r179*OH*GLYALD + + .72*j63*ISOPHFP + .5*j80*MVKN + .56*j81*MVKOOH + r177*O2*EO + .75*r233*MVKO2*CH3CO3 + + .38*r234*MVKO2*CH3O2 + .36*r235*MVKO2*HO2 + .37*r254*IEPOXOO*HO2 + .55*r290*ISOPN1DO2*HO2 + + .83*r292*ISOPN1D*O3 + .46*r294*ISOPN2BO2*HO2 + .15*r304*ISOPNBNO3O2*HO2 + + .28*r312*ISOPNOOHBO2*HO2 + r321*ISOPOH*OH + .07*r323*ISOPOOH*OH + .57*r336*IEPOXOO*NO + + .94*r346*ISOPN1DO2*NO + .73*r348*ISOPN2BO2*NO + .34*r354*ISOPNBNO3O2*NO + + .4*r358*ISOPNOOHBO2*NO + .76*r370*MVKO2*NO + - j43*GLYALD - r178*OH*GLYALD d(GLYOXAL)/dt = j21*BENZOOH + .5*j60*ISOPFDNC + .5*j61*ISOPFNC + .28*j63*ISOPHFP + .7*j87*PHENOOH - + .6*j115*TOLOOH + .34*j116*XYLENOOH + .17*j117*XYLOLOOH + .65*r155*M*C2H2*OH - + .2*r179*GLYALD*OH + .89*r181*HCOCH2OOH*OH + .15*r255*IEPOXOO*HO2 + .17*r293*ISOPN1D*O3 - + .17*r303*ISOPN4D*O3 + .17*r318*ISOPNOOHD*O3 + .1*r333*NC4CHOO2*HO2 + .66*r335*NC4CHO*O3 - + .23*r337*IEPOXOO*NO + .13*r373*NC4CHOO2*NO + r379*BENZO2*NO + .16*r392*MALO2*HO2 - + .4*r393*MALO2*NO + .07*r395*MDIALO2*HO2 + .17*r396*MDIALO2*NO + .7*r399*PHENO2*NO - + .6*r406*TOLO2*NO + .34*r412*XYLENO2*NO + .17*r415*XYLOLO2*NO - - j44*GLYOXAL - r645*GLYOXAL - r180*OH*GLYOXAL + + .6*j115*TOLOOH + .34*j116*XYLENOOH + .17*j117*XYLOLOOH + .65*r154*M*C2H2*OH + + .2*r178*GLYALD*OH + .89*r180*HCOCH2OOH*OH + .15*r254*IEPOXOO*HO2 + .17*r292*ISOPN1D*O3 + + .17*r302*ISOPN4D*O3 + .17*r317*ISOPNOOHD*O3 + .1*r332*NC4CHOO2*HO2 + .66*r334*NC4CHO*O3 + + .23*r336*IEPOXOO*NO + .13*r372*NC4CHOO2*NO + r378*BENZO2*NO + .16*r391*MALO2*HO2 + + .4*r392*MALO2*NO + .07*r394*MDIALO2*HO2 + .17*r395*MDIALO2*NO + .7*r398*PHENO2*NO + + .6*r405*TOLO2*NO + .34*r411*XYLENO2*NO + .17*r414*XYLOLO2*NO + - j44*GLYOXAL - r644*GLYOXAL - r179*OH*GLYOXAL d(H)/dt = j2*H2O + 2*j3*H2O + 2*j31*CH2O + j37*CH3OOH + j38*CH4 + .33*j39*CH4 + j143*HBR + j147*HCL + j148*HF + r1*O1D*H2 + r9*H2*O + r18*OH*H2 + r21*OH*O + r39*N*OH + r53*CL*H2 + r84*O1D*HCL - + r107*O1D*HBR + r109*F*H2 + r134*CH2O*OH + r150*O1D*CH4 + r153*CO*OH + r630*OCS*OH + r635*S*OH - + r640*SO*OH + + r107*O1D*HBR + r109*F*H2 + r134*CH2O*OH + r149*O1D*CH4 + r629*OCS*OH + r635*S*OH + r640*SO*OH - r14*O2*M*H - r11*HO2*H - r12*HO2*H - r13*HO2*H - r17*O3*H - d(H2)/dt = j1*H2O + j32*CH2O + 1.4400001*j39*CH4 + r11*H*HO2 + r151*O1D*CH4 + d(H2)/dt = j1*H2O + j32*CH2O + 1.4400001*j39*CH4 + r11*H*HO2 + r150*O1D*CH4 - r1*O1D*H2 - r9*O*H2 - r18*OH*H2 - r53*CL*H2 - r109*F*H2 d(H2402)/dt = - j142*H2402 - r105*O1D*H2402 - d(H2O2)/dt = .5*r646*HO2 + r24*M*OH*OH + r25*HO2*HO2 + .66*r293*ISOPN1D*O3 + .66*r303*ISOPN4D*O3 - + .66*r318*ISOPNOOHD*O3 + .03*r320*ISOP*O3 + .66*r335*NC4CHO*O3 + .22*r436*APIN*O3 - + .17*r456*BCARY*O3 + .32*r476*BPIN*O3 + .33*r496*LIMON*O3 + .02*r596*TERPF1*O3 - + .04*r601*TERPF2*O3 + d(H2O2)/dt = r24*M*OH*OH + r25*HO2*HO2 + .66*r292*ISOPN1D*O3 + .66*r302*ISOPN4D*O3 + .66*r317*ISOPNOOHD*O3 + + .03*r319*ISOP*O3 + .66*r334*NC4CHO*O3 + .22*r435*APIN*O3 + .17*r455*BCARY*O3 + + .32*r475*BPIN*O3 + .33*r495*LIMON*O3 + .02*r595*TERPF1*O3 + .04*r600*TERPF2*O3 - j4*H2O2 - r10*O*H2O2 - r19*OH*H2O2 - r54*CL*H2O2 - d(H2SO4)/dt = r643*SO3*H2O + d(H2SO4)/dt = r642*SO3*H2O - j153*H2SO4 d(HBR)/dt = r87*BR*CH2O + r88*BR*HO2 - j143*HBR - r100*O*HBR - r101*OH*HBR - r106*O1D*HBR - r107*O1D*HBR @@ -2233,319 +2227,319 @@ Extraneous prod/loss species d(HCFC142B)/dt = - j145*HCFC142B - r124*OH*HCFC142B - r129*O1D*HCFC142B d(HCFC22)/dt = - j146*HCFC22 - r125*OH*HCFC22 - r130*O1D*HCFC22 d(HCL)/dt = r51*CL*CH2O + r52*CL*CH4 + r53*CL*H2 + r54*CL*H2O2 + r55*CL*HO2 + r70*CLO*OH + r73*HOCL*CL - + r114*CH2BR2*CL + r116*CH3BR*CL + 2*r119*CH3CL*CL + r121*CHBR3*CL + r164*C2H6*CL - - j147*HCL - r71*O*HCL - r72*OH*HCL - r83*O1D*HCL - r84*O1D*HCL - r719*HOCL*HCL - - r724*CLONO2*HCL - r725*HOCL*HCL - r726*HOBR*HCL - r729*CLONO2*HCL - r730*HOCL*HCL - - r731*HOBR*HCL - r734*CLONO2*HCL - d(HCN)/dt = - r143*M*OH*HCN - r152*O1D*HCN - d(HCOCH2OOH)/dt = .68*r316*ISOPNOOHDO2*HO2 + .7*r318*ISOPNOOHD*O3 + .81*r361*ISOPNOOHDO2*NO - - j45*HCOCH2OOH - r181*OH*HCOCH2OOH - d(HCOOH)/dt = .41*j48*HPALD1 + .5*r145*HMHP*OH + .5*r146*HOCH2OO*HO2 + r148*HOCH2OO*NO + .35*r155*M*C2H2*OH - + .37*r157*C2H4*O3 + .12*r188*C3H6*O3 + .33*r219*MACR*O3 + .12*r237*MVK*O3 + .4*r256*INHEB*OH - + .22*r320*ISOP*O3 + .08*r476*BPIN*O3 + .15*r596*TERPF1*O3 + .26*r601*TERPF2*O3 - - r144*OH*HCOOH + + r114*CH2BR2*CL + r116*CH3BR*CL + 2*r119*CH3CL*CL + r121*CHBR3*CL + r163*C2H6*CL + - j147*HCL - r71*O*HCL - r72*OH*HCL - r83*O1D*HCL - r84*O1D*HCL - r718*HOCL*HCL + - r723*CLONO2*HCL - r724*HOCL*HCL - r725*HOBR*HCL - r728*CLONO2*HCL - r729*HOCL*HCL + - r730*HOBR*HCL - r733*CLONO2*HCL + d(HCN)/dt = - r142*M*OH*HCN - r151*O1D*HCN + d(HCOCH2OOH)/dt = .68*r315*ISOPNOOHDO2*HO2 + .7*r317*ISOPNOOHD*O3 + .81*r360*ISOPNOOHDO2*NO + - j45*HCOCH2OOH - r180*OH*HCOCH2OOH + d(HCOOH)/dt = .41*j48*HPALD1 + .5*r144*HMHP*OH + .5*r145*HOCH2OO*HO2 + r147*HOCH2OO*NO + .35*r154*M*C2H2*OH + + .37*r156*C2H4*O3 + .12*r187*C3H6*O3 + .33*r218*MACR*O3 + .12*r236*MVK*O3 + .4*r255*INHEB*OH + + .22*r319*ISOP*O3 + .08*r475*BPIN*O3 + .15*r595*TERPF1*O3 + .26*r600*TERPF2*O3 + - r143*OH*HCOOH d(HF)/dt = r108*F*CH4 + r109*F*H2 + r110*F*H2O + r111*F*HNO3 - j148*HF - d(HMHP)/dt = .5*r146*HOCH2OO*HO2 + .33*r320*ISOP*O3 + .11*r476*BPIN*O3 + .23*r596*TERPF1*O3 - + .4*r601*TERPF2*O3 - - j46*HMHP - r145*OH*HMHP - d(HNO3)/dt = r647*HONITR + r650*INHEB + r651*INHED + r652*ISOPNOOHD + r653*ISOPFDN + r654*ISOPFDNC - + r658*ISOPN1D + r659*ISOPN2B + r660*ISOPN4D + 2*r661*N2O5 + r662*NC4CHO + .5*r664*NO2 - + r665*NO3 + r666*ONITR + r669*TERPFDN + r671*TERPNPT1 + r672*TERPNPT + r673*TERPNT1 - + r674*TERPNT + 2*r718*N2O5 + r720*BRONO2 + 2*r721*N2O5 + r722*CLONO2 + r723*BRONO2 - + r727*CLONO2 + r728*BRONO2 + 2*r732*N2O5 + r733*CLONO2 + r47*M*NO2*OH + r132*CH2O*NO3 - + r166*CH3CHO*NO3 + r194*CH3COCHO*NO3 + r542*TERPA2*NO3 + r561*TERPA3*NO3 + r589*TERPA*NO3 - + r627*DMS*NO3 + r724*CLONO2*HCL + r729*CLONO2*HCL + r734*CLONO2*HCL + d(HMHP)/dt = .5*r145*HOCH2OO*HO2 + .33*r319*ISOP*O3 + .11*r475*BPIN*O3 + .23*r595*TERPF1*O3 + + .4*r600*TERPF2*O3 + - j46*HMHP - r144*OH*HMHP + d(HNO3)/dt = r646*HONITR + r649*INHEB + r650*INHED + r651*ISOPNOOHD + r652*ISOPFDN + r653*ISOPFDNC + + r657*ISOPN1D + r658*ISOPN2B + r659*ISOPN4D + 2*r660*N2O5 + r661*NC4CHO + .5*r663*NO2 + + r664*NO3 + r665*ONITR + r668*TERPFDN + r670*TERPNPT1 + r671*TERPNPT + r672*TERPNT1 + + r673*TERPNT + 2*r717*N2O5 + r719*BRONO2 + 2*r720*N2O5 + r721*CLONO2 + r722*BRONO2 + + r726*CLONO2 + r727*BRONO2 + 2*r731*N2O5 + r732*CLONO2 + r47*M*NO2*OH + r132*CH2O*NO3 + + r165*CH3CHO*NO3 + r193*CH3COCHO*NO3 + r541*TERPA2*NO3 + r560*TERPA3*NO3 + r588*TERPA*NO3 + + r626*DMS*NO3 + r723*CLONO2*HCL + r728*CLONO2*HCL + r733*CLONO2*HCL - j9*HNO3 - r48*OH*HNO3 - r111*F*HNO3 d(HO2NO2)/dt = r45*M*NO2*HO2 - j10*HO2NO2 - j11*HO2NO2 - r49*M*HO2NO2 - r26*OH*HO2NO2 - d(HOBR)/dt = r720*BRONO2 + r723*BRONO2 + r728*BRONO2 + r94*BRO*HO2 - - j149*HOBR - r102*O*HOBR - r726*HCL*HOBR - r731*HCL*HOBR - d(HOCL)/dt = r722*CLONO2 + r727*CLONO2 + r733*CLONO2 + r62*CLO*HO2 + r67*CLONO2*OH - - j150*HOCL - r73*CL*HOCL - r74*O*HOCL - r75*OH*HOCL - r719*HCL*HOCL - r725*HCL*HOCL - - r730*HCL*HOCL - d(HONITR)/dt = r212*ENEO2*NO - - j47*HONITR - r647*HONITR - r213*OH*HONITR - d(HPALD1)/dt = .25*r363*ISOPZD1O2 - - j48*HPALD1 - r248*OH*HPALD1 - d(HPALD4)/dt = .25*r366*ISOPZD4O2 - - j49*HPALD4 - r249*OH*HPALD4 - d(HPALDB1C)/dt = .15*r363*ISOPZD1O2 + .09*r323*ISOPOOH*OH - - j50*HPALDB1C - r250*OH*HPALDB1C - d(HPALDB4C)/dt = .15*r366*ISOPZD4O2 + .09*r323*ISOPOOH*OH - - j51*HPALDB4C - r251*OH*HPALDB4C + d(HOBR)/dt = r719*BRONO2 + r722*BRONO2 + r727*BRONO2 + r94*BRO*HO2 + - j149*HOBR - r102*O*HOBR - r725*HCL*HOBR - r730*HCL*HOBR + d(HOCL)/dt = r721*CLONO2 + r726*CLONO2 + r732*CLONO2 + r62*CLO*HO2 + r67*CLONO2*OH + - j150*HOCL - r73*CL*HOCL - r74*O*HOCL - r75*OH*HOCL - r718*HCL*HOCL - r724*HCL*HOCL + - r729*HCL*HOCL + d(HONITR)/dt = r211*ENEO2*NO + - j47*HONITR - r646*HONITR - r212*OH*HONITR + d(HPALD1)/dt = .25*r362*ISOPZD1O2 + - j48*HPALD1 - r247*OH*HPALD1 + d(HPALD4)/dt = .25*r365*ISOPZD4O2 + - j49*HPALD4 - r248*OH*HPALD4 + d(HPALDB1C)/dt = .15*r362*ISOPZD1O2 + .09*r322*ISOPOOH*OH + - j50*HPALDB1C - r249*OH*HPALDB1C + d(HPALDB4C)/dt = .15*r365*ISOPZD4O2 + .09*r322*ISOPOOH*OH + - j51*HPALDB4C - r250*OH*HPALDB4C d(HYAC)/dt = .17*j47*HONITR + .5*j53*HYDRALD + j59*ISOPFDN + .5*j60*ISOPFDNC + .5*j61*ISOPFNC + j62*ISOPFNP - + .28*j63*ISOPHFP + .5*j74*MACRN + .86*j75*MACROOH + r218*MACRO2 + .5*r201*POOH*OH - + .2*r202*RO2*CH3O2 + .5*r214*MACRN*OH + .86*r215*MACRO2*CH3CO3 + .9*r216*MACRO2*CH3O2 - + .51*r217*MACRO2*HO2 + r221*MACROOH*OH + .25*r232*M*MPAN*OH + .22*r252*HYDRALD*OH - + .5*r253*ICHE*OH + .19*r255*IEPOXOO*HO2 + .19*r257*INHED*OH + .28*r290*ISOPHFP*OH - + .46*r295*ISOPN2BO2*HO2 + .44*r301*ISOPN4DO2*HO2 + .83*r303*ISOPN4D*O3 - + .15*r305*ISOPNBNO3O2*HO2 + .06*r313*ISOPNOOHBO2*HO2 + r322*ISOPOH*OH + .07*r324*ISOPOOH*OH - + .29*r337*IEPOXOO*NO + .73*r349*ISOPN2BO2*NO + .87*r353*ISOPN4DO2*NO + .33*r355*ISOPNBNO3O2*NO - + .07*r359*ISOPNOOHBO2*NO + .86*r369*MACRO2*NO + .18*r516*MYRC*O3 - - j52*HYAC - r196*OH*HYAC - d(HYDRALD)/dt = .45*j64*ISOPN1D + .45*j67*ISOPN4D + j82*NC4CHO + .25*r265*ISOPB4O2*CH3O2 - + .45*r278*ISOPED1O2*CH3CO3 + .47*r279*ISOPED1O2*CH3O2 + .45*r282*ISOPED4O2*CH3CO3 - + .47*r283*ISOPED4O2*CH3O2 + .13*r323*ISOPOOH*OH + .45*r325*ISOPZD1O2*CH3CO3 - + .47*r326*ISOPZD1O2*CH3O2 + .45*r329*ISOPZD4O2*CH3CO3 + .47*r330*ISOPZD4O2*CH3O2 - + .45*r343*ISOPED1O2*NO + .45*r345*ISOPED4O2*NO + .45*r364*ISOPZD1O2*NO - + .45*r367*ISOPZD4O2*NO - - j53*HYDRALD - j54*HYDRALD - r252*OH*HYDRALD - d(HYPERACET)/dt = .5*j41*DHPMPAL + r210*DHPMPAL*OH + .15*r249*HPALD4*OH + .12*r316*ISOPNOOHDO2*HO2 - + .13*r318*ISOPNOOHD*O3 + .15*r361*ISOPNOOHDO2*NO - - j55*HYPERACET - j56*HYPERACET - r197*OH*HYPERACET - d(ICHE)/dt = j57*INHEB + j58*INHED + .08*r248*HPALD1*OH + .18*r249*HPALD4*OH + .58*r250*HPALDB1C*OH - + .77*r251*HPALDB4C*OH + .19*r254*IEPOX*OH + .04*r336*NC4CHO*OH - - r648*ICHE - r253*OH*ICHE - d(IEPOX)/dt = .08*r294*ISOPN1D*OH + .15*r297*ISOPN2B*OH + .13*r300*ISOPN3B*OH + .04*r304*ISOPN4D*OH - + .07*r319*ISOPNOOHD*OH + .85*r324*ISOPOOH*OH - - r649*IEPOX - r254*OH*IEPOX - d(INHEB)/dt = .2*r256*INHEB*OH + .4*r315*ISOPNOOHB*OH - - j57*INHEB - r650*INHEB - r256*OH*INHEB - d(INHED)/dt = .06*r257*INHED*OH + .03*r306*ISOPNBNO3*OH + .2*r319*ISOPNOOHD*OH - - j58*INHED - r651*INHED - r257*OH*INHED - d(ISOP)/dt = - r307*NO3*ISOP - r320*O3*ISOP - r321*OH*ISOP - d(ISOPFDN)/dt = r348*ISOPN1DO2*NO + r350*ISOPN2BO2*NO + r352*ISOPN3BO2*NO + r354*ISOPN4DO2*NO - + r356*ISOPNBNO3O2*NO + r358*ISOPNO3*NO + r360*ISOPNOOHBO2*NO + r362*ISOPNOOHDO2*NO - - j59*ISOPFDN - r653*ISOPFDN - r287*OH*ISOPFDN - d(ISOPFDNC)/dt = r287*ISOPFDN*OH + r374*NC4CHOO2*NO - - j60*ISOPFDNC - r654*ISOPFDNC - r286*OH*ISOPFDNC - d(ISOPFNC)/dt = r296*ISOPN2BO2 + r299*ISOPN3BO2 + r289*ISOPFNP*OH + r338*IEPOXOO*NO - - j61*ISOPFNC - r655*ISOPFNC - r288*OH*ISOPFNC - d(ISOPFNP)/dt = r292*ISOPN1DO2 + r302*ISOPN4DO2 + r314*ISOPNOOHBO2 + r317*ISOPNOOHDO2 + .42*r291*ISOPN1DO2*HO2 - + .48*r295*ISOPN2BO2*HO2 + .4*r298*ISOPN3BO2*HO2 + .5*r301*ISOPN4DO2*HO2 - + .6*r305*ISOPNBNO3O2*HO2 + .49*r313*ISOPNOOHBO2*HO2 + .17*r316*ISOPNOOHDO2*HO2 - + .2*r333*NC4CHOO2*HO2 - - j62*ISOPFNP - r656*ISOPFNP - r289*OH*ISOPFNP - d(ISOPHFP)/dt = .35*r255*IEPOXOO*HO2 + .08*r324*ISOPOOH*OH - - j63*ISOPHFP - r657*ISOPHFP - r290*OH*ISOPHFP - d(ISOPN1D)/dt = .28*r309*ISOPNO3*CH3O2 + .53*r311*ISOPNO3*ISOPNO3 + r346*ISOPED4O2*NO + r368*ISOPZD4O2*NO - - j64*ISOPN1D - r658*ISOPN1D - r293*O3*ISOPN1D - r294*OH*ISOPN1D - d(ISOPN2B)/dt = r340*ISOPB1O2*NO - - j65*ISOPN2B - r659*ISOPN2B - r297*OH*ISOPN2B - d(ISOPN3B)/dt = r342*ISOPB4O2*NO - - j66*ISOPN3B - r300*OH*ISOPN3B - d(ISOPN4D)/dt = .05*r309*ISOPNO3*CH3O2 + .09*r311*ISOPNO3*ISOPNO3 + r344*ISOPED1O2*NO + r365*ISOPZD1O2*NO - - j67*ISOPN4D - r660*ISOPN4D - r303*O3*ISOPN4D - r304*OH*ISOPN4D - d(ISOPNBNO3)/dt = .07*r309*ISOPNO3*CH3O2 + .15*r311*ISOPNO3*ISOPNO3 - - j68*ISOPNBNO3 - r306*OH*ISOPNBNO3 - d(ISOPNOOHB)/dt = .23*r310*ISOPNO3*HO2 - - j69*ISOPNOOHB - r315*OH*ISOPNOOHB - d(ISOPNOOHD)/dt = .53*r310*ISOPNO3*HO2 - - j70*ISOPNOOHD - r652*ISOPNOOHD - r318*O3*ISOPNOOHD - r319*OH*ISOPNOOHD - d(ISOPOH)/dt = .25*r259*ISOPB1O2*CH3O2 + .25*r265*ISOPB4O2*CH3O2 + .25*r279*ISOPED1O2*CH3O2 - + .25*r283*ISOPED4O2*CH3O2 + .25*r326*ISOPZD1O2*CH3O2 + .25*r330*ISOPZD4O2*CH3O2 - - r322*OH*ISOPOH - d(ISOPOOH)/dt = .94*r260*ISOPB1O2*HO2 + .94*r266*ISOPB4O2*HO2 + r280*ISOPED1O2*HO2 + r284*ISOPED4O2*HO2 - + r327*ISOPZD1O2*HO2 + r331*ISOPZD4O2*HO2 - - j71*ISOPOOH - r323*OH*ISOPOOH - r324*OH*ISOPOOH - d(IVOC)/dt = - r700*OH*IVOC - d(LIMON)/dt = - r478*NO3*LIMON - r496*O3*LIMON - r497*OH*LIMON + + .28*j63*ISOPHFP + .5*j74*MACRN + .86*j75*MACROOH + r217*MACRO2 + .5*r200*POOH*OH + + .2*r201*RO2*CH3O2 + .5*r213*MACRN*OH + .86*r214*MACRO2*CH3CO3 + .9*r215*MACRO2*CH3O2 + + .51*r216*MACRO2*HO2 + r220*MACROOH*OH + .25*r231*M*MPAN*OH + .22*r251*HYDRALD*OH + + .5*r252*ICHE*OH + .19*r254*IEPOXOO*HO2 + .19*r256*INHED*OH + .28*r289*ISOPHFP*OH + + .46*r294*ISOPN2BO2*HO2 + .44*r300*ISOPN4DO2*HO2 + .83*r302*ISOPN4D*O3 + + .15*r304*ISOPNBNO3O2*HO2 + .06*r312*ISOPNOOHBO2*HO2 + r321*ISOPOH*OH + .07*r323*ISOPOOH*OH + + .29*r336*IEPOXOO*NO + .73*r348*ISOPN2BO2*NO + .87*r352*ISOPN4DO2*NO + .33*r354*ISOPNBNO3O2*NO + + .07*r358*ISOPNOOHBO2*NO + .86*r368*MACRO2*NO + .18*r515*MYRC*O3 + - j52*HYAC - r195*OH*HYAC + d(HYDRALD)/dt = .45*j64*ISOPN1D + .45*j67*ISOPN4D + j82*NC4CHO + .25*r264*ISOPB4O2*CH3O2 + + .45*r277*ISOPED1O2*CH3CO3 + .47*r278*ISOPED1O2*CH3O2 + .45*r281*ISOPED4O2*CH3CO3 + + .47*r282*ISOPED4O2*CH3O2 + .13*r322*ISOPOOH*OH + .45*r324*ISOPZD1O2*CH3CO3 + + .47*r325*ISOPZD1O2*CH3O2 + .45*r328*ISOPZD4O2*CH3CO3 + .47*r329*ISOPZD4O2*CH3O2 + + .45*r342*ISOPED1O2*NO + .45*r344*ISOPED4O2*NO + .45*r363*ISOPZD1O2*NO + + .45*r366*ISOPZD4O2*NO + - j53*HYDRALD - j54*HYDRALD - r251*OH*HYDRALD + d(HYPERACET)/dt = .5*j41*DHPMPAL + r209*DHPMPAL*OH + .15*r248*HPALD4*OH + .12*r315*ISOPNOOHDO2*HO2 + + .13*r317*ISOPNOOHD*O3 + .15*r360*ISOPNOOHDO2*NO + - j55*HYPERACET - j56*HYPERACET - r196*OH*HYPERACET + d(ICHE)/dt = j57*INHEB + j58*INHED + .08*r247*HPALD1*OH + .18*r248*HPALD4*OH + .58*r249*HPALDB1C*OH + + .77*r250*HPALDB4C*OH + .19*r253*IEPOX*OH + .04*r335*NC4CHO*OH + - r647*ICHE - r252*OH*ICHE + d(IEPOX)/dt = .08*r293*ISOPN1D*OH + .15*r296*ISOPN2B*OH + .13*r299*ISOPN3B*OH + .04*r303*ISOPN4D*OH + + .07*r318*ISOPNOOHD*OH + .85*r323*ISOPOOH*OH + - r648*IEPOX - r253*OH*IEPOX + d(INHEB)/dt = .2*r255*INHEB*OH + .4*r314*ISOPNOOHB*OH + - j57*INHEB - r649*INHEB - r255*OH*INHEB + d(INHED)/dt = .06*r256*INHED*OH + .03*r305*ISOPNBNO3*OH + .2*r318*ISOPNOOHD*OH + - j58*INHED - r650*INHED - r256*OH*INHED + d(ISOP)/dt = - r306*NO3*ISOP - r319*O3*ISOP - r320*OH*ISOP + d(ISOPFDN)/dt = r347*ISOPN1DO2*NO + r349*ISOPN2BO2*NO + r351*ISOPN3BO2*NO + r353*ISOPN4DO2*NO + + r355*ISOPNBNO3O2*NO + r357*ISOPNO3*NO + r359*ISOPNOOHBO2*NO + r361*ISOPNOOHDO2*NO + - j59*ISOPFDN - r652*ISOPFDN - r286*OH*ISOPFDN + d(ISOPFDNC)/dt = r286*ISOPFDN*OH + r373*NC4CHOO2*NO + - j60*ISOPFDNC - r653*ISOPFDNC - r285*OH*ISOPFDNC + d(ISOPFNC)/dt = r295*ISOPN2BO2 + r298*ISOPN3BO2 + r288*ISOPFNP*OH + r337*IEPOXOO*NO + - j61*ISOPFNC - r654*ISOPFNC - r287*OH*ISOPFNC + d(ISOPFNP)/dt = r291*ISOPN1DO2 + r301*ISOPN4DO2 + r313*ISOPNOOHBO2 + r316*ISOPNOOHDO2 + .42*r290*ISOPN1DO2*HO2 + + .48*r294*ISOPN2BO2*HO2 + .4*r297*ISOPN3BO2*HO2 + .5*r300*ISOPN4DO2*HO2 + + .6*r304*ISOPNBNO3O2*HO2 + .49*r312*ISOPNOOHBO2*HO2 + .17*r315*ISOPNOOHDO2*HO2 + + .2*r332*NC4CHOO2*HO2 + - j62*ISOPFNP - r655*ISOPFNP - r288*OH*ISOPFNP + d(ISOPHFP)/dt = .35*r254*IEPOXOO*HO2 + .08*r323*ISOPOOH*OH + - j63*ISOPHFP - r656*ISOPHFP - r289*OH*ISOPHFP + d(ISOPN1D)/dt = .28*r308*ISOPNO3*CH3O2 + .53*r310*ISOPNO3*ISOPNO3 + r345*ISOPED4O2*NO + r367*ISOPZD4O2*NO + - j64*ISOPN1D - r657*ISOPN1D - r292*O3*ISOPN1D - r293*OH*ISOPN1D + d(ISOPN2B)/dt = r339*ISOPB1O2*NO + - j65*ISOPN2B - r658*ISOPN2B - r296*OH*ISOPN2B + d(ISOPN3B)/dt = r341*ISOPB4O2*NO + - j66*ISOPN3B - r299*OH*ISOPN3B + d(ISOPN4D)/dt = .05*r308*ISOPNO3*CH3O2 + .09*r310*ISOPNO3*ISOPNO3 + r343*ISOPED1O2*NO + r364*ISOPZD1O2*NO + - j67*ISOPN4D - r659*ISOPN4D - r302*O3*ISOPN4D - r303*OH*ISOPN4D + d(ISOPNBNO3)/dt = .07*r308*ISOPNO3*CH3O2 + .15*r310*ISOPNO3*ISOPNO3 + - j68*ISOPNBNO3 - r305*OH*ISOPNBNO3 + d(ISOPNOOHB)/dt = .23*r309*ISOPNO3*HO2 + - j69*ISOPNOOHB - r314*OH*ISOPNOOHB + d(ISOPNOOHD)/dt = .53*r309*ISOPNO3*HO2 + - j70*ISOPNOOHD - r651*ISOPNOOHD - r317*O3*ISOPNOOHD - r318*OH*ISOPNOOHD + d(ISOPOH)/dt = .25*r258*ISOPB1O2*CH3O2 + .25*r264*ISOPB4O2*CH3O2 + .25*r278*ISOPED1O2*CH3O2 + + .25*r282*ISOPED4O2*CH3O2 + .25*r325*ISOPZD1O2*CH3O2 + .25*r329*ISOPZD4O2*CH3O2 + - r321*OH*ISOPOH + d(ISOPOOH)/dt = .94*r259*ISOPB1O2*HO2 + .94*r265*ISOPB4O2*HO2 + r279*ISOPED1O2*HO2 + r283*ISOPED4O2*HO2 + + r326*ISOPZD1O2*HO2 + r330*ISOPZD4O2*HO2 + - j71*ISOPOOH - r322*OH*ISOPOOH - r323*OH*ISOPOOH + d(IVOC)/dt = - r699*OH*IVOC + d(LIMON)/dt = - r477*NO3*LIMON - r495*O3*LIMON - r496*OH*LIMON d(MACR)/dt = j51*HPALDB4C + j66*ISOPN3B + .5*j68*ISOPNBNO3 + .12*j69*ISOPNOOHB + .3*j71*ISOPOOH - + r267*ISOPB4O2 + .35*r249*HPALD4*OH + .14*r251*HPALDB4C*OH + r264*ISOPB4O2*CH3CO3 - + .5*r265*ISOPB4O2*CH3O2 + .06*r266*ISOPB4O2*HO2 + .04*r308*ISOPNO3*CH3CO3 - + .02*r309*ISOPNO3*CH3O2 + .02*r310*ISOPNO3*HO2 + .16*r311*ISOPNO3*ISOPNO3 + .04*r312*ISOPNO3*NO3 - + .41*r320*ISOP*O3 + r341*ISOPB4O2*NO + .04*r357*ISOPNO3*NO - - j72*MACR - j73*MACR - r219*O3*MACR - r220*OH*MACR - d(MACRN)/dt = .51*r334*NC4CHOO2 + .5*r286*ISOPFDNC*OH + .25*r288*ISOPFNC*OH + .03*r291*ISOPN1DO2*HO2 - + .06*r294*ISOPN1D*OH + .06*r295*ISOPN2BO2*HO2 + .06*r305*ISOPNBNO3O2*HO2 - + .15*r313*ISOPNOOHBO2*HO2 + .02*r316*ISOPNOOHDO2*HO2 + .29*r333*NC4CHOO2*HO2 - + .24*r336*NC4CHO*OH + .06*r347*ISOPN1DO2*NO + .27*r349*ISOPN2BO2*NO + .21*r355*ISOPNBNO3O2*NO - + .49*r359*ISOPNOOHBO2*NO + .02*r361*ISOPNOOHDO2*NO + r370*MACRO2*NO + .39*r373*NC4CHOO2*NO - - j74*MACRN - r214*OH*MACRN - d(MACROOH)/dt = .55*j64*ISOPN1D + .41*r217*MACRO2*HO2 + .09*r251*HPALDB4C*OH + .55*r282*ISOPED4O2*CH3CO3 - + .28*r283*ISOPED4O2*CH3O2 + .25*r288*ISOPFNC*OH + .55*r329*ISOPZD4O2*CH3CO3 - + .28*r330*ISOPZD4O2*CH3O2 + .55*r345*ISOPED4O2*NO + .55*r367*ISOPZD4O2*NO - - j75*MACROOH - r221*OH*MACROOH - d(MEK)/dt = .8*j19*ALKNIT + .8*j20*ALKOOH + .8*r244*ALKO2*NO - - j76*MEK - r230*OH*MEK - d(MEKOOH)/dt = .8*r228*MEKO2*HO2 - - j77*MEKOOH - r231*OH*MEKOOH - d(MPAN)/dt = r240*M*MCO3*NO2 - - j78*MPAN - r241*M*MPAN - r232*M*OH*MPAN + + r266*ISOPB4O2 + .35*r248*HPALD4*OH + .14*r250*HPALDB4C*OH + r263*ISOPB4O2*CH3CO3 + + .5*r264*ISOPB4O2*CH3O2 + .06*r265*ISOPB4O2*HO2 + .04*r307*ISOPNO3*CH3CO3 + + .02*r308*ISOPNO3*CH3O2 + .02*r309*ISOPNO3*HO2 + .16*r310*ISOPNO3*ISOPNO3 + .04*r311*ISOPNO3*NO3 + + .41*r319*ISOP*O3 + r340*ISOPB4O2*NO + .04*r356*ISOPNO3*NO + - j72*MACR - j73*MACR - r218*O3*MACR - r219*OH*MACR + d(MACRN)/dt = .51*r333*NC4CHOO2 + .5*r285*ISOPFDNC*OH + .25*r287*ISOPFNC*OH + .03*r290*ISOPN1DO2*HO2 + + .06*r293*ISOPN1D*OH + .06*r294*ISOPN2BO2*HO2 + .06*r304*ISOPNBNO3O2*HO2 + + .15*r312*ISOPNOOHBO2*HO2 + .02*r315*ISOPNOOHDO2*HO2 + .29*r332*NC4CHOO2*HO2 + + .24*r335*NC4CHO*OH + .06*r346*ISOPN1DO2*NO + .27*r348*ISOPN2BO2*NO + .21*r354*ISOPNBNO3O2*NO + + .49*r358*ISOPNOOHBO2*NO + .02*r360*ISOPNOOHDO2*NO + r369*MACRO2*NO + .39*r372*NC4CHOO2*NO + - j74*MACRN - r213*OH*MACRN + d(MACROOH)/dt = .55*j64*ISOPN1D + .41*r216*MACRO2*HO2 + .09*r250*HPALDB4C*OH + .55*r281*ISOPED4O2*CH3CO3 + + .28*r282*ISOPED4O2*CH3O2 + .25*r287*ISOPFNC*OH + .55*r328*ISOPZD4O2*CH3CO3 + + .28*r329*ISOPZD4O2*CH3O2 + .55*r344*ISOPED4O2*NO + .55*r366*ISOPZD4O2*NO + - j75*MACROOH - r220*OH*MACROOH + d(MEK)/dt = .8*j19*ALKNIT + .8*j20*ALKOOH + .8*r243*ALKO2*NO + - j76*MEK - r229*OH*MEK + d(MEKOOH)/dt = .8*r227*MEKO2*HO2 + - j77*MEKOOH - r230*OH*MEKOOH + d(MPAN)/dt = r239*M*MCO3*NO2 + - j78*MPAN - r240*M*MPAN - r231*M*OH*MPAN d(MVK)/dt = j50*HPALDB1C + j65*ISOPN2B + .5*j68*ISOPNBNO3 + .88*j69*ISOPNOOHB + .7*j71*ISOPOOH - + r261*ISOPB1O2 + .35*r248*HPALD1*OH + .23*r250*HPALDB1C*OH + r258*ISOPB1O2*CH3CO3 - + .75*r259*ISOPB1O2*CH3O2 + .06*r260*ISOPB1O2*HO2 + .42*r308*ISOPNO3*CH3CO3 - + .05*r309*ISOPNO3*CH3O2 + .22*r310*ISOPNO3*HO2 + .42*r312*ISOPNO3*NO3 + .17*r320*ISOP*O3 - + r339*ISOPB1O2*NO + .42*r357*ISOPNO3*NO - - j79*MVK - r237*O3*MVK - r238*OH*MVK - d(MVKN)/dt = .49*r334*NC4CHOO2 + .05*r257*INHED*OH + .5*r286*ISOPFDNC*OH + .25*r288*ISOPFNC*OH - + .6*r298*ISOPN3BO2*HO2 + .06*r301*ISOPN4DO2*HO2 + .04*r304*ISOPN4D*OH + .04*r305*ISOPNBNO3O2*HO2 - + .02*r313*ISOPNOOHBO2*HO2 + .01*r316*ISOPNOOHDO2*HO2 + .31*r333*NC4CHOO2*HO2 - + .04*r336*NC4CHO*OH + r351*ISOPN3BO2*NO + .13*r353*ISOPN4DO2*NO + .12*r355*ISOPNBNO3O2*NO - + .04*r359*ISOPNOOHBO2*NO + .02*r361*ISOPNOOHDO2*NO + r372*MVKO2*NO + .36*r373*NC4CHOO2*NO - - j80*MVKN - r233*OH*MVKN - d(MVKOOH)/dt = .55*j67*ISOPN4D + .46*r236*MVKO2*HO2 + .19*r250*HPALDB1C*OH + .55*r278*ISOPED1O2*CH3CO3 - + .28*r279*ISOPED1O2*CH3O2 + .25*r288*ISOPFNC*OH + .55*r325*ISOPZD1O2*CH3CO3 - + .28*r326*ISOPZD1O2*CH3O2 + .55*r343*ISOPED1O2*NO + .55*r364*ISOPZD1O2*NO - - j81*MVKOOH - r239*OH*MVKOOH - d(MYRC)/dt = - r498*NO3*MYRC - r516*O3*MYRC - r517*OH*MYRC + + r260*ISOPB1O2 + .35*r247*HPALD1*OH + .23*r249*HPALDB1C*OH + r257*ISOPB1O2*CH3CO3 + + .75*r258*ISOPB1O2*CH3O2 + .06*r259*ISOPB1O2*HO2 + .42*r307*ISOPNO3*CH3CO3 + + .05*r308*ISOPNO3*CH3O2 + .22*r309*ISOPNO3*HO2 + .42*r311*ISOPNO3*NO3 + .17*r319*ISOP*O3 + + r338*ISOPB1O2*NO + .42*r356*ISOPNO3*NO + - j79*MVK - r236*O3*MVK - r237*OH*MVK + d(MVKN)/dt = .49*r333*NC4CHOO2 + .05*r256*INHED*OH + .5*r285*ISOPFDNC*OH + .25*r287*ISOPFNC*OH + + .6*r297*ISOPN3BO2*HO2 + .06*r300*ISOPN4DO2*HO2 + .04*r303*ISOPN4D*OH + .04*r304*ISOPNBNO3O2*HO2 + + .02*r312*ISOPNOOHBO2*HO2 + .01*r315*ISOPNOOHDO2*HO2 + .31*r332*NC4CHOO2*HO2 + + .04*r335*NC4CHO*OH + r350*ISOPN3BO2*NO + .13*r352*ISOPN4DO2*NO + .12*r354*ISOPNBNO3O2*NO + + .04*r358*ISOPNOOHBO2*NO + .02*r360*ISOPNOOHDO2*NO + r371*MVKO2*NO + .36*r372*NC4CHOO2*NO + - j80*MVKN - r232*OH*MVKN + d(MVKOOH)/dt = .55*j67*ISOPN4D + .46*r235*MVKO2*HO2 + .19*r249*HPALDB1C*OH + .55*r277*ISOPED1O2*CH3CO3 + + .28*r278*ISOPED1O2*CH3O2 + .25*r287*ISOPFNC*OH + .55*r324*ISOPZD1O2*CH3CO3 + + .28*r325*ISOPZD1O2*CH3O2 + .55*r342*ISOPED1O2*NO + .55*r363*ISOPZD1O2*NO + - j81*MVKOOH - r238*OH*MVKOOH + d(MYRC)/dt = - r497*NO3*MYRC - r515*O3*MYRC - r516*OH*MYRC d(N)/dt = j15*NO - r31*O2*N - r27*NO*N - r28*NO2*N - r29*NO2*N - r30*NO2*N - r39*OH*N d(N2O)/dt = r28*N*NO2 - j12*N2O - r43*O1D*N2O - r44*O1D*N2O d(N2O5)/dt = r46*M*NO2*NO3 - - j13*N2O5 - j14*N2O5 - r50*M*N2O5 - r661*N2O5 - r718*N2O5 - r721*N2O5 - r732*N2O5 - d(NC4CHO)/dt = j70*ISOPNOOHD + .04*r294*ISOPN1D*OH + .03*r304*ISOPN4D*OH + .05*r306*ISOPNBNO3*OH - + .54*r308*ISOPNO3*CH3CO3 + .53*r309*ISOPNO3*CH3O2 + 1.0700001*r311*ISOPNO3*ISOPNO3 - + .54*r312*ISOPNO3*NO3 + .02*r315*ISOPNOOHB*OH + .09*r319*ISOPNOOHD*OH + .54*r357*ISOPNO3*NO - - j82*NC4CHO - r662*NC4CHO - r335*O3*NC4CHO - r336*OH*NC4CHO + - j13*N2O5 - j14*N2O5 - r50*M*N2O5 - r660*N2O5 - r717*N2O5 - r720*N2O5 - r731*N2O5 + d(NC4CHO)/dt = j70*ISOPNOOHD + .04*r293*ISOPN1D*OH + .03*r303*ISOPN4D*OH + .05*r305*ISOPNBNO3*OH + + .54*r307*ISOPNO3*CH3CO3 + .53*r308*ISOPNO3*CH3O2 + 1.0700001*r310*ISOPNO3*ISOPNO3 + + .54*r311*ISOPNO3*NO3 + .02*r314*ISOPNOOHB*OH + .09*r318*ISOPNOOHD*OH + .54*r356*ISOPNO3*NO + - j82*NC4CHO - r661*NC4CHO - r334*O3*NC4CHO - r335*OH*NC4CHO d(ncl_a1)/dt = 0 d(ncl_a2)/dt = 0 d(ncl_a3)/dt = 0 - d(NH3)/dt = - r644*OH*NH3 - d(NH4)/dt = - r663*NH4 - d(NH_5)/dt = - r737*NH_5 - d(NH_50)/dt = - r736*NH_50 - d(NO)/dt = j14*N2O5 + j16*NO2 + j17*NO3 + r31*O2*N + .5*r664*NO2 + 2*r29*N*NO2 + r32*NO2*O + r39*N*OH + d(NH3)/dt = - r643*OH*NH3 + d(NH4)/dt = - r662*NH4 + d(NH_5)/dt = - r736*NH_5 + d(NH_50)/dt = - r735*NH_50 + d(NO)/dt = j14*N2O5 + j16*NO2 + j17*NO3 + r31*O2*N + .5*r663*NO2 + 2*r29*N*NO2 + r32*NO2*O + r39*N*OH + 2*r43*O1D*N2O + r636*SO*NO2 - j15*NO - r27*N*NO - r36*NO3*NO - r40*HO2*NO - r41*O3*NO - r42*M*O*NO - r63*CLO*NO - - r95*BRO*NO - r138*CH3O2*NO - r148*HOCH2OO*NO - r161*C2H5O2*NO - r172*CH3CO3*NO - r176*EO2*NO - - r191*C3H7O2*NO - r200*PO2*NO - r204*RO2*NO - r211*ENEO2*NO - r212*ENEO2*NO - r226*MCO3*NO - - r229*MEKO2*NO - r244*ALKO2*NO - r245*ALKO2*NO - r337*IEPOXOO*NO - r338*IEPOXOO*NO - - r339*ISOPB1O2*NO - r340*ISOPB1O2*NO - r341*ISOPB4O2*NO - r342*ISOPB4O2*NO - r343*ISOPED1O2*NO - - r344*ISOPED1O2*NO - r345*ISOPED4O2*NO - r346*ISOPED4O2*NO - r347*ISOPN1DO2*NO - - r348*ISOPN1DO2*NO - r349*ISOPN2BO2*NO - r350*ISOPN2BO2*NO - r351*ISOPN3BO2*NO - - r352*ISOPN3BO2*NO - r353*ISOPN4DO2*NO - r354*ISOPN4DO2*NO - r355*ISOPNBNO3O2*NO - - r356*ISOPNBNO3O2*NO - r357*ISOPNO3*NO - r358*ISOPNO3*NO - r359*ISOPNOOHBO2*NO - - r360*ISOPNOOHBO2*NO - r361*ISOPNOOHDO2*NO - r362*ISOPNOOHDO2*NO - r364*ISOPZD1O2*NO - - r365*ISOPZD1O2*NO - r367*ISOPZD4O2*NO - r368*ISOPZD4O2*NO - r369*MACRO2*NO - r370*MACRO2*NO - - r371*MVKO2*NO - r372*MVKO2*NO - r373*NC4CHOO2*NO - r374*NC4CHOO2*NO - r376*ACBZO2*NO - - r379*BENZO2*NO - r384*BZOO*NO - r386*C6H5O2*NO - r390*DICARBO2*NO - r393*MALO2*NO - - r396*MDIALO2*NO - r399*PHENO2*NO - r406*TOLO2*NO - r412*XYLENO2*NO - r415*XYLOLO2*NO - - r423*APINNO3*NO - r431*APINO2*NO - r443*BCARYNO3*NO - r451*BCARYO2*NO - r463*BPINNO3*NO - - r471*BPINO2*NO - r483*LIMONNO3*NO - r491*LIMONO2*NO - r503*MYRCNO3*NO - r511*MYRCO2*NO - - r522*TERP1OOHO2*NO - r526*TERP2OOHO2*NO - r530*TERPA1O2*NO - r538*TERPA2CO3*NO - - r546*TERPA2O2*NO - r556*TERPA3CO3*NO - r565*TERPA3O2*NO - r575*TERPA4O2*NO - r586*TERPACO3*NO - - r595*TERPF1O2*NO - r600*TERPF2O2*NO - r607*TERPNPS1O2*NO - r611*TERPNPT1O2*NO - - r615*TERPNS1O2*NO - r619*TERPNT1O2*NO + - r95*BRO*NO - r138*CH3O2*NO - r147*HOCH2OO*NO - r160*C2H5O2*NO - r171*CH3CO3*NO - r175*EO2*NO + - r190*C3H7O2*NO - r199*PO2*NO - r203*RO2*NO - r210*ENEO2*NO - r211*ENEO2*NO - r225*MCO3*NO + - r228*MEKO2*NO - r243*ALKO2*NO - r244*ALKO2*NO - r336*IEPOXOO*NO - r337*IEPOXOO*NO + - r338*ISOPB1O2*NO - r339*ISOPB1O2*NO - r340*ISOPB4O2*NO - r341*ISOPB4O2*NO - r342*ISOPED1O2*NO + - r343*ISOPED1O2*NO - r344*ISOPED4O2*NO - r345*ISOPED4O2*NO - r346*ISOPN1DO2*NO + - r347*ISOPN1DO2*NO - r348*ISOPN2BO2*NO - r349*ISOPN2BO2*NO - r350*ISOPN3BO2*NO + - r351*ISOPN3BO2*NO - r352*ISOPN4DO2*NO - r353*ISOPN4DO2*NO - r354*ISOPNBNO3O2*NO + - r355*ISOPNBNO3O2*NO - r356*ISOPNO3*NO - r357*ISOPNO3*NO - r358*ISOPNOOHBO2*NO + - r359*ISOPNOOHBO2*NO - r360*ISOPNOOHDO2*NO - r361*ISOPNOOHDO2*NO - r363*ISOPZD1O2*NO + - r364*ISOPZD1O2*NO - r366*ISOPZD4O2*NO - r367*ISOPZD4O2*NO - r368*MACRO2*NO - r369*MACRO2*NO + - r370*MVKO2*NO - r371*MVKO2*NO - r372*NC4CHOO2*NO - r373*NC4CHOO2*NO - r375*ACBZO2*NO + - r378*BENZO2*NO - r383*BZOO*NO - r385*C6H5O2*NO - r389*DICARBO2*NO - r392*MALO2*NO + - r395*MDIALO2*NO - r398*PHENO2*NO - r405*TOLO2*NO - r411*XYLENO2*NO - r414*XYLOLO2*NO + - r422*APINNO3*NO - r430*APINO2*NO - r442*BCARYNO3*NO - r450*BCARYO2*NO - r462*BPINNO3*NO + - r470*BPINO2*NO - r482*LIMONNO3*NO - r490*LIMONO2*NO - r502*MYRCNO3*NO - r510*MYRCO2*NO + - r521*TERP1OOHO2*NO - r525*TERP2OOHO2*NO - r529*TERPA1O2*NO - r537*TERPA2CO3*NO + - r545*TERPA2O2*NO - r555*TERPA3CO3*NO - r564*TERPA3O2*NO - r574*TERPA4O2*NO - r585*TERPACO3*NO + - r594*TERPF1O2*NO - r599*TERPF2O2*NO - r606*TERPNPS1O2*NO - r610*TERPNPT1O2*NO + - r614*TERPNS1O2*NO - r618*TERPNT1O2*NO d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j19*ALKNIT + j47*HONITR + j57*INHEB + j58*INHED + 2*j59*ISOPFDN + 2*j60*ISOPFDNC + j61*ISOPFNC + j62*ISOPFNP + j64*ISOPN1D + j65*ISOPN2B + j66*ISOPN3B + j67*ISOPN4D + j68*ISOPNBNO3 + j69*ISOPNOOHB + .75*j74*MACRN + j78*MPAN + .75*j80*MVKN + j82*NC4CHO + j83*NO3CH2CHO + j84*NOA + j85*ONITR + .6*j86*PAN + j95*TERPA2PAN + j97*TERPA3PAN + j101*TERPAPAN + j103*TERPFDN + .5*j105*TERPNPS + .46*j106*TERPNPS1 + j107*TERPNPT + .46*j108*TERPNPT1 + j109*TERPNS + j110*TERPNS1 + j111*TERPNT + j112*TERPNT1 - + j120*BRONO2 + j139*CLONO2 + r49*M*HO2NO2 + r50*M*N2O5 + r186*M*PAN + r241*M*MPAN - + r409*M*PBZNIT + r624*M*TERPA2PAN + r625*M*TERPA3PAN + r626*M*TERPAPAN + r26*HO2NO2*OH + + j120*BRONO2 + j139*CLONO2 + r49*M*HO2NO2 + r50*M*N2O5 + r185*M*PAN + r240*M*MPAN + + r408*M*PBZNIT + r623*M*TERPA2PAN + r624*M*TERPA3PAN + r625*M*TERPAPAN + r26*HO2NO2*OH + r35*NO3*HO2 + 2*r36*NO3*NO + r37*NO3*O + r38*NO3*OH + r40*NO*HO2 + r41*NO*O3 + r42*M*NO*O - + r63*CLO*NO + r95*BRO*NO + r138*CH3O2*NO + r148*HOCH2OO*NO + r161*C2H5O2*NO + r172*CH3CO3*NO - + r176*EO2*NO + r182*NO3CH2CHO*OH + r191*C3H7O2*NO + r198*NOA*OH + r200*PO2*NO + r204*RO2*NO - + r208*BIGENE*NO3 + r211*ENEO2*NO + .5*r214*MACRN*OH + r226*MCO3*NO + r227*MCO3*NO3 - + r229*MEKO2*NO + r242*ALKNIT*OH + r244*ALKO2*NO + .4*r256*INHEB*OH + .19*r257*INHED*OH - + r286*ISOPFDNC*OH + .5*r288*ISOPFNC*OH + .17*r293*ISOPN1D*O3 + .08*r294*ISOPN1D*OH - + .46*r295*ISOPN2BO2*HO2 + .15*r297*ISOPN2B*OH + .13*r300*ISOPN3B*OH + .17*r303*ISOPN4D*O3 - + .04*r304*ISOPN4D*OH + .46*r308*ISOPNO3*CH3CO3 + .07*r309*ISOPNO3*CH3O2 + .24*r310*ISOPNO3*HO2 - + .16*r311*ISOPNO3*ISOPNO3 + 1.46*r312*ISOPNO3*NO3 + .17*r318*ISOPNOOHD*O3 + .07*r319*ISOPNOOHD*OH - + .17*r335*NC4CHO*O3 + .04*r336*NC4CHO*OH + r337*IEPOXOO*NO + r339*ISOPB1O2*NO + r341*ISOPB4O2*NO - + r343*ISOPED1O2*NO + r345*ISOPED4O2*NO + r347*ISOPN1DO2*NO + 1.73*r349*ISOPN2BO2*NO - + r351*ISOPN3BO2*NO + r353*ISOPN4DO2*NO + r355*ISOPNBNO3O2*NO + 1.46*r357*ISOPNO3*NO - + r359*ISOPNOOHBO2*NO + r361*ISOPNOOHDO2*NO + r364*ISOPZD1O2*NO + r367*ISOPZD4O2*NO - + r369*MACRO2*NO + r371*MVKO2*NO + r373*NC4CHOO2*NO + r376*ACBZO2*NO + r379*BENZO2*NO - + r384*BZOO*NO + r386*C6H5O2*NO + r390*DICARBO2*NO + r393*MALO2*NO + r396*MDIALO2*NO - + r399*PHENO2*NO + r406*TOLO2*NO + r412*XYLENO2*NO + r415*XYLOLO2*NO + 1.64*r419*APINNO3*APINNO3 - + r420*APINNO3*CH3CO3 + .82*r421*APINNO3*CH3O2 + .7*r422*APINNO3*HO2 + 1.86*r423*APINNO3*NO - + 2*r424*APINNO3*NO3 + r425*APINNO3*TERPA2CO3 + r426*APINNO3*TERPA3CO3 + r427*APINNO3*TERPACO3 - + .77*r431*APINO2*NO + r432*APINO2*NO3 + 1.64*r439*BCARYNO3*BCARYNO3 + r440*BCARYNO3*CH3CO3 - + .82*r441*BCARYNO3*CH3O2 + .5*r442*BCARYNO3*HO2 + 1.86*r443*BCARYNO3*NO + 2*r444*BCARYNO3*NO3 - + r445*BCARYNO3*TERPA2CO3 + r446*BCARYNO3*TERPA3CO3 + r447*BCARYNO3*TERPACO3 + .7*r451*BCARYO2*NO - + r452*BCARYO2*NO3 + .94*r459*BPINNO3*BPINNO3 + .5*r460*BPINNO3*CH3CO3 + .36*r461*BPINNO3*CH3O2 - + .24*r462*BPINNO3*HO2 + 1.39*r463*BPINNO3*NO + 1.5*r464*BPINNO3*NO3 + .5*r465*BPINNO3*TERPA2CO3 - + .5*r466*BPINNO3*TERPA3CO3 + .5*r467*BPINNO3*TERPACO3 + .75*r471*BPINO2*NO + r472*BPINO2*NO3 - + .46*r479*LIMONNO3*CH3CO3 + .31*r480*LIMONNO3*CH3O2 + .23*r481*LIMONNO3*HO2 - + .86*r482*LIMONNO3*LIMONNO3 + 1.36*r483*LIMONNO3*NO + 1.46*r484*LIMONNO3*NO3 - + .46*r485*LIMONNO3*TERPA2CO3 + .46*r486*LIMONNO3*TERPA3CO3 + .46*r487*LIMONNO3*TERPACO3 - + .77*r491*LIMONO2*NO + r492*LIMONO2*NO3 + .95*r499*MYRCNO3*CH3CO3 + .77*r500*MYRCNO3*CH3O2 - + .48*r501*MYRCNO3*HO2 + 1.54*r502*MYRCNO3*MYRCNO3 + 1.8200001*r503*MYRCNO3*NO - + 1.95*r504*MYRCNO3*NO3 + .95*r505*MYRCNO3*TERPA2CO3 + .95*r506*MYRCNO3*TERPA3CO3 - + .95*r507*MYRCNO3*TERPACO3 + .71*r511*MYRCO2*NO + r512*MYRCO2*NO3 + .7*r522*TERP1OOHO2*NO - + .7*r526*TERP2OOHO2*NO + .7*r530*TERPA1O2*NO + r531*TERPA1O2*NO3 + r538*TERPA2CO3*NO - + r539*TERPA2CO3*NO3 + .83*r546*TERPA2O2*NO + r547*TERPA2O2*NO3 + r552*TERPA2PAN*OH - + r556*TERPA3CO3*NO + r557*TERPA3CO3*NO3 + .7*r565*TERPA3O2*NO + r566*TERPA3O2*NO3 - + r571*TERPA3PAN*OH + .91*r575*TERPA4O2*NO + r576*TERPA4O2*NO3 + r586*TERPACO3*NO - + r587*TERPACO3*NO3 + r591*TERPAPAN*OH + r593*TERPF1*NO3 + .7*r595*TERPF1O2*NO - + .5*r598*TERPF2*NO3 + .7*r600*TERPF2O2*NO + r603*TERPFDN*OH + .7*r607*TERPNPS1O2*NO - + .7*r611*TERPNPT1O2*NO + .7*r615*TERPNS1O2*NO + r617*TERPNS*OH + .7*r619*TERPNT1O2*NO - + r621*TERPNT*OH - - j16*NO2 - r664*NO2 - r28*N*NO2 - r29*N*NO2 - r30*N*NO2 - r32*O*NO2 - r33*O3*NO2 + + r63*CLO*NO + r95*BRO*NO + r138*CH3O2*NO + r147*HOCH2OO*NO + r160*C2H5O2*NO + r171*CH3CO3*NO + + r175*EO2*NO + r181*NO3CH2CHO*OH + r190*C3H7O2*NO + r197*NOA*OH + r199*PO2*NO + r203*RO2*NO + + r207*BIGENE*NO3 + r210*ENEO2*NO + .5*r213*MACRN*OH + r225*MCO3*NO + r226*MCO3*NO3 + + r228*MEKO2*NO + r241*ALKNIT*OH + r243*ALKO2*NO + .4*r255*INHEB*OH + .19*r256*INHED*OH + + r285*ISOPFDNC*OH + .5*r287*ISOPFNC*OH + .17*r292*ISOPN1D*O3 + .08*r293*ISOPN1D*OH + + .46*r294*ISOPN2BO2*HO2 + .15*r296*ISOPN2B*OH + .13*r299*ISOPN3B*OH + .17*r302*ISOPN4D*O3 + + .04*r303*ISOPN4D*OH + .46*r307*ISOPNO3*CH3CO3 + .07*r308*ISOPNO3*CH3O2 + .24*r309*ISOPNO3*HO2 + + .16*r310*ISOPNO3*ISOPNO3 + 1.46*r311*ISOPNO3*NO3 + .17*r317*ISOPNOOHD*O3 + .07*r318*ISOPNOOHD*OH + + .17*r334*NC4CHO*O3 + .04*r335*NC4CHO*OH + r336*IEPOXOO*NO + r338*ISOPB1O2*NO + r340*ISOPB4O2*NO + + r342*ISOPED1O2*NO + r344*ISOPED4O2*NO + r346*ISOPN1DO2*NO + 1.73*r348*ISOPN2BO2*NO + + r350*ISOPN3BO2*NO + r352*ISOPN4DO2*NO + r354*ISOPNBNO3O2*NO + 1.46*r356*ISOPNO3*NO + + r358*ISOPNOOHBO2*NO + r360*ISOPNOOHDO2*NO + r363*ISOPZD1O2*NO + r366*ISOPZD4O2*NO + + r368*MACRO2*NO + r370*MVKO2*NO + r372*NC4CHOO2*NO + r375*ACBZO2*NO + r378*BENZO2*NO + + r383*BZOO*NO + r385*C6H5O2*NO + r389*DICARBO2*NO + r392*MALO2*NO + r395*MDIALO2*NO + + r398*PHENO2*NO + r405*TOLO2*NO + r411*XYLENO2*NO + r414*XYLOLO2*NO + 1.64*r418*APINNO3*APINNO3 + + r419*APINNO3*CH3CO3 + .82*r420*APINNO3*CH3O2 + .7*r421*APINNO3*HO2 + 1.86*r422*APINNO3*NO + + 2*r423*APINNO3*NO3 + r424*APINNO3*TERPA2CO3 + r425*APINNO3*TERPA3CO3 + r426*APINNO3*TERPACO3 + + .77*r430*APINO2*NO + r431*APINO2*NO3 + 1.64*r438*BCARYNO3*BCARYNO3 + r439*BCARYNO3*CH3CO3 + + .82*r440*BCARYNO3*CH3O2 + .5*r441*BCARYNO3*HO2 + 1.86*r442*BCARYNO3*NO + 2*r443*BCARYNO3*NO3 + + r444*BCARYNO3*TERPA2CO3 + r445*BCARYNO3*TERPA3CO3 + r446*BCARYNO3*TERPACO3 + .7*r450*BCARYO2*NO + + r451*BCARYO2*NO3 + .94*r458*BPINNO3*BPINNO3 + .5*r459*BPINNO3*CH3CO3 + .36*r460*BPINNO3*CH3O2 + + .24*r461*BPINNO3*HO2 + 1.39*r462*BPINNO3*NO + 1.5*r463*BPINNO3*NO3 + .5*r464*BPINNO3*TERPA2CO3 + + .5*r465*BPINNO3*TERPA3CO3 + .5*r466*BPINNO3*TERPACO3 + .75*r470*BPINO2*NO + r471*BPINO2*NO3 + + .46*r478*LIMONNO3*CH3CO3 + .31*r479*LIMONNO3*CH3O2 + .23*r480*LIMONNO3*HO2 + + .86*r481*LIMONNO3*LIMONNO3 + 1.36*r482*LIMONNO3*NO + 1.46*r483*LIMONNO3*NO3 + + .46*r484*LIMONNO3*TERPA2CO3 + .46*r485*LIMONNO3*TERPA3CO3 + .46*r486*LIMONNO3*TERPACO3 + + .77*r490*LIMONO2*NO + r491*LIMONO2*NO3 + .95*r498*MYRCNO3*CH3CO3 + .77*r499*MYRCNO3*CH3O2 + + .48*r500*MYRCNO3*HO2 + 1.54*r501*MYRCNO3*MYRCNO3 + 1.8200001*r502*MYRCNO3*NO + + 1.95*r503*MYRCNO3*NO3 + .95*r504*MYRCNO3*TERPA2CO3 + .95*r505*MYRCNO3*TERPA3CO3 + + .95*r506*MYRCNO3*TERPACO3 + .71*r510*MYRCO2*NO + r511*MYRCO2*NO3 + .7*r521*TERP1OOHO2*NO + + .7*r525*TERP2OOHO2*NO + .7*r529*TERPA1O2*NO + r530*TERPA1O2*NO3 + r537*TERPA2CO3*NO + + r538*TERPA2CO3*NO3 + .83*r545*TERPA2O2*NO + r546*TERPA2O2*NO3 + r551*TERPA2PAN*OH + + r555*TERPA3CO3*NO + r556*TERPA3CO3*NO3 + .7*r564*TERPA3O2*NO + r565*TERPA3O2*NO3 + + r570*TERPA3PAN*OH + .91*r574*TERPA4O2*NO + r575*TERPA4O2*NO3 + r585*TERPACO3*NO + + r586*TERPACO3*NO3 + r590*TERPAPAN*OH + r592*TERPF1*NO3 + .7*r594*TERPF1O2*NO + + .5*r597*TERPF2*NO3 + .7*r599*TERPF2O2*NO + r602*TERPFDN*OH + .7*r606*TERPNPS1O2*NO + + .7*r610*TERPNPT1O2*NO + .7*r614*TERPNS1O2*NO + r616*TERPNS*OH + .7*r618*TERPNT1O2*NO + + r620*TERPNT*OH + - j16*NO2 - r663*NO2 - r28*N*NO2 - r29*N*NO2 - r30*N*NO2 - r32*O*NO2 - r33*O3*NO2 - r34*M*O*NO2 - r45*M*HO2*NO2 - r46*M*NO3*NO2 - r47*M*OH*NO2 - r65*M*CLO*NO2 - r96*M*BRO*NO2 - - r185*M*CH3CO3*NO2 - r240*M*MCO3*NO2 - r391*M*DICARBO2*NO2 - r394*M*MALO2*NO2 - - r397*M*MDIALO2*NO2 - r401*PHENO*NO2 - r404*M*ACBZO2*NO2 - r518*M*TERPA2CO3*NO2 - - r519*M*TERPA3CO3*NO2 - r520*M*TERPACO3*NO2 - r636*SO*NO2 + - r184*M*CH3CO3*NO2 - r239*M*MCO3*NO2 - r390*M*DICARBO2*NO2 - r393*M*MALO2*NO2 + - r396*M*MDIALO2*NO2 - r400*PHENO*NO2 - r403*M*ACBZO2*NO2 - r517*M*TERPA2CO3*NO2 + - r518*M*TERPA3CO3*NO2 - r519*M*TERPACO3*NO2 - r636*SO*NO2 d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j86*PAN + j121*BRONO2 + j138*CLONO2 + r50*M*N2O5 + r33*NO2*O3 + r34*M*NO2*O + r48*HNO3*OH + r64*CLONO2*CL + r66*CLONO2*O + r67*CLONO2*OH - + r97*BRONO2*O + r111*F*HNO3 + r183*PAN*OH + r232*M*MPAN*OH - - j17*NO3 - j18*NO3 - r665*NO3 - r35*HO2*NO3 - r36*NO*NO3 - r37*O*NO3 - r38*OH*NO3 - - r46*M*NO2*NO3 - r132*CH2O*NO3 - r166*CH3CHO*NO3 - r187*C3H6*NO3 - r194*CH3COCHO*NO3 - - r208*BIGENE*NO3 - r227*MCO3*NO3 - r307*ISOP*NO3 - r312*ISOPNO3*NO3 - r418*APIN*NO3 - - r424*APINNO3*NO3 - r432*APINO2*NO3 - r438*BCARY*NO3 - r444*BCARYNO3*NO3 - r452*BCARYO2*NO3 - - r458*BPIN*NO3 - r464*BPINNO3*NO3 - r472*BPINO2*NO3 - r478*LIMON*NO3 - r484*LIMONNO3*NO3 - - r492*LIMONO2*NO3 - r498*MYRC*NO3 - r504*MYRCNO3*NO3 - r512*MYRCO2*NO3 - r531*TERPA1O2*NO3 - - r539*TERPA2CO3*NO3 - r542*TERPA2*NO3 - r547*TERPA2O2*NO3 - r557*TERPA3CO3*NO3 - r561*TERPA3*NO3 - - r566*TERPA3O2*NO3 - r576*TERPA4O2*NO3 - r587*TERPACO3*NO3 - r589*TERPA*NO3 - r593*TERPF1*NO3 - - r598*TERPF2*NO3 - r627*DMS*NO3 - d(NO3CH2CHO)/dt = .25*j80*MVKN + .44*r301*ISOPN4DO2*HO2 + .83*r303*ISOPN4D*O3 + .15*r305*ISOPNBNO3O2*HO2 - + .06*r313*ISOPNOOHBO2*HO2 + .12*r316*ISOPNOOHDO2*HO2 + .13*r318*ISOPNOOHD*O3 - + .1*r333*NC4CHOO2*HO2 + .22*r335*NC4CHO*O3 + .1*r336*NC4CHO*OH + .87*r353*ISOPN4DO2*NO - + .33*r355*ISOPNBNO3O2*NO + .07*r359*ISOPNOOHBO2*NO + .15*r361*ISOPNOOHDO2*NO - + .12*r373*NC4CHOO2*NO - - j83*NO3CH2CHO - r182*OH*NO3CH2CHO - d(NOA)/dt = .25*j74*MACRN + r187*C3H6*NO3 + .5*r214*MACRN*OH + .5*r233*MVKN*OH + .35*r257*INHED*OH - + .55*r291*ISOPN1DO2*HO2 + .83*r293*ISOPN1D*O3 + .15*r305*ISOPNBNO3O2*HO2 - + .28*r313*ISOPNOOHBO2*HO2 + .68*r316*ISOPNOOHDO2*HO2 + .7*r318*ISOPNOOHD*O3 - + .1*r333*NC4CHOO2*HO2 + .61*r335*NC4CHO*O3 + .35*r336*NC4CHO*OH + .94*r347*ISOPN1DO2*NO - + .34*r355*ISOPNBNO3O2*NO + .4*r359*ISOPNOOHBO2*NO + .81*r361*ISOPNOOHDO2*NO - + .13*r373*NC4CHOO2*NO - - j84*NOA - r198*OH*NOA + + r97*BRONO2*O + r111*F*HNO3 + r182*PAN*OH + r231*M*MPAN*OH + - j17*NO3 - j18*NO3 - r664*NO3 - r35*HO2*NO3 - r36*NO*NO3 - r37*O*NO3 - r38*OH*NO3 + - r46*M*NO2*NO3 - r132*CH2O*NO3 - r165*CH3CHO*NO3 - r186*C3H6*NO3 - r193*CH3COCHO*NO3 + - r207*BIGENE*NO3 - r226*MCO3*NO3 - r306*ISOP*NO3 - r311*ISOPNO3*NO3 - r417*APIN*NO3 + - r423*APINNO3*NO3 - r431*APINO2*NO3 - r437*BCARY*NO3 - r443*BCARYNO3*NO3 - r451*BCARYO2*NO3 + - r457*BPIN*NO3 - r463*BPINNO3*NO3 - r471*BPINO2*NO3 - r477*LIMON*NO3 - r483*LIMONNO3*NO3 + - r491*LIMONO2*NO3 - r497*MYRC*NO3 - r503*MYRCNO3*NO3 - r511*MYRCO2*NO3 - r530*TERPA1O2*NO3 + - r538*TERPA2CO3*NO3 - r541*TERPA2*NO3 - r546*TERPA2O2*NO3 - r556*TERPA3CO3*NO3 - r560*TERPA3*NO3 + - r565*TERPA3O2*NO3 - r575*TERPA4O2*NO3 - r586*TERPACO3*NO3 - r588*TERPA*NO3 - r592*TERPF1*NO3 + - r597*TERPF2*NO3 - r626*DMS*NO3 + d(NO3CH2CHO)/dt = .25*j80*MVKN + .44*r300*ISOPN4DO2*HO2 + .83*r302*ISOPN4D*O3 + .15*r304*ISOPNBNO3O2*HO2 + + .06*r312*ISOPNOOHBO2*HO2 + .12*r315*ISOPNOOHDO2*HO2 + .13*r317*ISOPNOOHD*O3 + + .1*r332*NC4CHOO2*HO2 + .22*r334*NC4CHO*O3 + .1*r335*NC4CHO*OH + .87*r352*ISOPN4DO2*NO + + .33*r354*ISOPNBNO3O2*NO + .07*r358*ISOPNOOHBO2*NO + .15*r360*ISOPNOOHDO2*NO + + .12*r372*NC4CHOO2*NO + - j83*NO3CH2CHO - r181*OH*NO3CH2CHO + d(NOA)/dt = .25*j74*MACRN + r186*C3H6*NO3 + .5*r213*MACRN*OH + .5*r232*MVKN*OH + .35*r256*INHED*OH + + .55*r290*ISOPN1DO2*HO2 + .83*r292*ISOPN1D*O3 + .15*r304*ISOPNBNO3O2*HO2 + + .28*r312*ISOPNOOHBO2*HO2 + .68*r315*ISOPNOOHDO2*HO2 + .7*r317*ISOPNOOHD*O3 + + .1*r332*NC4CHOO2*HO2 + .61*r334*NC4CHO*O3 + .35*r335*NC4CHO*OH + .94*r346*ISOPN1DO2*NO + + .34*r354*ISOPNBNO3O2*NO + .4*r358*ISOPNOOHBO2*NO + .81*r360*ISOPNOOHDO2*NO + + .13*r372*NC4CHOO2*NO + - j84*NOA - r197*OH*NOA d(num_a1)/dt = 0 d(num_a2)/dt = 0 d(num_a3)/dt = 0 d(num_a4)/dt = 0 d(O)/dt = j5*O2 + 2*j6*O2 + j3*H2O + j8*O3 + j14*N2O5 + j15*NO + j16*NO2 + j18*NO3 + .18*j39*CH4 + j40*CO2 + j119*BRO + j137*CLO + j151*OCLO + j155*SO + j156*SO2 + j157*SO3 + r3*N2*O1D - + r4*O2*O1D + r31*O2*N + r631*O2*S + r637*O2*SO + r13*H*HO2 + r23*OH*OH + r27*N*NO + r28*N*NO2 + + r4*O2*O1D + r31*O2*N + r630*O2*S + r637*O2*SO + r13*H*HO2 + r23*OH*OH + r27*N*NO + r28*N*NO2 - r8*O2*M*O - r6*O3*O - 2*r7*M*O*O - r9*H2*O - r10*H2O2*O - r15*HO2*O - r21*OH*O - r32*NO2*O - r34*M*NO2*O - r37*NO3*O - r42*M*NO*O - r66*CLONO2*O - r68*CLO*O - r71*HCL*O - r74*HOCL*O - - r97*BRONO2*O - r98*BRO*O - r100*HBR*O - r102*HOBR*O - r133*CH2O*O - r629*OCS*O - d(O3)/dt = r8*O2*M*O + .15*r171*CH3CO3*HO2 + .15*r224*MCO3*HO2 + .15*r537*TERPA2CO3*HO2 - + .15*r555*TERPA3CO3*HO2 + .15*r585*TERPACO3*HO2 + - r97*BRONO2*O - r98*BRO*O - r100*HBR*O - r102*HOBR*O - r133*CH2O*O - r628*OCS*O + d(O3)/dt = r8*O2*M*O + .15*r170*CH3CO3*HO2 + .15*r223*MCO3*HO2 + .15*r536*TERPA2CO3*HO2 + + .15*r554*TERPA3CO3*HO2 + .15*r584*TERPACO3*HO2 - j7*O3 - j8*O3 - r5*O1D*O3 - r6*O*O3 - r16*HO2*O3 - r17*H*O3 - r22*OH*O3 - r33*NO2*O3 - - r41*NO*O3 - r57*CL*O3 - r89*BR*O3 - r157*C2H4*O3 - r188*C3H6*O3 - r219*MACR*O3 - r237*MVK*O3 - - r293*ISOPN1D*O3 - r303*ISOPN4D*O3 - r318*ISOPNOOHD*O3 - r320*ISOP*O3 - r335*NC4CHO*O3 - - r402*PHENO*O3 - r436*APIN*O3 - r456*BCARY*O3 - r476*BPIN*O3 - r496*LIMON*O3 - r516*MYRC*O3 - - r596*TERPF1*O3 - r601*TERPF2*O3 - r632*S*O3 - r638*SO*O3 + - r41*NO*O3 - r57*CL*O3 - r89*BR*O3 - r156*C2H4*O3 - r187*C3H6*O3 - r218*MACR*O3 - r236*MVK*O3 + - r292*ISOPN1D*O3 - r302*ISOPN4D*O3 - r317*ISOPNOOHD*O3 - r319*ISOP*O3 - r334*NC4CHO*O3 + - r401*PHENO*O3 - r435*APIN*O3 - r455*BCARY*O3 - r475*BPIN*O3 - r495*LIMON*O3 - r515*MYRC*O3 + - r595*TERPF1*O3 - r600*TERPF2*O3 - r632*S*O3 - r638*SO*O3 d(O3S)/dt = 0 d(OCLO)/dt = r61*CLO*CLO + r91*BRO*CLO - j151*OCLO - r639*SO*OCLO - d(OCS)/dt = - j154*OCS - r629*O*OCS - r630*OH*OCS - d(ONITR)/dt = r213*HONITR*OH + .5*r233*MVKN*OH - - j85*ONITR - r666*ONITR - d(PAN)/dt = r185*M*CH3CO3*NO2 - - j86*PAN - r186*M*PAN - r183*OH*PAN - d(PBZNIT)/dt = r404*M*ACBZO2*NO2 - - r409*M*PBZNIT - d(PHENO)/dt = j30*C6H5OOH + r386*C6H5O2*NO + .07*r388*CRESOL*OH + .06*r400*PHENOL*OH + .07*r416*XYLOL*OH - - r401*NO2*PHENO - r402*O3*PHENO - d(PHENOL)/dt = .53*r377*BENZENE*OH - - r400*OH*PHENOL - d(PHENOOH)/dt = r398*PHENO2*HO2 - - j87*PHENOOH - r403*OH*PHENOOH + d(OCS)/dt = - j154*OCS - r628*O*OCS - r629*OH*OCS + d(ONITR)/dt = r212*HONITR*OH + .5*r232*MVKN*OH + - j85*ONITR - r665*ONITR + d(PAN)/dt = r184*M*CH3CO3*NO2 + - j86*PAN - r185*M*PAN - r182*OH*PAN + d(PBZNIT)/dt = r403*M*ACBZO2*NO2 + - r408*M*PBZNIT + d(PHENO)/dt = j30*C6H5OOH + r385*C6H5O2*NO + .07*r387*CRESOL*OH + .06*r399*PHENOL*OH + .07*r415*XYLOL*OH + - r400*NO2*PHENO - r401*O3*PHENO + d(PHENOL)/dt = .53*r376*BENZENE*OH + - r399*OH*PHENOL + d(PHENOOH)/dt = r397*PHENO2*HO2 + - j87*PHENOOH - r402*OH*PHENOOH d(pom_a1)/dt = 0 d(pom_a4)/dt = 0 - d(POOH)/dt = r199*PO2*HO2 - - j88*POOH - r201*OH*POOH - d(ROOH)/dt = .85*r203*RO2*HO2 - - j89*ROOH - r205*OH*ROOH + d(POOH)/dt = r198*PO2*HO2 + - j88*POOH - r200*OH*POOH + d(ROOH)/dt = .85*r202*RO2*HO2 + - j89*ROOH - r204*OH*ROOH d(S)/dt = j154*OCS + j155*SO - - r631*O2*S - r632*O3*S - r635*OH*S + - r630*O2*S - r632*O3*S - r635*OH*S d(SF6)/dt = - j152*SF6 - d(SO)/dt = j156*SO2 + r631*O2*S + r629*OCS*O + r632*S*O3 + r635*S*OH + d(SO)/dt = j156*SO2 + r630*O2*S + r628*OCS*O + r632*S*O3 + r635*S*OH - j155*SO - r637*O2*SO - r633*BRO*SO - r634*CLO*SO - r636*NO2*SO - r638*O3*SO - r639*OCLO*SO - r640*OH*SO - d(SO2)/dt = j157*SO3 + r637*O2*SO + r627*DMS*NO3 + r628*DMS*OH + r630*OCS*OH + r633*SO*BRO + r634*SO*CLO + d(SO2)/dt = j157*SO3 + r637*O2*SO + r626*DMS*NO3 + r627*DMS*OH + r629*OCS*OH + r633*SO*BRO + r634*SO*CLO + r636*SO*NO2 + r638*SO*O3 + r639*SO*OCLO + r640*SO*OH + .5*r641*DMS*OH - - j156*SO2 - r642*OH*SO2 - d(SO3)/dt = j153*H2SO4 + r642*SO2*OH - - j157*SO3 - r643*H2O*SO3 + - j156*SO2 - r631*M*OH*SO2 + d(SO3)/dt = j153*H2SO4 + r631*M*SO2*OH + - j157*SO3 - r642*H2O*SO3 d(so4_a1)/dt = 0 d(so4_a2)/dt = 0 d(so4_a3)/dt = 0 @@ -2559,289 +2553,289 @@ Extraneous prod/loss species d(soa4_a2)/dt = - j165*soa4_a2 d(soa5_a1)/dt = - j166*soa5_a1 d(soa5_a2)/dt = - j167*soa5_a2 - d(SOAG0)/dt = r645*GLYOXAL + .0508*r676*APINO2VBS*HO2 + .0245*r677*APINO2VBS*NO + .0508*r678*APIN*O3 - + .2202*r681*BCARYO2VBS*HO2 + .1279*r682*BCARYO2VBS*NO + .2202*r683*BCARY*O3 - + .0023*r686*BENZO2VBS*HO2 + .0097*r687*BENZO2VBS*NO + .0508*r689*BPINO2VBS*HO2 - + .0245*r690*BPINO2VBS*NO + .0508*r691*BPIN*O3 + .0031*r694*ISOPO2VBS*HO2 - + .0003*r695*ISOPO2VBS*NO + .2381*r698*IVOCO2VBS*HO2 + .1056*r699*IVOCO2VBS*NO - + .0508*r702*LIMONO2VBS*HO2 + .0245*r703*LIMONO2VBS*NO + .0508*r704*LIMON*O3 - + .0508*r707*MYRCO2VBS*HO2 + .0245*r708*MYRCO2VBS*NO + .0508*r709*MYRC*O3 + .5931*r711*SVOC*OH - + .1364*r713*TOLUO2VBS*HO2 + .0154*r714*TOLUO2VBS*NO + .1677*r716*XYLEO2VBS*HO2 - + .0063*r717*XYLEO2VBS*NO - d(SOAG1)/dt = .1149*r676*APINO2VBS*HO2 + .0082*r677*APINO2VBS*NO + .1149*r678*APIN*O3 - + .2067*r681*BCARYO2VBS*HO2 + .1792*r682*BCARYO2VBS*NO + .2067*r683*BCARY*O3 - + .0008*r686*BENZO2VBS*HO2 + .0034*r687*BENZO2VBS*NO + .1149*r689*BPINO2VBS*HO2 - + .0082*r690*BPINO2VBS*NO + .1149*r691*BPIN*O3 + .0035*r694*ISOPO2VBS*HO2 - + .0003*r695*ISOPO2VBS*NO + .1308*r698*IVOCO2VBS*HO2 + .1026*r699*IVOCO2VBS*NO - + .1149*r702*LIMONO2VBS*HO2 + .0082*r703*LIMONO2VBS*NO + .1149*r704*LIMON*O3 - + .1149*r707*MYRCO2VBS*HO2 + .0082*r708*MYRCO2VBS*NO + .1149*r709*MYRC*O3 + .1534*r711*SVOC*OH - + .0101*r713*TOLUO2VBS*HO2 + .0452*r714*TOLUO2VBS*NO + .0174*r716*XYLEO2VBS*HO2 - + .0237*r717*XYLEO2VBS*NO - d(SOAG2)/dt = .0348*r676*APINO2VBS*HO2 + .0772*r677*APINO2VBS*NO + .0348*r678*APIN*O3 - + .0653*r681*BCARYO2VBS*HO2 + .0676*r682*BCARYO2VBS*NO + .0653*r683*BCARY*O3 - + .0843*r686*BENZO2VBS*HO2 + .1579*r687*BENZO2VBS*NO + .0348*r689*BPINO2VBS*HO2 - + .0772*r690*BPINO2VBS*NO + .0348*r691*BPIN*O3 + .0003*r694*ISOPO2VBS*HO2 - + .0073*r695*ISOPO2VBS*NO + .0348*r698*IVOCO2VBS*HO2 + .0521*r699*IVOCO2VBS*NO - + .0348*r702*LIMONO2VBS*HO2 + .0772*r703*LIMONO2VBS*NO + .0348*r704*LIMON*O3 - + .0348*r707*MYRCO2VBS*HO2 + .0772*r708*MYRCO2VBS*NO + .0348*r709*MYRC*O3 + .0459*r711*SVOC*OH - + .0763*r713*TOLUO2VBS*HO2 + .0966*r714*TOLUO2VBS*NO + .086*r716*XYLEO2VBS*HO2 - + .0025*r717*XYLEO2VBS*NO - d(SOAG3)/dt = .17493*r675*APIN*NO3 + .0554*r676*APINO2VBS*HO2 + .0332*r677*APINO2VBS*NO + .0554*r678*APIN*O3 - + .17493*r680*BCARY*NO3 + .1284*r681*BCARYO2VBS*HO2 + .079*r682*BCARYO2VBS*NO - + .1284*r683*BCARY*O3 + .0443*r686*BENZO2VBS*HO2 + .0059*r687*BENZO2VBS*NO - + .17493*r688*BPIN*NO3 + .0554*r689*BPINO2VBS*HO2 + .0332*r690*BPINO2VBS*NO + .0554*r691*BPIN*O3 - + .059024*r693*ISOP*NO3 + .0271*r694*ISOPO2VBS*HO2 + .0057*r695*ISOPO2VBS*NO - + .0033*r696*ISOP*O3 + .0076*r698*IVOCO2VBS*HO2 + .0143*r699*IVOCO2VBS*NO - + .17493*r701*LIMON*NO3 + .0554*r702*LIMONO2VBS*HO2 + .0332*r703*LIMONO2VBS*NO - + .0554*r704*LIMON*O3 + .17493*r706*MYRC*NO3 + .0554*r707*MYRCO2VBS*HO2 - + .0332*r708*MYRCO2VBS*NO + .0554*r709*MYRC*O3 + .0085*r711*SVOC*OH + .2157*r713*TOLUO2VBS*HO2 - + .0073*r714*TOLUO2VBS*NO + .0512*r716*XYLEO2VBS*HO2 + .011*r717*XYLEO2VBS*NO - d(SOAG4)/dt = .59019*r675*APIN*NO3 + .1278*r676*APINO2VBS*HO2 + .13*r677*APINO2VBS*NO + .1278*r678*APIN*O3 - + .59019*r680*BCARY*NO3 + .114*r681*BCARYO2VBS*HO2 + .1254*r682*BCARYO2VBS*NO - + .114*r683*BCARY*O3 + .1621*r686*BENZO2VBS*HO2 + .0536*r687*BENZO2VBS*NO + .59019*r688*BPIN*NO3 - + .1278*r689*BPINO2VBS*HO2 + .13*r690*BPINO2VBS*NO + .1278*r691*BPIN*O3 + .025024*r693*ISOP*NO3 - + .0474*r694*ISOPO2VBS*HO2 + .0623*r695*ISOPO2VBS*NO + .0113*r698*IVOCO2VBS*HO2 - + .0166*r699*IVOCO2VBS*NO + .59019*r701*LIMON*NO3 + .1278*r702*LIMONO2VBS*HO2 - + .13*r703*LIMONO2VBS*NO + .1278*r704*LIMON*O3 + .59019*r706*MYRC*NO3 + .1278*r707*MYRCO2VBS*HO2 - + .13*r708*MYRCO2VBS*NO + .1278*r709*MYRC*O3 + .0128*r711*SVOC*OH + .0738*r713*TOLUO2VBS*HO2 - + .238*r714*TOLUO2VBS*NO + .1598*r716*XYLEO2VBS*HO2 + .1185*r717*XYLEO2VBS*NO - d(SQTN)/dt = .36*r439*BCARYNO3*BCARYNO3 + .18*r441*BCARYNO3*CH3O2 + .5*r442*BCARYNO3*HO2 + .07*r443*BCARYNO3*NO - + .3*r451*BCARYO2*NO - - r667*SQTN - d(ST80_25)/dt = - r738*ST80_25 - d(SVOC)/dt = - r711*OH*SVOC - d(TEPOMUC)/dt = .1*r408*TOLUENE*OH + .23*r410*XYLENES*OH + d(SOAG0)/dt = r644*GLYOXAL + .0508*r675*APINO2VBS*HO2 + .0245*r676*APINO2VBS*NO + .0508*r677*APIN*O3 + + .2202*r680*BCARYO2VBS*HO2 + .1279*r681*BCARYO2VBS*NO + .2202*r682*BCARY*O3 + + .0023*r685*BENZO2VBS*HO2 + .0097*r686*BENZO2VBS*NO + .0508*r688*BPINO2VBS*HO2 + + .0245*r689*BPINO2VBS*NO + .0508*r690*BPIN*O3 + .0031*r693*ISOPO2VBS*HO2 + + .0003*r694*ISOPO2VBS*NO + .2381*r697*IVOCO2VBS*HO2 + .1056*r698*IVOCO2VBS*NO + + .0508*r701*LIMONO2VBS*HO2 + .0245*r702*LIMONO2VBS*NO + .0508*r703*LIMON*O3 + + .0508*r706*MYRCO2VBS*HO2 + .0245*r707*MYRCO2VBS*NO + .0508*r708*MYRC*O3 + .5931*r710*SVOC*OH + + .1364*r712*TOLUO2VBS*HO2 + .0154*r713*TOLUO2VBS*NO + .1677*r715*XYLEO2VBS*HO2 + + .0063*r716*XYLEO2VBS*NO + d(SOAG1)/dt = .1149*r675*APINO2VBS*HO2 + .0082*r676*APINO2VBS*NO + .1149*r677*APIN*O3 + + .2067*r680*BCARYO2VBS*HO2 + .1792*r681*BCARYO2VBS*NO + .2067*r682*BCARY*O3 + + .0008*r685*BENZO2VBS*HO2 + .0034*r686*BENZO2VBS*NO + .1149*r688*BPINO2VBS*HO2 + + .0082*r689*BPINO2VBS*NO + .1149*r690*BPIN*O3 + .0035*r693*ISOPO2VBS*HO2 + + .0003*r694*ISOPO2VBS*NO + .1308*r697*IVOCO2VBS*HO2 + .1026*r698*IVOCO2VBS*NO + + .1149*r701*LIMONO2VBS*HO2 + .0082*r702*LIMONO2VBS*NO + .1149*r703*LIMON*O3 + + .1149*r706*MYRCO2VBS*HO2 + .0082*r707*MYRCO2VBS*NO + .1149*r708*MYRC*O3 + .1534*r710*SVOC*OH + + .0101*r712*TOLUO2VBS*HO2 + .0452*r713*TOLUO2VBS*NO + .0174*r715*XYLEO2VBS*HO2 + + .0237*r716*XYLEO2VBS*NO + d(SOAG2)/dt = .0348*r675*APINO2VBS*HO2 + .0772*r676*APINO2VBS*NO + .0348*r677*APIN*O3 + + .0653*r680*BCARYO2VBS*HO2 + .0676*r681*BCARYO2VBS*NO + .0653*r682*BCARY*O3 + + .0843*r685*BENZO2VBS*HO2 + .1579*r686*BENZO2VBS*NO + .0348*r688*BPINO2VBS*HO2 + + .0772*r689*BPINO2VBS*NO + .0348*r690*BPIN*O3 + .0003*r693*ISOPO2VBS*HO2 + + .0073*r694*ISOPO2VBS*NO + .0348*r697*IVOCO2VBS*HO2 + .0521*r698*IVOCO2VBS*NO + + .0348*r701*LIMONO2VBS*HO2 + .0772*r702*LIMONO2VBS*NO + .0348*r703*LIMON*O3 + + .0348*r706*MYRCO2VBS*HO2 + .0772*r707*MYRCO2VBS*NO + .0348*r708*MYRC*O3 + .0459*r710*SVOC*OH + + .0763*r712*TOLUO2VBS*HO2 + .0966*r713*TOLUO2VBS*NO + .086*r715*XYLEO2VBS*HO2 + + .0025*r716*XYLEO2VBS*NO + d(SOAG3)/dt = .17493*r674*APIN*NO3 + .0554*r675*APINO2VBS*HO2 + .0332*r676*APINO2VBS*NO + .0554*r677*APIN*O3 + + .17493*r679*BCARY*NO3 + .1284*r680*BCARYO2VBS*HO2 + .079*r681*BCARYO2VBS*NO + + .1284*r682*BCARY*O3 + .0443*r685*BENZO2VBS*HO2 + .0059*r686*BENZO2VBS*NO + + .17493*r687*BPIN*NO3 + .0554*r688*BPINO2VBS*HO2 + .0332*r689*BPINO2VBS*NO + .0554*r690*BPIN*O3 + + .059024*r692*ISOP*NO3 + .0271*r693*ISOPO2VBS*HO2 + .0057*r694*ISOPO2VBS*NO + + .0033*r695*ISOP*O3 + .0076*r697*IVOCO2VBS*HO2 + .0143*r698*IVOCO2VBS*NO + + .17493*r700*LIMON*NO3 + .0554*r701*LIMONO2VBS*HO2 + .0332*r702*LIMONO2VBS*NO + + .0554*r703*LIMON*O3 + .17493*r705*MYRC*NO3 + .0554*r706*MYRCO2VBS*HO2 + + .0332*r707*MYRCO2VBS*NO + .0554*r708*MYRC*O3 + .0085*r710*SVOC*OH + .2157*r712*TOLUO2VBS*HO2 + + .0073*r713*TOLUO2VBS*NO + .0512*r715*XYLEO2VBS*HO2 + .011*r716*XYLEO2VBS*NO + d(SOAG4)/dt = .59019*r674*APIN*NO3 + .1278*r675*APINO2VBS*HO2 + .13*r676*APINO2VBS*NO + .1278*r677*APIN*O3 + + .59019*r679*BCARY*NO3 + .114*r680*BCARYO2VBS*HO2 + .1254*r681*BCARYO2VBS*NO + + .114*r682*BCARY*O3 + .1621*r685*BENZO2VBS*HO2 + .0536*r686*BENZO2VBS*NO + .59019*r687*BPIN*NO3 + + .1278*r688*BPINO2VBS*HO2 + .13*r689*BPINO2VBS*NO + .1278*r690*BPIN*O3 + .025024*r692*ISOP*NO3 + + .0474*r693*ISOPO2VBS*HO2 + .0623*r694*ISOPO2VBS*NO + .0113*r697*IVOCO2VBS*HO2 + + .0166*r698*IVOCO2VBS*NO + .59019*r700*LIMON*NO3 + .1278*r701*LIMONO2VBS*HO2 + + .13*r702*LIMONO2VBS*NO + .1278*r703*LIMON*O3 + .59019*r705*MYRC*NO3 + .1278*r706*MYRCO2VBS*HO2 + + .13*r707*MYRCO2VBS*NO + .1278*r708*MYRC*O3 + .0128*r710*SVOC*OH + .0738*r712*TOLUO2VBS*HO2 + + .238*r713*TOLUO2VBS*NO + .1598*r715*XYLEO2VBS*HO2 + .1185*r716*XYLEO2VBS*NO + d(SQTN)/dt = .36*r438*BCARYNO3*BCARYNO3 + .18*r440*BCARYNO3*CH3O2 + .5*r441*BCARYNO3*HO2 + .07*r442*BCARYNO3*NO + + .3*r450*BCARYO2*NO + - r666*SQTN + d(ST80_25)/dt = - r737*ST80_25 + d(SVOC)/dt = - r710*OH*SVOC + d(TEPOMUC)/dt = .1*r407*TOLUENE*OH + .23*r409*XYLENES*OH - j90*TEPOMUC - d(TERP1OOH)/dt = .14*r428*APINO2*CH3CO3 + .13*r429*APINO2*CH3O2 + .25*r430*APINO2*HO2 + .11*r431*APINO2*NO - + .14*r432*APINO2*NO3 + .14*r433*APINO2*TERPA2CO3 + .14*r434*APINO2*TERPA3CO3 - + .14*r435*APINO2*TERPACO3 + .68*r470*BPINO2*HO2 + .9*r490*LIMONO2*HO2 - + .18*r525*TERP2OOHO2*HO2 + .7*r526*TERP2OOHO2*NO + .9*r599*TERPF2O2*HO2 - - j91*TERP1OOH - r523*OH*TERP1OOH - d(TERP2AOOH)/dt = .9*r450*BCARYO2*HO2 + .9*r510*MYRCO2*HO2 - - j92*TERP2AOOH - r524*OH*TERP2AOOH + d(TERP1OOH)/dt = .14*r427*APINO2*CH3CO3 + .13*r428*APINO2*CH3O2 + .25*r429*APINO2*HO2 + .11*r430*APINO2*NO + + .14*r431*APINO2*NO3 + .14*r432*APINO2*TERPA2CO3 + .14*r433*APINO2*TERPA3CO3 + + .14*r434*APINO2*TERPACO3 + .68*r469*BPINO2*HO2 + .9*r489*LIMONO2*HO2 + + .18*r524*TERP2OOHO2*HO2 + .7*r525*TERP2OOHO2*NO + .9*r598*TERPF2O2*HO2 + - j91*TERP1OOH - r522*OH*TERP1OOH + d(TERP2AOOH)/dt = .9*r449*BCARYO2*HO2 + .9*r509*MYRCO2*HO2 + - j92*TERP2AOOH - r523*OH*TERP2AOOH d(TERPA)/dt = .5*j105*TERPNPS + j107*TERPNPT + j109*TERPNS + j111*TERPNT + j113*TERPOOH - + 1.64*r419*APINNO3*APINNO3 + r420*APINNO3*CH3CO3 + .82*r421*APINNO3*CH3O2 + .7*r422*APINNO3*HO2 - + .93*r423*APINNO3*NO + r424*APINNO3*NO3 + r425*APINNO3*TERPA2CO3 + r426*APINNO3*TERPA3CO3 - + r427*APINNO3*TERPACO3 + .39*r428*APINO2*CH3CO3 + .42*r429*APINO2*CH3O2 + .29*r430*APINO2*HO2 - + .3*r431*APINO2*NO + .39*r432*APINO2*NO3 + .39*r433*APINO2*TERPA2CO3 - + .39*r434*APINO2*TERPA3CO3 + .39*r435*APINO2*TERPACO3 + .22*r436*APIN*O3 + r617*TERPNS*OH - + r621*TERPNT*OH + r623*TERPOOH*OH - - j93*TERPA - r589*NO3*TERPA - r590*OH*TERPA - d(TERPA2)/dt = .17*r436*APIN*O3 + .5*r528*TERPA1O2*CH3O2 + r591*TERPAPAN*OH - - j94*TERPA2 - r542*NO3*TERPA2 - r551*OH*TERPA2 - d(TERPA2PAN)/dt = r518*M*TERPA2CO3*NO2 - - j95*TERPA2PAN - r624*M*TERPA2PAN - r552*OH*TERPA2PAN - d(TERPA3)/dt = j114*TERPOOHL + .35*r428*APINO2*CH3CO3 + .2*r429*APINO2*CH3O2 + .27*r431*APINO2*NO - + .35*r432*APINO2*NO3 + .35*r433*APINO2*TERPA2CO3 + .35*r434*APINO2*TERPA3CO3 - + .35*r435*APINO2*TERPACO3 + .9*r459*BPINNO3*BPINNO3 + .48*r460*BPINNO3*CH3CO3 - + .34*r461*BPINNO3*CH3O2 + .22*r462*BPINNO3*HO2 + .44*r463*BPINNO3*NO + .48*r464*BPINNO3*NO3 - + .48*r465*BPINNO3*TERPA2CO3 + .48*r466*BPINNO3*TERPA3CO3 + .48*r467*BPINNO3*TERPACO3 - + .41*r468*BPINO2*CH3CO3 + .31*r469*BPINO2*CH3O2 + .31*r471*BPINO2*NO + .41*r472*BPINO2*NO3 - + .41*r473*BPINO2*TERPA2CO3 + .41*r474*BPINO2*TERPA3CO3 + .41*r475*BPINO2*TERPACO3 - + r593*TERPF1*NO3 + .1*r594*TERPF1O2*HO2 + .7*r595*TERPF1O2*NO + r596*TERPF1*O3 - + r622*TERPOOHL*OH - - j96*TERPA3 - r561*NO3*TERPA3 - r570*OH*TERPA3 - d(TERPA3PAN)/dt = r519*M*TERPA3CO3*NO2 - - j97*TERPA3PAN - r625*M*TERPA3PAN - r571*OH*TERPA3PAN - d(TERPACID)/dt = .01*r436*APIN*O3 + .13*r456*BCARY*O3 + .01*r496*LIMON*O3 + .51*r585*TERPACO3*HO2 - - j98*TERPACID - r582*OH*TERPACID - d(TERPACID2)/dt = .51*r537*TERPA2CO3*HO2 - - j99*TERPACID2 - r580*OH*TERPACID2 - d(TERPACID3)/dt = .51*r555*TERPA3CO3*HO2 - - j100*TERPACID3 - r581*OH*TERPACID3 - d(TERPAPAN)/dt = r520*M*TERPACO3*NO2 - - j101*TERPAPAN - r626*M*TERPAPAN - r591*OH*TERPAPAN - d(TERPDHDP)/dt = .82*r521*TERP1OOHO2*HO2 + .82*r525*TERP2OOHO2*HO2 - - j102*TERPDHDP - r668*TERPDHDP - r592*OH*TERPDHDP + + 1.64*r418*APINNO3*APINNO3 + r419*APINNO3*CH3CO3 + .82*r420*APINNO3*CH3O2 + .7*r421*APINNO3*HO2 + + .93*r422*APINNO3*NO + r423*APINNO3*NO3 + r424*APINNO3*TERPA2CO3 + r425*APINNO3*TERPA3CO3 + + r426*APINNO3*TERPACO3 + .39*r427*APINO2*CH3CO3 + .42*r428*APINO2*CH3O2 + .29*r429*APINO2*HO2 + + .3*r430*APINO2*NO + .39*r431*APINO2*NO3 + .39*r432*APINO2*TERPA2CO3 + + .39*r433*APINO2*TERPA3CO3 + .39*r434*APINO2*TERPACO3 + .22*r435*APIN*O3 + r616*TERPNS*OH + + r620*TERPNT*OH + r622*TERPOOH*OH + - j93*TERPA - r588*NO3*TERPA - r589*OH*TERPA + d(TERPA2)/dt = .17*r435*APIN*O3 + .5*r527*TERPA1O2*CH3O2 + r590*TERPAPAN*OH + - j94*TERPA2 - r541*NO3*TERPA2 - r550*OH*TERPA2 + d(TERPA2PAN)/dt = r517*M*TERPA2CO3*NO2 + - j95*TERPA2PAN - r623*M*TERPA2PAN - r551*OH*TERPA2PAN + d(TERPA3)/dt = j114*TERPOOHL + .35*r427*APINO2*CH3CO3 + .2*r428*APINO2*CH3O2 + .27*r430*APINO2*NO + + .35*r431*APINO2*NO3 + .35*r432*APINO2*TERPA2CO3 + .35*r433*APINO2*TERPA3CO3 + + .35*r434*APINO2*TERPACO3 + .9*r458*BPINNO3*BPINNO3 + .48*r459*BPINNO3*CH3CO3 + + .34*r460*BPINNO3*CH3O2 + .22*r461*BPINNO3*HO2 + .44*r462*BPINNO3*NO + .48*r463*BPINNO3*NO3 + + .48*r464*BPINNO3*TERPA2CO3 + .48*r465*BPINNO3*TERPA3CO3 + .48*r466*BPINNO3*TERPACO3 + + .41*r467*BPINO2*CH3CO3 + .31*r468*BPINO2*CH3O2 + .31*r470*BPINO2*NO + .41*r471*BPINO2*NO3 + + .41*r472*BPINO2*TERPA2CO3 + .41*r473*BPINO2*TERPA3CO3 + .41*r474*BPINO2*TERPACO3 + + r592*TERPF1*NO3 + .1*r593*TERPF1O2*HO2 + .7*r594*TERPF1O2*NO + r595*TERPF1*O3 + + r621*TERPOOHL*OH + - j96*TERPA3 - r560*NO3*TERPA3 - r569*OH*TERPA3 + d(TERPA3PAN)/dt = r518*M*TERPA3CO3*NO2 + - j97*TERPA3PAN - r624*M*TERPA3PAN - r570*OH*TERPA3PAN + d(TERPACID)/dt = .01*r435*APIN*O3 + .13*r455*BCARY*O3 + .01*r495*LIMON*O3 + .51*r584*TERPACO3*HO2 + - j98*TERPACID - r581*OH*TERPACID + d(TERPACID2)/dt = .51*r536*TERPA2CO3*HO2 + - j99*TERPACID2 - r579*OH*TERPACID2 + d(TERPACID3)/dt = .51*r554*TERPA3CO3*HO2 + - j100*TERPACID3 - r580*OH*TERPACID3 + d(TERPAPAN)/dt = r519*M*TERPACO3*NO2 + - j101*TERPAPAN - r625*M*TERPAPAN - r590*OH*TERPAPAN + d(TERPDHDP)/dt = .82*r520*TERP1OOHO2*HO2 + .82*r524*TERP2OOHO2*HO2 + - j102*TERPDHDP - r667*TERPDHDP - r591*OH*TERPDHDP d(TERPF1)/dt = j91*TERP1OOH + .46*j106*TERPNPS1 + .46*j108*TERPNPT1 + j110*TERPNS1 + j112*TERPNT1 - + .12*r428*APINO2*CH3CO3 + .14*r429*APINO2*CH3O2 + .06*r430*APINO2*HO2 + .09*r431*APINO2*NO - + .12*r432*APINO2*NO3 + .12*r433*APINO2*TERPA2CO3 + .12*r434*APINO2*TERPA3CO3 - + .12*r435*APINO2*TERPACO3 + .27*r468*BPINO2*CH3CO3 + .37*r469*BPINO2*CH3O2 + .2*r471*BPINO2*NO - + .27*r472*BPINO2*NO3 + .27*r473*BPINO2*TERPA2CO3 + .27*r474*BPINO2*TERPA3CO3 - + .27*r475*BPINO2*TERPACO3 + .46*r479*LIMONNO3*CH3CO3 + .31*r480*LIMONNO3*CH3O2 - + .23*r481*LIMONNO3*HO2 + .86*r482*LIMONNO3*LIMONNO3 + .43*r483*LIMONNO3*NO - + .46*r484*LIMONNO3*NO3 + .46*r485*LIMONNO3*TERPA2CO3 + .46*r486*LIMONNO3*TERPA3CO3 - + .46*r487*LIMONNO3*TERPACO3 + r488*LIMONO2*CH3CO3 + r489*LIMONO2*CH3O2 + .1*r490*LIMONO2*HO2 - + .77*r491*LIMONO2*NO + r492*LIMONO2*NO3 + r493*LIMONO2*TERPA2CO3 + r494*LIMONO2*TERPA3CO3 - + r495*LIMONO2*TERPACO3 + .66*r496*LIMON*O3 + .5*r598*TERPF2*NO3 + .1*r599*TERPF2O2*HO2 - + .7*r600*TERPF2O2*NO + r601*TERPF2*O3 - - r593*NO3*TERPF1 - r596*O3*TERPF1 - r597*OH*TERPF1 - d(TERPF2)/dt = j92*TERP2AOOH + 1.64*r439*BCARYNO3*BCARYNO3 + r440*BCARYNO3*CH3CO3 + .82*r441*BCARYNO3*CH3O2 - + .5*r442*BCARYNO3*HO2 + .93*r443*BCARYNO3*NO + r444*BCARYNO3*NO3 + r445*BCARYNO3*TERPA2CO3 - + r446*BCARYNO3*TERPA3CO3 + r447*BCARYNO3*TERPACO3 + r448*BCARYO2*CH3CO3 + r449*BCARYO2*CH3O2 - + .1*r450*BCARYO2*HO2 + .7*r451*BCARYO2*NO + r452*BCARYO2*NO3 + r453*BCARYO2*TERPA2CO3 - + r454*BCARYO2*TERPA3CO3 + r455*BCARYO2*TERPACO3 + .87*r456*BCARY*O3 + .95*r499*MYRCNO3*CH3CO3 - + .77*r500*MYRCNO3*CH3O2 + .48*r501*MYRCNO3*HO2 + 1.54*r502*MYRCNO3*MYRCNO3 - + .89*r503*MYRCNO3*NO + .95*r504*MYRCNO3*NO3 + .95*r505*MYRCNO3*TERPA2CO3 - + .95*r506*MYRCNO3*TERPA3CO3 + .95*r507*MYRCNO3*TERPACO3 + r508*MYRCO2*CH3CO3 - + r509*MYRCO2*CH3O2 + .1*r510*MYRCO2*HO2 + .71*r511*MYRCO2*NO + r512*MYRCO2*NO3 - + r513*MYRCO2*TERPA2CO3 + r514*MYRCO2*TERPA3CO3 + r515*MYRCO2*TERPACO3 + r516*MYRC*O3 - - r598*NO3*TERPF2 - r601*O3*TERPF2 - r602*OH*TERPF2 - d(TERPFDN)/dt = .07*r423*APINNO3*NO + .07*r463*BPINNO3*NO + .07*r483*LIMONNO3*NO + .07*r503*MYRCNO3*NO - + .3*r607*TERPNPS1O2*NO + .3*r611*TERPNPT1O2*NO + .3*r615*TERPNS1O2*NO + .3*r619*TERPNT1O2*NO - - j103*TERPFDN - r669*TERPFDN - r603*OH*TERPFDN - d(TERPHFN)/dt = .01*r431*APINO2*NO + .3*r522*TERP1OOHO2*NO + .3*r526*TERP2OOHO2*NO + .3*r595*TERPF1O2*NO - + .9*r606*TERPNPS1O2*HO2 + .9*r610*TERPNPT1O2*HO2 + .9*r614*TERPNS1O2*HO2 - + .9*r618*TERPNT1O2*HO2 - - j104*TERPHFN - r670*TERPHFN - r604*OH*TERPHFN - d(TERPK)/dt = .11*r429*APINO2*CH3O2 + .04*r459*BPINNO3*BPINNO3 + .02*r460*BPINNO3*CH3CO3 - + .02*r461*BPINNO3*CH3O2 + .02*r462*BPINNO3*HO2 + .02*r463*BPINNO3*NO + .02*r464*BPINNO3*NO3 - + .02*r465*BPINNO3*TERPA2CO3 + .02*r466*BPINNO3*TERPA3CO3 + .02*r467*BPINNO3*TERPACO3 - + .32*r468*BPINO2*CH3CO3 + .32*r469*BPINO2*CH3O2 + .03*r470*BPINO2*HO2 + .24*r471*BPINO2*NO - + .32*r472*BPINO2*NO3 + .32*r473*BPINO2*TERPA2CO3 + .32*r474*BPINO2*TERPA3CO3 - + .32*r475*BPINO2*TERPACO3 + .51*r476*BPIN*O3 - - r605*OH*TERPK - d(TERPNPS)/dt = .45*r462*BPINNO3*HO2 + .1*r606*TERPNPS1O2*HO2 + .7*r607*TERPNPS1O2*NO - - j105*TERPNPS - r609*OH*TERPNPS - d(TERPNPS1)/dt = .32*r481*LIMONNO3*HO2 + .36*r501*MYRCNO3*HO2 - - j106*TERPNPS1 - r608*OH*TERPNPS1 - d(TERPNPT)/dt = .3*r422*APINNO3*HO2 + .08*r462*BPINNO3*HO2 + .1*r610*TERPNPT1O2*HO2 + .7*r611*TERPNPT1O2*NO - - j107*TERPNPT - r672*TERPNPT - r613*OH*TERPNPT - d(TERPNPT1)/dt = .18*r481*LIMONNO3*HO2 + .16*r501*MYRCNO3*HO2 - - j108*TERPNPT1 - r671*TERPNPT1 - r612*OH*TERPNPT1 - d(TERPNS)/dt = j103*TERPFDN + j104*TERPHFN + .5*j105*TERPNPS + .09*r419*APINNO3*APINNO3 - + .09*r421*APINNO3*CH3O2 + .1*r431*APINO2*NO + .92*r459*BPINNO3*BPINNO3 - + .45*r460*BPINNO3*CH3CO3 + .56*r461*BPINNO3*CH3O2 + .23*r462*BPINNO3*HO2 + .42*r463*BPINNO3*NO - + .45*r464*BPINNO3*NO3 + .45*r465*BPINNO3*TERPA2CO3 + .45*r466*BPINNO3*TERPA3CO3 - + .45*r467*BPINNO3*TERPACO3 + .02*r471*BPINO2*NO + .3*r530*TERPA1O2*NO + .09*r575*TERPA4O2*NO - + r603*TERPFDN*OH + r604*TERPHFN*OH + .1*r614*TERPNS1O2*HO2 + .7*r615*TERPNS1O2*NO - - j109*TERPNS - r617*OH*TERPNS - d(TERPNS1)/dt = .54*j106*TERPNPS1 + .02*r431*APINO2*NO + .04*r471*BPINO2*NO + .35*r479*LIMONNO3*CH3CO3 - + .42*r480*LIMONNO3*CH3O2 + .18*r481*LIMONNO3*HO2 + .72*r482*LIMONNO3*LIMONNO3 - + .33*r483*LIMONNO3*NO + .35*r484*LIMONNO3*NO3 + .35*r485*LIMONNO3*TERPA2CO3 - + .35*r486*LIMONNO3*TERPA3CO3 + .35*r487*LIMONNO3*TERPACO3 + .06*r491*LIMONO2*NO - + .05*r499*MYRCNO3*CH3CO3 + .14*r500*MYRCNO3*CH3O2 + .19*r502*MYRCNO3*MYRCNO3 - + .04*r503*MYRCNO3*NO + .05*r504*MYRCNO3*NO3 + .05*r505*MYRCNO3*TERPA2CO3 - + .05*r506*MYRCNO3*TERPA3CO3 + .05*r507*MYRCNO3*TERPACO3 + .1*r511*MYRCO2*NO - + .5*r598*TERPF2*NO3 + .12*r600*TERPF2O2*NO - - j110*TERPNS1 - r616*OH*TERPNS1 - d(TERPNT)/dt = .27*r419*APINNO3*APINNO3 + .09*r421*APINNO3*CH3O2 + .05*r431*APINO2*NO - + .14*r459*BPINNO3*BPINNO3 + .05*r460*BPINNO3*CH3CO3 + .08*r461*BPINNO3*CH3O2 - + .05*r463*BPINNO3*NO + .05*r464*BPINNO3*NO3 + .05*r465*BPINNO3*TERPA2CO3 - + .05*r466*BPINNO3*TERPA3CO3 + .05*r467*BPINNO3*TERPACO3 + .06*r471*BPINO2*NO - + .17*r546*TERPA2O2*NO + .3*r565*TERPA3O2*NO + r613*TERPNPT*OH + .1*r618*TERPNT1O2*HO2 - + .7*r619*TERPNT1O2*NO - - j111*TERPNT - r674*TERPNT - r621*OH*TERPNT - d(TERPNT1)/dt = .54*j108*TERPNPT1 + .05*r431*APINO2*NO + .13*r471*BPINO2*NO + .19*r479*LIMONNO3*CH3CO3 - + .27*r480*LIMONNO3*CH3O2 + .09*r481*LIMONNO3*HO2 + .42*r482*LIMONNO3*LIMONNO3 - + .17*r483*LIMONNO3*NO + .19*r484*LIMONNO3*NO3 + .19*r485*LIMONNO3*TERPA2CO3 - + .19*r486*LIMONNO3*TERPA3CO3 + .19*r487*LIMONNO3*TERPACO3 + .17*r491*LIMONO2*NO - + .09*r500*MYRCNO3*CH3O2 + .27*r502*MYRCNO3*MYRCNO3 + .19*r511*MYRCO2*NO - + .18*r600*TERPF2O2*NO - - j112*TERPNT1 - r673*TERPNT1 - r620*OH*TERPNT1 - d(TERPOOH)/dt = j102*TERPDHDP + .4*r430*APINO2*HO2 + .29*r470*BPINO2*HO2 + r529*TERPA1O2*HO2 - + .62*r545*TERPA2O2*HO2 + r592*TERPDHDP*OH - - j113*TERPOOH - r623*OH*TERPOOH - d(TERPOOHL)/dt = .18*r521*TERP1OOHO2*HO2 + .7*r522*TERP1OOHO2*NO + .85*r564*TERPA3O2*HO2 - + .47*r574*TERPA4O2*HO2 + .9*r594*TERPF1O2*HO2 - - j114*TERPOOHL - r622*OH*TERPOOHL - d(TOLOOH)/dt = r405*TOLO2*HO2 - - j115*TOLOOH - r407*OH*TOLOOH - d(TOLUENE)/dt = - r408*OH*TOLUENE - d(XYLENES)/dt = - r410*OH*XYLENES - d(XYLENOOH)/dt = r411*XYLENO2*HO2 - - j116*XYLENOOH - r413*OH*XYLENOOH - d(XYLOL)/dt = .15*r410*XYLENES*OH - - r416*OH*XYLOL - d(XYLOLOOH)/dt = r414*XYLOLO2*HO2 - - j117*XYLOLOOH - r417*OH*XYLOLOOH - d(NHDEP)/dt = r663*NH4 + r644*NH3*OH - d(NDEP)/dt = r391*M*DICARBO2*NO2 + r394*M*MALO2*NO2 + r397*M*MDIALO2*NO2 + r401*PHENO*NO2 - d(ACBZO2)/dt = r409*M*PBZNIT + r381*BZALD*OH - - r375*HO2*ACBZO2 - r376*NO*ACBZO2 - r404*M*NO2*ACBZO2 - d(ALKO2)/dt = r246*ALKOOH*OH + r247*BIGALK*OH - - r243*HO2*ALKO2 - r244*NO*ALKO2 - r245*NO*ALKO2 - d(APINNO3)/dt = r418*APIN*NO3 - - 2*r419*APINNO3*APINNO3 - r420*CH3CO3*APINNO3 - r421*CH3O2*APINNO3 - r422*HO2*APINNO3 - - r423*NO*APINNO3 - r424*NO3*APINNO3 - r425*TERPA2CO3*APINNO3 - r426*TERPA3CO3*APINNO3 - - r427*TERPACO3*APINNO3 - d(APINO2)/dt = r437*APIN*OH - - r428*CH3CO3*APINO2 - r429*CH3O2*APINO2 - r430*HO2*APINO2 - r431*NO*APINO2 - r432*NO3*APINO2 - - r433*TERPA2CO3*APINO2 - r434*TERPA3CO3*APINO2 - r435*TERPACO3*APINO2 - d(APINO2VBS)/dt = r679*APIN*OH - - r676*HO2*APINO2VBS - r677*NO*APINO2VBS - d(BCARYNO3)/dt = r438*BCARY*NO3 - - 2*r439*BCARYNO3*BCARYNO3 - r440*CH3CO3*BCARYNO3 - r441*CH3O2*BCARYNO3 - r442*HO2*BCARYNO3 - - r443*NO*BCARYNO3 - r444*NO3*BCARYNO3 - r445*TERPA2CO3*BCARYNO3 - r446*TERPA3CO3*BCARYNO3 - - r447*TERPACO3*BCARYNO3 - d(BCARYO2)/dt = r457*BCARY*OH - - r448*CH3CO3*BCARYO2 - r449*CH3O2*BCARYO2 - r450*HO2*BCARYO2 - r451*NO*BCARYO2 - - r452*NO3*BCARYO2 - r453*TERPA2CO3*BCARYO2 - r454*TERPA3CO3*BCARYO2 - r455*TERPACO3*BCARYO2 - d(BCARYO2VBS)/dt = r684*BCARY*OH - - r681*HO2*BCARYO2VBS - r682*NO*BCARYO2VBS - d(BENZO2)/dt = .35*r377*BENZENE*OH + r380*BENZOOH*OH - - r378*HO2*BENZO2 - r379*NO*BENZO2 - d(BENZO2VBS)/dt = r685*BENZENE*OH - - r686*HO2*BENZO2VBS - r687*NO*BENZO2VBS - d(BPINNO3)/dt = r458*BPIN*NO3 + r609*TERPNPS*OH - - 2*r459*BPINNO3*BPINNO3 - r460*CH3CO3*BPINNO3 - r461*CH3O2*BPINNO3 - r462*HO2*BPINNO3 - - r463*NO*BPINNO3 - r464*NO3*BPINNO3 - r465*TERPA2CO3*BPINNO3 - r466*TERPA3CO3*BPINNO3 - - r467*TERPACO3*BPINNO3 - d(BPINO2)/dt = r477*BPIN*OH - - r468*CH3CO3*BPINO2 - r469*CH3O2*BPINO2 - r470*HO2*BPINO2 - r471*NO*BPINO2 - r472*NO3*BPINO2 - - r473*TERPA2CO3*BPINO2 - r474*TERPA3CO3*BPINO2 - r475*TERPACO3*BPINO2 - d(BPINO2VBS)/dt = r692*BPIN*OH - - r689*HO2*BPINO2VBS - r690*NO*BPINO2VBS - d(BZOO)/dt = r383*BZOOH*OH + .07*r408*TOLUENE*OH + .06*r410*XYLENES*OH - - r382*HO2*BZOO - r384*NO*BZOO - d(C2H5O2)/dt = j76*MEK + .5*r163*C2H5OOH*OH + r164*C2H6*CL + r165*C2H6*OH - - 2*r158*C2H5O2*C2H5O2 - r159*CH3O2*C2H5O2 - r160*HO2*C2H5O2 - r161*NO*C2H5O2 - d(C3H7O2)/dt = r192*C3H7OOH*OH + r193*C3H8*OH - - r189*CH3O2*C3H7O2 - r190*HO2*C3H7O2 - r191*NO*C3H7O2 - d(C6H5O2)/dt = .4*r375*ACBZO2*HO2 + r376*ACBZO2*NO + r387*C6H5OOH*OH + r402*PHENO*O3 - - r385*HO2*C6H5O2 - r386*NO*C6H5O2 + + .12*r427*APINO2*CH3CO3 + .14*r428*APINO2*CH3O2 + .06*r429*APINO2*HO2 + .09*r430*APINO2*NO + + .12*r431*APINO2*NO3 + .12*r432*APINO2*TERPA2CO3 + .12*r433*APINO2*TERPA3CO3 + + .12*r434*APINO2*TERPACO3 + .27*r467*BPINO2*CH3CO3 + .37*r468*BPINO2*CH3O2 + .2*r470*BPINO2*NO + + .27*r471*BPINO2*NO3 + .27*r472*BPINO2*TERPA2CO3 + .27*r473*BPINO2*TERPA3CO3 + + .27*r474*BPINO2*TERPACO3 + .46*r478*LIMONNO3*CH3CO3 + .31*r479*LIMONNO3*CH3O2 + + .23*r480*LIMONNO3*HO2 + .86*r481*LIMONNO3*LIMONNO3 + .43*r482*LIMONNO3*NO + + .46*r483*LIMONNO3*NO3 + .46*r484*LIMONNO3*TERPA2CO3 + .46*r485*LIMONNO3*TERPA3CO3 + + .46*r486*LIMONNO3*TERPACO3 + r487*LIMONO2*CH3CO3 + r488*LIMONO2*CH3O2 + .1*r489*LIMONO2*HO2 + + .77*r490*LIMONO2*NO + r491*LIMONO2*NO3 + r492*LIMONO2*TERPA2CO3 + r493*LIMONO2*TERPA3CO3 + + r494*LIMONO2*TERPACO3 + .66*r495*LIMON*O3 + .5*r597*TERPF2*NO3 + .1*r598*TERPF2O2*HO2 + + .7*r599*TERPF2O2*NO + r600*TERPF2*O3 + - r592*NO3*TERPF1 - r595*O3*TERPF1 - r596*OH*TERPF1 + d(TERPF2)/dt = j92*TERP2AOOH + 1.64*r438*BCARYNO3*BCARYNO3 + r439*BCARYNO3*CH3CO3 + .82*r440*BCARYNO3*CH3O2 + + .5*r441*BCARYNO3*HO2 + .93*r442*BCARYNO3*NO + r443*BCARYNO3*NO3 + r444*BCARYNO3*TERPA2CO3 + + r445*BCARYNO3*TERPA3CO3 + r446*BCARYNO3*TERPACO3 + r447*BCARYO2*CH3CO3 + r448*BCARYO2*CH3O2 + + .1*r449*BCARYO2*HO2 + .7*r450*BCARYO2*NO + r451*BCARYO2*NO3 + r452*BCARYO2*TERPA2CO3 + + r453*BCARYO2*TERPA3CO3 + r454*BCARYO2*TERPACO3 + .87*r455*BCARY*O3 + .95*r498*MYRCNO3*CH3CO3 + + .77*r499*MYRCNO3*CH3O2 + .48*r500*MYRCNO3*HO2 + 1.54*r501*MYRCNO3*MYRCNO3 + + .89*r502*MYRCNO3*NO + .95*r503*MYRCNO3*NO3 + .95*r504*MYRCNO3*TERPA2CO3 + + .95*r505*MYRCNO3*TERPA3CO3 + .95*r506*MYRCNO3*TERPACO3 + r507*MYRCO2*CH3CO3 + + r508*MYRCO2*CH3O2 + .1*r509*MYRCO2*HO2 + .71*r510*MYRCO2*NO + r511*MYRCO2*NO3 + + r512*MYRCO2*TERPA2CO3 + r513*MYRCO2*TERPA3CO3 + r514*MYRCO2*TERPACO3 + r515*MYRC*O3 + - r597*NO3*TERPF2 - r600*O3*TERPF2 - r601*OH*TERPF2 + d(TERPFDN)/dt = .07*r422*APINNO3*NO + .07*r462*BPINNO3*NO + .07*r482*LIMONNO3*NO + .07*r502*MYRCNO3*NO + + .3*r606*TERPNPS1O2*NO + .3*r610*TERPNPT1O2*NO + .3*r614*TERPNS1O2*NO + .3*r618*TERPNT1O2*NO + - j103*TERPFDN - r668*TERPFDN - r602*OH*TERPFDN + d(TERPHFN)/dt = .01*r430*APINO2*NO + .3*r521*TERP1OOHO2*NO + .3*r525*TERP2OOHO2*NO + .3*r594*TERPF1O2*NO + + .9*r605*TERPNPS1O2*HO2 + .9*r609*TERPNPT1O2*HO2 + .9*r613*TERPNS1O2*HO2 + + .9*r617*TERPNT1O2*HO2 + - j104*TERPHFN - r669*TERPHFN - r603*OH*TERPHFN + d(TERPK)/dt = .11*r428*APINO2*CH3O2 + .04*r458*BPINNO3*BPINNO3 + .02*r459*BPINNO3*CH3CO3 + + .02*r460*BPINNO3*CH3O2 + .02*r461*BPINNO3*HO2 + .02*r462*BPINNO3*NO + .02*r463*BPINNO3*NO3 + + .02*r464*BPINNO3*TERPA2CO3 + .02*r465*BPINNO3*TERPA3CO3 + .02*r466*BPINNO3*TERPACO3 + + .32*r467*BPINO2*CH3CO3 + .32*r468*BPINO2*CH3O2 + .03*r469*BPINO2*HO2 + .24*r470*BPINO2*NO + + .32*r471*BPINO2*NO3 + .32*r472*BPINO2*TERPA2CO3 + .32*r473*BPINO2*TERPA3CO3 + + .32*r474*BPINO2*TERPACO3 + .51*r475*BPIN*O3 + - r604*OH*TERPK + d(TERPNPS)/dt = .45*r461*BPINNO3*HO2 + .1*r605*TERPNPS1O2*HO2 + .7*r606*TERPNPS1O2*NO + - j105*TERPNPS - r608*OH*TERPNPS + d(TERPNPS1)/dt = .32*r480*LIMONNO3*HO2 + .36*r500*MYRCNO3*HO2 + - j106*TERPNPS1 - r607*OH*TERPNPS1 + d(TERPNPT)/dt = .3*r421*APINNO3*HO2 + .08*r461*BPINNO3*HO2 + .1*r609*TERPNPT1O2*HO2 + .7*r610*TERPNPT1O2*NO + - j107*TERPNPT - r671*TERPNPT - r612*OH*TERPNPT + d(TERPNPT1)/dt = .18*r480*LIMONNO3*HO2 + .16*r500*MYRCNO3*HO2 + - j108*TERPNPT1 - r670*TERPNPT1 - r611*OH*TERPNPT1 + d(TERPNS)/dt = j103*TERPFDN + j104*TERPHFN + .5*j105*TERPNPS + .09*r418*APINNO3*APINNO3 + + .09*r420*APINNO3*CH3O2 + .1*r430*APINO2*NO + .92*r458*BPINNO3*BPINNO3 + + .45*r459*BPINNO3*CH3CO3 + .56*r460*BPINNO3*CH3O2 + .23*r461*BPINNO3*HO2 + .42*r462*BPINNO3*NO + + .45*r463*BPINNO3*NO3 + .45*r464*BPINNO3*TERPA2CO3 + .45*r465*BPINNO3*TERPA3CO3 + + .45*r466*BPINNO3*TERPACO3 + .02*r470*BPINO2*NO + .3*r529*TERPA1O2*NO + .09*r574*TERPA4O2*NO + + r602*TERPFDN*OH + r603*TERPHFN*OH + .1*r613*TERPNS1O2*HO2 + .7*r614*TERPNS1O2*NO + - j109*TERPNS - r616*OH*TERPNS + d(TERPNS1)/dt = .54*j106*TERPNPS1 + .02*r430*APINO2*NO + .04*r470*BPINO2*NO + .35*r478*LIMONNO3*CH3CO3 + + .42*r479*LIMONNO3*CH3O2 + .18*r480*LIMONNO3*HO2 + .72*r481*LIMONNO3*LIMONNO3 + + .33*r482*LIMONNO3*NO + .35*r483*LIMONNO3*NO3 + .35*r484*LIMONNO3*TERPA2CO3 + + .35*r485*LIMONNO3*TERPA3CO3 + .35*r486*LIMONNO3*TERPACO3 + .06*r490*LIMONO2*NO + + .05*r498*MYRCNO3*CH3CO3 + .14*r499*MYRCNO3*CH3O2 + .19*r501*MYRCNO3*MYRCNO3 + + .04*r502*MYRCNO3*NO + .05*r503*MYRCNO3*NO3 + .05*r504*MYRCNO3*TERPA2CO3 + + .05*r505*MYRCNO3*TERPA3CO3 + .05*r506*MYRCNO3*TERPACO3 + .1*r510*MYRCO2*NO + + .5*r597*TERPF2*NO3 + .12*r599*TERPF2O2*NO + - j110*TERPNS1 - r615*OH*TERPNS1 + d(TERPNT)/dt = .27*r418*APINNO3*APINNO3 + .09*r420*APINNO3*CH3O2 + .05*r430*APINO2*NO + + .14*r458*BPINNO3*BPINNO3 + .05*r459*BPINNO3*CH3CO3 + .08*r460*BPINNO3*CH3O2 + + .05*r462*BPINNO3*NO + .05*r463*BPINNO3*NO3 + .05*r464*BPINNO3*TERPA2CO3 + + .05*r465*BPINNO3*TERPA3CO3 + .05*r466*BPINNO3*TERPACO3 + .06*r470*BPINO2*NO + + .17*r545*TERPA2O2*NO + .3*r564*TERPA3O2*NO + r612*TERPNPT*OH + .1*r617*TERPNT1O2*HO2 + + .7*r618*TERPNT1O2*NO + - j111*TERPNT - r673*TERPNT - r620*OH*TERPNT + d(TERPNT1)/dt = .54*j108*TERPNPT1 + .05*r430*APINO2*NO + .13*r470*BPINO2*NO + .19*r478*LIMONNO3*CH3CO3 + + .27*r479*LIMONNO3*CH3O2 + .09*r480*LIMONNO3*HO2 + .42*r481*LIMONNO3*LIMONNO3 + + .17*r482*LIMONNO3*NO + .19*r483*LIMONNO3*NO3 + .19*r484*LIMONNO3*TERPA2CO3 + + .19*r485*LIMONNO3*TERPA3CO3 + .19*r486*LIMONNO3*TERPACO3 + .17*r490*LIMONO2*NO + + .09*r499*MYRCNO3*CH3O2 + .27*r501*MYRCNO3*MYRCNO3 + .19*r510*MYRCO2*NO + + .18*r599*TERPF2O2*NO + - j112*TERPNT1 - r672*TERPNT1 - r619*OH*TERPNT1 + d(TERPOOH)/dt = j102*TERPDHDP + .4*r429*APINO2*HO2 + .29*r469*BPINO2*HO2 + r528*TERPA1O2*HO2 + + .62*r544*TERPA2O2*HO2 + r591*TERPDHDP*OH + - j113*TERPOOH - r622*OH*TERPOOH + d(TERPOOHL)/dt = .18*r520*TERP1OOHO2*HO2 + .7*r521*TERP1OOHO2*NO + .85*r563*TERPA3O2*HO2 + + .47*r573*TERPA4O2*HO2 + .9*r593*TERPF1O2*HO2 + - j114*TERPOOHL - r621*OH*TERPOOHL + d(TOLOOH)/dt = r404*TOLO2*HO2 + - j115*TOLOOH - r406*OH*TOLOOH + d(TOLUENE)/dt = - r407*OH*TOLUENE + d(XYLENES)/dt = - r409*OH*XYLENES + d(XYLENOOH)/dt = r410*XYLENO2*HO2 + - j116*XYLENOOH - r412*OH*XYLENOOH + d(XYLOL)/dt = .15*r409*XYLENES*OH + - r415*OH*XYLOL + d(XYLOLOOH)/dt = r413*XYLOLO2*HO2 + - j117*XYLOLOOH - r416*OH*XYLOLOOH + d(NHDEP)/dt = r662*NH4 + r643*NH3*OH + d(NDEP)/dt = r390*M*DICARBO2*NO2 + r393*M*MALO2*NO2 + r396*M*MDIALO2*NO2 + r400*PHENO*NO2 + d(ACBZO2)/dt = r408*M*PBZNIT + r380*BZALD*OH + - r374*HO2*ACBZO2 - r375*NO*ACBZO2 - r403*M*NO2*ACBZO2 + d(ALKO2)/dt = r245*ALKOOH*OH + r246*BIGALK*OH + - r242*HO2*ALKO2 - r243*NO*ALKO2 - r244*NO*ALKO2 + d(APINNO3)/dt = r417*APIN*NO3 + - 2*r418*APINNO3*APINNO3 - r419*CH3CO3*APINNO3 - r420*CH3O2*APINNO3 - r421*HO2*APINNO3 + - r422*NO*APINNO3 - r423*NO3*APINNO3 - r424*TERPA2CO3*APINNO3 - r425*TERPA3CO3*APINNO3 + - r426*TERPACO3*APINNO3 + d(APINO2)/dt = r436*APIN*OH + - r427*CH3CO3*APINO2 - r428*CH3O2*APINO2 - r429*HO2*APINO2 - r430*NO*APINO2 - r431*NO3*APINO2 + - r432*TERPA2CO3*APINO2 - r433*TERPA3CO3*APINO2 - r434*TERPACO3*APINO2 + d(APINO2VBS)/dt = r678*APIN*OH + - r675*HO2*APINO2VBS - r676*NO*APINO2VBS + d(BCARYNO3)/dt = r437*BCARY*NO3 + - 2*r438*BCARYNO3*BCARYNO3 - r439*CH3CO3*BCARYNO3 - r440*CH3O2*BCARYNO3 - r441*HO2*BCARYNO3 + - r442*NO*BCARYNO3 - r443*NO3*BCARYNO3 - r444*TERPA2CO3*BCARYNO3 - r445*TERPA3CO3*BCARYNO3 + - r446*TERPACO3*BCARYNO3 + d(BCARYO2)/dt = r456*BCARY*OH + - r447*CH3CO3*BCARYO2 - r448*CH3O2*BCARYO2 - r449*HO2*BCARYO2 - r450*NO*BCARYO2 + - r451*NO3*BCARYO2 - r452*TERPA2CO3*BCARYO2 - r453*TERPA3CO3*BCARYO2 - r454*TERPACO3*BCARYO2 + d(BCARYO2VBS)/dt = r683*BCARY*OH + - r680*HO2*BCARYO2VBS - r681*NO*BCARYO2VBS + d(BENZO2)/dt = .35*r376*BENZENE*OH + r379*BENZOOH*OH + - r377*HO2*BENZO2 - r378*NO*BENZO2 + d(BENZO2VBS)/dt = r684*BENZENE*OH + - r685*HO2*BENZO2VBS - r686*NO*BENZO2VBS + d(BPINNO3)/dt = r457*BPIN*NO3 + r608*TERPNPS*OH + - 2*r458*BPINNO3*BPINNO3 - r459*CH3CO3*BPINNO3 - r460*CH3O2*BPINNO3 - r461*HO2*BPINNO3 + - r462*NO*BPINNO3 - r463*NO3*BPINNO3 - r464*TERPA2CO3*BPINNO3 - r465*TERPA3CO3*BPINNO3 + - r466*TERPACO3*BPINNO3 + d(BPINO2)/dt = r476*BPIN*OH + - r467*CH3CO3*BPINO2 - r468*CH3O2*BPINO2 - r469*HO2*BPINO2 - r470*NO*BPINO2 - r471*NO3*BPINO2 + - r472*TERPA2CO3*BPINO2 - r473*TERPA3CO3*BPINO2 - r474*TERPACO3*BPINO2 + d(BPINO2VBS)/dt = r691*BPIN*OH + - r688*HO2*BPINO2VBS - r689*NO*BPINO2VBS + d(BZOO)/dt = r382*BZOOH*OH + .07*r407*TOLUENE*OH + .06*r409*XYLENES*OH + - r381*HO2*BZOO - r383*NO*BZOO + d(C2H5O2)/dt = j76*MEK + .5*r162*C2H5OOH*OH + r163*C2H6*CL + r164*C2H6*OH + - 2*r157*C2H5O2*C2H5O2 - r158*CH3O2*C2H5O2 - r159*HO2*C2H5O2 - r160*NO*C2H5O2 + d(C3H7O2)/dt = r191*C3H7OOH*OH + r192*C3H8*OH + - r188*CH3O2*C3H7O2 - r189*HO2*C3H7O2 - r190*NO*C3H7O2 + d(C6H5O2)/dt = .4*r374*ACBZO2*HO2 + r375*ACBZO2*NO + r386*C6H5OOH*OH + r401*PHENO*O3 + - r384*HO2*C6H5O2 - r385*NO*C6H5O2 d(CH3CO3)/dt = j26*BIGALD4 + j34*CH3COCH3 + j35*CH3COCHO + .33*j47*HONITR + .05*j48*HPALD1 + .07*j49*HPALD4 + j52*HYAC + .5*j53*HYDRALD + j55*HYPERACET + j56*HYPERACET + .35*j72*MACR + j76*MEK + j77*MEKOOH + .3*j79*MVK + .75*j80*MVKN + .56*j81*MVKOOH + j84*NOA + .6*j86*PAN + j89*ROOH - + .5*j90*TEPOMUC + r186*M*PAN + r166*CH3CHO*NO3 + r167*CH3CHO*OH + .5*r174*CH3COOOH*OH - + r194*CH3COCHO*NO3 + r195*CH3COCHO*OH + .3*r197*HYPERACET*OH + .3*r202*RO2*CH3O2 - + .15*r203*RO2*HO2 + r204*RO2*NO + .1*r219*MACR*O3 + .35*r222*MCO3*CH3CO3 - + .35*r223*MCO3*CH3O2 + .17*r224*MCO3*HO2 + .7*r225*MCO3*MCO3 + .35*r226*MCO3*NO - + .35*r227*MCO3*NO3 + .2*r228*MEKO2*HO2 + r229*MEKO2*NO + .75*r234*MVKO2*CH3CO3 - + .88*r235*MVKO2*CH3O2 + .49*r236*MVKO2*HO2 + .28*r237*MVK*O3 + .56*r239*MVKOOH*OH - + .06*r248*HPALD1*OH + .06*r249*HPALD4*OH + .07*r320*ISOP*O3 + .04*r335*NC4CHO*O3 - + .1*r336*NC4CHO*OH + .76*r371*MVKO2*NO + .33*r496*LIMON*O3 + 2*r571*TERPA3PAN*OH - + r573*TERPA4O2*CH3O2 + .53*r574*TERPA4O2*HO2 + .91*r575*TERPA4O2*NO + r576*TERPA4O2*NO3 - + r577*TERPA4O2*TERPA2CO3 + r578*TERPA4O2*TERPA3CO3 + r579*TERPA4O2*TERPACO3 - - 2*r169*CH3CO3*CH3CO3 - r170*CH3O2*CH3CO3 - r171*HO2*CH3CO3 - r172*NO*CH3CO3 - - r185*M*NO2*CH3CO3 - r215*MACRO2*CH3CO3 - r222*MCO3*CH3CO3 - r234*MVKO2*CH3CO3 - - r258*ISOPB1O2*CH3CO3 - r264*ISOPB4O2*CH3CO3 - r278*ISOPED1O2*CH3CO3 - r282*ISOPED4O2*CH3CO3 - - r308*ISOPNO3*CH3CO3 - r325*ISOPZD1O2*CH3CO3 - r329*ISOPZD4O2*CH3CO3 - r420*APINNO3*CH3CO3 - - r428*APINO2*CH3CO3 - r440*BCARYNO3*CH3CO3 - r448*BCARYO2*CH3CO3 - r460*BPINNO3*CH3CO3 - - r468*BPINO2*CH3CO3 - r479*LIMONNO3*CH3CO3 - r488*LIMONO2*CH3CO3 - r499*MYRCNO3*CH3CO3 - - r508*MYRCO2*CH3CO3 - r527*TERPA1O2*CH3CO3 - r535*TERPA2CO3*CH3CO3 - r543*TERPA2O2*CH3CO3 - - r553*TERPA3CO3*CH3CO3 - r562*TERPA3O2*CH3CO3 - r583*TERPACO3*CH3CO3 + + .5*j90*TEPOMUC + r185*M*PAN + r165*CH3CHO*NO3 + r166*CH3CHO*OH + .5*r173*CH3COOOH*OH + + r193*CH3COCHO*NO3 + r194*CH3COCHO*OH + .3*r196*HYPERACET*OH + .3*r201*RO2*CH3O2 + + .15*r202*RO2*HO2 + r203*RO2*NO + .1*r218*MACR*O3 + .35*r221*MCO3*CH3CO3 + + .35*r222*MCO3*CH3O2 + .17*r223*MCO3*HO2 + .7*r224*MCO3*MCO3 + .35*r225*MCO3*NO + + .35*r226*MCO3*NO3 + .2*r227*MEKO2*HO2 + r228*MEKO2*NO + .75*r233*MVKO2*CH3CO3 + + .88*r234*MVKO2*CH3O2 + .49*r235*MVKO2*HO2 + .28*r236*MVK*O3 + .56*r238*MVKOOH*OH + + .06*r247*HPALD1*OH + .06*r248*HPALD4*OH + .07*r319*ISOP*O3 + .04*r334*NC4CHO*O3 + + .1*r335*NC4CHO*OH + .76*r370*MVKO2*NO + .33*r495*LIMON*O3 + 2*r570*TERPA3PAN*OH + + r572*TERPA4O2*CH3O2 + .53*r573*TERPA4O2*HO2 + .91*r574*TERPA4O2*NO + r575*TERPA4O2*NO3 + + r576*TERPA4O2*TERPA2CO3 + r577*TERPA4O2*TERPA3CO3 + r578*TERPA4O2*TERPACO3 + - 2*r168*CH3CO3*CH3CO3 - r169*CH3O2*CH3CO3 - r170*HO2*CH3CO3 - r171*NO*CH3CO3 + - r184*M*NO2*CH3CO3 - r214*MACRO2*CH3CO3 - r221*MCO3*CH3CO3 - r233*MVKO2*CH3CO3 + - r257*ISOPB1O2*CH3CO3 - r263*ISOPB4O2*CH3CO3 - r277*ISOPED1O2*CH3CO3 - r281*ISOPED4O2*CH3CO3 + - r307*ISOPNO3*CH3CO3 - r324*ISOPZD1O2*CH3CO3 - r328*ISOPZD4O2*CH3CO3 - r419*APINNO3*CH3CO3 + - r427*APINO2*CH3CO3 - r439*BCARYNO3*CH3CO3 - r447*BCARYO2*CH3CO3 - r459*BPINNO3*CH3CO3 + - r467*BPINO2*CH3CO3 - r478*LIMONNO3*CH3CO3 - r487*LIMONO2*CH3CO3 - r498*MYRCNO3*CH3CO3 + - r507*MYRCO2*CH3CO3 - r526*TERPA1O2*CH3CO3 - r534*TERPA2CO3*CH3CO3 - r542*TERPA2O2*CH3CO3 + - r552*TERPA3CO3*CH3CO3 - r561*TERPA3O2*CH3CO3 - r582*TERPACO3*CH3CO3 d(CH3O2)/dt = j33*CH3CHO + j34*CH3COCH3 + j36*CH3COOOH + j38*CH4 + .04*j48*HPALD1 + .07*j49*HPALD4 + .65*j72*MACR + .3*j79*MVK + .4*j86*PAN + j131*CH3BR + j133*CH3CL + r52*CL*CH4 + r108*F*CH4 - + .7*r140*CH3OOH*OH + r141*CH4*OH + r149*O1D*CH4 + 2*r169*CH3CO3*CH3CO3 + .9*r170*CH3CO3*CH3O2 - + .49*r171*CH3CO3*HO2 + r172*CH3CO3*NO + r173*CH3COOH*OH + .28*r188*C3H6*O3 - + r215*MACRO2*CH3CO3 + 1.65*r222*MCO3*CH3CO3 + .65*r223*MCO3*CH3O2 + .32*r224*MCO3*HO2 - + 1.3*r225*MCO3*MCO3 + .65*r226*MCO3*NO + .65*r227*MCO3*NO3 + r234*MVKO2*CH3CO3 - + .06*r248*HPALD1*OH + .06*r249*HPALD4*OH + r258*ISOPB1O2*CH3CO3 + r264*ISOPB4O2*CH3CO3 - + r278*ISOPED1O2*CH3CO3 + r282*ISOPED4O2*CH3CO3 + r308*ISOPNO3*CH3CO3 + .21*r320*ISOP*O3 - + r325*ISOPZD1O2*CH3CO3 + r329*ISOPZD4O2*CH3CO3 + .33*r389*DICARBO2*HO2 + .83*r390*DICARBO2*NO - + .07*r395*MDIALO2*HO2 + .17*r396*MDIALO2*NO + r420*APINNO3*CH3CO3 + r428*APINO2*CH3CO3 - + r440*BCARYNO3*CH3CO3 + r448*BCARYO2*CH3CO3 + r460*BPINNO3*CH3CO3 + r468*BPINO2*CH3CO3 - + r479*LIMONNO3*CH3CO3 + r488*LIMONO2*CH3CO3 + r499*MYRCNO3*CH3CO3 + r508*MYRCO2*CH3CO3 - + r527*TERPA1O2*CH3CO3 + r535*TERPA2CO3*CH3CO3 + r543*TERPA2O2*CH3CO3 + r553*TERPA3CO3*CH3CO3 - + r562*TERPA3O2*CH3CO3 + r572*TERPA4O2*CH3CO3 + r583*TERPACO3*CH3CO3 + + .7*r140*CH3OOH*OH + r141*CH4*OH + r148*O1D*CH4 + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + + .49*r170*CH3CO3*HO2 + r171*CH3CO3*NO + r172*CH3COOH*OH + .28*r187*C3H6*O3 + + r214*MACRO2*CH3CO3 + 1.65*r221*MCO3*CH3CO3 + .65*r222*MCO3*CH3O2 + .32*r223*MCO3*HO2 + + 1.3*r224*MCO3*MCO3 + .65*r225*MCO3*NO + .65*r226*MCO3*NO3 + r233*MVKO2*CH3CO3 + + .06*r247*HPALD1*OH + .06*r248*HPALD4*OH + r257*ISOPB1O2*CH3CO3 + r263*ISOPB4O2*CH3CO3 + + r277*ISOPED1O2*CH3CO3 + r281*ISOPED4O2*CH3CO3 + r307*ISOPNO3*CH3CO3 + .21*r319*ISOP*O3 + + r324*ISOPZD1O2*CH3CO3 + r328*ISOPZD4O2*CH3CO3 + .33*r388*DICARBO2*HO2 + .83*r389*DICARBO2*NO + + .07*r394*MDIALO2*HO2 + .17*r395*MDIALO2*NO + r419*APINNO3*CH3CO3 + r427*APINO2*CH3CO3 + + r439*BCARYNO3*CH3CO3 + r447*BCARYO2*CH3CO3 + r459*BPINNO3*CH3CO3 + r467*BPINO2*CH3CO3 + + r478*LIMONNO3*CH3CO3 + r487*LIMONO2*CH3CO3 + r498*MYRCNO3*CH3CO3 + r507*MYRCO2*CH3CO3 + + r526*TERPA1O2*CH3CO3 + r534*TERPA2CO3*CH3CO3 + r542*TERPA2O2*CH3CO3 + r552*TERPA3CO3*CH3CO3 + + r561*TERPA3O2*CH3CO3 + r571*TERPA4O2*CH3CO3 + r582*TERPACO3*CH3CO3 - r58*CLO*CH3O2 - 2*r135*CH3O2*CH3O2 - 2*r136*CH3O2*CH3O2 - r137*HO2*CH3O2 - r138*NO*CH3O2 - - r159*C2H5O2*CH3O2 - r170*CH3CO3*CH3O2 - r189*C3H7O2*CH3O2 - r202*RO2*CH3O2 - - r216*MACRO2*CH3O2 - r223*MCO3*CH3O2 - r235*MVKO2*CH3O2 - r259*ISOPB1O2*CH3O2 - - r265*ISOPB4O2*CH3O2 - r279*ISOPED1O2*CH3O2 - r283*ISOPED4O2*CH3O2 - r309*ISOPNO3*CH3O2 - - r326*ISOPZD1O2*CH3O2 - r330*ISOPZD4O2*CH3O2 - r421*APINNO3*CH3O2 - r429*APINO2*CH3O2 - - r441*BCARYNO3*CH3O2 - r449*BCARYO2*CH3O2 - r461*BPINNO3*CH3O2 - r469*BPINO2*CH3O2 - - r480*LIMONNO3*CH3O2 - r489*LIMONO2*CH3O2 - r500*MYRCNO3*CH3O2 - r509*MYRCO2*CH3O2 - - r528*TERPA1O2*CH3O2 - r536*TERPA2CO3*CH3O2 - r544*TERPA2O2*CH3O2 - r554*TERPA3CO3*CH3O2 - - r563*TERPA3O2*CH3O2 - r573*TERPA4O2*CH3O2 - r584*TERPACO3*CH3O2 + - r158*C2H5O2*CH3O2 - r169*CH3CO3*CH3O2 - r188*C3H7O2*CH3O2 - r201*RO2*CH3O2 + - r215*MACRO2*CH3O2 - r222*MCO3*CH3O2 - r234*MVKO2*CH3O2 - r258*ISOPB1O2*CH3O2 + - r264*ISOPB4O2*CH3O2 - r278*ISOPED1O2*CH3O2 - r282*ISOPED4O2*CH3O2 - r308*ISOPNO3*CH3O2 + - r325*ISOPZD1O2*CH3O2 - r329*ISOPZD4O2*CH3O2 - r420*APINNO3*CH3O2 - r428*APINO2*CH3O2 + - r440*BCARYNO3*CH3O2 - r448*BCARYO2*CH3O2 - r460*BPINNO3*CH3O2 - r468*BPINO2*CH3O2 + - r479*LIMONNO3*CH3O2 - r488*LIMONO2*CH3O2 - r499*MYRCNO3*CH3O2 - r508*MYRCO2*CH3O2 + - r527*TERPA1O2*CH3O2 - r535*TERPA2CO3*CH3O2 - r543*TERPA2O2*CH3O2 - r553*TERPA3CO3*CH3O2 + - r562*TERPA3O2*CH3O2 - r572*TERPA4O2*CH3O2 - r583*TERPACO3*CH3O2 d(DICARBO2)/dt = .6*j24*BIGALD2 - - r389*HO2*DICARBO2 - r390*NO*DICARBO2 - r391*M*NO2*DICARBO2 - d(ENEO2)/dt = r209*BIGENE*OH - - r211*NO*ENEO2 - r212*NO*ENEO2 - d(EO)/dt = j42*EOOH + .75*r176*EO2*NO - - r177*EO - r178*O2*EO - d(EO2)/dt = r184*M*C2H4*OH - - r175*HO2*EO2 - r176*NO*EO2 + - r388*HO2*DICARBO2 - r389*NO*DICARBO2 - r390*M*NO2*DICARBO2 + d(ENEO2)/dt = r208*BIGENE*OH + - r210*NO*ENEO2 - r211*NO*ENEO2 + d(EO)/dt = j42*EOOH + .75*r175*EO2*NO + - r176*EO - r177*O2*EO + d(EO2)/dt = r183*M*C2H4*OH + - r174*HO2*EO2 - r175*NO*EO2 d(HO2)/dt = j11*HO2NO2 + j19*ALKNIT + .9*j20*ALKOOH + j21*BENZOOH + 1.5*j22*BEPOMUC + j23*BIGALD1 + .6*j24*BIGALD2 + .6*j25*BIGALD3 + j26*BIGALD4 + j27*BZOOH + j28*C2H5OOH + j29*C3H7OOH + j33*CH3CHO + j35*CH3COCHO + .5*j41*DHPMPAL + 2*j43*GLYALD + 2*j44*GLYOXAL + j45*HCOCH2OOH @@ -2853,178 +2847,178 @@ Extraneous prod/loss species + j92*TERP2AOOH + j93*TERPA + j94*TERPA2 + j96*TERPA3 + j102*TERPDHDP + j103*TERPFDN + j104*TERPHFN + .5*j105*TERPNPS + .54*j106*TERPNPS1 + .54*j108*TERPNPT1 + j109*TERPNS + j110*TERPNS1 + j111*TERPNT + j112*TERPNT1 + j113*TERPOOH + j114*TERPOOHL + j115*TOLOOH - + j116*XYLENOOH + j117*XYLOLOOH + r14*O2*M*H + r49*M*HO2NO2 + r147*HOCH2OO + r177*EO - + r178*O2*EO + r292*ISOPN1DO2 + r296*ISOPN2BO2 + r299*ISOPN3BO2 + r302*ISOPN4DO2 - + .4*r363*ISOPZD1O2 + .4*r366*ISOPZD4O2 + r10*H2O2*O + r19*OH*H2O2 + r22*OH*O3 + r38*NO3*OH + + j116*XYLENOOH + j117*XYLOLOOH + r14*O2*M*H + r49*M*HO2NO2 + r146*HOCH2OO + r176*EO + + r177*O2*EO + r291*ISOPN1DO2 + r295*ISOPN2BO2 + r298*ISOPN3BO2 + r301*ISOPN4DO2 + + .4*r362*ISOPZD1O2 + .4*r365*ISOPZD4O2 + r10*H2O2*O + r19*OH*H2O2 + r22*OH*O3 + r38*NO3*OH + r51*CL*CH2O + r54*CL*H2O2 + r58*CLO*CH3O2 + r69*CLO*OH + r87*BR*CH2O + r99*BRO*OH + r116*CH3BR*CL + r117*CH3BR*OH + r119*CH3CL*CL + r120*CH3CL*OH + r132*CH2O*NO3 + r133*CH2O*O - + 2*r135*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + r142*M*CO*OH + r143*M*HCN*OH - + r144*HCOOH*OH + .5*r145*HMHP*OH + .2*r146*HOCH2OO*HO2 + r148*HOCH2OO*NO + r150*O1D*CH4 - + .35*r155*M*C2H2*OH + .13*r157*C2H4*O3 + 1.2*r158*C2H5O2*C2H5O2 + r159*C2H5O2*CH3O2 - + r161*C2H5O2*NO + r162*C2H5OH*OH + r168*CH3CN*OH + .9*r170*CH3CO3*CH3O2 + .25*r176*EO2*NO - + r179*GLYALD*OH + r180*GLYOXAL*OH + .11*r181*HCOCH2OOH*OH + .28*r188*C3H6*O3 + r189*C3H7O2*CH3O2 - + r191*C3H7O2*NO + r196*HYAC*OH + r200*PO2*NO + .3*r202*RO2*CH3O2 + r211*ENEO2*NO - + r213*HONITR*OH + .5*r214*MACRN*OH + r215*MACRO2*CH3CO3 + 1.5*r216*MACRO2*CH3O2 - + .59*r217*MACRO2*HO2 + .14*r219*MACR*O3 + r223*MCO3*CH3O2 + r233*MVKN*OH + .25*r234*MVKO2*CH3CO3 - + .62*r235*MVKO2*CH3O2 + .18*r236*MVKO2*HO2 + .28*r237*MVK*O3 + .44*r239*MVKOOH*OH - + r244*ALKO2*NO + .51*r248*HPALD1*OH + .41*r249*HPALD4*OH + .32*r252*HYDRALD*OH - + .19*r254*IEPOX*OH + .65*r255*IEPOXOO*HO2 + .4*r257*INHED*OH + r258*ISOPB1O2*CH3CO3 - + 1.5*r259*ISOPB1O2*CH3O2 + .06*r260*ISOPB1O2*HO2 + r264*ISOPB4O2*CH3CO3 + r265*ISOPB4O2*CH3O2 - + .06*r266*ISOPB4O2*HO2 + .45*r278*ISOPED1O2*CH3CO3 + .72*r279*ISOPED1O2*CH3O2 - + .45*r282*ISOPED4O2*CH3CO3 + .72*r283*ISOPED4O2*CH3O2 + r287*ISOPFDN*OH + r289*ISOPFNP*OH - + .58*r291*ISOPN1DO2*HO2 + .17*r293*ISOPN1D*O3 + .04*r294*ISOPN1D*OH + .06*r295*ISOPN2BO2*HO2 - + .6*r298*ISOPN3BO2*HO2 + .5*r301*ISOPN4DO2*HO2 + .17*r303*ISOPN4D*O3 + .03*r304*ISOPN4D*OH - + .4*r305*ISOPNBNO3O2*HO2 + .05*r306*ISOPNBNO3*OH + .54*r308*ISOPNO3*CH3CO3 - + .4*r309*ISOPNO3*CH3O2 + .4*r311*ISOPNO3*ISOPNO3 + .54*r312*ISOPNO3*NO3 - + .17*r313*ISOPNOOHBO2*HO2 + .8*r316*ISOPNOOHDO2*HO2 + .42*r320*ISOP*O3 + r322*ISOPOH*OH - + .18*r323*ISOPOOH*OH + .45*r325*ISOPZD1O2*CH3CO3 + .72*r326*ISOPZD1O2*CH3O2 - + .45*r329*ISOPZD4O2*CH3CO3 + .72*r330*ISOPZD4O2*CH3O2 + .8*r333*NC4CHOO2*HO2 + .13*r335*NC4CHO*O3 - + .63*r336*NC4CHO*OH + r337*IEPOXOO*NO + r339*ISOPB1O2*NO + r341*ISOPB4O2*NO - + .45*r343*ISOPED1O2*NO + .45*r345*ISOPED4O2*NO + r347*ISOPN1DO2*NO + .27*r349*ISOPN2BO2*NO - + r351*ISOPN3BO2*NO + r353*ISOPN4DO2*NO + r355*ISOPNBNO3O2*NO + .54*r357*ISOPNO3*NO - + .53*r359*ISOPNOOHBO2*NO + .96*r361*ISOPNOOHDO2*NO + .45*r364*ISOPZD1O2*NO - + .45*r367*ISOPZD4O2*NO + r369*MACRO2*NO + .24*r371*MVKO2*NO + r373*NC4CHOO2*NO - + .65*r377*BENZENE*OH + r379*BENZO2*NO + r384*BZOO*NO + .73*r388*CRESOL*OH - + .07*r389*DICARBO2*HO2 + .17*r390*DICARBO2*NO + .16*r392*MALO2*HO2 + .4*r393*MALO2*NO - + .33*r395*MDIALO2*HO2 + .83*r396*MDIALO2*NO + r399*PHENO2*NO + .8*r400*PHENOL*OH + r406*TOLO2*NO - + .28*r408*TOLUENE*OH + .38*r410*XYLENES*OH + r412*XYLENO2*NO + r415*XYLOLO2*NO - + .63*r416*XYLOL*OH + .82*r421*APINNO3*CH3O2 + r428*APINO2*CH3CO3 + 1.16*r429*APINO2*CH3O2 - + .48*r430*APINO2*HO2 + .77*r431*APINO2*NO + r432*APINO2*NO3 + r433*APINO2*TERPA2CO3 - + r434*APINO2*TERPA3CO3 + r435*APINO2*TERPACO3 + .17*r436*APIN*O3 + .82*r441*BCARYNO3*CH3O2 - + r448*BCARYO2*CH3CO3 + r449*BCARYO2*CH3O2 + .1*r450*BCARYO2*HO2 + .7*r451*BCARYO2*NO - + r452*BCARYO2*NO3 + r453*BCARYO2*TERPA2CO3 + r454*BCARYO2*TERPA3CO3 + r455*BCARYO2*TERPACO3 - + .08*r456*BCARY*O3 + .94*r459*BPINNO3*BPINNO3 + .5*r460*BPINNO3*CH3CO3 + 1.1*r461*BPINNO3*CH3O2 - + .47*r463*BPINNO3*NO + .5*r464*BPINNO3*NO3 + .5*r465*BPINNO3*TERPA2CO3 - + .5*r466*BPINNO3*TERPA3CO3 + .5*r467*BPINNO3*TERPACO3 + r468*BPINO2*CH3CO3 - + 1.5*r469*BPINO2*CH3O2 + .03*r470*BPINO2*HO2 + .75*r471*BPINO2*NO + r472*BPINO2*NO3 - + r473*BPINO2*TERPA2CO3 + r474*BPINO2*TERPA3CO3 + r475*BPINO2*TERPACO3 + .54*r479*LIMONNO3*CH3CO3 - + 1.01*r480*LIMONNO3*CH3O2 + .27*r481*LIMONNO3*HO2 + .99*r482*LIMONNO3*LIMONNO3 - + .5*r483*LIMONNO3*NO + .54*r484*LIMONNO3*NO3 + .54*r485*LIMONNO3*TERPA2CO3 - + .54*r486*LIMONNO3*TERPA3CO3 + .54*r487*LIMONNO3*TERPACO3 + r488*LIMONO2*CH3CO3 - + r489*LIMONO2*CH3O2 + .1*r490*LIMONO2*HO2 + .77*r491*LIMONO2*NO + r492*LIMONO2*NO3 - + r493*LIMONO2*TERPA2CO3 + r494*LIMONO2*TERPA3CO3 + r495*LIMONO2*TERPACO3 - + .05*r499*MYRCNO3*CH3CO3 + .87*r500*MYRCNO3*CH3O2 + .04*r503*MYRCNO3*NO + .05*r504*MYRCNO3*NO3 - + .05*r505*MYRCNO3*TERPA2CO3 + .05*r506*MYRCNO3*TERPA3CO3 + .05*r507*MYRCNO3*TERPACO3 - + r508*MYRCO2*CH3CO3 + r509*MYRCO2*CH3O2 + .1*r510*MYRCO2*HO2 + .71*r511*MYRCO2*NO - + r512*MYRCO2*NO3 + r513*MYRCO2*TERPA2CO3 + r514*MYRCO2*TERPA3CO3 + r515*MYRCO2*TERPACO3 - + .63*r516*MYRC*O3 + .18*r521*TERP1OOHO2*HO2 + .7*r522*TERP1OOHO2*NO + .18*r525*TERP2OOHO2*HO2 - + .7*r526*TERP2OOHO2*NO + .5*r528*TERPA1O2*CH3O2 + r536*TERPA2CO3*CH3O2 + r544*TERPA2O2*CH3O2 - + r552*TERPA2PAN*OH + r554*TERPA3CO3*CH3O2 + r563*TERPA3O2*CH3O2 + r571*TERPA3PAN*OH - + r572*TERPA4O2*CH3CO3 + 2*r573*TERPA4O2*CH3O2 + .53*r574*TERPA4O2*HO2 + .91*r575*TERPA4O2*NO - + r576*TERPA4O2*NO3 + r577*TERPA4O2*TERPA2CO3 + r578*TERPA4O2*TERPA3CO3 + r579*TERPA4O2*TERPACO3 - + r584*TERPACO3*CH3O2 + .1*r594*TERPF1O2*HO2 + .7*r595*TERPF1O2*NO + .5*r598*TERPF2*NO3 - + .1*r599*TERPF2O2*HO2 + .7*r600*TERPF2O2*NO + .1*r606*TERPNPS1O2*HO2 + .7*r607*TERPNPS1O2*NO - + .1*r610*TERPNPT1O2*HO2 + .7*r611*TERPNPT1O2*NO + .1*r614*TERPNS1O2*HO2 + .7*r615*TERPNS1O2*NO - + .1*r618*TERPNT1O2*HO2 + .7*r619*TERPNT1O2*NO + .5*r641*DMS*OH + r642*SO2*OH - - r646*HO2 - r11*H*HO2 - r12*H*HO2 - r13*H*HO2 - r15*O*HO2 - r16*O3*HO2 - r20*OH*HO2 + + 2*r135*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + r142*M*HCN*OH + r143*HCOOH*OH + + .5*r144*HMHP*OH + .2*r145*HOCH2OO*HO2 + r147*HOCH2OO*NO + r149*O1D*CH4 + r152*CO*OH + + .35*r154*M*C2H2*OH + .13*r156*C2H4*O3 + 1.2*r157*C2H5O2*C2H5O2 + r158*C2H5O2*CH3O2 + + r160*C2H5O2*NO + r161*C2H5OH*OH + r167*CH3CN*OH + .9*r169*CH3CO3*CH3O2 + .25*r175*EO2*NO + + r178*GLYALD*OH + r179*GLYOXAL*OH + .11*r180*HCOCH2OOH*OH + .28*r187*C3H6*O3 + r188*C3H7O2*CH3O2 + + r190*C3H7O2*NO + r195*HYAC*OH + r199*PO2*NO + .3*r201*RO2*CH3O2 + r210*ENEO2*NO + + r212*HONITR*OH + .5*r213*MACRN*OH + r214*MACRO2*CH3CO3 + 1.5*r215*MACRO2*CH3O2 + + .59*r216*MACRO2*HO2 + .14*r218*MACR*O3 + r222*MCO3*CH3O2 + r232*MVKN*OH + .25*r233*MVKO2*CH3CO3 + + .62*r234*MVKO2*CH3O2 + .18*r235*MVKO2*HO2 + .28*r236*MVK*O3 + .44*r238*MVKOOH*OH + + r243*ALKO2*NO + .51*r247*HPALD1*OH + .41*r248*HPALD4*OH + .32*r251*HYDRALD*OH + + .19*r253*IEPOX*OH + .65*r254*IEPOXOO*HO2 + .4*r256*INHED*OH + r257*ISOPB1O2*CH3CO3 + + 1.5*r258*ISOPB1O2*CH3O2 + .06*r259*ISOPB1O2*HO2 + r263*ISOPB4O2*CH3CO3 + r264*ISOPB4O2*CH3O2 + + .06*r265*ISOPB4O2*HO2 + .45*r277*ISOPED1O2*CH3CO3 + .72*r278*ISOPED1O2*CH3O2 + + .45*r281*ISOPED4O2*CH3CO3 + .72*r282*ISOPED4O2*CH3O2 + r286*ISOPFDN*OH + r288*ISOPFNP*OH + + .58*r290*ISOPN1DO2*HO2 + .17*r292*ISOPN1D*O3 + .04*r293*ISOPN1D*OH + .06*r294*ISOPN2BO2*HO2 + + .6*r297*ISOPN3BO2*HO2 + .5*r300*ISOPN4DO2*HO2 + .17*r302*ISOPN4D*O3 + .03*r303*ISOPN4D*OH + + .4*r304*ISOPNBNO3O2*HO2 + .05*r305*ISOPNBNO3*OH + .54*r307*ISOPNO3*CH3CO3 + + .4*r308*ISOPNO3*CH3O2 + .4*r310*ISOPNO3*ISOPNO3 + .54*r311*ISOPNO3*NO3 + + .17*r312*ISOPNOOHBO2*HO2 + .8*r315*ISOPNOOHDO2*HO2 + .42*r319*ISOP*O3 + r321*ISOPOH*OH + + .18*r322*ISOPOOH*OH + .45*r324*ISOPZD1O2*CH3CO3 + .72*r325*ISOPZD1O2*CH3O2 + + .45*r328*ISOPZD4O2*CH3CO3 + .72*r329*ISOPZD4O2*CH3O2 + .8*r332*NC4CHOO2*HO2 + .13*r334*NC4CHO*O3 + + .63*r335*NC4CHO*OH + r336*IEPOXOO*NO + r338*ISOPB1O2*NO + r340*ISOPB4O2*NO + + .45*r342*ISOPED1O2*NO + .45*r344*ISOPED4O2*NO + r346*ISOPN1DO2*NO + .27*r348*ISOPN2BO2*NO + + r350*ISOPN3BO2*NO + r352*ISOPN4DO2*NO + r354*ISOPNBNO3O2*NO + .54*r356*ISOPNO3*NO + + .53*r358*ISOPNOOHBO2*NO + .96*r360*ISOPNOOHDO2*NO + .45*r363*ISOPZD1O2*NO + + .45*r366*ISOPZD4O2*NO + r368*MACRO2*NO + .24*r370*MVKO2*NO + r372*NC4CHOO2*NO + + .65*r376*BENZENE*OH + r378*BENZO2*NO + r383*BZOO*NO + .73*r387*CRESOL*OH + + .07*r388*DICARBO2*HO2 + .17*r389*DICARBO2*NO + .16*r391*MALO2*HO2 + .4*r392*MALO2*NO + + .33*r394*MDIALO2*HO2 + .83*r395*MDIALO2*NO + r398*PHENO2*NO + .8*r399*PHENOL*OH + r405*TOLO2*NO + + .28*r407*TOLUENE*OH + .38*r409*XYLENES*OH + r411*XYLENO2*NO + r414*XYLOLO2*NO + + .63*r415*XYLOL*OH + .82*r420*APINNO3*CH3O2 + r427*APINO2*CH3CO3 + 1.16*r428*APINO2*CH3O2 + + .48*r429*APINO2*HO2 + .77*r430*APINO2*NO + r431*APINO2*NO3 + r432*APINO2*TERPA2CO3 + + r433*APINO2*TERPA3CO3 + r434*APINO2*TERPACO3 + .17*r435*APIN*O3 + .82*r440*BCARYNO3*CH3O2 + + r447*BCARYO2*CH3CO3 + r448*BCARYO2*CH3O2 + .1*r449*BCARYO2*HO2 + .7*r450*BCARYO2*NO + + r451*BCARYO2*NO3 + r452*BCARYO2*TERPA2CO3 + r453*BCARYO2*TERPA3CO3 + r454*BCARYO2*TERPACO3 + + .08*r455*BCARY*O3 + .94*r458*BPINNO3*BPINNO3 + .5*r459*BPINNO3*CH3CO3 + 1.1*r460*BPINNO3*CH3O2 + + .47*r462*BPINNO3*NO + .5*r463*BPINNO3*NO3 + .5*r464*BPINNO3*TERPA2CO3 + + .5*r465*BPINNO3*TERPA3CO3 + .5*r466*BPINNO3*TERPACO3 + r467*BPINO2*CH3CO3 + + 1.5*r468*BPINO2*CH3O2 + .03*r469*BPINO2*HO2 + .75*r470*BPINO2*NO + r471*BPINO2*NO3 + + r472*BPINO2*TERPA2CO3 + r473*BPINO2*TERPA3CO3 + r474*BPINO2*TERPACO3 + .54*r478*LIMONNO3*CH3CO3 + + 1.01*r479*LIMONNO3*CH3O2 + .27*r480*LIMONNO3*HO2 + .99*r481*LIMONNO3*LIMONNO3 + + .5*r482*LIMONNO3*NO + .54*r483*LIMONNO3*NO3 + .54*r484*LIMONNO3*TERPA2CO3 + + .54*r485*LIMONNO3*TERPA3CO3 + .54*r486*LIMONNO3*TERPACO3 + r487*LIMONO2*CH3CO3 + + r488*LIMONO2*CH3O2 + .1*r489*LIMONO2*HO2 + .77*r490*LIMONO2*NO + r491*LIMONO2*NO3 + + r492*LIMONO2*TERPA2CO3 + r493*LIMONO2*TERPA3CO3 + r494*LIMONO2*TERPACO3 + + .05*r498*MYRCNO3*CH3CO3 + .87*r499*MYRCNO3*CH3O2 + .04*r502*MYRCNO3*NO + .05*r503*MYRCNO3*NO3 + + .05*r504*MYRCNO3*TERPA2CO3 + .05*r505*MYRCNO3*TERPA3CO3 + .05*r506*MYRCNO3*TERPACO3 + + r507*MYRCO2*CH3CO3 + r508*MYRCO2*CH3O2 + .1*r509*MYRCO2*HO2 + .71*r510*MYRCO2*NO + + r511*MYRCO2*NO3 + r512*MYRCO2*TERPA2CO3 + r513*MYRCO2*TERPA3CO3 + r514*MYRCO2*TERPACO3 + + .63*r515*MYRC*O3 + .18*r520*TERP1OOHO2*HO2 + .7*r521*TERP1OOHO2*NO + .18*r524*TERP2OOHO2*HO2 + + .7*r525*TERP2OOHO2*NO + .5*r527*TERPA1O2*CH3O2 + r535*TERPA2CO3*CH3O2 + r543*TERPA2O2*CH3O2 + + r551*TERPA2PAN*OH + r553*TERPA3CO3*CH3O2 + r562*TERPA3O2*CH3O2 + r570*TERPA3PAN*OH + + r571*TERPA4O2*CH3CO3 + 2*r572*TERPA4O2*CH3O2 + .53*r573*TERPA4O2*HO2 + .91*r574*TERPA4O2*NO + + r575*TERPA4O2*NO3 + r576*TERPA4O2*TERPA2CO3 + r577*TERPA4O2*TERPA3CO3 + r578*TERPA4O2*TERPACO3 + + r583*TERPACO3*CH3O2 + .1*r593*TERPF1O2*HO2 + .7*r594*TERPF1O2*NO + .5*r597*TERPF2*NO3 + + .1*r598*TERPF2O2*HO2 + .7*r599*TERPF2O2*NO + .1*r605*TERPNPS1O2*HO2 + .7*r606*TERPNPS1O2*NO + + .1*r609*TERPNPT1O2*HO2 + .7*r610*TERPNPT1O2*NO + .1*r613*TERPNS1O2*HO2 + .7*r614*TERPNS1O2*NO + + .1*r617*TERPNT1O2*HO2 + .7*r618*TERPNT1O2*NO + r631*M*SO2*OH + .5*r641*DMS*OH + - r645*HO2 - r11*H*HO2 - r12*H*HO2 - r13*H*HO2 - r15*O*HO2 - r16*O3*HO2 - r20*OH*HO2 - 2*r25*HO2*HO2 - r35*NO3*HO2 - r40*NO*HO2 - r45*M*NO2*HO2 - r55*CL*HO2 - r56*CL*HO2 - - r62*CLO*HO2 - r88*BR*HO2 - r94*BRO*HO2 - r131*CH2O*HO2 - r137*CH3O2*HO2 - r146*HOCH2OO*HO2 - - r160*C2H5O2*HO2 - r171*CH3CO3*HO2 - r175*EO2*HO2 - r190*C3H7O2*HO2 - r199*PO2*HO2 - - r203*RO2*HO2 - r217*MACRO2*HO2 - r224*MCO3*HO2 - r228*MEKO2*HO2 - r236*MVKO2*HO2 - - r243*ALKO2*HO2 - r255*IEPOXOO*HO2 - r260*ISOPB1O2*HO2 - r266*ISOPB4O2*HO2 - r280*ISOPED1O2*HO2 - - r284*ISOPED4O2*HO2 - r291*ISOPN1DO2*HO2 - r295*ISOPN2BO2*HO2 - r298*ISOPN3BO2*HO2 - - r301*ISOPN4DO2*HO2 - r305*ISOPNBNO3O2*HO2 - r310*ISOPNO3*HO2 - r313*ISOPNOOHBO2*HO2 - - r316*ISOPNOOHDO2*HO2 - r327*ISOPZD1O2*HO2 - r331*ISOPZD4O2*HO2 - r333*NC4CHOO2*HO2 - - r375*ACBZO2*HO2 - r378*BENZO2*HO2 - r382*BZOO*HO2 - r385*C6H5O2*HO2 - r389*DICARBO2*HO2 - - r392*MALO2*HO2 - r395*MDIALO2*HO2 - r398*PHENO2*HO2 - r405*TOLO2*HO2 - r411*XYLENO2*HO2 - - r414*XYLOLO2*HO2 - r422*APINNO3*HO2 - r430*APINO2*HO2 - r442*BCARYNO3*HO2 - r450*BCARYO2*HO2 - - r462*BPINNO3*HO2 - r470*BPINO2*HO2 - r481*LIMONNO3*HO2 - r490*LIMONO2*HO2 - r501*MYRCNO3*HO2 - - r510*MYRCO2*HO2 - r521*TERP1OOHO2*HO2 - r525*TERP2OOHO2*HO2 - r529*TERPA1O2*HO2 - - r537*TERPA2CO3*HO2 - r545*TERPA2O2*HO2 - r555*TERPA3CO3*HO2 - r564*TERPA3O2*HO2 - - r574*TERPA4O2*HO2 - r585*TERPACO3*HO2 - r594*TERPF1O2*HO2 - r599*TERPF2O2*HO2 - - r606*TERPNPS1O2*HO2 - r610*TERPNPT1O2*HO2 - r614*TERPNS1O2*HO2 - r618*TERPNT1O2*HO2 + - r62*CLO*HO2 - r88*BR*HO2 - r94*BRO*HO2 - r131*CH2O*HO2 - r137*CH3O2*HO2 - r145*HOCH2OO*HO2 + - r159*C2H5O2*HO2 - r170*CH3CO3*HO2 - r174*EO2*HO2 - r189*C3H7O2*HO2 - r198*PO2*HO2 + - r202*RO2*HO2 - r216*MACRO2*HO2 - r223*MCO3*HO2 - r227*MEKO2*HO2 - r235*MVKO2*HO2 + - r242*ALKO2*HO2 - r254*IEPOXOO*HO2 - r259*ISOPB1O2*HO2 - r265*ISOPB4O2*HO2 - r279*ISOPED1O2*HO2 + - r283*ISOPED4O2*HO2 - r290*ISOPN1DO2*HO2 - r294*ISOPN2BO2*HO2 - r297*ISOPN3BO2*HO2 + - r300*ISOPN4DO2*HO2 - r304*ISOPNBNO3O2*HO2 - r309*ISOPNO3*HO2 - r312*ISOPNOOHBO2*HO2 + - r315*ISOPNOOHDO2*HO2 - r326*ISOPZD1O2*HO2 - r330*ISOPZD4O2*HO2 - r332*NC4CHOO2*HO2 + - r374*ACBZO2*HO2 - r377*BENZO2*HO2 - r381*BZOO*HO2 - r384*C6H5O2*HO2 - r388*DICARBO2*HO2 + - r391*MALO2*HO2 - r394*MDIALO2*HO2 - r397*PHENO2*HO2 - r404*TOLO2*HO2 - r410*XYLENO2*HO2 + - r413*XYLOLO2*HO2 - r421*APINNO3*HO2 - r429*APINO2*HO2 - r441*BCARYNO3*HO2 - r449*BCARYO2*HO2 + - r461*BPINNO3*HO2 - r469*BPINO2*HO2 - r480*LIMONNO3*HO2 - r489*LIMONO2*HO2 - r500*MYRCNO3*HO2 + - r509*MYRCO2*HO2 - r520*TERP1OOHO2*HO2 - r524*TERP2OOHO2*HO2 - r528*TERPA1O2*HO2 + - r536*TERPA2CO3*HO2 - r544*TERPA2O2*HO2 - r554*TERPA3CO3*HO2 - r563*TERPA3O2*HO2 + - r573*TERPA4O2*HO2 - r584*TERPACO3*HO2 - r593*TERPF1O2*HO2 - r598*TERPF2O2*HO2 + - r605*TERPNPS1O2*HO2 - r609*TERPNPT1O2*HO2 - r613*TERPNS1O2*HO2 - r617*TERPNT1O2*HO2 d(HOCH2OO)/dt = r131*CH2O*HO2 - - r147*HOCH2OO - r146*HO2*HOCH2OO - r148*NO*HOCH2OO - d(IEPOXOO)/dt = .32*r252*HYDRALD*OH + .81*r254*IEPOX*OH - - r255*HO2*IEPOXOO - r337*NO*IEPOXOO - r338*NO*IEPOXOO - d(ISOPB1O2)/dt = r270*O2*ISOPC1C + r272*O2*ISOPC1T + .53*r323*ISOPOOH*OH - - r261*ISOPB1O2 - r262*ISOPB1O2 - r263*ISOPB1O2 - r258*CH3CO3*ISOPB1O2 - r259*CH3O2*ISOPB1O2 - - r260*HO2*ISOPB1O2 - r339*NO*ISOPB1O2 - r340*NO*ISOPB1O2 - d(ISOPB4O2)/dt = r274*O2*ISOPC4C + r276*O2*ISOPC4T + .16*r323*ISOPOOH*OH - - r267*ISOPB4O2 - r268*ISOPB4O2 - r269*ISOPB4O2 - r264*CH3CO3*ISOPB4O2 - r265*CH3O2*ISOPB4O2 - - r266*HO2*ISOPB4O2 - r341*NO*ISOPB4O2 - r342*NO*ISOPB4O2 - d(ISOPC1C)/dt = r262*ISOPB1O2 + r328*ISOPZD1O2 + .315*r321*ISOP*OH - - r270*O2*ISOPC1C - r271*O2*ISOPC1C - d(ISOPC1T)/dt = r263*ISOPB1O2 + r281*ISOPED1O2 + .315*r321*ISOP*OH - - r272*O2*ISOPC1T - r273*O2*ISOPC1T - d(ISOPC4C)/dt = r268*ISOPB4O2 + r332*ISOPZD4O2 + .259*r321*ISOP*OH - - r274*O2*ISOPC4C - r275*O2*ISOPC4C - d(ISOPC4T)/dt = r269*ISOPB4O2 + r285*ISOPED4O2 + .111*r321*ISOP*OH - - r276*O2*ISOPC4T - r277*O2*ISOPC4T - d(ISOPED1O2)/dt = r273*O2*ISOPC1T - - r281*ISOPED1O2 - r278*CH3CO3*ISOPED1O2 - r279*CH3O2*ISOPED1O2 - r280*HO2*ISOPED1O2 - - r343*NO*ISOPED1O2 - r344*NO*ISOPED1O2 - d(ISOPED4O2)/dt = r277*O2*ISOPC4T - - r285*ISOPED4O2 - r282*CH3CO3*ISOPED4O2 - r283*CH3O2*ISOPED4O2 - r284*HO2*ISOPED4O2 - - r345*NO*ISOPED4O2 - r346*NO*ISOPED4O2 - d(ISOPN1DO2)/dt = .82*r294*ISOPN1D*OH - - r292*ISOPN1DO2 - r291*HO2*ISOPN1DO2 - r347*NO*ISOPN1DO2 - r348*NO*ISOPN1DO2 - d(ISOPN2BO2)/dt = .85*r297*ISOPN2B*OH - - r296*ISOPN2BO2 - r295*HO2*ISOPN2BO2 - r349*NO*ISOPN2BO2 - r350*NO*ISOPN2BO2 - d(ISOPN3BO2)/dt = .87*r300*ISOPN3B*OH - - r299*ISOPN3BO2 - r298*HO2*ISOPN3BO2 - r351*NO*ISOPN3BO2 - r352*NO*ISOPN3BO2 - d(ISOPN4DO2)/dt = .89*r304*ISOPN4D*OH - - r302*ISOPN4DO2 - r301*HO2*ISOPN4DO2 - r353*NO*ISOPN4DO2 - r354*NO*ISOPN4DO2 - d(ISOPNBNO3O2)/dt = .92*r306*ISOPNBNO3*OH - - r305*HO2*ISOPNBNO3O2 - r355*NO*ISOPNBNO3O2 - r356*NO*ISOPNBNO3O2 - d(ISOPNO3)/dt = r307*ISOP*NO3 + .17*r315*ISOPNOOHB*OH + .07*r319*ISOPNOOHD*OH - - r308*CH3CO3*ISOPNO3 - r309*CH3O2*ISOPNO3 - r310*HO2*ISOPNO3 - 2*r311*ISOPNO3*ISOPNO3 - - r312*NO3*ISOPNO3 - r357*NO*ISOPNO3 - r358*NO*ISOPNO3 - d(ISOPNOOHBO2)/dt = .41*r315*ISOPNOOHB*OH - - r314*ISOPNOOHBO2 - r313*HO2*ISOPNOOHBO2 - r359*NO*ISOPNOOHBO2 - r360*NO*ISOPNOOHBO2 - d(ISOPNOOHDO2)/dt = .57*r319*ISOPNOOHD*OH - - r317*ISOPNOOHDO2 - r316*HO2*ISOPNOOHDO2 - r361*NO*ISOPNOOHDO2 - r362*NO*ISOPNOOHDO2 - d(ISOPO2VBS)/dt = r697*ISOP*OH - - r694*HO2*ISOPO2VBS - r695*NO*ISOPO2VBS - d(ISOPZD1O2)/dt = r271*O2*ISOPC1C - - r328*ISOPZD1O2 - r363*ISOPZD1O2 - r325*CH3CO3*ISOPZD1O2 - r326*CH3O2*ISOPZD1O2 - - r327*HO2*ISOPZD1O2 - r364*NO*ISOPZD1O2 - r365*NO*ISOPZD1O2 - d(ISOPZD4O2)/dt = r275*O2*ISOPC4C - - r332*ISOPZD4O2 - r366*ISOPZD4O2 - r329*CH3CO3*ISOPZD4O2 - r330*CH3O2*ISOPZD4O2 - - r331*HO2*ISOPZD4O2 - r367*NO*ISOPZD4O2 - r368*NO*ISOPZD4O2 - d(IVOCO2VBS)/dt = r700*IVOC*OH - - r698*HO2*IVOCO2VBS - r699*NO*IVOCO2VBS - d(LIMONNO3)/dt = r478*LIMON*NO3 - - r479*CH3CO3*LIMONNO3 - r480*CH3O2*LIMONNO3 - r481*HO2*LIMONNO3 - 2*r482*LIMONNO3*LIMONNO3 - - r483*NO*LIMONNO3 - r484*NO3*LIMONNO3 - r485*TERPA2CO3*LIMONNO3 - r486*TERPA3CO3*LIMONNO3 - - r487*TERPACO3*LIMONNO3 - d(LIMONO2)/dt = r497*LIMON*OH - - r488*CH3CO3*LIMONO2 - r489*CH3O2*LIMONO2 - r490*HO2*LIMONO2 - r491*NO*LIMONO2 - - r492*NO3*LIMONO2 - r493*TERPA2CO3*LIMONO2 - r494*TERPA3CO3*LIMONO2 - r495*TERPACO3*LIMONO2 - d(LIMONO2VBS)/dt = r705*LIMON*OH - - r702*HO2*LIMONO2VBS - r703*NO*LIMONO2VBS - d(MACRO2)/dt = .19*j49*HPALD4 + .55*r220*MACR*OH - - r218*MACRO2 - r215*CH3CO3*MACRO2 - r216*CH3O2*MACRO2 - r217*HO2*MACRO2 - r369*NO*MACRO2 - - r370*NO*MACRO2 + - r146*HOCH2OO - r145*HO2*HOCH2OO - r147*NO*HOCH2OO + d(IEPOXOO)/dt = .32*r251*HYDRALD*OH + .81*r253*IEPOX*OH + - r254*HO2*IEPOXOO - r336*NO*IEPOXOO - r337*NO*IEPOXOO + d(ISOPB1O2)/dt = r269*O2*ISOPC1C + r271*O2*ISOPC1T + .53*r322*ISOPOOH*OH + - r260*ISOPB1O2 - r261*ISOPB1O2 - r262*ISOPB1O2 - r257*CH3CO3*ISOPB1O2 - r258*CH3O2*ISOPB1O2 + - r259*HO2*ISOPB1O2 - r338*NO*ISOPB1O2 - r339*NO*ISOPB1O2 + d(ISOPB4O2)/dt = r273*O2*ISOPC4C + r275*O2*ISOPC4T + .16*r322*ISOPOOH*OH + - r266*ISOPB4O2 - r267*ISOPB4O2 - r268*ISOPB4O2 - r263*CH3CO3*ISOPB4O2 - r264*CH3O2*ISOPB4O2 + - r265*HO2*ISOPB4O2 - r340*NO*ISOPB4O2 - r341*NO*ISOPB4O2 + d(ISOPC1C)/dt = r261*ISOPB1O2 + r327*ISOPZD1O2 + .315*r320*ISOP*OH + - r269*O2*ISOPC1C - r270*O2*ISOPC1C + d(ISOPC1T)/dt = r262*ISOPB1O2 + r280*ISOPED1O2 + .315*r320*ISOP*OH + - r271*O2*ISOPC1T - r272*O2*ISOPC1T + d(ISOPC4C)/dt = r267*ISOPB4O2 + r331*ISOPZD4O2 + .259*r320*ISOP*OH + - r273*O2*ISOPC4C - r274*O2*ISOPC4C + d(ISOPC4T)/dt = r268*ISOPB4O2 + r284*ISOPED4O2 + .111*r320*ISOP*OH + - r275*O2*ISOPC4T - r276*O2*ISOPC4T + d(ISOPED1O2)/dt = r272*O2*ISOPC1T + - r280*ISOPED1O2 - r277*CH3CO3*ISOPED1O2 - r278*CH3O2*ISOPED1O2 - r279*HO2*ISOPED1O2 + - r342*NO*ISOPED1O2 - r343*NO*ISOPED1O2 + d(ISOPED4O2)/dt = r276*O2*ISOPC4T + - r284*ISOPED4O2 - r281*CH3CO3*ISOPED4O2 - r282*CH3O2*ISOPED4O2 - r283*HO2*ISOPED4O2 + - r344*NO*ISOPED4O2 - r345*NO*ISOPED4O2 + d(ISOPN1DO2)/dt = .82*r293*ISOPN1D*OH + - r291*ISOPN1DO2 - r290*HO2*ISOPN1DO2 - r346*NO*ISOPN1DO2 - r347*NO*ISOPN1DO2 + d(ISOPN2BO2)/dt = .85*r296*ISOPN2B*OH + - r295*ISOPN2BO2 - r294*HO2*ISOPN2BO2 - r348*NO*ISOPN2BO2 - r349*NO*ISOPN2BO2 + d(ISOPN3BO2)/dt = .87*r299*ISOPN3B*OH + - r298*ISOPN3BO2 - r297*HO2*ISOPN3BO2 - r350*NO*ISOPN3BO2 - r351*NO*ISOPN3BO2 + d(ISOPN4DO2)/dt = .89*r303*ISOPN4D*OH + - r301*ISOPN4DO2 - r300*HO2*ISOPN4DO2 - r352*NO*ISOPN4DO2 - r353*NO*ISOPN4DO2 + d(ISOPNBNO3O2)/dt = .92*r305*ISOPNBNO3*OH + - r304*HO2*ISOPNBNO3O2 - r354*NO*ISOPNBNO3O2 - r355*NO*ISOPNBNO3O2 + d(ISOPNO3)/dt = r306*ISOP*NO3 + .17*r314*ISOPNOOHB*OH + .07*r318*ISOPNOOHD*OH + - r307*CH3CO3*ISOPNO3 - r308*CH3O2*ISOPNO3 - r309*HO2*ISOPNO3 - 2*r310*ISOPNO3*ISOPNO3 + - r311*NO3*ISOPNO3 - r356*NO*ISOPNO3 - r357*NO*ISOPNO3 + d(ISOPNOOHBO2)/dt = .41*r314*ISOPNOOHB*OH + - r313*ISOPNOOHBO2 - r312*HO2*ISOPNOOHBO2 - r358*NO*ISOPNOOHBO2 - r359*NO*ISOPNOOHBO2 + d(ISOPNOOHDO2)/dt = .57*r318*ISOPNOOHD*OH + - r316*ISOPNOOHDO2 - r315*HO2*ISOPNOOHDO2 - r360*NO*ISOPNOOHDO2 - r361*NO*ISOPNOOHDO2 + d(ISOPO2VBS)/dt = r696*ISOP*OH + - r693*HO2*ISOPO2VBS - r694*NO*ISOPO2VBS + d(ISOPZD1O2)/dt = r270*O2*ISOPC1C + - r327*ISOPZD1O2 - r362*ISOPZD1O2 - r324*CH3CO3*ISOPZD1O2 - r325*CH3O2*ISOPZD1O2 + - r326*HO2*ISOPZD1O2 - r363*NO*ISOPZD1O2 - r364*NO*ISOPZD1O2 + d(ISOPZD4O2)/dt = r274*O2*ISOPC4C + - r331*ISOPZD4O2 - r365*ISOPZD4O2 - r328*CH3CO3*ISOPZD4O2 - r329*CH3O2*ISOPZD4O2 + - r330*HO2*ISOPZD4O2 - r366*NO*ISOPZD4O2 - r367*NO*ISOPZD4O2 + d(IVOCO2VBS)/dt = r699*IVOC*OH + - r697*HO2*IVOCO2VBS - r698*NO*IVOCO2VBS + d(LIMONNO3)/dt = r477*LIMON*NO3 + - r478*CH3CO3*LIMONNO3 - r479*CH3O2*LIMONNO3 - r480*HO2*LIMONNO3 - 2*r481*LIMONNO3*LIMONNO3 + - r482*NO*LIMONNO3 - r483*NO3*LIMONNO3 - r484*TERPA2CO3*LIMONNO3 - r485*TERPA3CO3*LIMONNO3 + - r486*TERPACO3*LIMONNO3 + d(LIMONO2)/dt = r496*LIMON*OH + - r487*CH3CO3*LIMONO2 - r488*CH3O2*LIMONO2 - r489*HO2*LIMONO2 - r490*NO*LIMONO2 + - r491*NO3*LIMONO2 - r492*TERPA2CO3*LIMONO2 - r493*TERPA3CO3*LIMONO2 - r494*TERPACO3*LIMONO2 + d(LIMONO2VBS)/dt = r704*LIMON*OH + - r701*HO2*LIMONO2VBS - r702*NO*LIMONO2VBS + d(MACRO2)/dt = .19*j49*HPALD4 + .55*r219*MACR*OH + - r217*MACRO2 - r214*CH3CO3*MACRO2 - r215*CH3O2*MACRO2 - r216*HO2*MACRO2 - r368*NO*MACRO2 + - r369*NO*MACRO2 d(MALO2)/dt = .6*j23*BIGALD1 - - r392*HO2*MALO2 - r393*NO*MALO2 - r394*M*NO2*MALO2 - d(MCO3)/dt = j73*MACR + j78*MPAN + r241*M*MPAN + .45*r220*MACR*OH - - r222*CH3CO3*MCO3 - r223*CH3O2*MCO3 - r224*HO2*MCO3 - 2*r225*MCO3*MCO3 - r226*NO*MCO3 - - r227*NO3*MCO3 - r240*M*NO2*MCO3 + - r391*HO2*MALO2 - r392*NO*MALO2 - r393*M*NO2*MALO2 + d(MCO3)/dt = j73*MACR + j78*MPAN + r240*M*MPAN + .45*r219*MACR*OH + - r221*CH3CO3*MCO3 - r222*CH3O2*MCO3 - r223*HO2*MCO3 - 2*r224*MCO3*MCO3 - r225*NO*MCO3 + - r226*NO3*MCO3 - r239*M*NO2*MCO3 d(MDIALO2)/dt = .6*j25*BIGALD3 - - r395*HO2*MDIALO2 - r396*NO*MDIALO2 - r397*M*NO2*MDIALO2 - d(MEKO2)/dt = r230*MEK*OH + r231*MEKOOH*OH - - r228*HO2*MEKO2 - r229*NO*MEKO2 - d(MVKO2)/dt = .23*j48*HPALD1 + r238*MVK*OH - - r234*CH3CO3*MVKO2 - r235*CH3O2*MVKO2 - r236*HO2*MVKO2 - r371*NO*MVKO2 - r372*NO*MVKO2 - d(MYRCNO3)/dt = r498*MYRC*NO3 - - r499*CH3CO3*MYRCNO3 - r500*CH3O2*MYRCNO3 - r501*HO2*MYRCNO3 - 2*r502*MYRCNO3*MYRCNO3 - - r503*NO*MYRCNO3 - r504*NO3*MYRCNO3 - r505*TERPA2CO3*MYRCNO3 - r506*TERPA3CO3*MYRCNO3 - - r507*TERPACO3*MYRCNO3 - d(MYRCO2)/dt = r517*MYRC*OH - - r508*CH3CO3*MYRCO2 - r509*CH3O2*MYRCO2 - r510*HO2*MYRCO2 - r511*NO*MYRCO2 - r512*NO3*MYRCO2 - - r513*TERPA2CO3*MYRCO2 - r514*TERPA3CO3*MYRCO2 - r515*TERPACO3*MYRCO2 - d(MYRCO2VBS)/dt = r710*MYRC*OH - - r707*HO2*MYRCO2VBS - r708*NO*MYRCO2VBS - d(NC4CHOO2)/dt = .4*r256*INHEB*OH + .35*r257*INHED*OH + .23*r336*NC4CHO*OH - - r334*NC4CHOO2 - r333*HO2*NC4CHOO2 - r373*NO*NC4CHOO2 - r374*NO*NC4CHOO2 + - r394*HO2*MDIALO2 - r395*NO*MDIALO2 - r396*M*NO2*MDIALO2 + d(MEKO2)/dt = r229*MEK*OH + r230*MEKOOH*OH + - r227*HO2*MEKO2 - r228*NO*MEKO2 + d(MVKO2)/dt = .23*j48*HPALD1 + r237*MVK*OH + - r233*CH3CO3*MVKO2 - r234*CH3O2*MVKO2 - r235*HO2*MVKO2 - r370*NO*MVKO2 - r371*NO*MVKO2 + d(MYRCNO3)/dt = r497*MYRC*NO3 + - r498*CH3CO3*MYRCNO3 - r499*CH3O2*MYRCNO3 - r500*HO2*MYRCNO3 - 2*r501*MYRCNO3*MYRCNO3 + - r502*NO*MYRCNO3 - r503*NO3*MYRCNO3 - r504*TERPA2CO3*MYRCNO3 - r505*TERPA3CO3*MYRCNO3 + - r506*TERPACO3*MYRCNO3 + d(MYRCO2)/dt = r516*MYRC*OH + - r507*CH3CO3*MYRCO2 - r508*CH3O2*MYRCO2 - r509*HO2*MYRCO2 - r510*NO*MYRCO2 - r511*NO3*MYRCO2 + - r512*TERPA2CO3*MYRCO2 - r513*TERPA3CO3*MYRCO2 - r514*TERPACO3*MYRCO2 + d(MYRCO2VBS)/dt = r709*MYRC*OH + - r706*HO2*MYRCO2VBS - r707*NO*MYRCO2VBS + d(NC4CHOO2)/dt = .4*r255*INHEB*OH + .35*r256*INHED*OH + .23*r335*NC4CHO*OH + - r333*NC4CHOO2 - r332*HO2*NC4CHOO2 - r372*NO*NC4CHOO2 - r373*NO*NC4CHOO2 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 - r43*N2O*O1D - r44*N2O*O1D - r76*CCL4*O1D - r77*CF2CLBR*O1D - r78*CFC11*O1D - r79*CFC113*O1D - r80*CFC114*O1D - r81*CFC115*O1D - r82*CFC12*O1D - r83*HCL*O1D - r84*HCL*O1D - r103*CF3BR*O1D - r104*CHBR3*O1D - r105*H2402*O1D - r106*HBR*O1D - r107*HBR*O1D - r112*COF2*O1D - r113*COFCL*O1D - r126*CH2BR2*O1D - r127*CH3BR*O1D - r128*HCFC141B*O1D - r129*HCFC142B*O1D - r130*HCFC22*O1D - - r149*CH4*O1D - r150*CH4*O1D - r151*CH4*O1D - r152*HCN*O1D + - r148*CH4*O1D - r149*CH4*O1D - r150*CH4*O1D - r151*HCN*O1D d(OH)/dt = j2*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j20*ALKOOH + j21*BENZOOH + j27*BZOOH + j28*C2H5OOH + j29*C3H7OOH + j30*C6H5OOH + j36*CH3COOOH + j37*CH3OOH + .33*j39*CH4 + 1.5*j41*DHPMPAL + j42*EOOH + j45*HCOCH2OOH + 2*j46*HMHP + 1.11*j48*HPALD1 + 1.1799999*j49*HPALD4 + j50*HPALDB1C @@ -3033,170 +3027,169 @@ Extraneous prod/loss species + j75*MACROOH + j77*MEKOOH + j81*MVKOOH + j87*PHENOOH + j88*POOH + j89*ROOH + j91*TERP1OOH + j92*TERP2AOOH + j98*TERPACID + j99*TERPACID2 + j100*TERPACID3 + j102*TERPDHDP + j104*TERPHFN + j105*TERPNPS + j106*TERPNPS1 + j107*TERPNPT + j108*TERPNPT1 + j113*TERPOOH + j114*TERPOOHL - + j115*TOLOOH + j116*XYLENOOH + j117*XYLOLOOH + j149*HOBR + j150*HOCL + r218*MACRO2 - + r261*ISOPB1O2 + r267*ISOPB4O2 + r314*ISOPNOOHBO2 + r317*ISOPNOOHDO2 + r334*NC4CHOO2 - + .6*r363*ISOPZD1O2 + .6*r366*ISOPZD4O2 + .5*r664*NO2 + r1*O1D*H2 + 2*r2*O1D*H2O + r9*H2*O + + j115*TOLOOH + j116*XYLENOOH + j117*XYLOLOOH + j149*HOBR + j150*HOCL + r217*MACRO2 + + r260*ISOPB1O2 + r266*ISOPB4O2 + r313*ISOPNOOHBO2 + r316*ISOPNOOHDO2 + r333*NC4CHOO2 + + .6*r362*ISOPZD1O2 + .6*r365*ISOPZD4O2 + .5*r663*NO2 + r1*O1D*H2 + 2*r2*O1D*H2O + r9*H2*O + r10*H2O2*O + 2*r12*H*HO2 + r15*HO2*O + r16*HO2*O3 + r17*H*O3 + r35*NO3*HO2 + r40*NO*HO2 + r56*CL*HO2 + r71*HCL*O + r74*HOCL*O + r83*O1D*HCL + r100*HBR*O + r102*HOBR*O + r106*O1D*HBR - + r110*F*H2O + r133*CH2O*O + .3*r140*CH3OOH*OH + .5*r145*HMHP*OH + .2*r146*HOCH2OO*HO2 - + r149*O1D*CH4 + r152*O1D*HCN + .65*r155*M*C2H2*OH + .13*r157*C2H4*O3 + .5*r163*C2H5OOH*OH - + .49*r171*CH3CO3*HO2 + .89*r181*HCOCH2OOH*OH + .36*r188*C3H6*O3 + .7*r197*HYPERACET*OH - + .5*r201*POOH*OH + .15*r203*RO2*HO2 + .59*r217*MACRO2*HO2 + .24*r219*MACR*O3 + .49*r224*MCO3*HO2 - + .2*r228*MEKO2*HO2 + .54*r236*MVKO2*HO2 + .36*r237*MVK*O3 + .43*r248*HPALD1*OH - + .53*r249*HPALD4*OH + 1.08*r252*HYDRALD*OH + .65*r255*IEPOXOO*HO2 + .06*r260*ISOPB1O2*HO2 - + .06*r266*ISOPB4O2*HO2 + .55*r278*ISOPED1O2*CH3CO3 + .28*r279*ISOPED1O2*CH3O2 - + .55*r282*ISOPED4O2*CH3CO3 + .28*r283*ISOPED4O2*CH3O2 + .5*r288*ISOPFNC*OH - + .58*r291*ISOPN1DO2*HO2 + .34*r293*ISOPN1D*O3 + .06*r294*ISOPN1D*OH + .52*r295*ISOPN2BO2*HO2 - + .6*r298*ISOPN3BO2*HO2 + .5*r301*ISOPN4DO2*HO2 + .34*r303*ISOPN4D*O3 + .04*r304*ISOPN4D*OH - + .4*r305*ISOPNBNO3O2*HO2 + .03*r306*ISOPNBNO3*OH + .24*r310*ISOPNO3*HO2 + .85*r313*ISOPNOOHBO2*HO2 - + .42*r315*ISOPNOOHB*OH + .86*r316*ISOPNOOHDO2*HO2 + .51*r318*ISOPNOOHD*O3 + .29*r319*ISOPNOOHD*OH - + .25*r320*ISOP*O3 + .13*r323*ISOPOOH*OH + .92*r324*ISOPOOH*OH + .55*r325*ISOPZD1O2*CH3CO3 - + .28*r326*ISOPZD1O2*CH3O2 + .55*r329*ISOPZD4O2*CH3CO3 + .28*r330*ISOPZD4O2*CH3O2 - + .8*r333*NC4CHOO2*HO2 + .34*r335*NC4CHO*O3 + .55*r343*ISOPED1O2*NO + .55*r345*ISOPED4O2*NO - + .47*r359*ISOPNOOHBO2*NO + .04*r361*ISOPNOOHDO2*NO + .55*r364*ISOPZD1O2*NO + .55*r367*ISOPZD4O2*NO - + .4*r375*ACBZO2*HO2 + .4*r389*DICARBO2*HO2 + .4*r395*MDIALO2*HO2 + .7*r422*APINNO3*HO2 - + .35*r430*APINO2*HO2 + .77*r436*APIN*O3 + .5*r442*BCARYNO3*HO2 + .1*r450*BCARYO2*HO2 - + .08*r456*BCARY*O3 + .47*r462*BPINNO3*HO2 + .03*r470*BPINO2*HO2 + .3*r476*BPIN*O3 - + .5*r481*LIMONNO3*HO2 + .1*r490*LIMONO2*HO2 + .66*r496*LIMON*O3 + .48*r501*MYRCNO3*HO2 - + .1*r510*MYRCO2*HO2 + .63*r516*MYRC*O3 + .18*r521*TERP1OOHO2*HO2 + .18*r525*TERP2OOHO2*HO2 - + .49*r537*TERPA2CO3*HO2 + .38*r545*TERPA2O2*HO2 + .49*r555*TERPA3CO3*HO2 + .15*r564*TERPA3O2*HO2 - + .53*r574*TERPA4O2*HO2 + .49*r585*TERPACO3*HO2 + .1*r594*TERPF1O2*HO2 + .09*r596*TERPF1*O3 - + .1*r599*TERPF2O2*HO2 + .1*r606*TERPNPS1O2*HO2 + .1*r610*TERPNPT1O2*HO2 + .1*r614*TERPNS1O2*HO2 - + .1*r618*TERPNT1O2*HO2 + + r110*F*H2O + r133*CH2O*O + .3*r140*CH3OOH*OH + .5*r144*HMHP*OH + .2*r145*HOCH2OO*HO2 + + r148*O1D*CH4 + r151*O1D*HCN + .65*r154*M*C2H2*OH + .13*r156*C2H4*O3 + .5*r162*C2H5OOH*OH + + .49*r170*CH3CO3*HO2 + .89*r180*HCOCH2OOH*OH + .36*r187*C3H6*O3 + .7*r196*HYPERACET*OH + + .5*r200*POOH*OH + .15*r202*RO2*HO2 + .59*r216*MACRO2*HO2 + .24*r218*MACR*O3 + .49*r223*MCO3*HO2 + + .2*r227*MEKO2*HO2 + .54*r235*MVKO2*HO2 + .36*r236*MVK*O3 + .43*r247*HPALD1*OH + + .53*r248*HPALD4*OH + 1.08*r251*HYDRALD*OH + .65*r254*IEPOXOO*HO2 + .06*r259*ISOPB1O2*HO2 + + .06*r265*ISOPB4O2*HO2 + .55*r277*ISOPED1O2*CH3CO3 + .28*r278*ISOPED1O2*CH3O2 + + .55*r281*ISOPED4O2*CH3CO3 + .28*r282*ISOPED4O2*CH3O2 + .5*r287*ISOPFNC*OH + + .58*r290*ISOPN1DO2*HO2 + .34*r292*ISOPN1D*O3 + .06*r293*ISOPN1D*OH + .52*r294*ISOPN2BO2*HO2 + + .6*r297*ISOPN3BO2*HO2 + .5*r300*ISOPN4DO2*HO2 + .34*r302*ISOPN4D*O3 + .04*r303*ISOPN4D*OH + + .4*r304*ISOPNBNO3O2*HO2 + .03*r305*ISOPNBNO3*OH + .24*r309*ISOPNO3*HO2 + .85*r312*ISOPNOOHBO2*HO2 + + .42*r314*ISOPNOOHB*OH + .86*r315*ISOPNOOHDO2*HO2 + .51*r317*ISOPNOOHD*O3 + .29*r318*ISOPNOOHD*OH + + .25*r319*ISOP*O3 + .13*r322*ISOPOOH*OH + .92*r323*ISOPOOH*OH + .55*r324*ISOPZD1O2*CH3CO3 + + .28*r325*ISOPZD1O2*CH3O2 + .55*r328*ISOPZD4O2*CH3CO3 + .28*r329*ISOPZD4O2*CH3O2 + + .8*r332*NC4CHOO2*HO2 + .34*r334*NC4CHO*O3 + .55*r342*ISOPED1O2*NO + .55*r344*ISOPED4O2*NO + + .47*r358*ISOPNOOHBO2*NO + .04*r360*ISOPNOOHDO2*NO + .55*r363*ISOPZD1O2*NO + .55*r366*ISOPZD4O2*NO + + .4*r374*ACBZO2*HO2 + .4*r388*DICARBO2*HO2 + .4*r394*MDIALO2*HO2 + .7*r421*APINNO3*HO2 + + .35*r429*APINO2*HO2 + .77*r435*APIN*O3 + .5*r441*BCARYNO3*HO2 + .1*r449*BCARYO2*HO2 + + .08*r455*BCARY*O3 + .47*r461*BPINNO3*HO2 + .03*r469*BPINO2*HO2 + .3*r475*BPIN*O3 + + .5*r480*LIMONNO3*HO2 + .1*r489*LIMONO2*HO2 + .66*r495*LIMON*O3 + .48*r500*MYRCNO3*HO2 + + .1*r509*MYRCO2*HO2 + .63*r515*MYRC*O3 + .18*r520*TERP1OOHO2*HO2 + .18*r524*TERP2OOHO2*HO2 + + .49*r536*TERPA2CO3*HO2 + .38*r544*TERPA2O2*HO2 + .49*r554*TERPA3CO3*HO2 + .15*r563*TERPA3O2*HO2 + + .53*r573*TERPA4O2*HO2 + .49*r584*TERPACO3*HO2 + .1*r593*TERPF1O2*HO2 + .09*r595*TERPF1*O3 + + .1*r598*TERPF2O2*HO2 + .1*r605*TERPNPS1O2*HO2 + .1*r609*TERPNPT1O2*HO2 + .1*r613*TERPNS1O2*HO2 + + .1*r617*TERPNT1O2*HO2 - r18*H2*OH - r19*H2O2*OH - r20*HO2*OH - r21*O*OH - r22*O3*OH - 2*r23*OH*OH - 2*r24*M*OH*OH - r26*HO2NO2*OH - r38*NO3*OH - r39*N*OH - r47*M*NO2*OH - r48*HNO3*OH - r67*CLONO2*OH - r69*CLO*OH - r70*CLO*OH - r72*HCL*OH - r75*HOCL*OH - r99*BRO*OH - r101*HBR*OH - r115*CH2BR2*OH - r117*CH3BR*OH - r118*CH3CCL3*OH - r120*CH3CL*OH - r122*CHBR3*OH - r123*HCFC141B*OH - r124*HCFC142B*OH - r125*HCFC22*OH - r134*CH2O*OH - r139*CH3OH*OH - r140*CH3OOH*OH - r141*CH4*OH - - r142*M*CO*OH - r143*M*HCN*OH - r144*HCOOH*OH - r145*HMHP*OH - r153*CO*OH - r155*M*C2H2*OH - - r162*C2H5OH*OH - r163*C2H5OOH*OH - r165*C2H6*OH - r167*CH3CHO*OH - r168*CH3CN*OH - - r173*CH3COOH*OH - r174*CH3COOOH*OH - r179*GLYALD*OH - r180*GLYOXAL*OH - r181*HCOCH2OOH*OH - - r182*NO3CH2CHO*OH - r183*PAN*OH - r184*M*C2H4*OH - r192*C3H7OOH*OH - r193*C3H8*OH - - r195*CH3COCHO*OH - r196*HYAC*OH - r197*HYPERACET*OH - r198*NOA*OH - r201*POOH*OH - r205*ROOH*OH - - r206*M*C3H6*OH - r207*CH3COCH3*OH - r209*BIGENE*OH - r213*HONITR*OH - r214*MACRN*OH - - r220*MACR*OH - r230*MEK*OH - r231*MEKOOH*OH - r232*M*MPAN*OH - r233*MVKN*OH - r238*MVK*OH - - r239*MVKOOH*OH - r242*ALKNIT*OH - r246*ALKOOH*OH - r247*BIGALK*OH - r248*HPALD1*OH - - r249*HPALD4*OH - r252*HYDRALD*OH - r254*IEPOX*OH - r256*INHEB*OH - r257*INHED*OH - - r286*ISOPFDNC*OH - r287*ISOPFDN*OH - r288*ISOPFNC*OH - r289*ISOPFNP*OH - r294*ISOPN1D*OH - - r297*ISOPN2B*OH - r300*ISOPN3B*OH - r304*ISOPN4D*OH - r306*ISOPNBNO3*OH - r315*ISOPNOOHB*OH - - r319*ISOPNOOHD*OH - r321*ISOP*OH - r322*ISOPOH*OH - r323*ISOPOOH*OH - r324*ISOPOOH*OH - - r336*NC4CHO*OH - r377*BENZENE*OH - r380*BENZOOH*OH - r381*BZALD*OH - r383*BZOOH*OH - - r387*C6H5OOH*OH - r388*CRESOL*OH - r400*PHENOL*OH - r403*PHENOOH*OH - r407*TOLOOH*OH - - r408*TOLUENE*OH - r410*XYLENES*OH - r413*XYLENOOH*OH - r416*XYLOL*OH - r417*XYLOLOOH*OH - - r437*APIN*OH - r457*BCARY*OH - r477*BPIN*OH - r497*LIMON*OH - r517*MYRC*OH - r523*TERP1OOH*OH - - r524*TERP2AOOH*OH - r551*TERPA2*OH - r552*TERPA2PAN*OH - r570*TERPA3*OH - r571*TERPA3PAN*OH - - r580*TERPACID2*OH - r581*TERPACID3*OH - r582*TERPACID*OH - r590*TERPA*OH - r591*TERPAPAN*OH - - r597*TERPF1*OH - r602*TERPF2*OH - r603*TERPFDN*OH - r605*TERPK*OH - r608*TERPNPS1*OH - - r609*TERPNPS*OH - r612*TERPNPT1*OH - r616*TERPNS1*OH - r617*TERPNS*OH - r620*TERPNT1*OH - - r621*TERPNT*OH - r628*DMS*OH - r630*OCS*OH - r635*S*OH - r640*SO*OH - r641*DMS*OH - - r642*SO2*OH - r644*NH3*OH - d(PHENO2)/dt = .2*r388*CRESOL*OH + .14*r400*PHENOL*OH + r403*PHENOOH*OH - - r398*HO2*PHENO2 - r399*NO*PHENO2 - d(PO2)/dt = .5*r201*POOH*OH + r206*M*C3H6*OH - - r199*HO2*PO2 - r200*NO*PO2 - d(RO2)/dt = r205*ROOH*OH + r207*CH3COCH3*OH - - r202*CH3O2*RO2 - r203*HO2*RO2 - r204*NO*RO2 - d(TERP1OOHO2)/dt = r523*TERP1OOH*OH - - r521*HO2*TERP1OOHO2 - r522*NO*TERP1OOHO2 - d(TERP2OOHO2)/dt = r524*TERP2AOOH*OH - - r525*HO2*TERP2OOHO2 - r526*NO*TERP2OOHO2 - d(TERPA1O2)/dt = j93*TERPA + j98*TERPACID + r427*APINNO3*TERPACO3 + r435*APINO2*TERPACO3 - + r447*BCARYNO3*TERPACO3 + r455*BCARYO2*TERPACO3 + r467*BPINNO3*TERPACO3 - + r475*BPINO2*TERPACO3 + r487*LIMONNO3*TERPACO3 + r495*LIMONO2*TERPACO3 - + r507*MYRCNO3*TERPACO3 + r515*MYRCO2*TERPACO3 + r541*TERPA2CO3*TERPACO3 - + r550*TERPA2O2*TERPACO3 + r560*TERPA3CO3*TERPACO3 + r569*TERPA3O2*TERPACO3 - + r579*TERPA4O2*TERPACO3 + .29*r582*TERPACID*OH + r583*TERPACO3*CH3CO3 + r584*TERPACO3*CH3O2 - + .49*r585*TERPACO3*HO2 + r586*TERPACO3*NO + r587*TERPACO3*NO3 + 2*r588*TERPACO3*TERPACO3 - + .86*r605*TERPK*OH - - r527*CH3CO3*TERPA1O2 - r528*CH3O2*TERPA1O2 - r529*HO2*TERPA1O2 - r530*NO*TERPA1O2 - - r531*NO3*TERPA1O2 - r532*TERPA2CO3*TERPA1O2 - r533*TERPA3CO3*TERPA1O2 - d(TERPA2CO3)/dt = j95*TERPA2PAN + r624*M*TERPA2PAN + .27*r436*APIN*O3 + .3*r476*BPIN*O3 + r542*TERPA2*NO3 - + r551*TERPA2*OH + .71*r580*TERPACID2*OH + .14*r605*TERPK*OH - - r425*APINNO3*TERPA2CO3 - r433*APINO2*TERPA2CO3 - r445*BCARYNO3*TERPA2CO3 - - r453*BCARYO2*TERPA2CO3 - r465*BPINNO3*TERPA2CO3 - r473*BPINO2*TERPA2CO3 - - r485*LIMONNO3*TERPA2CO3 - r493*LIMONO2*TERPA2CO3 - r505*MYRCNO3*TERPA2CO3 - - r513*MYRCO2*TERPA2CO3 - r518*M*NO2*TERPA2CO3 - r532*TERPA1O2*TERPA2CO3 - - r535*CH3CO3*TERPA2CO3 - r536*CH3O2*TERPA2CO3 - r537*HO2*TERPA2CO3 - r538*NO*TERPA2CO3 - - r539*NO3*TERPA2CO3 - 2*r540*TERPA2CO3*TERPA2CO3 - r541*TERPACO3*TERPA2CO3 - - r548*TERPA2O2*TERPA2CO3 - r558*TERPA3CO3*TERPA2CO3 - r567*TERPA3O2*TERPA2CO3 - - r577*TERPA4O2*TERPA2CO3 - d(TERPA2O2)/dt = j94*TERPA2 + j99*TERPACID2 + r425*APINNO3*TERPA2CO3 + r433*APINO2*TERPA2CO3 - + .33*r436*APIN*O3 + r445*BCARYNO3*TERPA2CO3 + r453*BCARYO2*TERPA2CO3 - + r465*BPINNO3*TERPA2CO3 + r473*BPINO2*TERPA2CO3 + r485*LIMONNO3*TERPA2CO3 - + r493*LIMONO2*TERPA2CO3 + r505*MYRCNO3*TERPA2CO3 + r513*MYRCO2*TERPA2CO3 - + r527*TERPA1O2*CH3CO3 + .5*r528*TERPA1O2*CH3O2 + .7*r530*TERPA1O2*NO + r531*TERPA1O2*NO3 - + 2*r532*TERPA1O2*TERPA2CO3 + r533*TERPA1O2*TERPA3CO3 + r534*TERPA1O2*TERPACO3 - + r535*TERPA2CO3*CH3CO3 + r536*TERPA2CO3*CH3O2 + .49*r537*TERPA2CO3*HO2 + r538*TERPA2CO3*NO - + r539*TERPA2CO3*NO3 + 2*r540*TERPA2CO3*TERPA2CO3 + r541*TERPA2CO3*TERPACO3 - + r558*TERPA3CO3*TERPA2CO3 + r567*TERPA3O2*TERPA2CO3 + r577*TERPA4O2*TERPA2CO3 - + .29*r580*TERPACID2*OH + .23*r590*TERPA*OH - - r543*CH3CO3*TERPA2O2 - r544*CH3O2*TERPA2O2 - r545*HO2*TERPA2O2 - r546*NO*TERPA2O2 - - r547*NO3*TERPA2O2 - r549*TERPA3CO3*TERPA2O2 - r550*TERPACO3*TERPA2O2 - d(TERPA3CO3)/dt = j97*TERPA3PAN + r625*M*TERPA3PAN + .33*r496*LIMON*O3 + r561*TERPA3*NO3 + .75*r570*TERPA3*OH - + .71*r581*TERPACID3*OH + .17*r597*TERPF1*OH - - r426*APINNO3*TERPA3CO3 - r434*APINO2*TERPA3CO3 - r446*BCARYNO3*TERPA3CO3 - - r454*BCARYO2*TERPA3CO3 - r466*BPINNO3*TERPA3CO3 - r474*BPINO2*TERPA3CO3 - - r486*LIMONNO3*TERPA3CO3 - r494*LIMONO2*TERPA3CO3 - r506*MYRCNO3*TERPA3CO3 - - r514*MYRCO2*TERPA3CO3 - r519*M*NO2*TERPA3CO3 - r533*TERPA1O2*TERPA3CO3 - - r549*TERPA2O2*TERPA3CO3 - r553*CH3CO3*TERPA3CO3 - r554*CH3O2*TERPA3CO3 - - r555*HO2*TERPA3CO3 - r556*NO*TERPA3CO3 - r557*NO3*TERPA3CO3 - r558*TERPA2CO3*TERPA3CO3 - - 2*r559*TERPA3CO3*TERPA3CO3 - r560*TERPACO3*TERPA3CO3 - r568*TERPA3O2*TERPA3CO3 - - r578*TERPA4O2*TERPA3CO3 - d(TERPA3O2)/dt = r543*TERPA2O2*CH3CO3 + r544*TERPA2O2*CH3O2 + .38*r545*TERPA2O2*HO2 + .83*r546*TERPA2O2*NO - + r547*TERPA2O2*NO3 + r548*TERPA2O2*TERPA2CO3 + r549*TERPA2O2*TERPA3CO3 - + r550*TERPA2O2*TERPACO3 - - r562*CH3CO3*TERPA3O2 - r563*CH3O2*TERPA3O2 - r564*HO2*TERPA3O2 - r565*NO*TERPA3O2 - - r566*NO3*TERPA3O2 - r567*TERPA2CO3*TERPA3O2 - r568*TERPA3CO3*TERPA3O2 - - r569*TERPACO3*TERPA3O2 - d(TERPA4O2)/dt = j96*TERPA3 + j100*TERPACID3 + r426*APINNO3*TERPA3CO3 + r434*APINO2*TERPA3CO3 - + r446*BCARYNO3*TERPA3CO3 + r454*BCARYO2*TERPA3CO3 + r466*BPINNO3*TERPA3CO3 - + r474*BPINO2*TERPA3CO3 + r486*LIMONNO3*TERPA3CO3 + r494*LIMONO2*TERPA3CO3 - + r506*MYRCNO3*TERPA3CO3 + r514*MYRCO2*TERPA3CO3 + r533*TERPA1O2*TERPA3CO3 - + r549*TERPA2O2*TERPA3CO3 + r553*TERPA3CO3*CH3CO3 + r554*TERPA3CO3*CH3O2 - + .49*r555*TERPA3CO3*HO2 + r556*TERPA3CO3*NO + r557*TERPA3CO3*NO3 + r558*TERPA3CO3*TERPA2CO3 - + 2*r559*TERPA3CO3*TERPA3CO3 + r560*TERPA3CO3*TERPACO3 + r562*TERPA3O2*CH3CO3 - + r563*TERPA3O2*CH3O2 + .15*r564*TERPA3O2*HO2 + .7*r565*TERPA3O2*NO + r566*TERPA3O2*NO3 - + r567*TERPA3O2*TERPA2CO3 + 2*r568*TERPA3O2*TERPA3CO3 + r569*TERPA3O2*TERPACO3 - + .25*r570*TERPA3*OH + .29*r581*TERPACID3*OH - - r572*CH3CO3*TERPA4O2 - r573*CH3O2*TERPA4O2 - r574*HO2*TERPA4O2 - r575*NO*TERPA4O2 - - r576*NO3*TERPA4O2 - r577*TERPA2CO3*TERPA4O2 - r579*TERPACO3*TERPA4O2 - d(TERPACO3)/dt = j101*TERPAPAN + r626*M*TERPAPAN + .71*r582*TERPACID*OH + r589*TERPA*NO3 + .77*r590*TERPA*OH - - r427*APINNO3*TERPACO3 - r435*APINO2*TERPACO3 - r447*BCARYNO3*TERPACO3 - - r455*BCARYO2*TERPACO3 - r467*BPINNO3*TERPACO3 - r475*BPINO2*TERPACO3 - - r487*LIMONNO3*TERPACO3 - r495*LIMONO2*TERPACO3 - r507*MYRCNO3*TERPACO3 - - r515*MYRCO2*TERPACO3 - r520*M*NO2*TERPACO3 - r534*TERPA1O2*TERPACO3 - - r541*TERPA2CO3*TERPACO3 - r550*TERPA2O2*TERPACO3 - r560*TERPA3CO3*TERPACO3 - - r569*TERPA3O2*TERPACO3 - r579*TERPA4O2*TERPACO3 - r583*CH3CO3*TERPACO3 - - r584*CH3O2*TERPACO3 - r585*HO2*TERPACO3 - r586*NO*TERPACO3 - r587*NO3*TERPACO3 - - 2*r588*TERPACO3*TERPACO3 - d(TERPF1O2)/dt = .83*r597*TERPF1*OH - - r594*HO2*TERPF1O2 - r595*NO*TERPF1O2 - d(TERPF2O2)/dt = r602*TERPF2*OH - - r599*HO2*TERPF2O2 - r600*NO*TERPF2O2 - d(TERPNPS1O2)/dt = r608*TERPNPS1*OH - - r606*HO2*TERPNPS1O2 - r607*NO*TERPNPS1O2 - d(TERPNPT1O2)/dt = r612*TERPNPT1*OH - - r610*HO2*TERPNPT1O2 - r611*NO*TERPNPT1O2 - d(TERPNS1O2)/dt = r616*TERPNS1*OH - - r614*HO2*TERPNS1O2 - r615*NO*TERPNS1O2 - d(TERPNT1O2)/dt = r620*TERPNT1*OH - - r618*HO2*TERPNT1O2 - r619*NO*TERPNT1O2 - d(TOLO2)/dt = r407*TOLOOH*OH + .65*r408*TOLUENE*OH - - r405*HO2*TOLO2 - r406*NO*TOLO2 - d(TOLUO2VBS)/dt = r712*TOLUENE*OH - - r713*HO2*TOLUO2VBS - r714*NO*TOLUO2VBS - d(XYLENO2)/dt = .56*r410*XYLENES*OH + r413*XYLENOOH*OH - - r411*HO2*XYLENO2 - r412*NO*XYLENO2 - d(XYLEO2VBS)/dt = r715*XYLENES*OH - - r716*HO2*XYLEO2VBS - r717*NO*XYLEO2VBS - d(XYLOLO2)/dt = .3*r416*XYLOL*OH + r417*XYLOLOOH*OH - - r414*HO2*XYLOLO2 - r415*NO*XYLOLO2 - d(H2O)/dt = .05*j39*CH4 + j153*H2SO4 + r13*H*HO2 + r18*OH*H2 + r19*OH*H2O2 + r20*OH*HO2 + r23*OH*OH - + r26*HO2NO2*OH + r48*HNO3*OH + r72*HCL*OH + r75*HOCL*OH + r101*HBR*OH + r115*CH2BR2*OH - + r117*CH3BR*OH + r118*CH3CCL3*OH + r120*CH3CL*OH + r125*HCFC22*OH + r134*CH2O*OH - + r140*CH3OOH*OH + r141*CH4*OH + r144*HCOOH*OH + r145*HMHP*OH + .3*r146*HOCH2OO*HO2 - + r165*C2H6*OH + r167*CH3CHO*OH + r173*CH3COOH*OH + r174*CH3COOOH*OH + r192*C3H7OOH*OH - + r193*C3H8*OH + r195*CH3COCHO*OH + r201*POOH*OH + r205*ROOH*OH + r207*CH3COCH3*OH - + .45*r220*MACR*OH + r609*TERPNPS*OH + r613*TERPNPT*OH + r644*NH3*OH + r719*HOCL*HCL - + r725*HOCL*HCL + r726*HOBR*HCL + r730*HOCL*HCL + r731*HOBR*HCL - - j1*H2O - j2*H2O - j3*H2O - r2*O1D*H2O - r110*F*H2O - r643*SO3*H2O + - r142*M*HCN*OH - r143*HCOOH*OH - r144*HMHP*OH - r152*CO*OH - r154*M*C2H2*OH - r161*C2H5OH*OH + - r162*C2H5OOH*OH - r164*C2H6*OH - r166*CH3CHO*OH - r167*CH3CN*OH - r172*CH3COOH*OH + - r173*CH3COOOH*OH - r178*GLYALD*OH - r179*GLYOXAL*OH - r180*HCOCH2OOH*OH - r181*NO3CH2CHO*OH + - r182*PAN*OH - r183*M*C2H4*OH - r191*C3H7OOH*OH - r192*C3H8*OH - r194*CH3COCHO*OH - r195*HYAC*OH + - r196*HYPERACET*OH - r197*NOA*OH - r200*POOH*OH - r204*ROOH*OH - r205*M*C3H6*OH + - r206*CH3COCH3*OH - r208*BIGENE*OH - r212*HONITR*OH - r213*MACRN*OH - r219*MACR*OH - r229*MEK*OH + - r230*MEKOOH*OH - r231*M*MPAN*OH - r232*MVKN*OH - r237*MVK*OH - r238*MVKOOH*OH - r241*ALKNIT*OH + - r245*ALKOOH*OH - r246*BIGALK*OH - r247*HPALD1*OH - r248*HPALD4*OH - r251*HYDRALD*OH + - r253*IEPOX*OH - r255*INHEB*OH - r256*INHED*OH - r285*ISOPFDNC*OH - r286*ISOPFDN*OH + - r287*ISOPFNC*OH - r288*ISOPFNP*OH - r293*ISOPN1D*OH - r296*ISOPN2B*OH - r299*ISOPN3B*OH + - r303*ISOPN4D*OH - r305*ISOPNBNO3*OH - r314*ISOPNOOHB*OH - r318*ISOPNOOHD*OH - r320*ISOP*OH + - r321*ISOPOH*OH - r322*ISOPOOH*OH - r323*ISOPOOH*OH - r335*NC4CHO*OH - r376*BENZENE*OH + - r379*BENZOOH*OH - r380*BZALD*OH - r382*BZOOH*OH - r386*C6H5OOH*OH - r387*CRESOL*OH + - r399*PHENOL*OH - r402*PHENOOH*OH - r406*TOLOOH*OH - r407*TOLUENE*OH - r409*XYLENES*OH + - r412*XYLENOOH*OH - r415*XYLOL*OH - r416*XYLOLOOH*OH - r436*APIN*OH - r456*BCARY*OH + - r476*BPIN*OH - r496*LIMON*OH - r516*MYRC*OH - r522*TERP1OOH*OH - r523*TERP2AOOH*OH + - r550*TERPA2*OH - r551*TERPA2PAN*OH - r569*TERPA3*OH - r570*TERPA3PAN*OH - r579*TERPACID2*OH + - r580*TERPACID3*OH - r581*TERPACID*OH - r589*TERPA*OH - r590*TERPAPAN*OH - r596*TERPF1*OH + - r601*TERPF2*OH - r602*TERPFDN*OH - r604*TERPK*OH - r607*TERPNPS1*OH - r608*TERPNPS*OH + - r611*TERPNPT1*OH - r615*TERPNS1*OH - r616*TERPNS*OH - r619*TERPNT1*OH - r620*TERPNT*OH + - r627*DMS*OH - r629*OCS*OH - r631*M*SO2*OH - r635*S*OH - r640*SO*OH - r641*DMS*OH - r643*NH3*OH + d(PHENO2)/dt = .2*r387*CRESOL*OH + .14*r399*PHENOL*OH + r402*PHENOOH*OH + - r397*HO2*PHENO2 - r398*NO*PHENO2 + d(PO2)/dt = .5*r200*POOH*OH + r205*M*C3H6*OH + - r198*HO2*PO2 - r199*NO*PO2 + d(RO2)/dt = r204*ROOH*OH + r206*CH3COCH3*OH + - r201*CH3O2*RO2 - r202*HO2*RO2 - r203*NO*RO2 + d(TERP1OOHO2)/dt = r522*TERP1OOH*OH + - r520*HO2*TERP1OOHO2 - r521*NO*TERP1OOHO2 + d(TERP2OOHO2)/dt = r523*TERP2AOOH*OH + - r524*HO2*TERP2OOHO2 - r525*NO*TERP2OOHO2 + d(TERPA1O2)/dt = j93*TERPA + j98*TERPACID + r426*APINNO3*TERPACO3 + r434*APINO2*TERPACO3 + + r446*BCARYNO3*TERPACO3 + r454*BCARYO2*TERPACO3 + r466*BPINNO3*TERPACO3 + + r474*BPINO2*TERPACO3 + r486*LIMONNO3*TERPACO3 + r494*LIMONO2*TERPACO3 + + r506*MYRCNO3*TERPACO3 + r514*MYRCO2*TERPACO3 + r540*TERPA2CO3*TERPACO3 + + r549*TERPA2O2*TERPACO3 + r559*TERPA3CO3*TERPACO3 + r568*TERPA3O2*TERPACO3 + + r578*TERPA4O2*TERPACO3 + .29*r581*TERPACID*OH + r582*TERPACO3*CH3CO3 + r583*TERPACO3*CH3O2 + + .49*r584*TERPACO3*HO2 + r585*TERPACO3*NO + r586*TERPACO3*NO3 + 2*r587*TERPACO3*TERPACO3 + + .86*r604*TERPK*OH + - r526*CH3CO3*TERPA1O2 - r527*CH3O2*TERPA1O2 - r528*HO2*TERPA1O2 - r529*NO*TERPA1O2 + - r530*NO3*TERPA1O2 - r531*TERPA2CO3*TERPA1O2 - r532*TERPA3CO3*TERPA1O2 + d(TERPA2CO3)/dt = j95*TERPA2PAN + r623*M*TERPA2PAN + .27*r435*APIN*O3 + .3*r475*BPIN*O3 + r541*TERPA2*NO3 + + r550*TERPA2*OH + .71*r579*TERPACID2*OH + .14*r604*TERPK*OH + - r424*APINNO3*TERPA2CO3 - r432*APINO2*TERPA2CO3 - r444*BCARYNO3*TERPA2CO3 + - r452*BCARYO2*TERPA2CO3 - r464*BPINNO3*TERPA2CO3 - r472*BPINO2*TERPA2CO3 + - r484*LIMONNO3*TERPA2CO3 - r492*LIMONO2*TERPA2CO3 - r504*MYRCNO3*TERPA2CO3 + - r512*MYRCO2*TERPA2CO3 - r517*M*NO2*TERPA2CO3 - r531*TERPA1O2*TERPA2CO3 + - r534*CH3CO3*TERPA2CO3 - r535*CH3O2*TERPA2CO3 - r536*HO2*TERPA2CO3 - r537*NO*TERPA2CO3 + - r538*NO3*TERPA2CO3 - 2*r539*TERPA2CO3*TERPA2CO3 - r540*TERPACO3*TERPA2CO3 + - r547*TERPA2O2*TERPA2CO3 - r557*TERPA3CO3*TERPA2CO3 - r566*TERPA3O2*TERPA2CO3 + - r576*TERPA4O2*TERPA2CO3 + d(TERPA2O2)/dt = j94*TERPA2 + j99*TERPACID2 + r424*APINNO3*TERPA2CO3 + r432*APINO2*TERPA2CO3 + + .33*r435*APIN*O3 + r444*BCARYNO3*TERPA2CO3 + r452*BCARYO2*TERPA2CO3 + + r464*BPINNO3*TERPA2CO3 + r472*BPINO2*TERPA2CO3 + r484*LIMONNO3*TERPA2CO3 + + r492*LIMONO2*TERPA2CO3 + r504*MYRCNO3*TERPA2CO3 + r512*MYRCO2*TERPA2CO3 + + r526*TERPA1O2*CH3CO3 + .5*r527*TERPA1O2*CH3O2 + .7*r529*TERPA1O2*NO + r530*TERPA1O2*NO3 + + 2*r531*TERPA1O2*TERPA2CO3 + r532*TERPA1O2*TERPA3CO3 + r533*TERPA1O2*TERPACO3 + + r534*TERPA2CO3*CH3CO3 + r535*TERPA2CO3*CH3O2 + .49*r536*TERPA2CO3*HO2 + r537*TERPA2CO3*NO + + r538*TERPA2CO3*NO3 + 2*r539*TERPA2CO3*TERPA2CO3 + r540*TERPA2CO3*TERPACO3 + + r557*TERPA3CO3*TERPA2CO3 + r566*TERPA3O2*TERPA2CO3 + r576*TERPA4O2*TERPA2CO3 + + .29*r579*TERPACID2*OH + .23*r589*TERPA*OH + - r542*CH3CO3*TERPA2O2 - r543*CH3O2*TERPA2O2 - r544*HO2*TERPA2O2 - r545*NO*TERPA2O2 + - r546*NO3*TERPA2O2 - r548*TERPA3CO3*TERPA2O2 - r549*TERPACO3*TERPA2O2 + d(TERPA3CO3)/dt = j97*TERPA3PAN + r624*M*TERPA3PAN + .33*r495*LIMON*O3 + r560*TERPA3*NO3 + .75*r569*TERPA3*OH + + .71*r580*TERPACID3*OH + .17*r596*TERPF1*OH + - r425*APINNO3*TERPA3CO3 - r433*APINO2*TERPA3CO3 - r445*BCARYNO3*TERPA3CO3 + - r453*BCARYO2*TERPA3CO3 - r465*BPINNO3*TERPA3CO3 - r473*BPINO2*TERPA3CO3 + - r485*LIMONNO3*TERPA3CO3 - r493*LIMONO2*TERPA3CO3 - r505*MYRCNO3*TERPA3CO3 + - r513*MYRCO2*TERPA3CO3 - r518*M*NO2*TERPA3CO3 - r532*TERPA1O2*TERPA3CO3 + - r548*TERPA2O2*TERPA3CO3 - r552*CH3CO3*TERPA3CO3 - r553*CH3O2*TERPA3CO3 + - r554*HO2*TERPA3CO3 - r555*NO*TERPA3CO3 - r556*NO3*TERPA3CO3 - r557*TERPA2CO3*TERPA3CO3 + - 2*r558*TERPA3CO3*TERPA3CO3 - r559*TERPACO3*TERPA3CO3 - r567*TERPA3O2*TERPA3CO3 + - r577*TERPA4O2*TERPA3CO3 + d(TERPA3O2)/dt = r542*TERPA2O2*CH3CO3 + r543*TERPA2O2*CH3O2 + .38*r544*TERPA2O2*HO2 + .83*r545*TERPA2O2*NO + + r546*TERPA2O2*NO3 + r547*TERPA2O2*TERPA2CO3 + r548*TERPA2O2*TERPA3CO3 + + r549*TERPA2O2*TERPACO3 + - r561*CH3CO3*TERPA3O2 - r562*CH3O2*TERPA3O2 - r563*HO2*TERPA3O2 - r564*NO*TERPA3O2 + - r565*NO3*TERPA3O2 - r566*TERPA2CO3*TERPA3O2 - r567*TERPA3CO3*TERPA3O2 + - r568*TERPACO3*TERPA3O2 + d(TERPA4O2)/dt = j96*TERPA3 + j100*TERPACID3 + r425*APINNO3*TERPA3CO3 + r433*APINO2*TERPA3CO3 + + r445*BCARYNO3*TERPA3CO3 + r453*BCARYO2*TERPA3CO3 + r465*BPINNO3*TERPA3CO3 + + r473*BPINO2*TERPA3CO3 + r485*LIMONNO3*TERPA3CO3 + r493*LIMONO2*TERPA3CO3 + + r505*MYRCNO3*TERPA3CO3 + r513*MYRCO2*TERPA3CO3 + r532*TERPA1O2*TERPA3CO3 + + r548*TERPA2O2*TERPA3CO3 + r552*TERPA3CO3*CH3CO3 + r553*TERPA3CO3*CH3O2 + + .49*r554*TERPA3CO3*HO2 + r555*TERPA3CO3*NO + r556*TERPA3CO3*NO3 + r557*TERPA3CO3*TERPA2CO3 + + 2*r558*TERPA3CO3*TERPA3CO3 + r559*TERPA3CO3*TERPACO3 + r561*TERPA3O2*CH3CO3 + + r562*TERPA3O2*CH3O2 + .15*r563*TERPA3O2*HO2 + .7*r564*TERPA3O2*NO + r565*TERPA3O2*NO3 + + r566*TERPA3O2*TERPA2CO3 + 2*r567*TERPA3O2*TERPA3CO3 + r568*TERPA3O2*TERPACO3 + + .25*r569*TERPA3*OH + .29*r580*TERPACID3*OH + - r571*CH3CO3*TERPA4O2 - r572*CH3O2*TERPA4O2 - r573*HO2*TERPA4O2 - r574*NO*TERPA4O2 + - r575*NO3*TERPA4O2 - r576*TERPA2CO3*TERPA4O2 - r578*TERPACO3*TERPA4O2 + d(TERPACO3)/dt = j101*TERPAPAN + r625*M*TERPAPAN + .71*r581*TERPACID*OH + r588*TERPA*NO3 + .77*r589*TERPA*OH + - r426*APINNO3*TERPACO3 - r434*APINO2*TERPACO3 - r446*BCARYNO3*TERPACO3 + - r454*BCARYO2*TERPACO3 - r466*BPINNO3*TERPACO3 - r474*BPINO2*TERPACO3 + - r486*LIMONNO3*TERPACO3 - r494*LIMONO2*TERPACO3 - r506*MYRCNO3*TERPACO3 + - r514*MYRCO2*TERPACO3 - r519*M*NO2*TERPACO3 - r533*TERPA1O2*TERPACO3 + - r540*TERPA2CO3*TERPACO3 - r549*TERPA2O2*TERPACO3 - r559*TERPA3CO3*TERPACO3 + - r568*TERPA3O2*TERPACO3 - r578*TERPA4O2*TERPACO3 - r582*CH3CO3*TERPACO3 + - r583*CH3O2*TERPACO3 - r584*HO2*TERPACO3 - r585*NO*TERPACO3 - r586*NO3*TERPACO3 + - 2*r587*TERPACO3*TERPACO3 + d(TERPF1O2)/dt = .83*r596*TERPF1*OH + - r593*HO2*TERPF1O2 - r594*NO*TERPF1O2 + d(TERPF2O2)/dt = r601*TERPF2*OH + - r598*HO2*TERPF2O2 - r599*NO*TERPF2O2 + d(TERPNPS1O2)/dt = r607*TERPNPS1*OH + - r605*HO2*TERPNPS1O2 - r606*NO*TERPNPS1O2 + d(TERPNPT1O2)/dt = r611*TERPNPT1*OH + - r609*HO2*TERPNPT1O2 - r610*NO*TERPNPT1O2 + d(TERPNS1O2)/dt = r615*TERPNS1*OH + - r613*HO2*TERPNS1O2 - r614*NO*TERPNS1O2 + d(TERPNT1O2)/dt = r619*TERPNT1*OH + - r617*HO2*TERPNT1O2 - r618*NO*TERPNT1O2 + d(TOLO2)/dt = r406*TOLOOH*OH + .65*r407*TOLUENE*OH + - r404*HO2*TOLO2 - r405*NO*TOLO2 + d(TOLUO2VBS)/dt = r711*TOLUENE*OH + - r712*HO2*TOLUO2VBS - r713*NO*TOLUO2VBS + d(XYLENO2)/dt = .56*r409*XYLENES*OH + r412*XYLENOOH*OH + - r410*HO2*XYLENO2 - r411*NO*XYLENO2 + d(XYLEO2VBS)/dt = r714*XYLENES*OH + - r715*HO2*XYLEO2VBS - r716*NO*XYLEO2VBS + d(XYLOLO2)/dt = .3*r415*XYLOL*OH + r416*XYLOLOOH*OH + - r413*HO2*XYLOLO2 - r414*NO*XYLOLO2 + d(H2O)/dt = .05*j39*CH4 + j153*H2SO4 + r645*HO2 + r13*H*HO2 + r18*OH*H2 + r19*OH*H2O2 + r20*OH*HO2 + + r23*OH*OH + r26*HO2NO2*OH + r48*HNO3*OH + r72*HCL*OH + r75*HOCL*OH + r101*HBR*OH + + r115*CH2BR2*OH + r117*CH3BR*OH + r118*CH3CCL3*OH + r120*CH3CL*OH + r125*HCFC22*OH + + r134*CH2O*OH + r140*CH3OOH*OH + r141*CH4*OH + r143*HCOOH*OH + r144*HMHP*OH + + .3*r145*HOCH2OO*HO2 + r164*C2H6*OH + r166*CH3CHO*OH + r172*CH3COOH*OH + r173*CH3COOOH*OH + + r191*C3H7OOH*OH + r192*C3H8*OH + r194*CH3COCHO*OH + r200*POOH*OH + r204*ROOH*OH + + r206*CH3COCH3*OH + .45*r219*MACR*OH + r608*TERPNPS*OH + r612*TERPNPT*OH + r643*NH3*OH + + r718*HOCL*HCL + r724*HOCL*HCL + r725*HOBR*HCL + r729*HOCL*HCL + r730*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r2*O1D*H2O - r110*F*H2O - r642*SO3*H2O diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/chem_mech.in b/src/chemistry/pp_trop_strat_mam4_ts2/chem_mech.in index e1c302eaf7..291c11b29e 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/chem_mech.in +++ b/src/chemistry/pp_trop_strat_mam4_ts2/chem_mech.in @@ -1,11 +1,11 @@ * Comments -* User-given Tag Description: TS2_1_isop_mt_simplevbs_no -* Tag database identifier : MZ275_TS2_1_isop_mt_simplevbs_no_20200410 -* Tag created by : rhs -* Tag created from branch : TS2_1_isop_mt_simplevbs_no -* Tag created on : 2020-04-10 13:27:37.970653-06 +* User-given Tag Description: TS2.2_simpleVBS +* Tag database identifier : MZ321_TS2.2_20221220 +* Tag created by : lke +* Tag created from branch : TS2.2 +* Tag created on : 2022-12-20 14:27:44.984975-07 * Comments for this tag follow: -* rhs : 2020-04-10 : TS2_1 includes all isoprene and monoterpene gas-phase updates from TS2 and high/low nox SOA yields. +* lke : 2022-12-20 : TS2 updated to JPL19 SPECIES @@ -432,35 +432,6 @@ Solution classes Explicit - AOA_NH - BRY - CCL4 - CF2CLBR - CF3BR - CFC11 - CFC113 - CFC114 - CFC115 - CFC12 - CH2BR2 - CH3BR - CH3CCL3 - CH3CL - CH4 - CHBR3 - CLY - CO2 - E90 - H2402 - HCFC141B - HCFC142B - HCFC22 - N2O - NH_5 - NH_50 - O3S - SF6 - ST80_25 NHDEP NDEP End Explicit @@ -468,6 +439,7 @@ Implicit ALKNIT ALKOOH + AOA_NH APIN bc_a1 bc_a4 @@ -486,6 +458,7 @@ BRCL BRO BRONO2 + BRY BZALD BZOOH C2H2 @@ -497,8 +470,20 @@ C3H7OOH C3H8 C6H5OOH + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 CH2O + CH3BR + CH3CCL3 CH3CHO + CH3CL CH3CN CH3COCH3 CH3COCHO @@ -506,12 +491,16 @@ CH3COOOH CH3OH CH3OOH + CH4 + CHBR3 CL CL2 CL2O2 CLO CLONO2 + CLY CO + CO2 COF2 COFCL CRESOL @@ -520,15 +509,20 @@ dst_a1 dst_a2 dst_a3 + E90 EOOH F GLYALD GLYOXAL H H2 + H2402 H2O2 H2SO4 HBR + HCFC141B + HCFC142B + HCFC22 HCL HCN HCOCH2OOH @@ -579,6 +573,7 @@ MVKOOH MYRC N + N2O N2O5 NC4CHO ncl_a1 @@ -586,6 +581,8 @@ ncl_a3 NH3 NH4 + NH_5 + NH_50 NO NO2 NO3 @@ -597,6 +594,7 @@ num_a4 O O3 + O3S OCLO OCS ONITR @@ -610,6 +608,7 @@ POOH ROOH S + SF6 SO SO2 SO3 @@ -632,6 +631,7 @@ SOAG3 SOAG4 SQTN + ST80_25 SVOC TEPOMUC TERP1OOH @@ -966,7 +966,7 @@ [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 ; 4.4e-32, 1.3, 7.5e-11, -0.2, 0.6 +[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 @@ -981,21 +981,21 @@ ********************************* *** odd-nitrogen ********************************* -[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 +[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 ; 1.5e-11, -3600 +[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.5e-11, 170 -[NO3_O] NO3 + O -> NO2 + O2 ; 1e-11 +[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.3e-12, 270 +[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 @@ -1112,8 +1112,7 @@ [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 -[CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.9e-33, 1, 1.1e-12, -1.3, 0.6 -[HCN_OH] HCN + OH + M -> HO2 + M ; 4.28e-33, 0, 9.3e-15, -4.42, 0.8 +[HCN_OH] HCN + OH + M -> HO2 + M ; 6.1e-33, 1.5, 9.8e-15, -4.6, 0.8 [HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4e-13 [HMHP_OH] HMHP + OH -> 0.5*CH2O + 0.5*HO2 + 0.5*HCOOH + 0.5*OH + H2O ; 1.3e-12, 500 [HOCH2OO_HO2] HOCH2OO + HO2 -> 0.5*HMHP + 0.5*HCOOH + 0.3*H2O + 0.2*HO2 + 0.2*OH ; 5.6e-15, 2300 @@ -1123,7 +1122,7 @@ [O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.5e-11 [O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9e-12 [O1D_HCN] O1D + HCN -> OH ; 1.08e-10, 105 -[usr_CO_OH_b] CO + OH -> CO2 + H +[usr_CO_OH] CO + OH -> CO2 + HO2 ********************************* *** C2 ********************************* @@ -1146,7 +1145,7 @@ [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.36*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.49*OH + 0.49*CH3O2 + 0.49*CO2 ; 4.3e-13, 1040 [CH3CO3_NO] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270 -[CH3COOH_OH] CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7e-13 +[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 @@ -1158,7 +1157,7 @@ [NO3CH2CHO_OH] NO3CH2CHO + OH -> CO2 + CH2O + NO2 ; 3.4e-12 [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 ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[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 @@ -1169,7 +1168,7 @@ [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 ; 8.7e-12, -615 +[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 @@ -1619,10 +1618,11 @@ *** Sulfur ********************************* [DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 -[DMS_OHa] DMS + OH -> SO2 ; 9.6e-12, -234 +[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 @@ -1631,16 +1631,15 @@ [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.7e-11, 335 +[SO_OH] SO + OH -> SO2 + H ; 2.6e-11, 330 [usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 -[usr_SO2_OH] SO2 + OH -> SO3 + HO2 [usr_SO3_H2O] SO3 + H2O -> H2SO4 ********************************* *** Tropospheric Aerosol ********************************* [NH3_OH] NH3 + OH -> H2O + 1*NHDEP ; 1.7e-12, -710 [usr_GLYOXAL_aer] GLYOXAL -> SOAG0 -[usr_HO2_aer] HO2 -> 0.5*H2O2 +[usr_HO2_aer] HO2 -> H2O [usr_HONITR_aer] HONITR -> HNO3 [usr_ICHE_aer] ICHE -> [usr_IEPOX_aer] IEPOX -> @@ -1745,23 +1744,20 @@ End Reactions Ext Forcing - so4_a2 <- dataset - NO <- dataset - NO2 <- dataset - SO2 <- dataset - SVOC <- dataset - pom_a1 <- dataset + num_a4 <- dataset pom_a4 <- dataset + bc_a4 <- dataset + SVOC <- dataset + SO2 <- dataset + NO2 <- dataset so4_a1 <- dataset + so4_a2 <- dataset CO <- dataset - bc_a1 <- dataset - bc_a4 <- dataset num_a1 <- dataset num_a2 <- dataset - num_a4 <- dataset - OH + NO N - AOA_NH + OH End Ext Forcing End Chemistry diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/chem_mods.F90 index 70d339afc3..8dc13abb6f 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/chem_mods.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/chem_mods.F90 @@ -6,24 +6,24 @@ module chem_mods implicit none save integer, parameter :: phtcnt = 167, & ! number of photolysis reactions - rxntot = 905, & ! number of total reactions - gascnt = 738, & ! number of gas phase reactions + rxntot = 904, & ! number of total reactions + gascnt = 737, & ! number of gas phase reactions nabscol = 2, & ! number of absorbing column densities gas_pcnst = 317, & ! number of "gas phase" species nfs = 3, & ! number of "fixed" species relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members - nzcnt = 3862, & ! number of non-zero matrix entries - extcnt = 17, & ! number of species with external forcing - clscnt1 = 31, & ! number of species in explicit class + nzcnt = 4132, & ! number of non-zero matrix entries + extcnt = 14, & ! 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 = 286, & ! number of species in implicit class + clscnt4 = 315, & ! 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 = 905, & + rxt_tag_cnt = 904, & enthalpy_cnt = 18, & nslvd = 84 integer :: clscnt(5) = 0 diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/m_rxt_id.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/m_rxt_id.F90 index 9686949a9c..68e6a8b1d2 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/m_rxt_id.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/m_rxt_id.F90 @@ -308,496 +308,496 @@ module m_rxt_id integer, parameter :: rid_CH3OH_OH = 306 integer, parameter :: rid_CH3OOH_OH = 307 integer, parameter :: rid_CH4_OH = 308 - integer, parameter :: rid_CO_OH_M = 309 - integer, parameter :: rid_HCN_OH = 310 - integer, parameter :: rid_HCOOH_OH = 311 - integer, parameter :: rid_HMHP_OH = 312 - integer, parameter :: rid_HOCH2OO_HO2 = 313 - integer, parameter :: rid_HOCH2OO_M = 314 - integer, parameter :: rid_HOCH2OO_NO = 315 - integer, parameter :: rid_O1D_CH4a = 316 - integer, parameter :: rid_O1D_CH4b = 317 - integer, parameter :: rid_O1D_CH4c = 318 - integer, parameter :: rid_O1D_HCN = 319 - integer, parameter :: rid_usr_CO_OH_b = 320 - integer, parameter :: rid_C2H2_CL_M = 321 - integer, parameter :: rid_C2H2_OH_M = 322 - integer, parameter :: rid_C2H4_CL_M = 323 - integer, parameter :: rid_C2H4_O3 = 324 - integer, parameter :: rid_C2H5O2_C2H5O2 = 325 - integer, parameter :: rid_C2H5O2_CH3O2 = 326 - integer, parameter :: rid_C2H5O2_HO2 = 327 - integer, parameter :: rid_C2H5O2_NO = 328 - integer, parameter :: rid_C2H5OH_OH = 329 - integer, parameter :: rid_C2H5OOH_OH = 330 - integer, parameter :: rid_C2H6_CL = 331 - integer, parameter :: rid_C2H6_OH = 332 - integer, parameter :: rid_CH3CHO_NO3 = 333 - integer, parameter :: rid_CH3CHO_OH = 334 - integer, parameter :: rid_CH3CN_OH = 335 - integer, parameter :: rid_CH3CO3_CH3CO3 = 336 - integer, parameter :: rid_CH3CO3_CH3O2 = 337 - integer, parameter :: rid_CH3CO3_HO2 = 338 - integer, parameter :: rid_CH3CO3_NO = 339 - integer, parameter :: rid_CH3COOH_OH = 340 - integer, parameter :: rid_CH3COOOH_OH = 341 - integer, parameter :: rid_EO2_HO2 = 342 - integer, parameter :: rid_EO2_NO = 343 - integer, parameter :: rid_EO_M = 344 - integer, parameter :: rid_EO_O2 = 345 - integer, parameter :: rid_GLYALD_OH = 346 - integer, parameter :: rid_GLYOXAL_OH = 347 - integer, parameter :: rid_HCOCH2OOH_OH = 348 - integer, parameter :: rid_NO3CH2CHO_OH = 349 - integer, parameter :: rid_PAN_OH = 350 - integer, parameter :: rid_tag_C2H4_OH = 351 - integer, parameter :: rid_tag_CH3CO3_NO2 = 352 - integer, parameter :: rid_usr_PAN_M = 353 - integer, parameter :: rid_C3H6_NO3 = 354 - integer, parameter :: rid_C3H6_O3 = 355 - integer, parameter :: rid_C3H7O2_CH3O2 = 356 - integer, parameter :: rid_C3H7O2_HO2 = 357 - integer, parameter :: rid_C3H7O2_NO = 358 - integer, parameter :: rid_C3H7OOH_OH = 359 - integer, parameter :: rid_C3H8_OH = 360 - integer, parameter :: rid_CH3COCHO_NO3 = 361 - integer, parameter :: rid_CH3COCHO_OH = 362 - integer, parameter :: rid_HYAC_OH = 363 - integer, parameter :: rid_HYPERACET_OH = 364 - integer, parameter :: rid_NOA_OH = 365 - integer, parameter :: rid_PO2_HO2 = 366 - integer, parameter :: rid_PO2_NO = 367 - integer, parameter :: rid_POOH_OH = 368 - integer, parameter :: rid_RO2_CH3O2 = 369 - integer, parameter :: rid_RO2_HO2 = 370 - integer, parameter :: rid_RO2_NO = 371 - integer, parameter :: rid_ROOH_OH = 372 - integer, parameter :: rid_tag_C3H6_OH = 373 - integer, parameter :: rid_usr_CH3COCH3_OH = 374 - integer, parameter :: rid_BIGENE_NO3 = 375 - integer, parameter :: rid_BIGENE_OH = 376 - integer, parameter :: rid_DHPMPAL_OH = 377 - integer, parameter :: rid_ENEO2_NO = 378 - integer, parameter :: rid_ENEO2_NOb = 379 - integer, parameter :: rid_HONITR_OH = 380 - integer, parameter :: rid_MACRN_OH = 381 - integer, parameter :: rid_MACRO2_CH3CO3 = 382 - integer, parameter :: rid_MACRO2_CH3O2 = 383 - integer, parameter :: rid_MACRO2_HO2 = 384 - integer, parameter :: rid_MACRO2_isom = 385 - integer, parameter :: rid_MACR_O3 = 386 - integer, parameter :: rid_MACR_OH = 387 - integer, parameter :: rid_MACROOH_OH = 388 - integer, parameter :: rid_MCO3_CH3CO3 = 389 - integer, parameter :: rid_MCO3_CH3O2 = 390 - integer, parameter :: rid_MCO3_HO2 = 391 - integer, parameter :: rid_MCO3_MCO3 = 392 - integer, parameter :: rid_MCO3_NO = 393 - integer, parameter :: rid_MCO3_NO3 = 394 - integer, parameter :: rid_MEKO2_HO2 = 395 - integer, parameter :: rid_MEKO2_NO = 396 - integer, parameter :: rid_MEK_OH = 397 - integer, parameter :: rid_MEKOOH_OH = 398 - integer, parameter :: rid_MPAN_OH_M = 399 - integer, parameter :: rid_MVKN_OH = 400 - integer, parameter :: rid_MVKO2_CH3CO3 = 401 - integer, parameter :: rid_MVKO2_CH3O2 = 402 - integer, parameter :: rid_MVKO2_HO2 = 403 - integer, parameter :: rid_MVK_O3 = 404 - integer, parameter :: rid_MVK_OH = 405 - integer, parameter :: rid_MVKOOH_OH = 406 - integer, parameter :: rid_tag_MCO3_NO2 = 407 - integer, parameter :: rid_usr_MPAN_M = 408 - integer, parameter :: rid_ALKNIT_OH = 409 - integer, parameter :: rid_ALKO2_HO2 = 410 - integer, parameter :: rid_ALKO2_NO = 411 - integer, parameter :: rid_ALKO2_NOb = 412 - integer, parameter :: rid_ALKOOH_OH = 413 - integer, parameter :: rid_BIGALK_OH = 414 - integer, parameter :: rid_HPALD1_OH = 415 - integer, parameter :: rid_HPALD4_OH = 416 - integer, parameter :: rid_HPALDB1C_OH = 417 - integer, parameter :: rid_HPALDB4C_OH = 418 - integer, parameter :: rid_HYDRALD_OH = 419 - integer, parameter :: rid_ICHE_OH = 420 - integer, parameter :: rid_IEPOX_OH = 421 - integer, parameter :: rid_IEPOXOO_HO2 = 422 - integer, parameter :: rid_INHEB_OH = 423 - integer, parameter :: rid_INHED_OH = 424 - integer, parameter :: rid_ISOPB1O2_CH3CO3 = 425 - integer, parameter :: rid_ISOPB1O2_CH3O2 = 426 - integer, parameter :: rid_ISOPB1O2_HO2 = 427 - integer, parameter :: rid_ISOPB1O2_I = 428 - integer, parameter :: rid_ISOPB1O2_M_C = 429 - integer, parameter :: rid_ISOPB1O2_M_T = 430 - integer, parameter :: rid_ISOPB4O2_CH3CO3 = 431 - integer, parameter :: rid_ISOPB4O2_CH3O2 = 432 - integer, parameter :: rid_ISOPB4O2_HO2 = 433 - integer, parameter :: rid_ISOPB4O2_I = 434 - integer, parameter :: rid_ISOPB4O2_M_C = 435 - integer, parameter :: rid_ISOPB4O2_M_T = 436 - integer, parameter :: rid_ISOPC1C_O2_B = 437 - integer, parameter :: rid_ISOPC1C_O2_D = 438 - integer, parameter :: rid_ISOPC1T_O2_B = 439 - integer, parameter :: rid_ISOPC1T_O2_D = 440 - integer, parameter :: rid_ISOPC4C_O2_B = 441 - integer, parameter :: rid_ISOPC4C_O2_D = 442 - integer, parameter :: rid_ISOPC4T_O2_B = 443 - integer, parameter :: rid_ISOPC4T_O2_D = 444 - integer, parameter :: rid_ISOPED1O2_CH3CO3 = 445 - integer, parameter :: rid_ISOPED1O2_CH3O2 = 446 - integer, parameter :: rid_ISOPED1O2_HO2 = 447 - integer, parameter :: rid_ISOPED1O2_M_C = 448 - integer, parameter :: rid_ISOPED4O2_CH3CO3 = 449 - integer, parameter :: rid_ISOPED4O2_CH3O2 = 450 - integer, parameter :: rid_ISOPED4O2_HO2 = 451 - integer, parameter :: rid_ISOPED4O2_M = 452 - integer, parameter :: rid_ISOPFDNC_OH = 453 - integer, parameter :: rid_ISOPFDN_OH = 454 - integer, parameter :: rid_ISOPFNC_OH = 455 - integer, parameter :: rid_ISOPFNP_OH = 456 - integer, parameter :: rid_ISOPHFP_OH = 457 - integer, parameter :: rid_ISOPN1DO2_HO2 = 458 - integer, parameter :: rid_ISOPN1DO2_I = 459 - integer, parameter :: rid_ISOPN1D_O3 = 460 - integer, parameter :: rid_ISOPN1D_OH = 461 - integer, parameter :: rid_ISOPN2BO2_HO2 = 462 - integer, parameter :: rid_ISOPN2BO2_I = 463 - integer, parameter :: rid_ISOPN2B_OH = 464 - integer, parameter :: rid_ISOPN3BO2_HO2 = 465 - integer, parameter :: rid_ISOPN3BO2_I = 466 - integer, parameter :: rid_ISOPN3B_OH = 467 - integer, parameter :: rid_ISOPN4DO2_HO2 = 468 - integer, parameter :: rid_ISOPN4DO2_I = 469 - integer, parameter :: rid_ISOPN4D_O3 = 470 - integer, parameter :: rid_ISOPN4D_OH = 471 - integer, parameter :: rid_ISOPNBNO3O2_HO2 = 472 - integer, parameter :: rid_ISOPNBNO3_OH = 473 - integer, parameter :: rid_ISOP_NO3 = 474 - integer, parameter :: rid_ISOPNO3_CH3CO3 = 475 - integer, parameter :: rid_ISOPNO3_CH3O2 = 476 - integer, parameter :: rid_ISOPNO3_HO2 = 477 - integer, parameter :: rid_ISOPNO3_ISOPNO3 = 478 - integer, parameter :: rid_ISOPNO3_NO3 = 479 - integer, parameter :: rid_ISOPNOOHBO2_HO2 = 480 - integer, parameter :: rid_ISOPNOOHBO2_I = 481 - integer, parameter :: rid_ISOPNOOHB_OH = 482 - integer, parameter :: rid_ISOPNOOHDO2_HO2 = 483 - integer, parameter :: rid_ISOPNOOHDO2_I = 484 - integer, parameter :: rid_ISOPNOOHD_O3 = 485 - integer, parameter :: rid_ISOPNOOHD_OH = 486 - integer, parameter :: rid_ISOP_O3 = 487 - integer, parameter :: rid_ISOP_OH = 488 - integer, parameter :: rid_ISOPOH_OH = 489 - integer, parameter :: rid_ISOPOOH_OH_abs = 490 - integer, parameter :: rid_ISOPOOH_OH_add = 491 - integer, parameter :: rid_ISOPZD1O2_CH3CO3 = 492 - integer, parameter :: rid_ISOPZD1O2_CH3O2 = 493 - integer, parameter :: rid_ISOPZD1O2_HO2 = 494 - integer, parameter :: rid_ISOPZD1O2_M = 495 - integer, parameter :: rid_ISOPZD4O2_CH3CO3 = 496 - integer, parameter :: rid_ISOPZD4O2_CH3O2 = 497 - integer, parameter :: rid_ISOPZD4O2_HO2 = 498 - integer, parameter :: rid_ISOPZD4O2_M_C = 499 - integer, parameter :: rid_NC4CHOO2_HO2 = 500 - integer, parameter :: rid_NC4CHOO2_isom = 501 - integer, parameter :: rid_NC4CHO_O3 = 502 - integer, parameter :: rid_NC4CHO_OH = 503 - integer, parameter :: rid_usr_IEPOXOO_NOa = 504 - integer, parameter :: rid_usr_IEPOXOO_NOn = 505 - integer, parameter :: rid_usr_ISOPB1O2_NOa = 506 - integer, parameter :: rid_usr_ISOPB1O2_NOn = 507 - integer, parameter :: rid_usr_ISOPB4O2_NOa = 508 - integer, parameter :: rid_usr_ISOPB4O2_NOn = 509 - integer, parameter :: rid_usr_ISOPED1O2_NOa = 510 - integer, parameter :: rid_usr_ISOPED1O2_NOn = 511 - integer, parameter :: rid_usr_ISOPED4O2_NOa = 512 - integer, parameter :: rid_usr_ISOPED4O2_NOn = 513 - integer, parameter :: rid_usr_ISOPN1DO2_NOa = 514 - integer, parameter :: rid_usr_ISOPN1DO2_NOn = 515 - integer, parameter :: rid_usr_ISOPN2BO2_NOa = 516 - integer, parameter :: rid_usr_ISOPN2BO2_NOn = 517 - integer, parameter :: rid_usr_ISOPN3BO2_NOa = 518 - integer, parameter :: rid_usr_ISOPN3BO2_NOn = 519 - integer, parameter :: rid_usr_ISOPN4DO2_NOa = 520 - integer, parameter :: rid_usr_ISOPN4DO2_NOn = 521 - integer, parameter :: rid_usr_ISOPNBNO3O2_NOa = 522 - integer, parameter :: rid_usr_ISOPNBNO3O2_NOn = 523 - integer, parameter :: rid_usr_ISOPNO3_NOa = 524 - integer, parameter :: rid_usr_ISOPNO3_NOn = 525 - integer, parameter :: rid_usr_ISOPNOOHBO2_NOa = 526 - integer, parameter :: rid_usr_ISOPNOOHBO2_NOn = 527 - integer, parameter :: rid_usr_ISOPNOOHDO2_NOa = 528 - integer, parameter :: rid_usr_ISOPNOOHDO2_NOn = 529 - integer, parameter :: rid_usr_ISOPZD1O2 = 530 - integer, parameter :: rid_usr_ISOPZD1O2_NOa = 531 - integer, parameter :: rid_usr_ISOPZD1O2_NOn = 532 - integer, parameter :: rid_usr_ISOPZD4O2 = 533 - integer, parameter :: rid_usr_ISOPZD4O2_NOa = 534 - integer, parameter :: rid_usr_ISOPZD4O2_NOn = 535 - integer, parameter :: rid_usr_MACRO2_NOa = 536 - integer, parameter :: rid_usr_MACRO2_NOn = 537 - integer, parameter :: rid_usr_MVKO2_NOa = 538 - integer, parameter :: rid_usr_MVKO2_NOn = 539 - integer, parameter :: rid_usr_NC4CHOO2_NOa = 540 - integer, parameter :: rid_usr_NC4CHOO2_NOn = 541 - integer, parameter :: rid_ACBZO2_HO2 = 542 - integer, parameter :: rid_ACBZO2_NO = 543 - integer, parameter :: rid_BENZENE_OH = 544 - integer, parameter :: rid_BENZO2_HO2 = 545 - integer, parameter :: rid_BENZO2_NO = 546 - integer, parameter :: rid_BENZOOH_OH = 547 - integer, parameter :: rid_BZALD_OH = 548 - integer, parameter :: rid_BZOO_HO2 = 549 - integer, parameter :: rid_BZOOH_OH = 550 - integer, parameter :: rid_BZOO_NO = 551 - integer, parameter :: rid_C6H5O2_HO2 = 552 - integer, parameter :: rid_C6H5O2_NO = 553 - integer, parameter :: rid_C6H5OOH_OH = 554 - integer, parameter :: rid_CRESOL_OH = 555 - integer, parameter :: rid_DICARBO2_HO2 = 556 - integer, parameter :: rid_DICARBO2_NO = 557 - integer, parameter :: rid_DICARBO2_NO2 = 558 - integer, parameter :: rid_MALO2_HO2 = 559 - integer, parameter :: rid_MALO2_NO = 560 - integer, parameter :: rid_MALO2_NO2 = 561 - integer, parameter :: rid_MDIALO2_HO2 = 562 - integer, parameter :: rid_MDIALO2_NO = 563 - integer, parameter :: rid_MDIALO2_NO2 = 564 - integer, parameter :: rid_PHENO2_HO2 = 565 - integer, parameter :: rid_PHENO2_NO = 566 - integer, parameter :: rid_PHENOL_OH = 567 - integer, parameter :: rid_PHENO_NO2 = 568 - integer, parameter :: rid_PHENO_O3 = 569 - integer, parameter :: rid_PHENOOH_OH = 570 - integer, parameter :: rid_tag_ACBZO2_NO2 = 571 - integer, parameter :: rid_TOLO2_HO2 = 572 - integer, parameter :: rid_TOLO2_NO = 573 - integer, parameter :: rid_TOLOOH_OH = 574 - integer, parameter :: rid_TOLUENE_OH = 575 - integer, parameter :: rid_usr_PBZNIT_M = 576 - integer, parameter :: rid_XYLENES_OH = 577 - integer, parameter :: rid_XYLENO2_HO2 = 578 - integer, parameter :: rid_XYLENO2_NO = 579 - integer, parameter :: rid_XYLENOOH_OH = 580 - integer, parameter :: rid_XYLOLO2_HO2 = 581 - integer, parameter :: rid_XYLOLO2_NO = 582 - integer, parameter :: rid_XYLOL_OH = 583 - integer, parameter :: rid_XYLOLOOH_OH = 584 - integer, parameter :: rid_APIN_NO3 = 585 - integer, parameter :: rid_APINNO3_APINNO3 = 586 - integer, parameter :: rid_APINNO3_CH3CO3 = 587 - integer, parameter :: rid_APINNO3_CH3O2 = 588 - integer, parameter :: rid_APINNO3_HO2 = 589 - integer, parameter :: rid_APINNO3_NO = 590 - integer, parameter :: rid_APINNO3_NO3 = 591 - integer, parameter :: rid_APINNO3_TERPA2CO3 = 592 - integer, parameter :: rid_APINNO3_TERPA3CO3 = 593 - integer, parameter :: rid_APINNO3_TERPACO3 = 594 - integer, parameter :: rid_APINO2_CH3CO3 = 595 - integer, parameter :: rid_APINO2_CH3O2 = 596 - integer, parameter :: rid_APINO2_HO2 = 597 - integer, parameter :: rid_APINO2_NO = 598 - integer, parameter :: rid_APINO2_NO3 = 599 - integer, parameter :: rid_APINO2_TERPA2CO3 = 600 - integer, parameter :: rid_APINO2_TERPA3CO3 = 601 - integer, parameter :: rid_APINO2_TERPACO3 = 602 - integer, parameter :: rid_APIN_O3 = 603 - integer, parameter :: rid_APIN_OH = 604 - integer, parameter :: rid_BCARY_NO3 = 605 - integer, parameter :: rid_BCARYNO3_BCARYNO3 = 606 - integer, parameter :: rid_BCARYNO3_CH3CO3 = 607 - integer, parameter :: rid_BCARYNO3_CH3O2 = 608 - integer, parameter :: rid_BCARYNO3_HO2 = 609 - integer, parameter :: rid_BCARYNO3_NO = 610 - integer, parameter :: rid_BCARYNO3_NO3 = 611 - integer, parameter :: rid_BCARYNO3_TERPA2CO3 = 612 - integer, parameter :: rid_BCARYNO3_TERPA3CO3 = 613 - integer, parameter :: rid_BCARYNO3_TERPACO3 = 614 - integer, parameter :: rid_BCARYO2_CH3CO3 = 615 - integer, parameter :: rid_BCARYO2_CH3O2 = 616 - integer, parameter :: rid_BCARYO2_HO2 = 617 - integer, parameter :: rid_BCARYO2_NO = 618 - integer, parameter :: rid_BCARYO2_NO3 = 619 - integer, parameter :: rid_BCARYO2_TERPA2CO3 = 620 - integer, parameter :: rid_BCARYO2_TERPA3CO3 = 621 - integer, parameter :: rid_BCARYO2_TERPACO3 = 622 - integer, parameter :: rid_BCARY_O3 = 623 - integer, parameter :: rid_BCARY_OH = 624 - integer, parameter :: rid_BPIN_NO3 = 625 - integer, parameter :: rid_BPINNO3_BPINNO3 = 626 - integer, parameter :: rid_BPINNO3_CH3CO3 = 627 - integer, parameter :: rid_BPINNO3_CH3O2 = 628 - integer, parameter :: rid_BPINNO3_HO2 = 629 - integer, parameter :: rid_BPINNO3_NO = 630 - integer, parameter :: rid_BPINNO3_NO3 = 631 - integer, parameter :: rid_BPINNO3_TERPA2CO3 = 632 - integer, parameter :: rid_BPINNO3_TERPA3CO3 = 633 - integer, parameter :: rid_BPINNO3_TERPACO3 = 634 - integer, parameter :: rid_BPINO2_CH3CO3 = 635 - integer, parameter :: rid_BPINO2_CH3O2 = 636 - integer, parameter :: rid_BPINO2_HO2 = 637 - integer, parameter :: rid_BPINO2_NO = 638 - integer, parameter :: rid_BPINO2_NO3 = 639 - integer, parameter :: rid_BPINO2_TERPA2CO3 = 640 - integer, parameter :: rid_BPINO2_TERPA3CO3 = 641 - integer, parameter :: rid_BPINO2_TERPACO3 = 642 - integer, parameter :: rid_BPIN_O3 = 643 - integer, parameter :: rid_BPIN_OH = 644 - integer, parameter :: rid_LIMON_NO3 = 645 - integer, parameter :: rid_LIMONNO3_CH3CO3 = 646 - integer, parameter :: rid_LIMONNO3_CH3O2 = 647 - integer, parameter :: rid_LIMONNO3_HO2 = 648 - integer, parameter :: rid_LIMONNO3_LIMONNO3 = 649 - integer, parameter :: rid_LIMONNO3_NO = 650 - integer, parameter :: rid_LIMONNO3_NO3 = 651 - integer, parameter :: rid_LIMONNO3_TERPA2CO3 = 652 - integer, parameter :: rid_LIMONNO3_TERPA3CO3 = 653 - integer, parameter :: rid_LIMONNO3_TERPACO3 = 654 - integer, parameter :: rid_LIMONO2_CH3CO3 = 655 - integer, parameter :: rid_LIMONO2_CH3O2 = 656 - integer, parameter :: rid_LIMONO2_HO2 = 657 - integer, parameter :: rid_LIMONO2_NO = 658 - integer, parameter :: rid_LIMONO2_NO3 = 659 - integer, parameter :: rid_LIMONO2_TERPA2CO3 = 660 - integer, parameter :: rid_LIMONO2_TERPA3CO3 = 661 - integer, parameter :: rid_LIMONO2_TERPACO3 = 662 - integer, parameter :: rid_LIMON_O3 = 663 - integer, parameter :: rid_LIMON_OH = 664 - integer, parameter :: rid_MYRC_NO3 = 665 - integer, parameter :: rid_MYRCNO3_CH3CO3 = 666 - integer, parameter :: rid_MYRCNO3_CH3O2 = 667 - integer, parameter :: rid_MYRCNO3_HO2 = 668 - integer, parameter :: rid_MYRCNO3_MYRCNO3 = 669 - integer, parameter :: rid_MYRCNO3_NO = 670 - integer, parameter :: rid_MYRCNO3_NO3 = 671 - integer, parameter :: rid_MYRCNO3_TERPA2CO3 = 672 - integer, parameter :: rid_MYRCNO3_TERPA3CO3 = 673 - integer, parameter :: rid_MYRCNO3_TERPACO3 = 674 - integer, parameter :: rid_MYRCO2_CH3CO3 = 675 - integer, parameter :: rid_MYRCO2_CH3O2 = 676 - integer, parameter :: rid_MYRCO2_HO2 = 677 - integer, parameter :: rid_MYRCO2_NO = 678 - integer, parameter :: rid_MYRCO2_NO3 = 679 - integer, parameter :: rid_MYRCO2_TERPA2CO3 = 680 - integer, parameter :: rid_MYRCO2_TERPA3CO3 = 681 - integer, parameter :: rid_MYRCO2_TERPACO3 = 682 - integer, parameter :: rid_MYRC_O3 = 683 - integer, parameter :: rid_MYRC_OH = 684 - integer, parameter :: rid_tag_TERPA2CO3_NO2 = 685 - integer, parameter :: rid_tag_TERPA3CO3_NO2 = 686 - integer, parameter :: rid_tag_TERPACO3_NO2 = 687 - integer, parameter :: rid_TERP1OOHO2_HO2 = 688 - integer, parameter :: rid_TERP1OOHO2_NO = 689 - integer, parameter :: rid_TERP1OOH_OH = 690 - integer, parameter :: rid_TERP2AOOH_OH = 691 - integer, parameter :: rid_TERP2OOHO2_HO2 = 692 - integer, parameter :: rid_TERP2OOHO2_NO = 693 - integer, parameter :: rid_TERPA1O2_CH3CO3 = 694 - integer, parameter :: rid_TERPA1O2_CH3O2 = 695 - integer, parameter :: rid_TERPA1O2_HO2 = 696 - integer, parameter :: rid_TERPA1O2_NO = 697 - integer, parameter :: rid_TERPA1O2_NO3 = 698 - integer, parameter :: rid_TERPA1O2_TERPA2CO3 = 699 - integer, parameter :: rid_TERPA1O2_TERPA3CO3 = 700 - integer, parameter :: rid_TERPA1O2_TERPACO3 = 701 - integer, parameter :: rid_TERPA2CO3_CH3CO3 = 702 - integer, parameter :: rid_TERPA2CO3_CH3O2 = 703 - integer, parameter :: rid_TERPA2CO3_HO2 = 704 - integer, parameter :: rid_TERPA2CO3_NO = 705 - integer, parameter :: rid_TERPA2CO3_NO3 = 706 - integer, parameter :: rid_TERPA2CO3_TERPA2CO3 = 707 - integer, parameter :: rid_TERPA2CO3_TERPACO3 = 708 - integer, parameter :: rid_TERPA2_NO3 = 709 - integer, parameter :: rid_TERPA2O2_CH3CO3 = 710 - integer, parameter :: rid_TERPA2O2_CH3O2 = 711 - integer, parameter :: rid_TERPA2O2_HO2 = 712 - integer, parameter :: rid_TERPA2O2_NO = 713 - integer, parameter :: rid_TERPA2O2_NO3 = 714 - integer, parameter :: rid_TERPA2O2_TERPA2CO3 = 715 - integer, parameter :: rid_TERPA2O2_TERPA3CO3 = 716 - integer, parameter :: rid_TERPA2O2_TERPACO3 = 717 - integer, parameter :: rid_TERPA2_OH = 718 - integer, parameter :: rid_TERPA2PAN_OH = 719 - integer, parameter :: rid_TERPA3CO3_CH3CO3 = 720 - integer, parameter :: rid_TERPA3CO3_CH3O2 = 721 - integer, parameter :: rid_TERPA3CO3_HO2 = 722 - integer, parameter :: rid_TERPA3CO3_NO = 723 - integer, parameter :: rid_TERPA3CO3_NO3 = 724 - integer, parameter :: rid_TERPA3CO3_TERPA2CO3 = 725 - integer, parameter :: rid_TERPA3CO3_TERPA3CO3 = 726 - integer, parameter :: rid_TERPA3CO3_TERPACO3 = 727 - integer, parameter :: rid_TERPA3_NO3 = 728 - integer, parameter :: rid_TERPA3O2_CH3CO3 = 729 - integer, parameter :: rid_TERPA3O2_CH3O2 = 730 - integer, parameter :: rid_TERPA3O2_HO2 = 731 - integer, parameter :: rid_TERPA3O2_NO = 732 - integer, parameter :: rid_TERPA3O2_NO3 = 733 - integer, parameter :: rid_TERPA3O2_TERPA2CO3 = 734 - integer, parameter :: rid_TERPA3O2_TERPA3CO3 = 735 - integer, parameter :: rid_TERPA3O2_TERPACO3 = 736 - integer, parameter :: rid_TERPA3_OH = 737 - integer, parameter :: rid_TERPA3PAN_OH = 738 - integer, parameter :: rid_TERPA4O2_CH3CO3 = 739 - integer, parameter :: rid_TERPA4O2_CH3O2 = 740 - integer, parameter :: rid_TERPA4O2_HO2 = 741 - integer, parameter :: rid_TERPA4O2_NO = 742 - integer, parameter :: rid_TERPA4O2_NO3 = 743 - integer, parameter :: rid_TERPA4O2_TERPA2CO3 = 744 - integer, parameter :: rid_TERPA4O2_TERPA3CO3 = 745 - integer, parameter :: rid_TERPA4O2_TERPACO3 = 746 - integer, parameter :: rid_TERPACID2_OH = 747 - integer, parameter :: rid_TERPACID3_OH = 748 - integer, parameter :: rid_TERPACID_OH = 749 - integer, parameter :: rid_TERPACO3_CH3CO3 = 750 - integer, parameter :: rid_TERPACO3_CH3O2 = 751 - integer, parameter :: rid_TERPACO3_HO2 = 752 - integer, parameter :: rid_TERPACO3_NO = 753 - integer, parameter :: rid_TERPACO3_NO3 = 754 - integer, parameter :: rid_TERPACO3_TERPACO3 = 755 - integer, parameter :: rid_TERPA_NO3 = 756 - integer, parameter :: rid_TERPA_OH = 757 - integer, parameter :: rid_TERPAPAN_OH = 758 - integer, parameter :: rid_TERPDHDP_OH = 759 - integer, parameter :: rid_TERPF1_NO3 = 760 - integer, parameter :: rid_TERPF1O2_HO2 = 761 - integer, parameter :: rid_TERPF1O2_NO = 762 - integer, parameter :: rid_TERPF1_O3 = 763 - integer, parameter :: rid_TERPF1_OH = 764 - integer, parameter :: rid_TERPF2_NO3 = 765 - integer, parameter :: rid_TERPF2O2_HO2 = 766 - integer, parameter :: rid_TERPF2O2_NO = 767 - integer, parameter :: rid_TERPF2_O3 = 768 - integer, parameter :: rid_TERPF2_OH = 769 - integer, parameter :: rid_TERPFDN_OH = 770 - integer, parameter :: rid_TERPHFN_OH = 771 - integer, parameter :: rid_TERPK_OH = 772 - integer, parameter :: rid_TERPNPS1O2_HO2 = 773 - integer, parameter :: rid_TERPNPS1O2_NO = 774 - integer, parameter :: rid_TERPNPS1_OH = 775 - integer, parameter :: rid_TERPNPS_OH = 776 - integer, parameter :: rid_TERPNPT1O2_HO2 = 777 - integer, parameter :: rid_TERPNPT1O2_NO = 778 - integer, parameter :: rid_TERPNPT1_OH = 779 - integer, parameter :: rid_TERPNPT_OH = 780 - integer, parameter :: rid_TERPNS1O2_HO2 = 781 - integer, parameter :: rid_TERPNS1O2_NO = 782 - integer, parameter :: rid_TERPNS1_OH = 783 - integer, parameter :: rid_TERPNS_OH = 784 - integer, parameter :: rid_TERPNT1O2_HO2 = 785 - integer, parameter :: rid_TERPNT1O2_NO = 786 - integer, parameter :: rid_TERPNT1_OH = 787 - integer, parameter :: rid_TERPNT_OH = 788 - integer, parameter :: rid_TERPOOHL_OH = 789 - integer, parameter :: rid_TERPOOH_OH = 790 - integer, parameter :: rid_usr_TERPA2PAN_M = 791 - integer, parameter :: rid_usr_TERPA3PAN_M = 792 - integer, parameter :: rid_usr_TERPAPAN_M = 793 - integer, parameter :: rid_DMS_NO3 = 794 - integer, parameter :: rid_DMS_OHa = 795 - integer, parameter :: rid_OCS_O = 796 - integer, parameter :: rid_OCS_OH = 797 - integer, parameter :: rid_S_O2 = 798 + integer, parameter :: rid_HCN_OH = 309 + integer, parameter :: rid_HCOOH_OH = 310 + integer, parameter :: rid_HMHP_OH = 311 + integer, parameter :: rid_HOCH2OO_HO2 = 312 + integer, parameter :: rid_HOCH2OO_M = 313 + integer, parameter :: rid_HOCH2OO_NO = 314 + integer, parameter :: rid_O1D_CH4a = 315 + integer, parameter :: rid_O1D_CH4b = 316 + integer, parameter :: rid_O1D_CH4c = 317 + integer, parameter :: rid_O1D_HCN = 318 + integer, parameter :: rid_usr_CO_OH = 319 + integer, parameter :: rid_C2H2_CL_M = 320 + integer, parameter :: rid_C2H2_OH_M = 321 + integer, parameter :: rid_C2H4_CL_M = 322 + integer, parameter :: rid_C2H4_O3 = 323 + integer, parameter :: rid_C2H5O2_C2H5O2 = 324 + integer, parameter :: rid_C2H5O2_CH3O2 = 325 + integer, parameter :: rid_C2H5O2_HO2 = 326 + integer, parameter :: rid_C2H5O2_NO = 327 + integer, parameter :: rid_C2H5OH_OH = 328 + integer, parameter :: rid_C2H5OOH_OH = 329 + integer, parameter :: rid_C2H6_CL = 330 + integer, parameter :: rid_C2H6_OH = 331 + integer, parameter :: rid_CH3CHO_NO3 = 332 + integer, parameter :: rid_CH3CHO_OH = 333 + integer, parameter :: rid_CH3CN_OH = 334 + integer, parameter :: rid_CH3CO3_CH3CO3 = 335 + integer, parameter :: rid_CH3CO3_CH3O2 = 336 + integer, parameter :: rid_CH3CO3_HO2 = 337 + integer, parameter :: rid_CH3CO3_NO = 338 + integer, parameter :: rid_CH3COOH_OH = 339 + integer, parameter :: rid_CH3COOOH_OH = 340 + integer, parameter :: rid_EO2_HO2 = 341 + integer, parameter :: rid_EO2_NO = 342 + integer, parameter :: rid_EO_M = 343 + integer, parameter :: rid_EO_O2 = 344 + integer, parameter :: rid_GLYALD_OH = 345 + integer, parameter :: rid_GLYOXAL_OH = 346 + integer, parameter :: rid_HCOCH2OOH_OH = 347 + integer, parameter :: rid_NO3CH2CHO_OH = 348 + integer, parameter :: rid_PAN_OH = 349 + integer, parameter :: rid_tag_C2H4_OH = 350 + integer, parameter :: rid_tag_CH3CO3_NO2 = 351 + integer, parameter :: rid_usr_PAN_M = 352 + integer, parameter :: rid_C3H6_NO3 = 353 + integer, parameter :: rid_C3H6_O3 = 354 + integer, parameter :: rid_C3H7O2_CH3O2 = 355 + integer, parameter :: rid_C3H7O2_HO2 = 356 + integer, parameter :: rid_C3H7O2_NO = 357 + integer, parameter :: rid_C3H7OOH_OH = 358 + integer, parameter :: rid_C3H8_OH = 359 + integer, parameter :: rid_CH3COCHO_NO3 = 360 + integer, parameter :: rid_CH3COCHO_OH = 361 + integer, parameter :: rid_HYAC_OH = 362 + integer, parameter :: rid_HYPERACET_OH = 363 + integer, parameter :: rid_NOA_OH = 364 + integer, parameter :: rid_PO2_HO2 = 365 + integer, parameter :: rid_PO2_NO = 366 + integer, parameter :: rid_POOH_OH = 367 + integer, parameter :: rid_RO2_CH3O2 = 368 + integer, parameter :: rid_RO2_HO2 = 369 + integer, parameter :: rid_RO2_NO = 370 + integer, parameter :: rid_ROOH_OH = 371 + integer, parameter :: rid_tag_C3H6_OH = 372 + integer, parameter :: rid_usr_CH3COCH3_OH = 373 + integer, parameter :: rid_BIGENE_NO3 = 374 + integer, parameter :: rid_BIGENE_OH = 375 + integer, parameter :: rid_DHPMPAL_OH = 376 + integer, parameter :: rid_ENEO2_NO = 377 + integer, parameter :: rid_ENEO2_NOb = 378 + integer, parameter :: rid_HONITR_OH = 379 + integer, parameter :: rid_MACRN_OH = 380 + integer, parameter :: rid_MACRO2_CH3CO3 = 381 + integer, parameter :: rid_MACRO2_CH3O2 = 382 + integer, parameter :: rid_MACRO2_HO2 = 383 + integer, parameter :: rid_MACRO2_isom = 384 + integer, parameter :: rid_MACR_O3 = 385 + integer, parameter :: rid_MACR_OH = 386 + integer, parameter :: rid_MACROOH_OH = 387 + integer, parameter :: rid_MCO3_CH3CO3 = 388 + integer, parameter :: rid_MCO3_CH3O2 = 389 + integer, parameter :: rid_MCO3_HO2 = 390 + integer, parameter :: rid_MCO3_MCO3 = 391 + integer, parameter :: rid_MCO3_NO = 392 + integer, parameter :: rid_MCO3_NO3 = 393 + integer, parameter :: rid_MEKO2_HO2 = 394 + integer, parameter :: rid_MEKO2_NO = 395 + integer, parameter :: rid_MEK_OH = 396 + integer, parameter :: rid_MEKOOH_OH = 397 + integer, parameter :: rid_MPAN_OH_M = 398 + integer, parameter :: rid_MVKN_OH = 399 + integer, parameter :: rid_MVKO2_CH3CO3 = 400 + integer, parameter :: rid_MVKO2_CH3O2 = 401 + integer, parameter :: rid_MVKO2_HO2 = 402 + integer, parameter :: rid_MVK_O3 = 403 + integer, parameter :: rid_MVK_OH = 404 + integer, parameter :: rid_MVKOOH_OH = 405 + integer, parameter :: rid_tag_MCO3_NO2 = 406 + integer, parameter :: rid_usr_MPAN_M = 407 + integer, parameter :: rid_ALKNIT_OH = 408 + integer, parameter :: rid_ALKO2_HO2 = 409 + integer, parameter :: rid_ALKO2_NO = 410 + integer, parameter :: rid_ALKO2_NOb = 411 + integer, parameter :: rid_ALKOOH_OH = 412 + integer, parameter :: rid_BIGALK_OH = 413 + integer, parameter :: rid_HPALD1_OH = 414 + integer, parameter :: rid_HPALD4_OH = 415 + integer, parameter :: rid_HPALDB1C_OH = 416 + integer, parameter :: rid_HPALDB4C_OH = 417 + integer, parameter :: rid_HYDRALD_OH = 418 + integer, parameter :: rid_ICHE_OH = 419 + integer, parameter :: rid_IEPOX_OH = 420 + integer, parameter :: rid_IEPOXOO_HO2 = 421 + integer, parameter :: rid_INHEB_OH = 422 + integer, parameter :: rid_INHED_OH = 423 + integer, parameter :: rid_ISOPB1O2_CH3CO3 = 424 + integer, parameter :: rid_ISOPB1O2_CH3O2 = 425 + integer, parameter :: rid_ISOPB1O2_HO2 = 426 + integer, parameter :: rid_ISOPB1O2_I = 427 + integer, parameter :: rid_ISOPB1O2_M_C = 428 + integer, parameter :: rid_ISOPB1O2_M_T = 429 + integer, parameter :: rid_ISOPB4O2_CH3CO3 = 430 + integer, parameter :: rid_ISOPB4O2_CH3O2 = 431 + integer, parameter :: rid_ISOPB4O2_HO2 = 432 + integer, parameter :: rid_ISOPB4O2_I = 433 + integer, parameter :: rid_ISOPB4O2_M_C = 434 + integer, parameter :: rid_ISOPB4O2_M_T = 435 + integer, parameter :: rid_ISOPC1C_O2_B = 436 + integer, parameter :: rid_ISOPC1C_O2_D = 437 + integer, parameter :: rid_ISOPC1T_O2_B = 438 + integer, parameter :: rid_ISOPC1T_O2_D = 439 + integer, parameter :: rid_ISOPC4C_O2_B = 440 + integer, parameter :: rid_ISOPC4C_O2_D = 441 + integer, parameter :: rid_ISOPC4T_O2_B = 442 + integer, parameter :: rid_ISOPC4T_O2_D = 443 + integer, parameter :: rid_ISOPED1O2_CH3CO3 = 444 + integer, parameter :: rid_ISOPED1O2_CH3O2 = 445 + integer, parameter :: rid_ISOPED1O2_HO2 = 446 + integer, parameter :: rid_ISOPED1O2_M_C = 447 + integer, parameter :: rid_ISOPED4O2_CH3CO3 = 448 + integer, parameter :: rid_ISOPED4O2_CH3O2 = 449 + integer, parameter :: rid_ISOPED4O2_HO2 = 450 + integer, parameter :: rid_ISOPED4O2_M = 451 + integer, parameter :: rid_ISOPFDNC_OH = 452 + integer, parameter :: rid_ISOPFDN_OH = 453 + integer, parameter :: rid_ISOPFNC_OH = 454 + integer, parameter :: rid_ISOPFNP_OH = 455 + integer, parameter :: rid_ISOPHFP_OH = 456 + integer, parameter :: rid_ISOPN1DO2_HO2 = 457 + integer, parameter :: rid_ISOPN1DO2_I = 458 + integer, parameter :: rid_ISOPN1D_O3 = 459 + integer, parameter :: rid_ISOPN1D_OH = 460 + integer, parameter :: rid_ISOPN2BO2_HO2 = 461 + integer, parameter :: rid_ISOPN2BO2_I = 462 + integer, parameter :: rid_ISOPN2B_OH = 463 + integer, parameter :: rid_ISOPN3BO2_HO2 = 464 + integer, parameter :: rid_ISOPN3BO2_I = 465 + integer, parameter :: rid_ISOPN3B_OH = 466 + integer, parameter :: rid_ISOPN4DO2_HO2 = 467 + integer, parameter :: rid_ISOPN4DO2_I = 468 + integer, parameter :: rid_ISOPN4D_O3 = 469 + integer, parameter :: rid_ISOPN4D_OH = 470 + integer, parameter :: rid_ISOPNBNO3O2_HO2 = 471 + integer, parameter :: rid_ISOPNBNO3_OH = 472 + integer, parameter :: rid_ISOP_NO3 = 473 + integer, parameter :: rid_ISOPNO3_CH3CO3 = 474 + integer, parameter :: rid_ISOPNO3_CH3O2 = 475 + integer, parameter :: rid_ISOPNO3_HO2 = 476 + integer, parameter :: rid_ISOPNO3_ISOPNO3 = 477 + integer, parameter :: rid_ISOPNO3_NO3 = 478 + integer, parameter :: rid_ISOPNOOHBO2_HO2 = 479 + integer, parameter :: rid_ISOPNOOHBO2_I = 480 + integer, parameter :: rid_ISOPNOOHB_OH = 481 + integer, parameter :: rid_ISOPNOOHDO2_HO2 = 482 + integer, parameter :: rid_ISOPNOOHDO2_I = 483 + integer, parameter :: rid_ISOPNOOHD_O3 = 484 + integer, parameter :: rid_ISOPNOOHD_OH = 485 + integer, parameter :: rid_ISOP_O3 = 486 + integer, parameter :: rid_ISOP_OH = 487 + integer, parameter :: rid_ISOPOH_OH = 488 + integer, parameter :: rid_ISOPOOH_OH_abs = 489 + integer, parameter :: rid_ISOPOOH_OH_add = 490 + integer, parameter :: rid_ISOPZD1O2_CH3CO3 = 491 + integer, parameter :: rid_ISOPZD1O2_CH3O2 = 492 + integer, parameter :: rid_ISOPZD1O2_HO2 = 493 + integer, parameter :: rid_ISOPZD1O2_M = 494 + integer, parameter :: rid_ISOPZD4O2_CH3CO3 = 495 + integer, parameter :: rid_ISOPZD4O2_CH3O2 = 496 + integer, parameter :: rid_ISOPZD4O2_HO2 = 497 + integer, parameter :: rid_ISOPZD4O2_M_C = 498 + integer, parameter :: rid_NC4CHOO2_HO2 = 499 + integer, parameter :: rid_NC4CHOO2_isom = 500 + integer, parameter :: rid_NC4CHO_O3 = 501 + integer, parameter :: rid_NC4CHO_OH = 502 + integer, parameter :: rid_usr_IEPOXOO_NOa = 503 + integer, parameter :: rid_usr_IEPOXOO_NOn = 504 + integer, parameter :: rid_usr_ISOPB1O2_NOa = 505 + integer, parameter :: rid_usr_ISOPB1O2_NOn = 506 + integer, parameter :: rid_usr_ISOPB4O2_NOa = 507 + integer, parameter :: rid_usr_ISOPB4O2_NOn = 508 + integer, parameter :: rid_usr_ISOPED1O2_NOa = 509 + integer, parameter :: rid_usr_ISOPED1O2_NOn = 510 + integer, parameter :: rid_usr_ISOPED4O2_NOa = 511 + integer, parameter :: rid_usr_ISOPED4O2_NOn = 512 + integer, parameter :: rid_usr_ISOPN1DO2_NOa = 513 + integer, parameter :: rid_usr_ISOPN1DO2_NOn = 514 + integer, parameter :: rid_usr_ISOPN2BO2_NOa = 515 + integer, parameter :: rid_usr_ISOPN2BO2_NOn = 516 + integer, parameter :: rid_usr_ISOPN3BO2_NOa = 517 + integer, parameter :: rid_usr_ISOPN3BO2_NOn = 518 + integer, parameter :: rid_usr_ISOPN4DO2_NOa = 519 + integer, parameter :: rid_usr_ISOPN4DO2_NOn = 520 + integer, parameter :: rid_usr_ISOPNBNO3O2_NOa = 521 + integer, parameter :: rid_usr_ISOPNBNO3O2_NOn = 522 + integer, parameter :: rid_usr_ISOPNO3_NOa = 523 + integer, parameter :: rid_usr_ISOPNO3_NOn = 524 + integer, parameter :: rid_usr_ISOPNOOHBO2_NOa = 525 + integer, parameter :: rid_usr_ISOPNOOHBO2_NOn = 526 + integer, parameter :: rid_usr_ISOPNOOHDO2_NOa = 527 + integer, parameter :: rid_usr_ISOPNOOHDO2_NOn = 528 + integer, parameter :: rid_usr_ISOPZD1O2 = 529 + integer, parameter :: rid_usr_ISOPZD1O2_NOa = 530 + integer, parameter :: rid_usr_ISOPZD1O2_NOn = 531 + integer, parameter :: rid_usr_ISOPZD4O2 = 532 + integer, parameter :: rid_usr_ISOPZD4O2_NOa = 533 + integer, parameter :: rid_usr_ISOPZD4O2_NOn = 534 + integer, parameter :: rid_usr_MACRO2_NOa = 535 + integer, parameter :: rid_usr_MACRO2_NOn = 536 + integer, parameter :: rid_usr_MVKO2_NOa = 537 + integer, parameter :: rid_usr_MVKO2_NOn = 538 + integer, parameter :: rid_usr_NC4CHOO2_NOa = 539 + integer, parameter :: rid_usr_NC4CHOO2_NOn = 540 + integer, parameter :: rid_ACBZO2_HO2 = 541 + integer, parameter :: rid_ACBZO2_NO = 542 + integer, parameter :: rid_BENZENE_OH = 543 + integer, parameter :: rid_BENZO2_HO2 = 544 + integer, parameter :: rid_BENZO2_NO = 545 + integer, parameter :: rid_BENZOOH_OH = 546 + integer, parameter :: rid_BZALD_OH = 547 + integer, parameter :: rid_BZOO_HO2 = 548 + integer, parameter :: rid_BZOOH_OH = 549 + integer, parameter :: rid_BZOO_NO = 550 + integer, parameter :: rid_C6H5O2_HO2 = 551 + integer, parameter :: rid_C6H5O2_NO = 552 + integer, parameter :: rid_C6H5OOH_OH = 553 + integer, parameter :: rid_CRESOL_OH = 554 + integer, parameter :: rid_DICARBO2_HO2 = 555 + integer, parameter :: rid_DICARBO2_NO = 556 + integer, parameter :: rid_DICARBO2_NO2 = 557 + integer, parameter :: rid_MALO2_HO2 = 558 + integer, parameter :: rid_MALO2_NO = 559 + integer, parameter :: rid_MALO2_NO2 = 560 + integer, parameter :: rid_MDIALO2_HO2 = 561 + integer, parameter :: rid_MDIALO2_NO = 562 + integer, parameter :: rid_MDIALO2_NO2 = 563 + integer, parameter :: rid_PHENO2_HO2 = 564 + integer, parameter :: rid_PHENO2_NO = 565 + integer, parameter :: rid_PHENOL_OH = 566 + integer, parameter :: rid_PHENO_NO2 = 567 + integer, parameter :: rid_PHENO_O3 = 568 + integer, parameter :: rid_PHENOOH_OH = 569 + integer, parameter :: rid_tag_ACBZO2_NO2 = 570 + integer, parameter :: rid_TOLO2_HO2 = 571 + integer, parameter :: rid_TOLO2_NO = 572 + integer, parameter :: rid_TOLOOH_OH = 573 + integer, parameter :: rid_TOLUENE_OH = 574 + integer, parameter :: rid_usr_PBZNIT_M = 575 + integer, parameter :: rid_XYLENES_OH = 576 + integer, parameter :: rid_XYLENO2_HO2 = 577 + integer, parameter :: rid_XYLENO2_NO = 578 + integer, parameter :: rid_XYLENOOH_OH = 579 + integer, parameter :: rid_XYLOLO2_HO2 = 580 + integer, parameter :: rid_XYLOLO2_NO = 581 + integer, parameter :: rid_XYLOL_OH = 582 + integer, parameter :: rid_XYLOLOOH_OH = 583 + integer, parameter :: rid_APIN_NO3 = 584 + integer, parameter :: rid_APINNO3_APINNO3 = 585 + integer, parameter :: rid_APINNO3_CH3CO3 = 586 + integer, parameter :: rid_APINNO3_CH3O2 = 587 + integer, parameter :: rid_APINNO3_HO2 = 588 + integer, parameter :: rid_APINNO3_NO = 589 + integer, parameter :: rid_APINNO3_NO3 = 590 + integer, parameter :: rid_APINNO3_TERPA2CO3 = 591 + integer, parameter :: rid_APINNO3_TERPA3CO3 = 592 + integer, parameter :: rid_APINNO3_TERPACO3 = 593 + integer, parameter :: rid_APINO2_CH3CO3 = 594 + integer, parameter :: rid_APINO2_CH3O2 = 595 + integer, parameter :: rid_APINO2_HO2 = 596 + integer, parameter :: rid_APINO2_NO = 597 + integer, parameter :: rid_APINO2_NO3 = 598 + integer, parameter :: rid_APINO2_TERPA2CO3 = 599 + integer, parameter :: rid_APINO2_TERPA3CO3 = 600 + integer, parameter :: rid_APINO2_TERPACO3 = 601 + integer, parameter :: rid_APIN_O3 = 602 + integer, parameter :: rid_APIN_OH = 603 + integer, parameter :: rid_BCARY_NO3 = 604 + integer, parameter :: rid_BCARYNO3_BCARYNO3 = 605 + integer, parameter :: rid_BCARYNO3_CH3CO3 = 606 + integer, parameter :: rid_BCARYNO3_CH3O2 = 607 + integer, parameter :: rid_BCARYNO3_HO2 = 608 + integer, parameter :: rid_BCARYNO3_NO = 609 + integer, parameter :: rid_BCARYNO3_NO3 = 610 + integer, parameter :: rid_BCARYNO3_TERPA2CO3 = 611 + integer, parameter :: rid_BCARYNO3_TERPA3CO3 = 612 + integer, parameter :: rid_BCARYNO3_TERPACO3 = 613 + integer, parameter :: rid_BCARYO2_CH3CO3 = 614 + integer, parameter :: rid_BCARYO2_CH3O2 = 615 + integer, parameter :: rid_BCARYO2_HO2 = 616 + integer, parameter :: rid_BCARYO2_NO = 617 + integer, parameter :: rid_BCARYO2_NO3 = 618 + integer, parameter :: rid_BCARYO2_TERPA2CO3 = 619 + integer, parameter :: rid_BCARYO2_TERPA3CO3 = 620 + integer, parameter :: rid_BCARYO2_TERPACO3 = 621 + integer, parameter :: rid_BCARY_O3 = 622 + integer, parameter :: rid_BCARY_OH = 623 + integer, parameter :: rid_BPIN_NO3 = 624 + integer, parameter :: rid_BPINNO3_BPINNO3 = 625 + integer, parameter :: rid_BPINNO3_CH3CO3 = 626 + integer, parameter :: rid_BPINNO3_CH3O2 = 627 + integer, parameter :: rid_BPINNO3_HO2 = 628 + integer, parameter :: rid_BPINNO3_NO = 629 + integer, parameter :: rid_BPINNO3_NO3 = 630 + integer, parameter :: rid_BPINNO3_TERPA2CO3 = 631 + integer, parameter :: rid_BPINNO3_TERPA3CO3 = 632 + integer, parameter :: rid_BPINNO3_TERPACO3 = 633 + integer, parameter :: rid_BPINO2_CH3CO3 = 634 + integer, parameter :: rid_BPINO2_CH3O2 = 635 + integer, parameter :: rid_BPINO2_HO2 = 636 + integer, parameter :: rid_BPINO2_NO = 637 + integer, parameter :: rid_BPINO2_NO3 = 638 + integer, parameter :: rid_BPINO2_TERPA2CO3 = 639 + integer, parameter :: rid_BPINO2_TERPA3CO3 = 640 + integer, parameter :: rid_BPINO2_TERPACO3 = 641 + integer, parameter :: rid_BPIN_O3 = 642 + integer, parameter :: rid_BPIN_OH = 643 + integer, parameter :: rid_LIMON_NO3 = 644 + integer, parameter :: rid_LIMONNO3_CH3CO3 = 645 + integer, parameter :: rid_LIMONNO3_CH3O2 = 646 + integer, parameter :: rid_LIMONNO3_HO2 = 647 + integer, parameter :: rid_LIMONNO3_LIMONNO3 = 648 + integer, parameter :: rid_LIMONNO3_NO = 649 + integer, parameter :: rid_LIMONNO3_NO3 = 650 + integer, parameter :: rid_LIMONNO3_TERPA2CO3 = 651 + integer, parameter :: rid_LIMONNO3_TERPA3CO3 = 652 + integer, parameter :: rid_LIMONNO3_TERPACO3 = 653 + integer, parameter :: rid_LIMONO2_CH3CO3 = 654 + integer, parameter :: rid_LIMONO2_CH3O2 = 655 + integer, parameter :: rid_LIMONO2_HO2 = 656 + integer, parameter :: rid_LIMONO2_NO = 657 + integer, parameter :: rid_LIMONO2_NO3 = 658 + integer, parameter :: rid_LIMONO2_TERPA2CO3 = 659 + integer, parameter :: rid_LIMONO2_TERPA3CO3 = 660 + integer, parameter :: rid_LIMONO2_TERPACO3 = 661 + integer, parameter :: rid_LIMON_O3 = 662 + integer, parameter :: rid_LIMON_OH = 663 + integer, parameter :: rid_MYRC_NO3 = 664 + integer, parameter :: rid_MYRCNO3_CH3CO3 = 665 + integer, parameter :: rid_MYRCNO3_CH3O2 = 666 + integer, parameter :: rid_MYRCNO3_HO2 = 667 + integer, parameter :: rid_MYRCNO3_MYRCNO3 = 668 + integer, parameter :: rid_MYRCNO3_NO = 669 + integer, parameter :: rid_MYRCNO3_NO3 = 670 + integer, parameter :: rid_MYRCNO3_TERPA2CO3 = 671 + integer, parameter :: rid_MYRCNO3_TERPA3CO3 = 672 + integer, parameter :: rid_MYRCNO3_TERPACO3 = 673 + integer, parameter :: rid_MYRCO2_CH3CO3 = 674 + integer, parameter :: rid_MYRCO2_CH3O2 = 675 + integer, parameter :: rid_MYRCO2_HO2 = 676 + integer, parameter :: rid_MYRCO2_NO = 677 + integer, parameter :: rid_MYRCO2_NO3 = 678 + integer, parameter :: rid_MYRCO2_TERPA2CO3 = 679 + integer, parameter :: rid_MYRCO2_TERPA3CO3 = 680 + integer, parameter :: rid_MYRCO2_TERPACO3 = 681 + integer, parameter :: rid_MYRC_O3 = 682 + integer, parameter :: rid_MYRC_OH = 683 + integer, parameter :: rid_tag_TERPA2CO3_NO2 = 684 + integer, parameter :: rid_tag_TERPA3CO3_NO2 = 685 + integer, parameter :: rid_tag_TERPACO3_NO2 = 686 + integer, parameter :: rid_TERP1OOHO2_HO2 = 687 + integer, parameter :: rid_TERP1OOHO2_NO = 688 + integer, parameter :: rid_TERP1OOH_OH = 689 + integer, parameter :: rid_TERP2AOOH_OH = 690 + integer, parameter :: rid_TERP2OOHO2_HO2 = 691 + integer, parameter :: rid_TERP2OOHO2_NO = 692 + integer, parameter :: rid_TERPA1O2_CH3CO3 = 693 + integer, parameter :: rid_TERPA1O2_CH3O2 = 694 + integer, parameter :: rid_TERPA1O2_HO2 = 695 + integer, parameter :: rid_TERPA1O2_NO = 696 + integer, parameter :: rid_TERPA1O2_NO3 = 697 + integer, parameter :: rid_TERPA1O2_TERPA2CO3 = 698 + integer, parameter :: rid_TERPA1O2_TERPA3CO3 = 699 + integer, parameter :: rid_TERPA1O2_TERPACO3 = 700 + integer, parameter :: rid_TERPA2CO3_CH3CO3 = 701 + integer, parameter :: rid_TERPA2CO3_CH3O2 = 702 + integer, parameter :: rid_TERPA2CO3_HO2 = 703 + integer, parameter :: rid_TERPA2CO3_NO = 704 + integer, parameter :: rid_TERPA2CO3_NO3 = 705 + integer, parameter :: rid_TERPA2CO3_TERPA2CO3 = 706 + integer, parameter :: rid_TERPA2CO3_TERPACO3 = 707 + integer, parameter :: rid_TERPA2_NO3 = 708 + integer, parameter :: rid_TERPA2O2_CH3CO3 = 709 + integer, parameter :: rid_TERPA2O2_CH3O2 = 710 + integer, parameter :: rid_TERPA2O2_HO2 = 711 + integer, parameter :: rid_TERPA2O2_NO = 712 + integer, parameter :: rid_TERPA2O2_NO3 = 713 + integer, parameter :: rid_TERPA2O2_TERPA2CO3 = 714 + integer, parameter :: rid_TERPA2O2_TERPA3CO3 = 715 + integer, parameter :: rid_TERPA2O2_TERPACO3 = 716 + integer, parameter :: rid_TERPA2_OH = 717 + integer, parameter :: rid_TERPA2PAN_OH = 718 + integer, parameter :: rid_TERPA3CO3_CH3CO3 = 719 + integer, parameter :: rid_TERPA3CO3_CH3O2 = 720 + integer, parameter :: rid_TERPA3CO3_HO2 = 721 + integer, parameter :: rid_TERPA3CO3_NO = 722 + integer, parameter :: rid_TERPA3CO3_NO3 = 723 + integer, parameter :: rid_TERPA3CO3_TERPA2CO3 = 724 + integer, parameter :: rid_TERPA3CO3_TERPA3CO3 = 725 + integer, parameter :: rid_TERPA3CO3_TERPACO3 = 726 + integer, parameter :: rid_TERPA3_NO3 = 727 + integer, parameter :: rid_TERPA3O2_CH3CO3 = 728 + integer, parameter :: rid_TERPA3O2_CH3O2 = 729 + integer, parameter :: rid_TERPA3O2_HO2 = 730 + integer, parameter :: rid_TERPA3O2_NO = 731 + integer, parameter :: rid_TERPA3O2_NO3 = 732 + integer, parameter :: rid_TERPA3O2_TERPA2CO3 = 733 + integer, parameter :: rid_TERPA3O2_TERPA3CO3 = 734 + integer, parameter :: rid_TERPA3O2_TERPACO3 = 735 + integer, parameter :: rid_TERPA3_OH = 736 + integer, parameter :: rid_TERPA3PAN_OH = 737 + integer, parameter :: rid_TERPA4O2_CH3CO3 = 738 + integer, parameter :: rid_TERPA4O2_CH3O2 = 739 + integer, parameter :: rid_TERPA4O2_HO2 = 740 + integer, parameter :: rid_TERPA4O2_NO = 741 + integer, parameter :: rid_TERPA4O2_NO3 = 742 + integer, parameter :: rid_TERPA4O2_TERPA2CO3 = 743 + integer, parameter :: rid_TERPA4O2_TERPA3CO3 = 744 + integer, parameter :: rid_TERPA4O2_TERPACO3 = 745 + integer, parameter :: rid_TERPACID2_OH = 746 + integer, parameter :: rid_TERPACID3_OH = 747 + integer, parameter :: rid_TERPACID_OH = 748 + integer, parameter :: rid_TERPACO3_CH3CO3 = 749 + integer, parameter :: rid_TERPACO3_CH3O2 = 750 + integer, parameter :: rid_TERPACO3_HO2 = 751 + integer, parameter :: rid_TERPACO3_NO = 752 + integer, parameter :: rid_TERPACO3_NO3 = 753 + integer, parameter :: rid_TERPACO3_TERPACO3 = 754 + integer, parameter :: rid_TERPA_NO3 = 755 + integer, parameter :: rid_TERPA_OH = 756 + integer, parameter :: rid_TERPAPAN_OH = 757 + integer, parameter :: rid_TERPDHDP_OH = 758 + integer, parameter :: rid_TERPF1_NO3 = 759 + integer, parameter :: rid_TERPF1O2_HO2 = 760 + integer, parameter :: rid_TERPF1O2_NO = 761 + integer, parameter :: rid_TERPF1_O3 = 762 + integer, parameter :: rid_TERPF1_OH = 763 + integer, parameter :: rid_TERPF2_NO3 = 764 + integer, parameter :: rid_TERPF2O2_HO2 = 765 + integer, parameter :: rid_TERPF2O2_NO = 766 + integer, parameter :: rid_TERPF2_O3 = 767 + integer, parameter :: rid_TERPF2_OH = 768 + integer, parameter :: rid_TERPFDN_OH = 769 + integer, parameter :: rid_TERPHFN_OH = 770 + integer, parameter :: rid_TERPK_OH = 771 + integer, parameter :: rid_TERPNPS1O2_HO2 = 772 + integer, parameter :: rid_TERPNPS1O2_NO = 773 + integer, parameter :: rid_TERPNPS1_OH = 774 + integer, parameter :: rid_TERPNPS_OH = 775 + integer, parameter :: rid_TERPNPT1O2_HO2 = 776 + integer, parameter :: rid_TERPNPT1O2_NO = 777 + integer, parameter :: rid_TERPNPT1_OH = 778 + integer, parameter :: rid_TERPNPT_OH = 779 + integer, parameter :: rid_TERPNS1O2_HO2 = 780 + integer, parameter :: rid_TERPNS1O2_NO = 781 + integer, parameter :: rid_TERPNS1_OH = 782 + integer, parameter :: rid_TERPNS_OH = 783 + integer, parameter :: rid_TERPNT1O2_HO2 = 784 + integer, parameter :: rid_TERPNT1O2_NO = 785 + integer, parameter :: rid_TERPNT1_OH = 786 + integer, parameter :: rid_TERPNT_OH = 787 + integer, parameter :: rid_TERPOOHL_OH = 788 + integer, parameter :: rid_TERPOOH_OH = 789 + integer, parameter :: rid_usr_TERPA2PAN_M = 790 + integer, parameter :: rid_usr_TERPA3PAN_M = 791 + integer, parameter :: rid_usr_TERPAPAN_M = 792 + integer, parameter :: rid_DMS_NO3 = 793 + integer, parameter :: rid_DMS_OHa = 794 + integer, parameter :: rid_OCS_O = 795 + integer, parameter :: rid_OCS_OH = 796 + integer, parameter :: rid_S_O2 = 797 + integer, parameter :: rid_SO2_OH_M = 798 integer, parameter :: rid_S_O3 = 799 integer, parameter :: rid_SO_BRO = 800 integer, parameter :: rid_SO_CLO = 801 @@ -808,101 +808,100 @@ module m_rxt_id integer, parameter :: rid_SO_OCLO = 806 integer, parameter :: rid_SO_OH = 807 integer, parameter :: rid_usr_DMS_OH = 808 - integer, parameter :: rid_usr_SO2_OH = 809 - integer, parameter :: rid_usr_SO3_H2O = 810 - integer, parameter :: rid_NH3_OH = 811 - integer, parameter :: rid_usr_GLYOXAL_aer = 812 - integer, parameter :: rid_usr_HO2_aer = 813 - integer, parameter :: rid_usr_HONITR_aer = 814 - integer, parameter :: rid_usr_ICHE_aer = 815 - integer, parameter :: rid_usr_IEPOX_aer = 816 - integer, parameter :: rid_usr_INHEB_aer = 817 - integer, parameter :: rid_usr_INHED_aer = 818 - integer, parameter :: rid_usr_INOOHD_aer = 819 - integer, parameter :: rid_usr_ISOPFDN_aer = 820 - integer, parameter :: rid_usr_ISOPFDNC_aer = 821 - integer, parameter :: rid_usr_ISOPFNC_aer = 822 - integer, parameter :: rid_usr_ISOPFNP_aer = 823 - integer, parameter :: rid_usr_ISOPHFP_aer = 824 - integer, parameter :: rid_usr_ISOPN1D_aer = 825 - integer, parameter :: rid_usr_ISOPN2B_aer = 826 - integer, parameter :: rid_usr_ISOPN4D_aer = 827 - integer, parameter :: rid_usr_N2O5_aer = 828 - integer, parameter :: rid_usr_NC4CHO_aer = 829 - integer, parameter :: rid_usr_NH4_strat_tau = 830 - integer, parameter :: rid_usr_NO2_aer = 831 - integer, parameter :: rid_usr_NO3_aer = 832 - integer, parameter :: rid_usr_ONITR_aer = 833 - integer, parameter :: rid_usr_SQTN_aer = 834 - integer, parameter :: rid_usr_TERPDHDP_aer = 835 - integer, parameter :: rid_usr_TERPFDN_aer = 836 - integer, parameter :: rid_usr_TERPHFN_aer = 837 - integer, parameter :: rid_usr_TERPNPT1_aer = 838 - integer, parameter :: rid_usr_TERPNPT_aer = 839 - integer, parameter :: rid_usr_TERPNT1_aer = 840 - integer, parameter :: rid_usr_TERPNT_aer = 841 - integer, parameter :: rid_APIN_NO3_vbs = 842 - integer, parameter :: rid_APINO2_HO2_vbs = 843 - integer, parameter :: rid_APINO2_NO_vbs = 844 - integer, parameter :: rid_APIN_O3_vbs = 845 - integer, parameter :: rid_APIN_OH_vbs = 846 - integer, parameter :: rid_BCARY_NO3_vbs = 847 - integer, parameter :: rid_BCARYO2_HO2_vbs = 848 - integer, parameter :: rid_BCARYO2_NO_vbs = 849 - integer, parameter :: rid_BCARY_O3_vbs = 850 - integer, parameter :: rid_BCARY_OH_vbs = 851 - integer, parameter :: rid_BENZENE_OH_vbs = 852 - integer, parameter :: rid_BENZO2_HO2_vbs = 853 - integer, parameter :: rid_BENZO2_NO_vbs = 854 - integer, parameter :: rid_BPIN_NO3_vbs = 855 - integer, parameter :: rid_BPINO2_HO2_vbs = 856 - integer, parameter :: rid_BPINO2_NO_vbs = 857 - integer, parameter :: rid_BPIN_O3_vbs = 858 - integer, parameter :: rid_BPIN_OH_vbs = 859 - integer, parameter :: rid_ISOP_NO3_vbs = 860 - integer, parameter :: rid_ISOPO2_HO2_vbs = 861 - integer, parameter :: rid_ISOPO2_NO_vbs = 862 - integer, parameter :: rid_ISOP_O3_vbs = 863 - integer, parameter :: rid_ISOP_OH_vbs = 864 - integer, parameter :: rid_IVOCO2_HO2_vbs = 865 - integer, parameter :: rid_IVOCO2_NO_vbs = 866 - integer, parameter :: rid_IVOC_OH_vbs = 867 - integer, parameter :: rid_LIMON_NO3_vbs = 868 - integer, parameter :: rid_LIMONO2_HO2_vbs = 869 - integer, parameter :: rid_LIMONO2_NO_vbs = 870 - integer, parameter :: rid_LIMON_O3_vbs = 871 - integer, parameter :: rid_LIMON_OH_vbs = 872 - integer, parameter :: rid_MYRC_NO3_vbs = 873 - integer, parameter :: rid_MYRCO2_HO2_vbs = 874 - integer, parameter :: rid_MYRCO2_NO_vbs = 875 - integer, parameter :: rid_MYRC_O3_vbs = 876 - integer, parameter :: rid_MYRC_OH_vbs = 877 - integer, parameter :: rid_SVOC_OH = 878 - integer, parameter :: rid_TOLUENE_OH_vbs = 879 - integer, parameter :: rid_TOLUO2_HO2_vbs = 880 - integer, parameter :: rid_TOLUO2_NO_vbs = 881 - integer, parameter :: rid_XYLENES_OH_vbs = 882 - integer, parameter :: rid_XYLEO2_HO2_vbs = 883 - integer, parameter :: rid_XYLEO2_NO_vbs = 884 - integer, parameter :: rid_het1 = 885 - integer, parameter :: rid_het10 = 886 - integer, parameter :: rid_het11 = 887 - integer, parameter :: rid_het12 = 888 - integer, parameter :: rid_het13 = 889 - integer, parameter :: rid_het14 = 890 - integer, parameter :: rid_het15 = 891 - integer, parameter :: rid_het16 = 892 - integer, parameter :: rid_het17 = 893 - integer, parameter :: rid_het2 = 894 - integer, parameter :: rid_het3 = 895 - integer, parameter :: rid_het4 = 896 - integer, parameter :: rid_het5 = 897 - integer, parameter :: rid_het6 = 898 - integer, parameter :: rid_het7 = 899 - integer, parameter :: rid_het8 = 900 - integer, parameter :: rid_het9 = 901 - integer, parameter :: rid_E90_tau = 902 - integer, parameter :: rid_NH_50_tau = 903 - integer, parameter :: rid_NH_5_tau = 904 - integer, parameter :: rid_ST80_25_tau = 905 + integer, parameter :: rid_usr_SO3_H2O = 809 + integer, parameter :: rid_NH3_OH = 810 + integer, parameter :: rid_usr_GLYOXAL_aer = 811 + integer, parameter :: rid_usr_HO2_aer = 812 + integer, parameter :: rid_usr_HONITR_aer = 813 + integer, parameter :: rid_usr_ICHE_aer = 814 + integer, parameter :: rid_usr_IEPOX_aer = 815 + integer, parameter :: rid_usr_INHEB_aer = 816 + integer, parameter :: rid_usr_INHED_aer = 817 + integer, parameter :: rid_usr_INOOHD_aer = 818 + integer, parameter :: rid_usr_ISOPFDN_aer = 819 + integer, parameter :: rid_usr_ISOPFDNC_aer = 820 + integer, parameter :: rid_usr_ISOPFNC_aer = 821 + integer, parameter :: rid_usr_ISOPFNP_aer = 822 + integer, parameter :: rid_usr_ISOPHFP_aer = 823 + integer, parameter :: rid_usr_ISOPN1D_aer = 824 + integer, parameter :: rid_usr_ISOPN2B_aer = 825 + integer, parameter :: rid_usr_ISOPN4D_aer = 826 + integer, parameter :: rid_usr_N2O5_aer = 827 + integer, parameter :: rid_usr_NC4CHO_aer = 828 + integer, parameter :: rid_usr_NH4_strat_tau = 829 + integer, parameter :: rid_usr_NO2_aer = 830 + integer, parameter :: rid_usr_NO3_aer = 831 + integer, parameter :: rid_usr_ONITR_aer = 832 + integer, parameter :: rid_usr_SQTN_aer = 833 + integer, parameter :: rid_usr_TERPDHDP_aer = 834 + integer, parameter :: rid_usr_TERPFDN_aer = 835 + integer, parameter :: rid_usr_TERPHFN_aer = 836 + integer, parameter :: rid_usr_TERPNPT1_aer = 837 + integer, parameter :: rid_usr_TERPNPT_aer = 838 + integer, parameter :: rid_usr_TERPNT1_aer = 839 + integer, parameter :: rid_usr_TERPNT_aer = 840 + integer, parameter :: rid_APIN_NO3_vbs = 841 + integer, parameter :: rid_APINO2_HO2_vbs = 842 + integer, parameter :: rid_APINO2_NO_vbs = 843 + integer, parameter :: rid_APIN_O3_vbs = 844 + integer, parameter :: rid_APIN_OH_vbs = 845 + integer, parameter :: rid_BCARY_NO3_vbs = 846 + integer, parameter :: rid_BCARYO2_HO2_vbs = 847 + integer, parameter :: rid_BCARYO2_NO_vbs = 848 + integer, parameter :: rid_BCARY_O3_vbs = 849 + integer, parameter :: rid_BCARY_OH_vbs = 850 + integer, parameter :: rid_BENZENE_OH_vbs = 851 + integer, parameter :: rid_BENZO2_HO2_vbs = 852 + integer, parameter :: rid_BENZO2_NO_vbs = 853 + integer, parameter :: rid_BPIN_NO3_vbs = 854 + integer, parameter :: rid_BPINO2_HO2_vbs = 855 + integer, parameter :: rid_BPINO2_NO_vbs = 856 + integer, parameter :: rid_BPIN_O3_vbs = 857 + integer, parameter :: rid_BPIN_OH_vbs = 858 + integer, parameter :: rid_ISOP_NO3_vbs = 859 + integer, parameter :: rid_ISOPO2_HO2_vbs = 860 + integer, parameter :: rid_ISOPO2_NO_vbs = 861 + integer, parameter :: rid_ISOP_O3_vbs = 862 + integer, parameter :: rid_ISOP_OH_vbs = 863 + integer, parameter :: rid_IVOCO2_HO2_vbs = 864 + integer, parameter :: rid_IVOCO2_NO_vbs = 865 + integer, parameter :: rid_IVOC_OH_vbs = 866 + integer, parameter :: rid_LIMON_NO3_vbs = 867 + integer, parameter :: rid_LIMONO2_HO2_vbs = 868 + integer, parameter :: rid_LIMONO2_NO_vbs = 869 + integer, parameter :: rid_LIMON_O3_vbs = 870 + integer, parameter :: rid_LIMON_OH_vbs = 871 + integer, parameter :: rid_MYRC_NO3_vbs = 872 + integer, parameter :: rid_MYRCO2_HO2_vbs = 873 + integer, parameter :: rid_MYRCO2_NO_vbs = 874 + integer, parameter :: rid_MYRC_O3_vbs = 875 + integer, parameter :: rid_MYRC_OH_vbs = 876 + integer, parameter :: rid_SVOC_OH = 877 + integer, parameter :: rid_TOLUENE_OH_vbs = 878 + integer, parameter :: rid_TOLUO2_HO2_vbs = 879 + integer, parameter :: rid_TOLUO2_NO_vbs = 880 + integer, parameter :: rid_XYLENES_OH_vbs = 881 + integer, parameter :: rid_XYLEO2_HO2_vbs = 882 + integer, parameter :: rid_XYLEO2_NO_vbs = 883 + integer, parameter :: rid_het1 = 884 + integer, parameter :: rid_het10 = 885 + integer, parameter :: rid_het11 = 886 + integer, parameter :: rid_het12 = 887 + integer, parameter :: rid_het13 = 888 + integer, parameter :: rid_het14 = 889 + integer, parameter :: rid_het15 = 890 + integer, parameter :: rid_het16 = 891 + integer, parameter :: rid_het17 = 892 + integer, parameter :: rid_het2 = 893 + integer, parameter :: rid_het3 = 894 + integer, parameter :: rid_het4 = 895 + integer, parameter :: rid_het5 = 896 + integer, parameter :: rid_het6 = 897 + integer, parameter :: rid_het7 = 898 + integer, parameter :: rid_het8 = 899 + integer, parameter :: rid_het9 = 900 + integer, parameter :: rid_E90_tau = 901 + integer, parameter :: rid_NH_50_tau = 902 + integer, parameter :: rid_NH_5_tau = 903 + integer, parameter :: rid_ST80_25_tau = 904 end module m_rxt_id diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/mo_adjrxt.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/mo_adjrxt.F90 index 352ee77ff1..76faad3d2d 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/mo_adjrxt.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/mo_adjrxt.F90 @@ -13,705 +13,704 @@ subroutine adjrxt( rate, inv, m, 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(:,:,170) = rate(:,:,170) * inv(:,:, 3) - rate(:,:,171) = rate(:,:,171) * inv(:,:, 2) - rate(:,:,174) = rate(:,:,174) * inv(:,:, 1) - rate(:,:,191) = rate(:,:,191) * inv(:,:, 1) - rate(:,:,198) = rate(:,:,198) * inv(:,:, 2) - rate(:,:,201) = rate(:,:,201) * inv(:,:, 1) - rate(:,:,209) = rate(:,:,209) * inv(:,:, 1) - rate(:,:,212) = rate(:,:,212) * inv(:,:, 1) - rate(:,:,213) = rate(:,:,213) * inv(:,:, 1) - rate(:,:,214) = rate(:,:,214) * inv(:,:, 1) - rate(:,:,216) = rate(:,:,216) * inv(:,:, 1) - rate(:,:,217) = rate(:,:,217) * inv(:,:, 1) - rate(:,:,232) = rate(:,:,232) * inv(:,:, 1) - rate(:,:,252) = rate(:,:,252) * inv(:,:, 1) - rate(:,:,253) = rate(:,:,253) * inv(:,:, 1) - rate(:,:,263) = rate(:,:,263) * inv(:,:, 1) - rate(:,:,309) = rate(:,:,309) * inv(:,:, 1) - rate(:,:,310) = rate(:,:,310) * inv(:,:, 1) - rate(:,:,321) = rate(:,:,321) * inv(:,:, 1) - rate(:,:,322) = rate(:,:,322) * inv(:,:, 1) - rate(:,:,323) = rate(:,:,323) * inv(:,:, 1) - rate(:,:,345) = rate(:,:,345) * inv(:,:, 2) - rate(:,:,351) = rate(:,:,351) * inv(:,:, 1) - rate(:,:,352) = rate(:,:,352) * inv(:,:, 1) - rate(:,:,353) = rate(:,:,353) * inv(:,:, 1) - rate(:,:,373) = rate(:,:,373) * inv(:,:, 1) - rate(:,:,399) = rate(:,:,399) * inv(:,:, 1) - rate(:,:,407) = rate(:,:,407) * inv(:,:, 1) - rate(:,:,408) = rate(:,:,408) * inv(:,:, 1) - rate(:,:,437) = rate(:,:,437) * inv(:,:, 2) - rate(:,:,438) = rate(:,:,438) * inv(:,:, 2) - rate(:,:,439) = rate(:,:,439) * inv(:,:, 2) - rate(:,:,440) = rate(:,:,440) * inv(:,:, 2) - rate(:,:,441) = rate(:,:,441) * inv(:,:, 2) - rate(:,:,442) = rate(:,:,442) * inv(:,:, 2) - rate(:,:,443) = rate(:,:,443) * inv(:,:, 2) - rate(:,:,444) = rate(:,:,444) * inv(:,:, 2) - rate(:,:,558) = rate(:,:,558) * inv(:,:, 1) - rate(:,:,561) = rate(:,:,561) * inv(:,:, 1) - rate(:,:,564) = rate(:,:,564) * inv(:,:, 1) - rate(:,:,571) = rate(:,:,571) * inv(:,:, 1) - rate(:,:,576) = rate(:,:,576) * inv(:,:, 1) - rate(:,:,685) = rate(:,:,685) * inv(:,:, 1) - rate(:,:,686) = rate(:,:,686) * inv(:,:, 1) - rate(:,:,687) = rate(:,:,687) * inv(:,:, 1) - rate(:,:,791) = rate(:,:,791) * inv(:,:, 1) - rate(:,:,792) = rate(:,:,792) * inv(:,:, 1) - rate(:,:,793) = rate(:,:,793) * inv(:,:, 1) - rate(:,:,798) = rate(:,:,798) * inv(:,:, 2) - rate(:,:,804) = rate(:,:,804) * inv(:,:, 2) - rate(:,:,175) = rate(:,:,175) * inv(:,:, 2) * inv(:,:, 1) - rate(:,:,181) = rate(:,:,181) * inv(:,:, 2) * inv(:,:, 1) - rate(:,:,168) = rate(:,:,168) * m(:,:) - rate(:,:,169) = rate(:,:,169) * m(:,:) - rate(:,:,172) = rate(:,:,172) * m(:,:) - rate(:,:,173) = rate(:,:,173) * m(:,:) - rate(:,:,174) = rate(:,:,174) * 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(:,:,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(:,:,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(:,:,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(:,:,245) = rate(:,:,245) * m(:,:) - rate(:,:,246) = rate(:,:,246) * 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(:,:,252) = rate(:,:,252) * 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(:,:,292) = rate(:,:,292) * 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(:,:,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(:,:,322) = rate(:,:,322) * 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(:,:,329) = rate(:,:,329) * 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(:,:,336) = rate(:,:,336) * m(:,:) - rate(:,:,337) = rate(:,:,337) * m(:,:) - rate(:,:,338) = rate(:,:,338) * m(:,:) - rate(:,:,339) = rate(:,:,339) * m(:,:) - rate(:,:,340) = rate(:,:,340) * m(:,:) - rate(:,:,341) = rate(:,:,341) * m(:,:) - rate(:,:,342) = rate(:,:,342) * m(:,:) - rate(:,:,343) = rate(:,:,343) * m(:,:) - rate(:,:,346) = rate(:,:,346) * m(:,:) - rate(:,:,347) = rate(:,:,347) * m(:,:) - rate(:,:,348) = rate(:,:,348) * m(:,:) - rate(:,:,349) = rate(:,:,349) * m(:,:) - rate(:,:,350) = rate(:,:,350) * m(:,:) - rate(:,:,351) = rate(:,:,351) * m(:,:) - rate(:,:,352) = rate(:,:,352) * m(:,:) - rate(:,:,354) = rate(:,:,354) * m(:,:) - rate(:,:,355) = rate(:,:,355) * m(:,:) - rate(:,:,356) = rate(:,:,356) * m(:,:) - rate(:,:,357) = rate(:,:,357) * m(:,:) - rate(:,:,358) = rate(:,:,358) * m(:,:) - rate(:,:,359) = rate(:,:,359) * m(:,:) - rate(:,:,360) = rate(:,:,360) * m(:,:) - rate(:,:,361) = rate(:,:,361) * m(:,:) - rate(:,:,362) = rate(:,:,362) * m(:,:) - rate(:,:,363) = rate(:,:,363) * m(:,:) - rate(:,:,364) = rate(:,:,364) * m(:,:) - rate(:,:,365) = rate(:,:,365) * m(:,:) - rate(:,:,366) = rate(:,:,366) * m(:,:) - rate(:,:,367) = rate(:,:,367) * m(:,:) - rate(:,:,368) = rate(:,:,368) * m(:,:) - rate(:,:,369) = rate(:,:,369) * m(:,:) - rate(:,:,370) = rate(:,:,370) * m(:,:) - rate(:,:,371) = rate(:,:,371) * m(:,:) - rate(:,:,372) = rate(:,:,372) * m(:,:) - rate(:,:,373) = rate(:,:,373) * m(:,:) - rate(:,:,374) = rate(:,:,374) * m(:,:) - rate(:,:,375) = rate(:,:,375) * m(:,:) - rate(:,:,376) = rate(:,:,376) * m(:,:) - rate(:,:,377) = rate(:,:,377) * m(:,:) - rate(:,:,378) = rate(:,:,378) * m(:,:) - rate(:,:,379) = rate(:,:,379) * m(:,:) - rate(:,:,380) = rate(:,:,380) * m(:,:) - rate(:,:,381) = rate(:,:,381) * m(:,:) - rate(:,:,382) = rate(:,:,382) * m(:,:) - rate(:,:,383) = rate(:,:,383) * m(:,:) - rate(:,:,384) = rate(:,:,384) * m(:,:) - rate(:,:,386) = rate(:,:,386) * m(:,:) - rate(:,:,387) = rate(:,:,387) * m(:,:) - rate(:,:,388) = rate(:,:,388) * m(:,:) - rate(:,:,389) = rate(:,:,389) * m(:,:) - rate(:,:,390) = rate(:,:,390) * m(:,:) - rate(:,:,391) = rate(:,:,391) * m(:,:) - rate(:,:,392) = rate(:,:,392) * m(:,:) - rate(:,:,393) = rate(:,:,393) * m(:,:) - rate(:,:,394) = rate(:,:,394) * m(:,:) - rate(:,:,395) = rate(:,:,395) * m(:,:) - rate(:,:,396) = rate(:,:,396) * m(:,:) - rate(:,:,397) = rate(:,:,397) * m(:,:) - rate(:,:,398) = rate(:,:,398) * m(:,:) - rate(:,:,399) = rate(:,:,399) * m(:,:) - rate(:,:,400) = rate(:,:,400) * m(:,:) - rate(:,:,401) = rate(:,:,401) * m(:,:) - rate(:,:,402) = rate(:,:,402) * m(:,:) - rate(:,:,403) = rate(:,:,403) * m(:,:) - rate(:,:,404) = rate(:,:,404) * m(:,:) - rate(:,:,405) = rate(:,:,405) * m(:,:) - rate(:,:,406) = rate(:,:,406) * m(:,:) - rate(:,:,407) = rate(:,:,407) * m(:,:) - rate(:,:,409) = rate(:,:,409) * m(:,:) - rate(:,:,410) = rate(:,:,410) * m(:,:) - rate(:,:,411) = rate(:,:,411) * m(:,:) - rate(:,:,412) = rate(:,:,412) * m(:,:) - rate(:,:,413) = rate(:,:,413) * m(:,:) - rate(:,:,414) = rate(:,:,414) * m(:,:) - rate(:,:,415) = rate(:,:,415) * m(:,:) - rate(:,:,416) = rate(:,:,416) * m(:,:) - rate(:,:,417) = rate(:,:,417) * m(:,:) - rate(:,:,418) = rate(:,:,418) * m(:,:) - rate(:,:,419) = rate(:,:,419) * m(:,:) - rate(:,:,420) = rate(:,:,420) * m(:,:) - rate(:,:,421) = rate(:,:,421) * m(:,:) - rate(:,:,422) = rate(:,:,422) * m(:,:) - rate(:,:,423) = rate(:,:,423) * m(:,:) - rate(:,:,424) = rate(:,:,424) * m(:,:) - rate(:,:,425) = rate(:,:,425) * m(:,:) - rate(:,:,426) = rate(:,:,426) * m(:,:) - rate(:,:,427) = rate(:,:,427) * m(:,:) - rate(:,:,431) = rate(:,:,431) * m(:,:) - rate(:,:,432) = rate(:,:,432) * m(:,:) - rate(:,:,433) = rate(:,:,433) * m(:,:) - rate(:,:,445) = rate(:,:,445) * m(:,:) - rate(:,:,446) = rate(:,:,446) * m(:,:) - rate(:,:,447) = rate(:,:,447) * m(:,:) - rate(:,:,449) = rate(:,:,449) * m(:,:) - rate(:,:,450) = rate(:,:,450) * m(:,:) - rate(:,:,451) = rate(:,:,451) * m(:,:) - rate(:,:,453) = rate(:,:,453) * m(:,:) - rate(:,:,454) = rate(:,:,454) * m(:,:) - rate(:,:,455) = rate(:,:,455) * m(:,:) - rate(:,:,456) = rate(:,:,456) * m(:,:) - rate(:,:,457) = rate(:,:,457) * m(:,:) - rate(:,:,458) = rate(:,:,458) * m(:,:) - rate(:,:,460) = rate(:,:,460) * m(:,:) - rate(:,:,461) = rate(:,:,461) * m(:,:) - rate(:,:,462) = rate(:,:,462) * m(:,:) - rate(:,:,464) = rate(:,:,464) * m(:,:) - rate(:,:,465) = rate(:,:,465) * m(:,:) - rate(:,:,467) = rate(:,:,467) * m(:,:) - rate(:,:,468) = rate(:,:,468) * m(:,:) - rate(:,:,470) = rate(:,:,470) * m(:,:) - rate(:,:,471) = rate(:,:,471) * m(:,:) - rate(:,:,472) = rate(:,:,472) * m(:,:) - rate(:,:,473) = rate(:,:,473) * m(:,:) - rate(:,:,474) = rate(:,:,474) * m(:,:) - rate(:,:,475) = rate(:,:,475) * m(:,:) - rate(:,:,476) = rate(:,:,476) * m(:,:) - rate(:,:,477) = rate(:,:,477) * m(:,:) - rate(:,:,478) = rate(:,:,478) * m(:,:) - rate(:,:,479) = rate(:,:,479) * m(:,:) - rate(:,:,480) = rate(:,:,480) * m(:,:) - rate(:,:,482) = rate(:,:,482) * m(:,:) - rate(:,:,483) = rate(:,:,483) * m(:,:) - rate(:,:,485) = rate(:,:,485) * m(:,:) - rate(:,:,486) = rate(:,:,486) * m(:,:) - rate(:,:,487) = rate(:,:,487) * m(:,:) - rate(:,:,488) = rate(:,:,488) * m(:,:) - rate(:,:,489) = rate(:,:,489) * m(:,:) - rate(:,:,490) = rate(:,:,490) * m(:,:) - rate(:,:,491) = rate(:,:,491) * m(:,:) - rate(:,:,492) = rate(:,:,492) * m(:,:) - rate(:,:,493) = rate(:,:,493) * m(:,:) - rate(:,:,494) = rate(:,:,494) * m(:,:) - rate(:,:,496) = rate(:,:,496) * m(:,:) - rate(:,:,497) = rate(:,:,497) * m(:,:) - rate(:,:,498) = rate(:,:,498) * m(:,:) - rate(:,:,500) = rate(:,:,500) * m(:,:) - rate(:,:,502) = rate(:,:,502) * m(:,:) - rate(:,:,503) = rate(:,:,503) * m(:,:) - rate(:,:,504) = rate(:,:,504) * m(:,:) - rate(:,:,505) = rate(:,:,505) * m(:,:) - rate(:,:,506) = rate(:,:,506) * m(:,:) - rate(:,:,507) = rate(:,:,507) * m(:,:) - rate(:,:,508) = rate(:,:,508) * m(:,:) - rate(:,:,509) = rate(:,:,509) * m(:,:) - rate(:,:,510) = rate(:,:,510) * m(:,:) - rate(:,:,511) = rate(:,:,511) * m(:,:) - rate(:,:,512) = rate(:,:,512) * m(:,:) - rate(:,:,513) = rate(:,:,513) * m(:,:) - rate(:,:,514) = rate(:,:,514) * m(:,:) - rate(:,:,515) = rate(:,:,515) * m(:,:) - rate(:,:,516) = rate(:,:,516) * m(:,:) - rate(:,:,517) = rate(:,:,517) * m(:,:) - rate(:,:,518) = rate(:,:,518) * m(:,:) - rate(:,:,519) = rate(:,:,519) * m(:,:) - rate(:,:,520) = rate(:,:,520) * m(:,:) - rate(:,:,521) = rate(:,:,521) * m(:,:) - rate(:,:,522) = rate(:,:,522) * m(:,:) - rate(:,:,523) = rate(:,:,523) * m(:,:) - rate(:,:,524) = rate(:,:,524) * m(:,:) - rate(:,:,525) = rate(:,:,525) * m(:,:) - rate(:,:,526) = rate(:,:,526) * m(:,:) - rate(:,:,527) = rate(:,:,527) * m(:,:) - rate(:,:,528) = rate(:,:,528) * m(:,:) - rate(:,:,529) = rate(:,:,529) * m(:,:) - rate(:,:,531) = rate(:,:,531) * m(:,:) - rate(:,:,532) = rate(:,:,532) * m(:,:) - rate(:,:,534) = rate(:,:,534) * m(:,:) - rate(:,:,535) = rate(:,:,535) * m(:,:) - rate(:,:,536) = rate(:,:,536) * m(:,:) - rate(:,:,537) = rate(:,:,537) * m(:,:) - rate(:,:,538) = rate(:,:,538) * m(:,:) - rate(:,:,539) = rate(:,:,539) * m(:,:) - rate(:,:,540) = rate(:,:,540) * m(:,:) - rate(:,:,541) = rate(:,:,541) * m(:,:) - rate(:,:,542) = rate(:,:,542) * m(:,:) - rate(:,:,543) = rate(:,:,543) * m(:,:) - rate(:,:,544) = rate(:,:,544) * m(:,:) - rate(:,:,545) = rate(:,:,545) * m(:,:) - rate(:,:,546) = rate(:,:,546) * m(:,:) - rate(:,:,547) = rate(:,:,547) * m(:,:) - rate(:,:,548) = rate(:,:,548) * m(:,:) - rate(:,:,549) = rate(:,:,549) * m(:,:) - rate(:,:,550) = rate(:,:,550) * m(:,:) - rate(:,:,551) = rate(:,:,551) * m(:,:) - rate(:,:,552) = rate(:,:,552) * m(:,:) - rate(:,:,553) = rate(:,:,553) * m(:,:) - rate(:,:,554) = rate(:,:,554) * m(:,:) - rate(:,:,555) = rate(:,:,555) * m(:,:) - rate(:,:,556) = rate(:,:,556) * m(:,:) - rate(:,:,557) = rate(:,:,557) * m(:,:) - rate(:,:,558) = rate(:,:,558) * m(:,:) - rate(:,:,559) = rate(:,:,559) * m(:,:) - rate(:,:,560) = rate(:,:,560) * m(:,:) - rate(:,:,561) = rate(:,:,561) * m(:,:) - rate(:,:,562) = rate(:,:,562) * m(:,:) - rate(:,:,563) = rate(:,:,563) * m(:,:) - rate(:,:,564) = rate(:,:,564) * m(:,:) - rate(:,:,565) = rate(:,:,565) * m(:,:) - rate(:,:,566) = rate(:,:,566) * m(:,:) - rate(:,:,567) = rate(:,:,567) * m(:,:) - rate(:,:,568) = rate(:,:,568) * m(:,:) - rate(:,:,569) = rate(:,:,569) * m(:,:) - rate(:,:,570) = rate(:,:,570) * m(:,:) - rate(:,:,571) = rate(:,:,571) * m(:,:) - rate(:,:,572) = rate(:,:,572) * m(:,:) - rate(:,:,573) = rate(:,:,573) * m(:,:) - rate(:,:,574) = rate(:,:,574) * m(:,:) - rate(:,:,575) = rate(:,:,575) * m(:,:) - rate(:,:,577) = rate(:,:,577) * m(:,:) - rate(:,:,578) = rate(:,:,578) * m(:,:) - rate(:,:,579) = rate(:,:,579) * m(:,:) - rate(:,:,580) = rate(:,:,580) * m(:,:) - rate(:,:,581) = rate(:,:,581) * m(:,:) - rate(:,:,582) = rate(:,:,582) * m(:,:) - rate(:,:,583) = rate(:,:,583) * m(:,:) - rate(:,:,584) = rate(:,:,584) * m(:,:) - rate(:,:,585) = rate(:,:,585) * m(:,:) - rate(:,:,586) = rate(:,:,586) * m(:,:) - rate(:,:,587) = rate(:,:,587) * m(:,:) - rate(:,:,588) = rate(:,:,588) * m(:,:) - rate(:,:,589) = rate(:,:,589) * m(:,:) - rate(:,:,590) = rate(:,:,590) * m(:,:) - rate(:,:,591) = rate(:,:,591) * m(:,:) - rate(:,:,592) = rate(:,:,592) * m(:,:) - rate(:,:,593) = rate(:,:,593) * m(:,:) - rate(:,:,594) = rate(:,:,594) * m(:,:) - rate(:,:,595) = rate(:,:,595) * m(:,:) - rate(:,:,596) = rate(:,:,596) * m(:,:) - rate(:,:,597) = rate(:,:,597) * m(:,:) - rate(:,:,598) = rate(:,:,598) * m(:,:) - rate(:,:,599) = rate(:,:,599) * m(:,:) - rate(:,:,600) = rate(:,:,600) * m(:,:) - rate(:,:,601) = rate(:,:,601) * m(:,:) - rate(:,:,602) = rate(:,:,602) * m(:,:) - rate(:,:,603) = rate(:,:,603) * m(:,:) - rate(:,:,604) = rate(:,:,604) * m(:,:) - rate(:,:,605) = rate(:,:,605) * m(:,:) - rate(:,:,606) = rate(:,:,606) * m(:,:) - rate(:,:,607) = rate(:,:,607) * m(:,:) - rate(:,:,608) = rate(:,:,608) * m(:,:) - rate(:,:,609) = rate(:,:,609) * m(:,:) - rate(:,:,610) = rate(:,:,610) * m(:,:) - rate(:,:,611) = rate(:,:,611) * m(:,:) - rate(:,:,612) = rate(:,:,612) * m(:,:) - rate(:,:,613) = rate(:,:,613) * m(:,:) - rate(:,:,614) = rate(:,:,614) * m(:,:) - rate(:,:,615) = rate(:,:,615) * m(:,:) - rate(:,:,616) = rate(:,:,616) * m(:,:) - rate(:,:,617) = rate(:,:,617) * m(:,:) - rate(:,:,618) = rate(:,:,618) * m(:,:) - rate(:,:,619) = rate(:,:,619) * m(:,:) - rate(:,:,620) = rate(:,:,620) * m(:,:) - rate(:,:,621) = rate(:,:,621) * m(:,:) - rate(:,:,622) = rate(:,:,622) * m(:,:) - rate(:,:,623) = rate(:,:,623) * m(:,:) - rate(:,:,624) = rate(:,:,624) * m(:,:) - rate(:,:,625) = rate(:,:,625) * m(:,:) - rate(:,:,626) = rate(:,:,626) * m(:,:) - rate(:,:,627) = rate(:,:,627) * m(:,:) - rate(:,:,628) = rate(:,:,628) * m(:,:) - rate(:,:,629) = rate(:,:,629) * m(:,:) - rate(:,:,630) = rate(:,:,630) * m(:,:) - rate(:,:,631) = rate(:,:,631) * m(:,:) - rate(:,:,632) = rate(:,:,632) * m(:,:) - rate(:,:,633) = rate(:,:,633) * m(:,:) - rate(:,:,634) = rate(:,:,634) * m(:,:) - rate(:,:,635) = rate(:,:,635) * m(:,:) - rate(:,:,636) = rate(:,:,636) * m(:,:) - rate(:,:,637) = rate(:,:,637) * m(:,:) - rate(:,:,638) = rate(:,:,638) * m(:,:) - rate(:,:,639) = rate(:,:,639) * m(:,:) - rate(:,:,640) = rate(:,:,640) * m(:,:) - rate(:,:,641) = rate(:,:,641) * m(:,:) - rate(:,:,642) = rate(:,:,642) * m(:,:) - rate(:,:,643) = rate(:,:,643) * m(:,:) - rate(:,:,644) = rate(:,:,644) * m(:,:) - rate(:,:,645) = rate(:,:,645) * m(:,:) - rate(:,:,646) = rate(:,:,646) * m(:,:) - rate(:,:,647) = rate(:,:,647) * m(:,:) - rate(:,:,648) = rate(:,:,648) * m(:,:) - rate(:,:,649) = rate(:,:,649) * m(:,:) - rate(:,:,650) = rate(:,:,650) * m(:,:) - rate(:,:,651) = rate(:,:,651) * m(:,:) - rate(:,:,652) = rate(:,:,652) * m(:,:) - rate(:,:,653) = rate(:,:,653) * m(:,:) - rate(:,:,654) = rate(:,:,654) * m(:,:) - rate(:,:,655) = rate(:,:,655) * m(:,:) - rate(:,:,656) = rate(:,:,656) * m(:,:) - rate(:,:,657) = rate(:,:,657) * m(:,:) - rate(:,:,658) = rate(:,:,658) * m(:,:) - rate(:,:,659) = rate(:,:,659) * m(:,:) - rate(:,:,660) = rate(:,:,660) * m(:,:) - rate(:,:,661) = rate(:,:,661) * m(:,:) - rate(:,:,662) = rate(:,:,662) * m(:,:) - rate(:,:,663) = rate(:,:,663) * m(:,:) - rate(:,:,664) = rate(:,:,664) * m(:,:) - rate(:,:,665) = rate(:,:,665) * m(:,:) - rate(:,:,666) = rate(:,:,666) * m(:,:) - rate(:,:,667) = rate(:,:,667) * m(:,:) - rate(:,:,668) = rate(:,:,668) * m(:,:) - rate(:,:,669) = rate(:,:,669) * m(:,:) - rate(:,:,670) = rate(:,:,670) * m(:,:) - rate(:,:,671) = rate(:,:,671) * m(:,:) - rate(:,:,672) = rate(:,:,672) * m(:,:) - rate(:,:,673) = rate(:,:,673) * m(:,:) - rate(:,:,674) = rate(:,:,674) * m(:,:) - rate(:,:,675) = rate(:,:,675) * m(:,:) - rate(:,:,676) = rate(:,:,676) * m(:,:) - rate(:,:,677) = rate(:,:,677) * m(:,:) - rate(:,:,678) = rate(:,:,678) * m(:,:) - rate(:,:,679) = rate(:,:,679) * m(:,:) - rate(:,:,680) = rate(:,:,680) * m(:,:) - rate(:,:,681) = rate(:,:,681) * m(:,:) - rate(:,:,682) = rate(:,:,682) * m(:,:) - rate(:,:,683) = rate(:,:,683) * m(:,:) - rate(:,:,684) = rate(:,:,684) * m(:,:) - rate(:,:,685) = rate(:,:,685) * m(:,:) - rate(:,:,686) = rate(:,:,686) * m(:,:) - rate(:,:,687) = rate(:,:,687) * m(:,:) - rate(:,:,688) = rate(:,:,688) * m(:,:) - rate(:,:,689) = rate(:,:,689) * m(:,:) - rate(:,:,690) = rate(:,:,690) * m(:,:) - rate(:,:,691) = rate(:,:,691) * m(:,:) - rate(:,:,692) = rate(:,:,692) * m(:,:) - rate(:,:,693) = rate(:,:,693) * m(:,:) - rate(:,:,694) = rate(:,:,694) * m(:,:) - rate(:,:,695) = rate(:,:,695) * m(:,:) - rate(:,:,696) = rate(:,:,696) * m(:,:) - rate(:,:,697) = rate(:,:,697) * m(:,:) - rate(:,:,698) = rate(:,:,698) * m(:,:) - rate(:,:,699) = rate(:,:,699) * m(:,:) - rate(:,:,700) = rate(:,:,700) * m(:,:) - rate(:,:,701) = rate(:,:,701) * m(:,:) - rate(:,:,702) = rate(:,:,702) * m(:,:) - rate(:,:,703) = rate(:,:,703) * m(:,:) - rate(:,:,704) = rate(:,:,704) * m(:,:) - rate(:,:,705) = rate(:,:,705) * m(:,:) - rate(:,:,706) = rate(:,:,706) * m(:,:) - rate(:,:,707) = rate(:,:,707) * m(:,:) - rate(:,:,708) = rate(:,:,708) * m(:,:) - rate(:,:,709) = rate(:,:,709) * m(:,:) - rate(:,:,710) = rate(:,:,710) * m(:,:) - rate(:,:,711) = rate(:,:,711) * m(:,:) - rate(:,:,712) = rate(:,:,712) * m(:,:) - rate(:,:,713) = rate(:,:,713) * m(:,:) - rate(:,:,714) = rate(:,:,714) * m(:,:) - rate(:,:,715) = rate(:,:,715) * m(:,:) - rate(:,:,716) = rate(:,:,716) * m(:,:) - rate(:,:,717) = rate(:,:,717) * m(:,:) - rate(:,:,718) = rate(:,:,718) * m(:,:) - rate(:,:,719) = rate(:,:,719) * m(:,:) - rate(:,:,720) = rate(:,:,720) * m(:,:) - rate(:,:,721) = rate(:,:,721) * m(:,:) - rate(:,:,722) = rate(:,:,722) * m(:,:) - rate(:,:,723) = rate(:,:,723) * m(:,:) - rate(:,:,724) = rate(:,:,724) * m(:,:) - rate(:,:,725) = rate(:,:,725) * m(:,:) - rate(:,:,726) = rate(:,:,726) * m(:,:) - rate(:,:,727) = rate(:,:,727) * m(:,:) - rate(:,:,728) = rate(:,:,728) * m(:,:) - rate(:,:,729) = rate(:,:,729) * m(:,:) - rate(:,:,730) = rate(:,:,730) * m(:,:) - rate(:,:,731) = rate(:,:,731) * m(:,:) - rate(:,:,732) = rate(:,:,732) * m(:,:) - rate(:,:,733) = rate(:,:,733) * m(:,:) - rate(:,:,734) = rate(:,:,734) * m(:,:) - rate(:,:,735) = rate(:,:,735) * m(:,:) - rate(:,:,736) = rate(:,:,736) * m(:,:) - rate(:,:,737) = rate(:,:,737) * m(:,:) - rate(:,:,738) = rate(:,:,738) * m(:,:) - rate(:,:,739) = rate(:,:,739) * m(:,:) - rate(:,:,740) = rate(:,:,740) * m(:,:) - rate(:,:,741) = rate(:,:,741) * m(:,:) - rate(:,:,742) = rate(:,:,742) * m(:,:) - rate(:,:,743) = rate(:,:,743) * m(:,:) - rate(:,:,744) = rate(:,:,744) * m(:,:) - rate(:,:,745) = rate(:,:,745) * m(:,:) - rate(:,:,746) = rate(:,:,746) * m(:,:) - rate(:,:,747) = rate(:,:,747) * m(:,:) - rate(:,:,748) = rate(:,:,748) * m(:,:) - rate(:,:,749) = rate(:,:,749) * m(:,:) - rate(:,:,750) = rate(:,:,750) * m(:,:) - rate(:,:,751) = rate(:,:,751) * m(:,:) - rate(:,:,752) = rate(:,:,752) * m(:,:) - rate(:,:,753) = rate(:,:,753) * m(:,:) - rate(:,:,754) = rate(:,:,754) * m(:,:) - rate(:,:,755) = rate(:,:,755) * m(:,:) - rate(:,:,756) = rate(:,:,756) * m(:,:) - rate(:,:,757) = rate(:,:,757) * m(:,:) - rate(:,:,758) = rate(:,:,758) * m(:,:) - rate(:,:,759) = rate(:,:,759) * m(:,:) - rate(:,:,760) = rate(:,:,760) * m(:,:) - rate(:,:,761) = rate(:,:,761) * m(:,:) - rate(:,:,762) = rate(:,:,762) * m(:,:) - rate(:,:,763) = rate(:,:,763) * m(:,:) - rate(:,:,764) = rate(:,:,764) * m(:,:) - rate(:,:,765) = rate(:,:,765) * m(:,:) - rate(:,:,766) = rate(:,:,766) * m(:,:) - rate(:,:,767) = rate(:,:,767) * m(:,:) - rate(:,:,768) = rate(:,:,768) * m(:,:) - rate(:,:,769) = rate(:,:,769) * m(:,:) - rate(:,:,770) = rate(:,:,770) * m(:,:) - rate(:,:,771) = rate(:,:,771) * m(:,:) - rate(:,:,772) = rate(:,:,772) * m(:,:) - rate(:,:,773) = rate(:,:,773) * m(:,:) - rate(:,:,774) = rate(:,:,774) * m(:,:) - rate(:,:,775) = rate(:,:,775) * m(:,:) - rate(:,:,776) = rate(:,:,776) * m(:,:) - rate(:,:,777) = rate(:,:,777) * m(:,:) - rate(:,:,778) = rate(:,:,778) * m(:,:) - rate(:,:,779) = rate(:,:,779) * m(:,:) - rate(:,:,780) = rate(:,:,780) * m(:,:) - rate(:,:,781) = rate(:,:,781) * m(:,:) - rate(:,:,782) = rate(:,:,782) * m(:,:) - rate(:,:,783) = rate(:,:,783) * m(:,:) - rate(:,:,784) = rate(:,:,784) * m(:,:) - rate(:,:,785) = rate(:,:,785) * m(:,:) - rate(:,:,786) = rate(:,:,786) * m(:,:) - rate(:,:,787) = rate(:,:,787) * m(:,:) - rate(:,:,788) = rate(:,:,788) * m(:,:) - rate(:,:,789) = rate(:,:,789) * m(:,:) - rate(:,:,790) = rate(:,:,790) * m(:,:) - rate(:,:,794) = rate(:,:,794) * m(:,:) - rate(:,:,795) = rate(:,:,795) * m(:,:) - rate(:,:,796) = rate(:,:,796) * m(:,:) - rate(:,:,797) = rate(:,:,797) * m(:,:) - rate(:,:,799) = rate(:,:,799) * m(:,:) - rate(:,:,800) = rate(:,:,800) * m(:,:) - rate(:,:,801) = rate(:,:,801) * m(:,:) - rate(:,:,802) = rate(:,:,802) * m(:,:) - rate(:,:,803) = rate(:,:,803) * m(:,:) - rate(:,:,805) = rate(:,:,805) * m(:,:) - rate(:,:,806) = rate(:,:,806) * m(:,:) - rate(:,:,807) = rate(:,:,807) * m(:,:) - rate(:,:,808) = rate(:,:,808) * m(:,:) - rate(:,:,809) = rate(:,:,809) * m(:,:) - rate(:,:,810) = rate(:,:,810) * m(:,:) - rate(:,:,811) = rate(:,:,811) * m(:,:) - rate(:,:,842) = rate(:,:,842) * m(:,:) - rate(:,:,843) = rate(:,:,843) * m(:,:) - rate(:,:,844) = rate(:,:,844) * m(:,:) - rate(:,:,845) = rate(:,:,845) * m(:,:) - rate(:,:,846) = rate(:,:,846) * m(:,:) - rate(:,:,847) = rate(:,:,847) * m(:,:) - rate(:,:,848) = rate(:,:,848) * m(:,:) - rate(:,:,849) = rate(:,:,849) * m(:,:) - rate(:,:,850) = rate(:,:,850) * m(:,:) - rate(:,:,851) = rate(:,:,851) * m(:,:) - rate(:,:,852) = rate(:,:,852) * m(:,:) - rate(:,:,853) = rate(:,:,853) * m(:,:) - rate(:,:,854) = rate(:,:,854) * m(:,:) - rate(:,:,855) = rate(:,:,855) * m(:,:) - rate(:,:,856) = rate(:,:,856) * m(:,:) - rate(:,:,857) = rate(:,:,857) * m(:,:) - rate(:,:,858) = rate(:,:,858) * m(:,:) - rate(:,:,859) = rate(:,:,859) * m(:,:) - rate(:,:,860) = rate(:,:,860) * m(:,:) - rate(:,:,861) = rate(:,:,861) * m(:,:) - rate(:,:,862) = rate(:,:,862) * m(:,:) - rate(:,:,863) = rate(:,:,863) * m(:,:) - rate(:,:,864) = rate(:,:,864) * m(:,:) - rate(:,:,865) = rate(:,:,865) * m(:,:) - rate(:,:,866) = rate(:,:,866) * m(:,:) - rate(:,:,867) = rate(:,:,867) * m(:,:) - rate(:,:,868) = rate(:,:,868) * m(:,:) - rate(:,:,869) = rate(:,:,869) * m(:,:) - rate(:,:,870) = rate(:,:,870) * m(:,:) - rate(:,:,871) = rate(:,:,871) * m(:,:) - rate(:,:,872) = rate(:,:,872) * m(:,:) - rate(:,:,873) = rate(:,:,873) * m(:,:) - rate(:,:,874) = rate(:,:,874) * m(:,:) - rate(:,:,875) = rate(:,:,875) * m(:,:) - rate(:,:,876) = rate(:,:,876) * m(:,:) - rate(:,:,877) = rate(:,:,877) * m(:,:) - rate(:,:,878) = rate(:,:,878) * m(:,:) - rate(:,:,879) = rate(:,:,879) * m(:,:) - rate(:,:,880) = rate(:,:,880) * m(:,:) - rate(:,:,881) = rate(:,:,881) * m(:,:) - rate(:,:,882) = rate(:,:,882) * m(:,:) - rate(:,:,883) = rate(:,:,883) * m(:,:) - rate(:,:,884) = rate(:,:,884) * m(:,:) - rate(:,:,886) = rate(:,:,886) * m(:,:) - rate(:,:,891) = rate(:,:,891) * m(:,:) - rate(:,:,892) = rate(:,:,892) * m(:,:) - rate(:,:,893) = rate(:,:,893) * m(:,:) - rate(:,:,896) = rate(:,:,896) * m(:,:) - rate(:,:,897) = rate(:,:,897) * m(:,:) - rate(:,:,898) = rate(:,:,898) * m(:,:) - rate(:,:,901) = rate(:,:,901) * m(:,:) + rate(:,:, 170) = rate(:,:, 170) * inv(:,:, 3) + rate(:,:, 171) = rate(:,:, 171) * inv(:,:, 2) + rate(:,:, 174) = rate(:,:, 174) * inv(:,:, 1) + rate(:,:, 191) = rate(:,:, 191) * inv(:,:, 1) + rate(:,:, 198) = rate(:,:, 198) * inv(:,:, 2) + rate(:,:, 201) = rate(:,:, 201) * inv(:,:, 1) + rate(:,:, 209) = rate(:,:, 209) * inv(:,:, 1) + rate(:,:, 212) = rate(:,:, 212) * inv(:,:, 1) + rate(:,:, 213) = rate(:,:, 213) * inv(:,:, 1) + rate(:,:, 214) = rate(:,:, 214) * inv(:,:, 1) + rate(:,:, 216) = rate(:,:, 216) * inv(:,:, 1) + rate(:,:, 217) = rate(:,:, 217) * inv(:,:, 1) + rate(:,:, 232) = rate(:,:, 232) * inv(:,:, 1) + rate(:,:, 252) = rate(:,:, 252) * inv(:,:, 1) + rate(:,:, 253) = rate(:,:, 253) * inv(:,:, 1) + rate(:,:, 263) = rate(:,:, 263) * inv(:,:, 1) + rate(:,:, 309) = rate(:,:, 309) * inv(:,:, 1) + rate(:,:, 320) = rate(:,:, 320) * inv(:,:, 1) + rate(:,:, 321) = rate(:,:, 321) * inv(:,:, 1) + rate(:,:, 322) = rate(:,:, 322) * inv(:,:, 1) + rate(:,:, 344) = rate(:,:, 344) * inv(:,:, 2) + rate(:,:, 350) = rate(:,:, 350) * inv(:,:, 1) + rate(:,:, 351) = rate(:,:, 351) * inv(:,:, 1) + rate(:,:, 352) = rate(:,:, 352) * inv(:,:, 1) + rate(:,:, 372) = rate(:,:, 372) * inv(:,:, 1) + rate(:,:, 398) = rate(:,:, 398) * inv(:,:, 1) + rate(:,:, 406) = rate(:,:, 406) * inv(:,:, 1) + rate(:,:, 407) = rate(:,:, 407) * inv(:,:, 1) + rate(:,:, 436) = rate(:,:, 436) * inv(:,:, 2) + rate(:,:, 437) = rate(:,:, 437) * inv(:,:, 2) + rate(:,:, 438) = rate(:,:, 438) * inv(:,:, 2) + rate(:,:, 439) = rate(:,:, 439) * inv(:,:, 2) + rate(:,:, 440) = rate(:,:, 440) * inv(:,:, 2) + rate(:,:, 441) = rate(:,:, 441) * inv(:,:, 2) + rate(:,:, 442) = rate(:,:, 442) * inv(:,:, 2) + rate(:,:, 443) = rate(:,:, 443) * inv(:,:, 2) + rate(:,:, 557) = rate(:,:, 557) * inv(:,:, 1) + rate(:,:, 560) = rate(:,:, 560) * inv(:,:, 1) + rate(:,:, 563) = rate(:,:, 563) * inv(:,:, 1) + rate(:,:, 570) = rate(:,:, 570) * inv(:,:, 1) + rate(:,:, 575) = rate(:,:, 575) * inv(:,:, 1) + rate(:,:, 684) = rate(:,:, 684) * inv(:,:, 1) + rate(:,:, 685) = rate(:,:, 685) * inv(:,:, 1) + rate(:,:, 686) = rate(:,:, 686) * inv(:,:, 1) + rate(:,:, 790) = rate(:,:, 790) * inv(:,:, 1) + rate(:,:, 791) = rate(:,:, 791) * inv(:,:, 1) + rate(:,:, 792) = rate(:,:, 792) * inv(:,:, 1) + rate(:,:, 797) = rate(:,:, 797) * inv(:,:, 2) + rate(:,:, 798) = rate(:,:, 798) * inv(:,:, 1) + rate(:,:, 804) = rate(:,:, 804) * inv(:,:, 2) + rate(:,:, 175) = rate(:,:, 175) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 181) = rate(:,:, 181) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 168) = rate(:,:, 168) * m(:,:) + rate(:,:, 169) = rate(:,:, 169) * m(:,:) + rate(:,:, 172) = rate(:,:, 172) * m(:,:) + rate(:,:, 173) = rate(:,:, 173) * m(:,:) + rate(:,:, 174) = rate(:,:, 174) * 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(:,:, 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(:,:, 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(:,:, 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * 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(:,:, 252) = rate(:,:, 252) * 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(:,:, 292) = rate(:,:, 292) * 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(:,:, 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(:,:, 322) = rate(:,:, 322) * 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(:,:, 329) = rate(:,:, 329) * 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(:,:, 336) = rate(:,:, 336) * m(:,:) + rate(:,:, 337) = rate(:,:, 337) * m(:,:) + rate(:,:, 338) = rate(:,:, 338) * m(:,:) + rate(:,:, 339) = rate(:,:, 339) * m(:,:) + rate(:,:, 340) = rate(:,:, 340) * m(:,:) + rate(:,:, 341) = rate(:,:, 341) * m(:,:) + rate(:,:, 342) = rate(:,:, 342) * m(:,:) + rate(:,:, 345) = rate(:,:, 345) * m(:,:) + rate(:,:, 346) = rate(:,:, 346) * m(:,:) + rate(:,:, 347) = rate(:,:, 347) * m(:,:) + rate(:,:, 348) = rate(:,:, 348) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 353) = rate(:,:, 353) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 357) = rate(:,:, 357) * m(:,:) + rate(:,:, 358) = rate(:,:, 358) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + rate(:,:, 360) = rate(:,:, 360) * m(:,:) + rate(:,:, 361) = rate(:,:, 361) * m(:,:) + rate(:,:, 362) = rate(:,:, 362) * m(:,:) + rate(:,:, 363) = rate(:,:, 363) * m(:,:) + rate(:,:, 364) = rate(:,:, 364) * m(:,:) + rate(:,:, 365) = rate(:,:, 365) * m(:,:) + rate(:,:, 366) = rate(:,:, 366) * m(:,:) + rate(:,:, 367) = rate(:,:, 367) * m(:,:) + rate(:,:, 368) = rate(:,:, 368) * m(:,:) + rate(:,:, 369) = rate(:,:, 369) * m(:,:) + rate(:,:, 370) = rate(:,:, 370) * m(:,:) + rate(:,:, 371) = rate(:,:, 371) * m(:,:) + rate(:,:, 372) = rate(:,:, 372) * m(:,:) + rate(:,:, 373) = rate(:,:, 373) * m(:,:) + rate(:,:, 374) = rate(:,:, 374) * m(:,:) + rate(:,:, 375) = rate(:,:, 375) * m(:,:) + rate(:,:, 376) = rate(:,:, 376) * m(:,:) + rate(:,:, 377) = rate(:,:, 377) * m(:,:) + rate(:,:, 378) = rate(:,:, 378) * m(:,:) + rate(:,:, 379) = rate(:,:, 379) * m(:,:) + rate(:,:, 380) = rate(:,:, 380) * m(:,:) + rate(:,:, 381) = rate(:,:, 381) * m(:,:) + rate(:,:, 382) = rate(:,:, 382) * m(:,:) + rate(:,:, 383) = rate(:,:, 383) * m(:,:) + rate(:,:, 385) = rate(:,:, 385) * m(:,:) + rate(:,:, 386) = rate(:,:, 386) * m(:,:) + rate(:,:, 387) = rate(:,:, 387) * m(:,:) + rate(:,:, 388) = rate(:,:, 388) * m(:,:) + rate(:,:, 389) = rate(:,:, 389) * m(:,:) + rate(:,:, 390) = rate(:,:, 390) * m(:,:) + rate(:,:, 391) = rate(:,:, 391) * m(:,:) + rate(:,:, 392) = rate(:,:, 392) * m(:,:) + rate(:,:, 393) = rate(:,:, 393) * m(:,:) + rate(:,:, 394) = rate(:,:, 394) * m(:,:) + rate(:,:, 395) = rate(:,:, 395) * m(:,:) + rate(:,:, 396) = rate(:,:, 396) * m(:,:) + rate(:,:, 397) = rate(:,:, 397) * m(:,:) + rate(:,:, 398) = rate(:,:, 398) * m(:,:) + rate(:,:, 399) = rate(:,:, 399) * m(:,:) + rate(:,:, 400) = rate(:,:, 400) * m(:,:) + rate(:,:, 401) = rate(:,:, 401) * m(:,:) + rate(:,:, 402) = rate(:,:, 402) * m(:,:) + rate(:,:, 403) = rate(:,:, 403) * m(:,:) + rate(:,:, 404) = rate(:,:, 404) * m(:,:) + rate(:,:, 405) = rate(:,:, 405) * m(:,:) + rate(:,:, 406) = rate(:,:, 406) * m(:,:) + rate(:,:, 408) = rate(:,:, 408) * m(:,:) + rate(:,:, 409) = rate(:,:, 409) * m(:,:) + rate(:,:, 410) = rate(:,:, 410) * m(:,:) + rate(:,:, 411) = rate(:,:, 411) * m(:,:) + rate(:,:, 412) = rate(:,:, 412) * m(:,:) + rate(:,:, 413) = rate(:,:, 413) * m(:,:) + rate(:,:, 414) = rate(:,:, 414) * m(:,:) + rate(:,:, 415) = rate(:,:, 415) * m(:,:) + rate(:,:, 416) = rate(:,:, 416) * m(:,:) + rate(:,:, 417) = rate(:,:, 417) * m(:,:) + rate(:,:, 418) = rate(:,:, 418) * m(:,:) + rate(:,:, 419) = rate(:,:, 419) * m(:,:) + rate(:,:, 420) = rate(:,:, 420) * m(:,:) + rate(:,:, 421) = rate(:,:, 421) * m(:,:) + rate(:,:, 422) = rate(:,:, 422) * m(:,:) + rate(:,:, 423) = rate(:,:, 423) * m(:,:) + rate(:,:, 424) = rate(:,:, 424) * m(:,:) + rate(:,:, 425) = rate(:,:, 425) * m(:,:) + rate(:,:, 426) = rate(:,:, 426) * m(:,:) + rate(:,:, 430) = rate(:,:, 430) * m(:,:) + rate(:,:, 431) = rate(:,:, 431) * m(:,:) + rate(:,:, 432) = rate(:,:, 432) * m(:,:) + rate(:,:, 444) = rate(:,:, 444) * m(:,:) + rate(:,:, 445) = rate(:,:, 445) * m(:,:) + rate(:,:, 446) = rate(:,:, 446) * m(:,:) + rate(:,:, 448) = rate(:,:, 448) * m(:,:) + rate(:,:, 449) = rate(:,:, 449) * m(:,:) + rate(:,:, 450) = rate(:,:, 450) * m(:,:) + rate(:,:, 452) = rate(:,:, 452) * m(:,:) + rate(:,:, 453) = rate(:,:, 453) * m(:,:) + rate(:,:, 454) = rate(:,:, 454) * m(:,:) + rate(:,:, 455) = rate(:,:, 455) * m(:,:) + rate(:,:, 456) = rate(:,:, 456) * m(:,:) + rate(:,:, 457) = rate(:,:, 457) * m(:,:) + rate(:,:, 459) = rate(:,:, 459) * m(:,:) + rate(:,:, 460) = rate(:,:, 460) * m(:,:) + rate(:,:, 461) = rate(:,:, 461) * m(:,:) + rate(:,:, 463) = rate(:,:, 463) * m(:,:) + rate(:,:, 464) = rate(:,:, 464) * m(:,:) + rate(:,:, 466) = rate(:,:, 466) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * m(:,:) + rate(:,:, 469) = rate(:,:, 469) * m(:,:) + rate(:,:, 470) = rate(:,:, 470) * m(:,:) + rate(:,:, 471) = rate(:,:, 471) * m(:,:) + rate(:,:, 472) = rate(:,:, 472) * m(:,:) + rate(:,:, 473) = rate(:,:, 473) * m(:,:) + rate(:,:, 474) = rate(:,:, 474) * m(:,:) + rate(:,:, 475) = rate(:,:, 475) * m(:,:) + rate(:,:, 476) = rate(:,:, 476) * m(:,:) + rate(:,:, 477) = rate(:,:, 477) * m(:,:) + rate(:,:, 478) = rate(:,:, 478) * m(:,:) + rate(:,:, 479) = rate(:,:, 479) * m(:,:) + rate(:,:, 481) = rate(:,:, 481) * m(:,:) + rate(:,:, 482) = rate(:,:, 482) * m(:,:) + rate(:,:, 484) = rate(:,:, 484) * m(:,:) + rate(:,:, 485) = rate(:,:, 485) * m(:,:) + rate(:,:, 486) = rate(:,:, 486) * m(:,:) + rate(:,:, 487) = rate(:,:, 487) * m(:,:) + rate(:,:, 488) = rate(:,:, 488) * m(:,:) + rate(:,:, 489) = rate(:,:, 489) * m(:,:) + rate(:,:, 490) = rate(:,:, 490) * m(:,:) + rate(:,:, 491) = rate(:,:, 491) * m(:,:) + rate(:,:, 492) = rate(:,:, 492) * m(:,:) + rate(:,:, 493) = rate(:,:, 493) * m(:,:) + rate(:,:, 495) = rate(:,:, 495) * m(:,:) + rate(:,:, 496) = rate(:,:, 496) * m(:,:) + rate(:,:, 497) = rate(:,:, 497) * m(:,:) + rate(:,:, 499) = rate(:,:, 499) * m(:,:) + rate(:,:, 501) = rate(:,:, 501) * m(:,:) + rate(:,:, 502) = rate(:,:, 502) * m(:,:) + rate(:,:, 503) = rate(:,:, 503) * m(:,:) + rate(:,:, 504) = rate(:,:, 504) * m(:,:) + rate(:,:, 505) = rate(:,:, 505) * m(:,:) + rate(:,:, 506) = rate(:,:, 506) * m(:,:) + rate(:,:, 507) = rate(:,:, 507) * m(:,:) + rate(:,:, 508) = rate(:,:, 508) * m(:,:) + rate(:,:, 509) = rate(:,:, 509) * m(:,:) + rate(:,:, 510) = rate(:,:, 510) * m(:,:) + rate(:,:, 511) = rate(:,:, 511) * m(:,:) + rate(:,:, 512) = rate(:,:, 512) * m(:,:) + rate(:,:, 513) = rate(:,:, 513) * m(:,:) + rate(:,:, 514) = rate(:,:, 514) * m(:,:) + rate(:,:, 515) = rate(:,:, 515) * m(:,:) + rate(:,:, 516) = rate(:,:, 516) * m(:,:) + rate(:,:, 517) = rate(:,:, 517) * m(:,:) + rate(:,:, 518) = rate(:,:, 518) * m(:,:) + rate(:,:, 519) = rate(:,:, 519) * m(:,:) + rate(:,:, 520) = rate(:,:, 520) * m(:,:) + rate(:,:, 521) = rate(:,:, 521) * m(:,:) + rate(:,:, 522) = rate(:,:, 522) * m(:,:) + rate(:,:, 523) = rate(:,:, 523) * m(:,:) + rate(:,:, 524) = rate(:,:, 524) * m(:,:) + rate(:,:, 525) = rate(:,:, 525) * m(:,:) + rate(:,:, 526) = rate(:,:, 526) * m(:,:) + rate(:,:, 527) = rate(:,:, 527) * m(:,:) + rate(:,:, 528) = rate(:,:, 528) * m(:,:) + rate(:,:, 530) = rate(:,:, 530) * m(:,:) + rate(:,:, 531) = rate(:,:, 531) * m(:,:) + rate(:,:, 533) = rate(:,:, 533) * m(:,:) + rate(:,:, 534) = rate(:,:, 534) * m(:,:) + rate(:,:, 535) = rate(:,:, 535) * m(:,:) + rate(:,:, 536) = rate(:,:, 536) * m(:,:) + rate(:,:, 537) = rate(:,:, 537) * m(:,:) + rate(:,:, 538) = rate(:,:, 538) * m(:,:) + rate(:,:, 539) = rate(:,:, 539) * m(:,:) + rate(:,:, 540) = rate(:,:, 540) * m(:,:) + rate(:,:, 541) = rate(:,:, 541) * m(:,:) + rate(:,:, 542) = rate(:,:, 542) * m(:,:) + rate(:,:, 543) = rate(:,:, 543) * m(:,:) + rate(:,:, 544) = rate(:,:, 544) * m(:,:) + rate(:,:, 545) = rate(:,:, 545) * m(:,:) + rate(:,:, 546) = rate(:,:, 546) * m(:,:) + rate(:,:, 547) = rate(:,:, 547) * m(:,:) + rate(:,:, 548) = rate(:,:, 548) * m(:,:) + rate(:,:, 549) = rate(:,:, 549) * m(:,:) + rate(:,:, 550) = rate(:,:, 550) * m(:,:) + rate(:,:, 551) = rate(:,:, 551) * m(:,:) + rate(:,:, 552) = rate(:,:, 552) * m(:,:) + rate(:,:, 553) = rate(:,:, 553) * m(:,:) + rate(:,:, 554) = rate(:,:, 554) * m(:,:) + rate(:,:, 555) = rate(:,:, 555) * m(:,:) + rate(:,:, 556) = rate(:,:, 556) * m(:,:) + rate(:,:, 557) = rate(:,:, 557) * m(:,:) + rate(:,:, 558) = rate(:,:, 558) * m(:,:) + rate(:,:, 559) = rate(:,:, 559) * m(:,:) + rate(:,:, 560) = rate(:,:, 560) * m(:,:) + rate(:,:, 561) = rate(:,:, 561) * m(:,:) + rate(:,:, 562) = rate(:,:, 562) * m(:,:) + rate(:,:, 563) = rate(:,:, 563) * m(:,:) + rate(:,:, 564) = rate(:,:, 564) * m(:,:) + rate(:,:, 565) = rate(:,:, 565) * m(:,:) + rate(:,:, 566) = rate(:,:, 566) * m(:,:) + rate(:,:, 567) = rate(:,:, 567) * m(:,:) + rate(:,:, 568) = rate(:,:, 568) * m(:,:) + rate(:,:, 569) = rate(:,:, 569) * m(:,:) + rate(:,:, 570) = rate(:,:, 570) * m(:,:) + rate(:,:, 571) = rate(:,:, 571) * m(:,:) + rate(:,:, 572) = rate(:,:, 572) * m(:,:) + rate(:,:, 573) = rate(:,:, 573) * m(:,:) + rate(:,:, 574) = rate(:,:, 574) * m(:,:) + rate(:,:, 576) = rate(:,:, 576) * m(:,:) + rate(:,:, 577) = rate(:,:, 577) * m(:,:) + rate(:,:, 578) = rate(:,:, 578) * m(:,:) + rate(:,:, 579) = rate(:,:, 579) * m(:,:) + rate(:,:, 580) = rate(:,:, 580) * m(:,:) + rate(:,:, 581) = rate(:,:, 581) * m(:,:) + rate(:,:, 582) = rate(:,:, 582) * m(:,:) + rate(:,:, 583) = rate(:,:, 583) * m(:,:) + rate(:,:, 584) = rate(:,:, 584) * m(:,:) + rate(:,:, 585) = rate(:,:, 585) * m(:,:) + rate(:,:, 586) = rate(:,:, 586) * m(:,:) + rate(:,:, 587) = rate(:,:, 587) * m(:,:) + rate(:,:, 588) = rate(:,:, 588) * m(:,:) + rate(:,:, 589) = rate(:,:, 589) * m(:,:) + rate(:,:, 590) = rate(:,:, 590) * m(:,:) + rate(:,:, 591) = rate(:,:, 591) * m(:,:) + rate(:,:, 592) = rate(:,:, 592) * m(:,:) + rate(:,:, 593) = rate(:,:, 593) * m(:,:) + rate(:,:, 594) = rate(:,:, 594) * m(:,:) + rate(:,:, 595) = rate(:,:, 595) * m(:,:) + rate(:,:, 596) = rate(:,:, 596) * m(:,:) + rate(:,:, 597) = rate(:,:, 597) * m(:,:) + rate(:,:, 598) = rate(:,:, 598) * m(:,:) + rate(:,:, 599) = rate(:,:, 599) * m(:,:) + rate(:,:, 600) = rate(:,:, 600) * m(:,:) + rate(:,:, 601) = rate(:,:, 601) * m(:,:) + rate(:,:, 602) = rate(:,:, 602) * m(:,:) + rate(:,:, 603) = rate(:,:, 603) * m(:,:) + rate(:,:, 604) = rate(:,:, 604) * m(:,:) + rate(:,:, 605) = rate(:,:, 605) * m(:,:) + rate(:,:, 606) = rate(:,:, 606) * m(:,:) + rate(:,:, 607) = rate(:,:, 607) * m(:,:) + rate(:,:, 608) = rate(:,:, 608) * m(:,:) + rate(:,:, 609) = rate(:,:, 609) * m(:,:) + rate(:,:, 610) = rate(:,:, 610) * m(:,:) + rate(:,:, 611) = rate(:,:, 611) * m(:,:) + rate(:,:, 612) = rate(:,:, 612) * m(:,:) + rate(:,:, 613) = rate(:,:, 613) * m(:,:) + rate(:,:, 614) = rate(:,:, 614) * m(:,:) + rate(:,:, 615) = rate(:,:, 615) * m(:,:) + rate(:,:, 616) = rate(:,:, 616) * m(:,:) + rate(:,:, 617) = rate(:,:, 617) * m(:,:) + rate(:,:, 618) = rate(:,:, 618) * m(:,:) + rate(:,:, 619) = rate(:,:, 619) * m(:,:) + rate(:,:, 620) = rate(:,:, 620) * m(:,:) + rate(:,:, 621) = rate(:,:, 621) * m(:,:) + rate(:,:, 622) = rate(:,:, 622) * m(:,:) + rate(:,:, 623) = rate(:,:, 623) * m(:,:) + rate(:,:, 624) = rate(:,:, 624) * m(:,:) + rate(:,:, 625) = rate(:,:, 625) * m(:,:) + rate(:,:, 626) = rate(:,:, 626) * m(:,:) + rate(:,:, 627) = rate(:,:, 627) * m(:,:) + rate(:,:, 628) = rate(:,:, 628) * m(:,:) + rate(:,:, 629) = rate(:,:, 629) * m(:,:) + rate(:,:, 630) = rate(:,:, 630) * m(:,:) + rate(:,:, 631) = rate(:,:, 631) * m(:,:) + rate(:,:, 632) = rate(:,:, 632) * m(:,:) + rate(:,:, 633) = rate(:,:, 633) * m(:,:) + rate(:,:, 634) = rate(:,:, 634) * m(:,:) + rate(:,:, 635) = rate(:,:, 635) * m(:,:) + rate(:,:, 636) = rate(:,:, 636) * m(:,:) + rate(:,:, 637) = rate(:,:, 637) * m(:,:) + rate(:,:, 638) = rate(:,:, 638) * m(:,:) + rate(:,:, 639) = rate(:,:, 639) * m(:,:) + rate(:,:, 640) = rate(:,:, 640) * m(:,:) + rate(:,:, 641) = rate(:,:, 641) * m(:,:) + rate(:,:, 642) = rate(:,:, 642) * m(:,:) + rate(:,:, 643) = rate(:,:, 643) * m(:,:) + rate(:,:, 644) = rate(:,:, 644) * m(:,:) + rate(:,:, 645) = rate(:,:, 645) * m(:,:) + rate(:,:, 646) = rate(:,:, 646) * m(:,:) + rate(:,:, 647) = rate(:,:, 647) * m(:,:) + rate(:,:, 648) = rate(:,:, 648) * m(:,:) + rate(:,:, 649) = rate(:,:, 649) * m(:,:) + rate(:,:, 650) = rate(:,:, 650) * m(:,:) + rate(:,:, 651) = rate(:,:, 651) * m(:,:) + rate(:,:, 652) = rate(:,:, 652) * m(:,:) + rate(:,:, 653) = rate(:,:, 653) * m(:,:) + rate(:,:, 654) = rate(:,:, 654) * m(:,:) + rate(:,:, 655) = rate(:,:, 655) * m(:,:) + rate(:,:, 656) = rate(:,:, 656) * m(:,:) + rate(:,:, 657) = rate(:,:, 657) * m(:,:) + rate(:,:, 658) = rate(:,:, 658) * m(:,:) + rate(:,:, 659) = rate(:,:, 659) * m(:,:) + rate(:,:, 660) = rate(:,:, 660) * m(:,:) + rate(:,:, 661) = rate(:,:, 661) * m(:,:) + rate(:,:, 662) = rate(:,:, 662) * m(:,:) + rate(:,:, 663) = rate(:,:, 663) * m(:,:) + rate(:,:, 664) = rate(:,:, 664) * m(:,:) + rate(:,:, 665) = rate(:,:, 665) * m(:,:) + rate(:,:, 666) = rate(:,:, 666) * m(:,:) + rate(:,:, 667) = rate(:,:, 667) * m(:,:) + rate(:,:, 668) = rate(:,:, 668) * m(:,:) + rate(:,:, 669) = rate(:,:, 669) * m(:,:) + rate(:,:, 670) = rate(:,:, 670) * m(:,:) + rate(:,:, 671) = rate(:,:, 671) * m(:,:) + rate(:,:, 672) = rate(:,:, 672) * m(:,:) + rate(:,:, 673) = rate(:,:, 673) * m(:,:) + rate(:,:, 674) = rate(:,:, 674) * m(:,:) + rate(:,:, 675) = rate(:,:, 675) * m(:,:) + rate(:,:, 676) = rate(:,:, 676) * m(:,:) + rate(:,:, 677) = rate(:,:, 677) * m(:,:) + rate(:,:, 678) = rate(:,:, 678) * m(:,:) + rate(:,:, 679) = rate(:,:, 679) * m(:,:) + rate(:,:, 680) = rate(:,:, 680) * m(:,:) + rate(:,:, 681) = rate(:,:, 681) * m(:,:) + rate(:,:, 682) = rate(:,:, 682) * m(:,:) + rate(:,:, 683) = rate(:,:, 683) * m(:,:) + rate(:,:, 684) = rate(:,:, 684) * m(:,:) + rate(:,:, 685) = rate(:,:, 685) * m(:,:) + rate(:,:, 686) = rate(:,:, 686) * m(:,:) + rate(:,:, 687) = rate(:,:, 687) * m(:,:) + rate(:,:, 688) = rate(:,:, 688) * m(:,:) + rate(:,:, 689) = rate(:,:, 689) * m(:,:) + rate(:,:, 690) = rate(:,:, 690) * m(:,:) + rate(:,:, 691) = rate(:,:, 691) * m(:,:) + rate(:,:, 692) = rate(:,:, 692) * m(:,:) + rate(:,:, 693) = rate(:,:, 693) * m(:,:) + rate(:,:, 694) = rate(:,:, 694) * m(:,:) + rate(:,:, 695) = rate(:,:, 695) * m(:,:) + rate(:,:, 696) = rate(:,:, 696) * m(:,:) + rate(:,:, 697) = rate(:,:, 697) * m(:,:) + rate(:,:, 698) = rate(:,:, 698) * m(:,:) + rate(:,:, 699) = rate(:,:, 699) * m(:,:) + rate(:,:, 700) = rate(:,:, 700) * m(:,:) + rate(:,:, 701) = rate(:,:, 701) * m(:,:) + rate(:,:, 702) = rate(:,:, 702) * m(:,:) + rate(:,:, 703) = rate(:,:, 703) * m(:,:) + rate(:,:, 704) = rate(:,:, 704) * m(:,:) + rate(:,:, 705) = rate(:,:, 705) * m(:,:) + rate(:,:, 706) = rate(:,:, 706) * m(:,:) + rate(:,:, 707) = rate(:,:, 707) * m(:,:) + rate(:,:, 708) = rate(:,:, 708) * m(:,:) + rate(:,:, 709) = rate(:,:, 709) * m(:,:) + rate(:,:, 710) = rate(:,:, 710) * m(:,:) + rate(:,:, 711) = rate(:,:, 711) * m(:,:) + rate(:,:, 712) = rate(:,:, 712) * m(:,:) + rate(:,:, 713) = rate(:,:, 713) * m(:,:) + rate(:,:, 714) = rate(:,:, 714) * m(:,:) + rate(:,:, 715) = rate(:,:, 715) * m(:,:) + rate(:,:, 716) = rate(:,:, 716) * m(:,:) + rate(:,:, 717) = rate(:,:, 717) * m(:,:) + rate(:,:, 718) = rate(:,:, 718) * m(:,:) + rate(:,:, 719) = rate(:,:, 719) * m(:,:) + rate(:,:, 720) = rate(:,:, 720) * m(:,:) + rate(:,:, 721) = rate(:,:, 721) * m(:,:) + rate(:,:, 722) = rate(:,:, 722) * m(:,:) + rate(:,:, 723) = rate(:,:, 723) * m(:,:) + rate(:,:, 724) = rate(:,:, 724) * m(:,:) + rate(:,:, 725) = rate(:,:, 725) * m(:,:) + rate(:,:, 726) = rate(:,:, 726) * m(:,:) + rate(:,:, 727) = rate(:,:, 727) * m(:,:) + rate(:,:, 728) = rate(:,:, 728) * m(:,:) + rate(:,:, 729) = rate(:,:, 729) * m(:,:) + rate(:,:, 730) = rate(:,:, 730) * m(:,:) + rate(:,:, 731) = rate(:,:, 731) * m(:,:) + rate(:,:, 732) = rate(:,:, 732) * m(:,:) + rate(:,:, 733) = rate(:,:, 733) * m(:,:) + rate(:,:, 734) = rate(:,:, 734) * m(:,:) + rate(:,:, 735) = rate(:,:, 735) * m(:,:) + rate(:,:, 736) = rate(:,:, 736) * m(:,:) + rate(:,:, 737) = rate(:,:, 737) * m(:,:) + rate(:,:, 738) = rate(:,:, 738) * m(:,:) + rate(:,:, 739) = rate(:,:, 739) * m(:,:) + rate(:,:, 740) = rate(:,:, 740) * m(:,:) + rate(:,:, 741) = rate(:,:, 741) * m(:,:) + rate(:,:, 742) = rate(:,:, 742) * m(:,:) + rate(:,:, 743) = rate(:,:, 743) * m(:,:) + rate(:,:, 744) = rate(:,:, 744) * m(:,:) + rate(:,:, 745) = rate(:,:, 745) * m(:,:) + rate(:,:, 746) = rate(:,:, 746) * m(:,:) + rate(:,:, 747) = rate(:,:, 747) * m(:,:) + rate(:,:, 748) = rate(:,:, 748) * m(:,:) + rate(:,:, 749) = rate(:,:, 749) * m(:,:) + rate(:,:, 750) = rate(:,:, 750) * m(:,:) + rate(:,:, 751) = rate(:,:, 751) * m(:,:) + rate(:,:, 752) = rate(:,:, 752) * m(:,:) + rate(:,:, 753) = rate(:,:, 753) * m(:,:) + rate(:,:, 754) = rate(:,:, 754) * m(:,:) + rate(:,:, 755) = rate(:,:, 755) * m(:,:) + rate(:,:, 756) = rate(:,:, 756) * m(:,:) + rate(:,:, 757) = rate(:,:, 757) * m(:,:) + rate(:,:, 758) = rate(:,:, 758) * m(:,:) + rate(:,:, 759) = rate(:,:, 759) * m(:,:) + rate(:,:, 760) = rate(:,:, 760) * m(:,:) + rate(:,:, 761) = rate(:,:, 761) * m(:,:) + rate(:,:, 762) = rate(:,:, 762) * m(:,:) + rate(:,:, 763) = rate(:,:, 763) * m(:,:) + rate(:,:, 764) = rate(:,:, 764) * m(:,:) + rate(:,:, 765) = rate(:,:, 765) * m(:,:) + rate(:,:, 766) = rate(:,:, 766) * m(:,:) + rate(:,:, 767) = rate(:,:, 767) * m(:,:) + rate(:,:, 768) = rate(:,:, 768) * m(:,:) + rate(:,:, 769) = rate(:,:, 769) * m(:,:) + rate(:,:, 770) = rate(:,:, 770) * m(:,:) + rate(:,:, 771) = rate(:,:, 771) * m(:,:) + rate(:,:, 772) = rate(:,:, 772) * m(:,:) + rate(:,:, 773) = rate(:,:, 773) * m(:,:) + rate(:,:, 774) = rate(:,:, 774) * m(:,:) + rate(:,:, 775) = rate(:,:, 775) * m(:,:) + rate(:,:, 776) = rate(:,:, 776) * m(:,:) + rate(:,:, 777) = rate(:,:, 777) * m(:,:) + rate(:,:, 778) = rate(:,:, 778) * m(:,:) + rate(:,:, 779) = rate(:,:, 779) * m(:,:) + rate(:,:, 780) = rate(:,:, 780) * m(:,:) + rate(:,:, 781) = rate(:,:, 781) * m(:,:) + rate(:,:, 782) = rate(:,:, 782) * m(:,:) + rate(:,:, 783) = rate(:,:, 783) * m(:,:) + rate(:,:, 784) = rate(:,:, 784) * m(:,:) + rate(:,:, 785) = rate(:,:, 785) * m(:,:) + rate(:,:, 786) = rate(:,:, 786) * m(:,:) + rate(:,:, 787) = rate(:,:, 787) * m(:,:) + rate(:,:, 788) = rate(:,:, 788) * m(:,:) + rate(:,:, 789) = rate(:,:, 789) * m(:,:) + rate(:,:, 793) = rate(:,:, 793) * m(:,:) + rate(:,:, 794) = rate(:,:, 794) * m(:,:) + rate(:,:, 795) = rate(:,:, 795) * m(:,:) + rate(:,:, 796) = rate(:,:, 796) * m(:,:) + rate(:,:, 798) = rate(:,:, 798) * m(:,:) + rate(:,:, 799) = rate(:,:, 799) * m(:,:) + rate(:,:, 800) = rate(:,:, 800) * m(:,:) + rate(:,:, 801) = rate(:,:, 801) * m(:,:) + rate(:,:, 802) = rate(:,:, 802) * m(:,:) + rate(:,:, 803) = rate(:,:, 803) * m(:,:) + rate(:,:, 805) = rate(:,:, 805) * m(:,:) + rate(:,:, 806) = rate(:,:, 806) * m(:,:) + rate(:,:, 807) = rate(:,:, 807) * m(:,:) + rate(:,:, 808) = rate(:,:, 808) * m(:,:) + rate(:,:, 809) = rate(:,:, 809) * m(:,:) + rate(:,:, 810) = rate(:,:, 810) * m(:,:) + rate(:,:, 841) = rate(:,:, 841) * m(:,:) + rate(:,:, 842) = rate(:,:, 842) * m(:,:) + rate(:,:, 843) = rate(:,:, 843) * m(:,:) + rate(:,:, 844) = rate(:,:, 844) * m(:,:) + rate(:,:, 845) = rate(:,:, 845) * m(:,:) + rate(:,:, 846) = rate(:,:, 846) * m(:,:) + rate(:,:, 847) = rate(:,:, 847) * m(:,:) + rate(:,:, 848) = rate(:,:, 848) * m(:,:) + rate(:,:, 849) = rate(:,:, 849) * m(:,:) + rate(:,:, 850) = rate(:,:, 850) * m(:,:) + rate(:,:, 851) = rate(:,:, 851) * m(:,:) + rate(:,:, 852) = rate(:,:, 852) * m(:,:) + rate(:,:, 853) = rate(:,:, 853) * m(:,:) + rate(:,:, 854) = rate(:,:, 854) * m(:,:) + rate(:,:, 855) = rate(:,:, 855) * m(:,:) + rate(:,:, 856) = rate(:,:, 856) * m(:,:) + rate(:,:, 857) = rate(:,:, 857) * m(:,:) + rate(:,:, 858) = rate(:,:, 858) * m(:,:) + rate(:,:, 859) = rate(:,:, 859) * m(:,:) + rate(:,:, 860) = rate(:,:, 860) * m(:,:) + rate(:,:, 861) = rate(:,:, 861) * m(:,:) + rate(:,:, 862) = rate(:,:, 862) * m(:,:) + rate(:,:, 863) = rate(:,:, 863) * m(:,:) + rate(:,:, 864) = rate(:,:, 864) * m(:,:) + rate(:,:, 865) = rate(:,:, 865) * m(:,:) + rate(:,:, 866) = rate(:,:, 866) * m(:,:) + rate(:,:, 867) = rate(:,:, 867) * m(:,:) + rate(:,:, 868) = rate(:,:, 868) * m(:,:) + rate(:,:, 869) = rate(:,:, 869) * m(:,:) + rate(:,:, 870) = rate(:,:, 870) * m(:,:) + rate(:,:, 871) = rate(:,:, 871) * m(:,:) + rate(:,:, 872) = rate(:,:, 872) * m(:,:) + rate(:,:, 873) = rate(:,:, 873) * m(:,:) + rate(:,:, 874) = rate(:,:, 874) * m(:,:) + rate(:,:, 875) = rate(:,:, 875) * m(:,:) + rate(:,:, 876) = rate(:,:, 876) * m(:,:) + rate(:,:, 877) = rate(:,:, 877) * m(:,:) + rate(:,:, 878) = rate(:,:, 878) * m(:,:) + rate(:,:, 879) = rate(:,:, 879) * m(:,:) + rate(:,:, 880) = rate(:,:, 880) * m(:,:) + rate(:,:, 881) = rate(:,:, 881) * m(:,:) + rate(:,:, 882) = rate(:,:, 882) * m(:,:) + rate(:,:, 883) = rate(:,:, 883) * m(:,:) + rate(:,:, 885) = rate(:,:, 885) * m(:,:) + rate(:,:, 890) = rate(:,:, 890) * m(:,:) + rate(:,:, 891) = rate(:,:, 891) * m(:,:) + rate(:,:, 892) = rate(:,:, 892) * m(:,:) + rate(:,:, 895) = rate(:,:, 895) * m(:,:) + rate(:,:, 896) = rate(:,:, 896) * m(:,:) + rate(:,:, 897) = rate(:,:, 897) * m(:,:) + rate(:,:, 900) = rate(:,:, 900) * m(:,:) end subroutine adjrxt end module mo_adjrxt diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/mo_indprd.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/mo_indprd.F90 index dd9d3262a9..29ea588876 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/mo_indprd.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/mo_indprd.F90 @@ -20,262 +20,190 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) ! ... "independent" production for Explicit species !-------------------------------------------------------------------- if( class == 1 ) then - prod(:,1) = + extfrc(:,17) - prod(:,2) = 0._r8 - prod(:,3) = 0._r8 - prod(:,4) = 0._r8 - prod(:,5) = 0._r8 - prod(:,6) = 0._r8 - prod(:,7) = 0._r8 - prod(:,8) = 0._r8 - prod(:,9) = 0._r8 - prod(:,10) = 0._r8 - prod(:,11) = 0._r8 - prod(:,12) = 0._r8 - prod(:,13) = 0._r8 - prod(:,14) = 0._r8 - prod(:,15) =.100_r8*rxt(:,355)*y(:,157)*y(:,30) - prod(:,16) = 0._r8 - prod(:,17) = 0._r8 - prod(:,18) = (2.000_r8*rxt(:,336)*y(:,250) +.900_r8*rxt(:,337)*y(:,251) + & - .490_r8*rxt(:,338)*y(:,256) +rxt(:,339)*y(:,147) + & - rxt(:,382)*y(:,282) +2.000_r8*rxt(:,389)*y(:,284) + & - rxt(:,401)*y(:,287) +rxt(:,425)*y(:,259) +rxt(:,431)*y(:,260) + & - rxt(:,445)*y(:,265) +rxt(:,449)*y(:,266) +rxt(:,475)*y(:,272) + & - rxt(:,492)*y(:,276) +rxt(:,496)*y(:,277) +rxt(:,587)*y(:,235) + & - rxt(:,595)*y(:,236) +rxt(:,607)*y(:,238) +rxt(:,615)*y(:,239) + & - rxt(:,627)*y(:,243) +rxt(:,635)*y(:,244) +rxt(:,646)*y(:,279) + & - rxt(:,655)*y(:,280) +rxt(:,666)*y(:,288) +rxt(:,675)*y(:,289) + & - rxt(:,694)*y(:,299) +2.000_r8*rxt(:,702)*y(:,300) + & - rxt(:,710)*y(:,301) +2.000_r8*rxt(:,720)*y(:,302) + & - rxt(:,729)*y(:,303) +rxt(:,739)*y(:,304) + & - 2.000_r8*rxt(:,750)*y(:,305))*y(:,250) + (rxt(:,592)*y(:,235) + & - rxt(:,600)*y(:,236) +rxt(:,612)*y(:,238) +rxt(:,620)*y(:,239) + & - rxt(:,632)*y(:,243) +rxt(:,640)*y(:,244) +rxt(:,652)*y(:,279) + & - rxt(:,660)*y(:,280) +rxt(:,672)*y(:,288) +rxt(:,680)*y(:,289) + & - rxt(:,699)*y(:,299) +rxt(:,703)*y(:,251) + & - .490_r8*rxt(:,704)*y(:,256) +rxt(:,705)*y(:,147) + & - rxt(:,706)*y(:,149) +2.000_r8*rxt(:,707)*y(:,300) + & - 2.000_r8*rxt(:,708)*y(:,305) +rxt(:,715)*y(:,301) + & - 2.000_r8*rxt(:,725)*y(:,302) +rxt(:,734)*y(:,303) + & - rxt(:,744)*y(:,304))*y(:,300) + (rxt(:,593)*y(:,235) + & - rxt(:,601)*y(:,236) +rxt(:,613)*y(:,238) +rxt(:,621)*y(:,239) + & - rxt(:,633)*y(:,243) +rxt(:,641)*y(:,244) +rxt(:,653)*y(:,279) + & - rxt(:,661)*y(:,280) +rxt(:,673)*y(:,288) +rxt(:,681)*y(:,289) + & - rxt(:,700)*y(:,299) +rxt(:,716)*y(:,301) +rxt(:,721)*y(:,251) + & - .490_r8*rxt(:,722)*y(:,256) +rxt(:,723)*y(:,147) + & - rxt(:,724)*y(:,149) +2.000_r8*rxt(:,726)*y(:,302) + & - 2.000_r8*rxt(:,727)*y(:,305) +rxt(:,735)*y(:,303) + & - rxt(:,745)*y(:,304))*y(:,302) + (rxt(:,594)*y(:,235) + & - rxt(:,602)*y(:,236) +rxt(:,614)*y(:,238) +rxt(:,622)*y(:,239) + & - rxt(:,634)*y(:,243) +rxt(:,642)*y(:,244) +rxt(:,654)*y(:,279) + & - rxt(:,662)*y(:,280) +rxt(:,674)*y(:,288) +rxt(:,682)*y(:,289) + & - rxt(:,701)*y(:,299) +rxt(:,717)*y(:,301) +rxt(:,736)*y(:,303) + & - rxt(:,746)*y(:,304) +rxt(:,751)*y(:,251) + & - .490_r8*rxt(:,752)*y(:,256) +rxt(:,753)*y(:,147) + & - rxt(:,754)*y(:,149) +2.000_r8*rxt(:,755)*y(:,305))*y(:,305) & - + (rxt(:,309)*y(:,63) +rxt(:,311)*y(:,90) +rxt(:,320)*y(:,63) + & - rxt(:,340)*y(:,51) +.500_r8*rxt(:,341)*y(:,52) + & - .800_r8*rxt(:,346)*y(:,76) +rxt(:,347)*y(:,77) +rxt(:,349)*y(:,150) + & - .540_r8*rxt(:,415)*y(:,98) +.540_r8*rxt(:,416)*y(:,99) + & - .360_r8*rxt(:,419)*y(:,103) +.190_r8*rxt(:,424)*y(:,108) + & - .450_r8*rxt(:,503)*y(:,139) +2.000_r8*rxt(:,719)*y(:,202) + & - 3.000_r8*rxt(:,738)*y(:,204) +.290_r8*rxt(:,747)*y(:,206) + & - .290_r8*rxt(:,748)*y(:,207) +.290_r8*rxt(:,749)*y(:,205))*y(:,293) & - + (rxt(:,390)*y(:,251) +.490_r8*rxt(:,391)*y(:,256) + & - 2.000_r8*rxt(:,392)*y(:,284) +rxt(:,393)*y(:,147) + & - rxt(:,394)*y(:,149))*y(:,284) + (.200_r8*rxt(:,355)*y(:,30) + & - .100_r8*rxt(:,404)*y(:,132) +.420_r8*rxt(:,487)*y(:,109) + & - .190_r8*rxt(:,643)*y(:,17))*y(:,157) +rxt(:,36)*y(:,52) & - +.170_r8*rxt(:,48)*y(:,98) +.280_r8*rxt(:,49)*y(:,99) +rxt(:,54) & - *y(:,103) +.400_r8*rxt(:,86)*y(:,162) +rxt(:,98)*y(:,205) +rxt(:,99) & - *y(:,206) +rxt(:,100)*y(:,207) - prod(:,19) = 0._r8 - prod(:,20) = 0._r8 - prod(:,21) = 0._r8 - prod(:,22) = 0._r8 - prod(:,23) = 0._r8 - prod(:,24) =rxt(:,195)*y(:,148)*y(:,136) - prod(:,25) = 0._r8 - prod(:,26) = 0._r8 - prod(:,27) = 0._r8 - prod(:,28) = 0._r8 - prod(:,29) = 0._r8 - prod(:,30) =rxt(:,811)*y(:,293)*y(:,143) +rxt(:,830)*y(:,144) - prod(:,31) = (rxt(:,558)*y(:,252) +rxt(:,561)*y(:,283) +rxt(:,564)*y(:,285) + & - rxt(:,568)*y(:,164))*y(:,148) + prod(:,1) =rxt(:,810)*y(:,293)*y(:,143) +rxt(:,829)*y(:,144) + prod(:,2) = (rxt(:,557)*y(:,252) +rxt(:,560)*y(:,283) +rxt(:,563)*y(:,285) + & + rxt(:,567)*y(:,164))*y(:,148) !-------------------------------------------------------------------- ! ... "independent" production for Implicit species !-------------------------------------------------------------------- else if( class == 4 ) then - prod(:,140) = 0._r8 - prod(:,141) = 0._r8 - prod(:,185) = 0._r8 - prod(:,1) = + extfrc(:,10) - prod(:,2) = + extfrc(:,11) prod(:,163) = 0._r8 - prod(:,56) = 0._r8 - prod(:,96) = 0._r8 - prod(:,57) = 0._r8 - prod(:,106) = 0._r8 - prod(:,83) = 0._r8 - prod(:,97) = 0._r8 - prod(:,87) = 0._r8 - prod(:,61) = 0._r8 - prod(:,94) = 0._r8 - prod(:,171) = 0._r8 - prod(:,233) =rxt(:,123)*y(:,35) +rxt(:,124)*y(:,36) +2.000_r8*rxt(:,130) & - *y(:,42) +rxt(:,131)*y(:,44) +3.000_r8*rxt(:,134)*y(:,56) & - +2.000_r8*rxt(:,142)*y(:,80) - prod(:,69) = 0._r8 - prod(:,284) = 0._r8 + prod(:,164) = 0._r8 + prod(:,1) = 0._r8 + prod(:,215) = 0._r8 + prod(:,2) = 0._r8 + prod(:,3) = + extfrc(:,3) + prod(:,196) = 0._r8 + prod(:,74) = 0._r8 prod(:,122) = 0._r8 - prod(:,70) = 0._r8 - prod(:,90) = 0._r8 - prod(:,84) = 0._r8 - prod(:,123) = 0._r8 - prod(:,76) = 0._r8 - prod(:,91) = 0._r8 - prod(:,85) = 0._r8 - prod(:,195) = 0._r8 - prod(:,99) = 0._r8 - prod(:,50) = 0._r8 - prod(:,77) = 0._r8 - prod(:,278) =.180_r8*rxt(:,39)*y(:,55) - prod(:,203) = 0._r8 - prod(:,48) = 0._r8 - prod(:,251) = 0._r8 - prod(:,240) = 0._r8 - prod(:,128) = 0._r8 + prod(:,75) = 0._r8 + prod(:,130) = 0._r8 + prod(:,101) = 0._r8 prod(:,119) = 0._r8 - prod(:,209) = 0._r8 - prod(:,104) = 0._r8 - prod(:,285) =4.000_r8*rxt(:,122)*y(:,34) +rxt(:,123)*y(:,35) & - +2.000_r8*rxt(:,125)*y(:,37) +2.000_r8*rxt(:,126)*y(:,38) & - +2.000_r8*rxt(:,127)*y(:,39) +rxt(:,128)*y(:,40) & - +2.000_r8*rxt(:,129)*y(:,41) +3.000_r8*rxt(:,132)*y(:,45) & - +rxt(:,133)*y(:,47) +rxt(:,144)*y(:,84) +rxt(:,145)*y(:,85) & - +rxt(:,146)*y(:,86) - prod(:,55) = 0._r8 - prod(:,49) = 0._r8 - prod(:,277) = 0._r8 - prod(:,196) = 0._r8 - prod(:,223) =.380_r8*rxt(:,39)*y(:,55) +rxt(:,40)*y(:,64) + extfrc(:,9) - prod(:,53) =rxt(:,123)*y(:,35) +rxt(:,124)*y(:,36) +rxt(:,126)*y(:,38) & - +2.000_r8*rxt(:,127)*y(:,39) +2.000_r8*rxt(:,128)*y(:,40) & - +rxt(:,129)*y(:,41) +2.000_r8*rxt(:,142)*y(:,80) +rxt(:,145)*y(:,85) & - +rxt(:,146)*y(:,86) - prod(:,62) =rxt(:,125)*y(:,37) +rxt(:,126)*y(:,38) +rxt(:,144)*y(:,84) - prod(:,64) = 0._r8 - prod(:,132) = 0._r8 - prod(:,81) = 0._r8 - prod(:,3) = 0._r8 + prod(:,108) = 0._r8 + prod(:,79) = 0._r8 + prod(:,116) = 0._r8 + prod(:,200) = 0._r8 + prod(:,274) = 0._r8 + prod(:,86) = 0._r8 + prod(:,289) = 0._r8 + prod(:,146) = 0._r8 prod(:,4) = 0._r8 - prod(:,5) = 0._r8 - prod(:,51) = 0._r8 - prod(:,167) =rxt(:,124)*y(:,36) +rxt(:,128)*y(:,40) - prod(:,218) = 0._r8 - prod(:,193) = 0._r8 - prod(:,271) = (rxt(:,38) +.330_r8*rxt(:,39))*y(:,55) - prod(:,215) =1.440_r8*rxt(:,39)*y(:,55) - prod(:,208) = 0._r8 - prod(:,52) = 0._r8 - prod(:,180) = 0._r8 - prod(:,283) = 0._r8 - prod(:,59) = 0._r8 - prod(:,149) = 0._r8 - prod(:,187) = 0._r8 - prod(:,68) = 0._r8 - prod(:,186) = 0._r8 - prod(:,270) = 0._r8 + prod(:,87) = 0._r8 + prod(:,111) = 0._r8 prod(:,103) = 0._r8 - prod(:,168) = 0._r8 - prod(:,182) = 0._r8 - prod(:,165) = 0._r8 - prod(:,130) = 0._r8 - prod(:,131) = 0._r8 + prod(:,148) = 0._r8 + prod(:,97) = 0._r8 prod(:,112) = 0._r8 - prod(:,113) = 0._r8 + prod(:,104) = 0._r8 + prod(:,225) = 0._r8 + prod(:,121) = 0._r8 + prod(:,61) = 0._r8 + prod(:,98) = 0._r8 + prod(:,58) = 0._r8 + prod(:,69) = 0._r8 + prod(:,70) = 0._r8 + prod(:,62) = 0._r8 + prod(:,71) = 0._r8 + prod(:,63) = 0._r8 + prod(:,72) = 0._r8 + prod(:,64) = 0._r8 + prod(:,137) = 0._r8 + prod(:,307) = 0._r8 + prod(:,154) = 0._r8 + prod(:,65) = 0._r8 prod(:,228) = 0._r8 - prod(:,234) = 0._r8 - prod(:,158) = 0._r8 - prod(:,198) = 0._r8 - prod(:,157) = 0._r8 - prod(:,111) = 0._r8 - prod(:,184) = 0._r8 - prod(:,202) = 0._r8 - prod(:,222) = 0._r8 - prod(:,178) = 0._r8 - prod(:,230) = 0._r8 - prod(:,206) = 0._r8 - prod(:,143) = 0._r8 - prod(:,243) = 0._r8 - prod(:,133) = 0._r8 - prod(:,120) = 0._r8 - prod(:,244) = 0._r8 - prod(:,139) = 0._r8 - prod(:,181) = 0._r8 - prod(:,216) = 0._r8 - prod(:,156) = 0._r8 - prod(:,242) = 0._r8 - prod(:,42) = 0._r8 - prod(:,172) = 0._r8 + prod(:,118) = 0._r8 + prod(:,59) = 0._r8 + prod(:,278) = 0._r8 + prod(:,263) = 0._r8 + prod(:,171) = 0._r8 + prod(:,161) = 0._r8 prod(:,236) = 0._r8 - prod(:,229) = 0._r8 - prod(:,205) = 0._r8 - prod(:,116) = 0._r8 - prod(:,86) = 0._r8 - prod(:,108) = 0._r8 - prod(:,241) = 0._r8 - prod(:,238) = 0._r8 - prod(:,210) = 0._r8 - prod(:,148) = 0._r8 - prod(:,95) = + extfrc(:,16) - prod(:,82) = 0._r8 + prod(:,129) = 0._r8 + prod(:,277) = 0._r8 + prod(:,125) = 0._r8 + prod(:,311) = 0._r8 + prod(:,73) = 0._r8 + prod(:,56) = 0._r8 + prod(:,291) = 0._r8 + prod(:,221) = 0._r8 + prod(:,5) = 0._r8 + prod(:,264) = + extfrc(:,9) prod(:,245) = 0._r8 + prod(:,91) = 0._r8 + prod(:,89) = 0._r8 + prod(:,82) = 0._r8 + prod(:,153) = 0._r8 + prod(:,105) = 0._r8 prod(:,6) = 0._r8 prod(:,7) = 0._r8 prod(:,8) = 0._r8 - prod(:,47) = 0._r8 prod(:,9) = 0._r8 - prod(:,272) = + extfrc(:,2) - prod(:,281) = + extfrc(:,3) - prod(:,274) = 0._r8 - prod(:,201) = 0._r8 + prod(:,66) = 0._r8 + prod(:,217) = 0._r8 + prod(:,252) = 0._r8 + prod(:,233) = 0._r8 + prod(:,290) = 0._r8 + prod(:,249) = 0._r8 + prod(:,60) = 0._r8 + prod(:,235) = 0._r8 + prod(:,67) = 0._r8 prod(:,207) = 0._r8 - prod(:,10) = + extfrc(:,12) - prod(:,11) = + extfrc(:,13) - prod(:,12) = 0._r8 - prod(:,13) = + extfrc(:,14) - prod(:,280) =.180_r8*rxt(:,39)*y(:,55) +rxt(:,40)*y(:,64) + (rxt(:,5) + & - 2.000_r8*rxt(:,6)) - prod(:,273) = 0._r8 prod(:,88) = 0._r8 - prod(:,93) = 0._r8 - prod(:,60) = 0._r8 - prod(:,109) = 0._r8 - prod(:,54) = 0._r8 - prod(:,110) = 0._r8 - prod(:,58) = 0._r8 - prod(:,89) = 0._r8 - prod(:,14) = + extfrc(:,6) - prod(:,15) = + extfrc(:,7) - prod(:,121) = 0._r8 - prod(:,98) = 0._r8 - prod(:,117) = 0._r8 - prod(:,221) = 0._r8 - prod(:,191) = + extfrc(:,4) - prod(:,75) = 0._r8 - prod(:,16) = + extfrc(:,8) - prod(:,17) = + extfrc(:,1) + prod(:,90) = 0._r8 + prod(:,102) = 0._r8 + prod(:,304) = 0._r8 + prod(:,77) = 0._r8 + prod(:,175) = 0._r8 + prod(:,224) = 0._r8 + prod(:,106) = 0._r8 + prod(:,211) = 0._r8 + prod(:,306) = 0._r8 + prod(:,127) = 0._r8 + prod(:,193) = 0._r8 + prod(:,205) = 0._r8 + prod(:,191) = 0._r8 + prod(:,152) = 0._r8 + prod(:,159) = 0._r8 + prod(:,133) = 0._r8 + prod(:,135) = 0._r8 + prod(:,256) = 0._r8 + prod(:,261) = 0._r8 + prod(:,189) = 0._r8 + prod(:,184) = 0._r8 + prod(:,239) = 0._r8 + prod(:,134) = 0._r8 + prod(:,216) = 0._r8 + prod(:,226) = 0._r8 + prod(:,248) = 0._r8 + prod(:,202) = 0._r8 + prod(:,258) = 0._r8 + prod(:,232) = 0._r8 + prod(:,169) = 0._r8 + prod(:,271) = 0._r8 + prod(:,151) = 0._r8 + prod(:,144) = 0._r8 + prod(:,270) = 0._r8 + prod(:,167) = 0._r8 + prod(:,209) = 0._r8 + prod(:,243) = 0._r8 + prod(:,183) = 0._r8 + prod(:,262) = 0._r8 + prod(:,51) = 0._r8 + prod(:,199) = 0._r8 + prod(:,268) = 0._r8 + prod(:,254) = 0._r8 + prod(:,231) = 0._r8 + prod(:,143) = 0._r8 + prod(:,107) = 0._r8 + prod(:,138) = 0._r8 + prod(:,269) = 0._r8 + prod(:,265) = 0._r8 + prod(:,237) = 0._r8 + prod(:,177) = 0._r8 + prod(:,132) = + extfrc(:,13) + prod(:,78) = 0._r8 + prod(:,100) = 0._r8 + prod(:,272) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,57) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) = 0._r8 + prod(:,305) = + extfrc(:,12) + prod(:,314) = + extfrc(:,6) + prod(:,312) = 0._r8 + prod(:,230) = 0._r8 + prod(:,234) = 0._r8 + prod(:,16) = + extfrc(:,10) + prod(:,17) = + extfrc(:,11) prod(:,18) = 0._r8 - prod(:,19) = 0._r8 + prod(:,19) = + extfrc(:,1) + prod(:,308) = (rxt(:,5) +2.000_r8*rxt(:,6)) + prod(:,303) = 0._r8 prod(:,20) = 0._r8 + prod(:,109) = 0._r8 + prod(:,117) = 0._r8 + prod(:,80) = 0._r8 + prod(:,145) = 0._r8 + prod(:,68) = 0._r8 + prod(:,136) = 0._r8 + prod(:,76) = 0._r8 + prod(:,110) = 0._r8 prod(:,21) = 0._r8 - prod(:,22) = 0._r8 + prod(:,22) = + extfrc(:,2) + prod(:,147) = 0._r8 + prod(:,120) = 0._r8 + prod(:,141) = 0._r8 prod(:,23) = 0._r8 - prod(:,24) = 0._r8 - prod(:,25) = 0._r8 + prod(:,244) = 0._r8 + prod(:,214) = + extfrc(:,5) + prod(:,96) = 0._r8 + prod(:,24) = + extfrc(:,7) + prod(:,25) = + extfrc(:,8) prod(:,26) = 0._r8 prod(:,27) = 0._r8 prod(:,28) = 0._r8 @@ -285,126 +213,135 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) prod(:,32) = 0._r8 prod(:,33) = 0._r8 prod(:,34) = 0._r8 - prod(:,35) = + extfrc(:,5) - prod(:,65) = 0._r8 - prod(:,253) = 0._r8 - prod(:,107) = 0._r8 - prod(:,254) = 0._r8 - prod(:,192) = 0._r8 - prod(:,124) = 0._r8 - prod(:,231) = 0._r8 - prod(:,125) = 0._r8 - prod(:,126) = 0._r8 - prod(:,78) = 0._r8 - prod(:,79) = 0._r8 - prod(:,100) = 0._r8 - prod(:,92) = 0._r8 - prod(:,262) = 0._r8 - prod(:,261) = 0._r8 - prod(:,190) = 0._r8 - prod(:,164) = 0._r8 - prod(:,175) = 0._r8 - prod(:,166) = 0._r8 - prod(:,134) = 0._r8 - prod(:,179) = 0._r8 - prod(:,144) = 0._r8 - prod(:,217) = 0._r8 - prod(:,226) = 0._r8 - prod(:,213) = 0._r8 - prod(:,227) = 0._r8 - prod(:,135) = 0._r8 - prod(:,127) = 0._r8 - prod(:,138) = 0._r8 - prod(:,63) = 0._r8 - prod(:,66) = 0._r8 - prod(:,150) = 0._r8 - prod(:,67) = 0._r8 - prod(:,101) = 0._r8 - prod(:,118) = 0._r8 - prod(:,188) = 0._r8 - prod(:,250) = 0._r8 - prod(:,255) = 0._r8 + prod(:,35) = 0._r8 prod(:,36) = 0._r8 - prod(:,247) = 0._r8 - prod(:,249) = 0._r8 prod(:,37) = 0._r8 - prod(:,114) = 0._r8 prod(:,38) = 0._r8 - prod(:,259) = 0._r8 - prod(:,256) = 0._r8 prod(:,39) = 0._r8 - prod(:,102) = 0._r8 - prod(:,199) = 0._r8 - prod(:,173) = 0._r8 - prod(:,137) = 0._r8 - prod(:,269) = 0._r8 - prod(:,279) =rxt(:,131)*y(:,44) +rxt(:,133)*y(:,47) +rxt(:,38)*y(:,55) - prod(:,155) = 0._r8 - prod(:,129) = 0._r8 - prod(:,80) = 0._r8 - prod(:,151) = 0._r8 - prod(:,276) = 0._r8 - prod(:,136) = 0._r8 - prod(:,214) = 0._r8 - prod(:,239) = 0._r8 - prod(:,235) = 0._r8 - prod(:,71) = 0._r8 - prod(:,72) = 0._r8 - prod(:,73) = 0._r8 - prod(:,74) = 0._r8 - prod(:,224) = 0._r8 - prod(:,225) = 0._r8 - prod(:,176) = 0._r8 - prod(:,183) = 0._r8 - prod(:,174) = 0._r8 - prod(:,177) = 0._r8 - prod(:,204) = 0._r8 - prod(:,246) = 0._r8 - prod(:,194) = 0._r8 - prod(:,200) = 0._r8 prod(:,40) = 0._r8 - prod(:,237) = 0._r8 - prod(:,232) = 0._r8 prod(:,41) = 0._r8 - prod(:,258) = 0._r8 - prod(:,252) = 0._r8 + prod(:,42) = 0._r8 prod(:,43) = 0._r8 - prod(:,212) = 0._r8 - prod(:,152) = 0._r8 - prod(:,220) = 0._r8 - prod(:,159) = 0._r8 + prod(:,44) = + extfrc(:,4) + prod(:,83) = 0._r8 + prod(:,285) = 0._r8 + prod(:,131) = 0._r8 + prod(:,282) = 0._r8 + prod(:,218) = 0._r8 + prod(:,155) = 0._r8 + prod(:,253) = 0._r8 + prod(:,156) = 0._r8 + prod(:,168) = 0._r8 + prod(:,113) = 0._r8 + prod(:,114) = 0._r8 + prod(:,123) = 0._r8 + prod(:,115) = 0._r8 + prod(:,293) = 0._r8 + prod(:,281) = 0._r8 + prod(:,213) = 0._r8 + prod(:,190) = 0._r8 + prod(:,201) = 0._r8 + prod(:,192) = 0._r8 + prod(:,157) = 0._r8 + prod(:,206) = 0._r8 + prod(:,170) = 0._r8 + prod(:,242) = 0._r8 + prod(:,250) = 0._r8 + prod(:,240) = 0._r8 + prod(:,251) = 0._r8 + prod(:,158) = 0._r8 + prod(:,149) = 0._r8 + prod(:,166) = 0._r8 + prod(:,81) = 0._r8 + prod(:,84) = 0._r8 + prod(:,176) = 0._r8 + prod(:,85) = 0._r8 + prod(:,124) = 0._r8 prod(:,142) = 0._r8 - prod(:,211) = 0._r8 - prod(:,260) = 0._r8 - prod(:,257) = 0._r8 - prod(:,44) = 0._r8 - prod(:,219) = 0._r8 - prod(:,275) =rxt(:,12)*y(:,137) +rxt(:,5) - prod(:,282) =.330_r8*rxt(:,39)*y(:,55) + extfrc(:,15) - prod(:,105) = 0._r8 - prod(:,160) = 0._r8 + prod(:,210) = 0._r8 + prod(:,279) = 0._r8 + prod(:,286) = 0._r8 + prod(:,45) = 0._r8 + prod(:,275) = 0._r8 + prod(:,280) = 0._r8 + prod(:,46) = 0._r8 + prod(:,139) = 0._r8 + prod(:,47) = 0._r8 + prod(:,288) = 0._r8 + prod(:,284) = 0._r8 + prod(:,48) = 0._r8 + prod(:,126) = 0._r8 + prod(:,223) = 0._r8 prod(:,197) = 0._r8 - prod(:,161) = 0._r8 - prod(:,169) = 0._r8 - prod(:,263) = 0._r8 + prod(:,162) = 0._r8 + prod(:,302) = 0._r8 + prod(:,313) = 0._r8 + prod(:,182) = 0._r8 + prod(:,150) = 0._r8 + prod(:,99) = 0._r8 + prod(:,178) = 0._r8 + prod(:,309) = 0._r8 + prod(:,160) = 0._r8 + prod(:,219) = 0._r8 prod(:,266) = 0._r8 - prod(:,265) = 0._r8 prod(:,267) = 0._r8 - prod(:,248) = 0._r8 - prod(:,264) = 0._r8 - prod(:,268) = 0._r8 - prod(:,145) = 0._r8 - prod(:,162) = 0._r8 - prod(:,189) = 0._r8 - prod(:,170) = 0._r8 - prod(:,146) = 0._r8 - prod(:,147) = 0._r8 - prod(:,153) = 0._r8 - prod(:,45) = 0._r8 - prod(:,154) = 0._r8 - prod(:,46) = 0._r8 - prod(:,115) = 0._r8 - prod(:,286) =.050_r8*rxt(:,39)*y(:,55) + prod(:,92) = 0._r8 + prod(:,93) = 0._r8 + prod(:,94) = 0._r8 + prod(:,95) = 0._r8 + prod(:,255) = 0._r8 + prod(:,257) = 0._r8 + prod(:,203) = 0._r8 + prod(:,208) = 0._r8 + prod(:,198) = 0._r8 + prod(:,204) = 0._r8 + prod(:,229) = 0._r8 + prod(:,273) = 0._r8 + prod(:,220) = 0._r8 + prod(:,227) = 0._r8 + prod(:,49) = 0._r8 + prod(:,260) = 0._r8 + prod(:,259) = 0._r8 + prod(:,50) = 0._r8 + prod(:,287) = 0._r8 + prod(:,283) = 0._r8 + prod(:,52) = 0._r8 + prod(:,241) = 0._r8 + prod(:,179) = 0._r8 + prod(:,246) = 0._r8 + prod(:,185) = 0._r8 + prod(:,165) = 0._r8 + prod(:,238) = 0._r8 + prod(:,294) = 0._r8 + prod(:,298) = 0._r8 + prod(:,53) = 0._r8 + prod(:,247) = 0._r8 + prod(:,292) =rxt(:,5) + prod(:,310) = + extfrc(:,14) + prod(:,128) = 0._r8 + prod(:,186) = 0._r8 + prod(:,222) = 0._r8 + prod(:,187) = 0._r8 + prod(:,194) = 0._r8 + prod(:,295) = 0._r8 + prod(:,301) = 0._r8 + prod(:,297) = 0._r8 + prod(:,299) = 0._r8 + prod(:,276) = 0._r8 + prod(:,296) = 0._r8 + prod(:,300) = 0._r8 + prod(:,172) = 0._r8 + prod(:,188) = 0._r8 + prod(:,212) = 0._r8 + prod(:,195) = 0._r8 + prod(:,173) = 0._r8 + prod(:,174) = 0._r8 + prod(:,180) = 0._r8 + prod(:,54) = 0._r8 + prod(:,181) = 0._r8 + prod(:,55) = 0._r8 + prod(:,140) = 0._r8 + prod(:,315) = 0._r8 end if end subroutine indprd end module mo_indprd diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/mo_lin_matrix.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/mo_lin_matrix.F90 index 21d9263268..3f4b0b6aec 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/mo_lin_matrix.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/mo_lin_matrix.F90 @@ -23,208 +23,215 @@ subroutine linmat01( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,634) = -( rxt(k,19) + het_rates(k,1) ) - mat(k,645) = -( rxt(k,20) + het_rates(k,2) ) - mat(k,1102) = -( het_rates(k,4) ) - mat(k,1) = -( het_rates(k,5) ) - mat(k,2) = -( het_rates(k,6) ) - mat(k,859) = -( het_rates(k,7) ) - mat(k,131) = -( het_rates(k,8) ) - mat(k,322) = -( rxt(k,21) + het_rates(k,9) ) - mat(k,137) = -( rxt(k,22) + het_rates(k,10) ) - mat(k,383) = -( rxt(k,23) + het_rates(k,11) ) - mat(k,323) = .500_r8*rxt(k,21) - mat(k,138) = rxt(k,22) - mat(k,612) = .200_r8*rxt(k,115) - mat(k,730) = .060_r8*rxt(k,116) - mat(k,250) = -( rxt(k,24) + het_rates(k,12) ) - mat(k,610) = .200_r8*rxt(k,115) - mat(k,727) = .200_r8*rxt(k,116) - mat(k,328) = -( rxt(k,25) + het_rates(k,13) ) - mat(k,611) = .200_r8*rxt(k,115) - mat(k,729) = .150_r8*rxt(k,116) - mat(k,270) = -( rxt(k,26) + het_rates(k,14) ) - mat(k,728) = .210_r8*rxt(k,116) - mat(k,153) = -( het_rates(k,15) ) - mat(k,308) = -( het_rates(k,16) ) - mat(k,941) = -( het_rates(k,17) ) - mat(k,1685) = -( het_rates(k,18) ) - mat(k,196) = rxt(k,118) - mat(k,3785) = rxt(k,119) - mat(k,492) = rxt(k,121) - mat(k,1040) = rxt(k,143) - mat(k,907) = rxt(k,149) - mat(k,3099) = rxt(k,244)*y(k,35) + rxt(k,270)*y(k,36) & - + 3.000_r8*rxt(k,271)*y(k,56) + 2.000_r8*rxt(k,272)*y(k,80) & - + 2.000_r8*rxt(k,293)*y(k,42) + rxt(k,294)*y(k,44) - mat(k,3819) = 2.000_r8*rxt(k,281)*y(k,42) + rxt(k,283)*y(k,44) & - + 3.000_r8*rxt(k,288)*y(k,56) - mat(k,3704) = 2.000_r8*rxt(k,282)*y(k,42) + rxt(k,284)*y(k,44) & - + 3.000_r8*rxt(k,289)*y(k,56) - mat(k,195) = -( rxt(k,118) + het_rates(k,19) ) - mat(k,3800) = -( rxt(k,119) + het_rates(k,20) ) - mat(k,497) = rxt(k,120) - mat(k,490) = -( rxt(k,120) + rxt(k,121) + rxt(k,887) + rxt(k,890) + rxt(k,895) & + mat(k,716) = -( rxt(k,19) + het_rates(k,1) ) + mat(k,727) = -( rxt(k,20) + het_rates(k,2) ) + mat(k,1) = -( het_rates(k,3) ) + mat(k,1246) = -( het_rates(k,4) ) + mat(k,2) = -( het_rates(k,5) ) + mat(k,3) = -( het_rates(k,6) ) + mat(k,1028) = -( het_rates(k,7) ) + mat(k,180) = -( het_rates(k,8) ) + mat(k,414) = -( rxt(k,21) + het_rates(k,9) ) + mat(k,186) = -( rxt(k,22) + het_rates(k,10) ) + mat(k,465) = -( rxt(k,23) + het_rates(k,11) ) + mat(k,415) = .500_r8*rxt(k,21) + mat(k,187) = rxt(k,22) + mat(k,747) = .200_r8*rxt(k,115) + mat(k,828) = .060_r8*rxt(k,116) + mat(k,298) = -( rxt(k,24) + het_rates(k,12) ) + mat(k,745) = .200_r8*rxt(k,115) + mat(k,825) = .200_r8*rxt(k,116) + mat(k,398) = -( rxt(k,25) + het_rates(k,13) ) + mat(k,746) = .200_r8*rxt(k,115) + mat(k,827) = .150_r8*rxt(k,116) + mat(k,334) = -( rxt(k,26) + het_rates(k,14) ) + mat(k,826) = .210_r8*rxt(k,116) + mat(k,202) = -( het_rates(k,15) ) + mat(k,374) = -( het_rates(k,16) ) + mat(k,1090) = -( het_rates(k,17) ) + mat(k,2199) = -( het_rates(k,18) ) + mat(k,241) = rxt(k,118) + mat(k,2554) = rxt(k,119) + mat(k,576) = rxt(k,121) + mat(k,159) = rxt(k,123) + mat(k,165) = rxt(k,124) + mat(k,510) = 2.000_r8*rxt(k,130) + mat(k,640) = rxt(k,131) + mat(k,433) = 3.000_r8*rxt(k,134) + mat(k,126) = 2.000_r8*rxt(k,142) + mat(k,1157) = rxt(k,143) + mat(k,994) = rxt(k,149) + mat(k,240) = -( rxt(k,118) + het_rates(k,19) ) + mat(k,2555) = -( rxt(k,119) + het_rates(k,20) ) + mat(k,577) = rxt(k,120) + mat(k,574) = -( rxt(k,120) + rxt(k,121) + rxt(k,886) + rxt(k,889) + rxt(k,894) & + het_rates(k,21) ) - mat(k,198) = -( het_rates(k,23) ) - mat(k,285) = rxt(k,27) - mat(k,286) = -( rxt(k,27) + het_rates(k,24) ) - mat(k,253) = -( het_rates(k,25) ) - mat(k,498) = -( het_rates(k,26) ) - mat(k,218) = -( het_rates(k,27) ) - mat(k,291) = -( rxt(k,28) + het_rates(k,28) ) - mat(k,259) = -( het_rates(k,29) ) - mat(k,1197) = -( het_rates(k,30) ) - mat(k,1854) = .700_r8*rxt(k,79) - mat(k,338) = -( rxt(k,29) + het_rates(k,31) ) - mat(k,112) = -( het_rates(k,32) ) - mat(k,222) = -( rxt(k,30) + het_rates(k,33) ) - mat(k,3337) = -( rxt(k,31) + rxt(k,32) + het_rates(k,43) ) - mat(k,641) = .100_r8*rxt(k,19) - mat(k,653) = .100_r8*rxt(k,20) - mat(k,372) = rxt(k,37) - mat(k,571) = .500_r8*rxt(k,41) - mat(k,1472) = rxt(k,43) - mat(k,725) = rxt(k,45) - mat(k,1121) = rxt(k,46) - mat(k,885) = .330_r8*rxt(k,47) - mat(k,1615) = rxt(k,52) - mat(k,810) = rxt(k,55) + rxt(k,56) - mat(k,579) = rxt(k,65) - mat(k,479) = rxt(k,66) - mat(k,630) = rxt(k,68) - mat(k,1060) = rxt(k,69) - mat(k,1907) = rxt(k,71) - mat(k,1760) = rxt(k,72) - mat(k,1625) = .250_r8*rxt(k,74) - mat(k,1334) = .140_r8*rxt(k,75) - mat(k,1807) = .250_r8*rxt(k,80) - mat(k,1366) = .440_r8*rxt(k,81) - mat(k,1273) = rxt(k,83) - mat(k,1346) = rxt(k,84) - mat(k,487) = rxt(k,88) - mat(k,335) = rxt(k,89) - mat(k,598) = rxt(k,314) - mat(k,237) = 2.000_r8*rxt(k,344) - mat(k,1839) = rxt(k,428) - mat(k,1741) = rxt(k,434) - mat(k,3108) = rxt(k,317)*y(k,55) + rxt(k,318)*y(k,55) - mat(k,1305) = -( rxt(k,33) + het_rates(k,46) ) - mat(k,637) = .400_r8*rxt(k,19) - mat(k,649) = .400_r8*rxt(k,20) - mat(k,293) = rxt(k,28) - mat(k,877) = .330_r8*rxt(k,47) - mat(k,267) = rxt(k,77) - mat(k,484) = rxt(k,88) - mat(k,106) = -( het_rates(k,48) ) - mat(k,2141) = -( rxt(k,34) + het_rates(k,49) ) - mat(k,638) = .250_r8*rxt(k,19) - mat(k,650) = .250_r8*rxt(k,20) - mat(k,340) = .820_r8*rxt(k,29) - mat(k,881) = .170_r8*rxt(k,47) - mat(k,1845) = -( rxt(k,35) + het_rates(k,50) ) - mat(k,272) = rxt(k,26) - mat(k,569) = .500_r8*rxt(k,41) - mat(k,548) = .680_r8*rxt(k,48) - mat(k,561) = .670_r8*rxt(k,49) - mat(k,1702) = rxt(k,54) - mat(k,1028) = .500_r8*rxt(k,60) - mat(k,1637) = .500_r8*rxt(k,61) - mat(k,668) = .720_r8*rxt(k,63) - mat(k,1621) = .250_r8*rxt(k,74) - mat(k,1332) = .140_r8*rxt(k,75) - mat(k,1802) = .250_r8*rxt(k,80) - mat(k,1363) = .440_r8*rxt(k,81) - mat(k,620) = .400_r8*rxt(k,115) - mat(k,738) = .540_r8*rxt(k,116) - mat(k,353) = .510_r8*rxt(k,117) - mat(k,530) = -( het_rates(k,51) ) - mat(k,468) = -( rxt(k,36) + het_rates(k,52) ) - mat(k,1356) = -( het_rates(k,53) ) - mat(k,370) = -( rxt(k,37) + het_rates(k,54) ) - mat(k,3836) = -( rxt(k,219)*y(k,55) + rxt(k,281)*y(k,42) + rxt(k,283)*y(k,44) & - + rxt(k,286)*y(k,47) + rxt(k,288)*y(k,56) + het_rates(k,57) ) - mat(k,197) = rxt(k,118) - mat(k,129) = 2.000_r8*rxt(k,135) - mat(k,111) = 2.000_r8*rxt(k,136) - mat(k,3320) = rxt(k,137) - mat(k,1221) = rxt(k,138) - mat(k,159) = rxt(k,141) - mat(k,3777) = rxt(k,147) - mat(k,1069) = rxt(k,150) - mat(k,3115) = 4.000_r8*rxt(k,243)*y(k,34) + rxt(k,244)*y(k,35) & - + 2.000_r8*rxt(k,245)*y(k,37) + 2.000_r8*rxt(k,246)*y(k,38) & - + 2.000_r8*rxt(k,247)*y(k,39) + rxt(k,248)*y(k,40) & - + 2.000_r8*rxt(k,249)*y(k,41) + rxt(k,295)*y(k,84) & - + rxt(k,296)*y(k,85) + rxt(k,297)*y(k,86) - mat(k,3755) = 3.000_r8*rxt(k,285)*y(k,45) + rxt(k,287)*y(k,47) & - + rxt(k,290)*y(k,84) + rxt(k,291)*y(k,85) + rxt(k,292)*y(k,86) - mat(k,128) = -( rxt(k,135) + het_rates(k,58) ) - mat(k,109) = -( rxt(k,136) + rxt(k,253) + het_rates(k,59) ) - mat(k,3312) = -( rxt(k,137) + het_rates(k,60) ) - mat(k,1216) = rxt(k,139) - mat(k,278) = rxt(k,151) - mat(k,110) = 2.000_r8*rxt(k,253) - mat(k,1213) = -( rxt(k,138) + rxt(k,139) + rxt(k,889) + rxt(k,894) + rxt(k,900) & + mat(k,4) = -( het_rates(k,22) ) + mat(k,243) = -( het_rates(k,23) ) + mat(k,349) = rxt(k,27) + mat(k,350) = -( rxt(k,27) + het_rates(k,24) ) + mat(k,308) = -( het_rates(k,25) ) + mat(k,590) = -( het_rates(k,26) ) + mat(k,280) = -( het_rates(k,27) ) + mat(k,355) = -( rxt(k,28) + het_rates(k,28) ) + mat(k,314) = -( het_rates(k,29) ) + mat(k,1365) = -( het_rates(k,30) ) + mat(k,2037) = .700_r8*rxt(k,79) + mat(k,408) = -( rxt(k,29) + het_rates(k,31) ) + mat(k,128) = -( het_rates(k,32) ) + mat(k,284) = -( rxt(k,30) + het_rates(k,33) ) + mat(k,118) = -( rxt(k,122) + het_rates(k,34) ) + mat(k,157) = -( rxt(k,123) + het_rates(k,35) ) + mat(k,162) = -( rxt(k,124) + het_rates(k,36) ) + mat(k,132) = -( rxt(k,125) + het_rates(k,37) ) + mat(k,167) = -( rxt(k,126) + het_rates(k,38) ) + mat(k,136) = -( rxt(k,127) + het_rates(k,39) ) + mat(k,172) = -( rxt(k,128) + het_rates(k,40) ) + mat(k,140) = -( rxt(k,129) + het_rates(k,41) ) + mat(k,509) = -( rxt(k,130) + het_rates(k,42) ) + mat(k,3358) = -( rxt(k,31) + rxt(k,32) + het_rates(k,43) ) + mat(k,722) = .100_r8*rxt(k,19) + mat(k,734) = .100_r8*rxt(k,20) + mat(k,461) = rxt(k,37) + mat(k,2264) = .180_r8*rxt(k,39) + mat(k,636) = .500_r8*rxt(k,41) + mat(k,1712) = rxt(k,43) + mat(k,822) = rxt(k,45) + mat(k,1210) = rxt(k,46) + mat(k,980) = .330_r8*rxt(k,47) + mat(k,1759) = rxt(k,52) + mat(k,965) = rxt(k,55) + rxt(k,56) + mat(k,615) = rxt(k,65) + mat(k,562) = rxt(k,66) + mat(k,764) = rxt(k,68) + mat(k,1190) = rxt(k,69) + mat(k,1904) = rxt(k,71) + mat(k,2028) = rxt(k,72) + mat(k,1730) = .250_r8*rxt(k,74) + mat(k,1463) = .140_r8*rxt(k,75) + mat(k,1932) = .250_r8*rxt(k,80) + mat(k,1501) = .440_r8*rxt(k,81) + mat(k,1455) = rxt(k,83) + mat(k,1482) = rxt(k,84) + mat(k,586) = rxt(k,88) + mat(k,405) = rxt(k,89) + mat(k,695) = rxt(k,313) + mat(k,290) = 2.000_r8*rxt(k,343) + mat(k,1967) = rxt(k,427) + mat(k,2006) = rxt(k,433) + mat(k,639) = -( rxt(k,131) + het_rates(k,44) ) + mat(k,144) = -( rxt(k,132) + het_rates(k,45) ) + mat(k,1429) = -( rxt(k,33) + het_rates(k,46) ) + mat(k,719) = .400_r8*rxt(k,19) + mat(k,731) = .400_r8*rxt(k,20) + mat(k,357) = rxt(k,28) + mat(k,973) = .330_r8*rxt(k,47) + mat(k,331) = rxt(k,77) + mat(k,584) = rxt(k,88) + mat(k,390) = -( rxt(k,133) + het_rates(k,47) ) + mat(k,121) = -( het_rates(k,48) ) + mat(k,2277) = -( rxt(k,34) + het_rates(k,49) ) + mat(k,720) = .250_r8*rxt(k,19) + mat(k,732) = .250_r8*rxt(k,20) + mat(k,410) = .820_r8*rxt(k,29) + mat(k,977) = .170_r8*rxt(k,47) + mat(k,1909) = -( rxt(k,35) + het_rates(k,50) ) + mat(k,335) = rxt(k,26) + mat(k,634) = .500_r8*rxt(k,41) + mat(k,625) = .680_r8*rxt(k,48) + mat(k,683) = .670_r8*rxt(k,49) + mat(k,1871) = rxt(k,54) + mat(k,1113) = .500_r8*rxt(k,60) + mat(k,1792) = .500_r8*rxt(k,61) + mat(k,777) = .720_r8*rxt(k,63) + mat(k,1727) = .250_r8*rxt(k,74) + mat(k,1461) = .140_r8*rxt(k,75) + mat(k,1927) = .250_r8*rxt(k,80) + mat(k,1498) = .440_r8*rxt(k,81) + mat(k,754) = .400_r8*rxt(k,115) + mat(k,835) = .540_r8*rxt(k,116) + mat(k,429) = .510_r8*rxt(k,117) + mat(k,789) = -( het_rates(k,51) ) + mat(k,700) = -( rxt(k,36) + het_rates(k,52) ) + mat(k,1492) = -( het_rates(k,53) ) + mat(k,459) = -( rxt(k,37) + het_rates(k,54) ) + mat(k,2259) = -( rxt(k,38) + rxt(k,39) + het_rates(k,55) ) + mat(k,432) = -( rxt(k,134) + het_rates(k,56) ) + mat(k,3864) = -( het_rates(k,57) ) + mat(k,242) = rxt(k,118) + mat(k,120) = 4.000_r8*rxt(k,122) + mat(k,161) = rxt(k,123) + mat(k,135) = 2.000_r8*rxt(k,125) + mat(k,171) = 2.000_r8*rxt(k,126) + mat(k,139) = 2.000_r8*rxt(k,127) + mat(k,176) = rxt(k,128) + mat(k,143) = 2.000_r8*rxt(k,129) + mat(k,146) = 3.000_r8*rxt(k,132) + mat(k,395) = rxt(k,133) + mat(k,178) = 2.000_r8*rxt(k,135) + mat(k,114) = 2.000_r8*rxt(k,136) + mat(k,2607) = rxt(k,137) + mat(k,1329) = rxt(k,138) + mat(k,254) = rxt(k,141) + mat(k,250) = rxt(k,144) + mat(k,259) = rxt(k,145) + mat(k,306) = rxt(k,146) + mat(k,3158) = rxt(k,147) + mat(k,1147) = rxt(k,150) + mat(k,177) = -( rxt(k,135) + het_rates(k,58) ) + mat(k,112) = -( rxt(k,136) + rxt(k,253) + het_rates(k,59) ) + mat(k,2597) = -( rxt(k,137) + het_rates(k,60) ) + mat(k,1324) = rxt(k,139) + mat(k,342) = rxt(k,151) + mat(k,113) = 2.000_r8*rxt(k,253) + mat(k,1323) = -( rxt(k,138) + rxt(k,139) + rxt(k,888) + rxt(k,893) + rxt(k,899) & + het_rates(k,61) ) - mat(k,1540) = -( het_rates(k,63) ) - mat(k,139) = 1.500_r8*rxt(k,22) - mat(k,330) = .600_r8*rxt(k,25) - mat(k,271) = rxt(k,26) - mat(k,3327) = rxt(k,31) + rxt(k,32) - mat(k,1306) = rxt(k,33) - mat(k,1844) = rxt(k,35) - mat(k,568) = .500_r8*rxt(k,41) - mat(k,1470) = rxt(k,43) - mat(k,1177) = 2.000_r8*rxt(k,44) - mat(k,723) = rxt(k,45) - mat(k,879) = .330_r8*rxt(k,47) - mat(k,547) = 1.320_r8*rxt(k,48) - mat(k,559) = 1.740_r8*rxt(k,49) - mat(k,422) = rxt(k,50) - mat(k,429) = rxt(k,51) - mat(k,1697) = 1.500_r8*rxt(k,53) + rxt(k,54) - mat(k,1923) = .550_r8*rxt(k,64) - mat(k,1957) = .550_r8*rxt(k,67) - mat(k,1748) = 1.650_r8*rxt(k,72) - mat(k,1618) = .750_r8*rxt(k,74) - mat(k,1330) = .860_r8*rxt(k,75) - mat(k,1859) = .700_r8*rxt(k,79) - mat(k,1271) = rxt(k,83) - mat(k,174) = 1.500_r8*rxt(k,90) - mat(k,2192) = rxt(k,93) - mat(k,1168) = rxt(k,94) - mat(k,1644) = rxt(k,96) - mat(k,304) = rxt(k,154) - mat(k,1384) = rxt(k,385) - mat(k,1481) = rxt(k,501) - mat(k,1777) = .600_r8*rxt(k,530) - mat(k,1664) = .600_r8*rxt(k,533) - mat(k,3818) = rxt(k,286)*y(k,47) - mat(k,122) = -( rxt(k,140) + het_rates(k,65) ) - mat(k,3093) = rxt(k,244)*y(k,35) + rxt(k,246)*y(k,38) & - + 2.000_r8*rxt(k,247)*y(k,39) + 2.000_r8*rxt(k,248)*y(k,40) & - + rxt(k,249)*y(k,41) + rxt(k,270)*y(k,36) & - + 2.000_r8*rxt(k,272)*y(k,80) + rxt(k,296)*y(k,85) & - + rxt(k,297)*y(k,86) - mat(k,3537) = rxt(k,291)*y(k,85) + rxt(k,292)*y(k,86) - mat(k,156) = -( rxt(k,141) + het_rates(k,66) ) - mat(k,3095) = rxt(k,245)*y(k,37) + rxt(k,246)*y(k,38) + rxt(k,295)*y(k,84) - mat(k,3544) = rxt(k,290)*y(k,84) - mat(k,168) = -( het_rates(k,67) ) - mat(k,566) = -( rxt(k,41) + het_rates(k,68) ) - mat(k,1768) = .600_r8*rxt(k,530) - mat(k,1656) = .600_r8*rxt(k,533) - mat(k,238) = -( het_rates(k,69) ) - mat(k,3) = -( het_rates(k,70) ) - mat(k,4) = -( het_rates(k,71) ) - mat(k,5) = -( het_rates(k,72) ) - mat(k,116) = -( rxt(k,42) + het_rates(k,74) ) - mat(k,897) = -( rxt(k,275)*y(k,55) + het_rates(k,75) ) - mat(k,123) = 2.000_r8*rxt(k,140) - mat(k,157) = rxt(k,141) - mat(k,193) = rxt(k,148) - mat(k,3096) = rxt(k,248)*y(k,40) + rxt(k,270)*y(k,36) + mat(k,5) = -( het_rates(k,62) ) + mat(k,1918) = -( het_rates(k,63) ) + mat(k,188) = 1.500_r8*rxt(k,22) + mat(k,400) = .600_r8*rxt(k,25) + mat(k,336) = rxt(k,26) + mat(k,3347) = rxt(k,31) + rxt(k,32) + mat(k,1430) = rxt(k,33) + mat(k,1910) = rxt(k,35) + mat(k,2258) = .380_r8*rxt(k,39) + mat(k,1612) = rxt(k,40) + mat(k,635) = .500_r8*rxt(k,41) + mat(k,1711) = rxt(k,43) + mat(k,1476) = 2.000_r8*rxt(k,44) + mat(k,821) = rxt(k,45) + mat(k,976) = .330_r8*rxt(k,47) + mat(k,626) = 1.320_r8*rxt(k,48) + mat(k,684) = 1.740_r8*rxt(k,49) + mat(k,484) = rxt(k,50) + mat(k,501) = rxt(k,51) + mat(k,1872) = 1.500_r8*rxt(k,53) + rxt(k,54) + mat(k,2108) = .550_r8*rxt(k,64) + mat(k,2076) = .550_r8*rxt(k,67) + mat(k,2021) = 1.650_r8*rxt(k,72) + mat(k,1728) = .750_r8*rxt(k,74) + mat(k,1462) = .860_r8*rxt(k,75) + mat(k,2045) = .700_r8*rxt(k,79) + mat(k,1454) = rxt(k,83) + mat(k,222) = 1.500_r8*rxt(k,90) + mat(k,2365) = rxt(k,93) + mat(k,1288) = rxt(k,94) + mat(k,1717) = rxt(k,96) + mat(k,386) = rxt(k,154) + mat(k,1546) = rxt(k,384) + mat(k,1644) = rxt(k,500) + mat(k,1850) = .600_r8*rxt(k,529) + mat(k,1819) = .600_r8*rxt(k,532) + mat(k,1611) = -( rxt(k,40) + het_rates(k,64) ) + mat(k,701) = rxt(k,36) + mat(k,2256) = .440_r8*rxt(k,39) + mat(k,624) = .170_r8*rxt(k,48) + mat(k,682) = .280_r8*rxt(k,49) + mat(k,1866) = rxt(k,54) + mat(k,567) = .400_r8*rxt(k,86) + mat(k,769) = rxt(k,98) + mat(k,361) = rxt(k,99) + mat(k,366) = rxt(k,100) end do end subroutine linmat01 subroutine linmat02( avec_len, mat, y, rxt, het_rates ) @@ -247,222 +254,207 @@ subroutine linmat02( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,1469) = -( rxt(k,43) + het_rates(k,76) ) - mat(k,878) = .330_r8*rxt(k,47) - mat(k,1696) = .500_r8*rxt(k,53) - mat(k,1528) = rxt(k,59) - mat(k,1023) = .500_r8*rxt(k,60) - mat(k,1631) = .500_r8*rxt(k,61) - mat(k,1337) = rxt(k,62) - mat(k,665) = .720_r8*rxt(k,63) - mat(k,1799) = .500_r8*rxt(k,80) - mat(k,1361) = .560_r8*rxt(k,81) - mat(k,235) = rxt(k,345) - mat(k,1176) = -( rxt(k,44) + rxt(k,812) + het_rates(k,77) ) - mat(k,325) = rxt(k,21) - mat(k,1022) = .500_r8*rxt(k,60) - mat(k,1628) = .500_r8*rxt(k,61) - mat(k,664) = .280_r8*rxt(k,63) - mat(k,282) = .700_r8*rxt(k,87) - mat(k,618) = .600_r8*rxt(k,115) - mat(k,736) = .340_r8*rxt(k,116) - mat(k,352) = .170_r8*rxt(k,117) - mat(k,2730) = -( rxt(k,181) + het_rates(k,78) ) - mat(k,3847) = rxt(k,2) + 2.000_r8*rxt(k,3) - mat(k,3330) = 2.000_r8*rxt(k,31) - mat(k,371) = rxt(k,37) - mat(k,1041) = rxt(k,143) - mat(k,3764) = rxt(k,147) - mat(k,194) = rxt(k,148) - mat(k,3101) = rxt(k,317)*y(k,55) - mat(k,1416) = -( het_rates(k,79) ) - mat(k,3843) = rxt(k,1) - mat(k,3326) = rxt(k,32) - mat(k,3098) = rxt(k,318)*y(k,55) - mat(k,1349) = -( rxt(k,4) + het_rates(k,81) ) - mat(k,3218) = .500_r8*rxt(k,813) - mat(k,119) = -( rxt(k,153) + het_rates(k,82) ) - mat(k,1039) = -( rxt(k,143) + het_rates(k,83) ) - mat(k,3775) = -( rxt(k,147) + het_rates(k,87) ) - mat(k,3834) = rxt(k,219)*y(k,55) + rxt(k,281)*y(k,42) + rxt(k,283)*y(k,44) & - + 2.000_r8*rxt(k,286)*y(k,47) + rxt(k,288)*y(k,56) - mat(k,146) = -( het_rates(k,88) ) - mat(k,721) = -( rxt(k,45) + het_rates(k,89) ) - mat(k,1124) = -( het_rates(k,90) ) - mat(k,544) = .410_r8*rxt(k,48) - mat(k,192) = -( rxt(k,148) + het_rates(k,91) ) - mat(k,896) = rxt(k,275)*y(k,55) - mat(k,1118) = -( rxt(k,46) + het_rates(k,92) ) - mat(k,2717) = -( rxt(k,9) + het_rates(k,93) ) - mat(k,883) = rxt(k,814) - mat(k,414) = rxt(k,817) - mat(k,1090) = rxt(k,818) - mat(k,1452) = rxt(k,819) - mat(k,1535) = rxt(k,820) - mat(k,1029) = rxt(k,821) - mat(k,1933) = rxt(k,825) - mat(k,577) = rxt(k,826) - mat(k,1967) = rxt(k,827) - mat(k,245) = 2.000_r8*rxt(k,828) + 2.000_r8*rxt(k,885) + 2.000_r8*rxt(k,888) & - + 2.000_r8*rxt(k,899) - mat(k,1995) = rxt(k,829) - mat(k,3500) = .500_r8*rxt(k,831) - mat(k,3076) = rxt(k,832) - mat(k,151) = rxt(k,833) - mat(k,1156) = rxt(k,836) - mat(k,675) = rxt(k,838) - mat(k,1035) = rxt(k,839) - mat(k,1606) = rxt(k,840) - mat(k,1398) = rxt(k,841) - mat(k,493) = rxt(k,887) + rxt(k,890) + rxt(k,895) - mat(k,1214) = rxt(k,889) + rxt(k,894) + rxt(k,900) - mat(k,364) = -( rxt(k,10) + rxt(k,11) + rxt(k,216) + het_rates(k,94) ) - mat(k,906) = -( rxt(k,149) + het_rates(k,95) ) - mat(k,491) = rxt(k,887) + rxt(k,890) + rxt(k,895) - mat(k,1064) = -( rxt(k,150) + het_rates(k,96) ) - mat(k,1212) = rxt(k,889) + rxt(k,894) + rxt(k,900) - mat(k,876) = -( rxt(k,47) + rxt(k,814) + het_rates(k,97) ) - mat(k,542) = -( rxt(k,48) + het_rates(k,98) ) - mat(k,1767) = .250_r8*rxt(k,530) - mat(k,554) = -( rxt(k,49) + het_rates(k,99) ) - mat(k,1655) = .250_r8*rxt(k,533) - mat(k,419) = -( rxt(k,50) + het_rates(k,100) ) - mat(k,1766) = .150_r8*rxt(k,530) - mat(k,426) = -( rxt(k,51) + het_rates(k,101) ) - mat(k,1654) = .150_r8*rxt(k,533) - mat(k,1611) = -( rxt(k,52) + het_rates(k,102) ) - mat(k,880) = .170_r8*rxt(k,47) - mat(k,1698) = .500_r8*rxt(k,53) - mat(k,1531) = rxt(k,59) - mat(k,1025) = .500_r8*rxt(k,60) - mat(k,1633) = .500_r8*rxt(k,61) - mat(k,1338) = rxt(k,62) - mat(k,667) = .280_r8*rxt(k,63) - mat(k,1619) = .500_r8*rxt(k,74) - mat(k,1331) = .860_r8*rxt(k,75) - mat(k,1385) = rxt(k,385) - mat(k,1700) = -( rxt(k,53) + rxt(k,54) + het_rates(k,103) ) - mat(k,1927) = .450_r8*rxt(k,64) - mat(k,1961) = .450_r8*rxt(k,67) - mat(k,1990) = rxt(k,82) - mat(k,807) = -( rxt(k,55) + rxt(k,56) + het_rates(k,104) ) - mat(k,567) = .500_r8*rxt(k,41) - mat(k,1236) = -( rxt(k,815) + het_rates(k,105) ) - mat(k,411) = rxt(k,57) - mat(k,1084) = rxt(k,58) - mat(k,802) = -( rxt(k,816) + het_rates(k,106) ) - mat(k,409) = -( rxt(k,57) + rxt(k,817) + het_rates(k,107) ) - mat(k,1083) = -( rxt(k,58) + rxt(k,818) + het_rates(k,108) ) - mat(k,1285) = -( het_rates(k,109) ) - mat(k,1529) = -( rxt(k,59) + rxt(k,820) + het_rates(k,110) ) - mat(k,1021) = -( rxt(k,60) + rxt(k,821) + het_rates(k,111) ) - mat(k,1635) = -( rxt(k,61) + rxt(k,822) + het_rates(k,112) ) - mat(k,1077) = rxt(k,463) - mat(k,988) = rxt(k,466) - mat(k,1336) = -( rxt(k,62) + rxt(k,823) + het_rates(k,113) ) - mat(k,1000) = rxt(k,459) - mat(k,1012) = rxt(k,469) - mat(k,1182) = rxt(k,481) - mat(k,1257) = rxt(k,484) - mat(k,663) = -( rxt(k,63) + rxt(k,824) + het_rates(k,114) ) - mat(k,1930) = -( rxt(k,64) + rxt(k,825) + het_rates(k,115) ) - mat(k,573) = -( rxt(k,65) + rxt(k,826) + het_rates(k,116) ) - mat(k,474) = -( rxt(k,66) + het_rates(k,117) ) - mat(k,1964) = -( rxt(k,67) + rxt(k,827) + het_rates(k,118) ) - mat(k,623) = -( rxt(k,68) + het_rates(k,119) ) - mat(k,1048) = -( rxt(k,69) + het_rates(k,120) ) - mat(k,1439) = -( rxt(k,70) + rxt(k,819) + het_rates(k,121) ) - mat(k,797) = -( het_rates(k,122) ) - mat(k,1896) = -( rxt(k,71) + het_rates(k,123) ) - mat(k,78) = -( het_rates(k,124) ) - mat(k,961) = -( het_rates(k,125) ) - mat(k,1751) = -( rxt(k,72) + rxt(k,73) + het_rates(k,126) ) - mat(k,430) = rxt(k,51) - mat(k,477) = rxt(k,66) - mat(k,626) = .500_r8*rxt(k,68) - mat(k,1053) = .120_r8*rxt(k,69) - mat(k,1891) = .300_r8*rxt(k,71) - mat(k,1730) = rxt(k,434) - mat(k,1620) = -( rxt(k,74) + het_rates(k,127) ) - mat(k,1483) = .510_r8*rxt(k,501) - mat(k,1329) = -( rxt(k,75) + het_rates(k,128) ) - mat(k,1916) = .550_r8*rxt(k,64) - mat(k,450) = -( rxt(k,76) + het_rates(k,129) ) - mat(k,633) = .800_r8*rxt(k,19) - mat(k,644) = .800_r8*rxt(k,20) - mat(k,265) = -( rxt(k,77) + het_rates(k,130) ) - mat(k,391) = -( rxt(k,78) + rxt(k,408) + het_rates(k,131) ) - mat(k,1863) = -( rxt(k,79) + het_rates(k,132) ) - mat(k,423) = rxt(k,50) - mat(k,576) = rxt(k,65) - mat(k,627) = .500_r8*rxt(k,68) - mat(k,1055) = .880_r8*rxt(k,69) - mat(k,1895) = .700_r8*rxt(k,71) - mat(k,1831) = rxt(k,428) - mat(k,1801) = -( rxt(k,80) + het_rates(k,133) ) - mat(k,1485) = .490_r8*rxt(k,501) - mat(k,1360) = -( rxt(k,81) + het_rates(k,134) ) - mat(k,1953) = .550_r8*rxt(k,67) - mat(k,710) = -( het_rates(k,135) ) - mat(k,316) = -( rxt(k,198) + het_rates(k,136) ) - mat(k,2762) = rxt(k,15) - mat(k,244) = -( rxt(k,13) + rxt(k,14) + rxt(k,217) + rxt(k,828) + rxt(k,885) & - + rxt(k,888) + rxt(k,899) + het_rates(k,138) ) - mat(k,1993) = -( rxt(k,82) + rxt(k,829) + het_rates(k,139) ) - mat(k,1449) = rxt(k,70) - mat(k,6) = -( het_rates(k,140) ) - mat(k,7) = -( het_rates(k,141) ) - mat(k,8) = -( het_rates(k,142) ) - mat(k,103) = -( het_rates(k,143) ) - mat(k,9) = -( rxt(k,830) + het_rates(k,144) ) - mat(k,2885) = -( rxt(k,15) + het_rates(k,147) ) - mat(k,246) = rxt(k,14) - mat(k,3502) = rxt(k,16) + .500_r8*rxt(k,831) - mat(k,3078) = rxt(k,17) - mat(k,318) = rxt(k,198) - mat(k,3102) = 2.000_r8*rxt(k,210)*y(k,137) - mat(k,3511) = -( rxt(k,16) + rxt(k,831) + het_rates(k,148) ) - mat(k,2723) = rxt(k,9) - mat(k,367) = rxt(k,11) + rxt(k,216) - mat(k,249) = rxt(k,13) + rxt(k,217) - mat(k,3087) = rxt(k,18) - mat(k,642) = rxt(k,19) - mat(k,886) = rxt(k,47) - mat(k,417) = rxt(k,57) - mat(k,1093) = rxt(k,58) - mat(k,1538) = 2.000_r8*rxt(k,59) - mat(k,1030) = 2.000_r8*rxt(k,60) - mat(k,1642) = rxt(k,61) - mat(k,1341) = rxt(k,62) - mat(k,1941) = rxt(k,64) - mat(k,580) = rxt(k,65) - mat(k,480) = rxt(k,66) - mat(k,1975) = rxt(k,67) - mat(k,631) = rxt(k,68) - mat(k,1061) = rxt(k,69) - mat(k,1626) = .750_r8*rxt(k,74) - mat(k,396) = rxt(k,78) + rxt(k,408) - mat(k,1808) = .750_r8*rxt(k,80) - mat(k,2003) = rxt(k,82) - mat(k,1274) = rxt(k,83) - mat(k,1347) = rxt(k,84) - mat(k,152) = rxt(k,85) - mat(k,403) = .600_r8*rxt(k,86) + rxt(k,353) - mat(k,512) = rxt(k,95) + rxt(k,791) - mat(k,520) = rxt(k,97) + rxt(k,792) - mat(k,348) = rxt(k,101) + rxt(k,793) - mat(k,1158) = rxt(k,103) - mat(k,893) = .500_r8*rxt(k,105) - mat(k,587) = .460_r8*rxt(k,106) - mat(k,1036) = rxt(k,107) - mat(k,677) = .460_r8*rxt(k,108) - mat(k,1466) = rxt(k,109) - mat(k,1596) = rxt(k,110) - mat(k,1400) = rxt(k,111) - mat(k,1609) = rxt(k,112) - mat(k,496) = rxt(k,120) - mat(k,1218) = rxt(k,139) - mat(k,127) = rxt(k,576) + mat(k,260) = -( rxt(k,140) + het_rates(k,65) ) + mat(k,158) = rxt(k,123) + mat(k,163) = rxt(k,124) + mat(k,169) = rxt(k,126) + mat(k,137) = 2.000_r8*rxt(k,127) + mat(k,173) = 2.000_r8*rxt(k,128) + mat(k,141) = rxt(k,129) + mat(k,125) = 2.000_r8*rxt(k,142) + mat(k,256) = rxt(k,145) + mat(k,301) = rxt(k,146) + mat(k,251) = -( rxt(k,141) + het_rates(k,66) ) + mat(k,133) = rxt(k,125) + mat(k,168) = rxt(k,126) + mat(k,247) = rxt(k,144) + mat(k,216) = -( het_rates(k,67) ) + mat(k,632) = -( rxt(k,41) + het_rates(k,68) ) + mat(k,1835) = .600_r8*rxt(k,529) + mat(k,1803) = .600_r8*rxt(k,532) + mat(k,320) = -( het_rates(k,69) ) + mat(k,6) = -( het_rates(k,70) ) + mat(k,7) = -( het_rates(k,71) ) + mat(k,8) = -( het_rates(k,72) ) + mat(k,9) = -( rxt(k,901) + het_rates(k,73) ) + mat(k,148) = -( rxt(k,42) + het_rates(k,74) ) + mat(k,1278) = -( het_rates(k,75) ) + mat(k,164) = rxt(k,124) + mat(k,174) = rxt(k,128) + mat(k,261) = 2.000_r8*rxt(k,140) + mat(k,252) = rxt(k,141) + mat(k,327) = rxt(k,148) + mat(k,1710) = -( rxt(k,43) + het_rates(k,76) ) + mat(k,974) = .330_r8*rxt(k,47) + mat(k,1867) = .500_r8*rxt(k,53) + mat(k,1658) = rxt(k,59) + mat(k,1110) = .500_r8*rxt(k,60) + mat(k,1788) = .500_r8*rxt(k,61) + mat(k,1467) = rxt(k,62) + mat(k,775) = .720_r8*rxt(k,63) + mat(k,1926) = .500_r8*rxt(k,80) + mat(k,1497) = .560_r8*rxt(k,81) + mat(k,289) = rxt(k,344) + mat(k,1474) = -( rxt(k,44) + rxt(k,811) + het_rates(k,77) ) + mat(k,417) = rxt(k,21) + mat(k,1109) = .500_r8*rxt(k,60) + mat(k,1785) = .500_r8*rxt(k,61) + mat(k,774) = .280_r8*rxt(k,63) + mat(k,346) = .700_r8*rxt(k,87) + mat(k,753) = .600_r8*rxt(k,115) + mat(k,834) = .340_r8*rxt(k,116) + mat(k,428) = .170_r8*rxt(k,117) + mat(k,2573) = -( rxt(k,181) + het_rates(k,78) ) + mat(k,4117) = rxt(k,2) + 2.000_r8*rxt(k,3) + mat(k,3351) = 2.000_r8*rxt(k,31) + mat(k,460) = rxt(k,37) + mat(k,2260) = rxt(k,38) + .330_r8*rxt(k,39) + mat(k,1159) = rxt(k,143) + mat(k,3147) = rxt(k,147) + mat(k,328) = rxt(k,148) + mat(k,1671) = -( het_rates(k,79) ) + mat(k,4113) = rxt(k,1) + mat(k,3346) = rxt(k,32) + mat(k,2257) = 1.440_r8*rxt(k,39) + mat(k,124) = -( rxt(k,142) + het_rates(k,80) ) + mat(k,1485) = -( rxt(k,4) + het_rates(k,81) ) + mat(k,151) = -( rxt(k,153) + het_rates(k,82) ) + mat(k,1156) = -( rxt(k,143) + het_rates(k,83) ) + mat(k,246) = -( rxt(k,144) + het_rates(k,84) ) + mat(k,255) = -( rxt(k,145) + het_rates(k,85) ) + mat(k,302) = -( rxt(k,146) + het_rates(k,86) ) + mat(k,3151) = -( rxt(k,147) + het_rates(k,87) ) + mat(k,195) = -( het_rates(k,88) ) + mat(k,819) = -( rxt(k,45) + het_rates(k,89) ) + mat(k,1357) = -( het_rates(k,90) ) + mat(k,622) = .410_r8*rxt(k,48) + mat(k,326) = -( rxt(k,148) + het_rates(k,91) ) + mat(k,1208) = -( rxt(k,46) + het_rates(k,92) ) + mat(k,3331) = -( rxt(k,9) + het_rates(k,93) ) + mat(k,979) = rxt(k,813) + mat(k,493) = rxt(k,816) + mat(k,1272) = rxt(k,817) + mat(k,1587) = rxt(k,818) + mat(k,1664) = rxt(k,819) + mat(k,1116) = rxt(k,820) + mat(k,2116) = rxt(k,824) + mat(k,614) = rxt(k,825) + mat(k,2084) = rxt(k,826) + mat(k,294) = 2.000_r8*rxt(k,827) + 2.000_r8*rxt(k,884) + 2.000_r8*rxt(k,887) & + + 2.000_r8*rxt(k,898) + mat(k,2145) = rxt(k,828) + mat(k,4097) = .500_r8*rxt(k,830) + mat(k,3953) = rxt(k,831) + mat(k,206) = rxt(k,832) + mat(k,1228) = rxt(k,835) + mat(k,785) = rxt(k,837) + mat(k,1152) = rxt(k,838) + mat(k,1704) = rxt(k,839) + mat(k,1536) = rxt(k,840) + mat(k,578) = rxt(k,886) + rxt(k,889) + rxt(k,894) + mat(k,1326) = rxt(k,888) + rxt(k,893) + rxt(k,899) + mat(k,446) = -( rxt(k,10) + rxt(k,11) + rxt(k,216) + het_rates(k,94) ) + mat(k,993) = -( rxt(k,149) + het_rates(k,95) ) + mat(k,575) = rxt(k,886) + rxt(k,889) + rxt(k,894) + mat(k,1142) = -( rxt(k,150) + het_rates(k,96) ) + mat(k,1322) = rxt(k,888) + rxt(k,893) + rxt(k,899) + mat(k,972) = -( rxt(k,47) + rxt(k,813) + het_rates(k,97) ) + mat(k,619) = -( rxt(k,48) + het_rates(k,98) ) + mat(k,1834) = .250_r8*rxt(k,529) + mat(k,678) = -( rxt(k,49) + het_rates(k,99) ) + mat(k,1804) = .250_r8*rxt(k,532) + mat(k,481) = -( rxt(k,50) + het_rates(k,100) ) + mat(k,1833) = .150_r8*rxt(k,529) + mat(k,498) = -( rxt(k,51) + het_rates(k,101) ) + mat(k,1802) = .150_r8*rxt(k,532) + mat(k,1756) = -( rxt(k,52) + het_rates(k,102) ) + mat(k,975) = .170_r8*rxt(k,47) + mat(k,1868) = .500_r8*rxt(k,53) + mat(k,1660) = rxt(k,59) + mat(k,1112) = .500_r8*rxt(k,60) + mat(k,1790) = .500_r8*rxt(k,61) + mat(k,1468) = rxt(k,62) + mat(k,776) = .280_r8*rxt(k,63) + mat(k,1726) = .500_r8*rxt(k,74) + mat(k,1460) = .860_r8*rxt(k,75) + mat(k,1544) = rxt(k,384) + mat(k,1870) = -( rxt(k,53) + rxt(k,54) + het_rates(k,103) ) + mat(k,2106) = .450_r8*rxt(k,64) + mat(k,2074) = .450_r8*rxt(k,67) + mat(k,2136) = rxt(k,82) + mat(k,962) = -( rxt(k,55) + rxt(k,56) + het_rates(k,104) ) + mat(k,633) = .500_r8*rxt(k,41) + mat(k,917) = -( rxt(k,814) + het_rates(k,105) ) + mat(k,489) = rxt(k,57) + mat(k,1263) = rxt(k,58) + mat(k,1522) = -( rxt(k,815) + het_rates(k,106) ) + mat(k,488) = -( rxt(k,57) + rxt(k,816) + het_rates(k,107) ) + mat(k,1264) = -( rxt(k,58) + rxt(k,817) + het_rates(k,108) ) + mat(k,1390) = -( het_rates(k,109) ) + mat(k,1657) = -( rxt(k,59) + rxt(k,819) + het_rates(k,110) ) + mat(k,1108) = -( rxt(k,60) + rxt(k,820) + het_rates(k,111) ) + mat(k,1791) = -( rxt(k,61) + rxt(k,821) + het_rates(k,112) ) + mat(k,1170) = rxt(k,462) + mat(k,1055) = rxt(k,465) + mat(k,1466) = -( rxt(k,62) + rxt(k,822) + het_rates(k,113) ) + mat(k,1120) = rxt(k,458) + mat(k,1132) = rxt(k,468) + mat(k,1309) = rxt(k,480) + mat(k,1415) = rxt(k,483) + mat(k,773) = -( rxt(k,63) + rxt(k,823) + het_rates(k,114) ) + mat(k,2110) = -( rxt(k,64) + rxt(k,824) + het_rates(k,115) ) + mat(k,610) = -( rxt(k,65) + rxt(k,825) + het_rates(k,116) ) + mat(k,558) = -( rxt(k,66) + het_rates(k,117) ) + mat(k,2078) = -( rxt(k,67) + rxt(k,826) + het_rates(k,118) ) + mat(k,758) = -( rxt(k,68) + het_rates(k,119) ) + mat(k,1178) = -( rxt(k,69) + het_rates(k,120) ) + mat(k,1570) = -( rxt(k,70) + rxt(k,818) + het_rates(k,121) ) + mat(k,912) = -( het_rates(k,122) ) + mat(k,1894) = -( rxt(k,71) + het_rates(k,123) ) + mat(k,87) = -( het_rates(k,124) ) + mat(k,1069) = -( het_rates(k,125) ) + mat(k,2022) = -( rxt(k,72) + rxt(k,73) + het_rates(k,126) ) + mat(k,502) = rxt(k,51) + mat(k,561) = rxt(k,66) + mat(k,761) = .500_r8*rxt(k,68) + mat(k,1185) = .120_r8*rxt(k,69) + mat(k,1900) = .300_r8*rxt(k,71) + mat(k,1998) = rxt(k,433) + mat(k,1725) = -( rxt(k,74) + het_rates(k,127) ) + mat(k,1640) = .510_r8*rxt(k,500) + mat(k,1459) = -( rxt(k,75) + het_rates(k,128) ) + mat(k,2094) = .550_r8*rxt(k,64) + mat(k,553) = -( rxt(k,76) + het_rates(k,129) ) + mat(k,715) = .800_r8*rxt(k,19) + mat(k,726) = .800_r8*rxt(k,20) + mat(k,329) = -( rxt(k,77) + het_rates(k,130) ) + mat(k,516) = -( rxt(k,78) + rxt(k,407) + het_rates(k,131) ) + mat(k,2047) = -( rxt(k,79) + het_rates(k,132) ) + mat(k,485) = rxt(k,50) + mat(k,613) = rxt(k,65) + mat(k,762) = .500_r8*rxt(k,68) + mat(k,1186) = .880_r8*rxt(k,69) + mat(k,1901) = .700_r8*rxt(k,71) + mat(k,1962) = rxt(k,427) + mat(k,1929) = -( rxt(k,80) + het_rates(k,133) ) + mat(k,1645) = .490_r8*rxt(k,500) + mat(k,1496) = -( rxt(k,81) + het_rates(k,134) ) + mat(k,2066) = .550_r8*rxt(k,67) + mat(k,846) = -( het_rates(k,135) ) + mat(k,474) = -( rxt(k,198) + het_rates(k,136) ) + mat(k,3187) = rxt(k,15) + mat(k,199) = -( rxt(k,12) + het_rates(k,137) ) + mat(k,292) = -( rxt(k,13) + rxt(k,14) + rxt(k,217) + rxt(k,827) + rxt(k,884) & + + rxt(k,887) + rxt(k,898) + het_rates(k,138) ) + mat(k,2140) = -( rxt(k,82) + rxt(k,828) + het_rates(k,139) ) + mat(k,1581) = rxt(k,70) + mat(k,10) = -( het_rates(k,140) ) + mat(k,11) = -( het_rates(k,141) ) + mat(k,12) = -( het_rates(k,142) ) + mat(k,115) = -( het_rates(k,143) ) + mat(k,13) = -( rxt(k,829) + het_rates(k,144) ) + mat(k,14) = -( rxt(k,903) + het_rates(k,145) ) + mat(k,15) = -( rxt(k,902) + het_rates(k,146) ) end do end subroutine linmat02 subroutine linmat03( avec_len, mat, y, rxt, het_rates ) @@ -485,271 +477,226 @@ subroutine linmat03( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,3080) = -( rxt(k,17) + rxt(k,18) + rxt(k,832) + het_rates(k,149) ) - mat(k,365) = rxt(k,10) - mat(k,247) = rxt(k,13) + rxt(k,14) + rxt(k,217) - mat(k,400) = .400_r8*rxt(k,86) - mat(k,494) = rxt(k,121) - mat(k,1215) = rxt(k,138) - mat(k,1270) = -( rxt(k,83) + het_rates(k,150) ) - mat(k,1797) = .250_r8*rxt(k,80) - mat(k,1343) = -( rxt(k,84) + het_rates(k,151) ) - mat(k,1617) = .250_r8*rxt(k,74) - mat(k,10) = -( het_rates(k,152) ) - mat(k,11) = -( het_rates(k,153) ) - mat(k,12) = -( het_rates(k,154) ) - mat(k,13) = -( het_rates(k,155) ) - mat(k,3460) = -( rxt(k,175) + het_rates(k,156) ) - mat(k,3856) = rxt(k,3) - mat(k,2994) = rxt(k,8) - mat(k,248) = rxt(k,14) - mat(k,2893) = rxt(k,15) - mat(k,3510) = rxt(k,16) - mat(k,3086) = rxt(k,18) - mat(k,3796) = rxt(k,119) - mat(k,3315) = rxt(k,137) - mat(k,279) = rxt(k,151) - mat(k,1520) = rxt(k,155) + rxt(k,804) - mat(k,1164) = rxt(k,156) - mat(k,216) = rxt(k,157) - mat(k,3110) = rxt(k,170) + rxt(k,171) - mat(k,319) = rxt(k,198) - mat(k,459) = rxt(k,798) - mat(k,2987) = -( rxt(k,7) + rxt(k,8) + het_rates(k,157) ) - mat(k,3453) = rxt(k,175) - mat(k,275) = -( rxt(k,151) + het_rates(k,159) ) - mat(k,300) = -( rxt(k,154) + het_rates(k,160) ) - mat(k,150) = -( rxt(k,85) + rxt(k,833) + het_rates(k,161) ) - mat(k,398) = -( rxt(k,86) + rxt(k,353) + het_rates(k,162) ) - mat(k,125) = -( rxt(k,576) + het_rates(k,163) ) - mat(k,405) = -( het_rates(k,164) ) - mat(k,223) = rxt(k,30) - mat(k,141) = -( het_rates(k,165) ) - mat(k,280) = -( rxt(k,87) + het_rates(k,166) ) - mat(k,14) = -( het_rates(k,167) ) - mat(k,15) = -( het_rates(k,168) ) - mat(k,482) = -( rxt(k,88) + het_rates(k,169) ) - mat(k,332) = -( rxt(k,89) + het_rates(k,170) ) - mat(k,455) = -( rxt(k,798) + het_rates(k,171) ) - mat(k,301) = rxt(k,154) - mat(k,1511) = rxt(k,155) - mat(k,1513) = -( rxt(k,155) + rxt(k,804) + het_rates(k,173) ) - mat(k,1162) = rxt(k,156) - mat(k,456) = rxt(k,798) - mat(k,1161) = -( rxt(k,156) + het_rates(k,174) ) - mat(k,215) = rxt(k,157) - mat(k,1512) = rxt(k,804) - mat(k,214) = -( rxt(k,157) + het_rates(k,175) ) - mat(k,120) = rxt(k,153) - mat(k,16) = -( het_rates(k,176) ) - mat(k,17) = -( het_rates(k,177) ) - mat(k,18) = -( het_rates(k,178) ) - mat(k,19) = -( rxt(k,158) + het_rates(k,179) ) - mat(k,20) = -( rxt(k,159) + het_rates(k,180) ) - mat(k,21) = -( rxt(k,160) + het_rates(k,181) ) - mat(k,22) = -( rxt(k,161) + het_rates(k,182) ) - mat(k,23) = -( rxt(k,162) + het_rates(k,183) ) - mat(k,24) = -( rxt(k,163) + het_rates(k,184) ) - mat(k,25) = -( rxt(k,164) + het_rates(k,185) ) - mat(k,26) = -( rxt(k,165) + het_rates(k,186) ) - mat(k,27) = -( rxt(k,166) + het_rates(k,187) ) - mat(k,28) = -( rxt(k,167) + het_rates(k,188) ) - mat(k,29) = -( het_rates(k,189) ) - mat(k,1175) = rxt(k,812) - mat(k,30) = -( het_rates(k,190) ) - mat(k,31) = -( het_rates(k,191) ) - mat(k,32) = -( het_rates(k,192) ) - mat(k,33) = -( het_rates(k,193) ) - mat(k,34) = -( rxt(k,834) + het_rates(k,194) ) - mat(k,40) = -( het_rates(k,196) ) - mat(k,173) = -( rxt(k,90) + het_rates(k,197) ) - mat(k,2179) = -( rxt(k,91) + het_rates(k,198) ) - mat(k,386) = -( rxt(k,92) + het_rates(k,199) ) - mat(k,2193) = -( rxt(k,93) + het_rates(k,200) ) - mat(k,890) = .500_r8*rxt(k,105) - mat(k,1034) = rxt(k,107) - mat(k,1464) = rxt(k,109) - mat(k,1397) = rxt(k,111) - mat(k,590) = rxt(k,113) - mat(k,1167) = -( rxt(k,94) + het_rates(k,201) ) - mat(k,506) = -( rxt(k,95) + rxt(k,791) + het_rates(k,202) ) - mat(k,1645) = -( rxt(k,96) + het_rates(k,203) ) - mat(k,527) = rxt(k,114) - mat(k,514) = -( rxt(k,97) + rxt(k,792) + het_rates(k,204) ) - mat(k,522) = -( rxt(k,98) + het_rates(k,205) ) - mat(k,226) = -( rxt(k,99) + het_rates(k,206) ) - mat(k,230) = -( rxt(k,100) + het_rates(k,207) ) - mat(k,344) = -( rxt(k,101) + rxt(k,793) + het_rates(k,208) ) - mat(k,296) = -( rxt(k,102) + rxt(k,835) + het_rates(k,209) ) - mat(k,2420) = -( het_rates(k,210) ) - mat(k,2181) = rxt(k,91) - mat(k,585) = .460_r8*rxt(k,106) - mat(k,674) = .460_r8*rxt(k,108) - mat(k,1592) = rxt(k,110) - mat(k,1605) = rxt(k,112) - mat(k,2392) = -( het_rates(k,211) ) - mat(k,388) = rxt(k,92) - mat(k,1154) = -( rxt(k,103) + rxt(k,836) + het_rates(k,212) ) - mat(k,871) = -( rxt(k,104) + rxt(k,837) + het_rates(k,213) ) - mat(k,995) = -( het_rates(k,214) ) - mat(k,888) = -( rxt(k,105) + het_rates(k,215) ) - mat(k,582) = -( rxt(k,106) + het_rates(k,216) ) - mat(k,1032) = -( rxt(k,107) + rxt(k,839) + het_rates(k,217) ) - mat(k,671) = -( rxt(k,108) + rxt(k,838) + het_rates(k,218) ) - mat(k,1463) = -( rxt(k,109) + het_rates(k,219) ) - mat(k,1155) = rxt(k,103) - mat(k,872) = rxt(k,104) - mat(k,889) = .500_r8*rxt(k,105) - mat(k,1590) = -( rxt(k,110) + het_rates(k,220) ) - mat(k,584) = .540_r8*rxt(k,106) - mat(k,1396) = -( rxt(k,111) + rxt(k,841) + het_rates(k,221) ) - mat(k,1603) = -( rxt(k,112) + rxt(k,840) + het_rates(k,222) ) - mat(k,673) = .540_r8*rxt(k,108) - mat(k,589) = -( rxt(k,113) + het_rates(k,223) ) - mat(k,297) = rxt(k,102) - mat(k,526) = -( rxt(k,114) + het_rates(k,224) ) - mat(k,613) = -( rxt(k,115) + het_rates(k,225) ) - mat(k,161) = -( het_rates(k,226) ) - mat(k,179) = -( het_rates(k,227) ) - mat(k,731) = -( rxt(k,116) + het_rates(k,228) ) - mat(k,187) = -( het_rates(k,229) ) - mat(k,350) = -( rxt(k,117) + het_rates(k,230) ) - mat(k,462) = -( het_rates(k,233) ) - mat(k,126) = rxt(k,576) - mat(k,1132) = -( het_rates(k,234) ) - mat(k,2119) = -( het_rates(k,235) ) - mat(k,2214) = -( het_rates(k,236) ) - mat(k,46) = -( het_rates(k,237) ) - mat(k,2053) = -( het_rates(k,238) ) - mat(k,2096) = -( het_rates(k,239) ) - mat(k,52) = -( het_rates(k,240) ) - mat(k,435) = -( het_rates(k,241) ) - mat(k,58) = -( het_rates(k,242) ) - mat(k,2332) = -( het_rates(k,243) ) - mat(k,2243) = -( het_rates(k,244) ) - mat(k,64) = -( het_rates(k,245) ) - mat(k,358) = -( het_rates(k,246) ) - mat(k,1243) = -( het_rates(k,247) ) - mat(k,452) = rxt(k,76) - mat(k,975) = -( het_rates(k,248) ) - mat(k,604) = -( het_rates(k,249) ) - mat(k,2699) = -( het_rates(k,250) ) - mat(k,273) = rxt(k,26) - mat(k,2142) = rxt(k,34) - mat(k,1846) = rxt(k,35) - mat(k,882) = .330_r8*rxt(k,47) - mat(k,550) = .050_r8*rxt(k,48) - mat(k,562) = .070_r8*rxt(k,49) - mat(k,1613) = rxt(k,52) - mat(k,1703) = .500_r8*rxt(k,53) - mat(k,809) = rxt(k,55) + rxt(k,56) - mat(k,1754) = .350_r8*rxt(k,72) - mat(k,453) = rxt(k,76) - mat(k,268) = rxt(k,77) - mat(k,1864) = .300_r8*rxt(k,79) - mat(k,1803) = .750_r8*rxt(k,80) - mat(k,1364) = .560_r8*rxt(k,81) - mat(k,1345) = rxt(k,84) - mat(k,399) = .600_r8*rxt(k,86) + rxt(k,353) - mat(k,334) = rxt(k,89) - mat(k,175) = .500_r8*rxt(k,90) - mat(k,3429) = -( het_rates(k,251) ) - mat(k,1311) = rxt(k,33) - mat(k,2149) = rxt(k,34) - mat(k,471) = rxt(k,36) - mat(k,552) = .040_r8*rxt(k,48) - mat(k,564) = .070_r8*rxt(k,49) - mat(k,1761) = .650_r8*rxt(k,72) - mat(k,1872) = .300_r8*rxt(k,79) - mat(k,402) = .400_r8*rxt(k,86) - mat(k,3830) = rxt(k,219)*y(k,55) - mat(k,902) = rxt(k,275)*y(k,55) - mat(k,3749) = rxt(k,308)*y(k,55) - mat(k,3109) = rxt(k,316)*y(k,55) - mat(k,789) = -( het_rates(k,252) ) - mat(k,251) = .600_r8*rxt(k,24) - mat(k,534) = -( het_rates(k,253) ) - mat(k,234) = -( rxt(k,344) + rxt(k,345) + het_rates(k,254) ) - mat(k,117) = rxt(k,42) - mat(k,744) = -( het_rates(k,255) ) - mat(k,3285) = -( rxt(k,813) + het_rates(k,256) ) - mat(k,366) = rxt(k,11) + rxt(k,216) - mat(k,640) = rxt(k,19) - mat(k,652) = .900_r8*rxt(k,20) - mat(k,326) = rxt(k,21) - mat(k,140) = 1.500_r8*rxt(k,22) - mat(k,385) = rxt(k,23) - mat(k,252) = .600_r8*rxt(k,24) - mat(k,331) = .600_r8*rxt(k,25) - mat(k,274) = rxt(k,26) - mat(k,289) = rxt(k,27) - mat(k,294) = rxt(k,28) - mat(k,341) = rxt(k,29) - mat(k,1310) = rxt(k,33) - mat(k,1850) = rxt(k,35) - mat(k,570) = .500_r8*rxt(k,41) - mat(k,1471) = 2.000_r8*rxt(k,43) - mat(k,1178) = 2.000_r8*rxt(k,44) - mat(k,724) = rxt(k,45) - mat(k,884) = .670_r8*rxt(k,47) - mat(k,551) = .620_r8*rxt(k,48) - mat(k,563) = .560_r8*rxt(k,49) - mat(k,424) = rxt(k,50) - mat(k,431) = rxt(k,51) - mat(k,1614) = rxt(k,52) - mat(k,1706) = 1.500_r8*rxt(k,53) + rxt(k,54) - mat(k,415) = rxt(k,57) - mat(k,1091) = rxt(k,58) - mat(k,669) = rxt(k,63) - mat(k,1938) = .450_r8*rxt(k,64) - mat(k,578) = rxt(k,65) - mat(k,478) = rxt(k,66) - mat(k,1972) = .450_r8*rxt(k,67) - mat(k,629) = rxt(k,68) - mat(k,1455) = rxt(k,70) - mat(k,1906) = rxt(k,71) - mat(k,1759) = rxt(k,72) + rxt(k,73) - mat(k,1624) = 1.250_r8*rxt(k,74) - mat(k,1333) = rxt(k,75) - mat(k,1806) = .500_r8*rxt(k,80) - mat(k,1365) = .440_r8*rxt(k,81) - mat(k,2000) = rxt(k,82) - mat(k,1272) = rxt(k,83) - mat(k,283) = rxt(k,87) - mat(k,486) = rxt(k,88) - mat(k,176) = rxt(k,90) - mat(k,2188) = rxt(k,91) - mat(k,389) = rxt(k,92) - mat(k,2200) = rxt(k,93) - mat(k,1173) = rxt(k,94) - mat(k,1651) = rxt(k,96) - mat(k,298) = rxt(k,102) - mat(k,1157) = rxt(k,103) - mat(k,873) = rxt(k,104) - mat(k,892) = .500_r8*rxt(k,105) - mat(k,586) = .540_r8*rxt(k,106) - mat(k,676) = .540_r8*rxt(k,108) - mat(k,1465) = rxt(k,109) - mat(k,1595) = rxt(k,110) - mat(k,1399) = rxt(k,111) - mat(k,1608) = rxt(k,112) - mat(k,591) = rxt(k,113) - mat(k,528) = rxt(k,114) - mat(k,621) = rxt(k,115) - mat(k,740) = rxt(k,116) - mat(k,354) = rxt(k,117) - mat(k,2734) = rxt(k,181) - mat(k,597) = rxt(k,314) - mat(k,236) = rxt(k,344) + rxt(k,345) - mat(k,1006) = rxt(k,459) - mat(k,1079) = rxt(k,463) - mat(k,991) = rxt(k,466) - mat(k,1017) = rxt(k,469) - mat(k,1790) = .400_r8*rxt(k,530) - mat(k,1678) = .400_r8*rxt(k,533) - mat(k,3827) = rxt(k,283)*y(k,44) + rxt(k,286)*y(k,47) - mat(k,3746) = rxt(k,284)*y(k,44) + rxt(k,287)*y(k,47) - mat(k,3106) = rxt(k,317)*y(k,55) + mat(k,3311) = -( rxt(k,15) + het_rates(k,147) ) + mat(k,293) = rxt(k,14) + mat(k,4096) = rxt(k,16) + .500_r8*rxt(k,830) + mat(k,3952) = rxt(k,17) + mat(k,477) = rxt(k,198) + mat(k,4105) = -( rxt(k,16) + rxt(k,830) + het_rates(k,148) ) + mat(k,3339) = rxt(k,9) + mat(k,450) = rxt(k,11) + rxt(k,216) + mat(k,297) = rxt(k,13) + rxt(k,217) + mat(k,3961) = rxt(k,18) + mat(k,725) = rxt(k,19) + mat(k,983) = rxt(k,47) + mat(k,497) = rxt(k,57) + mat(k,1276) = rxt(k,58) + mat(k,1668) = 2.000_r8*rxt(k,59) + mat(k,1118) = 2.000_r8*rxt(k,60) + mat(k,1800) = rxt(k,61) + mat(k,1472) = rxt(k,62) + mat(k,2123) = rxt(k,64) + mat(k,618) = rxt(k,65) + mat(k,565) = rxt(k,66) + mat(k,2091) = rxt(k,67) + mat(k,767) = rxt(k,68) + mat(k,1193) = rxt(k,69) + mat(k,1733) = .750_r8*rxt(k,74) + mat(k,522) = rxt(k,78) + rxt(k,407) + mat(k,1937) = .750_r8*rxt(k,80) + mat(k,2152) = rxt(k,82) + mat(k,1458) = rxt(k,83) + mat(k,1484) = rxt(k,84) + mat(k,207) = rxt(k,85) + mat(k,573) = .600_r8*rxt(k,86) + rxt(k,352) + mat(k,656) = rxt(k,95) + rxt(k,790) + mat(k,665) = rxt(k,97) + rxt(k,791) + mat(k,425) = rxt(k,101) + rxt(k,792) + mat(k,1231) = rxt(k,103) + mat(k,990) = .500_r8*rxt(k,105) + mat(k,672) = .460_r8*rxt(k,106) + mat(k,1154) = rxt(k,107) + mat(k,788) = .460_r8*rxt(k,108) + mat(k,1559) = rxt(k,109) + mat(k,1694) = rxt(k,110) + mat(k,1539) = rxt(k,111) + mat(k,1707) = rxt(k,112) + mat(k,581) = rxt(k,120) + mat(k,1331) = rxt(k,139) + mat(k,156) = rxt(k,575) + mat(k,3959) = -( rxt(k,17) + rxt(k,18) + rxt(k,831) + het_rates(k,149) ) + mat(k,449) = rxt(k,10) + mat(k,296) = rxt(k,13) + rxt(k,14) + rxt(k,217) + mat(k,571) = .400_r8*rxt(k,86) + mat(k,580) = rxt(k,121) + mat(k,1330) = rxt(k,138) + mat(k,1452) = -( rxt(k,83) + het_rates(k,150) ) + mat(k,1923) = .250_r8*rxt(k,80) + mat(k,1479) = -( rxt(k,84) + het_rates(k,151) ) + mat(k,1724) = .250_r8*rxt(k,74) + mat(k,16) = -( het_rates(k,152) ) + mat(k,17) = -( het_rates(k,153) ) + mat(k,18) = -( het_rates(k,154) ) + mat(k,19) = -( het_rates(k,155) ) + mat(k,3390) = -( rxt(k,175) + het_rates(k,156) ) + mat(k,4125) = rxt(k,3) + mat(k,3132) = rxt(k,8) + mat(k,295) = rxt(k,14) + mat(k,3314) = rxt(k,15) + mat(k,4099) = rxt(k,16) + mat(k,3955) = rxt(k,18) + mat(k,2265) = .180_r8*rxt(k,39) + mat(k,1613) = rxt(k,40) + mat(k,2564) = rxt(k,119) + mat(k,2604) = rxt(k,137) + mat(k,343) = rxt(k,151) + mat(k,1605) = rxt(k,155) + rxt(k,804) + mat(k,1235) = rxt(k,156) + mat(k,278) = rxt(k,157) + mat(k,2645) = rxt(k,170) + rxt(k,171) + mat(k,478) = rxt(k,198) + mat(k,544) = rxt(k,797) + mat(k,3127) = -( rxt(k,7) + rxt(k,8) + het_rates(k,157) ) + mat(k,3385) = rxt(k,175) + mat(k,20) = -( het_rates(k,158) ) + mat(k,339) = -( rxt(k,151) + het_rates(k,159) ) + mat(k,382) = -( rxt(k,154) + het_rates(k,160) ) + mat(k,205) = -( rxt(k,85) + rxt(k,832) + het_rates(k,161) ) + mat(k,566) = -( rxt(k,86) + rxt(k,352) + het_rates(k,162) ) + mat(k,154) = -( rxt(k,575) + het_rates(k,163) ) + mat(k,505) = -( het_rates(k,164) ) + mat(k,285) = rxt(k,30) + mat(k,190) = -( het_rates(k,165) ) + mat(k,344) = -( rxt(k,87) + het_rates(k,166) ) + mat(k,21) = -( het_rates(k,167) ) + mat(k,22) = -( het_rates(k,168) ) + mat(k,582) = -( rxt(k,88) + het_rates(k,169) ) + mat(k,402) = -( rxt(k,89) + het_rates(k,170) ) + mat(k,540) = -( rxt(k,797) + het_rates(k,171) ) + mat(k,383) = rxt(k,154) + mat(k,1596) = rxt(k,155) + mat(k,23) = -( rxt(k,152) + het_rates(k,172) ) + mat(k,1598) = -( rxt(k,155) + rxt(k,804) + het_rates(k,173) ) + mat(k,1234) = rxt(k,156) + mat(k,541) = rxt(k,797) + mat(k,1233) = -( rxt(k,156) + het_rates(k,174) ) + mat(k,277) = rxt(k,157) + mat(k,1597) = rxt(k,804) + mat(k,276) = -( rxt(k,157) + het_rates(k,175) ) + mat(k,152) = rxt(k,153) + mat(k,24) = -( het_rates(k,176) ) + mat(k,25) = -( het_rates(k,177) ) + mat(k,26) = -( het_rates(k,178) ) + mat(k,27) = -( rxt(k,158) + het_rates(k,179) ) + mat(k,28) = -( rxt(k,159) + het_rates(k,180) ) + mat(k,29) = -( rxt(k,160) + het_rates(k,181) ) + mat(k,30) = -( rxt(k,161) + het_rates(k,182) ) + mat(k,31) = -( rxt(k,162) + het_rates(k,183) ) + mat(k,32) = -( rxt(k,163) + het_rates(k,184) ) + mat(k,33) = -( rxt(k,164) + het_rates(k,185) ) + mat(k,34) = -( rxt(k,165) + het_rates(k,186) ) + mat(k,35) = -( rxt(k,166) + het_rates(k,187) ) + mat(k,36) = -( rxt(k,167) + het_rates(k,188) ) + mat(k,37) = -( het_rates(k,189) ) + mat(k,1473) = rxt(k,811) + mat(k,38) = -( het_rates(k,190) ) + mat(k,39) = -( het_rates(k,191) ) + mat(k,40) = -( het_rates(k,192) ) + mat(k,41) = -( het_rates(k,193) ) + mat(k,42) = -( rxt(k,833) + het_rates(k,194) ) + mat(k,43) = -( rxt(k,904) + het_rates(k,195) ) + mat(k,49) = -( het_rates(k,196) ) + mat(k,221) = -( rxt(k,90) + het_rates(k,197) ) + mat(k,2437) = -( rxt(k,91) + het_rates(k,198) ) + mat(k,468) = -( rxt(k,92) + het_rates(k,199) ) + mat(k,2366) = -( rxt(k,93) + het_rates(k,200) ) + mat(k,986) = .500_r8*rxt(k,105) + mat(k,1151) = rxt(k,107) + mat(k,1556) = rxt(k,109) + mat(k,1535) = rxt(k,111) + mat(k,674) = rxt(k,113) + mat(k,1287) = -( rxt(k,94) + het_rates(k,201) ) + mat(k,648) = -( rxt(k,95) + rxt(k,790) + het_rates(k,202) ) + mat(k,1716) = -( rxt(k,96) + het_rates(k,203) ) + mat(k,599) = rxt(k,114) + mat(k,657) = -( rxt(k,97) + rxt(k,791) + het_rates(k,204) ) + mat(k,768) = -( rxt(k,98) + het_rates(k,205) ) + mat(k,360) = -( rxt(k,99) + het_rates(k,206) ) + mat(k,365) = -( rxt(k,100) + het_rates(k,207) ) + mat(k,420) = -( rxt(k,101) + rxt(k,792) + het_rates(k,208) ) + mat(k,370) = -( rxt(k,102) + rxt(k,834) + het_rates(k,209) ) + mat(k,2663) = -( het_rates(k,210) ) + mat(k,2438) = rxt(k,91) + mat(k,669) = .460_r8*rxt(k,106) + mat(k,784) = .460_r8*rxt(k,108) + mat(k,1689) = rxt(k,110) + mat(k,1702) = rxt(k,112) + mat(k,2349) = -( het_rates(k,211) ) + mat(k,470) = rxt(k,92) + mat(k,1226) = -( rxt(k,103) + rxt(k,835) + het_rates(k,212) ) + mat(k,967) = -( rxt(k,104) + rxt(k,836) + het_rates(k,213) ) + mat(k,1104) = -( het_rates(k,214) ) + mat(k,984) = -( rxt(k,105) + het_rates(k,215) ) + mat(k,666) = -( rxt(k,106) + het_rates(k,216) ) + mat(k,1149) = -( rxt(k,107) + rxt(k,838) + het_rates(k,217) ) + mat(k,781) = -( rxt(k,108) + rxt(k,837) + het_rates(k,218) ) + mat(k,1555) = -( rxt(k,109) + het_rates(k,219) ) + mat(k,1227) = rxt(k,103) + mat(k,968) = rxt(k,104) + mat(k,985) = .500_r8*rxt(k,105) + mat(k,1687) = -( rxt(k,110) + het_rates(k,220) ) + mat(k,668) = .540_r8*rxt(k,106) + mat(k,1534) = -( rxt(k,111) + rxt(k,840) + het_rates(k,221) ) + mat(k,1700) = -( rxt(k,112) + rxt(k,839) + het_rates(k,222) ) + mat(k,783) = .540_r8*rxt(k,108) + mat(k,673) = -( rxt(k,113) + het_rates(k,223) ) + mat(k,371) = rxt(k,102) + mat(k,598) = -( rxt(k,114) + het_rates(k,224) ) + mat(k,748) = -( rxt(k,115) + het_rates(k,225) ) + mat(k,209) = -( het_rates(k,226) ) + mat(k,227) = -( het_rates(k,227) ) + mat(k,829) = -( rxt(k,116) + het_rates(k,228) ) + mat(k,235) = -( het_rates(k,229) ) + mat(k,426) = -( rxt(k,117) + het_rates(k,230) ) + mat(k,547) = -( het_rates(k,233) ) + mat(k,155) = rxt(k,575) + mat(k,1198) = -( het_rates(k,234) ) + mat(k,2296) = -( het_rates(k,235) ) + mat(k,2466) = -( het_rates(k,236) ) + mat(k,55) = -( het_rates(k,237) ) + mat(k,2213) = -( het_rates(k,238) ) + mat(k,2322) = -( het_rates(k,239) ) + mat(k,61) = -( het_rates(k,240) ) + mat(k,525) = -( het_rates(k,241) ) + mat(k,67) = -( het_rates(k,242) ) + mat(k,2530) = -( het_rates(k,243) ) + mat(k,2411) = -( het_rates(k,244) ) + mat(k,73) = -( het_rates(k,245) ) + mat(k,440) = -( het_rates(k,246) ) + mat(k,1348) = -( het_rates(k,247) ) + mat(k,555) = rxt(k,76) + mat(k,1042) = -( het_rates(k,248) ) + mat(k,709) = -( het_rates(k,249) ) + mat(k,3023) = -( het_rates(k,250) ) + mat(k,337) = rxt(k,26) + mat(k,2278) = rxt(k,34) + mat(k,1911) = rxt(k,35) + mat(k,978) = .330_r8*rxt(k,47) + mat(k,628) = .050_r8*rxt(k,48) + mat(k,686) = .070_r8*rxt(k,49) + mat(k,1758) = rxt(k,52) + mat(k,1874) = .500_r8*rxt(k,53) + mat(k,964) = rxt(k,55) + rxt(k,56) + mat(k,2024) = .350_r8*rxt(k,72) + mat(k,556) = rxt(k,76) + mat(k,332) = rxt(k,77) + mat(k,2049) = .300_r8*rxt(k,79) + mat(k,1930) = .750_r8*rxt(k,80) + mat(k,1500) = .560_r8*rxt(k,81) + mat(k,1481) = rxt(k,84) + mat(k,568) = .600_r8*rxt(k,86) + rxt(k,352) + mat(k,404) = rxt(k,89) + mat(k,223) = .500_r8*rxt(k,90) end do end subroutine linmat03 subroutine linmat04( avec_len, mat, y, rxt, het_rates ) @@ -772,179 +719,285 @@ subroutine linmat04( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,593) = -( rxt(k,314) + het_rates(k,257) ) - mat(k,1404) = -( het_rates(k,258) ) - mat(k,1829) = -( rxt(k,428) + rxt(k,429) + rxt(k,430) + het_rates(k,259) ) - mat(k,203) = rxt(k,437) - mat(k,206) = rxt(k,439) - mat(k,1729) = -( rxt(k,434) + rxt(k,435) + rxt(k,436) + het_rates(k,260) ) - mat(k,209) = rxt(k,441) - mat(k,212) = rxt(k,443) - mat(k,201) = -( rxt(k,437) + rxt(k,438) + het_rates(k,261) ) - mat(k,1810) = rxt(k,429) - mat(k,1765) = rxt(k,495) - mat(k,204) = -( rxt(k,439) + rxt(k,440) + het_rates(k,262) ) - mat(k,1811) = rxt(k,430) - mat(k,1544) = rxt(k,448) - mat(k,207) = -( rxt(k,441) + rxt(k,442) + het_rates(k,263) ) - mat(k,1710) = rxt(k,435) - mat(k,1653) = rxt(k,499) - mat(k,210) = -( rxt(k,443) + rxt(k,444) + het_rates(k,264) ) - mat(k,1711) = rxt(k,436) - mat(k,1565) = rxt(k,452) - mat(k,1550) = -( rxt(k,448) + het_rates(k,265) ) - mat(k,205) = rxt(k,440) - mat(k,1571) = -( rxt(k,452) + het_rates(k,266) ) - mat(k,211) = rxt(k,444) - mat(k,999) = -( rxt(k,459) + het_rates(k,267) ) - mat(k,1071) = -( rxt(k,463) + het_rates(k,268) ) - mat(k,985) = -( rxt(k,466) + het_rates(k,269) ) - mat(k,1010) = -( rxt(k,469) + het_rates(k,270) ) - mat(k,1315) = -( het_rates(k,271) ) - mat(k,2034) = -( het_rates(k,272) ) - mat(k,1180) = -( rxt(k,481) + het_rates(k,273) ) - mat(k,1255) = -( rxt(k,484) + het_rates(k,274) ) - mat(k,70) = -( het_rates(k,275) ) - mat(k,1780) = -( rxt(k,495) + rxt(k,530) + het_rates(k,276) ) - mat(k,202) = rxt(k,438) - mat(k,1667) = -( rxt(k,499) + rxt(k,533) + het_rates(k,277) ) - mat(k,208) = rxt(k,442) - mat(k,76) = -( het_rates(k,278) ) - mat(k,2303) = -( het_rates(k,279) ) - mat(k,2156) = -( het_rates(k,280) ) - mat(k,84) = -( het_rates(k,281) ) - mat(k,1383) = -( rxt(k,385) + het_rates(k,282) ) - mat(k,558) = .190_r8*rxt(k,49) - mat(k,751) = -( het_rates(k,283) ) - mat(k,384) = .600_r8*rxt(k,23) - mat(k,1497) = -( het_rates(k,284) ) - mat(k,1747) = rxt(k,73) - mat(k,392) = rxt(k,78) + rxt(k,408) - mat(k,812) = -( het_rates(k,285) ) - mat(k,329) = .600_r8*rxt(k,25) - mat(k,656) = -( het_rates(k,286) ) - mat(k,1370) = -( het_rates(k,287) ) - mat(k,546) = .230_r8*rxt(k,48) - mat(k,2364) = -( het_rates(k,288) ) - mat(k,2271) = -( het_rates(k,289) ) - mat(k,90) = -( het_rates(k,290) ) - mat(k,1480) = -( rxt(k,501) + het_rates(k,291) ) - mat(k,3105) = -( rxt(k,170) + rxt(k,171) + rxt(k,210)*y(k,137) & - + rxt(k,211)*y(k,137) + rxt(k,243)*y(k,34) + rxt(k,244)*y(k,35) & - + rxt(k,245)*y(k,37) + rxt(k,246)*y(k,38) + rxt(k,247)*y(k,39) & - + rxt(k,248)*y(k,40) + rxt(k,249)*y(k,41) + rxt(k,270)*y(k,36) & - + rxt(k,271)*y(k,56) + rxt(k,272)*y(k,80) + rxt(k,293)*y(k,42) & - + rxt(k,294)*y(k,44) + rxt(k,295)*y(k,84) + rxt(k,296)*y(k,85) & - + rxt(k,297)*y(k,86) + rxt(k,316)*y(k,55) + rxt(k,317)*y(k,55) & - + rxt(k,318)*y(k,55) + het_rates(k,292) ) - mat(k,3851) = rxt(k,1) - mat(k,2989) = rxt(k,7) - mat(k,3752) = -( rxt(k,282)*y(k,42) + rxt(k,284)*y(k,44) + rxt(k,285)*y(k,45) & - + rxt(k,287)*y(k,47) + rxt(k,289)*y(k,56) + rxt(k,290)*y(k,84) & - + rxt(k,291)*y(k,85) + rxt(k,292)*y(k,86) + rxt(k,308)*y(k,55) & - + het_rates(k,293) ) - mat(k,3858) = rxt(k,2) - mat(k,1352) = 2.000_r8*rxt(k,4) - mat(k,2724) = rxt(k,9) - mat(k,368) = rxt(k,10) - mat(k,654) = rxt(k,20) - mat(k,327) = rxt(k,21) - mat(k,290) = rxt(k,27) - mat(k,295) = rxt(k,28) - mat(k,342) = rxt(k,29) - mat(k,225) = rxt(k,30) - mat(k,472) = rxt(k,36) - mat(k,374) = rxt(k,37) - mat(k,572) = 1.500_r8*rxt(k,41) - mat(k,118) = rxt(k,42) - mat(k,726) = rxt(k,45) - mat(k,1122) = 2.000_r8*rxt(k,46) - mat(k,553) = 1.110_r8*rxt(k,48) - mat(k,565) = 1.180_r8*rxt(k,49) - mat(k,425) = rxt(k,50) - mat(k,432) = rxt(k,51) - mat(k,1709) = 3.000_r8*rxt(k,54) - mat(k,811) = rxt(k,55) + rxt(k,56) - mat(k,1643) = rxt(k,61) - mat(k,1342) = rxt(k,62) - mat(k,670) = rxt(k,63) - mat(k,1942) = .550_r8*rxt(k,64) - mat(k,1976) = .550_r8*rxt(k,67) - mat(k,1062) = rxt(k,69) - mat(k,1459) = rxt(k,70) - mat(k,1910) = rxt(k,71) - mat(k,1335) = rxt(k,75) - mat(k,269) = rxt(k,77) - mat(k,1367) = rxt(k,81) - mat(k,284) = rxt(k,87) - mat(k,488) = rxt(k,88) - mat(k,336) = rxt(k,89) - mat(k,2191) = rxt(k,91) - mat(k,390) = rxt(k,92) - mat(k,525) = rxt(k,98) - mat(k,229) = rxt(k,99) - mat(k,233) = rxt(k,100) - mat(k,299) = rxt(k,102) - mat(k,874) = rxt(k,104) - mat(k,894) = rxt(k,105) - mat(k,588) = rxt(k,106) - mat(k,1037) = rxt(k,107) - mat(k,678) = rxt(k,108) - mat(k,592) = rxt(k,113) - mat(k,529) = rxt(k,114) - mat(k,622) = rxt(k,115) - mat(k,741) = rxt(k,116) - mat(k,355) = rxt(k,117) - mat(k,909) = rxt(k,149) - mat(k,1067) = rxt(k,150) - mat(k,1395) = rxt(k,385) - mat(k,1842) = rxt(k,428) - mat(k,1744) = rxt(k,434) - mat(k,1193) = rxt(k,481) - mat(k,1269) = rxt(k,484) - mat(k,1493) = rxt(k,501) - mat(k,1794) = .600_r8*rxt(k,530) - mat(k,1682) = .600_r8*rxt(k,533) - mat(k,3512) = .500_r8*rxt(k,831) - mat(k,3112) = rxt(k,316)*y(k,55) - mat(k,377) = -( het_rates(k,294) ) - mat(k,822) = -( het_rates(k,295) ) - mat(k,1224) = -( het_rates(k,296) ) - mat(k,834) = -( het_rates(k,297) ) - mat(k,917) = -( het_rates(k,298) ) - mat(k,2445) = -( het_rates(k,299) ) - mat(k,2194) = rxt(k,93) - mat(k,523) = rxt(k,98) - mat(k,2532) = -( het_rates(k,300) ) - mat(k,509) = rxt(k,95) + rxt(k,791) - mat(k,2489) = -( het_rates(k,301) ) - mat(k,1169) = rxt(k,94) - mat(k,227) = rxt(k,99) - mat(k,2579) = -( het_rates(k,302) ) - mat(k,516) = rxt(k,97) + rxt(k,792) - mat(k,2072) = -( het_rates(k,303) ) - mat(k,2467) = -( het_rates(k,304) ) - mat(k,1646) = rxt(k,96) - mat(k,231) = rxt(k,100) - mat(k,2627) = -( het_rates(k,305) ) - mat(k,347) = rxt(k,101) + rxt(k,793) - mat(k,680) = -( het_rates(k,306) ) - mat(k,843) = -( het_rates(k,307) ) - mat(k,1144) = -( het_rates(k,308) ) - mat(k,926) = -( het_rates(k,309) ) - mat(k,688) = -( het_rates(k,310) ) - mat(k,696) = -( het_rates(k,311) ) - mat(k,762) = -( het_rates(k,312) ) - mat(k,96) = -( het_rates(k,313) ) - mat(k,778) = -( het_rates(k,314) ) - mat(k,102) = -( het_rates(k,315) ) - mat(k,443) = -( het_rates(k,316) ) - mat(k,3862) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,317) ) - mat(k,121) = rxt(k,153) - mat(k,3756) = rxt(k,282)*y(k,42) + rxt(k,284)*y(k,44) + rxt(k,285)*y(k,45) & - + rxt(k,287)*y(k,47) + rxt(k,292)*y(k,86) + rxt(k,308)*y(k,55) + mat(k,4052) = -( het_rates(k,251) ) + mat(k,1436) = rxt(k,33) + mat(k,2286) = rxt(k,34) + mat(k,705) = rxt(k,36) + mat(k,2270) = rxt(k,38) + mat(k,631) = .040_r8*rxt(k,48) + mat(k,690) = .070_r8*rxt(k,49) + mat(k,2033) = .650_r8*rxt(k,72) + mat(k,2058) = .300_r8*rxt(k,79) + mat(k,572) = .400_r8*rxt(k,86) + mat(k,646) = rxt(k,131) + mat(k,396) = rxt(k,133) + mat(k,904) = -( het_rates(k,252) ) + mat(k,299) = .600_r8*rxt(k,24) + mat(k,602) = -( het_rates(k,253) ) + mat(k,288) = -( rxt(k,343) + rxt(k,344) + het_rates(k,254) ) + mat(k,149) = rxt(k,42) + mat(k,859) = -( het_rates(k,255) ) + mat(k,3571) = -( rxt(k,812) + het_rates(k,256) ) + mat(k,447) = rxt(k,11) + rxt(k,216) + mat(k,723) = rxt(k,19) + mat(k,735) = .900_r8*rxt(k,20) + mat(k,418) = rxt(k,21) + mat(k,189) = 1.500_r8*rxt(k,22) + mat(k,467) = rxt(k,23) + mat(k,300) = .600_r8*rxt(k,24) + mat(k,401) = .600_r8*rxt(k,25) + mat(k,338) = rxt(k,26) + mat(k,353) = rxt(k,27) + mat(k,358) = rxt(k,28) + mat(k,411) = rxt(k,29) + mat(k,1433) = rxt(k,33) + mat(k,1913) = rxt(k,35) + mat(k,637) = .500_r8*rxt(k,41) + mat(k,1714) = 2.000_r8*rxt(k,43) + mat(k,1477) = 2.000_r8*rxt(k,44) + mat(k,823) = rxt(k,45) + mat(k,981) = .670_r8*rxt(k,47) + mat(k,629) = .620_r8*rxt(k,48) + mat(k,688) = .560_r8*rxt(k,49) + mat(k,486) = rxt(k,50) + mat(k,503) = rxt(k,51) + mat(k,1760) = rxt(k,52) + mat(k,1878) = 1.500_r8*rxt(k,53) + rxt(k,54) + mat(k,495) = rxt(k,57) + mat(k,1274) = rxt(k,58) + mat(k,779) = rxt(k,63) + mat(k,2119) = .450_r8*rxt(k,64) + mat(k,616) = rxt(k,65) + mat(k,563) = rxt(k,66) + mat(k,2087) = .450_r8*rxt(k,67) + mat(k,765) = rxt(k,68) + mat(k,1590) = rxt(k,70) + mat(k,1906) = rxt(k,71) + mat(k,2030) = rxt(k,72) + rxt(k,73) + mat(k,1731) = 1.250_r8*rxt(k,74) + mat(k,1464) = rxt(k,75) + mat(k,1934) = .500_r8*rxt(k,80) + mat(k,1502) = .440_r8*rxt(k,81) + mat(k,2148) = rxt(k,82) + mat(k,1456) = rxt(k,83) + mat(k,347) = rxt(k,87) + mat(k,587) = rxt(k,88) + mat(k,224) = rxt(k,90) + mat(k,2448) = rxt(k,91) + mat(k,471) = rxt(k,92) + mat(k,2372) = rxt(k,93) + mat(k,1292) = rxt(k,94) + mat(k,1721) = rxt(k,96) + mat(k,372) = rxt(k,102) + mat(k,1229) = rxt(k,103) + mat(k,969) = rxt(k,104) + mat(k,988) = .500_r8*rxt(k,105) + mat(k,670) = .540_r8*rxt(k,106) + mat(k,786) = .540_r8*rxt(k,108) + mat(k,1557) = rxt(k,109) + mat(k,1692) = rxt(k,110) + mat(k,1537) = rxt(k,111) + mat(k,1705) = rxt(k,112) + mat(k,675) = rxt(k,113) + mat(k,600) = rxt(k,114) + mat(k,756) = rxt(k,115) + mat(k,838) = rxt(k,116) + mat(k,430) = rxt(k,117) + mat(k,2580) = rxt(k,181) + mat(k,696) = rxt(k,313) + mat(k,291) = rxt(k,343) + rxt(k,344) + mat(k,1127) = rxt(k,458) + mat(k,1173) = rxt(k,462) + mat(k,1059) = rxt(k,465) + mat(k,1138) = rxt(k,468) + mat(k,1859) = .400_r8*rxt(k,529) + mat(k,1828) = .400_r8*rxt(k,532) + mat(k,691) = -( rxt(k,313) + het_rates(k,257) ) + mat(k,1296) = -( het_rates(k,258) ) + mat(k,1959) = -( rxt(k,427) + rxt(k,428) + rxt(k,429) + het_rates(k,259) ) + mat(k,265) = rxt(k,436) + mat(k,268) = rxt(k,438) + mat(k,1997) = -( rxt(k,433) + rxt(k,434) + rxt(k,435) + het_rates(k,260) ) + mat(k,271) = rxt(k,440) + mat(k,274) = rxt(k,442) + mat(k,263) = -( rxt(k,436) + rxt(k,437) + het_rates(k,261) ) + mat(k,1939) = rxt(k,428) + mat(k,1832) = rxt(k,494) + mat(k,266) = -( rxt(k,438) + rxt(k,439) + het_rates(k,262) ) + mat(k,1940) = rxt(k,429) + mat(k,1734) = rxt(k,447) + mat(k,269) = -( rxt(k,440) + rxt(k,441) + het_rates(k,263) ) + mat(k,1975) = rxt(k,434) + mat(k,1801) = rxt(k,498) + mat(k,272) = -( rxt(k,442) + rxt(k,443) + het_rates(k,264) ) + mat(k,1976) = rxt(k,435) + mat(k,1762) = rxt(k,451) + mat(k,1740) = -( rxt(k,447) + het_rates(k,265) ) + mat(k,267) = rxt(k,439) + mat(k,1769) = -( rxt(k,451) + het_rates(k,266) ) + mat(k,273) = rxt(k,443) + mat(k,1119) = -( rxt(k,458) + het_rates(k,267) ) + mat(k,1164) = -( rxt(k,462) + het_rates(k,268) ) + mat(k,1052) = -( rxt(k,465) + het_rates(k,269) ) + mat(k,1130) = -( rxt(k,468) + het_rates(k,270) ) + mat(k,1438) = -( het_rates(k,271) ) + mat(k,2180) = -( het_rates(k,272) ) + mat(k,1307) = -( rxt(k,480) + het_rates(k,273) ) + mat(k,1413) = -( rxt(k,483) + het_rates(k,274) ) + mat(k,79) = -( het_rates(k,275) ) + mat(k,1846) = -( rxt(k,494) + rxt(k,529) + het_rates(k,276) ) + mat(k,264) = rxt(k,437) + mat(k,1815) = -( rxt(k,498) + rxt(k,532) + het_rates(k,277) ) + mat(k,270) = rxt(k,441) + mat(k,85) = -( het_rates(k,278) ) + mat(k,2499) = -( het_rates(k,279) ) + mat(k,2381) = -( het_rates(k,280) ) + mat(k,93) = -( het_rates(k,281) ) + mat(k,1541) = -( rxt(k,384) + het_rates(k,282) ) + mat(k,681) = .190_r8*rxt(k,49) + mat(k,866) = -( het_rates(k,283) ) + mat(k,466) = .600_r8*rxt(k,23) + mat(k,1618) = -( het_rates(k,284) ) + mat(k,2017) = rxt(k,73) + mat(k,517) = rxt(k,78) + rxt(k,407) + mat(k,922) = -( het_rates(k,285) ) + mat(k,399) = .600_r8*rxt(k,25) + mat(k,738) = -( het_rates(k,286) ) + mat(k,1506) = -( het_rates(k,287) ) + mat(k,623) = .230_r8*rxt(k,48) + mat(k,2700) = -( het_rates(k,288) ) + mat(k,2806) = -( het_rates(k,289) ) + mat(k,99) = -( het_rates(k,290) ) + mat(k,1638) = -( rxt(k,500) + het_rates(k,291) ) + mat(k,2639) = -( rxt(k,170) + rxt(k,171) + het_rates(k,292) ) + mat(k,4119) = rxt(k,1) + mat(k,3116) = rxt(k,7) + mat(k,200) = rxt(k,12) + mat(k,3822) = -( het_rates(k,293) ) + mat(k,4127) = rxt(k,2) + mat(k,1489) = 2.000_r8*rxt(k,4) + mat(k,3335) = rxt(k,9) + mat(k,448) = rxt(k,10) + mat(k,736) = rxt(k,20) + mat(k,419) = rxt(k,21) + mat(k,354) = rxt(k,27) + mat(k,359) = rxt(k,28) + mat(k,412) = rxt(k,29) + mat(k,287) = rxt(k,30) + mat(k,704) = rxt(k,36) + mat(k,462) = rxt(k,37) + mat(k,2267) = .330_r8*rxt(k,39) + mat(k,638) = 1.500_r8*rxt(k,41) + mat(k,150) = rxt(k,42) + mat(k,824) = rxt(k,45) + mat(k,1212) = 2.000_r8*rxt(k,46) + mat(k,630) = 1.110_r8*rxt(k,48) + mat(k,689) = 1.180_r8*rxt(k,49) + mat(k,487) = rxt(k,50) + mat(k,504) = rxt(k,51) + mat(k,1879) = 3.000_r8*rxt(k,54) + mat(k,966) = rxt(k,55) + rxt(k,56) + mat(k,1799) = rxt(k,61) + mat(k,1471) = rxt(k,62) + mat(k,780) = rxt(k,63) + mat(k,2120) = .550_r8*rxt(k,64) + mat(k,2088) = .550_r8*rxt(k,67) + mat(k,1192) = rxt(k,69) + mat(k,1591) = rxt(k,70) + mat(k,1907) = rxt(k,71) + mat(k,1465) = rxt(k,75) + mat(k,333) = rxt(k,77) + mat(k,1503) = rxt(k,81) + mat(k,348) = rxt(k,87) + mat(k,588) = rxt(k,88) + mat(k,406) = rxt(k,89) + mat(k,2449) = rxt(k,91) + mat(k,472) = rxt(k,92) + mat(k,772) = rxt(k,98) + mat(k,364) = rxt(k,99) + mat(k,369) = rxt(k,100) + mat(k,373) = rxt(k,102) + mat(k,970) = rxt(k,104) + mat(k,989) = rxt(k,105) + mat(k,671) = rxt(k,106) + mat(k,1153) = rxt(k,107) + mat(k,787) = rxt(k,108) + mat(k,676) = rxt(k,113) + mat(k,601) = rxt(k,114) + mat(k,757) = rxt(k,115) + mat(k,839) = rxt(k,116) + mat(k,431) = rxt(k,117) + mat(k,998) = rxt(k,149) + mat(k,1146) = rxt(k,150) + mat(k,1552) = rxt(k,384) + mat(k,1970) = rxt(k,427) + mat(k,2009) = rxt(k,433) + mat(k,1319) = rxt(k,480) + mat(k,1427) = rxt(k,483) + mat(k,1652) = rxt(k,500) + mat(k,1860) = .600_r8*rxt(k,529) + mat(k,1829) = .600_r8*rxt(k,532) + mat(k,4101) = .500_r8*rxt(k,830) end do end subroutine linmat04 + subroutine linmat05( 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,453) = -( het_rates(k,294) ) + mat(k,932) = -( het_rates(k,295) ) + mat(k,1334) = -( het_rates(k,296) ) + mat(k,944) = -( het_rates(k,297) ) + mat(k,1004) = -( het_rates(k,298) ) + mat(k,2728) = -( het_rates(k,299) ) + mat(k,2367) = rxt(k,93) + mat(k,770) = rxt(k,98) + mat(k,2948) = -( het_rates(k,300) ) + mat(k,652) = rxt(k,95) + rxt(k,790) + mat(k,2775) = -( het_rates(k,301) ) + mat(k,1289) = rxt(k,94) + mat(k,362) = rxt(k,99) + mat(k,2853) = -( het_rates(k,302) ) + mat(k,660) = rxt(k,97) + rxt(k,791) + mat(k,2235) = -( het_rates(k,303) ) + mat(k,2751) = -( het_rates(k,304) ) + mat(k,1718) = rxt(k,96) + mat(k,367) = rxt(k,100) + mat(k,2901) = -( het_rates(k,305) ) + mat(k,423) = rxt(k,101) + rxt(k,792) + mat(k,795) = -( het_rates(k,306) ) + mat(k,953) = -( het_rates(k,307) ) + mat(k,1216) = -( het_rates(k,308) ) + mat(k,1013) = -( het_rates(k,309) ) + mat(k,803) = -( het_rates(k,310) ) + mat(k,811) = -( het_rates(k,311) ) + mat(k,877) = -( het_rates(k,312) ) + mat(k,105) = -( het_rates(k,313) ) + mat(k,893) = -( het_rates(k,314) ) + mat(k,111) = -( het_rates(k,315) ) + mat(k,533) = -( het_rates(k,316) ) + mat(k,4132) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,317) ) + mat(k,2271) = .050_r8*rxt(k,39) + mat(k,153) = rxt(k,153) + mat(k,3577) = rxt(k,812) + end do + end subroutine linmat05 subroutine linmat( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- ! ... linear matrix entries for implicit species @@ -964,5 +1017,6 @@ subroutine linmat( avec_len, mat, y, rxt, het_rates ) call linmat02( avec_len, mat, y, rxt, het_rates ) call linmat03( avec_len, mat, y, rxt, het_rates ) call linmat04( avec_len, mat, y, rxt, het_rates ) + call linmat05( avec_len, mat, y, rxt, het_rates ) end subroutine linmat end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/mo_lu_factor.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/mo_lu_factor.F90 index c895649a07..b3595d1977 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/mo_lu_factor.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/mo_lu_factor.F90 @@ -51,28 +51,23 @@ subroutine lu_fac01( avec_len, lu ) lu(k,32) = 1._r8 / lu(k,32) lu(k,33) = 1._r8 / lu(k,33) 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) = 1._r8 / lu(k,37) + lu(k,38) = 1._r8 / lu(k,38) + lu(k,39) = 1._r8 / lu(k,39) lu(k,40) = 1._r8 / lu(k,40) - lu(k,46) = 1._r8 / lu(k,46) - lu(k,52) = 1._r8 / lu(k,52) - lu(k,58) = 1._r8 / lu(k,58) - lu(k,64) = 1._r8 / lu(k,64) - lu(k,70) = 1._r8 / lu(k,70) - lu(k,76) = 1._r8 / lu(k,76) - lu(k,78) = 1._r8 / lu(k,78) - lu(k,84) = 1._r8 / lu(k,84) - lu(k,90) = 1._r8 / lu(k,90) - lu(k,96) = 1._r8 / lu(k,96) - lu(k,102) = 1._r8 / lu(k,102) - 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,3752) = lu(k,3752) - lu(k,104) * lu(k,3534) - lu(k,3756) = lu(k,3756) - lu(k,105) * lu(k,3534) - lu(k,106) = 1._r8 / lu(k,106) - lu(k,107) = lu(k,107) * lu(k,106) - lu(k,108) = lu(k,108) * lu(k,106) - lu(k,3746) = lu(k,3746) - lu(k,107) * lu(k,3535) - lu(k,3752) = lu(k,3752) - lu(k,108) * lu(k,3535) + lu(k,41) = 1._r8 / lu(k,41) + lu(k,42) = 1._r8 / lu(k,42) + lu(k,43) = 1._r8 / lu(k,43) + lu(k,49) = 1._r8 / lu(k,49) + lu(k,55) = 1._r8 / lu(k,55) + lu(k,61) = 1._r8 / lu(k,61) + lu(k,67) = 1._r8 / lu(k,67) + lu(k,73) = 1._r8 / lu(k,73) + lu(k,79) = 1._r8 / lu(k,79) + lu(k,85) = 1._r8 / lu(k,85) + lu(k,87) = 1._r8 / lu(k,87) end do end subroutine lu_fac01 subroutine lu_fac02( avec_len, lu ) @@ -89,108 +84,93 @@ subroutine lu_fac02( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,109) = 1._r8 / lu(k,109) - lu(k,110) = lu(k,110) * lu(k,109) - lu(k,111) = lu(k,111) * lu(k,109) - lu(k,3312) = lu(k,3312) - lu(k,110) * lu(k,3296) - lu(k,3320) = lu(k,3320) - lu(k,111) * lu(k,3296) + lu(k,93) = 1._r8 / lu(k,93) + lu(k,99) = 1._r8 / lu(k,99) + lu(k,105) = 1._r8 / lu(k,105) + lu(k,111) = 1._r8 / lu(k,111) lu(k,112) = 1._r8 / lu(k,112) lu(k,113) = lu(k,113) * lu(k,112) lu(k,114) = lu(k,114) * lu(k,112) - lu(k,115) = lu(k,115) * lu(k,112) - lu(k,3644) = lu(k,3644) - lu(k,113) * lu(k,3536) - lu(k,3752) = lu(k,3752) - lu(k,114) * lu(k,3536) - lu(k,3756) = lu(k,3756) - lu(k,115) * lu(k,3536) - 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,743) = lu(k,743) - lu(k,117) * lu(k,742) - lu(k,750) = - lu(k,118) * lu(k,742) - lu(k,3137) = - lu(k,117) * lu(k,3133) - lu(k,3291) = lu(k,3291) - lu(k,118) * lu(k,3133) - lu(k,119) = 1._r8 / lu(k,119) - lu(k,120) = lu(k,120) * lu(k,119) - lu(k,121) = lu(k,121) * lu(k,119) - lu(k,214) = lu(k,214) - lu(k,120) * lu(k,213) - lu(k,217) = lu(k,217) - lu(k,121) * lu(k,213) - lu(k,3840) = lu(k,3840) - lu(k,120) * lu(k,3838) - lu(k,3862) = lu(k,3862) - lu(k,121) * lu(k,3838) - lu(k,122) = 1._r8 / lu(k,122) - lu(k,123) = lu(k,123) * lu(k,122) - lu(k,124) = lu(k,124) * lu(k,122) - lu(k,3096) = lu(k,3096) - lu(k,123) * lu(k,3093) - lu(k,3105) = lu(k,3105) - lu(k,124) * lu(k,3093) - lu(k,3639) = - lu(k,123) * lu(k,3537) - lu(k,3745) = - lu(k,124) * lu(k,3537) - lu(k,125) = 1._r8 / lu(k,125) - lu(k,126) = lu(k,126) * lu(k,125) - lu(k,127) = lu(k,127) * lu(k,125) - lu(k,462) = lu(k,462) - lu(k,126) * lu(k,461) - lu(k,466) = lu(k,466) - lu(k,127) * lu(k,461) - lu(k,3475) = lu(k,3475) - lu(k,126) * lu(k,3467) - lu(k,3511) = lu(k,3511) - lu(k,127) * lu(k,3467) + lu(k,2597) = lu(k,2597) - lu(k,113) * lu(k,2586) + lu(k,2607) = lu(k,2607) - lu(k,114) * lu(k,2586) + lu(k,115) = 1._r8 / lu(k,115) + lu(k,116) = lu(k,116) * lu(k,115) + lu(k,117) = lu(k,117) * lu(k,115) + lu(k,3822) = lu(k,3822) - lu(k,116) * lu(k,3595) + lu(k,3827) = lu(k,3827) - lu(k,117) * lu(k,3595) + lu(k,118) = 1._r8 / lu(k,118) + lu(k,119) = lu(k,119) * lu(k,118) + lu(k,120) = lu(k,120) * lu(k,118) + lu(k,2639) = lu(k,2639) - lu(k,119) * lu(k,2612) + lu(k,2648) = lu(k,2648) - lu(k,120) * lu(k,2612) + lu(k,121) = 1._r8 / lu(k,121) + lu(k,122) = lu(k,122) * lu(k,121) + lu(k,123) = lu(k,123) * lu(k,121) + lu(k,3821) = lu(k,3821) - lu(k,122) * lu(k,3596) + lu(k,3822) = lu(k,3822) - lu(k,123) * lu(k,3596) + 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,2626) = lu(k,2626) - lu(k,125) * lu(k,2613) + lu(k,2634) = lu(k,2634) - lu(k,126) * lu(k,2613) + lu(k,2639) = lu(k,2639) - lu(k,127) * lu(k,2613) lu(k,128) = 1._r8 / lu(k,128) lu(k,129) = lu(k,129) * lu(k,128) - lu(k,1069) = lu(k,1069) - lu(k,129) * lu(k,1063) - lu(k,1221) = lu(k,1221) - lu(k,129) * lu(k,1211) - lu(k,3320) = lu(k,3320) - lu(k,129) * lu(k,3297) - lu(k,3777) = lu(k,3777) - lu(k,129) * lu(k,3757) - lu(k,3836) = lu(k,3836) - lu(k,129) * lu(k,3803) - lu(k,131) = 1._r8 / lu(k,131) - lu(k,132) = lu(k,132) * lu(k,131) - lu(k,133) = lu(k,133) * lu(k,131) - lu(k,134) = lu(k,134) * lu(k,131) - lu(k,135) = lu(k,135) * lu(k,131) - lu(k,136) = lu(k,136) * lu(k,131) - lu(k,3539) = lu(k,3539) - lu(k,132) * lu(k,3538) - lu(k,3540) = lu(k,3540) - lu(k,133) * lu(k,3538) - lu(k,3588) = lu(k,3588) - lu(k,134) * lu(k,3538) - lu(k,3746) = lu(k,3746) - lu(k,135) * lu(k,3538) - lu(k,3752) = lu(k,3752) - lu(k,136) * lu(k,3538) - lu(k,137) = 1._r8 / lu(k,137) - lu(k,138) = lu(k,138) * lu(k,137) - lu(k,139) = lu(k,139) * lu(k,137) - lu(k,140) = lu(k,140) * lu(k,137) - lu(k,3580) = - lu(k,138) * lu(k,3539) - lu(k,3694) = lu(k,3694) - lu(k,139) * lu(k,3539) - lu(k,3746) = lu(k,3746) - lu(k,140) * lu(k,3539) - lu(k,141) = 1._r8 / lu(k,141) - lu(k,142) = lu(k,142) * lu(k,141) - lu(k,143) = lu(k,143) * lu(k,141) - lu(k,144) = lu(k,144) * lu(k,141) - lu(k,145) = lu(k,145) * lu(k,141) - lu(k,3579) = lu(k,3579) - lu(k,142) * lu(k,3540) - lu(k,3584) = lu(k,3584) - lu(k,143) * lu(k,3540) - lu(k,3746) = lu(k,3746) - lu(k,144) * lu(k,3540) - lu(k,3752) = lu(k,3752) - lu(k,145) * lu(k,3540) - lu(k,146) = 1._r8 / lu(k,146) - lu(k,147) = lu(k,147) * lu(k,146) - lu(k,148) = lu(k,148) * lu(k,146) - lu(k,149) = lu(k,149) * lu(k,146) - lu(k,3105) = lu(k,3105) - lu(k,147) * lu(k,3094) - lu(k,3106) = lu(k,3106) - lu(k,148) * lu(k,3094) - lu(k,3112) = lu(k,3112) - lu(k,149) * lu(k,3094) - lu(k,3745) = lu(k,3745) - lu(k,147) * lu(k,3541) - lu(k,3746) = lu(k,3746) - lu(k,148) * lu(k,3541) - lu(k,3752) = lu(k,3752) - lu(k,149) * lu(k,3541) - lu(k,150) = 1._r8 / lu(k,150) - lu(k,151) = lu(k,151) * lu(k,150) - lu(k,152) = lu(k,152) * lu(k,150) - lu(k,883) = lu(k,883) - lu(k,151) * lu(k,875) - lu(k,886) = lu(k,886) - lu(k,152) * lu(k,875) - lu(k,1804) = - lu(k,151) * lu(k,1796) - lu(k,1808) = lu(k,1808) - lu(k,152) * lu(k,1796) - lu(k,3740) = lu(k,3740) - lu(k,151) * lu(k,3542) - lu(k,3751) = lu(k,3751) - lu(k,152) * lu(k,3542) - lu(k,153) = 1._r8 / lu(k,153) - lu(k,154) = lu(k,154) * lu(k,153) - lu(k,155) = lu(k,155) * lu(k,153) - lu(k,945) = - lu(k,154) * lu(k,940) - lu(k,953) = lu(k,953) - lu(k,155) * lu(k,940) - lu(k,2923) = - lu(k,154) * lu(k,2905) - lu(k,2996) = lu(k,2996) - lu(k,155) * lu(k,2905) - lu(k,3659) = lu(k,3659) - lu(k,154) * lu(k,3543) - lu(k,3752) = lu(k,3752) - lu(k,155) * lu(k,3543) + lu(k,130) = lu(k,130) * lu(k,128) + lu(k,131) = lu(k,131) * lu(k,128) + lu(k,3710) = lu(k,3710) - lu(k,129) * lu(k,3597) + lu(k,3822) = lu(k,3822) - lu(k,130) * lu(k,3597) + lu(k,3827) = lu(k,3827) - lu(k,131) * lu(k,3597) + lu(k,132) = 1._r8 / lu(k,132) + lu(k,133) = lu(k,133) * lu(k,132) + lu(k,134) = lu(k,134) * lu(k,132) + lu(k,135) = lu(k,135) * lu(k,132) + lu(k,2624) = lu(k,2624) - lu(k,133) * lu(k,2614) + lu(k,2639) = lu(k,2639) - lu(k,134) * lu(k,2614) + lu(k,2648) = lu(k,2648) - lu(k,135) * lu(k,2614) + 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,2626) = lu(k,2626) - lu(k,137) * lu(k,2615) + lu(k,2639) = lu(k,2639) - lu(k,138) * lu(k,2615) + lu(k,2648) = lu(k,2648) - lu(k,139) * lu(k,2615) + lu(k,140) = 1._r8 / lu(k,140) + lu(k,141) = lu(k,141) * lu(k,140) + lu(k,142) = lu(k,142) * lu(k,140) + lu(k,143) = lu(k,143) * lu(k,140) + lu(k,2626) = lu(k,2626) - lu(k,141) * lu(k,2616) + lu(k,2639) = lu(k,2639) - lu(k,142) * lu(k,2616) + lu(k,2648) = lu(k,2648) - lu(k,143) * lu(k,2616) + lu(k,144) = 1._r8 / lu(k,144) + lu(k,145) = lu(k,145) * lu(k,144) + lu(k,146) = lu(k,146) * lu(k,144) + lu(k,147) = lu(k,147) * lu(k,144) + lu(k,3822) = lu(k,3822) - lu(k,145) * lu(k,3598) + lu(k,3823) = lu(k,3823) - lu(k,146) * lu(k,3598) + lu(k,3827) = lu(k,3827) - lu(k,147) * lu(k,3598) + lu(k,148) = 1._r8 / lu(k,148) + lu(k,149) = lu(k,149) * lu(k,148) + lu(k,150) = lu(k,150) * lu(k,148) + lu(k,858) = lu(k,858) - lu(k,149) * lu(k,857) + lu(k,864) = - lu(k,150) * lu(k,857) + lu(k,3416) = - lu(k,149) * lu(k,3414) + lu(k,3572) = lu(k,3572) - lu(k,150) * lu(k,3414) + lu(k,151) = 1._r8 / lu(k,151) + lu(k,152) = lu(k,152) * lu(k,151) + lu(k,153) = lu(k,153) * lu(k,151) + lu(k,276) = lu(k,276) - lu(k,152) * lu(k,275) + lu(k,279) = lu(k,279) - lu(k,153) * lu(k,275) + lu(k,4108) = lu(k,4108) - lu(k,152) * lu(k,4107) + lu(k,4132) = lu(k,4132) - lu(k,153) * lu(k,4107) + lu(k,154) = 1._r8 / lu(k,154) + lu(k,155) = lu(k,155) * lu(k,154) + lu(k,156) = lu(k,156) * lu(k,154) + lu(k,547) = lu(k,547) - lu(k,155) * lu(k,546) + lu(k,552) = lu(k,552) - lu(k,156) * lu(k,546) + lu(k,4063) = lu(k,4063) - lu(k,155) * lu(k,4055) + lu(k,4105) = lu(k,4105) - lu(k,156) * lu(k,4055) end do end subroutine lu_fac02 subroutine lu_fac03( avec_len, lu ) @@ -207,116 +187,104 @@ subroutine lu_fac03( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,156) = 1._r8 / lu(k,156) - lu(k,157) = lu(k,157) * lu(k,156) - lu(k,158) = lu(k,158) * lu(k,156) - lu(k,159) = lu(k,159) * lu(k,156) - lu(k,3096) = lu(k,3096) - lu(k,157) * lu(k,3095) - lu(k,3105) = lu(k,3105) - lu(k,158) * lu(k,3095) - lu(k,3115) = lu(k,3115) - lu(k,159) * lu(k,3095) - lu(k,3639) = lu(k,3639) - lu(k,157) * lu(k,3544) - lu(k,3745) = lu(k,3745) - lu(k,158) * lu(k,3544) - lu(k,3755) = lu(k,3755) - lu(k,159) * lu(k,3544) - lu(k,161) = 1._r8 / lu(k,161) - lu(k,162) = lu(k,162) * lu(k,161) - lu(k,163) = lu(k,163) * lu(k,161) - lu(k,164) = lu(k,164) * lu(k,161) - lu(k,165) = lu(k,165) * lu(k,161) - lu(k,166) = lu(k,166) * lu(k,161) - lu(k,167) = lu(k,167) * lu(k,161) - lu(k,3546) = lu(k,3546) - lu(k,162) * lu(k,3545) - lu(k,3547) = lu(k,3547) - lu(k,163) * lu(k,3545) - lu(k,3576) = lu(k,3576) - lu(k,164) * lu(k,3545) - lu(k,3625) = lu(k,3625) - lu(k,165) * lu(k,3545) - lu(k,3746) = lu(k,3746) - lu(k,166) * lu(k,3545) - lu(k,3752) = lu(k,3752) - lu(k,167) * lu(k,3545) - 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,3579) = lu(k,3579) - lu(k,169) * lu(k,3546) - lu(k,3584) = lu(k,3584) - lu(k,170) * lu(k,3546) - lu(k,3746) = lu(k,3746) - lu(k,171) * lu(k,3546) - lu(k,3752) = lu(k,3752) - lu(k,172) * lu(k,3546) - lu(k,173) = 1._r8 / lu(k,173) - lu(k,174) = lu(k,174) * lu(k,173) - lu(k,175) = lu(k,175) * lu(k,173) - lu(k,176) = lu(k,176) * lu(k,173) - lu(k,183) = - lu(k,174) * lu(k,178) - lu(k,184) = - lu(k,175) * lu(k,178) - lu(k,185) = lu(k,185) - lu(k,176) * lu(k,178) - lu(k,3694) = lu(k,3694) - lu(k,174) * lu(k,3547) - lu(k,3739) = lu(k,3739) - lu(k,175) * lu(k,3547) - lu(k,3746) = lu(k,3746) - lu(k,176) * lu(k,3547) - lu(k,179) = 1._r8 / lu(k,179) - lu(k,180) = lu(k,180) * lu(k,179) - lu(k,181) = lu(k,181) * lu(k,179) - lu(k,182) = lu(k,182) * lu(k,179) - lu(k,183) = lu(k,183) * lu(k,179) - lu(k,184) = lu(k,184) * lu(k,179) - lu(k,185) = lu(k,185) * lu(k,179) - lu(k,186) = lu(k,186) * lu(k,179) - lu(k,3549) = lu(k,3549) - lu(k,180) * lu(k,3548) - lu(k,3576) = lu(k,3576) - lu(k,181) * lu(k,3548) - lu(k,3626) = lu(k,3626) - lu(k,182) * lu(k,3548) - lu(k,3694) = lu(k,3694) - lu(k,183) * lu(k,3548) - lu(k,3739) = lu(k,3739) - lu(k,184) * lu(k,3548) - lu(k,3746) = lu(k,3746) - lu(k,185) * lu(k,3548) - lu(k,3752) = lu(k,3752) - lu(k,186) * lu(k,3548) - lu(k,187) = 1._r8 / lu(k,187) - lu(k,188) = lu(k,188) * lu(k,187) - lu(k,189) = lu(k,189) * lu(k,187) - lu(k,190) = lu(k,190) * lu(k,187) - lu(k,191) = lu(k,191) * lu(k,187) - lu(k,3584) = lu(k,3584) - lu(k,188) * lu(k,3549) - lu(k,3589) = lu(k,3589) - lu(k,189) * lu(k,3549) - lu(k,3746) = lu(k,3746) - lu(k,190) * lu(k,3549) - lu(k,3752) = lu(k,3752) - lu(k,191) * lu(k,3549) - lu(k,192) = 1._r8 / lu(k,192) - lu(k,193) = lu(k,193) * lu(k,192) - lu(k,194) = lu(k,194) * lu(k,192) - lu(k,897) = lu(k,897) - lu(k,193) * lu(k,896) - lu(k,900) = lu(k,900) - lu(k,194) * lu(k,896) - lu(k,1415) = lu(k,1415) - lu(k,193) * lu(k,1414) - lu(k,1418) = lu(k,1418) - lu(k,194) * lu(k,1414) - lu(k,2715) = lu(k,2715) - lu(k,193) * lu(k,2714) - lu(k,2718) = - lu(k,194) * lu(k,2714) - lu(k,3841) = lu(k,3841) - lu(k,193) * lu(k,3839) - lu(k,3847) = lu(k,3847) - lu(k,194) * lu(k,3839) + 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,160) = lu(k,160) * lu(k,157) + lu(k,161) = lu(k,161) * lu(k,157) + lu(k,2626) = lu(k,2626) - lu(k,158) * lu(k,2617) + lu(k,2634) = lu(k,2634) - lu(k,159) * lu(k,2617) + lu(k,2639) = lu(k,2639) - lu(k,160) * lu(k,2617) + lu(k,2648) = lu(k,2648) - lu(k,161) * lu(k,2617) + lu(k,162) = 1._r8 / lu(k,162) + lu(k,163) = lu(k,163) * lu(k,162) + lu(k,164) = lu(k,164) * lu(k,162) + lu(k,165) = lu(k,165) * lu(k,162) + lu(k,166) = lu(k,166) * lu(k,162) + lu(k,2626) = lu(k,2626) - lu(k,163) * lu(k,2618) + lu(k,2632) = lu(k,2632) - lu(k,164) * lu(k,2618) + lu(k,2634) = lu(k,2634) - lu(k,165) * lu(k,2618) + lu(k,2639) = lu(k,2639) - lu(k,166) * lu(k,2618) + lu(k,167) = 1._r8 / lu(k,167) + lu(k,168) = lu(k,168) * lu(k,167) + lu(k,169) = lu(k,169) * lu(k,167) + lu(k,170) = lu(k,170) * lu(k,167) + lu(k,171) = lu(k,171) * lu(k,167) + lu(k,2624) = lu(k,2624) - lu(k,168) * lu(k,2619) + lu(k,2626) = lu(k,2626) - lu(k,169) * lu(k,2619) + lu(k,2639) = lu(k,2639) - lu(k,170) * lu(k,2619) + lu(k,2648) = lu(k,2648) - lu(k,171) * lu(k,2619) + lu(k,172) = 1._r8 / lu(k,172) + lu(k,173) = lu(k,173) * lu(k,172) + lu(k,174) = lu(k,174) * lu(k,172) + lu(k,175) = lu(k,175) * lu(k,172) + lu(k,176) = lu(k,176) * lu(k,172) + lu(k,2626) = lu(k,2626) - lu(k,173) * lu(k,2620) + lu(k,2632) = lu(k,2632) - lu(k,174) * lu(k,2620) + lu(k,2639) = lu(k,2639) - lu(k,175) * lu(k,2620) + lu(k,2648) = lu(k,2648) - lu(k,176) * lu(k,2620) + lu(k,177) = 1._r8 / lu(k,177) + lu(k,178) = lu(k,178) * lu(k,177) + lu(k,1147) = lu(k,1147) - lu(k,178) * lu(k,1141) + lu(k,1329) = lu(k,1329) - lu(k,178) * lu(k,1321) + lu(k,2607) = lu(k,2607) - lu(k,178) * lu(k,2587) + lu(k,3158) = lu(k,3158) - lu(k,178) * lu(k,3140) + lu(k,3864) = lu(k,3864) - lu(k,178) * lu(k,3828) + lu(k,180) = 1._r8 / lu(k,180) + lu(k,181) = lu(k,181) * lu(k,180) + lu(k,182) = lu(k,182) * lu(k,180) + lu(k,183) = lu(k,183) * lu(k,180) + lu(k,184) = lu(k,184) * lu(k,180) + lu(k,185) = lu(k,185) * lu(k,180) + lu(k,3600) = lu(k,3600) - lu(k,181) * lu(k,3599) + lu(k,3601) = lu(k,3601) - lu(k,182) * lu(k,3599) + lu(k,3655) = lu(k,3655) - lu(k,183) * lu(k,3599) + lu(k,3821) = lu(k,3821) - lu(k,184) * lu(k,3599) + lu(k,3822) = lu(k,3822) - lu(k,185) * lu(k,3599) + lu(k,186) = 1._r8 / lu(k,186) + lu(k,187) = lu(k,187) * lu(k,186) + lu(k,188) = lu(k,188) * lu(k,186) + lu(k,189) = lu(k,189) * lu(k,186) + lu(k,3646) = - lu(k,187) * lu(k,3600) + lu(k,3777) = lu(k,3777) - lu(k,188) * lu(k,3600) + lu(k,3821) = lu(k,3821) - lu(k,189) * lu(k,3600) + lu(k,190) = 1._r8 / lu(k,190) + lu(k,191) = lu(k,191) * lu(k,190) + lu(k,192) = lu(k,192) * lu(k,190) + lu(k,193) = lu(k,193) * lu(k,190) + lu(k,194) = lu(k,194) * lu(k,190) + lu(k,3644) = lu(k,3644) - lu(k,191) * lu(k,3601) + lu(k,3652) = lu(k,3652) - lu(k,192) * lu(k,3601) + lu(k,3821) = lu(k,3821) - lu(k,193) * lu(k,3601) + lu(k,3822) = lu(k,3822) - lu(k,194) * lu(k,3601) lu(k,195) = 1._r8 / lu(k,195) lu(k,196) = lu(k,196) * lu(k,195) lu(k,197) = lu(k,197) * lu(k,195) - lu(k,907) = lu(k,907) - lu(k,196) * lu(k,905) - lu(k,912) = - lu(k,197) * lu(k,905) - lu(k,3304) = lu(k,3304) - lu(k,196) * lu(k,3298) - lu(k,3320) = lu(k,3320) - lu(k,197) * lu(k,3298) - lu(k,3762) = - lu(k,196) * lu(k,3758) - lu(k,3777) = lu(k,3777) - lu(k,197) * lu(k,3758) - lu(k,3785) = lu(k,3785) - lu(k,196) * lu(k,3779) - lu(k,3801) = lu(k,3801) - lu(k,197) * lu(k,3779) - lu(k,198) = 1._r8 / lu(k,198) - lu(k,199) = lu(k,199) * lu(k,198) - lu(k,200) = lu(k,200) * lu(k,198) - lu(k,288) = - lu(k,199) * lu(k,285) - lu(k,290) = lu(k,290) - lu(k,200) * lu(k,285) - lu(k,359) = - lu(k,199) * lu(k,356) - lu(k,363) = - lu(k,200) * lu(k,356) - lu(k,2771) = lu(k,2771) - lu(k,199) * lu(k,2758) - lu(k,2895) = lu(k,2895) - lu(k,200) * lu(k,2758) - lu(k,3592) = lu(k,3592) - lu(k,199) * lu(k,3550) - lu(k,3752) = lu(k,3752) - lu(k,200) * lu(k,3550) - lu(k,201) = 1._r8 / lu(k,201) - lu(k,202) = lu(k,202) * lu(k,201) - lu(k,203) = lu(k,203) * lu(k,201) - lu(k,1293) = - lu(k,202) * lu(k,1279) - lu(k,1294) = - lu(k,203) * lu(k,1279) - lu(k,1780) = lu(k,1780) - lu(k,202) * lu(k,1765) - lu(k,1782) = - lu(k,203) * lu(k,1765) - lu(k,1827) = - lu(k,202) * lu(k,1810) - lu(k,1829) = lu(k,1829) - lu(k,203) * lu(k,1810) - lu(k,3708) = - lu(k,202) * lu(k,3551) - lu(k,3710) = lu(k,3710) - lu(k,203) * lu(k,3551) + lu(k,198) = lu(k,198) * lu(k,195) + lu(k,2639) = lu(k,2639) - lu(k,196) * lu(k,2621) + lu(k,2646) = lu(k,2646) - lu(k,197) * lu(k,2621) + lu(k,2647) = lu(k,2647) - lu(k,198) * lu(k,2621) + lu(k,3804) = - lu(k,196) * lu(k,3602) + lu(k,3821) = lu(k,3821) - lu(k,197) * lu(k,3602) + lu(k,3822) = lu(k,3822) - lu(k,198) * lu(k,3602) + lu(k,199) = 1._r8 / lu(k,199) + lu(k,200) = lu(k,200) * lu(k,199) + lu(k,201) = lu(k,201) * lu(k,199) + lu(k,476) = - lu(k,200) * lu(k,473) + lu(k,477) = lu(k,477) - lu(k,201) * lu(k,473) + lu(k,2639) = lu(k,2639) - lu(k,200) * lu(k,2622) + lu(k,2642) = lu(k,2642) - lu(k,201) * lu(k,2622) + lu(k,4088) = - lu(k,200) * lu(k,4056) + lu(k,4096) = lu(k,4096) - lu(k,201) * lu(k,4056) + lu(k,202) = 1._r8 / lu(k,202) + lu(k,203) = lu(k,203) * lu(k,202) + lu(k,204) = lu(k,204) * lu(k,202) + lu(k,1092) = - lu(k,203) * lu(k,1089) + lu(k,1102) = lu(k,1102) - lu(k,204) * lu(k,1089) + lu(k,3057) = - lu(k,203) * lu(k,3042) + lu(k,3134) = lu(k,3134) - lu(k,204) * lu(k,3042) + lu(k,3723) = lu(k,3723) - lu(k,203) * lu(k,3603) + lu(k,3822) = lu(k,3822) - lu(k,204) * lu(k,3603) end do end subroutine lu_fac03 subroutine lu_fac04( avec_len, lu ) @@ -333,117 +301,106 @@ subroutine lu_fac04( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,204) = 1._r8 / lu(k,204) - lu(k,205) = lu(k,205) * lu(k,204) - lu(k,206) = lu(k,206) * lu(k,204) - lu(k,1288) = - lu(k,205) * lu(k,1280) - lu(k,1294) = lu(k,1294) - lu(k,206) * lu(k,1280) - lu(k,1550) = lu(k,1550) - lu(k,205) * lu(k,1544) - lu(k,1553) = - lu(k,206) * lu(k,1544) - lu(k,1822) = - lu(k,205) * lu(k,1811) - lu(k,1829) = lu(k,1829) - lu(k,206) * lu(k,1811) - lu(k,3695) = - lu(k,205) * lu(k,3552) - lu(k,3710) = lu(k,3710) - lu(k,206) * lu(k,3552) - lu(k,207) = 1._r8 / lu(k,207) - lu(k,208) = lu(k,208) * lu(k,207) - lu(k,209) = lu(k,209) * lu(k,207) - lu(k,1290) = - lu(k,208) * lu(k,1281) - lu(k,1291) = - lu(k,209) * lu(k,1281) - lu(k,1667) = lu(k,1667) - lu(k,208) * lu(k,1653) - lu(k,1669) = - lu(k,209) * lu(k,1653) - lu(k,1727) = - lu(k,208) * lu(k,1710) - lu(k,1729) = lu(k,1729) - lu(k,209) * lu(k,1710) - lu(k,3703) = - lu(k,208) * lu(k,3553) - lu(k,3706) = lu(k,3706) - lu(k,209) * lu(k,3553) - lu(k,210) = 1._r8 / lu(k,210) - lu(k,211) = lu(k,211) * lu(k,210) - lu(k,212) = lu(k,212) * lu(k,210) - lu(k,1289) = - lu(k,211) * lu(k,1282) - lu(k,1291) = lu(k,1291) - lu(k,212) * lu(k,1282) - lu(k,1571) = lu(k,1571) - lu(k,211) * lu(k,1565) - lu(k,1574) = - lu(k,212) * lu(k,1565) - lu(k,1723) = - lu(k,211) * lu(k,1711) - lu(k,1729) = lu(k,1729) - lu(k,212) * lu(k,1711) - lu(k,3696) = - lu(k,211) * lu(k,3554) - lu(k,3706) = lu(k,3706) - lu(k,212) * lu(k,3554) - lu(k,214) = 1._r8 / lu(k,214) - lu(k,215) = lu(k,215) * lu(k,214) - lu(k,216) = lu(k,216) * lu(k,214) - lu(k,217) = lu(k,217) * lu(k,214) - lu(k,1161) = lu(k,1161) - lu(k,215) * lu(k,1160) - lu(k,1164) = lu(k,1164) - lu(k,216) * lu(k,1160) - lu(k,1166) = - lu(k,217) * lu(k,1160) - lu(k,3662) = lu(k,3662) - lu(k,215) * lu(k,3555) - lu(k,3750) = lu(k,3750) - lu(k,216) * lu(k,3555) - lu(k,3756) = lu(k,3756) - lu(k,217) * lu(k,3555) - lu(k,3842) = - lu(k,215) * lu(k,3840) - lu(k,3856) = lu(k,3856) - lu(k,216) * lu(k,3840) - lu(k,3862) = lu(k,3862) - lu(k,217) * lu(k,3840) - lu(k,218) = 1._r8 / lu(k,218) - lu(k,219) = lu(k,219) * lu(k,218) - lu(k,220) = lu(k,220) * lu(k,218) - lu(k,221) = lu(k,221) * lu(k,218) - lu(k,1244) = lu(k,1244) - lu(k,219) * lu(k,1241) - lu(k,1247) = lu(k,1247) - lu(k,220) * lu(k,1241) - lu(k,1251) = - lu(k,221) * lu(k,1241) - lu(k,3359) = lu(k,3359) - lu(k,219) * lu(k,3347) - lu(k,3426) = lu(k,3426) - lu(k,220) * lu(k,3347) - lu(k,3432) = lu(k,3432) - lu(k,221) * lu(k,3347) - lu(k,3674) = lu(k,3674) - lu(k,219) * lu(k,3556) - lu(k,3746) = lu(k,3746) - lu(k,220) * lu(k,3556) - lu(k,3752) = lu(k,3752) - lu(k,221) * lu(k,3556) - lu(k,222) = 1._r8 / lu(k,222) - lu(k,223) = lu(k,223) * lu(k,222) - lu(k,224) = lu(k,224) * lu(k,222) - lu(k,225) = lu(k,225) * lu(k,222) - lu(k,603) = lu(k,603) - lu(k,223) * lu(k,602) - lu(k,604) = lu(k,604) - lu(k,224) * lu(k,602) - lu(k,609) = - lu(k,225) * lu(k,602) - lu(k,3153) = - lu(k,223) * lu(k,3134) - lu(k,3165) = lu(k,3165) - lu(k,224) * lu(k,3134) - lu(k,3291) = lu(k,3291) - lu(k,225) * lu(k,3134) - lu(k,3584) = lu(k,3584) - lu(k,223) * lu(k,3557) - lu(k,3609) = lu(k,3609) - lu(k,224) * lu(k,3557) - lu(k,3752) = lu(k,3752) - lu(k,225) * lu(k,3557) - lu(k,226) = 1._r8 / lu(k,226) - lu(k,227) = lu(k,227) * lu(k,226) - lu(k,228) = lu(k,228) * lu(k,226) - lu(k,229) = lu(k,229) * lu(k,226) - lu(k,2531) = lu(k,2531) - lu(k,227) * lu(k,2504) - lu(k,2532) = lu(k,2532) - lu(k,228) * lu(k,2504) - lu(k,2546) = lu(k,2546) - lu(k,229) * lu(k,2504) - lu(k,3274) = lu(k,3274) - lu(k,227) * lu(k,3135) - lu(k,3275) = lu(k,3275) - lu(k,228) * lu(k,3135) - lu(k,3291) = lu(k,3291) - lu(k,229) * lu(k,3135) - lu(k,3735) = lu(k,3735) - lu(k,227) * lu(k,3558) - lu(k,3736) = lu(k,3736) - lu(k,228) * lu(k,3558) - lu(k,3752) = lu(k,3752) - lu(k,229) * lu(k,3558) - lu(k,230) = 1._r8 / lu(k,230) - lu(k,231) = lu(k,231) * lu(k,230) - lu(k,232) = lu(k,232) * lu(k,230) - lu(k,233) = lu(k,233) * lu(k,230) - lu(k,2576) = lu(k,2576) - lu(k,231) * lu(k,2550) - lu(k,2579) = lu(k,2579) - lu(k,232) * lu(k,2550) - lu(k,2592) = lu(k,2592) - lu(k,233) * lu(k,2550) - lu(k,3273) = lu(k,3273) - lu(k,231) * lu(k,3136) - lu(k,3276) = lu(k,3276) - lu(k,232) * lu(k,3136) - lu(k,3291) = lu(k,3291) - lu(k,233) * lu(k,3136) - lu(k,3734) = lu(k,3734) - lu(k,231) * lu(k,3559) - lu(k,3737) = lu(k,3737) - lu(k,232) * lu(k,3559) - lu(k,3752) = lu(k,3752) - lu(k,233) * lu(k,3559) - 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,745) = - lu(k,235) * lu(k,743) - lu(k,747) = lu(k,747) - lu(k,236) * lu(k,743) - lu(k,748) = lu(k,748) - lu(k,237) * lu(k,743) - lu(k,2832) = lu(k,2832) - lu(k,235) * lu(k,2759) - lu(k,2889) = lu(k,2889) - lu(k,236) * lu(k,2759) - lu(k,2891) = lu(k,2891) - lu(k,237) * lu(k,2759) - lu(k,3228) = lu(k,3228) - lu(k,235) * lu(k,3137) - lu(k,3285) = lu(k,3285) - lu(k,236) * lu(k,3137) - lu(k,3287) = lu(k,3287) - lu(k,237) * lu(k,3137) + lu(k,205) = 1._r8 / lu(k,205) + lu(k,206) = lu(k,206) * lu(k,205) + lu(k,207) = lu(k,207) * lu(k,205) + lu(k,979) = lu(k,979) - lu(k,206) * lu(k,971) + lu(k,983) = lu(k,983) - lu(k,207) * lu(k,971) + lu(k,1931) = - lu(k,206) * lu(k,1922) + lu(k,1937) = lu(k,1937) - lu(k,207) * lu(k,1922) + lu(k,3818) = lu(k,3818) - lu(k,206) * lu(k,3604) + lu(k,3826) = lu(k,3826) - lu(k,207) * lu(k,3604) + lu(k,209) = 1._r8 / lu(k,209) + lu(k,210) = lu(k,210) * lu(k,209) + lu(k,211) = lu(k,211) * lu(k,209) + lu(k,212) = lu(k,212) * lu(k,209) + lu(k,213) = lu(k,213) * lu(k,209) + lu(k,214) = lu(k,214) * lu(k,209) + lu(k,215) = lu(k,215) * lu(k,209) + lu(k,3606) = lu(k,3606) - lu(k,210) * lu(k,3605) + lu(k,3607) = lu(k,3607) - lu(k,211) * lu(k,3605) + lu(k,3642) = lu(k,3642) - lu(k,212) * lu(k,3605) + lu(k,3694) = lu(k,3694) - lu(k,213) * lu(k,3605) + lu(k,3821) = lu(k,3821) - lu(k,214) * lu(k,3605) + lu(k,3822) = lu(k,3822) - lu(k,215) * lu(k,3605) + lu(k,216) = 1._r8 / lu(k,216) + lu(k,217) = lu(k,217) * lu(k,216) + lu(k,218) = lu(k,218) * lu(k,216) + lu(k,219) = lu(k,219) * lu(k,216) + lu(k,220) = lu(k,220) * lu(k,216) + lu(k,3644) = lu(k,3644) - lu(k,217) * lu(k,3606) + lu(k,3652) = lu(k,3652) - lu(k,218) * lu(k,3606) + lu(k,3821) = lu(k,3821) - lu(k,219) * lu(k,3606) + lu(k,3822) = lu(k,3822) - lu(k,220) * lu(k,3606) + lu(k,221) = 1._r8 / lu(k,221) + lu(k,222) = lu(k,222) * lu(k,221) + lu(k,223) = lu(k,223) * lu(k,221) + lu(k,224) = lu(k,224) * lu(k,221) + lu(k,231) = - lu(k,222) * lu(k,226) + lu(k,232) = - lu(k,223) * lu(k,226) + lu(k,233) = lu(k,233) - lu(k,224) * lu(k,226) + lu(k,3777) = lu(k,3777) - lu(k,222) * lu(k,3607) + lu(k,3814) = lu(k,3814) - lu(k,223) * lu(k,3607) + lu(k,3821) = lu(k,3821) - lu(k,224) * lu(k,3607) + 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,234) = lu(k,234) * lu(k,227) + lu(k,3609) = lu(k,3609) - lu(k,228) * lu(k,3608) + lu(k,3642) = lu(k,3642) - lu(k,229) * lu(k,3608) + lu(k,3695) = lu(k,3695) - lu(k,230) * lu(k,3608) + lu(k,3777) = lu(k,3777) - lu(k,231) * lu(k,3608) + lu(k,3814) = lu(k,3814) - lu(k,232) * lu(k,3608) + lu(k,3821) = lu(k,3821) - lu(k,233) * lu(k,3608) + lu(k,3822) = lu(k,3822) - lu(k,234) * lu(k,3608) + lu(k,235) = 1._r8 / lu(k,235) + lu(k,236) = lu(k,236) * lu(k,235) + lu(k,237) = lu(k,237) * lu(k,235) + lu(k,238) = lu(k,238) * lu(k,235) + lu(k,239) = lu(k,239) * lu(k,235) + lu(k,3652) = lu(k,3652) - lu(k,236) * lu(k,3609) + lu(k,3656) = lu(k,3656) - lu(k,237) * lu(k,3609) + lu(k,3821) = lu(k,3821) - lu(k,238) * lu(k,3609) + lu(k,3822) = lu(k,3822) - lu(k,239) * lu(k,3609) + 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,994) = lu(k,994) - lu(k,241) * lu(k,992) + lu(k,999) = - lu(k,242) * lu(k,992) + lu(k,2554) = lu(k,2554) - lu(k,241) * lu(k,2548) + lu(k,2567) = lu(k,2567) - lu(k,242) * lu(k,2548) + lu(k,2594) = lu(k,2594) - lu(k,241) * lu(k,2588) + lu(k,2607) = lu(k,2607) - lu(k,242) * lu(k,2588) + lu(k,3145) = - lu(k,241) * lu(k,3141) + lu(k,3158) = lu(k,3158) - lu(k,242) * lu(k,3141) + lu(k,243) = 1._r8 / lu(k,243) + lu(k,244) = lu(k,244) * lu(k,243) + lu(k,245) = lu(k,245) * lu(k,243) + lu(k,352) = - lu(k,244) * lu(k,349) + lu(k,354) = lu(k,354) - lu(k,245) * lu(k,349) + lu(k,441) = - lu(k,244) * lu(k,438) + lu(k,444) = - lu(k,245) * lu(k,438) + lu(k,3191) = lu(k,3191) - lu(k,244) * lu(k,3179) + lu(k,3316) = lu(k,3316) - lu(k,245) * lu(k,3179) + lu(k,3658) = lu(k,3658) - lu(k,244) * lu(k,3610) + lu(k,3822) = lu(k,3822) - lu(k,245) * lu(k,3610) + lu(k,246) = 1._r8 / lu(k,246) + lu(k,247) = lu(k,247) * lu(k,246) + lu(k,248) = lu(k,248) * lu(k,246) + lu(k,249) = lu(k,249) * lu(k,246) + lu(k,250) = lu(k,250) * lu(k,246) + lu(k,2624) = lu(k,2624) - lu(k,247) * lu(k,2623) + lu(k,2639) = lu(k,2639) - lu(k,248) * lu(k,2623) + lu(k,2647) = lu(k,2647) - lu(k,249) * lu(k,2623) + lu(k,2648) = lu(k,2648) - lu(k,250) * lu(k,2623) + lu(k,3612) = lu(k,3612) - lu(k,247) * lu(k,3611) + lu(k,3804) = lu(k,3804) - lu(k,248) * lu(k,3611) + lu(k,3822) = lu(k,3822) - lu(k,249) * lu(k,3611) + lu(k,3823) = lu(k,3823) - lu(k,250) * lu(k,3611) end do end subroutine lu_fac04 subroutine lu_fac05( avec_len, lu ) @@ -460,134 +417,108 @@ subroutine lu_fac05( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,238) = 1._r8 / lu(k,238) - lu(k,239) = lu(k,239) * lu(k,238) - lu(k,240) = lu(k,240) * lu(k,238) - lu(k,241) = lu(k,241) * lu(k,238) - lu(k,242) = lu(k,242) * lu(k,238) - lu(k,243) = lu(k,243) * lu(k,238) - lu(k,3017) = lu(k,3017) - lu(k,239) * lu(k,3003) - lu(k,3076) = lu(k,3076) - lu(k,240) * lu(k,3003) - lu(k,3080) = lu(k,3080) - lu(k,241) * lu(k,3003) - lu(k,3082) = lu(k,3082) - lu(k,242) * lu(k,3003) - lu(k,3088) = lu(k,3088) - lu(k,243) * lu(k,3003) - lu(k,3662) = lu(k,3662) - lu(k,239) * lu(k,3560) - lu(k,3740) = lu(k,3740) - lu(k,240) * lu(k,3560) - lu(k,3744) = lu(k,3744) - lu(k,241) * lu(k,3560) - lu(k,3746) = lu(k,3746) - lu(k,242) * lu(k,3560) - lu(k,3752) = lu(k,3752) - lu(k,243) * lu(k,3560) - lu(k,244) = 1._r8 / lu(k,244) - lu(k,245) = lu(k,245) * lu(k,244) - lu(k,246) = lu(k,246) * lu(k,244) - lu(k,247) = lu(k,247) * lu(k,244) - lu(k,248) = lu(k,248) * lu(k,244) - lu(k,249) = lu(k,249) * lu(k,244) - lu(k,3076) = lu(k,3076) - lu(k,245) * lu(k,3004) - lu(k,3078) = lu(k,3078) - lu(k,246) * lu(k,3004) - lu(k,3080) = lu(k,3080) - lu(k,247) * lu(k,3004) - lu(k,3086) = lu(k,3086) - lu(k,248) * lu(k,3004) - lu(k,3087) = lu(k,3087) - lu(k,249) * lu(k,3004) - lu(k,3500) = lu(k,3500) - lu(k,245) * lu(k,3468) - lu(k,3502) = lu(k,3502) - lu(k,246) * lu(k,3468) - lu(k,3504) = lu(k,3504) - lu(k,247) * lu(k,3468) - lu(k,3510) = lu(k,3510) - lu(k,248) * lu(k,3468) - lu(k,3511) = lu(k,3511) - lu(k,249) * lu(k,3468) - lu(k,250) = 1._r8 / lu(k,250) - lu(k,251) = lu(k,251) * lu(k,250) - lu(k,252) = lu(k,252) * lu(k,250) - lu(k,616) = - lu(k,251) * lu(k,610) - lu(k,621) = lu(k,621) - lu(k,252) * lu(k,610) - lu(k,734) = - lu(k,251) * lu(k,727) - lu(k,740) = lu(k,740) - lu(k,252) * lu(k,727) - lu(k,763) = - lu(k,251) * lu(k,757) - lu(k,769) = lu(k,769) - lu(k,252) * lu(k,757) - lu(k,779) = - lu(k,251) * lu(k,772) - lu(k,786) = lu(k,786) - lu(k,252) * lu(k,772) - lu(k,2788) = lu(k,2788) - lu(k,251) * lu(k,2760) - lu(k,2889) = lu(k,2889) - lu(k,252) * lu(k,2760) - lu(k,253) = 1._r8 / lu(k,253) - lu(k,254) = lu(k,254) * lu(k,253) - lu(k,255) = lu(k,255) * lu(k,253) - lu(k,256) = lu(k,256) * lu(k,253) - lu(k,257) = lu(k,257) * lu(k,253) - lu(k,258) = lu(k,258) * lu(k,253) - lu(k,3658) = lu(k,3658) - lu(k,254) * lu(k,3561) - lu(k,3664) = lu(k,3664) - lu(k,255) * lu(k,3561) - lu(k,3694) = lu(k,3694) - lu(k,256) * lu(k,3561) - lu(k,3746) = lu(k,3746) - lu(k,257) * lu(k,3561) - lu(k,3752) = lu(k,3752) - lu(k,258) * lu(k,3561) - lu(k,3809) = - lu(k,254) * lu(k,3804) - lu(k,3810) = - lu(k,255) * lu(k,3804) - lu(k,3818) = lu(k,3818) - lu(k,256) * lu(k,3804) - lu(k,3827) = lu(k,3827) - lu(k,257) * lu(k,3804) - lu(k,3833) = lu(k,3833) - lu(k,258) * lu(k,3804) - lu(k,259) = 1._r8 / lu(k,259) - lu(k,260) = lu(k,260) * lu(k,259) - lu(k,261) = lu(k,261) * lu(k,259) - lu(k,262) = lu(k,262) * lu(k,259) - lu(k,263) = lu(k,263) * lu(k,259) - lu(k,264) = lu(k,264) * lu(k,259) - lu(k,3670) = lu(k,3670) - lu(k,260) * lu(k,3562) - lu(k,3752) = lu(k,3752) - lu(k,261) * lu(k,3562) - lu(k,3753) = lu(k,3753) - lu(k,262) * lu(k,3562) - lu(k,3755) = lu(k,3755) - lu(k,263) * lu(k,3562) - lu(k,3756) = lu(k,3756) - lu(k,264) * lu(k,3562) - lu(k,3812) = lu(k,3812) - lu(k,260) * lu(k,3805) - lu(k,3833) = lu(k,3833) - lu(k,261) * lu(k,3805) - lu(k,3834) = lu(k,3834) - lu(k,262) * lu(k,3805) - lu(k,3836) = lu(k,3836) - lu(k,263) * lu(k,3805) - lu(k,3837) = - lu(k,264) * lu(k,3805) - lu(k,265) = 1._r8 / lu(k,265) - lu(k,266) = lu(k,266) * lu(k,265) - lu(k,267) = lu(k,267) * lu(k,265) - lu(k,268) = lu(k,268) * lu(k,265) - lu(k,269) = lu(k,269) * lu(k,265) - lu(k,656) = lu(k,656) - lu(k,266) * lu(k,655) - lu(k,657) = lu(k,657) - lu(k,267) * lu(k,655) - lu(k,658) = lu(k,658) - lu(k,268) * lu(k,655) - lu(k,662) = lu(k,662) - lu(k,269) * lu(k,655) - lu(k,3168) = lu(k,3168) - lu(k,266) * lu(k,3138) - lu(k,3213) = lu(k,3213) - lu(k,267) * lu(k,3138) - lu(k,3278) = lu(k,3278) - lu(k,268) * lu(k,3138) - lu(k,3291) = lu(k,3291) - lu(k,269) * lu(k,3138) - lu(k,3614) = lu(k,3614) - lu(k,266) * lu(k,3563) - lu(k,3674) = lu(k,3674) - lu(k,267) * lu(k,3563) - lu(k,3739) = lu(k,3739) - lu(k,268) * lu(k,3563) - lu(k,3752) = lu(k,3752) - lu(k,269) * lu(k,3563) - lu(k,270) = 1._r8 / lu(k,270) - lu(k,271) = lu(k,271) * lu(k,270) - lu(k,272) = lu(k,272) * lu(k,270) - lu(k,273) = lu(k,273) * lu(k,270) - lu(k,274) = lu(k,274) * lu(k,270) - lu(k,737) = - lu(k,271) * lu(k,728) - lu(k,738) = lu(k,738) - lu(k,272) * lu(k,728) - lu(k,739) = - lu(k,273) * lu(k,728) - lu(k,740) = lu(k,740) - lu(k,274) * lu(k,728) - lu(k,782) = - lu(k,271) * lu(k,773) - lu(k,783) = lu(k,783) - lu(k,272) * lu(k,773) - lu(k,784) = - lu(k,273) * lu(k,773) - lu(k,786) = lu(k,786) - lu(k,274) * lu(k,773) - lu(k,2836) = lu(k,2836) - lu(k,271) * lu(k,2761) - lu(k,2853) = lu(k,2853) - lu(k,272) * lu(k,2761) - lu(k,2882) = lu(k,2882) - lu(k,273) * lu(k,2761) - lu(k,2889) = lu(k,2889) - lu(k,274) * lu(k,2761) - lu(k,275) = 1._r8 / lu(k,275) - lu(k,276) = lu(k,276) * lu(k,275) - lu(k,277) = lu(k,277) * lu(k,275) - lu(k,278) = lu(k,278) * lu(k,275) - lu(k,279) = lu(k,279) * lu(k,275) - lu(k,1512) = lu(k,1512) - lu(k,276) * lu(k,1510) - lu(k,1513) = lu(k,1513) - lu(k,277) * lu(k,1510) - lu(k,1519) = lu(k,1519) - lu(k,278) * lu(k,1510) - lu(k,1520) = lu(k,1520) - lu(k,279) * lu(k,1510) - lu(k,3301) = lu(k,3301) - lu(k,276) * lu(k,3299) - lu(k,3303) = lu(k,3303) - lu(k,277) * lu(k,3299) - lu(k,3312) = lu(k,3312) - lu(k,278) * lu(k,3299) - lu(k,3315) = lu(k,3315) - lu(k,279) * lu(k,3299) - lu(k,3783) = lu(k,3783) - lu(k,276) * lu(k,3780) - lu(k,3784) = lu(k,3784) - lu(k,277) * lu(k,3780) - lu(k,3793) = lu(k,3793) - lu(k,278) * lu(k,3780) - lu(k,3796) = lu(k,3796) - lu(k,279) * lu(k,3780) + lu(k,251) = 1._r8 / lu(k,251) + lu(k,252) = lu(k,252) * lu(k,251) + lu(k,253) = lu(k,253) * lu(k,251) + lu(k,254) = lu(k,254) * lu(k,251) + lu(k,2632) = lu(k,2632) - lu(k,252) * lu(k,2624) + lu(k,2639) = lu(k,2639) - lu(k,253) * lu(k,2624) + lu(k,2648) = lu(k,2648) - lu(k,254) * lu(k,2624) + lu(k,3730) = - lu(k,252) * lu(k,3612) + lu(k,3804) = lu(k,3804) - lu(k,253) * lu(k,3612) + lu(k,3823) = lu(k,3823) - lu(k,254) * lu(k,3612) + lu(k,255) = 1._r8 / lu(k,255) + lu(k,256) = lu(k,256) * lu(k,255) + lu(k,257) = lu(k,257) * lu(k,255) + lu(k,258) = lu(k,258) * lu(k,255) + lu(k,259) = lu(k,259) * lu(k,255) + lu(k,2626) = lu(k,2626) - lu(k,256) * lu(k,2625) + lu(k,2639) = lu(k,2639) - lu(k,257) * lu(k,2625) + lu(k,2647) = lu(k,2647) - lu(k,258) * lu(k,2625) + lu(k,2648) = lu(k,2648) - lu(k,259) * lu(k,2625) + lu(k,3614) = lu(k,3614) - lu(k,256) * lu(k,3613) + lu(k,3804) = lu(k,3804) - lu(k,257) * lu(k,3613) + lu(k,3822) = lu(k,3822) - lu(k,258) * lu(k,3613) + lu(k,3823) = lu(k,3823) - lu(k,259) * lu(k,3613) + 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,303) = - lu(k,261) * lu(k,301) + lu(k,304) = lu(k,304) - lu(k,262) * lu(k,301) + lu(k,2632) = lu(k,2632) - lu(k,261) * lu(k,2626) + lu(k,2639) = lu(k,2639) - lu(k,262) * lu(k,2626) + lu(k,3730) = lu(k,3730) - lu(k,261) * lu(k,3614) + lu(k,3804) = lu(k,3804) - lu(k,262) * lu(k,3614) + lu(k,263) = 1._r8 / lu(k,263) + lu(k,264) = lu(k,264) * lu(k,263) + lu(k,265) = lu(k,265) * lu(k,263) + lu(k,1396) = - lu(k,264) * lu(k,1384) + lu(k,1398) = - lu(k,265) * lu(k,1384) + lu(k,1846) = lu(k,1846) - lu(k,264) * lu(k,1832) + lu(k,1852) = - lu(k,265) * lu(k,1832) + lu(k,1953) = - lu(k,264) * lu(k,1939) + lu(k,1959) = lu(k,1959) - lu(k,265) * lu(k,1939) + lu(k,3773) = - lu(k,264) * lu(k,3615) + lu(k,3779) = lu(k,3779) - lu(k,265) * lu(k,3615) + lu(k,266) = 1._r8 / lu(k,266) + lu(k,267) = lu(k,267) * lu(k,266) + lu(k,268) = lu(k,268) * lu(k,266) + lu(k,1393) = - lu(k,267) * lu(k,1385) + lu(k,1398) = lu(k,1398) - lu(k,268) * lu(k,1385) + lu(k,1740) = lu(k,1740) - lu(k,267) * lu(k,1734) + lu(k,1746) = - lu(k,268) * lu(k,1734) + lu(k,1950) = - lu(k,267) * lu(k,1940) + lu(k,1959) = lu(k,1959) - lu(k,268) * lu(k,1940) + lu(k,3768) = - lu(k,267) * lu(k,3616) + lu(k,3779) = lu(k,3779) - lu(k,268) * lu(k,3616) + lu(k,269) = 1._r8 / lu(k,269) + lu(k,270) = lu(k,270) * lu(k,269) + lu(k,271) = lu(k,271) * lu(k,269) + lu(k,1395) = - lu(k,270) * lu(k,1386) + lu(k,1399) = - lu(k,271) * lu(k,1386) + lu(k,1815) = lu(k,1815) - lu(k,270) * lu(k,1801) + lu(k,1820) = - lu(k,271) * lu(k,1801) + lu(k,1990) = - lu(k,270) * lu(k,1975) + lu(k,1997) = lu(k,1997) - lu(k,271) * lu(k,1975) + lu(k,3772) = - lu(k,270) * lu(k,3617) + lu(k,3780) = lu(k,3780) - lu(k,271) * lu(k,3617) + lu(k,272) = 1._r8 / lu(k,272) + lu(k,273) = lu(k,273) * lu(k,272) + lu(k,274) = lu(k,274) * lu(k,272) + lu(k,1394) = - lu(k,273) * lu(k,1387) + lu(k,1399) = lu(k,1399) - lu(k,274) * lu(k,1387) + lu(k,1769) = lu(k,1769) - lu(k,273) * lu(k,1762) + lu(k,1774) = - lu(k,274) * lu(k,1762) + lu(k,1988) = - lu(k,273) * lu(k,1976) + lu(k,1997) = lu(k,1997) - lu(k,274) * lu(k,1976) + lu(k,3770) = - lu(k,273) * lu(k,3618) + lu(k,3780) = lu(k,3780) - lu(k,274) * lu(k,3618) + 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,1233) = lu(k,1233) - lu(k,277) * lu(k,1232) + lu(k,1235) = lu(k,1235) - lu(k,278) * lu(k,1232) + lu(k,1238) = - lu(k,279) * lu(k,1232) + lu(k,3727) = lu(k,3727) - lu(k,277) * lu(k,3619) + lu(k,3820) = lu(k,3820) - lu(k,278) * lu(k,3619) + lu(k,3827) = lu(k,3827) - lu(k,279) * lu(k,3619) + lu(k,4110) = - lu(k,277) * lu(k,4108) + lu(k,4125) = lu(k,4125) - lu(k,278) * lu(k,4108) + lu(k,4132) = lu(k,4132) - lu(k,279) * lu(k,4108) + lu(k,280) = 1._r8 / lu(k,280) + lu(k,281) = lu(k,281) * lu(k,280) + lu(k,282) = lu(k,282) * lu(k,280) + lu(k,283) = lu(k,283) * lu(k,280) + lu(k,1349) = lu(k,1349) - lu(k,281) * lu(k,1346) + lu(k,1353) = lu(k,1353) - lu(k,282) * lu(k,1346) + lu(k,1354) = - lu(k,283) * lu(k,1346) + lu(k,3741) = lu(k,3741) - lu(k,281) * lu(k,3620) + lu(k,3821) = lu(k,3821) - lu(k,282) * lu(k,3620) + lu(k,3822) = lu(k,3822) - lu(k,283) * lu(k,3620) + lu(k,3975) = lu(k,3975) - lu(k,281) * lu(k,3964) + lu(k,4048) = lu(k,4048) - lu(k,282) * lu(k,3964) + lu(k,4049) = lu(k,4049) - lu(k,283) * lu(k,3964) end do end subroutine lu_fac05 subroutine lu_fac06( avec_len, lu ) @@ -604,159 +535,125 @@ subroutine lu_fac06( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,280) = 1._r8 / lu(k,280) - lu(k,281) = lu(k,281) * lu(k,280) - lu(k,282) = lu(k,282) * lu(k,280) - lu(k,283) = lu(k,283) * lu(k,280) - lu(k,284) = lu(k,284) * lu(k,280) - lu(k,377) = lu(k,377) - lu(k,281) * lu(k,376) - lu(k,378) = lu(k,378) - lu(k,282) * lu(k,376) - lu(k,380) = lu(k,380) - lu(k,283) * lu(k,376) - lu(k,382) = - lu(k,284) * lu(k,376) - lu(k,3150) = lu(k,3150) - lu(k,281) * lu(k,3139) - lu(k,3206) = lu(k,3206) - lu(k,282) * lu(k,3139) - lu(k,3285) = lu(k,3285) - lu(k,283) * lu(k,3139) - lu(k,3291) = lu(k,3291) - lu(k,284) * lu(k,3139) - lu(k,3579) = lu(k,3579) - lu(k,281) * lu(k,3564) - lu(k,3664) = lu(k,3664) - lu(k,282) * lu(k,3564) - lu(k,3746) = lu(k,3746) - lu(k,283) * lu(k,3564) - lu(k,3752) = lu(k,3752) - lu(k,284) * lu(k,3564) - lu(k,286) = 1._r8 / lu(k,286) - lu(k,287) = lu(k,287) * lu(k,286) - lu(k,288) = lu(k,288) * lu(k,286) - lu(k,289) = lu(k,289) * lu(k,286) - lu(k,290) = lu(k,290) * lu(k,286) - lu(k,358) = lu(k,358) - lu(k,287) * lu(k,357) - lu(k,359) = lu(k,359) - lu(k,288) * lu(k,357) - lu(k,361) = lu(k,361) - lu(k,289) * lu(k,357) - lu(k,363) = lu(k,363) - lu(k,290) * lu(k,357) - lu(k,3147) = lu(k,3147) - lu(k,287) * lu(k,3140) - lu(k,3156) = lu(k,3156) - lu(k,288) * lu(k,3140) - lu(k,3285) = lu(k,3285) - lu(k,289) * lu(k,3140) - lu(k,3291) = lu(k,3291) - lu(k,290) * lu(k,3140) - lu(k,3576) = lu(k,3576) - lu(k,287) * lu(k,3565) - lu(k,3592) = lu(k,3592) - lu(k,288) * lu(k,3565) - lu(k,3746) = lu(k,3746) - lu(k,289) * lu(k,3565) - lu(k,3752) = lu(k,3752) - lu(k,290) * lu(k,3565) - lu(k,291) = 1._r8 / lu(k,291) - lu(k,292) = lu(k,292) * lu(k,291) - lu(k,293) = lu(k,293) * lu(k,291) - lu(k,294) = lu(k,294) * lu(k,291) - lu(k,295) = lu(k,295) * lu(k,291) - lu(k,1243) = lu(k,1243) - lu(k,292) * lu(k,1242) - lu(k,1244) = lu(k,1244) - lu(k,293) * lu(k,1242) - lu(k,1247) = lu(k,1247) - lu(k,294) * lu(k,1242) - lu(k,1251) = lu(k,1251) - lu(k,295) * lu(k,1242) - lu(k,3210) = lu(k,3210) - lu(k,292) * lu(k,3141) - lu(k,3213) = lu(k,3213) - lu(k,293) * lu(k,3141) - lu(k,3285) = lu(k,3285) - lu(k,294) * lu(k,3141) - lu(k,3291) = lu(k,3291) - lu(k,295) * lu(k,3141) - lu(k,3670) = lu(k,3670) - lu(k,292) * lu(k,3566) - lu(k,3674) = lu(k,3674) - lu(k,293) * lu(k,3566) - lu(k,3746) = lu(k,3746) - lu(k,294) * lu(k,3566) - lu(k,3752) = lu(k,3752) - lu(k,295) * lu(k,3566) - lu(k,296) = 1._r8 / lu(k,296) - lu(k,297) = lu(k,297) * lu(k,296) - lu(k,298) = lu(k,298) * lu(k,296) - lu(k,299) = lu(k,299) * lu(k,296) - lu(k,833) = - lu(k,297) * lu(k,831) - lu(k,839) = lu(k,839) - lu(k,298) * lu(k,831) - lu(k,842) = lu(k,842) - lu(k,299) * lu(k,831) - lu(k,915) = - lu(k,297) * lu(k,914) - lu(k,922) = lu(k,922) - lu(k,298) * lu(k,914) - lu(k,924) = lu(k,924) - lu(k,299) * lu(k,914) - lu(k,3163) = lu(k,3163) - lu(k,297) * lu(k,3142) - lu(k,3285) = lu(k,3285) - lu(k,298) * lu(k,3142) - lu(k,3291) = lu(k,3291) - lu(k,299) * lu(k,3142) - lu(k,3608) = lu(k,3608) - lu(k,297) * lu(k,3567) - lu(k,3746) = lu(k,3746) - lu(k,298) * lu(k,3567) - lu(k,3752) = lu(k,3752) - lu(k,299) * lu(k,3567) - lu(k,300) = 1._r8 / lu(k,300) - lu(k,301) = lu(k,301) * lu(k,300) - lu(k,302) = lu(k,302) * lu(k,300) - lu(k,303) = lu(k,303) * lu(k,300) - lu(k,304) = lu(k,304) * lu(k,300) - lu(k,305) = lu(k,305) * lu(k,300) - lu(k,306) = lu(k,306) * lu(k,300) - lu(k,307) = lu(k,307) * lu(k,300) - lu(k,3438) = - lu(k,301) * lu(k,3437) - lu(k,3443) = - lu(k,302) * lu(k,3437) - lu(k,3447) = lu(k,3447) - lu(k,303) * lu(k,3437) - lu(k,3448) = lu(k,3448) - lu(k,304) * lu(k,3437) - lu(k,3451) = lu(k,3451) - lu(k,305) * lu(k,3437) - lu(k,3460) = lu(k,3460) - lu(k,306) * lu(k,3437) - lu(k,3462) = lu(k,3462) - lu(k,307) * lu(k,3437) - lu(k,3591) = lu(k,3591) - lu(k,301) * lu(k,3568) - lu(k,3662) = lu(k,3662) - lu(k,302) * lu(k,3568) - lu(k,3692) = lu(k,3692) - lu(k,303) * lu(k,3568) - lu(k,3694) = lu(k,3694) - lu(k,304) * lu(k,3568) - lu(k,3741) = lu(k,3741) - lu(k,305) * lu(k,3568) - lu(k,3750) = lu(k,3750) - lu(k,306) * lu(k,3568) - lu(k,3752) = lu(k,3752) - lu(k,307) * lu(k,3568) + lu(k,284) = 1._r8 / lu(k,284) + lu(k,285) = lu(k,285) * lu(k,284) + lu(k,286) = lu(k,286) * lu(k,284) + lu(k,287) = lu(k,287) * lu(k,284) + lu(k,708) = lu(k,708) - lu(k,285) * lu(k,707) + lu(k,709) = lu(k,709) - lu(k,286) * lu(k,707) + lu(k,713) = - lu(k,287) * lu(k,707) + lu(k,3434) = - lu(k,285) * lu(k,3415) + lu(k,3444) = lu(k,3444) - lu(k,286) * lu(k,3415) + lu(k,3572) = lu(k,3572) - lu(k,287) * lu(k,3415) + lu(k,3652) = lu(k,3652) - lu(k,285) * lu(k,3621) + lu(k,3676) = lu(k,3676) - lu(k,286) * lu(k,3621) + lu(k,3822) = lu(k,3822) - lu(k,287) * lu(k,3621) + lu(k,288) = 1._r8 / lu(k,288) + lu(k,289) = lu(k,289) * lu(k,288) + lu(k,290) = lu(k,290) * lu(k,288) + lu(k,291) = lu(k,291) * lu(k,288) + lu(k,860) = - lu(k,289) * lu(k,858) + lu(k,862) = lu(k,862) - lu(k,290) * lu(k,858) + lu(k,863) = lu(k,863) - lu(k,291) * lu(k,858) + lu(k,3258) = lu(k,3258) - lu(k,289) * lu(k,3180) + lu(k,3313) = lu(k,3313) - lu(k,290) * lu(k,3180) + lu(k,3315) = lu(k,3315) - lu(k,291) * lu(k,3180) + lu(k,3514) = lu(k,3514) - lu(k,289) * lu(k,3416) + lu(k,3569) = lu(k,3569) - lu(k,290) * lu(k,3416) + lu(k,3571) = lu(k,3571) - lu(k,291) * lu(k,3416) + 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,3952) = lu(k,3952) - lu(k,293) * lu(k,3871) + lu(k,3953) = lu(k,3953) - lu(k,294) * lu(k,3871) + lu(k,3955) = lu(k,3955) - lu(k,295) * lu(k,3871) + lu(k,3959) = lu(k,3959) - lu(k,296) * lu(k,3871) + lu(k,3961) = lu(k,3961) - lu(k,297) * lu(k,3871) + lu(k,4096) = lu(k,4096) - lu(k,293) * lu(k,4057) + lu(k,4097) = lu(k,4097) - lu(k,294) * lu(k,4057) + lu(k,4099) = lu(k,4099) - lu(k,295) * lu(k,4057) + lu(k,4103) = lu(k,4103) - lu(k,296) * lu(k,4057) + lu(k,4105) = lu(k,4105) - lu(k,297) * lu(k,4057) + lu(k,298) = 1._r8 / lu(k,298) + lu(k,299) = lu(k,299) * lu(k,298) + lu(k,300) = lu(k,300) * lu(k,298) + lu(k,751) = - lu(k,299) * lu(k,745) + lu(k,756) = lu(k,756) - lu(k,300) * lu(k,745) + lu(k,832) = - lu(k,299) * lu(k,825) + lu(k,838) = lu(k,838) - lu(k,300) * lu(k,825) + lu(k,878) = - lu(k,299) * lu(k,872) + lu(k,884) = lu(k,884) - lu(k,300) * lu(k,872) + lu(k,894) = - lu(k,299) * lu(k,887) + lu(k,901) = lu(k,901) - lu(k,300) * lu(k,887) + lu(k,3209) = lu(k,3209) - lu(k,299) * lu(k,3181) + lu(k,3315) = lu(k,3315) - lu(k,300) * lu(k,3181) + lu(k,302) = 1._r8 / lu(k,302) + lu(k,303) = lu(k,303) * lu(k,302) + lu(k,304) = lu(k,304) * lu(k,302) + lu(k,305) = lu(k,305) * lu(k,302) + lu(k,306) = lu(k,306) * lu(k,302) + lu(k,307) = lu(k,307) * lu(k,302) + lu(k,2632) = lu(k,2632) - lu(k,303) * lu(k,2627) + lu(k,2639) = lu(k,2639) - lu(k,304) * lu(k,2627) + lu(k,2647) = lu(k,2647) - lu(k,305) * lu(k,2627) + lu(k,2648) = lu(k,2648) - lu(k,306) * lu(k,2627) + lu(k,2652) = lu(k,2652) - lu(k,307) * lu(k,2627) + lu(k,3730) = lu(k,3730) - lu(k,303) * lu(k,3622) + lu(k,3804) = lu(k,3804) - lu(k,304) * lu(k,3622) + lu(k,3822) = lu(k,3822) - lu(k,305) * lu(k,3622) + lu(k,3823) = lu(k,3823) - lu(k,306) * lu(k,3622) + lu(k,3827) = lu(k,3827) - lu(k,307) * lu(k,3622) 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,3006) = - lu(k,309) * lu(k,3005) - lu(k,3022) = lu(k,3022) - lu(k,310) * lu(k,3005) - lu(k,3057) = lu(k,3057) - lu(k,311) * lu(k,3005) - lu(k,3080) = lu(k,3080) - lu(k,312) * lu(k,3005) - lu(k,3084) = lu(k,3084) - lu(k,313) * lu(k,3005) - lu(k,3087) = lu(k,3087) - lu(k,314) * lu(k,3005) - lu(k,3088) = lu(k,3088) - lu(k,315) * lu(k,3005) - lu(k,3602) = lu(k,3602) - lu(k,309) * lu(k,3569) - lu(k,3674) = lu(k,3674) - lu(k,310) * lu(k,3569) - lu(k,3721) = lu(k,3721) - lu(k,311) * lu(k,3569) - lu(k,3744) = lu(k,3744) - lu(k,312) * lu(k,3569) - lu(k,3748) = lu(k,3748) - lu(k,313) * lu(k,3569) - lu(k,3751) = lu(k,3751) - lu(k,314) * lu(k,3569) - lu(k,3752) = lu(k,3752) - lu(k,315) * lu(k,3569) - lu(k,316) = 1._r8 / lu(k,316) - lu(k,317) = lu(k,317) * lu(k,316) - lu(k,318) = lu(k,318) * lu(k,316) - lu(k,319) = lu(k,319) * lu(k,316) - lu(k,320) = lu(k,320) * lu(k,316) - lu(k,321) = lu(k,321) * lu(k,316) - lu(k,2884) = - lu(k,317) * lu(k,2762) - lu(k,2885) = lu(k,2885) - lu(k,318) * lu(k,2762) - lu(k,2893) = lu(k,2893) - lu(k,319) * lu(k,2762) - lu(k,2894) = lu(k,2894) - lu(k,320) * lu(k,2762) - lu(k,2895) = lu(k,2895) - lu(k,321) * lu(k,2762) - lu(k,3501) = - lu(k,317) * lu(k,3469) - lu(k,3502) = lu(k,3502) - lu(k,318) * lu(k,3469) - lu(k,3510) = lu(k,3510) - lu(k,319) * lu(k,3469) - lu(k,3511) = lu(k,3511) - lu(k,320) * lu(k,3469) - lu(k,3512) = lu(k,3512) - lu(k,321) * lu(k,3469) - lu(k,3741) = lu(k,3741) - lu(k,317) * lu(k,3570) - lu(k,3742) = lu(k,3742) - lu(k,318) * lu(k,3570) - lu(k,3750) = lu(k,3750) - lu(k,319) * lu(k,3570) - lu(k,3751) = lu(k,3751) - lu(k,320) * lu(k,3570) - lu(k,3752) = lu(k,3752) - lu(k,321) * lu(k,3570) - lu(k,322) = 1._r8 / lu(k,322) - lu(k,323) = lu(k,323) * lu(k,322) - lu(k,324) = lu(k,324) * lu(k,322) - lu(k,325) = lu(k,325) * lu(k,322) - lu(k,326) = lu(k,326) * lu(k,322) - lu(k,327) = lu(k,327) * lu(k,322) - lu(k,434) = lu(k,434) - lu(k,323) * lu(k,433) - lu(k,435) = lu(k,435) - lu(k,324) * lu(k,433) - lu(k,437) = lu(k,437) - lu(k,325) * lu(k,433) - lu(k,439) = lu(k,439) - lu(k,326) * lu(k,433) - lu(k,441) = - lu(k,327) * lu(k,433) - lu(k,3151) = - lu(k,323) * lu(k,3143) - lu(k,3154) = lu(k,3154) - lu(k,324) * lu(k,3143) - lu(k,3206) = lu(k,3206) - lu(k,325) * lu(k,3143) - lu(k,3285) = lu(k,3285) - lu(k,326) * lu(k,3143) - lu(k,3291) = lu(k,3291) - lu(k,327) * lu(k,3143) - lu(k,3580) = lu(k,3580) - lu(k,323) * lu(k,3571) - lu(k,3588) = lu(k,3588) - lu(k,324) * lu(k,3571) - lu(k,3664) = lu(k,3664) - lu(k,325) * lu(k,3571) - lu(k,3746) = lu(k,3746) - lu(k,326) * lu(k,3571) - lu(k,3752) = lu(k,3752) - lu(k,327) * lu(k,3571) + lu(k,3737) = lu(k,3737) - lu(k,309) * lu(k,3623) + lu(k,3746) = lu(k,3746) - lu(k,310) * lu(k,3623) + lu(k,3777) = lu(k,3777) - lu(k,311) * lu(k,3623) + lu(k,3821) = lu(k,3821) - lu(k,312) * lu(k,3623) + lu(k,3822) = lu(k,3822) - lu(k,313) * lu(k,3623) + lu(k,3840) = - lu(k,309) * lu(k,3829) + lu(k,3842) = - lu(k,310) * lu(k,3829) + lu(k,3848) = lu(k,3848) - lu(k,311) * lu(k,3829) + lu(k,3862) = lu(k,3862) - lu(k,312) * lu(k,3829) + lu(k,3863) = lu(k,3863) - lu(k,313) * lu(k,3829) + lu(k,314) = 1._r8 / lu(k,314) + lu(k,315) = lu(k,315) * lu(k,314) + lu(k,316) = lu(k,316) * lu(k,314) + lu(k,317) = lu(k,317) * lu(k,314) + lu(k,318) = lu(k,318) * lu(k,314) + lu(k,319) = lu(k,319) * lu(k,314) + lu(k,3736) = lu(k,3736) - lu(k,315) * lu(k,3624) + lu(k,3816) = lu(k,3816) - lu(k,316) * lu(k,3624) + lu(k,3822) = lu(k,3822) - lu(k,317) * lu(k,3624) + lu(k,3823) = lu(k,3823) - lu(k,318) * lu(k,3624) + lu(k,3827) = lu(k,3827) - lu(k,319) * lu(k,3624) + lu(k,3839) = lu(k,3839) - lu(k,315) * lu(k,3830) + lu(k,3857) = lu(k,3857) - lu(k,316) * lu(k,3830) + lu(k,3863) = lu(k,3863) - lu(k,317) * lu(k,3830) + lu(k,3864) = lu(k,3864) - lu(k,318) * lu(k,3830) + lu(k,3868) = - lu(k,319) * lu(k,3830) + lu(k,320) = 1._r8 / lu(k,320) + lu(k,321) = lu(k,321) * lu(k,320) + lu(k,322) = lu(k,322) * lu(k,320) + lu(k,323) = lu(k,323) * lu(k,320) + lu(k,324) = lu(k,324) * lu(k,320) + lu(k,325) = lu(k,325) * lu(k,320) + lu(k,3727) = lu(k,3727) - lu(k,321) * lu(k,3625) + lu(k,3818) = lu(k,3818) - lu(k,322) * lu(k,3625) + lu(k,3821) = lu(k,3821) - lu(k,323) * lu(k,3625) + lu(k,3822) = lu(k,3822) - lu(k,324) * lu(k,3625) + lu(k,3824) = lu(k,3824) - lu(k,325) * lu(k,3625) + lu(k,3883) = lu(k,3883) - lu(k,321) * lu(k,3872) + lu(k,3953) = lu(k,3953) - lu(k,322) * lu(k,3872) + lu(k,3956) = lu(k,3956) - lu(k,323) * lu(k,3872) + lu(k,3957) = lu(k,3957) - lu(k,324) * lu(k,3872) + lu(k,3959) = lu(k,3959) - lu(k,325) * lu(k,3872) end do end subroutine lu_fac06 subroutine lu_fac07( avec_len, lu ) @@ -773,151 +670,171 @@ subroutine lu_fac07( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - 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,617) = - lu(k,329) * lu(k,611) - lu(k,619) = - lu(k,330) * lu(k,611) - lu(k,621) = lu(k,621) - lu(k,331) * lu(k,611) - lu(k,735) = - lu(k,329) * lu(k,729) - lu(k,737) = lu(k,737) - lu(k,330) * lu(k,729) - lu(k,740) = lu(k,740) - lu(k,331) * lu(k,729) - lu(k,764) = - lu(k,329) * lu(k,758) - lu(k,766) = - lu(k,330) * lu(k,758) - lu(k,769) = lu(k,769) - lu(k,331) * lu(k,758) - lu(k,780) = - lu(k,329) * lu(k,774) - lu(k,782) = lu(k,782) - lu(k,330) * lu(k,774) - lu(k,786) = lu(k,786) - lu(k,331) * lu(k,774) - lu(k,2791) = lu(k,2791) - lu(k,329) * lu(k,2763) - lu(k,2836) = lu(k,2836) - lu(k,330) * lu(k,2763) - lu(k,2889) = lu(k,2889) - lu(k,331) * lu(k,2763) - lu(k,332) = 1._r8 / lu(k,332) - lu(k,333) = lu(k,333) * lu(k,332) - lu(k,334) = lu(k,334) * lu(k,332) - lu(k,335) = lu(k,335) * lu(k,332) - lu(k,336) = lu(k,336) * lu(k,332) - lu(k,337) = lu(k,337) * lu(k,332) - lu(k,1224) = lu(k,1224) - lu(k,333) * lu(k,1223) - lu(k,1228) = lu(k,1228) - lu(k,334) * lu(k,1223) - lu(k,1231) = lu(k,1231) - lu(k,335) * lu(k,1223) - lu(k,1234) = lu(k,1234) - lu(k,336) * lu(k,1223) - lu(k,1235) = - lu(k,337) * lu(k,1223) - lu(k,3208) = lu(k,3208) - lu(k,333) * lu(k,3144) - lu(k,3278) = lu(k,3278) - lu(k,334) * lu(k,3144) - lu(k,3287) = lu(k,3287) - lu(k,335) * lu(k,3144) - lu(k,3291) = lu(k,3291) - lu(k,336) * lu(k,3144) - lu(k,3295) = lu(k,3295) - lu(k,337) * lu(k,3144) - lu(k,3668) = lu(k,3668) - lu(k,333) * lu(k,3572) - lu(k,3739) = lu(k,3739) - lu(k,334) * lu(k,3572) - lu(k,3748) = lu(k,3748) - lu(k,335) * lu(k,3572) - lu(k,3752) = lu(k,3752) - lu(k,336) * lu(k,3572) - lu(k,3756) = lu(k,3756) - lu(k,337) * lu(k,3572) - lu(k,338) = 1._r8 / lu(k,338) - lu(k,339) = lu(k,339) * lu(k,338) - lu(k,340) = lu(k,340) * lu(k,338) - lu(k,341) = lu(k,341) * lu(k,338) - lu(k,342) = lu(k,342) * lu(k,338) - lu(k,343) = lu(k,343) * lu(k,338) - lu(k,975) = lu(k,975) - lu(k,339) * lu(k,974) - lu(k,977) = lu(k,977) - lu(k,340) * lu(k,974) - lu(k,979) = lu(k,979) - lu(k,341) * lu(k,974) - lu(k,983) = - lu(k,342) * lu(k,974) - lu(k,984) = - lu(k,343) * lu(k,974) - lu(k,3191) = lu(k,3191) - lu(k,339) * lu(k,3145) - lu(k,3260) = lu(k,3260) - lu(k,340) * lu(k,3145) - lu(k,3285) = lu(k,3285) - lu(k,341) * lu(k,3145) - lu(k,3291) = lu(k,3291) - lu(k,342) * lu(k,3145) - lu(k,3295) = lu(k,3295) - lu(k,343) * lu(k,3145) - lu(k,3644) = lu(k,3644) - lu(k,339) * lu(k,3573) - lu(k,3721) = lu(k,3721) - lu(k,340) * lu(k,3573) - lu(k,3746) = lu(k,3746) - lu(k,341) * lu(k,3573) - lu(k,3752) = lu(k,3752) - lu(k,342) * lu(k,3573) - lu(k,3756) = lu(k,3756) - lu(k,343) * lu(k,3573) + lu(k,326) = 1._r8 / lu(k,326) + lu(k,327) = lu(k,327) * lu(k,326) + lu(k,328) = lu(k,328) * lu(k,326) + lu(k,1278) = lu(k,1278) - lu(k,327) * lu(k,1277) + lu(k,1281) = lu(k,1281) - lu(k,328) * lu(k,1277) + lu(k,1670) = lu(k,1670) - lu(k,327) * lu(k,1669) + lu(k,1673) = lu(k,1673) - lu(k,328) * lu(k,1669) + lu(k,2255) = lu(k,2255) - lu(k,327) * lu(k,2254) + lu(k,2260) = lu(k,2260) - lu(k,328) * lu(k,2254) + lu(k,3323) = lu(k,3323) - lu(k,327) * lu(k,3322) + lu(k,3326) = - lu(k,328) * lu(k,3322) + lu(k,4111) = lu(k,4111) - lu(k,327) * lu(k,4109) + lu(k,4117) = lu(k,4117) - lu(k,328) * lu(k,4109) + lu(k,329) = 1._r8 / lu(k,329) + lu(k,330) = lu(k,330) * lu(k,329) + lu(k,331) = lu(k,331) * lu(k,329) + lu(k,332) = lu(k,332) * lu(k,329) + lu(k,333) = lu(k,333) * lu(k,329) + lu(k,738) = lu(k,738) - lu(k,330) * lu(k,737) + lu(k,739) = lu(k,739) - lu(k,331) * lu(k,737) + lu(k,740) = lu(k,740) - lu(k,332) * lu(k,737) + lu(k,743) = lu(k,743) - lu(k,333) * lu(k,737) + lu(k,3446) = lu(k,3446) - lu(k,330) * lu(k,3417) + lu(k,3492) = lu(k,3492) - lu(k,331) * lu(k,3417) + lu(k,3564) = lu(k,3564) - lu(k,332) * lu(k,3417) + lu(k,3572) = lu(k,3572) - lu(k,333) * lu(k,3417) + lu(k,3679) = lu(k,3679) - lu(k,330) * lu(k,3626) + lu(k,3741) = lu(k,3741) - lu(k,331) * lu(k,3626) + lu(k,3814) = lu(k,3814) - lu(k,332) * lu(k,3626) + lu(k,3822) = lu(k,3822) - lu(k,333) * lu(k,3626) + lu(k,334) = 1._r8 / lu(k,334) + lu(k,335) = lu(k,335) * lu(k,334) + lu(k,336) = lu(k,336) * lu(k,334) + lu(k,337) = lu(k,337) * lu(k,334) + lu(k,338) = lu(k,338) * lu(k,334) + lu(k,835) = lu(k,835) - lu(k,335) * lu(k,826) + lu(k,836) = - lu(k,336) * lu(k,826) + lu(k,837) = - lu(k,337) * lu(k,826) + lu(k,838) = lu(k,838) - lu(k,338) * lu(k,826) + lu(k,897) = lu(k,897) - lu(k,335) * lu(k,888) + lu(k,898) = - lu(k,336) * lu(k,888) + lu(k,899) = - lu(k,337) * lu(k,888) + lu(k,901) = lu(k,901) - lu(k,338) * lu(k,888) + lu(k,3269) = lu(k,3269) - lu(k,335) * lu(k,3182) + lu(k,3270) = lu(k,3270) - lu(k,336) * lu(k,3182) + lu(k,3308) = lu(k,3308) - lu(k,337) * lu(k,3182) + lu(k,3315) = lu(k,3315) - lu(k,338) * lu(k,3182) + lu(k,339) = 1._r8 / lu(k,339) + lu(k,340) = lu(k,340) * lu(k,339) + lu(k,341) = lu(k,341) * lu(k,339) + lu(k,342) = lu(k,342) * lu(k,339) + lu(k,343) = lu(k,343) * lu(k,339) + lu(k,1597) = lu(k,1597) - lu(k,340) * lu(k,1595) + lu(k,1598) = lu(k,1598) - lu(k,341) * lu(k,1595) + lu(k,1602) = lu(k,1602) - lu(k,342) * lu(k,1595) + lu(k,1605) = lu(k,1605) - lu(k,343) * lu(k,1595) + lu(k,2552) = lu(k,2552) - lu(k,340) * lu(k,2549) + lu(k,2553) = lu(k,2553) - lu(k,341) * lu(k,2549) + lu(k,2557) = lu(k,2557) - lu(k,342) * lu(k,2549) + lu(k,2564) = lu(k,2564) - lu(k,343) * lu(k,2549) + lu(k,2591) = lu(k,2591) - lu(k,340) * lu(k,2589) + lu(k,2593) = lu(k,2593) - lu(k,341) * lu(k,2589) + lu(k,2597) = lu(k,2597) - lu(k,342) * lu(k,2589) + lu(k,2604) = lu(k,2604) - lu(k,343) * lu(k,2589) lu(k,344) = 1._r8 / lu(k,344) lu(k,345) = lu(k,345) * lu(k,344) lu(k,346) = lu(k,346) * lu(k,344) lu(k,347) = lu(k,347) * lu(k,344) lu(k,348) = lu(k,348) * lu(k,344) - lu(k,349) = lu(k,349) * lu(k,344) - lu(k,2599) = - lu(k,345) * lu(k,2596) - lu(k,2602) = lu(k,2602) - lu(k,346) * lu(k,2596) - lu(k,2627) = lu(k,2627) - lu(k,347) * lu(k,2596) - lu(k,2638) = lu(k,2638) - lu(k,348) * lu(k,2596) - lu(k,2639) = lu(k,2639) - lu(k,349) * lu(k,2596) - lu(k,3485) = - lu(k,345) * lu(k,3470) - lu(k,3490) = - lu(k,346) * lu(k,3470) - lu(k,3498) = lu(k,3498) - lu(k,347) * lu(k,3470) - lu(k,3511) = lu(k,3511) - lu(k,348) * lu(k,3470) - lu(k,3512) = lu(k,3512) - lu(k,349) * lu(k,3470) - lu(k,3663) = lu(k,3663) - lu(k,345) * lu(k,3574) - lu(k,3694) = lu(k,3694) - lu(k,346) * lu(k,3574) - lu(k,3738) = lu(k,3738) - lu(k,347) * lu(k,3574) - lu(k,3751) = lu(k,3751) - lu(k,348) * lu(k,3574) - lu(k,3752) = lu(k,3752) - lu(k,349) * lu(k,3574) + lu(k,453) = lu(k,453) - lu(k,345) * lu(k,452) + lu(k,454) = lu(k,454) - lu(k,346) * lu(k,452) + lu(k,456) = lu(k,456) - lu(k,347) * lu(k,452) + lu(k,457) = - lu(k,348) * lu(k,452) + lu(k,3430) = lu(k,3430) - lu(k,345) * lu(k,3418) + lu(k,3497) = lu(k,3497) - lu(k,346) * lu(k,3418) + lu(k,3571) = lu(k,3571) - lu(k,347) * lu(k,3418) + lu(k,3572) = lu(k,3572) - lu(k,348) * lu(k,3418) + lu(k,3644) = lu(k,3644) - lu(k,345) * lu(k,3627) + lu(k,3746) = lu(k,3746) - lu(k,346) * lu(k,3627) + lu(k,3821) = lu(k,3821) - lu(k,347) * lu(k,3627) + lu(k,3822) = lu(k,3822) - lu(k,348) * lu(k,3627) lu(k,350) = 1._r8 / lu(k,350) lu(k,351) = lu(k,351) * lu(k,350) lu(k,352) = lu(k,352) * lu(k,350) lu(k,353) = lu(k,353) * lu(k,350) lu(k,354) = lu(k,354) * lu(k,350) - lu(k,355) = lu(k,355) * lu(k,350) - lu(k,443) = lu(k,443) - lu(k,351) * lu(k,442) - lu(k,444) = lu(k,444) - lu(k,352) * lu(k,442) - lu(k,445) = lu(k,445) - lu(k,353) * lu(k,442) - lu(k,447) = lu(k,447) - lu(k,354) * lu(k,442) - lu(k,449) = - lu(k,355) * lu(k,442) - lu(k,3155) = lu(k,3155) - lu(k,351) * lu(k,3146) - lu(k,3206) = lu(k,3206) - lu(k,352) * lu(k,3146) - lu(k,3249) = lu(k,3249) - lu(k,353) * lu(k,3146) - lu(k,3285) = lu(k,3285) - lu(k,354) * lu(k,3146) - lu(k,3291) = lu(k,3291) - lu(k,355) * lu(k,3146) - lu(k,3589) = lu(k,3589) - lu(k,351) * lu(k,3575) - lu(k,3664) = lu(k,3664) - lu(k,352) * lu(k,3575) - lu(k,3711) = lu(k,3711) - lu(k,353) * lu(k,3575) - lu(k,3746) = lu(k,3746) - lu(k,354) * lu(k,3575) - lu(k,3752) = lu(k,3752) - lu(k,355) * lu(k,3575) - lu(k,358) = 1._r8 / lu(k,358) - lu(k,359) = lu(k,359) * lu(k,358) - lu(k,360) = lu(k,360) * lu(k,358) - lu(k,361) = lu(k,361) * lu(k,358) - lu(k,362) = lu(k,362) * lu(k,358) - lu(k,363) = lu(k,363) * lu(k,358) - lu(k,2771) = lu(k,2771) - lu(k,359) * lu(k,2764) - lu(k,2885) = lu(k,2885) - lu(k,360) * lu(k,2764) - lu(k,2889) = lu(k,2889) - lu(k,361) * lu(k,2764) - lu(k,2894) = lu(k,2894) - lu(k,362) * lu(k,2764) - lu(k,2895) = lu(k,2895) - lu(k,363) * lu(k,2764) - lu(k,3156) = lu(k,3156) - lu(k,359) * lu(k,3147) - lu(k,3281) = lu(k,3281) - lu(k,360) * lu(k,3147) - lu(k,3285) = lu(k,3285) - lu(k,361) * lu(k,3147) - lu(k,3290) = lu(k,3290) - lu(k,362) * lu(k,3147) - lu(k,3291) = lu(k,3291) - lu(k,363) * lu(k,3147) - lu(k,3592) = lu(k,3592) - lu(k,359) * lu(k,3576) - lu(k,3742) = lu(k,3742) - lu(k,360) * lu(k,3576) - lu(k,3746) = lu(k,3746) - lu(k,361) * lu(k,3576) - lu(k,3751) = lu(k,3751) - lu(k,362) * lu(k,3576) - lu(k,3752) = lu(k,3752) - lu(k,363) * lu(k,3576) - lu(k,364) = 1._r8 / lu(k,364) - lu(k,365) = lu(k,365) * lu(k,364) - lu(k,366) = lu(k,366) * lu(k,364) - lu(k,367) = lu(k,367) * lu(k,364) - lu(k,368) = lu(k,368) * lu(k,364) - lu(k,369) = lu(k,369) * lu(k,364) - lu(k,3283) = lu(k,3283) - lu(k,365) * lu(k,3148) - lu(k,3285) = lu(k,3285) - lu(k,366) * lu(k,3148) - lu(k,3290) = lu(k,3290) - lu(k,367) * lu(k,3148) - lu(k,3291) = lu(k,3291) - lu(k,368) * lu(k,3148) - lu(k,3295) = lu(k,3295) - lu(k,369) * lu(k,3148) - lu(k,3504) = lu(k,3504) - lu(k,365) * lu(k,3471) - lu(k,3506) = lu(k,3506) - lu(k,366) * lu(k,3471) - lu(k,3511) = lu(k,3511) - lu(k,367) * lu(k,3471) - lu(k,3512) = lu(k,3512) - lu(k,368) * lu(k,3471) - lu(k,3516) = - lu(k,369) * lu(k,3471) - lu(k,3744) = lu(k,3744) - lu(k,365) * lu(k,3577) - lu(k,3746) = lu(k,3746) - lu(k,366) * lu(k,3577) - lu(k,3751) = lu(k,3751) - lu(k,367) * lu(k,3577) - lu(k,3752) = lu(k,3752) - lu(k,368) * lu(k,3577) - lu(k,3756) = lu(k,3756) - lu(k,369) * lu(k,3577) + lu(k,440) = lu(k,440) - lu(k,351) * lu(k,439) + lu(k,441) = lu(k,441) - lu(k,352) * lu(k,439) + lu(k,443) = lu(k,443) - lu(k,353) * lu(k,439) + lu(k,444) = lu(k,444) - lu(k,354) * lu(k,439) + lu(k,3428) = lu(k,3428) - lu(k,351) * lu(k,3419) + lu(k,3437) = lu(k,3437) - lu(k,352) * lu(k,3419) + lu(k,3571) = lu(k,3571) - lu(k,353) * lu(k,3419) + lu(k,3572) = lu(k,3572) - lu(k,354) * lu(k,3419) + lu(k,3642) = lu(k,3642) - lu(k,351) * lu(k,3628) + lu(k,3658) = lu(k,3658) - lu(k,352) * lu(k,3628) + lu(k,3821) = lu(k,3821) - lu(k,353) * lu(k,3628) + lu(k,3822) = lu(k,3822) - lu(k,354) * lu(k,3628) + lu(k,355) = 1._r8 / lu(k,355) + lu(k,356) = lu(k,356) * lu(k,355) + lu(k,357) = lu(k,357) * lu(k,355) + lu(k,358) = lu(k,358) * lu(k,355) + lu(k,359) = lu(k,359) * lu(k,355) + lu(k,1348) = lu(k,1348) - lu(k,356) * lu(k,1347) + lu(k,1349) = lu(k,1349) - lu(k,357) * lu(k,1347) + lu(k,1353) = lu(k,1353) - lu(k,358) * lu(k,1347) + lu(k,1354) = lu(k,1354) - lu(k,359) * lu(k,1347) + lu(k,3489) = lu(k,3489) - lu(k,356) * lu(k,3420) + lu(k,3492) = lu(k,3492) - lu(k,357) * lu(k,3420) + lu(k,3571) = lu(k,3571) - lu(k,358) * lu(k,3420) + lu(k,3572) = lu(k,3572) - lu(k,359) * lu(k,3420) + lu(k,3736) = lu(k,3736) - lu(k,356) * lu(k,3629) + lu(k,3741) = lu(k,3741) - lu(k,357) * lu(k,3629) + lu(k,3821) = lu(k,3821) - lu(k,358) * lu(k,3629) + lu(k,3822) = lu(k,3822) - lu(k,359) * lu(k,3629) + 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,2922) = lu(k,2922) - lu(k,361) * lu(k,2917) + lu(k,2944) = lu(k,2944) - lu(k,362) * lu(k,2917) + lu(k,2948) = lu(k,2948) - lu(k,363) * lu(k,2917) + lu(k,2957) = lu(k,2957) - lu(k,364) * lu(k,2917) + lu(k,3507) = lu(k,3507) - lu(k,361) * lu(k,3421) + lu(k,3559) = lu(k,3559) - lu(k,362) * lu(k,3421) + lu(k,3563) = lu(k,3563) - lu(k,363) * lu(k,3421) + lu(k,3572) = lu(k,3572) - lu(k,364) * lu(k,3421) + lu(k,3758) = lu(k,3758) - lu(k,361) * lu(k,3630) + lu(k,3809) = lu(k,3809) - lu(k,362) * lu(k,3630) + lu(k,3813) = lu(k,3813) - lu(k,363) * lu(k,3630) + lu(k,3822) = lu(k,3822) - lu(k,364) * lu(k,3630) + lu(k,365) = 1._r8 / lu(k,365) + lu(k,366) = lu(k,366) * lu(k,365) + lu(k,367) = lu(k,367) * lu(k,365) + lu(k,368) = lu(k,368) * lu(k,365) + lu(k,369) = lu(k,369) * lu(k,365) + lu(k,2829) = lu(k,2829) - lu(k,366) * lu(k,2824) + lu(k,2850) = lu(k,2850) - lu(k,367) * lu(k,2824) + lu(k,2853) = lu(k,2853) - lu(k,368) * lu(k,2824) + lu(k,2864) = lu(k,2864) - lu(k,369) * lu(k,2824) + lu(k,3507) = lu(k,3507) - lu(k,366) * lu(k,3422) + lu(k,3558) = lu(k,3558) - lu(k,367) * lu(k,3422) + lu(k,3561) = lu(k,3561) - lu(k,368) * lu(k,3422) + lu(k,3572) = lu(k,3572) - lu(k,369) * lu(k,3422) + lu(k,3758) = lu(k,3758) - lu(k,366) * lu(k,3631) + lu(k,3808) = lu(k,3808) - lu(k,367) * lu(k,3631) + lu(k,3811) = lu(k,3811) - lu(k,368) * lu(k,3631) + lu(k,3822) = lu(k,3822) - lu(k,369) * lu(k,3631) + lu(k,370) = 1._r8 / lu(k,370) + lu(k,371) = lu(k,371) * lu(k,370) + lu(k,372) = lu(k,372) * lu(k,370) + lu(k,373) = lu(k,373) * lu(k,370) + lu(k,943) = - lu(k,371) * lu(k,941) + lu(k,950) = lu(k,950) - lu(k,372) * lu(k,941) + lu(k,951) = lu(k,951) - lu(k,373) * lu(k,941) + lu(k,1002) = - lu(k,371) * lu(k,1001) + lu(k,1009) = lu(k,1009) - lu(k,372) * lu(k,1001) + lu(k,1010) = lu(k,1010) - lu(k,373) * lu(k,1001) + lu(k,3441) = lu(k,3441) - lu(k,371) * lu(k,3423) + lu(k,3571) = lu(k,3571) - lu(k,372) * lu(k,3423) + lu(k,3572) = lu(k,3572) - lu(k,373) * lu(k,3423) + lu(k,3673) = lu(k,3673) - lu(k,371) * lu(k,3632) + lu(k,3821) = lu(k,3821) - lu(k,372) * lu(k,3632) + lu(k,3822) = lu(k,3822) - lu(k,373) * lu(k,3632) end do end subroutine lu_fac07 subroutine lu_fac08( avec_len, lu ) @@ -934,160 +851,133 @@ subroutine lu_fac08( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,370) = 1._r8 / lu(k,370) - lu(k,371) = lu(k,371) * lu(k,370) - lu(k,372) = lu(k,372) * lu(k,370) - lu(k,373) = lu(k,373) * lu(k,370) - lu(k,374) = lu(k,374) * lu(k,370) - lu(k,375) = lu(k,375) * lu(k,370) - lu(k,3280) = lu(k,3280) - lu(k,371) * lu(k,3149) - lu(k,3287) = lu(k,3287) - lu(k,372) * lu(k,3149) - lu(k,3288) = lu(k,3288) - lu(k,373) * lu(k,3149) - lu(k,3291) = lu(k,3291) - lu(k,374) * lu(k,3149) - lu(k,3295) = lu(k,3295) - lu(k,375) * lu(k,3149) - lu(k,3421) = - lu(k,371) * lu(k,3348) - lu(k,3428) = lu(k,3428) - lu(k,372) * lu(k,3348) - lu(k,3429) = lu(k,3429) - lu(k,373) * lu(k,3348) - lu(k,3432) = lu(k,3432) - lu(k,374) * lu(k,3348) - lu(k,3436) = - lu(k,375) * lu(k,3348) - lu(k,3741) = lu(k,3741) - lu(k,371) * lu(k,3578) - lu(k,3748) = lu(k,3748) - lu(k,372) * lu(k,3578) - lu(k,3749) = lu(k,3749) - lu(k,373) * lu(k,3578) - lu(k,3752) = lu(k,3752) - lu(k,374) * lu(k,3578) - lu(k,3756) = lu(k,3756) - lu(k,375) * lu(k,3578) - 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,2813) = lu(k,2813) - lu(k,378) * lu(k,2765) - lu(k,2885) = lu(k,2885) - lu(k,379) * lu(k,2765) - lu(k,2889) = lu(k,2889) - lu(k,380) * lu(k,2765) - lu(k,2894) = lu(k,2894) - lu(k,381) * lu(k,2765) - lu(k,2895) = lu(k,2895) - lu(k,382) * lu(k,2765) - lu(k,3206) = lu(k,3206) - lu(k,378) * lu(k,3150) - lu(k,3281) = lu(k,3281) - lu(k,379) * lu(k,3150) - lu(k,3285) = lu(k,3285) - lu(k,380) * lu(k,3150) - lu(k,3290) = lu(k,3290) - lu(k,381) * lu(k,3150) - lu(k,3291) = lu(k,3291) - lu(k,382) * lu(k,3150) - lu(k,3664) = lu(k,3664) - lu(k,378) * lu(k,3579) - lu(k,3742) = lu(k,3742) - lu(k,379) * lu(k,3579) - lu(k,3746) = lu(k,3746) - lu(k,380) * lu(k,3579) - lu(k,3751) = lu(k,3751) - lu(k,381) * lu(k,3579) - lu(k,3752) = lu(k,3752) - lu(k,382) * lu(k,3579) - lu(k,383) = 1._r8 / lu(k,383) - lu(k,384) = lu(k,384) * lu(k,383) - lu(k,385) = lu(k,385) * lu(k,383) - lu(k,436) = - lu(k,384) * lu(k,434) - lu(k,439) = lu(k,439) - lu(k,385) * lu(k,434) - lu(k,614) = - lu(k,384) * lu(k,612) - lu(k,621) = lu(k,621) - lu(k,385) * lu(k,612) - lu(k,732) = - lu(k,384) * lu(k,730) - lu(k,740) = lu(k,740) - lu(k,385) * lu(k,730) - lu(k,761) = - lu(k,384) * lu(k,759) - lu(k,769) = lu(k,769) - lu(k,385) * lu(k,759) - lu(k,777) = - lu(k,384) * lu(k,775) - lu(k,786) = lu(k,786) - lu(k,385) * lu(k,775) - lu(k,2785) = lu(k,2785) - lu(k,384) * lu(k,2766) - lu(k,2889) = lu(k,2889) - lu(k,385) * lu(k,2766) - lu(k,3177) = lu(k,3177) - lu(k,384) * lu(k,3151) - lu(k,3285) = lu(k,3285) - lu(k,385) * lu(k,3151) - lu(k,3624) = - lu(k,384) * lu(k,3580) - lu(k,3746) = lu(k,3746) - lu(k,385) * lu(k,3580) - lu(k,386) = 1._r8 / lu(k,386) - lu(k,387) = lu(k,387) * lu(k,386) - lu(k,388) = lu(k,388) * lu(k,386) - lu(k,389) = lu(k,389) * lu(k,386) - lu(k,390) = lu(k,390) * lu(k,386) - lu(k,2093) = - lu(k,387) * lu(k,2092) - lu(k,2099) = lu(k,2099) - lu(k,388) * lu(k,2092) - lu(k,2109) = lu(k,2109) - lu(k,389) * lu(k,2092) - lu(k,2113) = lu(k,2113) - lu(k,390) * lu(k,2092) - lu(k,2263) = - lu(k,387) * lu(k,2262) - lu(k,2272) = lu(k,2272) - lu(k,388) * lu(k,2262) - lu(k,2285) = lu(k,2285) - lu(k,389) * lu(k,2262) - lu(k,2289) = lu(k,2289) - lu(k,390) * lu(k,2262) - lu(k,3189) = lu(k,3189) - lu(k,387) * lu(k,3152) - lu(k,3270) = lu(k,3270) - lu(k,388) * lu(k,3152) - lu(k,3285) = lu(k,3285) - lu(k,389) * lu(k,3152) - lu(k,3291) = lu(k,3291) - lu(k,390) * lu(k,3152) - lu(k,3640) = lu(k,3640) - lu(k,387) * lu(k,3581) - lu(k,3731) = lu(k,3731) - lu(k,388) * lu(k,3581) - lu(k,3746) = lu(k,3746) - lu(k,389) * lu(k,3581) - lu(k,3752) = lu(k,3752) - lu(k,390) * lu(k,3581) - lu(k,391) = 1._r8 / lu(k,391) - lu(k,392) = lu(k,392) * lu(k,391) - lu(k,393) = lu(k,393) * lu(k,391) - lu(k,394) = lu(k,394) * lu(k,391) - lu(k,395) = lu(k,395) * lu(k,391) - lu(k,396) = lu(k,396) * lu(k,391) - lu(k,397) = lu(k,397) * lu(k,391) - lu(k,1497) = lu(k,1497) - lu(k,392) * lu(k,1494) - lu(k,1498) = lu(k,1498) - lu(k,393) * lu(k,1494) - lu(k,1499) = - lu(k,394) * lu(k,1494) - lu(k,1503) = lu(k,1503) - lu(k,395) * lu(k,1494) - lu(k,1507) = lu(k,1507) - lu(k,396) * lu(k,1494) - lu(k,1508) = lu(k,1508) - lu(k,397) * lu(k,1494) - lu(k,3488) = lu(k,3488) - lu(k,392) * lu(k,3472) - lu(k,3490) = lu(k,3490) - lu(k,393) * lu(k,3472) - lu(k,3491) = - lu(k,394) * lu(k,3472) - lu(k,3504) = lu(k,3504) - lu(k,395) * lu(k,3472) - lu(k,3511) = lu(k,3511) - lu(k,396) * lu(k,3472) - lu(k,3512) = lu(k,3512) - lu(k,397) * lu(k,3472) - lu(k,3691) = lu(k,3691) - lu(k,392) * lu(k,3582) - lu(k,3694) = lu(k,3694) - lu(k,393) * lu(k,3582) - lu(k,3699) = lu(k,3699) - lu(k,394) * lu(k,3582) - lu(k,3744) = lu(k,3744) - lu(k,395) * lu(k,3582) - lu(k,3751) = lu(k,3751) - lu(k,396) * lu(k,3582) - lu(k,3752) = lu(k,3752) - lu(k,397) * lu(k,3582) + lu(k,374) = 1._r8 / lu(k,374) + lu(k,375) = lu(k,375) * lu(k,374) + lu(k,376) = lu(k,376) * lu(k,374) + lu(k,377) = lu(k,377) * lu(k,374) + lu(k,378) = lu(k,378) * lu(k,374) + lu(k,379) = lu(k,379) * lu(k,374) + lu(k,380) = lu(k,380) * lu(k,374) + lu(k,381) = lu(k,381) * lu(k,374) + lu(k,3665) = lu(k,3665) - lu(k,375) * lu(k,3633) + lu(k,3741) = lu(k,3741) - lu(k,376) * lu(k,3633) + lu(k,3790) = lu(k,3790) - lu(k,377) * lu(k,3633) + lu(k,3819) = lu(k,3819) - lu(k,378) * lu(k,3633) + lu(k,3822) = lu(k,3822) - lu(k,379) * lu(k,3633) + lu(k,3824) = lu(k,3824) - lu(k,380) * lu(k,3633) + lu(k,3826) = lu(k,3826) - lu(k,381) * lu(k,3633) + lu(k,3874) = - lu(k,375) * lu(k,3873) + lu(k,3890) = lu(k,3890) - lu(k,376) * lu(k,3873) + lu(k,3925) = lu(k,3925) - lu(k,377) * lu(k,3873) + lu(k,3954) = lu(k,3954) - lu(k,378) * lu(k,3873) + lu(k,3957) = lu(k,3957) - lu(k,379) * lu(k,3873) + lu(k,3959) = lu(k,3959) - lu(k,380) * lu(k,3873) + lu(k,3961) = lu(k,3961) - lu(k,381) * lu(k,3873) + lu(k,382) = 1._r8 / lu(k,382) + lu(k,383) = lu(k,383) * lu(k,382) + lu(k,384) = lu(k,384) * lu(k,382) + lu(k,385) = lu(k,385) * lu(k,382) + lu(k,386) = lu(k,386) * lu(k,382) + lu(k,387) = lu(k,387) * lu(k,382) + lu(k,388) = lu(k,388) * lu(k,382) + lu(k,389) = lu(k,389) * lu(k,382) + lu(k,3368) = - lu(k,383) * lu(k,3367) + lu(k,3373) = - lu(k,384) * lu(k,3367) + lu(k,3376) = lu(k,3376) - lu(k,385) * lu(k,3367) + lu(k,3378) = lu(k,3378) - lu(k,386) * lu(k,3367) + lu(k,3382) = lu(k,3382) - lu(k,387) * lu(k,3367) + lu(k,3390) = lu(k,3390) - lu(k,388) * lu(k,3367) + lu(k,3392) = lu(k,3392) - lu(k,389) * lu(k,3367) + lu(k,3657) = lu(k,3657) - lu(k,383) * lu(k,3634) + lu(k,3727) = lu(k,3727) - lu(k,384) * lu(k,3634) + lu(k,3757) = lu(k,3757) - lu(k,385) * lu(k,3634) + lu(k,3777) = lu(k,3777) - lu(k,386) * lu(k,3634) + lu(k,3802) = lu(k,3802) - lu(k,387) * lu(k,3634) + lu(k,3820) = lu(k,3820) - lu(k,388) * lu(k,3634) + lu(k,3822) = lu(k,3822) - lu(k,389) * lu(k,3634) + lu(k,390) = 1._r8 / lu(k,390) + lu(k,391) = lu(k,391) * lu(k,390) + lu(k,392) = lu(k,392) * lu(k,390) + lu(k,393) = lu(k,393) * lu(k,390) + lu(k,394) = lu(k,394) * lu(k,390) + lu(k,395) = lu(k,395) * lu(k,390) + lu(k,396) = lu(k,396) * lu(k,390) + lu(k,397) = lu(k,397) * lu(k,390) + lu(k,3777) = lu(k,3777) - lu(k,391) * lu(k,3635) + lu(k,3816) = lu(k,3816) - lu(k,392) * lu(k,3635) + lu(k,3821) = lu(k,3821) - lu(k,393) * lu(k,3635) + lu(k,3822) = lu(k,3822) - lu(k,394) * lu(k,3635) + lu(k,3823) = lu(k,3823) - lu(k,395) * lu(k,3635) + lu(k,3825) = lu(k,3825) - lu(k,396) * lu(k,3635) + lu(k,3827) = lu(k,3827) - lu(k,397) * lu(k,3635) + lu(k,3848) = lu(k,3848) - lu(k,391) * lu(k,3831) + lu(k,3857) = lu(k,3857) - lu(k,392) * lu(k,3831) + lu(k,3862) = lu(k,3862) - lu(k,393) * lu(k,3831) + lu(k,3863) = lu(k,3863) - lu(k,394) * lu(k,3831) + lu(k,3864) = lu(k,3864) - lu(k,395) * lu(k,3831) + lu(k,3866) = lu(k,3866) - lu(k,396) * lu(k,3831) + lu(k,3868) = lu(k,3868) - lu(k,397) * lu(k,3831) lu(k,398) = 1._r8 / lu(k,398) lu(k,399) = lu(k,399) * lu(k,398) lu(k,400) = lu(k,400) * lu(k,398) lu(k,401) = lu(k,401) * lu(k,398) - lu(k,402) = lu(k,402) * lu(k,398) - lu(k,403) = lu(k,403) * lu(k,398) - lu(k,404) = lu(k,404) * lu(k,398) - lu(k,2699) = lu(k,2699) - lu(k,399) * lu(k,2643) - lu(k,2704) = - lu(k,400) * lu(k,2643) - lu(k,2706) = lu(k,2706) - lu(k,401) * lu(k,2643) - lu(k,2707) = lu(k,2707) - lu(k,402) * lu(k,2643) - lu(k,2709) = lu(k,2709) - lu(k,403) * lu(k,2643) - lu(k,2710) = lu(k,2710) - lu(k,404) * lu(k,2643) - lu(k,3499) = lu(k,3499) - lu(k,399) * lu(k,3473) - lu(k,3504) = lu(k,3504) - lu(k,400) * lu(k,3473) - lu(k,3508) = - lu(k,401) * lu(k,3473) - lu(k,3509) = - lu(k,402) * lu(k,3473) - lu(k,3511) = lu(k,3511) - lu(k,403) * lu(k,3473) - lu(k,3512) = lu(k,3512) - lu(k,404) * lu(k,3473) - lu(k,3739) = lu(k,3739) - lu(k,399) * lu(k,3583) - lu(k,3744) = lu(k,3744) - lu(k,400) * lu(k,3583) - lu(k,3748) = lu(k,3748) - lu(k,401) * lu(k,3583) - lu(k,3749) = lu(k,3749) - lu(k,402) * lu(k,3583) - lu(k,3751) = lu(k,3751) - lu(k,403) * lu(k,3583) - lu(k,3752) = lu(k,3752) - lu(k,404) * lu(k,3583) - lu(k,405) = 1._r8 / lu(k,405) - lu(k,406) = lu(k,406) * lu(k,405) - lu(k,407) = lu(k,407) * lu(k,405) - lu(k,408) = lu(k,408) * lu(k,405) - lu(k,604) = lu(k,604) - lu(k,406) * lu(k,603) - lu(k,606) = - lu(k,407) * lu(k,603) - lu(k,608) = lu(k,608) - lu(k,408) * lu(k,603) - lu(k,2777) = lu(k,2777) - lu(k,406) * lu(k,2767) - lu(k,2886) = lu(k,2886) - lu(k,407) * lu(k,2767) - lu(k,2894) = lu(k,2894) - lu(k,408) * lu(k,2767) - lu(k,2911) = lu(k,2911) - lu(k,406) * lu(k,2906) - lu(k,2987) = lu(k,2987) - lu(k,407) * lu(k,2906) - lu(k,2995) = lu(k,2995) - lu(k,408) * lu(k,2906) - lu(k,3165) = lu(k,3165) - lu(k,406) * lu(k,3153) - lu(k,3282) = lu(k,3282) - lu(k,407) * lu(k,3153) - lu(k,3290) = lu(k,3290) - lu(k,408) * lu(k,3153) - lu(k,3479) = - lu(k,406) * lu(k,3474) - lu(k,3503) = lu(k,3503) - lu(k,407) * lu(k,3474) - lu(k,3511) = lu(k,3511) - lu(k,408) * lu(k,3474) - lu(k,3609) = lu(k,3609) - lu(k,406) * lu(k,3584) - lu(k,3743) = lu(k,3743) - lu(k,407) * lu(k,3584) - lu(k,3751) = lu(k,3751) - lu(k,408) * lu(k,3584) + lu(k,752) = - lu(k,399) * lu(k,746) + lu(k,755) = - lu(k,400) * lu(k,746) + lu(k,756) = lu(k,756) - lu(k,401) * lu(k,746) + lu(k,833) = - lu(k,399) * lu(k,827) + lu(k,836) = lu(k,836) - lu(k,400) * lu(k,827) + lu(k,838) = lu(k,838) - lu(k,401) * lu(k,827) + lu(k,879) = - lu(k,399) * lu(k,873) + lu(k,882) = - lu(k,400) * lu(k,873) + lu(k,884) = lu(k,884) - lu(k,401) * lu(k,873) + lu(k,895) = - lu(k,399) * lu(k,889) + lu(k,898) = lu(k,898) - lu(k,400) * lu(k,889) + lu(k,901) = lu(k,901) - lu(k,401) * lu(k,889) + lu(k,3210) = lu(k,3210) - lu(k,399) * lu(k,3183) + lu(k,3270) = lu(k,3270) - lu(k,400) * lu(k,3183) + lu(k,3315) = lu(k,3315) - lu(k,401) * lu(k,3183) + lu(k,402) = 1._r8 / lu(k,402) + lu(k,403) = lu(k,403) * lu(k,402) + lu(k,404) = lu(k,404) * lu(k,402) + lu(k,405) = lu(k,405) * lu(k,402) + lu(k,406) = lu(k,406) * lu(k,402) + lu(k,407) = lu(k,407) * lu(k,402) + lu(k,1334) = lu(k,1334) - lu(k,403) * lu(k,1333) + lu(k,1338) = lu(k,1338) - lu(k,404) * lu(k,1333) + lu(k,1340) = lu(k,1340) - lu(k,405) * lu(k,1333) + lu(k,1342) = lu(k,1342) - lu(k,406) * lu(k,1333) + lu(k,1345) = - lu(k,407) * lu(k,1333) + lu(k,3488) = lu(k,3488) - lu(k,403) * lu(k,3424) + lu(k,3564) = lu(k,3564) - lu(k,404) * lu(k,3424) + lu(k,3569) = lu(k,3569) - lu(k,405) * lu(k,3424) + lu(k,3572) = lu(k,3572) - lu(k,406) * lu(k,3424) + lu(k,3577) = lu(k,3577) - lu(k,407) * lu(k,3424) + lu(k,3735) = lu(k,3735) - lu(k,403) * lu(k,3636) + lu(k,3814) = lu(k,3814) - lu(k,404) * lu(k,3636) + lu(k,3819) = lu(k,3819) - lu(k,405) * lu(k,3636) + lu(k,3822) = lu(k,3822) - lu(k,406) * lu(k,3636) + lu(k,3827) = lu(k,3827) - lu(k,407) * lu(k,3636) + 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,1042) = lu(k,1042) - lu(k,409) * lu(k,1041) + lu(k,1044) = lu(k,1044) - lu(k,410) * lu(k,1041) + lu(k,1047) = lu(k,1047) - lu(k,411) * lu(k,1041) + lu(k,1048) = - lu(k,412) * lu(k,1041) + lu(k,1051) = - lu(k,413) * lu(k,1041) + lu(k,3472) = lu(k,3472) - lu(k,409) * lu(k,3425) + lu(k,3540) = lu(k,3540) - lu(k,410) * lu(k,3425) + lu(k,3571) = lu(k,3571) - lu(k,411) * lu(k,3425) + lu(k,3572) = lu(k,3572) - lu(k,412) * lu(k,3425) + lu(k,3577) = lu(k,3577) - lu(k,413) * lu(k,3425) + lu(k,3710) = lu(k,3710) - lu(k,409) * lu(k,3637) + lu(k,3790) = lu(k,3790) - lu(k,410) * lu(k,3637) + lu(k,3821) = lu(k,3821) - lu(k,411) * lu(k,3637) + lu(k,3822) = lu(k,3822) - lu(k,412) * lu(k,3637) + lu(k,3827) = lu(k,3827) - lu(k,413) * lu(k,3637) end do end subroutine lu_fac08 subroutine lu_fac09( avec_len, lu ) @@ -1104,134 +994,174 @@ subroutine lu_fac09( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,409) = 1._r8 / lu(k,409) - lu(k,410) = lu(k,410) * lu(k,409) - lu(k,411) = lu(k,411) * lu(k,409) - lu(k,412) = lu(k,412) * lu(k,409) - lu(k,413) = lu(k,413) * lu(k,409) - lu(k,414) = lu(k,414) * lu(k,409) - lu(k,415) = lu(k,415) * lu(k,409) - lu(k,416) = lu(k,416) * lu(k,409) - lu(k,417) = lu(k,417) * lu(k,409) - lu(k,418) = lu(k,418) * lu(k,409) - lu(k,1049) = - lu(k,410) * lu(k,1047) - lu(k,1051) = - lu(k,411) * lu(k,1047) - lu(k,1052) = - lu(k,412) * lu(k,1047) - lu(k,1054) = - lu(k,413) * lu(k,1047) - lu(k,1058) = - lu(k,414) * lu(k,1047) - lu(k,1059) = - lu(k,415) * lu(k,1047) - lu(k,1060) = lu(k,1060) - lu(k,416) * lu(k,1047) - lu(k,1061) = lu(k,1061) - lu(k,417) * lu(k,1047) - lu(k,1062) = lu(k,1062) - lu(k,418) * lu(k,1047) - lu(k,3658) = lu(k,3658) - lu(k,410) * lu(k,3585) - lu(k,3669) = lu(k,3669) - lu(k,411) * lu(k,3585) - lu(k,3690) = lu(k,3690) - lu(k,412) * lu(k,3585) - lu(k,3711) = lu(k,3711) - lu(k,413) * lu(k,3585) - lu(k,3740) = lu(k,3740) - lu(k,414) * lu(k,3585) - lu(k,3746) = lu(k,3746) - lu(k,415) * lu(k,3585) - lu(k,3748) = lu(k,3748) - lu(k,416) * lu(k,3585) - lu(k,3751) = lu(k,3751) - lu(k,417) * lu(k,3585) - lu(k,3752) = lu(k,3752) - lu(k,418) * lu(k,3585) - lu(k,419) = 1._r8 / lu(k,419) - lu(k,420) = lu(k,420) * lu(k,419) - lu(k,421) = lu(k,421) * lu(k,419) - lu(k,422) = lu(k,422) * lu(k,419) - lu(k,423) = lu(k,423) * lu(k,419) - lu(k,424) = lu(k,424) * lu(k,419) - lu(k,425) = lu(k,425) * lu(k,419) - lu(k,1772) = - lu(k,420) * lu(k,1766) - lu(k,1774) = lu(k,1774) - lu(k,421) * lu(k,1766) - lu(k,1777) = lu(k,1777) - lu(k,422) * lu(k,1766) - lu(k,1784) = - lu(k,423) * lu(k,1766) - lu(k,1790) = lu(k,1790) - lu(k,424) * lu(k,1766) - lu(k,1794) = lu(k,1794) - lu(k,425) * lu(k,1766) - lu(k,1881) = - lu(k,420) * lu(k,1876) - lu(k,1883) = - lu(k,421) * lu(k,1876) - lu(k,1886) = - lu(k,422) * lu(k,1876) - lu(k,1895) = lu(k,1895) - lu(k,423) * lu(k,1876) - lu(k,1906) = lu(k,1906) - lu(k,424) * lu(k,1876) - lu(k,1910) = lu(k,1910) - lu(k,425) * lu(k,1876) - lu(k,3669) = lu(k,3669) - lu(k,420) * lu(k,3586) - lu(k,3681) = lu(k,3681) - lu(k,421) * lu(k,3586) - lu(k,3694) = lu(k,3694) - lu(k,422) * lu(k,3586) - lu(k,3712) = lu(k,3712) - lu(k,423) * lu(k,3586) - lu(k,3746) = lu(k,3746) - lu(k,424) * lu(k,3586) - lu(k,3752) = lu(k,3752) - lu(k,425) * lu(k,3586) + lu(k,414) = 1._r8 / lu(k,414) + lu(k,415) = lu(k,415) * lu(k,414) + lu(k,416) = lu(k,416) * lu(k,414) + lu(k,417) = lu(k,417) * lu(k,414) + lu(k,418) = lu(k,418) * lu(k,414) + lu(k,419) = lu(k,419) * lu(k,414) + lu(k,524) = lu(k,524) - lu(k,415) * lu(k,523) + lu(k,525) = lu(k,525) - lu(k,416) * lu(k,523) + lu(k,527) = lu(k,527) - lu(k,417) * lu(k,523) + lu(k,529) = lu(k,529) - lu(k,418) * lu(k,523) + lu(k,530) = - lu(k,419) * lu(k,523) + lu(k,3432) = - lu(k,415) * lu(k,3426) + lu(k,3435) = lu(k,3435) - lu(k,416) * lu(k,3426) + lu(k,3497) = lu(k,3497) - lu(k,417) * lu(k,3426) + lu(k,3571) = lu(k,3571) - lu(k,418) * lu(k,3426) + lu(k,3572) = lu(k,3572) - lu(k,419) * lu(k,3426) + lu(k,3646) = lu(k,3646) - lu(k,415) * lu(k,3638) + lu(k,3655) = lu(k,3655) - lu(k,416) * lu(k,3638) + lu(k,3746) = lu(k,3746) - lu(k,417) * lu(k,3638) + lu(k,3821) = lu(k,3821) - lu(k,418) * lu(k,3638) + lu(k,3822) = lu(k,3822) - lu(k,419) * lu(k,3638) + lu(k,420) = 1._r8 / lu(k,420) + lu(k,421) = lu(k,421) * lu(k,420) + lu(k,422) = lu(k,422) * lu(k,420) + lu(k,423) = lu(k,423) * lu(k,420) + lu(k,424) = lu(k,424) * lu(k,420) + lu(k,425) = lu(k,425) * lu(k,420) + lu(k,2873) = - lu(k,421) * lu(k,2870) + lu(k,2880) = lu(k,2880) - lu(k,422) * lu(k,2870) + lu(k,2901) = lu(k,2901) - lu(k,423) * lu(k,2870) + lu(k,2911) = lu(k,2911) - lu(k,424) * lu(k,2870) + lu(k,2915) = lu(k,2915) - lu(k,425) * lu(k,2870) + lu(k,3731) = lu(k,3731) - lu(k,421) * lu(k,3639) + lu(k,3777) = lu(k,3777) - lu(k,422) * lu(k,3639) + lu(k,3812) = lu(k,3812) - lu(k,423) * lu(k,3639) + lu(k,3822) = lu(k,3822) - lu(k,424) * lu(k,3639) + lu(k,3826) = lu(k,3826) - lu(k,425) * lu(k,3639) + lu(k,4074) = - lu(k,421) * lu(k,4058) + lu(k,4082) = - lu(k,422) * lu(k,4058) + lu(k,4091) = lu(k,4091) - lu(k,423) * lu(k,4058) + lu(k,4101) = lu(k,4101) - lu(k,424) * lu(k,4058) + lu(k,4105) = lu(k,4105) - lu(k,425) * lu(k,4058) lu(k,426) = 1._r8 / lu(k,426) lu(k,427) = lu(k,427) * lu(k,426) lu(k,428) = lu(k,428) * lu(k,426) lu(k,429) = lu(k,429) * lu(k,426) lu(k,430) = lu(k,430) * lu(k,426) lu(k,431) = lu(k,431) * lu(k,426) - lu(k,432) = lu(k,432) * lu(k,426) - lu(k,1659) = - lu(k,427) * lu(k,1654) - lu(k,1660) = lu(k,1660) - lu(k,428) * lu(k,1654) - lu(k,1664) = lu(k,1664) - lu(k,429) * lu(k,1654) - lu(k,1670) = - lu(k,430) * lu(k,1654) - lu(k,1678) = lu(k,1678) - lu(k,431) * lu(k,1654) - lu(k,1682) = lu(k,1682) - lu(k,432) * lu(k,1654) - lu(k,1881) = lu(k,1881) - lu(k,427) * lu(k,1877) - lu(k,1882) = - lu(k,428) * lu(k,1877) - lu(k,1886) = lu(k,1886) - lu(k,429) * lu(k,1877) - lu(k,1891) = lu(k,1891) - lu(k,430) * lu(k,1877) - lu(k,1906) = lu(k,1906) - lu(k,431) * lu(k,1877) - lu(k,1910) = lu(k,1910) - lu(k,432) * lu(k,1877) - lu(k,3669) = lu(k,3669) - lu(k,427) * lu(k,3587) - lu(k,3676) = lu(k,3676) - lu(k,428) * lu(k,3587) - lu(k,3694) = lu(k,3694) - lu(k,429) * lu(k,3587) - lu(k,3707) = lu(k,3707) - lu(k,430) * lu(k,3587) - lu(k,3746) = lu(k,3746) - lu(k,431) * lu(k,3587) - lu(k,3752) = lu(k,3752) - lu(k,432) * lu(k,3587) - lu(k,435) = 1._r8 / lu(k,435) - lu(k,436) = lu(k,436) * lu(k,435) - lu(k,437) = lu(k,437) * lu(k,435) - lu(k,438) = lu(k,438) * lu(k,435) - lu(k,439) = lu(k,439) * lu(k,435) - lu(k,440) = lu(k,440) * lu(k,435) - lu(k,441) = lu(k,441) * lu(k,435) - lu(k,2785) = lu(k,2785) - lu(k,436) * lu(k,2768) - lu(k,2813) = lu(k,2813) - lu(k,437) * lu(k,2768) - lu(k,2885) = lu(k,2885) - lu(k,438) * lu(k,2768) - lu(k,2889) = lu(k,2889) - lu(k,439) * lu(k,2768) - lu(k,2894) = lu(k,2894) - lu(k,440) * lu(k,2768) - lu(k,2895) = lu(k,2895) - lu(k,441) * lu(k,2768) - lu(k,3177) = lu(k,3177) - lu(k,436) * lu(k,3154) - lu(k,3206) = lu(k,3206) - lu(k,437) * lu(k,3154) - lu(k,3281) = lu(k,3281) - lu(k,438) * lu(k,3154) - lu(k,3285) = lu(k,3285) - lu(k,439) * lu(k,3154) - lu(k,3290) = lu(k,3290) - lu(k,440) * lu(k,3154) - lu(k,3291) = lu(k,3291) - lu(k,441) * lu(k,3154) - lu(k,3624) = lu(k,3624) - lu(k,436) * lu(k,3588) - lu(k,3664) = lu(k,3664) - lu(k,437) * lu(k,3588) - lu(k,3742) = lu(k,3742) - lu(k,438) * lu(k,3588) - lu(k,3746) = lu(k,3746) - lu(k,439) * lu(k,3588) - lu(k,3751) = lu(k,3751) - lu(k,440) * lu(k,3588) - lu(k,3752) = lu(k,3752) - lu(k,441) * lu(k,3588) - lu(k,443) = 1._r8 / lu(k,443) - lu(k,444) = lu(k,444) * lu(k,443) - lu(k,445) = lu(k,445) * lu(k,443) - lu(k,446) = lu(k,446) * lu(k,443) - lu(k,447) = lu(k,447) * lu(k,443) - lu(k,448) = lu(k,448) * lu(k,443) - lu(k,449) = lu(k,449) * lu(k,443) - lu(k,2813) = lu(k,2813) - lu(k,444) * lu(k,2769) - lu(k,2853) = lu(k,2853) - lu(k,445) * lu(k,2769) - lu(k,2885) = lu(k,2885) - lu(k,446) * lu(k,2769) - lu(k,2889) = lu(k,2889) - lu(k,447) * lu(k,2769) - lu(k,2894) = lu(k,2894) - lu(k,448) * lu(k,2769) - lu(k,2895) = lu(k,2895) - lu(k,449) * lu(k,2769) - lu(k,3206) = lu(k,3206) - lu(k,444) * lu(k,3155) - lu(k,3249) = lu(k,3249) - lu(k,445) * lu(k,3155) - lu(k,3281) = lu(k,3281) - lu(k,446) * lu(k,3155) - lu(k,3285) = lu(k,3285) - lu(k,447) * lu(k,3155) - lu(k,3290) = lu(k,3290) - lu(k,448) * lu(k,3155) - lu(k,3291) = lu(k,3291) - lu(k,449) * lu(k,3155) - lu(k,3664) = lu(k,3664) - lu(k,444) * lu(k,3589) - lu(k,3711) = lu(k,3711) - lu(k,445) * lu(k,3589) - lu(k,3742) = lu(k,3742) - lu(k,446) * lu(k,3589) - lu(k,3746) = lu(k,3746) - lu(k,447) * lu(k,3589) - lu(k,3751) = lu(k,3751) - lu(k,448) * lu(k,3589) - lu(k,3752) = lu(k,3752) - lu(k,449) * lu(k,3589) + lu(k,533) = lu(k,533) - lu(k,427) * lu(k,532) + lu(k,534) = lu(k,534) - lu(k,428) * lu(k,532) + lu(k,535) = lu(k,535) - lu(k,429) * lu(k,532) + lu(k,537) = lu(k,537) - lu(k,430) * lu(k,532) + lu(k,538) = - lu(k,431) * lu(k,532) + lu(k,3436) = lu(k,3436) - lu(k,427) * lu(k,3427) + lu(k,3497) = lu(k,3497) - lu(k,428) * lu(k,3427) + lu(k,3525) = lu(k,3525) - lu(k,429) * lu(k,3427) + lu(k,3571) = lu(k,3571) - lu(k,430) * lu(k,3427) + lu(k,3572) = lu(k,3572) - lu(k,431) * lu(k,3427) + lu(k,3656) = lu(k,3656) - lu(k,427) * lu(k,3640) + lu(k,3746) = lu(k,3746) - lu(k,428) * lu(k,3640) + lu(k,3776) = lu(k,3776) - lu(k,429) * lu(k,3640) + lu(k,3821) = lu(k,3821) - lu(k,430) * lu(k,3640) + lu(k,3822) = lu(k,3822) - lu(k,431) * lu(k,3640) + lu(k,432) = 1._r8 / lu(k,432) + lu(k,433) = lu(k,433) * lu(k,432) + lu(k,434) = lu(k,434) * lu(k,432) + lu(k,435) = lu(k,435) * lu(k,432) + lu(k,436) = lu(k,436) * lu(k,432) + lu(k,437) = lu(k,437) * lu(k,432) + lu(k,2634) = lu(k,2634) - lu(k,433) * lu(k,2628) + lu(k,2639) = lu(k,2639) - lu(k,434) * lu(k,2628) + lu(k,2641) = lu(k,2641) - lu(k,435) * lu(k,2628) + lu(k,2647) = lu(k,2647) - lu(k,436) * lu(k,2628) + lu(k,2648) = lu(k,2648) - lu(k,437) * lu(k,2628) + lu(k,3787) = lu(k,3787) - lu(k,433) * lu(k,3641) + lu(k,3804) = lu(k,3804) - lu(k,434) * lu(k,3641) + lu(k,3816) = lu(k,3816) - lu(k,435) * lu(k,3641) + lu(k,3822) = lu(k,3822) - lu(k,436) * lu(k,3641) + lu(k,3823) = lu(k,3823) - lu(k,437) * lu(k,3641) + lu(k,3849) = lu(k,3849) - lu(k,433) * lu(k,3832) + lu(k,3854) = - lu(k,434) * lu(k,3832) + lu(k,3857) = lu(k,3857) - lu(k,435) * lu(k,3832) + lu(k,3863) = lu(k,3863) - lu(k,436) * lu(k,3832) + lu(k,3864) = lu(k,3864) - lu(k,437) * lu(k,3832) + lu(k,440) = 1._r8 / lu(k,440) + lu(k,441) = lu(k,441) * lu(k,440) + lu(k,442) = lu(k,442) * lu(k,440) + lu(k,443) = lu(k,443) * lu(k,440) + lu(k,444) = lu(k,444) * lu(k,440) + lu(k,445) = lu(k,445) * lu(k,440) + lu(k,3191) = lu(k,3191) - lu(k,441) * lu(k,3184) + lu(k,3311) = lu(k,3311) - lu(k,442) * lu(k,3184) + lu(k,3315) = lu(k,3315) - lu(k,443) * lu(k,3184) + lu(k,3316) = lu(k,3316) - lu(k,444) * lu(k,3184) + lu(k,3320) = lu(k,3320) - lu(k,445) * lu(k,3184) + lu(k,3437) = lu(k,3437) - lu(k,441) * lu(k,3428) + lu(k,3567) = lu(k,3567) - lu(k,442) * lu(k,3428) + lu(k,3571) = lu(k,3571) - lu(k,443) * lu(k,3428) + lu(k,3572) = lu(k,3572) - lu(k,444) * lu(k,3428) + lu(k,3576) = lu(k,3576) - lu(k,445) * lu(k,3428) + lu(k,3658) = lu(k,3658) - lu(k,441) * lu(k,3642) + lu(k,3817) = lu(k,3817) - lu(k,442) * lu(k,3642) + lu(k,3821) = lu(k,3821) - lu(k,443) * lu(k,3642) + lu(k,3822) = lu(k,3822) - lu(k,444) * lu(k,3642) + lu(k,3826) = lu(k,3826) - lu(k,445) * lu(k,3642) + lu(k,446) = 1._r8 / lu(k,446) + lu(k,447) = lu(k,447) * lu(k,446) + lu(k,448) = lu(k,448) * lu(k,446) + lu(k,449) = lu(k,449) * lu(k,446) + lu(k,450) = lu(k,450) * lu(k,446) + lu(k,451) = lu(k,451) * lu(k,446) + lu(k,3571) = lu(k,3571) - lu(k,447) * lu(k,3429) + lu(k,3572) = lu(k,3572) - lu(k,448) * lu(k,3429) + lu(k,3574) = lu(k,3574) - lu(k,449) * lu(k,3429) + lu(k,3576) = lu(k,3576) - lu(k,450) * lu(k,3429) + lu(k,3577) = lu(k,3577) - lu(k,451) * lu(k,3429) + lu(k,3821) = lu(k,3821) - lu(k,447) * lu(k,3643) + lu(k,3822) = lu(k,3822) - lu(k,448) * lu(k,3643) + lu(k,3824) = lu(k,3824) - lu(k,449) * lu(k,3643) + lu(k,3826) = lu(k,3826) - lu(k,450) * lu(k,3643) + lu(k,3827) = lu(k,3827) - lu(k,451) * lu(k,3643) + lu(k,4100) = lu(k,4100) - lu(k,447) * lu(k,4059) + lu(k,4101) = lu(k,4101) - lu(k,448) * lu(k,4059) + lu(k,4103) = lu(k,4103) - lu(k,449) * lu(k,4059) + lu(k,4105) = lu(k,4105) - lu(k,450) * lu(k,4059) + lu(k,4106) = - lu(k,451) * lu(k,4059) + lu(k,453) = 1._r8 / lu(k,453) + lu(k,454) = lu(k,454) * lu(k,453) + lu(k,455) = lu(k,455) * lu(k,453) + lu(k,456) = lu(k,456) * lu(k,453) + lu(k,457) = lu(k,457) * lu(k,453) + lu(k,458) = lu(k,458) * lu(k,453) + lu(k,3243) = lu(k,3243) - lu(k,454) * lu(k,3185) + lu(k,3311) = lu(k,3311) - lu(k,455) * lu(k,3185) + lu(k,3315) = lu(k,3315) - lu(k,456) * lu(k,3185) + lu(k,3316) = lu(k,3316) - lu(k,457) * lu(k,3185) + lu(k,3320) = lu(k,3320) - lu(k,458) * lu(k,3185) + lu(k,3497) = lu(k,3497) - lu(k,454) * lu(k,3430) + lu(k,3567) = lu(k,3567) - lu(k,455) * lu(k,3430) + lu(k,3571) = lu(k,3571) - lu(k,456) * lu(k,3430) + lu(k,3572) = lu(k,3572) - lu(k,457) * lu(k,3430) + lu(k,3576) = lu(k,3576) - lu(k,458) * lu(k,3430) + lu(k,3746) = lu(k,3746) - lu(k,454) * lu(k,3644) + lu(k,3817) = lu(k,3817) - lu(k,455) * lu(k,3644) + lu(k,3821) = lu(k,3821) - lu(k,456) * lu(k,3644) + lu(k,3822) = lu(k,3822) - lu(k,457) * lu(k,3644) + lu(k,3826) = lu(k,3826) - lu(k,458) * lu(k,3644) + 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,3552) = lu(k,3552) - lu(k,460) * lu(k,3431) + lu(k,3569) = lu(k,3569) - lu(k,461) * lu(k,3431) + lu(k,3572) = lu(k,3572) - lu(k,462) * lu(k,3431) + lu(k,3575) = lu(k,3575) - lu(k,463) * lu(k,3431) + lu(k,3577) = lu(k,3577) - lu(k,464) * lu(k,3431) + lu(k,3802) = lu(k,3802) - lu(k,460) * lu(k,3645) + lu(k,3819) = lu(k,3819) - lu(k,461) * lu(k,3645) + lu(k,3822) = lu(k,3822) - lu(k,462) * lu(k,3645) + lu(k,3825) = lu(k,3825) - lu(k,463) * lu(k,3645) + lu(k,3827) = lu(k,3827) - lu(k,464) * lu(k,3645) + lu(k,4029) = - lu(k,460) * lu(k,3965) + lu(k,4046) = lu(k,4046) - lu(k,461) * lu(k,3965) + lu(k,4049) = lu(k,4049) - lu(k,462) * lu(k,3965) + lu(k,4052) = lu(k,4052) - lu(k,463) * lu(k,3965) + lu(k,4054) = - lu(k,464) * lu(k,3965) end do end subroutine lu_fac09 subroutine lu_fac10( avec_len, lu ) @@ -1248,109 +1178,46 @@ subroutine lu_fac10( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,450) = 1._r8 / lu(k,450) - lu(k,451) = lu(k,451) * lu(k,450) - lu(k,452) = lu(k,452) * lu(k,450) - lu(k,453) = lu(k,453) * lu(k,450) - lu(k,454) = lu(k,454) * lu(k,450) - lu(k,635) = - lu(k,451) * lu(k,633) - lu(k,636) = - lu(k,452) * lu(k,633) - lu(k,639) = - lu(k,453) * lu(k,633) - lu(k,643) = lu(k,643) - lu(k,454) * lu(k,633) - lu(k,646) = - lu(k,451) * lu(k,644) - lu(k,648) = - lu(k,452) * lu(k,644) - lu(k,651) = - lu(k,453) * lu(k,644) - lu(k,654) = lu(k,654) - lu(k,454) * lu(k,644) - lu(k,1131) = - lu(k,451) * lu(k,1128) - lu(k,1133) = - lu(k,452) * lu(k,1128) - lu(k,1136) = - lu(k,453) * lu(k,1128) - lu(k,1141) = - lu(k,454) * lu(k,1128) - lu(k,2779) = lu(k,2779) - lu(k,451) * lu(k,2770) - lu(k,2817) = lu(k,2817) - lu(k,452) * lu(k,2770) - lu(k,2882) = lu(k,2882) - lu(k,453) * lu(k,2770) - lu(k,2895) = lu(k,2895) - lu(k,454) * lu(k,2770) - lu(k,3614) = lu(k,3614) - lu(k,451) * lu(k,3590) - lu(k,3670) = lu(k,3670) - lu(k,452) * lu(k,3590) - lu(k,3739) = lu(k,3739) - lu(k,453) * lu(k,3590) - lu(k,3752) = lu(k,3752) - lu(k,454) * lu(k,3590) - lu(k,455) = 1._r8 / lu(k,455) - lu(k,456) = lu(k,456) * lu(k,455) - lu(k,457) = lu(k,457) * lu(k,455) - lu(k,458) = lu(k,458) * lu(k,455) - lu(k,459) = lu(k,459) * lu(k,455) - lu(k,460) = lu(k,460) * lu(k,455) - lu(k,1513) = lu(k,1513) - lu(k,456) * lu(k,1511) - lu(k,1515) = lu(k,1515) - lu(k,457) * lu(k,1511) - lu(k,1517) = lu(k,1517) - lu(k,458) * lu(k,1511) - lu(k,1520) = lu(k,1520) - lu(k,459) * lu(k,1511) - lu(k,1522) = lu(k,1522) - lu(k,460) * lu(k,1511) - lu(k,2938) = lu(k,2938) - lu(k,456) * lu(k,2907) - lu(k,2985) = lu(k,2985) - lu(k,457) * lu(k,2907) - lu(k,2987) = lu(k,2987) - lu(k,458) * lu(k,2907) - lu(k,2994) = lu(k,2994) - lu(k,459) * lu(k,2907) - lu(k,2996) = lu(k,2996) - lu(k,460) * lu(k,2907) - lu(k,3447) = lu(k,3447) - lu(k,456) * lu(k,3438) - lu(k,3451) = lu(k,3451) - lu(k,457) * lu(k,3438) - lu(k,3453) = lu(k,3453) - lu(k,458) * lu(k,3438) - lu(k,3460) = lu(k,3460) - lu(k,459) * lu(k,3438) - lu(k,3462) = lu(k,3462) - lu(k,460) * lu(k,3438) - lu(k,3692) = lu(k,3692) - lu(k,456) * lu(k,3591) - lu(k,3741) = lu(k,3741) - lu(k,457) * lu(k,3591) - lu(k,3743) = lu(k,3743) - lu(k,458) * lu(k,3591) - lu(k,3750) = lu(k,3750) - lu(k,459) * lu(k,3591) - lu(k,3752) = lu(k,3752) - lu(k,460) * lu(k,3591) - lu(k,462) = 1._r8 / lu(k,462) - lu(k,463) = lu(k,463) * lu(k,462) - lu(k,464) = lu(k,464) * lu(k,462) - lu(k,465) = lu(k,465) * lu(k,462) - lu(k,466) = lu(k,466) * lu(k,462) - lu(k,467) = lu(k,467) * lu(k,462) - lu(k,2777) = lu(k,2777) - lu(k,463) * lu(k,2771) - lu(k,2885) = lu(k,2885) - lu(k,464) * lu(k,2771) - lu(k,2889) = lu(k,2889) - lu(k,465) * lu(k,2771) - lu(k,2894) = lu(k,2894) - lu(k,466) * lu(k,2771) - lu(k,2895) = lu(k,2895) - lu(k,467) * lu(k,2771) - lu(k,3165) = lu(k,3165) - lu(k,463) * lu(k,3156) - lu(k,3281) = lu(k,3281) - lu(k,464) * lu(k,3156) - lu(k,3285) = lu(k,3285) - lu(k,465) * lu(k,3156) - lu(k,3290) = lu(k,3290) - lu(k,466) * lu(k,3156) - lu(k,3291) = lu(k,3291) - lu(k,467) * lu(k,3156) - lu(k,3479) = lu(k,3479) - lu(k,463) * lu(k,3475) - lu(k,3502) = lu(k,3502) - lu(k,464) * lu(k,3475) - lu(k,3506) = lu(k,3506) - lu(k,465) * lu(k,3475) - lu(k,3511) = lu(k,3511) - lu(k,466) * lu(k,3475) - lu(k,3512) = lu(k,3512) - lu(k,467) * lu(k,3475) - lu(k,3609) = lu(k,3609) - lu(k,463) * lu(k,3592) - lu(k,3742) = lu(k,3742) - lu(k,464) * lu(k,3592) - lu(k,3746) = lu(k,3746) - lu(k,465) * lu(k,3592) - lu(k,3751) = lu(k,3751) - lu(k,466) * lu(k,3592) - lu(k,3752) = lu(k,3752) - lu(k,467) * lu(k,3592) + lu(k,465) = 1._r8 / lu(k,465) + lu(k,466) = lu(k,466) * lu(k,465) + lu(k,467) = lu(k,467) * lu(k,465) + lu(k,526) = - lu(k,466) * lu(k,524) + lu(k,529) = lu(k,529) - lu(k,467) * lu(k,524) + lu(k,749) = - lu(k,466) * lu(k,747) + lu(k,756) = lu(k,756) - lu(k,467) * lu(k,747) + lu(k,830) = - lu(k,466) * lu(k,828) + lu(k,838) = lu(k,838) - lu(k,467) * lu(k,828) + lu(k,876) = - lu(k,466) * lu(k,874) + lu(k,884) = lu(k,884) - lu(k,467) * lu(k,874) + lu(k,892) = - lu(k,466) * lu(k,890) + lu(k,901) = lu(k,901) - lu(k,467) * lu(k,890) + lu(k,3206) = lu(k,3206) - lu(k,466) * lu(k,3186) + lu(k,3315) = lu(k,3315) - lu(k,467) * lu(k,3186) + lu(k,3458) = lu(k,3458) - lu(k,466) * lu(k,3432) + lu(k,3571) = lu(k,3571) - lu(k,467) * lu(k,3432) + lu(k,3693) = - lu(k,466) * lu(k,3646) + lu(k,3821) = lu(k,3821) - lu(k,467) * lu(k,3646) lu(k,468) = 1._r8 / lu(k,468) lu(k,469) = lu(k,469) * lu(k,468) lu(k,470) = lu(k,470) * lu(k,468) lu(k,471) = lu(k,471) * lu(k,468) lu(k,472) = lu(k,472) * lu(k,468) - lu(k,473) = lu(k,473) * lu(k,468) - lu(k,1500) = lu(k,1500) - lu(k,469) * lu(k,1495) - lu(k,1505) = lu(k,1505) - lu(k,470) * lu(k,1495) - lu(k,1506) = lu(k,1506) - lu(k,471) * lu(k,1495) - lu(k,1508) = lu(k,1508) - lu(k,472) * lu(k,1495) - lu(k,1509) = - lu(k,473) * lu(k,1495) - lu(k,2699) = lu(k,2699) - lu(k,469) * lu(k,2644) - lu(k,2706) = lu(k,2706) - lu(k,470) * lu(k,2644) - lu(k,2707) = lu(k,2707) - lu(k,471) * lu(k,2644) - lu(k,2710) = lu(k,2710) - lu(k,472) * lu(k,2644) - lu(k,2713) = - lu(k,473) * lu(k,2644) - lu(k,3278) = lu(k,3278) - lu(k,469) * lu(k,3157) - lu(k,3287) = lu(k,3287) - lu(k,470) * lu(k,3157) - lu(k,3288) = lu(k,3288) - lu(k,471) * lu(k,3157) - lu(k,3291) = lu(k,3291) - lu(k,472) * lu(k,3157) - lu(k,3295) = lu(k,3295) - lu(k,473) * lu(k,3157) - lu(k,3739) = lu(k,3739) - lu(k,469) * lu(k,3593) - lu(k,3748) = lu(k,3748) - lu(k,470) * lu(k,3593) - lu(k,3749) = lu(k,3749) - lu(k,471) * lu(k,3593) - lu(k,3752) = lu(k,3752) - lu(k,472) * lu(k,3593) - lu(k,3756) = lu(k,3756) - lu(k,473) * lu(k,3593) + lu(k,2317) = - lu(k,469) * lu(k,2316) + lu(k,2323) = lu(k,2323) - lu(k,470) * lu(k,2316) + lu(k,2336) = lu(k,2336) - lu(k,471) * lu(k,2316) + lu(k,2337) = lu(k,2337) - lu(k,472) * lu(k,2316) + lu(k,2791) = - lu(k,469) * lu(k,2790) + lu(k,2799) = lu(k,2799) - lu(k,470) * lu(k,2790) + lu(k,2817) = lu(k,2817) - lu(k,471) * lu(k,2790) + lu(k,2818) = lu(k,2818) - lu(k,472) * lu(k,2790) + lu(k,3470) = lu(k,3470) - lu(k,469) * lu(k,3433) + lu(k,3543) = lu(k,3543) - lu(k,470) * lu(k,3433) + lu(k,3571) = lu(k,3571) - lu(k,471) * lu(k,3433) + lu(k,3572) = lu(k,3572) - lu(k,472) * lu(k,3433) + lu(k,3707) = lu(k,3707) - lu(k,469) * lu(k,3647) + lu(k,3793) = lu(k,3793) - lu(k,470) * lu(k,3647) + lu(k,3821) = lu(k,3821) - lu(k,471) * lu(k,3647) + lu(k,3822) = lu(k,3822) - lu(k,472) * lu(k,3647) lu(k,474) = 1._r8 / lu(k,474) lu(k,475) = lu(k,475) * lu(k,474) lu(k,476) = lu(k,476) * lu(k,474) @@ -1358,57 +1225,77 @@ subroutine lu_fac10( avec_len, lu ) lu(k,478) = lu(k,478) * lu(k,474) lu(k,479) = lu(k,479) * lu(k,474) lu(k,480) = lu(k,480) * lu(k,474) - lu(k,481) = lu(k,481) * lu(k,474) - lu(k,1714) = - lu(k,475) * lu(k,1712) - lu(k,1715) = - lu(k,476) * lu(k,1712) - lu(k,1730) = lu(k,1730) - lu(k,477) * lu(k,1712) - lu(k,1740) = lu(k,1740) - lu(k,478) * lu(k,1712) - lu(k,1741) = lu(k,1741) - lu(k,479) * lu(k,1712) - lu(k,1743) = lu(k,1743) - lu(k,480) * lu(k,1712) - lu(k,1744) = lu(k,1744) - lu(k,481) * lu(k,1712) - lu(k,2789) = - lu(k,475) * lu(k,2772) - lu(k,2801) = lu(k,2801) - lu(k,476) * lu(k,2772) - lu(k,2849) = lu(k,2849) - lu(k,477) * lu(k,2772) - lu(k,2889) = lu(k,2889) - lu(k,478) * lu(k,2772) - lu(k,2891) = lu(k,2891) - lu(k,479) * lu(k,2772) - lu(k,2894) = lu(k,2894) - lu(k,480) * lu(k,2772) - lu(k,2895) = lu(k,2895) - lu(k,481) * lu(k,2772) - lu(k,3629) = lu(k,3629) - lu(k,475) * lu(k,3594) - lu(k,3645) = lu(k,3645) - lu(k,476) * lu(k,3594) - lu(k,3707) = lu(k,3707) - lu(k,477) * lu(k,3594) - lu(k,3746) = lu(k,3746) - lu(k,478) * lu(k,3594) - lu(k,3748) = lu(k,3748) - lu(k,479) * lu(k,3594) - lu(k,3751) = lu(k,3751) - lu(k,480) * lu(k,3594) - lu(k,3752) = lu(k,3752) - lu(k,481) * lu(k,3594) - lu(k,482) = 1._r8 / lu(k,482) - lu(k,483) = lu(k,483) * lu(k,482) - lu(k,484) = lu(k,484) * lu(k,482) - lu(k,485) = lu(k,485) * lu(k,482) - lu(k,486) = lu(k,486) * lu(k,482) - lu(k,487) = lu(k,487) * lu(k,482) - lu(k,488) = lu(k,488) * lu(k,482) - lu(k,489) = lu(k,489) * lu(k,482) - lu(k,822) = lu(k,822) - lu(k,483) * lu(k,821) - lu(k,823) = lu(k,823) - lu(k,484) * lu(k,821) - lu(k,824) = - lu(k,485) * lu(k,821) - lu(k,826) = lu(k,826) - lu(k,486) * lu(k,821) - lu(k,827) = lu(k,827) - lu(k,487) * lu(k,821) - lu(k,829) = - lu(k,488) * lu(k,821) - lu(k,830) = - lu(k,489) * lu(k,821) - lu(k,3183) = lu(k,3183) - lu(k,483) * lu(k,3158) - lu(k,3213) = lu(k,3213) - lu(k,484) * lu(k,3158) - lu(k,3237) = lu(k,3237) - lu(k,485) * lu(k,3158) - lu(k,3285) = lu(k,3285) - lu(k,486) * lu(k,3158) - lu(k,3287) = lu(k,3287) - lu(k,487) * lu(k,3158) - lu(k,3291) = lu(k,3291) - lu(k,488) * lu(k,3158) - lu(k,3295) = lu(k,3295) - lu(k,489) * lu(k,3158) - lu(k,3632) = lu(k,3632) - lu(k,483) * lu(k,3595) - lu(k,3674) = lu(k,3674) - lu(k,484) * lu(k,3595) - lu(k,3699) = lu(k,3699) - lu(k,485) * lu(k,3595) - lu(k,3746) = lu(k,3746) - lu(k,486) * lu(k,3595) - lu(k,3748) = lu(k,3748) - lu(k,487) * lu(k,3595) - lu(k,3752) = lu(k,3752) - lu(k,488) * lu(k,3595) - lu(k,3756) = lu(k,3756) - lu(k,489) * lu(k,3595) + lu(k,3296) = - lu(k,475) * lu(k,3187) + lu(k,3298) = - lu(k,476) * lu(k,3187) + lu(k,3311) = lu(k,3311) - lu(k,477) * lu(k,3187) + lu(k,3314) = lu(k,3314) - lu(k,478) * lu(k,3187) + lu(k,3316) = lu(k,3316) - lu(k,479) * lu(k,3187) + lu(k,3320) = lu(k,3320) - lu(k,480) * lu(k,3187) + lu(k,3802) = lu(k,3802) - lu(k,475) * lu(k,3648) + lu(k,3804) = lu(k,3804) - lu(k,476) * lu(k,3648) + lu(k,3817) = lu(k,3817) - lu(k,477) * lu(k,3648) + lu(k,3820) = lu(k,3820) - lu(k,478) * lu(k,3648) + lu(k,3822) = lu(k,3822) - lu(k,479) * lu(k,3648) + lu(k,3826) = lu(k,3826) - lu(k,480) * lu(k,3648) + lu(k,4086) = - lu(k,475) * lu(k,4060) + lu(k,4088) = lu(k,4088) - lu(k,476) * lu(k,4060) + lu(k,4096) = lu(k,4096) - lu(k,477) * lu(k,4060) + lu(k,4099) = lu(k,4099) - lu(k,478) * lu(k,4060) + lu(k,4101) = lu(k,4101) - lu(k,479) * lu(k,4060) + lu(k,4105) = lu(k,4105) - lu(k,480) * lu(k,4060) + lu(k,481) = 1._r8 / lu(k,481) + lu(k,482) = lu(k,482) * lu(k,481) + lu(k,483) = lu(k,483) * lu(k,481) + lu(k,484) = lu(k,484) * lu(k,481) + lu(k,485) = lu(k,485) * lu(k,481) + lu(k,486) = lu(k,486) * lu(k,481) + lu(k,487) = lu(k,487) * lu(k,481) + lu(k,1837) = - lu(k,482) * lu(k,1833) + lu(k,1841) = lu(k,1841) - lu(k,483) * lu(k,1833) + lu(k,1850) = lu(k,1850) - lu(k,484) * lu(k,1833) + lu(k,1853) = - lu(k,485) * lu(k,1833) + lu(k,1859) = lu(k,1859) - lu(k,486) * lu(k,1833) + lu(k,1860) = lu(k,1860) - lu(k,487) * lu(k,1833) + lu(k,1884) = - lu(k,482) * lu(k,1881) + lu(k,1887) = - lu(k,483) * lu(k,1881) + lu(k,1896) = - lu(k,484) * lu(k,1881) + lu(k,1901) = lu(k,1901) - lu(k,485) * lu(k,1881) + lu(k,1906) = lu(k,1906) - lu(k,486) * lu(k,1881) + lu(k,1907) = lu(k,1907) - lu(k,487) * lu(k,1881) + lu(k,3698) = lu(k,3698) - lu(k,482) * lu(k,3649) + lu(k,3750) = lu(k,3750) - lu(k,483) * lu(k,3649) + lu(k,3777) = lu(k,3777) - lu(k,484) * lu(k,3649) + lu(k,3782) = lu(k,3782) - lu(k,485) * lu(k,3649) + lu(k,3821) = lu(k,3821) - lu(k,486) * lu(k,3649) + lu(k,3822) = lu(k,3822) - lu(k,487) * lu(k,3649) + lu(k,488) = 1._r8 / lu(k,488) + lu(k,489) = lu(k,489) * lu(k,488) + lu(k,490) = lu(k,490) * lu(k,488) + lu(k,491) = lu(k,491) * lu(k,488) + lu(k,492) = lu(k,492) * lu(k,488) + lu(k,493) = lu(k,493) * lu(k,488) + lu(k,494) = lu(k,494) * lu(k,488) + lu(k,495) = lu(k,495) * lu(k,488) + lu(k,496) = lu(k,496) * lu(k,488) + lu(k,497) = lu(k,497) * lu(k,488) + lu(k,1177) = - lu(k,489) * lu(k,1176) + lu(k,1180) = - lu(k,490) * lu(k,1176) + lu(k,1181) = - lu(k,491) * lu(k,1176) + lu(k,1183) = - lu(k,492) * lu(k,1176) + lu(k,1189) = - lu(k,493) * lu(k,1176) + lu(k,1190) = lu(k,1190) - lu(k,494) * lu(k,1176) + lu(k,1191) = - lu(k,495) * lu(k,1176) + lu(k,1192) = lu(k,1192) - lu(k,496) * lu(k,1176) + lu(k,1193) = lu(k,1193) - lu(k,497) * lu(k,1176) + lu(k,3698) = lu(k,3698) - lu(k,489) * lu(k,3650) + lu(k,3737) = lu(k,3737) - lu(k,490) * lu(k,3650) + lu(k,3760) = lu(k,3760) - lu(k,491) * lu(k,3650) + lu(k,3776) = lu(k,3776) - lu(k,492) * lu(k,3650) + lu(k,3818) = lu(k,3818) - lu(k,493) * lu(k,3650) + lu(k,3819) = lu(k,3819) - lu(k,494) * lu(k,3650) + lu(k,3821) = lu(k,3821) - lu(k,495) * lu(k,3650) + lu(k,3822) = lu(k,3822) - lu(k,496) * lu(k,3650) + lu(k,3826) = lu(k,3826) - lu(k,497) * lu(k,3650) end do end subroutine lu_fac10 subroutine lu_fac11( avec_len, lu ) @@ -1425,35 +1312,6 @@ subroutine lu_fac11( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,490) = 1._r8 / lu(k,490) - lu(k,491) = lu(k,491) * lu(k,490) - lu(k,492) = lu(k,492) * lu(k,490) - lu(k,493) = lu(k,493) * lu(k,490) - lu(k,494) = lu(k,494) * lu(k,490) - lu(k,495) = lu(k,495) * lu(k,490) - lu(k,496) = lu(k,496) * lu(k,490) - lu(k,497) = lu(k,497) * lu(k,490) - lu(k,3440) = lu(k,3440) - lu(k,491) * lu(k,3439) - lu(k,3449) = lu(k,3449) - lu(k,492) * lu(k,3439) - lu(k,3450) = - lu(k,493) * lu(k,3439) - lu(k,3454) = lu(k,3454) - lu(k,494) * lu(k,3439) - lu(k,3460) = lu(k,3460) - lu(k,495) * lu(k,3439) - lu(k,3461) = lu(k,3461) - lu(k,496) * lu(k,3439) - lu(k,3464) = lu(k,3464) - lu(k,497) * lu(k,3439) - lu(k,3483) = - lu(k,491) * lu(k,3476) - lu(k,3492) = - lu(k,492) * lu(k,3476) - lu(k,3500) = lu(k,3500) - lu(k,493) * lu(k,3476) - lu(k,3504) = lu(k,3504) - lu(k,494) * lu(k,3476) - lu(k,3510) = lu(k,3510) - lu(k,495) * lu(k,3476) - lu(k,3511) = lu(k,3511) - lu(k,496) * lu(k,3476) - lu(k,3514) = lu(k,3514) - lu(k,497) * lu(k,3476) - lu(k,3782) = lu(k,3782) - lu(k,491) * lu(k,3781) - lu(k,3785) = lu(k,3785) - lu(k,492) * lu(k,3781) - lu(k,3786) = - lu(k,493) * lu(k,3781) - lu(k,3790) = - lu(k,494) * lu(k,3781) - lu(k,3796) = lu(k,3796) - lu(k,495) * lu(k,3781) - lu(k,3797) = lu(k,3797) - lu(k,496) * lu(k,3781) - lu(k,3800) = lu(k,3800) - lu(k,497) * lu(k,3781) lu(k,498) = 1._r8 / lu(k,498) lu(k,499) = lu(k,499) * lu(k,498) lu(k,500) = lu(k,500) * lu(k,498) @@ -1461,111 +1319,172 @@ subroutine lu_fac11( avec_len, lu ) lu(k,502) = lu(k,502) * lu(k,498) lu(k,503) = lu(k,503) * lu(k,498) lu(k,504) = lu(k,504) * lu(k,498) - lu(k,505) = lu(k,505) * lu(k,498) - lu(k,2914) = - lu(k,499) * lu(k,2908) - lu(k,2922) = lu(k,2922) - lu(k,500) * lu(k,2908) - lu(k,2940) = lu(k,2940) - lu(k,501) * lu(k,2908) - lu(k,2987) = lu(k,2987) - lu(k,502) * lu(k,2908) - lu(k,2990) = lu(k,2990) - lu(k,503) * lu(k,2908) - lu(k,2992) = lu(k,2992) - lu(k,504) * lu(k,2908) - lu(k,2996) = lu(k,2996) - lu(k,505) * lu(k,2908) - lu(k,3623) = lu(k,3623) - lu(k,499) * lu(k,3596) - lu(k,3658) = lu(k,3658) - lu(k,500) * lu(k,3596) - lu(k,3694) = lu(k,3694) - lu(k,501) * lu(k,3596) - lu(k,3743) = lu(k,3743) - lu(k,502) * lu(k,3596) - lu(k,3746) = lu(k,3746) - lu(k,503) * lu(k,3596) - lu(k,3748) = lu(k,3748) - lu(k,504) * lu(k,3596) - lu(k,3752) = lu(k,3752) - lu(k,505) * lu(k,3596) - lu(k,3807) = - lu(k,499) * lu(k,3806) - lu(k,3809) = lu(k,3809) - lu(k,500) * lu(k,3806) - lu(k,3818) = lu(k,3818) - lu(k,501) * lu(k,3806) - lu(k,3824) = lu(k,3824) - lu(k,502) * lu(k,3806) - lu(k,3827) = lu(k,3827) - lu(k,503) * lu(k,3806) - lu(k,3829) = lu(k,3829) - lu(k,504) * lu(k,3806) - lu(k,3833) = lu(k,3833) - lu(k,505) * lu(k,3806) - lu(k,506) = 1._r8 / lu(k,506) - lu(k,507) = lu(k,507) * lu(k,506) - lu(k,508) = lu(k,508) * lu(k,506) - lu(k,509) = lu(k,509) * lu(k,506) - lu(k,510) = lu(k,510) * lu(k,506) - lu(k,511) = lu(k,511) * lu(k,506) - lu(k,512) = lu(k,512) * lu(k,506) - lu(k,513) = lu(k,513) * lu(k,506) - lu(k,2509) = lu(k,2509) - lu(k,507) * lu(k,2505) - lu(k,2517) = lu(k,2517) - lu(k,508) * lu(k,2505) - lu(k,2532) = lu(k,2532) - lu(k,509) * lu(k,2505) - lu(k,2541) = lu(k,2541) - lu(k,510) * lu(k,2505) - lu(k,2542) = lu(k,2542) - lu(k,511) * lu(k,2505) - lu(k,2545) = lu(k,2545) - lu(k,512) * lu(k,2505) - lu(k,2546) = lu(k,2546) - lu(k,513) * lu(k,2505) - lu(k,3490) = lu(k,3490) - lu(k,507) * lu(k,3477) - lu(k,3494) = - lu(k,508) * lu(k,3477) - lu(k,3496) = lu(k,3496) - lu(k,509) * lu(k,3477) - lu(k,3506) = lu(k,3506) - lu(k,510) * lu(k,3477) - lu(k,3508) = lu(k,3508) - lu(k,511) * lu(k,3477) - lu(k,3511) = lu(k,3511) - lu(k,512) * lu(k,3477) - lu(k,3512) = lu(k,3512) - lu(k,513) * lu(k,3477) - lu(k,3694) = lu(k,3694) - lu(k,507) * lu(k,3597) - lu(k,3721) = lu(k,3721) - lu(k,508) * lu(k,3597) - lu(k,3736) = lu(k,3736) - lu(k,509) * lu(k,3597) - lu(k,3746) = lu(k,3746) - lu(k,510) * lu(k,3597) - lu(k,3748) = lu(k,3748) - lu(k,511) * lu(k,3597) - lu(k,3751) = lu(k,3751) - lu(k,512) * lu(k,3597) - lu(k,3752) = lu(k,3752) - lu(k,513) * lu(k,3597) - 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,2555) = lu(k,2555) - lu(k,515) * lu(k,2551) - lu(k,2579) = lu(k,2579) - lu(k,516) * lu(k,2551) - lu(k,2581) = lu(k,2581) - lu(k,517) * lu(k,2551) - lu(k,2587) = lu(k,2587) - lu(k,518) * lu(k,2551) - lu(k,2588) = lu(k,2588) - lu(k,519) * lu(k,2551) - lu(k,2591) = lu(k,2591) - lu(k,520) * lu(k,2551) - lu(k,2592) = lu(k,2592) - lu(k,521) * lu(k,2551) - lu(k,3490) = lu(k,3490) - lu(k,515) * lu(k,3478) - lu(k,3497) = lu(k,3497) - lu(k,516) * lu(k,3478) - lu(k,3499) = lu(k,3499) - lu(k,517) * lu(k,3478) - lu(k,3506) = lu(k,3506) - lu(k,518) * lu(k,3478) - lu(k,3508) = lu(k,3508) - lu(k,519) * lu(k,3478) - lu(k,3511) = lu(k,3511) - lu(k,520) * lu(k,3478) - lu(k,3512) = lu(k,3512) - lu(k,521) * lu(k,3478) - lu(k,3694) = lu(k,3694) - lu(k,515) * lu(k,3598) - lu(k,3737) = lu(k,3737) - lu(k,516) * lu(k,3598) - lu(k,3739) = lu(k,3739) - lu(k,517) * lu(k,3598) - lu(k,3746) = lu(k,3746) - lu(k,518) * lu(k,3598) - lu(k,3748) = lu(k,3748) - lu(k,519) * lu(k,3598) - lu(k,3751) = lu(k,3751) - lu(k,520) * lu(k,3598) - lu(k,3752) = lu(k,3752) - lu(k,521) * lu(k,3598) - lu(k,522) = 1._r8 / lu(k,522) - lu(k,523) = lu(k,523) * lu(k,522) - lu(k,524) = lu(k,524) * lu(k,522) - lu(k,525) = lu(k,525) * lu(k,522) - lu(k,864) = - lu(k,523) * lu(k,858) - lu(k,865) = - lu(k,524) * lu(k,858) - lu(k,870) = lu(k,870) - lu(k,525) * lu(k,858) - lu(k,966) = - lu(k,523) * lu(k,960) - lu(k,968) = - lu(k,524) * lu(k,960) - lu(k,973) = lu(k,973) - lu(k,525) * lu(k,960) - lu(k,1109) = - lu(k,523) * lu(k,1101) - lu(k,1112) = - lu(k,524) * lu(k,1101) - lu(k,1117) = lu(k,1117) - lu(k,525) * lu(k,1101) - lu(k,2622) = lu(k,2622) - lu(k,523) * lu(k,2597) - lu(k,2627) = lu(k,2627) - lu(k,524) * lu(k,2597) - lu(k,2639) = lu(k,2639) - lu(k,525) * lu(k,2597) - lu(k,2977) = - lu(k,523) * lu(k,2909) - lu(k,2982) = - lu(k,524) * lu(k,2909) - lu(k,2996) = lu(k,2996) - lu(k,525) * lu(k,2909) - lu(k,3272) = lu(k,3272) - lu(k,523) * lu(k,3159) - lu(k,3277) = lu(k,3277) - lu(k,524) * lu(k,3159) - lu(k,3291) = lu(k,3291) - lu(k,525) * lu(k,3159) - lu(k,3733) = lu(k,3733) - lu(k,523) * lu(k,3599) - lu(k,3738) = lu(k,3738) - lu(k,524) * lu(k,3599) - lu(k,3752) = lu(k,3752) - lu(k,525) * lu(k,3599) + lu(k,1806) = - lu(k,499) * lu(k,1802) + lu(k,1808) = lu(k,1808) - lu(k,500) * lu(k,1802) + lu(k,1819) = lu(k,1819) - lu(k,501) * lu(k,1802) + lu(k,1821) = - lu(k,502) * lu(k,1802) + lu(k,1828) = lu(k,1828) - lu(k,503) * lu(k,1802) + lu(k,1829) = lu(k,1829) - lu(k,504) * lu(k,1802) + lu(k,1884) = lu(k,1884) - lu(k,499) * lu(k,1882) + lu(k,1885) = - lu(k,500) * lu(k,1882) + lu(k,1896) = lu(k,1896) - lu(k,501) * lu(k,1882) + lu(k,1900) = lu(k,1900) - lu(k,502) * lu(k,1882) + lu(k,1906) = lu(k,1906) - lu(k,503) * lu(k,1882) + lu(k,1907) = lu(k,1907) - lu(k,504) * lu(k,1882) + lu(k,3698) = lu(k,3698) - lu(k,499) * lu(k,3651) + lu(k,3744) = lu(k,3744) - lu(k,500) * lu(k,3651) + lu(k,3777) = lu(k,3777) - lu(k,501) * lu(k,3651) + lu(k,3781) = lu(k,3781) - lu(k,502) * lu(k,3651) + lu(k,3821) = lu(k,3821) - lu(k,503) * lu(k,3651) + lu(k,3822) = lu(k,3822) - lu(k,504) * lu(k,3651) + lu(k,505) = 1._r8 / lu(k,505) + lu(k,506) = lu(k,506) * lu(k,505) + lu(k,507) = lu(k,507) * lu(k,505) + lu(k,508) = lu(k,508) * lu(k,505) + lu(k,709) = lu(k,709) - lu(k,506) * lu(k,708) + lu(k,710) = - lu(k,507) * lu(k,708) + lu(k,714) = lu(k,714) - lu(k,508) * lu(k,708) + lu(k,3046) = lu(k,3046) - lu(k,506) * lu(k,3043) + lu(k,3127) = lu(k,3127) - lu(k,507) * lu(k,3043) + lu(k,3138) = lu(k,3138) - lu(k,508) * lu(k,3043) + lu(k,3198) = lu(k,3198) - lu(k,506) * lu(k,3188) + lu(k,3309) = lu(k,3309) - lu(k,507) * lu(k,3188) + lu(k,3320) = lu(k,3320) - lu(k,508) * lu(k,3188) + lu(k,3444) = lu(k,3444) - lu(k,506) * lu(k,3434) + lu(k,3565) = lu(k,3565) - lu(k,507) * lu(k,3434) + lu(k,3576) = lu(k,3576) - lu(k,508) * lu(k,3434) + lu(k,3676) = lu(k,3676) - lu(k,506) * lu(k,3652) + lu(k,3815) = lu(k,3815) - lu(k,507) * lu(k,3652) + lu(k,3826) = lu(k,3826) - lu(k,508) * lu(k,3652) + lu(k,4068) = - lu(k,506) * lu(k,4061) + lu(k,4094) = lu(k,4094) - lu(k,507) * lu(k,4061) + lu(k,4105) = lu(k,4105) - lu(k,508) * lu(k,4061) + lu(k,509) = 1._r8 / lu(k,509) + lu(k,510) = lu(k,510) * lu(k,509) + lu(k,511) = lu(k,511) * lu(k,509) + lu(k,512) = lu(k,512) * lu(k,509) + lu(k,513) = lu(k,513) * lu(k,509) + lu(k,514) = lu(k,514) * lu(k,509) + lu(k,515) = lu(k,515) * lu(k,509) + lu(k,2634) = lu(k,2634) - lu(k,510) * lu(k,2629) + lu(k,2639) = lu(k,2639) - lu(k,511) * lu(k,2629) + lu(k,2641) = lu(k,2641) - lu(k,512) * lu(k,2629) + lu(k,2647) = lu(k,2647) - lu(k,513) * lu(k,2629) + lu(k,2648) = lu(k,2648) - lu(k,514) * lu(k,2629) + lu(k,2652) = lu(k,2652) - lu(k,515) * lu(k,2629) + lu(k,3787) = lu(k,3787) - lu(k,510) * lu(k,3653) + lu(k,3804) = lu(k,3804) - lu(k,511) * lu(k,3653) + lu(k,3816) = lu(k,3816) - lu(k,512) * lu(k,3653) + lu(k,3822) = lu(k,3822) - lu(k,513) * lu(k,3653) + lu(k,3823) = lu(k,3823) - lu(k,514) * lu(k,3653) + lu(k,3827) = lu(k,3827) - lu(k,515) * lu(k,3653) + lu(k,3849) = lu(k,3849) - lu(k,510) * lu(k,3833) + lu(k,3854) = lu(k,3854) - lu(k,511) * lu(k,3833) + lu(k,3857) = lu(k,3857) - lu(k,512) * lu(k,3833) + lu(k,3863) = lu(k,3863) - lu(k,513) * lu(k,3833) + lu(k,3864) = lu(k,3864) - lu(k,514) * lu(k,3833) + lu(k,3868) = lu(k,3868) - lu(k,515) * lu(k,3833) + lu(k,516) = 1._r8 / lu(k,516) + lu(k,517) = lu(k,517) * lu(k,516) + lu(k,518) = lu(k,518) * lu(k,516) + lu(k,519) = lu(k,519) * lu(k,516) + lu(k,520) = lu(k,520) * lu(k,516) + lu(k,521) = lu(k,521) * lu(k,516) + lu(k,522) = lu(k,522) * lu(k,516) + lu(k,1618) = lu(k,1618) - lu(k,517) * lu(k,1614) + lu(k,1619) = - lu(k,518) * lu(k,1614) + lu(k,1620) = lu(k,1620) - lu(k,519) * lu(k,1614) + lu(k,1627) = lu(k,1627) - lu(k,520) * lu(k,1614) + lu(k,1628) = lu(k,1628) - lu(k,521) * lu(k,1614) + lu(k,1630) = lu(k,1630) - lu(k,522) * lu(k,1614) + lu(k,3759) = lu(k,3759) - lu(k,517) * lu(k,3654) + lu(k,3769) = lu(k,3769) - lu(k,518) * lu(k,3654) + lu(k,3777) = lu(k,3777) - lu(k,519) * lu(k,3654) + lu(k,3822) = lu(k,3822) - lu(k,520) * lu(k,3654) + lu(k,3824) = lu(k,3824) - lu(k,521) * lu(k,3654) + lu(k,3826) = lu(k,3826) - lu(k,522) * lu(k,3654) + lu(k,4079) = lu(k,4079) - lu(k,517) * lu(k,4062) + lu(k,4080) = - lu(k,518) * lu(k,4062) + lu(k,4082) = lu(k,4082) - lu(k,519) * lu(k,4062) + lu(k,4101) = lu(k,4101) - lu(k,520) * lu(k,4062) + lu(k,4103) = lu(k,4103) - lu(k,521) * lu(k,4062) + lu(k,4105) = lu(k,4105) - lu(k,522) * lu(k,4062) + lu(k,525) = 1._r8 / lu(k,525) + lu(k,526) = lu(k,526) * lu(k,525) + lu(k,527) = lu(k,527) * lu(k,525) + lu(k,528) = lu(k,528) * lu(k,525) + lu(k,529) = lu(k,529) * lu(k,525) + lu(k,530) = lu(k,530) * lu(k,525) + lu(k,531) = lu(k,531) * lu(k,525) + lu(k,3206) = lu(k,3206) - lu(k,526) * lu(k,3189) + lu(k,3243) = lu(k,3243) - lu(k,527) * lu(k,3189) + lu(k,3311) = lu(k,3311) - lu(k,528) * lu(k,3189) + lu(k,3315) = lu(k,3315) - lu(k,529) * lu(k,3189) + lu(k,3316) = lu(k,3316) - lu(k,530) * lu(k,3189) + lu(k,3320) = lu(k,3320) - lu(k,531) * lu(k,3189) + lu(k,3458) = lu(k,3458) - lu(k,526) * lu(k,3435) + lu(k,3497) = lu(k,3497) - lu(k,527) * lu(k,3435) + lu(k,3567) = lu(k,3567) - lu(k,528) * lu(k,3435) + lu(k,3571) = lu(k,3571) - lu(k,529) * lu(k,3435) + lu(k,3572) = lu(k,3572) - lu(k,530) * lu(k,3435) + lu(k,3576) = lu(k,3576) - lu(k,531) * lu(k,3435) + lu(k,3693) = lu(k,3693) - lu(k,526) * lu(k,3655) + lu(k,3746) = lu(k,3746) - lu(k,527) * lu(k,3655) + lu(k,3817) = lu(k,3817) - lu(k,528) * lu(k,3655) + lu(k,3821) = lu(k,3821) - lu(k,529) * lu(k,3655) + lu(k,3822) = lu(k,3822) - lu(k,530) * lu(k,3655) + lu(k,3826) = lu(k,3826) - lu(k,531) * lu(k,3655) + lu(k,533) = 1._r8 / lu(k,533) + lu(k,534) = lu(k,534) * lu(k,533) + lu(k,535) = lu(k,535) * lu(k,533) + lu(k,536) = lu(k,536) * lu(k,533) + lu(k,537) = lu(k,537) * lu(k,533) + lu(k,538) = lu(k,538) * lu(k,533) + lu(k,539) = lu(k,539) * lu(k,533) + lu(k,3243) = lu(k,3243) - lu(k,534) * lu(k,3190) + lu(k,3269) = lu(k,3269) - lu(k,535) * lu(k,3190) + lu(k,3311) = lu(k,3311) - lu(k,536) * lu(k,3190) + lu(k,3315) = lu(k,3315) - lu(k,537) * lu(k,3190) + lu(k,3316) = lu(k,3316) - lu(k,538) * lu(k,3190) + lu(k,3320) = lu(k,3320) - lu(k,539) * lu(k,3190) + lu(k,3497) = lu(k,3497) - lu(k,534) * lu(k,3436) + lu(k,3525) = lu(k,3525) - lu(k,535) * lu(k,3436) + lu(k,3567) = lu(k,3567) - lu(k,536) * lu(k,3436) + lu(k,3571) = lu(k,3571) - lu(k,537) * lu(k,3436) + lu(k,3572) = lu(k,3572) - lu(k,538) * lu(k,3436) + lu(k,3576) = lu(k,3576) - lu(k,539) * lu(k,3436) + lu(k,3746) = lu(k,3746) - lu(k,534) * lu(k,3656) + lu(k,3776) = lu(k,3776) - lu(k,535) * lu(k,3656) + lu(k,3817) = lu(k,3817) - lu(k,536) * lu(k,3656) + lu(k,3821) = lu(k,3821) - lu(k,537) * lu(k,3656) + lu(k,3822) = lu(k,3822) - lu(k,538) * lu(k,3656) + lu(k,3826) = lu(k,3826) - lu(k,539) * lu(k,3656) + lu(k,540) = 1._r8 / lu(k,540) + lu(k,541) = lu(k,541) * lu(k,540) + lu(k,542) = lu(k,542) * lu(k,540) + lu(k,543) = lu(k,543) * lu(k,540) + lu(k,544) = lu(k,544) * lu(k,540) + lu(k,545) = lu(k,545) * lu(k,540) + lu(k,1598) = lu(k,1598) - lu(k,541) * lu(k,1596) + lu(k,1601) = lu(k,1601) - lu(k,542) * lu(k,1596) + lu(k,1603) = lu(k,1603) - lu(k,543) * lu(k,1596) + lu(k,1605) = lu(k,1605) - lu(k,544) * lu(k,1596) + lu(k,1607) = lu(k,1607) - lu(k,545) * lu(k,1596) + lu(k,3073) = lu(k,3073) - lu(k,541) * lu(k,3044) + lu(k,3114) = lu(k,3114) - lu(k,542) * lu(k,3044) + lu(k,3127) = lu(k,3127) - lu(k,543) * lu(k,3044) + lu(k,3132) = lu(k,3132) - lu(k,544) * lu(k,3044) + lu(k,3134) = lu(k,3134) - lu(k,545) * lu(k,3044) + lu(k,3376) = lu(k,3376) - lu(k,541) * lu(k,3368) + lu(k,3382) = lu(k,3382) - lu(k,542) * lu(k,3368) + lu(k,3385) = lu(k,3385) - lu(k,543) * lu(k,3368) + lu(k,3390) = lu(k,3390) - lu(k,544) * lu(k,3368) + lu(k,3392) = lu(k,3392) - lu(k,545) * lu(k,3368) + lu(k,3757) = lu(k,3757) - lu(k,541) * lu(k,3657) + lu(k,3802) = lu(k,3802) - lu(k,542) * lu(k,3657) + lu(k,3815) = lu(k,3815) - lu(k,543) * lu(k,3657) + lu(k,3820) = lu(k,3820) - lu(k,544) * lu(k,3657) + lu(k,3822) = lu(k,3822) - lu(k,545) * lu(k,3657) end do end subroutine lu_fac11 subroutine lu_fac12( avec_len, lu ) @@ -1582,153 +1501,144 @@ subroutine lu_fac12( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,526) = 1._r8 / lu(k,526) - lu(k,527) = lu(k,527) * lu(k,526) - lu(k,528) = lu(k,528) * lu(k,526) - lu(k,529) = lu(k,529) * lu(k,526) - lu(k,682) = lu(k,682) - lu(k,527) * lu(k,679) - lu(k,684) = lu(k,684) - lu(k,528) * lu(k,679) - lu(k,687) = lu(k,687) - lu(k,529) * lu(k,679) - lu(k,836) = - lu(k,527) * lu(k,832) - lu(k,839) = lu(k,839) - lu(k,528) * lu(k,832) - lu(k,842) = lu(k,842) - lu(k,529) * lu(k,832) - lu(k,2071) = - lu(k,527) * lu(k,2069) - lu(k,2086) = lu(k,2086) - lu(k,528) * lu(k,2069) - lu(k,2090) = lu(k,2090) - lu(k,529) * lu(k,2069) - lu(k,2464) = - lu(k,527) * lu(k,2461) - lu(k,2477) = lu(k,2477) - lu(k,528) * lu(k,2461) - lu(k,2481) = lu(k,2481) - lu(k,529) * lu(k,2461) - lu(k,2844) = lu(k,2844) - lu(k,527) * lu(k,2773) - lu(k,2889) = lu(k,2889) - lu(k,528) * lu(k,2773) - lu(k,2895) = lu(k,2895) - lu(k,529) * lu(k,2773) - lu(k,3240) = lu(k,3240) - lu(k,527) * lu(k,3160) - lu(k,3285) = lu(k,3285) - lu(k,528) * lu(k,3160) - lu(k,3291) = lu(k,3291) - lu(k,529) * lu(k,3160) - lu(k,3702) = lu(k,3702) - lu(k,527) * lu(k,3600) - lu(k,3746) = lu(k,3746) - lu(k,528) * lu(k,3600) - lu(k,3752) = lu(k,3752) - lu(k,529) * lu(k,3600) - 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,1207) = lu(k,1207) - lu(k,531) * lu(k,1194) - lu(k,1209) = lu(k,1209) - lu(k,532) * lu(k,1194) - lu(k,1210) = - lu(k,533) * lu(k,1194) - lu(k,1506) = lu(k,1506) - lu(k,531) * lu(k,1496) - lu(k,1508) = lu(k,1508) - lu(k,532) * lu(k,1496) - lu(k,1509) = lu(k,1509) - lu(k,533) * lu(k,1496) - lu(k,2707) = lu(k,2707) - lu(k,531) * lu(k,2645) - lu(k,2710) = lu(k,2710) - lu(k,532) * lu(k,2645) - lu(k,2713) = lu(k,2713) - lu(k,533) * lu(k,2645) - lu(k,2993) = lu(k,2993) - lu(k,531) * lu(k,2910) - lu(k,2996) = lu(k,2996) - lu(k,532) * lu(k,2910) - lu(k,3000) = - lu(k,533) * lu(k,2910) - lu(k,3288) = lu(k,3288) - lu(k,531) * lu(k,3161) - lu(k,3291) = lu(k,3291) - lu(k,532) * lu(k,3161) - lu(k,3295) = lu(k,3295) - lu(k,533) * lu(k,3161) - lu(k,3429) = lu(k,3429) - lu(k,531) * lu(k,3349) - lu(k,3432) = lu(k,3432) - lu(k,532) * lu(k,3349) - lu(k,3436) = lu(k,3436) - lu(k,533) * lu(k,3349) - lu(k,3749) = lu(k,3749) - lu(k,531) * lu(k,3601) - lu(k,3752) = lu(k,3752) - lu(k,532) * lu(k,3601) - lu(k,3756) = lu(k,3756) - lu(k,533) * lu(k,3601) - lu(k,534) = 1._r8 / lu(k,534) - lu(k,535) = lu(k,535) * lu(k,534) - lu(k,536) = lu(k,536) * lu(k,534) - lu(k,537) = lu(k,537) * lu(k,534) - lu(k,538) = lu(k,538) * lu(k,534) - lu(k,539) = lu(k,539) * lu(k,534) - lu(k,540) = lu(k,540) * lu(k,534) - lu(k,541) = lu(k,541) * lu(k,534) - lu(k,2796) = lu(k,2796) - lu(k,535) * lu(k,2774) - lu(k,2820) = lu(k,2820) - lu(k,536) * lu(k,2774) - lu(k,2864) = lu(k,2864) - lu(k,537) * lu(k,2774) - lu(k,2885) = lu(k,2885) - lu(k,538) * lu(k,2774) - lu(k,2889) = lu(k,2889) - lu(k,539) * lu(k,2774) - lu(k,2891) = lu(k,2891) - lu(k,540) * lu(k,2774) - lu(k,2894) = lu(k,2894) - lu(k,541) * lu(k,2774) - lu(k,3009) = - lu(k,535) * lu(k,3006) - lu(k,3022) = lu(k,3022) - lu(k,536) * lu(k,3006) - lu(k,3057) = lu(k,3057) - lu(k,537) * lu(k,3006) - lu(k,3078) = lu(k,3078) - lu(k,538) * lu(k,3006) - lu(k,3082) = lu(k,3082) - lu(k,539) * lu(k,3006) - lu(k,3084) = lu(k,3084) - lu(k,540) * lu(k,3006) - lu(k,3087) = lu(k,3087) - lu(k,541) * lu(k,3006) - lu(k,3637) = lu(k,3637) - lu(k,535) * lu(k,3602) - lu(k,3674) = lu(k,3674) - lu(k,536) * lu(k,3602) - lu(k,3721) = lu(k,3721) - lu(k,537) * lu(k,3602) - lu(k,3742) = lu(k,3742) - lu(k,538) * lu(k,3602) - lu(k,3746) = lu(k,3746) - lu(k,539) * lu(k,3602) - lu(k,3748) = lu(k,3748) - lu(k,540) * lu(k,3602) - lu(k,3751) = lu(k,3751) - lu(k,541) * lu(k,3602) - lu(k,542) = 1._r8 / lu(k,542) - lu(k,543) = lu(k,543) * lu(k,542) - lu(k,544) = lu(k,544) * lu(k,542) - lu(k,545) = lu(k,545) * lu(k,542) - lu(k,546) = lu(k,546) * lu(k,542) - lu(k,547) = lu(k,547) * lu(k,542) - lu(k,548) = lu(k,548) * lu(k,542) - lu(k,549) = lu(k,549) * lu(k,542) - lu(k,550) = lu(k,550) * lu(k,542) - lu(k,551) = lu(k,551) * lu(k,542) - lu(k,552) = lu(k,552) * lu(k,542) - lu(k,553) = lu(k,553) * lu(k,542) - lu(k,1768) = lu(k,1768) - lu(k,543) * lu(k,1767) - lu(k,1771) = - lu(k,544) * lu(k,1767) - lu(k,1772) = lu(k,1772) - lu(k,545) * lu(k,1767) - lu(k,1775) = - lu(k,546) * lu(k,1767) - lu(k,1777) = lu(k,1777) - lu(k,547) * lu(k,1767) - lu(k,1783) = - lu(k,548) * lu(k,1767) - lu(k,1784) = lu(k,1784) - lu(k,549) * lu(k,1767) - lu(k,1787) = lu(k,1787) - lu(k,550) * lu(k,1767) - lu(k,1790) = lu(k,1790) - lu(k,551) * lu(k,1767) - lu(k,1792) = lu(k,1792) - lu(k,552) * lu(k,1767) - lu(k,1794) = lu(k,1794) - lu(k,553) * lu(k,1767) - lu(k,3605) = lu(k,3605) - lu(k,543) * lu(k,3603) - lu(k,3658) = lu(k,3658) - lu(k,544) * lu(k,3603) - lu(k,3669) = lu(k,3669) - lu(k,545) * lu(k,3603) - lu(k,3682) = lu(k,3682) - lu(k,546) * lu(k,3603) - lu(k,3694) = lu(k,3694) - lu(k,547) * lu(k,3603) - lu(k,3711) = lu(k,3711) - lu(k,548) * lu(k,3603) - lu(k,3712) = lu(k,3712) - lu(k,549) * lu(k,3603) - lu(k,3739) = lu(k,3739) - lu(k,550) * lu(k,3603) - lu(k,3746) = lu(k,3746) - lu(k,551) * lu(k,3603) - lu(k,3749) = lu(k,3749) - lu(k,552) * lu(k,3603) - lu(k,3752) = lu(k,3752) - lu(k,553) * lu(k,3603) - lu(k,554) = 1._r8 / lu(k,554) - lu(k,555) = lu(k,555) * lu(k,554) - lu(k,556) = lu(k,556) * lu(k,554) - lu(k,557) = lu(k,557) * lu(k,554) - lu(k,558) = lu(k,558) * lu(k,554) - lu(k,559) = lu(k,559) * lu(k,554) - lu(k,560) = lu(k,560) * lu(k,554) - lu(k,561) = lu(k,561) * lu(k,554) - lu(k,562) = lu(k,562) * lu(k,554) - lu(k,563) = lu(k,563) * lu(k,554) - lu(k,564) = lu(k,564) * lu(k,554) - lu(k,565) = lu(k,565) * lu(k,554) - lu(k,1656) = lu(k,1656) - lu(k,555) * lu(k,1655) - lu(k,1658) = - lu(k,556) * lu(k,1655) - lu(k,1659) = lu(k,1659) - lu(k,557) * lu(k,1655) - lu(k,1662) = - lu(k,558) * lu(k,1655) - lu(k,1664) = lu(k,1664) - lu(k,559) * lu(k,1655) - lu(k,1670) = lu(k,1670) - lu(k,560) * lu(k,1655) - lu(k,1671) = - lu(k,561) * lu(k,1655) - lu(k,1675) = lu(k,1675) - lu(k,562) * lu(k,1655) - lu(k,1678) = lu(k,1678) - lu(k,563) * lu(k,1655) - lu(k,1680) = lu(k,1680) - lu(k,564) * lu(k,1655) - lu(k,1682) = lu(k,1682) - lu(k,565) * lu(k,1655) - lu(k,3605) = lu(k,3605) - lu(k,555) * lu(k,3604) - lu(k,3630) = lu(k,3630) - lu(k,556) * lu(k,3604) - lu(k,3669) = lu(k,3669) - lu(k,557) * lu(k,3604) - lu(k,3683) = lu(k,3683) - lu(k,558) * lu(k,3604) - lu(k,3694) = lu(k,3694) - lu(k,559) * lu(k,3604) - lu(k,3707) = lu(k,3707) - lu(k,560) * lu(k,3604) - lu(k,3711) = lu(k,3711) - lu(k,561) * lu(k,3604) - lu(k,3739) = lu(k,3739) - lu(k,562) * lu(k,3604) - lu(k,3746) = lu(k,3746) - lu(k,563) * lu(k,3604) - lu(k,3749) = lu(k,3749) - lu(k,564) * lu(k,3604) - lu(k,3752) = lu(k,3752) - lu(k,565) * lu(k,3604) + lu(k,547) = 1._r8 / lu(k,547) + lu(k,548) = lu(k,548) * lu(k,547) + lu(k,549) = lu(k,549) * lu(k,547) + lu(k,550) = lu(k,550) * lu(k,547) + lu(k,551) = lu(k,551) * lu(k,547) + lu(k,552) = lu(k,552) * lu(k,547) + lu(k,3198) = lu(k,3198) - lu(k,548) * lu(k,3191) + lu(k,3311) = lu(k,3311) - lu(k,549) * lu(k,3191) + lu(k,3315) = lu(k,3315) - lu(k,550) * lu(k,3191) + lu(k,3316) = lu(k,3316) - lu(k,551) * lu(k,3191) + lu(k,3320) = lu(k,3320) - lu(k,552) * lu(k,3191) + lu(k,3444) = lu(k,3444) - lu(k,548) * lu(k,3437) + lu(k,3567) = lu(k,3567) - lu(k,549) * lu(k,3437) + lu(k,3571) = lu(k,3571) - lu(k,550) * lu(k,3437) + lu(k,3572) = lu(k,3572) - lu(k,551) * lu(k,3437) + lu(k,3576) = lu(k,3576) - lu(k,552) * lu(k,3437) + lu(k,3676) = lu(k,3676) - lu(k,548) * lu(k,3658) + lu(k,3817) = lu(k,3817) - lu(k,549) * lu(k,3658) + lu(k,3821) = lu(k,3821) - lu(k,550) * lu(k,3658) + lu(k,3822) = lu(k,3822) - lu(k,551) * lu(k,3658) + lu(k,3826) = lu(k,3826) - lu(k,552) * lu(k,3658) + lu(k,4068) = lu(k,4068) - lu(k,548) * lu(k,4063) + lu(k,4096) = lu(k,4096) - lu(k,549) * lu(k,4063) + lu(k,4100) = lu(k,4100) - lu(k,550) * lu(k,4063) + lu(k,4101) = lu(k,4101) - lu(k,551) * lu(k,4063) + lu(k,4105) = lu(k,4105) - lu(k,552) * lu(k,4063) + lu(k,553) = 1._r8 / lu(k,553) + lu(k,554) = lu(k,554) * lu(k,553) + lu(k,555) = lu(k,555) * lu(k,553) + lu(k,556) = lu(k,556) * lu(k,553) + lu(k,557) = lu(k,557) * lu(k,553) + lu(k,717) = - lu(k,554) * lu(k,715) + lu(k,718) = - lu(k,555) * lu(k,715) + lu(k,721) = - lu(k,556) * lu(k,715) + lu(k,724) = lu(k,724) - lu(k,557) * lu(k,715) + lu(k,728) = - lu(k,554) * lu(k,726) + lu(k,730) = - lu(k,555) * lu(k,726) + lu(k,733) = - lu(k,556) * lu(k,726) + lu(k,736) = lu(k,736) - lu(k,557) * lu(k,726) + lu(k,1197) = - lu(k,554) * lu(k,1194) + lu(k,1199) = - lu(k,555) * lu(k,1194) + lu(k,1202) = - lu(k,556) * lu(k,1194) + lu(k,1206) = - lu(k,557) * lu(k,1194) + lu(k,3200) = lu(k,3200) - lu(k,554) * lu(k,3192) + lu(k,3235) = lu(k,3235) - lu(k,555) * lu(k,3192) + lu(k,3308) = lu(k,3308) - lu(k,556) * lu(k,3192) + lu(k,3316) = lu(k,3316) - lu(k,557) * lu(k,3192) + lu(k,3679) = lu(k,3679) - lu(k,554) * lu(k,3659) + lu(k,3736) = lu(k,3736) - lu(k,555) * lu(k,3659) + lu(k,3814) = lu(k,3814) - lu(k,556) * lu(k,3659) + lu(k,3822) = lu(k,3822) - lu(k,557) * lu(k,3659) + lu(k,558) = 1._r8 / lu(k,558) + lu(k,559) = lu(k,559) * lu(k,558) + lu(k,560) = lu(k,560) * lu(k,558) + lu(k,561) = lu(k,561) * lu(k,558) + lu(k,562) = lu(k,562) * lu(k,558) + lu(k,563) = lu(k,563) * lu(k,558) + lu(k,564) = lu(k,564) * lu(k,558) + lu(k,565) = lu(k,565) * lu(k,558) + lu(k,1979) = - lu(k,559) * lu(k,1977) + lu(k,1982) = - lu(k,560) * lu(k,1977) + lu(k,1998) = lu(k,1998) - lu(k,561) * lu(k,1977) + lu(k,2006) = lu(k,2006) - lu(k,562) * lu(k,1977) + lu(k,2008) = lu(k,2008) - lu(k,563) * lu(k,1977) + lu(k,2009) = lu(k,2009) - lu(k,564) * lu(k,1977) + lu(k,2012) = lu(k,2012) - lu(k,565) * lu(k,1977) + lu(k,3221) = lu(k,3221) - lu(k,559) * lu(k,3193) + lu(k,3248) = - lu(k,560) * lu(k,3193) + lu(k,3274) = lu(k,3274) - lu(k,561) * lu(k,3193) + lu(k,3313) = lu(k,3313) - lu(k,562) * lu(k,3193) + lu(k,3315) = lu(k,3315) - lu(k,563) * lu(k,3193) + lu(k,3316) = lu(k,3316) - lu(k,564) * lu(k,3193) + lu(k,3320) = lu(k,3320) - lu(k,565) * lu(k,3193) + lu(k,3711) = lu(k,3711) - lu(k,559) * lu(k,3660) + lu(k,3752) = lu(k,3752) - lu(k,560) * lu(k,3660) + lu(k,3781) = lu(k,3781) - lu(k,561) * lu(k,3660) + lu(k,3819) = lu(k,3819) - lu(k,562) * lu(k,3660) + lu(k,3821) = lu(k,3821) - lu(k,563) * lu(k,3660) + lu(k,3822) = lu(k,3822) - lu(k,564) * lu(k,3660) + lu(k,3826) = lu(k,3826) - lu(k,565) * lu(k,3660) + lu(k,566) = 1._r8 / lu(k,566) + lu(k,567) = lu(k,567) * lu(k,566) + lu(k,568) = lu(k,568) * lu(k,566) + lu(k,569) = lu(k,569) * lu(k,566) + lu(k,570) = lu(k,570) * lu(k,566) + lu(k,571) = lu(k,571) * lu(k,566) + lu(k,572) = lu(k,572) * lu(k,566) + lu(k,573) = lu(k,573) * lu(k,566) + lu(k,2973) = lu(k,2973) - lu(k,567) * lu(k,2963) + lu(k,3023) = lu(k,3023) - lu(k,568) * lu(k,2963) + lu(k,3028) = lu(k,3028) - lu(k,569) * lu(k,2963) + lu(k,3031) = lu(k,3031) - lu(k,570) * lu(k,2963) + lu(k,3033) = - lu(k,571) * lu(k,2963) + lu(k,3034) = lu(k,3034) - lu(k,572) * lu(k,2963) + lu(k,3035) = lu(k,3035) - lu(k,573) * lu(k,2963) + lu(k,3758) = lu(k,3758) - lu(k,567) * lu(k,3661) + lu(k,3814) = lu(k,3814) - lu(k,568) * lu(k,3661) + lu(k,3819) = lu(k,3819) - lu(k,569) * lu(k,3661) + lu(k,3822) = lu(k,3822) - lu(k,570) * lu(k,3661) + lu(k,3824) = lu(k,3824) - lu(k,571) * lu(k,3661) + lu(k,3825) = lu(k,3825) - lu(k,572) * lu(k,3661) + lu(k,3826) = lu(k,3826) - lu(k,573) * lu(k,3661) + lu(k,4078) = - lu(k,567) * lu(k,4064) + lu(k,4093) = lu(k,4093) - lu(k,568) * lu(k,4064) + lu(k,4098) = - lu(k,569) * lu(k,4064) + lu(k,4101) = lu(k,4101) - lu(k,570) * lu(k,4064) + lu(k,4103) = lu(k,4103) - lu(k,571) * lu(k,4064) + lu(k,4104) = - lu(k,572) * lu(k,4064) + lu(k,4105) = lu(k,4105) - lu(k,573) * lu(k,4064) + lu(k,574) = 1._r8 / lu(k,574) + lu(k,575) = lu(k,575) * lu(k,574) + lu(k,576) = lu(k,576) * lu(k,574) + lu(k,577) = lu(k,577) * lu(k,574) + lu(k,578) = lu(k,578) * lu(k,574) + lu(k,579) = lu(k,579) * lu(k,574) + lu(k,580) = lu(k,580) * lu(k,574) + lu(k,581) = lu(k,581) * lu(k,574) + lu(k,2551) = lu(k,2551) - lu(k,575) * lu(k,2550) + lu(k,2554) = lu(k,2554) - lu(k,576) * lu(k,2550) + lu(k,2555) = lu(k,2555) - lu(k,577) * lu(k,2550) + lu(k,2562) = - lu(k,578) * lu(k,2550) + lu(k,2564) = lu(k,2564) - lu(k,579) * lu(k,2550) + lu(k,2568) = - lu(k,580) * lu(k,2550) + lu(k,2569) = lu(k,2569) - lu(k,581) * lu(k,2550) + lu(k,3370) = lu(k,3370) - lu(k,575) * lu(k,3369) + lu(k,3379) = lu(k,3379) - lu(k,576) * lu(k,3369) + lu(k,3381) = lu(k,3381) - lu(k,577) * lu(k,3369) + lu(k,3388) = - lu(k,578) * lu(k,3369) + lu(k,3390) = lu(k,3390) - lu(k,579) * lu(k,3369) + lu(k,3394) = lu(k,3394) - lu(k,580) * lu(k,3369) + lu(k,3396) = lu(k,3396) - lu(k,581) * lu(k,3369) + lu(k,4072) = - lu(k,575) * lu(k,4065) + lu(k,4083) = - lu(k,576) * lu(k,4065) + lu(k,4085) = lu(k,4085) - lu(k,577) * lu(k,4065) + lu(k,4097) = lu(k,4097) - lu(k,578) * lu(k,4065) + lu(k,4099) = lu(k,4099) - lu(k,579) * lu(k,4065) + lu(k,4103) = lu(k,4103) - lu(k,580) * lu(k,4065) + lu(k,4105) = lu(k,4105) - lu(k,581) * lu(k,4065) end do end subroutine lu_fac12 subroutine lu_fac13( avec_len, lu ) @@ -1745,64 +1655,6 @@ subroutine lu_fac13( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,566) = 1._r8 / lu(k,566) - lu(k,567) = lu(k,567) * lu(k,566) - lu(k,568) = lu(k,568) * lu(k,566) - lu(k,569) = lu(k,569) * lu(k,566) - lu(k,570) = lu(k,570) * lu(k,566) - lu(k,571) = lu(k,571) * lu(k,566) - lu(k,572) = lu(k,572) * lu(k,566) - lu(k,1658) = lu(k,1658) - lu(k,567) * lu(k,1656) - lu(k,1664) = lu(k,1664) - lu(k,568) * lu(k,1656) - lu(k,1671) = lu(k,1671) - lu(k,569) * lu(k,1656) - lu(k,1678) = lu(k,1678) - lu(k,570) * lu(k,1656) - lu(k,1679) = lu(k,1679) - lu(k,571) * lu(k,1656) - lu(k,1682) = lu(k,1682) - lu(k,572) * lu(k,1656) - lu(k,1770) = - lu(k,567) * lu(k,1768) - lu(k,1777) = lu(k,1777) - lu(k,568) * lu(k,1768) - lu(k,1783) = lu(k,1783) - lu(k,569) * lu(k,1768) - lu(k,1790) = lu(k,1790) - lu(k,570) * lu(k,1768) - lu(k,1791) = lu(k,1791) - lu(k,571) * lu(k,1768) - lu(k,1794) = lu(k,1794) - lu(k,572) * lu(k,1768) - lu(k,3630) = lu(k,3630) - lu(k,567) * lu(k,3605) - lu(k,3694) = lu(k,3694) - lu(k,568) * lu(k,3605) - lu(k,3711) = lu(k,3711) - lu(k,569) * lu(k,3605) - lu(k,3746) = lu(k,3746) - lu(k,570) * lu(k,3605) - lu(k,3748) = lu(k,3748) - lu(k,571) * lu(k,3605) - lu(k,3752) = lu(k,3752) - lu(k,572) * lu(k,3605) - lu(k,573) = 1._r8 / lu(k,573) - lu(k,574) = lu(k,574) * lu(k,573) - lu(k,575) = lu(k,575) * lu(k,573) - lu(k,576) = lu(k,576) * lu(k,573) - lu(k,577) = lu(k,577) * lu(k,573) - lu(k,578) = lu(k,578) * lu(k,573) - lu(k,579) = lu(k,579) * lu(k,573) - lu(k,580) = lu(k,580) * lu(k,573) - lu(k,581) = lu(k,581) * lu(k,573) - lu(k,1814) = - lu(k,574) * lu(k,1812) - lu(k,1815) = - lu(k,575) * lu(k,1812) - lu(k,1831) = lu(k,1831) - lu(k,576) * lu(k,1812) - lu(k,1835) = - lu(k,577) * lu(k,1812) - lu(k,1838) = lu(k,1838) - lu(k,578) * lu(k,1812) - lu(k,1839) = lu(k,1839) - lu(k,579) * lu(k,1812) - lu(k,1841) = lu(k,1841) - lu(k,580) * lu(k,1812) - lu(k,1842) = lu(k,1842) - lu(k,581) * lu(k,1812) - lu(k,2789) = lu(k,2789) - lu(k,574) * lu(k,2775) - lu(k,2807) = lu(k,2807) - lu(k,575) * lu(k,2775) - lu(k,2854) = lu(k,2854) - lu(k,576) * lu(k,2775) - lu(k,2883) = - lu(k,577) * lu(k,2775) - lu(k,2889) = lu(k,2889) - lu(k,578) * lu(k,2775) - lu(k,2891) = lu(k,2891) - lu(k,579) * lu(k,2775) - lu(k,2894) = lu(k,2894) - lu(k,580) * lu(k,2775) - lu(k,2895) = lu(k,2895) - lu(k,581) * lu(k,2775) - lu(k,3629) = lu(k,3629) - lu(k,574) * lu(k,3606) - lu(k,3654) = lu(k,3654) - lu(k,575) * lu(k,3606) - lu(k,3712) = lu(k,3712) - lu(k,576) * lu(k,3606) - lu(k,3740) = lu(k,3740) - lu(k,577) * lu(k,3606) - lu(k,3746) = lu(k,3746) - lu(k,578) * lu(k,3606) - lu(k,3748) = lu(k,3748) - lu(k,579) * lu(k,3606) - lu(k,3751) = lu(k,3751) - lu(k,580) * lu(k,3606) - lu(k,3752) = lu(k,3752) - lu(k,581) * lu(k,3606) lu(k,582) = 1._r8 / lu(k,582) lu(k,583) = lu(k,583) * lu(k,582) lu(k,584) = lu(k,584) * lu(k,582) @@ -1810,91 +1662,181 @@ subroutine lu_fac13( avec_len, lu ) lu(k,586) = lu(k,586) * lu(k,582) lu(k,587) = lu(k,587) * lu(k,582) lu(k,588) = lu(k,588) * lu(k,582) - lu(k,2295) = - lu(k,583) * lu(k,2291) - lu(k,2300) = lu(k,2300) - lu(k,584) * lu(k,2291) - lu(k,2305) = lu(k,2305) - lu(k,585) * lu(k,2291) - lu(k,2317) = lu(k,2317) - lu(k,586) * lu(k,2291) - lu(k,2320) = lu(k,2320) - lu(k,587) * lu(k,2291) - lu(k,2321) = lu(k,2321) - lu(k,588) * lu(k,2291) - lu(k,2354) = - lu(k,583) * lu(k,2350) - lu(k,2359) = lu(k,2359) - lu(k,584) * lu(k,2350) - lu(k,2366) = - lu(k,585) * lu(k,2350) - lu(k,2378) = lu(k,2378) - lu(k,586) * lu(k,2350) - lu(k,2381) = lu(k,2381) - lu(k,587) * lu(k,2350) - lu(k,2382) = lu(k,2382) - lu(k,588) * lu(k,2350) - lu(k,3204) = lu(k,3204) - lu(k,583) * lu(k,3162) - lu(k,3235) = lu(k,3235) - lu(k,584) * lu(k,3162) - lu(k,3271) = lu(k,3271) - lu(k,585) * lu(k,3162) - lu(k,3285) = lu(k,3285) - lu(k,586) * lu(k,3162) - lu(k,3290) = lu(k,3290) - lu(k,587) * lu(k,3162) - lu(k,3291) = lu(k,3291) - lu(k,588) * lu(k,3162) - lu(k,3660) = lu(k,3660) - lu(k,583) * lu(k,3607) - lu(k,3697) = lu(k,3697) - lu(k,584) * lu(k,3607) - lu(k,3732) = lu(k,3732) - lu(k,585) * lu(k,3607) - lu(k,3746) = lu(k,3746) - lu(k,586) * lu(k,3607) - lu(k,3751) = lu(k,3751) - lu(k,587) * lu(k,3607) - lu(k,3752) = lu(k,3752) - lu(k,588) * lu(k,3607) - lu(k,589) = 1._r8 / lu(k,589) - lu(k,590) = lu(k,590) * lu(k,589) - lu(k,591) = lu(k,591) * lu(k,589) - lu(k,592) = lu(k,592) * lu(k,589) - lu(k,837) = - lu(k,590) * lu(k,833) - lu(k,839) = lu(k,839) - lu(k,591) * lu(k,833) - lu(k,842) = lu(k,842) - lu(k,592) * lu(k,833) - lu(k,920) = - lu(k,590) * lu(k,915) - lu(k,922) = lu(k,922) - lu(k,591) * lu(k,915) - lu(k,924) = lu(k,924) - lu(k,592) * lu(k,915) - lu(k,2213) = lu(k,2213) - lu(k,590) * lu(k,2202) - lu(k,2227) = lu(k,2227) - lu(k,591) * lu(k,2202) - lu(k,2231) = lu(k,2231) - lu(k,592) * lu(k,2202) - lu(k,2242) = - lu(k,590) * lu(k,2233) - lu(k,2256) = lu(k,2256) - lu(k,591) * lu(k,2233) - lu(k,2260) = lu(k,2260) - lu(k,592) * lu(k,2233) - lu(k,2444) = - lu(k,590) * lu(k,2439) - lu(k,2456) = lu(k,2456) - lu(k,591) * lu(k,2439) - lu(k,2460) = - lu(k,592) * lu(k,2439) - lu(k,2486) = - lu(k,590) * lu(k,2482) - lu(k,2498) = lu(k,2498) - lu(k,591) * lu(k,2482) - lu(k,2502) = lu(k,2502) - lu(k,592) * lu(k,2482) - lu(k,3263) = lu(k,3263) - lu(k,590) * lu(k,3163) - lu(k,3285) = lu(k,3285) - lu(k,591) * lu(k,3163) - lu(k,3291) = lu(k,3291) - lu(k,592) * lu(k,3163) - lu(k,3724) = lu(k,3724) - lu(k,590) * lu(k,3608) - lu(k,3746) = lu(k,3746) - lu(k,591) * lu(k,3608) - lu(k,3752) = lu(k,3752) - lu(k,592) * lu(k,3608) - lu(k,593) = 1._r8 / lu(k,593) - lu(k,594) = lu(k,594) * lu(k,593) - lu(k,595) = lu(k,595) * lu(k,593) - lu(k,596) = lu(k,596) * lu(k,593) - lu(k,597) = lu(k,597) * lu(k,593) - lu(k,598) = lu(k,598) * lu(k,593) - lu(k,599) = lu(k,599) * lu(k,593) - lu(k,600) = lu(k,600) * lu(k,593) - lu(k,601) = lu(k,601) * lu(k,593) - lu(k,2808) = - lu(k,594) * lu(k,2776) - lu(k,2809) = lu(k,2809) - lu(k,595) * lu(k,2776) - lu(k,2885) = lu(k,2885) - lu(k,596) * lu(k,2776) - lu(k,2889) = lu(k,2889) - lu(k,597) * lu(k,2776) - lu(k,2891) = lu(k,2891) - lu(k,598) * lu(k,2776) - lu(k,2894) = lu(k,2894) - lu(k,599) * lu(k,2776) - lu(k,2895) = lu(k,2895) - lu(k,600) * lu(k,2776) - lu(k,2899) = - lu(k,601) * lu(k,2776) - lu(k,3201) = lu(k,3201) - lu(k,594) * lu(k,3164) - lu(k,3202) = lu(k,3202) - lu(k,595) * lu(k,3164) - lu(k,3281) = lu(k,3281) - lu(k,596) * lu(k,3164) - lu(k,3285) = lu(k,3285) - lu(k,597) * lu(k,3164) - lu(k,3287) = lu(k,3287) - lu(k,598) * lu(k,3164) - lu(k,3290) = lu(k,3290) - lu(k,599) * lu(k,3164) - lu(k,3291) = lu(k,3291) - lu(k,600) * lu(k,3164) - lu(k,3295) = lu(k,3295) - lu(k,601) * lu(k,3164) - lu(k,3324) = - lu(k,594) * lu(k,3322) - lu(k,3325) = - lu(k,595) * lu(k,3322) - lu(k,3331) = - lu(k,596) * lu(k,3322) - lu(k,3335) = lu(k,3335) - lu(k,597) * lu(k,3322) - lu(k,3337) = lu(k,3337) - lu(k,598) * lu(k,3322) - lu(k,3340) = - lu(k,599) * lu(k,3322) - lu(k,3341) = lu(k,3341) - lu(k,600) * lu(k,3322) - lu(k,3345) = lu(k,3345) - lu(k,601) * lu(k,3322) + lu(k,589) = lu(k,589) * lu(k,582) + lu(k,932) = lu(k,932) - lu(k,583) * lu(k,931) + lu(k,933) = lu(k,933) - lu(k,584) * lu(k,931) + lu(k,934) = - lu(k,585) * lu(k,931) + lu(k,936) = lu(k,936) - lu(k,586) * lu(k,931) + lu(k,937) = lu(k,937) - lu(k,587) * lu(k,931) + lu(k,938) = - lu(k,588) * lu(k,931) + lu(k,940) = - lu(k,589) * lu(k,931) + lu(k,3463) = lu(k,3463) - lu(k,583) * lu(k,3438) + lu(k,3492) = lu(k,3492) - lu(k,584) * lu(k,3438) + lu(k,3518) = lu(k,3518) - lu(k,585) * lu(k,3438) + lu(k,3569) = lu(k,3569) - lu(k,586) * lu(k,3438) + lu(k,3571) = lu(k,3571) - lu(k,587) * lu(k,3438) + lu(k,3572) = lu(k,3572) - lu(k,588) * lu(k,3438) + lu(k,3577) = lu(k,3577) - lu(k,589) * lu(k,3438) + lu(k,3700) = lu(k,3700) - lu(k,583) * lu(k,3662) + lu(k,3741) = lu(k,3741) - lu(k,584) * lu(k,3662) + lu(k,3769) = lu(k,3769) - lu(k,585) * lu(k,3662) + lu(k,3819) = lu(k,3819) - lu(k,586) * lu(k,3662) + lu(k,3821) = lu(k,3821) - lu(k,587) * lu(k,3662) + lu(k,3822) = lu(k,3822) - lu(k,588) * lu(k,3662) + lu(k,3827) = lu(k,3827) - lu(k,589) * lu(k,3662) + lu(k,590) = 1._r8 / lu(k,590) + lu(k,591) = lu(k,591) * lu(k,590) + lu(k,592) = lu(k,592) * lu(k,590) + lu(k,593) = lu(k,593) * lu(k,590) + lu(k,594) = lu(k,594) * lu(k,590) + lu(k,595) = lu(k,595) * lu(k,590) + lu(k,596) = lu(k,596) * lu(k,590) + lu(k,597) = lu(k,597) * lu(k,590) + lu(k,3051) = - lu(k,591) * lu(k,3045) + lu(k,3063) = lu(k,3063) - lu(k,592) * lu(k,3045) + lu(k,3089) = lu(k,3089) - lu(k,593) * lu(k,3045) + lu(k,3127) = lu(k,3127) - lu(k,594) * lu(k,3045) + lu(k,3131) = lu(k,3131) - lu(k,595) * lu(k,3045) + lu(k,3133) = lu(k,3133) - lu(k,596) * lu(k,3045) + lu(k,3134) = lu(k,3134) - lu(k,597) * lu(k,3045) + lu(k,3692) = lu(k,3692) - lu(k,591) * lu(k,3663) + lu(k,3737) = lu(k,3737) - lu(k,592) * lu(k,3663) + lu(k,3777) = lu(k,3777) - lu(k,593) * lu(k,3663) + lu(k,3815) = lu(k,3815) - lu(k,594) * lu(k,3663) + lu(k,3819) = lu(k,3819) - lu(k,595) * lu(k,3663) + lu(k,3821) = lu(k,3821) - lu(k,596) * lu(k,3663) + lu(k,3822) = lu(k,3822) - lu(k,597) * lu(k,3663) + lu(k,3836) = - lu(k,591) * lu(k,3834) + lu(k,3840) = lu(k,3840) - lu(k,592) * lu(k,3834) + lu(k,3848) = lu(k,3848) - lu(k,593) * lu(k,3834) + lu(k,3856) = lu(k,3856) - lu(k,594) * lu(k,3834) + lu(k,3860) = lu(k,3860) - lu(k,595) * lu(k,3834) + lu(k,3862) = lu(k,3862) - lu(k,596) * lu(k,3834) + lu(k,3863) = lu(k,3863) - lu(k,597) * lu(k,3834) + lu(k,598) = 1._r8 / lu(k,598) + lu(k,599) = lu(k,599) * lu(k,598) + lu(k,600) = lu(k,600) * lu(k,598) + lu(k,601) = lu(k,601) * lu(k,598) + lu(k,797) = lu(k,797) - lu(k,599) * lu(k,794) + lu(k,800) = lu(k,800) - lu(k,600) * lu(k,794) + lu(k,801) = lu(k,801) - lu(k,601) * lu(k,794) + lu(k,946) = - lu(k,599) * lu(k,942) + lu(k,950) = lu(k,950) - lu(k,600) * lu(k,942) + lu(k,951) = lu(k,951) - lu(k,601) * lu(k,942) + lu(k,2233) = - lu(k,599) * lu(k,2230) + lu(k,2249) = lu(k,2249) - lu(k,600) * lu(k,2230) + lu(k,2250) = lu(k,2250) - lu(k,601) * lu(k,2230) + lu(k,2747) = - lu(k,599) * lu(k,2744) + lu(k,2761) = lu(k,2761) - lu(k,600) * lu(k,2744) + lu(k,2762) = lu(k,2762) - lu(k,601) * lu(k,2744) + lu(k,3259) = lu(k,3259) - lu(k,599) * lu(k,3194) + lu(k,3315) = lu(k,3315) - lu(k,600) * lu(k,3194) + lu(k,3316) = lu(k,3316) - lu(k,601) * lu(k,3194) + lu(k,3515) = lu(k,3515) - lu(k,599) * lu(k,3439) + lu(k,3571) = lu(k,3571) - lu(k,600) * lu(k,3439) + lu(k,3572) = lu(k,3572) - lu(k,601) * lu(k,3439) + lu(k,3766) = lu(k,3766) - lu(k,599) * lu(k,3664) + lu(k,3821) = lu(k,3821) - lu(k,600) * lu(k,3664) + lu(k,3822) = lu(k,3822) - lu(k,601) * lu(k,3664) + 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,3216) = lu(k,3216) - lu(k,603) * lu(k,3195) + lu(k,3238) = lu(k,3238) - lu(k,604) * lu(k,3195) + lu(k,3284) = lu(k,3284) - lu(k,605) * lu(k,3195) + lu(k,3311) = lu(k,3311) - lu(k,606) * lu(k,3195) + lu(k,3313) = lu(k,3313) - lu(k,607) * lu(k,3195) + lu(k,3315) = lu(k,3315) - lu(k,608) * lu(k,3195) + lu(k,3320) = lu(k,3320) - lu(k,609) * lu(k,3195) + lu(k,3705) = lu(k,3705) - lu(k,603) * lu(k,3665) + lu(k,3741) = lu(k,3741) - lu(k,604) * lu(k,3665) + lu(k,3790) = lu(k,3790) - lu(k,605) * lu(k,3665) + lu(k,3817) = lu(k,3817) - lu(k,606) * lu(k,3665) + lu(k,3819) = lu(k,3819) - lu(k,607) * lu(k,3665) + lu(k,3821) = lu(k,3821) - lu(k,608) * lu(k,3665) + lu(k,3826) = lu(k,3826) - lu(k,609) * lu(k,3665) + lu(k,3876) = - lu(k,603) * lu(k,3874) + lu(k,3890) = lu(k,3890) - lu(k,604) * lu(k,3874) + lu(k,3925) = lu(k,3925) - lu(k,605) * lu(k,3874) + lu(k,3952) = lu(k,3952) - lu(k,606) * lu(k,3874) + lu(k,3954) = lu(k,3954) - lu(k,607) * lu(k,3874) + lu(k,3956) = lu(k,3956) - lu(k,608) * lu(k,3874) + lu(k,3961) = lu(k,3961) - lu(k,609) * lu(k,3874) + lu(k,610) = 1._r8 / lu(k,610) + lu(k,611) = lu(k,611) * lu(k,610) + lu(k,612) = lu(k,612) * lu(k,610) + lu(k,613) = lu(k,613) * lu(k,610) + lu(k,614) = lu(k,614) * lu(k,610) + lu(k,615) = lu(k,615) * lu(k,610) + lu(k,616) = lu(k,616) * lu(k,610) + lu(k,617) = lu(k,617) * lu(k,610) + lu(k,618) = lu(k,618) * lu(k,610) + lu(k,1943) = - lu(k,611) * lu(k,1941) + lu(k,1945) = - lu(k,612) * lu(k,1941) + lu(k,1962) = lu(k,1962) - lu(k,613) * lu(k,1941) + lu(k,1966) = - lu(k,614) * lu(k,1941) + lu(k,1967) = lu(k,1967) - lu(k,615) * lu(k,1941) + lu(k,1969) = lu(k,1969) - lu(k,616) * lu(k,1941) + lu(k,1970) = lu(k,1970) - lu(k,617) * lu(k,1941) + lu(k,1973) = lu(k,1973) - lu(k,618) * lu(k,1941) + lu(k,3227) = lu(k,3227) - lu(k,611) * lu(k,3196) + lu(k,3248) = lu(k,3248) - lu(k,612) * lu(k,3196) + lu(k,3275) = lu(k,3275) - lu(k,613) * lu(k,3196) + lu(k,3312) = - lu(k,614) * lu(k,3196) + lu(k,3313) = lu(k,3313) - lu(k,615) * lu(k,3196) + lu(k,3315) = lu(k,3315) - lu(k,616) * lu(k,3196) + lu(k,3316) = lu(k,3316) - lu(k,617) * lu(k,3196) + lu(k,3320) = lu(k,3320) - lu(k,618) * lu(k,3196) + lu(k,3721) = lu(k,3721) - lu(k,611) * lu(k,3666) + lu(k,3752) = lu(k,3752) - lu(k,612) * lu(k,3666) + lu(k,3782) = lu(k,3782) - lu(k,613) * lu(k,3666) + lu(k,3818) = lu(k,3818) - lu(k,614) * lu(k,3666) + lu(k,3819) = lu(k,3819) - lu(k,615) * lu(k,3666) + lu(k,3821) = lu(k,3821) - lu(k,616) * lu(k,3666) + lu(k,3822) = lu(k,3822) - lu(k,617) * lu(k,3666) + lu(k,3826) = lu(k,3826) - lu(k,618) * lu(k,3666) + lu(k,619) = 1._r8 / lu(k,619) + lu(k,620) = lu(k,620) * lu(k,619) + lu(k,621) = lu(k,621) * lu(k,619) + lu(k,622) = lu(k,622) * lu(k,619) + lu(k,623) = lu(k,623) * lu(k,619) + lu(k,624) = lu(k,624) * lu(k,619) + lu(k,625) = lu(k,625) * lu(k,619) + lu(k,626) = lu(k,626) * lu(k,619) + lu(k,627) = lu(k,627) * lu(k,619) + lu(k,628) = lu(k,628) * lu(k,619) + lu(k,629) = lu(k,629) * lu(k,619) + lu(k,630) = lu(k,630) * lu(k,619) + lu(k,631) = lu(k,631) * lu(k,619) + lu(k,1835) = lu(k,1835) - lu(k,620) * lu(k,1834) + lu(k,1837) = lu(k,1837) - lu(k,621) * lu(k,1834) + lu(k,1839) = - lu(k,622) * lu(k,1834) + lu(k,1842) = - lu(k,623) * lu(k,1834) + lu(k,1843) = lu(k,1843) - lu(k,624) * lu(k,1834) + lu(k,1849) = - lu(k,625) * lu(k,1834) + lu(k,1850) = lu(k,1850) - lu(k,626) * lu(k,1834) + lu(k,1853) = lu(k,1853) - lu(k,627) * lu(k,1834) + lu(k,1855) = lu(k,1855) - lu(k,628) * lu(k,1834) + lu(k,1859) = lu(k,1859) - lu(k,629) * lu(k,1834) + lu(k,1860) = lu(k,1860) - lu(k,630) * lu(k,1834) + lu(k,1861) = lu(k,1861) - lu(k,631) * lu(k,1834) + lu(k,3668) = lu(k,3668) - lu(k,620) * lu(k,3667) + lu(k,3698) = lu(k,3698) - lu(k,621) * lu(k,3667) + lu(k,3737) = lu(k,3737) - lu(k,622) * lu(k,3667) + lu(k,3751) = lu(k,3751) - lu(k,623) * lu(k,3667) + lu(k,3758) = lu(k,3758) - lu(k,624) * lu(k,3667) + lu(k,3776) = lu(k,3776) - lu(k,625) * lu(k,3667) + lu(k,3777) = lu(k,3777) - lu(k,626) * lu(k,3667) + lu(k,3782) = lu(k,3782) - lu(k,627) * lu(k,3667) + lu(k,3814) = lu(k,3814) - lu(k,628) * lu(k,3667) + lu(k,3821) = lu(k,3821) - lu(k,629) * lu(k,3667) + lu(k,3822) = lu(k,3822) - lu(k,630) * lu(k,3667) + lu(k,3825) = lu(k,3825) - lu(k,631) * lu(k,3667) end do end subroutine lu_fac13 subroutine lu_fac14( avec_len, lu ) @@ -1911,185 +1853,195 @@ subroutine lu_fac14( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,604) = 1._r8 / lu(k,604) - lu(k,605) = lu(k,605) * lu(k,604) - lu(k,606) = lu(k,606) * lu(k,604) - lu(k,607) = lu(k,607) * lu(k,604) - lu(k,608) = lu(k,608) * lu(k,604) - lu(k,609) = lu(k,609) * lu(k,604) - lu(k,2885) = lu(k,2885) - lu(k,605) * lu(k,2777) - lu(k,2886) = lu(k,2886) - lu(k,606) * lu(k,2777) - lu(k,2889) = lu(k,2889) - lu(k,607) * lu(k,2777) - lu(k,2894) = lu(k,2894) - lu(k,608) * lu(k,2777) - lu(k,2895) = lu(k,2895) - lu(k,609) * lu(k,2777) - lu(k,2986) = lu(k,2986) - lu(k,605) * lu(k,2911) - lu(k,2987) = lu(k,2987) - lu(k,606) * lu(k,2911) - lu(k,2990) = lu(k,2990) - lu(k,607) * lu(k,2911) - lu(k,2995) = lu(k,2995) - lu(k,608) * lu(k,2911) - lu(k,2996) = lu(k,2996) - lu(k,609) * lu(k,2911) - lu(k,3281) = lu(k,3281) - lu(k,605) * lu(k,3165) - lu(k,3282) = lu(k,3282) - lu(k,606) * lu(k,3165) - lu(k,3285) = lu(k,3285) - lu(k,607) * lu(k,3165) - lu(k,3290) = lu(k,3290) - lu(k,608) * lu(k,3165) - lu(k,3291) = lu(k,3291) - lu(k,609) * lu(k,3165) - lu(k,3502) = lu(k,3502) - lu(k,605) * lu(k,3479) - lu(k,3503) = lu(k,3503) - lu(k,606) * lu(k,3479) - lu(k,3506) = lu(k,3506) - lu(k,607) * lu(k,3479) - lu(k,3511) = lu(k,3511) - lu(k,608) * lu(k,3479) - lu(k,3512) = lu(k,3512) - lu(k,609) * lu(k,3479) - lu(k,3742) = lu(k,3742) - lu(k,605) * lu(k,3609) - lu(k,3743) = lu(k,3743) - lu(k,606) * lu(k,3609) - lu(k,3746) = lu(k,3746) - lu(k,607) * lu(k,3609) - lu(k,3751) = lu(k,3751) - lu(k,608) * lu(k,3609) - lu(k,3752) = lu(k,3752) - lu(k,609) * lu(k,3609) - lu(k,613) = 1._r8 / lu(k,613) - lu(k,614) = lu(k,614) * lu(k,613) - lu(k,615) = lu(k,615) * lu(k,613) - lu(k,616) = lu(k,616) * lu(k,613) - lu(k,617) = lu(k,617) * lu(k,613) - lu(k,618) = lu(k,618) * lu(k,613) - lu(k,619) = lu(k,619) * lu(k,613) - lu(k,620) = lu(k,620) * lu(k,613) - lu(k,621) = lu(k,621) * lu(k,613) - lu(k,622) = lu(k,622) * lu(k,613) - lu(k,761) = lu(k,761) - lu(k,614) * lu(k,760) - lu(k,762) = lu(k,762) - lu(k,615) * lu(k,760) - lu(k,763) = lu(k,763) - lu(k,616) * lu(k,760) - lu(k,764) = lu(k,764) - lu(k,617) * lu(k,760) - lu(k,765) = lu(k,765) - lu(k,618) * lu(k,760) - lu(k,766) = lu(k,766) - lu(k,619) * lu(k,760) - lu(k,767) = lu(k,767) - lu(k,620) * lu(k,760) - lu(k,769) = lu(k,769) - lu(k,621) * lu(k,760) - lu(k,771) = - lu(k,622) * lu(k,760) - lu(k,3177) = lu(k,3177) - lu(k,614) * lu(k,3166) - lu(k,3178) = lu(k,3178) - lu(k,615) * lu(k,3166) - lu(k,3180) = lu(k,3180) - lu(k,616) * lu(k,3166) - lu(k,3182) = lu(k,3182) - lu(k,617) * lu(k,3166) - lu(k,3206) = lu(k,3206) - lu(k,618) * lu(k,3166) - lu(k,3232) = lu(k,3232) - lu(k,619) * lu(k,3166) - lu(k,3249) = lu(k,3249) - lu(k,620) * lu(k,3166) - lu(k,3285) = lu(k,3285) - lu(k,621) * lu(k,3166) - lu(k,3291) = lu(k,3291) - lu(k,622) * lu(k,3166) - lu(k,3624) = lu(k,3624) - lu(k,614) * lu(k,3610) - lu(k,3625) = lu(k,3625) - lu(k,615) * lu(k,3610) - lu(k,3627) = - lu(k,616) * lu(k,3610) - lu(k,3631) = - lu(k,617) * lu(k,3610) - lu(k,3664) = lu(k,3664) - lu(k,618) * lu(k,3610) - lu(k,3694) = lu(k,3694) - lu(k,619) * lu(k,3610) - lu(k,3711) = lu(k,3711) - lu(k,620) * lu(k,3610) - lu(k,3746) = lu(k,3746) - lu(k,621) * lu(k,3610) - lu(k,3752) = lu(k,3752) - lu(k,622) * lu(k,3610) - lu(k,623) = 1._r8 / lu(k,623) - lu(k,624) = lu(k,624) * lu(k,623) - lu(k,625) = lu(k,625) * lu(k,623) - lu(k,626) = lu(k,626) * lu(k,623) - lu(k,627) = lu(k,627) * lu(k,623) - lu(k,628) = lu(k,628) * lu(k,623) - lu(k,629) = lu(k,629) * lu(k,623) - lu(k,630) = lu(k,630) * lu(k,623) - lu(k,631) = lu(k,631) * lu(k,623) - lu(k,632) = lu(k,632) * lu(k,623) - lu(k,2010) = - lu(k,624) * lu(k,2008) - lu(k,2015) = - lu(k,625) * lu(k,2008) - lu(k,2027) = lu(k,2027) - lu(k,626) * lu(k,2008) - lu(k,2030) = lu(k,2030) - lu(k,627) * lu(k,2008) - lu(k,2033) = lu(k,2033) - lu(k,628) * lu(k,2008) - lu(k,2042) = lu(k,2042) - lu(k,629) * lu(k,2008) - lu(k,2043) = lu(k,2043) - lu(k,630) * lu(k,2008) - lu(k,2046) = lu(k,2046) - lu(k,631) * lu(k,2008) - lu(k,2047) = lu(k,2047) - lu(k,632) * lu(k,2008) - lu(k,3354) = - lu(k,624) * lu(k,3350) - lu(k,3360) = - lu(k,625) * lu(k,3350) - lu(k,3386) = lu(k,3386) - lu(k,626) * lu(k,3350) - lu(k,3391) = lu(k,3391) - lu(k,627) * lu(k,3350) - lu(k,3395) = lu(k,3395) - lu(k,628) * lu(k,3350) - lu(k,3426) = lu(k,3426) - lu(k,629) * lu(k,3350) - lu(k,3428) = lu(k,3428) - lu(k,630) * lu(k,3350) - lu(k,3431) = lu(k,3431) - lu(k,631) * lu(k,3350) - lu(k,3432) = lu(k,3432) - lu(k,632) * lu(k,3350) - lu(k,3655) = lu(k,3655) - lu(k,624) * lu(k,3611) - lu(k,3675) = lu(k,3675) - lu(k,625) * lu(k,3611) - lu(k,3707) = lu(k,3707) - lu(k,626) * lu(k,3611) - lu(k,3712) = lu(k,3712) - lu(k,627) * lu(k,3611) - lu(k,3716) = lu(k,3716) - lu(k,628) * lu(k,3611) - lu(k,3746) = lu(k,3746) - lu(k,629) * lu(k,3611) - lu(k,3748) = lu(k,3748) - lu(k,630) * lu(k,3611) - lu(k,3751) = lu(k,3751) - lu(k,631) * lu(k,3611) - lu(k,3752) = lu(k,3752) - lu(k,632) * lu(k,3611) - lu(k,634) = 1._r8 / lu(k,634) - lu(k,635) = lu(k,635) * lu(k,634) - lu(k,636) = lu(k,636) * lu(k,634) - lu(k,637) = lu(k,637) * lu(k,634) - lu(k,638) = lu(k,638) * lu(k,634) - lu(k,639) = lu(k,639) * lu(k,634) - lu(k,640) = lu(k,640) * lu(k,634) - lu(k,641) = lu(k,641) * lu(k,634) - lu(k,642) = lu(k,642) * lu(k,634) - lu(k,643) = lu(k,643) * lu(k,634) - lu(k,1131) = lu(k,1131) - lu(k,635) * lu(k,1129) - lu(k,1133) = lu(k,1133) - lu(k,636) * lu(k,1129) - lu(k,1134) = lu(k,1134) - lu(k,637) * lu(k,1129) - lu(k,1135) = lu(k,1135) - lu(k,638) * lu(k,1129) - lu(k,1136) = lu(k,1136) - lu(k,639) * lu(k,1129) - lu(k,1138) = lu(k,1138) - lu(k,640) * lu(k,1129) - lu(k,1139) = lu(k,1139) - lu(k,641) * lu(k,1129) - lu(k,1140) = lu(k,1140) - lu(k,642) * lu(k,1129) - lu(k,1141) = lu(k,1141) - lu(k,643) * lu(k,1129) - lu(k,2779) = lu(k,2779) - lu(k,635) * lu(k,2778) - lu(k,2817) = lu(k,2817) - lu(k,636) * lu(k,2778) - lu(k,2820) = lu(k,2820) - lu(k,637) * lu(k,2778) - lu(k,2864) = lu(k,2864) - lu(k,638) * lu(k,2778) - lu(k,2882) = lu(k,2882) - lu(k,639) * lu(k,2778) - lu(k,2889) = lu(k,2889) - lu(k,640) * lu(k,2778) - lu(k,2891) = lu(k,2891) - lu(k,641) * lu(k,2778) - lu(k,2894) = lu(k,2894) - lu(k,642) * lu(k,2778) - lu(k,2895) = lu(k,2895) - lu(k,643) * lu(k,2778) - lu(k,3614) = lu(k,3614) - lu(k,635) * lu(k,3612) - lu(k,3670) = lu(k,3670) - lu(k,636) * lu(k,3612) - lu(k,3674) = lu(k,3674) - lu(k,637) * lu(k,3612) - lu(k,3721) = lu(k,3721) - lu(k,638) * lu(k,3612) - lu(k,3739) = lu(k,3739) - lu(k,639) * lu(k,3612) - lu(k,3746) = lu(k,3746) - lu(k,640) * lu(k,3612) - lu(k,3748) = lu(k,3748) - lu(k,641) * lu(k,3612) - lu(k,3751) = lu(k,3751) - lu(k,642) * lu(k,3612) - lu(k,3752) = lu(k,3752) - lu(k,643) * lu(k,3612) - lu(k,645) = 1._r8 / lu(k,645) - lu(k,646) = lu(k,646) * lu(k,645) - lu(k,647) = lu(k,647) * lu(k,645) - lu(k,648) = lu(k,648) * lu(k,645) - lu(k,649) = lu(k,649) * lu(k,645) - lu(k,650) = lu(k,650) * lu(k,645) - lu(k,651) = lu(k,651) * lu(k,645) - lu(k,652) = lu(k,652) * lu(k,645) - lu(k,653) = lu(k,653) * lu(k,645) - lu(k,654) = lu(k,654) * lu(k,645) - lu(k,1131) = lu(k,1131) - lu(k,646) * lu(k,1130) - lu(k,1132) = lu(k,1132) - lu(k,647) * lu(k,1130) - lu(k,1133) = lu(k,1133) - lu(k,648) * lu(k,1130) - lu(k,1134) = lu(k,1134) - lu(k,649) * lu(k,1130) - lu(k,1135) = lu(k,1135) - lu(k,650) * lu(k,1130) - lu(k,1136) = lu(k,1136) - lu(k,651) * lu(k,1130) - lu(k,1138) = lu(k,1138) - lu(k,652) * lu(k,1130) - lu(k,1139) = lu(k,1139) - lu(k,653) * lu(k,1130) - lu(k,1141) = lu(k,1141) - lu(k,654) * lu(k,1130) - lu(k,3168) = lu(k,3168) - lu(k,646) * lu(k,3167) - lu(k,3203) = lu(k,3203) - lu(k,647) * lu(k,3167) - lu(k,3210) = lu(k,3210) - lu(k,648) * lu(k,3167) - lu(k,3213) = lu(k,3213) - lu(k,649) * lu(k,3167) - lu(k,3260) = lu(k,3260) - lu(k,650) * lu(k,3167) - lu(k,3278) = lu(k,3278) - lu(k,651) * lu(k,3167) - lu(k,3285) = lu(k,3285) - lu(k,652) * lu(k,3167) - lu(k,3287) = lu(k,3287) - lu(k,653) * lu(k,3167) - lu(k,3291) = lu(k,3291) - lu(k,654) * lu(k,3167) - lu(k,3614) = lu(k,3614) - lu(k,646) * lu(k,3613) - lu(k,3659) = lu(k,3659) - lu(k,647) * lu(k,3613) - lu(k,3670) = lu(k,3670) - lu(k,648) * lu(k,3613) - lu(k,3674) = lu(k,3674) - lu(k,649) * lu(k,3613) - lu(k,3721) = lu(k,3721) - lu(k,650) * lu(k,3613) - lu(k,3739) = lu(k,3739) - lu(k,651) * lu(k,3613) - lu(k,3746) = lu(k,3746) - lu(k,652) * lu(k,3613) - lu(k,3748) = lu(k,3748) - lu(k,653) * lu(k,3613) - lu(k,3752) = lu(k,3752) - lu(k,654) * lu(k,3613) + lu(k,632) = 1._r8 / lu(k,632) + lu(k,633) = lu(k,633) * lu(k,632) + lu(k,634) = lu(k,634) * lu(k,632) + lu(k,635) = lu(k,635) * lu(k,632) + lu(k,636) = lu(k,636) * lu(k,632) + lu(k,637) = lu(k,637) * lu(k,632) + lu(k,638) = lu(k,638) * lu(k,632) + lu(k,680) = lu(k,680) - lu(k,633) * lu(k,677) + lu(k,683) = lu(k,683) - lu(k,634) * lu(k,677) + lu(k,684) = lu(k,684) - lu(k,635) * lu(k,677) + lu(k,687) = - lu(k,636) * lu(k,677) + lu(k,688) = lu(k,688) - lu(k,637) * lu(k,677) + lu(k,689) = lu(k,689) - lu(k,638) * lu(k,677) + lu(k,1807) = - lu(k,633) * lu(k,1803) + lu(k,1818) = - lu(k,634) * lu(k,1803) + lu(k,1819) = lu(k,1819) - lu(k,635) * lu(k,1803) + lu(k,1826) = lu(k,1826) - lu(k,636) * lu(k,1803) + lu(k,1828) = lu(k,1828) - lu(k,637) * lu(k,1803) + lu(k,1829) = lu(k,1829) - lu(k,638) * lu(k,1803) + lu(k,1838) = - lu(k,633) * lu(k,1835) + lu(k,1849) = lu(k,1849) - lu(k,634) * lu(k,1835) + lu(k,1850) = lu(k,1850) - lu(k,635) * lu(k,1835) + lu(k,1857) = lu(k,1857) - lu(k,636) * lu(k,1835) + lu(k,1859) = lu(k,1859) - lu(k,637) * lu(k,1835) + lu(k,1860) = lu(k,1860) - lu(k,638) * lu(k,1835) + lu(k,3703) = lu(k,3703) - lu(k,633) * lu(k,3668) + lu(k,3776) = lu(k,3776) - lu(k,634) * lu(k,3668) + lu(k,3777) = lu(k,3777) - lu(k,635) * lu(k,3668) + lu(k,3819) = lu(k,3819) - lu(k,636) * lu(k,3668) + lu(k,3821) = lu(k,3821) - lu(k,637) * lu(k,3668) + lu(k,3822) = lu(k,3822) - lu(k,638) * lu(k,3668) + lu(k,639) = 1._r8 / lu(k,639) + lu(k,640) = lu(k,640) * lu(k,639) + lu(k,641) = lu(k,641) * lu(k,639) + lu(k,642) = lu(k,642) * lu(k,639) + lu(k,643) = lu(k,643) * lu(k,639) + lu(k,644) = lu(k,644) * lu(k,639) + lu(k,645) = lu(k,645) * lu(k,639) + lu(k,646) = lu(k,646) * lu(k,639) + lu(k,647) = lu(k,647) * lu(k,639) + lu(k,2634) = lu(k,2634) - lu(k,640) * lu(k,2630) + lu(k,2639) = lu(k,2639) - lu(k,641) * lu(k,2630) + lu(k,2641) = lu(k,2641) - lu(k,642) * lu(k,2630) + lu(k,2646) = lu(k,2646) - lu(k,643) * lu(k,2630) + lu(k,2647) = lu(k,2647) - lu(k,644) * lu(k,2630) + lu(k,2648) = lu(k,2648) - lu(k,645) * lu(k,2630) + lu(k,2650) = lu(k,2650) - lu(k,646) * lu(k,2630) + lu(k,2652) = lu(k,2652) - lu(k,647) * lu(k,2630) + lu(k,3787) = lu(k,3787) - lu(k,640) * lu(k,3669) + lu(k,3804) = lu(k,3804) - lu(k,641) * lu(k,3669) + lu(k,3816) = lu(k,3816) - lu(k,642) * lu(k,3669) + lu(k,3821) = lu(k,3821) - lu(k,643) * lu(k,3669) + lu(k,3822) = lu(k,3822) - lu(k,644) * lu(k,3669) + lu(k,3823) = lu(k,3823) - lu(k,645) * lu(k,3669) + lu(k,3825) = lu(k,3825) - lu(k,646) * lu(k,3669) + lu(k,3827) = lu(k,3827) - lu(k,647) * lu(k,3669) + lu(k,3849) = lu(k,3849) - lu(k,640) * lu(k,3835) + lu(k,3854) = lu(k,3854) - lu(k,641) * lu(k,3835) + lu(k,3857) = lu(k,3857) - lu(k,642) * lu(k,3835) + lu(k,3862) = lu(k,3862) - lu(k,643) * lu(k,3835) + lu(k,3863) = lu(k,3863) - lu(k,644) * lu(k,3835) + lu(k,3864) = lu(k,3864) - lu(k,645) * lu(k,3835) + lu(k,3866) = lu(k,3866) - lu(k,646) * lu(k,3835) + lu(k,3868) = lu(k,3868) - lu(k,647) * lu(k,3835) + lu(k,648) = 1._r8 / lu(k,648) + lu(k,649) = lu(k,649) * lu(k,648) + lu(k,650) = lu(k,650) * lu(k,648) + lu(k,651) = lu(k,651) * lu(k,648) + lu(k,652) = lu(k,652) * lu(k,648) + lu(k,653) = lu(k,653) * lu(k,648) + lu(k,654) = lu(k,654) * lu(k,648) + lu(k,655) = lu(k,655) * lu(k,648) + lu(k,656) = lu(k,656) * lu(k,648) + lu(k,2922) = lu(k,2922) - lu(k,649) * lu(k,2918) + lu(k,2926) = lu(k,2926) - lu(k,650) * lu(k,2918) + lu(k,2929) = lu(k,2929) - lu(k,651) * lu(k,2918) + lu(k,2948) = lu(k,2948) - lu(k,652) * lu(k,2918) + lu(k,2954) = lu(k,2954) - lu(k,653) * lu(k,2918) + lu(k,2956) = lu(k,2956) - lu(k,654) * lu(k,2918) + lu(k,2957) = lu(k,2957) - lu(k,655) * lu(k,2918) + lu(k,2961) = lu(k,2961) - lu(k,656) * lu(k,2918) + lu(k,3758) = lu(k,3758) - lu(k,649) * lu(k,3670) + lu(k,3777) = lu(k,3777) - lu(k,650) * lu(k,3670) + lu(k,3790) = lu(k,3790) - lu(k,651) * lu(k,3670) + lu(k,3813) = lu(k,3813) - lu(k,652) * lu(k,3670) + lu(k,3819) = lu(k,3819) - lu(k,653) * lu(k,3670) + lu(k,3821) = lu(k,3821) - lu(k,654) * lu(k,3670) + lu(k,3822) = lu(k,3822) - lu(k,655) * lu(k,3670) + lu(k,3826) = lu(k,3826) - lu(k,656) * lu(k,3670) + lu(k,4078) = lu(k,4078) - lu(k,649) * lu(k,4066) + lu(k,4082) = lu(k,4082) - lu(k,650) * lu(k,4066) + lu(k,4084) = - lu(k,651) * lu(k,4066) + lu(k,4092) = lu(k,4092) - lu(k,652) * lu(k,4066) + lu(k,4098) = lu(k,4098) - lu(k,653) * lu(k,4066) + lu(k,4100) = lu(k,4100) - lu(k,654) * lu(k,4066) + lu(k,4101) = lu(k,4101) - lu(k,655) * lu(k,4066) + lu(k,4105) = lu(k,4105) - lu(k,656) * lu(k,4066) + lu(k,657) = 1._r8 / lu(k,657) + lu(k,658) = lu(k,658) * lu(k,657) + lu(k,659) = lu(k,659) * lu(k,657) + lu(k,660) = lu(k,660) * lu(k,657) + lu(k,661) = lu(k,661) * lu(k,657) + lu(k,662) = lu(k,662) * lu(k,657) + lu(k,663) = lu(k,663) * lu(k,657) + lu(k,664) = lu(k,664) * lu(k,657) + lu(k,665) = lu(k,665) * lu(k,657) + lu(k,2829) = lu(k,2829) - lu(k,658) * lu(k,2825) + lu(k,2833) = lu(k,2833) - lu(k,659) * lu(k,2825) + lu(k,2853) = lu(k,2853) - lu(k,660) * lu(k,2825) + lu(k,2856) = lu(k,2856) - lu(k,661) * lu(k,2825) + lu(k,2861) = lu(k,2861) - lu(k,662) * lu(k,2825) + lu(k,2863) = lu(k,2863) - lu(k,663) * lu(k,2825) + lu(k,2864) = lu(k,2864) - lu(k,664) * lu(k,2825) + lu(k,2868) = lu(k,2868) - lu(k,665) * lu(k,2825) + lu(k,3758) = lu(k,3758) - lu(k,658) * lu(k,3671) + lu(k,3777) = lu(k,3777) - lu(k,659) * lu(k,3671) + lu(k,3811) = lu(k,3811) - lu(k,660) * lu(k,3671) + lu(k,3814) = lu(k,3814) - lu(k,661) * lu(k,3671) + lu(k,3819) = lu(k,3819) - lu(k,662) * lu(k,3671) + lu(k,3821) = lu(k,3821) - lu(k,663) * lu(k,3671) + lu(k,3822) = lu(k,3822) - lu(k,664) * lu(k,3671) + lu(k,3826) = lu(k,3826) - lu(k,665) * lu(k,3671) + lu(k,4078) = lu(k,4078) - lu(k,658) * lu(k,4067) + lu(k,4082) = lu(k,4082) - lu(k,659) * lu(k,4067) + lu(k,4090) = lu(k,4090) - lu(k,660) * lu(k,4067) + lu(k,4093) = lu(k,4093) - lu(k,661) * lu(k,4067) + lu(k,4098) = lu(k,4098) - lu(k,662) * lu(k,4067) + lu(k,4100) = lu(k,4100) - lu(k,663) * lu(k,4067) + lu(k,4101) = lu(k,4101) - lu(k,664) * lu(k,4067) + lu(k,4105) = lu(k,4105) - lu(k,665) * lu(k,4067) + lu(k,666) = 1._r8 / lu(k,666) + lu(k,667) = lu(k,667) * lu(k,666) + lu(k,668) = lu(k,668) * lu(k,666) + lu(k,669) = lu(k,669) * lu(k,666) + lu(k,670) = lu(k,670) * lu(k,666) + lu(k,671) = lu(k,671) * lu(k,666) + lu(k,672) = lu(k,672) * lu(k,666) + lu(k,2489) = - lu(k,667) * lu(k,2485) + lu(k,2495) = lu(k,2495) - lu(k,668) * lu(k,2485) + lu(k,2501) = lu(k,2501) - lu(k,669) * lu(k,2485) + lu(k,2513) = lu(k,2513) - lu(k,670) * lu(k,2485) + lu(k,2514) = lu(k,2514) - lu(k,671) * lu(k,2485) + lu(k,2517) = lu(k,2517) - lu(k,672) * lu(k,2485) + lu(k,2685) = - lu(k,667) * lu(k,2681) + lu(k,2691) = lu(k,2691) - lu(k,668) * lu(k,2681) + lu(k,2699) = - lu(k,669) * lu(k,2681) + lu(k,2714) = lu(k,2714) - lu(k,670) * lu(k,2681) + lu(k,2715) = lu(k,2715) - lu(k,671) * lu(k,2681) + lu(k,2719) = lu(k,2719) - lu(k,672) * lu(k,2681) + lu(k,3484) = lu(k,3484) - lu(k,667) * lu(k,3440) + lu(k,3512) = lu(k,3512) - lu(k,668) * lu(k,3440) + lu(k,3555) = lu(k,3555) - lu(k,669) * lu(k,3440) + lu(k,3571) = lu(k,3571) - lu(k,670) * lu(k,3440) + lu(k,3572) = lu(k,3572) - lu(k,671) * lu(k,3440) + lu(k,3576) = lu(k,3576) - lu(k,672) * lu(k,3440) + lu(k,3725) = lu(k,3725) - lu(k,667) * lu(k,3672) + lu(k,3763) = lu(k,3763) - lu(k,668) * lu(k,3672) + lu(k,3805) = lu(k,3805) - lu(k,669) * lu(k,3672) + lu(k,3821) = lu(k,3821) - lu(k,670) * lu(k,3672) + lu(k,3822) = lu(k,3822) - lu(k,671) * lu(k,3672) + lu(k,3826) = lu(k,3826) - lu(k,672) * lu(k,3672) + lu(k,673) = 1._r8 / lu(k,673) + lu(k,674) = lu(k,674) * lu(k,673) + lu(k,675) = lu(k,675) * lu(k,673) + lu(k,676) = lu(k,676) * lu(k,673) + lu(k,947) = - lu(k,674) * lu(k,943) + lu(k,950) = lu(k,950) - lu(k,675) * lu(k,943) + lu(k,951) = lu(k,951) - lu(k,676) * lu(k,943) + lu(k,1006) = - lu(k,674) * lu(k,1002) + lu(k,1009) = lu(k,1009) - lu(k,675) * lu(k,1002) + lu(k,1010) = lu(k,1010) - lu(k,676) * lu(k,1002) + lu(k,2410) = - lu(k,674) * lu(k,2400) + lu(k,2425) = lu(k,2425) - lu(k,675) * lu(k,2400) + lu(k,2426) = lu(k,2426) - lu(k,676) * lu(k,2400) + lu(k,2464) = lu(k,2464) - lu(k,674) * lu(k,2452) + lu(k,2479) = lu(k,2479) - lu(k,675) * lu(k,2452) + lu(k,2480) = lu(k,2480) - lu(k,676) * lu(k,2452) + lu(k,2727) = - lu(k,674) * lu(k,2721) + lu(k,2739) = lu(k,2739) - lu(k,675) * lu(k,2721) + lu(k,2740) = - lu(k,676) * lu(k,2721) + lu(k,2772) = - lu(k,674) * lu(k,2766) + lu(k,2784) = lu(k,2784) - lu(k,675) * lu(k,2766) + lu(k,2785) = lu(k,2785) - lu(k,676) * lu(k,2766) + lu(k,3544) = lu(k,3544) - lu(k,674) * lu(k,3441) + lu(k,3571) = lu(k,3571) - lu(k,675) * lu(k,3441) + lu(k,3572) = lu(k,3572) - lu(k,676) * lu(k,3441) + lu(k,3794) = lu(k,3794) - lu(k,674) * lu(k,3673) + lu(k,3821) = lu(k,3821) - lu(k,675) * lu(k,3673) + lu(k,3822) = lu(k,3822) - lu(k,676) * lu(k,3673) end do end subroutine lu_fac14 subroutine lu_fac15( avec_len, lu ) @@ -2106,181 +2058,175 @@ subroutine lu_fac15( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,656) = 1._r8 / lu(k,656) - lu(k,657) = lu(k,657) * lu(k,656) - lu(k,658) = lu(k,658) * lu(k,656) - lu(k,659) = lu(k,659) * lu(k,656) - lu(k,660) = lu(k,660) * lu(k,656) - lu(k,661) = lu(k,661) * lu(k,656) - lu(k,662) = lu(k,662) * lu(k,656) - lu(k,1134) = lu(k,1134) - lu(k,657) * lu(k,1131) - lu(k,1136) = lu(k,1136) - lu(k,658) * lu(k,1131) - lu(k,1137) = lu(k,1137) - lu(k,659) * lu(k,1131) - lu(k,1138) = lu(k,1138) - lu(k,660) * lu(k,1131) - lu(k,1140) = lu(k,1140) - lu(k,661) * lu(k,1131) - lu(k,1141) = lu(k,1141) - lu(k,662) * lu(k,1131) - lu(k,2820) = lu(k,2820) - lu(k,657) * lu(k,2779) - lu(k,2882) = lu(k,2882) - lu(k,658) * lu(k,2779) - lu(k,2885) = lu(k,2885) - lu(k,659) * lu(k,2779) - lu(k,2889) = lu(k,2889) - lu(k,660) * lu(k,2779) - lu(k,2894) = lu(k,2894) - lu(k,661) * lu(k,2779) - lu(k,2895) = lu(k,2895) - lu(k,662) * lu(k,2779) - lu(k,3213) = lu(k,3213) - lu(k,657) * lu(k,3168) - lu(k,3278) = lu(k,3278) - lu(k,658) * lu(k,3168) - lu(k,3281) = lu(k,3281) - lu(k,659) * lu(k,3168) - lu(k,3285) = lu(k,3285) - lu(k,660) * lu(k,3168) - lu(k,3290) = lu(k,3290) - lu(k,661) * lu(k,3168) - lu(k,3291) = lu(k,3291) - lu(k,662) * lu(k,3168) - lu(k,3674) = lu(k,3674) - lu(k,657) * lu(k,3614) - lu(k,3739) = lu(k,3739) - lu(k,658) * lu(k,3614) - lu(k,3742) = lu(k,3742) - lu(k,659) * lu(k,3614) - lu(k,3746) = lu(k,3746) - lu(k,660) * lu(k,3614) - lu(k,3751) = lu(k,3751) - lu(k,661) * lu(k,3614) - lu(k,3752) = lu(k,3752) - lu(k,662) * lu(k,3614) - lu(k,663) = 1._r8 / lu(k,663) - lu(k,664) = lu(k,664) * lu(k,663) - lu(k,665) = lu(k,665) * lu(k,663) - lu(k,666) = lu(k,666) * lu(k,663) - lu(k,667) = lu(k,667) * lu(k,663) - lu(k,668) = lu(k,668) * lu(k,663) - lu(k,669) = lu(k,669) * lu(k,663) - lu(k,670) = lu(k,670) * lu(k,663) - lu(k,1403) = lu(k,1403) - lu(k,664) * lu(k,1402) - lu(k,1405) = lu(k,1405) - lu(k,665) * lu(k,1402) - lu(k,1406) = lu(k,1406) - lu(k,666) * lu(k,1402) - lu(k,1407) = lu(k,1407) - lu(k,667) * lu(k,1402) - lu(k,1409) = lu(k,1409) - lu(k,668) * lu(k,1402) - lu(k,1411) = lu(k,1411) - lu(k,669) * lu(k,1402) - lu(k,1413) = lu(k,1413) - lu(k,670) * lu(k,1402) - lu(k,1880) = - lu(k,664) * lu(k,1878) - lu(k,1885) = lu(k,1885) - lu(k,665) * lu(k,1878) - lu(k,1886) = lu(k,1886) - lu(k,666) * lu(k,1878) - lu(k,1887) = lu(k,1887) - lu(k,667) * lu(k,1878) - lu(k,1894) = - lu(k,668) * lu(k,1878) - lu(k,1906) = lu(k,1906) - lu(k,669) * lu(k,1878) - lu(k,1910) = lu(k,1910) - lu(k,670) * lu(k,1878) - lu(k,3206) = lu(k,3206) - lu(k,664) * lu(k,3169) - lu(k,3228) = lu(k,3228) - lu(k,665) * lu(k,3169) - lu(k,3232) = lu(k,3232) - lu(k,666) * lu(k,3169) - lu(k,3237) = lu(k,3237) - lu(k,667) * lu(k,3169) - lu(k,3249) = lu(k,3249) - lu(k,668) * lu(k,3169) - lu(k,3285) = lu(k,3285) - lu(k,669) * lu(k,3169) - lu(k,3291) = lu(k,3291) - lu(k,670) * lu(k,3169) - lu(k,3664) = lu(k,3664) - lu(k,664) * lu(k,3615) - lu(k,3689) = lu(k,3689) - lu(k,665) * lu(k,3615) - lu(k,3694) = lu(k,3694) - lu(k,666) * lu(k,3615) - lu(k,3699) = lu(k,3699) - lu(k,667) * lu(k,3615) - lu(k,3711) = lu(k,3711) - lu(k,668) * lu(k,3615) - lu(k,3746) = lu(k,3746) - lu(k,669) * lu(k,3615) - lu(k,3752) = lu(k,3752) - lu(k,670) * lu(k,3615) - lu(k,671) = 1._r8 / lu(k,671) - lu(k,672) = lu(k,672) * lu(k,671) - lu(k,673) = lu(k,673) * lu(k,671) - lu(k,674) = lu(k,674) * lu(k,671) - lu(k,675) = lu(k,675) * lu(k,671) - lu(k,676) = lu(k,676) * lu(k,671) - lu(k,677) = lu(k,677) * lu(k,671) - lu(k,678) = lu(k,678) * lu(k,671) - lu(k,2293) = - lu(k,672) * lu(k,2292) - lu(k,2301) = lu(k,2301) - lu(k,673) * lu(k,2292) - lu(k,2305) = lu(k,2305) - lu(k,674) * lu(k,2292) - lu(k,2313) = - lu(k,675) * lu(k,2292) - lu(k,2317) = lu(k,2317) - lu(k,676) * lu(k,2292) - lu(k,2320) = lu(k,2320) - lu(k,677) * lu(k,2292) - lu(k,2321) = lu(k,2321) - lu(k,678) * lu(k,2292) - lu(k,2352) = - lu(k,672) * lu(k,2351) - lu(k,2360) = lu(k,2360) - lu(k,673) * lu(k,2351) - lu(k,2366) = lu(k,2366) - lu(k,674) * lu(k,2351) - lu(k,2374) = - lu(k,675) * lu(k,2351) - lu(k,2378) = lu(k,2378) - lu(k,676) * lu(k,2351) - lu(k,2381) = lu(k,2381) - lu(k,677) * lu(k,2351) - lu(k,2382) = lu(k,2382) - lu(k,678) * lu(k,2351) - lu(k,3190) = lu(k,3190) - lu(k,672) * lu(k,3170) - lu(k,3236) = lu(k,3236) - lu(k,673) * lu(k,3170) - lu(k,3271) = lu(k,3271) - lu(k,674) * lu(k,3170) - lu(k,3279) = - lu(k,675) * lu(k,3170) - lu(k,3285) = lu(k,3285) - lu(k,676) * lu(k,3170) - lu(k,3290) = lu(k,3290) - lu(k,677) * lu(k,3170) - lu(k,3291) = lu(k,3291) - lu(k,678) * lu(k,3170) - lu(k,3641) = lu(k,3641) - lu(k,672) * lu(k,3616) - lu(k,3698) = lu(k,3698) - lu(k,673) * lu(k,3616) - lu(k,3732) = lu(k,3732) - lu(k,674) * lu(k,3616) - lu(k,3740) = lu(k,3740) - lu(k,675) * lu(k,3616) - lu(k,3746) = lu(k,3746) - lu(k,676) * lu(k,3616) - lu(k,3751) = lu(k,3751) - lu(k,677) * lu(k,3616) - lu(k,3752) = lu(k,3752) - lu(k,678) * lu(k,3616) - lu(k,680) = 1._r8 / lu(k,680) - lu(k,681) = lu(k,681) * lu(k,680) - lu(k,682) = lu(k,682) * lu(k,680) - lu(k,683) = lu(k,683) * lu(k,680) - lu(k,684) = lu(k,684) * lu(k,680) - lu(k,685) = lu(k,685) * lu(k,680) - lu(k,686) = lu(k,686) * lu(k,680) - lu(k,687) = lu(k,687) * lu(k,680) - lu(k,2413) = - lu(k,681) * lu(k,2412) - lu(k,2418) = lu(k,2418) - lu(k,682) * lu(k,2412) - lu(k,2428) = - lu(k,683) * lu(k,2412) - lu(k,2431) = - lu(k,684) * lu(k,2412) - lu(k,2432) = lu(k,2432) - lu(k,685) * lu(k,2412) - lu(k,2434) = lu(k,2434) - lu(k,686) * lu(k,2412) - lu(k,2435) = lu(k,2435) - lu(k,687) * lu(k,2412) - lu(k,2795) = lu(k,2795) - lu(k,681) * lu(k,2780) - lu(k,2844) = lu(k,2844) - lu(k,682) * lu(k,2780) - lu(k,2885) = lu(k,2885) - lu(k,683) * lu(k,2780) - lu(k,2889) = lu(k,2889) - lu(k,684) * lu(k,2780) - lu(k,2891) = lu(k,2891) - lu(k,685) * lu(k,2780) - lu(k,2894) = lu(k,2894) - lu(k,686) * lu(k,2780) - lu(k,2895) = lu(k,2895) - lu(k,687) * lu(k,2780) - lu(k,3186) = lu(k,3186) - lu(k,681) * lu(k,3171) - lu(k,3240) = lu(k,3240) - lu(k,682) * lu(k,3171) - lu(k,3281) = lu(k,3281) - lu(k,683) * lu(k,3171) - lu(k,3285) = lu(k,3285) - lu(k,684) * lu(k,3171) - lu(k,3287) = lu(k,3287) - lu(k,685) * lu(k,3171) - lu(k,3290) = lu(k,3290) - lu(k,686) * lu(k,3171) - lu(k,3291) = lu(k,3291) - lu(k,687) * lu(k,3171) - lu(k,3636) = lu(k,3636) - lu(k,681) * lu(k,3617) - lu(k,3702) = lu(k,3702) - lu(k,682) * lu(k,3617) - lu(k,3742) = lu(k,3742) - lu(k,683) * lu(k,3617) - lu(k,3746) = lu(k,3746) - lu(k,684) * lu(k,3617) - lu(k,3748) = lu(k,3748) - lu(k,685) * lu(k,3617) - lu(k,3751) = lu(k,3751) - lu(k,686) * lu(k,3617) - lu(k,3752) = lu(k,3752) - lu(k,687) * lu(k,3617) - lu(k,688) = 1._r8 / lu(k,688) - lu(k,689) = lu(k,689) * lu(k,688) - lu(k,690) = lu(k,690) * lu(k,688) - lu(k,691) = lu(k,691) * lu(k,688) - lu(k,692) = lu(k,692) * lu(k,688) - lu(k,693) = lu(k,693) * lu(k,688) - lu(k,694) = lu(k,694) * lu(k,688) - lu(k,695) = lu(k,695) * lu(k,688) - lu(k,1587) = - lu(k,689) * lu(k,1586) - lu(k,1588) = - lu(k,690) * lu(k,1586) - lu(k,1589) = - lu(k,691) * lu(k,1586) - lu(k,1594) = - lu(k,692) * lu(k,1586) - lu(k,1595) = lu(k,1595) - lu(k,693) * lu(k,1586) - lu(k,1596) = lu(k,1596) - lu(k,694) * lu(k,1586) - lu(k,1597) = lu(k,1597) - lu(k,695) * lu(k,1586) - lu(k,2795) = lu(k,2795) - lu(k,689) * lu(k,2781) - lu(k,2812) = lu(k,2812) - lu(k,690) * lu(k,2781) - lu(k,2831) = lu(k,2831) - lu(k,691) * lu(k,2781) - lu(k,2885) = lu(k,2885) - lu(k,692) * lu(k,2781) - lu(k,2889) = lu(k,2889) - lu(k,693) * lu(k,2781) - lu(k,2894) = lu(k,2894) - lu(k,694) * lu(k,2781) - lu(k,2895) = lu(k,2895) - lu(k,695) * lu(k,2781) - lu(k,3186) = lu(k,3186) - lu(k,689) * lu(k,3172) - lu(k,3205) = - lu(k,690) * lu(k,3172) - lu(k,3227) = lu(k,3227) - lu(k,691) * lu(k,3172) - lu(k,3281) = lu(k,3281) - lu(k,692) * lu(k,3172) - lu(k,3285) = lu(k,3285) - lu(k,693) * lu(k,3172) - lu(k,3290) = lu(k,3290) - lu(k,694) * lu(k,3172) - lu(k,3291) = lu(k,3291) - lu(k,695) * lu(k,3172) - lu(k,3636) = lu(k,3636) - lu(k,689) * lu(k,3618) - lu(k,3661) = lu(k,3661) - lu(k,690) * lu(k,3618) - lu(k,3688) = lu(k,3688) - lu(k,691) * lu(k,3618) - lu(k,3742) = lu(k,3742) - lu(k,692) * lu(k,3618) - lu(k,3746) = lu(k,3746) - lu(k,693) * lu(k,3618) - lu(k,3751) = lu(k,3751) - lu(k,694) * lu(k,3618) - lu(k,3752) = lu(k,3752) - lu(k,695) * lu(k,3618) + lu(k,678) = 1._r8 / lu(k,678) + lu(k,679) = lu(k,679) * lu(k,678) + lu(k,680) = lu(k,680) * lu(k,678) + lu(k,681) = lu(k,681) * lu(k,678) + lu(k,682) = lu(k,682) * lu(k,678) + lu(k,683) = lu(k,683) * lu(k,678) + lu(k,684) = lu(k,684) * lu(k,678) + lu(k,685) = lu(k,685) * lu(k,678) + lu(k,686) = lu(k,686) * lu(k,678) + lu(k,687) = lu(k,687) * lu(k,678) + lu(k,688) = lu(k,688) * lu(k,678) + lu(k,689) = lu(k,689) * lu(k,678) + lu(k,690) = lu(k,690) * lu(k,678) + lu(k,1806) = lu(k,1806) - lu(k,679) * lu(k,1804) + lu(k,1807) = lu(k,1807) - lu(k,680) * lu(k,1804) + lu(k,1810) = - lu(k,681) * lu(k,1804) + lu(k,1811) = lu(k,1811) - lu(k,682) * lu(k,1804) + lu(k,1818) = lu(k,1818) - lu(k,683) * lu(k,1804) + lu(k,1819) = lu(k,1819) - lu(k,684) * lu(k,1804) + lu(k,1821) = lu(k,1821) - lu(k,685) * lu(k,1804) + lu(k,1824) = lu(k,1824) - lu(k,686) * lu(k,1804) + lu(k,1826) = lu(k,1826) - lu(k,687) * lu(k,1804) + lu(k,1828) = lu(k,1828) - lu(k,688) * lu(k,1804) + lu(k,1829) = lu(k,1829) - lu(k,689) * lu(k,1804) + lu(k,1830) = lu(k,1830) - lu(k,690) * lu(k,1804) + lu(k,3698) = lu(k,3698) - lu(k,679) * lu(k,3674) + lu(k,3703) = lu(k,3703) - lu(k,680) * lu(k,3674) + lu(k,3754) = lu(k,3754) - lu(k,681) * lu(k,3674) + lu(k,3758) = lu(k,3758) - lu(k,682) * lu(k,3674) + lu(k,3776) = lu(k,3776) - lu(k,683) * lu(k,3674) + lu(k,3777) = lu(k,3777) - lu(k,684) * lu(k,3674) + lu(k,3781) = lu(k,3781) - lu(k,685) * lu(k,3674) + lu(k,3814) = lu(k,3814) - lu(k,686) * lu(k,3674) + lu(k,3819) = lu(k,3819) - lu(k,687) * lu(k,3674) + lu(k,3821) = lu(k,3821) - lu(k,688) * lu(k,3674) + lu(k,3822) = lu(k,3822) - lu(k,689) * lu(k,3674) + lu(k,3825) = lu(k,3825) - lu(k,690) * lu(k,3674) + lu(k,691) = 1._r8 / lu(k,691) + lu(k,692) = lu(k,692) * lu(k,691) + lu(k,693) = lu(k,693) * lu(k,691) + lu(k,694) = lu(k,694) * lu(k,691) + lu(k,695) = lu(k,695) * lu(k,691) + lu(k,696) = lu(k,696) * lu(k,691) + lu(k,697) = lu(k,697) * lu(k,691) + lu(k,698) = lu(k,698) * lu(k,691) + lu(k,699) = lu(k,699) * lu(k,691) + lu(k,3229) = - lu(k,692) * lu(k,3197) + lu(k,3236) = lu(k,3236) - lu(k,693) * lu(k,3197) + lu(k,3311) = lu(k,3311) - lu(k,694) * lu(k,3197) + lu(k,3313) = lu(k,3313) - lu(k,695) * lu(k,3197) + lu(k,3315) = lu(k,3315) - lu(k,696) * lu(k,3197) + lu(k,3316) = lu(k,3316) - lu(k,697) * lu(k,3197) + lu(k,3320) = lu(k,3320) - lu(k,698) * lu(k,3197) + lu(k,3321) = - lu(k,699) * lu(k,3197) + lu(k,3343) = - lu(k,692) * lu(k,3341) + lu(k,3344) = - lu(k,693) * lu(k,3341) + lu(k,3356) = - lu(k,694) * lu(k,3341) + lu(k,3358) = lu(k,3358) - lu(k,695) * lu(k,3341) + lu(k,3360) = lu(k,3360) - lu(k,696) * lu(k,3341) + lu(k,3361) = lu(k,3361) - lu(k,697) * lu(k,3341) + lu(k,3365) = - lu(k,698) * lu(k,3341) + lu(k,3366) = lu(k,3366) - lu(k,699) * lu(k,3341) + lu(k,3483) = lu(k,3483) - lu(k,692) * lu(k,3442) + lu(k,3490) = lu(k,3490) - lu(k,693) * lu(k,3442) + lu(k,3567) = lu(k,3567) - lu(k,694) * lu(k,3442) + lu(k,3569) = lu(k,3569) - lu(k,695) * lu(k,3442) + lu(k,3571) = lu(k,3571) - lu(k,696) * lu(k,3442) + lu(k,3572) = lu(k,3572) - lu(k,697) * lu(k,3442) + lu(k,3576) = lu(k,3576) - lu(k,698) * lu(k,3442) + lu(k,3577) = lu(k,3577) - lu(k,699) * lu(k,3442) + lu(k,700) = 1._r8 / lu(k,700) + lu(k,701) = lu(k,701) * lu(k,700) + lu(k,702) = lu(k,702) * lu(k,700) + lu(k,703) = lu(k,703) * lu(k,700) + lu(k,704) = lu(k,704) * lu(k,700) + lu(k,705) = lu(k,705) * lu(k,700) + lu(k,706) = lu(k,706) * lu(k,700) + lu(k,1617) = lu(k,1617) - lu(k,701) * lu(k,1615) + lu(k,1621) = lu(k,1621) - lu(k,702) * lu(k,1615) + lu(k,1624) = lu(k,1624) - lu(k,703) * lu(k,1615) + lu(k,1627) = lu(k,1627) - lu(k,704) * lu(k,1615) + lu(k,1629) = lu(k,1629) - lu(k,705) * lu(k,1615) + lu(k,1631) = - lu(k,706) * lu(k,1615) + lu(k,2973) = lu(k,2973) - lu(k,701) * lu(k,2964) + lu(k,3023) = lu(k,3023) - lu(k,702) * lu(k,2964) + lu(k,3028) = lu(k,3028) - lu(k,703) * lu(k,2964) + lu(k,3031) = lu(k,3031) - lu(k,704) * lu(k,2964) + lu(k,3034) = lu(k,3034) - lu(k,705) * lu(k,2964) + lu(k,3036) = - lu(k,706) * lu(k,2964) + lu(k,3507) = lu(k,3507) - lu(k,701) * lu(k,3443) + lu(k,3564) = lu(k,3564) - lu(k,702) * lu(k,3443) + lu(k,3569) = lu(k,3569) - lu(k,703) * lu(k,3443) + lu(k,3572) = lu(k,3572) - lu(k,704) * lu(k,3443) + lu(k,3575) = lu(k,3575) - lu(k,705) * lu(k,3443) + lu(k,3577) = lu(k,3577) - lu(k,706) * lu(k,3443) + lu(k,3758) = lu(k,3758) - lu(k,701) * lu(k,3675) + lu(k,3814) = lu(k,3814) - lu(k,702) * lu(k,3675) + lu(k,3819) = lu(k,3819) - lu(k,703) * lu(k,3675) + lu(k,3822) = lu(k,3822) - lu(k,704) * lu(k,3675) + lu(k,3825) = lu(k,3825) - lu(k,705) * lu(k,3675) + lu(k,3827) = lu(k,3827) - lu(k,706) * lu(k,3675) + lu(k,709) = 1._r8 / lu(k,709) + lu(k,710) = lu(k,710) * lu(k,709) + lu(k,711) = lu(k,711) * lu(k,709) + lu(k,712) = lu(k,712) * lu(k,709) + lu(k,713) = lu(k,713) * lu(k,709) + lu(k,714) = lu(k,714) * lu(k,709) + lu(k,3127) = lu(k,3127) - lu(k,710) * lu(k,3046) + lu(k,3129) = lu(k,3129) - lu(k,711) * lu(k,3046) + lu(k,3133) = lu(k,3133) - lu(k,712) * lu(k,3046) + lu(k,3134) = lu(k,3134) - lu(k,713) * lu(k,3046) + lu(k,3138) = lu(k,3138) - lu(k,714) * lu(k,3046) + lu(k,3309) = lu(k,3309) - lu(k,710) * lu(k,3198) + lu(k,3311) = lu(k,3311) - lu(k,711) * lu(k,3198) + lu(k,3315) = lu(k,3315) - lu(k,712) * lu(k,3198) + lu(k,3316) = lu(k,3316) - lu(k,713) * lu(k,3198) + lu(k,3320) = lu(k,3320) - lu(k,714) * lu(k,3198) + lu(k,3565) = lu(k,3565) - lu(k,710) * lu(k,3444) + lu(k,3567) = lu(k,3567) - lu(k,711) * lu(k,3444) + lu(k,3571) = lu(k,3571) - lu(k,712) * lu(k,3444) + lu(k,3572) = lu(k,3572) - lu(k,713) * lu(k,3444) + lu(k,3576) = lu(k,3576) - lu(k,714) * lu(k,3444) + lu(k,3815) = lu(k,3815) - lu(k,710) * lu(k,3676) + lu(k,3817) = lu(k,3817) - lu(k,711) * lu(k,3676) + lu(k,3821) = lu(k,3821) - lu(k,712) * lu(k,3676) + lu(k,3822) = lu(k,3822) - lu(k,713) * lu(k,3676) + lu(k,3826) = lu(k,3826) - lu(k,714) * lu(k,3676) + lu(k,4094) = lu(k,4094) - lu(k,710) * lu(k,4068) + lu(k,4096) = lu(k,4096) - lu(k,711) * lu(k,4068) + lu(k,4100) = lu(k,4100) - lu(k,712) * lu(k,4068) + lu(k,4101) = lu(k,4101) - lu(k,713) * lu(k,4068) + lu(k,4105) = lu(k,4105) - lu(k,714) * lu(k,4068) + lu(k,716) = 1._r8 / lu(k,716) + lu(k,717) = lu(k,717) * lu(k,716) + lu(k,718) = lu(k,718) * lu(k,716) + lu(k,719) = lu(k,719) * lu(k,716) + lu(k,720) = lu(k,720) * lu(k,716) + lu(k,721) = lu(k,721) * lu(k,716) + lu(k,722) = lu(k,722) * lu(k,716) + lu(k,723) = lu(k,723) * lu(k,716) + lu(k,724) = lu(k,724) * lu(k,716) + lu(k,725) = lu(k,725) * lu(k,716) + lu(k,1197) = lu(k,1197) - lu(k,717) * lu(k,1195) + lu(k,1199) = lu(k,1199) - lu(k,718) * lu(k,1195) + lu(k,1200) = lu(k,1200) - lu(k,719) * lu(k,1195) + lu(k,1201) = lu(k,1201) - lu(k,720) * lu(k,1195) + lu(k,1202) = lu(k,1202) - lu(k,721) * lu(k,1195) + lu(k,1204) = lu(k,1204) - lu(k,722) * lu(k,1195) + lu(k,1205) = lu(k,1205) - lu(k,723) * lu(k,1195) + lu(k,1206) = lu(k,1206) - lu(k,724) * lu(k,1195) + lu(k,1207) = lu(k,1207) - lu(k,725) * lu(k,1195) + lu(k,3200) = lu(k,3200) - lu(k,717) * lu(k,3199) + lu(k,3235) = lu(k,3235) - lu(k,718) * lu(k,3199) + lu(k,3238) = lu(k,3238) - lu(k,719) * lu(k,3199) + lu(k,3284) = lu(k,3284) - lu(k,720) * lu(k,3199) + lu(k,3308) = lu(k,3308) - lu(k,721) * lu(k,3199) + lu(k,3313) = lu(k,3313) - lu(k,722) * lu(k,3199) + lu(k,3315) = lu(k,3315) - lu(k,723) * lu(k,3199) + lu(k,3316) = lu(k,3316) - lu(k,724) * lu(k,3199) + lu(k,3320) = lu(k,3320) - lu(k,725) * lu(k,3199) + lu(k,3679) = lu(k,3679) - lu(k,717) * lu(k,3677) + lu(k,3736) = lu(k,3736) - lu(k,718) * lu(k,3677) + lu(k,3741) = lu(k,3741) - lu(k,719) * lu(k,3677) + lu(k,3790) = lu(k,3790) - lu(k,720) * lu(k,3677) + lu(k,3814) = lu(k,3814) - lu(k,721) * lu(k,3677) + lu(k,3819) = lu(k,3819) - lu(k,722) * lu(k,3677) + lu(k,3821) = lu(k,3821) - lu(k,723) * lu(k,3677) + lu(k,3822) = lu(k,3822) - lu(k,724) * lu(k,3677) + lu(k,3826) = lu(k,3826) - lu(k,725) * lu(k,3677) end do end subroutine lu_fac15 subroutine lu_fac16( avec_len, lu ) @@ -2297,197 +2243,181 @@ subroutine lu_fac16( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,696) = 1._r8 / lu(k,696) - lu(k,697) = lu(k,697) * lu(k,696) - lu(k,698) = lu(k,698) * lu(k,696) - lu(k,699) = lu(k,699) * lu(k,696) - lu(k,700) = lu(k,700) * lu(k,696) - lu(k,701) = lu(k,701) * lu(k,696) - lu(k,702) = lu(k,702) * lu(k,696) - lu(k,703) = lu(k,703) * lu(k,696) - lu(k,1599) = - lu(k,697) * lu(k,1598) - lu(k,1600) = - lu(k,698) * lu(k,1598) - lu(k,1601) = - lu(k,699) * lu(k,1598) - lu(k,1607) = - lu(k,700) * lu(k,1598) - lu(k,1608) = lu(k,1608) - lu(k,701) * lu(k,1598) - lu(k,1609) = lu(k,1609) - lu(k,702) * lu(k,1598) - lu(k,1610) = lu(k,1610) - lu(k,703) * lu(k,1598) - lu(k,2795) = lu(k,2795) - lu(k,697) * lu(k,2782) - lu(k,2812) = lu(k,2812) - lu(k,698) * lu(k,2782) - lu(k,2829) = lu(k,2829) - lu(k,699) * lu(k,2782) - lu(k,2885) = lu(k,2885) - lu(k,700) * lu(k,2782) - lu(k,2889) = lu(k,2889) - lu(k,701) * lu(k,2782) - lu(k,2894) = lu(k,2894) - lu(k,702) * lu(k,2782) - lu(k,2895) = lu(k,2895) - lu(k,703) * lu(k,2782) - lu(k,3186) = lu(k,3186) - lu(k,697) * lu(k,3173) - lu(k,3205) = lu(k,3205) - lu(k,698) * lu(k,3173) - lu(k,3223) = lu(k,3223) - lu(k,699) * lu(k,3173) - lu(k,3281) = lu(k,3281) - lu(k,700) * lu(k,3173) - lu(k,3285) = lu(k,3285) - lu(k,701) * lu(k,3173) - lu(k,3290) = lu(k,3290) - lu(k,702) * lu(k,3173) - lu(k,3291) = lu(k,3291) - lu(k,703) * lu(k,3173) - lu(k,3636) = lu(k,3636) - lu(k,697) * lu(k,3619) - lu(k,3661) = lu(k,3661) - lu(k,698) * lu(k,3619) - lu(k,3684) = lu(k,3684) - lu(k,699) * lu(k,3619) - lu(k,3742) = lu(k,3742) - lu(k,700) * lu(k,3619) - lu(k,3746) = lu(k,3746) - lu(k,701) * lu(k,3619) - lu(k,3751) = lu(k,3751) - lu(k,702) * lu(k,3619) - lu(k,3752) = lu(k,3752) - lu(k,703) * lu(k,3619) - lu(k,710) = 1._r8 / lu(k,710) - lu(k,711) = lu(k,711) * lu(k,710) - lu(k,712) = lu(k,712) * lu(k,710) - lu(k,713) = lu(k,713) * lu(k,710) - lu(k,714) = lu(k,714) * lu(k,710) - lu(k,715) = lu(k,715) * lu(k,710) - lu(k,716) = lu(k,716) * lu(k,710) - lu(k,717) = lu(k,717) * lu(k,710) - lu(k,718) = lu(k,718) * lu(k,710) - lu(k,719) = lu(k,719) * lu(k,710) - lu(k,720) = lu(k,720) * lu(k,710) - lu(k,2943) = lu(k,2943) - lu(k,711) * lu(k,2912) - lu(k,2965) = lu(k,2965) - lu(k,712) * lu(k,2912) - lu(k,2971) = - lu(k,713) * lu(k,2912) - lu(k,2974) = - lu(k,714) * lu(k,2912) - lu(k,2975) = lu(k,2975) - lu(k,715) * lu(k,2912) - lu(k,2987) = lu(k,2987) - lu(k,716) * lu(k,2912) - lu(k,2988) = lu(k,2988) - lu(k,717) * lu(k,2912) - lu(k,2990) = lu(k,2990) - lu(k,718) * lu(k,2912) - lu(k,2992) = lu(k,2992) - lu(k,719) * lu(k,2912) - lu(k,2996) = lu(k,2996) - lu(k,720) * lu(k,2912) - lu(k,3036) = - lu(k,711) * lu(k,3007) - lu(k,3057) = lu(k,3057) - lu(k,712) * lu(k,3007) - lu(k,3063) = lu(k,3063) - lu(k,713) * lu(k,3007) - lu(k,3066) = lu(k,3066) - lu(k,714) * lu(k,3007) - lu(k,3067) = lu(k,3067) - lu(k,715) * lu(k,3007) - lu(k,3079) = - lu(k,716) * lu(k,3007) - lu(k,3080) = lu(k,3080) - lu(k,717) * lu(k,3007) - lu(k,3082) = lu(k,3082) - lu(k,718) * lu(k,3007) - lu(k,3084) = lu(k,3084) - lu(k,719) * lu(k,3007) - lu(k,3088) = lu(k,3088) - lu(k,720) * lu(k,3007) - lu(k,3699) = lu(k,3699) - lu(k,711) * lu(k,3620) - lu(k,3721) = lu(k,3721) - lu(k,712) * lu(k,3620) - lu(k,3727) = lu(k,3727) - lu(k,713) * lu(k,3620) - lu(k,3730) = - lu(k,714) * lu(k,3620) - lu(k,3731) = lu(k,3731) - lu(k,715) * lu(k,3620) - lu(k,3743) = lu(k,3743) - lu(k,716) * lu(k,3620) - lu(k,3744) = lu(k,3744) - lu(k,717) * lu(k,3620) - lu(k,3746) = lu(k,3746) - lu(k,718) * lu(k,3620) - lu(k,3748) = lu(k,3748) - lu(k,719) * lu(k,3620) - lu(k,3752) = lu(k,3752) - lu(k,720) * lu(k,3620) - lu(k,721) = 1._r8 / lu(k,721) - lu(k,722) = lu(k,722) * lu(k,721) - lu(k,723) = lu(k,723) * lu(k,721) - lu(k,724) = lu(k,724) * lu(k,721) - lu(k,725) = lu(k,725) * lu(k,721) - lu(k,726) = lu(k,726) * lu(k,721) - lu(k,1254) = - lu(k,722) * lu(k,1252) - lu(k,1260) = - lu(k,723) * lu(k,1252) - lu(k,1266) = lu(k,1266) - lu(k,724) * lu(k,1252) - lu(k,1267) = lu(k,1267) - lu(k,725) * lu(k,1252) - lu(k,1269) = lu(k,1269) - lu(k,726) * lu(k,1252) - lu(k,1431) = lu(k,1431) - lu(k,722) * lu(k,1427) - lu(k,1443) = - lu(k,723) * lu(k,1427) - lu(k,1455) = lu(k,1455) - lu(k,724) * lu(k,1427) - lu(k,1456) = - lu(k,725) * lu(k,1427) - lu(k,1459) = lu(k,1459) - lu(k,726) * lu(k,1427) - lu(k,2813) = lu(k,2813) - lu(k,722) * lu(k,2783) - lu(k,2836) = lu(k,2836) - lu(k,723) * lu(k,2783) - lu(k,2889) = lu(k,2889) - lu(k,724) * lu(k,2783) - lu(k,2891) = lu(k,2891) - lu(k,725) * lu(k,2783) - lu(k,2895) = lu(k,2895) - lu(k,726) * lu(k,2783) - lu(k,2926) = lu(k,2926) - lu(k,722) * lu(k,2913) - lu(k,2940) = lu(k,2940) - lu(k,723) * lu(k,2913) - lu(k,2990) = lu(k,2990) - lu(k,724) * lu(k,2913) - lu(k,2992) = lu(k,2992) - lu(k,725) * lu(k,2913) - lu(k,2996) = lu(k,2996) - lu(k,726) * lu(k,2913) - lu(k,3206) = lu(k,3206) - lu(k,722) * lu(k,3174) - lu(k,3232) = lu(k,3232) - lu(k,723) * lu(k,3174) - lu(k,3285) = lu(k,3285) - lu(k,724) * lu(k,3174) - lu(k,3287) = lu(k,3287) - lu(k,725) * lu(k,3174) - lu(k,3291) = lu(k,3291) - lu(k,726) * lu(k,3174) - lu(k,3664) = lu(k,3664) - lu(k,722) * lu(k,3621) - lu(k,3694) = lu(k,3694) - lu(k,723) * lu(k,3621) - lu(k,3746) = lu(k,3746) - lu(k,724) * lu(k,3621) - lu(k,3748) = lu(k,3748) - lu(k,725) * lu(k,3621) - lu(k,3752) = lu(k,3752) - lu(k,726) * lu(k,3621) - lu(k,731) = 1._r8 / lu(k,731) - lu(k,732) = lu(k,732) * lu(k,731) - lu(k,733) = lu(k,733) * lu(k,731) - lu(k,734) = lu(k,734) * lu(k,731) - lu(k,735) = lu(k,735) * lu(k,731) - lu(k,736) = lu(k,736) * lu(k,731) - lu(k,737) = lu(k,737) * lu(k,731) - lu(k,738) = lu(k,738) * lu(k,731) - lu(k,739) = lu(k,739) * lu(k,731) - lu(k,740) = lu(k,740) * lu(k,731) - lu(k,741) = lu(k,741) * lu(k,731) - lu(k,777) = lu(k,777) - lu(k,732) * lu(k,776) - lu(k,778) = lu(k,778) - lu(k,733) * lu(k,776) - lu(k,779) = lu(k,779) - lu(k,734) * lu(k,776) - lu(k,780) = lu(k,780) - lu(k,735) * lu(k,776) - lu(k,781) = lu(k,781) - lu(k,736) * lu(k,776) - lu(k,782) = lu(k,782) - lu(k,737) * lu(k,776) - lu(k,783) = lu(k,783) - lu(k,738) * lu(k,776) - lu(k,784) = lu(k,784) - lu(k,739) * lu(k,776) - lu(k,786) = lu(k,786) - lu(k,740) * lu(k,776) - lu(k,788) = - lu(k,741) * lu(k,776) - lu(k,3177) = lu(k,3177) - lu(k,732) * lu(k,3175) - lu(k,3179) = lu(k,3179) - lu(k,733) * lu(k,3175) - lu(k,3180) = lu(k,3180) - lu(k,734) * lu(k,3175) - lu(k,3182) = lu(k,3182) - lu(k,735) * lu(k,3175) - lu(k,3206) = lu(k,3206) - lu(k,736) * lu(k,3175) - lu(k,3232) = lu(k,3232) - lu(k,737) * lu(k,3175) - lu(k,3249) = lu(k,3249) - lu(k,738) * lu(k,3175) - lu(k,3278) = lu(k,3278) - lu(k,739) * lu(k,3175) - lu(k,3285) = lu(k,3285) - lu(k,740) * lu(k,3175) - lu(k,3291) = lu(k,3291) - lu(k,741) * lu(k,3175) - lu(k,3624) = lu(k,3624) - lu(k,732) * lu(k,3622) - lu(k,3626) = lu(k,3626) - lu(k,733) * lu(k,3622) - lu(k,3627) = lu(k,3627) - lu(k,734) * lu(k,3622) - lu(k,3631) = lu(k,3631) - lu(k,735) * lu(k,3622) - lu(k,3664) = lu(k,3664) - lu(k,736) * lu(k,3622) - lu(k,3694) = lu(k,3694) - lu(k,737) * lu(k,3622) - lu(k,3711) = lu(k,3711) - lu(k,738) * lu(k,3622) - lu(k,3739) = lu(k,3739) - lu(k,739) * lu(k,3622) - lu(k,3746) = lu(k,3746) - lu(k,740) * lu(k,3622) - lu(k,3752) = lu(k,3752) - lu(k,741) * lu(k,3622) - lu(k,744) = 1._r8 / lu(k,744) - lu(k,745) = lu(k,745) * lu(k,744) - lu(k,746) = lu(k,746) * lu(k,744) - lu(k,747) = lu(k,747) * lu(k,744) - lu(k,748) = lu(k,748) * lu(k,744) - lu(k,749) = lu(k,749) * lu(k,744) - lu(k,750) = lu(k,750) * lu(k,744) - lu(k,2832) = lu(k,2832) - lu(k,745) * lu(k,2784) - lu(k,2885) = lu(k,2885) - lu(k,746) * lu(k,2784) - lu(k,2889) = lu(k,2889) - lu(k,747) * lu(k,2784) - lu(k,2891) = lu(k,2891) - lu(k,748) * lu(k,2784) - lu(k,2894) = lu(k,2894) - lu(k,749) * lu(k,2784) - lu(k,2895) = lu(k,2895) - lu(k,750) * lu(k,2784) - lu(k,2936) = lu(k,2936) - lu(k,745) * lu(k,2914) - lu(k,2986) = lu(k,2986) - lu(k,746) * lu(k,2914) - lu(k,2990) = lu(k,2990) - lu(k,747) * lu(k,2914) - lu(k,2992) = lu(k,2992) - lu(k,748) * lu(k,2914) - lu(k,2995) = lu(k,2995) - lu(k,749) * lu(k,2914) - lu(k,2996) = lu(k,2996) - lu(k,750) * lu(k,2914) - lu(k,3228) = lu(k,3228) - lu(k,745) * lu(k,3176) - lu(k,3281) = lu(k,3281) - lu(k,746) * lu(k,3176) - lu(k,3285) = lu(k,3285) - lu(k,747) * lu(k,3176) - lu(k,3287) = lu(k,3287) - lu(k,748) * lu(k,3176) - lu(k,3290) = lu(k,3290) - lu(k,749) * lu(k,3176) - lu(k,3291) = lu(k,3291) - lu(k,750) * lu(k,3176) - lu(k,3689) = lu(k,3689) - lu(k,745) * lu(k,3623) - lu(k,3742) = lu(k,3742) - lu(k,746) * lu(k,3623) - lu(k,3746) = lu(k,3746) - lu(k,747) * lu(k,3623) - lu(k,3748) = lu(k,3748) - lu(k,748) * lu(k,3623) - lu(k,3751) = lu(k,3751) - lu(k,749) * lu(k,3623) - lu(k,3752) = lu(k,3752) - lu(k,750) * lu(k,3623) - lu(k,3817) = - lu(k,745) * lu(k,3807) - lu(k,3823) = - lu(k,746) * lu(k,3807) - lu(k,3827) = lu(k,3827) - lu(k,747) * lu(k,3807) - lu(k,3829) = lu(k,3829) - lu(k,748) * lu(k,3807) - lu(k,3832) = - lu(k,749) * lu(k,3807) - lu(k,3833) = lu(k,3833) - lu(k,750) * lu(k,3807) + lu(k,727) = 1._r8 / lu(k,727) + lu(k,728) = lu(k,728) * lu(k,727) + lu(k,729) = lu(k,729) * lu(k,727) + lu(k,730) = lu(k,730) * lu(k,727) + lu(k,731) = lu(k,731) * lu(k,727) + lu(k,732) = lu(k,732) * lu(k,727) + lu(k,733) = lu(k,733) * lu(k,727) + lu(k,734) = lu(k,734) * lu(k,727) + lu(k,735) = lu(k,735) * lu(k,727) + lu(k,736) = lu(k,736) * lu(k,727) + lu(k,1197) = lu(k,1197) - lu(k,728) * lu(k,1196) + lu(k,1198) = lu(k,1198) - lu(k,729) * lu(k,1196) + lu(k,1199) = lu(k,1199) - lu(k,730) * lu(k,1196) + lu(k,1200) = lu(k,1200) - lu(k,731) * lu(k,1196) + lu(k,1201) = lu(k,1201) - lu(k,732) * lu(k,1196) + lu(k,1202) = lu(k,1202) - lu(k,733) * lu(k,1196) + lu(k,1204) = lu(k,1204) - lu(k,734) * lu(k,1196) + lu(k,1205) = lu(k,1205) - lu(k,735) * lu(k,1196) + lu(k,1206) = lu(k,1206) - lu(k,736) * lu(k,1196) + lu(k,3446) = lu(k,3446) - lu(k,728) * lu(k,3445) + lu(k,3482) = lu(k,3482) - lu(k,729) * lu(k,3445) + lu(k,3489) = lu(k,3489) - lu(k,730) * lu(k,3445) + lu(k,3492) = lu(k,3492) - lu(k,731) * lu(k,3445) + lu(k,3540) = lu(k,3540) - lu(k,732) * lu(k,3445) + lu(k,3564) = lu(k,3564) - lu(k,733) * lu(k,3445) + lu(k,3569) = lu(k,3569) - lu(k,734) * lu(k,3445) + lu(k,3571) = lu(k,3571) - lu(k,735) * lu(k,3445) + lu(k,3572) = lu(k,3572) - lu(k,736) * lu(k,3445) + lu(k,3679) = lu(k,3679) - lu(k,728) * lu(k,3678) + lu(k,3723) = lu(k,3723) - lu(k,729) * lu(k,3678) + lu(k,3736) = lu(k,3736) - lu(k,730) * lu(k,3678) + lu(k,3741) = lu(k,3741) - lu(k,731) * lu(k,3678) + lu(k,3790) = lu(k,3790) - lu(k,732) * lu(k,3678) + lu(k,3814) = lu(k,3814) - lu(k,733) * lu(k,3678) + lu(k,3819) = lu(k,3819) - lu(k,734) * lu(k,3678) + lu(k,3821) = lu(k,3821) - lu(k,735) * lu(k,3678) + lu(k,3822) = lu(k,3822) - lu(k,736) * lu(k,3678) + lu(k,738) = 1._r8 / lu(k,738) + lu(k,739) = lu(k,739) * lu(k,738) + lu(k,740) = lu(k,740) * lu(k,738) + lu(k,741) = lu(k,741) * lu(k,738) + lu(k,742) = lu(k,742) * lu(k,738) + lu(k,743) = lu(k,743) * lu(k,738) + lu(k,744) = lu(k,744) * lu(k,738) + lu(k,1200) = lu(k,1200) - lu(k,739) * lu(k,1197) + lu(k,1202) = lu(k,1202) - lu(k,740) * lu(k,1197) + lu(k,1203) = lu(k,1203) - lu(k,741) * lu(k,1197) + lu(k,1205) = lu(k,1205) - lu(k,742) * lu(k,1197) + lu(k,1206) = lu(k,1206) - lu(k,743) * lu(k,1197) + lu(k,1207) = lu(k,1207) - lu(k,744) * lu(k,1197) + lu(k,3238) = lu(k,3238) - lu(k,739) * lu(k,3200) + lu(k,3308) = lu(k,3308) - lu(k,740) * lu(k,3200) + lu(k,3311) = lu(k,3311) - lu(k,741) * lu(k,3200) + lu(k,3315) = lu(k,3315) - lu(k,742) * lu(k,3200) + lu(k,3316) = lu(k,3316) - lu(k,743) * lu(k,3200) + lu(k,3320) = lu(k,3320) - lu(k,744) * lu(k,3200) + lu(k,3492) = lu(k,3492) - lu(k,739) * lu(k,3446) + lu(k,3564) = lu(k,3564) - lu(k,740) * lu(k,3446) + lu(k,3567) = lu(k,3567) - lu(k,741) * lu(k,3446) + lu(k,3571) = lu(k,3571) - lu(k,742) * lu(k,3446) + lu(k,3572) = lu(k,3572) - lu(k,743) * lu(k,3446) + lu(k,3576) = lu(k,3576) - lu(k,744) * lu(k,3446) + lu(k,3741) = lu(k,3741) - lu(k,739) * lu(k,3679) + lu(k,3814) = lu(k,3814) - lu(k,740) * lu(k,3679) + lu(k,3817) = lu(k,3817) - lu(k,741) * lu(k,3679) + lu(k,3821) = lu(k,3821) - lu(k,742) * lu(k,3679) + lu(k,3822) = lu(k,3822) - lu(k,743) * lu(k,3679) + lu(k,3826) = lu(k,3826) - lu(k,744) * lu(k,3679) + lu(k,748) = 1._r8 / lu(k,748) + lu(k,749) = lu(k,749) * lu(k,748) + lu(k,750) = lu(k,750) * lu(k,748) + lu(k,751) = lu(k,751) * lu(k,748) + lu(k,752) = lu(k,752) * lu(k,748) + lu(k,753) = lu(k,753) * lu(k,748) + lu(k,754) = lu(k,754) * lu(k,748) + lu(k,755) = lu(k,755) * lu(k,748) + lu(k,756) = lu(k,756) * lu(k,748) + lu(k,757) = lu(k,757) * lu(k,748) + lu(k,876) = lu(k,876) - lu(k,749) * lu(k,875) + lu(k,877) = lu(k,877) - lu(k,750) * lu(k,875) + lu(k,878) = lu(k,878) - lu(k,751) * lu(k,875) + lu(k,879) = lu(k,879) - lu(k,752) * lu(k,875) + lu(k,880) = lu(k,880) - lu(k,753) * lu(k,875) + lu(k,881) = lu(k,881) - lu(k,754) * lu(k,875) + lu(k,882) = lu(k,882) - lu(k,755) * lu(k,875) + lu(k,884) = lu(k,884) - lu(k,756) * lu(k,875) + lu(k,885) = - lu(k,757) * lu(k,875) + lu(k,3458) = lu(k,3458) - lu(k,749) * lu(k,3447) + lu(k,3459) = lu(k,3459) - lu(k,750) * lu(k,3447) + lu(k,3461) = lu(k,3461) - lu(k,751) * lu(k,3447) + lu(k,3462) = lu(k,3462) - lu(k,752) * lu(k,3447) + lu(k,3497) = lu(k,3497) - lu(k,753) * lu(k,3447) + lu(k,3525) = lu(k,3525) - lu(k,754) * lu(k,3447) + lu(k,3526) = lu(k,3526) - lu(k,755) * lu(k,3447) + lu(k,3571) = lu(k,3571) - lu(k,756) * lu(k,3447) + lu(k,3572) = lu(k,3572) - lu(k,757) * lu(k,3447) + lu(k,3693) = lu(k,3693) - lu(k,749) * lu(k,3680) + lu(k,3694) = lu(k,3694) - lu(k,750) * lu(k,3680) + lu(k,3696) = - lu(k,751) * lu(k,3680) + lu(k,3699) = - lu(k,752) * lu(k,3680) + lu(k,3746) = lu(k,3746) - lu(k,753) * lu(k,3680) + lu(k,3776) = lu(k,3776) - lu(k,754) * lu(k,3680) + lu(k,3777) = lu(k,3777) - lu(k,755) * lu(k,3680) + lu(k,3821) = lu(k,3821) - lu(k,756) * lu(k,3680) + lu(k,3822) = lu(k,3822) - lu(k,757) * lu(k,3680) + lu(k,758) = 1._r8 / lu(k,758) + lu(k,759) = lu(k,759) * lu(k,758) + lu(k,760) = lu(k,760) * lu(k,758) + lu(k,761) = lu(k,761) * lu(k,758) + lu(k,762) = lu(k,762) * lu(k,758) + lu(k,763) = lu(k,763) * lu(k,758) + lu(k,764) = lu(k,764) * lu(k,758) + lu(k,765) = lu(k,765) * lu(k,758) + lu(k,766) = lu(k,766) * lu(k,758) + lu(k,767) = lu(k,767) * lu(k,758) + lu(k,2156) = - lu(k,759) * lu(k,2154) + lu(k,2159) = - lu(k,760) * lu(k,2154) + lu(k,2175) = lu(k,2175) - lu(k,761) * lu(k,2154) + lu(k,2176) = lu(k,2176) - lu(k,762) * lu(k,2154) + lu(k,2179) = lu(k,2179) - lu(k,763) * lu(k,2154) + lu(k,2188) = lu(k,2188) - lu(k,764) * lu(k,2154) + lu(k,2190) = lu(k,2190) - lu(k,765) * lu(k,2154) + lu(k,2191) = lu(k,2191) - lu(k,766) * lu(k,2154) + lu(k,2195) = lu(k,2195) - lu(k,767) * lu(k,2154) + lu(k,3729) = lu(k,3729) - lu(k,759) * lu(k,3681) + lu(k,3742) = lu(k,3742) - lu(k,760) * lu(k,3681) + lu(k,3781) = lu(k,3781) - lu(k,761) * lu(k,3681) + lu(k,3782) = lu(k,3782) - lu(k,762) * lu(k,3681) + lu(k,3785) = lu(k,3785) - lu(k,763) * lu(k,3681) + lu(k,3819) = lu(k,3819) - lu(k,764) * lu(k,3681) + lu(k,3821) = lu(k,3821) - lu(k,765) * lu(k,3681) + lu(k,3822) = lu(k,3822) - lu(k,766) * lu(k,3681) + lu(k,3826) = lu(k,3826) - lu(k,767) * lu(k,3681) + lu(k,3971) = - lu(k,759) * lu(k,3966) + lu(k,3976) = - lu(k,760) * lu(k,3966) + lu(k,4009) = lu(k,4009) - lu(k,761) * lu(k,3966) + lu(k,4010) = lu(k,4010) - lu(k,762) * lu(k,3966) + lu(k,4013) = lu(k,4013) - lu(k,763) * lu(k,3966) + lu(k,4046) = lu(k,4046) - lu(k,764) * lu(k,3966) + lu(k,4048) = lu(k,4048) - lu(k,765) * lu(k,3966) + lu(k,4049) = lu(k,4049) - lu(k,766) * lu(k,3966) + lu(k,4053) = lu(k,4053) - lu(k,767) * lu(k,3966) + lu(k,768) = 1._r8 / lu(k,768) + lu(k,769) = lu(k,769) * lu(k,768) + lu(k,770) = lu(k,770) * lu(k,768) + lu(k,771) = lu(k,771) * lu(k,768) + lu(k,772) = lu(k,772) * lu(k,768) + lu(k,1030) = - lu(k,769) * lu(k,1027) + lu(k,1034) = - lu(k,770) * lu(k,1027) + lu(k,1035) = - lu(k,771) * lu(k,1027) + lu(k,1039) = lu(k,1039) - lu(k,772) * lu(k,1027) + lu(k,1071) = - lu(k,769) * lu(k,1068) + lu(k,1075) = - lu(k,770) * lu(k,1068) + lu(k,1077) = - lu(k,771) * lu(k,1068) + lu(k,1081) = lu(k,1081) - lu(k,772) * lu(k,1068) + lu(k,1249) = - lu(k,769) * lu(k,1245) + lu(k,1254) = - lu(k,770) * lu(k,1245) + lu(k,1256) = - lu(k,771) * lu(k,1245) + lu(k,1261) = lu(k,1261) - lu(k,772) * lu(k,1245) + lu(k,2876) = lu(k,2876) - lu(k,769) * lu(k,2871) + lu(k,2896) = lu(k,2896) - lu(k,770) * lu(k,2871) + lu(k,2901) = lu(k,2901) - lu(k,771) * lu(k,2871) + lu(k,2911) = lu(k,2911) - lu(k,772) * lu(k,2871) + lu(k,3074) = lu(k,3074) - lu(k,769) * lu(k,3047) + lu(k,3119) = - lu(k,770) * lu(k,3047) + lu(k,3124) = - lu(k,771) * lu(k,3047) + lu(k,3134) = lu(k,3134) - lu(k,772) * lu(k,3047) + lu(k,3507) = lu(k,3507) - lu(k,769) * lu(k,3448) + lu(k,3557) = lu(k,3557) - lu(k,770) * lu(k,3448) + lu(k,3562) = lu(k,3562) - lu(k,771) * lu(k,3448) + lu(k,3572) = lu(k,3572) - lu(k,772) * lu(k,3448) + lu(k,3758) = lu(k,3758) - lu(k,769) * lu(k,3682) + lu(k,3807) = lu(k,3807) - lu(k,770) * lu(k,3682) + lu(k,3812) = lu(k,3812) - lu(k,771) * lu(k,3682) + lu(k,3822) = lu(k,3822) - lu(k,772) * lu(k,3682) end do end subroutine lu_fac16 subroutine lu_fac17( avec_len, lu ) @@ -2504,193 +2434,183 @@ subroutine lu_fac17( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,751) = 1._r8 / lu(k,751) - lu(k,752) = lu(k,752) * lu(k,751) - lu(k,753) = lu(k,753) * lu(k,751) - lu(k,754) = lu(k,754) * lu(k,751) - lu(k,755) = lu(k,755) * lu(k,751) - lu(k,756) = lu(k,756) * lu(k,751) - lu(k,765) = lu(k,765) - lu(k,752) * lu(k,761) - lu(k,766) = lu(k,766) - lu(k,753) * lu(k,761) - lu(k,768) = lu(k,768) - lu(k,754) * lu(k,761) - lu(k,769) = lu(k,769) - lu(k,755) * lu(k,761) - lu(k,770) = lu(k,770) - lu(k,756) * lu(k,761) - lu(k,781) = lu(k,781) - lu(k,752) * lu(k,777) - lu(k,782) = lu(k,782) - lu(k,753) * lu(k,777) - lu(k,785) = lu(k,785) - lu(k,754) * lu(k,777) - lu(k,786) = lu(k,786) - lu(k,755) * lu(k,777) - lu(k,787) = lu(k,787) - lu(k,756) * lu(k,777) - lu(k,2813) = lu(k,2813) - lu(k,752) * lu(k,2785) - lu(k,2836) = lu(k,2836) - lu(k,753) * lu(k,2785) - lu(k,2885) = lu(k,2885) - lu(k,754) * lu(k,2785) - lu(k,2889) = lu(k,2889) - lu(k,755) * lu(k,2785) - lu(k,2894) = lu(k,2894) - lu(k,756) * lu(k,2785) - lu(k,3206) = lu(k,3206) - lu(k,752) * lu(k,3177) - lu(k,3232) = lu(k,3232) - lu(k,753) * lu(k,3177) - lu(k,3281) = lu(k,3281) - lu(k,754) * lu(k,3177) - lu(k,3285) = lu(k,3285) - lu(k,755) * lu(k,3177) - lu(k,3290) = lu(k,3290) - lu(k,756) * lu(k,3177) - lu(k,3486) = - lu(k,752) * lu(k,3480) - lu(k,3490) = lu(k,3490) - lu(k,753) * lu(k,3480) - lu(k,3502) = lu(k,3502) - lu(k,754) * lu(k,3480) - lu(k,3506) = lu(k,3506) - lu(k,755) * lu(k,3480) - lu(k,3511) = lu(k,3511) - lu(k,756) * lu(k,3480) - lu(k,3664) = lu(k,3664) - lu(k,752) * lu(k,3624) - lu(k,3694) = lu(k,3694) - lu(k,753) * lu(k,3624) - lu(k,3742) = lu(k,3742) - lu(k,754) * lu(k,3624) - lu(k,3746) = lu(k,3746) - lu(k,755) * lu(k,3624) - lu(k,3751) = lu(k,3751) - lu(k,756) * lu(k,3624) - lu(k,762) = 1._r8 / lu(k,762) - lu(k,763) = lu(k,763) * lu(k,762) - lu(k,764) = lu(k,764) * lu(k,762) - lu(k,765) = lu(k,765) * lu(k,762) - lu(k,766) = lu(k,766) * lu(k,762) - lu(k,767) = lu(k,767) * lu(k,762) - lu(k,768) = lu(k,768) * lu(k,762) - lu(k,769) = lu(k,769) * lu(k,762) - lu(k,770) = lu(k,770) * lu(k,762) - lu(k,771) = lu(k,771) * lu(k,762) - lu(k,2788) = lu(k,2788) - lu(k,763) * lu(k,2786) - lu(k,2791) = lu(k,2791) - lu(k,764) * lu(k,2786) - lu(k,2813) = lu(k,2813) - lu(k,765) * lu(k,2786) - lu(k,2836) = lu(k,2836) - lu(k,766) * lu(k,2786) - lu(k,2853) = lu(k,2853) - lu(k,767) * lu(k,2786) - lu(k,2885) = lu(k,2885) - lu(k,768) * lu(k,2786) - lu(k,2889) = lu(k,2889) - lu(k,769) * lu(k,2786) - lu(k,2894) = lu(k,2894) - lu(k,770) * lu(k,2786) - lu(k,2895) = lu(k,2895) - lu(k,771) * lu(k,2786) - lu(k,3180) = lu(k,3180) - lu(k,763) * lu(k,3178) - lu(k,3182) = lu(k,3182) - lu(k,764) * lu(k,3178) - lu(k,3206) = lu(k,3206) - lu(k,765) * lu(k,3178) - lu(k,3232) = lu(k,3232) - lu(k,766) * lu(k,3178) - lu(k,3249) = lu(k,3249) - lu(k,767) * lu(k,3178) - lu(k,3281) = lu(k,3281) - lu(k,768) * lu(k,3178) - lu(k,3285) = lu(k,3285) - lu(k,769) * lu(k,3178) - lu(k,3290) = lu(k,3290) - lu(k,770) * lu(k,3178) - lu(k,3291) = lu(k,3291) - lu(k,771) * lu(k,3178) - lu(k,3627) = lu(k,3627) - lu(k,763) * lu(k,3625) - lu(k,3631) = lu(k,3631) - lu(k,764) * lu(k,3625) - lu(k,3664) = lu(k,3664) - lu(k,765) * lu(k,3625) - lu(k,3694) = lu(k,3694) - lu(k,766) * lu(k,3625) - lu(k,3711) = lu(k,3711) - lu(k,767) * lu(k,3625) - lu(k,3742) = lu(k,3742) - lu(k,768) * lu(k,3625) - lu(k,3746) = lu(k,3746) - lu(k,769) * lu(k,3625) - lu(k,3751) = lu(k,3751) - lu(k,770) * lu(k,3625) - lu(k,3752) = lu(k,3752) - lu(k,771) * lu(k,3625) - lu(k,778) = 1._r8 / lu(k,778) - lu(k,779) = lu(k,779) * lu(k,778) - lu(k,780) = lu(k,780) * lu(k,778) - lu(k,781) = lu(k,781) * lu(k,778) - lu(k,782) = lu(k,782) * lu(k,778) - lu(k,783) = lu(k,783) * lu(k,778) - lu(k,784) = lu(k,784) * lu(k,778) - lu(k,785) = lu(k,785) * lu(k,778) - lu(k,786) = lu(k,786) * lu(k,778) - lu(k,787) = lu(k,787) * lu(k,778) - lu(k,788) = lu(k,788) * lu(k,778) - lu(k,2788) = lu(k,2788) - lu(k,779) * lu(k,2787) - lu(k,2791) = lu(k,2791) - lu(k,780) * lu(k,2787) - lu(k,2813) = lu(k,2813) - lu(k,781) * lu(k,2787) - lu(k,2836) = lu(k,2836) - lu(k,782) * lu(k,2787) - lu(k,2853) = lu(k,2853) - lu(k,783) * lu(k,2787) - lu(k,2882) = lu(k,2882) - lu(k,784) * lu(k,2787) - lu(k,2885) = lu(k,2885) - lu(k,785) * lu(k,2787) - lu(k,2889) = lu(k,2889) - lu(k,786) * lu(k,2787) - lu(k,2894) = lu(k,2894) - lu(k,787) * lu(k,2787) - lu(k,2895) = lu(k,2895) - lu(k,788) * lu(k,2787) - lu(k,3180) = lu(k,3180) - lu(k,779) * lu(k,3179) - lu(k,3182) = lu(k,3182) - lu(k,780) * lu(k,3179) - lu(k,3206) = lu(k,3206) - lu(k,781) * lu(k,3179) - lu(k,3232) = lu(k,3232) - lu(k,782) * lu(k,3179) - lu(k,3249) = lu(k,3249) - lu(k,783) * lu(k,3179) - lu(k,3278) = lu(k,3278) - lu(k,784) * lu(k,3179) - lu(k,3281) = lu(k,3281) - lu(k,785) * lu(k,3179) - lu(k,3285) = lu(k,3285) - lu(k,786) * lu(k,3179) - lu(k,3290) = lu(k,3290) - lu(k,787) * lu(k,3179) - lu(k,3291) = lu(k,3291) - lu(k,788) * lu(k,3179) - lu(k,3627) = lu(k,3627) - lu(k,779) * lu(k,3626) - lu(k,3631) = lu(k,3631) - lu(k,780) * lu(k,3626) - lu(k,3664) = lu(k,3664) - lu(k,781) * lu(k,3626) - lu(k,3694) = lu(k,3694) - lu(k,782) * lu(k,3626) - lu(k,3711) = lu(k,3711) - lu(k,783) * lu(k,3626) - lu(k,3739) = lu(k,3739) - lu(k,784) * lu(k,3626) - lu(k,3742) = lu(k,3742) - lu(k,785) * lu(k,3626) - lu(k,3746) = lu(k,3746) - lu(k,786) * lu(k,3626) - lu(k,3751) = lu(k,3751) - lu(k,787) * lu(k,3626) - lu(k,3752) = lu(k,3752) - lu(k,788) * lu(k,3626) + lu(k,773) = 1._r8 / lu(k,773) + lu(k,774) = lu(k,774) * lu(k,773) + lu(k,775) = lu(k,775) * lu(k,773) + lu(k,776) = lu(k,776) * lu(k,773) + lu(k,777) = lu(k,777) * lu(k,773) + lu(k,778) = lu(k,778) * lu(k,773) + lu(k,779) = lu(k,779) * lu(k,773) + lu(k,780) = lu(k,780) * lu(k,773) + lu(k,1297) = lu(k,1297) - lu(k,774) * lu(k,1295) + lu(k,1298) = lu(k,1298) - lu(k,775) * lu(k,1295) + lu(k,1299) = lu(k,1299) - lu(k,776) * lu(k,1295) + lu(k,1301) = lu(k,1301) - lu(k,777) * lu(k,1295) + lu(k,1302) = lu(k,1302) - lu(k,778) * lu(k,1295) + lu(k,1304) = lu(k,1304) - lu(k,779) * lu(k,1295) + lu(k,1305) = lu(k,1305) - lu(k,780) * lu(k,1295) + lu(k,1886) = - lu(k,774) * lu(k,1883) + lu(k,1890) = lu(k,1890) - lu(k,775) * lu(k,1883) + lu(k,1891) = lu(k,1891) - lu(k,776) * lu(k,1883) + lu(k,1895) = - lu(k,777) * lu(k,1883) + lu(k,1896) = lu(k,1896) - lu(k,778) * lu(k,1883) + lu(k,1906) = lu(k,1906) - lu(k,779) * lu(k,1883) + lu(k,1907) = lu(k,1907) - lu(k,780) * lu(k,1883) + lu(k,3497) = lu(k,3497) - lu(k,774) * lu(k,3449) + lu(k,3514) = lu(k,3514) - lu(k,775) * lu(k,3449) + lu(k,3518) = lu(k,3518) - lu(k,776) * lu(k,3449) + lu(k,3525) = lu(k,3525) - lu(k,777) * lu(k,3449) + lu(k,3526) = lu(k,3526) - lu(k,778) * lu(k,3449) + lu(k,3571) = lu(k,3571) - lu(k,779) * lu(k,3449) + lu(k,3572) = lu(k,3572) - lu(k,780) * lu(k,3449) + lu(k,3746) = lu(k,3746) - lu(k,774) * lu(k,3683) + lu(k,3765) = lu(k,3765) - lu(k,775) * lu(k,3683) + lu(k,3769) = lu(k,3769) - lu(k,776) * lu(k,3683) + lu(k,3776) = lu(k,3776) - lu(k,777) * lu(k,3683) + lu(k,3777) = lu(k,3777) - lu(k,778) * lu(k,3683) + lu(k,3821) = lu(k,3821) - lu(k,779) * lu(k,3683) + lu(k,3822) = lu(k,3822) - lu(k,780) * lu(k,3683) + lu(k,781) = 1._r8 / lu(k,781) + lu(k,782) = lu(k,782) * lu(k,781) + lu(k,783) = lu(k,783) * lu(k,781) + lu(k,784) = lu(k,784) * lu(k,781) + lu(k,785) = lu(k,785) * lu(k,781) + lu(k,786) = lu(k,786) * lu(k,781) + lu(k,787) = lu(k,787) * lu(k,781) + lu(k,788) = lu(k,788) * lu(k,781) + lu(k,2487) = - lu(k,782) * lu(k,2486) + lu(k,2496) = lu(k,2496) - lu(k,783) * lu(k,2486) + lu(k,2501) = lu(k,2501) - lu(k,784) * lu(k,2486) + lu(k,2510) = - lu(k,785) * lu(k,2486) + lu(k,2513) = lu(k,2513) - lu(k,786) * lu(k,2486) + lu(k,2514) = lu(k,2514) - lu(k,787) * lu(k,2486) + lu(k,2517) = lu(k,2517) - lu(k,788) * lu(k,2486) + lu(k,2683) = - lu(k,782) * lu(k,2682) + lu(k,2692) = lu(k,2692) - lu(k,783) * lu(k,2682) + lu(k,2699) = lu(k,2699) - lu(k,784) * lu(k,2682) + lu(k,2711) = - lu(k,785) * lu(k,2682) + lu(k,2714) = lu(k,2714) - lu(k,786) * lu(k,2682) + lu(k,2715) = lu(k,2715) - lu(k,787) * lu(k,2682) + lu(k,2719) = lu(k,2719) - lu(k,788) * lu(k,2682) + lu(k,3471) = lu(k,3471) - lu(k,782) * lu(k,3450) + lu(k,3513) = lu(k,3513) - lu(k,783) * lu(k,3450) + lu(k,3555) = lu(k,3555) - lu(k,784) * lu(k,3450) + lu(k,3568) = - lu(k,785) * lu(k,3450) + lu(k,3571) = lu(k,3571) - lu(k,786) * lu(k,3450) + lu(k,3572) = lu(k,3572) - lu(k,787) * lu(k,3450) + lu(k,3576) = lu(k,3576) - lu(k,788) * lu(k,3450) + lu(k,3708) = lu(k,3708) - lu(k,782) * lu(k,3684) + lu(k,3764) = lu(k,3764) - lu(k,783) * lu(k,3684) + lu(k,3805) = lu(k,3805) - lu(k,784) * lu(k,3684) + lu(k,3818) = lu(k,3818) - lu(k,785) * lu(k,3684) + lu(k,3821) = lu(k,3821) - lu(k,786) * lu(k,3684) + lu(k,3822) = lu(k,3822) - lu(k,787) * lu(k,3684) + lu(k,3826) = lu(k,3826) - lu(k,788) * lu(k,3684) lu(k,789) = 1._r8 / lu(k,789) lu(k,790) = lu(k,790) * lu(k,789) lu(k,791) = lu(k,791) * lu(k,789) lu(k,792) = lu(k,792) * lu(k,789) lu(k,793) = lu(k,793) * lu(k,789) - lu(k,794) = lu(k,794) * lu(k,789) - lu(k,795) = lu(k,795) * lu(k,789) - lu(k,796) = lu(k,796) * lu(k,789) - lu(k,2836) = lu(k,2836) - lu(k,790) * lu(k,2788) - lu(k,2853) = lu(k,2853) - lu(k,791) * lu(k,2788) - lu(k,2885) = lu(k,2885) - lu(k,792) * lu(k,2788) - lu(k,2889) = lu(k,2889) - lu(k,793) * lu(k,2788) - lu(k,2892) = lu(k,2892) - lu(k,794) * lu(k,2788) - lu(k,2894) = lu(k,2894) - lu(k,795) * lu(k,2788) - lu(k,2895) = lu(k,2895) - lu(k,796) * lu(k,2788) - lu(k,3232) = lu(k,3232) - lu(k,790) * lu(k,3180) - lu(k,3249) = lu(k,3249) - lu(k,791) * lu(k,3180) - lu(k,3281) = lu(k,3281) - lu(k,792) * lu(k,3180) - lu(k,3285) = lu(k,3285) - lu(k,793) * lu(k,3180) - lu(k,3288) = lu(k,3288) - lu(k,794) * lu(k,3180) - lu(k,3290) = lu(k,3290) - lu(k,795) * lu(k,3180) - lu(k,3291) = lu(k,3291) - lu(k,796) * lu(k,3180) - lu(k,3490) = lu(k,3490) - lu(k,790) * lu(k,3481) - lu(k,3493) = - lu(k,791) * lu(k,3481) - lu(k,3502) = lu(k,3502) - lu(k,792) * lu(k,3481) - lu(k,3506) = lu(k,3506) - lu(k,793) * lu(k,3481) - lu(k,3509) = lu(k,3509) - lu(k,794) * lu(k,3481) - lu(k,3511) = lu(k,3511) - lu(k,795) * lu(k,3481) - lu(k,3512) = lu(k,3512) - lu(k,796) * lu(k,3481) - lu(k,3694) = lu(k,3694) - lu(k,790) * lu(k,3627) - lu(k,3711) = lu(k,3711) - lu(k,791) * lu(k,3627) - lu(k,3742) = lu(k,3742) - lu(k,792) * lu(k,3627) - lu(k,3746) = lu(k,3746) - lu(k,793) * lu(k,3627) - lu(k,3749) = lu(k,3749) - lu(k,794) * lu(k,3627) - lu(k,3751) = lu(k,3751) - lu(k,795) * lu(k,3627) - lu(k,3752) = lu(k,3752) - lu(k,796) * lu(k,3627) - lu(k,797) = 1._r8 / lu(k,797) - lu(k,798) = lu(k,798) * lu(k,797) - lu(k,799) = lu(k,799) * lu(k,797) - lu(k,800) = lu(k,800) * lu(k,797) - lu(k,801) = lu(k,801) * lu(k,797) - lu(k,1548) = - lu(k,798) * lu(k,1545) - lu(k,1551) = - lu(k,799) * lu(k,1545) - lu(k,1560) = lu(k,1560) - lu(k,800) * lu(k,1545) - lu(k,1564) = lu(k,1564) - lu(k,801) * lu(k,1545) - lu(k,1569) = - lu(k,798) * lu(k,1566) - lu(k,1572) = - lu(k,799) * lu(k,1566) - lu(k,1581) = lu(k,1581) - lu(k,800) * lu(k,1566) - lu(k,1585) = lu(k,1585) - lu(k,801) * lu(k,1566) - lu(k,1663) = - lu(k,798) * lu(k,1657) - lu(k,1665) = - lu(k,799) * lu(k,1657) - lu(k,1678) = lu(k,1678) - lu(k,800) * lu(k,1657) - lu(k,1682) = lu(k,1682) - lu(k,801) * lu(k,1657) - lu(k,1720) = - lu(k,798) * lu(k,1713) - lu(k,1724) = - lu(k,799) * lu(k,1713) - lu(k,1740) = lu(k,1740) - lu(k,800) * lu(k,1713) - lu(k,1744) = lu(k,1744) - lu(k,801) * lu(k,1713) - lu(k,1776) = - lu(k,798) * lu(k,1769) - lu(k,1778) = - lu(k,799) * lu(k,1769) - lu(k,1790) = lu(k,1790) - lu(k,800) * lu(k,1769) - lu(k,1794) = lu(k,1794) - lu(k,801) * lu(k,1769) - lu(k,1819) = - lu(k,798) * lu(k,1813) - lu(k,1823) = - lu(k,799) * lu(k,1813) - lu(k,1838) = lu(k,1838) - lu(k,800) * lu(k,1813) - lu(k,1842) = lu(k,1842) - lu(k,801) * lu(k,1813) - lu(k,3370) = lu(k,3370) - lu(k,798) * lu(k,3351) - lu(k,3379) = lu(k,3379) - lu(k,799) * lu(k,3351) - lu(k,3426) = lu(k,3426) - lu(k,800) * lu(k,3351) - lu(k,3432) = lu(k,3432) - lu(k,801) * lu(k,3351) - lu(k,3689) = lu(k,3689) - lu(k,798) * lu(k,3628) - lu(k,3699) = lu(k,3699) - lu(k,799) * lu(k,3628) - lu(k,3746) = lu(k,3746) - lu(k,800) * lu(k,3628) - lu(k,3752) = lu(k,3752) - lu(k,801) * lu(k,3628) + lu(k,1368) = lu(k,1368) - lu(k,790) * lu(k,1362) + lu(k,1376) = lu(k,1376) - lu(k,791) * lu(k,1362) + lu(k,1378) = lu(k,1378) - lu(k,792) * lu(k,1362) + lu(k,1380) = - lu(k,793) * lu(k,1362) + lu(k,1617) = lu(k,1617) - lu(k,790) * lu(k,1616) + lu(k,1627) = lu(k,1627) - lu(k,791) * lu(k,1616) + lu(k,1629) = lu(k,1629) - lu(k,792) * lu(k,1616) + lu(k,1631) = lu(k,1631) - lu(k,793) * lu(k,1616) + lu(k,2973) = lu(k,2973) - lu(k,790) * lu(k,2965) + lu(k,3031) = lu(k,3031) - lu(k,791) * lu(k,2965) + lu(k,3034) = lu(k,3034) - lu(k,792) * lu(k,2965) + lu(k,3036) = lu(k,3036) - lu(k,793) * lu(k,2965) + lu(k,3074) = lu(k,3074) - lu(k,790) * lu(k,3048) + lu(k,3134) = lu(k,3134) - lu(k,791) * lu(k,3048) + lu(k,3137) = lu(k,3137) - lu(k,792) * lu(k,3048) + lu(k,3139) = - lu(k,793) * lu(k,3048) + lu(k,3507) = lu(k,3507) - lu(k,790) * lu(k,3451) + lu(k,3572) = lu(k,3572) - lu(k,791) * lu(k,3451) + lu(k,3575) = lu(k,3575) - lu(k,792) * lu(k,3451) + lu(k,3577) = lu(k,3577) - lu(k,793) * lu(k,3451) + lu(k,3758) = lu(k,3758) - lu(k,790) * lu(k,3685) + lu(k,3822) = lu(k,3822) - lu(k,791) * lu(k,3685) + lu(k,3825) = lu(k,3825) - lu(k,792) * lu(k,3685) + lu(k,3827) = lu(k,3827) - lu(k,793) * lu(k,3685) + lu(k,3987) = lu(k,3987) - lu(k,790) * lu(k,3967) + lu(k,4049) = lu(k,4049) - lu(k,791) * lu(k,3967) + lu(k,4052) = lu(k,4052) - lu(k,792) * lu(k,3967) + lu(k,4054) = lu(k,4054) - lu(k,793) * lu(k,3967) + lu(k,795) = 1._r8 / lu(k,795) + lu(k,796) = lu(k,796) * lu(k,795) + lu(k,797) = lu(k,797) * lu(k,795) + lu(k,798) = lu(k,798) * lu(k,795) + lu(k,799) = lu(k,799) * lu(k,795) + lu(k,800) = lu(k,800) * lu(k,795) + lu(k,801) = lu(k,801) * lu(k,795) + lu(k,802) = lu(k,802) * lu(k,795) + lu(k,2654) = - lu(k,796) * lu(k,2653) + lu(k,2660) = lu(k,2660) - lu(k,797) * lu(k,2653) + lu(k,2671) = - lu(k,798) * lu(k,2653) + lu(k,2673) = lu(k,2673) - lu(k,799) * lu(k,2653) + lu(k,2675) = - lu(k,800) * lu(k,2653) + lu(k,2676) = lu(k,2676) - lu(k,801) * lu(k,2653) + lu(k,2679) = lu(k,2679) - lu(k,802) * lu(k,2653) + lu(k,3215) = lu(k,3215) - lu(k,796) * lu(k,3201) + lu(k,3259) = lu(k,3259) - lu(k,797) * lu(k,3201) + lu(k,3311) = lu(k,3311) - lu(k,798) * lu(k,3201) + lu(k,3313) = lu(k,3313) - lu(k,799) * lu(k,3201) + lu(k,3315) = lu(k,3315) - lu(k,800) * lu(k,3201) + lu(k,3316) = lu(k,3316) - lu(k,801) * lu(k,3201) + lu(k,3320) = lu(k,3320) - lu(k,802) * lu(k,3201) + lu(k,3467) = lu(k,3467) - lu(k,796) * lu(k,3452) + lu(k,3515) = lu(k,3515) - lu(k,797) * lu(k,3452) + lu(k,3567) = lu(k,3567) - lu(k,798) * lu(k,3452) + lu(k,3569) = lu(k,3569) - lu(k,799) * lu(k,3452) + lu(k,3571) = lu(k,3571) - lu(k,800) * lu(k,3452) + lu(k,3572) = lu(k,3572) - lu(k,801) * lu(k,3452) + lu(k,3576) = lu(k,3576) - lu(k,802) * lu(k,3452) + lu(k,3704) = lu(k,3704) - lu(k,796) * lu(k,3686) + lu(k,3766) = lu(k,3766) - lu(k,797) * lu(k,3686) + lu(k,3817) = lu(k,3817) - lu(k,798) * lu(k,3686) + lu(k,3819) = lu(k,3819) - lu(k,799) * lu(k,3686) + lu(k,3821) = lu(k,3821) - lu(k,800) * lu(k,3686) + lu(k,3822) = lu(k,3822) - lu(k,801) * lu(k,3686) + lu(k,3826) = lu(k,3826) - lu(k,802) * lu(k,3686) + lu(k,803) = 1._r8 / lu(k,803) + lu(k,804) = lu(k,804) * lu(k,803) + lu(k,805) = lu(k,805) * lu(k,803) + lu(k,806) = lu(k,806) * lu(k,803) + lu(k,807) = lu(k,807) * lu(k,803) + lu(k,808) = lu(k,808) * lu(k,803) + lu(k,809) = lu(k,809) * lu(k,803) + lu(k,810) = lu(k,810) * lu(k,803) + lu(k,1684) = - lu(k,804) * lu(k,1683) + lu(k,1685) = - lu(k,805) * lu(k,1683) + lu(k,1686) = - lu(k,806) * lu(k,1683) + lu(k,1690) = - lu(k,807) * lu(k,1683) + lu(k,1692) = lu(k,1692) - lu(k,808) * lu(k,1683) + lu(k,1693) = lu(k,1693) - lu(k,809) * lu(k,1683) + lu(k,1694) = lu(k,1694) - lu(k,810) * lu(k,1683) + lu(k,3215) = lu(k,3215) - lu(k,804) * lu(k,3202) + lu(k,3231) = lu(k,3231) - lu(k,805) * lu(k,3202) + lu(k,3251) = lu(k,3251) - lu(k,806) * lu(k,3202) + lu(k,3311) = lu(k,3311) - lu(k,807) * lu(k,3202) + lu(k,3315) = lu(k,3315) - lu(k,808) * lu(k,3202) + lu(k,3316) = lu(k,3316) - lu(k,809) * lu(k,3202) + lu(k,3320) = lu(k,3320) - lu(k,810) * lu(k,3202) + lu(k,3467) = lu(k,3467) - lu(k,804) * lu(k,3453) + lu(k,3485) = - lu(k,805) * lu(k,3453) + lu(k,3505) = lu(k,3505) - lu(k,806) * lu(k,3453) + lu(k,3567) = lu(k,3567) - lu(k,807) * lu(k,3453) + lu(k,3571) = lu(k,3571) - lu(k,808) * lu(k,3453) + lu(k,3572) = lu(k,3572) - lu(k,809) * lu(k,3453) + lu(k,3576) = lu(k,3576) - lu(k,810) * lu(k,3453) + lu(k,3704) = lu(k,3704) - lu(k,804) * lu(k,3687) + lu(k,3726) = lu(k,3726) - lu(k,805) * lu(k,3687) + lu(k,3755) = lu(k,3755) - lu(k,806) * lu(k,3687) + lu(k,3817) = lu(k,3817) - lu(k,807) * lu(k,3687) + lu(k,3821) = lu(k,3821) - lu(k,808) * lu(k,3687) + lu(k,3822) = lu(k,3822) - lu(k,809) * lu(k,3687) + lu(k,3826) = lu(k,3826) - lu(k,810) * lu(k,3687) end do end subroutine lu_fac17 subroutine lu_fac18( avec_len, lu ) @@ -2707,203 +2627,197 @@ subroutine lu_fac18( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,802) = 1._r8 / lu(k,802) - lu(k,803) = lu(k,803) * lu(k,802) - lu(k,804) = lu(k,804) * lu(k,802) - lu(k,805) = lu(k,805) * lu(k,802) - lu(k,806) = lu(k,806) * lu(k,802) - lu(k,1432) = - lu(k,803) * lu(k,1428) - lu(k,1438) = - lu(k,804) * lu(k,1428) - lu(k,1455) = lu(k,1455) - lu(k,805) * lu(k,1428) - lu(k,1459) = lu(k,1459) - lu(k,806) * lu(k,1428) - lu(k,1716) = - lu(k,803) * lu(k,1714) - lu(k,1719) = - lu(k,804) * lu(k,1714) - lu(k,1740) = lu(k,1740) - lu(k,805) * lu(k,1714) - lu(k,1744) = lu(k,1744) - lu(k,806) * lu(k,1714) - lu(k,1816) = - lu(k,803) * lu(k,1814) - lu(k,1818) = - lu(k,804) * lu(k,1814) - lu(k,1838) = lu(k,1838) - lu(k,805) * lu(k,1814) - lu(k,1842) = lu(k,1842) - lu(k,806) * lu(k,1814) - lu(k,1881) = lu(k,1881) - lu(k,803) * lu(k,1879) - lu(k,1884) = - lu(k,804) * lu(k,1879) - lu(k,1906) = lu(k,1906) - lu(k,805) * lu(k,1879) - lu(k,1910) = lu(k,1910) - lu(k,806) * lu(k,1879) - lu(k,1915) = - lu(k,803) * lu(k,1912) - lu(k,1920) = - lu(k,804) * lu(k,1912) - lu(k,1938) = lu(k,1938) - lu(k,805) * lu(k,1912) - lu(k,1942) = lu(k,1942) - lu(k,806) * lu(k,1912) - lu(k,1949) = - lu(k,803) * lu(k,1946) - lu(k,1954) = - lu(k,804) * lu(k,1946) - lu(k,1972) = lu(k,1972) - lu(k,805) * lu(k,1946) - lu(k,1976) = lu(k,1976) - lu(k,806) * lu(k,1946) - lu(k,2816) = - lu(k,803) * lu(k,2789) - lu(k,2830) = lu(k,2830) - lu(k,804) * lu(k,2789) - lu(k,2889) = lu(k,2889) - lu(k,805) * lu(k,2789) - lu(k,2895) = lu(k,2895) - lu(k,806) * lu(k,2789) - lu(k,3669) = lu(k,3669) - lu(k,803) * lu(k,3629) - lu(k,3685) = lu(k,3685) - lu(k,804) * lu(k,3629) - lu(k,3746) = lu(k,3746) - lu(k,805) * lu(k,3629) - lu(k,3752) = lu(k,3752) - lu(k,806) * lu(k,3629) - lu(k,807) = 1._r8 / lu(k,807) - lu(k,808) = lu(k,808) * lu(k,807) - lu(k,809) = lu(k,809) * lu(k,807) - lu(k,810) = lu(k,810) * lu(k,807) - lu(k,811) = lu(k,811) * lu(k,807) - lu(k,1263) = - lu(k,808) * lu(k,1253) - lu(k,1264) = - lu(k,809) * lu(k,1253) - lu(k,1267) = lu(k,1267) - lu(k,810) * lu(k,1253) - lu(k,1269) = lu(k,1269) - lu(k,811) * lu(k,1253) - lu(k,1448) = lu(k,1448) - lu(k,808) * lu(k,1429) - lu(k,1451) = - lu(k,809) * lu(k,1429) - lu(k,1456) = lu(k,1456) - lu(k,810) * lu(k,1429) - lu(k,1459) = lu(k,1459) - lu(k,811) * lu(k,1429) - lu(k,1671) = lu(k,1671) - lu(k,808) * lu(k,1658) - lu(k,1675) = lu(k,1675) - lu(k,809) * lu(k,1658) - lu(k,1679) = lu(k,1679) - lu(k,810) * lu(k,1658) - lu(k,1682) = lu(k,1682) - lu(k,811) * lu(k,1658) - lu(k,1783) = lu(k,1783) - lu(k,808) * lu(k,1770) - lu(k,1787) = lu(k,1787) - lu(k,809) * lu(k,1770) - lu(k,1791) = lu(k,1791) - lu(k,810) * lu(k,1770) - lu(k,1794) = lu(k,1794) - lu(k,811) * lu(k,1770) - lu(k,2853) = lu(k,2853) - lu(k,808) * lu(k,2790) - lu(k,2882) = lu(k,2882) - lu(k,809) * lu(k,2790) - lu(k,2891) = lu(k,2891) - lu(k,810) * lu(k,2790) - lu(k,2895) = lu(k,2895) - lu(k,811) * lu(k,2790) - lu(k,2955) = lu(k,2955) - lu(k,808) * lu(k,2915) - lu(k,2983) = lu(k,2983) - lu(k,809) * lu(k,2915) - lu(k,2992) = lu(k,2992) - lu(k,810) * lu(k,2915) - lu(k,2996) = lu(k,2996) - lu(k,811) * lu(k,2915) - lu(k,3249) = lu(k,3249) - lu(k,808) * lu(k,3181) - lu(k,3278) = lu(k,3278) - lu(k,809) * lu(k,3181) - lu(k,3287) = lu(k,3287) - lu(k,810) * lu(k,3181) - lu(k,3291) = lu(k,3291) - lu(k,811) * lu(k,3181) - lu(k,3711) = lu(k,3711) - lu(k,808) * lu(k,3630) - lu(k,3739) = lu(k,3739) - lu(k,809) * lu(k,3630) - lu(k,3748) = lu(k,3748) - lu(k,810) * lu(k,3630) - lu(k,3752) = lu(k,3752) - lu(k,811) * lu(k,3630) - lu(k,812) = 1._r8 / lu(k,812) - lu(k,813) = lu(k,813) * lu(k,812) - lu(k,814) = lu(k,814) * lu(k,812) - lu(k,815) = lu(k,815) * lu(k,812) - lu(k,816) = lu(k,816) * lu(k,812) - lu(k,817) = lu(k,817) * lu(k,812) - lu(k,818) = lu(k,818) * lu(k,812) - lu(k,819) = lu(k,819) * lu(k,812) - lu(k,820) = lu(k,820) * lu(k,812) - lu(k,2813) = lu(k,2813) - lu(k,813) * lu(k,2791) - lu(k,2836) = lu(k,2836) - lu(k,814) * lu(k,2791) - lu(k,2853) = lu(k,2853) - lu(k,815) * lu(k,2791) - lu(k,2885) = lu(k,2885) - lu(k,816) * lu(k,2791) - lu(k,2889) = lu(k,2889) - lu(k,817) * lu(k,2791) - lu(k,2892) = lu(k,2892) - lu(k,818) * lu(k,2791) - lu(k,2894) = lu(k,2894) - lu(k,819) * lu(k,2791) - lu(k,2895) = lu(k,2895) - lu(k,820) * lu(k,2791) - lu(k,3206) = lu(k,3206) - lu(k,813) * lu(k,3182) - lu(k,3232) = lu(k,3232) - lu(k,814) * lu(k,3182) - lu(k,3249) = lu(k,3249) - lu(k,815) * lu(k,3182) - lu(k,3281) = lu(k,3281) - lu(k,816) * lu(k,3182) - lu(k,3285) = lu(k,3285) - lu(k,817) * lu(k,3182) - lu(k,3288) = lu(k,3288) - lu(k,818) * lu(k,3182) - lu(k,3290) = lu(k,3290) - lu(k,819) * lu(k,3182) - lu(k,3291) = lu(k,3291) - lu(k,820) * lu(k,3182) - lu(k,3486) = lu(k,3486) - lu(k,813) * lu(k,3482) - lu(k,3490) = lu(k,3490) - lu(k,814) * lu(k,3482) - lu(k,3493) = lu(k,3493) - lu(k,815) * lu(k,3482) - lu(k,3502) = lu(k,3502) - lu(k,816) * lu(k,3482) - lu(k,3506) = lu(k,3506) - lu(k,817) * lu(k,3482) - lu(k,3509) = lu(k,3509) - lu(k,818) * lu(k,3482) - lu(k,3511) = lu(k,3511) - lu(k,819) * lu(k,3482) - lu(k,3512) = lu(k,3512) - lu(k,820) * lu(k,3482) - lu(k,3664) = lu(k,3664) - lu(k,813) * lu(k,3631) - lu(k,3694) = lu(k,3694) - lu(k,814) * lu(k,3631) - lu(k,3711) = lu(k,3711) - lu(k,815) * lu(k,3631) - lu(k,3742) = lu(k,3742) - lu(k,816) * lu(k,3631) - lu(k,3746) = lu(k,3746) - lu(k,817) * lu(k,3631) - lu(k,3749) = lu(k,3749) - lu(k,818) * lu(k,3631) - lu(k,3751) = lu(k,3751) - lu(k,819) * lu(k,3631) - lu(k,3752) = lu(k,3752) - lu(k,820) * lu(k,3631) - lu(k,822) = 1._r8 / lu(k,822) - lu(k,823) = lu(k,823) * lu(k,822) - lu(k,824) = lu(k,824) * lu(k,822) - lu(k,825) = lu(k,825) * lu(k,822) - lu(k,826) = lu(k,826) * lu(k,822) - lu(k,827) = lu(k,827) * lu(k,822) - lu(k,828) = lu(k,828) * lu(k,822) - lu(k,829) = lu(k,829) * lu(k,822) - lu(k,830) = lu(k,830) * lu(k,822) - lu(k,1198) = lu(k,1198) - lu(k,823) * lu(k,1195) - lu(k,1201) = - lu(k,824) * lu(k,1195) - lu(k,1202) = - lu(k,825) * lu(k,1195) - lu(k,1205) = lu(k,1205) - lu(k,826) * lu(k,1195) - lu(k,1206) = lu(k,1206) - lu(k,827) * lu(k,1195) - lu(k,1208) = - lu(k,828) * lu(k,1195) - lu(k,1209) = lu(k,1209) - lu(k,829) * lu(k,1195) - lu(k,1210) = lu(k,1210) - lu(k,830) * lu(k,1195) - lu(k,2820) = lu(k,2820) - lu(k,823) * lu(k,2792) - lu(k,2841) = lu(k,2841) - lu(k,824) * lu(k,2792) - lu(k,2885) = lu(k,2885) - lu(k,825) * lu(k,2792) - lu(k,2889) = lu(k,2889) - lu(k,826) * lu(k,2792) - lu(k,2891) = lu(k,2891) - lu(k,827) * lu(k,2792) - lu(k,2894) = lu(k,2894) - lu(k,828) * lu(k,2792) - lu(k,2895) = lu(k,2895) - lu(k,829) * lu(k,2792) - lu(k,2899) = lu(k,2899) - lu(k,830) * lu(k,2792) - lu(k,3213) = lu(k,3213) - lu(k,823) * lu(k,3183) - lu(k,3237) = lu(k,3237) - lu(k,824) * lu(k,3183) - lu(k,3281) = lu(k,3281) - lu(k,825) * lu(k,3183) - lu(k,3285) = lu(k,3285) - lu(k,826) * lu(k,3183) - lu(k,3287) = lu(k,3287) - lu(k,827) * lu(k,3183) - lu(k,3290) = lu(k,3290) - lu(k,828) * lu(k,3183) - lu(k,3291) = lu(k,3291) - lu(k,829) * lu(k,3183) - lu(k,3295) = lu(k,3295) - lu(k,830) * lu(k,3183) - lu(k,3674) = lu(k,3674) - lu(k,823) * lu(k,3632) - lu(k,3699) = lu(k,3699) - lu(k,824) * lu(k,3632) - lu(k,3742) = lu(k,3742) - lu(k,825) * lu(k,3632) - lu(k,3746) = lu(k,3746) - lu(k,826) * lu(k,3632) - lu(k,3748) = lu(k,3748) - lu(k,827) * lu(k,3632) - lu(k,3751) = lu(k,3751) - lu(k,828) * lu(k,3632) - lu(k,3752) = lu(k,3752) - lu(k,829) * lu(k,3632) - lu(k,3756) = lu(k,3756) - lu(k,830) * lu(k,3632) - lu(k,834) = 1._r8 / lu(k,834) - lu(k,835) = lu(k,835) * lu(k,834) - lu(k,836) = lu(k,836) * lu(k,834) - lu(k,837) = lu(k,837) * lu(k,834) - lu(k,838) = lu(k,838) * lu(k,834) - lu(k,839) = lu(k,839) * lu(k,834) - lu(k,840) = lu(k,840) * lu(k,834) - lu(k,841) = lu(k,841) * lu(k,834) - lu(k,842) = lu(k,842) * lu(k,834) - lu(k,2176) = - lu(k,835) * lu(k,2175) - lu(k,2178) = - lu(k,836) * lu(k,2175) - lu(k,2180) = - lu(k,837) * lu(k,2175) - lu(k,2186) = - lu(k,838) * lu(k,2175) - lu(k,2188) = lu(k,2188) - lu(k,839) * lu(k,2175) - lu(k,2189) = - lu(k,840) * lu(k,2175) - lu(k,2190) = - lu(k,841) * lu(k,2175) - lu(k,2191) = lu(k,2191) - lu(k,842) * lu(k,2175) - lu(k,2795) = lu(k,2795) - lu(k,835) * lu(k,2793) - lu(k,2844) = lu(k,2844) - lu(k,836) * lu(k,2793) - lu(k,2867) = lu(k,2867) - lu(k,837) * lu(k,2793) - lu(k,2885) = lu(k,2885) - lu(k,838) * lu(k,2793) - lu(k,2889) = lu(k,2889) - lu(k,839) * lu(k,2793) - lu(k,2891) = lu(k,2891) - lu(k,840) * lu(k,2793) - lu(k,2894) = lu(k,2894) - lu(k,841) * lu(k,2793) - lu(k,2895) = lu(k,2895) - lu(k,842) * lu(k,2793) - lu(k,3186) = lu(k,3186) - lu(k,835) * lu(k,3184) - lu(k,3240) = lu(k,3240) - lu(k,836) * lu(k,3184) - lu(k,3263) = lu(k,3263) - lu(k,837) * lu(k,3184) - lu(k,3281) = lu(k,3281) - lu(k,838) * lu(k,3184) - lu(k,3285) = lu(k,3285) - lu(k,839) * lu(k,3184) - lu(k,3287) = lu(k,3287) - lu(k,840) * lu(k,3184) - lu(k,3290) = lu(k,3290) - lu(k,841) * lu(k,3184) - lu(k,3291) = lu(k,3291) - lu(k,842) * lu(k,3184) - lu(k,3636) = lu(k,3636) - lu(k,835) * lu(k,3633) - lu(k,3702) = lu(k,3702) - lu(k,836) * lu(k,3633) - lu(k,3724) = lu(k,3724) - lu(k,837) * lu(k,3633) - lu(k,3742) = lu(k,3742) - lu(k,838) * lu(k,3633) - lu(k,3746) = lu(k,3746) - lu(k,839) * lu(k,3633) - lu(k,3748) = lu(k,3748) - lu(k,840) * lu(k,3633) - lu(k,3751) = lu(k,3751) - lu(k,841) * lu(k,3633) - lu(k,3752) = lu(k,3752) - lu(k,842) * lu(k,3633) + lu(k,811) = 1._r8 / lu(k,811) + lu(k,812) = lu(k,812) * lu(k,811) + lu(k,813) = lu(k,813) * lu(k,811) + lu(k,814) = lu(k,814) * lu(k,811) + lu(k,815) = lu(k,815) * lu(k,811) + lu(k,816) = lu(k,816) * lu(k,811) + lu(k,817) = lu(k,817) * lu(k,811) + lu(k,818) = lu(k,818) * lu(k,811) + lu(k,1696) = - lu(k,812) * lu(k,1695) + lu(k,1697) = - lu(k,813) * lu(k,1695) + lu(k,1698) = - lu(k,814) * lu(k,1695) + lu(k,1703) = - lu(k,815) * lu(k,1695) + lu(k,1705) = lu(k,1705) - lu(k,816) * lu(k,1695) + lu(k,1706) = lu(k,1706) - lu(k,817) * lu(k,1695) + lu(k,1707) = lu(k,1707) - lu(k,818) * lu(k,1695) + lu(k,3215) = lu(k,3215) - lu(k,812) * lu(k,3203) + lu(k,3231) = lu(k,3231) - lu(k,813) * lu(k,3203) + lu(k,3249) = lu(k,3249) - lu(k,814) * lu(k,3203) + lu(k,3311) = lu(k,3311) - lu(k,815) * lu(k,3203) + lu(k,3315) = lu(k,3315) - lu(k,816) * lu(k,3203) + lu(k,3316) = lu(k,3316) - lu(k,817) * lu(k,3203) + lu(k,3320) = lu(k,3320) - lu(k,818) * lu(k,3203) + lu(k,3467) = lu(k,3467) - lu(k,812) * lu(k,3454) + lu(k,3485) = lu(k,3485) - lu(k,813) * lu(k,3454) + lu(k,3503) = lu(k,3503) - lu(k,814) * lu(k,3454) + lu(k,3567) = lu(k,3567) - lu(k,815) * lu(k,3454) + lu(k,3571) = lu(k,3571) - lu(k,816) * lu(k,3454) + lu(k,3572) = lu(k,3572) - lu(k,817) * lu(k,3454) + lu(k,3576) = lu(k,3576) - lu(k,818) * lu(k,3454) + lu(k,3704) = lu(k,3704) - lu(k,812) * lu(k,3688) + lu(k,3726) = lu(k,3726) - lu(k,813) * lu(k,3688) + lu(k,3753) = lu(k,3753) - lu(k,814) * lu(k,3688) + lu(k,3817) = lu(k,3817) - lu(k,815) * lu(k,3688) + lu(k,3821) = lu(k,3821) - lu(k,816) * lu(k,3688) + lu(k,3822) = lu(k,3822) - lu(k,817) * lu(k,3688) + lu(k,3826) = lu(k,3826) - lu(k,818) * lu(k,3688) + lu(k,819) = 1._r8 / lu(k,819) + lu(k,820) = lu(k,820) * lu(k,819) + lu(k,821) = lu(k,821) * lu(k,819) + lu(k,822) = lu(k,822) * lu(k,819) + lu(k,823) = lu(k,823) * lu(k,819) + lu(k,824) = lu(k,824) * lu(k,819) + lu(k,1416) = - lu(k,820) * lu(k,1411) + lu(k,1421) = - lu(k,821) * lu(k,1411) + lu(k,1425) = lu(k,1425) - lu(k,822) * lu(k,1411) + lu(k,1426) = lu(k,1426) - lu(k,823) * lu(k,1411) + lu(k,1427) = lu(k,1427) - lu(k,824) * lu(k,1411) + lu(k,1566) = lu(k,1566) - lu(k,820) * lu(k,1560) + lu(k,1579) = - lu(k,821) * lu(k,1560) + lu(k,1588) = - lu(k,822) * lu(k,1560) + lu(k,1590) = lu(k,1590) - lu(k,823) * lu(k,1560) + lu(k,1591) = lu(k,1591) - lu(k,824) * lu(k,1560) + lu(k,3068) = lu(k,3068) - lu(k,820) * lu(k,3049) + lu(k,3089) = lu(k,3089) - lu(k,821) * lu(k,3049) + lu(k,3131) = lu(k,3131) - lu(k,822) * lu(k,3049) + lu(k,3133) = lu(k,3133) - lu(k,823) * lu(k,3049) + lu(k,3134) = lu(k,3134) - lu(k,824) * lu(k,3049) + lu(k,3243) = lu(k,3243) - lu(k,820) * lu(k,3204) + lu(k,3270) = lu(k,3270) - lu(k,821) * lu(k,3204) + lu(k,3313) = lu(k,3313) - lu(k,822) * lu(k,3204) + lu(k,3315) = lu(k,3315) - lu(k,823) * lu(k,3204) + lu(k,3316) = lu(k,3316) - lu(k,824) * lu(k,3204) + lu(k,3497) = lu(k,3497) - lu(k,820) * lu(k,3455) + lu(k,3526) = lu(k,3526) - lu(k,821) * lu(k,3455) + lu(k,3569) = lu(k,3569) - lu(k,822) * lu(k,3455) + lu(k,3571) = lu(k,3571) - lu(k,823) * lu(k,3455) + lu(k,3572) = lu(k,3572) - lu(k,824) * lu(k,3455) + lu(k,3746) = lu(k,3746) - lu(k,820) * lu(k,3689) + lu(k,3777) = lu(k,3777) - lu(k,821) * lu(k,3689) + lu(k,3819) = lu(k,3819) - lu(k,822) * lu(k,3689) + lu(k,3821) = lu(k,3821) - lu(k,823) * lu(k,3689) + lu(k,3822) = lu(k,3822) - lu(k,824) * lu(k,3689) + lu(k,829) = 1._r8 / lu(k,829) + lu(k,830) = lu(k,830) * lu(k,829) + lu(k,831) = lu(k,831) * lu(k,829) + lu(k,832) = lu(k,832) * lu(k,829) + lu(k,833) = lu(k,833) * lu(k,829) + lu(k,834) = lu(k,834) * lu(k,829) + lu(k,835) = lu(k,835) * lu(k,829) + lu(k,836) = lu(k,836) * lu(k,829) + lu(k,837) = lu(k,837) * lu(k,829) + lu(k,838) = lu(k,838) * lu(k,829) + lu(k,839) = lu(k,839) * lu(k,829) + lu(k,892) = lu(k,892) - lu(k,830) * lu(k,891) + lu(k,893) = lu(k,893) - lu(k,831) * lu(k,891) + lu(k,894) = lu(k,894) - lu(k,832) * lu(k,891) + lu(k,895) = lu(k,895) - lu(k,833) * lu(k,891) + lu(k,896) = lu(k,896) - lu(k,834) * lu(k,891) + lu(k,897) = lu(k,897) - lu(k,835) * lu(k,891) + lu(k,898) = lu(k,898) - lu(k,836) * lu(k,891) + lu(k,899) = lu(k,899) - lu(k,837) * lu(k,891) + lu(k,901) = lu(k,901) - lu(k,838) * lu(k,891) + lu(k,902) = - lu(k,839) * lu(k,891) + lu(k,3458) = lu(k,3458) - lu(k,830) * lu(k,3456) + lu(k,3460) = lu(k,3460) - lu(k,831) * lu(k,3456) + lu(k,3461) = lu(k,3461) - lu(k,832) * lu(k,3456) + lu(k,3462) = lu(k,3462) - lu(k,833) * lu(k,3456) + lu(k,3497) = lu(k,3497) - lu(k,834) * lu(k,3456) + lu(k,3525) = lu(k,3525) - lu(k,835) * lu(k,3456) + lu(k,3526) = lu(k,3526) - lu(k,836) * lu(k,3456) + lu(k,3564) = lu(k,3564) - lu(k,837) * lu(k,3456) + lu(k,3571) = lu(k,3571) - lu(k,838) * lu(k,3456) + lu(k,3572) = lu(k,3572) - lu(k,839) * lu(k,3456) + lu(k,3693) = lu(k,3693) - lu(k,830) * lu(k,3690) + lu(k,3695) = lu(k,3695) - lu(k,831) * lu(k,3690) + lu(k,3696) = lu(k,3696) - lu(k,832) * lu(k,3690) + lu(k,3699) = lu(k,3699) - lu(k,833) * lu(k,3690) + lu(k,3746) = lu(k,3746) - lu(k,834) * lu(k,3690) + lu(k,3776) = lu(k,3776) - lu(k,835) * lu(k,3690) + lu(k,3777) = lu(k,3777) - lu(k,836) * lu(k,3690) + lu(k,3814) = lu(k,3814) - lu(k,837) * lu(k,3690) + lu(k,3821) = lu(k,3821) - lu(k,838) * lu(k,3690) + lu(k,3822) = lu(k,3822) - lu(k,839) * lu(k,3690) + lu(k,846) = 1._r8 / lu(k,846) + lu(k,847) = lu(k,847) * lu(k,846) + lu(k,848) = lu(k,848) * lu(k,846) + lu(k,849) = lu(k,849) * lu(k,846) + lu(k,850) = lu(k,850) * lu(k,846) + lu(k,851) = lu(k,851) * lu(k,846) + lu(k,852) = lu(k,852) * lu(k,846) + lu(k,853) = lu(k,853) * lu(k,846) + lu(k,854) = lu(k,854) * lu(k,846) + lu(k,855) = lu(k,855) * lu(k,846) + lu(k,856) = lu(k,856) * lu(k,846) + lu(k,3081) = lu(k,3081) - lu(k,847) * lu(k,3050) + lu(k,3102) = lu(k,3102) - lu(k,848) * lu(k,3050) + lu(k,3105) = lu(k,3105) - lu(k,849) * lu(k,3050) + lu(k,3118) = - lu(k,850) * lu(k,3050) + lu(k,3122) = - lu(k,851) * lu(k,3050) + lu(k,3127) = lu(k,3127) - lu(k,852) * lu(k,3050) + lu(k,3131) = lu(k,3131) - lu(k,853) * lu(k,3050) + lu(k,3133) = lu(k,3133) - lu(k,854) * lu(k,3050) + lu(k,3134) = lu(k,3134) - lu(k,855) * lu(k,3050) + lu(k,3136) = lu(k,3136) - lu(k,856) * lu(k,3050) + lu(k,3769) = lu(k,3769) - lu(k,847) * lu(k,3691) + lu(k,3790) = lu(k,3790) - lu(k,848) * lu(k,3691) + lu(k,3793) = lu(k,3793) - lu(k,849) * lu(k,3691) + lu(k,3806) = - lu(k,850) * lu(k,3691) + lu(k,3810) = lu(k,3810) - lu(k,851) * lu(k,3691) + lu(k,3815) = lu(k,3815) - lu(k,852) * lu(k,3691) + lu(k,3819) = lu(k,3819) - lu(k,853) * lu(k,3691) + lu(k,3821) = lu(k,3821) - lu(k,854) * lu(k,3691) + lu(k,3822) = lu(k,3822) - lu(k,855) * lu(k,3691) + lu(k,3824) = lu(k,3824) - lu(k,856) * lu(k,3691) + lu(k,3904) = - lu(k,847) * lu(k,3875) + lu(k,3925) = lu(k,3925) - lu(k,848) * lu(k,3875) + lu(k,3928) = lu(k,3928) - lu(k,849) * lu(k,3875) + lu(k,3941) = lu(k,3941) - lu(k,850) * lu(k,3875) + lu(k,3945) = lu(k,3945) - lu(k,851) * lu(k,3875) + lu(k,3950) = - lu(k,852) * lu(k,3875) + lu(k,3954) = lu(k,3954) - lu(k,853) * lu(k,3875) + lu(k,3956) = lu(k,3956) - lu(k,854) * lu(k,3875) + lu(k,3957) = lu(k,3957) - lu(k,855) * lu(k,3875) + lu(k,3959) = lu(k,3959) - lu(k,856) * lu(k,3875) + lu(k,859) = 1._r8 / lu(k,859) + lu(k,860) = lu(k,860) * lu(k,859) + lu(k,861) = lu(k,861) * lu(k,859) + lu(k,862) = lu(k,862) * lu(k,859) + lu(k,863) = lu(k,863) * lu(k,859) + lu(k,864) = lu(k,864) * lu(k,859) + lu(k,865) = lu(k,865) * lu(k,859) + lu(k,3077) = lu(k,3077) - lu(k,860) * lu(k,3051) + lu(k,3129) = lu(k,3129) - lu(k,861) * lu(k,3051) + lu(k,3131) = lu(k,3131) - lu(k,862) * lu(k,3051) + lu(k,3133) = lu(k,3133) - lu(k,863) * lu(k,3051) + lu(k,3134) = lu(k,3134) - lu(k,864) * lu(k,3051) + lu(k,3138) = lu(k,3138) - lu(k,865) * lu(k,3051) + lu(k,3258) = lu(k,3258) - lu(k,860) * lu(k,3205) + lu(k,3311) = lu(k,3311) - lu(k,861) * lu(k,3205) + lu(k,3313) = lu(k,3313) - lu(k,862) * lu(k,3205) + lu(k,3315) = lu(k,3315) - lu(k,863) * lu(k,3205) + lu(k,3316) = lu(k,3316) - lu(k,864) * lu(k,3205) + lu(k,3320) = lu(k,3320) - lu(k,865) * lu(k,3205) + lu(k,3514) = lu(k,3514) - lu(k,860) * lu(k,3457) + lu(k,3567) = lu(k,3567) - lu(k,861) * lu(k,3457) + lu(k,3569) = lu(k,3569) - lu(k,862) * lu(k,3457) + lu(k,3571) = lu(k,3571) - lu(k,863) * lu(k,3457) + lu(k,3572) = lu(k,3572) - lu(k,864) * lu(k,3457) + lu(k,3576) = lu(k,3576) - lu(k,865) * lu(k,3457) + lu(k,3765) = lu(k,3765) - lu(k,860) * lu(k,3692) + lu(k,3817) = lu(k,3817) - lu(k,861) * lu(k,3692) + lu(k,3819) = lu(k,3819) - lu(k,862) * lu(k,3692) + lu(k,3821) = lu(k,3821) - lu(k,863) * lu(k,3692) + lu(k,3822) = lu(k,3822) - lu(k,864) * lu(k,3692) + lu(k,3826) = lu(k,3826) - lu(k,865) * lu(k,3692) + lu(k,3847) = - lu(k,860) * lu(k,3836) + lu(k,3858) = - lu(k,861) * lu(k,3836) + lu(k,3860) = lu(k,3860) - lu(k,862) * lu(k,3836) + lu(k,3862) = lu(k,3862) - lu(k,863) * lu(k,3836) + lu(k,3863) = lu(k,3863) - lu(k,864) * lu(k,3836) + lu(k,3867) = - lu(k,865) * lu(k,3836) end do end subroutine lu_fac18 subroutine lu_fac19( avec_len, lu ) @@ -2920,174 +2834,193 @@ subroutine lu_fac19( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,843) = 1._r8 / lu(k,843) - lu(k,844) = lu(k,844) * lu(k,843) - lu(k,845) = lu(k,845) * lu(k,843) - lu(k,846) = lu(k,846) * lu(k,843) - lu(k,847) = lu(k,847) * lu(k,843) - lu(k,848) = lu(k,848) * lu(k,843) - lu(k,849) = lu(k,849) * lu(k,843) - lu(k,850) = lu(k,850) * lu(k,843) - lu(k,851) = lu(k,851) * lu(k,843) - lu(k,2388) = lu(k,2388) - lu(k,844) * lu(k,2384) - lu(k,2389) = - lu(k,845) * lu(k,2384) - lu(k,2390) = - lu(k,846) * lu(k,2384) - lu(k,2393) = lu(k,2393) - lu(k,847) * lu(k,2384) - lu(k,2401) = - lu(k,848) * lu(k,2384) - lu(k,2404) = lu(k,2404) - lu(k,849) * lu(k,2384) - lu(k,2407) = lu(k,2407) - lu(k,850) * lu(k,2384) - lu(k,2408) = lu(k,2408) - lu(k,851) * lu(k,2384) - lu(k,2839) = lu(k,2839) - lu(k,844) * lu(k,2794) - lu(k,2840) = lu(k,2840) - lu(k,845) * lu(k,2794) - lu(k,2866) = lu(k,2866) - lu(k,846) * lu(k,2794) - lu(k,2875) = lu(k,2875) - lu(k,847) * lu(k,2794) - lu(k,2885) = lu(k,2885) - lu(k,848) * lu(k,2794) - lu(k,2889) = lu(k,2889) - lu(k,849) * lu(k,2794) - lu(k,2894) = lu(k,2894) - lu(k,850) * lu(k,2794) - lu(k,2895) = lu(k,2895) - lu(k,851) * lu(k,2794) - lu(k,3235) = lu(k,3235) - lu(k,844) * lu(k,3185) - lu(k,3236) = lu(k,3236) - lu(k,845) * lu(k,3185) - lu(k,3262) = lu(k,3262) - lu(k,846) * lu(k,3185) - lu(k,3271) = lu(k,3271) - lu(k,847) * lu(k,3185) - lu(k,3281) = lu(k,3281) - lu(k,848) * lu(k,3185) - lu(k,3285) = lu(k,3285) - lu(k,849) * lu(k,3185) - lu(k,3290) = lu(k,3290) - lu(k,850) * lu(k,3185) - lu(k,3291) = lu(k,3291) - lu(k,851) * lu(k,3185) - lu(k,3697) = lu(k,3697) - lu(k,844) * lu(k,3634) - lu(k,3698) = lu(k,3698) - lu(k,845) * lu(k,3634) - lu(k,3723) = lu(k,3723) - lu(k,846) * lu(k,3634) - lu(k,3732) = lu(k,3732) - lu(k,847) * lu(k,3634) - lu(k,3742) = lu(k,3742) - lu(k,848) * lu(k,3634) - lu(k,3746) = lu(k,3746) - lu(k,849) * lu(k,3634) - lu(k,3751) = lu(k,3751) - lu(k,850) * lu(k,3634) - lu(k,3752) = lu(k,3752) - lu(k,851) * lu(k,3634) - lu(k,859) = 1._r8 / lu(k,859) - lu(k,860) = lu(k,860) * lu(k,859) - lu(k,861) = lu(k,861) * lu(k,859) - lu(k,862) = lu(k,862) * lu(k,859) - lu(k,863) = lu(k,863) * lu(k,859) - lu(k,864) = lu(k,864) * lu(k,859) - lu(k,865) = lu(k,865) * lu(k,859) - lu(k,866) = lu(k,866) * lu(k,859) - lu(k,867) = lu(k,867) * lu(k,859) - lu(k,868) = lu(k,868) * lu(k,859) - lu(k,869) = lu(k,869) * lu(k,859) - lu(k,870) = lu(k,870) * lu(k,859) - lu(k,2933) = lu(k,2933) - lu(k,860) * lu(k,2916) - lu(k,2962) = - lu(k,861) * lu(k,2916) - lu(k,2963) = - lu(k,862) * lu(k,2916) - lu(k,2975) = lu(k,2975) - lu(k,863) * lu(k,2916) - lu(k,2977) = lu(k,2977) - lu(k,864) * lu(k,2916) - lu(k,2982) = lu(k,2982) - lu(k,865) * lu(k,2916) - lu(k,2987) = lu(k,2987) - lu(k,866) * lu(k,2916) - lu(k,2988) = lu(k,2988) - lu(k,867) * lu(k,2916) - lu(k,2990) = lu(k,2990) - lu(k,868) * lu(k,2916) - lu(k,2992) = lu(k,2992) - lu(k,869) * lu(k,2916) - lu(k,2996) = lu(k,2996) - lu(k,870) * lu(k,2916) - lu(k,3024) = - lu(k,860) * lu(k,3008) - lu(k,3053) = lu(k,3053) - lu(k,861) * lu(k,3008) - lu(k,3055) = lu(k,3055) - lu(k,862) * lu(k,3008) - lu(k,3067) = lu(k,3067) - lu(k,863) * lu(k,3008) - lu(k,3069) = lu(k,3069) - lu(k,864) * lu(k,3008) - lu(k,3074) = lu(k,3074) - lu(k,865) * lu(k,3008) - lu(k,3079) = lu(k,3079) - lu(k,866) * lu(k,3008) - lu(k,3080) = lu(k,3080) - lu(k,867) * lu(k,3008) - lu(k,3082) = lu(k,3082) - lu(k,868) * lu(k,3008) - lu(k,3084) = lu(k,3084) - lu(k,869) * lu(k,3008) - lu(k,3088) = lu(k,3088) - lu(k,870) * lu(k,3008) - lu(k,3679) = lu(k,3679) - lu(k,860) * lu(k,3635) - lu(k,3718) = - lu(k,861) * lu(k,3635) - lu(k,3719) = lu(k,3719) - lu(k,862) * lu(k,3635) - lu(k,3731) = lu(k,3731) - lu(k,863) * lu(k,3635) - lu(k,3733) = lu(k,3733) - lu(k,864) * lu(k,3635) - lu(k,3738) = lu(k,3738) - lu(k,865) * lu(k,3635) - lu(k,3743) = lu(k,3743) - lu(k,866) * lu(k,3635) - lu(k,3744) = lu(k,3744) - lu(k,867) * lu(k,3635) - lu(k,3746) = lu(k,3746) - lu(k,868) * lu(k,3635) - lu(k,3748) = lu(k,3748) - lu(k,869) * lu(k,3635) - lu(k,3752) = lu(k,3752) - lu(k,870) * lu(k,3635) - lu(k,871) = 1._r8 / lu(k,871) - lu(k,872) = lu(k,872) * lu(k,871) - lu(k,873) = lu(k,873) * lu(k,871) - lu(k,874) = lu(k,874) * lu(k,871) - lu(k,918) = - lu(k,872) * lu(k,916) - lu(k,922) = lu(k,922) - lu(k,873) * lu(k,916) - lu(k,924) = lu(k,924) - lu(k,874) * lu(k,916) - lu(k,929) = - lu(k,872) * lu(k,925) - lu(k,931) = lu(k,931) - lu(k,873) * lu(k,925) - lu(k,933) = lu(k,933) - lu(k,874) * lu(k,925) - lu(k,1146) = - lu(k,872) * lu(k,1142) - lu(k,1150) = lu(k,1150) - lu(k,873) * lu(k,1142) - lu(k,1152) = lu(k,1152) - lu(k,874) * lu(k,1142) - lu(k,1589) = lu(k,1589) - lu(k,872) * lu(k,1587) - lu(k,1595) = lu(k,1595) - lu(k,873) * lu(k,1587) - lu(k,1597) = lu(k,1597) - lu(k,874) * lu(k,1587) - lu(k,1602) = - lu(k,872) * lu(k,1599) - lu(k,1608) = lu(k,1608) - lu(k,873) * lu(k,1599) - lu(k,1610) = lu(k,1610) - lu(k,874) * lu(k,1599) - lu(k,2177) = - lu(k,872) * lu(k,2176) - lu(k,2188) = lu(k,2188) - lu(k,873) * lu(k,2176) - lu(k,2191) = lu(k,2191) - lu(k,874) * lu(k,2176) - lu(k,2207) = lu(k,2207) - lu(k,872) * lu(k,2203) - lu(k,2227) = lu(k,2227) - lu(k,873) * lu(k,2203) - lu(k,2231) = lu(k,2231) - lu(k,874) * lu(k,2203) - lu(k,2417) = - lu(k,872) * lu(k,2413) - lu(k,2431) = lu(k,2431) - lu(k,873) * lu(k,2413) - lu(k,2435) = lu(k,2435) - lu(k,874) * lu(k,2413) - lu(k,2831) = lu(k,2831) - lu(k,872) * lu(k,2795) - lu(k,2889) = lu(k,2889) - lu(k,873) * lu(k,2795) - lu(k,2895) = lu(k,2895) - lu(k,874) * lu(k,2795) - lu(k,3227) = lu(k,3227) - lu(k,872) * lu(k,3186) - lu(k,3285) = lu(k,3285) - lu(k,873) * lu(k,3186) - lu(k,3291) = lu(k,3291) - lu(k,874) * lu(k,3186) - lu(k,3688) = lu(k,3688) - lu(k,872) * lu(k,3636) - lu(k,3746) = lu(k,3746) - lu(k,873) * lu(k,3636) - lu(k,3752) = lu(k,3752) - lu(k,874) * lu(k,3636) - lu(k,876) = 1._r8 / lu(k,876) - lu(k,877) = lu(k,877) * lu(k,876) - lu(k,878) = lu(k,878) * lu(k,876) - lu(k,879) = lu(k,879) * lu(k,876) - lu(k,880) = lu(k,880) * lu(k,876) - lu(k,881) = lu(k,881) * lu(k,876) - lu(k,882) = lu(k,882) * lu(k,876) - lu(k,883) = lu(k,883) * lu(k,876) - lu(k,884) = lu(k,884) * lu(k,876) - lu(k,885) = lu(k,885) * lu(k,876) - lu(k,886) = lu(k,886) * lu(k,876) - lu(k,887) = lu(k,887) * lu(k,876) - lu(k,2820) = lu(k,2820) - lu(k,877) * lu(k,2796) - lu(k,2832) = lu(k,2832) - lu(k,878) * lu(k,2796) - lu(k,2836) = lu(k,2836) - lu(k,879) * lu(k,2796) - lu(k,2841) = lu(k,2841) - lu(k,880) * lu(k,2796) - lu(k,2864) = lu(k,2864) - lu(k,881) * lu(k,2796) - lu(k,2882) = lu(k,2882) - lu(k,882) * lu(k,2796) - lu(k,2883) = lu(k,2883) - lu(k,883) * lu(k,2796) - lu(k,2889) = lu(k,2889) - lu(k,884) * lu(k,2796) - lu(k,2891) = lu(k,2891) - lu(k,885) * lu(k,2796) - lu(k,2894) = lu(k,2894) - lu(k,886) * lu(k,2796) - lu(k,2895) = lu(k,2895) - lu(k,887) * lu(k,2796) - lu(k,3022) = lu(k,3022) - lu(k,877) * lu(k,3009) - lu(k,3028) = - lu(k,878) * lu(k,3009) - lu(k,3031) = lu(k,3031) - lu(k,879) * lu(k,3009) - lu(k,3036) = lu(k,3036) - lu(k,880) * lu(k,3009) - lu(k,3057) = lu(k,3057) - lu(k,881) * lu(k,3009) - lu(k,3075) = lu(k,3075) - lu(k,882) * lu(k,3009) - lu(k,3076) = lu(k,3076) - lu(k,883) * lu(k,3009) - lu(k,3082) = lu(k,3082) - lu(k,884) * lu(k,3009) - lu(k,3084) = lu(k,3084) - lu(k,885) * lu(k,3009) - lu(k,3087) = lu(k,3087) - lu(k,886) * lu(k,3009) - lu(k,3088) = lu(k,3088) - lu(k,887) * lu(k,3009) - lu(k,3674) = lu(k,3674) - lu(k,877) * lu(k,3637) - lu(k,3689) = lu(k,3689) - lu(k,878) * lu(k,3637) - lu(k,3694) = lu(k,3694) - lu(k,879) * lu(k,3637) - lu(k,3699) = lu(k,3699) - lu(k,880) * lu(k,3637) - lu(k,3721) = lu(k,3721) - lu(k,881) * lu(k,3637) - lu(k,3739) = lu(k,3739) - lu(k,882) * lu(k,3637) - lu(k,3740) = lu(k,3740) - lu(k,883) * lu(k,3637) - lu(k,3746) = lu(k,3746) - lu(k,884) * lu(k,3637) - lu(k,3748) = lu(k,3748) - lu(k,885) * lu(k,3637) - lu(k,3751) = lu(k,3751) - lu(k,886) * lu(k,3637) - lu(k,3752) = lu(k,3752) - lu(k,887) * lu(k,3637) + lu(k,866) = 1._r8 / lu(k,866) + lu(k,867) = lu(k,867) * lu(k,866) + lu(k,868) = lu(k,868) * lu(k,866) + lu(k,869) = lu(k,869) * lu(k,866) + lu(k,870) = lu(k,870) * lu(k,866) + lu(k,871) = lu(k,871) * lu(k,866) + lu(k,880) = lu(k,880) - lu(k,867) * lu(k,876) + lu(k,882) = lu(k,882) - lu(k,868) * lu(k,876) + lu(k,883) = lu(k,883) - lu(k,869) * lu(k,876) + lu(k,884) = lu(k,884) - lu(k,870) * lu(k,876) + lu(k,886) = lu(k,886) - lu(k,871) * lu(k,876) + lu(k,896) = lu(k,896) - lu(k,867) * lu(k,892) + lu(k,898) = lu(k,898) - lu(k,868) * lu(k,892) + lu(k,900) = lu(k,900) - lu(k,869) * lu(k,892) + lu(k,901) = lu(k,901) - lu(k,870) * lu(k,892) + lu(k,903) = lu(k,903) - lu(k,871) * lu(k,892) + lu(k,3243) = lu(k,3243) - lu(k,867) * lu(k,3206) + lu(k,3270) = lu(k,3270) - lu(k,868) * lu(k,3206) + lu(k,3311) = lu(k,3311) - lu(k,869) * lu(k,3206) + lu(k,3315) = lu(k,3315) - lu(k,870) * lu(k,3206) + lu(k,3320) = lu(k,3320) - lu(k,871) * lu(k,3206) + lu(k,3497) = lu(k,3497) - lu(k,867) * lu(k,3458) + lu(k,3526) = lu(k,3526) - lu(k,868) * lu(k,3458) + lu(k,3567) = lu(k,3567) - lu(k,869) * lu(k,3458) + lu(k,3571) = lu(k,3571) - lu(k,870) * lu(k,3458) + lu(k,3576) = lu(k,3576) - lu(k,871) * lu(k,3458) + lu(k,3746) = lu(k,3746) - lu(k,867) * lu(k,3693) + lu(k,3777) = lu(k,3777) - lu(k,868) * lu(k,3693) + lu(k,3817) = lu(k,3817) - lu(k,869) * lu(k,3693) + lu(k,3821) = lu(k,3821) - lu(k,870) * lu(k,3693) + lu(k,3826) = lu(k,3826) - lu(k,871) * lu(k,3693) + lu(k,4076) = - lu(k,867) * lu(k,4069) + lu(k,4082) = lu(k,4082) - lu(k,868) * lu(k,4069) + lu(k,4096) = lu(k,4096) - lu(k,869) * lu(k,4069) + lu(k,4100) = lu(k,4100) - lu(k,870) * lu(k,4069) + lu(k,4105) = lu(k,4105) - lu(k,871) * lu(k,4069) + lu(k,877) = 1._r8 / lu(k,877) + lu(k,878) = lu(k,878) * lu(k,877) + lu(k,879) = lu(k,879) * lu(k,877) + lu(k,880) = lu(k,880) * lu(k,877) + lu(k,881) = lu(k,881) * lu(k,877) + lu(k,882) = lu(k,882) * lu(k,877) + lu(k,883) = lu(k,883) * lu(k,877) + lu(k,884) = lu(k,884) * lu(k,877) + lu(k,885) = lu(k,885) * lu(k,877) + lu(k,886) = lu(k,886) * lu(k,877) + lu(k,3209) = lu(k,3209) - lu(k,878) * lu(k,3207) + lu(k,3210) = lu(k,3210) - lu(k,879) * lu(k,3207) + lu(k,3243) = lu(k,3243) - lu(k,880) * lu(k,3207) + lu(k,3269) = lu(k,3269) - lu(k,881) * lu(k,3207) + lu(k,3270) = lu(k,3270) - lu(k,882) * lu(k,3207) + lu(k,3311) = lu(k,3311) - lu(k,883) * lu(k,3207) + lu(k,3315) = lu(k,3315) - lu(k,884) * lu(k,3207) + lu(k,3316) = lu(k,3316) - lu(k,885) * lu(k,3207) + lu(k,3320) = lu(k,3320) - lu(k,886) * lu(k,3207) + lu(k,3461) = lu(k,3461) - lu(k,878) * lu(k,3459) + lu(k,3462) = lu(k,3462) - lu(k,879) * lu(k,3459) + lu(k,3497) = lu(k,3497) - lu(k,880) * lu(k,3459) + lu(k,3525) = lu(k,3525) - lu(k,881) * lu(k,3459) + lu(k,3526) = lu(k,3526) - lu(k,882) * lu(k,3459) + lu(k,3567) = lu(k,3567) - lu(k,883) * lu(k,3459) + lu(k,3571) = lu(k,3571) - lu(k,884) * lu(k,3459) + lu(k,3572) = lu(k,3572) - lu(k,885) * lu(k,3459) + lu(k,3576) = lu(k,3576) - lu(k,886) * lu(k,3459) + lu(k,3696) = lu(k,3696) - lu(k,878) * lu(k,3694) + lu(k,3699) = lu(k,3699) - lu(k,879) * lu(k,3694) + lu(k,3746) = lu(k,3746) - lu(k,880) * lu(k,3694) + lu(k,3776) = lu(k,3776) - lu(k,881) * lu(k,3694) + lu(k,3777) = lu(k,3777) - lu(k,882) * lu(k,3694) + lu(k,3817) = lu(k,3817) - lu(k,883) * lu(k,3694) + lu(k,3821) = lu(k,3821) - lu(k,884) * lu(k,3694) + lu(k,3822) = lu(k,3822) - lu(k,885) * lu(k,3694) + lu(k,3826) = lu(k,3826) - lu(k,886) * lu(k,3694) + lu(k,893) = 1._r8 / lu(k,893) + lu(k,894) = lu(k,894) * lu(k,893) + lu(k,895) = lu(k,895) * lu(k,893) + lu(k,896) = lu(k,896) * lu(k,893) + lu(k,897) = lu(k,897) * lu(k,893) + lu(k,898) = lu(k,898) * lu(k,893) + lu(k,899) = lu(k,899) * lu(k,893) + lu(k,900) = lu(k,900) * lu(k,893) + lu(k,901) = lu(k,901) * lu(k,893) + lu(k,902) = lu(k,902) * lu(k,893) + lu(k,903) = lu(k,903) * lu(k,893) + lu(k,3209) = lu(k,3209) - lu(k,894) * lu(k,3208) + lu(k,3210) = lu(k,3210) - lu(k,895) * lu(k,3208) + lu(k,3243) = lu(k,3243) - lu(k,896) * lu(k,3208) + lu(k,3269) = lu(k,3269) - lu(k,897) * lu(k,3208) + lu(k,3270) = lu(k,3270) - lu(k,898) * lu(k,3208) + lu(k,3308) = lu(k,3308) - lu(k,899) * lu(k,3208) + lu(k,3311) = lu(k,3311) - lu(k,900) * lu(k,3208) + lu(k,3315) = lu(k,3315) - lu(k,901) * lu(k,3208) + lu(k,3316) = lu(k,3316) - lu(k,902) * lu(k,3208) + lu(k,3320) = lu(k,3320) - lu(k,903) * lu(k,3208) + lu(k,3461) = lu(k,3461) - lu(k,894) * lu(k,3460) + lu(k,3462) = lu(k,3462) - lu(k,895) * lu(k,3460) + lu(k,3497) = lu(k,3497) - lu(k,896) * lu(k,3460) + lu(k,3525) = lu(k,3525) - lu(k,897) * lu(k,3460) + lu(k,3526) = lu(k,3526) - lu(k,898) * lu(k,3460) + lu(k,3564) = lu(k,3564) - lu(k,899) * lu(k,3460) + lu(k,3567) = lu(k,3567) - lu(k,900) * lu(k,3460) + lu(k,3571) = lu(k,3571) - lu(k,901) * lu(k,3460) + lu(k,3572) = lu(k,3572) - lu(k,902) * lu(k,3460) + lu(k,3576) = lu(k,3576) - lu(k,903) * lu(k,3460) + lu(k,3696) = lu(k,3696) - lu(k,894) * lu(k,3695) + lu(k,3699) = lu(k,3699) - lu(k,895) * lu(k,3695) + lu(k,3746) = lu(k,3746) - lu(k,896) * lu(k,3695) + lu(k,3776) = lu(k,3776) - lu(k,897) * lu(k,3695) + lu(k,3777) = lu(k,3777) - lu(k,898) * lu(k,3695) + lu(k,3814) = lu(k,3814) - lu(k,899) * lu(k,3695) + lu(k,3817) = lu(k,3817) - lu(k,900) * lu(k,3695) + lu(k,3821) = lu(k,3821) - lu(k,901) * lu(k,3695) + lu(k,3822) = lu(k,3822) - lu(k,902) * lu(k,3695) + lu(k,3826) = lu(k,3826) - lu(k,903) * lu(k,3695) + lu(k,904) = 1._r8 / lu(k,904) + lu(k,905) = lu(k,905) * lu(k,904) + lu(k,906) = lu(k,906) * lu(k,904) + lu(k,907) = lu(k,907) * lu(k,904) + lu(k,908) = lu(k,908) * lu(k,904) + lu(k,909) = lu(k,909) * lu(k,904) + lu(k,910) = lu(k,910) * lu(k,904) + lu(k,911) = lu(k,911) * lu(k,904) + lu(k,3269) = lu(k,3269) - lu(k,905) * lu(k,3209) + lu(k,3270) = lu(k,3270) - lu(k,906) * lu(k,3209) + lu(k,3311) = lu(k,3311) - lu(k,907) * lu(k,3209) + lu(k,3315) = lu(k,3315) - lu(k,908) * lu(k,3209) + lu(k,3316) = lu(k,3316) - lu(k,909) * lu(k,3209) + lu(k,3319) = lu(k,3319) - lu(k,910) * lu(k,3209) + lu(k,3320) = lu(k,3320) - lu(k,911) * lu(k,3209) + lu(k,3525) = lu(k,3525) - lu(k,905) * lu(k,3461) + lu(k,3526) = lu(k,3526) - lu(k,906) * lu(k,3461) + lu(k,3567) = lu(k,3567) - lu(k,907) * lu(k,3461) + lu(k,3571) = lu(k,3571) - lu(k,908) * lu(k,3461) + lu(k,3572) = lu(k,3572) - lu(k,909) * lu(k,3461) + lu(k,3575) = lu(k,3575) - lu(k,910) * lu(k,3461) + lu(k,3576) = lu(k,3576) - lu(k,911) * lu(k,3461) + lu(k,3776) = lu(k,3776) - lu(k,905) * lu(k,3696) + lu(k,3777) = lu(k,3777) - lu(k,906) * lu(k,3696) + lu(k,3817) = lu(k,3817) - lu(k,907) * lu(k,3696) + lu(k,3821) = lu(k,3821) - lu(k,908) * lu(k,3696) + lu(k,3822) = lu(k,3822) - lu(k,909) * lu(k,3696) + lu(k,3825) = lu(k,3825) - lu(k,910) * lu(k,3696) + lu(k,3826) = lu(k,3826) - lu(k,911) * lu(k,3696) + lu(k,4081) = - lu(k,905) * lu(k,4070) + lu(k,4082) = lu(k,4082) - lu(k,906) * lu(k,4070) + lu(k,4096) = lu(k,4096) - lu(k,907) * lu(k,4070) + lu(k,4100) = lu(k,4100) - lu(k,908) * lu(k,4070) + lu(k,4101) = lu(k,4101) - lu(k,909) * lu(k,4070) + lu(k,4104) = lu(k,4104) - lu(k,910) * lu(k,4070) + lu(k,4105) = lu(k,4105) - lu(k,911) * lu(k,4070) + lu(k,912) = 1._r8 / lu(k,912) + lu(k,913) = lu(k,913) * lu(k,912) + lu(k,914) = lu(k,914) * lu(k,912) + lu(k,915) = lu(k,915) * lu(k,912) + lu(k,916) = lu(k,916) * lu(k,912) + lu(k,1739) = - lu(k,913) * lu(k,1735) + lu(k,1741) = - lu(k,914) * lu(k,1735) + lu(k,1752) = lu(k,1752) - lu(k,915) * lu(k,1735) + lu(k,1753) = lu(k,1753) - lu(k,916) * lu(k,1735) + lu(k,1767) = - lu(k,913) * lu(k,1763) + lu(k,1768) = - lu(k,914) * lu(k,1763) + lu(k,1780) = lu(k,1780) - lu(k,915) * lu(k,1763) + lu(k,1781) = lu(k,1781) - lu(k,916) * lu(k,1763) + lu(k,1812) = - lu(k,913) * lu(k,1805) + lu(k,1814) = - lu(k,914) * lu(k,1805) + lu(k,1828) = lu(k,1828) - lu(k,915) * lu(k,1805) + lu(k,1829) = lu(k,1829) - lu(k,916) * lu(k,1805) + lu(k,1844) = - lu(k,913) * lu(k,1836) + lu(k,1845) = - lu(k,914) * lu(k,1836) + lu(k,1859) = lu(k,1859) - lu(k,915) * lu(k,1836) + lu(k,1860) = lu(k,1860) - lu(k,916) * lu(k,1836) + lu(k,1948) = - lu(k,913) * lu(k,1942) + lu(k,1951) = - lu(k,914) * lu(k,1942) + lu(k,1969) = lu(k,1969) - lu(k,915) * lu(k,1942) + lu(k,1970) = lu(k,1970) - lu(k,916) * lu(k,1942) + lu(k,1985) = - lu(k,913) * lu(k,1978) + lu(k,1987) = - lu(k,914) * lu(k,1978) + lu(k,2008) = lu(k,2008) - lu(k,915) * lu(k,1978) + lu(k,2009) = lu(k,2009) - lu(k,916) * lu(k,1978) + lu(k,3765) = lu(k,3765) - lu(k,913) * lu(k,3697) + lu(k,3769) = lu(k,3769) - lu(k,914) * lu(k,3697) + lu(k,3821) = lu(k,3821) - lu(k,915) * lu(k,3697) + lu(k,3822) = lu(k,3822) - lu(k,916) * lu(k,3697) + lu(k,3993) = lu(k,3993) - lu(k,913) * lu(k,3968) + lu(k,3997) = lu(k,3997) - lu(k,914) * lu(k,3968) + lu(k,4048) = lu(k,4048) - lu(k,915) * lu(k,3968) + lu(k,4049) = lu(k,4049) - lu(k,916) * lu(k,3968) end do end subroutine lu_fac19 subroutine lu_fac20( avec_len, lu ) @@ -3104,178 +3037,207 @@ subroutine lu_fac20( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,888) = 1._r8 / lu(k,888) - lu(k,889) = lu(k,889) * lu(k,888) - lu(k,890) = lu(k,890) * lu(k,888) - lu(k,891) = lu(k,891) * lu(k,888) - lu(k,892) = lu(k,892) * lu(k,888) - lu(k,893) = lu(k,893) * lu(k,888) - lu(k,894) = lu(k,894) * lu(k,888) - lu(k,895) = lu(k,895) * lu(k,888) - lu(k,1146) = lu(k,1146) - lu(k,889) * lu(k,1143) - lu(k,1147) = - lu(k,890) * lu(k,1143) - lu(k,1148) = - lu(k,891) * lu(k,1143) - lu(k,1150) = lu(k,1150) - lu(k,892) * lu(k,1143) - lu(k,1151) = lu(k,1151) - lu(k,893) * lu(k,1143) - lu(k,1152) = lu(k,1152) - lu(k,894) * lu(k,1143) - lu(k,1153) = - lu(k,895) * lu(k,1143) - lu(k,2329) = lu(k,2329) - lu(k,889) * lu(k,2323) - lu(k,2331) = - lu(k,890) * lu(k,2323) - lu(k,2332) = lu(k,2332) - lu(k,891) * lu(k,2323) - lu(k,2344) = lu(k,2344) - lu(k,892) * lu(k,2323) - lu(k,2347) = lu(k,2347) - lu(k,893) * lu(k,2323) - lu(k,2348) = lu(k,2348) - lu(k,894) * lu(k,2323) - lu(k,2349) = - lu(k,895) * lu(k,2323) - lu(k,2831) = lu(k,2831) - lu(k,889) * lu(k,2797) - lu(k,2867) = lu(k,2867) - lu(k,890) * lu(k,2797) - lu(k,2872) = lu(k,2872) - lu(k,891) * lu(k,2797) - lu(k,2889) = lu(k,2889) - lu(k,892) * lu(k,2797) - lu(k,2894) = lu(k,2894) - lu(k,893) * lu(k,2797) - lu(k,2895) = lu(k,2895) - lu(k,894) * lu(k,2797) - lu(k,2899) = lu(k,2899) - lu(k,895) * lu(k,2797) - lu(k,3227) = lu(k,3227) - lu(k,889) * lu(k,3187) - lu(k,3263) = lu(k,3263) - lu(k,890) * lu(k,3187) - lu(k,3268) = lu(k,3268) - lu(k,891) * lu(k,3187) - lu(k,3285) = lu(k,3285) - lu(k,892) * lu(k,3187) - lu(k,3290) = lu(k,3290) - lu(k,893) * lu(k,3187) - lu(k,3291) = lu(k,3291) - lu(k,894) * lu(k,3187) - lu(k,3295) = lu(k,3295) - lu(k,895) * lu(k,3187) - lu(k,3688) = lu(k,3688) - lu(k,889) * lu(k,3638) - lu(k,3724) = lu(k,3724) - lu(k,890) * lu(k,3638) - lu(k,3729) = lu(k,3729) - lu(k,891) * lu(k,3638) - lu(k,3746) = lu(k,3746) - lu(k,892) * lu(k,3638) - lu(k,3751) = lu(k,3751) - lu(k,893) * lu(k,3638) - lu(k,3752) = lu(k,3752) - lu(k,894) * lu(k,3638) - lu(k,3756) = lu(k,3756) - lu(k,895) * lu(k,3638) - lu(k,897) = 1._r8 / lu(k,897) - lu(k,898) = lu(k,898) * lu(k,897) - lu(k,899) = lu(k,899) * lu(k,897) - lu(k,900) = lu(k,900) * lu(k,897) - lu(k,901) = lu(k,901) * lu(k,897) - lu(k,902) = lu(k,902) * lu(k,897) - lu(k,903) = lu(k,903) * lu(k,897) - lu(k,904) = lu(k,904) * lu(k,897) - lu(k,1416) = lu(k,1416) - lu(k,898) * lu(k,1415) - lu(k,1417) = - lu(k,899) * lu(k,1415) - lu(k,1418) = lu(k,1418) - lu(k,900) * lu(k,1415) - lu(k,1419) = - lu(k,901) * lu(k,1415) - lu(k,1421) = - lu(k,902) * lu(k,1415) - lu(k,1423) = lu(k,1423) - lu(k,903) * lu(k,1415) - lu(k,1426) = lu(k,1426) - lu(k,904) * lu(k,1415) - lu(k,2716) = - lu(k,898) * lu(k,2715) - lu(k,2717) = lu(k,2717) - lu(k,899) * lu(k,2715) - lu(k,2718) = lu(k,2718) - lu(k,900) * lu(k,2715) - lu(k,2719) = lu(k,2719) - lu(k,901) * lu(k,2715) - lu(k,2721) = - lu(k,902) * lu(k,2715) - lu(k,2724) = lu(k,2724) - lu(k,903) * lu(k,2715) - lu(k,2727) = lu(k,2727) - lu(k,904) * lu(k,2715) - lu(k,3098) = lu(k,3098) - lu(k,898) * lu(k,3096) - lu(k,3100) = - lu(k,899) * lu(k,3096) - lu(k,3101) = lu(k,3101) - lu(k,900) * lu(k,3096) - lu(k,3104) = - lu(k,901) * lu(k,3096) - lu(k,3109) = lu(k,3109) - lu(k,902) * lu(k,3096) - lu(k,3112) = lu(k,3112) - lu(k,903) * lu(k,3096) - lu(k,3116) = lu(k,3116) - lu(k,904) * lu(k,3096) - lu(k,3686) = lu(k,3686) - lu(k,898) * lu(k,3639) - lu(k,3740) = lu(k,3740) - lu(k,899) * lu(k,3639) - lu(k,3741) = lu(k,3741) - lu(k,900) * lu(k,3639) - lu(k,3744) = lu(k,3744) - lu(k,901) * lu(k,3639) - lu(k,3749) = lu(k,3749) - lu(k,902) * lu(k,3639) - lu(k,3752) = lu(k,3752) - lu(k,903) * lu(k,3639) - lu(k,3756) = lu(k,3756) - lu(k,904) * lu(k,3639) - lu(k,3843) = lu(k,3843) - lu(k,898) * lu(k,3841) - lu(k,3846) = - lu(k,899) * lu(k,3841) - lu(k,3847) = lu(k,3847) - lu(k,900) * lu(k,3841) - lu(k,3850) = - lu(k,901) * lu(k,3841) - lu(k,3855) = - lu(k,902) * lu(k,3841) - lu(k,3858) = lu(k,3858) - lu(k,903) * lu(k,3841) - lu(k,3862) = lu(k,3862) - lu(k,904) * lu(k,3841) - lu(k,906) = 1._r8 / lu(k,906) - lu(k,907) = lu(k,907) * lu(k,906) - lu(k,908) = lu(k,908) * lu(k,906) - lu(k,909) = lu(k,909) * lu(k,906) - lu(k,910) = lu(k,910) * lu(k,906) - lu(k,911) = lu(k,911) * lu(k,906) - lu(k,912) = lu(k,912) * lu(k,906) - lu(k,913) = lu(k,913) * lu(k,906) - lu(k,3242) = lu(k,3242) - lu(k,907) * lu(k,3188) - lu(k,3289) = lu(k,3289) - lu(k,908) * lu(k,3188) - lu(k,3291) = lu(k,3291) - lu(k,909) * lu(k,3188) - lu(k,3292) = lu(k,3292) - lu(k,910) * lu(k,3188) - lu(k,3293) = lu(k,3293) - lu(k,911) * lu(k,3188) - lu(k,3294) = lu(k,3294) - lu(k,912) * lu(k,3188) - lu(k,3295) = lu(k,3295) - lu(k,913) * lu(k,3188) - lu(k,3449) = lu(k,3449) - lu(k,907) * lu(k,3440) - lu(k,3460) = lu(k,3460) - lu(k,908) * lu(k,3440) - lu(k,3462) = lu(k,3462) - lu(k,909) * lu(k,3440) - lu(k,3463) = lu(k,3463) - lu(k,910) * lu(k,3440) - lu(k,3464) = lu(k,3464) - lu(k,911) * lu(k,3440) - lu(k,3465) = lu(k,3465) - lu(k,912) * lu(k,3440) - lu(k,3466) = - lu(k,913) * lu(k,3440) - lu(k,3492) = lu(k,3492) - lu(k,907) * lu(k,3483) - lu(k,3510) = lu(k,3510) - lu(k,908) * lu(k,3483) - lu(k,3512) = lu(k,3512) - lu(k,909) * lu(k,3483) - lu(k,3513) = - lu(k,910) * lu(k,3483) - lu(k,3514) = lu(k,3514) - lu(k,911) * lu(k,3483) - lu(k,3515) = - lu(k,912) * lu(k,3483) - lu(k,3516) = lu(k,3516) - lu(k,913) * lu(k,3483) - lu(k,3762) = lu(k,3762) - lu(k,907) * lu(k,3759) - lu(k,3772) = lu(k,3772) - lu(k,908) * lu(k,3759) - lu(k,3774) = lu(k,3774) - lu(k,909) * lu(k,3759) - lu(k,3775) = lu(k,3775) - lu(k,910) * lu(k,3759) - lu(k,3776) = - lu(k,911) * lu(k,3759) - lu(k,3777) = lu(k,3777) - lu(k,912) * lu(k,3759) - lu(k,3778) = lu(k,3778) - lu(k,913) * lu(k,3759) - lu(k,3785) = lu(k,3785) - lu(k,907) * lu(k,3782) - lu(k,3796) = lu(k,3796) - lu(k,908) * lu(k,3782) - lu(k,3798) = lu(k,3798) - lu(k,909) * lu(k,3782) - lu(k,3799) = - lu(k,910) * lu(k,3782) - lu(k,3800) = lu(k,3800) - lu(k,911) * lu(k,3782) - lu(k,3801) = lu(k,3801) - lu(k,912) * lu(k,3782) - lu(k,3802) = - lu(k,913) * lu(k,3782) lu(k,917) = 1._r8 / lu(k,917) lu(k,918) = lu(k,918) * lu(k,917) lu(k,919) = lu(k,919) * lu(k,917) lu(k,920) = lu(k,920) * lu(k,917) lu(k,921) = lu(k,921) * lu(k,917) - lu(k,922) = lu(k,922) * lu(k,917) - lu(k,923) = lu(k,923) * lu(k,917) - lu(k,924) = lu(k,924) * lu(k,917) - lu(k,2095) = - lu(k,918) * lu(k,2093) - lu(k,2097) = - lu(k,919) * lu(k,2093) - lu(k,2098) = - lu(k,920) * lu(k,2093) - lu(k,2107) = lu(k,2107) - lu(k,921) * lu(k,2093) - lu(k,2109) = lu(k,2109) - lu(k,922) * lu(k,2093) - lu(k,2112) = lu(k,2112) - lu(k,923) * lu(k,2093) - lu(k,2113) = lu(k,2113) - lu(k,924) * lu(k,2093) - lu(k,2265) = - lu(k,918) * lu(k,2263) - lu(k,2269) = - lu(k,919) * lu(k,2263) - lu(k,2270) = - lu(k,920) * lu(k,2263) - lu(k,2283) = lu(k,2283) - lu(k,921) * lu(k,2263) - lu(k,2285) = lu(k,2285) - lu(k,922) * lu(k,2263) - lu(k,2288) = lu(k,2288) - lu(k,923) * lu(k,2263) - lu(k,2289) = lu(k,2289) - lu(k,924) * lu(k,2263) - lu(k,2831) = lu(k,2831) - lu(k,918) * lu(k,2798) - lu(k,2866) = lu(k,2866) - lu(k,919) * lu(k,2798) - lu(k,2867) = lu(k,2867) - lu(k,920) * lu(k,2798) - lu(k,2885) = lu(k,2885) - lu(k,921) * lu(k,2798) - lu(k,2889) = lu(k,2889) - lu(k,922) * lu(k,2798) - lu(k,2894) = lu(k,2894) - lu(k,923) * lu(k,2798) - lu(k,2895) = lu(k,2895) - lu(k,924) * lu(k,2798) - lu(k,3227) = lu(k,3227) - lu(k,918) * lu(k,3189) - lu(k,3262) = lu(k,3262) - lu(k,919) * lu(k,3189) - lu(k,3263) = lu(k,3263) - lu(k,920) * lu(k,3189) - lu(k,3281) = lu(k,3281) - lu(k,921) * lu(k,3189) - lu(k,3285) = lu(k,3285) - lu(k,922) * lu(k,3189) - lu(k,3290) = lu(k,3290) - lu(k,923) * lu(k,3189) - lu(k,3291) = lu(k,3291) - lu(k,924) * lu(k,3189) - lu(k,3688) = lu(k,3688) - lu(k,918) * lu(k,3640) - lu(k,3723) = lu(k,3723) - lu(k,919) * lu(k,3640) - lu(k,3724) = lu(k,3724) - lu(k,920) * lu(k,3640) - lu(k,3742) = lu(k,3742) - lu(k,921) * lu(k,3640) - lu(k,3746) = lu(k,3746) - lu(k,922) * lu(k,3640) - lu(k,3751) = lu(k,3751) - lu(k,923) * lu(k,3640) - lu(k,3752) = lu(k,3752) - lu(k,924) * lu(k,3640) + lu(k,1182) = - lu(k,918) * lu(k,1177) + lu(k,1183) = lu(k,1183) - lu(k,919) * lu(k,1177) + lu(k,1184) = - lu(k,920) * lu(k,1177) + lu(k,1190) = lu(k,1190) - lu(k,921) * lu(k,1177) + lu(k,1268) = lu(k,1268) - lu(k,918) * lu(k,1263) + lu(k,1269) = - lu(k,919) * lu(k,1263) + lu(k,1270) = lu(k,1270) - lu(k,920) * lu(k,1263) + lu(k,1273) = lu(k,1273) - lu(k,921) * lu(k,1263) + lu(k,1525) = - lu(k,918) * lu(k,1519) + lu(k,1527) = - lu(k,919) * lu(k,1519) + lu(k,1528) = - lu(k,920) * lu(k,1519) + lu(k,1530) = - lu(k,921) * lu(k,1519) + lu(k,1814) = lu(k,1814) - lu(k,918) * lu(k,1806) + lu(k,1818) = lu(k,1818) - lu(k,919) * lu(k,1806) + lu(k,1819) = lu(k,1819) - lu(k,920) * lu(k,1806) + lu(k,1826) = lu(k,1826) - lu(k,921) * lu(k,1806) + lu(k,1845) = lu(k,1845) - lu(k,918) * lu(k,1837) + lu(k,1849) = lu(k,1849) - lu(k,919) * lu(k,1837) + lu(k,1850) = lu(k,1850) - lu(k,920) * lu(k,1837) + lu(k,1857) = lu(k,1857) - lu(k,921) * lu(k,1837) + lu(k,1891) = lu(k,1891) - lu(k,918) * lu(k,1884) + lu(k,1895) = lu(k,1895) - lu(k,919) * lu(k,1884) + lu(k,1896) = lu(k,1896) - lu(k,920) * lu(k,1884) + lu(k,1904) = lu(k,1904) - lu(k,921) * lu(k,1884) + lu(k,2134) = - lu(k,918) * lu(k,2125) + lu(k,2137) = lu(k,2137) - lu(k,919) * lu(k,2125) + lu(k,2138) = lu(k,2138) - lu(k,920) * lu(k,2125) + lu(k,2146) = - lu(k,921) * lu(k,2125) + lu(k,3769) = lu(k,3769) - lu(k,918) * lu(k,3698) + lu(k,3776) = lu(k,3776) - lu(k,919) * lu(k,3698) + lu(k,3777) = lu(k,3777) - lu(k,920) * lu(k,3698) + lu(k,3819) = lu(k,3819) - lu(k,921) * lu(k,3698) + lu(k,922) = 1._r8 / lu(k,922) + lu(k,923) = lu(k,923) * lu(k,922) + lu(k,924) = lu(k,924) * lu(k,922) + lu(k,925) = lu(k,925) * lu(k,922) + lu(k,926) = lu(k,926) * lu(k,922) + lu(k,927) = lu(k,927) * lu(k,922) + lu(k,928) = lu(k,928) * lu(k,922) + lu(k,929) = lu(k,929) * lu(k,922) + lu(k,930) = lu(k,930) * lu(k,922) + lu(k,3243) = lu(k,3243) - lu(k,923) * lu(k,3210) + lu(k,3269) = lu(k,3269) - lu(k,924) * lu(k,3210) + lu(k,3270) = lu(k,3270) - lu(k,925) * lu(k,3210) + lu(k,3311) = lu(k,3311) - lu(k,926) * lu(k,3210) + lu(k,3315) = lu(k,3315) - lu(k,927) * lu(k,3210) + lu(k,3316) = lu(k,3316) - lu(k,928) * lu(k,3210) + lu(k,3319) = lu(k,3319) - lu(k,929) * lu(k,3210) + lu(k,3320) = lu(k,3320) - lu(k,930) * lu(k,3210) + lu(k,3497) = lu(k,3497) - lu(k,923) * lu(k,3462) + lu(k,3525) = lu(k,3525) - lu(k,924) * lu(k,3462) + lu(k,3526) = lu(k,3526) - lu(k,925) * lu(k,3462) + lu(k,3567) = lu(k,3567) - lu(k,926) * lu(k,3462) + lu(k,3571) = lu(k,3571) - lu(k,927) * lu(k,3462) + lu(k,3572) = lu(k,3572) - lu(k,928) * lu(k,3462) + lu(k,3575) = lu(k,3575) - lu(k,929) * lu(k,3462) + lu(k,3576) = lu(k,3576) - lu(k,930) * lu(k,3462) + lu(k,3746) = lu(k,3746) - lu(k,923) * lu(k,3699) + lu(k,3776) = lu(k,3776) - lu(k,924) * lu(k,3699) + lu(k,3777) = lu(k,3777) - lu(k,925) * lu(k,3699) + lu(k,3817) = lu(k,3817) - lu(k,926) * lu(k,3699) + lu(k,3821) = lu(k,3821) - lu(k,927) * lu(k,3699) + lu(k,3822) = lu(k,3822) - lu(k,928) * lu(k,3699) + lu(k,3825) = lu(k,3825) - lu(k,929) * lu(k,3699) + lu(k,3826) = lu(k,3826) - lu(k,930) * lu(k,3699) + lu(k,4076) = lu(k,4076) - lu(k,923) * lu(k,4071) + lu(k,4081) = lu(k,4081) - lu(k,924) * lu(k,4071) + lu(k,4082) = lu(k,4082) - lu(k,925) * lu(k,4071) + lu(k,4096) = lu(k,4096) - lu(k,926) * lu(k,4071) + lu(k,4100) = lu(k,4100) - lu(k,927) * lu(k,4071) + lu(k,4101) = lu(k,4101) - lu(k,928) * lu(k,4071) + lu(k,4104) = lu(k,4104) - lu(k,929) * lu(k,4071) + lu(k,4105) = lu(k,4105) - lu(k,930) * lu(k,4071) + lu(k,932) = 1._r8 / lu(k,932) + lu(k,933) = lu(k,933) * lu(k,932) + lu(k,934) = lu(k,934) * lu(k,932) + lu(k,935) = lu(k,935) * lu(k,932) + lu(k,936) = lu(k,936) * lu(k,932) + lu(k,937) = lu(k,937) * lu(k,932) + lu(k,938) = lu(k,938) * lu(k,932) + lu(k,939) = lu(k,939) * lu(k,932) + lu(k,940) = lu(k,940) * lu(k,932) + lu(k,1366) = lu(k,1366) - lu(k,933) * lu(k,1363) + lu(k,1369) = - lu(k,934) * lu(k,1363) + lu(k,1373) = - lu(k,935) * lu(k,1363) + lu(k,1374) = lu(k,1374) - lu(k,936) * lu(k,1363) + lu(k,1375) = lu(k,1375) - lu(k,937) * lu(k,1363) + lu(k,1376) = lu(k,1376) - lu(k,938) * lu(k,1363) + lu(k,1379) = - lu(k,939) * lu(k,1363) + lu(k,1380) = lu(k,1380) - lu(k,940) * lu(k,1363) + lu(k,3238) = lu(k,3238) - lu(k,933) * lu(k,3211) + lu(k,3262) = lu(k,3262) - lu(k,934) * lu(k,3211) + lu(k,3311) = lu(k,3311) - lu(k,935) * lu(k,3211) + lu(k,3313) = lu(k,3313) - lu(k,936) * lu(k,3211) + lu(k,3315) = lu(k,3315) - lu(k,937) * lu(k,3211) + lu(k,3316) = lu(k,3316) - lu(k,938) * lu(k,3211) + lu(k,3320) = lu(k,3320) - lu(k,939) * lu(k,3211) + lu(k,3321) = lu(k,3321) - lu(k,940) * lu(k,3211) + lu(k,3492) = lu(k,3492) - lu(k,933) * lu(k,3463) + lu(k,3518) = lu(k,3518) - lu(k,934) * lu(k,3463) + lu(k,3567) = lu(k,3567) - lu(k,935) * lu(k,3463) + lu(k,3569) = lu(k,3569) - lu(k,936) * lu(k,3463) + lu(k,3571) = lu(k,3571) - lu(k,937) * lu(k,3463) + lu(k,3572) = lu(k,3572) - lu(k,938) * lu(k,3463) + lu(k,3576) = lu(k,3576) - lu(k,939) * lu(k,3463) + lu(k,3577) = lu(k,3577) - lu(k,940) * lu(k,3463) + lu(k,3741) = lu(k,3741) - lu(k,933) * lu(k,3700) + lu(k,3769) = lu(k,3769) - lu(k,934) * lu(k,3700) + lu(k,3817) = lu(k,3817) - lu(k,935) * lu(k,3700) + lu(k,3819) = lu(k,3819) - lu(k,936) * lu(k,3700) + lu(k,3821) = lu(k,3821) - lu(k,937) * lu(k,3700) + lu(k,3822) = lu(k,3822) - lu(k,938) * lu(k,3700) + lu(k,3826) = lu(k,3826) - lu(k,939) * lu(k,3700) + lu(k,3827) = lu(k,3827) - lu(k,940) * lu(k,3700) + lu(k,944) = 1._r8 / lu(k,944) + lu(k,945) = lu(k,945) * lu(k,944) + lu(k,946) = lu(k,946) * lu(k,944) + lu(k,947) = lu(k,947) * lu(k,944) + lu(k,948) = lu(k,948) * lu(k,944) + lu(k,949) = lu(k,949) * lu(k,944) + lu(k,950) = lu(k,950) * lu(k,944) + lu(k,951) = lu(k,951) * lu(k,944) + lu(k,952) = lu(k,952) * lu(k,944) + lu(k,2432) = - lu(k,945) * lu(k,2431) + lu(k,2434) = - lu(k,946) * lu(k,2431) + lu(k,2436) = - lu(k,947) * lu(k,2431) + lu(k,2444) = - lu(k,948) * lu(k,2431) + lu(k,2446) = - lu(k,949) * lu(k,2431) + lu(k,2448) = lu(k,2448) - lu(k,950) * lu(k,2431) + lu(k,2449) = lu(k,2449) - lu(k,951) * lu(k,2431) + lu(k,2451) = - lu(k,952) * lu(k,2431) + lu(k,3215) = lu(k,3215) - lu(k,945) * lu(k,3212) + lu(k,3259) = lu(k,3259) - lu(k,946) * lu(k,3212) + lu(k,3288) = lu(k,3288) - lu(k,947) * lu(k,3212) + lu(k,3311) = lu(k,3311) - lu(k,948) * lu(k,3212) + lu(k,3313) = lu(k,3313) - lu(k,949) * lu(k,3212) + lu(k,3315) = lu(k,3315) - lu(k,950) * lu(k,3212) + lu(k,3316) = lu(k,3316) - lu(k,951) * lu(k,3212) + lu(k,3320) = lu(k,3320) - lu(k,952) * lu(k,3212) + lu(k,3467) = lu(k,3467) - lu(k,945) * lu(k,3464) + lu(k,3515) = lu(k,3515) - lu(k,946) * lu(k,3464) + lu(k,3544) = lu(k,3544) - lu(k,947) * lu(k,3464) + lu(k,3567) = lu(k,3567) - lu(k,948) * lu(k,3464) + lu(k,3569) = lu(k,3569) - lu(k,949) * lu(k,3464) + lu(k,3571) = lu(k,3571) - lu(k,950) * lu(k,3464) + lu(k,3572) = lu(k,3572) - lu(k,951) * lu(k,3464) + lu(k,3576) = lu(k,3576) - lu(k,952) * lu(k,3464) + lu(k,3704) = lu(k,3704) - lu(k,945) * lu(k,3701) + lu(k,3766) = lu(k,3766) - lu(k,946) * lu(k,3701) + lu(k,3794) = lu(k,3794) - lu(k,947) * lu(k,3701) + lu(k,3817) = lu(k,3817) - lu(k,948) * lu(k,3701) + lu(k,3819) = lu(k,3819) - lu(k,949) * lu(k,3701) + lu(k,3821) = lu(k,3821) - lu(k,950) * lu(k,3701) + lu(k,3822) = lu(k,3822) - lu(k,951) * lu(k,3701) + lu(k,3826) = lu(k,3826) - lu(k,952) * lu(k,3701) + lu(k,953) = 1._r8 / lu(k,953) + lu(k,954) = lu(k,954) * lu(k,953) + lu(k,955) = lu(k,955) * lu(k,953) + lu(k,956) = lu(k,956) * lu(k,953) + lu(k,957) = lu(k,957) * lu(k,953) + lu(k,958) = lu(k,958) * lu(k,953) + lu(k,959) = lu(k,959) * lu(k,953) + lu(k,960) = lu(k,960) * lu(k,953) + lu(k,961) = lu(k,961) * lu(k,953) + lu(k,2346) = lu(k,2346) - lu(k,954) * lu(k,2341) + lu(k,2347) = - lu(k,955) * lu(k,2341) + lu(k,2351) = - lu(k,956) * lu(k,2341) + lu(k,2352) = lu(k,2352) - lu(k,957) * lu(k,2341) + lu(k,2355) = - lu(k,958) * lu(k,2341) + lu(k,2359) = lu(k,2359) - lu(k,959) * lu(k,2341) + lu(k,2360) = lu(k,2360) - lu(k,960) * lu(k,2341) + lu(k,2363) = lu(k,2363) - lu(k,961) * lu(k,2341) + lu(k,3256) = lu(k,3256) - lu(k,954) * lu(k,3213) + lu(k,3257) = lu(k,3257) - lu(k,955) * lu(k,3213) + lu(k,3291) = lu(k,3291) - lu(k,956) * lu(k,3213) + lu(k,3299) = lu(k,3299) - lu(k,957) * lu(k,3213) + lu(k,3311) = lu(k,3311) - lu(k,958) * lu(k,3213) + lu(k,3315) = lu(k,3315) - lu(k,959) * lu(k,3213) + lu(k,3316) = lu(k,3316) - lu(k,960) * lu(k,3213) + lu(k,3320) = lu(k,3320) - lu(k,961) * lu(k,3213) + lu(k,3512) = lu(k,3512) - lu(k,954) * lu(k,3465) + lu(k,3513) = lu(k,3513) - lu(k,955) * lu(k,3465) + lu(k,3547) = lu(k,3547) - lu(k,956) * lu(k,3465) + lu(k,3555) = lu(k,3555) - lu(k,957) * lu(k,3465) + lu(k,3567) = lu(k,3567) - lu(k,958) * lu(k,3465) + lu(k,3571) = lu(k,3571) - lu(k,959) * lu(k,3465) + lu(k,3572) = lu(k,3572) - lu(k,960) * lu(k,3465) + lu(k,3576) = lu(k,3576) - lu(k,961) * lu(k,3465) + lu(k,3763) = lu(k,3763) - lu(k,954) * lu(k,3702) + lu(k,3764) = lu(k,3764) - lu(k,955) * lu(k,3702) + lu(k,3797) = lu(k,3797) - lu(k,956) * lu(k,3702) + lu(k,3805) = lu(k,3805) - lu(k,957) * lu(k,3702) + lu(k,3817) = lu(k,3817) - lu(k,958) * lu(k,3702) + lu(k,3821) = lu(k,3821) - lu(k,959) * lu(k,3702) + lu(k,3822) = lu(k,3822) - lu(k,960) * lu(k,3702) + lu(k,3826) = lu(k,3826) - lu(k,961) * lu(k,3702) end do end subroutine lu_fac20 subroutine lu_fac21( avec_len, lu ) @@ -3292,193 +3254,211 @@ subroutine lu_fac21( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,926) = 1._r8 / lu(k,926) - lu(k,927) = lu(k,927) * lu(k,926) - lu(k,928) = lu(k,928) * lu(k,926) - lu(k,929) = lu(k,929) * lu(k,926) - lu(k,930) = lu(k,930) * lu(k,926) - lu(k,931) = lu(k,931) * lu(k,926) - lu(k,932) = lu(k,932) * lu(k,926) - lu(k,933) = lu(k,933) * lu(k,926) - lu(k,2294) = - lu(k,927) * lu(k,2293) - lu(k,2296) = lu(k,2296) - lu(k,928) * lu(k,2293) - lu(k,2299) = - lu(k,929) * lu(k,2293) - lu(k,2315) = lu(k,2315) - lu(k,930) * lu(k,2293) - lu(k,2317) = lu(k,2317) - lu(k,931) * lu(k,2293) - lu(k,2320) = lu(k,2320) - lu(k,932) * lu(k,2293) - lu(k,2321) = lu(k,2321) - lu(k,933) * lu(k,2293) - lu(k,2353) = - lu(k,927) * lu(k,2352) - lu(k,2355) = lu(k,2355) - lu(k,928) * lu(k,2352) - lu(k,2358) = - lu(k,929) * lu(k,2352) - lu(k,2376) = lu(k,2376) - lu(k,930) * lu(k,2352) - lu(k,2378) = lu(k,2378) - lu(k,931) * lu(k,2352) - lu(k,2381) = lu(k,2381) - lu(k,932) * lu(k,2352) - lu(k,2382) = lu(k,2382) - lu(k,933) * lu(k,2352) - lu(k,2806) = lu(k,2806) - lu(k,927) * lu(k,2799) - lu(k,2812) = lu(k,2812) - lu(k,928) * lu(k,2799) - lu(k,2831) = lu(k,2831) - lu(k,929) * lu(k,2799) - lu(k,2885) = lu(k,2885) - lu(k,930) * lu(k,2799) - lu(k,2889) = lu(k,2889) - lu(k,931) * lu(k,2799) - lu(k,2894) = lu(k,2894) - lu(k,932) * lu(k,2799) - lu(k,2895) = lu(k,2895) - lu(k,933) * lu(k,2799) - lu(k,3196) = lu(k,3196) - lu(k,927) * lu(k,3190) - lu(k,3205) = lu(k,3205) - lu(k,928) * lu(k,3190) - lu(k,3227) = lu(k,3227) - lu(k,929) * lu(k,3190) - lu(k,3281) = lu(k,3281) - lu(k,930) * lu(k,3190) - lu(k,3285) = lu(k,3285) - lu(k,931) * lu(k,3190) - lu(k,3290) = lu(k,3290) - lu(k,932) * lu(k,3190) - lu(k,3291) = lu(k,3291) - lu(k,933) * lu(k,3190) - lu(k,3650) = lu(k,3650) - lu(k,927) * lu(k,3641) - lu(k,3661) = lu(k,3661) - lu(k,928) * lu(k,3641) - lu(k,3688) = lu(k,3688) - lu(k,929) * lu(k,3641) - lu(k,3742) = lu(k,3742) - lu(k,930) * lu(k,3641) - lu(k,3746) = lu(k,3746) - lu(k,931) * lu(k,3641) - lu(k,3751) = lu(k,3751) - lu(k,932) * lu(k,3641) - lu(k,3752) = lu(k,3752) - lu(k,933) * lu(k,3641) - lu(k,941) = 1._r8 / lu(k,941) - lu(k,942) = lu(k,942) * lu(k,941) - lu(k,943) = lu(k,943) * lu(k,941) - lu(k,944) = lu(k,944) * lu(k,941) - lu(k,945) = lu(k,945) * lu(k,941) - lu(k,946) = lu(k,946) * lu(k,941) - lu(k,947) = lu(k,947) * lu(k,941) - lu(k,948) = lu(k,948) * lu(k,941) - lu(k,949) = lu(k,949) * lu(k,941) - lu(k,950) = lu(k,950) * lu(k,941) - lu(k,951) = lu(k,951) * lu(k,941) - lu(k,952) = lu(k,952) * lu(k,941) - lu(k,953) = lu(k,953) * lu(k,941) - lu(k,2919) = lu(k,2919) - lu(k,942) * lu(k,2917) - lu(k,2921) = lu(k,2921) - lu(k,943) * lu(k,2917) - lu(k,2922) = lu(k,2922) - lu(k,944) * lu(k,2917) - lu(k,2923) = lu(k,2923) - lu(k,945) * lu(k,2917) - lu(k,2933) = lu(k,2933) - lu(k,946) * lu(k,2917) - lu(k,2970) = - lu(k,947) * lu(k,2917) - lu(k,2973) = - lu(k,948) * lu(k,2917) - lu(k,2980) = lu(k,2980) - lu(k,949) * lu(k,2917) - lu(k,2987) = lu(k,2987) - lu(k,950) * lu(k,2917) - lu(k,2988) = lu(k,2988) - lu(k,951) * lu(k,2917) - lu(k,2992) = lu(k,2992) - lu(k,952) * lu(k,2917) - lu(k,2996) = lu(k,2996) - lu(k,953) * lu(k,2917) - lu(k,3012) = lu(k,3012) - lu(k,942) * lu(k,3010) - lu(k,3014) = - lu(k,943) * lu(k,3010) - lu(k,3015) = - lu(k,944) * lu(k,3010) - lu(k,3016) = - lu(k,945) * lu(k,3010) - lu(k,3024) = lu(k,3024) - lu(k,946) * lu(k,3010) - lu(k,3062) = lu(k,3062) - lu(k,947) * lu(k,3010) - lu(k,3065) = lu(k,3065) - lu(k,948) * lu(k,3010) - lu(k,3072) = lu(k,3072) - lu(k,949) * lu(k,3010) - lu(k,3079) = lu(k,3079) - lu(k,950) * lu(k,3010) - lu(k,3080) = lu(k,3080) - lu(k,951) * lu(k,3010) - lu(k,3084) = lu(k,3084) - lu(k,952) * lu(k,3010) - lu(k,3088) = lu(k,3088) - lu(k,953) * lu(k,3010) - lu(k,3646) = lu(k,3646) - lu(k,942) * lu(k,3642) - lu(k,3657) = lu(k,3657) - lu(k,943) * lu(k,3642) - lu(k,3658) = lu(k,3658) - lu(k,944) * lu(k,3642) - lu(k,3659) = lu(k,3659) - lu(k,945) * lu(k,3642) - lu(k,3679) = lu(k,3679) - lu(k,946) * lu(k,3642) - lu(k,3726) = lu(k,3726) - lu(k,947) * lu(k,3642) - lu(k,3729) = lu(k,3729) - lu(k,948) * lu(k,3642) - lu(k,3736) = lu(k,3736) - lu(k,949) * lu(k,3642) - lu(k,3743) = lu(k,3743) - lu(k,950) * lu(k,3642) - lu(k,3744) = lu(k,3744) - lu(k,951) * lu(k,3642) - lu(k,3748) = lu(k,3748) - lu(k,952) * lu(k,3642) - lu(k,3752) = lu(k,3752) - lu(k,953) * lu(k,3642) - lu(k,961) = 1._r8 / lu(k,961) - lu(k,962) = lu(k,962) * lu(k,961) - lu(k,963) = lu(k,963) * lu(k,961) - lu(k,964) = lu(k,964) * lu(k,961) - lu(k,965) = lu(k,965) * lu(k,961) - lu(k,966) = lu(k,966) * lu(k,961) - lu(k,967) = lu(k,967) * lu(k,961) - lu(k,968) = lu(k,968) * lu(k,961) - lu(k,969) = lu(k,969) * lu(k,961) - lu(k,970) = lu(k,970) * lu(k,961) - lu(k,971) = lu(k,971) * lu(k,961) - lu(k,972) = lu(k,972) * lu(k,961) - lu(k,973) = lu(k,973) * lu(k,961) - lu(k,2933) = lu(k,2933) - lu(k,962) * lu(k,2918) - lu(k,2966) = - lu(k,963) * lu(k,2918) - lu(k,2972) = - lu(k,964) * lu(k,2918) - lu(k,2976) = lu(k,2976) - lu(k,965) * lu(k,2918) - lu(k,2977) = lu(k,2977) - lu(k,966) * lu(k,2918) - lu(k,2981) = lu(k,2981) - lu(k,967) * lu(k,2918) - lu(k,2982) = lu(k,2982) - lu(k,968) * lu(k,2918) - lu(k,2983) = lu(k,2983) - lu(k,969) * lu(k,2918) - lu(k,2987) = lu(k,2987) - lu(k,970) * lu(k,2918) - lu(k,2988) = lu(k,2988) - lu(k,971) * lu(k,2918) - lu(k,2992) = lu(k,2992) - lu(k,972) * lu(k,2918) - lu(k,2996) = lu(k,2996) - lu(k,973) * lu(k,2918) - lu(k,3024) = lu(k,3024) - lu(k,962) * lu(k,3011) - lu(k,3058) = lu(k,3058) - lu(k,963) * lu(k,3011) - lu(k,3064) = lu(k,3064) - lu(k,964) * lu(k,3011) - lu(k,3068) = lu(k,3068) - lu(k,965) * lu(k,3011) - lu(k,3069) = lu(k,3069) - lu(k,966) * lu(k,3011) - lu(k,3073) = lu(k,3073) - lu(k,967) * lu(k,3011) - lu(k,3074) = lu(k,3074) - lu(k,968) * lu(k,3011) - lu(k,3075) = lu(k,3075) - lu(k,969) * lu(k,3011) - lu(k,3079) = lu(k,3079) - lu(k,970) * lu(k,3011) - lu(k,3080) = lu(k,3080) - lu(k,971) * lu(k,3011) - lu(k,3084) = lu(k,3084) - lu(k,972) * lu(k,3011) - lu(k,3088) = lu(k,3088) - lu(k,973) * lu(k,3011) - lu(k,3679) = lu(k,3679) - lu(k,962) * lu(k,3643) - lu(k,3722) = lu(k,3722) - lu(k,963) * lu(k,3643) - lu(k,3728) = - lu(k,964) * lu(k,3643) - lu(k,3732) = lu(k,3732) - lu(k,965) * lu(k,3643) - lu(k,3733) = lu(k,3733) - lu(k,966) * lu(k,3643) - lu(k,3737) = lu(k,3737) - lu(k,967) * lu(k,3643) - lu(k,3738) = lu(k,3738) - lu(k,968) * lu(k,3643) - lu(k,3739) = lu(k,3739) - lu(k,969) * lu(k,3643) - lu(k,3743) = lu(k,3743) - lu(k,970) * lu(k,3643) - lu(k,3744) = lu(k,3744) - lu(k,971) * lu(k,3643) - lu(k,3748) = lu(k,3748) - lu(k,972) * lu(k,3643) - lu(k,3752) = lu(k,3752) - lu(k,973) * lu(k,3643) - lu(k,975) = 1._r8 / lu(k,975) - lu(k,976) = lu(k,976) * lu(k,975) - lu(k,977) = lu(k,977) * lu(k,975) - lu(k,978) = lu(k,978) * lu(k,975) - lu(k,979) = lu(k,979) * lu(k,975) - lu(k,980) = lu(k,980) * lu(k,975) - lu(k,981) = lu(k,981) * lu(k,975) - lu(k,982) = lu(k,982) * lu(k,975) - lu(k,983) = lu(k,983) * lu(k,975) - lu(k,984) = lu(k,984) * lu(k,975) - lu(k,2820) = lu(k,2820) - lu(k,976) * lu(k,2800) - lu(k,2864) = lu(k,2864) - lu(k,977) * lu(k,2800) - lu(k,2885) = lu(k,2885) - lu(k,978) * lu(k,2800) - lu(k,2889) = lu(k,2889) - lu(k,979) * lu(k,2800) - lu(k,2891) = lu(k,2891) - lu(k,980) * lu(k,2800) - lu(k,2892) = lu(k,2892) - lu(k,981) * lu(k,2800) - lu(k,2894) = lu(k,2894) - lu(k,982) * lu(k,2800) - lu(k,2895) = lu(k,2895) - lu(k,983) * lu(k,2800) - lu(k,2899) = lu(k,2899) - lu(k,984) * lu(k,2800) - lu(k,3213) = lu(k,3213) - lu(k,976) * lu(k,3191) - lu(k,3260) = lu(k,3260) - lu(k,977) * lu(k,3191) - lu(k,3281) = lu(k,3281) - lu(k,978) * lu(k,3191) - lu(k,3285) = lu(k,3285) - lu(k,979) * lu(k,3191) - lu(k,3287) = lu(k,3287) - lu(k,980) * lu(k,3191) - lu(k,3288) = lu(k,3288) - lu(k,981) * lu(k,3191) - lu(k,3290) = lu(k,3290) - lu(k,982) * lu(k,3191) - lu(k,3291) = lu(k,3291) - lu(k,983) * lu(k,3191) - lu(k,3295) = lu(k,3295) - lu(k,984) * lu(k,3191) - lu(k,3359) = lu(k,3359) - lu(k,976) * lu(k,3352) - lu(k,3401) = lu(k,3401) - lu(k,977) * lu(k,3352) - lu(k,3422) = lu(k,3422) - lu(k,978) * lu(k,3352) - lu(k,3426) = lu(k,3426) - lu(k,979) * lu(k,3352) - lu(k,3428) = lu(k,3428) - lu(k,980) * lu(k,3352) - lu(k,3429) = lu(k,3429) - lu(k,981) * lu(k,3352) - lu(k,3431) = lu(k,3431) - lu(k,982) * lu(k,3352) - lu(k,3432) = lu(k,3432) - lu(k,983) * lu(k,3352) - lu(k,3436) = lu(k,3436) - lu(k,984) * lu(k,3352) - lu(k,3674) = lu(k,3674) - lu(k,976) * lu(k,3644) - lu(k,3721) = lu(k,3721) - lu(k,977) * lu(k,3644) - lu(k,3742) = lu(k,3742) - lu(k,978) * lu(k,3644) - lu(k,3746) = lu(k,3746) - lu(k,979) * lu(k,3644) - lu(k,3748) = lu(k,3748) - lu(k,980) * lu(k,3644) - lu(k,3749) = lu(k,3749) - lu(k,981) * lu(k,3644) - lu(k,3751) = lu(k,3751) - lu(k,982) * lu(k,3644) - lu(k,3752) = lu(k,3752) - lu(k,983) * lu(k,3644) - lu(k,3756) = lu(k,3756) - lu(k,984) * lu(k,3644) + lu(k,962) = 1._r8 / lu(k,962) + lu(k,963) = lu(k,963) * lu(k,962) + lu(k,964) = lu(k,964) * lu(k,962) + lu(k,965) = lu(k,965) * lu(k,962) + lu(k,966) = lu(k,966) * lu(k,962) + lu(k,1420) = - lu(k,963) * lu(k,1412) + lu(k,1423) = - lu(k,964) * lu(k,1412) + lu(k,1425) = lu(k,1425) - lu(k,965) * lu(k,1412) + lu(k,1427) = lu(k,1427) - lu(k,966) * lu(k,1412) + lu(k,1578) = lu(k,1578) - lu(k,963) * lu(k,1561) + lu(k,1583) = - lu(k,964) * lu(k,1561) + lu(k,1588) = lu(k,1588) - lu(k,965) * lu(k,1561) + lu(k,1591) = lu(k,1591) - lu(k,966) * lu(k,1561) + lu(k,1818) = lu(k,1818) - lu(k,963) * lu(k,1807) + lu(k,1824) = lu(k,1824) - lu(k,964) * lu(k,1807) + lu(k,1826) = lu(k,1826) - lu(k,965) * lu(k,1807) + lu(k,1829) = lu(k,1829) - lu(k,966) * lu(k,1807) + lu(k,1849) = lu(k,1849) - lu(k,963) * lu(k,1838) + lu(k,1855) = lu(k,1855) - lu(k,964) * lu(k,1838) + lu(k,1857) = lu(k,1857) - lu(k,965) * lu(k,1838) + lu(k,1860) = lu(k,1860) - lu(k,966) * lu(k,1838) + lu(k,3088) = lu(k,3088) - lu(k,963) * lu(k,3052) + lu(k,3126) = lu(k,3126) - lu(k,964) * lu(k,3052) + lu(k,3131) = lu(k,3131) - lu(k,965) * lu(k,3052) + lu(k,3134) = lu(k,3134) - lu(k,966) * lu(k,3052) + lu(k,3269) = lu(k,3269) - lu(k,963) * lu(k,3214) + lu(k,3308) = lu(k,3308) - lu(k,964) * lu(k,3214) + lu(k,3313) = lu(k,3313) - lu(k,965) * lu(k,3214) + lu(k,3316) = lu(k,3316) - lu(k,966) * lu(k,3214) + lu(k,3525) = lu(k,3525) - lu(k,963) * lu(k,3466) + lu(k,3564) = lu(k,3564) - lu(k,964) * lu(k,3466) + lu(k,3569) = lu(k,3569) - lu(k,965) * lu(k,3466) + lu(k,3572) = lu(k,3572) - lu(k,966) * lu(k,3466) + lu(k,3776) = lu(k,3776) - lu(k,963) * lu(k,3703) + lu(k,3814) = lu(k,3814) - lu(k,964) * lu(k,3703) + lu(k,3819) = lu(k,3819) - lu(k,965) * lu(k,3703) + lu(k,3822) = lu(k,3822) - lu(k,966) * lu(k,3703) + lu(k,967) = 1._r8 / lu(k,967) + lu(k,968) = lu(k,968) * lu(k,967) + lu(k,969) = lu(k,969) * lu(k,967) + lu(k,970) = lu(k,970) * lu(k,967) + lu(k,1005) = - lu(k,968) * lu(k,1003) + lu(k,1009) = lu(k,1009) - lu(k,969) * lu(k,1003) + lu(k,1010) = lu(k,1010) - lu(k,970) * lu(k,1003) + lu(k,1016) = - lu(k,968) * lu(k,1012) + lu(k,1018) = lu(k,1018) - lu(k,969) * lu(k,1012) + lu(k,1019) = lu(k,1019) - lu(k,970) * lu(k,1012) + lu(k,1218) = - lu(k,968) * lu(k,1214) + lu(k,1222) = lu(k,1222) - lu(k,969) * lu(k,1214) + lu(k,1223) = lu(k,1223) - lu(k,970) * lu(k,1214) + lu(k,1686) = lu(k,1686) - lu(k,968) * lu(k,1684) + lu(k,1692) = lu(k,1692) - lu(k,969) * lu(k,1684) + lu(k,1693) = lu(k,1693) - lu(k,970) * lu(k,1684) + lu(k,1699) = - lu(k,968) * lu(k,1696) + lu(k,1705) = lu(k,1705) - lu(k,969) * lu(k,1696) + lu(k,1706) = lu(k,1706) - lu(k,970) * lu(k,1696) + lu(k,2433) = - lu(k,968) * lu(k,2432) + lu(k,2448) = lu(k,2448) - lu(k,969) * lu(k,2432) + lu(k,2449) = lu(k,2449) - lu(k,970) * lu(k,2432) + lu(k,2457) = lu(k,2457) - lu(k,968) * lu(k,2453) + lu(k,2479) = lu(k,2479) - lu(k,969) * lu(k,2453) + lu(k,2480) = lu(k,2480) - lu(k,970) * lu(k,2453) + lu(k,2658) = - lu(k,968) * lu(k,2654) + lu(k,2675) = lu(k,2675) - lu(k,969) * lu(k,2654) + lu(k,2676) = lu(k,2676) - lu(k,970) * lu(k,2654) + lu(k,3251) = lu(k,3251) - lu(k,968) * lu(k,3215) + lu(k,3315) = lu(k,3315) - lu(k,969) * lu(k,3215) + lu(k,3316) = lu(k,3316) - lu(k,970) * lu(k,3215) + lu(k,3505) = lu(k,3505) - lu(k,968) * lu(k,3467) + lu(k,3571) = lu(k,3571) - lu(k,969) * lu(k,3467) + lu(k,3572) = lu(k,3572) - lu(k,970) * lu(k,3467) + lu(k,3755) = lu(k,3755) - lu(k,968) * lu(k,3704) + lu(k,3821) = lu(k,3821) - lu(k,969) * lu(k,3704) + lu(k,3822) = lu(k,3822) - lu(k,970) * lu(k,3704) + lu(k,972) = 1._r8 / lu(k,972) + lu(k,973) = lu(k,973) * lu(k,972) + lu(k,974) = lu(k,974) * lu(k,972) + lu(k,975) = lu(k,975) * lu(k,972) + lu(k,976) = lu(k,976) * lu(k,972) + lu(k,977) = lu(k,977) * lu(k,972) + lu(k,978) = lu(k,978) * lu(k,972) + lu(k,979) = lu(k,979) * lu(k,972) + lu(k,980) = lu(k,980) * lu(k,972) + lu(k,981) = lu(k,981) * lu(k,972) + lu(k,982) = lu(k,982) * lu(k,972) + lu(k,983) = lu(k,983) * lu(k,972) + lu(k,3238) = lu(k,3238) - lu(k,973) * lu(k,3216) + lu(k,3258) = lu(k,3258) - lu(k,974) * lu(k,3216) + lu(k,3262) = lu(k,3262) - lu(k,975) * lu(k,3216) + lu(k,3270) = lu(k,3270) - lu(k,976) * lu(k,3216) + lu(k,3284) = lu(k,3284) - lu(k,977) * lu(k,3216) + lu(k,3308) = lu(k,3308) - lu(k,978) * lu(k,3216) + lu(k,3312) = lu(k,3312) - lu(k,979) * lu(k,3216) + lu(k,3313) = lu(k,3313) - lu(k,980) * lu(k,3216) + lu(k,3315) = lu(k,3315) - lu(k,981) * lu(k,3216) + lu(k,3316) = lu(k,3316) - lu(k,982) * lu(k,3216) + lu(k,3320) = lu(k,3320) - lu(k,983) * lu(k,3216) + lu(k,3741) = lu(k,3741) - lu(k,973) * lu(k,3705) + lu(k,3765) = lu(k,3765) - lu(k,974) * lu(k,3705) + lu(k,3769) = lu(k,3769) - lu(k,975) * lu(k,3705) + lu(k,3777) = lu(k,3777) - lu(k,976) * lu(k,3705) + lu(k,3790) = lu(k,3790) - lu(k,977) * lu(k,3705) + lu(k,3814) = lu(k,3814) - lu(k,978) * lu(k,3705) + lu(k,3818) = lu(k,3818) - lu(k,979) * lu(k,3705) + lu(k,3819) = lu(k,3819) - lu(k,980) * lu(k,3705) + lu(k,3821) = lu(k,3821) - lu(k,981) * lu(k,3705) + lu(k,3822) = lu(k,3822) - lu(k,982) * lu(k,3705) + lu(k,3826) = lu(k,3826) - lu(k,983) * lu(k,3705) + lu(k,3890) = lu(k,3890) - lu(k,973) * lu(k,3876) + lu(k,3901) = - lu(k,974) * lu(k,3876) + lu(k,3904) = lu(k,3904) - lu(k,975) * lu(k,3876) + lu(k,3911) = lu(k,3911) - lu(k,976) * lu(k,3876) + lu(k,3925) = lu(k,3925) - lu(k,977) * lu(k,3876) + lu(k,3949) = lu(k,3949) - lu(k,978) * lu(k,3876) + lu(k,3953) = lu(k,3953) - lu(k,979) * lu(k,3876) + lu(k,3954) = lu(k,3954) - lu(k,980) * lu(k,3876) + lu(k,3956) = lu(k,3956) - lu(k,981) * lu(k,3876) + lu(k,3957) = lu(k,3957) - lu(k,982) * lu(k,3876) + lu(k,3961) = lu(k,3961) - lu(k,983) * lu(k,3876) + lu(k,984) = 1._r8 / lu(k,984) + lu(k,985) = lu(k,985) * lu(k,984) + lu(k,986) = lu(k,986) * lu(k,984) + lu(k,987) = lu(k,987) * lu(k,984) + lu(k,988) = lu(k,988) * lu(k,984) + lu(k,989) = lu(k,989) * lu(k,984) + lu(k,990) = lu(k,990) * lu(k,984) + lu(k,991) = lu(k,991) * lu(k,984) + lu(k,1218) = lu(k,1218) - lu(k,985) * lu(k,1215) + lu(k,1219) = - lu(k,986) * lu(k,1215) + lu(k,1220) = - lu(k,987) * lu(k,1215) + lu(k,1222) = lu(k,1222) - lu(k,988) * lu(k,1215) + lu(k,1223) = lu(k,1223) - lu(k,989) * lu(k,1215) + lu(k,1224) = lu(k,1224) - lu(k,990) * lu(k,1215) + lu(k,1225) = - lu(k,991) * lu(k,1215) + lu(k,2525) = lu(k,2525) - lu(k,985) * lu(k,2519) + lu(k,2529) = - lu(k,986) * lu(k,2519) + lu(k,2530) = lu(k,2530) - lu(k,987) * lu(k,2519) + lu(k,2542) = lu(k,2542) - lu(k,988) * lu(k,2519) + lu(k,2543) = lu(k,2543) - lu(k,989) * lu(k,2519) + lu(k,2546) = lu(k,2546) - lu(k,990) * lu(k,2519) + lu(k,2547) = - lu(k,991) * lu(k,2519) + lu(k,3251) = lu(k,3251) - lu(k,985) * lu(k,3217) + lu(k,3288) = lu(k,3288) - lu(k,986) * lu(k,3217) + lu(k,3294) = lu(k,3294) - lu(k,987) * lu(k,3217) + lu(k,3315) = lu(k,3315) - lu(k,988) * lu(k,3217) + lu(k,3316) = lu(k,3316) - lu(k,989) * lu(k,3217) + lu(k,3320) = lu(k,3320) - lu(k,990) * lu(k,3217) + lu(k,3321) = lu(k,3321) - lu(k,991) * lu(k,3217) + lu(k,3505) = lu(k,3505) - lu(k,985) * lu(k,3468) + lu(k,3544) = lu(k,3544) - lu(k,986) * lu(k,3468) + lu(k,3550) = lu(k,3550) - lu(k,987) * lu(k,3468) + lu(k,3571) = lu(k,3571) - lu(k,988) * lu(k,3468) + lu(k,3572) = lu(k,3572) - lu(k,989) * lu(k,3468) + lu(k,3576) = lu(k,3576) - lu(k,990) * lu(k,3468) + lu(k,3577) = lu(k,3577) - lu(k,991) * lu(k,3468) + lu(k,3755) = lu(k,3755) - lu(k,985) * lu(k,3706) + lu(k,3794) = lu(k,3794) - lu(k,986) * lu(k,3706) + lu(k,3800) = lu(k,3800) - lu(k,987) * lu(k,3706) + lu(k,3821) = lu(k,3821) - lu(k,988) * lu(k,3706) + lu(k,3822) = lu(k,3822) - lu(k,989) * lu(k,3706) + lu(k,3826) = lu(k,3826) - lu(k,990) * lu(k,3706) + lu(k,3827) = lu(k,3827) - lu(k,991) * lu(k,3706) + lu(k,993) = 1._r8 / lu(k,993) + lu(k,994) = lu(k,994) * lu(k,993) + lu(k,995) = lu(k,995) * lu(k,993) + lu(k,996) = lu(k,996) * lu(k,993) + lu(k,997) = lu(k,997) * lu(k,993) + lu(k,998) = lu(k,998) * lu(k,993) + lu(k,999) = lu(k,999) * lu(k,993) + lu(k,1000) = lu(k,1000) * lu(k,993) + lu(k,2554) = lu(k,2554) - lu(k,994) * lu(k,2551) + lu(k,2555) = lu(k,2555) - lu(k,995) * lu(k,2551) + lu(k,2560) = - lu(k,996) * lu(k,2551) + lu(k,2564) = lu(k,2564) - lu(k,997) * lu(k,2551) + lu(k,2566) = lu(k,2566) - lu(k,998) * lu(k,2551) + lu(k,2567) = lu(k,2567) - lu(k,999) * lu(k,2551) + lu(k,2570) = - lu(k,1000) * lu(k,2551) + lu(k,3145) = lu(k,3145) - lu(k,994) * lu(k,3142) + lu(k,3146) = - lu(k,995) * lu(k,3142) + lu(k,3151) = lu(k,3151) - lu(k,996) * lu(k,3142) + lu(k,3155) = lu(k,3155) - lu(k,997) * lu(k,3142) + lu(k,3157) = lu(k,3157) - lu(k,998) * lu(k,3142) + lu(k,3158) = lu(k,3158) - lu(k,999) * lu(k,3142) + lu(k,3162) = lu(k,3162) - lu(k,1000) * lu(k,3142) + lu(k,3379) = lu(k,3379) - lu(k,994) * lu(k,3370) + lu(k,3381) = lu(k,3381) - lu(k,995) * lu(k,3370) + lu(k,3386) = lu(k,3386) - lu(k,996) * lu(k,3370) + lu(k,3390) = lu(k,3390) - lu(k,997) * lu(k,3370) + lu(k,3392) = lu(k,3392) - lu(k,998) * lu(k,3370) + lu(k,3393) = lu(k,3393) - lu(k,999) * lu(k,3370) + lu(k,3397) = - lu(k,1000) * lu(k,3370) + lu(k,3536) = lu(k,3536) - lu(k,994) * lu(k,3469) + lu(k,3551) = lu(k,3551) - lu(k,995) * lu(k,3469) + lu(k,3566) = lu(k,3566) - lu(k,996) * lu(k,3469) + lu(k,3570) = lu(k,3570) - lu(k,997) * lu(k,3469) + lu(k,3572) = lu(k,3572) - lu(k,998) * lu(k,3469) + lu(k,3573) = lu(k,3573) - lu(k,999) * lu(k,3469) + lu(k,3577) = lu(k,3577) - lu(k,1000) * lu(k,3469) + lu(k,4083) = lu(k,4083) - lu(k,994) * lu(k,4072) + lu(k,4085) = lu(k,4085) - lu(k,995) * lu(k,4072) + lu(k,4095) = - lu(k,996) * lu(k,4072) + lu(k,4099) = lu(k,4099) - lu(k,997) * lu(k,4072) + lu(k,4101) = lu(k,4101) - lu(k,998) * lu(k,4072) + lu(k,4102) = - lu(k,999) * lu(k,4072) + lu(k,4106) = lu(k,4106) - lu(k,1000) * lu(k,4072) end do end subroutine lu_fac21 subroutine lu_fac22( avec_len, lu ) @@ -3495,197 +3475,187 @@ subroutine lu_fac22( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,985) = 1._r8 / lu(k,985) - lu(k,986) = lu(k,986) * lu(k,985) - lu(k,987) = lu(k,987) * lu(k,985) - lu(k,988) = lu(k,988) * lu(k,985) - lu(k,989) = lu(k,989) * lu(k,985) - lu(k,990) = lu(k,990) * lu(k,985) - lu(k,991) = lu(k,991) * lu(k,985) - lu(k,992) = lu(k,992) * lu(k,985) - lu(k,993) = lu(k,993) * lu(k,985) - lu(k,994) = lu(k,994) * lu(k,985) - lu(k,1717) = - lu(k,986) * lu(k,1715) - lu(k,1721) = - lu(k,987) * lu(k,1715) - lu(k,1726) = - lu(k,988) * lu(k,1715) - lu(k,1731) = - lu(k,989) * lu(k,1715) - lu(k,1739) = lu(k,1739) - lu(k,990) * lu(k,1715) - lu(k,1740) = lu(k,1740) - lu(k,991) * lu(k,1715) - lu(k,1741) = lu(k,1741) - lu(k,992) * lu(k,1715) - lu(k,1743) = lu(k,1743) - lu(k,993) * lu(k,1715) - lu(k,1744) = lu(k,1744) - lu(k,994) * lu(k,1715) - lu(k,2823) = - lu(k,986) * lu(k,2801) - lu(k,2835) = lu(k,2835) - lu(k,987) * lu(k,2801) - lu(k,2843) = lu(k,2843) - lu(k,988) * lu(k,2801) - lu(k,2851) = lu(k,2851) - lu(k,989) * lu(k,2801) - lu(k,2885) = lu(k,2885) - lu(k,990) * lu(k,2801) - lu(k,2889) = lu(k,2889) - lu(k,991) * lu(k,2801) - lu(k,2891) = lu(k,2891) - lu(k,992) * lu(k,2801) - lu(k,2894) = lu(k,2894) - lu(k,993) * lu(k,2801) - lu(k,2895) = lu(k,2895) - lu(k,994) * lu(k,2801) - lu(k,3216) = lu(k,3216) - lu(k,986) * lu(k,3192) - lu(k,3231) = - lu(k,987) * lu(k,3192) - lu(k,3239) = - lu(k,988) * lu(k,3192) - lu(k,3247) = lu(k,3247) - lu(k,989) * lu(k,3192) - lu(k,3281) = lu(k,3281) - lu(k,990) * lu(k,3192) - lu(k,3285) = lu(k,3285) - lu(k,991) * lu(k,3192) - lu(k,3287) = lu(k,3287) - lu(k,992) * lu(k,3192) - lu(k,3290) = lu(k,3290) - lu(k,993) * lu(k,3192) - lu(k,3291) = lu(k,3291) - lu(k,994) * lu(k,3192) - lu(k,3677) = lu(k,3677) - lu(k,986) * lu(k,3645) - lu(k,3693) = lu(k,3693) - lu(k,987) * lu(k,3645) - lu(k,3701) = lu(k,3701) - lu(k,988) * lu(k,3645) - lu(k,3709) = lu(k,3709) - lu(k,989) * lu(k,3645) - lu(k,3742) = lu(k,3742) - lu(k,990) * lu(k,3645) - lu(k,3746) = lu(k,3746) - lu(k,991) * lu(k,3645) - lu(k,3748) = lu(k,3748) - lu(k,992) * lu(k,3645) - lu(k,3751) = lu(k,3751) - lu(k,993) * lu(k,3645) - lu(k,3752) = lu(k,3752) - lu(k,994) * lu(k,3645) - lu(k,995) = 1._r8 / lu(k,995) - lu(k,996) = lu(k,996) * lu(k,995) - lu(k,997) = lu(k,997) * lu(k,995) - lu(k,998) = lu(k,998) * lu(k,995) - lu(k,2216) = lu(k,2216) - lu(k,996) * lu(k,2204) - lu(k,2219) = lu(k,2219) - lu(k,997) * lu(k,2204) - lu(k,2231) = lu(k,2231) - lu(k,998) * lu(k,2204) - lu(k,2245) = lu(k,2245) - lu(k,996) * lu(k,2234) - lu(k,2248) = lu(k,2248) - lu(k,997) * lu(k,2234) - lu(k,2260) = lu(k,2260) - lu(k,998) * lu(k,2234) - lu(k,2333) = lu(k,2333) - lu(k,996) * lu(k,2324) - lu(k,2336) = lu(k,2336) - lu(k,997) * lu(k,2324) - lu(k,2348) = lu(k,2348) - lu(k,998) * lu(k,2324) - lu(k,2529) = lu(k,2529) - lu(k,996) * lu(k,2506) - lu(k,2532) = lu(k,2532) - lu(k,997) * lu(k,2506) - lu(k,2546) = lu(k,2546) - lu(k,998) * lu(k,2506) - lu(k,2575) = lu(k,2575) - lu(k,996) * lu(k,2552) - lu(k,2578) = lu(k,2578) - lu(k,997) * lu(k,2552) - lu(k,2592) = lu(k,2592) - lu(k,998) * lu(k,2552) - lu(k,2622) = lu(k,2622) - lu(k,996) * lu(k,2598) - lu(k,2625) = lu(k,2625) - lu(k,997) * lu(k,2598) - lu(k,2639) = lu(k,2639) - lu(k,998) * lu(k,2598) - lu(k,2693) = lu(k,2693) - lu(k,996) * lu(k,2646) - lu(k,2696) = lu(k,2696) - lu(k,997) * lu(k,2646) - lu(k,2710) = lu(k,2710) - lu(k,998) * lu(k,2646) - lu(k,2876) = lu(k,2876) - lu(k,996) * lu(k,2802) - lu(k,2879) = lu(k,2879) - lu(k,997) * lu(k,2802) - lu(k,2895) = lu(k,2895) - lu(k,998) * lu(k,2802) - lu(k,2977) = lu(k,2977) - lu(k,996) * lu(k,2919) - lu(k,2980) = lu(k,2980) - lu(k,997) * lu(k,2919) - lu(k,2996) = lu(k,2996) - lu(k,998) * lu(k,2919) - lu(k,3069) = lu(k,3069) - lu(k,996) * lu(k,3012) - lu(k,3072) = lu(k,3072) - lu(k,997) * lu(k,3012) - lu(k,3088) = lu(k,3088) - lu(k,998) * lu(k,3012) - lu(k,3272) = lu(k,3272) - lu(k,996) * lu(k,3193) - lu(k,3275) = lu(k,3275) - lu(k,997) * lu(k,3193) - lu(k,3291) = lu(k,3291) - lu(k,998) * lu(k,3193) - lu(k,3413) = lu(k,3413) - lu(k,996) * lu(k,3353) - lu(k,3416) = lu(k,3416) - lu(k,997) * lu(k,3353) - lu(k,3432) = lu(k,3432) - lu(k,998) * lu(k,3353) - lu(k,3733) = lu(k,3733) - lu(k,996) * lu(k,3646) - lu(k,3736) = lu(k,3736) - lu(k,997) * lu(k,3646) - lu(k,3752) = lu(k,3752) - lu(k,998) * lu(k,3646) - lu(k,999) = 1._r8 / lu(k,999) - lu(k,1000) = lu(k,1000) * lu(k,999) - lu(k,1001) = lu(k,1001) * lu(k,999) - lu(k,1002) = lu(k,1002) * lu(k,999) - lu(k,1003) = lu(k,1003) * lu(k,999) - lu(k,1004) = lu(k,1004) * lu(k,999) - lu(k,1005) = lu(k,1005) * lu(k,999) - lu(k,1006) = lu(k,1006) * lu(k,999) - lu(k,1007) = lu(k,1007) * lu(k,999) - lu(k,1008) = lu(k,1008) * lu(k,999) - lu(k,1009) = lu(k,1009) * lu(k,999) - lu(k,1917) = - lu(k,1000) * lu(k,1913) - lu(k,1918) = lu(k,1918) - lu(k,1001) * lu(k,1913) - lu(k,1921) = lu(k,1921) - lu(k,1002) * lu(k,1913) - lu(k,1922) = - lu(k,1003) * lu(k,1913) - lu(k,1925) = lu(k,1925) - lu(k,1004) * lu(k,1913) - lu(k,1935) = - lu(k,1005) * lu(k,1913) - lu(k,1938) = lu(k,1938) - lu(k,1006) * lu(k,1913) - lu(k,1939) = - lu(k,1007) * lu(k,1913) - lu(k,1941) = lu(k,1941) - lu(k,1008) * lu(k,1913) - lu(k,1942) = lu(k,1942) - lu(k,1009) * lu(k,1913) - lu(k,2823) = lu(k,2823) - lu(k,1000) * lu(k,2803) - lu(k,2824) = lu(k,2824) - lu(k,1001) * lu(k,2803) - lu(k,2832) = lu(k,2832) - lu(k,1002) * lu(k,2803) - lu(k,2835) = lu(k,2835) - lu(k,1003) * lu(k,2803) - lu(k,2842) = lu(k,2842) - lu(k,1004) * lu(k,2803) - lu(k,2885) = lu(k,2885) - lu(k,1005) * lu(k,2803) - lu(k,2889) = lu(k,2889) - lu(k,1006) * lu(k,2803) - lu(k,2891) = lu(k,2891) - lu(k,1007) * lu(k,2803) - lu(k,2894) = lu(k,2894) - lu(k,1008) * lu(k,2803) - lu(k,2895) = lu(k,2895) - lu(k,1009) * lu(k,2803) - lu(k,3216) = lu(k,3216) - lu(k,1000) * lu(k,3194) - lu(k,3217) = lu(k,3217) - lu(k,1001) * lu(k,3194) - lu(k,3228) = lu(k,3228) - lu(k,1002) * lu(k,3194) - lu(k,3231) = lu(k,3231) - lu(k,1003) * lu(k,3194) - lu(k,3238) = lu(k,3238) - lu(k,1004) * lu(k,3194) - lu(k,3281) = lu(k,3281) - lu(k,1005) * lu(k,3194) - lu(k,3285) = lu(k,3285) - lu(k,1006) * lu(k,3194) - lu(k,3287) = lu(k,3287) - lu(k,1007) * lu(k,3194) - lu(k,3290) = lu(k,3290) - lu(k,1008) * lu(k,3194) - lu(k,3291) = lu(k,3291) - lu(k,1009) * lu(k,3194) - lu(k,3677) = lu(k,3677) - lu(k,1000) * lu(k,3647) - lu(k,3678) = lu(k,3678) - lu(k,1001) * lu(k,3647) - lu(k,3689) = lu(k,3689) - lu(k,1002) * lu(k,3647) - lu(k,3693) = lu(k,3693) - lu(k,1003) * lu(k,3647) - lu(k,3700) = lu(k,3700) - lu(k,1004) * lu(k,3647) - lu(k,3742) = lu(k,3742) - lu(k,1005) * lu(k,3647) - lu(k,3746) = lu(k,3746) - lu(k,1006) * lu(k,3647) - lu(k,3748) = lu(k,3748) - lu(k,1007) * lu(k,3647) - lu(k,3751) = lu(k,3751) - lu(k,1008) * lu(k,3647) - lu(k,3752) = lu(k,3752) - lu(k,1009) * lu(k,3647) - lu(k,1010) = 1._r8 / lu(k,1010) - lu(k,1011) = lu(k,1011) * lu(k,1010) - lu(k,1012) = lu(k,1012) * lu(k,1010) - lu(k,1013) = lu(k,1013) * lu(k,1010) - lu(k,1014) = lu(k,1014) * lu(k,1010) - lu(k,1015) = lu(k,1015) * lu(k,1010) - lu(k,1016) = lu(k,1016) * lu(k,1010) - lu(k,1017) = lu(k,1017) * lu(k,1010) - lu(k,1018) = lu(k,1018) * lu(k,1010) - lu(k,1019) = lu(k,1019) * lu(k,1010) - lu(k,1020) = lu(k,1020) * lu(k,1010) - lu(k,1950) = lu(k,1950) - lu(k,1011) * lu(k,1947) - lu(k,1951) = - lu(k,1012) * lu(k,1947) - lu(k,1956) = - lu(k,1013) * lu(k,1947) - lu(k,1958) = lu(k,1958) - lu(k,1014) * lu(k,1947) - lu(k,1962) = lu(k,1962) - lu(k,1015) * lu(k,1947) - lu(k,1969) = - lu(k,1016) * lu(k,1947) - lu(k,1972) = lu(k,1972) - lu(k,1017) * lu(k,1947) - lu(k,1973) = - lu(k,1018) * lu(k,1947) - lu(k,1975) = lu(k,1975) - lu(k,1019) * lu(k,1947) - lu(k,1976) = lu(k,1976) - lu(k,1020) * lu(k,1947) - lu(k,2819) = lu(k,2819) - lu(k,1011) * lu(k,2804) - lu(k,2823) = lu(k,2823) - lu(k,1012) * lu(k,2804) - lu(k,2835) = lu(k,2835) - lu(k,1013) * lu(k,2804) - lu(k,2841) = lu(k,2841) - lu(k,1014) * lu(k,2804) - lu(k,2851) = lu(k,2851) - lu(k,1015) * lu(k,2804) - lu(k,2885) = lu(k,2885) - lu(k,1016) * lu(k,2804) - lu(k,2889) = lu(k,2889) - lu(k,1017) * lu(k,2804) - lu(k,2891) = lu(k,2891) - lu(k,1018) * lu(k,2804) - lu(k,2894) = lu(k,2894) - lu(k,1019) * lu(k,2804) - lu(k,2895) = lu(k,2895) - lu(k,1020) * lu(k,2804) - lu(k,3212) = lu(k,3212) - lu(k,1011) * lu(k,3195) - lu(k,3216) = lu(k,3216) - lu(k,1012) * lu(k,3195) - lu(k,3231) = lu(k,3231) - lu(k,1013) * lu(k,3195) - lu(k,3237) = lu(k,3237) - lu(k,1014) * lu(k,3195) - lu(k,3247) = lu(k,3247) - lu(k,1015) * lu(k,3195) - lu(k,3281) = lu(k,3281) - lu(k,1016) * lu(k,3195) - lu(k,3285) = lu(k,3285) - lu(k,1017) * lu(k,3195) - lu(k,3287) = lu(k,3287) - lu(k,1018) * lu(k,3195) - lu(k,3290) = lu(k,3290) - lu(k,1019) * lu(k,3195) - lu(k,3291) = lu(k,3291) - lu(k,1020) * lu(k,3195) - lu(k,3672) = lu(k,3672) - lu(k,1011) * lu(k,3648) - lu(k,3677) = lu(k,3677) - lu(k,1012) * lu(k,3648) - lu(k,3693) = lu(k,3693) - lu(k,1013) * lu(k,3648) - lu(k,3699) = lu(k,3699) - lu(k,1014) * lu(k,3648) - lu(k,3709) = lu(k,3709) - lu(k,1015) * lu(k,3648) - lu(k,3742) = lu(k,3742) - lu(k,1016) * lu(k,3648) - lu(k,3746) = lu(k,3746) - lu(k,1017) * lu(k,3648) - lu(k,3748) = lu(k,3748) - lu(k,1018) * lu(k,3648) - lu(k,3751) = lu(k,3751) - lu(k,1019) * lu(k,3648) - lu(k,3752) = lu(k,3752) - lu(k,1020) * lu(k,3648) + lu(k,1004) = 1._r8 / lu(k,1004) + lu(k,1005) = lu(k,1005) * lu(k,1004) + lu(k,1006) = lu(k,1006) * lu(k,1004) + lu(k,1007) = lu(k,1007) * lu(k,1004) + lu(k,1008) = lu(k,1008) * lu(k,1004) + lu(k,1009) = lu(k,1009) * lu(k,1004) + lu(k,1010) = lu(k,1010) * lu(k,1004) + lu(k,1011) = lu(k,1011) * lu(k,1004) + lu(k,2319) = - lu(k,1005) * lu(k,2317) + lu(k,2324) = - lu(k,1006) * lu(k,2317) + lu(k,2325) = - lu(k,1007) * lu(k,2317) + lu(k,2333) = lu(k,2333) - lu(k,1008) * lu(k,2317) + lu(k,2336) = lu(k,2336) - lu(k,1009) * lu(k,2317) + lu(k,2337) = lu(k,2337) - lu(k,1010) * lu(k,2317) + lu(k,2340) = lu(k,2340) - lu(k,1011) * lu(k,2317) + lu(k,2793) = - lu(k,1005) * lu(k,2791) + lu(k,2800) = - lu(k,1006) * lu(k,2791) + lu(k,2801) = - lu(k,1007) * lu(k,2791) + lu(k,2813) = lu(k,2813) - lu(k,1008) * lu(k,2791) + lu(k,2817) = lu(k,2817) - lu(k,1009) * lu(k,2791) + lu(k,2818) = lu(k,2818) - lu(k,1010) * lu(k,2791) + lu(k,2822) = lu(k,2822) - lu(k,1011) * lu(k,2791) + lu(k,3251) = lu(k,3251) - lu(k,1005) * lu(k,3218) + lu(k,3288) = lu(k,3288) - lu(k,1006) * lu(k,3218) + lu(k,3291) = lu(k,3291) - lu(k,1007) * lu(k,3218) + lu(k,3311) = lu(k,3311) - lu(k,1008) * lu(k,3218) + lu(k,3315) = lu(k,3315) - lu(k,1009) * lu(k,3218) + lu(k,3316) = lu(k,3316) - lu(k,1010) * lu(k,3218) + lu(k,3320) = lu(k,3320) - lu(k,1011) * lu(k,3218) + lu(k,3505) = lu(k,3505) - lu(k,1005) * lu(k,3470) + lu(k,3544) = lu(k,3544) - lu(k,1006) * lu(k,3470) + lu(k,3547) = lu(k,3547) - lu(k,1007) * lu(k,3470) + lu(k,3567) = lu(k,3567) - lu(k,1008) * lu(k,3470) + lu(k,3571) = lu(k,3571) - lu(k,1009) * lu(k,3470) + lu(k,3572) = lu(k,3572) - lu(k,1010) * lu(k,3470) + lu(k,3576) = lu(k,3576) - lu(k,1011) * lu(k,3470) + lu(k,3755) = lu(k,3755) - lu(k,1005) * lu(k,3707) + lu(k,3794) = lu(k,3794) - lu(k,1006) * lu(k,3707) + lu(k,3797) = lu(k,3797) - lu(k,1007) * lu(k,3707) + lu(k,3817) = lu(k,3817) - lu(k,1008) * lu(k,3707) + lu(k,3821) = lu(k,3821) - lu(k,1009) * lu(k,3707) + lu(k,3822) = lu(k,3822) - lu(k,1010) * lu(k,3707) + lu(k,3826) = lu(k,3826) - lu(k,1011) * lu(k,3707) + lu(k,1013) = 1._r8 / lu(k,1013) + lu(k,1014) = lu(k,1014) * lu(k,1013) + lu(k,1015) = lu(k,1015) * lu(k,1013) + lu(k,1016) = lu(k,1016) * lu(k,1013) + lu(k,1017) = lu(k,1017) * lu(k,1013) + lu(k,1018) = lu(k,1018) * lu(k,1013) + lu(k,1019) = lu(k,1019) * lu(k,1013) + lu(k,1020) = lu(k,1020) * lu(k,1013) + lu(k,2488) = - lu(k,1014) * lu(k,2487) + lu(k,2490) = lu(k,2490) - lu(k,1015) * lu(k,2487) + lu(k,2493) = - lu(k,1016) * lu(k,2487) + lu(k,2509) = lu(k,2509) - lu(k,1017) * lu(k,2487) + lu(k,2513) = lu(k,2513) - lu(k,1018) * lu(k,2487) + lu(k,2514) = lu(k,2514) - lu(k,1019) * lu(k,2487) + lu(k,2517) = lu(k,2517) - lu(k,1020) * lu(k,2487) + lu(k,2684) = - lu(k,1014) * lu(k,2683) + lu(k,2686) = lu(k,2686) - lu(k,1015) * lu(k,2683) + lu(k,2689) = - lu(k,1016) * lu(k,2683) + lu(k,2710) = lu(k,2710) - lu(k,1017) * lu(k,2683) + lu(k,2714) = lu(k,2714) - lu(k,1018) * lu(k,2683) + lu(k,2715) = lu(k,2715) - lu(k,1019) * lu(k,2683) + lu(k,2719) = lu(k,2719) - lu(k,1020) * lu(k,2683) + lu(k,3226) = lu(k,3226) - lu(k,1014) * lu(k,3219) + lu(k,3231) = lu(k,3231) - lu(k,1015) * lu(k,3219) + lu(k,3251) = lu(k,3251) - lu(k,1016) * lu(k,3219) + lu(k,3311) = lu(k,3311) - lu(k,1017) * lu(k,3219) + lu(k,3315) = lu(k,3315) - lu(k,1018) * lu(k,3219) + lu(k,3316) = lu(k,3316) - lu(k,1019) * lu(k,3219) + lu(k,3320) = lu(k,3320) - lu(k,1020) * lu(k,3219) + lu(k,3478) = lu(k,3478) - lu(k,1014) * lu(k,3471) + lu(k,3485) = lu(k,3485) - lu(k,1015) * lu(k,3471) + lu(k,3505) = lu(k,3505) - lu(k,1016) * lu(k,3471) + lu(k,3567) = lu(k,3567) - lu(k,1017) * lu(k,3471) + lu(k,3571) = lu(k,3571) - lu(k,1018) * lu(k,3471) + lu(k,3572) = lu(k,3572) - lu(k,1019) * lu(k,3471) + lu(k,3576) = lu(k,3576) - lu(k,1020) * lu(k,3471) + lu(k,3719) = lu(k,3719) - lu(k,1014) * lu(k,3708) + lu(k,3726) = lu(k,3726) - lu(k,1015) * lu(k,3708) + lu(k,3755) = lu(k,3755) - lu(k,1016) * lu(k,3708) + lu(k,3817) = lu(k,3817) - lu(k,1017) * lu(k,3708) + lu(k,3821) = lu(k,3821) - lu(k,1018) * lu(k,3708) + lu(k,3822) = lu(k,3822) - lu(k,1019) * lu(k,3708) + lu(k,3826) = lu(k,3826) - lu(k,1020) * lu(k,3708) + lu(k,1028) = 1._r8 / lu(k,1028) + lu(k,1029) = lu(k,1029) * lu(k,1028) + lu(k,1030) = lu(k,1030) * lu(k,1028) + lu(k,1031) = lu(k,1031) * lu(k,1028) + lu(k,1032) = lu(k,1032) * lu(k,1028) + lu(k,1033) = lu(k,1033) * lu(k,1028) + lu(k,1034) = lu(k,1034) * lu(k,1028) + lu(k,1035) = lu(k,1035) * lu(k,1028) + lu(k,1036) = lu(k,1036) * lu(k,1028) + lu(k,1037) = lu(k,1037) * lu(k,1028) + lu(k,1038) = lu(k,1038) * lu(k,1028) + lu(k,1039) = lu(k,1039) * lu(k,1028) + lu(k,1040) = lu(k,1040) * lu(k,1028) + lu(k,3070) = lu(k,3070) - lu(k,1029) * lu(k,3053) + lu(k,3074) = lu(k,3074) - lu(k,1030) * lu(k,3053) + lu(k,3100) = - lu(k,1031) * lu(k,3053) + lu(k,3104) = - lu(k,1032) * lu(k,3053) + lu(k,3105) = lu(k,3105) - lu(k,1033) * lu(k,3053) + lu(k,3119) = lu(k,3119) - lu(k,1034) * lu(k,3053) + lu(k,3124) = lu(k,3124) - lu(k,1035) * lu(k,3053) + lu(k,3127) = lu(k,3127) - lu(k,1036) * lu(k,3053) + lu(k,3131) = lu(k,3131) - lu(k,1037) * lu(k,3053) + lu(k,3133) = lu(k,3133) - lu(k,1038) * lu(k,3053) + lu(k,3134) = lu(k,3134) - lu(k,1039) * lu(k,3053) + lu(k,3136) = lu(k,3136) - lu(k,1040) * lu(k,3053) + lu(k,3748) = lu(k,3748) - lu(k,1029) * lu(k,3709) + lu(k,3758) = lu(k,3758) - lu(k,1030) * lu(k,3709) + lu(k,3788) = - lu(k,1031) * lu(k,3709) + lu(k,3792) = lu(k,3792) - lu(k,1032) * lu(k,3709) + lu(k,3793) = lu(k,3793) - lu(k,1033) * lu(k,3709) + lu(k,3807) = lu(k,3807) - lu(k,1034) * lu(k,3709) + lu(k,3812) = lu(k,3812) - lu(k,1035) * lu(k,3709) + lu(k,3815) = lu(k,3815) - lu(k,1036) * lu(k,3709) + lu(k,3819) = lu(k,3819) - lu(k,1037) * lu(k,3709) + lu(k,3821) = lu(k,3821) - lu(k,1038) * lu(k,3709) + lu(k,3822) = lu(k,3822) - lu(k,1039) * lu(k,3709) + lu(k,3824) = lu(k,3824) - lu(k,1040) * lu(k,3709) + lu(k,3892) = - lu(k,1029) * lu(k,3877) + lu(k,3897) = lu(k,3897) - lu(k,1030) * lu(k,3877) + lu(k,3922) = lu(k,3922) - lu(k,1031) * lu(k,3877) + lu(k,3927) = lu(k,3927) - lu(k,1032) * lu(k,3877) + lu(k,3928) = lu(k,3928) - lu(k,1033) * lu(k,3877) + lu(k,3942) = lu(k,3942) - lu(k,1034) * lu(k,3877) + lu(k,3947) = lu(k,3947) - lu(k,1035) * lu(k,3877) + lu(k,3950) = lu(k,3950) - lu(k,1036) * lu(k,3877) + lu(k,3954) = lu(k,3954) - lu(k,1037) * lu(k,3877) + lu(k,3956) = lu(k,3956) - lu(k,1038) * lu(k,3877) + lu(k,3957) = lu(k,3957) - lu(k,1039) * lu(k,3877) + lu(k,3959) = lu(k,3959) - lu(k,1040) * lu(k,3877) + lu(k,1042) = 1._r8 / lu(k,1042) + lu(k,1043) = lu(k,1043) * lu(k,1042) + lu(k,1044) = lu(k,1044) * lu(k,1042) + lu(k,1045) = lu(k,1045) * lu(k,1042) + lu(k,1046) = lu(k,1046) * lu(k,1042) + lu(k,1047) = lu(k,1047) * lu(k,1042) + lu(k,1048) = lu(k,1048) * lu(k,1042) + lu(k,1049) = lu(k,1049) * lu(k,1042) + lu(k,1050) = lu(k,1050) * lu(k,1042) + lu(k,1051) = lu(k,1051) * lu(k,1042) + lu(k,3238) = lu(k,3238) - lu(k,1043) * lu(k,3220) + lu(k,3284) = lu(k,3284) - lu(k,1044) * lu(k,3220) + lu(k,3311) = lu(k,3311) - lu(k,1045) * lu(k,3220) + lu(k,3313) = lu(k,3313) - lu(k,1046) * lu(k,3220) + lu(k,3315) = lu(k,3315) - lu(k,1047) * lu(k,3220) + lu(k,3316) = lu(k,3316) - lu(k,1048) * lu(k,3220) + lu(k,3319) = lu(k,3319) - lu(k,1049) * lu(k,3220) + lu(k,3320) = lu(k,3320) - lu(k,1050) * lu(k,3220) + lu(k,3321) = lu(k,3321) - lu(k,1051) * lu(k,3220) + lu(k,3492) = lu(k,3492) - lu(k,1043) * lu(k,3472) + lu(k,3540) = lu(k,3540) - lu(k,1044) * lu(k,3472) + lu(k,3567) = lu(k,3567) - lu(k,1045) * lu(k,3472) + lu(k,3569) = lu(k,3569) - lu(k,1046) * lu(k,3472) + lu(k,3571) = lu(k,3571) - lu(k,1047) * lu(k,3472) + lu(k,3572) = lu(k,3572) - lu(k,1048) * lu(k,3472) + lu(k,3575) = lu(k,3575) - lu(k,1049) * lu(k,3472) + lu(k,3576) = lu(k,3576) - lu(k,1050) * lu(k,3472) + lu(k,3577) = lu(k,3577) - lu(k,1051) * lu(k,3472) + lu(k,3741) = lu(k,3741) - lu(k,1043) * lu(k,3710) + lu(k,3790) = lu(k,3790) - lu(k,1044) * lu(k,3710) + lu(k,3817) = lu(k,3817) - lu(k,1045) * lu(k,3710) + lu(k,3819) = lu(k,3819) - lu(k,1046) * lu(k,3710) + lu(k,3821) = lu(k,3821) - lu(k,1047) * lu(k,3710) + lu(k,3822) = lu(k,3822) - lu(k,1048) * lu(k,3710) + lu(k,3825) = lu(k,3825) - lu(k,1049) * lu(k,3710) + lu(k,3826) = lu(k,3826) - lu(k,1050) * lu(k,3710) + lu(k,3827) = lu(k,3827) - lu(k,1051) * lu(k,3710) + lu(k,3975) = lu(k,3975) - lu(k,1043) * lu(k,3969) + lu(k,4018) = lu(k,4018) - lu(k,1044) * lu(k,3969) + lu(k,4044) = lu(k,4044) - lu(k,1045) * lu(k,3969) + lu(k,4046) = lu(k,4046) - lu(k,1046) * lu(k,3969) + lu(k,4048) = lu(k,4048) - lu(k,1047) * lu(k,3969) + lu(k,4049) = lu(k,4049) - lu(k,1048) * lu(k,3969) + lu(k,4052) = lu(k,4052) - lu(k,1049) * lu(k,3969) + lu(k,4053) = lu(k,4053) - lu(k,1050) * lu(k,3969) + lu(k,4054) = lu(k,4054) - lu(k,1051) * lu(k,3969) end do end subroutine lu_fac22 subroutine lu_fac23( avec_len, lu ) @@ -3702,156 +3672,158 @@ subroutine lu_fac23( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1021) = 1._r8 / lu(k,1021) - lu(k,1022) = lu(k,1022) * lu(k,1021) - lu(k,1023) = lu(k,1023) * lu(k,1021) - lu(k,1024) = lu(k,1024) * lu(k,1021) - lu(k,1025) = lu(k,1025) * lu(k,1021) - lu(k,1026) = lu(k,1026) * lu(k,1021) - lu(k,1027) = lu(k,1027) * lu(k,1021) - lu(k,1028) = lu(k,1028) * lu(k,1021) - lu(k,1029) = lu(k,1029) * lu(k,1021) - lu(k,1030) = lu(k,1030) * lu(k,1021) - lu(k,1031) = lu(k,1031) * lu(k,1021) - lu(k,1475) = lu(k,1475) - lu(k,1022) * lu(k,1474) - lu(k,1479) = - lu(k,1023) * lu(k,1474) - lu(k,1481) = lu(k,1481) - lu(k,1024) * lu(k,1474) - lu(k,1482) = - lu(k,1025) * lu(k,1474) - lu(k,1483) = lu(k,1483) - lu(k,1026) * lu(k,1474) - lu(k,1485) = lu(k,1485) - lu(k,1027) * lu(k,1474) - lu(k,1486) = lu(k,1486) - lu(k,1028) * lu(k,1474) - lu(k,1488) = - lu(k,1029) * lu(k,1474) - lu(k,1492) = lu(k,1492) - lu(k,1030) * lu(k,1474) - lu(k,1493) = lu(k,1493) - lu(k,1031) * lu(k,1474) - lu(k,1527) = - lu(k,1022) * lu(k,1526) - lu(k,1528) = lu(k,1528) - lu(k,1023) * lu(k,1526) - lu(k,1530) = - lu(k,1024) * lu(k,1526) - lu(k,1531) = lu(k,1531) - lu(k,1025) * lu(k,1526) - lu(k,1532) = - lu(k,1026) * lu(k,1526) - lu(k,1533) = - lu(k,1027) * lu(k,1526) - lu(k,1534) = - lu(k,1028) * lu(k,1526) - lu(k,1535) = lu(k,1535) - lu(k,1029) * lu(k,1526) - lu(k,1538) = lu(k,1538) - lu(k,1030) * lu(k,1526) - lu(k,1539) = lu(k,1539) - lu(k,1031) * lu(k,1526) - lu(k,2813) = lu(k,2813) - lu(k,1022) * lu(k,2805) - lu(k,2832) = lu(k,2832) - lu(k,1023) * lu(k,2805) - lu(k,2836) = lu(k,2836) - lu(k,1024) * lu(k,2805) - lu(k,2841) = lu(k,2841) - lu(k,1025) * lu(k,2805) - lu(k,2842) = lu(k,2842) - lu(k,1026) * lu(k,2805) - lu(k,2851) = lu(k,2851) - lu(k,1027) * lu(k,2805) - lu(k,2853) = lu(k,2853) - lu(k,1028) * lu(k,2805) - lu(k,2883) = lu(k,2883) - lu(k,1029) * lu(k,2805) - lu(k,2894) = lu(k,2894) - lu(k,1030) * lu(k,2805) - lu(k,2895) = lu(k,2895) - lu(k,1031) * lu(k,2805) - lu(k,3664) = lu(k,3664) - lu(k,1022) * lu(k,3649) - lu(k,3689) = lu(k,3689) - lu(k,1023) * lu(k,3649) - lu(k,3694) = lu(k,3694) - lu(k,1024) * lu(k,3649) - lu(k,3699) = lu(k,3699) - lu(k,1025) * lu(k,3649) - lu(k,3700) = lu(k,3700) - lu(k,1026) * lu(k,3649) - lu(k,3709) = lu(k,3709) - lu(k,1027) * lu(k,3649) - lu(k,3711) = lu(k,3711) - lu(k,1028) * lu(k,3649) - lu(k,3740) = lu(k,3740) - lu(k,1029) * lu(k,3649) - lu(k,3751) = lu(k,3751) - lu(k,1030) * lu(k,3649) - lu(k,3752) = lu(k,3752) - lu(k,1031) * lu(k,3649) - lu(k,1032) = 1._r8 / lu(k,1032) - lu(k,1033) = lu(k,1033) * lu(k,1032) - lu(k,1034) = lu(k,1034) * lu(k,1032) - lu(k,1035) = lu(k,1035) * lu(k,1032) - lu(k,1036) = lu(k,1036) * lu(k,1032) - lu(k,1037) = lu(k,1037) * lu(k,1032) - lu(k,1038) = lu(k,1038) * lu(k,1032) - lu(k,2117) = lu(k,2117) - lu(k,1033) * lu(k,2114) - lu(k,2120) = lu(k,2120) - lu(k,1034) * lu(k,2114) - lu(k,2128) = - lu(k,1035) * lu(k,2114) - lu(k,2134) = lu(k,2134) - lu(k,1036) * lu(k,2114) - lu(k,2135) = lu(k,2135) - lu(k,1037) * lu(k,2114) - lu(k,2136) = - lu(k,1038) * lu(k,2114) - lu(k,2298) = - lu(k,1033) * lu(k,2294) - lu(k,2302) = - lu(k,1034) * lu(k,2294) - lu(k,2313) = lu(k,2313) - lu(k,1035) * lu(k,2294) - lu(k,2320) = lu(k,2320) - lu(k,1036) * lu(k,2294) - lu(k,2321) = lu(k,2321) - lu(k,1037) * lu(k,2294) - lu(k,2322) = - lu(k,1038) * lu(k,2294) - lu(k,2328) = lu(k,2328) - lu(k,1033) * lu(k,2325) - lu(k,2331) = lu(k,2331) - lu(k,1034) * lu(k,2325) - lu(k,2340) = - lu(k,1035) * lu(k,2325) - lu(k,2347) = lu(k,2347) - lu(k,1036) * lu(k,2325) - lu(k,2348) = lu(k,2348) - lu(k,1037) * lu(k,2325) - lu(k,2349) = lu(k,2349) - lu(k,1038) * lu(k,2325) - lu(k,2357) = - lu(k,1033) * lu(k,2353) - lu(k,2362) = - lu(k,1034) * lu(k,2353) - lu(k,2374) = lu(k,2374) - lu(k,1035) * lu(k,2353) - lu(k,2381) = lu(k,2381) - lu(k,1036) * lu(k,2353) - lu(k,2382) = lu(k,2382) - lu(k,1037) * lu(k,2353) - lu(k,2383) = - lu(k,1038) * lu(k,2353) - lu(k,2829) = lu(k,2829) - lu(k,1033) * lu(k,2806) - lu(k,2867) = lu(k,2867) - lu(k,1034) * lu(k,2806) - lu(k,2883) = lu(k,2883) - lu(k,1035) * lu(k,2806) - lu(k,2894) = lu(k,2894) - lu(k,1036) * lu(k,2806) - lu(k,2895) = lu(k,2895) - lu(k,1037) * lu(k,2806) - lu(k,2899) = lu(k,2899) - lu(k,1038) * lu(k,2806) - lu(k,3223) = lu(k,3223) - lu(k,1033) * lu(k,3196) - lu(k,3263) = lu(k,3263) - lu(k,1034) * lu(k,3196) - lu(k,3279) = lu(k,3279) - lu(k,1035) * lu(k,3196) - lu(k,3290) = lu(k,3290) - lu(k,1036) * lu(k,3196) - lu(k,3291) = lu(k,3291) - lu(k,1037) * lu(k,3196) - lu(k,3295) = lu(k,3295) - lu(k,1038) * lu(k,3196) - lu(k,3684) = lu(k,3684) - lu(k,1033) * lu(k,3650) - lu(k,3724) = lu(k,3724) - lu(k,1034) * lu(k,3650) - lu(k,3740) = lu(k,3740) - lu(k,1035) * lu(k,3650) - lu(k,3751) = lu(k,3751) - lu(k,1036) * lu(k,3650) - lu(k,3752) = lu(k,3752) - lu(k,1037) * lu(k,3650) - lu(k,3756) = lu(k,3756) - lu(k,1038) * lu(k,3650) - lu(k,1039) = 1._r8 / lu(k,1039) - lu(k,1040) = lu(k,1040) * lu(k,1039) - lu(k,1041) = lu(k,1041) * lu(k,1039) - lu(k,1042) = lu(k,1042) * lu(k,1039) - lu(k,1043) = lu(k,1043) * lu(k,1039) - lu(k,1044) = lu(k,1044) * lu(k,1039) - lu(k,1045) = lu(k,1045) * lu(k,1039) - lu(k,1046) = lu(k,1046) * lu(k,1039) - lu(k,1685) = lu(k,1685) - lu(k,1040) * lu(k,1683) - lu(k,1686) = - lu(k,1041) * lu(k,1683) - lu(k,1688) = - lu(k,1042) * lu(k,1683) - lu(k,1691) = - lu(k,1043) * lu(k,1683) - lu(k,1692) = - lu(k,1044) * lu(k,1683) - lu(k,1693) = lu(k,1693) - lu(k,1045) * lu(k,1683) - lu(k,1694) = - lu(k,1046) * lu(k,1683) - lu(k,3099) = lu(k,3099) - lu(k,1040) * lu(k,3097) - lu(k,3101) = lu(k,3101) - lu(k,1041) * lu(k,3097) - lu(k,3105) = lu(k,3105) - lu(k,1042) * lu(k,3097) - lu(k,3110) = lu(k,3110) - lu(k,1043) * lu(k,3097) - lu(k,3112) = lu(k,3112) - lu(k,1044) * lu(k,3097) - lu(k,3114) = lu(k,3114) - lu(k,1045) * lu(k,3097) - lu(k,3116) = lu(k,3116) - lu(k,1046) * lu(k,3097) - lu(k,3242) = lu(k,3242) - lu(k,1040) * lu(k,3197) - lu(k,3280) = lu(k,3280) - lu(k,1041) * lu(k,3197) - lu(k,3284) = - lu(k,1042) * lu(k,3197) - lu(k,3289) = lu(k,3289) - lu(k,1043) * lu(k,3197) - lu(k,3291) = lu(k,3291) - lu(k,1044) * lu(k,3197) - lu(k,3293) = lu(k,3293) - lu(k,1045) * lu(k,3197) - lu(k,3295) = lu(k,3295) - lu(k,1046) * lu(k,3197) - lu(k,3328) = lu(k,3328) - lu(k,1040) * lu(k,3323) - lu(k,3330) = lu(k,3330) - lu(k,1041) * lu(k,3323) - lu(k,3334) = - lu(k,1042) * lu(k,3323) - lu(k,3339) = lu(k,3339) - lu(k,1043) * lu(k,3323) - lu(k,3341) = lu(k,3341) - lu(k,1044) * lu(k,3323) - lu(k,3343) = - lu(k,1045) * lu(k,3323) - lu(k,3345) = lu(k,3345) - lu(k,1046) * lu(k,3323) - lu(k,3449) = lu(k,3449) - lu(k,1040) * lu(k,3441) - lu(k,3451) = lu(k,3451) - lu(k,1041) * lu(k,3441) - lu(k,3455) = - lu(k,1042) * lu(k,3441) - lu(k,3460) = lu(k,3460) - lu(k,1043) * lu(k,3441) - lu(k,3462) = lu(k,3462) - lu(k,1044) * lu(k,3441) - lu(k,3464) = lu(k,3464) - lu(k,1045) * lu(k,3441) - lu(k,3466) = lu(k,3466) - lu(k,1046) * lu(k,3441) - lu(k,3704) = lu(k,3704) - lu(k,1040) * lu(k,3651) - lu(k,3741) = lu(k,3741) - lu(k,1041) * lu(k,3651) - lu(k,3745) = lu(k,3745) - lu(k,1042) * lu(k,3651) - lu(k,3750) = lu(k,3750) - lu(k,1043) * lu(k,3651) - lu(k,3752) = lu(k,3752) - lu(k,1044) * lu(k,3651) - lu(k,3754) = lu(k,3754) - lu(k,1045) * lu(k,3651) - lu(k,3756) = lu(k,3756) - lu(k,1046) * lu(k,3651) + lu(k,1052) = 1._r8 / lu(k,1052) + lu(k,1053) = lu(k,1053) * lu(k,1052) + lu(k,1054) = lu(k,1054) * lu(k,1052) + lu(k,1055) = lu(k,1055) * lu(k,1052) + lu(k,1056) = lu(k,1056) * lu(k,1052) + lu(k,1057) = lu(k,1057) * lu(k,1052) + lu(k,1058) = lu(k,1058) * lu(k,1052) + lu(k,1059) = lu(k,1059) * lu(k,1052) + lu(k,1060) = lu(k,1060) * lu(k,1052) + lu(k,1061) = lu(k,1061) * lu(k,1052) + lu(k,1980) = - lu(k,1053) * lu(k,1979) + lu(k,1984) = - lu(k,1054) * lu(k,1979) + lu(k,1989) = - lu(k,1055) * lu(k,1979) + lu(k,1995) = - lu(k,1056) * lu(k,1979) + lu(k,2004) = lu(k,2004) - lu(k,1057) * lu(k,1979) + lu(k,2006) = lu(k,2006) - lu(k,1058) * lu(k,1979) + lu(k,2008) = lu(k,2008) - lu(k,1059) * lu(k,1979) + lu(k,2009) = lu(k,2009) - lu(k,1060) * lu(k,1979) + lu(k,2012) = lu(k,2012) - lu(k,1061) * lu(k,1979) + lu(k,3242) = - lu(k,1053) * lu(k,3221) + lu(k,3255) = lu(k,3255) - lu(k,1054) * lu(k,3221) + lu(k,3264) = lu(k,3264) - lu(k,1055) * lu(k,3221) + lu(k,3271) = lu(k,3271) - lu(k,1056) * lu(k,3221) + lu(k,3311) = lu(k,3311) - lu(k,1057) * lu(k,3221) + lu(k,3313) = lu(k,3313) - lu(k,1058) * lu(k,3221) + lu(k,3315) = lu(k,3315) - lu(k,1059) * lu(k,3221) + lu(k,3316) = lu(k,3316) - lu(k,1060) * lu(k,3221) + lu(k,3320) = lu(k,3320) - lu(k,1061) * lu(k,3221) + lu(k,3496) = lu(k,3496) - lu(k,1053) * lu(k,3473) + lu(k,3510) = - lu(k,1054) * lu(k,3473) + lu(k,3520) = - lu(k,1055) * lu(k,3473) + lu(k,3527) = lu(k,3527) - lu(k,1056) * lu(k,3473) + lu(k,3567) = lu(k,3567) - lu(k,1057) * lu(k,3473) + lu(k,3569) = lu(k,3569) - lu(k,1058) * lu(k,3473) + lu(k,3571) = lu(k,3571) - lu(k,1059) * lu(k,3473) + lu(k,3572) = lu(k,3572) - lu(k,1060) * lu(k,3473) + lu(k,3576) = lu(k,3576) - lu(k,1061) * lu(k,3473) + lu(k,3745) = lu(k,3745) - lu(k,1053) * lu(k,3711) + lu(k,3761) = lu(k,3761) - lu(k,1054) * lu(k,3711) + lu(k,3771) = lu(k,3771) - lu(k,1055) * lu(k,3711) + lu(k,3778) = lu(k,3778) - lu(k,1056) * lu(k,3711) + lu(k,3817) = lu(k,3817) - lu(k,1057) * lu(k,3711) + lu(k,3819) = lu(k,3819) - lu(k,1058) * lu(k,3711) + lu(k,3821) = lu(k,3821) - lu(k,1059) * lu(k,3711) + lu(k,3822) = lu(k,3822) - lu(k,1060) * lu(k,3711) + lu(k,3826) = lu(k,3826) - lu(k,1061) * lu(k,3711) + lu(k,1069) = 1._r8 / lu(k,1069) + lu(k,1070) = lu(k,1070) * lu(k,1069) + lu(k,1071) = lu(k,1071) * lu(k,1069) + lu(k,1072) = lu(k,1072) * lu(k,1069) + lu(k,1073) = lu(k,1073) * lu(k,1069) + lu(k,1074) = lu(k,1074) * lu(k,1069) + lu(k,1075) = lu(k,1075) * lu(k,1069) + lu(k,1076) = lu(k,1076) * lu(k,1069) + lu(k,1077) = lu(k,1077) * lu(k,1069) + lu(k,1078) = lu(k,1078) * lu(k,1069) + lu(k,1079) = lu(k,1079) * lu(k,1069) + lu(k,1080) = lu(k,1080) * lu(k,1069) + lu(k,1081) = lu(k,1081) * lu(k,1069) + lu(k,1082) = lu(k,1082) * lu(k,1069) + lu(k,3070) = lu(k,3070) - lu(k,1070) * lu(k,3054) + lu(k,3074) = lu(k,3074) - lu(k,1071) * lu(k,3054) + lu(k,3107) = - lu(k,1072) * lu(k,3054) + lu(k,3111) = - lu(k,1073) * lu(k,3054) + lu(k,3117) = lu(k,3117) - lu(k,1074) * lu(k,3054) + lu(k,3119) = lu(k,3119) - lu(k,1075) * lu(k,3054) + lu(k,3123) = lu(k,3123) - lu(k,1076) * lu(k,3054) + lu(k,3124) = lu(k,3124) - lu(k,1077) * lu(k,3054) + lu(k,3126) = lu(k,3126) - lu(k,1078) * lu(k,3054) + lu(k,3127) = lu(k,3127) - lu(k,1079) * lu(k,3054) + lu(k,3131) = lu(k,3131) - lu(k,1080) * lu(k,3054) + lu(k,3134) = lu(k,3134) - lu(k,1081) * lu(k,3054) + lu(k,3136) = lu(k,3136) - lu(k,1082) * lu(k,3054) + lu(k,3748) = lu(k,3748) - lu(k,1070) * lu(k,3712) + lu(k,3758) = lu(k,3758) - lu(k,1071) * lu(k,3712) + lu(k,3795) = lu(k,3795) - lu(k,1072) * lu(k,3712) + lu(k,3799) = - lu(k,1073) * lu(k,3712) + lu(k,3805) = lu(k,3805) - lu(k,1074) * lu(k,3712) + lu(k,3807) = lu(k,3807) - lu(k,1075) * lu(k,3712) + lu(k,3811) = lu(k,3811) - lu(k,1076) * lu(k,3712) + lu(k,3812) = lu(k,3812) - lu(k,1077) * lu(k,3712) + lu(k,3814) = lu(k,3814) - lu(k,1078) * lu(k,3712) + lu(k,3815) = lu(k,3815) - lu(k,1079) * lu(k,3712) + lu(k,3819) = lu(k,3819) - lu(k,1080) * lu(k,3712) + lu(k,3822) = lu(k,3822) - lu(k,1081) * lu(k,3712) + lu(k,3824) = lu(k,3824) - lu(k,1082) * lu(k,3712) + lu(k,3892) = lu(k,3892) - lu(k,1070) * lu(k,3878) + lu(k,3897) = lu(k,3897) - lu(k,1071) * lu(k,3878) + lu(k,3930) = lu(k,3930) - lu(k,1072) * lu(k,3878) + lu(k,3934) = lu(k,3934) - lu(k,1073) * lu(k,3878) + lu(k,3940) = lu(k,3940) - lu(k,1074) * lu(k,3878) + lu(k,3942) = lu(k,3942) - lu(k,1075) * lu(k,3878) + lu(k,3946) = lu(k,3946) - lu(k,1076) * lu(k,3878) + lu(k,3947) = lu(k,3947) - lu(k,1077) * lu(k,3878) + lu(k,3949) = lu(k,3949) - lu(k,1078) * lu(k,3878) + lu(k,3950) = lu(k,3950) - lu(k,1079) * lu(k,3878) + lu(k,3954) = lu(k,3954) - lu(k,1080) * lu(k,3878) + lu(k,3957) = lu(k,3957) - lu(k,1081) * lu(k,3878) + lu(k,3959) = lu(k,3959) - lu(k,1082) * lu(k,3878) + lu(k,1090) = 1._r8 / lu(k,1090) + lu(k,1091) = lu(k,1091) * lu(k,1090) + lu(k,1092) = lu(k,1092) * lu(k,1090) + lu(k,1093) = lu(k,1093) * lu(k,1090) + lu(k,1094) = lu(k,1094) * lu(k,1090) + lu(k,1095) = lu(k,1095) * lu(k,1090) + lu(k,1096) = lu(k,1096) * lu(k,1090) + lu(k,1097) = lu(k,1097) * lu(k,1090) + lu(k,1098) = lu(k,1098) * lu(k,1090) + lu(k,1099) = lu(k,1099) * lu(k,1090) + lu(k,1100) = lu(k,1100) * lu(k,1090) + lu(k,1101) = lu(k,1101) * lu(k,1090) + lu(k,1102) = lu(k,1102) * lu(k,1090) + lu(k,1103) = lu(k,1103) * lu(k,1090) + lu(k,3056) = lu(k,3056) - lu(k,1091) * lu(k,3055) + lu(k,3057) = lu(k,3057) - lu(k,1092) * lu(k,3055) + lu(k,3058) = lu(k,3058) - lu(k,1093) * lu(k,3055) + lu(k,3063) = lu(k,3063) - lu(k,1094) * lu(k,3055) + lu(k,3070) = lu(k,3070) - lu(k,1095) * lu(k,3055) + lu(k,3074) = lu(k,3074) - lu(k,1096) * lu(k,3055) + lu(k,3108) = - lu(k,1097) * lu(k,3055) + lu(k,3112) = - lu(k,1098) * lu(k,3055) + lu(k,3125) = lu(k,3125) - lu(k,1099) * lu(k,3055) + lu(k,3127) = lu(k,3127) - lu(k,1100) * lu(k,3055) + lu(k,3131) = lu(k,3131) - lu(k,1101) * lu(k,3055) + lu(k,3134) = lu(k,3134) - lu(k,1102) * lu(k,3055) + lu(k,3136) = lu(k,3136) - lu(k,1103) * lu(k,3055) + lu(k,3714) = lu(k,3714) - lu(k,1091) * lu(k,3713) + lu(k,3723) = lu(k,3723) - lu(k,1092) * lu(k,3713) + lu(k,3724) = lu(k,3724) - lu(k,1093) * lu(k,3713) + lu(k,3737) = lu(k,3737) - lu(k,1094) * lu(k,3713) + lu(k,3748) = lu(k,3748) - lu(k,1095) * lu(k,3713) + lu(k,3758) = lu(k,3758) - lu(k,1096) * lu(k,3713) + lu(k,3796) = lu(k,3796) - lu(k,1097) * lu(k,3713) + lu(k,3800) = lu(k,3800) - lu(k,1098) * lu(k,3713) + lu(k,3813) = lu(k,3813) - lu(k,1099) * lu(k,3713) + lu(k,3815) = lu(k,3815) - lu(k,1100) * lu(k,3713) + lu(k,3819) = lu(k,3819) - lu(k,1101) * lu(k,3713) + lu(k,3822) = lu(k,3822) - lu(k,1102) * lu(k,3713) + lu(k,3824) = lu(k,3824) - lu(k,1103) * lu(k,3713) + lu(k,3880) = lu(k,3880) - lu(k,1091) * lu(k,3879) + lu(k,3881) = - lu(k,1092) * lu(k,3879) + lu(k,3882) = - lu(k,1093) * lu(k,3879) + lu(k,3887) = - lu(k,1094) * lu(k,3879) + lu(k,3892) = lu(k,3892) - lu(k,1095) * lu(k,3879) + lu(k,3897) = lu(k,3897) - lu(k,1096) * lu(k,3879) + lu(k,3931) = lu(k,3931) - lu(k,1097) * lu(k,3879) + lu(k,3935) = lu(k,3935) - lu(k,1098) * lu(k,3879) + lu(k,3948) = lu(k,3948) - lu(k,1099) * lu(k,3879) + lu(k,3950) = lu(k,3950) - lu(k,1100) * lu(k,3879) + lu(k,3954) = lu(k,3954) - lu(k,1101) * lu(k,3879) + lu(k,3957) = lu(k,3957) - lu(k,1102) * lu(k,3879) + lu(k,3959) = lu(k,3959) - lu(k,1103) * lu(k,3879) end do end subroutine lu_fac23 subroutine lu_fac24( avec_len, lu ) @@ -3868,224 +3840,202 @@ subroutine lu_fac24( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - 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,1055) = lu(k,1055) * lu(k,1048) - lu(k,1056) = lu(k,1056) * lu(k,1048) - lu(k,1057) = lu(k,1057) * lu(k,1048) - lu(k,1058) = lu(k,1058) * lu(k,1048) - lu(k,1059) = lu(k,1059) * lu(k,1048) - lu(k,1060) = lu(k,1060) * lu(k,1048) - lu(k,1061) = lu(k,1061) * lu(k,1048) - lu(k,1062) = lu(k,1062) * lu(k,1048) - lu(k,2011) = - lu(k,1049) * lu(k,2009) - lu(k,2012) = - lu(k,1050) * lu(k,2009) - lu(k,2013) = - lu(k,1051) * lu(k,2009) - lu(k,2021) = - lu(k,1052) * lu(k,2009) - lu(k,2027) = lu(k,2027) - lu(k,1053) * lu(k,2009) - lu(k,2029) = - lu(k,1054) * lu(k,2009) - lu(k,2030) = lu(k,2030) - lu(k,1055) * lu(k,2009) - lu(k,2033) = lu(k,2033) - lu(k,1056) * lu(k,2009) - lu(k,2034) = lu(k,2034) - lu(k,1057) * lu(k,2009) - lu(k,2037) = - lu(k,1058) * lu(k,2009) - lu(k,2042) = lu(k,2042) - lu(k,1059) * lu(k,2009) - lu(k,2043) = lu(k,2043) - lu(k,1060) * lu(k,2009) - lu(k,2046) = lu(k,2046) - lu(k,1061) * lu(k,2009) - lu(k,2047) = lu(k,2047) - lu(k,1062) * lu(k,2009) - lu(k,3202) = lu(k,3202) - lu(k,1049) * lu(k,3198) - lu(k,3207) = lu(k,3207) - lu(k,1050) * lu(k,3198) - lu(k,3209) = - lu(k,1051) * lu(k,3198) - lu(k,3229) = lu(k,3229) - lu(k,1052) * lu(k,3198) - lu(k,3245) = lu(k,3245) - lu(k,1053) * lu(k,3198) - lu(k,3249) = lu(k,3249) - lu(k,1054) * lu(k,3198) - lu(k,3250) = lu(k,3250) - lu(k,1055) * lu(k,3198) - lu(k,3254) = - lu(k,1056) * lu(k,3198) - lu(k,3255) = lu(k,3255) - lu(k,1057) * lu(k,3198) - lu(k,3279) = lu(k,3279) - lu(k,1058) * lu(k,3198) - lu(k,3285) = lu(k,3285) - lu(k,1059) * lu(k,3198) - lu(k,3287) = lu(k,3287) - lu(k,1060) * lu(k,3198) - lu(k,3290) = lu(k,3290) - lu(k,1061) * lu(k,3198) - lu(k,3291) = lu(k,3291) - lu(k,1062) * lu(k,3198) - lu(k,3658) = lu(k,3658) - lu(k,1049) * lu(k,3652) - lu(k,3665) = lu(k,3665) - lu(k,1050) * lu(k,3652) - lu(k,3669) = lu(k,3669) - lu(k,1051) * lu(k,3652) - lu(k,3690) = lu(k,3690) - lu(k,1052) * lu(k,3652) - lu(k,3707) = lu(k,3707) - lu(k,1053) * lu(k,3652) - lu(k,3711) = lu(k,3711) - lu(k,1054) * lu(k,3652) - lu(k,3712) = lu(k,3712) - lu(k,1055) * lu(k,3652) - lu(k,3716) = lu(k,3716) - lu(k,1056) * lu(k,3652) - lu(k,3717) = lu(k,3717) - lu(k,1057) * lu(k,3652) - lu(k,3740) = lu(k,3740) - lu(k,1058) * lu(k,3652) - lu(k,3746) = lu(k,3746) - lu(k,1059) * lu(k,3652) - lu(k,3748) = lu(k,3748) - lu(k,1060) * lu(k,3652) - lu(k,3751) = lu(k,3751) - lu(k,1061) * lu(k,3652) - lu(k,3752) = lu(k,3752) - lu(k,1062) * lu(k,3652) - lu(k,1064) = 1._r8 / lu(k,1064) - lu(k,1065) = lu(k,1065) * lu(k,1064) - lu(k,1066) = lu(k,1066) * lu(k,1064) - lu(k,1067) = lu(k,1067) * lu(k,1064) - lu(k,1068) = lu(k,1068) * lu(k,1064) - lu(k,1069) = lu(k,1069) * lu(k,1064) - lu(k,1070) = lu(k,1070) * lu(k,1064) - lu(k,1216) = lu(k,1216) - lu(k,1065) * lu(k,1212) - lu(k,1217) = lu(k,1217) - lu(k,1066) * lu(k,1212) - lu(k,1219) = lu(k,1219) - lu(k,1067) * lu(k,1212) - lu(k,1220) = lu(k,1220) - lu(k,1068) * lu(k,1212) - lu(k,1221) = lu(k,1221) - lu(k,1069) * lu(k,1212) - lu(k,1222) = - lu(k,1070) * lu(k,1212) - lu(k,3286) = lu(k,3286) - lu(k,1065) * lu(k,3199) - lu(k,3289) = lu(k,3289) - lu(k,1066) * lu(k,3199) - lu(k,3291) = lu(k,3291) - lu(k,1067) * lu(k,3199) - lu(k,3292) = lu(k,3292) - lu(k,1068) * lu(k,3199) - lu(k,3294) = lu(k,3294) - lu(k,1069) * lu(k,3199) - lu(k,3295) = lu(k,3295) - lu(k,1070) * lu(k,3199) - lu(k,3312) = lu(k,3312) - lu(k,1065) * lu(k,3300) - lu(k,3315) = lu(k,3315) - lu(k,1066) * lu(k,3300) - lu(k,3317) = lu(k,3317) - lu(k,1067) * lu(k,3300) - lu(k,3318) = lu(k,3318) - lu(k,1068) * lu(k,3300) - lu(k,3320) = lu(k,3320) - lu(k,1069) * lu(k,3300) - lu(k,3321) = - lu(k,1070) * lu(k,3300) - lu(k,3457) = lu(k,3457) - lu(k,1065) * lu(k,3442) - lu(k,3460) = lu(k,3460) - lu(k,1066) * lu(k,3442) - lu(k,3462) = lu(k,3462) - lu(k,1067) * lu(k,3442) - lu(k,3463) = lu(k,3463) - lu(k,1068) * lu(k,3442) - lu(k,3465) = lu(k,3465) - lu(k,1069) * lu(k,3442) - lu(k,3466) = lu(k,3466) - lu(k,1070) * lu(k,3442) - lu(k,3747) = lu(k,3747) - lu(k,1065) * lu(k,3653) - lu(k,3750) = lu(k,3750) - lu(k,1066) * lu(k,3653) - lu(k,3752) = lu(k,3752) - lu(k,1067) * lu(k,3653) - lu(k,3753) = lu(k,3753) - lu(k,1068) * lu(k,3653) - lu(k,3755) = lu(k,3755) - lu(k,1069) * lu(k,3653) - lu(k,3756) = lu(k,3756) - lu(k,1070) * lu(k,3653) - lu(k,3769) = lu(k,3769) - lu(k,1065) * lu(k,3760) - lu(k,3772) = lu(k,3772) - lu(k,1066) * lu(k,3760) - lu(k,3774) = lu(k,3774) - lu(k,1067) * lu(k,3760) - lu(k,3775) = lu(k,3775) - lu(k,1068) * lu(k,3760) - lu(k,3777) = lu(k,3777) - lu(k,1069) * lu(k,3760) - lu(k,3778) = lu(k,3778) - lu(k,1070) * lu(k,3760) - lu(k,3828) = lu(k,3828) - lu(k,1065) * lu(k,3808) - lu(k,3831) = - lu(k,1066) * lu(k,3808) - lu(k,3833) = lu(k,3833) - lu(k,1067) * lu(k,3808) - lu(k,3834) = lu(k,3834) - lu(k,1068) * lu(k,3808) - lu(k,3836) = lu(k,3836) - lu(k,1069) * lu(k,3808) - lu(k,3837) = lu(k,3837) - lu(k,1070) * lu(k,3808) - lu(k,1071) = 1._r8 / lu(k,1071) - lu(k,1072) = lu(k,1072) * lu(k,1071) - lu(k,1073) = lu(k,1073) * lu(k,1071) - lu(k,1074) = lu(k,1074) * lu(k,1071) - lu(k,1075) = lu(k,1075) * lu(k,1071) - lu(k,1076) = lu(k,1076) * lu(k,1071) - lu(k,1077) = lu(k,1077) * lu(k,1071) - lu(k,1078) = lu(k,1078) * lu(k,1071) - lu(k,1079) = lu(k,1079) * lu(k,1071) - lu(k,1080) = lu(k,1080) * lu(k,1071) - lu(k,1081) = lu(k,1081) * lu(k,1071) - lu(k,1082) = lu(k,1082) * lu(k,1071) - lu(k,1817) = - lu(k,1072) * lu(k,1815) - lu(k,1819) = lu(k,1819) - lu(k,1073) * lu(k,1815) - lu(k,1820) = - lu(k,1074) * lu(k,1815) - lu(k,1823) = lu(k,1823) - lu(k,1075) * lu(k,1815) - lu(k,1824) = - lu(k,1076) * lu(k,1815) - lu(k,1825) = - lu(k,1077) * lu(k,1815) - lu(k,1837) = lu(k,1837) - lu(k,1078) * lu(k,1815) - lu(k,1838) = lu(k,1838) - lu(k,1079) * lu(k,1815) - lu(k,1839) = lu(k,1839) - lu(k,1080) * lu(k,1815) - lu(k,1841) = lu(k,1841) - lu(k,1081) * lu(k,1815) - lu(k,1842) = lu(k,1842) - lu(k,1082) * lu(k,1815) - lu(k,2823) = lu(k,2823) - lu(k,1072) * lu(k,2807) - lu(k,2832) = lu(k,2832) - lu(k,1073) * lu(k,2807) - lu(k,2835) = lu(k,2835) - lu(k,1074) * lu(k,2807) - lu(k,2841) = lu(k,2841) - lu(k,1075) * lu(k,2807) - lu(k,2842) = lu(k,2842) - lu(k,1076) * lu(k,2807) - lu(k,2843) = lu(k,2843) - lu(k,1077) * lu(k,2807) - lu(k,2885) = lu(k,2885) - lu(k,1078) * lu(k,2807) - lu(k,2889) = lu(k,2889) - lu(k,1079) * lu(k,2807) - lu(k,2891) = lu(k,2891) - lu(k,1080) * lu(k,2807) - lu(k,2894) = lu(k,2894) - lu(k,1081) * lu(k,2807) - lu(k,2895) = lu(k,2895) - lu(k,1082) * lu(k,2807) - lu(k,3216) = lu(k,3216) - lu(k,1072) * lu(k,3200) - lu(k,3228) = lu(k,3228) - lu(k,1073) * lu(k,3200) - lu(k,3231) = lu(k,3231) - lu(k,1074) * lu(k,3200) - lu(k,3237) = lu(k,3237) - lu(k,1075) * lu(k,3200) - lu(k,3238) = lu(k,3238) - lu(k,1076) * lu(k,3200) - lu(k,3239) = lu(k,3239) - lu(k,1077) * lu(k,3200) - lu(k,3281) = lu(k,3281) - lu(k,1078) * lu(k,3200) - lu(k,3285) = lu(k,3285) - lu(k,1079) * lu(k,3200) - lu(k,3287) = lu(k,3287) - lu(k,1080) * lu(k,3200) - lu(k,3290) = lu(k,3290) - lu(k,1081) * lu(k,3200) - lu(k,3291) = lu(k,3291) - lu(k,1082) * lu(k,3200) - lu(k,3677) = lu(k,3677) - lu(k,1072) * lu(k,3654) - lu(k,3689) = lu(k,3689) - lu(k,1073) * lu(k,3654) - lu(k,3693) = lu(k,3693) - lu(k,1074) * lu(k,3654) - lu(k,3699) = lu(k,3699) - lu(k,1075) * lu(k,3654) - lu(k,3700) = lu(k,3700) - lu(k,1076) * lu(k,3654) - lu(k,3701) = lu(k,3701) - lu(k,1077) * lu(k,3654) - lu(k,3742) = lu(k,3742) - lu(k,1078) * lu(k,3654) - lu(k,3746) = lu(k,3746) - lu(k,1079) * lu(k,3654) - lu(k,3748) = lu(k,3748) - lu(k,1080) * lu(k,3654) - lu(k,3751) = lu(k,3751) - lu(k,1081) * lu(k,3654) - lu(k,3752) = lu(k,3752) - lu(k,1082) * lu(k,3654) - lu(k,1083) = 1._r8 / lu(k,1083) - lu(k,1084) = lu(k,1084) * lu(k,1083) - lu(k,1085) = lu(k,1085) * lu(k,1083) - lu(k,1086) = lu(k,1086) * lu(k,1083) - lu(k,1087) = lu(k,1087) * lu(k,1083) - lu(k,1088) = lu(k,1088) * lu(k,1083) - lu(k,1089) = lu(k,1089) * lu(k,1083) - lu(k,1090) = lu(k,1090) * lu(k,1083) - lu(k,1091) = lu(k,1091) * lu(k,1083) - lu(k,1092) = lu(k,1092) * lu(k,1083) - lu(k,1093) = lu(k,1093) * lu(k,1083) - lu(k,1094) = lu(k,1094) * lu(k,1083) - lu(k,1432) = lu(k,1432) - lu(k,1084) * lu(k,1430) - lu(k,1436) = lu(k,1436) - lu(k,1085) * lu(k,1430) - lu(k,1441) = - lu(k,1086) * lu(k,1430) - lu(k,1443) = lu(k,1443) - lu(k,1087) * lu(k,1430) - lu(k,1444) = - lu(k,1088) * lu(k,1430) - lu(k,1447) = - lu(k,1089) * lu(k,1430) - lu(k,1452) = lu(k,1452) - lu(k,1090) * lu(k,1430) - lu(k,1455) = lu(k,1455) - lu(k,1091) * lu(k,1430) - lu(k,1456) = lu(k,1456) - lu(k,1092) * lu(k,1430) - lu(k,1458) = lu(k,1458) - lu(k,1093) * lu(k,1430) - lu(k,1459) = lu(k,1459) - lu(k,1094) * lu(k,1430) - lu(k,2013) = lu(k,2013) - lu(k,1084) * lu(k,2010) - lu(k,2017) = - lu(k,1085) * lu(k,2010) - lu(k,2021) = lu(k,2021) - lu(k,1086) * lu(k,2010) - lu(k,2023) = - lu(k,1087) * lu(k,2010) - lu(k,2024) = - lu(k,1088) * lu(k,2010) - lu(k,2028) = - lu(k,1089) * lu(k,2010) - lu(k,2037) = lu(k,2037) - lu(k,1090) * lu(k,2010) - lu(k,2042) = lu(k,2042) - lu(k,1091) * lu(k,2010) - lu(k,2043) = lu(k,2043) - lu(k,1092) * lu(k,2010) - lu(k,2046) = lu(k,2046) - lu(k,1093) * lu(k,2010) - lu(k,2047) = lu(k,2047) - lu(k,1094) * lu(k,2010) - lu(k,3357) = - lu(k,1084) * lu(k,3354) - lu(k,3363) = - lu(k,1085) * lu(k,3354) - lu(k,3371) = - lu(k,1086) * lu(k,3354) - lu(k,3374) = lu(k,3374) - lu(k,1087) * lu(k,3354) - lu(k,3379) = lu(k,3379) - lu(k,1088) * lu(k,3354) - lu(k,3388) = - lu(k,1089) * lu(k,3354) - lu(k,3420) = - lu(k,1090) * lu(k,3354) - lu(k,3426) = lu(k,3426) - lu(k,1091) * lu(k,3354) - lu(k,3428) = lu(k,3428) - lu(k,1092) * lu(k,3354) - lu(k,3431) = lu(k,3431) - lu(k,1093) * lu(k,3354) - lu(k,3432) = lu(k,3432) - lu(k,1094) * lu(k,3354) - lu(k,3669) = lu(k,3669) - lu(k,1084) * lu(k,3655) - lu(k,3678) = lu(k,3678) - lu(k,1085) * lu(k,3655) - lu(k,3690) = lu(k,3690) - lu(k,1086) * lu(k,3655) - lu(k,3694) = lu(k,3694) - lu(k,1087) * lu(k,3655) - lu(k,3699) = lu(k,3699) - lu(k,1088) * lu(k,3655) - lu(k,3709) = lu(k,3709) - lu(k,1089) * lu(k,3655) - lu(k,3740) = lu(k,3740) - lu(k,1090) * lu(k,3655) - lu(k,3746) = lu(k,3746) - lu(k,1091) * lu(k,3655) - lu(k,3748) = lu(k,3748) - lu(k,1092) * lu(k,3655) - lu(k,3751) = lu(k,3751) - lu(k,1093) * lu(k,3655) - lu(k,3752) = lu(k,3752) - lu(k,1094) * lu(k,3655) + lu(k,1104) = 1._r8 / lu(k,1104) + lu(k,1105) = lu(k,1105) * lu(k,1104) + lu(k,1106) = lu(k,1106) * lu(k,1104) + lu(k,1107) = lu(k,1107) * lu(k,1104) + lu(k,2414) = lu(k,2414) - lu(k,1105) * lu(k,2401) + lu(k,2419) = lu(k,2419) - lu(k,1106) * lu(k,2401) + lu(k,2426) = lu(k,2426) - lu(k,1107) * lu(k,2401) + lu(k,2468) = lu(k,2468) - lu(k,1105) * lu(k,2454) + lu(k,2473) = lu(k,2473) - lu(k,1106) * lu(k,2454) + lu(k,2480) = lu(k,2480) - lu(k,1107) * lu(k,2454) + lu(k,2531) = lu(k,2531) - lu(k,1105) * lu(k,2520) + lu(k,2536) = lu(k,2536) - lu(k,1106) * lu(k,2520) + lu(k,2543) = lu(k,2543) - lu(k,1107) * lu(k,2520) + lu(k,2849) = lu(k,2849) - lu(k,1105) * lu(k,2826) + lu(k,2855) = lu(k,2855) - lu(k,1106) * lu(k,2826) + lu(k,2864) = lu(k,2864) - lu(k,1107) * lu(k,2826) + lu(k,2896) = lu(k,2896) - lu(k,1105) * lu(k,2872) + lu(k,2902) = lu(k,2902) - lu(k,1106) * lu(k,2872) + lu(k,2911) = lu(k,2911) - lu(k,1107) * lu(k,2872) + lu(k,2942) = lu(k,2942) - lu(k,1105) * lu(k,2919) + lu(k,2948) = lu(k,2948) - lu(k,1106) * lu(k,2919) + lu(k,2957) = lu(k,2957) - lu(k,1107) * lu(k,2919) + lu(k,3016) = lu(k,3016) - lu(k,1105) * lu(k,2966) + lu(k,3022) = lu(k,3022) - lu(k,1106) * lu(k,2966) + lu(k,3031) = lu(k,3031) - lu(k,1107) * lu(k,2966) + lu(k,3119) = lu(k,3119) - lu(k,1105) * lu(k,3056) + lu(k,3125) = lu(k,3125) - lu(k,1106) * lu(k,3056) + lu(k,3134) = lu(k,3134) - lu(k,1107) * lu(k,3056) + lu(k,3301) = lu(k,3301) - lu(k,1105) * lu(k,3222) + lu(k,3307) = lu(k,3307) - lu(k,1106) * lu(k,3222) + lu(k,3316) = lu(k,3316) - lu(k,1107) * lu(k,3222) + lu(k,3557) = lu(k,3557) - lu(k,1105) * lu(k,3474) + lu(k,3563) = lu(k,3563) - lu(k,1106) * lu(k,3474) + lu(k,3572) = lu(k,3572) - lu(k,1107) * lu(k,3474) + lu(k,3807) = lu(k,3807) - lu(k,1105) * lu(k,3714) + lu(k,3813) = lu(k,3813) - lu(k,1106) * lu(k,3714) + lu(k,3822) = lu(k,3822) - lu(k,1107) * lu(k,3714) + lu(k,3942) = lu(k,3942) - lu(k,1105) * lu(k,3880) + lu(k,3948) = lu(k,3948) - lu(k,1106) * lu(k,3880) + lu(k,3957) = lu(k,3957) - lu(k,1107) * lu(k,3880) + lu(k,4034) = lu(k,4034) - lu(k,1105) * lu(k,3970) + lu(k,4040) = lu(k,4040) - lu(k,1106) * lu(k,3970) + lu(k,4049) = lu(k,4049) - lu(k,1107) * lu(k,3970) + lu(k,1108) = 1._r8 / lu(k,1108) + lu(k,1109) = lu(k,1109) * lu(k,1108) + lu(k,1110) = lu(k,1110) * lu(k,1108) + lu(k,1111) = lu(k,1111) * lu(k,1108) + lu(k,1112) = lu(k,1112) * lu(k,1108) + lu(k,1113) = lu(k,1113) * lu(k,1108) + lu(k,1114) = lu(k,1114) * lu(k,1108) + lu(k,1115) = lu(k,1115) * lu(k,1108) + lu(k,1116) = lu(k,1116) * lu(k,1108) + lu(k,1117) = lu(k,1117) * lu(k,1108) + lu(k,1118) = lu(k,1118) * lu(k,1108) + lu(k,1635) = lu(k,1635) - lu(k,1109) * lu(k,1632) + lu(k,1639) = - lu(k,1110) * lu(k,1632) + lu(k,1640) = lu(k,1640) - lu(k,1111) * lu(k,1632) + lu(k,1641) = - lu(k,1112) * lu(k,1632) + lu(k,1643) = lu(k,1643) - lu(k,1113) * lu(k,1632) + lu(k,1644) = lu(k,1644) - lu(k,1114) * lu(k,1632) + lu(k,1645) = lu(k,1645) - lu(k,1115) * lu(k,1632) + lu(k,1648) = - lu(k,1116) * lu(k,1632) + lu(k,1652) = lu(k,1652) - lu(k,1117) * lu(k,1632) + lu(k,1653) = lu(k,1653) - lu(k,1118) * lu(k,1632) + lu(k,1655) = - lu(k,1109) * lu(k,1654) + lu(k,1658) = lu(k,1658) - lu(k,1110) * lu(k,1654) + lu(k,1659) = - lu(k,1111) * lu(k,1654) + lu(k,1660) = lu(k,1660) - lu(k,1112) * lu(k,1654) + lu(k,1661) = - lu(k,1113) * lu(k,1654) + lu(k,1662) = - lu(k,1114) * lu(k,1654) + lu(k,1663) = - lu(k,1115) * lu(k,1654) + lu(k,1664) = lu(k,1664) - lu(k,1116) * lu(k,1654) + lu(k,1667) = lu(k,1667) - lu(k,1117) * lu(k,1654) + lu(k,1668) = lu(k,1668) - lu(k,1118) * lu(k,1654) + lu(k,3243) = lu(k,3243) - lu(k,1109) * lu(k,3223) + lu(k,3258) = lu(k,3258) - lu(k,1110) * lu(k,3223) + lu(k,3260) = lu(k,3260) - lu(k,1111) * lu(k,3223) + lu(k,3262) = lu(k,3262) - lu(k,1112) * lu(k,3223) + lu(k,3269) = lu(k,3269) - lu(k,1113) * lu(k,3223) + lu(k,3270) = lu(k,3270) - lu(k,1114) * lu(k,3223) + lu(k,3271) = lu(k,3271) - lu(k,1115) * lu(k,3223) + lu(k,3312) = lu(k,3312) - lu(k,1116) * lu(k,3223) + lu(k,3316) = lu(k,3316) - lu(k,1117) * lu(k,3223) + lu(k,3320) = lu(k,3320) - lu(k,1118) * lu(k,3223) + lu(k,3746) = lu(k,3746) - lu(k,1109) * lu(k,3715) + lu(k,3765) = lu(k,3765) - lu(k,1110) * lu(k,3715) + lu(k,3767) = lu(k,3767) - lu(k,1111) * lu(k,3715) + lu(k,3769) = lu(k,3769) - lu(k,1112) * lu(k,3715) + lu(k,3776) = lu(k,3776) - lu(k,1113) * lu(k,3715) + lu(k,3777) = lu(k,3777) - lu(k,1114) * lu(k,3715) + lu(k,3778) = lu(k,3778) - lu(k,1115) * lu(k,3715) + lu(k,3818) = lu(k,3818) - lu(k,1116) * lu(k,3715) + lu(k,3822) = lu(k,3822) - lu(k,1117) * lu(k,3715) + lu(k,3826) = lu(k,3826) - lu(k,1118) * lu(k,3715) + lu(k,1119) = 1._r8 / lu(k,1119) + lu(k,1120) = lu(k,1120) * lu(k,1119) + lu(k,1121) = lu(k,1121) * lu(k,1119) + lu(k,1122) = lu(k,1122) * lu(k,1119) + lu(k,1123) = lu(k,1123) * lu(k,1119) + lu(k,1124) = lu(k,1124) * lu(k,1119) + lu(k,1125) = lu(k,1125) * lu(k,1119) + lu(k,1126) = lu(k,1126) * lu(k,1119) + lu(k,1127) = lu(k,1127) * lu(k,1119) + lu(k,1128) = lu(k,1128) * lu(k,1119) + lu(k,1129) = lu(k,1129) * lu(k,1119) + lu(k,2095) = - lu(k,1120) * lu(k,2093) + lu(k,2097) = lu(k,2097) - lu(k,1121) * lu(k,2093) + lu(k,2101) = - lu(k,1122) * lu(k,2093) + lu(k,2102) = lu(k,2102) - lu(k,1123) * lu(k,2093) + lu(k,2103) = lu(k,2103) - lu(k,1124) * lu(k,2093) + lu(k,2115) = - lu(k,1125) * lu(k,2093) + lu(k,2117) = - lu(k,1126) * lu(k,2093) + lu(k,2119) = lu(k,2119) - lu(k,1127) * lu(k,2093) + lu(k,2120) = lu(k,2120) - lu(k,1128) * lu(k,2093) + lu(k,2123) = lu(k,2123) - lu(k,1129) * lu(k,2093) + lu(k,3242) = lu(k,3242) - lu(k,1120) * lu(k,3224) + lu(k,3244) = lu(k,3244) - lu(k,1121) * lu(k,3224) + lu(k,3255) = lu(k,3255) - lu(k,1122) * lu(k,3224) + lu(k,3258) = lu(k,3258) - lu(k,1123) * lu(k,3224) + lu(k,3260) = lu(k,3260) - lu(k,1124) * lu(k,3224) + lu(k,3311) = lu(k,3311) - lu(k,1125) * lu(k,3224) + lu(k,3313) = lu(k,3313) - lu(k,1126) * lu(k,3224) + lu(k,3315) = lu(k,3315) - lu(k,1127) * lu(k,3224) + lu(k,3316) = lu(k,3316) - lu(k,1128) * lu(k,3224) + lu(k,3320) = lu(k,3320) - lu(k,1129) * lu(k,3224) + lu(k,3496) = lu(k,3496) - lu(k,1120) * lu(k,3475) + lu(k,3498) = lu(k,3498) - lu(k,1121) * lu(k,3475) + lu(k,3510) = lu(k,3510) - lu(k,1122) * lu(k,3475) + lu(k,3514) = lu(k,3514) - lu(k,1123) * lu(k,3475) + lu(k,3516) = lu(k,3516) - lu(k,1124) * lu(k,3475) + lu(k,3567) = lu(k,3567) - lu(k,1125) * lu(k,3475) + lu(k,3569) = lu(k,3569) - lu(k,1126) * lu(k,3475) + lu(k,3571) = lu(k,3571) - lu(k,1127) * lu(k,3475) + lu(k,3572) = lu(k,3572) - lu(k,1128) * lu(k,3475) + lu(k,3576) = lu(k,3576) - lu(k,1129) * lu(k,3475) + lu(k,3745) = lu(k,3745) - lu(k,1120) * lu(k,3716) + lu(k,3747) = lu(k,3747) - lu(k,1121) * lu(k,3716) + lu(k,3761) = lu(k,3761) - lu(k,1122) * lu(k,3716) + lu(k,3765) = lu(k,3765) - lu(k,1123) * lu(k,3716) + lu(k,3767) = lu(k,3767) - lu(k,1124) * lu(k,3716) + lu(k,3817) = lu(k,3817) - lu(k,1125) * lu(k,3716) + lu(k,3819) = lu(k,3819) - lu(k,1126) * lu(k,3716) + lu(k,3821) = lu(k,3821) - lu(k,1127) * lu(k,3716) + lu(k,3822) = lu(k,3822) - lu(k,1128) * lu(k,3716) + lu(k,3826) = lu(k,3826) - lu(k,1129) * lu(k,3716) + lu(k,1130) = 1._r8 / lu(k,1130) + lu(k,1131) = lu(k,1131) * lu(k,1130) + lu(k,1132) = lu(k,1132) * lu(k,1130) + lu(k,1133) = lu(k,1133) * lu(k,1130) + lu(k,1134) = lu(k,1134) * lu(k,1130) + lu(k,1135) = lu(k,1135) * lu(k,1130) + lu(k,1136) = lu(k,1136) * lu(k,1130) + lu(k,1137) = lu(k,1137) * lu(k,1130) + lu(k,1138) = lu(k,1138) * lu(k,1130) + lu(k,1139) = lu(k,1139) * lu(k,1130) + lu(k,1140) = lu(k,1140) * lu(k,1130) + lu(k,2062) = lu(k,2062) - lu(k,1131) * lu(k,2061) + lu(k,2063) = - lu(k,1132) * lu(k,2061) + lu(k,2069) = - lu(k,1133) * lu(k,2061) + lu(k,2072) = lu(k,2072) - lu(k,1134) * lu(k,2061) + lu(k,2077) = lu(k,2077) - lu(k,1135) * lu(k,2061) + lu(k,2083) = - lu(k,1136) * lu(k,2061) + lu(k,2085) = - lu(k,1137) * lu(k,2061) + lu(k,2087) = lu(k,2087) - lu(k,1138) * lu(k,2061) + lu(k,2088) = lu(k,2088) - lu(k,1139) * lu(k,2061) + lu(k,2091) = lu(k,2091) - lu(k,1140) * lu(k,2061) + lu(k,3240) = lu(k,3240) - lu(k,1131) * lu(k,3225) + lu(k,3242) = lu(k,3242) - lu(k,1132) * lu(k,3225) + lu(k,3255) = lu(k,3255) - lu(k,1133) * lu(k,3225) + lu(k,3262) = lu(k,3262) - lu(k,1134) * lu(k,3225) + lu(k,3271) = lu(k,3271) - lu(k,1135) * lu(k,3225) + lu(k,3311) = lu(k,3311) - lu(k,1136) * lu(k,3225) + lu(k,3313) = lu(k,3313) - lu(k,1137) * lu(k,3225) + lu(k,3315) = lu(k,3315) - lu(k,1138) * lu(k,3225) + lu(k,3316) = lu(k,3316) - lu(k,1139) * lu(k,3225) + lu(k,3320) = lu(k,3320) - lu(k,1140) * lu(k,3225) + lu(k,3494) = lu(k,3494) - lu(k,1131) * lu(k,3476) + lu(k,3496) = lu(k,3496) - lu(k,1132) * lu(k,3476) + lu(k,3510) = lu(k,3510) - lu(k,1133) * lu(k,3476) + lu(k,3518) = lu(k,3518) - lu(k,1134) * lu(k,3476) + lu(k,3527) = lu(k,3527) - lu(k,1135) * lu(k,3476) + lu(k,3567) = lu(k,3567) - lu(k,1136) * lu(k,3476) + lu(k,3569) = lu(k,3569) - lu(k,1137) * lu(k,3476) + lu(k,3571) = lu(k,3571) - lu(k,1138) * lu(k,3476) + lu(k,3572) = lu(k,3572) - lu(k,1139) * lu(k,3476) + lu(k,3576) = lu(k,3576) - lu(k,1140) * lu(k,3476) + lu(k,3743) = lu(k,3743) - lu(k,1131) * lu(k,3717) + lu(k,3745) = lu(k,3745) - lu(k,1132) * lu(k,3717) + lu(k,3761) = lu(k,3761) - lu(k,1133) * lu(k,3717) + lu(k,3769) = lu(k,3769) - lu(k,1134) * lu(k,3717) + lu(k,3778) = lu(k,3778) - lu(k,1135) * lu(k,3717) + lu(k,3817) = lu(k,3817) - lu(k,1136) * lu(k,3717) + lu(k,3819) = lu(k,3819) - lu(k,1137) * lu(k,3717) + lu(k,3821) = lu(k,3821) - lu(k,1138) * lu(k,3717) + lu(k,3822) = lu(k,3822) - lu(k,1139) * lu(k,3717) + lu(k,3826) = lu(k,3826) - lu(k,1140) * lu(k,3717) end do end subroutine lu_fac24 subroutine lu_fac25( avec_len, lu ) @@ -4102,277 +4052,210 @@ subroutine lu_fac25( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1102) = 1._r8 / lu(k,1102) - lu(k,1103) = lu(k,1103) * lu(k,1102) - lu(k,1104) = lu(k,1104) * lu(k,1102) - lu(k,1105) = lu(k,1105) * lu(k,1102) - lu(k,1106) = lu(k,1106) * lu(k,1102) - lu(k,1107) = lu(k,1107) * lu(k,1102) - lu(k,1108) = lu(k,1108) * lu(k,1102) - lu(k,1109) = lu(k,1109) * lu(k,1102) - lu(k,1110) = lu(k,1110) * lu(k,1102) - lu(k,1111) = lu(k,1111) * lu(k,1102) - lu(k,1112) = lu(k,1112) * lu(k,1102) - lu(k,1113) = lu(k,1113) * lu(k,1102) - lu(k,1114) = lu(k,1114) * lu(k,1102) - lu(k,1115) = lu(k,1115) * lu(k,1102) - lu(k,1116) = lu(k,1116) * lu(k,1102) - lu(k,1117) = lu(k,1117) * lu(k,1102) - lu(k,2925) = lu(k,2925) - lu(k,1103) * lu(k,2920) - lu(k,2933) = lu(k,2933) - lu(k,1104) * lu(k,2920) - lu(k,2940) = lu(k,2940) - lu(k,1105) * lu(k,2920) - lu(k,2964) = - lu(k,1106) * lu(k,2920) - lu(k,2968) = lu(k,2968) - lu(k,1107) * lu(k,2920) - lu(k,2969) = - lu(k,1108) * lu(k,2920) - lu(k,2977) = lu(k,2977) - lu(k,1109) * lu(k,2920) - lu(k,2979) = lu(k,2979) - lu(k,1110) * lu(k,2920) - lu(k,2980) = lu(k,2980) - lu(k,1111) * lu(k,2920) - lu(k,2982) = lu(k,2982) - lu(k,1112) * lu(k,2920) - lu(k,2987) = lu(k,2987) - lu(k,1113) * lu(k,2920) - lu(k,2988) = lu(k,2988) - lu(k,1114) * lu(k,2920) - lu(k,2990) = lu(k,2990) - lu(k,1115) * lu(k,2920) - lu(k,2992) = lu(k,2992) - lu(k,1116) * lu(k,2920) - lu(k,2996) = lu(k,2996) - lu(k,1117) * lu(k,2920) - lu(k,3018) = lu(k,3018) - lu(k,1103) * lu(k,3013) - lu(k,3024) = lu(k,3024) - lu(k,1104) * lu(k,3013) - lu(k,3031) = lu(k,3031) - lu(k,1105) * lu(k,3013) - lu(k,3056) = lu(k,3056) - lu(k,1106) * lu(k,3013) - lu(k,3060) = lu(k,3060) - lu(k,1107) * lu(k,3013) - lu(k,3061) = lu(k,3061) - lu(k,1108) * lu(k,3013) - lu(k,3069) = lu(k,3069) - lu(k,1109) * lu(k,3013) - lu(k,3071) = lu(k,3071) - lu(k,1110) * lu(k,3013) - lu(k,3072) = lu(k,3072) - lu(k,1111) * lu(k,3013) - lu(k,3074) = lu(k,3074) - lu(k,1112) * lu(k,3013) - lu(k,3079) = lu(k,3079) - lu(k,1113) * lu(k,3013) - lu(k,3080) = lu(k,3080) - lu(k,1114) * lu(k,3013) - lu(k,3082) = lu(k,3082) - lu(k,1115) * lu(k,3013) - lu(k,3084) = lu(k,3084) - lu(k,1116) * lu(k,3013) - lu(k,3088) = lu(k,3088) - lu(k,1117) * lu(k,3013) - lu(k,3663) = lu(k,3663) - lu(k,1103) * lu(k,3656) - lu(k,3679) = lu(k,3679) - lu(k,1104) * lu(k,3656) - lu(k,3694) = lu(k,3694) - lu(k,1105) * lu(k,3656) - lu(k,3720) = - lu(k,1106) * lu(k,3656) - lu(k,3724) = lu(k,3724) - lu(k,1107) * lu(k,3656) - lu(k,3725) = lu(k,3725) - lu(k,1108) * lu(k,3656) - lu(k,3733) = lu(k,3733) - lu(k,1109) * lu(k,3656) - lu(k,3735) = lu(k,3735) - lu(k,1110) * lu(k,3656) - lu(k,3736) = lu(k,3736) - lu(k,1111) * lu(k,3656) - lu(k,3738) = lu(k,3738) - lu(k,1112) * lu(k,3656) - lu(k,3743) = lu(k,3743) - lu(k,1113) * lu(k,3656) - lu(k,3744) = lu(k,3744) - lu(k,1114) * lu(k,3656) - lu(k,3746) = lu(k,3746) - lu(k,1115) * lu(k,3656) - lu(k,3748) = lu(k,3748) - lu(k,1116) * lu(k,3656) - lu(k,3752) = lu(k,3752) - lu(k,1117) * lu(k,3656) - lu(k,1118) = 1._r8 / lu(k,1118) - lu(k,1119) = lu(k,1119) * lu(k,1118) - lu(k,1120) = lu(k,1120) * lu(k,1118) - lu(k,1121) = lu(k,1121) * lu(k,1118) - lu(k,1122) = lu(k,1122) * lu(k,1118) - lu(k,1123) = lu(k,1123) * lu(k,1118) - lu(k,1284) = lu(k,1284) - lu(k,1119) * lu(k,1283) - lu(k,1300) = lu(k,1300) - lu(k,1120) * lu(k,1283) - lu(k,1301) = lu(k,1301) - lu(k,1121) * lu(k,1283) - lu(k,1303) = lu(k,1303) - lu(k,1122) * lu(k,1283) - lu(k,1304) = - lu(k,1123) * lu(k,1283) - lu(k,2386) = lu(k,2386) - lu(k,1119) * lu(k,2385) - lu(k,2404) = lu(k,2404) - lu(k,1120) * lu(k,2385) - lu(k,2405) = lu(k,2405) - lu(k,1121) * lu(k,2385) - lu(k,2408) = lu(k,2408) - lu(k,1122) * lu(k,2385) - lu(k,2411) = - lu(k,1123) * lu(k,2385) - lu(k,2415) = lu(k,2415) - lu(k,1119) * lu(k,2414) - lu(k,2431) = lu(k,2431) - lu(k,1120) * lu(k,2414) - lu(k,2432) = lu(k,2432) - lu(k,1121) * lu(k,2414) - lu(k,2435) = lu(k,2435) - lu(k,1122) * lu(k,2414) - lu(k,2438) = - lu(k,1123) * lu(k,2414) - lu(k,2809) = lu(k,2809) - lu(k,1119) * lu(k,2808) - lu(k,2889) = lu(k,2889) - lu(k,1120) * lu(k,2808) - lu(k,2891) = lu(k,2891) - lu(k,1121) * lu(k,2808) - lu(k,2895) = lu(k,2895) - lu(k,1122) * lu(k,2808) - lu(k,2899) = lu(k,2899) - lu(k,1123) * lu(k,2808) - lu(k,2922) = lu(k,2922) - lu(k,1119) * lu(k,2921) - lu(k,2990) = lu(k,2990) - lu(k,1120) * lu(k,2921) - lu(k,2992) = lu(k,2992) - lu(k,1121) * lu(k,2921) - lu(k,2996) = lu(k,2996) - lu(k,1122) * lu(k,2921) - lu(k,3000) = lu(k,3000) - lu(k,1123) * lu(k,2921) - lu(k,3015) = lu(k,3015) - lu(k,1119) * lu(k,3014) - lu(k,3082) = lu(k,3082) - lu(k,1120) * lu(k,3014) - lu(k,3084) = lu(k,3084) - lu(k,1121) * lu(k,3014) - lu(k,3088) = lu(k,3088) - lu(k,1122) * lu(k,3014) - lu(k,3092) = - lu(k,1123) * lu(k,3014) - lu(k,3202) = lu(k,3202) - lu(k,1119) * lu(k,3201) - lu(k,3285) = lu(k,3285) - lu(k,1120) * lu(k,3201) - lu(k,3287) = lu(k,3287) - lu(k,1121) * lu(k,3201) - lu(k,3291) = lu(k,3291) - lu(k,1122) * lu(k,3201) - lu(k,3295) = lu(k,3295) - lu(k,1123) * lu(k,3201) - lu(k,3325) = lu(k,3325) - lu(k,1119) * lu(k,3324) - lu(k,3335) = lu(k,3335) - lu(k,1120) * lu(k,3324) - lu(k,3337) = lu(k,3337) - lu(k,1121) * lu(k,3324) - lu(k,3341) = lu(k,3341) - lu(k,1122) * lu(k,3324) - lu(k,3345) = lu(k,3345) - lu(k,1123) * lu(k,3324) - lu(k,3658) = lu(k,3658) - lu(k,1119) * lu(k,3657) - lu(k,3746) = lu(k,3746) - lu(k,1120) * lu(k,3657) - lu(k,3748) = lu(k,3748) - lu(k,1121) * lu(k,3657) - lu(k,3752) = lu(k,3752) - lu(k,1122) * lu(k,3657) - lu(k,3756) = lu(k,3756) - lu(k,1123) * lu(k,3657) - lu(k,1124) = 1._r8 / lu(k,1124) - lu(k,1125) = lu(k,1125) * lu(k,1124) - lu(k,1126) = lu(k,1126) * lu(k,1124) - lu(k,1127) = lu(k,1127) * lu(k,1124) - lu(k,1205) = lu(k,1205) - lu(k,1125) * lu(k,1196) - lu(k,1209) = lu(k,1209) - lu(k,1126) * lu(k,1196) - lu(k,1210) = lu(k,1210) - lu(k,1127) * lu(k,1196) - lu(k,1300) = lu(k,1300) - lu(k,1125) * lu(k,1284) - lu(k,1303) = lu(k,1303) - lu(k,1126) * lu(k,1284) - lu(k,1304) = lu(k,1304) - lu(k,1127) * lu(k,1284) - lu(k,1759) = lu(k,1759) - lu(k,1125) * lu(k,1745) - lu(k,1763) = lu(k,1763) - lu(k,1126) * lu(k,1745) - lu(k,1764) = lu(k,1764) - lu(k,1127) * lu(k,1745) - lu(k,1790) = lu(k,1790) - lu(k,1125) * lu(k,1771) - lu(k,1794) = lu(k,1794) - lu(k,1126) * lu(k,1771) - lu(k,1795) = - lu(k,1127) * lu(k,1771) - lu(k,1870) = lu(k,1870) - lu(k,1125) * lu(k,1853) - lu(k,1874) = lu(k,1874) - lu(k,1126) * lu(k,1853) - lu(k,1875) = - lu(k,1127) * lu(k,1853) - lu(k,2042) = lu(k,2042) - lu(k,1125) * lu(k,2011) - lu(k,2047) = lu(k,2047) - lu(k,1126) * lu(k,2011) - lu(k,2050) = - lu(k,1127) * lu(k,2011) - lu(k,2404) = lu(k,2404) - lu(k,1125) * lu(k,2386) - lu(k,2408) = lu(k,2408) - lu(k,1126) * lu(k,2386) - lu(k,2411) = lu(k,2411) - lu(k,1127) * lu(k,2386) - lu(k,2431) = lu(k,2431) - lu(k,1125) * lu(k,2415) - lu(k,2435) = lu(k,2435) - lu(k,1126) * lu(k,2415) - lu(k,2438) = lu(k,2438) - lu(k,1127) * lu(k,2415) - lu(k,2889) = lu(k,2889) - lu(k,1125) * lu(k,2809) - lu(k,2895) = lu(k,2895) - lu(k,1126) * lu(k,2809) - lu(k,2899) = lu(k,2899) - lu(k,1127) * lu(k,2809) - lu(k,2990) = lu(k,2990) - lu(k,1125) * lu(k,2922) - lu(k,2996) = lu(k,2996) - lu(k,1126) * lu(k,2922) - lu(k,3000) = lu(k,3000) - lu(k,1127) * lu(k,2922) - lu(k,3082) = lu(k,3082) - lu(k,1125) * lu(k,3015) - lu(k,3088) = lu(k,3088) - lu(k,1126) * lu(k,3015) - lu(k,3092) = lu(k,3092) - lu(k,1127) * lu(k,3015) - lu(k,3285) = lu(k,3285) - lu(k,1125) * lu(k,3202) - lu(k,3291) = lu(k,3291) - lu(k,1126) * lu(k,3202) - lu(k,3295) = lu(k,3295) - lu(k,1127) * lu(k,3202) - lu(k,3335) = lu(k,3335) - lu(k,1125) * lu(k,3325) - lu(k,3341) = lu(k,3341) - lu(k,1126) * lu(k,3325) - lu(k,3345) = lu(k,3345) - lu(k,1127) * lu(k,3325) - lu(k,3746) = lu(k,3746) - lu(k,1125) * lu(k,3658) - lu(k,3752) = lu(k,3752) - lu(k,1126) * lu(k,3658) - lu(k,3756) = lu(k,3756) - lu(k,1127) * lu(k,3658) - lu(k,3827) = lu(k,3827) - lu(k,1125) * lu(k,3809) - lu(k,3833) = lu(k,3833) - lu(k,1126) * lu(k,3809) - lu(k,3837) = lu(k,3837) - lu(k,1127) * lu(k,3809) - lu(k,1132) = 1._r8 / lu(k,1132) - lu(k,1133) = lu(k,1133) * lu(k,1132) - lu(k,1134) = lu(k,1134) * lu(k,1132) - lu(k,1135) = lu(k,1135) * lu(k,1132) - lu(k,1136) = lu(k,1136) * lu(k,1132) - lu(k,1137) = lu(k,1137) * lu(k,1132) - lu(k,1138) = lu(k,1138) * lu(k,1132) - lu(k,1139) = lu(k,1139) * lu(k,1132) - lu(k,1140) = lu(k,1140) * lu(k,1132) - lu(k,1141) = lu(k,1141) * lu(k,1132) - lu(k,2817) = lu(k,2817) - lu(k,1133) * lu(k,2810) - lu(k,2820) = lu(k,2820) - lu(k,1134) * lu(k,2810) - lu(k,2864) = lu(k,2864) - lu(k,1135) * lu(k,2810) - lu(k,2882) = lu(k,2882) - lu(k,1136) * lu(k,2810) - lu(k,2885) = lu(k,2885) - lu(k,1137) * lu(k,2810) - lu(k,2889) = lu(k,2889) - lu(k,1138) * lu(k,2810) - lu(k,2891) = lu(k,2891) - lu(k,1139) * lu(k,2810) - lu(k,2894) = lu(k,2894) - lu(k,1140) * lu(k,2810) - lu(k,2895) = lu(k,2895) - lu(k,1141) * lu(k,2810) - lu(k,2928) = - lu(k,1133) * lu(k,2923) - lu(k,2931) = lu(k,2931) - lu(k,1134) * lu(k,2923) - lu(k,2965) = lu(k,2965) - lu(k,1135) * lu(k,2923) - lu(k,2983) = lu(k,2983) - lu(k,1136) * lu(k,2923) - lu(k,2986) = lu(k,2986) - lu(k,1137) * lu(k,2923) - lu(k,2990) = lu(k,2990) - lu(k,1138) * lu(k,2923) - lu(k,2992) = lu(k,2992) - lu(k,1139) * lu(k,2923) - lu(k,2995) = lu(k,2995) - lu(k,1140) * lu(k,2923) - lu(k,2996) = lu(k,2996) - lu(k,1141) * lu(k,2923) - lu(k,3020) = - lu(k,1133) * lu(k,3016) - lu(k,3022) = lu(k,3022) - lu(k,1134) * lu(k,3016) - lu(k,3057) = lu(k,3057) - lu(k,1135) * lu(k,3016) - lu(k,3075) = lu(k,3075) - lu(k,1136) * lu(k,3016) - lu(k,3078) = lu(k,3078) - lu(k,1137) * lu(k,3016) - lu(k,3082) = lu(k,3082) - lu(k,1138) * lu(k,3016) - lu(k,3084) = lu(k,3084) - lu(k,1139) * lu(k,3016) - lu(k,3087) = lu(k,3087) - lu(k,1140) * lu(k,3016) - lu(k,3088) = lu(k,3088) - lu(k,1141) * lu(k,3016) - lu(k,3210) = lu(k,3210) - lu(k,1133) * lu(k,3203) - lu(k,3213) = lu(k,3213) - lu(k,1134) * lu(k,3203) - lu(k,3260) = lu(k,3260) - lu(k,1135) * lu(k,3203) - lu(k,3278) = lu(k,3278) - lu(k,1136) * lu(k,3203) - lu(k,3281) = lu(k,3281) - lu(k,1137) * lu(k,3203) - lu(k,3285) = lu(k,3285) - lu(k,1138) * lu(k,3203) - lu(k,3287) = lu(k,3287) - lu(k,1139) * lu(k,3203) - lu(k,3290) = lu(k,3290) - lu(k,1140) * lu(k,3203) - lu(k,3291) = lu(k,3291) - lu(k,1141) * lu(k,3203) - lu(k,3670) = lu(k,3670) - lu(k,1133) * lu(k,3659) - lu(k,3674) = lu(k,3674) - lu(k,1134) * lu(k,3659) - lu(k,3721) = lu(k,3721) - lu(k,1135) * lu(k,3659) - lu(k,3739) = lu(k,3739) - lu(k,1136) * lu(k,3659) - lu(k,3742) = lu(k,3742) - lu(k,1137) * lu(k,3659) - lu(k,3746) = lu(k,3746) - lu(k,1138) * lu(k,3659) - lu(k,3748) = lu(k,3748) - lu(k,1139) * lu(k,3659) - lu(k,3751) = lu(k,3751) - lu(k,1140) * lu(k,3659) - lu(k,3752) = lu(k,3752) - lu(k,1141) * lu(k,3659) - lu(k,1144) = 1._r8 / lu(k,1144) - lu(k,1145) = lu(k,1145) * lu(k,1144) - lu(k,1146) = lu(k,1146) * lu(k,1144) - lu(k,1147) = lu(k,1147) * lu(k,1144) - lu(k,1148) = lu(k,1148) * lu(k,1144) - lu(k,1149) = lu(k,1149) * lu(k,1144) - lu(k,1150) = lu(k,1150) * lu(k,1144) - lu(k,1151) = lu(k,1151) * lu(k,1144) - lu(k,1152) = lu(k,1152) * lu(k,1144) - lu(k,1153) = lu(k,1153) * lu(k,1144) - lu(k,2296) = lu(k,2296) - lu(k,1145) * lu(k,2295) - lu(k,2299) = lu(k,2299) - lu(k,1146) * lu(k,2295) - lu(k,2302) = lu(k,2302) - lu(k,1147) * lu(k,2295) - lu(k,2304) = - lu(k,1148) * lu(k,2295) - lu(k,2315) = lu(k,2315) - lu(k,1149) * lu(k,2295) - lu(k,2317) = lu(k,2317) - lu(k,1150) * lu(k,2295) - lu(k,2320) = lu(k,2320) - lu(k,1151) * lu(k,2295) - lu(k,2321) = lu(k,2321) - lu(k,1152) * lu(k,2295) - lu(k,2322) = lu(k,2322) - lu(k,1153) * lu(k,2295) - lu(k,2355) = lu(k,2355) - lu(k,1145) * lu(k,2354) - lu(k,2358) = lu(k,2358) - lu(k,1146) * lu(k,2354) - lu(k,2362) = lu(k,2362) - lu(k,1147) * lu(k,2354) - lu(k,2363) = - lu(k,1148) * lu(k,2354) - lu(k,2376) = lu(k,2376) - lu(k,1149) * lu(k,2354) - lu(k,2378) = lu(k,2378) - lu(k,1150) * lu(k,2354) - lu(k,2381) = lu(k,2381) - lu(k,1151) * lu(k,2354) - lu(k,2382) = lu(k,2382) - lu(k,1152) * lu(k,2354) - lu(k,2383) = lu(k,2383) - lu(k,1153) * lu(k,2354) - lu(k,2812) = lu(k,2812) - lu(k,1145) * lu(k,2811) - lu(k,2831) = lu(k,2831) - lu(k,1146) * lu(k,2811) - lu(k,2867) = lu(k,2867) - lu(k,1147) * lu(k,2811) - lu(k,2872) = lu(k,2872) - lu(k,1148) * lu(k,2811) - lu(k,2885) = lu(k,2885) - lu(k,1149) * lu(k,2811) - lu(k,2889) = lu(k,2889) - lu(k,1150) * lu(k,2811) - lu(k,2894) = lu(k,2894) - lu(k,1151) * lu(k,2811) - lu(k,2895) = lu(k,2895) - lu(k,1152) * lu(k,2811) - lu(k,2899) = lu(k,2899) - lu(k,1153) * lu(k,2811) - lu(k,3205) = lu(k,3205) - lu(k,1145) * lu(k,3204) - lu(k,3227) = lu(k,3227) - lu(k,1146) * lu(k,3204) - lu(k,3263) = lu(k,3263) - lu(k,1147) * lu(k,3204) - lu(k,3268) = lu(k,3268) - lu(k,1148) * lu(k,3204) - lu(k,3281) = lu(k,3281) - lu(k,1149) * lu(k,3204) - lu(k,3285) = lu(k,3285) - lu(k,1150) * lu(k,3204) - lu(k,3290) = lu(k,3290) - lu(k,1151) * lu(k,3204) - lu(k,3291) = lu(k,3291) - lu(k,1152) * lu(k,3204) - lu(k,3295) = lu(k,3295) - lu(k,1153) * lu(k,3204) - lu(k,3661) = lu(k,3661) - lu(k,1145) * lu(k,3660) - lu(k,3688) = lu(k,3688) - lu(k,1146) * lu(k,3660) - lu(k,3724) = lu(k,3724) - lu(k,1147) * lu(k,3660) - lu(k,3729) = lu(k,3729) - lu(k,1148) * lu(k,3660) - lu(k,3742) = lu(k,3742) - lu(k,1149) * lu(k,3660) - lu(k,3746) = lu(k,3746) - lu(k,1150) * lu(k,3660) - lu(k,3751) = lu(k,3751) - lu(k,1151) * lu(k,3660) - lu(k,3752) = lu(k,3752) - lu(k,1152) * lu(k,3660) - lu(k,3756) = lu(k,3756) - lu(k,1153) * lu(k,3660) + lu(k,1142) = 1._r8 / lu(k,1142) + lu(k,1143) = lu(k,1143) * lu(k,1142) + lu(k,1144) = lu(k,1144) * lu(k,1142) + lu(k,1145) = lu(k,1145) * lu(k,1142) + lu(k,1146) = lu(k,1146) * lu(k,1142) + lu(k,1147) = lu(k,1147) * lu(k,1142) + lu(k,1148) = lu(k,1148) * lu(k,1142) + lu(k,1324) = lu(k,1324) - lu(k,1143) * lu(k,1322) + lu(k,1325) = lu(k,1325) - lu(k,1144) * lu(k,1322) + lu(k,1327) = lu(k,1327) - lu(k,1145) * lu(k,1322) + lu(k,1328) = lu(k,1328) - lu(k,1146) * lu(k,1322) + lu(k,1329) = lu(k,1329) - lu(k,1147) * lu(k,1322) + lu(k,1332) = - lu(k,1148) * lu(k,1322) + lu(k,2597) = lu(k,2597) - lu(k,1143) * lu(k,2590) + lu(k,2600) = lu(k,2600) - lu(k,1144) * lu(k,2590) + lu(k,2604) = lu(k,2604) - lu(k,1145) * lu(k,2590) + lu(k,2606) = lu(k,2606) - lu(k,1146) * lu(k,2590) + lu(k,2607) = lu(k,2607) - lu(k,1147) * lu(k,2590) + lu(k,2611) = - lu(k,1148) * lu(k,2590) + lu(k,3148) = lu(k,3148) - lu(k,1143) * lu(k,3143) + lu(k,3151) = lu(k,3151) - lu(k,1144) * lu(k,3143) + lu(k,3155) = lu(k,3155) - lu(k,1145) * lu(k,3143) + lu(k,3157) = lu(k,3157) - lu(k,1146) * lu(k,3143) + lu(k,3158) = lu(k,3158) - lu(k,1147) * lu(k,3143) + lu(k,3162) = lu(k,3162) - lu(k,1148) * lu(k,3143) + lu(k,3383) = lu(k,3383) - lu(k,1143) * lu(k,3371) + lu(k,3386) = lu(k,3386) - lu(k,1144) * lu(k,3371) + lu(k,3390) = lu(k,3390) - lu(k,1145) * lu(k,3371) + lu(k,3392) = lu(k,3392) - lu(k,1146) * lu(k,3371) + lu(k,3393) = lu(k,3393) - lu(k,1147) * lu(k,3371) + lu(k,3397) = lu(k,3397) - lu(k,1148) * lu(k,3371) + lu(k,3553) = lu(k,3553) - lu(k,1143) * lu(k,3477) + lu(k,3566) = lu(k,3566) - lu(k,1144) * lu(k,3477) + lu(k,3570) = lu(k,3570) - lu(k,1145) * lu(k,3477) + lu(k,3572) = lu(k,3572) - lu(k,1146) * lu(k,3477) + lu(k,3573) = lu(k,3573) - lu(k,1147) * lu(k,3477) + lu(k,3577) = lu(k,3577) - lu(k,1148) * lu(k,3477) + lu(k,3803) = lu(k,3803) - lu(k,1143) * lu(k,3718) + lu(k,3816) = lu(k,3816) - lu(k,1144) * lu(k,3718) + lu(k,3820) = lu(k,3820) - lu(k,1145) * lu(k,3718) + lu(k,3822) = lu(k,3822) - lu(k,1146) * lu(k,3718) + lu(k,3823) = lu(k,3823) - lu(k,1147) * lu(k,3718) + lu(k,3827) = lu(k,3827) - lu(k,1148) * lu(k,3718) + lu(k,3853) = lu(k,3853) - lu(k,1143) * lu(k,3837) + lu(k,3857) = lu(k,3857) - lu(k,1144) * lu(k,3837) + lu(k,3861) = - lu(k,1145) * lu(k,3837) + lu(k,3863) = lu(k,3863) - lu(k,1146) * lu(k,3837) + lu(k,3864) = lu(k,3864) - lu(k,1147) * lu(k,3837) + lu(k,3868) = lu(k,3868) - lu(k,1148) * lu(k,3837) + lu(k,1149) = 1._r8 / lu(k,1149) + lu(k,1150) = lu(k,1150) * lu(k,1149) + lu(k,1151) = lu(k,1151) * lu(k,1149) + lu(k,1152) = lu(k,1152) * lu(k,1149) + lu(k,1153) = lu(k,1153) * lu(k,1149) + lu(k,1154) = lu(k,1154) * lu(k,1149) + lu(k,1155) = lu(k,1155) * lu(k,1149) + lu(k,2292) = lu(k,2292) - lu(k,1150) * lu(k,2289) + lu(k,2297) = lu(k,2297) - lu(k,1151) * lu(k,2289) + lu(k,2306) = - lu(k,1152) * lu(k,2289) + lu(k,2310) = lu(k,2310) - lu(k,1153) * lu(k,2289) + lu(k,2313) = lu(k,2313) - lu(k,1154) * lu(k,2289) + lu(k,2314) = - lu(k,1155) * lu(k,2289) + lu(k,2492) = - lu(k,1150) * lu(k,2488) + lu(k,2498) = - lu(k,1151) * lu(k,2488) + lu(k,2510) = lu(k,2510) - lu(k,1152) * lu(k,2488) + lu(k,2514) = lu(k,2514) - lu(k,1153) * lu(k,2488) + lu(k,2517) = lu(k,2517) - lu(k,1154) * lu(k,2488) + lu(k,2518) = - lu(k,1155) * lu(k,2488) + lu(k,2524) = lu(k,2524) - lu(k,1150) * lu(k,2521) + lu(k,2529) = lu(k,2529) - lu(k,1151) * lu(k,2521) + lu(k,2539) = - lu(k,1152) * lu(k,2521) + lu(k,2543) = lu(k,2543) - lu(k,1153) * lu(k,2521) + lu(k,2546) = lu(k,2546) - lu(k,1154) * lu(k,2521) + lu(k,2547) = lu(k,2547) - lu(k,1155) * lu(k,2521) + lu(k,2688) = - lu(k,1150) * lu(k,2684) + lu(k,2696) = - lu(k,1151) * lu(k,2684) + lu(k,2711) = lu(k,2711) - lu(k,1152) * lu(k,2684) + lu(k,2715) = lu(k,2715) - lu(k,1153) * lu(k,2684) + lu(k,2719) = lu(k,2719) - lu(k,1154) * lu(k,2684) + lu(k,2720) = - lu(k,1155) * lu(k,2684) + lu(k,3249) = lu(k,3249) - lu(k,1150) * lu(k,3226) + lu(k,3288) = lu(k,3288) - lu(k,1151) * lu(k,3226) + lu(k,3312) = lu(k,3312) - lu(k,1152) * lu(k,3226) + lu(k,3316) = lu(k,3316) - lu(k,1153) * lu(k,3226) + lu(k,3320) = lu(k,3320) - lu(k,1154) * lu(k,3226) + lu(k,3321) = lu(k,3321) - lu(k,1155) * lu(k,3226) + lu(k,3503) = lu(k,3503) - lu(k,1150) * lu(k,3478) + lu(k,3544) = lu(k,3544) - lu(k,1151) * lu(k,3478) + lu(k,3568) = lu(k,3568) - lu(k,1152) * lu(k,3478) + lu(k,3572) = lu(k,3572) - lu(k,1153) * lu(k,3478) + lu(k,3576) = lu(k,3576) - lu(k,1154) * lu(k,3478) + lu(k,3577) = lu(k,3577) - lu(k,1155) * lu(k,3478) + lu(k,3753) = lu(k,3753) - lu(k,1150) * lu(k,3719) + lu(k,3794) = lu(k,3794) - lu(k,1151) * lu(k,3719) + lu(k,3818) = lu(k,3818) - lu(k,1152) * lu(k,3719) + lu(k,3822) = lu(k,3822) - lu(k,1153) * lu(k,3719) + lu(k,3826) = lu(k,3826) - lu(k,1154) * lu(k,3719) + lu(k,3827) = lu(k,3827) - lu(k,1155) * lu(k,3719) + lu(k,1156) = 1._r8 / lu(k,1156) + lu(k,1157) = lu(k,1157) * lu(k,1156) + lu(k,1158) = lu(k,1158) * lu(k,1156) + lu(k,1159) = lu(k,1159) * lu(k,1156) + lu(k,1160) = lu(k,1160) * lu(k,1156) + lu(k,1161) = lu(k,1161) * lu(k,1156) + lu(k,1162) = lu(k,1162) * lu(k,1156) + lu(k,1163) = lu(k,1163) * lu(k,1156) + lu(k,2199) = lu(k,2199) - lu(k,1157) * lu(k,2197) + lu(k,2200) = lu(k,2200) - lu(k,1158) * lu(k,2197) + lu(k,2201) = - lu(k,1159) * lu(k,2197) + lu(k,2202) = - lu(k,1160) * lu(k,2197) + lu(k,2205) = - lu(k,1161) * lu(k,2197) + lu(k,2207) = - lu(k,1162) * lu(k,2197) + lu(k,2208) = - lu(k,1163) * lu(k,2197) + lu(k,2634) = lu(k,2634) - lu(k,1157) * lu(k,2631) + lu(k,2636) = lu(k,2636) - lu(k,1158) * lu(k,2631) + lu(k,2637) = lu(k,2637) - lu(k,1159) * lu(k,2631) + lu(k,2639) = lu(k,2639) - lu(k,1160) * lu(k,2631) + lu(k,2645) = lu(k,2645) - lu(k,1161) * lu(k,2631) + lu(k,2647) = lu(k,2647) - lu(k,1162) * lu(k,2631) + lu(k,2652) = lu(k,2652) - lu(k,1163) * lu(k,2631) + lu(k,3348) = lu(k,3348) - lu(k,1157) * lu(k,3342) + lu(k,3350) = - lu(k,1158) * lu(k,3342) + lu(k,3351) = lu(k,3351) - lu(k,1159) * lu(k,3342) + lu(k,3353) = - lu(k,1160) * lu(k,3342) + lu(k,3359) = lu(k,3359) - lu(k,1161) * lu(k,3342) + lu(k,3361) = lu(k,3361) - lu(k,1162) * lu(k,3342) + lu(k,3366) = lu(k,3366) - lu(k,1163) * lu(k,3342) + lu(k,3379) = lu(k,3379) - lu(k,1157) * lu(k,3372) + lu(k,3381) = lu(k,3381) - lu(k,1158) * lu(k,3372) + lu(k,3382) = lu(k,3382) - lu(k,1159) * lu(k,3372) + lu(k,3384) = - lu(k,1160) * lu(k,3372) + lu(k,3390) = lu(k,3390) - lu(k,1161) * lu(k,3372) + lu(k,3392) = lu(k,3392) - lu(k,1162) * lu(k,3372) + lu(k,3397) = lu(k,3397) - lu(k,1163) * lu(k,3372) + lu(k,3536) = lu(k,3536) - lu(k,1157) * lu(k,3479) + lu(k,3551) = lu(k,3551) - lu(k,1158) * lu(k,3479) + lu(k,3552) = lu(k,3552) - lu(k,1159) * lu(k,3479) + lu(k,3554) = - lu(k,1160) * lu(k,3479) + lu(k,3570) = lu(k,3570) - lu(k,1161) * lu(k,3479) + lu(k,3572) = lu(k,3572) - lu(k,1162) * lu(k,3479) + lu(k,3577) = lu(k,3577) - lu(k,1163) * lu(k,3479) + lu(k,3787) = lu(k,3787) - lu(k,1157) * lu(k,3720) + lu(k,3801) = lu(k,3801) - lu(k,1158) * lu(k,3720) + lu(k,3802) = lu(k,3802) - lu(k,1159) * lu(k,3720) + lu(k,3804) = lu(k,3804) - lu(k,1160) * lu(k,3720) + lu(k,3820) = lu(k,3820) - lu(k,1161) * lu(k,3720) + lu(k,3822) = lu(k,3822) - lu(k,1162) * lu(k,3720) + lu(k,3827) = lu(k,3827) - lu(k,1163) * lu(k,3720) + lu(k,1164) = 1._r8 / lu(k,1164) + lu(k,1165) = lu(k,1165) * lu(k,1164) + lu(k,1166) = lu(k,1166) * lu(k,1164) + lu(k,1167) = lu(k,1167) * lu(k,1164) + lu(k,1168) = lu(k,1168) * lu(k,1164) + lu(k,1169) = lu(k,1169) * lu(k,1164) + lu(k,1170) = lu(k,1170) * lu(k,1164) + lu(k,1171) = lu(k,1171) * lu(k,1164) + lu(k,1172) = lu(k,1172) * lu(k,1164) + lu(k,1173) = lu(k,1173) * lu(k,1164) + lu(k,1174) = lu(k,1174) * lu(k,1164) + lu(k,1175) = lu(k,1175) * lu(k,1164) + lu(k,1944) = - lu(k,1165) * lu(k,1943) + lu(k,1947) = - lu(k,1166) * lu(k,1943) + lu(k,1948) = lu(k,1948) - lu(k,1167) * lu(k,1943) + lu(k,1949) = - lu(k,1168) * lu(k,1943) + lu(k,1951) = lu(k,1951) - lu(k,1169) * lu(k,1943) + lu(k,1952) = - lu(k,1170) * lu(k,1943) + lu(k,1965) = lu(k,1965) - lu(k,1171) * lu(k,1943) + lu(k,1967) = lu(k,1967) - lu(k,1172) * lu(k,1943) + lu(k,1969) = lu(k,1969) - lu(k,1173) * lu(k,1943) + lu(k,1970) = lu(k,1970) - lu(k,1174) * lu(k,1943) + lu(k,1973) = lu(k,1973) - lu(k,1175) * lu(k,1943) + lu(k,3242) = lu(k,3242) - lu(k,1165) * lu(k,3227) + lu(k,3255) = lu(k,3255) - lu(k,1166) * lu(k,3227) + lu(k,3258) = lu(k,3258) - lu(k,1167) * lu(k,3227) + lu(k,3260) = lu(k,3260) - lu(k,1168) * lu(k,3227) + lu(k,3262) = lu(k,3262) - lu(k,1169) * lu(k,3227) + lu(k,3264) = lu(k,3264) - lu(k,1170) * lu(k,3227) + lu(k,3311) = lu(k,3311) - lu(k,1171) * lu(k,3227) + lu(k,3313) = lu(k,3313) - lu(k,1172) * lu(k,3227) + lu(k,3315) = lu(k,3315) - lu(k,1173) * lu(k,3227) + lu(k,3316) = lu(k,3316) - lu(k,1174) * lu(k,3227) + lu(k,3320) = lu(k,3320) - lu(k,1175) * lu(k,3227) + lu(k,3496) = lu(k,3496) - lu(k,1165) * lu(k,3480) + lu(k,3510) = lu(k,3510) - lu(k,1166) * lu(k,3480) + lu(k,3514) = lu(k,3514) - lu(k,1167) * lu(k,3480) + lu(k,3516) = lu(k,3516) - lu(k,1168) * lu(k,3480) + lu(k,3518) = lu(k,3518) - lu(k,1169) * lu(k,3480) + lu(k,3520) = lu(k,3520) - lu(k,1170) * lu(k,3480) + lu(k,3567) = lu(k,3567) - lu(k,1171) * lu(k,3480) + lu(k,3569) = lu(k,3569) - lu(k,1172) * lu(k,3480) + lu(k,3571) = lu(k,3571) - lu(k,1173) * lu(k,3480) + lu(k,3572) = lu(k,3572) - lu(k,1174) * lu(k,3480) + lu(k,3576) = lu(k,3576) - lu(k,1175) * lu(k,3480) + lu(k,3745) = lu(k,3745) - lu(k,1165) * lu(k,3721) + lu(k,3761) = lu(k,3761) - lu(k,1166) * lu(k,3721) + lu(k,3765) = lu(k,3765) - lu(k,1167) * lu(k,3721) + lu(k,3767) = lu(k,3767) - lu(k,1168) * lu(k,3721) + lu(k,3769) = lu(k,3769) - lu(k,1169) * lu(k,3721) + lu(k,3771) = lu(k,3771) - lu(k,1170) * lu(k,3721) + lu(k,3817) = lu(k,3817) - lu(k,1171) * lu(k,3721) + lu(k,3819) = lu(k,3819) - lu(k,1172) * lu(k,3721) + lu(k,3821) = lu(k,3821) - lu(k,1173) * lu(k,3721) + lu(k,3822) = lu(k,3822) - lu(k,1174) * lu(k,3721) + lu(k,3826) = lu(k,3826) - lu(k,1175) * lu(k,3721) end do end subroutine lu_fac25 subroutine lu_fac26( avec_len, lu ) @@ -4389,286 +4272,228 @@ subroutine lu_fac26( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1154) = 1._r8 / lu(k,1154) - lu(k,1155) = lu(k,1155) * lu(k,1154) - lu(k,1156) = lu(k,1156) * lu(k,1154) - lu(k,1157) = lu(k,1157) * lu(k,1154) - lu(k,1158) = lu(k,1158) * lu(k,1154) - lu(k,1159) = lu(k,1159) * lu(k,1154) - lu(k,1589) = lu(k,1589) - lu(k,1155) * lu(k,1588) - lu(k,1593) = - lu(k,1156) * lu(k,1588) - lu(k,1595) = lu(k,1595) - lu(k,1157) * lu(k,1588) - lu(k,1596) = lu(k,1596) - lu(k,1158) * lu(k,1588) - lu(k,1597) = lu(k,1597) - lu(k,1159) * lu(k,1588) - lu(k,1602) = lu(k,1602) - lu(k,1155) * lu(k,1600) - lu(k,1606) = lu(k,1606) - lu(k,1156) * lu(k,1600) - lu(k,1608) = lu(k,1608) - lu(k,1157) * lu(k,1600) - lu(k,1609) = lu(k,1609) - lu(k,1158) * lu(k,1600) - lu(k,1610) = lu(k,1610) - lu(k,1159) * lu(k,1600) - lu(k,2118) = lu(k,2118) - lu(k,1155) * lu(k,2115) - lu(k,2128) = lu(k,2128) - lu(k,1156) * lu(k,2115) - lu(k,2131) = lu(k,2131) - lu(k,1157) * lu(k,2115) - lu(k,2134) = lu(k,2134) - lu(k,1158) * lu(k,2115) - lu(k,2135) = lu(k,2135) - lu(k,1159) * lu(k,2115) - lu(k,2299) = lu(k,2299) - lu(k,1155) * lu(k,2296) - lu(k,2313) = lu(k,2313) - lu(k,1156) * lu(k,2296) - lu(k,2317) = lu(k,2317) - lu(k,1157) * lu(k,2296) - lu(k,2320) = lu(k,2320) - lu(k,1158) * lu(k,2296) - lu(k,2321) = lu(k,2321) - lu(k,1159) * lu(k,2296) - lu(k,2329) = lu(k,2329) - lu(k,1155) * lu(k,2326) - lu(k,2340) = lu(k,2340) - lu(k,1156) * lu(k,2326) - lu(k,2344) = lu(k,2344) - lu(k,1157) * lu(k,2326) - lu(k,2347) = lu(k,2347) - lu(k,1158) * lu(k,2326) - lu(k,2348) = lu(k,2348) - lu(k,1159) * lu(k,2326) - lu(k,2358) = lu(k,2358) - lu(k,1155) * lu(k,2355) - lu(k,2374) = lu(k,2374) - lu(k,1156) * lu(k,2355) - lu(k,2378) = lu(k,2378) - lu(k,1157) * lu(k,2355) - lu(k,2381) = lu(k,2381) - lu(k,1158) * lu(k,2355) - lu(k,2382) = lu(k,2382) - lu(k,1159) * lu(k,2355) - lu(k,2831) = lu(k,2831) - lu(k,1155) * lu(k,2812) - lu(k,2883) = lu(k,2883) - lu(k,1156) * lu(k,2812) - lu(k,2889) = lu(k,2889) - lu(k,1157) * lu(k,2812) - lu(k,2894) = lu(k,2894) - lu(k,1158) * lu(k,2812) - lu(k,2895) = lu(k,2895) - lu(k,1159) * lu(k,2812) - lu(k,3227) = lu(k,3227) - lu(k,1155) * lu(k,3205) - lu(k,3279) = lu(k,3279) - lu(k,1156) * lu(k,3205) - lu(k,3285) = lu(k,3285) - lu(k,1157) * lu(k,3205) - lu(k,3290) = lu(k,3290) - lu(k,1158) * lu(k,3205) - lu(k,3291) = lu(k,3291) - lu(k,1159) * lu(k,3205) - lu(k,3688) = lu(k,3688) - lu(k,1155) * lu(k,3661) - lu(k,3740) = lu(k,3740) - lu(k,1156) * lu(k,3661) - lu(k,3746) = lu(k,3746) - lu(k,1157) * lu(k,3661) - lu(k,3751) = lu(k,3751) - lu(k,1158) * lu(k,3661) - lu(k,3752) = lu(k,3752) - lu(k,1159) * lu(k,3661) - lu(k,1161) = 1._r8 / lu(k,1161) - lu(k,1162) = lu(k,1162) * lu(k,1161) - lu(k,1163) = lu(k,1163) * lu(k,1161) - lu(k,1164) = lu(k,1164) * lu(k,1161) - lu(k,1165) = lu(k,1165) * lu(k,1161) - lu(k,1166) = lu(k,1166) * lu(k,1161) - lu(k,1513) = lu(k,1513) - lu(k,1162) * lu(k,1512) - lu(k,1518) = - lu(k,1163) * lu(k,1512) - lu(k,1520) = lu(k,1520) - lu(k,1164) * lu(k,1512) - lu(k,1522) = lu(k,1522) - lu(k,1165) * lu(k,1512) - lu(k,1525) = - lu(k,1166) * lu(k,1512) - lu(k,2938) = lu(k,2938) - lu(k,1162) * lu(k,2924) - lu(k,2990) = lu(k,2990) - lu(k,1163) * lu(k,2924) - lu(k,2994) = lu(k,2994) - lu(k,1164) * lu(k,2924) - lu(k,2996) = lu(k,2996) - lu(k,1165) * lu(k,2924) - lu(k,3000) = lu(k,3000) - lu(k,1166) * lu(k,2924) - lu(k,3030) = - lu(k,1162) * lu(k,3017) - lu(k,3082) = lu(k,3082) - lu(k,1163) * lu(k,3017) - lu(k,3086) = lu(k,3086) - lu(k,1164) * lu(k,3017) - lu(k,3088) = lu(k,3088) - lu(k,1165) * lu(k,3017) - lu(k,3092) = lu(k,3092) - lu(k,1166) * lu(k,3017) - lu(k,3303) = lu(k,3303) - lu(k,1162) * lu(k,3301) - lu(k,3311) = lu(k,3311) - lu(k,1163) * lu(k,3301) - lu(k,3315) = lu(k,3315) - lu(k,1164) * lu(k,3301) - lu(k,3317) = lu(k,3317) - lu(k,1165) * lu(k,3301) - lu(k,3321) = lu(k,3321) - lu(k,1166) * lu(k,3301) - lu(k,3447) = lu(k,3447) - lu(k,1162) * lu(k,3443) - lu(k,3456) = lu(k,3456) - lu(k,1163) * lu(k,3443) - lu(k,3460) = lu(k,3460) - lu(k,1164) * lu(k,3443) - lu(k,3462) = lu(k,3462) - lu(k,1165) * lu(k,3443) - lu(k,3466) = lu(k,3466) - lu(k,1166) * lu(k,3443) - lu(k,3489) = lu(k,3489) - lu(k,1162) * lu(k,3484) - lu(k,3506) = lu(k,3506) - lu(k,1163) * lu(k,3484) - lu(k,3510) = lu(k,3510) - lu(k,1164) * lu(k,3484) - lu(k,3512) = lu(k,3512) - lu(k,1165) * lu(k,3484) - lu(k,3516) = lu(k,3516) - lu(k,1166) * lu(k,3484) - lu(k,3692) = lu(k,3692) - lu(k,1162) * lu(k,3662) - lu(k,3746) = lu(k,3746) - lu(k,1163) * lu(k,3662) - lu(k,3750) = lu(k,3750) - lu(k,1164) * lu(k,3662) - lu(k,3752) = lu(k,3752) - lu(k,1165) * lu(k,3662) - lu(k,3756) = lu(k,3756) - lu(k,1166) * lu(k,3662) - lu(k,3784) = lu(k,3784) - lu(k,1162) * lu(k,3783) - lu(k,3792) = lu(k,3792) - lu(k,1163) * lu(k,3783) - lu(k,3796) = lu(k,3796) - lu(k,1164) * lu(k,3783) - lu(k,3798) = lu(k,3798) - lu(k,1165) * lu(k,3783) - lu(k,3802) = lu(k,3802) - lu(k,1166) * lu(k,3783) - lu(k,3844) = - lu(k,1162) * lu(k,3842) - lu(k,3852) = - lu(k,1163) * lu(k,3842) - lu(k,3856) = lu(k,3856) - lu(k,1164) * lu(k,3842) - lu(k,3858) = lu(k,3858) - lu(k,1165) * lu(k,3842) - lu(k,3862) = lu(k,3862) - lu(k,1166) * lu(k,3842) - lu(k,1167) = 1._r8 / lu(k,1167) - lu(k,1168) = lu(k,1168) * lu(k,1167) - lu(k,1169) = lu(k,1169) * lu(k,1167) - lu(k,1170) = lu(k,1170) * lu(k,1167) - lu(k,1171) = lu(k,1171) * lu(k,1167) - lu(k,1172) = lu(k,1172) * lu(k,1167) - lu(k,1173) = lu(k,1173) * lu(k,1167) - lu(k,1174) = lu(k,1174) * lu(k,1167) - lu(k,2443) = - lu(k,1168) * lu(k,2440) - lu(k,2447) = lu(k,2447) - lu(k,1169) * lu(k,2440) - lu(k,2448) = lu(k,2448) - lu(k,1170) * lu(k,2440) - lu(k,2452) = - lu(k,1171) * lu(k,2440) - lu(k,2455) = lu(k,2455) - lu(k,1172) * lu(k,2440) - lu(k,2456) = lu(k,2456) - lu(k,1173) * lu(k,2440) - lu(k,2460) = lu(k,2460) - lu(k,1174) * lu(k,2440) - lu(k,2602) = lu(k,2602) - lu(k,1168) * lu(k,2599) - lu(k,2624) = lu(k,2624) - lu(k,1169) * lu(k,2599) - lu(k,2625) = lu(k,2625) - lu(k,1170) * lu(k,2599) - lu(k,2629) = - lu(k,1171) * lu(k,2599) - lu(k,2633) = lu(k,2633) - lu(k,1172) * lu(k,2599) - lu(k,2634) = lu(k,2634) - lu(k,1173) * lu(k,2599) - lu(k,2639) = lu(k,2639) - lu(k,1174) * lu(k,2599) - lu(k,2940) = lu(k,2940) - lu(k,1168) * lu(k,2925) - lu(k,2979) = lu(k,2979) - lu(k,1169) * lu(k,2925) - lu(k,2980) = lu(k,2980) - lu(k,1170) * lu(k,2925) - lu(k,2984) = - lu(k,1171) * lu(k,2925) - lu(k,2988) = lu(k,2988) - lu(k,1172) * lu(k,2925) - lu(k,2990) = lu(k,2990) - lu(k,1173) * lu(k,2925) - lu(k,2996) = lu(k,2996) - lu(k,1174) * lu(k,2925) - lu(k,3031) = lu(k,3031) - lu(k,1168) * lu(k,3018) - lu(k,3071) = lu(k,3071) - lu(k,1169) * lu(k,3018) - lu(k,3072) = lu(k,3072) - lu(k,1170) * lu(k,3018) - lu(k,3076) = lu(k,3076) - lu(k,1171) * lu(k,3018) - lu(k,3080) = lu(k,3080) - lu(k,1172) * lu(k,3018) - lu(k,3082) = lu(k,3082) - lu(k,1173) * lu(k,3018) - lu(k,3088) = lu(k,3088) - lu(k,1174) * lu(k,3018) - lu(k,3374) = lu(k,3374) - lu(k,1168) * lu(k,3355) - lu(k,3415) = lu(k,3415) - lu(k,1169) * lu(k,3355) - lu(k,3416) = lu(k,3416) - lu(k,1170) * lu(k,3355) - lu(k,3420) = lu(k,3420) - lu(k,1171) * lu(k,3355) - lu(k,3424) = - lu(k,1172) * lu(k,3355) - lu(k,3426) = lu(k,3426) - lu(k,1173) * lu(k,3355) - lu(k,3432) = lu(k,3432) - lu(k,1174) * lu(k,3355) - lu(k,3490) = lu(k,3490) - lu(k,1168) * lu(k,3485) - lu(k,3495) = - lu(k,1169) * lu(k,3485) - lu(k,3496) = lu(k,3496) - lu(k,1170) * lu(k,3485) - lu(k,3500) = lu(k,3500) - lu(k,1171) * lu(k,3485) - lu(k,3504) = lu(k,3504) - lu(k,1172) * lu(k,3485) - lu(k,3506) = lu(k,3506) - lu(k,1173) * lu(k,3485) - lu(k,3512) = lu(k,3512) - lu(k,1174) * lu(k,3485) - lu(k,3694) = lu(k,3694) - lu(k,1168) * lu(k,3663) - lu(k,3735) = lu(k,3735) - lu(k,1169) * lu(k,3663) - lu(k,3736) = lu(k,3736) - lu(k,1170) * lu(k,3663) - lu(k,3740) = lu(k,3740) - lu(k,1171) * lu(k,3663) - lu(k,3744) = lu(k,3744) - lu(k,1172) * lu(k,3663) - lu(k,3746) = lu(k,3746) - lu(k,1173) * lu(k,3663) - lu(k,3752) = lu(k,3752) - lu(k,1174) * lu(k,3663) - lu(k,1176) = 1._r8 / lu(k,1176) - lu(k,1177) = lu(k,1177) * lu(k,1176) - lu(k,1178) = lu(k,1178) * lu(k,1176) - lu(k,1179) = lu(k,1179) * lu(k,1176) - lu(k,1260) = lu(k,1260) - lu(k,1177) * lu(k,1254) - lu(k,1266) = lu(k,1266) - lu(k,1178) * lu(k,1254) - lu(k,1269) = lu(k,1269) - lu(k,1179) * lu(k,1254) - lu(k,1406) = lu(k,1406) - lu(k,1177) * lu(k,1403) - lu(k,1411) = lu(k,1411) - lu(k,1178) * lu(k,1403) - lu(k,1413) = lu(k,1413) - lu(k,1179) * lu(k,1403) - lu(k,1443) = lu(k,1443) - lu(k,1177) * lu(k,1431) - lu(k,1455) = lu(k,1455) - lu(k,1178) * lu(k,1431) - lu(k,1459) = lu(k,1459) - lu(k,1179) * lu(k,1431) - lu(k,1470) = lu(k,1470) - lu(k,1177) * lu(k,1468) - lu(k,1471) = lu(k,1471) - lu(k,1178) * lu(k,1468) - lu(k,1473) = lu(k,1473) - lu(k,1179) * lu(k,1468) - lu(k,1481) = lu(k,1481) - lu(k,1177) * lu(k,1475) - lu(k,1490) = lu(k,1490) - lu(k,1178) * lu(k,1475) - lu(k,1493) = lu(k,1493) - lu(k,1179) * lu(k,1475) - lu(k,1530) = lu(k,1530) - lu(k,1177) * lu(k,1527) - lu(k,1536) = lu(k,1536) - lu(k,1178) * lu(k,1527) - lu(k,1539) = lu(k,1539) - lu(k,1179) * lu(k,1527) - lu(k,1632) = lu(k,1632) - lu(k,1177) * lu(k,1628) - lu(k,1640) = - lu(k,1178) * lu(k,1628) - lu(k,1643) = lu(k,1643) - lu(k,1179) * lu(k,1628) - lu(k,1886) = lu(k,1886) - lu(k,1177) * lu(k,1880) - lu(k,1906) = lu(k,1906) - lu(k,1178) * lu(k,1880) - lu(k,1910) = lu(k,1910) - lu(k,1179) * lu(k,1880) - lu(k,1923) = lu(k,1923) - lu(k,1177) * lu(k,1914) - lu(k,1938) = lu(k,1938) - lu(k,1178) * lu(k,1914) - lu(k,1942) = lu(k,1942) - lu(k,1179) * lu(k,1914) - lu(k,1957) = lu(k,1957) - lu(k,1177) * lu(k,1948) - lu(k,1972) = lu(k,1972) - lu(k,1178) * lu(k,1948) - lu(k,1976) = lu(k,1976) - lu(k,1179) * lu(k,1948) - lu(k,1986) = lu(k,1986) - lu(k,1177) * lu(k,1980) - lu(k,2000) = lu(k,2000) - lu(k,1178) * lu(k,1980) - lu(k,2004) = lu(k,2004) - lu(k,1179) * lu(k,1980) - lu(k,2836) = lu(k,2836) - lu(k,1177) * lu(k,2813) - lu(k,2889) = lu(k,2889) - lu(k,1178) * lu(k,2813) - lu(k,2895) = lu(k,2895) - lu(k,1179) * lu(k,2813) - lu(k,2940) = lu(k,2940) - lu(k,1177) * lu(k,2926) - lu(k,2990) = lu(k,2990) - lu(k,1178) * lu(k,2926) - lu(k,2996) = lu(k,2996) - lu(k,1179) * lu(k,2926) - lu(k,3232) = lu(k,3232) - lu(k,1177) * lu(k,3206) - lu(k,3285) = lu(k,3285) - lu(k,1178) * lu(k,3206) - lu(k,3291) = lu(k,3291) - lu(k,1179) * lu(k,3206) - lu(k,3490) = lu(k,3490) - lu(k,1177) * lu(k,3486) - lu(k,3506) = lu(k,3506) - lu(k,1178) * lu(k,3486) - lu(k,3512) = lu(k,3512) - lu(k,1179) * lu(k,3486) - lu(k,3694) = lu(k,3694) - lu(k,1177) * lu(k,3664) - lu(k,3746) = lu(k,3746) - lu(k,1178) * lu(k,3664) - lu(k,3752) = lu(k,3752) - lu(k,1179) * lu(k,3664) - lu(k,3818) = lu(k,3818) - lu(k,1177) * lu(k,3810) - lu(k,3827) = lu(k,3827) - lu(k,1178) * lu(k,3810) - lu(k,3833) = lu(k,3833) - lu(k,1179) * lu(k,3810) - lu(k,1180) = 1._r8 / lu(k,1180) - lu(k,1181) = lu(k,1181) * lu(k,1180) - lu(k,1182) = lu(k,1182) * lu(k,1180) - lu(k,1183) = lu(k,1183) * lu(k,1180) - lu(k,1184) = lu(k,1184) * lu(k,1180) - lu(k,1185) = lu(k,1185) * lu(k,1180) - lu(k,1186) = lu(k,1186) * lu(k,1180) - lu(k,1187) = lu(k,1187) * lu(k,1180) - lu(k,1188) = lu(k,1188) * lu(k,1180) - lu(k,1189) = lu(k,1189) * lu(k,1180) - lu(k,1190) = lu(k,1190) * lu(k,1180) - lu(k,1191) = lu(k,1191) * lu(k,1180) - lu(k,1192) = lu(k,1192) * lu(k,1180) - lu(k,1193) = lu(k,1193) * lu(k,1180) - lu(k,2014) = - lu(k,1181) * lu(k,2012) - lu(k,2016) = - lu(k,1182) * lu(k,2012) - lu(k,2017) = lu(k,2017) - lu(k,1183) * lu(k,2012) - lu(k,2020) = - lu(k,1184) * lu(k,2012) - lu(k,2022) = lu(k,2022) - lu(k,1185) * lu(k,2012) - lu(k,2024) = lu(k,2024) - lu(k,1186) * lu(k,2012) - lu(k,2025) = - lu(k,1187) * lu(k,2012) - lu(k,2028) = lu(k,2028) - lu(k,1188) * lu(k,2012) - lu(k,2039) = lu(k,2039) - lu(k,1189) * lu(k,2012) - lu(k,2042) = lu(k,2042) - lu(k,1190) * lu(k,2012) - lu(k,2043) = lu(k,2043) - lu(k,1191) * lu(k,2012) - lu(k,2046) = lu(k,2046) - lu(k,1192) * lu(k,2012) - lu(k,2047) = lu(k,2047) - lu(k,1193) * lu(k,2012) - lu(k,2819) = lu(k,2819) - lu(k,1181) * lu(k,2814) - lu(k,2823) = lu(k,2823) - lu(k,1182) * lu(k,2814) - lu(k,2824) = lu(k,2824) - lu(k,1183) * lu(k,2814) - lu(k,2832) = lu(k,2832) - lu(k,1184) * lu(k,2814) - lu(k,2835) = lu(k,2835) - lu(k,1185) * lu(k,2814) - lu(k,2841) = lu(k,2841) - lu(k,1186) * lu(k,2814) - lu(k,2842) = lu(k,2842) - lu(k,1187) * lu(k,2814) - lu(k,2851) = lu(k,2851) - lu(k,1188) * lu(k,2814) - lu(k,2885) = lu(k,2885) - lu(k,1189) * lu(k,2814) - lu(k,2889) = lu(k,2889) - lu(k,1190) * lu(k,2814) - lu(k,2891) = lu(k,2891) - lu(k,1191) * lu(k,2814) - lu(k,2894) = lu(k,2894) - lu(k,1192) * lu(k,2814) - lu(k,2895) = lu(k,2895) - lu(k,1193) * lu(k,2814) - lu(k,3212) = lu(k,3212) - lu(k,1181) * lu(k,3207) - lu(k,3216) = lu(k,3216) - lu(k,1182) * lu(k,3207) - lu(k,3217) = lu(k,3217) - lu(k,1183) * lu(k,3207) - lu(k,3228) = lu(k,3228) - lu(k,1184) * lu(k,3207) - lu(k,3231) = lu(k,3231) - lu(k,1185) * lu(k,3207) - lu(k,3237) = lu(k,3237) - lu(k,1186) * lu(k,3207) - lu(k,3238) = lu(k,3238) - lu(k,1187) * lu(k,3207) - lu(k,3247) = lu(k,3247) - lu(k,1188) * lu(k,3207) - lu(k,3281) = lu(k,3281) - lu(k,1189) * lu(k,3207) - lu(k,3285) = lu(k,3285) - lu(k,1190) * lu(k,3207) - lu(k,3287) = lu(k,3287) - lu(k,1191) * lu(k,3207) - lu(k,3290) = lu(k,3290) - lu(k,1192) * lu(k,3207) - lu(k,3291) = lu(k,3291) - lu(k,1193) * lu(k,3207) - lu(k,3672) = lu(k,3672) - lu(k,1181) * lu(k,3665) - lu(k,3677) = lu(k,3677) - lu(k,1182) * lu(k,3665) - lu(k,3678) = lu(k,3678) - lu(k,1183) * lu(k,3665) - lu(k,3689) = lu(k,3689) - lu(k,1184) * lu(k,3665) - lu(k,3693) = lu(k,3693) - lu(k,1185) * lu(k,3665) - lu(k,3699) = lu(k,3699) - lu(k,1186) * lu(k,3665) - lu(k,3700) = lu(k,3700) - lu(k,1187) * lu(k,3665) - lu(k,3709) = lu(k,3709) - lu(k,1188) * lu(k,3665) - lu(k,3742) = lu(k,3742) - lu(k,1189) * lu(k,3665) - lu(k,3746) = lu(k,3746) - lu(k,1190) * lu(k,3665) - lu(k,3748) = lu(k,3748) - lu(k,1191) * lu(k,3665) - lu(k,3751) = lu(k,3751) - lu(k,1192) * lu(k,3665) - lu(k,3752) = lu(k,3752) - lu(k,1193) * lu(k,3665) + lu(k,1178) = 1._r8 / lu(k,1178) + lu(k,1179) = lu(k,1179) * lu(k,1178) + lu(k,1180) = lu(k,1180) * lu(k,1178) + lu(k,1181) = lu(k,1181) * lu(k,1178) + lu(k,1182) = lu(k,1182) * lu(k,1178) + lu(k,1183) = lu(k,1183) * lu(k,1178) + lu(k,1184) = lu(k,1184) * lu(k,1178) + lu(k,1185) = lu(k,1185) * lu(k,1178) + lu(k,1186) = lu(k,1186) * lu(k,1178) + lu(k,1187) = lu(k,1187) * lu(k,1178) + lu(k,1188) = lu(k,1188) * lu(k,1178) + lu(k,1189) = lu(k,1189) * lu(k,1178) + lu(k,1190) = lu(k,1190) * lu(k,1178) + lu(k,1191) = lu(k,1191) * lu(k,1178) + lu(k,1192) = lu(k,1192) * lu(k,1178) + lu(k,1193) = lu(k,1193) * lu(k,1178) + lu(k,2157) = - lu(k,1179) * lu(k,2155) + lu(k,2158) = - lu(k,1180) * lu(k,2155) + lu(k,2166) = - lu(k,1181) * lu(k,2155) + lu(k,2170) = - lu(k,1182) * lu(k,2155) + lu(k,2172) = - lu(k,1183) * lu(k,2155) + lu(k,2173) = - lu(k,1184) * lu(k,2155) + lu(k,2175) = lu(k,2175) - lu(k,1185) * lu(k,2155) + lu(k,2176) = lu(k,2176) - lu(k,1186) * lu(k,2155) + lu(k,2179) = lu(k,2179) - lu(k,1187) * lu(k,2155) + lu(k,2180) = lu(k,2180) - lu(k,1188) * lu(k,2155) + lu(k,2187) = - lu(k,1189) * lu(k,2155) + lu(k,2188) = lu(k,2188) - lu(k,1190) * lu(k,2155) + lu(k,2190) = lu(k,2190) - lu(k,1191) * lu(k,2155) + lu(k,2191) = lu(k,2191) - lu(k,1192) * lu(k,2155) + lu(k,2195) = lu(k,2195) - lu(k,1193) * lu(k,2155) + lu(k,3487) = lu(k,3487) - lu(k,1179) * lu(k,3481) + lu(k,3490) = lu(k,3490) - lu(k,1180) * lu(k,3481) + lu(k,3509) = lu(k,3509) - lu(k,1181) * lu(k,3481) + lu(k,3518) = lu(k,3518) - lu(k,1182) * lu(k,3481) + lu(k,3525) = lu(k,3525) - lu(k,1183) * lu(k,3481) + lu(k,3526) = lu(k,3526) - lu(k,1184) * lu(k,3481) + lu(k,3530) = lu(k,3530) - lu(k,1185) * lu(k,3481) + lu(k,3531) = lu(k,3531) - lu(k,1186) * lu(k,3481) + lu(k,3534) = - lu(k,1187) * lu(k,3481) + lu(k,3535) = lu(k,3535) - lu(k,1188) * lu(k,3481) + lu(k,3568) = lu(k,3568) - lu(k,1189) * lu(k,3481) + lu(k,3569) = lu(k,3569) - lu(k,1190) * lu(k,3481) + lu(k,3571) = lu(k,3571) - lu(k,1191) * lu(k,3481) + lu(k,3572) = lu(k,3572) - lu(k,1192) * lu(k,3481) + lu(k,3576) = lu(k,3576) - lu(k,1193) * lu(k,3481) + lu(k,3733) = lu(k,3733) - lu(k,1179) * lu(k,3722) + lu(k,3737) = lu(k,3737) - lu(k,1180) * lu(k,3722) + lu(k,3760) = lu(k,3760) - lu(k,1181) * lu(k,3722) + lu(k,3769) = lu(k,3769) - lu(k,1182) * lu(k,3722) + lu(k,3776) = lu(k,3776) - lu(k,1183) * lu(k,3722) + lu(k,3777) = lu(k,3777) - lu(k,1184) * lu(k,3722) + lu(k,3781) = lu(k,3781) - lu(k,1185) * lu(k,3722) + lu(k,3782) = lu(k,3782) - lu(k,1186) * lu(k,3722) + lu(k,3785) = lu(k,3785) - lu(k,1187) * lu(k,3722) + lu(k,3786) = lu(k,3786) - lu(k,1188) * lu(k,3722) + lu(k,3818) = lu(k,3818) - lu(k,1189) * lu(k,3722) + lu(k,3819) = lu(k,3819) - lu(k,1190) * lu(k,3722) + lu(k,3821) = lu(k,3821) - lu(k,1191) * lu(k,3722) + lu(k,3822) = lu(k,3822) - lu(k,1192) * lu(k,3722) + lu(k,3826) = lu(k,3826) - lu(k,1193) * lu(k,3722) + lu(k,1198) = 1._r8 / lu(k,1198) + lu(k,1199) = lu(k,1199) * lu(k,1198) + lu(k,1200) = lu(k,1200) * lu(k,1198) + lu(k,1201) = lu(k,1201) * lu(k,1198) + lu(k,1202) = lu(k,1202) * lu(k,1198) + lu(k,1203) = lu(k,1203) * lu(k,1198) + lu(k,1204) = lu(k,1204) * lu(k,1198) + lu(k,1205) = lu(k,1205) * lu(k,1198) + lu(k,1206) = lu(k,1206) * lu(k,1198) + lu(k,1207) = lu(k,1207) * lu(k,1198) + lu(k,3062) = - lu(k,1199) * lu(k,3057) + lu(k,3066) = lu(k,3066) - lu(k,1200) * lu(k,3057) + lu(k,3102) = lu(k,3102) - lu(k,1201) * lu(k,3057) + lu(k,3126) = lu(k,3126) - lu(k,1202) * lu(k,3057) + lu(k,3129) = lu(k,3129) - lu(k,1203) * lu(k,3057) + lu(k,3131) = lu(k,3131) - lu(k,1204) * lu(k,3057) + lu(k,3133) = lu(k,3133) - lu(k,1205) * lu(k,3057) + lu(k,3134) = lu(k,3134) - lu(k,1206) * lu(k,3057) + lu(k,3138) = lu(k,3138) - lu(k,1207) * lu(k,3057) + lu(k,3235) = lu(k,3235) - lu(k,1199) * lu(k,3228) + lu(k,3238) = lu(k,3238) - lu(k,1200) * lu(k,3228) + lu(k,3284) = lu(k,3284) - lu(k,1201) * lu(k,3228) + lu(k,3308) = lu(k,3308) - lu(k,1202) * lu(k,3228) + lu(k,3311) = lu(k,3311) - lu(k,1203) * lu(k,3228) + lu(k,3313) = lu(k,3313) - lu(k,1204) * lu(k,3228) + lu(k,3315) = lu(k,3315) - lu(k,1205) * lu(k,3228) + lu(k,3316) = lu(k,3316) - lu(k,1206) * lu(k,3228) + lu(k,3320) = lu(k,3320) - lu(k,1207) * lu(k,3228) + lu(k,3489) = lu(k,3489) - lu(k,1199) * lu(k,3482) + lu(k,3492) = lu(k,3492) - lu(k,1200) * lu(k,3482) + lu(k,3540) = lu(k,3540) - lu(k,1201) * lu(k,3482) + lu(k,3564) = lu(k,3564) - lu(k,1202) * lu(k,3482) + lu(k,3567) = lu(k,3567) - lu(k,1203) * lu(k,3482) + lu(k,3569) = lu(k,3569) - lu(k,1204) * lu(k,3482) + lu(k,3571) = lu(k,3571) - lu(k,1205) * lu(k,3482) + lu(k,3572) = lu(k,3572) - lu(k,1206) * lu(k,3482) + lu(k,3576) = lu(k,3576) - lu(k,1207) * lu(k,3482) + lu(k,3736) = lu(k,3736) - lu(k,1199) * lu(k,3723) + lu(k,3741) = lu(k,3741) - lu(k,1200) * lu(k,3723) + lu(k,3790) = lu(k,3790) - lu(k,1201) * lu(k,3723) + lu(k,3814) = lu(k,3814) - lu(k,1202) * lu(k,3723) + lu(k,3817) = lu(k,3817) - lu(k,1203) * lu(k,3723) + lu(k,3819) = lu(k,3819) - lu(k,1204) * lu(k,3723) + lu(k,3821) = lu(k,3821) - lu(k,1205) * lu(k,3723) + lu(k,3822) = lu(k,3822) - lu(k,1206) * lu(k,3723) + lu(k,3826) = lu(k,3826) - lu(k,1207) * lu(k,3723) + lu(k,3886) = - lu(k,1199) * lu(k,3881) + lu(k,3890) = lu(k,3890) - lu(k,1200) * lu(k,3881) + lu(k,3925) = lu(k,3925) - lu(k,1201) * lu(k,3881) + lu(k,3949) = lu(k,3949) - lu(k,1202) * lu(k,3881) + lu(k,3952) = lu(k,3952) - lu(k,1203) * lu(k,3881) + lu(k,3954) = lu(k,3954) - lu(k,1204) * lu(k,3881) + lu(k,3956) = lu(k,3956) - lu(k,1205) * lu(k,3881) + lu(k,3957) = lu(k,3957) - lu(k,1206) * lu(k,3881) + lu(k,3961) = lu(k,3961) - lu(k,1207) * lu(k,3881) + lu(k,1208) = 1._r8 / lu(k,1208) + lu(k,1209) = lu(k,1209) * lu(k,1208) + lu(k,1210) = lu(k,1210) * lu(k,1208) + lu(k,1211) = lu(k,1211) * lu(k,1208) + lu(k,1212) = lu(k,1212) * lu(k,1208) + lu(k,1213) = lu(k,1213) * lu(k,1208) + lu(k,1389) = lu(k,1389) - lu(k,1209) * lu(k,1388) + lu(k,1405) = lu(k,1405) - lu(k,1210) * lu(k,1388) + lu(k,1406) = lu(k,1406) - lu(k,1211) * lu(k,1388) + lu(k,1407) = lu(k,1407) - lu(k,1212) * lu(k,1388) + lu(k,1410) = - lu(k,1213) * lu(k,1388) + lu(k,2343) = lu(k,2343) - lu(k,1209) * lu(k,2342) + lu(k,2357) = lu(k,2357) - lu(k,1210) * lu(k,2342) + lu(k,2359) = lu(k,2359) - lu(k,1211) * lu(k,2342) + lu(k,2360) = lu(k,2360) - lu(k,1212) * lu(k,2342) + lu(k,2364) = - lu(k,1213) * lu(k,2342) + lu(k,2656) = lu(k,2656) - lu(k,1209) * lu(k,2655) + lu(k,2673) = lu(k,2673) - lu(k,1210) * lu(k,2655) + lu(k,2675) = lu(k,2675) - lu(k,1211) * lu(k,2655) + lu(k,2676) = lu(k,2676) - lu(k,1212) * lu(k,2655) + lu(k,2680) = - lu(k,1213) * lu(k,2655) + lu(k,3063) = lu(k,3063) - lu(k,1209) * lu(k,3058) + lu(k,3131) = lu(k,3131) - lu(k,1210) * lu(k,3058) + lu(k,3133) = lu(k,3133) - lu(k,1211) * lu(k,3058) + lu(k,3134) = lu(k,3134) - lu(k,1212) * lu(k,3058) + lu(k,3139) = lu(k,3139) - lu(k,1213) * lu(k,3058) + lu(k,3236) = lu(k,3236) - lu(k,1209) * lu(k,3229) + lu(k,3313) = lu(k,3313) - lu(k,1210) * lu(k,3229) + lu(k,3315) = lu(k,3315) - lu(k,1211) * lu(k,3229) + lu(k,3316) = lu(k,3316) - lu(k,1212) * lu(k,3229) + lu(k,3321) = lu(k,3321) - lu(k,1213) * lu(k,3229) + lu(k,3344) = lu(k,3344) - lu(k,1209) * lu(k,3343) + lu(k,3358) = lu(k,3358) - lu(k,1210) * lu(k,3343) + lu(k,3360) = lu(k,3360) - lu(k,1211) * lu(k,3343) + lu(k,3361) = lu(k,3361) - lu(k,1212) * lu(k,3343) + lu(k,3366) = lu(k,3366) - lu(k,1213) * lu(k,3343) + lu(k,3490) = lu(k,3490) - lu(k,1209) * lu(k,3483) + lu(k,3569) = lu(k,3569) - lu(k,1210) * lu(k,3483) + lu(k,3571) = lu(k,3571) - lu(k,1211) * lu(k,3483) + lu(k,3572) = lu(k,3572) - lu(k,1212) * lu(k,3483) + lu(k,3577) = lu(k,3577) - lu(k,1213) * lu(k,3483) + lu(k,3737) = lu(k,3737) - lu(k,1209) * lu(k,3724) + lu(k,3819) = lu(k,3819) - lu(k,1210) * lu(k,3724) + lu(k,3821) = lu(k,3821) - lu(k,1211) * lu(k,3724) + lu(k,3822) = lu(k,3822) - lu(k,1212) * lu(k,3724) + lu(k,3827) = lu(k,3827) - lu(k,1213) * lu(k,3724) + lu(k,3887) = lu(k,3887) - lu(k,1209) * lu(k,3882) + lu(k,3954) = lu(k,3954) - lu(k,1210) * lu(k,3882) + lu(k,3956) = lu(k,3956) - lu(k,1211) * lu(k,3882) + lu(k,3957) = lu(k,3957) - lu(k,1212) * lu(k,3882) + lu(k,3962) = - lu(k,1213) * lu(k,3882) + lu(k,1216) = 1._r8 / lu(k,1216) + lu(k,1217) = lu(k,1217) * lu(k,1216) + lu(k,1218) = lu(k,1218) * lu(k,1216) + lu(k,1219) = lu(k,1219) * lu(k,1216) + lu(k,1220) = lu(k,1220) * lu(k,1216) + lu(k,1221) = lu(k,1221) * lu(k,1216) + lu(k,1222) = lu(k,1222) * lu(k,1216) + lu(k,1223) = lu(k,1223) * lu(k,1216) + lu(k,1224) = lu(k,1224) * lu(k,1216) + lu(k,1225) = lu(k,1225) * lu(k,1216) + lu(k,2490) = lu(k,2490) - lu(k,1217) * lu(k,2489) + lu(k,2493) = lu(k,2493) - lu(k,1218) * lu(k,2489) + lu(k,2498) = lu(k,2498) - lu(k,1219) * lu(k,2489) + lu(k,2500) = - lu(k,1220) * lu(k,2489) + lu(k,2509) = lu(k,2509) - lu(k,1221) * lu(k,2489) + lu(k,2513) = lu(k,2513) - lu(k,1222) * lu(k,2489) + lu(k,2514) = lu(k,2514) - lu(k,1223) * lu(k,2489) + lu(k,2517) = lu(k,2517) - lu(k,1224) * lu(k,2489) + lu(k,2518) = lu(k,2518) - lu(k,1225) * lu(k,2489) + lu(k,2686) = lu(k,2686) - lu(k,1217) * lu(k,2685) + lu(k,2689) = lu(k,2689) - lu(k,1218) * lu(k,2685) + lu(k,2696) = lu(k,2696) - lu(k,1219) * lu(k,2685) + lu(k,2698) = - lu(k,1220) * lu(k,2685) + lu(k,2710) = lu(k,2710) - lu(k,1221) * lu(k,2685) + lu(k,2714) = lu(k,2714) - lu(k,1222) * lu(k,2685) + lu(k,2715) = lu(k,2715) - lu(k,1223) * lu(k,2685) + lu(k,2719) = lu(k,2719) - lu(k,1224) * lu(k,2685) + lu(k,2720) = lu(k,2720) - lu(k,1225) * lu(k,2685) + lu(k,3231) = lu(k,3231) - lu(k,1217) * lu(k,3230) + lu(k,3251) = lu(k,3251) - lu(k,1218) * lu(k,3230) + lu(k,3288) = lu(k,3288) - lu(k,1219) * lu(k,3230) + lu(k,3294) = lu(k,3294) - lu(k,1220) * lu(k,3230) + lu(k,3311) = lu(k,3311) - lu(k,1221) * lu(k,3230) + lu(k,3315) = lu(k,3315) - lu(k,1222) * lu(k,3230) + lu(k,3316) = lu(k,3316) - lu(k,1223) * lu(k,3230) + lu(k,3320) = lu(k,3320) - lu(k,1224) * lu(k,3230) + lu(k,3321) = lu(k,3321) - lu(k,1225) * lu(k,3230) + lu(k,3485) = lu(k,3485) - lu(k,1217) * lu(k,3484) + lu(k,3505) = lu(k,3505) - lu(k,1218) * lu(k,3484) + lu(k,3544) = lu(k,3544) - lu(k,1219) * lu(k,3484) + lu(k,3550) = lu(k,3550) - lu(k,1220) * lu(k,3484) + lu(k,3567) = lu(k,3567) - lu(k,1221) * lu(k,3484) + lu(k,3571) = lu(k,3571) - lu(k,1222) * lu(k,3484) + lu(k,3572) = lu(k,3572) - lu(k,1223) * lu(k,3484) + lu(k,3576) = lu(k,3576) - lu(k,1224) * lu(k,3484) + lu(k,3577) = lu(k,3577) - lu(k,1225) * lu(k,3484) + lu(k,3726) = lu(k,3726) - lu(k,1217) * lu(k,3725) + lu(k,3755) = lu(k,3755) - lu(k,1218) * lu(k,3725) + lu(k,3794) = lu(k,3794) - lu(k,1219) * lu(k,3725) + lu(k,3800) = lu(k,3800) - lu(k,1220) * lu(k,3725) + lu(k,3817) = lu(k,3817) - lu(k,1221) * lu(k,3725) + lu(k,3821) = lu(k,3821) - lu(k,1222) * lu(k,3725) + lu(k,3822) = lu(k,3822) - lu(k,1223) * lu(k,3725) + lu(k,3826) = lu(k,3826) - lu(k,1224) * lu(k,3725) + lu(k,3827) = lu(k,3827) - lu(k,1225) * lu(k,3725) end do end subroutine lu_fac26 subroutine lu_fac27( avec_len, lu ) @@ -4685,203 +4510,234 @@ subroutine lu_fac27( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1197) = 1._r8 / lu(k,1197) - lu(k,1198) = lu(k,1198) * lu(k,1197) - lu(k,1199) = lu(k,1199) * lu(k,1197) - lu(k,1200) = lu(k,1200) * lu(k,1197) - lu(k,1201) = lu(k,1201) * lu(k,1197) - lu(k,1202) = lu(k,1202) * lu(k,1197) - lu(k,1203) = lu(k,1203) * lu(k,1197) - lu(k,1204) = lu(k,1204) * lu(k,1197) - lu(k,1205) = lu(k,1205) * lu(k,1197) - lu(k,1206) = lu(k,1206) * lu(k,1197) - lu(k,1207) = lu(k,1207) * lu(k,1197) - lu(k,1208) = lu(k,1208) * lu(k,1197) - lu(k,1209) = lu(k,1209) * lu(k,1197) - lu(k,1210) = lu(k,1210) * lu(k,1197) - lu(k,1855) = lu(k,1855) - lu(k,1198) * lu(k,1854) - lu(k,1856) = - lu(k,1199) * lu(k,1854) - lu(k,1859) = lu(k,1859) - lu(k,1200) * lu(k,1854) - lu(k,1860) = - lu(k,1201) * lu(k,1854) - lu(k,1867) = - lu(k,1202) * lu(k,1854) - lu(k,1868) = lu(k,1868) - lu(k,1203) * lu(k,1854) - lu(k,1869) = - lu(k,1204) * lu(k,1854) - lu(k,1870) = lu(k,1870) - lu(k,1205) * lu(k,1854) - lu(k,1871) = lu(k,1871) - lu(k,1206) * lu(k,1854) - lu(k,1872) = lu(k,1872) - lu(k,1207) * lu(k,1854) - lu(k,1873) = - lu(k,1208) * lu(k,1854) - lu(k,1874) = lu(k,1874) - lu(k,1209) * lu(k,1854) - lu(k,1875) = lu(k,1875) - lu(k,1210) * lu(k,1854) - lu(k,2931) = lu(k,2931) - lu(k,1198) * lu(k,2927) - lu(k,2932) = lu(k,2932) - lu(k,1199) * lu(k,2927) - lu(k,2940) = lu(k,2940) - lu(k,1200) * lu(k,2927) - lu(k,2943) = lu(k,2943) - lu(k,1201) * lu(k,2927) - lu(k,2986) = lu(k,2986) - lu(k,1202) * lu(k,2927) - lu(k,2987) = lu(k,2987) - lu(k,1203) * lu(k,2927) - lu(k,2988) = lu(k,2988) - lu(k,1204) * lu(k,2927) - lu(k,2990) = lu(k,2990) - lu(k,1205) * lu(k,2927) - lu(k,2992) = lu(k,2992) - lu(k,1206) * lu(k,2927) - lu(k,2993) = lu(k,2993) - lu(k,1207) * lu(k,2927) - lu(k,2995) = lu(k,2995) - lu(k,1208) * lu(k,2927) - lu(k,2996) = lu(k,2996) - lu(k,1209) * lu(k,2927) - lu(k,3000) = lu(k,3000) - lu(k,1210) * lu(k,2927) - lu(k,3022) = lu(k,3022) - lu(k,1198) * lu(k,3019) - lu(k,3023) = lu(k,3023) - lu(k,1199) * lu(k,3019) - lu(k,3031) = lu(k,3031) - lu(k,1200) * lu(k,3019) - lu(k,3036) = lu(k,3036) - lu(k,1201) * lu(k,3019) - lu(k,3078) = lu(k,3078) - lu(k,1202) * lu(k,3019) - lu(k,3079) = lu(k,3079) - lu(k,1203) * lu(k,3019) - lu(k,3080) = lu(k,3080) - lu(k,1204) * lu(k,3019) - lu(k,3082) = lu(k,3082) - lu(k,1205) * lu(k,3019) - lu(k,3084) = lu(k,3084) - lu(k,1206) * lu(k,3019) - lu(k,3085) = lu(k,3085) - lu(k,1207) * lu(k,3019) - lu(k,3087) = lu(k,3087) - lu(k,1208) * lu(k,3019) - lu(k,3088) = lu(k,3088) - lu(k,1209) * lu(k,3019) - lu(k,3092) = lu(k,3092) - lu(k,1210) * lu(k,3019) - lu(k,3674) = lu(k,3674) - lu(k,1198) * lu(k,3666) - lu(k,3678) = lu(k,3678) - lu(k,1199) * lu(k,3666) - lu(k,3694) = lu(k,3694) - lu(k,1200) * lu(k,3666) - lu(k,3699) = lu(k,3699) - lu(k,1201) * lu(k,3666) - lu(k,3742) = lu(k,3742) - lu(k,1202) * lu(k,3666) - lu(k,3743) = lu(k,3743) - lu(k,1203) * lu(k,3666) - lu(k,3744) = lu(k,3744) - lu(k,1204) * lu(k,3666) - lu(k,3746) = lu(k,3746) - lu(k,1205) * lu(k,3666) - lu(k,3748) = lu(k,3748) - lu(k,1206) * lu(k,3666) - lu(k,3749) = lu(k,3749) - lu(k,1207) * lu(k,3666) - lu(k,3751) = lu(k,3751) - lu(k,1208) * lu(k,3666) - lu(k,3752) = lu(k,3752) - lu(k,1209) * lu(k,3666) - lu(k,3756) = lu(k,3756) - lu(k,1210) * lu(k,3666) - lu(k,1213) = 1._r8 / lu(k,1213) - lu(k,1214) = lu(k,1214) * lu(k,1213) - lu(k,1215) = lu(k,1215) * lu(k,1213) - lu(k,1216) = lu(k,1216) * lu(k,1213) - lu(k,1217) = lu(k,1217) * lu(k,1213) - lu(k,1218) = lu(k,1218) * lu(k,1213) - lu(k,1219) = lu(k,1219) * lu(k,1213) - lu(k,1220) = lu(k,1220) * lu(k,1213) - lu(k,1221) = lu(k,1221) * lu(k,1213) - lu(k,1222) = lu(k,1222) * lu(k,1213) - lu(k,3305) = - lu(k,1214) * lu(k,3302) - lu(k,3309) = - lu(k,1215) * lu(k,3302) - lu(k,3312) = lu(k,3312) - lu(k,1216) * lu(k,3302) - lu(k,3315) = lu(k,3315) - lu(k,1217) * lu(k,3302) - lu(k,3316) = lu(k,3316) - lu(k,1218) * lu(k,3302) - lu(k,3317) = lu(k,3317) - lu(k,1219) * lu(k,3302) - lu(k,3318) = lu(k,3318) - lu(k,1220) * lu(k,3302) - lu(k,3320) = lu(k,3320) - lu(k,1221) * lu(k,3302) - lu(k,3321) = lu(k,3321) - lu(k,1222) * lu(k,3302) - lu(k,3450) = lu(k,3450) - lu(k,1214) * lu(k,3444) - lu(k,3454) = lu(k,3454) - lu(k,1215) * lu(k,3444) - lu(k,3457) = lu(k,3457) - lu(k,1216) * lu(k,3444) - lu(k,3460) = lu(k,3460) - lu(k,1217) * lu(k,3444) - lu(k,3461) = lu(k,3461) - lu(k,1218) * lu(k,3444) - lu(k,3462) = lu(k,3462) - lu(k,1219) * lu(k,3444) - lu(k,3463) = lu(k,3463) - lu(k,1220) * lu(k,3444) - lu(k,3465) = lu(k,3465) - lu(k,1221) * lu(k,3444) - lu(k,3466) = lu(k,3466) - lu(k,1222) * lu(k,3444) - lu(k,3500) = lu(k,3500) - lu(k,1214) * lu(k,3487) - lu(k,3504) = lu(k,3504) - lu(k,1215) * lu(k,3487) - lu(k,3507) = lu(k,3507) - lu(k,1216) * lu(k,3487) - lu(k,3510) = lu(k,3510) - lu(k,1217) * lu(k,3487) - lu(k,3511) = lu(k,3511) - lu(k,1218) * lu(k,3487) - lu(k,3512) = lu(k,3512) - lu(k,1219) * lu(k,3487) - lu(k,3513) = lu(k,3513) - lu(k,1220) * lu(k,3487) - lu(k,3515) = lu(k,3515) - lu(k,1221) * lu(k,3487) - lu(k,3516) = lu(k,3516) - lu(k,1222) * lu(k,3487) - lu(k,3740) = lu(k,3740) - lu(k,1214) * lu(k,3667) - lu(k,3744) = lu(k,3744) - lu(k,1215) * lu(k,3667) - lu(k,3747) = lu(k,3747) - lu(k,1216) * lu(k,3667) - lu(k,3750) = lu(k,3750) - lu(k,1217) * lu(k,3667) - lu(k,3751) = lu(k,3751) - lu(k,1218) * lu(k,3667) - lu(k,3752) = lu(k,3752) - lu(k,1219) * lu(k,3667) - lu(k,3753) = lu(k,3753) - lu(k,1220) * lu(k,3667) - lu(k,3755) = lu(k,3755) - lu(k,1221) * lu(k,3667) - lu(k,3756) = lu(k,3756) - lu(k,1222) * lu(k,3667) - lu(k,3763) = lu(k,3763) - lu(k,1214) * lu(k,3761) - lu(k,3766) = - lu(k,1215) * lu(k,3761) - lu(k,3769) = lu(k,3769) - lu(k,1216) * lu(k,3761) - lu(k,3772) = lu(k,3772) - lu(k,1217) * lu(k,3761) - lu(k,3773) = - lu(k,1218) * lu(k,3761) - lu(k,3774) = lu(k,3774) - lu(k,1219) * lu(k,3761) - lu(k,3775) = lu(k,3775) - lu(k,1220) * lu(k,3761) - lu(k,3777) = lu(k,3777) - lu(k,1221) * lu(k,3761) - lu(k,3778) = lu(k,3778) - lu(k,1222) * lu(k,3761) - lu(k,3821) = - lu(k,1214) * lu(k,3811) - lu(k,3825) = lu(k,3825) - lu(k,1215) * lu(k,3811) - lu(k,3828) = lu(k,3828) - lu(k,1216) * lu(k,3811) - lu(k,3831) = lu(k,3831) - lu(k,1217) * lu(k,3811) - lu(k,3832) = lu(k,3832) - lu(k,1218) * lu(k,3811) - lu(k,3833) = lu(k,3833) - lu(k,1219) * lu(k,3811) - lu(k,3834) = lu(k,3834) - lu(k,1220) * lu(k,3811) - lu(k,3836) = lu(k,3836) - lu(k,1221) * lu(k,3811) - lu(k,3837) = lu(k,3837) - lu(k,1222) * lu(k,3811) - lu(k,1224) = 1._r8 / lu(k,1224) - lu(k,1225) = lu(k,1225) * lu(k,1224) - lu(k,1226) = lu(k,1226) * lu(k,1224) - lu(k,1227) = lu(k,1227) * lu(k,1224) - lu(k,1228) = lu(k,1228) * lu(k,1224) - lu(k,1229) = lu(k,1229) * lu(k,1224) - lu(k,1230) = lu(k,1230) * lu(k,1224) - lu(k,1231) = lu(k,1231) * lu(k,1224) - lu(k,1232) = lu(k,1232) * lu(k,1224) - lu(k,1233) = lu(k,1233) * lu(k,1224) - lu(k,1234) = lu(k,1234) * lu(k,1224) - lu(k,1235) = lu(k,1235) * lu(k,1224) - lu(k,2138) = - lu(k,1225) * lu(k,2137) - lu(k,2139) = - lu(k,1226) * lu(k,2137) - lu(k,2140) = - lu(k,1227) * lu(k,2137) - lu(k,2142) = lu(k,2142) - lu(k,1228) * lu(k,2137) - lu(k,2145) = - lu(k,1229) * lu(k,2137) - lu(k,2147) = - lu(k,1230) * lu(k,2137) - lu(k,2148) = - lu(k,1231) * lu(k,2137) - lu(k,2149) = lu(k,2149) - lu(k,1232) * lu(k,2137) - lu(k,2150) = - lu(k,1233) * lu(k,2137) - lu(k,2151) = lu(k,2151) - lu(k,1234) * lu(k,2137) - lu(k,2152) = lu(k,2152) - lu(k,1235) * lu(k,2137) - lu(k,2825) = - lu(k,1225) * lu(k,2815) - lu(k,2841) = lu(k,2841) - lu(k,1226) * lu(k,2815) - lu(k,2853) = lu(k,2853) - lu(k,1227) * lu(k,2815) - lu(k,2882) = lu(k,2882) - lu(k,1228) * lu(k,2815) - lu(k,2885) = lu(k,2885) - lu(k,1229) * lu(k,2815) - lu(k,2889) = lu(k,2889) - lu(k,1230) * lu(k,2815) - lu(k,2891) = lu(k,2891) - lu(k,1231) * lu(k,2815) - lu(k,2892) = lu(k,2892) - lu(k,1232) * lu(k,2815) - lu(k,2894) = lu(k,2894) - lu(k,1233) * lu(k,2815) - lu(k,2895) = lu(k,2895) - lu(k,1234) * lu(k,2815) - lu(k,2899) = lu(k,2899) - lu(k,1235) * lu(k,2815) - lu(k,3219) = - lu(k,1225) * lu(k,3208) - lu(k,3237) = lu(k,3237) - lu(k,1226) * lu(k,3208) - lu(k,3249) = lu(k,3249) - lu(k,1227) * lu(k,3208) - lu(k,3278) = lu(k,3278) - lu(k,1228) * lu(k,3208) - lu(k,3281) = lu(k,3281) - lu(k,1229) * lu(k,3208) - lu(k,3285) = lu(k,3285) - lu(k,1230) * lu(k,3208) - lu(k,3287) = lu(k,3287) - lu(k,1231) * lu(k,3208) - lu(k,3288) = lu(k,3288) - lu(k,1232) * lu(k,3208) - lu(k,3290) = lu(k,3290) - lu(k,1233) * lu(k,3208) - lu(k,3291) = lu(k,3291) - lu(k,1234) * lu(k,3208) - lu(k,3295) = lu(k,3295) - lu(k,1235) * lu(k,3208) - lu(k,3364) = lu(k,3364) - lu(k,1225) * lu(k,3356) - lu(k,3379) = lu(k,3379) - lu(k,1226) * lu(k,3356) - lu(k,3390) = lu(k,3390) - lu(k,1227) * lu(k,3356) - lu(k,3419) = lu(k,3419) - lu(k,1228) * lu(k,3356) - lu(k,3422) = lu(k,3422) - lu(k,1229) * lu(k,3356) - lu(k,3426) = lu(k,3426) - lu(k,1230) * lu(k,3356) - lu(k,3428) = lu(k,3428) - lu(k,1231) * lu(k,3356) - lu(k,3429) = lu(k,3429) - lu(k,1232) * lu(k,3356) - lu(k,3431) = lu(k,3431) - lu(k,1233) * lu(k,3356) - lu(k,3432) = lu(k,3432) - lu(k,1234) * lu(k,3356) - lu(k,3436) = lu(k,3436) - lu(k,1235) * lu(k,3356) - lu(k,3680) = lu(k,3680) - lu(k,1225) * lu(k,3668) - lu(k,3699) = lu(k,3699) - lu(k,1226) * lu(k,3668) - lu(k,3711) = lu(k,3711) - lu(k,1227) * lu(k,3668) - lu(k,3739) = lu(k,3739) - lu(k,1228) * lu(k,3668) - lu(k,3742) = lu(k,3742) - lu(k,1229) * lu(k,3668) - lu(k,3746) = lu(k,3746) - lu(k,1230) * lu(k,3668) - lu(k,3748) = lu(k,3748) - lu(k,1231) * lu(k,3668) - lu(k,3749) = lu(k,3749) - lu(k,1232) * lu(k,3668) - lu(k,3751) = lu(k,3751) - lu(k,1233) * lu(k,3668) - lu(k,3752) = lu(k,3752) - lu(k,1234) * lu(k,3668) - lu(k,3756) = lu(k,3756) - lu(k,1235) * lu(k,3668) + lu(k,1226) = 1._r8 / lu(k,1226) + lu(k,1227) = lu(k,1227) * lu(k,1226) + lu(k,1228) = lu(k,1228) * lu(k,1226) + lu(k,1229) = lu(k,1229) * lu(k,1226) + lu(k,1230) = lu(k,1230) * lu(k,1226) + lu(k,1231) = lu(k,1231) * lu(k,1226) + lu(k,1686) = lu(k,1686) - lu(k,1227) * lu(k,1685) + lu(k,1691) = - lu(k,1228) * lu(k,1685) + lu(k,1692) = lu(k,1692) - lu(k,1229) * lu(k,1685) + lu(k,1693) = lu(k,1693) - lu(k,1230) * lu(k,1685) + lu(k,1694) = lu(k,1694) - lu(k,1231) * lu(k,1685) + lu(k,1699) = lu(k,1699) - lu(k,1227) * lu(k,1697) + lu(k,1704) = lu(k,1704) - lu(k,1228) * lu(k,1697) + lu(k,1705) = lu(k,1705) - lu(k,1229) * lu(k,1697) + lu(k,1706) = lu(k,1706) - lu(k,1230) * lu(k,1697) + lu(k,1707) = lu(k,1707) - lu(k,1231) * lu(k,1697) + lu(k,2293) = lu(k,2293) - lu(k,1227) * lu(k,2290) + lu(k,2306) = lu(k,2306) - lu(k,1228) * lu(k,2290) + lu(k,2309) = lu(k,2309) - lu(k,1229) * lu(k,2290) + lu(k,2310) = lu(k,2310) - lu(k,1230) * lu(k,2290) + lu(k,2313) = lu(k,2313) - lu(k,1231) * lu(k,2290) + lu(k,2493) = lu(k,2493) - lu(k,1227) * lu(k,2490) + lu(k,2510) = lu(k,2510) - lu(k,1228) * lu(k,2490) + lu(k,2513) = lu(k,2513) - lu(k,1229) * lu(k,2490) + lu(k,2514) = lu(k,2514) - lu(k,1230) * lu(k,2490) + lu(k,2517) = lu(k,2517) - lu(k,1231) * lu(k,2490) + lu(k,2525) = lu(k,2525) - lu(k,1227) * lu(k,2522) + lu(k,2539) = lu(k,2539) - lu(k,1228) * lu(k,2522) + lu(k,2542) = lu(k,2542) - lu(k,1229) * lu(k,2522) + lu(k,2543) = lu(k,2543) - lu(k,1230) * lu(k,2522) + lu(k,2546) = lu(k,2546) - lu(k,1231) * lu(k,2522) + lu(k,2689) = lu(k,2689) - lu(k,1227) * lu(k,2686) + lu(k,2711) = lu(k,2711) - lu(k,1228) * lu(k,2686) + lu(k,2714) = lu(k,2714) - lu(k,1229) * lu(k,2686) + lu(k,2715) = lu(k,2715) - lu(k,1230) * lu(k,2686) + lu(k,2719) = lu(k,2719) - lu(k,1231) * lu(k,2686) + lu(k,3251) = lu(k,3251) - lu(k,1227) * lu(k,3231) + lu(k,3312) = lu(k,3312) - lu(k,1228) * lu(k,3231) + lu(k,3315) = lu(k,3315) - lu(k,1229) * lu(k,3231) + lu(k,3316) = lu(k,3316) - lu(k,1230) * lu(k,3231) + lu(k,3320) = lu(k,3320) - lu(k,1231) * lu(k,3231) + lu(k,3505) = lu(k,3505) - lu(k,1227) * lu(k,3485) + lu(k,3568) = lu(k,3568) - lu(k,1228) * lu(k,3485) + lu(k,3571) = lu(k,3571) - lu(k,1229) * lu(k,3485) + lu(k,3572) = lu(k,3572) - lu(k,1230) * lu(k,3485) + lu(k,3576) = lu(k,3576) - lu(k,1231) * lu(k,3485) + lu(k,3755) = lu(k,3755) - lu(k,1227) * lu(k,3726) + lu(k,3818) = lu(k,3818) - lu(k,1228) * lu(k,3726) + lu(k,3821) = lu(k,3821) - lu(k,1229) * lu(k,3726) + lu(k,3822) = lu(k,3822) - lu(k,1230) * lu(k,3726) + lu(k,3826) = lu(k,3826) - lu(k,1231) * lu(k,3726) + lu(k,1233) = 1._r8 / lu(k,1233) + lu(k,1234) = lu(k,1234) * lu(k,1233) + lu(k,1235) = lu(k,1235) * lu(k,1233) + lu(k,1236) = lu(k,1236) * lu(k,1233) + lu(k,1237) = lu(k,1237) * lu(k,1233) + lu(k,1238) = lu(k,1238) * lu(k,1233) + lu(k,1598) = lu(k,1598) - lu(k,1234) * lu(k,1597) + lu(k,1605) = lu(k,1605) - lu(k,1235) * lu(k,1597) + lu(k,1606) = - lu(k,1236) * lu(k,1597) + lu(k,1607) = lu(k,1607) - lu(k,1237) * lu(k,1597) + lu(k,1610) = - lu(k,1238) * lu(k,1597) + lu(k,2553) = lu(k,2553) - lu(k,1234) * lu(k,2552) + lu(k,2564) = lu(k,2564) - lu(k,1235) * lu(k,2552) + lu(k,2565) = lu(k,2565) - lu(k,1236) * lu(k,2552) + lu(k,2566) = lu(k,2566) - lu(k,1237) * lu(k,2552) + lu(k,2570) = lu(k,2570) - lu(k,1238) * lu(k,2552) + lu(k,2593) = lu(k,2593) - lu(k,1234) * lu(k,2591) + lu(k,2604) = lu(k,2604) - lu(k,1235) * lu(k,2591) + lu(k,2605) = lu(k,2605) - lu(k,1236) * lu(k,2591) + lu(k,2606) = lu(k,2606) - lu(k,1237) * lu(k,2591) + lu(k,2611) = lu(k,2611) - lu(k,1238) * lu(k,2591) + lu(k,3073) = lu(k,3073) - lu(k,1234) * lu(k,3059) + lu(k,3132) = lu(k,3132) - lu(k,1235) * lu(k,3059) + lu(k,3133) = lu(k,3133) - lu(k,1236) * lu(k,3059) + lu(k,3134) = lu(k,3134) - lu(k,1237) * lu(k,3059) + lu(k,3139) = lu(k,3139) - lu(k,1238) * lu(k,3059) + lu(k,3376) = lu(k,3376) - lu(k,1234) * lu(k,3373) + lu(k,3390) = lu(k,3390) - lu(k,1235) * lu(k,3373) + lu(k,3391) = lu(k,3391) - lu(k,1236) * lu(k,3373) + lu(k,3392) = lu(k,3392) - lu(k,1237) * lu(k,3373) + lu(k,3397) = lu(k,3397) - lu(k,1238) * lu(k,3373) + lu(k,3757) = lu(k,3757) - lu(k,1234) * lu(k,3727) + lu(k,3820) = lu(k,3820) - lu(k,1235) * lu(k,3727) + lu(k,3821) = lu(k,3821) - lu(k,1236) * lu(k,3727) + lu(k,3822) = lu(k,3822) - lu(k,1237) * lu(k,3727) + lu(k,3827) = lu(k,3827) - lu(k,1238) * lu(k,3727) + lu(k,3896) = - lu(k,1234) * lu(k,3883) + lu(k,3955) = lu(k,3955) - lu(k,1235) * lu(k,3883) + lu(k,3956) = lu(k,3956) - lu(k,1236) * lu(k,3883) + lu(k,3957) = lu(k,3957) - lu(k,1237) * lu(k,3883) + lu(k,3962) = lu(k,3962) - lu(k,1238) * lu(k,3883) + lu(k,4077) = lu(k,4077) - lu(k,1234) * lu(k,4073) + lu(k,4099) = lu(k,4099) - lu(k,1235) * lu(k,4073) + lu(k,4100) = lu(k,4100) - lu(k,1236) * lu(k,4073) + lu(k,4101) = lu(k,4101) - lu(k,1237) * lu(k,4073) + lu(k,4106) = lu(k,4106) - lu(k,1238) * lu(k,4073) + lu(k,4112) = - lu(k,1234) * lu(k,4110) + lu(k,4125) = lu(k,4125) - lu(k,1235) * lu(k,4110) + lu(k,4126) = - lu(k,1236) * lu(k,4110) + lu(k,4127) = lu(k,4127) - lu(k,1237) * lu(k,4110) + lu(k,4132) = lu(k,4132) - lu(k,1238) * lu(k,4110) + lu(k,1246) = 1._r8 / lu(k,1246) + lu(k,1247) = lu(k,1247) * lu(k,1246) + lu(k,1248) = lu(k,1248) * lu(k,1246) + lu(k,1249) = lu(k,1249) * lu(k,1246) + lu(k,1250) = lu(k,1250) * lu(k,1246) + lu(k,1251) = lu(k,1251) * lu(k,1246) + lu(k,1252) = lu(k,1252) * lu(k,1246) + lu(k,1253) = lu(k,1253) * lu(k,1246) + lu(k,1254) = lu(k,1254) * lu(k,1246) + lu(k,1255) = lu(k,1255) * lu(k,1246) + lu(k,1256) = lu(k,1256) * lu(k,1246) + lu(k,1257) = lu(k,1257) * lu(k,1246) + lu(k,1258) = lu(k,1258) * lu(k,1246) + lu(k,1259) = lu(k,1259) * lu(k,1246) + lu(k,1260) = lu(k,1260) * lu(k,1246) + lu(k,1261) = lu(k,1261) * lu(k,1246) + lu(k,1262) = lu(k,1262) * lu(k,1246) + lu(k,3061) = lu(k,3061) - lu(k,1247) * lu(k,3060) + lu(k,3070) = lu(k,3070) - lu(k,1248) * lu(k,3060) + lu(k,3074) = lu(k,3074) - lu(k,1249) * lu(k,3060) + lu(k,3089) = lu(k,3089) - lu(k,1250) * lu(k,3060) + lu(k,3103) = - lu(k,1251) * lu(k,3060) + lu(k,3106) = lu(k,3106) - lu(k,1252) * lu(k,3060) + lu(k,3110) = - lu(k,1253) * lu(k,3060) + lu(k,3119) = lu(k,3119) - lu(k,1254) * lu(k,3060) + lu(k,3121) = lu(k,3121) - lu(k,1255) * lu(k,3060) + lu(k,3124) = lu(k,3124) - lu(k,1256) * lu(k,3060) + lu(k,3125) = lu(k,3125) - lu(k,1257) * lu(k,3060) + lu(k,3127) = lu(k,3127) - lu(k,1258) * lu(k,3060) + lu(k,3131) = lu(k,3131) - lu(k,1259) * lu(k,3060) + lu(k,3133) = lu(k,3133) - lu(k,1260) * lu(k,3060) + lu(k,3134) = lu(k,3134) - lu(k,1261) * lu(k,3060) + lu(k,3136) = lu(k,3136) - lu(k,1262) * lu(k,3060) + lu(k,3731) = lu(k,3731) - lu(k,1247) * lu(k,3728) + lu(k,3748) = lu(k,3748) - lu(k,1248) * lu(k,3728) + lu(k,3758) = lu(k,3758) - lu(k,1249) * lu(k,3728) + lu(k,3777) = lu(k,3777) - lu(k,1250) * lu(k,3728) + lu(k,3791) = - lu(k,1251) * lu(k,3728) + lu(k,3794) = lu(k,3794) - lu(k,1252) * lu(k,3728) + lu(k,3798) = lu(k,3798) - lu(k,1253) * lu(k,3728) + lu(k,3807) = lu(k,3807) - lu(k,1254) * lu(k,3728) + lu(k,3809) = lu(k,3809) - lu(k,1255) * lu(k,3728) + lu(k,3812) = lu(k,3812) - lu(k,1256) * lu(k,3728) + lu(k,3813) = lu(k,3813) - lu(k,1257) * lu(k,3728) + lu(k,3815) = lu(k,3815) - lu(k,1258) * lu(k,3728) + lu(k,3819) = lu(k,3819) - lu(k,1259) * lu(k,3728) + lu(k,3821) = lu(k,3821) - lu(k,1260) * lu(k,3728) + lu(k,3822) = lu(k,3822) - lu(k,1261) * lu(k,3728) + lu(k,3824) = lu(k,3824) - lu(k,1262) * lu(k,3728) + lu(k,3885) = lu(k,3885) - lu(k,1247) * lu(k,3884) + lu(k,3892) = lu(k,3892) - lu(k,1248) * lu(k,3884) + lu(k,3897) = lu(k,3897) - lu(k,1249) * lu(k,3884) + lu(k,3911) = lu(k,3911) - lu(k,1250) * lu(k,3884) + lu(k,3926) = lu(k,3926) - lu(k,1251) * lu(k,3884) + lu(k,3929) = lu(k,3929) - lu(k,1252) * lu(k,3884) + lu(k,3933) = lu(k,3933) - lu(k,1253) * lu(k,3884) + lu(k,3942) = lu(k,3942) - lu(k,1254) * lu(k,3884) + lu(k,3944) = lu(k,3944) - lu(k,1255) * lu(k,3884) + lu(k,3947) = lu(k,3947) - lu(k,1256) * lu(k,3884) + lu(k,3948) = lu(k,3948) - lu(k,1257) * lu(k,3884) + lu(k,3950) = lu(k,3950) - lu(k,1258) * lu(k,3884) + lu(k,3954) = lu(k,3954) - lu(k,1259) * lu(k,3884) + lu(k,3956) = lu(k,3956) - lu(k,1260) * lu(k,3884) + lu(k,3957) = lu(k,3957) - lu(k,1261) * lu(k,3884) + lu(k,3959) = lu(k,3959) - lu(k,1262) * lu(k,3884) + lu(k,1264) = 1._r8 / lu(k,1264) + lu(k,1265) = lu(k,1265) * lu(k,1264) + lu(k,1266) = lu(k,1266) * lu(k,1264) + lu(k,1267) = lu(k,1267) * lu(k,1264) + lu(k,1268) = lu(k,1268) * lu(k,1264) + lu(k,1269) = lu(k,1269) * lu(k,1264) + lu(k,1270) = lu(k,1270) * lu(k,1264) + lu(k,1271) = lu(k,1271) * lu(k,1264) + lu(k,1272) = lu(k,1272) * lu(k,1264) + lu(k,1273) = lu(k,1273) * lu(k,1264) + lu(k,1274) = lu(k,1274) * lu(k,1264) + lu(k,1275) = lu(k,1275) * lu(k,1264) + lu(k,1276) = lu(k,1276) * lu(k,1264) + lu(k,1567) = lu(k,1567) - lu(k,1265) * lu(k,1562) + lu(k,1571) = - lu(k,1266) * lu(k,1562) + lu(k,1572) = - lu(k,1267) * lu(k,1562) + lu(k,1576) = - lu(k,1268) * lu(k,1562) + lu(k,1578) = lu(k,1578) - lu(k,1269) * lu(k,1562) + lu(k,1579) = lu(k,1579) - lu(k,1270) * lu(k,1562) + lu(k,1580) = - lu(k,1271) * lu(k,1562) + lu(k,1587) = lu(k,1587) - lu(k,1272) * lu(k,1562) + lu(k,1588) = lu(k,1588) - lu(k,1273) * lu(k,1562) + lu(k,1590) = lu(k,1590) - lu(k,1274) * lu(k,1562) + lu(k,1591) = lu(k,1591) - lu(k,1275) * lu(k,1562) + lu(k,1593) = lu(k,1593) - lu(k,1276) * lu(k,1562) + lu(k,2162) = - lu(k,1265) * lu(k,2156) + lu(k,2165) = lu(k,2165) - lu(k,1266) * lu(k,2156) + lu(k,2166) = lu(k,2166) - lu(k,1267) * lu(k,2156) + lu(k,2170) = lu(k,2170) - lu(k,1268) * lu(k,2156) + lu(k,2172) = lu(k,2172) - lu(k,1269) * lu(k,2156) + lu(k,2173) = lu(k,2173) - lu(k,1270) * lu(k,2156) + lu(k,2174) = - lu(k,1271) * lu(k,2156) + lu(k,2187) = lu(k,2187) - lu(k,1272) * lu(k,2156) + lu(k,2188) = lu(k,2188) - lu(k,1273) * lu(k,2156) + lu(k,2190) = lu(k,2190) - lu(k,1274) * lu(k,2156) + lu(k,2191) = lu(k,2191) - lu(k,1275) * lu(k,2156) + lu(k,2195) = lu(k,2195) - lu(k,1276) * lu(k,2156) + lu(k,3747) = lu(k,3747) - lu(k,1265) * lu(k,3729) + lu(k,3758) = lu(k,3758) - lu(k,1266) * lu(k,3729) + lu(k,3760) = lu(k,3760) - lu(k,1267) * lu(k,3729) + lu(k,3769) = lu(k,3769) - lu(k,1268) * lu(k,3729) + lu(k,3776) = lu(k,3776) - lu(k,1269) * lu(k,3729) + lu(k,3777) = lu(k,3777) - lu(k,1270) * lu(k,3729) + lu(k,3778) = lu(k,3778) - lu(k,1271) * lu(k,3729) + lu(k,3818) = lu(k,3818) - lu(k,1272) * lu(k,3729) + lu(k,3819) = lu(k,3819) - lu(k,1273) * lu(k,3729) + lu(k,3821) = lu(k,3821) - lu(k,1274) * lu(k,3729) + lu(k,3822) = lu(k,3822) - lu(k,1275) * lu(k,3729) + lu(k,3826) = lu(k,3826) - lu(k,1276) * lu(k,3729) + lu(k,3980) = - lu(k,1265) * lu(k,3971) + lu(k,3987) = lu(k,3987) - lu(k,1266) * lu(k,3971) + lu(k,3989) = - lu(k,1267) * lu(k,3971) + lu(k,3997) = lu(k,3997) - lu(k,1268) * lu(k,3971) + lu(k,4004) = lu(k,4004) - lu(k,1269) * lu(k,3971) + lu(k,4005) = lu(k,4005) - lu(k,1270) * lu(k,3971) + lu(k,4006) = - lu(k,1271) * lu(k,3971) + lu(k,4045) = - lu(k,1272) * lu(k,3971) + lu(k,4046) = lu(k,4046) - lu(k,1273) * lu(k,3971) + lu(k,4048) = lu(k,4048) - lu(k,1274) * lu(k,3971) + lu(k,4049) = lu(k,4049) - lu(k,1275) * lu(k,3971) + lu(k,4053) = lu(k,4053) - lu(k,1276) * lu(k,3971) end do end subroutine lu_fac27 subroutine lu_fac28( avec_len, lu ) @@ -4898,264 +4754,181 @@ subroutine lu_fac28( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1236) = 1._r8 / lu(k,1236) - lu(k,1237) = lu(k,1237) * lu(k,1236) - lu(k,1238) = lu(k,1238) * lu(k,1236) - lu(k,1239) = lu(k,1239) * lu(k,1236) - lu(k,1240) = lu(k,1240) * lu(k,1236) - lu(k,1443) = lu(k,1443) - lu(k,1237) * lu(k,1432) - lu(k,1444) = lu(k,1444) - lu(k,1238) * lu(k,1432) - lu(k,1448) = lu(k,1448) - lu(k,1239) * lu(k,1432) - lu(k,1456) = lu(k,1456) - lu(k,1240) * lu(k,1432) - lu(k,1664) = lu(k,1664) - lu(k,1237) * lu(k,1659) - lu(k,1665) = lu(k,1665) - lu(k,1238) * lu(k,1659) - lu(k,1671) = lu(k,1671) - lu(k,1239) * lu(k,1659) - lu(k,1679) = lu(k,1679) - lu(k,1240) * lu(k,1659) - lu(k,1722) = - lu(k,1237) * lu(k,1716) - lu(k,1724) = lu(k,1724) - lu(k,1238) * lu(k,1716) - lu(k,1732) = - lu(k,1239) * lu(k,1716) - lu(k,1741) = lu(k,1741) - lu(k,1240) * lu(k,1716) - lu(k,1777) = lu(k,1777) - lu(k,1237) * lu(k,1772) - lu(k,1778) = lu(k,1778) - lu(k,1238) * lu(k,1772) - lu(k,1783) = lu(k,1783) - lu(k,1239) * lu(k,1772) - lu(k,1791) = lu(k,1791) - lu(k,1240) * lu(k,1772) - lu(k,1821) = - lu(k,1237) * lu(k,1816) - lu(k,1823) = lu(k,1823) - lu(k,1238) * lu(k,1816) - lu(k,1830) = - lu(k,1239) * lu(k,1816) - lu(k,1839) = lu(k,1839) - lu(k,1240) * lu(k,1816) - lu(k,1886) = lu(k,1886) - lu(k,1237) * lu(k,1881) - lu(k,1887) = lu(k,1887) - lu(k,1238) * lu(k,1881) - lu(k,1894) = lu(k,1894) - lu(k,1239) * lu(k,1881) - lu(k,1907) = lu(k,1907) - lu(k,1240) * lu(k,1881) - lu(k,1923) = lu(k,1923) - lu(k,1237) * lu(k,1915) - lu(k,1924) = - lu(k,1238) * lu(k,1915) - lu(k,1929) = lu(k,1929) - lu(k,1239) * lu(k,1915) - lu(k,1939) = lu(k,1939) - lu(k,1240) * lu(k,1915) - lu(k,1957) = lu(k,1957) - lu(k,1237) * lu(k,1949) - lu(k,1958) = lu(k,1958) - lu(k,1238) * lu(k,1949) - lu(k,1963) = lu(k,1963) - lu(k,1239) * lu(k,1949) - lu(k,1973) = lu(k,1973) - lu(k,1240) * lu(k,1949) - lu(k,1986) = lu(k,1986) - lu(k,1237) * lu(k,1981) - lu(k,1987) = - lu(k,1238) * lu(k,1981) - lu(k,1992) = lu(k,1992) - lu(k,1239) * lu(k,1981) - lu(k,2001) = - lu(k,1240) * lu(k,1981) - lu(k,2023) = lu(k,2023) - lu(k,1237) * lu(k,2013) - lu(k,2024) = lu(k,2024) - lu(k,1238) * lu(k,2013) - lu(k,2029) = lu(k,2029) - lu(k,1239) * lu(k,2013) - lu(k,2043) = lu(k,2043) - lu(k,1240) * lu(k,2013) - lu(k,2836) = lu(k,2836) - lu(k,1237) * lu(k,2816) - lu(k,2841) = lu(k,2841) - lu(k,1238) * lu(k,2816) - lu(k,2853) = lu(k,2853) - lu(k,1239) * lu(k,2816) - lu(k,2891) = lu(k,2891) - lu(k,1240) * lu(k,2816) - lu(k,3232) = lu(k,3232) - lu(k,1237) * lu(k,3209) - lu(k,3237) = lu(k,3237) - lu(k,1238) * lu(k,3209) - lu(k,3249) = lu(k,3249) - lu(k,1239) * lu(k,3209) - lu(k,3287) = lu(k,3287) - lu(k,1240) * lu(k,3209) - lu(k,3374) = lu(k,3374) - lu(k,1237) * lu(k,3357) - lu(k,3379) = lu(k,3379) - lu(k,1238) * lu(k,3357) - lu(k,3390) = lu(k,3390) - lu(k,1239) * lu(k,3357) - lu(k,3428) = lu(k,3428) - lu(k,1240) * lu(k,3357) - lu(k,3694) = lu(k,3694) - lu(k,1237) * lu(k,3669) - lu(k,3699) = lu(k,3699) - lu(k,1238) * lu(k,3669) - lu(k,3711) = lu(k,3711) - lu(k,1239) * lu(k,3669) - lu(k,3748) = lu(k,3748) - lu(k,1240) * lu(k,3669) - 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,1246) = lu(k,1246) * lu(k,1243) - lu(k,1247) = lu(k,1247) * lu(k,1243) - lu(k,1248) = lu(k,1248) * lu(k,1243) - lu(k,1249) = lu(k,1249) * lu(k,1243) - lu(k,1250) = lu(k,1250) * lu(k,1243) - lu(k,1251) = lu(k,1251) * lu(k,1243) - lu(k,2820) = lu(k,2820) - lu(k,1244) * lu(k,2817) - lu(k,2825) = lu(k,2825) - lu(k,1245) * lu(k,2817) - lu(k,2885) = lu(k,2885) - lu(k,1246) * lu(k,2817) - lu(k,2889) = lu(k,2889) - lu(k,1247) * lu(k,2817) - lu(k,2891) = lu(k,2891) - lu(k,1248) * lu(k,2817) - lu(k,2892) = lu(k,2892) - lu(k,1249) * lu(k,2817) - lu(k,2894) = lu(k,2894) - lu(k,1250) * lu(k,2817) - lu(k,2895) = lu(k,2895) - lu(k,1251) * lu(k,2817) - lu(k,2931) = lu(k,2931) - lu(k,1244) * lu(k,2928) - lu(k,2934) = - lu(k,1245) * lu(k,2928) - lu(k,2986) = lu(k,2986) - lu(k,1246) * lu(k,2928) - lu(k,2990) = lu(k,2990) - lu(k,1247) * lu(k,2928) - lu(k,2992) = lu(k,2992) - lu(k,1248) * lu(k,2928) - lu(k,2993) = lu(k,2993) - lu(k,1249) * lu(k,2928) - lu(k,2995) = lu(k,2995) - lu(k,1250) * lu(k,2928) - lu(k,2996) = lu(k,2996) - lu(k,1251) * lu(k,2928) - lu(k,3022) = lu(k,3022) - lu(k,1244) * lu(k,3020) - lu(k,3025) = - lu(k,1245) * lu(k,3020) - lu(k,3078) = lu(k,3078) - lu(k,1246) * lu(k,3020) - lu(k,3082) = lu(k,3082) - lu(k,1247) * lu(k,3020) - lu(k,3084) = lu(k,3084) - lu(k,1248) * lu(k,3020) - lu(k,3085) = lu(k,3085) - lu(k,1249) * lu(k,3020) - lu(k,3087) = lu(k,3087) - lu(k,1250) * lu(k,3020) - lu(k,3088) = lu(k,3088) - lu(k,1251) * lu(k,3020) - lu(k,3213) = lu(k,3213) - lu(k,1244) * lu(k,3210) - lu(k,3219) = lu(k,3219) - lu(k,1245) * lu(k,3210) - lu(k,3281) = lu(k,3281) - lu(k,1246) * lu(k,3210) - lu(k,3285) = lu(k,3285) - lu(k,1247) * lu(k,3210) - lu(k,3287) = lu(k,3287) - lu(k,1248) * lu(k,3210) - lu(k,3288) = lu(k,3288) - lu(k,1249) * lu(k,3210) - lu(k,3290) = lu(k,3290) - lu(k,1250) * lu(k,3210) - lu(k,3291) = lu(k,3291) - lu(k,1251) * lu(k,3210) - lu(k,3359) = lu(k,3359) - lu(k,1244) * lu(k,3358) - lu(k,3364) = lu(k,3364) - lu(k,1245) * lu(k,3358) - lu(k,3422) = lu(k,3422) - lu(k,1246) * lu(k,3358) - lu(k,3426) = lu(k,3426) - lu(k,1247) * lu(k,3358) - lu(k,3428) = lu(k,3428) - lu(k,1248) * lu(k,3358) - lu(k,3429) = lu(k,3429) - lu(k,1249) * lu(k,3358) - lu(k,3431) = lu(k,3431) - lu(k,1250) * lu(k,3358) - lu(k,3432) = lu(k,3432) - lu(k,1251) * lu(k,3358) - lu(k,3674) = lu(k,3674) - lu(k,1244) * lu(k,3670) - lu(k,3680) = lu(k,3680) - lu(k,1245) * lu(k,3670) - lu(k,3742) = lu(k,3742) - lu(k,1246) * lu(k,3670) - lu(k,3746) = lu(k,3746) - lu(k,1247) * lu(k,3670) - lu(k,3748) = lu(k,3748) - lu(k,1248) * lu(k,3670) - lu(k,3749) = lu(k,3749) - lu(k,1249) * lu(k,3670) - lu(k,3751) = lu(k,3751) - lu(k,1250) * lu(k,3670) - lu(k,3752) = lu(k,3752) - lu(k,1251) * lu(k,3670) - lu(k,3813) = - lu(k,1244) * lu(k,3812) - lu(k,3815) = - lu(k,1245) * lu(k,3812) - lu(k,3823) = lu(k,3823) - lu(k,1246) * lu(k,3812) - lu(k,3827) = lu(k,3827) - lu(k,1247) * lu(k,3812) - lu(k,3829) = lu(k,3829) - lu(k,1248) * lu(k,3812) - lu(k,3830) = lu(k,3830) - lu(k,1249) * lu(k,3812) - lu(k,3832) = lu(k,3832) - lu(k,1250) * lu(k,3812) - lu(k,3833) = lu(k,3833) - lu(k,1251) * lu(k,3812) - lu(k,1255) = 1._r8 / lu(k,1255) - lu(k,1256) = lu(k,1256) * lu(k,1255) - lu(k,1257) = lu(k,1257) * lu(k,1255) - lu(k,1258) = lu(k,1258) * lu(k,1255) - lu(k,1259) = lu(k,1259) * lu(k,1255) - lu(k,1260) = lu(k,1260) * lu(k,1255) - lu(k,1261) = lu(k,1261) * lu(k,1255) - lu(k,1262) = lu(k,1262) * lu(k,1255) - lu(k,1263) = lu(k,1263) * lu(k,1255) - lu(k,1264) = lu(k,1264) * lu(k,1255) - lu(k,1265) = lu(k,1265) * lu(k,1255) - lu(k,1266) = lu(k,1266) * lu(k,1255) - lu(k,1267) = lu(k,1267) * lu(k,1255) - lu(k,1268) = lu(k,1268) * lu(k,1255) - lu(k,1269) = lu(k,1269) * lu(k,1255) - lu(k,1434) = lu(k,1434) - lu(k,1256) * lu(k,1433) - lu(k,1435) = - lu(k,1257) * lu(k,1433) - lu(k,1436) = lu(k,1436) - lu(k,1258) * lu(k,1433) - lu(k,1442) = - lu(k,1259) * lu(k,1433) - lu(k,1443) = lu(k,1443) - lu(k,1260) * lu(k,1433) - lu(k,1445) = - lu(k,1261) * lu(k,1433) - lu(k,1447) = lu(k,1447) - lu(k,1262) * lu(k,1433) - lu(k,1448) = lu(k,1448) - lu(k,1263) * lu(k,1433) - lu(k,1451) = lu(k,1451) - lu(k,1264) * lu(k,1433) - lu(k,1453) = - lu(k,1265) * lu(k,1433) - lu(k,1455) = lu(k,1455) - lu(k,1266) * lu(k,1433) - lu(k,1456) = lu(k,1456) - lu(k,1267) * lu(k,1433) - lu(k,1458) = lu(k,1458) - lu(k,1268) * lu(k,1433) - lu(k,1459) = lu(k,1459) - lu(k,1269) * lu(k,1433) - lu(k,2819) = lu(k,2819) - lu(k,1256) * lu(k,2818) - lu(k,2823) = lu(k,2823) - lu(k,1257) * lu(k,2818) - lu(k,2824) = lu(k,2824) - lu(k,1258) * lu(k,2818) - lu(k,2835) = lu(k,2835) - lu(k,1259) * lu(k,2818) - lu(k,2836) = lu(k,2836) - lu(k,1260) * lu(k,2818) - lu(k,2842) = lu(k,2842) - lu(k,1261) * lu(k,2818) - lu(k,2851) = lu(k,2851) - lu(k,1262) * lu(k,2818) - lu(k,2853) = lu(k,2853) - lu(k,1263) * lu(k,2818) - lu(k,2882) = lu(k,2882) - lu(k,1264) * lu(k,2818) - lu(k,2885) = lu(k,2885) - lu(k,1265) * lu(k,2818) - lu(k,2889) = lu(k,2889) - lu(k,1266) * lu(k,2818) - lu(k,2891) = lu(k,2891) - lu(k,1267) * lu(k,2818) - lu(k,2894) = lu(k,2894) - lu(k,1268) * lu(k,2818) - lu(k,2895) = lu(k,2895) - lu(k,1269) * lu(k,2818) - lu(k,3212) = lu(k,3212) - lu(k,1256) * lu(k,3211) - lu(k,3216) = lu(k,3216) - lu(k,1257) * lu(k,3211) - lu(k,3217) = lu(k,3217) - lu(k,1258) * lu(k,3211) - lu(k,3231) = lu(k,3231) - lu(k,1259) * lu(k,3211) - lu(k,3232) = lu(k,3232) - lu(k,1260) * lu(k,3211) - lu(k,3238) = lu(k,3238) - lu(k,1261) * lu(k,3211) - lu(k,3247) = lu(k,3247) - lu(k,1262) * lu(k,3211) - lu(k,3249) = lu(k,3249) - lu(k,1263) * lu(k,3211) - lu(k,3278) = lu(k,3278) - lu(k,1264) * lu(k,3211) - lu(k,3281) = lu(k,3281) - lu(k,1265) * lu(k,3211) - lu(k,3285) = lu(k,3285) - lu(k,1266) * lu(k,3211) - lu(k,3287) = lu(k,3287) - lu(k,1267) * lu(k,3211) - lu(k,3290) = lu(k,3290) - lu(k,1268) * lu(k,3211) - lu(k,3291) = lu(k,3291) - lu(k,1269) * lu(k,3211) - lu(k,3672) = lu(k,3672) - lu(k,1256) * lu(k,3671) - lu(k,3677) = lu(k,3677) - lu(k,1257) * lu(k,3671) - lu(k,3678) = lu(k,3678) - lu(k,1258) * lu(k,3671) - lu(k,3693) = lu(k,3693) - lu(k,1259) * lu(k,3671) - lu(k,3694) = lu(k,3694) - lu(k,1260) * lu(k,3671) - lu(k,3700) = lu(k,3700) - lu(k,1261) * lu(k,3671) - lu(k,3709) = lu(k,3709) - lu(k,1262) * lu(k,3671) - lu(k,3711) = lu(k,3711) - lu(k,1263) * lu(k,3671) - lu(k,3739) = lu(k,3739) - lu(k,1264) * lu(k,3671) - lu(k,3742) = lu(k,3742) - lu(k,1265) * lu(k,3671) - lu(k,3746) = lu(k,3746) - lu(k,1266) * lu(k,3671) - lu(k,3748) = lu(k,3748) - lu(k,1267) * lu(k,3671) - lu(k,3751) = lu(k,3751) - lu(k,1268) * lu(k,3671) - lu(k,3752) = lu(k,3752) - lu(k,1269) * lu(k,3671) - lu(k,1270) = 1._r8 / lu(k,1270) - lu(k,1271) = lu(k,1271) * lu(k,1270) - lu(k,1272) = lu(k,1272) * lu(k,1270) - lu(k,1273) = lu(k,1273) * lu(k,1270) - lu(k,1274) = lu(k,1274) * lu(k,1270) - lu(k,1275) = lu(k,1275) * lu(k,1270) - lu(k,1320) = - lu(k,1271) * lu(k,1314) - lu(k,1325) = lu(k,1325) - lu(k,1272) * lu(k,1314) - lu(k,1326) = lu(k,1326) - lu(k,1273) * lu(k,1314) - lu(k,1327) = lu(k,1327) - lu(k,1274) * lu(k,1314) - lu(k,1328) = lu(k,1328) - lu(k,1275) * lu(k,1314) - lu(k,1443) = lu(k,1443) - lu(k,1271) * lu(k,1434) - lu(k,1455) = lu(k,1455) - lu(k,1272) * lu(k,1434) - lu(k,1456) = lu(k,1456) - lu(k,1273) * lu(k,1434) - lu(k,1458) = lu(k,1458) - lu(k,1274) * lu(k,1434) - lu(k,1459) = lu(k,1459) - lu(k,1275) * lu(k,1434) - lu(k,1481) = lu(k,1481) - lu(k,1271) * lu(k,1476) - lu(k,1490) = lu(k,1490) - lu(k,1272) * lu(k,1476) - lu(k,1491) = - lu(k,1273) * lu(k,1476) - lu(k,1492) = lu(k,1492) - lu(k,1274) * lu(k,1476) - lu(k,1493) = lu(k,1493) - lu(k,1275) * lu(k,1476) - lu(k,1800) = lu(k,1800) - lu(k,1271) * lu(k,1797) - lu(k,1806) = lu(k,1806) - lu(k,1272) * lu(k,1797) - lu(k,1807) = lu(k,1807) - lu(k,1273) * lu(k,1797) - lu(k,1808) = lu(k,1808) - lu(k,1274) * lu(k,1797) - lu(k,1809) = lu(k,1809) - lu(k,1275) * lu(k,1797) - lu(k,1957) = lu(k,1957) - lu(k,1271) * lu(k,1950) - lu(k,1972) = lu(k,1972) - lu(k,1272) * lu(k,1950) - lu(k,1973) = lu(k,1973) - lu(k,1273) * lu(k,1950) - lu(k,1975) = lu(k,1975) - lu(k,1274) * lu(k,1950) - lu(k,1976) = lu(k,1976) - lu(k,1275) * lu(k,1950) - lu(k,1986) = lu(k,1986) - lu(k,1271) * lu(k,1982) - lu(k,2000) = lu(k,2000) - lu(k,1272) * lu(k,1982) - lu(k,2001) = lu(k,2001) - lu(k,1273) * lu(k,1982) - lu(k,2003) = lu(k,2003) - lu(k,1274) * lu(k,1982) - lu(k,2004) = lu(k,2004) - lu(k,1275) * lu(k,1982) - lu(k,2023) = lu(k,2023) - lu(k,1271) * lu(k,2014) - lu(k,2042) = lu(k,2042) - lu(k,1272) * lu(k,2014) - lu(k,2043) = lu(k,2043) - lu(k,1273) * lu(k,2014) - lu(k,2046) = lu(k,2046) - lu(k,1274) * lu(k,2014) - lu(k,2047) = lu(k,2047) - lu(k,1275) * lu(k,2014) - lu(k,2836) = lu(k,2836) - lu(k,1271) * lu(k,2819) - lu(k,2889) = lu(k,2889) - lu(k,1272) * lu(k,2819) - lu(k,2891) = lu(k,2891) - lu(k,1273) * lu(k,2819) - lu(k,2894) = lu(k,2894) - lu(k,1274) * lu(k,2819) - lu(k,2895) = lu(k,2895) - lu(k,1275) * lu(k,2819) - lu(k,2940) = lu(k,2940) - lu(k,1271) * lu(k,2929) - lu(k,2990) = lu(k,2990) - lu(k,1272) * lu(k,2929) - lu(k,2992) = lu(k,2992) - lu(k,1273) * lu(k,2929) - lu(k,2995) = lu(k,2995) - lu(k,1274) * lu(k,2929) - lu(k,2996) = lu(k,2996) - lu(k,1275) * lu(k,2929) - lu(k,3232) = lu(k,3232) - lu(k,1271) * lu(k,3212) - lu(k,3285) = lu(k,3285) - lu(k,1272) * lu(k,3212) - lu(k,3287) = lu(k,3287) - lu(k,1273) * lu(k,3212) - lu(k,3290) = lu(k,3290) - lu(k,1274) * lu(k,3212) - lu(k,3291) = lu(k,3291) - lu(k,1275) * lu(k,3212) - lu(k,3694) = lu(k,3694) - lu(k,1271) * lu(k,3672) - lu(k,3746) = lu(k,3746) - lu(k,1272) * lu(k,3672) - lu(k,3748) = lu(k,3748) - lu(k,1273) * lu(k,3672) - lu(k,3751) = lu(k,3751) - lu(k,1274) * lu(k,3672) - lu(k,3752) = lu(k,3752) - lu(k,1275) * lu(k,3672) + lu(k,1278) = 1._r8 / lu(k,1278) + lu(k,1279) = lu(k,1279) * lu(k,1278) + lu(k,1280) = lu(k,1280) * lu(k,1278) + lu(k,1281) = lu(k,1281) * lu(k,1278) + lu(k,1282) = lu(k,1282) * lu(k,1278) + lu(k,1283) = lu(k,1283) * lu(k,1278) + lu(k,1284) = lu(k,1284) * lu(k,1278) + lu(k,1285) = lu(k,1285) * lu(k,1278) + lu(k,1286) = lu(k,1286) * lu(k,1278) + lu(k,1671) = lu(k,1671) - lu(k,1279) * lu(k,1670) + lu(k,1672) = - lu(k,1280) * lu(k,1670) + lu(k,1673) = lu(k,1673) - lu(k,1281) * lu(k,1670) + lu(k,1676) = - lu(k,1282) * lu(k,1670) + lu(k,1678) = lu(k,1678) - lu(k,1283) * lu(k,1670) + lu(k,1680) = - lu(k,1284) * lu(k,1670) + lu(k,1681) = - lu(k,1285) * lu(k,1670) + lu(k,1682) = lu(k,1682) - lu(k,1286) * lu(k,1670) + lu(k,2257) = lu(k,2257) - lu(k,1279) * lu(k,2255) + lu(k,2259) = lu(k,2259) - lu(k,1280) * lu(k,2255) + lu(k,2260) = lu(k,2260) - lu(k,1281) * lu(k,2255) + lu(k,2263) = - lu(k,1282) * lu(k,2255) + lu(k,2267) = lu(k,2267) - lu(k,1283) * lu(k,2255) + lu(k,2269) = - lu(k,1284) * lu(k,2255) + lu(k,2270) = lu(k,2270) - lu(k,1285) * lu(k,2255) + lu(k,2271) = lu(k,2271) - lu(k,1286) * lu(k,2255) + lu(k,2633) = lu(k,2633) - lu(k,1279) * lu(k,2632) + lu(k,2635) = lu(k,2635) - lu(k,1280) * lu(k,2632) + lu(k,2637) = lu(k,2637) - lu(k,1281) * lu(k,2632) + lu(k,2643) = - lu(k,1282) * lu(k,2632) + lu(k,2647) = lu(k,2647) - lu(k,1283) * lu(k,2632) + lu(k,2649) = - lu(k,1284) * lu(k,2632) + lu(k,2650) = lu(k,2650) - lu(k,1285) * lu(k,2632) + lu(k,2652) = lu(k,2652) - lu(k,1286) * lu(k,2632) + lu(k,3324) = - lu(k,1279) * lu(k,3323) + lu(k,3325) = - lu(k,1280) * lu(k,3323) + lu(k,3326) = lu(k,3326) - lu(k,1281) * lu(k,3323) + lu(k,3331) = lu(k,3331) - lu(k,1282) * lu(k,3323) + lu(k,3335) = lu(k,3335) - lu(k,1283) * lu(k,3323) + lu(k,3337) = lu(k,3337) - lu(k,1284) * lu(k,3323) + lu(k,3338) = - lu(k,1285) * lu(k,3323) + lu(k,3340) = lu(k,3340) - lu(k,1286) * lu(k,3323) + lu(k,3762) = lu(k,3762) - lu(k,1279) * lu(k,3730) + lu(k,3789) = lu(k,3789) - lu(k,1280) * lu(k,3730) + lu(k,3802) = lu(k,3802) - lu(k,1281) * lu(k,3730) + lu(k,3818) = lu(k,3818) - lu(k,1282) * lu(k,3730) + lu(k,3822) = lu(k,3822) - lu(k,1283) * lu(k,3730) + lu(k,3824) = lu(k,3824) - lu(k,1284) * lu(k,3730) + lu(k,3825) = lu(k,3825) - lu(k,1285) * lu(k,3730) + lu(k,3827) = lu(k,3827) - lu(k,1286) * lu(k,3730) + lu(k,4113) = lu(k,4113) - lu(k,1279) * lu(k,4111) + lu(k,4115) = - lu(k,1280) * lu(k,4111) + lu(k,4117) = lu(k,4117) - lu(k,1281) * lu(k,4111) + lu(k,4123) = - lu(k,1282) * lu(k,4111) + lu(k,4127) = lu(k,4127) - lu(k,1283) * lu(k,4111) + lu(k,4129) = - lu(k,1284) * lu(k,4111) + lu(k,4130) = - lu(k,1285) * lu(k,4111) + lu(k,4132) = lu(k,4132) - lu(k,1286) * lu(k,4111) + lu(k,1287) = 1._r8 / lu(k,1287) + lu(k,1288) = lu(k,1288) * lu(k,1287) + lu(k,1289) = lu(k,1289) * lu(k,1287) + lu(k,1290) = lu(k,1290) * lu(k,1287) + lu(k,1291) = lu(k,1291) * lu(k,1287) + lu(k,1292) = lu(k,1292) * lu(k,1287) + lu(k,1293) = lu(k,1293) * lu(k,1287) + lu(k,1294) = lu(k,1294) * lu(k,1287) + lu(k,2726) = - lu(k,1288) * lu(k,2722) + lu(k,2730) = lu(k,2730) - lu(k,1289) * lu(k,2722) + lu(k,2733) = lu(k,2733) - lu(k,1290) * lu(k,2722) + lu(k,2736) = - lu(k,1291) * lu(k,2722) + lu(k,2739) = lu(k,2739) - lu(k,1292) * lu(k,2722) + lu(k,2740) = lu(k,2740) - lu(k,1293) * lu(k,2722) + lu(k,2741) = lu(k,2741) - lu(k,1294) * lu(k,2722) + lu(k,2880) = lu(k,2880) - lu(k,1288) * lu(k,2873) + lu(k,2898) = lu(k,2898) - lu(k,1289) * lu(k,2873) + lu(k,2902) = lu(k,2902) - lu(k,1290) * lu(k,2873) + lu(k,2907) = - lu(k,1291) * lu(k,2873) + lu(k,2910) = lu(k,2910) - lu(k,1292) * lu(k,2873) + lu(k,2911) = lu(k,2911) - lu(k,1293) * lu(k,2873) + lu(k,2913) = lu(k,2913) - lu(k,1294) * lu(k,2873) + lu(k,3089) = lu(k,3089) - lu(k,1288) * lu(k,3061) + lu(k,3121) = lu(k,3121) - lu(k,1289) * lu(k,3061) + lu(k,3125) = lu(k,3125) - lu(k,1290) * lu(k,3061) + lu(k,3130) = - lu(k,1291) * lu(k,3061) + lu(k,3133) = lu(k,3133) - lu(k,1292) * lu(k,3061) + lu(k,3134) = lu(k,3134) - lu(k,1293) * lu(k,3061) + lu(k,3136) = lu(k,3136) - lu(k,1294) * lu(k,3061) + lu(k,3777) = lu(k,3777) - lu(k,1288) * lu(k,3731) + lu(k,3809) = lu(k,3809) - lu(k,1289) * lu(k,3731) + lu(k,3813) = lu(k,3813) - lu(k,1290) * lu(k,3731) + lu(k,3818) = lu(k,3818) - lu(k,1291) * lu(k,3731) + lu(k,3821) = lu(k,3821) - lu(k,1292) * lu(k,3731) + lu(k,3822) = lu(k,3822) - lu(k,1293) * lu(k,3731) + lu(k,3824) = lu(k,3824) - lu(k,1294) * lu(k,3731) + lu(k,3911) = lu(k,3911) - lu(k,1288) * lu(k,3885) + lu(k,3944) = lu(k,3944) - lu(k,1289) * lu(k,3885) + lu(k,3948) = lu(k,3948) - lu(k,1290) * lu(k,3885) + lu(k,3953) = lu(k,3953) - lu(k,1291) * lu(k,3885) + lu(k,3956) = lu(k,3956) - lu(k,1292) * lu(k,3885) + lu(k,3957) = lu(k,3957) - lu(k,1293) * lu(k,3885) + lu(k,3959) = lu(k,3959) - lu(k,1294) * lu(k,3885) + lu(k,4005) = lu(k,4005) - lu(k,1288) * lu(k,3972) + lu(k,4036) = lu(k,4036) - lu(k,1289) * lu(k,3972) + lu(k,4040) = lu(k,4040) - lu(k,1290) * lu(k,3972) + lu(k,4045) = lu(k,4045) - lu(k,1291) * lu(k,3972) + lu(k,4048) = lu(k,4048) - lu(k,1292) * lu(k,3972) + lu(k,4049) = lu(k,4049) - lu(k,1293) * lu(k,3972) + lu(k,4051) = - lu(k,1294) * lu(k,3972) + lu(k,4082) = lu(k,4082) - lu(k,1288) * lu(k,4074) + lu(k,4089) = - lu(k,1289) * lu(k,4074) + lu(k,4092) = lu(k,4092) - lu(k,1290) * lu(k,4074) + lu(k,4097) = lu(k,4097) - lu(k,1291) * lu(k,4074) + lu(k,4100) = lu(k,4100) - lu(k,1292) * lu(k,4074) + lu(k,4101) = lu(k,4101) - lu(k,1293) * lu(k,4074) + lu(k,4103) = lu(k,4103) - lu(k,1294) * lu(k,4074) + lu(k,1296) = 1._r8 / lu(k,1296) + lu(k,1297) = lu(k,1297) * lu(k,1296) + lu(k,1298) = lu(k,1298) * lu(k,1296) + lu(k,1299) = lu(k,1299) * lu(k,1296) + lu(k,1300) = lu(k,1300) * lu(k,1296) + lu(k,1301) = lu(k,1301) * lu(k,1296) + lu(k,1302) = lu(k,1302) * lu(k,1296) + lu(k,1303) = lu(k,1303) * lu(k,1296) + lu(k,1304) = lu(k,1304) * lu(k,1296) + lu(k,1305) = lu(k,1305) * lu(k,1296) + lu(k,1306) = lu(k,1306) * lu(k,1296) + lu(k,1521) = - lu(k,1297) * lu(k,1520) + lu(k,1524) = - lu(k,1298) * lu(k,1520) + lu(k,1525) = lu(k,1525) - lu(k,1299) * lu(k,1520) + lu(k,1526) = - lu(k,1300) * lu(k,1520) + lu(k,1527) = lu(k,1527) - lu(k,1301) * lu(k,1520) + lu(k,1528) = lu(k,1528) - lu(k,1302) * lu(k,1520) + lu(k,1529) = - lu(k,1303) * lu(k,1520) + lu(k,1531) = lu(k,1531) - lu(k,1304) * lu(k,1520) + lu(k,1532) = lu(k,1532) - lu(k,1305) * lu(k,1520) + lu(k,1533) = - lu(k,1306) * lu(k,1520) + lu(k,1865) = - lu(k,1297) * lu(k,1864) + lu(k,1867) = lu(k,1867) - lu(k,1298) * lu(k,1864) + lu(k,1868) = lu(k,1868) - lu(k,1299) * lu(k,1864) + lu(k,1869) = - lu(k,1300) * lu(k,1864) + lu(k,1871) = lu(k,1871) - lu(k,1301) * lu(k,1864) + lu(k,1872) = lu(k,1872) - lu(k,1302) * lu(k,1864) + lu(k,1875) = - lu(k,1303) * lu(k,1864) + lu(k,1878) = lu(k,1878) - lu(k,1304) * lu(k,1864) + lu(k,1879) = lu(k,1879) - lu(k,1305) * lu(k,1864) + lu(k,1880) = - lu(k,1306) * lu(k,1864) + lu(k,3243) = lu(k,3243) - lu(k,1297) * lu(k,3232) + lu(k,3258) = lu(k,3258) - lu(k,1298) * lu(k,3232) + lu(k,3262) = lu(k,3262) - lu(k,1299) * lu(k,3232) + lu(k,3264) = lu(k,3264) - lu(k,1300) * lu(k,3232) + lu(k,3269) = lu(k,3269) - lu(k,1301) * lu(k,3232) + lu(k,3270) = lu(k,3270) - lu(k,1302) * lu(k,3232) + lu(k,3311) = lu(k,3311) - lu(k,1303) * lu(k,3232) + lu(k,3315) = lu(k,3315) - lu(k,1304) * lu(k,3232) + lu(k,3316) = lu(k,3316) - lu(k,1305) * lu(k,3232) + lu(k,3320) = lu(k,3320) - lu(k,1306) * lu(k,3232) + lu(k,3497) = lu(k,3497) - lu(k,1297) * lu(k,3486) + lu(k,3514) = lu(k,3514) - lu(k,1298) * lu(k,3486) + lu(k,3518) = lu(k,3518) - lu(k,1299) * lu(k,3486) + lu(k,3520) = lu(k,3520) - lu(k,1300) * lu(k,3486) + lu(k,3525) = lu(k,3525) - lu(k,1301) * lu(k,3486) + lu(k,3526) = lu(k,3526) - lu(k,1302) * lu(k,3486) + lu(k,3567) = lu(k,3567) - lu(k,1303) * lu(k,3486) + lu(k,3571) = lu(k,3571) - lu(k,1304) * lu(k,3486) + lu(k,3572) = lu(k,3572) - lu(k,1305) * lu(k,3486) + lu(k,3576) = lu(k,3576) - lu(k,1306) * lu(k,3486) + lu(k,3746) = lu(k,3746) - lu(k,1297) * lu(k,3732) + lu(k,3765) = lu(k,3765) - lu(k,1298) * lu(k,3732) + lu(k,3769) = lu(k,3769) - lu(k,1299) * lu(k,3732) + lu(k,3771) = lu(k,3771) - lu(k,1300) * lu(k,3732) + lu(k,3776) = lu(k,3776) - lu(k,1301) * lu(k,3732) + lu(k,3777) = lu(k,3777) - lu(k,1302) * lu(k,3732) + lu(k,3817) = lu(k,3817) - lu(k,1303) * lu(k,3732) + lu(k,3821) = lu(k,3821) - lu(k,1304) * lu(k,3732) + lu(k,3822) = lu(k,3822) - lu(k,1305) * lu(k,3732) + lu(k,3826) = lu(k,3826) - lu(k,1306) * lu(k,3732) end do end subroutine lu_fac28 subroutine lu_fac29( avec_len, lu ) @@ -5172,235 +4945,203 @@ subroutine lu_fac29( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1285) = 1._r8 / lu(k,1285) - lu(k,1286) = lu(k,1286) * lu(k,1285) - lu(k,1287) = lu(k,1287) * lu(k,1285) - lu(k,1288) = lu(k,1288) * lu(k,1285) - lu(k,1289) = lu(k,1289) * lu(k,1285) - lu(k,1290) = lu(k,1290) * lu(k,1285) - lu(k,1291) = lu(k,1291) * lu(k,1285) - lu(k,1292) = lu(k,1292) * lu(k,1285) - lu(k,1293) = lu(k,1293) * lu(k,1285) - lu(k,1294) = lu(k,1294) * lu(k,1285) - lu(k,1295) = lu(k,1295) * lu(k,1285) - lu(k,1296) = lu(k,1296) * lu(k,1285) - lu(k,1297) = lu(k,1297) * lu(k,1285) - lu(k,1298) = lu(k,1298) * lu(k,1285) - lu(k,1299) = lu(k,1299) * lu(k,1285) - lu(k,1300) = lu(k,1300) * lu(k,1285) - lu(k,1301) = lu(k,1301) * lu(k,1285) - lu(k,1302) = lu(k,1302) * lu(k,1285) - lu(k,1303) = lu(k,1303) * lu(k,1285) - lu(k,1304) = lu(k,1304) * lu(k,1285) - lu(k,2933) = lu(k,2933) - lu(k,1286) * lu(k,2930) - lu(k,2940) = lu(k,2940) - lu(k,1287) * lu(k,2930) - lu(k,2941) = - lu(k,1288) * lu(k,2930) - lu(k,2942) = - lu(k,1289) * lu(k,2930) - lu(k,2947) = - lu(k,1290) * lu(k,2930) - lu(k,2950) = - lu(k,1291) * lu(k,2930) - lu(k,2951) = lu(k,2951) - lu(k,1292) * lu(k,2930) - lu(k,2952) = - lu(k,1293) * lu(k,2930) - lu(k,2954) = - lu(k,1294) * lu(k,2930) - lu(k,2956) = lu(k,2956) - lu(k,1295) * lu(k,2930) - lu(k,2961) = - lu(k,1296) * lu(k,2930) - lu(k,2983) = lu(k,2983) - lu(k,1297) * lu(k,2930) - lu(k,2987) = lu(k,2987) - lu(k,1298) * lu(k,2930) - lu(k,2988) = lu(k,2988) - lu(k,1299) * lu(k,2930) - lu(k,2990) = lu(k,2990) - lu(k,1300) * lu(k,2930) - lu(k,2992) = lu(k,2992) - lu(k,1301) * lu(k,2930) - lu(k,2993) = lu(k,2993) - lu(k,1302) * lu(k,2930) - lu(k,2996) = lu(k,2996) - lu(k,1303) * lu(k,2930) - lu(k,3000) = lu(k,3000) - lu(k,1304) * lu(k,2930) - lu(k,3024) = lu(k,3024) - lu(k,1286) * lu(k,3021) - lu(k,3031) = lu(k,3031) - lu(k,1287) * lu(k,3021) - lu(k,3032) = - lu(k,1288) * lu(k,3021) - lu(k,3033) = - lu(k,1289) * lu(k,3021) - lu(k,3038) = - lu(k,1290) * lu(k,3021) - lu(k,3041) = - lu(k,1291) * lu(k,3021) - lu(k,3042) = lu(k,3042) - lu(k,1292) * lu(k,3021) - lu(k,3043) = - lu(k,1293) * lu(k,3021) - lu(k,3045) = - lu(k,1294) * lu(k,3021) - lu(k,3047) = lu(k,3047) - lu(k,1295) * lu(k,3021) - lu(k,3052) = lu(k,3052) - lu(k,1296) * lu(k,3021) - lu(k,3075) = lu(k,3075) - lu(k,1297) * lu(k,3021) - lu(k,3079) = lu(k,3079) - lu(k,1298) * lu(k,3021) - lu(k,3080) = lu(k,3080) - lu(k,1299) * lu(k,3021) - lu(k,3082) = lu(k,3082) - lu(k,1300) * lu(k,3021) - lu(k,3084) = lu(k,3084) - lu(k,1301) * lu(k,3021) - lu(k,3085) = lu(k,3085) - lu(k,1302) * lu(k,3021) - lu(k,3088) = lu(k,3088) - lu(k,1303) * lu(k,3021) - lu(k,3092) = lu(k,3092) - lu(k,1304) * lu(k,3021) - lu(k,3679) = lu(k,3679) - lu(k,1286) * lu(k,3673) - lu(k,3694) = lu(k,3694) - lu(k,1287) * lu(k,3673) - lu(k,3695) = lu(k,3695) - lu(k,1288) * lu(k,3673) - lu(k,3696) = lu(k,3696) - lu(k,1289) * lu(k,3673) - lu(k,3703) = lu(k,3703) - lu(k,1290) * lu(k,3673) - lu(k,3706) = lu(k,3706) - lu(k,1291) * lu(k,3673) - lu(k,3707) = lu(k,3707) - lu(k,1292) * lu(k,3673) - lu(k,3708) = lu(k,3708) - lu(k,1293) * lu(k,3673) - lu(k,3710) = lu(k,3710) - lu(k,1294) * lu(k,3673) - lu(k,3712) = lu(k,3712) - lu(k,1295) * lu(k,3673) - lu(k,3717) = lu(k,3717) - lu(k,1296) * lu(k,3673) - lu(k,3739) = lu(k,3739) - lu(k,1297) * lu(k,3673) - lu(k,3743) = lu(k,3743) - lu(k,1298) * lu(k,3673) - lu(k,3744) = lu(k,3744) - lu(k,1299) * lu(k,3673) - lu(k,3746) = lu(k,3746) - lu(k,1300) * lu(k,3673) - lu(k,3748) = lu(k,3748) - lu(k,1301) * lu(k,3673) - lu(k,3749) = lu(k,3749) - lu(k,1302) * lu(k,3673) - lu(k,3752) = lu(k,3752) - lu(k,1303) * lu(k,3673) - lu(k,3756) = lu(k,3756) - lu(k,1304) * lu(k,3673) - lu(k,1305) = 1._r8 / lu(k,1305) - lu(k,1306) = lu(k,1306) * lu(k,1305) - lu(k,1307) = lu(k,1307) * lu(k,1305) - lu(k,1308) = lu(k,1308) * lu(k,1305) - lu(k,1309) = lu(k,1309) * lu(k,1305) - lu(k,1310) = lu(k,1310) * lu(k,1305) - lu(k,1311) = lu(k,1311) * lu(k,1305) - lu(k,1312) = lu(k,1312) * lu(k,1305) - lu(k,1313) = lu(k,1313) * lu(k,1305) - lu(k,1859) = lu(k,1859) - lu(k,1306) * lu(k,1855) - lu(k,1864) = lu(k,1864) - lu(k,1307) * lu(k,1855) - lu(k,1865) = - lu(k,1308) * lu(k,1855) - lu(k,1869) = lu(k,1869) - lu(k,1309) * lu(k,1855) - lu(k,1870) = lu(k,1870) - lu(k,1310) * lu(k,1855) - lu(k,1872) = lu(k,1872) - lu(k,1311) * lu(k,1855) - lu(k,1874) = lu(k,1874) - lu(k,1312) * lu(k,1855) - lu(k,1875) = lu(k,1875) - lu(k,1313) * lu(k,1855) - lu(k,2836) = lu(k,2836) - lu(k,1306) * lu(k,2820) - lu(k,2882) = lu(k,2882) - lu(k,1307) * lu(k,2820) - lu(k,2883) = lu(k,2883) - lu(k,1308) * lu(k,2820) - lu(k,2887) = lu(k,2887) - lu(k,1309) * lu(k,2820) - lu(k,2889) = lu(k,2889) - lu(k,1310) * lu(k,2820) - lu(k,2892) = lu(k,2892) - lu(k,1311) * lu(k,2820) - lu(k,2895) = lu(k,2895) - lu(k,1312) * lu(k,2820) - lu(k,2899) = lu(k,2899) - lu(k,1313) * lu(k,2820) - lu(k,2940) = lu(k,2940) - lu(k,1306) * lu(k,2931) - lu(k,2983) = lu(k,2983) - lu(k,1307) * lu(k,2931) - lu(k,2984) = lu(k,2984) - lu(k,1308) * lu(k,2931) - lu(k,2988) = lu(k,2988) - lu(k,1309) * lu(k,2931) - lu(k,2990) = lu(k,2990) - lu(k,1310) * lu(k,2931) - lu(k,2993) = lu(k,2993) - lu(k,1311) * lu(k,2931) - lu(k,2996) = lu(k,2996) - lu(k,1312) * lu(k,2931) - lu(k,3000) = lu(k,3000) - lu(k,1313) * lu(k,2931) - lu(k,3031) = lu(k,3031) - lu(k,1306) * lu(k,3022) - lu(k,3075) = lu(k,3075) - lu(k,1307) * lu(k,3022) - lu(k,3076) = lu(k,3076) - lu(k,1308) * lu(k,3022) - lu(k,3080) = lu(k,3080) - lu(k,1309) * lu(k,3022) - lu(k,3082) = lu(k,3082) - lu(k,1310) * lu(k,3022) - lu(k,3085) = lu(k,3085) - lu(k,1311) * lu(k,3022) - lu(k,3088) = lu(k,3088) - lu(k,1312) * lu(k,3022) - lu(k,3092) = lu(k,3092) - lu(k,1313) * lu(k,3022) - lu(k,3232) = lu(k,3232) - lu(k,1306) * lu(k,3213) - lu(k,3278) = lu(k,3278) - lu(k,1307) * lu(k,3213) - lu(k,3279) = lu(k,3279) - lu(k,1308) * lu(k,3213) - lu(k,3283) = lu(k,3283) - lu(k,1309) * lu(k,3213) - lu(k,3285) = lu(k,3285) - lu(k,1310) * lu(k,3213) - lu(k,3288) = lu(k,3288) - lu(k,1311) * lu(k,3213) - lu(k,3291) = lu(k,3291) - lu(k,1312) * lu(k,3213) - lu(k,3295) = lu(k,3295) - lu(k,1313) * lu(k,3213) - lu(k,3374) = lu(k,3374) - lu(k,1306) * lu(k,3359) - lu(k,3419) = lu(k,3419) - lu(k,1307) * lu(k,3359) - lu(k,3420) = lu(k,3420) - lu(k,1308) * lu(k,3359) - lu(k,3424) = lu(k,3424) - lu(k,1309) * lu(k,3359) - lu(k,3426) = lu(k,3426) - lu(k,1310) * lu(k,3359) - lu(k,3429) = lu(k,3429) - lu(k,1311) * lu(k,3359) - lu(k,3432) = lu(k,3432) - lu(k,1312) * lu(k,3359) - lu(k,3436) = lu(k,3436) - lu(k,1313) * lu(k,3359) - lu(k,3694) = lu(k,3694) - lu(k,1306) * lu(k,3674) - lu(k,3739) = lu(k,3739) - lu(k,1307) * lu(k,3674) - lu(k,3740) = lu(k,3740) - lu(k,1308) * lu(k,3674) - lu(k,3744) = lu(k,3744) - lu(k,1309) * lu(k,3674) - lu(k,3746) = lu(k,3746) - lu(k,1310) * lu(k,3674) - lu(k,3749) = lu(k,3749) - lu(k,1311) * lu(k,3674) - lu(k,3752) = lu(k,3752) - lu(k,1312) * lu(k,3674) - lu(k,3756) = lu(k,3756) - lu(k,1313) * lu(k,3674) - lu(k,3818) = lu(k,3818) - lu(k,1306) * lu(k,3813) - lu(k,3820) = - lu(k,1307) * lu(k,3813) - lu(k,3821) = lu(k,3821) - lu(k,1308) * lu(k,3813) - lu(k,3825) = lu(k,3825) - lu(k,1309) * lu(k,3813) - lu(k,3827) = lu(k,3827) - lu(k,1310) * lu(k,3813) - lu(k,3830) = lu(k,3830) - lu(k,1311) * lu(k,3813) - lu(k,3833) = lu(k,3833) - lu(k,1312) * lu(k,3813) - lu(k,3837) = lu(k,3837) - lu(k,1313) * lu(k,3813) - lu(k,1315) = 1._r8 / lu(k,1315) - lu(k,1316) = lu(k,1316) * lu(k,1315) - lu(k,1317) = lu(k,1317) * lu(k,1315) - lu(k,1318) = lu(k,1318) * lu(k,1315) - lu(k,1319) = lu(k,1319) * lu(k,1315) - lu(k,1320) = lu(k,1320) * lu(k,1315) - lu(k,1321) = lu(k,1321) * lu(k,1315) - lu(k,1322) = lu(k,1322) * lu(k,1315) - lu(k,1323) = lu(k,1323) * lu(k,1315) - lu(k,1324) = lu(k,1324) * lu(k,1315) - lu(k,1325) = lu(k,1325) * lu(k,1315) - lu(k,1326) = lu(k,1326) * lu(k,1315) - lu(k,1327) = lu(k,1327) * lu(k,1315) - lu(k,1328) = lu(k,1328) * lu(k,1315) - lu(k,2016) = lu(k,2016) - lu(k,1316) * lu(k,2015) - lu(k,2017) = lu(k,2017) - lu(k,1317) * lu(k,2015) - lu(k,2020) = lu(k,2020) - lu(k,1318) * lu(k,2015) - lu(k,2022) = lu(k,2022) - lu(k,1319) * lu(k,2015) - lu(k,2023) = lu(k,2023) - lu(k,1320) * lu(k,2015) - lu(k,2024) = lu(k,2024) - lu(k,1321) * lu(k,2015) - lu(k,2025) = lu(k,2025) - lu(k,1322) * lu(k,2015) - lu(k,2028) = lu(k,2028) - lu(k,1323) * lu(k,2015) - lu(k,2039) = lu(k,2039) - lu(k,1324) * lu(k,2015) - lu(k,2042) = lu(k,2042) - lu(k,1325) * lu(k,2015) - lu(k,2043) = lu(k,2043) - lu(k,1326) * lu(k,2015) - lu(k,2046) = lu(k,2046) - lu(k,1327) * lu(k,2015) - lu(k,2047) = lu(k,2047) - lu(k,1328) * lu(k,2015) - lu(k,2823) = lu(k,2823) - lu(k,1316) * lu(k,2821) - lu(k,2824) = lu(k,2824) - lu(k,1317) * lu(k,2821) - lu(k,2832) = lu(k,2832) - lu(k,1318) * lu(k,2821) - lu(k,2835) = lu(k,2835) - lu(k,1319) * lu(k,2821) - lu(k,2836) = lu(k,2836) - lu(k,1320) * lu(k,2821) - lu(k,2841) = lu(k,2841) - lu(k,1321) * lu(k,2821) - lu(k,2842) = lu(k,2842) - lu(k,1322) * lu(k,2821) - lu(k,2851) = lu(k,2851) - lu(k,1323) * lu(k,2821) - lu(k,2885) = lu(k,2885) - lu(k,1324) * lu(k,2821) - lu(k,2889) = lu(k,2889) - lu(k,1325) * lu(k,2821) - lu(k,2891) = lu(k,2891) - lu(k,1326) * lu(k,2821) - lu(k,2894) = lu(k,2894) - lu(k,1327) * lu(k,2821) - lu(k,2895) = lu(k,2895) - lu(k,1328) * lu(k,2821) - lu(k,3216) = lu(k,3216) - lu(k,1316) * lu(k,3214) - lu(k,3217) = lu(k,3217) - lu(k,1317) * lu(k,3214) - lu(k,3228) = lu(k,3228) - lu(k,1318) * lu(k,3214) - lu(k,3231) = lu(k,3231) - lu(k,1319) * lu(k,3214) - lu(k,3232) = lu(k,3232) - lu(k,1320) * lu(k,3214) - lu(k,3237) = lu(k,3237) - lu(k,1321) * lu(k,3214) - lu(k,3238) = lu(k,3238) - lu(k,1322) * lu(k,3214) - lu(k,3247) = lu(k,3247) - lu(k,1323) * lu(k,3214) - lu(k,3281) = lu(k,3281) - lu(k,1324) * lu(k,3214) - lu(k,3285) = lu(k,3285) - lu(k,1325) * lu(k,3214) - lu(k,3287) = lu(k,3287) - lu(k,1326) * lu(k,3214) - lu(k,3290) = lu(k,3290) - lu(k,1327) * lu(k,3214) - lu(k,3291) = lu(k,3291) - lu(k,1328) * lu(k,3214) - lu(k,3362) = - lu(k,1316) * lu(k,3360) - lu(k,3363) = lu(k,3363) - lu(k,1317) * lu(k,3360) - lu(k,3370) = lu(k,3370) - lu(k,1318) * lu(k,3360) - lu(k,3373) = - lu(k,1319) * lu(k,3360) - lu(k,3374) = lu(k,3374) - lu(k,1320) * lu(k,3360) - lu(k,3379) = lu(k,3379) - lu(k,1321) * lu(k,3360) - lu(k,3380) = - lu(k,1322) * lu(k,3360) - lu(k,3388) = lu(k,3388) - lu(k,1323) * lu(k,3360) - lu(k,3422) = lu(k,3422) - lu(k,1324) * lu(k,3360) - lu(k,3426) = lu(k,3426) - lu(k,1325) * lu(k,3360) - lu(k,3428) = lu(k,3428) - lu(k,1326) * lu(k,3360) - lu(k,3431) = lu(k,3431) - lu(k,1327) * lu(k,3360) - lu(k,3432) = lu(k,3432) - lu(k,1328) * lu(k,3360) - lu(k,3677) = lu(k,3677) - lu(k,1316) * lu(k,3675) - lu(k,3678) = lu(k,3678) - lu(k,1317) * lu(k,3675) - lu(k,3689) = lu(k,3689) - lu(k,1318) * lu(k,3675) - lu(k,3693) = lu(k,3693) - lu(k,1319) * lu(k,3675) - lu(k,3694) = lu(k,3694) - lu(k,1320) * lu(k,3675) - lu(k,3699) = lu(k,3699) - lu(k,1321) * lu(k,3675) - lu(k,3700) = lu(k,3700) - lu(k,1322) * lu(k,3675) - lu(k,3709) = lu(k,3709) - lu(k,1323) * lu(k,3675) - lu(k,3742) = lu(k,3742) - lu(k,1324) * lu(k,3675) - lu(k,3746) = lu(k,3746) - lu(k,1325) * lu(k,3675) - lu(k,3748) = lu(k,3748) - lu(k,1326) * lu(k,3675) - lu(k,3751) = lu(k,3751) - lu(k,1327) * lu(k,3675) - lu(k,3752) = lu(k,3752) - lu(k,1328) * lu(k,3675) + lu(k,1307) = 1._r8 / lu(k,1307) + lu(k,1308) = lu(k,1308) * lu(k,1307) + lu(k,1309) = lu(k,1309) * lu(k,1307) + lu(k,1310) = lu(k,1310) * lu(k,1307) + lu(k,1311) = lu(k,1311) * lu(k,1307) + lu(k,1312) = lu(k,1312) * lu(k,1307) + lu(k,1313) = lu(k,1313) * lu(k,1307) + lu(k,1314) = lu(k,1314) * lu(k,1307) + lu(k,1315) = lu(k,1315) * lu(k,1307) + lu(k,1316) = lu(k,1316) * lu(k,1307) + lu(k,1317) = lu(k,1317) * lu(k,1307) + lu(k,1318) = lu(k,1318) * lu(k,1307) + lu(k,1319) = lu(k,1319) * lu(k,1307) + lu(k,1320) = lu(k,1320) * lu(k,1307) + lu(k,2160) = - lu(k,1308) * lu(k,2157) + lu(k,2161) = - lu(k,1309) * lu(k,2157) + lu(k,2162) = lu(k,2162) - lu(k,1310) * lu(k,2157) + lu(k,2167) = lu(k,2167) - lu(k,1311) * lu(k,2157) + lu(k,2168) = - lu(k,1312) * lu(k,2157) + lu(k,2169) = - lu(k,1313) * lu(k,2157) + lu(k,2170) = lu(k,2170) - lu(k,1314) * lu(k,2157) + lu(k,2174) = lu(k,2174) - lu(k,1315) * lu(k,2157) + lu(k,2186) = lu(k,2186) - lu(k,1316) * lu(k,2157) + lu(k,2188) = lu(k,2188) - lu(k,1317) * lu(k,2157) + lu(k,2190) = lu(k,2190) - lu(k,1318) * lu(k,2157) + lu(k,2191) = lu(k,2191) - lu(k,1319) * lu(k,2157) + lu(k,2195) = lu(k,2195) - lu(k,1320) * lu(k,2157) + lu(k,3240) = lu(k,3240) - lu(k,1308) * lu(k,3233) + lu(k,3242) = lu(k,3242) - lu(k,1309) * lu(k,3233) + lu(k,3244) = lu(k,3244) - lu(k,1310) * lu(k,3233) + lu(k,3255) = lu(k,3255) - lu(k,1311) * lu(k,3233) + lu(k,3258) = lu(k,3258) - lu(k,1312) * lu(k,3233) + lu(k,3260) = lu(k,3260) - lu(k,1313) * lu(k,3233) + lu(k,3262) = lu(k,3262) - lu(k,1314) * lu(k,3233) + lu(k,3271) = lu(k,3271) - lu(k,1315) * lu(k,3233) + lu(k,3311) = lu(k,3311) - lu(k,1316) * lu(k,3233) + lu(k,3313) = lu(k,3313) - lu(k,1317) * lu(k,3233) + lu(k,3315) = lu(k,3315) - lu(k,1318) * lu(k,3233) + lu(k,3316) = lu(k,3316) - lu(k,1319) * lu(k,3233) + lu(k,3320) = lu(k,3320) - lu(k,1320) * lu(k,3233) + lu(k,3494) = lu(k,3494) - lu(k,1308) * lu(k,3487) + lu(k,3496) = lu(k,3496) - lu(k,1309) * lu(k,3487) + lu(k,3498) = lu(k,3498) - lu(k,1310) * lu(k,3487) + lu(k,3510) = lu(k,3510) - lu(k,1311) * lu(k,3487) + lu(k,3514) = lu(k,3514) - lu(k,1312) * lu(k,3487) + lu(k,3516) = lu(k,3516) - lu(k,1313) * lu(k,3487) + lu(k,3518) = lu(k,3518) - lu(k,1314) * lu(k,3487) + lu(k,3527) = lu(k,3527) - lu(k,1315) * lu(k,3487) + lu(k,3567) = lu(k,3567) - lu(k,1316) * lu(k,3487) + lu(k,3569) = lu(k,3569) - lu(k,1317) * lu(k,3487) + lu(k,3571) = lu(k,3571) - lu(k,1318) * lu(k,3487) + lu(k,3572) = lu(k,3572) - lu(k,1319) * lu(k,3487) + lu(k,3576) = lu(k,3576) - lu(k,1320) * lu(k,3487) + lu(k,3743) = lu(k,3743) - lu(k,1308) * lu(k,3733) + lu(k,3745) = lu(k,3745) - lu(k,1309) * lu(k,3733) + lu(k,3747) = lu(k,3747) - lu(k,1310) * lu(k,3733) + lu(k,3761) = lu(k,3761) - lu(k,1311) * lu(k,3733) + lu(k,3765) = lu(k,3765) - lu(k,1312) * lu(k,3733) + lu(k,3767) = lu(k,3767) - lu(k,1313) * lu(k,3733) + lu(k,3769) = lu(k,3769) - lu(k,1314) * lu(k,3733) + lu(k,3778) = lu(k,3778) - lu(k,1315) * lu(k,3733) + lu(k,3817) = lu(k,3817) - lu(k,1316) * lu(k,3733) + lu(k,3819) = lu(k,3819) - lu(k,1317) * lu(k,3733) + lu(k,3821) = lu(k,3821) - lu(k,1318) * lu(k,3733) + lu(k,3822) = lu(k,3822) - lu(k,1319) * lu(k,3733) + lu(k,3826) = lu(k,3826) - lu(k,1320) * lu(k,3733) + lu(k,1323) = 1._r8 / lu(k,1323) + lu(k,1324) = lu(k,1324) * lu(k,1323) + lu(k,1325) = lu(k,1325) * lu(k,1323) + lu(k,1326) = lu(k,1326) * lu(k,1323) + lu(k,1327) = lu(k,1327) * lu(k,1323) + lu(k,1328) = lu(k,1328) * lu(k,1323) + lu(k,1329) = lu(k,1329) * lu(k,1323) + lu(k,1330) = lu(k,1330) * lu(k,1323) + lu(k,1331) = lu(k,1331) * lu(k,1323) + lu(k,1332) = lu(k,1332) * lu(k,1323) + lu(k,2597) = lu(k,2597) - lu(k,1324) * lu(k,2592) + lu(k,2600) = lu(k,2600) - lu(k,1325) * lu(k,2592) + lu(k,2602) = - lu(k,1326) * lu(k,2592) + lu(k,2604) = lu(k,2604) - lu(k,1327) * lu(k,2592) + lu(k,2606) = lu(k,2606) - lu(k,1328) * lu(k,2592) + lu(k,2607) = lu(k,2607) - lu(k,1329) * lu(k,2592) + lu(k,2608) = - lu(k,1330) * lu(k,2592) + lu(k,2610) = lu(k,2610) - lu(k,1331) * lu(k,2592) + lu(k,2611) = lu(k,2611) - lu(k,1332) * lu(k,2592) + lu(k,3148) = lu(k,3148) - lu(k,1324) * lu(k,3144) + lu(k,3151) = lu(k,3151) - lu(k,1325) * lu(k,3144) + lu(k,3153) = lu(k,3153) - lu(k,1326) * lu(k,3144) + lu(k,3155) = lu(k,3155) - lu(k,1327) * lu(k,3144) + lu(k,3157) = lu(k,3157) - lu(k,1328) * lu(k,3144) + lu(k,3158) = lu(k,3158) - lu(k,1329) * lu(k,3144) + lu(k,3159) = - lu(k,1330) * lu(k,3144) + lu(k,3161) = - lu(k,1331) * lu(k,3144) + lu(k,3162) = lu(k,3162) - lu(k,1332) * lu(k,3144) + lu(k,3383) = lu(k,3383) - lu(k,1324) * lu(k,3374) + lu(k,3386) = lu(k,3386) - lu(k,1325) * lu(k,3374) + lu(k,3388) = lu(k,3388) - lu(k,1326) * lu(k,3374) + lu(k,3390) = lu(k,3390) - lu(k,1327) * lu(k,3374) + lu(k,3392) = lu(k,3392) - lu(k,1328) * lu(k,3374) + lu(k,3393) = lu(k,3393) - lu(k,1329) * lu(k,3374) + lu(k,3394) = lu(k,3394) - lu(k,1330) * lu(k,3374) + lu(k,3396) = lu(k,3396) - lu(k,1331) * lu(k,3374) + lu(k,3397) = lu(k,3397) - lu(k,1332) * lu(k,3374) + lu(k,3803) = lu(k,3803) - lu(k,1324) * lu(k,3734) + lu(k,3816) = lu(k,3816) - lu(k,1325) * lu(k,3734) + lu(k,3818) = lu(k,3818) - lu(k,1326) * lu(k,3734) + lu(k,3820) = lu(k,3820) - lu(k,1327) * lu(k,3734) + lu(k,3822) = lu(k,3822) - lu(k,1328) * lu(k,3734) + lu(k,3823) = lu(k,3823) - lu(k,1329) * lu(k,3734) + lu(k,3824) = lu(k,3824) - lu(k,1330) * lu(k,3734) + lu(k,3826) = lu(k,3826) - lu(k,1331) * lu(k,3734) + lu(k,3827) = lu(k,3827) - lu(k,1332) * lu(k,3734) + lu(k,3853) = lu(k,3853) - lu(k,1324) * lu(k,3838) + lu(k,3857) = lu(k,3857) - lu(k,1325) * lu(k,3838) + lu(k,3859) = - lu(k,1326) * lu(k,3838) + lu(k,3861) = lu(k,3861) - lu(k,1327) * lu(k,3838) + lu(k,3863) = lu(k,3863) - lu(k,1328) * lu(k,3838) + lu(k,3864) = lu(k,3864) - lu(k,1329) * lu(k,3838) + lu(k,3865) = lu(k,3865) - lu(k,1330) * lu(k,3838) + lu(k,3867) = lu(k,3867) - lu(k,1331) * lu(k,3838) + lu(k,3868) = lu(k,3868) - lu(k,1332) * lu(k,3838) + lu(k,4087) = lu(k,4087) - lu(k,1324) * lu(k,4075) + lu(k,4095) = lu(k,4095) - lu(k,1325) * lu(k,4075) + lu(k,4097) = lu(k,4097) - lu(k,1326) * lu(k,4075) + lu(k,4099) = lu(k,4099) - lu(k,1327) * lu(k,4075) + lu(k,4101) = lu(k,4101) - lu(k,1328) * lu(k,4075) + lu(k,4102) = lu(k,4102) - lu(k,1329) * lu(k,4075) + lu(k,4103) = lu(k,4103) - lu(k,1330) * lu(k,4075) + lu(k,4105) = lu(k,4105) - lu(k,1331) * lu(k,4075) + lu(k,4106) = lu(k,4106) - lu(k,1332) * lu(k,4075) + lu(k,1334) = 1._r8 / lu(k,1334) + lu(k,1335) = lu(k,1335) * lu(k,1334) + lu(k,1336) = lu(k,1336) * lu(k,1334) + lu(k,1337) = lu(k,1337) * lu(k,1334) + lu(k,1338) = lu(k,1338) * lu(k,1334) + lu(k,1339) = lu(k,1339) * lu(k,1334) + lu(k,1340) = lu(k,1340) * lu(k,1334) + lu(k,1341) = lu(k,1341) * lu(k,1334) + lu(k,1342) = lu(k,1342) * lu(k,1334) + lu(k,1343) = lu(k,1343) * lu(k,1334) + lu(k,1344) = lu(k,1344) * lu(k,1334) + lu(k,1345) = lu(k,1345) * lu(k,1334) + lu(k,2273) = - lu(k,1335) * lu(k,2272) + lu(k,2274) = - lu(k,1336) * lu(k,2272) + lu(k,2275) = - lu(k,1337) * lu(k,2272) + lu(k,2278) = lu(k,2278) - lu(k,1338) * lu(k,2272) + lu(k,2279) = - lu(k,1339) * lu(k,2272) + lu(k,2281) = - lu(k,1340) * lu(k,2272) + lu(k,2283) = - lu(k,1341) * lu(k,2272) + lu(k,2284) = lu(k,2284) - lu(k,1342) * lu(k,2272) + lu(k,2286) = lu(k,2286) - lu(k,1343) * lu(k,2272) + lu(k,2287) = - lu(k,1344) * lu(k,2272) + lu(k,2288) = lu(k,2288) - lu(k,1345) * lu(k,2272) + lu(k,3245) = - lu(k,1335) * lu(k,3234) + lu(k,3262) = lu(k,3262) - lu(k,1336) * lu(k,3234) + lu(k,3269) = lu(k,3269) - lu(k,1337) * lu(k,3234) + lu(k,3308) = lu(k,3308) - lu(k,1338) * lu(k,3234) + lu(k,3311) = lu(k,3311) - lu(k,1339) * lu(k,3234) + lu(k,3313) = lu(k,3313) - lu(k,1340) * lu(k,3234) + lu(k,3315) = lu(k,3315) - lu(k,1341) * lu(k,3234) + lu(k,3316) = lu(k,3316) - lu(k,1342) * lu(k,3234) + lu(k,3319) = lu(k,3319) - lu(k,1343) * lu(k,3234) + lu(k,3320) = lu(k,3320) - lu(k,1344) * lu(k,3234) + lu(k,3321) = lu(k,3321) - lu(k,1345) * lu(k,3234) + lu(k,3500) = - lu(k,1335) * lu(k,3488) + lu(k,3518) = lu(k,3518) - lu(k,1336) * lu(k,3488) + lu(k,3525) = lu(k,3525) - lu(k,1337) * lu(k,3488) + lu(k,3564) = lu(k,3564) - lu(k,1338) * lu(k,3488) + lu(k,3567) = lu(k,3567) - lu(k,1339) * lu(k,3488) + lu(k,3569) = lu(k,3569) - lu(k,1340) * lu(k,3488) + lu(k,3571) = lu(k,3571) - lu(k,1341) * lu(k,3488) + lu(k,3572) = lu(k,3572) - lu(k,1342) * lu(k,3488) + lu(k,3575) = lu(k,3575) - lu(k,1343) * lu(k,3488) + lu(k,3576) = lu(k,3576) - lu(k,1344) * lu(k,3488) + lu(k,3577) = lu(k,3577) - lu(k,1345) * lu(k,3488) + lu(k,3749) = lu(k,3749) - lu(k,1335) * lu(k,3735) + lu(k,3769) = lu(k,3769) - lu(k,1336) * lu(k,3735) + lu(k,3776) = lu(k,3776) - lu(k,1337) * lu(k,3735) + lu(k,3814) = lu(k,3814) - lu(k,1338) * lu(k,3735) + lu(k,3817) = lu(k,3817) - lu(k,1339) * lu(k,3735) + lu(k,3819) = lu(k,3819) - lu(k,1340) * lu(k,3735) + lu(k,3821) = lu(k,3821) - lu(k,1341) * lu(k,3735) + lu(k,3822) = lu(k,3822) - lu(k,1342) * lu(k,3735) + lu(k,3825) = lu(k,3825) - lu(k,1343) * lu(k,3735) + lu(k,3826) = lu(k,3826) - lu(k,1344) * lu(k,3735) + lu(k,3827) = lu(k,3827) - lu(k,1345) * lu(k,3735) + lu(k,3981) = lu(k,3981) - lu(k,1335) * lu(k,3973) + lu(k,3997) = lu(k,3997) - lu(k,1336) * lu(k,3973) + lu(k,4004) = lu(k,4004) - lu(k,1337) * lu(k,3973) + lu(k,4041) = lu(k,4041) - lu(k,1338) * lu(k,3973) + lu(k,4044) = lu(k,4044) - lu(k,1339) * lu(k,3973) + lu(k,4046) = lu(k,4046) - lu(k,1340) * lu(k,3973) + lu(k,4048) = lu(k,4048) - lu(k,1341) * lu(k,3973) + lu(k,4049) = lu(k,4049) - lu(k,1342) * lu(k,3973) + lu(k,4052) = lu(k,4052) - lu(k,1343) * lu(k,3973) + lu(k,4053) = lu(k,4053) - lu(k,1344) * lu(k,3973) + lu(k,4054) = lu(k,4054) - lu(k,1345) * lu(k,3973) end do end subroutine lu_fac29 subroutine lu_fac30( avec_len, lu ) @@ -5417,307 +5158,293 @@ subroutine lu_fac30( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1329) = 1._r8 / lu(k,1329) - lu(k,1330) = lu(k,1330) * lu(k,1329) - lu(k,1331) = lu(k,1331) * lu(k,1329) - lu(k,1332) = lu(k,1332) * lu(k,1329) - lu(k,1333) = lu(k,1333) * lu(k,1329) - lu(k,1334) = lu(k,1334) * lu(k,1329) - lu(k,1335) = lu(k,1335) * lu(k,1329) - lu(k,1384) = lu(k,1384) - lu(k,1330) * lu(k,1382) - lu(k,1385) = lu(k,1385) - lu(k,1331) * lu(k,1382) - lu(k,1387) = lu(k,1387) - lu(k,1332) * lu(k,1382) - lu(k,1391) = lu(k,1391) - lu(k,1333) * lu(k,1382) - lu(k,1392) = lu(k,1392) - lu(k,1334) * lu(k,1382) - lu(k,1395) = lu(k,1395) - lu(k,1335) * lu(k,1382) - lu(k,1570) = lu(k,1570) - lu(k,1330) * lu(k,1567) - lu(k,1572) = lu(k,1572) - lu(k,1331) * lu(k,1567) - lu(k,1575) = - lu(k,1332) * lu(k,1567) - lu(k,1581) = lu(k,1581) - lu(k,1333) * lu(k,1567) - lu(k,1582) = lu(k,1582) - lu(k,1334) * lu(k,1567) - lu(k,1585) = lu(k,1585) - lu(k,1335) * lu(k,1567) - lu(k,1632) = lu(k,1632) - lu(k,1330) * lu(k,1629) - lu(k,1633) = lu(k,1633) - lu(k,1331) * lu(k,1629) - lu(k,1637) = lu(k,1637) - lu(k,1332) * lu(k,1629) - lu(k,1640) = lu(k,1640) - lu(k,1333) * lu(k,1629) - lu(k,1641) = - lu(k,1334) * lu(k,1629) - lu(k,1643) = lu(k,1643) - lu(k,1335) * lu(k,1629) - lu(k,1664) = lu(k,1664) - lu(k,1330) * lu(k,1660) - lu(k,1665) = lu(k,1665) - lu(k,1331) * lu(k,1660) - lu(k,1671) = lu(k,1671) - lu(k,1332) * lu(k,1660) - lu(k,1678) = lu(k,1678) - lu(k,1333) * lu(k,1660) - lu(k,1679) = lu(k,1679) - lu(k,1334) * lu(k,1660) - lu(k,1682) = lu(k,1682) - lu(k,1335) * lu(k,1660) - lu(k,1886) = lu(k,1886) - lu(k,1330) * lu(k,1882) - lu(k,1887) = lu(k,1887) - lu(k,1331) * lu(k,1882) - lu(k,1894) = lu(k,1894) - lu(k,1332) * lu(k,1882) - lu(k,1906) = lu(k,1906) - lu(k,1333) * lu(k,1882) - lu(k,1907) = lu(k,1907) - lu(k,1334) * lu(k,1882) - lu(k,1910) = lu(k,1910) - lu(k,1335) * lu(k,1882) - lu(k,1923) = lu(k,1923) - lu(k,1330) * lu(k,1916) - lu(k,1924) = lu(k,1924) - lu(k,1331) * lu(k,1916) - lu(k,1929) = lu(k,1929) - lu(k,1332) * lu(k,1916) - lu(k,1938) = lu(k,1938) - lu(k,1333) * lu(k,1916) - lu(k,1939) = lu(k,1939) - lu(k,1334) * lu(k,1916) - lu(k,1942) = lu(k,1942) - lu(k,1335) * lu(k,1916) - lu(k,2655) = lu(k,2655) - lu(k,1330) * lu(k,2647) - lu(k,2660) = lu(k,2660) - lu(k,1331) * lu(k,2647) - lu(k,2670) = lu(k,2670) - lu(k,1332) * lu(k,2647) - lu(k,2705) = lu(k,2705) - lu(k,1333) * lu(k,2647) - lu(k,2706) = lu(k,2706) - lu(k,1334) * lu(k,2647) - lu(k,2710) = lu(k,2710) - lu(k,1335) * lu(k,2647) - lu(k,2836) = lu(k,2836) - lu(k,1330) * lu(k,2822) - lu(k,2841) = lu(k,2841) - lu(k,1331) * lu(k,2822) - lu(k,2853) = lu(k,2853) - lu(k,1332) * lu(k,2822) - lu(k,2889) = lu(k,2889) - lu(k,1333) * lu(k,2822) - lu(k,2891) = lu(k,2891) - lu(k,1334) * lu(k,2822) - lu(k,2895) = lu(k,2895) - lu(k,1335) * lu(k,2822) - lu(k,3232) = lu(k,3232) - lu(k,1330) * lu(k,3215) - lu(k,3237) = lu(k,3237) - lu(k,1331) * lu(k,3215) - lu(k,3249) = lu(k,3249) - lu(k,1332) * lu(k,3215) - lu(k,3285) = lu(k,3285) - lu(k,1333) * lu(k,3215) - lu(k,3287) = lu(k,3287) - lu(k,1334) * lu(k,3215) - lu(k,3291) = lu(k,3291) - lu(k,1335) * lu(k,3215) - lu(k,3374) = lu(k,3374) - lu(k,1330) * lu(k,3361) - lu(k,3379) = lu(k,3379) - lu(k,1331) * lu(k,3361) - lu(k,3390) = lu(k,3390) - lu(k,1332) * lu(k,3361) - lu(k,3426) = lu(k,3426) - lu(k,1333) * lu(k,3361) - lu(k,3428) = lu(k,3428) - lu(k,1334) * lu(k,3361) - lu(k,3432) = lu(k,3432) - lu(k,1335) * lu(k,3361) - lu(k,3694) = lu(k,3694) - lu(k,1330) * lu(k,3676) - lu(k,3699) = lu(k,3699) - lu(k,1331) * lu(k,3676) - lu(k,3711) = lu(k,3711) - lu(k,1332) * lu(k,3676) - lu(k,3746) = lu(k,3746) - lu(k,1333) * lu(k,3676) - lu(k,3748) = lu(k,3748) - lu(k,1334) * lu(k,3676) - lu(k,3752) = lu(k,3752) - lu(k,1335) * lu(k,3676) - lu(k,1336) = 1._r8 / lu(k,1336) - lu(k,1337) = lu(k,1337) * lu(k,1336) - lu(k,1338) = lu(k,1338) * lu(k,1336) - lu(k,1339) = lu(k,1339) * lu(k,1336) - lu(k,1340) = lu(k,1340) * lu(k,1336) - lu(k,1341) = lu(k,1341) * lu(k,1336) - lu(k,1342) = lu(k,1342) * lu(k,1336) - lu(k,1440) = - lu(k,1337) * lu(k,1435) - lu(k,1444) = lu(k,1444) - lu(k,1338) * lu(k,1435) - lu(k,1446) = - lu(k,1339) * lu(k,1435) - lu(k,1455) = lu(k,1455) - lu(k,1340) * lu(k,1435) - lu(k,1458) = lu(k,1458) - lu(k,1341) * lu(k,1435) - lu(k,1459) = lu(k,1459) - lu(k,1342) * lu(k,1435) - lu(k,1479) = lu(k,1479) - lu(k,1337) * lu(k,1477) - lu(k,1482) = lu(k,1482) - lu(k,1338) * lu(k,1477) - lu(k,1484) = - lu(k,1339) * lu(k,1477) - lu(k,1490) = lu(k,1490) - lu(k,1340) * lu(k,1477) - lu(k,1492) = lu(k,1492) - lu(k,1341) * lu(k,1477) - lu(k,1493) = lu(k,1493) - lu(k,1342) * lu(k,1477) - lu(k,1720) = lu(k,1720) - lu(k,1337) * lu(k,1717) - lu(k,1724) = lu(k,1724) - lu(k,1338) * lu(k,1717) - lu(k,1726) = lu(k,1726) - lu(k,1339) * lu(k,1717) - lu(k,1740) = lu(k,1740) - lu(k,1340) * lu(k,1717) - lu(k,1743) = lu(k,1743) - lu(k,1341) * lu(k,1717) - lu(k,1744) = lu(k,1744) - lu(k,1342) * lu(k,1717) - lu(k,1819) = lu(k,1819) - lu(k,1337) * lu(k,1817) - lu(k,1823) = lu(k,1823) - lu(k,1338) * lu(k,1817) - lu(k,1825) = lu(k,1825) - lu(k,1339) * lu(k,1817) - lu(k,1838) = lu(k,1838) - lu(k,1340) * lu(k,1817) - lu(k,1841) = lu(k,1841) - lu(k,1341) * lu(k,1817) - lu(k,1842) = lu(k,1842) - lu(k,1342) * lu(k,1817) - lu(k,1921) = lu(k,1921) - lu(k,1337) * lu(k,1917) - lu(k,1924) = lu(k,1924) - lu(k,1338) * lu(k,1917) - lu(k,1926) = - lu(k,1339) * lu(k,1917) - lu(k,1938) = lu(k,1938) - lu(k,1340) * lu(k,1917) - lu(k,1941) = lu(k,1941) - lu(k,1341) * lu(k,1917) - lu(k,1942) = lu(k,1942) - lu(k,1342) * lu(k,1917) - lu(k,1955) = - lu(k,1337) * lu(k,1951) - lu(k,1958) = lu(k,1958) - lu(k,1338) * lu(k,1951) - lu(k,1960) = - lu(k,1339) * lu(k,1951) - lu(k,1972) = lu(k,1972) - lu(k,1340) * lu(k,1951) - lu(k,1975) = lu(k,1975) - lu(k,1341) * lu(k,1951) - lu(k,1976) = lu(k,1976) - lu(k,1342) * lu(k,1951) - lu(k,2020) = lu(k,2020) - lu(k,1337) * lu(k,2016) - lu(k,2024) = lu(k,2024) - lu(k,1338) * lu(k,2016) - lu(k,2026) = - lu(k,1339) * lu(k,2016) - lu(k,2042) = lu(k,2042) - lu(k,1340) * lu(k,2016) - lu(k,2046) = lu(k,2046) - lu(k,1341) * lu(k,2016) - lu(k,2047) = lu(k,2047) - lu(k,1342) * lu(k,2016) - lu(k,2832) = lu(k,2832) - lu(k,1337) * lu(k,2823) - lu(k,2841) = lu(k,2841) - lu(k,1338) * lu(k,2823) - lu(k,2843) = lu(k,2843) - lu(k,1339) * lu(k,2823) - lu(k,2889) = lu(k,2889) - lu(k,1340) * lu(k,2823) - lu(k,2894) = lu(k,2894) - lu(k,1341) * lu(k,2823) - lu(k,2895) = lu(k,2895) - lu(k,1342) * lu(k,2823) - lu(k,3228) = lu(k,3228) - lu(k,1337) * lu(k,3216) - lu(k,3237) = lu(k,3237) - lu(k,1338) * lu(k,3216) - lu(k,3239) = lu(k,3239) - lu(k,1339) * lu(k,3216) - lu(k,3285) = lu(k,3285) - lu(k,1340) * lu(k,3216) - lu(k,3290) = lu(k,3290) - lu(k,1341) * lu(k,3216) - lu(k,3291) = lu(k,3291) - lu(k,1342) * lu(k,3216) - lu(k,3370) = lu(k,3370) - lu(k,1337) * lu(k,3362) - lu(k,3379) = lu(k,3379) - lu(k,1338) * lu(k,3362) - lu(k,3381) = - lu(k,1339) * lu(k,3362) - lu(k,3426) = lu(k,3426) - lu(k,1340) * lu(k,3362) - lu(k,3431) = lu(k,3431) - lu(k,1341) * lu(k,3362) - lu(k,3432) = lu(k,3432) - lu(k,1342) * lu(k,3362) - lu(k,3689) = lu(k,3689) - lu(k,1337) * lu(k,3677) - lu(k,3699) = lu(k,3699) - lu(k,1338) * lu(k,3677) - lu(k,3701) = lu(k,3701) - lu(k,1339) * lu(k,3677) - lu(k,3746) = lu(k,3746) - lu(k,1340) * lu(k,3677) - lu(k,3751) = lu(k,3751) - lu(k,1341) * lu(k,3677) - lu(k,3752) = lu(k,3752) - lu(k,1342) * lu(k,3677) - lu(k,1343) = 1._r8 / lu(k,1343) - lu(k,1344) = lu(k,1344) * lu(k,1343) - lu(k,1345) = lu(k,1345) * lu(k,1343) - lu(k,1346) = lu(k,1346) * lu(k,1343) - lu(k,1347) = lu(k,1347) * lu(k,1343) - lu(k,1348) = lu(k,1348) * lu(k,1343) - lu(k,1448) = lu(k,1448) - lu(k,1344) * lu(k,1436) - lu(k,1451) = lu(k,1451) - lu(k,1345) * lu(k,1436) - lu(k,1456) = lu(k,1456) - lu(k,1346) * lu(k,1436) - lu(k,1458) = lu(k,1458) - lu(k,1347) * lu(k,1436) - lu(k,1459) = lu(k,1459) - lu(k,1348) * lu(k,1436) - lu(k,1486) = lu(k,1486) - lu(k,1344) * lu(k,1478) - lu(k,1487) = - lu(k,1345) * lu(k,1478) - lu(k,1491) = lu(k,1491) - lu(k,1346) * lu(k,1478) - lu(k,1492) = lu(k,1492) - lu(k,1347) * lu(k,1478) - lu(k,1493) = lu(k,1493) - lu(k,1348) * lu(k,1478) - lu(k,1621) = lu(k,1621) - lu(k,1344) * lu(k,1617) - lu(k,1622) = - lu(k,1345) * lu(k,1617) - lu(k,1625) = lu(k,1625) - lu(k,1346) * lu(k,1617) - lu(k,1626) = lu(k,1626) - lu(k,1347) * lu(k,1617) - lu(k,1627) = lu(k,1627) - lu(k,1348) * lu(k,1617) - lu(k,1802) = lu(k,1802) - lu(k,1344) * lu(k,1798) - lu(k,1803) = lu(k,1803) - lu(k,1345) * lu(k,1798) - lu(k,1807) = lu(k,1807) - lu(k,1346) * lu(k,1798) - lu(k,1808) = lu(k,1808) - lu(k,1347) * lu(k,1798) - lu(k,1809) = lu(k,1809) - lu(k,1348) * lu(k,1798) - lu(k,1862) = lu(k,1862) - lu(k,1344) * lu(k,1856) - lu(k,1864) = lu(k,1864) - lu(k,1345) * lu(k,1856) - lu(k,1871) = lu(k,1871) - lu(k,1346) * lu(k,1856) - lu(k,1873) = lu(k,1873) - lu(k,1347) * lu(k,1856) - lu(k,1874) = lu(k,1874) - lu(k,1348) * lu(k,1856) - lu(k,1929) = lu(k,1929) - lu(k,1344) * lu(k,1918) - lu(k,1932) = - lu(k,1345) * lu(k,1918) - lu(k,1939) = lu(k,1939) - lu(k,1346) * lu(k,1918) - lu(k,1941) = lu(k,1941) - lu(k,1347) * lu(k,1918) - lu(k,1942) = lu(k,1942) - lu(k,1348) * lu(k,1918) - lu(k,1992) = lu(k,1992) - lu(k,1344) * lu(k,1983) - lu(k,1994) = lu(k,1994) - lu(k,1345) * lu(k,1983) - lu(k,2001) = lu(k,2001) - lu(k,1346) * lu(k,1983) - lu(k,2003) = lu(k,2003) - lu(k,1347) * lu(k,1983) - lu(k,2004) = lu(k,2004) - lu(k,1348) * lu(k,1983) - lu(k,2029) = lu(k,2029) - lu(k,1344) * lu(k,2017) - lu(k,2036) = lu(k,2036) - lu(k,1345) * lu(k,2017) - lu(k,2043) = lu(k,2043) - lu(k,1346) * lu(k,2017) - lu(k,2046) = lu(k,2046) - lu(k,1347) * lu(k,2017) - lu(k,2047) = lu(k,2047) - lu(k,1348) * lu(k,2017) - lu(k,2853) = lu(k,2853) - lu(k,1344) * lu(k,2824) - lu(k,2882) = lu(k,2882) - lu(k,1345) * lu(k,2824) - lu(k,2891) = lu(k,2891) - lu(k,1346) * lu(k,2824) - lu(k,2894) = lu(k,2894) - lu(k,1347) * lu(k,2824) - lu(k,2895) = lu(k,2895) - lu(k,1348) * lu(k,2824) - lu(k,2955) = lu(k,2955) - lu(k,1344) * lu(k,2932) - lu(k,2983) = lu(k,2983) - lu(k,1345) * lu(k,2932) - lu(k,2992) = lu(k,2992) - lu(k,1346) * lu(k,2932) - lu(k,2995) = lu(k,2995) - lu(k,1347) * lu(k,2932) - lu(k,2996) = lu(k,2996) - lu(k,1348) * lu(k,2932) - lu(k,3046) = lu(k,3046) - lu(k,1344) * lu(k,3023) - lu(k,3075) = lu(k,3075) - lu(k,1345) * lu(k,3023) - lu(k,3084) = lu(k,3084) - lu(k,1346) * lu(k,3023) - lu(k,3087) = lu(k,3087) - lu(k,1347) * lu(k,3023) - lu(k,3088) = lu(k,3088) - lu(k,1348) * lu(k,3023) - lu(k,3249) = lu(k,3249) - lu(k,1344) * lu(k,3217) - lu(k,3278) = lu(k,3278) - lu(k,1345) * lu(k,3217) - lu(k,3287) = lu(k,3287) - lu(k,1346) * lu(k,3217) - lu(k,3290) = lu(k,3290) - lu(k,1347) * lu(k,3217) - lu(k,3291) = lu(k,3291) - lu(k,1348) * lu(k,3217) - lu(k,3390) = lu(k,3390) - lu(k,1344) * lu(k,3363) - lu(k,3419) = lu(k,3419) - lu(k,1345) * lu(k,3363) - lu(k,3428) = lu(k,3428) - lu(k,1346) * lu(k,3363) - lu(k,3431) = lu(k,3431) - lu(k,1347) * lu(k,3363) - lu(k,3432) = lu(k,3432) - lu(k,1348) * lu(k,3363) - lu(k,3711) = lu(k,3711) - lu(k,1344) * lu(k,3678) - lu(k,3739) = lu(k,3739) - lu(k,1345) * lu(k,3678) - lu(k,3748) = lu(k,3748) - lu(k,1346) * lu(k,3678) - lu(k,3751) = lu(k,3751) - lu(k,1347) * lu(k,3678) - lu(k,3752) = lu(k,3752) - lu(k,1348) * lu(k,3678) - lu(k,1349) = 1._r8 / lu(k,1349) - lu(k,1350) = lu(k,1350) * lu(k,1349) - lu(k,1351) = lu(k,1351) * lu(k,1349) - lu(k,1352) = lu(k,1352) * lu(k,1349) - lu(k,1353) = lu(k,1353) * lu(k,1349) - lu(k,1354) = lu(k,1354) * lu(k,1349) - lu(k,1355) = lu(k,1355) * lu(k,1349) - lu(k,1455) = lu(k,1455) - lu(k,1350) * lu(k,1437) - lu(k,1457) = - lu(k,1351) * lu(k,1437) - lu(k,1459) = lu(k,1459) - lu(k,1352) * lu(k,1437) - lu(k,1460) = - lu(k,1353) * lu(k,1437) - lu(k,1461) = - lu(k,1354) * lu(k,1437) - lu(k,1462) = - lu(k,1355) * lu(k,1437) - lu(k,1938) = lu(k,1938) - lu(k,1350) * lu(k,1919) - lu(k,1940) = - lu(k,1351) * lu(k,1919) - lu(k,1942) = lu(k,1942) - lu(k,1352) * lu(k,1919) - lu(k,1943) = - lu(k,1353) * lu(k,1919) - lu(k,1944) = - lu(k,1354) * lu(k,1919) - lu(k,1945) = - lu(k,1355) * lu(k,1919) - lu(k,1972) = lu(k,1972) - lu(k,1350) * lu(k,1952) - lu(k,1974) = - lu(k,1351) * lu(k,1952) - lu(k,1976) = lu(k,1976) - lu(k,1352) * lu(k,1952) - lu(k,1977) = - lu(k,1353) * lu(k,1952) - lu(k,1978) = - lu(k,1354) * lu(k,1952) - lu(k,1979) = - lu(k,1355) * lu(k,1952) - lu(k,2000) = lu(k,2000) - lu(k,1350) * lu(k,1984) - lu(k,2002) = - lu(k,1351) * lu(k,1984) - lu(k,2004) = lu(k,2004) - lu(k,1352) * lu(k,1984) - lu(k,2005) = - lu(k,1353) * lu(k,1984) - lu(k,2006) = - lu(k,1354) * lu(k,1984) - lu(k,2007) = - lu(k,1355) * lu(k,1984) - lu(k,2404) = lu(k,2404) - lu(k,1350) * lu(k,2387) - lu(k,2406) = - lu(k,1351) * lu(k,2387) - lu(k,2408) = lu(k,2408) - lu(k,1352) * lu(k,2387) - lu(k,2409) = - lu(k,1353) * lu(k,2387) - lu(k,2410) = - lu(k,1354) * lu(k,2387) - lu(k,2411) = lu(k,2411) - lu(k,1355) * lu(k,2387) - lu(k,2431) = lu(k,2431) - lu(k,1350) * lu(k,2416) - lu(k,2433) = - lu(k,1351) * lu(k,2416) - lu(k,2435) = lu(k,2435) - lu(k,1352) * lu(k,2416) - lu(k,2436) = - lu(k,1353) * lu(k,2416) - lu(k,2437) = - lu(k,1354) * lu(k,2416) - lu(k,2438) = lu(k,2438) - lu(k,1355) * lu(k,2416) - lu(k,2990) = lu(k,2990) - lu(k,1350) * lu(k,2933) - lu(k,2994) = lu(k,2994) - lu(k,1351) * lu(k,2933) - lu(k,2996) = lu(k,2996) - lu(k,1352) * lu(k,2933) - lu(k,2997) = - lu(k,1353) * lu(k,2933) - lu(k,2999) = lu(k,2999) - lu(k,1354) * lu(k,2933) - lu(k,3000) = lu(k,3000) - lu(k,1355) * lu(k,2933) - lu(k,3082) = lu(k,3082) - lu(k,1350) * lu(k,3024) - lu(k,3086) = lu(k,3086) - lu(k,1351) * lu(k,3024) - lu(k,3088) = lu(k,3088) - lu(k,1352) * lu(k,3024) - lu(k,3089) = - lu(k,1353) * lu(k,3024) - lu(k,3091) = - lu(k,1354) * lu(k,3024) - lu(k,3092) = lu(k,3092) - lu(k,1355) * lu(k,3024) - lu(k,3285) = lu(k,3285) - lu(k,1350) * lu(k,3218) - lu(k,3289) = lu(k,3289) - lu(k,1351) * lu(k,3218) - lu(k,3291) = lu(k,3291) - lu(k,1352) * lu(k,3218) - lu(k,3292) = lu(k,3292) - lu(k,1353) * lu(k,3218) - lu(k,3294) = lu(k,3294) - lu(k,1354) * lu(k,3218) - lu(k,3295) = lu(k,3295) - lu(k,1355) * lu(k,3218) - lu(k,3456) = lu(k,3456) - lu(k,1350) * lu(k,3445) - lu(k,3460) = lu(k,3460) - lu(k,1351) * lu(k,3445) - lu(k,3462) = lu(k,3462) - lu(k,1352) * lu(k,3445) - lu(k,3463) = lu(k,3463) - lu(k,1353) * lu(k,3445) - lu(k,3465) = lu(k,3465) - lu(k,1354) * lu(k,3445) - lu(k,3466) = lu(k,3466) - lu(k,1355) * lu(k,3445) - lu(k,3746) = lu(k,3746) - lu(k,1350) * lu(k,3679) - lu(k,3750) = lu(k,3750) - lu(k,1351) * lu(k,3679) - lu(k,3752) = lu(k,3752) - lu(k,1352) * lu(k,3679) - lu(k,3753) = lu(k,3753) - lu(k,1353) * lu(k,3679) - lu(k,3755) = lu(k,3755) - lu(k,1354) * lu(k,3679) - lu(k,3756) = lu(k,3756) - lu(k,1355) * lu(k,3679) - lu(k,3827) = lu(k,3827) - lu(k,1350) * lu(k,3814) - lu(k,3831) = lu(k,3831) - lu(k,1351) * lu(k,3814) - lu(k,3833) = lu(k,3833) - lu(k,1352) * lu(k,3814) - lu(k,3834) = lu(k,3834) - lu(k,1353) * lu(k,3814) - lu(k,3836) = lu(k,3836) - lu(k,1354) * lu(k,3814) - lu(k,3837) = lu(k,3837) - lu(k,1355) * lu(k,3814) + lu(k,1348) = 1._r8 / lu(k,1348) + lu(k,1349) = lu(k,1349) * lu(k,1348) + lu(k,1350) = lu(k,1350) * lu(k,1348) + lu(k,1351) = lu(k,1351) * lu(k,1348) + lu(k,1352) = lu(k,1352) * lu(k,1348) + lu(k,1353) = lu(k,1353) * lu(k,1348) + lu(k,1354) = lu(k,1354) * lu(k,1348) + lu(k,1355) = lu(k,1355) * lu(k,1348) + lu(k,1356) = lu(k,1356) * lu(k,1348) + lu(k,3066) = lu(k,3066) - lu(k,1349) * lu(k,3062) + lu(k,3071) = - lu(k,1350) * lu(k,3062) + lu(k,3129) = lu(k,3129) - lu(k,1351) * lu(k,3062) + lu(k,3131) = lu(k,3131) - lu(k,1352) * lu(k,3062) + lu(k,3133) = lu(k,3133) - lu(k,1353) * lu(k,3062) + lu(k,3134) = lu(k,3134) - lu(k,1354) * lu(k,3062) + lu(k,3137) = lu(k,3137) - lu(k,1355) * lu(k,3062) + lu(k,3138) = lu(k,3138) - lu(k,1356) * lu(k,3062) + lu(k,3238) = lu(k,3238) - lu(k,1349) * lu(k,3235) + lu(k,3245) = lu(k,3245) - lu(k,1350) * lu(k,3235) + lu(k,3311) = lu(k,3311) - lu(k,1351) * lu(k,3235) + lu(k,3313) = lu(k,3313) - lu(k,1352) * lu(k,3235) + lu(k,3315) = lu(k,3315) - lu(k,1353) * lu(k,3235) + lu(k,3316) = lu(k,3316) - lu(k,1354) * lu(k,3235) + lu(k,3319) = lu(k,3319) - lu(k,1355) * lu(k,3235) + lu(k,3320) = lu(k,3320) - lu(k,1356) * lu(k,3235) + lu(k,3492) = lu(k,3492) - lu(k,1349) * lu(k,3489) + lu(k,3500) = lu(k,3500) - lu(k,1350) * lu(k,3489) + lu(k,3567) = lu(k,3567) - lu(k,1351) * lu(k,3489) + lu(k,3569) = lu(k,3569) - lu(k,1352) * lu(k,3489) + lu(k,3571) = lu(k,3571) - lu(k,1353) * lu(k,3489) + lu(k,3572) = lu(k,3572) - lu(k,1354) * lu(k,3489) + lu(k,3575) = lu(k,3575) - lu(k,1355) * lu(k,3489) + lu(k,3576) = lu(k,3576) - lu(k,1356) * lu(k,3489) + lu(k,3741) = lu(k,3741) - lu(k,1349) * lu(k,3736) + lu(k,3749) = lu(k,3749) - lu(k,1350) * lu(k,3736) + lu(k,3817) = lu(k,3817) - lu(k,1351) * lu(k,3736) + lu(k,3819) = lu(k,3819) - lu(k,1352) * lu(k,3736) + lu(k,3821) = lu(k,3821) - lu(k,1353) * lu(k,3736) + lu(k,3822) = lu(k,3822) - lu(k,1354) * lu(k,3736) + lu(k,3825) = lu(k,3825) - lu(k,1355) * lu(k,3736) + lu(k,3826) = lu(k,3826) - lu(k,1356) * lu(k,3736) + lu(k,3841) = - lu(k,1349) * lu(k,3839) + lu(k,3844) = - lu(k,1350) * lu(k,3839) + lu(k,3858) = lu(k,3858) - lu(k,1351) * lu(k,3839) + lu(k,3860) = lu(k,3860) - lu(k,1352) * lu(k,3839) + lu(k,3862) = lu(k,3862) - lu(k,1353) * lu(k,3839) + lu(k,3863) = lu(k,3863) - lu(k,1354) * lu(k,3839) + lu(k,3866) = lu(k,3866) - lu(k,1355) * lu(k,3839) + lu(k,3867) = lu(k,3867) - lu(k,1356) * lu(k,3839) + lu(k,3890) = lu(k,3890) - lu(k,1349) * lu(k,3886) + lu(k,3893) = - lu(k,1350) * lu(k,3886) + lu(k,3952) = lu(k,3952) - lu(k,1351) * lu(k,3886) + lu(k,3954) = lu(k,3954) - lu(k,1352) * lu(k,3886) + lu(k,3956) = lu(k,3956) - lu(k,1353) * lu(k,3886) + lu(k,3957) = lu(k,3957) - lu(k,1354) * lu(k,3886) + lu(k,3960) = lu(k,3960) - lu(k,1355) * lu(k,3886) + lu(k,3961) = lu(k,3961) - lu(k,1356) * lu(k,3886) + lu(k,3975) = lu(k,3975) - lu(k,1349) * lu(k,3974) + lu(k,3981) = lu(k,3981) - lu(k,1350) * lu(k,3974) + lu(k,4044) = lu(k,4044) - lu(k,1351) * lu(k,3974) + lu(k,4046) = lu(k,4046) - lu(k,1352) * lu(k,3974) + lu(k,4048) = lu(k,4048) - lu(k,1353) * lu(k,3974) + lu(k,4049) = lu(k,4049) - lu(k,1354) * lu(k,3974) + lu(k,4052) = lu(k,4052) - lu(k,1355) * lu(k,3974) + lu(k,4053) = lu(k,4053) - lu(k,1356) * lu(k,3974) + lu(k,1357) = 1._r8 / lu(k,1357) + lu(k,1358) = lu(k,1358) * lu(k,1357) + lu(k,1359) = lu(k,1359) * lu(k,1357) + lu(k,1360) = lu(k,1360) * lu(k,1357) + lu(k,1361) = lu(k,1361) * lu(k,1357) + lu(k,1368) = lu(k,1368) - lu(k,1358) * lu(k,1364) + lu(k,1375) = lu(k,1375) - lu(k,1359) * lu(k,1364) + lu(k,1376) = lu(k,1376) - lu(k,1360) * lu(k,1364) + lu(k,1380) = lu(k,1380) - lu(k,1361) * lu(k,1364) + lu(k,1392) = lu(k,1392) - lu(k,1358) * lu(k,1389) + lu(k,1406) = lu(k,1406) - lu(k,1359) * lu(k,1389) + lu(k,1407) = lu(k,1407) - lu(k,1360) * lu(k,1389) + lu(k,1410) = lu(k,1410) - lu(k,1361) * lu(k,1389) + lu(k,1843) = lu(k,1843) - lu(k,1358) * lu(k,1839) + lu(k,1859) = lu(k,1859) - lu(k,1359) * lu(k,1839) + lu(k,1860) = lu(k,1860) - lu(k,1360) * lu(k,1839) + lu(k,1863) = - lu(k,1361) * lu(k,1839) + lu(k,2016) = - lu(k,1358) * lu(k,2014) + lu(k,2030) = lu(k,2030) - lu(k,1359) * lu(k,2014) + lu(k,2031) = lu(k,2031) - lu(k,1360) * lu(k,2014) + lu(k,2035) = lu(k,2035) - lu(k,1361) * lu(k,2014) + lu(k,2041) = lu(k,2041) - lu(k,1358) * lu(k,2036) + lu(k,2055) = lu(k,2055) - lu(k,1359) * lu(k,2036) + lu(k,2056) = lu(k,2056) - lu(k,1360) * lu(k,2036) + lu(k,2060) = - lu(k,1361) * lu(k,2036) + lu(k,2165) = lu(k,2165) - lu(k,1358) * lu(k,2158) + lu(k,2190) = lu(k,2190) - lu(k,1359) * lu(k,2158) + lu(k,2191) = lu(k,2191) - lu(k,1360) * lu(k,2158) + lu(k,2196) = - lu(k,1361) * lu(k,2158) + lu(k,2345) = - lu(k,1358) * lu(k,2343) + lu(k,2359) = lu(k,2359) - lu(k,1359) * lu(k,2343) + lu(k,2360) = lu(k,2360) - lu(k,1360) * lu(k,2343) + lu(k,2364) = lu(k,2364) - lu(k,1361) * lu(k,2343) + lu(k,2659) = - lu(k,1358) * lu(k,2656) + lu(k,2675) = lu(k,2675) - lu(k,1359) * lu(k,2656) + lu(k,2676) = lu(k,2676) - lu(k,1360) * lu(k,2656) + lu(k,2680) = lu(k,2680) - lu(k,1361) * lu(k,2656) + lu(k,3074) = lu(k,3074) - lu(k,1358) * lu(k,3063) + lu(k,3133) = lu(k,3133) - lu(k,1359) * lu(k,3063) + lu(k,3134) = lu(k,3134) - lu(k,1360) * lu(k,3063) + lu(k,3139) = lu(k,3139) - lu(k,1361) * lu(k,3063) + lu(k,3252) = lu(k,3252) - lu(k,1358) * lu(k,3236) + lu(k,3315) = lu(k,3315) - lu(k,1359) * lu(k,3236) + lu(k,3316) = lu(k,3316) - lu(k,1360) * lu(k,3236) + lu(k,3321) = lu(k,3321) - lu(k,1361) * lu(k,3236) + lu(k,3345) = - lu(k,1358) * lu(k,3344) + lu(k,3360) = lu(k,3360) - lu(k,1359) * lu(k,3344) + lu(k,3361) = lu(k,3361) - lu(k,1360) * lu(k,3344) + lu(k,3366) = lu(k,3366) - lu(k,1361) * lu(k,3344) + lu(k,3507) = lu(k,3507) - lu(k,1358) * lu(k,3490) + lu(k,3571) = lu(k,3571) - lu(k,1359) * lu(k,3490) + lu(k,3572) = lu(k,3572) - lu(k,1360) * lu(k,3490) + lu(k,3577) = lu(k,3577) - lu(k,1361) * lu(k,3490) + lu(k,3758) = lu(k,3758) - lu(k,1358) * lu(k,3737) + lu(k,3821) = lu(k,3821) - lu(k,1359) * lu(k,3737) + lu(k,3822) = lu(k,3822) - lu(k,1360) * lu(k,3737) + lu(k,3827) = lu(k,3827) - lu(k,1361) * lu(k,3737) + lu(k,3845) = - lu(k,1358) * lu(k,3840) + lu(k,3862) = lu(k,3862) - lu(k,1359) * lu(k,3840) + lu(k,3863) = lu(k,3863) - lu(k,1360) * lu(k,3840) + lu(k,3868) = lu(k,3868) - lu(k,1361) * lu(k,3840) + lu(k,3897) = lu(k,3897) - lu(k,1358) * lu(k,3887) + lu(k,3956) = lu(k,3956) - lu(k,1359) * lu(k,3887) + lu(k,3957) = lu(k,3957) - lu(k,1360) * lu(k,3887) + lu(k,3962) = lu(k,3962) - lu(k,1361) * lu(k,3887) + lu(k,1365) = 1._r8 / lu(k,1365) + lu(k,1366) = lu(k,1366) * lu(k,1365) + lu(k,1367) = lu(k,1367) * lu(k,1365) + lu(k,1368) = lu(k,1368) * lu(k,1365) + lu(k,1369) = lu(k,1369) * lu(k,1365) + lu(k,1370) = lu(k,1370) * lu(k,1365) + lu(k,1371) = lu(k,1371) * lu(k,1365) + lu(k,1372) = lu(k,1372) * lu(k,1365) + lu(k,1373) = lu(k,1373) * lu(k,1365) + lu(k,1374) = lu(k,1374) * lu(k,1365) + lu(k,1375) = lu(k,1375) * lu(k,1365) + lu(k,1376) = lu(k,1376) * lu(k,1365) + lu(k,1377) = lu(k,1377) * lu(k,1365) + lu(k,1378) = lu(k,1378) * lu(k,1365) + lu(k,1379) = lu(k,1379) * lu(k,1365) + lu(k,1380) = lu(k,1380) * lu(k,1365) + lu(k,2038) = lu(k,2038) - lu(k,1366) * lu(k,2037) + lu(k,2039) = - lu(k,1367) * lu(k,2037) + lu(k,2041) = lu(k,2041) - lu(k,1368) * lu(k,2037) + lu(k,2043) = - lu(k,1369) * lu(k,2037) + lu(k,2045) = lu(k,2045) - lu(k,1370) * lu(k,2037) + lu(k,2048) = - lu(k,1371) * lu(k,2037) + lu(k,2050) = lu(k,2050) - lu(k,1372) * lu(k,2037) + lu(k,2051) = - lu(k,1373) * lu(k,2037) + lu(k,2053) = lu(k,2053) - lu(k,1374) * lu(k,2037) + lu(k,2055) = lu(k,2055) - lu(k,1375) * lu(k,2037) + lu(k,2056) = lu(k,2056) - lu(k,1376) * lu(k,2037) + lu(k,2057) = - lu(k,1377) * lu(k,2037) + lu(k,2058) = lu(k,2058) - lu(k,1378) * lu(k,2037) + lu(k,2059) = - lu(k,1379) * lu(k,2037) + lu(k,2060) = lu(k,2060) - lu(k,1380) * lu(k,2037) + lu(k,3066) = lu(k,3066) - lu(k,1366) * lu(k,3064) + lu(k,3069) = lu(k,3069) - lu(k,1367) * lu(k,3064) + lu(k,3074) = lu(k,3074) - lu(k,1368) * lu(k,3064) + lu(k,3081) = lu(k,3081) - lu(k,1369) * lu(k,3064) + lu(k,3089) = lu(k,3089) - lu(k,1370) * lu(k,3064) + lu(k,3101) = lu(k,3101) - lu(k,1371) * lu(k,3064) + lu(k,3127) = lu(k,3127) - lu(k,1372) * lu(k,3064) + lu(k,3129) = lu(k,3129) - lu(k,1373) * lu(k,3064) + lu(k,3131) = lu(k,3131) - lu(k,1374) * lu(k,3064) + lu(k,3133) = lu(k,3133) - lu(k,1375) * lu(k,3064) + lu(k,3134) = lu(k,3134) - lu(k,1376) * lu(k,3064) + lu(k,3136) = lu(k,3136) - lu(k,1377) * lu(k,3064) + lu(k,3137) = lu(k,3137) - lu(k,1378) * lu(k,3064) + lu(k,3138) = lu(k,3138) - lu(k,1379) * lu(k,3064) + lu(k,3139) = lu(k,3139) - lu(k,1380) * lu(k,3064) + lu(k,3741) = lu(k,3741) - lu(k,1366) * lu(k,3738) + lu(k,3747) = lu(k,3747) - lu(k,1367) * lu(k,3738) + lu(k,3758) = lu(k,3758) - lu(k,1368) * lu(k,3738) + lu(k,3769) = lu(k,3769) - lu(k,1369) * lu(k,3738) + lu(k,3777) = lu(k,3777) - lu(k,1370) * lu(k,3738) + lu(k,3789) = lu(k,3789) - lu(k,1371) * lu(k,3738) + lu(k,3815) = lu(k,3815) - lu(k,1372) * lu(k,3738) + lu(k,3817) = lu(k,3817) - lu(k,1373) * lu(k,3738) + lu(k,3819) = lu(k,3819) - lu(k,1374) * lu(k,3738) + lu(k,3821) = lu(k,3821) - lu(k,1375) * lu(k,3738) + lu(k,3822) = lu(k,3822) - lu(k,1376) * lu(k,3738) + lu(k,3824) = lu(k,3824) - lu(k,1377) * lu(k,3738) + lu(k,3825) = lu(k,3825) - lu(k,1378) * lu(k,3738) + lu(k,3826) = lu(k,3826) - lu(k,1379) * lu(k,3738) + lu(k,3827) = lu(k,3827) - lu(k,1380) * lu(k,3738) + lu(k,3890) = lu(k,3890) - lu(k,1366) * lu(k,3888) + lu(k,3891) = lu(k,3891) - lu(k,1367) * lu(k,3888) + lu(k,3897) = lu(k,3897) - lu(k,1368) * lu(k,3888) + lu(k,3904) = lu(k,3904) - lu(k,1369) * lu(k,3888) + lu(k,3911) = lu(k,3911) - lu(k,1370) * lu(k,3888) + lu(k,3924) = - lu(k,1371) * lu(k,3888) + lu(k,3950) = lu(k,3950) - lu(k,1372) * lu(k,3888) + lu(k,3952) = lu(k,3952) - lu(k,1373) * lu(k,3888) + lu(k,3954) = lu(k,3954) - lu(k,1374) * lu(k,3888) + lu(k,3956) = lu(k,3956) - lu(k,1375) * lu(k,3888) + lu(k,3957) = lu(k,3957) - lu(k,1376) * lu(k,3888) + lu(k,3959) = lu(k,3959) - lu(k,1377) * lu(k,3888) + lu(k,3960) = lu(k,3960) - lu(k,1378) * lu(k,3888) + lu(k,3961) = lu(k,3961) - lu(k,1379) * lu(k,3888) + lu(k,3962) = lu(k,3962) - lu(k,1380) * lu(k,3888) + lu(k,1390) = 1._r8 / lu(k,1390) + lu(k,1391) = lu(k,1391) * lu(k,1390) + lu(k,1392) = lu(k,1392) * lu(k,1390) + lu(k,1393) = lu(k,1393) * lu(k,1390) + lu(k,1394) = lu(k,1394) * lu(k,1390) + lu(k,1395) = lu(k,1395) * lu(k,1390) + lu(k,1396) = lu(k,1396) * lu(k,1390) + lu(k,1397) = lu(k,1397) * lu(k,1390) + lu(k,1398) = lu(k,1398) * lu(k,1390) + lu(k,1399) = lu(k,1399) * lu(k,1390) + lu(k,1400) = lu(k,1400) * lu(k,1390) + lu(k,1401) = lu(k,1401) * lu(k,1390) + lu(k,1402) = lu(k,1402) * lu(k,1390) + lu(k,1403) = lu(k,1403) * lu(k,1390) + lu(k,1404) = lu(k,1404) * lu(k,1390) + lu(k,1405) = lu(k,1405) * lu(k,1390) + lu(k,1406) = lu(k,1406) * lu(k,1390) + lu(k,1407) = lu(k,1407) * lu(k,1390) + lu(k,1408) = lu(k,1408) * lu(k,1390) + lu(k,1409) = lu(k,1409) * lu(k,1390) + lu(k,1410) = lu(k,1410) * lu(k,1390) + lu(k,3070) = lu(k,3070) - lu(k,1391) * lu(k,3065) + lu(k,3074) = lu(k,3074) - lu(k,1392) * lu(k,3065) + lu(k,3080) = - lu(k,1393) * lu(k,3065) + lu(k,3082) = - lu(k,1394) * lu(k,3065) + lu(k,3084) = - lu(k,1395) * lu(k,3065) + lu(k,3085) = - lu(k,1396) * lu(k,3065) + lu(k,3089) = lu(k,3089) - lu(k,1397) * lu(k,3065) + lu(k,3091) = - lu(k,1398) * lu(k,3065) + lu(k,3092) = - lu(k,1399) * lu(k,3065) + lu(k,3093) = lu(k,3093) - lu(k,1400) * lu(k,3065) + lu(k,3094) = lu(k,3094) - lu(k,1401) * lu(k,3065) + lu(k,3098) = - lu(k,1402) * lu(k,3065) + lu(k,3126) = lu(k,3126) - lu(k,1403) * lu(k,3065) + lu(k,3127) = lu(k,3127) - lu(k,1404) * lu(k,3065) + lu(k,3131) = lu(k,3131) - lu(k,1405) * lu(k,3065) + lu(k,3133) = lu(k,3133) - lu(k,1406) * lu(k,3065) + lu(k,3134) = lu(k,3134) - lu(k,1407) * lu(k,3065) + lu(k,3136) = lu(k,3136) - lu(k,1408) * lu(k,3065) + lu(k,3137) = lu(k,3137) - lu(k,1409) * lu(k,3065) + lu(k,3139) = lu(k,3139) - lu(k,1410) * lu(k,3065) + lu(k,3748) = lu(k,3748) - lu(k,1391) * lu(k,3739) + lu(k,3758) = lu(k,3758) - lu(k,1392) * lu(k,3739) + lu(k,3768) = lu(k,3768) - lu(k,1393) * lu(k,3739) + lu(k,3770) = lu(k,3770) - lu(k,1394) * lu(k,3739) + lu(k,3772) = lu(k,3772) - lu(k,1395) * lu(k,3739) + lu(k,3773) = lu(k,3773) - lu(k,1396) * lu(k,3739) + lu(k,3777) = lu(k,3777) - lu(k,1397) * lu(k,3739) + lu(k,3779) = lu(k,3779) - lu(k,1398) * lu(k,3739) + lu(k,3780) = lu(k,3780) - lu(k,1399) * lu(k,3739) + lu(k,3781) = lu(k,3781) - lu(k,1400) * lu(k,3739) + lu(k,3782) = lu(k,3782) - lu(k,1401) * lu(k,3739) + lu(k,3786) = lu(k,3786) - lu(k,1402) * lu(k,3739) + lu(k,3814) = lu(k,3814) - lu(k,1403) * lu(k,3739) + lu(k,3815) = lu(k,3815) - lu(k,1404) * lu(k,3739) + lu(k,3819) = lu(k,3819) - lu(k,1405) * lu(k,3739) + lu(k,3821) = lu(k,3821) - lu(k,1406) * lu(k,3739) + lu(k,3822) = lu(k,3822) - lu(k,1407) * lu(k,3739) + lu(k,3824) = lu(k,3824) - lu(k,1408) * lu(k,3739) + lu(k,3825) = lu(k,3825) - lu(k,1409) * lu(k,3739) + lu(k,3827) = lu(k,3827) - lu(k,1410) * lu(k,3739) + lu(k,3892) = lu(k,3892) - lu(k,1391) * lu(k,3889) + lu(k,3897) = lu(k,3897) - lu(k,1392) * lu(k,3889) + lu(k,3903) = - lu(k,1393) * lu(k,3889) + lu(k,3905) = - lu(k,1394) * lu(k,3889) + lu(k,3906) = - lu(k,1395) * lu(k,3889) + lu(k,3907) = - lu(k,1396) * lu(k,3889) + lu(k,3911) = lu(k,3911) - lu(k,1397) * lu(k,3889) + lu(k,3913) = - lu(k,1398) * lu(k,3889) + lu(k,3914) = - lu(k,1399) * lu(k,3889) + lu(k,3915) = lu(k,3915) - lu(k,1400) * lu(k,3889) + lu(k,3916) = lu(k,3916) - lu(k,1401) * lu(k,3889) + lu(k,3920) = lu(k,3920) - lu(k,1402) * lu(k,3889) + lu(k,3949) = lu(k,3949) - lu(k,1403) * lu(k,3889) + lu(k,3950) = lu(k,3950) - lu(k,1404) * lu(k,3889) + lu(k,3954) = lu(k,3954) - lu(k,1405) * lu(k,3889) + lu(k,3956) = lu(k,3956) - lu(k,1406) * lu(k,3889) + lu(k,3957) = lu(k,3957) - lu(k,1407) * lu(k,3889) + lu(k,3959) = lu(k,3959) - lu(k,1408) * lu(k,3889) + lu(k,3960) = lu(k,3960) - lu(k,1409) * lu(k,3889) + lu(k,3962) = lu(k,3962) - lu(k,1410) * lu(k,3889) end do end subroutine lu_fac30 subroutine lu_fac31( avec_len, lu ) @@ -5734,356 +5461,307 @@ subroutine lu_fac31( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1356) = 1._r8 / lu(k,1356) - lu(k,1357) = lu(k,1357) * lu(k,1356) - lu(k,1358) = lu(k,1358) * lu(k,1356) - lu(k,1359) = lu(k,1359) * lu(k,1356) - lu(k,1377) = lu(k,1377) - lu(k,1357) * lu(k,1368) - lu(k,1378) = lu(k,1378) - lu(k,1358) * lu(k,1368) - lu(k,1381) = lu(k,1381) - lu(k,1359) * lu(k,1368) - lu(k,1560) = lu(k,1560) - lu(k,1357) * lu(k,1546) - lu(k,1561) = lu(k,1561) - lu(k,1358) * lu(k,1546) - lu(k,1564) = lu(k,1564) - lu(k,1359) * lu(k,1546) - lu(k,1581) = lu(k,1581) - lu(k,1357) * lu(k,1568) - lu(k,1582) = lu(k,1582) - lu(k,1358) * lu(k,1568) - lu(k,1585) = lu(k,1585) - lu(k,1359) * lu(k,1568) - lu(k,1678) = lu(k,1678) - lu(k,1357) * lu(k,1661) - lu(k,1679) = lu(k,1679) - lu(k,1358) * lu(k,1661) - lu(k,1682) = lu(k,1682) - lu(k,1359) * lu(k,1661) - lu(k,1740) = lu(k,1740) - lu(k,1357) * lu(k,1718) - lu(k,1741) = lu(k,1741) - lu(k,1358) * lu(k,1718) - lu(k,1744) = lu(k,1744) - lu(k,1359) * lu(k,1718) - lu(k,1790) = lu(k,1790) - lu(k,1357) * lu(k,1773) - lu(k,1791) = lu(k,1791) - lu(k,1358) * lu(k,1773) - lu(k,1794) = lu(k,1794) - lu(k,1359) * lu(k,1773) - lu(k,2042) = lu(k,2042) - lu(k,1357) * lu(k,2018) - lu(k,2043) = lu(k,2043) - lu(k,1358) * lu(k,2018) - lu(k,2047) = lu(k,2047) - lu(k,1359) * lu(k,2018) - lu(k,2064) = lu(k,2064) - lu(k,1357) * lu(k,2052) - lu(k,2065) = lu(k,2065) - lu(k,1358) * lu(k,2052) - lu(k,2068) = lu(k,2068) - lu(k,1359) * lu(k,2052) - lu(k,2109) = lu(k,2109) - lu(k,1357) * lu(k,2094) - lu(k,2110) = lu(k,2110) - lu(k,1358) * lu(k,2094) - lu(k,2113) = lu(k,2113) - lu(k,1359) * lu(k,2094) - lu(k,2131) = lu(k,2131) - lu(k,1357) * lu(k,2116) - lu(k,2132) = lu(k,2132) - lu(k,1358) * lu(k,2116) - lu(k,2135) = lu(k,2135) - lu(k,1359) * lu(k,2116) - lu(k,2147) = lu(k,2147) - lu(k,1357) * lu(k,2138) - lu(k,2148) = lu(k,2148) - lu(k,1358) * lu(k,2138) - lu(k,2151) = lu(k,2151) - lu(k,1359) * lu(k,2138) - lu(k,2170) = lu(k,2170) - lu(k,1357) * lu(k,2153) - lu(k,2171) = lu(k,2171) - lu(k,1358) * lu(k,2153) - lu(k,2174) = lu(k,2174) - lu(k,1359) * lu(k,2153) - lu(k,2227) = lu(k,2227) - lu(k,1357) * lu(k,2205) - lu(k,2228) = lu(k,2228) - lu(k,1358) * lu(k,2205) - lu(k,2231) = lu(k,2231) - lu(k,1359) * lu(k,2205) - lu(k,2285) = lu(k,2285) - lu(k,1357) * lu(k,2264) - lu(k,2286) = lu(k,2286) - lu(k,1358) * lu(k,2264) - lu(k,2289) = lu(k,2289) - lu(k,1359) * lu(k,2264) - lu(k,2317) = lu(k,2317) - lu(k,1357) * lu(k,2297) - lu(k,2318) = lu(k,2318) - lu(k,1358) * lu(k,2297) - lu(k,2321) = lu(k,2321) - lu(k,1359) * lu(k,2297) - lu(k,2344) = lu(k,2344) - lu(k,1357) * lu(k,2327) - lu(k,2345) = lu(k,2345) - lu(k,1358) * lu(k,2327) - lu(k,2348) = lu(k,2348) - lu(k,1359) * lu(k,2327) - lu(k,2378) = lu(k,2378) - lu(k,1357) * lu(k,2356) - lu(k,2379) = lu(k,2379) - lu(k,1358) * lu(k,2356) - lu(k,2382) = lu(k,2382) - lu(k,1359) * lu(k,2356) - lu(k,2456) = lu(k,2456) - lu(k,1357) * lu(k,2441) - lu(k,2457) = lu(k,2457) - lu(k,1358) * lu(k,2441) - lu(k,2460) = lu(k,2460) - lu(k,1359) * lu(k,2441) - lu(k,2889) = lu(k,2889) - lu(k,1357) * lu(k,2825) - lu(k,2891) = lu(k,2891) - lu(k,1358) * lu(k,2825) - lu(k,2895) = lu(k,2895) - lu(k,1359) * lu(k,2825) - lu(k,2990) = lu(k,2990) - lu(k,1357) * lu(k,2934) - lu(k,2992) = lu(k,2992) - lu(k,1358) * lu(k,2934) - lu(k,2996) = lu(k,2996) - lu(k,1359) * lu(k,2934) - lu(k,3082) = lu(k,3082) - lu(k,1357) * lu(k,3025) - lu(k,3084) = lu(k,3084) - lu(k,1358) * lu(k,3025) - lu(k,3088) = lu(k,3088) - lu(k,1359) * lu(k,3025) - lu(k,3285) = lu(k,3285) - lu(k,1357) * lu(k,3219) - lu(k,3287) = lu(k,3287) - lu(k,1358) * lu(k,3219) - lu(k,3291) = lu(k,3291) - lu(k,1359) * lu(k,3219) - lu(k,3426) = lu(k,3426) - lu(k,1357) * lu(k,3364) - lu(k,3428) = lu(k,3428) - lu(k,1358) * lu(k,3364) - lu(k,3432) = lu(k,3432) - lu(k,1359) * lu(k,3364) - lu(k,3746) = lu(k,3746) - lu(k,1357) * lu(k,3680) - lu(k,3748) = lu(k,3748) - lu(k,1358) * lu(k,3680) - lu(k,3752) = lu(k,3752) - lu(k,1359) * lu(k,3680) - lu(k,3827) = lu(k,3827) - lu(k,1357) * lu(k,3815) - lu(k,3829) = lu(k,3829) - lu(k,1358) * lu(k,3815) - lu(k,3833) = lu(k,3833) - lu(k,1359) * lu(k,3815) - lu(k,1360) = 1._r8 / lu(k,1360) - lu(k,1361) = lu(k,1361) * lu(k,1360) - lu(k,1362) = lu(k,1362) * lu(k,1360) - lu(k,1363) = lu(k,1363) * lu(k,1360) - lu(k,1364) = lu(k,1364) * lu(k,1360) - lu(k,1365) = lu(k,1365) * lu(k,1360) - lu(k,1366) = lu(k,1366) * lu(k,1360) - lu(k,1367) = lu(k,1367) * lu(k,1360) - lu(k,1371) = lu(k,1371) - lu(k,1361) * lu(k,1369) - lu(k,1372) = lu(k,1372) - lu(k,1362) * lu(k,1369) - lu(k,1374) = lu(k,1374) - lu(k,1363) * lu(k,1369) - lu(k,1375) = lu(k,1375) - lu(k,1364) * lu(k,1369) - lu(k,1377) = lu(k,1377) - lu(k,1365) * lu(k,1369) - lu(k,1378) = lu(k,1378) - lu(k,1366) * lu(k,1369) - lu(k,1381) = lu(k,1381) - lu(k,1367) * lu(k,1369) - lu(k,1548) = lu(k,1548) - lu(k,1361) * lu(k,1547) - lu(k,1549) = lu(k,1549) - lu(k,1362) * lu(k,1547) - lu(k,1554) = - lu(k,1363) * lu(k,1547) - lu(k,1557) = lu(k,1557) - lu(k,1364) * lu(k,1547) - lu(k,1560) = lu(k,1560) - lu(k,1365) * lu(k,1547) - lu(k,1561) = lu(k,1561) - lu(k,1366) * lu(k,1547) - lu(k,1564) = lu(k,1564) - lu(k,1367) * lu(k,1547) - lu(k,1631) = lu(k,1631) - lu(k,1361) * lu(k,1630) - lu(k,1632) = lu(k,1632) - lu(k,1362) * lu(k,1630) - lu(k,1637) = lu(k,1637) - lu(k,1363) * lu(k,1630) - lu(k,1638) = - lu(k,1364) * lu(k,1630) - lu(k,1640) = lu(k,1640) - lu(k,1365) * lu(k,1630) - lu(k,1641) = lu(k,1641) - lu(k,1366) * lu(k,1630) - lu(k,1643) = lu(k,1643) - lu(k,1367) * lu(k,1630) - lu(k,1776) = lu(k,1776) - lu(k,1361) * lu(k,1774) - lu(k,1777) = lu(k,1777) - lu(k,1362) * lu(k,1774) - lu(k,1783) = lu(k,1783) - lu(k,1363) * lu(k,1774) - lu(k,1787) = lu(k,1787) - lu(k,1364) * lu(k,1774) - lu(k,1790) = lu(k,1790) - lu(k,1365) * lu(k,1774) - lu(k,1791) = lu(k,1791) - lu(k,1366) * lu(k,1774) - lu(k,1794) = lu(k,1794) - lu(k,1367) * lu(k,1774) - lu(k,1885) = lu(k,1885) - lu(k,1361) * lu(k,1883) - lu(k,1886) = lu(k,1886) - lu(k,1362) * lu(k,1883) - lu(k,1894) = lu(k,1894) - lu(k,1363) * lu(k,1883) - lu(k,1900) = - lu(k,1364) * lu(k,1883) - lu(k,1906) = lu(k,1906) - lu(k,1365) * lu(k,1883) - lu(k,1907) = lu(k,1907) - lu(k,1366) * lu(k,1883) - lu(k,1910) = lu(k,1910) - lu(k,1367) * lu(k,1883) - lu(k,1955) = lu(k,1955) - lu(k,1361) * lu(k,1953) - lu(k,1957) = lu(k,1957) - lu(k,1362) * lu(k,1953) - lu(k,1963) = lu(k,1963) - lu(k,1363) * lu(k,1953) - lu(k,1966) = - lu(k,1364) * lu(k,1953) - lu(k,1972) = lu(k,1972) - lu(k,1365) * lu(k,1953) - lu(k,1973) = lu(k,1973) - lu(k,1366) * lu(k,1953) - lu(k,1976) = lu(k,1976) - lu(k,1367) * lu(k,1953) - lu(k,2653) = lu(k,2653) - lu(k,1361) * lu(k,2648) - lu(k,2655) = lu(k,2655) - lu(k,1362) * lu(k,2648) - lu(k,2670) = lu(k,2670) - lu(k,1363) * lu(k,2648) - lu(k,2699) = lu(k,2699) - lu(k,1364) * lu(k,2648) - lu(k,2705) = lu(k,2705) - lu(k,1365) * lu(k,2648) - lu(k,2706) = lu(k,2706) - lu(k,1366) * lu(k,2648) - lu(k,2710) = lu(k,2710) - lu(k,1367) * lu(k,2648) - lu(k,2832) = lu(k,2832) - lu(k,1361) * lu(k,2826) - lu(k,2836) = lu(k,2836) - lu(k,1362) * lu(k,2826) - lu(k,2853) = lu(k,2853) - lu(k,1363) * lu(k,2826) - lu(k,2882) = lu(k,2882) - lu(k,1364) * lu(k,2826) - lu(k,2889) = lu(k,2889) - lu(k,1365) * lu(k,2826) - lu(k,2891) = lu(k,2891) - lu(k,1366) * lu(k,2826) - lu(k,2895) = lu(k,2895) - lu(k,1367) * lu(k,2826) - lu(k,3228) = lu(k,3228) - lu(k,1361) * lu(k,3220) - lu(k,3232) = lu(k,3232) - lu(k,1362) * lu(k,3220) - lu(k,3249) = lu(k,3249) - lu(k,1363) * lu(k,3220) - lu(k,3278) = lu(k,3278) - lu(k,1364) * lu(k,3220) - lu(k,3285) = lu(k,3285) - lu(k,1365) * lu(k,3220) - lu(k,3287) = lu(k,3287) - lu(k,1366) * lu(k,3220) - lu(k,3291) = lu(k,3291) - lu(k,1367) * lu(k,3220) - lu(k,3370) = lu(k,3370) - lu(k,1361) * lu(k,3365) - lu(k,3374) = lu(k,3374) - lu(k,1362) * lu(k,3365) - lu(k,3390) = lu(k,3390) - lu(k,1363) * lu(k,3365) - lu(k,3419) = lu(k,3419) - lu(k,1364) * lu(k,3365) - lu(k,3426) = lu(k,3426) - lu(k,1365) * lu(k,3365) - lu(k,3428) = lu(k,3428) - lu(k,1366) * lu(k,3365) - lu(k,3432) = lu(k,3432) - lu(k,1367) * lu(k,3365) - lu(k,3689) = lu(k,3689) - lu(k,1361) * lu(k,3681) - lu(k,3694) = lu(k,3694) - lu(k,1362) * lu(k,3681) - lu(k,3711) = lu(k,3711) - lu(k,1363) * lu(k,3681) - lu(k,3739) = lu(k,3739) - lu(k,1364) * lu(k,3681) - lu(k,3746) = lu(k,3746) - lu(k,1365) * lu(k,3681) - lu(k,3748) = lu(k,3748) - lu(k,1366) * lu(k,3681) - lu(k,3752) = lu(k,3752) - lu(k,1367) * lu(k,3681) - lu(k,1370) = 1._r8 / lu(k,1370) - lu(k,1371) = lu(k,1371) * lu(k,1370) - lu(k,1372) = lu(k,1372) * lu(k,1370) - lu(k,1373) = lu(k,1373) * lu(k,1370) - lu(k,1374) = lu(k,1374) * lu(k,1370) - lu(k,1375) = lu(k,1375) * lu(k,1370) - lu(k,1376) = lu(k,1376) * lu(k,1370) - lu(k,1377) = lu(k,1377) * lu(k,1370) - lu(k,1378) = lu(k,1378) * lu(k,1370) - lu(k,1379) = lu(k,1379) * lu(k,1370) - lu(k,1380) = lu(k,1380) * lu(k,1370) - lu(k,1381) = lu(k,1381) * lu(k,1370) - lu(k,1776) = lu(k,1776) - lu(k,1371) * lu(k,1775) - lu(k,1777) = lu(k,1777) - lu(k,1372) * lu(k,1775) - lu(k,1781) = - lu(k,1373) * lu(k,1775) - lu(k,1783) = lu(k,1783) - lu(k,1374) * lu(k,1775) - lu(k,1787) = lu(k,1787) - lu(k,1375) * lu(k,1775) - lu(k,1789) = lu(k,1789) - lu(k,1376) * lu(k,1775) - lu(k,1790) = lu(k,1790) - lu(k,1377) * lu(k,1775) - lu(k,1791) = lu(k,1791) - lu(k,1378) * lu(k,1775) - lu(k,1792) = lu(k,1792) - lu(k,1379) * lu(k,1775) - lu(k,1793) = lu(k,1793) - lu(k,1380) * lu(k,1775) - lu(k,1794) = lu(k,1794) - lu(k,1381) * lu(k,1775) - lu(k,1858) = - lu(k,1371) * lu(k,1857) - lu(k,1859) = lu(k,1859) - lu(k,1372) * lu(k,1857) - lu(k,1861) = - lu(k,1373) * lu(k,1857) - lu(k,1862) = lu(k,1862) - lu(k,1374) * lu(k,1857) - lu(k,1864) = lu(k,1864) - lu(k,1375) * lu(k,1857) - lu(k,1867) = lu(k,1867) - lu(k,1376) * lu(k,1857) - lu(k,1870) = lu(k,1870) - lu(k,1377) * lu(k,1857) - lu(k,1871) = lu(k,1871) - lu(k,1378) * lu(k,1857) - lu(k,1872) = lu(k,1872) - lu(k,1379) * lu(k,1857) - lu(k,1873) = lu(k,1873) - lu(k,1380) * lu(k,1857) - lu(k,1874) = lu(k,1874) - lu(k,1381) * lu(k,1857) - lu(k,2653) = lu(k,2653) - lu(k,1371) * lu(k,2649) - lu(k,2655) = lu(k,2655) - lu(k,1372) * lu(k,2649) - lu(k,2668) = - lu(k,1373) * lu(k,2649) - lu(k,2670) = lu(k,2670) - lu(k,1374) * lu(k,2649) - lu(k,2699) = lu(k,2699) - lu(k,1375) * lu(k,2649) - lu(k,2702) = lu(k,2702) - lu(k,1376) * lu(k,2649) - lu(k,2705) = lu(k,2705) - lu(k,1377) * lu(k,2649) - lu(k,2706) = lu(k,2706) - lu(k,1378) * lu(k,2649) - lu(k,2707) = lu(k,2707) - lu(k,1379) * lu(k,2649) - lu(k,2709) = lu(k,2709) - lu(k,1380) * lu(k,2649) - lu(k,2710) = lu(k,2710) - lu(k,1381) * lu(k,2649) - lu(k,2832) = lu(k,2832) - lu(k,1371) * lu(k,2827) - lu(k,2836) = lu(k,2836) - lu(k,1372) * lu(k,2827) - lu(k,2851) = lu(k,2851) - lu(k,1373) * lu(k,2827) - lu(k,2853) = lu(k,2853) - lu(k,1374) * lu(k,2827) - lu(k,2882) = lu(k,2882) - lu(k,1375) * lu(k,2827) - lu(k,2885) = lu(k,2885) - lu(k,1376) * lu(k,2827) - lu(k,2889) = lu(k,2889) - lu(k,1377) * lu(k,2827) - lu(k,2891) = lu(k,2891) - lu(k,1378) * lu(k,2827) - lu(k,2892) = lu(k,2892) - lu(k,1379) * lu(k,2827) - lu(k,2894) = lu(k,2894) - lu(k,1380) * lu(k,2827) - lu(k,2895) = lu(k,2895) - lu(k,1381) * lu(k,2827) - lu(k,3228) = lu(k,3228) - lu(k,1371) * lu(k,3221) - lu(k,3232) = lu(k,3232) - lu(k,1372) * lu(k,3221) - lu(k,3247) = lu(k,3247) - lu(k,1373) * lu(k,3221) - lu(k,3249) = lu(k,3249) - lu(k,1374) * lu(k,3221) - lu(k,3278) = lu(k,3278) - lu(k,1375) * lu(k,3221) - lu(k,3281) = lu(k,3281) - lu(k,1376) * lu(k,3221) - lu(k,3285) = lu(k,3285) - lu(k,1377) * lu(k,3221) - lu(k,3287) = lu(k,3287) - lu(k,1378) * lu(k,3221) - lu(k,3288) = lu(k,3288) - lu(k,1379) * lu(k,3221) - lu(k,3290) = lu(k,3290) - lu(k,1380) * lu(k,3221) - lu(k,3291) = lu(k,3291) - lu(k,1381) * lu(k,3221) - lu(k,3370) = lu(k,3370) - lu(k,1371) * lu(k,3366) - lu(k,3374) = lu(k,3374) - lu(k,1372) * lu(k,3366) - lu(k,3388) = lu(k,3388) - lu(k,1373) * lu(k,3366) - lu(k,3390) = lu(k,3390) - lu(k,1374) * lu(k,3366) - lu(k,3419) = lu(k,3419) - lu(k,1375) * lu(k,3366) - lu(k,3422) = lu(k,3422) - lu(k,1376) * lu(k,3366) - lu(k,3426) = lu(k,3426) - lu(k,1377) * lu(k,3366) - lu(k,3428) = lu(k,3428) - lu(k,1378) * lu(k,3366) - lu(k,3429) = lu(k,3429) - lu(k,1379) * lu(k,3366) - lu(k,3431) = lu(k,3431) - lu(k,1380) * lu(k,3366) - lu(k,3432) = lu(k,3432) - lu(k,1381) * lu(k,3366) - lu(k,3689) = lu(k,3689) - lu(k,1371) * lu(k,3682) - lu(k,3694) = lu(k,3694) - lu(k,1372) * lu(k,3682) - lu(k,3709) = lu(k,3709) - lu(k,1373) * lu(k,3682) - lu(k,3711) = lu(k,3711) - lu(k,1374) * lu(k,3682) - lu(k,3739) = lu(k,3739) - lu(k,1375) * lu(k,3682) - lu(k,3742) = lu(k,3742) - lu(k,1376) * lu(k,3682) - lu(k,3746) = lu(k,3746) - lu(k,1377) * lu(k,3682) - lu(k,3748) = lu(k,3748) - lu(k,1378) * lu(k,3682) - lu(k,3749) = lu(k,3749) - lu(k,1379) * lu(k,3682) - lu(k,3751) = lu(k,3751) - lu(k,1380) * lu(k,3682) - lu(k,3752) = lu(k,3752) - lu(k,1381) * lu(k,3682) - lu(k,1383) = 1._r8 / lu(k,1383) - lu(k,1384) = lu(k,1384) * lu(k,1383) - lu(k,1385) = lu(k,1385) * lu(k,1383) - lu(k,1386) = lu(k,1386) * lu(k,1383) - lu(k,1387) = lu(k,1387) * lu(k,1383) - lu(k,1388) = lu(k,1388) * lu(k,1383) - lu(k,1389) = lu(k,1389) * lu(k,1383) - lu(k,1390) = lu(k,1390) * lu(k,1383) - lu(k,1391) = lu(k,1391) * lu(k,1383) - lu(k,1392) = lu(k,1392) * lu(k,1383) - lu(k,1393) = lu(k,1393) * lu(k,1383) - lu(k,1394) = lu(k,1394) * lu(k,1383) - lu(k,1395) = lu(k,1395) * lu(k,1383) - lu(k,1664) = lu(k,1664) - lu(k,1384) * lu(k,1662) - lu(k,1665) = lu(k,1665) - lu(k,1385) * lu(k,1662) - lu(k,1666) = - lu(k,1386) * lu(k,1662) - lu(k,1671) = lu(k,1671) - lu(k,1387) * lu(k,1662) - lu(k,1674) = - lu(k,1388) * lu(k,1662) - lu(k,1675) = lu(k,1675) - lu(k,1389) * lu(k,1662) - lu(k,1677) = lu(k,1677) - lu(k,1390) * lu(k,1662) - lu(k,1678) = lu(k,1678) - lu(k,1391) * lu(k,1662) - lu(k,1679) = lu(k,1679) - lu(k,1392) * lu(k,1662) - lu(k,1680) = lu(k,1680) - lu(k,1393) * lu(k,1662) - lu(k,1681) = lu(k,1681) - lu(k,1394) * lu(k,1662) - lu(k,1682) = lu(k,1682) - lu(k,1395) * lu(k,1662) - lu(k,1748) = lu(k,1748) - lu(k,1384) * lu(k,1746) - lu(k,1749) = - lu(k,1385) * lu(k,1746) - lu(k,1750) = - lu(k,1386) * lu(k,1746) - lu(k,1752) = lu(k,1752) - lu(k,1387) * lu(k,1746) - lu(k,1753) = - lu(k,1388) * lu(k,1746) - lu(k,1754) = lu(k,1754) - lu(k,1389) * lu(k,1746) - lu(k,1756) = - lu(k,1390) * lu(k,1746) - lu(k,1759) = lu(k,1759) - lu(k,1391) * lu(k,1746) - lu(k,1760) = lu(k,1760) - lu(k,1392) * lu(k,1746) - lu(k,1761) = lu(k,1761) - lu(k,1393) * lu(k,1746) - lu(k,1762) = - lu(k,1394) * lu(k,1746) - lu(k,1763) = lu(k,1763) - lu(k,1395) * lu(k,1746) - lu(k,2655) = lu(k,2655) - lu(k,1384) * lu(k,2650) - lu(k,2660) = lu(k,2660) - lu(k,1385) * lu(k,2650) - lu(k,2661) = - lu(k,1386) * lu(k,2650) - lu(k,2670) = lu(k,2670) - lu(k,1387) * lu(k,2650) - lu(k,2681) = lu(k,2681) - lu(k,1388) * lu(k,2650) - lu(k,2699) = lu(k,2699) - lu(k,1389) * lu(k,2650) - lu(k,2702) = lu(k,2702) - lu(k,1390) * lu(k,2650) - lu(k,2705) = lu(k,2705) - lu(k,1391) * lu(k,2650) - lu(k,2706) = lu(k,2706) - lu(k,1392) * lu(k,2650) - lu(k,2707) = lu(k,2707) - lu(k,1393) * lu(k,2650) - lu(k,2709) = lu(k,2709) - lu(k,1394) * lu(k,2650) - lu(k,2710) = lu(k,2710) - lu(k,1395) * lu(k,2650) - lu(k,2836) = lu(k,2836) - lu(k,1384) * lu(k,2828) - lu(k,2841) = lu(k,2841) - lu(k,1385) * lu(k,2828) - lu(k,2842) = lu(k,2842) - lu(k,1386) * lu(k,2828) - lu(k,2853) = lu(k,2853) - lu(k,1387) * lu(k,2828) - lu(k,2864) = lu(k,2864) - lu(k,1388) * lu(k,2828) - lu(k,2882) = lu(k,2882) - lu(k,1389) * lu(k,2828) - lu(k,2885) = lu(k,2885) - lu(k,1390) * lu(k,2828) - lu(k,2889) = lu(k,2889) - lu(k,1391) * lu(k,2828) - lu(k,2891) = lu(k,2891) - lu(k,1392) * lu(k,2828) - lu(k,2892) = lu(k,2892) - lu(k,1393) * lu(k,2828) - lu(k,2894) = lu(k,2894) - lu(k,1394) * lu(k,2828) - lu(k,2895) = lu(k,2895) - lu(k,1395) * lu(k,2828) - lu(k,3232) = lu(k,3232) - lu(k,1384) * lu(k,3222) - lu(k,3237) = lu(k,3237) - lu(k,1385) * lu(k,3222) - lu(k,3238) = lu(k,3238) - lu(k,1386) * lu(k,3222) - lu(k,3249) = lu(k,3249) - lu(k,1387) * lu(k,3222) - lu(k,3260) = lu(k,3260) - lu(k,1388) * lu(k,3222) - lu(k,3278) = lu(k,3278) - lu(k,1389) * lu(k,3222) - lu(k,3281) = lu(k,3281) - lu(k,1390) * lu(k,3222) - lu(k,3285) = lu(k,3285) - lu(k,1391) * lu(k,3222) - lu(k,3287) = lu(k,3287) - lu(k,1392) * lu(k,3222) - lu(k,3288) = lu(k,3288) - lu(k,1393) * lu(k,3222) - lu(k,3290) = lu(k,3290) - lu(k,1394) * lu(k,3222) - lu(k,3291) = lu(k,3291) - lu(k,1395) * lu(k,3222) - lu(k,3374) = lu(k,3374) - lu(k,1384) * lu(k,3367) - lu(k,3379) = lu(k,3379) - lu(k,1385) * lu(k,3367) - lu(k,3380) = lu(k,3380) - lu(k,1386) * lu(k,3367) - lu(k,3390) = lu(k,3390) - lu(k,1387) * lu(k,3367) - lu(k,3401) = lu(k,3401) - lu(k,1388) * lu(k,3367) - lu(k,3419) = lu(k,3419) - lu(k,1389) * lu(k,3367) - lu(k,3422) = lu(k,3422) - lu(k,1390) * lu(k,3367) - lu(k,3426) = lu(k,3426) - lu(k,1391) * lu(k,3367) - lu(k,3428) = lu(k,3428) - lu(k,1392) * lu(k,3367) - lu(k,3429) = lu(k,3429) - lu(k,1393) * lu(k,3367) - lu(k,3431) = lu(k,3431) - lu(k,1394) * lu(k,3367) - lu(k,3432) = lu(k,3432) - lu(k,1395) * lu(k,3367) - lu(k,3694) = lu(k,3694) - lu(k,1384) * lu(k,3683) - lu(k,3699) = lu(k,3699) - lu(k,1385) * lu(k,3683) - lu(k,3700) = lu(k,3700) - lu(k,1386) * lu(k,3683) - lu(k,3711) = lu(k,3711) - lu(k,1387) * lu(k,3683) - lu(k,3721) = lu(k,3721) - lu(k,1388) * lu(k,3683) - lu(k,3739) = lu(k,3739) - lu(k,1389) * lu(k,3683) - lu(k,3742) = lu(k,3742) - lu(k,1390) * lu(k,3683) - lu(k,3746) = lu(k,3746) - lu(k,1391) * lu(k,3683) - lu(k,3748) = lu(k,3748) - lu(k,1392) * lu(k,3683) - lu(k,3749) = lu(k,3749) - lu(k,1393) * lu(k,3683) - lu(k,3751) = lu(k,3751) - lu(k,1394) * lu(k,3683) - lu(k,3752) = lu(k,3752) - lu(k,1395) * lu(k,3683) + lu(k,1413) = 1._r8 / lu(k,1413) + lu(k,1414) = lu(k,1414) * lu(k,1413) + lu(k,1415) = lu(k,1415) * lu(k,1413) + lu(k,1416) = lu(k,1416) * lu(k,1413) + lu(k,1417) = lu(k,1417) * lu(k,1413) + lu(k,1418) = lu(k,1418) * lu(k,1413) + lu(k,1419) = lu(k,1419) * lu(k,1413) + lu(k,1420) = lu(k,1420) * lu(k,1413) + lu(k,1421) = lu(k,1421) * lu(k,1413) + lu(k,1422) = lu(k,1422) * lu(k,1413) + lu(k,1423) = lu(k,1423) * lu(k,1413) + lu(k,1424) = lu(k,1424) * lu(k,1413) + lu(k,1425) = lu(k,1425) * lu(k,1413) + lu(k,1426) = lu(k,1426) * lu(k,1413) + lu(k,1427) = lu(k,1427) * lu(k,1413) + lu(k,1428) = lu(k,1428) * lu(k,1413) + lu(k,1564) = lu(k,1564) - lu(k,1414) * lu(k,1563) + lu(k,1565) = - lu(k,1415) * lu(k,1563) + lu(k,1566) = lu(k,1566) - lu(k,1416) * lu(k,1563) + lu(k,1567) = lu(k,1567) - lu(k,1417) * lu(k,1563) + lu(k,1573) = - lu(k,1418) * lu(k,1563) + lu(k,1575) = - lu(k,1419) * lu(k,1563) + lu(k,1578) = lu(k,1578) - lu(k,1420) * lu(k,1563) + lu(k,1579) = lu(k,1579) - lu(k,1421) * lu(k,1563) + lu(k,1580) = lu(k,1580) - lu(k,1422) * lu(k,1563) + lu(k,1583) = lu(k,1583) - lu(k,1423) * lu(k,1563) + lu(k,1586) = - lu(k,1424) * lu(k,1563) + lu(k,1588) = lu(k,1588) - lu(k,1425) * lu(k,1563) + lu(k,1590) = lu(k,1590) - lu(k,1426) * lu(k,1563) + lu(k,1591) = lu(k,1591) - lu(k,1427) * lu(k,1563) + lu(k,1593) = lu(k,1593) - lu(k,1428) * lu(k,1563) + lu(k,3240) = lu(k,3240) - lu(k,1414) * lu(k,3237) + lu(k,3242) = lu(k,3242) - lu(k,1415) * lu(k,3237) + lu(k,3243) = lu(k,3243) - lu(k,1416) * lu(k,3237) + lu(k,3244) = lu(k,3244) - lu(k,1417) * lu(k,3237) + lu(k,3255) = lu(k,3255) - lu(k,1418) * lu(k,3237) + lu(k,3260) = lu(k,3260) - lu(k,1419) * lu(k,3237) + lu(k,3269) = lu(k,3269) - lu(k,1420) * lu(k,3237) + lu(k,3270) = lu(k,3270) - lu(k,1421) * lu(k,3237) + lu(k,3271) = lu(k,3271) - lu(k,1422) * lu(k,3237) + lu(k,3308) = lu(k,3308) - lu(k,1423) * lu(k,3237) + lu(k,3311) = lu(k,3311) - lu(k,1424) * lu(k,3237) + lu(k,3313) = lu(k,3313) - lu(k,1425) * lu(k,3237) + lu(k,3315) = lu(k,3315) - lu(k,1426) * lu(k,3237) + lu(k,3316) = lu(k,3316) - lu(k,1427) * lu(k,3237) + lu(k,3320) = lu(k,3320) - lu(k,1428) * lu(k,3237) + lu(k,3494) = lu(k,3494) - lu(k,1414) * lu(k,3491) + lu(k,3496) = lu(k,3496) - lu(k,1415) * lu(k,3491) + lu(k,3497) = lu(k,3497) - lu(k,1416) * lu(k,3491) + lu(k,3498) = lu(k,3498) - lu(k,1417) * lu(k,3491) + lu(k,3510) = lu(k,3510) - lu(k,1418) * lu(k,3491) + lu(k,3516) = lu(k,3516) - lu(k,1419) * lu(k,3491) + lu(k,3525) = lu(k,3525) - lu(k,1420) * lu(k,3491) + lu(k,3526) = lu(k,3526) - lu(k,1421) * lu(k,3491) + lu(k,3527) = lu(k,3527) - lu(k,1422) * lu(k,3491) + lu(k,3564) = lu(k,3564) - lu(k,1423) * lu(k,3491) + lu(k,3567) = lu(k,3567) - lu(k,1424) * lu(k,3491) + lu(k,3569) = lu(k,3569) - lu(k,1425) * lu(k,3491) + lu(k,3571) = lu(k,3571) - lu(k,1426) * lu(k,3491) + lu(k,3572) = lu(k,3572) - lu(k,1427) * lu(k,3491) + lu(k,3576) = lu(k,3576) - lu(k,1428) * lu(k,3491) + lu(k,3743) = lu(k,3743) - lu(k,1414) * lu(k,3740) + lu(k,3745) = lu(k,3745) - lu(k,1415) * lu(k,3740) + lu(k,3746) = lu(k,3746) - lu(k,1416) * lu(k,3740) + lu(k,3747) = lu(k,3747) - lu(k,1417) * lu(k,3740) + lu(k,3761) = lu(k,3761) - lu(k,1418) * lu(k,3740) + lu(k,3767) = lu(k,3767) - lu(k,1419) * lu(k,3740) + lu(k,3776) = lu(k,3776) - lu(k,1420) * lu(k,3740) + lu(k,3777) = lu(k,3777) - lu(k,1421) * lu(k,3740) + lu(k,3778) = lu(k,3778) - lu(k,1422) * lu(k,3740) + lu(k,3814) = lu(k,3814) - lu(k,1423) * lu(k,3740) + lu(k,3817) = lu(k,3817) - lu(k,1424) * lu(k,3740) + lu(k,3819) = lu(k,3819) - lu(k,1425) * lu(k,3740) + lu(k,3821) = lu(k,3821) - lu(k,1426) * lu(k,3740) + lu(k,3822) = lu(k,3822) - lu(k,1427) * lu(k,3740) + lu(k,3826) = lu(k,3826) - lu(k,1428) * lu(k,3740) + lu(k,1429) = 1._r8 / lu(k,1429) + lu(k,1430) = lu(k,1430) * lu(k,1429) + lu(k,1431) = lu(k,1431) * lu(k,1429) + lu(k,1432) = lu(k,1432) * lu(k,1429) + lu(k,1433) = lu(k,1433) * lu(k,1429) + lu(k,1434) = lu(k,1434) * lu(k,1429) + lu(k,1435) = lu(k,1435) * lu(k,1429) + lu(k,1436) = lu(k,1436) * lu(k,1429) + lu(k,1437) = lu(k,1437) * lu(k,1429) + lu(k,2045) = lu(k,2045) - lu(k,1430) * lu(k,2038) + lu(k,2049) = lu(k,2049) - lu(k,1431) * lu(k,2038) + lu(k,2052) = - lu(k,1432) * lu(k,2038) + lu(k,2055) = lu(k,2055) - lu(k,1433) * lu(k,2038) + lu(k,2056) = lu(k,2056) - lu(k,1434) * lu(k,2038) + lu(k,2057) = lu(k,2057) - lu(k,1435) * lu(k,2038) + lu(k,2058) = lu(k,2058) - lu(k,1436) * lu(k,2038) + lu(k,2060) = lu(k,2060) - lu(k,1437) * lu(k,2038) + lu(k,3089) = lu(k,3089) - lu(k,1430) * lu(k,3066) + lu(k,3126) = lu(k,3126) - lu(k,1431) * lu(k,3066) + lu(k,3130) = lu(k,3130) - lu(k,1432) * lu(k,3066) + lu(k,3133) = lu(k,3133) - lu(k,1433) * lu(k,3066) + lu(k,3134) = lu(k,3134) - lu(k,1434) * lu(k,3066) + lu(k,3136) = lu(k,3136) - lu(k,1435) * lu(k,3066) + lu(k,3137) = lu(k,3137) - lu(k,1436) * lu(k,3066) + lu(k,3139) = lu(k,3139) - lu(k,1437) * lu(k,3066) + lu(k,3270) = lu(k,3270) - lu(k,1430) * lu(k,3238) + lu(k,3308) = lu(k,3308) - lu(k,1431) * lu(k,3238) + lu(k,3312) = lu(k,3312) - lu(k,1432) * lu(k,3238) + lu(k,3315) = lu(k,3315) - lu(k,1433) * lu(k,3238) + lu(k,3316) = lu(k,3316) - lu(k,1434) * lu(k,3238) + lu(k,3318) = lu(k,3318) - lu(k,1435) * lu(k,3238) + lu(k,3319) = lu(k,3319) - lu(k,1436) * lu(k,3238) + lu(k,3321) = lu(k,3321) - lu(k,1437) * lu(k,3238) + lu(k,3526) = lu(k,3526) - lu(k,1430) * lu(k,3492) + lu(k,3564) = lu(k,3564) - lu(k,1431) * lu(k,3492) + lu(k,3568) = lu(k,3568) - lu(k,1432) * lu(k,3492) + lu(k,3571) = lu(k,3571) - lu(k,1433) * lu(k,3492) + lu(k,3572) = lu(k,3572) - lu(k,1434) * lu(k,3492) + lu(k,3574) = lu(k,3574) - lu(k,1435) * lu(k,3492) + lu(k,3575) = lu(k,3575) - lu(k,1436) * lu(k,3492) + lu(k,3577) = lu(k,3577) - lu(k,1437) * lu(k,3492) + lu(k,3777) = lu(k,3777) - lu(k,1430) * lu(k,3741) + lu(k,3814) = lu(k,3814) - lu(k,1431) * lu(k,3741) + lu(k,3818) = lu(k,3818) - lu(k,1432) * lu(k,3741) + lu(k,3821) = lu(k,3821) - lu(k,1433) * lu(k,3741) + lu(k,3822) = lu(k,3822) - lu(k,1434) * lu(k,3741) + lu(k,3824) = lu(k,3824) - lu(k,1435) * lu(k,3741) + lu(k,3825) = lu(k,3825) - lu(k,1436) * lu(k,3741) + lu(k,3827) = lu(k,3827) - lu(k,1437) * lu(k,3741) + lu(k,3848) = lu(k,3848) - lu(k,1430) * lu(k,3841) + lu(k,3855) = - lu(k,1431) * lu(k,3841) + lu(k,3859) = lu(k,3859) - lu(k,1432) * lu(k,3841) + lu(k,3862) = lu(k,3862) - lu(k,1433) * lu(k,3841) + lu(k,3863) = lu(k,3863) - lu(k,1434) * lu(k,3841) + lu(k,3865) = lu(k,3865) - lu(k,1435) * lu(k,3841) + lu(k,3866) = lu(k,3866) - lu(k,1436) * lu(k,3841) + lu(k,3868) = lu(k,3868) - lu(k,1437) * lu(k,3841) + lu(k,3911) = lu(k,3911) - lu(k,1430) * lu(k,3890) + lu(k,3949) = lu(k,3949) - lu(k,1431) * lu(k,3890) + lu(k,3953) = lu(k,3953) - lu(k,1432) * lu(k,3890) + lu(k,3956) = lu(k,3956) - lu(k,1433) * lu(k,3890) + lu(k,3957) = lu(k,3957) - lu(k,1434) * lu(k,3890) + lu(k,3959) = lu(k,3959) - lu(k,1435) * lu(k,3890) + lu(k,3960) = lu(k,3960) - lu(k,1436) * lu(k,3890) + lu(k,3962) = lu(k,3962) - lu(k,1437) * lu(k,3890) + lu(k,4005) = lu(k,4005) - lu(k,1430) * lu(k,3975) + lu(k,4041) = lu(k,4041) - lu(k,1431) * lu(k,3975) + lu(k,4045) = lu(k,4045) - lu(k,1432) * lu(k,3975) + lu(k,4048) = lu(k,4048) - lu(k,1433) * lu(k,3975) + lu(k,4049) = lu(k,4049) - lu(k,1434) * lu(k,3975) + lu(k,4051) = lu(k,4051) - lu(k,1435) * lu(k,3975) + lu(k,4052) = lu(k,4052) - lu(k,1436) * lu(k,3975) + lu(k,4054) = lu(k,4054) - lu(k,1437) * lu(k,3975) + lu(k,1438) = 1._r8 / lu(k,1438) + lu(k,1439) = lu(k,1439) * lu(k,1438) + lu(k,1440) = lu(k,1440) * lu(k,1438) + lu(k,1441) = lu(k,1441) * lu(k,1438) + lu(k,1442) = lu(k,1442) * lu(k,1438) + lu(k,1443) = lu(k,1443) * lu(k,1438) + lu(k,1444) = lu(k,1444) * lu(k,1438) + lu(k,1445) = lu(k,1445) * lu(k,1438) + lu(k,1446) = lu(k,1446) * lu(k,1438) + lu(k,1447) = lu(k,1447) * lu(k,1438) + lu(k,1448) = lu(k,1448) * lu(k,1438) + lu(k,1449) = lu(k,1449) * lu(k,1438) + lu(k,1450) = lu(k,1450) * lu(k,1438) + lu(k,1451) = lu(k,1451) * lu(k,1438) + lu(k,2160) = lu(k,2160) - lu(k,1439) * lu(k,2159) + lu(k,2161) = lu(k,2161) - lu(k,1440) * lu(k,2159) + lu(k,2162) = lu(k,2162) - lu(k,1441) * lu(k,2159) + lu(k,2167) = lu(k,2167) - lu(k,1442) * lu(k,2159) + lu(k,2168) = lu(k,2168) - lu(k,1443) * lu(k,2159) + lu(k,2169) = lu(k,2169) - lu(k,1444) * lu(k,2159) + lu(k,2170) = lu(k,2170) - lu(k,1445) * lu(k,2159) + lu(k,2174) = lu(k,2174) - lu(k,1446) * lu(k,2159) + lu(k,2186) = lu(k,2186) - lu(k,1447) * lu(k,2159) + lu(k,2188) = lu(k,2188) - lu(k,1448) * lu(k,2159) + lu(k,2190) = lu(k,2190) - lu(k,1449) * lu(k,2159) + lu(k,2191) = lu(k,2191) - lu(k,1450) * lu(k,2159) + lu(k,2195) = lu(k,2195) - lu(k,1451) * lu(k,2159) + lu(k,3240) = lu(k,3240) - lu(k,1439) * lu(k,3239) + lu(k,3242) = lu(k,3242) - lu(k,1440) * lu(k,3239) + lu(k,3244) = lu(k,3244) - lu(k,1441) * lu(k,3239) + lu(k,3255) = lu(k,3255) - lu(k,1442) * lu(k,3239) + lu(k,3258) = lu(k,3258) - lu(k,1443) * lu(k,3239) + lu(k,3260) = lu(k,3260) - lu(k,1444) * lu(k,3239) + lu(k,3262) = lu(k,3262) - lu(k,1445) * lu(k,3239) + lu(k,3271) = lu(k,3271) - lu(k,1446) * lu(k,3239) + lu(k,3311) = lu(k,3311) - lu(k,1447) * lu(k,3239) + lu(k,3313) = lu(k,3313) - lu(k,1448) * lu(k,3239) + lu(k,3315) = lu(k,3315) - lu(k,1449) * lu(k,3239) + lu(k,3316) = lu(k,3316) - lu(k,1450) * lu(k,3239) + lu(k,3320) = lu(k,3320) - lu(k,1451) * lu(k,3239) + lu(k,3494) = lu(k,3494) - lu(k,1439) * lu(k,3493) + lu(k,3496) = lu(k,3496) - lu(k,1440) * lu(k,3493) + lu(k,3498) = lu(k,3498) - lu(k,1441) * lu(k,3493) + lu(k,3510) = lu(k,3510) - lu(k,1442) * lu(k,3493) + lu(k,3514) = lu(k,3514) - lu(k,1443) * lu(k,3493) + lu(k,3516) = lu(k,3516) - lu(k,1444) * lu(k,3493) + lu(k,3518) = lu(k,3518) - lu(k,1445) * lu(k,3493) + lu(k,3527) = lu(k,3527) - lu(k,1446) * lu(k,3493) + lu(k,3567) = lu(k,3567) - lu(k,1447) * lu(k,3493) + lu(k,3569) = lu(k,3569) - lu(k,1448) * lu(k,3493) + lu(k,3571) = lu(k,3571) - lu(k,1449) * lu(k,3493) + lu(k,3572) = lu(k,3572) - lu(k,1450) * lu(k,3493) + lu(k,3576) = lu(k,3576) - lu(k,1451) * lu(k,3493) + lu(k,3743) = lu(k,3743) - lu(k,1439) * lu(k,3742) + lu(k,3745) = lu(k,3745) - lu(k,1440) * lu(k,3742) + lu(k,3747) = lu(k,3747) - lu(k,1441) * lu(k,3742) + lu(k,3761) = lu(k,3761) - lu(k,1442) * lu(k,3742) + lu(k,3765) = lu(k,3765) - lu(k,1443) * lu(k,3742) + lu(k,3767) = lu(k,3767) - lu(k,1444) * lu(k,3742) + lu(k,3769) = lu(k,3769) - lu(k,1445) * lu(k,3742) + lu(k,3778) = lu(k,3778) - lu(k,1446) * lu(k,3742) + lu(k,3817) = lu(k,3817) - lu(k,1447) * lu(k,3742) + lu(k,3819) = lu(k,3819) - lu(k,1448) * lu(k,3742) + lu(k,3821) = lu(k,3821) - lu(k,1449) * lu(k,3742) + lu(k,3822) = lu(k,3822) - lu(k,1450) * lu(k,3742) + lu(k,3826) = lu(k,3826) - lu(k,1451) * lu(k,3742) + lu(k,3977) = - lu(k,1439) * lu(k,3976) + lu(k,3979) = - lu(k,1440) * lu(k,3976) + lu(k,3980) = lu(k,3980) - lu(k,1441) * lu(k,3976) + lu(k,3990) = - lu(k,1442) * lu(k,3976) + lu(k,3993) = lu(k,3993) - lu(k,1443) * lu(k,3976) + lu(k,3995) = - lu(k,1444) * lu(k,3976) + lu(k,3997) = lu(k,3997) - lu(k,1445) * lu(k,3976) + lu(k,4006) = lu(k,4006) - lu(k,1446) * lu(k,3976) + lu(k,4044) = lu(k,4044) - lu(k,1447) * lu(k,3976) + lu(k,4046) = lu(k,4046) - lu(k,1448) * lu(k,3976) + lu(k,4048) = lu(k,4048) - lu(k,1449) * lu(k,3976) + lu(k,4049) = lu(k,4049) - lu(k,1450) * lu(k,3976) + lu(k,4053) = lu(k,4053) - lu(k,1451) * lu(k,3976) + lu(k,1452) = 1._r8 / lu(k,1452) + lu(k,1453) = lu(k,1453) * lu(k,1452) + lu(k,1454) = lu(k,1454) * lu(k,1452) + lu(k,1455) = lu(k,1455) * lu(k,1452) + lu(k,1456) = lu(k,1456) * lu(k,1452) + lu(k,1457) = lu(k,1457) * lu(k,1452) + lu(k,1458) = lu(k,1458) * lu(k,1452) + lu(k,1571) = lu(k,1571) - lu(k,1453) * lu(k,1564) + lu(k,1579) = lu(k,1579) - lu(k,1454) * lu(k,1564) + lu(k,1588) = lu(k,1588) - lu(k,1455) * lu(k,1564) + lu(k,1590) = lu(k,1590) - lu(k,1456) * lu(k,1564) + lu(k,1591) = lu(k,1591) - lu(k,1457) * lu(k,1564) + lu(k,1593) = lu(k,1593) - lu(k,1458) * lu(k,1564) + lu(k,1637) = - lu(k,1453) * lu(k,1633) + lu(k,1644) = lu(k,1644) - lu(k,1454) * lu(k,1633) + lu(k,1649) = - lu(k,1455) * lu(k,1633) + lu(k,1651) = lu(k,1651) - lu(k,1456) * lu(k,1633) + lu(k,1652) = lu(k,1652) - lu(k,1457) * lu(k,1633) + lu(k,1653) = lu(k,1653) - lu(k,1458) * lu(k,1633) + lu(k,1925) = - lu(k,1453) * lu(k,1923) + lu(k,1928) = lu(k,1928) - lu(k,1454) * lu(k,1923) + lu(k,1932) = lu(k,1932) - lu(k,1455) * lu(k,1923) + lu(k,1934) = lu(k,1934) - lu(k,1456) * lu(k,1923) + lu(k,1935) = lu(k,1935) - lu(k,1457) * lu(k,1923) + lu(k,1937) = lu(k,1937) - lu(k,1458) * lu(k,1923) + lu(k,2068) = - lu(k,1453) * lu(k,2062) + lu(k,2076) = lu(k,2076) - lu(k,1454) * lu(k,2062) + lu(k,2085) = lu(k,2085) - lu(k,1455) * lu(k,2062) + lu(k,2087) = lu(k,2087) - lu(k,1456) * lu(k,2062) + lu(k,2088) = lu(k,2088) - lu(k,1457) * lu(k,2062) + lu(k,2091) = lu(k,2091) - lu(k,1458) * lu(k,2062) + lu(k,2130) = lu(k,2130) - lu(k,1453) * lu(k,2126) + lu(k,2138) = lu(k,2138) - lu(k,1454) * lu(k,2126) + lu(k,2146) = lu(k,2146) - lu(k,1455) * lu(k,2126) + lu(k,2148) = lu(k,2148) - lu(k,1456) * lu(k,2126) + lu(k,2149) = lu(k,2149) - lu(k,1457) * lu(k,2126) + lu(k,2152) = lu(k,2152) - lu(k,1458) * lu(k,2126) + lu(k,2165) = lu(k,2165) - lu(k,1453) * lu(k,2160) + lu(k,2173) = lu(k,2173) - lu(k,1454) * lu(k,2160) + lu(k,2188) = lu(k,2188) - lu(k,1455) * lu(k,2160) + lu(k,2190) = lu(k,2190) - lu(k,1456) * lu(k,2160) + lu(k,2191) = lu(k,2191) - lu(k,1457) * lu(k,2160) + lu(k,2195) = lu(k,2195) - lu(k,1458) * lu(k,2160) + lu(k,3074) = lu(k,3074) - lu(k,1453) * lu(k,3067) + lu(k,3089) = lu(k,3089) - lu(k,1454) * lu(k,3067) + lu(k,3131) = lu(k,3131) - lu(k,1455) * lu(k,3067) + lu(k,3133) = lu(k,3133) - lu(k,1456) * lu(k,3067) + lu(k,3134) = lu(k,3134) - lu(k,1457) * lu(k,3067) + lu(k,3138) = lu(k,3138) - lu(k,1458) * lu(k,3067) + lu(k,3252) = lu(k,3252) - lu(k,1453) * lu(k,3240) + lu(k,3270) = lu(k,3270) - lu(k,1454) * lu(k,3240) + lu(k,3313) = lu(k,3313) - lu(k,1455) * lu(k,3240) + lu(k,3315) = lu(k,3315) - lu(k,1456) * lu(k,3240) + lu(k,3316) = lu(k,3316) - lu(k,1457) * lu(k,3240) + lu(k,3320) = lu(k,3320) - lu(k,1458) * lu(k,3240) + lu(k,3507) = lu(k,3507) - lu(k,1453) * lu(k,3494) + lu(k,3526) = lu(k,3526) - lu(k,1454) * lu(k,3494) + lu(k,3569) = lu(k,3569) - lu(k,1455) * lu(k,3494) + lu(k,3571) = lu(k,3571) - lu(k,1456) * lu(k,3494) + lu(k,3572) = lu(k,3572) - lu(k,1457) * lu(k,3494) + lu(k,3576) = lu(k,3576) - lu(k,1458) * lu(k,3494) + lu(k,3758) = lu(k,3758) - lu(k,1453) * lu(k,3743) + lu(k,3777) = lu(k,3777) - lu(k,1454) * lu(k,3743) + lu(k,3819) = lu(k,3819) - lu(k,1455) * lu(k,3743) + lu(k,3821) = lu(k,3821) - lu(k,1456) * lu(k,3743) + lu(k,3822) = lu(k,3822) - lu(k,1457) * lu(k,3743) + lu(k,3826) = lu(k,3826) - lu(k,1458) * lu(k,3743) + lu(k,3987) = lu(k,3987) - lu(k,1453) * lu(k,3977) + lu(k,4005) = lu(k,4005) - lu(k,1454) * lu(k,3977) + lu(k,4046) = lu(k,4046) - lu(k,1455) * lu(k,3977) + lu(k,4048) = lu(k,4048) - lu(k,1456) * lu(k,3977) + lu(k,4049) = lu(k,4049) - lu(k,1457) * lu(k,3977) + lu(k,4053) = lu(k,4053) - lu(k,1458) * lu(k,3977) end do end subroutine lu_fac31 subroutine lu_fac32( avec_len, lu ) @@ -6100,303 +5778,380 @@ subroutine lu_fac32( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1396) = 1._r8 / lu(k,1396) - lu(k,1397) = lu(k,1397) * lu(k,1396) - lu(k,1398) = lu(k,1398) * lu(k,1396) - lu(k,1399) = lu(k,1399) * lu(k,1396) - lu(k,1400) = lu(k,1400) * lu(k,1396) - lu(k,1401) = lu(k,1401) * lu(k,1396) - lu(k,1604) = - lu(k,1397) * lu(k,1601) - lu(k,1606) = lu(k,1606) - lu(k,1398) * lu(k,1601) - lu(k,1608) = lu(k,1608) - lu(k,1399) * lu(k,1601) - lu(k,1609) = lu(k,1609) - lu(k,1400) * lu(k,1601) - lu(k,1610) = lu(k,1610) - lu(k,1401) * lu(k,1601) - lu(k,2074) = - lu(k,1397) * lu(k,2070) - lu(k,2082) = - lu(k,1398) * lu(k,2070) - lu(k,2086) = lu(k,2086) - lu(k,1399) * lu(k,2070) - lu(k,2089) = lu(k,2089) - lu(k,1400) * lu(k,2070) - lu(k,2090) = lu(k,2090) - lu(k,1401) * lu(k,2070) - lu(k,2120) = lu(k,2120) - lu(k,1397) * lu(k,2117) - lu(k,2128) = lu(k,2128) - lu(k,1398) * lu(k,2117) - lu(k,2131) = lu(k,2131) - lu(k,1399) * lu(k,2117) - lu(k,2134) = lu(k,2134) - lu(k,1400) * lu(k,2117) - lu(k,2135) = lu(k,2135) - lu(k,1401) * lu(k,2117) - lu(k,2213) = lu(k,2213) - lu(k,1397) * lu(k,2206) - lu(k,2223) = - lu(k,1398) * lu(k,2206) - lu(k,2227) = lu(k,2227) - lu(k,1399) * lu(k,2206) - lu(k,2230) = lu(k,2230) - lu(k,1400) * lu(k,2206) - lu(k,2231) = lu(k,2231) - lu(k,1401) * lu(k,2206) - lu(k,2242) = lu(k,2242) - lu(k,1397) * lu(k,2235) - lu(k,2252) = - lu(k,1398) * lu(k,2235) - lu(k,2256) = lu(k,2256) - lu(k,1399) * lu(k,2235) - lu(k,2259) = lu(k,2259) - lu(k,1400) * lu(k,2235) - lu(k,2260) = lu(k,2260) - lu(k,1401) * lu(k,2235) - lu(k,2302) = lu(k,2302) - lu(k,1397) * lu(k,2298) - lu(k,2313) = lu(k,2313) - lu(k,1398) * lu(k,2298) - lu(k,2317) = lu(k,2317) - lu(k,1399) * lu(k,2298) - lu(k,2320) = lu(k,2320) - lu(k,1400) * lu(k,2298) - lu(k,2321) = lu(k,2321) - lu(k,1401) * lu(k,2298) - lu(k,2331) = lu(k,2331) - lu(k,1397) * lu(k,2328) - lu(k,2340) = lu(k,2340) - lu(k,1398) * lu(k,2328) - lu(k,2344) = lu(k,2344) - lu(k,1399) * lu(k,2328) - lu(k,2347) = lu(k,2347) - lu(k,1400) * lu(k,2328) - lu(k,2348) = lu(k,2348) - lu(k,1401) * lu(k,2328) - lu(k,2362) = lu(k,2362) - lu(k,1397) * lu(k,2357) - lu(k,2374) = lu(k,2374) - lu(k,1398) * lu(k,2357) - lu(k,2378) = lu(k,2378) - lu(k,1399) * lu(k,2357) - lu(k,2381) = lu(k,2381) - lu(k,1400) * lu(k,2357) - lu(k,2382) = lu(k,2382) - lu(k,1401) * lu(k,2357) - lu(k,2486) = lu(k,2486) - lu(k,1397) * lu(k,2483) - lu(k,2494) = - lu(k,1398) * lu(k,2483) - lu(k,2498) = lu(k,2498) - lu(k,1399) * lu(k,2483) - lu(k,2501) = lu(k,2501) - lu(k,1400) * lu(k,2483) - lu(k,2502) = lu(k,2502) - lu(k,1401) * lu(k,2483) - lu(k,2520) = lu(k,2520) - lu(k,1397) * lu(k,2507) - lu(k,2536) = - lu(k,1398) * lu(k,2507) - lu(k,2541) = lu(k,2541) - lu(k,1399) * lu(k,2507) - lu(k,2545) = lu(k,2545) - lu(k,1400) * lu(k,2507) - lu(k,2546) = lu(k,2546) - lu(k,1401) * lu(k,2507) - lu(k,2566) = lu(k,2566) - lu(k,1397) * lu(k,2553) - lu(k,2582) = - lu(k,1398) * lu(k,2553) - lu(k,2587) = lu(k,2587) - lu(k,1399) * lu(k,2553) - lu(k,2591) = lu(k,2591) - lu(k,1400) * lu(k,2553) - lu(k,2592) = lu(k,2592) - lu(k,1401) * lu(k,2553) - lu(k,2613) = lu(k,2613) - lu(k,1397) * lu(k,2600) - lu(k,2629) = lu(k,2629) - lu(k,1398) * lu(k,2600) - lu(k,2634) = lu(k,2634) - lu(k,1399) * lu(k,2600) - lu(k,2638) = lu(k,2638) - lu(k,1400) * lu(k,2600) - lu(k,2639) = lu(k,2639) - lu(k,1401) * lu(k,2600) - lu(k,2684) = lu(k,2684) - lu(k,1397) * lu(k,2651) - lu(k,2700) = - lu(k,1398) * lu(k,2651) - lu(k,2705) = lu(k,2705) - lu(k,1399) * lu(k,2651) - lu(k,2709) = lu(k,2709) - lu(k,1400) * lu(k,2651) - lu(k,2710) = lu(k,2710) - lu(k,1401) * lu(k,2651) - lu(k,2867) = lu(k,2867) - lu(k,1397) * lu(k,2829) - lu(k,2883) = lu(k,2883) - lu(k,1398) * lu(k,2829) - lu(k,2889) = lu(k,2889) - lu(k,1399) * lu(k,2829) - lu(k,2894) = lu(k,2894) - lu(k,1400) * lu(k,2829) - lu(k,2895) = lu(k,2895) - lu(k,1401) * lu(k,2829) - lu(k,3060) = lu(k,3060) - lu(k,1397) * lu(k,3026) - lu(k,3076) = lu(k,3076) - lu(k,1398) * lu(k,3026) - lu(k,3082) = lu(k,3082) - lu(k,1399) * lu(k,3026) - lu(k,3087) = lu(k,3087) - lu(k,1400) * lu(k,3026) - lu(k,3088) = lu(k,3088) - lu(k,1401) * lu(k,3026) - lu(k,3263) = lu(k,3263) - lu(k,1397) * lu(k,3223) - lu(k,3279) = lu(k,3279) - lu(k,1398) * lu(k,3223) - lu(k,3285) = lu(k,3285) - lu(k,1399) * lu(k,3223) - lu(k,3290) = lu(k,3290) - lu(k,1400) * lu(k,3223) - lu(k,3291) = lu(k,3291) - lu(k,1401) * lu(k,3223) - lu(k,3404) = lu(k,3404) - lu(k,1397) * lu(k,3368) - lu(k,3420) = lu(k,3420) - lu(k,1398) * lu(k,3368) - lu(k,3426) = lu(k,3426) - lu(k,1399) * lu(k,3368) - lu(k,3431) = lu(k,3431) - lu(k,1400) * lu(k,3368) - lu(k,3432) = lu(k,3432) - lu(k,1401) * lu(k,3368) - lu(k,3724) = lu(k,3724) - lu(k,1397) * lu(k,3684) - lu(k,3740) = lu(k,3740) - lu(k,1398) * lu(k,3684) - lu(k,3746) = lu(k,3746) - lu(k,1399) * lu(k,3684) - lu(k,3751) = lu(k,3751) - lu(k,1400) * lu(k,3684) - lu(k,3752) = lu(k,3752) - lu(k,1401) * lu(k,3684) - lu(k,1404) = 1._r8 / lu(k,1404) - lu(k,1405) = lu(k,1405) * lu(k,1404) - lu(k,1406) = lu(k,1406) * lu(k,1404) - lu(k,1407) = lu(k,1407) * lu(k,1404) - lu(k,1408) = lu(k,1408) * lu(k,1404) - lu(k,1409) = lu(k,1409) * lu(k,1404) - lu(k,1410) = lu(k,1410) * lu(k,1404) - lu(k,1411) = lu(k,1411) * lu(k,1404) - lu(k,1412) = lu(k,1412) * lu(k,1404) - lu(k,1413) = lu(k,1413) * lu(k,1404) - lu(k,1440) = lu(k,1440) - lu(k,1405) * lu(k,1438) - lu(k,1443) = lu(k,1443) - lu(k,1406) * lu(k,1438) - lu(k,1444) = lu(k,1444) - lu(k,1407) * lu(k,1438) - lu(k,1446) = lu(k,1446) - lu(k,1408) * lu(k,1438) - lu(k,1448) = lu(k,1448) - lu(k,1409) * lu(k,1438) - lu(k,1453) = lu(k,1453) - lu(k,1410) * lu(k,1438) - lu(k,1455) = lu(k,1455) - lu(k,1411) * lu(k,1438) - lu(k,1458) = lu(k,1458) - lu(k,1412) * lu(k,1438) - lu(k,1459) = lu(k,1459) - lu(k,1413) * lu(k,1438) - lu(k,1696) = lu(k,1696) - lu(k,1405) * lu(k,1695) - lu(k,1697) = lu(k,1697) - lu(k,1406) * lu(k,1695) - lu(k,1698) = lu(k,1698) - lu(k,1407) * lu(k,1695) - lu(k,1699) = - lu(k,1408) * lu(k,1695) - lu(k,1702) = lu(k,1702) - lu(k,1409) * lu(k,1695) - lu(k,1705) = - lu(k,1410) * lu(k,1695) - lu(k,1706) = lu(k,1706) - lu(k,1411) * lu(k,1695) - lu(k,1708) = - lu(k,1412) * lu(k,1695) - lu(k,1709) = lu(k,1709) - lu(k,1413) * lu(k,1695) - lu(k,1720) = lu(k,1720) - lu(k,1405) * lu(k,1719) - lu(k,1722) = lu(k,1722) - lu(k,1406) * lu(k,1719) - lu(k,1724) = lu(k,1724) - lu(k,1407) * lu(k,1719) - lu(k,1726) = lu(k,1726) - lu(k,1408) * lu(k,1719) - lu(k,1732) = lu(k,1732) - lu(k,1409) * lu(k,1719) - lu(k,1739) = lu(k,1739) - lu(k,1410) * lu(k,1719) - lu(k,1740) = lu(k,1740) - lu(k,1411) * lu(k,1719) - lu(k,1743) = lu(k,1743) - lu(k,1412) * lu(k,1719) - lu(k,1744) = lu(k,1744) - lu(k,1413) * lu(k,1719) - lu(k,1819) = lu(k,1819) - lu(k,1405) * lu(k,1818) - lu(k,1821) = lu(k,1821) - lu(k,1406) * lu(k,1818) - lu(k,1823) = lu(k,1823) - lu(k,1407) * lu(k,1818) - lu(k,1825) = lu(k,1825) - lu(k,1408) * lu(k,1818) - lu(k,1830) = lu(k,1830) - lu(k,1409) * lu(k,1818) - lu(k,1837) = lu(k,1837) - lu(k,1410) * lu(k,1818) - lu(k,1838) = lu(k,1838) - lu(k,1411) * lu(k,1818) - lu(k,1841) = lu(k,1841) - lu(k,1412) * lu(k,1818) - lu(k,1842) = lu(k,1842) - lu(k,1413) * lu(k,1818) - lu(k,1885) = lu(k,1885) - lu(k,1405) * lu(k,1884) - lu(k,1886) = lu(k,1886) - lu(k,1406) * lu(k,1884) - lu(k,1887) = lu(k,1887) - lu(k,1407) * lu(k,1884) - lu(k,1888) = - lu(k,1408) * lu(k,1884) - lu(k,1894) = lu(k,1894) - lu(k,1409) * lu(k,1884) - lu(k,1903) = - lu(k,1410) * lu(k,1884) - lu(k,1906) = lu(k,1906) - lu(k,1411) * lu(k,1884) - lu(k,1909) = - lu(k,1412) * lu(k,1884) - lu(k,1910) = lu(k,1910) - lu(k,1413) * lu(k,1884) - lu(k,1921) = lu(k,1921) - lu(k,1405) * lu(k,1920) - lu(k,1923) = lu(k,1923) - lu(k,1406) * lu(k,1920) - lu(k,1924) = lu(k,1924) - lu(k,1407) * lu(k,1920) - lu(k,1926) = lu(k,1926) - lu(k,1408) * lu(k,1920) - lu(k,1929) = lu(k,1929) - lu(k,1409) * lu(k,1920) - lu(k,1935) = lu(k,1935) - lu(k,1410) * lu(k,1920) - lu(k,1938) = lu(k,1938) - lu(k,1411) * lu(k,1920) - lu(k,1941) = lu(k,1941) - lu(k,1412) * lu(k,1920) - lu(k,1942) = lu(k,1942) - lu(k,1413) * lu(k,1920) - lu(k,1955) = lu(k,1955) - lu(k,1405) * lu(k,1954) - lu(k,1957) = lu(k,1957) - lu(k,1406) * lu(k,1954) - lu(k,1958) = lu(k,1958) - lu(k,1407) * lu(k,1954) - lu(k,1960) = lu(k,1960) - lu(k,1408) * lu(k,1954) - lu(k,1963) = lu(k,1963) - lu(k,1409) * lu(k,1954) - lu(k,1969) = lu(k,1969) - lu(k,1410) * lu(k,1954) - lu(k,1972) = lu(k,1972) - lu(k,1411) * lu(k,1954) - lu(k,1975) = lu(k,1975) - lu(k,1412) * lu(k,1954) - lu(k,1976) = lu(k,1976) - lu(k,1413) * lu(k,1954) - lu(k,2832) = lu(k,2832) - lu(k,1405) * lu(k,2830) - lu(k,2836) = lu(k,2836) - lu(k,1406) * lu(k,2830) - lu(k,2841) = lu(k,2841) - lu(k,1407) * lu(k,2830) - lu(k,2843) = lu(k,2843) - lu(k,1408) * lu(k,2830) - lu(k,2853) = lu(k,2853) - lu(k,1409) * lu(k,2830) - lu(k,2885) = lu(k,2885) - lu(k,1410) * lu(k,2830) - lu(k,2889) = lu(k,2889) - lu(k,1411) * lu(k,2830) - lu(k,2894) = lu(k,2894) - lu(k,1412) * lu(k,2830) - lu(k,2895) = lu(k,2895) - lu(k,1413) * lu(k,2830) - lu(k,3228) = lu(k,3228) - lu(k,1405) * lu(k,3224) - lu(k,3232) = lu(k,3232) - lu(k,1406) * lu(k,3224) - lu(k,3237) = lu(k,3237) - lu(k,1407) * lu(k,3224) - lu(k,3239) = lu(k,3239) - lu(k,1408) * lu(k,3224) - lu(k,3249) = lu(k,3249) - lu(k,1409) * lu(k,3224) - lu(k,3281) = lu(k,3281) - lu(k,1410) * lu(k,3224) - lu(k,3285) = lu(k,3285) - lu(k,1411) * lu(k,3224) - lu(k,3290) = lu(k,3290) - lu(k,1412) * lu(k,3224) - lu(k,3291) = lu(k,3291) - lu(k,1413) * lu(k,3224) - lu(k,3689) = lu(k,3689) - lu(k,1405) * lu(k,3685) - lu(k,3694) = lu(k,3694) - lu(k,1406) * lu(k,3685) - lu(k,3699) = lu(k,3699) - lu(k,1407) * lu(k,3685) - lu(k,3701) = lu(k,3701) - lu(k,1408) * lu(k,3685) - lu(k,3711) = lu(k,3711) - lu(k,1409) * lu(k,3685) - lu(k,3742) = lu(k,3742) - lu(k,1410) * lu(k,3685) - lu(k,3746) = lu(k,3746) - lu(k,1411) * lu(k,3685) - lu(k,3751) = lu(k,3751) - lu(k,1412) * lu(k,3685) - lu(k,3752) = lu(k,3752) - lu(k,1413) * lu(k,3685) - lu(k,1416) = 1._r8 / lu(k,1416) - lu(k,1417) = lu(k,1417) * lu(k,1416) - lu(k,1418) = lu(k,1418) * lu(k,1416) - lu(k,1419) = lu(k,1419) * lu(k,1416) - lu(k,1420) = lu(k,1420) * lu(k,1416) - lu(k,1421) = lu(k,1421) * lu(k,1416) - lu(k,1422) = lu(k,1422) * lu(k,1416) - lu(k,1423) = lu(k,1423) * lu(k,1416) - lu(k,1424) = lu(k,1424) * lu(k,1416) - lu(k,1425) = lu(k,1425) * lu(k,1416) - lu(k,1426) = lu(k,1426) * lu(k,1416) - lu(k,2717) = lu(k,2717) - lu(k,1417) * lu(k,2716) - lu(k,2718) = lu(k,2718) - lu(k,1418) * lu(k,2716) - lu(k,2719) = lu(k,2719) - lu(k,1419) * lu(k,2716) - lu(k,2720) = - lu(k,1420) * lu(k,2716) - lu(k,2721) = lu(k,2721) - lu(k,1421) * lu(k,2716) - lu(k,2722) = - lu(k,1422) * lu(k,2716) - lu(k,2724) = lu(k,2724) - lu(k,1423) * lu(k,2716) - lu(k,2725) = - lu(k,1424) * lu(k,2716) - lu(k,2726) = - lu(k,1425) * lu(k,2716) - lu(k,2727) = lu(k,2727) - lu(k,1426) * lu(k,2716) - lu(k,2729) = - lu(k,1417) * lu(k,2728) - lu(k,2730) = lu(k,2730) - lu(k,1418) * lu(k,2728) - lu(k,2732) = - lu(k,1419) * lu(k,2728) - lu(k,2733) = - lu(k,1420) * lu(k,2728) - lu(k,2735) = - lu(k,1421) * lu(k,2728) - lu(k,2736) = lu(k,2736) - lu(k,1422) * lu(k,2728) - lu(k,2738) = lu(k,2738) - lu(k,1423) * lu(k,2728) - lu(k,2739) = - lu(k,1424) * lu(k,2728) - lu(k,2740) = - lu(k,1425) * lu(k,2728) - lu(k,2741) = lu(k,2741) - lu(k,1426) * lu(k,2728) - lu(k,3100) = lu(k,3100) - lu(k,1417) * lu(k,3098) - lu(k,3101) = lu(k,3101) - lu(k,1418) * lu(k,3098) - lu(k,3104) = lu(k,3104) - lu(k,1419) * lu(k,3098) - lu(k,3105) = lu(k,3105) - lu(k,1420) * lu(k,3098) - lu(k,3109) = lu(k,3109) - lu(k,1421) * lu(k,3098) - lu(k,3110) = lu(k,3110) - lu(k,1422) * lu(k,3098) - lu(k,3112) = lu(k,3112) - lu(k,1423) * lu(k,3098) - lu(k,3113) = lu(k,3113) - lu(k,1424) * lu(k,3098) - lu(k,3115) = lu(k,3115) - lu(k,1425) * lu(k,3098) - lu(k,3116) = lu(k,3116) - lu(k,1426) * lu(k,3098) - lu(k,3279) = lu(k,3279) - lu(k,1417) * lu(k,3225) - lu(k,3280) = lu(k,3280) - lu(k,1418) * lu(k,3225) - lu(k,3283) = lu(k,3283) - lu(k,1419) * lu(k,3225) - lu(k,3284) = lu(k,3284) - lu(k,1420) * lu(k,3225) - lu(k,3288) = lu(k,3288) - lu(k,1421) * lu(k,3225) - lu(k,3289) = lu(k,3289) - lu(k,1422) * lu(k,3225) - lu(k,3291) = lu(k,3291) - lu(k,1423) * lu(k,3225) - lu(k,3292) = lu(k,3292) - lu(k,1424) * lu(k,3225) - lu(k,3294) = lu(k,3294) - lu(k,1425) * lu(k,3225) - lu(k,3295) = lu(k,3295) - lu(k,1426) * lu(k,3225) - lu(k,3329) = lu(k,3329) - lu(k,1417) * lu(k,3326) - lu(k,3330) = lu(k,3330) - lu(k,1418) * lu(k,3326) - lu(k,3333) = lu(k,3333) - lu(k,1419) * lu(k,3326) - lu(k,3334) = lu(k,3334) - lu(k,1420) * lu(k,3326) - lu(k,3338) = - lu(k,1421) * lu(k,3326) - lu(k,3339) = lu(k,3339) - lu(k,1422) * lu(k,3326) - lu(k,3341) = lu(k,3341) - lu(k,1423) * lu(k,3326) - lu(k,3342) = lu(k,3342) - lu(k,1424) * lu(k,3326) - lu(k,3344) = lu(k,3344) - lu(k,1425) * lu(k,3326) - lu(k,3345) = lu(k,3345) - lu(k,1426) * lu(k,3326) - lu(k,3450) = lu(k,3450) - lu(k,1417) * lu(k,3446) - lu(k,3451) = lu(k,3451) - lu(k,1418) * lu(k,3446) - lu(k,3454) = lu(k,3454) - lu(k,1419) * lu(k,3446) - lu(k,3455) = lu(k,3455) - lu(k,1420) * lu(k,3446) - lu(k,3459) = - lu(k,1421) * lu(k,3446) - lu(k,3460) = lu(k,3460) - lu(k,1422) * lu(k,3446) - lu(k,3462) = lu(k,3462) - lu(k,1423) * lu(k,3446) - lu(k,3463) = lu(k,3463) - lu(k,1424) * lu(k,3446) - lu(k,3465) = lu(k,3465) - lu(k,1425) * lu(k,3446) - lu(k,3466) = lu(k,3466) - lu(k,1426) * lu(k,3446) - lu(k,3740) = lu(k,3740) - lu(k,1417) * lu(k,3686) - lu(k,3741) = lu(k,3741) - lu(k,1418) * lu(k,3686) - lu(k,3744) = lu(k,3744) - lu(k,1419) * lu(k,3686) - lu(k,3745) = lu(k,3745) - lu(k,1420) * lu(k,3686) - lu(k,3749) = lu(k,3749) - lu(k,1421) * lu(k,3686) - lu(k,3750) = lu(k,3750) - lu(k,1422) * lu(k,3686) - lu(k,3752) = lu(k,3752) - lu(k,1423) * lu(k,3686) - lu(k,3753) = lu(k,3753) - lu(k,1424) * lu(k,3686) - lu(k,3755) = lu(k,3755) - lu(k,1425) * lu(k,3686) - lu(k,3756) = lu(k,3756) - lu(k,1426) * lu(k,3686) - lu(k,3821) = lu(k,3821) - lu(k,1417) * lu(k,3816) - lu(k,3822) = lu(k,3822) - lu(k,1418) * lu(k,3816) - lu(k,3825) = lu(k,3825) - lu(k,1419) * lu(k,3816) - lu(k,3826) = - lu(k,1420) * lu(k,3816) - lu(k,3830) = lu(k,3830) - lu(k,1421) * lu(k,3816) - lu(k,3831) = lu(k,3831) - lu(k,1422) * lu(k,3816) - lu(k,3833) = lu(k,3833) - lu(k,1423) * lu(k,3816) - lu(k,3834) = lu(k,3834) - lu(k,1424) * lu(k,3816) - lu(k,3836) = lu(k,3836) - lu(k,1425) * lu(k,3816) - lu(k,3837) = lu(k,3837) - lu(k,1426) * lu(k,3816) - lu(k,3846) = lu(k,3846) - lu(k,1417) * lu(k,3843) - lu(k,3847) = lu(k,3847) - lu(k,1418) * lu(k,3843) - lu(k,3850) = lu(k,3850) - lu(k,1419) * lu(k,3843) - lu(k,3851) = lu(k,3851) - lu(k,1420) * lu(k,3843) - lu(k,3855) = lu(k,3855) - lu(k,1421) * lu(k,3843) - lu(k,3856) = lu(k,3856) - lu(k,1422) * lu(k,3843) - lu(k,3858) = lu(k,3858) - lu(k,1423) * lu(k,3843) - lu(k,3859) = - lu(k,1424) * lu(k,3843) - lu(k,3861) = - lu(k,1425) * lu(k,3843) - lu(k,3862) = lu(k,3862) - lu(k,1426) * lu(k,3843) + lu(k,1459) = 1._r8 / lu(k,1459) + lu(k,1460) = lu(k,1460) * lu(k,1459) + lu(k,1461) = lu(k,1461) * lu(k,1459) + lu(k,1462) = lu(k,1462) * lu(k,1459) + lu(k,1463) = lu(k,1463) * lu(k,1459) + lu(k,1464) = lu(k,1464) * lu(k,1459) + lu(k,1465) = lu(k,1465) * lu(k,1459) + lu(k,1544) = lu(k,1544) - lu(k,1460) * lu(k,1540) + lu(k,1545) = lu(k,1545) - lu(k,1461) * lu(k,1540) + lu(k,1546) = lu(k,1546) - lu(k,1462) * lu(k,1540) + lu(k,1550) = lu(k,1550) - lu(k,1463) * lu(k,1540) + lu(k,1551) = lu(k,1551) - lu(k,1464) * lu(k,1540) + lu(k,1552) = lu(k,1552) - lu(k,1465) * lu(k,1540) + lu(k,1768) = lu(k,1768) - lu(k,1460) * lu(k,1764) + lu(k,1772) = - lu(k,1461) * lu(k,1764) + lu(k,1773) = lu(k,1773) - lu(k,1462) * lu(k,1764) + lu(k,1778) = lu(k,1778) - lu(k,1463) * lu(k,1764) + lu(k,1780) = lu(k,1780) - lu(k,1464) * lu(k,1764) + lu(k,1781) = lu(k,1781) - lu(k,1465) * lu(k,1764) + lu(k,1790) = lu(k,1790) - lu(k,1460) * lu(k,1784) + lu(k,1792) = lu(k,1792) - lu(k,1461) * lu(k,1784) + lu(k,1793) = lu(k,1793) - lu(k,1462) * lu(k,1784) + lu(k,1796) = - lu(k,1463) * lu(k,1784) + lu(k,1798) = - lu(k,1464) * lu(k,1784) + lu(k,1799) = lu(k,1799) - lu(k,1465) * lu(k,1784) + lu(k,1814) = lu(k,1814) - lu(k,1460) * lu(k,1808) + lu(k,1818) = lu(k,1818) - lu(k,1461) * lu(k,1808) + lu(k,1819) = lu(k,1819) - lu(k,1462) * lu(k,1808) + lu(k,1826) = lu(k,1826) - lu(k,1463) * lu(k,1808) + lu(k,1828) = lu(k,1828) - lu(k,1464) * lu(k,1808) + lu(k,1829) = lu(k,1829) - lu(k,1465) * lu(k,1808) + lu(k,1891) = lu(k,1891) - lu(k,1460) * lu(k,1885) + lu(k,1895) = lu(k,1895) - lu(k,1461) * lu(k,1885) + lu(k,1896) = lu(k,1896) - lu(k,1462) * lu(k,1885) + lu(k,1904) = lu(k,1904) - lu(k,1463) * lu(k,1885) + lu(k,1906) = lu(k,1906) - lu(k,1464) * lu(k,1885) + lu(k,1907) = lu(k,1907) - lu(k,1465) * lu(k,1885) + lu(k,2104) = - lu(k,1460) * lu(k,2094) + lu(k,2107) = lu(k,2107) - lu(k,1461) * lu(k,2094) + lu(k,2108) = lu(k,2108) - lu(k,1462) * lu(k,2094) + lu(k,2117) = lu(k,2117) - lu(k,1463) * lu(k,2094) + lu(k,2119) = lu(k,2119) - lu(k,1464) * lu(k,2094) + lu(k,2120) = lu(k,2120) - lu(k,1465) * lu(k,2094) + lu(k,2981) = lu(k,2981) - lu(k,1460) * lu(k,2967) + lu(k,2987) = lu(k,2987) - lu(k,1461) * lu(k,2967) + lu(k,2988) = lu(k,2988) - lu(k,1462) * lu(k,2967) + lu(k,3028) = lu(k,3028) - lu(k,1463) * lu(k,2967) + lu(k,3030) = lu(k,3030) - lu(k,1464) * lu(k,2967) + lu(k,3031) = lu(k,3031) - lu(k,1465) * lu(k,2967) + lu(k,3262) = lu(k,3262) - lu(k,1460) * lu(k,3241) + lu(k,3269) = lu(k,3269) - lu(k,1461) * lu(k,3241) + lu(k,3270) = lu(k,3270) - lu(k,1462) * lu(k,3241) + lu(k,3313) = lu(k,3313) - lu(k,1463) * lu(k,3241) + lu(k,3315) = lu(k,3315) - lu(k,1464) * lu(k,3241) + lu(k,3316) = lu(k,3316) - lu(k,1465) * lu(k,3241) + lu(k,3518) = lu(k,3518) - lu(k,1460) * lu(k,3495) + lu(k,3525) = lu(k,3525) - lu(k,1461) * lu(k,3495) + lu(k,3526) = lu(k,3526) - lu(k,1462) * lu(k,3495) + lu(k,3569) = lu(k,3569) - lu(k,1463) * lu(k,3495) + lu(k,3571) = lu(k,3571) - lu(k,1464) * lu(k,3495) + lu(k,3572) = lu(k,3572) - lu(k,1465) * lu(k,3495) + lu(k,3769) = lu(k,3769) - lu(k,1460) * lu(k,3744) + lu(k,3776) = lu(k,3776) - lu(k,1461) * lu(k,3744) + lu(k,3777) = lu(k,3777) - lu(k,1462) * lu(k,3744) + lu(k,3819) = lu(k,3819) - lu(k,1463) * lu(k,3744) + lu(k,3821) = lu(k,3821) - lu(k,1464) * lu(k,3744) + lu(k,3822) = lu(k,3822) - lu(k,1465) * lu(k,3744) + lu(k,3997) = lu(k,3997) - lu(k,1460) * lu(k,3978) + lu(k,4004) = lu(k,4004) - lu(k,1461) * lu(k,3978) + lu(k,4005) = lu(k,4005) - lu(k,1462) * lu(k,3978) + lu(k,4046) = lu(k,4046) - lu(k,1463) * lu(k,3978) + lu(k,4048) = lu(k,4048) - lu(k,1464) * lu(k,3978) + lu(k,4049) = lu(k,4049) - lu(k,1465) * lu(k,3978) + lu(k,1466) = 1._r8 / lu(k,1466) + lu(k,1467) = lu(k,1467) * lu(k,1466) + lu(k,1468) = lu(k,1468) * lu(k,1466) + lu(k,1469) = lu(k,1469) * lu(k,1466) + lu(k,1470) = lu(k,1470) * lu(k,1466) + lu(k,1471) = lu(k,1471) * lu(k,1466) + lu(k,1472) = lu(k,1472) * lu(k,1466) + lu(k,1574) = - lu(k,1467) * lu(k,1565) + lu(k,1576) = lu(k,1576) - lu(k,1468) * lu(k,1565) + lu(k,1577) = - lu(k,1469) * lu(k,1565) + lu(k,1590) = lu(k,1590) - lu(k,1470) * lu(k,1565) + lu(k,1591) = lu(k,1591) - lu(k,1471) * lu(k,1565) + lu(k,1593) = lu(k,1593) - lu(k,1472) * lu(k,1565) + lu(k,1639) = lu(k,1639) - lu(k,1467) * lu(k,1634) + lu(k,1641) = lu(k,1641) - lu(k,1468) * lu(k,1634) + lu(k,1642) = - lu(k,1469) * lu(k,1634) + lu(k,1651) = lu(k,1651) - lu(k,1470) * lu(k,1634) + lu(k,1652) = lu(k,1652) - lu(k,1471) * lu(k,1634) + lu(k,1653) = lu(k,1653) - lu(k,1472) * lu(k,1634) + lu(k,1948) = lu(k,1948) - lu(k,1467) * lu(k,1944) + lu(k,1951) = lu(k,1951) - lu(k,1468) * lu(k,1944) + lu(k,1952) = lu(k,1952) - lu(k,1469) * lu(k,1944) + lu(k,1969) = lu(k,1969) - lu(k,1470) * lu(k,1944) + lu(k,1970) = lu(k,1970) - lu(k,1471) * lu(k,1944) + lu(k,1973) = lu(k,1973) - lu(k,1472) * lu(k,1944) + lu(k,1985) = lu(k,1985) - lu(k,1467) * lu(k,1980) + lu(k,1987) = lu(k,1987) - lu(k,1468) * lu(k,1980) + lu(k,1989) = lu(k,1989) - lu(k,1469) * lu(k,1980) + lu(k,2008) = lu(k,2008) - lu(k,1470) * lu(k,1980) + lu(k,2009) = lu(k,2009) - lu(k,1471) * lu(k,1980) + lu(k,2012) = lu(k,2012) - lu(k,1472) * lu(k,1980) + lu(k,2070) = - lu(k,1467) * lu(k,2063) + lu(k,2072) = lu(k,2072) - lu(k,1468) * lu(k,2063) + lu(k,2073) = - lu(k,1469) * lu(k,2063) + lu(k,2087) = lu(k,2087) - lu(k,1470) * lu(k,2063) + lu(k,2088) = lu(k,2088) - lu(k,1471) * lu(k,2063) + lu(k,2091) = lu(k,2091) - lu(k,1472) * lu(k,2063) + lu(k,2102) = lu(k,2102) - lu(k,1467) * lu(k,2095) + lu(k,2104) = lu(k,2104) - lu(k,1468) * lu(k,2095) + lu(k,2105) = - lu(k,1469) * lu(k,2095) + lu(k,2119) = lu(k,2119) - lu(k,1470) * lu(k,2095) + lu(k,2120) = lu(k,2120) - lu(k,1471) * lu(k,2095) + lu(k,2123) = lu(k,2123) - lu(k,1472) * lu(k,2095) + lu(k,2168) = lu(k,2168) - lu(k,1467) * lu(k,2161) + lu(k,2170) = lu(k,2170) - lu(k,1468) * lu(k,2161) + lu(k,2171) = - lu(k,1469) * lu(k,2161) + lu(k,2190) = lu(k,2190) - lu(k,1470) * lu(k,2161) + lu(k,2191) = lu(k,2191) - lu(k,1471) * lu(k,2161) + lu(k,2195) = lu(k,2195) - lu(k,1472) * lu(k,2161) + lu(k,3258) = lu(k,3258) - lu(k,1467) * lu(k,3242) + lu(k,3262) = lu(k,3262) - lu(k,1468) * lu(k,3242) + lu(k,3264) = lu(k,3264) - lu(k,1469) * lu(k,3242) + lu(k,3315) = lu(k,3315) - lu(k,1470) * lu(k,3242) + lu(k,3316) = lu(k,3316) - lu(k,1471) * lu(k,3242) + lu(k,3320) = lu(k,3320) - lu(k,1472) * lu(k,3242) + lu(k,3514) = lu(k,3514) - lu(k,1467) * lu(k,3496) + lu(k,3518) = lu(k,3518) - lu(k,1468) * lu(k,3496) + lu(k,3520) = lu(k,3520) - lu(k,1469) * lu(k,3496) + lu(k,3571) = lu(k,3571) - lu(k,1470) * lu(k,3496) + lu(k,3572) = lu(k,3572) - lu(k,1471) * lu(k,3496) + lu(k,3576) = lu(k,3576) - lu(k,1472) * lu(k,3496) + lu(k,3765) = lu(k,3765) - lu(k,1467) * lu(k,3745) + lu(k,3769) = lu(k,3769) - lu(k,1468) * lu(k,3745) + lu(k,3771) = lu(k,3771) - lu(k,1469) * lu(k,3745) + lu(k,3821) = lu(k,3821) - lu(k,1470) * lu(k,3745) + lu(k,3822) = lu(k,3822) - lu(k,1471) * lu(k,3745) + lu(k,3826) = lu(k,3826) - lu(k,1472) * lu(k,3745) + lu(k,3993) = lu(k,3993) - lu(k,1467) * lu(k,3979) + lu(k,3997) = lu(k,3997) - lu(k,1468) * lu(k,3979) + lu(k,3999) = - lu(k,1469) * lu(k,3979) + lu(k,4048) = lu(k,4048) - lu(k,1470) * lu(k,3979) + lu(k,4049) = lu(k,4049) - lu(k,1471) * lu(k,3979) + lu(k,4053) = lu(k,4053) - lu(k,1472) * lu(k,3979) + lu(k,1474) = 1._r8 / lu(k,1474) + lu(k,1475) = lu(k,1475) * lu(k,1474) + lu(k,1476) = lu(k,1476) * lu(k,1474) + lu(k,1477) = lu(k,1477) * lu(k,1474) + lu(k,1478) = lu(k,1478) * lu(k,1474) + lu(k,1523) = - lu(k,1475) * lu(k,1521) + lu(k,1528) = lu(k,1528) - lu(k,1476) * lu(k,1521) + lu(k,1531) = lu(k,1531) - lu(k,1477) * lu(k,1521) + lu(k,1532) = lu(k,1532) - lu(k,1478) * lu(k,1521) + lu(k,1571) = lu(k,1571) - lu(k,1475) * lu(k,1566) + lu(k,1579) = lu(k,1579) - lu(k,1476) * lu(k,1566) + lu(k,1590) = lu(k,1590) - lu(k,1477) * lu(k,1566) + lu(k,1591) = lu(k,1591) - lu(k,1478) * lu(k,1566) + lu(k,1637) = lu(k,1637) - lu(k,1475) * lu(k,1635) + lu(k,1644) = lu(k,1644) - lu(k,1476) * lu(k,1635) + lu(k,1651) = lu(k,1651) - lu(k,1477) * lu(k,1635) + lu(k,1652) = lu(k,1652) - lu(k,1478) * lu(k,1635) + lu(k,1656) = - lu(k,1475) * lu(k,1655) + lu(k,1662) = lu(k,1662) - lu(k,1476) * lu(k,1655) + lu(k,1666) = lu(k,1666) - lu(k,1477) * lu(k,1655) + lu(k,1667) = lu(k,1667) - lu(k,1478) * lu(k,1655) + lu(k,1709) = lu(k,1709) - lu(k,1475) * lu(k,1708) + lu(k,1711) = lu(k,1711) - lu(k,1476) * lu(k,1708) + lu(k,1714) = lu(k,1714) - lu(k,1477) * lu(k,1708) + lu(k,1715) = lu(k,1715) - lu(k,1478) * lu(k,1708) + lu(k,1787) = - lu(k,1475) * lu(k,1785) + lu(k,1793) = lu(k,1793) - lu(k,1476) * lu(k,1785) + lu(k,1798) = lu(k,1798) - lu(k,1477) * lu(k,1785) + lu(k,1799) = lu(k,1799) - lu(k,1478) * lu(k,1785) + lu(k,1866) = lu(k,1866) - lu(k,1475) * lu(k,1865) + lu(k,1872) = lu(k,1872) - lu(k,1476) * lu(k,1865) + lu(k,1878) = lu(k,1878) - lu(k,1477) * lu(k,1865) + lu(k,1879) = lu(k,1879) - lu(k,1478) * lu(k,1865) + lu(k,1889) = - lu(k,1475) * lu(k,1886) + lu(k,1896) = lu(k,1896) - lu(k,1476) * lu(k,1886) + lu(k,1906) = lu(k,1906) - lu(k,1477) * lu(k,1886) + lu(k,1907) = lu(k,1907) - lu(k,1478) * lu(k,1886) + lu(k,2068) = lu(k,2068) - lu(k,1475) * lu(k,2064) + lu(k,2076) = lu(k,2076) - lu(k,1476) * lu(k,2064) + lu(k,2087) = lu(k,2087) - lu(k,1477) * lu(k,2064) + lu(k,2088) = lu(k,2088) - lu(k,1478) * lu(k,2064) + lu(k,2100) = - lu(k,1475) * lu(k,2096) + lu(k,2108) = lu(k,2108) - lu(k,1476) * lu(k,2096) + lu(k,2119) = lu(k,2119) - lu(k,1477) * lu(k,2096) + lu(k,2120) = lu(k,2120) - lu(k,1478) * lu(k,2096) + lu(k,2130) = lu(k,2130) - lu(k,1475) * lu(k,2127) + lu(k,2138) = lu(k,2138) - lu(k,1476) * lu(k,2127) + lu(k,2148) = lu(k,2148) - lu(k,1477) * lu(k,2127) + lu(k,2149) = lu(k,2149) - lu(k,1478) * lu(k,2127) + lu(k,3074) = lu(k,3074) - lu(k,1475) * lu(k,3068) + lu(k,3089) = lu(k,3089) - lu(k,1476) * lu(k,3068) + lu(k,3133) = lu(k,3133) - lu(k,1477) * lu(k,3068) + lu(k,3134) = lu(k,3134) - lu(k,1478) * lu(k,3068) + lu(k,3252) = lu(k,3252) - lu(k,1475) * lu(k,3243) + lu(k,3270) = lu(k,3270) - lu(k,1476) * lu(k,3243) + lu(k,3315) = lu(k,3315) - lu(k,1477) * lu(k,3243) + lu(k,3316) = lu(k,3316) - lu(k,1478) * lu(k,3243) + lu(k,3507) = lu(k,3507) - lu(k,1475) * lu(k,3497) + lu(k,3526) = lu(k,3526) - lu(k,1476) * lu(k,3497) + lu(k,3571) = lu(k,3571) - lu(k,1477) * lu(k,3497) + lu(k,3572) = lu(k,3572) - lu(k,1478) * lu(k,3497) + lu(k,3758) = lu(k,3758) - lu(k,1475) * lu(k,3746) + lu(k,3777) = lu(k,3777) - lu(k,1476) * lu(k,3746) + lu(k,3821) = lu(k,3821) - lu(k,1477) * lu(k,3746) + lu(k,3822) = lu(k,3822) - lu(k,1478) * lu(k,3746) + lu(k,3845) = lu(k,3845) - lu(k,1475) * lu(k,3842) + lu(k,3848) = lu(k,3848) - lu(k,1476) * lu(k,3842) + lu(k,3862) = lu(k,3862) - lu(k,1477) * lu(k,3842) + lu(k,3863) = lu(k,3863) - lu(k,1478) * lu(k,3842) + lu(k,4078) = lu(k,4078) - lu(k,1475) * lu(k,4076) + lu(k,4082) = lu(k,4082) - lu(k,1476) * lu(k,4076) + lu(k,4100) = lu(k,4100) - lu(k,1477) * lu(k,4076) + lu(k,4101) = lu(k,4101) - lu(k,1478) * lu(k,4076) + lu(k,1479) = 1._r8 / lu(k,1479) + lu(k,1480) = lu(k,1480) * lu(k,1479) + lu(k,1481) = lu(k,1481) * lu(k,1479) + lu(k,1482) = lu(k,1482) * lu(k,1479) + lu(k,1483) = lu(k,1483) * lu(k,1479) + lu(k,1484) = lu(k,1484) * lu(k,1479) + lu(k,1578) = lu(k,1578) - lu(k,1480) * lu(k,1567) + lu(k,1583) = lu(k,1583) - lu(k,1481) * lu(k,1567) + lu(k,1588) = lu(k,1588) - lu(k,1482) * lu(k,1567) + lu(k,1591) = lu(k,1591) - lu(k,1483) * lu(k,1567) + lu(k,1593) = lu(k,1593) - lu(k,1484) * lu(k,1567) + lu(k,1643) = lu(k,1643) - lu(k,1480) * lu(k,1636) + lu(k,1646) = - lu(k,1481) * lu(k,1636) + lu(k,1649) = lu(k,1649) - lu(k,1482) * lu(k,1636) + lu(k,1652) = lu(k,1652) - lu(k,1483) * lu(k,1636) + lu(k,1653) = lu(k,1653) - lu(k,1484) * lu(k,1636) + lu(k,1727) = lu(k,1727) - lu(k,1480) * lu(k,1724) + lu(k,1729) = - lu(k,1481) * lu(k,1724) + lu(k,1730) = lu(k,1730) - lu(k,1482) * lu(k,1724) + lu(k,1732) = lu(k,1732) - lu(k,1483) * lu(k,1724) + lu(k,1733) = lu(k,1733) - lu(k,1484) * lu(k,1724) + lu(k,1927) = lu(k,1927) - lu(k,1480) * lu(k,1924) + lu(k,1930) = lu(k,1930) - lu(k,1481) * lu(k,1924) + lu(k,1932) = lu(k,1932) - lu(k,1482) * lu(k,1924) + lu(k,1935) = lu(k,1935) - lu(k,1483) * lu(k,1924) + lu(k,1937) = lu(k,1937) - lu(k,1484) * lu(k,1924) + lu(k,2044) = lu(k,2044) - lu(k,1480) * lu(k,2039) + lu(k,2049) = lu(k,2049) - lu(k,1481) * lu(k,2039) + lu(k,2053) = lu(k,2053) - lu(k,1482) * lu(k,2039) + lu(k,2056) = lu(k,2056) - lu(k,1483) * lu(k,2039) + lu(k,2059) = lu(k,2059) - lu(k,1484) * lu(k,2039) + lu(k,2107) = lu(k,2107) - lu(k,1480) * lu(k,2097) + lu(k,2112) = - lu(k,1481) * lu(k,2097) + lu(k,2117) = lu(k,2117) - lu(k,1482) * lu(k,2097) + lu(k,2120) = lu(k,2120) - lu(k,1483) * lu(k,2097) + lu(k,2123) = lu(k,2123) - lu(k,1484) * lu(k,2097) + lu(k,2137) = lu(k,2137) - lu(k,1480) * lu(k,2128) + lu(k,2141) = lu(k,2141) - lu(k,1481) * lu(k,2128) + lu(k,2146) = lu(k,2146) - lu(k,1482) * lu(k,2128) + lu(k,2149) = lu(k,2149) - lu(k,1483) * lu(k,2128) + lu(k,2152) = lu(k,2152) - lu(k,1484) * lu(k,2128) + lu(k,2172) = lu(k,2172) - lu(k,1480) * lu(k,2162) + lu(k,2183) = lu(k,2183) - lu(k,1481) * lu(k,2162) + lu(k,2188) = lu(k,2188) - lu(k,1482) * lu(k,2162) + lu(k,2191) = lu(k,2191) - lu(k,1483) * lu(k,2162) + lu(k,2195) = lu(k,2195) - lu(k,1484) * lu(k,2162) + lu(k,3088) = lu(k,3088) - lu(k,1480) * lu(k,3069) + lu(k,3126) = lu(k,3126) - lu(k,1481) * lu(k,3069) + lu(k,3131) = lu(k,3131) - lu(k,1482) * lu(k,3069) + lu(k,3134) = lu(k,3134) - lu(k,1483) * lu(k,3069) + lu(k,3138) = lu(k,3138) - lu(k,1484) * lu(k,3069) + lu(k,3269) = lu(k,3269) - lu(k,1480) * lu(k,3244) + lu(k,3308) = lu(k,3308) - lu(k,1481) * lu(k,3244) + lu(k,3313) = lu(k,3313) - lu(k,1482) * lu(k,3244) + lu(k,3316) = lu(k,3316) - lu(k,1483) * lu(k,3244) + lu(k,3320) = lu(k,3320) - lu(k,1484) * lu(k,3244) + lu(k,3525) = lu(k,3525) - lu(k,1480) * lu(k,3498) + lu(k,3564) = lu(k,3564) - lu(k,1481) * lu(k,3498) + lu(k,3569) = lu(k,3569) - lu(k,1482) * lu(k,3498) + lu(k,3572) = lu(k,3572) - lu(k,1483) * lu(k,3498) + lu(k,3576) = lu(k,3576) - lu(k,1484) * lu(k,3498) + lu(k,3776) = lu(k,3776) - lu(k,1480) * lu(k,3747) + lu(k,3814) = lu(k,3814) - lu(k,1481) * lu(k,3747) + lu(k,3819) = lu(k,3819) - lu(k,1482) * lu(k,3747) + lu(k,3822) = lu(k,3822) - lu(k,1483) * lu(k,3747) + lu(k,3826) = lu(k,3826) - lu(k,1484) * lu(k,3747) + lu(k,3910) = lu(k,3910) - lu(k,1480) * lu(k,3891) + lu(k,3949) = lu(k,3949) - lu(k,1481) * lu(k,3891) + lu(k,3954) = lu(k,3954) - lu(k,1482) * lu(k,3891) + lu(k,3957) = lu(k,3957) - lu(k,1483) * lu(k,3891) + lu(k,3961) = lu(k,3961) - lu(k,1484) * lu(k,3891) + lu(k,4004) = lu(k,4004) - lu(k,1480) * lu(k,3980) + lu(k,4041) = lu(k,4041) - lu(k,1481) * lu(k,3980) + lu(k,4046) = lu(k,4046) - lu(k,1482) * lu(k,3980) + lu(k,4049) = lu(k,4049) - lu(k,1483) * lu(k,3980) + lu(k,4053) = lu(k,4053) - lu(k,1484) * lu(k,3980) + lu(k,1485) = 1._r8 / lu(k,1485) + lu(k,1486) = lu(k,1486) * lu(k,1485) + lu(k,1487) = lu(k,1487) * lu(k,1485) + lu(k,1488) = lu(k,1488) * lu(k,1485) + lu(k,1489) = lu(k,1489) * lu(k,1485) + lu(k,1490) = lu(k,1490) * lu(k,1485) + lu(k,1491) = lu(k,1491) * lu(k,1485) + lu(k,1585) = - lu(k,1486) * lu(k,1568) + lu(k,1589) = - lu(k,1487) * lu(k,1568) + lu(k,1590) = lu(k,1590) - lu(k,1488) * lu(k,1568) + lu(k,1591) = lu(k,1591) - lu(k,1489) * lu(k,1568) + lu(k,1592) = - lu(k,1490) * lu(k,1568) + lu(k,1594) = - lu(k,1491) * lu(k,1568) + lu(k,2082) = - lu(k,1486) * lu(k,2065) + lu(k,2086) = - lu(k,1487) * lu(k,2065) + lu(k,2087) = lu(k,2087) - lu(k,1488) * lu(k,2065) + lu(k,2088) = lu(k,2088) - lu(k,1489) * lu(k,2065) + lu(k,2089) = - lu(k,1490) * lu(k,2065) + lu(k,2092) = - lu(k,1491) * lu(k,2065) + lu(k,2114) = - lu(k,1486) * lu(k,2098) + lu(k,2118) = - lu(k,1487) * lu(k,2098) + lu(k,2119) = lu(k,2119) - lu(k,1488) * lu(k,2098) + lu(k,2120) = lu(k,2120) - lu(k,1489) * lu(k,2098) + lu(k,2121) = - lu(k,1490) * lu(k,2098) + lu(k,2124) = - lu(k,1491) * lu(k,2098) + lu(k,2143) = - lu(k,1486) * lu(k,2129) + lu(k,2147) = - lu(k,1487) * lu(k,2129) + lu(k,2148) = lu(k,2148) - lu(k,1488) * lu(k,2129) + lu(k,2149) = lu(k,2149) - lu(k,1489) * lu(k,2129) + lu(k,2150) = - lu(k,1490) * lu(k,2129) + lu(k,2153) = - lu(k,1491) * lu(k,2129) + lu(k,2354) = - lu(k,1486) * lu(k,2344) + lu(k,2358) = - lu(k,1487) * lu(k,2344) + lu(k,2359) = lu(k,2359) - lu(k,1488) * lu(k,2344) + lu(k,2360) = lu(k,2360) - lu(k,1489) * lu(k,2344) + lu(k,2361) = - lu(k,1490) * lu(k,2344) + lu(k,2364) = lu(k,2364) - lu(k,1491) * lu(k,2344) + lu(k,2670) = - lu(k,1486) * lu(k,2657) + lu(k,2674) = - lu(k,1487) * lu(k,2657) + lu(k,2675) = lu(k,2675) - lu(k,1488) * lu(k,2657) + lu(k,2676) = lu(k,2676) - lu(k,1489) * lu(k,2657) + lu(k,2677) = - lu(k,1490) * lu(k,2657) + lu(k,2680) = lu(k,2680) - lu(k,1491) * lu(k,2657) + lu(k,3128) = - lu(k,1486) * lu(k,3070) + lu(k,3132) = lu(k,3132) - lu(k,1487) * lu(k,3070) + lu(k,3133) = lu(k,3133) - lu(k,1488) * lu(k,3070) + lu(k,3134) = lu(k,3134) - lu(k,1489) * lu(k,3070) + lu(k,3135) = lu(k,3135) - lu(k,1490) * lu(k,3070) + lu(k,3139) = lu(k,3139) - lu(k,1491) * lu(k,3070) + lu(k,3386) = lu(k,3386) - lu(k,1486) * lu(k,3375) + lu(k,3390) = lu(k,3390) - lu(k,1487) * lu(k,3375) + lu(k,3391) = lu(k,3391) - lu(k,1488) * lu(k,3375) + lu(k,3392) = lu(k,3392) - lu(k,1489) * lu(k,3375) + lu(k,3393) = lu(k,3393) - lu(k,1490) * lu(k,3375) + lu(k,3397) = lu(k,3397) - lu(k,1491) * lu(k,3375) + lu(k,3566) = lu(k,3566) - lu(k,1486) * lu(k,3499) + lu(k,3570) = lu(k,3570) - lu(k,1487) * lu(k,3499) + lu(k,3571) = lu(k,3571) - lu(k,1488) * lu(k,3499) + lu(k,3572) = lu(k,3572) - lu(k,1489) * lu(k,3499) + lu(k,3573) = lu(k,3573) - lu(k,1490) * lu(k,3499) + lu(k,3577) = lu(k,3577) - lu(k,1491) * lu(k,3499) + lu(k,3816) = lu(k,3816) - lu(k,1486) * lu(k,3748) + lu(k,3820) = lu(k,3820) - lu(k,1487) * lu(k,3748) + lu(k,3821) = lu(k,3821) - lu(k,1488) * lu(k,3748) + lu(k,3822) = lu(k,3822) - lu(k,1489) * lu(k,3748) + lu(k,3823) = lu(k,3823) - lu(k,1490) * lu(k,3748) + lu(k,3827) = lu(k,3827) - lu(k,1491) * lu(k,3748) + lu(k,3857) = lu(k,3857) - lu(k,1486) * lu(k,3843) + lu(k,3861) = lu(k,3861) - lu(k,1487) * lu(k,3843) + lu(k,3862) = lu(k,3862) - lu(k,1488) * lu(k,3843) + lu(k,3863) = lu(k,3863) - lu(k,1489) * lu(k,3843) + lu(k,3864) = lu(k,3864) - lu(k,1490) * lu(k,3843) + lu(k,3868) = lu(k,3868) - lu(k,1491) * lu(k,3843) + lu(k,3951) = - lu(k,1486) * lu(k,3892) + lu(k,3955) = lu(k,3955) - lu(k,1487) * lu(k,3892) + lu(k,3956) = lu(k,3956) - lu(k,1488) * lu(k,3892) + lu(k,3957) = lu(k,3957) - lu(k,1489) * lu(k,3892) + lu(k,3958) = - lu(k,1490) * lu(k,3892) + lu(k,3962) = lu(k,3962) - lu(k,1491) * lu(k,3892) end do end subroutine lu_fac32 subroutine lu_fac33( avec_len, lu ) @@ -6413,425 +6168,367 @@ subroutine lu_fac33( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1439) = 1._r8 / lu(k,1439) - lu(k,1440) = lu(k,1440) * lu(k,1439) - lu(k,1441) = lu(k,1441) * lu(k,1439) - lu(k,1442) = lu(k,1442) * lu(k,1439) - lu(k,1443) = lu(k,1443) * lu(k,1439) - lu(k,1444) = lu(k,1444) * lu(k,1439) - lu(k,1445) = lu(k,1445) * lu(k,1439) - lu(k,1446) = lu(k,1446) * lu(k,1439) - lu(k,1447) = lu(k,1447) * lu(k,1439) - lu(k,1448) = lu(k,1448) * lu(k,1439) - lu(k,1449) = lu(k,1449) * lu(k,1439) - lu(k,1450) = lu(k,1450) * lu(k,1439) - lu(k,1451) = lu(k,1451) * lu(k,1439) - lu(k,1452) = lu(k,1452) * lu(k,1439) - lu(k,1453) = lu(k,1453) * lu(k,1439) - lu(k,1454) = lu(k,1454) * lu(k,1439) - lu(k,1455) = lu(k,1455) * lu(k,1439) - lu(k,1456) = lu(k,1456) * lu(k,1439) - lu(k,1457) = lu(k,1457) * lu(k,1439) - lu(k,1458) = lu(k,1458) * lu(k,1439) - lu(k,1459) = lu(k,1459) * lu(k,1439) - lu(k,1460) = lu(k,1460) * lu(k,1439) - lu(k,1461) = lu(k,1461) * lu(k,1439) - lu(k,1462) = lu(k,1462) * lu(k,1439) - lu(k,2020) = lu(k,2020) - lu(k,1440) * lu(k,2019) - lu(k,2021) = lu(k,2021) - lu(k,1441) * lu(k,2019) - lu(k,2022) = lu(k,2022) - lu(k,1442) * lu(k,2019) - lu(k,2023) = lu(k,2023) - lu(k,1443) * lu(k,2019) - lu(k,2024) = lu(k,2024) - lu(k,1444) * lu(k,2019) - lu(k,2025) = lu(k,2025) - lu(k,1445) * lu(k,2019) - lu(k,2026) = lu(k,2026) - lu(k,1446) * lu(k,2019) - lu(k,2028) = lu(k,2028) - lu(k,1447) * lu(k,2019) - lu(k,2029) = lu(k,2029) - lu(k,1448) * lu(k,2019) - lu(k,2033) = lu(k,2033) - lu(k,1449) * lu(k,2019) - lu(k,2034) = lu(k,2034) - lu(k,1450) * lu(k,2019) - lu(k,2036) = lu(k,2036) - lu(k,1451) * lu(k,2019) - lu(k,2037) = lu(k,2037) - lu(k,1452) * lu(k,2019) - lu(k,2039) = lu(k,2039) - lu(k,1453) * lu(k,2019) - lu(k,2040) = - lu(k,1454) * lu(k,2019) - lu(k,2042) = lu(k,2042) - lu(k,1455) * lu(k,2019) - lu(k,2043) = lu(k,2043) - lu(k,1456) * lu(k,2019) - lu(k,2045) = - lu(k,1457) * lu(k,2019) - lu(k,2046) = lu(k,2046) - lu(k,1458) * lu(k,2019) - lu(k,2047) = lu(k,2047) - lu(k,1459) * lu(k,2019) - lu(k,2048) = - lu(k,1460) * lu(k,2019) - lu(k,2049) = - lu(k,1461) * lu(k,2019) - lu(k,2050) = lu(k,2050) - lu(k,1462) * lu(k,2019) - lu(k,2936) = lu(k,2936) - lu(k,1440) * lu(k,2935) - lu(k,2937) = - lu(k,1441) * lu(k,2935) - lu(k,2939) = - lu(k,1442) * lu(k,2935) - lu(k,2940) = lu(k,2940) - lu(k,1443) * lu(k,2935) - lu(k,2943) = lu(k,2943) - lu(k,1444) * lu(k,2935) - lu(k,2944) = - lu(k,1445) * lu(k,2935) - lu(k,2945) = - lu(k,1446) * lu(k,2935) - lu(k,2953) = - lu(k,1447) * lu(k,2935) - lu(k,2955) = lu(k,2955) - lu(k,1448) * lu(k,2935) - lu(k,2960) = lu(k,2960) - lu(k,1449) * lu(k,2935) - lu(k,2961) = lu(k,2961) - lu(k,1450) * lu(k,2935) - lu(k,2983) = lu(k,2983) - lu(k,1451) * lu(k,2935) - lu(k,2984) = lu(k,2984) - lu(k,1452) * lu(k,2935) - lu(k,2986) = lu(k,2986) - lu(k,1453) * lu(k,2935) - lu(k,2987) = lu(k,2987) - lu(k,1454) * lu(k,2935) - lu(k,2990) = lu(k,2990) - lu(k,1455) * lu(k,2935) - lu(k,2992) = lu(k,2992) - lu(k,1456) * lu(k,2935) - lu(k,2994) = lu(k,2994) - lu(k,1457) * lu(k,2935) - lu(k,2995) = lu(k,2995) - lu(k,1458) * lu(k,2935) - lu(k,2996) = lu(k,2996) - lu(k,1459) * lu(k,2935) - lu(k,2997) = lu(k,2997) - lu(k,1460) * lu(k,2935) - lu(k,2999) = lu(k,2999) - lu(k,1461) * lu(k,2935) - lu(k,3000) = lu(k,3000) - lu(k,1462) * lu(k,2935) - lu(k,3228) = lu(k,3228) - lu(k,1440) * lu(k,3226) - lu(k,3229) = lu(k,3229) - lu(k,1441) * lu(k,3226) - lu(k,3231) = lu(k,3231) - lu(k,1442) * lu(k,3226) - lu(k,3232) = lu(k,3232) - lu(k,1443) * lu(k,3226) - lu(k,3237) = lu(k,3237) - lu(k,1444) * lu(k,3226) - lu(k,3238) = lu(k,3238) - lu(k,1445) * lu(k,3226) - lu(k,3239) = lu(k,3239) - lu(k,1446) * lu(k,3226) - lu(k,3247) = lu(k,3247) - lu(k,1447) * lu(k,3226) - lu(k,3249) = lu(k,3249) - lu(k,1448) * lu(k,3226) - lu(k,3254) = lu(k,3254) - lu(k,1449) * lu(k,3226) - lu(k,3255) = lu(k,3255) - lu(k,1450) * lu(k,3226) - lu(k,3278) = lu(k,3278) - lu(k,1451) * lu(k,3226) - lu(k,3279) = lu(k,3279) - lu(k,1452) * lu(k,3226) - lu(k,3281) = lu(k,3281) - lu(k,1453) * lu(k,3226) - lu(k,3282) = lu(k,3282) - lu(k,1454) * lu(k,3226) - lu(k,3285) = lu(k,3285) - lu(k,1455) * lu(k,3226) - lu(k,3287) = lu(k,3287) - lu(k,1456) * lu(k,3226) - lu(k,3289) = lu(k,3289) - lu(k,1457) * lu(k,3226) - lu(k,3290) = lu(k,3290) - lu(k,1458) * lu(k,3226) - lu(k,3291) = lu(k,3291) - lu(k,1459) * lu(k,3226) - lu(k,3292) = lu(k,3292) - lu(k,1460) * lu(k,3226) - lu(k,3294) = lu(k,3294) - lu(k,1461) * lu(k,3226) - lu(k,3295) = lu(k,3295) - lu(k,1462) * lu(k,3226) - lu(k,3689) = lu(k,3689) - lu(k,1440) * lu(k,3687) - lu(k,3690) = lu(k,3690) - lu(k,1441) * lu(k,3687) - lu(k,3693) = lu(k,3693) - lu(k,1442) * lu(k,3687) - lu(k,3694) = lu(k,3694) - lu(k,1443) * lu(k,3687) - lu(k,3699) = lu(k,3699) - lu(k,1444) * lu(k,3687) - lu(k,3700) = lu(k,3700) - lu(k,1445) * lu(k,3687) - lu(k,3701) = lu(k,3701) - lu(k,1446) * lu(k,3687) - lu(k,3709) = lu(k,3709) - lu(k,1447) * lu(k,3687) - lu(k,3711) = lu(k,3711) - lu(k,1448) * lu(k,3687) - lu(k,3716) = lu(k,3716) - lu(k,1449) * lu(k,3687) - lu(k,3717) = lu(k,3717) - lu(k,1450) * lu(k,3687) - lu(k,3739) = lu(k,3739) - lu(k,1451) * lu(k,3687) - lu(k,3740) = lu(k,3740) - lu(k,1452) * lu(k,3687) - lu(k,3742) = lu(k,3742) - lu(k,1453) * lu(k,3687) - lu(k,3743) = lu(k,3743) - lu(k,1454) * lu(k,3687) - lu(k,3746) = lu(k,3746) - lu(k,1455) * lu(k,3687) - lu(k,3748) = lu(k,3748) - lu(k,1456) * lu(k,3687) - lu(k,3750) = lu(k,3750) - lu(k,1457) * lu(k,3687) - lu(k,3751) = lu(k,3751) - lu(k,1458) * lu(k,3687) - lu(k,3752) = lu(k,3752) - lu(k,1459) * lu(k,3687) - lu(k,3753) = lu(k,3753) - lu(k,1460) * lu(k,3687) - lu(k,3755) = lu(k,3755) - lu(k,1461) * lu(k,3687) - lu(k,3756) = lu(k,3756) - lu(k,1462) * lu(k,3687) - lu(k,1463) = 1._r8 / lu(k,1463) - lu(k,1464) = lu(k,1464) * lu(k,1463) - lu(k,1465) = lu(k,1465) * lu(k,1463) - lu(k,1466) = lu(k,1466) * lu(k,1463) - lu(k,1467) = lu(k,1467) * lu(k,1463) - lu(k,1591) = - lu(k,1464) * lu(k,1589) - lu(k,1595) = lu(k,1595) - lu(k,1465) * lu(k,1589) - lu(k,1596) = lu(k,1596) - lu(k,1466) * lu(k,1589) - lu(k,1597) = lu(k,1597) - lu(k,1467) * lu(k,1589) - lu(k,1604) = lu(k,1604) - lu(k,1464) * lu(k,1602) - lu(k,1608) = lu(k,1608) - lu(k,1465) * lu(k,1602) - lu(k,1609) = lu(k,1609) - lu(k,1466) * lu(k,1602) - lu(k,1610) = lu(k,1610) - lu(k,1467) * lu(k,1602) - lu(k,2098) = lu(k,2098) - lu(k,1464) * lu(k,2095) - lu(k,2109) = lu(k,2109) - lu(k,1465) * lu(k,2095) - lu(k,2112) = lu(k,2112) - lu(k,1466) * lu(k,2095) - lu(k,2113) = lu(k,2113) - lu(k,1467) * lu(k,2095) - lu(k,2120) = lu(k,2120) - lu(k,1464) * lu(k,2118) - lu(k,2131) = lu(k,2131) - lu(k,1465) * lu(k,2118) - lu(k,2134) = lu(k,2134) - lu(k,1466) * lu(k,2118) - lu(k,2135) = lu(k,2135) - lu(k,1467) * lu(k,2118) - lu(k,2180) = lu(k,2180) - lu(k,1464) * lu(k,2177) - lu(k,2188) = lu(k,2188) - lu(k,1465) * lu(k,2177) - lu(k,2190) = lu(k,2190) - lu(k,1466) * lu(k,2177) - lu(k,2191) = lu(k,2191) - lu(k,1467) * lu(k,2177) - lu(k,2213) = lu(k,2213) - lu(k,1464) * lu(k,2207) - lu(k,2227) = lu(k,2227) - lu(k,1465) * lu(k,2207) - lu(k,2230) = lu(k,2230) - lu(k,1466) * lu(k,2207) - lu(k,2231) = lu(k,2231) - lu(k,1467) * lu(k,2207) - lu(k,2242) = lu(k,2242) - lu(k,1464) * lu(k,2236) - lu(k,2256) = lu(k,2256) - lu(k,1465) * lu(k,2236) - lu(k,2259) = lu(k,2259) - lu(k,1466) * lu(k,2236) - lu(k,2260) = lu(k,2260) - lu(k,1467) * lu(k,2236) - lu(k,2270) = lu(k,2270) - lu(k,1464) * lu(k,2265) - lu(k,2285) = lu(k,2285) - lu(k,1465) * lu(k,2265) - lu(k,2288) = lu(k,2288) - lu(k,1466) * lu(k,2265) - lu(k,2289) = lu(k,2289) - lu(k,1467) * lu(k,2265) - lu(k,2302) = lu(k,2302) - lu(k,1464) * lu(k,2299) - lu(k,2317) = lu(k,2317) - lu(k,1465) * lu(k,2299) - lu(k,2320) = lu(k,2320) - lu(k,1466) * lu(k,2299) - lu(k,2321) = lu(k,2321) - lu(k,1467) * lu(k,2299) - lu(k,2331) = lu(k,2331) - lu(k,1464) * lu(k,2329) - lu(k,2344) = lu(k,2344) - lu(k,1465) * lu(k,2329) - lu(k,2347) = lu(k,2347) - lu(k,1466) * lu(k,2329) - lu(k,2348) = lu(k,2348) - lu(k,1467) * lu(k,2329) - lu(k,2362) = lu(k,2362) - lu(k,1464) * lu(k,2358) - lu(k,2378) = lu(k,2378) - lu(k,1465) * lu(k,2358) - lu(k,2381) = lu(k,2381) - lu(k,1466) * lu(k,2358) - lu(k,2382) = lu(k,2382) - lu(k,1467) * lu(k,2358) - lu(k,2419) = - lu(k,1464) * lu(k,2417) - lu(k,2431) = lu(k,2431) - lu(k,1465) * lu(k,2417) - lu(k,2434) = lu(k,2434) - lu(k,1466) * lu(k,2417) - lu(k,2435) = lu(k,2435) - lu(k,1467) * lu(k,2417) - lu(k,2444) = lu(k,2444) - lu(k,1464) * lu(k,2442) - lu(k,2456) = lu(k,2456) - lu(k,1465) * lu(k,2442) - lu(k,2459) = lu(k,2459) - lu(k,1466) * lu(k,2442) - lu(k,2460) = lu(k,2460) - lu(k,1467) * lu(k,2442) - lu(k,2465) = - lu(k,1464) * lu(k,2462) - lu(k,2477) = lu(k,2477) - lu(k,1465) * lu(k,2462) - lu(k,2480) = lu(k,2480) - lu(k,1466) * lu(k,2462) - lu(k,2481) = lu(k,2481) - lu(k,1467) * lu(k,2462) - lu(k,2520) = lu(k,2520) - lu(k,1464) * lu(k,2508) - lu(k,2541) = lu(k,2541) - lu(k,1465) * lu(k,2508) - lu(k,2545) = lu(k,2545) - lu(k,1466) * lu(k,2508) - lu(k,2546) = lu(k,2546) - lu(k,1467) * lu(k,2508) - lu(k,2566) = lu(k,2566) - lu(k,1464) * lu(k,2554) - lu(k,2587) = lu(k,2587) - lu(k,1465) * lu(k,2554) - lu(k,2591) = lu(k,2591) - lu(k,1466) * lu(k,2554) - lu(k,2592) = lu(k,2592) - lu(k,1467) * lu(k,2554) - lu(k,2613) = lu(k,2613) - lu(k,1464) * lu(k,2601) - lu(k,2634) = lu(k,2634) - lu(k,1465) * lu(k,2601) - lu(k,2638) = lu(k,2638) - lu(k,1466) * lu(k,2601) - lu(k,2639) = lu(k,2639) - lu(k,1467) * lu(k,2601) - lu(k,2684) = lu(k,2684) - lu(k,1464) * lu(k,2652) - lu(k,2705) = lu(k,2705) - lu(k,1465) * lu(k,2652) - lu(k,2709) = lu(k,2709) - lu(k,1466) * lu(k,2652) - lu(k,2710) = lu(k,2710) - lu(k,1467) * lu(k,2652) - lu(k,2867) = lu(k,2867) - lu(k,1464) * lu(k,2831) - lu(k,2889) = lu(k,2889) - lu(k,1465) * lu(k,2831) - lu(k,2894) = lu(k,2894) - lu(k,1466) * lu(k,2831) - lu(k,2895) = lu(k,2895) - lu(k,1467) * lu(k,2831) - lu(k,3060) = lu(k,3060) - lu(k,1464) * lu(k,3027) - lu(k,3082) = lu(k,3082) - lu(k,1465) * lu(k,3027) - lu(k,3087) = lu(k,3087) - lu(k,1466) * lu(k,3027) - lu(k,3088) = lu(k,3088) - lu(k,1467) * lu(k,3027) - lu(k,3263) = lu(k,3263) - lu(k,1464) * lu(k,3227) - lu(k,3285) = lu(k,3285) - lu(k,1465) * lu(k,3227) - lu(k,3290) = lu(k,3290) - lu(k,1466) * lu(k,3227) - lu(k,3291) = lu(k,3291) - lu(k,1467) * lu(k,3227) - lu(k,3404) = lu(k,3404) - lu(k,1464) * lu(k,3369) - lu(k,3426) = lu(k,3426) - lu(k,1465) * lu(k,3369) - lu(k,3431) = lu(k,3431) - lu(k,1466) * lu(k,3369) - lu(k,3432) = lu(k,3432) - lu(k,1467) * lu(k,3369) - lu(k,3724) = lu(k,3724) - lu(k,1464) * lu(k,3688) - lu(k,3746) = lu(k,3746) - lu(k,1465) * lu(k,3688) - lu(k,3751) = lu(k,3751) - lu(k,1466) * lu(k,3688) - lu(k,3752) = lu(k,3752) - lu(k,1467) * lu(k,3688) - lu(k,1469) = 1._r8 / lu(k,1469) - lu(k,1470) = lu(k,1470) * lu(k,1469) - lu(k,1471) = lu(k,1471) * lu(k,1469) - lu(k,1472) = lu(k,1472) * lu(k,1469) - lu(k,1473) = lu(k,1473) * lu(k,1469) - lu(k,1481) = lu(k,1481) - lu(k,1470) * lu(k,1479) - lu(k,1490) = lu(k,1490) - lu(k,1471) * lu(k,1479) - lu(k,1491) = lu(k,1491) - lu(k,1472) * lu(k,1479) - lu(k,1493) = lu(k,1493) - lu(k,1473) * lu(k,1479) - lu(k,1530) = lu(k,1530) - lu(k,1470) * lu(k,1528) - lu(k,1536) = lu(k,1536) - lu(k,1471) * lu(k,1528) - lu(k,1537) = - lu(k,1472) * lu(k,1528) - lu(k,1539) = lu(k,1539) - lu(k,1473) * lu(k,1528) - lu(k,1549) = lu(k,1549) - lu(k,1470) * lu(k,1548) - lu(k,1560) = lu(k,1560) - lu(k,1471) * lu(k,1548) - lu(k,1561) = lu(k,1561) - lu(k,1472) * lu(k,1548) - lu(k,1564) = lu(k,1564) - lu(k,1473) * lu(k,1548) - lu(k,1570) = lu(k,1570) - lu(k,1470) * lu(k,1569) - lu(k,1581) = lu(k,1581) - lu(k,1471) * lu(k,1569) - lu(k,1582) = lu(k,1582) - lu(k,1472) * lu(k,1569) - lu(k,1585) = lu(k,1585) - lu(k,1473) * lu(k,1569) - lu(k,1632) = lu(k,1632) - lu(k,1470) * lu(k,1631) - lu(k,1640) = lu(k,1640) - lu(k,1471) * lu(k,1631) - lu(k,1641) = lu(k,1641) - lu(k,1472) * lu(k,1631) - lu(k,1643) = lu(k,1643) - lu(k,1473) * lu(k,1631) - lu(k,1664) = lu(k,1664) - lu(k,1470) * lu(k,1663) - lu(k,1678) = lu(k,1678) - lu(k,1471) * lu(k,1663) - lu(k,1679) = lu(k,1679) - lu(k,1472) * lu(k,1663) - lu(k,1682) = lu(k,1682) - lu(k,1473) * lu(k,1663) - lu(k,1697) = lu(k,1697) - lu(k,1470) * lu(k,1696) - lu(k,1706) = lu(k,1706) - lu(k,1471) * lu(k,1696) - lu(k,1707) = - lu(k,1472) * lu(k,1696) - lu(k,1709) = lu(k,1709) - lu(k,1473) * lu(k,1696) - lu(k,1722) = lu(k,1722) - lu(k,1470) * lu(k,1720) - lu(k,1740) = lu(k,1740) - lu(k,1471) * lu(k,1720) - lu(k,1741) = lu(k,1741) - lu(k,1472) * lu(k,1720) - lu(k,1744) = lu(k,1744) - lu(k,1473) * lu(k,1720) - lu(k,1777) = lu(k,1777) - lu(k,1470) * lu(k,1776) - lu(k,1790) = lu(k,1790) - lu(k,1471) * lu(k,1776) - lu(k,1791) = lu(k,1791) - lu(k,1472) * lu(k,1776) - lu(k,1794) = lu(k,1794) - lu(k,1473) * lu(k,1776) - lu(k,1800) = lu(k,1800) - lu(k,1470) * lu(k,1799) - lu(k,1806) = lu(k,1806) - lu(k,1471) * lu(k,1799) - lu(k,1807) = lu(k,1807) - lu(k,1472) * lu(k,1799) - lu(k,1809) = lu(k,1809) - lu(k,1473) * lu(k,1799) - lu(k,1821) = lu(k,1821) - lu(k,1470) * lu(k,1819) - lu(k,1838) = lu(k,1838) - lu(k,1471) * lu(k,1819) - lu(k,1839) = lu(k,1839) - lu(k,1472) * lu(k,1819) - lu(k,1842) = lu(k,1842) - lu(k,1473) * lu(k,1819) - lu(k,1859) = lu(k,1859) - lu(k,1470) * lu(k,1858) - lu(k,1870) = lu(k,1870) - lu(k,1471) * lu(k,1858) - lu(k,1871) = lu(k,1871) - lu(k,1472) * lu(k,1858) - lu(k,1874) = lu(k,1874) - lu(k,1473) * lu(k,1858) - lu(k,1886) = lu(k,1886) - lu(k,1470) * lu(k,1885) - lu(k,1906) = lu(k,1906) - lu(k,1471) * lu(k,1885) - lu(k,1907) = lu(k,1907) - lu(k,1472) * lu(k,1885) - lu(k,1910) = lu(k,1910) - lu(k,1473) * lu(k,1885) - lu(k,1923) = lu(k,1923) - lu(k,1470) * lu(k,1921) - lu(k,1938) = lu(k,1938) - lu(k,1471) * lu(k,1921) - lu(k,1939) = lu(k,1939) - lu(k,1472) * lu(k,1921) - lu(k,1942) = lu(k,1942) - lu(k,1473) * lu(k,1921) - lu(k,1957) = lu(k,1957) - lu(k,1470) * lu(k,1955) - lu(k,1972) = lu(k,1972) - lu(k,1471) * lu(k,1955) - lu(k,1973) = lu(k,1973) - lu(k,1472) * lu(k,1955) - lu(k,1976) = lu(k,1976) - lu(k,1473) * lu(k,1955) - lu(k,2023) = lu(k,2023) - lu(k,1470) * lu(k,2020) - lu(k,2042) = lu(k,2042) - lu(k,1471) * lu(k,2020) - lu(k,2043) = lu(k,2043) - lu(k,1472) * lu(k,2020) - lu(k,2047) = lu(k,2047) - lu(k,1473) * lu(k,2020) - lu(k,2655) = lu(k,2655) - lu(k,1470) * lu(k,2653) - lu(k,2705) = lu(k,2705) - lu(k,1471) * lu(k,2653) - lu(k,2706) = lu(k,2706) - lu(k,1472) * lu(k,2653) - lu(k,2710) = lu(k,2710) - lu(k,1473) * lu(k,2653) - lu(k,2836) = lu(k,2836) - lu(k,1470) * lu(k,2832) - lu(k,2889) = lu(k,2889) - lu(k,1471) * lu(k,2832) - lu(k,2891) = lu(k,2891) - lu(k,1472) * lu(k,2832) - lu(k,2895) = lu(k,2895) - lu(k,1473) * lu(k,2832) - lu(k,2940) = lu(k,2940) - lu(k,1470) * lu(k,2936) - lu(k,2990) = lu(k,2990) - lu(k,1471) * lu(k,2936) - lu(k,2992) = lu(k,2992) - lu(k,1472) * lu(k,2936) - lu(k,2996) = lu(k,2996) - lu(k,1473) * lu(k,2936) - lu(k,3031) = lu(k,3031) - lu(k,1470) * lu(k,3028) - lu(k,3082) = lu(k,3082) - lu(k,1471) * lu(k,3028) - lu(k,3084) = lu(k,3084) - lu(k,1472) * lu(k,3028) - lu(k,3088) = lu(k,3088) - lu(k,1473) * lu(k,3028) - lu(k,3232) = lu(k,3232) - lu(k,1470) * lu(k,3228) - lu(k,3285) = lu(k,3285) - lu(k,1471) * lu(k,3228) - lu(k,3287) = lu(k,3287) - lu(k,1472) * lu(k,3228) - lu(k,3291) = lu(k,3291) - lu(k,1473) * lu(k,3228) - lu(k,3374) = lu(k,3374) - lu(k,1470) * lu(k,3370) - lu(k,3426) = lu(k,3426) - lu(k,1471) * lu(k,3370) - lu(k,3428) = lu(k,3428) - lu(k,1472) * lu(k,3370) - lu(k,3432) = lu(k,3432) - lu(k,1473) * lu(k,3370) - lu(k,3694) = lu(k,3694) - lu(k,1470) * lu(k,3689) - lu(k,3746) = lu(k,3746) - lu(k,1471) * lu(k,3689) - lu(k,3748) = lu(k,3748) - lu(k,1472) * lu(k,3689) - lu(k,3752) = lu(k,3752) - lu(k,1473) * lu(k,3689) - lu(k,3818) = lu(k,3818) - lu(k,1470) * lu(k,3817) - lu(k,3827) = lu(k,3827) - lu(k,1471) * lu(k,3817) - lu(k,3829) = lu(k,3829) - lu(k,1472) * lu(k,3817) - lu(k,3833) = lu(k,3833) - lu(k,1473) * lu(k,3817) - lu(k,1480) = 1._r8 / lu(k,1480) - lu(k,1481) = lu(k,1481) * lu(k,1480) - lu(k,1482) = lu(k,1482) * lu(k,1480) - lu(k,1483) = lu(k,1483) * lu(k,1480) - lu(k,1484) = lu(k,1484) * lu(k,1480) - lu(k,1485) = lu(k,1485) * lu(k,1480) - lu(k,1486) = lu(k,1486) * lu(k,1480) - lu(k,1487) = lu(k,1487) * lu(k,1480) - lu(k,1488) = lu(k,1488) * lu(k,1480) - lu(k,1489) = lu(k,1489) * lu(k,1480) - lu(k,1490) = lu(k,1490) * lu(k,1480) - lu(k,1491) = lu(k,1491) * lu(k,1480) - lu(k,1492) = lu(k,1492) * lu(k,1480) - lu(k,1493) = lu(k,1493) * lu(k,1480) - lu(k,1986) = lu(k,1986) - lu(k,1481) * lu(k,1985) - lu(k,1987) = lu(k,1987) - lu(k,1482) * lu(k,1985) - lu(k,1988) = lu(k,1988) - lu(k,1483) * lu(k,1985) - lu(k,1989) = - lu(k,1484) * lu(k,1985) - lu(k,1991) = lu(k,1991) - lu(k,1485) * lu(k,1985) - lu(k,1992) = lu(k,1992) - lu(k,1486) * lu(k,1985) - lu(k,1994) = lu(k,1994) - lu(k,1487) * lu(k,1985) - lu(k,1995) = lu(k,1995) - lu(k,1488) * lu(k,1985) - lu(k,1997) = - lu(k,1489) * lu(k,1985) - lu(k,2000) = lu(k,2000) - lu(k,1490) * lu(k,1985) - lu(k,2001) = lu(k,2001) - lu(k,1491) * lu(k,1985) - lu(k,2003) = lu(k,2003) - lu(k,1492) * lu(k,1985) - lu(k,2004) = lu(k,2004) - lu(k,1493) * lu(k,1985) - lu(k,2023) = lu(k,2023) - lu(k,1481) * lu(k,2021) - lu(k,2024) = lu(k,2024) - lu(k,1482) * lu(k,2021) - lu(k,2025) = lu(k,2025) - lu(k,1483) * lu(k,2021) - lu(k,2026) = lu(k,2026) - lu(k,1484) * lu(k,2021) - lu(k,2028) = lu(k,2028) - lu(k,1485) * lu(k,2021) - lu(k,2029) = lu(k,2029) - lu(k,1486) * lu(k,2021) - lu(k,2036) = lu(k,2036) - lu(k,1487) * lu(k,2021) - lu(k,2037) = lu(k,2037) - lu(k,1488) * lu(k,2021) - lu(k,2039) = lu(k,2039) - lu(k,1489) * lu(k,2021) - lu(k,2042) = lu(k,2042) - lu(k,1490) * lu(k,2021) - lu(k,2043) = lu(k,2043) - lu(k,1491) * lu(k,2021) - lu(k,2046) = lu(k,2046) - lu(k,1492) * lu(k,2021) - lu(k,2047) = lu(k,2047) - lu(k,1493) * lu(k,2021) - lu(k,2836) = lu(k,2836) - lu(k,1481) * lu(k,2833) - lu(k,2841) = lu(k,2841) - lu(k,1482) * lu(k,2833) - lu(k,2842) = lu(k,2842) - lu(k,1483) * lu(k,2833) - lu(k,2843) = lu(k,2843) - lu(k,1484) * lu(k,2833) - lu(k,2851) = lu(k,2851) - lu(k,1485) * lu(k,2833) - lu(k,2853) = lu(k,2853) - lu(k,1486) * lu(k,2833) - lu(k,2882) = lu(k,2882) - lu(k,1487) * lu(k,2833) - lu(k,2883) = lu(k,2883) - lu(k,1488) * lu(k,2833) - lu(k,2885) = lu(k,2885) - lu(k,1489) * lu(k,2833) - lu(k,2889) = lu(k,2889) - lu(k,1490) * lu(k,2833) - lu(k,2891) = lu(k,2891) - lu(k,1491) * lu(k,2833) - lu(k,2894) = lu(k,2894) - lu(k,1492) * lu(k,2833) - lu(k,2895) = lu(k,2895) - lu(k,1493) * lu(k,2833) - lu(k,2940) = lu(k,2940) - lu(k,1481) * lu(k,2937) - lu(k,2943) = lu(k,2943) - lu(k,1482) * lu(k,2937) - lu(k,2944) = lu(k,2944) - lu(k,1483) * lu(k,2937) - lu(k,2945) = lu(k,2945) - lu(k,1484) * lu(k,2937) - lu(k,2953) = lu(k,2953) - lu(k,1485) * lu(k,2937) - lu(k,2955) = lu(k,2955) - lu(k,1486) * lu(k,2937) - lu(k,2983) = lu(k,2983) - lu(k,1487) * lu(k,2937) - lu(k,2984) = lu(k,2984) - lu(k,1488) * lu(k,2937) - lu(k,2986) = lu(k,2986) - lu(k,1489) * lu(k,2937) - lu(k,2990) = lu(k,2990) - lu(k,1490) * lu(k,2937) - lu(k,2992) = lu(k,2992) - lu(k,1491) * lu(k,2937) - lu(k,2995) = lu(k,2995) - lu(k,1492) * lu(k,2937) - lu(k,2996) = lu(k,2996) - lu(k,1493) * lu(k,2937) - lu(k,3232) = lu(k,3232) - lu(k,1481) * lu(k,3229) - lu(k,3237) = lu(k,3237) - lu(k,1482) * lu(k,3229) - lu(k,3238) = lu(k,3238) - lu(k,1483) * lu(k,3229) - lu(k,3239) = lu(k,3239) - lu(k,1484) * lu(k,3229) - lu(k,3247) = lu(k,3247) - lu(k,1485) * lu(k,3229) - lu(k,3249) = lu(k,3249) - lu(k,1486) * lu(k,3229) - lu(k,3278) = lu(k,3278) - lu(k,1487) * lu(k,3229) - lu(k,3279) = lu(k,3279) - lu(k,1488) * lu(k,3229) - lu(k,3281) = lu(k,3281) - lu(k,1489) * lu(k,3229) - lu(k,3285) = lu(k,3285) - lu(k,1490) * lu(k,3229) - lu(k,3287) = lu(k,3287) - lu(k,1491) * lu(k,3229) - lu(k,3290) = lu(k,3290) - lu(k,1492) * lu(k,3229) - lu(k,3291) = lu(k,3291) - lu(k,1493) * lu(k,3229) - lu(k,3374) = lu(k,3374) - lu(k,1481) * lu(k,3371) - lu(k,3379) = lu(k,3379) - lu(k,1482) * lu(k,3371) - lu(k,3380) = lu(k,3380) - lu(k,1483) * lu(k,3371) - lu(k,3381) = lu(k,3381) - lu(k,1484) * lu(k,3371) - lu(k,3388) = lu(k,3388) - lu(k,1485) * lu(k,3371) - lu(k,3390) = lu(k,3390) - lu(k,1486) * lu(k,3371) - lu(k,3419) = lu(k,3419) - lu(k,1487) * lu(k,3371) - lu(k,3420) = lu(k,3420) - lu(k,1488) * lu(k,3371) - lu(k,3422) = lu(k,3422) - lu(k,1489) * lu(k,3371) - lu(k,3426) = lu(k,3426) - lu(k,1490) * lu(k,3371) - lu(k,3428) = lu(k,3428) - lu(k,1491) * lu(k,3371) - lu(k,3431) = lu(k,3431) - lu(k,1492) * lu(k,3371) - lu(k,3432) = lu(k,3432) - lu(k,1493) * lu(k,3371) - lu(k,3694) = lu(k,3694) - lu(k,1481) * lu(k,3690) - lu(k,3699) = lu(k,3699) - lu(k,1482) * lu(k,3690) - lu(k,3700) = lu(k,3700) - lu(k,1483) * lu(k,3690) - lu(k,3701) = lu(k,3701) - lu(k,1484) * lu(k,3690) - lu(k,3709) = lu(k,3709) - lu(k,1485) * lu(k,3690) - lu(k,3711) = lu(k,3711) - lu(k,1486) * lu(k,3690) - lu(k,3739) = lu(k,3739) - lu(k,1487) * lu(k,3690) - lu(k,3740) = lu(k,3740) - lu(k,1488) * lu(k,3690) - lu(k,3742) = lu(k,3742) - lu(k,1489) * lu(k,3690) - lu(k,3746) = lu(k,3746) - lu(k,1490) * lu(k,3690) - lu(k,3748) = lu(k,3748) - lu(k,1491) * lu(k,3690) - lu(k,3751) = lu(k,3751) - lu(k,1492) * lu(k,3690) - lu(k,3752) = lu(k,3752) - lu(k,1493) * lu(k,3690) + lu(k,1492) = 1._r8 / lu(k,1492) + lu(k,1493) = lu(k,1493) * lu(k,1492) + lu(k,1494) = lu(k,1494) * lu(k,1492) + lu(k,1495) = lu(k,1495) * lu(k,1492) + lu(k,1514) = lu(k,1514) - lu(k,1493) * lu(k,1504) + lu(k,1515) = lu(k,1515) - lu(k,1494) * lu(k,1504) + lu(k,1516) = lu(k,1516) - lu(k,1495) * lu(k,1504) + lu(k,1750) = lu(k,1750) - lu(k,1493) * lu(k,1736) + lu(k,1752) = lu(k,1752) - lu(k,1494) * lu(k,1736) + lu(k,1753) = lu(k,1753) - lu(k,1495) * lu(k,1736) + lu(k,1778) = lu(k,1778) - lu(k,1493) * lu(k,1765) + lu(k,1780) = lu(k,1780) - lu(k,1494) * lu(k,1765) + lu(k,1781) = lu(k,1781) - lu(k,1495) * lu(k,1765) + lu(k,1826) = lu(k,1826) - lu(k,1493) * lu(k,1809) + lu(k,1828) = lu(k,1828) - lu(k,1494) * lu(k,1809) + lu(k,1829) = lu(k,1829) - lu(k,1495) * lu(k,1809) + lu(k,1857) = lu(k,1857) - lu(k,1493) * lu(k,1840) + lu(k,1859) = lu(k,1859) - lu(k,1494) * lu(k,1840) + lu(k,1860) = lu(k,1860) - lu(k,1495) * lu(k,1840) + lu(k,2006) = lu(k,2006) - lu(k,1493) * lu(k,1981) + lu(k,2008) = lu(k,2008) - lu(k,1494) * lu(k,1981) + lu(k,2009) = lu(k,2009) - lu(k,1495) * lu(k,1981) + lu(k,2188) = lu(k,2188) - lu(k,1493) * lu(k,2163) + lu(k,2190) = lu(k,2190) - lu(k,1494) * lu(k,2163) + lu(k,2191) = lu(k,2191) - lu(k,1495) * lu(k,2163) + lu(k,2223) = lu(k,2223) - lu(k,1493) * lu(k,2210) + lu(k,2225) = lu(k,2225) - lu(k,1494) * lu(k,2210) + lu(k,2226) = lu(k,2226) - lu(k,1495) * lu(k,2210) + lu(k,2281) = lu(k,2281) - lu(k,1493) * lu(k,2273) + lu(k,2283) = lu(k,2283) - lu(k,1494) * lu(k,2273) + lu(k,2284) = lu(k,2284) - lu(k,1495) * lu(k,2273) + lu(k,2307) = lu(k,2307) - lu(k,1493) * lu(k,2291) + lu(k,2309) = lu(k,2309) - lu(k,1494) * lu(k,2291) + lu(k,2310) = lu(k,2310) - lu(k,1495) * lu(k,2291) + lu(k,2334) = lu(k,2334) - lu(k,1493) * lu(k,2318) + lu(k,2336) = lu(k,2336) - lu(k,1494) * lu(k,2318) + lu(k,2337) = lu(k,2337) - lu(k,1495) * lu(k,2318) + lu(k,2393) = lu(k,2393) - lu(k,1493) * lu(k,2375) + lu(k,2395) = lu(k,2395) - lu(k,1494) * lu(k,2375) + lu(k,2396) = lu(k,2396) - lu(k,1495) * lu(k,2375) + lu(k,2477) = lu(k,2477) - lu(k,1493) * lu(k,2455) + lu(k,2479) = lu(k,2479) - lu(k,1494) * lu(k,2455) + lu(k,2480) = lu(k,2480) - lu(k,1495) * lu(k,2455) + lu(k,2511) = lu(k,2511) - lu(k,1493) * lu(k,2491) + lu(k,2513) = lu(k,2513) - lu(k,1494) * lu(k,2491) + lu(k,2514) = lu(k,2514) - lu(k,1495) * lu(k,2491) + lu(k,2540) = lu(k,2540) - lu(k,1493) * lu(k,2523) + lu(k,2542) = lu(k,2542) - lu(k,1494) * lu(k,2523) + lu(k,2543) = lu(k,2543) - lu(k,1495) * lu(k,2523) + lu(k,2712) = lu(k,2712) - lu(k,1493) * lu(k,2687) + lu(k,2714) = lu(k,2714) - lu(k,1494) * lu(k,2687) + lu(k,2715) = lu(k,2715) - lu(k,1495) * lu(k,2687) + lu(k,2737) = lu(k,2737) - lu(k,1493) * lu(k,2723) + lu(k,2739) = lu(k,2739) - lu(k,1494) * lu(k,2723) + lu(k,2740) = lu(k,2740) - lu(k,1495) * lu(k,2723) + lu(k,2815) = lu(k,2815) - lu(k,1493) * lu(k,2792) + lu(k,2817) = lu(k,2817) - lu(k,1494) * lu(k,2792) + lu(k,2818) = lu(k,2818) - lu(k,1495) * lu(k,2792) + lu(k,3131) = lu(k,3131) - lu(k,1493) * lu(k,3071) + lu(k,3133) = lu(k,3133) - lu(k,1494) * lu(k,3071) + lu(k,3134) = lu(k,3134) - lu(k,1495) * lu(k,3071) + lu(k,3313) = lu(k,3313) - lu(k,1493) * lu(k,3245) + lu(k,3315) = lu(k,3315) - lu(k,1494) * lu(k,3245) + lu(k,3316) = lu(k,3316) - lu(k,1495) * lu(k,3245) + lu(k,3569) = lu(k,3569) - lu(k,1493) * lu(k,3500) + lu(k,3571) = lu(k,3571) - lu(k,1494) * lu(k,3500) + lu(k,3572) = lu(k,3572) - lu(k,1495) * lu(k,3500) + lu(k,3819) = lu(k,3819) - lu(k,1493) * lu(k,3749) + lu(k,3821) = lu(k,3821) - lu(k,1494) * lu(k,3749) + lu(k,3822) = lu(k,3822) - lu(k,1495) * lu(k,3749) + lu(k,3860) = lu(k,3860) - lu(k,1493) * lu(k,3844) + lu(k,3862) = lu(k,3862) - lu(k,1494) * lu(k,3844) + lu(k,3863) = lu(k,3863) - lu(k,1495) * lu(k,3844) + lu(k,3954) = lu(k,3954) - lu(k,1493) * lu(k,3893) + lu(k,3956) = lu(k,3956) - lu(k,1494) * lu(k,3893) + lu(k,3957) = lu(k,3957) - lu(k,1495) * lu(k,3893) + lu(k,4046) = lu(k,4046) - lu(k,1493) * lu(k,3981) + lu(k,4048) = lu(k,4048) - lu(k,1494) * lu(k,3981) + lu(k,4049) = lu(k,4049) - lu(k,1495) * lu(k,3981) + lu(k,1496) = 1._r8 / lu(k,1496) + lu(k,1497) = lu(k,1497) * lu(k,1496) + lu(k,1498) = lu(k,1498) * lu(k,1496) + lu(k,1499) = lu(k,1499) * lu(k,1496) + lu(k,1500) = lu(k,1500) * lu(k,1496) + lu(k,1501) = lu(k,1501) * lu(k,1496) + lu(k,1502) = lu(k,1502) * lu(k,1496) + lu(k,1503) = lu(k,1503) * lu(k,1496) + lu(k,1508) = lu(k,1508) - lu(k,1497) * lu(k,1505) + lu(k,1509) = lu(k,1509) - lu(k,1498) * lu(k,1505) + lu(k,1510) = lu(k,1510) - lu(k,1499) * lu(k,1505) + lu(k,1512) = lu(k,1512) - lu(k,1500) * lu(k,1505) + lu(k,1514) = lu(k,1514) - lu(k,1501) * lu(k,1505) + lu(k,1515) = lu(k,1515) - lu(k,1502) * lu(k,1505) + lu(k,1516) = lu(k,1516) - lu(k,1503) * lu(k,1505) + lu(k,1739) = lu(k,1739) - lu(k,1497) * lu(k,1737) + lu(k,1744) = - lu(k,1498) * lu(k,1737) + lu(k,1745) = lu(k,1745) - lu(k,1499) * lu(k,1737) + lu(k,1748) = lu(k,1748) - lu(k,1500) * lu(k,1737) + lu(k,1750) = lu(k,1750) - lu(k,1501) * lu(k,1737) + lu(k,1752) = lu(k,1752) - lu(k,1502) * lu(k,1737) + lu(k,1753) = lu(k,1753) - lu(k,1503) * lu(k,1737) + lu(k,1788) = lu(k,1788) - lu(k,1497) * lu(k,1786) + lu(k,1792) = lu(k,1792) - lu(k,1498) * lu(k,1786) + lu(k,1793) = lu(k,1793) - lu(k,1499) * lu(k,1786) + lu(k,1795) = - lu(k,1500) * lu(k,1786) + lu(k,1796) = lu(k,1796) - lu(k,1501) * lu(k,1786) + lu(k,1798) = lu(k,1798) - lu(k,1502) * lu(k,1786) + lu(k,1799) = lu(k,1799) - lu(k,1503) * lu(k,1786) + lu(k,1844) = lu(k,1844) - lu(k,1497) * lu(k,1841) + lu(k,1849) = lu(k,1849) - lu(k,1498) * lu(k,1841) + lu(k,1850) = lu(k,1850) - lu(k,1499) * lu(k,1841) + lu(k,1855) = lu(k,1855) - lu(k,1500) * lu(k,1841) + lu(k,1857) = lu(k,1857) - lu(k,1501) * lu(k,1841) + lu(k,1859) = lu(k,1859) - lu(k,1502) * lu(k,1841) + lu(k,1860) = lu(k,1860) - lu(k,1503) * lu(k,1841) + lu(k,1890) = lu(k,1890) - lu(k,1497) * lu(k,1887) + lu(k,1895) = lu(k,1895) - lu(k,1498) * lu(k,1887) + lu(k,1896) = lu(k,1896) - lu(k,1499) * lu(k,1887) + lu(k,1902) = - lu(k,1500) * lu(k,1887) + lu(k,1904) = lu(k,1904) - lu(k,1501) * lu(k,1887) + lu(k,1906) = lu(k,1906) - lu(k,1502) * lu(k,1887) + lu(k,1907) = lu(k,1907) - lu(k,1503) * lu(k,1887) + lu(k,2070) = lu(k,2070) - lu(k,1497) * lu(k,2066) + lu(k,2075) = lu(k,2075) - lu(k,1498) * lu(k,2066) + lu(k,2076) = lu(k,2076) - lu(k,1499) * lu(k,2066) + lu(k,2080) = - lu(k,1500) * lu(k,2066) + lu(k,2085) = lu(k,2085) - lu(k,1501) * lu(k,2066) + lu(k,2087) = lu(k,2087) - lu(k,1502) * lu(k,2066) + lu(k,2088) = lu(k,2088) - lu(k,1503) * lu(k,2066) + lu(k,2977) = lu(k,2977) - lu(k,1497) * lu(k,2968) + lu(k,2987) = lu(k,2987) - lu(k,1498) * lu(k,2968) + lu(k,2988) = lu(k,2988) - lu(k,1499) * lu(k,2968) + lu(k,3023) = lu(k,3023) - lu(k,1500) * lu(k,2968) + lu(k,3028) = lu(k,3028) - lu(k,1501) * lu(k,2968) + lu(k,3030) = lu(k,3030) - lu(k,1502) * lu(k,2968) + lu(k,3031) = lu(k,3031) - lu(k,1503) * lu(k,2968) + lu(k,3258) = lu(k,3258) - lu(k,1497) * lu(k,3246) + lu(k,3269) = lu(k,3269) - lu(k,1498) * lu(k,3246) + lu(k,3270) = lu(k,3270) - lu(k,1499) * lu(k,3246) + lu(k,3308) = lu(k,3308) - lu(k,1500) * lu(k,3246) + lu(k,3313) = lu(k,3313) - lu(k,1501) * lu(k,3246) + lu(k,3315) = lu(k,3315) - lu(k,1502) * lu(k,3246) + lu(k,3316) = lu(k,3316) - lu(k,1503) * lu(k,3246) + lu(k,3514) = lu(k,3514) - lu(k,1497) * lu(k,3501) + lu(k,3525) = lu(k,3525) - lu(k,1498) * lu(k,3501) + lu(k,3526) = lu(k,3526) - lu(k,1499) * lu(k,3501) + lu(k,3564) = lu(k,3564) - lu(k,1500) * lu(k,3501) + lu(k,3569) = lu(k,3569) - lu(k,1501) * lu(k,3501) + lu(k,3571) = lu(k,3571) - lu(k,1502) * lu(k,3501) + lu(k,3572) = lu(k,3572) - lu(k,1503) * lu(k,3501) + lu(k,3765) = lu(k,3765) - lu(k,1497) * lu(k,3750) + lu(k,3776) = lu(k,3776) - lu(k,1498) * lu(k,3750) + lu(k,3777) = lu(k,3777) - lu(k,1499) * lu(k,3750) + lu(k,3814) = lu(k,3814) - lu(k,1500) * lu(k,3750) + lu(k,3819) = lu(k,3819) - lu(k,1501) * lu(k,3750) + lu(k,3821) = lu(k,3821) - lu(k,1502) * lu(k,3750) + lu(k,3822) = lu(k,3822) - lu(k,1503) * lu(k,3750) + lu(k,3993) = lu(k,3993) - lu(k,1497) * lu(k,3982) + lu(k,4004) = lu(k,4004) - lu(k,1498) * lu(k,3982) + lu(k,4005) = lu(k,4005) - lu(k,1499) * lu(k,3982) + lu(k,4041) = lu(k,4041) - lu(k,1500) * lu(k,3982) + lu(k,4046) = lu(k,4046) - lu(k,1501) * lu(k,3982) + lu(k,4048) = lu(k,4048) - lu(k,1502) * lu(k,3982) + lu(k,4049) = lu(k,4049) - lu(k,1503) * lu(k,3982) + lu(k,1506) = 1._r8 / lu(k,1506) + lu(k,1507) = lu(k,1507) * lu(k,1506) + lu(k,1508) = lu(k,1508) * lu(k,1506) + lu(k,1509) = lu(k,1509) * lu(k,1506) + lu(k,1510) = lu(k,1510) * lu(k,1506) + lu(k,1511) = lu(k,1511) * lu(k,1506) + lu(k,1512) = lu(k,1512) * lu(k,1506) + lu(k,1513) = lu(k,1513) * lu(k,1506) + lu(k,1514) = lu(k,1514) * lu(k,1506) + lu(k,1515) = lu(k,1515) * lu(k,1506) + lu(k,1516) = lu(k,1516) * lu(k,1506) + lu(k,1517) = lu(k,1517) * lu(k,1506) + lu(k,1518) = lu(k,1518) * lu(k,1506) + lu(k,1843) = lu(k,1843) - lu(k,1507) * lu(k,1842) + lu(k,1844) = lu(k,1844) - lu(k,1508) * lu(k,1842) + lu(k,1849) = lu(k,1849) - lu(k,1509) * lu(k,1842) + lu(k,1850) = lu(k,1850) - lu(k,1510) * lu(k,1842) + lu(k,1851) = - lu(k,1511) * lu(k,1842) + lu(k,1855) = lu(k,1855) - lu(k,1512) * lu(k,1842) + lu(k,1856) = lu(k,1856) - lu(k,1513) * lu(k,1842) + lu(k,1857) = lu(k,1857) - lu(k,1514) * lu(k,1842) + lu(k,1859) = lu(k,1859) - lu(k,1515) * lu(k,1842) + lu(k,1860) = lu(k,1860) - lu(k,1516) * lu(k,1842) + lu(k,1861) = lu(k,1861) - lu(k,1517) * lu(k,1842) + lu(k,1862) = lu(k,1862) - lu(k,1518) * lu(k,1842) + lu(k,2041) = lu(k,2041) - lu(k,1507) * lu(k,2040) + lu(k,2042) = - lu(k,1508) * lu(k,2040) + lu(k,2044) = lu(k,2044) - lu(k,1509) * lu(k,2040) + lu(k,2045) = lu(k,2045) - lu(k,1510) * lu(k,2040) + lu(k,2046) = - lu(k,1511) * lu(k,2040) + lu(k,2049) = lu(k,2049) - lu(k,1512) * lu(k,2040) + lu(k,2051) = lu(k,2051) - lu(k,1513) * lu(k,2040) + lu(k,2053) = lu(k,2053) - lu(k,1514) * lu(k,2040) + lu(k,2055) = lu(k,2055) - lu(k,1515) * lu(k,2040) + lu(k,2056) = lu(k,2056) - lu(k,1516) * lu(k,2040) + lu(k,2058) = lu(k,2058) - lu(k,1517) * lu(k,2040) + lu(k,2059) = lu(k,2059) - lu(k,1518) * lu(k,2040) + lu(k,2973) = lu(k,2973) - lu(k,1507) * lu(k,2969) + lu(k,2977) = lu(k,2977) - lu(k,1508) * lu(k,2969) + lu(k,2987) = lu(k,2987) - lu(k,1509) * lu(k,2969) + lu(k,2988) = lu(k,2988) - lu(k,1510) * lu(k,2969) + lu(k,2989) = - lu(k,1511) * lu(k,2969) + lu(k,3023) = lu(k,3023) - lu(k,1512) * lu(k,2969) + lu(k,3026) = lu(k,3026) - lu(k,1513) * lu(k,2969) + lu(k,3028) = lu(k,3028) - lu(k,1514) * lu(k,2969) + lu(k,3030) = lu(k,3030) - lu(k,1515) * lu(k,2969) + lu(k,3031) = lu(k,3031) - lu(k,1516) * lu(k,2969) + lu(k,3034) = lu(k,3034) - lu(k,1517) * lu(k,2969) + lu(k,3035) = lu(k,3035) - lu(k,1518) * lu(k,2969) + lu(k,3252) = lu(k,3252) - lu(k,1507) * lu(k,3247) + lu(k,3258) = lu(k,3258) - lu(k,1508) * lu(k,3247) + lu(k,3269) = lu(k,3269) - lu(k,1509) * lu(k,3247) + lu(k,3270) = lu(k,3270) - lu(k,1510) * lu(k,3247) + lu(k,3271) = lu(k,3271) - lu(k,1511) * lu(k,3247) + lu(k,3308) = lu(k,3308) - lu(k,1512) * lu(k,3247) + lu(k,3311) = lu(k,3311) - lu(k,1513) * lu(k,3247) + lu(k,3313) = lu(k,3313) - lu(k,1514) * lu(k,3247) + lu(k,3315) = lu(k,3315) - lu(k,1515) * lu(k,3247) + lu(k,3316) = lu(k,3316) - lu(k,1516) * lu(k,3247) + lu(k,3319) = lu(k,3319) - lu(k,1517) * lu(k,3247) + lu(k,3320) = lu(k,3320) - lu(k,1518) * lu(k,3247) + lu(k,3507) = lu(k,3507) - lu(k,1507) * lu(k,3502) + lu(k,3514) = lu(k,3514) - lu(k,1508) * lu(k,3502) + lu(k,3525) = lu(k,3525) - lu(k,1509) * lu(k,3502) + lu(k,3526) = lu(k,3526) - lu(k,1510) * lu(k,3502) + lu(k,3527) = lu(k,3527) - lu(k,1511) * lu(k,3502) + lu(k,3564) = lu(k,3564) - lu(k,1512) * lu(k,3502) + lu(k,3567) = lu(k,3567) - lu(k,1513) * lu(k,3502) + lu(k,3569) = lu(k,3569) - lu(k,1514) * lu(k,3502) + lu(k,3571) = lu(k,3571) - lu(k,1515) * lu(k,3502) + lu(k,3572) = lu(k,3572) - lu(k,1516) * lu(k,3502) + lu(k,3575) = lu(k,3575) - lu(k,1517) * lu(k,3502) + lu(k,3576) = lu(k,3576) - lu(k,1518) * lu(k,3502) + lu(k,3758) = lu(k,3758) - lu(k,1507) * lu(k,3751) + lu(k,3765) = lu(k,3765) - lu(k,1508) * lu(k,3751) + lu(k,3776) = lu(k,3776) - lu(k,1509) * lu(k,3751) + lu(k,3777) = lu(k,3777) - lu(k,1510) * lu(k,3751) + lu(k,3778) = lu(k,3778) - lu(k,1511) * lu(k,3751) + lu(k,3814) = lu(k,3814) - lu(k,1512) * lu(k,3751) + lu(k,3817) = lu(k,3817) - lu(k,1513) * lu(k,3751) + lu(k,3819) = lu(k,3819) - lu(k,1514) * lu(k,3751) + lu(k,3821) = lu(k,3821) - lu(k,1515) * lu(k,3751) + lu(k,3822) = lu(k,3822) - lu(k,1516) * lu(k,3751) + lu(k,3825) = lu(k,3825) - lu(k,1517) * lu(k,3751) + lu(k,3826) = lu(k,3826) - lu(k,1518) * lu(k,3751) + lu(k,3987) = lu(k,3987) - lu(k,1507) * lu(k,3983) + lu(k,3993) = lu(k,3993) - lu(k,1508) * lu(k,3983) + lu(k,4004) = lu(k,4004) - lu(k,1509) * lu(k,3983) + lu(k,4005) = lu(k,4005) - lu(k,1510) * lu(k,3983) + lu(k,4006) = lu(k,4006) - lu(k,1511) * lu(k,3983) + lu(k,4041) = lu(k,4041) - lu(k,1512) * lu(k,3983) + lu(k,4044) = lu(k,4044) - lu(k,1513) * lu(k,3983) + lu(k,4046) = lu(k,4046) - lu(k,1514) * lu(k,3983) + lu(k,4048) = lu(k,4048) - lu(k,1515) * lu(k,3983) + lu(k,4049) = lu(k,4049) - lu(k,1516) * lu(k,3983) + lu(k,4052) = lu(k,4052) - lu(k,1517) * lu(k,3983) + lu(k,4053) = lu(k,4053) - lu(k,1518) * lu(k,3983) + lu(k,1522) = 1._r8 / lu(k,1522) + lu(k,1523) = lu(k,1523) * lu(k,1522) + lu(k,1524) = lu(k,1524) * lu(k,1522) + lu(k,1525) = lu(k,1525) * lu(k,1522) + lu(k,1526) = lu(k,1526) * lu(k,1522) + lu(k,1527) = lu(k,1527) * lu(k,1522) + lu(k,1528) = lu(k,1528) * lu(k,1522) + lu(k,1529) = lu(k,1529) * lu(k,1522) + lu(k,1530) = lu(k,1530) * lu(k,1522) + lu(k,1531) = lu(k,1531) * lu(k,1522) + lu(k,1532) = lu(k,1532) * lu(k,1522) + lu(k,1533) = lu(k,1533) * lu(k,1522) + lu(k,1571) = lu(k,1571) - lu(k,1523) * lu(k,1569) + lu(k,1574) = lu(k,1574) - lu(k,1524) * lu(k,1569) + lu(k,1576) = lu(k,1576) - lu(k,1525) * lu(k,1569) + lu(k,1577) = lu(k,1577) - lu(k,1526) * lu(k,1569) + lu(k,1578) = lu(k,1578) - lu(k,1527) * lu(k,1569) + lu(k,1579) = lu(k,1579) - lu(k,1528) * lu(k,1569) + lu(k,1586) = lu(k,1586) - lu(k,1529) * lu(k,1569) + lu(k,1588) = lu(k,1588) - lu(k,1530) * lu(k,1569) + lu(k,1590) = lu(k,1590) - lu(k,1531) * lu(k,1569) + lu(k,1591) = lu(k,1591) - lu(k,1532) * lu(k,1569) + lu(k,1593) = lu(k,1593) - lu(k,1533) * lu(k,1569) + lu(k,1889) = lu(k,1889) - lu(k,1523) * lu(k,1888) + lu(k,1890) = lu(k,1890) - lu(k,1524) * lu(k,1888) + lu(k,1891) = lu(k,1891) - lu(k,1525) * lu(k,1888) + lu(k,1892) = - lu(k,1526) * lu(k,1888) + lu(k,1895) = lu(k,1895) - lu(k,1527) * lu(k,1888) + lu(k,1896) = lu(k,1896) - lu(k,1528) * lu(k,1888) + lu(k,1903) = - lu(k,1529) * lu(k,1888) + lu(k,1904) = lu(k,1904) - lu(k,1530) * lu(k,1888) + lu(k,1906) = lu(k,1906) - lu(k,1531) * lu(k,1888) + lu(k,1907) = lu(k,1907) - lu(k,1532) * lu(k,1888) + lu(k,1908) = - lu(k,1533) * lu(k,1888) + lu(k,1946) = lu(k,1946) - lu(k,1523) * lu(k,1945) + lu(k,1948) = lu(k,1948) - lu(k,1524) * lu(k,1945) + lu(k,1951) = lu(k,1951) - lu(k,1525) * lu(k,1945) + lu(k,1952) = lu(k,1952) - lu(k,1526) * lu(k,1945) + lu(k,1956) = - lu(k,1527) * lu(k,1945) + lu(k,1957) = - lu(k,1528) * lu(k,1945) + lu(k,1965) = lu(k,1965) - lu(k,1529) * lu(k,1945) + lu(k,1967) = lu(k,1967) - lu(k,1530) * lu(k,1945) + lu(k,1969) = lu(k,1969) - lu(k,1531) * lu(k,1945) + lu(k,1970) = lu(k,1970) - lu(k,1532) * lu(k,1945) + lu(k,1973) = lu(k,1973) - lu(k,1533) * lu(k,1945) + lu(k,1983) = lu(k,1983) - lu(k,1523) * lu(k,1982) + lu(k,1985) = lu(k,1985) - lu(k,1524) * lu(k,1982) + lu(k,1987) = lu(k,1987) - lu(k,1525) * lu(k,1982) + lu(k,1989) = lu(k,1989) - lu(k,1526) * lu(k,1982) + lu(k,1993) = - lu(k,1527) * lu(k,1982) + lu(k,1994) = - lu(k,1528) * lu(k,1982) + lu(k,2004) = lu(k,2004) - lu(k,1529) * lu(k,1982) + lu(k,2006) = lu(k,2006) - lu(k,1530) * lu(k,1982) + lu(k,2008) = lu(k,2008) - lu(k,1531) * lu(k,1982) + lu(k,2009) = lu(k,2009) - lu(k,1532) * lu(k,1982) + lu(k,2012) = lu(k,2012) - lu(k,1533) * lu(k,1982) + lu(k,2068) = lu(k,2068) - lu(k,1523) * lu(k,2067) + lu(k,2070) = lu(k,2070) - lu(k,1524) * lu(k,2067) + lu(k,2072) = lu(k,2072) - lu(k,1525) * lu(k,2067) + lu(k,2073) = lu(k,2073) - lu(k,1526) * lu(k,2067) + lu(k,2075) = lu(k,2075) - lu(k,1527) * lu(k,2067) + lu(k,2076) = lu(k,2076) - lu(k,1528) * lu(k,2067) + lu(k,2083) = lu(k,2083) - lu(k,1529) * lu(k,2067) + lu(k,2085) = lu(k,2085) - lu(k,1530) * lu(k,2067) + lu(k,2087) = lu(k,2087) - lu(k,1531) * lu(k,2067) + lu(k,2088) = lu(k,2088) - lu(k,1532) * lu(k,2067) + lu(k,2091) = lu(k,2091) - lu(k,1533) * lu(k,2067) + lu(k,2100) = lu(k,2100) - lu(k,1523) * lu(k,2099) + lu(k,2102) = lu(k,2102) - lu(k,1524) * lu(k,2099) + lu(k,2104) = lu(k,2104) - lu(k,1525) * lu(k,2099) + lu(k,2105) = lu(k,2105) - lu(k,1526) * lu(k,2099) + lu(k,2107) = lu(k,2107) - lu(k,1527) * lu(k,2099) + lu(k,2108) = lu(k,2108) - lu(k,1528) * lu(k,2099) + lu(k,2115) = lu(k,2115) - lu(k,1529) * lu(k,2099) + lu(k,2117) = lu(k,2117) - lu(k,1530) * lu(k,2099) + lu(k,2119) = lu(k,2119) - lu(k,1531) * lu(k,2099) + lu(k,2120) = lu(k,2120) - lu(k,1532) * lu(k,2099) + lu(k,2123) = lu(k,2123) - lu(k,1533) * lu(k,2099) + lu(k,3252) = lu(k,3252) - lu(k,1523) * lu(k,3248) + lu(k,3258) = lu(k,3258) - lu(k,1524) * lu(k,3248) + lu(k,3262) = lu(k,3262) - lu(k,1525) * lu(k,3248) + lu(k,3264) = lu(k,3264) - lu(k,1526) * lu(k,3248) + lu(k,3269) = lu(k,3269) - lu(k,1527) * lu(k,3248) + lu(k,3270) = lu(k,3270) - lu(k,1528) * lu(k,3248) + lu(k,3311) = lu(k,3311) - lu(k,1529) * lu(k,3248) + lu(k,3313) = lu(k,3313) - lu(k,1530) * lu(k,3248) + lu(k,3315) = lu(k,3315) - lu(k,1531) * lu(k,3248) + lu(k,3316) = lu(k,3316) - lu(k,1532) * lu(k,3248) + lu(k,3320) = lu(k,3320) - lu(k,1533) * lu(k,3248) + lu(k,3758) = lu(k,3758) - lu(k,1523) * lu(k,3752) + lu(k,3765) = lu(k,3765) - lu(k,1524) * lu(k,3752) + lu(k,3769) = lu(k,3769) - lu(k,1525) * lu(k,3752) + lu(k,3771) = lu(k,3771) - lu(k,1526) * lu(k,3752) + lu(k,3776) = lu(k,3776) - lu(k,1527) * lu(k,3752) + lu(k,3777) = lu(k,3777) - lu(k,1528) * lu(k,3752) + lu(k,3817) = lu(k,3817) - lu(k,1529) * lu(k,3752) + lu(k,3819) = lu(k,3819) - lu(k,1530) * lu(k,3752) + lu(k,3821) = lu(k,3821) - lu(k,1531) * lu(k,3752) + lu(k,3822) = lu(k,3822) - lu(k,1532) * lu(k,3752) + lu(k,3826) = lu(k,3826) - lu(k,1533) * lu(k,3752) end do end subroutine lu_fac33 subroutine lu_fac34( avec_len, lu ) @@ -6848,335 +6545,425 @@ subroutine lu_fac34( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1497) = 1._r8 / lu(k,1497) - lu(k,1498) = lu(k,1498) * lu(k,1497) - lu(k,1499) = lu(k,1499) * lu(k,1497) - lu(k,1500) = lu(k,1500) * lu(k,1497) - lu(k,1501) = lu(k,1501) * lu(k,1497) - lu(k,1502) = lu(k,1502) * lu(k,1497) - lu(k,1503) = lu(k,1503) * lu(k,1497) - lu(k,1504) = lu(k,1504) * lu(k,1497) - lu(k,1505) = lu(k,1505) * lu(k,1497) - lu(k,1506) = lu(k,1506) * lu(k,1497) - lu(k,1507) = lu(k,1507) * lu(k,1497) - lu(k,1508) = lu(k,1508) * lu(k,1497) - lu(k,1509) = lu(k,1509) * lu(k,1497) - lu(k,1748) = lu(k,1748) - lu(k,1498) * lu(k,1747) - lu(k,1749) = lu(k,1749) - lu(k,1499) * lu(k,1747) - lu(k,1754) = lu(k,1754) - lu(k,1500) * lu(k,1747) - lu(k,1756) = lu(k,1756) - lu(k,1501) * lu(k,1747) - lu(k,1757) = lu(k,1757) - lu(k,1502) * lu(k,1747) - lu(k,1758) = - lu(k,1503) * lu(k,1747) - lu(k,1759) = lu(k,1759) - lu(k,1504) * lu(k,1747) - lu(k,1760) = lu(k,1760) - lu(k,1505) * lu(k,1747) - lu(k,1761) = lu(k,1761) - lu(k,1506) * lu(k,1747) - lu(k,1762) = lu(k,1762) - lu(k,1507) * lu(k,1747) - lu(k,1763) = lu(k,1763) - lu(k,1508) * lu(k,1747) - lu(k,1764) = lu(k,1764) - lu(k,1509) * lu(k,1747) - lu(k,2655) = lu(k,2655) - lu(k,1498) * lu(k,2654) - lu(k,2660) = lu(k,2660) - lu(k,1499) * lu(k,2654) - lu(k,2699) = lu(k,2699) - lu(k,1500) * lu(k,2654) - lu(k,2702) = lu(k,2702) - lu(k,1501) * lu(k,2654) - lu(k,2703) = lu(k,2703) - lu(k,1502) * lu(k,2654) - lu(k,2704) = lu(k,2704) - lu(k,1503) * lu(k,2654) - lu(k,2705) = lu(k,2705) - lu(k,1504) * lu(k,2654) - lu(k,2706) = lu(k,2706) - lu(k,1505) * lu(k,2654) - lu(k,2707) = lu(k,2707) - lu(k,1506) * lu(k,2654) - lu(k,2709) = lu(k,2709) - lu(k,1507) * lu(k,2654) - lu(k,2710) = lu(k,2710) - lu(k,1508) * lu(k,2654) - lu(k,2713) = lu(k,2713) - lu(k,1509) * lu(k,2654) - lu(k,2836) = lu(k,2836) - lu(k,1498) * lu(k,2834) - lu(k,2841) = lu(k,2841) - lu(k,1499) * lu(k,2834) - lu(k,2882) = lu(k,2882) - lu(k,1500) * lu(k,2834) - lu(k,2885) = lu(k,2885) - lu(k,1501) * lu(k,2834) - lu(k,2886) = lu(k,2886) - lu(k,1502) * lu(k,2834) - lu(k,2887) = lu(k,2887) - lu(k,1503) * lu(k,2834) - lu(k,2889) = lu(k,2889) - lu(k,1504) * lu(k,2834) - lu(k,2891) = lu(k,2891) - lu(k,1505) * lu(k,2834) - lu(k,2892) = lu(k,2892) - lu(k,1506) * lu(k,2834) - lu(k,2894) = lu(k,2894) - lu(k,1507) * lu(k,2834) - lu(k,2895) = lu(k,2895) - lu(k,1508) * lu(k,2834) - lu(k,2899) = lu(k,2899) - lu(k,1509) * lu(k,2834) - lu(k,3031) = lu(k,3031) - lu(k,1498) * lu(k,3029) - lu(k,3036) = lu(k,3036) - lu(k,1499) * lu(k,3029) - lu(k,3075) = lu(k,3075) - lu(k,1500) * lu(k,3029) - lu(k,3078) = lu(k,3078) - lu(k,1501) * lu(k,3029) - lu(k,3079) = lu(k,3079) - lu(k,1502) * lu(k,3029) - lu(k,3080) = lu(k,3080) - lu(k,1503) * lu(k,3029) - lu(k,3082) = lu(k,3082) - lu(k,1504) * lu(k,3029) - lu(k,3084) = lu(k,3084) - lu(k,1505) * lu(k,3029) - lu(k,3085) = lu(k,3085) - lu(k,1506) * lu(k,3029) - lu(k,3087) = lu(k,3087) - lu(k,1507) * lu(k,3029) - lu(k,3088) = lu(k,3088) - lu(k,1508) * lu(k,3029) - lu(k,3092) = lu(k,3092) - lu(k,1509) * lu(k,3029) - lu(k,3232) = lu(k,3232) - lu(k,1498) * lu(k,3230) - lu(k,3237) = lu(k,3237) - lu(k,1499) * lu(k,3230) - lu(k,3278) = lu(k,3278) - lu(k,1500) * lu(k,3230) - lu(k,3281) = lu(k,3281) - lu(k,1501) * lu(k,3230) - lu(k,3282) = lu(k,3282) - lu(k,1502) * lu(k,3230) - lu(k,3283) = lu(k,3283) - lu(k,1503) * lu(k,3230) - lu(k,3285) = lu(k,3285) - lu(k,1504) * lu(k,3230) - lu(k,3287) = lu(k,3287) - lu(k,1505) * lu(k,3230) - lu(k,3288) = lu(k,3288) - lu(k,1506) * lu(k,3230) - lu(k,3290) = lu(k,3290) - lu(k,1507) * lu(k,3230) - lu(k,3291) = lu(k,3291) - lu(k,1508) * lu(k,3230) - lu(k,3295) = lu(k,3295) - lu(k,1509) * lu(k,3230) - lu(k,3374) = lu(k,3374) - lu(k,1498) * lu(k,3372) - lu(k,3379) = lu(k,3379) - lu(k,1499) * lu(k,3372) - lu(k,3419) = lu(k,3419) - lu(k,1500) * lu(k,3372) - lu(k,3422) = lu(k,3422) - lu(k,1501) * lu(k,3372) - lu(k,3423) = - lu(k,1502) * lu(k,3372) - lu(k,3424) = lu(k,3424) - lu(k,1503) * lu(k,3372) - lu(k,3426) = lu(k,3426) - lu(k,1504) * lu(k,3372) - lu(k,3428) = lu(k,3428) - lu(k,1505) * lu(k,3372) - lu(k,3429) = lu(k,3429) - lu(k,1506) * lu(k,3372) - lu(k,3431) = lu(k,3431) - lu(k,1507) * lu(k,3372) - lu(k,3432) = lu(k,3432) - lu(k,1508) * lu(k,3372) - lu(k,3436) = lu(k,3436) - lu(k,1509) * lu(k,3372) - lu(k,3490) = lu(k,3490) - lu(k,1498) * lu(k,3488) - lu(k,3491) = lu(k,3491) - lu(k,1499) * lu(k,3488) - lu(k,3499) = lu(k,3499) - lu(k,1500) * lu(k,3488) - lu(k,3502) = lu(k,3502) - lu(k,1501) * lu(k,3488) - lu(k,3503) = lu(k,3503) - lu(k,1502) * lu(k,3488) - lu(k,3504) = lu(k,3504) - lu(k,1503) * lu(k,3488) - lu(k,3506) = lu(k,3506) - lu(k,1504) * lu(k,3488) - lu(k,3508) = lu(k,3508) - lu(k,1505) * lu(k,3488) - lu(k,3509) = lu(k,3509) - lu(k,1506) * lu(k,3488) - lu(k,3511) = lu(k,3511) - lu(k,1507) * lu(k,3488) - lu(k,3512) = lu(k,3512) - lu(k,1508) * lu(k,3488) - lu(k,3516) = lu(k,3516) - lu(k,1509) * lu(k,3488) - lu(k,3694) = lu(k,3694) - lu(k,1498) * lu(k,3691) - lu(k,3699) = lu(k,3699) - lu(k,1499) * lu(k,3691) - lu(k,3739) = lu(k,3739) - lu(k,1500) * lu(k,3691) - lu(k,3742) = lu(k,3742) - lu(k,1501) * lu(k,3691) - lu(k,3743) = lu(k,3743) - lu(k,1502) * lu(k,3691) - lu(k,3744) = lu(k,3744) - lu(k,1503) * lu(k,3691) - lu(k,3746) = lu(k,3746) - lu(k,1504) * lu(k,3691) - lu(k,3748) = lu(k,3748) - lu(k,1505) * lu(k,3691) - lu(k,3749) = lu(k,3749) - lu(k,1506) * lu(k,3691) - lu(k,3751) = lu(k,3751) - lu(k,1507) * lu(k,3691) - lu(k,3752) = lu(k,3752) - lu(k,1508) * lu(k,3691) - lu(k,3756) = lu(k,3756) - lu(k,1509) * lu(k,3691) - lu(k,1513) = 1._r8 / lu(k,1513) - lu(k,1514) = lu(k,1514) * lu(k,1513) - lu(k,1515) = lu(k,1515) * lu(k,1513) - lu(k,1516) = lu(k,1516) * lu(k,1513) - lu(k,1517) = lu(k,1517) * lu(k,1513) - lu(k,1518) = lu(k,1518) * lu(k,1513) - lu(k,1519) = lu(k,1519) * lu(k,1513) - lu(k,1520) = lu(k,1520) * lu(k,1513) - lu(k,1521) = lu(k,1521) * lu(k,1513) - lu(k,1522) = lu(k,1522) * lu(k,1513) - lu(k,1523) = lu(k,1523) * lu(k,1513) - lu(k,1524) = lu(k,1524) * lu(k,1513) - lu(k,1525) = lu(k,1525) * lu(k,1513) - lu(k,2948) = lu(k,2948) - lu(k,1514) * lu(k,2938) - lu(k,2985) = lu(k,2985) - lu(k,1515) * lu(k,2938) - lu(k,2986) = lu(k,2986) - lu(k,1516) * lu(k,2938) - lu(k,2987) = lu(k,2987) - lu(k,1517) * lu(k,2938) - lu(k,2990) = lu(k,2990) - lu(k,1518) * lu(k,2938) - lu(k,2991) = lu(k,2991) - lu(k,1519) * lu(k,2938) - lu(k,2994) = lu(k,2994) - lu(k,1520) * lu(k,2938) - lu(k,2995) = lu(k,2995) - lu(k,1521) * lu(k,2938) - lu(k,2996) = lu(k,2996) - lu(k,1522) * lu(k,2938) - lu(k,2998) = lu(k,2998) - lu(k,1523) * lu(k,2938) - lu(k,2999) = lu(k,2999) - lu(k,1524) * lu(k,2938) - lu(k,3000) = lu(k,3000) - lu(k,1525) * lu(k,2938) - lu(k,3039) = - lu(k,1514) * lu(k,3030) - lu(k,3077) = - lu(k,1515) * lu(k,3030) - lu(k,3078) = lu(k,3078) - lu(k,1516) * lu(k,3030) - lu(k,3079) = lu(k,3079) - lu(k,1517) * lu(k,3030) - lu(k,3082) = lu(k,3082) - lu(k,1518) * lu(k,3030) - lu(k,3083) = - lu(k,1519) * lu(k,3030) - lu(k,3086) = lu(k,3086) - lu(k,1520) * lu(k,3030) - lu(k,3087) = lu(k,3087) - lu(k,1521) * lu(k,3030) - lu(k,3088) = lu(k,3088) - lu(k,1522) * lu(k,3030) - lu(k,3090) = - lu(k,1523) * lu(k,3030) - lu(k,3091) = lu(k,3091) - lu(k,1524) * lu(k,3030) - lu(k,3092) = lu(k,3092) - lu(k,1525) * lu(k,3030) - lu(k,3304) = lu(k,3304) - lu(k,1514) * lu(k,3303) - lu(k,3306) = - lu(k,1515) * lu(k,3303) - lu(k,3307) = lu(k,3307) - lu(k,1516) * lu(k,3303) - lu(k,3308) = - lu(k,1517) * lu(k,3303) - lu(k,3311) = lu(k,3311) - lu(k,1518) * lu(k,3303) - lu(k,3312) = lu(k,3312) - lu(k,1519) * lu(k,3303) - lu(k,3315) = lu(k,3315) - lu(k,1520) * lu(k,3303) - lu(k,3316) = lu(k,3316) - lu(k,1521) * lu(k,3303) - lu(k,3317) = lu(k,3317) - lu(k,1522) * lu(k,3303) - lu(k,3319) = lu(k,3319) - lu(k,1523) * lu(k,3303) - lu(k,3320) = lu(k,3320) - lu(k,1524) * lu(k,3303) - lu(k,3321) = lu(k,3321) - lu(k,1525) * lu(k,3303) - lu(k,3449) = lu(k,3449) - lu(k,1514) * lu(k,3447) - lu(k,3451) = lu(k,3451) - lu(k,1515) * lu(k,3447) - lu(k,3452) = lu(k,3452) - lu(k,1516) * lu(k,3447) - lu(k,3453) = lu(k,3453) - lu(k,1517) * lu(k,3447) - lu(k,3456) = lu(k,3456) - lu(k,1518) * lu(k,3447) - lu(k,3457) = lu(k,3457) - lu(k,1519) * lu(k,3447) - lu(k,3460) = lu(k,3460) - lu(k,1520) * lu(k,3447) - lu(k,3461) = lu(k,3461) - lu(k,1521) * lu(k,3447) - lu(k,3462) = lu(k,3462) - lu(k,1522) * lu(k,3447) - lu(k,3464) = lu(k,3464) - lu(k,1523) * lu(k,3447) - lu(k,3465) = lu(k,3465) - lu(k,1524) * lu(k,3447) - lu(k,3466) = lu(k,3466) - lu(k,1525) * lu(k,3447) - lu(k,3492) = lu(k,3492) - lu(k,1514) * lu(k,3489) - lu(k,3501) = lu(k,3501) - lu(k,1515) * lu(k,3489) - lu(k,3502) = lu(k,3502) - lu(k,1516) * lu(k,3489) - lu(k,3503) = lu(k,3503) - lu(k,1517) * lu(k,3489) - lu(k,3506) = lu(k,3506) - lu(k,1518) * lu(k,3489) - lu(k,3507) = lu(k,3507) - lu(k,1519) * lu(k,3489) - lu(k,3510) = lu(k,3510) - lu(k,1520) * lu(k,3489) - lu(k,3511) = lu(k,3511) - lu(k,1521) * lu(k,3489) - lu(k,3512) = lu(k,3512) - lu(k,1522) * lu(k,3489) - lu(k,3514) = lu(k,3514) - lu(k,1523) * lu(k,3489) - lu(k,3515) = lu(k,3515) - lu(k,1524) * lu(k,3489) - lu(k,3516) = lu(k,3516) - lu(k,1525) * lu(k,3489) - lu(k,3704) = lu(k,3704) - lu(k,1514) * lu(k,3692) - lu(k,3741) = lu(k,3741) - lu(k,1515) * lu(k,3692) - lu(k,3742) = lu(k,3742) - lu(k,1516) * lu(k,3692) - lu(k,3743) = lu(k,3743) - lu(k,1517) * lu(k,3692) - lu(k,3746) = lu(k,3746) - lu(k,1518) * lu(k,3692) - lu(k,3747) = lu(k,3747) - lu(k,1519) * lu(k,3692) - lu(k,3750) = lu(k,3750) - lu(k,1520) * lu(k,3692) - lu(k,3751) = lu(k,3751) - lu(k,1521) * lu(k,3692) - lu(k,3752) = lu(k,3752) - lu(k,1522) * lu(k,3692) - lu(k,3754) = lu(k,3754) - lu(k,1523) * lu(k,3692) - lu(k,3755) = lu(k,3755) - lu(k,1524) * lu(k,3692) - lu(k,3756) = lu(k,3756) - lu(k,1525) * lu(k,3692) - lu(k,3785) = lu(k,3785) - lu(k,1514) * lu(k,3784) - lu(k,3787) = - lu(k,1515) * lu(k,3784) - lu(k,3788) = lu(k,3788) - lu(k,1516) * lu(k,3784) - lu(k,3789) = - lu(k,1517) * lu(k,3784) - lu(k,3792) = lu(k,3792) - lu(k,1518) * lu(k,3784) - lu(k,3793) = lu(k,3793) - lu(k,1519) * lu(k,3784) - lu(k,3796) = lu(k,3796) - lu(k,1520) * lu(k,3784) - lu(k,3797) = lu(k,3797) - lu(k,1521) * lu(k,3784) - lu(k,3798) = lu(k,3798) - lu(k,1522) * lu(k,3784) - lu(k,3800) = lu(k,3800) - lu(k,1523) * lu(k,3784) - lu(k,3801) = lu(k,3801) - lu(k,1524) * lu(k,3784) - lu(k,3802) = lu(k,3802) - lu(k,1525) * lu(k,3784) - lu(k,3845) = - lu(k,1514) * lu(k,3844) - lu(k,3847) = lu(k,3847) - lu(k,1515) * lu(k,3844) - lu(k,3848) = - lu(k,1516) * lu(k,3844) - lu(k,3849) = - lu(k,1517) * lu(k,3844) - lu(k,3852) = lu(k,3852) - lu(k,1518) * lu(k,3844) - lu(k,3853) = - lu(k,1519) * lu(k,3844) - lu(k,3856) = lu(k,3856) - lu(k,1520) * lu(k,3844) - lu(k,3857) = - lu(k,1521) * lu(k,3844) - lu(k,3858) = lu(k,3858) - lu(k,1522) * lu(k,3844) - lu(k,3860) = - lu(k,1523) * lu(k,3844) - lu(k,3861) = lu(k,3861) - lu(k,1524) * lu(k,3844) - lu(k,3862) = lu(k,3862) - lu(k,1525) * lu(k,3844) - lu(k,1529) = 1._r8 / lu(k,1529) - lu(k,1530) = lu(k,1530) * lu(k,1529) - lu(k,1531) = lu(k,1531) * lu(k,1529) - lu(k,1532) = lu(k,1532) * lu(k,1529) - lu(k,1533) = lu(k,1533) * lu(k,1529) - lu(k,1534) = lu(k,1534) * lu(k,1529) - lu(k,1535) = lu(k,1535) * lu(k,1529) - lu(k,1536) = lu(k,1536) * lu(k,1529) - lu(k,1537) = lu(k,1537) * lu(k,1529) - lu(k,1538) = lu(k,1538) * lu(k,1529) - lu(k,1539) = lu(k,1539) * lu(k,1529) - lu(k,1722) = lu(k,1722) - lu(k,1530) * lu(k,1721) - lu(k,1724) = lu(k,1724) - lu(k,1531) * lu(k,1721) - lu(k,1725) = - lu(k,1532) * lu(k,1721) - lu(k,1731) = lu(k,1731) - lu(k,1533) * lu(k,1721) - lu(k,1732) = lu(k,1732) - lu(k,1534) * lu(k,1721) - lu(k,1737) = - lu(k,1535) * lu(k,1721) - lu(k,1740) = lu(k,1740) - lu(k,1536) * lu(k,1721) - lu(k,1741) = lu(k,1741) - lu(k,1537) * lu(k,1721) - lu(k,1743) = lu(k,1743) - lu(k,1538) * lu(k,1721) - lu(k,1744) = lu(k,1744) - lu(k,1539) * lu(k,1721) - lu(k,1821) = lu(k,1821) - lu(k,1530) * lu(k,1820) - lu(k,1823) = lu(k,1823) - lu(k,1531) * lu(k,1820) - lu(k,1824) = lu(k,1824) - lu(k,1532) * lu(k,1820) - lu(k,1828) = - lu(k,1533) * lu(k,1820) - lu(k,1830) = lu(k,1830) - lu(k,1534) * lu(k,1820) - lu(k,1835) = lu(k,1835) - lu(k,1535) * lu(k,1820) - lu(k,1838) = lu(k,1838) - lu(k,1536) * lu(k,1820) - lu(k,1839) = lu(k,1839) - lu(k,1537) * lu(k,1820) - lu(k,1841) = lu(k,1841) - lu(k,1538) * lu(k,1820) - lu(k,1842) = lu(k,1842) - lu(k,1539) * lu(k,1820) - lu(k,1923) = lu(k,1923) - lu(k,1530) * lu(k,1922) - lu(k,1924) = lu(k,1924) - lu(k,1531) * lu(k,1922) - lu(k,1925) = lu(k,1925) - lu(k,1532) * lu(k,1922) - lu(k,1928) = - lu(k,1533) * lu(k,1922) - lu(k,1929) = lu(k,1929) - lu(k,1534) * lu(k,1922) - lu(k,1933) = lu(k,1933) - lu(k,1535) * lu(k,1922) - lu(k,1938) = lu(k,1938) - lu(k,1536) * lu(k,1922) - lu(k,1939) = lu(k,1939) - lu(k,1537) * lu(k,1922) - lu(k,1941) = lu(k,1941) - lu(k,1538) * lu(k,1922) - lu(k,1942) = lu(k,1942) - lu(k,1539) * lu(k,1922) - lu(k,1957) = lu(k,1957) - lu(k,1530) * lu(k,1956) - lu(k,1958) = lu(k,1958) - lu(k,1531) * lu(k,1956) - lu(k,1959) = - lu(k,1532) * lu(k,1956) - lu(k,1962) = lu(k,1962) - lu(k,1533) * lu(k,1956) - lu(k,1963) = lu(k,1963) - lu(k,1534) * lu(k,1956) - lu(k,1967) = lu(k,1967) - lu(k,1535) * lu(k,1956) - lu(k,1972) = lu(k,1972) - lu(k,1536) * lu(k,1956) - lu(k,1973) = lu(k,1973) - lu(k,1537) * lu(k,1956) - lu(k,1975) = lu(k,1975) - lu(k,1538) * lu(k,1956) - lu(k,1976) = lu(k,1976) - lu(k,1539) * lu(k,1956) - lu(k,2023) = lu(k,2023) - lu(k,1530) * lu(k,2022) - lu(k,2024) = lu(k,2024) - lu(k,1531) * lu(k,2022) - lu(k,2025) = lu(k,2025) - lu(k,1532) * lu(k,2022) - lu(k,2028) = lu(k,2028) - lu(k,1533) * lu(k,2022) - lu(k,2029) = lu(k,2029) - lu(k,1534) * lu(k,2022) - lu(k,2037) = lu(k,2037) - lu(k,1535) * lu(k,2022) - lu(k,2042) = lu(k,2042) - lu(k,1536) * lu(k,2022) - lu(k,2043) = lu(k,2043) - lu(k,1537) * lu(k,2022) - lu(k,2046) = lu(k,2046) - lu(k,1538) * lu(k,2022) - lu(k,2047) = lu(k,2047) - lu(k,1539) * lu(k,2022) - lu(k,2836) = lu(k,2836) - lu(k,1530) * lu(k,2835) - lu(k,2841) = lu(k,2841) - lu(k,1531) * lu(k,2835) - lu(k,2842) = lu(k,2842) - lu(k,1532) * lu(k,2835) - lu(k,2851) = lu(k,2851) - lu(k,1533) * lu(k,2835) - lu(k,2853) = lu(k,2853) - lu(k,1534) * lu(k,2835) - lu(k,2883) = lu(k,2883) - lu(k,1535) * lu(k,2835) - lu(k,2889) = lu(k,2889) - lu(k,1536) * lu(k,2835) - lu(k,2891) = lu(k,2891) - lu(k,1537) * lu(k,2835) - lu(k,2894) = lu(k,2894) - lu(k,1538) * lu(k,2835) - lu(k,2895) = lu(k,2895) - lu(k,1539) * lu(k,2835) - lu(k,2940) = lu(k,2940) - lu(k,1530) * lu(k,2939) - lu(k,2943) = lu(k,2943) - lu(k,1531) * lu(k,2939) - lu(k,2944) = lu(k,2944) - lu(k,1532) * lu(k,2939) - lu(k,2953) = lu(k,2953) - lu(k,1533) * lu(k,2939) - lu(k,2955) = lu(k,2955) - lu(k,1534) * lu(k,2939) - lu(k,2984) = lu(k,2984) - lu(k,1535) * lu(k,2939) - lu(k,2990) = lu(k,2990) - lu(k,1536) * lu(k,2939) - lu(k,2992) = lu(k,2992) - lu(k,1537) * lu(k,2939) - lu(k,2995) = lu(k,2995) - lu(k,1538) * lu(k,2939) - lu(k,2996) = lu(k,2996) - lu(k,1539) * lu(k,2939) - lu(k,3232) = lu(k,3232) - lu(k,1530) * lu(k,3231) - lu(k,3237) = lu(k,3237) - lu(k,1531) * lu(k,3231) - lu(k,3238) = lu(k,3238) - lu(k,1532) * lu(k,3231) - lu(k,3247) = lu(k,3247) - lu(k,1533) * lu(k,3231) - lu(k,3249) = lu(k,3249) - lu(k,1534) * lu(k,3231) - lu(k,3279) = lu(k,3279) - lu(k,1535) * lu(k,3231) - lu(k,3285) = lu(k,3285) - lu(k,1536) * lu(k,3231) - lu(k,3287) = lu(k,3287) - lu(k,1537) * lu(k,3231) - lu(k,3290) = lu(k,3290) - lu(k,1538) * lu(k,3231) - lu(k,3291) = lu(k,3291) - lu(k,1539) * lu(k,3231) - lu(k,3374) = lu(k,3374) - lu(k,1530) * lu(k,3373) - lu(k,3379) = lu(k,3379) - lu(k,1531) * lu(k,3373) - lu(k,3380) = lu(k,3380) - lu(k,1532) * lu(k,3373) - lu(k,3388) = lu(k,3388) - lu(k,1533) * lu(k,3373) - lu(k,3390) = lu(k,3390) - lu(k,1534) * lu(k,3373) - lu(k,3420) = lu(k,3420) - lu(k,1535) * lu(k,3373) - lu(k,3426) = lu(k,3426) - lu(k,1536) * lu(k,3373) - lu(k,3428) = lu(k,3428) - lu(k,1537) * lu(k,3373) - lu(k,3431) = lu(k,3431) - lu(k,1538) * lu(k,3373) - lu(k,3432) = lu(k,3432) - lu(k,1539) * lu(k,3373) - lu(k,3694) = lu(k,3694) - lu(k,1530) * lu(k,3693) - lu(k,3699) = lu(k,3699) - lu(k,1531) * lu(k,3693) - lu(k,3700) = lu(k,3700) - lu(k,1532) * lu(k,3693) - lu(k,3709) = lu(k,3709) - lu(k,1533) * lu(k,3693) - lu(k,3711) = lu(k,3711) - lu(k,1534) * lu(k,3693) - lu(k,3740) = lu(k,3740) - lu(k,1535) * lu(k,3693) - lu(k,3746) = lu(k,3746) - lu(k,1536) * lu(k,3693) - lu(k,3748) = lu(k,3748) - lu(k,1537) * lu(k,3693) - lu(k,3751) = lu(k,3751) - lu(k,1538) * lu(k,3693) - lu(k,3752) = lu(k,3752) - lu(k,1539) * lu(k,3693) + lu(k,1534) = 1._r8 / lu(k,1534) + lu(k,1535) = lu(k,1535) * lu(k,1534) + lu(k,1536) = lu(k,1536) * lu(k,1534) + lu(k,1537) = lu(k,1537) * lu(k,1534) + lu(k,1538) = lu(k,1538) * lu(k,1534) + lu(k,1539) = lu(k,1539) * lu(k,1534) + lu(k,1701) = - lu(k,1535) * lu(k,1698) + lu(k,1704) = lu(k,1704) - lu(k,1536) * lu(k,1698) + lu(k,1705) = lu(k,1705) - lu(k,1537) * lu(k,1698) + lu(k,1706) = lu(k,1706) - lu(k,1538) * lu(k,1698) + lu(k,1707) = lu(k,1707) - lu(k,1539) * lu(k,1698) + lu(k,2237) = - lu(k,1535) * lu(k,2231) + lu(k,2246) = - lu(k,1536) * lu(k,2231) + lu(k,2249) = lu(k,2249) - lu(k,1537) * lu(k,2231) + lu(k,2250) = lu(k,2250) - lu(k,1538) * lu(k,2231) + lu(k,2253) = lu(k,2253) - lu(k,1539) * lu(k,2231) + lu(k,2297) = lu(k,2297) - lu(k,1535) * lu(k,2292) + lu(k,2306) = lu(k,2306) - lu(k,1536) * lu(k,2292) + lu(k,2309) = lu(k,2309) - lu(k,1537) * lu(k,2292) + lu(k,2310) = lu(k,2310) - lu(k,1538) * lu(k,2292) + lu(k,2313) = lu(k,2313) - lu(k,1539) * lu(k,2292) + lu(k,2410) = lu(k,2410) - lu(k,1535) * lu(k,2402) + lu(k,2422) = - lu(k,1536) * lu(k,2402) + lu(k,2425) = lu(k,2425) - lu(k,1537) * lu(k,2402) + lu(k,2426) = lu(k,2426) - lu(k,1538) * lu(k,2402) + lu(k,2429) = lu(k,2429) - lu(k,1539) * lu(k,2402) + lu(k,2464) = lu(k,2464) - lu(k,1535) * lu(k,2456) + lu(k,2476) = - lu(k,1536) * lu(k,2456) + lu(k,2479) = lu(k,2479) - lu(k,1537) * lu(k,2456) + lu(k,2480) = lu(k,2480) - lu(k,1538) * lu(k,2456) + lu(k,2483) = lu(k,2483) - lu(k,1539) * lu(k,2456) + lu(k,2498) = lu(k,2498) - lu(k,1535) * lu(k,2492) + lu(k,2510) = lu(k,2510) - lu(k,1536) * lu(k,2492) + lu(k,2513) = lu(k,2513) - lu(k,1537) * lu(k,2492) + lu(k,2514) = lu(k,2514) - lu(k,1538) * lu(k,2492) + lu(k,2517) = lu(k,2517) - lu(k,1539) * lu(k,2492) + lu(k,2529) = lu(k,2529) - lu(k,1535) * lu(k,2524) + lu(k,2539) = lu(k,2539) - lu(k,1536) * lu(k,2524) + lu(k,2542) = lu(k,2542) - lu(k,1537) * lu(k,2524) + lu(k,2543) = lu(k,2543) - lu(k,1538) * lu(k,2524) + lu(k,2546) = lu(k,2546) - lu(k,1539) * lu(k,2524) + lu(k,2696) = lu(k,2696) - lu(k,1535) * lu(k,2688) + lu(k,2711) = lu(k,2711) - lu(k,1536) * lu(k,2688) + lu(k,2714) = lu(k,2714) - lu(k,1537) * lu(k,2688) + lu(k,2715) = lu(k,2715) - lu(k,1538) * lu(k,2688) + lu(k,2719) = lu(k,2719) - lu(k,1539) * lu(k,2688) + lu(k,2772) = lu(k,2772) - lu(k,1535) * lu(k,2767) + lu(k,2781) = - lu(k,1536) * lu(k,2767) + lu(k,2784) = lu(k,2784) - lu(k,1537) * lu(k,2767) + lu(k,2785) = lu(k,2785) - lu(k,1538) * lu(k,2767) + lu(k,2788) = lu(k,2788) - lu(k,1539) * lu(k,2767) + lu(k,2840) = lu(k,2840) - lu(k,1535) * lu(k,2827) + lu(k,2860) = - lu(k,1536) * lu(k,2827) + lu(k,2863) = lu(k,2863) - lu(k,1537) * lu(k,2827) + lu(k,2864) = lu(k,2864) - lu(k,1538) * lu(k,2827) + lu(k,2868) = lu(k,2868) - lu(k,1539) * lu(k,2827) + lu(k,2887) = lu(k,2887) - lu(k,1535) * lu(k,2874) + lu(k,2907) = lu(k,2907) - lu(k,1536) * lu(k,2874) + lu(k,2910) = lu(k,2910) - lu(k,1537) * lu(k,2874) + lu(k,2911) = lu(k,2911) - lu(k,1538) * lu(k,2874) + lu(k,2915) = lu(k,2915) - lu(k,1539) * lu(k,2874) + lu(k,2933) = lu(k,2933) - lu(k,1535) * lu(k,2920) + lu(k,2953) = - lu(k,1536) * lu(k,2920) + lu(k,2956) = lu(k,2956) - lu(k,1537) * lu(k,2920) + lu(k,2957) = lu(k,2957) - lu(k,1538) * lu(k,2920) + lu(k,2961) = lu(k,2961) - lu(k,1539) * lu(k,2920) + lu(k,3005) = lu(k,3005) - lu(k,1535) * lu(k,2970) + lu(k,3027) = - lu(k,1536) * lu(k,2970) + lu(k,3030) = lu(k,3030) - lu(k,1537) * lu(k,2970) + lu(k,3031) = lu(k,3031) - lu(k,1538) * lu(k,2970) + lu(k,3035) = lu(k,3035) - lu(k,1539) * lu(k,2970) + lu(k,3288) = lu(k,3288) - lu(k,1535) * lu(k,3249) + lu(k,3312) = lu(k,3312) - lu(k,1536) * lu(k,3249) + lu(k,3315) = lu(k,3315) - lu(k,1537) * lu(k,3249) + lu(k,3316) = lu(k,3316) - lu(k,1538) * lu(k,3249) + lu(k,3320) = lu(k,3320) - lu(k,1539) * lu(k,3249) + lu(k,3544) = lu(k,3544) - lu(k,1535) * lu(k,3503) + lu(k,3568) = lu(k,3568) - lu(k,1536) * lu(k,3503) + lu(k,3571) = lu(k,3571) - lu(k,1537) * lu(k,3503) + lu(k,3572) = lu(k,3572) - lu(k,1538) * lu(k,3503) + lu(k,3576) = lu(k,3576) - lu(k,1539) * lu(k,3503) + lu(k,3794) = lu(k,3794) - lu(k,1535) * lu(k,3753) + lu(k,3818) = lu(k,3818) - lu(k,1536) * lu(k,3753) + lu(k,3821) = lu(k,3821) - lu(k,1537) * lu(k,3753) + lu(k,3822) = lu(k,3822) - lu(k,1538) * lu(k,3753) + lu(k,3826) = lu(k,3826) - lu(k,1539) * lu(k,3753) + lu(k,3929) = lu(k,3929) - lu(k,1535) * lu(k,3894) + lu(k,3953) = lu(k,3953) - lu(k,1536) * lu(k,3894) + lu(k,3956) = lu(k,3956) - lu(k,1537) * lu(k,3894) + lu(k,3957) = lu(k,3957) - lu(k,1538) * lu(k,3894) + lu(k,3961) = lu(k,3961) - lu(k,1539) * lu(k,3894) + lu(k,4022) = lu(k,4022) - lu(k,1535) * lu(k,3984) + lu(k,4045) = lu(k,4045) - lu(k,1536) * lu(k,3984) + lu(k,4048) = lu(k,4048) - lu(k,1537) * lu(k,3984) + lu(k,4049) = lu(k,4049) - lu(k,1538) * lu(k,3984) + lu(k,4053) = lu(k,4053) - lu(k,1539) * lu(k,3984) + lu(k,1541) = 1._r8 / lu(k,1541) + lu(k,1542) = lu(k,1542) * lu(k,1541) + lu(k,1543) = lu(k,1543) * lu(k,1541) + lu(k,1544) = lu(k,1544) * lu(k,1541) + lu(k,1545) = lu(k,1545) * lu(k,1541) + lu(k,1546) = lu(k,1546) * lu(k,1541) + lu(k,1547) = lu(k,1547) * lu(k,1541) + lu(k,1548) = lu(k,1548) * lu(k,1541) + lu(k,1549) = lu(k,1549) * lu(k,1541) + lu(k,1550) = lu(k,1550) * lu(k,1541) + lu(k,1551) = lu(k,1551) * lu(k,1541) + lu(k,1552) = lu(k,1552) * lu(k,1541) + lu(k,1553) = lu(k,1553) * lu(k,1541) + lu(k,1554) = lu(k,1554) * lu(k,1541) + lu(k,1811) = lu(k,1811) - lu(k,1542) * lu(k,1810) + lu(k,1813) = - lu(k,1543) * lu(k,1810) + lu(k,1814) = lu(k,1814) - lu(k,1544) * lu(k,1810) + lu(k,1818) = lu(k,1818) - lu(k,1545) * lu(k,1810) + lu(k,1819) = lu(k,1819) - lu(k,1546) * lu(k,1810) + lu(k,1823) = - lu(k,1547) * lu(k,1810) + lu(k,1824) = lu(k,1824) - lu(k,1548) * lu(k,1810) + lu(k,1825) = lu(k,1825) - lu(k,1549) * lu(k,1810) + lu(k,1826) = lu(k,1826) - lu(k,1550) * lu(k,1810) + lu(k,1828) = lu(k,1828) - lu(k,1551) * lu(k,1810) + lu(k,1829) = lu(k,1829) - lu(k,1552) * lu(k,1810) + lu(k,1830) = lu(k,1830) - lu(k,1553) * lu(k,1810) + lu(k,1831) = lu(k,1831) - lu(k,1554) * lu(k,1810) + lu(k,2016) = lu(k,2016) - lu(k,1542) * lu(k,2015) + lu(k,2018) = - lu(k,1543) * lu(k,2015) + lu(k,2019) = - lu(k,1544) * lu(k,2015) + lu(k,2020) = lu(k,2020) - lu(k,1545) * lu(k,2015) + lu(k,2021) = lu(k,2021) - lu(k,1546) * lu(k,2015) + lu(k,2023) = - lu(k,1547) * lu(k,2015) + lu(k,2024) = lu(k,2024) - lu(k,1548) * lu(k,2015) + lu(k,2026) = - lu(k,1549) * lu(k,2015) + lu(k,2028) = lu(k,2028) - lu(k,1550) * lu(k,2015) + lu(k,2030) = lu(k,2030) - lu(k,1551) * lu(k,2015) + lu(k,2031) = lu(k,2031) - lu(k,1552) * lu(k,2015) + lu(k,2033) = lu(k,2033) - lu(k,1553) * lu(k,2015) + lu(k,2034) = - lu(k,1554) * lu(k,2015) + lu(k,2973) = lu(k,2973) - lu(k,1542) * lu(k,2971) + lu(k,2979) = - lu(k,1543) * lu(k,2971) + lu(k,2981) = lu(k,2981) - lu(k,1544) * lu(k,2971) + lu(k,2987) = lu(k,2987) - lu(k,1545) * lu(k,2971) + lu(k,2988) = lu(k,2988) - lu(k,1546) * lu(k,2971) + lu(k,3001) = lu(k,3001) - lu(k,1547) * lu(k,2971) + lu(k,3023) = lu(k,3023) - lu(k,1548) * lu(k,2971) + lu(k,3026) = lu(k,3026) - lu(k,1549) * lu(k,2971) + lu(k,3028) = lu(k,3028) - lu(k,1550) * lu(k,2971) + lu(k,3030) = lu(k,3030) - lu(k,1551) * lu(k,2971) + lu(k,3031) = lu(k,3031) - lu(k,1552) * lu(k,2971) + lu(k,3034) = lu(k,3034) - lu(k,1553) * lu(k,2971) + lu(k,3035) = lu(k,3035) - lu(k,1554) * lu(k,2971) + lu(k,3252) = lu(k,3252) - lu(k,1542) * lu(k,3250) + lu(k,3260) = lu(k,3260) - lu(k,1543) * lu(k,3250) + lu(k,3262) = lu(k,3262) - lu(k,1544) * lu(k,3250) + lu(k,3269) = lu(k,3269) - lu(k,1545) * lu(k,3250) + lu(k,3270) = lu(k,3270) - lu(k,1546) * lu(k,3250) + lu(k,3284) = lu(k,3284) - lu(k,1547) * lu(k,3250) + lu(k,3308) = lu(k,3308) - lu(k,1548) * lu(k,3250) + lu(k,3311) = lu(k,3311) - lu(k,1549) * lu(k,3250) + lu(k,3313) = lu(k,3313) - lu(k,1550) * lu(k,3250) + lu(k,3315) = lu(k,3315) - lu(k,1551) * lu(k,3250) + lu(k,3316) = lu(k,3316) - lu(k,1552) * lu(k,3250) + lu(k,3319) = lu(k,3319) - lu(k,1553) * lu(k,3250) + lu(k,3320) = lu(k,3320) - lu(k,1554) * lu(k,3250) + lu(k,3507) = lu(k,3507) - lu(k,1542) * lu(k,3504) + lu(k,3516) = lu(k,3516) - lu(k,1543) * lu(k,3504) + lu(k,3518) = lu(k,3518) - lu(k,1544) * lu(k,3504) + lu(k,3525) = lu(k,3525) - lu(k,1545) * lu(k,3504) + lu(k,3526) = lu(k,3526) - lu(k,1546) * lu(k,3504) + lu(k,3540) = lu(k,3540) - lu(k,1547) * lu(k,3504) + lu(k,3564) = lu(k,3564) - lu(k,1548) * lu(k,3504) + lu(k,3567) = lu(k,3567) - lu(k,1549) * lu(k,3504) + lu(k,3569) = lu(k,3569) - lu(k,1550) * lu(k,3504) + lu(k,3571) = lu(k,3571) - lu(k,1551) * lu(k,3504) + lu(k,3572) = lu(k,3572) - lu(k,1552) * lu(k,3504) + lu(k,3575) = lu(k,3575) - lu(k,1553) * lu(k,3504) + lu(k,3576) = lu(k,3576) - lu(k,1554) * lu(k,3504) + lu(k,3758) = lu(k,3758) - lu(k,1542) * lu(k,3754) + lu(k,3767) = lu(k,3767) - lu(k,1543) * lu(k,3754) + lu(k,3769) = lu(k,3769) - lu(k,1544) * lu(k,3754) + lu(k,3776) = lu(k,3776) - lu(k,1545) * lu(k,3754) + lu(k,3777) = lu(k,3777) - lu(k,1546) * lu(k,3754) + lu(k,3790) = lu(k,3790) - lu(k,1547) * lu(k,3754) + lu(k,3814) = lu(k,3814) - lu(k,1548) * lu(k,3754) + lu(k,3817) = lu(k,3817) - lu(k,1549) * lu(k,3754) + lu(k,3819) = lu(k,3819) - lu(k,1550) * lu(k,3754) + lu(k,3821) = lu(k,3821) - lu(k,1551) * lu(k,3754) + lu(k,3822) = lu(k,3822) - lu(k,1552) * lu(k,3754) + lu(k,3825) = lu(k,3825) - lu(k,1553) * lu(k,3754) + lu(k,3826) = lu(k,3826) - lu(k,1554) * lu(k,3754) + lu(k,3987) = lu(k,3987) - lu(k,1542) * lu(k,3985) + lu(k,3995) = lu(k,3995) - lu(k,1543) * lu(k,3985) + lu(k,3997) = lu(k,3997) - lu(k,1544) * lu(k,3985) + lu(k,4004) = lu(k,4004) - lu(k,1545) * lu(k,3985) + lu(k,4005) = lu(k,4005) - lu(k,1546) * lu(k,3985) + lu(k,4018) = lu(k,4018) - lu(k,1547) * lu(k,3985) + lu(k,4041) = lu(k,4041) - lu(k,1548) * lu(k,3985) + lu(k,4044) = lu(k,4044) - lu(k,1549) * lu(k,3985) + lu(k,4046) = lu(k,4046) - lu(k,1550) * lu(k,3985) + lu(k,4048) = lu(k,4048) - lu(k,1551) * lu(k,3985) + lu(k,4049) = lu(k,4049) - lu(k,1552) * lu(k,3985) + lu(k,4052) = lu(k,4052) - lu(k,1553) * lu(k,3985) + lu(k,4053) = lu(k,4053) - lu(k,1554) * lu(k,3985) + lu(k,1555) = 1._r8 / lu(k,1555) + lu(k,1556) = lu(k,1556) * lu(k,1555) + lu(k,1557) = lu(k,1557) * lu(k,1555) + lu(k,1558) = lu(k,1558) * lu(k,1555) + lu(k,1559) = lu(k,1559) * lu(k,1555) + lu(k,1688) = - lu(k,1556) * lu(k,1686) + lu(k,1692) = lu(k,1692) - lu(k,1557) * lu(k,1686) + lu(k,1693) = lu(k,1693) - lu(k,1558) * lu(k,1686) + lu(k,1694) = lu(k,1694) - lu(k,1559) * lu(k,1686) + lu(k,1701) = lu(k,1701) - lu(k,1556) * lu(k,1699) + lu(k,1705) = lu(k,1705) - lu(k,1557) * lu(k,1699) + lu(k,1706) = lu(k,1706) - lu(k,1558) * lu(k,1699) + lu(k,1707) = lu(k,1707) - lu(k,1559) * lu(k,1699) + lu(k,2297) = lu(k,2297) - lu(k,1556) * lu(k,2293) + lu(k,2309) = lu(k,2309) - lu(k,1557) * lu(k,2293) + lu(k,2310) = lu(k,2310) - lu(k,1558) * lu(k,2293) + lu(k,2313) = lu(k,2313) - lu(k,1559) * lu(k,2293) + lu(k,2324) = lu(k,2324) - lu(k,1556) * lu(k,2319) + lu(k,2336) = lu(k,2336) - lu(k,1557) * lu(k,2319) + lu(k,2337) = lu(k,2337) - lu(k,1558) * lu(k,2319) + lu(k,2340) = lu(k,2340) - lu(k,1559) * lu(k,2319) + lu(k,2410) = lu(k,2410) - lu(k,1556) * lu(k,2403) + lu(k,2425) = lu(k,2425) - lu(k,1557) * lu(k,2403) + lu(k,2426) = lu(k,2426) - lu(k,1558) * lu(k,2403) + lu(k,2429) = lu(k,2429) - lu(k,1559) * lu(k,2403) + lu(k,2436) = lu(k,2436) - lu(k,1556) * lu(k,2433) + lu(k,2448) = lu(k,2448) - lu(k,1557) * lu(k,2433) + lu(k,2449) = lu(k,2449) - lu(k,1558) * lu(k,2433) + lu(k,2451) = lu(k,2451) - lu(k,1559) * lu(k,2433) + lu(k,2464) = lu(k,2464) - lu(k,1556) * lu(k,2457) + lu(k,2479) = lu(k,2479) - lu(k,1557) * lu(k,2457) + lu(k,2480) = lu(k,2480) - lu(k,1558) * lu(k,2457) + lu(k,2483) = lu(k,2483) - lu(k,1559) * lu(k,2457) + lu(k,2498) = lu(k,2498) - lu(k,1556) * lu(k,2493) + lu(k,2513) = lu(k,2513) - lu(k,1557) * lu(k,2493) + lu(k,2514) = lu(k,2514) - lu(k,1558) * lu(k,2493) + lu(k,2517) = lu(k,2517) - lu(k,1559) * lu(k,2493) + lu(k,2529) = lu(k,2529) - lu(k,1556) * lu(k,2525) + lu(k,2542) = lu(k,2542) - lu(k,1557) * lu(k,2525) + lu(k,2543) = lu(k,2543) - lu(k,1558) * lu(k,2525) + lu(k,2546) = lu(k,2546) - lu(k,1559) * lu(k,2525) + lu(k,2662) = - lu(k,1556) * lu(k,2658) + lu(k,2675) = lu(k,2675) - lu(k,1557) * lu(k,2658) + lu(k,2676) = lu(k,2676) - lu(k,1558) * lu(k,2658) + lu(k,2679) = lu(k,2679) - lu(k,1559) * lu(k,2658) + lu(k,2696) = lu(k,2696) - lu(k,1556) * lu(k,2689) + lu(k,2714) = lu(k,2714) - lu(k,1557) * lu(k,2689) + lu(k,2715) = lu(k,2715) - lu(k,1558) * lu(k,2689) + lu(k,2719) = lu(k,2719) - lu(k,1559) * lu(k,2689) + lu(k,2727) = lu(k,2727) - lu(k,1556) * lu(k,2724) + lu(k,2739) = lu(k,2739) - lu(k,1557) * lu(k,2724) + lu(k,2740) = lu(k,2740) - lu(k,1558) * lu(k,2724) + lu(k,2743) = lu(k,2743) - lu(k,1559) * lu(k,2724) + lu(k,2749) = - lu(k,1556) * lu(k,2745) + lu(k,2761) = lu(k,2761) - lu(k,1557) * lu(k,2745) + lu(k,2762) = lu(k,2762) - lu(k,1558) * lu(k,2745) + lu(k,2765) = lu(k,2765) - lu(k,1559) * lu(k,2745) + lu(k,2800) = lu(k,2800) - lu(k,1556) * lu(k,2793) + lu(k,2817) = lu(k,2817) - lu(k,1557) * lu(k,2793) + lu(k,2818) = lu(k,2818) - lu(k,1558) * lu(k,2793) + lu(k,2822) = lu(k,2822) - lu(k,1559) * lu(k,2793) + lu(k,2840) = lu(k,2840) - lu(k,1556) * lu(k,2828) + lu(k,2863) = lu(k,2863) - lu(k,1557) * lu(k,2828) + lu(k,2864) = lu(k,2864) - lu(k,1558) * lu(k,2828) + lu(k,2868) = lu(k,2868) - lu(k,1559) * lu(k,2828) + lu(k,2887) = lu(k,2887) - lu(k,1556) * lu(k,2875) + lu(k,2910) = lu(k,2910) - lu(k,1557) * lu(k,2875) + lu(k,2911) = lu(k,2911) - lu(k,1558) * lu(k,2875) + lu(k,2915) = lu(k,2915) - lu(k,1559) * lu(k,2875) + lu(k,2933) = lu(k,2933) - lu(k,1556) * lu(k,2921) + lu(k,2956) = lu(k,2956) - lu(k,1557) * lu(k,2921) + lu(k,2957) = lu(k,2957) - lu(k,1558) * lu(k,2921) + lu(k,2961) = lu(k,2961) - lu(k,1559) * lu(k,2921) + lu(k,3005) = lu(k,3005) - lu(k,1556) * lu(k,2972) + lu(k,3030) = lu(k,3030) - lu(k,1557) * lu(k,2972) + lu(k,3031) = lu(k,3031) - lu(k,1558) * lu(k,2972) + lu(k,3035) = lu(k,3035) - lu(k,1559) * lu(k,2972) + lu(k,3288) = lu(k,3288) - lu(k,1556) * lu(k,3251) + lu(k,3315) = lu(k,3315) - lu(k,1557) * lu(k,3251) + lu(k,3316) = lu(k,3316) - lu(k,1558) * lu(k,3251) + lu(k,3320) = lu(k,3320) - lu(k,1559) * lu(k,3251) + lu(k,3544) = lu(k,3544) - lu(k,1556) * lu(k,3505) + lu(k,3571) = lu(k,3571) - lu(k,1557) * lu(k,3505) + lu(k,3572) = lu(k,3572) - lu(k,1558) * lu(k,3505) + lu(k,3576) = lu(k,3576) - lu(k,1559) * lu(k,3505) + lu(k,3794) = lu(k,3794) - lu(k,1556) * lu(k,3755) + lu(k,3821) = lu(k,3821) - lu(k,1557) * lu(k,3755) + lu(k,3822) = lu(k,3822) - lu(k,1558) * lu(k,3755) + lu(k,3826) = lu(k,3826) - lu(k,1559) * lu(k,3755) + lu(k,3929) = lu(k,3929) - lu(k,1556) * lu(k,3895) + lu(k,3956) = lu(k,3956) - lu(k,1557) * lu(k,3895) + lu(k,3957) = lu(k,3957) - lu(k,1558) * lu(k,3895) + lu(k,3961) = lu(k,3961) - lu(k,1559) * lu(k,3895) + lu(k,4022) = lu(k,4022) - lu(k,1556) * lu(k,3986) + lu(k,4048) = lu(k,4048) - lu(k,1557) * lu(k,3986) + lu(k,4049) = lu(k,4049) - lu(k,1558) * lu(k,3986) + lu(k,4053) = lu(k,4053) - lu(k,1559) * lu(k,3986) + lu(k,1570) = 1._r8 / lu(k,1570) + lu(k,1571) = lu(k,1571) * lu(k,1570) + lu(k,1572) = lu(k,1572) * lu(k,1570) + lu(k,1573) = lu(k,1573) * lu(k,1570) + lu(k,1574) = lu(k,1574) * lu(k,1570) + lu(k,1575) = lu(k,1575) * lu(k,1570) + lu(k,1576) = lu(k,1576) * lu(k,1570) + lu(k,1577) = lu(k,1577) * lu(k,1570) + lu(k,1578) = lu(k,1578) * lu(k,1570) + lu(k,1579) = lu(k,1579) * lu(k,1570) + lu(k,1580) = lu(k,1580) * lu(k,1570) + lu(k,1581) = lu(k,1581) * lu(k,1570) + lu(k,1582) = lu(k,1582) * lu(k,1570) + lu(k,1583) = lu(k,1583) * lu(k,1570) + lu(k,1584) = lu(k,1584) * lu(k,1570) + lu(k,1585) = lu(k,1585) * lu(k,1570) + lu(k,1586) = lu(k,1586) * lu(k,1570) + lu(k,1587) = lu(k,1587) * lu(k,1570) + lu(k,1588) = lu(k,1588) * lu(k,1570) + lu(k,1589) = lu(k,1589) * lu(k,1570) + lu(k,1590) = lu(k,1590) * lu(k,1570) + lu(k,1591) = lu(k,1591) * lu(k,1570) + lu(k,1592) = lu(k,1592) * lu(k,1570) + lu(k,1593) = lu(k,1593) * lu(k,1570) + lu(k,1594) = lu(k,1594) * lu(k,1570) + lu(k,2165) = lu(k,2165) - lu(k,1571) * lu(k,2164) + lu(k,2166) = lu(k,2166) - lu(k,1572) * lu(k,2164) + lu(k,2167) = lu(k,2167) - lu(k,1573) * lu(k,2164) + lu(k,2168) = lu(k,2168) - lu(k,1574) * lu(k,2164) + lu(k,2169) = lu(k,2169) - lu(k,1575) * lu(k,2164) + lu(k,2170) = lu(k,2170) - lu(k,1576) * lu(k,2164) + lu(k,2171) = lu(k,2171) - lu(k,1577) * lu(k,2164) + lu(k,2172) = lu(k,2172) - lu(k,1578) * lu(k,2164) + lu(k,2173) = lu(k,2173) - lu(k,1579) * lu(k,2164) + lu(k,2174) = lu(k,2174) - lu(k,1580) * lu(k,2164) + lu(k,2179) = lu(k,2179) - lu(k,1581) * lu(k,2164) + lu(k,2180) = lu(k,2180) - lu(k,1582) * lu(k,2164) + lu(k,2183) = lu(k,2183) - lu(k,1583) * lu(k,2164) + lu(k,2184) = - lu(k,1584) * lu(k,2164) + lu(k,2185) = - lu(k,1585) * lu(k,2164) + lu(k,2186) = lu(k,2186) - lu(k,1586) * lu(k,2164) + lu(k,2187) = lu(k,2187) - lu(k,1587) * lu(k,2164) + lu(k,2188) = lu(k,2188) - lu(k,1588) * lu(k,2164) + lu(k,2189) = - lu(k,1589) * lu(k,2164) + lu(k,2190) = lu(k,2190) - lu(k,1590) * lu(k,2164) + lu(k,2191) = lu(k,2191) - lu(k,1591) * lu(k,2164) + lu(k,2192) = - lu(k,1592) * lu(k,2164) + lu(k,2195) = lu(k,2195) - lu(k,1593) * lu(k,2164) + lu(k,2196) = lu(k,2196) - lu(k,1594) * lu(k,2164) + lu(k,3074) = lu(k,3074) - lu(k,1571) * lu(k,3072) + lu(k,3075) = - lu(k,1572) * lu(k,3072) + lu(k,3076) = - lu(k,1573) * lu(k,3072) + lu(k,3077) = lu(k,3077) - lu(k,1574) * lu(k,3072) + lu(k,3079) = - lu(k,1575) * lu(k,3072) + lu(k,3081) = lu(k,3081) - lu(k,1576) * lu(k,3072) + lu(k,3083) = - lu(k,1577) * lu(k,3072) + lu(k,3088) = lu(k,3088) - lu(k,1578) * lu(k,3072) + lu(k,3089) = lu(k,3089) - lu(k,1579) * lu(k,3072) + lu(k,3090) = - lu(k,1580) * lu(k,3072) + lu(k,3097) = lu(k,3097) - lu(k,1581) * lu(k,3072) + lu(k,3098) = lu(k,3098) - lu(k,1582) * lu(k,3072) + lu(k,3126) = lu(k,3126) - lu(k,1583) * lu(k,3072) + lu(k,3127) = lu(k,3127) - lu(k,1584) * lu(k,3072) + lu(k,3128) = lu(k,3128) - lu(k,1585) * lu(k,3072) + lu(k,3129) = lu(k,3129) - lu(k,1586) * lu(k,3072) + lu(k,3130) = lu(k,3130) - lu(k,1587) * lu(k,3072) + lu(k,3131) = lu(k,3131) - lu(k,1588) * lu(k,3072) + lu(k,3132) = lu(k,3132) - lu(k,1589) * lu(k,3072) + lu(k,3133) = lu(k,3133) - lu(k,1590) * lu(k,3072) + lu(k,3134) = lu(k,3134) - lu(k,1591) * lu(k,3072) + lu(k,3135) = lu(k,3135) - lu(k,1592) * lu(k,3072) + lu(k,3138) = lu(k,3138) - lu(k,1593) * lu(k,3072) + lu(k,3139) = lu(k,3139) - lu(k,1594) * lu(k,3072) + lu(k,3507) = lu(k,3507) - lu(k,1571) * lu(k,3506) + lu(k,3509) = lu(k,3509) - lu(k,1572) * lu(k,3506) + lu(k,3510) = lu(k,3510) - lu(k,1573) * lu(k,3506) + lu(k,3514) = lu(k,3514) - lu(k,1574) * lu(k,3506) + lu(k,3516) = lu(k,3516) - lu(k,1575) * lu(k,3506) + lu(k,3518) = lu(k,3518) - lu(k,1576) * lu(k,3506) + lu(k,3520) = lu(k,3520) - lu(k,1577) * lu(k,3506) + lu(k,3525) = lu(k,3525) - lu(k,1578) * lu(k,3506) + lu(k,3526) = lu(k,3526) - lu(k,1579) * lu(k,3506) + lu(k,3527) = lu(k,3527) - lu(k,1580) * lu(k,3506) + lu(k,3534) = lu(k,3534) - lu(k,1581) * lu(k,3506) + lu(k,3535) = lu(k,3535) - lu(k,1582) * lu(k,3506) + lu(k,3564) = lu(k,3564) - lu(k,1583) * lu(k,3506) + lu(k,3565) = lu(k,3565) - lu(k,1584) * lu(k,3506) + lu(k,3566) = lu(k,3566) - lu(k,1585) * lu(k,3506) + lu(k,3567) = lu(k,3567) - lu(k,1586) * lu(k,3506) + lu(k,3568) = lu(k,3568) - lu(k,1587) * lu(k,3506) + lu(k,3569) = lu(k,3569) - lu(k,1588) * lu(k,3506) + lu(k,3570) = lu(k,3570) - lu(k,1589) * lu(k,3506) + lu(k,3571) = lu(k,3571) - lu(k,1590) * lu(k,3506) + lu(k,3572) = lu(k,3572) - lu(k,1591) * lu(k,3506) + lu(k,3573) = lu(k,3573) - lu(k,1592) * lu(k,3506) + lu(k,3576) = lu(k,3576) - lu(k,1593) * lu(k,3506) + lu(k,3577) = lu(k,3577) - lu(k,1594) * lu(k,3506) + lu(k,3758) = lu(k,3758) - lu(k,1571) * lu(k,3756) + lu(k,3760) = lu(k,3760) - lu(k,1572) * lu(k,3756) + lu(k,3761) = lu(k,3761) - lu(k,1573) * lu(k,3756) + lu(k,3765) = lu(k,3765) - lu(k,1574) * lu(k,3756) + lu(k,3767) = lu(k,3767) - lu(k,1575) * lu(k,3756) + lu(k,3769) = lu(k,3769) - lu(k,1576) * lu(k,3756) + lu(k,3771) = lu(k,3771) - lu(k,1577) * lu(k,3756) + lu(k,3776) = lu(k,3776) - lu(k,1578) * lu(k,3756) + lu(k,3777) = lu(k,3777) - lu(k,1579) * lu(k,3756) + lu(k,3778) = lu(k,3778) - lu(k,1580) * lu(k,3756) + lu(k,3785) = lu(k,3785) - lu(k,1581) * lu(k,3756) + lu(k,3786) = lu(k,3786) - lu(k,1582) * lu(k,3756) + lu(k,3814) = lu(k,3814) - lu(k,1583) * lu(k,3756) + lu(k,3815) = lu(k,3815) - lu(k,1584) * lu(k,3756) + lu(k,3816) = lu(k,3816) - lu(k,1585) * lu(k,3756) + lu(k,3817) = lu(k,3817) - lu(k,1586) * lu(k,3756) + lu(k,3818) = lu(k,3818) - lu(k,1587) * lu(k,3756) + lu(k,3819) = lu(k,3819) - lu(k,1588) * lu(k,3756) + lu(k,3820) = lu(k,3820) - lu(k,1589) * lu(k,3756) + lu(k,3821) = lu(k,3821) - lu(k,1590) * lu(k,3756) + lu(k,3822) = lu(k,3822) - lu(k,1591) * lu(k,3756) + lu(k,3823) = lu(k,3823) - lu(k,1592) * lu(k,3756) + lu(k,3826) = lu(k,3826) - lu(k,1593) * lu(k,3756) + lu(k,3827) = lu(k,3827) - lu(k,1594) * lu(k,3756) end do end subroutine lu_fac34 subroutine lu_fac35( avec_len, lu ) @@ -7193,248 +6980,220 @@ subroutine lu_fac35( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1540) = 1._r8 / lu(k,1540) - lu(k,1541) = lu(k,1541) * lu(k,1540) - lu(k,1542) = lu(k,1542) * lu(k,1540) - lu(k,1543) = lu(k,1543) * lu(k,1540) - lu(k,1558) = - lu(k,1541) * lu(k,1549) - lu(k,1560) = lu(k,1560) - lu(k,1542) * lu(k,1549) - lu(k,1564) = lu(k,1564) - lu(k,1543) * lu(k,1549) - lu(k,1579) = - lu(k,1541) * lu(k,1570) - lu(k,1581) = lu(k,1581) - lu(k,1542) * lu(k,1570) - lu(k,1585) = lu(k,1585) - lu(k,1543) * lu(k,1570) - lu(k,1623) = - lu(k,1541) * lu(k,1618) - lu(k,1624) = lu(k,1624) - lu(k,1542) * lu(k,1618) - lu(k,1627) = lu(k,1627) - lu(k,1543) * lu(k,1618) - lu(k,1639) = - lu(k,1541) * lu(k,1632) - lu(k,1640) = lu(k,1640) - lu(k,1542) * lu(k,1632) - lu(k,1643) = lu(k,1643) - lu(k,1543) * lu(k,1632) - lu(k,1649) = - lu(k,1541) * lu(k,1644) - lu(k,1651) = lu(k,1651) - lu(k,1542) * lu(k,1644) - lu(k,1652) = lu(k,1652) - lu(k,1543) * lu(k,1644) - lu(k,1676) = - lu(k,1541) * lu(k,1664) - lu(k,1678) = lu(k,1678) - lu(k,1542) * lu(k,1664) - lu(k,1682) = lu(k,1682) - lu(k,1543) * lu(k,1664) - lu(k,1686) = lu(k,1686) - lu(k,1541) * lu(k,1684) - lu(k,1689) = lu(k,1689) - lu(k,1542) * lu(k,1684) - lu(k,1692) = lu(k,1692) - lu(k,1543) * lu(k,1684) - lu(k,1704) = - lu(k,1541) * lu(k,1697) - lu(k,1706) = lu(k,1706) - lu(k,1542) * lu(k,1697) - lu(k,1709) = lu(k,1709) - lu(k,1543) * lu(k,1697) - lu(k,1738) = - lu(k,1541) * lu(k,1722) - lu(k,1740) = lu(k,1740) - lu(k,1542) * lu(k,1722) - lu(k,1744) = lu(k,1744) - lu(k,1543) * lu(k,1722) - lu(k,1755) = - lu(k,1541) * lu(k,1748) - lu(k,1759) = lu(k,1759) - lu(k,1542) * lu(k,1748) - lu(k,1763) = lu(k,1763) - lu(k,1543) * lu(k,1748) - lu(k,1788) = - lu(k,1541) * lu(k,1777) - lu(k,1790) = lu(k,1790) - lu(k,1542) * lu(k,1777) - lu(k,1794) = lu(k,1794) - lu(k,1543) * lu(k,1777) - lu(k,1805) = - lu(k,1541) * lu(k,1800) - lu(k,1806) = lu(k,1806) - lu(k,1542) * lu(k,1800) - lu(k,1809) = lu(k,1809) - lu(k,1543) * lu(k,1800) - lu(k,1836) = - lu(k,1541) * lu(k,1821) - lu(k,1838) = lu(k,1838) - lu(k,1542) * lu(k,1821) - lu(k,1842) = lu(k,1842) - lu(k,1543) * lu(k,1821) - lu(k,1848) = - lu(k,1541) * lu(k,1844) - lu(k,1850) = lu(k,1850) - lu(k,1542) * lu(k,1844) - lu(k,1851) = lu(k,1851) - lu(k,1543) * lu(k,1844) - lu(k,1866) = - lu(k,1541) * lu(k,1859) - lu(k,1870) = lu(k,1870) - lu(k,1542) * lu(k,1859) - lu(k,1874) = lu(k,1874) - lu(k,1543) * lu(k,1859) - lu(k,1902) = - lu(k,1541) * lu(k,1886) - lu(k,1906) = lu(k,1906) - lu(k,1542) * lu(k,1886) - lu(k,1910) = lu(k,1910) - lu(k,1543) * lu(k,1886) - lu(k,1934) = - lu(k,1541) * lu(k,1923) - lu(k,1938) = lu(k,1938) - lu(k,1542) * lu(k,1923) - lu(k,1942) = lu(k,1942) - lu(k,1543) * lu(k,1923) - lu(k,1968) = - lu(k,1541) * lu(k,1957) - lu(k,1972) = lu(k,1972) - lu(k,1542) * lu(k,1957) - lu(k,1976) = lu(k,1976) - lu(k,1543) * lu(k,1957) - lu(k,1996) = - lu(k,1541) * lu(k,1986) - lu(k,2000) = lu(k,2000) - lu(k,1542) * lu(k,1986) - lu(k,2004) = lu(k,2004) - lu(k,1543) * lu(k,1986) - lu(k,2038) = - lu(k,1541) * lu(k,2023) - lu(k,2042) = lu(k,2042) - lu(k,1542) * lu(k,2023) - lu(k,2047) = lu(k,2047) - lu(k,1543) * lu(k,2023) - lu(k,2198) = - lu(k,1541) * lu(k,2192) - lu(k,2200) = lu(k,2200) - lu(k,1542) * lu(k,2192) - lu(k,2201) = lu(k,2201) - lu(k,1543) * lu(k,2192) - lu(k,2453) = - lu(k,1541) * lu(k,2443) - lu(k,2456) = lu(k,2456) - lu(k,1542) * lu(k,2443) - lu(k,2460) = lu(k,2460) - lu(k,1543) * lu(k,2443) - lu(k,2474) = - lu(k,1541) * lu(k,2463) - lu(k,2477) = lu(k,2477) - lu(k,1542) * lu(k,2463) - lu(k,2481) = lu(k,2481) - lu(k,1543) * lu(k,2463) - lu(k,2537) = - lu(k,1541) * lu(k,2509) - lu(k,2541) = lu(k,2541) - lu(k,1542) * lu(k,2509) - lu(k,2546) = lu(k,2546) - lu(k,1543) * lu(k,2509) - lu(k,2583) = - lu(k,1541) * lu(k,2555) - lu(k,2587) = lu(k,2587) - lu(k,1542) * lu(k,2555) - lu(k,2592) = lu(k,2592) - lu(k,1543) * lu(k,2555) - lu(k,2630) = - lu(k,1541) * lu(k,2602) - lu(k,2634) = lu(k,2634) - lu(k,1542) * lu(k,2602) - lu(k,2639) = lu(k,2639) - lu(k,1543) * lu(k,2602) - lu(k,2701) = - lu(k,1541) * lu(k,2655) - lu(k,2705) = lu(k,2705) - lu(k,1542) * lu(k,2655) - lu(k,2710) = lu(k,2710) - lu(k,1543) * lu(k,2655) - lu(k,2884) = lu(k,2884) - lu(k,1541) * lu(k,2836) - lu(k,2889) = lu(k,2889) - lu(k,1542) * lu(k,2836) - lu(k,2895) = lu(k,2895) - lu(k,1543) * lu(k,2836) - lu(k,2985) = lu(k,2985) - lu(k,1541) * lu(k,2940) - lu(k,2990) = lu(k,2990) - lu(k,1542) * lu(k,2940) - lu(k,2996) = lu(k,2996) - lu(k,1543) * lu(k,2940) - lu(k,3077) = lu(k,3077) - lu(k,1541) * lu(k,3031) - lu(k,3082) = lu(k,3082) - lu(k,1542) * lu(k,3031) - lu(k,3088) = lu(k,3088) - lu(k,1543) * lu(k,3031) - lu(k,3280) = lu(k,3280) - lu(k,1541) * lu(k,3232) - lu(k,3285) = lu(k,3285) - lu(k,1542) * lu(k,3232) - lu(k,3291) = lu(k,3291) - lu(k,1543) * lu(k,3232) - lu(k,3330) = lu(k,3330) - lu(k,1541) * lu(k,3327) - lu(k,3335) = lu(k,3335) - lu(k,1542) * lu(k,3327) - lu(k,3341) = lu(k,3341) - lu(k,1543) * lu(k,3327) - lu(k,3421) = lu(k,3421) - lu(k,1541) * lu(k,3374) - lu(k,3426) = lu(k,3426) - lu(k,1542) * lu(k,3374) - lu(k,3432) = lu(k,3432) - lu(k,1543) * lu(k,3374) - lu(k,3451) = lu(k,3451) - lu(k,1541) * lu(k,3448) - lu(k,3456) = lu(k,3456) - lu(k,1542) * lu(k,3448) - lu(k,3462) = lu(k,3462) - lu(k,1543) * lu(k,3448) - lu(k,3501) = lu(k,3501) - lu(k,1541) * lu(k,3490) - lu(k,3506) = lu(k,3506) - lu(k,1542) * lu(k,3490) - lu(k,3512) = lu(k,3512) - lu(k,1543) * lu(k,3490) - lu(k,3741) = lu(k,3741) - lu(k,1541) * lu(k,3694) - lu(k,3746) = lu(k,3746) - lu(k,1542) * lu(k,3694) - lu(k,3752) = lu(k,3752) - lu(k,1543) * lu(k,3694) - lu(k,3822) = lu(k,3822) - lu(k,1541) * lu(k,3818) - lu(k,3827) = lu(k,3827) - lu(k,1542) * lu(k,3818) - lu(k,3833) = lu(k,3833) - lu(k,1543) * lu(k,3818) - lu(k,1550) = 1._r8 / lu(k,1550) - lu(k,1551) = lu(k,1551) * lu(k,1550) - lu(k,1552) = lu(k,1552) * lu(k,1550) - lu(k,1553) = lu(k,1553) * lu(k,1550) - lu(k,1554) = lu(k,1554) * lu(k,1550) - lu(k,1555) = lu(k,1555) * lu(k,1550) - lu(k,1556) = lu(k,1556) * lu(k,1550) - lu(k,1557) = lu(k,1557) * lu(k,1550) - lu(k,1558) = lu(k,1558) * lu(k,1550) - lu(k,1559) = lu(k,1559) * lu(k,1550) - lu(k,1560) = lu(k,1560) * lu(k,1550) - lu(k,1561) = lu(k,1561) * lu(k,1550) - lu(k,1562) = lu(k,1562) * lu(k,1550) - lu(k,1563) = lu(k,1563) * lu(k,1550) - lu(k,1564) = lu(k,1564) * lu(k,1550) - lu(k,1823) = lu(k,1823) - lu(k,1551) * lu(k,1822) - lu(k,1826) = - lu(k,1552) * lu(k,1822) - lu(k,1829) = lu(k,1829) - lu(k,1553) * lu(k,1822) - lu(k,1830) = lu(k,1830) - lu(k,1554) * lu(k,1822) - lu(k,1832) = lu(k,1832) - lu(k,1555) * lu(k,1822) - lu(k,1833) = - lu(k,1556) * lu(k,1822) - lu(k,1834) = lu(k,1834) - lu(k,1557) * lu(k,1822) - lu(k,1836) = lu(k,1836) - lu(k,1558) * lu(k,1822) - lu(k,1837) = lu(k,1837) - lu(k,1559) * lu(k,1822) - lu(k,1838) = lu(k,1838) - lu(k,1560) * lu(k,1822) - lu(k,1839) = lu(k,1839) - lu(k,1561) * lu(k,1822) - lu(k,1840) = lu(k,1840) - lu(k,1562) * lu(k,1822) - lu(k,1841) = lu(k,1841) - lu(k,1563) * lu(k,1822) - lu(k,1842) = lu(k,1842) - lu(k,1564) * lu(k,1822) - lu(k,2660) = lu(k,2660) - lu(k,1551) * lu(k,2656) - lu(k,2664) = lu(k,2664) - lu(k,1552) * lu(k,2656) - lu(k,2669) = lu(k,2669) - lu(k,1553) * lu(k,2656) - lu(k,2670) = lu(k,2670) - lu(k,1554) * lu(k,2656) - lu(k,2672) = - lu(k,1555) * lu(k,2656) - lu(k,2674) = - lu(k,1556) * lu(k,2656) - lu(k,2699) = lu(k,2699) - lu(k,1557) * lu(k,2656) - lu(k,2701) = lu(k,2701) - lu(k,1558) * lu(k,2656) - lu(k,2702) = lu(k,2702) - lu(k,1559) * lu(k,2656) - lu(k,2705) = lu(k,2705) - lu(k,1560) * lu(k,2656) - lu(k,2706) = lu(k,2706) - lu(k,1561) * lu(k,2656) - lu(k,2707) = lu(k,2707) - lu(k,1562) * lu(k,2656) - lu(k,2709) = lu(k,2709) - lu(k,1563) * lu(k,2656) - lu(k,2710) = lu(k,2710) - lu(k,1564) * lu(k,2656) - lu(k,2841) = lu(k,2841) - lu(k,1551) * lu(k,2837) - lu(k,2847) = lu(k,2847) - lu(k,1552) * lu(k,2837) - lu(k,2852) = lu(k,2852) - lu(k,1553) * lu(k,2837) - lu(k,2853) = lu(k,2853) - lu(k,1554) * lu(k,2837) - lu(k,2855) = - lu(k,1555) * lu(k,2837) - lu(k,2857) = lu(k,2857) - lu(k,1556) * lu(k,2837) - lu(k,2882) = lu(k,2882) - lu(k,1557) * lu(k,2837) - lu(k,2884) = lu(k,2884) - lu(k,1558) * lu(k,2837) - lu(k,2885) = lu(k,2885) - lu(k,1559) * lu(k,2837) - lu(k,2889) = lu(k,2889) - lu(k,1560) * lu(k,2837) - lu(k,2891) = lu(k,2891) - lu(k,1561) * lu(k,2837) - lu(k,2892) = lu(k,2892) - lu(k,1562) * lu(k,2837) - lu(k,2894) = lu(k,2894) - lu(k,1563) * lu(k,2837) - lu(k,2895) = lu(k,2895) - lu(k,1564) * lu(k,2837) - lu(k,2943) = lu(k,2943) - lu(k,1551) * lu(k,2941) - lu(k,2949) = - lu(k,1552) * lu(k,2941) - lu(k,2954) = lu(k,2954) - lu(k,1553) * lu(k,2941) - lu(k,2955) = lu(k,2955) - lu(k,1554) * lu(k,2941) - lu(k,2957) = - lu(k,1555) * lu(k,2941) - lu(k,2959) = lu(k,2959) - lu(k,1556) * lu(k,2941) - lu(k,2983) = lu(k,2983) - lu(k,1557) * lu(k,2941) - lu(k,2985) = lu(k,2985) - lu(k,1558) * lu(k,2941) - lu(k,2986) = lu(k,2986) - lu(k,1559) * lu(k,2941) - lu(k,2990) = lu(k,2990) - lu(k,1560) * lu(k,2941) - lu(k,2992) = lu(k,2992) - lu(k,1561) * lu(k,2941) - lu(k,2993) = lu(k,2993) - lu(k,1562) * lu(k,2941) - lu(k,2995) = lu(k,2995) - lu(k,1563) * lu(k,2941) - lu(k,2996) = lu(k,2996) - lu(k,1564) * lu(k,2941) - lu(k,3036) = lu(k,3036) - lu(k,1551) * lu(k,3032) - lu(k,3040) = - lu(k,1552) * lu(k,3032) - lu(k,3045) = lu(k,3045) - lu(k,1553) * lu(k,3032) - lu(k,3046) = lu(k,3046) - lu(k,1554) * lu(k,3032) - lu(k,3048) = - lu(k,1555) * lu(k,3032) - lu(k,3050) = - lu(k,1556) * lu(k,3032) - lu(k,3075) = lu(k,3075) - lu(k,1557) * lu(k,3032) - lu(k,3077) = lu(k,3077) - lu(k,1558) * lu(k,3032) - lu(k,3078) = lu(k,3078) - lu(k,1559) * lu(k,3032) - lu(k,3082) = lu(k,3082) - lu(k,1560) * lu(k,3032) - lu(k,3084) = lu(k,3084) - lu(k,1561) * lu(k,3032) - lu(k,3085) = lu(k,3085) - lu(k,1562) * lu(k,3032) - lu(k,3087) = lu(k,3087) - lu(k,1563) * lu(k,3032) - lu(k,3088) = lu(k,3088) - lu(k,1564) * lu(k,3032) - lu(k,3237) = lu(k,3237) - lu(k,1551) * lu(k,3233) - lu(k,3243) = - lu(k,1552) * lu(k,3233) - lu(k,3248) = lu(k,3248) - lu(k,1553) * lu(k,3233) - lu(k,3249) = lu(k,3249) - lu(k,1554) * lu(k,3233) - lu(k,3251) = lu(k,3251) - lu(k,1555) * lu(k,3233) - lu(k,3253) = - lu(k,1556) * lu(k,3233) - lu(k,3278) = lu(k,3278) - lu(k,1557) * lu(k,3233) - lu(k,3280) = lu(k,3280) - lu(k,1558) * lu(k,3233) - lu(k,3281) = lu(k,3281) - lu(k,1559) * lu(k,3233) - lu(k,3285) = lu(k,3285) - lu(k,1560) * lu(k,3233) - lu(k,3287) = lu(k,3287) - lu(k,1561) * lu(k,3233) - lu(k,3288) = lu(k,3288) - lu(k,1562) * lu(k,3233) - lu(k,3290) = lu(k,3290) - lu(k,1563) * lu(k,3233) - lu(k,3291) = lu(k,3291) - lu(k,1564) * lu(k,3233) - lu(k,3379) = lu(k,3379) - lu(k,1551) * lu(k,3375) - lu(k,3384) = lu(k,3384) - lu(k,1552) * lu(k,3375) - lu(k,3389) = lu(k,3389) - lu(k,1553) * lu(k,3375) - lu(k,3390) = lu(k,3390) - lu(k,1554) * lu(k,3375) - lu(k,3392) = - lu(k,1555) * lu(k,3375) - lu(k,3394) = lu(k,3394) - lu(k,1556) * lu(k,3375) - lu(k,3419) = lu(k,3419) - lu(k,1557) * lu(k,3375) - lu(k,3421) = lu(k,3421) - lu(k,1558) * lu(k,3375) - lu(k,3422) = lu(k,3422) - lu(k,1559) * lu(k,3375) - lu(k,3426) = lu(k,3426) - lu(k,1560) * lu(k,3375) - lu(k,3428) = lu(k,3428) - lu(k,1561) * lu(k,3375) - lu(k,3429) = lu(k,3429) - lu(k,1562) * lu(k,3375) - lu(k,3431) = lu(k,3431) - lu(k,1563) * lu(k,3375) - lu(k,3432) = lu(k,3432) - lu(k,1564) * lu(k,3375) - lu(k,3699) = lu(k,3699) - lu(k,1551) * lu(k,3695) - lu(k,3705) = lu(k,3705) - lu(k,1552) * lu(k,3695) - lu(k,3710) = lu(k,3710) - lu(k,1553) * lu(k,3695) - lu(k,3711) = lu(k,3711) - lu(k,1554) * lu(k,3695) - lu(k,3713) = lu(k,3713) - lu(k,1555) * lu(k,3695) - lu(k,3715) = lu(k,3715) - lu(k,1556) * lu(k,3695) - lu(k,3739) = lu(k,3739) - lu(k,1557) * lu(k,3695) - lu(k,3741) = lu(k,3741) - lu(k,1558) * lu(k,3695) - lu(k,3742) = lu(k,3742) - lu(k,1559) * lu(k,3695) - lu(k,3746) = lu(k,3746) - lu(k,1560) * lu(k,3695) - lu(k,3748) = lu(k,3748) - lu(k,1561) * lu(k,3695) - lu(k,3749) = lu(k,3749) - lu(k,1562) * lu(k,3695) - lu(k,3751) = lu(k,3751) - lu(k,1563) * lu(k,3695) - lu(k,3752) = lu(k,3752) - lu(k,1564) * lu(k,3695) + lu(k,1598) = 1._r8 / lu(k,1598) + lu(k,1599) = lu(k,1599) * lu(k,1598) + lu(k,1600) = lu(k,1600) * lu(k,1598) + lu(k,1601) = lu(k,1601) * lu(k,1598) + lu(k,1602) = lu(k,1602) * lu(k,1598) + lu(k,1603) = lu(k,1603) * lu(k,1598) + lu(k,1604) = lu(k,1604) * lu(k,1598) + lu(k,1605) = lu(k,1605) * lu(k,1598) + lu(k,1606) = lu(k,1606) * lu(k,1598) + lu(k,1607) = lu(k,1607) * lu(k,1598) + lu(k,1608) = lu(k,1608) * lu(k,1598) + lu(k,1609) = lu(k,1609) * lu(k,1598) + lu(k,1610) = lu(k,1610) * lu(k,1598) + lu(k,2554) = lu(k,2554) - lu(k,1599) * lu(k,2553) + lu(k,2555) = lu(k,2555) - lu(k,1600) * lu(k,2553) + lu(k,2556) = - lu(k,1601) * lu(k,2553) + lu(k,2557) = lu(k,2557) - lu(k,1602) * lu(k,2553) + lu(k,2559) = - lu(k,1603) * lu(k,2553) + lu(k,2561) = lu(k,2561) - lu(k,1604) * lu(k,2553) + lu(k,2564) = lu(k,2564) - lu(k,1605) * lu(k,2553) + lu(k,2565) = lu(k,2565) - lu(k,1606) * lu(k,2553) + lu(k,2566) = lu(k,2566) - lu(k,1607) * lu(k,2553) + lu(k,2567) = lu(k,2567) - lu(k,1608) * lu(k,2553) + lu(k,2569) = lu(k,2569) - lu(k,1609) * lu(k,2553) + lu(k,2570) = lu(k,2570) - lu(k,1610) * lu(k,2553) + lu(k,2594) = lu(k,2594) - lu(k,1599) * lu(k,2593) + lu(k,2595) = lu(k,2595) - lu(k,1600) * lu(k,2593) + lu(k,2596) = - lu(k,1601) * lu(k,2593) + lu(k,2597) = lu(k,2597) - lu(k,1602) * lu(k,2593) + lu(k,2599) = - lu(k,1603) * lu(k,2593) + lu(k,2601) = lu(k,2601) - lu(k,1604) * lu(k,2593) + lu(k,2604) = lu(k,2604) - lu(k,1605) * lu(k,2593) + lu(k,2605) = lu(k,2605) - lu(k,1606) * lu(k,2593) + lu(k,2606) = lu(k,2606) - lu(k,1607) * lu(k,2593) + lu(k,2607) = lu(k,2607) - lu(k,1608) * lu(k,2593) + lu(k,2610) = lu(k,2610) - lu(k,1609) * lu(k,2593) + lu(k,2611) = lu(k,2611) - lu(k,1610) * lu(k,2593) + lu(k,3099) = lu(k,3099) - lu(k,1599) * lu(k,3073) + lu(k,3113) = lu(k,3113) - lu(k,1600) * lu(k,3073) + lu(k,3114) = lu(k,3114) - lu(k,1601) * lu(k,3073) + lu(k,3115) = lu(k,3115) - lu(k,1602) * lu(k,3073) + lu(k,3127) = lu(k,3127) - lu(k,1603) * lu(k,3073) + lu(k,3129) = lu(k,3129) - lu(k,1604) * lu(k,3073) + lu(k,3132) = lu(k,3132) - lu(k,1605) * lu(k,3073) + lu(k,3133) = lu(k,3133) - lu(k,1606) * lu(k,3073) + lu(k,3134) = lu(k,3134) - lu(k,1607) * lu(k,3073) + lu(k,3135) = lu(k,3135) - lu(k,1608) * lu(k,3073) + lu(k,3138) = lu(k,3138) - lu(k,1609) * lu(k,3073) + lu(k,3139) = lu(k,3139) - lu(k,1610) * lu(k,3073) + lu(k,3379) = lu(k,3379) - lu(k,1599) * lu(k,3376) + lu(k,3381) = lu(k,3381) - lu(k,1600) * lu(k,3376) + lu(k,3382) = lu(k,3382) - lu(k,1601) * lu(k,3376) + lu(k,3383) = lu(k,3383) - lu(k,1602) * lu(k,3376) + lu(k,3385) = lu(k,3385) - lu(k,1603) * lu(k,3376) + lu(k,3387) = lu(k,3387) - lu(k,1604) * lu(k,3376) + lu(k,3390) = lu(k,3390) - lu(k,1605) * lu(k,3376) + lu(k,3391) = lu(k,3391) - lu(k,1606) * lu(k,3376) + lu(k,3392) = lu(k,3392) - lu(k,1607) * lu(k,3376) + lu(k,3393) = lu(k,3393) - lu(k,1608) * lu(k,3376) + lu(k,3396) = lu(k,3396) - lu(k,1609) * lu(k,3376) + lu(k,3397) = lu(k,3397) - lu(k,1610) * lu(k,3376) + lu(k,3787) = lu(k,3787) - lu(k,1599) * lu(k,3757) + lu(k,3801) = lu(k,3801) - lu(k,1600) * lu(k,3757) + lu(k,3802) = lu(k,3802) - lu(k,1601) * lu(k,3757) + lu(k,3803) = lu(k,3803) - lu(k,1602) * lu(k,3757) + lu(k,3815) = lu(k,3815) - lu(k,1603) * lu(k,3757) + lu(k,3817) = lu(k,3817) - lu(k,1604) * lu(k,3757) + lu(k,3820) = lu(k,3820) - lu(k,1605) * lu(k,3757) + lu(k,3821) = lu(k,3821) - lu(k,1606) * lu(k,3757) + lu(k,3822) = lu(k,3822) - lu(k,1607) * lu(k,3757) + lu(k,3823) = lu(k,3823) - lu(k,1608) * lu(k,3757) + lu(k,3826) = lu(k,3826) - lu(k,1609) * lu(k,3757) + lu(k,3827) = lu(k,3827) - lu(k,1610) * lu(k,3757) + lu(k,3921) = - lu(k,1599) * lu(k,3896) + lu(k,3936) = - lu(k,1600) * lu(k,3896) + lu(k,3937) = - lu(k,1601) * lu(k,3896) + lu(k,3938) = - lu(k,1602) * lu(k,3896) + lu(k,3950) = lu(k,3950) - lu(k,1603) * lu(k,3896) + lu(k,3952) = lu(k,3952) - lu(k,1604) * lu(k,3896) + lu(k,3955) = lu(k,3955) - lu(k,1605) * lu(k,3896) + lu(k,3956) = lu(k,3956) - lu(k,1606) * lu(k,3896) + lu(k,3957) = lu(k,3957) - lu(k,1607) * lu(k,3896) + lu(k,3958) = lu(k,3958) - lu(k,1608) * lu(k,3896) + lu(k,3961) = lu(k,3961) - lu(k,1609) * lu(k,3896) + lu(k,3962) = lu(k,3962) - lu(k,1610) * lu(k,3896) + lu(k,4083) = lu(k,4083) - lu(k,1599) * lu(k,4077) + lu(k,4085) = lu(k,4085) - lu(k,1600) * lu(k,4077) + lu(k,4086) = lu(k,4086) - lu(k,1601) * lu(k,4077) + lu(k,4087) = lu(k,4087) - lu(k,1602) * lu(k,4077) + lu(k,4094) = lu(k,4094) - lu(k,1603) * lu(k,4077) + lu(k,4096) = lu(k,4096) - lu(k,1604) * lu(k,4077) + lu(k,4099) = lu(k,4099) - lu(k,1605) * lu(k,4077) + lu(k,4100) = lu(k,4100) - lu(k,1606) * lu(k,4077) + lu(k,4101) = lu(k,4101) - lu(k,1607) * lu(k,4077) + lu(k,4102) = lu(k,4102) - lu(k,1608) * lu(k,4077) + lu(k,4105) = lu(k,4105) - lu(k,1609) * lu(k,4077) + lu(k,4106) = lu(k,4106) - lu(k,1610) * lu(k,4077) + lu(k,4114) = - lu(k,1599) * lu(k,4112) + lu(k,4116) = - lu(k,1600) * lu(k,4112) + lu(k,4117) = lu(k,4117) - lu(k,1601) * lu(k,4112) + lu(k,4118) = - lu(k,1602) * lu(k,4112) + lu(k,4120) = - lu(k,1603) * lu(k,4112) + lu(k,4122) = - lu(k,1604) * lu(k,4112) + lu(k,4125) = lu(k,4125) - lu(k,1605) * lu(k,4112) + lu(k,4126) = lu(k,4126) - lu(k,1606) * lu(k,4112) + lu(k,4127) = lu(k,4127) - lu(k,1607) * lu(k,4112) + lu(k,4128) = - lu(k,1608) * lu(k,4112) + lu(k,4131) = - lu(k,1609) * lu(k,4112) + lu(k,4132) = lu(k,4132) - lu(k,1610) * lu(k,4112) + lu(k,1611) = 1._r8 / lu(k,1611) + lu(k,1612) = lu(k,1612) * lu(k,1611) + lu(k,1613) = lu(k,1613) * lu(k,1611) + lu(k,1620) = lu(k,1620) - lu(k,1612) * lu(k,1617) + lu(k,1625) = - lu(k,1613) * lu(k,1617) + lu(k,1644) = lu(k,1644) - lu(k,1612) * lu(k,1637) + lu(k,1650) = - lu(k,1613) * lu(k,1637) + lu(k,1662) = lu(k,1662) - lu(k,1612) * lu(k,1656) + lu(k,1665) = - lu(k,1613) * lu(k,1656) + lu(k,1711) = lu(k,1711) - lu(k,1612) * lu(k,1709) + lu(k,1713) = - lu(k,1613) * lu(k,1709) + lu(k,1745) = lu(k,1745) - lu(k,1612) * lu(k,1738) + lu(k,1751) = - lu(k,1613) * lu(k,1738) + lu(k,1773) = lu(k,1773) - lu(k,1612) * lu(k,1766) + lu(k,1779) = - lu(k,1613) * lu(k,1766) + lu(k,1793) = lu(k,1793) - lu(k,1612) * lu(k,1787) + lu(k,1797) = - lu(k,1613) * lu(k,1787) + lu(k,1819) = lu(k,1819) - lu(k,1612) * lu(k,1811) + lu(k,1827) = - lu(k,1613) * lu(k,1811) + lu(k,1850) = lu(k,1850) - lu(k,1612) * lu(k,1843) + lu(k,1858) = - lu(k,1613) * lu(k,1843) + lu(k,1872) = lu(k,1872) - lu(k,1612) * lu(k,1866) + lu(k,1877) = - lu(k,1613) * lu(k,1866) + lu(k,1896) = lu(k,1896) - lu(k,1612) * lu(k,1889) + lu(k,1905) = - lu(k,1613) * lu(k,1889) + lu(k,1918) = lu(k,1918) - lu(k,1612) * lu(k,1917) + lu(k,1919) = - lu(k,1613) * lu(k,1917) + lu(k,1928) = lu(k,1928) - lu(k,1612) * lu(k,1925) + lu(k,1933) = - lu(k,1613) * lu(k,1925) + lu(k,1957) = lu(k,1957) - lu(k,1612) * lu(k,1946) + lu(k,1968) = - lu(k,1613) * lu(k,1946) + lu(k,1994) = lu(k,1994) - lu(k,1612) * lu(k,1983) + lu(k,2007) = - lu(k,1613) * lu(k,1983) + lu(k,2021) = lu(k,2021) - lu(k,1612) * lu(k,2016) + lu(k,2029) = - lu(k,1613) * lu(k,2016) + lu(k,2045) = lu(k,2045) - lu(k,1612) * lu(k,2041) + lu(k,2054) = - lu(k,1613) * lu(k,2041) + lu(k,2076) = lu(k,2076) - lu(k,1612) * lu(k,2068) + lu(k,2086) = lu(k,2086) - lu(k,1613) * lu(k,2068) + lu(k,2108) = lu(k,2108) - lu(k,1612) * lu(k,2100) + lu(k,2118) = lu(k,2118) - lu(k,1613) * lu(k,2100) + lu(k,2138) = lu(k,2138) - lu(k,1612) * lu(k,2130) + lu(k,2147) = lu(k,2147) - lu(k,1613) * lu(k,2130) + lu(k,2173) = lu(k,2173) - lu(k,1612) * lu(k,2165) + lu(k,2189) = lu(k,2189) - lu(k,1613) * lu(k,2165) + lu(k,2212) = - lu(k,1612) * lu(k,2211) + lu(k,2224) = - lu(k,1613) * lu(k,2211) + lu(k,2234) = - lu(k,1612) * lu(k,2232) + lu(k,2248) = - lu(k,1613) * lu(k,2232) + lu(k,2258) = lu(k,2258) - lu(k,1612) * lu(k,2256) + lu(k,2265) = lu(k,2265) - lu(k,1613) * lu(k,2256) + lu(k,2295) = - lu(k,1612) * lu(k,2294) + lu(k,2308) = - lu(k,1613) * lu(k,2294) + lu(k,2321) = - lu(k,1612) * lu(k,2320) + lu(k,2335) = - lu(k,1613) * lu(k,2320) + lu(k,2348) = - lu(k,1612) * lu(k,2345) + lu(k,2358) = lu(k,2358) - lu(k,1613) * lu(k,2345) + lu(k,2379) = - lu(k,1612) * lu(k,2376) + lu(k,2394) = - lu(k,1613) * lu(k,2376) + lu(k,2408) = - lu(k,1612) * lu(k,2404) + lu(k,2424) = - lu(k,1613) * lu(k,2404) + lu(k,2462) = - lu(k,1612) * lu(k,2458) + lu(k,2478) = - lu(k,1613) * lu(k,2458) + lu(k,2497) = - lu(k,1612) * lu(k,2494) + lu(k,2512) = - lu(k,1613) * lu(k,2494) + lu(k,2528) = - lu(k,1612) * lu(k,2526) + lu(k,2541) = - lu(k,1613) * lu(k,2526) + lu(k,2661) = - lu(k,1612) * lu(k,2659) + lu(k,2674) = lu(k,2674) - lu(k,1613) * lu(k,2659) + lu(k,2693) = - lu(k,1612) * lu(k,2690) + lu(k,2713) = - lu(k,1613) * lu(k,2690) + lu(k,2726) = lu(k,2726) - lu(k,1612) * lu(k,2725) + lu(k,2738) = - lu(k,1613) * lu(k,2725) + lu(k,2748) = lu(k,2748) - lu(k,1612) * lu(k,2746) + lu(k,2760) = - lu(k,1613) * lu(k,2746) + lu(k,2769) = - lu(k,1612) * lu(k,2768) + lu(k,2783) = - lu(k,1613) * lu(k,2768) + lu(k,2797) = - lu(k,1612) * lu(k,2794) + lu(k,2816) = - lu(k,1613) * lu(k,2794) + lu(k,2833) = lu(k,2833) - lu(k,1612) * lu(k,2829) + lu(k,2862) = - lu(k,1613) * lu(k,2829) + lu(k,2880) = lu(k,2880) - lu(k,1612) * lu(k,2876) + lu(k,2909) = - lu(k,1613) * lu(k,2876) + lu(k,2926) = lu(k,2926) - lu(k,1612) * lu(k,2922) + lu(k,2955) = - lu(k,1613) * lu(k,2922) + lu(k,2988) = lu(k,2988) - lu(k,1612) * lu(k,2973) + lu(k,3029) = - lu(k,1613) * lu(k,2973) + lu(k,3089) = lu(k,3089) - lu(k,1612) * lu(k,3074) + lu(k,3132) = lu(k,3132) - lu(k,1613) * lu(k,3074) + lu(k,3270) = lu(k,3270) - lu(k,1612) * lu(k,3252) + lu(k,3314) = lu(k,3314) - lu(k,1613) * lu(k,3252) + lu(k,3347) = lu(k,3347) - lu(k,1612) * lu(k,3345) + lu(k,3359) = lu(k,3359) - lu(k,1613) * lu(k,3345) + lu(k,3526) = lu(k,3526) - lu(k,1612) * lu(k,3507) + lu(k,3570) = lu(k,3570) - lu(k,1613) * lu(k,3507) + lu(k,3777) = lu(k,3777) - lu(k,1612) * lu(k,3758) + lu(k,3820) = lu(k,3820) - lu(k,1613) * lu(k,3758) + lu(k,3848) = lu(k,3848) - lu(k,1612) * lu(k,3845) + lu(k,3861) = lu(k,3861) - lu(k,1613) * lu(k,3845) + lu(k,3911) = lu(k,3911) - lu(k,1612) * lu(k,3897) + lu(k,3955) = lu(k,3955) - lu(k,1613) * lu(k,3897) + lu(k,4005) = lu(k,4005) - lu(k,1612) * lu(k,3987) + lu(k,4047) = - lu(k,1613) * lu(k,3987) + lu(k,4082) = lu(k,4082) - lu(k,1612) * lu(k,4078) + lu(k,4099) = lu(k,4099) - lu(k,1613) * lu(k,4078) end do end subroutine lu_fac35 subroutine lu_fac36( avec_len, lu ) @@ -7451,607 +7210,367 @@ subroutine lu_fac36( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1571) = 1._r8 / lu(k,1571) - lu(k,1572) = lu(k,1572) * lu(k,1571) - lu(k,1573) = lu(k,1573) * lu(k,1571) - lu(k,1574) = lu(k,1574) * lu(k,1571) - lu(k,1575) = lu(k,1575) * lu(k,1571) - lu(k,1576) = lu(k,1576) * lu(k,1571) - lu(k,1577) = lu(k,1577) * lu(k,1571) - lu(k,1578) = lu(k,1578) * lu(k,1571) - lu(k,1579) = lu(k,1579) * lu(k,1571) - lu(k,1580) = lu(k,1580) * lu(k,1571) - lu(k,1581) = lu(k,1581) * lu(k,1571) - lu(k,1582) = lu(k,1582) * lu(k,1571) - lu(k,1583) = lu(k,1583) * lu(k,1571) - lu(k,1584) = lu(k,1584) * lu(k,1571) - lu(k,1585) = lu(k,1585) * lu(k,1571) - lu(k,1724) = lu(k,1724) - lu(k,1572) * lu(k,1723) - lu(k,1728) = lu(k,1728) - lu(k,1573) * lu(k,1723) - lu(k,1729) = lu(k,1729) - lu(k,1574) * lu(k,1723) - lu(k,1732) = lu(k,1732) - lu(k,1575) * lu(k,1723) - lu(k,1733) = lu(k,1733) - lu(k,1576) * lu(k,1723) - lu(k,1734) = - lu(k,1577) * lu(k,1723) - lu(k,1736) = lu(k,1736) - lu(k,1578) * lu(k,1723) - lu(k,1738) = lu(k,1738) - lu(k,1579) * lu(k,1723) - lu(k,1739) = lu(k,1739) - lu(k,1580) * lu(k,1723) - lu(k,1740) = lu(k,1740) - lu(k,1581) * lu(k,1723) - lu(k,1741) = lu(k,1741) - lu(k,1582) * lu(k,1723) - lu(k,1742) = lu(k,1742) - lu(k,1583) * lu(k,1723) - lu(k,1743) = lu(k,1743) - lu(k,1584) * lu(k,1723) - lu(k,1744) = lu(k,1744) - lu(k,1585) * lu(k,1723) - lu(k,2660) = lu(k,2660) - lu(k,1572) * lu(k,2657) - lu(k,2664) = lu(k,2664) - lu(k,1573) * lu(k,2657) - lu(k,2665) = lu(k,2665) - lu(k,1574) * lu(k,2657) - lu(k,2670) = lu(k,2670) - lu(k,1575) * lu(k,2657) - lu(k,2672) = lu(k,2672) - lu(k,1576) * lu(k,2657) - lu(k,2673) = - lu(k,1577) * lu(k,2657) - lu(k,2699) = lu(k,2699) - lu(k,1578) * lu(k,2657) - lu(k,2701) = lu(k,2701) - lu(k,1579) * lu(k,2657) - lu(k,2702) = lu(k,2702) - lu(k,1580) * lu(k,2657) - lu(k,2705) = lu(k,2705) - lu(k,1581) * lu(k,2657) - lu(k,2706) = lu(k,2706) - lu(k,1582) * lu(k,2657) - lu(k,2707) = lu(k,2707) - lu(k,1583) * lu(k,2657) - lu(k,2709) = lu(k,2709) - lu(k,1584) * lu(k,2657) - lu(k,2710) = lu(k,2710) - lu(k,1585) * lu(k,2657) - lu(k,2841) = lu(k,2841) - lu(k,1572) * lu(k,2838) - lu(k,2847) = lu(k,2847) - lu(k,1573) * lu(k,2838) - lu(k,2848) = lu(k,2848) - lu(k,1574) * lu(k,2838) - lu(k,2853) = lu(k,2853) - lu(k,1575) * lu(k,2838) - lu(k,2855) = lu(k,2855) - lu(k,1576) * lu(k,2838) - lu(k,2856) = lu(k,2856) - lu(k,1577) * lu(k,2838) - lu(k,2882) = lu(k,2882) - lu(k,1578) * lu(k,2838) - lu(k,2884) = lu(k,2884) - lu(k,1579) * lu(k,2838) - lu(k,2885) = lu(k,2885) - lu(k,1580) * lu(k,2838) - lu(k,2889) = lu(k,2889) - lu(k,1581) * lu(k,2838) - lu(k,2891) = lu(k,2891) - lu(k,1582) * lu(k,2838) - lu(k,2892) = lu(k,2892) - lu(k,1583) * lu(k,2838) - lu(k,2894) = lu(k,2894) - lu(k,1584) * lu(k,2838) - lu(k,2895) = lu(k,2895) - lu(k,1585) * lu(k,2838) - lu(k,2943) = lu(k,2943) - lu(k,1572) * lu(k,2942) - lu(k,2949) = lu(k,2949) - lu(k,1573) * lu(k,2942) - lu(k,2950) = lu(k,2950) - lu(k,1574) * lu(k,2942) - lu(k,2955) = lu(k,2955) - lu(k,1575) * lu(k,2942) - lu(k,2957) = lu(k,2957) - lu(k,1576) * lu(k,2942) - lu(k,2958) = lu(k,2958) - lu(k,1577) * lu(k,2942) - lu(k,2983) = lu(k,2983) - lu(k,1578) * lu(k,2942) - lu(k,2985) = lu(k,2985) - lu(k,1579) * lu(k,2942) - lu(k,2986) = lu(k,2986) - lu(k,1580) * lu(k,2942) - lu(k,2990) = lu(k,2990) - lu(k,1581) * lu(k,2942) - lu(k,2992) = lu(k,2992) - lu(k,1582) * lu(k,2942) - lu(k,2993) = lu(k,2993) - lu(k,1583) * lu(k,2942) - lu(k,2995) = lu(k,2995) - lu(k,1584) * lu(k,2942) - lu(k,2996) = lu(k,2996) - lu(k,1585) * lu(k,2942) - lu(k,3036) = lu(k,3036) - lu(k,1572) * lu(k,3033) - lu(k,3040) = lu(k,3040) - lu(k,1573) * lu(k,3033) - lu(k,3041) = lu(k,3041) - lu(k,1574) * lu(k,3033) - lu(k,3046) = lu(k,3046) - lu(k,1575) * lu(k,3033) - lu(k,3048) = lu(k,3048) - lu(k,1576) * lu(k,3033) - lu(k,3049) = - lu(k,1577) * lu(k,3033) - lu(k,3075) = lu(k,3075) - lu(k,1578) * lu(k,3033) - lu(k,3077) = lu(k,3077) - lu(k,1579) * lu(k,3033) - lu(k,3078) = lu(k,3078) - lu(k,1580) * lu(k,3033) - lu(k,3082) = lu(k,3082) - lu(k,1581) * lu(k,3033) - lu(k,3084) = lu(k,3084) - lu(k,1582) * lu(k,3033) - lu(k,3085) = lu(k,3085) - lu(k,1583) * lu(k,3033) - lu(k,3087) = lu(k,3087) - lu(k,1584) * lu(k,3033) - lu(k,3088) = lu(k,3088) - lu(k,1585) * lu(k,3033) - lu(k,3237) = lu(k,3237) - lu(k,1572) * lu(k,3234) - lu(k,3243) = lu(k,3243) - lu(k,1573) * lu(k,3234) - lu(k,3244) = lu(k,3244) - lu(k,1574) * lu(k,3234) - lu(k,3249) = lu(k,3249) - lu(k,1575) * lu(k,3234) - lu(k,3251) = lu(k,3251) - lu(k,1576) * lu(k,3234) - lu(k,3252) = - lu(k,1577) * lu(k,3234) - lu(k,3278) = lu(k,3278) - lu(k,1578) * lu(k,3234) - lu(k,3280) = lu(k,3280) - lu(k,1579) * lu(k,3234) - lu(k,3281) = lu(k,3281) - lu(k,1580) * lu(k,3234) - lu(k,3285) = lu(k,3285) - lu(k,1581) * lu(k,3234) - lu(k,3287) = lu(k,3287) - lu(k,1582) * lu(k,3234) - lu(k,3288) = lu(k,3288) - lu(k,1583) * lu(k,3234) - lu(k,3290) = lu(k,3290) - lu(k,1584) * lu(k,3234) - lu(k,3291) = lu(k,3291) - lu(k,1585) * lu(k,3234) - lu(k,3379) = lu(k,3379) - lu(k,1572) * lu(k,3376) - lu(k,3384) = lu(k,3384) - lu(k,1573) * lu(k,3376) - lu(k,3385) = lu(k,3385) - lu(k,1574) * lu(k,3376) - lu(k,3390) = lu(k,3390) - lu(k,1575) * lu(k,3376) - lu(k,3392) = lu(k,3392) - lu(k,1576) * lu(k,3376) - lu(k,3393) = lu(k,3393) - lu(k,1577) * lu(k,3376) - lu(k,3419) = lu(k,3419) - lu(k,1578) * lu(k,3376) - lu(k,3421) = lu(k,3421) - lu(k,1579) * lu(k,3376) - lu(k,3422) = lu(k,3422) - lu(k,1580) * lu(k,3376) - lu(k,3426) = lu(k,3426) - lu(k,1581) * lu(k,3376) - lu(k,3428) = lu(k,3428) - lu(k,1582) * lu(k,3376) - lu(k,3429) = lu(k,3429) - lu(k,1583) * lu(k,3376) - lu(k,3431) = lu(k,3431) - lu(k,1584) * lu(k,3376) - lu(k,3432) = lu(k,3432) - lu(k,1585) * lu(k,3376) - lu(k,3699) = lu(k,3699) - lu(k,1572) * lu(k,3696) - lu(k,3705) = lu(k,3705) - lu(k,1573) * lu(k,3696) - lu(k,3706) = lu(k,3706) - lu(k,1574) * lu(k,3696) - lu(k,3711) = lu(k,3711) - lu(k,1575) * lu(k,3696) - lu(k,3713) = lu(k,3713) - lu(k,1576) * lu(k,3696) - lu(k,3714) = lu(k,3714) - lu(k,1577) * lu(k,3696) - lu(k,3739) = lu(k,3739) - lu(k,1578) * lu(k,3696) - lu(k,3741) = lu(k,3741) - lu(k,1579) * lu(k,3696) - lu(k,3742) = lu(k,3742) - lu(k,1580) * lu(k,3696) - lu(k,3746) = lu(k,3746) - lu(k,1581) * lu(k,3696) - lu(k,3748) = lu(k,3748) - lu(k,1582) * lu(k,3696) - lu(k,3749) = lu(k,3749) - lu(k,1583) * lu(k,3696) - lu(k,3751) = lu(k,3751) - lu(k,1584) * lu(k,3696) - lu(k,3752) = lu(k,3752) - lu(k,1585) * lu(k,3696) - lu(k,1590) = 1._r8 / lu(k,1590) - lu(k,1591) = lu(k,1591) * lu(k,1590) - lu(k,1592) = lu(k,1592) * lu(k,1590) - lu(k,1593) = lu(k,1593) * lu(k,1590) - lu(k,1594) = lu(k,1594) * lu(k,1590) - lu(k,1595) = lu(k,1595) * lu(k,1590) - lu(k,1596) = lu(k,1596) * lu(k,1590) - lu(k,1597) = lu(k,1597) * lu(k,1590) - lu(k,2158) = - lu(k,1591) * lu(k,2154) - lu(k,2159) = lu(k,2159) - lu(k,1592) * lu(k,2154) - lu(k,2167) = - lu(k,1593) * lu(k,2154) - lu(k,2168) = lu(k,2168) - lu(k,1594) * lu(k,2154) - lu(k,2170) = lu(k,2170) - lu(k,1595) * lu(k,2154) - lu(k,2173) = lu(k,2173) - lu(k,1596) * lu(k,2154) - lu(k,2174) = lu(k,2174) - lu(k,1597) * lu(k,2154) - lu(k,2213) = lu(k,2213) - lu(k,1591) * lu(k,2208) - lu(k,2215) = lu(k,2215) - lu(k,1592) * lu(k,2208) - lu(k,2223) = lu(k,2223) - lu(k,1593) * lu(k,2208) - lu(k,2225) = lu(k,2225) - lu(k,1594) * lu(k,2208) - lu(k,2227) = lu(k,2227) - lu(k,1595) * lu(k,2208) - lu(k,2230) = lu(k,2230) - lu(k,1596) * lu(k,2208) - lu(k,2231) = lu(k,2231) - lu(k,1597) * lu(k,2208) - lu(k,2242) = lu(k,2242) - lu(k,1591) * lu(k,2237) - lu(k,2244) = lu(k,2244) - lu(k,1592) * lu(k,2237) - lu(k,2252) = lu(k,2252) - lu(k,1593) * lu(k,2237) - lu(k,2254) = lu(k,2254) - lu(k,1594) * lu(k,2237) - lu(k,2256) = lu(k,2256) - lu(k,1595) * lu(k,2237) - lu(k,2259) = lu(k,2259) - lu(k,1596) * lu(k,2237) - lu(k,2260) = lu(k,2260) - lu(k,1597) * lu(k,2237) - lu(k,2270) = lu(k,2270) - lu(k,1591) * lu(k,2266) - lu(k,2273) = - lu(k,1592) * lu(k,2266) - lu(k,2281) = - lu(k,1593) * lu(k,2266) - lu(k,2283) = lu(k,2283) - lu(k,1594) * lu(k,2266) - lu(k,2285) = lu(k,2285) - lu(k,1595) * lu(k,2266) - lu(k,2288) = lu(k,2288) - lu(k,1596) * lu(k,2266) - lu(k,2289) = lu(k,2289) - lu(k,1597) * lu(k,2266) - lu(k,2302) = lu(k,2302) - lu(k,1591) * lu(k,2300) - lu(k,2305) = lu(k,2305) - lu(k,1592) * lu(k,2300) - lu(k,2313) = lu(k,2313) - lu(k,1593) * lu(k,2300) - lu(k,2315) = lu(k,2315) - lu(k,1594) * lu(k,2300) - lu(k,2317) = lu(k,2317) - lu(k,1595) * lu(k,2300) - lu(k,2320) = lu(k,2320) - lu(k,1596) * lu(k,2300) - lu(k,2321) = lu(k,2321) - lu(k,1597) * lu(k,2300) - lu(k,2362) = lu(k,2362) - lu(k,1591) * lu(k,2359) - lu(k,2366) = lu(k,2366) - lu(k,1592) * lu(k,2359) - lu(k,2374) = lu(k,2374) - lu(k,1593) * lu(k,2359) - lu(k,2376) = lu(k,2376) - lu(k,1594) * lu(k,2359) - lu(k,2378) = lu(k,2378) - lu(k,1595) * lu(k,2359) - lu(k,2381) = lu(k,2381) - lu(k,1596) * lu(k,2359) - lu(k,2382) = lu(k,2382) - lu(k,1597) * lu(k,2359) - lu(k,2391) = - lu(k,1591) * lu(k,2388) - lu(k,2393) = lu(k,2393) - lu(k,1592) * lu(k,2388) - lu(k,2399) = - lu(k,1593) * lu(k,2388) - lu(k,2401) = lu(k,2401) - lu(k,1594) * lu(k,2388) - lu(k,2404) = lu(k,2404) - lu(k,1595) * lu(k,2388) - lu(k,2407) = lu(k,2407) - lu(k,1596) * lu(k,2388) - lu(k,2408) = lu(k,2408) - lu(k,1597) * lu(k,2388) - lu(k,2520) = lu(k,2520) - lu(k,1591) * lu(k,2510) - lu(k,2528) = lu(k,2528) - lu(k,1592) * lu(k,2510) - lu(k,2536) = lu(k,2536) - lu(k,1593) * lu(k,2510) - lu(k,2538) = lu(k,2538) - lu(k,1594) * lu(k,2510) - lu(k,2541) = lu(k,2541) - lu(k,1595) * lu(k,2510) - lu(k,2545) = lu(k,2545) - lu(k,1596) * lu(k,2510) - lu(k,2546) = lu(k,2546) - lu(k,1597) * lu(k,2510) - lu(k,2566) = lu(k,2566) - lu(k,1591) * lu(k,2556) - lu(k,2574) = lu(k,2574) - lu(k,1592) * lu(k,2556) - lu(k,2582) = lu(k,2582) - lu(k,1593) * lu(k,2556) - lu(k,2584) = lu(k,2584) - lu(k,1594) * lu(k,2556) - lu(k,2587) = lu(k,2587) - lu(k,1595) * lu(k,2556) - lu(k,2591) = lu(k,2591) - lu(k,1596) * lu(k,2556) - lu(k,2592) = lu(k,2592) - lu(k,1597) * lu(k,2556) - lu(k,2613) = lu(k,2613) - lu(k,1591) * lu(k,2603) - lu(k,2621) = lu(k,2621) - lu(k,1592) * lu(k,2603) - lu(k,2629) = lu(k,2629) - lu(k,1593) * lu(k,2603) - lu(k,2631) = lu(k,2631) - lu(k,1594) * lu(k,2603) - lu(k,2634) = lu(k,2634) - lu(k,1595) * lu(k,2603) - lu(k,2638) = lu(k,2638) - lu(k,1596) * lu(k,2603) - lu(k,2639) = lu(k,2639) - lu(k,1597) * lu(k,2603) - lu(k,2684) = lu(k,2684) - lu(k,1591) * lu(k,2658) - lu(k,2692) = lu(k,2692) - lu(k,1592) * lu(k,2658) - lu(k,2700) = lu(k,2700) - lu(k,1593) * lu(k,2658) - lu(k,2702) = lu(k,2702) - lu(k,1594) * lu(k,2658) - lu(k,2705) = lu(k,2705) - lu(k,1595) * lu(k,2658) - lu(k,2709) = lu(k,2709) - lu(k,1596) * lu(k,2658) - lu(k,2710) = lu(k,2710) - lu(k,1597) * lu(k,2658) - lu(k,2867) = lu(k,2867) - lu(k,1591) * lu(k,2839) - lu(k,2875) = lu(k,2875) - lu(k,1592) * lu(k,2839) - lu(k,2883) = lu(k,2883) - lu(k,1593) * lu(k,2839) - lu(k,2885) = lu(k,2885) - lu(k,1594) * lu(k,2839) - lu(k,2889) = lu(k,2889) - lu(k,1595) * lu(k,2839) - lu(k,2894) = lu(k,2894) - lu(k,1596) * lu(k,2839) - lu(k,2895) = lu(k,2895) - lu(k,1597) * lu(k,2839) - lu(k,3060) = lu(k,3060) - lu(k,1591) * lu(k,3034) - lu(k,3068) = lu(k,3068) - lu(k,1592) * lu(k,3034) - lu(k,3076) = lu(k,3076) - lu(k,1593) * lu(k,3034) - lu(k,3078) = lu(k,3078) - lu(k,1594) * lu(k,3034) - lu(k,3082) = lu(k,3082) - lu(k,1595) * lu(k,3034) - lu(k,3087) = lu(k,3087) - lu(k,1596) * lu(k,3034) - lu(k,3088) = lu(k,3088) - lu(k,1597) * lu(k,3034) - lu(k,3263) = lu(k,3263) - lu(k,1591) * lu(k,3235) - lu(k,3271) = lu(k,3271) - lu(k,1592) * lu(k,3235) - lu(k,3279) = lu(k,3279) - lu(k,1593) * lu(k,3235) - lu(k,3281) = lu(k,3281) - lu(k,1594) * lu(k,3235) - lu(k,3285) = lu(k,3285) - lu(k,1595) * lu(k,3235) - lu(k,3290) = lu(k,3290) - lu(k,1596) * lu(k,3235) - lu(k,3291) = lu(k,3291) - lu(k,1597) * lu(k,3235) - lu(k,3404) = lu(k,3404) - lu(k,1591) * lu(k,3377) - lu(k,3412) = lu(k,3412) - lu(k,1592) * lu(k,3377) - lu(k,3420) = lu(k,3420) - lu(k,1593) * lu(k,3377) - lu(k,3422) = lu(k,3422) - lu(k,1594) * lu(k,3377) - lu(k,3426) = lu(k,3426) - lu(k,1595) * lu(k,3377) - lu(k,3431) = lu(k,3431) - lu(k,1596) * lu(k,3377) - lu(k,3432) = lu(k,3432) - lu(k,1597) * lu(k,3377) - lu(k,3724) = lu(k,3724) - lu(k,1591) * lu(k,3697) - lu(k,3732) = lu(k,3732) - lu(k,1592) * lu(k,3697) - lu(k,3740) = lu(k,3740) - lu(k,1593) * lu(k,3697) - lu(k,3742) = lu(k,3742) - lu(k,1594) * lu(k,3697) - lu(k,3746) = lu(k,3746) - lu(k,1595) * lu(k,3697) - lu(k,3751) = lu(k,3751) - lu(k,1596) * lu(k,3697) - lu(k,3752) = lu(k,3752) - lu(k,1597) * lu(k,3697) - lu(k,1603) = 1._r8 / lu(k,1603) - lu(k,1604) = lu(k,1604) * lu(k,1603) - lu(k,1605) = lu(k,1605) * lu(k,1603) - lu(k,1606) = lu(k,1606) * lu(k,1603) - lu(k,1607) = lu(k,1607) * lu(k,1603) - lu(k,1608) = lu(k,1608) * lu(k,1603) - lu(k,1609) = lu(k,1609) * lu(k,1603) - lu(k,1610) = lu(k,1610) * lu(k,1603) - lu(k,2158) = lu(k,2158) - lu(k,1604) * lu(k,2155) - lu(k,2159) = lu(k,2159) - lu(k,1605) * lu(k,2155) - lu(k,2167) = lu(k,2167) - lu(k,1606) * lu(k,2155) - lu(k,2168) = lu(k,2168) - lu(k,1607) * lu(k,2155) - lu(k,2170) = lu(k,2170) - lu(k,1608) * lu(k,2155) - lu(k,2173) = lu(k,2173) - lu(k,1609) * lu(k,2155) - lu(k,2174) = lu(k,2174) - lu(k,1610) * lu(k,2155) - lu(k,2213) = lu(k,2213) - lu(k,1604) * lu(k,2209) - lu(k,2215) = lu(k,2215) - lu(k,1605) * lu(k,2209) - lu(k,2223) = lu(k,2223) - lu(k,1606) * lu(k,2209) - lu(k,2225) = lu(k,2225) - lu(k,1607) * lu(k,2209) - lu(k,2227) = lu(k,2227) - lu(k,1608) * lu(k,2209) - lu(k,2230) = lu(k,2230) - lu(k,1609) * lu(k,2209) - lu(k,2231) = lu(k,2231) - lu(k,1610) * lu(k,2209) - lu(k,2242) = lu(k,2242) - lu(k,1604) * lu(k,2238) - lu(k,2244) = lu(k,2244) - lu(k,1605) * lu(k,2238) - lu(k,2252) = lu(k,2252) - lu(k,1606) * lu(k,2238) - lu(k,2254) = lu(k,2254) - lu(k,1607) * lu(k,2238) - lu(k,2256) = lu(k,2256) - lu(k,1608) * lu(k,2238) - lu(k,2259) = lu(k,2259) - lu(k,1609) * lu(k,2238) - lu(k,2260) = lu(k,2260) - lu(k,1610) * lu(k,2238) - lu(k,2270) = lu(k,2270) - lu(k,1604) * lu(k,2267) - lu(k,2273) = lu(k,2273) - lu(k,1605) * lu(k,2267) - lu(k,2281) = lu(k,2281) - lu(k,1606) * lu(k,2267) - lu(k,2283) = lu(k,2283) - lu(k,1607) * lu(k,2267) - lu(k,2285) = lu(k,2285) - lu(k,1608) * lu(k,2267) - lu(k,2288) = lu(k,2288) - lu(k,1609) * lu(k,2267) - lu(k,2289) = lu(k,2289) - lu(k,1610) * lu(k,2267) - lu(k,2302) = lu(k,2302) - lu(k,1604) * lu(k,2301) - lu(k,2305) = lu(k,2305) - lu(k,1605) * lu(k,2301) - lu(k,2313) = lu(k,2313) - lu(k,1606) * lu(k,2301) - lu(k,2315) = lu(k,2315) - lu(k,1607) * lu(k,2301) - lu(k,2317) = lu(k,2317) - lu(k,1608) * lu(k,2301) - lu(k,2320) = lu(k,2320) - lu(k,1609) * lu(k,2301) - lu(k,2321) = lu(k,2321) - lu(k,1610) * lu(k,2301) - lu(k,2362) = lu(k,2362) - lu(k,1604) * lu(k,2360) - lu(k,2366) = lu(k,2366) - lu(k,1605) * lu(k,2360) - lu(k,2374) = lu(k,2374) - lu(k,1606) * lu(k,2360) - lu(k,2376) = lu(k,2376) - lu(k,1607) * lu(k,2360) - lu(k,2378) = lu(k,2378) - lu(k,1608) * lu(k,2360) - lu(k,2381) = lu(k,2381) - lu(k,1609) * lu(k,2360) - lu(k,2382) = lu(k,2382) - lu(k,1610) * lu(k,2360) - lu(k,2391) = lu(k,2391) - lu(k,1604) * lu(k,2389) - lu(k,2393) = lu(k,2393) - lu(k,1605) * lu(k,2389) - lu(k,2399) = lu(k,2399) - lu(k,1606) * lu(k,2389) - lu(k,2401) = lu(k,2401) - lu(k,1607) * lu(k,2389) - lu(k,2404) = lu(k,2404) - lu(k,1608) * lu(k,2389) - lu(k,2407) = lu(k,2407) - lu(k,1609) * lu(k,2389) - lu(k,2408) = lu(k,2408) - lu(k,1610) * lu(k,2389) - lu(k,2520) = lu(k,2520) - lu(k,1604) * lu(k,2511) - lu(k,2528) = lu(k,2528) - lu(k,1605) * lu(k,2511) - lu(k,2536) = lu(k,2536) - lu(k,1606) * lu(k,2511) - lu(k,2538) = lu(k,2538) - lu(k,1607) * lu(k,2511) - lu(k,2541) = lu(k,2541) - lu(k,1608) * lu(k,2511) - lu(k,2545) = lu(k,2545) - lu(k,1609) * lu(k,2511) - lu(k,2546) = lu(k,2546) - lu(k,1610) * lu(k,2511) - lu(k,2566) = lu(k,2566) - lu(k,1604) * lu(k,2557) - lu(k,2574) = lu(k,2574) - lu(k,1605) * lu(k,2557) - lu(k,2582) = lu(k,2582) - lu(k,1606) * lu(k,2557) - lu(k,2584) = lu(k,2584) - lu(k,1607) * lu(k,2557) - lu(k,2587) = lu(k,2587) - lu(k,1608) * lu(k,2557) - lu(k,2591) = lu(k,2591) - lu(k,1609) * lu(k,2557) - lu(k,2592) = lu(k,2592) - lu(k,1610) * lu(k,2557) - lu(k,2613) = lu(k,2613) - lu(k,1604) * lu(k,2604) - lu(k,2621) = lu(k,2621) - lu(k,1605) * lu(k,2604) - lu(k,2629) = lu(k,2629) - lu(k,1606) * lu(k,2604) - lu(k,2631) = lu(k,2631) - lu(k,1607) * lu(k,2604) - lu(k,2634) = lu(k,2634) - lu(k,1608) * lu(k,2604) - lu(k,2638) = lu(k,2638) - lu(k,1609) * lu(k,2604) - lu(k,2639) = lu(k,2639) - lu(k,1610) * lu(k,2604) - lu(k,2684) = lu(k,2684) - lu(k,1604) * lu(k,2659) - lu(k,2692) = lu(k,2692) - lu(k,1605) * lu(k,2659) - lu(k,2700) = lu(k,2700) - lu(k,1606) * lu(k,2659) - lu(k,2702) = lu(k,2702) - lu(k,1607) * lu(k,2659) - lu(k,2705) = lu(k,2705) - lu(k,1608) * lu(k,2659) - lu(k,2709) = lu(k,2709) - lu(k,1609) * lu(k,2659) - lu(k,2710) = lu(k,2710) - lu(k,1610) * lu(k,2659) - lu(k,2867) = lu(k,2867) - lu(k,1604) * lu(k,2840) - lu(k,2875) = lu(k,2875) - lu(k,1605) * lu(k,2840) - lu(k,2883) = lu(k,2883) - lu(k,1606) * lu(k,2840) - lu(k,2885) = lu(k,2885) - lu(k,1607) * lu(k,2840) - lu(k,2889) = lu(k,2889) - lu(k,1608) * lu(k,2840) - lu(k,2894) = lu(k,2894) - lu(k,1609) * lu(k,2840) - lu(k,2895) = lu(k,2895) - lu(k,1610) * lu(k,2840) - lu(k,3060) = lu(k,3060) - lu(k,1604) * lu(k,3035) - lu(k,3068) = lu(k,3068) - lu(k,1605) * lu(k,3035) - lu(k,3076) = lu(k,3076) - lu(k,1606) * lu(k,3035) - lu(k,3078) = lu(k,3078) - lu(k,1607) * lu(k,3035) - lu(k,3082) = lu(k,3082) - lu(k,1608) * lu(k,3035) - lu(k,3087) = lu(k,3087) - lu(k,1609) * lu(k,3035) - lu(k,3088) = lu(k,3088) - lu(k,1610) * lu(k,3035) - lu(k,3263) = lu(k,3263) - lu(k,1604) * lu(k,3236) - lu(k,3271) = lu(k,3271) - lu(k,1605) * lu(k,3236) - lu(k,3279) = lu(k,3279) - lu(k,1606) * lu(k,3236) - lu(k,3281) = lu(k,3281) - lu(k,1607) * lu(k,3236) - lu(k,3285) = lu(k,3285) - lu(k,1608) * lu(k,3236) - lu(k,3290) = lu(k,3290) - lu(k,1609) * lu(k,3236) - lu(k,3291) = lu(k,3291) - lu(k,1610) * lu(k,3236) - lu(k,3404) = lu(k,3404) - lu(k,1604) * lu(k,3378) - lu(k,3412) = lu(k,3412) - lu(k,1605) * lu(k,3378) - lu(k,3420) = lu(k,3420) - lu(k,1606) * lu(k,3378) - lu(k,3422) = lu(k,3422) - lu(k,1607) * lu(k,3378) - lu(k,3426) = lu(k,3426) - lu(k,1608) * lu(k,3378) - lu(k,3431) = lu(k,3431) - lu(k,1609) * lu(k,3378) - lu(k,3432) = lu(k,3432) - lu(k,1610) * lu(k,3378) - lu(k,3724) = lu(k,3724) - lu(k,1604) * lu(k,3698) - lu(k,3732) = lu(k,3732) - lu(k,1605) * lu(k,3698) - lu(k,3740) = lu(k,3740) - lu(k,1606) * lu(k,3698) - lu(k,3742) = lu(k,3742) - lu(k,1607) * lu(k,3698) - lu(k,3746) = lu(k,3746) - lu(k,1608) * lu(k,3698) - lu(k,3751) = lu(k,3751) - lu(k,1609) * lu(k,3698) - lu(k,3752) = lu(k,3752) - lu(k,1610) * lu(k,3698) - lu(k,1611) = 1._r8 / lu(k,1611) - lu(k,1612) = lu(k,1612) * lu(k,1611) - lu(k,1613) = lu(k,1613) * lu(k,1611) - lu(k,1614) = lu(k,1614) * lu(k,1611) - lu(k,1615) = lu(k,1615) * lu(k,1611) - lu(k,1616) = lu(k,1616) * lu(k,1611) - lu(k,1621) = lu(k,1621) - lu(k,1612) * lu(k,1619) - lu(k,1622) = lu(k,1622) - lu(k,1613) * lu(k,1619) - lu(k,1624) = lu(k,1624) - lu(k,1614) * lu(k,1619) - lu(k,1625) = lu(k,1625) - lu(k,1615) * lu(k,1619) - lu(k,1627) = lu(k,1627) - lu(k,1616) * lu(k,1619) - lu(k,1637) = lu(k,1637) - lu(k,1612) * lu(k,1633) - lu(k,1638) = lu(k,1638) - lu(k,1613) * lu(k,1633) - lu(k,1640) = lu(k,1640) - lu(k,1614) * lu(k,1633) - lu(k,1641) = lu(k,1641) - lu(k,1615) * lu(k,1633) - lu(k,1643) = lu(k,1643) - lu(k,1616) * lu(k,1633) - lu(k,1671) = lu(k,1671) - lu(k,1612) * lu(k,1665) - lu(k,1675) = lu(k,1675) - lu(k,1613) * lu(k,1665) - lu(k,1678) = lu(k,1678) - lu(k,1614) * lu(k,1665) - lu(k,1679) = lu(k,1679) - lu(k,1615) * lu(k,1665) - lu(k,1682) = lu(k,1682) - lu(k,1616) * lu(k,1665) - lu(k,1702) = lu(k,1702) - lu(k,1612) * lu(k,1698) - lu(k,1703) = lu(k,1703) - lu(k,1613) * lu(k,1698) - lu(k,1706) = lu(k,1706) - lu(k,1614) * lu(k,1698) - lu(k,1707) = lu(k,1707) - lu(k,1615) * lu(k,1698) - lu(k,1709) = lu(k,1709) - lu(k,1616) * lu(k,1698) - lu(k,1732) = lu(k,1732) - lu(k,1612) * lu(k,1724) - lu(k,1736) = lu(k,1736) - lu(k,1613) * lu(k,1724) - lu(k,1740) = lu(k,1740) - lu(k,1614) * lu(k,1724) - lu(k,1741) = lu(k,1741) - lu(k,1615) * lu(k,1724) - lu(k,1744) = lu(k,1744) - lu(k,1616) * lu(k,1724) - lu(k,1752) = lu(k,1752) - lu(k,1612) * lu(k,1749) - lu(k,1754) = lu(k,1754) - lu(k,1613) * lu(k,1749) - lu(k,1759) = lu(k,1759) - lu(k,1614) * lu(k,1749) - lu(k,1760) = lu(k,1760) - lu(k,1615) * lu(k,1749) - lu(k,1763) = lu(k,1763) - lu(k,1616) * lu(k,1749) - lu(k,1783) = lu(k,1783) - lu(k,1612) * lu(k,1778) - lu(k,1787) = lu(k,1787) - lu(k,1613) * lu(k,1778) - lu(k,1790) = lu(k,1790) - lu(k,1614) * lu(k,1778) - lu(k,1791) = lu(k,1791) - lu(k,1615) * lu(k,1778) - lu(k,1794) = lu(k,1794) - lu(k,1616) * lu(k,1778) - lu(k,1830) = lu(k,1830) - lu(k,1612) * lu(k,1823) - lu(k,1834) = lu(k,1834) - lu(k,1613) * lu(k,1823) - lu(k,1838) = lu(k,1838) - lu(k,1614) * lu(k,1823) - lu(k,1839) = lu(k,1839) - lu(k,1615) * lu(k,1823) - lu(k,1842) = lu(k,1842) - lu(k,1616) * lu(k,1823) - lu(k,1862) = lu(k,1862) - lu(k,1612) * lu(k,1860) - lu(k,1864) = lu(k,1864) - lu(k,1613) * lu(k,1860) - lu(k,1870) = lu(k,1870) - lu(k,1614) * lu(k,1860) - lu(k,1871) = lu(k,1871) - lu(k,1615) * lu(k,1860) - lu(k,1874) = lu(k,1874) - lu(k,1616) * lu(k,1860) - lu(k,1894) = lu(k,1894) - lu(k,1612) * lu(k,1887) - lu(k,1900) = lu(k,1900) - lu(k,1613) * lu(k,1887) - lu(k,1906) = lu(k,1906) - lu(k,1614) * lu(k,1887) - lu(k,1907) = lu(k,1907) - lu(k,1615) * lu(k,1887) - lu(k,1910) = lu(k,1910) - lu(k,1616) * lu(k,1887) - lu(k,1929) = lu(k,1929) - lu(k,1612) * lu(k,1924) - lu(k,1932) = lu(k,1932) - lu(k,1613) * lu(k,1924) - lu(k,1938) = lu(k,1938) - lu(k,1614) * lu(k,1924) - lu(k,1939) = lu(k,1939) - lu(k,1615) * lu(k,1924) - lu(k,1942) = lu(k,1942) - lu(k,1616) * lu(k,1924) - lu(k,1963) = lu(k,1963) - lu(k,1612) * lu(k,1958) - lu(k,1966) = lu(k,1966) - lu(k,1613) * lu(k,1958) - lu(k,1972) = lu(k,1972) - lu(k,1614) * lu(k,1958) - lu(k,1973) = lu(k,1973) - lu(k,1615) * lu(k,1958) - lu(k,1976) = lu(k,1976) - lu(k,1616) * lu(k,1958) - lu(k,1992) = lu(k,1992) - lu(k,1612) * lu(k,1987) - lu(k,1994) = lu(k,1994) - lu(k,1613) * lu(k,1987) - lu(k,2000) = lu(k,2000) - lu(k,1614) * lu(k,1987) - lu(k,2001) = lu(k,2001) - lu(k,1615) * lu(k,1987) - lu(k,2004) = lu(k,2004) - lu(k,1616) * lu(k,1987) - lu(k,2029) = lu(k,2029) - lu(k,1612) * lu(k,2024) - lu(k,2036) = lu(k,2036) - lu(k,1613) * lu(k,2024) - lu(k,2042) = lu(k,2042) - lu(k,1614) * lu(k,2024) - lu(k,2043) = lu(k,2043) - lu(k,1615) * lu(k,2024) - lu(k,2047) = lu(k,2047) - lu(k,1616) * lu(k,2024) - lu(k,2140) = lu(k,2140) - lu(k,1612) * lu(k,2139) - lu(k,2142) = lu(k,2142) - lu(k,1613) * lu(k,2139) - lu(k,2147) = lu(k,2147) - lu(k,1614) * lu(k,2139) - lu(k,2148) = lu(k,2148) - lu(k,1615) * lu(k,2139) - lu(k,2151) = lu(k,2151) - lu(k,1616) * lu(k,2139) - lu(k,2670) = lu(k,2670) - lu(k,1612) * lu(k,2660) - lu(k,2699) = lu(k,2699) - lu(k,1613) * lu(k,2660) - lu(k,2705) = lu(k,2705) - lu(k,1614) * lu(k,2660) - lu(k,2706) = lu(k,2706) - lu(k,1615) * lu(k,2660) - lu(k,2710) = lu(k,2710) - lu(k,1616) * lu(k,2660) - lu(k,2853) = lu(k,2853) - lu(k,1612) * lu(k,2841) - lu(k,2882) = lu(k,2882) - lu(k,1613) * lu(k,2841) - lu(k,2889) = lu(k,2889) - lu(k,1614) * lu(k,2841) - lu(k,2891) = lu(k,2891) - lu(k,1615) * lu(k,2841) - lu(k,2895) = lu(k,2895) - lu(k,1616) * lu(k,2841) - lu(k,2955) = lu(k,2955) - lu(k,1612) * lu(k,2943) - lu(k,2983) = lu(k,2983) - lu(k,1613) * lu(k,2943) - lu(k,2990) = lu(k,2990) - lu(k,1614) * lu(k,2943) - lu(k,2992) = lu(k,2992) - lu(k,1615) * lu(k,2943) - lu(k,2996) = lu(k,2996) - lu(k,1616) * lu(k,2943) - lu(k,3046) = lu(k,3046) - lu(k,1612) * lu(k,3036) - lu(k,3075) = lu(k,3075) - lu(k,1613) * lu(k,3036) - lu(k,3082) = lu(k,3082) - lu(k,1614) * lu(k,3036) - lu(k,3084) = lu(k,3084) - lu(k,1615) * lu(k,3036) - lu(k,3088) = lu(k,3088) - lu(k,1616) * lu(k,3036) - lu(k,3249) = lu(k,3249) - lu(k,1612) * lu(k,3237) - lu(k,3278) = lu(k,3278) - lu(k,1613) * lu(k,3237) - lu(k,3285) = lu(k,3285) - lu(k,1614) * lu(k,3237) - lu(k,3287) = lu(k,3287) - lu(k,1615) * lu(k,3237) - lu(k,3291) = lu(k,3291) - lu(k,1616) * lu(k,3237) - lu(k,3390) = lu(k,3390) - lu(k,1612) * lu(k,3379) - lu(k,3419) = lu(k,3419) - lu(k,1613) * lu(k,3379) - lu(k,3426) = lu(k,3426) - lu(k,1614) * lu(k,3379) - lu(k,3428) = lu(k,3428) - lu(k,1615) * lu(k,3379) - lu(k,3432) = lu(k,3432) - lu(k,1616) * lu(k,3379) - lu(k,3493) = lu(k,3493) - lu(k,1612) * lu(k,3491) - lu(k,3499) = lu(k,3499) - lu(k,1613) * lu(k,3491) - lu(k,3506) = lu(k,3506) - lu(k,1614) * lu(k,3491) - lu(k,3508) = lu(k,3508) - lu(k,1615) * lu(k,3491) - lu(k,3512) = lu(k,3512) - lu(k,1616) * lu(k,3491) - lu(k,3711) = lu(k,3711) - lu(k,1612) * lu(k,3699) - lu(k,3739) = lu(k,3739) - lu(k,1613) * lu(k,3699) - lu(k,3746) = lu(k,3746) - lu(k,1614) * lu(k,3699) - lu(k,3748) = lu(k,3748) - lu(k,1615) * lu(k,3699) - lu(k,3752) = lu(k,3752) - lu(k,1616) * lu(k,3699) - lu(k,1620) = 1._r8 / lu(k,1620) - lu(k,1621) = lu(k,1621) * lu(k,1620) - lu(k,1622) = lu(k,1622) * lu(k,1620) - lu(k,1623) = lu(k,1623) * lu(k,1620) - lu(k,1624) = lu(k,1624) * lu(k,1620) - lu(k,1625) = lu(k,1625) * lu(k,1620) - lu(k,1626) = lu(k,1626) * lu(k,1620) - lu(k,1627) = lu(k,1627) * lu(k,1620) - lu(k,1637) = lu(k,1637) - lu(k,1621) * lu(k,1634) - lu(k,1638) = lu(k,1638) - lu(k,1622) * lu(k,1634) - lu(k,1639) = lu(k,1639) - lu(k,1623) * lu(k,1634) - lu(k,1640) = lu(k,1640) - lu(k,1624) * lu(k,1634) - lu(k,1641) = lu(k,1641) - lu(k,1625) * lu(k,1634) - lu(k,1642) = lu(k,1642) - lu(k,1626) * lu(k,1634) - lu(k,1643) = lu(k,1643) - lu(k,1627) * lu(k,1634) - lu(k,1671) = lu(k,1671) - lu(k,1621) * lu(k,1666) - lu(k,1675) = lu(k,1675) - lu(k,1622) * lu(k,1666) - lu(k,1676) = lu(k,1676) - lu(k,1623) * lu(k,1666) - lu(k,1678) = lu(k,1678) - lu(k,1624) * lu(k,1666) - lu(k,1679) = lu(k,1679) - lu(k,1625) * lu(k,1666) - lu(k,1681) = lu(k,1681) - lu(k,1626) * lu(k,1666) - lu(k,1682) = lu(k,1682) - lu(k,1627) * lu(k,1666) - lu(k,1732) = lu(k,1732) - lu(k,1621) * lu(k,1725) - lu(k,1736) = lu(k,1736) - lu(k,1622) * lu(k,1725) - lu(k,1738) = lu(k,1738) - lu(k,1623) * lu(k,1725) - lu(k,1740) = lu(k,1740) - lu(k,1624) * lu(k,1725) - lu(k,1741) = lu(k,1741) - lu(k,1625) * lu(k,1725) - lu(k,1743) = lu(k,1743) - lu(k,1626) * lu(k,1725) - lu(k,1744) = lu(k,1744) - lu(k,1627) * lu(k,1725) - lu(k,1752) = lu(k,1752) - lu(k,1621) * lu(k,1750) - lu(k,1754) = lu(k,1754) - lu(k,1622) * lu(k,1750) - lu(k,1755) = lu(k,1755) - lu(k,1623) * lu(k,1750) - lu(k,1759) = lu(k,1759) - lu(k,1624) * lu(k,1750) - lu(k,1760) = lu(k,1760) - lu(k,1625) * lu(k,1750) - lu(k,1762) = lu(k,1762) - lu(k,1626) * lu(k,1750) - lu(k,1763) = lu(k,1763) - lu(k,1627) * lu(k,1750) - lu(k,1830) = lu(k,1830) - lu(k,1621) * lu(k,1824) - lu(k,1834) = lu(k,1834) - lu(k,1622) * lu(k,1824) - lu(k,1836) = lu(k,1836) - lu(k,1623) * lu(k,1824) - lu(k,1838) = lu(k,1838) - lu(k,1624) * lu(k,1824) - lu(k,1839) = lu(k,1839) - lu(k,1625) * lu(k,1824) - lu(k,1841) = lu(k,1841) - lu(k,1626) * lu(k,1824) - lu(k,1842) = lu(k,1842) - lu(k,1627) * lu(k,1824) - lu(k,1929) = lu(k,1929) - lu(k,1621) * lu(k,1925) - lu(k,1932) = lu(k,1932) - lu(k,1622) * lu(k,1925) - lu(k,1934) = lu(k,1934) - lu(k,1623) * lu(k,1925) - lu(k,1938) = lu(k,1938) - lu(k,1624) * lu(k,1925) - lu(k,1939) = lu(k,1939) - lu(k,1625) * lu(k,1925) - lu(k,1941) = lu(k,1941) - lu(k,1626) * lu(k,1925) - lu(k,1942) = lu(k,1942) - lu(k,1627) * lu(k,1925) - lu(k,1963) = lu(k,1963) - lu(k,1621) * lu(k,1959) - lu(k,1966) = lu(k,1966) - lu(k,1622) * lu(k,1959) - lu(k,1968) = lu(k,1968) - lu(k,1623) * lu(k,1959) - lu(k,1972) = lu(k,1972) - lu(k,1624) * lu(k,1959) - lu(k,1973) = lu(k,1973) - lu(k,1625) * lu(k,1959) - lu(k,1975) = lu(k,1975) - lu(k,1626) * lu(k,1959) - lu(k,1976) = lu(k,1976) - lu(k,1627) * lu(k,1959) - lu(k,1992) = lu(k,1992) - lu(k,1621) * lu(k,1988) - lu(k,1994) = lu(k,1994) - lu(k,1622) * lu(k,1988) - lu(k,1996) = lu(k,1996) - lu(k,1623) * lu(k,1988) - lu(k,2000) = lu(k,2000) - lu(k,1624) * lu(k,1988) - lu(k,2001) = lu(k,2001) - lu(k,1625) * lu(k,1988) - lu(k,2003) = lu(k,2003) - lu(k,1626) * lu(k,1988) - lu(k,2004) = lu(k,2004) - lu(k,1627) * lu(k,1988) - lu(k,2029) = lu(k,2029) - lu(k,1621) * lu(k,2025) - lu(k,2036) = lu(k,2036) - lu(k,1622) * lu(k,2025) - lu(k,2038) = lu(k,2038) - lu(k,1623) * lu(k,2025) - lu(k,2042) = lu(k,2042) - lu(k,1624) * lu(k,2025) - lu(k,2043) = lu(k,2043) - lu(k,1625) * lu(k,2025) - lu(k,2046) = lu(k,2046) - lu(k,1626) * lu(k,2025) - lu(k,2047) = lu(k,2047) - lu(k,1627) * lu(k,2025) - lu(k,2670) = lu(k,2670) - lu(k,1621) * lu(k,2661) - lu(k,2699) = lu(k,2699) - lu(k,1622) * lu(k,2661) - lu(k,2701) = lu(k,2701) - lu(k,1623) * lu(k,2661) - lu(k,2705) = lu(k,2705) - lu(k,1624) * lu(k,2661) - lu(k,2706) = lu(k,2706) - lu(k,1625) * lu(k,2661) - lu(k,2709) = lu(k,2709) - lu(k,1626) * lu(k,2661) - lu(k,2710) = lu(k,2710) - lu(k,1627) * lu(k,2661) - lu(k,2853) = lu(k,2853) - lu(k,1621) * lu(k,2842) - lu(k,2882) = lu(k,2882) - lu(k,1622) * lu(k,2842) - lu(k,2884) = lu(k,2884) - lu(k,1623) * lu(k,2842) - lu(k,2889) = lu(k,2889) - lu(k,1624) * lu(k,2842) - lu(k,2891) = lu(k,2891) - lu(k,1625) * lu(k,2842) - lu(k,2894) = lu(k,2894) - lu(k,1626) * lu(k,2842) - lu(k,2895) = lu(k,2895) - lu(k,1627) * lu(k,2842) - lu(k,2955) = lu(k,2955) - lu(k,1621) * lu(k,2944) - lu(k,2983) = lu(k,2983) - lu(k,1622) * lu(k,2944) - lu(k,2985) = lu(k,2985) - lu(k,1623) * lu(k,2944) - lu(k,2990) = lu(k,2990) - lu(k,1624) * lu(k,2944) - lu(k,2992) = lu(k,2992) - lu(k,1625) * lu(k,2944) - lu(k,2995) = lu(k,2995) - lu(k,1626) * lu(k,2944) - lu(k,2996) = lu(k,2996) - lu(k,1627) * lu(k,2944) - lu(k,3249) = lu(k,3249) - lu(k,1621) * lu(k,3238) - lu(k,3278) = lu(k,3278) - lu(k,1622) * lu(k,3238) - lu(k,3280) = lu(k,3280) - lu(k,1623) * lu(k,3238) - lu(k,3285) = lu(k,3285) - lu(k,1624) * lu(k,3238) - lu(k,3287) = lu(k,3287) - lu(k,1625) * lu(k,3238) - lu(k,3290) = lu(k,3290) - lu(k,1626) * lu(k,3238) - lu(k,3291) = lu(k,3291) - lu(k,1627) * lu(k,3238) - lu(k,3390) = lu(k,3390) - lu(k,1621) * lu(k,3380) - lu(k,3419) = lu(k,3419) - lu(k,1622) * lu(k,3380) - lu(k,3421) = lu(k,3421) - lu(k,1623) * lu(k,3380) - lu(k,3426) = lu(k,3426) - lu(k,1624) * lu(k,3380) - lu(k,3428) = lu(k,3428) - lu(k,1625) * lu(k,3380) - lu(k,3431) = lu(k,3431) - lu(k,1626) * lu(k,3380) - lu(k,3432) = lu(k,3432) - lu(k,1627) * lu(k,3380) - lu(k,3711) = lu(k,3711) - lu(k,1621) * lu(k,3700) - lu(k,3739) = lu(k,3739) - lu(k,1622) * lu(k,3700) - lu(k,3741) = lu(k,3741) - lu(k,1623) * lu(k,3700) - lu(k,3746) = lu(k,3746) - lu(k,1624) * lu(k,3700) - lu(k,3748) = lu(k,3748) - lu(k,1625) * lu(k,3700) - lu(k,3751) = lu(k,3751) - lu(k,1626) * lu(k,3700) - lu(k,3752) = lu(k,3752) - lu(k,1627) * lu(k,3700) + lu(k,1618) = 1._r8 / lu(k,1618) + lu(k,1619) = lu(k,1619) * lu(k,1618) + lu(k,1620) = lu(k,1620) * lu(k,1618) + lu(k,1621) = lu(k,1621) * lu(k,1618) + lu(k,1622) = lu(k,1622) * lu(k,1618) + lu(k,1623) = lu(k,1623) * lu(k,1618) + lu(k,1624) = lu(k,1624) * lu(k,1618) + lu(k,1625) = lu(k,1625) * lu(k,1618) + lu(k,1626) = lu(k,1626) * lu(k,1618) + lu(k,1627) = lu(k,1627) * lu(k,1618) + lu(k,1628) = lu(k,1628) * lu(k,1618) + lu(k,1629) = lu(k,1629) * lu(k,1618) + lu(k,1630) = lu(k,1630) * lu(k,1618) + lu(k,1631) = lu(k,1631) * lu(k,1618) + lu(k,2019) = lu(k,2019) - lu(k,1619) * lu(k,2017) + lu(k,2021) = lu(k,2021) - lu(k,1620) * lu(k,2017) + lu(k,2024) = lu(k,2024) - lu(k,1621) * lu(k,2017) + lu(k,2025) = lu(k,2025) - lu(k,1622) * lu(k,2017) + lu(k,2026) = lu(k,2026) - lu(k,1623) * lu(k,2017) + lu(k,2028) = lu(k,2028) - lu(k,1624) * lu(k,2017) + lu(k,2029) = lu(k,2029) - lu(k,1625) * lu(k,2017) + lu(k,2030) = lu(k,2030) - lu(k,1626) * lu(k,2017) + lu(k,2031) = lu(k,2031) - lu(k,1627) * lu(k,2017) + lu(k,2032) = - lu(k,1628) * lu(k,2017) + lu(k,2033) = lu(k,2033) - lu(k,1629) * lu(k,2017) + lu(k,2034) = lu(k,2034) - lu(k,1630) * lu(k,2017) + lu(k,2035) = lu(k,2035) - lu(k,1631) * lu(k,2017) + lu(k,2981) = lu(k,2981) - lu(k,1619) * lu(k,2974) + lu(k,2988) = lu(k,2988) - lu(k,1620) * lu(k,2974) + lu(k,3023) = lu(k,3023) - lu(k,1621) * lu(k,2974) + lu(k,3024) = lu(k,3024) - lu(k,1622) * lu(k,2974) + lu(k,3026) = lu(k,3026) - lu(k,1623) * lu(k,2974) + lu(k,3028) = lu(k,3028) - lu(k,1624) * lu(k,2974) + lu(k,3029) = lu(k,3029) - lu(k,1625) * lu(k,2974) + lu(k,3030) = lu(k,3030) - lu(k,1626) * lu(k,2974) + lu(k,3031) = lu(k,3031) - lu(k,1627) * lu(k,2974) + lu(k,3033) = lu(k,3033) - lu(k,1628) * lu(k,2974) + lu(k,3034) = lu(k,3034) - lu(k,1629) * lu(k,2974) + lu(k,3035) = lu(k,3035) - lu(k,1630) * lu(k,2974) + lu(k,3036) = lu(k,3036) - lu(k,1631) * lu(k,2974) + lu(k,3262) = lu(k,3262) - lu(k,1619) * lu(k,3253) + lu(k,3270) = lu(k,3270) - lu(k,1620) * lu(k,3253) + lu(k,3308) = lu(k,3308) - lu(k,1621) * lu(k,3253) + lu(k,3309) = lu(k,3309) - lu(k,1622) * lu(k,3253) + lu(k,3311) = lu(k,3311) - lu(k,1623) * lu(k,3253) + lu(k,3313) = lu(k,3313) - lu(k,1624) * lu(k,3253) + lu(k,3314) = lu(k,3314) - lu(k,1625) * lu(k,3253) + lu(k,3315) = lu(k,3315) - lu(k,1626) * lu(k,3253) + lu(k,3316) = lu(k,3316) - lu(k,1627) * lu(k,3253) + lu(k,3318) = lu(k,3318) - lu(k,1628) * lu(k,3253) + lu(k,3319) = lu(k,3319) - lu(k,1629) * lu(k,3253) + lu(k,3320) = lu(k,3320) - lu(k,1630) * lu(k,3253) + lu(k,3321) = lu(k,3321) - lu(k,1631) * lu(k,3253) + lu(k,3518) = lu(k,3518) - lu(k,1619) * lu(k,3508) + lu(k,3526) = lu(k,3526) - lu(k,1620) * lu(k,3508) + lu(k,3564) = lu(k,3564) - lu(k,1621) * lu(k,3508) + lu(k,3565) = lu(k,3565) - lu(k,1622) * lu(k,3508) + lu(k,3567) = lu(k,3567) - lu(k,1623) * lu(k,3508) + lu(k,3569) = lu(k,3569) - lu(k,1624) * lu(k,3508) + lu(k,3570) = lu(k,3570) - lu(k,1625) * lu(k,3508) + lu(k,3571) = lu(k,3571) - lu(k,1626) * lu(k,3508) + lu(k,3572) = lu(k,3572) - lu(k,1627) * lu(k,3508) + lu(k,3574) = lu(k,3574) - lu(k,1628) * lu(k,3508) + lu(k,3575) = lu(k,3575) - lu(k,1629) * lu(k,3508) + lu(k,3576) = lu(k,3576) - lu(k,1630) * lu(k,3508) + lu(k,3577) = lu(k,3577) - lu(k,1631) * lu(k,3508) + lu(k,3769) = lu(k,3769) - lu(k,1619) * lu(k,3759) + lu(k,3777) = lu(k,3777) - lu(k,1620) * lu(k,3759) + lu(k,3814) = lu(k,3814) - lu(k,1621) * lu(k,3759) + lu(k,3815) = lu(k,3815) - lu(k,1622) * lu(k,3759) + lu(k,3817) = lu(k,3817) - lu(k,1623) * lu(k,3759) + lu(k,3819) = lu(k,3819) - lu(k,1624) * lu(k,3759) + lu(k,3820) = lu(k,3820) - lu(k,1625) * lu(k,3759) + lu(k,3821) = lu(k,3821) - lu(k,1626) * lu(k,3759) + lu(k,3822) = lu(k,3822) - lu(k,1627) * lu(k,3759) + lu(k,3824) = lu(k,3824) - lu(k,1628) * lu(k,3759) + lu(k,3825) = lu(k,3825) - lu(k,1629) * lu(k,3759) + lu(k,3826) = lu(k,3826) - lu(k,1630) * lu(k,3759) + lu(k,3827) = lu(k,3827) - lu(k,1631) * lu(k,3759) + lu(k,3904) = lu(k,3904) - lu(k,1619) * lu(k,3898) + lu(k,3911) = lu(k,3911) - lu(k,1620) * lu(k,3898) + lu(k,3949) = lu(k,3949) - lu(k,1621) * lu(k,3898) + lu(k,3950) = lu(k,3950) - lu(k,1622) * lu(k,3898) + lu(k,3952) = lu(k,3952) - lu(k,1623) * lu(k,3898) + lu(k,3954) = lu(k,3954) - lu(k,1624) * lu(k,3898) + lu(k,3955) = lu(k,3955) - lu(k,1625) * lu(k,3898) + lu(k,3956) = lu(k,3956) - lu(k,1626) * lu(k,3898) + lu(k,3957) = lu(k,3957) - lu(k,1627) * lu(k,3898) + lu(k,3959) = lu(k,3959) - lu(k,1628) * lu(k,3898) + lu(k,3960) = lu(k,3960) - lu(k,1629) * lu(k,3898) + lu(k,3961) = lu(k,3961) - lu(k,1630) * lu(k,3898) + lu(k,3962) = lu(k,3962) - lu(k,1631) * lu(k,3898) + lu(k,3997) = lu(k,3997) - lu(k,1619) * lu(k,3988) + lu(k,4005) = lu(k,4005) - lu(k,1620) * lu(k,3988) + lu(k,4041) = lu(k,4041) - lu(k,1621) * lu(k,3988) + lu(k,4042) = - lu(k,1622) * lu(k,3988) + lu(k,4044) = lu(k,4044) - lu(k,1623) * lu(k,3988) + lu(k,4046) = lu(k,4046) - lu(k,1624) * lu(k,3988) + lu(k,4047) = lu(k,4047) - lu(k,1625) * lu(k,3988) + lu(k,4048) = lu(k,4048) - lu(k,1626) * lu(k,3988) + lu(k,4049) = lu(k,4049) - lu(k,1627) * lu(k,3988) + lu(k,4051) = lu(k,4051) - lu(k,1628) * lu(k,3988) + lu(k,4052) = lu(k,4052) - lu(k,1629) * lu(k,3988) + lu(k,4053) = lu(k,4053) - lu(k,1630) * lu(k,3988) + lu(k,4054) = lu(k,4054) - lu(k,1631) * lu(k,3988) + lu(k,4080) = lu(k,4080) - lu(k,1619) * lu(k,4079) + lu(k,4082) = lu(k,4082) - lu(k,1620) * lu(k,4079) + lu(k,4093) = lu(k,4093) - lu(k,1621) * lu(k,4079) + lu(k,4094) = lu(k,4094) - lu(k,1622) * lu(k,4079) + lu(k,4096) = lu(k,4096) - lu(k,1623) * lu(k,4079) + lu(k,4098) = lu(k,4098) - lu(k,1624) * lu(k,4079) + lu(k,4099) = lu(k,4099) - lu(k,1625) * lu(k,4079) + lu(k,4100) = lu(k,4100) - lu(k,1626) * lu(k,4079) + lu(k,4101) = lu(k,4101) - lu(k,1627) * lu(k,4079) + lu(k,4103) = lu(k,4103) - lu(k,1628) * lu(k,4079) + lu(k,4104) = lu(k,4104) - lu(k,1629) * lu(k,4079) + lu(k,4105) = lu(k,4105) - lu(k,1630) * lu(k,4079) + lu(k,4106) = lu(k,4106) - lu(k,1631) * lu(k,4079) + lu(k,1638) = 1._r8 / lu(k,1638) + lu(k,1639) = lu(k,1639) * lu(k,1638) + lu(k,1640) = lu(k,1640) * lu(k,1638) + lu(k,1641) = lu(k,1641) * lu(k,1638) + lu(k,1642) = lu(k,1642) * lu(k,1638) + lu(k,1643) = lu(k,1643) * lu(k,1638) + lu(k,1644) = lu(k,1644) * lu(k,1638) + lu(k,1645) = lu(k,1645) * lu(k,1638) + lu(k,1646) = lu(k,1646) * lu(k,1638) + lu(k,1647) = lu(k,1647) * lu(k,1638) + lu(k,1648) = lu(k,1648) * lu(k,1638) + lu(k,1649) = lu(k,1649) * lu(k,1638) + lu(k,1650) = lu(k,1650) * lu(k,1638) + lu(k,1651) = lu(k,1651) * lu(k,1638) + lu(k,1652) = lu(k,1652) * lu(k,1638) + lu(k,1653) = lu(k,1653) * lu(k,1638) + lu(k,2132) = - lu(k,1639) * lu(k,2131) + lu(k,2133) = lu(k,2133) - lu(k,1640) * lu(k,2131) + lu(k,2134) = lu(k,2134) - lu(k,1641) * lu(k,2131) + lu(k,2135) = - lu(k,1642) * lu(k,2131) + lu(k,2137) = lu(k,2137) - lu(k,1643) * lu(k,2131) + lu(k,2138) = lu(k,2138) - lu(k,1644) * lu(k,2131) + lu(k,2139) = lu(k,2139) - lu(k,1645) * lu(k,2131) + lu(k,2141) = lu(k,2141) - lu(k,1646) * lu(k,2131) + lu(k,2144) = - lu(k,1647) * lu(k,2131) + lu(k,2145) = lu(k,2145) - lu(k,1648) * lu(k,2131) + lu(k,2146) = lu(k,2146) - lu(k,1649) * lu(k,2131) + lu(k,2147) = lu(k,2147) - lu(k,1650) * lu(k,2131) + lu(k,2148) = lu(k,2148) - lu(k,1651) * lu(k,2131) + lu(k,2149) = lu(k,2149) - lu(k,1652) * lu(k,2131) + lu(k,2152) = lu(k,2152) - lu(k,1653) * lu(k,2131) + lu(k,2168) = lu(k,2168) - lu(k,1639) * lu(k,2166) + lu(k,2169) = lu(k,2169) - lu(k,1640) * lu(k,2166) + lu(k,2170) = lu(k,2170) - lu(k,1641) * lu(k,2166) + lu(k,2171) = lu(k,2171) - lu(k,1642) * lu(k,2166) + lu(k,2172) = lu(k,2172) - lu(k,1643) * lu(k,2166) + lu(k,2173) = lu(k,2173) - lu(k,1644) * lu(k,2166) + lu(k,2174) = lu(k,2174) - lu(k,1645) * lu(k,2166) + lu(k,2183) = lu(k,2183) - lu(k,1646) * lu(k,2166) + lu(k,2186) = lu(k,2186) - lu(k,1647) * lu(k,2166) + lu(k,2187) = lu(k,2187) - lu(k,1648) * lu(k,2166) + lu(k,2188) = lu(k,2188) - lu(k,1649) * lu(k,2166) + lu(k,2189) = lu(k,2189) - lu(k,1650) * lu(k,2166) + lu(k,2190) = lu(k,2190) - lu(k,1651) * lu(k,2166) + lu(k,2191) = lu(k,2191) - lu(k,1652) * lu(k,2166) + lu(k,2195) = lu(k,2195) - lu(k,1653) * lu(k,2166) + lu(k,3077) = lu(k,3077) - lu(k,1639) * lu(k,3075) + lu(k,3079) = lu(k,3079) - lu(k,1640) * lu(k,3075) + lu(k,3081) = lu(k,3081) - lu(k,1641) * lu(k,3075) + lu(k,3083) = lu(k,3083) - lu(k,1642) * lu(k,3075) + lu(k,3088) = lu(k,3088) - lu(k,1643) * lu(k,3075) + lu(k,3089) = lu(k,3089) - lu(k,1644) * lu(k,3075) + lu(k,3090) = lu(k,3090) - lu(k,1645) * lu(k,3075) + lu(k,3126) = lu(k,3126) - lu(k,1646) * lu(k,3075) + lu(k,3129) = lu(k,3129) - lu(k,1647) * lu(k,3075) + lu(k,3130) = lu(k,3130) - lu(k,1648) * lu(k,3075) + lu(k,3131) = lu(k,3131) - lu(k,1649) * lu(k,3075) + lu(k,3132) = lu(k,3132) - lu(k,1650) * lu(k,3075) + lu(k,3133) = lu(k,3133) - lu(k,1651) * lu(k,3075) + lu(k,3134) = lu(k,3134) - lu(k,1652) * lu(k,3075) + lu(k,3138) = lu(k,3138) - lu(k,1653) * lu(k,3075) + lu(k,3258) = lu(k,3258) - lu(k,1639) * lu(k,3254) + lu(k,3260) = lu(k,3260) - lu(k,1640) * lu(k,3254) + lu(k,3262) = lu(k,3262) - lu(k,1641) * lu(k,3254) + lu(k,3264) = lu(k,3264) - lu(k,1642) * lu(k,3254) + lu(k,3269) = lu(k,3269) - lu(k,1643) * lu(k,3254) + lu(k,3270) = lu(k,3270) - lu(k,1644) * lu(k,3254) + lu(k,3271) = lu(k,3271) - lu(k,1645) * lu(k,3254) + lu(k,3308) = lu(k,3308) - lu(k,1646) * lu(k,3254) + lu(k,3311) = lu(k,3311) - lu(k,1647) * lu(k,3254) + lu(k,3312) = lu(k,3312) - lu(k,1648) * lu(k,3254) + lu(k,3313) = lu(k,3313) - lu(k,1649) * lu(k,3254) + lu(k,3314) = lu(k,3314) - lu(k,1650) * lu(k,3254) + lu(k,3315) = lu(k,3315) - lu(k,1651) * lu(k,3254) + lu(k,3316) = lu(k,3316) - lu(k,1652) * lu(k,3254) + lu(k,3320) = lu(k,3320) - lu(k,1653) * lu(k,3254) + lu(k,3514) = lu(k,3514) - lu(k,1639) * lu(k,3509) + lu(k,3516) = lu(k,3516) - lu(k,1640) * lu(k,3509) + lu(k,3518) = lu(k,3518) - lu(k,1641) * lu(k,3509) + lu(k,3520) = lu(k,3520) - lu(k,1642) * lu(k,3509) + lu(k,3525) = lu(k,3525) - lu(k,1643) * lu(k,3509) + lu(k,3526) = lu(k,3526) - lu(k,1644) * lu(k,3509) + lu(k,3527) = lu(k,3527) - lu(k,1645) * lu(k,3509) + lu(k,3564) = lu(k,3564) - lu(k,1646) * lu(k,3509) + lu(k,3567) = lu(k,3567) - lu(k,1647) * lu(k,3509) + lu(k,3568) = lu(k,3568) - lu(k,1648) * lu(k,3509) + lu(k,3569) = lu(k,3569) - lu(k,1649) * lu(k,3509) + lu(k,3570) = lu(k,3570) - lu(k,1650) * lu(k,3509) + lu(k,3571) = lu(k,3571) - lu(k,1651) * lu(k,3509) + lu(k,3572) = lu(k,3572) - lu(k,1652) * lu(k,3509) + lu(k,3576) = lu(k,3576) - lu(k,1653) * lu(k,3509) + lu(k,3765) = lu(k,3765) - lu(k,1639) * lu(k,3760) + lu(k,3767) = lu(k,3767) - lu(k,1640) * lu(k,3760) + lu(k,3769) = lu(k,3769) - lu(k,1641) * lu(k,3760) + lu(k,3771) = lu(k,3771) - lu(k,1642) * lu(k,3760) + lu(k,3776) = lu(k,3776) - lu(k,1643) * lu(k,3760) + lu(k,3777) = lu(k,3777) - lu(k,1644) * lu(k,3760) + lu(k,3778) = lu(k,3778) - lu(k,1645) * lu(k,3760) + lu(k,3814) = lu(k,3814) - lu(k,1646) * lu(k,3760) + lu(k,3817) = lu(k,3817) - lu(k,1647) * lu(k,3760) + lu(k,3818) = lu(k,3818) - lu(k,1648) * lu(k,3760) + lu(k,3819) = lu(k,3819) - lu(k,1649) * lu(k,3760) + lu(k,3820) = lu(k,3820) - lu(k,1650) * lu(k,3760) + lu(k,3821) = lu(k,3821) - lu(k,1651) * lu(k,3760) + lu(k,3822) = lu(k,3822) - lu(k,1652) * lu(k,3760) + lu(k,3826) = lu(k,3826) - lu(k,1653) * lu(k,3760) + lu(k,3993) = lu(k,3993) - lu(k,1639) * lu(k,3989) + lu(k,3995) = lu(k,3995) - lu(k,1640) * lu(k,3989) + lu(k,3997) = lu(k,3997) - lu(k,1641) * lu(k,3989) + lu(k,3999) = lu(k,3999) - lu(k,1642) * lu(k,3989) + lu(k,4004) = lu(k,4004) - lu(k,1643) * lu(k,3989) + lu(k,4005) = lu(k,4005) - lu(k,1644) * lu(k,3989) + lu(k,4006) = lu(k,4006) - lu(k,1645) * lu(k,3989) + lu(k,4041) = lu(k,4041) - lu(k,1646) * lu(k,3989) + lu(k,4044) = lu(k,4044) - lu(k,1647) * lu(k,3989) + lu(k,4045) = lu(k,4045) - lu(k,1648) * lu(k,3989) + lu(k,4046) = lu(k,4046) - lu(k,1649) * lu(k,3989) + lu(k,4047) = lu(k,4047) - lu(k,1650) * lu(k,3989) + lu(k,4048) = lu(k,4048) - lu(k,1651) * lu(k,3989) + lu(k,4049) = lu(k,4049) - lu(k,1652) * lu(k,3989) + lu(k,4053) = lu(k,4053) - lu(k,1653) * lu(k,3989) + lu(k,1657) = 1._r8 / lu(k,1657) + lu(k,1658) = lu(k,1658) * lu(k,1657) + lu(k,1659) = lu(k,1659) * lu(k,1657) + lu(k,1660) = lu(k,1660) * lu(k,1657) + lu(k,1661) = lu(k,1661) * lu(k,1657) + lu(k,1662) = lu(k,1662) * lu(k,1657) + lu(k,1663) = lu(k,1663) * lu(k,1657) + lu(k,1664) = lu(k,1664) * lu(k,1657) + lu(k,1665) = lu(k,1665) * lu(k,1657) + lu(k,1666) = lu(k,1666) * lu(k,1657) + lu(k,1667) = lu(k,1667) * lu(k,1657) + lu(k,1668) = lu(k,1668) * lu(k,1657) + lu(k,1948) = lu(k,1948) - lu(k,1658) * lu(k,1947) + lu(k,1949) = lu(k,1949) - lu(k,1659) * lu(k,1947) + lu(k,1951) = lu(k,1951) - lu(k,1660) * lu(k,1947) + lu(k,1956) = lu(k,1956) - lu(k,1661) * lu(k,1947) + lu(k,1957) = lu(k,1957) - lu(k,1662) * lu(k,1947) + lu(k,1958) = - lu(k,1663) * lu(k,1947) + lu(k,1966) = lu(k,1966) - lu(k,1664) * lu(k,1947) + lu(k,1968) = lu(k,1968) - lu(k,1665) * lu(k,1947) + lu(k,1969) = lu(k,1969) - lu(k,1666) * lu(k,1947) + lu(k,1970) = lu(k,1970) - lu(k,1667) * lu(k,1947) + lu(k,1973) = lu(k,1973) - lu(k,1668) * lu(k,1947) + lu(k,1985) = lu(k,1985) - lu(k,1658) * lu(k,1984) + lu(k,1986) = - lu(k,1659) * lu(k,1984) + lu(k,1987) = lu(k,1987) - lu(k,1660) * lu(k,1984) + lu(k,1993) = lu(k,1993) - lu(k,1661) * lu(k,1984) + lu(k,1994) = lu(k,1994) - lu(k,1662) * lu(k,1984) + lu(k,1995) = lu(k,1995) - lu(k,1663) * lu(k,1984) + lu(k,2005) = - lu(k,1664) * lu(k,1984) + lu(k,2007) = lu(k,2007) - lu(k,1665) * lu(k,1984) + lu(k,2008) = lu(k,2008) - lu(k,1666) * lu(k,1984) + lu(k,2009) = lu(k,2009) - lu(k,1667) * lu(k,1984) + lu(k,2012) = lu(k,2012) - lu(k,1668) * lu(k,1984) + lu(k,2070) = lu(k,2070) - lu(k,1658) * lu(k,2069) + lu(k,2071) = - lu(k,1659) * lu(k,2069) + lu(k,2072) = lu(k,2072) - lu(k,1660) * lu(k,2069) + lu(k,2075) = lu(k,2075) - lu(k,1661) * lu(k,2069) + lu(k,2076) = lu(k,2076) - lu(k,1662) * lu(k,2069) + lu(k,2077) = lu(k,2077) - lu(k,1663) * lu(k,2069) + lu(k,2084) = lu(k,2084) - lu(k,1664) * lu(k,2069) + lu(k,2086) = lu(k,2086) - lu(k,1665) * lu(k,2069) + lu(k,2087) = lu(k,2087) - lu(k,1666) * lu(k,2069) + lu(k,2088) = lu(k,2088) - lu(k,1667) * lu(k,2069) + lu(k,2091) = lu(k,2091) - lu(k,1668) * lu(k,2069) + lu(k,2102) = lu(k,2102) - lu(k,1658) * lu(k,2101) + lu(k,2103) = lu(k,2103) - lu(k,1659) * lu(k,2101) + lu(k,2104) = lu(k,2104) - lu(k,1660) * lu(k,2101) + lu(k,2107) = lu(k,2107) - lu(k,1661) * lu(k,2101) + lu(k,2108) = lu(k,2108) - lu(k,1662) * lu(k,2101) + lu(k,2109) = - lu(k,1663) * lu(k,2101) + lu(k,2116) = lu(k,2116) - lu(k,1664) * lu(k,2101) + lu(k,2118) = lu(k,2118) - lu(k,1665) * lu(k,2101) + lu(k,2119) = lu(k,2119) - lu(k,1666) * lu(k,2101) + lu(k,2120) = lu(k,2120) - lu(k,1667) * lu(k,2101) + lu(k,2123) = lu(k,2123) - lu(k,1668) * lu(k,2101) + lu(k,2168) = lu(k,2168) - lu(k,1658) * lu(k,2167) + lu(k,2169) = lu(k,2169) - lu(k,1659) * lu(k,2167) + lu(k,2170) = lu(k,2170) - lu(k,1660) * lu(k,2167) + lu(k,2172) = lu(k,2172) - lu(k,1661) * lu(k,2167) + lu(k,2173) = lu(k,2173) - lu(k,1662) * lu(k,2167) + lu(k,2174) = lu(k,2174) - lu(k,1663) * lu(k,2167) + lu(k,2187) = lu(k,2187) - lu(k,1664) * lu(k,2167) + lu(k,2189) = lu(k,2189) - lu(k,1665) * lu(k,2167) + lu(k,2190) = lu(k,2190) - lu(k,1666) * lu(k,2167) + lu(k,2191) = lu(k,2191) - lu(k,1667) * lu(k,2167) + lu(k,2195) = lu(k,2195) - lu(k,1668) * lu(k,2167) + lu(k,3077) = lu(k,3077) - lu(k,1658) * lu(k,3076) + lu(k,3079) = lu(k,3079) - lu(k,1659) * lu(k,3076) + lu(k,3081) = lu(k,3081) - lu(k,1660) * lu(k,3076) + lu(k,3088) = lu(k,3088) - lu(k,1661) * lu(k,3076) + lu(k,3089) = lu(k,3089) - lu(k,1662) * lu(k,3076) + lu(k,3090) = lu(k,3090) - lu(k,1663) * lu(k,3076) + lu(k,3130) = lu(k,3130) - lu(k,1664) * lu(k,3076) + lu(k,3132) = lu(k,3132) - lu(k,1665) * lu(k,3076) + lu(k,3133) = lu(k,3133) - lu(k,1666) * lu(k,3076) + lu(k,3134) = lu(k,3134) - lu(k,1667) * lu(k,3076) + lu(k,3138) = lu(k,3138) - lu(k,1668) * lu(k,3076) + lu(k,3258) = lu(k,3258) - lu(k,1658) * lu(k,3255) + lu(k,3260) = lu(k,3260) - lu(k,1659) * lu(k,3255) + lu(k,3262) = lu(k,3262) - lu(k,1660) * lu(k,3255) + lu(k,3269) = lu(k,3269) - lu(k,1661) * lu(k,3255) + lu(k,3270) = lu(k,3270) - lu(k,1662) * lu(k,3255) + lu(k,3271) = lu(k,3271) - lu(k,1663) * lu(k,3255) + lu(k,3312) = lu(k,3312) - lu(k,1664) * lu(k,3255) + lu(k,3314) = lu(k,3314) - lu(k,1665) * lu(k,3255) + lu(k,3315) = lu(k,3315) - lu(k,1666) * lu(k,3255) + lu(k,3316) = lu(k,3316) - lu(k,1667) * lu(k,3255) + lu(k,3320) = lu(k,3320) - lu(k,1668) * lu(k,3255) + lu(k,3514) = lu(k,3514) - lu(k,1658) * lu(k,3510) + lu(k,3516) = lu(k,3516) - lu(k,1659) * lu(k,3510) + lu(k,3518) = lu(k,3518) - lu(k,1660) * lu(k,3510) + lu(k,3525) = lu(k,3525) - lu(k,1661) * lu(k,3510) + lu(k,3526) = lu(k,3526) - lu(k,1662) * lu(k,3510) + lu(k,3527) = lu(k,3527) - lu(k,1663) * lu(k,3510) + lu(k,3568) = lu(k,3568) - lu(k,1664) * lu(k,3510) + lu(k,3570) = lu(k,3570) - lu(k,1665) * lu(k,3510) + lu(k,3571) = lu(k,3571) - lu(k,1666) * lu(k,3510) + lu(k,3572) = lu(k,3572) - lu(k,1667) * lu(k,3510) + lu(k,3576) = lu(k,3576) - lu(k,1668) * lu(k,3510) + lu(k,3765) = lu(k,3765) - lu(k,1658) * lu(k,3761) + lu(k,3767) = lu(k,3767) - lu(k,1659) * lu(k,3761) + lu(k,3769) = lu(k,3769) - lu(k,1660) * lu(k,3761) + lu(k,3776) = lu(k,3776) - lu(k,1661) * lu(k,3761) + lu(k,3777) = lu(k,3777) - lu(k,1662) * lu(k,3761) + lu(k,3778) = lu(k,3778) - lu(k,1663) * lu(k,3761) + lu(k,3818) = lu(k,3818) - lu(k,1664) * lu(k,3761) + lu(k,3820) = lu(k,3820) - lu(k,1665) * lu(k,3761) + lu(k,3821) = lu(k,3821) - lu(k,1666) * lu(k,3761) + lu(k,3822) = lu(k,3822) - lu(k,1667) * lu(k,3761) + lu(k,3826) = lu(k,3826) - lu(k,1668) * lu(k,3761) + lu(k,3993) = lu(k,3993) - lu(k,1658) * lu(k,3990) + lu(k,3995) = lu(k,3995) - lu(k,1659) * lu(k,3990) + lu(k,3997) = lu(k,3997) - lu(k,1660) * lu(k,3990) + lu(k,4004) = lu(k,4004) - lu(k,1661) * lu(k,3990) + lu(k,4005) = lu(k,4005) - lu(k,1662) * lu(k,3990) + lu(k,4006) = lu(k,4006) - lu(k,1663) * lu(k,3990) + lu(k,4045) = lu(k,4045) - lu(k,1664) * lu(k,3990) + lu(k,4047) = lu(k,4047) - lu(k,1665) * lu(k,3990) + lu(k,4048) = lu(k,4048) - lu(k,1666) * lu(k,3990) + lu(k,4049) = lu(k,4049) - lu(k,1667) * lu(k,3990) + lu(k,4053) = lu(k,4053) - lu(k,1668) * lu(k,3990) end do end subroutine lu_fac36 subroutine lu_fac37( avec_len, lu ) @@ -8068,518 +7587,368 @@ subroutine lu_fac37( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1635) = 1._r8 / lu(k,1635) - lu(k,1636) = lu(k,1636) * lu(k,1635) - lu(k,1637) = lu(k,1637) * lu(k,1635) - lu(k,1638) = lu(k,1638) * lu(k,1635) - lu(k,1639) = lu(k,1639) * lu(k,1635) - lu(k,1640) = lu(k,1640) * lu(k,1635) - lu(k,1641) = lu(k,1641) * lu(k,1635) - lu(k,1642) = lu(k,1642) * lu(k,1635) - lu(k,1643) = lu(k,1643) * lu(k,1635) - lu(k,1701) = - lu(k,1636) * lu(k,1699) - lu(k,1702) = lu(k,1702) - lu(k,1637) * lu(k,1699) - lu(k,1703) = lu(k,1703) - lu(k,1638) * lu(k,1699) - lu(k,1704) = lu(k,1704) - lu(k,1639) * lu(k,1699) - lu(k,1706) = lu(k,1706) - lu(k,1640) * lu(k,1699) - lu(k,1707) = lu(k,1707) - lu(k,1641) * lu(k,1699) - lu(k,1708) = lu(k,1708) - lu(k,1642) * lu(k,1699) - lu(k,1709) = lu(k,1709) - lu(k,1643) * lu(k,1699) - lu(k,1731) = lu(k,1731) - lu(k,1636) * lu(k,1726) - lu(k,1732) = lu(k,1732) - lu(k,1637) * lu(k,1726) - lu(k,1736) = lu(k,1736) - lu(k,1638) * lu(k,1726) - lu(k,1738) = lu(k,1738) - lu(k,1639) * lu(k,1726) - lu(k,1740) = lu(k,1740) - lu(k,1640) * lu(k,1726) - lu(k,1741) = lu(k,1741) - lu(k,1641) * lu(k,1726) - lu(k,1743) = lu(k,1743) - lu(k,1642) * lu(k,1726) - lu(k,1744) = lu(k,1744) - lu(k,1643) * lu(k,1726) - lu(k,1828) = lu(k,1828) - lu(k,1636) * lu(k,1825) - lu(k,1830) = lu(k,1830) - lu(k,1637) * lu(k,1825) - lu(k,1834) = lu(k,1834) - lu(k,1638) * lu(k,1825) - lu(k,1836) = lu(k,1836) - lu(k,1639) * lu(k,1825) - lu(k,1838) = lu(k,1838) - lu(k,1640) * lu(k,1825) - lu(k,1839) = lu(k,1839) - lu(k,1641) * lu(k,1825) - lu(k,1841) = lu(k,1841) - lu(k,1642) * lu(k,1825) - lu(k,1842) = lu(k,1842) - lu(k,1643) * lu(k,1825) - lu(k,1892) = - lu(k,1636) * lu(k,1888) - lu(k,1894) = lu(k,1894) - lu(k,1637) * lu(k,1888) - lu(k,1900) = lu(k,1900) - lu(k,1638) * lu(k,1888) - lu(k,1902) = lu(k,1902) - lu(k,1639) * lu(k,1888) - lu(k,1906) = lu(k,1906) - lu(k,1640) * lu(k,1888) - lu(k,1907) = lu(k,1907) - lu(k,1641) * lu(k,1888) - lu(k,1909) = lu(k,1909) - lu(k,1642) * lu(k,1888) - lu(k,1910) = lu(k,1910) - lu(k,1643) * lu(k,1888) - lu(k,1928) = lu(k,1928) - lu(k,1636) * lu(k,1926) - lu(k,1929) = lu(k,1929) - lu(k,1637) * lu(k,1926) - lu(k,1932) = lu(k,1932) - lu(k,1638) * lu(k,1926) - lu(k,1934) = lu(k,1934) - lu(k,1639) * lu(k,1926) - lu(k,1938) = lu(k,1938) - lu(k,1640) * lu(k,1926) - lu(k,1939) = lu(k,1939) - lu(k,1641) * lu(k,1926) - lu(k,1941) = lu(k,1941) - lu(k,1642) * lu(k,1926) - lu(k,1942) = lu(k,1942) - lu(k,1643) * lu(k,1926) - lu(k,1962) = lu(k,1962) - lu(k,1636) * lu(k,1960) - lu(k,1963) = lu(k,1963) - lu(k,1637) * lu(k,1960) - lu(k,1966) = lu(k,1966) - lu(k,1638) * lu(k,1960) - lu(k,1968) = lu(k,1968) - lu(k,1639) * lu(k,1960) - lu(k,1972) = lu(k,1972) - lu(k,1640) * lu(k,1960) - lu(k,1973) = lu(k,1973) - lu(k,1641) * lu(k,1960) - lu(k,1975) = lu(k,1975) - lu(k,1642) * lu(k,1960) - lu(k,1976) = lu(k,1976) - lu(k,1643) * lu(k,1960) - lu(k,1991) = lu(k,1991) - lu(k,1636) * lu(k,1989) - lu(k,1992) = lu(k,1992) - lu(k,1637) * lu(k,1989) - lu(k,1994) = lu(k,1994) - lu(k,1638) * lu(k,1989) - lu(k,1996) = lu(k,1996) - lu(k,1639) * lu(k,1989) - lu(k,2000) = lu(k,2000) - lu(k,1640) * lu(k,1989) - lu(k,2001) = lu(k,2001) - lu(k,1641) * lu(k,1989) - lu(k,2003) = lu(k,2003) - lu(k,1642) * lu(k,1989) - lu(k,2004) = lu(k,2004) - lu(k,1643) * lu(k,1989) - lu(k,2028) = lu(k,2028) - lu(k,1636) * lu(k,2026) - lu(k,2029) = lu(k,2029) - lu(k,1637) * lu(k,2026) - lu(k,2036) = lu(k,2036) - lu(k,1638) * lu(k,2026) - lu(k,2038) = lu(k,2038) - lu(k,1639) * lu(k,2026) - lu(k,2042) = lu(k,2042) - lu(k,1640) * lu(k,2026) - lu(k,2043) = lu(k,2043) - lu(k,1641) * lu(k,2026) - lu(k,2046) = lu(k,2046) - lu(k,1642) * lu(k,2026) - lu(k,2047) = lu(k,2047) - lu(k,1643) * lu(k,2026) - lu(k,2851) = lu(k,2851) - lu(k,1636) * lu(k,2843) - lu(k,2853) = lu(k,2853) - lu(k,1637) * lu(k,2843) - lu(k,2882) = lu(k,2882) - lu(k,1638) * lu(k,2843) - lu(k,2884) = lu(k,2884) - lu(k,1639) * lu(k,2843) - lu(k,2889) = lu(k,2889) - lu(k,1640) * lu(k,2843) - lu(k,2891) = lu(k,2891) - lu(k,1641) * lu(k,2843) - lu(k,2894) = lu(k,2894) - lu(k,1642) * lu(k,2843) - lu(k,2895) = lu(k,2895) - lu(k,1643) * lu(k,2843) - lu(k,2953) = lu(k,2953) - lu(k,1636) * lu(k,2945) - lu(k,2955) = lu(k,2955) - lu(k,1637) * lu(k,2945) - lu(k,2983) = lu(k,2983) - lu(k,1638) * lu(k,2945) - lu(k,2985) = lu(k,2985) - lu(k,1639) * lu(k,2945) - lu(k,2990) = lu(k,2990) - lu(k,1640) * lu(k,2945) - lu(k,2992) = lu(k,2992) - lu(k,1641) * lu(k,2945) - lu(k,2995) = lu(k,2995) - lu(k,1642) * lu(k,2945) - lu(k,2996) = lu(k,2996) - lu(k,1643) * lu(k,2945) - lu(k,3247) = lu(k,3247) - lu(k,1636) * lu(k,3239) - lu(k,3249) = lu(k,3249) - lu(k,1637) * lu(k,3239) - lu(k,3278) = lu(k,3278) - lu(k,1638) * lu(k,3239) - lu(k,3280) = lu(k,3280) - lu(k,1639) * lu(k,3239) - lu(k,3285) = lu(k,3285) - lu(k,1640) * lu(k,3239) - lu(k,3287) = lu(k,3287) - lu(k,1641) * lu(k,3239) - lu(k,3290) = lu(k,3290) - lu(k,1642) * lu(k,3239) - lu(k,3291) = lu(k,3291) - lu(k,1643) * lu(k,3239) - lu(k,3388) = lu(k,3388) - lu(k,1636) * lu(k,3381) - lu(k,3390) = lu(k,3390) - lu(k,1637) * lu(k,3381) - lu(k,3419) = lu(k,3419) - lu(k,1638) * lu(k,3381) - lu(k,3421) = lu(k,3421) - lu(k,1639) * lu(k,3381) - lu(k,3426) = lu(k,3426) - lu(k,1640) * lu(k,3381) - lu(k,3428) = lu(k,3428) - lu(k,1641) * lu(k,3381) - lu(k,3431) = lu(k,3431) - lu(k,1642) * lu(k,3381) - lu(k,3432) = lu(k,3432) - lu(k,1643) * lu(k,3381) - lu(k,3709) = lu(k,3709) - lu(k,1636) * lu(k,3701) - lu(k,3711) = lu(k,3711) - lu(k,1637) * lu(k,3701) - lu(k,3739) = lu(k,3739) - lu(k,1638) * lu(k,3701) - lu(k,3741) = lu(k,3741) - lu(k,1639) * lu(k,3701) - lu(k,3746) = lu(k,3746) - lu(k,1640) * lu(k,3701) - lu(k,3748) = lu(k,3748) - lu(k,1641) * lu(k,3701) - lu(k,3751) = lu(k,3751) - lu(k,1642) * lu(k,3701) - lu(k,3752) = lu(k,3752) - lu(k,1643) * lu(k,3701) - lu(k,1645) = 1._r8 / lu(k,1645) - lu(k,1646) = lu(k,1646) * lu(k,1645) - lu(k,1647) = lu(k,1647) * lu(k,1645) - lu(k,1648) = lu(k,1648) * lu(k,1645) - lu(k,1649) = lu(k,1649) * lu(k,1645) - lu(k,1650) = lu(k,1650) * lu(k,1645) - lu(k,1651) = lu(k,1651) * lu(k,1645) - lu(k,1652) = lu(k,1652) * lu(k,1645) - lu(k,2076) = lu(k,2076) - lu(k,1646) * lu(k,2071) - lu(k,2079) = lu(k,2079) - lu(k,1647) * lu(k,2071) - lu(k,2082) = lu(k,2082) - lu(k,1648) * lu(k,2071) - lu(k,2083) = - lu(k,1649) * lu(k,2071) - lu(k,2085) = lu(k,2085) - lu(k,1650) * lu(k,2071) - lu(k,2086) = lu(k,2086) - lu(k,1651) * lu(k,2071) - lu(k,2090) = lu(k,2090) - lu(k,1652) * lu(k,2071) - lu(k,2182) = - lu(k,1646) * lu(k,2178) - lu(k,2183) = - lu(k,1647) * lu(k,2178) - lu(k,2184) = - lu(k,1648) * lu(k,2178) - lu(k,2185) = - lu(k,1649) * lu(k,2178) - lu(k,2187) = - lu(k,1650) * lu(k,2178) - lu(k,2188) = lu(k,2188) - lu(k,1651) * lu(k,2178) - lu(k,2191) = lu(k,2191) - lu(k,1652) * lu(k,2178) - lu(k,2217) = lu(k,2217) - lu(k,1646) * lu(k,2210) - lu(k,2220) = lu(k,2220) - lu(k,1647) * lu(k,2210) - lu(k,2223) = lu(k,2223) - lu(k,1648) * lu(k,2210) - lu(k,2224) = - lu(k,1649) * lu(k,2210) - lu(k,2226) = lu(k,2226) - lu(k,1650) * lu(k,2210) - lu(k,2227) = lu(k,2227) - lu(k,1651) * lu(k,2210) - lu(k,2231) = lu(k,2231) - lu(k,1652) * lu(k,2210) - lu(k,2246) = lu(k,2246) - lu(k,1646) * lu(k,2239) - lu(k,2249) = lu(k,2249) - lu(k,1647) * lu(k,2239) - lu(k,2252) = lu(k,2252) - lu(k,1648) * lu(k,2239) - lu(k,2253) = - lu(k,1649) * lu(k,2239) - lu(k,2255) = lu(k,2255) - lu(k,1650) * lu(k,2239) - lu(k,2256) = lu(k,2256) - lu(k,1651) * lu(k,2239) - lu(k,2260) = lu(k,2260) - lu(k,1652) * lu(k,2239) - lu(k,2334) = lu(k,2334) - lu(k,1646) * lu(k,2330) - lu(k,2337) = lu(k,2337) - lu(k,1647) * lu(k,2330) - lu(k,2340) = lu(k,2340) - lu(k,1648) * lu(k,2330) - lu(k,2341) = - lu(k,1649) * lu(k,2330) - lu(k,2343) = lu(k,2343) - lu(k,1650) * lu(k,2330) - lu(k,2344) = lu(k,2344) - lu(k,1651) * lu(k,2330) - lu(k,2348) = lu(k,2348) - lu(k,1652) * lu(k,2330) - lu(k,2422) = - lu(k,1646) * lu(k,2418) - lu(k,2424) = lu(k,2424) - lu(k,1647) * lu(k,2418) - lu(k,2426) = - lu(k,1648) * lu(k,2418) - lu(k,2427) = - lu(k,1649) * lu(k,2418) - lu(k,2430) = lu(k,2430) - lu(k,1650) * lu(k,2418) - lu(k,2431) = lu(k,2431) - lu(k,1651) * lu(k,2418) - lu(k,2435) = lu(k,2435) - lu(k,1652) * lu(k,2418) - lu(k,2467) = lu(k,2467) - lu(k,1646) * lu(k,2464) - lu(k,2470) = lu(k,2470) - lu(k,1647) * lu(k,2464) - lu(k,2473) = - lu(k,1648) * lu(k,2464) - lu(k,2474) = lu(k,2474) - lu(k,1649) * lu(k,2464) - lu(k,2476) = lu(k,2476) - lu(k,1650) * lu(k,2464) - lu(k,2477) = lu(k,2477) - lu(k,1651) * lu(k,2464) - lu(k,2481) = lu(k,2481) - lu(k,1652) * lu(k,2464) - lu(k,2530) = lu(k,2530) - lu(k,1646) * lu(k,2512) - lu(k,2533) = lu(k,2533) - lu(k,1647) * lu(k,2512) - lu(k,2536) = lu(k,2536) - lu(k,1648) * lu(k,2512) - lu(k,2537) = lu(k,2537) - lu(k,1649) * lu(k,2512) - lu(k,2540) = lu(k,2540) - lu(k,1650) * lu(k,2512) - lu(k,2541) = lu(k,2541) - lu(k,1651) * lu(k,2512) - lu(k,2546) = lu(k,2546) - lu(k,1652) * lu(k,2512) - lu(k,2576) = lu(k,2576) - lu(k,1646) * lu(k,2558) - lu(k,2579) = lu(k,2579) - lu(k,1647) * lu(k,2558) - lu(k,2582) = lu(k,2582) - lu(k,1648) * lu(k,2558) - lu(k,2583) = lu(k,2583) - lu(k,1649) * lu(k,2558) - lu(k,2586) = lu(k,2586) - lu(k,1650) * lu(k,2558) - lu(k,2587) = lu(k,2587) - lu(k,1651) * lu(k,2558) - lu(k,2592) = lu(k,2592) - lu(k,1652) * lu(k,2558) - lu(k,2623) = lu(k,2623) - lu(k,1646) * lu(k,2605) - lu(k,2626) = lu(k,2626) - lu(k,1647) * lu(k,2605) - lu(k,2629) = lu(k,2629) - lu(k,1648) * lu(k,2605) - lu(k,2630) = lu(k,2630) - lu(k,1649) * lu(k,2605) - lu(k,2633) = lu(k,2633) - lu(k,1650) * lu(k,2605) - lu(k,2634) = lu(k,2634) - lu(k,1651) * lu(k,2605) - lu(k,2639) = lu(k,2639) - lu(k,1652) * lu(k,2605) - lu(k,2694) = lu(k,2694) - lu(k,1646) * lu(k,2662) - lu(k,2697) = lu(k,2697) - lu(k,1647) * lu(k,2662) - lu(k,2700) = lu(k,2700) - lu(k,1648) * lu(k,2662) - lu(k,2701) = lu(k,2701) - lu(k,1649) * lu(k,2662) - lu(k,2704) = lu(k,2704) - lu(k,1650) * lu(k,2662) - lu(k,2705) = lu(k,2705) - lu(k,1651) * lu(k,2662) - lu(k,2710) = lu(k,2710) - lu(k,1652) * lu(k,2662) - lu(k,2877) = lu(k,2877) - lu(k,1646) * lu(k,2844) - lu(k,2880) = lu(k,2880) - lu(k,1647) * lu(k,2844) - lu(k,2883) = lu(k,2883) - lu(k,1648) * lu(k,2844) - lu(k,2884) = lu(k,2884) - lu(k,1649) * lu(k,2844) - lu(k,2887) = lu(k,2887) - lu(k,1650) * lu(k,2844) - lu(k,2889) = lu(k,2889) - lu(k,1651) * lu(k,2844) - lu(k,2895) = lu(k,2895) - lu(k,1652) * lu(k,2844) - lu(k,2978) = - lu(k,1646) * lu(k,2946) - lu(k,2981) = lu(k,2981) - lu(k,1647) * lu(k,2946) - lu(k,2984) = lu(k,2984) - lu(k,1648) * lu(k,2946) - lu(k,2985) = lu(k,2985) - lu(k,1649) * lu(k,2946) - lu(k,2988) = lu(k,2988) - lu(k,1650) * lu(k,2946) - lu(k,2990) = lu(k,2990) - lu(k,1651) * lu(k,2946) - lu(k,2996) = lu(k,2996) - lu(k,1652) * lu(k,2946) - lu(k,3070) = lu(k,3070) - lu(k,1646) * lu(k,3037) - lu(k,3073) = lu(k,3073) - lu(k,1647) * lu(k,3037) - lu(k,3076) = lu(k,3076) - lu(k,1648) * lu(k,3037) - lu(k,3077) = lu(k,3077) - lu(k,1649) * lu(k,3037) - lu(k,3080) = lu(k,3080) - lu(k,1650) * lu(k,3037) - lu(k,3082) = lu(k,3082) - lu(k,1651) * lu(k,3037) - lu(k,3088) = lu(k,3088) - lu(k,1652) * lu(k,3037) - lu(k,3273) = lu(k,3273) - lu(k,1646) * lu(k,3240) - lu(k,3276) = lu(k,3276) - lu(k,1647) * lu(k,3240) - lu(k,3279) = lu(k,3279) - lu(k,1648) * lu(k,3240) - lu(k,3280) = lu(k,3280) - lu(k,1649) * lu(k,3240) - lu(k,3283) = lu(k,3283) - lu(k,1650) * lu(k,3240) - lu(k,3285) = lu(k,3285) - lu(k,1651) * lu(k,3240) - lu(k,3291) = lu(k,3291) - lu(k,1652) * lu(k,3240) - lu(k,3414) = lu(k,3414) - lu(k,1646) * lu(k,3382) - lu(k,3417) = lu(k,3417) - lu(k,1647) * lu(k,3382) - lu(k,3420) = lu(k,3420) - lu(k,1648) * lu(k,3382) - lu(k,3421) = lu(k,3421) - lu(k,1649) * lu(k,3382) - lu(k,3424) = lu(k,3424) - lu(k,1650) * lu(k,3382) - lu(k,3426) = lu(k,3426) - lu(k,1651) * lu(k,3382) - lu(k,3432) = lu(k,3432) - lu(k,1652) * lu(k,3382) - lu(k,3734) = lu(k,3734) - lu(k,1646) * lu(k,3702) - lu(k,3737) = lu(k,3737) - lu(k,1647) * lu(k,3702) - lu(k,3740) = lu(k,3740) - lu(k,1648) * lu(k,3702) - lu(k,3741) = lu(k,3741) - lu(k,1649) * lu(k,3702) - lu(k,3744) = lu(k,3744) - lu(k,1650) * lu(k,3702) - lu(k,3746) = lu(k,3746) - lu(k,1651) * lu(k,3702) - lu(k,3752) = lu(k,3752) - lu(k,1652) * lu(k,3702) - lu(k,1667) = 1._r8 / lu(k,1667) - lu(k,1668) = lu(k,1668) * lu(k,1667) - lu(k,1669) = lu(k,1669) * lu(k,1667) - lu(k,1670) = lu(k,1670) * lu(k,1667) - lu(k,1671) = lu(k,1671) * lu(k,1667) - lu(k,1672) = lu(k,1672) * lu(k,1667) - lu(k,1673) = lu(k,1673) * lu(k,1667) - lu(k,1674) = lu(k,1674) * lu(k,1667) - lu(k,1675) = lu(k,1675) * lu(k,1667) - lu(k,1676) = lu(k,1676) * lu(k,1667) - lu(k,1677) = lu(k,1677) * lu(k,1667) - lu(k,1678) = lu(k,1678) * lu(k,1667) - lu(k,1679) = lu(k,1679) * lu(k,1667) - lu(k,1680) = lu(k,1680) * lu(k,1667) - lu(k,1681) = lu(k,1681) * lu(k,1667) - lu(k,1682) = lu(k,1682) * lu(k,1667) - lu(k,1728) = lu(k,1728) - lu(k,1668) * lu(k,1727) - lu(k,1729) = lu(k,1729) - lu(k,1669) * lu(k,1727) - lu(k,1730) = lu(k,1730) - lu(k,1670) * lu(k,1727) - lu(k,1732) = lu(k,1732) - lu(k,1671) * lu(k,1727) - lu(k,1733) = lu(k,1733) - lu(k,1672) * lu(k,1727) - lu(k,1734) = lu(k,1734) - lu(k,1673) * lu(k,1727) - lu(k,1735) = - lu(k,1674) * lu(k,1727) - lu(k,1736) = lu(k,1736) - lu(k,1675) * lu(k,1727) - lu(k,1738) = lu(k,1738) - lu(k,1676) * lu(k,1727) - lu(k,1739) = lu(k,1739) - lu(k,1677) * lu(k,1727) - lu(k,1740) = lu(k,1740) - lu(k,1678) * lu(k,1727) - lu(k,1741) = lu(k,1741) - lu(k,1679) * lu(k,1727) - lu(k,1742) = lu(k,1742) - lu(k,1680) * lu(k,1727) - lu(k,1743) = lu(k,1743) - lu(k,1681) * lu(k,1727) - lu(k,1744) = lu(k,1744) - lu(k,1682) * lu(k,1727) - lu(k,2664) = lu(k,2664) - lu(k,1668) * lu(k,2663) - lu(k,2665) = lu(k,2665) - lu(k,1669) * lu(k,2663) - lu(k,2666) = lu(k,2666) - lu(k,1670) * lu(k,2663) - lu(k,2670) = lu(k,2670) - lu(k,1671) * lu(k,2663) - lu(k,2672) = lu(k,2672) - lu(k,1672) * lu(k,2663) - lu(k,2673) = lu(k,2673) - lu(k,1673) * lu(k,2663) - lu(k,2681) = lu(k,2681) - lu(k,1674) * lu(k,2663) - lu(k,2699) = lu(k,2699) - lu(k,1675) * lu(k,2663) - lu(k,2701) = lu(k,2701) - lu(k,1676) * lu(k,2663) - lu(k,2702) = lu(k,2702) - lu(k,1677) * lu(k,2663) - lu(k,2705) = lu(k,2705) - lu(k,1678) * lu(k,2663) - lu(k,2706) = lu(k,2706) - lu(k,1679) * lu(k,2663) - lu(k,2707) = lu(k,2707) - lu(k,1680) * lu(k,2663) - lu(k,2709) = lu(k,2709) - lu(k,1681) * lu(k,2663) - lu(k,2710) = lu(k,2710) - lu(k,1682) * lu(k,2663) - lu(k,2847) = lu(k,2847) - lu(k,1668) * lu(k,2845) - lu(k,2848) = lu(k,2848) - lu(k,1669) * lu(k,2845) - lu(k,2849) = lu(k,2849) - lu(k,1670) * lu(k,2845) - lu(k,2853) = lu(k,2853) - lu(k,1671) * lu(k,2845) - lu(k,2855) = lu(k,2855) - lu(k,1672) * lu(k,2845) - lu(k,2856) = lu(k,2856) - lu(k,1673) * lu(k,2845) - lu(k,2864) = lu(k,2864) - lu(k,1674) * lu(k,2845) - lu(k,2882) = lu(k,2882) - lu(k,1675) * lu(k,2845) - lu(k,2884) = lu(k,2884) - lu(k,1676) * lu(k,2845) - lu(k,2885) = lu(k,2885) - lu(k,1677) * lu(k,2845) - lu(k,2889) = lu(k,2889) - lu(k,1678) * lu(k,2845) - lu(k,2891) = lu(k,2891) - lu(k,1679) * lu(k,2845) - lu(k,2892) = lu(k,2892) - lu(k,1680) * lu(k,2845) - lu(k,2894) = lu(k,2894) - lu(k,1681) * lu(k,2845) - lu(k,2895) = lu(k,2895) - lu(k,1682) * lu(k,2845) - lu(k,2949) = lu(k,2949) - lu(k,1668) * lu(k,2947) - lu(k,2950) = lu(k,2950) - lu(k,1669) * lu(k,2947) - lu(k,2951) = lu(k,2951) - lu(k,1670) * lu(k,2947) - lu(k,2955) = lu(k,2955) - lu(k,1671) * lu(k,2947) - lu(k,2957) = lu(k,2957) - lu(k,1672) * lu(k,2947) - lu(k,2958) = lu(k,2958) - lu(k,1673) * lu(k,2947) - lu(k,2965) = lu(k,2965) - lu(k,1674) * lu(k,2947) - lu(k,2983) = lu(k,2983) - lu(k,1675) * lu(k,2947) - lu(k,2985) = lu(k,2985) - lu(k,1676) * lu(k,2947) - lu(k,2986) = lu(k,2986) - lu(k,1677) * lu(k,2947) - lu(k,2990) = lu(k,2990) - lu(k,1678) * lu(k,2947) - lu(k,2992) = lu(k,2992) - lu(k,1679) * lu(k,2947) - lu(k,2993) = lu(k,2993) - lu(k,1680) * lu(k,2947) - lu(k,2995) = lu(k,2995) - lu(k,1681) * lu(k,2947) - lu(k,2996) = lu(k,2996) - lu(k,1682) * lu(k,2947) - lu(k,3040) = lu(k,3040) - lu(k,1668) * lu(k,3038) - lu(k,3041) = lu(k,3041) - lu(k,1669) * lu(k,3038) - lu(k,3042) = lu(k,3042) - lu(k,1670) * lu(k,3038) - lu(k,3046) = lu(k,3046) - lu(k,1671) * lu(k,3038) - lu(k,3048) = lu(k,3048) - lu(k,1672) * lu(k,3038) - lu(k,3049) = lu(k,3049) - lu(k,1673) * lu(k,3038) - lu(k,3057) = lu(k,3057) - lu(k,1674) * lu(k,3038) - lu(k,3075) = lu(k,3075) - lu(k,1675) * lu(k,3038) - lu(k,3077) = lu(k,3077) - lu(k,1676) * lu(k,3038) - lu(k,3078) = lu(k,3078) - lu(k,1677) * lu(k,3038) - lu(k,3082) = lu(k,3082) - lu(k,1678) * lu(k,3038) - lu(k,3084) = lu(k,3084) - lu(k,1679) * lu(k,3038) - lu(k,3085) = lu(k,3085) - lu(k,1680) * lu(k,3038) - lu(k,3087) = lu(k,3087) - lu(k,1681) * lu(k,3038) - lu(k,3088) = lu(k,3088) - lu(k,1682) * lu(k,3038) - lu(k,3243) = lu(k,3243) - lu(k,1668) * lu(k,3241) - lu(k,3244) = lu(k,3244) - lu(k,1669) * lu(k,3241) - lu(k,3245) = lu(k,3245) - lu(k,1670) * lu(k,3241) - lu(k,3249) = lu(k,3249) - lu(k,1671) * lu(k,3241) - lu(k,3251) = lu(k,3251) - lu(k,1672) * lu(k,3241) - lu(k,3252) = lu(k,3252) - lu(k,1673) * lu(k,3241) - lu(k,3260) = lu(k,3260) - lu(k,1674) * lu(k,3241) - lu(k,3278) = lu(k,3278) - lu(k,1675) * lu(k,3241) - lu(k,3280) = lu(k,3280) - lu(k,1676) * lu(k,3241) - lu(k,3281) = lu(k,3281) - lu(k,1677) * lu(k,3241) - lu(k,3285) = lu(k,3285) - lu(k,1678) * lu(k,3241) - lu(k,3287) = lu(k,3287) - lu(k,1679) * lu(k,3241) - lu(k,3288) = lu(k,3288) - lu(k,1680) * lu(k,3241) - lu(k,3290) = lu(k,3290) - lu(k,1681) * lu(k,3241) - lu(k,3291) = lu(k,3291) - lu(k,1682) * lu(k,3241) - lu(k,3384) = lu(k,3384) - lu(k,1668) * lu(k,3383) - lu(k,3385) = lu(k,3385) - lu(k,1669) * lu(k,3383) - lu(k,3386) = lu(k,3386) - lu(k,1670) * lu(k,3383) - lu(k,3390) = lu(k,3390) - lu(k,1671) * lu(k,3383) - lu(k,3392) = lu(k,3392) - lu(k,1672) * lu(k,3383) - lu(k,3393) = lu(k,3393) - lu(k,1673) * lu(k,3383) - lu(k,3401) = lu(k,3401) - lu(k,1674) * lu(k,3383) - lu(k,3419) = lu(k,3419) - lu(k,1675) * lu(k,3383) - lu(k,3421) = lu(k,3421) - lu(k,1676) * lu(k,3383) - lu(k,3422) = lu(k,3422) - lu(k,1677) * lu(k,3383) - lu(k,3426) = lu(k,3426) - lu(k,1678) * lu(k,3383) - lu(k,3428) = lu(k,3428) - lu(k,1679) * lu(k,3383) - lu(k,3429) = lu(k,3429) - lu(k,1680) * lu(k,3383) - lu(k,3431) = lu(k,3431) - lu(k,1681) * lu(k,3383) - lu(k,3432) = lu(k,3432) - lu(k,1682) * lu(k,3383) - lu(k,3705) = lu(k,3705) - lu(k,1668) * lu(k,3703) - lu(k,3706) = lu(k,3706) - lu(k,1669) * lu(k,3703) - lu(k,3707) = lu(k,3707) - lu(k,1670) * lu(k,3703) - lu(k,3711) = lu(k,3711) - lu(k,1671) * lu(k,3703) - lu(k,3713) = lu(k,3713) - lu(k,1672) * lu(k,3703) - lu(k,3714) = lu(k,3714) - lu(k,1673) * lu(k,3703) - lu(k,3721) = lu(k,3721) - lu(k,1674) * lu(k,3703) - lu(k,3739) = lu(k,3739) - lu(k,1675) * lu(k,3703) - lu(k,3741) = lu(k,3741) - lu(k,1676) * lu(k,3703) - lu(k,3742) = lu(k,3742) - lu(k,1677) * lu(k,3703) - lu(k,3746) = lu(k,3746) - lu(k,1678) * lu(k,3703) - lu(k,3748) = lu(k,3748) - lu(k,1679) * lu(k,3703) - lu(k,3749) = lu(k,3749) - lu(k,1680) * lu(k,3703) - lu(k,3751) = lu(k,3751) - lu(k,1681) * lu(k,3703) - lu(k,3752) = lu(k,3752) - lu(k,1682) * lu(k,3703) - lu(k,1685) = 1._r8 / lu(k,1685) - lu(k,1686) = lu(k,1686) * lu(k,1685) - lu(k,1687) = lu(k,1687) * lu(k,1685) - lu(k,1688) = lu(k,1688) * lu(k,1685) - lu(k,1689) = lu(k,1689) * lu(k,1685) - lu(k,1690) = lu(k,1690) * lu(k,1685) - lu(k,1691) = lu(k,1691) * lu(k,1685) - lu(k,1692) = lu(k,1692) * lu(k,1685) - lu(k,1693) = lu(k,1693) * lu(k,1685) - lu(k,1694) = lu(k,1694) * lu(k,1685) - lu(k,2884) = lu(k,2884) - lu(k,1686) * lu(k,2846) - lu(k,2886) = lu(k,2886) - lu(k,1687) * lu(k,2846) - lu(k,2888) = - lu(k,1688) * lu(k,2846) - lu(k,2889) = lu(k,2889) - lu(k,1689) * lu(k,2846) - lu(k,2891) = lu(k,2891) - lu(k,1690) * lu(k,2846) - lu(k,2893) = lu(k,2893) - lu(k,1691) * lu(k,2846) - lu(k,2895) = lu(k,2895) - lu(k,1692) * lu(k,2846) - lu(k,2897) = lu(k,2897) - lu(k,1693) * lu(k,2846) - lu(k,2899) = lu(k,2899) - lu(k,1694) * lu(k,2846) - lu(k,2985) = lu(k,2985) - lu(k,1686) * lu(k,2948) - lu(k,2987) = lu(k,2987) - lu(k,1687) * lu(k,2948) - lu(k,2989) = lu(k,2989) - lu(k,1688) * lu(k,2948) - lu(k,2990) = lu(k,2990) - lu(k,1689) * lu(k,2948) - lu(k,2992) = lu(k,2992) - lu(k,1690) * lu(k,2948) - lu(k,2994) = lu(k,2994) - lu(k,1691) * lu(k,2948) - lu(k,2996) = lu(k,2996) - lu(k,1692) * lu(k,2948) - lu(k,2998) = lu(k,2998) - lu(k,1693) * lu(k,2948) - lu(k,3000) = lu(k,3000) - lu(k,1694) * lu(k,2948) - lu(k,3077) = lu(k,3077) - lu(k,1686) * lu(k,3039) - lu(k,3079) = lu(k,3079) - lu(k,1687) * lu(k,3039) - lu(k,3081) = - lu(k,1688) * lu(k,3039) - lu(k,3082) = lu(k,3082) - lu(k,1689) * lu(k,3039) - lu(k,3084) = lu(k,3084) - lu(k,1690) * lu(k,3039) - lu(k,3086) = lu(k,3086) - lu(k,1691) * lu(k,3039) - lu(k,3088) = lu(k,3088) - lu(k,1692) * lu(k,3039) - lu(k,3090) = lu(k,3090) - lu(k,1693) * lu(k,3039) - lu(k,3092) = lu(k,3092) - lu(k,1694) * lu(k,3039) - lu(k,3101) = lu(k,3101) - lu(k,1686) * lu(k,3099) - lu(k,3103) = lu(k,3103) - lu(k,1687) * lu(k,3099) - lu(k,3105) = lu(k,3105) - lu(k,1688) * lu(k,3099) - lu(k,3106) = lu(k,3106) - lu(k,1689) * lu(k,3099) - lu(k,3108) = lu(k,3108) - lu(k,1690) * lu(k,3099) - lu(k,3110) = lu(k,3110) - lu(k,1691) * lu(k,3099) - lu(k,3112) = lu(k,3112) - lu(k,1692) * lu(k,3099) - lu(k,3114) = lu(k,3114) - lu(k,1693) * lu(k,3099) - lu(k,3116) = lu(k,3116) - lu(k,1694) * lu(k,3099) - lu(k,3280) = lu(k,3280) - lu(k,1686) * lu(k,3242) - lu(k,3282) = lu(k,3282) - lu(k,1687) * lu(k,3242) - lu(k,3284) = lu(k,3284) - lu(k,1688) * lu(k,3242) - lu(k,3285) = lu(k,3285) - lu(k,1689) * lu(k,3242) - lu(k,3287) = lu(k,3287) - lu(k,1690) * lu(k,3242) - lu(k,3289) = lu(k,3289) - lu(k,1691) * lu(k,3242) - lu(k,3291) = lu(k,3291) - lu(k,1692) * lu(k,3242) - lu(k,3293) = lu(k,3293) - lu(k,1693) * lu(k,3242) - lu(k,3295) = lu(k,3295) - lu(k,1694) * lu(k,3242) - lu(k,3306) = lu(k,3306) - lu(k,1686) * lu(k,3304) - lu(k,3308) = lu(k,3308) - lu(k,1687) * lu(k,3304) - lu(k,3310) = - lu(k,1688) * lu(k,3304) - lu(k,3311) = lu(k,3311) - lu(k,1689) * lu(k,3304) - lu(k,3313) = lu(k,3313) - lu(k,1690) * lu(k,3304) - lu(k,3315) = lu(k,3315) - lu(k,1691) * lu(k,3304) - lu(k,3317) = lu(k,3317) - lu(k,1692) * lu(k,3304) - lu(k,3319) = lu(k,3319) - lu(k,1693) * lu(k,3304) - lu(k,3321) = lu(k,3321) - lu(k,1694) * lu(k,3304) - lu(k,3330) = lu(k,3330) - lu(k,1686) * lu(k,3328) - lu(k,3332) = - lu(k,1687) * lu(k,3328) - lu(k,3334) = lu(k,3334) - lu(k,1688) * lu(k,3328) - lu(k,3335) = lu(k,3335) - lu(k,1689) * lu(k,3328) - lu(k,3337) = lu(k,3337) - lu(k,1690) * lu(k,3328) - lu(k,3339) = lu(k,3339) - lu(k,1691) * lu(k,3328) - lu(k,3341) = lu(k,3341) - lu(k,1692) * lu(k,3328) - lu(k,3343) = lu(k,3343) - lu(k,1693) * lu(k,3328) - lu(k,3345) = lu(k,3345) - lu(k,1694) * lu(k,3328) - lu(k,3451) = lu(k,3451) - lu(k,1686) * lu(k,3449) - lu(k,3453) = lu(k,3453) - lu(k,1687) * lu(k,3449) - lu(k,3455) = lu(k,3455) - lu(k,1688) * lu(k,3449) - lu(k,3456) = lu(k,3456) - lu(k,1689) * lu(k,3449) - lu(k,3458) = lu(k,3458) - lu(k,1690) * lu(k,3449) - lu(k,3460) = lu(k,3460) - lu(k,1691) * lu(k,3449) - lu(k,3462) = lu(k,3462) - lu(k,1692) * lu(k,3449) - lu(k,3464) = lu(k,3464) - lu(k,1693) * lu(k,3449) - lu(k,3466) = lu(k,3466) - lu(k,1694) * lu(k,3449) - lu(k,3501) = lu(k,3501) - lu(k,1686) * lu(k,3492) - lu(k,3503) = lu(k,3503) - lu(k,1687) * lu(k,3492) - lu(k,3505) = - lu(k,1688) * lu(k,3492) - lu(k,3506) = lu(k,3506) - lu(k,1689) * lu(k,3492) - lu(k,3508) = lu(k,3508) - lu(k,1690) * lu(k,3492) - lu(k,3510) = lu(k,3510) - lu(k,1691) * lu(k,3492) - lu(k,3512) = lu(k,3512) - lu(k,1692) * lu(k,3492) - lu(k,3514) = lu(k,3514) - lu(k,1693) * lu(k,3492) - lu(k,3516) = lu(k,3516) - lu(k,1694) * lu(k,3492) - lu(k,3741) = lu(k,3741) - lu(k,1686) * lu(k,3704) - lu(k,3743) = lu(k,3743) - lu(k,1687) * lu(k,3704) - lu(k,3745) = lu(k,3745) - lu(k,1688) * lu(k,3704) - lu(k,3746) = lu(k,3746) - lu(k,1689) * lu(k,3704) - lu(k,3748) = lu(k,3748) - lu(k,1690) * lu(k,3704) - lu(k,3750) = lu(k,3750) - lu(k,1691) * lu(k,3704) - lu(k,3752) = lu(k,3752) - lu(k,1692) * lu(k,3704) - lu(k,3754) = lu(k,3754) - lu(k,1693) * lu(k,3704) - lu(k,3756) = lu(k,3756) - lu(k,1694) * lu(k,3704) - lu(k,3764) = lu(k,3764) - lu(k,1686) * lu(k,3762) - lu(k,3765) = - lu(k,1687) * lu(k,3762) - lu(k,3767) = lu(k,3767) - lu(k,1688) * lu(k,3762) - lu(k,3768) = - lu(k,1689) * lu(k,3762) - lu(k,3770) = - lu(k,1690) * lu(k,3762) - lu(k,3772) = lu(k,3772) - lu(k,1691) * lu(k,3762) - lu(k,3774) = lu(k,3774) - lu(k,1692) * lu(k,3762) - lu(k,3776) = lu(k,3776) - lu(k,1693) * lu(k,3762) - lu(k,3778) = lu(k,3778) - lu(k,1694) * lu(k,3762) - lu(k,3787) = lu(k,3787) - lu(k,1686) * lu(k,3785) - lu(k,3789) = lu(k,3789) - lu(k,1687) * lu(k,3785) - lu(k,3791) = - lu(k,1688) * lu(k,3785) - lu(k,3792) = lu(k,3792) - lu(k,1689) * lu(k,3785) - lu(k,3794) = - lu(k,1690) * lu(k,3785) - lu(k,3796) = lu(k,3796) - lu(k,1691) * lu(k,3785) - lu(k,3798) = lu(k,3798) - lu(k,1692) * lu(k,3785) - lu(k,3800) = lu(k,3800) - lu(k,1693) * lu(k,3785) - lu(k,3802) = lu(k,3802) - lu(k,1694) * lu(k,3785) - lu(k,3822) = lu(k,3822) - lu(k,1686) * lu(k,3819) - lu(k,3824) = lu(k,3824) - lu(k,1687) * lu(k,3819) - lu(k,3826) = lu(k,3826) - lu(k,1688) * lu(k,3819) - lu(k,3827) = lu(k,3827) - lu(k,1689) * lu(k,3819) - lu(k,3829) = lu(k,3829) - lu(k,1690) * lu(k,3819) - lu(k,3831) = lu(k,3831) - lu(k,1691) * lu(k,3819) - lu(k,3833) = lu(k,3833) - lu(k,1692) * lu(k,3819) - lu(k,3835) = - lu(k,1693) * lu(k,3819) - lu(k,3837) = lu(k,3837) - lu(k,1694) * lu(k,3819) - lu(k,3847) = lu(k,3847) - lu(k,1686) * lu(k,3845) - lu(k,3849) = lu(k,3849) - lu(k,1687) * lu(k,3845) - lu(k,3851) = lu(k,3851) - lu(k,1688) * lu(k,3845) - lu(k,3852) = lu(k,3852) - lu(k,1689) * lu(k,3845) - lu(k,3854) = - lu(k,1690) * lu(k,3845) - lu(k,3856) = lu(k,3856) - lu(k,1691) * lu(k,3845) - lu(k,3858) = lu(k,3858) - lu(k,1692) * lu(k,3845) - lu(k,3860) = lu(k,3860) - lu(k,1693) * lu(k,3845) - lu(k,3862) = lu(k,3862) - lu(k,1694) * lu(k,3845) + lu(k,1671) = 1._r8 / lu(k,1671) + lu(k,1672) = lu(k,1672) * lu(k,1671) + lu(k,1673) = lu(k,1673) * lu(k,1671) + lu(k,1674) = lu(k,1674) * lu(k,1671) + lu(k,1675) = lu(k,1675) * lu(k,1671) + lu(k,1676) = lu(k,1676) * lu(k,1671) + lu(k,1677) = lu(k,1677) * lu(k,1671) + lu(k,1678) = lu(k,1678) * lu(k,1671) + lu(k,1679) = lu(k,1679) * lu(k,1671) + lu(k,1680) = lu(k,1680) * lu(k,1671) + lu(k,1681) = lu(k,1681) * lu(k,1671) + lu(k,1682) = lu(k,1682) * lu(k,1671) + lu(k,2259) = lu(k,2259) - lu(k,1672) * lu(k,2257) + lu(k,2260) = lu(k,2260) - lu(k,1673) * lu(k,2257) + lu(k,2261) = lu(k,2261) - lu(k,1674) * lu(k,2257) + lu(k,2262) = lu(k,2262) - lu(k,1675) * lu(k,2257) + lu(k,2263) = lu(k,2263) - lu(k,1676) * lu(k,2257) + lu(k,2265) = lu(k,2265) - lu(k,1677) * lu(k,2257) + lu(k,2267) = lu(k,2267) - lu(k,1678) * lu(k,2257) + lu(k,2268) = lu(k,2268) - lu(k,1679) * lu(k,2257) + lu(k,2269) = lu(k,2269) - lu(k,1680) * lu(k,2257) + lu(k,2270) = lu(k,2270) - lu(k,1681) * lu(k,2257) + lu(k,2271) = lu(k,2271) - lu(k,1682) * lu(k,2257) + lu(k,2572) = - lu(k,1672) * lu(k,2571) + lu(k,2573) = lu(k,2573) - lu(k,1673) * lu(k,2571) + lu(k,2574) = - lu(k,1674) * lu(k,2571) + lu(k,2576) = - lu(k,1675) * lu(k,2571) + lu(k,2577) = - lu(k,1676) * lu(k,2571) + lu(k,2579) = lu(k,2579) - lu(k,1677) * lu(k,2571) + lu(k,2581) = lu(k,2581) - lu(k,1678) * lu(k,2571) + lu(k,2582) = - lu(k,1679) * lu(k,2571) + lu(k,2583) = - lu(k,1680) * lu(k,2571) + lu(k,2584) = - lu(k,1681) * lu(k,2571) + lu(k,2585) = lu(k,2585) - lu(k,1682) * lu(k,2571) + lu(k,2635) = lu(k,2635) - lu(k,1672) * lu(k,2633) + lu(k,2637) = lu(k,2637) - lu(k,1673) * lu(k,2633) + lu(k,2639) = lu(k,2639) - lu(k,1674) * lu(k,2633) + lu(k,2641) = lu(k,2641) - lu(k,1675) * lu(k,2633) + lu(k,2643) = lu(k,2643) - lu(k,1676) * lu(k,2633) + lu(k,2645) = lu(k,2645) - lu(k,1677) * lu(k,2633) + lu(k,2647) = lu(k,2647) - lu(k,1678) * lu(k,2633) + lu(k,2648) = lu(k,2648) - lu(k,1679) * lu(k,2633) + lu(k,2649) = lu(k,2649) - lu(k,1680) * lu(k,2633) + lu(k,2650) = lu(k,2650) - lu(k,1681) * lu(k,2633) + lu(k,2652) = lu(k,2652) - lu(k,1682) * lu(k,2633) + lu(k,3325) = lu(k,3325) - lu(k,1672) * lu(k,3324) + lu(k,3326) = lu(k,3326) - lu(k,1673) * lu(k,3324) + lu(k,3327) = - lu(k,1674) * lu(k,3324) + lu(k,3329) = - lu(k,1675) * lu(k,3324) + lu(k,3331) = lu(k,3331) - lu(k,1676) * lu(k,3324) + lu(k,3333) = - lu(k,1677) * lu(k,3324) + lu(k,3335) = lu(k,3335) - lu(k,1678) * lu(k,3324) + lu(k,3336) = - lu(k,1679) * lu(k,3324) + lu(k,3337) = lu(k,3337) - lu(k,1680) * lu(k,3324) + lu(k,3338) = lu(k,3338) - lu(k,1681) * lu(k,3324) + lu(k,3340) = lu(k,3340) - lu(k,1682) * lu(k,3324) + lu(k,3349) = - lu(k,1672) * lu(k,3346) + lu(k,3351) = lu(k,3351) - lu(k,1673) * lu(k,3346) + lu(k,3353) = lu(k,3353) - lu(k,1674) * lu(k,3346) + lu(k,3355) = lu(k,3355) - lu(k,1675) * lu(k,3346) + lu(k,3357) = lu(k,3357) - lu(k,1676) * lu(k,3346) + lu(k,3359) = lu(k,3359) - lu(k,1677) * lu(k,3346) + lu(k,3361) = lu(k,3361) - lu(k,1678) * lu(k,3346) + lu(k,3362) = lu(k,3362) - lu(k,1679) * lu(k,3346) + lu(k,3363) = lu(k,3363) - lu(k,1680) * lu(k,3346) + lu(k,3364) = - lu(k,1681) * lu(k,3346) + lu(k,3366) = lu(k,3366) - lu(k,1682) * lu(k,3346) + lu(k,3380) = - lu(k,1672) * lu(k,3377) + lu(k,3382) = lu(k,3382) - lu(k,1673) * lu(k,3377) + lu(k,3384) = lu(k,3384) - lu(k,1674) * lu(k,3377) + lu(k,3386) = lu(k,3386) - lu(k,1675) * lu(k,3377) + lu(k,3388) = lu(k,3388) - lu(k,1676) * lu(k,3377) + lu(k,3390) = lu(k,3390) - lu(k,1677) * lu(k,3377) + lu(k,3392) = lu(k,3392) - lu(k,1678) * lu(k,3377) + lu(k,3393) = lu(k,3393) - lu(k,1679) * lu(k,3377) + lu(k,3394) = lu(k,3394) - lu(k,1680) * lu(k,3377) + lu(k,3395) = - lu(k,1681) * lu(k,3377) + lu(k,3397) = lu(k,3397) - lu(k,1682) * lu(k,3377) + lu(k,3539) = - lu(k,1672) * lu(k,3511) + lu(k,3552) = lu(k,3552) - lu(k,1673) * lu(k,3511) + lu(k,3554) = lu(k,3554) - lu(k,1674) * lu(k,3511) + lu(k,3566) = lu(k,3566) - lu(k,1675) * lu(k,3511) + lu(k,3568) = lu(k,3568) - lu(k,1676) * lu(k,3511) + lu(k,3570) = lu(k,3570) - lu(k,1677) * lu(k,3511) + lu(k,3572) = lu(k,3572) - lu(k,1678) * lu(k,3511) + lu(k,3573) = lu(k,3573) - lu(k,1679) * lu(k,3511) + lu(k,3574) = lu(k,3574) - lu(k,1680) * lu(k,3511) + lu(k,3575) = lu(k,3575) - lu(k,1681) * lu(k,3511) + lu(k,3577) = lu(k,3577) - lu(k,1682) * lu(k,3511) + lu(k,3789) = lu(k,3789) - lu(k,1672) * lu(k,3762) + lu(k,3802) = lu(k,3802) - lu(k,1673) * lu(k,3762) + lu(k,3804) = lu(k,3804) - lu(k,1674) * lu(k,3762) + lu(k,3816) = lu(k,3816) - lu(k,1675) * lu(k,3762) + lu(k,3818) = lu(k,3818) - lu(k,1676) * lu(k,3762) + lu(k,3820) = lu(k,3820) - lu(k,1677) * lu(k,3762) + lu(k,3822) = lu(k,3822) - lu(k,1678) * lu(k,3762) + lu(k,3823) = lu(k,3823) - lu(k,1679) * lu(k,3762) + lu(k,3824) = lu(k,3824) - lu(k,1680) * lu(k,3762) + lu(k,3825) = lu(k,3825) - lu(k,1681) * lu(k,3762) + lu(k,3827) = lu(k,3827) - lu(k,1682) * lu(k,3762) + lu(k,3850) = lu(k,3850) - lu(k,1672) * lu(k,3846) + lu(k,3852) = lu(k,3852) - lu(k,1673) * lu(k,3846) + lu(k,3854) = lu(k,3854) - lu(k,1674) * lu(k,3846) + lu(k,3857) = lu(k,3857) - lu(k,1675) * lu(k,3846) + lu(k,3859) = lu(k,3859) - lu(k,1676) * lu(k,3846) + lu(k,3861) = lu(k,3861) - lu(k,1677) * lu(k,3846) + lu(k,3863) = lu(k,3863) - lu(k,1678) * lu(k,3846) + lu(k,3864) = lu(k,3864) - lu(k,1679) * lu(k,3846) + lu(k,3865) = lu(k,3865) - lu(k,1680) * lu(k,3846) + lu(k,3866) = lu(k,3866) - lu(k,1681) * lu(k,3846) + lu(k,3868) = lu(k,3868) - lu(k,1682) * lu(k,3846) + lu(k,4115) = lu(k,4115) - lu(k,1672) * lu(k,4113) + lu(k,4117) = lu(k,4117) - lu(k,1673) * lu(k,4113) + lu(k,4119) = lu(k,4119) - lu(k,1674) * lu(k,4113) + lu(k,4121) = - lu(k,1675) * lu(k,4113) + lu(k,4123) = lu(k,4123) - lu(k,1676) * lu(k,4113) + lu(k,4125) = lu(k,4125) - lu(k,1677) * lu(k,4113) + lu(k,4127) = lu(k,4127) - lu(k,1678) * lu(k,4113) + lu(k,4128) = lu(k,4128) - lu(k,1679) * lu(k,4113) + lu(k,4129) = lu(k,4129) - lu(k,1680) * lu(k,4113) + lu(k,4130) = lu(k,4130) - lu(k,1681) * lu(k,4113) + lu(k,4132) = lu(k,4132) - lu(k,1682) * lu(k,4113) + lu(k,1687) = 1._r8 / lu(k,1687) + lu(k,1688) = lu(k,1688) * lu(k,1687) + lu(k,1689) = lu(k,1689) * lu(k,1687) + lu(k,1690) = lu(k,1690) * lu(k,1687) + lu(k,1691) = lu(k,1691) * lu(k,1687) + lu(k,1692) = lu(k,1692) * lu(k,1687) + lu(k,1693) = lu(k,1693) * lu(k,1687) + lu(k,1694) = lu(k,1694) * lu(k,1687) + lu(k,2350) = - lu(k,1688) * lu(k,2346) + lu(k,2352) = lu(k,2352) - lu(k,1689) * lu(k,2346) + lu(k,2355) = lu(k,2355) - lu(k,1690) * lu(k,2346) + lu(k,2356) = - lu(k,1691) * lu(k,2346) + lu(k,2359) = lu(k,2359) - lu(k,1692) * lu(k,2346) + lu(k,2360) = lu(k,2360) - lu(k,1693) * lu(k,2346) + lu(k,2363) = lu(k,2363) - lu(k,1694) * lu(k,2346) + lu(k,2380) = - lu(k,1688) * lu(k,2377) + lu(k,2383) = lu(k,2383) - lu(k,1689) * lu(k,2377) + lu(k,2391) = lu(k,2391) - lu(k,1690) * lu(k,2377) + lu(k,2392) = - lu(k,1691) * lu(k,2377) + lu(k,2395) = lu(k,2395) - lu(k,1692) * lu(k,2377) + lu(k,2396) = lu(k,2396) - lu(k,1693) * lu(k,2377) + lu(k,2399) = lu(k,2399) - lu(k,1694) * lu(k,2377) + lu(k,2410) = lu(k,2410) - lu(k,1688) * lu(k,2405) + lu(k,2413) = lu(k,2413) - lu(k,1689) * lu(k,2405) + lu(k,2421) = lu(k,2421) - lu(k,1690) * lu(k,2405) + lu(k,2422) = lu(k,2422) - lu(k,1691) * lu(k,2405) + lu(k,2425) = lu(k,2425) - lu(k,1692) * lu(k,2405) + lu(k,2426) = lu(k,2426) - lu(k,1693) * lu(k,2405) + lu(k,2429) = lu(k,2429) - lu(k,1694) * lu(k,2405) + lu(k,2464) = lu(k,2464) - lu(k,1688) * lu(k,2459) + lu(k,2467) = lu(k,2467) - lu(k,1689) * lu(k,2459) + lu(k,2475) = lu(k,2475) - lu(k,1690) * lu(k,2459) + lu(k,2476) = lu(k,2476) - lu(k,1691) * lu(k,2459) + lu(k,2479) = lu(k,2479) - lu(k,1692) * lu(k,2459) + lu(k,2480) = lu(k,2480) - lu(k,1693) * lu(k,2459) + lu(k,2483) = lu(k,2483) - lu(k,1694) * lu(k,2459) + lu(k,2498) = lu(k,2498) - lu(k,1688) * lu(k,2495) + lu(k,2501) = lu(k,2501) - lu(k,1689) * lu(k,2495) + lu(k,2509) = lu(k,2509) - lu(k,1690) * lu(k,2495) + lu(k,2510) = lu(k,2510) - lu(k,1691) * lu(k,2495) + lu(k,2513) = lu(k,2513) - lu(k,1692) * lu(k,2495) + lu(k,2514) = lu(k,2514) - lu(k,1693) * lu(k,2495) + lu(k,2517) = lu(k,2517) - lu(k,1694) * lu(k,2495) + lu(k,2696) = lu(k,2696) - lu(k,1688) * lu(k,2691) + lu(k,2699) = lu(k,2699) - lu(k,1689) * lu(k,2691) + lu(k,2710) = lu(k,2710) - lu(k,1690) * lu(k,2691) + lu(k,2711) = lu(k,2711) - lu(k,1691) * lu(k,2691) + lu(k,2714) = lu(k,2714) - lu(k,1692) * lu(k,2691) + lu(k,2715) = lu(k,2715) - lu(k,1693) * lu(k,2691) + lu(k,2719) = lu(k,2719) - lu(k,1694) * lu(k,2691) + lu(k,2800) = lu(k,2800) - lu(k,1688) * lu(k,2795) + lu(k,2802) = - lu(k,1689) * lu(k,2795) + lu(k,2813) = lu(k,2813) - lu(k,1690) * lu(k,2795) + lu(k,2814) = - lu(k,1691) * lu(k,2795) + lu(k,2817) = lu(k,2817) - lu(k,1692) * lu(k,2795) + lu(k,2818) = lu(k,2818) - lu(k,1693) * lu(k,2795) + lu(k,2822) = lu(k,2822) - lu(k,1694) * lu(k,2795) + lu(k,2840) = lu(k,2840) - lu(k,1688) * lu(k,2830) + lu(k,2847) = lu(k,2847) - lu(k,1689) * lu(k,2830) + lu(k,2859) = lu(k,2859) - lu(k,1690) * lu(k,2830) + lu(k,2860) = lu(k,2860) - lu(k,1691) * lu(k,2830) + lu(k,2863) = lu(k,2863) - lu(k,1692) * lu(k,2830) + lu(k,2864) = lu(k,2864) - lu(k,1693) * lu(k,2830) + lu(k,2868) = lu(k,2868) - lu(k,1694) * lu(k,2830) + lu(k,2887) = lu(k,2887) - lu(k,1688) * lu(k,2877) + lu(k,2894) = lu(k,2894) - lu(k,1689) * lu(k,2877) + lu(k,2906) = lu(k,2906) - lu(k,1690) * lu(k,2877) + lu(k,2907) = lu(k,2907) - lu(k,1691) * lu(k,2877) + lu(k,2910) = lu(k,2910) - lu(k,1692) * lu(k,2877) + lu(k,2911) = lu(k,2911) - lu(k,1693) * lu(k,2877) + lu(k,2915) = lu(k,2915) - lu(k,1694) * lu(k,2877) + lu(k,2933) = lu(k,2933) - lu(k,1688) * lu(k,2923) + lu(k,2940) = lu(k,2940) - lu(k,1689) * lu(k,2923) + lu(k,2952) = lu(k,2952) - lu(k,1690) * lu(k,2923) + lu(k,2953) = lu(k,2953) - lu(k,1691) * lu(k,2923) + lu(k,2956) = lu(k,2956) - lu(k,1692) * lu(k,2923) + lu(k,2957) = lu(k,2957) - lu(k,1693) * lu(k,2923) + lu(k,2961) = lu(k,2961) - lu(k,1694) * lu(k,2923) + lu(k,3005) = lu(k,3005) - lu(k,1688) * lu(k,2975) + lu(k,3014) = lu(k,3014) - lu(k,1689) * lu(k,2975) + lu(k,3026) = lu(k,3026) - lu(k,1690) * lu(k,2975) + lu(k,3027) = lu(k,3027) - lu(k,1691) * lu(k,2975) + lu(k,3030) = lu(k,3030) - lu(k,1692) * lu(k,2975) + lu(k,3031) = lu(k,3031) - lu(k,1693) * lu(k,2975) + lu(k,3035) = lu(k,3035) - lu(k,1694) * lu(k,2975) + lu(k,3288) = lu(k,3288) - lu(k,1688) * lu(k,3256) + lu(k,3299) = lu(k,3299) - lu(k,1689) * lu(k,3256) + lu(k,3311) = lu(k,3311) - lu(k,1690) * lu(k,3256) + lu(k,3312) = lu(k,3312) - lu(k,1691) * lu(k,3256) + lu(k,3315) = lu(k,3315) - lu(k,1692) * lu(k,3256) + lu(k,3316) = lu(k,3316) - lu(k,1693) * lu(k,3256) + lu(k,3320) = lu(k,3320) - lu(k,1694) * lu(k,3256) + lu(k,3544) = lu(k,3544) - lu(k,1688) * lu(k,3512) + lu(k,3555) = lu(k,3555) - lu(k,1689) * lu(k,3512) + lu(k,3567) = lu(k,3567) - lu(k,1690) * lu(k,3512) + lu(k,3568) = lu(k,3568) - lu(k,1691) * lu(k,3512) + lu(k,3571) = lu(k,3571) - lu(k,1692) * lu(k,3512) + lu(k,3572) = lu(k,3572) - lu(k,1693) * lu(k,3512) + lu(k,3576) = lu(k,3576) - lu(k,1694) * lu(k,3512) + lu(k,3794) = lu(k,3794) - lu(k,1688) * lu(k,3763) + lu(k,3805) = lu(k,3805) - lu(k,1689) * lu(k,3763) + lu(k,3817) = lu(k,3817) - lu(k,1690) * lu(k,3763) + lu(k,3818) = lu(k,3818) - lu(k,1691) * lu(k,3763) + lu(k,3821) = lu(k,3821) - lu(k,1692) * lu(k,3763) + lu(k,3822) = lu(k,3822) - lu(k,1693) * lu(k,3763) + lu(k,3826) = lu(k,3826) - lu(k,1694) * lu(k,3763) + lu(k,3929) = lu(k,3929) - lu(k,1688) * lu(k,3899) + lu(k,3940) = lu(k,3940) - lu(k,1689) * lu(k,3899) + lu(k,3952) = lu(k,3952) - lu(k,1690) * lu(k,3899) + lu(k,3953) = lu(k,3953) - lu(k,1691) * lu(k,3899) + lu(k,3956) = lu(k,3956) - lu(k,1692) * lu(k,3899) + lu(k,3957) = lu(k,3957) - lu(k,1693) * lu(k,3899) + lu(k,3961) = lu(k,3961) - lu(k,1694) * lu(k,3899) + lu(k,4022) = lu(k,4022) - lu(k,1688) * lu(k,3991) + lu(k,4032) = lu(k,4032) - lu(k,1689) * lu(k,3991) + lu(k,4044) = lu(k,4044) - lu(k,1690) * lu(k,3991) + lu(k,4045) = lu(k,4045) - lu(k,1691) * lu(k,3991) + lu(k,4048) = lu(k,4048) - lu(k,1692) * lu(k,3991) + lu(k,4049) = lu(k,4049) - lu(k,1693) * lu(k,3991) + lu(k,4053) = lu(k,4053) - lu(k,1694) * lu(k,3991) + lu(k,1700) = 1._r8 / lu(k,1700) + lu(k,1701) = lu(k,1701) * lu(k,1700) + lu(k,1702) = lu(k,1702) * lu(k,1700) + lu(k,1703) = lu(k,1703) * lu(k,1700) + lu(k,1704) = lu(k,1704) * lu(k,1700) + lu(k,1705) = lu(k,1705) * lu(k,1700) + lu(k,1706) = lu(k,1706) * lu(k,1700) + lu(k,1707) = lu(k,1707) * lu(k,1700) + lu(k,2350) = lu(k,2350) - lu(k,1701) * lu(k,2347) + lu(k,2352) = lu(k,2352) - lu(k,1702) * lu(k,2347) + lu(k,2355) = lu(k,2355) - lu(k,1703) * lu(k,2347) + lu(k,2356) = lu(k,2356) - lu(k,1704) * lu(k,2347) + lu(k,2359) = lu(k,2359) - lu(k,1705) * lu(k,2347) + lu(k,2360) = lu(k,2360) - lu(k,1706) * lu(k,2347) + lu(k,2363) = lu(k,2363) - lu(k,1707) * lu(k,2347) + lu(k,2380) = lu(k,2380) - lu(k,1701) * lu(k,2378) + lu(k,2383) = lu(k,2383) - lu(k,1702) * lu(k,2378) + lu(k,2391) = lu(k,2391) - lu(k,1703) * lu(k,2378) + lu(k,2392) = lu(k,2392) - lu(k,1704) * lu(k,2378) + lu(k,2395) = lu(k,2395) - lu(k,1705) * lu(k,2378) + lu(k,2396) = lu(k,2396) - lu(k,1706) * lu(k,2378) + lu(k,2399) = lu(k,2399) - lu(k,1707) * lu(k,2378) + lu(k,2410) = lu(k,2410) - lu(k,1701) * lu(k,2406) + lu(k,2413) = lu(k,2413) - lu(k,1702) * lu(k,2406) + lu(k,2421) = lu(k,2421) - lu(k,1703) * lu(k,2406) + lu(k,2422) = lu(k,2422) - lu(k,1704) * lu(k,2406) + lu(k,2425) = lu(k,2425) - lu(k,1705) * lu(k,2406) + lu(k,2426) = lu(k,2426) - lu(k,1706) * lu(k,2406) + lu(k,2429) = lu(k,2429) - lu(k,1707) * lu(k,2406) + lu(k,2464) = lu(k,2464) - lu(k,1701) * lu(k,2460) + lu(k,2467) = lu(k,2467) - lu(k,1702) * lu(k,2460) + lu(k,2475) = lu(k,2475) - lu(k,1703) * lu(k,2460) + lu(k,2476) = lu(k,2476) - lu(k,1704) * lu(k,2460) + lu(k,2479) = lu(k,2479) - lu(k,1705) * lu(k,2460) + lu(k,2480) = lu(k,2480) - lu(k,1706) * lu(k,2460) + lu(k,2483) = lu(k,2483) - lu(k,1707) * lu(k,2460) + lu(k,2498) = lu(k,2498) - lu(k,1701) * lu(k,2496) + lu(k,2501) = lu(k,2501) - lu(k,1702) * lu(k,2496) + lu(k,2509) = lu(k,2509) - lu(k,1703) * lu(k,2496) + lu(k,2510) = lu(k,2510) - lu(k,1704) * lu(k,2496) + lu(k,2513) = lu(k,2513) - lu(k,1705) * lu(k,2496) + lu(k,2514) = lu(k,2514) - lu(k,1706) * lu(k,2496) + lu(k,2517) = lu(k,2517) - lu(k,1707) * lu(k,2496) + lu(k,2696) = lu(k,2696) - lu(k,1701) * lu(k,2692) + lu(k,2699) = lu(k,2699) - lu(k,1702) * lu(k,2692) + lu(k,2710) = lu(k,2710) - lu(k,1703) * lu(k,2692) + lu(k,2711) = lu(k,2711) - lu(k,1704) * lu(k,2692) + lu(k,2714) = lu(k,2714) - lu(k,1705) * lu(k,2692) + lu(k,2715) = lu(k,2715) - lu(k,1706) * lu(k,2692) + lu(k,2719) = lu(k,2719) - lu(k,1707) * lu(k,2692) + lu(k,2800) = lu(k,2800) - lu(k,1701) * lu(k,2796) + lu(k,2802) = lu(k,2802) - lu(k,1702) * lu(k,2796) + lu(k,2813) = lu(k,2813) - lu(k,1703) * lu(k,2796) + lu(k,2814) = lu(k,2814) - lu(k,1704) * lu(k,2796) + lu(k,2817) = lu(k,2817) - lu(k,1705) * lu(k,2796) + lu(k,2818) = lu(k,2818) - lu(k,1706) * lu(k,2796) + lu(k,2822) = lu(k,2822) - lu(k,1707) * lu(k,2796) + lu(k,2840) = lu(k,2840) - lu(k,1701) * lu(k,2831) + lu(k,2847) = lu(k,2847) - lu(k,1702) * lu(k,2831) + lu(k,2859) = lu(k,2859) - lu(k,1703) * lu(k,2831) + lu(k,2860) = lu(k,2860) - lu(k,1704) * lu(k,2831) + lu(k,2863) = lu(k,2863) - lu(k,1705) * lu(k,2831) + lu(k,2864) = lu(k,2864) - lu(k,1706) * lu(k,2831) + lu(k,2868) = lu(k,2868) - lu(k,1707) * lu(k,2831) + lu(k,2887) = lu(k,2887) - lu(k,1701) * lu(k,2878) + lu(k,2894) = lu(k,2894) - lu(k,1702) * lu(k,2878) + lu(k,2906) = lu(k,2906) - lu(k,1703) * lu(k,2878) + lu(k,2907) = lu(k,2907) - lu(k,1704) * lu(k,2878) + lu(k,2910) = lu(k,2910) - lu(k,1705) * lu(k,2878) + lu(k,2911) = lu(k,2911) - lu(k,1706) * lu(k,2878) + lu(k,2915) = lu(k,2915) - lu(k,1707) * lu(k,2878) + lu(k,2933) = lu(k,2933) - lu(k,1701) * lu(k,2924) + lu(k,2940) = lu(k,2940) - lu(k,1702) * lu(k,2924) + lu(k,2952) = lu(k,2952) - lu(k,1703) * lu(k,2924) + lu(k,2953) = lu(k,2953) - lu(k,1704) * lu(k,2924) + lu(k,2956) = lu(k,2956) - lu(k,1705) * lu(k,2924) + lu(k,2957) = lu(k,2957) - lu(k,1706) * lu(k,2924) + lu(k,2961) = lu(k,2961) - lu(k,1707) * lu(k,2924) + lu(k,3005) = lu(k,3005) - lu(k,1701) * lu(k,2976) + lu(k,3014) = lu(k,3014) - lu(k,1702) * lu(k,2976) + lu(k,3026) = lu(k,3026) - lu(k,1703) * lu(k,2976) + lu(k,3027) = lu(k,3027) - lu(k,1704) * lu(k,2976) + lu(k,3030) = lu(k,3030) - lu(k,1705) * lu(k,2976) + lu(k,3031) = lu(k,3031) - lu(k,1706) * lu(k,2976) + lu(k,3035) = lu(k,3035) - lu(k,1707) * lu(k,2976) + lu(k,3288) = lu(k,3288) - lu(k,1701) * lu(k,3257) + lu(k,3299) = lu(k,3299) - lu(k,1702) * lu(k,3257) + lu(k,3311) = lu(k,3311) - lu(k,1703) * lu(k,3257) + lu(k,3312) = lu(k,3312) - lu(k,1704) * lu(k,3257) + lu(k,3315) = lu(k,3315) - lu(k,1705) * lu(k,3257) + lu(k,3316) = lu(k,3316) - lu(k,1706) * lu(k,3257) + lu(k,3320) = lu(k,3320) - lu(k,1707) * lu(k,3257) + lu(k,3544) = lu(k,3544) - lu(k,1701) * lu(k,3513) + lu(k,3555) = lu(k,3555) - lu(k,1702) * lu(k,3513) + lu(k,3567) = lu(k,3567) - lu(k,1703) * lu(k,3513) + lu(k,3568) = lu(k,3568) - lu(k,1704) * lu(k,3513) + lu(k,3571) = lu(k,3571) - lu(k,1705) * lu(k,3513) + lu(k,3572) = lu(k,3572) - lu(k,1706) * lu(k,3513) + lu(k,3576) = lu(k,3576) - lu(k,1707) * lu(k,3513) + lu(k,3794) = lu(k,3794) - lu(k,1701) * lu(k,3764) + lu(k,3805) = lu(k,3805) - lu(k,1702) * lu(k,3764) + lu(k,3817) = lu(k,3817) - lu(k,1703) * lu(k,3764) + lu(k,3818) = lu(k,3818) - lu(k,1704) * lu(k,3764) + lu(k,3821) = lu(k,3821) - lu(k,1705) * lu(k,3764) + lu(k,3822) = lu(k,3822) - lu(k,1706) * lu(k,3764) + lu(k,3826) = lu(k,3826) - lu(k,1707) * lu(k,3764) + lu(k,3929) = lu(k,3929) - lu(k,1701) * lu(k,3900) + lu(k,3940) = lu(k,3940) - lu(k,1702) * lu(k,3900) + lu(k,3952) = lu(k,3952) - lu(k,1703) * lu(k,3900) + lu(k,3953) = lu(k,3953) - lu(k,1704) * lu(k,3900) + lu(k,3956) = lu(k,3956) - lu(k,1705) * lu(k,3900) + lu(k,3957) = lu(k,3957) - lu(k,1706) * lu(k,3900) + lu(k,3961) = lu(k,3961) - lu(k,1707) * lu(k,3900) + lu(k,4022) = lu(k,4022) - lu(k,1701) * lu(k,3992) + lu(k,4032) = lu(k,4032) - lu(k,1702) * lu(k,3992) + lu(k,4044) = lu(k,4044) - lu(k,1703) * lu(k,3992) + lu(k,4045) = lu(k,4045) - lu(k,1704) * lu(k,3992) + lu(k,4048) = lu(k,4048) - lu(k,1705) * lu(k,3992) + lu(k,4049) = lu(k,4049) - lu(k,1706) * lu(k,3992) + lu(k,4053) = lu(k,4053) - lu(k,1707) * lu(k,3992) end do end subroutine lu_fac37 subroutine lu_fac38( avec_len, lu ) @@ -8596,545 +7965,519 @@ subroutine lu_fac38( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1700) = 1._r8 / lu(k,1700) - lu(k,1701) = lu(k,1701) * lu(k,1700) - lu(k,1702) = lu(k,1702) * lu(k,1700) - lu(k,1703) = lu(k,1703) * lu(k,1700) - lu(k,1704) = lu(k,1704) * lu(k,1700) - lu(k,1705) = lu(k,1705) * lu(k,1700) - lu(k,1706) = lu(k,1706) * lu(k,1700) - lu(k,1707) = lu(k,1707) * lu(k,1700) - lu(k,1708) = lu(k,1708) * lu(k,1700) - lu(k,1709) = lu(k,1709) * lu(k,1700) - lu(k,1731) = lu(k,1731) - lu(k,1701) * lu(k,1728) - lu(k,1732) = lu(k,1732) - lu(k,1702) * lu(k,1728) - lu(k,1736) = lu(k,1736) - lu(k,1703) * lu(k,1728) - lu(k,1738) = lu(k,1738) - lu(k,1704) * lu(k,1728) - lu(k,1739) = lu(k,1739) - lu(k,1705) * lu(k,1728) - lu(k,1740) = lu(k,1740) - lu(k,1706) * lu(k,1728) - lu(k,1741) = lu(k,1741) - lu(k,1707) * lu(k,1728) - lu(k,1743) = lu(k,1743) - lu(k,1708) * lu(k,1728) - lu(k,1744) = lu(k,1744) - lu(k,1709) * lu(k,1728) - lu(k,1781) = lu(k,1781) - lu(k,1701) * lu(k,1779) - lu(k,1783) = lu(k,1783) - lu(k,1702) * lu(k,1779) - lu(k,1787) = lu(k,1787) - lu(k,1703) * lu(k,1779) - lu(k,1788) = lu(k,1788) - lu(k,1704) * lu(k,1779) - lu(k,1789) = lu(k,1789) - lu(k,1705) * lu(k,1779) - lu(k,1790) = lu(k,1790) - lu(k,1706) * lu(k,1779) - lu(k,1791) = lu(k,1791) - lu(k,1707) * lu(k,1779) - lu(k,1793) = lu(k,1793) - lu(k,1708) * lu(k,1779) - lu(k,1794) = lu(k,1794) - lu(k,1709) * lu(k,1779) - lu(k,1828) = lu(k,1828) - lu(k,1701) * lu(k,1826) - lu(k,1830) = lu(k,1830) - lu(k,1702) * lu(k,1826) - lu(k,1834) = lu(k,1834) - lu(k,1703) * lu(k,1826) - lu(k,1836) = lu(k,1836) - lu(k,1704) * lu(k,1826) - lu(k,1837) = lu(k,1837) - lu(k,1705) * lu(k,1826) - lu(k,1838) = lu(k,1838) - lu(k,1706) * lu(k,1826) - lu(k,1839) = lu(k,1839) - lu(k,1707) * lu(k,1826) - lu(k,1841) = lu(k,1841) - lu(k,1708) * lu(k,1826) - lu(k,1842) = lu(k,1842) - lu(k,1709) * lu(k,1826) - lu(k,1892) = lu(k,1892) - lu(k,1701) * lu(k,1889) - lu(k,1894) = lu(k,1894) - lu(k,1702) * lu(k,1889) - lu(k,1900) = lu(k,1900) - lu(k,1703) * lu(k,1889) - lu(k,1902) = lu(k,1902) - lu(k,1704) * lu(k,1889) - lu(k,1903) = lu(k,1903) - lu(k,1705) * lu(k,1889) - lu(k,1906) = lu(k,1906) - lu(k,1706) * lu(k,1889) - lu(k,1907) = lu(k,1907) - lu(k,1707) * lu(k,1889) - lu(k,1909) = lu(k,1909) - lu(k,1708) * lu(k,1889) - lu(k,1910) = lu(k,1910) - lu(k,1709) * lu(k,1889) - lu(k,1928) = lu(k,1928) - lu(k,1701) * lu(k,1927) - lu(k,1929) = lu(k,1929) - lu(k,1702) * lu(k,1927) - lu(k,1932) = lu(k,1932) - lu(k,1703) * lu(k,1927) - lu(k,1934) = lu(k,1934) - lu(k,1704) * lu(k,1927) - lu(k,1935) = lu(k,1935) - lu(k,1705) * lu(k,1927) - lu(k,1938) = lu(k,1938) - lu(k,1706) * lu(k,1927) - lu(k,1939) = lu(k,1939) - lu(k,1707) * lu(k,1927) - lu(k,1941) = lu(k,1941) - lu(k,1708) * lu(k,1927) - lu(k,1942) = lu(k,1942) - lu(k,1709) * lu(k,1927) - lu(k,1962) = lu(k,1962) - lu(k,1701) * lu(k,1961) - lu(k,1963) = lu(k,1963) - lu(k,1702) * lu(k,1961) - lu(k,1966) = lu(k,1966) - lu(k,1703) * lu(k,1961) - lu(k,1968) = lu(k,1968) - lu(k,1704) * lu(k,1961) - lu(k,1969) = lu(k,1969) - lu(k,1705) * lu(k,1961) - lu(k,1972) = lu(k,1972) - lu(k,1706) * lu(k,1961) - lu(k,1973) = lu(k,1973) - lu(k,1707) * lu(k,1961) - lu(k,1975) = lu(k,1975) - lu(k,1708) * lu(k,1961) - lu(k,1976) = lu(k,1976) - lu(k,1709) * lu(k,1961) - lu(k,1991) = lu(k,1991) - lu(k,1701) * lu(k,1990) - lu(k,1992) = lu(k,1992) - lu(k,1702) * lu(k,1990) - lu(k,1994) = lu(k,1994) - lu(k,1703) * lu(k,1990) - lu(k,1996) = lu(k,1996) - lu(k,1704) * lu(k,1990) - lu(k,1997) = lu(k,1997) - lu(k,1705) * lu(k,1990) - lu(k,2000) = lu(k,2000) - lu(k,1706) * lu(k,1990) - lu(k,2001) = lu(k,2001) - lu(k,1707) * lu(k,1990) - lu(k,2003) = lu(k,2003) - lu(k,1708) * lu(k,1990) - lu(k,2004) = lu(k,2004) - lu(k,1709) * lu(k,1990) - lu(k,2668) = lu(k,2668) - lu(k,1701) * lu(k,2664) - lu(k,2670) = lu(k,2670) - lu(k,1702) * lu(k,2664) - lu(k,2699) = lu(k,2699) - lu(k,1703) * lu(k,2664) - lu(k,2701) = lu(k,2701) - lu(k,1704) * lu(k,2664) - lu(k,2702) = lu(k,2702) - lu(k,1705) * lu(k,2664) - lu(k,2705) = lu(k,2705) - lu(k,1706) * lu(k,2664) - lu(k,2706) = lu(k,2706) - lu(k,1707) * lu(k,2664) - lu(k,2709) = lu(k,2709) - lu(k,1708) * lu(k,2664) - lu(k,2710) = lu(k,2710) - lu(k,1709) * lu(k,2664) - lu(k,2851) = lu(k,2851) - lu(k,1701) * lu(k,2847) - lu(k,2853) = lu(k,2853) - lu(k,1702) * lu(k,2847) - lu(k,2882) = lu(k,2882) - lu(k,1703) * lu(k,2847) - lu(k,2884) = lu(k,2884) - lu(k,1704) * lu(k,2847) - lu(k,2885) = lu(k,2885) - lu(k,1705) * lu(k,2847) - lu(k,2889) = lu(k,2889) - lu(k,1706) * lu(k,2847) - lu(k,2891) = lu(k,2891) - lu(k,1707) * lu(k,2847) - lu(k,2894) = lu(k,2894) - lu(k,1708) * lu(k,2847) - lu(k,2895) = lu(k,2895) - lu(k,1709) * lu(k,2847) - lu(k,2953) = lu(k,2953) - lu(k,1701) * lu(k,2949) - lu(k,2955) = lu(k,2955) - lu(k,1702) * lu(k,2949) - lu(k,2983) = lu(k,2983) - lu(k,1703) * lu(k,2949) - lu(k,2985) = lu(k,2985) - lu(k,1704) * lu(k,2949) - lu(k,2986) = lu(k,2986) - lu(k,1705) * lu(k,2949) - lu(k,2990) = lu(k,2990) - lu(k,1706) * lu(k,2949) - lu(k,2992) = lu(k,2992) - lu(k,1707) * lu(k,2949) - lu(k,2995) = lu(k,2995) - lu(k,1708) * lu(k,2949) - lu(k,2996) = lu(k,2996) - lu(k,1709) * lu(k,2949) - lu(k,3044) = - lu(k,1701) * lu(k,3040) - lu(k,3046) = lu(k,3046) - lu(k,1702) * lu(k,3040) - lu(k,3075) = lu(k,3075) - lu(k,1703) * lu(k,3040) - lu(k,3077) = lu(k,3077) - lu(k,1704) * lu(k,3040) - lu(k,3078) = lu(k,3078) - lu(k,1705) * lu(k,3040) - lu(k,3082) = lu(k,3082) - lu(k,1706) * lu(k,3040) - lu(k,3084) = lu(k,3084) - lu(k,1707) * lu(k,3040) - lu(k,3087) = lu(k,3087) - lu(k,1708) * lu(k,3040) - lu(k,3088) = lu(k,3088) - lu(k,1709) * lu(k,3040) - lu(k,3247) = lu(k,3247) - lu(k,1701) * lu(k,3243) - lu(k,3249) = lu(k,3249) - lu(k,1702) * lu(k,3243) - lu(k,3278) = lu(k,3278) - lu(k,1703) * lu(k,3243) - lu(k,3280) = lu(k,3280) - lu(k,1704) * lu(k,3243) - lu(k,3281) = lu(k,3281) - lu(k,1705) * lu(k,3243) - lu(k,3285) = lu(k,3285) - lu(k,1706) * lu(k,3243) - lu(k,3287) = lu(k,3287) - lu(k,1707) * lu(k,3243) - lu(k,3290) = lu(k,3290) - lu(k,1708) * lu(k,3243) - lu(k,3291) = lu(k,3291) - lu(k,1709) * lu(k,3243) - lu(k,3388) = lu(k,3388) - lu(k,1701) * lu(k,3384) - lu(k,3390) = lu(k,3390) - lu(k,1702) * lu(k,3384) - lu(k,3419) = lu(k,3419) - lu(k,1703) * lu(k,3384) - lu(k,3421) = lu(k,3421) - lu(k,1704) * lu(k,3384) - lu(k,3422) = lu(k,3422) - lu(k,1705) * lu(k,3384) - lu(k,3426) = lu(k,3426) - lu(k,1706) * lu(k,3384) - lu(k,3428) = lu(k,3428) - lu(k,1707) * lu(k,3384) - lu(k,3431) = lu(k,3431) - lu(k,1708) * lu(k,3384) - lu(k,3432) = lu(k,3432) - lu(k,1709) * lu(k,3384) - lu(k,3709) = lu(k,3709) - lu(k,1701) * lu(k,3705) - lu(k,3711) = lu(k,3711) - lu(k,1702) * lu(k,3705) - lu(k,3739) = lu(k,3739) - lu(k,1703) * lu(k,3705) - lu(k,3741) = lu(k,3741) - lu(k,1704) * lu(k,3705) - lu(k,3742) = lu(k,3742) - lu(k,1705) * lu(k,3705) - lu(k,3746) = lu(k,3746) - lu(k,1706) * lu(k,3705) - lu(k,3748) = lu(k,3748) - lu(k,1707) * lu(k,3705) - lu(k,3751) = lu(k,3751) - lu(k,1708) * lu(k,3705) - lu(k,3752) = lu(k,3752) - lu(k,1709) * lu(k,3705) - lu(k,1729) = 1._r8 / lu(k,1729) - lu(k,1730) = lu(k,1730) * lu(k,1729) - lu(k,1731) = lu(k,1731) * lu(k,1729) - lu(k,1732) = lu(k,1732) * lu(k,1729) - lu(k,1733) = lu(k,1733) * lu(k,1729) - lu(k,1734) = lu(k,1734) * lu(k,1729) - lu(k,1735) = lu(k,1735) * lu(k,1729) - lu(k,1736) = lu(k,1736) * lu(k,1729) - lu(k,1737) = lu(k,1737) * lu(k,1729) - lu(k,1738) = lu(k,1738) * lu(k,1729) - lu(k,1739) = lu(k,1739) * lu(k,1729) - lu(k,1740) = lu(k,1740) * lu(k,1729) - lu(k,1741) = lu(k,1741) * lu(k,1729) - lu(k,1742) = lu(k,1742) * lu(k,1729) - lu(k,1743) = lu(k,1743) * lu(k,1729) - lu(k,1744) = lu(k,1744) * lu(k,1729) - lu(k,1891) = lu(k,1891) - lu(k,1730) * lu(k,1890) - lu(k,1892) = lu(k,1892) - lu(k,1731) * lu(k,1890) - lu(k,1894) = lu(k,1894) - lu(k,1732) * lu(k,1890) - lu(k,1896) = lu(k,1896) - lu(k,1733) * lu(k,1890) - lu(k,1897) = - lu(k,1734) * lu(k,1890) - lu(k,1899) = - lu(k,1735) * lu(k,1890) - lu(k,1900) = lu(k,1900) - lu(k,1736) * lu(k,1890) - lu(k,1901) = - lu(k,1737) * lu(k,1890) - lu(k,1902) = lu(k,1902) - lu(k,1738) * lu(k,1890) - lu(k,1903) = lu(k,1903) - lu(k,1739) * lu(k,1890) - lu(k,1906) = lu(k,1906) - lu(k,1740) * lu(k,1890) - lu(k,1907) = lu(k,1907) - lu(k,1741) * lu(k,1890) - lu(k,1908) = - lu(k,1742) * lu(k,1890) - lu(k,1909) = lu(k,1909) - lu(k,1743) * lu(k,1890) - lu(k,1910) = lu(k,1910) - lu(k,1744) * lu(k,1890) - lu(k,2666) = lu(k,2666) - lu(k,1730) * lu(k,2665) - lu(k,2668) = lu(k,2668) - lu(k,1731) * lu(k,2665) - lu(k,2670) = lu(k,2670) - lu(k,1732) * lu(k,2665) - lu(k,2672) = lu(k,2672) - lu(k,1733) * lu(k,2665) - lu(k,2673) = lu(k,2673) - lu(k,1734) * lu(k,2665) - lu(k,2681) = lu(k,2681) - lu(k,1735) * lu(k,2665) - lu(k,2699) = lu(k,2699) - lu(k,1736) * lu(k,2665) - lu(k,2700) = lu(k,2700) - lu(k,1737) * lu(k,2665) - lu(k,2701) = lu(k,2701) - lu(k,1738) * lu(k,2665) - lu(k,2702) = lu(k,2702) - lu(k,1739) * lu(k,2665) - lu(k,2705) = lu(k,2705) - lu(k,1740) * lu(k,2665) - lu(k,2706) = lu(k,2706) - lu(k,1741) * lu(k,2665) - lu(k,2707) = lu(k,2707) - lu(k,1742) * lu(k,2665) - lu(k,2709) = lu(k,2709) - lu(k,1743) * lu(k,2665) - lu(k,2710) = lu(k,2710) - lu(k,1744) * lu(k,2665) - lu(k,2849) = lu(k,2849) - lu(k,1730) * lu(k,2848) - lu(k,2851) = lu(k,2851) - lu(k,1731) * lu(k,2848) - lu(k,2853) = lu(k,2853) - lu(k,1732) * lu(k,2848) - lu(k,2855) = lu(k,2855) - lu(k,1733) * lu(k,2848) - lu(k,2856) = lu(k,2856) - lu(k,1734) * lu(k,2848) - lu(k,2864) = lu(k,2864) - lu(k,1735) * lu(k,2848) - lu(k,2882) = lu(k,2882) - lu(k,1736) * lu(k,2848) - lu(k,2883) = lu(k,2883) - lu(k,1737) * lu(k,2848) - lu(k,2884) = lu(k,2884) - lu(k,1738) * lu(k,2848) - lu(k,2885) = lu(k,2885) - lu(k,1739) * lu(k,2848) - lu(k,2889) = lu(k,2889) - lu(k,1740) * lu(k,2848) - lu(k,2891) = lu(k,2891) - lu(k,1741) * lu(k,2848) - lu(k,2892) = lu(k,2892) - lu(k,1742) * lu(k,2848) - lu(k,2894) = lu(k,2894) - lu(k,1743) * lu(k,2848) - lu(k,2895) = lu(k,2895) - lu(k,1744) * lu(k,2848) - lu(k,2951) = lu(k,2951) - lu(k,1730) * lu(k,2950) - lu(k,2953) = lu(k,2953) - lu(k,1731) * lu(k,2950) - lu(k,2955) = lu(k,2955) - lu(k,1732) * lu(k,2950) - lu(k,2957) = lu(k,2957) - lu(k,1733) * lu(k,2950) - lu(k,2958) = lu(k,2958) - lu(k,1734) * lu(k,2950) - lu(k,2965) = lu(k,2965) - lu(k,1735) * lu(k,2950) - lu(k,2983) = lu(k,2983) - lu(k,1736) * lu(k,2950) - lu(k,2984) = lu(k,2984) - lu(k,1737) * lu(k,2950) - lu(k,2985) = lu(k,2985) - lu(k,1738) * lu(k,2950) - lu(k,2986) = lu(k,2986) - lu(k,1739) * lu(k,2950) - lu(k,2990) = lu(k,2990) - lu(k,1740) * lu(k,2950) - lu(k,2992) = lu(k,2992) - lu(k,1741) * lu(k,2950) - lu(k,2993) = lu(k,2993) - lu(k,1742) * lu(k,2950) - lu(k,2995) = lu(k,2995) - lu(k,1743) * lu(k,2950) - lu(k,2996) = lu(k,2996) - lu(k,1744) * lu(k,2950) - lu(k,3042) = lu(k,3042) - lu(k,1730) * lu(k,3041) - lu(k,3044) = lu(k,3044) - lu(k,1731) * lu(k,3041) - lu(k,3046) = lu(k,3046) - lu(k,1732) * lu(k,3041) - lu(k,3048) = lu(k,3048) - lu(k,1733) * lu(k,3041) - lu(k,3049) = lu(k,3049) - lu(k,1734) * lu(k,3041) - lu(k,3057) = lu(k,3057) - lu(k,1735) * lu(k,3041) - lu(k,3075) = lu(k,3075) - lu(k,1736) * lu(k,3041) - lu(k,3076) = lu(k,3076) - lu(k,1737) * lu(k,3041) - lu(k,3077) = lu(k,3077) - lu(k,1738) * lu(k,3041) - lu(k,3078) = lu(k,3078) - lu(k,1739) * lu(k,3041) - lu(k,3082) = lu(k,3082) - lu(k,1740) * lu(k,3041) - lu(k,3084) = lu(k,3084) - lu(k,1741) * lu(k,3041) - lu(k,3085) = lu(k,3085) - lu(k,1742) * lu(k,3041) - lu(k,3087) = lu(k,3087) - lu(k,1743) * lu(k,3041) - lu(k,3088) = lu(k,3088) - lu(k,1744) * lu(k,3041) - lu(k,3245) = lu(k,3245) - lu(k,1730) * lu(k,3244) - lu(k,3247) = lu(k,3247) - lu(k,1731) * lu(k,3244) - lu(k,3249) = lu(k,3249) - lu(k,1732) * lu(k,3244) - lu(k,3251) = lu(k,3251) - lu(k,1733) * lu(k,3244) - lu(k,3252) = lu(k,3252) - lu(k,1734) * lu(k,3244) - lu(k,3260) = lu(k,3260) - lu(k,1735) * lu(k,3244) - lu(k,3278) = lu(k,3278) - lu(k,1736) * lu(k,3244) - lu(k,3279) = lu(k,3279) - lu(k,1737) * lu(k,3244) - lu(k,3280) = lu(k,3280) - lu(k,1738) * lu(k,3244) - lu(k,3281) = lu(k,3281) - lu(k,1739) * lu(k,3244) - lu(k,3285) = lu(k,3285) - lu(k,1740) * lu(k,3244) - lu(k,3287) = lu(k,3287) - lu(k,1741) * lu(k,3244) - lu(k,3288) = lu(k,3288) - lu(k,1742) * lu(k,3244) - lu(k,3290) = lu(k,3290) - lu(k,1743) * lu(k,3244) - lu(k,3291) = lu(k,3291) - lu(k,1744) * lu(k,3244) - lu(k,3386) = lu(k,3386) - lu(k,1730) * lu(k,3385) - lu(k,3388) = lu(k,3388) - lu(k,1731) * lu(k,3385) - lu(k,3390) = lu(k,3390) - lu(k,1732) * lu(k,3385) - lu(k,3392) = lu(k,3392) - lu(k,1733) * lu(k,3385) - lu(k,3393) = lu(k,3393) - lu(k,1734) * lu(k,3385) - lu(k,3401) = lu(k,3401) - lu(k,1735) * lu(k,3385) - lu(k,3419) = lu(k,3419) - lu(k,1736) * lu(k,3385) - lu(k,3420) = lu(k,3420) - lu(k,1737) * lu(k,3385) - lu(k,3421) = lu(k,3421) - lu(k,1738) * lu(k,3385) - lu(k,3422) = lu(k,3422) - lu(k,1739) * lu(k,3385) - lu(k,3426) = lu(k,3426) - lu(k,1740) * lu(k,3385) - lu(k,3428) = lu(k,3428) - lu(k,1741) * lu(k,3385) - lu(k,3429) = lu(k,3429) - lu(k,1742) * lu(k,3385) - lu(k,3431) = lu(k,3431) - lu(k,1743) * lu(k,3385) - lu(k,3432) = lu(k,3432) - lu(k,1744) * lu(k,3385) - lu(k,3707) = lu(k,3707) - lu(k,1730) * lu(k,3706) - lu(k,3709) = lu(k,3709) - lu(k,1731) * lu(k,3706) - lu(k,3711) = lu(k,3711) - lu(k,1732) * lu(k,3706) - lu(k,3713) = lu(k,3713) - lu(k,1733) * lu(k,3706) - lu(k,3714) = lu(k,3714) - lu(k,1734) * lu(k,3706) - lu(k,3721) = lu(k,3721) - lu(k,1735) * lu(k,3706) - lu(k,3739) = lu(k,3739) - lu(k,1736) * lu(k,3706) - lu(k,3740) = lu(k,3740) - lu(k,1737) * lu(k,3706) - lu(k,3741) = lu(k,3741) - lu(k,1738) * lu(k,3706) - lu(k,3742) = lu(k,3742) - lu(k,1739) * lu(k,3706) - lu(k,3746) = lu(k,3746) - lu(k,1740) * lu(k,3706) - lu(k,3748) = lu(k,3748) - lu(k,1741) * lu(k,3706) - lu(k,3749) = lu(k,3749) - lu(k,1742) * lu(k,3706) - lu(k,3751) = lu(k,3751) - lu(k,1743) * lu(k,3706) - lu(k,3752) = lu(k,3752) - lu(k,1744) * lu(k,3706) - lu(k,1751) = 1._r8 / lu(k,1751) - lu(k,1752) = lu(k,1752) * lu(k,1751) - lu(k,1753) = lu(k,1753) * lu(k,1751) - lu(k,1754) = lu(k,1754) * lu(k,1751) - lu(k,1755) = lu(k,1755) * lu(k,1751) - lu(k,1756) = lu(k,1756) * lu(k,1751) - lu(k,1757) = lu(k,1757) * lu(k,1751) - lu(k,1758) = lu(k,1758) * lu(k,1751) - lu(k,1759) = lu(k,1759) * lu(k,1751) - lu(k,1760) = lu(k,1760) * lu(k,1751) - lu(k,1761) = lu(k,1761) * lu(k,1751) - lu(k,1762) = lu(k,1762) * lu(k,1751) - lu(k,1763) = lu(k,1763) * lu(k,1751) - lu(k,1764) = lu(k,1764) * lu(k,1751) - lu(k,1894) = lu(k,1894) - lu(k,1752) * lu(k,1891) - lu(k,1899) = lu(k,1899) - lu(k,1753) * lu(k,1891) - lu(k,1900) = lu(k,1900) - lu(k,1754) * lu(k,1891) - lu(k,1902) = lu(k,1902) - lu(k,1755) * lu(k,1891) - lu(k,1903) = lu(k,1903) - lu(k,1756) * lu(k,1891) - lu(k,1904) = - lu(k,1757) * lu(k,1891) - lu(k,1905) = - lu(k,1758) * lu(k,1891) - lu(k,1906) = lu(k,1906) - lu(k,1759) * lu(k,1891) - lu(k,1907) = lu(k,1907) - lu(k,1760) * lu(k,1891) - lu(k,1908) = lu(k,1908) - lu(k,1761) * lu(k,1891) - lu(k,1909) = lu(k,1909) - lu(k,1762) * lu(k,1891) - lu(k,1910) = lu(k,1910) - lu(k,1763) * lu(k,1891) - lu(k,1911) = - lu(k,1764) * lu(k,1891) - lu(k,2029) = lu(k,2029) - lu(k,1752) * lu(k,2027) - lu(k,2035) = - lu(k,1753) * lu(k,2027) - lu(k,2036) = lu(k,2036) - lu(k,1754) * lu(k,2027) - lu(k,2038) = lu(k,2038) - lu(k,1755) * lu(k,2027) - lu(k,2039) = lu(k,2039) - lu(k,1756) * lu(k,2027) - lu(k,2040) = lu(k,2040) - lu(k,1757) * lu(k,2027) - lu(k,2041) = lu(k,2041) - lu(k,1758) * lu(k,2027) - lu(k,2042) = lu(k,2042) - lu(k,1759) * lu(k,2027) - lu(k,2043) = lu(k,2043) - lu(k,1760) * lu(k,2027) - lu(k,2044) = lu(k,2044) - lu(k,1761) * lu(k,2027) - lu(k,2046) = lu(k,2046) - lu(k,1762) * lu(k,2027) - lu(k,2047) = lu(k,2047) - lu(k,1763) * lu(k,2027) - lu(k,2050) = lu(k,2050) - lu(k,1764) * lu(k,2027) - lu(k,2670) = lu(k,2670) - lu(k,1752) * lu(k,2666) - lu(k,2681) = lu(k,2681) - lu(k,1753) * lu(k,2666) - lu(k,2699) = lu(k,2699) - lu(k,1754) * lu(k,2666) - lu(k,2701) = lu(k,2701) - lu(k,1755) * lu(k,2666) - lu(k,2702) = lu(k,2702) - lu(k,1756) * lu(k,2666) - lu(k,2703) = lu(k,2703) - lu(k,1757) * lu(k,2666) - lu(k,2704) = lu(k,2704) - lu(k,1758) * lu(k,2666) - lu(k,2705) = lu(k,2705) - lu(k,1759) * lu(k,2666) - lu(k,2706) = lu(k,2706) - lu(k,1760) * lu(k,2666) - lu(k,2707) = lu(k,2707) - lu(k,1761) * lu(k,2666) - lu(k,2709) = lu(k,2709) - lu(k,1762) * lu(k,2666) - lu(k,2710) = lu(k,2710) - lu(k,1763) * lu(k,2666) - lu(k,2713) = lu(k,2713) - lu(k,1764) * lu(k,2666) - lu(k,2853) = lu(k,2853) - lu(k,1752) * lu(k,2849) - lu(k,2864) = lu(k,2864) - lu(k,1753) * lu(k,2849) - lu(k,2882) = lu(k,2882) - lu(k,1754) * lu(k,2849) - lu(k,2884) = lu(k,2884) - lu(k,1755) * lu(k,2849) - lu(k,2885) = lu(k,2885) - lu(k,1756) * lu(k,2849) - lu(k,2886) = lu(k,2886) - lu(k,1757) * lu(k,2849) - lu(k,2887) = lu(k,2887) - lu(k,1758) * lu(k,2849) - lu(k,2889) = lu(k,2889) - lu(k,1759) * lu(k,2849) - lu(k,2891) = lu(k,2891) - lu(k,1760) * lu(k,2849) - lu(k,2892) = lu(k,2892) - lu(k,1761) * lu(k,2849) - lu(k,2894) = lu(k,2894) - lu(k,1762) * lu(k,2849) - lu(k,2895) = lu(k,2895) - lu(k,1763) * lu(k,2849) - lu(k,2899) = lu(k,2899) - lu(k,1764) * lu(k,2849) - lu(k,2955) = lu(k,2955) - lu(k,1752) * lu(k,2951) - lu(k,2965) = lu(k,2965) - lu(k,1753) * lu(k,2951) - lu(k,2983) = lu(k,2983) - lu(k,1754) * lu(k,2951) - lu(k,2985) = lu(k,2985) - lu(k,1755) * lu(k,2951) - lu(k,2986) = lu(k,2986) - lu(k,1756) * lu(k,2951) - lu(k,2987) = lu(k,2987) - lu(k,1757) * lu(k,2951) - lu(k,2988) = lu(k,2988) - lu(k,1758) * lu(k,2951) - lu(k,2990) = lu(k,2990) - lu(k,1759) * lu(k,2951) - lu(k,2992) = lu(k,2992) - lu(k,1760) * lu(k,2951) - lu(k,2993) = lu(k,2993) - lu(k,1761) * lu(k,2951) - lu(k,2995) = lu(k,2995) - lu(k,1762) * lu(k,2951) - lu(k,2996) = lu(k,2996) - lu(k,1763) * lu(k,2951) - lu(k,3000) = lu(k,3000) - lu(k,1764) * lu(k,2951) - lu(k,3046) = lu(k,3046) - lu(k,1752) * lu(k,3042) - lu(k,3057) = lu(k,3057) - lu(k,1753) * lu(k,3042) - lu(k,3075) = lu(k,3075) - lu(k,1754) * lu(k,3042) - lu(k,3077) = lu(k,3077) - lu(k,1755) * lu(k,3042) - lu(k,3078) = lu(k,3078) - lu(k,1756) * lu(k,3042) - lu(k,3079) = lu(k,3079) - lu(k,1757) * lu(k,3042) - lu(k,3080) = lu(k,3080) - lu(k,1758) * lu(k,3042) - lu(k,3082) = lu(k,3082) - lu(k,1759) * lu(k,3042) - lu(k,3084) = lu(k,3084) - lu(k,1760) * lu(k,3042) - lu(k,3085) = lu(k,3085) - lu(k,1761) * lu(k,3042) - lu(k,3087) = lu(k,3087) - lu(k,1762) * lu(k,3042) - lu(k,3088) = lu(k,3088) - lu(k,1763) * lu(k,3042) - lu(k,3092) = lu(k,3092) - lu(k,1764) * lu(k,3042) - lu(k,3249) = lu(k,3249) - lu(k,1752) * lu(k,3245) - lu(k,3260) = lu(k,3260) - lu(k,1753) * lu(k,3245) - lu(k,3278) = lu(k,3278) - lu(k,1754) * lu(k,3245) - lu(k,3280) = lu(k,3280) - lu(k,1755) * lu(k,3245) - lu(k,3281) = lu(k,3281) - lu(k,1756) * lu(k,3245) - lu(k,3282) = lu(k,3282) - lu(k,1757) * lu(k,3245) - lu(k,3283) = lu(k,3283) - lu(k,1758) * lu(k,3245) - lu(k,3285) = lu(k,3285) - lu(k,1759) * lu(k,3245) - lu(k,3287) = lu(k,3287) - lu(k,1760) * lu(k,3245) - lu(k,3288) = lu(k,3288) - lu(k,1761) * lu(k,3245) - lu(k,3290) = lu(k,3290) - lu(k,1762) * lu(k,3245) - lu(k,3291) = lu(k,3291) - lu(k,1763) * lu(k,3245) - lu(k,3295) = lu(k,3295) - lu(k,1764) * lu(k,3245) - lu(k,3390) = lu(k,3390) - lu(k,1752) * lu(k,3386) - lu(k,3401) = lu(k,3401) - lu(k,1753) * lu(k,3386) - lu(k,3419) = lu(k,3419) - lu(k,1754) * lu(k,3386) - lu(k,3421) = lu(k,3421) - lu(k,1755) * lu(k,3386) - lu(k,3422) = lu(k,3422) - lu(k,1756) * lu(k,3386) - lu(k,3423) = lu(k,3423) - lu(k,1757) * lu(k,3386) - lu(k,3424) = lu(k,3424) - lu(k,1758) * lu(k,3386) - lu(k,3426) = lu(k,3426) - lu(k,1759) * lu(k,3386) - lu(k,3428) = lu(k,3428) - lu(k,1760) * lu(k,3386) - lu(k,3429) = lu(k,3429) - lu(k,1761) * lu(k,3386) - lu(k,3431) = lu(k,3431) - lu(k,1762) * lu(k,3386) - lu(k,3432) = lu(k,3432) - lu(k,1763) * lu(k,3386) - lu(k,3436) = lu(k,3436) - lu(k,1764) * lu(k,3386) - lu(k,3711) = lu(k,3711) - lu(k,1752) * lu(k,3707) - lu(k,3721) = lu(k,3721) - lu(k,1753) * lu(k,3707) - lu(k,3739) = lu(k,3739) - lu(k,1754) * lu(k,3707) - lu(k,3741) = lu(k,3741) - lu(k,1755) * lu(k,3707) - lu(k,3742) = lu(k,3742) - lu(k,1756) * lu(k,3707) - lu(k,3743) = lu(k,3743) - lu(k,1757) * lu(k,3707) - lu(k,3744) = lu(k,3744) - lu(k,1758) * lu(k,3707) - lu(k,3746) = lu(k,3746) - lu(k,1759) * lu(k,3707) - lu(k,3748) = lu(k,3748) - lu(k,1760) * lu(k,3707) - lu(k,3749) = lu(k,3749) - lu(k,1761) * lu(k,3707) - lu(k,3751) = lu(k,3751) - lu(k,1762) * lu(k,3707) - lu(k,3752) = lu(k,3752) - lu(k,1763) * lu(k,3707) - lu(k,3756) = lu(k,3756) - lu(k,1764) * lu(k,3707) - lu(k,1780) = 1._r8 / lu(k,1780) - lu(k,1781) = lu(k,1781) * lu(k,1780) - lu(k,1782) = lu(k,1782) * lu(k,1780) - lu(k,1783) = lu(k,1783) * lu(k,1780) - lu(k,1784) = lu(k,1784) * lu(k,1780) - lu(k,1785) = lu(k,1785) * lu(k,1780) - lu(k,1786) = lu(k,1786) * lu(k,1780) - lu(k,1787) = lu(k,1787) * lu(k,1780) - lu(k,1788) = lu(k,1788) * lu(k,1780) - lu(k,1789) = lu(k,1789) * lu(k,1780) - lu(k,1790) = lu(k,1790) * lu(k,1780) - lu(k,1791) = lu(k,1791) * lu(k,1780) - lu(k,1792) = lu(k,1792) * lu(k,1780) - lu(k,1793) = lu(k,1793) * lu(k,1780) - lu(k,1794) = lu(k,1794) * lu(k,1780) - lu(k,1795) = lu(k,1795) * lu(k,1780) - lu(k,1828) = lu(k,1828) - lu(k,1781) * lu(k,1827) - lu(k,1829) = lu(k,1829) - lu(k,1782) * lu(k,1827) - lu(k,1830) = lu(k,1830) - lu(k,1783) * lu(k,1827) - lu(k,1831) = lu(k,1831) - lu(k,1784) * lu(k,1827) - lu(k,1832) = lu(k,1832) - lu(k,1785) * lu(k,1827) - lu(k,1833) = lu(k,1833) - lu(k,1786) * lu(k,1827) - lu(k,1834) = lu(k,1834) - lu(k,1787) * lu(k,1827) - lu(k,1836) = lu(k,1836) - lu(k,1788) * lu(k,1827) - lu(k,1837) = lu(k,1837) - lu(k,1789) * lu(k,1827) - lu(k,1838) = lu(k,1838) - lu(k,1790) * lu(k,1827) - lu(k,1839) = lu(k,1839) - lu(k,1791) * lu(k,1827) - lu(k,1840) = lu(k,1840) - lu(k,1792) * lu(k,1827) - lu(k,1841) = lu(k,1841) - lu(k,1793) * lu(k,1827) - lu(k,1842) = lu(k,1842) - lu(k,1794) * lu(k,1827) - lu(k,1843) = - lu(k,1795) * lu(k,1827) - lu(k,2668) = lu(k,2668) - lu(k,1781) * lu(k,2667) - lu(k,2669) = lu(k,2669) - lu(k,1782) * lu(k,2667) - lu(k,2670) = lu(k,2670) - lu(k,1783) * lu(k,2667) - lu(k,2671) = lu(k,2671) - lu(k,1784) * lu(k,2667) - lu(k,2672) = lu(k,2672) - lu(k,1785) * lu(k,2667) - lu(k,2674) = lu(k,2674) - lu(k,1786) * lu(k,2667) - lu(k,2699) = lu(k,2699) - lu(k,1787) * lu(k,2667) - lu(k,2701) = lu(k,2701) - lu(k,1788) * lu(k,2667) - lu(k,2702) = lu(k,2702) - lu(k,1789) * lu(k,2667) - lu(k,2705) = lu(k,2705) - lu(k,1790) * lu(k,2667) - lu(k,2706) = lu(k,2706) - lu(k,1791) * lu(k,2667) - lu(k,2707) = lu(k,2707) - lu(k,1792) * lu(k,2667) - lu(k,2709) = lu(k,2709) - lu(k,1793) * lu(k,2667) - lu(k,2710) = lu(k,2710) - lu(k,1794) * lu(k,2667) - lu(k,2713) = lu(k,2713) - lu(k,1795) * lu(k,2667) - lu(k,2851) = lu(k,2851) - lu(k,1781) * lu(k,2850) - lu(k,2852) = lu(k,2852) - lu(k,1782) * lu(k,2850) - lu(k,2853) = lu(k,2853) - lu(k,1783) * lu(k,2850) - lu(k,2854) = lu(k,2854) - lu(k,1784) * lu(k,2850) - lu(k,2855) = lu(k,2855) - lu(k,1785) * lu(k,2850) - lu(k,2857) = lu(k,2857) - lu(k,1786) * lu(k,2850) - lu(k,2882) = lu(k,2882) - lu(k,1787) * lu(k,2850) - lu(k,2884) = lu(k,2884) - lu(k,1788) * lu(k,2850) - lu(k,2885) = lu(k,2885) - lu(k,1789) * lu(k,2850) - lu(k,2889) = lu(k,2889) - lu(k,1790) * lu(k,2850) - lu(k,2891) = lu(k,2891) - lu(k,1791) * lu(k,2850) - lu(k,2892) = lu(k,2892) - lu(k,1792) * lu(k,2850) - lu(k,2894) = lu(k,2894) - lu(k,1793) * lu(k,2850) - lu(k,2895) = lu(k,2895) - lu(k,1794) * lu(k,2850) - lu(k,2899) = lu(k,2899) - lu(k,1795) * lu(k,2850) - lu(k,2953) = lu(k,2953) - lu(k,1781) * lu(k,2952) - lu(k,2954) = lu(k,2954) - lu(k,1782) * lu(k,2952) - lu(k,2955) = lu(k,2955) - lu(k,1783) * lu(k,2952) - lu(k,2956) = lu(k,2956) - lu(k,1784) * lu(k,2952) - lu(k,2957) = lu(k,2957) - lu(k,1785) * lu(k,2952) - lu(k,2959) = lu(k,2959) - lu(k,1786) * lu(k,2952) - lu(k,2983) = lu(k,2983) - lu(k,1787) * lu(k,2952) - lu(k,2985) = lu(k,2985) - lu(k,1788) * lu(k,2952) - lu(k,2986) = lu(k,2986) - lu(k,1789) * lu(k,2952) - lu(k,2990) = lu(k,2990) - lu(k,1790) * lu(k,2952) - lu(k,2992) = lu(k,2992) - lu(k,1791) * lu(k,2952) - lu(k,2993) = lu(k,2993) - lu(k,1792) * lu(k,2952) - lu(k,2995) = lu(k,2995) - lu(k,1793) * lu(k,2952) - lu(k,2996) = lu(k,2996) - lu(k,1794) * lu(k,2952) - lu(k,3000) = lu(k,3000) - lu(k,1795) * lu(k,2952) - lu(k,3044) = lu(k,3044) - lu(k,1781) * lu(k,3043) - lu(k,3045) = lu(k,3045) - lu(k,1782) * lu(k,3043) - lu(k,3046) = lu(k,3046) - lu(k,1783) * lu(k,3043) - lu(k,3047) = lu(k,3047) - lu(k,1784) * lu(k,3043) - lu(k,3048) = lu(k,3048) - lu(k,1785) * lu(k,3043) - lu(k,3050) = lu(k,3050) - lu(k,1786) * lu(k,3043) - lu(k,3075) = lu(k,3075) - lu(k,1787) * lu(k,3043) - lu(k,3077) = lu(k,3077) - lu(k,1788) * lu(k,3043) - lu(k,3078) = lu(k,3078) - lu(k,1789) * lu(k,3043) - lu(k,3082) = lu(k,3082) - lu(k,1790) * lu(k,3043) - lu(k,3084) = lu(k,3084) - lu(k,1791) * lu(k,3043) - lu(k,3085) = lu(k,3085) - lu(k,1792) * lu(k,3043) - lu(k,3087) = lu(k,3087) - lu(k,1793) * lu(k,3043) - lu(k,3088) = lu(k,3088) - lu(k,1794) * lu(k,3043) - lu(k,3092) = lu(k,3092) - lu(k,1795) * lu(k,3043) - lu(k,3247) = lu(k,3247) - lu(k,1781) * lu(k,3246) - lu(k,3248) = lu(k,3248) - lu(k,1782) * lu(k,3246) - lu(k,3249) = lu(k,3249) - lu(k,1783) * lu(k,3246) - lu(k,3250) = lu(k,3250) - lu(k,1784) * lu(k,3246) - lu(k,3251) = lu(k,3251) - lu(k,1785) * lu(k,3246) - lu(k,3253) = lu(k,3253) - lu(k,1786) * lu(k,3246) - lu(k,3278) = lu(k,3278) - lu(k,1787) * lu(k,3246) - lu(k,3280) = lu(k,3280) - lu(k,1788) * lu(k,3246) - lu(k,3281) = lu(k,3281) - lu(k,1789) * lu(k,3246) - lu(k,3285) = lu(k,3285) - lu(k,1790) * lu(k,3246) - lu(k,3287) = lu(k,3287) - lu(k,1791) * lu(k,3246) - lu(k,3288) = lu(k,3288) - lu(k,1792) * lu(k,3246) - lu(k,3290) = lu(k,3290) - lu(k,1793) * lu(k,3246) - lu(k,3291) = lu(k,3291) - lu(k,1794) * lu(k,3246) - lu(k,3295) = lu(k,3295) - lu(k,1795) * lu(k,3246) - lu(k,3388) = lu(k,3388) - lu(k,1781) * lu(k,3387) - lu(k,3389) = lu(k,3389) - lu(k,1782) * lu(k,3387) - lu(k,3390) = lu(k,3390) - lu(k,1783) * lu(k,3387) - lu(k,3391) = lu(k,3391) - lu(k,1784) * lu(k,3387) - lu(k,3392) = lu(k,3392) - lu(k,1785) * lu(k,3387) - lu(k,3394) = lu(k,3394) - lu(k,1786) * lu(k,3387) - lu(k,3419) = lu(k,3419) - lu(k,1787) * lu(k,3387) - lu(k,3421) = lu(k,3421) - lu(k,1788) * lu(k,3387) - lu(k,3422) = lu(k,3422) - lu(k,1789) * lu(k,3387) - lu(k,3426) = lu(k,3426) - lu(k,1790) * lu(k,3387) - lu(k,3428) = lu(k,3428) - lu(k,1791) * lu(k,3387) - lu(k,3429) = lu(k,3429) - lu(k,1792) * lu(k,3387) - lu(k,3431) = lu(k,3431) - lu(k,1793) * lu(k,3387) - lu(k,3432) = lu(k,3432) - lu(k,1794) * lu(k,3387) - lu(k,3436) = lu(k,3436) - lu(k,1795) * lu(k,3387) - lu(k,3709) = lu(k,3709) - lu(k,1781) * lu(k,3708) - lu(k,3710) = lu(k,3710) - lu(k,1782) * lu(k,3708) - lu(k,3711) = lu(k,3711) - lu(k,1783) * lu(k,3708) - lu(k,3712) = lu(k,3712) - lu(k,1784) * lu(k,3708) - lu(k,3713) = lu(k,3713) - lu(k,1785) * lu(k,3708) - lu(k,3715) = lu(k,3715) - lu(k,1786) * lu(k,3708) - lu(k,3739) = lu(k,3739) - lu(k,1787) * lu(k,3708) - lu(k,3741) = lu(k,3741) - lu(k,1788) * lu(k,3708) - lu(k,3742) = lu(k,3742) - lu(k,1789) * lu(k,3708) - lu(k,3746) = lu(k,3746) - lu(k,1790) * lu(k,3708) - lu(k,3748) = lu(k,3748) - lu(k,1791) * lu(k,3708) - lu(k,3749) = lu(k,3749) - lu(k,1792) * lu(k,3708) - lu(k,3751) = lu(k,3751) - lu(k,1793) * lu(k,3708) - lu(k,3752) = lu(k,3752) - lu(k,1794) * lu(k,3708) - lu(k,3756) = lu(k,3756) - lu(k,1795) * lu(k,3708) + lu(k,1710) = 1._r8 / lu(k,1710) + lu(k,1711) = lu(k,1711) * lu(k,1710) + lu(k,1712) = lu(k,1712) * lu(k,1710) + lu(k,1713) = lu(k,1713) * lu(k,1710) + lu(k,1714) = lu(k,1714) * lu(k,1710) + lu(k,1715) = lu(k,1715) * lu(k,1710) + lu(k,1745) = lu(k,1745) - lu(k,1711) * lu(k,1739) + lu(k,1750) = lu(k,1750) - lu(k,1712) * lu(k,1739) + lu(k,1751) = lu(k,1751) - lu(k,1713) * lu(k,1739) + lu(k,1752) = lu(k,1752) - lu(k,1714) * lu(k,1739) + lu(k,1753) = lu(k,1753) - lu(k,1715) * lu(k,1739) + lu(k,1773) = lu(k,1773) - lu(k,1711) * lu(k,1767) + lu(k,1778) = lu(k,1778) - lu(k,1712) * lu(k,1767) + lu(k,1779) = lu(k,1779) - lu(k,1713) * lu(k,1767) + lu(k,1780) = lu(k,1780) - lu(k,1714) * lu(k,1767) + lu(k,1781) = lu(k,1781) - lu(k,1715) * lu(k,1767) + lu(k,1793) = lu(k,1793) - lu(k,1711) * lu(k,1788) + lu(k,1796) = lu(k,1796) - lu(k,1712) * lu(k,1788) + lu(k,1797) = lu(k,1797) - lu(k,1713) * lu(k,1788) + lu(k,1798) = lu(k,1798) - lu(k,1714) * lu(k,1788) + lu(k,1799) = lu(k,1799) - lu(k,1715) * lu(k,1788) + lu(k,1819) = lu(k,1819) - lu(k,1711) * lu(k,1812) + lu(k,1826) = lu(k,1826) - lu(k,1712) * lu(k,1812) + lu(k,1827) = lu(k,1827) - lu(k,1713) * lu(k,1812) + lu(k,1828) = lu(k,1828) - lu(k,1714) * lu(k,1812) + lu(k,1829) = lu(k,1829) - lu(k,1715) * lu(k,1812) + lu(k,1850) = lu(k,1850) - lu(k,1711) * lu(k,1844) + lu(k,1857) = lu(k,1857) - lu(k,1712) * lu(k,1844) + lu(k,1858) = lu(k,1858) - lu(k,1713) * lu(k,1844) + lu(k,1859) = lu(k,1859) - lu(k,1714) * lu(k,1844) + lu(k,1860) = lu(k,1860) - lu(k,1715) * lu(k,1844) + lu(k,1872) = lu(k,1872) - lu(k,1711) * lu(k,1867) + lu(k,1876) = - lu(k,1712) * lu(k,1867) + lu(k,1877) = lu(k,1877) - lu(k,1713) * lu(k,1867) + lu(k,1878) = lu(k,1878) - lu(k,1714) * lu(k,1867) + lu(k,1879) = lu(k,1879) - lu(k,1715) * lu(k,1867) + lu(k,1896) = lu(k,1896) - lu(k,1711) * lu(k,1890) + lu(k,1904) = lu(k,1904) - lu(k,1712) * lu(k,1890) + lu(k,1905) = lu(k,1905) - lu(k,1713) * lu(k,1890) + lu(k,1906) = lu(k,1906) - lu(k,1714) * lu(k,1890) + lu(k,1907) = lu(k,1907) - lu(k,1715) * lu(k,1890) + lu(k,1928) = lu(k,1928) - lu(k,1711) * lu(k,1926) + lu(k,1932) = lu(k,1932) - lu(k,1712) * lu(k,1926) + lu(k,1933) = lu(k,1933) - lu(k,1713) * lu(k,1926) + lu(k,1934) = lu(k,1934) - lu(k,1714) * lu(k,1926) + lu(k,1935) = lu(k,1935) - lu(k,1715) * lu(k,1926) + lu(k,1957) = lu(k,1957) - lu(k,1711) * lu(k,1948) + lu(k,1967) = lu(k,1967) - lu(k,1712) * lu(k,1948) + lu(k,1968) = lu(k,1968) - lu(k,1713) * lu(k,1948) + lu(k,1969) = lu(k,1969) - lu(k,1714) * lu(k,1948) + lu(k,1970) = lu(k,1970) - lu(k,1715) * lu(k,1948) + lu(k,1994) = lu(k,1994) - lu(k,1711) * lu(k,1985) + lu(k,2006) = lu(k,2006) - lu(k,1712) * lu(k,1985) + lu(k,2007) = lu(k,2007) - lu(k,1713) * lu(k,1985) + lu(k,2008) = lu(k,2008) - lu(k,1714) * lu(k,1985) + lu(k,2009) = lu(k,2009) - lu(k,1715) * lu(k,1985) + lu(k,2045) = lu(k,2045) - lu(k,1711) * lu(k,2042) + lu(k,2053) = lu(k,2053) - lu(k,1712) * lu(k,2042) + lu(k,2054) = lu(k,2054) - lu(k,1713) * lu(k,2042) + lu(k,2055) = lu(k,2055) - lu(k,1714) * lu(k,2042) + lu(k,2056) = lu(k,2056) - lu(k,1715) * lu(k,2042) + lu(k,2076) = lu(k,2076) - lu(k,1711) * lu(k,2070) + lu(k,2085) = lu(k,2085) - lu(k,1712) * lu(k,2070) + lu(k,2086) = lu(k,2086) - lu(k,1713) * lu(k,2070) + lu(k,2087) = lu(k,2087) - lu(k,1714) * lu(k,2070) + lu(k,2088) = lu(k,2088) - lu(k,1715) * lu(k,2070) + lu(k,2108) = lu(k,2108) - lu(k,1711) * lu(k,2102) + lu(k,2117) = lu(k,2117) - lu(k,1712) * lu(k,2102) + lu(k,2118) = lu(k,2118) - lu(k,1713) * lu(k,2102) + lu(k,2119) = lu(k,2119) - lu(k,1714) * lu(k,2102) + lu(k,2120) = lu(k,2120) - lu(k,1715) * lu(k,2102) + lu(k,2138) = lu(k,2138) - lu(k,1711) * lu(k,2132) + lu(k,2146) = lu(k,2146) - lu(k,1712) * lu(k,2132) + lu(k,2147) = lu(k,2147) - lu(k,1713) * lu(k,2132) + lu(k,2148) = lu(k,2148) - lu(k,1714) * lu(k,2132) + lu(k,2149) = lu(k,2149) - lu(k,1715) * lu(k,2132) + lu(k,2173) = lu(k,2173) - lu(k,1711) * lu(k,2168) + lu(k,2188) = lu(k,2188) - lu(k,1712) * lu(k,2168) + lu(k,2189) = lu(k,2189) - lu(k,1713) * lu(k,2168) + lu(k,2190) = lu(k,2190) - lu(k,1714) * lu(k,2168) + lu(k,2191) = lu(k,2191) - lu(k,1715) * lu(k,2168) + lu(k,2988) = lu(k,2988) - lu(k,1711) * lu(k,2977) + lu(k,3028) = lu(k,3028) - lu(k,1712) * lu(k,2977) + lu(k,3029) = lu(k,3029) - lu(k,1713) * lu(k,2977) + lu(k,3030) = lu(k,3030) - lu(k,1714) * lu(k,2977) + lu(k,3031) = lu(k,3031) - lu(k,1715) * lu(k,2977) + lu(k,3089) = lu(k,3089) - lu(k,1711) * lu(k,3077) + lu(k,3131) = lu(k,3131) - lu(k,1712) * lu(k,3077) + lu(k,3132) = lu(k,3132) - lu(k,1713) * lu(k,3077) + lu(k,3133) = lu(k,3133) - lu(k,1714) * lu(k,3077) + lu(k,3134) = lu(k,3134) - lu(k,1715) * lu(k,3077) + lu(k,3270) = lu(k,3270) - lu(k,1711) * lu(k,3258) + lu(k,3313) = lu(k,3313) - lu(k,1712) * lu(k,3258) + lu(k,3314) = lu(k,3314) - lu(k,1713) * lu(k,3258) + lu(k,3315) = lu(k,3315) - lu(k,1714) * lu(k,3258) + lu(k,3316) = lu(k,3316) - lu(k,1715) * lu(k,3258) + lu(k,3526) = lu(k,3526) - lu(k,1711) * lu(k,3514) + lu(k,3569) = lu(k,3569) - lu(k,1712) * lu(k,3514) + lu(k,3570) = lu(k,3570) - lu(k,1713) * lu(k,3514) + lu(k,3571) = lu(k,3571) - lu(k,1714) * lu(k,3514) + lu(k,3572) = lu(k,3572) - lu(k,1715) * lu(k,3514) + lu(k,3777) = lu(k,3777) - lu(k,1711) * lu(k,3765) + lu(k,3819) = lu(k,3819) - lu(k,1712) * lu(k,3765) + lu(k,3820) = lu(k,3820) - lu(k,1713) * lu(k,3765) + lu(k,3821) = lu(k,3821) - lu(k,1714) * lu(k,3765) + lu(k,3822) = lu(k,3822) - lu(k,1715) * lu(k,3765) + lu(k,3848) = lu(k,3848) - lu(k,1711) * lu(k,3847) + lu(k,3860) = lu(k,3860) - lu(k,1712) * lu(k,3847) + lu(k,3861) = lu(k,3861) - lu(k,1713) * lu(k,3847) + lu(k,3862) = lu(k,3862) - lu(k,1714) * lu(k,3847) + lu(k,3863) = lu(k,3863) - lu(k,1715) * lu(k,3847) + lu(k,3911) = lu(k,3911) - lu(k,1711) * lu(k,3901) + lu(k,3954) = lu(k,3954) - lu(k,1712) * lu(k,3901) + lu(k,3955) = lu(k,3955) - lu(k,1713) * lu(k,3901) + lu(k,3956) = lu(k,3956) - lu(k,1714) * lu(k,3901) + lu(k,3957) = lu(k,3957) - lu(k,1715) * lu(k,3901) + lu(k,4005) = lu(k,4005) - lu(k,1711) * lu(k,3993) + lu(k,4046) = lu(k,4046) - lu(k,1712) * lu(k,3993) + lu(k,4047) = lu(k,4047) - lu(k,1713) * lu(k,3993) + lu(k,4048) = lu(k,4048) - lu(k,1714) * lu(k,3993) + lu(k,4049) = lu(k,4049) - lu(k,1715) * lu(k,3993) + lu(k,1716) = 1._r8 / lu(k,1716) + lu(k,1717) = lu(k,1717) * lu(k,1716) + lu(k,1718) = lu(k,1718) * lu(k,1716) + lu(k,1719) = lu(k,1719) * lu(k,1716) + lu(k,1720) = lu(k,1720) * lu(k,1716) + lu(k,1721) = lu(k,1721) * lu(k,1716) + lu(k,1722) = lu(k,1722) * lu(k,1716) + lu(k,1723) = lu(k,1723) * lu(k,1716) + lu(k,2234) = lu(k,2234) - lu(k,1717) * lu(k,2233) + lu(k,2239) = lu(k,2239) - lu(k,1718) * lu(k,2233) + lu(k,2241) = lu(k,2241) - lu(k,1719) * lu(k,2233) + lu(k,2246) = lu(k,2246) - lu(k,1720) * lu(k,2233) + lu(k,2249) = lu(k,2249) - lu(k,1721) * lu(k,2233) + lu(k,2250) = lu(k,2250) - lu(k,1722) * lu(k,2233) + lu(k,2251) = lu(k,2251) - lu(k,1723) * lu(k,2233) + lu(k,2408) = lu(k,2408) - lu(k,1717) * lu(k,2407) + lu(k,2415) = lu(k,2415) - lu(k,1718) * lu(k,2407) + lu(k,2417) = lu(k,2417) - lu(k,1719) * lu(k,2407) + lu(k,2422) = lu(k,2422) - lu(k,1720) * lu(k,2407) + lu(k,2425) = lu(k,2425) - lu(k,1721) * lu(k,2407) + lu(k,2426) = lu(k,2426) - lu(k,1722) * lu(k,2407) + lu(k,2427) = lu(k,2427) - lu(k,1723) * lu(k,2407) + lu(k,2435) = - lu(k,1717) * lu(k,2434) + lu(k,2440) = - lu(k,1718) * lu(k,2434) + lu(k,2442) = - lu(k,1719) * lu(k,2434) + lu(k,2445) = - lu(k,1720) * lu(k,2434) + lu(k,2448) = lu(k,2448) - lu(k,1721) * lu(k,2434) + lu(k,2449) = lu(k,2449) - lu(k,1722) * lu(k,2434) + lu(k,2450) = - lu(k,1723) * lu(k,2434) + lu(k,2462) = lu(k,2462) - lu(k,1717) * lu(k,2461) + lu(k,2469) = lu(k,2469) - lu(k,1718) * lu(k,2461) + lu(k,2471) = lu(k,2471) - lu(k,1719) * lu(k,2461) + lu(k,2476) = lu(k,2476) - lu(k,1720) * lu(k,2461) + lu(k,2479) = lu(k,2479) - lu(k,1721) * lu(k,2461) + lu(k,2480) = lu(k,2480) - lu(k,1722) * lu(k,2461) + lu(k,2481) = lu(k,2481) - lu(k,1723) * lu(k,2461) + lu(k,2528) = lu(k,2528) - lu(k,1717) * lu(k,2527) + lu(k,2532) = lu(k,2532) - lu(k,1718) * lu(k,2527) + lu(k,2534) = lu(k,2534) - lu(k,1719) * lu(k,2527) + lu(k,2539) = lu(k,2539) - lu(k,1720) * lu(k,2527) + lu(k,2542) = lu(k,2542) - lu(k,1721) * lu(k,2527) + lu(k,2543) = lu(k,2543) - lu(k,1722) * lu(k,2527) + lu(k,2544) = lu(k,2544) - lu(k,1723) * lu(k,2527) + lu(k,2661) = lu(k,2661) - lu(k,1717) * lu(k,2660) + lu(k,2665) = - lu(k,1718) * lu(k,2660) + lu(k,2667) = lu(k,2667) - lu(k,1719) * lu(k,2660) + lu(k,2672) = - lu(k,1720) * lu(k,2660) + lu(k,2675) = lu(k,2675) - lu(k,1721) * lu(k,2660) + lu(k,2676) = lu(k,2676) - lu(k,1722) * lu(k,2660) + lu(k,2678) = lu(k,2678) - lu(k,1723) * lu(k,2660) + lu(k,2748) = lu(k,2748) - lu(k,1717) * lu(k,2747) + lu(k,2751) = lu(k,2751) - lu(k,1718) * lu(k,2747) + lu(k,2753) = lu(k,2753) - lu(k,1719) * lu(k,2747) + lu(k,2758) = - lu(k,1720) * lu(k,2747) + lu(k,2761) = lu(k,2761) - lu(k,1721) * lu(k,2747) + lu(k,2762) = lu(k,2762) - lu(k,1722) * lu(k,2747) + lu(k,2763) = lu(k,2763) - lu(k,1723) * lu(k,2747) + lu(k,2833) = lu(k,2833) - lu(k,1717) * lu(k,2832) + lu(k,2850) = lu(k,2850) - lu(k,1718) * lu(k,2832) + lu(k,2853) = lu(k,2853) - lu(k,1719) * lu(k,2832) + lu(k,2860) = lu(k,2860) - lu(k,1720) * lu(k,2832) + lu(k,2863) = lu(k,2863) - lu(k,1721) * lu(k,2832) + lu(k,2864) = lu(k,2864) - lu(k,1722) * lu(k,2832) + lu(k,2866) = lu(k,2866) - lu(k,1723) * lu(k,2832) + lu(k,2880) = lu(k,2880) - lu(k,1717) * lu(k,2879) + lu(k,2897) = lu(k,2897) - lu(k,1718) * lu(k,2879) + lu(k,2900) = lu(k,2900) - lu(k,1719) * lu(k,2879) + lu(k,2907) = lu(k,2907) - lu(k,1720) * lu(k,2879) + lu(k,2910) = lu(k,2910) - lu(k,1721) * lu(k,2879) + lu(k,2911) = lu(k,2911) - lu(k,1722) * lu(k,2879) + lu(k,2913) = lu(k,2913) - lu(k,1723) * lu(k,2879) + lu(k,2926) = lu(k,2926) - lu(k,1717) * lu(k,2925) + lu(k,2943) = lu(k,2943) - lu(k,1718) * lu(k,2925) + lu(k,2946) = lu(k,2946) - lu(k,1719) * lu(k,2925) + lu(k,2953) = lu(k,2953) - lu(k,1720) * lu(k,2925) + lu(k,2956) = lu(k,2956) - lu(k,1721) * lu(k,2925) + lu(k,2957) = lu(k,2957) - lu(k,1722) * lu(k,2925) + lu(k,2959) = lu(k,2959) - lu(k,1723) * lu(k,2925) + lu(k,2988) = lu(k,2988) - lu(k,1717) * lu(k,2978) + lu(k,3017) = lu(k,3017) - lu(k,1718) * lu(k,2978) + lu(k,3020) = lu(k,3020) - lu(k,1719) * lu(k,2978) + lu(k,3027) = lu(k,3027) - lu(k,1720) * lu(k,2978) + lu(k,3030) = lu(k,3030) - lu(k,1721) * lu(k,2978) + lu(k,3031) = lu(k,3031) - lu(k,1722) * lu(k,2978) + lu(k,3033) = lu(k,3033) - lu(k,1723) * lu(k,2978) + lu(k,3089) = lu(k,3089) - lu(k,1717) * lu(k,3078) + lu(k,3120) = - lu(k,1718) * lu(k,3078) + lu(k,3123) = lu(k,3123) - lu(k,1719) * lu(k,3078) + lu(k,3130) = lu(k,3130) - lu(k,1720) * lu(k,3078) + lu(k,3133) = lu(k,3133) - lu(k,1721) * lu(k,3078) + lu(k,3134) = lu(k,3134) - lu(k,1722) * lu(k,3078) + lu(k,3136) = lu(k,3136) - lu(k,1723) * lu(k,3078) + lu(k,3270) = lu(k,3270) - lu(k,1717) * lu(k,3259) + lu(k,3302) = lu(k,3302) - lu(k,1718) * lu(k,3259) + lu(k,3305) = lu(k,3305) - lu(k,1719) * lu(k,3259) + lu(k,3312) = lu(k,3312) - lu(k,1720) * lu(k,3259) + lu(k,3315) = lu(k,3315) - lu(k,1721) * lu(k,3259) + lu(k,3316) = lu(k,3316) - lu(k,1722) * lu(k,3259) + lu(k,3318) = lu(k,3318) - lu(k,1723) * lu(k,3259) + lu(k,3526) = lu(k,3526) - lu(k,1717) * lu(k,3515) + lu(k,3558) = lu(k,3558) - lu(k,1718) * lu(k,3515) + lu(k,3561) = lu(k,3561) - lu(k,1719) * lu(k,3515) + lu(k,3568) = lu(k,3568) - lu(k,1720) * lu(k,3515) + lu(k,3571) = lu(k,3571) - lu(k,1721) * lu(k,3515) + lu(k,3572) = lu(k,3572) - lu(k,1722) * lu(k,3515) + lu(k,3574) = lu(k,3574) - lu(k,1723) * lu(k,3515) + lu(k,3777) = lu(k,3777) - lu(k,1717) * lu(k,3766) + lu(k,3808) = lu(k,3808) - lu(k,1718) * lu(k,3766) + lu(k,3811) = lu(k,3811) - lu(k,1719) * lu(k,3766) + lu(k,3818) = lu(k,3818) - lu(k,1720) * lu(k,3766) + lu(k,3821) = lu(k,3821) - lu(k,1721) * lu(k,3766) + lu(k,3822) = lu(k,3822) - lu(k,1722) * lu(k,3766) + lu(k,3824) = lu(k,3824) - lu(k,1723) * lu(k,3766) + lu(k,3911) = lu(k,3911) - lu(k,1717) * lu(k,3902) + lu(k,3943) = lu(k,3943) - lu(k,1718) * lu(k,3902) + lu(k,3946) = lu(k,3946) - lu(k,1719) * lu(k,3902) + lu(k,3953) = lu(k,3953) - lu(k,1720) * lu(k,3902) + lu(k,3956) = lu(k,3956) - lu(k,1721) * lu(k,3902) + lu(k,3957) = lu(k,3957) - lu(k,1722) * lu(k,3902) + lu(k,3959) = lu(k,3959) - lu(k,1723) * lu(k,3902) + lu(k,4005) = lu(k,4005) - lu(k,1717) * lu(k,3994) + lu(k,4035) = lu(k,4035) - lu(k,1718) * lu(k,3994) + lu(k,4038) = lu(k,4038) - lu(k,1719) * lu(k,3994) + lu(k,4045) = lu(k,4045) - lu(k,1720) * lu(k,3994) + lu(k,4048) = lu(k,4048) - lu(k,1721) * lu(k,3994) + lu(k,4049) = lu(k,4049) - lu(k,1722) * lu(k,3994) + lu(k,4051) = lu(k,4051) - lu(k,1723) * lu(k,3994) + lu(k,1725) = 1._r8 / lu(k,1725) + lu(k,1726) = lu(k,1726) * lu(k,1725) + lu(k,1727) = lu(k,1727) * lu(k,1725) + lu(k,1728) = lu(k,1728) * lu(k,1725) + lu(k,1729) = lu(k,1729) * lu(k,1725) + lu(k,1730) = lu(k,1730) * lu(k,1725) + lu(k,1731) = lu(k,1731) * lu(k,1725) + lu(k,1732) = lu(k,1732) * lu(k,1725) + lu(k,1733) = lu(k,1733) * lu(k,1725) + lu(k,1790) = lu(k,1790) - lu(k,1726) * lu(k,1789) + lu(k,1792) = lu(k,1792) - lu(k,1727) * lu(k,1789) + lu(k,1793) = lu(k,1793) - lu(k,1728) * lu(k,1789) + lu(k,1795) = lu(k,1795) - lu(k,1729) * lu(k,1789) + lu(k,1796) = lu(k,1796) - lu(k,1730) * lu(k,1789) + lu(k,1798) = lu(k,1798) - lu(k,1731) * lu(k,1789) + lu(k,1799) = lu(k,1799) - lu(k,1732) * lu(k,1789) + lu(k,1800) = lu(k,1800) - lu(k,1733) * lu(k,1789) + lu(k,1814) = lu(k,1814) - lu(k,1726) * lu(k,1813) + lu(k,1818) = lu(k,1818) - lu(k,1727) * lu(k,1813) + lu(k,1819) = lu(k,1819) - lu(k,1728) * lu(k,1813) + lu(k,1824) = lu(k,1824) - lu(k,1729) * lu(k,1813) + lu(k,1826) = lu(k,1826) - lu(k,1730) * lu(k,1813) + lu(k,1828) = lu(k,1828) - lu(k,1731) * lu(k,1813) + lu(k,1829) = lu(k,1829) - lu(k,1732) * lu(k,1813) + lu(k,1831) = lu(k,1831) - lu(k,1733) * lu(k,1813) + lu(k,1951) = lu(k,1951) - lu(k,1726) * lu(k,1949) + lu(k,1956) = lu(k,1956) - lu(k,1727) * lu(k,1949) + lu(k,1957) = lu(k,1957) - lu(k,1728) * lu(k,1949) + lu(k,1964) = lu(k,1964) - lu(k,1729) * lu(k,1949) + lu(k,1967) = lu(k,1967) - lu(k,1730) * lu(k,1949) + lu(k,1969) = lu(k,1969) - lu(k,1731) * lu(k,1949) + lu(k,1970) = lu(k,1970) - lu(k,1732) * lu(k,1949) + lu(k,1973) = lu(k,1973) - lu(k,1733) * lu(k,1949) + lu(k,1987) = lu(k,1987) - lu(k,1726) * lu(k,1986) + lu(k,1993) = lu(k,1993) - lu(k,1727) * lu(k,1986) + lu(k,1994) = lu(k,1994) - lu(k,1728) * lu(k,1986) + lu(k,2003) = lu(k,2003) - lu(k,1729) * lu(k,1986) + lu(k,2006) = lu(k,2006) - lu(k,1730) * lu(k,1986) + lu(k,2008) = lu(k,2008) - lu(k,1731) * lu(k,1986) + lu(k,2009) = lu(k,2009) - lu(k,1732) * lu(k,1986) + lu(k,2012) = lu(k,2012) - lu(k,1733) * lu(k,1986) + lu(k,2019) = lu(k,2019) - lu(k,1726) * lu(k,2018) + lu(k,2020) = lu(k,2020) - lu(k,1727) * lu(k,2018) + lu(k,2021) = lu(k,2021) - lu(k,1728) * lu(k,2018) + lu(k,2024) = lu(k,2024) - lu(k,1729) * lu(k,2018) + lu(k,2028) = lu(k,2028) - lu(k,1730) * lu(k,2018) + lu(k,2030) = lu(k,2030) - lu(k,1731) * lu(k,2018) + lu(k,2031) = lu(k,2031) - lu(k,1732) * lu(k,2018) + lu(k,2034) = lu(k,2034) - lu(k,1733) * lu(k,2018) + lu(k,2072) = lu(k,2072) - lu(k,1726) * lu(k,2071) + lu(k,2075) = lu(k,2075) - lu(k,1727) * lu(k,2071) + lu(k,2076) = lu(k,2076) - lu(k,1728) * lu(k,2071) + lu(k,2080) = lu(k,2080) - lu(k,1729) * lu(k,2071) + lu(k,2085) = lu(k,2085) - lu(k,1730) * lu(k,2071) + lu(k,2087) = lu(k,2087) - lu(k,1731) * lu(k,2071) + lu(k,2088) = lu(k,2088) - lu(k,1732) * lu(k,2071) + lu(k,2091) = lu(k,2091) - lu(k,1733) * lu(k,2071) + lu(k,2104) = lu(k,2104) - lu(k,1726) * lu(k,2103) + lu(k,2107) = lu(k,2107) - lu(k,1727) * lu(k,2103) + lu(k,2108) = lu(k,2108) - lu(k,1728) * lu(k,2103) + lu(k,2112) = lu(k,2112) - lu(k,1729) * lu(k,2103) + lu(k,2117) = lu(k,2117) - lu(k,1730) * lu(k,2103) + lu(k,2119) = lu(k,2119) - lu(k,1731) * lu(k,2103) + lu(k,2120) = lu(k,2120) - lu(k,1732) * lu(k,2103) + lu(k,2123) = lu(k,2123) - lu(k,1733) * lu(k,2103) + lu(k,2134) = lu(k,2134) - lu(k,1726) * lu(k,2133) + lu(k,2137) = lu(k,2137) - lu(k,1727) * lu(k,2133) + lu(k,2138) = lu(k,2138) - lu(k,1728) * lu(k,2133) + lu(k,2141) = lu(k,2141) - lu(k,1729) * lu(k,2133) + lu(k,2146) = lu(k,2146) - lu(k,1730) * lu(k,2133) + lu(k,2148) = lu(k,2148) - lu(k,1731) * lu(k,2133) + lu(k,2149) = lu(k,2149) - lu(k,1732) * lu(k,2133) + lu(k,2152) = lu(k,2152) - lu(k,1733) * lu(k,2133) + lu(k,2170) = lu(k,2170) - lu(k,1726) * lu(k,2169) + lu(k,2172) = lu(k,2172) - lu(k,1727) * lu(k,2169) + lu(k,2173) = lu(k,2173) - lu(k,1728) * lu(k,2169) + lu(k,2183) = lu(k,2183) - lu(k,1729) * lu(k,2169) + lu(k,2188) = lu(k,2188) - lu(k,1730) * lu(k,2169) + lu(k,2190) = lu(k,2190) - lu(k,1731) * lu(k,2169) + lu(k,2191) = lu(k,2191) - lu(k,1732) * lu(k,2169) + lu(k,2195) = lu(k,2195) - lu(k,1733) * lu(k,2169) + lu(k,2981) = lu(k,2981) - lu(k,1726) * lu(k,2979) + lu(k,2987) = lu(k,2987) - lu(k,1727) * lu(k,2979) + lu(k,2988) = lu(k,2988) - lu(k,1728) * lu(k,2979) + lu(k,3023) = lu(k,3023) - lu(k,1729) * lu(k,2979) + lu(k,3028) = lu(k,3028) - lu(k,1730) * lu(k,2979) + lu(k,3030) = lu(k,3030) - lu(k,1731) * lu(k,2979) + lu(k,3031) = lu(k,3031) - lu(k,1732) * lu(k,2979) + lu(k,3035) = lu(k,3035) - lu(k,1733) * lu(k,2979) + lu(k,3081) = lu(k,3081) - lu(k,1726) * lu(k,3079) + lu(k,3088) = lu(k,3088) - lu(k,1727) * lu(k,3079) + lu(k,3089) = lu(k,3089) - lu(k,1728) * lu(k,3079) + lu(k,3126) = lu(k,3126) - lu(k,1729) * lu(k,3079) + lu(k,3131) = lu(k,3131) - lu(k,1730) * lu(k,3079) + lu(k,3133) = lu(k,3133) - lu(k,1731) * lu(k,3079) + lu(k,3134) = lu(k,3134) - lu(k,1732) * lu(k,3079) + lu(k,3138) = lu(k,3138) - lu(k,1733) * lu(k,3079) + lu(k,3262) = lu(k,3262) - lu(k,1726) * lu(k,3260) + lu(k,3269) = lu(k,3269) - lu(k,1727) * lu(k,3260) + lu(k,3270) = lu(k,3270) - lu(k,1728) * lu(k,3260) + lu(k,3308) = lu(k,3308) - lu(k,1729) * lu(k,3260) + lu(k,3313) = lu(k,3313) - lu(k,1730) * lu(k,3260) + lu(k,3315) = lu(k,3315) - lu(k,1731) * lu(k,3260) + lu(k,3316) = lu(k,3316) - lu(k,1732) * lu(k,3260) + lu(k,3320) = lu(k,3320) - lu(k,1733) * lu(k,3260) + lu(k,3518) = lu(k,3518) - lu(k,1726) * lu(k,3516) + lu(k,3525) = lu(k,3525) - lu(k,1727) * lu(k,3516) + lu(k,3526) = lu(k,3526) - lu(k,1728) * lu(k,3516) + lu(k,3564) = lu(k,3564) - lu(k,1729) * lu(k,3516) + lu(k,3569) = lu(k,3569) - lu(k,1730) * lu(k,3516) + lu(k,3571) = lu(k,3571) - lu(k,1731) * lu(k,3516) + lu(k,3572) = lu(k,3572) - lu(k,1732) * lu(k,3516) + lu(k,3576) = lu(k,3576) - lu(k,1733) * lu(k,3516) + lu(k,3769) = lu(k,3769) - lu(k,1726) * lu(k,3767) + lu(k,3776) = lu(k,3776) - lu(k,1727) * lu(k,3767) + lu(k,3777) = lu(k,3777) - lu(k,1728) * lu(k,3767) + lu(k,3814) = lu(k,3814) - lu(k,1729) * lu(k,3767) + lu(k,3819) = lu(k,3819) - lu(k,1730) * lu(k,3767) + lu(k,3821) = lu(k,3821) - lu(k,1731) * lu(k,3767) + lu(k,3822) = lu(k,3822) - lu(k,1732) * lu(k,3767) + lu(k,3826) = lu(k,3826) - lu(k,1733) * lu(k,3767) + lu(k,3997) = lu(k,3997) - lu(k,1726) * lu(k,3995) + lu(k,4004) = lu(k,4004) - lu(k,1727) * lu(k,3995) + lu(k,4005) = lu(k,4005) - lu(k,1728) * lu(k,3995) + lu(k,4041) = lu(k,4041) - lu(k,1729) * lu(k,3995) + lu(k,4046) = lu(k,4046) - lu(k,1730) * lu(k,3995) + lu(k,4048) = lu(k,4048) - lu(k,1731) * lu(k,3995) + lu(k,4049) = lu(k,4049) - lu(k,1732) * lu(k,3995) + lu(k,4053) = lu(k,4053) - lu(k,1733) * lu(k,3995) + lu(k,1740) = 1._r8 / lu(k,1740) + lu(k,1741) = lu(k,1741) * lu(k,1740) + lu(k,1742) = lu(k,1742) * lu(k,1740) + lu(k,1743) = lu(k,1743) * lu(k,1740) + lu(k,1744) = lu(k,1744) * lu(k,1740) + lu(k,1745) = lu(k,1745) * lu(k,1740) + lu(k,1746) = lu(k,1746) * lu(k,1740) + lu(k,1747) = lu(k,1747) * lu(k,1740) + lu(k,1748) = lu(k,1748) * lu(k,1740) + lu(k,1749) = lu(k,1749) * lu(k,1740) + lu(k,1750) = lu(k,1750) * lu(k,1740) + lu(k,1751) = lu(k,1751) * lu(k,1740) + lu(k,1752) = lu(k,1752) * lu(k,1740) + lu(k,1753) = lu(k,1753) * lu(k,1740) + lu(k,1754) = lu(k,1754) * lu(k,1740) + lu(k,1755) = lu(k,1755) * lu(k,1740) + lu(k,1951) = lu(k,1951) - lu(k,1741) * lu(k,1950) + lu(k,1954) = - lu(k,1742) * lu(k,1950) + lu(k,1955) = lu(k,1955) - lu(k,1743) * lu(k,1950) + lu(k,1956) = lu(k,1956) - lu(k,1744) * lu(k,1950) + lu(k,1957) = lu(k,1957) - lu(k,1745) * lu(k,1950) + lu(k,1959) = lu(k,1959) - lu(k,1746) * lu(k,1950) + lu(k,1963) = - lu(k,1747) * lu(k,1950) + lu(k,1964) = lu(k,1964) - lu(k,1748) * lu(k,1950) + lu(k,1965) = lu(k,1965) - lu(k,1749) * lu(k,1950) + lu(k,1967) = lu(k,1967) - lu(k,1750) * lu(k,1950) + lu(k,1968) = lu(k,1968) - lu(k,1751) * lu(k,1950) + lu(k,1969) = lu(k,1969) - lu(k,1752) * lu(k,1950) + lu(k,1970) = lu(k,1970) - lu(k,1753) * lu(k,1950) + lu(k,1972) = lu(k,1972) - lu(k,1754) * lu(k,1950) + lu(k,1973) = lu(k,1973) - lu(k,1755) * lu(k,1950) + lu(k,2981) = lu(k,2981) - lu(k,1741) * lu(k,2980) + lu(k,2985) = lu(k,2985) - lu(k,1742) * lu(k,2980) + lu(k,2986) = - lu(k,1743) * lu(k,2980) + lu(k,2987) = lu(k,2987) - lu(k,1744) * lu(k,2980) + lu(k,2988) = lu(k,2988) - lu(k,1745) * lu(k,2980) + lu(k,2990) = lu(k,2990) - lu(k,1746) * lu(k,2980) + lu(k,2994) = - lu(k,1747) * lu(k,2980) + lu(k,3023) = lu(k,3023) - lu(k,1748) * lu(k,2980) + lu(k,3026) = lu(k,3026) - lu(k,1749) * lu(k,2980) + lu(k,3028) = lu(k,3028) - lu(k,1750) * lu(k,2980) + lu(k,3029) = lu(k,3029) - lu(k,1751) * lu(k,2980) + lu(k,3030) = lu(k,3030) - lu(k,1752) * lu(k,2980) + lu(k,3031) = lu(k,3031) - lu(k,1753) * lu(k,2980) + lu(k,3034) = lu(k,3034) - lu(k,1754) * lu(k,2980) + lu(k,3035) = lu(k,3035) - lu(k,1755) * lu(k,2980) + lu(k,3081) = lu(k,3081) - lu(k,1741) * lu(k,3080) + lu(k,3086) = - lu(k,1742) * lu(k,3080) + lu(k,3087) = - lu(k,1743) * lu(k,3080) + lu(k,3088) = lu(k,3088) - lu(k,1744) * lu(k,3080) + lu(k,3089) = lu(k,3089) - lu(k,1745) * lu(k,3080) + lu(k,3091) = lu(k,3091) - lu(k,1746) * lu(k,3080) + lu(k,3095) = lu(k,3095) - lu(k,1747) * lu(k,3080) + lu(k,3126) = lu(k,3126) - lu(k,1748) * lu(k,3080) + lu(k,3129) = lu(k,3129) - lu(k,1749) * lu(k,3080) + lu(k,3131) = lu(k,3131) - lu(k,1750) * lu(k,3080) + lu(k,3132) = lu(k,3132) - lu(k,1751) * lu(k,3080) + lu(k,3133) = lu(k,3133) - lu(k,1752) * lu(k,3080) + lu(k,3134) = lu(k,3134) - lu(k,1753) * lu(k,3080) + lu(k,3137) = lu(k,3137) - lu(k,1754) * lu(k,3080) + lu(k,3138) = lu(k,3138) - lu(k,1755) * lu(k,3080) + lu(k,3262) = lu(k,3262) - lu(k,1741) * lu(k,3261) + lu(k,3267) = lu(k,3267) - lu(k,1742) * lu(k,3261) + lu(k,3268) = - lu(k,1743) * lu(k,3261) + lu(k,3269) = lu(k,3269) - lu(k,1744) * lu(k,3261) + lu(k,3270) = lu(k,3270) - lu(k,1745) * lu(k,3261) + lu(k,3272) = lu(k,3272) - lu(k,1746) * lu(k,3261) + lu(k,3276) = lu(k,3276) - lu(k,1747) * lu(k,3261) + lu(k,3308) = lu(k,3308) - lu(k,1748) * lu(k,3261) + lu(k,3311) = lu(k,3311) - lu(k,1749) * lu(k,3261) + lu(k,3313) = lu(k,3313) - lu(k,1750) * lu(k,3261) + lu(k,3314) = lu(k,3314) - lu(k,1751) * lu(k,3261) + lu(k,3315) = lu(k,3315) - lu(k,1752) * lu(k,3261) + lu(k,3316) = lu(k,3316) - lu(k,1753) * lu(k,3261) + lu(k,3319) = lu(k,3319) - lu(k,1754) * lu(k,3261) + lu(k,3320) = lu(k,3320) - lu(k,1755) * lu(k,3261) + lu(k,3518) = lu(k,3518) - lu(k,1741) * lu(k,3517) + lu(k,3523) = - lu(k,1742) * lu(k,3517) + lu(k,3524) = lu(k,3524) - lu(k,1743) * lu(k,3517) + lu(k,3525) = lu(k,3525) - lu(k,1744) * lu(k,3517) + lu(k,3526) = lu(k,3526) - lu(k,1745) * lu(k,3517) + lu(k,3528) = lu(k,3528) - lu(k,1746) * lu(k,3517) + lu(k,3532) = - lu(k,1747) * lu(k,3517) + lu(k,3564) = lu(k,3564) - lu(k,1748) * lu(k,3517) + lu(k,3567) = lu(k,3567) - lu(k,1749) * lu(k,3517) + lu(k,3569) = lu(k,3569) - lu(k,1750) * lu(k,3517) + lu(k,3570) = lu(k,3570) - lu(k,1751) * lu(k,3517) + lu(k,3571) = lu(k,3571) - lu(k,1752) * lu(k,3517) + lu(k,3572) = lu(k,3572) - lu(k,1753) * lu(k,3517) + lu(k,3575) = lu(k,3575) - lu(k,1754) * lu(k,3517) + lu(k,3576) = lu(k,3576) - lu(k,1755) * lu(k,3517) + lu(k,3769) = lu(k,3769) - lu(k,1741) * lu(k,3768) + lu(k,3774) = lu(k,3774) - lu(k,1742) * lu(k,3768) + lu(k,3775) = lu(k,3775) - lu(k,1743) * lu(k,3768) + lu(k,3776) = lu(k,3776) - lu(k,1744) * lu(k,3768) + lu(k,3777) = lu(k,3777) - lu(k,1745) * lu(k,3768) + lu(k,3779) = lu(k,3779) - lu(k,1746) * lu(k,3768) + lu(k,3783) = lu(k,3783) - lu(k,1747) * lu(k,3768) + lu(k,3814) = lu(k,3814) - lu(k,1748) * lu(k,3768) + lu(k,3817) = lu(k,3817) - lu(k,1749) * lu(k,3768) + lu(k,3819) = lu(k,3819) - lu(k,1750) * lu(k,3768) + lu(k,3820) = lu(k,3820) - lu(k,1751) * lu(k,3768) + lu(k,3821) = lu(k,3821) - lu(k,1752) * lu(k,3768) + lu(k,3822) = lu(k,3822) - lu(k,1753) * lu(k,3768) + lu(k,3825) = lu(k,3825) - lu(k,1754) * lu(k,3768) + lu(k,3826) = lu(k,3826) - lu(k,1755) * lu(k,3768) + lu(k,3904) = lu(k,3904) - lu(k,1741) * lu(k,3903) + lu(k,3908) = - lu(k,1742) * lu(k,3903) + lu(k,3909) = - lu(k,1743) * lu(k,3903) + lu(k,3910) = lu(k,3910) - lu(k,1744) * lu(k,3903) + lu(k,3911) = lu(k,3911) - lu(k,1745) * lu(k,3903) + lu(k,3913) = lu(k,3913) - lu(k,1746) * lu(k,3903) + lu(k,3917) = - lu(k,1747) * lu(k,3903) + lu(k,3949) = lu(k,3949) - lu(k,1748) * lu(k,3903) + lu(k,3952) = lu(k,3952) - lu(k,1749) * lu(k,3903) + lu(k,3954) = lu(k,3954) - lu(k,1750) * lu(k,3903) + lu(k,3955) = lu(k,3955) - lu(k,1751) * lu(k,3903) + lu(k,3956) = lu(k,3956) - lu(k,1752) * lu(k,3903) + lu(k,3957) = lu(k,3957) - lu(k,1753) * lu(k,3903) + lu(k,3960) = lu(k,3960) - lu(k,1754) * lu(k,3903) + lu(k,3961) = lu(k,3961) - lu(k,1755) * lu(k,3903) + lu(k,3997) = lu(k,3997) - lu(k,1741) * lu(k,3996) + lu(k,4002) = lu(k,4002) - lu(k,1742) * lu(k,3996) + lu(k,4003) = - lu(k,1743) * lu(k,3996) + lu(k,4004) = lu(k,4004) - lu(k,1744) * lu(k,3996) + lu(k,4005) = lu(k,4005) - lu(k,1745) * lu(k,3996) + lu(k,4007) = lu(k,4007) - lu(k,1746) * lu(k,3996) + lu(k,4011) = lu(k,4011) - lu(k,1747) * lu(k,3996) + lu(k,4041) = lu(k,4041) - lu(k,1748) * lu(k,3996) + lu(k,4044) = lu(k,4044) - lu(k,1749) * lu(k,3996) + lu(k,4046) = lu(k,4046) - lu(k,1750) * lu(k,3996) + lu(k,4047) = lu(k,4047) - lu(k,1751) * lu(k,3996) + lu(k,4048) = lu(k,4048) - lu(k,1752) * lu(k,3996) + lu(k,4049) = lu(k,4049) - lu(k,1753) * lu(k,3996) + lu(k,4052) = lu(k,4052) - lu(k,1754) * lu(k,3996) + lu(k,4053) = lu(k,4053) - lu(k,1755) * lu(k,3996) end do end subroutine lu_fac38 subroutine lu_fac39( avec_len, lu ) @@ -9151,488 +8494,526 @@ subroutine lu_fac39( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1801) = 1._r8 / lu(k,1801) - lu(k,1802) = lu(k,1802) * lu(k,1801) - lu(k,1803) = lu(k,1803) * lu(k,1801) - lu(k,1804) = lu(k,1804) * lu(k,1801) - lu(k,1805) = lu(k,1805) * lu(k,1801) - lu(k,1806) = lu(k,1806) * lu(k,1801) - lu(k,1807) = lu(k,1807) * lu(k,1801) - lu(k,1808) = lu(k,1808) * lu(k,1801) - lu(k,1809) = lu(k,1809) * lu(k,1801) - lu(k,1830) = lu(k,1830) - lu(k,1802) * lu(k,1828) - lu(k,1834) = lu(k,1834) - lu(k,1803) * lu(k,1828) - lu(k,1835) = lu(k,1835) - lu(k,1804) * lu(k,1828) - lu(k,1836) = lu(k,1836) - lu(k,1805) * lu(k,1828) - lu(k,1838) = lu(k,1838) - lu(k,1806) * lu(k,1828) - lu(k,1839) = lu(k,1839) - lu(k,1807) * lu(k,1828) - lu(k,1841) = lu(k,1841) - lu(k,1808) * lu(k,1828) - lu(k,1842) = lu(k,1842) - lu(k,1809) * lu(k,1828) - lu(k,1862) = lu(k,1862) - lu(k,1802) * lu(k,1861) - lu(k,1864) = lu(k,1864) - lu(k,1803) * lu(k,1861) - lu(k,1865) = lu(k,1865) - lu(k,1804) * lu(k,1861) - lu(k,1866) = lu(k,1866) - lu(k,1805) * lu(k,1861) - lu(k,1870) = lu(k,1870) - lu(k,1806) * lu(k,1861) - lu(k,1871) = lu(k,1871) - lu(k,1807) * lu(k,1861) - lu(k,1873) = lu(k,1873) - lu(k,1808) * lu(k,1861) - lu(k,1874) = lu(k,1874) - lu(k,1809) * lu(k,1861) - lu(k,1894) = lu(k,1894) - lu(k,1802) * lu(k,1892) - lu(k,1900) = lu(k,1900) - lu(k,1803) * lu(k,1892) - lu(k,1901) = lu(k,1901) - lu(k,1804) * lu(k,1892) - lu(k,1902) = lu(k,1902) - lu(k,1805) * lu(k,1892) - lu(k,1906) = lu(k,1906) - lu(k,1806) * lu(k,1892) - lu(k,1907) = lu(k,1907) - lu(k,1807) * lu(k,1892) - lu(k,1909) = lu(k,1909) - lu(k,1808) * lu(k,1892) - lu(k,1910) = lu(k,1910) - lu(k,1809) * lu(k,1892) - lu(k,1929) = lu(k,1929) - lu(k,1802) * lu(k,1928) - lu(k,1932) = lu(k,1932) - lu(k,1803) * lu(k,1928) - lu(k,1933) = lu(k,1933) - lu(k,1804) * lu(k,1928) - lu(k,1934) = lu(k,1934) - lu(k,1805) * lu(k,1928) - lu(k,1938) = lu(k,1938) - lu(k,1806) * lu(k,1928) - lu(k,1939) = lu(k,1939) - lu(k,1807) * lu(k,1928) - lu(k,1941) = lu(k,1941) - lu(k,1808) * lu(k,1928) - lu(k,1942) = lu(k,1942) - lu(k,1809) * lu(k,1928) - lu(k,1963) = lu(k,1963) - lu(k,1802) * lu(k,1962) - lu(k,1966) = lu(k,1966) - lu(k,1803) * lu(k,1962) - lu(k,1967) = lu(k,1967) - lu(k,1804) * lu(k,1962) - lu(k,1968) = lu(k,1968) - lu(k,1805) * lu(k,1962) - lu(k,1972) = lu(k,1972) - lu(k,1806) * lu(k,1962) - lu(k,1973) = lu(k,1973) - lu(k,1807) * lu(k,1962) - lu(k,1975) = lu(k,1975) - lu(k,1808) * lu(k,1962) - lu(k,1976) = lu(k,1976) - lu(k,1809) * lu(k,1962) - lu(k,1992) = lu(k,1992) - lu(k,1802) * lu(k,1991) - lu(k,1994) = lu(k,1994) - lu(k,1803) * lu(k,1991) - lu(k,1995) = lu(k,1995) - lu(k,1804) * lu(k,1991) - lu(k,1996) = lu(k,1996) - lu(k,1805) * lu(k,1991) - lu(k,2000) = lu(k,2000) - lu(k,1806) * lu(k,1991) - lu(k,2001) = lu(k,2001) - lu(k,1807) * lu(k,1991) - lu(k,2003) = lu(k,2003) - lu(k,1808) * lu(k,1991) - lu(k,2004) = lu(k,2004) - lu(k,1809) * lu(k,1991) - lu(k,2029) = lu(k,2029) - lu(k,1802) * lu(k,2028) - lu(k,2036) = lu(k,2036) - lu(k,1803) * lu(k,2028) - lu(k,2037) = lu(k,2037) - lu(k,1804) * lu(k,2028) - lu(k,2038) = lu(k,2038) - lu(k,1805) * lu(k,2028) - lu(k,2042) = lu(k,2042) - lu(k,1806) * lu(k,2028) - lu(k,2043) = lu(k,2043) - lu(k,1807) * lu(k,2028) - lu(k,2046) = lu(k,2046) - lu(k,1808) * lu(k,2028) - lu(k,2047) = lu(k,2047) - lu(k,1809) * lu(k,2028) - lu(k,2670) = lu(k,2670) - lu(k,1802) * lu(k,2668) - lu(k,2699) = lu(k,2699) - lu(k,1803) * lu(k,2668) - lu(k,2700) = lu(k,2700) - lu(k,1804) * lu(k,2668) - lu(k,2701) = lu(k,2701) - lu(k,1805) * lu(k,2668) - lu(k,2705) = lu(k,2705) - lu(k,1806) * lu(k,2668) - lu(k,2706) = lu(k,2706) - lu(k,1807) * lu(k,2668) - lu(k,2709) = lu(k,2709) - lu(k,1808) * lu(k,2668) - lu(k,2710) = lu(k,2710) - lu(k,1809) * lu(k,2668) - lu(k,2853) = lu(k,2853) - lu(k,1802) * lu(k,2851) - lu(k,2882) = lu(k,2882) - lu(k,1803) * lu(k,2851) - lu(k,2883) = lu(k,2883) - lu(k,1804) * lu(k,2851) - lu(k,2884) = lu(k,2884) - lu(k,1805) * lu(k,2851) - lu(k,2889) = lu(k,2889) - lu(k,1806) * lu(k,2851) - lu(k,2891) = lu(k,2891) - lu(k,1807) * lu(k,2851) - lu(k,2894) = lu(k,2894) - lu(k,1808) * lu(k,2851) - lu(k,2895) = lu(k,2895) - lu(k,1809) * lu(k,2851) - lu(k,2955) = lu(k,2955) - lu(k,1802) * lu(k,2953) - lu(k,2983) = lu(k,2983) - lu(k,1803) * lu(k,2953) - lu(k,2984) = lu(k,2984) - lu(k,1804) * lu(k,2953) - lu(k,2985) = lu(k,2985) - lu(k,1805) * lu(k,2953) - lu(k,2990) = lu(k,2990) - lu(k,1806) * lu(k,2953) - lu(k,2992) = lu(k,2992) - lu(k,1807) * lu(k,2953) - lu(k,2995) = lu(k,2995) - lu(k,1808) * lu(k,2953) - lu(k,2996) = lu(k,2996) - lu(k,1809) * lu(k,2953) - lu(k,3046) = lu(k,3046) - lu(k,1802) * lu(k,3044) - lu(k,3075) = lu(k,3075) - lu(k,1803) * lu(k,3044) - lu(k,3076) = lu(k,3076) - lu(k,1804) * lu(k,3044) - lu(k,3077) = lu(k,3077) - lu(k,1805) * lu(k,3044) - lu(k,3082) = lu(k,3082) - lu(k,1806) * lu(k,3044) - lu(k,3084) = lu(k,3084) - lu(k,1807) * lu(k,3044) - lu(k,3087) = lu(k,3087) - lu(k,1808) * lu(k,3044) - lu(k,3088) = lu(k,3088) - lu(k,1809) * lu(k,3044) - lu(k,3249) = lu(k,3249) - lu(k,1802) * lu(k,3247) - lu(k,3278) = lu(k,3278) - lu(k,1803) * lu(k,3247) - lu(k,3279) = lu(k,3279) - lu(k,1804) * lu(k,3247) - lu(k,3280) = lu(k,3280) - lu(k,1805) * lu(k,3247) - lu(k,3285) = lu(k,3285) - lu(k,1806) * lu(k,3247) - lu(k,3287) = lu(k,3287) - lu(k,1807) * lu(k,3247) - lu(k,3290) = lu(k,3290) - lu(k,1808) * lu(k,3247) - lu(k,3291) = lu(k,3291) - lu(k,1809) * lu(k,3247) - lu(k,3390) = lu(k,3390) - lu(k,1802) * lu(k,3388) - lu(k,3419) = lu(k,3419) - lu(k,1803) * lu(k,3388) - lu(k,3420) = lu(k,3420) - lu(k,1804) * lu(k,3388) - lu(k,3421) = lu(k,3421) - lu(k,1805) * lu(k,3388) - lu(k,3426) = lu(k,3426) - lu(k,1806) * lu(k,3388) - lu(k,3428) = lu(k,3428) - lu(k,1807) * lu(k,3388) - lu(k,3431) = lu(k,3431) - lu(k,1808) * lu(k,3388) - lu(k,3432) = lu(k,3432) - lu(k,1809) * lu(k,3388) - lu(k,3711) = lu(k,3711) - lu(k,1802) * lu(k,3709) - lu(k,3739) = lu(k,3739) - lu(k,1803) * lu(k,3709) - lu(k,3740) = lu(k,3740) - lu(k,1804) * lu(k,3709) - lu(k,3741) = lu(k,3741) - lu(k,1805) * lu(k,3709) - lu(k,3746) = lu(k,3746) - lu(k,1806) * lu(k,3709) - lu(k,3748) = lu(k,3748) - lu(k,1807) * lu(k,3709) - lu(k,3751) = lu(k,3751) - lu(k,1808) * lu(k,3709) - lu(k,3752) = lu(k,3752) - lu(k,1809) * lu(k,3709) - lu(k,1829) = 1._r8 / lu(k,1829) - lu(k,1830) = lu(k,1830) * lu(k,1829) - lu(k,1831) = lu(k,1831) * lu(k,1829) - lu(k,1832) = lu(k,1832) * lu(k,1829) - lu(k,1833) = lu(k,1833) * lu(k,1829) - lu(k,1834) = lu(k,1834) * lu(k,1829) - lu(k,1835) = lu(k,1835) * lu(k,1829) - lu(k,1836) = lu(k,1836) * lu(k,1829) - lu(k,1837) = lu(k,1837) * lu(k,1829) - lu(k,1838) = lu(k,1838) * lu(k,1829) - lu(k,1839) = lu(k,1839) * lu(k,1829) - lu(k,1840) = lu(k,1840) * lu(k,1829) - lu(k,1841) = lu(k,1841) * lu(k,1829) - lu(k,1842) = lu(k,1842) * lu(k,1829) - lu(k,1843) = lu(k,1843) * lu(k,1829) - lu(k,1894) = lu(k,1894) - lu(k,1830) * lu(k,1893) - lu(k,1895) = lu(k,1895) - lu(k,1831) * lu(k,1893) - lu(k,1896) = lu(k,1896) - lu(k,1832) * lu(k,1893) - lu(k,1898) = - lu(k,1833) * lu(k,1893) - lu(k,1900) = lu(k,1900) - lu(k,1834) * lu(k,1893) - lu(k,1901) = lu(k,1901) - lu(k,1835) * lu(k,1893) - lu(k,1902) = lu(k,1902) - lu(k,1836) * lu(k,1893) - lu(k,1903) = lu(k,1903) - lu(k,1837) * lu(k,1893) - lu(k,1906) = lu(k,1906) - lu(k,1838) * lu(k,1893) - lu(k,1907) = lu(k,1907) - lu(k,1839) * lu(k,1893) - lu(k,1908) = lu(k,1908) - lu(k,1840) * lu(k,1893) - lu(k,1909) = lu(k,1909) - lu(k,1841) * lu(k,1893) - lu(k,1910) = lu(k,1910) - lu(k,1842) * lu(k,1893) - lu(k,1911) = lu(k,1911) - lu(k,1843) * lu(k,1893) - lu(k,2670) = lu(k,2670) - lu(k,1830) * lu(k,2669) - lu(k,2671) = lu(k,2671) - lu(k,1831) * lu(k,2669) - lu(k,2672) = lu(k,2672) - lu(k,1832) * lu(k,2669) - lu(k,2674) = lu(k,2674) - lu(k,1833) * lu(k,2669) - lu(k,2699) = lu(k,2699) - lu(k,1834) * lu(k,2669) - lu(k,2700) = lu(k,2700) - lu(k,1835) * lu(k,2669) - lu(k,2701) = lu(k,2701) - lu(k,1836) * lu(k,2669) - lu(k,2702) = lu(k,2702) - lu(k,1837) * lu(k,2669) - lu(k,2705) = lu(k,2705) - lu(k,1838) * lu(k,2669) - lu(k,2706) = lu(k,2706) - lu(k,1839) * lu(k,2669) - lu(k,2707) = lu(k,2707) - lu(k,1840) * lu(k,2669) - lu(k,2709) = lu(k,2709) - lu(k,1841) * lu(k,2669) - lu(k,2710) = lu(k,2710) - lu(k,1842) * lu(k,2669) - lu(k,2713) = lu(k,2713) - lu(k,1843) * lu(k,2669) - lu(k,2853) = lu(k,2853) - lu(k,1830) * lu(k,2852) - lu(k,2854) = lu(k,2854) - lu(k,1831) * lu(k,2852) - lu(k,2855) = lu(k,2855) - lu(k,1832) * lu(k,2852) - lu(k,2857) = lu(k,2857) - lu(k,1833) * lu(k,2852) - lu(k,2882) = lu(k,2882) - lu(k,1834) * lu(k,2852) - lu(k,2883) = lu(k,2883) - lu(k,1835) * lu(k,2852) - lu(k,2884) = lu(k,2884) - lu(k,1836) * lu(k,2852) - lu(k,2885) = lu(k,2885) - lu(k,1837) * lu(k,2852) - lu(k,2889) = lu(k,2889) - lu(k,1838) * lu(k,2852) - lu(k,2891) = lu(k,2891) - lu(k,1839) * lu(k,2852) - lu(k,2892) = lu(k,2892) - lu(k,1840) * lu(k,2852) - lu(k,2894) = lu(k,2894) - lu(k,1841) * lu(k,2852) - lu(k,2895) = lu(k,2895) - lu(k,1842) * lu(k,2852) - lu(k,2899) = lu(k,2899) - lu(k,1843) * lu(k,2852) - lu(k,2955) = lu(k,2955) - lu(k,1830) * lu(k,2954) - lu(k,2956) = lu(k,2956) - lu(k,1831) * lu(k,2954) - lu(k,2957) = lu(k,2957) - lu(k,1832) * lu(k,2954) - lu(k,2959) = lu(k,2959) - lu(k,1833) * lu(k,2954) - lu(k,2983) = lu(k,2983) - lu(k,1834) * lu(k,2954) - lu(k,2984) = lu(k,2984) - lu(k,1835) * lu(k,2954) - lu(k,2985) = lu(k,2985) - lu(k,1836) * lu(k,2954) - lu(k,2986) = lu(k,2986) - lu(k,1837) * lu(k,2954) - lu(k,2990) = lu(k,2990) - lu(k,1838) * lu(k,2954) - lu(k,2992) = lu(k,2992) - lu(k,1839) * lu(k,2954) - lu(k,2993) = lu(k,2993) - lu(k,1840) * lu(k,2954) - lu(k,2995) = lu(k,2995) - lu(k,1841) * lu(k,2954) - lu(k,2996) = lu(k,2996) - lu(k,1842) * lu(k,2954) - lu(k,3000) = lu(k,3000) - lu(k,1843) * lu(k,2954) - lu(k,3046) = lu(k,3046) - lu(k,1830) * lu(k,3045) - lu(k,3047) = lu(k,3047) - lu(k,1831) * lu(k,3045) - lu(k,3048) = lu(k,3048) - lu(k,1832) * lu(k,3045) - lu(k,3050) = lu(k,3050) - lu(k,1833) * lu(k,3045) - lu(k,3075) = lu(k,3075) - lu(k,1834) * lu(k,3045) - lu(k,3076) = lu(k,3076) - lu(k,1835) * lu(k,3045) - lu(k,3077) = lu(k,3077) - lu(k,1836) * lu(k,3045) - lu(k,3078) = lu(k,3078) - lu(k,1837) * lu(k,3045) - lu(k,3082) = lu(k,3082) - lu(k,1838) * lu(k,3045) - lu(k,3084) = lu(k,3084) - lu(k,1839) * lu(k,3045) - lu(k,3085) = lu(k,3085) - lu(k,1840) * lu(k,3045) - lu(k,3087) = lu(k,3087) - lu(k,1841) * lu(k,3045) - lu(k,3088) = lu(k,3088) - lu(k,1842) * lu(k,3045) - lu(k,3092) = lu(k,3092) - lu(k,1843) * lu(k,3045) - lu(k,3249) = lu(k,3249) - lu(k,1830) * lu(k,3248) - lu(k,3250) = lu(k,3250) - lu(k,1831) * lu(k,3248) - lu(k,3251) = lu(k,3251) - lu(k,1832) * lu(k,3248) - lu(k,3253) = lu(k,3253) - lu(k,1833) * lu(k,3248) - lu(k,3278) = lu(k,3278) - lu(k,1834) * lu(k,3248) - lu(k,3279) = lu(k,3279) - lu(k,1835) * lu(k,3248) - lu(k,3280) = lu(k,3280) - lu(k,1836) * lu(k,3248) - lu(k,3281) = lu(k,3281) - lu(k,1837) * lu(k,3248) - lu(k,3285) = lu(k,3285) - lu(k,1838) * lu(k,3248) - lu(k,3287) = lu(k,3287) - lu(k,1839) * lu(k,3248) - lu(k,3288) = lu(k,3288) - lu(k,1840) * lu(k,3248) - lu(k,3290) = lu(k,3290) - lu(k,1841) * lu(k,3248) - lu(k,3291) = lu(k,3291) - lu(k,1842) * lu(k,3248) - lu(k,3295) = lu(k,3295) - lu(k,1843) * lu(k,3248) - lu(k,3390) = lu(k,3390) - lu(k,1830) * lu(k,3389) - lu(k,3391) = lu(k,3391) - lu(k,1831) * lu(k,3389) - lu(k,3392) = lu(k,3392) - lu(k,1832) * lu(k,3389) - lu(k,3394) = lu(k,3394) - lu(k,1833) * lu(k,3389) - lu(k,3419) = lu(k,3419) - lu(k,1834) * lu(k,3389) - lu(k,3420) = lu(k,3420) - lu(k,1835) * lu(k,3389) - lu(k,3421) = lu(k,3421) - lu(k,1836) * lu(k,3389) - lu(k,3422) = lu(k,3422) - lu(k,1837) * lu(k,3389) - lu(k,3426) = lu(k,3426) - lu(k,1838) * lu(k,3389) - lu(k,3428) = lu(k,3428) - lu(k,1839) * lu(k,3389) - lu(k,3429) = lu(k,3429) - lu(k,1840) * lu(k,3389) - lu(k,3431) = lu(k,3431) - lu(k,1841) * lu(k,3389) - lu(k,3432) = lu(k,3432) - lu(k,1842) * lu(k,3389) - lu(k,3436) = lu(k,3436) - lu(k,1843) * lu(k,3389) - lu(k,3711) = lu(k,3711) - lu(k,1830) * lu(k,3710) - lu(k,3712) = lu(k,3712) - lu(k,1831) * lu(k,3710) - lu(k,3713) = lu(k,3713) - lu(k,1832) * lu(k,3710) - lu(k,3715) = lu(k,3715) - lu(k,1833) * lu(k,3710) - lu(k,3739) = lu(k,3739) - lu(k,1834) * lu(k,3710) - lu(k,3740) = lu(k,3740) - lu(k,1835) * lu(k,3710) - lu(k,3741) = lu(k,3741) - lu(k,1836) * lu(k,3710) - lu(k,3742) = lu(k,3742) - lu(k,1837) * lu(k,3710) - lu(k,3746) = lu(k,3746) - lu(k,1838) * lu(k,3710) - lu(k,3748) = lu(k,3748) - lu(k,1839) * lu(k,3710) - lu(k,3749) = lu(k,3749) - lu(k,1840) * lu(k,3710) - lu(k,3751) = lu(k,3751) - lu(k,1841) * lu(k,3710) - lu(k,3752) = lu(k,3752) - lu(k,1842) * lu(k,3710) - lu(k,3756) = lu(k,3756) - lu(k,1843) * lu(k,3710) - lu(k,1845) = 1._r8 / lu(k,1845) - lu(k,1846) = lu(k,1846) * lu(k,1845) - lu(k,1847) = lu(k,1847) * lu(k,1845) - lu(k,1848) = lu(k,1848) * lu(k,1845) - lu(k,1849) = lu(k,1849) * lu(k,1845) - lu(k,1850) = lu(k,1850) * lu(k,1845) - lu(k,1851) = lu(k,1851) * lu(k,1845) - lu(k,1852) = lu(k,1852) * lu(k,1845) - lu(k,1864) = lu(k,1864) - lu(k,1846) * lu(k,1862) - lu(k,1865) = lu(k,1865) - lu(k,1847) * lu(k,1862) - lu(k,1866) = lu(k,1866) - lu(k,1848) * lu(k,1862) - lu(k,1869) = lu(k,1869) - lu(k,1849) * lu(k,1862) - lu(k,1870) = lu(k,1870) - lu(k,1850) * lu(k,1862) - lu(k,1874) = lu(k,1874) - lu(k,1851) * lu(k,1862) - lu(k,1875) = lu(k,1875) - lu(k,1852) * lu(k,1862) - lu(k,1900) = lu(k,1900) - lu(k,1846) * lu(k,1894) - lu(k,1901) = lu(k,1901) - lu(k,1847) * lu(k,1894) - lu(k,1902) = lu(k,1902) - lu(k,1848) * lu(k,1894) - lu(k,1905) = lu(k,1905) - lu(k,1849) * lu(k,1894) - lu(k,1906) = lu(k,1906) - lu(k,1850) * lu(k,1894) - lu(k,1910) = lu(k,1910) - lu(k,1851) * lu(k,1894) - lu(k,1911) = lu(k,1911) - lu(k,1852) * lu(k,1894) - lu(k,1932) = lu(k,1932) - lu(k,1846) * lu(k,1929) - lu(k,1933) = lu(k,1933) - lu(k,1847) * lu(k,1929) - lu(k,1934) = lu(k,1934) - lu(k,1848) * lu(k,1929) - lu(k,1937) = - lu(k,1849) * lu(k,1929) - lu(k,1938) = lu(k,1938) - lu(k,1850) * lu(k,1929) - lu(k,1942) = lu(k,1942) - lu(k,1851) * lu(k,1929) - lu(k,1945) = lu(k,1945) - lu(k,1852) * lu(k,1929) - lu(k,1966) = lu(k,1966) - lu(k,1846) * lu(k,1963) - lu(k,1967) = lu(k,1967) - lu(k,1847) * lu(k,1963) - lu(k,1968) = lu(k,1968) - lu(k,1848) * lu(k,1963) - lu(k,1971) = - lu(k,1849) * lu(k,1963) - lu(k,1972) = lu(k,1972) - lu(k,1850) * lu(k,1963) - lu(k,1976) = lu(k,1976) - lu(k,1851) * lu(k,1963) - lu(k,1979) = lu(k,1979) - lu(k,1852) * lu(k,1963) - lu(k,1994) = lu(k,1994) - lu(k,1846) * lu(k,1992) - lu(k,1995) = lu(k,1995) - lu(k,1847) * lu(k,1992) - lu(k,1996) = lu(k,1996) - lu(k,1848) * lu(k,1992) - lu(k,1999) = - lu(k,1849) * lu(k,1992) - lu(k,2000) = lu(k,2000) - lu(k,1850) * lu(k,1992) - lu(k,2004) = lu(k,2004) - lu(k,1851) * lu(k,1992) - lu(k,2007) = lu(k,2007) - lu(k,1852) * lu(k,1992) - lu(k,2036) = lu(k,2036) - lu(k,1846) * lu(k,2029) - lu(k,2037) = lu(k,2037) - lu(k,1847) * lu(k,2029) - lu(k,2038) = lu(k,2038) - lu(k,1848) * lu(k,2029) - lu(k,2041) = lu(k,2041) - lu(k,1849) * lu(k,2029) - lu(k,2042) = lu(k,2042) - lu(k,1850) * lu(k,2029) - lu(k,2047) = lu(k,2047) - lu(k,1851) * lu(k,2029) - lu(k,2050) = lu(k,2050) - lu(k,1852) * lu(k,2029) - lu(k,2142) = lu(k,2142) - lu(k,1846) * lu(k,2140) - lu(k,2143) = - lu(k,1847) * lu(k,2140) - lu(k,2144) = - lu(k,1848) * lu(k,2140) - lu(k,2146) = - lu(k,1849) * lu(k,2140) - lu(k,2147) = lu(k,2147) - lu(k,1850) * lu(k,2140) - lu(k,2151) = lu(k,2151) - lu(k,1851) * lu(k,2140) - lu(k,2152) = lu(k,2152) - lu(k,1852) * lu(k,2140) - lu(k,2699) = lu(k,2699) - lu(k,1846) * lu(k,2670) - lu(k,2700) = lu(k,2700) - lu(k,1847) * lu(k,2670) - lu(k,2701) = lu(k,2701) - lu(k,1848) * lu(k,2670) - lu(k,2704) = lu(k,2704) - lu(k,1849) * lu(k,2670) - lu(k,2705) = lu(k,2705) - lu(k,1850) * lu(k,2670) - lu(k,2710) = lu(k,2710) - lu(k,1851) * lu(k,2670) - lu(k,2713) = lu(k,2713) - lu(k,1852) * lu(k,2670) - lu(k,2882) = lu(k,2882) - lu(k,1846) * lu(k,2853) - lu(k,2883) = lu(k,2883) - lu(k,1847) * lu(k,2853) - lu(k,2884) = lu(k,2884) - lu(k,1848) * lu(k,2853) - lu(k,2887) = lu(k,2887) - lu(k,1849) * lu(k,2853) - lu(k,2889) = lu(k,2889) - lu(k,1850) * lu(k,2853) - lu(k,2895) = lu(k,2895) - lu(k,1851) * lu(k,2853) - lu(k,2899) = lu(k,2899) - lu(k,1852) * lu(k,2853) - lu(k,2983) = lu(k,2983) - lu(k,1846) * lu(k,2955) - lu(k,2984) = lu(k,2984) - lu(k,1847) * lu(k,2955) - lu(k,2985) = lu(k,2985) - lu(k,1848) * lu(k,2955) - lu(k,2988) = lu(k,2988) - lu(k,1849) * lu(k,2955) - lu(k,2990) = lu(k,2990) - lu(k,1850) * lu(k,2955) - lu(k,2996) = lu(k,2996) - lu(k,1851) * lu(k,2955) - lu(k,3000) = lu(k,3000) - lu(k,1852) * lu(k,2955) - lu(k,3075) = lu(k,3075) - lu(k,1846) * lu(k,3046) - lu(k,3076) = lu(k,3076) - lu(k,1847) * lu(k,3046) - lu(k,3077) = lu(k,3077) - lu(k,1848) * lu(k,3046) - lu(k,3080) = lu(k,3080) - lu(k,1849) * lu(k,3046) - lu(k,3082) = lu(k,3082) - lu(k,1850) * lu(k,3046) - lu(k,3088) = lu(k,3088) - lu(k,1851) * lu(k,3046) - lu(k,3092) = lu(k,3092) - lu(k,1852) * lu(k,3046) - lu(k,3278) = lu(k,3278) - lu(k,1846) * lu(k,3249) - lu(k,3279) = lu(k,3279) - lu(k,1847) * lu(k,3249) - lu(k,3280) = lu(k,3280) - lu(k,1848) * lu(k,3249) - lu(k,3283) = lu(k,3283) - lu(k,1849) * lu(k,3249) - lu(k,3285) = lu(k,3285) - lu(k,1850) * lu(k,3249) - lu(k,3291) = lu(k,3291) - lu(k,1851) * lu(k,3249) - lu(k,3295) = lu(k,3295) - lu(k,1852) * lu(k,3249) - lu(k,3419) = lu(k,3419) - lu(k,1846) * lu(k,3390) - lu(k,3420) = lu(k,3420) - lu(k,1847) * lu(k,3390) - lu(k,3421) = lu(k,3421) - lu(k,1848) * lu(k,3390) - lu(k,3424) = lu(k,3424) - lu(k,1849) * lu(k,3390) - lu(k,3426) = lu(k,3426) - lu(k,1850) * lu(k,3390) - lu(k,3432) = lu(k,3432) - lu(k,1851) * lu(k,3390) - lu(k,3436) = lu(k,3436) - lu(k,1852) * lu(k,3390) - lu(k,3499) = lu(k,3499) - lu(k,1846) * lu(k,3493) - lu(k,3500) = lu(k,3500) - lu(k,1847) * lu(k,3493) - lu(k,3501) = lu(k,3501) - lu(k,1848) * lu(k,3493) - lu(k,3504) = lu(k,3504) - lu(k,1849) * lu(k,3493) - lu(k,3506) = lu(k,3506) - lu(k,1850) * lu(k,3493) - lu(k,3512) = lu(k,3512) - lu(k,1851) * lu(k,3493) - lu(k,3516) = lu(k,3516) - lu(k,1852) * lu(k,3493) - lu(k,3739) = lu(k,3739) - lu(k,1846) * lu(k,3711) - lu(k,3740) = lu(k,3740) - lu(k,1847) * lu(k,3711) - lu(k,3741) = lu(k,3741) - lu(k,1848) * lu(k,3711) - lu(k,3744) = lu(k,3744) - lu(k,1849) * lu(k,3711) - lu(k,3746) = lu(k,3746) - lu(k,1850) * lu(k,3711) - lu(k,3752) = lu(k,3752) - lu(k,1851) * lu(k,3711) - lu(k,3756) = lu(k,3756) - lu(k,1852) * lu(k,3711) - lu(k,1863) = 1._r8 / lu(k,1863) - lu(k,1864) = lu(k,1864) * lu(k,1863) - lu(k,1865) = lu(k,1865) * lu(k,1863) - lu(k,1866) = lu(k,1866) * lu(k,1863) - lu(k,1867) = lu(k,1867) * lu(k,1863) - lu(k,1868) = lu(k,1868) * lu(k,1863) - lu(k,1869) = lu(k,1869) * lu(k,1863) - lu(k,1870) = lu(k,1870) * lu(k,1863) - lu(k,1871) = lu(k,1871) * lu(k,1863) - lu(k,1872) = lu(k,1872) * lu(k,1863) - lu(k,1873) = lu(k,1873) * lu(k,1863) - lu(k,1874) = lu(k,1874) * lu(k,1863) - lu(k,1875) = lu(k,1875) * lu(k,1863) - lu(k,1900) = lu(k,1900) - lu(k,1864) * lu(k,1895) - lu(k,1901) = lu(k,1901) - lu(k,1865) * lu(k,1895) - lu(k,1902) = lu(k,1902) - lu(k,1866) * lu(k,1895) - lu(k,1903) = lu(k,1903) - lu(k,1867) * lu(k,1895) - lu(k,1904) = lu(k,1904) - lu(k,1868) * lu(k,1895) - lu(k,1905) = lu(k,1905) - lu(k,1869) * lu(k,1895) - lu(k,1906) = lu(k,1906) - lu(k,1870) * lu(k,1895) - lu(k,1907) = lu(k,1907) - lu(k,1871) * lu(k,1895) - lu(k,1908) = lu(k,1908) - lu(k,1872) * lu(k,1895) - lu(k,1909) = lu(k,1909) - lu(k,1873) * lu(k,1895) - lu(k,1910) = lu(k,1910) - lu(k,1874) * lu(k,1895) - lu(k,1911) = lu(k,1911) - lu(k,1875) * lu(k,1895) - lu(k,2036) = lu(k,2036) - lu(k,1864) * lu(k,2030) - lu(k,2037) = lu(k,2037) - lu(k,1865) * lu(k,2030) - lu(k,2038) = lu(k,2038) - lu(k,1866) * lu(k,2030) - lu(k,2039) = lu(k,2039) - lu(k,1867) * lu(k,2030) - lu(k,2040) = lu(k,2040) - lu(k,1868) * lu(k,2030) - lu(k,2041) = lu(k,2041) - lu(k,1869) * lu(k,2030) - lu(k,2042) = lu(k,2042) - lu(k,1870) * lu(k,2030) - lu(k,2043) = lu(k,2043) - lu(k,1871) * lu(k,2030) - lu(k,2044) = lu(k,2044) - lu(k,1872) * lu(k,2030) - lu(k,2046) = lu(k,2046) - lu(k,1873) * lu(k,2030) - lu(k,2047) = lu(k,2047) - lu(k,1874) * lu(k,2030) - lu(k,2050) = lu(k,2050) - lu(k,1875) * lu(k,2030) - lu(k,2699) = lu(k,2699) - lu(k,1864) * lu(k,2671) - lu(k,2700) = lu(k,2700) - lu(k,1865) * lu(k,2671) - lu(k,2701) = lu(k,2701) - lu(k,1866) * lu(k,2671) - lu(k,2702) = lu(k,2702) - lu(k,1867) * lu(k,2671) - lu(k,2703) = lu(k,2703) - lu(k,1868) * lu(k,2671) - lu(k,2704) = lu(k,2704) - lu(k,1869) * lu(k,2671) - lu(k,2705) = lu(k,2705) - lu(k,1870) * lu(k,2671) - lu(k,2706) = lu(k,2706) - lu(k,1871) * lu(k,2671) - lu(k,2707) = lu(k,2707) - lu(k,1872) * lu(k,2671) - lu(k,2709) = lu(k,2709) - lu(k,1873) * lu(k,2671) - lu(k,2710) = lu(k,2710) - lu(k,1874) * lu(k,2671) - lu(k,2713) = lu(k,2713) - lu(k,1875) * lu(k,2671) - lu(k,2882) = lu(k,2882) - lu(k,1864) * lu(k,2854) - lu(k,2883) = lu(k,2883) - lu(k,1865) * lu(k,2854) - lu(k,2884) = lu(k,2884) - lu(k,1866) * lu(k,2854) - lu(k,2885) = lu(k,2885) - lu(k,1867) * lu(k,2854) - lu(k,2886) = lu(k,2886) - lu(k,1868) * lu(k,2854) - lu(k,2887) = lu(k,2887) - lu(k,1869) * lu(k,2854) - lu(k,2889) = lu(k,2889) - lu(k,1870) * lu(k,2854) - lu(k,2891) = lu(k,2891) - lu(k,1871) * lu(k,2854) - lu(k,2892) = lu(k,2892) - lu(k,1872) * lu(k,2854) - lu(k,2894) = lu(k,2894) - lu(k,1873) * lu(k,2854) - lu(k,2895) = lu(k,2895) - lu(k,1874) * lu(k,2854) - lu(k,2899) = lu(k,2899) - lu(k,1875) * lu(k,2854) - lu(k,2983) = lu(k,2983) - lu(k,1864) * lu(k,2956) - lu(k,2984) = lu(k,2984) - lu(k,1865) * lu(k,2956) - lu(k,2985) = lu(k,2985) - lu(k,1866) * lu(k,2956) - lu(k,2986) = lu(k,2986) - lu(k,1867) * lu(k,2956) - lu(k,2987) = lu(k,2987) - lu(k,1868) * lu(k,2956) - lu(k,2988) = lu(k,2988) - lu(k,1869) * lu(k,2956) - lu(k,2990) = lu(k,2990) - lu(k,1870) * lu(k,2956) - lu(k,2992) = lu(k,2992) - lu(k,1871) * lu(k,2956) - lu(k,2993) = lu(k,2993) - lu(k,1872) * lu(k,2956) - lu(k,2995) = lu(k,2995) - lu(k,1873) * lu(k,2956) - lu(k,2996) = lu(k,2996) - lu(k,1874) * lu(k,2956) - lu(k,3000) = lu(k,3000) - lu(k,1875) * lu(k,2956) - lu(k,3075) = lu(k,3075) - lu(k,1864) * lu(k,3047) - lu(k,3076) = lu(k,3076) - lu(k,1865) * lu(k,3047) - lu(k,3077) = lu(k,3077) - lu(k,1866) * lu(k,3047) - lu(k,3078) = lu(k,3078) - lu(k,1867) * lu(k,3047) - lu(k,3079) = lu(k,3079) - lu(k,1868) * lu(k,3047) - lu(k,3080) = lu(k,3080) - lu(k,1869) * lu(k,3047) - lu(k,3082) = lu(k,3082) - lu(k,1870) * lu(k,3047) - lu(k,3084) = lu(k,3084) - lu(k,1871) * lu(k,3047) - lu(k,3085) = lu(k,3085) - lu(k,1872) * lu(k,3047) - lu(k,3087) = lu(k,3087) - lu(k,1873) * lu(k,3047) - lu(k,3088) = lu(k,3088) - lu(k,1874) * lu(k,3047) - lu(k,3092) = lu(k,3092) - lu(k,1875) * lu(k,3047) - lu(k,3278) = lu(k,3278) - lu(k,1864) * lu(k,3250) - lu(k,3279) = lu(k,3279) - lu(k,1865) * lu(k,3250) - lu(k,3280) = lu(k,3280) - lu(k,1866) * lu(k,3250) - lu(k,3281) = lu(k,3281) - lu(k,1867) * lu(k,3250) - lu(k,3282) = lu(k,3282) - lu(k,1868) * lu(k,3250) - lu(k,3283) = lu(k,3283) - lu(k,1869) * lu(k,3250) - lu(k,3285) = lu(k,3285) - lu(k,1870) * lu(k,3250) - lu(k,3287) = lu(k,3287) - lu(k,1871) * lu(k,3250) - lu(k,3288) = lu(k,3288) - lu(k,1872) * lu(k,3250) - lu(k,3290) = lu(k,3290) - lu(k,1873) * lu(k,3250) - lu(k,3291) = lu(k,3291) - lu(k,1874) * lu(k,3250) - lu(k,3295) = lu(k,3295) - lu(k,1875) * lu(k,3250) - lu(k,3419) = lu(k,3419) - lu(k,1864) * lu(k,3391) - lu(k,3420) = lu(k,3420) - lu(k,1865) * lu(k,3391) - lu(k,3421) = lu(k,3421) - lu(k,1866) * lu(k,3391) - lu(k,3422) = lu(k,3422) - lu(k,1867) * lu(k,3391) - lu(k,3423) = lu(k,3423) - lu(k,1868) * lu(k,3391) - lu(k,3424) = lu(k,3424) - lu(k,1869) * lu(k,3391) - lu(k,3426) = lu(k,3426) - lu(k,1870) * lu(k,3391) - lu(k,3428) = lu(k,3428) - lu(k,1871) * lu(k,3391) - lu(k,3429) = lu(k,3429) - lu(k,1872) * lu(k,3391) - lu(k,3431) = lu(k,3431) - lu(k,1873) * lu(k,3391) - lu(k,3432) = lu(k,3432) - lu(k,1874) * lu(k,3391) - lu(k,3436) = lu(k,3436) - lu(k,1875) * lu(k,3391) - lu(k,3739) = lu(k,3739) - lu(k,1864) * lu(k,3712) - lu(k,3740) = lu(k,3740) - lu(k,1865) * lu(k,3712) - lu(k,3741) = lu(k,3741) - lu(k,1866) * lu(k,3712) - lu(k,3742) = lu(k,3742) - lu(k,1867) * lu(k,3712) - lu(k,3743) = lu(k,3743) - lu(k,1868) * lu(k,3712) - lu(k,3744) = lu(k,3744) - lu(k,1869) * lu(k,3712) - lu(k,3746) = lu(k,3746) - lu(k,1870) * lu(k,3712) - lu(k,3748) = lu(k,3748) - lu(k,1871) * lu(k,3712) - lu(k,3749) = lu(k,3749) - lu(k,1872) * lu(k,3712) - lu(k,3751) = lu(k,3751) - lu(k,1873) * lu(k,3712) - lu(k,3752) = lu(k,3752) - lu(k,1874) * lu(k,3712) - lu(k,3756) = lu(k,3756) - lu(k,1875) * lu(k,3712) + lu(k,1756) = 1._r8 / lu(k,1756) + lu(k,1757) = lu(k,1757) * lu(k,1756) + lu(k,1758) = lu(k,1758) * lu(k,1756) + lu(k,1759) = lu(k,1759) * lu(k,1756) + lu(k,1760) = lu(k,1760) * lu(k,1756) + lu(k,1761) = lu(k,1761) * lu(k,1756) + lu(k,1772) = lu(k,1772) - lu(k,1757) * lu(k,1768) + lu(k,1776) = lu(k,1776) - lu(k,1758) * lu(k,1768) + lu(k,1778) = lu(k,1778) - lu(k,1759) * lu(k,1768) + lu(k,1780) = lu(k,1780) - lu(k,1760) * lu(k,1768) + lu(k,1781) = lu(k,1781) - lu(k,1761) * lu(k,1768) + lu(k,1792) = lu(k,1792) - lu(k,1757) * lu(k,1790) + lu(k,1795) = lu(k,1795) - lu(k,1758) * lu(k,1790) + lu(k,1796) = lu(k,1796) - lu(k,1759) * lu(k,1790) + lu(k,1798) = lu(k,1798) - lu(k,1760) * lu(k,1790) + lu(k,1799) = lu(k,1799) - lu(k,1761) * lu(k,1790) + lu(k,1818) = lu(k,1818) - lu(k,1757) * lu(k,1814) + lu(k,1824) = lu(k,1824) - lu(k,1758) * lu(k,1814) + lu(k,1826) = lu(k,1826) - lu(k,1759) * lu(k,1814) + lu(k,1828) = lu(k,1828) - lu(k,1760) * lu(k,1814) + lu(k,1829) = lu(k,1829) - lu(k,1761) * lu(k,1814) + lu(k,1849) = lu(k,1849) - lu(k,1757) * lu(k,1845) + lu(k,1855) = lu(k,1855) - lu(k,1758) * lu(k,1845) + lu(k,1857) = lu(k,1857) - lu(k,1759) * lu(k,1845) + lu(k,1859) = lu(k,1859) - lu(k,1760) * lu(k,1845) + lu(k,1860) = lu(k,1860) - lu(k,1761) * lu(k,1845) + lu(k,1871) = lu(k,1871) - lu(k,1757) * lu(k,1868) + lu(k,1874) = lu(k,1874) - lu(k,1758) * lu(k,1868) + lu(k,1876) = lu(k,1876) - lu(k,1759) * lu(k,1868) + lu(k,1878) = lu(k,1878) - lu(k,1760) * lu(k,1868) + lu(k,1879) = lu(k,1879) - lu(k,1761) * lu(k,1868) + lu(k,1895) = lu(k,1895) - lu(k,1757) * lu(k,1891) + lu(k,1902) = lu(k,1902) - lu(k,1758) * lu(k,1891) + lu(k,1904) = lu(k,1904) - lu(k,1759) * lu(k,1891) + lu(k,1906) = lu(k,1906) - lu(k,1760) * lu(k,1891) + lu(k,1907) = lu(k,1907) - lu(k,1761) * lu(k,1891) + lu(k,1956) = lu(k,1956) - lu(k,1757) * lu(k,1951) + lu(k,1964) = lu(k,1964) - lu(k,1758) * lu(k,1951) + lu(k,1967) = lu(k,1967) - lu(k,1759) * lu(k,1951) + lu(k,1969) = lu(k,1969) - lu(k,1760) * lu(k,1951) + lu(k,1970) = lu(k,1970) - lu(k,1761) * lu(k,1951) + lu(k,1993) = lu(k,1993) - lu(k,1757) * lu(k,1987) + lu(k,2003) = lu(k,2003) - lu(k,1758) * lu(k,1987) + lu(k,2006) = lu(k,2006) - lu(k,1759) * lu(k,1987) + lu(k,2008) = lu(k,2008) - lu(k,1760) * lu(k,1987) + lu(k,2009) = lu(k,2009) - lu(k,1761) * lu(k,1987) + lu(k,2020) = lu(k,2020) - lu(k,1757) * lu(k,2019) + lu(k,2024) = lu(k,2024) - lu(k,1758) * lu(k,2019) + lu(k,2028) = lu(k,2028) - lu(k,1759) * lu(k,2019) + lu(k,2030) = lu(k,2030) - lu(k,1760) * lu(k,2019) + lu(k,2031) = lu(k,2031) - lu(k,1761) * lu(k,2019) + lu(k,2044) = lu(k,2044) - lu(k,1757) * lu(k,2043) + lu(k,2049) = lu(k,2049) - lu(k,1758) * lu(k,2043) + lu(k,2053) = lu(k,2053) - lu(k,1759) * lu(k,2043) + lu(k,2055) = lu(k,2055) - lu(k,1760) * lu(k,2043) + lu(k,2056) = lu(k,2056) - lu(k,1761) * lu(k,2043) + lu(k,2075) = lu(k,2075) - lu(k,1757) * lu(k,2072) + lu(k,2080) = lu(k,2080) - lu(k,1758) * lu(k,2072) + lu(k,2085) = lu(k,2085) - lu(k,1759) * lu(k,2072) + lu(k,2087) = lu(k,2087) - lu(k,1760) * lu(k,2072) + lu(k,2088) = lu(k,2088) - lu(k,1761) * lu(k,2072) + lu(k,2107) = lu(k,2107) - lu(k,1757) * lu(k,2104) + lu(k,2112) = lu(k,2112) - lu(k,1758) * lu(k,2104) + lu(k,2117) = lu(k,2117) - lu(k,1759) * lu(k,2104) + lu(k,2119) = lu(k,2119) - lu(k,1760) * lu(k,2104) + lu(k,2120) = lu(k,2120) - lu(k,1761) * lu(k,2104) + lu(k,2137) = lu(k,2137) - lu(k,1757) * lu(k,2134) + lu(k,2141) = lu(k,2141) - lu(k,1758) * lu(k,2134) + lu(k,2146) = lu(k,2146) - lu(k,1759) * lu(k,2134) + lu(k,2148) = lu(k,2148) - lu(k,1760) * lu(k,2134) + lu(k,2149) = lu(k,2149) - lu(k,1761) * lu(k,2134) + lu(k,2172) = lu(k,2172) - lu(k,1757) * lu(k,2170) + lu(k,2183) = lu(k,2183) - lu(k,1758) * lu(k,2170) + lu(k,2188) = lu(k,2188) - lu(k,1759) * lu(k,2170) + lu(k,2190) = lu(k,2190) - lu(k,1760) * lu(k,2170) + lu(k,2191) = lu(k,2191) - lu(k,1761) * lu(k,2170) + lu(k,2275) = lu(k,2275) - lu(k,1757) * lu(k,2274) + lu(k,2278) = lu(k,2278) - lu(k,1758) * lu(k,2274) + lu(k,2281) = lu(k,2281) - lu(k,1759) * lu(k,2274) + lu(k,2283) = lu(k,2283) - lu(k,1760) * lu(k,2274) + lu(k,2284) = lu(k,2284) - lu(k,1761) * lu(k,2274) + lu(k,2987) = lu(k,2987) - lu(k,1757) * lu(k,2981) + lu(k,3023) = lu(k,3023) - lu(k,1758) * lu(k,2981) + lu(k,3028) = lu(k,3028) - lu(k,1759) * lu(k,2981) + lu(k,3030) = lu(k,3030) - lu(k,1760) * lu(k,2981) + lu(k,3031) = lu(k,3031) - lu(k,1761) * lu(k,2981) + lu(k,3088) = lu(k,3088) - lu(k,1757) * lu(k,3081) + lu(k,3126) = lu(k,3126) - lu(k,1758) * lu(k,3081) + lu(k,3131) = lu(k,3131) - lu(k,1759) * lu(k,3081) + lu(k,3133) = lu(k,3133) - lu(k,1760) * lu(k,3081) + lu(k,3134) = lu(k,3134) - lu(k,1761) * lu(k,3081) + lu(k,3269) = lu(k,3269) - lu(k,1757) * lu(k,3262) + lu(k,3308) = lu(k,3308) - lu(k,1758) * lu(k,3262) + lu(k,3313) = lu(k,3313) - lu(k,1759) * lu(k,3262) + lu(k,3315) = lu(k,3315) - lu(k,1760) * lu(k,3262) + lu(k,3316) = lu(k,3316) - lu(k,1761) * lu(k,3262) + lu(k,3525) = lu(k,3525) - lu(k,1757) * lu(k,3518) + lu(k,3564) = lu(k,3564) - lu(k,1758) * lu(k,3518) + lu(k,3569) = lu(k,3569) - lu(k,1759) * lu(k,3518) + lu(k,3571) = lu(k,3571) - lu(k,1760) * lu(k,3518) + lu(k,3572) = lu(k,3572) - lu(k,1761) * lu(k,3518) + lu(k,3776) = lu(k,3776) - lu(k,1757) * lu(k,3769) + lu(k,3814) = lu(k,3814) - lu(k,1758) * lu(k,3769) + lu(k,3819) = lu(k,3819) - lu(k,1759) * lu(k,3769) + lu(k,3821) = lu(k,3821) - lu(k,1760) * lu(k,3769) + lu(k,3822) = lu(k,3822) - lu(k,1761) * lu(k,3769) + lu(k,3910) = lu(k,3910) - lu(k,1757) * lu(k,3904) + lu(k,3949) = lu(k,3949) - lu(k,1758) * lu(k,3904) + lu(k,3954) = lu(k,3954) - lu(k,1759) * lu(k,3904) + lu(k,3956) = lu(k,3956) - lu(k,1760) * lu(k,3904) + lu(k,3957) = lu(k,3957) - lu(k,1761) * lu(k,3904) + lu(k,4004) = lu(k,4004) - lu(k,1757) * lu(k,3997) + lu(k,4041) = lu(k,4041) - lu(k,1758) * lu(k,3997) + lu(k,4046) = lu(k,4046) - lu(k,1759) * lu(k,3997) + lu(k,4048) = lu(k,4048) - lu(k,1760) * lu(k,3997) + lu(k,4049) = lu(k,4049) - lu(k,1761) * lu(k,3997) + lu(k,4081) = lu(k,4081) - lu(k,1757) * lu(k,4080) + lu(k,4093) = lu(k,4093) - lu(k,1758) * lu(k,4080) + lu(k,4098) = lu(k,4098) - lu(k,1759) * lu(k,4080) + lu(k,4100) = lu(k,4100) - lu(k,1760) * lu(k,4080) + lu(k,4101) = lu(k,4101) - lu(k,1761) * lu(k,4080) + lu(k,1769) = 1._r8 / lu(k,1769) + lu(k,1770) = lu(k,1770) * lu(k,1769) + lu(k,1771) = lu(k,1771) * lu(k,1769) + lu(k,1772) = lu(k,1772) * lu(k,1769) + lu(k,1773) = lu(k,1773) * lu(k,1769) + lu(k,1774) = lu(k,1774) * lu(k,1769) + lu(k,1775) = lu(k,1775) * lu(k,1769) + lu(k,1776) = lu(k,1776) * lu(k,1769) + lu(k,1777) = lu(k,1777) * lu(k,1769) + lu(k,1778) = lu(k,1778) * lu(k,1769) + lu(k,1779) = lu(k,1779) * lu(k,1769) + lu(k,1780) = lu(k,1780) * lu(k,1769) + lu(k,1781) = lu(k,1781) * lu(k,1769) + lu(k,1782) = lu(k,1782) * lu(k,1769) + lu(k,1783) = lu(k,1783) * lu(k,1769) + lu(k,1991) = lu(k,1991) - lu(k,1770) * lu(k,1988) + lu(k,1992) = lu(k,1992) - lu(k,1771) * lu(k,1988) + lu(k,1993) = lu(k,1993) - lu(k,1772) * lu(k,1988) + lu(k,1994) = lu(k,1994) - lu(k,1773) * lu(k,1988) + lu(k,1997) = lu(k,1997) - lu(k,1774) * lu(k,1988) + lu(k,2001) = - lu(k,1775) * lu(k,1988) + lu(k,2003) = lu(k,2003) - lu(k,1776) * lu(k,1988) + lu(k,2004) = lu(k,2004) - lu(k,1777) * lu(k,1988) + lu(k,2006) = lu(k,2006) - lu(k,1778) * lu(k,1988) + lu(k,2007) = lu(k,2007) - lu(k,1779) * lu(k,1988) + lu(k,2008) = lu(k,2008) - lu(k,1780) * lu(k,1988) + lu(k,2009) = lu(k,2009) - lu(k,1781) * lu(k,1988) + lu(k,2011) = lu(k,2011) - lu(k,1782) * lu(k,1988) + lu(k,2012) = lu(k,2012) - lu(k,1783) * lu(k,1988) + lu(k,2985) = lu(k,2985) - lu(k,1770) * lu(k,2982) + lu(k,2986) = lu(k,2986) - lu(k,1771) * lu(k,2982) + lu(k,2987) = lu(k,2987) - lu(k,1772) * lu(k,2982) + lu(k,2988) = lu(k,2988) - lu(k,1773) * lu(k,2982) + lu(k,2991) = lu(k,2991) - lu(k,1774) * lu(k,2982) + lu(k,2995) = - lu(k,1775) * lu(k,2982) + lu(k,3023) = lu(k,3023) - lu(k,1776) * lu(k,2982) + lu(k,3026) = lu(k,3026) - lu(k,1777) * lu(k,2982) + lu(k,3028) = lu(k,3028) - lu(k,1778) * lu(k,2982) + lu(k,3029) = lu(k,3029) - lu(k,1779) * lu(k,2982) + lu(k,3030) = lu(k,3030) - lu(k,1780) * lu(k,2982) + lu(k,3031) = lu(k,3031) - lu(k,1781) * lu(k,2982) + lu(k,3034) = lu(k,3034) - lu(k,1782) * lu(k,2982) + lu(k,3035) = lu(k,3035) - lu(k,1783) * lu(k,2982) + lu(k,3086) = lu(k,3086) - lu(k,1770) * lu(k,3082) + lu(k,3087) = lu(k,3087) - lu(k,1771) * lu(k,3082) + lu(k,3088) = lu(k,3088) - lu(k,1772) * lu(k,3082) + lu(k,3089) = lu(k,3089) - lu(k,1773) * lu(k,3082) + lu(k,3092) = lu(k,3092) - lu(k,1774) * lu(k,3082) + lu(k,3096) = lu(k,3096) - lu(k,1775) * lu(k,3082) + lu(k,3126) = lu(k,3126) - lu(k,1776) * lu(k,3082) + lu(k,3129) = lu(k,3129) - lu(k,1777) * lu(k,3082) + lu(k,3131) = lu(k,3131) - lu(k,1778) * lu(k,3082) + lu(k,3132) = lu(k,3132) - lu(k,1779) * lu(k,3082) + lu(k,3133) = lu(k,3133) - lu(k,1780) * lu(k,3082) + lu(k,3134) = lu(k,3134) - lu(k,1781) * lu(k,3082) + lu(k,3137) = lu(k,3137) - lu(k,1782) * lu(k,3082) + lu(k,3138) = lu(k,3138) - lu(k,1783) * lu(k,3082) + lu(k,3267) = lu(k,3267) - lu(k,1770) * lu(k,3263) + lu(k,3268) = lu(k,3268) - lu(k,1771) * lu(k,3263) + lu(k,3269) = lu(k,3269) - lu(k,1772) * lu(k,3263) + lu(k,3270) = lu(k,3270) - lu(k,1773) * lu(k,3263) + lu(k,3273) = lu(k,3273) - lu(k,1774) * lu(k,3263) + lu(k,3277) = lu(k,3277) - lu(k,1775) * lu(k,3263) + lu(k,3308) = lu(k,3308) - lu(k,1776) * lu(k,3263) + lu(k,3311) = lu(k,3311) - lu(k,1777) * lu(k,3263) + lu(k,3313) = lu(k,3313) - lu(k,1778) * lu(k,3263) + lu(k,3314) = lu(k,3314) - lu(k,1779) * lu(k,3263) + lu(k,3315) = lu(k,3315) - lu(k,1780) * lu(k,3263) + lu(k,3316) = lu(k,3316) - lu(k,1781) * lu(k,3263) + lu(k,3319) = lu(k,3319) - lu(k,1782) * lu(k,3263) + lu(k,3320) = lu(k,3320) - lu(k,1783) * lu(k,3263) + lu(k,3523) = lu(k,3523) - lu(k,1770) * lu(k,3519) + lu(k,3524) = lu(k,3524) - lu(k,1771) * lu(k,3519) + lu(k,3525) = lu(k,3525) - lu(k,1772) * lu(k,3519) + lu(k,3526) = lu(k,3526) - lu(k,1773) * lu(k,3519) + lu(k,3529) = lu(k,3529) - lu(k,1774) * lu(k,3519) + lu(k,3533) = - lu(k,1775) * lu(k,3519) + lu(k,3564) = lu(k,3564) - lu(k,1776) * lu(k,3519) + lu(k,3567) = lu(k,3567) - lu(k,1777) * lu(k,3519) + lu(k,3569) = lu(k,3569) - lu(k,1778) * lu(k,3519) + lu(k,3570) = lu(k,3570) - lu(k,1779) * lu(k,3519) + lu(k,3571) = lu(k,3571) - lu(k,1780) * lu(k,3519) + lu(k,3572) = lu(k,3572) - lu(k,1781) * lu(k,3519) + lu(k,3575) = lu(k,3575) - lu(k,1782) * lu(k,3519) + lu(k,3576) = lu(k,3576) - lu(k,1783) * lu(k,3519) + lu(k,3774) = lu(k,3774) - lu(k,1770) * lu(k,3770) + lu(k,3775) = lu(k,3775) - lu(k,1771) * lu(k,3770) + lu(k,3776) = lu(k,3776) - lu(k,1772) * lu(k,3770) + lu(k,3777) = lu(k,3777) - lu(k,1773) * lu(k,3770) + lu(k,3780) = lu(k,3780) - lu(k,1774) * lu(k,3770) + lu(k,3784) = lu(k,3784) - lu(k,1775) * lu(k,3770) + lu(k,3814) = lu(k,3814) - lu(k,1776) * lu(k,3770) + lu(k,3817) = lu(k,3817) - lu(k,1777) * lu(k,3770) + lu(k,3819) = lu(k,3819) - lu(k,1778) * lu(k,3770) + lu(k,3820) = lu(k,3820) - lu(k,1779) * lu(k,3770) + lu(k,3821) = lu(k,3821) - lu(k,1780) * lu(k,3770) + lu(k,3822) = lu(k,3822) - lu(k,1781) * lu(k,3770) + lu(k,3825) = lu(k,3825) - lu(k,1782) * lu(k,3770) + lu(k,3826) = lu(k,3826) - lu(k,1783) * lu(k,3770) + lu(k,3908) = lu(k,3908) - lu(k,1770) * lu(k,3905) + lu(k,3909) = lu(k,3909) - lu(k,1771) * lu(k,3905) + lu(k,3910) = lu(k,3910) - lu(k,1772) * lu(k,3905) + lu(k,3911) = lu(k,3911) - lu(k,1773) * lu(k,3905) + lu(k,3914) = lu(k,3914) - lu(k,1774) * lu(k,3905) + lu(k,3918) = - lu(k,1775) * lu(k,3905) + lu(k,3949) = lu(k,3949) - lu(k,1776) * lu(k,3905) + lu(k,3952) = lu(k,3952) - lu(k,1777) * lu(k,3905) + lu(k,3954) = lu(k,3954) - lu(k,1778) * lu(k,3905) + lu(k,3955) = lu(k,3955) - lu(k,1779) * lu(k,3905) + lu(k,3956) = lu(k,3956) - lu(k,1780) * lu(k,3905) + lu(k,3957) = lu(k,3957) - lu(k,1781) * lu(k,3905) + lu(k,3960) = lu(k,3960) - lu(k,1782) * lu(k,3905) + lu(k,3961) = lu(k,3961) - lu(k,1783) * lu(k,3905) + lu(k,4002) = lu(k,4002) - lu(k,1770) * lu(k,3998) + lu(k,4003) = lu(k,4003) - lu(k,1771) * lu(k,3998) + lu(k,4004) = lu(k,4004) - lu(k,1772) * lu(k,3998) + lu(k,4005) = lu(k,4005) - lu(k,1773) * lu(k,3998) + lu(k,4008) = lu(k,4008) - lu(k,1774) * lu(k,3998) + lu(k,4012) = lu(k,4012) - lu(k,1775) * lu(k,3998) + lu(k,4041) = lu(k,4041) - lu(k,1776) * lu(k,3998) + lu(k,4044) = lu(k,4044) - lu(k,1777) * lu(k,3998) + lu(k,4046) = lu(k,4046) - lu(k,1778) * lu(k,3998) + lu(k,4047) = lu(k,4047) - lu(k,1779) * lu(k,3998) + lu(k,4048) = lu(k,4048) - lu(k,1780) * lu(k,3998) + lu(k,4049) = lu(k,4049) - lu(k,1781) * lu(k,3998) + lu(k,4052) = lu(k,4052) - lu(k,1782) * lu(k,3998) + lu(k,4053) = lu(k,4053) - lu(k,1783) * lu(k,3998) + lu(k,1791) = 1._r8 / lu(k,1791) + lu(k,1792) = lu(k,1792) * lu(k,1791) + lu(k,1793) = lu(k,1793) * lu(k,1791) + lu(k,1794) = lu(k,1794) * lu(k,1791) + lu(k,1795) = lu(k,1795) * lu(k,1791) + lu(k,1796) = lu(k,1796) * lu(k,1791) + lu(k,1797) = lu(k,1797) * lu(k,1791) + lu(k,1798) = lu(k,1798) * lu(k,1791) + lu(k,1799) = lu(k,1799) * lu(k,1791) + lu(k,1800) = lu(k,1800) * lu(k,1791) + lu(k,1871) = lu(k,1871) - lu(k,1792) * lu(k,1869) + lu(k,1872) = lu(k,1872) - lu(k,1793) * lu(k,1869) + lu(k,1873) = - lu(k,1794) * lu(k,1869) + lu(k,1874) = lu(k,1874) - lu(k,1795) * lu(k,1869) + lu(k,1876) = lu(k,1876) - lu(k,1796) * lu(k,1869) + lu(k,1877) = lu(k,1877) - lu(k,1797) * lu(k,1869) + lu(k,1878) = lu(k,1878) - lu(k,1798) * lu(k,1869) + lu(k,1879) = lu(k,1879) - lu(k,1799) * lu(k,1869) + lu(k,1880) = lu(k,1880) - lu(k,1800) * lu(k,1869) + lu(k,1895) = lu(k,1895) - lu(k,1792) * lu(k,1892) + lu(k,1896) = lu(k,1896) - lu(k,1793) * lu(k,1892) + lu(k,1897) = - lu(k,1794) * lu(k,1892) + lu(k,1902) = lu(k,1902) - lu(k,1795) * lu(k,1892) + lu(k,1904) = lu(k,1904) - lu(k,1796) * lu(k,1892) + lu(k,1905) = lu(k,1905) - lu(k,1797) * lu(k,1892) + lu(k,1906) = lu(k,1906) - lu(k,1798) * lu(k,1892) + lu(k,1907) = lu(k,1907) - lu(k,1799) * lu(k,1892) + lu(k,1908) = lu(k,1908) - lu(k,1800) * lu(k,1892) + lu(k,1956) = lu(k,1956) - lu(k,1792) * lu(k,1952) + lu(k,1957) = lu(k,1957) - lu(k,1793) * lu(k,1952) + lu(k,1958) = lu(k,1958) - lu(k,1794) * lu(k,1952) + lu(k,1964) = lu(k,1964) - lu(k,1795) * lu(k,1952) + lu(k,1967) = lu(k,1967) - lu(k,1796) * lu(k,1952) + lu(k,1968) = lu(k,1968) - lu(k,1797) * lu(k,1952) + lu(k,1969) = lu(k,1969) - lu(k,1798) * lu(k,1952) + lu(k,1970) = lu(k,1970) - lu(k,1799) * lu(k,1952) + lu(k,1973) = lu(k,1973) - lu(k,1800) * lu(k,1952) + lu(k,1993) = lu(k,1993) - lu(k,1792) * lu(k,1989) + lu(k,1994) = lu(k,1994) - lu(k,1793) * lu(k,1989) + lu(k,1995) = lu(k,1995) - lu(k,1794) * lu(k,1989) + lu(k,2003) = lu(k,2003) - lu(k,1795) * lu(k,1989) + lu(k,2006) = lu(k,2006) - lu(k,1796) * lu(k,1989) + lu(k,2007) = lu(k,2007) - lu(k,1797) * lu(k,1989) + lu(k,2008) = lu(k,2008) - lu(k,1798) * lu(k,1989) + lu(k,2009) = lu(k,2009) - lu(k,1799) * lu(k,1989) + lu(k,2012) = lu(k,2012) - lu(k,1800) * lu(k,1989) + lu(k,2075) = lu(k,2075) - lu(k,1792) * lu(k,2073) + lu(k,2076) = lu(k,2076) - lu(k,1793) * lu(k,2073) + lu(k,2077) = lu(k,2077) - lu(k,1794) * lu(k,2073) + lu(k,2080) = lu(k,2080) - lu(k,1795) * lu(k,2073) + lu(k,2085) = lu(k,2085) - lu(k,1796) * lu(k,2073) + lu(k,2086) = lu(k,2086) - lu(k,1797) * lu(k,2073) + lu(k,2087) = lu(k,2087) - lu(k,1798) * lu(k,2073) + lu(k,2088) = lu(k,2088) - lu(k,1799) * lu(k,2073) + lu(k,2091) = lu(k,2091) - lu(k,1800) * lu(k,2073) + lu(k,2107) = lu(k,2107) - lu(k,1792) * lu(k,2105) + lu(k,2108) = lu(k,2108) - lu(k,1793) * lu(k,2105) + lu(k,2109) = lu(k,2109) - lu(k,1794) * lu(k,2105) + lu(k,2112) = lu(k,2112) - lu(k,1795) * lu(k,2105) + lu(k,2117) = lu(k,2117) - lu(k,1796) * lu(k,2105) + lu(k,2118) = lu(k,2118) - lu(k,1797) * lu(k,2105) + lu(k,2119) = lu(k,2119) - lu(k,1798) * lu(k,2105) + lu(k,2120) = lu(k,2120) - lu(k,1799) * lu(k,2105) + lu(k,2123) = lu(k,2123) - lu(k,1800) * lu(k,2105) + lu(k,2137) = lu(k,2137) - lu(k,1792) * lu(k,2135) + lu(k,2138) = lu(k,2138) - lu(k,1793) * lu(k,2135) + lu(k,2139) = lu(k,2139) - lu(k,1794) * lu(k,2135) + lu(k,2141) = lu(k,2141) - lu(k,1795) * lu(k,2135) + lu(k,2146) = lu(k,2146) - lu(k,1796) * lu(k,2135) + lu(k,2147) = lu(k,2147) - lu(k,1797) * lu(k,2135) + lu(k,2148) = lu(k,2148) - lu(k,1798) * lu(k,2135) + lu(k,2149) = lu(k,2149) - lu(k,1799) * lu(k,2135) + lu(k,2152) = lu(k,2152) - lu(k,1800) * lu(k,2135) + lu(k,2172) = lu(k,2172) - lu(k,1792) * lu(k,2171) + lu(k,2173) = lu(k,2173) - lu(k,1793) * lu(k,2171) + lu(k,2174) = lu(k,2174) - lu(k,1794) * lu(k,2171) + lu(k,2183) = lu(k,2183) - lu(k,1795) * lu(k,2171) + lu(k,2188) = lu(k,2188) - lu(k,1796) * lu(k,2171) + lu(k,2189) = lu(k,2189) - lu(k,1797) * lu(k,2171) + lu(k,2190) = lu(k,2190) - lu(k,1798) * lu(k,2171) + lu(k,2191) = lu(k,2191) - lu(k,1799) * lu(k,2171) + lu(k,2195) = lu(k,2195) - lu(k,1800) * lu(k,2171) + lu(k,3088) = lu(k,3088) - lu(k,1792) * lu(k,3083) + lu(k,3089) = lu(k,3089) - lu(k,1793) * lu(k,3083) + lu(k,3090) = lu(k,3090) - lu(k,1794) * lu(k,3083) + lu(k,3126) = lu(k,3126) - lu(k,1795) * lu(k,3083) + lu(k,3131) = lu(k,3131) - lu(k,1796) * lu(k,3083) + lu(k,3132) = lu(k,3132) - lu(k,1797) * lu(k,3083) + lu(k,3133) = lu(k,3133) - lu(k,1798) * lu(k,3083) + lu(k,3134) = lu(k,3134) - lu(k,1799) * lu(k,3083) + lu(k,3138) = lu(k,3138) - lu(k,1800) * lu(k,3083) + lu(k,3269) = lu(k,3269) - lu(k,1792) * lu(k,3264) + lu(k,3270) = lu(k,3270) - lu(k,1793) * lu(k,3264) + lu(k,3271) = lu(k,3271) - lu(k,1794) * lu(k,3264) + lu(k,3308) = lu(k,3308) - lu(k,1795) * lu(k,3264) + lu(k,3313) = lu(k,3313) - lu(k,1796) * lu(k,3264) + lu(k,3314) = lu(k,3314) - lu(k,1797) * lu(k,3264) + lu(k,3315) = lu(k,3315) - lu(k,1798) * lu(k,3264) + lu(k,3316) = lu(k,3316) - lu(k,1799) * lu(k,3264) + lu(k,3320) = lu(k,3320) - lu(k,1800) * lu(k,3264) + lu(k,3525) = lu(k,3525) - lu(k,1792) * lu(k,3520) + lu(k,3526) = lu(k,3526) - lu(k,1793) * lu(k,3520) + lu(k,3527) = lu(k,3527) - lu(k,1794) * lu(k,3520) + lu(k,3564) = lu(k,3564) - lu(k,1795) * lu(k,3520) + lu(k,3569) = lu(k,3569) - lu(k,1796) * lu(k,3520) + lu(k,3570) = lu(k,3570) - lu(k,1797) * lu(k,3520) + lu(k,3571) = lu(k,3571) - lu(k,1798) * lu(k,3520) + lu(k,3572) = lu(k,3572) - lu(k,1799) * lu(k,3520) + lu(k,3576) = lu(k,3576) - lu(k,1800) * lu(k,3520) + lu(k,3776) = lu(k,3776) - lu(k,1792) * lu(k,3771) + lu(k,3777) = lu(k,3777) - lu(k,1793) * lu(k,3771) + lu(k,3778) = lu(k,3778) - lu(k,1794) * lu(k,3771) + lu(k,3814) = lu(k,3814) - lu(k,1795) * lu(k,3771) + lu(k,3819) = lu(k,3819) - lu(k,1796) * lu(k,3771) + lu(k,3820) = lu(k,3820) - lu(k,1797) * lu(k,3771) + lu(k,3821) = lu(k,3821) - lu(k,1798) * lu(k,3771) + lu(k,3822) = lu(k,3822) - lu(k,1799) * lu(k,3771) + lu(k,3826) = lu(k,3826) - lu(k,1800) * lu(k,3771) + lu(k,4004) = lu(k,4004) - lu(k,1792) * lu(k,3999) + lu(k,4005) = lu(k,4005) - lu(k,1793) * lu(k,3999) + lu(k,4006) = lu(k,4006) - lu(k,1794) * lu(k,3999) + lu(k,4041) = lu(k,4041) - lu(k,1795) * lu(k,3999) + lu(k,4046) = lu(k,4046) - lu(k,1796) * lu(k,3999) + lu(k,4047) = lu(k,4047) - lu(k,1797) * lu(k,3999) + lu(k,4048) = lu(k,4048) - lu(k,1798) * lu(k,3999) + lu(k,4049) = lu(k,4049) - lu(k,1799) * lu(k,3999) + lu(k,4053) = lu(k,4053) - lu(k,1800) * lu(k,3999) + lu(k,1815) = 1._r8 / lu(k,1815) + lu(k,1816) = lu(k,1816) * lu(k,1815) + lu(k,1817) = lu(k,1817) * lu(k,1815) + lu(k,1818) = lu(k,1818) * lu(k,1815) + lu(k,1819) = lu(k,1819) * lu(k,1815) + lu(k,1820) = lu(k,1820) * lu(k,1815) + lu(k,1821) = lu(k,1821) * lu(k,1815) + lu(k,1822) = lu(k,1822) * lu(k,1815) + lu(k,1823) = lu(k,1823) * lu(k,1815) + lu(k,1824) = lu(k,1824) * lu(k,1815) + lu(k,1825) = lu(k,1825) * lu(k,1815) + lu(k,1826) = lu(k,1826) * lu(k,1815) + lu(k,1827) = lu(k,1827) * lu(k,1815) + lu(k,1828) = lu(k,1828) * lu(k,1815) + lu(k,1829) = lu(k,1829) * lu(k,1815) + lu(k,1830) = lu(k,1830) * lu(k,1815) + lu(k,1831) = lu(k,1831) * lu(k,1815) + lu(k,1991) = lu(k,1991) - lu(k,1816) * lu(k,1990) + lu(k,1992) = lu(k,1992) - lu(k,1817) * lu(k,1990) + lu(k,1993) = lu(k,1993) - lu(k,1818) * lu(k,1990) + lu(k,1994) = lu(k,1994) - lu(k,1819) * lu(k,1990) + lu(k,1997) = lu(k,1997) - lu(k,1820) * lu(k,1990) + lu(k,1998) = lu(k,1998) - lu(k,1821) * lu(k,1990) + lu(k,2001) = lu(k,2001) - lu(k,1822) * lu(k,1990) + lu(k,2002) = - lu(k,1823) * lu(k,1990) + lu(k,2003) = lu(k,2003) - lu(k,1824) * lu(k,1990) + lu(k,2004) = lu(k,2004) - lu(k,1825) * lu(k,1990) + lu(k,2006) = lu(k,2006) - lu(k,1826) * lu(k,1990) + lu(k,2007) = lu(k,2007) - lu(k,1827) * lu(k,1990) + lu(k,2008) = lu(k,2008) - lu(k,1828) * lu(k,1990) + lu(k,2009) = lu(k,2009) - lu(k,1829) * lu(k,1990) + lu(k,2011) = lu(k,2011) - lu(k,1830) * lu(k,1990) + lu(k,2012) = lu(k,2012) - lu(k,1831) * lu(k,1990) + lu(k,2985) = lu(k,2985) - lu(k,1816) * lu(k,2983) + lu(k,2986) = lu(k,2986) - lu(k,1817) * lu(k,2983) + lu(k,2987) = lu(k,2987) - lu(k,1818) * lu(k,2983) + lu(k,2988) = lu(k,2988) - lu(k,1819) * lu(k,2983) + lu(k,2991) = lu(k,2991) - lu(k,1820) * lu(k,2983) + lu(k,2992) = lu(k,2992) - lu(k,1821) * lu(k,2983) + lu(k,2995) = lu(k,2995) - lu(k,1822) * lu(k,2983) + lu(k,3001) = lu(k,3001) - lu(k,1823) * lu(k,2983) + lu(k,3023) = lu(k,3023) - lu(k,1824) * lu(k,2983) + lu(k,3026) = lu(k,3026) - lu(k,1825) * lu(k,2983) + lu(k,3028) = lu(k,3028) - lu(k,1826) * lu(k,2983) + lu(k,3029) = lu(k,3029) - lu(k,1827) * lu(k,2983) + lu(k,3030) = lu(k,3030) - lu(k,1828) * lu(k,2983) + lu(k,3031) = lu(k,3031) - lu(k,1829) * lu(k,2983) + lu(k,3034) = lu(k,3034) - lu(k,1830) * lu(k,2983) + lu(k,3035) = lu(k,3035) - lu(k,1831) * lu(k,2983) + lu(k,3086) = lu(k,3086) - lu(k,1816) * lu(k,3084) + lu(k,3087) = lu(k,3087) - lu(k,1817) * lu(k,3084) + lu(k,3088) = lu(k,3088) - lu(k,1818) * lu(k,3084) + lu(k,3089) = lu(k,3089) - lu(k,1819) * lu(k,3084) + lu(k,3092) = lu(k,3092) - lu(k,1820) * lu(k,3084) + lu(k,3093) = lu(k,3093) - lu(k,1821) * lu(k,3084) + lu(k,3096) = lu(k,3096) - lu(k,1822) * lu(k,3084) + lu(k,3102) = lu(k,3102) - lu(k,1823) * lu(k,3084) + lu(k,3126) = lu(k,3126) - lu(k,1824) * lu(k,3084) + lu(k,3129) = lu(k,3129) - lu(k,1825) * lu(k,3084) + lu(k,3131) = lu(k,3131) - lu(k,1826) * lu(k,3084) + lu(k,3132) = lu(k,3132) - lu(k,1827) * lu(k,3084) + lu(k,3133) = lu(k,3133) - lu(k,1828) * lu(k,3084) + lu(k,3134) = lu(k,3134) - lu(k,1829) * lu(k,3084) + lu(k,3137) = lu(k,3137) - lu(k,1830) * lu(k,3084) + lu(k,3138) = lu(k,3138) - lu(k,1831) * lu(k,3084) + lu(k,3267) = lu(k,3267) - lu(k,1816) * lu(k,3265) + lu(k,3268) = lu(k,3268) - lu(k,1817) * lu(k,3265) + lu(k,3269) = lu(k,3269) - lu(k,1818) * lu(k,3265) + lu(k,3270) = lu(k,3270) - lu(k,1819) * lu(k,3265) + lu(k,3273) = lu(k,3273) - lu(k,1820) * lu(k,3265) + lu(k,3274) = lu(k,3274) - lu(k,1821) * lu(k,3265) + lu(k,3277) = lu(k,3277) - lu(k,1822) * lu(k,3265) + lu(k,3284) = lu(k,3284) - lu(k,1823) * lu(k,3265) + lu(k,3308) = lu(k,3308) - lu(k,1824) * lu(k,3265) + lu(k,3311) = lu(k,3311) - lu(k,1825) * lu(k,3265) + lu(k,3313) = lu(k,3313) - lu(k,1826) * lu(k,3265) + lu(k,3314) = lu(k,3314) - lu(k,1827) * lu(k,3265) + lu(k,3315) = lu(k,3315) - lu(k,1828) * lu(k,3265) + lu(k,3316) = lu(k,3316) - lu(k,1829) * lu(k,3265) + lu(k,3319) = lu(k,3319) - lu(k,1830) * lu(k,3265) + lu(k,3320) = lu(k,3320) - lu(k,1831) * lu(k,3265) + lu(k,3523) = lu(k,3523) - lu(k,1816) * lu(k,3521) + lu(k,3524) = lu(k,3524) - lu(k,1817) * lu(k,3521) + lu(k,3525) = lu(k,3525) - lu(k,1818) * lu(k,3521) + lu(k,3526) = lu(k,3526) - lu(k,1819) * lu(k,3521) + lu(k,3529) = lu(k,3529) - lu(k,1820) * lu(k,3521) + lu(k,3530) = lu(k,3530) - lu(k,1821) * lu(k,3521) + lu(k,3533) = lu(k,3533) - lu(k,1822) * lu(k,3521) + lu(k,3540) = lu(k,3540) - lu(k,1823) * lu(k,3521) + lu(k,3564) = lu(k,3564) - lu(k,1824) * lu(k,3521) + lu(k,3567) = lu(k,3567) - lu(k,1825) * lu(k,3521) + lu(k,3569) = lu(k,3569) - lu(k,1826) * lu(k,3521) + lu(k,3570) = lu(k,3570) - lu(k,1827) * lu(k,3521) + lu(k,3571) = lu(k,3571) - lu(k,1828) * lu(k,3521) + lu(k,3572) = lu(k,3572) - lu(k,1829) * lu(k,3521) + lu(k,3575) = lu(k,3575) - lu(k,1830) * lu(k,3521) + lu(k,3576) = lu(k,3576) - lu(k,1831) * lu(k,3521) + lu(k,3774) = lu(k,3774) - lu(k,1816) * lu(k,3772) + lu(k,3775) = lu(k,3775) - lu(k,1817) * lu(k,3772) + lu(k,3776) = lu(k,3776) - lu(k,1818) * lu(k,3772) + lu(k,3777) = lu(k,3777) - lu(k,1819) * lu(k,3772) + lu(k,3780) = lu(k,3780) - lu(k,1820) * lu(k,3772) + lu(k,3781) = lu(k,3781) - lu(k,1821) * lu(k,3772) + lu(k,3784) = lu(k,3784) - lu(k,1822) * lu(k,3772) + lu(k,3790) = lu(k,3790) - lu(k,1823) * lu(k,3772) + lu(k,3814) = lu(k,3814) - lu(k,1824) * lu(k,3772) + lu(k,3817) = lu(k,3817) - lu(k,1825) * lu(k,3772) + lu(k,3819) = lu(k,3819) - lu(k,1826) * lu(k,3772) + lu(k,3820) = lu(k,3820) - lu(k,1827) * lu(k,3772) + lu(k,3821) = lu(k,3821) - lu(k,1828) * lu(k,3772) + lu(k,3822) = lu(k,3822) - lu(k,1829) * lu(k,3772) + lu(k,3825) = lu(k,3825) - lu(k,1830) * lu(k,3772) + lu(k,3826) = lu(k,3826) - lu(k,1831) * lu(k,3772) + lu(k,3908) = lu(k,3908) - lu(k,1816) * lu(k,3906) + lu(k,3909) = lu(k,3909) - lu(k,1817) * lu(k,3906) + lu(k,3910) = lu(k,3910) - lu(k,1818) * lu(k,3906) + lu(k,3911) = lu(k,3911) - lu(k,1819) * lu(k,3906) + lu(k,3914) = lu(k,3914) - lu(k,1820) * lu(k,3906) + lu(k,3915) = lu(k,3915) - lu(k,1821) * lu(k,3906) + lu(k,3918) = lu(k,3918) - lu(k,1822) * lu(k,3906) + lu(k,3925) = lu(k,3925) - lu(k,1823) * lu(k,3906) + lu(k,3949) = lu(k,3949) - lu(k,1824) * lu(k,3906) + lu(k,3952) = lu(k,3952) - lu(k,1825) * lu(k,3906) + lu(k,3954) = lu(k,3954) - lu(k,1826) * lu(k,3906) + lu(k,3955) = lu(k,3955) - lu(k,1827) * lu(k,3906) + lu(k,3956) = lu(k,3956) - lu(k,1828) * lu(k,3906) + lu(k,3957) = lu(k,3957) - lu(k,1829) * lu(k,3906) + lu(k,3960) = lu(k,3960) - lu(k,1830) * lu(k,3906) + lu(k,3961) = lu(k,3961) - lu(k,1831) * lu(k,3906) + lu(k,4002) = lu(k,4002) - lu(k,1816) * lu(k,4000) + lu(k,4003) = lu(k,4003) - lu(k,1817) * lu(k,4000) + lu(k,4004) = lu(k,4004) - lu(k,1818) * lu(k,4000) + lu(k,4005) = lu(k,4005) - lu(k,1819) * lu(k,4000) + lu(k,4008) = lu(k,4008) - lu(k,1820) * lu(k,4000) + lu(k,4009) = lu(k,4009) - lu(k,1821) * lu(k,4000) + lu(k,4012) = lu(k,4012) - lu(k,1822) * lu(k,4000) + lu(k,4018) = lu(k,4018) - lu(k,1823) * lu(k,4000) + lu(k,4041) = lu(k,4041) - lu(k,1824) * lu(k,4000) + lu(k,4044) = lu(k,4044) - lu(k,1825) * lu(k,4000) + lu(k,4046) = lu(k,4046) - lu(k,1826) * lu(k,4000) + lu(k,4047) = lu(k,4047) - lu(k,1827) * lu(k,4000) + lu(k,4048) = lu(k,4048) - lu(k,1828) * lu(k,4000) + lu(k,4049) = lu(k,4049) - lu(k,1829) * lu(k,4000) + lu(k,4052) = lu(k,4052) - lu(k,1830) * lu(k,4000) + lu(k,4053) = lu(k,4053) - lu(k,1831) * lu(k,4000) end do end subroutine lu_fac39 subroutine lu_fac40( avec_len, lu ) @@ -9649,399 +9030,576 @@ subroutine lu_fac40( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1896) = 1._r8 / lu(k,1896) - lu(k,1897) = lu(k,1897) * lu(k,1896) - lu(k,1898) = lu(k,1898) * lu(k,1896) - lu(k,1899) = lu(k,1899) * lu(k,1896) - lu(k,1900) = lu(k,1900) * lu(k,1896) - lu(k,1901) = lu(k,1901) * lu(k,1896) - lu(k,1902) = lu(k,1902) * lu(k,1896) - lu(k,1903) = lu(k,1903) * lu(k,1896) - lu(k,1904) = lu(k,1904) * lu(k,1896) - lu(k,1905) = lu(k,1905) * lu(k,1896) - lu(k,1906) = lu(k,1906) * lu(k,1896) - lu(k,1907) = lu(k,1907) * lu(k,1896) - lu(k,1908) = lu(k,1908) * lu(k,1896) - lu(k,1909) = lu(k,1909) * lu(k,1896) - lu(k,1910) = lu(k,1910) * lu(k,1896) - lu(k,1911) = lu(k,1911) * lu(k,1896) - lu(k,2673) = lu(k,2673) - lu(k,1897) * lu(k,2672) - lu(k,2674) = lu(k,2674) - lu(k,1898) * lu(k,2672) - lu(k,2681) = lu(k,2681) - lu(k,1899) * lu(k,2672) - lu(k,2699) = lu(k,2699) - lu(k,1900) * lu(k,2672) - lu(k,2700) = lu(k,2700) - lu(k,1901) * lu(k,2672) - lu(k,2701) = lu(k,2701) - lu(k,1902) * lu(k,2672) - lu(k,2702) = lu(k,2702) - lu(k,1903) * lu(k,2672) - lu(k,2703) = lu(k,2703) - lu(k,1904) * lu(k,2672) - lu(k,2704) = lu(k,2704) - lu(k,1905) * lu(k,2672) - lu(k,2705) = lu(k,2705) - lu(k,1906) * lu(k,2672) - lu(k,2706) = lu(k,2706) - lu(k,1907) * lu(k,2672) - lu(k,2707) = lu(k,2707) - lu(k,1908) * lu(k,2672) - lu(k,2709) = lu(k,2709) - lu(k,1909) * lu(k,2672) - lu(k,2710) = lu(k,2710) - lu(k,1910) * lu(k,2672) - lu(k,2713) = lu(k,2713) - lu(k,1911) * lu(k,2672) - lu(k,2856) = lu(k,2856) - lu(k,1897) * lu(k,2855) - lu(k,2857) = lu(k,2857) - lu(k,1898) * lu(k,2855) - lu(k,2864) = lu(k,2864) - lu(k,1899) * lu(k,2855) - lu(k,2882) = lu(k,2882) - lu(k,1900) * lu(k,2855) - lu(k,2883) = lu(k,2883) - lu(k,1901) * lu(k,2855) - lu(k,2884) = lu(k,2884) - lu(k,1902) * lu(k,2855) - lu(k,2885) = lu(k,2885) - lu(k,1903) * lu(k,2855) - lu(k,2886) = lu(k,2886) - lu(k,1904) * lu(k,2855) - lu(k,2887) = lu(k,2887) - lu(k,1905) * lu(k,2855) - lu(k,2889) = lu(k,2889) - lu(k,1906) * lu(k,2855) - lu(k,2891) = lu(k,2891) - lu(k,1907) * lu(k,2855) - lu(k,2892) = lu(k,2892) - lu(k,1908) * lu(k,2855) - lu(k,2894) = lu(k,2894) - lu(k,1909) * lu(k,2855) - lu(k,2895) = lu(k,2895) - lu(k,1910) * lu(k,2855) - lu(k,2899) = lu(k,2899) - lu(k,1911) * lu(k,2855) - lu(k,2958) = lu(k,2958) - lu(k,1897) * lu(k,2957) - lu(k,2959) = lu(k,2959) - lu(k,1898) * lu(k,2957) - lu(k,2965) = lu(k,2965) - lu(k,1899) * lu(k,2957) - lu(k,2983) = lu(k,2983) - lu(k,1900) * lu(k,2957) - lu(k,2984) = lu(k,2984) - lu(k,1901) * lu(k,2957) - lu(k,2985) = lu(k,2985) - lu(k,1902) * lu(k,2957) - lu(k,2986) = lu(k,2986) - lu(k,1903) * lu(k,2957) - lu(k,2987) = lu(k,2987) - lu(k,1904) * lu(k,2957) - lu(k,2988) = lu(k,2988) - lu(k,1905) * lu(k,2957) - lu(k,2990) = lu(k,2990) - lu(k,1906) * lu(k,2957) - lu(k,2992) = lu(k,2992) - lu(k,1907) * lu(k,2957) - lu(k,2993) = lu(k,2993) - lu(k,1908) * lu(k,2957) - lu(k,2995) = lu(k,2995) - lu(k,1909) * lu(k,2957) - lu(k,2996) = lu(k,2996) - lu(k,1910) * lu(k,2957) - lu(k,3000) = lu(k,3000) - lu(k,1911) * lu(k,2957) - lu(k,3049) = lu(k,3049) - lu(k,1897) * lu(k,3048) - lu(k,3050) = lu(k,3050) - lu(k,1898) * lu(k,3048) - lu(k,3057) = lu(k,3057) - lu(k,1899) * lu(k,3048) - lu(k,3075) = lu(k,3075) - lu(k,1900) * lu(k,3048) - lu(k,3076) = lu(k,3076) - lu(k,1901) * lu(k,3048) - lu(k,3077) = lu(k,3077) - lu(k,1902) * lu(k,3048) - lu(k,3078) = lu(k,3078) - lu(k,1903) * lu(k,3048) - lu(k,3079) = lu(k,3079) - lu(k,1904) * lu(k,3048) - lu(k,3080) = lu(k,3080) - lu(k,1905) * lu(k,3048) - lu(k,3082) = lu(k,3082) - lu(k,1906) * lu(k,3048) - lu(k,3084) = lu(k,3084) - lu(k,1907) * lu(k,3048) - lu(k,3085) = lu(k,3085) - lu(k,1908) * lu(k,3048) - lu(k,3087) = lu(k,3087) - lu(k,1909) * lu(k,3048) - lu(k,3088) = lu(k,3088) - lu(k,1910) * lu(k,3048) - lu(k,3092) = lu(k,3092) - lu(k,1911) * lu(k,3048) - lu(k,3252) = lu(k,3252) - lu(k,1897) * lu(k,3251) - lu(k,3253) = lu(k,3253) - lu(k,1898) * lu(k,3251) - lu(k,3260) = lu(k,3260) - lu(k,1899) * lu(k,3251) - lu(k,3278) = lu(k,3278) - lu(k,1900) * lu(k,3251) - lu(k,3279) = lu(k,3279) - lu(k,1901) * lu(k,3251) - lu(k,3280) = lu(k,3280) - lu(k,1902) * lu(k,3251) - lu(k,3281) = lu(k,3281) - lu(k,1903) * lu(k,3251) - lu(k,3282) = lu(k,3282) - lu(k,1904) * lu(k,3251) - lu(k,3283) = lu(k,3283) - lu(k,1905) * lu(k,3251) - lu(k,3285) = lu(k,3285) - lu(k,1906) * lu(k,3251) - lu(k,3287) = lu(k,3287) - lu(k,1907) * lu(k,3251) - lu(k,3288) = lu(k,3288) - lu(k,1908) * lu(k,3251) - lu(k,3290) = lu(k,3290) - lu(k,1909) * lu(k,3251) - lu(k,3291) = lu(k,3291) - lu(k,1910) * lu(k,3251) - lu(k,3295) = lu(k,3295) - lu(k,1911) * lu(k,3251) - lu(k,3393) = lu(k,3393) - lu(k,1897) * lu(k,3392) - lu(k,3394) = lu(k,3394) - lu(k,1898) * lu(k,3392) - lu(k,3401) = lu(k,3401) - lu(k,1899) * lu(k,3392) - lu(k,3419) = lu(k,3419) - lu(k,1900) * lu(k,3392) - lu(k,3420) = lu(k,3420) - lu(k,1901) * lu(k,3392) - lu(k,3421) = lu(k,3421) - lu(k,1902) * lu(k,3392) - lu(k,3422) = lu(k,3422) - lu(k,1903) * lu(k,3392) - lu(k,3423) = lu(k,3423) - lu(k,1904) * lu(k,3392) - lu(k,3424) = lu(k,3424) - lu(k,1905) * lu(k,3392) - lu(k,3426) = lu(k,3426) - lu(k,1906) * lu(k,3392) - lu(k,3428) = lu(k,3428) - lu(k,1907) * lu(k,3392) - lu(k,3429) = lu(k,3429) - lu(k,1908) * lu(k,3392) - lu(k,3431) = lu(k,3431) - lu(k,1909) * lu(k,3392) - lu(k,3432) = lu(k,3432) - lu(k,1910) * lu(k,3392) - lu(k,3436) = lu(k,3436) - lu(k,1911) * lu(k,3392) - lu(k,3714) = lu(k,3714) - lu(k,1897) * lu(k,3713) - lu(k,3715) = lu(k,3715) - lu(k,1898) * lu(k,3713) - lu(k,3721) = lu(k,3721) - lu(k,1899) * lu(k,3713) - lu(k,3739) = lu(k,3739) - lu(k,1900) * lu(k,3713) - lu(k,3740) = lu(k,3740) - lu(k,1901) * lu(k,3713) - lu(k,3741) = lu(k,3741) - lu(k,1902) * lu(k,3713) - lu(k,3742) = lu(k,3742) - lu(k,1903) * lu(k,3713) - lu(k,3743) = lu(k,3743) - lu(k,1904) * lu(k,3713) - lu(k,3744) = lu(k,3744) - lu(k,1905) * lu(k,3713) - lu(k,3746) = lu(k,3746) - lu(k,1906) * lu(k,3713) - lu(k,3748) = lu(k,3748) - lu(k,1907) * lu(k,3713) - lu(k,3749) = lu(k,3749) - lu(k,1908) * lu(k,3713) - lu(k,3751) = lu(k,3751) - lu(k,1909) * lu(k,3713) - lu(k,3752) = lu(k,3752) - lu(k,1910) * lu(k,3713) - lu(k,3756) = lu(k,3756) - lu(k,1911) * lu(k,3713) - lu(k,1930) = 1._r8 / lu(k,1930) - lu(k,1931) = lu(k,1931) * lu(k,1930) - lu(k,1932) = lu(k,1932) * lu(k,1930) - lu(k,1933) = lu(k,1933) * lu(k,1930) - lu(k,1934) = lu(k,1934) * lu(k,1930) - lu(k,1935) = lu(k,1935) * lu(k,1930) - lu(k,1936) = lu(k,1936) * lu(k,1930) - lu(k,1937) = lu(k,1937) * lu(k,1930) - lu(k,1938) = lu(k,1938) * lu(k,1930) - lu(k,1939) = lu(k,1939) * lu(k,1930) - lu(k,1940) = lu(k,1940) * lu(k,1930) - lu(k,1941) = lu(k,1941) * lu(k,1930) - lu(k,1942) = lu(k,1942) * lu(k,1930) - lu(k,1943) = lu(k,1943) * lu(k,1930) - lu(k,1944) = lu(k,1944) * lu(k,1930) - lu(k,1945) = lu(k,1945) * lu(k,1930) - lu(k,2033) = lu(k,2033) - lu(k,1931) * lu(k,2031) - lu(k,2036) = lu(k,2036) - lu(k,1932) * lu(k,2031) - lu(k,2037) = lu(k,2037) - lu(k,1933) * lu(k,2031) - lu(k,2038) = lu(k,2038) - lu(k,1934) * lu(k,2031) - lu(k,2039) = lu(k,2039) - lu(k,1935) * lu(k,2031) - lu(k,2040) = lu(k,2040) - lu(k,1936) * lu(k,2031) - lu(k,2041) = lu(k,2041) - lu(k,1937) * lu(k,2031) - lu(k,2042) = lu(k,2042) - lu(k,1938) * lu(k,2031) - lu(k,2043) = lu(k,2043) - lu(k,1939) * lu(k,2031) - lu(k,2045) = lu(k,2045) - lu(k,1940) * lu(k,2031) - lu(k,2046) = lu(k,2046) - lu(k,1941) * lu(k,2031) - lu(k,2047) = lu(k,2047) - lu(k,1942) * lu(k,2031) - lu(k,2048) = lu(k,2048) - lu(k,1943) * lu(k,2031) - lu(k,2049) = lu(k,2049) - lu(k,1944) * lu(k,2031) - lu(k,2050) = lu(k,2050) - lu(k,1945) * lu(k,2031) - lu(k,2675) = lu(k,2675) - lu(k,1931) * lu(k,2673) - lu(k,2699) = lu(k,2699) - lu(k,1932) * lu(k,2673) - lu(k,2700) = lu(k,2700) - lu(k,1933) * lu(k,2673) - lu(k,2701) = lu(k,2701) - lu(k,1934) * lu(k,2673) - lu(k,2702) = lu(k,2702) - lu(k,1935) * lu(k,2673) - lu(k,2703) = lu(k,2703) - lu(k,1936) * lu(k,2673) - lu(k,2704) = lu(k,2704) - lu(k,1937) * lu(k,2673) - lu(k,2705) = lu(k,2705) - lu(k,1938) * lu(k,2673) - lu(k,2706) = lu(k,2706) - lu(k,1939) * lu(k,2673) - lu(k,2708) = - lu(k,1940) * lu(k,2673) - lu(k,2709) = lu(k,2709) - lu(k,1941) * lu(k,2673) - lu(k,2710) = lu(k,2710) - lu(k,1942) * lu(k,2673) - lu(k,2711) = - lu(k,1943) * lu(k,2673) - lu(k,2712) = - lu(k,1944) * lu(k,2673) - lu(k,2713) = lu(k,2713) - lu(k,1945) * lu(k,2673) - lu(k,2858) = lu(k,2858) - lu(k,1931) * lu(k,2856) - lu(k,2882) = lu(k,2882) - lu(k,1932) * lu(k,2856) - lu(k,2883) = lu(k,2883) - lu(k,1933) * lu(k,2856) - lu(k,2884) = lu(k,2884) - lu(k,1934) * lu(k,2856) - lu(k,2885) = lu(k,2885) - lu(k,1935) * lu(k,2856) - lu(k,2886) = lu(k,2886) - lu(k,1936) * lu(k,2856) - lu(k,2887) = lu(k,2887) - lu(k,1937) * lu(k,2856) - lu(k,2889) = lu(k,2889) - lu(k,1938) * lu(k,2856) - lu(k,2891) = lu(k,2891) - lu(k,1939) * lu(k,2856) - lu(k,2893) = lu(k,2893) - lu(k,1940) * lu(k,2856) - lu(k,2894) = lu(k,2894) - lu(k,1941) * lu(k,2856) - lu(k,2895) = lu(k,2895) - lu(k,1942) * lu(k,2856) - lu(k,2896) = - lu(k,1943) * lu(k,2856) - lu(k,2898) = lu(k,2898) - lu(k,1944) * lu(k,2856) - lu(k,2899) = lu(k,2899) - lu(k,1945) * lu(k,2856) - lu(k,2960) = lu(k,2960) - lu(k,1931) * lu(k,2958) - lu(k,2983) = lu(k,2983) - lu(k,1932) * lu(k,2958) - lu(k,2984) = lu(k,2984) - lu(k,1933) * lu(k,2958) - lu(k,2985) = lu(k,2985) - lu(k,1934) * lu(k,2958) - lu(k,2986) = lu(k,2986) - lu(k,1935) * lu(k,2958) - lu(k,2987) = lu(k,2987) - lu(k,1936) * lu(k,2958) - lu(k,2988) = lu(k,2988) - lu(k,1937) * lu(k,2958) - lu(k,2990) = lu(k,2990) - lu(k,1938) * lu(k,2958) - lu(k,2992) = lu(k,2992) - lu(k,1939) * lu(k,2958) - lu(k,2994) = lu(k,2994) - lu(k,1940) * lu(k,2958) - lu(k,2995) = lu(k,2995) - lu(k,1941) * lu(k,2958) - lu(k,2996) = lu(k,2996) - lu(k,1942) * lu(k,2958) - lu(k,2997) = lu(k,2997) - lu(k,1943) * lu(k,2958) - lu(k,2999) = lu(k,2999) - lu(k,1944) * lu(k,2958) - lu(k,3000) = lu(k,3000) - lu(k,1945) * lu(k,2958) - lu(k,3051) = lu(k,3051) - lu(k,1931) * lu(k,3049) - lu(k,3075) = lu(k,3075) - lu(k,1932) * lu(k,3049) - lu(k,3076) = lu(k,3076) - lu(k,1933) * lu(k,3049) - lu(k,3077) = lu(k,3077) - lu(k,1934) * lu(k,3049) - lu(k,3078) = lu(k,3078) - lu(k,1935) * lu(k,3049) - lu(k,3079) = lu(k,3079) - lu(k,1936) * lu(k,3049) - lu(k,3080) = lu(k,3080) - lu(k,1937) * lu(k,3049) - lu(k,3082) = lu(k,3082) - lu(k,1938) * lu(k,3049) - lu(k,3084) = lu(k,3084) - lu(k,1939) * lu(k,3049) - lu(k,3086) = lu(k,3086) - lu(k,1940) * lu(k,3049) - lu(k,3087) = lu(k,3087) - lu(k,1941) * lu(k,3049) - lu(k,3088) = lu(k,3088) - lu(k,1942) * lu(k,3049) - lu(k,3089) = lu(k,3089) - lu(k,1943) * lu(k,3049) - lu(k,3091) = lu(k,3091) - lu(k,1944) * lu(k,3049) - lu(k,3092) = lu(k,3092) - lu(k,1945) * lu(k,3049) - lu(k,3254) = lu(k,3254) - lu(k,1931) * lu(k,3252) - lu(k,3278) = lu(k,3278) - lu(k,1932) * lu(k,3252) - lu(k,3279) = lu(k,3279) - lu(k,1933) * lu(k,3252) - lu(k,3280) = lu(k,3280) - lu(k,1934) * lu(k,3252) - lu(k,3281) = lu(k,3281) - lu(k,1935) * lu(k,3252) - lu(k,3282) = lu(k,3282) - lu(k,1936) * lu(k,3252) - lu(k,3283) = lu(k,3283) - lu(k,1937) * lu(k,3252) - lu(k,3285) = lu(k,3285) - lu(k,1938) * lu(k,3252) - lu(k,3287) = lu(k,3287) - lu(k,1939) * lu(k,3252) - lu(k,3289) = lu(k,3289) - lu(k,1940) * lu(k,3252) - lu(k,3290) = lu(k,3290) - lu(k,1941) * lu(k,3252) - lu(k,3291) = lu(k,3291) - lu(k,1942) * lu(k,3252) - lu(k,3292) = lu(k,3292) - lu(k,1943) * lu(k,3252) - lu(k,3294) = lu(k,3294) - lu(k,1944) * lu(k,3252) - lu(k,3295) = lu(k,3295) - lu(k,1945) * lu(k,3252) - lu(k,3395) = lu(k,3395) - lu(k,1931) * lu(k,3393) - lu(k,3419) = lu(k,3419) - lu(k,1932) * lu(k,3393) - lu(k,3420) = lu(k,3420) - lu(k,1933) * lu(k,3393) - lu(k,3421) = lu(k,3421) - lu(k,1934) * lu(k,3393) - lu(k,3422) = lu(k,3422) - lu(k,1935) * lu(k,3393) - lu(k,3423) = lu(k,3423) - lu(k,1936) * lu(k,3393) - lu(k,3424) = lu(k,3424) - lu(k,1937) * lu(k,3393) - lu(k,3426) = lu(k,3426) - lu(k,1938) * lu(k,3393) - lu(k,3428) = lu(k,3428) - lu(k,1939) * lu(k,3393) - lu(k,3430) = - lu(k,1940) * lu(k,3393) - lu(k,3431) = lu(k,3431) - lu(k,1941) * lu(k,3393) - lu(k,3432) = lu(k,3432) - lu(k,1942) * lu(k,3393) - lu(k,3433) = - lu(k,1943) * lu(k,3393) - lu(k,3435) = lu(k,3435) - lu(k,1944) * lu(k,3393) - lu(k,3436) = lu(k,3436) - lu(k,1945) * lu(k,3393) - lu(k,3716) = lu(k,3716) - lu(k,1931) * lu(k,3714) - lu(k,3739) = lu(k,3739) - lu(k,1932) * lu(k,3714) - lu(k,3740) = lu(k,3740) - lu(k,1933) * lu(k,3714) - lu(k,3741) = lu(k,3741) - lu(k,1934) * lu(k,3714) - lu(k,3742) = lu(k,3742) - lu(k,1935) * lu(k,3714) - lu(k,3743) = lu(k,3743) - lu(k,1936) * lu(k,3714) - lu(k,3744) = lu(k,3744) - lu(k,1937) * lu(k,3714) - lu(k,3746) = lu(k,3746) - lu(k,1938) * lu(k,3714) - lu(k,3748) = lu(k,3748) - lu(k,1939) * lu(k,3714) - lu(k,3750) = lu(k,3750) - lu(k,1940) * lu(k,3714) - lu(k,3751) = lu(k,3751) - lu(k,1941) * lu(k,3714) - lu(k,3752) = lu(k,3752) - lu(k,1942) * lu(k,3714) - lu(k,3753) = lu(k,3753) - lu(k,1943) * lu(k,3714) - lu(k,3755) = lu(k,3755) - lu(k,1944) * lu(k,3714) - lu(k,3756) = lu(k,3756) - lu(k,1945) * lu(k,3714) - lu(k,1964) = 1._r8 / lu(k,1964) - lu(k,1965) = lu(k,1965) * lu(k,1964) - lu(k,1966) = lu(k,1966) * lu(k,1964) - lu(k,1967) = lu(k,1967) * lu(k,1964) - lu(k,1968) = lu(k,1968) * lu(k,1964) - lu(k,1969) = lu(k,1969) * lu(k,1964) - lu(k,1970) = lu(k,1970) * lu(k,1964) - lu(k,1971) = lu(k,1971) * lu(k,1964) - lu(k,1972) = lu(k,1972) * lu(k,1964) - lu(k,1973) = lu(k,1973) * lu(k,1964) - lu(k,1974) = lu(k,1974) * lu(k,1964) - lu(k,1975) = lu(k,1975) * lu(k,1964) - lu(k,1976) = lu(k,1976) * lu(k,1964) - lu(k,1977) = lu(k,1977) * lu(k,1964) - lu(k,1978) = lu(k,1978) * lu(k,1964) - lu(k,1979) = lu(k,1979) * lu(k,1964) - lu(k,2033) = lu(k,2033) - lu(k,1965) * lu(k,2032) - lu(k,2036) = lu(k,2036) - lu(k,1966) * lu(k,2032) - lu(k,2037) = lu(k,2037) - lu(k,1967) * lu(k,2032) - lu(k,2038) = lu(k,2038) - lu(k,1968) * lu(k,2032) - lu(k,2039) = lu(k,2039) - lu(k,1969) * lu(k,2032) - lu(k,2040) = lu(k,2040) - lu(k,1970) * lu(k,2032) - lu(k,2041) = lu(k,2041) - lu(k,1971) * lu(k,2032) - lu(k,2042) = lu(k,2042) - lu(k,1972) * lu(k,2032) - lu(k,2043) = lu(k,2043) - lu(k,1973) * lu(k,2032) - lu(k,2045) = lu(k,2045) - lu(k,1974) * lu(k,2032) - lu(k,2046) = lu(k,2046) - lu(k,1975) * lu(k,2032) - lu(k,2047) = lu(k,2047) - lu(k,1976) * lu(k,2032) - lu(k,2048) = lu(k,2048) - lu(k,1977) * lu(k,2032) - lu(k,2049) = lu(k,2049) - lu(k,1978) * lu(k,2032) - lu(k,2050) = lu(k,2050) - lu(k,1979) * lu(k,2032) - lu(k,2675) = lu(k,2675) - lu(k,1965) * lu(k,2674) - lu(k,2699) = lu(k,2699) - lu(k,1966) * lu(k,2674) - lu(k,2700) = lu(k,2700) - lu(k,1967) * lu(k,2674) - lu(k,2701) = lu(k,2701) - lu(k,1968) * lu(k,2674) - lu(k,2702) = lu(k,2702) - lu(k,1969) * lu(k,2674) - lu(k,2703) = lu(k,2703) - lu(k,1970) * lu(k,2674) - lu(k,2704) = lu(k,2704) - lu(k,1971) * lu(k,2674) - lu(k,2705) = lu(k,2705) - lu(k,1972) * lu(k,2674) - lu(k,2706) = lu(k,2706) - lu(k,1973) * lu(k,2674) - lu(k,2708) = lu(k,2708) - lu(k,1974) * lu(k,2674) - lu(k,2709) = lu(k,2709) - lu(k,1975) * lu(k,2674) - lu(k,2710) = lu(k,2710) - lu(k,1976) * lu(k,2674) - lu(k,2711) = lu(k,2711) - lu(k,1977) * lu(k,2674) - lu(k,2712) = lu(k,2712) - lu(k,1978) * lu(k,2674) - lu(k,2713) = lu(k,2713) - lu(k,1979) * lu(k,2674) - lu(k,2858) = lu(k,2858) - lu(k,1965) * lu(k,2857) - lu(k,2882) = lu(k,2882) - lu(k,1966) * lu(k,2857) - lu(k,2883) = lu(k,2883) - lu(k,1967) * lu(k,2857) - lu(k,2884) = lu(k,2884) - lu(k,1968) * lu(k,2857) - lu(k,2885) = lu(k,2885) - lu(k,1969) * lu(k,2857) - lu(k,2886) = lu(k,2886) - lu(k,1970) * lu(k,2857) - lu(k,2887) = lu(k,2887) - lu(k,1971) * lu(k,2857) - lu(k,2889) = lu(k,2889) - lu(k,1972) * lu(k,2857) - lu(k,2891) = lu(k,2891) - lu(k,1973) * lu(k,2857) - lu(k,2893) = lu(k,2893) - lu(k,1974) * lu(k,2857) - lu(k,2894) = lu(k,2894) - lu(k,1975) * lu(k,2857) - lu(k,2895) = lu(k,2895) - lu(k,1976) * lu(k,2857) - lu(k,2896) = lu(k,2896) - lu(k,1977) * lu(k,2857) - lu(k,2898) = lu(k,2898) - lu(k,1978) * lu(k,2857) - lu(k,2899) = lu(k,2899) - lu(k,1979) * lu(k,2857) - lu(k,2960) = lu(k,2960) - lu(k,1965) * lu(k,2959) - lu(k,2983) = lu(k,2983) - lu(k,1966) * lu(k,2959) - lu(k,2984) = lu(k,2984) - lu(k,1967) * lu(k,2959) - lu(k,2985) = lu(k,2985) - lu(k,1968) * lu(k,2959) - lu(k,2986) = lu(k,2986) - lu(k,1969) * lu(k,2959) - lu(k,2987) = lu(k,2987) - lu(k,1970) * lu(k,2959) - lu(k,2988) = lu(k,2988) - lu(k,1971) * lu(k,2959) - lu(k,2990) = lu(k,2990) - lu(k,1972) * lu(k,2959) - lu(k,2992) = lu(k,2992) - lu(k,1973) * lu(k,2959) - lu(k,2994) = lu(k,2994) - lu(k,1974) * lu(k,2959) - lu(k,2995) = lu(k,2995) - lu(k,1975) * lu(k,2959) - lu(k,2996) = lu(k,2996) - lu(k,1976) * lu(k,2959) - lu(k,2997) = lu(k,2997) - lu(k,1977) * lu(k,2959) - lu(k,2999) = lu(k,2999) - lu(k,1978) * lu(k,2959) - lu(k,3000) = lu(k,3000) - lu(k,1979) * lu(k,2959) - lu(k,3051) = lu(k,3051) - lu(k,1965) * lu(k,3050) - lu(k,3075) = lu(k,3075) - lu(k,1966) * lu(k,3050) - lu(k,3076) = lu(k,3076) - lu(k,1967) * lu(k,3050) - lu(k,3077) = lu(k,3077) - lu(k,1968) * lu(k,3050) - lu(k,3078) = lu(k,3078) - lu(k,1969) * lu(k,3050) - lu(k,3079) = lu(k,3079) - lu(k,1970) * lu(k,3050) - lu(k,3080) = lu(k,3080) - lu(k,1971) * lu(k,3050) - lu(k,3082) = lu(k,3082) - lu(k,1972) * lu(k,3050) - lu(k,3084) = lu(k,3084) - lu(k,1973) * lu(k,3050) - lu(k,3086) = lu(k,3086) - lu(k,1974) * lu(k,3050) - lu(k,3087) = lu(k,3087) - lu(k,1975) * lu(k,3050) - lu(k,3088) = lu(k,3088) - lu(k,1976) * lu(k,3050) - lu(k,3089) = lu(k,3089) - lu(k,1977) * lu(k,3050) - lu(k,3091) = lu(k,3091) - lu(k,1978) * lu(k,3050) - lu(k,3092) = lu(k,3092) - lu(k,1979) * lu(k,3050) - lu(k,3254) = lu(k,3254) - lu(k,1965) * lu(k,3253) - lu(k,3278) = lu(k,3278) - lu(k,1966) * lu(k,3253) - lu(k,3279) = lu(k,3279) - lu(k,1967) * lu(k,3253) - lu(k,3280) = lu(k,3280) - lu(k,1968) * lu(k,3253) - lu(k,3281) = lu(k,3281) - lu(k,1969) * lu(k,3253) - lu(k,3282) = lu(k,3282) - lu(k,1970) * lu(k,3253) - lu(k,3283) = lu(k,3283) - lu(k,1971) * lu(k,3253) - lu(k,3285) = lu(k,3285) - lu(k,1972) * lu(k,3253) - lu(k,3287) = lu(k,3287) - lu(k,1973) * lu(k,3253) - lu(k,3289) = lu(k,3289) - lu(k,1974) * lu(k,3253) - lu(k,3290) = lu(k,3290) - lu(k,1975) * lu(k,3253) - lu(k,3291) = lu(k,3291) - lu(k,1976) * lu(k,3253) - lu(k,3292) = lu(k,3292) - lu(k,1977) * lu(k,3253) - lu(k,3294) = lu(k,3294) - lu(k,1978) * lu(k,3253) - lu(k,3295) = lu(k,3295) - lu(k,1979) * lu(k,3253) - lu(k,3395) = lu(k,3395) - lu(k,1965) * lu(k,3394) - lu(k,3419) = lu(k,3419) - lu(k,1966) * lu(k,3394) - lu(k,3420) = lu(k,3420) - lu(k,1967) * lu(k,3394) - lu(k,3421) = lu(k,3421) - lu(k,1968) * lu(k,3394) - lu(k,3422) = lu(k,3422) - lu(k,1969) * lu(k,3394) - lu(k,3423) = lu(k,3423) - lu(k,1970) * lu(k,3394) - lu(k,3424) = lu(k,3424) - lu(k,1971) * lu(k,3394) - lu(k,3426) = lu(k,3426) - lu(k,1972) * lu(k,3394) - lu(k,3428) = lu(k,3428) - lu(k,1973) * lu(k,3394) - lu(k,3430) = lu(k,3430) - lu(k,1974) * lu(k,3394) - lu(k,3431) = lu(k,3431) - lu(k,1975) * lu(k,3394) - lu(k,3432) = lu(k,3432) - lu(k,1976) * lu(k,3394) - lu(k,3433) = lu(k,3433) - lu(k,1977) * lu(k,3394) - lu(k,3435) = lu(k,3435) - lu(k,1978) * lu(k,3394) - lu(k,3436) = lu(k,3436) - lu(k,1979) * lu(k,3394) - lu(k,3716) = lu(k,3716) - lu(k,1965) * lu(k,3715) - lu(k,3739) = lu(k,3739) - lu(k,1966) * lu(k,3715) - lu(k,3740) = lu(k,3740) - lu(k,1967) * lu(k,3715) - lu(k,3741) = lu(k,3741) - lu(k,1968) * lu(k,3715) - lu(k,3742) = lu(k,3742) - lu(k,1969) * lu(k,3715) - lu(k,3743) = lu(k,3743) - lu(k,1970) * lu(k,3715) - lu(k,3744) = lu(k,3744) - lu(k,1971) * lu(k,3715) - lu(k,3746) = lu(k,3746) - lu(k,1972) * lu(k,3715) - lu(k,3748) = lu(k,3748) - lu(k,1973) * lu(k,3715) - lu(k,3750) = lu(k,3750) - lu(k,1974) * lu(k,3715) - lu(k,3751) = lu(k,3751) - lu(k,1975) * lu(k,3715) - lu(k,3752) = lu(k,3752) - lu(k,1976) * lu(k,3715) - lu(k,3753) = lu(k,3753) - lu(k,1977) * lu(k,3715) - lu(k,3755) = lu(k,3755) - lu(k,1978) * lu(k,3715) - lu(k,3756) = lu(k,3756) - lu(k,1979) * lu(k,3715) + lu(k,1846) = 1._r8 / lu(k,1846) + lu(k,1847) = lu(k,1847) * lu(k,1846) + lu(k,1848) = lu(k,1848) * lu(k,1846) + lu(k,1849) = lu(k,1849) * lu(k,1846) + lu(k,1850) = lu(k,1850) * lu(k,1846) + lu(k,1851) = lu(k,1851) * lu(k,1846) + lu(k,1852) = lu(k,1852) * lu(k,1846) + lu(k,1853) = lu(k,1853) * lu(k,1846) + lu(k,1854) = lu(k,1854) * lu(k,1846) + lu(k,1855) = lu(k,1855) * lu(k,1846) + lu(k,1856) = lu(k,1856) * lu(k,1846) + lu(k,1857) = lu(k,1857) * lu(k,1846) + lu(k,1858) = lu(k,1858) * lu(k,1846) + lu(k,1859) = lu(k,1859) * lu(k,1846) + lu(k,1860) = lu(k,1860) * lu(k,1846) + lu(k,1861) = lu(k,1861) * lu(k,1846) + lu(k,1862) = lu(k,1862) * lu(k,1846) + lu(k,1863) = lu(k,1863) * lu(k,1846) + lu(k,1954) = lu(k,1954) - lu(k,1847) * lu(k,1953) + lu(k,1955) = lu(k,1955) - lu(k,1848) * lu(k,1953) + lu(k,1956) = lu(k,1956) - lu(k,1849) * lu(k,1953) + lu(k,1957) = lu(k,1957) - lu(k,1850) * lu(k,1953) + lu(k,1958) = lu(k,1958) - lu(k,1851) * lu(k,1953) + lu(k,1959) = lu(k,1959) - lu(k,1852) * lu(k,1953) + lu(k,1962) = lu(k,1962) - lu(k,1853) * lu(k,1953) + lu(k,1963) = lu(k,1963) - lu(k,1854) * lu(k,1953) + lu(k,1964) = lu(k,1964) - lu(k,1855) * lu(k,1953) + lu(k,1965) = lu(k,1965) - lu(k,1856) * lu(k,1953) + lu(k,1967) = lu(k,1967) - lu(k,1857) * lu(k,1953) + lu(k,1968) = lu(k,1968) - lu(k,1858) * lu(k,1953) + lu(k,1969) = lu(k,1969) - lu(k,1859) * lu(k,1953) + lu(k,1970) = lu(k,1970) - lu(k,1860) * lu(k,1953) + lu(k,1972) = lu(k,1972) - lu(k,1861) * lu(k,1953) + lu(k,1973) = lu(k,1973) - lu(k,1862) * lu(k,1953) + lu(k,1974) = - lu(k,1863) * lu(k,1953) + lu(k,2985) = lu(k,2985) - lu(k,1847) * lu(k,2984) + lu(k,2986) = lu(k,2986) - lu(k,1848) * lu(k,2984) + lu(k,2987) = lu(k,2987) - lu(k,1849) * lu(k,2984) + lu(k,2988) = lu(k,2988) - lu(k,1850) * lu(k,2984) + lu(k,2989) = lu(k,2989) - lu(k,1851) * lu(k,2984) + lu(k,2990) = lu(k,2990) - lu(k,1852) * lu(k,2984) + lu(k,2993) = lu(k,2993) - lu(k,1853) * lu(k,2984) + lu(k,2994) = lu(k,2994) - lu(k,1854) * lu(k,2984) + lu(k,3023) = lu(k,3023) - lu(k,1855) * lu(k,2984) + lu(k,3026) = lu(k,3026) - lu(k,1856) * lu(k,2984) + lu(k,3028) = lu(k,3028) - lu(k,1857) * lu(k,2984) + lu(k,3029) = lu(k,3029) - lu(k,1858) * lu(k,2984) + lu(k,3030) = lu(k,3030) - lu(k,1859) * lu(k,2984) + lu(k,3031) = lu(k,3031) - lu(k,1860) * lu(k,2984) + lu(k,3034) = lu(k,3034) - lu(k,1861) * lu(k,2984) + lu(k,3035) = lu(k,3035) - lu(k,1862) * lu(k,2984) + lu(k,3036) = lu(k,3036) - lu(k,1863) * lu(k,2984) + lu(k,3086) = lu(k,3086) - lu(k,1847) * lu(k,3085) + lu(k,3087) = lu(k,3087) - lu(k,1848) * lu(k,3085) + lu(k,3088) = lu(k,3088) - lu(k,1849) * lu(k,3085) + lu(k,3089) = lu(k,3089) - lu(k,1850) * lu(k,3085) + lu(k,3090) = lu(k,3090) - lu(k,1851) * lu(k,3085) + lu(k,3091) = lu(k,3091) - lu(k,1852) * lu(k,3085) + lu(k,3094) = lu(k,3094) - lu(k,1853) * lu(k,3085) + lu(k,3095) = lu(k,3095) - lu(k,1854) * lu(k,3085) + lu(k,3126) = lu(k,3126) - lu(k,1855) * lu(k,3085) + lu(k,3129) = lu(k,3129) - lu(k,1856) * lu(k,3085) + lu(k,3131) = lu(k,3131) - lu(k,1857) * lu(k,3085) + lu(k,3132) = lu(k,3132) - lu(k,1858) * lu(k,3085) + lu(k,3133) = lu(k,3133) - lu(k,1859) * lu(k,3085) + lu(k,3134) = lu(k,3134) - lu(k,1860) * lu(k,3085) + lu(k,3137) = lu(k,3137) - lu(k,1861) * lu(k,3085) + lu(k,3138) = lu(k,3138) - lu(k,1862) * lu(k,3085) + lu(k,3139) = lu(k,3139) - lu(k,1863) * lu(k,3085) + lu(k,3267) = lu(k,3267) - lu(k,1847) * lu(k,3266) + lu(k,3268) = lu(k,3268) - lu(k,1848) * lu(k,3266) + lu(k,3269) = lu(k,3269) - lu(k,1849) * lu(k,3266) + lu(k,3270) = lu(k,3270) - lu(k,1850) * lu(k,3266) + lu(k,3271) = lu(k,3271) - lu(k,1851) * lu(k,3266) + lu(k,3272) = lu(k,3272) - lu(k,1852) * lu(k,3266) + lu(k,3275) = lu(k,3275) - lu(k,1853) * lu(k,3266) + lu(k,3276) = lu(k,3276) - lu(k,1854) * lu(k,3266) + lu(k,3308) = lu(k,3308) - lu(k,1855) * lu(k,3266) + lu(k,3311) = lu(k,3311) - lu(k,1856) * lu(k,3266) + lu(k,3313) = lu(k,3313) - lu(k,1857) * lu(k,3266) + lu(k,3314) = lu(k,3314) - lu(k,1858) * lu(k,3266) + lu(k,3315) = lu(k,3315) - lu(k,1859) * lu(k,3266) + lu(k,3316) = lu(k,3316) - lu(k,1860) * lu(k,3266) + lu(k,3319) = lu(k,3319) - lu(k,1861) * lu(k,3266) + lu(k,3320) = lu(k,3320) - lu(k,1862) * lu(k,3266) + lu(k,3321) = lu(k,3321) - lu(k,1863) * lu(k,3266) + lu(k,3523) = lu(k,3523) - lu(k,1847) * lu(k,3522) + lu(k,3524) = lu(k,3524) - lu(k,1848) * lu(k,3522) + lu(k,3525) = lu(k,3525) - lu(k,1849) * lu(k,3522) + lu(k,3526) = lu(k,3526) - lu(k,1850) * lu(k,3522) + lu(k,3527) = lu(k,3527) - lu(k,1851) * lu(k,3522) + lu(k,3528) = lu(k,3528) - lu(k,1852) * lu(k,3522) + lu(k,3531) = lu(k,3531) - lu(k,1853) * lu(k,3522) + lu(k,3532) = lu(k,3532) - lu(k,1854) * lu(k,3522) + lu(k,3564) = lu(k,3564) - lu(k,1855) * lu(k,3522) + lu(k,3567) = lu(k,3567) - lu(k,1856) * lu(k,3522) + lu(k,3569) = lu(k,3569) - lu(k,1857) * lu(k,3522) + lu(k,3570) = lu(k,3570) - lu(k,1858) * lu(k,3522) + lu(k,3571) = lu(k,3571) - lu(k,1859) * lu(k,3522) + lu(k,3572) = lu(k,3572) - lu(k,1860) * lu(k,3522) + lu(k,3575) = lu(k,3575) - lu(k,1861) * lu(k,3522) + lu(k,3576) = lu(k,3576) - lu(k,1862) * lu(k,3522) + lu(k,3577) = lu(k,3577) - lu(k,1863) * lu(k,3522) + lu(k,3774) = lu(k,3774) - lu(k,1847) * lu(k,3773) + lu(k,3775) = lu(k,3775) - lu(k,1848) * lu(k,3773) + lu(k,3776) = lu(k,3776) - lu(k,1849) * lu(k,3773) + lu(k,3777) = lu(k,3777) - lu(k,1850) * lu(k,3773) + lu(k,3778) = lu(k,3778) - lu(k,1851) * lu(k,3773) + lu(k,3779) = lu(k,3779) - lu(k,1852) * lu(k,3773) + lu(k,3782) = lu(k,3782) - lu(k,1853) * lu(k,3773) + lu(k,3783) = lu(k,3783) - lu(k,1854) * lu(k,3773) + lu(k,3814) = lu(k,3814) - lu(k,1855) * lu(k,3773) + lu(k,3817) = lu(k,3817) - lu(k,1856) * lu(k,3773) + lu(k,3819) = lu(k,3819) - lu(k,1857) * lu(k,3773) + lu(k,3820) = lu(k,3820) - lu(k,1858) * lu(k,3773) + lu(k,3821) = lu(k,3821) - lu(k,1859) * lu(k,3773) + lu(k,3822) = lu(k,3822) - lu(k,1860) * lu(k,3773) + lu(k,3825) = lu(k,3825) - lu(k,1861) * lu(k,3773) + lu(k,3826) = lu(k,3826) - lu(k,1862) * lu(k,3773) + lu(k,3827) = lu(k,3827) - lu(k,1863) * lu(k,3773) + lu(k,3908) = lu(k,3908) - lu(k,1847) * lu(k,3907) + lu(k,3909) = lu(k,3909) - lu(k,1848) * lu(k,3907) + lu(k,3910) = lu(k,3910) - lu(k,1849) * lu(k,3907) + lu(k,3911) = lu(k,3911) - lu(k,1850) * lu(k,3907) + lu(k,3912) = - lu(k,1851) * lu(k,3907) + lu(k,3913) = lu(k,3913) - lu(k,1852) * lu(k,3907) + lu(k,3916) = lu(k,3916) - lu(k,1853) * lu(k,3907) + lu(k,3917) = lu(k,3917) - lu(k,1854) * lu(k,3907) + lu(k,3949) = lu(k,3949) - lu(k,1855) * lu(k,3907) + lu(k,3952) = lu(k,3952) - lu(k,1856) * lu(k,3907) + lu(k,3954) = lu(k,3954) - lu(k,1857) * lu(k,3907) + lu(k,3955) = lu(k,3955) - lu(k,1858) * lu(k,3907) + lu(k,3956) = lu(k,3956) - lu(k,1859) * lu(k,3907) + lu(k,3957) = lu(k,3957) - lu(k,1860) * lu(k,3907) + lu(k,3960) = lu(k,3960) - lu(k,1861) * lu(k,3907) + lu(k,3961) = lu(k,3961) - lu(k,1862) * lu(k,3907) + lu(k,3962) = lu(k,3962) - lu(k,1863) * lu(k,3907) + lu(k,4002) = lu(k,4002) - lu(k,1847) * lu(k,4001) + lu(k,4003) = lu(k,4003) - lu(k,1848) * lu(k,4001) + lu(k,4004) = lu(k,4004) - lu(k,1849) * lu(k,4001) + lu(k,4005) = lu(k,4005) - lu(k,1850) * lu(k,4001) + lu(k,4006) = lu(k,4006) - lu(k,1851) * lu(k,4001) + lu(k,4007) = lu(k,4007) - lu(k,1852) * lu(k,4001) + lu(k,4010) = lu(k,4010) - lu(k,1853) * lu(k,4001) + lu(k,4011) = lu(k,4011) - lu(k,1854) * lu(k,4001) + lu(k,4041) = lu(k,4041) - lu(k,1855) * lu(k,4001) + lu(k,4044) = lu(k,4044) - lu(k,1856) * lu(k,4001) + lu(k,4046) = lu(k,4046) - lu(k,1857) * lu(k,4001) + lu(k,4047) = lu(k,4047) - lu(k,1858) * lu(k,4001) + lu(k,4048) = lu(k,4048) - lu(k,1859) * lu(k,4001) + lu(k,4049) = lu(k,4049) - lu(k,1860) * lu(k,4001) + lu(k,4052) = lu(k,4052) - lu(k,1861) * lu(k,4001) + lu(k,4053) = lu(k,4053) - lu(k,1862) * lu(k,4001) + lu(k,4054) = lu(k,4054) - lu(k,1863) * lu(k,4001) + lu(k,1870) = 1._r8 / lu(k,1870) + lu(k,1871) = lu(k,1871) * lu(k,1870) + lu(k,1872) = lu(k,1872) * lu(k,1870) + lu(k,1873) = lu(k,1873) * lu(k,1870) + lu(k,1874) = lu(k,1874) * lu(k,1870) + lu(k,1875) = lu(k,1875) * lu(k,1870) + lu(k,1876) = lu(k,1876) * lu(k,1870) + lu(k,1877) = lu(k,1877) * lu(k,1870) + lu(k,1878) = lu(k,1878) * lu(k,1870) + lu(k,1879) = lu(k,1879) * lu(k,1870) + lu(k,1880) = lu(k,1880) * lu(k,1870) + lu(k,1895) = lu(k,1895) - lu(k,1871) * lu(k,1893) + lu(k,1896) = lu(k,1896) - lu(k,1872) * lu(k,1893) + lu(k,1897) = lu(k,1897) - lu(k,1873) * lu(k,1893) + lu(k,1902) = lu(k,1902) - lu(k,1874) * lu(k,1893) + lu(k,1903) = lu(k,1903) - lu(k,1875) * lu(k,1893) + lu(k,1904) = lu(k,1904) - lu(k,1876) * lu(k,1893) + lu(k,1905) = lu(k,1905) - lu(k,1877) * lu(k,1893) + lu(k,1906) = lu(k,1906) - lu(k,1878) * lu(k,1893) + lu(k,1907) = lu(k,1907) - lu(k,1879) * lu(k,1893) + lu(k,1908) = lu(k,1908) - lu(k,1880) * lu(k,1893) + lu(k,1956) = lu(k,1956) - lu(k,1871) * lu(k,1954) + lu(k,1957) = lu(k,1957) - lu(k,1872) * lu(k,1954) + lu(k,1958) = lu(k,1958) - lu(k,1873) * lu(k,1954) + lu(k,1964) = lu(k,1964) - lu(k,1874) * lu(k,1954) + lu(k,1965) = lu(k,1965) - lu(k,1875) * lu(k,1954) + lu(k,1967) = lu(k,1967) - lu(k,1876) * lu(k,1954) + lu(k,1968) = lu(k,1968) - lu(k,1877) * lu(k,1954) + lu(k,1969) = lu(k,1969) - lu(k,1878) * lu(k,1954) + lu(k,1970) = lu(k,1970) - lu(k,1879) * lu(k,1954) + lu(k,1973) = lu(k,1973) - lu(k,1880) * lu(k,1954) + lu(k,1993) = lu(k,1993) - lu(k,1871) * lu(k,1991) + lu(k,1994) = lu(k,1994) - lu(k,1872) * lu(k,1991) + lu(k,1995) = lu(k,1995) - lu(k,1873) * lu(k,1991) + lu(k,2003) = lu(k,2003) - lu(k,1874) * lu(k,1991) + lu(k,2004) = lu(k,2004) - lu(k,1875) * lu(k,1991) + lu(k,2006) = lu(k,2006) - lu(k,1876) * lu(k,1991) + lu(k,2007) = lu(k,2007) - lu(k,1877) * lu(k,1991) + lu(k,2008) = lu(k,2008) - lu(k,1878) * lu(k,1991) + lu(k,2009) = lu(k,2009) - lu(k,1879) * lu(k,1991) + lu(k,2012) = lu(k,2012) - lu(k,1880) * lu(k,1991) + lu(k,2075) = lu(k,2075) - lu(k,1871) * lu(k,2074) + lu(k,2076) = lu(k,2076) - lu(k,1872) * lu(k,2074) + lu(k,2077) = lu(k,2077) - lu(k,1873) * lu(k,2074) + lu(k,2080) = lu(k,2080) - lu(k,1874) * lu(k,2074) + lu(k,2083) = lu(k,2083) - lu(k,1875) * lu(k,2074) + lu(k,2085) = lu(k,2085) - lu(k,1876) * lu(k,2074) + lu(k,2086) = lu(k,2086) - lu(k,1877) * lu(k,2074) + lu(k,2087) = lu(k,2087) - lu(k,1878) * lu(k,2074) + lu(k,2088) = lu(k,2088) - lu(k,1879) * lu(k,2074) + lu(k,2091) = lu(k,2091) - lu(k,1880) * lu(k,2074) + lu(k,2107) = lu(k,2107) - lu(k,1871) * lu(k,2106) + lu(k,2108) = lu(k,2108) - lu(k,1872) * lu(k,2106) + lu(k,2109) = lu(k,2109) - lu(k,1873) * lu(k,2106) + lu(k,2112) = lu(k,2112) - lu(k,1874) * lu(k,2106) + lu(k,2115) = lu(k,2115) - lu(k,1875) * lu(k,2106) + lu(k,2117) = lu(k,2117) - lu(k,1876) * lu(k,2106) + lu(k,2118) = lu(k,2118) - lu(k,1877) * lu(k,2106) + lu(k,2119) = lu(k,2119) - lu(k,1878) * lu(k,2106) + lu(k,2120) = lu(k,2120) - lu(k,1879) * lu(k,2106) + lu(k,2123) = lu(k,2123) - lu(k,1880) * lu(k,2106) + lu(k,2137) = lu(k,2137) - lu(k,1871) * lu(k,2136) + lu(k,2138) = lu(k,2138) - lu(k,1872) * lu(k,2136) + lu(k,2139) = lu(k,2139) - lu(k,1873) * lu(k,2136) + lu(k,2141) = lu(k,2141) - lu(k,1874) * lu(k,2136) + lu(k,2144) = lu(k,2144) - lu(k,1875) * lu(k,2136) + lu(k,2146) = lu(k,2146) - lu(k,1876) * lu(k,2136) + lu(k,2147) = lu(k,2147) - lu(k,1877) * lu(k,2136) + lu(k,2148) = lu(k,2148) - lu(k,1878) * lu(k,2136) + lu(k,2149) = lu(k,2149) - lu(k,1879) * lu(k,2136) + lu(k,2152) = lu(k,2152) - lu(k,1880) * lu(k,2136) + lu(k,2987) = lu(k,2987) - lu(k,1871) * lu(k,2985) + lu(k,2988) = lu(k,2988) - lu(k,1872) * lu(k,2985) + lu(k,2989) = lu(k,2989) - lu(k,1873) * lu(k,2985) + lu(k,3023) = lu(k,3023) - lu(k,1874) * lu(k,2985) + lu(k,3026) = lu(k,3026) - lu(k,1875) * lu(k,2985) + lu(k,3028) = lu(k,3028) - lu(k,1876) * lu(k,2985) + lu(k,3029) = lu(k,3029) - lu(k,1877) * lu(k,2985) + lu(k,3030) = lu(k,3030) - lu(k,1878) * lu(k,2985) + lu(k,3031) = lu(k,3031) - lu(k,1879) * lu(k,2985) + lu(k,3035) = lu(k,3035) - lu(k,1880) * lu(k,2985) + lu(k,3088) = lu(k,3088) - lu(k,1871) * lu(k,3086) + lu(k,3089) = lu(k,3089) - lu(k,1872) * lu(k,3086) + lu(k,3090) = lu(k,3090) - lu(k,1873) * lu(k,3086) + lu(k,3126) = lu(k,3126) - lu(k,1874) * lu(k,3086) + lu(k,3129) = lu(k,3129) - lu(k,1875) * lu(k,3086) + lu(k,3131) = lu(k,3131) - lu(k,1876) * lu(k,3086) + lu(k,3132) = lu(k,3132) - lu(k,1877) * lu(k,3086) + lu(k,3133) = lu(k,3133) - lu(k,1878) * lu(k,3086) + lu(k,3134) = lu(k,3134) - lu(k,1879) * lu(k,3086) + lu(k,3138) = lu(k,3138) - lu(k,1880) * lu(k,3086) + lu(k,3269) = lu(k,3269) - lu(k,1871) * lu(k,3267) + lu(k,3270) = lu(k,3270) - lu(k,1872) * lu(k,3267) + lu(k,3271) = lu(k,3271) - lu(k,1873) * lu(k,3267) + lu(k,3308) = lu(k,3308) - lu(k,1874) * lu(k,3267) + lu(k,3311) = lu(k,3311) - lu(k,1875) * lu(k,3267) + lu(k,3313) = lu(k,3313) - lu(k,1876) * lu(k,3267) + lu(k,3314) = lu(k,3314) - lu(k,1877) * lu(k,3267) + lu(k,3315) = lu(k,3315) - lu(k,1878) * lu(k,3267) + lu(k,3316) = lu(k,3316) - lu(k,1879) * lu(k,3267) + lu(k,3320) = lu(k,3320) - lu(k,1880) * lu(k,3267) + lu(k,3525) = lu(k,3525) - lu(k,1871) * lu(k,3523) + lu(k,3526) = lu(k,3526) - lu(k,1872) * lu(k,3523) + lu(k,3527) = lu(k,3527) - lu(k,1873) * lu(k,3523) + lu(k,3564) = lu(k,3564) - lu(k,1874) * lu(k,3523) + lu(k,3567) = lu(k,3567) - lu(k,1875) * lu(k,3523) + lu(k,3569) = lu(k,3569) - lu(k,1876) * lu(k,3523) + lu(k,3570) = lu(k,3570) - lu(k,1877) * lu(k,3523) + lu(k,3571) = lu(k,3571) - lu(k,1878) * lu(k,3523) + lu(k,3572) = lu(k,3572) - lu(k,1879) * lu(k,3523) + lu(k,3576) = lu(k,3576) - lu(k,1880) * lu(k,3523) + lu(k,3776) = lu(k,3776) - lu(k,1871) * lu(k,3774) + lu(k,3777) = lu(k,3777) - lu(k,1872) * lu(k,3774) + lu(k,3778) = lu(k,3778) - lu(k,1873) * lu(k,3774) + lu(k,3814) = lu(k,3814) - lu(k,1874) * lu(k,3774) + lu(k,3817) = lu(k,3817) - lu(k,1875) * lu(k,3774) + lu(k,3819) = lu(k,3819) - lu(k,1876) * lu(k,3774) + lu(k,3820) = lu(k,3820) - lu(k,1877) * lu(k,3774) + lu(k,3821) = lu(k,3821) - lu(k,1878) * lu(k,3774) + lu(k,3822) = lu(k,3822) - lu(k,1879) * lu(k,3774) + lu(k,3826) = lu(k,3826) - lu(k,1880) * lu(k,3774) + lu(k,3910) = lu(k,3910) - lu(k,1871) * lu(k,3908) + lu(k,3911) = lu(k,3911) - lu(k,1872) * lu(k,3908) + lu(k,3912) = lu(k,3912) - lu(k,1873) * lu(k,3908) + lu(k,3949) = lu(k,3949) - lu(k,1874) * lu(k,3908) + lu(k,3952) = lu(k,3952) - lu(k,1875) * lu(k,3908) + lu(k,3954) = lu(k,3954) - lu(k,1876) * lu(k,3908) + lu(k,3955) = lu(k,3955) - lu(k,1877) * lu(k,3908) + lu(k,3956) = lu(k,3956) - lu(k,1878) * lu(k,3908) + lu(k,3957) = lu(k,3957) - lu(k,1879) * lu(k,3908) + lu(k,3961) = lu(k,3961) - lu(k,1880) * lu(k,3908) + lu(k,4004) = lu(k,4004) - lu(k,1871) * lu(k,4002) + lu(k,4005) = lu(k,4005) - lu(k,1872) * lu(k,4002) + lu(k,4006) = lu(k,4006) - lu(k,1873) * lu(k,4002) + lu(k,4041) = lu(k,4041) - lu(k,1874) * lu(k,4002) + lu(k,4044) = lu(k,4044) - lu(k,1875) * lu(k,4002) + lu(k,4046) = lu(k,4046) - lu(k,1876) * lu(k,4002) + lu(k,4047) = lu(k,4047) - lu(k,1877) * lu(k,4002) + lu(k,4048) = lu(k,4048) - lu(k,1878) * lu(k,4002) + lu(k,4049) = lu(k,4049) - lu(k,1879) * lu(k,4002) + lu(k,4053) = lu(k,4053) - lu(k,1880) * lu(k,4002) + lu(k,1894) = 1._r8 / lu(k,1894) + lu(k,1895) = lu(k,1895) * lu(k,1894) + lu(k,1896) = lu(k,1896) * lu(k,1894) + lu(k,1897) = lu(k,1897) * lu(k,1894) + lu(k,1898) = lu(k,1898) * lu(k,1894) + lu(k,1899) = lu(k,1899) * lu(k,1894) + lu(k,1900) = lu(k,1900) * lu(k,1894) + lu(k,1901) = lu(k,1901) * lu(k,1894) + lu(k,1902) = lu(k,1902) * lu(k,1894) + lu(k,1903) = lu(k,1903) * lu(k,1894) + lu(k,1904) = lu(k,1904) * lu(k,1894) + lu(k,1905) = lu(k,1905) * lu(k,1894) + lu(k,1906) = lu(k,1906) * lu(k,1894) + lu(k,1907) = lu(k,1907) * lu(k,1894) + lu(k,1908) = lu(k,1908) * lu(k,1894) + lu(k,1956) = lu(k,1956) - lu(k,1895) * lu(k,1955) + lu(k,1957) = lu(k,1957) - lu(k,1896) * lu(k,1955) + lu(k,1958) = lu(k,1958) - lu(k,1897) * lu(k,1955) + lu(k,1959) = lu(k,1959) - lu(k,1898) * lu(k,1955) + lu(k,1960) = - lu(k,1899) * lu(k,1955) + lu(k,1961) = - lu(k,1900) * lu(k,1955) + lu(k,1962) = lu(k,1962) - lu(k,1901) * lu(k,1955) + lu(k,1964) = lu(k,1964) - lu(k,1902) * lu(k,1955) + lu(k,1965) = lu(k,1965) - lu(k,1903) * lu(k,1955) + lu(k,1967) = lu(k,1967) - lu(k,1904) * lu(k,1955) + lu(k,1968) = lu(k,1968) - lu(k,1905) * lu(k,1955) + lu(k,1969) = lu(k,1969) - lu(k,1906) * lu(k,1955) + lu(k,1970) = lu(k,1970) - lu(k,1907) * lu(k,1955) + lu(k,1973) = lu(k,1973) - lu(k,1908) * lu(k,1955) + lu(k,1993) = lu(k,1993) - lu(k,1895) * lu(k,1992) + lu(k,1994) = lu(k,1994) - lu(k,1896) * lu(k,1992) + lu(k,1995) = lu(k,1995) - lu(k,1897) * lu(k,1992) + lu(k,1996) = - lu(k,1898) * lu(k,1992) + lu(k,1997) = lu(k,1997) - lu(k,1899) * lu(k,1992) + lu(k,1998) = lu(k,1998) - lu(k,1900) * lu(k,1992) + lu(k,1999) = - lu(k,1901) * lu(k,1992) + lu(k,2003) = lu(k,2003) - lu(k,1902) * lu(k,1992) + lu(k,2004) = lu(k,2004) - lu(k,1903) * lu(k,1992) + lu(k,2006) = lu(k,2006) - lu(k,1904) * lu(k,1992) + lu(k,2007) = lu(k,2007) - lu(k,1905) * lu(k,1992) + lu(k,2008) = lu(k,2008) - lu(k,1906) * lu(k,1992) + lu(k,2009) = lu(k,2009) - lu(k,1907) * lu(k,1992) + lu(k,2012) = lu(k,2012) - lu(k,1908) * lu(k,1992) + lu(k,2987) = lu(k,2987) - lu(k,1895) * lu(k,2986) + lu(k,2988) = lu(k,2988) - lu(k,1896) * lu(k,2986) + lu(k,2989) = lu(k,2989) - lu(k,1897) * lu(k,2986) + lu(k,2990) = lu(k,2990) - lu(k,1898) * lu(k,2986) + lu(k,2991) = lu(k,2991) - lu(k,1899) * lu(k,2986) + lu(k,2992) = lu(k,2992) - lu(k,1900) * lu(k,2986) + lu(k,2993) = lu(k,2993) - lu(k,1901) * lu(k,2986) + lu(k,3023) = lu(k,3023) - lu(k,1902) * lu(k,2986) + lu(k,3026) = lu(k,3026) - lu(k,1903) * lu(k,2986) + lu(k,3028) = lu(k,3028) - lu(k,1904) * lu(k,2986) + lu(k,3029) = lu(k,3029) - lu(k,1905) * lu(k,2986) + lu(k,3030) = lu(k,3030) - lu(k,1906) * lu(k,2986) + lu(k,3031) = lu(k,3031) - lu(k,1907) * lu(k,2986) + lu(k,3035) = lu(k,3035) - lu(k,1908) * lu(k,2986) + lu(k,3088) = lu(k,3088) - lu(k,1895) * lu(k,3087) + lu(k,3089) = lu(k,3089) - lu(k,1896) * lu(k,3087) + lu(k,3090) = lu(k,3090) - lu(k,1897) * lu(k,3087) + lu(k,3091) = lu(k,3091) - lu(k,1898) * lu(k,3087) + lu(k,3092) = lu(k,3092) - lu(k,1899) * lu(k,3087) + lu(k,3093) = lu(k,3093) - lu(k,1900) * lu(k,3087) + lu(k,3094) = lu(k,3094) - lu(k,1901) * lu(k,3087) + lu(k,3126) = lu(k,3126) - lu(k,1902) * lu(k,3087) + lu(k,3129) = lu(k,3129) - lu(k,1903) * lu(k,3087) + lu(k,3131) = lu(k,3131) - lu(k,1904) * lu(k,3087) + lu(k,3132) = lu(k,3132) - lu(k,1905) * lu(k,3087) + lu(k,3133) = lu(k,3133) - lu(k,1906) * lu(k,3087) + lu(k,3134) = lu(k,3134) - lu(k,1907) * lu(k,3087) + lu(k,3138) = lu(k,3138) - lu(k,1908) * lu(k,3087) + lu(k,3269) = lu(k,3269) - lu(k,1895) * lu(k,3268) + lu(k,3270) = lu(k,3270) - lu(k,1896) * lu(k,3268) + lu(k,3271) = lu(k,3271) - lu(k,1897) * lu(k,3268) + lu(k,3272) = lu(k,3272) - lu(k,1898) * lu(k,3268) + lu(k,3273) = lu(k,3273) - lu(k,1899) * lu(k,3268) + lu(k,3274) = lu(k,3274) - lu(k,1900) * lu(k,3268) + lu(k,3275) = lu(k,3275) - lu(k,1901) * lu(k,3268) + lu(k,3308) = lu(k,3308) - lu(k,1902) * lu(k,3268) + lu(k,3311) = lu(k,3311) - lu(k,1903) * lu(k,3268) + lu(k,3313) = lu(k,3313) - lu(k,1904) * lu(k,3268) + lu(k,3314) = lu(k,3314) - lu(k,1905) * lu(k,3268) + lu(k,3315) = lu(k,3315) - lu(k,1906) * lu(k,3268) + lu(k,3316) = lu(k,3316) - lu(k,1907) * lu(k,3268) + lu(k,3320) = lu(k,3320) - lu(k,1908) * lu(k,3268) + lu(k,3525) = lu(k,3525) - lu(k,1895) * lu(k,3524) + lu(k,3526) = lu(k,3526) - lu(k,1896) * lu(k,3524) + lu(k,3527) = lu(k,3527) - lu(k,1897) * lu(k,3524) + lu(k,3528) = lu(k,3528) - lu(k,1898) * lu(k,3524) + lu(k,3529) = lu(k,3529) - lu(k,1899) * lu(k,3524) + lu(k,3530) = lu(k,3530) - lu(k,1900) * lu(k,3524) + lu(k,3531) = lu(k,3531) - lu(k,1901) * lu(k,3524) + lu(k,3564) = lu(k,3564) - lu(k,1902) * lu(k,3524) + lu(k,3567) = lu(k,3567) - lu(k,1903) * lu(k,3524) + lu(k,3569) = lu(k,3569) - lu(k,1904) * lu(k,3524) + lu(k,3570) = lu(k,3570) - lu(k,1905) * lu(k,3524) + lu(k,3571) = lu(k,3571) - lu(k,1906) * lu(k,3524) + lu(k,3572) = lu(k,3572) - lu(k,1907) * lu(k,3524) + lu(k,3576) = lu(k,3576) - lu(k,1908) * lu(k,3524) + lu(k,3776) = lu(k,3776) - lu(k,1895) * lu(k,3775) + lu(k,3777) = lu(k,3777) - lu(k,1896) * lu(k,3775) + lu(k,3778) = lu(k,3778) - lu(k,1897) * lu(k,3775) + lu(k,3779) = lu(k,3779) - lu(k,1898) * lu(k,3775) + lu(k,3780) = lu(k,3780) - lu(k,1899) * lu(k,3775) + lu(k,3781) = lu(k,3781) - lu(k,1900) * lu(k,3775) + lu(k,3782) = lu(k,3782) - lu(k,1901) * lu(k,3775) + lu(k,3814) = lu(k,3814) - lu(k,1902) * lu(k,3775) + lu(k,3817) = lu(k,3817) - lu(k,1903) * lu(k,3775) + lu(k,3819) = lu(k,3819) - lu(k,1904) * lu(k,3775) + lu(k,3820) = lu(k,3820) - lu(k,1905) * lu(k,3775) + lu(k,3821) = lu(k,3821) - lu(k,1906) * lu(k,3775) + lu(k,3822) = lu(k,3822) - lu(k,1907) * lu(k,3775) + lu(k,3826) = lu(k,3826) - lu(k,1908) * lu(k,3775) + lu(k,3910) = lu(k,3910) - lu(k,1895) * lu(k,3909) + lu(k,3911) = lu(k,3911) - lu(k,1896) * lu(k,3909) + lu(k,3912) = lu(k,3912) - lu(k,1897) * lu(k,3909) + lu(k,3913) = lu(k,3913) - lu(k,1898) * lu(k,3909) + lu(k,3914) = lu(k,3914) - lu(k,1899) * lu(k,3909) + lu(k,3915) = lu(k,3915) - lu(k,1900) * lu(k,3909) + lu(k,3916) = lu(k,3916) - lu(k,1901) * lu(k,3909) + lu(k,3949) = lu(k,3949) - lu(k,1902) * lu(k,3909) + lu(k,3952) = lu(k,3952) - lu(k,1903) * lu(k,3909) + lu(k,3954) = lu(k,3954) - lu(k,1904) * lu(k,3909) + lu(k,3955) = lu(k,3955) - lu(k,1905) * lu(k,3909) + lu(k,3956) = lu(k,3956) - lu(k,1906) * lu(k,3909) + lu(k,3957) = lu(k,3957) - lu(k,1907) * lu(k,3909) + lu(k,3961) = lu(k,3961) - lu(k,1908) * lu(k,3909) + lu(k,4004) = lu(k,4004) - lu(k,1895) * lu(k,4003) + lu(k,4005) = lu(k,4005) - lu(k,1896) * lu(k,4003) + lu(k,4006) = lu(k,4006) - lu(k,1897) * lu(k,4003) + lu(k,4007) = lu(k,4007) - lu(k,1898) * lu(k,4003) + lu(k,4008) = lu(k,4008) - lu(k,1899) * lu(k,4003) + lu(k,4009) = lu(k,4009) - lu(k,1900) * lu(k,4003) + lu(k,4010) = lu(k,4010) - lu(k,1901) * lu(k,4003) + lu(k,4041) = lu(k,4041) - lu(k,1902) * lu(k,4003) + lu(k,4044) = lu(k,4044) - lu(k,1903) * lu(k,4003) + lu(k,4046) = lu(k,4046) - lu(k,1904) * lu(k,4003) + lu(k,4047) = lu(k,4047) - lu(k,1905) * lu(k,4003) + lu(k,4048) = lu(k,4048) - lu(k,1906) * lu(k,4003) + lu(k,4049) = lu(k,4049) - lu(k,1907) * lu(k,4003) + lu(k,4053) = lu(k,4053) - lu(k,1908) * lu(k,4003) + lu(k,1909) = 1._r8 / lu(k,1909) + lu(k,1910) = lu(k,1910) * lu(k,1909) + lu(k,1911) = lu(k,1911) * lu(k,1909) + lu(k,1912) = lu(k,1912) * lu(k,1909) + lu(k,1913) = lu(k,1913) * lu(k,1909) + lu(k,1914) = lu(k,1914) * lu(k,1909) + lu(k,1915) = lu(k,1915) * lu(k,1909) + lu(k,1916) = lu(k,1916) * lu(k,1909) + lu(k,1928) = lu(k,1928) - lu(k,1910) * lu(k,1927) + lu(k,1930) = lu(k,1930) - lu(k,1911) * lu(k,1927) + lu(k,1931) = lu(k,1931) - lu(k,1912) * lu(k,1927) + lu(k,1934) = lu(k,1934) - lu(k,1913) * lu(k,1927) + lu(k,1935) = lu(k,1935) - lu(k,1914) * lu(k,1927) + lu(k,1936) = - lu(k,1915) * lu(k,1927) + lu(k,1938) = - lu(k,1916) * lu(k,1927) + lu(k,1957) = lu(k,1957) - lu(k,1910) * lu(k,1956) + lu(k,1964) = lu(k,1964) - lu(k,1911) * lu(k,1956) + lu(k,1966) = lu(k,1966) - lu(k,1912) * lu(k,1956) + lu(k,1969) = lu(k,1969) - lu(k,1913) * lu(k,1956) + lu(k,1970) = lu(k,1970) - lu(k,1914) * lu(k,1956) + lu(k,1971) = - lu(k,1915) * lu(k,1956) + lu(k,1974) = lu(k,1974) - lu(k,1916) * lu(k,1956) + lu(k,1994) = lu(k,1994) - lu(k,1910) * lu(k,1993) + lu(k,2003) = lu(k,2003) - lu(k,1911) * lu(k,1993) + lu(k,2005) = lu(k,2005) - lu(k,1912) * lu(k,1993) + lu(k,2008) = lu(k,2008) - lu(k,1913) * lu(k,1993) + lu(k,2009) = lu(k,2009) - lu(k,1914) * lu(k,1993) + lu(k,2010) = - lu(k,1915) * lu(k,1993) + lu(k,2013) = - lu(k,1916) * lu(k,1993) + lu(k,2021) = lu(k,2021) - lu(k,1910) * lu(k,2020) + lu(k,2024) = lu(k,2024) - lu(k,1911) * lu(k,2020) + lu(k,2027) = - lu(k,1912) * lu(k,2020) + lu(k,2030) = lu(k,2030) - lu(k,1913) * lu(k,2020) + lu(k,2031) = lu(k,2031) - lu(k,1914) * lu(k,2020) + lu(k,2032) = lu(k,2032) - lu(k,1915) * lu(k,2020) + lu(k,2035) = lu(k,2035) - lu(k,1916) * lu(k,2020) + lu(k,2045) = lu(k,2045) - lu(k,1910) * lu(k,2044) + lu(k,2049) = lu(k,2049) - lu(k,1911) * lu(k,2044) + lu(k,2052) = lu(k,2052) - lu(k,1912) * lu(k,2044) + lu(k,2055) = lu(k,2055) - lu(k,1913) * lu(k,2044) + lu(k,2056) = lu(k,2056) - lu(k,1914) * lu(k,2044) + lu(k,2057) = lu(k,2057) - lu(k,1915) * lu(k,2044) + lu(k,2060) = lu(k,2060) - lu(k,1916) * lu(k,2044) + lu(k,2076) = lu(k,2076) - lu(k,1910) * lu(k,2075) + lu(k,2080) = lu(k,2080) - lu(k,1911) * lu(k,2075) + lu(k,2084) = lu(k,2084) - lu(k,1912) * lu(k,2075) + lu(k,2087) = lu(k,2087) - lu(k,1913) * lu(k,2075) + lu(k,2088) = lu(k,2088) - lu(k,1914) * lu(k,2075) + lu(k,2090) = - lu(k,1915) * lu(k,2075) + lu(k,2092) = lu(k,2092) - lu(k,1916) * lu(k,2075) + lu(k,2108) = lu(k,2108) - lu(k,1910) * lu(k,2107) + lu(k,2112) = lu(k,2112) - lu(k,1911) * lu(k,2107) + lu(k,2116) = lu(k,2116) - lu(k,1912) * lu(k,2107) + lu(k,2119) = lu(k,2119) - lu(k,1913) * lu(k,2107) + lu(k,2120) = lu(k,2120) - lu(k,1914) * lu(k,2107) + lu(k,2122) = - lu(k,1915) * lu(k,2107) + lu(k,2124) = lu(k,2124) - lu(k,1916) * lu(k,2107) + lu(k,2138) = lu(k,2138) - lu(k,1910) * lu(k,2137) + lu(k,2141) = lu(k,2141) - lu(k,1911) * lu(k,2137) + lu(k,2145) = lu(k,2145) - lu(k,1912) * lu(k,2137) + lu(k,2148) = lu(k,2148) - lu(k,1913) * lu(k,2137) + lu(k,2149) = lu(k,2149) - lu(k,1914) * lu(k,2137) + lu(k,2151) = - lu(k,1915) * lu(k,2137) + lu(k,2153) = lu(k,2153) - lu(k,1916) * lu(k,2137) + lu(k,2173) = lu(k,2173) - lu(k,1910) * lu(k,2172) + lu(k,2183) = lu(k,2183) - lu(k,1911) * lu(k,2172) + lu(k,2187) = lu(k,2187) - lu(k,1912) * lu(k,2172) + lu(k,2190) = lu(k,2190) - lu(k,1913) * lu(k,2172) + lu(k,2191) = lu(k,2191) - lu(k,1914) * lu(k,2172) + lu(k,2193) = lu(k,2193) - lu(k,1915) * lu(k,2172) + lu(k,2196) = lu(k,2196) - lu(k,1916) * lu(k,2172) + lu(k,2276) = - lu(k,1910) * lu(k,2275) + lu(k,2278) = lu(k,2278) - lu(k,1911) * lu(k,2275) + lu(k,2280) = - lu(k,1912) * lu(k,2275) + lu(k,2283) = lu(k,2283) - lu(k,1913) * lu(k,2275) + lu(k,2284) = lu(k,2284) - lu(k,1914) * lu(k,2275) + lu(k,2285) = - lu(k,1915) * lu(k,2275) + lu(k,2288) = lu(k,2288) - lu(k,1916) * lu(k,2275) + lu(k,2988) = lu(k,2988) - lu(k,1910) * lu(k,2987) + lu(k,3023) = lu(k,3023) - lu(k,1911) * lu(k,2987) + lu(k,3027) = lu(k,3027) - lu(k,1912) * lu(k,2987) + lu(k,3030) = lu(k,3030) - lu(k,1913) * lu(k,2987) + lu(k,3031) = lu(k,3031) - lu(k,1914) * lu(k,2987) + lu(k,3033) = lu(k,3033) - lu(k,1915) * lu(k,2987) + lu(k,3036) = lu(k,3036) - lu(k,1916) * lu(k,2987) + lu(k,3089) = lu(k,3089) - lu(k,1910) * lu(k,3088) + lu(k,3126) = lu(k,3126) - lu(k,1911) * lu(k,3088) + lu(k,3130) = lu(k,3130) - lu(k,1912) * lu(k,3088) + lu(k,3133) = lu(k,3133) - lu(k,1913) * lu(k,3088) + lu(k,3134) = lu(k,3134) - lu(k,1914) * lu(k,3088) + lu(k,3136) = lu(k,3136) - lu(k,1915) * lu(k,3088) + lu(k,3139) = lu(k,3139) - lu(k,1916) * lu(k,3088) + lu(k,3270) = lu(k,3270) - lu(k,1910) * lu(k,3269) + lu(k,3308) = lu(k,3308) - lu(k,1911) * lu(k,3269) + lu(k,3312) = lu(k,3312) - lu(k,1912) * lu(k,3269) + lu(k,3315) = lu(k,3315) - lu(k,1913) * lu(k,3269) + lu(k,3316) = lu(k,3316) - lu(k,1914) * lu(k,3269) + lu(k,3318) = lu(k,3318) - lu(k,1915) * lu(k,3269) + lu(k,3321) = lu(k,3321) - lu(k,1916) * lu(k,3269) + lu(k,3526) = lu(k,3526) - lu(k,1910) * lu(k,3525) + lu(k,3564) = lu(k,3564) - lu(k,1911) * lu(k,3525) + lu(k,3568) = lu(k,3568) - lu(k,1912) * lu(k,3525) + lu(k,3571) = lu(k,3571) - lu(k,1913) * lu(k,3525) + lu(k,3572) = lu(k,3572) - lu(k,1914) * lu(k,3525) + lu(k,3574) = lu(k,3574) - lu(k,1915) * lu(k,3525) + lu(k,3577) = lu(k,3577) - lu(k,1916) * lu(k,3525) + lu(k,3777) = lu(k,3777) - lu(k,1910) * lu(k,3776) + lu(k,3814) = lu(k,3814) - lu(k,1911) * lu(k,3776) + lu(k,3818) = lu(k,3818) - lu(k,1912) * lu(k,3776) + lu(k,3821) = lu(k,3821) - lu(k,1913) * lu(k,3776) + lu(k,3822) = lu(k,3822) - lu(k,1914) * lu(k,3776) + lu(k,3824) = lu(k,3824) - lu(k,1915) * lu(k,3776) + lu(k,3827) = lu(k,3827) - lu(k,1916) * lu(k,3776) + lu(k,3911) = lu(k,3911) - lu(k,1910) * lu(k,3910) + lu(k,3949) = lu(k,3949) - lu(k,1911) * lu(k,3910) + lu(k,3953) = lu(k,3953) - lu(k,1912) * lu(k,3910) + lu(k,3956) = lu(k,3956) - lu(k,1913) * lu(k,3910) + lu(k,3957) = lu(k,3957) - lu(k,1914) * lu(k,3910) + lu(k,3959) = lu(k,3959) - lu(k,1915) * lu(k,3910) + lu(k,3962) = lu(k,3962) - lu(k,1916) * lu(k,3910) + lu(k,4005) = lu(k,4005) - lu(k,1910) * lu(k,4004) + lu(k,4041) = lu(k,4041) - lu(k,1911) * lu(k,4004) + lu(k,4045) = lu(k,4045) - lu(k,1912) * lu(k,4004) + lu(k,4048) = lu(k,4048) - lu(k,1913) * lu(k,4004) + lu(k,4049) = lu(k,4049) - lu(k,1914) * lu(k,4004) + lu(k,4051) = lu(k,4051) - lu(k,1915) * lu(k,4004) + lu(k,4054) = lu(k,4054) - lu(k,1916) * lu(k,4004) + lu(k,4082) = lu(k,4082) - lu(k,1910) * lu(k,4081) + lu(k,4093) = lu(k,4093) - lu(k,1911) * lu(k,4081) + lu(k,4097) = lu(k,4097) - lu(k,1912) * lu(k,4081) + lu(k,4100) = lu(k,4100) - lu(k,1913) * lu(k,4081) + lu(k,4101) = lu(k,4101) - lu(k,1914) * lu(k,4081) + lu(k,4103) = lu(k,4103) - lu(k,1915) * lu(k,4081) + lu(k,4106) = lu(k,4106) - lu(k,1916) * lu(k,4081) end do end subroutine lu_fac40 subroutine lu_fac41( avec_len, lu ) @@ -10058,609 +9616,543 @@ subroutine lu_fac41( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1993) = 1._r8 / lu(k,1993) - lu(k,1994) = lu(k,1994) * lu(k,1993) - lu(k,1995) = lu(k,1995) * lu(k,1993) - lu(k,1996) = lu(k,1996) * lu(k,1993) - lu(k,1997) = lu(k,1997) * lu(k,1993) - lu(k,1998) = lu(k,1998) * lu(k,1993) - lu(k,1999) = lu(k,1999) * lu(k,1993) - lu(k,2000) = lu(k,2000) * lu(k,1993) - lu(k,2001) = lu(k,2001) * lu(k,1993) - lu(k,2002) = lu(k,2002) * lu(k,1993) - lu(k,2003) = lu(k,2003) * lu(k,1993) - lu(k,2004) = lu(k,2004) * lu(k,1993) - lu(k,2005) = lu(k,2005) * lu(k,1993) - lu(k,2006) = lu(k,2006) * lu(k,1993) - lu(k,2007) = lu(k,2007) * lu(k,1993) - lu(k,2036) = lu(k,2036) - lu(k,1994) * lu(k,2033) - lu(k,2037) = lu(k,2037) - lu(k,1995) * lu(k,2033) - lu(k,2038) = lu(k,2038) - lu(k,1996) * lu(k,2033) - lu(k,2039) = lu(k,2039) - lu(k,1997) * lu(k,2033) - lu(k,2040) = lu(k,2040) - lu(k,1998) * lu(k,2033) - lu(k,2041) = lu(k,2041) - lu(k,1999) * lu(k,2033) - lu(k,2042) = lu(k,2042) - lu(k,2000) * lu(k,2033) - lu(k,2043) = lu(k,2043) - lu(k,2001) * lu(k,2033) - lu(k,2045) = lu(k,2045) - lu(k,2002) * lu(k,2033) - lu(k,2046) = lu(k,2046) - lu(k,2003) * lu(k,2033) - lu(k,2047) = lu(k,2047) - lu(k,2004) * lu(k,2033) - lu(k,2048) = lu(k,2048) - lu(k,2005) * lu(k,2033) - lu(k,2049) = lu(k,2049) - lu(k,2006) * lu(k,2033) - lu(k,2050) = lu(k,2050) - lu(k,2007) * lu(k,2033) - lu(k,2699) = lu(k,2699) - lu(k,1994) * lu(k,2675) - lu(k,2700) = lu(k,2700) - lu(k,1995) * lu(k,2675) - lu(k,2701) = lu(k,2701) - lu(k,1996) * lu(k,2675) - lu(k,2702) = lu(k,2702) - lu(k,1997) * lu(k,2675) - lu(k,2703) = lu(k,2703) - lu(k,1998) * lu(k,2675) - lu(k,2704) = lu(k,2704) - lu(k,1999) * lu(k,2675) - lu(k,2705) = lu(k,2705) - lu(k,2000) * lu(k,2675) - lu(k,2706) = lu(k,2706) - lu(k,2001) * lu(k,2675) - lu(k,2708) = lu(k,2708) - lu(k,2002) * lu(k,2675) - lu(k,2709) = lu(k,2709) - lu(k,2003) * lu(k,2675) - lu(k,2710) = lu(k,2710) - lu(k,2004) * lu(k,2675) - lu(k,2711) = lu(k,2711) - lu(k,2005) * lu(k,2675) - lu(k,2712) = lu(k,2712) - lu(k,2006) * lu(k,2675) - lu(k,2713) = lu(k,2713) - lu(k,2007) * lu(k,2675) - lu(k,2882) = lu(k,2882) - lu(k,1994) * lu(k,2858) - lu(k,2883) = lu(k,2883) - lu(k,1995) * lu(k,2858) - lu(k,2884) = lu(k,2884) - lu(k,1996) * lu(k,2858) - lu(k,2885) = lu(k,2885) - lu(k,1997) * lu(k,2858) - lu(k,2886) = lu(k,2886) - lu(k,1998) * lu(k,2858) - lu(k,2887) = lu(k,2887) - lu(k,1999) * lu(k,2858) - lu(k,2889) = lu(k,2889) - lu(k,2000) * lu(k,2858) - lu(k,2891) = lu(k,2891) - lu(k,2001) * lu(k,2858) - lu(k,2893) = lu(k,2893) - lu(k,2002) * lu(k,2858) - lu(k,2894) = lu(k,2894) - lu(k,2003) * lu(k,2858) - lu(k,2895) = lu(k,2895) - lu(k,2004) * lu(k,2858) - lu(k,2896) = lu(k,2896) - lu(k,2005) * lu(k,2858) - lu(k,2898) = lu(k,2898) - lu(k,2006) * lu(k,2858) - lu(k,2899) = lu(k,2899) - lu(k,2007) * lu(k,2858) - lu(k,2983) = lu(k,2983) - lu(k,1994) * lu(k,2960) - lu(k,2984) = lu(k,2984) - lu(k,1995) * lu(k,2960) - lu(k,2985) = lu(k,2985) - lu(k,1996) * lu(k,2960) - lu(k,2986) = lu(k,2986) - lu(k,1997) * lu(k,2960) - lu(k,2987) = lu(k,2987) - lu(k,1998) * lu(k,2960) - lu(k,2988) = lu(k,2988) - lu(k,1999) * lu(k,2960) - lu(k,2990) = lu(k,2990) - lu(k,2000) * lu(k,2960) - lu(k,2992) = lu(k,2992) - lu(k,2001) * lu(k,2960) - lu(k,2994) = lu(k,2994) - lu(k,2002) * lu(k,2960) - lu(k,2995) = lu(k,2995) - lu(k,2003) * lu(k,2960) - lu(k,2996) = lu(k,2996) - lu(k,2004) * lu(k,2960) - lu(k,2997) = lu(k,2997) - lu(k,2005) * lu(k,2960) - lu(k,2999) = lu(k,2999) - lu(k,2006) * lu(k,2960) - lu(k,3000) = lu(k,3000) - lu(k,2007) * lu(k,2960) - lu(k,3075) = lu(k,3075) - lu(k,1994) * lu(k,3051) - lu(k,3076) = lu(k,3076) - lu(k,1995) * lu(k,3051) - lu(k,3077) = lu(k,3077) - lu(k,1996) * lu(k,3051) - lu(k,3078) = lu(k,3078) - lu(k,1997) * lu(k,3051) - lu(k,3079) = lu(k,3079) - lu(k,1998) * lu(k,3051) - lu(k,3080) = lu(k,3080) - lu(k,1999) * lu(k,3051) - lu(k,3082) = lu(k,3082) - lu(k,2000) * lu(k,3051) - lu(k,3084) = lu(k,3084) - lu(k,2001) * lu(k,3051) - lu(k,3086) = lu(k,3086) - lu(k,2002) * lu(k,3051) - lu(k,3087) = lu(k,3087) - lu(k,2003) * lu(k,3051) - lu(k,3088) = lu(k,3088) - lu(k,2004) * lu(k,3051) - lu(k,3089) = lu(k,3089) - lu(k,2005) * lu(k,3051) - lu(k,3091) = lu(k,3091) - lu(k,2006) * lu(k,3051) - lu(k,3092) = lu(k,3092) - lu(k,2007) * lu(k,3051) - lu(k,3278) = lu(k,3278) - lu(k,1994) * lu(k,3254) - lu(k,3279) = lu(k,3279) - lu(k,1995) * lu(k,3254) - lu(k,3280) = lu(k,3280) - lu(k,1996) * lu(k,3254) - lu(k,3281) = lu(k,3281) - lu(k,1997) * lu(k,3254) - lu(k,3282) = lu(k,3282) - lu(k,1998) * lu(k,3254) - lu(k,3283) = lu(k,3283) - lu(k,1999) * lu(k,3254) - lu(k,3285) = lu(k,3285) - lu(k,2000) * lu(k,3254) - lu(k,3287) = lu(k,3287) - lu(k,2001) * lu(k,3254) - lu(k,3289) = lu(k,3289) - lu(k,2002) * lu(k,3254) - lu(k,3290) = lu(k,3290) - lu(k,2003) * lu(k,3254) - lu(k,3291) = lu(k,3291) - lu(k,2004) * lu(k,3254) - lu(k,3292) = lu(k,3292) - lu(k,2005) * lu(k,3254) - lu(k,3294) = lu(k,3294) - lu(k,2006) * lu(k,3254) - lu(k,3295) = lu(k,3295) - lu(k,2007) * lu(k,3254) - lu(k,3419) = lu(k,3419) - lu(k,1994) * lu(k,3395) - lu(k,3420) = lu(k,3420) - lu(k,1995) * lu(k,3395) - lu(k,3421) = lu(k,3421) - lu(k,1996) * lu(k,3395) - lu(k,3422) = lu(k,3422) - lu(k,1997) * lu(k,3395) - lu(k,3423) = lu(k,3423) - lu(k,1998) * lu(k,3395) - lu(k,3424) = lu(k,3424) - lu(k,1999) * lu(k,3395) - lu(k,3426) = lu(k,3426) - lu(k,2000) * lu(k,3395) - lu(k,3428) = lu(k,3428) - lu(k,2001) * lu(k,3395) - lu(k,3430) = lu(k,3430) - lu(k,2002) * lu(k,3395) - lu(k,3431) = lu(k,3431) - lu(k,2003) * lu(k,3395) - lu(k,3432) = lu(k,3432) - lu(k,2004) * lu(k,3395) - lu(k,3433) = lu(k,3433) - lu(k,2005) * lu(k,3395) - lu(k,3435) = lu(k,3435) - lu(k,2006) * lu(k,3395) - lu(k,3436) = lu(k,3436) - lu(k,2007) * lu(k,3395) - lu(k,3739) = lu(k,3739) - lu(k,1994) * lu(k,3716) - lu(k,3740) = lu(k,3740) - lu(k,1995) * lu(k,3716) - lu(k,3741) = lu(k,3741) - lu(k,1996) * lu(k,3716) - lu(k,3742) = lu(k,3742) - lu(k,1997) * lu(k,3716) - lu(k,3743) = lu(k,3743) - lu(k,1998) * lu(k,3716) - lu(k,3744) = lu(k,3744) - lu(k,1999) * lu(k,3716) - lu(k,3746) = lu(k,3746) - lu(k,2000) * lu(k,3716) - lu(k,3748) = lu(k,3748) - lu(k,2001) * lu(k,3716) - lu(k,3750) = lu(k,3750) - lu(k,2002) * lu(k,3716) - lu(k,3751) = lu(k,3751) - lu(k,2003) * lu(k,3716) - lu(k,3752) = lu(k,3752) - lu(k,2004) * lu(k,3716) - lu(k,3753) = lu(k,3753) - lu(k,2005) * lu(k,3716) - lu(k,3755) = lu(k,3755) - lu(k,2006) * lu(k,3716) - lu(k,3756) = lu(k,3756) - lu(k,2007) * lu(k,3716) - lu(k,2034) = 1._r8 / lu(k,2034) - lu(k,2035) = lu(k,2035) * lu(k,2034) - lu(k,2036) = lu(k,2036) * lu(k,2034) - lu(k,2037) = lu(k,2037) * lu(k,2034) - lu(k,2038) = lu(k,2038) * lu(k,2034) - lu(k,2039) = lu(k,2039) * lu(k,2034) - lu(k,2040) = lu(k,2040) * lu(k,2034) - lu(k,2041) = lu(k,2041) * lu(k,2034) - lu(k,2042) = lu(k,2042) * lu(k,2034) - lu(k,2043) = lu(k,2043) * lu(k,2034) - lu(k,2044) = lu(k,2044) * lu(k,2034) - lu(k,2045) = lu(k,2045) * lu(k,2034) - lu(k,2046) = lu(k,2046) * lu(k,2034) - lu(k,2047) = lu(k,2047) * lu(k,2034) - lu(k,2048) = lu(k,2048) * lu(k,2034) - lu(k,2049) = lu(k,2049) * lu(k,2034) - lu(k,2050) = lu(k,2050) * lu(k,2034) - lu(k,2681) = lu(k,2681) - lu(k,2035) * lu(k,2676) - lu(k,2699) = lu(k,2699) - lu(k,2036) * lu(k,2676) - lu(k,2700) = lu(k,2700) - lu(k,2037) * lu(k,2676) - lu(k,2701) = lu(k,2701) - lu(k,2038) * lu(k,2676) - lu(k,2702) = lu(k,2702) - lu(k,2039) * lu(k,2676) - lu(k,2703) = lu(k,2703) - lu(k,2040) * lu(k,2676) - lu(k,2704) = lu(k,2704) - lu(k,2041) * lu(k,2676) - lu(k,2705) = lu(k,2705) - lu(k,2042) * lu(k,2676) - lu(k,2706) = lu(k,2706) - lu(k,2043) * lu(k,2676) - lu(k,2707) = lu(k,2707) - lu(k,2044) * lu(k,2676) - lu(k,2708) = lu(k,2708) - lu(k,2045) * lu(k,2676) - lu(k,2709) = lu(k,2709) - lu(k,2046) * lu(k,2676) - lu(k,2710) = lu(k,2710) - lu(k,2047) * lu(k,2676) - lu(k,2711) = lu(k,2711) - lu(k,2048) * lu(k,2676) - lu(k,2712) = lu(k,2712) - lu(k,2049) * lu(k,2676) - lu(k,2713) = lu(k,2713) - lu(k,2050) * lu(k,2676) - lu(k,2864) = lu(k,2864) - lu(k,2035) * lu(k,2859) - lu(k,2882) = lu(k,2882) - lu(k,2036) * lu(k,2859) - lu(k,2883) = lu(k,2883) - lu(k,2037) * lu(k,2859) - lu(k,2884) = lu(k,2884) - lu(k,2038) * lu(k,2859) - lu(k,2885) = lu(k,2885) - lu(k,2039) * lu(k,2859) - lu(k,2886) = lu(k,2886) - lu(k,2040) * lu(k,2859) - lu(k,2887) = lu(k,2887) - lu(k,2041) * lu(k,2859) - lu(k,2889) = lu(k,2889) - lu(k,2042) * lu(k,2859) - lu(k,2891) = lu(k,2891) - lu(k,2043) * lu(k,2859) - lu(k,2892) = lu(k,2892) - lu(k,2044) * lu(k,2859) - lu(k,2893) = lu(k,2893) - lu(k,2045) * lu(k,2859) - lu(k,2894) = lu(k,2894) - lu(k,2046) * lu(k,2859) - lu(k,2895) = lu(k,2895) - lu(k,2047) * lu(k,2859) - lu(k,2896) = lu(k,2896) - lu(k,2048) * lu(k,2859) - lu(k,2898) = lu(k,2898) - lu(k,2049) * lu(k,2859) - lu(k,2899) = lu(k,2899) - lu(k,2050) * lu(k,2859) - lu(k,2965) = lu(k,2965) - lu(k,2035) * lu(k,2961) - lu(k,2983) = lu(k,2983) - lu(k,2036) * lu(k,2961) - lu(k,2984) = lu(k,2984) - lu(k,2037) * lu(k,2961) - lu(k,2985) = lu(k,2985) - lu(k,2038) * lu(k,2961) - lu(k,2986) = lu(k,2986) - lu(k,2039) * lu(k,2961) - lu(k,2987) = lu(k,2987) - lu(k,2040) * lu(k,2961) - lu(k,2988) = lu(k,2988) - lu(k,2041) * lu(k,2961) - lu(k,2990) = lu(k,2990) - lu(k,2042) * lu(k,2961) - lu(k,2992) = lu(k,2992) - lu(k,2043) * lu(k,2961) - lu(k,2993) = lu(k,2993) - lu(k,2044) * lu(k,2961) - lu(k,2994) = lu(k,2994) - lu(k,2045) * lu(k,2961) - lu(k,2995) = lu(k,2995) - lu(k,2046) * lu(k,2961) - lu(k,2996) = lu(k,2996) - lu(k,2047) * lu(k,2961) - lu(k,2997) = lu(k,2997) - lu(k,2048) * lu(k,2961) - lu(k,2999) = lu(k,2999) - lu(k,2049) * lu(k,2961) - lu(k,3000) = lu(k,3000) - lu(k,2050) * lu(k,2961) - lu(k,3057) = lu(k,3057) - lu(k,2035) * lu(k,3052) - lu(k,3075) = lu(k,3075) - lu(k,2036) * lu(k,3052) - lu(k,3076) = lu(k,3076) - lu(k,2037) * lu(k,3052) - lu(k,3077) = lu(k,3077) - lu(k,2038) * lu(k,3052) - lu(k,3078) = lu(k,3078) - lu(k,2039) * lu(k,3052) - lu(k,3079) = lu(k,3079) - lu(k,2040) * lu(k,3052) - lu(k,3080) = lu(k,3080) - lu(k,2041) * lu(k,3052) - lu(k,3082) = lu(k,3082) - lu(k,2042) * lu(k,3052) - lu(k,3084) = lu(k,3084) - lu(k,2043) * lu(k,3052) - lu(k,3085) = lu(k,3085) - lu(k,2044) * lu(k,3052) - lu(k,3086) = lu(k,3086) - lu(k,2045) * lu(k,3052) - lu(k,3087) = lu(k,3087) - lu(k,2046) * lu(k,3052) - lu(k,3088) = lu(k,3088) - lu(k,2047) * lu(k,3052) - lu(k,3089) = lu(k,3089) - lu(k,2048) * lu(k,3052) - lu(k,3091) = lu(k,3091) - lu(k,2049) * lu(k,3052) - lu(k,3092) = lu(k,3092) - lu(k,2050) * lu(k,3052) - lu(k,3260) = lu(k,3260) - lu(k,2035) * lu(k,3255) - lu(k,3278) = lu(k,3278) - lu(k,2036) * lu(k,3255) - lu(k,3279) = lu(k,3279) - lu(k,2037) * lu(k,3255) - lu(k,3280) = lu(k,3280) - lu(k,2038) * lu(k,3255) - lu(k,3281) = lu(k,3281) - lu(k,2039) * lu(k,3255) - lu(k,3282) = lu(k,3282) - lu(k,2040) * lu(k,3255) - lu(k,3283) = lu(k,3283) - lu(k,2041) * lu(k,3255) - lu(k,3285) = lu(k,3285) - lu(k,2042) * lu(k,3255) - lu(k,3287) = lu(k,3287) - lu(k,2043) * lu(k,3255) - lu(k,3288) = lu(k,3288) - lu(k,2044) * lu(k,3255) - lu(k,3289) = lu(k,3289) - lu(k,2045) * lu(k,3255) - lu(k,3290) = lu(k,3290) - lu(k,2046) * lu(k,3255) - lu(k,3291) = lu(k,3291) - lu(k,2047) * lu(k,3255) - lu(k,3292) = lu(k,3292) - lu(k,2048) * lu(k,3255) - lu(k,3294) = lu(k,3294) - lu(k,2049) * lu(k,3255) - lu(k,3295) = lu(k,3295) - lu(k,2050) * lu(k,3255) - lu(k,3401) = lu(k,3401) - lu(k,2035) * lu(k,3396) - lu(k,3419) = lu(k,3419) - lu(k,2036) * lu(k,3396) - lu(k,3420) = lu(k,3420) - lu(k,2037) * lu(k,3396) - lu(k,3421) = lu(k,3421) - lu(k,2038) * lu(k,3396) - lu(k,3422) = lu(k,3422) - lu(k,2039) * lu(k,3396) - lu(k,3423) = lu(k,3423) - lu(k,2040) * lu(k,3396) - lu(k,3424) = lu(k,3424) - lu(k,2041) * lu(k,3396) - lu(k,3426) = lu(k,3426) - lu(k,2042) * lu(k,3396) - lu(k,3428) = lu(k,3428) - lu(k,2043) * lu(k,3396) - lu(k,3429) = lu(k,3429) - lu(k,2044) * lu(k,3396) - lu(k,3430) = lu(k,3430) - lu(k,2045) * lu(k,3396) - lu(k,3431) = lu(k,3431) - lu(k,2046) * lu(k,3396) - lu(k,3432) = lu(k,3432) - lu(k,2047) * lu(k,3396) - lu(k,3433) = lu(k,3433) - lu(k,2048) * lu(k,3396) - lu(k,3435) = lu(k,3435) - lu(k,2049) * lu(k,3396) - lu(k,3436) = lu(k,3436) - lu(k,2050) * lu(k,3396) - lu(k,3721) = lu(k,3721) - lu(k,2035) * lu(k,3717) - lu(k,3739) = lu(k,3739) - lu(k,2036) * lu(k,3717) - lu(k,3740) = lu(k,3740) - lu(k,2037) * lu(k,3717) - lu(k,3741) = lu(k,3741) - lu(k,2038) * lu(k,3717) - lu(k,3742) = lu(k,3742) - lu(k,2039) * lu(k,3717) - lu(k,3743) = lu(k,3743) - lu(k,2040) * lu(k,3717) - lu(k,3744) = lu(k,3744) - lu(k,2041) * lu(k,3717) - lu(k,3746) = lu(k,3746) - lu(k,2042) * lu(k,3717) - lu(k,3748) = lu(k,3748) - lu(k,2043) * lu(k,3717) - lu(k,3749) = lu(k,3749) - lu(k,2044) * lu(k,3717) - lu(k,3750) = lu(k,3750) - lu(k,2045) * lu(k,3717) - lu(k,3751) = lu(k,3751) - lu(k,2046) * lu(k,3717) - lu(k,3752) = lu(k,3752) - lu(k,2047) * lu(k,3717) - lu(k,3753) = lu(k,3753) - lu(k,2048) * lu(k,3717) - lu(k,3755) = lu(k,3755) - lu(k,2049) * lu(k,3717) - lu(k,3756) = lu(k,3756) - lu(k,2050) * lu(k,3717) - lu(k,2053) = 1._r8 / lu(k,2053) - lu(k,2054) = lu(k,2054) * lu(k,2053) - lu(k,2055) = lu(k,2055) * lu(k,2053) - lu(k,2056) = lu(k,2056) * lu(k,2053) - lu(k,2057) = lu(k,2057) * lu(k,2053) - lu(k,2058) = lu(k,2058) * lu(k,2053) - lu(k,2059) = lu(k,2059) * lu(k,2053) - lu(k,2060) = lu(k,2060) * lu(k,2053) - lu(k,2061) = lu(k,2061) * lu(k,2053) - lu(k,2062) = lu(k,2062) * lu(k,2053) - lu(k,2063) = lu(k,2063) * lu(k,2053) - lu(k,2064) = lu(k,2064) * lu(k,2053) - lu(k,2065) = lu(k,2065) * lu(k,2053) - lu(k,2066) = lu(k,2066) * lu(k,2053) - lu(k,2067) = lu(k,2067) * lu(k,2053) - lu(k,2068) = lu(k,2068) * lu(k,2053) - lu(k,2527) = lu(k,2527) - lu(k,2054) * lu(k,2513) - lu(k,2529) = lu(k,2529) - lu(k,2055) * lu(k,2513) - lu(k,2530) = lu(k,2530) - lu(k,2056) * lu(k,2513) - lu(k,2531) = lu(k,2531) - lu(k,2057) * lu(k,2513) - lu(k,2532) = lu(k,2532) - lu(k,2058) * lu(k,2513) - lu(k,2533) = lu(k,2533) - lu(k,2059) * lu(k,2513) - lu(k,2534) = lu(k,2534) - lu(k,2060) * lu(k,2513) - lu(k,2535) = lu(k,2535) - lu(k,2061) * lu(k,2513) - lu(k,2538) = lu(k,2538) - lu(k,2062) * lu(k,2513) - lu(k,2540) = lu(k,2540) - lu(k,2063) * lu(k,2513) - lu(k,2541) = lu(k,2541) - lu(k,2064) * lu(k,2513) - lu(k,2542) = lu(k,2542) - lu(k,2065) * lu(k,2513) - lu(k,2543) = lu(k,2543) - lu(k,2066) * lu(k,2513) - lu(k,2545) = lu(k,2545) - lu(k,2067) * lu(k,2513) - lu(k,2546) = lu(k,2546) - lu(k,2068) * lu(k,2513) - lu(k,2573) = lu(k,2573) - lu(k,2054) * lu(k,2559) - lu(k,2575) = lu(k,2575) - lu(k,2055) * lu(k,2559) - lu(k,2576) = lu(k,2576) - lu(k,2056) * lu(k,2559) - lu(k,2577) = lu(k,2577) - lu(k,2057) * lu(k,2559) - lu(k,2578) = lu(k,2578) - lu(k,2058) * lu(k,2559) - lu(k,2579) = lu(k,2579) - lu(k,2059) * lu(k,2559) - lu(k,2580) = lu(k,2580) - lu(k,2060) * lu(k,2559) - lu(k,2581) = lu(k,2581) - lu(k,2061) * lu(k,2559) - lu(k,2584) = lu(k,2584) - lu(k,2062) * lu(k,2559) - lu(k,2586) = lu(k,2586) - lu(k,2063) * lu(k,2559) - lu(k,2587) = lu(k,2587) - lu(k,2064) * lu(k,2559) - lu(k,2588) = lu(k,2588) - lu(k,2065) * lu(k,2559) - lu(k,2589) = lu(k,2589) - lu(k,2066) * lu(k,2559) - lu(k,2591) = lu(k,2591) - lu(k,2067) * lu(k,2559) - lu(k,2592) = lu(k,2592) - lu(k,2068) * lu(k,2559) - lu(k,2620) = lu(k,2620) - lu(k,2054) * lu(k,2606) - lu(k,2622) = lu(k,2622) - lu(k,2055) * lu(k,2606) - lu(k,2623) = lu(k,2623) - lu(k,2056) * lu(k,2606) - lu(k,2624) = lu(k,2624) - lu(k,2057) * lu(k,2606) - lu(k,2625) = lu(k,2625) - lu(k,2058) * lu(k,2606) - lu(k,2626) = lu(k,2626) - lu(k,2059) * lu(k,2606) - lu(k,2627) = lu(k,2627) - lu(k,2060) * lu(k,2606) - lu(k,2628) = lu(k,2628) - lu(k,2061) * lu(k,2606) - lu(k,2631) = lu(k,2631) - lu(k,2062) * lu(k,2606) - lu(k,2633) = lu(k,2633) - lu(k,2063) * lu(k,2606) - lu(k,2634) = lu(k,2634) - lu(k,2064) * lu(k,2606) - lu(k,2635) = lu(k,2635) - lu(k,2065) * lu(k,2606) - lu(k,2636) = lu(k,2636) - lu(k,2066) * lu(k,2606) - lu(k,2638) = lu(k,2638) - lu(k,2067) * lu(k,2606) - lu(k,2639) = lu(k,2639) - lu(k,2068) * lu(k,2606) - lu(k,2691) = lu(k,2691) - lu(k,2054) * lu(k,2677) - lu(k,2693) = lu(k,2693) - lu(k,2055) * lu(k,2677) - lu(k,2694) = lu(k,2694) - lu(k,2056) * lu(k,2677) - lu(k,2695) = lu(k,2695) - lu(k,2057) * lu(k,2677) - lu(k,2696) = lu(k,2696) - lu(k,2058) * lu(k,2677) - lu(k,2697) = lu(k,2697) - lu(k,2059) * lu(k,2677) - lu(k,2698) = lu(k,2698) - lu(k,2060) * lu(k,2677) - lu(k,2699) = lu(k,2699) - lu(k,2061) * lu(k,2677) - lu(k,2702) = lu(k,2702) - lu(k,2062) * lu(k,2677) - lu(k,2704) = lu(k,2704) - lu(k,2063) * lu(k,2677) - lu(k,2705) = lu(k,2705) - lu(k,2064) * lu(k,2677) - lu(k,2706) = lu(k,2706) - lu(k,2065) * lu(k,2677) - lu(k,2707) = lu(k,2707) - lu(k,2066) * lu(k,2677) - lu(k,2709) = lu(k,2709) - lu(k,2067) * lu(k,2677) - lu(k,2710) = lu(k,2710) - lu(k,2068) * lu(k,2677) - lu(k,2874) = lu(k,2874) - lu(k,2054) * lu(k,2860) - lu(k,2876) = lu(k,2876) - lu(k,2055) * lu(k,2860) - lu(k,2877) = lu(k,2877) - lu(k,2056) * lu(k,2860) - lu(k,2878) = lu(k,2878) - lu(k,2057) * lu(k,2860) - lu(k,2879) = lu(k,2879) - lu(k,2058) * lu(k,2860) - lu(k,2880) = lu(k,2880) - lu(k,2059) * lu(k,2860) - lu(k,2881) = lu(k,2881) - lu(k,2060) * lu(k,2860) - lu(k,2882) = lu(k,2882) - lu(k,2061) * lu(k,2860) - lu(k,2885) = lu(k,2885) - lu(k,2062) * lu(k,2860) - lu(k,2887) = lu(k,2887) - lu(k,2063) * lu(k,2860) - lu(k,2889) = lu(k,2889) - lu(k,2064) * lu(k,2860) - lu(k,2891) = lu(k,2891) - lu(k,2065) * lu(k,2860) - lu(k,2892) = lu(k,2892) - lu(k,2066) * lu(k,2860) - lu(k,2894) = lu(k,2894) - lu(k,2067) * lu(k,2860) - lu(k,2895) = lu(k,2895) - lu(k,2068) * lu(k,2860) - lu(k,2975) = lu(k,2975) - lu(k,2054) * lu(k,2962) - lu(k,2977) = lu(k,2977) - lu(k,2055) * lu(k,2962) - lu(k,2978) = lu(k,2978) - lu(k,2056) * lu(k,2962) - lu(k,2979) = lu(k,2979) - lu(k,2057) * lu(k,2962) - lu(k,2980) = lu(k,2980) - lu(k,2058) * lu(k,2962) - lu(k,2981) = lu(k,2981) - lu(k,2059) * lu(k,2962) - lu(k,2982) = lu(k,2982) - lu(k,2060) * lu(k,2962) - lu(k,2983) = lu(k,2983) - lu(k,2061) * lu(k,2962) - lu(k,2986) = lu(k,2986) - lu(k,2062) * lu(k,2962) - lu(k,2988) = lu(k,2988) - lu(k,2063) * lu(k,2962) - lu(k,2990) = lu(k,2990) - lu(k,2064) * lu(k,2962) - lu(k,2992) = lu(k,2992) - lu(k,2065) * lu(k,2962) - lu(k,2993) = lu(k,2993) - lu(k,2066) * lu(k,2962) - lu(k,2995) = lu(k,2995) - lu(k,2067) * lu(k,2962) - lu(k,2996) = lu(k,2996) - lu(k,2068) * lu(k,2962) - lu(k,3067) = lu(k,3067) - lu(k,2054) * lu(k,3053) - lu(k,3069) = lu(k,3069) - lu(k,2055) * lu(k,3053) - lu(k,3070) = lu(k,3070) - lu(k,2056) * lu(k,3053) - lu(k,3071) = lu(k,3071) - lu(k,2057) * lu(k,3053) - lu(k,3072) = lu(k,3072) - lu(k,2058) * lu(k,3053) - lu(k,3073) = lu(k,3073) - lu(k,2059) * lu(k,3053) - lu(k,3074) = lu(k,3074) - lu(k,2060) * lu(k,3053) - lu(k,3075) = lu(k,3075) - lu(k,2061) * lu(k,3053) - lu(k,3078) = lu(k,3078) - lu(k,2062) * lu(k,3053) - lu(k,3080) = lu(k,3080) - lu(k,2063) * lu(k,3053) - lu(k,3082) = lu(k,3082) - lu(k,2064) * lu(k,3053) - lu(k,3084) = lu(k,3084) - lu(k,2065) * lu(k,3053) - lu(k,3085) = lu(k,3085) - lu(k,2066) * lu(k,3053) - lu(k,3087) = lu(k,3087) - lu(k,2067) * lu(k,3053) - lu(k,3088) = lu(k,3088) - lu(k,2068) * lu(k,3053) - lu(k,3270) = lu(k,3270) - lu(k,2054) * lu(k,3256) - lu(k,3272) = lu(k,3272) - lu(k,2055) * lu(k,3256) - lu(k,3273) = lu(k,3273) - lu(k,2056) * lu(k,3256) - lu(k,3274) = lu(k,3274) - lu(k,2057) * lu(k,3256) - lu(k,3275) = lu(k,3275) - lu(k,2058) * lu(k,3256) - lu(k,3276) = lu(k,3276) - lu(k,2059) * lu(k,3256) - lu(k,3277) = lu(k,3277) - lu(k,2060) * lu(k,3256) - lu(k,3278) = lu(k,3278) - lu(k,2061) * lu(k,3256) - lu(k,3281) = lu(k,3281) - lu(k,2062) * lu(k,3256) - lu(k,3283) = lu(k,3283) - lu(k,2063) * lu(k,3256) - lu(k,3285) = lu(k,3285) - lu(k,2064) * lu(k,3256) - lu(k,3287) = lu(k,3287) - lu(k,2065) * lu(k,3256) - lu(k,3288) = lu(k,3288) - lu(k,2066) * lu(k,3256) - lu(k,3290) = lu(k,3290) - lu(k,2067) * lu(k,3256) - lu(k,3291) = lu(k,3291) - lu(k,2068) * lu(k,3256) - lu(k,3411) = lu(k,3411) - lu(k,2054) * lu(k,3397) - lu(k,3413) = lu(k,3413) - lu(k,2055) * lu(k,3397) - lu(k,3414) = lu(k,3414) - lu(k,2056) * lu(k,3397) - lu(k,3415) = lu(k,3415) - lu(k,2057) * lu(k,3397) - lu(k,3416) = lu(k,3416) - lu(k,2058) * lu(k,3397) - lu(k,3417) = lu(k,3417) - lu(k,2059) * lu(k,3397) - lu(k,3418) = lu(k,3418) - lu(k,2060) * lu(k,3397) - lu(k,3419) = lu(k,3419) - lu(k,2061) * lu(k,3397) - lu(k,3422) = lu(k,3422) - lu(k,2062) * lu(k,3397) - lu(k,3424) = lu(k,3424) - lu(k,2063) * lu(k,3397) - lu(k,3426) = lu(k,3426) - lu(k,2064) * lu(k,3397) - lu(k,3428) = lu(k,3428) - lu(k,2065) * lu(k,3397) - lu(k,3429) = lu(k,3429) - lu(k,2066) * lu(k,3397) - lu(k,3431) = lu(k,3431) - lu(k,2067) * lu(k,3397) - lu(k,3432) = lu(k,3432) - lu(k,2068) * lu(k,3397) - lu(k,3731) = lu(k,3731) - lu(k,2054) * lu(k,3718) - lu(k,3733) = lu(k,3733) - lu(k,2055) * lu(k,3718) - lu(k,3734) = lu(k,3734) - lu(k,2056) * lu(k,3718) - lu(k,3735) = lu(k,3735) - lu(k,2057) * lu(k,3718) - lu(k,3736) = lu(k,3736) - lu(k,2058) * lu(k,3718) - lu(k,3737) = lu(k,3737) - lu(k,2059) * lu(k,3718) - lu(k,3738) = lu(k,3738) - lu(k,2060) * lu(k,3718) - lu(k,3739) = lu(k,3739) - lu(k,2061) * lu(k,3718) - lu(k,3742) = lu(k,3742) - lu(k,2062) * lu(k,3718) - lu(k,3744) = lu(k,3744) - lu(k,2063) * lu(k,3718) - lu(k,3746) = lu(k,3746) - lu(k,2064) * lu(k,3718) - lu(k,3748) = lu(k,3748) - lu(k,2065) * lu(k,3718) - lu(k,3749) = lu(k,3749) - lu(k,2066) * lu(k,3718) - lu(k,3751) = lu(k,3751) - lu(k,2067) * lu(k,3718) - lu(k,3752) = lu(k,3752) - lu(k,2068) * lu(k,3718) - lu(k,2072) = 1._r8 / lu(k,2072) - lu(k,2073) = lu(k,2073) * lu(k,2072) - lu(k,2074) = lu(k,2074) * lu(k,2072) - lu(k,2075) = lu(k,2075) * lu(k,2072) - lu(k,2076) = lu(k,2076) * lu(k,2072) - lu(k,2077) = lu(k,2077) * lu(k,2072) - lu(k,2078) = lu(k,2078) * lu(k,2072) - lu(k,2079) = lu(k,2079) * lu(k,2072) - lu(k,2080) = lu(k,2080) * lu(k,2072) - lu(k,2081) = lu(k,2081) * lu(k,2072) - lu(k,2082) = lu(k,2082) * lu(k,2072) - lu(k,2083) = lu(k,2083) * lu(k,2072) - lu(k,2084) = lu(k,2084) * lu(k,2072) - lu(k,2085) = lu(k,2085) * lu(k,2072) - lu(k,2086) = lu(k,2086) * lu(k,2072) - lu(k,2087) = lu(k,2087) * lu(k,2072) - lu(k,2088) = lu(k,2088) * lu(k,2072) - lu(k,2089) = lu(k,2089) * lu(k,2072) - lu(k,2090) = lu(k,2090) * lu(k,2072) - lu(k,2485) = - lu(k,2073) * lu(k,2484) - lu(k,2486) = lu(k,2486) - lu(k,2074) * lu(k,2484) - lu(k,2487) = lu(k,2487) - lu(k,2075) * lu(k,2484) - lu(k,2488) = lu(k,2488) - lu(k,2076) * lu(k,2484) - lu(k,2489) = lu(k,2489) - lu(k,2077) * lu(k,2484) - lu(k,2490) = lu(k,2490) - lu(k,2078) * lu(k,2484) - lu(k,2491) = lu(k,2491) - lu(k,2079) * lu(k,2484) - lu(k,2492) = lu(k,2492) - lu(k,2080) * lu(k,2484) - lu(k,2493) = lu(k,2493) - lu(k,2081) * lu(k,2484) - lu(k,2494) = lu(k,2494) - lu(k,2082) * lu(k,2484) - lu(k,2495) = - lu(k,2083) * lu(k,2484) - lu(k,2496) = lu(k,2496) - lu(k,2084) * lu(k,2484) - lu(k,2497) = lu(k,2497) - lu(k,2085) * lu(k,2484) - lu(k,2498) = lu(k,2498) - lu(k,2086) * lu(k,2484) - lu(k,2499) = lu(k,2499) - lu(k,2087) * lu(k,2484) - lu(k,2500) = lu(k,2500) - lu(k,2088) * lu(k,2484) - lu(k,2501) = lu(k,2501) - lu(k,2089) * lu(k,2484) - lu(k,2502) = lu(k,2502) - lu(k,2090) * lu(k,2484) - lu(k,2517) = lu(k,2517) - lu(k,2073) * lu(k,2514) - lu(k,2520) = lu(k,2520) - lu(k,2074) * lu(k,2514) - lu(k,2529) = lu(k,2529) - lu(k,2075) * lu(k,2514) - lu(k,2530) = lu(k,2530) - lu(k,2076) * lu(k,2514) - lu(k,2531) = lu(k,2531) - lu(k,2077) * lu(k,2514) - lu(k,2532) = lu(k,2532) - lu(k,2078) * lu(k,2514) - lu(k,2533) = lu(k,2533) - lu(k,2079) * lu(k,2514) - lu(k,2534) = lu(k,2534) - lu(k,2080) * lu(k,2514) - lu(k,2535) = lu(k,2535) - lu(k,2081) * lu(k,2514) - lu(k,2536) = lu(k,2536) - lu(k,2082) * lu(k,2514) - lu(k,2537) = lu(k,2537) - lu(k,2083) * lu(k,2514) - lu(k,2538) = lu(k,2538) - lu(k,2084) * lu(k,2514) - lu(k,2540) = lu(k,2540) - lu(k,2085) * lu(k,2514) - lu(k,2541) = lu(k,2541) - lu(k,2086) * lu(k,2514) - lu(k,2542) = lu(k,2542) - lu(k,2087) * lu(k,2514) - lu(k,2543) = lu(k,2543) - lu(k,2088) * lu(k,2514) - lu(k,2545) = lu(k,2545) - lu(k,2089) * lu(k,2514) - lu(k,2546) = lu(k,2546) - lu(k,2090) * lu(k,2514) - lu(k,2563) = lu(k,2563) - lu(k,2073) * lu(k,2560) - lu(k,2566) = lu(k,2566) - lu(k,2074) * lu(k,2560) - lu(k,2575) = lu(k,2575) - lu(k,2075) * lu(k,2560) - lu(k,2576) = lu(k,2576) - lu(k,2076) * lu(k,2560) - lu(k,2577) = lu(k,2577) - lu(k,2077) * lu(k,2560) - lu(k,2578) = lu(k,2578) - lu(k,2078) * lu(k,2560) - lu(k,2579) = lu(k,2579) - lu(k,2079) * lu(k,2560) - lu(k,2580) = lu(k,2580) - lu(k,2080) * lu(k,2560) - lu(k,2581) = lu(k,2581) - lu(k,2081) * lu(k,2560) - lu(k,2582) = lu(k,2582) - lu(k,2082) * lu(k,2560) - lu(k,2583) = lu(k,2583) - lu(k,2083) * lu(k,2560) - lu(k,2584) = lu(k,2584) - lu(k,2084) * lu(k,2560) - lu(k,2586) = lu(k,2586) - lu(k,2085) * lu(k,2560) - lu(k,2587) = lu(k,2587) - lu(k,2086) * lu(k,2560) - lu(k,2588) = lu(k,2588) - lu(k,2087) * lu(k,2560) - lu(k,2589) = lu(k,2589) - lu(k,2088) * lu(k,2560) - lu(k,2591) = lu(k,2591) - lu(k,2089) * lu(k,2560) - lu(k,2592) = lu(k,2592) - lu(k,2090) * lu(k,2560) - lu(k,2610) = lu(k,2610) - lu(k,2073) * lu(k,2607) - lu(k,2613) = lu(k,2613) - lu(k,2074) * lu(k,2607) - lu(k,2622) = lu(k,2622) - lu(k,2075) * lu(k,2607) - lu(k,2623) = lu(k,2623) - lu(k,2076) * lu(k,2607) - lu(k,2624) = lu(k,2624) - lu(k,2077) * lu(k,2607) - lu(k,2625) = lu(k,2625) - lu(k,2078) * lu(k,2607) - lu(k,2626) = lu(k,2626) - lu(k,2079) * lu(k,2607) - lu(k,2627) = lu(k,2627) - lu(k,2080) * lu(k,2607) - lu(k,2628) = lu(k,2628) - lu(k,2081) * lu(k,2607) - lu(k,2629) = lu(k,2629) - lu(k,2082) * lu(k,2607) - lu(k,2630) = lu(k,2630) - lu(k,2083) * lu(k,2607) - lu(k,2631) = lu(k,2631) - lu(k,2084) * lu(k,2607) - lu(k,2633) = lu(k,2633) - lu(k,2085) * lu(k,2607) - lu(k,2634) = lu(k,2634) - lu(k,2086) * lu(k,2607) - lu(k,2635) = lu(k,2635) - lu(k,2087) * lu(k,2607) - lu(k,2636) = lu(k,2636) - lu(k,2088) * lu(k,2607) - lu(k,2638) = lu(k,2638) - lu(k,2089) * lu(k,2607) - lu(k,2639) = lu(k,2639) - lu(k,2090) * lu(k,2607) - lu(k,2681) = lu(k,2681) - lu(k,2073) * lu(k,2678) - lu(k,2684) = lu(k,2684) - lu(k,2074) * lu(k,2678) - lu(k,2693) = lu(k,2693) - lu(k,2075) * lu(k,2678) - lu(k,2694) = lu(k,2694) - lu(k,2076) * lu(k,2678) - lu(k,2695) = lu(k,2695) - lu(k,2077) * lu(k,2678) - lu(k,2696) = lu(k,2696) - lu(k,2078) * lu(k,2678) - lu(k,2697) = lu(k,2697) - lu(k,2079) * lu(k,2678) - lu(k,2698) = lu(k,2698) - lu(k,2080) * lu(k,2678) - lu(k,2699) = lu(k,2699) - lu(k,2081) * lu(k,2678) - lu(k,2700) = lu(k,2700) - lu(k,2082) * lu(k,2678) - lu(k,2701) = lu(k,2701) - lu(k,2083) * lu(k,2678) - lu(k,2702) = lu(k,2702) - lu(k,2084) * lu(k,2678) - lu(k,2704) = lu(k,2704) - lu(k,2085) * lu(k,2678) - lu(k,2705) = lu(k,2705) - lu(k,2086) * lu(k,2678) - lu(k,2706) = lu(k,2706) - lu(k,2087) * lu(k,2678) - lu(k,2707) = lu(k,2707) - lu(k,2088) * lu(k,2678) - lu(k,2709) = lu(k,2709) - lu(k,2089) * lu(k,2678) - lu(k,2710) = lu(k,2710) - lu(k,2090) * lu(k,2678) - lu(k,2864) = lu(k,2864) - lu(k,2073) * lu(k,2861) - lu(k,2867) = lu(k,2867) - lu(k,2074) * lu(k,2861) - lu(k,2876) = lu(k,2876) - lu(k,2075) * lu(k,2861) - lu(k,2877) = lu(k,2877) - lu(k,2076) * lu(k,2861) - lu(k,2878) = lu(k,2878) - lu(k,2077) * lu(k,2861) - lu(k,2879) = lu(k,2879) - lu(k,2078) * lu(k,2861) - lu(k,2880) = lu(k,2880) - lu(k,2079) * lu(k,2861) - lu(k,2881) = lu(k,2881) - lu(k,2080) * lu(k,2861) - lu(k,2882) = lu(k,2882) - lu(k,2081) * lu(k,2861) - lu(k,2883) = lu(k,2883) - lu(k,2082) * lu(k,2861) - lu(k,2884) = lu(k,2884) - lu(k,2083) * lu(k,2861) - lu(k,2885) = lu(k,2885) - lu(k,2084) * lu(k,2861) - lu(k,2887) = lu(k,2887) - lu(k,2085) * lu(k,2861) - lu(k,2889) = lu(k,2889) - lu(k,2086) * lu(k,2861) - lu(k,2891) = lu(k,2891) - lu(k,2087) * lu(k,2861) - lu(k,2892) = lu(k,2892) - lu(k,2088) * lu(k,2861) - lu(k,2894) = lu(k,2894) - lu(k,2089) * lu(k,2861) - lu(k,2895) = lu(k,2895) - lu(k,2090) * lu(k,2861) - lu(k,3057) = lu(k,3057) - lu(k,2073) * lu(k,3054) - lu(k,3060) = lu(k,3060) - lu(k,2074) * lu(k,3054) - lu(k,3069) = lu(k,3069) - lu(k,2075) * lu(k,3054) - lu(k,3070) = lu(k,3070) - lu(k,2076) * lu(k,3054) - lu(k,3071) = lu(k,3071) - lu(k,2077) * lu(k,3054) - lu(k,3072) = lu(k,3072) - lu(k,2078) * lu(k,3054) - lu(k,3073) = lu(k,3073) - lu(k,2079) * lu(k,3054) - lu(k,3074) = lu(k,3074) - lu(k,2080) * lu(k,3054) - lu(k,3075) = lu(k,3075) - lu(k,2081) * lu(k,3054) - lu(k,3076) = lu(k,3076) - lu(k,2082) * lu(k,3054) - lu(k,3077) = lu(k,3077) - lu(k,2083) * lu(k,3054) - lu(k,3078) = lu(k,3078) - lu(k,2084) * lu(k,3054) - lu(k,3080) = lu(k,3080) - lu(k,2085) * lu(k,3054) - lu(k,3082) = lu(k,3082) - lu(k,2086) * lu(k,3054) - lu(k,3084) = lu(k,3084) - lu(k,2087) * lu(k,3054) - lu(k,3085) = lu(k,3085) - lu(k,2088) * lu(k,3054) - lu(k,3087) = lu(k,3087) - lu(k,2089) * lu(k,3054) - lu(k,3088) = lu(k,3088) - lu(k,2090) * lu(k,3054) - lu(k,3260) = lu(k,3260) - lu(k,2073) * lu(k,3257) - lu(k,3263) = lu(k,3263) - lu(k,2074) * lu(k,3257) - lu(k,3272) = lu(k,3272) - lu(k,2075) * lu(k,3257) - lu(k,3273) = lu(k,3273) - lu(k,2076) * lu(k,3257) - lu(k,3274) = lu(k,3274) - lu(k,2077) * lu(k,3257) - lu(k,3275) = lu(k,3275) - lu(k,2078) * lu(k,3257) - lu(k,3276) = lu(k,3276) - lu(k,2079) * lu(k,3257) - lu(k,3277) = lu(k,3277) - lu(k,2080) * lu(k,3257) - lu(k,3278) = lu(k,3278) - lu(k,2081) * lu(k,3257) - lu(k,3279) = lu(k,3279) - lu(k,2082) * lu(k,3257) - lu(k,3280) = lu(k,3280) - lu(k,2083) * lu(k,3257) - lu(k,3281) = lu(k,3281) - lu(k,2084) * lu(k,3257) - lu(k,3283) = lu(k,3283) - lu(k,2085) * lu(k,3257) - lu(k,3285) = lu(k,3285) - lu(k,2086) * lu(k,3257) - lu(k,3287) = lu(k,3287) - lu(k,2087) * lu(k,3257) - lu(k,3288) = lu(k,3288) - lu(k,2088) * lu(k,3257) - lu(k,3290) = lu(k,3290) - lu(k,2089) * lu(k,3257) - lu(k,3291) = lu(k,3291) - lu(k,2090) * lu(k,3257) - lu(k,3401) = lu(k,3401) - lu(k,2073) * lu(k,3398) - lu(k,3404) = lu(k,3404) - lu(k,2074) * lu(k,3398) - lu(k,3413) = lu(k,3413) - lu(k,2075) * lu(k,3398) - lu(k,3414) = lu(k,3414) - lu(k,2076) * lu(k,3398) - lu(k,3415) = lu(k,3415) - lu(k,2077) * lu(k,3398) - lu(k,3416) = lu(k,3416) - lu(k,2078) * lu(k,3398) - lu(k,3417) = lu(k,3417) - lu(k,2079) * lu(k,3398) - lu(k,3418) = lu(k,3418) - lu(k,2080) * lu(k,3398) - lu(k,3419) = lu(k,3419) - lu(k,2081) * lu(k,3398) - lu(k,3420) = lu(k,3420) - lu(k,2082) * lu(k,3398) - lu(k,3421) = lu(k,3421) - lu(k,2083) * lu(k,3398) - lu(k,3422) = lu(k,3422) - lu(k,2084) * lu(k,3398) - lu(k,3424) = lu(k,3424) - lu(k,2085) * lu(k,3398) - lu(k,3426) = lu(k,3426) - lu(k,2086) * lu(k,3398) - lu(k,3428) = lu(k,3428) - lu(k,2087) * lu(k,3398) - lu(k,3429) = lu(k,3429) - lu(k,2088) * lu(k,3398) - lu(k,3431) = lu(k,3431) - lu(k,2089) * lu(k,3398) - lu(k,3432) = lu(k,3432) - lu(k,2090) * lu(k,3398) + lu(k,1918) = 1._r8 / lu(k,1918) + lu(k,1919) = lu(k,1919) * lu(k,1918) + lu(k,1920) = lu(k,1920) * lu(k,1918) + lu(k,1921) = lu(k,1921) * lu(k,1918) + lu(k,1933) = lu(k,1933) - lu(k,1919) * lu(k,1928) + lu(k,1934) = lu(k,1934) - lu(k,1920) * lu(k,1928) + lu(k,1935) = lu(k,1935) - lu(k,1921) * lu(k,1928) + lu(k,1968) = lu(k,1968) - lu(k,1919) * lu(k,1957) + lu(k,1969) = lu(k,1969) - lu(k,1920) * lu(k,1957) + lu(k,1970) = lu(k,1970) - lu(k,1921) * lu(k,1957) + lu(k,2007) = lu(k,2007) - lu(k,1919) * lu(k,1994) + lu(k,2008) = lu(k,2008) - lu(k,1920) * lu(k,1994) + lu(k,2009) = lu(k,2009) - lu(k,1921) * lu(k,1994) + lu(k,2029) = lu(k,2029) - lu(k,1919) * lu(k,2021) + lu(k,2030) = lu(k,2030) - lu(k,1920) * lu(k,2021) + lu(k,2031) = lu(k,2031) - lu(k,1921) * lu(k,2021) + lu(k,2054) = lu(k,2054) - lu(k,1919) * lu(k,2045) + lu(k,2055) = lu(k,2055) - lu(k,1920) * lu(k,2045) + lu(k,2056) = lu(k,2056) - lu(k,1921) * lu(k,2045) + lu(k,2086) = lu(k,2086) - lu(k,1919) * lu(k,2076) + lu(k,2087) = lu(k,2087) - lu(k,1920) * lu(k,2076) + lu(k,2088) = lu(k,2088) - lu(k,1921) * lu(k,2076) + lu(k,2118) = lu(k,2118) - lu(k,1919) * lu(k,2108) + lu(k,2119) = lu(k,2119) - lu(k,1920) * lu(k,2108) + lu(k,2120) = lu(k,2120) - lu(k,1921) * lu(k,2108) + lu(k,2147) = lu(k,2147) - lu(k,1919) * lu(k,2138) + lu(k,2148) = lu(k,2148) - lu(k,1920) * lu(k,2138) + lu(k,2149) = lu(k,2149) - lu(k,1921) * lu(k,2138) + lu(k,2189) = lu(k,2189) - lu(k,1919) * lu(k,2173) + lu(k,2190) = lu(k,2190) - lu(k,1920) * lu(k,2173) + lu(k,2191) = lu(k,2191) - lu(k,1921) * lu(k,2173) + lu(k,2205) = lu(k,2205) - lu(k,1919) * lu(k,2198) + lu(k,2206) = lu(k,2206) - lu(k,1920) * lu(k,2198) + lu(k,2207) = lu(k,2207) - lu(k,1921) * lu(k,2198) + lu(k,2224) = lu(k,2224) - lu(k,1919) * lu(k,2212) + lu(k,2225) = lu(k,2225) - lu(k,1920) * lu(k,2212) + lu(k,2226) = lu(k,2226) - lu(k,1921) * lu(k,2212) + lu(k,2248) = lu(k,2248) - lu(k,1919) * lu(k,2234) + lu(k,2249) = lu(k,2249) - lu(k,1920) * lu(k,2234) + lu(k,2250) = lu(k,2250) - lu(k,1921) * lu(k,2234) + lu(k,2265) = lu(k,2265) - lu(k,1919) * lu(k,2258) + lu(k,2266) = lu(k,2266) - lu(k,1920) * lu(k,2258) + lu(k,2267) = lu(k,2267) - lu(k,1921) * lu(k,2258) + lu(k,2282) = - lu(k,1919) * lu(k,2276) + lu(k,2283) = lu(k,2283) - lu(k,1920) * lu(k,2276) + lu(k,2284) = lu(k,2284) - lu(k,1921) * lu(k,2276) + lu(k,2308) = lu(k,2308) - lu(k,1919) * lu(k,2295) + lu(k,2309) = lu(k,2309) - lu(k,1920) * lu(k,2295) + lu(k,2310) = lu(k,2310) - lu(k,1921) * lu(k,2295) + lu(k,2335) = lu(k,2335) - lu(k,1919) * lu(k,2321) + lu(k,2336) = lu(k,2336) - lu(k,1920) * lu(k,2321) + lu(k,2337) = lu(k,2337) - lu(k,1921) * lu(k,2321) + lu(k,2358) = lu(k,2358) - lu(k,1919) * lu(k,2348) + lu(k,2359) = lu(k,2359) - lu(k,1920) * lu(k,2348) + lu(k,2360) = lu(k,2360) - lu(k,1921) * lu(k,2348) + lu(k,2371) = - lu(k,1919) * lu(k,2365) + lu(k,2372) = lu(k,2372) - lu(k,1920) * lu(k,2365) + lu(k,2373) = lu(k,2373) - lu(k,1921) * lu(k,2365) + lu(k,2394) = lu(k,2394) - lu(k,1919) * lu(k,2379) + lu(k,2395) = lu(k,2395) - lu(k,1920) * lu(k,2379) + lu(k,2396) = lu(k,2396) - lu(k,1921) * lu(k,2379) + lu(k,2424) = lu(k,2424) - lu(k,1919) * lu(k,2408) + lu(k,2425) = lu(k,2425) - lu(k,1920) * lu(k,2408) + lu(k,2426) = lu(k,2426) - lu(k,1921) * lu(k,2408) + lu(k,2447) = - lu(k,1919) * lu(k,2435) + lu(k,2448) = lu(k,2448) - lu(k,1920) * lu(k,2435) + lu(k,2449) = lu(k,2449) - lu(k,1921) * lu(k,2435) + lu(k,2478) = lu(k,2478) - lu(k,1919) * lu(k,2462) + lu(k,2479) = lu(k,2479) - lu(k,1920) * lu(k,2462) + lu(k,2480) = lu(k,2480) - lu(k,1921) * lu(k,2462) + lu(k,2512) = lu(k,2512) - lu(k,1919) * lu(k,2497) + lu(k,2513) = lu(k,2513) - lu(k,1920) * lu(k,2497) + lu(k,2514) = lu(k,2514) - lu(k,1921) * lu(k,2497) + lu(k,2541) = lu(k,2541) - lu(k,1919) * lu(k,2528) + lu(k,2542) = lu(k,2542) - lu(k,1920) * lu(k,2528) + lu(k,2543) = lu(k,2543) - lu(k,1921) * lu(k,2528) + lu(k,2674) = lu(k,2674) - lu(k,1919) * lu(k,2661) + lu(k,2675) = lu(k,2675) - lu(k,1920) * lu(k,2661) + lu(k,2676) = lu(k,2676) - lu(k,1921) * lu(k,2661) + lu(k,2713) = lu(k,2713) - lu(k,1919) * lu(k,2693) + lu(k,2714) = lu(k,2714) - lu(k,1920) * lu(k,2693) + lu(k,2715) = lu(k,2715) - lu(k,1921) * lu(k,2693) + lu(k,2738) = lu(k,2738) - lu(k,1919) * lu(k,2726) + lu(k,2739) = lu(k,2739) - lu(k,1920) * lu(k,2726) + lu(k,2740) = lu(k,2740) - lu(k,1921) * lu(k,2726) + lu(k,2760) = lu(k,2760) - lu(k,1919) * lu(k,2748) + lu(k,2761) = lu(k,2761) - lu(k,1920) * lu(k,2748) + lu(k,2762) = lu(k,2762) - lu(k,1921) * lu(k,2748) + lu(k,2783) = lu(k,2783) - lu(k,1919) * lu(k,2769) + lu(k,2784) = lu(k,2784) - lu(k,1920) * lu(k,2769) + lu(k,2785) = lu(k,2785) - lu(k,1921) * lu(k,2769) + lu(k,2816) = lu(k,2816) - lu(k,1919) * lu(k,2797) + lu(k,2817) = lu(k,2817) - lu(k,1920) * lu(k,2797) + lu(k,2818) = lu(k,2818) - lu(k,1921) * lu(k,2797) + lu(k,2862) = lu(k,2862) - lu(k,1919) * lu(k,2833) + lu(k,2863) = lu(k,2863) - lu(k,1920) * lu(k,2833) + lu(k,2864) = lu(k,2864) - lu(k,1921) * lu(k,2833) + lu(k,2909) = lu(k,2909) - lu(k,1919) * lu(k,2880) + lu(k,2910) = lu(k,2910) - lu(k,1920) * lu(k,2880) + lu(k,2911) = lu(k,2911) - lu(k,1921) * lu(k,2880) + lu(k,2955) = lu(k,2955) - lu(k,1919) * lu(k,2926) + lu(k,2956) = lu(k,2956) - lu(k,1920) * lu(k,2926) + lu(k,2957) = lu(k,2957) - lu(k,1921) * lu(k,2926) + lu(k,3029) = lu(k,3029) - lu(k,1919) * lu(k,2988) + lu(k,3030) = lu(k,3030) - lu(k,1920) * lu(k,2988) + lu(k,3031) = lu(k,3031) - lu(k,1921) * lu(k,2988) + lu(k,3132) = lu(k,3132) - lu(k,1919) * lu(k,3089) + lu(k,3133) = lu(k,3133) - lu(k,1920) * lu(k,3089) + lu(k,3134) = lu(k,3134) - lu(k,1921) * lu(k,3089) + lu(k,3314) = lu(k,3314) - lu(k,1919) * lu(k,3270) + lu(k,3315) = lu(k,3315) - lu(k,1920) * lu(k,3270) + lu(k,3316) = lu(k,3316) - lu(k,1921) * lu(k,3270) + lu(k,3359) = lu(k,3359) - lu(k,1919) * lu(k,3347) + lu(k,3360) = lu(k,3360) - lu(k,1920) * lu(k,3347) + lu(k,3361) = lu(k,3361) - lu(k,1921) * lu(k,3347) + lu(k,3390) = lu(k,3390) - lu(k,1919) * lu(k,3378) + lu(k,3391) = lu(k,3391) - lu(k,1920) * lu(k,3378) + lu(k,3392) = lu(k,3392) - lu(k,1921) * lu(k,3378) + lu(k,3570) = lu(k,3570) - lu(k,1919) * lu(k,3526) + lu(k,3571) = lu(k,3571) - lu(k,1920) * lu(k,3526) + lu(k,3572) = lu(k,3572) - lu(k,1921) * lu(k,3526) + lu(k,3820) = lu(k,3820) - lu(k,1919) * lu(k,3777) + lu(k,3821) = lu(k,3821) - lu(k,1920) * lu(k,3777) + lu(k,3822) = lu(k,3822) - lu(k,1921) * lu(k,3777) + lu(k,3861) = lu(k,3861) - lu(k,1919) * lu(k,3848) + lu(k,3862) = lu(k,3862) - lu(k,1920) * lu(k,3848) + lu(k,3863) = lu(k,3863) - lu(k,1921) * lu(k,3848) + lu(k,3955) = lu(k,3955) - lu(k,1919) * lu(k,3911) + lu(k,3956) = lu(k,3956) - lu(k,1920) * lu(k,3911) + lu(k,3957) = lu(k,3957) - lu(k,1921) * lu(k,3911) + lu(k,4047) = lu(k,4047) - lu(k,1919) * lu(k,4005) + lu(k,4048) = lu(k,4048) - lu(k,1920) * lu(k,4005) + lu(k,4049) = lu(k,4049) - lu(k,1921) * lu(k,4005) + lu(k,4099) = lu(k,4099) - lu(k,1919) * lu(k,4082) + lu(k,4100) = lu(k,4100) - lu(k,1920) * lu(k,4082) + lu(k,4101) = lu(k,4101) - lu(k,1921) * lu(k,4082) + lu(k,1929) = 1._r8 / lu(k,1929) + lu(k,1930) = lu(k,1930) * lu(k,1929) + lu(k,1931) = lu(k,1931) * lu(k,1929) + lu(k,1932) = lu(k,1932) * lu(k,1929) + lu(k,1933) = lu(k,1933) * lu(k,1929) + lu(k,1934) = lu(k,1934) * lu(k,1929) + lu(k,1935) = lu(k,1935) * lu(k,1929) + lu(k,1936) = lu(k,1936) * lu(k,1929) + lu(k,1937) = lu(k,1937) * lu(k,1929) + lu(k,1938) = lu(k,1938) * lu(k,1929) + lu(k,1964) = lu(k,1964) - lu(k,1930) * lu(k,1958) + lu(k,1966) = lu(k,1966) - lu(k,1931) * lu(k,1958) + lu(k,1967) = lu(k,1967) - lu(k,1932) * lu(k,1958) + lu(k,1968) = lu(k,1968) - lu(k,1933) * lu(k,1958) + lu(k,1969) = lu(k,1969) - lu(k,1934) * lu(k,1958) + lu(k,1970) = lu(k,1970) - lu(k,1935) * lu(k,1958) + lu(k,1971) = lu(k,1971) - lu(k,1936) * lu(k,1958) + lu(k,1973) = lu(k,1973) - lu(k,1937) * lu(k,1958) + lu(k,1974) = lu(k,1974) - lu(k,1938) * lu(k,1958) + lu(k,2003) = lu(k,2003) - lu(k,1930) * lu(k,1995) + lu(k,2005) = lu(k,2005) - lu(k,1931) * lu(k,1995) + lu(k,2006) = lu(k,2006) - lu(k,1932) * lu(k,1995) + lu(k,2007) = lu(k,2007) - lu(k,1933) * lu(k,1995) + lu(k,2008) = lu(k,2008) - lu(k,1934) * lu(k,1995) + lu(k,2009) = lu(k,2009) - lu(k,1935) * lu(k,1995) + lu(k,2010) = lu(k,2010) - lu(k,1936) * lu(k,1995) + lu(k,2012) = lu(k,2012) - lu(k,1937) * lu(k,1995) + lu(k,2013) = lu(k,2013) - lu(k,1938) * lu(k,1995) + lu(k,2049) = lu(k,2049) - lu(k,1930) * lu(k,2046) + lu(k,2052) = lu(k,2052) - lu(k,1931) * lu(k,2046) + lu(k,2053) = lu(k,2053) - lu(k,1932) * lu(k,2046) + lu(k,2054) = lu(k,2054) - lu(k,1933) * lu(k,2046) + lu(k,2055) = lu(k,2055) - lu(k,1934) * lu(k,2046) + lu(k,2056) = lu(k,2056) - lu(k,1935) * lu(k,2046) + lu(k,2057) = lu(k,2057) - lu(k,1936) * lu(k,2046) + lu(k,2059) = lu(k,2059) - lu(k,1937) * lu(k,2046) + lu(k,2060) = lu(k,2060) - lu(k,1938) * lu(k,2046) + lu(k,2080) = lu(k,2080) - lu(k,1930) * lu(k,2077) + lu(k,2084) = lu(k,2084) - lu(k,1931) * lu(k,2077) + lu(k,2085) = lu(k,2085) - lu(k,1932) * lu(k,2077) + lu(k,2086) = lu(k,2086) - lu(k,1933) * lu(k,2077) + lu(k,2087) = lu(k,2087) - lu(k,1934) * lu(k,2077) + lu(k,2088) = lu(k,2088) - lu(k,1935) * lu(k,2077) + lu(k,2090) = lu(k,2090) - lu(k,1936) * lu(k,2077) + lu(k,2091) = lu(k,2091) - lu(k,1937) * lu(k,2077) + lu(k,2092) = lu(k,2092) - lu(k,1938) * lu(k,2077) + lu(k,2112) = lu(k,2112) - lu(k,1930) * lu(k,2109) + lu(k,2116) = lu(k,2116) - lu(k,1931) * lu(k,2109) + lu(k,2117) = lu(k,2117) - lu(k,1932) * lu(k,2109) + lu(k,2118) = lu(k,2118) - lu(k,1933) * lu(k,2109) + lu(k,2119) = lu(k,2119) - lu(k,1934) * lu(k,2109) + lu(k,2120) = lu(k,2120) - lu(k,1935) * lu(k,2109) + lu(k,2122) = lu(k,2122) - lu(k,1936) * lu(k,2109) + lu(k,2123) = lu(k,2123) - lu(k,1937) * lu(k,2109) + lu(k,2124) = lu(k,2124) - lu(k,1938) * lu(k,2109) + lu(k,2141) = lu(k,2141) - lu(k,1930) * lu(k,2139) + lu(k,2145) = lu(k,2145) - lu(k,1931) * lu(k,2139) + lu(k,2146) = lu(k,2146) - lu(k,1932) * lu(k,2139) + lu(k,2147) = lu(k,2147) - lu(k,1933) * lu(k,2139) + lu(k,2148) = lu(k,2148) - lu(k,1934) * lu(k,2139) + lu(k,2149) = lu(k,2149) - lu(k,1935) * lu(k,2139) + lu(k,2151) = lu(k,2151) - lu(k,1936) * lu(k,2139) + lu(k,2152) = lu(k,2152) - lu(k,1937) * lu(k,2139) + lu(k,2153) = lu(k,2153) - lu(k,1938) * lu(k,2139) + lu(k,2183) = lu(k,2183) - lu(k,1930) * lu(k,2174) + lu(k,2187) = lu(k,2187) - lu(k,1931) * lu(k,2174) + lu(k,2188) = lu(k,2188) - lu(k,1932) * lu(k,2174) + lu(k,2189) = lu(k,2189) - lu(k,1933) * lu(k,2174) + lu(k,2190) = lu(k,2190) - lu(k,1934) * lu(k,2174) + lu(k,2191) = lu(k,2191) - lu(k,1935) * lu(k,2174) + lu(k,2193) = lu(k,2193) - lu(k,1936) * lu(k,2174) + lu(k,2195) = lu(k,2195) - lu(k,1937) * lu(k,2174) + lu(k,2196) = lu(k,2196) - lu(k,1938) * lu(k,2174) + lu(k,3023) = lu(k,3023) - lu(k,1930) * lu(k,2989) + lu(k,3027) = lu(k,3027) - lu(k,1931) * lu(k,2989) + lu(k,3028) = lu(k,3028) - lu(k,1932) * lu(k,2989) + lu(k,3029) = lu(k,3029) - lu(k,1933) * lu(k,2989) + lu(k,3030) = lu(k,3030) - lu(k,1934) * lu(k,2989) + lu(k,3031) = lu(k,3031) - lu(k,1935) * lu(k,2989) + lu(k,3033) = lu(k,3033) - lu(k,1936) * lu(k,2989) + lu(k,3035) = lu(k,3035) - lu(k,1937) * lu(k,2989) + lu(k,3036) = lu(k,3036) - lu(k,1938) * lu(k,2989) + lu(k,3126) = lu(k,3126) - lu(k,1930) * lu(k,3090) + lu(k,3130) = lu(k,3130) - lu(k,1931) * lu(k,3090) + lu(k,3131) = lu(k,3131) - lu(k,1932) * lu(k,3090) + lu(k,3132) = lu(k,3132) - lu(k,1933) * lu(k,3090) + lu(k,3133) = lu(k,3133) - lu(k,1934) * lu(k,3090) + lu(k,3134) = lu(k,3134) - lu(k,1935) * lu(k,3090) + lu(k,3136) = lu(k,3136) - lu(k,1936) * lu(k,3090) + lu(k,3138) = lu(k,3138) - lu(k,1937) * lu(k,3090) + lu(k,3139) = lu(k,3139) - lu(k,1938) * lu(k,3090) + lu(k,3308) = lu(k,3308) - lu(k,1930) * lu(k,3271) + lu(k,3312) = lu(k,3312) - lu(k,1931) * lu(k,3271) + lu(k,3313) = lu(k,3313) - lu(k,1932) * lu(k,3271) + lu(k,3314) = lu(k,3314) - lu(k,1933) * lu(k,3271) + lu(k,3315) = lu(k,3315) - lu(k,1934) * lu(k,3271) + lu(k,3316) = lu(k,3316) - lu(k,1935) * lu(k,3271) + lu(k,3318) = lu(k,3318) - lu(k,1936) * lu(k,3271) + lu(k,3320) = lu(k,3320) - lu(k,1937) * lu(k,3271) + lu(k,3321) = lu(k,3321) - lu(k,1938) * lu(k,3271) + lu(k,3564) = lu(k,3564) - lu(k,1930) * lu(k,3527) + lu(k,3568) = lu(k,3568) - lu(k,1931) * lu(k,3527) + lu(k,3569) = lu(k,3569) - lu(k,1932) * lu(k,3527) + lu(k,3570) = lu(k,3570) - lu(k,1933) * lu(k,3527) + lu(k,3571) = lu(k,3571) - lu(k,1934) * lu(k,3527) + lu(k,3572) = lu(k,3572) - lu(k,1935) * lu(k,3527) + lu(k,3574) = lu(k,3574) - lu(k,1936) * lu(k,3527) + lu(k,3576) = lu(k,3576) - lu(k,1937) * lu(k,3527) + lu(k,3577) = lu(k,3577) - lu(k,1938) * lu(k,3527) + lu(k,3814) = lu(k,3814) - lu(k,1930) * lu(k,3778) + lu(k,3818) = lu(k,3818) - lu(k,1931) * lu(k,3778) + lu(k,3819) = lu(k,3819) - lu(k,1932) * lu(k,3778) + lu(k,3820) = lu(k,3820) - lu(k,1933) * lu(k,3778) + lu(k,3821) = lu(k,3821) - lu(k,1934) * lu(k,3778) + lu(k,3822) = lu(k,3822) - lu(k,1935) * lu(k,3778) + lu(k,3824) = lu(k,3824) - lu(k,1936) * lu(k,3778) + lu(k,3826) = lu(k,3826) - lu(k,1937) * lu(k,3778) + lu(k,3827) = lu(k,3827) - lu(k,1938) * lu(k,3778) + lu(k,3949) = lu(k,3949) - lu(k,1930) * lu(k,3912) + lu(k,3953) = lu(k,3953) - lu(k,1931) * lu(k,3912) + lu(k,3954) = lu(k,3954) - lu(k,1932) * lu(k,3912) + lu(k,3955) = lu(k,3955) - lu(k,1933) * lu(k,3912) + lu(k,3956) = lu(k,3956) - lu(k,1934) * lu(k,3912) + lu(k,3957) = lu(k,3957) - lu(k,1935) * lu(k,3912) + lu(k,3959) = lu(k,3959) - lu(k,1936) * lu(k,3912) + lu(k,3961) = lu(k,3961) - lu(k,1937) * lu(k,3912) + lu(k,3962) = lu(k,3962) - lu(k,1938) * lu(k,3912) + lu(k,4041) = lu(k,4041) - lu(k,1930) * lu(k,4006) + lu(k,4045) = lu(k,4045) - lu(k,1931) * lu(k,4006) + lu(k,4046) = lu(k,4046) - lu(k,1932) * lu(k,4006) + lu(k,4047) = lu(k,4047) - lu(k,1933) * lu(k,4006) + lu(k,4048) = lu(k,4048) - lu(k,1934) * lu(k,4006) + lu(k,4049) = lu(k,4049) - lu(k,1935) * lu(k,4006) + lu(k,4051) = lu(k,4051) - lu(k,1936) * lu(k,4006) + lu(k,4053) = lu(k,4053) - lu(k,1937) * lu(k,4006) + lu(k,4054) = lu(k,4054) - lu(k,1938) * lu(k,4006) + lu(k,1959) = 1._r8 / lu(k,1959) + lu(k,1960) = lu(k,1960) * lu(k,1959) + lu(k,1961) = lu(k,1961) * lu(k,1959) + lu(k,1962) = lu(k,1962) * lu(k,1959) + lu(k,1963) = lu(k,1963) * lu(k,1959) + lu(k,1964) = lu(k,1964) * lu(k,1959) + lu(k,1965) = lu(k,1965) * lu(k,1959) + lu(k,1966) = lu(k,1966) * lu(k,1959) + lu(k,1967) = lu(k,1967) * lu(k,1959) + lu(k,1968) = lu(k,1968) * lu(k,1959) + lu(k,1969) = lu(k,1969) * lu(k,1959) + lu(k,1970) = lu(k,1970) * lu(k,1959) + lu(k,1971) = lu(k,1971) * lu(k,1959) + lu(k,1972) = lu(k,1972) * lu(k,1959) + lu(k,1973) = lu(k,1973) * lu(k,1959) + lu(k,1974) = lu(k,1974) * lu(k,1959) + lu(k,1997) = lu(k,1997) - lu(k,1960) * lu(k,1996) + lu(k,1998) = lu(k,1998) - lu(k,1961) * lu(k,1996) + lu(k,1999) = lu(k,1999) - lu(k,1962) * lu(k,1996) + lu(k,2000) = - lu(k,1963) * lu(k,1996) + lu(k,2003) = lu(k,2003) - lu(k,1964) * lu(k,1996) + lu(k,2004) = lu(k,2004) - lu(k,1965) * lu(k,1996) + lu(k,2005) = lu(k,2005) - lu(k,1966) * lu(k,1996) + lu(k,2006) = lu(k,2006) - lu(k,1967) * lu(k,1996) + lu(k,2007) = lu(k,2007) - lu(k,1968) * lu(k,1996) + lu(k,2008) = lu(k,2008) - lu(k,1969) * lu(k,1996) + lu(k,2009) = lu(k,2009) - lu(k,1970) * lu(k,1996) + lu(k,2010) = lu(k,2010) - lu(k,1971) * lu(k,1996) + lu(k,2011) = lu(k,2011) - lu(k,1972) * lu(k,1996) + lu(k,2012) = lu(k,2012) - lu(k,1973) * lu(k,1996) + lu(k,2013) = lu(k,2013) - lu(k,1974) * lu(k,1996) + lu(k,2991) = lu(k,2991) - lu(k,1960) * lu(k,2990) + lu(k,2992) = lu(k,2992) - lu(k,1961) * lu(k,2990) + lu(k,2993) = lu(k,2993) - lu(k,1962) * lu(k,2990) + lu(k,2994) = lu(k,2994) - lu(k,1963) * lu(k,2990) + lu(k,3023) = lu(k,3023) - lu(k,1964) * lu(k,2990) + lu(k,3026) = lu(k,3026) - lu(k,1965) * lu(k,2990) + lu(k,3027) = lu(k,3027) - lu(k,1966) * lu(k,2990) + lu(k,3028) = lu(k,3028) - lu(k,1967) * lu(k,2990) + lu(k,3029) = lu(k,3029) - lu(k,1968) * lu(k,2990) + lu(k,3030) = lu(k,3030) - lu(k,1969) * lu(k,2990) + lu(k,3031) = lu(k,3031) - lu(k,1970) * lu(k,2990) + lu(k,3033) = lu(k,3033) - lu(k,1971) * lu(k,2990) + lu(k,3034) = lu(k,3034) - lu(k,1972) * lu(k,2990) + lu(k,3035) = lu(k,3035) - lu(k,1973) * lu(k,2990) + lu(k,3036) = lu(k,3036) - lu(k,1974) * lu(k,2990) + lu(k,3092) = lu(k,3092) - lu(k,1960) * lu(k,3091) + lu(k,3093) = lu(k,3093) - lu(k,1961) * lu(k,3091) + lu(k,3094) = lu(k,3094) - lu(k,1962) * lu(k,3091) + lu(k,3095) = lu(k,3095) - lu(k,1963) * lu(k,3091) + lu(k,3126) = lu(k,3126) - lu(k,1964) * lu(k,3091) + lu(k,3129) = lu(k,3129) - lu(k,1965) * lu(k,3091) + lu(k,3130) = lu(k,3130) - lu(k,1966) * lu(k,3091) + lu(k,3131) = lu(k,3131) - lu(k,1967) * lu(k,3091) + lu(k,3132) = lu(k,3132) - lu(k,1968) * lu(k,3091) + lu(k,3133) = lu(k,3133) - lu(k,1969) * lu(k,3091) + lu(k,3134) = lu(k,3134) - lu(k,1970) * lu(k,3091) + lu(k,3136) = lu(k,3136) - lu(k,1971) * lu(k,3091) + lu(k,3137) = lu(k,3137) - lu(k,1972) * lu(k,3091) + lu(k,3138) = lu(k,3138) - lu(k,1973) * lu(k,3091) + lu(k,3139) = lu(k,3139) - lu(k,1974) * lu(k,3091) + lu(k,3273) = lu(k,3273) - lu(k,1960) * lu(k,3272) + lu(k,3274) = lu(k,3274) - lu(k,1961) * lu(k,3272) + lu(k,3275) = lu(k,3275) - lu(k,1962) * lu(k,3272) + lu(k,3276) = lu(k,3276) - lu(k,1963) * lu(k,3272) + lu(k,3308) = lu(k,3308) - lu(k,1964) * lu(k,3272) + lu(k,3311) = lu(k,3311) - lu(k,1965) * lu(k,3272) + lu(k,3312) = lu(k,3312) - lu(k,1966) * lu(k,3272) + lu(k,3313) = lu(k,3313) - lu(k,1967) * lu(k,3272) + lu(k,3314) = lu(k,3314) - lu(k,1968) * lu(k,3272) + lu(k,3315) = lu(k,3315) - lu(k,1969) * lu(k,3272) + lu(k,3316) = lu(k,3316) - lu(k,1970) * lu(k,3272) + lu(k,3318) = lu(k,3318) - lu(k,1971) * lu(k,3272) + lu(k,3319) = lu(k,3319) - lu(k,1972) * lu(k,3272) + lu(k,3320) = lu(k,3320) - lu(k,1973) * lu(k,3272) + lu(k,3321) = lu(k,3321) - lu(k,1974) * lu(k,3272) + lu(k,3529) = lu(k,3529) - lu(k,1960) * lu(k,3528) + lu(k,3530) = lu(k,3530) - lu(k,1961) * lu(k,3528) + lu(k,3531) = lu(k,3531) - lu(k,1962) * lu(k,3528) + lu(k,3532) = lu(k,3532) - lu(k,1963) * lu(k,3528) + lu(k,3564) = lu(k,3564) - lu(k,1964) * lu(k,3528) + lu(k,3567) = lu(k,3567) - lu(k,1965) * lu(k,3528) + lu(k,3568) = lu(k,3568) - lu(k,1966) * lu(k,3528) + lu(k,3569) = lu(k,3569) - lu(k,1967) * lu(k,3528) + lu(k,3570) = lu(k,3570) - lu(k,1968) * lu(k,3528) + lu(k,3571) = lu(k,3571) - lu(k,1969) * lu(k,3528) + lu(k,3572) = lu(k,3572) - lu(k,1970) * lu(k,3528) + lu(k,3574) = lu(k,3574) - lu(k,1971) * lu(k,3528) + lu(k,3575) = lu(k,3575) - lu(k,1972) * lu(k,3528) + lu(k,3576) = lu(k,3576) - lu(k,1973) * lu(k,3528) + lu(k,3577) = lu(k,3577) - lu(k,1974) * lu(k,3528) + lu(k,3780) = lu(k,3780) - lu(k,1960) * lu(k,3779) + lu(k,3781) = lu(k,3781) - lu(k,1961) * lu(k,3779) + lu(k,3782) = lu(k,3782) - lu(k,1962) * lu(k,3779) + lu(k,3783) = lu(k,3783) - lu(k,1963) * lu(k,3779) + lu(k,3814) = lu(k,3814) - lu(k,1964) * lu(k,3779) + lu(k,3817) = lu(k,3817) - lu(k,1965) * lu(k,3779) + lu(k,3818) = lu(k,3818) - lu(k,1966) * lu(k,3779) + lu(k,3819) = lu(k,3819) - lu(k,1967) * lu(k,3779) + lu(k,3820) = lu(k,3820) - lu(k,1968) * lu(k,3779) + lu(k,3821) = lu(k,3821) - lu(k,1969) * lu(k,3779) + lu(k,3822) = lu(k,3822) - lu(k,1970) * lu(k,3779) + lu(k,3824) = lu(k,3824) - lu(k,1971) * lu(k,3779) + lu(k,3825) = lu(k,3825) - lu(k,1972) * lu(k,3779) + lu(k,3826) = lu(k,3826) - lu(k,1973) * lu(k,3779) + lu(k,3827) = lu(k,3827) - lu(k,1974) * lu(k,3779) + lu(k,3914) = lu(k,3914) - lu(k,1960) * lu(k,3913) + lu(k,3915) = lu(k,3915) - lu(k,1961) * lu(k,3913) + lu(k,3916) = lu(k,3916) - lu(k,1962) * lu(k,3913) + lu(k,3917) = lu(k,3917) - lu(k,1963) * lu(k,3913) + lu(k,3949) = lu(k,3949) - lu(k,1964) * lu(k,3913) + lu(k,3952) = lu(k,3952) - lu(k,1965) * lu(k,3913) + lu(k,3953) = lu(k,3953) - lu(k,1966) * lu(k,3913) + lu(k,3954) = lu(k,3954) - lu(k,1967) * lu(k,3913) + lu(k,3955) = lu(k,3955) - lu(k,1968) * lu(k,3913) + lu(k,3956) = lu(k,3956) - lu(k,1969) * lu(k,3913) + lu(k,3957) = lu(k,3957) - lu(k,1970) * lu(k,3913) + lu(k,3959) = lu(k,3959) - lu(k,1971) * lu(k,3913) + lu(k,3960) = lu(k,3960) - lu(k,1972) * lu(k,3913) + lu(k,3961) = lu(k,3961) - lu(k,1973) * lu(k,3913) + lu(k,3962) = lu(k,3962) - lu(k,1974) * lu(k,3913) + lu(k,4008) = lu(k,4008) - lu(k,1960) * lu(k,4007) + lu(k,4009) = lu(k,4009) - lu(k,1961) * lu(k,4007) + lu(k,4010) = lu(k,4010) - lu(k,1962) * lu(k,4007) + lu(k,4011) = lu(k,4011) - lu(k,1963) * lu(k,4007) + lu(k,4041) = lu(k,4041) - lu(k,1964) * lu(k,4007) + lu(k,4044) = lu(k,4044) - lu(k,1965) * lu(k,4007) + lu(k,4045) = lu(k,4045) - lu(k,1966) * lu(k,4007) + lu(k,4046) = lu(k,4046) - lu(k,1967) * lu(k,4007) + lu(k,4047) = lu(k,4047) - lu(k,1968) * lu(k,4007) + lu(k,4048) = lu(k,4048) - lu(k,1969) * lu(k,4007) + lu(k,4049) = lu(k,4049) - lu(k,1970) * lu(k,4007) + lu(k,4051) = lu(k,4051) - lu(k,1971) * lu(k,4007) + lu(k,4052) = lu(k,4052) - lu(k,1972) * lu(k,4007) + lu(k,4053) = lu(k,4053) - lu(k,1973) * lu(k,4007) + lu(k,4054) = lu(k,4054) - lu(k,1974) * lu(k,4007) + lu(k,1997) = 1._r8 / lu(k,1997) + lu(k,1998) = lu(k,1998) * lu(k,1997) + lu(k,1999) = lu(k,1999) * lu(k,1997) + lu(k,2000) = lu(k,2000) * lu(k,1997) + lu(k,2001) = lu(k,2001) * lu(k,1997) + lu(k,2002) = lu(k,2002) * lu(k,1997) + lu(k,2003) = lu(k,2003) * lu(k,1997) + lu(k,2004) = lu(k,2004) * lu(k,1997) + lu(k,2005) = lu(k,2005) * lu(k,1997) + lu(k,2006) = lu(k,2006) * lu(k,1997) + lu(k,2007) = lu(k,2007) * lu(k,1997) + lu(k,2008) = lu(k,2008) * lu(k,1997) + lu(k,2009) = lu(k,2009) * lu(k,1997) + lu(k,2010) = lu(k,2010) * lu(k,1997) + lu(k,2011) = lu(k,2011) * lu(k,1997) + lu(k,2012) = lu(k,2012) * lu(k,1997) + lu(k,2013) = lu(k,2013) * lu(k,1997) + lu(k,2992) = lu(k,2992) - lu(k,1998) * lu(k,2991) + lu(k,2993) = lu(k,2993) - lu(k,1999) * lu(k,2991) + lu(k,2994) = lu(k,2994) - lu(k,2000) * lu(k,2991) + lu(k,2995) = lu(k,2995) - lu(k,2001) * lu(k,2991) + lu(k,3001) = lu(k,3001) - lu(k,2002) * lu(k,2991) + lu(k,3023) = lu(k,3023) - lu(k,2003) * lu(k,2991) + lu(k,3026) = lu(k,3026) - lu(k,2004) * lu(k,2991) + lu(k,3027) = lu(k,3027) - lu(k,2005) * lu(k,2991) + lu(k,3028) = lu(k,3028) - lu(k,2006) * lu(k,2991) + lu(k,3029) = lu(k,3029) - lu(k,2007) * lu(k,2991) + lu(k,3030) = lu(k,3030) - lu(k,2008) * lu(k,2991) + lu(k,3031) = lu(k,3031) - lu(k,2009) * lu(k,2991) + lu(k,3033) = lu(k,3033) - lu(k,2010) * lu(k,2991) + lu(k,3034) = lu(k,3034) - lu(k,2011) * lu(k,2991) + lu(k,3035) = lu(k,3035) - lu(k,2012) * lu(k,2991) + lu(k,3036) = lu(k,3036) - lu(k,2013) * lu(k,2991) + lu(k,3093) = lu(k,3093) - lu(k,1998) * lu(k,3092) + lu(k,3094) = lu(k,3094) - lu(k,1999) * lu(k,3092) + lu(k,3095) = lu(k,3095) - lu(k,2000) * lu(k,3092) + lu(k,3096) = lu(k,3096) - lu(k,2001) * lu(k,3092) + lu(k,3102) = lu(k,3102) - lu(k,2002) * lu(k,3092) + lu(k,3126) = lu(k,3126) - lu(k,2003) * lu(k,3092) + lu(k,3129) = lu(k,3129) - lu(k,2004) * lu(k,3092) + lu(k,3130) = lu(k,3130) - lu(k,2005) * lu(k,3092) + lu(k,3131) = lu(k,3131) - lu(k,2006) * lu(k,3092) + lu(k,3132) = lu(k,3132) - lu(k,2007) * lu(k,3092) + lu(k,3133) = lu(k,3133) - lu(k,2008) * lu(k,3092) + lu(k,3134) = lu(k,3134) - lu(k,2009) * lu(k,3092) + lu(k,3136) = lu(k,3136) - lu(k,2010) * lu(k,3092) + lu(k,3137) = lu(k,3137) - lu(k,2011) * lu(k,3092) + lu(k,3138) = lu(k,3138) - lu(k,2012) * lu(k,3092) + lu(k,3139) = lu(k,3139) - lu(k,2013) * lu(k,3092) + lu(k,3274) = lu(k,3274) - lu(k,1998) * lu(k,3273) + lu(k,3275) = lu(k,3275) - lu(k,1999) * lu(k,3273) + lu(k,3276) = lu(k,3276) - lu(k,2000) * lu(k,3273) + lu(k,3277) = lu(k,3277) - lu(k,2001) * lu(k,3273) + lu(k,3284) = lu(k,3284) - lu(k,2002) * lu(k,3273) + lu(k,3308) = lu(k,3308) - lu(k,2003) * lu(k,3273) + lu(k,3311) = lu(k,3311) - lu(k,2004) * lu(k,3273) + lu(k,3312) = lu(k,3312) - lu(k,2005) * lu(k,3273) + lu(k,3313) = lu(k,3313) - lu(k,2006) * lu(k,3273) + lu(k,3314) = lu(k,3314) - lu(k,2007) * lu(k,3273) + lu(k,3315) = lu(k,3315) - lu(k,2008) * lu(k,3273) + lu(k,3316) = lu(k,3316) - lu(k,2009) * lu(k,3273) + lu(k,3318) = lu(k,3318) - lu(k,2010) * lu(k,3273) + lu(k,3319) = lu(k,3319) - lu(k,2011) * lu(k,3273) + lu(k,3320) = lu(k,3320) - lu(k,2012) * lu(k,3273) + lu(k,3321) = lu(k,3321) - lu(k,2013) * lu(k,3273) + lu(k,3530) = lu(k,3530) - lu(k,1998) * lu(k,3529) + lu(k,3531) = lu(k,3531) - lu(k,1999) * lu(k,3529) + lu(k,3532) = lu(k,3532) - lu(k,2000) * lu(k,3529) + lu(k,3533) = lu(k,3533) - lu(k,2001) * lu(k,3529) + lu(k,3540) = lu(k,3540) - lu(k,2002) * lu(k,3529) + lu(k,3564) = lu(k,3564) - lu(k,2003) * lu(k,3529) + lu(k,3567) = lu(k,3567) - lu(k,2004) * lu(k,3529) + lu(k,3568) = lu(k,3568) - lu(k,2005) * lu(k,3529) + lu(k,3569) = lu(k,3569) - lu(k,2006) * lu(k,3529) + lu(k,3570) = lu(k,3570) - lu(k,2007) * lu(k,3529) + lu(k,3571) = lu(k,3571) - lu(k,2008) * lu(k,3529) + lu(k,3572) = lu(k,3572) - lu(k,2009) * lu(k,3529) + lu(k,3574) = lu(k,3574) - lu(k,2010) * lu(k,3529) + lu(k,3575) = lu(k,3575) - lu(k,2011) * lu(k,3529) + lu(k,3576) = lu(k,3576) - lu(k,2012) * lu(k,3529) + lu(k,3577) = lu(k,3577) - lu(k,2013) * lu(k,3529) + lu(k,3781) = lu(k,3781) - lu(k,1998) * lu(k,3780) + lu(k,3782) = lu(k,3782) - lu(k,1999) * lu(k,3780) + lu(k,3783) = lu(k,3783) - lu(k,2000) * lu(k,3780) + lu(k,3784) = lu(k,3784) - lu(k,2001) * lu(k,3780) + lu(k,3790) = lu(k,3790) - lu(k,2002) * lu(k,3780) + lu(k,3814) = lu(k,3814) - lu(k,2003) * lu(k,3780) + lu(k,3817) = lu(k,3817) - lu(k,2004) * lu(k,3780) + lu(k,3818) = lu(k,3818) - lu(k,2005) * lu(k,3780) + lu(k,3819) = lu(k,3819) - lu(k,2006) * lu(k,3780) + lu(k,3820) = lu(k,3820) - lu(k,2007) * lu(k,3780) + lu(k,3821) = lu(k,3821) - lu(k,2008) * lu(k,3780) + lu(k,3822) = lu(k,3822) - lu(k,2009) * lu(k,3780) + lu(k,3824) = lu(k,3824) - lu(k,2010) * lu(k,3780) + lu(k,3825) = lu(k,3825) - lu(k,2011) * lu(k,3780) + lu(k,3826) = lu(k,3826) - lu(k,2012) * lu(k,3780) + lu(k,3827) = lu(k,3827) - lu(k,2013) * lu(k,3780) + lu(k,3915) = lu(k,3915) - lu(k,1998) * lu(k,3914) + lu(k,3916) = lu(k,3916) - lu(k,1999) * lu(k,3914) + lu(k,3917) = lu(k,3917) - lu(k,2000) * lu(k,3914) + lu(k,3918) = lu(k,3918) - lu(k,2001) * lu(k,3914) + lu(k,3925) = lu(k,3925) - lu(k,2002) * lu(k,3914) + lu(k,3949) = lu(k,3949) - lu(k,2003) * lu(k,3914) + lu(k,3952) = lu(k,3952) - lu(k,2004) * lu(k,3914) + lu(k,3953) = lu(k,3953) - lu(k,2005) * lu(k,3914) + lu(k,3954) = lu(k,3954) - lu(k,2006) * lu(k,3914) + lu(k,3955) = lu(k,3955) - lu(k,2007) * lu(k,3914) + lu(k,3956) = lu(k,3956) - lu(k,2008) * lu(k,3914) + lu(k,3957) = lu(k,3957) - lu(k,2009) * lu(k,3914) + lu(k,3959) = lu(k,3959) - lu(k,2010) * lu(k,3914) + lu(k,3960) = lu(k,3960) - lu(k,2011) * lu(k,3914) + lu(k,3961) = lu(k,3961) - lu(k,2012) * lu(k,3914) + lu(k,3962) = lu(k,3962) - lu(k,2013) * lu(k,3914) + lu(k,4009) = lu(k,4009) - lu(k,1998) * lu(k,4008) + lu(k,4010) = lu(k,4010) - lu(k,1999) * lu(k,4008) + lu(k,4011) = lu(k,4011) - lu(k,2000) * lu(k,4008) + lu(k,4012) = lu(k,4012) - lu(k,2001) * lu(k,4008) + lu(k,4018) = lu(k,4018) - lu(k,2002) * lu(k,4008) + lu(k,4041) = lu(k,4041) - lu(k,2003) * lu(k,4008) + lu(k,4044) = lu(k,4044) - lu(k,2004) * lu(k,4008) + lu(k,4045) = lu(k,4045) - lu(k,2005) * lu(k,4008) + lu(k,4046) = lu(k,4046) - lu(k,2006) * lu(k,4008) + lu(k,4047) = lu(k,4047) - lu(k,2007) * lu(k,4008) + lu(k,4048) = lu(k,4048) - lu(k,2008) * lu(k,4008) + lu(k,4049) = lu(k,4049) - lu(k,2009) * lu(k,4008) + lu(k,4051) = lu(k,4051) - lu(k,2010) * lu(k,4008) + lu(k,4052) = lu(k,4052) - lu(k,2011) * lu(k,4008) + lu(k,4053) = lu(k,4053) - lu(k,2012) * lu(k,4008) + lu(k,4054) = lu(k,4054) - lu(k,2013) * lu(k,4008) end do end subroutine lu_fac41 subroutine lu_fac42( avec_len, lu ) @@ -10677,570 +10169,369 @@ subroutine lu_fac42( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,2096) = 1._r8 / lu(k,2096) - lu(k,2097) = lu(k,2097) * lu(k,2096) - lu(k,2098) = lu(k,2098) * lu(k,2096) - lu(k,2099) = lu(k,2099) * lu(k,2096) - lu(k,2100) = lu(k,2100) * lu(k,2096) - lu(k,2101) = lu(k,2101) * lu(k,2096) - lu(k,2102) = lu(k,2102) * lu(k,2096) - lu(k,2103) = lu(k,2103) * lu(k,2096) - lu(k,2104) = lu(k,2104) * lu(k,2096) - lu(k,2105) = lu(k,2105) * lu(k,2096) - lu(k,2106) = lu(k,2106) * lu(k,2096) - lu(k,2107) = lu(k,2107) * lu(k,2096) - lu(k,2108) = lu(k,2108) * lu(k,2096) - lu(k,2109) = lu(k,2109) * lu(k,2096) - lu(k,2110) = lu(k,2110) * lu(k,2096) - lu(k,2111) = lu(k,2111) * lu(k,2096) - lu(k,2112) = lu(k,2112) * lu(k,2096) - lu(k,2113) = lu(k,2113) * lu(k,2096) - lu(k,2519) = lu(k,2519) - lu(k,2097) * lu(k,2515) - lu(k,2520) = lu(k,2520) - lu(k,2098) * lu(k,2515) - lu(k,2527) = lu(k,2527) - lu(k,2099) * lu(k,2515) - lu(k,2529) = lu(k,2529) - lu(k,2100) * lu(k,2515) - lu(k,2530) = lu(k,2530) - lu(k,2101) * lu(k,2515) - lu(k,2531) = lu(k,2531) - lu(k,2102) * lu(k,2515) - lu(k,2532) = lu(k,2532) - lu(k,2103) * lu(k,2515) - lu(k,2533) = lu(k,2533) - lu(k,2104) * lu(k,2515) - lu(k,2534) = lu(k,2534) - lu(k,2105) * lu(k,2515) - lu(k,2535) = lu(k,2535) - lu(k,2106) * lu(k,2515) - lu(k,2538) = lu(k,2538) - lu(k,2107) * lu(k,2515) - lu(k,2540) = lu(k,2540) - lu(k,2108) * lu(k,2515) - lu(k,2541) = lu(k,2541) - lu(k,2109) * lu(k,2515) - lu(k,2542) = lu(k,2542) - lu(k,2110) * lu(k,2515) - lu(k,2543) = lu(k,2543) - lu(k,2111) * lu(k,2515) - lu(k,2545) = lu(k,2545) - lu(k,2112) * lu(k,2515) - lu(k,2546) = lu(k,2546) - lu(k,2113) * lu(k,2515) - lu(k,2565) = lu(k,2565) - lu(k,2097) * lu(k,2561) - lu(k,2566) = lu(k,2566) - lu(k,2098) * lu(k,2561) - lu(k,2573) = lu(k,2573) - lu(k,2099) * lu(k,2561) - lu(k,2575) = lu(k,2575) - lu(k,2100) * lu(k,2561) - lu(k,2576) = lu(k,2576) - lu(k,2101) * lu(k,2561) - lu(k,2577) = lu(k,2577) - lu(k,2102) * lu(k,2561) - lu(k,2578) = lu(k,2578) - lu(k,2103) * lu(k,2561) - lu(k,2579) = lu(k,2579) - lu(k,2104) * lu(k,2561) - lu(k,2580) = lu(k,2580) - lu(k,2105) * lu(k,2561) - lu(k,2581) = lu(k,2581) - lu(k,2106) * lu(k,2561) - lu(k,2584) = lu(k,2584) - lu(k,2107) * lu(k,2561) - lu(k,2586) = lu(k,2586) - lu(k,2108) * lu(k,2561) - lu(k,2587) = lu(k,2587) - lu(k,2109) * lu(k,2561) - lu(k,2588) = lu(k,2588) - lu(k,2110) * lu(k,2561) - lu(k,2589) = lu(k,2589) - lu(k,2111) * lu(k,2561) - lu(k,2591) = lu(k,2591) - lu(k,2112) * lu(k,2561) - lu(k,2592) = lu(k,2592) - lu(k,2113) * lu(k,2561) - lu(k,2612) = lu(k,2612) - lu(k,2097) * lu(k,2608) - lu(k,2613) = lu(k,2613) - lu(k,2098) * lu(k,2608) - lu(k,2620) = lu(k,2620) - lu(k,2099) * lu(k,2608) - lu(k,2622) = lu(k,2622) - lu(k,2100) * lu(k,2608) - lu(k,2623) = lu(k,2623) - lu(k,2101) * lu(k,2608) - lu(k,2624) = lu(k,2624) - lu(k,2102) * lu(k,2608) - lu(k,2625) = lu(k,2625) - lu(k,2103) * lu(k,2608) - lu(k,2626) = lu(k,2626) - lu(k,2104) * lu(k,2608) - lu(k,2627) = lu(k,2627) - lu(k,2105) * lu(k,2608) - lu(k,2628) = lu(k,2628) - lu(k,2106) * lu(k,2608) - lu(k,2631) = lu(k,2631) - lu(k,2107) * lu(k,2608) - lu(k,2633) = lu(k,2633) - lu(k,2108) * lu(k,2608) - lu(k,2634) = lu(k,2634) - lu(k,2109) * lu(k,2608) - lu(k,2635) = lu(k,2635) - lu(k,2110) * lu(k,2608) - lu(k,2636) = lu(k,2636) - lu(k,2111) * lu(k,2608) - lu(k,2638) = lu(k,2638) - lu(k,2112) * lu(k,2608) - lu(k,2639) = lu(k,2639) - lu(k,2113) * lu(k,2608) - lu(k,2683) = lu(k,2683) - lu(k,2097) * lu(k,2679) - lu(k,2684) = lu(k,2684) - lu(k,2098) * lu(k,2679) - lu(k,2691) = lu(k,2691) - lu(k,2099) * lu(k,2679) - lu(k,2693) = lu(k,2693) - lu(k,2100) * lu(k,2679) - lu(k,2694) = lu(k,2694) - lu(k,2101) * lu(k,2679) - lu(k,2695) = lu(k,2695) - lu(k,2102) * lu(k,2679) - lu(k,2696) = lu(k,2696) - lu(k,2103) * lu(k,2679) - lu(k,2697) = lu(k,2697) - lu(k,2104) * lu(k,2679) - lu(k,2698) = lu(k,2698) - lu(k,2105) * lu(k,2679) - lu(k,2699) = lu(k,2699) - lu(k,2106) * lu(k,2679) - lu(k,2702) = lu(k,2702) - lu(k,2107) * lu(k,2679) - lu(k,2704) = lu(k,2704) - lu(k,2108) * lu(k,2679) - lu(k,2705) = lu(k,2705) - lu(k,2109) * lu(k,2679) - lu(k,2706) = lu(k,2706) - lu(k,2110) * lu(k,2679) - lu(k,2707) = lu(k,2707) - lu(k,2111) * lu(k,2679) - lu(k,2709) = lu(k,2709) - lu(k,2112) * lu(k,2679) - lu(k,2710) = lu(k,2710) - lu(k,2113) * lu(k,2679) - lu(k,2866) = lu(k,2866) - lu(k,2097) * lu(k,2862) - lu(k,2867) = lu(k,2867) - lu(k,2098) * lu(k,2862) - lu(k,2874) = lu(k,2874) - lu(k,2099) * lu(k,2862) - lu(k,2876) = lu(k,2876) - lu(k,2100) * lu(k,2862) - lu(k,2877) = lu(k,2877) - lu(k,2101) * lu(k,2862) - lu(k,2878) = lu(k,2878) - lu(k,2102) * lu(k,2862) - lu(k,2879) = lu(k,2879) - lu(k,2103) * lu(k,2862) - lu(k,2880) = lu(k,2880) - lu(k,2104) * lu(k,2862) - lu(k,2881) = lu(k,2881) - lu(k,2105) * lu(k,2862) - lu(k,2882) = lu(k,2882) - lu(k,2106) * lu(k,2862) - lu(k,2885) = lu(k,2885) - lu(k,2107) * lu(k,2862) - lu(k,2887) = lu(k,2887) - lu(k,2108) * lu(k,2862) - lu(k,2889) = lu(k,2889) - lu(k,2109) * lu(k,2862) - lu(k,2891) = lu(k,2891) - lu(k,2110) * lu(k,2862) - lu(k,2892) = lu(k,2892) - lu(k,2111) * lu(k,2862) - lu(k,2894) = lu(k,2894) - lu(k,2112) * lu(k,2862) - lu(k,2895) = lu(k,2895) - lu(k,2113) * lu(k,2862) - lu(k,2967) = - lu(k,2097) * lu(k,2963) - lu(k,2968) = lu(k,2968) - lu(k,2098) * lu(k,2963) - lu(k,2975) = lu(k,2975) - lu(k,2099) * lu(k,2963) - lu(k,2977) = lu(k,2977) - lu(k,2100) * lu(k,2963) - lu(k,2978) = lu(k,2978) - lu(k,2101) * lu(k,2963) - lu(k,2979) = lu(k,2979) - lu(k,2102) * lu(k,2963) - lu(k,2980) = lu(k,2980) - lu(k,2103) * lu(k,2963) - lu(k,2981) = lu(k,2981) - lu(k,2104) * lu(k,2963) - lu(k,2982) = lu(k,2982) - lu(k,2105) * lu(k,2963) - lu(k,2983) = lu(k,2983) - lu(k,2106) * lu(k,2963) - lu(k,2986) = lu(k,2986) - lu(k,2107) * lu(k,2963) - lu(k,2988) = lu(k,2988) - lu(k,2108) * lu(k,2963) - lu(k,2990) = lu(k,2990) - lu(k,2109) * lu(k,2963) - lu(k,2992) = lu(k,2992) - lu(k,2110) * lu(k,2963) - lu(k,2993) = lu(k,2993) - lu(k,2111) * lu(k,2963) - lu(k,2995) = lu(k,2995) - lu(k,2112) * lu(k,2963) - lu(k,2996) = lu(k,2996) - lu(k,2113) * lu(k,2963) - lu(k,3059) = lu(k,3059) - lu(k,2097) * lu(k,3055) - lu(k,3060) = lu(k,3060) - lu(k,2098) * lu(k,3055) - lu(k,3067) = lu(k,3067) - lu(k,2099) * lu(k,3055) - lu(k,3069) = lu(k,3069) - lu(k,2100) * lu(k,3055) - lu(k,3070) = lu(k,3070) - lu(k,2101) * lu(k,3055) - lu(k,3071) = lu(k,3071) - lu(k,2102) * lu(k,3055) - lu(k,3072) = lu(k,3072) - lu(k,2103) * lu(k,3055) - lu(k,3073) = lu(k,3073) - lu(k,2104) * lu(k,3055) - lu(k,3074) = lu(k,3074) - lu(k,2105) * lu(k,3055) - lu(k,3075) = lu(k,3075) - lu(k,2106) * lu(k,3055) - lu(k,3078) = lu(k,3078) - lu(k,2107) * lu(k,3055) - lu(k,3080) = lu(k,3080) - lu(k,2108) * lu(k,3055) - lu(k,3082) = lu(k,3082) - lu(k,2109) * lu(k,3055) - lu(k,3084) = lu(k,3084) - lu(k,2110) * lu(k,3055) - lu(k,3085) = lu(k,3085) - lu(k,2111) * lu(k,3055) - lu(k,3087) = lu(k,3087) - lu(k,2112) * lu(k,3055) - lu(k,3088) = lu(k,3088) - lu(k,2113) * lu(k,3055) - lu(k,3262) = lu(k,3262) - lu(k,2097) * lu(k,3258) - lu(k,3263) = lu(k,3263) - lu(k,2098) * lu(k,3258) - lu(k,3270) = lu(k,3270) - lu(k,2099) * lu(k,3258) - lu(k,3272) = lu(k,3272) - lu(k,2100) * lu(k,3258) - lu(k,3273) = lu(k,3273) - lu(k,2101) * lu(k,3258) - lu(k,3274) = lu(k,3274) - lu(k,2102) * lu(k,3258) - lu(k,3275) = lu(k,3275) - lu(k,2103) * lu(k,3258) - lu(k,3276) = lu(k,3276) - lu(k,2104) * lu(k,3258) - lu(k,3277) = lu(k,3277) - lu(k,2105) * lu(k,3258) - lu(k,3278) = lu(k,3278) - lu(k,2106) * lu(k,3258) - lu(k,3281) = lu(k,3281) - lu(k,2107) * lu(k,3258) - lu(k,3283) = lu(k,3283) - lu(k,2108) * lu(k,3258) - lu(k,3285) = lu(k,3285) - lu(k,2109) * lu(k,3258) - lu(k,3287) = lu(k,3287) - lu(k,2110) * lu(k,3258) - lu(k,3288) = lu(k,3288) - lu(k,2111) * lu(k,3258) - lu(k,3290) = lu(k,3290) - lu(k,2112) * lu(k,3258) - lu(k,3291) = lu(k,3291) - lu(k,2113) * lu(k,3258) - lu(k,3403) = lu(k,3403) - lu(k,2097) * lu(k,3399) - lu(k,3404) = lu(k,3404) - lu(k,2098) * lu(k,3399) - lu(k,3411) = lu(k,3411) - lu(k,2099) * lu(k,3399) - lu(k,3413) = lu(k,3413) - lu(k,2100) * lu(k,3399) - lu(k,3414) = lu(k,3414) - lu(k,2101) * lu(k,3399) - lu(k,3415) = lu(k,3415) - lu(k,2102) * lu(k,3399) - lu(k,3416) = lu(k,3416) - lu(k,2103) * lu(k,3399) - lu(k,3417) = lu(k,3417) - lu(k,2104) * lu(k,3399) - lu(k,3418) = lu(k,3418) - lu(k,2105) * lu(k,3399) - lu(k,3419) = lu(k,3419) - lu(k,2106) * lu(k,3399) - lu(k,3422) = lu(k,3422) - lu(k,2107) * lu(k,3399) - lu(k,3424) = lu(k,3424) - lu(k,2108) * lu(k,3399) - lu(k,3426) = lu(k,3426) - lu(k,2109) * lu(k,3399) - lu(k,3428) = lu(k,3428) - lu(k,2110) * lu(k,3399) - lu(k,3429) = lu(k,3429) - lu(k,2111) * lu(k,3399) - lu(k,3431) = lu(k,3431) - lu(k,2112) * lu(k,3399) - lu(k,3432) = lu(k,3432) - lu(k,2113) * lu(k,3399) - lu(k,3723) = lu(k,3723) - lu(k,2097) * lu(k,3719) - lu(k,3724) = lu(k,3724) - lu(k,2098) * lu(k,3719) - lu(k,3731) = lu(k,3731) - lu(k,2099) * lu(k,3719) - lu(k,3733) = lu(k,3733) - lu(k,2100) * lu(k,3719) - lu(k,3734) = lu(k,3734) - lu(k,2101) * lu(k,3719) - lu(k,3735) = lu(k,3735) - lu(k,2102) * lu(k,3719) - lu(k,3736) = lu(k,3736) - lu(k,2103) * lu(k,3719) - lu(k,3737) = lu(k,3737) - lu(k,2104) * lu(k,3719) - lu(k,3738) = lu(k,3738) - lu(k,2105) * lu(k,3719) - lu(k,3739) = lu(k,3739) - lu(k,2106) * lu(k,3719) - lu(k,3742) = lu(k,3742) - lu(k,2107) * lu(k,3719) - lu(k,3744) = lu(k,3744) - lu(k,2108) * lu(k,3719) - lu(k,3746) = lu(k,3746) - lu(k,2109) * lu(k,3719) - lu(k,3748) = lu(k,3748) - lu(k,2110) * lu(k,3719) - lu(k,3749) = lu(k,3749) - lu(k,2111) * lu(k,3719) - lu(k,3751) = lu(k,3751) - lu(k,2112) * lu(k,3719) - lu(k,3752) = lu(k,3752) - lu(k,2113) * lu(k,3719) - lu(k,2119) = 1._r8 / lu(k,2119) - lu(k,2120) = lu(k,2120) * lu(k,2119) - lu(k,2121) = lu(k,2121) * lu(k,2119) - lu(k,2122) = lu(k,2122) * lu(k,2119) - lu(k,2123) = lu(k,2123) * lu(k,2119) - lu(k,2124) = lu(k,2124) * lu(k,2119) - lu(k,2125) = lu(k,2125) * lu(k,2119) - lu(k,2126) = lu(k,2126) * lu(k,2119) - lu(k,2127) = lu(k,2127) * lu(k,2119) - lu(k,2128) = lu(k,2128) * lu(k,2119) - lu(k,2129) = lu(k,2129) * lu(k,2119) - lu(k,2130) = lu(k,2130) * lu(k,2119) - lu(k,2131) = lu(k,2131) * lu(k,2119) - lu(k,2132) = lu(k,2132) * lu(k,2119) - lu(k,2133) = lu(k,2133) * lu(k,2119) - lu(k,2134) = lu(k,2134) * lu(k,2119) - lu(k,2135) = lu(k,2135) * lu(k,2119) - lu(k,2136) = lu(k,2136) * lu(k,2119) - lu(k,2520) = lu(k,2520) - lu(k,2120) * lu(k,2516) - lu(k,2529) = lu(k,2529) - lu(k,2121) * lu(k,2516) - lu(k,2530) = lu(k,2530) - lu(k,2122) * lu(k,2516) - lu(k,2531) = lu(k,2531) - lu(k,2123) * lu(k,2516) - lu(k,2532) = lu(k,2532) - lu(k,2124) * lu(k,2516) - lu(k,2533) = lu(k,2533) - lu(k,2125) * lu(k,2516) - lu(k,2534) = lu(k,2534) - lu(k,2126) * lu(k,2516) - lu(k,2535) = lu(k,2535) - lu(k,2127) * lu(k,2516) - lu(k,2536) = lu(k,2536) - lu(k,2128) * lu(k,2516) - lu(k,2538) = lu(k,2538) - lu(k,2129) * lu(k,2516) - lu(k,2540) = lu(k,2540) - lu(k,2130) * lu(k,2516) - lu(k,2541) = lu(k,2541) - lu(k,2131) * lu(k,2516) - lu(k,2542) = lu(k,2542) - lu(k,2132) * lu(k,2516) - lu(k,2543) = lu(k,2543) - lu(k,2133) * lu(k,2516) - lu(k,2545) = lu(k,2545) - lu(k,2134) * lu(k,2516) - lu(k,2546) = lu(k,2546) - lu(k,2135) * lu(k,2516) - lu(k,2549) = - lu(k,2136) * lu(k,2516) - lu(k,2566) = lu(k,2566) - lu(k,2120) * lu(k,2562) - lu(k,2575) = lu(k,2575) - lu(k,2121) * lu(k,2562) - lu(k,2576) = lu(k,2576) - lu(k,2122) * lu(k,2562) - lu(k,2577) = lu(k,2577) - lu(k,2123) * lu(k,2562) - lu(k,2578) = lu(k,2578) - lu(k,2124) * lu(k,2562) - lu(k,2579) = lu(k,2579) - lu(k,2125) * lu(k,2562) - lu(k,2580) = lu(k,2580) - lu(k,2126) * lu(k,2562) - lu(k,2581) = lu(k,2581) - lu(k,2127) * lu(k,2562) - lu(k,2582) = lu(k,2582) - lu(k,2128) * lu(k,2562) - lu(k,2584) = lu(k,2584) - lu(k,2129) * lu(k,2562) - lu(k,2586) = lu(k,2586) - lu(k,2130) * lu(k,2562) - lu(k,2587) = lu(k,2587) - lu(k,2131) * lu(k,2562) - lu(k,2588) = lu(k,2588) - lu(k,2132) * lu(k,2562) - lu(k,2589) = lu(k,2589) - lu(k,2133) * lu(k,2562) - lu(k,2591) = lu(k,2591) - lu(k,2134) * lu(k,2562) - lu(k,2592) = lu(k,2592) - lu(k,2135) * lu(k,2562) - lu(k,2595) = - lu(k,2136) * lu(k,2562) - lu(k,2613) = lu(k,2613) - lu(k,2120) * lu(k,2609) - lu(k,2622) = lu(k,2622) - lu(k,2121) * lu(k,2609) - lu(k,2623) = lu(k,2623) - lu(k,2122) * lu(k,2609) - lu(k,2624) = lu(k,2624) - lu(k,2123) * lu(k,2609) - lu(k,2625) = lu(k,2625) - lu(k,2124) * lu(k,2609) - lu(k,2626) = lu(k,2626) - lu(k,2125) * lu(k,2609) - lu(k,2627) = lu(k,2627) - lu(k,2126) * lu(k,2609) - lu(k,2628) = lu(k,2628) - lu(k,2127) * lu(k,2609) - lu(k,2629) = lu(k,2629) - lu(k,2128) * lu(k,2609) - lu(k,2631) = lu(k,2631) - lu(k,2129) * lu(k,2609) - lu(k,2633) = lu(k,2633) - lu(k,2130) * lu(k,2609) - lu(k,2634) = lu(k,2634) - lu(k,2131) * lu(k,2609) - lu(k,2635) = lu(k,2635) - lu(k,2132) * lu(k,2609) - lu(k,2636) = lu(k,2636) - lu(k,2133) * lu(k,2609) - lu(k,2638) = lu(k,2638) - lu(k,2134) * lu(k,2609) - lu(k,2639) = lu(k,2639) - lu(k,2135) * lu(k,2609) - lu(k,2642) = - lu(k,2136) * lu(k,2609) - lu(k,2684) = lu(k,2684) - lu(k,2120) * lu(k,2680) - lu(k,2693) = lu(k,2693) - lu(k,2121) * lu(k,2680) - lu(k,2694) = lu(k,2694) - lu(k,2122) * lu(k,2680) - lu(k,2695) = lu(k,2695) - lu(k,2123) * lu(k,2680) - lu(k,2696) = lu(k,2696) - lu(k,2124) * lu(k,2680) - lu(k,2697) = lu(k,2697) - lu(k,2125) * lu(k,2680) - lu(k,2698) = lu(k,2698) - lu(k,2126) * lu(k,2680) - lu(k,2699) = lu(k,2699) - lu(k,2127) * lu(k,2680) - lu(k,2700) = lu(k,2700) - lu(k,2128) * lu(k,2680) - lu(k,2702) = lu(k,2702) - lu(k,2129) * lu(k,2680) - lu(k,2704) = lu(k,2704) - lu(k,2130) * lu(k,2680) - lu(k,2705) = lu(k,2705) - lu(k,2131) * lu(k,2680) - lu(k,2706) = lu(k,2706) - lu(k,2132) * lu(k,2680) - lu(k,2707) = lu(k,2707) - lu(k,2133) * lu(k,2680) - lu(k,2709) = lu(k,2709) - lu(k,2134) * lu(k,2680) - lu(k,2710) = lu(k,2710) - lu(k,2135) * lu(k,2680) - lu(k,2713) = lu(k,2713) - lu(k,2136) * lu(k,2680) - lu(k,2867) = lu(k,2867) - lu(k,2120) * lu(k,2863) - lu(k,2876) = lu(k,2876) - lu(k,2121) * lu(k,2863) - lu(k,2877) = lu(k,2877) - lu(k,2122) * lu(k,2863) - lu(k,2878) = lu(k,2878) - lu(k,2123) * lu(k,2863) - lu(k,2879) = lu(k,2879) - lu(k,2124) * lu(k,2863) - lu(k,2880) = lu(k,2880) - lu(k,2125) * lu(k,2863) - lu(k,2881) = lu(k,2881) - lu(k,2126) * lu(k,2863) - lu(k,2882) = lu(k,2882) - lu(k,2127) * lu(k,2863) - lu(k,2883) = lu(k,2883) - lu(k,2128) * lu(k,2863) - lu(k,2885) = lu(k,2885) - lu(k,2129) * lu(k,2863) - lu(k,2887) = lu(k,2887) - lu(k,2130) * lu(k,2863) - lu(k,2889) = lu(k,2889) - lu(k,2131) * lu(k,2863) - lu(k,2891) = lu(k,2891) - lu(k,2132) * lu(k,2863) - lu(k,2892) = lu(k,2892) - lu(k,2133) * lu(k,2863) - lu(k,2894) = lu(k,2894) - lu(k,2134) * lu(k,2863) - lu(k,2895) = lu(k,2895) - lu(k,2135) * lu(k,2863) - lu(k,2899) = lu(k,2899) - lu(k,2136) * lu(k,2863) - lu(k,2968) = lu(k,2968) - lu(k,2120) * lu(k,2964) - lu(k,2977) = lu(k,2977) - lu(k,2121) * lu(k,2964) - lu(k,2978) = lu(k,2978) - lu(k,2122) * lu(k,2964) - lu(k,2979) = lu(k,2979) - lu(k,2123) * lu(k,2964) - lu(k,2980) = lu(k,2980) - lu(k,2124) * lu(k,2964) - lu(k,2981) = lu(k,2981) - lu(k,2125) * lu(k,2964) - lu(k,2982) = lu(k,2982) - lu(k,2126) * lu(k,2964) - lu(k,2983) = lu(k,2983) - lu(k,2127) * lu(k,2964) - lu(k,2984) = lu(k,2984) - lu(k,2128) * lu(k,2964) - lu(k,2986) = lu(k,2986) - lu(k,2129) * lu(k,2964) - lu(k,2988) = lu(k,2988) - lu(k,2130) * lu(k,2964) - lu(k,2990) = lu(k,2990) - lu(k,2131) * lu(k,2964) - lu(k,2992) = lu(k,2992) - lu(k,2132) * lu(k,2964) - lu(k,2993) = lu(k,2993) - lu(k,2133) * lu(k,2964) - lu(k,2995) = lu(k,2995) - lu(k,2134) * lu(k,2964) - lu(k,2996) = lu(k,2996) - lu(k,2135) * lu(k,2964) - lu(k,3000) = lu(k,3000) - lu(k,2136) * lu(k,2964) - lu(k,3060) = lu(k,3060) - lu(k,2120) * lu(k,3056) - lu(k,3069) = lu(k,3069) - lu(k,2121) * lu(k,3056) - lu(k,3070) = lu(k,3070) - lu(k,2122) * lu(k,3056) - lu(k,3071) = lu(k,3071) - lu(k,2123) * lu(k,3056) - lu(k,3072) = lu(k,3072) - lu(k,2124) * lu(k,3056) - lu(k,3073) = lu(k,3073) - lu(k,2125) * lu(k,3056) - lu(k,3074) = lu(k,3074) - lu(k,2126) * lu(k,3056) - lu(k,3075) = lu(k,3075) - lu(k,2127) * lu(k,3056) - lu(k,3076) = lu(k,3076) - lu(k,2128) * lu(k,3056) - lu(k,3078) = lu(k,3078) - lu(k,2129) * lu(k,3056) - lu(k,3080) = lu(k,3080) - lu(k,2130) * lu(k,3056) - lu(k,3082) = lu(k,3082) - lu(k,2131) * lu(k,3056) - lu(k,3084) = lu(k,3084) - lu(k,2132) * lu(k,3056) - lu(k,3085) = lu(k,3085) - lu(k,2133) * lu(k,3056) - lu(k,3087) = lu(k,3087) - lu(k,2134) * lu(k,3056) - lu(k,3088) = lu(k,3088) - lu(k,2135) * lu(k,3056) - lu(k,3092) = lu(k,3092) - lu(k,2136) * lu(k,3056) - lu(k,3263) = lu(k,3263) - lu(k,2120) * lu(k,3259) - lu(k,3272) = lu(k,3272) - lu(k,2121) * lu(k,3259) - lu(k,3273) = lu(k,3273) - lu(k,2122) * lu(k,3259) - lu(k,3274) = lu(k,3274) - lu(k,2123) * lu(k,3259) - lu(k,3275) = lu(k,3275) - lu(k,2124) * lu(k,3259) - lu(k,3276) = lu(k,3276) - lu(k,2125) * lu(k,3259) - lu(k,3277) = lu(k,3277) - lu(k,2126) * lu(k,3259) - lu(k,3278) = lu(k,3278) - lu(k,2127) * lu(k,3259) - lu(k,3279) = lu(k,3279) - lu(k,2128) * lu(k,3259) - lu(k,3281) = lu(k,3281) - lu(k,2129) * lu(k,3259) - lu(k,3283) = lu(k,3283) - lu(k,2130) * lu(k,3259) - lu(k,3285) = lu(k,3285) - lu(k,2131) * lu(k,3259) - lu(k,3287) = lu(k,3287) - lu(k,2132) * lu(k,3259) - lu(k,3288) = lu(k,3288) - lu(k,2133) * lu(k,3259) - lu(k,3290) = lu(k,3290) - lu(k,2134) * lu(k,3259) - lu(k,3291) = lu(k,3291) - lu(k,2135) * lu(k,3259) - lu(k,3295) = lu(k,3295) - lu(k,2136) * lu(k,3259) - lu(k,3404) = lu(k,3404) - lu(k,2120) * lu(k,3400) - lu(k,3413) = lu(k,3413) - lu(k,2121) * lu(k,3400) - lu(k,3414) = lu(k,3414) - lu(k,2122) * lu(k,3400) - lu(k,3415) = lu(k,3415) - lu(k,2123) * lu(k,3400) - lu(k,3416) = lu(k,3416) - lu(k,2124) * lu(k,3400) - lu(k,3417) = lu(k,3417) - lu(k,2125) * lu(k,3400) - lu(k,3418) = lu(k,3418) - lu(k,2126) * lu(k,3400) - lu(k,3419) = lu(k,3419) - lu(k,2127) * lu(k,3400) - lu(k,3420) = lu(k,3420) - lu(k,2128) * lu(k,3400) - lu(k,3422) = lu(k,3422) - lu(k,2129) * lu(k,3400) - lu(k,3424) = lu(k,3424) - lu(k,2130) * lu(k,3400) - lu(k,3426) = lu(k,3426) - lu(k,2131) * lu(k,3400) - lu(k,3428) = lu(k,3428) - lu(k,2132) * lu(k,3400) - lu(k,3429) = lu(k,3429) - lu(k,2133) * lu(k,3400) - lu(k,3431) = lu(k,3431) - lu(k,2134) * lu(k,3400) - lu(k,3432) = lu(k,3432) - lu(k,2135) * lu(k,3400) - lu(k,3436) = lu(k,3436) - lu(k,2136) * lu(k,3400) - lu(k,3724) = lu(k,3724) - lu(k,2120) * lu(k,3720) - lu(k,3733) = lu(k,3733) - lu(k,2121) * lu(k,3720) - lu(k,3734) = lu(k,3734) - lu(k,2122) * lu(k,3720) - lu(k,3735) = lu(k,3735) - lu(k,2123) * lu(k,3720) - lu(k,3736) = lu(k,3736) - lu(k,2124) * lu(k,3720) - lu(k,3737) = lu(k,3737) - lu(k,2125) * lu(k,3720) - lu(k,3738) = lu(k,3738) - lu(k,2126) * lu(k,3720) - lu(k,3739) = lu(k,3739) - lu(k,2127) * lu(k,3720) - lu(k,3740) = lu(k,3740) - lu(k,2128) * lu(k,3720) - lu(k,3742) = lu(k,3742) - lu(k,2129) * lu(k,3720) - lu(k,3744) = lu(k,3744) - lu(k,2130) * lu(k,3720) - lu(k,3746) = lu(k,3746) - lu(k,2131) * lu(k,3720) - lu(k,3748) = lu(k,3748) - lu(k,2132) * lu(k,3720) - lu(k,3749) = lu(k,3749) - lu(k,2133) * lu(k,3720) - lu(k,3751) = lu(k,3751) - lu(k,2134) * lu(k,3720) - lu(k,3752) = lu(k,3752) - lu(k,2135) * lu(k,3720) - lu(k,3756) = lu(k,3756) - lu(k,2136) * lu(k,3720) - lu(k,2141) = 1._r8 / lu(k,2141) - lu(k,2142) = lu(k,2142) * lu(k,2141) - lu(k,2143) = lu(k,2143) * lu(k,2141) - lu(k,2144) = lu(k,2144) * lu(k,2141) - lu(k,2145) = lu(k,2145) * lu(k,2141) - lu(k,2146) = lu(k,2146) * lu(k,2141) - lu(k,2147) = lu(k,2147) * lu(k,2141) - lu(k,2148) = lu(k,2148) * lu(k,2141) - lu(k,2149) = lu(k,2149) * lu(k,2141) - lu(k,2150) = lu(k,2150) * lu(k,2141) - lu(k,2151) = lu(k,2151) * lu(k,2141) - lu(k,2152) = lu(k,2152) * lu(k,2141) - lu(k,2222) = lu(k,2222) - lu(k,2142) * lu(k,2211) - lu(k,2223) = lu(k,2223) - lu(k,2143) * lu(k,2211) - lu(k,2224) = lu(k,2224) - lu(k,2144) * lu(k,2211) - lu(k,2225) = lu(k,2225) - lu(k,2145) * lu(k,2211) - lu(k,2226) = lu(k,2226) - lu(k,2146) * lu(k,2211) - lu(k,2227) = lu(k,2227) - lu(k,2147) * lu(k,2211) - lu(k,2228) = lu(k,2228) - lu(k,2148) * lu(k,2211) - lu(k,2229) = lu(k,2229) - lu(k,2149) * lu(k,2211) - lu(k,2230) = lu(k,2230) - lu(k,2150) * lu(k,2211) - lu(k,2231) = lu(k,2231) - lu(k,2151) * lu(k,2211) - lu(k,2232) = - lu(k,2152) * lu(k,2211) - lu(k,2251) = lu(k,2251) - lu(k,2142) * lu(k,2240) - lu(k,2252) = lu(k,2252) - lu(k,2143) * lu(k,2240) - lu(k,2253) = lu(k,2253) - lu(k,2144) * lu(k,2240) - lu(k,2254) = lu(k,2254) - lu(k,2145) * lu(k,2240) - lu(k,2255) = lu(k,2255) - lu(k,2146) * lu(k,2240) - lu(k,2256) = lu(k,2256) - lu(k,2147) * lu(k,2240) - lu(k,2257) = lu(k,2257) - lu(k,2148) * lu(k,2240) - lu(k,2258) = lu(k,2258) - lu(k,2149) * lu(k,2240) - lu(k,2259) = lu(k,2259) - lu(k,2150) * lu(k,2240) - lu(k,2260) = lu(k,2260) - lu(k,2151) * lu(k,2240) - lu(k,2261) = - lu(k,2152) * lu(k,2240) - lu(k,2280) = lu(k,2280) - lu(k,2142) * lu(k,2268) - lu(k,2281) = lu(k,2281) - lu(k,2143) * lu(k,2268) - lu(k,2282) = - lu(k,2144) * lu(k,2268) - lu(k,2283) = lu(k,2283) - lu(k,2145) * lu(k,2268) - lu(k,2284) = lu(k,2284) - lu(k,2146) * lu(k,2268) - lu(k,2285) = lu(k,2285) - lu(k,2147) * lu(k,2268) - lu(k,2286) = lu(k,2286) - lu(k,2148) * lu(k,2268) - lu(k,2287) = lu(k,2287) - lu(k,2149) * lu(k,2268) - lu(k,2288) = lu(k,2288) - lu(k,2150) * lu(k,2268) - lu(k,2289) = lu(k,2289) - lu(k,2151) * lu(k,2268) - lu(k,2290) = - lu(k,2152) * lu(k,2268) - lu(k,2373) = lu(k,2373) - lu(k,2142) * lu(k,2361) - lu(k,2374) = lu(k,2374) - lu(k,2143) * lu(k,2361) - lu(k,2375) = - lu(k,2144) * lu(k,2361) - lu(k,2376) = lu(k,2376) - lu(k,2145) * lu(k,2361) - lu(k,2377) = lu(k,2377) - lu(k,2146) * lu(k,2361) - lu(k,2378) = lu(k,2378) - lu(k,2147) * lu(k,2361) - lu(k,2379) = lu(k,2379) - lu(k,2148) * lu(k,2361) - lu(k,2380) = lu(k,2380) - lu(k,2149) * lu(k,2361) - lu(k,2381) = lu(k,2381) - lu(k,2150) * lu(k,2361) - lu(k,2382) = lu(k,2382) - lu(k,2151) * lu(k,2361) - lu(k,2383) = lu(k,2383) - lu(k,2152) * lu(k,2361) - lu(k,2493) = lu(k,2493) - lu(k,2142) * lu(k,2485) - lu(k,2494) = lu(k,2494) - lu(k,2143) * lu(k,2485) - lu(k,2495) = lu(k,2495) - lu(k,2144) * lu(k,2485) - lu(k,2496) = lu(k,2496) - lu(k,2145) * lu(k,2485) - lu(k,2497) = lu(k,2497) - lu(k,2146) * lu(k,2485) - lu(k,2498) = lu(k,2498) - lu(k,2147) * lu(k,2485) - lu(k,2499) = lu(k,2499) - lu(k,2148) * lu(k,2485) - lu(k,2500) = lu(k,2500) - lu(k,2149) * lu(k,2485) - lu(k,2501) = lu(k,2501) - lu(k,2150) * lu(k,2485) - lu(k,2502) = lu(k,2502) - lu(k,2151) * lu(k,2485) - lu(k,2503) = - lu(k,2152) * lu(k,2485) - lu(k,2535) = lu(k,2535) - lu(k,2142) * lu(k,2517) - lu(k,2536) = lu(k,2536) - lu(k,2143) * lu(k,2517) - lu(k,2537) = lu(k,2537) - lu(k,2144) * lu(k,2517) - lu(k,2538) = lu(k,2538) - lu(k,2145) * lu(k,2517) - lu(k,2540) = lu(k,2540) - lu(k,2146) * lu(k,2517) - lu(k,2541) = lu(k,2541) - lu(k,2147) * lu(k,2517) - lu(k,2542) = lu(k,2542) - lu(k,2148) * lu(k,2517) - lu(k,2543) = lu(k,2543) - lu(k,2149) * lu(k,2517) - lu(k,2545) = lu(k,2545) - lu(k,2150) * lu(k,2517) - lu(k,2546) = lu(k,2546) - lu(k,2151) * lu(k,2517) - lu(k,2549) = lu(k,2549) - lu(k,2152) * lu(k,2517) - lu(k,2581) = lu(k,2581) - lu(k,2142) * lu(k,2563) - lu(k,2582) = lu(k,2582) - lu(k,2143) * lu(k,2563) - lu(k,2583) = lu(k,2583) - lu(k,2144) * lu(k,2563) - lu(k,2584) = lu(k,2584) - lu(k,2145) * lu(k,2563) - lu(k,2586) = lu(k,2586) - lu(k,2146) * lu(k,2563) - lu(k,2587) = lu(k,2587) - lu(k,2147) * lu(k,2563) - lu(k,2588) = lu(k,2588) - lu(k,2148) * lu(k,2563) - lu(k,2589) = lu(k,2589) - lu(k,2149) * lu(k,2563) - lu(k,2591) = lu(k,2591) - lu(k,2150) * lu(k,2563) - lu(k,2592) = lu(k,2592) - lu(k,2151) * lu(k,2563) - lu(k,2595) = lu(k,2595) - lu(k,2152) * lu(k,2563) - lu(k,2628) = lu(k,2628) - lu(k,2142) * lu(k,2610) - lu(k,2629) = lu(k,2629) - lu(k,2143) * lu(k,2610) - lu(k,2630) = lu(k,2630) - lu(k,2144) * lu(k,2610) - lu(k,2631) = lu(k,2631) - lu(k,2145) * lu(k,2610) - lu(k,2633) = lu(k,2633) - lu(k,2146) * lu(k,2610) - lu(k,2634) = lu(k,2634) - lu(k,2147) * lu(k,2610) - lu(k,2635) = lu(k,2635) - lu(k,2148) * lu(k,2610) - lu(k,2636) = lu(k,2636) - lu(k,2149) * lu(k,2610) - lu(k,2638) = lu(k,2638) - lu(k,2150) * lu(k,2610) - lu(k,2639) = lu(k,2639) - lu(k,2151) * lu(k,2610) - lu(k,2642) = lu(k,2642) - lu(k,2152) * lu(k,2610) - lu(k,2699) = lu(k,2699) - lu(k,2142) * lu(k,2681) - lu(k,2700) = lu(k,2700) - lu(k,2143) * lu(k,2681) - lu(k,2701) = lu(k,2701) - lu(k,2144) * lu(k,2681) - lu(k,2702) = lu(k,2702) - lu(k,2145) * lu(k,2681) - lu(k,2704) = lu(k,2704) - lu(k,2146) * lu(k,2681) - lu(k,2705) = lu(k,2705) - lu(k,2147) * lu(k,2681) - lu(k,2706) = lu(k,2706) - lu(k,2148) * lu(k,2681) - lu(k,2707) = lu(k,2707) - lu(k,2149) * lu(k,2681) - lu(k,2709) = lu(k,2709) - lu(k,2150) * lu(k,2681) - lu(k,2710) = lu(k,2710) - lu(k,2151) * lu(k,2681) - lu(k,2713) = lu(k,2713) - lu(k,2152) * lu(k,2681) - lu(k,2882) = lu(k,2882) - lu(k,2142) * lu(k,2864) - lu(k,2883) = lu(k,2883) - lu(k,2143) * lu(k,2864) - lu(k,2884) = lu(k,2884) - lu(k,2144) * lu(k,2864) - lu(k,2885) = lu(k,2885) - lu(k,2145) * lu(k,2864) - lu(k,2887) = lu(k,2887) - lu(k,2146) * lu(k,2864) - lu(k,2889) = lu(k,2889) - lu(k,2147) * lu(k,2864) - lu(k,2891) = lu(k,2891) - lu(k,2148) * lu(k,2864) - lu(k,2892) = lu(k,2892) - lu(k,2149) * lu(k,2864) - lu(k,2894) = lu(k,2894) - lu(k,2150) * lu(k,2864) - lu(k,2895) = lu(k,2895) - lu(k,2151) * lu(k,2864) - lu(k,2899) = lu(k,2899) - lu(k,2152) * lu(k,2864) - lu(k,2983) = lu(k,2983) - lu(k,2142) * lu(k,2965) - lu(k,2984) = lu(k,2984) - lu(k,2143) * lu(k,2965) - lu(k,2985) = lu(k,2985) - lu(k,2144) * lu(k,2965) - lu(k,2986) = lu(k,2986) - lu(k,2145) * lu(k,2965) - lu(k,2988) = lu(k,2988) - lu(k,2146) * lu(k,2965) - lu(k,2990) = lu(k,2990) - lu(k,2147) * lu(k,2965) - lu(k,2992) = lu(k,2992) - lu(k,2148) * lu(k,2965) - lu(k,2993) = lu(k,2993) - lu(k,2149) * lu(k,2965) - lu(k,2995) = lu(k,2995) - lu(k,2150) * lu(k,2965) - lu(k,2996) = lu(k,2996) - lu(k,2151) * lu(k,2965) - lu(k,3000) = lu(k,3000) - lu(k,2152) * lu(k,2965) - lu(k,3075) = lu(k,3075) - lu(k,2142) * lu(k,3057) - lu(k,3076) = lu(k,3076) - lu(k,2143) * lu(k,3057) - lu(k,3077) = lu(k,3077) - lu(k,2144) * lu(k,3057) - lu(k,3078) = lu(k,3078) - lu(k,2145) * lu(k,3057) - lu(k,3080) = lu(k,3080) - lu(k,2146) * lu(k,3057) - lu(k,3082) = lu(k,3082) - lu(k,2147) * lu(k,3057) - lu(k,3084) = lu(k,3084) - lu(k,2148) * lu(k,3057) - lu(k,3085) = lu(k,3085) - lu(k,2149) * lu(k,3057) - lu(k,3087) = lu(k,3087) - lu(k,2150) * lu(k,3057) - lu(k,3088) = lu(k,3088) - lu(k,2151) * lu(k,3057) - lu(k,3092) = lu(k,3092) - lu(k,2152) * lu(k,3057) - lu(k,3278) = lu(k,3278) - lu(k,2142) * lu(k,3260) - lu(k,3279) = lu(k,3279) - lu(k,2143) * lu(k,3260) - lu(k,3280) = lu(k,3280) - lu(k,2144) * lu(k,3260) - lu(k,3281) = lu(k,3281) - lu(k,2145) * lu(k,3260) - lu(k,3283) = lu(k,3283) - lu(k,2146) * lu(k,3260) - lu(k,3285) = lu(k,3285) - lu(k,2147) * lu(k,3260) - lu(k,3287) = lu(k,3287) - lu(k,2148) * lu(k,3260) - lu(k,3288) = lu(k,3288) - lu(k,2149) * lu(k,3260) - lu(k,3290) = lu(k,3290) - lu(k,2150) * lu(k,3260) - lu(k,3291) = lu(k,3291) - lu(k,2151) * lu(k,3260) - lu(k,3295) = lu(k,3295) - lu(k,2152) * lu(k,3260) - lu(k,3419) = lu(k,3419) - lu(k,2142) * lu(k,3401) - lu(k,3420) = lu(k,3420) - lu(k,2143) * lu(k,3401) - lu(k,3421) = lu(k,3421) - lu(k,2144) * lu(k,3401) - lu(k,3422) = lu(k,3422) - lu(k,2145) * lu(k,3401) - lu(k,3424) = lu(k,3424) - lu(k,2146) * lu(k,3401) - lu(k,3426) = lu(k,3426) - lu(k,2147) * lu(k,3401) - lu(k,3428) = lu(k,3428) - lu(k,2148) * lu(k,3401) - lu(k,3429) = lu(k,3429) - lu(k,2149) * lu(k,3401) - lu(k,3431) = lu(k,3431) - lu(k,2150) * lu(k,3401) - lu(k,3432) = lu(k,3432) - lu(k,2151) * lu(k,3401) - lu(k,3436) = lu(k,3436) - lu(k,2152) * lu(k,3401) - lu(k,3499) = lu(k,3499) - lu(k,2142) * lu(k,3494) - lu(k,3500) = lu(k,3500) - lu(k,2143) * lu(k,3494) - lu(k,3501) = lu(k,3501) - lu(k,2144) * lu(k,3494) - lu(k,3502) = lu(k,3502) - lu(k,2145) * lu(k,3494) - lu(k,3504) = lu(k,3504) - lu(k,2146) * lu(k,3494) - lu(k,3506) = lu(k,3506) - lu(k,2147) * lu(k,3494) - lu(k,3508) = lu(k,3508) - lu(k,2148) * lu(k,3494) - lu(k,3509) = lu(k,3509) - lu(k,2149) * lu(k,3494) - lu(k,3511) = lu(k,3511) - lu(k,2150) * lu(k,3494) - lu(k,3512) = lu(k,3512) - lu(k,2151) * lu(k,3494) - lu(k,3516) = lu(k,3516) - lu(k,2152) * lu(k,3494) - lu(k,3739) = lu(k,3739) - lu(k,2142) * lu(k,3721) - lu(k,3740) = lu(k,3740) - lu(k,2143) * lu(k,3721) - lu(k,3741) = lu(k,3741) - lu(k,2144) * lu(k,3721) - lu(k,3742) = lu(k,3742) - lu(k,2145) * lu(k,3721) - lu(k,3744) = lu(k,3744) - lu(k,2146) * lu(k,3721) - lu(k,3746) = lu(k,3746) - lu(k,2147) * lu(k,3721) - lu(k,3748) = lu(k,3748) - lu(k,2148) * lu(k,3721) - lu(k,3749) = lu(k,3749) - lu(k,2149) * lu(k,3721) - lu(k,3751) = lu(k,3751) - lu(k,2150) * lu(k,3721) - lu(k,3752) = lu(k,3752) - lu(k,2151) * lu(k,3721) - lu(k,3756) = lu(k,3756) - lu(k,2152) * lu(k,3721) + lu(k,2022) = 1._r8 / lu(k,2022) + lu(k,2023) = lu(k,2023) * lu(k,2022) + lu(k,2024) = lu(k,2024) * lu(k,2022) + lu(k,2025) = lu(k,2025) * lu(k,2022) + lu(k,2026) = lu(k,2026) * lu(k,2022) + lu(k,2027) = lu(k,2027) * lu(k,2022) + lu(k,2028) = lu(k,2028) * lu(k,2022) + lu(k,2029) = lu(k,2029) * lu(k,2022) + lu(k,2030) = lu(k,2030) * lu(k,2022) + lu(k,2031) = lu(k,2031) * lu(k,2022) + lu(k,2032) = lu(k,2032) * lu(k,2022) + lu(k,2033) = lu(k,2033) * lu(k,2022) + lu(k,2034) = lu(k,2034) * lu(k,2022) + lu(k,2035) = lu(k,2035) * lu(k,2022) + lu(k,2182) = - lu(k,2023) * lu(k,2175) + lu(k,2183) = lu(k,2183) - lu(k,2024) * lu(k,2175) + lu(k,2184) = lu(k,2184) - lu(k,2025) * lu(k,2175) + lu(k,2186) = lu(k,2186) - lu(k,2026) * lu(k,2175) + lu(k,2187) = lu(k,2187) - lu(k,2027) * lu(k,2175) + lu(k,2188) = lu(k,2188) - lu(k,2028) * lu(k,2175) + lu(k,2189) = lu(k,2189) - lu(k,2029) * lu(k,2175) + lu(k,2190) = lu(k,2190) - lu(k,2030) * lu(k,2175) + lu(k,2191) = lu(k,2191) - lu(k,2031) * lu(k,2175) + lu(k,2193) = lu(k,2193) - lu(k,2032) * lu(k,2175) + lu(k,2194) = lu(k,2194) - lu(k,2033) * lu(k,2175) + lu(k,2195) = lu(k,2195) - lu(k,2034) * lu(k,2175) + lu(k,2196) = lu(k,2196) - lu(k,2035) * lu(k,2175) + lu(k,3001) = lu(k,3001) - lu(k,2023) * lu(k,2992) + lu(k,3023) = lu(k,3023) - lu(k,2024) * lu(k,2992) + lu(k,3024) = lu(k,3024) - lu(k,2025) * lu(k,2992) + lu(k,3026) = lu(k,3026) - lu(k,2026) * lu(k,2992) + lu(k,3027) = lu(k,3027) - lu(k,2027) * lu(k,2992) + lu(k,3028) = lu(k,3028) - lu(k,2028) * lu(k,2992) + lu(k,3029) = lu(k,3029) - lu(k,2029) * lu(k,2992) + lu(k,3030) = lu(k,3030) - lu(k,2030) * lu(k,2992) + lu(k,3031) = lu(k,3031) - lu(k,2031) * lu(k,2992) + lu(k,3033) = lu(k,3033) - lu(k,2032) * lu(k,2992) + lu(k,3034) = lu(k,3034) - lu(k,2033) * lu(k,2992) + lu(k,3035) = lu(k,3035) - lu(k,2034) * lu(k,2992) + lu(k,3036) = lu(k,3036) - lu(k,2035) * lu(k,2992) + lu(k,3102) = lu(k,3102) - lu(k,2023) * lu(k,3093) + lu(k,3126) = lu(k,3126) - lu(k,2024) * lu(k,3093) + lu(k,3127) = lu(k,3127) - lu(k,2025) * lu(k,3093) + lu(k,3129) = lu(k,3129) - lu(k,2026) * lu(k,3093) + lu(k,3130) = lu(k,3130) - lu(k,2027) * lu(k,3093) + lu(k,3131) = lu(k,3131) - lu(k,2028) * lu(k,3093) + lu(k,3132) = lu(k,3132) - lu(k,2029) * lu(k,3093) + lu(k,3133) = lu(k,3133) - lu(k,2030) * lu(k,3093) + lu(k,3134) = lu(k,3134) - lu(k,2031) * lu(k,3093) + lu(k,3136) = lu(k,3136) - lu(k,2032) * lu(k,3093) + lu(k,3137) = lu(k,3137) - lu(k,2033) * lu(k,3093) + lu(k,3138) = lu(k,3138) - lu(k,2034) * lu(k,3093) + lu(k,3139) = lu(k,3139) - lu(k,2035) * lu(k,3093) + lu(k,3284) = lu(k,3284) - lu(k,2023) * lu(k,3274) + lu(k,3308) = lu(k,3308) - lu(k,2024) * lu(k,3274) + lu(k,3309) = lu(k,3309) - lu(k,2025) * lu(k,3274) + lu(k,3311) = lu(k,3311) - lu(k,2026) * lu(k,3274) + lu(k,3312) = lu(k,3312) - lu(k,2027) * lu(k,3274) + lu(k,3313) = lu(k,3313) - lu(k,2028) * lu(k,3274) + lu(k,3314) = lu(k,3314) - lu(k,2029) * lu(k,3274) + lu(k,3315) = lu(k,3315) - lu(k,2030) * lu(k,3274) + lu(k,3316) = lu(k,3316) - lu(k,2031) * lu(k,3274) + lu(k,3318) = lu(k,3318) - lu(k,2032) * lu(k,3274) + lu(k,3319) = lu(k,3319) - lu(k,2033) * lu(k,3274) + lu(k,3320) = lu(k,3320) - lu(k,2034) * lu(k,3274) + lu(k,3321) = lu(k,3321) - lu(k,2035) * lu(k,3274) + lu(k,3540) = lu(k,3540) - lu(k,2023) * lu(k,3530) + lu(k,3564) = lu(k,3564) - lu(k,2024) * lu(k,3530) + lu(k,3565) = lu(k,3565) - lu(k,2025) * lu(k,3530) + lu(k,3567) = lu(k,3567) - lu(k,2026) * lu(k,3530) + lu(k,3568) = lu(k,3568) - lu(k,2027) * lu(k,3530) + lu(k,3569) = lu(k,3569) - lu(k,2028) * lu(k,3530) + lu(k,3570) = lu(k,3570) - lu(k,2029) * lu(k,3530) + lu(k,3571) = lu(k,3571) - lu(k,2030) * lu(k,3530) + lu(k,3572) = lu(k,3572) - lu(k,2031) * lu(k,3530) + lu(k,3574) = lu(k,3574) - lu(k,2032) * lu(k,3530) + lu(k,3575) = lu(k,3575) - lu(k,2033) * lu(k,3530) + lu(k,3576) = lu(k,3576) - lu(k,2034) * lu(k,3530) + lu(k,3577) = lu(k,3577) - lu(k,2035) * lu(k,3530) + lu(k,3790) = lu(k,3790) - lu(k,2023) * lu(k,3781) + lu(k,3814) = lu(k,3814) - lu(k,2024) * lu(k,3781) + lu(k,3815) = lu(k,3815) - lu(k,2025) * lu(k,3781) + lu(k,3817) = lu(k,3817) - lu(k,2026) * lu(k,3781) + lu(k,3818) = lu(k,3818) - lu(k,2027) * lu(k,3781) + lu(k,3819) = lu(k,3819) - lu(k,2028) * lu(k,3781) + lu(k,3820) = lu(k,3820) - lu(k,2029) * lu(k,3781) + lu(k,3821) = lu(k,3821) - lu(k,2030) * lu(k,3781) + lu(k,3822) = lu(k,3822) - lu(k,2031) * lu(k,3781) + lu(k,3824) = lu(k,3824) - lu(k,2032) * lu(k,3781) + lu(k,3825) = lu(k,3825) - lu(k,2033) * lu(k,3781) + lu(k,3826) = lu(k,3826) - lu(k,2034) * lu(k,3781) + lu(k,3827) = lu(k,3827) - lu(k,2035) * lu(k,3781) + lu(k,3925) = lu(k,3925) - lu(k,2023) * lu(k,3915) + lu(k,3949) = lu(k,3949) - lu(k,2024) * lu(k,3915) + lu(k,3950) = lu(k,3950) - lu(k,2025) * lu(k,3915) + lu(k,3952) = lu(k,3952) - lu(k,2026) * lu(k,3915) + lu(k,3953) = lu(k,3953) - lu(k,2027) * lu(k,3915) + lu(k,3954) = lu(k,3954) - lu(k,2028) * lu(k,3915) + lu(k,3955) = lu(k,3955) - lu(k,2029) * lu(k,3915) + lu(k,3956) = lu(k,3956) - lu(k,2030) * lu(k,3915) + lu(k,3957) = lu(k,3957) - lu(k,2031) * lu(k,3915) + lu(k,3959) = lu(k,3959) - lu(k,2032) * lu(k,3915) + lu(k,3960) = lu(k,3960) - lu(k,2033) * lu(k,3915) + lu(k,3961) = lu(k,3961) - lu(k,2034) * lu(k,3915) + lu(k,3962) = lu(k,3962) - lu(k,2035) * lu(k,3915) + lu(k,4018) = lu(k,4018) - lu(k,2023) * lu(k,4009) + lu(k,4041) = lu(k,4041) - lu(k,2024) * lu(k,4009) + lu(k,4042) = lu(k,4042) - lu(k,2025) * lu(k,4009) + lu(k,4044) = lu(k,4044) - lu(k,2026) * lu(k,4009) + lu(k,4045) = lu(k,4045) - lu(k,2027) * lu(k,4009) + lu(k,4046) = lu(k,4046) - lu(k,2028) * lu(k,4009) + lu(k,4047) = lu(k,4047) - lu(k,2029) * lu(k,4009) + lu(k,4048) = lu(k,4048) - lu(k,2030) * lu(k,4009) + lu(k,4049) = lu(k,4049) - lu(k,2031) * lu(k,4009) + lu(k,4051) = lu(k,4051) - lu(k,2032) * lu(k,4009) + lu(k,4052) = lu(k,4052) - lu(k,2033) * lu(k,4009) + lu(k,4053) = lu(k,4053) - lu(k,2034) * lu(k,4009) + lu(k,4054) = lu(k,4054) - lu(k,2035) * lu(k,4009) + lu(k,2047) = 1._r8 / lu(k,2047) + lu(k,2048) = lu(k,2048) * lu(k,2047) + lu(k,2049) = lu(k,2049) * lu(k,2047) + lu(k,2050) = lu(k,2050) * lu(k,2047) + lu(k,2051) = lu(k,2051) * lu(k,2047) + lu(k,2052) = lu(k,2052) * lu(k,2047) + lu(k,2053) = lu(k,2053) * lu(k,2047) + lu(k,2054) = lu(k,2054) * lu(k,2047) + lu(k,2055) = lu(k,2055) * lu(k,2047) + lu(k,2056) = lu(k,2056) * lu(k,2047) + lu(k,2057) = lu(k,2057) * lu(k,2047) + lu(k,2058) = lu(k,2058) * lu(k,2047) + lu(k,2059) = lu(k,2059) * lu(k,2047) + lu(k,2060) = lu(k,2060) * lu(k,2047) + lu(k,2181) = - lu(k,2048) * lu(k,2176) + lu(k,2183) = lu(k,2183) - lu(k,2049) * lu(k,2176) + lu(k,2184) = lu(k,2184) - lu(k,2050) * lu(k,2176) + lu(k,2186) = lu(k,2186) - lu(k,2051) * lu(k,2176) + lu(k,2187) = lu(k,2187) - lu(k,2052) * lu(k,2176) + lu(k,2188) = lu(k,2188) - lu(k,2053) * lu(k,2176) + lu(k,2189) = lu(k,2189) - lu(k,2054) * lu(k,2176) + lu(k,2190) = lu(k,2190) - lu(k,2055) * lu(k,2176) + lu(k,2191) = lu(k,2191) - lu(k,2056) * lu(k,2176) + lu(k,2193) = lu(k,2193) - lu(k,2057) * lu(k,2176) + lu(k,2194) = lu(k,2194) - lu(k,2058) * lu(k,2176) + lu(k,2195) = lu(k,2195) - lu(k,2059) * lu(k,2176) + lu(k,2196) = lu(k,2196) - lu(k,2060) * lu(k,2176) + lu(k,3000) = - lu(k,2048) * lu(k,2993) + lu(k,3023) = lu(k,3023) - lu(k,2049) * lu(k,2993) + lu(k,3024) = lu(k,3024) - lu(k,2050) * lu(k,2993) + lu(k,3026) = lu(k,3026) - lu(k,2051) * lu(k,2993) + lu(k,3027) = lu(k,3027) - lu(k,2052) * lu(k,2993) + lu(k,3028) = lu(k,3028) - lu(k,2053) * lu(k,2993) + lu(k,3029) = lu(k,3029) - lu(k,2054) * lu(k,2993) + lu(k,3030) = lu(k,3030) - lu(k,2055) * lu(k,2993) + lu(k,3031) = lu(k,3031) - lu(k,2056) * lu(k,2993) + lu(k,3033) = lu(k,3033) - lu(k,2057) * lu(k,2993) + lu(k,3034) = lu(k,3034) - lu(k,2058) * lu(k,2993) + lu(k,3035) = lu(k,3035) - lu(k,2059) * lu(k,2993) + lu(k,3036) = lu(k,3036) - lu(k,2060) * lu(k,2993) + lu(k,3101) = lu(k,3101) - lu(k,2048) * lu(k,3094) + lu(k,3126) = lu(k,3126) - lu(k,2049) * lu(k,3094) + lu(k,3127) = lu(k,3127) - lu(k,2050) * lu(k,3094) + lu(k,3129) = lu(k,3129) - lu(k,2051) * lu(k,3094) + lu(k,3130) = lu(k,3130) - lu(k,2052) * lu(k,3094) + lu(k,3131) = lu(k,3131) - lu(k,2053) * lu(k,3094) + lu(k,3132) = lu(k,3132) - lu(k,2054) * lu(k,3094) + lu(k,3133) = lu(k,3133) - lu(k,2055) * lu(k,3094) + lu(k,3134) = lu(k,3134) - lu(k,2056) * lu(k,3094) + lu(k,3136) = lu(k,3136) - lu(k,2057) * lu(k,3094) + lu(k,3137) = lu(k,3137) - lu(k,2058) * lu(k,3094) + lu(k,3138) = lu(k,3138) - lu(k,2059) * lu(k,3094) + lu(k,3139) = lu(k,3139) - lu(k,2060) * lu(k,3094) + lu(k,3283) = - lu(k,2048) * lu(k,3275) + lu(k,3308) = lu(k,3308) - lu(k,2049) * lu(k,3275) + lu(k,3309) = lu(k,3309) - lu(k,2050) * lu(k,3275) + lu(k,3311) = lu(k,3311) - lu(k,2051) * lu(k,3275) + lu(k,3312) = lu(k,3312) - lu(k,2052) * lu(k,3275) + lu(k,3313) = lu(k,3313) - lu(k,2053) * lu(k,3275) + lu(k,3314) = lu(k,3314) - lu(k,2054) * lu(k,3275) + lu(k,3315) = lu(k,3315) - lu(k,2055) * lu(k,3275) + lu(k,3316) = lu(k,3316) - lu(k,2056) * lu(k,3275) + lu(k,3318) = lu(k,3318) - lu(k,2057) * lu(k,3275) + lu(k,3319) = lu(k,3319) - lu(k,2058) * lu(k,3275) + lu(k,3320) = lu(k,3320) - lu(k,2059) * lu(k,3275) + lu(k,3321) = lu(k,3321) - lu(k,2060) * lu(k,3275) + lu(k,3539) = lu(k,3539) - lu(k,2048) * lu(k,3531) + lu(k,3564) = lu(k,3564) - lu(k,2049) * lu(k,3531) + lu(k,3565) = lu(k,3565) - lu(k,2050) * lu(k,3531) + lu(k,3567) = lu(k,3567) - lu(k,2051) * lu(k,3531) + lu(k,3568) = lu(k,3568) - lu(k,2052) * lu(k,3531) + lu(k,3569) = lu(k,3569) - lu(k,2053) * lu(k,3531) + lu(k,3570) = lu(k,3570) - lu(k,2054) * lu(k,3531) + lu(k,3571) = lu(k,3571) - lu(k,2055) * lu(k,3531) + lu(k,3572) = lu(k,3572) - lu(k,2056) * lu(k,3531) + lu(k,3574) = lu(k,3574) - lu(k,2057) * lu(k,3531) + lu(k,3575) = lu(k,3575) - lu(k,2058) * lu(k,3531) + lu(k,3576) = lu(k,3576) - lu(k,2059) * lu(k,3531) + lu(k,3577) = lu(k,3577) - lu(k,2060) * lu(k,3531) + lu(k,3789) = lu(k,3789) - lu(k,2048) * lu(k,3782) + lu(k,3814) = lu(k,3814) - lu(k,2049) * lu(k,3782) + lu(k,3815) = lu(k,3815) - lu(k,2050) * lu(k,3782) + lu(k,3817) = lu(k,3817) - lu(k,2051) * lu(k,3782) + lu(k,3818) = lu(k,3818) - lu(k,2052) * lu(k,3782) + lu(k,3819) = lu(k,3819) - lu(k,2053) * lu(k,3782) + lu(k,3820) = lu(k,3820) - lu(k,2054) * lu(k,3782) + lu(k,3821) = lu(k,3821) - lu(k,2055) * lu(k,3782) + lu(k,3822) = lu(k,3822) - lu(k,2056) * lu(k,3782) + lu(k,3824) = lu(k,3824) - lu(k,2057) * lu(k,3782) + lu(k,3825) = lu(k,3825) - lu(k,2058) * lu(k,3782) + lu(k,3826) = lu(k,3826) - lu(k,2059) * lu(k,3782) + lu(k,3827) = lu(k,3827) - lu(k,2060) * lu(k,3782) + lu(k,3924) = lu(k,3924) - lu(k,2048) * lu(k,3916) + lu(k,3949) = lu(k,3949) - lu(k,2049) * lu(k,3916) + lu(k,3950) = lu(k,3950) - lu(k,2050) * lu(k,3916) + lu(k,3952) = lu(k,3952) - lu(k,2051) * lu(k,3916) + lu(k,3953) = lu(k,3953) - lu(k,2052) * lu(k,3916) + lu(k,3954) = lu(k,3954) - lu(k,2053) * lu(k,3916) + lu(k,3955) = lu(k,3955) - lu(k,2054) * lu(k,3916) + lu(k,3956) = lu(k,3956) - lu(k,2055) * lu(k,3916) + lu(k,3957) = lu(k,3957) - lu(k,2056) * lu(k,3916) + lu(k,3959) = lu(k,3959) - lu(k,2057) * lu(k,3916) + lu(k,3960) = lu(k,3960) - lu(k,2058) * lu(k,3916) + lu(k,3961) = lu(k,3961) - lu(k,2059) * lu(k,3916) + lu(k,3962) = lu(k,3962) - lu(k,2060) * lu(k,3916) + lu(k,4017) = - lu(k,2048) * lu(k,4010) + lu(k,4041) = lu(k,4041) - lu(k,2049) * lu(k,4010) + lu(k,4042) = lu(k,4042) - lu(k,2050) * lu(k,4010) + lu(k,4044) = lu(k,4044) - lu(k,2051) * lu(k,4010) + lu(k,4045) = lu(k,4045) - lu(k,2052) * lu(k,4010) + lu(k,4046) = lu(k,4046) - lu(k,2053) * lu(k,4010) + lu(k,4047) = lu(k,4047) - lu(k,2054) * lu(k,4010) + lu(k,4048) = lu(k,4048) - lu(k,2055) * lu(k,4010) + lu(k,4049) = lu(k,4049) - lu(k,2056) * lu(k,4010) + lu(k,4051) = lu(k,4051) - lu(k,2057) * lu(k,4010) + lu(k,4052) = lu(k,4052) - lu(k,2058) * lu(k,4010) + lu(k,4053) = lu(k,4053) - lu(k,2059) * lu(k,4010) + lu(k,4054) = lu(k,4054) - lu(k,2060) * lu(k,4010) + lu(k,2078) = 1._r8 / lu(k,2078) + lu(k,2079) = lu(k,2079) * lu(k,2078) + lu(k,2080) = lu(k,2080) * lu(k,2078) + lu(k,2081) = lu(k,2081) * lu(k,2078) + lu(k,2082) = lu(k,2082) * lu(k,2078) + lu(k,2083) = lu(k,2083) * lu(k,2078) + lu(k,2084) = lu(k,2084) * lu(k,2078) + lu(k,2085) = lu(k,2085) * lu(k,2078) + lu(k,2086) = lu(k,2086) * lu(k,2078) + lu(k,2087) = lu(k,2087) * lu(k,2078) + lu(k,2088) = lu(k,2088) * lu(k,2078) + lu(k,2089) = lu(k,2089) * lu(k,2078) + lu(k,2090) = lu(k,2090) * lu(k,2078) + lu(k,2091) = lu(k,2091) * lu(k,2078) + lu(k,2092) = lu(k,2092) * lu(k,2078) + lu(k,2179) = lu(k,2179) - lu(k,2079) * lu(k,2177) + lu(k,2183) = lu(k,2183) - lu(k,2080) * lu(k,2177) + lu(k,2184) = lu(k,2184) - lu(k,2081) * lu(k,2177) + lu(k,2185) = lu(k,2185) - lu(k,2082) * lu(k,2177) + lu(k,2186) = lu(k,2186) - lu(k,2083) * lu(k,2177) + lu(k,2187) = lu(k,2187) - lu(k,2084) * lu(k,2177) + lu(k,2188) = lu(k,2188) - lu(k,2085) * lu(k,2177) + lu(k,2189) = lu(k,2189) - lu(k,2086) * lu(k,2177) + lu(k,2190) = lu(k,2190) - lu(k,2087) * lu(k,2177) + lu(k,2191) = lu(k,2191) - lu(k,2088) * lu(k,2177) + lu(k,2192) = lu(k,2192) - lu(k,2089) * lu(k,2177) + lu(k,2193) = lu(k,2193) - lu(k,2090) * lu(k,2177) + lu(k,2195) = lu(k,2195) - lu(k,2091) * lu(k,2177) + lu(k,2196) = lu(k,2196) - lu(k,2092) * lu(k,2177) + lu(k,2996) = lu(k,2996) - lu(k,2079) * lu(k,2994) + lu(k,3023) = lu(k,3023) - lu(k,2080) * lu(k,2994) + lu(k,3024) = lu(k,3024) - lu(k,2081) * lu(k,2994) + lu(k,3025) = - lu(k,2082) * lu(k,2994) + lu(k,3026) = lu(k,3026) - lu(k,2083) * lu(k,2994) + lu(k,3027) = lu(k,3027) - lu(k,2084) * lu(k,2994) + lu(k,3028) = lu(k,3028) - lu(k,2085) * lu(k,2994) + lu(k,3029) = lu(k,3029) - lu(k,2086) * lu(k,2994) + lu(k,3030) = lu(k,3030) - lu(k,2087) * lu(k,2994) + lu(k,3031) = lu(k,3031) - lu(k,2088) * lu(k,2994) + lu(k,3032) = - lu(k,2089) * lu(k,2994) + lu(k,3033) = lu(k,3033) - lu(k,2090) * lu(k,2994) + lu(k,3035) = lu(k,3035) - lu(k,2091) * lu(k,2994) + lu(k,3036) = lu(k,3036) - lu(k,2092) * lu(k,2994) + lu(k,3097) = lu(k,3097) - lu(k,2079) * lu(k,3095) + lu(k,3126) = lu(k,3126) - lu(k,2080) * lu(k,3095) + lu(k,3127) = lu(k,3127) - lu(k,2081) * lu(k,3095) + lu(k,3128) = lu(k,3128) - lu(k,2082) * lu(k,3095) + lu(k,3129) = lu(k,3129) - lu(k,2083) * lu(k,3095) + lu(k,3130) = lu(k,3130) - lu(k,2084) * lu(k,3095) + lu(k,3131) = lu(k,3131) - lu(k,2085) * lu(k,3095) + lu(k,3132) = lu(k,3132) - lu(k,2086) * lu(k,3095) + lu(k,3133) = lu(k,3133) - lu(k,2087) * lu(k,3095) + lu(k,3134) = lu(k,3134) - lu(k,2088) * lu(k,3095) + lu(k,3135) = lu(k,3135) - lu(k,2089) * lu(k,3095) + lu(k,3136) = lu(k,3136) - lu(k,2090) * lu(k,3095) + lu(k,3138) = lu(k,3138) - lu(k,2091) * lu(k,3095) + lu(k,3139) = lu(k,3139) - lu(k,2092) * lu(k,3095) + lu(k,3278) = lu(k,3278) - lu(k,2079) * lu(k,3276) + lu(k,3308) = lu(k,3308) - lu(k,2080) * lu(k,3276) + lu(k,3309) = lu(k,3309) - lu(k,2081) * lu(k,3276) + lu(k,3310) = - lu(k,2082) * lu(k,3276) + lu(k,3311) = lu(k,3311) - lu(k,2083) * lu(k,3276) + lu(k,3312) = lu(k,3312) - lu(k,2084) * lu(k,3276) + lu(k,3313) = lu(k,3313) - lu(k,2085) * lu(k,3276) + lu(k,3314) = lu(k,3314) - lu(k,2086) * lu(k,3276) + lu(k,3315) = lu(k,3315) - lu(k,2087) * lu(k,3276) + lu(k,3316) = lu(k,3316) - lu(k,2088) * lu(k,3276) + lu(k,3317) = lu(k,3317) - lu(k,2089) * lu(k,3276) + lu(k,3318) = lu(k,3318) - lu(k,2090) * lu(k,3276) + lu(k,3320) = lu(k,3320) - lu(k,2091) * lu(k,3276) + lu(k,3321) = lu(k,3321) - lu(k,2092) * lu(k,3276) + lu(k,3534) = lu(k,3534) - lu(k,2079) * lu(k,3532) + lu(k,3564) = lu(k,3564) - lu(k,2080) * lu(k,3532) + lu(k,3565) = lu(k,3565) - lu(k,2081) * lu(k,3532) + lu(k,3566) = lu(k,3566) - lu(k,2082) * lu(k,3532) + lu(k,3567) = lu(k,3567) - lu(k,2083) * lu(k,3532) + lu(k,3568) = lu(k,3568) - lu(k,2084) * lu(k,3532) + lu(k,3569) = lu(k,3569) - lu(k,2085) * lu(k,3532) + lu(k,3570) = lu(k,3570) - lu(k,2086) * lu(k,3532) + lu(k,3571) = lu(k,3571) - lu(k,2087) * lu(k,3532) + lu(k,3572) = lu(k,3572) - lu(k,2088) * lu(k,3532) + lu(k,3573) = lu(k,3573) - lu(k,2089) * lu(k,3532) + lu(k,3574) = lu(k,3574) - lu(k,2090) * lu(k,3532) + lu(k,3576) = lu(k,3576) - lu(k,2091) * lu(k,3532) + lu(k,3577) = lu(k,3577) - lu(k,2092) * lu(k,3532) + lu(k,3785) = lu(k,3785) - lu(k,2079) * lu(k,3783) + lu(k,3814) = lu(k,3814) - lu(k,2080) * lu(k,3783) + lu(k,3815) = lu(k,3815) - lu(k,2081) * lu(k,3783) + lu(k,3816) = lu(k,3816) - lu(k,2082) * lu(k,3783) + lu(k,3817) = lu(k,3817) - lu(k,2083) * lu(k,3783) + lu(k,3818) = lu(k,3818) - lu(k,2084) * lu(k,3783) + lu(k,3819) = lu(k,3819) - lu(k,2085) * lu(k,3783) + lu(k,3820) = lu(k,3820) - lu(k,2086) * lu(k,3783) + lu(k,3821) = lu(k,3821) - lu(k,2087) * lu(k,3783) + lu(k,3822) = lu(k,3822) - lu(k,2088) * lu(k,3783) + lu(k,3823) = lu(k,3823) - lu(k,2089) * lu(k,3783) + lu(k,3824) = lu(k,3824) - lu(k,2090) * lu(k,3783) + lu(k,3826) = lu(k,3826) - lu(k,2091) * lu(k,3783) + lu(k,3827) = lu(k,3827) - lu(k,2092) * lu(k,3783) + lu(k,3919) = lu(k,3919) - lu(k,2079) * lu(k,3917) + lu(k,3949) = lu(k,3949) - lu(k,2080) * lu(k,3917) + lu(k,3950) = lu(k,3950) - lu(k,2081) * lu(k,3917) + lu(k,3951) = lu(k,3951) - lu(k,2082) * lu(k,3917) + lu(k,3952) = lu(k,3952) - lu(k,2083) * lu(k,3917) + lu(k,3953) = lu(k,3953) - lu(k,2084) * lu(k,3917) + lu(k,3954) = lu(k,3954) - lu(k,2085) * lu(k,3917) + lu(k,3955) = lu(k,3955) - lu(k,2086) * lu(k,3917) + lu(k,3956) = lu(k,3956) - lu(k,2087) * lu(k,3917) + lu(k,3957) = lu(k,3957) - lu(k,2088) * lu(k,3917) + lu(k,3958) = lu(k,3958) - lu(k,2089) * lu(k,3917) + lu(k,3959) = lu(k,3959) - lu(k,2090) * lu(k,3917) + lu(k,3961) = lu(k,3961) - lu(k,2091) * lu(k,3917) + lu(k,3962) = lu(k,3962) - lu(k,2092) * lu(k,3917) + lu(k,4013) = lu(k,4013) - lu(k,2079) * lu(k,4011) + lu(k,4041) = lu(k,4041) - lu(k,2080) * lu(k,4011) + lu(k,4042) = lu(k,4042) - lu(k,2081) * lu(k,4011) + lu(k,4043) = - lu(k,2082) * lu(k,4011) + lu(k,4044) = lu(k,4044) - lu(k,2083) * lu(k,4011) + lu(k,4045) = lu(k,4045) - lu(k,2084) * lu(k,4011) + lu(k,4046) = lu(k,4046) - lu(k,2085) * lu(k,4011) + lu(k,4047) = lu(k,4047) - lu(k,2086) * lu(k,4011) + lu(k,4048) = lu(k,4048) - lu(k,2087) * lu(k,4011) + lu(k,4049) = lu(k,4049) - lu(k,2088) * lu(k,4011) + lu(k,4050) = lu(k,4050) - lu(k,2089) * lu(k,4011) + lu(k,4051) = lu(k,4051) - lu(k,2090) * lu(k,4011) + lu(k,4053) = lu(k,4053) - lu(k,2091) * lu(k,4011) + lu(k,4054) = lu(k,4054) - lu(k,2092) * lu(k,4011) end do end subroutine lu_fac42 subroutine lu_fac43( avec_len, lu ) @@ -11257,563 +10548,516 @@ subroutine lu_fac43( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,2156) = 1._r8 / lu(k,2156) - lu(k,2157) = lu(k,2157) * lu(k,2156) - lu(k,2158) = lu(k,2158) * lu(k,2156) - lu(k,2159) = lu(k,2159) * lu(k,2156) - lu(k,2160) = lu(k,2160) * lu(k,2156) - lu(k,2161) = lu(k,2161) * lu(k,2156) - lu(k,2162) = lu(k,2162) * lu(k,2156) - lu(k,2163) = lu(k,2163) * lu(k,2156) - lu(k,2164) = lu(k,2164) * lu(k,2156) - lu(k,2165) = lu(k,2165) * lu(k,2156) - lu(k,2166) = lu(k,2166) * lu(k,2156) - lu(k,2167) = lu(k,2167) * lu(k,2156) - lu(k,2168) = lu(k,2168) * lu(k,2156) - lu(k,2169) = lu(k,2169) * lu(k,2156) - lu(k,2170) = lu(k,2170) * lu(k,2156) - lu(k,2171) = lu(k,2171) * lu(k,2156) - lu(k,2172) = lu(k,2172) * lu(k,2156) - lu(k,2173) = lu(k,2173) * lu(k,2156) - lu(k,2174) = lu(k,2174) * lu(k,2156) - lu(k,2519) = lu(k,2519) - lu(k,2157) * lu(k,2518) - lu(k,2520) = lu(k,2520) - lu(k,2158) * lu(k,2518) - lu(k,2528) = lu(k,2528) - lu(k,2159) * lu(k,2518) - lu(k,2529) = lu(k,2529) - lu(k,2160) * lu(k,2518) - lu(k,2530) = lu(k,2530) - lu(k,2161) * lu(k,2518) - lu(k,2531) = lu(k,2531) - lu(k,2162) * lu(k,2518) - lu(k,2532) = lu(k,2532) - lu(k,2163) * lu(k,2518) - lu(k,2533) = lu(k,2533) - lu(k,2164) * lu(k,2518) - lu(k,2534) = lu(k,2534) - lu(k,2165) * lu(k,2518) - lu(k,2535) = lu(k,2535) - lu(k,2166) * lu(k,2518) - lu(k,2536) = lu(k,2536) - lu(k,2167) * lu(k,2518) - lu(k,2538) = lu(k,2538) - lu(k,2168) * lu(k,2518) - lu(k,2540) = lu(k,2540) - lu(k,2169) * lu(k,2518) - lu(k,2541) = lu(k,2541) - lu(k,2170) * lu(k,2518) - lu(k,2542) = lu(k,2542) - lu(k,2171) * lu(k,2518) - lu(k,2543) = lu(k,2543) - lu(k,2172) * lu(k,2518) - lu(k,2545) = lu(k,2545) - lu(k,2173) * lu(k,2518) - lu(k,2546) = lu(k,2546) - lu(k,2174) * lu(k,2518) - lu(k,2565) = lu(k,2565) - lu(k,2157) * lu(k,2564) - lu(k,2566) = lu(k,2566) - lu(k,2158) * lu(k,2564) - lu(k,2574) = lu(k,2574) - lu(k,2159) * lu(k,2564) - lu(k,2575) = lu(k,2575) - lu(k,2160) * lu(k,2564) - lu(k,2576) = lu(k,2576) - lu(k,2161) * lu(k,2564) - lu(k,2577) = lu(k,2577) - lu(k,2162) * lu(k,2564) - lu(k,2578) = lu(k,2578) - lu(k,2163) * lu(k,2564) - lu(k,2579) = lu(k,2579) - lu(k,2164) * lu(k,2564) - lu(k,2580) = lu(k,2580) - lu(k,2165) * lu(k,2564) - lu(k,2581) = lu(k,2581) - lu(k,2166) * lu(k,2564) - lu(k,2582) = lu(k,2582) - lu(k,2167) * lu(k,2564) - lu(k,2584) = lu(k,2584) - lu(k,2168) * lu(k,2564) - lu(k,2586) = lu(k,2586) - lu(k,2169) * lu(k,2564) - lu(k,2587) = lu(k,2587) - lu(k,2170) * lu(k,2564) - lu(k,2588) = lu(k,2588) - lu(k,2171) * lu(k,2564) - lu(k,2589) = lu(k,2589) - lu(k,2172) * lu(k,2564) - lu(k,2591) = lu(k,2591) - lu(k,2173) * lu(k,2564) - lu(k,2592) = lu(k,2592) - lu(k,2174) * lu(k,2564) - lu(k,2612) = lu(k,2612) - lu(k,2157) * lu(k,2611) - lu(k,2613) = lu(k,2613) - lu(k,2158) * lu(k,2611) - lu(k,2621) = lu(k,2621) - lu(k,2159) * lu(k,2611) - lu(k,2622) = lu(k,2622) - lu(k,2160) * lu(k,2611) - lu(k,2623) = lu(k,2623) - lu(k,2161) * lu(k,2611) - lu(k,2624) = lu(k,2624) - lu(k,2162) * lu(k,2611) - lu(k,2625) = lu(k,2625) - lu(k,2163) * lu(k,2611) - lu(k,2626) = lu(k,2626) - lu(k,2164) * lu(k,2611) - lu(k,2627) = lu(k,2627) - lu(k,2165) * lu(k,2611) - lu(k,2628) = lu(k,2628) - lu(k,2166) * lu(k,2611) - lu(k,2629) = lu(k,2629) - lu(k,2167) * lu(k,2611) - lu(k,2631) = lu(k,2631) - lu(k,2168) * lu(k,2611) - lu(k,2633) = lu(k,2633) - lu(k,2169) * lu(k,2611) - lu(k,2634) = lu(k,2634) - lu(k,2170) * lu(k,2611) - lu(k,2635) = lu(k,2635) - lu(k,2171) * lu(k,2611) - lu(k,2636) = lu(k,2636) - lu(k,2172) * lu(k,2611) - lu(k,2638) = lu(k,2638) - lu(k,2173) * lu(k,2611) - lu(k,2639) = lu(k,2639) - lu(k,2174) * lu(k,2611) - lu(k,2683) = lu(k,2683) - lu(k,2157) * lu(k,2682) - lu(k,2684) = lu(k,2684) - lu(k,2158) * lu(k,2682) - lu(k,2692) = lu(k,2692) - lu(k,2159) * lu(k,2682) - lu(k,2693) = lu(k,2693) - lu(k,2160) * lu(k,2682) - lu(k,2694) = lu(k,2694) - lu(k,2161) * lu(k,2682) - lu(k,2695) = lu(k,2695) - lu(k,2162) * lu(k,2682) - lu(k,2696) = lu(k,2696) - lu(k,2163) * lu(k,2682) - lu(k,2697) = lu(k,2697) - lu(k,2164) * lu(k,2682) - lu(k,2698) = lu(k,2698) - lu(k,2165) * lu(k,2682) - lu(k,2699) = lu(k,2699) - lu(k,2166) * lu(k,2682) - lu(k,2700) = lu(k,2700) - lu(k,2167) * lu(k,2682) - lu(k,2702) = lu(k,2702) - lu(k,2168) * lu(k,2682) - lu(k,2704) = lu(k,2704) - lu(k,2169) * lu(k,2682) - lu(k,2705) = lu(k,2705) - lu(k,2170) * lu(k,2682) - lu(k,2706) = lu(k,2706) - lu(k,2171) * lu(k,2682) - lu(k,2707) = lu(k,2707) - lu(k,2172) * lu(k,2682) - lu(k,2709) = lu(k,2709) - lu(k,2173) * lu(k,2682) - lu(k,2710) = lu(k,2710) - lu(k,2174) * lu(k,2682) - lu(k,2866) = lu(k,2866) - lu(k,2157) * lu(k,2865) - lu(k,2867) = lu(k,2867) - lu(k,2158) * lu(k,2865) - lu(k,2875) = lu(k,2875) - lu(k,2159) * lu(k,2865) - lu(k,2876) = lu(k,2876) - lu(k,2160) * lu(k,2865) - lu(k,2877) = lu(k,2877) - lu(k,2161) * lu(k,2865) - lu(k,2878) = lu(k,2878) - lu(k,2162) * lu(k,2865) - lu(k,2879) = lu(k,2879) - lu(k,2163) * lu(k,2865) - lu(k,2880) = lu(k,2880) - lu(k,2164) * lu(k,2865) - lu(k,2881) = lu(k,2881) - lu(k,2165) * lu(k,2865) - lu(k,2882) = lu(k,2882) - lu(k,2166) * lu(k,2865) - lu(k,2883) = lu(k,2883) - lu(k,2167) * lu(k,2865) - lu(k,2885) = lu(k,2885) - lu(k,2168) * lu(k,2865) - lu(k,2887) = lu(k,2887) - lu(k,2169) * lu(k,2865) - lu(k,2889) = lu(k,2889) - lu(k,2170) * lu(k,2865) - lu(k,2891) = lu(k,2891) - lu(k,2171) * lu(k,2865) - lu(k,2892) = lu(k,2892) - lu(k,2172) * lu(k,2865) - lu(k,2894) = lu(k,2894) - lu(k,2173) * lu(k,2865) - lu(k,2895) = lu(k,2895) - lu(k,2174) * lu(k,2865) - lu(k,2967) = lu(k,2967) - lu(k,2157) * lu(k,2966) - lu(k,2968) = lu(k,2968) - lu(k,2158) * lu(k,2966) - lu(k,2976) = lu(k,2976) - lu(k,2159) * lu(k,2966) - lu(k,2977) = lu(k,2977) - lu(k,2160) * lu(k,2966) - lu(k,2978) = lu(k,2978) - lu(k,2161) * lu(k,2966) - lu(k,2979) = lu(k,2979) - lu(k,2162) * lu(k,2966) - lu(k,2980) = lu(k,2980) - lu(k,2163) * lu(k,2966) - lu(k,2981) = lu(k,2981) - lu(k,2164) * lu(k,2966) - lu(k,2982) = lu(k,2982) - lu(k,2165) * lu(k,2966) - lu(k,2983) = lu(k,2983) - lu(k,2166) * lu(k,2966) - lu(k,2984) = lu(k,2984) - lu(k,2167) * lu(k,2966) - lu(k,2986) = lu(k,2986) - lu(k,2168) * lu(k,2966) - lu(k,2988) = lu(k,2988) - lu(k,2169) * lu(k,2966) - lu(k,2990) = lu(k,2990) - lu(k,2170) * lu(k,2966) - lu(k,2992) = lu(k,2992) - lu(k,2171) * lu(k,2966) - lu(k,2993) = lu(k,2993) - lu(k,2172) * lu(k,2966) - lu(k,2995) = lu(k,2995) - lu(k,2173) * lu(k,2966) - lu(k,2996) = lu(k,2996) - lu(k,2174) * lu(k,2966) - lu(k,3059) = lu(k,3059) - lu(k,2157) * lu(k,3058) - lu(k,3060) = lu(k,3060) - lu(k,2158) * lu(k,3058) - lu(k,3068) = lu(k,3068) - lu(k,2159) * lu(k,3058) - lu(k,3069) = lu(k,3069) - lu(k,2160) * lu(k,3058) - lu(k,3070) = lu(k,3070) - lu(k,2161) * lu(k,3058) - lu(k,3071) = lu(k,3071) - lu(k,2162) * lu(k,3058) - lu(k,3072) = lu(k,3072) - lu(k,2163) * lu(k,3058) - lu(k,3073) = lu(k,3073) - lu(k,2164) * lu(k,3058) - lu(k,3074) = lu(k,3074) - lu(k,2165) * lu(k,3058) - lu(k,3075) = lu(k,3075) - lu(k,2166) * lu(k,3058) - lu(k,3076) = lu(k,3076) - lu(k,2167) * lu(k,3058) - lu(k,3078) = lu(k,3078) - lu(k,2168) * lu(k,3058) - lu(k,3080) = lu(k,3080) - lu(k,2169) * lu(k,3058) - lu(k,3082) = lu(k,3082) - lu(k,2170) * lu(k,3058) - lu(k,3084) = lu(k,3084) - lu(k,2171) * lu(k,3058) - lu(k,3085) = lu(k,3085) - lu(k,2172) * lu(k,3058) - lu(k,3087) = lu(k,3087) - lu(k,2173) * lu(k,3058) - lu(k,3088) = lu(k,3088) - lu(k,2174) * lu(k,3058) - lu(k,3262) = lu(k,3262) - lu(k,2157) * lu(k,3261) - lu(k,3263) = lu(k,3263) - lu(k,2158) * lu(k,3261) - lu(k,3271) = lu(k,3271) - lu(k,2159) * lu(k,3261) - lu(k,3272) = lu(k,3272) - lu(k,2160) * lu(k,3261) - lu(k,3273) = lu(k,3273) - lu(k,2161) * lu(k,3261) - lu(k,3274) = lu(k,3274) - lu(k,2162) * lu(k,3261) - lu(k,3275) = lu(k,3275) - lu(k,2163) * lu(k,3261) - lu(k,3276) = lu(k,3276) - lu(k,2164) * lu(k,3261) - lu(k,3277) = lu(k,3277) - lu(k,2165) * lu(k,3261) - lu(k,3278) = lu(k,3278) - lu(k,2166) * lu(k,3261) - lu(k,3279) = lu(k,3279) - lu(k,2167) * lu(k,3261) - lu(k,3281) = lu(k,3281) - lu(k,2168) * lu(k,3261) - lu(k,3283) = lu(k,3283) - lu(k,2169) * lu(k,3261) - lu(k,3285) = lu(k,3285) - lu(k,2170) * lu(k,3261) - lu(k,3287) = lu(k,3287) - lu(k,2171) * lu(k,3261) - lu(k,3288) = lu(k,3288) - lu(k,2172) * lu(k,3261) - lu(k,3290) = lu(k,3290) - lu(k,2173) * lu(k,3261) - lu(k,3291) = lu(k,3291) - lu(k,2174) * lu(k,3261) - lu(k,3403) = lu(k,3403) - lu(k,2157) * lu(k,3402) - lu(k,3404) = lu(k,3404) - lu(k,2158) * lu(k,3402) - lu(k,3412) = lu(k,3412) - lu(k,2159) * lu(k,3402) - lu(k,3413) = lu(k,3413) - lu(k,2160) * lu(k,3402) - lu(k,3414) = lu(k,3414) - lu(k,2161) * lu(k,3402) - lu(k,3415) = lu(k,3415) - lu(k,2162) * lu(k,3402) - lu(k,3416) = lu(k,3416) - lu(k,2163) * lu(k,3402) - lu(k,3417) = lu(k,3417) - lu(k,2164) * lu(k,3402) - lu(k,3418) = lu(k,3418) - lu(k,2165) * lu(k,3402) - lu(k,3419) = lu(k,3419) - lu(k,2166) * lu(k,3402) - lu(k,3420) = lu(k,3420) - lu(k,2167) * lu(k,3402) - lu(k,3422) = lu(k,3422) - lu(k,2168) * lu(k,3402) - lu(k,3424) = lu(k,3424) - lu(k,2169) * lu(k,3402) - lu(k,3426) = lu(k,3426) - lu(k,2170) * lu(k,3402) - lu(k,3428) = lu(k,3428) - lu(k,2171) * lu(k,3402) - lu(k,3429) = lu(k,3429) - lu(k,2172) * lu(k,3402) - lu(k,3431) = lu(k,3431) - lu(k,2173) * lu(k,3402) - lu(k,3432) = lu(k,3432) - lu(k,2174) * lu(k,3402) - lu(k,3723) = lu(k,3723) - lu(k,2157) * lu(k,3722) - lu(k,3724) = lu(k,3724) - lu(k,2158) * lu(k,3722) - lu(k,3732) = lu(k,3732) - lu(k,2159) * lu(k,3722) - lu(k,3733) = lu(k,3733) - lu(k,2160) * lu(k,3722) - lu(k,3734) = lu(k,3734) - lu(k,2161) * lu(k,3722) - lu(k,3735) = lu(k,3735) - lu(k,2162) * lu(k,3722) - lu(k,3736) = lu(k,3736) - lu(k,2163) * lu(k,3722) - lu(k,3737) = lu(k,3737) - lu(k,2164) * lu(k,3722) - lu(k,3738) = lu(k,3738) - lu(k,2165) * lu(k,3722) - lu(k,3739) = lu(k,3739) - lu(k,2166) * lu(k,3722) - lu(k,3740) = lu(k,3740) - lu(k,2167) * lu(k,3722) - lu(k,3742) = lu(k,3742) - lu(k,2168) * lu(k,3722) - lu(k,3744) = lu(k,3744) - lu(k,2169) * lu(k,3722) - lu(k,3746) = lu(k,3746) - lu(k,2170) * lu(k,3722) - lu(k,3748) = lu(k,3748) - lu(k,2171) * lu(k,3722) - lu(k,3749) = lu(k,3749) - lu(k,2172) * lu(k,3722) - lu(k,3751) = lu(k,3751) - lu(k,2173) * lu(k,3722) - lu(k,3752) = lu(k,3752) - lu(k,2174) * lu(k,3722) - lu(k,2179) = 1._r8 / lu(k,2179) - lu(k,2180) = lu(k,2180) * lu(k,2179) - lu(k,2181) = lu(k,2181) * lu(k,2179) - lu(k,2182) = lu(k,2182) * lu(k,2179) - lu(k,2183) = lu(k,2183) * lu(k,2179) - lu(k,2184) = lu(k,2184) * lu(k,2179) - lu(k,2185) = lu(k,2185) * lu(k,2179) - lu(k,2186) = lu(k,2186) * lu(k,2179) - lu(k,2187) = lu(k,2187) * lu(k,2179) - lu(k,2188) = lu(k,2188) * lu(k,2179) - lu(k,2189) = lu(k,2189) * lu(k,2179) - lu(k,2190) = lu(k,2190) * lu(k,2179) - lu(k,2191) = lu(k,2191) * lu(k,2179) - lu(k,2213) = lu(k,2213) - lu(k,2180) * lu(k,2212) - lu(k,2215) = lu(k,2215) - lu(k,2181) * lu(k,2212) - lu(k,2217) = lu(k,2217) - lu(k,2182) * lu(k,2212) - lu(k,2220) = lu(k,2220) - lu(k,2183) * lu(k,2212) - lu(k,2223) = lu(k,2223) - lu(k,2184) * lu(k,2212) - lu(k,2224) = lu(k,2224) - lu(k,2185) * lu(k,2212) - lu(k,2225) = lu(k,2225) - lu(k,2186) * lu(k,2212) - lu(k,2226) = lu(k,2226) - lu(k,2187) * lu(k,2212) - lu(k,2227) = lu(k,2227) - lu(k,2188) * lu(k,2212) - lu(k,2228) = lu(k,2228) - lu(k,2189) * lu(k,2212) - lu(k,2230) = lu(k,2230) - lu(k,2190) * lu(k,2212) - lu(k,2231) = lu(k,2231) - lu(k,2191) * lu(k,2212) - lu(k,2242) = lu(k,2242) - lu(k,2180) * lu(k,2241) - lu(k,2244) = lu(k,2244) - lu(k,2181) * lu(k,2241) - lu(k,2246) = lu(k,2246) - lu(k,2182) * lu(k,2241) - lu(k,2249) = lu(k,2249) - lu(k,2183) * lu(k,2241) - lu(k,2252) = lu(k,2252) - lu(k,2184) * lu(k,2241) - lu(k,2253) = lu(k,2253) - lu(k,2185) * lu(k,2241) - lu(k,2254) = lu(k,2254) - lu(k,2186) * lu(k,2241) - lu(k,2255) = lu(k,2255) - lu(k,2187) * lu(k,2241) - lu(k,2256) = lu(k,2256) - lu(k,2188) * lu(k,2241) - lu(k,2257) = lu(k,2257) - lu(k,2189) * lu(k,2241) - lu(k,2259) = lu(k,2259) - lu(k,2190) * lu(k,2241) - lu(k,2260) = lu(k,2260) - lu(k,2191) * lu(k,2241) - lu(k,2270) = lu(k,2270) - lu(k,2180) * lu(k,2269) - lu(k,2273) = lu(k,2273) - lu(k,2181) * lu(k,2269) - lu(k,2275) = lu(k,2275) - lu(k,2182) * lu(k,2269) - lu(k,2278) = lu(k,2278) - lu(k,2183) * lu(k,2269) - lu(k,2281) = lu(k,2281) - lu(k,2184) * lu(k,2269) - lu(k,2282) = lu(k,2282) - lu(k,2185) * lu(k,2269) - lu(k,2283) = lu(k,2283) - lu(k,2186) * lu(k,2269) - lu(k,2284) = lu(k,2284) - lu(k,2187) * lu(k,2269) - lu(k,2285) = lu(k,2285) - lu(k,2188) * lu(k,2269) - lu(k,2286) = lu(k,2286) - lu(k,2189) * lu(k,2269) - lu(k,2288) = lu(k,2288) - lu(k,2190) * lu(k,2269) - lu(k,2289) = lu(k,2289) - lu(k,2191) * lu(k,2269) - lu(k,2391) = lu(k,2391) - lu(k,2180) * lu(k,2390) - lu(k,2393) = lu(k,2393) - lu(k,2181) * lu(k,2390) - lu(k,2395) = - lu(k,2182) * lu(k,2390) - lu(k,2397) = - lu(k,2183) * lu(k,2390) - lu(k,2399) = lu(k,2399) - lu(k,2184) * lu(k,2390) - lu(k,2400) = - lu(k,2185) * lu(k,2390) - lu(k,2401) = lu(k,2401) - lu(k,2186) * lu(k,2390) - lu(k,2403) = lu(k,2403) - lu(k,2187) * lu(k,2390) - lu(k,2404) = lu(k,2404) - lu(k,2188) * lu(k,2390) - lu(k,2405) = lu(k,2405) - lu(k,2189) * lu(k,2390) - lu(k,2407) = lu(k,2407) - lu(k,2190) * lu(k,2390) - lu(k,2408) = lu(k,2408) - lu(k,2191) * lu(k,2390) - lu(k,2520) = lu(k,2520) - lu(k,2180) * lu(k,2519) - lu(k,2528) = lu(k,2528) - lu(k,2181) * lu(k,2519) - lu(k,2530) = lu(k,2530) - lu(k,2182) * lu(k,2519) - lu(k,2533) = lu(k,2533) - lu(k,2183) * lu(k,2519) - lu(k,2536) = lu(k,2536) - lu(k,2184) * lu(k,2519) - lu(k,2537) = lu(k,2537) - lu(k,2185) * lu(k,2519) - lu(k,2538) = lu(k,2538) - lu(k,2186) * lu(k,2519) - lu(k,2540) = lu(k,2540) - lu(k,2187) * lu(k,2519) - lu(k,2541) = lu(k,2541) - lu(k,2188) * lu(k,2519) - lu(k,2542) = lu(k,2542) - lu(k,2189) * lu(k,2519) - lu(k,2545) = lu(k,2545) - lu(k,2190) * lu(k,2519) - lu(k,2546) = lu(k,2546) - lu(k,2191) * lu(k,2519) - lu(k,2566) = lu(k,2566) - lu(k,2180) * lu(k,2565) - lu(k,2574) = lu(k,2574) - lu(k,2181) * lu(k,2565) - lu(k,2576) = lu(k,2576) - lu(k,2182) * lu(k,2565) - lu(k,2579) = lu(k,2579) - lu(k,2183) * lu(k,2565) - lu(k,2582) = lu(k,2582) - lu(k,2184) * lu(k,2565) - lu(k,2583) = lu(k,2583) - lu(k,2185) * lu(k,2565) - lu(k,2584) = lu(k,2584) - lu(k,2186) * lu(k,2565) - lu(k,2586) = lu(k,2586) - lu(k,2187) * lu(k,2565) - lu(k,2587) = lu(k,2587) - lu(k,2188) * lu(k,2565) - lu(k,2588) = lu(k,2588) - lu(k,2189) * lu(k,2565) - lu(k,2591) = lu(k,2591) - lu(k,2190) * lu(k,2565) - lu(k,2592) = lu(k,2592) - lu(k,2191) * lu(k,2565) - lu(k,2613) = lu(k,2613) - lu(k,2180) * lu(k,2612) - lu(k,2621) = lu(k,2621) - lu(k,2181) * lu(k,2612) - lu(k,2623) = lu(k,2623) - lu(k,2182) * lu(k,2612) - lu(k,2626) = lu(k,2626) - lu(k,2183) * lu(k,2612) - lu(k,2629) = lu(k,2629) - lu(k,2184) * lu(k,2612) - lu(k,2630) = lu(k,2630) - lu(k,2185) * lu(k,2612) - lu(k,2631) = lu(k,2631) - lu(k,2186) * lu(k,2612) - lu(k,2633) = lu(k,2633) - lu(k,2187) * lu(k,2612) - lu(k,2634) = lu(k,2634) - lu(k,2188) * lu(k,2612) - lu(k,2635) = lu(k,2635) - lu(k,2189) * lu(k,2612) - lu(k,2638) = lu(k,2638) - lu(k,2190) * lu(k,2612) - lu(k,2639) = lu(k,2639) - lu(k,2191) * lu(k,2612) - lu(k,2684) = lu(k,2684) - lu(k,2180) * lu(k,2683) - lu(k,2692) = lu(k,2692) - lu(k,2181) * lu(k,2683) - lu(k,2694) = lu(k,2694) - lu(k,2182) * lu(k,2683) - lu(k,2697) = lu(k,2697) - lu(k,2183) * lu(k,2683) - lu(k,2700) = lu(k,2700) - lu(k,2184) * lu(k,2683) - lu(k,2701) = lu(k,2701) - lu(k,2185) * lu(k,2683) - lu(k,2702) = lu(k,2702) - lu(k,2186) * lu(k,2683) - lu(k,2704) = lu(k,2704) - lu(k,2187) * lu(k,2683) - lu(k,2705) = lu(k,2705) - lu(k,2188) * lu(k,2683) - lu(k,2706) = lu(k,2706) - lu(k,2189) * lu(k,2683) - lu(k,2709) = lu(k,2709) - lu(k,2190) * lu(k,2683) - lu(k,2710) = lu(k,2710) - lu(k,2191) * lu(k,2683) - lu(k,2867) = lu(k,2867) - lu(k,2180) * lu(k,2866) - lu(k,2875) = lu(k,2875) - lu(k,2181) * lu(k,2866) - lu(k,2877) = lu(k,2877) - lu(k,2182) * lu(k,2866) - lu(k,2880) = lu(k,2880) - lu(k,2183) * lu(k,2866) - lu(k,2883) = lu(k,2883) - lu(k,2184) * lu(k,2866) - lu(k,2884) = lu(k,2884) - lu(k,2185) * lu(k,2866) - lu(k,2885) = lu(k,2885) - lu(k,2186) * lu(k,2866) - lu(k,2887) = lu(k,2887) - lu(k,2187) * lu(k,2866) - lu(k,2889) = lu(k,2889) - lu(k,2188) * lu(k,2866) - lu(k,2891) = lu(k,2891) - lu(k,2189) * lu(k,2866) - lu(k,2894) = lu(k,2894) - lu(k,2190) * lu(k,2866) - lu(k,2895) = lu(k,2895) - lu(k,2191) * lu(k,2866) - lu(k,2968) = lu(k,2968) - lu(k,2180) * lu(k,2967) - lu(k,2976) = lu(k,2976) - lu(k,2181) * lu(k,2967) - lu(k,2978) = lu(k,2978) - lu(k,2182) * lu(k,2967) - lu(k,2981) = lu(k,2981) - lu(k,2183) * lu(k,2967) - lu(k,2984) = lu(k,2984) - lu(k,2184) * lu(k,2967) - lu(k,2985) = lu(k,2985) - lu(k,2185) * lu(k,2967) - lu(k,2986) = lu(k,2986) - lu(k,2186) * lu(k,2967) - lu(k,2988) = lu(k,2988) - lu(k,2187) * lu(k,2967) - lu(k,2990) = lu(k,2990) - lu(k,2188) * lu(k,2967) - lu(k,2992) = lu(k,2992) - lu(k,2189) * lu(k,2967) - lu(k,2995) = lu(k,2995) - lu(k,2190) * lu(k,2967) - lu(k,2996) = lu(k,2996) - lu(k,2191) * lu(k,2967) - lu(k,3060) = lu(k,3060) - lu(k,2180) * lu(k,3059) - lu(k,3068) = lu(k,3068) - lu(k,2181) * lu(k,3059) - lu(k,3070) = lu(k,3070) - lu(k,2182) * lu(k,3059) - lu(k,3073) = lu(k,3073) - lu(k,2183) * lu(k,3059) - lu(k,3076) = lu(k,3076) - lu(k,2184) * lu(k,3059) - lu(k,3077) = lu(k,3077) - lu(k,2185) * lu(k,3059) - lu(k,3078) = lu(k,3078) - lu(k,2186) * lu(k,3059) - lu(k,3080) = lu(k,3080) - lu(k,2187) * lu(k,3059) - lu(k,3082) = lu(k,3082) - lu(k,2188) * lu(k,3059) - lu(k,3084) = lu(k,3084) - lu(k,2189) * lu(k,3059) - lu(k,3087) = lu(k,3087) - lu(k,2190) * lu(k,3059) - lu(k,3088) = lu(k,3088) - lu(k,2191) * lu(k,3059) - lu(k,3263) = lu(k,3263) - lu(k,2180) * lu(k,3262) - lu(k,3271) = lu(k,3271) - lu(k,2181) * lu(k,3262) - lu(k,3273) = lu(k,3273) - lu(k,2182) * lu(k,3262) - lu(k,3276) = lu(k,3276) - lu(k,2183) * lu(k,3262) - lu(k,3279) = lu(k,3279) - lu(k,2184) * lu(k,3262) - lu(k,3280) = lu(k,3280) - lu(k,2185) * lu(k,3262) - lu(k,3281) = lu(k,3281) - lu(k,2186) * lu(k,3262) - lu(k,3283) = lu(k,3283) - lu(k,2187) * lu(k,3262) - lu(k,3285) = lu(k,3285) - lu(k,2188) * lu(k,3262) - lu(k,3287) = lu(k,3287) - lu(k,2189) * lu(k,3262) - lu(k,3290) = lu(k,3290) - lu(k,2190) * lu(k,3262) - lu(k,3291) = lu(k,3291) - lu(k,2191) * lu(k,3262) - lu(k,3404) = lu(k,3404) - lu(k,2180) * lu(k,3403) - lu(k,3412) = lu(k,3412) - lu(k,2181) * lu(k,3403) - lu(k,3414) = lu(k,3414) - lu(k,2182) * lu(k,3403) - lu(k,3417) = lu(k,3417) - lu(k,2183) * lu(k,3403) - lu(k,3420) = lu(k,3420) - lu(k,2184) * lu(k,3403) - lu(k,3421) = lu(k,3421) - lu(k,2185) * lu(k,3403) - lu(k,3422) = lu(k,3422) - lu(k,2186) * lu(k,3403) - lu(k,3424) = lu(k,3424) - lu(k,2187) * lu(k,3403) - lu(k,3426) = lu(k,3426) - lu(k,2188) * lu(k,3403) - lu(k,3428) = lu(k,3428) - lu(k,2189) * lu(k,3403) - lu(k,3431) = lu(k,3431) - lu(k,2190) * lu(k,3403) - lu(k,3432) = lu(k,3432) - lu(k,2191) * lu(k,3403) - lu(k,3724) = lu(k,3724) - lu(k,2180) * lu(k,3723) - lu(k,3732) = lu(k,3732) - lu(k,2181) * lu(k,3723) - lu(k,3734) = lu(k,3734) - lu(k,2182) * lu(k,3723) - lu(k,3737) = lu(k,3737) - lu(k,2183) * lu(k,3723) - lu(k,3740) = lu(k,3740) - lu(k,2184) * lu(k,3723) - lu(k,3741) = lu(k,3741) - lu(k,2185) * lu(k,3723) - lu(k,3742) = lu(k,3742) - lu(k,2186) * lu(k,3723) - lu(k,3744) = lu(k,3744) - lu(k,2187) * lu(k,3723) - lu(k,3746) = lu(k,3746) - lu(k,2188) * lu(k,3723) - lu(k,3748) = lu(k,3748) - lu(k,2189) * lu(k,3723) - lu(k,3751) = lu(k,3751) - lu(k,2190) * lu(k,3723) - lu(k,3752) = lu(k,3752) - lu(k,2191) * lu(k,3723) - lu(k,2193) = 1._r8 / lu(k,2193) - lu(k,2194) = lu(k,2194) * lu(k,2193) - lu(k,2195) = lu(k,2195) * lu(k,2193) - lu(k,2196) = lu(k,2196) * lu(k,2193) - lu(k,2197) = lu(k,2197) * lu(k,2193) - lu(k,2198) = lu(k,2198) * lu(k,2193) - lu(k,2199) = lu(k,2199) * lu(k,2193) - lu(k,2200) = lu(k,2200) * lu(k,2193) - lu(k,2201) = lu(k,2201) * lu(k,2193) - lu(k,2216) = lu(k,2216) - lu(k,2194) * lu(k,2213) - lu(k,2218) = lu(k,2218) - lu(k,2195) * lu(k,2213) - lu(k,2221) = lu(k,2221) - lu(k,2196) * lu(k,2213) - lu(k,2223) = lu(k,2223) - lu(k,2197) * lu(k,2213) - lu(k,2224) = lu(k,2224) - lu(k,2198) * lu(k,2213) - lu(k,2226) = lu(k,2226) - lu(k,2199) * lu(k,2213) - lu(k,2227) = lu(k,2227) - lu(k,2200) * lu(k,2213) - lu(k,2231) = lu(k,2231) - lu(k,2201) * lu(k,2213) - lu(k,2245) = lu(k,2245) - lu(k,2194) * lu(k,2242) - lu(k,2247) = lu(k,2247) - lu(k,2195) * lu(k,2242) - lu(k,2250) = lu(k,2250) - lu(k,2196) * lu(k,2242) - lu(k,2252) = lu(k,2252) - lu(k,2197) * lu(k,2242) - lu(k,2253) = lu(k,2253) - lu(k,2198) * lu(k,2242) - lu(k,2255) = lu(k,2255) - lu(k,2199) * lu(k,2242) - lu(k,2256) = lu(k,2256) - lu(k,2200) * lu(k,2242) - lu(k,2260) = lu(k,2260) - lu(k,2201) * lu(k,2242) - lu(k,2274) = lu(k,2274) - lu(k,2194) * lu(k,2270) - lu(k,2276) = lu(k,2276) - lu(k,2195) * lu(k,2270) - lu(k,2279) = lu(k,2279) - lu(k,2196) * lu(k,2270) - lu(k,2281) = lu(k,2281) - lu(k,2197) * lu(k,2270) - lu(k,2282) = lu(k,2282) - lu(k,2198) * lu(k,2270) - lu(k,2284) = lu(k,2284) - lu(k,2199) * lu(k,2270) - lu(k,2285) = lu(k,2285) - lu(k,2200) * lu(k,2270) - lu(k,2289) = lu(k,2289) - lu(k,2201) * lu(k,2270) - lu(k,2306) = lu(k,2306) - lu(k,2194) * lu(k,2302) - lu(k,2308) = lu(k,2308) - lu(k,2195) * lu(k,2302) - lu(k,2311) = lu(k,2311) - lu(k,2196) * lu(k,2302) - lu(k,2313) = lu(k,2313) - lu(k,2197) * lu(k,2302) - lu(k,2314) = - lu(k,2198) * lu(k,2302) - lu(k,2316) = lu(k,2316) - lu(k,2199) * lu(k,2302) - lu(k,2317) = lu(k,2317) - lu(k,2200) * lu(k,2302) - lu(k,2321) = lu(k,2321) - lu(k,2201) * lu(k,2302) - lu(k,2333) = lu(k,2333) - lu(k,2194) * lu(k,2331) - lu(k,2335) = lu(k,2335) - lu(k,2195) * lu(k,2331) - lu(k,2338) = lu(k,2338) - lu(k,2196) * lu(k,2331) - lu(k,2340) = lu(k,2340) - lu(k,2197) * lu(k,2331) - lu(k,2341) = lu(k,2341) - lu(k,2198) * lu(k,2331) - lu(k,2343) = lu(k,2343) - lu(k,2199) * lu(k,2331) - lu(k,2344) = lu(k,2344) - lu(k,2200) * lu(k,2331) - lu(k,2348) = lu(k,2348) - lu(k,2201) * lu(k,2331) - lu(k,2367) = lu(k,2367) - lu(k,2194) * lu(k,2362) - lu(k,2369) = lu(k,2369) - lu(k,2195) * lu(k,2362) - lu(k,2372) = lu(k,2372) - lu(k,2196) * lu(k,2362) - lu(k,2374) = lu(k,2374) - lu(k,2197) * lu(k,2362) - lu(k,2375) = lu(k,2375) - lu(k,2198) * lu(k,2362) - lu(k,2377) = lu(k,2377) - lu(k,2199) * lu(k,2362) - lu(k,2378) = lu(k,2378) - lu(k,2200) * lu(k,2362) - lu(k,2382) = lu(k,2382) - lu(k,2201) * lu(k,2362) - lu(k,2394) = - lu(k,2194) * lu(k,2391) - lu(k,2396) = - lu(k,2195) * lu(k,2391) - lu(k,2398) = - lu(k,2196) * lu(k,2391) - lu(k,2399) = lu(k,2399) - lu(k,2197) * lu(k,2391) - lu(k,2400) = lu(k,2400) - lu(k,2198) * lu(k,2391) - lu(k,2403) = lu(k,2403) - lu(k,2199) * lu(k,2391) - lu(k,2404) = lu(k,2404) - lu(k,2200) * lu(k,2391) - lu(k,2408) = lu(k,2408) - lu(k,2201) * lu(k,2391) - lu(k,2421) = - lu(k,2194) * lu(k,2419) - lu(k,2423) = - lu(k,2195) * lu(k,2419) - lu(k,2425) = - lu(k,2196) * lu(k,2419) - lu(k,2426) = lu(k,2426) - lu(k,2197) * lu(k,2419) - lu(k,2427) = lu(k,2427) - lu(k,2198) * lu(k,2419) - lu(k,2430) = lu(k,2430) - lu(k,2199) * lu(k,2419) - lu(k,2431) = lu(k,2431) - lu(k,2200) * lu(k,2419) - lu(k,2435) = lu(k,2435) - lu(k,2201) * lu(k,2419) - lu(k,2445) = lu(k,2445) - lu(k,2194) * lu(k,2444) - lu(k,2447) = lu(k,2447) - lu(k,2195) * lu(k,2444) - lu(k,2450) = lu(k,2450) - lu(k,2196) * lu(k,2444) - lu(k,2452) = lu(k,2452) - lu(k,2197) * lu(k,2444) - lu(k,2453) = lu(k,2453) - lu(k,2198) * lu(k,2444) - lu(k,2455) = lu(k,2455) - lu(k,2199) * lu(k,2444) - lu(k,2456) = lu(k,2456) - lu(k,2200) * lu(k,2444) - lu(k,2460) = lu(k,2460) - lu(k,2201) * lu(k,2444) - lu(k,2466) = lu(k,2466) - lu(k,2194) * lu(k,2465) - lu(k,2468) = lu(k,2468) - lu(k,2195) * lu(k,2465) - lu(k,2471) = lu(k,2471) - lu(k,2196) * lu(k,2465) - lu(k,2473) = lu(k,2473) - lu(k,2197) * lu(k,2465) - lu(k,2474) = lu(k,2474) - lu(k,2198) * lu(k,2465) - lu(k,2476) = lu(k,2476) - lu(k,2199) * lu(k,2465) - lu(k,2477) = lu(k,2477) - lu(k,2200) * lu(k,2465) - lu(k,2481) = lu(k,2481) - lu(k,2201) * lu(k,2465) - lu(k,2487) = lu(k,2487) - lu(k,2194) * lu(k,2486) - lu(k,2489) = lu(k,2489) - lu(k,2195) * lu(k,2486) - lu(k,2492) = lu(k,2492) - lu(k,2196) * lu(k,2486) - lu(k,2494) = lu(k,2494) - lu(k,2197) * lu(k,2486) - lu(k,2495) = lu(k,2495) - lu(k,2198) * lu(k,2486) - lu(k,2497) = lu(k,2497) - lu(k,2199) * lu(k,2486) - lu(k,2498) = lu(k,2498) - lu(k,2200) * lu(k,2486) - lu(k,2502) = lu(k,2502) - lu(k,2201) * lu(k,2486) - lu(k,2529) = lu(k,2529) - lu(k,2194) * lu(k,2520) - lu(k,2531) = lu(k,2531) - lu(k,2195) * lu(k,2520) - lu(k,2534) = lu(k,2534) - lu(k,2196) * lu(k,2520) - lu(k,2536) = lu(k,2536) - lu(k,2197) * lu(k,2520) - lu(k,2537) = lu(k,2537) - lu(k,2198) * lu(k,2520) - lu(k,2540) = lu(k,2540) - lu(k,2199) * lu(k,2520) - lu(k,2541) = lu(k,2541) - lu(k,2200) * lu(k,2520) - lu(k,2546) = lu(k,2546) - lu(k,2201) * lu(k,2520) - lu(k,2575) = lu(k,2575) - lu(k,2194) * lu(k,2566) - lu(k,2577) = lu(k,2577) - lu(k,2195) * lu(k,2566) - lu(k,2580) = lu(k,2580) - lu(k,2196) * lu(k,2566) - lu(k,2582) = lu(k,2582) - lu(k,2197) * lu(k,2566) - lu(k,2583) = lu(k,2583) - lu(k,2198) * lu(k,2566) - lu(k,2586) = lu(k,2586) - lu(k,2199) * lu(k,2566) - lu(k,2587) = lu(k,2587) - lu(k,2200) * lu(k,2566) - lu(k,2592) = lu(k,2592) - lu(k,2201) * lu(k,2566) - lu(k,2622) = lu(k,2622) - lu(k,2194) * lu(k,2613) - lu(k,2624) = lu(k,2624) - lu(k,2195) * lu(k,2613) - lu(k,2627) = lu(k,2627) - lu(k,2196) * lu(k,2613) - lu(k,2629) = lu(k,2629) - lu(k,2197) * lu(k,2613) - lu(k,2630) = lu(k,2630) - lu(k,2198) * lu(k,2613) - lu(k,2633) = lu(k,2633) - lu(k,2199) * lu(k,2613) - lu(k,2634) = lu(k,2634) - lu(k,2200) * lu(k,2613) - lu(k,2639) = lu(k,2639) - lu(k,2201) * lu(k,2613) - lu(k,2693) = lu(k,2693) - lu(k,2194) * lu(k,2684) - lu(k,2695) = lu(k,2695) - lu(k,2195) * lu(k,2684) - lu(k,2698) = lu(k,2698) - lu(k,2196) * lu(k,2684) - lu(k,2700) = lu(k,2700) - lu(k,2197) * lu(k,2684) - lu(k,2701) = lu(k,2701) - lu(k,2198) * lu(k,2684) - lu(k,2704) = lu(k,2704) - lu(k,2199) * lu(k,2684) - lu(k,2705) = lu(k,2705) - lu(k,2200) * lu(k,2684) - lu(k,2710) = lu(k,2710) - lu(k,2201) * lu(k,2684) - lu(k,2876) = lu(k,2876) - lu(k,2194) * lu(k,2867) - lu(k,2878) = lu(k,2878) - lu(k,2195) * lu(k,2867) - lu(k,2881) = lu(k,2881) - lu(k,2196) * lu(k,2867) - lu(k,2883) = lu(k,2883) - lu(k,2197) * lu(k,2867) - lu(k,2884) = lu(k,2884) - lu(k,2198) * lu(k,2867) - lu(k,2887) = lu(k,2887) - lu(k,2199) * lu(k,2867) - lu(k,2889) = lu(k,2889) - lu(k,2200) * lu(k,2867) - lu(k,2895) = lu(k,2895) - lu(k,2201) * lu(k,2867) - lu(k,2977) = lu(k,2977) - lu(k,2194) * lu(k,2968) - lu(k,2979) = lu(k,2979) - lu(k,2195) * lu(k,2968) - lu(k,2982) = lu(k,2982) - lu(k,2196) * lu(k,2968) - lu(k,2984) = lu(k,2984) - lu(k,2197) * lu(k,2968) - lu(k,2985) = lu(k,2985) - lu(k,2198) * lu(k,2968) - lu(k,2988) = lu(k,2988) - lu(k,2199) * lu(k,2968) - lu(k,2990) = lu(k,2990) - lu(k,2200) * lu(k,2968) - lu(k,2996) = lu(k,2996) - lu(k,2201) * lu(k,2968) - lu(k,3069) = lu(k,3069) - lu(k,2194) * lu(k,3060) - lu(k,3071) = lu(k,3071) - lu(k,2195) * lu(k,3060) - lu(k,3074) = lu(k,3074) - lu(k,2196) * lu(k,3060) - lu(k,3076) = lu(k,3076) - lu(k,2197) * lu(k,3060) - lu(k,3077) = lu(k,3077) - lu(k,2198) * lu(k,3060) - lu(k,3080) = lu(k,3080) - lu(k,2199) * lu(k,3060) - lu(k,3082) = lu(k,3082) - lu(k,2200) * lu(k,3060) - lu(k,3088) = lu(k,3088) - lu(k,2201) * lu(k,3060) - lu(k,3272) = lu(k,3272) - lu(k,2194) * lu(k,3263) - lu(k,3274) = lu(k,3274) - lu(k,2195) * lu(k,3263) - lu(k,3277) = lu(k,3277) - lu(k,2196) * lu(k,3263) - lu(k,3279) = lu(k,3279) - lu(k,2197) * lu(k,3263) - lu(k,3280) = lu(k,3280) - lu(k,2198) * lu(k,3263) - lu(k,3283) = lu(k,3283) - lu(k,2199) * lu(k,3263) - lu(k,3285) = lu(k,3285) - lu(k,2200) * lu(k,3263) - lu(k,3291) = lu(k,3291) - lu(k,2201) * lu(k,3263) - lu(k,3413) = lu(k,3413) - lu(k,2194) * lu(k,3404) - lu(k,3415) = lu(k,3415) - lu(k,2195) * lu(k,3404) - lu(k,3418) = lu(k,3418) - lu(k,2196) * lu(k,3404) - lu(k,3420) = lu(k,3420) - lu(k,2197) * lu(k,3404) - lu(k,3421) = lu(k,3421) - lu(k,2198) * lu(k,3404) - lu(k,3424) = lu(k,3424) - lu(k,2199) * lu(k,3404) - lu(k,3426) = lu(k,3426) - lu(k,2200) * lu(k,3404) - lu(k,3432) = lu(k,3432) - lu(k,2201) * lu(k,3404) - lu(k,3733) = lu(k,3733) - lu(k,2194) * lu(k,3724) - lu(k,3735) = lu(k,3735) - lu(k,2195) * lu(k,3724) - lu(k,3738) = lu(k,3738) - lu(k,2196) * lu(k,3724) - lu(k,3740) = lu(k,3740) - lu(k,2197) * lu(k,3724) - lu(k,3741) = lu(k,3741) - lu(k,2198) * lu(k,3724) - lu(k,3744) = lu(k,3744) - lu(k,2199) * lu(k,3724) - lu(k,3746) = lu(k,3746) - lu(k,2200) * lu(k,3724) - lu(k,3752) = lu(k,3752) - lu(k,2201) * lu(k,3724) + lu(k,2110) = 1._r8 / lu(k,2110) + lu(k,2111) = lu(k,2111) * lu(k,2110) + lu(k,2112) = lu(k,2112) * lu(k,2110) + lu(k,2113) = lu(k,2113) * lu(k,2110) + lu(k,2114) = lu(k,2114) * lu(k,2110) + lu(k,2115) = lu(k,2115) * lu(k,2110) + lu(k,2116) = lu(k,2116) * lu(k,2110) + lu(k,2117) = lu(k,2117) * lu(k,2110) + lu(k,2118) = lu(k,2118) * lu(k,2110) + lu(k,2119) = lu(k,2119) * lu(k,2110) + lu(k,2120) = lu(k,2120) * lu(k,2110) + lu(k,2121) = lu(k,2121) * lu(k,2110) + lu(k,2122) = lu(k,2122) * lu(k,2110) + lu(k,2123) = lu(k,2123) * lu(k,2110) + lu(k,2124) = lu(k,2124) * lu(k,2110) + lu(k,2179) = lu(k,2179) - lu(k,2111) * lu(k,2178) + lu(k,2183) = lu(k,2183) - lu(k,2112) * lu(k,2178) + lu(k,2184) = lu(k,2184) - lu(k,2113) * lu(k,2178) + lu(k,2185) = lu(k,2185) - lu(k,2114) * lu(k,2178) + lu(k,2186) = lu(k,2186) - lu(k,2115) * lu(k,2178) + lu(k,2187) = lu(k,2187) - lu(k,2116) * lu(k,2178) + lu(k,2188) = lu(k,2188) - lu(k,2117) * lu(k,2178) + lu(k,2189) = lu(k,2189) - lu(k,2118) * lu(k,2178) + lu(k,2190) = lu(k,2190) - lu(k,2119) * lu(k,2178) + lu(k,2191) = lu(k,2191) - lu(k,2120) * lu(k,2178) + lu(k,2192) = lu(k,2192) - lu(k,2121) * lu(k,2178) + lu(k,2193) = lu(k,2193) - lu(k,2122) * lu(k,2178) + lu(k,2195) = lu(k,2195) - lu(k,2123) * lu(k,2178) + lu(k,2196) = lu(k,2196) - lu(k,2124) * lu(k,2178) + lu(k,2996) = lu(k,2996) - lu(k,2111) * lu(k,2995) + lu(k,3023) = lu(k,3023) - lu(k,2112) * lu(k,2995) + lu(k,3024) = lu(k,3024) - lu(k,2113) * lu(k,2995) + lu(k,3025) = lu(k,3025) - lu(k,2114) * lu(k,2995) + lu(k,3026) = lu(k,3026) - lu(k,2115) * lu(k,2995) + lu(k,3027) = lu(k,3027) - lu(k,2116) * lu(k,2995) + lu(k,3028) = lu(k,3028) - lu(k,2117) * lu(k,2995) + lu(k,3029) = lu(k,3029) - lu(k,2118) * lu(k,2995) + lu(k,3030) = lu(k,3030) - lu(k,2119) * lu(k,2995) + lu(k,3031) = lu(k,3031) - lu(k,2120) * lu(k,2995) + lu(k,3032) = lu(k,3032) - lu(k,2121) * lu(k,2995) + lu(k,3033) = lu(k,3033) - lu(k,2122) * lu(k,2995) + lu(k,3035) = lu(k,3035) - lu(k,2123) * lu(k,2995) + lu(k,3036) = lu(k,3036) - lu(k,2124) * lu(k,2995) + lu(k,3097) = lu(k,3097) - lu(k,2111) * lu(k,3096) + lu(k,3126) = lu(k,3126) - lu(k,2112) * lu(k,3096) + lu(k,3127) = lu(k,3127) - lu(k,2113) * lu(k,3096) + lu(k,3128) = lu(k,3128) - lu(k,2114) * lu(k,3096) + lu(k,3129) = lu(k,3129) - lu(k,2115) * lu(k,3096) + lu(k,3130) = lu(k,3130) - lu(k,2116) * lu(k,3096) + lu(k,3131) = lu(k,3131) - lu(k,2117) * lu(k,3096) + lu(k,3132) = lu(k,3132) - lu(k,2118) * lu(k,3096) + lu(k,3133) = lu(k,3133) - lu(k,2119) * lu(k,3096) + lu(k,3134) = lu(k,3134) - lu(k,2120) * lu(k,3096) + lu(k,3135) = lu(k,3135) - lu(k,2121) * lu(k,3096) + lu(k,3136) = lu(k,3136) - lu(k,2122) * lu(k,3096) + lu(k,3138) = lu(k,3138) - lu(k,2123) * lu(k,3096) + lu(k,3139) = lu(k,3139) - lu(k,2124) * lu(k,3096) + lu(k,3278) = lu(k,3278) - lu(k,2111) * lu(k,3277) + lu(k,3308) = lu(k,3308) - lu(k,2112) * lu(k,3277) + lu(k,3309) = lu(k,3309) - lu(k,2113) * lu(k,3277) + lu(k,3310) = lu(k,3310) - lu(k,2114) * lu(k,3277) + lu(k,3311) = lu(k,3311) - lu(k,2115) * lu(k,3277) + lu(k,3312) = lu(k,3312) - lu(k,2116) * lu(k,3277) + lu(k,3313) = lu(k,3313) - lu(k,2117) * lu(k,3277) + lu(k,3314) = lu(k,3314) - lu(k,2118) * lu(k,3277) + lu(k,3315) = lu(k,3315) - lu(k,2119) * lu(k,3277) + lu(k,3316) = lu(k,3316) - lu(k,2120) * lu(k,3277) + lu(k,3317) = lu(k,3317) - lu(k,2121) * lu(k,3277) + lu(k,3318) = lu(k,3318) - lu(k,2122) * lu(k,3277) + lu(k,3320) = lu(k,3320) - lu(k,2123) * lu(k,3277) + lu(k,3321) = lu(k,3321) - lu(k,2124) * lu(k,3277) + lu(k,3534) = lu(k,3534) - lu(k,2111) * lu(k,3533) + lu(k,3564) = lu(k,3564) - lu(k,2112) * lu(k,3533) + lu(k,3565) = lu(k,3565) - lu(k,2113) * lu(k,3533) + lu(k,3566) = lu(k,3566) - lu(k,2114) * lu(k,3533) + lu(k,3567) = lu(k,3567) - lu(k,2115) * lu(k,3533) + lu(k,3568) = lu(k,3568) - lu(k,2116) * lu(k,3533) + lu(k,3569) = lu(k,3569) - lu(k,2117) * lu(k,3533) + lu(k,3570) = lu(k,3570) - lu(k,2118) * lu(k,3533) + lu(k,3571) = lu(k,3571) - lu(k,2119) * lu(k,3533) + lu(k,3572) = lu(k,3572) - lu(k,2120) * lu(k,3533) + lu(k,3573) = lu(k,3573) - lu(k,2121) * lu(k,3533) + lu(k,3574) = lu(k,3574) - lu(k,2122) * lu(k,3533) + lu(k,3576) = lu(k,3576) - lu(k,2123) * lu(k,3533) + lu(k,3577) = lu(k,3577) - lu(k,2124) * lu(k,3533) + lu(k,3785) = lu(k,3785) - lu(k,2111) * lu(k,3784) + lu(k,3814) = lu(k,3814) - lu(k,2112) * lu(k,3784) + lu(k,3815) = lu(k,3815) - lu(k,2113) * lu(k,3784) + lu(k,3816) = lu(k,3816) - lu(k,2114) * lu(k,3784) + lu(k,3817) = lu(k,3817) - lu(k,2115) * lu(k,3784) + lu(k,3818) = lu(k,3818) - lu(k,2116) * lu(k,3784) + lu(k,3819) = lu(k,3819) - lu(k,2117) * lu(k,3784) + lu(k,3820) = lu(k,3820) - lu(k,2118) * lu(k,3784) + lu(k,3821) = lu(k,3821) - lu(k,2119) * lu(k,3784) + lu(k,3822) = lu(k,3822) - lu(k,2120) * lu(k,3784) + lu(k,3823) = lu(k,3823) - lu(k,2121) * lu(k,3784) + lu(k,3824) = lu(k,3824) - lu(k,2122) * lu(k,3784) + lu(k,3826) = lu(k,3826) - lu(k,2123) * lu(k,3784) + lu(k,3827) = lu(k,3827) - lu(k,2124) * lu(k,3784) + lu(k,3919) = lu(k,3919) - lu(k,2111) * lu(k,3918) + lu(k,3949) = lu(k,3949) - lu(k,2112) * lu(k,3918) + lu(k,3950) = lu(k,3950) - lu(k,2113) * lu(k,3918) + lu(k,3951) = lu(k,3951) - lu(k,2114) * lu(k,3918) + lu(k,3952) = lu(k,3952) - lu(k,2115) * lu(k,3918) + lu(k,3953) = lu(k,3953) - lu(k,2116) * lu(k,3918) + lu(k,3954) = lu(k,3954) - lu(k,2117) * lu(k,3918) + lu(k,3955) = lu(k,3955) - lu(k,2118) * lu(k,3918) + lu(k,3956) = lu(k,3956) - lu(k,2119) * lu(k,3918) + lu(k,3957) = lu(k,3957) - lu(k,2120) * lu(k,3918) + lu(k,3958) = lu(k,3958) - lu(k,2121) * lu(k,3918) + lu(k,3959) = lu(k,3959) - lu(k,2122) * lu(k,3918) + lu(k,3961) = lu(k,3961) - lu(k,2123) * lu(k,3918) + lu(k,3962) = lu(k,3962) - lu(k,2124) * lu(k,3918) + lu(k,4013) = lu(k,4013) - lu(k,2111) * lu(k,4012) + lu(k,4041) = lu(k,4041) - lu(k,2112) * lu(k,4012) + lu(k,4042) = lu(k,4042) - lu(k,2113) * lu(k,4012) + lu(k,4043) = lu(k,4043) - lu(k,2114) * lu(k,4012) + lu(k,4044) = lu(k,4044) - lu(k,2115) * lu(k,4012) + lu(k,4045) = lu(k,4045) - lu(k,2116) * lu(k,4012) + lu(k,4046) = lu(k,4046) - lu(k,2117) * lu(k,4012) + lu(k,4047) = lu(k,4047) - lu(k,2118) * lu(k,4012) + lu(k,4048) = lu(k,4048) - lu(k,2119) * lu(k,4012) + lu(k,4049) = lu(k,4049) - lu(k,2120) * lu(k,4012) + lu(k,4050) = lu(k,4050) - lu(k,2121) * lu(k,4012) + lu(k,4051) = lu(k,4051) - lu(k,2122) * lu(k,4012) + lu(k,4053) = lu(k,4053) - lu(k,2123) * lu(k,4012) + lu(k,4054) = lu(k,4054) - lu(k,2124) * lu(k,4012) + lu(k,2140) = 1._r8 / lu(k,2140) + lu(k,2141) = lu(k,2141) * lu(k,2140) + lu(k,2142) = lu(k,2142) * lu(k,2140) + lu(k,2143) = lu(k,2143) * lu(k,2140) + lu(k,2144) = lu(k,2144) * lu(k,2140) + lu(k,2145) = lu(k,2145) * lu(k,2140) + lu(k,2146) = lu(k,2146) * lu(k,2140) + lu(k,2147) = lu(k,2147) * lu(k,2140) + lu(k,2148) = lu(k,2148) * lu(k,2140) + lu(k,2149) = lu(k,2149) * lu(k,2140) + lu(k,2150) = lu(k,2150) * lu(k,2140) + lu(k,2151) = lu(k,2151) * lu(k,2140) + lu(k,2152) = lu(k,2152) * lu(k,2140) + lu(k,2153) = lu(k,2153) * lu(k,2140) + lu(k,2183) = lu(k,2183) - lu(k,2141) * lu(k,2179) + lu(k,2184) = lu(k,2184) - lu(k,2142) * lu(k,2179) + lu(k,2185) = lu(k,2185) - lu(k,2143) * lu(k,2179) + lu(k,2186) = lu(k,2186) - lu(k,2144) * lu(k,2179) + lu(k,2187) = lu(k,2187) - lu(k,2145) * lu(k,2179) + lu(k,2188) = lu(k,2188) - lu(k,2146) * lu(k,2179) + lu(k,2189) = lu(k,2189) - lu(k,2147) * lu(k,2179) + lu(k,2190) = lu(k,2190) - lu(k,2148) * lu(k,2179) + lu(k,2191) = lu(k,2191) - lu(k,2149) * lu(k,2179) + lu(k,2192) = lu(k,2192) - lu(k,2150) * lu(k,2179) + lu(k,2193) = lu(k,2193) - lu(k,2151) * lu(k,2179) + lu(k,2195) = lu(k,2195) - lu(k,2152) * lu(k,2179) + lu(k,2196) = lu(k,2196) - lu(k,2153) * lu(k,2179) + lu(k,3023) = lu(k,3023) - lu(k,2141) * lu(k,2996) + lu(k,3024) = lu(k,3024) - lu(k,2142) * lu(k,2996) + lu(k,3025) = lu(k,3025) - lu(k,2143) * lu(k,2996) + lu(k,3026) = lu(k,3026) - lu(k,2144) * lu(k,2996) + lu(k,3027) = lu(k,3027) - lu(k,2145) * lu(k,2996) + lu(k,3028) = lu(k,3028) - lu(k,2146) * lu(k,2996) + lu(k,3029) = lu(k,3029) - lu(k,2147) * lu(k,2996) + lu(k,3030) = lu(k,3030) - lu(k,2148) * lu(k,2996) + lu(k,3031) = lu(k,3031) - lu(k,2149) * lu(k,2996) + lu(k,3032) = lu(k,3032) - lu(k,2150) * lu(k,2996) + lu(k,3033) = lu(k,3033) - lu(k,2151) * lu(k,2996) + lu(k,3035) = lu(k,3035) - lu(k,2152) * lu(k,2996) + lu(k,3036) = lu(k,3036) - lu(k,2153) * lu(k,2996) + lu(k,3126) = lu(k,3126) - lu(k,2141) * lu(k,3097) + lu(k,3127) = lu(k,3127) - lu(k,2142) * lu(k,3097) + lu(k,3128) = lu(k,3128) - lu(k,2143) * lu(k,3097) + lu(k,3129) = lu(k,3129) - lu(k,2144) * lu(k,3097) + lu(k,3130) = lu(k,3130) - lu(k,2145) * lu(k,3097) + lu(k,3131) = lu(k,3131) - lu(k,2146) * lu(k,3097) + lu(k,3132) = lu(k,3132) - lu(k,2147) * lu(k,3097) + lu(k,3133) = lu(k,3133) - lu(k,2148) * lu(k,3097) + lu(k,3134) = lu(k,3134) - lu(k,2149) * lu(k,3097) + lu(k,3135) = lu(k,3135) - lu(k,2150) * lu(k,3097) + lu(k,3136) = lu(k,3136) - lu(k,2151) * lu(k,3097) + lu(k,3138) = lu(k,3138) - lu(k,2152) * lu(k,3097) + lu(k,3139) = lu(k,3139) - lu(k,2153) * lu(k,3097) + lu(k,3308) = lu(k,3308) - lu(k,2141) * lu(k,3278) + lu(k,3309) = lu(k,3309) - lu(k,2142) * lu(k,3278) + lu(k,3310) = lu(k,3310) - lu(k,2143) * lu(k,3278) + lu(k,3311) = lu(k,3311) - lu(k,2144) * lu(k,3278) + lu(k,3312) = lu(k,3312) - lu(k,2145) * lu(k,3278) + lu(k,3313) = lu(k,3313) - lu(k,2146) * lu(k,3278) + lu(k,3314) = lu(k,3314) - lu(k,2147) * lu(k,3278) + lu(k,3315) = lu(k,3315) - lu(k,2148) * lu(k,3278) + lu(k,3316) = lu(k,3316) - lu(k,2149) * lu(k,3278) + lu(k,3317) = lu(k,3317) - lu(k,2150) * lu(k,3278) + lu(k,3318) = lu(k,3318) - lu(k,2151) * lu(k,3278) + lu(k,3320) = lu(k,3320) - lu(k,2152) * lu(k,3278) + lu(k,3321) = lu(k,3321) - lu(k,2153) * lu(k,3278) + lu(k,3564) = lu(k,3564) - lu(k,2141) * lu(k,3534) + lu(k,3565) = lu(k,3565) - lu(k,2142) * lu(k,3534) + lu(k,3566) = lu(k,3566) - lu(k,2143) * lu(k,3534) + lu(k,3567) = lu(k,3567) - lu(k,2144) * lu(k,3534) + lu(k,3568) = lu(k,3568) - lu(k,2145) * lu(k,3534) + lu(k,3569) = lu(k,3569) - lu(k,2146) * lu(k,3534) + lu(k,3570) = lu(k,3570) - lu(k,2147) * lu(k,3534) + lu(k,3571) = lu(k,3571) - lu(k,2148) * lu(k,3534) + lu(k,3572) = lu(k,3572) - lu(k,2149) * lu(k,3534) + lu(k,3573) = lu(k,3573) - lu(k,2150) * lu(k,3534) + lu(k,3574) = lu(k,3574) - lu(k,2151) * lu(k,3534) + lu(k,3576) = lu(k,3576) - lu(k,2152) * lu(k,3534) + lu(k,3577) = lu(k,3577) - lu(k,2153) * lu(k,3534) + lu(k,3814) = lu(k,3814) - lu(k,2141) * lu(k,3785) + lu(k,3815) = lu(k,3815) - lu(k,2142) * lu(k,3785) + lu(k,3816) = lu(k,3816) - lu(k,2143) * lu(k,3785) + lu(k,3817) = lu(k,3817) - lu(k,2144) * lu(k,3785) + lu(k,3818) = lu(k,3818) - lu(k,2145) * lu(k,3785) + lu(k,3819) = lu(k,3819) - lu(k,2146) * lu(k,3785) + lu(k,3820) = lu(k,3820) - lu(k,2147) * lu(k,3785) + lu(k,3821) = lu(k,3821) - lu(k,2148) * lu(k,3785) + lu(k,3822) = lu(k,3822) - lu(k,2149) * lu(k,3785) + lu(k,3823) = lu(k,3823) - lu(k,2150) * lu(k,3785) + lu(k,3824) = lu(k,3824) - lu(k,2151) * lu(k,3785) + lu(k,3826) = lu(k,3826) - lu(k,2152) * lu(k,3785) + lu(k,3827) = lu(k,3827) - lu(k,2153) * lu(k,3785) + lu(k,3949) = lu(k,3949) - lu(k,2141) * lu(k,3919) + lu(k,3950) = lu(k,3950) - lu(k,2142) * lu(k,3919) + lu(k,3951) = lu(k,3951) - lu(k,2143) * lu(k,3919) + lu(k,3952) = lu(k,3952) - lu(k,2144) * lu(k,3919) + lu(k,3953) = lu(k,3953) - lu(k,2145) * lu(k,3919) + lu(k,3954) = lu(k,3954) - lu(k,2146) * lu(k,3919) + lu(k,3955) = lu(k,3955) - lu(k,2147) * lu(k,3919) + lu(k,3956) = lu(k,3956) - lu(k,2148) * lu(k,3919) + lu(k,3957) = lu(k,3957) - lu(k,2149) * lu(k,3919) + lu(k,3958) = lu(k,3958) - lu(k,2150) * lu(k,3919) + lu(k,3959) = lu(k,3959) - lu(k,2151) * lu(k,3919) + lu(k,3961) = lu(k,3961) - lu(k,2152) * lu(k,3919) + lu(k,3962) = lu(k,3962) - lu(k,2153) * lu(k,3919) + lu(k,4041) = lu(k,4041) - lu(k,2141) * lu(k,4013) + lu(k,4042) = lu(k,4042) - lu(k,2142) * lu(k,4013) + lu(k,4043) = lu(k,4043) - lu(k,2143) * lu(k,4013) + lu(k,4044) = lu(k,4044) - lu(k,2144) * lu(k,4013) + lu(k,4045) = lu(k,4045) - lu(k,2145) * lu(k,4013) + lu(k,4046) = lu(k,4046) - lu(k,2146) * lu(k,4013) + lu(k,4047) = lu(k,4047) - lu(k,2147) * lu(k,4013) + lu(k,4048) = lu(k,4048) - lu(k,2148) * lu(k,4013) + lu(k,4049) = lu(k,4049) - lu(k,2149) * lu(k,4013) + lu(k,4050) = lu(k,4050) - lu(k,2150) * lu(k,4013) + lu(k,4051) = lu(k,4051) - lu(k,2151) * lu(k,4013) + lu(k,4053) = lu(k,4053) - lu(k,2152) * lu(k,4013) + lu(k,4054) = lu(k,4054) - lu(k,2153) * lu(k,4013) + lu(k,2180) = 1._r8 / lu(k,2180) + lu(k,2181) = lu(k,2181) * lu(k,2180) + lu(k,2182) = lu(k,2182) * lu(k,2180) + lu(k,2183) = lu(k,2183) * lu(k,2180) + lu(k,2184) = lu(k,2184) * lu(k,2180) + lu(k,2185) = lu(k,2185) * lu(k,2180) + lu(k,2186) = lu(k,2186) * lu(k,2180) + lu(k,2187) = lu(k,2187) * lu(k,2180) + lu(k,2188) = lu(k,2188) * lu(k,2180) + lu(k,2189) = lu(k,2189) * lu(k,2180) + lu(k,2190) = lu(k,2190) * lu(k,2180) + lu(k,2191) = lu(k,2191) * lu(k,2180) + lu(k,2192) = lu(k,2192) * lu(k,2180) + lu(k,2193) = lu(k,2193) * lu(k,2180) + lu(k,2194) = lu(k,2194) * lu(k,2180) + lu(k,2195) = lu(k,2195) * lu(k,2180) + lu(k,2196) = lu(k,2196) * lu(k,2180) + lu(k,3000) = lu(k,3000) - lu(k,2181) * lu(k,2997) + lu(k,3001) = lu(k,3001) - lu(k,2182) * lu(k,2997) + lu(k,3023) = lu(k,3023) - lu(k,2183) * lu(k,2997) + lu(k,3024) = lu(k,3024) - lu(k,2184) * lu(k,2997) + lu(k,3025) = lu(k,3025) - lu(k,2185) * lu(k,2997) + lu(k,3026) = lu(k,3026) - lu(k,2186) * lu(k,2997) + lu(k,3027) = lu(k,3027) - lu(k,2187) * lu(k,2997) + lu(k,3028) = lu(k,3028) - lu(k,2188) * lu(k,2997) + lu(k,3029) = lu(k,3029) - lu(k,2189) * lu(k,2997) + lu(k,3030) = lu(k,3030) - lu(k,2190) * lu(k,2997) + lu(k,3031) = lu(k,3031) - lu(k,2191) * lu(k,2997) + lu(k,3032) = lu(k,3032) - lu(k,2192) * lu(k,2997) + lu(k,3033) = lu(k,3033) - lu(k,2193) * lu(k,2997) + lu(k,3034) = lu(k,3034) - lu(k,2194) * lu(k,2997) + lu(k,3035) = lu(k,3035) - lu(k,2195) * lu(k,2997) + lu(k,3036) = lu(k,3036) - lu(k,2196) * lu(k,2997) + lu(k,3101) = lu(k,3101) - lu(k,2181) * lu(k,3098) + lu(k,3102) = lu(k,3102) - lu(k,2182) * lu(k,3098) + lu(k,3126) = lu(k,3126) - lu(k,2183) * lu(k,3098) + lu(k,3127) = lu(k,3127) - lu(k,2184) * lu(k,3098) + lu(k,3128) = lu(k,3128) - lu(k,2185) * lu(k,3098) + lu(k,3129) = lu(k,3129) - lu(k,2186) * lu(k,3098) + lu(k,3130) = lu(k,3130) - lu(k,2187) * lu(k,3098) + lu(k,3131) = lu(k,3131) - lu(k,2188) * lu(k,3098) + lu(k,3132) = lu(k,3132) - lu(k,2189) * lu(k,3098) + lu(k,3133) = lu(k,3133) - lu(k,2190) * lu(k,3098) + lu(k,3134) = lu(k,3134) - lu(k,2191) * lu(k,3098) + lu(k,3135) = lu(k,3135) - lu(k,2192) * lu(k,3098) + lu(k,3136) = lu(k,3136) - lu(k,2193) * lu(k,3098) + lu(k,3137) = lu(k,3137) - lu(k,2194) * lu(k,3098) + lu(k,3138) = lu(k,3138) - lu(k,2195) * lu(k,3098) + lu(k,3139) = lu(k,3139) - lu(k,2196) * lu(k,3098) + lu(k,3283) = lu(k,3283) - lu(k,2181) * lu(k,3279) + lu(k,3284) = lu(k,3284) - lu(k,2182) * lu(k,3279) + lu(k,3308) = lu(k,3308) - lu(k,2183) * lu(k,3279) + lu(k,3309) = lu(k,3309) - lu(k,2184) * lu(k,3279) + lu(k,3310) = lu(k,3310) - lu(k,2185) * lu(k,3279) + lu(k,3311) = lu(k,3311) - lu(k,2186) * lu(k,3279) + lu(k,3312) = lu(k,3312) - lu(k,2187) * lu(k,3279) + lu(k,3313) = lu(k,3313) - lu(k,2188) * lu(k,3279) + lu(k,3314) = lu(k,3314) - lu(k,2189) * lu(k,3279) + lu(k,3315) = lu(k,3315) - lu(k,2190) * lu(k,3279) + lu(k,3316) = lu(k,3316) - lu(k,2191) * lu(k,3279) + lu(k,3317) = lu(k,3317) - lu(k,2192) * lu(k,3279) + lu(k,3318) = lu(k,3318) - lu(k,2193) * lu(k,3279) + lu(k,3319) = lu(k,3319) - lu(k,2194) * lu(k,3279) + lu(k,3320) = lu(k,3320) - lu(k,2195) * lu(k,3279) + lu(k,3321) = lu(k,3321) - lu(k,2196) * lu(k,3279) + lu(k,3539) = lu(k,3539) - lu(k,2181) * lu(k,3535) + lu(k,3540) = lu(k,3540) - lu(k,2182) * lu(k,3535) + lu(k,3564) = lu(k,3564) - lu(k,2183) * lu(k,3535) + lu(k,3565) = lu(k,3565) - lu(k,2184) * lu(k,3535) + lu(k,3566) = lu(k,3566) - lu(k,2185) * lu(k,3535) + lu(k,3567) = lu(k,3567) - lu(k,2186) * lu(k,3535) + lu(k,3568) = lu(k,3568) - lu(k,2187) * lu(k,3535) + lu(k,3569) = lu(k,3569) - lu(k,2188) * lu(k,3535) + lu(k,3570) = lu(k,3570) - lu(k,2189) * lu(k,3535) + lu(k,3571) = lu(k,3571) - lu(k,2190) * lu(k,3535) + lu(k,3572) = lu(k,3572) - lu(k,2191) * lu(k,3535) + lu(k,3573) = lu(k,3573) - lu(k,2192) * lu(k,3535) + lu(k,3574) = lu(k,3574) - lu(k,2193) * lu(k,3535) + lu(k,3575) = lu(k,3575) - lu(k,2194) * lu(k,3535) + lu(k,3576) = lu(k,3576) - lu(k,2195) * lu(k,3535) + lu(k,3577) = lu(k,3577) - lu(k,2196) * lu(k,3535) + lu(k,3789) = lu(k,3789) - lu(k,2181) * lu(k,3786) + lu(k,3790) = lu(k,3790) - lu(k,2182) * lu(k,3786) + lu(k,3814) = lu(k,3814) - lu(k,2183) * lu(k,3786) + lu(k,3815) = lu(k,3815) - lu(k,2184) * lu(k,3786) + lu(k,3816) = lu(k,3816) - lu(k,2185) * lu(k,3786) + lu(k,3817) = lu(k,3817) - lu(k,2186) * lu(k,3786) + lu(k,3818) = lu(k,3818) - lu(k,2187) * lu(k,3786) + lu(k,3819) = lu(k,3819) - lu(k,2188) * lu(k,3786) + lu(k,3820) = lu(k,3820) - lu(k,2189) * lu(k,3786) + lu(k,3821) = lu(k,3821) - lu(k,2190) * lu(k,3786) + lu(k,3822) = lu(k,3822) - lu(k,2191) * lu(k,3786) + lu(k,3823) = lu(k,3823) - lu(k,2192) * lu(k,3786) + lu(k,3824) = lu(k,3824) - lu(k,2193) * lu(k,3786) + lu(k,3825) = lu(k,3825) - lu(k,2194) * lu(k,3786) + lu(k,3826) = lu(k,3826) - lu(k,2195) * lu(k,3786) + lu(k,3827) = lu(k,3827) - lu(k,2196) * lu(k,3786) + lu(k,3924) = lu(k,3924) - lu(k,2181) * lu(k,3920) + lu(k,3925) = lu(k,3925) - lu(k,2182) * lu(k,3920) + lu(k,3949) = lu(k,3949) - lu(k,2183) * lu(k,3920) + lu(k,3950) = lu(k,3950) - lu(k,2184) * lu(k,3920) + lu(k,3951) = lu(k,3951) - lu(k,2185) * lu(k,3920) + lu(k,3952) = lu(k,3952) - lu(k,2186) * lu(k,3920) + lu(k,3953) = lu(k,3953) - lu(k,2187) * lu(k,3920) + lu(k,3954) = lu(k,3954) - lu(k,2188) * lu(k,3920) + lu(k,3955) = lu(k,3955) - lu(k,2189) * lu(k,3920) + lu(k,3956) = lu(k,3956) - lu(k,2190) * lu(k,3920) + lu(k,3957) = lu(k,3957) - lu(k,2191) * lu(k,3920) + lu(k,3958) = lu(k,3958) - lu(k,2192) * lu(k,3920) + lu(k,3959) = lu(k,3959) - lu(k,2193) * lu(k,3920) + lu(k,3960) = lu(k,3960) - lu(k,2194) * lu(k,3920) + lu(k,3961) = lu(k,3961) - lu(k,2195) * lu(k,3920) + lu(k,3962) = lu(k,3962) - lu(k,2196) * lu(k,3920) + lu(k,4017) = lu(k,4017) - lu(k,2181) * lu(k,4014) + lu(k,4018) = lu(k,4018) - lu(k,2182) * lu(k,4014) + lu(k,4041) = lu(k,4041) - lu(k,2183) * lu(k,4014) + lu(k,4042) = lu(k,4042) - lu(k,2184) * lu(k,4014) + lu(k,4043) = lu(k,4043) - lu(k,2185) * lu(k,4014) + lu(k,4044) = lu(k,4044) - lu(k,2186) * lu(k,4014) + lu(k,4045) = lu(k,4045) - lu(k,2187) * lu(k,4014) + lu(k,4046) = lu(k,4046) - lu(k,2188) * lu(k,4014) + lu(k,4047) = lu(k,4047) - lu(k,2189) * lu(k,4014) + lu(k,4048) = lu(k,4048) - lu(k,2190) * lu(k,4014) + lu(k,4049) = lu(k,4049) - lu(k,2191) * lu(k,4014) + lu(k,4050) = lu(k,4050) - lu(k,2192) * lu(k,4014) + lu(k,4051) = lu(k,4051) - lu(k,2193) * lu(k,4014) + lu(k,4052) = lu(k,4052) - lu(k,2194) * lu(k,4014) + lu(k,4053) = lu(k,4053) - lu(k,2195) * lu(k,4014) + lu(k,4054) = lu(k,4054) - lu(k,2196) * lu(k,4014) + lu(k,2199) = 1._r8 / lu(k,2199) + lu(k,2200) = lu(k,2200) * lu(k,2199) + lu(k,2201) = lu(k,2201) * lu(k,2199) + lu(k,2202) = lu(k,2202) * lu(k,2199) + lu(k,2203) = lu(k,2203) * lu(k,2199) + lu(k,2204) = lu(k,2204) * lu(k,2199) + lu(k,2205) = lu(k,2205) * lu(k,2199) + lu(k,2206) = lu(k,2206) * lu(k,2199) + lu(k,2207) = lu(k,2207) * lu(k,2199) + lu(k,2208) = lu(k,2208) * lu(k,2199) + lu(k,2555) = lu(k,2555) - lu(k,2200) * lu(k,2554) + lu(k,2556) = lu(k,2556) - lu(k,2201) * lu(k,2554) + lu(k,2558) = - lu(k,2202) * lu(k,2554) + lu(k,2559) = lu(k,2559) - lu(k,2203) * lu(k,2554) + lu(k,2563) = - lu(k,2204) * lu(k,2554) + lu(k,2564) = lu(k,2564) - lu(k,2205) * lu(k,2554) + lu(k,2565) = lu(k,2565) - lu(k,2206) * lu(k,2554) + lu(k,2566) = lu(k,2566) - lu(k,2207) * lu(k,2554) + lu(k,2570) = lu(k,2570) - lu(k,2208) * lu(k,2554) + lu(k,2595) = lu(k,2595) - lu(k,2200) * lu(k,2594) + lu(k,2596) = lu(k,2596) - lu(k,2201) * lu(k,2594) + lu(k,2598) = - lu(k,2202) * lu(k,2594) + lu(k,2599) = lu(k,2599) - lu(k,2203) * lu(k,2594) + lu(k,2603) = lu(k,2603) - lu(k,2204) * lu(k,2594) + lu(k,2604) = lu(k,2604) - lu(k,2205) * lu(k,2594) + lu(k,2605) = lu(k,2605) - lu(k,2206) * lu(k,2594) + lu(k,2606) = lu(k,2606) - lu(k,2207) * lu(k,2594) + lu(k,2611) = lu(k,2611) - lu(k,2208) * lu(k,2594) + lu(k,2636) = lu(k,2636) - lu(k,2200) * lu(k,2634) + lu(k,2637) = lu(k,2637) - lu(k,2201) * lu(k,2634) + lu(k,2639) = lu(k,2639) - lu(k,2202) * lu(k,2634) + lu(k,2640) = lu(k,2640) - lu(k,2203) * lu(k,2634) + lu(k,2644) = lu(k,2644) - lu(k,2204) * lu(k,2634) + lu(k,2645) = lu(k,2645) - lu(k,2205) * lu(k,2634) + lu(k,2646) = lu(k,2646) - lu(k,2206) * lu(k,2634) + lu(k,2647) = lu(k,2647) - lu(k,2207) * lu(k,2634) + lu(k,2652) = lu(k,2652) - lu(k,2208) * lu(k,2634) + lu(k,3113) = lu(k,3113) - lu(k,2200) * lu(k,3099) + lu(k,3114) = lu(k,3114) - lu(k,2201) * lu(k,3099) + lu(k,3116) = lu(k,3116) - lu(k,2202) * lu(k,3099) + lu(k,3127) = lu(k,3127) - lu(k,2203) * lu(k,3099) + lu(k,3131) = lu(k,3131) - lu(k,2204) * lu(k,3099) + lu(k,3132) = lu(k,3132) - lu(k,2205) * lu(k,3099) + lu(k,3133) = lu(k,3133) - lu(k,2206) * lu(k,3099) + lu(k,3134) = lu(k,3134) - lu(k,2207) * lu(k,3099) + lu(k,3139) = lu(k,3139) - lu(k,2208) * lu(k,3099) + lu(k,3146) = lu(k,3146) - lu(k,2200) * lu(k,3145) + lu(k,3147) = lu(k,3147) - lu(k,2201) * lu(k,3145) + lu(k,3149) = lu(k,3149) - lu(k,2202) * lu(k,3145) + lu(k,3150) = - lu(k,2203) * lu(k,3145) + lu(k,3154) = - lu(k,2204) * lu(k,3145) + lu(k,3155) = lu(k,3155) - lu(k,2205) * lu(k,3145) + lu(k,3156) = - lu(k,2206) * lu(k,3145) + lu(k,3157) = lu(k,3157) - lu(k,2207) * lu(k,3145) + lu(k,3162) = lu(k,3162) - lu(k,2208) * lu(k,3145) + lu(k,3295) = lu(k,3295) - lu(k,2200) * lu(k,3280) + lu(k,3296) = lu(k,3296) - lu(k,2201) * lu(k,3280) + lu(k,3298) = lu(k,3298) - lu(k,2202) * lu(k,3280) + lu(k,3309) = lu(k,3309) - lu(k,2203) * lu(k,3280) + lu(k,3313) = lu(k,3313) - lu(k,2204) * lu(k,3280) + lu(k,3314) = lu(k,3314) - lu(k,2205) * lu(k,3280) + lu(k,3315) = lu(k,3315) - lu(k,2206) * lu(k,3280) + lu(k,3316) = lu(k,3316) - lu(k,2207) * lu(k,3280) + lu(k,3321) = lu(k,3321) - lu(k,2208) * lu(k,3280) + lu(k,3350) = lu(k,3350) - lu(k,2200) * lu(k,3348) + lu(k,3351) = lu(k,3351) - lu(k,2201) * lu(k,3348) + lu(k,3353) = lu(k,3353) - lu(k,2202) * lu(k,3348) + lu(k,3354) = - lu(k,2203) * lu(k,3348) + lu(k,3358) = lu(k,3358) - lu(k,2204) * lu(k,3348) + lu(k,3359) = lu(k,3359) - lu(k,2205) * lu(k,3348) + lu(k,3360) = lu(k,3360) - lu(k,2206) * lu(k,3348) + lu(k,3361) = lu(k,3361) - lu(k,2207) * lu(k,3348) + lu(k,3366) = lu(k,3366) - lu(k,2208) * lu(k,3348) + lu(k,3381) = lu(k,3381) - lu(k,2200) * lu(k,3379) + lu(k,3382) = lu(k,3382) - lu(k,2201) * lu(k,3379) + lu(k,3384) = lu(k,3384) - lu(k,2202) * lu(k,3379) + lu(k,3385) = lu(k,3385) - lu(k,2203) * lu(k,3379) + lu(k,3389) = lu(k,3389) - lu(k,2204) * lu(k,3379) + lu(k,3390) = lu(k,3390) - lu(k,2205) * lu(k,3379) + lu(k,3391) = lu(k,3391) - lu(k,2206) * lu(k,3379) + lu(k,3392) = lu(k,3392) - lu(k,2207) * lu(k,3379) + lu(k,3397) = lu(k,3397) - lu(k,2208) * lu(k,3379) + lu(k,3551) = lu(k,3551) - lu(k,2200) * lu(k,3536) + lu(k,3552) = lu(k,3552) - lu(k,2201) * lu(k,3536) + lu(k,3554) = lu(k,3554) - lu(k,2202) * lu(k,3536) + lu(k,3565) = lu(k,3565) - lu(k,2203) * lu(k,3536) + lu(k,3569) = lu(k,3569) - lu(k,2204) * lu(k,3536) + lu(k,3570) = lu(k,3570) - lu(k,2205) * lu(k,3536) + lu(k,3571) = lu(k,3571) - lu(k,2206) * lu(k,3536) + lu(k,3572) = lu(k,3572) - lu(k,2207) * lu(k,3536) + lu(k,3577) = lu(k,3577) - lu(k,2208) * lu(k,3536) + lu(k,3801) = lu(k,3801) - lu(k,2200) * lu(k,3787) + lu(k,3802) = lu(k,3802) - lu(k,2201) * lu(k,3787) + lu(k,3804) = lu(k,3804) - lu(k,2202) * lu(k,3787) + lu(k,3815) = lu(k,3815) - lu(k,2203) * lu(k,3787) + lu(k,3819) = lu(k,3819) - lu(k,2204) * lu(k,3787) + lu(k,3820) = lu(k,3820) - lu(k,2205) * lu(k,3787) + lu(k,3821) = lu(k,3821) - lu(k,2206) * lu(k,3787) + lu(k,3822) = lu(k,3822) - lu(k,2207) * lu(k,3787) + lu(k,3827) = lu(k,3827) - lu(k,2208) * lu(k,3787) + lu(k,3851) = - lu(k,2200) * lu(k,3849) + lu(k,3852) = lu(k,3852) - lu(k,2201) * lu(k,3849) + lu(k,3854) = lu(k,3854) - lu(k,2202) * lu(k,3849) + lu(k,3856) = lu(k,3856) - lu(k,2203) * lu(k,3849) + lu(k,3860) = lu(k,3860) - lu(k,2204) * lu(k,3849) + lu(k,3861) = lu(k,3861) - lu(k,2205) * lu(k,3849) + lu(k,3862) = lu(k,3862) - lu(k,2206) * lu(k,3849) + lu(k,3863) = lu(k,3863) - lu(k,2207) * lu(k,3849) + lu(k,3868) = lu(k,3868) - lu(k,2208) * lu(k,3849) + lu(k,3936) = lu(k,3936) - lu(k,2200) * lu(k,3921) + lu(k,3937) = lu(k,3937) - lu(k,2201) * lu(k,3921) + lu(k,3939) = - lu(k,2202) * lu(k,3921) + lu(k,3950) = lu(k,3950) - lu(k,2203) * lu(k,3921) + lu(k,3954) = lu(k,3954) - lu(k,2204) * lu(k,3921) + lu(k,3955) = lu(k,3955) - lu(k,2205) * lu(k,3921) + lu(k,3956) = lu(k,3956) - lu(k,2206) * lu(k,3921) + lu(k,3957) = lu(k,3957) - lu(k,2207) * lu(k,3921) + lu(k,3962) = lu(k,3962) - lu(k,2208) * lu(k,3921) + lu(k,4085) = lu(k,4085) - lu(k,2200) * lu(k,4083) + lu(k,4086) = lu(k,4086) - lu(k,2201) * lu(k,4083) + lu(k,4088) = lu(k,4088) - lu(k,2202) * lu(k,4083) + lu(k,4094) = lu(k,4094) - lu(k,2203) * lu(k,4083) + lu(k,4098) = lu(k,4098) - lu(k,2204) * lu(k,4083) + lu(k,4099) = lu(k,4099) - lu(k,2205) * lu(k,4083) + lu(k,4100) = lu(k,4100) - lu(k,2206) * lu(k,4083) + lu(k,4101) = lu(k,4101) - lu(k,2207) * lu(k,4083) + lu(k,4106) = lu(k,4106) - lu(k,2208) * lu(k,4083) + lu(k,4116) = lu(k,4116) - lu(k,2200) * lu(k,4114) + lu(k,4117) = lu(k,4117) - lu(k,2201) * lu(k,4114) + lu(k,4119) = lu(k,4119) - lu(k,2202) * lu(k,4114) + lu(k,4120) = lu(k,4120) - lu(k,2203) * lu(k,4114) + lu(k,4124) = - lu(k,2204) * lu(k,4114) + lu(k,4125) = lu(k,4125) - lu(k,2205) * lu(k,4114) + lu(k,4126) = lu(k,4126) - lu(k,2206) * lu(k,4114) + lu(k,4127) = lu(k,4127) - lu(k,2207) * lu(k,4114) + lu(k,4132) = lu(k,4132) - lu(k,2208) * lu(k,4114) end do end subroutine lu_fac43 subroutine lu_fac44( avec_len, lu ) @@ -11830,614 +11074,545 @@ subroutine lu_fac44( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,2214) = 1._r8 / lu(k,2214) - lu(k,2215) = lu(k,2215) * lu(k,2214) - lu(k,2216) = lu(k,2216) * lu(k,2214) - lu(k,2217) = lu(k,2217) * lu(k,2214) - lu(k,2218) = lu(k,2218) * lu(k,2214) - lu(k,2219) = lu(k,2219) * lu(k,2214) - lu(k,2220) = lu(k,2220) * lu(k,2214) - lu(k,2221) = lu(k,2221) * lu(k,2214) - lu(k,2222) = lu(k,2222) * lu(k,2214) - lu(k,2223) = lu(k,2223) * lu(k,2214) - lu(k,2224) = lu(k,2224) * lu(k,2214) - lu(k,2225) = lu(k,2225) * lu(k,2214) - lu(k,2226) = lu(k,2226) * lu(k,2214) - lu(k,2227) = lu(k,2227) * lu(k,2214) - lu(k,2228) = lu(k,2228) * lu(k,2214) - lu(k,2229) = lu(k,2229) * lu(k,2214) - lu(k,2230) = lu(k,2230) * lu(k,2214) - lu(k,2231) = lu(k,2231) * lu(k,2214) - lu(k,2232) = lu(k,2232) * lu(k,2214) - lu(k,2528) = lu(k,2528) - lu(k,2215) * lu(k,2521) - lu(k,2529) = lu(k,2529) - lu(k,2216) * lu(k,2521) - lu(k,2530) = lu(k,2530) - lu(k,2217) * lu(k,2521) - lu(k,2531) = lu(k,2531) - lu(k,2218) * lu(k,2521) - lu(k,2532) = lu(k,2532) - lu(k,2219) * lu(k,2521) - lu(k,2533) = lu(k,2533) - lu(k,2220) * lu(k,2521) - lu(k,2534) = lu(k,2534) - lu(k,2221) * lu(k,2521) - lu(k,2535) = lu(k,2535) - lu(k,2222) * lu(k,2521) - lu(k,2536) = lu(k,2536) - lu(k,2223) * lu(k,2521) - lu(k,2537) = lu(k,2537) - lu(k,2224) * lu(k,2521) - lu(k,2538) = lu(k,2538) - lu(k,2225) * lu(k,2521) - lu(k,2540) = lu(k,2540) - lu(k,2226) * lu(k,2521) - lu(k,2541) = lu(k,2541) - lu(k,2227) * lu(k,2521) - lu(k,2542) = lu(k,2542) - lu(k,2228) * lu(k,2521) - lu(k,2543) = lu(k,2543) - lu(k,2229) * lu(k,2521) - lu(k,2545) = lu(k,2545) - lu(k,2230) * lu(k,2521) - lu(k,2546) = lu(k,2546) - lu(k,2231) * lu(k,2521) - lu(k,2549) = lu(k,2549) - lu(k,2232) * lu(k,2521) - lu(k,2574) = lu(k,2574) - lu(k,2215) * lu(k,2567) - lu(k,2575) = lu(k,2575) - lu(k,2216) * lu(k,2567) - lu(k,2576) = lu(k,2576) - lu(k,2217) * lu(k,2567) - lu(k,2577) = lu(k,2577) - lu(k,2218) * lu(k,2567) - lu(k,2578) = lu(k,2578) - lu(k,2219) * lu(k,2567) - lu(k,2579) = lu(k,2579) - lu(k,2220) * lu(k,2567) - lu(k,2580) = lu(k,2580) - lu(k,2221) * lu(k,2567) - lu(k,2581) = lu(k,2581) - lu(k,2222) * lu(k,2567) - lu(k,2582) = lu(k,2582) - lu(k,2223) * lu(k,2567) - lu(k,2583) = lu(k,2583) - lu(k,2224) * lu(k,2567) - lu(k,2584) = lu(k,2584) - lu(k,2225) * lu(k,2567) - lu(k,2586) = lu(k,2586) - lu(k,2226) * lu(k,2567) - lu(k,2587) = lu(k,2587) - lu(k,2227) * lu(k,2567) - lu(k,2588) = lu(k,2588) - lu(k,2228) * lu(k,2567) - lu(k,2589) = lu(k,2589) - lu(k,2229) * lu(k,2567) - lu(k,2591) = lu(k,2591) - lu(k,2230) * lu(k,2567) - lu(k,2592) = lu(k,2592) - lu(k,2231) * lu(k,2567) - lu(k,2595) = lu(k,2595) - lu(k,2232) * lu(k,2567) - lu(k,2621) = lu(k,2621) - lu(k,2215) * lu(k,2614) - lu(k,2622) = lu(k,2622) - lu(k,2216) * lu(k,2614) - lu(k,2623) = lu(k,2623) - lu(k,2217) * lu(k,2614) - lu(k,2624) = lu(k,2624) - lu(k,2218) * lu(k,2614) - lu(k,2625) = lu(k,2625) - lu(k,2219) * lu(k,2614) - lu(k,2626) = lu(k,2626) - lu(k,2220) * lu(k,2614) - lu(k,2627) = lu(k,2627) - lu(k,2221) * lu(k,2614) - lu(k,2628) = lu(k,2628) - lu(k,2222) * lu(k,2614) - lu(k,2629) = lu(k,2629) - lu(k,2223) * lu(k,2614) - lu(k,2630) = lu(k,2630) - lu(k,2224) * lu(k,2614) - lu(k,2631) = lu(k,2631) - lu(k,2225) * lu(k,2614) - lu(k,2633) = lu(k,2633) - lu(k,2226) * lu(k,2614) - lu(k,2634) = lu(k,2634) - lu(k,2227) * lu(k,2614) - lu(k,2635) = lu(k,2635) - lu(k,2228) * lu(k,2614) - lu(k,2636) = lu(k,2636) - lu(k,2229) * lu(k,2614) - lu(k,2638) = lu(k,2638) - lu(k,2230) * lu(k,2614) - lu(k,2639) = lu(k,2639) - lu(k,2231) * lu(k,2614) - lu(k,2642) = lu(k,2642) - lu(k,2232) * lu(k,2614) - lu(k,2692) = lu(k,2692) - lu(k,2215) * lu(k,2685) - lu(k,2693) = lu(k,2693) - lu(k,2216) * lu(k,2685) - lu(k,2694) = lu(k,2694) - lu(k,2217) * lu(k,2685) - lu(k,2695) = lu(k,2695) - lu(k,2218) * lu(k,2685) - lu(k,2696) = lu(k,2696) - lu(k,2219) * lu(k,2685) - lu(k,2697) = lu(k,2697) - lu(k,2220) * lu(k,2685) - lu(k,2698) = lu(k,2698) - lu(k,2221) * lu(k,2685) - lu(k,2699) = lu(k,2699) - lu(k,2222) * lu(k,2685) - lu(k,2700) = lu(k,2700) - lu(k,2223) * lu(k,2685) - lu(k,2701) = lu(k,2701) - lu(k,2224) * lu(k,2685) - lu(k,2702) = lu(k,2702) - lu(k,2225) * lu(k,2685) - lu(k,2704) = lu(k,2704) - lu(k,2226) * lu(k,2685) - lu(k,2705) = lu(k,2705) - lu(k,2227) * lu(k,2685) - lu(k,2706) = lu(k,2706) - lu(k,2228) * lu(k,2685) - lu(k,2707) = lu(k,2707) - lu(k,2229) * lu(k,2685) - lu(k,2709) = lu(k,2709) - lu(k,2230) * lu(k,2685) - lu(k,2710) = lu(k,2710) - lu(k,2231) * lu(k,2685) - lu(k,2713) = lu(k,2713) - lu(k,2232) * lu(k,2685) - lu(k,2875) = lu(k,2875) - lu(k,2215) * lu(k,2868) - lu(k,2876) = lu(k,2876) - lu(k,2216) * lu(k,2868) - lu(k,2877) = lu(k,2877) - lu(k,2217) * lu(k,2868) - lu(k,2878) = lu(k,2878) - lu(k,2218) * lu(k,2868) - lu(k,2879) = lu(k,2879) - lu(k,2219) * lu(k,2868) - lu(k,2880) = lu(k,2880) - lu(k,2220) * lu(k,2868) - lu(k,2881) = lu(k,2881) - lu(k,2221) * lu(k,2868) - lu(k,2882) = lu(k,2882) - lu(k,2222) * lu(k,2868) - lu(k,2883) = lu(k,2883) - lu(k,2223) * lu(k,2868) - lu(k,2884) = lu(k,2884) - lu(k,2224) * lu(k,2868) - lu(k,2885) = lu(k,2885) - lu(k,2225) * lu(k,2868) - lu(k,2887) = lu(k,2887) - lu(k,2226) * lu(k,2868) - lu(k,2889) = lu(k,2889) - lu(k,2227) * lu(k,2868) - lu(k,2891) = lu(k,2891) - lu(k,2228) * lu(k,2868) - lu(k,2892) = lu(k,2892) - lu(k,2229) * lu(k,2868) - lu(k,2894) = lu(k,2894) - lu(k,2230) * lu(k,2868) - lu(k,2895) = lu(k,2895) - lu(k,2231) * lu(k,2868) - lu(k,2899) = lu(k,2899) - lu(k,2232) * lu(k,2868) - lu(k,2976) = lu(k,2976) - lu(k,2215) * lu(k,2969) - lu(k,2977) = lu(k,2977) - lu(k,2216) * lu(k,2969) - lu(k,2978) = lu(k,2978) - lu(k,2217) * lu(k,2969) - lu(k,2979) = lu(k,2979) - lu(k,2218) * lu(k,2969) - lu(k,2980) = lu(k,2980) - lu(k,2219) * lu(k,2969) - lu(k,2981) = lu(k,2981) - lu(k,2220) * lu(k,2969) - lu(k,2982) = lu(k,2982) - lu(k,2221) * lu(k,2969) - lu(k,2983) = lu(k,2983) - lu(k,2222) * lu(k,2969) - lu(k,2984) = lu(k,2984) - lu(k,2223) * lu(k,2969) - lu(k,2985) = lu(k,2985) - lu(k,2224) * lu(k,2969) - lu(k,2986) = lu(k,2986) - lu(k,2225) * lu(k,2969) - lu(k,2988) = lu(k,2988) - lu(k,2226) * lu(k,2969) - lu(k,2990) = lu(k,2990) - lu(k,2227) * lu(k,2969) - lu(k,2992) = lu(k,2992) - lu(k,2228) * lu(k,2969) - lu(k,2993) = lu(k,2993) - lu(k,2229) * lu(k,2969) - lu(k,2995) = lu(k,2995) - lu(k,2230) * lu(k,2969) - lu(k,2996) = lu(k,2996) - lu(k,2231) * lu(k,2969) - lu(k,3000) = lu(k,3000) - lu(k,2232) * lu(k,2969) - lu(k,3068) = lu(k,3068) - lu(k,2215) * lu(k,3061) - lu(k,3069) = lu(k,3069) - lu(k,2216) * lu(k,3061) - lu(k,3070) = lu(k,3070) - lu(k,2217) * lu(k,3061) - lu(k,3071) = lu(k,3071) - lu(k,2218) * lu(k,3061) - lu(k,3072) = lu(k,3072) - lu(k,2219) * lu(k,3061) - lu(k,3073) = lu(k,3073) - lu(k,2220) * lu(k,3061) - lu(k,3074) = lu(k,3074) - lu(k,2221) * lu(k,3061) - lu(k,3075) = lu(k,3075) - lu(k,2222) * lu(k,3061) - lu(k,3076) = lu(k,3076) - lu(k,2223) * lu(k,3061) - lu(k,3077) = lu(k,3077) - lu(k,2224) * lu(k,3061) - lu(k,3078) = lu(k,3078) - lu(k,2225) * lu(k,3061) - lu(k,3080) = lu(k,3080) - lu(k,2226) * lu(k,3061) - lu(k,3082) = lu(k,3082) - lu(k,2227) * lu(k,3061) - lu(k,3084) = lu(k,3084) - lu(k,2228) * lu(k,3061) - lu(k,3085) = lu(k,3085) - lu(k,2229) * lu(k,3061) - lu(k,3087) = lu(k,3087) - lu(k,2230) * lu(k,3061) - lu(k,3088) = lu(k,3088) - lu(k,2231) * lu(k,3061) - lu(k,3092) = lu(k,3092) - lu(k,2232) * lu(k,3061) - lu(k,3271) = lu(k,3271) - lu(k,2215) * lu(k,3264) - lu(k,3272) = lu(k,3272) - lu(k,2216) * lu(k,3264) - lu(k,3273) = lu(k,3273) - lu(k,2217) * lu(k,3264) - lu(k,3274) = lu(k,3274) - lu(k,2218) * lu(k,3264) - lu(k,3275) = lu(k,3275) - lu(k,2219) * lu(k,3264) - lu(k,3276) = lu(k,3276) - lu(k,2220) * lu(k,3264) - lu(k,3277) = lu(k,3277) - lu(k,2221) * lu(k,3264) - lu(k,3278) = lu(k,3278) - lu(k,2222) * lu(k,3264) - lu(k,3279) = lu(k,3279) - lu(k,2223) * lu(k,3264) - lu(k,3280) = lu(k,3280) - lu(k,2224) * lu(k,3264) - lu(k,3281) = lu(k,3281) - lu(k,2225) * lu(k,3264) - lu(k,3283) = lu(k,3283) - lu(k,2226) * lu(k,3264) - lu(k,3285) = lu(k,3285) - lu(k,2227) * lu(k,3264) - lu(k,3287) = lu(k,3287) - lu(k,2228) * lu(k,3264) - lu(k,3288) = lu(k,3288) - lu(k,2229) * lu(k,3264) - lu(k,3290) = lu(k,3290) - lu(k,2230) * lu(k,3264) - lu(k,3291) = lu(k,3291) - lu(k,2231) * lu(k,3264) - lu(k,3295) = lu(k,3295) - lu(k,2232) * lu(k,3264) - lu(k,3412) = lu(k,3412) - lu(k,2215) * lu(k,3405) - lu(k,3413) = lu(k,3413) - lu(k,2216) * lu(k,3405) - lu(k,3414) = lu(k,3414) - lu(k,2217) * lu(k,3405) - lu(k,3415) = lu(k,3415) - lu(k,2218) * lu(k,3405) - lu(k,3416) = lu(k,3416) - lu(k,2219) * lu(k,3405) - lu(k,3417) = lu(k,3417) - lu(k,2220) * lu(k,3405) - lu(k,3418) = lu(k,3418) - lu(k,2221) * lu(k,3405) - lu(k,3419) = lu(k,3419) - lu(k,2222) * lu(k,3405) - lu(k,3420) = lu(k,3420) - lu(k,2223) * lu(k,3405) - lu(k,3421) = lu(k,3421) - lu(k,2224) * lu(k,3405) - lu(k,3422) = lu(k,3422) - lu(k,2225) * lu(k,3405) - lu(k,3424) = lu(k,3424) - lu(k,2226) * lu(k,3405) - lu(k,3426) = lu(k,3426) - lu(k,2227) * lu(k,3405) - lu(k,3428) = lu(k,3428) - lu(k,2228) * lu(k,3405) - lu(k,3429) = lu(k,3429) - lu(k,2229) * lu(k,3405) - lu(k,3431) = lu(k,3431) - lu(k,2230) * lu(k,3405) - lu(k,3432) = lu(k,3432) - lu(k,2231) * lu(k,3405) - lu(k,3436) = lu(k,3436) - lu(k,2232) * lu(k,3405) - lu(k,3732) = lu(k,3732) - lu(k,2215) * lu(k,3725) - lu(k,3733) = lu(k,3733) - lu(k,2216) * lu(k,3725) - lu(k,3734) = lu(k,3734) - lu(k,2217) * lu(k,3725) - lu(k,3735) = lu(k,3735) - lu(k,2218) * lu(k,3725) - lu(k,3736) = lu(k,3736) - lu(k,2219) * lu(k,3725) - lu(k,3737) = lu(k,3737) - lu(k,2220) * lu(k,3725) - lu(k,3738) = lu(k,3738) - lu(k,2221) * lu(k,3725) - lu(k,3739) = lu(k,3739) - lu(k,2222) * lu(k,3725) - lu(k,3740) = lu(k,3740) - lu(k,2223) * lu(k,3725) - lu(k,3741) = lu(k,3741) - lu(k,2224) * lu(k,3725) - lu(k,3742) = lu(k,3742) - lu(k,2225) * lu(k,3725) - lu(k,3744) = lu(k,3744) - lu(k,2226) * lu(k,3725) - lu(k,3746) = lu(k,3746) - lu(k,2227) * lu(k,3725) - lu(k,3748) = lu(k,3748) - lu(k,2228) * lu(k,3725) - lu(k,3749) = lu(k,3749) - lu(k,2229) * lu(k,3725) - lu(k,3751) = lu(k,3751) - lu(k,2230) * lu(k,3725) - lu(k,3752) = lu(k,3752) - lu(k,2231) * lu(k,3725) - lu(k,3756) = lu(k,3756) - lu(k,2232) * lu(k,3725) - lu(k,2243) = 1._r8 / lu(k,2243) - lu(k,2244) = lu(k,2244) * lu(k,2243) - lu(k,2245) = lu(k,2245) * lu(k,2243) - lu(k,2246) = lu(k,2246) * lu(k,2243) - lu(k,2247) = lu(k,2247) * lu(k,2243) - lu(k,2248) = lu(k,2248) * lu(k,2243) - lu(k,2249) = lu(k,2249) * lu(k,2243) - lu(k,2250) = lu(k,2250) * lu(k,2243) - lu(k,2251) = lu(k,2251) * lu(k,2243) - lu(k,2252) = lu(k,2252) * lu(k,2243) - lu(k,2253) = lu(k,2253) * lu(k,2243) - lu(k,2254) = lu(k,2254) * lu(k,2243) - lu(k,2255) = lu(k,2255) * lu(k,2243) - lu(k,2256) = lu(k,2256) * lu(k,2243) - lu(k,2257) = lu(k,2257) * lu(k,2243) - lu(k,2258) = lu(k,2258) * lu(k,2243) - lu(k,2259) = lu(k,2259) * lu(k,2243) - lu(k,2260) = lu(k,2260) * lu(k,2243) - lu(k,2261) = lu(k,2261) * lu(k,2243) - lu(k,2528) = lu(k,2528) - lu(k,2244) * lu(k,2522) - lu(k,2529) = lu(k,2529) - lu(k,2245) * lu(k,2522) - lu(k,2530) = lu(k,2530) - lu(k,2246) * lu(k,2522) - lu(k,2531) = lu(k,2531) - lu(k,2247) * lu(k,2522) - lu(k,2532) = lu(k,2532) - lu(k,2248) * lu(k,2522) - lu(k,2533) = lu(k,2533) - lu(k,2249) * lu(k,2522) - lu(k,2534) = lu(k,2534) - lu(k,2250) * lu(k,2522) - lu(k,2535) = lu(k,2535) - lu(k,2251) * lu(k,2522) - lu(k,2536) = lu(k,2536) - lu(k,2252) * lu(k,2522) - lu(k,2537) = lu(k,2537) - lu(k,2253) * lu(k,2522) - lu(k,2538) = lu(k,2538) - lu(k,2254) * lu(k,2522) - lu(k,2540) = lu(k,2540) - lu(k,2255) * lu(k,2522) - lu(k,2541) = lu(k,2541) - lu(k,2256) * lu(k,2522) - lu(k,2542) = lu(k,2542) - lu(k,2257) * lu(k,2522) - lu(k,2543) = lu(k,2543) - lu(k,2258) * lu(k,2522) - lu(k,2545) = lu(k,2545) - lu(k,2259) * lu(k,2522) - lu(k,2546) = lu(k,2546) - lu(k,2260) * lu(k,2522) - lu(k,2549) = lu(k,2549) - lu(k,2261) * lu(k,2522) - lu(k,2574) = lu(k,2574) - lu(k,2244) * lu(k,2568) - lu(k,2575) = lu(k,2575) - lu(k,2245) * lu(k,2568) - lu(k,2576) = lu(k,2576) - lu(k,2246) * lu(k,2568) - lu(k,2577) = lu(k,2577) - lu(k,2247) * lu(k,2568) - lu(k,2578) = lu(k,2578) - lu(k,2248) * lu(k,2568) - lu(k,2579) = lu(k,2579) - lu(k,2249) * lu(k,2568) - lu(k,2580) = lu(k,2580) - lu(k,2250) * lu(k,2568) - lu(k,2581) = lu(k,2581) - lu(k,2251) * lu(k,2568) - lu(k,2582) = lu(k,2582) - lu(k,2252) * lu(k,2568) - lu(k,2583) = lu(k,2583) - lu(k,2253) * lu(k,2568) - lu(k,2584) = lu(k,2584) - lu(k,2254) * lu(k,2568) - lu(k,2586) = lu(k,2586) - lu(k,2255) * lu(k,2568) - lu(k,2587) = lu(k,2587) - lu(k,2256) * lu(k,2568) - lu(k,2588) = lu(k,2588) - lu(k,2257) * lu(k,2568) - lu(k,2589) = lu(k,2589) - lu(k,2258) * lu(k,2568) - lu(k,2591) = lu(k,2591) - lu(k,2259) * lu(k,2568) - lu(k,2592) = lu(k,2592) - lu(k,2260) * lu(k,2568) - lu(k,2595) = lu(k,2595) - lu(k,2261) * lu(k,2568) - lu(k,2621) = lu(k,2621) - lu(k,2244) * lu(k,2615) - lu(k,2622) = lu(k,2622) - lu(k,2245) * lu(k,2615) - lu(k,2623) = lu(k,2623) - lu(k,2246) * lu(k,2615) - lu(k,2624) = lu(k,2624) - lu(k,2247) * lu(k,2615) - lu(k,2625) = lu(k,2625) - lu(k,2248) * lu(k,2615) - lu(k,2626) = lu(k,2626) - lu(k,2249) * lu(k,2615) - lu(k,2627) = lu(k,2627) - lu(k,2250) * lu(k,2615) - lu(k,2628) = lu(k,2628) - lu(k,2251) * lu(k,2615) - lu(k,2629) = lu(k,2629) - lu(k,2252) * lu(k,2615) - lu(k,2630) = lu(k,2630) - lu(k,2253) * lu(k,2615) - lu(k,2631) = lu(k,2631) - lu(k,2254) * lu(k,2615) - lu(k,2633) = lu(k,2633) - lu(k,2255) * lu(k,2615) - lu(k,2634) = lu(k,2634) - lu(k,2256) * lu(k,2615) - lu(k,2635) = lu(k,2635) - lu(k,2257) * lu(k,2615) - lu(k,2636) = lu(k,2636) - lu(k,2258) * lu(k,2615) - lu(k,2638) = lu(k,2638) - lu(k,2259) * lu(k,2615) - lu(k,2639) = lu(k,2639) - lu(k,2260) * lu(k,2615) - lu(k,2642) = lu(k,2642) - lu(k,2261) * lu(k,2615) - lu(k,2692) = lu(k,2692) - lu(k,2244) * lu(k,2686) - lu(k,2693) = lu(k,2693) - lu(k,2245) * lu(k,2686) - lu(k,2694) = lu(k,2694) - lu(k,2246) * lu(k,2686) - lu(k,2695) = lu(k,2695) - lu(k,2247) * lu(k,2686) - lu(k,2696) = lu(k,2696) - lu(k,2248) * lu(k,2686) - lu(k,2697) = lu(k,2697) - lu(k,2249) * lu(k,2686) - lu(k,2698) = lu(k,2698) - lu(k,2250) * lu(k,2686) - lu(k,2699) = lu(k,2699) - lu(k,2251) * lu(k,2686) - lu(k,2700) = lu(k,2700) - lu(k,2252) * lu(k,2686) - lu(k,2701) = lu(k,2701) - lu(k,2253) * lu(k,2686) - lu(k,2702) = lu(k,2702) - lu(k,2254) * lu(k,2686) - lu(k,2704) = lu(k,2704) - lu(k,2255) * lu(k,2686) - lu(k,2705) = lu(k,2705) - lu(k,2256) * lu(k,2686) - lu(k,2706) = lu(k,2706) - lu(k,2257) * lu(k,2686) - lu(k,2707) = lu(k,2707) - lu(k,2258) * lu(k,2686) - lu(k,2709) = lu(k,2709) - lu(k,2259) * lu(k,2686) - lu(k,2710) = lu(k,2710) - lu(k,2260) * lu(k,2686) - lu(k,2713) = lu(k,2713) - lu(k,2261) * lu(k,2686) - lu(k,2875) = lu(k,2875) - lu(k,2244) * lu(k,2869) - lu(k,2876) = lu(k,2876) - lu(k,2245) * lu(k,2869) - lu(k,2877) = lu(k,2877) - lu(k,2246) * lu(k,2869) - lu(k,2878) = lu(k,2878) - lu(k,2247) * lu(k,2869) - lu(k,2879) = lu(k,2879) - lu(k,2248) * lu(k,2869) - lu(k,2880) = lu(k,2880) - lu(k,2249) * lu(k,2869) - lu(k,2881) = lu(k,2881) - lu(k,2250) * lu(k,2869) - lu(k,2882) = lu(k,2882) - lu(k,2251) * lu(k,2869) - lu(k,2883) = lu(k,2883) - lu(k,2252) * lu(k,2869) - lu(k,2884) = lu(k,2884) - lu(k,2253) * lu(k,2869) - lu(k,2885) = lu(k,2885) - lu(k,2254) * lu(k,2869) - lu(k,2887) = lu(k,2887) - lu(k,2255) * lu(k,2869) - lu(k,2889) = lu(k,2889) - lu(k,2256) * lu(k,2869) - lu(k,2891) = lu(k,2891) - lu(k,2257) * lu(k,2869) - lu(k,2892) = lu(k,2892) - lu(k,2258) * lu(k,2869) - lu(k,2894) = lu(k,2894) - lu(k,2259) * lu(k,2869) - lu(k,2895) = lu(k,2895) - lu(k,2260) * lu(k,2869) - lu(k,2899) = lu(k,2899) - lu(k,2261) * lu(k,2869) - lu(k,2976) = lu(k,2976) - lu(k,2244) * lu(k,2970) - lu(k,2977) = lu(k,2977) - lu(k,2245) * lu(k,2970) - lu(k,2978) = lu(k,2978) - lu(k,2246) * lu(k,2970) - lu(k,2979) = lu(k,2979) - lu(k,2247) * lu(k,2970) - lu(k,2980) = lu(k,2980) - lu(k,2248) * lu(k,2970) - lu(k,2981) = lu(k,2981) - lu(k,2249) * lu(k,2970) - lu(k,2982) = lu(k,2982) - lu(k,2250) * lu(k,2970) - lu(k,2983) = lu(k,2983) - lu(k,2251) * lu(k,2970) - lu(k,2984) = lu(k,2984) - lu(k,2252) * lu(k,2970) - lu(k,2985) = lu(k,2985) - lu(k,2253) * lu(k,2970) - lu(k,2986) = lu(k,2986) - lu(k,2254) * lu(k,2970) - lu(k,2988) = lu(k,2988) - lu(k,2255) * lu(k,2970) - lu(k,2990) = lu(k,2990) - lu(k,2256) * lu(k,2970) - lu(k,2992) = lu(k,2992) - lu(k,2257) * lu(k,2970) - lu(k,2993) = lu(k,2993) - lu(k,2258) * lu(k,2970) - lu(k,2995) = lu(k,2995) - lu(k,2259) * lu(k,2970) - lu(k,2996) = lu(k,2996) - lu(k,2260) * lu(k,2970) - lu(k,3000) = lu(k,3000) - lu(k,2261) * lu(k,2970) - lu(k,3068) = lu(k,3068) - lu(k,2244) * lu(k,3062) - lu(k,3069) = lu(k,3069) - lu(k,2245) * lu(k,3062) - lu(k,3070) = lu(k,3070) - lu(k,2246) * lu(k,3062) - lu(k,3071) = lu(k,3071) - lu(k,2247) * lu(k,3062) - lu(k,3072) = lu(k,3072) - lu(k,2248) * lu(k,3062) - lu(k,3073) = lu(k,3073) - lu(k,2249) * lu(k,3062) - lu(k,3074) = lu(k,3074) - lu(k,2250) * lu(k,3062) - lu(k,3075) = lu(k,3075) - lu(k,2251) * lu(k,3062) - lu(k,3076) = lu(k,3076) - lu(k,2252) * lu(k,3062) - lu(k,3077) = lu(k,3077) - lu(k,2253) * lu(k,3062) - lu(k,3078) = lu(k,3078) - lu(k,2254) * lu(k,3062) - lu(k,3080) = lu(k,3080) - lu(k,2255) * lu(k,3062) - lu(k,3082) = lu(k,3082) - lu(k,2256) * lu(k,3062) - lu(k,3084) = lu(k,3084) - lu(k,2257) * lu(k,3062) - lu(k,3085) = lu(k,3085) - lu(k,2258) * lu(k,3062) - lu(k,3087) = lu(k,3087) - lu(k,2259) * lu(k,3062) - lu(k,3088) = lu(k,3088) - lu(k,2260) * lu(k,3062) - lu(k,3092) = lu(k,3092) - lu(k,2261) * lu(k,3062) - lu(k,3271) = lu(k,3271) - lu(k,2244) * lu(k,3265) - lu(k,3272) = lu(k,3272) - lu(k,2245) * lu(k,3265) - lu(k,3273) = lu(k,3273) - lu(k,2246) * lu(k,3265) - lu(k,3274) = lu(k,3274) - lu(k,2247) * lu(k,3265) - lu(k,3275) = lu(k,3275) - lu(k,2248) * lu(k,3265) - lu(k,3276) = lu(k,3276) - lu(k,2249) * lu(k,3265) - lu(k,3277) = lu(k,3277) - lu(k,2250) * lu(k,3265) - lu(k,3278) = lu(k,3278) - lu(k,2251) * lu(k,3265) - lu(k,3279) = lu(k,3279) - lu(k,2252) * lu(k,3265) - lu(k,3280) = lu(k,3280) - lu(k,2253) * lu(k,3265) - lu(k,3281) = lu(k,3281) - lu(k,2254) * lu(k,3265) - lu(k,3283) = lu(k,3283) - lu(k,2255) * lu(k,3265) - lu(k,3285) = lu(k,3285) - lu(k,2256) * lu(k,3265) - lu(k,3287) = lu(k,3287) - lu(k,2257) * lu(k,3265) - lu(k,3288) = lu(k,3288) - lu(k,2258) * lu(k,3265) - lu(k,3290) = lu(k,3290) - lu(k,2259) * lu(k,3265) - lu(k,3291) = lu(k,3291) - lu(k,2260) * lu(k,3265) - lu(k,3295) = lu(k,3295) - lu(k,2261) * lu(k,3265) - lu(k,3412) = lu(k,3412) - lu(k,2244) * lu(k,3406) - lu(k,3413) = lu(k,3413) - lu(k,2245) * lu(k,3406) - lu(k,3414) = lu(k,3414) - lu(k,2246) * lu(k,3406) - lu(k,3415) = lu(k,3415) - lu(k,2247) * lu(k,3406) - lu(k,3416) = lu(k,3416) - lu(k,2248) * lu(k,3406) - lu(k,3417) = lu(k,3417) - lu(k,2249) * lu(k,3406) - lu(k,3418) = lu(k,3418) - lu(k,2250) * lu(k,3406) - lu(k,3419) = lu(k,3419) - lu(k,2251) * lu(k,3406) - lu(k,3420) = lu(k,3420) - lu(k,2252) * lu(k,3406) - lu(k,3421) = lu(k,3421) - lu(k,2253) * lu(k,3406) - lu(k,3422) = lu(k,3422) - lu(k,2254) * lu(k,3406) - lu(k,3424) = lu(k,3424) - lu(k,2255) * lu(k,3406) - lu(k,3426) = lu(k,3426) - lu(k,2256) * lu(k,3406) - lu(k,3428) = lu(k,3428) - lu(k,2257) * lu(k,3406) - lu(k,3429) = lu(k,3429) - lu(k,2258) * lu(k,3406) - lu(k,3431) = lu(k,3431) - lu(k,2259) * lu(k,3406) - lu(k,3432) = lu(k,3432) - lu(k,2260) * lu(k,3406) - lu(k,3436) = lu(k,3436) - lu(k,2261) * lu(k,3406) - lu(k,3732) = lu(k,3732) - lu(k,2244) * lu(k,3726) - lu(k,3733) = lu(k,3733) - lu(k,2245) * lu(k,3726) - lu(k,3734) = lu(k,3734) - lu(k,2246) * lu(k,3726) - lu(k,3735) = lu(k,3735) - lu(k,2247) * lu(k,3726) - lu(k,3736) = lu(k,3736) - lu(k,2248) * lu(k,3726) - lu(k,3737) = lu(k,3737) - lu(k,2249) * lu(k,3726) - lu(k,3738) = lu(k,3738) - lu(k,2250) * lu(k,3726) - lu(k,3739) = lu(k,3739) - lu(k,2251) * lu(k,3726) - lu(k,3740) = lu(k,3740) - lu(k,2252) * lu(k,3726) - lu(k,3741) = lu(k,3741) - lu(k,2253) * lu(k,3726) - lu(k,3742) = lu(k,3742) - lu(k,2254) * lu(k,3726) - lu(k,3744) = lu(k,3744) - lu(k,2255) * lu(k,3726) - lu(k,3746) = lu(k,3746) - lu(k,2256) * lu(k,3726) - lu(k,3748) = lu(k,3748) - lu(k,2257) * lu(k,3726) - lu(k,3749) = lu(k,3749) - lu(k,2258) * lu(k,3726) - lu(k,3751) = lu(k,3751) - lu(k,2259) * lu(k,3726) - lu(k,3752) = lu(k,3752) - lu(k,2260) * lu(k,3726) - lu(k,3756) = lu(k,3756) - lu(k,2261) * lu(k,3726) - lu(k,2271) = 1._r8 / lu(k,2271) - lu(k,2272) = lu(k,2272) * lu(k,2271) - lu(k,2273) = lu(k,2273) * lu(k,2271) - lu(k,2274) = lu(k,2274) * lu(k,2271) - lu(k,2275) = lu(k,2275) * lu(k,2271) - lu(k,2276) = lu(k,2276) * lu(k,2271) - lu(k,2277) = lu(k,2277) * lu(k,2271) - lu(k,2278) = lu(k,2278) * lu(k,2271) - lu(k,2279) = lu(k,2279) * lu(k,2271) - lu(k,2280) = lu(k,2280) * lu(k,2271) - lu(k,2281) = lu(k,2281) * lu(k,2271) - lu(k,2282) = lu(k,2282) * lu(k,2271) - lu(k,2283) = lu(k,2283) * lu(k,2271) - lu(k,2284) = lu(k,2284) * lu(k,2271) - lu(k,2285) = lu(k,2285) * lu(k,2271) - lu(k,2286) = lu(k,2286) * lu(k,2271) - lu(k,2287) = lu(k,2287) * lu(k,2271) - lu(k,2288) = lu(k,2288) * lu(k,2271) - lu(k,2289) = lu(k,2289) * lu(k,2271) - lu(k,2290) = lu(k,2290) * lu(k,2271) - lu(k,2527) = lu(k,2527) - lu(k,2272) * lu(k,2523) - lu(k,2528) = lu(k,2528) - lu(k,2273) * lu(k,2523) - lu(k,2529) = lu(k,2529) - lu(k,2274) * lu(k,2523) - lu(k,2530) = lu(k,2530) - lu(k,2275) * lu(k,2523) - lu(k,2531) = lu(k,2531) - lu(k,2276) * lu(k,2523) - lu(k,2532) = lu(k,2532) - lu(k,2277) * lu(k,2523) - lu(k,2533) = lu(k,2533) - lu(k,2278) * lu(k,2523) - lu(k,2534) = lu(k,2534) - lu(k,2279) * lu(k,2523) - lu(k,2535) = lu(k,2535) - lu(k,2280) * lu(k,2523) - lu(k,2536) = lu(k,2536) - lu(k,2281) * lu(k,2523) - lu(k,2537) = lu(k,2537) - lu(k,2282) * lu(k,2523) - lu(k,2538) = lu(k,2538) - lu(k,2283) * lu(k,2523) - lu(k,2540) = lu(k,2540) - lu(k,2284) * lu(k,2523) - lu(k,2541) = lu(k,2541) - lu(k,2285) * lu(k,2523) - lu(k,2542) = lu(k,2542) - lu(k,2286) * lu(k,2523) - lu(k,2543) = lu(k,2543) - lu(k,2287) * lu(k,2523) - lu(k,2545) = lu(k,2545) - lu(k,2288) * lu(k,2523) - lu(k,2546) = lu(k,2546) - lu(k,2289) * lu(k,2523) - lu(k,2549) = lu(k,2549) - lu(k,2290) * lu(k,2523) - lu(k,2573) = lu(k,2573) - lu(k,2272) * lu(k,2569) - lu(k,2574) = lu(k,2574) - lu(k,2273) * lu(k,2569) - lu(k,2575) = lu(k,2575) - lu(k,2274) * lu(k,2569) - lu(k,2576) = lu(k,2576) - lu(k,2275) * lu(k,2569) - lu(k,2577) = lu(k,2577) - lu(k,2276) * lu(k,2569) - lu(k,2578) = lu(k,2578) - lu(k,2277) * lu(k,2569) - lu(k,2579) = lu(k,2579) - lu(k,2278) * lu(k,2569) - lu(k,2580) = lu(k,2580) - lu(k,2279) * lu(k,2569) - lu(k,2581) = lu(k,2581) - lu(k,2280) * lu(k,2569) - lu(k,2582) = lu(k,2582) - lu(k,2281) * lu(k,2569) - lu(k,2583) = lu(k,2583) - lu(k,2282) * lu(k,2569) - lu(k,2584) = lu(k,2584) - lu(k,2283) * lu(k,2569) - lu(k,2586) = lu(k,2586) - lu(k,2284) * lu(k,2569) - lu(k,2587) = lu(k,2587) - lu(k,2285) * lu(k,2569) - lu(k,2588) = lu(k,2588) - lu(k,2286) * lu(k,2569) - lu(k,2589) = lu(k,2589) - lu(k,2287) * lu(k,2569) - lu(k,2591) = lu(k,2591) - lu(k,2288) * lu(k,2569) - lu(k,2592) = lu(k,2592) - lu(k,2289) * lu(k,2569) - lu(k,2595) = lu(k,2595) - lu(k,2290) * lu(k,2569) - lu(k,2620) = lu(k,2620) - lu(k,2272) * lu(k,2616) - lu(k,2621) = lu(k,2621) - lu(k,2273) * lu(k,2616) - lu(k,2622) = lu(k,2622) - lu(k,2274) * lu(k,2616) - lu(k,2623) = lu(k,2623) - lu(k,2275) * lu(k,2616) - lu(k,2624) = lu(k,2624) - lu(k,2276) * lu(k,2616) - lu(k,2625) = lu(k,2625) - lu(k,2277) * lu(k,2616) - lu(k,2626) = lu(k,2626) - lu(k,2278) * lu(k,2616) - lu(k,2627) = lu(k,2627) - lu(k,2279) * lu(k,2616) - lu(k,2628) = lu(k,2628) - lu(k,2280) * lu(k,2616) - lu(k,2629) = lu(k,2629) - lu(k,2281) * lu(k,2616) - lu(k,2630) = lu(k,2630) - lu(k,2282) * lu(k,2616) - lu(k,2631) = lu(k,2631) - lu(k,2283) * lu(k,2616) - lu(k,2633) = lu(k,2633) - lu(k,2284) * lu(k,2616) - lu(k,2634) = lu(k,2634) - lu(k,2285) * lu(k,2616) - lu(k,2635) = lu(k,2635) - lu(k,2286) * lu(k,2616) - lu(k,2636) = lu(k,2636) - lu(k,2287) * lu(k,2616) - lu(k,2638) = lu(k,2638) - lu(k,2288) * lu(k,2616) - lu(k,2639) = lu(k,2639) - lu(k,2289) * lu(k,2616) - lu(k,2642) = lu(k,2642) - lu(k,2290) * lu(k,2616) - lu(k,2691) = lu(k,2691) - lu(k,2272) * lu(k,2687) - lu(k,2692) = lu(k,2692) - lu(k,2273) * lu(k,2687) - lu(k,2693) = lu(k,2693) - lu(k,2274) * lu(k,2687) - lu(k,2694) = lu(k,2694) - lu(k,2275) * lu(k,2687) - lu(k,2695) = lu(k,2695) - lu(k,2276) * lu(k,2687) - lu(k,2696) = lu(k,2696) - lu(k,2277) * lu(k,2687) - lu(k,2697) = lu(k,2697) - lu(k,2278) * lu(k,2687) - lu(k,2698) = lu(k,2698) - lu(k,2279) * lu(k,2687) - lu(k,2699) = lu(k,2699) - lu(k,2280) * lu(k,2687) - lu(k,2700) = lu(k,2700) - lu(k,2281) * lu(k,2687) - lu(k,2701) = lu(k,2701) - lu(k,2282) * lu(k,2687) - lu(k,2702) = lu(k,2702) - lu(k,2283) * lu(k,2687) - lu(k,2704) = lu(k,2704) - lu(k,2284) * lu(k,2687) - lu(k,2705) = lu(k,2705) - lu(k,2285) * lu(k,2687) - lu(k,2706) = lu(k,2706) - lu(k,2286) * lu(k,2687) - lu(k,2707) = lu(k,2707) - lu(k,2287) * lu(k,2687) - lu(k,2709) = lu(k,2709) - lu(k,2288) * lu(k,2687) - lu(k,2710) = lu(k,2710) - lu(k,2289) * lu(k,2687) - lu(k,2713) = lu(k,2713) - lu(k,2290) * lu(k,2687) - lu(k,2874) = lu(k,2874) - lu(k,2272) * lu(k,2870) - lu(k,2875) = lu(k,2875) - lu(k,2273) * lu(k,2870) - lu(k,2876) = lu(k,2876) - lu(k,2274) * lu(k,2870) - lu(k,2877) = lu(k,2877) - lu(k,2275) * lu(k,2870) - lu(k,2878) = lu(k,2878) - lu(k,2276) * lu(k,2870) - lu(k,2879) = lu(k,2879) - lu(k,2277) * lu(k,2870) - lu(k,2880) = lu(k,2880) - lu(k,2278) * lu(k,2870) - lu(k,2881) = lu(k,2881) - lu(k,2279) * lu(k,2870) - lu(k,2882) = lu(k,2882) - lu(k,2280) * lu(k,2870) - lu(k,2883) = lu(k,2883) - lu(k,2281) * lu(k,2870) - lu(k,2884) = lu(k,2884) - lu(k,2282) * lu(k,2870) - lu(k,2885) = lu(k,2885) - lu(k,2283) * lu(k,2870) - lu(k,2887) = lu(k,2887) - lu(k,2284) * lu(k,2870) - lu(k,2889) = lu(k,2889) - lu(k,2285) * lu(k,2870) - lu(k,2891) = lu(k,2891) - lu(k,2286) * lu(k,2870) - lu(k,2892) = lu(k,2892) - lu(k,2287) * lu(k,2870) - lu(k,2894) = lu(k,2894) - lu(k,2288) * lu(k,2870) - lu(k,2895) = lu(k,2895) - lu(k,2289) * lu(k,2870) - lu(k,2899) = lu(k,2899) - lu(k,2290) * lu(k,2870) - lu(k,2975) = lu(k,2975) - lu(k,2272) * lu(k,2971) - lu(k,2976) = lu(k,2976) - lu(k,2273) * lu(k,2971) - lu(k,2977) = lu(k,2977) - lu(k,2274) * lu(k,2971) - lu(k,2978) = lu(k,2978) - lu(k,2275) * lu(k,2971) - lu(k,2979) = lu(k,2979) - lu(k,2276) * lu(k,2971) - lu(k,2980) = lu(k,2980) - lu(k,2277) * lu(k,2971) - lu(k,2981) = lu(k,2981) - lu(k,2278) * lu(k,2971) - lu(k,2982) = lu(k,2982) - lu(k,2279) * lu(k,2971) - lu(k,2983) = lu(k,2983) - lu(k,2280) * lu(k,2971) - lu(k,2984) = lu(k,2984) - lu(k,2281) * lu(k,2971) - lu(k,2985) = lu(k,2985) - lu(k,2282) * lu(k,2971) - lu(k,2986) = lu(k,2986) - lu(k,2283) * lu(k,2971) - lu(k,2988) = lu(k,2988) - lu(k,2284) * lu(k,2971) - lu(k,2990) = lu(k,2990) - lu(k,2285) * lu(k,2971) - lu(k,2992) = lu(k,2992) - lu(k,2286) * lu(k,2971) - lu(k,2993) = lu(k,2993) - lu(k,2287) * lu(k,2971) - lu(k,2995) = lu(k,2995) - lu(k,2288) * lu(k,2971) - lu(k,2996) = lu(k,2996) - lu(k,2289) * lu(k,2971) - lu(k,3000) = lu(k,3000) - lu(k,2290) * lu(k,2971) - lu(k,3067) = lu(k,3067) - lu(k,2272) * lu(k,3063) - lu(k,3068) = lu(k,3068) - lu(k,2273) * lu(k,3063) - lu(k,3069) = lu(k,3069) - lu(k,2274) * lu(k,3063) - lu(k,3070) = lu(k,3070) - lu(k,2275) * lu(k,3063) - lu(k,3071) = lu(k,3071) - lu(k,2276) * lu(k,3063) - lu(k,3072) = lu(k,3072) - lu(k,2277) * lu(k,3063) - lu(k,3073) = lu(k,3073) - lu(k,2278) * lu(k,3063) - lu(k,3074) = lu(k,3074) - lu(k,2279) * lu(k,3063) - lu(k,3075) = lu(k,3075) - lu(k,2280) * lu(k,3063) - lu(k,3076) = lu(k,3076) - lu(k,2281) * lu(k,3063) - lu(k,3077) = lu(k,3077) - lu(k,2282) * lu(k,3063) - lu(k,3078) = lu(k,3078) - lu(k,2283) * lu(k,3063) - lu(k,3080) = lu(k,3080) - lu(k,2284) * lu(k,3063) - lu(k,3082) = lu(k,3082) - lu(k,2285) * lu(k,3063) - lu(k,3084) = lu(k,3084) - lu(k,2286) * lu(k,3063) - lu(k,3085) = lu(k,3085) - lu(k,2287) * lu(k,3063) - lu(k,3087) = lu(k,3087) - lu(k,2288) * lu(k,3063) - lu(k,3088) = lu(k,3088) - lu(k,2289) * lu(k,3063) - lu(k,3092) = lu(k,3092) - lu(k,2290) * lu(k,3063) - lu(k,3270) = lu(k,3270) - lu(k,2272) * lu(k,3266) - lu(k,3271) = lu(k,3271) - lu(k,2273) * lu(k,3266) - lu(k,3272) = lu(k,3272) - lu(k,2274) * lu(k,3266) - lu(k,3273) = lu(k,3273) - lu(k,2275) * lu(k,3266) - lu(k,3274) = lu(k,3274) - lu(k,2276) * lu(k,3266) - lu(k,3275) = lu(k,3275) - lu(k,2277) * lu(k,3266) - lu(k,3276) = lu(k,3276) - lu(k,2278) * lu(k,3266) - lu(k,3277) = lu(k,3277) - lu(k,2279) * lu(k,3266) - lu(k,3278) = lu(k,3278) - lu(k,2280) * lu(k,3266) - lu(k,3279) = lu(k,3279) - lu(k,2281) * lu(k,3266) - lu(k,3280) = lu(k,3280) - lu(k,2282) * lu(k,3266) - lu(k,3281) = lu(k,3281) - lu(k,2283) * lu(k,3266) - lu(k,3283) = lu(k,3283) - lu(k,2284) * lu(k,3266) - lu(k,3285) = lu(k,3285) - lu(k,2285) * lu(k,3266) - lu(k,3287) = lu(k,3287) - lu(k,2286) * lu(k,3266) - lu(k,3288) = lu(k,3288) - lu(k,2287) * lu(k,3266) - lu(k,3290) = lu(k,3290) - lu(k,2288) * lu(k,3266) - lu(k,3291) = lu(k,3291) - lu(k,2289) * lu(k,3266) - lu(k,3295) = lu(k,3295) - lu(k,2290) * lu(k,3266) - lu(k,3411) = lu(k,3411) - lu(k,2272) * lu(k,3407) - lu(k,3412) = lu(k,3412) - lu(k,2273) * lu(k,3407) - lu(k,3413) = lu(k,3413) - lu(k,2274) * lu(k,3407) - lu(k,3414) = lu(k,3414) - lu(k,2275) * lu(k,3407) - lu(k,3415) = lu(k,3415) - lu(k,2276) * lu(k,3407) - lu(k,3416) = lu(k,3416) - lu(k,2277) * lu(k,3407) - lu(k,3417) = lu(k,3417) - lu(k,2278) * lu(k,3407) - lu(k,3418) = lu(k,3418) - lu(k,2279) * lu(k,3407) - lu(k,3419) = lu(k,3419) - lu(k,2280) * lu(k,3407) - lu(k,3420) = lu(k,3420) - lu(k,2281) * lu(k,3407) - lu(k,3421) = lu(k,3421) - lu(k,2282) * lu(k,3407) - lu(k,3422) = lu(k,3422) - lu(k,2283) * lu(k,3407) - lu(k,3424) = lu(k,3424) - lu(k,2284) * lu(k,3407) - lu(k,3426) = lu(k,3426) - lu(k,2285) * lu(k,3407) - lu(k,3428) = lu(k,3428) - lu(k,2286) * lu(k,3407) - lu(k,3429) = lu(k,3429) - lu(k,2287) * lu(k,3407) - lu(k,3431) = lu(k,3431) - lu(k,2288) * lu(k,3407) - lu(k,3432) = lu(k,3432) - lu(k,2289) * lu(k,3407) - lu(k,3436) = lu(k,3436) - lu(k,2290) * lu(k,3407) - lu(k,3731) = lu(k,3731) - lu(k,2272) * lu(k,3727) - lu(k,3732) = lu(k,3732) - lu(k,2273) * lu(k,3727) - lu(k,3733) = lu(k,3733) - lu(k,2274) * lu(k,3727) - lu(k,3734) = lu(k,3734) - lu(k,2275) * lu(k,3727) - lu(k,3735) = lu(k,3735) - lu(k,2276) * lu(k,3727) - lu(k,3736) = lu(k,3736) - lu(k,2277) * lu(k,3727) - lu(k,3737) = lu(k,3737) - lu(k,2278) * lu(k,3727) - lu(k,3738) = lu(k,3738) - lu(k,2279) * lu(k,3727) - lu(k,3739) = lu(k,3739) - lu(k,2280) * lu(k,3727) - lu(k,3740) = lu(k,3740) - lu(k,2281) * lu(k,3727) - lu(k,3741) = lu(k,3741) - lu(k,2282) * lu(k,3727) - lu(k,3742) = lu(k,3742) - lu(k,2283) * lu(k,3727) - lu(k,3744) = lu(k,3744) - lu(k,2284) * lu(k,3727) - lu(k,3746) = lu(k,3746) - lu(k,2285) * lu(k,3727) - lu(k,3748) = lu(k,3748) - lu(k,2286) * lu(k,3727) - lu(k,3749) = lu(k,3749) - lu(k,2287) * lu(k,3727) - lu(k,3751) = lu(k,3751) - lu(k,2288) * lu(k,3727) - lu(k,3752) = lu(k,3752) - lu(k,2289) * lu(k,3727) - lu(k,3756) = lu(k,3756) - lu(k,2290) * lu(k,3727) + lu(k,2213) = 1._r8 / lu(k,2213) + lu(k,2214) = lu(k,2214) * lu(k,2213) + lu(k,2215) = lu(k,2215) * lu(k,2213) + lu(k,2216) = lu(k,2216) * lu(k,2213) + lu(k,2217) = lu(k,2217) * lu(k,2213) + lu(k,2218) = lu(k,2218) * lu(k,2213) + lu(k,2219) = lu(k,2219) * lu(k,2213) + lu(k,2220) = lu(k,2220) * lu(k,2213) + lu(k,2221) = lu(k,2221) * lu(k,2213) + lu(k,2222) = lu(k,2222) * lu(k,2213) + lu(k,2223) = lu(k,2223) * lu(k,2213) + lu(k,2224) = lu(k,2224) * lu(k,2213) + lu(k,2225) = lu(k,2225) * lu(k,2213) + lu(k,2226) = lu(k,2226) * lu(k,2213) + lu(k,2227) = lu(k,2227) * lu(k,2213) + lu(k,2228) = lu(k,2228) * lu(k,2213) + lu(k,2229) = lu(k,2229) * lu(k,2213) + lu(k,2839) = lu(k,2839) - lu(k,2214) * lu(k,2834) + lu(k,2849) = lu(k,2849) - lu(k,2215) * lu(k,2834) + lu(k,2850) = lu(k,2850) - lu(k,2216) * lu(k,2834) + lu(k,2851) = lu(k,2851) - lu(k,2217) * lu(k,2834) + lu(k,2853) = lu(k,2853) - lu(k,2218) * lu(k,2834) + lu(k,2854) = lu(k,2854) - lu(k,2219) * lu(k,2834) + lu(k,2855) = lu(k,2855) - lu(k,2220) * lu(k,2834) + lu(k,2856) = lu(k,2856) - lu(k,2221) * lu(k,2834) + lu(k,2859) = lu(k,2859) - lu(k,2222) * lu(k,2834) + lu(k,2861) = lu(k,2861) - lu(k,2223) * lu(k,2834) + lu(k,2862) = lu(k,2862) - lu(k,2224) * lu(k,2834) + lu(k,2863) = lu(k,2863) - lu(k,2225) * lu(k,2834) + lu(k,2864) = lu(k,2864) - lu(k,2226) * lu(k,2834) + lu(k,2866) = lu(k,2866) - lu(k,2227) * lu(k,2834) + lu(k,2867) = lu(k,2867) - lu(k,2228) * lu(k,2834) + lu(k,2868) = lu(k,2868) - lu(k,2229) * lu(k,2834) + lu(k,2886) = lu(k,2886) - lu(k,2214) * lu(k,2881) + lu(k,2896) = lu(k,2896) - lu(k,2215) * lu(k,2881) + lu(k,2897) = lu(k,2897) - lu(k,2216) * lu(k,2881) + lu(k,2898) = lu(k,2898) - lu(k,2217) * lu(k,2881) + lu(k,2900) = lu(k,2900) - lu(k,2218) * lu(k,2881) + lu(k,2901) = lu(k,2901) - lu(k,2219) * lu(k,2881) + lu(k,2902) = lu(k,2902) - lu(k,2220) * lu(k,2881) + lu(k,2903) = lu(k,2903) - lu(k,2221) * lu(k,2881) + lu(k,2906) = lu(k,2906) - lu(k,2222) * lu(k,2881) + lu(k,2908) = lu(k,2908) - lu(k,2223) * lu(k,2881) + lu(k,2909) = lu(k,2909) - lu(k,2224) * lu(k,2881) + lu(k,2910) = lu(k,2910) - lu(k,2225) * lu(k,2881) + lu(k,2911) = lu(k,2911) - lu(k,2226) * lu(k,2881) + lu(k,2913) = lu(k,2913) - lu(k,2227) * lu(k,2881) + lu(k,2914) = lu(k,2914) - lu(k,2228) * lu(k,2881) + lu(k,2915) = lu(k,2915) - lu(k,2229) * lu(k,2881) + lu(k,2932) = lu(k,2932) - lu(k,2214) * lu(k,2927) + lu(k,2942) = lu(k,2942) - lu(k,2215) * lu(k,2927) + lu(k,2943) = lu(k,2943) - lu(k,2216) * lu(k,2927) + lu(k,2944) = lu(k,2944) - lu(k,2217) * lu(k,2927) + lu(k,2946) = lu(k,2946) - lu(k,2218) * lu(k,2927) + lu(k,2947) = lu(k,2947) - lu(k,2219) * lu(k,2927) + lu(k,2948) = lu(k,2948) - lu(k,2220) * lu(k,2927) + lu(k,2949) = lu(k,2949) - lu(k,2221) * lu(k,2927) + lu(k,2952) = lu(k,2952) - lu(k,2222) * lu(k,2927) + lu(k,2954) = lu(k,2954) - lu(k,2223) * lu(k,2927) + lu(k,2955) = lu(k,2955) - lu(k,2224) * lu(k,2927) + lu(k,2956) = lu(k,2956) - lu(k,2225) * lu(k,2927) + lu(k,2957) = lu(k,2957) - lu(k,2226) * lu(k,2927) + lu(k,2959) = lu(k,2959) - lu(k,2227) * lu(k,2927) + lu(k,2960) = lu(k,2960) - lu(k,2228) * lu(k,2927) + lu(k,2961) = lu(k,2961) - lu(k,2229) * lu(k,2927) + lu(k,3004) = lu(k,3004) - lu(k,2214) * lu(k,2998) + lu(k,3016) = lu(k,3016) - lu(k,2215) * lu(k,2998) + lu(k,3017) = lu(k,3017) - lu(k,2216) * lu(k,2998) + lu(k,3018) = lu(k,3018) - lu(k,2217) * lu(k,2998) + lu(k,3020) = lu(k,3020) - lu(k,2218) * lu(k,2998) + lu(k,3021) = lu(k,3021) - lu(k,2219) * lu(k,2998) + lu(k,3022) = lu(k,3022) - lu(k,2220) * lu(k,2998) + lu(k,3023) = lu(k,3023) - lu(k,2221) * lu(k,2998) + lu(k,3026) = lu(k,3026) - lu(k,2222) * lu(k,2998) + lu(k,3028) = lu(k,3028) - lu(k,2223) * lu(k,2998) + lu(k,3029) = lu(k,3029) - lu(k,2224) * lu(k,2998) + lu(k,3030) = lu(k,3030) - lu(k,2225) * lu(k,2998) + lu(k,3031) = lu(k,3031) - lu(k,2226) * lu(k,2998) + lu(k,3033) = lu(k,3033) - lu(k,2227) * lu(k,2998) + lu(k,3034) = lu(k,3034) - lu(k,2228) * lu(k,2998) + lu(k,3035) = lu(k,3035) - lu(k,2229) * lu(k,2998) + lu(k,3105) = lu(k,3105) - lu(k,2214) * lu(k,3100) + lu(k,3119) = lu(k,3119) - lu(k,2215) * lu(k,3100) + lu(k,3120) = lu(k,3120) - lu(k,2216) * lu(k,3100) + lu(k,3121) = lu(k,3121) - lu(k,2217) * lu(k,3100) + lu(k,3123) = lu(k,3123) - lu(k,2218) * lu(k,3100) + lu(k,3124) = lu(k,3124) - lu(k,2219) * lu(k,3100) + lu(k,3125) = lu(k,3125) - lu(k,2220) * lu(k,3100) + lu(k,3126) = lu(k,3126) - lu(k,2221) * lu(k,3100) + lu(k,3129) = lu(k,3129) - lu(k,2222) * lu(k,3100) + lu(k,3131) = lu(k,3131) - lu(k,2223) * lu(k,3100) + lu(k,3132) = lu(k,3132) - lu(k,2224) * lu(k,3100) + lu(k,3133) = lu(k,3133) - lu(k,2225) * lu(k,3100) + lu(k,3134) = lu(k,3134) - lu(k,2226) * lu(k,3100) + lu(k,3136) = lu(k,3136) - lu(k,2227) * lu(k,3100) + lu(k,3137) = lu(k,3137) - lu(k,2228) * lu(k,3100) + lu(k,3138) = lu(k,3138) - lu(k,2229) * lu(k,3100) + lu(k,3287) = lu(k,3287) - lu(k,2214) * lu(k,3281) + lu(k,3301) = lu(k,3301) - lu(k,2215) * lu(k,3281) + lu(k,3302) = lu(k,3302) - lu(k,2216) * lu(k,3281) + lu(k,3303) = lu(k,3303) - lu(k,2217) * lu(k,3281) + lu(k,3305) = lu(k,3305) - lu(k,2218) * lu(k,3281) + lu(k,3306) = lu(k,3306) - lu(k,2219) * lu(k,3281) + lu(k,3307) = lu(k,3307) - lu(k,2220) * lu(k,3281) + lu(k,3308) = lu(k,3308) - lu(k,2221) * lu(k,3281) + lu(k,3311) = lu(k,3311) - lu(k,2222) * lu(k,3281) + lu(k,3313) = lu(k,3313) - lu(k,2223) * lu(k,3281) + lu(k,3314) = lu(k,3314) - lu(k,2224) * lu(k,3281) + lu(k,3315) = lu(k,3315) - lu(k,2225) * lu(k,3281) + lu(k,3316) = lu(k,3316) - lu(k,2226) * lu(k,3281) + lu(k,3318) = lu(k,3318) - lu(k,2227) * lu(k,3281) + lu(k,3319) = lu(k,3319) - lu(k,2228) * lu(k,3281) + lu(k,3320) = lu(k,3320) - lu(k,2229) * lu(k,3281) + lu(k,3543) = lu(k,3543) - lu(k,2214) * lu(k,3537) + lu(k,3557) = lu(k,3557) - lu(k,2215) * lu(k,3537) + lu(k,3558) = lu(k,3558) - lu(k,2216) * lu(k,3537) + lu(k,3559) = lu(k,3559) - lu(k,2217) * lu(k,3537) + lu(k,3561) = lu(k,3561) - lu(k,2218) * lu(k,3537) + lu(k,3562) = lu(k,3562) - lu(k,2219) * lu(k,3537) + lu(k,3563) = lu(k,3563) - lu(k,2220) * lu(k,3537) + lu(k,3564) = lu(k,3564) - lu(k,2221) * lu(k,3537) + lu(k,3567) = lu(k,3567) - lu(k,2222) * lu(k,3537) + lu(k,3569) = lu(k,3569) - lu(k,2223) * lu(k,3537) + lu(k,3570) = lu(k,3570) - lu(k,2224) * lu(k,3537) + lu(k,3571) = lu(k,3571) - lu(k,2225) * lu(k,3537) + lu(k,3572) = lu(k,3572) - lu(k,2226) * lu(k,3537) + lu(k,3574) = lu(k,3574) - lu(k,2227) * lu(k,3537) + lu(k,3575) = lu(k,3575) - lu(k,2228) * lu(k,3537) + lu(k,3576) = lu(k,3576) - lu(k,2229) * lu(k,3537) + lu(k,3793) = lu(k,3793) - lu(k,2214) * lu(k,3788) + lu(k,3807) = lu(k,3807) - lu(k,2215) * lu(k,3788) + lu(k,3808) = lu(k,3808) - lu(k,2216) * lu(k,3788) + lu(k,3809) = lu(k,3809) - lu(k,2217) * lu(k,3788) + lu(k,3811) = lu(k,3811) - lu(k,2218) * lu(k,3788) + lu(k,3812) = lu(k,3812) - lu(k,2219) * lu(k,3788) + lu(k,3813) = lu(k,3813) - lu(k,2220) * lu(k,3788) + lu(k,3814) = lu(k,3814) - lu(k,2221) * lu(k,3788) + lu(k,3817) = lu(k,3817) - lu(k,2222) * lu(k,3788) + lu(k,3819) = lu(k,3819) - lu(k,2223) * lu(k,3788) + lu(k,3820) = lu(k,3820) - lu(k,2224) * lu(k,3788) + lu(k,3821) = lu(k,3821) - lu(k,2225) * lu(k,3788) + lu(k,3822) = lu(k,3822) - lu(k,2226) * lu(k,3788) + lu(k,3824) = lu(k,3824) - lu(k,2227) * lu(k,3788) + lu(k,3825) = lu(k,3825) - lu(k,2228) * lu(k,3788) + lu(k,3826) = lu(k,3826) - lu(k,2229) * lu(k,3788) + lu(k,3928) = lu(k,3928) - lu(k,2214) * lu(k,3922) + lu(k,3942) = lu(k,3942) - lu(k,2215) * lu(k,3922) + lu(k,3943) = lu(k,3943) - lu(k,2216) * lu(k,3922) + lu(k,3944) = lu(k,3944) - lu(k,2217) * lu(k,3922) + lu(k,3946) = lu(k,3946) - lu(k,2218) * lu(k,3922) + lu(k,3947) = lu(k,3947) - lu(k,2219) * lu(k,3922) + lu(k,3948) = lu(k,3948) - lu(k,2220) * lu(k,3922) + lu(k,3949) = lu(k,3949) - lu(k,2221) * lu(k,3922) + lu(k,3952) = lu(k,3952) - lu(k,2222) * lu(k,3922) + lu(k,3954) = lu(k,3954) - lu(k,2223) * lu(k,3922) + lu(k,3955) = lu(k,3955) - lu(k,2224) * lu(k,3922) + lu(k,3956) = lu(k,3956) - lu(k,2225) * lu(k,3922) + lu(k,3957) = lu(k,3957) - lu(k,2226) * lu(k,3922) + lu(k,3959) = lu(k,3959) - lu(k,2227) * lu(k,3922) + lu(k,3960) = lu(k,3960) - lu(k,2228) * lu(k,3922) + lu(k,3961) = lu(k,3961) - lu(k,2229) * lu(k,3922) + lu(k,4021) = lu(k,4021) - lu(k,2214) * lu(k,4015) + lu(k,4034) = lu(k,4034) - lu(k,2215) * lu(k,4015) + lu(k,4035) = lu(k,4035) - lu(k,2216) * lu(k,4015) + lu(k,4036) = lu(k,4036) - lu(k,2217) * lu(k,4015) + lu(k,4038) = lu(k,4038) - lu(k,2218) * lu(k,4015) + lu(k,4039) = lu(k,4039) - lu(k,2219) * lu(k,4015) + lu(k,4040) = lu(k,4040) - lu(k,2220) * lu(k,4015) + lu(k,4041) = lu(k,4041) - lu(k,2221) * lu(k,4015) + lu(k,4044) = lu(k,4044) - lu(k,2222) * lu(k,4015) + lu(k,4046) = lu(k,4046) - lu(k,2223) * lu(k,4015) + lu(k,4047) = lu(k,4047) - lu(k,2224) * lu(k,4015) + lu(k,4048) = lu(k,4048) - lu(k,2225) * lu(k,4015) + lu(k,4049) = lu(k,4049) - lu(k,2226) * lu(k,4015) + lu(k,4051) = lu(k,4051) - lu(k,2227) * lu(k,4015) + lu(k,4052) = lu(k,4052) - lu(k,2228) * lu(k,4015) + lu(k,4053) = lu(k,4053) - lu(k,2229) * lu(k,4015) + lu(k,2235) = 1._r8 / lu(k,2235) + lu(k,2236) = lu(k,2236) * lu(k,2235) + lu(k,2237) = lu(k,2237) * lu(k,2235) + lu(k,2238) = lu(k,2238) * lu(k,2235) + lu(k,2239) = lu(k,2239) * lu(k,2235) + lu(k,2240) = lu(k,2240) * lu(k,2235) + lu(k,2241) = lu(k,2241) * lu(k,2235) + lu(k,2242) = lu(k,2242) * lu(k,2235) + lu(k,2243) = lu(k,2243) * lu(k,2235) + lu(k,2244) = lu(k,2244) * lu(k,2235) + lu(k,2245) = lu(k,2245) * lu(k,2235) + lu(k,2246) = lu(k,2246) * lu(k,2235) + lu(k,2247) = lu(k,2247) * lu(k,2235) + lu(k,2248) = lu(k,2248) * lu(k,2235) + lu(k,2249) = lu(k,2249) * lu(k,2235) + lu(k,2250) = lu(k,2250) * lu(k,2235) + lu(k,2251) = lu(k,2251) * lu(k,2235) + lu(k,2252) = lu(k,2252) * lu(k,2235) + lu(k,2253) = lu(k,2253) * lu(k,2235) + lu(k,2771) = - lu(k,2236) * lu(k,2770) + lu(k,2772) = lu(k,2772) - lu(k,2237) * lu(k,2770) + lu(k,2773) = lu(k,2773) - lu(k,2238) * lu(k,2770) + lu(k,2774) = lu(k,2774) - lu(k,2239) * lu(k,2770) + lu(k,2775) = lu(k,2775) - lu(k,2240) * lu(k,2770) + lu(k,2776) = lu(k,2776) - lu(k,2241) * lu(k,2770) + lu(k,2777) = lu(k,2777) - lu(k,2242) * lu(k,2770) + lu(k,2778) = lu(k,2778) - lu(k,2243) * lu(k,2770) + lu(k,2779) = lu(k,2779) - lu(k,2244) * lu(k,2770) + lu(k,2780) = lu(k,2780) - lu(k,2245) * lu(k,2770) + lu(k,2781) = lu(k,2781) - lu(k,2246) * lu(k,2770) + lu(k,2782) = lu(k,2782) - lu(k,2247) * lu(k,2770) + lu(k,2783) = lu(k,2783) - lu(k,2248) * lu(k,2770) + lu(k,2784) = lu(k,2784) - lu(k,2249) * lu(k,2770) + lu(k,2785) = lu(k,2785) - lu(k,2250) * lu(k,2770) + lu(k,2786) = lu(k,2786) - lu(k,2251) * lu(k,2770) + lu(k,2787) = lu(k,2787) - lu(k,2252) * lu(k,2770) + lu(k,2788) = lu(k,2788) - lu(k,2253) * lu(k,2770) + lu(k,2836) = lu(k,2836) - lu(k,2236) * lu(k,2835) + lu(k,2840) = lu(k,2840) - lu(k,2237) * lu(k,2835) + lu(k,2849) = lu(k,2849) - lu(k,2238) * lu(k,2835) + lu(k,2850) = lu(k,2850) - lu(k,2239) * lu(k,2835) + lu(k,2851) = lu(k,2851) - lu(k,2240) * lu(k,2835) + lu(k,2853) = lu(k,2853) - lu(k,2241) * lu(k,2835) + lu(k,2854) = lu(k,2854) - lu(k,2242) * lu(k,2835) + lu(k,2855) = lu(k,2855) - lu(k,2243) * lu(k,2835) + lu(k,2856) = lu(k,2856) - lu(k,2244) * lu(k,2835) + lu(k,2859) = lu(k,2859) - lu(k,2245) * lu(k,2835) + lu(k,2860) = lu(k,2860) - lu(k,2246) * lu(k,2835) + lu(k,2861) = lu(k,2861) - lu(k,2247) * lu(k,2835) + lu(k,2862) = lu(k,2862) - lu(k,2248) * lu(k,2835) + lu(k,2863) = lu(k,2863) - lu(k,2249) * lu(k,2835) + lu(k,2864) = lu(k,2864) - lu(k,2250) * lu(k,2835) + lu(k,2866) = lu(k,2866) - lu(k,2251) * lu(k,2835) + lu(k,2867) = lu(k,2867) - lu(k,2252) * lu(k,2835) + lu(k,2868) = lu(k,2868) - lu(k,2253) * lu(k,2835) + lu(k,2883) = lu(k,2883) - lu(k,2236) * lu(k,2882) + lu(k,2887) = lu(k,2887) - lu(k,2237) * lu(k,2882) + lu(k,2896) = lu(k,2896) - lu(k,2238) * lu(k,2882) + lu(k,2897) = lu(k,2897) - lu(k,2239) * lu(k,2882) + lu(k,2898) = lu(k,2898) - lu(k,2240) * lu(k,2882) + lu(k,2900) = lu(k,2900) - lu(k,2241) * lu(k,2882) + lu(k,2901) = lu(k,2901) - lu(k,2242) * lu(k,2882) + lu(k,2902) = lu(k,2902) - lu(k,2243) * lu(k,2882) + lu(k,2903) = lu(k,2903) - lu(k,2244) * lu(k,2882) + lu(k,2906) = lu(k,2906) - lu(k,2245) * lu(k,2882) + lu(k,2907) = lu(k,2907) - lu(k,2246) * lu(k,2882) + lu(k,2908) = lu(k,2908) - lu(k,2247) * lu(k,2882) + lu(k,2909) = lu(k,2909) - lu(k,2248) * lu(k,2882) + lu(k,2910) = lu(k,2910) - lu(k,2249) * lu(k,2882) + lu(k,2911) = lu(k,2911) - lu(k,2250) * lu(k,2882) + lu(k,2913) = lu(k,2913) - lu(k,2251) * lu(k,2882) + lu(k,2914) = lu(k,2914) - lu(k,2252) * lu(k,2882) + lu(k,2915) = lu(k,2915) - lu(k,2253) * lu(k,2882) + lu(k,2929) = lu(k,2929) - lu(k,2236) * lu(k,2928) + lu(k,2933) = lu(k,2933) - lu(k,2237) * lu(k,2928) + lu(k,2942) = lu(k,2942) - lu(k,2238) * lu(k,2928) + lu(k,2943) = lu(k,2943) - lu(k,2239) * lu(k,2928) + lu(k,2944) = lu(k,2944) - lu(k,2240) * lu(k,2928) + lu(k,2946) = lu(k,2946) - lu(k,2241) * lu(k,2928) + lu(k,2947) = lu(k,2947) - lu(k,2242) * lu(k,2928) + lu(k,2948) = lu(k,2948) - lu(k,2243) * lu(k,2928) + lu(k,2949) = lu(k,2949) - lu(k,2244) * lu(k,2928) + lu(k,2952) = lu(k,2952) - lu(k,2245) * lu(k,2928) + lu(k,2953) = lu(k,2953) - lu(k,2246) * lu(k,2928) + lu(k,2954) = lu(k,2954) - lu(k,2247) * lu(k,2928) + lu(k,2955) = lu(k,2955) - lu(k,2248) * lu(k,2928) + lu(k,2956) = lu(k,2956) - lu(k,2249) * lu(k,2928) + lu(k,2957) = lu(k,2957) - lu(k,2250) * lu(k,2928) + lu(k,2959) = lu(k,2959) - lu(k,2251) * lu(k,2928) + lu(k,2960) = lu(k,2960) - lu(k,2252) * lu(k,2928) + lu(k,2961) = lu(k,2961) - lu(k,2253) * lu(k,2928) + lu(k,3001) = lu(k,3001) - lu(k,2236) * lu(k,2999) + lu(k,3005) = lu(k,3005) - lu(k,2237) * lu(k,2999) + lu(k,3016) = lu(k,3016) - lu(k,2238) * lu(k,2999) + lu(k,3017) = lu(k,3017) - lu(k,2239) * lu(k,2999) + lu(k,3018) = lu(k,3018) - lu(k,2240) * lu(k,2999) + lu(k,3020) = lu(k,3020) - lu(k,2241) * lu(k,2999) + lu(k,3021) = lu(k,3021) - lu(k,2242) * lu(k,2999) + lu(k,3022) = lu(k,3022) - lu(k,2243) * lu(k,2999) + lu(k,3023) = lu(k,3023) - lu(k,2244) * lu(k,2999) + lu(k,3026) = lu(k,3026) - lu(k,2245) * lu(k,2999) + lu(k,3027) = lu(k,3027) - lu(k,2246) * lu(k,2999) + lu(k,3028) = lu(k,3028) - lu(k,2247) * lu(k,2999) + lu(k,3029) = lu(k,3029) - lu(k,2248) * lu(k,2999) + lu(k,3030) = lu(k,3030) - lu(k,2249) * lu(k,2999) + lu(k,3031) = lu(k,3031) - lu(k,2250) * lu(k,2999) + lu(k,3033) = lu(k,3033) - lu(k,2251) * lu(k,2999) + lu(k,3034) = lu(k,3034) - lu(k,2252) * lu(k,2999) + lu(k,3035) = lu(k,3035) - lu(k,2253) * lu(k,2999) + lu(k,3284) = lu(k,3284) - lu(k,2236) * lu(k,3282) + lu(k,3288) = lu(k,3288) - lu(k,2237) * lu(k,3282) + lu(k,3301) = lu(k,3301) - lu(k,2238) * lu(k,3282) + lu(k,3302) = lu(k,3302) - lu(k,2239) * lu(k,3282) + lu(k,3303) = lu(k,3303) - lu(k,2240) * lu(k,3282) + lu(k,3305) = lu(k,3305) - lu(k,2241) * lu(k,3282) + lu(k,3306) = lu(k,3306) - lu(k,2242) * lu(k,3282) + lu(k,3307) = lu(k,3307) - lu(k,2243) * lu(k,3282) + lu(k,3308) = lu(k,3308) - lu(k,2244) * lu(k,3282) + lu(k,3311) = lu(k,3311) - lu(k,2245) * lu(k,3282) + lu(k,3312) = lu(k,3312) - lu(k,2246) * lu(k,3282) + lu(k,3313) = lu(k,3313) - lu(k,2247) * lu(k,3282) + lu(k,3314) = lu(k,3314) - lu(k,2248) * lu(k,3282) + lu(k,3315) = lu(k,3315) - lu(k,2249) * lu(k,3282) + lu(k,3316) = lu(k,3316) - lu(k,2250) * lu(k,3282) + lu(k,3318) = lu(k,3318) - lu(k,2251) * lu(k,3282) + lu(k,3319) = lu(k,3319) - lu(k,2252) * lu(k,3282) + lu(k,3320) = lu(k,3320) - lu(k,2253) * lu(k,3282) + lu(k,3540) = lu(k,3540) - lu(k,2236) * lu(k,3538) + lu(k,3544) = lu(k,3544) - lu(k,2237) * lu(k,3538) + lu(k,3557) = lu(k,3557) - lu(k,2238) * lu(k,3538) + lu(k,3558) = lu(k,3558) - lu(k,2239) * lu(k,3538) + lu(k,3559) = lu(k,3559) - lu(k,2240) * lu(k,3538) + lu(k,3561) = lu(k,3561) - lu(k,2241) * lu(k,3538) + lu(k,3562) = lu(k,3562) - lu(k,2242) * lu(k,3538) + lu(k,3563) = lu(k,3563) - lu(k,2243) * lu(k,3538) + lu(k,3564) = lu(k,3564) - lu(k,2244) * lu(k,3538) + lu(k,3567) = lu(k,3567) - lu(k,2245) * lu(k,3538) + lu(k,3568) = lu(k,3568) - lu(k,2246) * lu(k,3538) + lu(k,3569) = lu(k,3569) - lu(k,2247) * lu(k,3538) + lu(k,3570) = lu(k,3570) - lu(k,2248) * lu(k,3538) + lu(k,3571) = lu(k,3571) - lu(k,2249) * lu(k,3538) + lu(k,3572) = lu(k,3572) - lu(k,2250) * lu(k,3538) + lu(k,3574) = lu(k,3574) - lu(k,2251) * lu(k,3538) + lu(k,3575) = lu(k,3575) - lu(k,2252) * lu(k,3538) + lu(k,3576) = lu(k,3576) - lu(k,2253) * lu(k,3538) + lu(k,3925) = lu(k,3925) - lu(k,2236) * lu(k,3923) + lu(k,3929) = lu(k,3929) - lu(k,2237) * lu(k,3923) + lu(k,3942) = lu(k,3942) - lu(k,2238) * lu(k,3923) + lu(k,3943) = lu(k,3943) - lu(k,2239) * lu(k,3923) + lu(k,3944) = lu(k,3944) - lu(k,2240) * lu(k,3923) + lu(k,3946) = lu(k,3946) - lu(k,2241) * lu(k,3923) + lu(k,3947) = lu(k,3947) - lu(k,2242) * lu(k,3923) + lu(k,3948) = lu(k,3948) - lu(k,2243) * lu(k,3923) + lu(k,3949) = lu(k,3949) - lu(k,2244) * lu(k,3923) + lu(k,3952) = lu(k,3952) - lu(k,2245) * lu(k,3923) + lu(k,3953) = lu(k,3953) - lu(k,2246) * lu(k,3923) + lu(k,3954) = lu(k,3954) - lu(k,2247) * lu(k,3923) + lu(k,3955) = lu(k,3955) - lu(k,2248) * lu(k,3923) + lu(k,3956) = lu(k,3956) - lu(k,2249) * lu(k,3923) + lu(k,3957) = lu(k,3957) - lu(k,2250) * lu(k,3923) + lu(k,3959) = lu(k,3959) - lu(k,2251) * lu(k,3923) + lu(k,3960) = lu(k,3960) - lu(k,2252) * lu(k,3923) + lu(k,3961) = lu(k,3961) - lu(k,2253) * lu(k,3923) + lu(k,4018) = lu(k,4018) - lu(k,2236) * lu(k,4016) + lu(k,4022) = lu(k,4022) - lu(k,2237) * lu(k,4016) + lu(k,4034) = lu(k,4034) - lu(k,2238) * lu(k,4016) + lu(k,4035) = lu(k,4035) - lu(k,2239) * lu(k,4016) + lu(k,4036) = lu(k,4036) - lu(k,2240) * lu(k,4016) + lu(k,4038) = lu(k,4038) - lu(k,2241) * lu(k,4016) + lu(k,4039) = lu(k,4039) - lu(k,2242) * lu(k,4016) + lu(k,4040) = lu(k,4040) - lu(k,2243) * lu(k,4016) + lu(k,4041) = lu(k,4041) - lu(k,2244) * lu(k,4016) + lu(k,4044) = lu(k,4044) - lu(k,2245) * lu(k,4016) + lu(k,4045) = lu(k,4045) - lu(k,2246) * lu(k,4016) + lu(k,4046) = lu(k,4046) - lu(k,2247) * lu(k,4016) + lu(k,4047) = lu(k,4047) - lu(k,2248) * lu(k,4016) + lu(k,4048) = lu(k,4048) - lu(k,2249) * lu(k,4016) + lu(k,4049) = lu(k,4049) - lu(k,2250) * lu(k,4016) + lu(k,4051) = lu(k,4051) - lu(k,2251) * lu(k,4016) + lu(k,4052) = lu(k,4052) - lu(k,2252) * lu(k,4016) + lu(k,4053) = lu(k,4053) - lu(k,2253) * lu(k,4016) + lu(k,2259) = 1._r8 / lu(k,2259) + lu(k,2260) = lu(k,2260) * lu(k,2259) + lu(k,2261) = lu(k,2261) * lu(k,2259) + lu(k,2262) = lu(k,2262) * lu(k,2259) + lu(k,2263) = lu(k,2263) * lu(k,2259) + lu(k,2264) = lu(k,2264) * lu(k,2259) + lu(k,2265) = lu(k,2265) * lu(k,2259) + lu(k,2266) = lu(k,2266) * lu(k,2259) + lu(k,2267) = lu(k,2267) * lu(k,2259) + lu(k,2268) = lu(k,2268) * lu(k,2259) + lu(k,2269) = lu(k,2269) * lu(k,2259) + lu(k,2270) = lu(k,2270) * lu(k,2259) + lu(k,2271) = lu(k,2271) * lu(k,2259) + lu(k,2573) = lu(k,2573) - lu(k,2260) * lu(k,2572) + lu(k,2574) = lu(k,2574) - lu(k,2261) * lu(k,2572) + lu(k,2576) = lu(k,2576) - lu(k,2262) * lu(k,2572) + lu(k,2577) = lu(k,2577) - lu(k,2263) * lu(k,2572) + lu(k,2578) = - lu(k,2264) * lu(k,2572) + lu(k,2579) = lu(k,2579) - lu(k,2265) * lu(k,2572) + lu(k,2580) = lu(k,2580) - lu(k,2266) * lu(k,2572) + lu(k,2581) = lu(k,2581) - lu(k,2267) * lu(k,2572) + lu(k,2582) = lu(k,2582) - lu(k,2268) * lu(k,2572) + lu(k,2583) = lu(k,2583) - lu(k,2269) * lu(k,2572) + lu(k,2584) = lu(k,2584) - lu(k,2270) * lu(k,2572) + lu(k,2585) = lu(k,2585) - lu(k,2271) * lu(k,2572) + lu(k,2637) = lu(k,2637) - lu(k,2260) * lu(k,2635) + lu(k,2639) = lu(k,2639) - lu(k,2261) * lu(k,2635) + lu(k,2641) = lu(k,2641) - lu(k,2262) * lu(k,2635) + lu(k,2643) = lu(k,2643) - lu(k,2263) * lu(k,2635) + lu(k,2644) = lu(k,2644) - lu(k,2264) * lu(k,2635) + lu(k,2645) = lu(k,2645) - lu(k,2265) * lu(k,2635) + lu(k,2646) = lu(k,2646) - lu(k,2266) * lu(k,2635) + lu(k,2647) = lu(k,2647) - lu(k,2267) * lu(k,2635) + lu(k,2648) = lu(k,2648) - lu(k,2268) * lu(k,2635) + lu(k,2649) = lu(k,2649) - lu(k,2269) * lu(k,2635) + lu(k,2650) = lu(k,2650) - lu(k,2270) * lu(k,2635) + lu(k,2652) = lu(k,2652) - lu(k,2271) * lu(k,2635) + lu(k,3012) = - lu(k,2260) * lu(k,3000) + lu(k,3013) = - lu(k,2261) * lu(k,3000) + lu(k,3025) = lu(k,3025) - lu(k,2262) * lu(k,3000) + lu(k,3027) = lu(k,3027) - lu(k,2263) * lu(k,3000) + lu(k,3028) = lu(k,3028) - lu(k,2264) * lu(k,3000) + lu(k,3029) = lu(k,3029) - lu(k,2265) * lu(k,3000) + lu(k,3030) = lu(k,3030) - lu(k,2266) * lu(k,3000) + lu(k,3031) = lu(k,3031) - lu(k,2267) * lu(k,3000) + lu(k,3032) = lu(k,3032) - lu(k,2268) * lu(k,3000) + lu(k,3033) = lu(k,3033) - lu(k,2269) * lu(k,3000) + lu(k,3034) = lu(k,3034) - lu(k,2270) * lu(k,3000) + lu(k,3036) = lu(k,3036) - lu(k,2271) * lu(k,3000) + lu(k,3114) = lu(k,3114) - lu(k,2260) * lu(k,3101) + lu(k,3116) = lu(k,3116) - lu(k,2261) * lu(k,3101) + lu(k,3128) = lu(k,3128) - lu(k,2262) * lu(k,3101) + lu(k,3130) = lu(k,3130) - lu(k,2263) * lu(k,3101) + lu(k,3131) = lu(k,3131) - lu(k,2264) * lu(k,3101) + lu(k,3132) = lu(k,3132) - lu(k,2265) * lu(k,3101) + lu(k,3133) = lu(k,3133) - lu(k,2266) * lu(k,3101) + lu(k,3134) = lu(k,3134) - lu(k,2267) * lu(k,3101) + lu(k,3135) = lu(k,3135) - lu(k,2268) * lu(k,3101) + lu(k,3136) = lu(k,3136) - lu(k,2269) * lu(k,3101) + lu(k,3137) = lu(k,3137) - lu(k,2270) * lu(k,3101) + lu(k,3139) = lu(k,3139) - lu(k,2271) * lu(k,3101) + lu(k,3296) = lu(k,3296) - lu(k,2260) * lu(k,3283) + lu(k,3298) = lu(k,3298) - lu(k,2261) * lu(k,3283) + lu(k,3310) = lu(k,3310) - lu(k,2262) * lu(k,3283) + lu(k,3312) = lu(k,3312) - lu(k,2263) * lu(k,3283) + lu(k,3313) = lu(k,3313) - lu(k,2264) * lu(k,3283) + lu(k,3314) = lu(k,3314) - lu(k,2265) * lu(k,3283) + lu(k,3315) = lu(k,3315) - lu(k,2266) * lu(k,3283) + lu(k,3316) = lu(k,3316) - lu(k,2267) * lu(k,3283) + lu(k,3317) = lu(k,3317) - lu(k,2268) * lu(k,3283) + lu(k,3318) = lu(k,3318) - lu(k,2269) * lu(k,3283) + lu(k,3319) = lu(k,3319) - lu(k,2270) * lu(k,3283) + lu(k,3321) = lu(k,3321) - lu(k,2271) * lu(k,3283) + lu(k,3326) = lu(k,3326) - lu(k,2260) * lu(k,3325) + lu(k,3327) = lu(k,3327) - lu(k,2261) * lu(k,3325) + lu(k,3329) = lu(k,3329) - lu(k,2262) * lu(k,3325) + lu(k,3331) = lu(k,3331) - lu(k,2263) * lu(k,3325) + lu(k,3332) = - lu(k,2264) * lu(k,3325) + lu(k,3333) = lu(k,3333) - lu(k,2265) * lu(k,3325) + lu(k,3334) = - lu(k,2266) * lu(k,3325) + lu(k,3335) = lu(k,3335) - lu(k,2267) * lu(k,3325) + lu(k,3336) = lu(k,3336) - lu(k,2268) * lu(k,3325) + lu(k,3337) = lu(k,3337) - lu(k,2269) * lu(k,3325) + lu(k,3338) = lu(k,3338) - lu(k,2270) * lu(k,3325) + lu(k,3340) = lu(k,3340) - lu(k,2271) * lu(k,3325) + lu(k,3351) = lu(k,3351) - lu(k,2260) * lu(k,3349) + lu(k,3353) = lu(k,3353) - lu(k,2261) * lu(k,3349) + lu(k,3355) = lu(k,3355) - lu(k,2262) * lu(k,3349) + lu(k,3357) = lu(k,3357) - lu(k,2263) * lu(k,3349) + lu(k,3358) = lu(k,3358) - lu(k,2264) * lu(k,3349) + lu(k,3359) = lu(k,3359) - lu(k,2265) * lu(k,3349) + lu(k,3360) = lu(k,3360) - lu(k,2266) * lu(k,3349) + lu(k,3361) = lu(k,3361) - lu(k,2267) * lu(k,3349) + lu(k,3362) = lu(k,3362) - lu(k,2268) * lu(k,3349) + lu(k,3363) = lu(k,3363) - lu(k,2269) * lu(k,3349) + lu(k,3364) = lu(k,3364) - lu(k,2270) * lu(k,3349) + lu(k,3366) = lu(k,3366) - lu(k,2271) * lu(k,3349) + lu(k,3382) = lu(k,3382) - lu(k,2260) * lu(k,3380) + lu(k,3384) = lu(k,3384) - lu(k,2261) * lu(k,3380) + lu(k,3386) = lu(k,3386) - lu(k,2262) * lu(k,3380) + lu(k,3388) = lu(k,3388) - lu(k,2263) * lu(k,3380) + lu(k,3389) = lu(k,3389) - lu(k,2264) * lu(k,3380) + lu(k,3390) = lu(k,3390) - lu(k,2265) * lu(k,3380) + lu(k,3391) = lu(k,3391) - lu(k,2266) * lu(k,3380) + lu(k,3392) = lu(k,3392) - lu(k,2267) * lu(k,3380) + lu(k,3393) = lu(k,3393) - lu(k,2268) * lu(k,3380) + lu(k,3394) = lu(k,3394) - lu(k,2269) * lu(k,3380) + lu(k,3395) = lu(k,3395) - lu(k,2270) * lu(k,3380) + lu(k,3397) = lu(k,3397) - lu(k,2271) * lu(k,3380) + lu(k,3552) = lu(k,3552) - lu(k,2260) * lu(k,3539) + lu(k,3554) = lu(k,3554) - lu(k,2261) * lu(k,3539) + lu(k,3566) = lu(k,3566) - lu(k,2262) * lu(k,3539) + lu(k,3568) = lu(k,3568) - lu(k,2263) * lu(k,3539) + lu(k,3569) = lu(k,3569) - lu(k,2264) * lu(k,3539) + lu(k,3570) = lu(k,3570) - lu(k,2265) * lu(k,3539) + lu(k,3571) = lu(k,3571) - lu(k,2266) * lu(k,3539) + lu(k,3572) = lu(k,3572) - lu(k,2267) * lu(k,3539) + lu(k,3573) = lu(k,3573) - lu(k,2268) * lu(k,3539) + lu(k,3574) = lu(k,3574) - lu(k,2269) * lu(k,3539) + lu(k,3575) = lu(k,3575) - lu(k,2270) * lu(k,3539) + lu(k,3577) = lu(k,3577) - lu(k,2271) * lu(k,3539) + lu(k,3802) = lu(k,3802) - lu(k,2260) * lu(k,3789) + lu(k,3804) = lu(k,3804) - lu(k,2261) * lu(k,3789) + lu(k,3816) = lu(k,3816) - lu(k,2262) * lu(k,3789) + lu(k,3818) = lu(k,3818) - lu(k,2263) * lu(k,3789) + lu(k,3819) = lu(k,3819) - lu(k,2264) * lu(k,3789) + lu(k,3820) = lu(k,3820) - lu(k,2265) * lu(k,3789) + lu(k,3821) = lu(k,3821) - lu(k,2266) * lu(k,3789) + lu(k,3822) = lu(k,3822) - lu(k,2267) * lu(k,3789) + lu(k,3823) = lu(k,3823) - lu(k,2268) * lu(k,3789) + lu(k,3824) = lu(k,3824) - lu(k,2269) * lu(k,3789) + lu(k,3825) = lu(k,3825) - lu(k,2270) * lu(k,3789) + lu(k,3827) = lu(k,3827) - lu(k,2271) * lu(k,3789) + lu(k,3852) = lu(k,3852) - lu(k,2260) * lu(k,3850) + lu(k,3854) = lu(k,3854) - lu(k,2261) * lu(k,3850) + lu(k,3857) = lu(k,3857) - lu(k,2262) * lu(k,3850) + lu(k,3859) = lu(k,3859) - lu(k,2263) * lu(k,3850) + lu(k,3860) = lu(k,3860) - lu(k,2264) * lu(k,3850) + lu(k,3861) = lu(k,3861) - lu(k,2265) * lu(k,3850) + lu(k,3862) = lu(k,3862) - lu(k,2266) * lu(k,3850) + lu(k,3863) = lu(k,3863) - lu(k,2267) * lu(k,3850) + lu(k,3864) = lu(k,3864) - lu(k,2268) * lu(k,3850) + lu(k,3865) = lu(k,3865) - lu(k,2269) * lu(k,3850) + lu(k,3866) = lu(k,3866) - lu(k,2270) * lu(k,3850) + lu(k,3868) = lu(k,3868) - lu(k,2271) * lu(k,3850) + lu(k,3937) = lu(k,3937) - lu(k,2260) * lu(k,3924) + lu(k,3939) = lu(k,3939) - lu(k,2261) * lu(k,3924) + lu(k,3951) = lu(k,3951) - lu(k,2262) * lu(k,3924) + lu(k,3953) = lu(k,3953) - lu(k,2263) * lu(k,3924) + lu(k,3954) = lu(k,3954) - lu(k,2264) * lu(k,3924) + lu(k,3955) = lu(k,3955) - lu(k,2265) * lu(k,3924) + lu(k,3956) = lu(k,3956) - lu(k,2266) * lu(k,3924) + lu(k,3957) = lu(k,3957) - lu(k,2267) * lu(k,3924) + lu(k,3958) = lu(k,3958) - lu(k,2268) * lu(k,3924) + lu(k,3959) = lu(k,3959) - lu(k,2269) * lu(k,3924) + lu(k,3960) = lu(k,3960) - lu(k,2270) * lu(k,3924) + lu(k,3962) = lu(k,3962) - lu(k,2271) * lu(k,3924) + lu(k,4029) = lu(k,4029) - lu(k,2260) * lu(k,4017) + lu(k,4031) = - lu(k,2261) * lu(k,4017) + lu(k,4043) = lu(k,4043) - lu(k,2262) * lu(k,4017) + lu(k,4045) = lu(k,4045) - lu(k,2263) * lu(k,4017) + lu(k,4046) = lu(k,4046) - lu(k,2264) * lu(k,4017) + lu(k,4047) = lu(k,4047) - lu(k,2265) * lu(k,4017) + lu(k,4048) = lu(k,4048) - lu(k,2266) * lu(k,4017) + lu(k,4049) = lu(k,4049) - lu(k,2267) * lu(k,4017) + lu(k,4050) = lu(k,4050) - lu(k,2268) * lu(k,4017) + lu(k,4051) = lu(k,4051) - lu(k,2269) * lu(k,4017) + lu(k,4052) = lu(k,4052) - lu(k,2270) * lu(k,4017) + lu(k,4054) = lu(k,4054) - lu(k,2271) * lu(k,4017) + lu(k,4117) = lu(k,4117) - lu(k,2260) * lu(k,4115) + lu(k,4119) = lu(k,4119) - lu(k,2261) * lu(k,4115) + lu(k,4121) = lu(k,4121) - lu(k,2262) * lu(k,4115) + lu(k,4123) = lu(k,4123) - lu(k,2263) * lu(k,4115) + lu(k,4124) = lu(k,4124) - lu(k,2264) * lu(k,4115) + lu(k,4125) = lu(k,4125) - lu(k,2265) * lu(k,4115) + lu(k,4126) = lu(k,4126) - lu(k,2266) * lu(k,4115) + lu(k,4127) = lu(k,4127) - lu(k,2267) * lu(k,4115) + lu(k,4128) = lu(k,4128) - lu(k,2268) * lu(k,4115) + lu(k,4129) = lu(k,4129) - lu(k,2269) * lu(k,4115) + lu(k,4130) = lu(k,4130) - lu(k,2270) * lu(k,4115) + lu(k,4132) = lu(k,4132) - lu(k,2271) * lu(k,4115) end do end subroutine lu_fac44 subroutine lu_fac45( avec_len, lu ) @@ -12454,631 +11629,592 @@ subroutine lu_fac45( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,2303) = 1._r8 / lu(k,2303) - lu(k,2304) = lu(k,2304) * lu(k,2303) - lu(k,2305) = lu(k,2305) * lu(k,2303) - lu(k,2306) = lu(k,2306) * lu(k,2303) - lu(k,2307) = lu(k,2307) * lu(k,2303) - lu(k,2308) = lu(k,2308) * lu(k,2303) - lu(k,2309) = lu(k,2309) * lu(k,2303) - lu(k,2310) = lu(k,2310) * lu(k,2303) - lu(k,2311) = lu(k,2311) * lu(k,2303) - lu(k,2312) = lu(k,2312) * lu(k,2303) - lu(k,2313) = lu(k,2313) * lu(k,2303) - lu(k,2314) = lu(k,2314) * lu(k,2303) - lu(k,2315) = lu(k,2315) * lu(k,2303) - lu(k,2316) = lu(k,2316) * lu(k,2303) - lu(k,2317) = lu(k,2317) * lu(k,2303) - lu(k,2318) = lu(k,2318) * lu(k,2303) - lu(k,2319) = lu(k,2319) * lu(k,2303) - lu(k,2320) = lu(k,2320) * lu(k,2303) - lu(k,2321) = lu(k,2321) * lu(k,2303) - lu(k,2322) = lu(k,2322) * lu(k,2303) - lu(k,2525) = lu(k,2525) - lu(k,2304) * lu(k,2524) - lu(k,2528) = lu(k,2528) - lu(k,2305) * lu(k,2524) - lu(k,2529) = lu(k,2529) - lu(k,2306) * lu(k,2524) - lu(k,2530) = lu(k,2530) - lu(k,2307) * lu(k,2524) - lu(k,2531) = lu(k,2531) - lu(k,2308) * lu(k,2524) - lu(k,2532) = lu(k,2532) - lu(k,2309) * lu(k,2524) - lu(k,2533) = lu(k,2533) - lu(k,2310) * lu(k,2524) - lu(k,2534) = lu(k,2534) - lu(k,2311) * lu(k,2524) - lu(k,2535) = lu(k,2535) - lu(k,2312) * lu(k,2524) - lu(k,2536) = lu(k,2536) - lu(k,2313) * lu(k,2524) - lu(k,2537) = lu(k,2537) - lu(k,2314) * lu(k,2524) - lu(k,2538) = lu(k,2538) - lu(k,2315) * lu(k,2524) - lu(k,2540) = lu(k,2540) - lu(k,2316) * lu(k,2524) - lu(k,2541) = lu(k,2541) - lu(k,2317) * lu(k,2524) - lu(k,2542) = lu(k,2542) - lu(k,2318) * lu(k,2524) - lu(k,2543) = lu(k,2543) - lu(k,2319) * lu(k,2524) - lu(k,2545) = lu(k,2545) - lu(k,2320) * lu(k,2524) - lu(k,2546) = lu(k,2546) - lu(k,2321) * lu(k,2524) - lu(k,2549) = lu(k,2549) - lu(k,2322) * lu(k,2524) - lu(k,2571) = lu(k,2571) - lu(k,2304) * lu(k,2570) - lu(k,2574) = lu(k,2574) - lu(k,2305) * lu(k,2570) - lu(k,2575) = lu(k,2575) - lu(k,2306) * lu(k,2570) - lu(k,2576) = lu(k,2576) - lu(k,2307) * lu(k,2570) - lu(k,2577) = lu(k,2577) - lu(k,2308) * lu(k,2570) - lu(k,2578) = lu(k,2578) - lu(k,2309) * lu(k,2570) - lu(k,2579) = lu(k,2579) - lu(k,2310) * lu(k,2570) - lu(k,2580) = lu(k,2580) - lu(k,2311) * lu(k,2570) - lu(k,2581) = lu(k,2581) - lu(k,2312) * lu(k,2570) - lu(k,2582) = lu(k,2582) - lu(k,2313) * lu(k,2570) - lu(k,2583) = lu(k,2583) - lu(k,2314) * lu(k,2570) - lu(k,2584) = lu(k,2584) - lu(k,2315) * lu(k,2570) - lu(k,2586) = lu(k,2586) - lu(k,2316) * lu(k,2570) - lu(k,2587) = lu(k,2587) - lu(k,2317) * lu(k,2570) - lu(k,2588) = lu(k,2588) - lu(k,2318) * lu(k,2570) - lu(k,2589) = lu(k,2589) - lu(k,2319) * lu(k,2570) - lu(k,2591) = lu(k,2591) - lu(k,2320) * lu(k,2570) - lu(k,2592) = lu(k,2592) - lu(k,2321) * lu(k,2570) - lu(k,2595) = lu(k,2595) - lu(k,2322) * lu(k,2570) - lu(k,2618) = lu(k,2618) - lu(k,2304) * lu(k,2617) - lu(k,2621) = lu(k,2621) - lu(k,2305) * lu(k,2617) - lu(k,2622) = lu(k,2622) - lu(k,2306) * lu(k,2617) - lu(k,2623) = lu(k,2623) - lu(k,2307) * lu(k,2617) - lu(k,2624) = lu(k,2624) - lu(k,2308) * lu(k,2617) - lu(k,2625) = lu(k,2625) - lu(k,2309) * lu(k,2617) - lu(k,2626) = lu(k,2626) - lu(k,2310) * lu(k,2617) - lu(k,2627) = lu(k,2627) - lu(k,2311) * lu(k,2617) - lu(k,2628) = lu(k,2628) - lu(k,2312) * lu(k,2617) - lu(k,2629) = lu(k,2629) - lu(k,2313) * lu(k,2617) - lu(k,2630) = lu(k,2630) - lu(k,2314) * lu(k,2617) - lu(k,2631) = lu(k,2631) - lu(k,2315) * lu(k,2617) - lu(k,2633) = lu(k,2633) - lu(k,2316) * lu(k,2617) - lu(k,2634) = lu(k,2634) - lu(k,2317) * lu(k,2617) - lu(k,2635) = lu(k,2635) - lu(k,2318) * lu(k,2617) - lu(k,2636) = lu(k,2636) - lu(k,2319) * lu(k,2617) - lu(k,2638) = lu(k,2638) - lu(k,2320) * lu(k,2617) - lu(k,2639) = lu(k,2639) - lu(k,2321) * lu(k,2617) - lu(k,2642) = lu(k,2642) - lu(k,2322) * lu(k,2617) - lu(k,2689) = lu(k,2689) - lu(k,2304) * lu(k,2688) - lu(k,2692) = lu(k,2692) - lu(k,2305) * lu(k,2688) - lu(k,2693) = lu(k,2693) - lu(k,2306) * lu(k,2688) - lu(k,2694) = lu(k,2694) - lu(k,2307) * lu(k,2688) - lu(k,2695) = lu(k,2695) - lu(k,2308) * lu(k,2688) - lu(k,2696) = lu(k,2696) - lu(k,2309) * lu(k,2688) - lu(k,2697) = lu(k,2697) - lu(k,2310) * lu(k,2688) - lu(k,2698) = lu(k,2698) - lu(k,2311) * lu(k,2688) - lu(k,2699) = lu(k,2699) - lu(k,2312) * lu(k,2688) - lu(k,2700) = lu(k,2700) - lu(k,2313) * lu(k,2688) - lu(k,2701) = lu(k,2701) - lu(k,2314) * lu(k,2688) - lu(k,2702) = lu(k,2702) - lu(k,2315) * lu(k,2688) - lu(k,2704) = lu(k,2704) - lu(k,2316) * lu(k,2688) - lu(k,2705) = lu(k,2705) - lu(k,2317) * lu(k,2688) - lu(k,2706) = lu(k,2706) - lu(k,2318) * lu(k,2688) - lu(k,2707) = lu(k,2707) - lu(k,2319) * lu(k,2688) - lu(k,2709) = lu(k,2709) - lu(k,2320) * lu(k,2688) - lu(k,2710) = lu(k,2710) - lu(k,2321) * lu(k,2688) - lu(k,2713) = lu(k,2713) - lu(k,2322) * lu(k,2688) - lu(k,2872) = lu(k,2872) - lu(k,2304) * lu(k,2871) - lu(k,2875) = lu(k,2875) - lu(k,2305) * lu(k,2871) - lu(k,2876) = lu(k,2876) - lu(k,2306) * lu(k,2871) - lu(k,2877) = lu(k,2877) - lu(k,2307) * lu(k,2871) - lu(k,2878) = lu(k,2878) - lu(k,2308) * lu(k,2871) - lu(k,2879) = lu(k,2879) - lu(k,2309) * lu(k,2871) - lu(k,2880) = lu(k,2880) - lu(k,2310) * lu(k,2871) - lu(k,2881) = lu(k,2881) - lu(k,2311) * lu(k,2871) - lu(k,2882) = lu(k,2882) - lu(k,2312) * lu(k,2871) - lu(k,2883) = lu(k,2883) - lu(k,2313) * lu(k,2871) - lu(k,2884) = lu(k,2884) - lu(k,2314) * lu(k,2871) - lu(k,2885) = lu(k,2885) - lu(k,2315) * lu(k,2871) - lu(k,2887) = lu(k,2887) - lu(k,2316) * lu(k,2871) - lu(k,2889) = lu(k,2889) - lu(k,2317) * lu(k,2871) - lu(k,2891) = lu(k,2891) - lu(k,2318) * lu(k,2871) - lu(k,2892) = lu(k,2892) - lu(k,2319) * lu(k,2871) - lu(k,2894) = lu(k,2894) - lu(k,2320) * lu(k,2871) - lu(k,2895) = lu(k,2895) - lu(k,2321) * lu(k,2871) - lu(k,2899) = lu(k,2899) - lu(k,2322) * lu(k,2871) - lu(k,2973) = lu(k,2973) - lu(k,2304) * lu(k,2972) - lu(k,2976) = lu(k,2976) - lu(k,2305) * lu(k,2972) - lu(k,2977) = lu(k,2977) - lu(k,2306) * lu(k,2972) - lu(k,2978) = lu(k,2978) - lu(k,2307) * lu(k,2972) - lu(k,2979) = lu(k,2979) - lu(k,2308) * lu(k,2972) - lu(k,2980) = lu(k,2980) - lu(k,2309) * lu(k,2972) - lu(k,2981) = lu(k,2981) - lu(k,2310) * lu(k,2972) - lu(k,2982) = lu(k,2982) - lu(k,2311) * lu(k,2972) - lu(k,2983) = lu(k,2983) - lu(k,2312) * lu(k,2972) - lu(k,2984) = lu(k,2984) - lu(k,2313) * lu(k,2972) - lu(k,2985) = lu(k,2985) - lu(k,2314) * lu(k,2972) - lu(k,2986) = lu(k,2986) - lu(k,2315) * lu(k,2972) - lu(k,2988) = lu(k,2988) - lu(k,2316) * lu(k,2972) - lu(k,2990) = lu(k,2990) - lu(k,2317) * lu(k,2972) - lu(k,2992) = lu(k,2992) - lu(k,2318) * lu(k,2972) - lu(k,2993) = lu(k,2993) - lu(k,2319) * lu(k,2972) - lu(k,2995) = lu(k,2995) - lu(k,2320) * lu(k,2972) - lu(k,2996) = lu(k,2996) - lu(k,2321) * lu(k,2972) - lu(k,3000) = lu(k,3000) - lu(k,2322) * lu(k,2972) - lu(k,3065) = lu(k,3065) - lu(k,2304) * lu(k,3064) - lu(k,3068) = lu(k,3068) - lu(k,2305) * lu(k,3064) - lu(k,3069) = lu(k,3069) - lu(k,2306) * lu(k,3064) - lu(k,3070) = lu(k,3070) - lu(k,2307) * lu(k,3064) - lu(k,3071) = lu(k,3071) - lu(k,2308) * lu(k,3064) - lu(k,3072) = lu(k,3072) - lu(k,2309) * lu(k,3064) - lu(k,3073) = lu(k,3073) - lu(k,2310) * lu(k,3064) - lu(k,3074) = lu(k,3074) - lu(k,2311) * lu(k,3064) - lu(k,3075) = lu(k,3075) - lu(k,2312) * lu(k,3064) - lu(k,3076) = lu(k,3076) - lu(k,2313) * lu(k,3064) - lu(k,3077) = lu(k,3077) - lu(k,2314) * lu(k,3064) - lu(k,3078) = lu(k,3078) - lu(k,2315) * lu(k,3064) - lu(k,3080) = lu(k,3080) - lu(k,2316) * lu(k,3064) - lu(k,3082) = lu(k,3082) - lu(k,2317) * lu(k,3064) - lu(k,3084) = lu(k,3084) - lu(k,2318) * lu(k,3064) - lu(k,3085) = lu(k,3085) - lu(k,2319) * lu(k,3064) - lu(k,3087) = lu(k,3087) - lu(k,2320) * lu(k,3064) - lu(k,3088) = lu(k,3088) - lu(k,2321) * lu(k,3064) - lu(k,3092) = lu(k,3092) - lu(k,2322) * lu(k,3064) - lu(k,3268) = lu(k,3268) - lu(k,2304) * lu(k,3267) - lu(k,3271) = lu(k,3271) - lu(k,2305) * lu(k,3267) - lu(k,3272) = lu(k,3272) - lu(k,2306) * lu(k,3267) - lu(k,3273) = lu(k,3273) - lu(k,2307) * lu(k,3267) - lu(k,3274) = lu(k,3274) - lu(k,2308) * lu(k,3267) - lu(k,3275) = lu(k,3275) - lu(k,2309) * lu(k,3267) - lu(k,3276) = lu(k,3276) - lu(k,2310) * lu(k,3267) - lu(k,3277) = lu(k,3277) - lu(k,2311) * lu(k,3267) - lu(k,3278) = lu(k,3278) - lu(k,2312) * lu(k,3267) - lu(k,3279) = lu(k,3279) - lu(k,2313) * lu(k,3267) - lu(k,3280) = lu(k,3280) - lu(k,2314) * lu(k,3267) - lu(k,3281) = lu(k,3281) - lu(k,2315) * lu(k,3267) - lu(k,3283) = lu(k,3283) - lu(k,2316) * lu(k,3267) - lu(k,3285) = lu(k,3285) - lu(k,2317) * lu(k,3267) - lu(k,3287) = lu(k,3287) - lu(k,2318) * lu(k,3267) - lu(k,3288) = lu(k,3288) - lu(k,2319) * lu(k,3267) - lu(k,3290) = lu(k,3290) - lu(k,2320) * lu(k,3267) - lu(k,3291) = lu(k,3291) - lu(k,2321) * lu(k,3267) - lu(k,3295) = lu(k,3295) - lu(k,2322) * lu(k,3267) - lu(k,3409) = lu(k,3409) - lu(k,2304) * lu(k,3408) - lu(k,3412) = lu(k,3412) - lu(k,2305) * lu(k,3408) - lu(k,3413) = lu(k,3413) - lu(k,2306) * lu(k,3408) - lu(k,3414) = lu(k,3414) - lu(k,2307) * lu(k,3408) - lu(k,3415) = lu(k,3415) - lu(k,2308) * lu(k,3408) - lu(k,3416) = lu(k,3416) - lu(k,2309) * lu(k,3408) - lu(k,3417) = lu(k,3417) - lu(k,2310) * lu(k,3408) - lu(k,3418) = lu(k,3418) - lu(k,2311) * lu(k,3408) - lu(k,3419) = lu(k,3419) - lu(k,2312) * lu(k,3408) - lu(k,3420) = lu(k,3420) - lu(k,2313) * lu(k,3408) - lu(k,3421) = lu(k,3421) - lu(k,2314) * lu(k,3408) - lu(k,3422) = lu(k,3422) - lu(k,2315) * lu(k,3408) - lu(k,3424) = lu(k,3424) - lu(k,2316) * lu(k,3408) - lu(k,3426) = lu(k,3426) - lu(k,2317) * lu(k,3408) - lu(k,3428) = lu(k,3428) - lu(k,2318) * lu(k,3408) - lu(k,3429) = lu(k,3429) - lu(k,2319) * lu(k,3408) - lu(k,3431) = lu(k,3431) - lu(k,2320) * lu(k,3408) - lu(k,3432) = lu(k,3432) - lu(k,2321) * lu(k,3408) - lu(k,3436) = lu(k,3436) - lu(k,2322) * lu(k,3408) - lu(k,3729) = lu(k,3729) - lu(k,2304) * lu(k,3728) - lu(k,3732) = lu(k,3732) - lu(k,2305) * lu(k,3728) - lu(k,3733) = lu(k,3733) - lu(k,2306) * lu(k,3728) - lu(k,3734) = lu(k,3734) - lu(k,2307) * lu(k,3728) - lu(k,3735) = lu(k,3735) - lu(k,2308) * lu(k,3728) - lu(k,3736) = lu(k,3736) - lu(k,2309) * lu(k,3728) - lu(k,3737) = lu(k,3737) - lu(k,2310) * lu(k,3728) - lu(k,3738) = lu(k,3738) - lu(k,2311) * lu(k,3728) - lu(k,3739) = lu(k,3739) - lu(k,2312) * lu(k,3728) - lu(k,3740) = lu(k,3740) - lu(k,2313) * lu(k,3728) - lu(k,3741) = lu(k,3741) - lu(k,2314) * lu(k,3728) - lu(k,3742) = lu(k,3742) - lu(k,2315) * lu(k,3728) - lu(k,3744) = lu(k,3744) - lu(k,2316) * lu(k,3728) - lu(k,3746) = lu(k,3746) - lu(k,2317) * lu(k,3728) - lu(k,3748) = lu(k,3748) - lu(k,2318) * lu(k,3728) - lu(k,3749) = lu(k,3749) - lu(k,2319) * lu(k,3728) - lu(k,3751) = lu(k,3751) - lu(k,2320) * lu(k,3728) - lu(k,3752) = lu(k,3752) - lu(k,2321) * lu(k,3728) - lu(k,3756) = lu(k,3756) - lu(k,2322) * lu(k,3728) - lu(k,2332) = 1._r8 / lu(k,2332) - lu(k,2333) = lu(k,2333) * lu(k,2332) - lu(k,2334) = lu(k,2334) * lu(k,2332) - lu(k,2335) = lu(k,2335) * lu(k,2332) - lu(k,2336) = lu(k,2336) * lu(k,2332) - lu(k,2337) = lu(k,2337) * lu(k,2332) - lu(k,2338) = lu(k,2338) * lu(k,2332) - lu(k,2339) = lu(k,2339) * lu(k,2332) - lu(k,2340) = lu(k,2340) * lu(k,2332) - lu(k,2341) = lu(k,2341) * lu(k,2332) - lu(k,2342) = lu(k,2342) * lu(k,2332) - lu(k,2343) = lu(k,2343) * lu(k,2332) - lu(k,2344) = lu(k,2344) * lu(k,2332) - lu(k,2345) = lu(k,2345) * lu(k,2332) - lu(k,2346) = lu(k,2346) * lu(k,2332) - lu(k,2347) = lu(k,2347) * lu(k,2332) - lu(k,2348) = lu(k,2348) * lu(k,2332) - lu(k,2349) = lu(k,2349) * lu(k,2332) - lu(k,2367) = lu(k,2367) - lu(k,2333) * lu(k,2363) - lu(k,2368) = lu(k,2368) - lu(k,2334) * lu(k,2363) - lu(k,2369) = lu(k,2369) - lu(k,2335) * lu(k,2363) - lu(k,2370) = lu(k,2370) - lu(k,2336) * lu(k,2363) - lu(k,2371) = lu(k,2371) - lu(k,2337) * lu(k,2363) - lu(k,2372) = lu(k,2372) - lu(k,2338) * lu(k,2363) - lu(k,2373) = lu(k,2373) - lu(k,2339) * lu(k,2363) - lu(k,2374) = lu(k,2374) - lu(k,2340) * lu(k,2363) - lu(k,2375) = lu(k,2375) - lu(k,2341) * lu(k,2363) - lu(k,2376) = lu(k,2376) - lu(k,2342) * lu(k,2363) - lu(k,2377) = lu(k,2377) - lu(k,2343) * lu(k,2363) - lu(k,2378) = lu(k,2378) - lu(k,2344) * lu(k,2363) - lu(k,2379) = lu(k,2379) - lu(k,2345) * lu(k,2363) - lu(k,2380) = lu(k,2380) - lu(k,2346) * lu(k,2363) - lu(k,2381) = lu(k,2381) - lu(k,2347) * lu(k,2363) - lu(k,2382) = lu(k,2382) - lu(k,2348) * lu(k,2363) - lu(k,2383) = lu(k,2383) - lu(k,2349) * lu(k,2363) - lu(k,2529) = lu(k,2529) - lu(k,2333) * lu(k,2525) - lu(k,2530) = lu(k,2530) - lu(k,2334) * lu(k,2525) - lu(k,2531) = lu(k,2531) - lu(k,2335) * lu(k,2525) - lu(k,2532) = lu(k,2532) - lu(k,2336) * lu(k,2525) - lu(k,2533) = lu(k,2533) - lu(k,2337) * lu(k,2525) - lu(k,2534) = lu(k,2534) - lu(k,2338) * lu(k,2525) - lu(k,2535) = lu(k,2535) - lu(k,2339) * lu(k,2525) - lu(k,2536) = lu(k,2536) - lu(k,2340) * lu(k,2525) - lu(k,2537) = lu(k,2537) - lu(k,2341) * lu(k,2525) - lu(k,2538) = lu(k,2538) - lu(k,2342) * lu(k,2525) - lu(k,2540) = lu(k,2540) - lu(k,2343) * lu(k,2525) - lu(k,2541) = lu(k,2541) - lu(k,2344) * lu(k,2525) - lu(k,2542) = lu(k,2542) - lu(k,2345) * lu(k,2525) - lu(k,2543) = lu(k,2543) - lu(k,2346) * lu(k,2525) - lu(k,2545) = lu(k,2545) - lu(k,2347) * lu(k,2525) - lu(k,2546) = lu(k,2546) - lu(k,2348) * lu(k,2525) - lu(k,2549) = lu(k,2549) - lu(k,2349) * lu(k,2525) - lu(k,2575) = lu(k,2575) - lu(k,2333) * lu(k,2571) - lu(k,2576) = lu(k,2576) - lu(k,2334) * lu(k,2571) - lu(k,2577) = lu(k,2577) - lu(k,2335) * lu(k,2571) - lu(k,2578) = lu(k,2578) - lu(k,2336) * lu(k,2571) - lu(k,2579) = lu(k,2579) - lu(k,2337) * lu(k,2571) - lu(k,2580) = lu(k,2580) - lu(k,2338) * lu(k,2571) - lu(k,2581) = lu(k,2581) - lu(k,2339) * lu(k,2571) - lu(k,2582) = lu(k,2582) - lu(k,2340) * lu(k,2571) - lu(k,2583) = lu(k,2583) - lu(k,2341) * lu(k,2571) - lu(k,2584) = lu(k,2584) - lu(k,2342) * lu(k,2571) - lu(k,2586) = lu(k,2586) - lu(k,2343) * lu(k,2571) - lu(k,2587) = lu(k,2587) - lu(k,2344) * lu(k,2571) - lu(k,2588) = lu(k,2588) - lu(k,2345) * lu(k,2571) - lu(k,2589) = lu(k,2589) - lu(k,2346) * lu(k,2571) - lu(k,2591) = lu(k,2591) - lu(k,2347) * lu(k,2571) - lu(k,2592) = lu(k,2592) - lu(k,2348) * lu(k,2571) - lu(k,2595) = lu(k,2595) - lu(k,2349) * lu(k,2571) - lu(k,2622) = lu(k,2622) - lu(k,2333) * lu(k,2618) - lu(k,2623) = lu(k,2623) - lu(k,2334) * lu(k,2618) - lu(k,2624) = lu(k,2624) - lu(k,2335) * lu(k,2618) - lu(k,2625) = lu(k,2625) - lu(k,2336) * lu(k,2618) - lu(k,2626) = lu(k,2626) - lu(k,2337) * lu(k,2618) - lu(k,2627) = lu(k,2627) - lu(k,2338) * lu(k,2618) - lu(k,2628) = lu(k,2628) - lu(k,2339) * lu(k,2618) - lu(k,2629) = lu(k,2629) - lu(k,2340) * lu(k,2618) - lu(k,2630) = lu(k,2630) - lu(k,2341) * lu(k,2618) - lu(k,2631) = lu(k,2631) - lu(k,2342) * lu(k,2618) - lu(k,2633) = lu(k,2633) - lu(k,2343) * lu(k,2618) - lu(k,2634) = lu(k,2634) - lu(k,2344) * lu(k,2618) - lu(k,2635) = lu(k,2635) - lu(k,2345) * lu(k,2618) - lu(k,2636) = lu(k,2636) - lu(k,2346) * lu(k,2618) - lu(k,2638) = lu(k,2638) - lu(k,2347) * lu(k,2618) - lu(k,2639) = lu(k,2639) - lu(k,2348) * lu(k,2618) - lu(k,2642) = lu(k,2642) - lu(k,2349) * lu(k,2618) - lu(k,2693) = lu(k,2693) - lu(k,2333) * lu(k,2689) - lu(k,2694) = lu(k,2694) - lu(k,2334) * lu(k,2689) - lu(k,2695) = lu(k,2695) - lu(k,2335) * lu(k,2689) - lu(k,2696) = lu(k,2696) - lu(k,2336) * lu(k,2689) - lu(k,2697) = lu(k,2697) - lu(k,2337) * lu(k,2689) - lu(k,2698) = lu(k,2698) - lu(k,2338) * lu(k,2689) - lu(k,2699) = lu(k,2699) - lu(k,2339) * lu(k,2689) - lu(k,2700) = lu(k,2700) - lu(k,2340) * lu(k,2689) - lu(k,2701) = lu(k,2701) - lu(k,2341) * lu(k,2689) - lu(k,2702) = lu(k,2702) - lu(k,2342) * lu(k,2689) - lu(k,2704) = lu(k,2704) - lu(k,2343) * lu(k,2689) - lu(k,2705) = lu(k,2705) - lu(k,2344) * lu(k,2689) - lu(k,2706) = lu(k,2706) - lu(k,2345) * lu(k,2689) - lu(k,2707) = lu(k,2707) - lu(k,2346) * lu(k,2689) - lu(k,2709) = lu(k,2709) - lu(k,2347) * lu(k,2689) - lu(k,2710) = lu(k,2710) - lu(k,2348) * lu(k,2689) - lu(k,2713) = lu(k,2713) - lu(k,2349) * lu(k,2689) - lu(k,2876) = lu(k,2876) - lu(k,2333) * lu(k,2872) - lu(k,2877) = lu(k,2877) - lu(k,2334) * lu(k,2872) - lu(k,2878) = lu(k,2878) - lu(k,2335) * lu(k,2872) - lu(k,2879) = lu(k,2879) - lu(k,2336) * lu(k,2872) - lu(k,2880) = lu(k,2880) - lu(k,2337) * lu(k,2872) - lu(k,2881) = lu(k,2881) - lu(k,2338) * lu(k,2872) - lu(k,2882) = lu(k,2882) - lu(k,2339) * lu(k,2872) - lu(k,2883) = lu(k,2883) - lu(k,2340) * lu(k,2872) - lu(k,2884) = lu(k,2884) - lu(k,2341) * lu(k,2872) - lu(k,2885) = lu(k,2885) - lu(k,2342) * lu(k,2872) - lu(k,2887) = lu(k,2887) - lu(k,2343) * lu(k,2872) - lu(k,2889) = lu(k,2889) - lu(k,2344) * lu(k,2872) - lu(k,2891) = lu(k,2891) - lu(k,2345) * lu(k,2872) - lu(k,2892) = lu(k,2892) - lu(k,2346) * lu(k,2872) - lu(k,2894) = lu(k,2894) - lu(k,2347) * lu(k,2872) - lu(k,2895) = lu(k,2895) - lu(k,2348) * lu(k,2872) - lu(k,2899) = lu(k,2899) - lu(k,2349) * lu(k,2872) - lu(k,2977) = lu(k,2977) - lu(k,2333) * lu(k,2973) - lu(k,2978) = lu(k,2978) - lu(k,2334) * lu(k,2973) - lu(k,2979) = lu(k,2979) - lu(k,2335) * lu(k,2973) - lu(k,2980) = lu(k,2980) - lu(k,2336) * lu(k,2973) - lu(k,2981) = lu(k,2981) - lu(k,2337) * lu(k,2973) - lu(k,2982) = lu(k,2982) - lu(k,2338) * lu(k,2973) - lu(k,2983) = lu(k,2983) - lu(k,2339) * lu(k,2973) - lu(k,2984) = lu(k,2984) - lu(k,2340) * lu(k,2973) - lu(k,2985) = lu(k,2985) - lu(k,2341) * lu(k,2973) - lu(k,2986) = lu(k,2986) - lu(k,2342) * lu(k,2973) - lu(k,2988) = lu(k,2988) - lu(k,2343) * lu(k,2973) - lu(k,2990) = lu(k,2990) - lu(k,2344) * lu(k,2973) - lu(k,2992) = lu(k,2992) - lu(k,2345) * lu(k,2973) - lu(k,2993) = lu(k,2993) - lu(k,2346) * lu(k,2973) - lu(k,2995) = lu(k,2995) - lu(k,2347) * lu(k,2973) - lu(k,2996) = lu(k,2996) - lu(k,2348) * lu(k,2973) - lu(k,3000) = lu(k,3000) - lu(k,2349) * lu(k,2973) - lu(k,3069) = lu(k,3069) - lu(k,2333) * lu(k,3065) - lu(k,3070) = lu(k,3070) - lu(k,2334) * lu(k,3065) - lu(k,3071) = lu(k,3071) - lu(k,2335) * lu(k,3065) - lu(k,3072) = lu(k,3072) - lu(k,2336) * lu(k,3065) - lu(k,3073) = lu(k,3073) - lu(k,2337) * lu(k,3065) - lu(k,3074) = lu(k,3074) - lu(k,2338) * lu(k,3065) - lu(k,3075) = lu(k,3075) - lu(k,2339) * lu(k,3065) - lu(k,3076) = lu(k,3076) - lu(k,2340) * lu(k,3065) - lu(k,3077) = lu(k,3077) - lu(k,2341) * lu(k,3065) - lu(k,3078) = lu(k,3078) - lu(k,2342) * lu(k,3065) - lu(k,3080) = lu(k,3080) - lu(k,2343) * lu(k,3065) - lu(k,3082) = lu(k,3082) - lu(k,2344) * lu(k,3065) - lu(k,3084) = lu(k,3084) - lu(k,2345) * lu(k,3065) - lu(k,3085) = lu(k,3085) - lu(k,2346) * lu(k,3065) - lu(k,3087) = lu(k,3087) - lu(k,2347) * lu(k,3065) - lu(k,3088) = lu(k,3088) - lu(k,2348) * lu(k,3065) - lu(k,3092) = lu(k,3092) - lu(k,2349) * lu(k,3065) - lu(k,3272) = lu(k,3272) - lu(k,2333) * lu(k,3268) - lu(k,3273) = lu(k,3273) - lu(k,2334) * lu(k,3268) - lu(k,3274) = lu(k,3274) - lu(k,2335) * lu(k,3268) - lu(k,3275) = lu(k,3275) - lu(k,2336) * lu(k,3268) - lu(k,3276) = lu(k,3276) - lu(k,2337) * lu(k,3268) - lu(k,3277) = lu(k,3277) - lu(k,2338) * lu(k,3268) - lu(k,3278) = lu(k,3278) - lu(k,2339) * lu(k,3268) - lu(k,3279) = lu(k,3279) - lu(k,2340) * lu(k,3268) - lu(k,3280) = lu(k,3280) - lu(k,2341) * lu(k,3268) - lu(k,3281) = lu(k,3281) - lu(k,2342) * lu(k,3268) - lu(k,3283) = lu(k,3283) - lu(k,2343) * lu(k,3268) - lu(k,3285) = lu(k,3285) - lu(k,2344) * lu(k,3268) - lu(k,3287) = lu(k,3287) - lu(k,2345) * lu(k,3268) - lu(k,3288) = lu(k,3288) - lu(k,2346) * lu(k,3268) - lu(k,3290) = lu(k,3290) - lu(k,2347) * lu(k,3268) - lu(k,3291) = lu(k,3291) - lu(k,2348) * lu(k,3268) - lu(k,3295) = lu(k,3295) - lu(k,2349) * lu(k,3268) - lu(k,3413) = lu(k,3413) - lu(k,2333) * lu(k,3409) - lu(k,3414) = lu(k,3414) - lu(k,2334) * lu(k,3409) - lu(k,3415) = lu(k,3415) - lu(k,2335) * lu(k,3409) - lu(k,3416) = lu(k,3416) - lu(k,2336) * lu(k,3409) - lu(k,3417) = lu(k,3417) - lu(k,2337) * lu(k,3409) - lu(k,3418) = lu(k,3418) - lu(k,2338) * lu(k,3409) - lu(k,3419) = lu(k,3419) - lu(k,2339) * lu(k,3409) - lu(k,3420) = lu(k,3420) - lu(k,2340) * lu(k,3409) - lu(k,3421) = lu(k,3421) - lu(k,2341) * lu(k,3409) - lu(k,3422) = lu(k,3422) - lu(k,2342) * lu(k,3409) - lu(k,3424) = lu(k,3424) - lu(k,2343) * lu(k,3409) - lu(k,3426) = lu(k,3426) - lu(k,2344) * lu(k,3409) - lu(k,3428) = lu(k,3428) - lu(k,2345) * lu(k,3409) - lu(k,3429) = lu(k,3429) - lu(k,2346) * lu(k,3409) - lu(k,3431) = lu(k,3431) - lu(k,2347) * lu(k,3409) - lu(k,3432) = lu(k,3432) - lu(k,2348) * lu(k,3409) - lu(k,3436) = lu(k,3436) - lu(k,2349) * lu(k,3409) - lu(k,3733) = lu(k,3733) - lu(k,2333) * lu(k,3729) - lu(k,3734) = lu(k,3734) - lu(k,2334) * lu(k,3729) - lu(k,3735) = lu(k,3735) - lu(k,2335) * lu(k,3729) - lu(k,3736) = lu(k,3736) - lu(k,2336) * lu(k,3729) - lu(k,3737) = lu(k,3737) - lu(k,2337) * lu(k,3729) - lu(k,3738) = lu(k,3738) - lu(k,2338) * lu(k,3729) - lu(k,3739) = lu(k,3739) - lu(k,2339) * lu(k,3729) - lu(k,3740) = lu(k,3740) - lu(k,2340) * lu(k,3729) - lu(k,3741) = lu(k,3741) - lu(k,2341) * lu(k,3729) - lu(k,3742) = lu(k,3742) - lu(k,2342) * lu(k,3729) - lu(k,3744) = lu(k,3744) - lu(k,2343) * lu(k,3729) - lu(k,3746) = lu(k,3746) - lu(k,2344) * lu(k,3729) - lu(k,3748) = lu(k,3748) - lu(k,2345) * lu(k,3729) - lu(k,3749) = lu(k,3749) - lu(k,2346) * lu(k,3729) - lu(k,3751) = lu(k,3751) - lu(k,2347) * lu(k,3729) - lu(k,3752) = lu(k,3752) - lu(k,2348) * lu(k,3729) - lu(k,3756) = lu(k,3756) - lu(k,2349) * lu(k,3729) - lu(k,2364) = 1._r8 / lu(k,2364) - lu(k,2365) = lu(k,2365) * lu(k,2364) - lu(k,2366) = lu(k,2366) * lu(k,2364) - lu(k,2367) = lu(k,2367) * lu(k,2364) - lu(k,2368) = lu(k,2368) * lu(k,2364) - lu(k,2369) = lu(k,2369) * lu(k,2364) - lu(k,2370) = lu(k,2370) * lu(k,2364) - lu(k,2371) = lu(k,2371) * lu(k,2364) - lu(k,2372) = lu(k,2372) * lu(k,2364) - lu(k,2373) = lu(k,2373) * lu(k,2364) - lu(k,2374) = lu(k,2374) * lu(k,2364) - lu(k,2375) = lu(k,2375) * lu(k,2364) - lu(k,2376) = lu(k,2376) * lu(k,2364) - lu(k,2377) = lu(k,2377) * lu(k,2364) - lu(k,2378) = lu(k,2378) * lu(k,2364) - lu(k,2379) = lu(k,2379) * lu(k,2364) - lu(k,2380) = lu(k,2380) * lu(k,2364) - lu(k,2381) = lu(k,2381) * lu(k,2364) - lu(k,2382) = lu(k,2382) * lu(k,2364) - lu(k,2383) = lu(k,2383) * lu(k,2364) - lu(k,2527) = lu(k,2527) - lu(k,2365) * lu(k,2526) - lu(k,2528) = lu(k,2528) - lu(k,2366) * lu(k,2526) - lu(k,2529) = lu(k,2529) - lu(k,2367) * lu(k,2526) - lu(k,2530) = lu(k,2530) - lu(k,2368) * lu(k,2526) - lu(k,2531) = lu(k,2531) - lu(k,2369) * lu(k,2526) - lu(k,2532) = lu(k,2532) - lu(k,2370) * lu(k,2526) - lu(k,2533) = lu(k,2533) - lu(k,2371) * lu(k,2526) - lu(k,2534) = lu(k,2534) - lu(k,2372) * lu(k,2526) - lu(k,2535) = lu(k,2535) - lu(k,2373) * lu(k,2526) - lu(k,2536) = lu(k,2536) - lu(k,2374) * lu(k,2526) - lu(k,2537) = lu(k,2537) - lu(k,2375) * lu(k,2526) - lu(k,2538) = lu(k,2538) - lu(k,2376) * lu(k,2526) - lu(k,2540) = lu(k,2540) - lu(k,2377) * lu(k,2526) - lu(k,2541) = lu(k,2541) - lu(k,2378) * lu(k,2526) - lu(k,2542) = lu(k,2542) - lu(k,2379) * lu(k,2526) - lu(k,2543) = lu(k,2543) - lu(k,2380) * lu(k,2526) - lu(k,2545) = lu(k,2545) - lu(k,2381) * lu(k,2526) - lu(k,2546) = lu(k,2546) - lu(k,2382) * lu(k,2526) - lu(k,2549) = lu(k,2549) - lu(k,2383) * lu(k,2526) - lu(k,2573) = lu(k,2573) - lu(k,2365) * lu(k,2572) - lu(k,2574) = lu(k,2574) - lu(k,2366) * lu(k,2572) - lu(k,2575) = lu(k,2575) - lu(k,2367) * lu(k,2572) - lu(k,2576) = lu(k,2576) - lu(k,2368) * lu(k,2572) - lu(k,2577) = lu(k,2577) - lu(k,2369) * lu(k,2572) - lu(k,2578) = lu(k,2578) - lu(k,2370) * lu(k,2572) - lu(k,2579) = lu(k,2579) - lu(k,2371) * lu(k,2572) - lu(k,2580) = lu(k,2580) - lu(k,2372) * lu(k,2572) - lu(k,2581) = lu(k,2581) - lu(k,2373) * lu(k,2572) - lu(k,2582) = lu(k,2582) - lu(k,2374) * lu(k,2572) - lu(k,2583) = lu(k,2583) - lu(k,2375) * lu(k,2572) - lu(k,2584) = lu(k,2584) - lu(k,2376) * lu(k,2572) - lu(k,2586) = lu(k,2586) - lu(k,2377) * lu(k,2572) - lu(k,2587) = lu(k,2587) - lu(k,2378) * lu(k,2572) - lu(k,2588) = lu(k,2588) - lu(k,2379) * lu(k,2572) - lu(k,2589) = lu(k,2589) - lu(k,2380) * lu(k,2572) - lu(k,2591) = lu(k,2591) - lu(k,2381) * lu(k,2572) - lu(k,2592) = lu(k,2592) - lu(k,2382) * lu(k,2572) - lu(k,2595) = lu(k,2595) - lu(k,2383) * lu(k,2572) - lu(k,2620) = lu(k,2620) - lu(k,2365) * lu(k,2619) - lu(k,2621) = lu(k,2621) - lu(k,2366) * lu(k,2619) - lu(k,2622) = lu(k,2622) - lu(k,2367) * lu(k,2619) - lu(k,2623) = lu(k,2623) - lu(k,2368) * lu(k,2619) - lu(k,2624) = lu(k,2624) - lu(k,2369) * lu(k,2619) - lu(k,2625) = lu(k,2625) - lu(k,2370) * lu(k,2619) - lu(k,2626) = lu(k,2626) - lu(k,2371) * lu(k,2619) - lu(k,2627) = lu(k,2627) - lu(k,2372) * lu(k,2619) - lu(k,2628) = lu(k,2628) - lu(k,2373) * lu(k,2619) - lu(k,2629) = lu(k,2629) - lu(k,2374) * lu(k,2619) - lu(k,2630) = lu(k,2630) - lu(k,2375) * lu(k,2619) - lu(k,2631) = lu(k,2631) - lu(k,2376) * lu(k,2619) - lu(k,2633) = lu(k,2633) - lu(k,2377) * lu(k,2619) - lu(k,2634) = lu(k,2634) - lu(k,2378) * lu(k,2619) - lu(k,2635) = lu(k,2635) - lu(k,2379) * lu(k,2619) - lu(k,2636) = lu(k,2636) - lu(k,2380) * lu(k,2619) - lu(k,2638) = lu(k,2638) - lu(k,2381) * lu(k,2619) - lu(k,2639) = lu(k,2639) - lu(k,2382) * lu(k,2619) - lu(k,2642) = lu(k,2642) - lu(k,2383) * lu(k,2619) - lu(k,2691) = lu(k,2691) - lu(k,2365) * lu(k,2690) - lu(k,2692) = lu(k,2692) - lu(k,2366) * lu(k,2690) - lu(k,2693) = lu(k,2693) - lu(k,2367) * lu(k,2690) - lu(k,2694) = lu(k,2694) - lu(k,2368) * lu(k,2690) - lu(k,2695) = lu(k,2695) - lu(k,2369) * lu(k,2690) - lu(k,2696) = lu(k,2696) - lu(k,2370) * lu(k,2690) - lu(k,2697) = lu(k,2697) - lu(k,2371) * lu(k,2690) - lu(k,2698) = lu(k,2698) - lu(k,2372) * lu(k,2690) - lu(k,2699) = lu(k,2699) - lu(k,2373) * lu(k,2690) - lu(k,2700) = lu(k,2700) - lu(k,2374) * lu(k,2690) - lu(k,2701) = lu(k,2701) - lu(k,2375) * lu(k,2690) - lu(k,2702) = lu(k,2702) - lu(k,2376) * lu(k,2690) - lu(k,2704) = lu(k,2704) - lu(k,2377) * lu(k,2690) - lu(k,2705) = lu(k,2705) - lu(k,2378) * lu(k,2690) - lu(k,2706) = lu(k,2706) - lu(k,2379) * lu(k,2690) - lu(k,2707) = lu(k,2707) - lu(k,2380) * lu(k,2690) - lu(k,2709) = lu(k,2709) - lu(k,2381) * lu(k,2690) - lu(k,2710) = lu(k,2710) - lu(k,2382) * lu(k,2690) - lu(k,2713) = lu(k,2713) - lu(k,2383) * lu(k,2690) - lu(k,2874) = lu(k,2874) - lu(k,2365) * lu(k,2873) - lu(k,2875) = lu(k,2875) - lu(k,2366) * lu(k,2873) - lu(k,2876) = lu(k,2876) - lu(k,2367) * lu(k,2873) - lu(k,2877) = lu(k,2877) - lu(k,2368) * lu(k,2873) - lu(k,2878) = lu(k,2878) - lu(k,2369) * lu(k,2873) - lu(k,2879) = lu(k,2879) - lu(k,2370) * lu(k,2873) - lu(k,2880) = lu(k,2880) - lu(k,2371) * lu(k,2873) - lu(k,2881) = lu(k,2881) - lu(k,2372) * lu(k,2873) - lu(k,2882) = lu(k,2882) - lu(k,2373) * lu(k,2873) - lu(k,2883) = lu(k,2883) - lu(k,2374) * lu(k,2873) - lu(k,2884) = lu(k,2884) - lu(k,2375) * lu(k,2873) - lu(k,2885) = lu(k,2885) - lu(k,2376) * lu(k,2873) - lu(k,2887) = lu(k,2887) - lu(k,2377) * lu(k,2873) - lu(k,2889) = lu(k,2889) - lu(k,2378) * lu(k,2873) - lu(k,2891) = lu(k,2891) - lu(k,2379) * lu(k,2873) - lu(k,2892) = lu(k,2892) - lu(k,2380) * lu(k,2873) - lu(k,2894) = lu(k,2894) - lu(k,2381) * lu(k,2873) - lu(k,2895) = lu(k,2895) - lu(k,2382) * lu(k,2873) - lu(k,2899) = lu(k,2899) - lu(k,2383) * lu(k,2873) - lu(k,2975) = lu(k,2975) - lu(k,2365) * lu(k,2974) - lu(k,2976) = lu(k,2976) - lu(k,2366) * lu(k,2974) - lu(k,2977) = lu(k,2977) - lu(k,2367) * lu(k,2974) - lu(k,2978) = lu(k,2978) - lu(k,2368) * lu(k,2974) - lu(k,2979) = lu(k,2979) - lu(k,2369) * lu(k,2974) - lu(k,2980) = lu(k,2980) - lu(k,2370) * lu(k,2974) - lu(k,2981) = lu(k,2981) - lu(k,2371) * lu(k,2974) - lu(k,2982) = lu(k,2982) - lu(k,2372) * lu(k,2974) - lu(k,2983) = lu(k,2983) - lu(k,2373) * lu(k,2974) - lu(k,2984) = lu(k,2984) - lu(k,2374) * lu(k,2974) - lu(k,2985) = lu(k,2985) - lu(k,2375) * lu(k,2974) - lu(k,2986) = lu(k,2986) - lu(k,2376) * lu(k,2974) - lu(k,2988) = lu(k,2988) - lu(k,2377) * lu(k,2974) - lu(k,2990) = lu(k,2990) - lu(k,2378) * lu(k,2974) - lu(k,2992) = lu(k,2992) - lu(k,2379) * lu(k,2974) - lu(k,2993) = lu(k,2993) - lu(k,2380) * lu(k,2974) - lu(k,2995) = lu(k,2995) - lu(k,2381) * lu(k,2974) - lu(k,2996) = lu(k,2996) - lu(k,2382) * lu(k,2974) - lu(k,3000) = lu(k,3000) - lu(k,2383) * lu(k,2974) - lu(k,3067) = lu(k,3067) - lu(k,2365) * lu(k,3066) - lu(k,3068) = lu(k,3068) - lu(k,2366) * lu(k,3066) - lu(k,3069) = lu(k,3069) - lu(k,2367) * lu(k,3066) - lu(k,3070) = lu(k,3070) - lu(k,2368) * lu(k,3066) - lu(k,3071) = lu(k,3071) - lu(k,2369) * lu(k,3066) - lu(k,3072) = lu(k,3072) - lu(k,2370) * lu(k,3066) - lu(k,3073) = lu(k,3073) - lu(k,2371) * lu(k,3066) - lu(k,3074) = lu(k,3074) - lu(k,2372) * lu(k,3066) - lu(k,3075) = lu(k,3075) - lu(k,2373) * lu(k,3066) - lu(k,3076) = lu(k,3076) - lu(k,2374) * lu(k,3066) - lu(k,3077) = lu(k,3077) - lu(k,2375) * lu(k,3066) - lu(k,3078) = lu(k,3078) - lu(k,2376) * lu(k,3066) - lu(k,3080) = lu(k,3080) - lu(k,2377) * lu(k,3066) - lu(k,3082) = lu(k,3082) - lu(k,2378) * lu(k,3066) - lu(k,3084) = lu(k,3084) - lu(k,2379) * lu(k,3066) - lu(k,3085) = lu(k,3085) - lu(k,2380) * lu(k,3066) - lu(k,3087) = lu(k,3087) - lu(k,2381) * lu(k,3066) - lu(k,3088) = lu(k,3088) - lu(k,2382) * lu(k,3066) - lu(k,3092) = lu(k,3092) - lu(k,2383) * lu(k,3066) - lu(k,3270) = lu(k,3270) - lu(k,2365) * lu(k,3269) - lu(k,3271) = lu(k,3271) - lu(k,2366) * lu(k,3269) - lu(k,3272) = lu(k,3272) - lu(k,2367) * lu(k,3269) - lu(k,3273) = lu(k,3273) - lu(k,2368) * lu(k,3269) - lu(k,3274) = lu(k,3274) - lu(k,2369) * lu(k,3269) - lu(k,3275) = lu(k,3275) - lu(k,2370) * lu(k,3269) - lu(k,3276) = lu(k,3276) - lu(k,2371) * lu(k,3269) - lu(k,3277) = lu(k,3277) - lu(k,2372) * lu(k,3269) - lu(k,3278) = lu(k,3278) - lu(k,2373) * lu(k,3269) - lu(k,3279) = lu(k,3279) - lu(k,2374) * lu(k,3269) - lu(k,3280) = lu(k,3280) - lu(k,2375) * lu(k,3269) - lu(k,3281) = lu(k,3281) - lu(k,2376) * lu(k,3269) - lu(k,3283) = lu(k,3283) - lu(k,2377) * lu(k,3269) - lu(k,3285) = lu(k,3285) - lu(k,2378) * lu(k,3269) - lu(k,3287) = lu(k,3287) - lu(k,2379) * lu(k,3269) - lu(k,3288) = lu(k,3288) - lu(k,2380) * lu(k,3269) - lu(k,3290) = lu(k,3290) - lu(k,2381) * lu(k,3269) - lu(k,3291) = lu(k,3291) - lu(k,2382) * lu(k,3269) - lu(k,3295) = lu(k,3295) - lu(k,2383) * lu(k,3269) - lu(k,3411) = lu(k,3411) - lu(k,2365) * lu(k,3410) - lu(k,3412) = lu(k,3412) - lu(k,2366) * lu(k,3410) - lu(k,3413) = lu(k,3413) - lu(k,2367) * lu(k,3410) - lu(k,3414) = lu(k,3414) - lu(k,2368) * lu(k,3410) - lu(k,3415) = lu(k,3415) - lu(k,2369) * lu(k,3410) - lu(k,3416) = lu(k,3416) - lu(k,2370) * lu(k,3410) - lu(k,3417) = lu(k,3417) - lu(k,2371) * lu(k,3410) - lu(k,3418) = lu(k,3418) - lu(k,2372) * lu(k,3410) - lu(k,3419) = lu(k,3419) - lu(k,2373) * lu(k,3410) - lu(k,3420) = lu(k,3420) - lu(k,2374) * lu(k,3410) - lu(k,3421) = lu(k,3421) - lu(k,2375) * lu(k,3410) - lu(k,3422) = lu(k,3422) - lu(k,2376) * lu(k,3410) - lu(k,3424) = lu(k,3424) - lu(k,2377) * lu(k,3410) - lu(k,3426) = lu(k,3426) - lu(k,2378) * lu(k,3410) - lu(k,3428) = lu(k,3428) - lu(k,2379) * lu(k,3410) - lu(k,3429) = lu(k,3429) - lu(k,2380) * lu(k,3410) - lu(k,3431) = lu(k,3431) - lu(k,2381) * lu(k,3410) - lu(k,3432) = lu(k,3432) - lu(k,2382) * lu(k,3410) - lu(k,3436) = lu(k,3436) - lu(k,2383) * lu(k,3410) - lu(k,3731) = lu(k,3731) - lu(k,2365) * lu(k,3730) - lu(k,3732) = lu(k,3732) - lu(k,2366) * lu(k,3730) - lu(k,3733) = lu(k,3733) - lu(k,2367) * lu(k,3730) - lu(k,3734) = lu(k,3734) - lu(k,2368) * lu(k,3730) - lu(k,3735) = lu(k,3735) - lu(k,2369) * lu(k,3730) - lu(k,3736) = lu(k,3736) - lu(k,2370) * lu(k,3730) - lu(k,3737) = lu(k,3737) - lu(k,2371) * lu(k,3730) - lu(k,3738) = lu(k,3738) - lu(k,2372) * lu(k,3730) - lu(k,3739) = lu(k,3739) - lu(k,2373) * lu(k,3730) - lu(k,3740) = lu(k,3740) - lu(k,2374) * lu(k,3730) - lu(k,3741) = lu(k,3741) - lu(k,2375) * lu(k,3730) - lu(k,3742) = lu(k,3742) - lu(k,2376) * lu(k,3730) - lu(k,3744) = lu(k,3744) - lu(k,2377) * lu(k,3730) - lu(k,3746) = lu(k,3746) - lu(k,2378) * lu(k,3730) - lu(k,3748) = lu(k,3748) - lu(k,2379) * lu(k,3730) - lu(k,3749) = lu(k,3749) - lu(k,2380) * lu(k,3730) - lu(k,3751) = lu(k,3751) - lu(k,2381) * lu(k,3730) - lu(k,3752) = lu(k,3752) - lu(k,2382) * lu(k,3730) - lu(k,3756) = lu(k,3756) - lu(k,2383) * lu(k,3730) + lu(k,2277) = 1._r8 / lu(k,2277) + lu(k,2278) = lu(k,2278) * lu(k,2277) + lu(k,2279) = lu(k,2279) * lu(k,2277) + lu(k,2280) = lu(k,2280) * lu(k,2277) + lu(k,2281) = lu(k,2281) * lu(k,2277) + lu(k,2282) = lu(k,2282) * lu(k,2277) + lu(k,2283) = lu(k,2283) * lu(k,2277) + lu(k,2284) = lu(k,2284) * lu(k,2277) + lu(k,2285) = lu(k,2285) * lu(k,2277) + lu(k,2286) = lu(k,2286) * lu(k,2277) + lu(k,2287) = lu(k,2287) * lu(k,2277) + lu(k,2288) = lu(k,2288) * lu(k,2277) + lu(k,2420) = lu(k,2420) - lu(k,2278) * lu(k,2409) + lu(k,2421) = lu(k,2421) - lu(k,2279) * lu(k,2409) + lu(k,2422) = lu(k,2422) - lu(k,2280) * lu(k,2409) + lu(k,2423) = lu(k,2423) - lu(k,2281) * lu(k,2409) + lu(k,2424) = lu(k,2424) - lu(k,2282) * lu(k,2409) + lu(k,2425) = lu(k,2425) - lu(k,2283) * lu(k,2409) + lu(k,2426) = lu(k,2426) - lu(k,2284) * lu(k,2409) + lu(k,2427) = lu(k,2427) - lu(k,2285) * lu(k,2409) + lu(k,2428) = lu(k,2428) - lu(k,2286) * lu(k,2409) + lu(k,2429) = lu(k,2429) - lu(k,2287) * lu(k,2409) + lu(k,2430) = - lu(k,2288) * lu(k,2409) + lu(k,2474) = lu(k,2474) - lu(k,2278) * lu(k,2463) + lu(k,2475) = lu(k,2475) - lu(k,2279) * lu(k,2463) + lu(k,2476) = lu(k,2476) - lu(k,2280) * lu(k,2463) + lu(k,2477) = lu(k,2477) - lu(k,2281) * lu(k,2463) + lu(k,2478) = lu(k,2478) - lu(k,2282) * lu(k,2463) + lu(k,2479) = lu(k,2479) - lu(k,2283) * lu(k,2463) + lu(k,2480) = lu(k,2480) - lu(k,2284) * lu(k,2463) + lu(k,2481) = lu(k,2481) - lu(k,2285) * lu(k,2463) + lu(k,2482) = lu(k,2482) - lu(k,2286) * lu(k,2463) + lu(k,2483) = lu(k,2483) - lu(k,2287) * lu(k,2463) + lu(k,2484) = - lu(k,2288) * lu(k,2463) + lu(k,2707) = lu(k,2707) - lu(k,2278) * lu(k,2694) + lu(k,2710) = lu(k,2710) - lu(k,2279) * lu(k,2694) + lu(k,2711) = lu(k,2711) - lu(k,2280) * lu(k,2694) + lu(k,2712) = lu(k,2712) - lu(k,2281) * lu(k,2694) + lu(k,2713) = lu(k,2713) - lu(k,2282) * lu(k,2694) + lu(k,2714) = lu(k,2714) - lu(k,2283) * lu(k,2694) + lu(k,2715) = lu(k,2715) - lu(k,2284) * lu(k,2694) + lu(k,2717) = lu(k,2717) - lu(k,2285) * lu(k,2694) + lu(k,2718) = lu(k,2718) - lu(k,2286) * lu(k,2694) + lu(k,2719) = lu(k,2719) - lu(k,2287) * lu(k,2694) + lu(k,2720) = lu(k,2720) - lu(k,2288) * lu(k,2694) + lu(k,2779) = lu(k,2779) - lu(k,2278) * lu(k,2771) + lu(k,2780) = lu(k,2780) - lu(k,2279) * lu(k,2771) + lu(k,2781) = lu(k,2781) - lu(k,2280) * lu(k,2771) + lu(k,2782) = lu(k,2782) - lu(k,2281) * lu(k,2771) + lu(k,2783) = lu(k,2783) - lu(k,2282) * lu(k,2771) + lu(k,2784) = lu(k,2784) - lu(k,2283) * lu(k,2771) + lu(k,2785) = lu(k,2785) - lu(k,2284) * lu(k,2771) + lu(k,2786) = lu(k,2786) - lu(k,2285) * lu(k,2771) + lu(k,2787) = lu(k,2787) - lu(k,2286) * lu(k,2771) + lu(k,2788) = lu(k,2788) - lu(k,2287) * lu(k,2771) + lu(k,2789) = - lu(k,2288) * lu(k,2771) + lu(k,2810) = lu(k,2810) - lu(k,2278) * lu(k,2798) + lu(k,2813) = lu(k,2813) - lu(k,2279) * lu(k,2798) + lu(k,2814) = lu(k,2814) - lu(k,2280) * lu(k,2798) + lu(k,2815) = lu(k,2815) - lu(k,2281) * lu(k,2798) + lu(k,2816) = lu(k,2816) - lu(k,2282) * lu(k,2798) + lu(k,2817) = lu(k,2817) - lu(k,2283) * lu(k,2798) + lu(k,2818) = lu(k,2818) - lu(k,2284) * lu(k,2798) + lu(k,2820) = lu(k,2820) - lu(k,2285) * lu(k,2798) + lu(k,2821) = lu(k,2821) - lu(k,2286) * lu(k,2798) + lu(k,2822) = lu(k,2822) - lu(k,2287) * lu(k,2798) + lu(k,2823) = - lu(k,2288) * lu(k,2798) + lu(k,2856) = lu(k,2856) - lu(k,2278) * lu(k,2836) + lu(k,2859) = lu(k,2859) - lu(k,2279) * lu(k,2836) + lu(k,2860) = lu(k,2860) - lu(k,2280) * lu(k,2836) + lu(k,2861) = lu(k,2861) - lu(k,2281) * lu(k,2836) + lu(k,2862) = lu(k,2862) - lu(k,2282) * lu(k,2836) + lu(k,2863) = lu(k,2863) - lu(k,2283) * lu(k,2836) + lu(k,2864) = lu(k,2864) - lu(k,2284) * lu(k,2836) + lu(k,2866) = lu(k,2866) - lu(k,2285) * lu(k,2836) + lu(k,2867) = lu(k,2867) - lu(k,2286) * lu(k,2836) + lu(k,2868) = lu(k,2868) - lu(k,2287) * lu(k,2836) + lu(k,2869) = - lu(k,2288) * lu(k,2836) + lu(k,2903) = lu(k,2903) - lu(k,2278) * lu(k,2883) + lu(k,2906) = lu(k,2906) - lu(k,2279) * lu(k,2883) + lu(k,2907) = lu(k,2907) - lu(k,2280) * lu(k,2883) + lu(k,2908) = lu(k,2908) - lu(k,2281) * lu(k,2883) + lu(k,2909) = lu(k,2909) - lu(k,2282) * lu(k,2883) + lu(k,2910) = lu(k,2910) - lu(k,2283) * lu(k,2883) + lu(k,2911) = lu(k,2911) - lu(k,2284) * lu(k,2883) + lu(k,2913) = lu(k,2913) - lu(k,2285) * lu(k,2883) + lu(k,2914) = lu(k,2914) - lu(k,2286) * lu(k,2883) + lu(k,2915) = lu(k,2915) - lu(k,2287) * lu(k,2883) + lu(k,2916) = - lu(k,2288) * lu(k,2883) + lu(k,2949) = lu(k,2949) - lu(k,2278) * lu(k,2929) + lu(k,2952) = lu(k,2952) - lu(k,2279) * lu(k,2929) + lu(k,2953) = lu(k,2953) - lu(k,2280) * lu(k,2929) + lu(k,2954) = lu(k,2954) - lu(k,2281) * lu(k,2929) + lu(k,2955) = lu(k,2955) - lu(k,2282) * lu(k,2929) + lu(k,2956) = lu(k,2956) - lu(k,2283) * lu(k,2929) + lu(k,2957) = lu(k,2957) - lu(k,2284) * lu(k,2929) + lu(k,2959) = lu(k,2959) - lu(k,2285) * lu(k,2929) + lu(k,2960) = lu(k,2960) - lu(k,2286) * lu(k,2929) + lu(k,2961) = lu(k,2961) - lu(k,2287) * lu(k,2929) + lu(k,2962) = - lu(k,2288) * lu(k,2929) + lu(k,3023) = lu(k,3023) - lu(k,2278) * lu(k,3001) + lu(k,3026) = lu(k,3026) - lu(k,2279) * lu(k,3001) + lu(k,3027) = lu(k,3027) - lu(k,2280) * lu(k,3001) + lu(k,3028) = lu(k,3028) - lu(k,2281) * lu(k,3001) + lu(k,3029) = lu(k,3029) - lu(k,2282) * lu(k,3001) + lu(k,3030) = lu(k,3030) - lu(k,2283) * lu(k,3001) + lu(k,3031) = lu(k,3031) - lu(k,2284) * lu(k,3001) + lu(k,3033) = lu(k,3033) - lu(k,2285) * lu(k,3001) + lu(k,3034) = lu(k,3034) - lu(k,2286) * lu(k,3001) + lu(k,3035) = lu(k,3035) - lu(k,2287) * lu(k,3001) + lu(k,3036) = lu(k,3036) - lu(k,2288) * lu(k,3001) + lu(k,3126) = lu(k,3126) - lu(k,2278) * lu(k,3102) + lu(k,3129) = lu(k,3129) - lu(k,2279) * lu(k,3102) + lu(k,3130) = lu(k,3130) - lu(k,2280) * lu(k,3102) + lu(k,3131) = lu(k,3131) - lu(k,2281) * lu(k,3102) + lu(k,3132) = lu(k,3132) - lu(k,2282) * lu(k,3102) + lu(k,3133) = lu(k,3133) - lu(k,2283) * lu(k,3102) + lu(k,3134) = lu(k,3134) - lu(k,2284) * lu(k,3102) + lu(k,3136) = lu(k,3136) - lu(k,2285) * lu(k,3102) + lu(k,3137) = lu(k,3137) - lu(k,2286) * lu(k,3102) + lu(k,3138) = lu(k,3138) - lu(k,2287) * lu(k,3102) + lu(k,3139) = lu(k,3139) - lu(k,2288) * lu(k,3102) + lu(k,3308) = lu(k,3308) - lu(k,2278) * lu(k,3284) + lu(k,3311) = lu(k,3311) - lu(k,2279) * lu(k,3284) + lu(k,3312) = lu(k,3312) - lu(k,2280) * lu(k,3284) + lu(k,3313) = lu(k,3313) - lu(k,2281) * lu(k,3284) + lu(k,3314) = lu(k,3314) - lu(k,2282) * lu(k,3284) + lu(k,3315) = lu(k,3315) - lu(k,2283) * lu(k,3284) + lu(k,3316) = lu(k,3316) - lu(k,2284) * lu(k,3284) + lu(k,3318) = lu(k,3318) - lu(k,2285) * lu(k,3284) + lu(k,3319) = lu(k,3319) - lu(k,2286) * lu(k,3284) + lu(k,3320) = lu(k,3320) - lu(k,2287) * lu(k,3284) + lu(k,3321) = lu(k,3321) - lu(k,2288) * lu(k,3284) + lu(k,3564) = lu(k,3564) - lu(k,2278) * lu(k,3540) + lu(k,3567) = lu(k,3567) - lu(k,2279) * lu(k,3540) + lu(k,3568) = lu(k,3568) - lu(k,2280) * lu(k,3540) + lu(k,3569) = lu(k,3569) - lu(k,2281) * lu(k,3540) + lu(k,3570) = lu(k,3570) - lu(k,2282) * lu(k,3540) + lu(k,3571) = lu(k,3571) - lu(k,2283) * lu(k,3540) + lu(k,3572) = lu(k,3572) - lu(k,2284) * lu(k,3540) + lu(k,3574) = lu(k,3574) - lu(k,2285) * lu(k,3540) + lu(k,3575) = lu(k,3575) - lu(k,2286) * lu(k,3540) + lu(k,3576) = lu(k,3576) - lu(k,2287) * lu(k,3540) + lu(k,3577) = lu(k,3577) - lu(k,2288) * lu(k,3540) + lu(k,3814) = lu(k,3814) - lu(k,2278) * lu(k,3790) + lu(k,3817) = lu(k,3817) - lu(k,2279) * lu(k,3790) + lu(k,3818) = lu(k,3818) - lu(k,2280) * lu(k,3790) + lu(k,3819) = lu(k,3819) - lu(k,2281) * lu(k,3790) + lu(k,3820) = lu(k,3820) - lu(k,2282) * lu(k,3790) + lu(k,3821) = lu(k,3821) - lu(k,2283) * lu(k,3790) + lu(k,3822) = lu(k,3822) - lu(k,2284) * lu(k,3790) + lu(k,3824) = lu(k,3824) - lu(k,2285) * lu(k,3790) + lu(k,3825) = lu(k,3825) - lu(k,2286) * lu(k,3790) + lu(k,3826) = lu(k,3826) - lu(k,2287) * lu(k,3790) + lu(k,3827) = lu(k,3827) - lu(k,2288) * lu(k,3790) + lu(k,3949) = lu(k,3949) - lu(k,2278) * lu(k,3925) + lu(k,3952) = lu(k,3952) - lu(k,2279) * lu(k,3925) + lu(k,3953) = lu(k,3953) - lu(k,2280) * lu(k,3925) + lu(k,3954) = lu(k,3954) - lu(k,2281) * lu(k,3925) + lu(k,3955) = lu(k,3955) - lu(k,2282) * lu(k,3925) + lu(k,3956) = lu(k,3956) - lu(k,2283) * lu(k,3925) + lu(k,3957) = lu(k,3957) - lu(k,2284) * lu(k,3925) + lu(k,3959) = lu(k,3959) - lu(k,2285) * lu(k,3925) + lu(k,3960) = lu(k,3960) - lu(k,2286) * lu(k,3925) + lu(k,3961) = lu(k,3961) - lu(k,2287) * lu(k,3925) + lu(k,3962) = lu(k,3962) - lu(k,2288) * lu(k,3925) + lu(k,4041) = lu(k,4041) - lu(k,2278) * lu(k,4018) + lu(k,4044) = lu(k,4044) - lu(k,2279) * lu(k,4018) + lu(k,4045) = lu(k,4045) - lu(k,2280) * lu(k,4018) + lu(k,4046) = lu(k,4046) - lu(k,2281) * lu(k,4018) + lu(k,4047) = lu(k,4047) - lu(k,2282) * lu(k,4018) + lu(k,4048) = lu(k,4048) - lu(k,2283) * lu(k,4018) + lu(k,4049) = lu(k,4049) - lu(k,2284) * lu(k,4018) + lu(k,4051) = lu(k,4051) - lu(k,2285) * lu(k,4018) + lu(k,4052) = lu(k,4052) - lu(k,2286) * lu(k,4018) + lu(k,4053) = lu(k,4053) - lu(k,2287) * lu(k,4018) + lu(k,4054) = lu(k,4054) - lu(k,2288) * lu(k,4018) + lu(k,4093) = lu(k,4093) - lu(k,2278) * lu(k,4084) + lu(k,4096) = lu(k,4096) - lu(k,2279) * lu(k,4084) + lu(k,4097) = lu(k,4097) - lu(k,2280) * lu(k,4084) + lu(k,4098) = lu(k,4098) - lu(k,2281) * lu(k,4084) + lu(k,4099) = lu(k,4099) - lu(k,2282) * lu(k,4084) + lu(k,4100) = lu(k,4100) - lu(k,2283) * lu(k,4084) + lu(k,4101) = lu(k,4101) - lu(k,2284) * lu(k,4084) + lu(k,4103) = lu(k,4103) - lu(k,2285) * lu(k,4084) + lu(k,4104) = lu(k,4104) - lu(k,2286) * lu(k,4084) + lu(k,4105) = lu(k,4105) - lu(k,2287) * lu(k,4084) + lu(k,4106) = lu(k,4106) - lu(k,2288) * lu(k,4084) + lu(k,2296) = 1._r8 / lu(k,2296) + lu(k,2297) = lu(k,2297) * lu(k,2296) + lu(k,2298) = lu(k,2298) * lu(k,2296) + lu(k,2299) = lu(k,2299) * lu(k,2296) + lu(k,2300) = lu(k,2300) * lu(k,2296) + lu(k,2301) = lu(k,2301) * lu(k,2296) + lu(k,2302) = lu(k,2302) * lu(k,2296) + lu(k,2303) = lu(k,2303) * lu(k,2296) + lu(k,2304) = lu(k,2304) * lu(k,2296) + lu(k,2305) = lu(k,2305) * lu(k,2296) + lu(k,2306) = lu(k,2306) * lu(k,2296) + lu(k,2307) = lu(k,2307) * lu(k,2296) + lu(k,2308) = lu(k,2308) * lu(k,2296) + lu(k,2309) = lu(k,2309) * lu(k,2296) + lu(k,2310) = lu(k,2310) * lu(k,2296) + lu(k,2311) = lu(k,2311) * lu(k,2296) + lu(k,2312) = lu(k,2312) * lu(k,2296) + lu(k,2313) = lu(k,2313) * lu(k,2296) + lu(k,2314) = lu(k,2314) * lu(k,2296) + lu(k,2840) = lu(k,2840) - lu(k,2297) * lu(k,2837) + lu(k,2849) = lu(k,2849) - lu(k,2298) * lu(k,2837) + lu(k,2850) = lu(k,2850) - lu(k,2299) * lu(k,2837) + lu(k,2851) = lu(k,2851) - lu(k,2300) * lu(k,2837) + lu(k,2853) = lu(k,2853) - lu(k,2301) * lu(k,2837) + lu(k,2854) = lu(k,2854) - lu(k,2302) * lu(k,2837) + lu(k,2855) = lu(k,2855) - lu(k,2303) * lu(k,2837) + lu(k,2856) = lu(k,2856) - lu(k,2304) * lu(k,2837) + lu(k,2859) = lu(k,2859) - lu(k,2305) * lu(k,2837) + lu(k,2860) = lu(k,2860) - lu(k,2306) * lu(k,2837) + lu(k,2861) = lu(k,2861) - lu(k,2307) * lu(k,2837) + lu(k,2862) = lu(k,2862) - lu(k,2308) * lu(k,2837) + lu(k,2863) = lu(k,2863) - lu(k,2309) * lu(k,2837) + lu(k,2864) = lu(k,2864) - lu(k,2310) * lu(k,2837) + lu(k,2866) = lu(k,2866) - lu(k,2311) * lu(k,2837) + lu(k,2867) = lu(k,2867) - lu(k,2312) * lu(k,2837) + lu(k,2868) = lu(k,2868) - lu(k,2313) * lu(k,2837) + lu(k,2869) = lu(k,2869) - lu(k,2314) * lu(k,2837) + lu(k,2887) = lu(k,2887) - lu(k,2297) * lu(k,2884) + lu(k,2896) = lu(k,2896) - lu(k,2298) * lu(k,2884) + lu(k,2897) = lu(k,2897) - lu(k,2299) * lu(k,2884) + lu(k,2898) = lu(k,2898) - lu(k,2300) * lu(k,2884) + lu(k,2900) = lu(k,2900) - lu(k,2301) * lu(k,2884) + lu(k,2901) = lu(k,2901) - lu(k,2302) * lu(k,2884) + lu(k,2902) = lu(k,2902) - lu(k,2303) * lu(k,2884) + lu(k,2903) = lu(k,2903) - lu(k,2304) * lu(k,2884) + lu(k,2906) = lu(k,2906) - lu(k,2305) * lu(k,2884) + lu(k,2907) = lu(k,2907) - lu(k,2306) * lu(k,2884) + lu(k,2908) = lu(k,2908) - lu(k,2307) * lu(k,2884) + lu(k,2909) = lu(k,2909) - lu(k,2308) * lu(k,2884) + lu(k,2910) = lu(k,2910) - lu(k,2309) * lu(k,2884) + lu(k,2911) = lu(k,2911) - lu(k,2310) * lu(k,2884) + lu(k,2913) = lu(k,2913) - lu(k,2311) * lu(k,2884) + lu(k,2914) = lu(k,2914) - lu(k,2312) * lu(k,2884) + lu(k,2915) = lu(k,2915) - lu(k,2313) * lu(k,2884) + lu(k,2916) = lu(k,2916) - lu(k,2314) * lu(k,2884) + lu(k,2933) = lu(k,2933) - lu(k,2297) * lu(k,2930) + lu(k,2942) = lu(k,2942) - lu(k,2298) * lu(k,2930) + lu(k,2943) = lu(k,2943) - lu(k,2299) * lu(k,2930) + lu(k,2944) = lu(k,2944) - lu(k,2300) * lu(k,2930) + lu(k,2946) = lu(k,2946) - lu(k,2301) * lu(k,2930) + lu(k,2947) = lu(k,2947) - lu(k,2302) * lu(k,2930) + lu(k,2948) = lu(k,2948) - lu(k,2303) * lu(k,2930) + lu(k,2949) = lu(k,2949) - lu(k,2304) * lu(k,2930) + lu(k,2952) = lu(k,2952) - lu(k,2305) * lu(k,2930) + lu(k,2953) = lu(k,2953) - lu(k,2306) * lu(k,2930) + lu(k,2954) = lu(k,2954) - lu(k,2307) * lu(k,2930) + lu(k,2955) = lu(k,2955) - lu(k,2308) * lu(k,2930) + lu(k,2956) = lu(k,2956) - lu(k,2309) * lu(k,2930) + lu(k,2957) = lu(k,2957) - lu(k,2310) * lu(k,2930) + lu(k,2959) = lu(k,2959) - lu(k,2311) * lu(k,2930) + lu(k,2960) = lu(k,2960) - lu(k,2312) * lu(k,2930) + lu(k,2961) = lu(k,2961) - lu(k,2313) * lu(k,2930) + lu(k,2962) = lu(k,2962) - lu(k,2314) * lu(k,2930) + lu(k,3005) = lu(k,3005) - lu(k,2297) * lu(k,3002) + lu(k,3016) = lu(k,3016) - lu(k,2298) * lu(k,3002) + lu(k,3017) = lu(k,3017) - lu(k,2299) * lu(k,3002) + lu(k,3018) = lu(k,3018) - lu(k,2300) * lu(k,3002) + lu(k,3020) = lu(k,3020) - lu(k,2301) * lu(k,3002) + lu(k,3021) = lu(k,3021) - lu(k,2302) * lu(k,3002) + lu(k,3022) = lu(k,3022) - lu(k,2303) * lu(k,3002) + lu(k,3023) = lu(k,3023) - lu(k,2304) * lu(k,3002) + lu(k,3026) = lu(k,3026) - lu(k,2305) * lu(k,3002) + lu(k,3027) = lu(k,3027) - lu(k,2306) * lu(k,3002) + lu(k,3028) = lu(k,3028) - lu(k,2307) * lu(k,3002) + lu(k,3029) = lu(k,3029) - lu(k,2308) * lu(k,3002) + lu(k,3030) = lu(k,3030) - lu(k,2309) * lu(k,3002) + lu(k,3031) = lu(k,3031) - lu(k,2310) * lu(k,3002) + lu(k,3033) = lu(k,3033) - lu(k,2311) * lu(k,3002) + lu(k,3034) = lu(k,3034) - lu(k,2312) * lu(k,3002) + lu(k,3035) = lu(k,3035) - lu(k,2313) * lu(k,3002) + lu(k,3036) = lu(k,3036) - lu(k,2314) * lu(k,3002) + lu(k,3106) = lu(k,3106) - lu(k,2297) * lu(k,3103) + lu(k,3119) = lu(k,3119) - lu(k,2298) * lu(k,3103) + lu(k,3120) = lu(k,3120) - lu(k,2299) * lu(k,3103) + lu(k,3121) = lu(k,3121) - lu(k,2300) * lu(k,3103) + lu(k,3123) = lu(k,3123) - lu(k,2301) * lu(k,3103) + lu(k,3124) = lu(k,3124) - lu(k,2302) * lu(k,3103) + lu(k,3125) = lu(k,3125) - lu(k,2303) * lu(k,3103) + lu(k,3126) = lu(k,3126) - lu(k,2304) * lu(k,3103) + lu(k,3129) = lu(k,3129) - lu(k,2305) * lu(k,3103) + lu(k,3130) = lu(k,3130) - lu(k,2306) * lu(k,3103) + lu(k,3131) = lu(k,3131) - lu(k,2307) * lu(k,3103) + lu(k,3132) = lu(k,3132) - lu(k,2308) * lu(k,3103) + lu(k,3133) = lu(k,3133) - lu(k,2309) * lu(k,3103) + lu(k,3134) = lu(k,3134) - lu(k,2310) * lu(k,3103) + lu(k,3136) = lu(k,3136) - lu(k,2311) * lu(k,3103) + lu(k,3137) = lu(k,3137) - lu(k,2312) * lu(k,3103) + lu(k,3138) = lu(k,3138) - lu(k,2313) * lu(k,3103) + lu(k,3139) = lu(k,3139) - lu(k,2314) * lu(k,3103) + lu(k,3288) = lu(k,3288) - lu(k,2297) * lu(k,3285) + lu(k,3301) = lu(k,3301) - lu(k,2298) * lu(k,3285) + lu(k,3302) = lu(k,3302) - lu(k,2299) * lu(k,3285) + lu(k,3303) = lu(k,3303) - lu(k,2300) * lu(k,3285) + lu(k,3305) = lu(k,3305) - lu(k,2301) * lu(k,3285) + lu(k,3306) = lu(k,3306) - lu(k,2302) * lu(k,3285) + lu(k,3307) = lu(k,3307) - lu(k,2303) * lu(k,3285) + lu(k,3308) = lu(k,3308) - lu(k,2304) * lu(k,3285) + lu(k,3311) = lu(k,3311) - lu(k,2305) * lu(k,3285) + lu(k,3312) = lu(k,3312) - lu(k,2306) * lu(k,3285) + lu(k,3313) = lu(k,3313) - lu(k,2307) * lu(k,3285) + lu(k,3314) = lu(k,3314) - lu(k,2308) * lu(k,3285) + lu(k,3315) = lu(k,3315) - lu(k,2309) * lu(k,3285) + lu(k,3316) = lu(k,3316) - lu(k,2310) * lu(k,3285) + lu(k,3318) = lu(k,3318) - lu(k,2311) * lu(k,3285) + lu(k,3319) = lu(k,3319) - lu(k,2312) * lu(k,3285) + lu(k,3320) = lu(k,3320) - lu(k,2313) * lu(k,3285) + lu(k,3321) = lu(k,3321) - lu(k,2314) * lu(k,3285) + lu(k,3544) = lu(k,3544) - lu(k,2297) * lu(k,3541) + lu(k,3557) = lu(k,3557) - lu(k,2298) * lu(k,3541) + lu(k,3558) = lu(k,3558) - lu(k,2299) * lu(k,3541) + lu(k,3559) = lu(k,3559) - lu(k,2300) * lu(k,3541) + lu(k,3561) = lu(k,3561) - lu(k,2301) * lu(k,3541) + lu(k,3562) = lu(k,3562) - lu(k,2302) * lu(k,3541) + lu(k,3563) = lu(k,3563) - lu(k,2303) * lu(k,3541) + lu(k,3564) = lu(k,3564) - lu(k,2304) * lu(k,3541) + lu(k,3567) = lu(k,3567) - lu(k,2305) * lu(k,3541) + lu(k,3568) = lu(k,3568) - lu(k,2306) * lu(k,3541) + lu(k,3569) = lu(k,3569) - lu(k,2307) * lu(k,3541) + lu(k,3570) = lu(k,3570) - lu(k,2308) * lu(k,3541) + lu(k,3571) = lu(k,3571) - lu(k,2309) * lu(k,3541) + lu(k,3572) = lu(k,3572) - lu(k,2310) * lu(k,3541) + lu(k,3574) = lu(k,3574) - lu(k,2311) * lu(k,3541) + lu(k,3575) = lu(k,3575) - lu(k,2312) * lu(k,3541) + lu(k,3576) = lu(k,3576) - lu(k,2313) * lu(k,3541) + lu(k,3577) = lu(k,3577) - lu(k,2314) * lu(k,3541) + lu(k,3794) = lu(k,3794) - lu(k,2297) * lu(k,3791) + lu(k,3807) = lu(k,3807) - lu(k,2298) * lu(k,3791) + lu(k,3808) = lu(k,3808) - lu(k,2299) * lu(k,3791) + lu(k,3809) = lu(k,3809) - lu(k,2300) * lu(k,3791) + lu(k,3811) = lu(k,3811) - lu(k,2301) * lu(k,3791) + lu(k,3812) = lu(k,3812) - lu(k,2302) * lu(k,3791) + lu(k,3813) = lu(k,3813) - lu(k,2303) * lu(k,3791) + lu(k,3814) = lu(k,3814) - lu(k,2304) * lu(k,3791) + lu(k,3817) = lu(k,3817) - lu(k,2305) * lu(k,3791) + lu(k,3818) = lu(k,3818) - lu(k,2306) * lu(k,3791) + lu(k,3819) = lu(k,3819) - lu(k,2307) * lu(k,3791) + lu(k,3820) = lu(k,3820) - lu(k,2308) * lu(k,3791) + lu(k,3821) = lu(k,3821) - lu(k,2309) * lu(k,3791) + lu(k,3822) = lu(k,3822) - lu(k,2310) * lu(k,3791) + lu(k,3824) = lu(k,3824) - lu(k,2311) * lu(k,3791) + lu(k,3825) = lu(k,3825) - lu(k,2312) * lu(k,3791) + lu(k,3826) = lu(k,3826) - lu(k,2313) * lu(k,3791) + lu(k,3827) = lu(k,3827) - lu(k,2314) * lu(k,3791) + lu(k,3929) = lu(k,3929) - lu(k,2297) * lu(k,3926) + lu(k,3942) = lu(k,3942) - lu(k,2298) * lu(k,3926) + lu(k,3943) = lu(k,3943) - lu(k,2299) * lu(k,3926) + lu(k,3944) = lu(k,3944) - lu(k,2300) * lu(k,3926) + lu(k,3946) = lu(k,3946) - lu(k,2301) * lu(k,3926) + lu(k,3947) = lu(k,3947) - lu(k,2302) * lu(k,3926) + lu(k,3948) = lu(k,3948) - lu(k,2303) * lu(k,3926) + lu(k,3949) = lu(k,3949) - lu(k,2304) * lu(k,3926) + lu(k,3952) = lu(k,3952) - lu(k,2305) * lu(k,3926) + lu(k,3953) = lu(k,3953) - lu(k,2306) * lu(k,3926) + lu(k,3954) = lu(k,3954) - lu(k,2307) * lu(k,3926) + lu(k,3955) = lu(k,3955) - lu(k,2308) * lu(k,3926) + lu(k,3956) = lu(k,3956) - lu(k,2309) * lu(k,3926) + lu(k,3957) = lu(k,3957) - lu(k,2310) * lu(k,3926) + lu(k,3959) = lu(k,3959) - lu(k,2311) * lu(k,3926) + lu(k,3960) = lu(k,3960) - lu(k,2312) * lu(k,3926) + lu(k,3961) = lu(k,3961) - lu(k,2313) * lu(k,3926) + lu(k,3962) = lu(k,3962) - lu(k,2314) * lu(k,3926) + lu(k,4022) = lu(k,4022) - lu(k,2297) * lu(k,4019) + lu(k,4034) = lu(k,4034) - lu(k,2298) * lu(k,4019) + lu(k,4035) = lu(k,4035) - lu(k,2299) * lu(k,4019) + lu(k,4036) = lu(k,4036) - lu(k,2300) * lu(k,4019) + lu(k,4038) = lu(k,4038) - lu(k,2301) * lu(k,4019) + lu(k,4039) = lu(k,4039) - lu(k,2302) * lu(k,4019) + lu(k,4040) = lu(k,4040) - lu(k,2303) * lu(k,4019) + lu(k,4041) = lu(k,4041) - lu(k,2304) * lu(k,4019) + lu(k,4044) = lu(k,4044) - lu(k,2305) * lu(k,4019) + lu(k,4045) = lu(k,4045) - lu(k,2306) * lu(k,4019) + lu(k,4046) = lu(k,4046) - lu(k,2307) * lu(k,4019) + lu(k,4047) = lu(k,4047) - lu(k,2308) * lu(k,4019) + lu(k,4048) = lu(k,4048) - lu(k,2309) * lu(k,4019) + lu(k,4049) = lu(k,4049) - lu(k,2310) * lu(k,4019) + lu(k,4051) = lu(k,4051) - lu(k,2311) * lu(k,4019) + lu(k,4052) = lu(k,4052) - lu(k,2312) * lu(k,4019) + lu(k,4053) = lu(k,4053) - lu(k,2313) * lu(k,4019) + lu(k,4054) = lu(k,4054) - lu(k,2314) * lu(k,4019) + lu(k,2322) = 1._r8 / lu(k,2322) + lu(k,2323) = lu(k,2323) * lu(k,2322) + lu(k,2324) = lu(k,2324) * lu(k,2322) + lu(k,2325) = lu(k,2325) * lu(k,2322) + lu(k,2326) = lu(k,2326) * lu(k,2322) + lu(k,2327) = lu(k,2327) * lu(k,2322) + lu(k,2328) = lu(k,2328) * lu(k,2322) + lu(k,2329) = lu(k,2329) * lu(k,2322) + lu(k,2330) = lu(k,2330) * lu(k,2322) + lu(k,2331) = lu(k,2331) * lu(k,2322) + lu(k,2332) = lu(k,2332) * lu(k,2322) + lu(k,2333) = lu(k,2333) * lu(k,2322) + lu(k,2334) = lu(k,2334) * lu(k,2322) + lu(k,2335) = lu(k,2335) * lu(k,2322) + lu(k,2336) = lu(k,2336) * lu(k,2322) + lu(k,2337) = lu(k,2337) * lu(k,2322) + lu(k,2338) = lu(k,2338) * lu(k,2322) + lu(k,2339) = lu(k,2339) * lu(k,2322) + lu(k,2340) = lu(k,2340) * lu(k,2322) + lu(k,2839) = lu(k,2839) - lu(k,2323) * lu(k,2838) + lu(k,2840) = lu(k,2840) - lu(k,2324) * lu(k,2838) + lu(k,2843) = lu(k,2843) - lu(k,2325) * lu(k,2838) + lu(k,2849) = lu(k,2849) - lu(k,2326) * lu(k,2838) + lu(k,2850) = lu(k,2850) - lu(k,2327) * lu(k,2838) + lu(k,2851) = lu(k,2851) - lu(k,2328) * lu(k,2838) + lu(k,2853) = lu(k,2853) - lu(k,2329) * lu(k,2838) + lu(k,2854) = lu(k,2854) - lu(k,2330) * lu(k,2838) + lu(k,2855) = lu(k,2855) - lu(k,2331) * lu(k,2838) + lu(k,2856) = lu(k,2856) - lu(k,2332) * lu(k,2838) + lu(k,2859) = lu(k,2859) - lu(k,2333) * lu(k,2838) + lu(k,2861) = lu(k,2861) - lu(k,2334) * lu(k,2838) + lu(k,2862) = lu(k,2862) - lu(k,2335) * lu(k,2838) + lu(k,2863) = lu(k,2863) - lu(k,2336) * lu(k,2838) + lu(k,2864) = lu(k,2864) - lu(k,2337) * lu(k,2838) + lu(k,2866) = lu(k,2866) - lu(k,2338) * lu(k,2838) + lu(k,2867) = lu(k,2867) - lu(k,2339) * lu(k,2838) + lu(k,2868) = lu(k,2868) - lu(k,2340) * lu(k,2838) + lu(k,2886) = lu(k,2886) - lu(k,2323) * lu(k,2885) + lu(k,2887) = lu(k,2887) - lu(k,2324) * lu(k,2885) + lu(k,2890) = lu(k,2890) - lu(k,2325) * lu(k,2885) + lu(k,2896) = lu(k,2896) - lu(k,2326) * lu(k,2885) + lu(k,2897) = lu(k,2897) - lu(k,2327) * lu(k,2885) + lu(k,2898) = lu(k,2898) - lu(k,2328) * lu(k,2885) + lu(k,2900) = lu(k,2900) - lu(k,2329) * lu(k,2885) + lu(k,2901) = lu(k,2901) - lu(k,2330) * lu(k,2885) + lu(k,2902) = lu(k,2902) - lu(k,2331) * lu(k,2885) + lu(k,2903) = lu(k,2903) - lu(k,2332) * lu(k,2885) + lu(k,2906) = lu(k,2906) - lu(k,2333) * lu(k,2885) + lu(k,2908) = lu(k,2908) - lu(k,2334) * lu(k,2885) + lu(k,2909) = lu(k,2909) - lu(k,2335) * lu(k,2885) + lu(k,2910) = lu(k,2910) - lu(k,2336) * lu(k,2885) + lu(k,2911) = lu(k,2911) - lu(k,2337) * lu(k,2885) + lu(k,2913) = lu(k,2913) - lu(k,2338) * lu(k,2885) + lu(k,2914) = lu(k,2914) - lu(k,2339) * lu(k,2885) + lu(k,2915) = lu(k,2915) - lu(k,2340) * lu(k,2885) + lu(k,2932) = lu(k,2932) - lu(k,2323) * lu(k,2931) + lu(k,2933) = lu(k,2933) - lu(k,2324) * lu(k,2931) + lu(k,2936) = lu(k,2936) - lu(k,2325) * lu(k,2931) + lu(k,2942) = lu(k,2942) - lu(k,2326) * lu(k,2931) + lu(k,2943) = lu(k,2943) - lu(k,2327) * lu(k,2931) + lu(k,2944) = lu(k,2944) - lu(k,2328) * lu(k,2931) + lu(k,2946) = lu(k,2946) - lu(k,2329) * lu(k,2931) + lu(k,2947) = lu(k,2947) - lu(k,2330) * lu(k,2931) + lu(k,2948) = lu(k,2948) - lu(k,2331) * lu(k,2931) + lu(k,2949) = lu(k,2949) - lu(k,2332) * lu(k,2931) + lu(k,2952) = lu(k,2952) - lu(k,2333) * lu(k,2931) + lu(k,2954) = lu(k,2954) - lu(k,2334) * lu(k,2931) + lu(k,2955) = lu(k,2955) - lu(k,2335) * lu(k,2931) + lu(k,2956) = lu(k,2956) - lu(k,2336) * lu(k,2931) + lu(k,2957) = lu(k,2957) - lu(k,2337) * lu(k,2931) + lu(k,2959) = lu(k,2959) - lu(k,2338) * lu(k,2931) + lu(k,2960) = lu(k,2960) - lu(k,2339) * lu(k,2931) + lu(k,2961) = lu(k,2961) - lu(k,2340) * lu(k,2931) + lu(k,3004) = lu(k,3004) - lu(k,2323) * lu(k,3003) + lu(k,3005) = lu(k,3005) - lu(k,2324) * lu(k,3003) + lu(k,3008) = lu(k,3008) - lu(k,2325) * lu(k,3003) + lu(k,3016) = lu(k,3016) - lu(k,2326) * lu(k,3003) + lu(k,3017) = lu(k,3017) - lu(k,2327) * lu(k,3003) + lu(k,3018) = lu(k,3018) - lu(k,2328) * lu(k,3003) + lu(k,3020) = lu(k,3020) - lu(k,2329) * lu(k,3003) + lu(k,3021) = lu(k,3021) - lu(k,2330) * lu(k,3003) + lu(k,3022) = lu(k,3022) - lu(k,2331) * lu(k,3003) + lu(k,3023) = lu(k,3023) - lu(k,2332) * lu(k,3003) + lu(k,3026) = lu(k,3026) - lu(k,2333) * lu(k,3003) + lu(k,3028) = lu(k,3028) - lu(k,2334) * lu(k,3003) + lu(k,3029) = lu(k,3029) - lu(k,2335) * lu(k,3003) + lu(k,3030) = lu(k,3030) - lu(k,2336) * lu(k,3003) + lu(k,3031) = lu(k,3031) - lu(k,2337) * lu(k,3003) + lu(k,3033) = lu(k,3033) - lu(k,2338) * lu(k,3003) + lu(k,3034) = lu(k,3034) - lu(k,2339) * lu(k,3003) + lu(k,3035) = lu(k,3035) - lu(k,2340) * lu(k,3003) + lu(k,3105) = lu(k,3105) - lu(k,2323) * lu(k,3104) + lu(k,3106) = lu(k,3106) - lu(k,2324) * lu(k,3104) + lu(k,3109) = - lu(k,2325) * lu(k,3104) + lu(k,3119) = lu(k,3119) - lu(k,2326) * lu(k,3104) + lu(k,3120) = lu(k,3120) - lu(k,2327) * lu(k,3104) + lu(k,3121) = lu(k,3121) - lu(k,2328) * lu(k,3104) + lu(k,3123) = lu(k,3123) - lu(k,2329) * lu(k,3104) + lu(k,3124) = lu(k,3124) - lu(k,2330) * lu(k,3104) + lu(k,3125) = lu(k,3125) - lu(k,2331) * lu(k,3104) + lu(k,3126) = lu(k,3126) - lu(k,2332) * lu(k,3104) + lu(k,3129) = lu(k,3129) - lu(k,2333) * lu(k,3104) + lu(k,3131) = lu(k,3131) - lu(k,2334) * lu(k,3104) + lu(k,3132) = lu(k,3132) - lu(k,2335) * lu(k,3104) + lu(k,3133) = lu(k,3133) - lu(k,2336) * lu(k,3104) + lu(k,3134) = lu(k,3134) - lu(k,2337) * lu(k,3104) + lu(k,3136) = lu(k,3136) - lu(k,2338) * lu(k,3104) + lu(k,3137) = lu(k,3137) - lu(k,2339) * lu(k,3104) + lu(k,3138) = lu(k,3138) - lu(k,2340) * lu(k,3104) + lu(k,3287) = lu(k,3287) - lu(k,2323) * lu(k,3286) + lu(k,3288) = lu(k,3288) - lu(k,2324) * lu(k,3286) + lu(k,3291) = lu(k,3291) - lu(k,2325) * lu(k,3286) + lu(k,3301) = lu(k,3301) - lu(k,2326) * lu(k,3286) + lu(k,3302) = lu(k,3302) - lu(k,2327) * lu(k,3286) + lu(k,3303) = lu(k,3303) - lu(k,2328) * lu(k,3286) + lu(k,3305) = lu(k,3305) - lu(k,2329) * lu(k,3286) + lu(k,3306) = lu(k,3306) - lu(k,2330) * lu(k,3286) + lu(k,3307) = lu(k,3307) - lu(k,2331) * lu(k,3286) + lu(k,3308) = lu(k,3308) - lu(k,2332) * lu(k,3286) + lu(k,3311) = lu(k,3311) - lu(k,2333) * lu(k,3286) + lu(k,3313) = lu(k,3313) - lu(k,2334) * lu(k,3286) + lu(k,3314) = lu(k,3314) - lu(k,2335) * lu(k,3286) + lu(k,3315) = lu(k,3315) - lu(k,2336) * lu(k,3286) + lu(k,3316) = lu(k,3316) - lu(k,2337) * lu(k,3286) + lu(k,3318) = lu(k,3318) - lu(k,2338) * lu(k,3286) + lu(k,3319) = lu(k,3319) - lu(k,2339) * lu(k,3286) + lu(k,3320) = lu(k,3320) - lu(k,2340) * lu(k,3286) + lu(k,3543) = lu(k,3543) - lu(k,2323) * lu(k,3542) + lu(k,3544) = lu(k,3544) - lu(k,2324) * lu(k,3542) + lu(k,3547) = lu(k,3547) - lu(k,2325) * lu(k,3542) + lu(k,3557) = lu(k,3557) - lu(k,2326) * lu(k,3542) + lu(k,3558) = lu(k,3558) - lu(k,2327) * lu(k,3542) + lu(k,3559) = lu(k,3559) - lu(k,2328) * lu(k,3542) + lu(k,3561) = lu(k,3561) - lu(k,2329) * lu(k,3542) + lu(k,3562) = lu(k,3562) - lu(k,2330) * lu(k,3542) + lu(k,3563) = lu(k,3563) - lu(k,2331) * lu(k,3542) + lu(k,3564) = lu(k,3564) - lu(k,2332) * lu(k,3542) + lu(k,3567) = lu(k,3567) - lu(k,2333) * lu(k,3542) + lu(k,3569) = lu(k,3569) - lu(k,2334) * lu(k,3542) + lu(k,3570) = lu(k,3570) - lu(k,2335) * lu(k,3542) + lu(k,3571) = lu(k,3571) - lu(k,2336) * lu(k,3542) + lu(k,3572) = lu(k,3572) - lu(k,2337) * lu(k,3542) + lu(k,3574) = lu(k,3574) - lu(k,2338) * lu(k,3542) + lu(k,3575) = lu(k,3575) - lu(k,2339) * lu(k,3542) + lu(k,3576) = lu(k,3576) - lu(k,2340) * lu(k,3542) + lu(k,3793) = lu(k,3793) - lu(k,2323) * lu(k,3792) + lu(k,3794) = lu(k,3794) - lu(k,2324) * lu(k,3792) + lu(k,3797) = lu(k,3797) - lu(k,2325) * lu(k,3792) + lu(k,3807) = lu(k,3807) - lu(k,2326) * lu(k,3792) + lu(k,3808) = lu(k,3808) - lu(k,2327) * lu(k,3792) + lu(k,3809) = lu(k,3809) - lu(k,2328) * lu(k,3792) + lu(k,3811) = lu(k,3811) - lu(k,2329) * lu(k,3792) + lu(k,3812) = lu(k,3812) - lu(k,2330) * lu(k,3792) + lu(k,3813) = lu(k,3813) - lu(k,2331) * lu(k,3792) + lu(k,3814) = lu(k,3814) - lu(k,2332) * lu(k,3792) + lu(k,3817) = lu(k,3817) - lu(k,2333) * lu(k,3792) + lu(k,3819) = lu(k,3819) - lu(k,2334) * lu(k,3792) + lu(k,3820) = lu(k,3820) - lu(k,2335) * lu(k,3792) + lu(k,3821) = lu(k,3821) - lu(k,2336) * lu(k,3792) + lu(k,3822) = lu(k,3822) - lu(k,2337) * lu(k,3792) + lu(k,3824) = lu(k,3824) - lu(k,2338) * lu(k,3792) + lu(k,3825) = lu(k,3825) - lu(k,2339) * lu(k,3792) + lu(k,3826) = lu(k,3826) - lu(k,2340) * lu(k,3792) + lu(k,3928) = lu(k,3928) - lu(k,2323) * lu(k,3927) + lu(k,3929) = lu(k,3929) - lu(k,2324) * lu(k,3927) + lu(k,3932) = lu(k,3932) - lu(k,2325) * lu(k,3927) + lu(k,3942) = lu(k,3942) - lu(k,2326) * lu(k,3927) + lu(k,3943) = lu(k,3943) - lu(k,2327) * lu(k,3927) + lu(k,3944) = lu(k,3944) - lu(k,2328) * lu(k,3927) + lu(k,3946) = lu(k,3946) - lu(k,2329) * lu(k,3927) + lu(k,3947) = lu(k,3947) - lu(k,2330) * lu(k,3927) + lu(k,3948) = lu(k,3948) - lu(k,2331) * lu(k,3927) + lu(k,3949) = lu(k,3949) - lu(k,2332) * lu(k,3927) + lu(k,3952) = lu(k,3952) - lu(k,2333) * lu(k,3927) + lu(k,3954) = lu(k,3954) - lu(k,2334) * lu(k,3927) + lu(k,3955) = lu(k,3955) - lu(k,2335) * lu(k,3927) + lu(k,3956) = lu(k,3956) - lu(k,2336) * lu(k,3927) + lu(k,3957) = lu(k,3957) - lu(k,2337) * lu(k,3927) + lu(k,3959) = lu(k,3959) - lu(k,2338) * lu(k,3927) + lu(k,3960) = lu(k,3960) - lu(k,2339) * lu(k,3927) + lu(k,3961) = lu(k,3961) - lu(k,2340) * lu(k,3927) + lu(k,4021) = lu(k,4021) - lu(k,2323) * lu(k,4020) + lu(k,4022) = lu(k,4022) - lu(k,2324) * lu(k,4020) + lu(k,4025) = lu(k,4025) - lu(k,2325) * lu(k,4020) + lu(k,4034) = lu(k,4034) - lu(k,2326) * lu(k,4020) + lu(k,4035) = lu(k,4035) - lu(k,2327) * lu(k,4020) + lu(k,4036) = lu(k,4036) - lu(k,2328) * lu(k,4020) + lu(k,4038) = lu(k,4038) - lu(k,2329) * lu(k,4020) + lu(k,4039) = lu(k,4039) - lu(k,2330) * lu(k,4020) + lu(k,4040) = lu(k,4040) - lu(k,2331) * lu(k,4020) + lu(k,4041) = lu(k,4041) - lu(k,2332) * lu(k,4020) + lu(k,4044) = lu(k,4044) - lu(k,2333) * lu(k,4020) + lu(k,4046) = lu(k,4046) - lu(k,2334) * lu(k,4020) + lu(k,4047) = lu(k,4047) - lu(k,2335) * lu(k,4020) + lu(k,4048) = lu(k,4048) - lu(k,2336) * lu(k,4020) + lu(k,4049) = lu(k,4049) - lu(k,2337) * lu(k,4020) + lu(k,4051) = lu(k,4051) - lu(k,2338) * lu(k,4020) + lu(k,4052) = lu(k,4052) - lu(k,2339) * lu(k,4020) + lu(k,4053) = lu(k,4053) - lu(k,2340) * lu(k,4020) end do end subroutine lu_fac45 subroutine lu_fac46( avec_len, lu ) @@ -13095,611 +12231,586 @@ subroutine lu_fac46( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,2392) = 1._r8 / lu(k,2392) - lu(k,2393) = lu(k,2393) * lu(k,2392) - lu(k,2394) = lu(k,2394) * lu(k,2392) - lu(k,2395) = lu(k,2395) * lu(k,2392) - lu(k,2396) = lu(k,2396) * lu(k,2392) - lu(k,2397) = lu(k,2397) * lu(k,2392) - lu(k,2398) = lu(k,2398) * lu(k,2392) - lu(k,2399) = lu(k,2399) * lu(k,2392) - lu(k,2400) = lu(k,2400) * lu(k,2392) - lu(k,2401) = lu(k,2401) * lu(k,2392) - lu(k,2402) = lu(k,2402) * lu(k,2392) - lu(k,2403) = lu(k,2403) * lu(k,2392) - lu(k,2404) = lu(k,2404) * lu(k,2392) - lu(k,2405) = lu(k,2405) * lu(k,2392) - lu(k,2406) = lu(k,2406) * lu(k,2392) - lu(k,2407) = lu(k,2407) * lu(k,2392) - lu(k,2408) = lu(k,2408) * lu(k,2392) - lu(k,2409) = lu(k,2409) * lu(k,2392) - lu(k,2410) = lu(k,2410) * lu(k,2392) - lu(k,2411) = lu(k,2411) * lu(k,2392) - lu(k,2528) = lu(k,2528) - lu(k,2393) * lu(k,2527) - lu(k,2529) = lu(k,2529) - lu(k,2394) * lu(k,2527) - lu(k,2530) = lu(k,2530) - lu(k,2395) * lu(k,2527) - lu(k,2531) = lu(k,2531) - lu(k,2396) * lu(k,2527) - lu(k,2533) = lu(k,2533) - lu(k,2397) * lu(k,2527) - lu(k,2534) = lu(k,2534) - lu(k,2398) * lu(k,2527) - lu(k,2536) = lu(k,2536) - lu(k,2399) * lu(k,2527) - lu(k,2537) = lu(k,2537) - lu(k,2400) * lu(k,2527) - lu(k,2538) = lu(k,2538) - lu(k,2401) * lu(k,2527) - lu(k,2539) = lu(k,2539) - lu(k,2402) * lu(k,2527) - lu(k,2540) = lu(k,2540) - lu(k,2403) * lu(k,2527) - lu(k,2541) = lu(k,2541) - lu(k,2404) * lu(k,2527) - lu(k,2542) = lu(k,2542) - lu(k,2405) * lu(k,2527) - lu(k,2544) = - lu(k,2406) * lu(k,2527) - lu(k,2545) = lu(k,2545) - lu(k,2407) * lu(k,2527) - lu(k,2546) = lu(k,2546) - lu(k,2408) * lu(k,2527) - lu(k,2547) = - lu(k,2409) * lu(k,2527) - lu(k,2548) = - lu(k,2410) * lu(k,2527) - lu(k,2549) = lu(k,2549) - lu(k,2411) * lu(k,2527) - lu(k,2574) = lu(k,2574) - lu(k,2393) * lu(k,2573) - lu(k,2575) = lu(k,2575) - lu(k,2394) * lu(k,2573) - lu(k,2576) = lu(k,2576) - lu(k,2395) * lu(k,2573) - lu(k,2577) = lu(k,2577) - lu(k,2396) * lu(k,2573) - lu(k,2579) = lu(k,2579) - lu(k,2397) * lu(k,2573) - lu(k,2580) = lu(k,2580) - lu(k,2398) * lu(k,2573) - lu(k,2582) = lu(k,2582) - lu(k,2399) * lu(k,2573) - lu(k,2583) = lu(k,2583) - lu(k,2400) * lu(k,2573) - lu(k,2584) = lu(k,2584) - lu(k,2401) * lu(k,2573) - lu(k,2585) = lu(k,2585) - lu(k,2402) * lu(k,2573) - lu(k,2586) = lu(k,2586) - lu(k,2403) * lu(k,2573) - lu(k,2587) = lu(k,2587) - lu(k,2404) * lu(k,2573) - lu(k,2588) = lu(k,2588) - lu(k,2405) * lu(k,2573) - lu(k,2590) = - lu(k,2406) * lu(k,2573) - lu(k,2591) = lu(k,2591) - lu(k,2407) * lu(k,2573) - lu(k,2592) = lu(k,2592) - lu(k,2408) * lu(k,2573) - lu(k,2593) = - lu(k,2409) * lu(k,2573) - lu(k,2594) = - lu(k,2410) * lu(k,2573) - lu(k,2595) = lu(k,2595) - lu(k,2411) * lu(k,2573) - lu(k,2621) = lu(k,2621) - lu(k,2393) * lu(k,2620) - lu(k,2622) = lu(k,2622) - lu(k,2394) * lu(k,2620) - lu(k,2623) = lu(k,2623) - lu(k,2395) * lu(k,2620) - lu(k,2624) = lu(k,2624) - lu(k,2396) * lu(k,2620) - lu(k,2626) = lu(k,2626) - lu(k,2397) * lu(k,2620) - lu(k,2627) = lu(k,2627) - lu(k,2398) * lu(k,2620) - lu(k,2629) = lu(k,2629) - lu(k,2399) * lu(k,2620) - lu(k,2630) = lu(k,2630) - lu(k,2400) * lu(k,2620) - lu(k,2631) = lu(k,2631) - lu(k,2401) * lu(k,2620) - lu(k,2632) = lu(k,2632) - lu(k,2402) * lu(k,2620) - lu(k,2633) = lu(k,2633) - lu(k,2403) * lu(k,2620) - lu(k,2634) = lu(k,2634) - lu(k,2404) * lu(k,2620) - lu(k,2635) = lu(k,2635) - lu(k,2405) * lu(k,2620) - lu(k,2637) = - lu(k,2406) * lu(k,2620) - lu(k,2638) = lu(k,2638) - lu(k,2407) * lu(k,2620) - lu(k,2639) = lu(k,2639) - lu(k,2408) * lu(k,2620) - lu(k,2640) = - lu(k,2409) * lu(k,2620) - lu(k,2641) = - lu(k,2410) * lu(k,2620) - lu(k,2642) = lu(k,2642) - lu(k,2411) * lu(k,2620) - lu(k,2692) = lu(k,2692) - lu(k,2393) * lu(k,2691) - lu(k,2693) = lu(k,2693) - lu(k,2394) * lu(k,2691) - lu(k,2694) = lu(k,2694) - lu(k,2395) * lu(k,2691) - lu(k,2695) = lu(k,2695) - lu(k,2396) * lu(k,2691) - lu(k,2697) = lu(k,2697) - lu(k,2397) * lu(k,2691) - lu(k,2698) = lu(k,2698) - lu(k,2398) * lu(k,2691) - lu(k,2700) = lu(k,2700) - lu(k,2399) * lu(k,2691) - lu(k,2701) = lu(k,2701) - lu(k,2400) * lu(k,2691) - lu(k,2702) = lu(k,2702) - lu(k,2401) * lu(k,2691) - lu(k,2703) = lu(k,2703) - lu(k,2402) * lu(k,2691) - lu(k,2704) = lu(k,2704) - lu(k,2403) * lu(k,2691) - lu(k,2705) = lu(k,2705) - lu(k,2404) * lu(k,2691) - lu(k,2706) = lu(k,2706) - lu(k,2405) * lu(k,2691) - lu(k,2708) = lu(k,2708) - lu(k,2406) * lu(k,2691) - lu(k,2709) = lu(k,2709) - lu(k,2407) * lu(k,2691) - lu(k,2710) = lu(k,2710) - lu(k,2408) * lu(k,2691) - lu(k,2711) = lu(k,2711) - lu(k,2409) * lu(k,2691) - lu(k,2712) = lu(k,2712) - lu(k,2410) * lu(k,2691) - lu(k,2713) = lu(k,2713) - lu(k,2411) * lu(k,2691) - lu(k,2875) = lu(k,2875) - lu(k,2393) * lu(k,2874) - lu(k,2876) = lu(k,2876) - lu(k,2394) * lu(k,2874) - lu(k,2877) = lu(k,2877) - lu(k,2395) * lu(k,2874) - lu(k,2878) = lu(k,2878) - lu(k,2396) * lu(k,2874) - lu(k,2880) = lu(k,2880) - lu(k,2397) * lu(k,2874) - lu(k,2881) = lu(k,2881) - lu(k,2398) * lu(k,2874) - lu(k,2883) = lu(k,2883) - lu(k,2399) * lu(k,2874) - lu(k,2884) = lu(k,2884) - lu(k,2400) * lu(k,2874) - lu(k,2885) = lu(k,2885) - lu(k,2401) * lu(k,2874) - lu(k,2886) = lu(k,2886) - lu(k,2402) * lu(k,2874) - lu(k,2887) = lu(k,2887) - lu(k,2403) * lu(k,2874) - lu(k,2889) = lu(k,2889) - lu(k,2404) * lu(k,2874) - lu(k,2891) = lu(k,2891) - lu(k,2405) * lu(k,2874) - lu(k,2893) = lu(k,2893) - lu(k,2406) * lu(k,2874) - lu(k,2894) = lu(k,2894) - lu(k,2407) * lu(k,2874) - lu(k,2895) = lu(k,2895) - lu(k,2408) * lu(k,2874) - lu(k,2896) = lu(k,2896) - lu(k,2409) * lu(k,2874) - lu(k,2898) = lu(k,2898) - lu(k,2410) * lu(k,2874) - lu(k,2899) = lu(k,2899) - lu(k,2411) * lu(k,2874) - lu(k,2976) = lu(k,2976) - lu(k,2393) * lu(k,2975) - lu(k,2977) = lu(k,2977) - lu(k,2394) * lu(k,2975) - lu(k,2978) = lu(k,2978) - lu(k,2395) * lu(k,2975) - lu(k,2979) = lu(k,2979) - lu(k,2396) * lu(k,2975) - lu(k,2981) = lu(k,2981) - lu(k,2397) * lu(k,2975) - lu(k,2982) = lu(k,2982) - lu(k,2398) * lu(k,2975) - lu(k,2984) = lu(k,2984) - lu(k,2399) * lu(k,2975) - lu(k,2985) = lu(k,2985) - lu(k,2400) * lu(k,2975) - lu(k,2986) = lu(k,2986) - lu(k,2401) * lu(k,2975) - lu(k,2987) = lu(k,2987) - lu(k,2402) * lu(k,2975) - lu(k,2988) = lu(k,2988) - lu(k,2403) * lu(k,2975) - lu(k,2990) = lu(k,2990) - lu(k,2404) * lu(k,2975) - lu(k,2992) = lu(k,2992) - lu(k,2405) * lu(k,2975) - lu(k,2994) = lu(k,2994) - lu(k,2406) * lu(k,2975) - lu(k,2995) = lu(k,2995) - lu(k,2407) * lu(k,2975) - lu(k,2996) = lu(k,2996) - lu(k,2408) * lu(k,2975) - lu(k,2997) = lu(k,2997) - lu(k,2409) * lu(k,2975) - lu(k,2999) = lu(k,2999) - lu(k,2410) * lu(k,2975) - lu(k,3000) = lu(k,3000) - lu(k,2411) * lu(k,2975) - lu(k,3068) = lu(k,3068) - lu(k,2393) * lu(k,3067) - lu(k,3069) = lu(k,3069) - lu(k,2394) * lu(k,3067) - lu(k,3070) = lu(k,3070) - lu(k,2395) * lu(k,3067) - lu(k,3071) = lu(k,3071) - lu(k,2396) * lu(k,3067) - lu(k,3073) = lu(k,3073) - lu(k,2397) * lu(k,3067) - lu(k,3074) = lu(k,3074) - lu(k,2398) * lu(k,3067) - lu(k,3076) = lu(k,3076) - lu(k,2399) * lu(k,3067) - lu(k,3077) = lu(k,3077) - lu(k,2400) * lu(k,3067) - lu(k,3078) = lu(k,3078) - lu(k,2401) * lu(k,3067) - lu(k,3079) = lu(k,3079) - lu(k,2402) * lu(k,3067) - lu(k,3080) = lu(k,3080) - lu(k,2403) * lu(k,3067) - lu(k,3082) = lu(k,3082) - lu(k,2404) * lu(k,3067) - lu(k,3084) = lu(k,3084) - lu(k,2405) * lu(k,3067) - lu(k,3086) = lu(k,3086) - lu(k,2406) * lu(k,3067) - lu(k,3087) = lu(k,3087) - lu(k,2407) * lu(k,3067) - lu(k,3088) = lu(k,3088) - lu(k,2408) * lu(k,3067) - lu(k,3089) = lu(k,3089) - lu(k,2409) * lu(k,3067) - lu(k,3091) = lu(k,3091) - lu(k,2410) * lu(k,3067) - lu(k,3092) = lu(k,3092) - lu(k,2411) * lu(k,3067) - lu(k,3271) = lu(k,3271) - lu(k,2393) * lu(k,3270) - lu(k,3272) = lu(k,3272) - lu(k,2394) * lu(k,3270) - lu(k,3273) = lu(k,3273) - lu(k,2395) * lu(k,3270) - lu(k,3274) = lu(k,3274) - lu(k,2396) * lu(k,3270) - lu(k,3276) = lu(k,3276) - lu(k,2397) * lu(k,3270) - lu(k,3277) = lu(k,3277) - lu(k,2398) * lu(k,3270) - lu(k,3279) = lu(k,3279) - lu(k,2399) * lu(k,3270) - lu(k,3280) = lu(k,3280) - lu(k,2400) * lu(k,3270) - lu(k,3281) = lu(k,3281) - lu(k,2401) * lu(k,3270) - lu(k,3282) = lu(k,3282) - lu(k,2402) * lu(k,3270) - lu(k,3283) = lu(k,3283) - lu(k,2403) * lu(k,3270) - lu(k,3285) = lu(k,3285) - lu(k,2404) * lu(k,3270) - lu(k,3287) = lu(k,3287) - lu(k,2405) * lu(k,3270) - lu(k,3289) = lu(k,3289) - lu(k,2406) * lu(k,3270) - lu(k,3290) = lu(k,3290) - lu(k,2407) * lu(k,3270) - lu(k,3291) = lu(k,3291) - lu(k,2408) * lu(k,3270) - lu(k,3292) = lu(k,3292) - lu(k,2409) * lu(k,3270) - lu(k,3294) = lu(k,3294) - lu(k,2410) * lu(k,3270) - lu(k,3295) = lu(k,3295) - lu(k,2411) * lu(k,3270) - lu(k,3412) = lu(k,3412) - lu(k,2393) * lu(k,3411) - lu(k,3413) = lu(k,3413) - lu(k,2394) * lu(k,3411) - lu(k,3414) = lu(k,3414) - lu(k,2395) * lu(k,3411) - lu(k,3415) = lu(k,3415) - lu(k,2396) * lu(k,3411) - lu(k,3417) = lu(k,3417) - lu(k,2397) * lu(k,3411) - lu(k,3418) = lu(k,3418) - lu(k,2398) * lu(k,3411) - lu(k,3420) = lu(k,3420) - lu(k,2399) * lu(k,3411) - lu(k,3421) = lu(k,3421) - lu(k,2400) * lu(k,3411) - lu(k,3422) = lu(k,3422) - lu(k,2401) * lu(k,3411) - lu(k,3423) = lu(k,3423) - lu(k,2402) * lu(k,3411) - lu(k,3424) = lu(k,3424) - lu(k,2403) * lu(k,3411) - lu(k,3426) = lu(k,3426) - lu(k,2404) * lu(k,3411) - lu(k,3428) = lu(k,3428) - lu(k,2405) * lu(k,3411) - lu(k,3430) = lu(k,3430) - lu(k,2406) * lu(k,3411) - lu(k,3431) = lu(k,3431) - lu(k,2407) * lu(k,3411) - lu(k,3432) = lu(k,3432) - lu(k,2408) * lu(k,3411) - lu(k,3433) = lu(k,3433) - lu(k,2409) * lu(k,3411) - lu(k,3435) = lu(k,3435) - lu(k,2410) * lu(k,3411) - lu(k,3436) = lu(k,3436) - lu(k,2411) * lu(k,3411) - lu(k,3732) = lu(k,3732) - lu(k,2393) * lu(k,3731) - lu(k,3733) = lu(k,3733) - lu(k,2394) * lu(k,3731) - lu(k,3734) = lu(k,3734) - lu(k,2395) * lu(k,3731) - lu(k,3735) = lu(k,3735) - lu(k,2396) * lu(k,3731) - lu(k,3737) = lu(k,3737) - lu(k,2397) * lu(k,3731) - lu(k,3738) = lu(k,3738) - lu(k,2398) * lu(k,3731) - lu(k,3740) = lu(k,3740) - lu(k,2399) * lu(k,3731) - lu(k,3741) = lu(k,3741) - lu(k,2400) * lu(k,3731) - lu(k,3742) = lu(k,3742) - lu(k,2401) * lu(k,3731) - lu(k,3743) = lu(k,3743) - lu(k,2402) * lu(k,3731) - lu(k,3744) = lu(k,3744) - lu(k,2403) * lu(k,3731) - lu(k,3746) = lu(k,3746) - lu(k,2404) * lu(k,3731) - lu(k,3748) = lu(k,3748) - lu(k,2405) * lu(k,3731) - lu(k,3750) = lu(k,3750) - lu(k,2406) * lu(k,3731) - lu(k,3751) = lu(k,3751) - lu(k,2407) * lu(k,3731) - lu(k,3752) = lu(k,3752) - lu(k,2408) * lu(k,3731) - lu(k,3753) = lu(k,3753) - lu(k,2409) * lu(k,3731) - lu(k,3755) = lu(k,3755) - lu(k,2410) * lu(k,3731) - lu(k,3756) = lu(k,3756) - lu(k,2411) * lu(k,3731) - lu(k,2420) = 1._r8 / lu(k,2420) - lu(k,2421) = lu(k,2421) * lu(k,2420) - lu(k,2422) = lu(k,2422) * lu(k,2420) - lu(k,2423) = lu(k,2423) * lu(k,2420) - lu(k,2424) = lu(k,2424) * lu(k,2420) - lu(k,2425) = lu(k,2425) * lu(k,2420) - lu(k,2426) = lu(k,2426) * lu(k,2420) - lu(k,2427) = lu(k,2427) * lu(k,2420) - lu(k,2428) = lu(k,2428) * lu(k,2420) - lu(k,2429) = lu(k,2429) * lu(k,2420) - lu(k,2430) = lu(k,2430) * lu(k,2420) - lu(k,2431) = lu(k,2431) * lu(k,2420) - lu(k,2432) = lu(k,2432) * lu(k,2420) - lu(k,2433) = lu(k,2433) * lu(k,2420) - lu(k,2434) = lu(k,2434) * lu(k,2420) - lu(k,2435) = lu(k,2435) * lu(k,2420) - lu(k,2436) = lu(k,2436) * lu(k,2420) - lu(k,2437) = lu(k,2437) * lu(k,2420) - lu(k,2438) = lu(k,2438) * lu(k,2420) - lu(k,2529) = lu(k,2529) - lu(k,2421) * lu(k,2528) - lu(k,2530) = lu(k,2530) - lu(k,2422) * lu(k,2528) - lu(k,2531) = lu(k,2531) - lu(k,2423) * lu(k,2528) - lu(k,2533) = lu(k,2533) - lu(k,2424) * lu(k,2528) - lu(k,2534) = lu(k,2534) - lu(k,2425) * lu(k,2528) - lu(k,2536) = lu(k,2536) - lu(k,2426) * lu(k,2528) - lu(k,2537) = lu(k,2537) - lu(k,2427) * lu(k,2528) - lu(k,2538) = lu(k,2538) - lu(k,2428) * lu(k,2528) - lu(k,2539) = lu(k,2539) - lu(k,2429) * lu(k,2528) - lu(k,2540) = lu(k,2540) - lu(k,2430) * lu(k,2528) - lu(k,2541) = lu(k,2541) - lu(k,2431) * lu(k,2528) - lu(k,2542) = lu(k,2542) - lu(k,2432) * lu(k,2528) - lu(k,2544) = lu(k,2544) - lu(k,2433) * lu(k,2528) - lu(k,2545) = lu(k,2545) - lu(k,2434) * lu(k,2528) - lu(k,2546) = lu(k,2546) - lu(k,2435) * lu(k,2528) - lu(k,2547) = lu(k,2547) - lu(k,2436) * lu(k,2528) - lu(k,2548) = lu(k,2548) - lu(k,2437) * lu(k,2528) - lu(k,2549) = lu(k,2549) - lu(k,2438) * lu(k,2528) - lu(k,2575) = lu(k,2575) - lu(k,2421) * lu(k,2574) - lu(k,2576) = lu(k,2576) - lu(k,2422) * lu(k,2574) - lu(k,2577) = lu(k,2577) - lu(k,2423) * lu(k,2574) - lu(k,2579) = lu(k,2579) - lu(k,2424) * lu(k,2574) - lu(k,2580) = lu(k,2580) - lu(k,2425) * lu(k,2574) - lu(k,2582) = lu(k,2582) - lu(k,2426) * lu(k,2574) - lu(k,2583) = lu(k,2583) - lu(k,2427) * lu(k,2574) - lu(k,2584) = lu(k,2584) - lu(k,2428) * lu(k,2574) - lu(k,2585) = lu(k,2585) - lu(k,2429) * lu(k,2574) - lu(k,2586) = lu(k,2586) - lu(k,2430) * lu(k,2574) - lu(k,2587) = lu(k,2587) - lu(k,2431) * lu(k,2574) - lu(k,2588) = lu(k,2588) - lu(k,2432) * lu(k,2574) - lu(k,2590) = lu(k,2590) - lu(k,2433) * lu(k,2574) - lu(k,2591) = lu(k,2591) - lu(k,2434) * lu(k,2574) - lu(k,2592) = lu(k,2592) - lu(k,2435) * lu(k,2574) - lu(k,2593) = lu(k,2593) - lu(k,2436) * lu(k,2574) - lu(k,2594) = lu(k,2594) - lu(k,2437) * lu(k,2574) - lu(k,2595) = lu(k,2595) - lu(k,2438) * lu(k,2574) - lu(k,2622) = lu(k,2622) - lu(k,2421) * lu(k,2621) - lu(k,2623) = lu(k,2623) - lu(k,2422) * lu(k,2621) - lu(k,2624) = lu(k,2624) - lu(k,2423) * lu(k,2621) - lu(k,2626) = lu(k,2626) - lu(k,2424) * lu(k,2621) - lu(k,2627) = lu(k,2627) - lu(k,2425) * lu(k,2621) - lu(k,2629) = lu(k,2629) - lu(k,2426) * lu(k,2621) - lu(k,2630) = lu(k,2630) - lu(k,2427) * lu(k,2621) - lu(k,2631) = lu(k,2631) - lu(k,2428) * lu(k,2621) - lu(k,2632) = lu(k,2632) - lu(k,2429) * lu(k,2621) - lu(k,2633) = lu(k,2633) - lu(k,2430) * lu(k,2621) - lu(k,2634) = lu(k,2634) - lu(k,2431) * lu(k,2621) - lu(k,2635) = lu(k,2635) - lu(k,2432) * lu(k,2621) - lu(k,2637) = lu(k,2637) - lu(k,2433) * lu(k,2621) - lu(k,2638) = lu(k,2638) - lu(k,2434) * lu(k,2621) - lu(k,2639) = lu(k,2639) - lu(k,2435) * lu(k,2621) - lu(k,2640) = lu(k,2640) - lu(k,2436) * lu(k,2621) - lu(k,2641) = lu(k,2641) - lu(k,2437) * lu(k,2621) - lu(k,2642) = lu(k,2642) - lu(k,2438) * lu(k,2621) - lu(k,2693) = lu(k,2693) - lu(k,2421) * lu(k,2692) - lu(k,2694) = lu(k,2694) - lu(k,2422) * lu(k,2692) - lu(k,2695) = lu(k,2695) - lu(k,2423) * lu(k,2692) - lu(k,2697) = lu(k,2697) - lu(k,2424) * lu(k,2692) - lu(k,2698) = lu(k,2698) - lu(k,2425) * lu(k,2692) - lu(k,2700) = lu(k,2700) - lu(k,2426) * lu(k,2692) - lu(k,2701) = lu(k,2701) - lu(k,2427) * lu(k,2692) - lu(k,2702) = lu(k,2702) - lu(k,2428) * lu(k,2692) - lu(k,2703) = lu(k,2703) - lu(k,2429) * lu(k,2692) - lu(k,2704) = lu(k,2704) - lu(k,2430) * lu(k,2692) - lu(k,2705) = lu(k,2705) - lu(k,2431) * lu(k,2692) - lu(k,2706) = lu(k,2706) - lu(k,2432) * lu(k,2692) - lu(k,2708) = lu(k,2708) - lu(k,2433) * lu(k,2692) - lu(k,2709) = lu(k,2709) - lu(k,2434) * lu(k,2692) - lu(k,2710) = lu(k,2710) - lu(k,2435) * lu(k,2692) - lu(k,2711) = lu(k,2711) - lu(k,2436) * lu(k,2692) - lu(k,2712) = lu(k,2712) - lu(k,2437) * lu(k,2692) - lu(k,2713) = lu(k,2713) - lu(k,2438) * lu(k,2692) - lu(k,2876) = lu(k,2876) - lu(k,2421) * lu(k,2875) - lu(k,2877) = lu(k,2877) - lu(k,2422) * lu(k,2875) - lu(k,2878) = lu(k,2878) - lu(k,2423) * lu(k,2875) - lu(k,2880) = lu(k,2880) - lu(k,2424) * lu(k,2875) - lu(k,2881) = lu(k,2881) - lu(k,2425) * lu(k,2875) - lu(k,2883) = lu(k,2883) - lu(k,2426) * lu(k,2875) - lu(k,2884) = lu(k,2884) - lu(k,2427) * lu(k,2875) - lu(k,2885) = lu(k,2885) - lu(k,2428) * lu(k,2875) - lu(k,2886) = lu(k,2886) - lu(k,2429) * lu(k,2875) - lu(k,2887) = lu(k,2887) - lu(k,2430) * lu(k,2875) - lu(k,2889) = lu(k,2889) - lu(k,2431) * lu(k,2875) - lu(k,2891) = lu(k,2891) - lu(k,2432) * lu(k,2875) - lu(k,2893) = lu(k,2893) - lu(k,2433) * lu(k,2875) - lu(k,2894) = lu(k,2894) - lu(k,2434) * lu(k,2875) - lu(k,2895) = lu(k,2895) - lu(k,2435) * lu(k,2875) - lu(k,2896) = lu(k,2896) - lu(k,2436) * lu(k,2875) - lu(k,2898) = lu(k,2898) - lu(k,2437) * lu(k,2875) - lu(k,2899) = lu(k,2899) - lu(k,2438) * lu(k,2875) - lu(k,2977) = lu(k,2977) - lu(k,2421) * lu(k,2976) - lu(k,2978) = lu(k,2978) - lu(k,2422) * lu(k,2976) - lu(k,2979) = lu(k,2979) - lu(k,2423) * lu(k,2976) - lu(k,2981) = lu(k,2981) - lu(k,2424) * lu(k,2976) - lu(k,2982) = lu(k,2982) - lu(k,2425) * lu(k,2976) - lu(k,2984) = lu(k,2984) - lu(k,2426) * lu(k,2976) - lu(k,2985) = lu(k,2985) - lu(k,2427) * lu(k,2976) - lu(k,2986) = lu(k,2986) - lu(k,2428) * lu(k,2976) - lu(k,2987) = lu(k,2987) - lu(k,2429) * lu(k,2976) - lu(k,2988) = lu(k,2988) - lu(k,2430) * lu(k,2976) - lu(k,2990) = lu(k,2990) - lu(k,2431) * lu(k,2976) - lu(k,2992) = lu(k,2992) - lu(k,2432) * lu(k,2976) - lu(k,2994) = lu(k,2994) - lu(k,2433) * lu(k,2976) - lu(k,2995) = lu(k,2995) - lu(k,2434) * lu(k,2976) - lu(k,2996) = lu(k,2996) - lu(k,2435) * lu(k,2976) - lu(k,2997) = lu(k,2997) - lu(k,2436) * lu(k,2976) - lu(k,2999) = lu(k,2999) - lu(k,2437) * lu(k,2976) - lu(k,3000) = lu(k,3000) - lu(k,2438) * lu(k,2976) - lu(k,3069) = lu(k,3069) - lu(k,2421) * lu(k,3068) - lu(k,3070) = lu(k,3070) - lu(k,2422) * lu(k,3068) - lu(k,3071) = lu(k,3071) - lu(k,2423) * lu(k,3068) - lu(k,3073) = lu(k,3073) - lu(k,2424) * lu(k,3068) - lu(k,3074) = lu(k,3074) - lu(k,2425) * lu(k,3068) - lu(k,3076) = lu(k,3076) - lu(k,2426) * lu(k,3068) - lu(k,3077) = lu(k,3077) - lu(k,2427) * lu(k,3068) - lu(k,3078) = lu(k,3078) - lu(k,2428) * lu(k,3068) - lu(k,3079) = lu(k,3079) - lu(k,2429) * lu(k,3068) - lu(k,3080) = lu(k,3080) - lu(k,2430) * lu(k,3068) - lu(k,3082) = lu(k,3082) - lu(k,2431) * lu(k,3068) - lu(k,3084) = lu(k,3084) - lu(k,2432) * lu(k,3068) - lu(k,3086) = lu(k,3086) - lu(k,2433) * lu(k,3068) - lu(k,3087) = lu(k,3087) - lu(k,2434) * lu(k,3068) - lu(k,3088) = lu(k,3088) - lu(k,2435) * lu(k,3068) - lu(k,3089) = lu(k,3089) - lu(k,2436) * lu(k,3068) - lu(k,3091) = lu(k,3091) - lu(k,2437) * lu(k,3068) - lu(k,3092) = lu(k,3092) - lu(k,2438) * lu(k,3068) - lu(k,3272) = lu(k,3272) - lu(k,2421) * lu(k,3271) - lu(k,3273) = lu(k,3273) - lu(k,2422) * lu(k,3271) - lu(k,3274) = lu(k,3274) - lu(k,2423) * lu(k,3271) - lu(k,3276) = lu(k,3276) - lu(k,2424) * lu(k,3271) - lu(k,3277) = lu(k,3277) - lu(k,2425) * lu(k,3271) - lu(k,3279) = lu(k,3279) - lu(k,2426) * lu(k,3271) - lu(k,3280) = lu(k,3280) - lu(k,2427) * lu(k,3271) - lu(k,3281) = lu(k,3281) - lu(k,2428) * lu(k,3271) - lu(k,3282) = lu(k,3282) - lu(k,2429) * lu(k,3271) - lu(k,3283) = lu(k,3283) - lu(k,2430) * lu(k,3271) - lu(k,3285) = lu(k,3285) - lu(k,2431) * lu(k,3271) - lu(k,3287) = lu(k,3287) - lu(k,2432) * lu(k,3271) - lu(k,3289) = lu(k,3289) - lu(k,2433) * lu(k,3271) - lu(k,3290) = lu(k,3290) - lu(k,2434) * lu(k,3271) - lu(k,3291) = lu(k,3291) - lu(k,2435) * lu(k,3271) - lu(k,3292) = lu(k,3292) - lu(k,2436) * lu(k,3271) - lu(k,3294) = lu(k,3294) - lu(k,2437) * lu(k,3271) - lu(k,3295) = lu(k,3295) - lu(k,2438) * lu(k,3271) - lu(k,3413) = lu(k,3413) - lu(k,2421) * lu(k,3412) - lu(k,3414) = lu(k,3414) - lu(k,2422) * lu(k,3412) - lu(k,3415) = lu(k,3415) - lu(k,2423) * lu(k,3412) - lu(k,3417) = lu(k,3417) - lu(k,2424) * lu(k,3412) - lu(k,3418) = lu(k,3418) - lu(k,2425) * lu(k,3412) - lu(k,3420) = lu(k,3420) - lu(k,2426) * lu(k,3412) - lu(k,3421) = lu(k,3421) - lu(k,2427) * lu(k,3412) - lu(k,3422) = lu(k,3422) - lu(k,2428) * lu(k,3412) - lu(k,3423) = lu(k,3423) - lu(k,2429) * lu(k,3412) - lu(k,3424) = lu(k,3424) - lu(k,2430) * lu(k,3412) - lu(k,3426) = lu(k,3426) - lu(k,2431) * lu(k,3412) - lu(k,3428) = lu(k,3428) - lu(k,2432) * lu(k,3412) - lu(k,3430) = lu(k,3430) - lu(k,2433) * lu(k,3412) - lu(k,3431) = lu(k,3431) - lu(k,2434) * lu(k,3412) - lu(k,3432) = lu(k,3432) - lu(k,2435) * lu(k,3412) - lu(k,3433) = lu(k,3433) - lu(k,2436) * lu(k,3412) - lu(k,3435) = lu(k,3435) - lu(k,2437) * lu(k,3412) - lu(k,3436) = lu(k,3436) - lu(k,2438) * lu(k,3412) - lu(k,3733) = lu(k,3733) - lu(k,2421) * lu(k,3732) - lu(k,3734) = lu(k,3734) - lu(k,2422) * lu(k,3732) - lu(k,3735) = lu(k,3735) - lu(k,2423) * lu(k,3732) - lu(k,3737) = lu(k,3737) - lu(k,2424) * lu(k,3732) - lu(k,3738) = lu(k,3738) - lu(k,2425) * lu(k,3732) - lu(k,3740) = lu(k,3740) - lu(k,2426) * lu(k,3732) - lu(k,3741) = lu(k,3741) - lu(k,2427) * lu(k,3732) - lu(k,3742) = lu(k,3742) - lu(k,2428) * lu(k,3732) - lu(k,3743) = lu(k,3743) - lu(k,2429) * lu(k,3732) - lu(k,3744) = lu(k,3744) - lu(k,2430) * lu(k,3732) - lu(k,3746) = lu(k,3746) - lu(k,2431) * lu(k,3732) - lu(k,3748) = lu(k,3748) - lu(k,2432) * lu(k,3732) - lu(k,3750) = lu(k,3750) - lu(k,2433) * lu(k,3732) - lu(k,3751) = lu(k,3751) - lu(k,2434) * lu(k,3732) - lu(k,3752) = lu(k,3752) - lu(k,2435) * lu(k,3732) - lu(k,3753) = lu(k,3753) - lu(k,2436) * lu(k,3732) - lu(k,3755) = lu(k,3755) - lu(k,2437) * lu(k,3732) - lu(k,3756) = lu(k,3756) - lu(k,2438) * lu(k,3732) - lu(k,2445) = 1._r8 / lu(k,2445) - lu(k,2446) = lu(k,2446) * lu(k,2445) - lu(k,2447) = lu(k,2447) * lu(k,2445) - lu(k,2448) = lu(k,2448) * lu(k,2445) - lu(k,2449) = lu(k,2449) * lu(k,2445) - lu(k,2450) = lu(k,2450) * lu(k,2445) - lu(k,2451) = lu(k,2451) * lu(k,2445) - lu(k,2452) = lu(k,2452) * lu(k,2445) - lu(k,2453) = lu(k,2453) * lu(k,2445) - lu(k,2454) = lu(k,2454) * lu(k,2445) - lu(k,2455) = lu(k,2455) * lu(k,2445) - lu(k,2456) = lu(k,2456) * lu(k,2445) - lu(k,2457) = lu(k,2457) * lu(k,2445) - lu(k,2458) = lu(k,2458) * lu(k,2445) - lu(k,2459) = lu(k,2459) * lu(k,2445) - lu(k,2460) = lu(k,2460) * lu(k,2445) - lu(k,2467) = lu(k,2467) - lu(k,2446) * lu(k,2466) - lu(k,2468) = lu(k,2468) - lu(k,2447) * lu(k,2466) - lu(k,2469) = lu(k,2469) - lu(k,2448) * lu(k,2466) - lu(k,2470) = lu(k,2470) - lu(k,2449) * lu(k,2466) - lu(k,2471) = lu(k,2471) - lu(k,2450) * lu(k,2466) - lu(k,2472) = lu(k,2472) - lu(k,2451) * lu(k,2466) - lu(k,2473) = lu(k,2473) - lu(k,2452) * lu(k,2466) - lu(k,2474) = lu(k,2474) - lu(k,2453) * lu(k,2466) - lu(k,2475) = lu(k,2475) - lu(k,2454) * lu(k,2466) - lu(k,2476) = lu(k,2476) - lu(k,2455) * lu(k,2466) - lu(k,2477) = lu(k,2477) - lu(k,2456) * lu(k,2466) - lu(k,2478) = lu(k,2478) - lu(k,2457) * lu(k,2466) - lu(k,2479) = lu(k,2479) - lu(k,2458) * lu(k,2466) - lu(k,2480) = lu(k,2480) - lu(k,2459) * lu(k,2466) - lu(k,2481) = lu(k,2481) - lu(k,2460) * lu(k,2466) - lu(k,2488) = lu(k,2488) - lu(k,2446) * lu(k,2487) - lu(k,2489) = lu(k,2489) - lu(k,2447) * lu(k,2487) - lu(k,2490) = lu(k,2490) - lu(k,2448) * lu(k,2487) - lu(k,2491) = lu(k,2491) - lu(k,2449) * lu(k,2487) - lu(k,2492) = lu(k,2492) - lu(k,2450) * lu(k,2487) - lu(k,2493) = lu(k,2493) - lu(k,2451) * lu(k,2487) - lu(k,2494) = lu(k,2494) - lu(k,2452) * lu(k,2487) - lu(k,2495) = lu(k,2495) - lu(k,2453) * lu(k,2487) - lu(k,2496) = lu(k,2496) - lu(k,2454) * lu(k,2487) - lu(k,2497) = lu(k,2497) - lu(k,2455) * lu(k,2487) - lu(k,2498) = lu(k,2498) - lu(k,2456) * lu(k,2487) - lu(k,2499) = lu(k,2499) - lu(k,2457) * lu(k,2487) - lu(k,2500) = lu(k,2500) - lu(k,2458) * lu(k,2487) - lu(k,2501) = lu(k,2501) - lu(k,2459) * lu(k,2487) - lu(k,2502) = lu(k,2502) - lu(k,2460) * lu(k,2487) - lu(k,2530) = lu(k,2530) - lu(k,2446) * lu(k,2529) - lu(k,2531) = lu(k,2531) - lu(k,2447) * lu(k,2529) - lu(k,2532) = lu(k,2532) - lu(k,2448) * lu(k,2529) - lu(k,2533) = lu(k,2533) - lu(k,2449) * lu(k,2529) - lu(k,2534) = lu(k,2534) - lu(k,2450) * lu(k,2529) - lu(k,2535) = lu(k,2535) - lu(k,2451) * lu(k,2529) - lu(k,2536) = lu(k,2536) - lu(k,2452) * lu(k,2529) - lu(k,2537) = lu(k,2537) - lu(k,2453) * lu(k,2529) - lu(k,2538) = lu(k,2538) - lu(k,2454) * lu(k,2529) - lu(k,2540) = lu(k,2540) - lu(k,2455) * lu(k,2529) - lu(k,2541) = lu(k,2541) - lu(k,2456) * lu(k,2529) - lu(k,2542) = lu(k,2542) - lu(k,2457) * lu(k,2529) - lu(k,2543) = lu(k,2543) - lu(k,2458) * lu(k,2529) - lu(k,2545) = lu(k,2545) - lu(k,2459) * lu(k,2529) - lu(k,2546) = lu(k,2546) - lu(k,2460) * lu(k,2529) - lu(k,2576) = lu(k,2576) - lu(k,2446) * lu(k,2575) - lu(k,2577) = lu(k,2577) - lu(k,2447) * lu(k,2575) - lu(k,2578) = lu(k,2578) - lu(k,2448) * lu(k,2575) - lu(k,2579) = lu(k,2579) - lu(k,2449) * lu(k,2575) - lu(k,2580) = lu(k,2580) - lu(k,2450) * lu(k,2575) - lu(k,2581) = lu(k,2581) - lu(k,2451) * lu(k,2575) - lu(k,2582) = lu(k,2582) - lu(k,2452) * lu(k,2575) - lu(k,2583) = lu(k,2583) - lu(k,2453) * lu(k,2575) - lu(k,2584) = lu(k,2584) - lu(k,2454) * lu(k,2575) - lu(k,2586) = lu(k,2586) - lu(k,2455) * lu(k,2575) - lu(k,2587) = lu(k,2587) - lu(k,2456) * lu(k,2575) - lu(k,2588) = lu(k,2588) - lu(k,2457) * lu(k,2575) - lu(k,2589) = lu(k,2589) - lu(k,2458) * lu(k,2575) - lu(k,2591) = lu(k,2591) - lu(k,2459) * lu(k,2575) - lu(k,2592) = lu(k,2592) - lu(k,2460) * lu(k,2575) - lu(k,2623) = lu(k,2623) - lu(k,2446) * lu(k,2622) - lu(k,2624) = lu(k,2624) - lu(k,2447) * lu(k,2622) - lu(k,2625) = lu(k,2625) - lu(k,2448) * lu(k,2622) - lu(k,2626) = lu(k,2626) - lu(k,2449) * lu(k,2622) - lu(k,2627) = lu(k,2627) - lu(k,2450) * lu(k,2622) - lu(k,2628) = lu(k,2628) - lu(k,2451) * lu(k,2622) - lu(k,2629) = lu(k,2629) - lu(k,2452) * lu(k,2622) - lu(k,2630) = lu(k,2630) - lu(k,2453) * lu(k,2622) - lu(k,2631) = lu(k,2631) - lu(k,2454) * lu(k,2622) - lu(k,2633) = lu(k,2633) - lu(k,2455) * lu(k,2622) - lu(k,2634) = lu(k,2634) - lu(k,2456) * lu(k,2622) - lu(k,2635) = lu(k,2635) - lu(k,2457) * lu(k,2622) - lu(k,2636) = lu(k,2636) - lu(k,2458) * lu(k,2622) - lu(k,2638) = lu(k,2638) - lu(k,2459) * lu(k,2622) - lu(k,2639) = lu(k,2639) - lu(k,2460) * lu(k,2622) - lu(k,2694) = lu(k,2694) - lu(k,2446) * lu(k,2693) - lu(k,2695) = lu(k,2695) - lu(k,2447) * lu(k,2693) - lu(k,2696) = lu(k,2696) - lu(k,2448) * lu(k,2693) - lu(k,2697) = lu(k,2697) - lu(k,2449) * lu(k,2693) - lu(k,2698) = lu(k,2698) - lu(k,2450) * lu(k,2693) - lu(k,2699) = lu(k,2699) - lu(k,2451) * lu(k,2693) - lu(k,2700) = lu(k,2700) - lu(k,2452) * lu(k,2693) - lu(k,2701) = lu(k,2701) - lu(k,2453) * lu(k,2693) - lu(k,2702) = lu(k,2702) - lu(k,2454) * lu(k,2693) - lu(k,2704) = lu(k,2704) - lu(k,2455) * lu(k,2693) - lu(k,2705) = lu(k,2705) - lu(k,2456) * lu(k,2693) - lu(k,2706) = lu(k,2706) - lu(k,2457) * lu(k,2693) - lu(k,2707) = lu(k,2707) - lu(k,2458) * lu(k,2693) - lu(k,2709) = lu(k,2709) - lu(k,2459) * lu(k,2693) - lu(k,2710) = lu(k,2710) - lu(k,2460) * lu(k,2693) - lu(k,2877) = lu(k,2877) - lu(k,2446) * lu(k,2876) - lu(k,2878) = lu(k,2878) - lu(k,2447) * lu(k,2876) - lu(k,2879) = lu(k,2879) - lu(k,2448) * lu(k,2876) - lu(k,2880) = lu(k,2880) - lu(k,2449) * lu(k,2876) - lu(k,2881) = lu(k,2881) - lu(k,2450) * lu(k,2876) - lu(k,2882) = lu(k,2882) - lu(k,2451) * lu(k,2876) - lu(k,2883) = lu(k,2883) - lu(k,2452) * lu(k,2876) - lu(k,2884) = lu(k,2884) - lu(k,2453) * lu(k,2876) - lu(k,2885) = lu(k,2885) - lu(k,2454) * lu(k,2876) - lu(k,2887) = lu(k,2887) - lu(k,2455) * lu(k,2876) - lu(k,2889) = lu(k,2889) - lu(k,2456) * lu(k,2876) - lu(k,2891) = lu(k,2891) - lu(k,2457) * lu(k,2876) - lu(k,2892) = lu(k,2892) - lu(k,2458) * lu(k,2876) - lu(k,2894) = lu(k,2894) - lu(k,2459) * lu(k,2876) - lu(k,2895) = lu(k,2895) - lu(k,2460) * lu(k,2876) - lu(k,2978) = lu(k,2978) - lu(k,2446) * lu(k,2977) - lu(k,2979) = lu(k,2979) - lu(k,2447) * lu(k,2977) - lu(k,2980) = lu(k,2980) - lu(k,2448) * lu(k,2977) - lu(k,2981) = lu(k,2981) - lu(k,2449) * lu(k,2977) - lu(k,2982) = lu(k,2982) - lu(k,2450) * lu(k,2977) - lu(k,2983) = lu(k,2983) - lu(k,2451) * lu(k,2977) - lu(k,2984) = lu(k,2984) - lu(k,2452) * lu(k,2977) - lu(k,2985) = lu(k,2985) - lu(k,2453) * lu(k,2977) - lu(k,2986) = lu(k,2986) - lu(k,2454) * lu(k,2977) - lu(k,2988) = lu(k,2988) - lu(k,2455) * lu(k,2977) - lu(k,2990) = lu(k,2990) - lu(k,2456) * lu(k,2977) - lu(k,2992) = lu(k,2992) - lu(k,2457) * lu(k,2977) - lu(k,2993) = lu(k,2993) - lu(k,2458) * lu(k,2977) - lu(k,2995) = lu(k,2995) - lu(k,2459) * lu(k,2977) - lu(k,2996) = lu(k,2996) - lu(k,2460) * lu(k,2977) - lu(k,3070) = lu(k,3070) - lu(k,2446) * lu(k,3069) - lu(k,3071) = lu(k,3071) - lu(k,2447) * lu(k,3069) - lu(k,3072) = lu(k,3072) - lu(k,2448) * lu(k,3069) - lu(k,3073) = lu(k,3073) - lu(k,2449) * lu(k,3069) - lu(k,3074) = lu(k,3074) - lu(k,2450) * lu(k,3069) - lu(k,3075) = lu(k,3075) - lu(k,2451) * lu(k,3069) - lu(k,3076) = lu(k,3076) - lu(k,2452) * lu(k,3069) - lu(k,3077) = lu(k,3077) - lu(k,2453) * lu(k,3069) - lu(k,3078) = lu(k,3078) - lu(k,2454) * lu(k,3069) - lu(k,3080) = lu(k,3080) - lu(k,2455) * lu(k,3069) - lu(k,3082) = lu(k,3082) - lu(k,2456) * lu(k,3069) - lu(k,3084) = lu(k,3084) - lu(k,2457) * lu(k,3069) - lu(k,3085) = lu(k,3085) - lu(k,2458) * lu(k,3069) - lu(k,3087) = lu(k,3087) - lu(k,2459) * lu(k,3069) - lu(k,3088) = lu(k,3088) - lu(k,2460) * lu(k,3069) - lu(k,3273) = lu(k,3273) - lu(k,2446) * lu(k,3272) - lu(k,3274) = lu(k,3274) - lu(k,2447) * lu(k,3272) - lu(k,3275) = lu(k,3275) - lu(k,2448) * lu(k,3272) - lu(k,3276) = lu(k,3276) - lu(k,2449) * lu(k,3272) - lu(k,3277) = lu(k,3277) - lu(k,2450) * lu(k,3272) - lu(k,3278) = lu(k,3278) - lu(k,2451) * lu(k,3272) - lu(k,3279) = lu(k,3279) - lu(k,2452) * lu(k,3272) - lu(k,3280) = lu(k,3280) - lu(k,2453) * lu(k,3272) - lu(k,3281) = lu(k,3281) - lu(k,2454) * lu(k,3272) - lu(k,3283) = lu(k,3283) - lu(k,2455) * lu(k,3272) - lu(k,3285) = lu(k,3285) - lu(k,2456) * lu(k,3272) - lu(k,3287) = lu(k,3287) - lu(k,2457) * lu(k,3272) - lu(k,3288) = lu(k,3288) - lu(k,2458) * lu(k,3272) - lu(k,3290) = lu(k,3290) - lu(k,2459) * lu(k,3272) - lu(k,3291) = lu(k,3291) - lu(k,2460) * lu(k,3272) - lu(k,3414) = lu(k,3414) - lu(k,2446) * lu(k,3413) - lu(k,3415) = lu(k,3415) - lu(k,2447) * lu(k,3413) - lu(k,3416) = lu(k,3416) - lu(k,2448) * lu(k,3413) - lu(k,3417) = lu(k,3417) - lu(k,2449) * lu(k,3413) - lu(k,3418) = lu(k,3418) - lu(k,2450) * lu(k,3413) - lu(k,3419) = lu(k,3419) - lu(k,2451) * lu(k,3413) - lu(k,3420) = lu(k,3420) - lu(k,2452) * lu(k,3413) - lu(k,3421) = lu(k,3421) - lu(k,2453) * lu(k,3413) - lu(k,3422) = lu(k,3422) - lu(k,2454) * lu(k,3413) - lu(k,3424) = lu(k,3424) - lu(k,2455) * lu(k,3413) - lu(k,3426) = lu(k,3426) - lu(k,2456) * lu(k,3413) - lu(k,3428) = lu(k,3428) - lu(k,2457) * lu(k,3413) - lu(k,3429) = lu(k,3429) - lu(k,2458) * lu(k,3413) - lu(k,3431) = lu(k,3431) - lu(k,2459) * lu(k,3413) - lu(k,3432) = lu(k,3432) - lu(k,2460) * lu(k,3413) - lu(k,3734) = lu(k,3734) - lu(k,2446) * lu(k,3733) - lu(k,3735) = lu(k,3735) - lu(k,2447) * lu(k,3733) - lu(k,3736) = lu(k,3736) - lu(k,2448) * lu(k,3733) - lu(k,3737) = lu(k,3737) - lu(k,2449) * lu(k,3733) - lu(k,3738) = lu(k,3738) - lu(k,2450) * lu(k,3733) - lu(k,3739) = lu(k,3739) - lu(k,2451) * lu(k,3733) - lu(k,3740) = lu(k,3740) - lu(k,2452) * lu(k,3733) - lu(k,3741) = lu(k,3741) - lu(k,2453) * lu(k,3733) - lu(k,3742) = lu(k,3742) - lu(k,2454) * lu(k,3733) - lu(k,3744) = lu(k,3744) - lu(k,2455) * lu(k,3733) - lu(k,3746) = lu(k,3746) - lu(k,2456) * lu(k,3733) - lu(k,3748) = lu(k,3748) - lu(k,2457) * lu(k,3733) - lu(k,3749) = lu(k,3749) - lu(k,2458) * lu(k,3733) - lu(k,3751) = lu(k,3751) - lu(k,2459) * lu(k,3733) - lu(k,3752) = lu(k,3752) - lu(k,2460) * lu(k,3733) + lu(k,2349) = 1._r8 / lu(k,2349) + lu(k,2350) = lu(k,2350) * lu(k,2349) + lu(k,2351) = lu(k,2351) * lu(k,2349) + lu(k,2352) = lu(k,2352) * lu(k,2349) + lu(k,2353) = lu(k,2353) * lu(k,2349) + lu(k,2354) = lu(k,2354) * lu(k,2349) + lu(k,2355) = lu(k,2355) * lu(k,2349) + lu(k,2356) = lu(k,2356) * lu(k,2349) + lu(k,2357) = lu(k,2357) * lu(k,2349) + lu(k,2358) = lu(k,2358) * lu(k,2349) + lu(k,2359) = lu(k,2359) * lu(k,2349) + lu(k,2360) = lu(k,2360) * lu(k,2349) + lu(k,2361) = lu(k,2361) * lu(k,2349) + lu(k,2362) = lu(k,2362) * lu(k,2349) + lu(k,2363) = lu(k,2363) * lu(k,2349) + lu(k,2364) = lu(k,2364) * lu(k,2349) + lu(k,2696) = lu(k,2696) - lu(k,2350) * lu(k,2695) + lu(k,2697) = - lu(k,2351) * lu(k,2695) + lu(k,2699) = lu(k,2699) - lu(k,2352) * lu(k,2695) + lu(k,2708) = - lu(k,2353) * lu(k,2695) + lu(k,2709) = - lu(k,2354) * lu(k,2695) + lu(k,2710) = lu(k,2710) - lu(k,2355) * lu(k,2695) + lu(k,2711) = lu(k,2711) - lu(k,2356) * lu(k,2695) + lu(k,2712) = lu(k,2712) - lu(k,2357) * lu(k,2695) + lu(k,2713) = lu(k,2713) - lu(k,2358) * lu(k,2695) + lu(k,2714) = lu(k,2714) - lu(k,2359) * lu(k,2695) + lu(k,2715) = lu(k,2715) - lu(k,2360) * lu(k,2695) + lu(k,2716) = - lu(k,2361) * lu(k,2695) + lu(k,2717) = lu(k,2717) - lu(k,2362) * lu(k,2695) + lu(k,2719) = lu(k,2719) - lu(k,2363) * lu(k,2695) + lu(k,2720) = lu(k,2720) - lu(k,2364) * lu(k,2695) + lu(k,2800) = lu(k,2800) - lu(k,2350) * lu(k,2799) + lu(k,2801) = lu(k,2801) - lu(k,2351) * lu(k,2799) + lu(k,2802) = lu(k,2802) - lu(k,2352) * lu(k,2799) + lu(k,2811) = - lu(k,2353) * lu(k,2799) + lu(k,2812) = - lu(k,2354) * lu(k,2799) + lu(k,2813) = lu(k,2813) - lu(k,2355) * lu(k,2799) + lu(k,2814) = lu(k,2814) - lu(k,2356) * lu(k,2799) + lu(k,2815) = lu(k,2815) - lu(k,2357) * lu(k,2799) + lu(k,2816) = lu(k,2816) - lu(k,2358) * lu(k,2799) + lu(k,2817) = lu(k,2817) - lu(k,2359) * lu(k,2799) + lu(k,2818) = lu(k,2818) - lu(k,2360) * lu(k,2799) + lu(k,2819) = - lu(k,2361) * lu(k,2799) + lu(k,2820) = lu(k,2820) - lu(k,2362) * lu(k,2799) + lu(k,2822) = lu(k,2822) - lu(k,2363) * lu(k,2799) + lu(k,2823) = lu(k,2823) - lu(k,2364) * lu(k,2799) + lu(k,2840) = lu(k,2840) - lu(k,2350) * lu(k,2839) + lu(k,2843) = lu(k,2843) - lu(k,2351) * lu(k,2839) + lu(k,2847) = lu(k,2847) - lu(k,2352) * lu(k,2839) + lu(k,2857) = lu(k,2857) - lu(k,2353) * lu(k,2839) + lu(k,2858) = - lu(k,2354) * lu(k,2839) + lu(k,2859) = lu(k,2859) - lu(k,2355) * lu(k,2839) + lu(k,2860) = lu(k,2860) - lu(k,2356) * lu(k,2839) + lu(k,2861) = lu(k,2861) - lu(k,2357) * lu(k,2839) + lu(k,2862) = lu(k,2862) - lu(k,2358) * lu(k,2839) + lu(k,2863) = lu(k,2863) - lu(k,2359) * lu(k,2839) + lu(k,2864) = lu(k,2864) - lu(k,2360) * lu(k,2839) + lu(k,2865) = - lu(k,2361) * lu(k,2839) + lu(k,2866) = lu(k,2866) - lu(k,2362) * lu(k,2839) + lu(k,2868) = lu(k,2868) - lu(k,2363) * lu(k,2839) + lu(k,2869) = lu(k,2869) - lu(k,2364) * lu(k,2839) + lu(k,2887) = lu(k,2887) - lu(k,2350) * lu(k,2886) + lu(k,2890) = lu(k,2890) - lu(k,2351) * lu(k,2886) + lu(k,2894) = lu(k,2894) - lu(k,2352) * lu(k,2886) + lu(k,2904) = lu(k,2904) - lu(k,2353) * lu(k,2886) + lu(k,2905) = - lu(k,2354) * lu(k,2886) + lu(k,2906) = lu(k,2906) - lu(k,2355) * lu(k,2886) + lu(k,2907) = lu(k,2907) - lu(k,2356) * lu(k,2886) + lu(k,2908) = lu(k,2908) - lu(k,2357) * lu(k,2886) + lu(k,2909) = lu(k,2909) - lu(k,2358) * lu(k,2886) + lu(k,2910) = lu(k,2910) - lu(k,2359) * lu(k,2886) + lu(k,2911) = lu(k,2911) - lu(k,2360) * lu(k,2886) + lu(k,2912) = - lu(k,2361) * lu(k,2886) + lu(k,2913) = lu(k,2913) - lu(k,2362) * lu(k,2886) + lu(k,2915) = lu(k,2915) - lu(k,2363) * lu(k,2886) + lu(k,2916) = lu(k,2916) - lu(k,2364) * lu(k,2886) + lu(k,2933) = lu(k,2933) - lu(k,2350) * lu(k,2932) + lu(k,2936) = lu(k,2936) - lu(k,2351) * lu(k,2932) + lu(k,2940) = lu(k,2940) - lu(k,2352) * lu(k,2932) + lu(k,2950) = lu(k,2950) - lu(k,2353) * lu(k,2932) + lu(k,2951) = - lu(k,2354) * lu(k,2932) + lu(k,2952) = lu(k,2952) - lu(k,2355) * lu(k,2932) + lu(k,2953) = lu(k,2953) - lu(k,2356) * lu(k,2932) + lu(k,2954) = lu(k,2954) - lu(k,2357) * lu(k,2932) + lu(k,2955) = lu(k,2955) - lu(k,2358) * lu(k,2932) + lu(k,2956) = lu(k,2956) - lu(k,2359) * lu(k,2932) + lu(k,2957) = lu(k,2957) - lu(k,2360) * lu(k,2932) + lu(k,2958) = - lu(k,2361) * lu(k,2932) + lu(k,2959) = lu(k,2959) - lu(k,2362) * lu(k,2932) + lu(k,2961) = lu(k,2961) - lu(k,2363) * lu(k,2932) + lu(k,2962) = lu(k,2962) - lu(k,2364) * lu(k,2932) + lu(k,3005) = lu(k,3005) - lu(k,2350) * lu(k,3004) + lu(k,3008) = lu(k,3008) - lu(k,2351) * lu(k,3004) + lu(k,3014) = lu(k,3014) - lu(k,2352) * lu(k,3004) + lu(k,3024) = lu(k,3024) - lu(k,2353) * lu(k,3004) + lu(k,3025) = lu(k,3025) - lu(k,2354) * lu(k,3004) + lu(k,3026) = lu(k,3026) - lu(k,2355) * lu(k,3004) + lu(k,3027) = lu(k,3027) - lu(k,2356) * lu(k,3004) + lu(k,3028) = lu(k,3028) - lu(k,2357) * lu(k,3004) + lu(k,3029) = lu(k,3029) - lu(k,2358) * lu(k,3004) + lu(k,3030) = lu(k,3030) - lu(k,2359) * lu(k,3004) + lu(k,3031) = lu(k,3031) - lu(k,2360) * lu(k,3004) + lu(k,3032) = lu(k,3032) - lu(k,2361) * lu(k,3004) + lu(k,3033) = lu(k,3033) - lu(k,2362) * lu(k,3004) + lu(k,3035) = lu(k,3035) - lu(k,2363) * lu(k,3004) + lu(k,3036) = lu(k,3036) - lu(k,2364) * lu(k,3004) + lu(k,3106) = lu(k,3106) - lu(k,2350) * lu(k,3105) + lu(k,3109) = lu(k,3109) - lu(k,2351) * lu(k,3105) + lu(k,3117) = lu(k,3117) - lu(k,2352) * lu(k,3105) + lu(k,3127) = lu(k,3127) - lu(k,2353) * lu(k,3105) + lu(k,3128) = lu(k,3128) - lu(k,2354) * lu(k,3105) + lu(k,3129) = lu(k,3129) - lu(k,2355) * lu(k,3105) + lu(k,3130) = lu(k,3130) - lu(k,2356) * lu(k,3105) + lu(k,3131) = lu(k,3131) - lu(k,2357) * lu(k,3105) + lu(k,3132) = lu(k,3132) - lu(k,2358) * lu(k,3105) + lu(k,3133) = lu(k,3133) - lu(k,2359) * lu(k,3105) + lu(k,3134) = lu(k,3134) - lu(k,2360) * lu(k,3105) + lu(k,3135) = lu(k,3135) - lu(k,2361) * lu(k,3105) + lu(k,3136) = lu(k,3136) - lu(k,2362) * lu(k,3105) + lu(k,3138) = lu(k,3138) - lu(k,2363) * lu(k,3105) + lu(k,3139) = lu(k,3139) - lu(k,2364) * lu(k,3105) + lu(k,3288) = lu(k,3288) - lu(k,2350) * lu(k,3287) + lu(k,3291) = lu(k,3291) - lu(k,2351) * lu(k,3287) + lu(k,3299) = lu(k,3299) - lu(k,2352) * lu(k,3287) + lu(k,3309) = lu(k,3309) - lu(k,2353) * lu(k,3287) + lu(k,3310) = lu(k,3310) - lu(k,2354) * lu(k,3287) + lu(k,3311) = lu(k,3311) - lu(k,2355) * lu(k,3287) + lu(k,3312) = lu(k,3312) - lu(k,2356) * lu(k,3287) + lu(k,3313) = lu(k,3313) - lu(k,2357) * lu(k,3287) + lu(k,3314) = lu(k,3314) - lu(k,2358) * lu(k,3287) + lu(k,3315) = lu(k,3315) - lu(k,2359) * lu(k,3287) + lu(k,3316) = lu(k,3316) - lu(k,2360) * lu(k,3287) + lu(k,3317) = lu(k,3317) - lu(k,2361) * lu(k,3287) + lu(k,3318) = lu(k,3318) - lu(k,2362) * lu(k,3287) + lu(k,3320) = lu(k,3320) - lu(k,2363) * lu(k,3287) + lu(k,3321) = lu(k,3321) - lu(k,2364) * lu(k,3287) + lu(k,3544) = lu(k,3544) - lu(k,2350) * lu(k,3543) + lu(k,3547) = lu(k,3547) - lu(k,2351) * lu(k,3543) + lu(k,3555) = lu(k,3555) - lu(k,2352) * lu(k,3543) + lu(k,3565) = lu(k,3565) - lu(k,2353) * lu(k,3543) + lu(k,3566) = lu(k,3566) - lu(k,2354) * lu(k,3543) + lu(k,3567) = lu(k,3567) - lu(k,2355) * lu(k,3543) + lu(k,3568) = lu(k,3568) - lu(k,2356) * lu(k,3543) + lu(k,3569) = lu(k,3569) - lu(k,2357) * lu(k,3543) + lu(k,3570) = lu(k,3570) - lu(k,2358) * lu(k,3543) + lu(k,3571) = lu(k,3571) - lu(k,2359) * lu(k,3543) + lu(k,3572) = lu(k,3572) - lu(k,2360) * lu(k,3543) + lu(k,3573) = lu(k,3573) - lu(k,2361) * lu(k,3543) + lu(k,3574) = lu(k,3574) - lu(k,2362) * lu(k,3543) + lu(k,3576) = lu(k,3576) - lu(k,2363) * lu(k,3543) + lu(k,3577) = lu(k,3577) - lu(k,2364) * lu(k,3543) + lu(k,3794) = lu(k,3794) - lu(k,2350) * lu(k,3793) + lu(k,3797) = lu(k,3797) - lu(k,2351) * lu(k,3793) + lu(k,3805) = lu(k,3805) - lu(k,2352) * lu(k,3793) + lu(k,3815) = lu(k,3815) - lu(k,2353) * lu(k,3793) + lu(k,3816) = lu(k,3816) - lu(k,2354) * lu(k,3793) + lu(k,3817) = lu(k,3817) - lu(k,2355) * lu(k,3793) + lu(k,3818) = lu(k,3818) - lu(k,2356) * lu(k,3793) + lu(k,3819) = lu(k,3819) - lu(k,2357) * lu(k,3793) + lu(k,3820) = lu(k,3820) - lu(k,2358) * lu(k,3793) + lu(k,3821) = lu(k,3821) - lu(k,2359) * lu(k,3793) + lu(k,3822) = lu(k,3822) - lu(k,2360) * lu(k,3793) + lu(k,3823) = lu(k,3823) - lu(k,2361) * lu(k,3793) + lu(k,3824) = lu(k,3824) - lu(k,2362) * lu(k,3793) + lu(k,3826) = lu(k,3826) - lu(k,2363) * lu(k,3793) + lu(k,3827) = lu(k,3827) - lu(k,2364) * lu(k,3793) + lu(k,3929) = lu(k,3929) - lu(k,2350) * lu(k,3928) + lu(k,3932) = lu(k,3932) - lu(k,2351) * lu(k,3928) + lu(k,3940) = lu(k,3940) - lu(k,2352) * lu(k,3928) + lu(k,3950) = lu(k,3950) - lu(k,2353) * lu(k,3928) + lu(k,3951) = lu(k,3951) - lu(k,2354) * lu(k,3928) + lu(k,3952) = lu(k,3952) - lu(k,2355) * lu(k,3928) + lu(k,3953) = lu(k,3953) - lu(k,2356) * lu(k,3928) + lu(k,3954) = lu(k,3954) - lu(k,2357) * lu(k,3928) + lu(k,3955) = lu(k,3955) - lu(k,2358) * lu(k,3928) + lu(k,3956) = lu(k,3956) - lu(k,2359) * lu(k,3928) + lu(k,3957) = lu(k,3957) - lu(k,2360) * lu(k,3928) + lu(k,3958) = lu(k,3958) - lu(k,2361) * lu(k,3928) + lu(k,3959) = lu(k,3959) - lu(k,2362) * lu(k,3928) + lu(k,3961) = lu(k,3961) - lu(k,2363) * lu(k,3928) + lu(k,3962) = lu(k,3962) - lu(k,2364) * lu(k,3928) + lu(k,4022) = lu(k,4022) - lu(k,2350) * lu(k,4021) + lu(k,4025) = lu(k,4025) - lu(k,2351) * lu(k,4021) + lu(k,4032) = lu(k,4032) - lu(k,2352) * lu(k,4021) + lu(k,4042) = lu(k,4042) - lu(k,2353) * lu(k,4021) + lu(k,4043) = lu(k,4043) - lu(k,2354) * lu(k,4021) + lu(k,4044) = lu(k,4044) - lu(k,2355) * lu(k,4021) + lu(k,4045) = lu(k,4045) - lu(k,2356) * lu(k,4021) + lu(k,4046) = lu(k,4046) - lu(k,2357) * lu(k,4021) + lu(k,4047) = lu(k,4047) - lu(k,2358) * lu(k,4021) + lu(k,4048) = lu(k,4048) - lu(k,2359) * lu(k,4021) + lu(k,4049) = lu(k,4049) - lu(k,2360) * lu(k,4021) + lu(k,4050) = lu(k,4050) - lu(k,2361) * lu(k,4021) + lu(k,4051) = lu(k,4051) - lu(k,2362) * lu(k,4021) + lu(k,4053) = lu(k,4053) - lu(k,2363) * lu(k,4021) + lu(k,4054) = lu(k,4054) - lu(k,2364) * lu(k,4021) + lu(k,2366) = 1._r8 / lu(k,2366) + lu(k,2367) = lu(k,2367) * lu(k,2366) + lu(k,2368) = lu(k,2368) * lu(k,2366) + lu(k,2369) = lu(k,2369) * lu(k,2366) + lu(k,2370) = lu(k,2370) * lu(k,2366) + lu(k,2371) = lu(k,2371) * lu(k,2366) + lu(k,2372) = lu(k,2372) * lu(k,2366) + lu(k,2373) = lu(k,2373) * lu(k,2366) + lu(k,2374) = lu(k,2374) * lu(k,2366) + lu(k,2384) = lu(k,2384) - lu(k,2367) * lu(k,2380) + lu(k,2386) = lu(k,2386) - lu(k,2368) * lu(k,2380) + lu(k,2388) = lu(k,2388) - lu(k,2369) * lu(k,2380) + lu(k,2392) = lu(k,2392) - lu(k,2370) * lu(k,2380) + lu(k,2394) = lu(k,2394) - lu(k,2371) * lu(k,2380) + lu(k,2395) = lu(k,2395) - lu(k,2372) * lu(k,2380) + lu(k,2396) = lu(k,2396) - lu(k,2373) * lu(k,2380) + lu(k,2397) = lu(k,2397) - lu(k,2374) * lu(k,2380) + lu(k,2414) = lu(k,2414) - lu(k,2367) * lu(k,2410) + lu(k,2416) = lu(k,2416) - lu(k,2368) * lu(k,2410) + lu(k,2418) = lu(k,2418) - lu(k,2369) * lu(k,2410) + lu(k,2422) = lu(k,2422) - lu(k,2370) * lu(k,2410) + lu(k,2424) = lu(k,2424) - lu(k,2371) * lu(k,2410) + lu(k,2425) = lu(k,2425) - lu(k,2372) * lu(k,2410) + lu(k,2426) = lu(k,2426) - lu(k,2373) * lu(k,2410) + lu(k,2427) = lu(k,2427) - lu(k,2374) * lu(k,2410) + lu(k,2439) = - lu(k,2367) * lu(k,2436) + lu(k,2441) = - lu(k,2368) * lu(k,2436) + lu(k,2443) = - lu(k,2369) * lu(k,2436) + lu(k,2445) = lu(k,2445) - lu(k,2370) * lu(k,2436) + lu(k,2447) = lu(k,2447) - lu(k,2371) * lu(k,2436) + lu(k,2448) = lu(k,2448) - lu(k,2372) * lu(k,2436) + lu(k,2449) = lu(k,2449) - lu(k,2373) * lu(k,2436) + lu(k,2450) = lu(k,2450) - lu(k,2374) * lu(k,2436) + lu(k,2468) = lu(k,2468) - lu(k,2367) * lu(k,2464) + lu(k,2470) = lu(k,2470) - lu(k,2368) * lu(k,2464) + lu(k,2472) = lu(k,2472) - lu(k,2369) * lu(k,2464) + lu(k,2476) = lu(k,2476) - lu(k,2370) * lu(k,2464) + lu(k,2478) = lu(k,2478) - lu(k,2371) * lu(k,2464) + lu(k,2479) = lu(k,2479) - lu(k,2372) * lu(k,2464) + lu(k,2480) = lu(k,2480) - lu(k,2373) * lu(k,2464) + lu(k,2481) = lu(k,2481) - lu(k,2374) * lu(k,2464) + lu(k,2502) = lu(k,2502) - lu(k,2367) * lu(k,2498) + lu(k,2504) = lu(k,2504) - lu(k,2368) * lu(k,2498) + lu(k,2506) = lu(k,2506) - lu(k,2369) * lu(k,2498) + lu(k,2510) = lu(k,2510) - lu(k,2370) * lu(k,2498) + lu(k,2512) = lu(k,2512) - lu(k,2371) * lu(k,2498) + lu(k,2513) = lu(k,2513) - lu(k,2372) * lu(k,2498) + lu(k,2514) = lu(k,2514) - lu(k,2373) * lu(k,2498) + lu(k,2515) = lu(k,2515) - lu(k,2374) * lu(k,2498) + lu(k,2531) = lu(k,2531) - lu(k,2367) * lu(k,2529) + lu(k,2533) = lu(k,2533) - lu(k,2368) * lu(k,2529) + lu(k,2535) = lu(k,2535) - lu(k,2369) * lu(k,2529) + lu(k,2539) = lu(k,2539) - lu(k,2370) * lu(k,2529) + lu(k,2541) = lu(k,2541) - lu(k,2371) * lu(k,2529) + lu(k,2542) = lu(k,2542) - lu(k,2372) * lu(k,2529) + lu(k,2543) = lu(k,2543) - lu(k,2373) * lu(k,2529) + lu(k,2544) = lu(k,2544) - lu(k,2374) * lu(k,2529) + lu(k,2664) = - lu(k,2367) * lu(k,2662) + lu(k,2666) = - lu(k,2368) * lu(k,2662) + lu(k,2668) = - lu(k,2369) * lu(k,2662) + lu(k,2672) = lu(k,2672) - lu(k,2370) * lu(k,2662) + lu(k,2674) = lu(k,2674) - lu(k,2371) * lu(k,2662) + lu(k,2675) = lu(k,2675) - lu(k,2372) * lu(k,2662) + lu(k,2676) = lu(k,2676) - lu(k,2373) * lu(k,2662) + lu(k,2678) = lu(k,2678) - lu(k,2374) * lu(k,2662) + lu(k,2701) = lu(k,2701) - lu(k,2367) * lu(k,2696) + lu(k,2703) = lu(k,2703) - lu(k,2368) * lu(k,2696) + lu(k,2705) = lu(k,2705) - lu(k,2369) * lu(k,2696) + lu(k,2711) = lu(k,2711) - lu(k,2370) * lu(k,2696) + lu(k,2713) = lu(k,2713) - lu(k,2371) * lu(k,2696) + lu(k,2714) = lu(k,2714) - lu(k,2372) * lu(k,2696) + lu(k,2715) = lu(k,2715) - lu(k,2373) * lu(k,2696) + lu(k,2717) = lu(k,2717) - lu(k,2374) * lu(k,2696) + lu(k,2728) = lu(k,2728) - lu(k,2367) * lu(k,2727) + lu(k,2730) = lu(k,2730) - lu(k,2368) * lu(k,2727) + lu(k,2732) = lu(k,2732) - lu(k,2369) * lu(k,2727) + lu(k,2736) = lu(k,2736) - lu(k,2370) * lu(k,2727) + lu(k,2738) = lu(k,2738) - lu(k,2371) * lu(k,2727) + lu(k,2739) = lu(k,2739) - lu(k,2372) * lu(k,2727) + lu(k,2740) = lu(k,2740) - lu(k,2373) * lu(k,2727) + lu(k,2741) = lu(k,2741) - lu(k,2374) * lu(k,2727) + lu(k,2750) = lu(k,2750) - lu(k,2367) * lu(k,2749) + lu(k,2752) = lu(k,2752) - lu(k,2368) * lu(k,2749) + lu(k,2754) = lu(k,2754) - lu(k,2369) * lu(k,2749) + lu(k,2758) = lu(k,2758) - lu(k,2370) * lu(k,2749) + lu(k,2760) = lu(k,2760) - lu(k,2371) * lu(k,2749) + lu(k,2761) = lu(k,2761) - lu(k,2372) * lu(k,2749) + lu(k,2762) = lu(k,2762) - lu(k,2373) * lu(k,2749) + lu(k,2763) = lu(k,2763) - lu(k,2374) * lu(k,2749) + lu(k,2773) = lu(k,2773) - lu(k,2367) * lu(k,2772) + lu(k,2775) = lu(k,2775) - lu(k,2368) * lu(k,2772) + lu(k,2777) = lu(k,2777) - lu(k,2369) * lu(k,2772) + lu(k,2781) = lu(k,2781) - lu(k,2370) * lu(k,2772) + lu(k,2783) = lu(k,2783) - lu(k,2371) * lu(k,2772) + lu(k,2784) = lu(k,2784) - lu(k,2372) * lu(k,2772) + lu(k,2785) = lu(k,2785) - lu(k,2373) * lu(k,2772) + lu(k,2786) = lu(k,2786) - lu(k,2374) * lu(k,2772) + lu(k,2803) = lu(k,2803) - lu(k,2367) * lu(k,2800) + lu(k,2805) = lu(k,2805) - lu(k,2368) * lu(k,2800) + lu(k,2808) = lu(k,2808) - lu(k,2369) * lu(k,2800) + lu(k,2814) = lu(k,2814) - lu(k,2370) * lu(k,2800) + lu(k,2816) = lu(k,2816) - lu(k,2371) * lu(k,2800) + lu(k,2817) = lu(k,2817) - lu(k,2372) * lu(k,2800) + lu(k,2818) = lu(k,2818) - lu(k,2373) * lu(k,2800) + lu(k,2820) = lu(k,2820) - lu(k,2374) * lu(k,2800) + lu(k,2849) = lu(k,2849) - lu(k,2367) * lu(k,2840) + lu(k,2851) = lu(k,2851) - lu(k,2368) * lu(k,2840) + lu(k,2854) = lu(k,2854) - lu(k,2369) * lu(k,2840) + lu(k,2860) = lu(k,2860) - lu(k,2370) * lu(k,2840) + lu(k,2862) = lu(k,2862) - lu(k,2371) * lu(k,2840) + lu(k,2863) = lu(k,2863) - lu(k,2372) * lu(k,2840) + lu(k,2864) = lu(k,2864) - lu(k,2373) * lu(k,2840) + lu(k,2866) = lu(k,2866) - lu(k,2374) * lu(k,2840) + lu(k,2896) = lu(k,2896) - lu(k,2367) * lu(k,2887) + lu(k,2898) = lu(k,2898) - lu(k,2368) * lu(k,2887) + lu(k,2901) = lu(k,2901) - lu(k,2369) * lu(k,2887) + lu(k,2907) = lu(k,2907) - lu(k,2370) * lu(k,2887) + lu(k,2909) = lu(k,2909) - lu(k,2371) * lu(k,2887) + lu(k,2910) = lu(k,2910) - lu(k,2372) * lu(k,2887) + lu(k,2911) = lu(k,2911) - lu(k,2373) * lu(k,2887) + lu(k,2913) = lu(k,2913) - lu(k,2374) * lu(k,2887) + lu(k,2942) = lu(k,2942) - lu(k,2367) * lu(k,2933) + lu(k,2944) = lu(k,2944) - lu(k,2368) * lu(k,2933) + lu(k,2947) = lu(k,2947) - lu(k,2369) * lu(k,2933) + lu(k,2953) = lu(k,2953) - lu(k,2370) * lu(k,2933) + lu(k,2955) = lu(k,2955) - lu(k,2371) * lu(k,2933) + lu(k,2956) = lu(k,2956) - lu(k,2372) * lu(k,2933) + lu(k,2957) = lu(k,2957) - lu(k,2373) * lu(k,2933) + lu(k,2959) = lu(k,2959) - lu(k,2374) * lu(k,2933) + lu(k,3016) = lu(k,3016) - lu(k,2367) * lu(k,3005) + lu(k,3018) = lu(k,3018) - lu(k,2368) * lu(k,3005) + lu(k,3021) = lu(k,3021) - lu(k,2369) * lu(k,3005) + lu(k,3027) = lu(k,3027) - lu(k,2370) * lu(k,3005) + lu(k,3029) = lu(k,3029) - lu(k,2371) * lu(k,3005) + lu(k,3030) = lu(k,3030) - lu(k,2372) * lu(k,3005) + lu(k,3031) = lu(k,3031) - lu(k,2373) * lu(k,3005) + lu(k,3033) = lu(k,3033) - lu(k,2374) * lu(k,3005) + lu(k,3119) = lu(k,3119) - lu(k,2367) * lu(k,3106) + lu(k,3121) = lu(k,3121) - lu(k,2368) * lu(k,3106) + lu(k,3124) = lu(k,3124) - lu(k,2369) * lu(k,3106) + lu(k,3130) = lu(k,3130) - lu(k,2370) * lu(k,3106) + lu(k,3132) = lu(k,3132) - lu(k,2371) * lu(k,3106) + lu(k,3133) = lu(k,3133) - lu(k,2372) * lu(k,3106) + lu(k,3134) = lu(k,3134) - lu(k,2373) * lu(k,3106) + lu(k,3136) = lu(k,3136) - lu(k,2374) * lu(k,3106) + lu(k,3301) = lu(k,3301) - lu(k,2367) * lu(k,3288) + lu(k,3303) = lu(k,3303) - lu(k,2368) * lu(k,3288) + lu(k,3306) = lu(k,3306) - lu(k,2369) * lu(k,3288) + lu(k,3312) = lu(k,3312) - lu(k,2370) * lu(k,3288) + lu(k,3314) = lu(k,3314) - lu(k,2371) * lu(k,3288) + lu(k,3315) = lu(k,3315) - lu(k,2372) * lu(k,3288) + lu(k,3316) = lu(k,3316) - lu(k,2373) * lu(k,3288) + lu(k,3318) = lu(k,3318) - lu(k,2374) * lu(k,3288) + lu(k,3557) = lu(k,3557) - lu(k,2367) * lu(k,3544) + lu(k,3559) = lu(k,3559) - lu(k,2368) * lu(k,3544) + lu(k,3562) = lu(k,3562) - lu(k,2369) * lu(k,3544) + lu(k,3568) = lu(k,3568) - lu(k,2370) * lu(k,3544) + lu(k,3570) = lu(k,3570) - lu(k,2371) * lu(k,3544) + lu(k,3571) = lu(k,3571) - lu(k,2372) * lu(k,3544) + lu(k,3572) = lu(k,3572) - lu(k,2373) * lu(k,3544) + lu(k,3574) = lu(k,3574) - lu(k,2374) * lu(k,3544) + lu(k,3807) = lu(k,3807) - lu(k,2367) * lu(k,3794) + lu(k,3809) = lu(k,3809) - lu(k,2368) * lu(k,3794) + lu(k,3812) = lu(k,3812) - lu(k,2369) * lu(k,3794) + lu(k,3818) = lu(k,3818) - lu(k,2370) * lu(k,3794) + lu(k,3820) = lu(k,3820) - lu(k,2371) * lu(k,3794) + lu(k,3821) = lu(k,3821) - lu(k,2372) * lu(k,3794) + lu(k,3822) = lu(k,3822) - lu(k,2373) * lu(k,3794) + lu(k,3824) = lu(k,3824) - lu(k,2374) * lu(k,3794) + lu(k,3942) = lu(k,3942) - lu(k,2367) * lu(k,3929) + lu(k,3944) = lu(k,3944) - lu(k,2368) * lu(k,3929) + lu(k,3947) = lu(k,3947) - lu(k,2369) * lu(k,3929) + lu(k,3953) = lu(k,3953) - lu(k,2370) * lu(k,3929) + lu(k,3955) = lu(k,3955) - lu(k,2371) * lu(k,3929) + lu(k,3956) = lu(k,3956) - lu(k,2372) * lu(k,3929) + lu(k,3957) = lu(k,3957) - lu(k,2373) * lu(k,3929) + lu(k,3959) = lu(k,3959) - lu(k,2374) * lu(k,3929) + lu(k,4034) = lu(k,4034) - lu(k,2367) * lu(k,4022) + lu(k,4036) = lu(k,4036) - lu(k,2368) * lu(k,4022) + lu(k,4039) = lu(k,4039) - lu(k,2369) * lu(k,4022) + lu(k,4045) = lu(k,4045) - lu(k,2370) * lu(k,4022) + lu(k,4047) = lu(k,4047) - lu(k,2371) * lu(k,4022) + lu(k,4048) = lu(k,4048) - lu(k,2372) * lu(k,4022) + lu(k,4049) = lu(k,4049) - lu(k,2373) * lu(k,4022) + lu(k,4051) = lu(k,4051) - lu(k,2374) * lu(k,4022) + lu(k,2381) = 1._r8 / lu(k,2381) + lu(k,2382) = lu(k,2382) * lu(k,2381) + lu(k,2383) = lu(k,2383) * lu(k,2381) + lu(k,2384) = lu(k,2384) * lu(k,2381) + lu(k,2385) = lu(k,2385) * lu(k,2381) + lu(k,2386) = lu(k,2386) * lu(k,2381) + lu(k,2387) = lu(k,2387) * lu(k,2381) + lu(k,2388) = lu(k,2388) * lu(k,2381) + lu(k,2389) = lu(k,2389) * lu(k,2381) + lu(k,2390) = lu(k,2390) * lu(k,2381) + lu(k,2391) = lu(k,2391) * lu(k,2381) + lu(k,2392) = lu(k,2392) * lu(k,2381) + lu(k,2393) = lu(k,2393) * lu(k,2381) + lu(k,2394) = lu(k,2394) * lu(k,2381) + lu(k,2395) = lu(k,2395) * lu(k,2381) + lu(k,2396) = lu(k,2396) * lu(k,2381) + lu(k,2397) = lu(k,2397) * lu(k,2381) + lu(k,2398) = lu(k,2398) * lu(k,2381) + lu(k,2399) = lu(k,2399) * lu(k,2381) + lu(k,2843) = lu(k,2843) - lu(k,2382) * lu(k,2841) + lu(k,2847) = lu(k,2847) - lu(k,2383) * lu(k,2841) + lu(k,2849) = lu(k,2849) - lu(k,2384) * lu(k,2841) + lu(k,2850) = lu(k,2850) - lu(k,2385) * lu(k,2841) + lu(k,2851) = lu(k,2851) - lu(k,2386) * lu(k,2841) + lu(k,2853) = lu(k,2853) - lu(k,2387) * lu(k,2841) + lu(k,2854) = lu(k,2854) - lu(k,2388) * lu(k,2841) + lu(k,2855) = lu(k,2855) - lu(k,2389) * lu(k,2841) + lu(k,2856) = lu(k,2856) - lu(k,2390) * lu(k,2841) + lu(k,2859) = lu(k,2859) - lu(k,2391) * lu(k,2841) + lu(k,2860) = lu(k,2860) - lu(k,2392) * lu(k,2841) + lu(k,2861) = lu(k,2861) - lu(k,2393) * lu(k,2841) + lu(k,2862) = lu(k,2862) - lu(k,2394) * lu(k,2841) + lu(k,2863) = lu(k,2863) - lu(k,2395) * lu(k,2841) + lu(k,2864) = lu(k,2864) - lu(k,2396) * lu(k,2841) + lu(k,2866) = lu(k,2866) - lu(k,2397) * lu(k,2841) + lu(k,2867) = lu(k,2867) - lu(k,2398) * lu(k,2841) + lu(k,2868) = lu(k,2868) - lu(k,2399) * lu(k,2841) + lu(k,2890) = lu(k,2890) - lu(k,2382) * lu(k,2888) + lu(k,2894) = lu(k,2894) - lu(k,2383) * lu(k,2888) + lu(k,2896) = lu(k,2896) - lu(k,2384) * lu(k,2888) + lu(k,2897) = lu(k,2897) - lu(k,2385) * lu(k,2888) + lu(k,2898) = lu(k,2898) - lu(k,2386) * lu(k,2888) + lu(k,2900) = lu(k,2900) - lu(k,2387) * lu(k,2888) + lu(k,2901) = lu(k,2901) - lu(k,2388) * lu(k,2888) + lu(k,2902) = lu(k,2902) - lu(k,2389) * lu(k,2888) + lu(k,2903) = lu(k,2903) - lu(k,2390) * lu(k,2888) + lu(k,2906) = lu(k,2906) - lu(k,2391) * lu(k,2888) + lu(k,2907) = lu(k,2907) - lu(k,2392) * lu(k,2888) + lu(k,2908) = lu(k,2908) - lu(k,2393) * lu(k,2888) + lu(k,2909) = lu(k,2909) - lu(k,2394) * lu(k,2888) + lu(k,2910) = lu(k,2910) - lu(k,2395) * lu(k,2888) + lu(k,2911) = lu(k,2911) - lu(k,2396) * lu(k,2888) + lu(k,2913) = lu(k,2913) - lu(k,2397) * lu(k,2888) + lu(k,2914) = lu(k,2914) - lu(k,2398) * lu(k,2888) + lu(k,2915) = lu(k,2915) - lu(k,2399) * lu(k,2888) + lu(k,2936) = lu(k,2936) - lu(k,2382) * lu(k,2934) + lu(k,2940) = lu(k,2940) - lu(k,2383) * lu(k,2934) + lu(k,2942) = lu(k,2942) - lu(k,2384) * lu(k,2934) + lu(k,2943) = lu(k,2943) - lu(k,2385) * lu(k,2934) + lu(k,2944) = lu(k,2944) - lu(k,2386) * lu(k,2934) + lu(k,2946) = lu(k,2946) - lu(k,2387) * lu(k,2934) + lu(k,2947) = lu(k,2947) - lu(k,2388) * lu(k,2934) + lu(k,2948) = lu(k,2948) - lu(k,2389) * lu(k,2934) + lu(k,2949) = lu(k,2949) - lu(k,2390) * lu(k,2934) + lu(k,2952) = lu(k,2952) - lu(k,2391) * lu(k,2934) + lu(k,2953) = lu(k,2953) - lu(k,2392) * lu(k,2934) + lu(k,2954) = lu(k,2954) - lu(k,2393) * lu(k,2934) + lu(k,2955) = lu(k,2955) - lu(k,2394) * lu(k,2934) + lu(k,2956) = lu(k,2956) - lu(k,2395) * lu(k,2934) + lu(k,2957) = lu(k,2957) - lu(k,2396) * lu(k,2934) + lu(k,2959) = lu(k,2959) - lu(k,2397) * lu(k,2934) + lu(k,2960) = lu(k,2960) - lu(k,2398) * lu(k,2934) + lu(k,2961) = lu(k,2961) - lu(k,2399) * lu(k,2934) + lu(k,3008) = lu(k,3008) - lu(k,2382) * lu(k,3006) + lu(k,3014) = lu(k,3014) - lu(k,2383) * lu(k,3006) + lu(k,3016) = lu(k,3016) - lu(k,2384) * lu(k,3006) + lu(k,3017) = lu(k,3017) - lu(k,2385) * lu(k,3006) + lu(k,3018) = lu(k,3018) - lu(k,2386) * lu(k,3006) + lu(k,3020) = lu(k,3020) - lu(k,2387) * lu(k,3006) + lu(k,3021) = lu(k,3021) - lu(k,2388) * lu(k,3006) + lu(k,3022) = lu(k,3022) - lu(k,2389) * lu(k,3006) + lu(k,3023) = lu(k,3023) - lu(k,2390) * lu(k,3006) + lu(k,3026) = lu(k,3026) - lu(k,2391) * lu(k,3006) + lu(k,3027) = lu(k,3027) - lu(k,2392) * lu(k,3006) + lu(k,3028) = lu(k,3028) - lu(k,2393) * lu(k,3006) + lu(k,3029) = lu(k,3029) - lu(k,2394) * lu(k,3006) + lu(k,3030) = lu(k,3030) - lu(k,2395) * lu(k,3006) + lu(k,3031) = lu(k,3031) - lu(k,2396) * lu(k,3006) + lu(k,3033) = lu(k,3033) - lu(k,2397) * lu(k,3006) + lu(k,3034) = lu(k,3034) - lu(k,2398) * lu(k,3006) + lu(k,3035) = lu(k,3035) - lu(k,2399) * lu(k,3006) + lu(k,3109) = lu(k,3109) - lu(k,2382) * lu(k,3107) + lu(k,3117) = lu(k,3117) - lu(k,2383) * lu(k,3107) + lu(k,3119) = lu(k,3119) - lu(k,2384) * lu(k,3107) + lu(k,3120) = lu(k,3120) - lu(k,2385) * lu(k,3107) + lu(k,3121) = lu(k,3121) - lu(k,2386) * lu(k,3107) + lu(k,3123) = lu(k,3123) - lu(k,2387) * lu(k,3107) + lu(k,3124) = lu(k,3124) - lu(k,2388) * lu(k,3107) + lu(k,3125) = lu(k,3125) - lu(k,2389) * lu(k,3107) + lu(k,3126) = lu(k,3126) - lu(k,2390) * lu(k,3107) + lu(k,3129) = lu(k,3129) - lu(k,2391) * lu(k,3107) + lu(k,3130) = lu(k,3130) - lu(k,2392) * lu(k,3107) + lu(k,3131) = lu(k,3131) - lu(k,2393) * lu(k,3107) + lu(k,3132) = lu(k,3132) - lu(k,2394) * lu(k,3107) + lu(k,3133) = lu(k,3133) - lu(k,2395) * lu(k,3107) + lu(k,3134) = lu(k,3134) - lu(k,2396) * lu(k,3107) + lu(k,3136) = lu(k,3136) - lu(k,2397) * lu(k,3107) + lu(k,3137) = lu(k,3137) - lu(k,2398) * lu(k,3107) + lu(k,3138) = lu(k,3138) - lu(k,2399) * lu(k,3107) + lu(k,3291) = lu(k,3291) - lu(k,2382) * lu(k,3289) + lu(k,3299) = lu(k,3299) - lu(k,2383) * lu(k,3289) + lu(k,3301) = lu(k,3301) - lu(k,2384) * lu(k,3289) + lu(k,3302) = lu(k,3302) - lu(k,2385) * lu(k,3289) + lu(k,3303) = lu(k,3303) - lu(k,2386) * lu(k,3289) + lu(k,3305) = lu(k,3305) - lu(k,2387) * lu(k,3289) + lu(k,3306) = lu(k,3306) - lu(k,2388) * lu(k,3289) + lu(k,3307) = lu(k,3307) - lu(k,2389) * lu(k,3289) + lu(k,3308) = lu(k,3308) - lu(k,2390) * lu(k,3289) + lu(k,3311) = lu(k,3311) - lu(k,2391) * lu(k,3289) + lu(k,3312) = lu(k,3312) - lu(k,2392) * lu(k,3289) + lu(k,3313) = lu(k,3313) - lu(k,2393) * lu(k,3289) + lu(k,3314) = lu(k,3314) - lu(k,2394) * lu(k,3289) + lu(k,3315) = lu(k,3315) - lu(k,2395) * lu(k,3289) + lu(k,3316) = lu(k,3316) - lu(k,2396) * lu(k,3289) + lu(k,3318) = lu(k,3318) - lu(k,2397) * lu(k,3289) + lu(k,3319) = lu(k,3319) - lu(k,2398) * lu(k,3289) + lu(k,3320) = lu(k,3320) - lu(k,2399) * lu(k,3289) + lu(k,3547) = lu(k,3547) - lu(k,2382) * lu(k,3545) + lu(k,3555) = lu(k,3555) - lu(k,2383) * lu(k,3545) + lu(k,3557) = lu(k,3557) - lu(k,2384) * lu(k,3545) + lu(k,3558) = lu(k,3558) - lu(k,2385) * lu(k,3545) + lu(k,3559) = lu(k,3559) - lu(k,2386) * lu(k,3545) + lu(k,3561) = lu(k,3561) - lu(k,2387) * lu(k,3545) + lu(k,3562) = lu(k,3562) - lu(k,2388) * lu(k,3545) + lu(k,3563) = lu(k,3563) - lu(k,2389) * lu(k,3545) + lu(k,3564) = lu(k,3564) - lu(k,2390) * lu(k,3545) + lu(k,3567) = lu(k,3567) - lu(k,2391) * lu(k,3545) + lu(k,3568) = lu(k,3568) - lu(k,2392) * lu(k,3545) + lu(k,3569) = lu(k,3569) - lu(k,2393) * lu(k,3545) + lu(k,3570) = lu(k,3570) - lu(k,2394) * lu(k,3545) + lu(k,3571) = lu(k,3571) - lu(k,2395) * lu(k,3545) + lu(k,3572) = lu(k,3572) - lu(k,2396) * lu(k,3545) + lu(k,3574) = lu(k,3574) - lu(k,2397) * lu(k,3545) + lu(k,3575) = lu(k,3575) - lu(k,2398) * lu(k,3545) + lu(k,3576) = lu(k,3576) - lu(k,2399) * lu(k,3545) + lu(k,3797) = lu(k,3797) - lu(k,2382) * lu(k,3795) + lu(k,3805) = lu(k,3805) - lu(k,2383) * lu(k,3795) + lu(k,3807) = lu(k,3807) - lu(k,2384) * lu(k,3795) + lu(k,3808) = lu(k,3808) - lu(k,2385) * lu(k,3795) + lu(k,3809) = lu(k,3809) - lu(k,2386) * lu(k,3795) + lu(k,3811) = lu(k,3811) - lu(k,2387) * lu(k,3795) + lu(k,3812) = lu(k,3812) - lu(k,2388) * lu(k,3795) + lu(k,3813) = lu(k,3813) - lu(k,2389) * lu(k,3795) + lu(k,3814) = lu(k,3814) - lu(k,2390) * lu(k,3795) + lu(k,3817) = lu(k,3817) - lu(k,2391) * lu(k,3795) + lu(k,3818) = lu(k,3818) - lu(k,2392) * lu(k,3795) + lu(k,3819) = lu(k,3819) - lu(k,2393) * lu(k,3795) + lu(k,3820) = lu(k,3820) - lu(k,2394) * lu(k,3795) + lu(k,3821) = lu(k,3821) - lu(k,2395) * lu(k,3795) + lu(k,3822) = lu(k,3822) - lu(k,2396) * lu(k,3795) + lu(k,3824) = lu(k,3824) - lu(k,2397) * lu(k,3795) + lu(k,3825) = lu(k,3825) - lu(k,2398) * lu(k,3795) + lu(k,3826) = lu(k,3826) - lu(k,2399) * lu(k,3795) + lu(k,3932) = lu(k,3932) - lu(k,2382) * lu(k,3930) + lu(k,3940) = lu(k,3940) - lu(k,2383) * lu(k,3930) + lu(k,3942) = lu(k,3942) - lu(k,2384) * lu(k,3930) + lu(k,3943) = lu(k,3943) - lu(k,2385) * lu(k,3930) + lu(k,3944) = lu(k,3944) - lu(k,2386) * lu(k,3930) + lu(k,3946) = lu(k,3946) - lu(k,2387) * lu(k,3930) + lu(k,3947) = lu(k,3947) - lu(k,2388) * lu(k,3930) + lu(k,3948) = lu(k,3948) - lu(k,2389) * lu(k,3930) + lu(k,3949) = lu(k,3949) - lu(k,2390) * lu(k,3930) + lu(k,3952) = lu(k,3952) - lu(k,2391) * lu(k,3930) + lu(k,3953) = lu(k,3953) - lu(k,2392) * lu(k,3930) + lu(k,3954) = lu(k,3954) - lu(k,2393) * lu(k,3930) + lu(k,3955) = lu(k,3955) - lu(k,2394) * lu(k,3930) + lu(k,3956) = lu(k,3956) - lu(k,2395) * lu(k,3930) + lu(k,3957) = lu(k,3957) - lu(k,2396) * lu(k,3930) + lu(k,3959) = lu(k,3959) - lu(k,2397) * lu(k,3930) + lu(k,3960) = lu(k,3960) - lu(k,2398) * lu(k,3930) + lu(k,3961) = lu(k,3961) - lu(k,2399) * lu(k,3930) + lu(k,4025) = lu(k,4025) - lu(k,2382) * lu(k,4023) + lu(k,4032) = lu(k,4032) - lu(k,2383) * lu(k,4023) + lu(k,4034) = lu(k,4034) - lu(k,2384) * lu(k,4023) + lu(k,4035) = lu(k,4035) - lu(k,2385) * lu(k,4023) + lu(k,4036) = lu(k,4036) - lu(k,2386) * lu(k,4023) + lu(k,4038) = lu(k,4038) - lu(k,2387) * lu(k,4023) + lu(k,4039) = lu(k,4039) - lu(k,2388) * lu(k,4023) + lu(k,4040) = lu(k,4040) - lu(k,2389) * lu(k,4023) + lu(k,4041) = lu(k,4041) - lu(k,2390) * lu(k,4023) + lu(k,4044) = lu(k,4044) - lu(k,2391) * lu(k,4023) + lu(k,4045) = lu(k,4045) - lu(k,2392) * lu(k,4023) + lu(k,4046) = lu(k,4046) - lu(k,2393) * lu(k,4023) + lu(k,4047) = lu(k,4047) - lu(k,2394) * lu(k,4023) + lu(k,4048) = lu(k,4048) - lu(k,2395) * lu(k,4023) + lu(k,4049) = lu(k,4049) - lu(k,2396) * lu(k,4023) + lu(k,4051) = lu(k,4051) - lu(k,2397) * lu(k,4023) + lu(k,4052) = lu(k,4052) - lu(k,2398) * lu(k,4023) + lu(k,4053) = lu(k,4053) - lu(k,2399) * lu(k,4023) end do end subroutine lu_fac46 subroutine lu_fac47( avec_len, lu ) @@ -13716,693 +12827,612 @@ subroutine lu_fac47( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,2467) = 1._r8 / lu(k,2467) - lu(k,2468) = lu(k,2468) * lu(k,2467) - lu(k,2469) = lu(k,2469) * lu(k,2467) - lu(k,2470) = lu(k,2470) * lu(k,2467) - lu(k,2471) = lu(k,2471) * lu(k,2467) - lu(k,2472) = lu(k,2472) * lu(k,2467) - lu(k,2473) = lu(k,2473) * lu(k,2467) - lu(k,2474) = lu(k,2474) * lu(k,2467) - lu(k,2475) = lu(k,2475) * lu(k,2467) - lu(k,2476) = lu(k,2476) * lu(k,2467) - lu(k,2477) = lu(k,2477) * lu(k,2467) - lu(k,2478) = lu(k,2478) * lu(k,2467) - lu(k,2479) = lu(k,2479) * lu(k,2467) - lu(k,2480) = lu(k,2480) * lu(k,2467) - lu(k,2481) = lu(k,2481) * lu(k,2467) - lu(k,2489) = lu(k,2489) - lu(k,2468) * lu(k,2488) - lu(k,2490) = lu(k,2490) - lu(k,2469) * lu(k,2488) - lu(k,2491) = lu(k,2491) - lu(k,2470) * lu(k,2488) - lu(k,2492) = lu(k,2492) - lu(k,2471) * lu(k,2488) - lu(k,2493) = lu(k,2493) - lu(k,2472) * lu(k,2488) - lu(k,2494) = lu(k,2494) - lu(k,2473) * lu(k,2488) - lu(k,2495) = lu(k,2495) - lu(k,2474) * lu(k,2488) - lu(k,2496) = lu(k,2496) - lu(k,2475) * lu(k,2488) - lu(k,2497) = lu(k,2497) - lu(k,2476) * lu(k,2488) - lu(k,2498) = lu(k,2498) - lu(k,2477) * lu(k,2488) - lu(k,2499) = lu(k,2499) - lu(k,2478) * lu(k,2488) - lu(k,2500) = lu(k,2500) - lu(k,2479) * lu(k,2488) - lu(k,2501) = lu(k,2501) - lu(k,2480) * lu(k,2488) - lu(k,2502) = lu(k,2502) - lu(k,2481) * lu(k,2488) - lu(k,2531) = lu(k,2531) - lu(k,2468) * lu(k,2530) - lu(k,2532) = lu(k,2532) - lu(k,2469) * lu(k,2530) - lu(k,2533) = lu(k,2533) - lu(k,2470) * lu(k,2530) - lu(k,2534) = lu(k,2534) - lu(k,2471) * lu(k,2530) - lu(k,2535) = lu(k,2535) - lu(k,2472) * lu(k,2530) - lu(k,2536) = lu(k,2536) - lu(k,2473) * lu(k,2530) - lu(k,2537) = lu(k,2537) - lu(k,2474) * lu(k,2530) - lu(k,2538) = lu(k,2538) - lu(k,2475) * lu(k,2530) - lu(k,2540) = lu(k,2540) - lu(k,2476) * lu(k,2530) - lu(k,2541) = lu(k,2541) - lu(k,2477) * lu(k,2530) - lu(k,2542) = lu(k,2542) - lu(k,2478) * lu(k,2530) - lu(k,2543) = lu(k,2543) - lu(k,2479) * lu(k,2530) - lu(k,2545) = lu(k,2545) - lu(k,2480) * lu(k,2530) - lu(k,2546) = lu(k,2546) - lu(k,2481) * lu(k,2530) - lu(k,2577) = lu(k,2577) - lu(k,2468) * lu(k,2576) - lu(k,2578) = lu(k,2578) - lu(k,2469) * lu(k,2576) - lu(k,2579) = lu(k,2579) - lu(k,2470) * lu(k,2576) - lu(k,2580) = lu(k,2580) - lu(k,2471) * lu(k,2576) - lu(k,2581) = lu(k,2581) - lu(k,2472) * lu(k,2576) - lu(k,2582) = lu(k,2582) - lu(k,2473) * lu(k,2576) - lu(k,2583) = lu(k,2583) - lu(k,2474) * lu(k,2576) - lu(k,2584) = lu(k,2584) - lu(k,2475) * lu(k,2576) - lu(k,2586) = lu(k,2586) - lu(k,2476) * lu(k,2576) - lu(k,2587) = lu(k,2587) - lu(k,2477) * lu(k,2576) - lu(k,2588) = lu(k,2588) - lu(k,2478) * lu(k,2576) - lu(k,2589) = lu(k,2589) - lu(k,2479) * lu(k,2576) - lu(k,2591) = lu(k,2591) - lu(k,2480) * lu(k,2576) - lu(k,2592) = lu(k,2592) - lu(k,2481) * lu(k,2576) - lu(k,2624) = lu(k,2624) - lu(k,2468) * lu(k,2623) - lu(k,2625) = lu(k,2625) - lu(k,2469) * lu(k,2623) - lu(k,2626) = lu(k,2626) - lu(k,2470) * lu(k,2623) - lu(k,2627) = lu(k,2627) - lu(k,2471) * lu(k,2623) - lu(k,2628) = lu(k,2628) - lu(k,2472) * lu(k,2623) - lu(k,2629) = lu(k,2629) - lu(k,2473) * lu(k,2623) - lu(k,2630) = lu(k,2630) - lu(k,2474) * lu(k,2623) - lu(k,2631) = lu(k,2631) - lu(k,2475) * lu(k,2623) - lu(k,2633) = lu(k,2633) - lu(k,2476) * lu(k,2623) - lu(k,2634) = lu(k,2634) - lu(k,2477) * lu(k,2623) - lu(k,2635) = lu(k,2635) - lu(k,2478) * lu(k,2623) - lu(k,2636) = lu(k,2636) - lu(k,2479) * lu(k,2623) - lu(k,2638) = lu(k,2638) - lu(k,2480) * lu(k,2623) - lu(k,2639) = lu(k,2639) - lu(k,2481) * lu(k,2623) - lu(k,2695) = lu(k,2695) - lu(k,2468) * lu(k,2694) - lu(k,2696) = lu(k,2696) - lu(k,2469) * lu(k,2694) - lu(k,2697) = lu(k,2697) - lu(k,2470) * lu(k,2694) - lu(k,2698) = lu(k,2698) - lu(k,2471) * lu(k,2694) - lu(k,2699) = lu(k,2699) - lu(k,2472) * lu(k,2694) - lu(k,2700) = lu(k,2700) - lu(k,2473) * lu(k,2694) - lu(k,2701) = lu(k,2701) - lu(k,2474) * lu(k,2694) - lu(k,2702) = lu(k,2702) - lu(k,2475) * lu(k,2694) - lu(k,2704) = lu(k,2704) - lu(k,2476) * lu(k,2694) - lu(k,2705) = lu(k,2705) - lu(k,2477) * lu(k,2694) - lu(k,2706) = lu(k,2706) - lu(k,2478) * lu(k,2694) - lu(k,2707) = lu(k,2707) - lu(k,2479) * lu(k,2694) - lu(k,2709) = lu(k,2709) - lu(k,2480) * lu(k,2694) - lu(k,2710) = lu(k,2710) - lu(k,2481) * lu(k,2694) - lu(k,2878) = lu(k,2878) - lu(k,2468) * lu(k,2877) - lu(k,2879) = lu(k,2879) - lu(k,2469) * lu(k,2877) - lu(k,2880) = lu(k,2880) - lu(k,2470) * lu(k,2877) - lu(k,2881) = lu(k,2881) - lu(k,2471) * lu(k,2877) - lu(k,2882) = lu(k,2882) - lu(k,2472) * lu(k,2877) - lu(k,2883) = lu(k,2883) - lu(k,2473) * lu(k,2877) - lu(k,2884) = lu(k,2884) - lu(k,2474) * lu(k,2877) - lu(k,2885) = lu(k,2885) - lu(k,2475) * lu(k,2877) - lu(k,2887) = lu(k,2887) - lu(k,2476) * lu(k,2877) - lu(k,2889) = lu(k,2889) - lu(k,2477) * lu(k,2877) - lu(k,2891) = lu(k,2891) - lu(k,2478) * lu(k,2877) - lu(k,2892) = lu(k,2892) - lu(k,2479) * lu(k,2877) - lu(k,2894) = lu(k,2894) - lu(k,2480) * lu(k,2877) - lu(k,2895) = lu(k,2895) - lu(k,2481) * lu(k,2877) - lu(k,2979) = lu(k,2979) - lu(k,2468) * lu(k,2978) - lu(k,2980) = lu(k,2980) - lu(k,2469) * lu(k,2978) - lu(k,2981) = lu(k,2981) - lu(k,2470) * lu(k,2978) - lu(k,2982) = lu(k,2982) - lu(k,2471) * lu(k,2978) - lu(k,2983) = lu(k,2983) - lu(k,2472) * lu(k,2978) - lu(k,2984) = lu(k,2984) - lu(k,2473) * lu(k,2978) - lu(k,2985) = lu(k,2985) - lu(k,2474) * lu(k,2978) - lu(k,2986) = lu(k,2986) - lu(k,2475) * lu(k,2978) - lu(k,2988) = lu(k,2988) - lu(k,2476) * lu(k,2978) - lu(k,2990) = lu(k,2990) - lu(k,2477) * lu(k,2978) - lu(k,2992) = lu(k,2992) - lu(k,2478) * lu(k,2978) - lu(k,2993) = lu(k,2993) - lu(k,2479) * lu(k,2978) - lu(k,2995) = lu(k,2995) - lu(k,2480) * lu(k,2978) - lu(k,2996) = lu(k,2996) - lu(k,2481) * lu(k,2978) - lu(k,3071) = lu(k,3071) - lu(k,2468) * lu(k,3070) - lu(k,3072) = lu(k,3072) - lu(k,2469) * lu(k,3070) - lu(k,3073) = lu(k,3073) - lu(k,2470) * lu(k,3070) - lu(k,3074) = lu(k,3074) - lu(k,2471) * lu(k,3070) - lu(k,3075) = lu(k,3075) - lu(k,2472) * lu(k,3070) - lu(k,3076) = lu(k,3076) - lu(k,2473) * lu(k,3070) - lu(k,3077) = lu(k,3077) - lu(k,2474) * lu(k,3070) - lu(k,3078) = lu(k,3078) - lu(k,2475) * lu(k,3070) - lu(k,3080) = lu(k,3080) - lu(k,2476) * lu(k,3070) - lu(k,3082) = lu(k,3082) - lu(k,2477) * lu(k,3070) - lu(k,3084) = lu(k,3084) - lu(k,2478) * lu(k,3070) - lu(k,3085) = lu(k,3085) - lu(k,2479) * lu(k,3070) - lu(k,3087) = lu(k,3087) - lu(k,2480) * lu(k,3070) - lu(k,3088) = lu(k,3088) - lu(k,2481) * lu(k,3070) - lu(k,3274) = lu(k,3274) - lu(k,2468) * lu(k,3273) - lu(k,3275) = lu(k,3275) - lu(k,2469) * lu(k,3273) - lu(k,3276) = lu(k,3276) - lu(k,2470) * lu(k,3273) - lu(k,3277) = lu(k,3277) - lu(k,2471) * lu(k,3273) - lu(k,3278) = lu(k,3278) - lu(k,2472) * lu(k,3273) - lu(k,3279) = lu(k,3279) - lu(k,2473) * lu(k,3273) - lu(k,3280) = lu(k,3280) - lu(k,2474) * lu(k,3273) - lu(k,3281) = lu(k,3281) - lu(k,2475) * lu(k,3273) - lu(k,3283) = lu(k,3283) - lu(k,2476) * lu(k,3273) - lu(k,3285) = lu(k,3285) - lu(k,2477) * lu(k,3273) - lu(k,3287) = lu(k,3287) - lu(k,2478) * lu(k,3273) - lu(k,3288) = lu(k,3288) - lu(k,2479) * lu(k,3273) - lu(k,3290) = lu(k,3290) - lu(k,2480) * lu(k,3273) - lu(k,3291) = lu(k,3291) - lu(k,2481) * lu(k,3273) - lu(k,3415) = lu(k,3415) - lu(k,2468) * lu(k,3414) - lu(k,3416) = lu(k,3416) - lu(k,2469) * lu(k,3414) - lu(k,3417) = lu(k,3417) - lu(k,2470) * lu(k,3414) - lu(k,3418) = lu(k,3418) - lu(k,2471) * lu(k,3414) - lu(k,3419) = lu(k,3419) - lu(k,2472) * lu(k,3414) - lu(k,3420) = lu(k,3420) - lu(k,2473) * lu(k,3414) - lu(k,3421) = lu(k,3421) - lu(k,2474) * lu(k,3414) - lu(k,3422) = lu(k,3422) - lu(k,2475) * lu(k,3414) - lu(k,3424) = lu(k,3424) - lu(k,2476) * lu(k,3414) - lu(k,3426) = lu(k,3426) - lu(k,2477) * lu(k,3414) - lu(k,3428) = lu(k,3428) - lu(k,2478) * lu(k,3414) - lu(k,3429) = lu(k,3429) - lu(k,2479) * lu(k,3414) - lu(k,3431) = lu(k,3431) - lu(k,2480) * lu(k,3414) - lu(k,3432) = lu(k,3432) - lu(k,2481) * lu(k,3414) - lu(k,3735) = lu(k,3735) - lu(k,2468) * lu(k,3734) - lu(k,3736) = lu(k,3736) - lu(k,2469) * lu(k,3734) - lu(k,3737) = lu(k,3737) - lu(k,2470) * lu(k,3734) - lu(k,3738) = lu(k,3738) - lu(k,2471) * lu(k,3734) - lu(k,3739) = lu(k,3739) - lu(k,2472) * lu(k,3734) - lu(k,3740) = lu(k,3740) - lu(k,2473) * lu(k,3734) - lu(k,3741) = lu(k,3741) - lu(k,2474) * lu(k,3734) - lu(k,3742) = lu(k,3742) - lu(k,2475) * lu(k,3734) - lu(k,3744) = lu(k,3744) - lu(k,2476) * lu(k,3734) - lu(k,3746) = lu(k,3746) - lu(k,2477) * lu(k,3734) - lu(k,3748) = lu(k,3748) - lu(k,2478) * lu(k,3734) - lu(k,3749) = lu(k,3749) - lu(k,2479) * lu(k,3734) - lu(k,3751) = lu(k,3751) - lu(k,2480) * lu(k,3734) - lu(k,3752) = lu(k,3752) - lu(k,2481) * lu(k,3734) - lu(k,2489) = 1._r8 / lu(k,2489) - lu(k,2490) = lu(k,2490) * lu(k,2489) - lu(k,2491) = lu(k,2491) * lu(k,2489) - lu(k,2492) = lu(k,2492) * lu(k,2489) - lu(k,2493) = lu(k,2493) * lu(k,2489) - lu(k,2494) = lu(k,2494) * lu(k,2489) - lu(k,2495) = lu(k,2495) * lu(k,2489) - lu(k,2496) = lu(k,2496) * lu(k,2489) - lu(k,2497) = lu(k,2497) * lu(k,2489) - lu(k,2498) = lu(k,2498) * lu(k,2489) - lu(k,2499) = lu(k,2499) * lu(k,2489) - lu(k,2500) = lu(k,2500) * lu(k,2489) - lu(k,2501) = lu(k,2501) * lu(k,2489) - lu(k,2502) = lu(k,2502) * lu(k,2489) - lu(k,2503) = lu(k,2503) * lu(k,2489) - lu(k,2532) = lu(k,2532) - lu(k,2490) * lu(k,2531) - lu(k,2533) = lu(k,2533) - lu(k,2491) * lu(k,2531) - lu(k,2534) = lu(k,2534) - lu(k,2492) * lu(k,2531) - lu(k,2535) = lu(k,2535) - lu(k,2493) * lu(k,2531) - lu(k,2536) = lu(k,2536) - lu(k,2494) * lu(k,2531) - lu(k,2537) = lu(k,2537) - lu(k,2495) * lu(k,2531) - lu(k,2538) = lu(k,2538) - lu(k,2496) * lu(k,2531) - lu(k,2540) = lu(k,2540) - lu(k,2497) * lu(k,2531) - lu(k,2541) = lu(k,2541) - lu(k,2498) * lu(k,2531) - lu(k,2542) = lu(k,2542) - lu(k,2499) * lu(k,2531) - lu(k,2543) = lu(k,2543) - lu(k,2500) * lu(k,2531) - lu(k,2545) = lu(k,2545) - lu(k,2501) * lu(k,2531) - lu(k,2546) = lu(k,2546) - lu(k,2502) * lu(k,2531) - lu(k,2549) = lu(k,2549) - lu(k,2503) * lu(k,2531) - lu(k,2578) = lu(k,2578) - lu(k,2490) * lu(k,2577) - lu(k,2579) = lu(k,2579) - lu(k,2491) * lu(k,2577) - lu(k,2580) = lu(k,2580) - lu(k,2492) * lu(k,2577) - lu(k,2581) = lu(k,2581) - lu(k,2493) * lu(k,2577) - lu(k,2582) = lu(k,2582) - lu(k,2494) * lu(k,2577) - lu(k,2583) = lu(k,2583) - lu(k,2495) * lu(k,2577) - lu(k,2584) = lu(k,2584) - lu(k,2496) * lu(k,2577) - lu(k,2586) = lu(k,2586) - lu(k,2497) * lu(k,2577) - lu(k,2587) = lu(k,2587) - lu(k,2498) * lu(k,2577) - lu(k,2588) = lu(k,2588) - lu(k,2499) * lu(k,2577) - lu(k,2589) = lu(k,2589) - lu(k,2500) * lu(k,2577) - lu(k,2591) = lu(k,2591) - lu(k,2501) * lu(k,2577) - lu(k,2592) = lu(k,2592) - lu(k,2502) * lu(k,2577) - lu(k,2595) = lu(k,2595) - lu(k,2503) * lu(k,2577) - lu(k,2625) = lu(k,2625) - lu(k,2490) * lu(k,2624) - lu(k,2626) = lu(k,2626) - lu(k,2491) * lu(k,2624) - lu(k,2627) = lu(k,2627) - lu(k,2492) * lu(k,2624) - lu(k,2628) = lu(k,2628) - lu(k,2493) * lu(k,2624) - lu(k,2629) = lu(k,2629) - lu(k,2494) * lu(k,2624) - lu(k,2630) = lu(k,2630) - lu(k,2495) * lu(k,2624) - lu(k,2631) = lu(k,2631) - lu(k,2496) * lu(k,2624) - lu(k,2633) = lu(k,2633) - lu(k,2497) * lu(k,2624) - lu(k,2634) = lu(k,2634) - lu(k,2498) * lu(k,2624) - lu(k,2635) = lu(k,2635) - lu(k,2499) * lu(k,2624) - lu(k,2636) = lu(k,2636) - lu(k,2500) * lu(k,2624) - lu(k,2638) = lu(k,2638) - lu(k,2501) * lu(k,2624) - lu(k,2639) = lu(k,2639) - lu(k,2502) * lu(k,2624) - lu(k,2642) = lu(k,2642) - lu(k,2503) * lu(k,2624) - lu(k,2696) = lu(k,2696) - lu(k,2490) * lu(k,2695) - lu(k,2697) = lu(k,2697) - lu(k,2491) * lu(k,2695) - lu(k,2698) = lu(k,2698) - lu(k,2492) * lu(k,2695) - lu(k,2699) = lu(k,2699) - lu(k,2493) * lu(k,2695) - lu(k,2700) = lu(k,2700) - lu(k,2494) * lu(k,2695) - lu(k,2701) = lu(k,2701) - lu(k,2495) * lu(k,2695) - lu(k,2702) = lu(k,2702) - lu(k,2496) * lu(k,2695) - lu(k,2704) = lu(k,2704) - lu(k,2497) * lu(k,2695) - lu(k,2705) = lu(k,2705) - lu(k,2498) * lu(k,2695) - lu(k,2706) = lu(k,2706) - lu(k,2499) * lu(k,2695) - lu(k,2707) = lu(k,2707) - lu(k,2500) * lu(k,2695) - lu(k,2709) = lu(k,2709) - lu(k,2501) * lu(k,2695) - lu(k,2710) = lu(k,2710) - lu(k,2502) * lu(k,2695) - lu(k,2713) = lu(k,2713) - lu(k,2503) * lu(k,2695) - lu(k,2879) = lu(k,2879) - lu(k,2490) * lu(k,2878) - lu(k,2880) = lu(k,2880) - lu(k,2491) * lu(k,2878) - lu(k,2881) = lu(k,2881) - lu(k,2492) * lu(k,2878) - lu(k,2882) = lu(k,2882) - lu(k,2493) * lu(k,2878) - lu(k,2883) = lu(k,2883) - lu(k,2494) * lu(k,2878) - lu(k,2884) = lu(k,2884) - lu(k,2495) * lu(k,2878) - lu(k,2885) = lu(k,2885) - lu(k,2496) * lu(k,2878) - lu(k,2887) = lu(k,2887) - lu(k,2497) * lu(k,2878) - lu(k,2889) = lu(k,2889) - lu(k,2498) * lu(k,2878) - lu(k,2891) = lu(k,2891) - lu(k,2499) * lu(k,2878) - lu(k,2892) = lu(k,2892) - lu(k,2500) * lu(k,2878) - lu(k,2894) = lu(k,2894) - lu(k,2501) * lu(k,2878) - lu(k,2895) = lu(k,2895) - lu(k,2502) * lu(k,2878) - lu(k,2899) = lu(k,2899) - lu(k,2503) * lu(k,2878) - lu(k,2980) = lu(k,2980) - lu(k,2490) * lu(k,2979) - lu(k,2981) = lu(k,2981) - lu(k,2491) * lu(k,2979) - lu(k,2982) = lu(k,2982) - lu(k,2492) * lu(k,2979) - lu(k,2983) = lu(k,2983) - lu(k,2493) * lu(k,2979) - lu(k,2984) = lu(k,2984) - lu(k,2494) * lu(k,2979) - lu(k,2985) = lu(k,2985) - lu(k,2495) * lu(k,2979) - lu(k,2986) = lu(k,2986) - lu(k,2496) * lu(k,2979) - lu(k,2988) = lu(k,2988) - lu(k,2497) * lu(k,2979) - lu(k,2990) = lu(k,2990) - lu(k,2498) * lu(k,2979) - lu(k,2992) = lu(k,2992) - lu(k,2499) * lu(k,2979) - lu(k,2993) = lu(k,2993) - lu(k,2500) * lu(k,2979) - lu(k,2995) = lu(k,2995) - lu(k,2501) * lu(k,2979) - lu(k,2996) = lu(k,2996) - lu(k,2502) * lu(k,2979) - lu(k,3000) = lu(k,3000) - lu(k,2503) * lu(k,2979) - lu(k,3072) = lu(k,3072) - lu(k,2490) * lu(k,3071) - lu(k,3073) = lu(k,3073) - lu(k,2491) * lu(k,3071) - lu(k,3074) = lu(k,3074) - lu(k,2492) * lu(k,3071) - lu(k,3075) = lu(k,3075) - lu(k,2493) * lu(k,3071) - lu(k,3076) = lu(k,3076) - lu(k,2494) * lu(k,3071) - lu(k,3077) = lu(k,3077) - lu(k,2495) * lu(k,3071) - lu(k,3078) = lu(k,3078) - lu(k,2496) * lu(k,3071) - lu(k,3080) = lu(k,3080) - lu(k,2497) * lu(k,3071) - lu(k,3082) = lu(k,3082) - lu(k,2498) * lu(k,3071) - lu(k,3084) = lu(k,3084) - lu(k,2499) * lu(k,3071) - lu(k,3085) = lu(k,3085) - lu(k,2500) * lu(k,3071) - lu(k,3087) = lu(k,3087) - lu(k,2501) * lu(k,3071) - lu(k,3088) = lu(k,3088) - lu(k,2502) * lu(k,3071) - lu(k,3092) = lu(k,3092) - lu(k,2503) * lu(k,3071) - lu(k,3275) = lu(k,3275) - lu(k,2490) * lu(k,3274) - lu(k,3276) = lu(k,3276) - lu(k,2491) * lu(k,3274) - lu(k,3277) = lu(k,3277) - lu(k,2492) * lu(k,3274) - lu(k,3278) = lu(k,3278) - lu(k,2493) * lu(k,3274) - lu(k,3279) = lu(k,3279) - lu(k,2494) * lu(k,3274) - lu(k,3280) = lu(k,3280) - lu(k,2495) * lu(k,3274) - lu(k,3281) = lu(k,3281) - lu(k,2496) * lu(k,3274) - lu(k,3283) = lu(k,3283) - lu(k,2497) * lu(k,3274) - lu(k,3285) = lu(k,3285) - lu(k,2498) * lu(k,3274) - lu(k,3287) = lu(k,3287) - lu(k,2499) * lu(k,3274) - lu(k,3288) = lu(k,3288) - lu(k,2500) * lu(k,3274) - lu(k,3290) = lu(k,3290) - lu(k,2501) * lu(k,3274) - lu(k,3291) = lu(k,3291) - lu(k,2502) * lu(k,3274) - lu(k,3295) = lu(k,3295) - lu(k,2503) * lu(k,3274) - lu(k,3416) = lu(k,3416) - lu(k,2490) * lu(k,3415) - lu(k,3417) = lu(k,3417) - lu(k,2491) * lu(k,3415) - lu(k,3418) = lu(k,3418) - lu(k,2492) * lu(k,3415) - lu(k,3419) = lu(k,3419) - lu(k,2493) * lu(k,3415) - lu(k,3420) = lu(k,3420) - lu(k,2494) * lu(k,3415) - lu(k,3421) = lu(k,3421) - lu(k,2495) * lu(k,3415) - lu(k,3422) = lu(k,3422) - lu(k,2496) * lu(k,3415) - lu(k,3424) = lu(k,3424) - lu(k,2497) * lu(k,3415) - lu(k,3426) = lu(k,3426) - lu(k,2498) * lu(k,3415) - lu(k,3428) = lu(k,3428) - lu(k,2499) * lu(k,3415) - lu(k,3429) = lu(k,3429) - lu(k,2500) * lu(k,3415) - lu(k,3431) = lu(k,3431) - lu(k,2501) * lu(k,3415) - lu(k,3432) = lu(k,3432) - lu(k,2502) * lu(k,3415) - lu(k,3436) = lu(k,3436) - lu(k,2503) * lu(k,3415) - lu(k,3496) = lu(k,3496) - lu(k,2490) * lu(k,3495) - lu(k,3497) = lu(k,3497) - lu(k,2491) * lu(k,3495) - lu(k,3498) = lu(k,3498) - lu(k,2492) * lu(k,3495) - lu(k,3499) = lu(k,3499) - lu(k,2493) * lu(k,3495) - lu(k,3500) = lu(k,3500) - lu(k,2494) * lu(k,3495) - lu(k,3501) = lu(k,3501) - lu(k,2495) * lu(k,3495) - lu(k,3502) = lu(k,3502) - lu(k,2496) * lu(k,3495) - lu(k,3504) = lu(k,3504) - lu(k,2497) * lu(k,3495) - lu(k,3506) = lu(k,3506) - lu(k,2498) * lu(k,3495) - lu(k,3508) = lu(k,3508) - lu(k,2499) * lu(k,3495) - lu(k,3509) = lu(k,3509) - lu(k,2500) * lu(k,3495) - lu(k,3511) = lu(k,3511) - lu(k,2501) * lu(k,3495) - lu(k,3512) = lu(k,3512) - lu(k,2502) * lu(k,3495) - lu(k,3516) = lu(k,3516) - lu(k,2503) * lu(k,3495) - lu(k,3736) = lu(k,3736) - lu(k,2490) * lu(k,3735) - lu(k,3737) = lu(k,3737) - lu(k,2491) * lu(k,3735) - lu(k,3738) = lu(k,3738) - lu(k,2492) * lu(k,3735) - lu(k,3739) = lu(k,3739) - lu(k,2493) * lu(k,3735) - lu(k,3740) = lu(k,3740) - lu(k,2494) * lu(k,3735) - lu(k,3741) = lu(k,3741) - lu(k,2495) * lu(k,3735) - lu(k,3742) = lu(k,3742) - lu(k,2496) * lu(k,3735) - lu(k,3744) = lu(k,3744) - lu(k,2497) * lu(k,3735) - lu(k,3746) = lu(k,3746) - lu(k,2498) * lu(k,3735) - lu(k,3748) = lu(k,3748) - lu(k,2499) * lu(k,3735) - lu(k,3749) = lu(k,3749) - lu(k,2500) * lu(k,3735) - lu(k,3751) = lu(k,3751) - lu(k,2501) * lu(k,3735) - lu(k,3752) = lu(k,3752) - lu(k,2502) * lu(k,3735) - lu(k,3756) = lu(k,3756) - lu(k,2503) * lu(k,3735) - lu(k,2532) = 1._r8 / lu(k,2532) - lu(k,2533) = lu(k,2533) * lu(k,2532) - lu(k,2534) = lu(k,2534) * lu(k,2532) - lu(k,2535) = lu(k,2535) * lu(k,2532) - lu(k,2536) = lu(k,2536) * lu(k,2532) - lu(k,2537) = lu(k,2537) * lu(k,2532) - lu(k,2538) = lu(k,2538) * lu(k,2532) - lu(k,2539) = lu(k,2539) * lu(k,2532) - lu(k,2540) = lu(k,2540) * lu(k,2532) - lu(k,2541) = lu(k,2541) * lu(k,2532) - lu(k,2542) = lu(k,2542) * lu(k,2532) - lu(k,2543) = lu(k,2543) * lu(k,2532) - lu(k,2544) = lu(k,2544) * lu(k,2532) - lu(k,2545) = lu(k,2545) * lu(k,2532) - lu(k,2546) = lu(k,2546) * lu(k,2532) - lu(k,2547) = lu(k,2547) * lu(k,2532) - lu(k,2548) = lu(k,2548) * lu(k,2532) - lu(k,2549) = lu(k,2549) * lu(k,2532) - lu(k,2579) = lu(k,2579) - lu(k,2533) * lu(k,2578) - lu(k,2580) = lu(k,2580) - lu(k,2534) * lu(k,2578) - lu(k,2581) = lu(k,2581) - lu(k,2535) * lu(k,2578) - lu(k,2582) = lu(k,2582) - lu(k,2536) * lu(k,2578) - lu(k,2583) = lu(k,2583) - lu(k,2537) * lu(k,2578) - lu(k,2584) = lu(k,2584) - lu(k,2538) * lu(k,2578) - lu(k,2585) = lu(k,2585) - lu(k,2539) * lu(k,2578) - lu(k,2586) = lu(k,2586) - lu(k,2540) * lu(k,2578) - lu(k,2587) = lu(k,2587) - lu(k,2541) * lu(k,2578) - lu(k,2588) = lu(k,2588) - lu(k,2542) * lu(k,2578) - lu(k,2589) = lu(k,2589) - lu(k,2543) * lu(k,2578) - lu(k,2590) = lu(k,2590) - lu(k,2544) * lu(k,2578) - lu(k,2591) = lu(k,2591) - lu(k,2545) * lu(k,2578) - lu(k,2592) = lu(k,2592) - lu(k,2546) * lu(k,2578) - lu(k,2593) = lu(k,2593) - lu(k,2547) * lu(k,2578) - lu(k,2594) = lu(k,2594) - lu(k,2548) * lu(k,2578) - lu(k,2595) = lu(k,2595) - lu(k,2549) * lu(k,2578) - lu(k,2626) = lu(k,2626) - lu(k,2533) * lu(k,2625) - lu(k,2627) = lu(k,2627) - lu(k,2534) * lu(k,2625) - lu(k,2628) = lu(k,2628) - lu(k,2535) * lu(k,2625) - lu(k,2629) = lu(k,2629) - lu(k,2536) * lu(k,2625) - lu(k,2630) = lu(k,2630) - lu(k,2537) * lu(k,2625) - lu(k,2631) = lu(k,2631) - lu(k,2538) * lu(k,2625) - lu(k,2632) = lu(k,2632) - lu(k,2539) * lu(k,2625) - lu(k,2633) = lu(k,2633) - lu(k,2540) * lu(k,2625) - lu(k,2634) = lu(k,2634) - lu(k,2541) * lu(k,2625) - lu(k,2635) = lu(k,2635) - lu(k,2542) * lu(k,2625) - lu(k,2636) = lu(k,2636) - lu(k,2543) * lu(k,2625) - lu(k,2637) = lu(k,2637) - lu(k,2544) * lu(k,2625) - lu(k,2638) = lu(k,2638) - lu(k,2545) * lu(k,2625) - lu(k,2639) = lu(k,2639) - lu(k,2546) * lu(k,2625) - lu(k,2640) = lu(k,2640) - lu(k,2547) * lu(k,2625) - lu(k,2641) = lu(k,2641) - lu(k,2548) * lu(k,2625) - lu(k,2642) = lu(k,2642) - lu(k,2549) * lu(k,2625) - lu(k,2697) = lu(k,2697) - lu(k,2533) * lu(k,2696) - lu(k,2698) = lu(k,2698) - lu(k,2534) * lu(k,2696) - lu(k,2699) = lu(k,2699) - lu(k,2535) * lu(k,2696) - lu(k,2700) = lu(k,2700) - lu(k,2536) * lu(k,2696) - lu(k,2701) = lu(k,2701) - lu(k,2537) * lu(k,2696) - lu(k,2702) = lu(k,2702) - lu(k,2538) * lu(k,2696) - lu(k,2703) = lu(k,2703) - lu(k,2539) * lu(k,2696) - lu(k,2704) = lu(k,2704) - lu(k,2540) * lu(k,2696) - lu(k,2705) = lu(k,2705) - lu(k,2541) * lu(k,2696) - lu(k,2706) = lu(k,2706) - lu(k,2542) * lu(k,2696) - lu(k,2707) = lu(k,2707) - lu(k,2543) * lu(k,2696) - lu(k,2708) = lu(k,2708) - lu(k,2544) * lu(k,2696) - lu(k,2709) = lu(k,2709) - lu(k,2545) * lu(k,2696) - lu(k,2710) = lu(k,2710) - lu(k,2546) * lu(k,2696) - lu(k,2711) = lu(k,2711) - lu(k,2547) * lu(k,2696) - lu(k,2712) = lu(k,2712) - lu(k,2548) * lu(k,2696) - lu(k,2713) = lu(k,2713) - lu(k,2549) * lu(k,2696) - lu(k,2880) = lu(k,2880) - lu(k,2533) * lu(k,2879) - lu(k,2881) = lu(k,2881) - lu(k,2534) * lu(k,2879) - lu(k,2882) = lu(k,2882) - lu(k,2535) * lu(k,2879) - lu(k,2883) = lu(k,2883) - lu(k,2536) * lu(k,2879) - lu(k,2884) = lu(k,2884) - lu(k,2537) * lu(k,2879) - lu(k,2885) = lu(k,2885) - lu(k,2538) * lu(k,2879) - lu(k,2886) = lu(k,2886) - lu(k,2539) * lu(k,2879) - lu(k,2887) = lu(k,2887) - lu(k,2540) * lu(k,2879) - lu(k,2889) = lu(k,2889) - lu(k,2541) * lu(k,2879) - lu(k,2891) = lu(k,2891) - lu(k,2542) * lu(k,2879) - lu(k,2892) = lu(k,2892) - lu(k,2543) * lu(k,2879) - lu(k,2893) = lu(k,2893) - lu(k,2544) * lu(k,2879) - lu(k,2894) = lu(k,2894) - lu(k,2545) * lu(k,2879) - lu(k,2895) = lu(k,2895) - lu(k,2546) * lu(k,2879) - lu(k,2896) = lu(k,2896) - lu(k,2547) * lu(k,2879) - lu(k,2898) = lu(k,2898) - lu(k,2548) * lu(k,2879) - lu(k,2899) = lu(k,2899) - lu(k,2549) * lu(k,2879) - lu(k,2981) = lu(k,2981) - lu(k,2533) * lu(k,2980) - lu(k,2982) = lu(k,2982) - lu(k,2534) * lu(k,2980) - lu(k,2983) = lu(k,2983) - lu(k,2535) * lu(k,2980) - lu(k,2984) = lu(k,2984) - lu(k,2536) * lu(k,2980) - lu(k,2985) = lu(k,2985) - lu(k,2537) * lu(k,2980) - lu(k,2986) = lu(k,2986) - lu(k,2538) * lu(k,2980) - lu(k,2987) = lu(k,2987) - lu(k,2539) * lu(k,2980) - lu(k,2988) = lu(k,2988) - lu(k,2540) * lu(k,2980) - lu(k,2990) = lu(k,2990) - lu(k,2541) * lu(k,2980) - lu(k,2992) = lu(k,2992) - lu(k,2542) * lu(k,2980) - lu(k,2993) = lu(k,2993) - lu(k,2543) * lu(k,2980) - lu(k,2994) = lu(k,2994) - lu(k,2544) * lu(k,2980) - lu(k,2995) = lu(k,2995) - lu(k,2545) * lu(k,2980) - lu(k,2996) = lu(k,2996) - lu(k,2546) * lu(k,2980) - lu(k,2997) = lu(k,2997) - lu(k,2547) * lu(k,2980) - lu(k,2999) = lu(k,2999) - lu(k,2548) * lu(k,2980) - lu(k,3000) = lu(k,3000) - lu(k,2549) * lu(k,2980) - lu(k,3073) = lu(k,3073) - lu(k,2533) * lu(k,3072) - lu(k,3074) = lu(k,3074) - lu(k,2534) * lu(k,3072) - lu(k,3075) = lu(k,3075) - lu(k,2535) * lu(k,3072) - lu(k,3076) = lu(k,3076) - lu(k,2536) * lu(k,3072) - lu(k,3077) = lu(k,3077) - lu(k,2537) * lu(k,3072) - lu(k,3078) = lu(k,3078) - lu(k,2538) * lu(k,3072) - lu(k,3079) = lu(k,3079) - lu(k,2539) * lu(k,3072) - lu(k,3080) = lu(k,3080) - lu(k,2540) * lu(k,3072) - lu(k,3082) = lu(k,3082) - lu(k,2541) * lu(k,3072) - lu(k,3084) = lu(k,3084) - lu(k,2542) * lu(k,3072) - lu(k,3085) = lu(k,3085) - lu(k,2543) * lu(k,3072) - lu(k,3086) = lu(k,3086) - lu(k,2544) * lu(k,3072) - lu(k,3087) = lu(k,3087) - lu(k,2545) * lu(k,3072) - lu(k,3088) = lu(k,3088) - lu(k,2546) * lu(k,3072) - lu(k,3089) = lu(k,3089) - lu(k,2547) * lu(k,3072) - lu(k,3091) = lu(k,3091) - lu(k,2548) * lu(k,3072) - lu(k,3092) = lu(k,3092) - lu(k,2549) * lu(k,3072) - lu(k,3276) = lu(k,3276) - lu(k,2533) * lu(k,3275) - lu(k,3277) = lu(k,3277) - lu(k,2534) * lu(k,3275) - lu(k,3278) = lu(k,3278) - lu(k,2535) * lu(k,3275) - lu(k,3279) = lu(k,3279) - lu(k,2536) * lu(k,3275) - lu(k,3280) = lu(k,3280) - lu(k,2537) * lu(k,3275) - lu(k,3281) = lu(k,3281) - lu(k,2538) * lu(k,3275) - lu(k,3282) = lu(k,3282) - lu(k,2539) * lu(k,3275) - lu(k,3283) = lu(k,3283) - lu(k,2540) * lu(k,3275) - lu(k,3285) = lu(k,3285) - lu(k,2541) * lu(k,3275) - lu(k,3287) = lu(k,3287) - lu(k,2542) * lu(k,3275) - lu(k,3288) = lu(k,3288) - lu(k,2543) * lu(k,3275) - lu(k,3289) = lu(k,3289) - lu(k,2544) * lu(k,3275) - lu(k,3290) = lu(k,3290) - lu(k,2545) * lu(k,3275) - lu(k,3291) = lu(k,3291) - lu(k,2546) * lu(k,3275) - lu(k,3292) = lu(k,3292) - lu(k,2547) * lu(k,3275) - lu(k,3294) = lu(k,3294) - lu(k,2548) * lu(k,3275) - lu(k,3295) = lu(k,3295) - lu(k,2549) * lu(k,3275) - lu(k,3417) = lu(k,3417) - lu(k,2533) * lu(k,3416) - lu(k,3418) = lu(k,3418) - lu(k,2534) * lu(k,3416) - lu(k,3419) = lu(k,3419) - lu(k,2535) * lu(k,3416) - lu(k,3420) = lu(k,3420) - lu(k,2536) * lu(k,3416) - lu(k,3421) = lu(k,3421) - lu(k,2537) * lu(k,3416) - lu(k,3422) = lu(k,3422) - lu(k,2538) * lu(k,3416) - lu(k,3423) = lu(k,3423) - lu(k,2539) * lu(k,3416) - lu(k,3424) = lu(k,3424) - lu(k,2540) * lu(k,3416) - lu(k,3426) = lu(k,3426) - lu(k,2541) * lu(k,3416) - lu(k,3428) = lu(k,3428) - lu(k,2542) * lu(k,3416) - lu(k,3429) = lu(k,3429) - lu(k,2543) * lu(k,3416) - lu(k,3430) = lu(k,3430) - lu(k,2544) * lu(k,3416) - lu(k,3431) = lu(k,3431) - lu(k,2545) * lu(k,3416) - lu(k,3432) = lu(k,3432) - lu(k,2546) * lu(k,3416) - lu(k,3433) = lu(k,3433) - lu(k,2547) * lu(k,3416) - lu(k,3435) = lu(k,3435) - lu(k,2548) * lu(k,3416) - lu(k,3436) = lu(k,3436) - lu(k,2549) * lu(k,3416) - lu(k,3497) = lu(k,3497) - lu(k,2533) * lu(k,3496) - lu(k,3498) = lu(k,3498) - lu(k,2534) * lu(k,3496) - lu(k,3499) = lu(k,3499) - lu(k,2535) * lu(k,3496) - lu(k,3500) = lu(k,3500) - lu(k,2536) * lu(k,3496) - lu(k,3501) = lu(k,3501) - lu(k,2537) * lu(k,3496) - lu(k,3502) = lu(k,3502) - lu(k,2538) * lu(k,3496) - lu(k,3503) = lu(k,3503) - lu(k,2539) * lu(k,3496) - lu(k,3504) = lu(k,3504) - lu(k,2540) * lu(k,3496) - lu(k,3506) = lu(k,3506) - lu(k,2541) * lu(k,3496) - lu(k,3508) = lu(k,3508) - lu(k,2542) * lu(k,3496) - lu(k,3509) = lu(k,3509) - lu(k,2543) * lu(k,3496) - lu(k,3510) = lu(k,3510) - lu(k,2544) * lu(k,3496) - lu(k,3511) = lu(k,3511) - lu(k,2545) * lu(k,3496) - lu(k,3512) = lu(k,3512) - lu(k,2546) * lu(k,3496) - lu(k,3513) = lu(k,3513) - lu(k,2547) * lu(k,3496) - lu(k,3515) = lu(k,3515) - lu(k,2548) * lu(k,3496) - lu(k,3516) = lu(k,3516) - lu(k,2549) * lu(k,3496) - lu(k,3737) = lu(k,3737) - lu(k,2533) * lu(k,3736) - lu(k,3738) = lu(k,3738) - lu(k,2534) * lu(k,3736) - lu(k,3739) = lu(k,3739) - lu(k,2535) * lu(k,3736) - lu(k,3740) = lu(k,3740) - lu(k,2536) * lu(k,3736) - lu(k,3741) = lu(k,3741) - lu(k,2537) * lu(k,3736) - lu(k,3742) = lu(k,3742) - lu(k,2538) * lu(k,3736) - lu(k,3743) = lu(k,3743) - lu(k,2539) * lu(k,3736) - lu(k,3744) = lu(k,3744) - lu(k,2540) * lu(k,3736) - lu(k,3746) = lu(k,3746) - lu(k,2541) * lu(k,3736) - lu(k,3748) = lu(k,3748) - lu(k,2542) * lu(k,3736) - lu(k,3749) = lu(k,3749) - lu(k,2543) * lu(k,3736) - lu(k,3750) = lu(k,3750) - lu(k,2544) * lu(k,3736) - lu(k,3751) = lu(k,3751) - lu(k,2545) * lu(k,3736) - lu(k,3752) = lu(k,3752) - lu(k,2546) * lu(k,3736) - lu(k,3753) = lu(k,3753) - lu(k,2547) * lu(k,3736) - lu(k,3755) = lu(k,3755) - lu(k,2548) * lu(k,3736) - lu(k,3756) = lu(k,3756) - lu(k,2549) * lu(k,3736) - lu(k,2579) = 1._r8 / lu(k,2579) - lu(k,2580) = lu(k,2580) * lu(k,2579) - lu(k,2581) = lu(k,2581) * lu(k,2579) - lu(k,2582) = lu(k,2582) * lu(k,2579) - lu(k,2583) = lu(k,2583) * lu(k,2579) - lu(k,2584) = lu(k,2584) * lu(k,2579) - lu(k,2585) = lu(k,2585) * lu(k,2579) - lu(k,2586) = lu(k,2586) * lu(k,2579) - lu(k,2587) = lu(k,2587) * lu(k,2579) - lu(k,2588) = lu(k,2588) * lu(k,2579) - lu(k,2589) = lu(k,2589) * lu(k,2579) - lu(k,2590) = lu(k,2590) * lu(k,2579) - lu(k,2591) = lu(k,2591) * lu(k,2579) - lu(k,2592) = lu(k,2592) * lu(k,2579) - lu(k,2593) = lu(k,2593) * lu(k,2579) - lu(k,2594) = lu(k,2594) * lu(k,2579) - lu(k,2595) = lu(k,2595) * lu(k,2579) - lu(k,2627) = lu(k,2627) - lu(k,2580) * lu(k,2626) - lu(k,2628) = lu(k,2628) - lu(k,2581) * lu(k,2626) - lu(k,2629) = lu(k,2629) - lu(k,2582) * lu(k,2626) - lu(k,2630) = lu(k,2630) - lu(k,2583) * lu(k,2626) - lu(k,2631) = lu(k,2631) - lu(k,2584) * lu(k,2626) - lu(k,2632) = lu(k,2632) - lu(k,2585) * lu(k,2626) - lu(k,2633) = lu(k,2633) - lu(k,2586) * lu(k,2626) - lu(k,2634) = lu(k,2634) - lu(k,2587) * lu(k,2626) - lu(k,2635) = lu(k,2635) - lu(k,2588) * lu(k,2626) - lu(k,2636) = lu(k,2636) - lu(k,2589) * lu(k,2626) - lu(k,2637) = lu(k,2637) - lu(k,2590) * lu(k,2626) - lu(k,2638) = lu(k,2638) - lu(k,2591) * lu(k,2626) - lu(k,2639) = lu(k,2639) - lu(k,2592) * lu(k,2626) - lu(k,2640) = lu(k,2640) - lu(k,2593) * lu(k,2626) - lu(k,2641) = lu(k,2641) - lu(k,2594) * lu(k,2626) - lu(k,2642) = lu(k,2642) - lu(k,2595) * lu(k,2626) - lu(k,2698) = lu(k,2698) - lu(k,2580) * lu(k,2697) - lu(k,2699) = lu(k,2699) - lu(k,2581) * lu(k,2697) - lu(k,2700) = lu(k,2700) - lu(k,2582) * lu(k,2697) - lu(k,2701) = lu(k,2701) - lu(k,2583) * lu(k,2697) - lu(k,2702) = lu(k,2702) - lu(k,2584) * lu(k,2697) - lu(k,2703) = lu(k,2703) - lu(k,2585) * lu(k,2697) - lu(k,2704) = lu(k,2704) - lu(k,2586) * lu(k,2697) - lu(k,2705) = lu(k,2705) - lu(k,2587) * lu(k,2697) - lu(k,2706) = lu(k,2706) - lu(k,2588) * lu(k,2697) - lu(k,2707) = lu(k,2707) - lu(k,2589) * lu(k,2697) - lu(k,2708) = lu(k,2708) - lu(k,2590) * lu(k,2697) - lu(k,2709) = lu(k,2709) - lu(k,2591) * lu(k,2697) - lu(k,2710) = lu(k,2710) - lu(k,2592) * lu(k,2697) - lu(k,2711) = lu(k,2711) - lu(k,2593) * lu(k,2697) - lu(k,2712) = lu(k,2712) - lu(k,2594) * lu(k,2697) - lu(k,2713) = lu(k,2713) - lu(k,2595) * lu(k,2697) - lu(k,2881) = lu(k,2881) - lu(k,2580) * lu(k,2880) - lu(k,2882) = lu(k,2882) - lu(k,2581) * lu(k,2880) - lu(k,2883) = lu(k,2883) - lu(k,2582) * lu(k,2880) - lu(k,2884) = lu(k,2884) - lu(k,2583) * lu(k,2880) - lu(k,2885) = lu(k,2885) - lu(k,2584) * lu(k,2880) - lu(k,2886) = lu(k,2886) - lu(k,2585) * lu(k,2880) - lu(k,2887) = lu(k,2887) - lu(k,2586) * lu(k,2880) - lu(k,2889) = lu(k,2889) - lu(k,2587) * lu(k,2880) - lu(k,2891) = lu(k,2891) - lu(k,2588) * lu(k,2880) - lu(k,2892) = lu(k,2892) - lu(k,2589) * lu(k,2880) - lu(k,2893) = lu(k,2893) - lu(k,2590) * lu(k,2880) - lu(k,2894) = lu(k,2894) - lu(k,2591) * lu(k,2880) - lu(k,2895) = lu(k,2895) - lu(k,2592) * lu(k,2880) - lu(k,2896) = lu(k,2896) - lu(k,2593) * lu(k,2880) - lu(k,2898) = lu(k,2898) - lu(k,2594) * lu(k,2880) - lu(k,2899) = lu(k,2899) - lu(k,2595) * lu(k,2880) - lu(k,2982) = lu(k,2982) - lu(k,2580) * lu(k,2981) - lu(k,2983) = lu(k,2983) - lu(k,2581) * lu(k,2981) - lu(k,2984) = lu(k,2984) - lu(k,2582) * lu(k,2981) - lu(k,2985) = lu(k,2985) - lu(k,2583) * lu(k,2981) - lu(k,2986) = lu(k,2986) - lu(k,2584) * lu(k,2981) - lu(k,2987) = lu(k,2987) - lu(k,2585) * lu(k,2981) - lu(k,2988) = lu(k,2988) - lu(k,2586) * lu(k,2981) - lu(k,2990) = lu(k,2990) - lu(k,2587) * lu(k,2981) - lu(k,2992) = lu(k,2992) - lu(k,2588) * lu(k,2981) - lu(k,2993) = lu(k,2993) - lu(k,2589) * lu(k,2981) - lu(k,2994) = lu(k,2994) - lu(k,2590) * lu(k,2981) - lu(k,2995) = lu(k,2995) - lu(k,2591) * lu(k,2981) - lu(k,2996) = lu(k,2996) - lu(k,2592) * lu(k,2981) - lu(k,2997) = lu(k,2997) - lu(k,2593) * lu(k,2981) - lu(k,2999) = lu(k,2999) - lu(k,2594) * lu(k,2981) - lu(k,3000) = lu(k,3000) - lu(k,2595) * lu(k,2981) - lu(k,3074) = lu(k,3074) - lu(k,2580) * lu(k,3073) - lu(k,3075) = lu(k,3075) - lu(k,2581) * lu(k,3073) - lu(k,3076) = lu(k,3076) - lu(k,2582) * lu(k,3073) - lu(k,3077) = lu(k,3077) - lu(k,2583) * lu(k,3073) - lu(k,3078) = lu(k,3078) - lu(k,2584) * lu(k,3073) - lu(k,3079) = lu(k,3079) - lu(k,2585) * lu(k,3073) - lu(k,3080) = lu(k,3080) - lu(k,2586) * lu(k,3073) - lu(k,3082) = lu(k,3082) - lu(k,2587) * lu(k,3073) - lu(k,3084) = lu(k,3084) - lu(k,2588) * lu(k,3073) - lu(k,3085) = lu(k,3085) - lu(k,2589) * lu(k,3073) - lu(k,3086) = lu(k,3086) - lu(k,2590) * lu(k,3073) - lu(k,3087) = lu(k,3087) - lu(k,2591) * lu(k,3073) - lu(k,3088) = lu(k,3088) - lu(k,2592) * lu(k,3073) - lu(k,3089) = lu(k,3089) - lu(k,2593) * lu(k,3073) - lu(k,3091) = lu(k,3091) - lu(k,2594) * lu(k,3073) - lu(k,3092) = lu(k,3092) - lu(k,2595) * lu(k,3073) - lu(k,3277) = lu(k,3277) - lu(k,2580) * lu(k,3276) - lu(k,3278) = lu(k,3278) - lu(k,2581) * lu(k,3276) - lu(k,3279) = lu(k,3279) - lu(k,2582) * lu(k,3276) - lu(k,3280) = lu(k,3280) - lu(k,2583) * lu(k,3276) - lu(k,3281) = lu(k,3281) - lu(k,2584) * lu(k,3276) - lu(k,3282) = lu(k,3282) - lu(k,2585) * lu(k,3276) - lu(k,3283) = lu(k,3283) - lu(k,2586) * lu(k,3276) - lu(k,3285) = lu(k,3285) - lu(k,2587) * lu(k,3276) - lu(k,3287) = lu(k,3287) - lu(k,2588) * lu(k,3276) - lu(k,3288) = lu(k,3288) - lu(k,2589) * lu(k,3276) - lu(k,3289) = lu(k,3289) - lu(k,2590) * lu(k,3276) - lu(k,3290) = lu(k,3290) - lu(k,2591) * lu(k,3276) - lu(k,3291) = lu(k,3291) - lu(k,2592) * lu(k,3276) - lu(k,3292) = lu(k,3292) - lu(k,2593) * lu(k,3276) - lu(k,3294) = lu(k,3294) - lu(k,2594) * lu(k,3276) - lu(k,3295) = lu(k,3295) - lu(k,2595) * lu(k,3276) - lu(k,3418) = lu(k,3418) - lu(k,2580) * lu(k,3417) - lu(k,3419) = lu(k,3419) - lu(k,2581) * lu(k,3417) - lu(k,3420) = lu(k,3420) - lu(k,2582) * lu(k,3417) - lu(k,3421) = lu(k,3421) - lu(k,2583) * lu(k,3417) - lu(k,3422) = lu(k,3422) - lu(k,2584) * lu(k,3417) - lu(k,3423) = lu(k,3423) - lu(k,2585) * lu(k,3417) - lu(k,3424) = lu(k,3424) - lu(k,2586) * lu(k,3417) - lu(k,3426) = lu(k,3426) - lu(k,2587) * lu(k,3417) - lu(k,3428) = lu(k,3428) - lu(k,2588) * lu(k,3417) - lu(k,3429) = lu(k,3429) - lu(k,2589) * lu(k,3417) - lu(k,3430) = lu(k,3430) - lu(k,2590) * lu(k,3417) - lu(k,3431) = lu(k,3431) - lu(k,2591) * lu(k,3417) - lu(k,3432) = lu(k,3432) - lu(k,2592) * lu(k,3417) - lu(k,3433) = lu(k,3433) - lu(k,2593) * lu(k,3417) - lu(k,3435) = lu(k,3435) - lu(k,2594) * lu(k,3417) - lu(k,3436) = lu(k,3436) - lu(k,2595) * lu(k,3417) - lu(k,3498) = lu(k,3498) - lu(k,2580) * lu(k,3497) - lu(k,3499) = lu(k,3499) - lu(k,2581) * lu(k,3497) - lu(k,3500) = lu(k,3500) - lu(k,2582) * lu(k,3497) - lu(k,3501) = lu(k,3501) - lu(k,2583) * lu(k,3497) - lu(k,3502) = lu(k,3502) - lu(k,2584) * lu(k,3497) - lu(k,3503) = lu(k,3503) - lu(k,2585) * lu(k,3497) - lu(k,3504) = lu(k,3504) - lu(k,2586) * lu(k,3497) - lu(k,3506) = lu(k,3506) - lu(k,2587) * lu(k,3497) - lu(k,3508) = lu(k,3508) - lu(k,2588) * lu(k,3497) - lu(k,3509) = lu(k,3509) - lu(k,2589) * lu(k,3497) - lu(k,3510) = lu(k,3510) - lu(k,2590) * lu(k,3497) - lu(k,3511) = lu(k,3511) - lu(k,2591) * lu(k,3497) - lu(k,3512) = lu(k,3512) - lu(k,2592) * lu(k,3497) - lu(k,3513) = lu(k,3513) - lu(k,2593) * lu(k,3497) - lu(k,3515) = lu(k,3515) - lu(k,2594) * lu(k,3497) - lu(k,3516) = lu(k,3516) - lu(k,2595) * lu(k,3497) - lu(k,3738) = lu(k,3738) - lu(k,2580) * lu(k,3737) - lu(k,3739) = lu(k,3739) - lu(k,2581) * lu(k,3737) - lu(k,3740) = lu(k,3740) - lu(k,2582) * lu(k,3737) - lu(k,3741) = lu(k,3741) - lu(k,2583) * lu(k,3737) - lu(k,3742) = lu(k,3742) - lu(k,2584) * lu(k,3737) - lu(k,3743) = lu(k,3743) - lu(k,2585) * lu(k,3737) - lu(k,3744) = lu(k,3744) - lu(k,2586) * lu(k,3737) - lu(k,3746) = lu(k,3746) - lu(k,2587) * lu(k,3737) - lu(k,3748) = lu(k,3748) - lu(k,2588) * lu(k,3737) - lu(k,3749) = lu(k,3749) - lu(k,2589) * lu(k,3737) - lu(k,3750) = lu(k,3750) - lu(k,2590) * lu(k,3737) - lu(k,3751) = lu(k,3751) - lu(k,2591) * lu(k,3737) - lu(k,3752) = lu(k,3752) - lu(k,2592) * lu(k,3737) - lu(k,3753) = lu(k,3753) - lu(k,2593) * lu(k,3737) - lu(k,3755) = lu(k,3755) - lu(k,2594) * lu(k,3737) - lu(k,3756) = lu(k,3756) - lu(k,2595) * lu(k,3737) + lu(k,2411) = 1._r8 / lu(k,2411) + lu(k,2412) = lu(k,2412) * lu(k,2411) + lu(k,2413) = lu(k,2413) * lu(k,2411) + lu(k,2414) = lu(k,2414) * lu(k,2411) + lu(k,2415) = lu(k,2415) * lu(k,2411) + lu(k,2416) = lu(k,2416) * lu(k,2411) + lu(k,2417) = lu(k,2417) * lu(k,2411) + lu(k,2418) = lu(k,2418) * lu(k,2411) + lu(k,2419) = lu(k,2419) * lu(k,2411) + lu(k,2420) = lu(k,2420) * lu(k,2411) + lu(k,2421) = lu(k,2421) * lu(k,2411) + lu(k,2422) = lu(k,2422) * lu(k,2411) + lu(k,2423) = lu(k,2423) * lu(k,2411) + lu(k,2424) = lu(k,2424) * lu(k,2411) + lu(k,2425) = lu(k,2425) * lu(k,2411) + lu(k,2426) = lu(k,2426) * lu(k,2411) + lu(k,2427) = lu(k,2427) * lu(k,2411) + lu(k,2428) = lu(k,2428) * lu(k,2411) + lu(k,2429) = lu(k,2429) * lu(k,2411) + lu(k,2430) = lu(k,2430) * lu(k,2411) + lu(k,2843) = lu(k,2843) - lu(k,2412) * lu(k,2842) + lu(k,2847) = lu(k,2847) - lu(k,2413) * lu(k,2842) + lu(k,2849) = lu(k,2849) - lu(k,2414) * lu(k,2842) + lu(k,2850) = lu(k,2850) - lu(k,2415) * lu(k,2842) + lu(k,2851) = lu(k,2851) - lu(k,2416) * lu(k,2842) + lu(k,2853) = lu(k,2853) - lu(k,2417) * lu(k,2842) + lu(k,2854) = lu(k,2854) - lu(k,2418) * lu(k,2842) + lu(k,2855) = lu(k,2855) - lu(k,2419) * lu(k,2842) + lu(k,2856) = lu(k,2856) - lu(k,2420) * lu(k,2842) + lu(k,2859) = lu(k,2859) - lu(k,2421) * lu(k,2842) + lu(k,2860) = lu(k,2860) - lu(k,2422) * lu(k,2842) + lu(k,2861) = lu(k,2861) - lu(k,2423) * lu(k,2842) + lu(k,2862) = lu(k,2862) - lu(k,2424) * lu(k,2842) + lu(k,2863) = lu(k,2863) - lu(k,2425) * lu(k,2842) + lu(k,2864) = lu(k,2864) - lu(k,2426) * lu(k,2842) + lu(k,2866) = lu(k,2866) - lu(k,2427) * lu(k,2842) + lu(k,2867) = lu(k,2867) - lu(k,2428) * lu(k,2842) + lu(k,2868) = lu(k,2868) - lu(k,2429) * lu(k,2842) + lu(k,2869) = lu(k,2869) - lu(k,2430) * lu(k,2842) + lu(k,2890) = lu(k,2890) - lu(k,2412) * lu(k,2889) + lu(k,2894) = lu(k,2894) - lu(k,2413) * lu(k,2889) + lu(k,2896) = lu(k,2896) - lu(k,2414) * lu(k,2889) + lu(k,2897) = lu(k,2897) - lu(k,2415) * lu(k,2889) + lu(k,2898) = lu(k,2898) - lu(k,2416) * lu(k,2889) + lu(k,2900) = lu(k,2900) - lu(k,2417) * lu(k,2889) + lu(k,2901) = lu(k,2901) - lu(k,2418) * lu(k,2889) + lu(k,2902) = lu(k,2902) - lu(k,2419) * lu(k,2889) + lu(k,2903) = lu(k,2903) - lu(k,2420) * lu(k,2889) + lu(k,2906) = lu(k,2906) - lu(k,2421) * lu(k,2889) + lu(k,2907) = lu(k,2907) - lu(k,2422) * lu(k,2889) + lu(k,2908) = lu(k,2908) - lu(k,2423) * lu(k,2889) + lu(k,2909) = lu(k,2909) - lu(k,2424) * lu(k,2889) + lu(k,2910) = lu(k,2910) - lu(k,2425) * lu(k,2889) + lu(k,2911) = lu(k,2911) - lu(k,2426) * lu(k,2889) + lu(k,2913) = lu(k,2913) - lu(k,2427) * lu(k,2889) + lu(k,2914) = lu(k,2914) - lu(k,2428) * lu(k,2889) + lu(k,2915) = lu(k,2915) - lu(k,2429) * lu(k,2889) + lu(k,2916) = lu(k,2916) - lu(k,2430) * lu(k,2889) + lu(k,2936) = lu(k,2936) - lu(k,2412) * lu(k,2935) + lu(k,2940) = lu(k,2940) - lu(k,2413) * lu(k,2935) + lu(k,2942) = lu(k,2942) - lu(k,2414) * lu(k,2935) + lu(k,2943) = lu(k,2943) - lu(k,2415) * lu(k,2935) + lu(k,2944) = lu(k,2944) - lu(k,2416) * lu(k,2935) + lu(k,2946) = lu(k,2946) - lu(k,2417) * lu(k,2935) + lu(k,2947) = lu(k,2947) - lu(k,2418) * lu(k,2935) + lu(k,2948) = lu(k,2948) - lu(k,2419) * lu(k,2935) + lu(k,2949) = lu(k,2949) - lu(k,2420) * lu(k,2935) + lu(k,2952) = lu(k,2952) - lu(k,2421) * lu(k,2935) + lu(k,2953) = lu(k,2953) - lu(k,2422) * lu(k,2935) + lu(k,2954) = lu(k,2954) - lu(k,2423) * lu(k,2935) + lu(k,2955) = lu(k,2955) - lu(k,2424) * lu(k,2935) + lu(k,2956) = lu(k,2956) - lu(k,2425) * lu(k,2935) + lu(k,2957) = lu(k,2957) - lu(k,2426) * lu(k,2935) + lu(k,2959) = lu(k,2959) - lu(k,2427) * lu(k,2935) + lu(k,2960) = lu(k,2960) - lu(k,2428) * lu(k,2935) + lu(k,2961) = lu(k,2961) - lu(k,2429) * lu(k,2935) + lu(k,2962) = lu(k,2962) - lu(k,2430) * lu(k,2935) + lu(k,3008) = lu(k,3008) - lu(k,2412) * lu(k,3007) + lu(k,3014) = lu(k,3014) - lu(k,2413) * lu(k,3007) + lu(k,3016) = lu(k,3016) - lu(k,2414) * lu(k,3007) + lu(k,3017) = lu(k,3017) - lu(k,2415) * lu(k,3007) + lu(k,3018) = lu(k,3018) - lu(k,2416) * lu(k,3007) + lu(k,3020) = lu(k,3020) - lu(k,2417) * lu(k,3007) + lu(k,3021) = lu(k,3021) - lu(k,2418) * lu(k,3007) + lu(k,3022) = lu(k,3022) - lu(k,2419) * lu(k,3007) + lu(k,3023) = lu(k,3023) - lu(k,2420) * lu(k,3007) + lu(k,3026) = lu(k,3026) - lu(k,2421) * lu(k,3007) + lu(k,3027) = lu(k,3027) - lu(k,2422) * lu(k,3007) + lu(k,3028) = lu(k,3028) - lu(k,2423) * lu(k,3007) + lu(k,3029) = lu(k,3029) - lu(k,2424) * lu(k,3007) + lu(k,3030) = lu(k,3030) - lu(k,2425) * lu(k,3007) + lu(k,3031) = lu(k,3031) - lu(k,2426) * lu(k,3007) + lu(k,3033) = lu(k,3033) - lu(k,2427) * lu(k,3007) + lu(k,3034) = lu(k,3034) - lu(k,2428) * lu(k,3007) + lu(k,3035) = lu(k,3035) - lu(k,2429) * lu(k,3007) + lu(k,3036) = lu(k,3036) - lu(k,2430) * lu(k,3007) + lu(k,3109) = lu(k,3109) - lu(k,2412) * lu(k,3108) + lu(k,3117) = lu(k,3117) - lu(k,2413) * lu(k,3108) + lu(k,3119) = lu(k,3119) - lu(k,2414) * lu(k,3108) + lu(k,3120) = lu(k,3120) - lu(k,2415) * lu(k,3108) + lu(k,3121) = lu(k,3121) - lu(k,2416) * lu(k,3108) + lu(k,3123) = lu(k,3123) - lu(k,2417) * lu(k,3108) + lu(k,3124) = lu(k,3124) - lu(k,2418) * lu(k,3108) + lu(k,3125) = lu(k,3125) - lu(k,2419) * lu(k,3108) + lu(k,3126) = lu(k,3126) - lu(k,2420) * lu(k,3108) + lu(k,3129) = lu(k,3129) - lu(k,2421) * lu(k,3108) + lu(k,3130) = lu(k,3130) - lu(k,2422) * lu(k,3108) + lu(k,3131) = lu(k,3131) - lu(k,2423) * lu(k,3108) + lu(k,3132) = lu(k,3132) - lu(k,2424) * lu(k,3108) + lu(k,3133) = lu(k,3133) - lu(k,2425) * lu(k,3108) + lu(k,3134) = lu(k,3134) - lu(k,2426) * lu(k,3108) + lu(k,3136) = lu(k,3136) - lu(k,2427) * lu(k,3108) + lu(k,3137) = lu(k,3137) - lu(k,2428) * lu(k,3108) + lu(k,3138) = lu(k,3138) - lu(k,2429) * lu(k,3108) + lu(k,3139) = lu(k,3139) - lu(k,2430) * lu(k,3108) + lu(k,3291) = lu(k,3291) - lu(k,2412) * lu(k,3290) + lu(k,3299) = lu(k,3299) - lu(k,2413) * lu(k,3290) + lu(k,3301) = lu(k,3301) - lu(k,2414) * lu(k,3290) + lu(k,3302) = lu(k,3302) - lu(k,2415) * lu(k,3290) + lu(k,3303) = lu(k,3303) - lu(k,2416) * lu(k,3290) + lu(k,3305) = lu(k,3305) - lu(k,2417) * lu(k,3290) + lu(k,3306) = lu(k,3306) - lu(k,2418) * lu(k,3290) + lu(k,3307) = lu(k,3307) - lu(k,2419) * lu(k,3290) + lu(k,3308) = lu(k,3308) - lu(k,2420) * lu(k,3290) + lu(k,3311) = lu(k,3311) - lu(k,2421) * lu(k,3290) + lu(k,3312) = lu(k,3312) - lu(k,2422) * lu(k,3290) + lu(k,3313) = lu(k,3313) - lu(k,2423) * lu(k,3290) + lu(k,3314) = lu(k,3314) - lu(k,2424) * lu(k,3290) + lu(k,3315) = lu(k,3315) - lu(k,2425) * lu(k,3290) + lu(k,3316) = lu(k,3316) - lu(k,2426) * lu(k,3290) + lu(k,3318) = lu(k,3318) - lu(k,2427) * lu(k,3290) + lu(k,3319) = lu(k,3319) - lu(k,2428) * lu(k,3290) + lu(k,3320) = lu(k,3320) - lu(k,2429) * lu(k,3290) + lu(k,3321) = lu(k,3321) - lu(k,2430) * lu(k,3290) + lu(k,3547) = lu(k,3547) - lu(k,2412) * lu(k,3546) + lu(k,3555) = lu(k,3555) - lu(k,2413) * lu(k,3546) + lu(k,3557) = lu(k,3557) - lu(k,2414) * lu(k,3546) + lu(k,3558) = lu(k,3558) - lu(k,2415) * lu(k,3546) + lu(k,3559) = lu(k,3559) - lu(k,2416) * lu(k,3546) + lu(k,3561) = lu(k,3561) - lu(k,2417) * lu(k,3546) + lu(k,3562) = lu(k,3562) - lu(k,2418) * lu(k,3546) + lu(k,3563) = lu(k,3563) - lu(k,2419) * lu(k,3546) + lu(k,3564) = lu(k,3564) - lu(k,2420) * lu(k,3546) + lu(k,3567) = lu(k,3567) - lu(k,2421) * lu(k,3546) + lu(k,3568) = lu(k,3568) - lu(k,2422) * lu(k,3546) + lu(k,3569) = lu(k,3569) - lu(k,2423) * lu(k,3546) + lu(k,3570) = lu(k,3570) - lu(k,2424) * lu(k,3546) + lu(k,3571) = lu(k,3571) - lu(k,2425) * lu(k,3546) + lu(k,3572) = lu(k,3572) - lu(k,2426) * lu(k,3546) + lu(k,3574) = lu(k,3574) - lu(k,2427) * lu(k,3546) + lu(k,3575) = lu(k,3575) - lu(k,2428) * lu(k,3546) + lu(k,3576) = lu(k,3576) - lu(k,2429) * lu(k,3546) + lu(k,3577) = lu(k,3577) - lu(k,2430) * lu(k,3546) + lu(k,3797) = lu(k,3797) - lu(k,2412) * lu(k,3796) + lu(k,3805) = lu(k,3805) - lu(k,2413) * lu(k,3796) + lu(k,3807) = lu(k,3807) - lu(k,2414) * lu(k,3796) + lu(k,3808) = lu(k,3808) - lu(k,2415) * lu(k,3796) + lu(k,3809) = lu(k,3809) - lu(k,2416) * lu(k,3796) + lu(k,3811) = lu(k,3811) - lu(k,2417) * lu(k,3796) + lu(k,3812) = lu(k,3812) - lu(k,2418) * lu(k,3796) + lu(k,3813) = lu(k,3813) - lu(k,2419) * lu(k,3796) + lu(k,3814) = lu(k,3814) - lu(k,2420) * lu(k,3796) + lu(k,3817) = lu(k,3817) - lu(k,2421) * lu(k,3796) + lu(k,3818) = lu(k,3818) - lu(k,2422) * lu(k,3796) + lu(k,3819) = lu(k,3819) - lu(k,2423) * lu(k,3796) + lu(k,3820) = lu(k,3820) - lu(k,2424) * lu(k,3796) + lu(k,3821) = lu(k,3821) - lu(k,2425) * lu(k,3796) + lu(k,3822) = lu(k,3822) - lu(k,2426) * lu(k,3796) + lu(k,3824) = lu(k,3824) - lu(k,2427) * lu(k,3796) + lu(k,3825) = lu(k,3825) - lu(k,2428) * lu(k,3796) + lu(k,3826) = lu(k,3826) - lu(k,2429) * lu(k,3796) + lu(k,3827) = lu(k,3827) - lu(k,2430) * lu(k,3796) + lu(k,3932) = lu(k,3932) - lu(k,2412) * lu(k,3931) + lu(k,3940) = lu(k,3940) - lu(k,2413) * lu(k,3931) + lu(k,3942) = lu(k,3942) - lu(k,2414) * lu(k,3931) + lu(k,3943) = lu(k,3943) - lu(k,2415) * lu(k,3931) + lu(k,3944) = lu(k,3944) - lu(k,2416) * lu(k,3931) + lu(k,3946) = lu(k,3946) - lu(k,2417) * lu(k,3931) + lu(k,3947) = lu(k,3947) - lu(k,2418) * lu(k,3931) + lu(k,3948) = lu(k,3948) - lu(k,2419) * lu(k,3931) + lu(k,3949) = lu(k,3949) - lu(k,2420) * lu(k,3931) + lu(k,3952) = lu(k,3952) - lu(k,2421) * lu(k,3931) + lu(k,3953) = lu(k,3953) - lu(k,2422) * lu(k,3931) + lu(k,3954) = lu(k,3954) - lu(k,2423) * lu(k,3931) + lu(k,3955) = lu(k,3955) - lu(k,2424) * lu(k,3931) + lu(k,3956) = lu(k,3956) - lu(k,2425) * lu(k,3931) + lu(k,3957) = lu(k,3957) - lu(k,2426) * lu(k,3931) + lu(k,3959) = lu(k,3959) - lu(k,2427) * lu(k,3931) + lu(k,3960) = lu(k,3960) - lu(k,2428) * lu(k,3931) + lu(k,3961) = lu(k,3961) - lu(k,2429) * lu(k,3931) + lu(k,3962) = lu(k,3962) - lu(k,2430) * lu(k,3931) + lu(k,4025) = lu(k,4025) - lu(k,2412) * lu(k,4024) + lu(k,4032) = lu(k,4032) - lu(k,2413) * lu(k,4024) + lu(k,4034) = lu(k,4034) - lu(k,2414) * lu(k,4024) + lu(k,4035) = lu(k,4035) - lu(k,2415) * lu(k,4024) + lu(k,4036) = lu(k,4036) - lu(k,2416) * lu(k,4024) + lu(k,4038) = lu(k,4038) - lu(k,2417) * lu(k,4024) + lu(k,4039) = lu(k,4039) - lu(k,2418) * lu(k,4024) + lu(k,4040) = lu(k,4040) - lu(k,2419) * lu(k,4024) + lu(k,4041) = lu(k,4041) - lu(k,2420) * lu(k,4024) + lu(k,4044) = lu(k,4044) - lu(k,2421) * lu(k,4024) + lu(k,4045) = lu(k,4045) - lu(k,2422) * lu(k,4024) + lu(k,4046) = lu(k,4046) - lu(k,2423) * lu(k,4024) + lu(k,4047) = lu(k,4047) - lu(k,2424) * lu(k,4024) + lu(k,4048) = lu(k,4048) - lu(k,2425) * lu(k,4024) + lu(k,4049) = lu(k,4049) - lu(k,2426) * lu(k,4024) + lu(k,4051) = lu(k,4051) - lu(k,2427) * lu(k,4024) + lu(k,4052) = lu(k,4052) - lu(k,2428) * lu(k,4024) + lu(k,4053) = lu(k,4053) - lu(k,2429) * lu(k,4024) + lu(k,4054) = lu(k,4054) - lu(k,2430) * lu(k,4024) + lu(k,2437) = 1._r8 / lu(k,2437) + lu(k,2438) = lu(k,2438) * lu(k,2437) + lu(k,2439) = lu(k,2439) * lu(k,2437) + lu(k,2440) = lu(k,2440) * lu(k,2437) + lu(k,2441) = lu(k,2441) * lu(k,2437) + lu(k,2442) = lu(k,2442) * lu(k,2437) + lu(k,2443) = lu(k,2443) * lu(k,2437) + lu(k,2444) = lu(k,2444) * lu(k,2437) + lu(k,2445) = lu(k,2445) * lu(k,2437) + lu(k,2446) = lu(k,2446) * lu(k,2437) + lu(k,2447) = lu(k,2447) * lu(k,2437) + lu(k,2448) = lu(k,2448) * lu(k,2437) + lu(k,2449) = lu(k,2449) * lu(k,2437) + lu(k,2450) = lu(k,2450) * lu(k,2437) + lu(k,2451) = lu(k,2451) * lu(k,2437) + lu(k,2467) = lu(k,2467) - lu(k,2438) * lu(k,2465) + lu(k,2468) = lu(k,2468) - lu(k,2439) * lu(k,2465) + lu(k,2469) = lu(k,2469) - lu(k,2440) * lu(k,2465) + lu(k,2470) = lu(k,2470) - lu(k,2441) * lu(k,2465) + lu(k,2471) = lu(k,2471) - lu(k,2442) * lu(k,2465) + lu(k,2472) = lu(k,2472) - lu(k,2443) * lu(k,2465) + lu(k,2475) = lu(k,2475) - lu(k,2444) * lu(k,2465) + lu(k,2476) = lu(k,2476) - lu(k,2445) * lu(k,2465) + lu(k,2477) = lu(k,2477) - lu(k,2446) * lu(k,2465) + lu(k,2478) = lu(k,2478) - lu(k,2447) * lu(k,2465) + lu(k,2479) = lu(k,2479) - lu(k,2448) * lu(k,2465) + lu(k,2480) = lu(k,2480) - lu(k,2449) * lu(k,2465) + lu(k,2481) = lu(k,2481) - lu(k,2450) * lu(k,2465) + lu(k,2483) = lu(k,2483) - lu(k,2451) * lu(k,2465) + lu(k,2699) = lu(k,2699) - lu(k,2438) * lu(k,2697) + lu(k,2701) = lu(k,2701) - lu(k,2439) * lu(k,2697) + lu(k,2702) = lu(k,2702) - lu(k,2440) * lu(k,2697) + lu(k,2703) = lu(k,2703) - lu(k,2441) * lu(k,2697) + lu(k,2704) = lu(k,2704) - lu(k,2442) * lu(k,2697) + lu(k,2705) = lu(k,2705) - lu(k,2443) * lu(k,2697) + lu(k,2710) = lu(k,2710) - lu(k,2444) * lu(k,2697) + lu(k,2711) = lu(k,2711) - lu(k,2445) * lu(k,2697) + lu(k,2712) = lu(k,2712) - lu(k,2446) * lu(k,2697) + lu(k,2713) = lu(k,2713) - lu(k,2447) * lu(k,2697) + lu(k,2714) = lu(k,2714) - lu(k,2448) * lu(k,2697) + lu(k,2715) = lu(k,2715) - lu(k,2449) * lu(k,2697) + lu(k,2717) = lu(k,2717) - lu(k,2450) * lu(k,2697) + lu(k,2719) = lu(k,2719) - lu(k,2451) * lu(k,2697) + lu(k,2802) = lu(k,2802) - lu(k,2438) * lu(k,2801) + lu(k,2803) = lu(k,2803) - lu(k,2439) * lu(k,2801) + lu(k,2804) = lu(k,2804) - lu(k,2440) * lu(k,2801) + lu(k,2805) = lu(k,2805) - lu(k,2441) * lu(k,2801) + lu(k,2807) = lu(k,2807) - lu(k,2442) * lu(k,2801) + lu(k,2808) = lu(k,2808) - lu(k,2443) * lu(k,2801) + lu(k,2813) = lu(k,2813) - lu(k,2444) * lu(k,2801) + lu(k,2814) = lu(k,2814) - lu(k,2445) * lu(k,2801) + lu(k,2815) = lu(k,2815) - lu(k,2446) * lu(k,2801) + lu(k,2816) = lu(k,2816) - lu(k,2447) * lu(k,2801) + lu(k,2817) = lu(k,2817) - lu(k,2448) * lu(k,2801) + lu(k,2818) = lu(k,2818) - lu(k,2449) * lu(k,2801) + lu(k,2820) = lu(k,2820) - lu(k,2450) * lu(k,2801) + lu(k,2822) = lu(k,2822) - lu(k,2451) * lu(k,2801) + lu(k,2847) = lu(k,2847) - lu(k,2438) * lu(k,2843) + lu(k,2849) = lu(k,2849) - lu(k,2439) * lu(k,2843) + lu(k,2850) = lu(k,2850) - lu(k,2440) * lu(k,2843) + lu(k,2851) = lu(k,2851) - lu(k,2441) * lu(k,2843) + lu(k,2853) = lu(k,2853) - lu(k,2442) * lu(k,2843) + lu(k,2854) = lu(k,2854) - lu(k,2443) * lu(k,2843) + lu(k,2859) = lu(k,2859) - lu(k,2444) * lu(k,2843) + lu(k,2860) = lu(k,2860) - lu(k,2445) * lu(k,2843) + lu(k,2861) = lu(k,2861) - lu(k,2446) * lu(k,2843) + lu(k,2862) = lu(k,2862) - lu(k,2447) * lu(k,2843) + lu(k,2863) = lu(k,2863) - lu(k,2448) * lu(k,2843) + lu(k,2864) = lu(k,2864) - lu(k,2449) * lu(k,2843) + lu(k,2866) = lu(k,2866) - lu(k,2450) * lu(k,2843) + lu(k,2868) = lu(k,2868) - lu(k,2451) * lu(k,2843) + lu(k,2894) = lu(k,2894) - lu(k,2438) * lu(k,2890) + lu(k,2896) = lu(k,2896) - lu(k,2439) * lu(k,2890) + lu(k,2897) = lu(k,2897) - lu(k,2440) * lu(k,2890) + lu(k,2898) = lu(k,2898) - lu(k,2441) * lu(k,2890) + lu(k,2900) = lu(k,2900) - lu(k,2442) * lu(k,2890) + lu(k,2901) = lu(k,2901) - lu(k,2443) * lu(k,2890) + lu(k,2906) = lu(k,2906) - lu(k,2444) * lu(k,2890) + lu(k,2907) = lu(k,2907) - lu(k,2445) * lu(k,2890) + lu(k,2908) = lu(k,2908) - lu(k,2446) * lu(k,2890) + lu(k,2909) = lu(k,2909) - lu(k,2447) * lu(k,2890) + lu(k,2910) = lu(k,2910) - lu(k,2448) * lu(k,2890) + lu(k,2911) = lu(k,2911) - lu(k,2449) * lu(k,2890) + lu(k,2913) = lu(k,2913) - lu(k,2450) * lu(k,2890) + lu(k,2915) = lu(k,2915) - lu(k,2451) * lu(k,2890) + lu(k,2940) = lu(k,2940) - lu(k,2438) * lu(k,2936) + lu(k,2942) = lu(k,2942) - lu(k,2439) * lu(k,2936) + lu(k,2943) = lu(k,2943) - lu(k,2440) * lu(k,2936) + lu(k,2944) = lu(k,2944) - lu(k,2441) * lu(k,2936) + lu(k,2946) = lu(k,2946) - lu(k,2442) * lu(k,2936) + lu(k,2947) = lu(k,2947) - lu(k,2443) * lu(k,2936) + lu(k,2952) = lu(k,2952) - lu(k,2444) * lu(k,2936) + lu(k,2953) = lu(k,2953) - lu(k,2445) * lu(k,2936) + lu(k,2954) = lu(k,2954) - lu(k,2446) * lu(k,2936) + lu(k,2955) = lu(k,2955) - lu(k,2447) * lu(k,2936) + lu(k,2956) = lu(k,2956) - lu(k,2448) * lu(k,2936) + lu(k,2957) = lu(k,2957) - lu(k,2449) * lu(k,2936) + lu(k,2959) = lu(k,2959) - lu(k,2450) * lu(k,2936) + lu(k,2961) = lu(k,2961) - lu(k,2451) * lu(k,2936) + lu(k,3014) = lu(k,3014) - lu(k,2438) * lu(k,3008) + lu(k,3016) = lu(k,3016) - lu(k,2439) * lu(k,3008) + lu(k,3017) = lu(k,3017) - lu(k,2440) * lu(k,3008) + lu(k,3018) = lu(k,3018) - lu(k,2441) * lu(k,3008) + lu(k,3020) = lu(k,3020) - lu(k,2442) * lu(k,3008) + lu(k,3021) = lu(k,3021) - lu(k,2443) * lu(k,3008) + lu(k,3026) = lu(k,3026) - lu(k,2444) * lu(k,3008) + lu(k,3027) = lu(k,3027) - lu(k,2445) * lu(k,3008) + lu(k,3028) = lu(k,3028) - lu(k,2446) * lu(k,3008) + lu(k,3029) = lu(k,3029) - lu(k,2447) * lu(k,3008) + lu(k,3030) = lu(k,3030) - lu(k,2448) * lu(k,3008) + lu(k,3031) = lu(k,3031) - lu(k,2449) * lu(k,3008) + lu(k,3033) = lu(k,3033) - lu(k,2450) * lu(k,3008) + lu(k,3035) = lu(k,3035) - lu(k,2451) * lu(k,3008) + lu(k,3117) = lu(k,3117) - lu(k,2438) * lu(k,3109) + lu(k,3119) = lu(k,3119) - lu(k,2439) * lu(k,3109) + lu(k,3120) = lu(k,3120) - lu(k,2440) * lu(k,3109) + lu(k,3121) = lu(k,3121) - lu(k,2441) * lu(k,3109) + lu(k,3123) = lu(k,3123) - lu(k,2442) * lu(k,3109) + lu(k,3124) = lu(k,3124) - lu(k,2443) * lu(k,3109) + lu(k,3129) = lu(k,3129) - lu(k,2444) * lu(k,3109) + lu(k,3130) = lu(k,3130) - lu(k,2445) * lu(k,3109) + lu(k,3131) = lu(k,3131) - lu(k,2446) * lu(k,3109) + lu(k,3132) = lu(k,3132) - lu(k,2447) * lu(k,3109) + lu(k,3133) = lu(k,3133) - lu(k,2448) * lu(k,3109) + lu(k,3134) = lu(k,3134) - lu(k,2449) * lu(k,3109) + lu(k,3136) = lu(k,3136) - lu(k,2450) * lu(k,3109) + lu(k,3138) = lu(k,3138) - lu(k,2451) * lu(k,3109) + lu(k,3299) = lu(k,3299) - lu(k,2438) * lu(k,3291) + lu(k,3301) = lu(k,3301) - lu(k,2439) * lu(k,3291) + lu(k,3302) = lu(k,3302) - lu(k,2440) * lu(k,3291) + lu(k,3303) = lu(k,3303) - lu(k,2441) * lu(k,3291) + lu(k,3305) = lu(k,3305) - lu(k,2442) * lu(k,3291) + lu(k,3306) = lu(k,3306) - lu(k,2443) * lu(k,3291) + lu(k,3311) = lu(k,3311) - lu(k,2444) * lu(k,3291) + lu(k,3312) = lu(k,3312) - lu(k,2445) * lu(k,3291) + lu(k,3313) = lu(k,3313) - lu(k,2446) * lu(k,3291) + lu(k,3314) = lu(k,3314) - lu(k,2447) * lu(k,3291) + lu(k,3315) = lu(k,3315) - lu(k,2448) * lu(k,3291) + lu(k,3316) = lu(k,3316) - lu(k,2449) * lu(k,3291) + lu(k,3318) = lu(k,3318) - lu(k,2450) * lu(k,3291) + lu(k,3320) = lu(k,3320) - lu(k,2451) * lu(k,3291) + lu(k,3555) = lu(k,3555) - lu(k,2438) * lu(k,3547) + lu(k,3557) = lu(k,3557) - lu(k,2439) * lu(k,3547) + lu(k,3558) = lu(k,3558) - lu(k,2440) * lu(k,3547) + lu(k,3559) = lu(k,3559) - lu(k,2441) * lu(k,3547) + lu(k,3561) = lu(k,3561) - lu(k,2442) * lu(k,3547) + lu(k,3562) = lu(k,3562) - lu(k,2443) * lu(k,3547) + lu(k,3567) = lu(k,3567) - lu(k,2444) * lu(k,3547) + lu(k,3568) = lu(k,3568) - lu(k,2445) * lu(k,3547) + lu(k,3569) = lu(k,3569) - lu(k,2446) * lu(k,3547) + lu(k,3570) = lu(k,3570) - lu(k,2447) * lu(k,3547) + lu(k,3571) = lu(k,3571) - lu(k,2448) * lu(k,3547) + lu(k,3572) = lu(k,3572) - lu(k,2449) * lu(k,3547) + lu(k,3574) = lu(k,3574) - lu(k,2450) * lu(k,3547) + lu(k,3576) = lu(k,3576) - lu(k,2451) * lu(k,3547) + lu(k,3805) = lu(k,3805) - lu(k,2438) * lu(k,3797) + lu(k,3807) = lu(k,3807) - lu(k,2439) * lu(k,3797) + lu(k,3808) = lu(k,3808) - lu(k,2440) * lu(k,3797) + lu(k,3809) = lu(k,3809) - lu(k,2441) * lu(k,3797) + lu(k,3811) = lu(k,3811) - lu(k,2442) * lu(k,3797) + lu(k,3812) = lu(k,3812) - lu(k,2443) * lu(k,3797) + lu(k,3817) = lu(k,3817) - lu(k,2444) * lu(k,3797) + lu(k,3818) = lu(k,3818) - lu(k,2445) * lu(k,3797) + lu(k,3819) = lu(k,3819) - lu(k,2446) * lu(k,3797) + lu(k,3820) = lu(k,3820) - lu(k,2447) * lu(k,3797) + lu(k,3821) = lu(k,3821) - lu(k,2448) * lu(k,3797) + lu(k,3822) = lu(k,3822) - lu(k,2449) * lu(k,3797) + lu(k,3824) = lu(k,3824) - lu(k,2450) * lu(k,3797) + lu(k,3826) = lu(k,3826) - lu(k,2451) * lu(k,3797) + lu(k,3940) = lu(k,3940) - lu(k,2438) * lu(k,3932) + lu(k,3942) = lu(k,3942) - lu(k,2439) * lu(k,3932) + lu(k,3943) = lu(k,3943) - lu(k,2440) * lu(k,3932) + lu(k,3944) = lu(k,3944) - lu(k,2441) * lu(k,3932) + lu(k,3946) = lu(k,3946) - lu(k,2442) * lu(k,3932) + lu(k,3947) = lu(k,3947) - lu(k,2443) * lu(k,3932) + lu(k,3952) = lu(k,3952) - lu(k,2444) * lu(k,3932) + lu(k,3953) = lu(k,3953) - lu(k,2445) * lu(k,3932) + lu(k,3954) = lu(k,3954) - lu(k,2446) * lu(k,3932) + lu(k,3955) = lu(k,3955) - lu(k,2447) * lu(k,3932) + lu(k,3956) = lu(k,3956) - lu(k,2448) * lu(k,3932) + lu(k,3957) = lu(k,3957) - lu(k,2449) * lu(k,3932) + lu(k,3959) = lu(k,3959) - lu(k,2450) * lu(k,3932) + lu(k,3961) = lu(k,3961) - lu(k,2451) * lu(k,3932) + lu(k,4032) = lu(k,4032) - lu(k,2438) * lu(k,4025) + lu(k,4034) = lu(k,4034) - lu(k,2439) * lu(k,4025) + lu(k,4035) = lu(k,4035) - lu(k,2440) * lu(k,4025) + lu(k,4036) = lu(k,4036) - lu(k,2441) * lu(k,4025) + lu(k,4038) = lu(k,4038) - lu(k,2442) * lu(k,4025) + lu(k,4039) = lu(k,4039) - lu(k,2443) * lu(k,4025) + lu(k,4044) = lu(k,4044) - lu(k,2444) * lu(k,4025) + lu(k,4045) = lu(k,4045) - lu(k,2445) * lu(k,4025) + lu(k,4046) = lu(k,4046) - lu(k,2446) * lu(k,4025) + lu(k,4047) = lu(k,4047) - lu(k,2447) * lu(k,4025) + lu(k,4048) = lu(k,4048) - lu(k,2448) * lu(k,4025) + lu(k,4049) = lu(k,4049) - lu(k,2449) * lu(k,4025) + lu(k,4051) = lu(k,4051) - lu(k,2450) * lu(k,4025) + lu(k,4053) = lu(k,4053) - lu(k,2451) * lu(k,4025) + lu(k,2466) = 1._r8 / lu(k,2466) + lu(k,2467) = lu(k,2467) * lu(k,2466) + lu(k,2468) = lu(k,2468) * lu(k,2466) + lu(k,2469) = lu(k,2469) * lu(k,2466) + lu(k,2470) = lu(k,2470) * lu(k,2466) + lu(k,2471) = lu(k,2471) * lu(k,2466) + lu(k,2472) = lu(k,2472) * lu(k,2466) + lu(k,2473) = lu(k,2473) * lu(k,2466) + lu(k,2474) = lu(k,2474) * lu(k,2466) + lu(k,2475) = lu(k,2475) * lu(k,2466) + lu(k,2476) = lu(k,2476) * lu(k,2466) + lu(k,2477) = lu(k,2477) * lu(k,2466) + lu(k,2478) = lu(k,2478) * lu(k,2466) + lu(k,2479) = lu(k,2479) * lu(k,2466) + lu(k,2480) = lu(k,2480) * lu(k,2466) + lu(k,2481) = lu(k,2481) * lu(k,2466) + lu(k,2482) = lu(k,2482) * lu(k,2466) + lu(k,2483) = lu(k,2483) * lu(k,2466) + lu(k,2484) = lu(k,2484) * lu(k,2466) + lu(k,2847) = lu(k,2847) - lu(k,2467) * lu(k,2844) + lu(k,2849) = lu(k,2849) - lu(k,2468) * lu(k,2844) + lu(k,2850) = lu(k,2850) - lu(k,2469) * lu(k,2844) + lu(k,2851) = lu(k,2851) - lu(k,2470) * lu(k,2844) + lu(k,2853) = lu(k,2853) - lu(k,2471) * lu(k,2844) + lu(k,2854) = lu(k,2854) - lu(k,2472) * lu(k,2844) + lu(k,2855) = lu(k,2855) - lu(k,2473) * lu(k,2844) + lu(k,2856) = lu(k,2856) - lu(k,2474) * lu(k,2844) + lu(k,2859) = lu(k,2859) - lu(k,2475) * lu(k,2844) + lu(k,2860) = lu(k,2860) - lu(k,2476) * lu(k,2844) + lu(k,2861) = lu(k,2861) - lu(k,2477) * lu(k,2844) + lu(k,2862) = lu(k,2862) - lu(k,2478) * lu(k,2844) + lu(k,2863) = lu(k,2863) - lu(k,2479) * lu(k,2844) + lu(k,2864) = lu(k,2864) - lu(k,2480) * lu(k,2844) + lu(k,2866) = lu(k,2866) - lu(k,2481) * lu(k,2844) + lu(k,2867) = lu(k,2867) - lu(k,2482) * lu(k,2844) + lu(k,2868) = lu(k,2868) - lu(k,2483) * lu(k,2844) + lu(k,2869) = lu(k,2869) - lu(k,2484) * lu(k,2844) + lu(k,2894) = lu(k,2894) - lu(k,2467) * lu(k,2891) + lu(k,2896) = lu(k,2896) - lu(k,2468) * lu(k,2891) + lu(k,2897) = lu(k,2897) - lu(k,2469) * lu(k,2891) + lu(k,2898) = lu(k,2898) - lu(k,2470) * lu(k,2891) + lu(k,2900) = lu(k,2900) - lu(k,2471) * lu(k,2891) + lu(k,2901) = lu(k,2901) - lu(k,2472) * lu(k,2891) + lu(k,2902) = lu(k,2902) - lu(k,2473) * lu(k,2891) + lu(k,2903) = lu(k,2903) - lu(k,2474) * lu(k,2891) + lu(k,2906) = lu(k,2906) - lu(k,2475) * lu(k,2891) + lu(k,2907) = lu(k,2907) - lu(k,2476) * lu(k,2891) + lu(k,2908) = lu(k,2908) - lu(k,2477) * lu(k,2891) + lu(k,2909) = lu(k,2909) - lu(k,2478) * lu(k,2891) + lu(k,2910) = lu(k,2910) - lu(k,2479) * lu(k,2891) + lu(k,2911) = lu(k,2911) - lu(k,2480) * lu(k,2891) + lu(k,2913) = lu(k,2913) - lu(k,2481) * lu(k,2891) + lu(k,2914) = lu(k,2914) - lu(k,2482) * lu(k,2891) + lu(k,2915) = lu(k,2915) - lu(k,2483) * lu(k,2891) + lu(k,2916) = lu(k,2916) - lu(k,2484) * lu(k,2891) + lu(k,2940) = lu(k,2940) - lu(k,2467) * lu(k,2937) + lu(k,2942) = lu(k,2942) - lu(k,2468) * lu(k,2937) + lu(k,2943) = lu(k,2943) - lu(k,2469) * lu(k,2937) + lu(k,2944) = lu(k,2944) - lu(k,2470) * lu(k,2937) + lu(k,2946) = lu(k,2946) - lu(k,2471) * lu(k,2937) + lu(k,2947) = lu(k,2947) - lu(k,2472) * lu(k,2937) + lu(k,2948) = lu(k,2948) - lu(k,2473) * lu(k,2937) + lu(k,2949) = lu(k,2949) - lu(k,2474) * lu(k,2937) + lu(k,2952) = lu(k,2952) - lu(k,2475) * lu(k,2937) + lu(k,2953) = lu(k,2953) - lu(k,2476) * lu(k,2937) + lu(k,2954) = lu(k,2954) - lu(k,2477) * lu(k,2937) + lu(k,2955) = lu(k,2955) - lu(k,2478) * lu(k,2937) + lu(k,2956) = lu(k,2956) - lu(k,2479) * lu(k,2937) + lu(k,2957) = lu(k,2957) - lu(k,2480) * lu(k,2937) + lu(k,2959) = lu(k,2959) - lu(k,2481) * lu(k,2937) + lu(k,2960) = lu(k,2960) - lu(k,2482) * lu(k,2937) + lu(k,2961) = lu(k,2961) - lu(k,2483) * lu(k,2937) + lu(k,2962) = lu(k,2962) - lu(k,2484) * lu(k,2937) + lu(k,3014) = lu(k,3014) - lu(k,2467) * lu(k,3009) + lu(k,3016) = lu(k,3016) - lu(k,2468) * lu(k,3009) + lu(k,3017) = lu(k,3017) - lu(k,2469) * lu(k,3009) + lu(k,3018) = lu(k,3018) - lu(k,2470) * lu(k,3009) + lu(k,3020) = lu(k,3020) - lu(k,2471) * lu(k,3009) + lu(k,3021) = lu(k,3021) - lu(k,2472) * lu(k,3009) + lu(k,3022) = lu(k,3022) - lu(k,2473) * lu(k,3009) + lu(k,3023) = lu(k,3023) - lu(k,2474) * lu(k,3009) + lu(k,3026) = lu(k,3026) - lu(k,2475) * lu(k,3009) + lu(k,3027) = lu(k,3027) - lu(k,2476) * lu(k,3009) + lu(k,3028) = lu(k,3028) - lu(k,2477) * lu(k,3009) + lu(k,3029) = lu(k,3029) - lu(k,2478) * lu(k,3009) + lu(k,3030) = lu(k,3030) - lu(k,2479) * lu(k,3009) + lu(k,3031) = lu(k,3031) - lu(k,2480) * lu(k,3009) + lu(k,3033) = lu(k,3033) - lu(k,2481) * lu(k,3009) + lu(k,3034) = lu(k,3034) - lu(k,2482) * lu(k,3009) + lu(k,3035) = lu(k,3035) - lu(k,2483) * lu(k,3009) + lu(k,3036) = lu(k,3036) - lu(k,2484) * lu(k,3009) + lu(k,3117) = lu(k,3117) - lu(k,2467) * lu(k,3110) + lu(k,3119) = lu(k,3119) - lu(k,2468) * lu(k,3110) + lu(k,3120) = lu(k,3120) - lu(k,2469) * lu(k,3110) + lu(k,3121) = lu(k,3121) - lu(k,2470) * lu(k,3110) + lu(k,3123) = lu(k,3123) - lu(k,2471) * lu(k,3110) + lu(k,3124) = lu(k,3124) - lu(k,2472) * lu(k,3110) + lu(k,3125) = lu(k,3125) - lu(k,2473) * lu(k,3110) + lu(k,3126) = lu(k,3126) - lu(k,2474) * lu(k,3110) + lu(k,3129) = lu(k,3129) - lu(k,2475) * lu(k,3110) + lu(k,3130) = lu(k,3130) - lu(k,2476) * lu(k,3110) + lu(k,3131) = lu(k,3131) - lu(k,2477) * lu(k,3110) + lu(k,3132) = lu(k,3132) - lu(k,2478) * lu(k,3110) + lu(k,3133) = lu(k,3133) - lu(k,2479) * lu(k,3110) + lu(k,3134) = lu(k,3134) - lu(k,2480) * lu(k,3110) + lu(k,3136) = lu(k,3136) - lu(k,2481) * lu(k,3110) + lu(k,3137) = lu(k,3137) - lu(k,2482) * lu(k,3110) + lu(k,3138) = lu(k,3138) - lu(k,2483) * lu(k,3110) + lu(k,3139) = lu(k,3139) - lu(k,2484) * lu(k,3110) + lu(k,3299) = lu(k,3299) - lu(k,2467) * lu(k,3292) + lu(k,3301) = lu(k,3301) - lu(k,2468) * lu(k,3292) + lu(k,3302) = lu(k,3302) - lu(k,2469) * lu(k,3292) + lu(k,3303) = lu(k,3303) - lu(k,2470) * lu(k,3292) + lu(k,3305) = lu(k,3305) - lu(k,2471) * lu(k,3292) + lu(k,3306) = lu(k,3306) - lu(k,2472) * lu(k,3292) + lu(k,3307) = lu(k,3307) - lu(k,2473) * lu(k,3292) + lu(k,3308) = lu(k,3308) - lu(k,2474) * lu(k,3292) + lu(k,3311) = lu(k,3311) - lu(k,2475) * lu(k,3292) + lu(k,3312) = lu(k,3312) - lu(k,2476) * lu(k,3292) + lu(k,3313) = lu(k,3313) - lu(k,2477) * lu(k,3292) + lu(k,3314) = lu(k,3314) - lu(k,2478) * lu(k,3292) + lu(k,3315) = lu(k,3315) - lu(k,2479) * lu(k,3292) + lu(k,3316) = lu(k,3316) - lu(k,2480) * lu(k,3292) + lu(k,3318) = lu(k,3318) - lu(k,2481) * lu(k,3292) + lu(k,3319) = lu(k,3319) - lu(k,2482) * lu(k,3292) + lu(k,3320) = lu(k,3320) - lu(k,2483) * lu(k,3292) + lu(k,3321) = lu(k,3321) - lu(k,2484) * lu(k,3292) + lu(k,3555) = lu(k,3555) - lu(k,2467) * lu(k,3548) + lu(k,3557) = lu(k,3557) - lu(k,2468) * lu(k,3548) + lu(k,3558) = lu(k,3558) - lu(k,2469) * lu(k,3548) + lu(k,3559) = lu(k,3559) - lu(k,2470) * lu(k,3548) + lu(k,3561) = lu(k,3561) - lu(k,2471) * lu(k,3548) + lu(k,3562) = lu(k,3562) - lu(k,2472) * lu(k,3548) + lu(k,3563) = lu(k,3563) - lu(k,2473) * lu(k,3548) + lu(k,3564) = lu(k,3564) - lu(k,2474) * lu(k,3548) + lu(k,3567) = lu(k,3567) - lu(k,2475) * lu(k,3548) + lu(k,3568) = lu(k,3568) - lu(k,2476) * lu(k,3548) + lu(k,3569) = lu(k,3569) - lu(k,2477) * lu(k,3548) + lu(k,3570) = lu(k,3570) - lu(k,2478) * lu(k,3548) + lu(k,3571) = lu(k,3571) - lu(k,2479) * lu(k,3548) + lu(k,3572) = lu(k,3572) - lu(k,2480) * lu(k,3548) + lu(k,3574) = lu(k,3574) - lu(k,2481) * lu(k,3548) + lu(k,3575) = lu(k,3575) - lu(k,2482) * lu(k,3548) + lu(k,3576) = lu(k,3576) - lu(k,2483) * lu(k,3548) + lu(k,3577) = lu(k,3577) - lu(k,2484) * lu(k,3548) + lu(k,3805) = lu(k,3805) - lu(k,2467) * lu(k,3798) + lu(k,3807) = lu(k,3807) - lu(k,2468) * lu(k,3798) + lu(k,3808) = lu(k,3808) - lu(k,2469) * lu(k,3798) + lu(k,3809) = lu(k,3809) - lu(k,2470) * lu(k,3798) + lu(k,3811) = lu(k,3811) - lu(k,2471) * lu(k,3798) + lu(k,3812) = lu(k,3812) - lu(k,2472) * lu(k,3798) + lu(k,3813) = lu(k,3813) - lu(k,2473) * lu(k,3798) + lu(k,3814) = lu(k,3814) - lu(k,2474) * lu(k,3798) + lu(k,3817) = lu(k,3817) - lu(k,2475) * lu(k,3798) + lu(k,3818) = lu(k,3818) - lu(k,2476) * lu(k,3798) + lu(k,3819) = lu(k,3819) - lu(k,2477) * lu(k,3798) + lu(k,3820) = lu(k,3820) - lu(k,2478) * lu(k,3798) + lu(k,3821) = lu(k,3821) - lu(k,2479) * lu(k,3798) + lu(k,3822) = lu(k,3822) - lu(k,2480) * lu(k,3798) + lu(k,3824) = lu(k,3824) - lu(k,2481) * lu(k,3798) + lu(k,3825) = lu(k,3825) - lu(k,2482) * lu(k,3798) + lu(k,3826) = lu(k,3826) - lu(k,2483) * lu(k,3798) + lu(k,3827) = lu(k,3827) - lu(k,2484) * lu(k,3798) + lu(k,3940) = lu(k,3940) - lu(k,2467) * lu(k,3933) + lu(k,3942) = lu(k,3942) - lu(k,2468) * lu(k,3933) + lu(k,3943) = lu(k,3943) - lu(k,2469) * lu(k,3933) + lu(k,3944) = lu(k,3944) - lu(k,2470) * lu(k,3933) + lu(k,3946) = lu(k,3946) - lu(k,2471) * lu(k,3933) + lu(k,3947) = lu(k,3947) - lu(k,2472) * lu(k,3933) + lu(k,3948) = lu(k,3948) - lu(k,2473) * lu(k,3933) + lu(k,3949) = lu(k,3949) - lu(k,2474) * lu(k,3933) + lu(k,3952) = lu(k,3952) - lu(k,2475) * lu(k,3933) + lu(k,3953) = lu(k,3953) - lu(k,2476) * lu(k,3933) + lu(k,3954) = lu(k,3954) - lu(k,2477) * lu(k,3933) + lu(k,3955) = lu(k,3955) - lu(k,2478) * lu(k,3933) + lu(k,3956) = lu(k,3956) - lu(k,2479) * lu(k,3933) + lu(k,3957) = lu(k,3957) - lu(k,2480) * lu(k,3933) + lu(k,3959) = lu(k,3959) - lu(k,2481) * lu(k,3933) + lu(k,3960) = lu(k,3960) - lu(k,2482) * lu(k,3933) + lu(k,3961) = lu(k,3961) - lu(k,2483) * lu(k,3933) + lu(k,3962) = lu(k,3962) - lu(k,2484) * lu(k,3933) + lu(k,4032) = lu(k,4032) - lu(k,2467) * lu(k,4026) + lu(k,4034) = lu(k,4034) - lu(k,2468) * lu(k,4026) + lu(k,4035) = lu(k,4035) - lu(k,2469) * lu(k,4026) + lu(k,4036) = lu(k,4036) - lu(k,2470) * lu(k,4026) + lu(k,4038) = lu(k,4038) - lu(k,2471) * lu(k,4026) + lu(k,4039) = lu(k,4039) - lu(k,2472) * lu(k,4026) + lu(k,4040) = lu(k,4040) - lu(k,2473) * lu(k,4026) + lu(k,4041) = lu(k,4041) - lu(k,2474) * lu(k,4026) + lu(k,4044) = lu(k,4044) - lu(k,2475) * lu(k,4026) + lu(k,4045) = lu(k,4045) - lu(k,2476) * lu(k,4026) + lu(k,4046) = lu(k,4046) - lu(k,2477) * lu(k,4026) + lu(k,4047) = lu(k,4047) - lu(k,2478) * lu(k,4026) + lu(k,4048) = lu(k,4048) - lu(k,2479) * lu(k,4026) + lu(k,4049) = lu(k,4049) - lu(k,2480) * lu(k,4026) + lu(k,4051) = lu(k,4051) - lu(k,2481) * lu(k,4026) + lu(k,4052) = lu(k,4052) - lu(k,2482) * lu(k,4026) + lu(k,4053) = lu(k,4053) - lu(k,2483) * lu(k,4026) + lu(k,4054) = lu(k,4054) - lu(k,2484) * lu(k,4026) end do end subroutine lu_fac47 subroutine lu_fac48( avec_len, lu ) @@ -14419,617 +13449,632 @@ subroutine lu_fac48( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,2627) = 1._r8 / lu(k,2627) - lu(k,2628) = lu(k,2628) * lu(k,2627) - lu(k,2629) = lu(k,2629) * lu(k,2627) - lu(k,2630) = lu(k,2630) * lu(k,2627) - lu(k,2631) = lu(k,2631) * lu(k,2627) - lu(k,2632) = lu(k,2632) * lu(k,2627) - lu(k,2633) = lu(k,2633) * lu(k,2627) - lu(k,2634) = lu(k,2634) * lu(k,2627) - lu(k,2635) = lu(k,2635) * lu(k,2627) - lu(k,2636) = lu(k,2636) * lu(k,2627) - lu(k,2637) = lu(k,2637) * lu(k,2627) - lu(k,2638) = lu(k,2638) * lu(k,2627) - lu(k,2639) = lu(k,2639) * lu(k,2627) - lu(k,2640) = lu(k,2640) * lu(k,2627) - lu(k,2641) = lu(k,2641) * lu(k,2627) - lu(k,2642) = lu(k,2642) * lu(k,2627) - lu(k,2699) = lu(k,2699) - lu(k,2628) * lu(k,2698) - lu(k,2700) = lu(k,2700) - lu(k,2629) * lu(k,2698) - lu(k,2701) = lu(k,2701) - lu(k,2630) * lu(k,2698) - lu(k,2702) = lu(k,2702) - lu(k,2631) * lu(k,2698) - lu(k,2703) = lu(k,2703) - lu(k,2632) * lu(k,2698) - lu(k,2704) = lu(k,2704) - lu(k,2633) * lu(k,2698) - lu(k,2705) = lu(k,2705) - lu(k,2634) * lu(k,2698) - lu(k,2706) = lu(k,2706) - lu(k,2635) * lu(k,2698) - lu(k,2707) = lu(k,2707) - lu(k,2636) * lu(k,2698) - lu(k,2708) = lu(k,2708) - lu(k,2637) * lu(k,2698) - lu(k,2709) = lu(k,2709) - lu(k,2638) * lu(k,2698) - lu(k,2710) = lu(k,2710) - lu(k,2639) * lu(k,2698) - lu(k,2711) = lu(k,2711) - lu(k,2640) * lu(k,2698) - lu(k,2712) = lu(k,2712) - lu(k,2641) * lu(k,2698) - lu(k,2713) = lu(k,2713) - lu(k,2642) * lu(k,2698) - lu(k,2882) = lu(k,2882) - lu(k,2628) * lu(k,2881) - lu(k,2883) = lu(k,2883) - lu(k,2629) * lu(k,2881) - lu(k,2884) = lu(k,2884) - lu(k,2630) * lu(k,2881) - lu(k,2885) = lu(k,2885) - lu(k,2631) * lu(k,2881) - lu(k,2886) = lu(k,2886) - lu(k,2632) * lu(k,2881) - lu(k,2887) = lu(k,2887) - lu(k,2633) * lu(k,2881) - lu(k,2889) = lu(k,2889) - lu(k,2634) * lu(k,2881) - lu(k,2891) = lu(k,2891) - lu(k,2635) * lu(k,2881) - lu(k,2892) = lu(k,2892) - lu(k,2636) * lu(k,2881) - lu(k,2893) = lu(k,2893) - lu(k,2637) * lu(k,2881) - lu(k,2894) = lu(k,2894) - lu(k,2638) * lu(k,2881) - lu(k,2895) = lu(k,2895) - lu(k,2639) * lu(k,2881) - lu(k,2896) = lu(k,2896) - lu(k,2640) * lu(k,2881) - lu(k,2898) = lu(k,2898) - lu(k,2641) * lu(k,2881) - lu(k,2899) = lu(k,2899) - lu(k,2642) * lu(k,2881) - lu(k,2983) = lu(k,2983) - lu(k,2628) * lu(k,2982) - lu(k,2984) = lu(k,2984) - lu(k,2629) * lu(k,2982) - lu(k,2985) = lu(k,2985) - lu(k,2630) * lu(k,2982) - lu(k,2986) = lu(k,2986) - lu(k,2631) * lu(k,2982) - lu(k,2987) = lu(k,2987) - lu(k,2632) * lu(k,2982) - lu(k,2988) = lu(k,2988) - lu(k,2633) * lu(k,2982) - lu(k,2990) = lu(k,2990) - lu(k,2634) * lu(k,2982) - lu(k,2992) = lu(k,2992) - lu(k,2635) * lu(k,2982) - lu(k,2993) = lu(k,2993) - lu(k,2636) * lu(k,2982) - lu(k,2994) = lu(k,2994) - lu(k,2637) * lu(k,2982) - lu(k,2995) = lu(k,2995) - lu(k,2638) * lu(k,2982) - lu(k,2996) = lu(k,2996) - lu(k,2639) * lu(k,2982) - lu(k,2997) = lu(k,2997) - lu(k,2640) * lu(k,2982) - lu(k,2999) = lu(k,2999) - lu(k,2641) * lu(k,2982) - lu(k,3000) = lu(k,3000) - lu(k,2642) * lu(k,2982) - lu(k,3075) = lu(k,3075) - lu(k,2628) * lu(k,3074) - lu(k,3076) = lu(k,3076) - lu(k,2629) * lu(k,3074) - lu(k,3077) = lu(k,3077) - lu(k,2630) * lu(k,3074) - lu(k,3078) = lu(k,3078) - lu(k,2631) * lu(k,3074) - lu(k,3079) = lu(k,3079) - lu(k,2632) * lu(k,3074) - lu(k,3080) = lu(k,3080) - lu(k,2633) * lu(k,3074) - lu(k,3082) = lu(k,3082) - lu(k,2634) * lu(k,3074) - lu(k,3084) = lu(k,3084) - lu(k,2635) * lu(k,3074) - lu(k,3085) = lu(k,3085) - lu(k,2636) * lu(k,3074) - lu(k,3086) = lu(k,3086) - lu(k,2637) * lu(k,3074) - lu(k,3087) = lu(k,3087) - lu(k,2638) * lu(k,3074) - lu(k,3088) = lu(k,3088) - lu(k,2639) * lu(k,3074) - lu(k,3089) = lu(k,3089) - lu(k,2640) * lu(k,3074) - lu(k,3091) = lu(k,3091) - lu(k,2641) * lu(k,3074) - lu(k,3092) = lu(k,3092) - lu(k,2642) * lu(k,3074) - lu(k,3278) = lu(k,3278) - lu(k,2628) * lu(k,3277) - lu(k,3279) = lu(k,3279) - lu(k,2629) * lu(k,3277) - lu(k,3280) = lu(k,3280) - lu(k,2630) * lu(k,3277) - lu(k,3281) = lu(k,3281) - lu(k,2631) * lu(k,3277) - lu(k,3282) = lu(k,3282) - lu(k,2632) * lu(k,3277) - lu(k,3283) = lu(k,3283) - lu(k,2633) * lu(k,3277) - lu(k,3285) = lu(k,3285) - lu(k,2634) * lu(k,3277) - lu(k,3287) = lu(k,3287) - lu(k,2635) * lu(k,3277) - lu(k,3288) = lu(k,3288) - lu(k,2636) * lu(k,3277) - lu(k,3289) = lu(k,3289) - lu(k,2637) * lu(k,3277) - lu(k,3290) = lu(k,3290) - lu(k,2638) * lu(k,3277) - lu(k,3291) = lu(k,3291) - lu(k,2639) * lu(k,3277) - lu(k,3292) = lu(k,3292) - lu(k,2640) * lu(k,3277) - lu(k,3294) = lu(k,3294) - lu(k,2641) * lu(k,3277) - lu(k,3295) = lu(k,3295) - lu(k,2642) * lu(k,3277) - lu(k,3419) = lu(k,3419) - lu(k,2628) * lu(k,3418) - lu(k,3420) = lu(k,3420) - lu(k,2629) * lu(k,3418) - lu(k,3421) = lu(k,3421) - lu(k,2630) * lu(k,3418) - lu(k,3422) = lu(k,3422) - lu(k,2631) * lu(k,3418) - lu(k,3423) = lu(k,3423) - lu(k,2632) * lu(k,3418) - lu(k,3424) = lu(k,3424) - lu(k,2633) * lu(k,3418) - lu(k,3426) = lu(k,3426) - lu(k,2634) * lu(k,3418) - lu(k,3428) = lu(k,3428) - lu(k,2635) * lu(k,3418) - lu(k,3429) = lu(k,3429) - lu(k,2636) * lu(k,3418) - lu(k,3430) = lu(k,3430) - lu(k,2637) * lu(k,3418) - lu(k,3431) = lu(k,3431) - lu(k,2638) * lu(k,3418) - lu(k,3432) = lu(k,3432) - lu(k,2639) * lu(k,3418) - lu(k,3433) = lu(k,3433) - lu(k,2640) * lu(k,3418) - lu(k,3435) = lu(k,3435) - lu(k,2641) * lu(k,3418) - lu(k,3436) = lu(k,3436) - lu(k,2642) * lu(k,3418) - lu(k,3499) = lu(k,3499) - lu(k,2628) * lu(k,3498) - lu(k,3500) = lu(k,3500) - lu(k,2629) * lu(k,3498) - lu(k,3501) = lu(k,3501) - lu(k,2630) * lu(k,3498) - lu(k,3502) = lu(k,3502) - lu(k,2631) * lu(k,3498) - lu(k,3503) = lu(k,3503) - lu(k,2632) * lu(k,3498) - lu(k,3504) = lu(k,3504) - lu(k,2633) * lu(k,3498) - lu(k,3506) = lu(k,3506) - lu(k,2634) * lu(k,3498) - lu(k,3508) = lu(k,3508) - lu(k,2635) * lu(k,3498) - lu(k,3509) = lu(k,3509) - lu(k,2636) * lu(k,3498) - lu(k,3510) = lu(k,3510) - lu(k,2637) * lu(k,3498) - lu(k,3511) = lu(k,3511) - lu(k,2638) * lu(k,3498) - lu(k,3512) = lu(k,3512) - lu(k,2639) * lu(k,3498) - lu(k,3513) = lu(k,3513) - lu(k,2640) * lu(k,3498) - lu(k,3515) = lu(k,3515) - lu(k,2641) * lu(k,3498) - lu(k,3516) = lu(k,3516) - lu(k,2642) * lu(k,3498) - lu(k,3739) = lu(k,3739) - lu(k,2628) * lu(k,3738) - lu(k,3740) = lu(k,3740) - lu(k,2629) * lu(k,3738) - lu(k,3741) = lu(k,3741) - lu(k,2630) * lu(k,3738) - lu(k,3742) = lu(k,3742) - lu(k,2631) * lu(k,3738) - lu(k,3743) = lu(k,3743) - lu(k,2632) * lu(k,3738) - lu(k,3744) = lu(k,3744) - lu(k,2633) * lu(k,3738) - lu(k,3746) = lu(k,3746) - lu(k,2634) * lu(k,3738) - lu(k,3748) = lu(k,3748) - lu(k,2635) * lu(k,3738) - lu(k,3749) = lu(k,3749) - lu(k,2636) * lu(k,3738) - lu(k,3750) = lu(k,3750) - lu(k,2637) * lu(k,3738) - lu(k,3751) = lu(k,3751) - lu(k,2638) * lu(k,3738) - lu(k,3752) = lu(k,3752) - lu(k,2639) * lu(k,3738) - lu(k,3753) = lu(k,3753) - lu(k,2640) * lu(k,3738) - lu(k,3755) = lu(k,3755) - lu(k,2641) * lu(k,3738) - lu(k,3756) = lu(k,3756) - lu(k,2642) * lu(k,3738) - lu(k,2699) = 1._r8 / lu(k,2699) - lu(k,2700) = lu(k,2700) * lu(k,2699) - lu(k,2701) = lu(k,2701) * lu(k,2699) - lu(k,2702) = lu(k,2702) * lu(k,2699) - lu(k,2703) = lu(k,2703) * lu(k,2699) - lu(k,2704) = lu(k,2704) * lu(k,2699) - lu(k,2705) = lu(k,2705) * lu(k,2699) - lu(k,2706) = lu(k,2706) * lu(k,2699) - lu(k,2707) = lu(k,2707) * lu(k,2699) - lu(k,2708) = lu(k,2708) * lu(k,2699) - lu(k,2709) = lu(k,2709) * lu(k,2699) - lu(k,2710) = lu(k,2710) * lu(k,2699) - lu(k,2711) = lu(k,2711) * lu(k,2699) - lu(k,2712) = lu(k,2712) * lu(k,2699) - lu(k,2713) = lu(k,2713) * lu(k,2699) - lu(k,2883) = lu(k,2883) - lu(k,2700) * lu(k,2882) - lu(k,2884) = lu(k,2884) - lu(k,2701) * lu(k,2882) - lu(k,2885) = lu(k,2885) - lu(k,2702) * lu(k,2882) - lu(k,2886) = lu(k,2886) - lu(k,2703) * lu(k,2882) - lu(k,2887) = lu(k,2887) - lu(k,2704) * lu(k,2882) - lu(k,2889) = lu(k,2889) - lu(k,2705) * lu(k,2882) - lu(k,2891) = lu(k,2891) - lu(k,2706) * lu(k,2882) - lu(k,2892) = lu(k,2892) - lu(k,2707) * lu(k,2882) - lu(k,2893) = lu(k,2893) - lu(k,2708) * lu(k,2882) - lu(k,2894) = lu(k,2894) - lu(k,2709) * lu(k,2882) - lu(k,2895) = lu(k,2895) - lu(k,2710) * lu(k,2882) - lu(k,2896) = lu(k,2896) - lu(k,2711) * lu(k,2882) - lu(k,2898) = lu(k,2898) - lu(k,2712) * lu(k,2882) - lu(k,2899) = lu(k,2899) - lu(k,2713) * lu(k,2882) - lu(k,2984) = lu(k,2984) - lu(k,2700) * lu(k,2983) - lu(k,2985) = lu(k,2985) - lu(k,2701) * lu(k,2983) - lu(k,2986) = lu(k,2986) - lu(k,2702) * lu(k,2983) - lu(k,2987) = lu(k,2987) - lu(k,2703) * lu(k,2983) - lu(k,2988) = lu(k,2988) - lu(k,2704) * lu(k,2983) - lu(k,2990) = lu(k,2990) - lu(k,2705) * lu(k,2983) - lu(k,2992) = lu(k,2992) - lu(k,2706) * lu(k,2983) - lu(k,2993) = lu(k,2993) - lu(k,2707) * lu(k,2983) - lu(k,2994) = lu(k,2994) - lu(k,2708) * lu(k,2983) - lu(k,2995) = lu(k,2995) - lu(k,2709) * lu(k,2983) - lu(k,2996) = lu(k,2996) - lu(k,2710) * lu(k,2983) - lu(k,2997) = lu(k,2997) - lu(k,2711) * lu(k,2983) - lu(k,2999) = lu(k,2999) - lu(k,2712) * lu(k,2983) - lu(k,3000) = lu(k,3000) - lu(k,2713) * lu(k,2983) - lu(k,3076) = lu(k,3076) - lu(k,2700) * lu(k,3075) - lu(k,3077) = lu(k,3077) - lu(k,2701) * lu(k,3075) - lu(k,3078) = lu(k,3078) - lu(k,2702) * lu(k,3075) - lu(k,3079) = lu(k,3079) - lu(k,2703) * lu(k,3075) - lu(k,3080) = lu(k,3080) - lu(k,2704) * lu(k,3075) - lu(k,3082) = lu(k,3082) - lu(k,2705) * lu(k,3075) - lu(k,3084) = lu(k,3084) - lu(k,2706) * lu(k,3075) - lu(k,3085) = lu(k,3085) - lu(k,2707) * lu(k,3075) - lu(k,3086) = lu(k,3086) - lu(k,2708) * lu(k,3075) - lu(k,3087) = lu(k,3087) - lu(k,2709) * lu(k,3075) - lu(k,3088) = lu(k,3088) - lu(k,2710) * lu(k,3075) - lu(k,3089) = lu(k,3089) - lu(k,2711) * lu(k,3075) - lu(k,3091) = lu(k,3091) - lu(k,2712) * lu(k,3075) - lu(k,3092) = lu(k,3092) - lu(k,2713) * lu(k,3075) - lu(k,3279) = lu(k,3279) - lu(k,2700) * lu(k,3278) - lu(k,3280) = lu(k,3280) - lu(k,2701) * lu(k,3278) - lu(k,3281) = lu(k,3281) - lu(k,2702) * lu(k,3278) - lu(k,3282) = lu(k,3282) - lu(k,2703) * lu(k,3278) - lu(k,3283) = lu(k,3283) - lu(k,2704) * lu(k,3278) - lu(k,3285) = lu(k,3285) - lu(k,2705) * lu(k,3278) - lu(k,3287) = lu(k,3287) - lu(k,2706) * lu(k,3278) - lu(k,3288) = lu(k,3288) - lu(k,2707) * lu(k,3278) - lu(k,3289) = lu(k,3289) - lu(k,2708) * lu(k,3278) - lu(k,3290) = lu(k,3290) - lu(k,2709) * lu(k,3278) - lu(k,3291) = lu(k,3291) - lu(k,2710) * lu(k,3278) - lu(k,3292) = lu(k,3292) - lu(k,2711) * lu(k,3278) - lu(k,3294) = lu(k,3294) - lu(k,2712) * lu(k,3278) - lu(k,3295) = lu(k,3295) - lu(k,2713) * lu(k,3278) - lu(k,3420) = lu(k,3420) - lu(k,2700) * lu(k,3419) - lu(k,3421) = lu(k,3421) - lu(k,2701) * lu(k,3419) - lu(k,3422) = lu(k,3422) - lu(k,2702) * lu(k,3419) - lu(k,3423) = lu(k,3423) - lu(k,2703) * lu(k,3419) - lu(k,3424) = lu(k,3424) - lu(k,2704) * lu(k,3419) - lu(k,3426) = lu(k,3426) - lu(k,2705) * lu(k,3419) - lu(k,3428) = lu(k,3428) - lu(k,2706) * lu(k,3419) - lu(k,3429) = lu(k,3429) - lu(k,2707) * lu(k,3419) - lu(k,3430) = lu(k,3430) - lu(k,2708) * lu(k,3419) - lu(k,3431) = lu(k,3431) - lu(k,2709) * lu(k,3419) - lu(k,3432) = lu(k,3432) - lu(k,2710) * lu(k,3419) - lu(k,3433) = lu(k,3433) - lu(k,2711) * lu(k,3419) - lu(k,3435) = lu(k,3435) - lu(k,2712) * lu(k,3419) - lu(k,3436) = lu(k,3436) - lu(k,2713) * lu(k,3419) - lu(k,3500) = lu(k,3500) - lu(k,2700) * lu(k,3499) - lu(k,3501) = lu(k,3501) - lu(k,2701) * lu(k,3499) - lu(k,3502) = lu(k,3502) - lu(k,2702) * lu(k,3499) - lu(k,3503) = lu(k,3503) - lu(k,2703) * lu(k,3499) - lu(k,3504) = lu(k,3504) - lu(k,2704) * lu(k,3499) - lu(k,3506) = lu(k,3506) - lu(k,2705) * lu(k,3499) - lu(k,3508) = lu(k,3508) - lu(k,2706) * lu(k,3499) - lu(k,3509) = lu(k,3509) - lu(k,2707) * lu(k,3499) - lu(k,3510) = lu(k,3510) - lu(k,2708) * lu(k,3499) - lu(k,3511) = lu(k,3511) - lu(k,2709) * lu(k,3499) - lu(k,3512) = lu(k,3512) - lu(k,2710) * lu(k,3499) - lu(k,3513) = lu(k,3513) - lu(k,2711) * lu(k,3499) - lu(k,3515) = lu(k,3515) - lu(k,2712) * lu(k,3499) - lu(k,3516) = lu(k,3516) - lu(k,2713) * lu(k,3499) - lu(k,3740) = lu(k,3740) - lu(k,2700) * lu(k,3739) - lu(k,3741) = lu(k,3741) - lu(k,2701) * lu(k,3739) - lu(k,3742) = lu(k,3742) - lu(k,2702) * lu(k,3739) - lu(k,3743) = lu(k,3743) - lu(k,2703) * lu(k,3739) - lu(k,3744) = lu(k,3744) - lu(k,2704) * lu(k,3739) - lu(k,3746) = lu(k,3746) - lu(k,2705) * lu(k,3739) - lu(k,3748) = lu(k,3748) - lu(k,2706) * lu(k,3739) - lu(k,3749) = lu(k,3749) - lu(k,2707) * lu(k,3739) - lu(k,3750) = lu(k,3750) - lu(k,2708) * lu(k,3739) - lu(k,3751) = lu(k,3751) - lu(k,2709) * lu(k,3739) - lu(k,3752) = lu(k,3752) - lu(k,2710) * lu(k,3739) - lu(k,3753) = lu(k,3753) - lu(k,2711) * lu(k,3739) - lu(k,3755) = lu(k,3755) - lu(k,2712) * lu(k,3739) - lu(k,3756) = lu(k,3756) - lu(k,2713) * lu(k,3739) - lu(k,3821) = lu(k,3821) - lu(k,2700) * lu(k,3820) - lu(k,3822) = lu(k,3822) - lu(k,2701) * lu(k,3820) - lu(k,3823) = lu(k,3823) - lu(k,2702) * lu(k,3820) - lu(k,3824) = lu(k,3824) - lu(k,2703) * lu(k,3820) - lu(k,3825) = lu(k,3825) - lu(k,2704) * lu(k,3820) - lu(k,3827) = lu(k,3827) - lu(k,2705) * lu(k,3820) - lu(k,3829) = lu(k,3829) - lu(k,2706) * lu(k,3820) - lu(k,3830) = lu(k,3830) - lu(k,2707) * lu(k,3820) - lu(k,3831) = lu(k,3831) - lu(k,2708) * lu(k,3820) - lu(k,3832) = lu(k,3832) - lu(k,2709) * lu(k,3820) - lu(k,3833) = lu(k,3833) - lu(k,2710) * lu(k,3820) - lu(k,3834) = lu(k,3834) - lu(k,2711) * lu(k,3820) - lu(k,3836) = lu(k,3836) - lu(k,2712) * lu(k,3820) - lu(k,3837) = lu(k,3837) - lu(k,2713) * lu(k,3820) - lu(k,2717) = 1._r8 / lu(k,2717) - lu(k,2718) = lu(k,2718) * lu(k,2717) - lu(k,2719) = lu(k,2719) * lu(k,2717) - lu(k,2720) = lu(k,2720) * lu(k,2717) - lu(k,2721) = lu(k,2721) * lu(k,2717) - lu(k,2722) = lu(k,2722) * lu(k,2717) - lu(k,2723) = lu(k,2723) * lu(k,2717) - lu(k,2724) = lu(k,2724) * lu(k,2717) - lu(k,2725) = lu(k,2725) * lu(k,2717) - lu(k,2726) = lu(k,2726) * lu(k,2717) - lu(k,2727) = lu(k,2727) * lu(k,2717) - lu(k,2730) = lu(k,2730) - lu(k,2718) * lu(k,2729) - lu(k,2732) = lu(k,2732) - lu(k,2719) * lu(k,2729) - lu(k,2733) = lu(k,2733) - lu(k,2720) * lu(k,2729) - lu(k,2735) = lu(k,2735) - lu(k,2721) * lu(k,2729) - lu(k,2736) = lu(k,2736) - lu(k,2722) * lu(k,2729) - lu(k,2737) = - lu(k,2723) * lu(k,2729) - lu(k,2738) = lu(k,2738) - lu(k,2724) * lu(k,2729) - lu(k,2739) = lu(k,2739) - lu(k,2725) * lu(k,2729) - lu(k,2740) = lu(k,2740) - lu(k,2726) * lu(k,2729) - lu(k,2741) = lu(k,2741) - lu(k,2727) * lu(k,2729) - lu(k,2884) = lu(k,2884) - lu(k,2718) * lu(k,2883) - lu(k,2887) = lu(k,2887) - lu(k,2719) * lu(k,2883) - lu(k,2888) = lu(k,2888) - lu(k,2720) * lu(k,2883) - lu(k,2892) = lu(k,2892) - lu(k,2721) * lu(k,2883) - lu(k,2893) = lu(k,2893) - lu(k,2722) * lu(k,2883) - lu(k,2894) = lu(k,2894) - lu(k,2723) * lu(k,2883) - lu(k,2895) = lu(k,2895) - lu(k,2724) * lu(k,2883) - lu(k,2896) = lu(k,2896) - lu(k,2725) * lu(k,2883) - lu(k,2898) = lu(k,2898) - lu(k,2726) * lu(k,2883) - lu(k,2899) = lu(k,2899) - lu(k,2727) * lu(k,2883) - lu(k,2985) = lu(k,2985) - lu(k,2718) * lu(k,2984) - lu(k,2988) = lu(k,2988) - lu(k,2719) * lu(k,2984) - lu(k,2989) = lu(k,2989) - lu(k,2720) * lu(k,2984) - lu(k,2993) = lu(k,2993) - lu(k,2721) * lu(k,2984) - lu(k,2994) = lu(k,2994) - lu(k,2722) * lu(k,2984) - lu(k,2995) = lu(k,2995) - lu(k,2723) * lu(k,2984) - lu(k,2996) = lu(k,2996) - lu(k,2724) * lu(k,2984) - lu(k,2997) = lu(k,2997) - lu(k,2725) * lu(k,2984) - lu(k,2999) = lu(k,2999) - lu(k,2726) * lu(k,2984) - lu(k,3000) = lu(k,3000) - lu(k,2727) * lu(k,2984) - lu(k,3077) = lu(k,3077) - lu(k,2718) * lu(k,3076) - lu(k,3080) = lu(k,3080) - lu(k,2719) * lu(k,3076) - lu(k,3081) = lu(k,3081) - lu(k,2720) * lu(k,3076) - lu(k,3085) = lu(k,3085) - lu(k,2721) * lu(k,3076) - lu(k,3086) = lu(k,3086) - lu(k,2722) * lu(k,3076) - lu(k,3087) = lu(k,3087) - lu(k,2723) * lu(k,3076) - lu(k,3088) = lu(k,3088) - lu(k,2724) * lu(k,3076) - lu(k,3089) = lu(k,3089) - lu(k,2725) * lu(k,3076) - lu(k,3091) = lu(k,3091) - lu(k,2726) * lu(k,3076) - lu(k,3092) = lu(k,3092) - lu(k,2727) * lu(k,3076) - lu(k,3101) = lu(k,3101) - lu(k,2718) * lu(k,3100) - lu(k,3104) = lu(k,3104) - lu(k,2719) * lu(k,3100) - lu(k,3105) = lu(k,3105) - lu(k,2720) * lu(k,3100) - lu(k,3109) = lu(k,3109) - lu(k,2721) * lu(k,3100) - lu(k,3110) = lu(k,3110) - lu(k,2722) * lu(k,3100) - lu(k,3111) = - lu(k,2723) * lu(k,3100) - lu(k,3112) = lu(k,3112) - lu(k,2724) * lu(k,3100) - lu(k,3113) = lu(k,3113) - lu(k,2725) * lu(k,3100) - lu(k,3115) = lu(k,3115) - lu(k,2726) * lu(k,3100) - lu(k,3116) = lu(k,3116) - lu(k,2727) * lu(k,3100) - lu(k,3280) = lu(k,3280) - lu(k,2718) * lu(k,3279) - lu(k,3283) = lu(k,3283) - lu(k,2719) * lu(k,3279) - lu(k,3284) = lu(k,3284) - lu(k,2720) * lu(k,3279) - lu(k,3288) = lu(k,3288) - lu(k,2721) * lu(k,3279) - lu(k,3289) = lu(k,3289) - lu(k,2722) * lu(k,3279) - lu(k,3290) = lu(k,3290) - lu(k,2723) * lu(k,3279) - lu(k,3291) = lu(k,3291) - lu(k,2724) * lu(k,3279) - lu(k,3292) = lu(k,3292) - lu(k,2725) * lu(k,3279) - lu(k,3294) = lu(k,3294) - lu(k,2726) * lu(k,3279) - lu(k,3295) = lu(k,3295) - lu(k,2727) * lu(k,3279) - lu(k,3306) = lu(k,3306) - lu(k,2718) * lu(k,3305) - lu(k,3309) = lu(k,3309) - lu(k,2719) * lu(k,3305) - lu(k,3310) = lu(k,3310) - lu(k,2720) * lu(k,3305) - lu(k,3314) = lu(k,3314) - lu(k,2721) * lu(k,3305) - lu(k,3315) = lu(k,3315) - lu(k,2722) * lu(k,3305) - lu(k,3316) = lu(k,3316) - lu(k,2723) * lu(k,3305) - lu(k,3317) = lu(k,3317) - lu(k,2724) * lu(k,3305) - lu(k,3318) = lu(k,3318) - lu(k,2725) * lu(k,3305) - lu(k,3320) = lu(k,3320) - lu(k,2726) * lu(k,3305) - lu(k,3321) = lu(k,3321) - lu(k,2727) * lu(k,3305) - lu(k,3330) = lu(k,3330) - lu(k,2718) * lu(k,3329) - lu(k,3333) = lu(k,3333) - lu(k,2719) * lu(k,3329) - lu(k,3334) = lu(k,3334) - lu(k,2720) * lu(k,3329) - lu(k,3338) = lu(k,3338) - lu(k,2721) * lu(k,3329) - lu(k,3339) = lu(k,3339) - lu(k,2722) * lu(k,3329) - lu(k,3340) = lu(k,3340) - lu(k,2723) * lu(k,3329) - lu(k,3341) = lu(k,3341) - lu(k,2724) * lu(k,3329) - lu(k,3342) = lu(k,3342) - lu(k,2725) * lu(k,3329) - lu(k,3344) = lu(k,3344) - lu(k,2726) * lu(k,3329) - lu(k,3345) = lu(k,3345) - lu(k,2727) * lu(k,3329) - lu(k,3421) = lu(k,3421) - lu(k,2718) * lu(k,3420) - lu(k,3424) = lu(k,3424) - lu(k,2719) * lu(k,3420) - lu(k,3425) = - lu(k,2720) * lu(k,3420) - lu(k,3429) = lu(k,3429) - lu(k,2721) * lu(k,3420) - lu(k,3430) = lu(k,3430) - lu(k,2722) * lu(k,3420) - lu(k,3431) = lu(k,3431) - lu(k,2723) * lu(k,3420) - lu(k,3432) = lu(k,3432) - lu(k,2724) * lu(k,3420) - lu(k,3433) = lu(k,3433) - lu(k,2725) * lu(k,3420) - lu(k,3435) = lu(k,3435) - lu(k,2726) * lu(k,3420) - lu(k,3436) = lu(k,3436) - lu(k,2727) * lu(k,3420) - lu(k,3451) = lu(k,3451) - lu(k,2718) * lu(k,3450) - lu(k,3454) = lu(k,3454) - lu(k,2719) * lu(k,3450) - lu(k,3455) = lu(k,3455) - lu(k,2720) * lu(k,3450) - lu(k,3459) = lu(k,3459) - lu(k,2721) * lu(k,3450) - lu(k,3460) = lu(k,3460) - lu(k,2722) * lu(k,3450) - lu(k,3461) = lu(k,3461) - lu(k,2723) * lu(k,3450) - lu(k,3462) = lu(k,3462) - lu(k,2724) * lu(k,3450) - lu(k,3463) = lu(k,3463) - lu(k,2725) * lu(k,3450) - lu(k,3465) = lu(k,3465) - lu(k,2726) * lu(k,3450) - lu(k,3466) = lu(k,3466) - lu(k,2727) * lu(k,3450) - lu(k,3501) = lu(k,3501) - lu(k,2718) * lu(k,3500) - lu(k,3504) = lu(k,3504) - lu(k,2719) * lu(k,3500) - lu(k,3505) = lu(k,3505) - lu(k,2720) * lu(k,3500) - lu(k,3509) = lu(k,3509) - lu(k,2721) * lu(k,3500) - lu(k,3510) = lu(k,3510) - lu(k,2722) * lu(k,3500) - lu(k,3511) = lu(k,3511) - lu(k,2723) * lu(k,3500) - lu(k,3512) = lu(k,3512) - lu(k,2724) * lu(k,3500) - lu(k,3513) = lu(k,3513) - lu(k,2725) * lu(k,3500) - lu(k,3515) = lu(k,3515) - lu(k,2726) * lu(k,3500) - lu(k,3516) = lu(k,3516) - lu(k,2727) * lu(k,3500) - lu(k,3741) = lu(k,3741) - lu(k,2718) * lu(k,3740) - lu(k,3744) = lu(k,3744) - lu(k,2719) * lu(k,3740) - lu(k,3745) = lu(k,3745) - lu(k,2720) * lu(k,3740) - lu(k,3749) = lu(k,3749) - lu(k,2721) * lu(k,3740) - lu(k,3750) = lu(k,3750) - lu(k,2722) * lu(k,3740) - lu(k,3751) = lu(k,3751) - lu(k,2723) * lu(k,3740) - lu(k,3752) = lu(k,3752) - lu(k,2724) * lu(k,3740) - lu(k,3753) = lu(k,3753) - lu(k,2725) * lu(k,3740) - lu(k,3755) = lu(k,3755) - lu(k,2726) * lu(k,3740) - lu(k,3756) = lu(k,3756) - lu(k,2727) * lu(k,3740) - lu(k,3764) = lu(k,3764) - lu(k,2718) * lu(k,3763) - lu(k,3766) = lu(k,3766) - lu(k,2719) * lu(k,3763) - lu(k,3767) = lu(k,3767) - lu(k,2720) * lu(k,3763) - lu(k,3771) = - lu(k,2721) * lu(k,3763) - lu(k,3772) = lu(k,3772) - lu(k,2722) * lu(k,3763) - lu(k,3773) = lu(k,3773) - lu(k,2723) * lu(k,3763) - lu(k,3774) = lu(k,3774) - lu(k,2724) * lu(k,3763) - lu(k,3775) = lu(k,3775) - lu(k,2725) * lu(k,3763) - lu(k,3777) = lu(k,3777) - lu(k,2726) * lu(k,3763) - lu(k,3778) = lu(k,3778) - lu(k,2727) * lu(k,3763) - lu(k,3787) = lu(k,3787) - lu(k,2718) * lu(k,3786) - lu(k,3790) = lu(k,3790) - lu(k,2719) * lu(k,3786) - lu(k,3791) = lu(k,3791) - lu(k,2720) * lu(k,3786) - lu(k,3795) = - lu(k,2721) * lu(k,3786) - lu(k,3796) = lu(k,3796) - lu(k,2722) * lu(k,3786) - lu(k,3797) = lu(k,3797) - lu(k,2723) * lu(k,3786) - lu(k,3798) = lu(k,3798) - lu(k,2724) * lu(k,3786) - lu(k,3799) = lu(k,3799) - lu(k,2725) * lu(k,3786) - lu(k,3801) = lu(k,3801) - lu(k,2726) * lu(k,3786) - lu(k,3802) = lu(k,3802) - lu(k,2727) * lu(k,3786) - lu(k,3822) = lu(k,3822) - lu(k,2718) * lu(k,3821) - lu(k,3825) = lu(k,3825) - lu(k,2719) * lu(k,3821) - lu(k,3826) = lu(k,3826) - lu(k,2720) * lu(k,3821) - lu(k,3830) = lu(k,3830) - lu(k,2721) * lu(k,3821) - lu(k,3831) = lu(k,3831) - lu(k,2722) * lu(k,3821) - lu(k,3832) = lu(k,3832) - lu(k,2723) * lu(k,3821) - lu(k,3833) = lu(k,3833) - lu(k,2724) * lu(k,3821) - lu(k,3834) = lu(k,3834) - lu(k,2725) * lu(k,3821) - lu(k,3836) = lu(k,3836) - lu(k,2726) * lu(k,3821) - lu(k,3837) = lu(k,3837) - lu(k,2727) * lu(k,3821) - lu(k,3847) = lu(k,3847) - lu(k,2718) * lu(k,3846) - lu(k,3850) = lu(k,3850) - lu(k,2719) * lu(k,3846) - lu(k,3851) = lu(k,3851) - lu(k,2720) * lu(k,3846) - lu(k,3855) = lu(k,3855) - lu(k,2721) * lu(k,3846) - lu(k,3856) = lu(k,3856) - lu(k,2722) * lu(k,3846) - lu(k,3857) = lu(k,3857) - lu(k,2723) * lu(k,3846) - lu(k,3858) = lu(k,3858) - lu(k,2724) * lu(k,3846) - lu(k,3859) = lu(k,3859) - lu(k,2725) * lu(k,3846) - lu(k,3861) = lu(k,3861) - lu(k,2726) * lu(k,3846) - lu(k,3862) = lu(k,3862) - lu(k,2727) * lu(k,3846) - lu(k,2730) = 1._r8 / lu(k,2730) - lu(k,2731) = lu(k,2731) * lu(k,2730) - lu(k,2732) = lu(k,2732) * lu(k,2730) - lu(k,2733) = lu(k,2733) * lu(k,2730) - lu(k,2734) = lu(k,2734) * lu(k,2730) - lu(k,2735) = lu(k,2735) * lu(k,2730) - lu(k,2736) = lu(k,2736) * lu(k,2730) - lu(k,2737) = lu(k,2737) * lu(k,2730) - lu(k,2738) = lu(k,2738) * lu(k,2730) - lu(k,2739) = lu(k,2739) * lu(k,2730) - lu(k,2740) = lu(k,2740) * lu(k,2730) - lu(k,2741) = lu(k,2741) * lu(k,2730) - lu(k,2886) = lu(k,2886) - lu(k,2731) * lu(k,2884) - lu(k,2887) = lu(k,2887) - lu(k,2732) * lu(k,2884) - lu(k,2888) = lu(k,2888) - lu(k,2733) * lu(k,2884) - lu(k,2889) = lu(k,2889) - lu(k,2734) * lu(k,2884) - lu(k,2892) = lu(k,2892) - lu(k,2735) * lu(k,2884) - lu(k,2893) = lu(k,2893) - lu(k,2736) * lu(k,2884) - lu(k,2894) = lu(k,2894) - lu(k,2737) * lu(k,2884) - lu(k,2895) = lu(k,2895) - lu(k,2738) * lu(k,2884) - lu(k,2896) = lu(k,2896) - lu(k,2739) * lu(k,2884) - lu(k,2898) = lu(k,2898) - lu(k,2740) * lu(k,2884) - lu(k,2899) = lu(k,2899) - lu(k,2741) * lu(k,2884) - lu(k,2987) = lu(k,2987) - lu(k,2731) * lu(k,2985) - lu(k,2988) = lu(k,2988) - lu(k,2732) * lu(k,2985) - lu(k,2989) = lu(k,2989) - lu(k,2733) * lu(k,2985) - lu(k,2990) = lu(k,2990) - lu(k,2734) * lu(k,2985) - lu(k,2993) = lu(k,2993) - lu(k,2735) * lu(k,2985) - lu(k,2994) = lu(k,2994) - lu(k,2736) * lu(k,2985) - lu(k,2995) = lu(k,2995) - lu(k,2737) * lu(k,2985) - lu(k,2996) = lu(k,2996) - lu(k,2738) * lu(k,2985) - lu(k,2997) = lu(k,2997) - lu(k,2739) * lu(k,2985) - lu(k,2999) = lu(k,2999) - lu(k,2740) * lu(k,2985) - lu(k,3000) = lu(k,3000) - lu(k,2741) * lu(k,2985) - lu(k,3079) = lu(k,3079) - lu(k,2731) * lu(k,3077) - lu(k,3080) = lu(k,3080) - lu(k,2732) * lu(k,3077) - lu(k,3081) = lu(k,3081) - lu(k,2733) * lu(k,3077) - lu(k,3082) = lu(k,3082) - lu(k,2734) * lu(k,3077) - lu(k,3085) = lu(k,3085) - lu(k,2735) * lu(k,3077) - lu(k,3086) = lu(k,3086) - lu(k,2736) * lu(k,3077) - lu(k,3087) = lu(k,3087) - lu(k,2737) * lu(k,3077) - lu(k,3088) = lu(k,3088) - lu(k,2738) * lu(k,3077) - lu(k,3089) = lu(k,3089) - lu(k,2739) * lu(k,3077) - lu(k,3091) = lu(k,3091) - lu(k,2740) * lu(k,3077) - lu(k,3092) = lu(k,3092) - lu(k,2741) * lu(k,3077) - lu(k,3103) = lu(k,3103) - lu(k,2731) * lu(k,3101) - lu(k,3104) = lu(k,3104) - lu(k,2732) * lu(k,3101) - lu(k,3105) = lu(k,3105) - lu(k,2733) * lu(k,3101) - lu(k,3106) = lu(k,3106) - lu(k,2734) * lu(k,3101) - lu(k,3109) = lu(k,3109) - lu(k,2735) * lu(k,3101) - lu(k,3110) = lu(k,3110) - lu(k,2736) * lu(k,3101) - lu(k,3111) = lu(k,3111) - lu(k,2737) * lu(k,3101) - lu(k,3112) = lu(k,3112) - lu(k,2738) * lu(k,3101) - lu(k,3113) = lu(k,3113) - lu(k,2739) * lu(k,3101) - lu(k,3115) = lu(k,3115) - lu(k,2740) * lu(k,3101) - lu(k,3116) = lu(k,3116) - lu(k,2741) * lu(k,3101) - lu(k,3282) = lu(k,3282) - lu(k,2731) * lu(k,3280) - lu(k,3283) = lu(k,3283) - lu(k,2732) * lu(k,3280) - lu(k,3284) = lu(k,3284) - lu(k,2733) * lu(k,3280) - lu(k,3285) = lu(k,3285) - lu(k,2734) * lu(k,3280) - lu(k,3288) = lu(k,3288) - lu(k,2735) * lu(k,3280) - lu(k,3289) = lu(k,3289) - lu(k,2736) * lu(k,3280) - lu(k,3290) = lu(k,3290) - lu(k,2737) * lu(k,3280) - lu(k,3291) = lu(k,3291) - lu(k,2738) * lu(k,3280) - lu(k,3292) = lu(k,3292) - lu(k,2739) * lu(k,3280) - lu(k,3294) = lu(k,3294) - lu(k,2740) * lu(k,3280) - lu(k,3295) = lu(k,3295) - lu(k,2741) * lu(k,3280) - lu(k,3308) = lu(k,3308) - lu(k,2731) * lu(k,3306) - lu(k,3309) = lu(k,3309) - lu(k,2732) * lu(k,3306) - lu(k,3310) = lu(k,3310) - lu(k,2733) * lu(k,3306) - lu(k,3311) = lu(k,3311) - lu(k,2734) * lu(k,3306) - lu(k,3314) = lu(k,3314) - lu(k,2735) * lu(k,3306) - lu(k,3315) = lu(k,3315) - lu(k,2736) * lu(k,3306) - lu(k,3316) = lu(k,3316) - lu(k,2737) * lu(k,3306) - lu(k,3317) = lu(k,3317) - lu(k,2738) * lu(k,3306) - lu(k,3318) = lu(k,3318) - lu(k,2739) * lu(k,3306) - lu(k,3320) = lu(k,3320) - lu(k,2740) * lu(k,3306) - lu(k,3321) = lu(k,3321) - lu(k,2741) * lu(k,3306) - lu(k,3332) = lu(k,3332) - lu(k,2731) * lu(k,3330) - lu(k,3333) = lu(k,3333) - lu(k,2732) * lu(k,3330) - lu(k,3334) = lu(k,3334) - lu(k,2733) * lu(k,3330) - lu(k,3335) = lu(k,3335) - lu(k,2734) * lu(k,3330) - lu(k,3338) = lu(k,3338) - lu(k,2735) * lu(k,3330) - lu(k,3339) = lu(k,3339) - lu(k,2736) * lu(k,3330) - lu(k,3340) = lu(k,3340) - lu(k,2737) * lu(k,3330) - lu(k,3341) = lu(k,3341) - lu(k,2738) * lu(k,3330) - lu(k,3342) = lu(k,3342) - lu(k,2739) * lu(k,3330) - lu(k,3344) = lu(k,3344) - lu(k,2740) * lu(k,3330) - lu(k,3345) = lu(k,3345) - lu(k,2741) * lu(k,3330) - lu(k,3423) = lu(k,3423) - lu(k,2731) * lu(k,3421) - lu(k,3424) = lu(k,3424) - lu(k,2732) * lu(k,3421) - lu(k,3425) = lu(k,3425) - lu(k,2733) * lu(k,3421) - lu(k,3426) = lu(k,3426) - lu(k,2734) * lu(k,3421) - lu(k,3429) = lu(k,3429) - lu(k,2735) * lu(k,3421) - lu(k,3430) = lu(k,3430) - lu(k,2736) * lu(k,3421) - lu(k,3431) = lu(k,3431) - lu(k,2737) * lu(k,3421) - lu(k,3432) = lu(k,3432) - lu(k,2738) * lu(k,3421) - lu(k,3433) = lu(k,3433) - lu(k,2739) * lu(k,3421) - lu(k,3435) = lu(k,3435) - lu(k,2740) * lu(k,3421) - lu(k,3436) = lu(k,3436) - lu(k,2741) * lu(k,3421) - lu(k,3453) = lu(k,3453) - lu(k,2731) * lu(k,3451) - lu(k,3454) = lu(k,3454) - lu(k,2732) * lu(k,3451) - lu(k,3455) = lu(k,3455) - lu(k,2733) * lu(k,3451) - lu(k,3456) = lu(k,3456) - lu(k,2734) * lu(k,3451) - lu(k,3459) = lu(k,3459) - lu(k,2735) * lu(k,3451) - lu(k,3460) = lu(k,3460) - lu(k,2736) * lu(k,3451) - lu(k,3461) = lu(k,3461) - lu(k,2737) * lu(k,3451) - lu(k,3462) = lu(k,3462) - lu(k,2738) * lu(k,3451) - lu(k,3463) = lu(k,3463) - lu(k,2739) * lu(k,3451) - lu(k,3465) = lu(k,3465) - lu(k,2740) * lu(k,3451) - lu(k,3466) = lu(k,3466) - lu(k,2741) * lu(k,3451) - lu(k,3503) = lu(k,3503) - lu(k,2731) * lu(k,3501) - lu(k,3504) = lu(k,3504) - lu(k,2732) * lu(k,3501) - lu(k,3505) = lu(k,3505) - lu(k,2733) * lu(k,3501) - lu(k,3506) = lu(k,3506) - lu(k,2734) * lu(k,3501) - lu(k,3509) = lu(k,3509) - lu(k,2735) * lu(k,3501) - lu(k,3510) = lu(k,3510) - lu(k,2736) * lu(k,3501) - lu(k,3511) = lu(k,3511) - lu(k,2737) * lu(k,3501) - lu(k,3512) = lu(k,3512) - lu(k,2738) * lu(k,3501) - lu(k,3513) = lu(k,3513) - lu(k,2739) * lu(k,3501) - lu(k,3515) = lu(k,3515) - lu(k,2740) * lu(k,3501) - lu(k,3516) = lu(k,3516) - lu(k,2741) * lu(k,3501) - lu(k,3743) = lu(k,3743) - lu(k,2731) * lu(k,3741) - lu(k,3744) = lu(k,3744) - lu(k,2732) * lu(k,3741) - lu(k,3745) = lu(k,3745) - lu(k,2733) * lu(k,3741) - lu(k,3746) = lu(k,3746) - lu(k,2734) * lu(k,3741) - lu(k,3749) = lu(k,3749) - lu(k,2735) * lu(k,3741) - lu(k,3750) = lu(k,3750) - lu(k,2736) * lu(k,3741) - lu(k,3751) = lu(k,3751) - lu(k,2737) * lu(k,3741) - lu(k,3752) = lu(k,3752) - lu(k,2738) * lu(k,3741) - lu(k,3753) = lu(k,3753) - lu(k,2739) * lu(k,3741) - lu(k,3755) = lu(k,3755) - lu(k,2740) * lu(k,3741) - lu(k,3756) = lu(k,3756) - lu(k,2741) * lu(k,3741) - lu(k,3765) = lu(k,3765) - lu(k,2731) * lu(k,3764) - lu(k,3766) = lu(k,3766) - lu(k,2732) * lu(k,3764) - lu(k,3767) = lu(k,3767) - lu(k,2733) * lu(k,3764) - lu(k,3768) = lu(k,3768) - lu(k,2734) * lu(k,3764) - lu(k,3771) = lu(k,3771) - lu(k,2735) * lu(k,3764) - lu(k,3772) = lu(k,3772) - lu(k,2736) * lu(k,3764) - lu(k,3773) = lu(k,3773) - lu(k,2737) * lu(k,3764) - lu(k,3774) = lu(k,3774) - lu(k,2738) * lu(k,3764) - lu(k,3775) = lu(k,3775) - lu(k,2739) * lu(k,3764) - lu(k,3777) = lu(k,3777) - lu(k,2740) * lu(k,3764) - lu(k,3778) = lu(k,3778) - lu(k,2741) * lu(k,3764) - lu(k,3789) = lu(k,3789) - lu(k,2731) * lu(k,3787) - lu(k,3790) = lu(k,3790) - lu(k,2732) * lu(k,3787) - lu(k,3791) = lu(k,3791) - lu(k,2733) * lu(k,3787) - lu(k,3792) = lu(k,3792) - lu(k,2734) * lu(k,3787) - lu(k,3795) = lu(k,3795) - lu(k,2735) * lu(k,3787) - lu(k,3796) = lu(k,3796) - lu(k,2736) * lu(k,3787) - lu(k,3797) = lu(k,3797) - lu(k,2737) * lu(k,3787) - lu(k,3798) = lu(k,3798) - lu(k,2738) * lu(k,3787) - lu(k,3799) = lu(k,3799) - lu(k,2739) * lu(k,3787) - lu(k,3801) = lu(k,3801) - lu(k,2740) * lu(k,3787) - lu(k,3802) = lu(k,3802) - lu(k,2741) * lu(k,3787) - lu(k,3824) = lu(k,3824) - lu(k,2731) * lu(k,3822) - lu(k,3825) = lu(k,3825) - lu(k,2732) * lu(k,3822) - lu(k,3826) = lu(k,3826) - lu(k,2733) * lu(k,3822) - lu(k,3827) = lu(k,3827) - lu(k,2734) * lu(k,3822) - lu(k,3830) = lu(k,3830) - lu(k,2735) * lu(k,3822) - lu(k,3831) = lu(k,3831) - lu(k,2736) * lu(k,3822) - lu(k,3832) = lu(k,3832) - lu(k,2737) * lu(k,3822) - lu(k,3833) = lu(k,3833) - lu(k,2738) * lu(k,3822) - lu(k,3834) = lu(k,3834) - lu(k,2739) * lu(k,3822) - lu(k,3836) = lu(k,3836) - lu(k,2740) * lu(k,3822) - lu(k,3837) = lu(k,3837) - lu(k,2741) * lu(k,3822) - lu(k,3849) = lu(k,3849) - lu(k,2731) * lu(k,3847) - lu(k,3850) = lu(k,3850) - lu(k,2732) * lu(k,3847) - lu(k,3851) = lu(k,3851) - lu(k,2733) * lu(k,3847) - lu(k,3852) = lu(k,3852) - lu(k,2734) * lu(k,3847) - lu(k,3855) = lu(k,3855) - lu(k,2735) * lu(k,3847) - lu(k,3856) = lu(k,3856) - lu(k,2736) * lu(k,3847) - lu(k,3857) = lu(k,3857) - lu(k,2737) * lu(k,3847) - lu(k,3858) = lu(k,3858) - lu(k,2738) * lu(k,3847) - lu(k,3859) = lu(k,3859) - lu(k,2739) * lu(k,3847) - lu(k,3861) = lu(k,3861) - lu(k,2740) * lu(k,3847) - lu(k,3862) = lu(k,3862) - lu(k,2741) * lu(k,3847) + lu(k,2499) = 1._r8 / lu(k,2499) + lu(k,2500) = lu(k,2500) * lu(k,2499) + lu(k,2501) = lu(k,2501) * lu(k,2499) + lu(k,2502) = lu(k,2502) * lu(k,2499) + lu(k,2503) = lu(k,2503) * lu(k,2499) + lu(k,2504) = lu(k,2504) * lu(k,2499) + lu(k,2505) = lu(k,2505) * lu(k,2499) + lu(k,2506) = lu(k,2506) * lu(k,2499) + lu(k,2507) = lu(k,2507) * lu(k,2499) + lu(k,2508) = lu(k,2508) * lu(k,2499) + lu(k,2509) = lu(k,2509) * lu(k,2499) + lu(k,2510) = lu(k,2510) * lu(k,2499) + lu(k,2511) = lu(k,2511) * lu(k,2499) + lu(k,2512) = lu(k,2512) * lu(k,2499) + lu(k,2513) = lu(k,2513) * lu(k,2499) + lu(k,2514) = lu(k,2514) * lu(k,2499) + lu(k,2515) = lu(k,2515) * lu(k,2499) + lu(k,2516) = lu(k,2516) * lu(k,2499) + lu(k,2517) = lu(k,2517) * lu(k,2499) + lu(k,2518) = lu(k,2518) * lu(k,2499) + lu(k,2846) = lu(k,2846) - lu(k,2500) * lu(k,2845) + lu(k,2847) = lu(k,2847) - lu(k,2501) * lu(k,2845) + lu(k,2849) = lu(k,2849) - lu(k,2502) * lu(k,2845) + lu(k,2850) = lu(k,2850) - lu(k,2503) * lu(k,2845) + lu(k,2851) = lu(k,2851) - lu(k,2504) * lu(k,2845) + lu(k,2853) = lu(k,2853) - lu(k,2505) * lu(k,2845) + lu(k,2854) = lu(k,2854) - lu(k,2506) * lu(k,2845) + lu(k,2855) = lu(k,2855) - lu(k,2507) * lu(k,2845) + lu(k,2856) = lu(k,2856) - lu(k,2508) * lu(k,2845) + lu(k,2859) = lu(k,2859) - lu(k,2509) * lu(k,2845) + lu(k,2860) = lu(k,2860) - lu(k,2510) * lu(k,2845) + lu(k,2861) = lu(k,2861) - lu(k,2511) * lu(k,2845) + lu(k,2862) = lu(k,2862) - lu(k,2512) * lu(k,2845) + lu(k,2863) = lu(k,2863) - lu(k,2513) * lu(k,2845) + lu(k,2864) = lu(k,2864) - lu(k,2514) * lu(k,2845) + lu(k,2866) = lu(k,2866) - lu(k,2515) * lu(k,2845) + lu(k,2867) = lu(k,2867) - lu(k,2516) * lu(k,2845) + lu(k,2868) = lu(k,2868) - lu(k,2517) * lu(k,2845) + lu(k,2869) = lu(k,2869) - lu(k,2518) * lu(k,2845) + lu(k,2893) = lu(k,2893) - lu(k,2500) * lu(k,2892) + lu(k,2894) = lu(k,2894) - lu(k,2501) * lu(k,2892) + lu(k,2896) = lu(k,2896) - lu(k,2502) * lu(k,2892) + lu(k,2897) = lu(k,2897) - lu(k,2503) * lu(k,2892) + lu(k,2898) = lu(k,2898) - lu(k,2504) * lu(k,2892) + lu(k,2900) = lu(k,2900) - lu(k,2505) * lu(k,2892) + lu(k,2901) = lu(k,2901) - lu(k,2506) * lu(k,2892) + lu(k,2902) = lu(k,2902) - lu(k,2507) * lu(k,2892) + lu(k,2903) = lu(k,2903) - lu(k,2508) * lu(k,2892) + lu(k,2906) = lu(k,2906) - lu(k,2509) * lu(k,2892) + lu(k,2907) = lu(k,2907) - lu(k,2510) * lu(k,2892) + lu(k,2908) = lu(k,2908) - lu(k,2511) * lu(k,2892) + lu(k,2909) = lu(k,2909) - lu(k,2512) * lu(k,2892) + lu(k,2910) = lu(k,2910) - lu(k,2513) * lu(k,2892) + lu(k,2911) = lu(k,2911) - lu(k,2514) * lu(k,2892) + lu(k,2913) = lu(k,2913) - lu(k,2515) * lu(k,2892) + lu(k,2914) = lu(k,2914) - lu(k,2516) * lu(k,2892) + lu(k,2915) = lu(k,2915) - lu(k,2517) * lu(k,2892) + lu(k,2916) = lu(k,2916) - lu(k,2518) * lu(k,2892) + lu(k,2939) = lu(k,2939) - lu(k,2500) * lu(k,2938) + lu(k,2940) = lu(k,2940) - lu(k,2501) * lu(k,2938) + lu(k,2942) = lu(k,2942) - lu(k,2502) * lu(k,2938) + lu(k,2943) = lu(k,2943) - lu(k,2503) * lu(k,2938) + lu(k,2944) = lu(k,2944) - lu(k,2504) * lu(k,2938) + lu(k,2946) = lu(k,2946) - lu(k,2505) * lu(k,2938) + lu(k,2947) = lu(k,2947) - lu(k,2506) * lu(k,2938) + lu(k,2948) = lu(k,2948) - lu(k,2507) * lu(k,2938) + lu(k,2949) = lu(k,2949) - lu(k,2508) * lu(k,2938) + lu(k,2952) = lu(k,2952) - lu(k,2509) * lu(k,2938) + lu(k,2953) = lu(k,2953) - lu(k,2510) * lu(k,2938) + lu(k,2954) = lu(k,2954) - lu(k,2511) * lu(k,2938) + lu(k,2955) = lu(k,2955) - lu(k,2512) * lu(k,2938) + lu(k,2956) = lu(k,2956) - lu(k,2513) * lu(k,2938) + lu(k,2957) = lu(k,2957) - lu(k,2514) * lu(k,2938) + lu(k,2959) = lu(k,2959) - lu(k,2515) * lu(k,2938) + lu(k,2960) = lu(k,2960) - lu(k,2516) * lu(k,2938) + lu(k,2961) = lu(k,2961) - lu(k,2517) * lu(k,2938) + lu(k,2962) = lu(k,2962) - lu(k,2518) * lu(k,2938) + lu(k,3011) = lu(k,3011) - lu(k,2500) * lu(k,3010) + lu(k,3014) = lu(k,3014) - lu(k,2501) * lu(k,3010) + lu(k,3016) = lu(k,3016) - lu(k,2502) * lu(k,3010) + lu(k,3017) = lu(k,3017) - lu(k,2503) * lu(k,3010) + lu(k,3018) = lu(k,3018) - lu(k,2504) * lu(k,3010) + lu(k,3020) = lu(k,3020) - lu(k,2505) * lu(k,3010) + lu(k,3021) = lu(k,3021) - lu(k,2506) * lu(k,3010) + lu(k,3022) = lu(k,3022) - lu(k,2507) * lu(k,3010) + lu(k,3023) = lu(k,3023) - lu(k,2508) * lu(k,3010) + lu(k,3026) = lu(k,3026) - lu(k,2509) * lu(k,3010) + lu(k,3027) = lu(k,3027) - lu(k,2510) * lu(k,3010) + lu(k,3028) = lu(k,3028) - lu(k,2511) * lu(k,3010) + lu(k,3029) = lu(k,3029) - lu(k,2512) * lu(k,3010) + lu(k,3030) = lu(k,3030) - lu(k,2513) * lu(k,3010) + lu(k,3031) = lu(k,3031) - lu(k,2514) * lu(k,3010) + lu(k,3033) = lu(k,3033) - lu(k,2515) * lu(k,3010) + lu(k,3034) = lu(k,3034) - lu(k,2516) * lu(k,3010) + lu(k,3035) = lu(k,3035) - lu(k,2517) * lu(k,3010) + lu(k,3036) = lu(k,3036) - lu(k,2518) * lu(k,3010) + lu(k,3112) = lu(k,3112) - lu(k,2500) * lu(k,3111) + lu(k,3117) = lu(k,3117) - lu(k,2501) * lu(k,3111) + lu(k,3119) = lu(k,3119) - lu(k,2502) * lu(k,3111) + lu(k,3120) = lu(k,3120) - lu(k,2503) * lu(k,3111) + lu(k,3121) = lu(k,3121) - lu(k,2504) * lu(k,3111) + lu(k,3123) = lu(k,3123) - lu(k,2505) * lu(k,3111) + lu(k,3124) = lu(k,3124) - lu(k,2506) * lu(k,3111) + lu(k,3125) = lu(k,3125) - lu(k,2507) * lu(k,3111) + lu(k,3126) = lu(k,3126) - lu(k,2508) * lu(k,3111) + lu(k,3129) = lu(k,3129) - lu(k,2509) * lu(k,3111) + lu(k,3130) = lu(k,3130) - lu(k,2510) * lu(k,3111) + lu(k,3131) = lu(k,3131) - lu(k,2511) * lu(k,3111) + lu(k,3132) = lu(k,3132) - lu(k,2512) * lu(k,3111) + lu(k,3133) = lu(k,3133) - lu(k,2513) * lu(k,3111) + lu(k,3134) = lu(k,3134) - lu(k,2514) * lu(k,3111) + lu(k,3136) = lu(k,3136) - lu(k,2515) * lu(k,3111) + lu(k,3137) = lu(k,3137) - lu(k,2516) * lu(k,3111) + lu(k,3138) = lu(k,3138) - lu(k,2517) * lu(k,3111) + lu(k,3139) = lu(k,3139) - lu(k,2518) * lu(k,3111) + lu(k,3294) = lu(k,3294) - lu(k,2500) * lu(k,3293) + lu(k,3299) = lu(k,3299) - lu(k,2501) * lu(k,3293) + lu(k,3301) = lu(k,3301) - lu(k,2502) * lu(k,3293) + lu(k,3302) = lu(k,3302) - lu(k,2503) * lu(k,3293) + lu(k,3303) = lu(k,3303) - lu(k,2504) * lu(k,3293) + lu(k,3305) = lu(k,3305) - lu(k,2505) * lu(k,3293) + lu(k,3306) = lu(k,3306) - lu(k,2506) * lu(k,3293) + lu(k,3307) = lu(k,3307) - lu(k,2507) * lu(k,3293) + lu(k,3308) = lu(k,3308) - lu(k,2508) * lu(k,3293) + lu(k,3311) = lu(k,3311) - lu(k,2509) * lu(k,3293) + lu(k,3312) = lu(k,3312) - lu(k,2510) * lu(k,3293) + lu(k,3313) = lu(k,3313) - lu(k,2511) * lu(k,3293) + lu(k,3314) = lu(k,3314) - lu(k,2512) * lu(k,3293) + lu(k,3315) = lu(k,3315) - lu(k,2513) * lu(k,3293) + lu(k,3316) = lu(k,3316) - lu(k,2514) * lu(k,3293) + lu(k,3318) = lu(k,3318) - lu(k,2515) * lu(k,3293) + lu(k,3319) = lu(k,3319) - lu(k,2516) * lu(k,3293) + lu(k,3320) = lu(k,3320) - lu(k,2517) * lu(k,3293) + lu(k,3321) = lu(k,3321) - lu(k,2518) * lu(k,3293) + lu(k,3550) = lu(k,3550) - lu(k,2500) * lu(k,3549) + lu(k,3555) = lu(k,3555) - lu(k,2501) * lu(k,3549) + lu(k,3557) = lu(k,3557) - lu(k,2502) * lu(k,3549) + lu(k,3558) = lu(k,3558) - lu(k,2503) * lu(k,3549) + lu(k,3559) = lu(k,3559) - lu(k,2504) * lu(k,3549) + lu(k,3561) = lu(k,3561) - lu(k,2505) * lu(k,3549) + lu(k,3562) = lu(k,3562) - lu(k,2506) * lu(k,3549) + lu(k,3563) = lu(k,3563) - lu(k,2507) * lu(k,3549) + lu(k,3564) = lu(k,3564) - lu(k,2508) * lu(k,3549) + lu(k,3567) = lu(k,3567) - lu(k,2509) * lu(k,3549) + lu(k,3568) = lu(k,3568) - lu(k,2510) * lu(k,3549) + lu(k,3569) = lu(k,3569) - lu(k,2511) * lu(k,3549) + lu(k,3570) = lu(k,3570) - lu(k,2512) * lu(k,3549) + lu(k,3571) = lu(k,3571) - lu(k,2513) * lu(k,3549) + lu(k,3572) = lu(k,3572) - lu(k,2514) * lu(k,3549) + lu(k,3574) = lu(k,3574) - lu(k,2515) * lu(k,3549) + lu(k,3575) = lu(k,3575) - lu(k,2516) * lu(k,3549) + lu(k,3576) = lu(k,3576) - lu(k,2517) * lu(k,3549) + lu(k,3577) = lu(k,3577) - lu(k,2518) * lu(k,3549) + lu(k,3800) = lu(k,3800) - lu(k,2500) * lu(k,3799) + lu(k,3805) = lu(k,3805) - lu(k,2501) * lu(k,3799) + lu(k,3807) = lu(k,3807) - lu(k,2502) * lu(k,3799) + lu(k,3808) = lu(k,3808) - lu(k,2503) * lu(k,3799) + lu(k,3809) = lu(k,3809) - lu(k,2504) * lu(k,3799) + lu(k,3811) = lu(k,3811) - lu(k,2505) * lu(k,3799) + lu(k,3812) = lu(k,3812) - lu(k,2506) * lu(k,3799) + lu(k,3813) = lu(k,3813) - lu(k,2507) * lu(k,3799) + lu(k,3814) = lu(k,3814) - lu(k,2508) * lu(k,3799) + lu(k,3817) = lu(k,3817) - lu(k,2509) * lu(k,3799) + lu(k,3818) = lu(k,3818) - lu(k,2510) * lu(k,3799) + lu(k,3819) = lu(k,3819) - lu(k,2511) * lu(k,3799) + lu(k,3820) = lu(k,3820) - lu(k,2512) * lu(k,3799) + lu(k,3821) = lu(k,3821) - lu(k,2513) * lu(k,3799) + lu(k,3822) = lu(k,3822) - lu(k,2514) * lu(k,3799) + lu(k,3824) = lu(k,3824) - lu(k,2515) * lu(k,3799) + lu(k,3825) = lu(k,3825) - lu(k,2516) * lu(k,3799) + lu(k,3826) = lu(k,3826) - lu(k,2517) * lu(k,3799) + lu(k,3827) = lu(k,3827) - lu(k,2518) * lu(k,3799) + lu(k,3935) = lu(k,3935) - lu(k,2500) * lu(k,3934) + lu(k,3940) = lu(k,3940) - lu(k,2501) * lu(k,3934) + lu(k,3942) = lu(k,3942) - lu(k,2502) * lu(k,3934) + lu(k,3943) = lu(k,3943) - lu(k,2503) * lu(k,3934) + lu(k,3944) = lu(k,3944) - lu(k,2504) * lu(k,3934) + lu(k,3946) = lu(k,3946) - lu(k,2505) * lu(k,3934) + lu(k,3947) = lu(k,3947) - lu(k,2506) * lu(k,3934) + lu(k,3948) = lu(k,3948) - lu(k,2507) * lu(k,3934) + lu(k,3949) = lu(k,3949) - lu(k,2508) * lu(k,3934) + lu(k,3952) = lu(k,3952) - lu(k,2509) * lu(k,3934) + lu(k,3953) = lu(k,3953) - lu(k,2510) * lu(k,3934) + lu(k,3954) = lu(k,3954) - lu(k,2511) * lu(k,3934) + lu(k,3955) = lu(k,3955) - lu(k,2512) * lu(k,3934) + lu(k,3956) = lu(k,3956) - lu(k,2513) * lu(k,3934) + lu(k,3957) = lu(k,3957) - lu(k,2514) * lu(k,3934) + lu(k,3959) = lu(k,3959) - lu(k,2515) * lu(k,3934) + lu(k,3960) = lu(k,3960) - lu(k,2516) * lu(k,3934) + lu(k,3961) = lu(k,3961) - lu(k,2517) * lu(k,3934) + lu(k,3962) = lu(k,3962) - lu(k,2518) * lu(k,3934) + lu(k,4028) = lu(k,4028) - lu(k,2500) * lu(k,4027) + lu(k,4032) = lu(k,4032) - lu(k,2501) * lu(k,4027) + lu(k,4034) = lu(k,4034) - lu(k,2502) * lu(k,4027) + lu(k,4035) = lu(k,4035) - lu(k,2503) * lu(k,4027) + lu(k,4036) = lu(k,4036) - lu(k,2504) * lu(k,4027) + lu(k,4038) = lu(k,4038) - lu(k,2505) * lu(k,4027) + lu(k,4039) = lu(k,4039) - lu(k,2506) * lu(k,4027) + lu(k,4040) = lu(k,4040) - lu(k,2507) * lu(k,4027) + lu(k,4041) = lu(k,4041) - lu(k,2508) * lu(k,4027) + lu(k,4044) = lu(k,4044) - lu(k,2509) * lu(k,4027) + lu(k,4045) = lu(k,4045) - lu(k,2510) * lu(k,4027) + lu(k,4046) = lu(k,4046) - lu(k,2511) * lu(k,4027) + lu(k,4047) = lu(k,4047) - lu(k,2512) * lu(k,4027) + lu(k,4048) = lu(k,4048) - lu(k,2513) * lu(k,4027) + lu(k,4049) = lu(k,4049) - lu(k,2514) * lu(k,4027) + lu(k,4051) = lu(k,4051) - lu(k,2515) * lu(k,4027) + lu(k,4052) = lu(k,4052) - lu(k,2516) * lu(k,4027) + lu(k,4053) = lu(k,4053) - lu(k,2517) * lu(k,4027) + lu(k,4054) = lu(k,4054) - lu(k,2518) * lu(k,4027) + lu(k,2530) = 1._r8 / lu(k,2530) + lu(k,2531) = lu(k,2531) * lu(k,2530) + lu(k,2532) = lu(k,2532) * lu(k,2530) + lu(k,2533) = lu(k,2533) * lu(k,2530) + lu(k,2534) = lu(k,2534) * lu(k,2530) + lu(k,2535) = lu(k,2535) * lu(k,2530) + lu(k,2536) = lu(k,2536) * lu(k,2530) + lu(k,2537) = lu(k,2537) * lu(k,2530) + lu(k,2538) = lu(k,2538) * lu(k,2530) + lu(k,2539) = lu(k,2539) * lu(k,2530) + lu(k,2540) = lu(k,2540) * lu(k,2530) + lu(k,2541) = lu(k,2541) * lu(k,2530) + lu(k,2542) = lu(k,2542) * lu(k,2530) + lu(k,2543) = lu(k,2543) * lu(k,2530) + lu(k,2544) = lu(k,2544) * lu(k,2530) + lu(k,2545) = lu(k,2545) * lu(k,2530) + lu(k,2546) = lu(k,2546) * lu(k,2530) + lu(k,2547) = lu(k,2547) * lu(k,2530) + lu(k,2701) = lu(k,2701) - lu(k,2531) * lu(k,2698) + lu(k,2702) = lu(k,2702) - lu(k,2532) * lu(k,2698) + lu(k,2703) = lu(k,2703) - lu(k,2533) * lu(k,2698) + lu(k,2704) = lu(k,2704) - lu(k,2534) * lu(k,2698) + lu(k,2705) = lu(k,2705) - lu(k,2535) * lu(k,2698) + lu(k,2706) = lu(k,2706) - lu(k,2536) * lu(k,2698) + lu(k,2707) = lu(k,2707) - lu(k,2537) * lu(k,2698) + lu(k,2710) = lu(k,2710) - lu(k,2538) * lu(k,2698) + lu(k,2711) = lu(k,2711) - lu(k,2539) * lu(k,2698) + lu(k,2712) = lu(k,2712) - lu(k,2540) * lu(k,2698) + lu(k,2713) = lu(k,2713) - lu(k,2541) * lu(k,2698) + lu(k,2714) = lu(k,2714) - lu(k,2542) * lu(k,2698) + lu(k,2715) = lu(k,2715) - lu(k,2543) * lu(k,2698) + lu(k,2717) = lu(k,2717) - lu(k,2544) * lu(k,2698) + lu(k,2718) = lu(k,2718) - lu(k,2545) * lu(k,2698) + lu(k,2719) = lu(k,2719) - lu(k,2546) * lu(k,2698) + lu(k,2720) = lu(k,2720) - lu(k,2547) * lu(k,2698) + lu(k,2849) = lu(k,2849) - lu(k,2531) * lu(k,2846) + lu(k,2850) = lu(k,2850) - lu(k,2532) * lu(k,2846) + lu(k,2851) = lu(k,2851) - lu(k,2533) * lu(k,2846) + lu(k,2853) = lu(k,2853) - lu(k,2534) * lu(k,2846) + lu(k,2854) = lu(k,2854) - lu(k,2535) * lu(k,2846) + lu(k,2855) = lu(k,2855) - lu(k,2536) * lu(k,2846) + lu(k,2856) = lu(k,2856) - lu(k,2537) * lu(k,2846) + lu(k,2859) = lu(k,2859) - lu(k,2538) * lu(k,2846) + lu(k,2860) = lu(k,2860) - lu(k,2539) * lu(k,2846) + lu(k,2861) = lu(k,2861) - lu(k,2540) * lu(k,2846) + lu(k,2862) = lu(k,2862) - lu(k,2541) * lu(k,2846) + lu(k,2863) = lu(k,2863) - lu(k,2542) * lu(k,2846) + lu(k,2864) = lu(k,2864) - lu(k,2543) * lu(k,2846) + lu(k,2866) = lu(k,2866) - lu(k,2544) * lu(k,2846) + lu(k,2867) = lu(k,2867) - lu(k,2545) * lu(k,2846) + lu(k,2868) = lu(k,2868) - lu(k,2546) * lu(k,2846) + lu(k,2869) = lu(k,2869) - lu(k,2547) * lu(k,2846) + lu(k,2896) = lu(k,2896) - lu(k,2531) * lu(k,2893) + lu(k,2897) = lu(k,2897) - lu(k,2532) * lu(k,2893) + lu(k,2898) = lu(k,2898) - lu(k,2533) * lu(k,2893) + lu(k,2900) = lu(k,2900) - lu(k,2534) * lu(k,2893) + lu(k,2901) = lu(k,2901) - lu(k,2535) * lu(k,2893) + lu(k,2902) = lu(k,2902) - lu(k,2536) * lu(k,2893) + lu(k,2903) = lu(k,2903) - lu(k,2537) * lu(k,2893) + lu(k,2906) = lu(k,2906) - lu(k,2538) * lu(k,2893) + lu(k,2907) = lu(k,2907) - lu(k,2539) * lu(k,2893) + lu(k,2908) = lu(k,2908) - lu(k,2540) * lu(k,2893) + lu(k,2909) = lu(k,2909) - lu(k,2541) * lu(k,2893) + lu(k,2910) = lu(k,2910) - lu(k,2542) * lu(k,2893) + lu(k,2911) = lu(k,2911) - lu(k,2543) * lu(k,2893) + lu(k,2913) = lu(k,2913) - lu(k,2544) * lu(k,2893) + lu(k,2914) = lu(k,2914) - lu(k,2545) * lu(k,2893) + lu(k,2915) = lu(k,2915) - lu(k,2546) * lu(k,2893) + lu(k,2916) = lu(k,2916) - lu(k,2547) * lu(k,2893) + lu(k,2942) = lu(k,2942) - lu(k,2531) * lu(k,2939) + lu(k,2943) = lu(k,2943) - lu(k,2532) * lu(k,2939) + lu(k,2944) = lu(k,2944) - lu(k,2533) * lu(k,2939) + lu(k,2946) = lu(k,2946) - lu(k,2534) * lu(k,2939) + lu(k,2947) = lu(k,2947) - lu(k,2535) * lu(k,2939) + lu(k,2948) = lu(k,2948) - lu(k,2536) * lu(k,2939) + lu(k,2949) = lu(k,2949) - lu(k,2537) * lu(k,2939) + lu(k,2952) = lu(k,2952) - lu(k,2538) * lu(k,2939) + lu(k,2953) = lu(k,2953) - lu(k,2539) * lu(k,2939) + lu(k,2954) = lu(k,2954) - lu(k,2540) * lu(k,2939) + lu(k,2955) = lu(k,2955) - lu(k,2541) * lu(k,2939) + lu(k,2956) = lu(k,2956) - lu(k,2542) * lu(k,2939) + lu(k,2957) = lu(k,2957) - lu(k,2543) * lu(k,2939) + lu(k,2959) = lu(k,2959) - lu(k,2544) * lu(k,2939) + lu(k,2960) = lu(k,2960) - lu(k,2545) * lu(k,2939) + lu(k,2961) = lu(k,2961) - lu(k,2546) * lu(k,2939) + lu(k,2962) = lu(k,2962) - lu(k,2547) * lu(k,2939) + lu(k,3016) = lu(k,3016) - lu(k,2531) * lu(k,3011) + lu(k,3017) = lu(k,3017) - lu(k,2532) * lu(k,3011) + lu(k,3018) = lu(k,3018) - lu(k,2533) * lu(k,3011) + lu(k,3020) = lu(k,3020) - lu(k,2534) * lu(k,3011) + lu(k,3021) = lu(k,3021) - lu(k,2535) * lu(k,3011) + lu(k,3022) = lu(k,3022) - lu(k,2536) * lu(k,3011) + lu(k,3023) = lu(k,3023) - lu(k,2537) * lu(k,3011) + lu(k,3026) = lu(k,3026) - lu(k,2538) * lu(k,3011) + lu(k,3027) = lu(k,3027) - lu(k,2539) * lu(k,3011) + lu(k,3028) = lu(k,3028) - lu(k,2540) * lu(k,3011) + lu(k,3029) = lu(k,3029) - lu(k,2541) * lu(k,3011) + lu(k,3030) = lu(k,3030) - lu(k,2542) * lu(k,3011) + lu(k,3031) = lu(k,3031) - lu(k,2543) * lu(k,3011) + lu(k,3033) = lu(k,3033) - lu(k,2544) * lu(k,3011) + lu(k,3034) = lu(k,3034) - lu(k,2545) * lu(k,3011) + lu(k,3035) = lu(k,3035) - lu(k,2546) * lu(k,3011) + lu(k,3036) = lu(k,3036) - lu(k,2547) * lu(k,3011) + lu(k,3119) = lu(k,3119) - lu(k,2531) * lu(k,3112) + lu(k,3120) = lu(k,3120) - lu(k,2532) * lu(k,3112) + lu(k,3121) = lu(k,3121) - lu(k,2533) * lu(k,3112) + lu(k,3123) = lu(k,3123) - lu(k,2534) * lu(k,3112) + lu(k,3124) = lu(k,3124) - lu(k,2535) * lu(k,3112) + lu(k,3125) = lu(k,3125) - lu(k,2536) * lu(k,3112) + lu(k,3126) = lu(k,3126) - lu(k,2537) * lu(k,3112) + lu(k,3129) = lu(k,3129) - lu(k,2538) * lu(k,3112) + lu(k,3130) = lu(k,3130) - lu(k,2539) * lu(k,3112) + lu(k,3131) = lu(k,3131) - lu(k,2540) * lu(k,3112) + lu(k,3132) = lu(k,3132) - lu(k,2541) * lu(k,3112) + lu(k,3133) = lu(k,3133) - lu(k,2542) * lu(k,3112) + lu(k,3134) = lu(k,3134) - lu(k,2543) * lu(k,3112) + lu(k,3136) = lu(k,3136) - lu(k,2544) * lu(k,3112) + lu(k,3137) = lu(k,3137) - lu(k,2545) * lu(k,3112) + lu(k,3138) = lu(k,3138) - lu(k,2546) * lu(k,3112) + lu(k,3139) = lu(k,3139) - lu(k,2547) * lu(k,3112) + lu(k,3301) = lu(k,3301) - lu(k,2531) * lu(k,3294) + lu(k,3302) = lu(k,3302) - lu(k,2532) * lu(k,3294) + lu(k,3303) = lu(k,3303) - lu(k,2533) * lu(k,3294) + lu(k,3305) = lu(k,3305) - lu(k,2534) * lu(k,3294) + lu(k,3306) = lu(k,3306) - lu(k,2535) * lu(k,3294) + lu(k,3307) = lu(k,3307) - lu(k,2536) * lu(k,3294) + lu(k,3308) = lu(k,3308) - lu(k,2537) * lu(k,3294) + lu(k,3311) = lu(k,3311) - lu(k,2538) * lu(k,3294) + lu(k,3312) = lu(k,3312) - lu(k,2539) * lu(k,3294) + lu(k,3313) = lu(k,3313) - lu(k,2540) * lu(k,3294) + lu(k,3314) = lu(k,3314) - lu(k,2541) * lu(k,3294) + lu(k,3315) = lu(k,3315) - lu(k,2542) * lu(k,3294) + lu(k,3316) = lu(k,3316) - lu(k,2543) * lu(k,3294) + lu(k,3318) = lu(k,3318) - lu(k,2544) * lu(k,3294) + lu(k,3319) = lu(k,3319) - lu(k,2545) * lu(k,3294) + lu(k,3320) = lu(k,3320) - lu(k,2546) * lu(k,3294) + lu(k,3321) = lu(k,3321) - lu(k,2547) * lu(k,3294) + lu(k,3557) = lu(k,3557) - lu(k,2531) * lu(k,3550) + lu(k,3558) = lu(k,3558) - lu(k,2532) * lu(k,3550) + lu(k,3559) = lu(k,3559) - lu(k,2533) * lu(k,3550) + lu(k,3561) = lu(k,3561) - lu(k,2534) * lu(k,3550) + lu(k,3562) = lu(k,3562) - lu(k,2535) * lu(k,3550) + lu(k,3563) = lu(k,3563) - lu(k,2536) * lu(k,3550) + lu(k,3564) = lu(k,3564) - lu(k,2537) * lu(k,3550) + lu(k,3567) = lu(k,3567) - lu(k,2538) * lu(k,3550) + lu(k,3568) = lu(k,3568) - lu(k,2539) * lu(k,3550) + lu(k,3569) = lu(k,3569) - lu(k,2540) * lu(k,3550) + lu(k,3570) = lu(k,3570) - lu(k,2541) * lu(k,3550) + lu(k,3571) = lu(k,3571) - lu(k,2542) * lu(k,3550) + lu(k,3572) = lu(k,3572) - lu(k,2543) * lu(k,3550) + lu(k,3574) = lu(k,3574) - lu(k,2544) * lu(k,3550) + lu(k,3575) = lu(k,3575) - lu(k,2545) * lu(k,3550) + lu(k,3576) = lu(k,3576) - lu(k,2546) * lu(k,3550) + lu(k,3577) = lu(k,3577) - lu(k,2547) * lu(k,3550) + lu(k,3807) = lu(k,3807) - lu(k,2531) * lu(k,3800) + lu(k,3808) = lu(k,3808) - lu(k,2532) * lu(k,3800) + lu(k,3809) = lu(k,3809) - lu(k,2533) * lu(k,3800) + lu(k,3811) = lu(k,3811) - lu(k,2534) * lu(k,3800) + lu(k,3812) = lu(k,3812) - lu(k,2535) * lu(k,3800) + lu(k,3813) = lu(k,3813) - lu(k,2536) * lu(k,3800) + lu(k,3814) = lu(k,3814) - lu(k,2537) * lu(k,3800) + lu(k,3817) = lu(k,3817) - lu(k,2538) * lu(k,3800) + lu(k,3818) = lu(k,3818) - lu(k,2539) * lu(k,3800) + lu(k,3819) = lu(k,3819) - lu(k,2540) * lu(k,3800) + lu(k,3820) = lu(k,3820) - lu(k,2541) * lu(k,3800) + lu(k,3821) = lu(k,3821) - lu(k,2542) * lu(k,3800) + lu(k,3822) = lu(k,3822) - lu(k,2543) * lu(k,3800) + lu(k,3824) = lu(k,3824) - lu(k,2544) * lu(k,3800) + lu(k,3825) = lu(k,3825) - lu(k,2545) * lu(k,3800) + lu(k,3826) = lu(k,3826) - lu(k,2546) * lu(k,3800) + lu(k,3827) = lu(k,3827) - lu(k,2547) * lu(k,3800) + lu(k,3942) = lu(k,3942) - lu(k,2531) * lu(k,3935) + lu(k,3943) = lu(k,3943) - lu(k,2532) * lu(k,3935) + lu(k,3944) = lu(k,3944) - lu(k,2533) * lu(k,3935) + lu(k,3946) = lu(k,3946) - lu(k,2534) * lu(k,3935) + lu(k,3947) = lu(k,3947) - lu(k,2535) * lu(k,3935) + lu(k,3948) = lu(k,3948) - lu(k,2536) * lu(k,3935) + lu(k,3949) = lu(k,3949) - lu(k,2537) * lu(k,3935) + lu(k,3952) = lu(k,3952) - lu(k,2538) * lu(k,3935) + lu(k,3953) = lu(k,3953) - lu(k,2539) * lu(k,3935) + lu(k,3954) = lu(k,3954) - lu(k,2540) * lu(k,3935) + lu(k,3955) = lu(k,3955) - lu(k,2541) * lu(k,3935) + lu(k,3956) = lu(k,3956) - lu(k,2542) * lu(k,3935) + lu(k,3957) = lu(k,3957) - lu(k,2543) * lu(k,3935) + lu(k,3959) = lu(k,3959) - lu(k,2544) * lu(k,3935) + lu(k,3960) = lu(k,3960) - lu(k,2545) * lu(k,3935) + lu(k,3961) = lu(k,3961) - lu(k,2546) * lu(k,3935) + lu(k,3962) = lu(k,3962) - lu(k,2547) * lu(k,3935) + lu(k,4034) = lu(k,4034) - lu(k,2531) * lu(k,4028) + lu(k,4035) = lu(k,4035) - lu(k,2532) * lu(k,4028) + lu(k,4036) = lu(k,4036) - lu(k,2533) * lu(k,4028) + lu(k,4038) = lu(k,4038) - lu(k,2534) * lu(k,4028) + lu(k,4039) = lu(k,4039) - lu(k,2535) * lu(k,4028) + lu(k,4040) = lu(k,4040) - lu(k,2536) * lu(k,4028) + lu(k,4041) = lu(k,4041) - lu(k,2537) * lu(k,4028) + lu(k,4044) = lu(k,4044) - lu(k,2538) * lu(k,4028) + lu(k,4045) = lu(k,4045) - lu(k,2539) * lu(k,4028) + lu(k,4046) = lu(k,4046) - lu(k,2540) * lu(k,4028) + lu(k,4047) = lu(k,4047) - lu(k,2541) * lu(k,4028) + lu(k,4048) = lu(k,4048) - lu(k,2542) * lu(k,4028) + lu(k,4049) = lu(k,4049) - lu(k,2543) * lu(k,4028) + lu(k,4051) = lu(k,4051) - lu(k,2544) * lu(k,4028) + lu(k,4052) = lu(k,4052) - lu(k,2545) * lu(k,4028) + lu(k,4053) = lu(k,4053) - lu(k,2546) * lu(k,4028) + lu(k,4054) = lu(k,4054) - lu(k,2547) * lu(k,4028) + lu(k,2555) = 1._r8 / lu(k,2555) + lu(k,2556) = lu(k,2556) * lu(k,2555) + lu(k,2557) = lu(k,2557) * lu(k,2555) + lu(k,2558) = lu(k,2558) * lu(k,2555) + lu(k,2559) = lu(k,2559) * lu(k,2555) + lu(k,2560) = lu(k,2560) * lu(k,2555) + lu(k,2561) = lu(k,2561) * lu(k,2555) + lu(k,2562) = lu(k,2562) * lu(k,2555) + lu(k,2563) = lu(k,2563) * lu(k,2555) + lu(k,2564) = lu(k,2564) * lu(k,2555) + lu(k,2565) = lu(k,2565) * lu(k,2555) + lu(k,2566) = lu(k,2566) * lu(k,2555) + lu(k,2567) = lu(k,2567) * lu(k,2555) + lu(k,2568) = lu(k,2568) * lu(k,2555) + lu(k,2569) = lu(k,2569) * lu(k,2555) + lu(k,2570) = lu(k,2570) * lu(k,2555) + lu(k,2596) = lu(k,2596) - lu(k,2556) * lu(k,2595) + lu(k,2597) = lu(k,2597) - lu(k,2557) * lu(k,2595) + lu(k,2598) = lu(k,2598) - lu(k,2558) * lu(k,2595) + lu(k,2599) = lu(k,2599) - lu(k,2559) * lu(k,2595) + lu(k,2600) = lu(k,2600) - lu(k,2560) * lu(k,2595) + lu(k,2601) = lu(k,2601) - lu(k,2561) * lu(k,2595) + lu(k,2602) = lu(k,2602) - lu(k,2562) * lu(k,2595) + lu(k,2603) = lu(k,2603) - lu(k,2563) * lu(k,2595) + lu(k,2604) = lu(k,2604) - lu(k,2564) * lu(k,2595) + lu(k,2605) = lu(k,2605) - lu(k,2565) * lu(k,2595) + lu(k,2606) = lu(k,2606) - lu(k,2566) * lu(k,2595) + lu(k,2607) = lu(k,2607) - lu(k,2567) * lu(k,2595) + lu(k,2608) = lu(k,2608) - lu(k,2568) * lu(k,2595) + lu(k,2610) = lu(k,2610) - lu(k,2569) * lu(k,2595) + lu(k,2611) = lu(k,2611) - lu(k,2570) * lu(k,2595) + lu(k,2637) = lu(k,2637) - lu(k,2556) * lu(k,2636) + lu(k,2638) = lu(k,2638) - lu(k,2557) * lu(k,2636) + lu(k,2639) = lu(k,2639) - lu(k,2558) * lu(k,2636) + lu(k,2640) = lu(k,2640) - lu(k,2559) * lu(k,2636) + lu(k,2641) = lu(k,2641) - lu(k,2560) * lu(k,2636) + lu(k,2642) = lu(k,2642) - lu(k,2561) * lu(k,2636) + lu(k,2643) = lu(k,2643) - lu(k,2562) * lu(k,2636) + lu(k,2644) = lu(k,2644) - lu(k,2563) * lu(k,2636) + lu(k,2645) = lu(k,2645) - lu(k,2564) * lu(k,2636) + lu(k,2646) = lu(k,2646) - lu(k,2565) * lu(k,2636) + lu(k,2647) = lu(k,2647) - lu(k,2566) * lu(k,2636) + lu(k,2648) = lu(k,2648) - lu(k,2567) * lu(k,2636) + lu(k,2649) = lu(k,2649) - lu(k,2568) * lu(k,2636) + lu(k,2651) = - lu(k,2569) * lu(k,2636) + lu(k,2652) = lu(k,2652) - lu(k,2570) * lu(k,2636) + lu(k,3114) = lu(k,3114) - lu(k,2556) * lu(k,3113) + lu(k,3115) = lu(k,3115) - lu(k,2557) * lu(k,3113) + lu(k,3116) = lu(k,3116) - lu(k,2558) * lu(k,3113) + lu(k,3127) = lu(k,3127) - lu(k,2559) * lu(k,3113) + lu(k,3128) = lu(k,3128) - lu(k,2560) * lu(k,3113) + lu(k,3129) = lu(k,3129) - lu(k,2561) * lu(k,3113) + lu(k,3130) = lu(k,3130) - lu(k,2562) * lu(k,3113) + lu(k,3131) = lu(k,3131) - lu(k,2563) * lu(k,3113) + lu(k,3132) = lu(k,3132) - lu(k,2564) * lu(k,3113) + lu(k,3133) = lu(k,3133) - lu(k,2565) * lu(k,3113) + lu(k,3134) = lu(k,3134) - lu(k,2566) * lu(k,3113) + lu(k,3135) = lu(k,3135) - lu(k,2567) * lu(k,3113) + lu(k,3136) = lu(k,3136) - lu(k,2568) * lu(k,3113) + lu(k,3138) = lu(k,3138) - lu(k,2569) * lu(k,3113) + lu(k,3139) = lu(k,3139) - lu(k,2570) * lu(k,3113) + lu(k,3147) = lu(k,3147) - lu(k,2556) * lu(k,3146) + lu(k,3148) = lu(k,3148) - lu(k,2557) * lu(k,3146) + lu(k,3149) = lu(k,3149) - lu(k,2558) * lu(k,3146) + lu(k,3150) = lu(k,3150) - lu(k,2559) * lu(k,3146) + lu(k,3151) = lu(k,3151) - lu(k,2560) * lu(k,3146) + lu(k,3152) = - lu(k,2561) * lu(k,3146) + lu(k,3153) = lu(k,3153) - lu(k,2562) * lu(k,3146) + lu(k,3154) = lu(k,3154) - lu(k,2563) * lu(k,3146) + lu(k,3155) = lu(k,3155) - lu(k,2564) * lu(k,3146) + lu(k,3156) = lu(k,3156) - lu(k,2565) * lu(k,3146) + lu(k,3157) = lu(k,3157) - lu(k,2566) * lu(k,3146) + lu(k,3158) = lu(k,3158) - lu(k,2567) * lu(k,3146) + lu(k,3159) = lu(k,3159) - lu(k,2568) * lu(k,3146) + lu(k,3161) = lu(k,3161) - lu(k,2569) * lu(k,3146) + lu(k,3162) = lu(k,3162) - lu(k,2570) * lu(k,3146) + lu(k,3296) = lu(k,3296) - lu(k,2556) * lu(k,3295) + lu(k,3297) = lu(k,3297) - lu(k,2557) * lu(k,3295) + lu(k,3298) = lu(k,3298) - lu(k,2558) * lu(k,3295) + lu(k,3309) = lu(k,3309) - lu(k,2559) * lu(k,3295) + lu(k,3310) = lu(k,3310) - lu(k,2560) * lu(k,3295) + lu(k,3311) = lu(k,3311) - lu(k,2561) * lu(k,3295) + lu(k,3312) = lu(k,3312) - lu(k,2562) * lu(k,3295) + lu(k,3313) = lu(k,3313) - lu(k,2563) * lu(k,3295) + lu(k,3314) = lu(k,3314) - lu(k,2564) * lu(k,3295) + lu(k,3315) = lu(k,3315) - lu(k,2565) * lu(k,3295) + lu(k,3316) = lu(k,3316) - lu(k,2566) * lu(k,3295) + lu(k,3317) = lu(k,3317) - lu(k,2567) * lu(k,3295) + lu(k,3318) = lu(k,3318) - lu(k,2568) * lu(k,3295) + lu(k,3320) = lu(k,3320) - lu(k,2569) * lu(k,3295) + lu(k,3321) = lu(k,3321) - lu(k,2570) * lu(k,3295) + lu(k,3351) = lu(k,3351) - lu(k,2556) * lu(k,3350) + lu(k,3352) = - lu(k,2557) * lu(k,3350) + lu(k,3353) = lu(k,3353) - lu(k,2558) * lu(k,3350) + lu(k,3354) = lu(k,3354) - lu(k,2559) * lu(k,3350) + lu(k,3355) = lu(k,3355) - lu(k,2560) * lu(k,3350) + lu(k,3356) = lu(k,3356) - lu(k,2561) * lu(k,3350) + lu(k,3357) = lu(k,3357) - lu(k,2562) * lu(k,3350) + lu(k,3358) = lu(k,3358) - lu(k,2563) * lu(k,3350) + lu(k,3359) = lu(k,3359) - lu(k,2564) * lu(k,3350) + lu(k,3360) = lu(k,3360) - lu(k,2565) * lu(k,3350) + lu(k,3361) = lu(k,3361) - lu(k,2566) * lu(k,3350) + lu(k,3362) = lu(k,3362) - lu(k,2567) * lu(k,3350) + lu(k,3363) = lu(k,3363) - lu(k,2568) * lu(k,3350) + lu(k,3365) = lu(k,3365) - lu(k,2569) * lu(k,3350) + lu(k,3366) = lu(k,3366) - lu(k,2570) * lu(k,3350) + lu(k,3382) = lu(k,3382) - lu(k,2556) * lu(k,3381) + lu(k,3383) = lu(k,3383) - lu(k,2557) * lu(k,3381) + lu(k,3384) = lu(k,3384) - lu(k,2558) * lu(k,3381) + lu(k,3385) = lu(k,3385) - lu(k,2559) * lu(k,3381) + lu(k,3386) = lu(k,3386) - lu(k,2560) * lu(k,3381) + lu(k,3387) = lu(k,3387) - lu(k,2561) * lu(k,3381) + lu(k,3388) = lu(k,3388) - lu(k,2562) * lu(k,3381) + lu(k,3389) = lu(k,3389) - lu(k,2563) * lu(k,3381) + lu(k,3390) = lu(k,3390) - lu(k,2564) * lu(k,3381) + lu(k,3391) = lu(k,3391) - lu(k,2565) * lu(k,3381) + lu(k,3392) = lu(k,3392) - lu(k,2566) * lu(k,3381) + lu(k,3393) = lu(k,3393) - lu(k,2567) * lu(k,3381) + lu(k,3394) = lu(k,3394) - lu(k,2568) * lu(k,3381) + lu(k,3396) = lu(k,3396) - lu(k,2569) * lu(k,3381) + lu(k,3397) = lu(k,3397) - lu(k,2570) * lu(k,3381) + lu(k,3552) = lu(k,3552) - lu(k,2556) * lu(k,3551) + lu(k,3553) = lu(k,3553) - lu(k,2557) * lu(k,3551) + lu(k,3554) = lu(k,3554) - lu(k,2558) * lu(k,3551) + lu(k,3565) = lu(k,3565) - lu(k,2559) * lu(k,3551) + lu(k,3566) = lu(k,3566) - lu(k,2560) * lu(k,3551) + lu(k,3567) = lu(k,3567) - lu(k,2561) * lu(k,3551) + lu(k,3568) = lu(k,3568) - lu(k,2562) * lu(k,3551) + lu(k,3569) = lu(k,3569) - lu(k,2563) * lu(k,3551) + lu(k,3570) = lu(k,3570) - lu(k,2564) * lu(k,3551) + lu(k,3571) = lu(k,3571) - lu(k,2565) * lu(k,3551) + lu(k,3572) = lu(k,3572) - lu(k,2566) * lu(k,3551) + lu(k,3573) = lu(k,3573) - lu(k,2567) * lu(k,3551) + lu(k,3574) = lu(k,3574) - lu(k,2568) * lu(k,3551) + lu(k,3576) = lu(k,3576) - lu(k,2569) * lu(k,3551) + lu(k,3577) = lu(k,3577) - lu(k,2570) * lu(k,3551) + lu(k,3802) = lu(k,3802) - lu(k,2556) * lu(k,3801) + lu(k,3803) = lu(k,3803) - lu(k,2557) * lu(k,3801) + lu(k,3804) = lu(k,3804) - lu(k,2558) * lu(k,3801) + lu(k,3815) = lu(k,3815) - lu(k,2559) * lu(k,3801) + lu(k,3816) = lu(k,3816) - lu(k,2560) * lu(k,3801) + lu(k,3817) = lu(k,3817) - lu(k,2561) * lu(k,3801) + lu(k,3818) = lu(k,3818) - lu(k,2562) * lu(k,3801) + lu(k,3819) = lu(k,3819) - lu(k,2563) * lu(k,3801) + lu(k,3820) = lu(k,3820) - lu(k,2564) * lu(k,3801) + lu(k,3821) = lu(k,3821) - lu(k,2565) * lu(k,3801) + lu(k,3822) = lu(k,3822) - lu(k,2566) * lu(k,3801) + lu(k,3823) = lu(k,3823) - lu(k,2567) * lu(k,3801) + lu(k,3824) = lu(k,3824) - lu(k,2568) * lu(k,3801) + lu(k,3826) = lu(k,3826) - lu(k,2569) * lu(k,3801) + lu(k,3827) = lu(k,3827) - lu(k,2570) * lu(k,3801) + lu(k,3852) = lu(k,3852) - lu(k,2556) * lu(k,3851) + lu(k,3853) = lu(k,3853) - lu(k,2557) * lu(k,3851) + lu(k,3854) = lu(k,3854) - lu(k,2558) * lu(k,3851) + lu(k,3856) = lu(k,3856) - lu(k,2559) * lu(k,3851) + lu(k,3857) = lu(k,3857) - lu(k,2560) * lu(k,3851) + lu(k,3858) = lu(k,3858) - lu(k,2561) * lu(k,3851) + lu(k,3859) = lu(k,3859) - lu(k,2562) * lu(k,3851) + lu(k,3860) = lu(k,3860) - lu(k,2563) * lu(k,3851) + lu(k,3861) = lu(k,3861) - lu(k,2564) * lu(k,3851) + lu(k,3862) = lu(k,3862) - lu(k,2565) * lu(k,3851) + lu(k,3863) = lu(k,3863) - lu(k,2566) * lu(k,3851) + lu(k,3864) = lu(k,3864) - lu(k,2567) * lu(k,3851) + lu(k,3865) = lu(k,3865) - lu(k,2568) * lu(k,3851) + lu(k,3867) = lu(k,3867) - lu(k,2569) * lu(k,3851) + lu(k,3868) = lu(k,3868) - lu(k,2570) * lu(k,3851) + lu(k,3937) = lu(k,3937) - lu(k,2556) * lu(k,3936) + lu(k,3938) = lu(k,3938) - lu(k,2557) * lu(k,3936) + lu(k,3939) = lu(k,3939) - lu(k,2558) * lu(k,3936) + lu(k,3950) = lu(k,3950) - lu(k,2559) * lu(k,3936) + lu(k,3951) = lu(k,3951) - lu(k,2560) * lu(k,3936) + lu(k,3952) = lu(k,3952) - lu(k,2561) * lu(k,3936) + lu(k,3953) = lu(k,3953) - lu(k,2562) * lu(k,3936) + lu(k,3954) = lu(k,3954) - lu(k,2563) * lu(k,3936) + lu(k,3955) = lu(k,3955) - lu(k,2564) * lu(k,3936) + lu(k,3956) = lu(k,3956) - lu(k,2565) * lu(k,3936) + lu(k,3957) = lu(k,3957) - lu(k,2566) * lu(k,3936) + lu(k,3958) = lu(k,3958) - lu(k,2567) * lu(k,3936) + lu(k,3959) = lu(k,3959) - lu(k,2568) * lu(k,3936) + lu(k,3961) = lu(k,3961) - lu(k,2569) * lu(k,3936) + lu(k,3962) = lu(k,3962) - lu(k,2570) * lu(k,3936) + lu(k,4086) = lu(k,4086) - lu(k,2556) * lu(k,4085) + lu(k,4087) = lu(k,4087) - lu(k,2557) * lu(k,4085) + lu(k,4088) = lu(k,4088) - lu(k,2558) * lu(k,4085) + lu(k,4094) = lu(k,4094) - lu(k,2559) * lu(k,4085) + lu(k,4095) = lu(k,4095) - lu(k,2560) * lu(k,4085) + lu(k,4096) = lu(k,4096) - lu(k,2561) * lu(k,4085) + lu(k,4097) = lu(k,4097) - lu(k,2562) * lu(k,4085) + lu(k,4098) = lu(k,4098) - lu(k,2563) * lu(k,4085) + lu(k,4099) = lu(k,4099) - lu(k,2564) * lu(k,4085) + lu(k,4100) = lu(k,4100) - lu(k,2565) * lu(k,4085) + lu(k,4101) = lu(k,4101) - lu(k,2566) * lu(k,4085) + lu(k,4102) = lu(k,4102) - lu(k,2567) * lu(k,4085) + lu(k,4103) = lu(k,4103) - lu(k,2568) * lu(k,4085) + lu(k,4105) = lu(k,4105) - lu(k,2569) * lu(k,4085) + lu(k,4106) = lu(k,4106) - lu(k,2570) * lu(k,4085) + lu(k,4117) = lu(k,4117) - lu(k,2556) * lu(k,4116) + lu(k,4118) = lu(k,4118) - lu(k,2557) * lu(k,4116) + lu(k,4119) = lu(k,4119) - lu(k,2558) * lu(k,4116) + lu(k,4120) = lu(k,4120) - lu(k,2559) * lu(k,4116) + lu(k,4121) = lu(k,4121) - lu(k,2560) * lu(k,4116) + lu(k,4122) = lu(k,4122) - lu(k,2561) * lu(k,4116) + lu(k,4123) = lu(k,4123) - lu(k,2562) * lu(k,4116) + lu(k,4124) = lu(k,4124) - lu(k,2563) * lu(k,4116) + lu(k,4125) = lu(k,4125) - lu(k,2564) * lu(k,4116) + lu(k,4126) = lu(k,4126) - lu(k,2565) * lu(k,4116) + lu(k,4127) = lu(k,4127) - lu(k,2566) * lu(k,4116) + lu(k,4128) = lu(k,4128) - lu(k,2567) * lu(k,4116) + lu(k,4129) = lu(k,4129) - lu(k,2568) * lu(k,4116) + lu(k,4131) = lu(k,4131) - lu(k,2569) * lu(k,4116) + lu(k,4132) = lu(k,4132) - lu(k,2570) * lu(k,4116) end do end subroutine lu_fac48 subroutine lu_fac49( avec_len, lu ) @@ -15046,676 +14091,826 @@ subroutine lu_fac49( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,2885) = 1._r8 / lu(k,2885) - lu(k,2886) = lu(k,2886) * lu(k,2885) - lu(k,2887) = lu(k,2887) * lu(k,2885) - lu(k,2888) = lu(k,2888) * lu(k,2885) - lu(k,2889) = lu(k,2889) * lu(k,2885) - lu(k,2890) = lu(k,2890) * lu(k,2885) - lu(k,2891) = lu(k,2891) * lu(k,2885) - lu(k,2892) = lu(k,2892) * lu(k,2885) - lu(k,2893) = lu(k,2893) * lu(k,2885) - lu(k,2894) = lu(k,2894) * lu(k,2885) - lu(k,2895) = lu(k,2895) * lu(k,2885) - lu(k,2896) = lu(k,2896) * lu(k,2885) - lu(k,2897) = lu(k,2897) * lu(k,2885) - lu(k,2898) = lu(k,2898) * lu(k,2885) - lu(k,2899) = lu(k,2899) * lu(k,2885) - lu(k,2987) = lu(k,2987) - lu(k,2886) * lu(k,2986) - lu(k,2988) = lu(k,2988) - lu(k,2887) * lu(k,2986) - lu(k,2989) = lu(k,2989) - lu(k,2888) * lu(k,2986) - lu(k,2990) = lu(k,2990) - lu(k,2889) * lu(k,2986) - lu(k,2991) = lu(k,2991) - lu(k,2890) * lu(k,2986) - lu(k,2992) = lu(k,2992) - lu(k,2891) * lu(k,2986) - lu(k,2993) = lu(k,2993) - lu(k,2892) * lu(k,2986) - lu(k,2994) = lu(k,2994) - lu(k,2893) * lu(k,2986) - lu(k,2995) = lu(k,2995) - lu(k,2894) * lu(k,2986) - lu(k,2996) = lu(k,2996) - lu(k,2895) * lu(k,2986) - lu(k,2997) = lu(k,2997) - lu(k,2896) * lu(k,2986) - lu(k,2998) = lu(k,2998) - lu(k,2897) * lu(k,2986) - lu(k,2999) = lu(k,2999) - lu(k,2898) * lu(k,2986) - lu(k,3000) = lu(k,3000) - lu(k,2899) * lu(k,2986) - lu(k,3079) = lu(k,3079) - lu(k,2886) * lu(k,3078) - lu(k,3080) = lu(k,3080) - lu(k,2887) * lu(k,3078) - lu(k,3081) = lu(k,3081) - lu(k,2888) * lu(k,3078) - lu(k,3082) = lu(k,3082) - lu(k,2889) * lu(k,3078) - lu(k,3083) = lu(k,3083) - lu(k,2890) * lu(k,3078) - lu(k,3084) = lu(k,3084) - lu(k,2891) * lu(k,3078) - lu(k,3085) = lu(k,3085) - lu(k,2892) * lu(k,3078) - lu(k,3086) = lu(k,3086) - lu(k,2893) * lu(k,3078) - lu(k,3087) = lu(k,3087) - lu(k,2894) * lu(k,3078) - lu(k,3088) = lu(k,3088) - lu(k,2895) * lu(k,3078) - lu(k,3089) = lu(k,3089) - lu(k,2896) * lu(k,3078) - lu(k,3090) = lu(k,3090) - lu(k,2897) * lu(k,3078) - lu(k,3091) = lu(k,3091) - lu(k,2898) * lu(k,3078) - lu(k,3092) = lu(k,3092) - lu(k,2899) * lu(k,3078) - lu(k,3103) = lu(k,3103) - lu(k,2886) * lu(k,3102) - lu(k,3104) = lu(k,3104) - lu(k,2887) * lu(k,3102) - lu(k,3105) = lu(k,3105) - lu(k,2888) * lu(k,3102) - lu(k,3106) = lu(k,3106) - lu(k,2889) * lu(k,3102) - lu(k,3107) = lu(k,3107) - lu(k,2890) * lu(k,3102) - lu(k,3108) = lu(k,3108) - lu(k,2891) * lu(k,3102) - lu(k,3109) = lu(k,3109) - lu(k,2892) * lu(k,3102) - lu(k,3110) = lu(k,3110) - lu(k,2893) * lu(k,3102) - lu(k,3111) = lu(k,3111) - lu(k,2894) * lu(k,3102) - lu(k,3112) = lu(k,3112) - lu(k,2895) * lu(k,3102) - lu(k,3113) = lu(k,3113) - lu(k,2896) * lu(k,3102) - lu(k,3114) = lu(k,3114) - lu(k,2897) * lu(k,3102) - lu(k,3115) = lu(k,3115) - lu(k,2898) * lu(k,3102) - lu(k,3116) = lu(k,3116) - lu(k,2899) * lu(k,3102) - lu(k,3282) = lu(k,3282) - lu(k,2886) * lu(k,3281) - lu(k,3283) = lu(k,3283) - lu(k,2887) * lu(k,3281) - lu(k,3284) = lu(k,3284) - lu(k,2888) * lu(k,3281) - lu(k,3285) = lu(k,3285) - lu(k,2889) * lu(k,3281) - lu(k,3286) = lu(k,3286) - lu(k,2890) * lu(k,3281) - lu(k,3287) = lu(k,3287) - lu(k,2891) * lu(k,3281) - lu(k,3288) = lu(k,3288) - lu(k,2892) * lu(k,3281) - lu(k,3289) = lu(k,3289) - lu(k,2893) * lu(k,3281) - lu(k,3290) = lu(k,3290) - lu(k,2894) * lu(k,3281) - lu(k,3291) = lu(k,3291) - lu(k,2895) * lu(k,3281) - lu(k,3292) = lu(k,3292) - lu(k,2896) * lu(k,3281) - lu(k,3293) = lu(k,3293) - lu(k,2897) * lu(k,3281) - lu(k,3294) = lu(k,3294) - lu(k,2898) * lu(k,3281) - lu(k,3295) = lu(k,3295) - lu(k,2899) * lu(k,3281) - lu(k,3308) = lu(k,3308) - lu(k,2886) * lu(k,3307) - lu(k,3309) = lu(k,3309) - lu(k,2887) * lu(k,3307) - lu(k,3310) = lu(k,3310) - lu(k,2888) * lu(k,3307) - lu(k,3311) = lu(k,3311) - lu(k,2889) * lu(k,3307) - lu(k,3312) = lu(k,3312) - lu(k,2890) * lu(k,3307) - lu(k,3313) = lu(k,3313) - lu(k,2891) * lu(k,3307) - lu(k,3314) = lu(k,3314) - lu(k,2892) * lu(k,3307) - lu(k,3315) = lu(k,3315) - lu(k,2893) * lu(k,3307) - lu(k,3316) = lu(k,3316) - lu(k,2894) * lu(k,3307) - lu(k,3317) = lu(k,3317) - lu(k,2895) * lu(k,3307) - lu(k,3318) = lu(k,3318) - lu(k,2896) * lu(k,3307) - lu(k,3319) = lu(k,3319) - lu(k,2897) * lu(k,3307) - lu(k,3320) = lu(k,3320) - lu(k,2898) * lu(k,3307) - lu(k,3321) = lu(k,3321) - lu(k,2899) * lu(k,3307) - lu(k,3332) = lu(k,3332) - lu(k,2886) * lu(k,3331) - lu(k,3333) = lu(k,3333) - lu(k,2887) * lu(k,3331) - lu(k,3334) = lu(k,3334) - lu(k,2888) * lu(k,3331) - lu(k,3335) = lu(k,3335) - lu(k,2889) * lu(k,3331) - lu(k,3336) = - lu(k,2890) * lu(k,3331) - lu(k,3337) = lu(k,3337) - lu(k,2891) * lu(k,3331) - lu(k,3338) = lu(k,3338) - lu(k,2892) * lu(k,3331) - lu(k,3339) = lu(k,3339) - lu(k,2893) * lu(k,3331) - lu(k,3340) = lu(k,3340) - lu(k,2894) * lu(k,3331) - lu(k,3341) = lu(k,3341) - lu(k,2895) * lu(k,3331) - lu(k,3342) = lu(k,3342) - lu(k,2896) * lu(k,3331) - lu(k,3343) = lu(k,3343) - lu(k,2897) * lu(k,3331) - lu(k,3344) = lu(k,3344) - lu(k,2898) * lu(k,3331) - lu(k,3345) = lu(k,3345) - lu(k,2899) * lu(k,3331) - lu(k,3423) = lu(k,3423) - lu(k,2886) * lu(k,3422) - lu(k,3424) = lu(k,3424) - lu(k,2887) * lu(k,3422) - lu(k,3425) = lu(k,3425) - lu(k,2888) * lu(k,3422) - lu(k,3426) = lu(k,3426) - lu(k,2889) * lu(k,3422) - lu(k,3427) = lu(k,3427) - lu(k,2890) * lu(k,3422) - lu(k,3428) = lu(k,3428) - lu(k,2891) * lu(k,3422) - lu(k,3429) = lu(k,3429) - lu(k,2892) * lu(k,3422) - lu(k,3430) = lu(k,3430) - lu(k,2893) * lu(k,3422) - lu(k,3431) = lu(k,3431) - lu(k,2894) * lu(k,3422) - lu(k,3432) = lu(k,3432) - lu(k,2895) * lu(k,3422) - lu(k,3433) = lu(k,3433) - lu(k,2896) * lu(k,3422) - lu(k,3434) = - lu(k,2897) * lu(k,3422) - lu(k,3435) = lu(k,3435) - lu(k,2898) * lu(k,3422) - lu(k,3436) = lu(k,3436) - lu(k,2899) * lu(k,3422) - lu(k,3453) = lu(k,3453) - lu(k,2886) * lu(k,3452) - lu(k,3454) = lu(k,3454) - lu(k,2887) * lu(k,3452) - lu(k,3455) = lu(k,3455) - lu(k,2888) * lu(k,3452) - lu(k,3456) = lu(k,3456) - lu(k,2889) * lu(k,3452) - lu(k,3457) = lu(k,3457) - lu(k,2890) * lu(k,3452) - lu(k,3458) = lu(k,3458) - lu(k,2891) * lu(k,3452) - lu(k,3459) = lu(k,3459) - lu(k,2892) * lu(k,3452) - lu(k,3460) = lu(k,3460) - lu(k,2893) * lu(k,3452) - lu(k,3461) = lu(k,3461) - lu(k,2894) * lu(k,3452) - lu(k,3462) = lu(k,3462) - lu(k,2895) * lu(k,3452) - lu(k,3463) = lu(k,3463) - lu(k,2896) * lu(k,3452) - lu(k,3464) = lu(k,3464) - lu(k,2897) * lu(k,3452) - lu(k,3465) = lu(k,3465) - lu(k,2898) * lu(k,3452) - lu(k,3466) = lu(k,3466) - lu(k,2899) * lu(k,3452) - lu(k,3503) = lu(k,3503) - lu(k,2886) * lu(k,3502) - lu(k,3504) = lu(k,3504) - lu(k,2887) * lu(k,3502) - lu(k,3505) = lu(k,3505) - lu(k,2888) * lu(k,3502) - lu(k,3506) = lu(k,3506) - lu(k,2889) * lu(k,3502) - lu(k,3507) = lu(k,3507) - lu(k,2890) * lu(k,3502) - lu(k,3508) = lu(k,3508) - lu(k,2891) * lu(k,3502) - lu(k,3509) = lu(k,3509) - lu(k,2892) * lu(k,3502) - lu(k,3510) = lu(k,3510) - lu(k,2893) * lu(k,3502) - lu(k,3511) = lu(k,3511) - lu(k,2894) * lu(k,3502) - lu(k,3512) = lu(k,3512) - lu(k,2895) * lu(k,3502) - lu(k,3513) = lu(k,3513) - lu(k,2896) * lu(k,3502) - lu(k,3514) = lu(k,3514) - lu(k,2897) * lu(k,3502) - lu(k,3515) = lu(k,3515) - lu(k,2898) * lu(k,3502) - lu(k,3516) = lu(k,3516) - lu(k,2899) * lu(k,3502) - lu(k,3743) = lu(k,3743) - lu(k,2886) * lu(k,3742) - lu(k,3744) = lu(k,3744) - lu(k,2887) * lu(k,3742) - lu(k,3745) = lu(k,3745) - lu(k,2888) * lu(k,3742) - lu(k,3746) = lu(k,3746) - lu(k,2889) * lu(k,3742) - lu(k,3747) = lu(k,3747) - lu(k,2890) * lu(k,3742) - lu(k,3748) = lu(k,3748) - lu(k,2891) * lu(k,3742) - lu(k,3749) = lu(k,3749) - lu(k,2892) * lu(k,3742) - lu(k,3750) = lu(k,3750) - lu(k,2893) * lu(k,3742) - lu(k,3751) = lu(k,3751) - lu(k,2894) * lu(k,3742) - lu(k,3752) = lu(k,3752) - lu(k,2895) * lu(k,3742) - lu(k,3753) = lu(k,3753) - lu(k,2896) * lu(k,3742) - lu(k,3754) = lu(k,3754) - lu(k,2897) * lu(k,3742) - lu(k,3755) = lu(k,3755) - lu(k,2898) * lu(k,3742) - lu(k,3756) = lu(k,3756) - lu(k,2899) * lu(k,3742) - lu(k,3789) = lu(k,3789) - lu(k,2886) * lu(k,3788) - lu(k,3790) = lu(k,3790) - lu(k,2887) * lu(k,3788) - lu(k,3791) = lu(k,3791) - lu(k,2888) * lu(k,3788) - lu(k,3792) = lu(k,3792) - lu(k,2889) * lu(k,3788) - lu(k,3793) = lu(k,3793) - lu(k,2890) * lu(k,3788) - lu(k,3794) = lu(k,3794) - lu(k,2891) * lu(k,3788) - lu(k,3795) = lu(k,3795) - lu(k,2892) * lu(k,3788) - lu(k,3796) = lu(k,3796) - lu(k,2893) * lu(k,3788) - lu(k,3797) = lu(k,3797) - lu(k,2894) * lu(k,3788) - lu(k,3798) = lu(k,3798) - lu(k,2895) * lu(k,3788) - lu(k,3799) = lu(k,3799) - lu(k,2896) * lu(k,3788) - lu(k,3800) = lu(k,3800) - lu(k,2897) * lu(k,3788) - lu(k,3801) = lu(k,3801) - lu(k,2898) * lu(k,3788) - lu(k,3802) = lu(k,3802) - lu(k,2899) * lu(k,3788) - lu(k,3824) = lu(k,3824) - lu(k,2886) * lu(k,3823) - lu(k,3825) = lu(k,3825) - lu(k,2887) * lu(k,3823) - lu(k,3826) = lu(k,3826) - lu(k,2888) * lu(k,3823) - lu(k,3827) = lu(k,3827) - lu(k,2889) * lu(k,3823) - lu(k,3828) = lu(k,3828) - lu(k,2890) * lu(k,3823) - lu(k,3829) = lu(k,3829) - lu(k,2891) * lu(k,3823) - lu(k,3830) = lu(k,3830) - lu(k,2892) * lu(k,3823) - lu(k,3831) = lu(k,3831) - lu(k,2893) * lu(k,3823) - lu(k,3832) = lu(k,3832) - lu(k,2894) * lu(k,3823) - lu(k,3833) = lu(k,3833) - lu(k,2895) * lu(k,3823) - lu(k,3834) = lu(k,3834) - lu(k,2896) * lu(k,3823) - lu(k,3835) = lu(k,3835) - lu(k,2897) * lu(k,3823) - lu(k,3836) = lu(k,3836) - lu(k,2898) * lu(k,3823) - lu(k,3837) = lu(k,3837) - lu(k,2899) * lu(k,3823) - lu(k,3849) = lu(k,3849) - lu(k,2886) * lu(k,3848) - lu(k,3850) = lu(k,3850) - lu(k,2887) * lu(k,3848) - lu(k,3851) = lu(k,3851) - lu(k,2888) * lu(k,3848) - lu(k,3852) = lu(k,3852) - lu(k,2889) * lu(k,3848) - lu(k,3853) = lu(k,3853) - lu(k,2890) * lu(k,3848) - lu(k,3854) = lu(k,3854) - lu(k,2891) * lu(k,3848) - lu(k,3855) = lu(k,3855) - lu(k,2892) * lu(k,3848) - lu(k,3856) = lu(k,3856) - lu(k,2893) * lu(k,3848) - lu(k,3857) = lu(k,3857) - lu(k,2894) * lu(k,3848) - lu(k,3858) = lu(k,3858) - lu(k,2895) * lu(k,3848) - lu(k,3859) = lu(k,3859) - lu(k,2896) * lu(k,3848) - lu(k,3860) = lu(k,3860) - lu(k,2897) * lu(k,3848) - lu(k,3861) = lu(k,3861) - lu(k,2898) * lu(k,3848) - lu(k,3862) = lu(k,3862) - lu(k,2899) * lu(k,3848) - lu(k,2987) = 1._r8 / lu(k,2987) - lu(k,2988) = lu(k,2988) * lu(k,2987) - lu(k,2989) = lu(k,2989) * lu(k,2987) - lu(k,2990) = lu(k,2990) * lu(k,2987) - lu(k,2991) = lu(k,2991) * lu(k,2987) - lu(k,2992) = lu(k,2992) * lu(k,2987) - lu(k,2993) = lu(k,2993) * lu(k,2987) - lu(k,2994) = lu(k,2994) * lu(k,2987) - lu(k,2995) = lu(k,2995) * lu(k,2987) - lu(k,2996) = lu(k,2996) * lu(k,2987) - lu(k,2997) = lu(k,2997) * lu(k,2987) - lu(k,2998) = lu(k,2998) * lu(k,2987) - lu(k,2999) = lu(k,2999) * lu(k,2987) - lu(k,3000) = lu(k,3000) * lu(k,2987) - lu(k,3080) = lu(k,3080) - lu(k,2988) * lu(k,3079) - lu(k,3081) = lu(k,3081) - lu(k,2989) * lu(k,3079) - lu(k,3082) = lu(k,3082) - lu(k,2990) * lu(k,3079) - lu(k,3083) = lu(k,3083) - lu(k,2991) * lu(k,3079) - lu(k,3084) = lu(k,3084) - lu(k,2992) * lu(k,3079) - lu(k,3085) = lu(k,3085) - lu(k,2993) * lu(k,3079) - lu(k,3086) = lu(k,3086) - lu(k,2994) * lu(k,3079) - lu(k,3087) = lu(k,3087) - lu(k,2995) * lu(k,3079) - lu(k,3088) = lu(k,3088) - lu(k,2996) * lu(k,3079) - lu(k,3089) = lu(k,3089) - lu(k,2997) * lu(k,3079) - lu(k,3090) = lu(k,3090) - lu(k,2998) * lu(k,3079) - lu(k,3091) = lu(k,3091) - lu(k,2999) * lu(k,3079) - lu(k,3092) = lu(k,3092) - lu(k,3000) * lu(k,3079) - lu(k,3104) = lu(k,3104) - lu(k,2988) * lu(k,3103) - lu(k,3105) = lu(k,3105) - lu(k,2989) * lu(k,3103) - lu(k,3106) = lu(k,3106) - lu(k,2990) * lu(k,3103) - lu(k,3107) = lu(k,3107) - lu(k,2991) * lu(k,3103) - lu(k,3108) = lu(k,3108) - lu(k,2992) * lu(k,3103) - lu(k,3109) = lu(k,3109) - lu(k,2993) * lu(k,3103) - lu(k,3110) = lu(k,3110) - lu(k,2994) * lu(k,3103) - lu(k,3111) = lu(k,3111) - lu(k,2995) * lu(k,3103) - lu(k,3112) = lu(k,3112) - lu(k,2996) * lu(k,3103) - lu(k,3113) = lu(k,3113) - lu(k,2997) * lu(k,3103) - lu(k,3114) = lu(k,3114) - lu(k,2998) * lu(k,3103) - lu(k,3115) = lu(k,3115) - lu(k,2999) * lu(k,3103) - lu(k,3116) = lu(k,3116) - lu(k,3000) * lu(k,3103) - lu(k,3283) = lu(k,3283) - lu(k,2988) * lu(k,3282) - lu(k,3284) = lu(k,3284) - lu(k,2989) * lu(k,3282) - lu(k,3285) = lu(k,3285) - lu(k,2990) * lu(k,3282) - lu(k,3286) = lu(k,3286) - lu(k,2991) * lu(k,3282) - lu(k,3287) = lu(k,3287) - lu(k,2992) * lu(k,3282) - lu(k,3288) = lu(k,3288) - lu(k,2993) * lu(k,3282) - lu(k,3289) = lu(k,3289) - lu(k,2994) * lu(k,3282) - lu(k,3290) = lu(k,3290) - lu(k,2995) * lu(k,3282) - lu(k,3291) = lu(k,3291) - lu(k,2996) * lu(k,3282) - lu(k,3292) = lu(k,3292) - lu(k,2997) * lu(k,3282) - lu(k,3293) = lu(k,3293) - lu(k,2998) * lu(k,3282) - lu(k,3294) = lu(k,3294) - lu(k,2999) * lu(k,3282) - lu(k,3295) = lu(k,3295) - lu(k,3000) * lu(k,3282) - lu(k,3309) = lu(k,3309) - lu(k,2988) * lu(k,3308) - lu(k,3310) = lu(k,3310) - lu(k,2989) * lu(k,3308) - lu(k,3311) = lu(k,3311) - lu(k,2990) * lu(k,3308) - lu(k,3312) = lu(k,3312) - lu(k,2991) * lu(k,3308) - lu(k,3313) = lu(k,3313) - lu(k,2992) * lu(k,3308) - lu(k,3314) = lu(k,3314) - lu(k,2993) * lu(k,3308) - lu(k,3315) = lu(k,3315) - lu(k,2994) * lu(k,3308) - lu(k,3316) = lu(k,3316) - lu(k,2995) * lu(k,3308) - lu(k,3317) = lu(k,3317) - lu(k,2996) * lu(k,3308) - lu(k,3318) = lu(k,3318) - lu(k,2997) * lu(k,3308) - lu(k,3319) = lu(k,3319) - lu(k,2998) * lu(k,3308) - lu(k,3320) = lu(k,3320) - lu(k,2999) * lu(k,3308) - lu(k,3321) = lu(k,3321) - lu(k,3000) * lu(k,3308) - lu(k,3333) = lu(k,3333) - lu(k,2988) * lu(k,3332) - lu(k,3334) = lu(k,3334) - lu(k,2989) * lu(k,3332) - lu(k,3335) = lu(k,3335) - lu(k,2990) * lu(k,3332) - lu(k,3336) = lu(k,3336) - lu(k,2991) * lu(k,3332) - lu(k,3337) = lu(k,3337) - lu(k,2992) * lu(k,3332) - lu(k,3338) = lu(k,3338) - lu(k,2993) * lu(k,3332) - lu(k,3339) = lu(k,3339) - lu(k,2994) * lu(k,3332) - lu(k,3340) = lu(k,3340) - lu(k,2995) * lu(k,3332) - lu(k,3341) = lu(k,3341) - lu(k,2996) * lu(k,3332) - lu(k,3342) = lu(k,3342) - lu(k,2997) * lu(k,3332) - lu(k,3343) = lu(k,3343) - lu(k,2998) * lu(k,3332) - lu(k,3344) = lu(k,3344) - lu(k,2999) * lu(k,3332) - lu(k,3345) = lu(k,3345) - lu(k,3000) * lu(k,3332) - lu(k,3424) = lu(k,3424) - lu(k,2988) * lu(k,3423) - lu(k,3425) = lu(k,3425) - lu(k,2989) * lu(k,3423) - lu(k,3426) = lu(k,3426) - lu(k,2990) * lu(k,3423) - lu(k,3427) = lu(k,3427) - lu(k,2991) * lu(k,3423) - lu(k,3428) = lu(k,3428) - lu(k,2992) * lu(k,3423) - lu(k,3429) = lu(k,3429) - lu(k,2993) * lu(k,3423) - lu(k,3430) = lu(k,3430) - lu(k,2994) * lu(k,3423) - lu(k,3431) = lu(k,3431) - lu(k,2995) * lu(k,3423) - lu(k,3432) = lu(k,3432) - lu(k,2996) * lu(k,3423) - lu(k,3433) = lu(k,3433) - lu(k,2997) * lu(k,3423) - lu(k,3434) = lu(k,3434) - lu(k,2998) * lu(k,3423) - lu(k,3435) = lu(k,3435) - lu(k,2999) * lu(k,3423) - lu(k,3436) = lu(k,3436) - lu(k,3000) * lu(k,3423) - lu(k,3454) = lu(k,3454) - lu(k,2988) * lu(k,3453) - lu(k,3455) = lu(k,3455) - lu(k,2989) * lu(k,3453) - lu(k,3456) = lu(k,3456) - lu(k,2990) * lu(k,3453) - lu(k,3457) = lu(k,3457) - lu(k,2991) * lu(k,3453) - lu(k,3458) = lu(k,3458) - lu(k,2992) * lu(k,3453) - lu(k,3459) = lu(k,3459) - lu(k,2993) * lu(k,3453) - lu(k,3460) = lu(k,3460) - lu(k,2994) * lu(k,3453) - lu(k,3461) = lu(k,3461) - lu(k,2995) * lu(k,3453) - lu(k,3462) = lu(k,3462) - lu(k,2996) * lu(k,3453) - lu(k,3463) = lu(k,3463) - lu(k,2997) * lu(k,3453) - lu(k,3464) = lu(k,3464) - lu(k,2998) * lu(k,3453) - lu(k,3465) = lu(k,3465) - lu(k,2999) * lu(k,3453) - lu(k,3466) = lu(k,3466) - lu(k,3000) * lu(k,3453) - lu(k,3504) = lu(k,3504) - lu(k,2988) * lu(k,3503) - lu(k,3505) = lu(k,3505) - lu(k,2989) * lu(k,3503) - lu(k,3506) = lu(k,3506) - lu(k,2990) * lu(k,3503) - lu(k,3507) = lu(k,3507) - lu(k,2991) * lu(k,3503) - lu(k,3508) = lu(k,3508) - lu(k,2992) * lu(k,3503) - lu(k,3509) = lu(k,3509) - lu(k,2993) * lu(k,3503) - lu(k,3510) = lu(k,3510) - lu(k,2994) * lu(k,3503) - lu(k,3511) = lu(k,3511) - lu(k,2995) * lu(k,3503) - lu(k,3512) = lu(k,3512) - lu(k,2996) * lu(k,3503) - lu(k,3513) = lu(k,3513) - lu(k,2997) * lu(k,3503) - lu(k,3514) = lu(k,3514) - lu(k,2998) * lu(k,3503) - lu(k,3515) = lu(k,3515) - lu(k,2999) * lu(k,3503) - lu(k,3516) = lu(k,3516) - lu(k,3000) * lu(k,3503) - lu(k,3744) = lu(k,3744) - lu(k,2988) * lu(k,3743) - lu(k,3745) = lu(k,3745) - lu(k,2989) * lu(k,3743) - lu(k,3746) = lu(k,3746) - lu(k,2990) * lu(k,3743) - lu(k,3747) = lu(k,3747) - lu(k,2991) * lu(k,3743) - lu(k,3748) = lu(k,3748) - lu(k,2992) * lu(k,3743) - lu(k,3749) = lu(k,3749) - lu(k,2993) * lu(k,3743) - lu(k,3750) = lu(k,3750) - lu(k,2994) * lu(k,3743) - lu(k,3751) = lu(k,3751) - lu(k,2995) * lu(k,3743) - lu(k,3752) = lu(k,3752) - lu(k,2996) * lu(k,3743) - lu(k,3753) = lu(k,3753) - lu(k,2997) * lu(k,3743) - lu(k,3754) = lu(k,3754) - lu(k,2998) * lu(k,3743) - lu(k,3755) = lu(k,3755) - lu(k,2999) * lu(k,3743) - lu(k,3756) = lu(k,3756) - lu(k,3000) * lu(k,3743) - lu(k,3766) = lu(k,3766) - lu(k,2988) * lu(k,3765) - lu(k,3767) = lu(k,3767) - lu(k,2989) * lu(k,3765) - lu(k,3768) = lu(k,3768) - lu(k,2990) * lu(k,3765) - lu(k,3769) = lu(k,3769) - lu(k,2991) * lu(k,3765) - lu(k,3770) = lu(k,3770) - lu(k,2992) * lu(k,3765) - lu(k,3771) = lu(k,3771) - lu(k,2993) * lu(k,3765) - lu(k,3772) = lu(k,3772) - lu(k,2994) * lu(k,3765) - lu(k,3773) = lu(k,3773) - lu(k,2995) * lu(k,3765) - lu(k,3774) = lu(k,3774) - lu(k,2996) * lu(k,3765) - lu(k,3775) = lu(k,3775) - lu(k,2997) * lu(k,3765) - lu(k,3776) = lu(k,3776) - lu(k,2998) * lu(k,3765) - lu(k,3777) = lu(k,3777) - lu(k,2999) * lu(k,3765) - lu(k,3778) = lu(k,3778) - lu(k,3000) * lu(k,3765) - lu(k,3790) = lu(k,3790) - lu(k,2988) * lu(k,3789) - lu(k,3791) = lu(k,3791) - lu(k,2989) * lu(k,3789) - lu(k,3792) = lu(k,3792) - lu(k,2990) * lu(k,3789) - lu(k,3793) = lu(k,3793) - lu(k,2991) * lu(k,3789) - lu(k,3794) = lu(k,3794) - lu(k,2992) * lu(k,3789) - lu(k,3795) = lu(k,3795) - lu(k,2993) * lu(k,3789) - lu(k,3796) = lu(k,3796) - lu(k,2994) * lu(k,3789) - lu(k,3797) = lu(k,3797) - lu(k,2995) * lu(k,3789) - lu(k,3798) = lu(k,3798) - lu(k,2996) * lu(k,3789) - lu(k,3799) = lu(k,3799) - lu(k,2997) * lu(k,3789) - lu(k,3800) = lu(k,3800) - lu(k,2998) * lu(k,3789) - lu(k,3801) = lu(k,3801) - lu(k,2999) * lu(k,3789) - lu(k,3802) = lu(k,3802) - lu(k,3000) * lu(k,3789) - lu(k,3825) = lu(k,3825) - lu(k,2988) * lu(k,3824) - lu(k,3826) = lu(k,3826) - lu(k,2989) * lu(k,3824) - lu(k,3827) = lu(k,3827) - lu(k,2990) * lu(k,3824) - lu(k,3828) = lu(k,3828) - lu(k,2991) * lu(k,3824) - lu(k,3829) = lu(k,3829) - lu(k,2992) * lu(k,3824) - lu(k,3830) = lu(k,3830) - lu(k,2993) * lu(k,3824) - lu(k,3831) = lu(k,3831) - lu(k,2994) * lu(k,3824) - lu(k,3832) = lu(k,3832) - lu(k,2995) * lu(k,3824) - lu(k,3833) = lu(k,3833) - lu(k,2996) * lu(k,3824) - lu(k,3834) = lu(k,3834) - lu(k,2997) * lu(k,3824) - lu(k,3835) = lu(k,3835) - lu(k,2998) * lu(k,3824) - lu(k,3836) = lu(k,3836) - lu(k,2999) * lu(k,3824) - lu(k,3837) = lu(k,3837) - lu(k,3000) * lu(k,3824) - lu(k,3850) = lu(k,3850) - lu(k,2988) * lu(k,3849) - lu(k,3851) = lu(k,3851) - lu(k,2989) * lu(k,3849) - lu(k,3852) = lu(k,3852) - lu(k,2990) * lu(k,3849) - lu(k,3853) = lu(k,3853) - lu(k,2991) * lu(k,3849) - lu(k,3854) = lu(k,3854) - lu(k,2992) * lu(k,3849) - lu(k,3855) = lu(k,3855) - lu(k,2993) * lu(k,3849) - lu(k,3856) = lu(k,3856) - lu(k,2994) * lu(k,3849) - lu(k,3857) = lu(k,3857) - lu(k,2995) * lu(k,3849) - lu(k,3858) = lu(k,3858) - lu(k,2996) * lu(k,3849) - lu(k,3859) = lu(k,3859) - lu(k,2997) * lu(k,3849) - lu(k,3860) = lu(k,3860) - lu(k,2998) * lu(k,3849) - lu(k,3861) = lu(k,3861) - lu(k,2999) * lu(k,3849) - lu(k,3862) = lu(k,3862) - lu(k,3000) * lu(k,3849) - lu(k,3080) = 1._r8 / lu(k,3080) - lu(k,3081) = lu(k,3081) * lu(k,3080) - lu(k,3082) = lu(k,3082) * lu(k,3080) - lu(k,3083) = lu(k,3083) * lu(k,3080) - lu(k,3084) = lu(k,3084) * lu(k,3080) - lu(k,3085) = lu(k,3085) * lu(k,3080) - lu(k,3086) = lu(k,3086) * lu(k,3080) - lu(k,3087) = lu(k,3087) * lu(k,3080) - lu(k,3088) = lu(k,3088) * lu(k,3080) - lu(k,3089) = lu(k,3089) * lu(k,3080) - lu(k,3090) = lu(k,3090) * lu(k,3080) - lu(k,3091) = lu(k,3091) * lu(k,3080) - lu(k,3092) = lu(k,3092) * lu(k,3080) - lu(k,3105) = lu(k,3105) - lu(k,3081) * lu(k,3104) - lu(k,3106) = lu(k,3106) - lu(k,3082) * lu(k,3104) - lu(k,3107) = lu(k,3107) - lu(k,3083) * lu(k,3104) - lu(k,3108) = lu(k,3108) - lu(k,3084) * lu(k,3104) - lu(k,3109) = lu(k,3109) - lu(k,3085) * lu(k,3104) - lu(k,3110) = lu(k,3110) - lu(k,3086) * lu(k,3104) - lu(k,3111) = lu(k,3111) - lu(k,3087) * lu(k,3104) - lu(k,3112) = lu(k,3112) - lu(k,3088) * lu(k,3104) - lu(k,3113) = lu(k,3113) - lu(k,3089) * lu(k,3104) - lu(k,3114) = lu(k,3114) - lu(k,3090) * lu(k,3104) - lu(k,3115) = lu(k,3115) - lu(k,3091) * lu(k,3104) - lu(k,3116) = lu(k,3116) - lu(k,3092) * lu(k,3104) - lu(k,3284) = lu(k,3284) - lu(k,3081) * lu(k,3283) - lu(k,3285) = lu(k,3285) - lu(k,3082) * lu(k,3283) - lu(k,3286) = lu(k,3286) - lu(k,3083) * lu(k,3283) - lu(k,3287) = lu(k,3287) - lu(k,3084) * lu(k,3283) - lu(k,3288) = lu(k,3288) - lu(k,3085) * lu(k,3283) - lu(k,3289) = lu(k,3289) - lu(k,3086) * lu(k,3283) - lu(k,3290) = lu(k,3290) - lu(k,3087) * lu(k,3283) - lu(k,3291) = lu(k,3291) - lu(k,3088) * lu(k,3283) - lu(k,3292) = lu(k,3292) - lu(k,3089) * lu(k,3283) - lu(k,3293) = lu(k,3293) - lu(k,3090) * lu(k,3283) - lu(k,3294) = lu(k,3294) - lu(k,3091) * lu(k,3283) - lu(k,3295) = lu(k,3295) - lu(k,3092) * lu(k,3283) - lu(k,3310) = lu(k,3310) - lu(k,3081) * lu(k,3309) - lu(k,3311) = lu(k,3311) - lu(k,3082) * lu(k,3309) - lu(k,3312) = lu(k,3312) - lu(k,3083) * lu(k,3309) - lu(k,3313) = lu(k,3313) - lu(k,3084) * lu(k,3309) - lu(k,3314) = lu(k,3314) - lu(k,3085) * lu(k,3309) - lu(k,3315) = lu(k,3315) - lu(k,3086) * lu(k,3309) - lu(k,3316) = lu(k,3316) - lu(k,3087) * lu(k,3309) - lu(k,3317) = lu(k,3317) - lu(k,3088) * lu(k,3309) - lu(k,3318) = lu(k,3318) - lu(k,3089) * lu(k,3309) - lu(k,3319) = lu(k,3319) - lu(k,3090) * lu(k,3309) - lu(k,3320) = lu(k,3320) - lu(k,3091) * lu(k,3309) - lu(k,3321) = lu(k,3321) - lu(k,3092) * lu(k,3309) - lu(k,3334) = lu(k,3334) - lu(k,3081) * lu(k,3333) - lu(k,3335) = lu(k,3335) - lu(k,3082) * lu(k,3333) - lu(k,3336) = lu(k,3336) - lu(k,3083) * lu(k,3333) - lu(k,3337) = lu(k,3337) - lu(k,3084) * lu(k,3333) - lu(k,3338) = lu(k,3338) - lu(k,3085) * lu(k,3333) - lu(k,3339) = lu(k,3339) - lu(k,3086) * lu(k,3333) - lu(k,3340) = lu(k,3340) - lu(k,3087) * lu(k,3333) - lu(k,3341) = lu(k,3341) - lu(k,3088) * lu(k,3333) - lu(k,3342) = lu(k,3342) - lu(k,3089) * lu(k,3333) - lu(k,3343) = lu(k,3343) - lu(k,3090) * lu(k,3333) - lu(k,3344) = lu(k,3344) - lu(k,3091) * lu(k,3333) - lu(k,3345) = lu(k,3345) - lu(k,3092) * lu(k,3333) - lu(k,3425) = lu(k,3425) - lu(k,3081) * lu(k,3424) - lu(k,3426) = lu(k,3426) - lu(k,3082) * lu(k,3424) - lu(k,3427) = lu(k,3427) - lu(k,3083) * lu(k,3424) - lu(k,3428) = lu(k,3428) - lu(k,3084) * lu(k,3424) - lu(k,3429) = lu(k,3429) - lu(k,3085) * lu(k,3424) - lu(k,3430) = lu(k,3430) - lu(k,3086) * lu(k,3424) - lu(k,3431) = lu(k,3431) - lu(k,3087) * lu(k,3424) - lu(k,3432) = lu(k,3432) - lu(k,3088) * lu(k,3424) - lu(k,3433) = lu(k,3433) - lu(k,3089) * lu(k,3424) - lu(k,3434) = lu(k,3434) - lu(k,3090) * lu(k,3424) - lu(k,3435) = lu(k,3435) - lu(k,3091) * lu(k,3424) - lu(k,3436) = lu(k,3436) - lu(k,3092) * lu(k,3424) - lu(k,3455) = lu(k,3455) - lu(k,3081) * lu(k,3454) - lu(k,3456) = lu(k,3456) - lu(k,3082) * lu(k,3454) - lu(k,3457) = lu(k,3457) - lu(k,3083) * lu(k,3454) - lu(k,3458) = lu(k,3458) - lu(k,3084) * lu(k,3454) - lu(k,3459) = lu(k,3459) - lu(k,3085) * lu(k,3454) - lu(k,3460) = lu(k,3460) - lu(k,3086) * lu(k,3454) - lu(k,3461) = lu(k,3461) - lu(k,3087) * lu(k,3454) - lu(k,3462) = lu(k,3462) - lu(k,3088) * lu(k,3454) - lu(k,3463) = lu(k,3463) - lu(k,3089) * lu(k,3454) - lu(k,3464) = lu(k,3464) - lu(k,3090) * lu(k,3454) - lu(k,3465) = lu(k,3465) - lu(k,3091) * lu(k,3454) - lu(k,3466) = lu(k,3466) - lu(k,3092) * lu(k,3454) - lu(k,3505) = lu(k,3505) - lu(k,3081) * lu(k,3504) - lu(k,3506) = lu(k,3506) - lu(k,3082) * lu(k,3504) - lu(k,3507) = lu(k,3507) - lu(k,3083) * lu(k,3504) - lu(k,3508) = lu(k,3508) - lu(k,3084) * lu(k,3504) - lu(k,3509) = lu(k,3509) - lu(k,3085) * lu(k,3504) - lu(k,3510) = lu(k,3510) - lu(k,3086) * lu(k,3504) - lu(k,3511) = lu(k,3511) - lu(k,3087) * lu(k,3504) - lu(k,3512) = lu(k,3512) - lu(k,3088) * lu(k,3504) - lu(k,3513) = lu(k,3513) - lu(k,3089) * lu(k,3504) - lu(k,3514) = lu(k,3514) - lu(k,3090) * lu(k,3504) - lu(k,3515) = lu(k,3515) - lu(k,3091) * lu(k,3504) - lu(k,3516) = lu(k,3516) - lu(k,3092) * lu(k,3504) - lu(k,3745) = lu(k,3745) - lu(k,3081) * lu(k,3744) - lu(k,3746) = lu(k,3746) - lu(k,3082) * lu(k,3744) - lu(k,3747) = lu(k,3747) - lu(k,3083) * lu(k,3744) - lu(k,3748) = lu(k,3748) - lu(k,3084) * lu(k,3744) - lu(k,3749) = lu(k,3749) - lu(k,3085) * lu(k,3744) - lu(k,3750) = lu(k,3750) - lu(k,3086) * lu(k,3744) - lu(k,3751) = lu(k,3751) - lu(k,3087) * lu(k,3744) - lu(k,3752) = lu(k,3752) - lu(k,3088) * lu(k,3744) - lu(k,3753) = lu(k,3753) - lu(k,3089) * lu(k,3744) - lu(k,3754) = lu(k,3754) - lu(k,3090) * lu(k,3744) - lu(k,3755) = lu(k,3755) - lu(k,3091) * lu(k,3744) - lu(k,3756) = lu(k,3756) - lu(k,3092) * lu(k,3744) - lu(k,3767) = lu(k,3767) - lu(k,3081) * lu(k,3766) - lu(k,3768) = lu(k,3768) - lu(k,3082) * lu(k,3766) - lu(k,3769) = lu(k,3769) - lu(k,3083) * lu(k,3766) - lu(k,3770) = lu(k,3770) - lu(k,3084) * lu(k,3766) - lu(k,3771) = lu(k,3771) - lu(k,3085) * lu(k,3766) - lu(k,3772) = lu(k,3772) - lu(k,3086) * lu(k,3766) - lu(k,3773) = lu(k,3773) - lu(k,3087) * lu(k,3766) - lu(k,3774) = lu(k,3774) - lu(k,3088) * lu(k,3766) - lu(k,3775) = lu(k,3775) - lu(k,3089) * lu(k,3766) - lu(k,3776) = lu(k,3776) - lu(k,3090) * lu(k,3766) - lu(k,3777) = lu(k,3777) - lu(k,3091) * lu(k,3766) - lu(k,3778) = lu(k,3778) - lu(k,3092) * lu(k,3766) - lu(k,3791) = lu(k,3791) - lu(k,3081) * lu(k,3790) - lu(k,3792) = lu(k,3792) - lu(k,3082) * lu(k,3790) - lu(k,3793) = lu(k,3793) - lu(k,3083) * lu(k,3790) - lu(k,3794) = lu(k,3794) - lu(k,3084) * lu(k,3790) - lu(k,3795) = lu(k,3795) - lu(k,3085) * lu(k,3790) - lu(k,3796) = lu(k,3796) - lu(k,3086) * lu(k,3790) - lu(k,3797) = lu(k,3797) - lu(k,3087) * lu(k,3790) - lu(k,3798) = lu(k,3798) - lu(k,3088) * lu(k,3790) - lu(k,3799) = lu(k,3799) - lu(k,3089) * lu(k,3790) - lu(k,3800) = lu(k,3800) - lu(k,3090) * lu(k,3790) - lu(k,3801) = lu(k,3801) - lu(k,3091) * lu(k,3790) - lu(k,3802) = lu(k,3802) - lu(k,3092) * lu(k,3790) - lu(k,3826) = lu(k,3826) - lu(k,3081) * lu(k,3825) - lu(k,3827) = lu(k,3827) - lu(k,3082) * lu(k,3825) - lu(k,3828) = lu(k,3828) - lu(k,3083) * lu(k,3825) - lu(k,3829) = lu(k,3829) - lu(k,3084) * lu(k,3825) - lu(k,3830) = lu(k,3830) - lu(k,3085) * lu(k,3825) - lu(k,3831) = lu(k,3831) - lu(k,3086) * lu(k,3825) - lu(k,3832) = lu(k,3832) - lu(k,3087) * lu(k,3825) - lu(k,3833) = lu(k,3833) - lu(k,3088) * lu(k,3825) - lu(k,3834) = lu(k,3834) - lu(k,3089) * lu(k,3825) - lu(k,3835) = lu(k,3835) - lu(k,3090) * lu(k,3825) - lu(k,3836) = lu(k,3836) - lu(k,3091) * lu(k,3825) - lu(k,3837) = lu(k,3837) - lu(k,3092) * lu(k,3825) - lu(k,3851) = lu(k,3851) - lu(k,3081) * lu(k,3850) - lu(k,3852) = lu(k,3852) - lu(k,3082) * lu(k,3850) - lu(k,3853) = lu(k,3853) - lu(k,3083) * lu(k,3850) - lu(k,3854) = lu(k,3854) - lu(k,3084) * lu(k,3850) - lu(k,3855) = lu(k,3855) - lu(k,3085) * lu(k,3850) - lu(k,3856) = lu(k,3856) - lu(k,3086) * lu(k,3850) - lu(k,3857) = lu(k,3857) - lu(k,3087) * lu(k,3850) - lu(k,3858) = lu(k,3858) - lu(k,3088) * lu(k,3850) - lu(k,3859) = lu(k,3859) - lu(k,3089) * lu(k,3850) - lu(k,3860) = lu(k,3860) - lu(k,3090) * lu(k,3850) - lu(k,3861) = lu(k,3861) - lu(k,3091) * lu(k,3850) - lu(k,3862) = lu(k,3862) - lu(k,3092) * lu(k,3850) - lu(k,3105) = 1._r8 / lu(k,3105) - lu(k,3106) = lu(k,3106) * lu(k,3105) - lu(k,3107) = lu(k,3107) * lu(k,3105) - lu(k,3108) = lu(k,3108) * lu(k,3105) - lu(k,3109) = lu(k,3109) * lu(k,3105) - lu(k,3110) = lu(k,3110) * lu(k,3105) - lu(k,3111) = lu(k,3111) * lu(k,3105) - lu(k,3112) = lu(k,3112) * lu(k,3105) - lu(k,3113) = lu(k,3113) * lu(k,3105) - lu(k,3114) = lu(k,3114) * lu(k,3105) - lu(k,3115) = lu(k,3115) * lu(k,3105) - lu(k,3116) = lu(k,3116) * lu(k,3105) - lu(k,3285) = lu(k,3285) - lu(k,3106) * lu(k,3284) - lu(k,3286) = lu(k,3286) - lu(k,3107) * lu(k,3284) - lu(k,3287) = lu(k,3287) - lu(k,3108) * lu(k,3284) - lu(k,3288) = lu(k,3288) - lu(k,3109) * lu(k,3284) - lu(k,3289) = lu(k,3289) - lu(k,3110) * lu(k,3284) - lu(k,3290) = lu(k,3290) - lu(k,3111) * lu(k,3284) - lu(k,3291) = lu(k,3291) - lu(k,3112) * lu(k,3284) - lu(k,3292) = lu(k,3292) - lu(k,3113) * lu(k,3284) - lu(k,3293) = lu(k,3293) - lu(k,3114) * lu(k,3284) - lu(k,3294) = lu(k,3294) - lu(k,3115) * lu(k,3284) - lu(k,3295) = lu(k,3295) - lu(k,3116) * lu(k,3284) - lu(k,3311) = lu(k,3311) - lu(k,3106) * lu(k,3310) - lu(k,3312) = lu(k,3312) - lu(k,3107) * lu(k,3310) - lu(k,3313) = lu(k,3313) - lu(k,3108) * lu(k,3310) - lu(k,3314) = lu(k,3314) - lu(k,3109) * lu(k,3310) - lu(k,3315) = lu(k,3315) - lu(k,3110) * lu(k,3310) - lu(k,3316) = lu(k,3316) - lu(k,3111) * lu(k,3310) - lu(k,3317) = lu(k,3317) - lu(k,3112) * lu(k,3310) - lu(k,3318) = lu(k,3318) - lu(k,3113) * lu(k,3310) - lu(k,3319) = lu(k,3319) - lu(k,3114) * lu(k,3310) - lu(k,3320) = lu(k,3320) - lu(k,3115) * lu(k,3310) - lu(k,3321) = lu(k,3321) - lu(k,3116) * lu(k,3310) - lu(k,3335) = lu(k,3335) - lu(k,3106) * lu(k,3334) - lu(k,3336) = lu(k,3336) - lu(k,3107) * lu(k,3334) - lu(k,3337) = lu(k,3337) - lu(k,3108) * lu(k,3334) - lu(k,3338) = lu(k,3338) - lu(k,3109) * lu(k,3334) - lu(k,3339) = lu(k,3339) - lu(k,3110) * lu(k,3334) - lu(k,3340) = lu(k,3340) - lu(k,3111) * lu(k,3334) - lu(k,3341) = lu(k,3341) - lu(k,3112) * lu(k,3334) - lu(k,3342) = lu(k,3342) - lu(k,3113) * lu(k,3334) - lu(k,3343) = lu(k,3343) - lu(k,3114) * lu(k,3334) - lu(k,3344) = lu(k,3344) - lu(k,3115) * lu(k,3334) - lu(k,3345) = lu(k,3345) - lu(k,3116) * lu(k,3334) - lu(k,3426) = lu(k,3426) - lu(k,3106) * lu(k,3425) - lu(k,3427) = lu(k,3427) - lu(k,3107) * lu(k,3425) - lu(k,3428) = lu(k,3428) - lu(k,3108) * lu(k,3425) - lu(k,3429) = lu(k,3429) - lu(k,3109) * lu(k,3425) - lu(k,3430) = lu(k,3430) - lu(k,3110) * lu(k,3425) - lu(k,3431) = lu(k,3431) - lu(k,3111) * lu(k,3425) - lu(k,3432) = lu(k,3432) - lu(k,3112) * lu(k,3425) - lu(k,3433) = lu(k,3433) - lu(k,3113) * lu(k,3425) - lu(k,3434) = lu(k,3434) - lu(k,3114) * lu(k,3425) - lu(k,3435) = lu(k,3435) - lu(k,3115) * lu(k,3425) - lu(k,3436) = lu(k,3436) - lu(k,3116) * lu(k,3425) - lu(k,3456) = lu(k,3456) - lu(k,3106) * lu(k,3455) - lu(k,3457) = lu(k,3457) - lu(k,3107) * lu(k,3455) - lu(k,3458) = lu(k,3458) - lu(k,3108) * lu(k,3455) - lu(k,3459) = lu(k,3459) - lu(k,3109) * lu(k,3455) - lu(k,3460) = lu(k,3460) - lu(k,3110) * lu(k,3455) - lu(k,3461) = lu(k,3461) - lu(k,3111) * lu(k,3455) - lu(k,3462) = lu(k,3462) - lu(k,3112) * lu(k,3455) - lu(k,3463) = lu(k,3463) - lu(k,3113) * lu(k,3455) - lu(k,3464) = lu(k,3464) - lu(k,3114) * lu(k,3455) - lu(k,3465) = lu(k,3465) - lu(k,3115) * lu(k,3455) - lu(k,3466) = lu(k,3466) - lu(k,3116) * lu(k,3455) - lu(k,3506) = lu(k,3506) - lu(k,3106) * lu(k,3505) - lu(k,3507) = lu(k,3507) - lu(k,3107) * lu(k,3505) - lu(k,3508) = lu(k,3508) - lu(k,3108) * lu(k,3505) - lu(k,3509) = lu(k,3509) - lu(k,3109) * lu(k,3505) - lu(k,3510) = lu(k,3510) - lu(k,3110) * lu(k,3505) - lu(k,3511) = lu(k,3511) - lu(k,3111) * lu(k,3505) - lu(k,3512) = lu(k,3512) - lu(k,3112) * lu(k,3505) - lu(k,3513) = lu(k,3513) - lu(k,3113) * lu(k,3505) - lu(k,3514) = lu(k,3514) - lu(k,3114) * lu(k,3505) - lu(k,3515) = lu(k,3515) - lu(k,3115) * lu(k,3505) - lu(k,3516) = lu(k,3516) - lu(k,3116) * lu(k,3505) - lu(k,3746) = lu(k,3746) - lu(k,3106) * lu(k,3745) - lu(k,3747) = lu(k,3747) - lu(k,3107) * lu(k,3745) - lu(k,3748) = lu(k,3748) - lu(k,3108) * lu(k,3745) - lu(k,3749) = lu(k,3749) - lu(k,3109) * lu(k,3745) - lu(k,3750) = lu(k,3750) - lu(k,3110) * lu(k,3745) - lu(k,3751) = lu(k,3751) - lu(k,3111) * lu(k,3745) - lu(k,3752) = lu(k,3752) - lu(k,3112) * lu(k,3745) - lu(k,3753) = lu(k,3753) - lu(k,3113) * lu(k,3745) - lu(k,3754) = lu(k,3754) - lu(k,3114) * lu(k,3745) - lu(k,3755) = lu(k,3755) - lu(k,3115) * lu(k,3745) - lu(k,3756) = lu(k,3756) - lu(k,3116) * lu(k,3745) - lu(k,3768) = lu(k,3768) - lu(k,3106) * lu(k,3767) - lu(k,3769) = lu(k,3769) - lu(k,3107) * lu(k,3767) - lu(k,3770) = lu(k,3770) - lu(k,3108) * lu(k,3767) - lu(k,3771) = lu(k,3771) - lu(k,3109) * lu(k,3767) - lu(k,3772) = lu(k,3772) - lu(k,3110) * lu(k,3767) - lu(k,3773) = lu(k,3773) - lu(k,3111) * lu(k,3767) - lu(k,3774) = lu(k,3774) - lu(k,3112) * lu(k,3767) - lu(k,3775) = lu(k,3775) - lu(k,3113) * lu(k,3767) - lu(k,3776) = lu(k,3776) - lu(k,3114) * lu(k,3767) - lu(k,3777) = lu(k,3777) - lu(k,3115) * lu(k,3767) - lu(k,3778) = lu(k,3778) - lu(k,3116) * lu(k,3767) - lu(k,3792) = lu(k,3792) - lu(k,3106) * lu(k,3791) - lu(k,3793) = lu(k,3793) - lu(k,3107) * lu(k,3791) - lu(k,3794) = lu(k,3794) - lu(k,3108) * lu(k,3791) - lu(k,3795) = lu(k,3795) - lu(k,3109) * lu(k,3791) - lu(k,3796) = lu(k,3796) - lu(k,3110) * lu(k,3791) - lu(k,3797) = lu(k,3797) - lu(k,3111) * lu(k,3791) - lu(k,3798) = lu(k,3798) - lu(k,3112) * lu(k,3791) - lu(k,3799) = lu(k,3799) - lu(k,3113) * lu(k,3791) - lu(k,3800) = lu(k,3800) - lu(k,3114) * lu(k,3791) - lu(k,3801) = lu(k,3801) - lu(k,3115) * lu(k,3791) - lu(k,3802) = lu(k,3802) - lu(k,3116) * lu(k,3791) - lu(k,3827) = lu(k,3827) - lu(k,3106) * lu(k,3826) - lu(k,3828) = lu(k,3828) - lu(k,3107) * lu(k,3826) - lu(k,3829) = lu(k,3829) - lu(k,3108) * lu(k,3826) - lu(k,3830) = lu(k,3830) - lu(k,3109) * lu(k,3826) - lu(k,3831) = lu(k,3831) - lu(k,3110) * lu(k,3826) - lu(k,3832) = lu(k,3832) - lu(k,3111) * lu(k,3826) - lu(k,3833) = lu(k,3833) - lu(k,3112) * lu(k,3826) - lu(k,3834) = lu(k,3834) - lu(k,3113) * lu(k,3826) - lu(k,3835) = lu(k,3835) - lu(k,3114) * lu(k,3826) - lu(k,3836) = lu(k,3836) - lu(k,3115) * lu(k,3826) - lu(k,3837) = lu(k,3837) - lu(k,3116) * lu(k,3826) - lu(k,3852) = lu(k,3852) - lu(k,3106) * lu(k,3851) - lu(k,3853) = lu(k,3853) - lu(k,3107) * lu(k,3851) - lu(k,3854) = lu(k,3854) - lu(k,3108) * lu(k,3851) - lu(k,3855) = lu(k,3855) - lu(k,3109) * lu(k,3851) - lu(k,3856) = lu(k,3856) - lu(k,3110) * lu(k,3851) - lu(k,3857) = lu(k,3857) - lu(k,3111) * lu(k,3851) - lu(k,3858) = lu(k,3858) - lu(k,3112) * lu(k,3851) - lu(k,3859) = lu(k,3859) - lu(k,3113) * lu(k,3851) - lu(k,3860) = lu(k,3860) - lu(k,3114) * lu(k,3851) - lu(k,3861) = lu(k,3861) - lu(k,3115) * lu(k,3851) - lu(k,3862) = lu(k,3862) - lu(k,3116) * lu(k,3851) + lu(k,2573) = 1._r8 / lu(k,2573) + lu(k,2574) = lu(k,2574) * lu(k,2573) + lu(k,2575) = lu(k,2575) * lu(k,2573) + lu(k,2576) = lu(k,2576) * lu(k,2573) + lu(k,2577) = lu(k,2577) * lu(k,2573) + lu(k,2578) = lu(k,2578) * lu(k,2573) + lu(k,2579) = lu(k,2579) * lu(k,2573) + lu(k,2580) = lu(k,2580) * lu(k,2573) + lu(k,2581) = lu(k,2581) * lu(k,2573) + lu(k,2582) = lu(k,2582) * lu(k,2573) + lu(k,2583) = lu(k,2583) * lu(k,2573) + lu(k,2584) = lu(k,2584) * lu(k,2573) + lu(k,2585) = lu(k,2585) * lu(k,2573) + lu(k,2598) = lu(k,2598) - lu(k,2574) * lu(k,2596) + lu(k,2599) = lu(k,2599) - lu(k,2575) * lu(k,2596) + lu(k,2600) = lu(k,2600) - lu(k,2576) * lu(k,2596) + lu(k,2602) = lu(k,2602) - lu(k,2577) * lu(k,2596) + lu(k,2603) = lu(k,2603) - lu(k,2578) * lu(k,2596) + lu(k,2604) = lu(k,2604) - lu(k,2579) * lu(k,2596) + lu(k,2605) = lu(k,2605) - lu(k,2580) * lu(k,2596) + lu(k,2606) = lu(k,2606) - lu(k,2581) * lu(k,2596) + lu(k,2607) = lu(k,2607) - lu(k,2582) * lu(k,2596) + lu(k,2608) = lu(k,2608) - lu(k,2583) * lu(k,2596) + lu(k,2609) = lu(k,2609) - lu(k,2584) * lu(k,2596) + lu(k,2611) = lu(k,2611) - lu(k,2585) * lu(k,2596) + lu(k,2639) = lu(k,2639) - lu(k,2574) * lu(k,2637) + lu(k,2640) = lu(k,2640) - lu(k,2575) * lu(k,2637) + lu(k,2641) = lu(k,2641) - lu(k,2576) * lu(k,2637) + lu(k,2643) = lu(k,2643) - lu(k,2577) * lu(k,2637) + lu(k,2644) = lu(k,2644) - lu(k,2578) * lu(k,2637) + lu(k,2645) = lu(k,2645) - lu(k,2579) * lu(k,2637) + lu(k,2646) = lu(k,2646) - lu(k,2580) * lu(k,2637) + lu(k,2647) = lu(k,2647) - lu(k,2581) * lu(k,2637) + lu(k,2648) = lu(k,2648) - lu(k,2582) * lu(k,2637) + lu(k,2649) = lu(k,2649) - lu(k,2583) * lu(k,2637) + lu(k,2650) = lu(k,2650) - lu(k,2584) * lu(k,2637) + lu(k,2652) = lu(k,2652) - lu(k,2585) * lu(k,2637) + lu(k,3013) = lu(k,3013) - lu(k,2574) * lu(k,3012) + lu(k,3024) = lu(k,3024) - lu(k,2575) * lu(k,3012) + lu(k,3025) = lu(k,3025) - lu(k,2576) * lu(k,3012) + lu(k,3027) = lu(k,3027) - lu(k,2577) * lu(k,3012) + lu(k,3028) = lu(k,3028) - lu(k,2578) * lu(k,3012) + lu(k,3029) = lu(k,3029) - lu(k,2579) * lu(k,3012) + lu(k,3030) = lu(k,3030) - lu(k,2580) * lu(k,3012) + lu(k,3031) = lu(k,3031) - lu(k,2581) * lu(k,3012) + lu(k,3032) = lu(k,3032) - lu(k,2582) * lu(k,3012) + lu(k,3033) = lu(k,3033) - lu(k,2583) * lu(k,3012) + lu(k,3034) = lu(k,3034) - lu(k,2584) * lu(k,3012) + lu(k,3036) = lu(k,3036) - lu(k,2585) * lu(k,3012) + lu(k,3116) = lu(k,3116) - lu(k,2574) * lu(k,3114) + lu(k,3127) = lu(k,3127) - lu(k,2575) * lu(k,3114) + lu(k,3128) = lu(k,3128) - lu(k,2576) * lu(k,3114) + lu(k,3130) = lu(k,3130) - lu(k,2577) * lu(k,3114) + lu(k,3131) = lu(k,3131) - lu(k,2578) * lu(k,3114) + lu(k,3132) = lu(k,3132) - lu(k,2579) * lu(k,3114) + lu(k,3133) = lu(k,3133) - lu(k,2580) * lu(k,3114) + lu(k,3134) = lu(k,3134) - lu(k,2581) * lu(k,3114) + lu(k,3135) = lu(k,3135) - lu(k,2582) * lu(k,3114) + lu(k,3136) = lu(k,3136) - lu(k,2583) * lu(k,3114) + lu(k,3137) = lu(k,3137) - lu(k,2584) * lu(k,3114) + lu(k,3139) = lu(k,3139) - lu(k,2585) * lu(k,3114) + lu(k,3149) = lu(k,3149) - lu(k,2574) * lu(k,3147) + lu(k,3150) = lu(k,3150) - lu(k,2575) * lu(k,3147) + lu(k,3151) = lu(k,3151) - lu(k,2576) * lu(k,3147) + lu(k,3153) = lu(k,3153) - lu(k,2577) * lu(k,3147) + lu(k,3154) = lu(k,3154) - lu(k,2578) * lu(k,3147) + lu(k,3155) = lu(k,3155) - lu(k,2579) * lu(k,3147) + lu(k,3156) = lu(k,3156) - lu(k,2580) * lu(k,3147) + lu(k,3157) = lu(k,3157) - lu(k,2581) * lu(k,3147) + lu(k,3158) = lu(k,3158) - lu(k,2582) * lu(k,3147) + lu(k,3159) = lu(k,3159) - lu(k,2583) * lu(k,3147) + lu(k,3160) = - lu(k,2584) * lu(k,3147) + lu(k,3162) = lu(k,3162) - lu(k,2585) * lu(k,3147) + lu(k,3298) = lu(k,3298) - lu(k,2574) * lu(k,3296) + lu(k,3309) = lu(k,3309) - lu(k,2575) * lu(k,3296) + lu(k,3310) = lu(k,3310) - lu(k,2576) * lu(k,3296) + lu(k,3312) = lu(k,3312) - lu(k,2577) * lu(k,3296) + lu(k,3313) = lu(k,3313) - lu(k,2578) * lu(k,3296) + lu(k,3314) = lu(k,3314) - lu(k,2579) * lu(k,3296) + lu(k,3315) = lu(k,3315) - lu(k,2580) * lu(k,3296) + lu(k,3316) = lu(k,3316) - lu(k,2581) * lu(k,3296) + lu(k,3317) = lu(k,3317) - lu(k,2582) * lu(k,3296) + lu(k,3318) = lu(k,3318) - lu(k,2583) * lu(k,3296) + lu(k,3319) = lu(k,3319) - lu(k,2584) * lu(k,3296) + lu(k,3321) = lu(k,3321) - lu(k,2585) * lu(k,3296) + lu(k,3327) = lu(k,3327) - lu(k,2574) * lu(k,3326) + lu(k,3328) = - lu(k,2575) * lu(k,3326) + lu(k,3329) = lu(k,3329) - lu(k,2576) * lu(k,3326) + lu(k,3331) = lu(k,3331) - lu(k,2577) * lu(k,3326) + lu(k,3332) = lu(k,3332) - lu(k,2578) * lu(k,3326) + lu(k,3333) = lu(k,3333) - lu(k,2579) * lu(k,3326) + lu(k,3334) = lu(k,3334) - lu(k,2580) * lu(k,3326) + lu(k,3335) = lu(k,3335) - lu(k,2581) * lu(k,3326) + lu(k,3336) = lu(k,3336) - lu(k,2582) * lu(k,3326) + lu(k,3337) = lu(k,3337) - lu(k,2583) * lu(k,3326) + lu(k,3338) = lu(k,3338) - lu(k,2584) * lu(k,3326) + lu(k,3340) = lu(k,3340) - lu(k,2585) * lu(k,3326) + lu(k,3353) = lu(k,3353) - lu(k,2574) * lu(k,3351) + lu(k,3354) = lu(k,3354) - lu(k,2575) * lu(k,3351) + lu(k,3355) = lu(k,3355) - lu(k,2576) * lu(k,3351) + lu(k,3357) = lu(k,3357) - lu(k,2577) * lu(k,3351) + lu(k,3358) = lu(k,3358) - lu(k,2578) * lu(k,3351) + lu(k,3359) = lu(k,3359) - lu(k,2579) * lu(k,3351) + lu(k,3360) = lu(k,3360) - lu(k,2580) * lu(k,3351) + lu(k,3361) = lu(k,3361) - lu(k,2581) * lu(k,3351) + lu(k,3362) = lu(k,3362) - lu(k,2582) * lu(k,3351) + lu(k,3363) = lu(k,3363) - lu(k,2583) * lu(k,3351) + lu(k,3364) = lu(k,3364) - lu(k,2584) * lu(k,3351) + lu(k,3366) = lu(k,3366) - lu(k,2585) * lu(k,3351) + lu(k,3384) = lu(k,3384) - lu(k,2574) * lu(k,3382) + lu(k,3385) = lu(k,3385) - lu(k,2575) * lu(k,3382) + lu(k,3386) = lu(k,3386) - lu(k,2576) * lu(k,3382) + lu(k,3388) = lu(k,3388) - lu(k,2577) * lu(k,3382) + lu(k,3389) = lu(k,3389) - lu(k,2578) * lu(k,3382) + lu(k,3390) = lu(k,3390) - lu(k,2579) * lu(k,3382) + lu(k,3391) = lu(k,3391) - lu(k,2580) * lu(k,3382) + lu(k,3392) = lu(k,3392) - lu(k,2581) * lu(k,3382) + lu(k,3393) = lu(k,3393) - lu(k,2582) * lu(k,3382) + lu(k,3394) = lu(k,3394) - lu(k,2583) * lu(k,3382) + lu(k,3395) = lu(k,3395) - lu(k,2584) * lu(k,3382) + lu(k,3397) = lu(k,3397) - lu(k,2585) * lu(k,3382) + lu(k,3554) = lu(k,3554) - lu(k,2574) * lu(k,3552) + lu(k,3565) = lu(k,3565) - lu(k,2575) * lu(k,3552) + lu(k,3566) = lu(k,3566) - lu(k,2576) * lu(k,3552) + lu(k,3568) = lu(k,3568) - lu(k,2577) * lu(k,3552) + lu(k,3569) = lu(k,3569) - lu(k,2578) * lu(k,3552) + lu(k,3570) = lu(k,3570) - lu(k,2579) * lu(k,3552) + lu(k,3571) = lu(k,3571) - lu(k,2580) * lu(k,3552) + lu(k,3572) = lu(k,3572) - lu(k,2581) * lu(k,3552) + lu(k,3573) = lu(k,3573) - lu(k,2582) * lu(k,3552) + lu(k,3574) = lu(k,3574) - lu(k,2583) * lu(k,3552) + lu(k,3575) = lu(k,3575) - lu(k,2584) * lu(k,3552) + lu(k,3577) = lu(k,3577) - lu(k,2585) * lu(k,3552) + lu(k,3804) = lu(k,3804) - lu(k,2574) * lu(k,3802) + lu(k,3815) = lu(k,3815) - lu(k,2575) * lu(k,3802) + lu(k,3816) = lu(k,3816) - lu(k,2576) * lu(k,3802) + lu(k,3818) = lu(k,3818) - lu(k,2577) * lu(k,3802) + lu(k,3819) = lu(k,3819) - lu(k,2578) * lu(k,3802) + lu(k,3820) = lu(k,3820) - lu(k,2579) * lu(k,3802) + lu(k,3821) = lu(k,3821) - lu(k,2580) * lu(k,3802) + lu(k,3822) = lu(k,3822) - lu(k,2581) * lu(k,3802) + lu(k,3823) = lu(k,3823) - lu(k,2582) * lu(k,3802) + lu(k,3824) = lu(k,3824) - lu(k,2583) * lu(k,3802) + lu(k,3825) = lu(k,3825) - lu(k,2584) * lu(k,3802) + lu(k,3827) = lu(k,3827) - lu(k,2585) * lu(k,3802) + lu(k,3854) = lu(k,3854) - lu(k,2574) * lu(k,3852) + lu(k,3856) = lu(k,3856) - lu(k,2575) * lu(k,3852) + lu(k,3857) = lu(k,3857) - lu(k,2576) * lu(k,3852) + lu(k,3859) = lu(k,3859) - lu(k,2577) * lu(k,3852) + lu(k,3860) = lu(k,3860) - lu(k,2578) * lu(k,3852) + lu(k,3861) = lu(k,3861) - lu(k,2579) * lu(k,3852) + lu(k,3862) = lu(k,3862) - lu(k,2580) * lu(k,3852) + lu(k,3863) = lu(k,3863) - lu(k,2581) * lu(k,3852) + lu(k,3864) = lu(k,3864) - lu(k,2582) * lu(k,3852) + lu(k,3865) = lu(k,3865) - lu(k,2583) * lu(k,3852) + lu(k,3866) = lu(k,3866) - lu(k,2584) * lu(k,3852) + lu(k,3868) = lu(k,3868) - lu(k,2585) * lu(k,3852) + lu(k,3939) = lu(k,3939) - lu(k,2574) * lu(k,3937) + lu(k,3950) = lu(k,3950) - lu(k,2575) * lu(k,3937) + lu(k,3951) = lu(k,3951) - lu(k,2576) * lu(k,3937) + lu(k,3953) = lu(k,3953) - lu(k,2577) * lu(k,3937) + lu(k,3954) = lu(k,3954) - lu(k,2578) * lu(k,3937) + lu(k,3955) = lu(k,3955) - lu(k,2579) * lu(k,3937) + lu(k,3956) = lu(k,3956) - lu(k,2580) * lu(k,3937) + lu(k,3957) = lu(k,3957) - lu(k,2581) * lu(k,3937) + lu(k,3958) = lu(k,3958) - lu(k,2582) * lu(k,3937) + lu(k,3959) = lu(k,3959) - lu(k,2583) * lu(k,3937) + lu(k,3960) = lu(k,3960) - lu(k,2584) * lu(k,3937) + lu(k,3962) = lu(k,3962) - lu(k,2585) * lu(k,3937) + lu(k,4031) = lu(k,4031) - lu(k,2574) * lu(k,4029) + lu(k,4042) = lu(k,4042) - lu(k,2575) * lu(k,4029) + lu(k,4043) = lu(k,4043) - lu(k,2576) * lu(k,4029) + lu(k,4045) = lu(k,4045) - lu(k,2577) * lu(k,4029) + lu(k,4046) = lu(k,4046) - lu(k,2578) * lu(k,4029) + lu(k,4047) = lu(k,4047) - lu(k,2579) * lu(k,4029) + lu(k,4048) = lu(k,4048) - lu(k,2580) * lu(k,4029) + lu(k,4049) = lu(k,4049) - lu(k,2581) * lu(k,4029) + lu(k,4050) = lu(k,4050) - lu(k,2582) * lu(k,4029) + lu(k,4051) = lu(k,4051) - lu(k,2583) * lu(k,4029) + lu(k,4052) = lu(k,4052) - lu(k,2584) * lu(k,4029) + lu(k,4054) = lu(k,4054) - lu(k,2585) * lu(k,4029) + lu(k,4088) = lu(k,4088) - lu(k,2574) * lu(k,4086) + lu(k,4094) = lu(k,4094) - lu(k,2575) * lu(k,4086) + lu(k,4095) = lu(k,4095) - lu(k,2576) * lu(k,4086) + lu(k,4097) = lu(k,4097) - lu(k,2577) * lu(k,4086) + lu(k,4098) = lu(k,4098) - lu(k,2578) * lu(k,4086) + lu(k,4099) = lu(k,4099) - lu(k,2579) * lu(k,4086) + lu(k,4100) = lu(k,4100) - lu(k,2580) * lu(k,4086) + lu(k,4101) = lu(k,4101) - lu(k,2581) * lu(k,4086) + lu(k,4102) = lu(k,4102) - lu(k,2582) * lu(k,4086) + lu(k,4103) = lu(k,4103) - lu(k,2583) * lu(k,4086) + lu(k,4104) = lu(k,4104) - lu(k,2584) * lu(k,4086) + lu(k,4106) = lu(k,4106) - lu(k,2585) * lu(k,4086) + lu(k,4119) = lu(k,4119) - lu(k,2574) * lu(k,4117) + lu(k,4120) = lu(k,4120) - lu(k,2575) * lu(k,4117) + lu(k,4121) = lu(k,4121) - lu(k,2576) * lu(k,4117) + lu(k,4123) = lu(k,4123) - lu(k,2577) * lu(k,4117) + lu(k,4124) = lu(k,4124) - lu(k,2578) * lu(k,4117) + lu(k,4125) = lu(k,4125) - lu(k,2579) * lu(k,4117) + lu(k,4126) = lu(k,4126) - lu(k,2580) * lu(k,4117) + lu(k,4127) = lu(k,4127) - lu(k,2581) * lu(k,4117) + lu(k,4128) = lu(k,4128) - lu(k,2582) * lu(k,4117) + lu(k,4129) = lu(k,4129) - lu(k,2583) * lu(k,4117) + lu(k,4130) = lu(k,4130) - lu(k,2584) * lu(k,4117) + lu(k,4132) = lu(k,4132) - lu(k,2585) * lu(k,4117) + lu(k,2597) = 1._r8 / lu(k,2597) + lu(k,2598) = lu(k,2598) * lu(k,2597) + lu(k,2599) = lu(k,2599) * lu(k,2597) + lu(k,2600) = lu(k,2600) * lu(k,2597) + lu(k,2601) = lu(k,2601) * lu(k,2597) + lu(k,2602) = lu(k,2602) * lu(k,2597) + lu(k,2603) = lu(k,2603) * lu(k,2597) + lu(k,2604) = lu(k,2604) * lu(k,2597) + lu(k,2605) = lu(k,2605) * lu(k,2597) + lu(k,2606) = lu(k,2606) * lu(k,2597) + lu(k,2607) = lu(k,2607) * lu(k,2597) + lu(k,2608) = lu(k,2608) * lu(k,2597) + lu(k,2609) = lu(k,2609) * lu(k,2597) + lu(k,2610) = lu(k,2610) * lu(k,2597) + lu(k,2611) = lu(k,2611) * lu(k,2597) + lu(k,2639) = lu(k,2639) - lu(k,2598) * lu(k,2638) + lu(k,2640) = lu(k,2640) - lu(k,2599) * lu(k,2638) + lu(k,2641) = lu(k,2641) - lu(k,2600) * lu(k,2638) + lu(k,2642) = lu(k,2642) - lu(k,2601) * lu(k,2638) + lu(k,2643) = lu(k,2643) - lu(k,2602) * lu(k,2638) + lu(k,2644) = lu(k,2644) - lu(k,2603) * lu(k,2638) + lu(k,2645) = lu(k,2645) - lu(k,2604) * lu(k,2638) + lu(k,2646) = lu(k,2646) - lu(k,2605) * lu(k,2638) + lu(k,2647) = lu(k,2647) - lu(k,2606) * lu(k,2638) + lu(k,2648) = lu(k,2648) - lu(k,2607) * lu(k,2638) + lu(k,2649) = lu(k,2649) - lu(k,2608) * lu(k,2638) + lu(k,2650) = lu(k,2650) - lu(k,2609) * lu(k,2638) + lu(k,2651) = lu(k,2651) - lu(k,2610) * lu(k,2638) + lu(k,2652) = lu(k,2652) - lu(k,2611) * lu(k,2638) + lu(k,3116) = lu(k,3116) - lu(k,2598) * lu(k,3115) + lu(k,3127) = lu(k,3127) - lu(k,2599) * lu(k,3115) + lu(k,3128) = lu(k,3128) - lu(k,2600) * lu(k,3115) + lu(k,3129) = lu(k,3129) - lu(k,2601) * lu(k,3115) + lu(k,3130) = lu(k,3130) - lu(k,2602) * lu(k,3115) + lu(k,3131) = lu(k,3131) - lu(k,2603) * lu(k,3115) + lu(k,3132) = lu(k,3132) - lu(k,2604) * lu(k,3115) + lu(k,3133) = lu(k,3133) - lu(k,2605) * lu(k,3115) + lu(k,3134) = lu(k,3134) - lu(k,2606) * lu(k,3115) + lu(k,3135) = lu(k,3135) - lu(k,2607) * lu(k,3115) + lu(k,3136) = lu(k,3136) - lu(k,2608) * lu(k,3115) + lu(k,3137) = lu(k,3137) - lu(k,2609) * lu(k,3115) + lu(k,3138) = lu(k,3138) - lu(k,2610) * lu(k,3115) + lu(k,3139) = lu(k,3139) - lu(k,2611) * lu(k,3115) + lu(k,3149) = lu(k,3149) - lu(k,2598) * lu(k,3148) + lu(k,3150) = lu(k,3150) - lu(k,2599) * lu(k,3148) + lu(k,3151) = lu(k,3151) - lu(k,2600) * lu(k,3148) + lu(k,3152) = lu(k,3152) - lu(k,2601) * lu(k,3148) + lu(k,3153) = lu(k,3153) - lu(k,2602) * lu(k,3148) + lu(k,3154) = lu(k,3154) - lu(k,2603) * lu(k,3148) + lu(k,3155) = lu(k,3155) - lu(k,2604) * lu(k,3148) + lu(k,3156) = lu(k,3156) - lu(k,2605) * lu(k,3148) + lu(k,3157) = lu(k,3157) - lu(k,2606) * lu(k,3148) + lu(k,3158) = lu(k,3158) - lu(k,2607) * lu(k,3148) + lu(k,3159) = lu(k,3159) - lu(k,2608) * lu(k,3148) + lu(k,3160) = lu(k,3160) - lu(k,2609) * lu(k,3148) + lu(k,3161) = lu(k,3161) - lu(k,2610) * lu(k,3148) + lu(k,3162) = lu(k,3162) - lu(k,2611) * lu(k,3148) + lu(k,3298) = lu(k,3298) - lu(k,2598) * lu(k,3297) + lu(k,3309) = lu(k,3309) - lu(k,2599) * lu(k,3297) + lu(k,3310) = lu(k,3310) - lu(k,2600) * lu(k,3297) + lu(k,3311) = lu(k,3311) - lu(k,2601) * lu(k,3297) + lu(k,3312) = lu(k,3312) - lu(k,2602) * lu(k,3297) + lu(k,3313) = lu(k,3313) - lu(k,2603) * lu(k,3297) + lu(k,3314) = lu(k,3314) - lu(k,2604) * lu(k,3297) + lu(k,3315) = lu(k,3315) - lu(k,2605) * lu(k,3297) + lu(k,3316) = lu(k,3316) - lu(k,2606) * lu(k,3297) + lu(k,3317) = lu(k,3317) - lu(k,2607) * lu(k,3297) + lu(k,3318) = lu(k,3318) - lu(k,2608) * lu(k,3297) + lu(k,3319) = lu(k,3319) - lu(k,2609) * lu(k,3297) + lu(k,3320) = lu(k,3320) - lu(k,2610) * lu(k,3297) + lu(k,3321) = lu(k,3321) - lu(k,2611) * lu(k,3297) + lu(k,3353) = lu(k,3353) - lu(k,2598) * lu(k,3352) + lu(k,3354) = lu(k,3354) - lu(k,2599) * lu(k,3352) + lu(k,3355) = lu(k,3355) - lu(k,2600) * lu(k,3352) + lu(k,3356) = lu(k,3356) - lu(k,2601) * lu(k,3352) + lu(k,3357) = lu(k,3357) - lu(k,2602) * lu(k,3352) + lu(k,3358) = lu(k,3358) - lu(k,2603) * lu(k,3352) + lu(k,3359) = lu(k,3359) - lu(k,2604) * lu(k,3352) + lu(k,3360) = lu(k,3360) - lu(k,2605) * lu(k,3352) + lu(k,3361) = lu(k,3361) - lu(k,2606) * lu(k,3352) + lu(k,3362) = lu(k,3362) - lu(k,2607) * lu(k,3352) + lu(k,3363) = lu(k,3363) - lu(k,2608) * lu(k,3352) + lu(k,3364) = lu(k,3364) - lu(k,2609) * lu(k,3352) + lu(k,3365) = lu(k,3365) - lu(k,2610) * lu(k,3352) + lu(k,3366) = lu(k,3366) - lu(k,2611) * lu(k,3352) + lu(k,3384) = lu(k,3384) - lu(k,2598) * lu(k,3383) + lu(k,3385) = lu(k,3385) - lu(k,2599) * lu(k,3383) + lu(k,3386) = lu(k,3386) - lu(k,2600) * lu(k,3383) + lu(k,3387) = lu(k,3387) - lu(k,2601) * lu(k,3383) + lu(k,3388) = lu(k,3388) - lu(k,2602) * lu(k,3383) + lu(k,3389) = lu(k,3389) - lu(k,2603) * lu(k,3383) + lu(k,3390) = lu(k,3390) - lu(k,2604) * lu(k,3383) + lu(k,3391) = lu(k,3391) - lu(k,2605) * lu(k,3383) + lu(k,3392) = lu(k,3392) - lu(k,2606) * lu(k,3383) + lu(k,3393) = lu(k,3393) - lu(k,2607) * lu(k,3383) + lu(k,3394) = lu(k,3394) - lu(k,2608) * lu(k,3383) + lu(k,3395) = lu(k,3395) - lu(k,2609) * lu(k,3383) + lu(k,3396) = lu(k,3396) - lu(k,2610) * lu(k,3383) + lu(k,3397) = lu(k,3397) - lu(k,2611) * lu(k,3383) + lu(k,3554) = lu(k,3554) - lu(k,2598) * lu(k,3553) + lu(k,3565) = lu(k,3565) - lu(k,2599) * lu(k,3553) + lu(k,3566) = lu(k,3566) - lu(k,2600) * lu(k,3553) + lu(k,3567) = lu(k,3567) - lu(k,2601) * lu(k,3553) + lu(k,3568) = lu(k,3568) - lu(k,2602) * lu(k,3553) + lu(k,3569) = lu(k,3569) - lu(k,2603) * lu(k,3553) + lu(k,3570) = lu(k,3570) - lu(k,2604) * lu(k,3553) + lu(k,3571) = lu(k,3571) - lu(k,2605) * lu(k,3553) + lu(k,3572) = lu(k,3572) - lu(k,2606) * lu(k,3553) + lu(k,3573) = lu(k,3573) - lu(k,2607) * lu(k,3553) + lu(k,3574) = lu(k,3574) - lu(k,2608) * lu(k,3553) + lu(k,3575) = lu(k,3575) - lu(k,2609) * lu(k,3553) + lu(k,3576) = lu(k,3576) - lu(k,2610) * lu(k,3553) + lu(k,3577) = lu(k,3577) - lu(k,2611) * lu(k,3553) + lu(k,3804) = lu(k,3804) - lu(k,2598) * lu(k,3803) + lu(k,3815) = lu(k,3815) - lu(k,2599) * lu(k,3803) + lu(k,3816) = lu(k,3816) - lu(k,2600) * lu(k,3803) + lu(k,3817) = lu(k,3817) - lu(k,2601) * lu(k,3803) + lu(k,3818) = lu(k,3818) - lu(k,2602) * lu(k,3803) + lu(k,3819) = lu(k,3819) - lu(k,2603) * lu(k,3803) + lu(k,3820) = lu(k,3820) - lu(k,2604) * lu(k,3803) + lu(k,3821) = lu(k,3821) - lu(k,2605) * lu(k,3803) + lu(k,3822) = lu(k,3822) - lu(k,2606) * lu(k,3803) + lu(k,3823) = lu(k,3823) - lu(k,2607) * lu(k,3803) + lu(k,3824) = lu(k,3824) - lu(k,2608) * lu(k,3803) + lu(k,3825) = lu(k,3825) - lu(k,2609) * lu(k,3803) + lu(k,3826) = lu(k,3826) - lu(k,2610) * lu(k,3803) + lu(k,3827) = lu(k,3827) - lu(k,2611) * lu(k,3803) + lu(k,3854) = lu(k,3854) - lu(k,2598) * lu(k,3853) + lu(k,3856) = lu(k,3856) - lu(k,2599) * lu(k,3853) + lu(k,3857) = lu(k,3857) - lu(k,2600) * lu(k,3853) + lu(k,3858) = lu(k,3858) - lu(k,2601) * lu(k,3853) + lu(k,3859) = lu(k,3859) - lu(k,2602) * lu(k,3853) + lu(k,3860) = lu(k,3860) - lu(k,2603) * lu(k,3853) + lu(k,3861) = lu(k,3861) - lu(k,2604) * lu(k,3853) + lu(k,3862) = lu(k,3862) - lu(k,2605) * lu(k,3853) + lu(k,3863) = lu(k,3863) - lu(k,2606) * lu(k,3853) + lu(k,3864) = lu(k,3864) - lu(k,2607) * lu(k,3853) + lu(k,3865) = lu(k,3865) - lu(k,2608) * lu(k,3853) + lu(k,3866) = lu(k,3866) - lu(k,2609) * lu(k,3853) + lu(k,3867) = lu(k,3867) - lu(k,2610) * lu(k,3853) + lu(k,3868) = lu(k,3868) - lu(k,2611) * lu(k,3853) + lu(k,3939) = lu(k,3939) - lu(k,2598) * lu(k,3938) + lu(k,3950) = lu(k,3950) - lu(k,2599) * lu(k,3938) + lu(k,3951) = lu(k,3951) - lu(k,2600) * lu(k,3938) + lu(k,3952) = lu(k,3952) - lu(k,2601) * lu(k,3938) + lu(k,3953) = lu(k,3953) - lu(k,2602) * lu(k,3938) + lu(k,3954) = lu(k,3954) - lu(k,2603) * lu(k,3938) + lu(k,3955) = lu(k,3955) - lu(k,2604) * lu(k,3938) + lu(k,3956) = lu(k,3956) - lu(k,2605) * lu(k,3938) + lu(k,3957) = lu(k,3957) - lu(k,2606) * lu(k,3938) + lu(k,3958) = lu(k,3958) - lu(k,2607) * lu(k,3938) + lu(k,3959) = lu(k,3959) - lu(k,2608) * lu(k,3938) + lu(k,3960) = lu(k,3960) - lu(k,2609) * lu(k,3938) + lu(k,3961) = lu(k,3961) - lu(k,2610) * lu(k,3938) + lu(k,3962) = lu(k,3962) - lu(k,2611) * lu(k,3938) + lu(k,4031) = lu(k,4031) - lu(k,2598) * lu(k,4030) + lu(k,4042) = lu(k,4042) - lu(k,2599) * lu(k,4030) + lu(k,4043) = lu(k,4043) - lu(k,2600) * lu(k,4030) + lu(k,4044) = lu(k,4044) - lu(k,2601) * lu(k,4030) + lu(k,4045) = lu(k,4045) - lu(k,2602) * lu(k,4030) + lu(k,4046) = lu(k,4046) - lu(k,2603) * lu(k,4030) + lu(k,4047) = lu(k,4047) - lu(k,2604) * lu(k,4030) + lu(k,4048) = lu(k,4048) - lu(k,2605) * lu(k,4030) + lu(k,4049) = lu(k,4049) - lu(k,2606) * lu(k,4030) + lu(k,4050) = lu(k,4050) - lu(k,2607) * lu(k,4030) + lu(k,4051) = lu(k,4051) - lu(k,2608) * lu(k,4030) + lu(k,4052) = lu(k,4052) - lu(k,2609) * lu(k,4030) + lu(k,4053) = lu(k,4053) - lu(k,2610) * lu(k,4030) + lu(k,4054) = lu(k,4054) - lu(k,2611) * lu(k,4030) + lu(k,4088) = lu(k,4088) - lu(k,2598) * lu(k,4087) + lu(k,4094) = lu(k,4094) - lu(k,2599) * lu(k,4087) + lu(k,4095) = lu(k,4095) - lu(k,2600) * lu(k,4087) + lu(k,4096) = lu(k,4096) - lu(k,2601) * lu(k,4087) + lu(k,4097) = lu(k,4097) - lu(k,2602) * lu(k,4087) + lu(k,4098) = lu(k,4098) - lu(k,2603) * lu(k,4087) + lu(k,4099) = lu(k,4099) - lu(k,2604) * lu(k,4087) + lu(k,4100) = lu(k,4100) - lu(k,2605) * lu(k,4087) + lu(k,4101) = lu(k,4101) - lu(k,2606) * lu(k,4087) + lu(k,4102) = lu(k,4102) - lu(k,2607) * lu(k,4087) + lu(k,4103) = lu(k,4103) - lu(k,2608) * lu(k,4087) + lu(k,4104) = lu(k,4104) - lu(k,2609) * lu(k,4087) + lu(k,4105) = lu(k,4105) - lu(k,2610) * lu(k,4087) + lu(k,4106) = lu(k,4106) - lu(k,2611) * lu(k,4087) + lu(k,4119) = lu(k,4119) - lu(k,2598) * lu(k,4118) + lu(k,4120) = lu(k,4120) - lu(k,2599) * lu(k,4118) + lu(k,4121) = lu(k,4121) - lu(k,2600) * lu(k,4118) + lu(k,4122) = lu(k,4122) - lu(k,2601) * lu(k,4118) + lu(k,4123) = lu(k,4123) - lu(k,2602) * lu(k,4118) + lu(k,4124) = lu(k,4124) - lu(k,2603) * lu(k,4118) + lu(k,4125) = lu(k,4125) - lu(k,2604) * lu(k,4118) + lu(k,4126) = lu(k,4126) - lu(k,2605) * lu(k,4118) + lu(k,4127) = lu(k,4127) - lu(k,2606) * lu(k,4118) + lu(k,4128) = lu(k,4128) - lu(k,2607) * lu(k,4118) + lu(k,4129) = lu(k,4129) - lu(k,2608) * lu(k,4118) + lu(k,4130) = lu(k,4130) - lu(k,2609) * lu(k,4118) + lu(k,4131) = lu(k,4131) - lu(k,2610) * lu(k,4118) + lu(k,4132) = lu(k,4132) - lu(k,2611) * lu(k,4118) + lu(k,2639) = 1._r8 / lu(k,2639) + lu(k,2640) = lu(k,2640) * lu(k,2639) + lu(k,2641) = lu(k,2641) * lu(k,2639) + lu(k,2642) = lu(k,2642) * lu(k,2639) + lu(k,2643) = lu(k,2643) * lu(k,2639) + lu(k,2644) = lu(k,2644) * lu(k,2639) + lu(k,2645) = lu(k,2645) * lu(k,2639) + lu(k,2646) = lu(k,2646) * lu(k,2639) + lu(k,2647) = lu(k,2647) * lu(k,2639) + lu(k,2648) = lu(k,2648) * lu(k,2639) + lu(k,2649) = lu(k,2649) * lu(k,2639) + lu(k,2650) = lu(k,2650) * lu(k,2639) + lu(k,2651) = lu(k,2651) * lu(k,2639) + lu(k,2652) = lu(k,2652) * lu(k,2639) + lu(k,3024) = lu(k,3024) - lu(k,2640) * lu(k,3013) + lu(k,3025) = lu(k,3025) - lu(k,2641) * lu(k,3013) + lu(k,3026) = lu(k,3026) - lu(k,2642) * lu(k,3013) + lu(k,3027) = lu(k,3027) - lu(k,2643) * lu(k,3013) + lu(k,3028) = lu(k,3028) - lu(k,2644) * lu(k,3013) + lu(k,3029) = lu(k,3029) - lu(k,2645) * lu(k,3013) + lu(k,3030) = lu(k,3030) - lu(k,2646) * lu(k,3013) + lu(k,3031) = lu(k,3031) - lu(k,2647) * lu(k,3013) + lu(k,3032) = lu(k,3032) - lu(k,2648) * lu(k,3013) + lu(k,3033) = lu(k,3033) - lu(k,2649) * lu(k,3013) + lu(k,3034) = lu(k,3034) - lu(k,2650) * lu(k,3013) + lu(k,3035) = lu(k,3035) - lu(k,2651) * lu(k,3013) + lu(k,3036) = lu(k,3036) - lu(k,2652) * lu(k,3013) + lu(k,3127) = lu(k,3127) - lu(k,2640) * lu(k,3116) + lu(k,3128) = lu(k,3128) - lu(k,2641) * lu(k,3116) + lu(k,3129) = lu(k,3129) - lu(k,2642) * lu(k,3116) + lu(k,3130) = lu(k,3130) - lu(k,2643) * lu(k,3116) + lu(k,3131) = lu(k,3131) - lu(k,2644) * lu(k,3116) + lu(k,3132) = lu(k,3132) - lu(k,2645) * lu(k,3116) + lu(k,3133) = lu(k,3133) - lu(k,2646) * lu(k,3116) + lu(k,3134) = lu(k,3134) - lu(k,2647) * lu(k,3116) + lu(k,3135) = lu(k,3135) - lu(k,2648) * lu(k,3116) + lu(k,3136) = lu(k,3136) - lu(k,2649) * lu(k,3116) + lu(k,3137) = lu(k,3137) - lu(k,2650) * lu(k,3116) + lu(k,3138) = lu(k,3138) - lu(k,2651) * lu(k,3116) + lu(k,3139) = lu(k,3139) - lu(k,2652) * lu(k,3116) + lu(k,3150) = lu(k,3150) - lu(k,2640) * lu(k,3149) + lu(k,3151) = lu(k,3151) - lu(k,2641) * lu(k,3149) + lu(k,3152) = lu(k,3152) - lu(k,2642) * lu(k,3149) + lu(k,3153) = lu(k,3153) - lu(k,2643) * lu(k,3149) + lu(k,3154) = lu(k,3154) - lu(k,2644) * lu(k,3149) + lu(k,3155) = lu(k,3155) - lu(k,2645) * lu(k,3149) + lu(k,3156) = lu(k,3156) - lu(k,2646) * lu(k,3149) + lu(k,3157) = lu(k,3157) - lu(k,2647) * lu(k,3149) + lu(k,3158) = lu(k,3158) - lu(k,2648) * lu(k,3149) + lu(k,3159) = lu(k,3159) - lu(k,2649) * lu(k,3149) + lu(k,3160) = lu(k,3160) - lu(k,2650) * lu(k,3149) + lu(k,3161) = lu(k,3161) - lu(k,2651) * lu(k,3149) + lu(k,3162) = lu(k,3162) - lu(k,2652) * lu(k,3149) + lu(k,3309) = lu(k,3309) - lu(k,2640) * lu(k,3298) + lu(k,3310) = lu(k,3310) - lu(k,2641) * lu(k,3298) + lu(k,3311) = lu(k,3311) - lu(k,2642) * lu(k,3298) + lu(k,3312) = lu(k,3312) - lu(k,2643) * lu(k,3298) + lu(k,3313) = lu(k,3313) - lu(k,2644) * lu(k,3298) + lu(k,3314) = lu(k,3314) - lu(k,2645) * lu(k,3298) + lu(k,3315) = lu(k,3315) - lu(k,2646) * lu(k,3298) + lu(k,3316) = lu(k,3316) - lu(k,2647) * lu(k,3298) + lu(k,3317) = lu(k,3317) - lu(k,2648) * lu(k,3298) + lu(k,3318) = lu(k,3318) - lu(k,2649) * lu(k,3298) + lu(k,3319) = lu(k,3319) - lu(k,2650) * lu(k,3298) + lu(k,3320) = lu(k,3320) - lu(k,2651) * lu(k,3298) + lu(k,3321) = lu(k,3321) - lu(k,2652) * lu(k,3298) + lu(k,3328) = lu(k,3328) - lu(k,2640) * lu(k,3327) + lu(k,3329) = lu(k,3329) - lu(k,2641) * lu(k,3327) + lu(k,3330) = - lu(k,2642) * lu(k,3327) + lu(k,3331) = lu(k,3331) - lu(k,2643) * lu(k,3327) + lu(k,3332) = lu(k,3332) - lu(k,2644) * lu(k,3327) + lu(k,3333) = lu(k,3333) - lu(k,2645) * lu(k,3327) + lu(k,3334) = lu(k,3334) - lu(k,2646) * lu(k,3327) + lu(k,3335) = lu(k,3335) - lu(k,2647) * lu(k,3327) + lu(k,3336) = lu(k,3336) - lu(k,2648) * lu(k,3327) + lu(k,3337) = lu(k,3337) - lu(k,2649) * lu(k,3327) + lu(k,3338) = lu(k,3338) - lu(k,2650) * lu(k,3327) + lu(k,3339) = lu(k,3339) - lu(k,2651) * lu(k,3327) + lu(k,3340) = lu(k,3340) - lu(k,2652) * lu(k,3327) + lu(k,3354) = lu(k,3354) - lu(k,2640) * lu(k,3353) + lu(k,3355) = lu(k,3355) - lu(k,2641) * lu(k,3353) + lu(k,3356) = lu(k,3356) - lu(k,2642) * lu(k,3353) + lu(k,3357) = lu(k,3357) - lu(k,2643) * lu(k,3353) + lu(k,3358) = lu(k,3358) - lu(k,2644) * lu(k,3353) + lu(k,3359) = lu(k,3359) - lu(k,2645) * lu(k,3353) + lu(k,3360) = lu(k,3360) - lu(k,2646) * lu(k,3353) + lu(k,3361) = lu(k,3361) - lu(k,2647) * lu(k,3353) + lu(k,3362) = lu(k,3362) - lu(k,2648) * lu(k,3353) + lu(k,3363) = lu(k,3363) - lu(k,2649) * lu(k,3353) + lu(k,3364) = lu(k,3364) - lu(k,2650) * lu(k,3353) + lu(k,3365) = lu(k,3365) - lu(k,2651) * lu(k,3353) + lu(k,3366) = lu(k,3366) - lu(k,2652) * lu(k,3353) + lu(k,3385) = lu(k,3385) - lu(k,2640) * lu(k,3384) + lu(k,3386) = lu(k,3386) - lu(k,2641) * lu(k,3384) + lu(k,3387) = lu(k,3387) - lu(k,2642) * lu(k,3384) + lu(k,3388) = lu(k,3388) - lu(k,2643) * lu(k,3384) + lu(k,3389) = lu(k,3389) - lu(k,2644) * lu(k,3384) + lu(k,3390) = lu(k,3390) - lu(k,2645) * lu(k,3384) + lu(k,3391) = lu(k,3391) - lu(k,2646) * lu(k,3384) + lu(k,3392) = lu(k,3392) - lu(k,2647) * lu(k,3384) + lu(k,3393) = lu(k,3393) - lu(k,2648) * lu(k,3384) + lu(k,3394) = lu(k,3394) - lu(k,2649) * lu(k,3384) + lu(k,3395) = lu(k,3395) - lu(k,2650) * lu(k,3384) + lu(k,3396) = lu(k,3396) - lu(k,2651) * lu(k,3384) + lu(k,3397) = lu(k,3397) - lu(k,2652) * lu(k,3384) + lu(k,3565) = lu(k,3565) - lu(k,2640) * lu(k,3554) + lu(k,3566) = lu(k,3566) - lu(k,2641) * lu(k,3554) + lu(k,3567) = lu(k,3567) - lu(k,2642) * lu(k,3554) + lu(k,3568) = lu(k,3568) - lu(k,2643) * lu(k,3554) + lu(k,3569) = lu(k,3569) - lu(k,2644) * lu(k,3554) + lu(k,3570) = lu(k,3570) - lu(k,2645) * lu(k,3554) + lu(k,3571) = lu(k,3571) - lu(k,2646) * lu(k,3554) + lu(k,3572) = lu(k,3572) - lu(k,2647) * lu(k,3554) + lu(k,3573) = lu(k,3573) - lu(k,2648) * lu(k,3554) + lu(k,3574) = lu(k,3574) - lu(k,2649) * lu(k,3554) + lu(k,3575) = lu(k,3575) - lu(k,2650) * lu(k,3554) + lu(k,3576) = lu(k,3576) - lu(k,2651) * lu(k,3554) + lu(k,3577) = lu(k,3577) - lu(k,2652) * lu(k,3554) + lu(k,3815) = lu(k,3815) - lu(k,2640) * lu(k,3804) + lu(k,3816) = lu(k,3816) - lu(k,2641) * lu(k,3804) + lu(k,3817) = lu(k,3817) - lu(k,2642) * lu(k,3804) + lu(k,3818) = lu(k,3818) - lu(k,2643) * lu(k,3804) + lu(k,3819) = lu(k,3819) - lu(k,2644) * lu(k,3804) + lu(k,3820) = lu(k,3820) - lu(k,2645) * lu(k,3804) + lu(k,3821) = lu(k,3821) - lu(k,2646) * lu(k,3804) + lu(k,3822) = lu(k,3822) - lu(k,2647) * lu(k,3804) + lu(k,3823) = lu(k,3823) - lu(k,2648) * lu(k,3804) + lu(k,3824) = lu(k,3824) - lu(k,2649) * lu(k,3804) + lu(k,3825) = lu(k,3825) - lu(k,2650) * lu(k,3804) + lu(k,3826) = lu(k,3826) - lu(k,2651) * lu(k,3804) + lu(k,3827) = lu(k,3827) - lu(k,2652) * lu(k,3804) + lu(k,3856) = lu(k,3856) - lu(k,2640) * lu(k,3854) + lu(k,3857) = lu(k,3857) - lu(k,2641) * lu(k,3854) + lu(k,3858) = lu(k,3858) - lu(k,2642) * lu(k,3854) + lu(k,3859) = lu(k,3859) - lu(k,2643) * lu(k,3854) + lu(k,3860) = lu(k,3860) - lu(k,2644) * lu(k,3854) + lu(k,3861) = lu(k,3861) - lu(k,2645) * lu(k,3854) + lu(k,3862) = lu(k,3862) - lu(k,2646) * lu(k,3854) + lu(k,3863) = lu(k,3863) - lu(k,2647) * lu(k,3854) + lu(k,3864) = lu(k,3864) - lu(k,2648) * lu(k,3854) + lu(k,3865) = lu(k,3865) - lu(k,2649) * lu(k,3854) + lu(k,3866) = lu(k,3866) - lu(k,2650) * lu(k,3854) + lu(k,3867) = lu(k,3867) - lu(k,2651) * lu(k,3854) + lu(k,3868) = lu(k,3868) - lu(k,2652) * lu(k,3854) + lu(k,3950) = lu(k,3950) - lu(k,2640) * lu(k,3939) + lu(k,3951) = lu(k,3951) - lu(k,2641) * lu(k,3939) + lu(k,3952) = lu(k,3952) - lu(k,2642) * lu(k,3939) + lu(k,3953) = lu(k,3953) - lu(k,2643) * lu(k,3939) + lu(k,3954) = lu(k,3954) - lu(k,2644) * lu(k,3939) + lu(k,3955) = lu(k,3955) - lu(k,2645) * lu(k,3939) + lu(k,3956) = lu(k,3956) - lu(k,2646) * lu(k,3939) + lu(k,3957) = lu(k,3957) - lu(k,2647) * lu(k,3939) + lu(k,3958) = lu(k,3958) - lu(k,2648) * lu(k,3939) + lu(k,3959) = lu(k,3959) - lu(k,2649) * lu(k,3939) + lu(k,3960) = lu(k,3960) - lu(k,2650) * lu(k,3939) + lu(k,3961) = lu(k,3961) - lu(k,2651) * lu(k,3939) + lu(k,3962) = lu(k,3962) - lu(k,2652) * lu(k,3939) + lu(k,4042) = lu(k,4042) - lu(k,2640) * lu(k,4031) + lu(k,4043) = lu(k,4043) - lu(k,2641) * lu(k,4031) + lu(k,4044) = lu(k,4044) - lu(k,2642) * lu(k,4031) + lu(k,4045) = lu(k,4045) - lu(k,2643) * lu(k,4031) + lu(k,4046) = lu(k,4046) - lu(k,2644) * lu(k,4031) + lu(k,4047) = lu(k,4047) - lu(k,2645) * lu(k,4031) + lu(k,4048) = lu(k,4048) - lu(k,2646) * lu(k,4031) + lu(k,4049) = lu(k,4049) - lu(k,2647) * lu(k,4031) + lu(k,4050) = lu(k,4050) - lu(k,2648) * lu(k,4031) + lu(k,4051) = lu(k,4051) - lu(k,2649) * lu(k,4031) + lu(k,4052) = lu(k,4052) - lu(k,2650) * lu(k,4031) + lu(k,4053) = lu(k,4053) - lu(k,2651) * lu(k,4031) + lu(k,4054) = lu(k,4054) - lu(k,2652) * lu(k,4031) + lu(k,4094) = lu(k,4094) - lu(k,2640) * lu(k,4088) + lu(k,4095) = lu(k,4095) - lu(k,2641) * lu(k,4088) + lu(k,4096) = lu(k,4096) - lu(k,2642) * lu(k,4088) + lu(k,4097) = lu(k,4097) - lu(k,2643) * lu(k,4088) + lu(k,4098) = lu(k,4098) - lu(k,2644) * lu(k,4088) + lu(k,4099) = lu(k,4099) - lu(k,2645) * lu(k,4088) + lu(k,4100) = lu(k,4100) - lu(k,2646) * lu(k,4088) + lu(k,4101) = lu(k,4101) - lu(k,2647) * lu(k,4088) + lu(k,4102) = lu(k,4102) - lu(k,2648) * lu(k,4088) + lu(k,4103) = lu(k,4103) - lu(k,2649) * lu(k,4088) + lu(k,4104) = lu(k,4104) - lu(k,2650) * lu(k,4088) + lu(k,4105) = lu(k,4105) - lu(k,2651) * lu(k,4088) + lu(k,4106) = lu(k,4106) - lu(k,2652) * lu(k,4088) + lu(k,4120) = lu(k,4120) - lu(k,2640) * lu(k,4119) + lu(k,4121) = lu(k,4121) - lu(k,2641) * lu(k,4119) + lu(k,4122) = lu(k,4122) - lu(k,2642) * lu(k,4119) + lu(k,4123) = lu(k,4123) - lu(k,2643) * lu(k,4119) + lu(k,4124) = lu(k,4124) - lu(k,2644) * lu(k,4119) + lu(k,4125) = lu(k,4125) - lu(k,2645) * lu(k,4119) + lu(k,4126) = lu(k,4126) - lu(k,2646) * lu(k,4119) + lu(k,4127) = lu(k,4127) - lu(k,2647) * lu(k,4119) + lu(k,4128) = lu(k,4128) - lu(k,2648) * lu(k,4119) + lu(k,4129) = lu(k,4129) - lu(k,2649) * lu(k,4119) + lu(k,4130) = lu(k,4130) - lu(k,2650) * lu(k,4119) + lu(k,4131) = lu(k,4131) - lu(k,2651) * lu(k,4119) + lu(k,4132) = lu(k,4132) - lu(k,2652) * lu(k,4119) + lu(k,2663) = 1._r8 / lu(k,2663) + lu(k,2664) = lu(k,2664) * lu(k,2663) + lu(k,2665) = lu(k,2665) * lu(k,2663) + lu(k,2666) = lu(k,2666) * lu(k,2663) + lu(k,2667) = lu(k,2667) * lu(k,2663) + lu(k,2668) = lu(k,2668) * lu(k,2663) + lu(k,2669) = lu(k,2669) * lu(k,2663) + lu(k,2670) = lu(k,2670) * lu(k,2663) + lu(k,2671) = lu(k,2671) * lu(k,2663) + lu(k,2672) = lu(k,2672) * lu(k,2663) + lu(k,2673) = lu(k,2673) * lu(k,2663) + lu(k,2674) = lu(k,2674) * lu(k,2663) + lu(k,2675) = lu(k,2675) * lu(k,2663) + lu(k,2676) = lu(k,2676) * lu(k,2663) + lu(k,2677) = lu(k,2677) * lu(k,2663) + lu(k,2678) = lu(k,2678) * lu(k,2663) + lu(k,2679) = lu(k,2679) * lu(k,2663) + lu(k,2680) = lu(k,2680) * lu(k,2663) + lu(k,2701) = lu(k,2701) - lu(k,2664) * lu(k,2699) + lu(k,2702) = lu(k,2702) - lu(k,2665) * lu(k,2699) + lu(k,2703) = lu(k,2703) - lu(k,2666) * lu(k,2699) + lu(k,2704) = lu(k,2704) - lu(k,2667) * lu(k,2699) + lu(k,2705) = lu(k,2705) - lu(k,2668) * lu(k,2699) + lu(k,2708) = lu(k,2708) - lu(k,2669) * lu(k,2699) + lu(k,2709) = lu(k,2709) - lu(k,2670) * lu(k,2699) + lu(k,2710) = lu(k,2710) - lu(k,2671) * lu(k,2699) + lu(k,2711) = lu(k,2711) - lu(k,2672) * lu(k,2699) + lu(k,2712) = lu(k,2712) - lu(k,2673) * lu(k,2699) + lu(k,2713) = lu(k,2713) - lu(k,2674) * lu(k,2699) + lu(k,2714) = lu(k,2714) - lu(k,2675) * lu(k,2699) + lu(k,2715) = lu(k,2715) - lu(k,2676) * lu(k,2699) + lu(k,2716) = lu(k,2716) - lu(k,2677) * lu(k,2699) + lu(k,2717) = lu(k,2717) - lu(k,2678) * lu(k,2699) + lu(k,2719) = lu(k,2719) - lu(k,2679) * lu(k,2699) + lu(k,2720) = lu(k,2720) - lu(k,2680) * lu(k,2699) + lu(k,2803) = lu(k,2803) - lu(k,2664) * lu(k,2802) + lu(k,2804) = lu(k,2804) - lu(k,2665) * lu(k,2802) + lu(k,2805) = lu(k,2805) - lu(k,2666) * lu(k,2802) + lu(k,2807) = lu(k,2807) - lu(k,2667) * lu(k,2802) + lu(k,2808) = lu(k,2808) - lu(k,2668) * lu(k,2802) + lu(k,2811) = lu(k,2811) - lu(k,2669) * lu(k,2802) + lu(k,2812) = lu(k,2812) - lu(k,2670) * lu(k,2802) + lu(k,2813) = lu(k,2813) - lu(k,2671) * lu(k,2802) + lu(k,2814) = lu(k,2814) - lu(k,2672) * lu(k,2802) + lu(k,2815) = lu(k,2815) - lu(k,2673) * lu(k,2802) + lu(k,2816) = lu(k,2816) - lu(k,2674) * lu(k,2802) + lu(k,2817) = lu(k,2817) - lu(k,2675) * lu(k,2802) + lu(k,2818) = lu(k,2818) - lu(k,2676) * lu(k,2802) + lu(k,2819) = lu(k,2819) - lu(k,2677) * lu(k,2802) + lu(k,2820) = lu(k,2820) - lu(k,2678) * lu(k,2802) + lu(k,2822) = lu(k,2822) - lu(k,2679) * lu(k,2802) + lu(k,2823) = lu(k,2823) - lu(k,2680) * lu(k,2802) + lu(k,2849) = lu(k,2849) - lu(k,2664) * lu(k,2847) + lu(k,2850) = lu(k,2850) - lu(k,2665) * lu(k,2847) + lu(k,2851) = lu(k,2851) - lu(k,2666) * lu(k,2847) + lu(k,2853) = lu(k,2853) - lu(k,2667) * lu(k,2847) + lu(k,2854) = lu(k,2854) - lu(k,2668) * lu(k,2847) + lu(k,2857) = lu(k,2857) - lu(k,2669) * lu(k,2847) + lu(k,2858) = lu(k,2858) - lu(k,2670) * lu(k,2847) + lu(k,2859) = lu(k,2859) - lu(k,2671) * lu(k,2847) + lu(k,2860) = lu(k,2860) - lu(k,2672) * lu(k,2847) + lu(k,2861) = lu(k,2861) - lu(k,2673) * lu(k,2847) + lu(k,2862) = lu(k,2862) - lu(k,2674) * lu(k,2847) + lu(k,2863) = lu(k,2863) - lu(k,2675) * lu(k,2847) + lu(k,2864) = lu(k,2864) - lu(k,2676) * lu(k,2847) + lu(k,2865) = lu(k,2865) - lu(k,2677) * lu(k,2847) + lu(k,2866) = lu(k,2866) - lu(k,2678) * lu(k,2847) + lu(k,2868) = lu(k,2868) - lu(k,2679) * lu(k,2847) + lu(k,2869) = lu(k,2869) - lu(k,2680) * lu(k,2847) + lu(k,2896) = lu(k,2896) - lu(k,2664) * lu(k,2894) + lu(k,2897) = lu(k,2897) - lu(k,2665) * lu(k,2894) + lu(k,2898) = lu(k,2898) - lu(k,2666) * lu(k,2894) + lu(k,2900) = lu(k,2900) - lu(k,2667) * lu(k,2894) + lu(k,2901) = lu(k,2901) - lu(k,2668) * lu(k,2894) + lu(k,2904) = lu(k,2904) - lu(k,2669) * lu(k,2894) + lu(k,2905) = lu(k,2905) - lu(k,2670) * lu(k,2894) + lu(k,2906) = lu(k,2906) - lu(k,2671) * lu(k,2894) + lu(k,2907) = lu(k,2907) - lu(k,2672) * lu(k,2894) + lu(k,2908) = lu(k,2908) - lu(k,2673) * lu(k,2894) + lu(k,2909) = lu(k,2909) - lu(k,2674) * lu(k,2894) + lu(k,2910) = lu(k,2910) - lu(k,2675) * lu(k,2894) + lu(k,2911) = lu(k,2911) - lu(k,2676) * lu(k,2894) + lu(k,2912) = lu(k,2912) - lu(k,2677) * lu(k,2894) + lu(k,2913) = lu(k,2913) - lu(k,2678) * lu(k,2894) + lu(k,2915) = lu(k,2915) - lu(k,2679) * lu(k,2894) + lu(k,2916) = lu(k,2916) - lu(k,2680) * lu(k,2894) + lu(k,2942) = lu(k,2942) - lu(k,2664) * lu(k,2940) + lu(k,2943) = lu(k,2943) - lu(k,2665) * lu(k,2940) + lu(k,2944) = lu(k,2944) - lu(k,2666) * lu(k,2940) + lu(k,2946) = lu(k,2946) - lu(k,2667) * lu(k,2940) + lu(k,2947) = lu(k,2947) - lu(k,2668) * lu(k,2940) + lu(k,2950) = lu(k,2950) - lu(k,2669) * lu(k,2940) + lu(k,2951) = lu(k,2951) - lu(k,2670) * lu(k,2940) + lu(k,2952) = lu(k,2952) - lu(k,2671) * lu(k,2940) + lu(k,2953) = lu(k,2953) - lu(k,2672) * lu(k,2940) + lu(k,2954) = lu(k,2954) - lu(k,2673) * lu(k,2940) + lu(k,2955) = lu(k,2955) - lu(k,2674) * lu(k,2940) + lu(k,2956) = lu(k,2956) - lu(k,2675) * lu(k,2940) + lu(k,2957) = lu(k,2957) - lu(k,2676) * lu(k,2940) + lu(k,2958) = lu(k,2958) - lu(k,2677) * lu(k,2940) + lu(k,2959) = lu(k,2959) - lu(k,2678) * lu(k,2940) + lu(k,2961) = lu(k,2961) - lu(k,2679) * lu(k,2940) + lu(k,2962) = lu(k,2962) - lu(k,2680) * lu(k,2940) + lu(k,3016) = lu(k,3016) - lu(k,2664) * lu(k,3014) + lu(k,3017) = lu(k,3017) - lu(k,2665) * lu(k,3014) + lu(k,3018) = lu(k,3018) - lu(k,2666) * lu(k,3014) + lu(k,3020) = lu(k,3020) - lu(k,2667) * lu(k,3014) + lu(k,3021) = lu(k,3021) - lu(k,2668) * lu(k,3014) + lu(k,3024) = lu(k,3024) - lu(k,2669) * lu(k,3014) + lu(k,3025) = lu(k,3025) - lu(k,2670) * lu(k,3014) + lu(k,3026) = lu(k,3026) - lu(k,2671) * lu(k,3014) + lu(k,3027) = lu(k,3027) - lu(k,2672) * lu(k,3014) + lu(k,3028) = lu(k,3028) - lu(k,2673) * lu(k,3014) + lu(k,3029) = lu(k,3029) - lu(k,2674) * lu(k,3014) + lu(k,3030) = lu(k,3030) - lu(k,2675) * lu(k,3014) + lu(k,3031) = lu(k,3031) - lu(k,2676) * lu(k,3014) + lu(k,3032) = lu(k,3032) - lu(k,2677) * lu(k,3014) + lu(k,3033) = lu(k,3033) - lu(k,2678) * lu(k,3014) + lu(k,3035) = lu(k,3035) - lu(k,2679) * lu(k,3014) + lu(k,3036) = lu(k,3036) - lu(k,2680) * lu(k,3014) + lu(k,3119) = lu(k,3119) - lu(k,2664) * lu(k,3117) + lu(k,3120) = lu(k,3120) - lu(k,2665) * lu(k,3117) + lu(k,3121) = lu(k,3121) - lu(k,2666) * lu(k,3117) + lu(k,3123) = lu(k,3123) - lu(k,2667) * lu(k,3117) + lu(k,3124) = lu(k,3124) - lu(k,2668) * lu(k,3117) + lu(k,3127) = lu(k,3127) - lu(k,2669) * lu(k,3117) + lu(k,3128) = lu(k,3128) - lu(k,2670) * lu(k,3117) + lu(k,3129) = lu(k,3129) - lu(k,2671) * lu(k,3117) + lu(k,3130) = lu(k,3130) - lu(k,2672) * lu(k,3117) + lu(k,3131) = lu(k,3131) - lu(k,2673) * lu(k,3117) + lu(k,3132) = lu(k,3132) - lu(k,2674) * lu(k,3117) + lu(k,3133) = lu(k,3133) - lu(k,2675) * lu(k,3117) + lu(k,3134) = lu(k,3134) - lu(k,2676) * lu(k,3117) + lu(k,3135) = lu(k,3135) - lu(k,2677) * lu(k,3117) + lu(k,3136) = lu(k,3136) - lu(k,2678) * lu(k,3117) + lu(k,3138) = lu(k,3138) - lu(k,2679) * lu(k,3117) + lu(k,3139) = lu(k,3139) - lu(k,2680) * lu(k,3117) + lu(k,3301) = lu(k,3301) - lu(k,2664) * lu(k,3299) + lu(k,3302) = lu(k,3302) - lu(k,2665) * lu(k,3299) + lu(k,3303) = lu(k,3303) - lu(k,2666) * lu(k,3299) + lu(k,3305) = lu(k,3305) - lu(k,2667) * lu(k,3299) + lu(k,3306) = lu(k,3306) - lu(k,2668) * lu(k,3299) + lu(k,3309) = lu(k,3309) - lu(k,2669) * lu(k,3299) + lu(k,3310) = lu(k,3310) - lu(k,2670) * lu(k,3299) + lu(k,3311) = lu(k,3311) - lu(k,2671) * lu(k,3299) + lu(k,3312) = lu(k,3312) - lu(k,2672) * lu(k,3299) + lu(k,3313) = lu(k,3313) - lu(k,2673) * lu(k,3299) + lu(k,3314) = lu(k,3314) - lu(k,2674) * lu(k,3299) + lu(k,3315) = lu(k,3315) - lu(k,2675) * lu(k,3299) + lu(k,3316) = lu(k,3316) - lu(k,2676) * lu(k,3299) + lu(k,3317) = lu(k,3317) - lu(k,2677) * lu(k,3299) + lu(k,3318) = lu(k,3318) - lu(k,2678) * lu(k,3299) + lu(k,3320) = lu(k,3320) - lu(k,2679) * lu(k,3299) + lu(k,3321) = lu(k,3321) - lu(k,2680) * lu(k,3299) + lu(k,3557) = lu(k,3557) - lu(k,2664) * lu(k,3555) + lu(k,3558) = lu(k,3558) - lu(k,2665) * lu(k,3555) + lu(k,3559) = lu(k,3559) - lu(k,2666) * lu(k,3555) + lu(k,3561) = lu(k,3561) - lu(k,2667) * lu(k,3555) + lu(k,3562) = lu(k,3562) - lu(k,2668) * lu(k,3555) + lu(k,3565) = lu(k,3565) - lu(k,2669) * lu(k,3555) + lu(k,3566) = lu(k,3566) - lu(k,2670) * lu(k,3555) + lu(k,3567) = lu(k,3567) - lu(k,2671) * lu(k,3555) + lu(k,3568) = lu(k,3568) - lu(k,2672) * lu(k,3555) + lu(k,3569) = lu(k,3569) - lu(k,2673) * lu(k,3555) + lu(k,3570) = lu(k,3570) - lu(k,2674) * lu(k,3555) + lu(k,3571) = lu(k,3571) - lu(k,2675) * lu(k,3555) + lu(k,3572) = lu(k,3572) - lu(k,2676) * lu(k,3555) + lu(k,3573) = lu(k,3573) - lu(k,2677) * lu(k,3555) + lu(k,3574) = lu(k,3574) - lu(k,2678) * lu(k,3555) + lu(k,3576) = lu(k,3576) - lu(k,2679) * lu(k,3555) + lu(k,3577) = lu(k,3577) - lu(k,2680) * lu(k,3555) + lu(k,3807) = lu(k,3807) - lu(k,2664) * lu(k,3805) + lu(k,3808) = lu(k,3808) - lu(k,2665) * lu(k,3805) + lu(k,3809) = lu(k,3809) - lu(k,2666) * lu(k,3805) + lu(k,3811) = lu(k,3811) - lu(k,2667) * lu(k,3805) + lu(k,3812) = lu(k,3812) - lu(k,2668) * lu(k,3805) + lu(k,3815) = lu(k,3815) - lu(k,2669) * lu(k,3805) + lu(k,3816) = lu(k,3816) - lu(k,2670) * lu(k,3805) + lu(k,3817) = lu(k,3817) - lu(k,2671) * lu(k,3805) + lu(k,3818) = lu(k,3818) - lu(k,2672) * lu(k,3805) + lu(k,3819) = lu(k,3819) - lu(k,2673) * lu(k,3805) + lu(k,3820) = lu(k,3820) - lu(k,2674) * lu(k,3805) + lu(k,3821) = lu(k,3821) - lu(k,2675) * lu(k,3805) + lu(k,3822) = lu(k,3822) - lu(k,2676) * lu(k,3805) + lu(k,3823) = lu(k,3823) - lu(k,2677) * lu(k,3805) + lu(k,3824) = lu(k,3824) - lu(k,2678) * lu(k,3805) + lu(k,3826) = lu(k,3826) - lu(k,2679) * lu(k,3805) + lu(k,3827) = lu(k,3827) - lu(k,2680) * lu(k,3805) + lu(k,3942) = lu(k,3942) - lu(k,2664) * lu(k,3940) + lu(k,3943) = lu(k,3943) - lu(k,2665) * lu(k,3940) + lu(k,3944) = lu(k,3944) - lu(k,2666) * lu(k,3940) + lu(k,3946) = lu(k,3946) - lu(k,2667) * lu(k,3940) + lu(k,3947) = lu(k,3947) - lu(k,2668) * lu(k,3940) + lu(k,3950) = lu(k,3950) - lu(k,2669) * lu(k,3940) + lu(k,3951) = lu(k,3951) - lu(k,2670) * lu(k,3940) + lu(k,3952) = lu(k,3952) - lu(k,2671) * lu(k,3940) + lu(k,3953) = lu(k,3953) - lu(k,2672) * lu(k,3940) + lu(k,3954) = lu(k,3954) - lu(k,2673) * lu(k,3940) + lu(k,3955) = lu(k,3955) - lu(k,2674) * lu(k,3940) + lu(k,3956) = lu(k,3956) - lu(k,2675) * lu(k,3940) + lu(k,3957) = lu(k,3957) - lu(k,2676) * lu(k,3940) + lu(k,3958) = lu(k,3958) - lu(k,2677) * lu(k,3940) + lu(k,3959) = lu(k,3959) - lu(k,2678) * lu(k,3940) + lu(k,3961) = lu(k,3961) - lu(k,2679) * lu(k,3940) + lu(k,3962) = lu(k,3962) - lu(k,2680) * lu(k,3940) + lu(k,4034) = lu(k,4034) - lu(k,2664) * lu(k,4032) + lu(k,4035) = lu(k,4035) - lu(k,2665) * lu(k,4032) + lu(k,4036) = lu(k,4036) - lu(k,2666) * lu(k,4032) + lu(k,4038) = lu(k,4038) - lu(k,2667) * lu(k,4032) + lu(k,4039) = lu(k,4039) - lu(k,2668) * lu(k,4032) + lu(k,4042) = lu(k,4042) - lu(k,2669) * lu(k,4032) + lu(k,4043) = lu(k,4043) - lu(k,2670) * lu(k,4032) + lu(k,4044) = lu(k,4044) - lu(k,2671) * lu(k,4032) + lu(k,4045) = lu(k,4045) - lu(k,2672) * lu(k,4032) + lu(k,4046) = lu(k,4046) - lu(k,2673) * lu(k,4032) + lu(k,4047) = lu(k,4047) - lu(k,2674) * lu(k,4032) + lu(k,4048) = lu(k,4048) - lu(k,2675) * lu(k,4032) + lu(k,4049) = lu(k,4049) - lu(k,2676) * lu(k,4032) + lu(k,4050) = lu(k,4050) - lu(k,2677) * lu(k,4032) + lu(k,4051) = lu(k,4051) - lu(k,2678) * lu(k,4032) + lu(k,4053) = lu(k,4053) - lu(k,2679) * lu(k,4032) + lu(k,4054) = lu(k,4054) - lu(k,2680) * lu(k,4032) end do end subroutine lu_fac49 subroutine lu_fac50( avec_len, lu ) @@ -15732,412 +14927,621 @@ subroutine lu_fac50( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,3285) = 1._r8 / lu(k,3285) - lu(k,3286) = lu(k,3286) * lu(k,3285) - lu(k,3287) = lu(k,3287) * lu(k,3285) - lu(k,3288) = lu(k,3288) * lu(k,3285) - lu(k,3289) = lu(k,3289) * lu(k,3285) - lu(k,3290) = lu(k,3290) * lu(k,3285) - lu(k,3291) = lu(k,3291) * lu(k,3285) - lu(k,3292) = lu(k,3292) * lu(k,3285) - lu(k,3293) = lu(k,3293) * lu(k,3285) - lu(k,3294) = lu(k,3294) * lu(k,3285) - lu(k,3295) = lu(k,3295) * lu(k,3285) - lu(k,3312) = lu(k,3312) - lu(k,3286) * lu(k,3311) - lu(k,3313) = lu(k,3313) - lu(k,3287) * lu(k,3311) - lu(k,3314) = lu(k,3314) - lu(k,3288) * lu(k,3311) - lu(k,3315) = lu(k,3315) - lu(k,3289) * lu(k,3311) - lu(k,3316) = lu(k,3316) - lu(k,3290) * lu(k,3311) - lu(k,3317) = lu(k,3317) - lu(k,3291) * lu(k,3311) - lu(k,3318) = lu(k,3318) - lu(k,3292) * lu(k,3311) - lu(k,3319) = lu(k,3319) - lu(k,3293) * lu(k,3311) - lu(k,3320) = lu(k,3320) - lu(k,3294) * lu(k,3311) - lu(k,3321) = lu(k,3321) - lu(k,3295) * lu(k,3311) - lu(k,3336) = lu(k,3336) - lu(k,3286) * lu(k,3335) - lu(k,3337) = lu(k,3337) - lu(k,3287) * lu(k,3335) - lu(k,3338) = lu(k,3338) - lu(k,3288) * lu(k,3335) - lu(k,3339) = lu(k,3339) - lu(k,3289) * lu(k,3335) - lu(k,3340) = lu(k,3340) - lu(k,3290) * lu(k,3335) - lu(k,3341) = lu(k,3341) - lu(k,3291) * lu(k,3335) - lu(k,3342) = lu(k,3342) - lu(k,3292) * lu(k,3335) - lu(k,3343) = lu(k,3343) - lu(k,3293) * lu(k,3335) - lu(k,3344) = lu(k,3344) - lu(k,3294) * lu(k,3335) - lu(k,3345) = lu(k,3345) - lu(k,3295) * lu(k,3335) - lu(k,3427) = lu(k,3427) - lu(k,3286) * lu(k,3426) - lu(k,3428) = lu(k,3428) - lu(k,3287) * lu(k,3426) - lu(k,3429) = lu(k,3429) - lu(k,3288) * lu(k,3426) - lu(k,3430) = lu(k,3430) - lu(k,3289) * lu(k,3426) - lu(k,3431) = lu(k,3431) - lu(k,3290) * lu(k,3426) - lu(k,3432) = lu(k,3432) - lu(k,3291) * lu(k,3426) - lu(k,3433) = lu(k,3433) - lu(k,3292) * lu(k,3426) - lu(k,3434) = lu(k,3434) - lu(k,3293) * lu(k,3426) - lu(k,3435) = lu(k,3435) - lu(k,3294) * lu(k,3426) - lu(k,3436) = lu(k,3436) - lu(k,3295) * lu(k,3426) - lu(k,3457) = lu(k,3457) - lu(k,3286) * lu(k,3456) - lu(k,3458) = lu(k,3458) - lu(k,3287) * lu(k,3456) - lu(k,3459) = lu(k,3459) - lu(k,3288) * lu(k,3456) - lu(k,3460) = lu(k,3460) - lu(k,3289) * lu(k,3456) - lu(k,3461) = lu(k,3461) - lu(k,3290) * lu(k,3456) - lu(k,3462) = lu(k,3462) - lu(k,3291) * lu(k,3456) - lu(k,3463) = lu(k,3463) - lu(k,3292) * lu(k,3456) - lu(k,3464) = lu(k,3464) - lu(k,3293) * lu(k,3456) - lu(k,3465) = lu(k,3465) - lu(k,3294) * lu(k,3456) - lu(k,3466) = lu(k,3466) - lu(k,3295) * lu(k,3456) - lu(k,3507) = lu(k,3507) - lu(k,3286) * lu(k,3506) - lu(k,3508) = lu(k,3508) - lu(k,3287) * lu(k,3506) - lu(k,3509) = lu(k,3509) - lu(k,3288) * lu(k,3506) - lu(k,3510) = lu(k,3510) - lu(k,3289) * lu(k,3506) - lu(k,3511) = lu(k,3511) - lu(k,3290) * lu(k,3506) - lu(k,3512) = lu(k,3512) - lu(k,3291) * lu(k,3506) - lu(k,3513) = lu(k,3513) - lu(k,3292) * lu(k,3506) - lu(k,3514) = lu(k,3514) - lu(k,3293) * lu(k,3506) - lu(k,3515) = lu(k,3515) - lu(k,3294) * lu(k,3506) - lu(k,3516) = lu(k,3516) - lu(k,3295) * lu(k,3506) - lu(k,3747) = lu(k,3747) - lu(k,3286) * lu(k,3746) - lu(k,3748) = lu(k,3748) - lu(k,3287) * lu(k,3746) - lu(k,3749) = lu(k,3749) - lu(k,3288) * lu(k,3746) - lu(k,3750) = lu(k,3750) - lu(k,3289) * lu(k,3746) - lu(k,3751) = lu(k,3751) - lu(k,3290) * lu(k,3746) - lu(k,3752) = lu(k,3752) - lu(k,3291) * lu(k,3746) - lu(k,3753) = lu(k,3753) - lu(k,3292) * lu(k,3746) - lu(k,3754) = lu(k,3754) - lu(k,3293) * lu(k,3746) - lu(k,3755) = lu(k,3755) - lu(k,3294) * lu(k,3746) - lu(k,3756) = lu(k,3756) - lu(k,3295) * lu(k,3746) - lu(k,3769) = lu(k,3769) - lu(k,3286) * lu(k,3768) - lu(k,3770) = lu(k,3770) - lu(k,3287) * lu(k,3768) - lu(k,3771) = lu(k,3771) - lu(k,3288) * lu(k,3768) - lu(k,3772) = lu(k,3772) - lu(k,3289) * lu(k,3768) - lu(k,3773) = lu(k,3773) - lu(k,3290) * lu(k,3768) - lu(k,3774) = lu(k,3774) - lu(k,3291) * lu(k,3768) - lu(k,3775) = lu(k,3775) - lu(k,3292) * lu(k,3768) - lu(k,3776) = lu(k,3776) - lu(k,3293) * lu(k,3768) - lu(k,3777) = lu(k,3777) - lu(k,3294) * lu(k,3768) - lu(k,3778) = lu(k,3778) - lu(k,3295) * lu(k,3768) - lu(k,3793) = lu(k,3793) - lu(k,3286) * lu(k,3792) - lu(k,3794) = lu(k,3794) - lu(k,3287) * lu(k,3792) - lu(k,3795) = lu(k,3795) - lu(k,3288) * lu(k,3792) - lu(k,3796) = lu(k,3796) - lu(k,3289) * lu(k,3792) - lu(k,3797) = lu(k,3797) - lu(k,3290) * lu(k,3792) - lu(k,3798) = lu(k,3798) - lu(k,3291) * lu(k,3792) - lu(k,3799) = lu(k,3799) - lu(k,3292) * lu(k,3792) - lu(k,3800) = lu(k,3800) - lu(k,3293) * lu(k,3792) - lu(k,3801) = lu(k,3801) - lu(k,3294) * lu(k,3792) - lu(k,3802) = lu(k,3802) - lu(k,3295) * lu(k,3792) - lu(k,3828) = lu(k,3828) - lu(k,3286) * lu(k,3827) - lu(k,3829) = lu(k,3829) - lu(k,3287) * lu(k,3827) - lu(k,3830) = lu(k,3830) - lu(k,3288) * lu(k,3827) - lu(k,3831) = lu(k,3831) - lu(k,3289) * lu(k,3827) - lu(k,3832) = lu(k,3832) - lu(k,3290) * lu(k,3827) - lu(k,3833) = lu(k,3833) - lu(k,3291) * lu(k,3827) - lu(k,3834) = lu(k,3834) - lu(k,3292) * lu(k,3827) - lu(k,3835) = lu(k,3835) - lu(k,3293) * lu(k,3827) - lu(k,3836) = lu(k,3836) - lu(k,3294) * lu(k,3827) - lu(k,3837) = lu(k,3837) - lu(k,3295) * lu(k,3827) - lu(k,3853) = lu(k,3853) - lu(k,3286) * lu(k,3852) - lu(k,3854) = lu(k,3854) - lu(k,3287) * lu(k,3852) - lu(k,3855) = lu(k,3855) - lu(k,3288) * lu(k,3852) - lu(k,3856) = lu(k,3856) - lu(k,3289) * lu(k,3852) - lu(k,3857) = lu(k,3857) - lu(k,3290) * lu(k,3852) - lu(k,3858) = lu(k,3858) - lu(k,3291) * lu(k,3852) - lu(k,3859) = lu(k,3859) - lu(k,3292) * lu(k,3852) - lu(k,3860) = lu(k,3860) - lu(k,3293) * lu(k,3852) - lu(k,3861) = lu(k,3861) - lu(k,3294) * lu(k,3852) - lu(k,3862) = lu(k,3862) - lu(k,3295) * lu(k,3852) - lu(k,3312) = 1._r8 / lu(k,3312) - lu(k,3313) = lu(k,3313) * lu(k,3312) - lu(k,3314) = lu(k,3314) * lu(k,3312) - lu(k,3315) = lu(k,3315) * lu(k,3312) - lu(k,3316) = lu(k,3316) * lu(k,3312) - lu(k,3317) = lu(k,3317) * lu(k,3312) - lu(k,3318) = lu(k,3318) * lu(k,3312) - lu(k,3319) = lu(k,3319) * lu(k,3312) - lu(k,3320) = lu(k,3320) * lu(k,3312) - lu(k,3321) = lu(k,3321) * lu(k,3312) - lu(k,3337) = lu(k,3337) - lu(k,3313) * lu(k,3336) - lu(k,3338) = lu(k,3338) - lu(k,3314) * lu(k,3336) - lu(k,3339) = lu(k,3339) - lu(k,3315) * lu(k,3336) - lu(k,3340) = lu(k,3340) - lu(k,3316) * lu(k,3336) - lu(k,3341) = lu(k,3341) - lu(k,3317) * lu(k,3336) - lu(k,3342) = lu(k,3342) - lu(k,3318) * lu(k,3336) - lu(k,3343) = lu(k,3343) - lu(k,3319) * lu(k,3336) - lu(k,3344) = lu(k,3344) - lu(k,3320) * lu(k,3336) - lu(k,3345) = lu(k,3345) - lu(k,3321) * lu(k,3336) - lu(k,3428) = lu(k,3428) - lu(k,3313) * lu(k,3427) - lu(k,3429) = lu(k,3429) - lu(k,3314) * lu(k,3427) - lu(k,3430) = lu(k,3430) - lu(k,3315) * lu(k,3427) - lu(k,3431) = lu(k,3431) - lu(k,3316) * lu(k,3427) - lu(k,3432) = lu(k,3432) - lu(k,3317) * lu(k,3427) - lu(k,3433) = lu(k,3433) - lu(k,3318) * lu(k,3427) - lu(k,3434) = lu(k,3434) - lu(k,3319) * lu(k,3427) - lu(k,3435) = lu(k,3435) - lu(k,3320) * lu(k,3427) - lu(k,3436) = lu(k,3436) - lu(k,3321) * lu(k,3427) - lu(k,3458) = lu(k,3458) - lu(k,3313) * lu(k,3457) - lu(k,3459) = lu(k,3459) - lu(k,3314) * lu(k,3457) - lu(k,3460) = lu(k,3460) - lu(k,3315) * lu(k,3457) - lu(k,3461) = lu(k,3461) - lu(k,3316) * lu(k,3457) - lu(k,3462) = lu(k,3462) - lu(k,3317) * lu(k,3457) - lu(k,3463) = lu(k,3463) - lu(k,3318) * lu(k,3457) - lu(k,3464) = lu(k,3464) - lu(k,3319) * lu(k,3457) - lu(k,3465) = lu(k,3465) - lu(k,3320) * lu(k,3457) - lu(k,3466) = lu(k,3466) - lu(k,3321) * lu(k,3457) - lu(k,3508) = lu(k,3508) - lu(k,3313) * lu(k,3507) - lu(k,3509) = lu(k,3509) - lu(k,3314) * lu(k,3507) - lu(k,3510) = lu(k,3510) - lu(k,3315) * lu(k,3507) - lu(k,3511) = lu(k,3511) - lu(k,3316) * lu(k,3507) - lu(k,3512) = lu(k,3512) - lu(k,3317) * lu(k,3507) - lu(k,3513) = lu(k,3513) - lu(k,3318) * lu(k,3507) - lu(k,3514) = lu(k,3514) - lu(k,3319) * lu(k,3507) - lu(k,3515) = lu(k,3515) - lu(k,3320) * lu(k,3507) - lu(k,3516) = lu(k,3516) - lu(k,3321) * lu(k,3507) - lu(k,3748) = lu(k,3748) - lu(k,3313) * lu(k,3747) - lu(k,3749) = lu(k,3749) - lu(k,3314) * lu(k,3747) - lu(k,3750) = lu(k,3750) - lu(k,3315) * lu(k,3747) - lu(k,3751) = lu(k,3751) - lu(k,3316) * lu(k,3747) - lu(k,3752) = lu(k,3752) - lu(k,3317) * lu(k,3747) - lu(k,3753) = lu(k,3753) - lu(k,3318) * lu(k,3747) - lu(k,3754) = lu(k,3754) - lu(k,3319) * lu(k,3747) - lu(k,3755) = lu(k,3755) - lu(k,3320) * lu(k,3747) - lu(k,3756) = lu(k,3756) - lu(k,3321) * lu(k,3747) - lu(k,3770) = lu(k,3770) - lu(k,3313) * lu(k,3769) - lu(k,3771) = lu(k,3771) - lu(k,3314) * lu(k,3769) - lu(k,3772) = lu(k,3772) - lu(k,3315) * lu(k,3769) - lu(k,3773) = lu(k,3773) - lu(k,3316) * lu(k,3769) - lu(k,3774) = lu(k,3774) - lu(k,3317) * lu(k,3769) - lu(k,3775) = lu(k,3775) - lu(k,3318) * lu(k,3769) - lu(k,3776) = lu(k,3776) - lu(k,3319) * lu(k,3769) - lu(k,3777) = lu(k,3777) - lu(k,3320) * lu(k,3769) - lu(k,3778) = lu(k,3778) - lu(k,3321) * lu(k,3769) - lu(k,3794) = lu(k,3794) - lu(k,3313) * lu(k,3793) - lu(k,3795) = lu(k,3795) - lu(k,3314) * lu(k,3793) - lu(k,3796) = lu(k,3796) - lu(k,3315) * lu(k,3793) - lu(k,3797) = lu(k,3797) - lu(k,3316) * lu(k,3793) - lu(k,3798) = lu(k,3798) - lu(k,3317) * lu(k,3793) - lu(k,3799) = lu(k,3799) - lu(k,3318) * lu(k,3793) - lu(k,3800) = lu(k,3800) - lu(k,3319) * lu(k,3793) - lu(k,3801) = lu(k,3801) - lu(k,3320) * lu(k,3793) - lu(k,3802) = lu(k,3802) - lu(k,3321) * lu(k,3793) - lu(k,3829) = lu(k,3829) - lu(k,3313) * lu(k,3828) - lu(k,3830) = lu(k,3830) - lu(k,3314) * lu(k,3828) - lu(k,3831) = lu(k,3831) - lu(k,3315) * lu(k,3828) - lu(k,3832) = lu(k,3832) - lu(k,3316) * lu(k,3828) - lu(k,3833) = lu(k,3833) - lu(k,3317) * lu(k,3828) - lu(k,3834) = lu(k,3834) - lu(k,3318) * lu(k,3828) - lu(k,3835) = lu(k,3835) - lu(k,3319) * lu(k,3828) - lu(k,3836) = lu(k,3836) - lu(k,3320) * lu(k,3828) - lu(k,3837) = lu(k,3837) - lu(k,3321) * lu(k,3828) - lu(k,3854) = lu(k,3854) - lu(k,3313) * lu(k,3853) - lu(k,3855) = lu(k,3855) - lu(k,3314) * lu(k,3853) - lu(k,3856) = lu(k,3856) - lu(k,3315) * lu(k,3853) - lu(k,3857) = lu(k,3857) - lu(k,3316) * lu(k,3853) - lu(k,3858) = lu(k,3858) - lu(k,3317) * lu(k,3853) - lu(k,3859) = lu(k,3859) - lu(k,3318) * lu(k,3853) - lu(k,3860) = lu(k,3860) - lu(k,3319) * lu(k,3853) - lu(k,3861) = lu(k,3861) - lu(k,3320) * lu(k,3853) - lu(k,3862) = lu(k,3862) - lu(k,3321) * lu(k,3853) - lu(k,3337) = 1._r8 / lu(k,3337) - lu(k,3338) = lu(k,3338) * lu(k,3337) - lu(k,3339) = lu(k,3339) * lu(k,3337) - lu(k,3340) = lu(k,3340) * lu(k,3337) - lu(k,3341) = lu(k,3341) * lu(k,3337) - lu(k,3342) = lu(k,3342) * lu(k,3337) - lu(k,3343) = lu(k,3343) * lu(k,3337) - lu(k,3344) = lu(k,3344) * lu(k,3337) - lu(k,3345) = lu(k,3345) * lu(k,3337) - lu(k,3429) = lu(k,3429) - lu(k,3338) * lu(k,3428) - lu(k,3430) = lu(k,3430) - lu(k,3339) * lu(k,3428) - lu(k,3431) = lu(k,3431) - lu(k,3340) * lu(k,3428) - lu(k,3432) = lu(k,3432) - lu(k,3341) * lu(k,3428) - lu(k,3433) = lu(k,3433) - lu(k,3342) * lu(k,3428) - lu(k,3434) = lu(k,3434) - lu(k,3343) * lu(k,3428) - lu(k,3435) = lu(k,3435) - lu(k,3344) * lu(k,3428) - lu(k,3436) = lu(k,3436) - lu(k,3345) * lu(k,3428) - lu(k,3459) = lu(k,3459) - lu(k,3338) * lu(k,3458) - lu(k,3460) = lu(k,3460) - lu(k,3339) * lu(k,3458) - lu(k,3461) = lu(k,3461) - lu(k,3340) * lu(k,3458) - lu(k,3462) = lu(k,3462) - lu(k,3341) * lu(k,3458) - lu(k,3463) = lu(k,3463) - lu(k,3342) * lu(k,3458) - lu(k,3464) = lu(k,3464) - lu(k,3343) * lu(k,3458) - lu(k,3465) = lu(k,3465) - lu(k,3344) * lu(k,3458) - lu(k,3466) = lu(k,3466) - lu(k,3345) * lu(k,3458) - lu(k,3509) = lu(k,3509) - lu(k,3338) * lu(k,3508) - lu(k,3510) = lu(k,3510) - lu(k,3339) * lu(k,3508) - lu(k,3511) = lu(k,3511) - lu(k,3340) * lu(k,3508) - lu(k,3512) = lu(k,3512) - lu(k,3341) * lu(k,3508) - lu(k,3513) = lu(k,3513) - lu(k,3342) * lu(k,3508) - lu(k,3514) = lu(k,3514) - lu(k,3343) * lu(k,3508) - lu(k,3515) = lu(k,3515) - lu(k,3344) * lu(k,3508) - lu(k,3516) = lu(k,3516) - lu(k,3345) * lu(k,3508) - lu(k,3749) = lu(k,3749) - lu(k,3338) * lu(k,3748) - lu(k,3750) = lu(k,3750) - lu(k,3339) * lu(k,3748) - lu(k,3751) = lu(k,3751) - lu(k,3340) * lu(k,3748) - lu(k,3752) = lu(k,3752) - lu(k,3341) * lu(k,3748) - lu(k,3753) = lu(k,3753) - lu(k,3342) * lu(k,3748) - lu(k,3754) = lu(k,3754) - lu(k,3343) * lu(k,3748) - lu(k,3755) = lu(k,3755) - lu(k,3344) * lu(k,3748) - lu(k,3756) = lu(k,3756) - lu(k,3345) * lu(k,3748) - lu(k,3771) = lu(k,3771) - lu(k,3338) * lu(k,3770) - lu(k,3772) = lu(k,3772) - lu(k,3339) * lu(k,3770) - lu(k,3773) = lu(k,3773) - lu(k,3340) * lu(k,3770) - lu(k,3774) = lu(k,3774) - lu(k,3341) * lu(k,3770) - lu(k,3775) = lu(k,3775) - lu(k,3342) * lu(k,3770) - lu(k,3776) = lu(k,3776) - lu(k,3343) * lu(k,3770) - lu(k,3777) = lu(k,3777) - lu(k,3344) * lu(k,3770) - lu(k,3778) = lu(k,3778) - lu(k,3345) * lu(k,3770) - lu(k,3795) = lu(k,3795) - lu(k,3338) * lu(k,3794) - lu(k,3796) = lu(k,3796) - lu(k,3339) * lu(k,3794) - lu(k,3797) = lu(k,3797) - lu(k,3340) * lu(k,3794) - lu(k,3798) = lu(k,3798) - lu(k,3341) * lu(k,3794) - lu(k,3799) = lu(k,3799) - lu(k,3342) * lu(k,3794) - lu(k,3800) = lu(k,3800) - lu(k,3343) * lu(k,3794) - lu(k,3801) = lu(k,3801) - lu(k,3344) * lu(k,3794) - lu(k,3802) = lu(k,3802) - lu(k,3345) * lu(k,3794) - lu(k,3830) = lu(k,3830) - lu(k,3338) * lu(k,3829) - lu(k,3831) = lu(k,3831) - lu(k,3339) * lu(k,3829) - lu(k,3832) = lu(k,3832) - lu(k,3340) * lu(k,3829) - lu(k,3833) = lu(k,3833) - lu(k,3341) * lu(k,3829) - lu(k,3834) = lu(k,3834) - lu(k,3342) * lu(k,3829) - lu(k,3835) = lu(k,3835) - lu(k,3343) * lu(k,3829) - lu(k,3836) = lu(k,3836) - lu(k,3344) * lu(k,3829) - lu(k,3837) = lu(k,3837) - lu(k,3345) * lu(k,3829) - lu(k,3855) = lu(k,3855) - lu(k,3338) * lu(k,3854) - lu(k,3856) = lu(k,3856) - lu(k,3339) * lu(k,3854) - lu(k,3857) = lu(k,3857) - lu(k,3340) * lu(k,3854) - lu(k,3858) = lu(k,3858) - lu(k,3341) * lu(k,3854) - lu(k,3859) = lu(k,3859) - lu(k,3342) * lu(k,3854) - lu(k,3860) = lu(k,3860) - lu(k,3343) * lu(k,3854) - lu(k,3861) = lu(k,3861) - lu(k,3344) * lu(k,3854) - lu(k,3862) = lu(k,3862) - lu(k,3345) * lu(k,3854) - lu(k,3429) = 1._r8 / lu(k,3429) - lu(k,3430) = lu(k,3430) * lu(k,3429) - lu(k,3431) = lu(k,3431) * lu(k,3429) - lu(k,3432) = lu(k,3432) * lu(k,3429) - lu(k,3433) = lu(k,3433) * lu(k,3429) - lu(k,3434) = lu(k,3434) * lu(k,3429) - lu(k,3435) = lu(k,3435) * lu(k,3429) - lu(k,3436) = lu(k,3436) * lu(k,3429) - lu(k,3460) = lu(k,3460) - lu(k,3430) * lu(k,3459) - lu(k,3461) = lu(k,3461) - lu(k,3431) * lu(k,3459) - lu(k,3462) = lu(k,3462) - lu(k,3432) * lu(k,3459) - lu(k,3463) = lu(k,3463) - lu(k,3433) * lu(k,3459) - lu(k,3464) = lu(k,3464) - lu(k,3434) * lu(k,3459) - lu(k,3465) = lu(k,3465) - lu(k,3435) * lu(k,3459) - lu(k,3466) = lu(k,3466) - lu(k,3436) * lu(k,3459) - lu(k,3510) = lu(k,3510) - lu(k,3430) * lu(k,3509) - lu(k,3511) = lu(k,3511) - lu(k,3431) * lu(k,3509) - lu(k,3512) = lu(k,3512) - lu(k,3432) * lu(k,3509) - lu(k,3513) = lu(k,3513) - lu(k,3433) * lu(k,3509) - lu(k,3514) = lu(k,3514) - lu(k,3434) * lu(k,3509) - lu(k,3515) = lu(k,3515) - lu(k,3435) * lu(k,3509) - lu(k,3516) = lu(k,3516) - lu(k,3436) * lu(k,3509) - lu(k,3750) = lu(k,3750) - lu(k,3430) * lu(k,3749) - lu(k,3751) = lu(k,3751) - lu(k,3431) * lu(k,3749) - lu(k,3752) = lu(k,3752) - lu(k,3432) * lu(k,3749) - lu(k,3753) = lu(k,3753) - lu(k,3433) * lu(k,3749) - lu(k,3754) = lu(k,3754) - lu(k,3434) * lu(k,3749) - lu(k,3755) = lu(k,3755) - lu(k,3435) * lu(k,3749) - lu(k,3756) = lu(k,3756) - lu(k,3436) * lu(k,3749) - lu(k,3772) = lu(k,3772) - lu(k,3430) * lu(k,3771) - lu(k,3773) = lu(k,3773) - lu(k,3431) * lu(k,3771) - lu(k,3774) = lu(k,3774) - lu(k,3432) * lu(k,3771) - lu(k,3775) = lu(k,3775) - lu(k,3433) * lu(k,3771) - lu(k,3776) = lu(k,3776) - lu(k,3434) * lu(k,3771) - lu(k,3777) = lu(k,3777) - lu(k,3435) * lu(k,3771) - lu(k,3778) = lu(k,3778) - lu(k,3436) * lu(k,3771) - lu(k,3796) = lu(k,3796) - lu(k,3430) * lu(k,3795) - lu(k,3797) = lu(k,3797) - lu(k,3431) * lu(k,3795) - lu(k,3798) = lu(k,3798) - lu(k,3432) * lu(k,3795) - lu(k,3799) = lu(k,3799) - lu(k,3433) * lu(k,3795) - lu(k,3800) = lu(k,3800) - lu(k,3434) * lu(k,3795) - lu(k,3801) = lu(k,3801) - lu(k,3435) * lu(k,3795) - lu(k,3802) = lu(k,3802) - lu(k,3436) * lu(k,3795) - lu(k,3831) = lu(k,3831) - lu(k,3430) * lu(k,3830) - lu(k,3832) = lu(k,3832) - lu(k,3431) * lu(k,3830) - lu(k,3833) = lu(k,3833) - lu(k,3432) * lu(k,3830) - lu(k,3834) = lu(k,3834) - lu(k,3433) * lu(k,3830) - lu(k,3835) = lu(k,3835) - lu(k,3434) * lu(k,3830) - lu(k,3836) = lu(k,3836) - lu(k,3435) * lu(k,3830) - lu(k,3837) = lu(k,3837) - lu(k,3436) * lu(k,3830) - lu(k,3856) = lu(k,3856) - lu(k,3430) * lu(k,3855) - lu(k,3857) = lu(k,3857) - lu(k,3431) * lu(k,3855) - lu(k,3858) = lu(k,3858) - lu(k,3432) * lu(k,3855) - lu(k,3859) = lu(k,3859) - lu(k,3433) * lu(k,3855) - lu(k,3860) = lu(k,3860) - lu(k,3434) * lu(k,3855) - lu(k,3861) = lu(k,3861) - lu(k,3435) * lu(k,3855) - lu(k,3862) = lu(k,3862) - lu(k,3436) * lu(k,3855) - lu(k,3460) = 1._r8 / lu(k,3460) - lu(k,3461) = lu(k,3461) * lu(k,3460) - lu(k,3462) = lu(k,3462) * lu(k,3460) - lu(k,3463) = lu(k,3463) * lu(k,3460) - lu(k,3464) = lu(k,3464) * lu(k,3460) - lu(k,3465) = lu(k,3465) * lu(k,3460) - lu(k,3466) = lu(k,3466) * lu(k,3460) - lu(k,3511) = lu(k,3511) - lu(k,3461) * lu(k,3510) - lu(k,3512) = lu(k,3512) - lu(k,3462) * lu(k,3510) - lu(k,3513) = lu(k,3513) - lu(k,3463) * lu(k,3510) - lu(k,3514) = lu(k,3514) - lu(k,3464) * lu(k,3510) - lu(k,3515) = lu(k,3515) - lu(k,3465) * lu(k,3510) - lu(k,3516) = lu(k,3516) - lu(k,3466) * lu(k,3510) - lu(k,3751) = lu(k,3751) - lu(k,3461) * lu(k,3750) - lu(k,3752) = lu(k,3752) - lu(k,3462) * lu(k,3750) - lu(k,3753) = lu(k,3753) - lu(k,3463) * lu(k,3750) - lu(k,3754) = lu(k,3754) - lu(k,3464) * lu(k,3750) - lu(k,3755) = lu(k,3755) - lu(k,3465) * lu(k,3750) - lu(k,3756) = lu(k,3756) - lu(k,3466) * lu(k,3750) - lu(k,3773) = lu(k,3773) - lu(k,3461) * lu(k,3772) - lu(k,3774) = lu(k,3774) - lu(k,3462) * lu(k,3772) - lu(k,3775) = lu(k,3775) - lu(k,3463) * lu(k,3772) - lu(k,3776) = lu(k,3776) - lu(k,3464) * lu(k,3772) - lu(k,3777) = lu(k,3777) - lu(k,3465) * lu(k,3772) - lu(k,3778) = lu(k,3778) - lu(k,3466) * lu(k,3772) - lu(k,3797) = lu(k,3797) - lu(k,3461) * lu(k,3796) - lu(k,3798) = lu(k,3798) - lu(k,3462) * lu(k,3796) - lu(k,3799) = lu(k,3799) - lu(k,3463) * lu(k,3796) - lu(k,3800) = lu(k,3800) - lu(k,3464) * lu(k,3796) - lu(k,3801) = lu(k,3801) - lu(k,3465) * lu(k,3796) - lu(k,3802) = lu(k,3802) - lu(k,3466) * lu(k,3796) - lu(k,3832) = lu(k,3832) - lu(k,3461) * lu(k,3831) - lu(k,3833) = lu(k,3833) - lu(k,3462) * lu(k,3831) - lu(k,3834) = lu(k,3834) - lu(k,3463) * lu(k,3831) - lu(k,3835) = lu(k,3835) - lu(k,3464) * lu(k,3831) - lu(k,3836) = lu(k,3836) - lu(k,3465) * lu(k,3831) - lu(k,3837) = lu(k,3837) - lu(k,3466) * lu(k,3831) - lu(k,3857) = lu(k,3857) - lu(k,3461) * lu(k,3856) - lu(k,3858) = lu(k,3858) - lu(k,3462) * lu(k,3856) - lu(k,3859) = lu(k,3859) - lu(k,3463) * lu(k,3856) - lu(k,3860) = lu(k,3860) - lu(k,3464) * lu(k,3856) - lu(k,3861) = lu(k,3861) - lu(k,3465) * lu(k,3856) - lu(k,3862) = lu(k,3862) - lu(k,3466) * lu(k,3856) - lu(k,3511) = 1._r8 / lu(k,3511) - lu(k,3512) = lu(k,3512) * lu(k,3511) - lu(k,3513) = lu(k,3513) * lu(k,3511) - lu(k,3514) = lu(k,3514) * lu(k,3511) - lu(k,3515) = lu(k,3515) * lu(k,3511) - lu(k,3516) = lu(k,3516) * lu(k,3511) - lu(k,3752) = lu(k,3752) - lu(k,3512) * lu(k,3751) - lu(k,3753) = lu(k,3753) - lu(k,3513) * lu(k,3751) - lu(k,3754) = lu(k,3754) - lu(k,3514) * lu(k,3751) - lu(k,3755) = lu(k,3755) - lu(k,3515) * lu(k,3751) - lu(k,3756) = lu(k,3756) - lu(k,3516) * lu(k,3751) - lu(k,3774) = lu(k,3774) - lu(k,3512) * lu(k,3773) - lu(k,3775) = lu(k,3775) - lu(k,3513) * lu(k,3773) - lu(k,3776) = lu(k,3776) - lu(k,3514) * lu(k,3773) - lu(k,3777) = lu(k,3777) - lu(k,3515) * lu(k,3773) - lu(k,3778) = lu(k,3778) - lu(k,3516) * lu(k,3773) - lu(k,3798) = lu(k,3798) - lu(k,3512) * lu(k,3797) - lu(k,3799) = lu(k,3799) - lu(k,3513) * lu(k,3797) - lu(k,3800) = lu(k,3800) - lu(k,3514) * lu(k,3797) - lu(k,3801) = lu(k,3801) - lu(k,3515) * lu(k,3797) - lu(k,3802) = lu(k,3802) - lu(k,3516) * lu(k,3797) - lu(k,3833) = lu(k,3833) - lu(k,3512) * lu(k,3832) - lu(k,3834) = lu(k,3834) - lu(k,3513) * lu(k,3832) - lu(k,3835) = lu(k,3835) - lu(k,3514) * lu(k,3832) - lu(k,3836) = lu(k,3836) - lu(k,3515) * lu(k,3832) - lu(k,3837) = lu(k,3837) - lu(k,3516) * lu(k,3832) - lu(k,3858) = lu(k,3858) - lu(k,3512) * lu(k,3857) - lu(k,3859) = lu(k,3859) - lu(k,3513) * lu(k,3857) - lu(k,3860) = lu(k,3860) - lu(k,3514) * lu(k,3857) - lu(k,3861) = lu(k,3861) - lu(k,3515) * lu(k,3857) - lu(k,3862) = lu(k,3862) - lu(k,3516) * lu(k,3857) + lu(k,2700) = 1._r8 / lu(k,2700) + lu(k,2701) = lu(k,2701) * lu(k,2700) + lu(k,2702) = lu(k,2702) * lu(k,2700) + lu(k,2703) = lu(k,2703) * lu(k,2700) + lu(k,2704) = lu(k,2704) * lu(k,2700) + lu(k,2705) = lu(k,2705) * lu(k,2700) + lu(k,2706) = lu(k,2706) * lu(k,2700) + lu(k,2707) = lu(k,2707) * lu(k,2700) + lu(k,2708) = lu(k,2708) * lu(k,2700) + lu(k,2709) = lu(k,2709) * lu(k,2700) + lu(k,2710) = lu(k,2710) * lu(k,2700) + lu(k,2711) = lu(k,2711) * lu(k,2700) + lu(k,2712) = lu(k,2712) * lu(k,2700) + lu(k,2713) = lu(k,2713) * lu(k,2700) + lu(k,2714) = lu(k,2714) * lu(k,2700) + lu(k,2715) = lu(k,2715) * lu(k,2700) + lu(k,2716) = lu(k,2716) * lu(k,2700) + lu(k,2717) = lu(k,2717) * lu(k,2700) + lu(k,2718) = lu(k,2718) * lu(k,2700) + lu(k,2719) = lu(k,2719) * lu(k,2700) + lu(k,2720) = lu(k,2720) * lu(k,2700) + lu(k,2849) = lu(k,2849) - lu(k,2701) * lu(k,2848) + lu(k,2850) = lu(k,2850) - lu(k,2702) * lu(k,2848) + lu(k,2851) = lu(k,2851) - lu(k,2703) * lu(k,2848) + lu(k,2853) = lu(k,2853) - lu(k,2704) * lu(k,2848) + lu(k,2854) = lu(k,2854) - lu(k,2705) * lu(k,2848) + lu(k,2855) = lu(k,2855) - lu(k,2706) * lu(k,2848) + lu(k,2856) = lu(k,2856) - lu(k,2707) * lu(k,2848) + lu(k,2857) = lu(k,2857) - lu(k,2708) * lu(k,2848) + lu(k,2858) = lu(k,2858) - lu(k,2709) * lu(k,2848) + lu(k,2859) = lu(k,2859) - lu(k,2710) * lu(k,2848) + lu(k,2860) = lu(k,2860) - lu(k,2711) * lu(k,2848) + lu(k,2861) = lu(k,2861) - lu(k,2712) * lu(k,2848) + lu(k,2862) = lu(k,2862) - lu(k,2713) * lu(k,2848) + lu(k,2863) = lu(k,2863) - lu(k,2714) * lu(k,2848) + lu(k,2864) = lu(k,2864) - lu(k,2715) * lu(k,2848) + lu(k,2865) = lu(k,2865) - lu(k,2716) * lu(k,2848) + lu(k,2866) = lu(k,2866) - lu(k,2717) * lu(k,2848) + lu(k,2867) = lu(k,2867) - lu(k,2718) * lu(k,2848) + lu(k,2868) = lu(k,2868) - lu(k,2719) * lu(k,2848) + lu(k,2869) = lu(k,2869) - lu(k,2720) * lu(k,2848) + lu(k,2896) = lu(k,2896) - lu(k,2701) * lu(k,2895) + lu(k,2897) = lu(k,2897) - lu(k,2702) * lu(k,2895) + lu(k,2898) = lu(k,2898) - lu(k,2703) * lu(k,2895) + lu(k,2900) = lu(k,2900) - lu(k,2704) * lu(k,2895) + lu(k,2901) = lu(k,2901) - lu(k,2705) * lu(k,2895) + lu(k,2902) = lu(k,2902) - lu(k,2706) * lu(k,2895) + lu(k,2903) = lu(k,2903) - lu(k,2707) * lu(k,2895) + lu(k,2904) = lu(k,2904) - lu(k,2708) * lu(k,2895) + lu(k,2905) = lu(k,2905) - lu(k,2709) * lu(k,2895) + lu(k,2906) = lu(k,2906) - lu(k,2710) * lu(k,2895) + lu(k,2907) = lu(k,2907) - lu(k,2711) * lu(k,2895) + lu(k,2908) = lu(k,2908) - lu(k,2712) * lu(k,2895) + lu(k,2909) = lu(k,2909) - lu(k,2713) * lu(k,2895) + lu(k,2910) = lu(k,2910) - lu(k,2714) * lu(k,2895) + lu(k,2911) = lu(k,2911) - lu(k,2715) * lu(k,2895) + lu(k,2912) = lu(k,2912) - lu(k,2716) * lu(k,2895) + lu(k,2913) = lu(k,2913) - lu(k,2717) * lu(k,2895) + lu(k,2914) = lu(k,2914) - lu(k,2718) * lu(k,2895) + lu(k,2915) = lu(k,2915) - lu(k,2719) * lu(k,2895) + lu(k,2916) = lu(k,2916) - lu(k,2720) * lu(k,2895) + lu(k,2942) = lu(k,2942) - lu(k,2701) * lu(k,2941) + lu(k,2943) = lu(k,2943) - lu(k,2702) * lu(k,2941) + lu(k,2944) = lu(k,2944) - lu(k,2703) * lu(k,2941) + lu(k,2946) = lu(k,2946) - lu(k,2704) * lu(k,2941) + lu(k,2947) = lu(k,2947) - lu(k,2705) * lu(k,2941) + lu(k,2948) = lu(k,2948) - lu(k,2706) * lu(k,2941) + lu(k,2949) = lu(k,2949) - lu(k,2707) * lu(k,2941) + lu(k,2950) = lu(k,2950) - lu(k,2708) * lu(k,2941) + lu(k,2951) = lu(k,2951) - lu(k,2709) * lu(k,2941) + lu(k,2952) = lu(k,2952) - lu(k,2710) * lu(k,2941) + lu(k,2953) = lu(k,2953) - lu(k,2711) * lu(k,2941) + lu(k,2954) = lu(k,2954) - lu(k,2712) * lu(k,2941) + lu(k,2955) = lu(k,2955) - lu(k,2713) * lu(k,2941) + lu(k,2956) = lu(k,2956) - lu(k,2714) * lu(k,2941) + lu(k,2957) = lu(k,2957) - lu(k,2715) * lu(k,2941) + lu(k,2958) = lu(k,2958) - lu(k,2716) * lu(k,2941) + lu(k,2959) = lu(k,2959) - lu(k,2717) * lu(k,2941) + lu(k,2960) = lu(k,2960) - lu(k,2718) * lu(k,2941) + lu(k,2961) = lu(k,2961) - lu(k,2719) * lu(k,2941) + lu(k,2962) = lu(k,2962) - lu(k,2720) * lu(k,2941) + lu(k,3016) = lu(k,3016) - lu(k,2701) * lu(k,3015) + lu(k,3017) = lu(k,3017) - lu(k,2702) * lu(k,3015) + lu(k,3018) = lu(k,3018) - lu(k,2703) * lu(k,3015) + lu(k,3020) = lu(k,3020) - lu(k,2704) * lu(k,3015) + lu(k,3021) = lu(k,3021) - lu(k,2705) * lu(k,3015) + lu(k,3022) = lu(k,3022) - lu(k,2706) * lu(k,3015) + lu(k,3023) = lu(k,3023) - lu(k,2707) * lu(k,3015) + lu(k,3024) = lu(k,3024) - lu(k,2708) * lu(k,3015) + lu(k,3025) = lu(k,3025) - lu(k,2709) * lu(k,3015) + lu(k,3026) = lu(k,3026) - lu(k,2710) * lu(k,3015) + lu(k,3027) = lu(k,3027) - lu(k,2711) * lu(k,3015) + lu(k,3028) = lu(k,3028) - lu(k,2712) * lu(k,3015) + lu(k,3029) = lu(k,3029) - lu(k,2713) * lu(k,3015) + lu(k,3030) = lu(k,3030) - lu(k,2714) * lu(k,3015) + lu(k,3031) = lu(k,3031) - lu(k,2715) * lu(k,3015) + lu(k,3032) = lu(k,3032) - lu(k,2716) * lu(k,3015) + lu(k,3033) = lu(k,3033) - lu(k,2717) * lu(k,3015) + lu(k,3034) = lu(k,3034) - lu(k,2718) * lu(k,3015) + lu(k,3035) = lu(k,3035) - lu(k,2719) * lu(k,3015) + lu(k,3036) = lu(k,3036) - lu(k,2720) * lu(k,3015) + lu(k,3119) = lu(k,3119) - lu(k,2701) * lu(k,3118) + lu(k,3120) = lu(k,3120) - lu(k,2702) * lu(k,3118) + lu(k,3121) = lu(k,3121) - lu(k,2703) * lu(k,3118) + lu(k,3123) = lu(k,3123) - lu(k,2704) * lu(k,3118) + lu(k,3124) = lu(k,3124) - lu(k,2705) * lu(k,3118) + lu(k,3125) = lu(k,3125) - lu(k,2706) * lu(k,3118) + lu(k,3126) = lu(k,3126) - lu(k,2707) * lu(k,3118) + lu(k,3127) = lu(k,3127) - lu(k,2708) * lu(k,3118) + lu(k,3128) = lu(k,3128) - lu(k,2709) * lu(k,3118) + lu(k,3129) = lu(k,3129) - lu(k,2710) * lu(k,3118) + lu(k,3130) = lu(k,3130) - lu(k,2711) * lu(k,3118) + lu(k,3131) = lu(k,3131) - lu(k,2712) * lu(k,3118) + lu(k,3132) = lu(k,3132) - lu(k,2713) * lu(k,3118) + lu(k,3133) = lu(k,3133) - lu(k,2714) * lu(k,3118) + lu(k,3134) = lu(k,3134) - lu(k,2715) * lu(k,3118) + lu(k,3135) = lu(k,3135) - lu(k,2716) * lu(k,3118) + lu(k,3136) = lu(k,3136) - lu(k,2717) * lu(k,3118) + lu(k,3137) = lu(k,3137) - lu(k,2718) * lu(k,3118) + lu(k,3138) = lu(k,3138) - lu(k,2719) * lu(k,3118) + lu(k,3139) = lu(k,3139) - lu(k,2720) * lu(k,3118) + lu(k,3301) = lu(k,3301) - lu(k,2701) * lu(k,3300) + lu(k,3302) = lu(k,3302) - lu(k,2702) * lu(k,3300) + lu(k,3303) = lu(k,3303) - lu(k,2703) * lu(k,3300) + lu(k,3305) = lu(k,3305) - lu(k,2704) * lu(k,3300) + lu(k,3306) = lu(k,3306) - lu(k,2705) * lu(k,3300) + lu(k,3307) = lu(k,3307) - lu(k,2706) * lu(k,3300) + lu(k,3308) = lu(k,3308) - lu(k,2707) * lu(k,3300) + lu(k,3309) = lu(k,3309) - lu(k,2708) * lu(k,3300) + lu(k,3310) = lu(k,3310) - lu(k,2709) * lu(k,3300) + lu(k,3311) = lu(k,3311) - lu(k,2710) * lu(k,3300) + lu(k,3312) = lu(k,3312) - lu(k,2711) * lu(k,3300) + lu(k,3313) = lu(k,3313) - lu(k,2712) * lu(k,3300) + lu(k,3314) = lu(k,3314) - lu(k,2713) * lu(k,3300) + lu(k,3315) = lu(k,3315) - lu(k,2714) * lu(k,3300) + lu(k,3316) = lu(k,3316) - lu(k,2715) * lu(k,3300) + lu(k,3317) = lu(k,3317) - lu(k,2716) * lu(k,3300) + lu(k,3318) = lu(k,3318) - lu(k,2717) * lu(k,3300) + lu(k,3319) = lu(k,3319) - lu(k,2718) * lu(k,3300) + lu(k,3320) = lu(k,3320) - lu(k,2719) * lu(k,3300) + lu(k,3321) = lu(k,3321) - lu(k,2720) * lu(k,3300) + lu(k,3557) = lu(k,3557) - lu(k,2701) * lu(k,3556) + lu(k,3558) = lu(k,3558) - lu(k,2702) * lu(k,3556) + lu(k,3559) = lu(k,3559) - lu(k,2703) * lu(k,3556) + lu(k,3561) = lu(k,3561) - lu(k,2704) * lu(k,3556) + lu(k,3562) = lu(k,3562) - lu(k,2705) * lu(k,3556) + lu(k,3563) = lu(k,3563) - lu(k,2706) * lu(k,3556) + lu(k,3564) = lu(k,3564) - lu(k,2707) * lu(k,3556) + lu(k,3565) = lu(k,3565) - lu(k,2708) * lu(k,3556) + lu(k,3566) = lu(k,3566) - lu(k,2709) * lu(k,3556) + lu(k,3567) = lu(k,3567) - lu(k,2710) * lu(k,3556) + lu(k,3568) = lu(k,3568) - lu(k,2711) * lu(k,3556) + lu(k,3569) = lu(k,3569) - lu(k,2712) * lu(k,3556) + lu(k,3570) = lu(k,3570) - lu(k,2713) * lu(k,3556) + lu(k,3571) = lu(k,3571) - lu(k,2714) * lu(k,3556) + lu(k,3572) = lu(k,3572) - lu(k,2715) * lu(k,3556) + lu(k,3573) = lu(k,3573) - lu(k,2716) * lu(k,3556) + lu(k,3574) = lu(k,3574) - lu(k,2717) * lu(k,3556) + lu(k,3575) = lu(k,3575) - lu(k,2718) * lu(k,3556) + lu(k,3576) = lu(k,3576) - lu(k,2719) * lu(k,3556) + lu(k,3577) = lu(k,3577) - lu(k,2720) * lu(k,3556) + lu(k,3807) = lu(k,3807) - lu(k,2701) * lu(k,3806) + lu(k,3808) = lu(k,3808) - lu(k,2702) * lu(k,3806) + lu(k,3809) = lu(k,3809) - lu(k,2703) * lu(k,3806) + lu(k,3811) = lu(k,3811) - lu(k,2704) * lu(k,3806) + lu(k,3812) = lu(k,3812) - lu(k,2705) * lu(k,3806) + lu(k,3813) = lu(k,3813) - lu(k,2706) * lu(k,3806) + lu(k,3814) = lu(k,3814) - lu(k,2707) * lu(k,3806) + lu(k,3815) = lu(k,3815) - lu(k,2708) * lu(k,3806) + lu(k,3816) = lu(k,3816) - lu(k,2709) * lu(k,3806) + lu(k,3817) = lu(k,3817) - lu(k,2710) * lu(k,3806) + lu(k,3818) = lu(k,3818) - lu(k,2711) * lu(k,3806) + lu(k,3819) = lu(k,3819) - lu(k,2712) * lu(k,3806) + lu(k,3820) = lu(k,3820) - lu(k,2713) * lu(k,3806) + lu(k,3821) = lu(k,3821) - lu(k,2714) * lu(k,3806) + lu(k,3822) = lu(k,3822) - lu(k,2715) * lu(k,3806) + lu(k,3823) = lu(k,3823) - lu(k,2716) * lu(k,3806) + lu(k,3824) = lu(k,3824) - lu(k,2717) * lu(k,3806) + lu(k,3825) = lu(k,3825) - lu(k,2718) * lu(k,3806) + lu(k,3826) = lu(k,3826) - lu(k,2719) * lu(k,3806) + lu(k,3827) = lu(k,3827) - lu(k,2720) * lu(k,3806) + lu(k,3942) = lu(k,3942) - lu(k,2701) * lu(k,3941) + lu(k,3943) = lu(k,3943) - lu(k,2702) * lu(k,3941) + lu(k,3944) = lu(k,3944) - lu(k,2703) * lu(k,3941) + lu(k,3946) = lu(k,3946) - lu(k,2704) * lu(k,3941) + lu(k,3947) = lu(k,3947) - lu(k,2705) * lu(k,3941) + lu(k,3948) = lu(k,3948) - lu(k,2706) * lu(k,3941) + lu(k,3949) = lu(k,3949) - lu(k,2707) * lu(k,3941) + lu(k,3950) = lu(k,3950) - lu(k,2708) * lu(k,3941) + lu(k,3951) = lu(k,3951) - lu(k,2709) * lu(k,3941) + lu(k,3952) = lu(k,3952) - lu(k,2710) * lu(k,3941) + lu(k,3953) = lu(k,3953) - lu(k,2711) * lu(k,3941) + lu(k,3954) = lu(k,3954) - lu(k,2712) * lu(k,3941) + lu(k,3955) = lu(k,3955) - lu(k,2713) * lu(k,3941) + lu(k,3956) = lu(k,3956) - lu(k,2714) * lu(k,3941) + lu(k,3957) = lu(k,3957) - lu(k,2715) * lu(k,3941) + lu(k,3958) = lu(k,3958) - lu(k,2716) * lu(k,3941) + lu(k,3959) = lu(k,3959) - lu(k,2717) * lu(k,3941) + lu(k,3960) = lu(k,3960) - lu(k,2718) * lu(k,3941) + lu(k,3961) = lu(k,3961) - lu(k,2719) * lu(k,3941) + lu(k,3962) = lu(k,3962) - lu(k,2720) * lu(k,3941) + lu(k,4034) = lu(k,4034) - lu(k,2701) * lu(k,4033) + lu(k,4035) = lu(k,4035) - lu(k,2702) * lu(k,4033) + lu(k,4036) = lu(k,4036) - lu(k,2703) * lu(k,4033) + lu(k,4038) = lu(k,4038) - lu(k,2704) * lu(k,4033) + lu(k,4039) = lu(k,4039) - lu(k,2705) * lu(k,4033) + lu(k,4040) = lu(k,4040) - lu(k,2706) * lu(k,4033) + lu(k,4041) = lu(k,4041) - lu(k,2707) * lu(k,4033) + lu(k,4042) = lu(k,4042) - lu(k,2708) * lu(k,4033) + lu(k,4043) = lu(k,4043) - lu(k,2709) * lu(k,4033) + lu(k,4044) = lu(k,4044) - lu(k,2710) * lu(k,4033) + lu(k,4045) = lu(k,4045) - lu(k,2711) * lu(k,4033) + lu(k,4046) = lu(k,4046) - lu(k,2712) * lu(k,4033) + lu(k,4047) = lu(k,4047) - lu(k,2713) * lu(k,4033) + lu(k,4048) = lu(k,4048) - lu(k,2714) * lu(k,4033) + lu(k,4049) = lu(k,4049) - lu(k,2715) * lu(k,4033) + lu(k,4050) = lu(k,4050) - lu(k,2716) * lu(k,4033) + lu(k,4051) = lu(k,4051) - lu(k,2717) * lu(k,4033) + lu(k,4052) = lu(k,4052) - lu(k,2718) * lu(k,4033) + lu(k,4053) = lu(k,4053) - lu(k,2719) * lu(k,4033) + lu(k,4054) = lu(k,4054) - lu(k,2720) * lu(k,4033) + lu(k,2728) = 1._r8 / lu(k,2728) + lu(k,2729) = lu(k,2729) * lu(k,2728) + lu(k,2730) = lu(k,2730) * lu(k,2728) + lu(k,2731) = lu(k,2731) * lu(k,2728) + lu(k,2732) = lu(k,2732) * lu(k,2728) + lu(k,2733) = lu(k,2733) * lu(k,2728) + lu(k,2734) = lu(k,2734) * lu(k,2728) + lu(k,2735) = lu(k,2735) * lu(k,2728) + lu(k,2736) = lu(k,2736) * lu(k,2728) + lu(k,2737) = lu(k,2737) * lu(k,2728) + lu(k,2738) = lu(k,2738) * lu(k,2728) + lu(k,2739) = lu(k,2739) * lu(k,2728) + lu(k,2740) = lu(k,2740) * lu(k,2728) + lu(k,2741) = lu(k,2741) * lu(k,2728) + lu(k,2742) = lu(k,2742) * lu(k,2728) + lu(k,2743) = lu(k,2743) * lu(k,2728) + lu(k,2751) = lu(k,2751) - lu(k,2729) * lu(k,2750) + lu(k,2752) = lu(k,2752) - lu(k,2730) * lu(k,2750) + lu(k,2753) = lu(k,2753) - lu(k,2731) * lu(k,2750) + lu(k,2754) = lu(k,2754) - lu(k,2732) * lu(k,2750) + lu(k,2755) = lu(k,2755) - lu(k,2733) * lu(k,2750) + lu(k,2756) = lu(k,2756) - lu(k,2734) * lu(k,2750) + lu(k,2757) = lu(k,2757) - lu(k,2735) * lu(k,2750) + lu(k,2758) = lu(k,2758) - lu(k,2736) * lu(k,2750) + lu(k,2759) = lu(k,2759) - lu(k,2737) * lu(k,2750) + lu(k,2760) = lu(k,2760) - lu(k,2738) * lu(k,2750) + lu(k,2761) = lu(k,2761) - lu(k,2739) * lu(k,2750) + lu(k,2762) = lu(k,2762) - lu(k,2740) * lu(k,2750) + lu(k,2763) = lu(k,2763) - lu(k,2741) * lu(k,2750) + lu(k,2764) = lu(k,2764) - lu(k,2742) * lu(k,2750) + lu(k,2765) = lu(k,2765) - lu(k,2743) * lu(k,2750) + lu(k,2774) = lu(k,2774) - lu(k,2729) * lu(k,2773) + lu(k,2775) = lu(k,2775) - lu(k,2730) * lu(k,2773) + lu(k,2776) = lu(k,2776) - lu(k,2731) * lu(k,2773) + lu(k,2777) = lu(k,2777) - lu(k,2732) * lu(k,2773) + lu(k,2778) = lu(k,2778) - lu(k,2733) * lu(k,2773) + lu(k,2779) = lu(k,2779) - lu(k,2734) * lu(k,2773) + lu(k,2780) = lu(k,2780) - lu(k,2735) * lu(k,2773) + lu(k,2781) = lu(k,2781) - lu(k,2736) * lu(k,2773) + lu(k,2782) = lu(k,2782) - lu(k,2737) * lu(k,2773) + lu(k,2783) = lu(k,2783) - lu(k,2738) * lu(k,2773) + lu(k,2784) = lu(k,2784) - lu(k,2739) * lu(k,2773) + lu(k,2785) = lu(k,2785) - lu(k,2740) * lu(k,2773) + lu(k,2786) = lu(k,2786) - lu(k,2741) * lu(k,2773) + lu(k,2787) = lu(k,2787) - lu(k,2742) * lu(k,2773) + lu(k,2788) = lu(k,2788) - lu(k,2743) * lu(k,2773) + lu(k,2804) = lu(k,2804) - lu(k,2729) * lu(k,2803) + lu(k,2805) = lu(k,2805) - lu(k,2730) * lu(k,2803) + lu(k,2807) = lu(k,2807) - lu(k,2731) * lu(k,2803) + lu(k,2808) = lu(k,2808) - lu(k,2732) * lu(k,2803) + lu(k,2809) = lu(k,2809) - lu(k,2733) * lu(k,2803) + lu(k,2810) = lu(k,2810) - lu(k,2734) * lu(k,2803) + lu(k,2813) = lu(k,2813) - lu(k,2735) * lu(k,2803) + lu(k,2814) = lu(k,2814) - lu(k,2736) * lu(k,2803) + lu(k,2815) = lu(k,2815) - lu(k,2737) * lu(k,2803) + lu(k,2816) = lu(k,2816) - lu(k,2738) * lu(k,2803) + lu(k,2817) = lu(k,2817) - lu(k,2739) * lu(k,2803) + lu(k,2818) = lu(k,2818) - lu(k,2740) * lu(k,2803) + lu(k,2820) = lu(k,2820) - lu(k,2741) * lu(k,2803) + lu(k,2821) = lu(k,2821) - lu(k,2742) * lu(k,2803) + lu(k,2822) = lu(k,2822) - lu(k,2743) * lu(k,2803) + lu(k,2850) = lu(k,2850) - lu(k,2729) * lu(k,2849) + lu(k,2851) = lu(k,2851) - lu(k,2730) * lu(k,2849) + lu(k,2853) = lu(k,2853) - lu(k,2731) * lu(k,2849) + lu(k,2854) = lu(k,2854) - lu(k,2732) * lu(k,2849) + lu(k,2855) = lu(k,2855) - lu(k,2733) * lu(k,2849) + lu(k,2856) = lu(k,2856) - lu(k,2734) * lu(k,2849) + lu(k,2859) = lu(k,2859) - lu(k,2735) * lu(k,2849) + lu(k,2860) = lu(k,2860) - lu(k,2736) * lu(k,2849) + lu(k,2861) = lu(k,2861) - lu(k,2737) * lu(k,2849) + lu(k,2862) = lu(k,2862) - lu(k,2738) * lu(k,2849) + lu(k,2863) = lu(k,2863) - lu(k,2739) * lu(k,2849) + lu(k,2864) = lu(k,2864) - lu(k,2740) * lu(k,2849) + lu(k,2866) = lu(k,2866) - lu(k,2741) * lu(k,2849) + lu(k,2867) = lu(k,2867) - lu(k,2742) * lu(k,2849) + lu(k,2868) = lu(k,2868) - lu(k,2743) * lu(k,2849) + lu(k,2897) = lu(k,2897) - lu(k,2729) * lu(k,2896) + lu(k,2898) = lu(k,2898) - lu(k,2730) * lu(k,2896) + lu(k,2900) = lu(k,2900) - lu(k,2731) * lu(k,2896) + lu(k,2901) = lu(k,2901) - lu(k,2732) * lu(k,2896) + lu(k,2902) = lu(k,2902) - lu(k,2733) * lu(k,2896) + lu(k,2903) = lu(k,2903) - lu(k,2734) * lu(k,2896) + lu(k,2906) = lu(k,2906) - lu(k,2735) * lu(k,2896) + lu(k,2907) = lu(k,2907) - lu(k,2736) * lu(k,2896) + lu(k,2908) = lu(k,2908) - lu(k,2737) * lu(k,2896) + lu(k,2909) = lu(k,2909) - lu(k,2738) * lu(k,2896) + lu(k,2910) = lu(k,2910) - lu(k,2739) * lu(k,2896) + lu(k,2911) = lu(k,2911) - lu(k,2740) * lu(k,2896) + lu(k,2913) = lu(k,2913) - lu(k,2741) * lu(k,2896) + lu(k,2914) = lu(k,2914) - lu(k,2742) * lu(k,2896) + lu(k,2915) = lu(k,2915) - lu(k,2743) * lu(k,2896) + lu(k,2943) = lu(k,2943) - lu(k,2729) * lu(k,2942) + lu(k,2944) = lu(k,2944) - lu(k,2730) * lu(k,2942) + lu(k,2946) = lu(k,2946) - lu(k,2731) * lu(k,2942) + lu(k,2947) = lu(k,2947) - lu(k,2732) * lu(k,2942) + lu(k,2948) = lu(k,2948) - lu(k,2733) * lu(k,2942) + lu(k,2949) = lu(k,2949) - lu(k,2734) * lu(k,2942) + lu(k,2952) = lu(k,2952) - lu(k,2735) * lu(k,2942) + lu(k,2953) = lu(k,2953) - lu(k,2736) * lu(k,2942) + lu(k,2954) = lu(k,2954) - lu(k,2737) * lu(k,2942) + lu(k,2955) = lu(k,2955) - lu(k,2738) * lu(k,2942) + lu(k,2956) = lu(k,2956) - lu(k,2739) * lu(k,2942) + lu(k,2957) = lu(k,2957) - lu(k,2740) * lu(k,2942) + lu(k,2959) = lu(k,2959) - lu(k,2741) * lu(k,2942) + lu(k,2960) = lu(k,2960) - lu(k,2742) * lu(k,2942) + lu(k,2961) = lu(k,2961) - lu(k,2743) * lu(k,2942) + lu(k,3017) = lu(k,3017) - lu(k,2729) * lu(k,3016) + lu(k,3018) = lu(k,3018) - lu(k,2730) * lu(k,3016) + lu(k,3020) = lu(k,3020) - lu(k,2731) * lu(k,3016) + lu(k,3021) = lu(k,3021) - lu(k,2732) * lu(k,3016) + lu(k,3022) = lu(k,3022) - lu(k,2733) * lu(k,3016) + lu(k,3023) = lu(k,3023) - lu(k,2734) * lu(k,3016) + lu(k,3026) = lu(k,3026) - lu(k,2735) * lu(k,3016) + lu(k,3027) = lu(k,3027) - lu(k,2736) * lu(k,3016) + lu(k,3028) = lu(k,3028) - lu(k,2737) * lu(k,3016) + lu(k,3029) = lu(k,3029) - lu(k,2738) * lu(k,3016) + lu(k,3030) = lu(k,3030) - lu(k,2739) * lu(k,3016) + lu(k,3031) = lu(k,3031) - lu(k,2740) * lu(k,3016) + lu(k,3033) = lu(k,3033) - lu(k,2741) * lu(k,3016) + lu(k,3034) = lu(k,3034) - lu(k,2742) * lu(k,3016) + lu(k,3035) = lu(k,3035) - lu(k,2743) * lu(k,3016) + lu(k,3120) = lu(k,3120) - lu(k,2729) * lu(k,3119) + lu(k,3121) = lu(k,3121) - lu(k,2730) * lu(k,3119) + lu(k,3123) = lu(k,3123) - lu(k,2731) * lu(k,3119) + lu(k,3124) = lu(k,3124) - lu(k,2732) * lu(k,3119) + lu(k,3125) = lu(k,3125) - lu(k,2733) * lu(k,3119) + lu(k,3126) = lu(k,3126) - lu(k,2734) * lu(k,3119) + lu(k,3129) = lu(k,3129) - lu(k,2735) * lu(k,3119) + lu(k,3130) = lu(k,3130) - lu(k,2736) * lu(k,3119) + lu(k,3131) = lu(k,3131) - lu(k,2737) * lu(k,3119) + lu(k,3132) = lu(k,3132) - lu(k,2738) * lu(k,3119) + lu(k,3133) = lu(k,3133) - lu(k,2739) * lu(k,3119) + lu(k,3134) = lu(k,3134) - lu(k,2740) * lu(k,3119) + lu(k,3136) = lu(k,3136) - lu(k,2741) * lu(k,3119) + lu(k,3137) = lu(k,3137) - lu(k,2742) * lu(k,3119) + lu(k,3138) = lu(k,3138) - lu(k,2743) * lu(k,3119) + lu(k,3302) = lu(k,3302) - lu(k,2729) * lu(k,3301) + lu(k,3303) = lu(k,3303) - lu(k,2730) * lu(k,3301) + lu(k,3305) = lu(k,3305) - lu(k,2731) * lu(k,3301) + lu(k,3306) = lu(k,3306) - lu(k,2732) * lu(k,3301) + lu(k,3307) = lu(k,3307) - lu(k,2733) * lu(k,3301) + lu(k,3308) = lu(k,3308) - lu(k,2734) * lu(k,3301) + lu(k,3311) = lu(k,3311) - lu(k,2735) * lu(k,3301) + lu(k,3312) = lu(k,3312) - lu(k,2736) * lu(k,3301) + lu(k,3313) = lu(k,3313) - lu(k,2737) * lu(k,3301) + lu(k,3314) = lu(k,3314) - lu(k,2738) * lu(k,3301) + lu(k,3315) = lu(k,3315) - lu(k,2739) * lu(k,3301) + lu(k,3316) = lu(k,3316) - lu(k,2740) * lu(k,3301) + lu(k,3318) = lu(k,3318) - lu(k,2741) * lu(k,3301) + lu(k,3319) = lu(k,3319) - lu(k,2742) * lu(k,3301) + lu(k,3320) = lu(k,3320) - lu(k,2743) * lu(k,3301) + lu(k,3558) = lu(k,3558) - lu(k,2729) * lu(k,3557) + lu(k,3559) = lu(k,3559) - lu(k,2730) * lu(k,3557) + lu(k,3561) = lu(k,3561) - lu(k,2731) * lu(k,3557) + lu(k,3562) = lu(k,3562) - lu(k,2732) * lu(k,3557) + lu(k,3563) = lu(k,3563) - lu(k,2733) * lu(k,3557) + lu(k,3564) = lu(k,3564) - lu(k,2734) * lu(k,3557) + lu(k,3567) = lu(k,3567) - lu(k,2735) * lu(k,3557) + lu(k,3568) = lu(k,3568) - lu(k,2736) * lu(k,3557) + lu(k,3569) = lu(k,3569) - lu(k,2737) * lu(k,3557) + lu(k,3570) = lu(k,3570) - lu(k,2738) * lu(k,3557) + lu(k,3571) = lu(k,3571) - lu(k,2739) * lu(k,3557) + lu(k,3572) = lu(k,3572) - lu(k,2740) * lu(k,3557) + lu(k,3574) = lu(k,3574) - lu(k,2741) * lu(k,3557) + lu(k,3575) = lu(k,3575) - lu(k,2742) * lu(k,3557) + lu(k,3576) = lu(k,3576) - lu(k,2743) * lu(k,3557) + lu(k,3808) = lu(k,3808) - lu(k,2729) * lu(k,3807) + lu(k,3809) = lu(k,3809) - lu(k,2730) * lu(k,3807) + lu(k,3811) = lu(k,3811) - lu(k,2731) * lu(k,3807) + lu(k,3812) = lu(k,3812) - lu(k,2732) * lu(k,3807) + lu(k,3813) = lu(k,3813) - lu(k,2733) * lu(k,3807) + lu(k,3814) = lu(k,3814) - lu(k,2734) * lu(k,3807) + lu(k,3817) = lu(k,3817) - lu(k,2735) * lu(k,3807) + lu(k,3818) = lu(k,3818) - lu(k,2736) * lu(k,3807) + lu(k,3819) = lu(k,3819) - lu(k,2737) * lu(k,3807) + lu(k,3820) = lu(k,3820) - lu(k,2738) * lu(k,3807) + lu(k,3821) = lu(k,3821) - lu(k,2739) * lu(k,3807) + lu(k,3822) = lu(k,3822) - lu(k,2740) * lu(k,3807) + lu(k,3824) = lu(k,3824) - lu(k,2741) * lu(k,3807) + lu(k,3825) = lu(k,3825) - lu(k,2742) * lu(k,3807) + lu(k,3826) = lu(k,3826) - lu(k,2743) * lu(k,3807) + lu(k,3943) = lu(k,3943) - lu(k,2729) * lu(k,3942) + lu(k,3944) = lu(k,3944) - lu(k,2730) * lu(k,3942) + lu(k,3946) = lu(k,3946) - lu(k,2731) * lu(k,3942) + lu(k,3947) = lu(k,3947) - lu(k,2732) * lu(k,3942) + lu(k,3948) = lu(k,3948) - lu(k,2733) * lu(k,3942) + lu(k,3949) = lu(k,3949) - lu(k,2734) * lu(k,3942) + lu(k,3952) = lu(k,3952) - lu(k,2735) * lu(k,3942) + lu(k,3953) = lu(k,3953) - lu(k,2736) * lu(k,3942) + lu(k,3954) = lu(k,3954) - lu(k,2737) * lu(k,3942) + lu(k,3955) = lu(k,3955) - lu(k,2738) * lu(k,3942) + lu(k,3956) = lu(k,3956) - lu(k,2739) * lu(k,3942) + lu(k,3957) = lu(k,3957) - lu(k,2740) * lu(k,3942) + lu(k,3959) = lu(k,3959) - lu(k,2741) * lu(k,3942) + lu(k,3960) = lu(k,3960) - lu(k,2742) * lu(k,3942) + lu(k,3961) = lu(k,3961) - lu(k,2743) * lu(k,3942) + lu(k,4035) = lu(k,4035) - lu(k,2729) * lu(k,4034) + lu(k,4036) = lu(k,4036) - lu(k,2730) * lu(k,4034) + lu(k,4038) = lu(k,4038) - lu(k,2731) * lu(k,4034) + lu(k,4039) = lu(k,4039) - lu(k,2732) * lu(k,4034) + lu(k,4040) = lu(k,4040) - lu(k,2733) * lu(k,4034) + lu(k,4041) = lu(k,4041) - lu(k,2734) * lu(k,4034) + lu(k,4044) = lu(k,4044) - lu(k,2735) * lu(k,4034) + lu(k,4045) = lu(k,4045) - lu(k,2736) * lu(k,4034) + lu(k,4046) = lu(k,4046) - lu(k,2737) * lu(k,4034) + lu(k,4047) = lu(k,4047) - lu(k,2738) * lu(k,4034) + lu(k,4048) = lu(k,4048) - lu(k,2739) * lu(k,4034) + lu(k,4049) = lu(k,4049) - lu(k,2740) * lu(k,4034) + lu(k,4051) = lu(k,4051) - lu(k,2741) * lu(k,4034) + lu(k,4052) = lu(k,4052) - lu(k,2742) * lu(k,4034) + lu(k,4053) = lu(k,4053) - lu(k,2743) * lu(k,4034) + lu(k,2751) = 1._r8 / lu(k,2751) + lu(k,2752) = lu(k,2752) * lu(k,2751) + lu(k,2753) = lu(k,2753) * lu(k,2751) + lu(k,2754) = lu(k,2754) * lu(k,2751) + lu(k,2755) = lu(k,2755) * lu(k,2751) + lu(k,2756) = lu(k,2756) * lu(k,2751) + lu(k,2757) = lu(k,2757) * lu(k,2751) + lu(k,2758) = lu(k,2758) * lu(k,2751) + lu(k,2759) = lu(k,2759) * lu(k,2751) + lu(k,2760) = lu(k,2760) * lu(k,2751) + lu(k,2761) = lu(k,2761) * lu(k,2751) + lu(k,2762) = lu(k,2762) * lu(k,2751) + lu(k,2763) = lu(k,2763) * lu(k,2751) + lu(k,2764) = lu(k,2764) * lu(k,2751) + lu(k,2765) = lu(k,2765) * lu(k,2751) + lu(k,2775) = lu(k,2775) - lu(k,2752) * lu(k,2774) + lu(k,2776) = lu(k,2776) - lu(k,2753) * lu(k,2774) + lu(k,2777) = lu(k,2777) - lu(k,2754) * lu(k,2774) + lu(k,2778) = lu(k,2778) - lu(k,2755) * lu(k,2774) + lu(k,2779) = lu(k,2779) - lu(k,2756) * lu(k,2774) + lu(k,2780) = lu(k,2780) - lu(k,2757) * lu(k,2774) + lu(k,2781) = lu(k,2781) - lu(k,2758) * lu(k,2774) + lu(k,2782) = lu(k,2782) - lu(k,2759) * lu(k,2774) + lu(k,2783) = lu(k,2783) - lu(k,2760) * lu(k,2774) + lu(k,2784) = lu(k,2784) - lu(k,2761) * lu(k,2774) + lu(k,2785) = lu(k,2785) - lu(k,2762) * lu(k,2774) + lu(k,2786) = lu(k,2786) - lu(k,2763) * lu(k,2774) + lu(k,2787) = lu(k,2787) - lu(k,2764) * lu(k,2774) + lu(k,2788) = lu(k,2788) - lu(k,2765) * lu(k,2774) + lu(k,2805) = lu(k,2805) - lu(k,2752) * lu(k,2804) + lu(k,2807) = lu(k,2807) - lu(k,2753) * lu(k,2804) + lu(k,2808) = lu(k,2808) - lu(k,2754) * lu(k,2804) + lu(k,2809) = lu(k,2809) - lu(k,2755) * lu(k,2804) + lu(k,2810) = lu(k,2810) - lu(k,2756) * lu(k,2804) + lu(k,2813) = lu(k,2813) - lu(k,2757) * lu(k,2804) + lu(k,2814) = lu(k,2814) - lu(k,2758) * lu(k,2804) + lu(k,2815) = lu(k,2815) - lu(k,2759) * lu(k,2804) + lu(k,2816) = lu(k,2816) - lu(k,2760) * lu(k,2804) + lu(k,2817) = lu(k,2817) - lu(k,2761) * lu(k,2804) + lu(k,2818) = lu(k,2818) - lu(k,2762) * lu(k,2804) + lu(k,2820) = lu(k,2820) - lu(k,2763) * lu(k,2804) + lu(k,2821) = lu(k,2821) - lu(k,2764) * lu(k,2804) + lu(k,2822) = lu(k,2822) - lu(k,2765) * lu(k,2804) + lu(k,2851) = lu(k,2851) - lu(k,2752) * lu(k,2850) + lu(k,2853) = lu(k,2853) - lu(k,2753) * lu(k,2850) + lu(k,2854) = lu(k,2854) - lu(k,2754) * lu(k,2850) + lu(k,2855) = lu(k,2855) - lu(k,2755) * lu(k,2850) + lu(k,2856) = lu(k,2856) - lu(k,2756) * lu(k,2850) + lu(k,2859) = lu(k,2859) - lu(k,2757) * lu(k,2850) + lu(k,2860) = lu(k,2860) - lu(k,2758) * lu(k,2850) + lu(k,2861) = lu(k,2861) - lu(k,2759) * lu(k,2850) + lu(k,2862) = lu(k,2862) - lu(k,2760) * lu(k,2850) + lu(k,2863) = lu(k,2863) - lu(k,2761) * lu(k,2850) + lu(k,2864) = lu(k,2864) - lu(k,2762) * lu(k,2850) + lu(k,2866) = lu(k,2866) - lu(k,2763) * lu(k,2850) + lu(k,2867) = lu(k,2867) - lu(k,2764) * lu(k,2850) + lu(k,2868) = lu(k,2868) - lu(k,2765) * lu(k,2850) + lu(k,2898) = lu(k,2898) - lu(k,2752) * lu(k,2897) + lu(k,2900) = lu(k,2900) - lu(k,2753) * lu(k,2897) + lu(k,2901) = lu(k,2901) - lu(k,2754) * lu(k,2897) + lu(k,2902) = lu(k,2902) - lu(k,2755) * lu(k,2897) + lu(k,2903) = lu(k,2903) - lu(k,2756) * lu(k,2897) + lu(k,2906) = lu(k,2906) - lu(k,2757) * lu(k,2897) + lu(k,2907) = lu(k,2907) - lu(k,2758) * lu(k,2897) + lu(k,2908) = lu(k,2908) - lu(k,2759) * lu(k,2897) + lu(k,2909) = lu(k,2909) - lu(k,2760) * lu(k,2897) + lu(k,2910) = lu(k,2910) - lu(k,2761) * lu(k,2897) + lu(k,2911) = lu(k,2911) - lu(k,2762) * lu(k,2897) + lu(k,2913) = lu(k,2913) - lu(k,2763) * lu(k,2897) + lu(k,2914) = lu(k,2914) - lu(k,2764) * lu(k,2897) + lu(k,2915) = lu(k,2915) - lu(k,2765) * lu(k,2897) + lu(k,2944) = lu(k,2944) - lu(k,2752) * lu(k,2943) + lu(k,2946) = lu(k,2946) - lu(k,2753) * lu(k,2943) + lu(k,2947) = lu(k,2947) - lu(k,2754) * lu(k,2943) + lu(k,2948) = lu(k,2948) - lu(k,2755) * lu(k,2943) + lu(k,2949) = lu(k,2949) - lu(k,2756) * lu(k,2943) + lu(k,2952) = lu(k,2952) - lu(k,2757) * lu(k,2943) + lu(k,2953) = lu(k,2953) - lu(k,2758) * lu(k,2943) + lu(k,2954) = lu(k,2954) - lu(k,2759) * lu(k,2943) + lu(k,2955) = lu(k,2955) - lu(k,2760) * lu(k,2943) + lu(k,2956) = lu(k,2956) - lu(k,2761) * lu(k,2943) + lu(k,2957) = lu(k,2957) - lu(k,2762) * lu(k,2943) + lu(k,2959) = lu(k,2959) - lu(k,2763) * lu(k,2943) + lu(k,2960) = lu(k,2960) - lu(k,2764) * lu(k,2943) + lu(k,2961) = lu(k,2961) - lu(k,2765) * lu(k,2943) + lu(k,3018) = lu(k,3018) - lu(k,2752) * lu(k,3017) + lu(k,3020) = lu(k,3020) - lu(k,2753) * lu(k,3017) + lu(k,3021) = lu(k,3021) - lu(k,2754) * lu(k,3017) + lu(k,3022) = lu(k,3022) - lu(k,2755) * lu(k,3017) + lu(k,3023) = lu(k,3023) - lu(k,2756) * lu(k,3017) + lu(k,3026) = lu(k,3026) - lu(k,2757) * lu(k,3017) + lu(k,3027) = lu(k,3027) - lu(k,2758) * lu(k,3017) + lu(k,3028) = lu(k,3028) - lu(k,2759) * lu(k,3017) + lu(k,3029) = lu(k,3029) - lu(k,2760) * lu(k,3017) + lu(k,3030) = lu(k,3030) - lu(k,2761) * lu(k,3017) + lu(k,3031) = lu(k,3031) - lu(k,2762) * lu(k,3017) + lu(k,3033) = lu(k,3033) - lu(k,2763) * lu(k,3017) + lu(k,3034) = lu(k,3034) - lu(k,2764) * lu(k,3017) + lu(k,3035) = lu(k,3035) - lu(k,2765) * lu(k,3017) + lu(k,3121) = lu(k,3121) - lu(k,2752) * lu(k,3120) + lu(k,3123) = lu(k,3123) - lu(k,2753) * lu(k,3120) + lu(k,3124) = lu(k,3124) - lu(k,2754) * lu(k,3120) + lu(k,3125) = lu(k,3125) - lu(k,2755) * lu(k,3120) + lu(k,3126) = lu(k,3126) - lu(k,2756) * lu(k,3120) + lu(k,3129) = lu(k,3129) - lu(k,2757) * lu(k,3120) + lu(k,3130) = lu(k,3130) - lu(k,2758) * lu(k,3120) + lu(k,3131) = lu(k,3131) - lu(k,2759) * lu(k,3120) + lu(k,3132) = lu(k,3132) - lu(k,2760) * lu(k,3120) + lu(k,3133) = lu(k,3133) - lu(k,2761) * lu(k,3120) + lu(k,3134) = lu(k,3134) - lu(k,2762) * lu(k,3120) + lu(k,3136) = lu(k,3136) - lu(k,2763) * lu(k,3120) + lu(k,3137) = lu(k,3137) - lu(k,2764) * lu(k,3120) + lu(k,3138) = lu(k,3138) - lu(k,2765) * lu(k,3120) + lu(k,3303) = lu(k,3303) - lu(k,2752) * lu(k,3302) + lu(k,3305) = lu(k,3305) - lu(k,2753) * lu(k,3302) + lu(k,3306) = lu(k,3306) - lu(k,2754) * lu(k,3302) + lu(k,3307) = lu(k,3307) - lu(k,2755) * lu(k,3302) + lu(k,3308) = lu(k,3308) - lu(k,2756) * lu(k,3302) + lu(k,3311) = lu(k,3311) - lu(k,2757) * lu(k,3302) + lu(k,3312) = lu(k,3312) - lu(k,2758) * lu(k,3302) + lu(k,3313) = lu(k,3313) - lu(k,2759) * lu(k,3302) + lu(k,3314) = lu(k,3314) - lu(k,2760) * lu(k,3302) + lu(k,3315) = lu(k,3315) - lu(k,2761) * lu(k,3302) + lu(k,3316) = lu(k,3316) - lu(k,2762) * lu(k,3302) + lu(k,3318) = lu(k,3318) - lu(k,2763) * lu(k,3302) + lu(k,3319) = lu(k,3319) - lu(k,2764) * lu(k,3302) + lu(k,3320) = lu(k,3320) - lu(k,2765) * lu(k,3302) + lu(k,3559) = lu(k,3559) - lu(k,2752) * lu(k,3558) + lu(k,3561) = lu(k,3561) - lu(k,2753) * lu(k,3558) + lu(k,3562) = lu(k,3562) - lu(k,2754) * lu(k,3558) + lu(k,3563) = lu(k,3563) - lu(k,2755) * lu(k,3558) + lu(k,3564) = lu(k,3564) - lu(k,2756) * lu(k,3558) + lu(k,3567) = lu(k,3567) - lu(k,2757) * lu(k,3558) + lu(k,3568) = lu(k,3568) - lu(k,2758) * lu(k,3558) + lu(k,3569) = lu(k,3569) - lu(k,2759) * lu(k,3558) + lu(k,3570) = lu(k,3570) - lu(k,2760) * lu(k,3558) + lu(k,3571) = lu(k,3571) - lu(k,2761) * lu(k,3558) + lu(k,3572) = lu(k,3572) - lu(k,2762) * lu(k,3558) + lu(k,3574) = lu(k,3574) - lu(k,2763) * lu(k,3558) + lu(k,3575) = lu(k,3575) - lu(k,2764) * lu(k,3558) + lu(k,3576) = lu(k,3576) - lu(k,2765) * lu(k,3558) + lu(k,3809) = lu(k,3809) - lu(k,2752) * lu(k,3808) + lu(k,3811) = lu(k,3811) - lu(k,2753) * lu(k,3808) + lu(k,3812) = lu(k,3812) - lu(k,2754) * lu(k,3808) + lu(k,3813) = lu(k,3813) - lu(k,2755) * lu(k,3808) + lu(k,3814) = lu(k,3814) - lu(k,2756) * lu(k,3808) + lu(k,3817) = lu(k,3817) - lu(k,2757) * lu(k,3808) + lu(k,3818) = lu(k,3818) - lu(k,2758) * lu(k,3808) + lu(k,3819) = lu(k,3819) - lu(k,2759) * lu(k,3808) + lu(k,3820) = lu(k,3820) - lu(k,2760) * lu(k,3808) + lu(k,3821) = lu(k,3821) - lu(k,2761) * lu(k,3808) + lu(k,3822) = lu(k,3822) - lu(k,2762) * lu(k,3808) + lu(k,3824) = lu(k,3824) - lu(k,2763) * lu(k,3808) + lu(k,3825) = lu(k,3825) - lu(k,2764) * lu(k,3808) + lu(k,3826) = lu(k,3826) - lu(k,2765) * lu(k,3808) + lu(k,3944) = lu(k,3944) - lu(k,2752) * lu(k,3943) + lu(k,3946) = lu(k,3946) - lu(k,2753) * lu(k,3943) + lu(k,3947) = lu(k,3947) - lu(k,2754) * lu(k,3943) + lu(k,3948) = lu(k,3948) - lu(k,2755) * lu(k,3943) + lu(k,3949) = lu(k,3949) - lu(k,2756) * lu(k,3943) + lu(k,3952) = lu(k,3952) - lu(k,2757) * lu(k,3943) + lu(k,3953) = lu(k,3953) - lu(k,2758) * lu(k,3943) + lu(k,3954) = lu(k,3954) - lu(k,2759) * lu(k,3943) + lu(k,3955) = lu(k,3955) - lu(k,2760) * lu(k,3943) + lu(k,3956) = lu(k,3956) - lu(k,2761) * lu(k,3943) + lu(k,3957) = lu(k,3957) - lu(k,2762) * lu(k,3943) + lu(k,3959) = lu(k,3959) - lu(k,2763) * lu(k,3943) + lu(k,3960) = lu(k,3960) - lu(k,2764) * lu(k,3943) + lu(k,3961) = lu(k,3961) - lu(k,2765) * lu(k,3943) + lu(k,4036) = lu(k,4036) - lu(k,2752) * lu(k,4035) + lu(k,4038) = lu(k,4038) - lu(k,2753) * lu(k,4035) + lu(k,4039) = lu(k,4039) - lu(k,2754) * lu(k,4035) + lu(k,4040) = lu(k,4040) - lu(k,2755) * lu(k,4035) + lu(k,4041) = lu(k,4041) - lu(k,2756) * lu(k,4035) + lu(k,4044) = lu(k,4044) - lu(k,2757) * lu(k,4035) + lu(k,4045) = lu(k,4045) - lu(k,2758) * lu(k,4035) + lu(k,4046) = lu(k,4046) - lu(k,2759) * lu(k,4035) + lu(k,4047) = lu(k,4047) - lu(k,2760) * lu(k,4035) + lu(k,4048) = lu(k,4048) - lu(k,2761) * lu(k,4035) + lu(k,4049) = lu(k,4049) - lu(k,2762) * lu(k,4035) + lu(k,4051) = lu(k,4051) - lu(k,2763) * lu(k,4035) + lu(k,4052) = lu(k,4052) - lu(k,2764) * lu(k,4035) + lu(k,4053) = lu(k,4053) - lu(k,2765) * lu(k,4035) end do end subroutine lu_fac50 subroutine lu_fac51( avec_len, lu ) @@ -16154,53 +15558,1741 @@ subroutine lu_fac51( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,3752) = 1._r8 / lu(k,3752) - lu(k,3753) = lu(k,3753) * lu(k,3752) - lu(k,3754) = lu(k,3754) * lu(k,3752) - lu(k,3755) = lu(k,3755) * lu(k,3752) - lu(k,3756) = lu(k,3756) * lu(k,3752) - lu(k,3775) = lu(k,3775) - lu(k,3753) * lu(k,3774) - lu(k,3776) = lu(k,3776) - lu(k,3754) * lu(k,3774) - lu(k,3777) = lu(k,3777) - lu(k,3755) * lu(k,3774) - lu(k,3778) = lu(k,3778) - lu(k,3756) * lu(k,3774) - lu(k,3799) = lu(k,3799) - lu(k,3753) * lu(k,3798) - lu(k,3800) = lu(k,3800) - lu(k,3754) * lu(k,3798) - lu(k,3801) = lu(k,3801) - lu(k,3755) * lu(k,3798) - lu(k,3802) = lu(k,3802) - lu(k,3756) * lu(k,3798) - lu(k,3834) = lu(k,3834) - lu(k,3753) * lu(k,3833) - lu(k,3835) = lu(k,3835) - lu(k,3754) * lu(k,3833) - lu(k,3836) = lu(k,3836) - lu(k,3755) * lu(k,3833) - lu(k,3837) = lu(k,3837) - lu(k,3756) * lu(k,3833) - lu(k,3859) = lu(k,3859) - lu(k,3753) * lu(k,3858) - lu(k,3860) = lu(k,3860) - lu(k,3754) * lu(k,3858) - lu(k,3861) = lu(k,3861) - lu(k,3755) * lu(k,3858) - lu(k,3862) = lu(k,3862) - lu(k,3756) * lu(k,3858) - lu(k,3775) = 1._r8 / lu(k,3775) - lu(k,3776) = lu(k,3776) * lu(k,3775) - lu(k,3777) = lu(k,3777) * lu(k,3775) - lu(k,3778) = lu(k,3778) * lu(k,3775) - lu(k,3800) = lu(k,3800) - lu(k,3776) * lu(k,3799) - lu(k,3801) = lu(k,3801) - lu(k,3777) * lu(k,3799) - lu(k,3802) = lu(k,3802) - lu(k,3778) * lu(k,3799) - lu(k,3835) = lu(k,3835) - lu(k,3776) * lu(k,3834) - lu(k,3836) = lu(k,3836) - lu(k,3777) * lu(k,3834) - lu(k,3837) = lu(k,3837) - lu(k,3778) * lu(k,3834) - lu(k,3860) = lu(k,3860) - lu(k,3776) * lu(k,3859) - lu(k,3861) = lu(k,3861) - lu(k,3777) * lu(k,3859) - lu(k,3862) = lu(k,3862) - lu(k,3778) * lu(k,3859) - lu(k,3800) = 1._r8 / lu(k,3800) - lu(k,3801) = lu(k,3801) * lu(k,3800) - lu(k,3802) = lu(k,3802) * lu(k,3800) - lu(k,3836) = lu(k,3836) - lu(k,3801) * lu(k,3835) - lu(k,3837) = lu(k,3837) - lu(k,3802) * lu(k,3835) - lu(k,3861) = lu(k,3861) - lu(k,3801) * lu(k,3860) - lu(k,3862) = lu(k,3862) - lu(k,3802) * lu(k,3860) - lu(k,3836) = 1._r8 / lu(k,3836) - lu(k,3837) = lu(k,3837) * lu(k,3836) - lu(k,3862) = lu(k,3862) - lu(k,3837) * lu(k,3861) - lu(k,3862) = 1._r8 / lu(k,3862) + lu(k,2775) = 1._r8 / lu(k,2775) + lu(k,2776) = lu(k,2776) * lu(k,2775) + lu(k,2777) = lu(k,2777) * lu(k,2775) + lu(k,2778) = lu(k,2778) * lu(k,2775) + lu(k,2779) = lu(k,2779) * lu(k,2775) + lu(k,2780) = lu(k,2780) * lu(k,2775) + lu(k,2781) = lu(k,2781) * lu(k,2775) + lu(k,2782) = lu(k,2782) * lu(k,2775) + lu(k,2783) = lu(k,2783) * lu(k,2775) + lu(k,2784) = lu(k,2784) * lu(k,2775) + lu(k,2785) = lu(k,2785) * lu(k,2775) + lu(k,2786) = lu(k,2786) * lu(k,2775) + lu(k,2787) = lu(k,2787) * lu(k,2775) + lu(k,2788) = lu(k,2788) * lu(k,2775) + lu(k,2789) = lu(k,2789) * lu(k,2775) + lu(k,2807) = lu(k,2807) - lu(k,2776) * lu(k,2805) + lu(k,2808) = lu(k,2808) - lu(k,2777) * lu(k,2805) + lu(k,2809) = lu(k,2809) - lu(k,2778) * lu(k,2805) + lu(k,2810) = lu(k,2810) - lu(k,2779) * lu(k,2805) + lu(k,2813) = lu(k,2813) - lu(k,2780) * lu(k,2805) + lu(k,2814) = lu(k,2814) - lu(k,2781) * lu(k,2805) + lu(k,2815) = lu(k,2815) - lu(k,2782) * lu(k,2805) + lu(k,2816) = lu(k,2816) - lu(k,2783) * lu(k,2805) + lu(k,2817) = lu(k,2817) - lu(k,2784) * lu(k,2805) + lu(k,2818) = lu(k,2818) - lu(k,2785) * lu(k,2805) + lu(k,2820) = lu(k,2820) - lu(k,2786) * lu(k,2805) + lu(k,2821) = lu(k,2821) - lu(k,2787) * lu(k,2805) + lu(k,2822) = lu(k,2822) - lu(k,2788) * lu(k,2805) + lu(k,2823) = lu(k,2823) - lu(k,2789) * lu(k,2805) + lu(k,2853) = lu(k,2853) - lu(k,2776) * lu(k,2851) + lu(k,2854) = lu(k,2854) - lu(k,2777) * lu(k,2851) + lu(k,2855) = lu(k,2855) - lu(k,2778) * lu(k,2851) + lu(k,2856) = lu(k,2856) - lu(k,2779) * lu(k,2851) + lu(k,2859) = lu(k,2859) - lu(k,2780) * lu(k,2851) + lu(k,2860) = lu(k,2860) - lu(k,2781) * lu(k,2851) + lu(k,2861) = lu(k,2861) - lu(k,2782) * lu(k,2851) + lu(k,2862) = lu(k,2862) - lu(k,2783) * lu(k,2851) + lu(k,2863) = lu(k,2863) - lu(k,2784) * lu(k,2851) + lu(k,2864) = lu(k,2864) - lu(k,2785) * lu(k,2851) + lu(k,2866) = lu(k,2866) - lu(k,2786) * lu(k,2851) + lu(k,2867) = lu(k,2867) - lu(k,2787) * lu(k,2851) + lu(k,2868) = lu(k,2868) - lu(k,2788) * lu(k,2851) + lu(k,2869) = lu(k,2869) - lu(k,2789) * lu(k,2851) + lu(k,2900) = lu(k,2900) - lu(k,2776) * lu(k,2898) + lu(k,2901) = lu(k,2901) - lu(k,2777) * lu(k,2898) + lu(k,2902) = lu(k,2902) - lu(k,2778) * lu(k,2898) + lu(k,2903) = lu(k,2903) - lu(k,2779) * lu(k,2898) + lu(k,2906) = lu(k,2906) - lu(k,2780) * lu(k,2898) + lu(k,2907) = lu(k,2907) - lu(k,2781) * lu(k,2898) + lu(k,2908) = lu(k,2908) - lu(k,2782) * lu(k,2898) + lu(k,2909) = lu(k,2909) - lu(k,2783) * lu(k,2898) + lu(k,2910) = lu(k,2910) - lu(k,2784) * lu(k,2898) + lu(k,2911) = lu(k,2911) - lu(k,2785) * lu(k,2898) + lu(k,2913) = lu(k,2913) - lu(k,2786) * lu(k,2898) + lu(k,2914) = lu(k,2914) - lu(k,2787) * lu(k,2898) + lu(k,2915) = lu(k,2915) - lu(k,2788) * lu(k,2898) + lu(k,2916) = lu(k,2916) - lu(k,2789) * lu(k,2898) + lu(k,2946) = lu(k,2946) - lu(k,2776) * lu(k,2944) + lu(k,2947) = lu(k,2947) - lu(k,2777) * lu(k,2944) + lu(k,2948) = lu(k,2948) - lu(k,2778) * lu(k,2944) + lu(k,2949) = lu(k,2949) - lu(k,2779) * lu(k,2944) + lu(k,2952) = lu(k,2952) - lu(k,2780) * lu(k,2944) + lu(k,2953) = lu(k,2953) - lu(k,2781) * lu(k,2944) + lu(k,2954) = lu(k,2954) - lu(k,2782) * lu(k,2944) + lu(k,2955) = lu(k,2955) - lu(k,2783) * lu(k,2944) + lu(k,2956) = lu(k,2956) - lu(k,2784) * lu(k,2944) + lu(k,2957) = lu(k,2957) - lu(k,2785) * lu(k,2944) + lu(k,2959) = lu(k,2959) - lu(k,2786) * lu(k,2944) + lu(k,2960) = lu(k,2960) - lu(k,2787) * lu(k,2944) + lu(k,2961) = lu(k,2961) - lu(k,2788) * lu(k,2944) + lu(k,2962) = lu(k,2962) - lu(k,2789) * lu(k,2944) + lu(k,3020) = lu(k,3020) - lu(k,2776) * lu(k,3018) + lu(k,3021) = lu(k,3021) - lu(k,2777) * lu(k,3018) + lu(k,3022) = lu(k,3022) - lu(k,2778) * lu(k,3018) + lu(k,3023) = lu(k,3023) - lu(k,2779) * lu(k,3018) + lu(k,3026) = lu(k,3026) - lu(k,2780) * lu(k,3018) + lu(k,3027) = lu(k,3027) - lu(k,2781) * lu(k,3018) + lu(k,3028) = lu(k,3028) - lu(k,2782) * lu(k,3018) + lu(k,3029) = lu(k,3029) - lu(k,2783) * lu(k,3018) + lu(k,3030) = lu(k,3030) - lu(k,2784) * lu(k,3018) + lu(k,3031) = lu(k,3031) - lu(k,2785) * lu(k,3018) + lu(k,3033) = lu(k,3033) - lu(k,2786) * lu(k,3018) + lu(k,3034) = lu(k,3034) - lu(k,2787) * lu(k,3018) + lu(k,3035) = lu(k,3035) - lu(k,2788) * lu(k,3018) + lu(k,3036) = lu(k,3036) - lu(k,2789) * lu(k,3018) + lu(k,3123) = lu(k,3123) - lu(k,2776) * lu(k,3121) + lu(k,3124) = lu(k,3124) - lu(k,2777) * lu(k,3121) + lu(k,3125) = lu(k,3125) - lu(k,2778) * lu(k,3121) + lu(k,3126) = lu(k,3126) - lu(k,2779) * lu(k,3121) + lu(k,3129) = lu(k,3129) - lu(k,2780) * lu(k,3121) + lu(k,3130) = lu(k,3130) - lu(k,2781) * lu(k,3121) + lu(k,3131) = lu(k,3131) - lu(k,2782) * lu(k,3121) + lu(k,3132) = lu(k,3132) - lu(k,2783) * lu(k,3121) + lu(k,3133) = lu(k,3133) - lu(k,2784) * lu(k,3121) + lu(k,3134) = lu(k,3134) - lu(k,2785) * lu(k,3121) + lu(k,3136) = lu(k,3136) - lu(k,2786) * lu(k,3121) + lu(k,3137) = lu(k,3137) - lu(k,2787) * lu(k,3121) + lu(k,3138) = lu(k,3138) - lu(k,2788) * lu(k,3121) + lu(k,3139) = lu(k,3139) - lu(k,2789) * lu(k,3121) + lu(k,3305) = lu(k,3305) - lu(k,2776) * lu(k,3303) + lu(k,3306) = lu(k,3306) - lu(k,2777) * lu(k,3303) + lu(k,3307) = lu(k,3307) - lu(k,2778) * lu(k,3303) + lu(k,3308) = lu(k,3308) - lu(k,2779) * lu(k,3303) + lu(k,3311) = lu(k,3311) - lu(k,2780) * lu(k,3303) + lu(k,3312) = lu(k,3312) - lu(k,2781) * lu(k,3303) + lu(k,3313) = lu(k,3313) - lu(k,2782) * lu(k,3303) + lu(k,3314) = lu(k,3314) - lu(k,2783) * lu(k,3303) + lu(k,3315) = lu(k,3315) - lu(k,2784) * lu(k,3303) + lu(k,3316) = lu(k,3316) - lu(k,2785) * lu(k,3303) + lu(k,3318) = lu(k,3318) - lu(k,2786) * lu(k,3303) + lu(k,3319) = lu(k,3319) - lu(k,2787) * lu(k,3303) + lu(k,3320) = lu(k,3320) - lu(k,2788) * lu(k,3303) + lu(k,3321) = lu(k,3321) - lu(k,2789) * lu(k,3303) + lu(k,3561) = lu(k,3561) - lu(k,2776) * lu(k,3559) + lu(k,3562) = lu(k,3562) - lu(k,2777) * lu(k,3559) + lu(k,3563) = lu(k,3563) - lu(k,2778) * lu(k,3559) + lu(k,3564) = lu(k,3564) - lu(k,2779) * lu(k,3559) + lu(k,3567) = lu(k,3567) - lu(k,2780) * lu(k,3559) + lu(k,3568) = lu(k,3568) - lu(k,2781) * lu(k,3559) + lu(k,3569) = lu(k,3569) - lu(k,2782) * lu(k,3559) + lu(k,3570) = lu(k,3570) - lu(k,2783) * lu(k,3559) + lu(k,3571) = lu(k,3571) - lu(k,2784) * lu(k,3559) + lu(k,3572) = lu(k,3572) - lu(k,2785) * lu(k,3559) + lu(k,3574) = lu(k,3574) - lu(k,2786) * lu(k,3559) + lu(k,3575) = lu(k,3575) - lu(k,2787) * lu(k,3559) + lu(k,3576) = lu(k,3576) - lu(k,2788) * lu(k,3559) + lu(k,3577) = lu(k,3577) - lu(k,2789) * lu(k,3559) + lu(k,3811) = lu(k,3811) - lu(k,2776) * lu(k,3809) + lu(k,3812) = lu(k,3812) - lu(k,2777) * lu(k,3809) + lu(k,3813) = lu(k,3813) - lu(k,2778) * lu(k,3809) + lu(k,3814) = lu(k,3814) - lu(k,2779) * lu(k,3809) + lu(k,3817) = lu(k,3817) - lu(k,2780) * lu(k,3809) + lu(k,3818) = lu(k,3818) - lu(k,2781) * lu(k,3809) + lu(k,3819) = lu(k,3819) - lu(k,2782) * lu(k,3809) + lu(k,3820) = lu(k,3820) - lu(k,2783) * lu(k,3809) + lu(k,3821) = lu(k,3821) - lu(k,2784) * lu(k,3809) + lu(k,3822) = lu(k,3822) - lu(k,2785) * lu(k,3809) + lu(k,3824) = lu(k,3824) - lu(k,2786) * lu(k,3809) + lu(k,3825) = lu(k,3825) - lu(k,2787) * lu(k,3809) + lu(k,3826) = lu(k,3826) - lu(k,2788) * lu(k,3809) + lu(k,3827) = lu(k,3827) - lu(k,2789) * lu(k,3809) + lu(k,3946) = lu(k,3946) - lu(k,2776) * lu(k,3944) + lu(k,3947) = lu(k,3947) - lu(k,2777) * lu(k,3944) + lu(k,3948) = lu(k,3948) - lu(k,2778) * lu(k,3944) + lu(k,3949) = lu(k,3949) - lu(k,2779) * lu(k,3944) + lu(k,3952) = lu(k,3952) - lu(k,2780) * lu(k,3944) + lu(k,3953) = lu(k,3953) - lu(k,2781) * lu(k,3944) + lu(k,3954) = lu(k,3954) - lu(k,2782) * lu(k,3944) + lu(k,3955) = lu(k,3955) - lu(k,2783) * lu(k,3944) + lu(k,3956) = lu(k,3956) - lu(k,2784) * lu(k,3944) + lu(k,3957) = lu(k,3957) - lu(k,2785) * lu(k,3944) + lu(k,3959) = lu(k,3959) - lu(k,2786) * lu(k,3944) + lu(k,3960) = lu(k,3960) - lu(k,2787) * lu(k,3944) + lu(k,3961) = lu(k,3961) - lu(k,2788) * lu(k,3944) + lu(k,3962) = lu(k,3962) - lu(k,2789) * lu(k,3944) + lu(k,4038) = lu(k,4038) - lu(k,2776) * lu(k,4036) + lu(k,4039) = lu(k,4039) - lu(k,2777) * lu(k,4036) + lu(k,4040) = lu(k,4040) - lu(k,2778) * lu(k,4036) + lu(k,4041) = lu(k,4041) - lu(k,2779) * lu(k,4036) + lu(k,4044) = lu(k,4044) - lu(k,2780) * lu(k,4036) + lu(k,4045) = lu(k,4045) - lu(k,2781) * lu(k,4036) + lu(k,4046) = lu(k,4046) - lu(k,2782) * lu(k,4036) + lu(k,4047) = lu(k,4047) - lu(k,2783) * lu(k,4036) + lu(k,4048) = lu(k,4048) - lu(k,2784) * lu(k,4036) + lu(k,4049) = lu(k,4049) - lu(k,2785) * lu(k,4036) + lu(k,4051) = lu(k,4051) - lu(k,2786) * lu(k,4036) + lu(k,4052) = lu(k,4052) - lu(k,2787) * lu(k,4036) + lu(k,4053) = lu(k,4053) - lu(k,2788) * lu(k,4036) + lu(k,4054) = lu(k,4054) - lu(k,2789) * lu(k,4036) + lu(k,4090) = lu(k,4090) - lu(k,2776) * lu(k,4089) + lu(k,4091) = lu(k,4091) - lu(k,2777) * lu(k,4089) + lu(k,4092) = lu(k,4092) - lu(k,2778) * lu(k,4089) + lu(k,4093) = lu(k,4093) - lu(k,2779) * lu(k,4089) + lu(k,4096) = lu(k,4096) - lu(k,2780) * lu(k,4089) + lu(k,4097) = lu(k,4097) - lu(k,2781) * lu(k,4089) + lu(k,4098) = lu(k,4098) - lu(k,2782) * lu(k,4089) + lu(k,4099) = lu(k,4099) - lu(k,2783) * lu(k,4089) + lu(k,4100) = lu(k,4100) - lu(k,2784) * lu(k,4089) + lu(k,4101) = lu(k,4101) - lu(k,2785) * lu(k,4089) + lu(k,4103) = lu(k,4103) - lu(k,2786) * lu(k,4089) + lu(k,4104) = lu(k,4104) - lu(k,2787) * lu(k,4089) + lu(k,4105) = lu(k,4105) - lu(k,2788) * lu(k,4089) + lu(k,4106) = lu(k,4106) - lu(k,2789) * lu(k,4089) + lu(k,2806) = 1._r8 / lu(k,2806) + lu(k,2807) = lu(k,2807) * lu(k,2806) + lu(k,2808) = lu(k,2808) * lu(k,2806) + lu(k,2809) = lu(k,2809) * lu(k,2806) + lu(k,2810) = lu(k,2810) * lu(k,2806) + lu(k,2811) = lu(k,2811) * lu(k,2806) + lu(k,2812) = lu(k,2812) * lu(k,2806) + lu(k,2813) = lu(k,2813) * lu(k,2806) + lu(k,2814) = lu(k,2814) * lu(k,2806) + lu(k,2815) = lu(k,2815) * lu(k,2806) + lu(k,2816) = lu(k,2816) * lu(k,2806) + lu(k,2817) = lu(k,2817) * lu(k,2806) + lu(k,2818) = lu(k,2818) * lu(k,2806) + lu(k,2819) = lu(k,2819) * lu(k,2806) + lu(k,2820) = lu(k,2820) * lu(k,2806) + lu(k,2821) = lu(k,2821) * lu(k,2806) + lu(k,2822) = lu(k,2822) * lu(k,2806) + lu(k,2823) = lu(k,2823) * lu(k,2806) + lu(k,2853) = lu(k,2853) - lu(k,2807) * lu(k,2852) + lu(k,2854) = lu(k,2854) - lu(k,2808) * lu(k,2852) + lu(k,2855) = lu(k,2855) - lu(k,2809) * lu(k,2852) + lu(k,2856) = lu(k,2856) - lu(k,2810) * lu(k,2852) + lu(k,2857) = lu(k,2857) - lu(k,2811) * lu(k,2852) + lu(k,2858) = lu(k,2858) - lu(k,2812) * lu(k,2852) + lu(k,2859) = lu(k,2859) - lu(k,2813) * lu(k,2852) + lu(k,2860) = lu(k,2860) - lu(k,2814) * lu(k,2852) + lu(k,2861) = lu(k,2861) - lu(k,2815) * lu(k,2852) + lu(k,2862) = lu(k,2862) - lu(k,2816) * lu(k,2852) + lu(k,2863) = lu(k,2863) - lu(k,2817) * lu(k,2852) + lu(k,2864) = lu(k,2864) - lu(k,2818) * lu(k,2852) + lu(k,2865) = lu(k,2865) - lu(k,2819) * lu(k,2852) + lu(k,2866) = lu(k,2866) - lu(k,2820) * lu(k,2852) + lu(k,2867) = lu(k,2867) - lu(k,2821) * lu(k,2852) + lu(k,2868) = lu(k,2868) - lu(k,2822) * lu(k,2852) + lu(k,2869) = lu(k,2869) - lu(k,2823) * lu(k,2852) + lu(k,2900) = lu(k,2900) - lu(k,2807) * lu(k,2899) + lu(k,2901) = lu(k,2901) - lu(k,2808) * lu(k,2899) + lu(k,2902) = lu(k,2902) - lu(k,2809) * lu(k,2899) + lu(k,2903) = lu(k,2903) - lu(k,2810) * lu(k,2899) + lu(k,2904) = lu(k,2904) - lu(k,2811) * lu(k,2899) + lu(k,2905) = lu(k,2905) - lu(k,2812) * lu(k,2899) + lu(k,2906) = lu(k,2906) - lu(k,2813) * lu(k,2899) + lu(k,2907) = lu(k,2907) - lu(k,2814) * lu(k,2899) + lu(k,2908) = lu(k,2908) - lu(k,2815) * lu(k,2899) + lu(k,2909) = lu(k,2909) - lu(k,2816) * lu(k,2899) + lu(k,2910) = lu(k,2910) - lu(k,2817) * lu(k,2899) + lu(k,2911) = lu(k,2911) - lu(k,2818) * lu(k,2899) + lu(k,2912) = lu(k,2912) - lu(k,2819) * lu(k,2899) + lu(k,2913) = lu(k,2913) - lu(k,2820) * lu(k,2899) + lu(k,2914) = lu(k,2914) - lu(k,2821) * lu(k,2899) + lu(k,2915) = lu(k,2915) - lu(k,2822) * lu(k,2899) + lu(k,2916) = lu(k,2916) - lu(k,2823) * lu(k,2899) + lu(k,2946) = lu(k,2946) - lu(k,2807) * lu(k,2945) + lu(k,2947) = lu(k,2947) - lu(k,2808) * lu(k,2945) + lu(k,2948) = lu(k,2948) - lu(k,2809) * lu(k,2945) + lu(k,2949) = lu(k,2949) - lu(k,2810) * lu(k,2945) + lu(k,2950) = lu(k,2950) - lu(k,2811) * lu(k,2945) + lu(k,2951) = lu(k,2951) - lu(k,2812) * lu(k,2945) + lu(k,2952) = lu(k,2952) - lu(k,2813) * lu(k,2945) + lu(k,2953) = lu(k,2953) - lu(k,2814) * lu(k,2945) + lu(k,2954) = lu(k,2954) - lu(k,2815) * lu(k,2945) + lu(k,2955) = lu(k,2955) - lu(k,2816) * lu(k,2945) + lu(k,2956) = lu(k,2956) - lu(k,2817) * lu(k,2945) + lu(k,2957) = lu(k,2957) - lu(k,2818) * lu(k,2945) + lu(k,2958) = lu(k,2958) - lu(k,2819) * lu(k,2945) + lu(k,2959) = lu(k,2959) - lu(k,2820) * lu(k,2945) + lu(k,2960) = lu(k,2960) - lu(k,2821) * lu(k,2945) + lu(k,2961) = lu(k,2961) - lu(k,2822) * lu(k,2945) + lu(k,2962) = lu(k,2962) - lu(k,2823) * lu(k,2945) + lu(k,3020) = lu(k,3020) - lu(k,2807) * lu(k,3019) + lu(k,3021) = lu(k,3021) - lu(k,2808) * lu(k,3019) + lu(k,3022) = lu(k,3022) - lu(k,2809) * lu(k,3019) + lu(k,3023) = lu(k,3023) - lu(k,2810) * lu(k,3019) + lu(k,3024) = lu(k,3024) - lu(k,2811) * lu(k,3019) + lu(k,3025) = lu(k,3025) - lu(k,2812) * lu(k,3019) + lu(k,3026) = lu(k,3026) - lu(k,2813) * lu(k,3019) + lu(k,3027) = lu(k,3027) - lu(k,2814) * lu(k,3019) + lu(k,3028) = lu(k,3028) - lu(k,2815) * lu(k,3019) + lu(k,3029) = lu(k,3029) - lu(k,2816) * lu(k,3019) + lu(k,3030) = lu(k,3030) - lu(k,2817) * lu(k,3019) + lu(k,3031) = lu(k,3031) - lu(k,2818) * lu(k,3019) + lu(k,3032) = lu(k,3032) - lu(k,2819) * lu(k,3019) + lu(k,3033) = lu(k,3033) - lu(k,2820) * lu(k,3019) + lu(k,3034) = lu(k,3034) - lu(k,2821) * lu(k,3019) + lu(k,3035) = lu(k,3035) - lu(k,2822) * lu(k,3019) + lu(k,3036) = lu(k,3036) - lu(k,2823) * lu(k,3019) + lu(k,3123) = lu(k,3123) - lu(k,2807) * lu(k,3122) + lu(k,3124) = lu(k,3124) - lu(k,2808) * lu(k,3122) + lu(k,3125) = lu(k,3125) - lu(k,2809) * lu(k,3122) + lu(k,3126) = lu(k,3126) - lu(k,2810) * lu(k,3122) + lu(k,3127) = lu(k,3127) - lu(k,2811) * lu(k,3122) + lu(k,3128) = lu(k,3128) - lu(k,2812) * lu(k,3122) + lu(k,3129) = lu(k,3129) - lu(k,2813) * lu(k,3122) + lu(k,3130) = lu(k,3130) - lu(k,2814) * lu(k,3122) + lu(k,3131) = lu(k,3131) - lu(k,2815) * lu(k,3122) + lu(k,3132) = lu(k,3132) - lu(k,2816) * lu(k,3122) + lu(k,3133) = lu(k,3133) - lu(k,2817) * lu(k,3122) + lu(k,3134) = lu(k,3134) - lu(k,2818) * lu(k,3122) + lu(k,3135) = lu(k,3135) - lu(k,2819) * lu(k,3122) + lu(k,3136) = lu(k,3136) - lu(k,2820) * lu(k,3122) + lu(k,3137) = lu(k,3137) - lu(k,2821) * lu(k,3122) + lu(k,3138) = lu(k,3138) - lu(k,2822) * lu(k,3122) + lu(k,3139) = lu(k,3139) - lu(k,2823) * lu(k,3122) + lu(k,3305) = lu(k,3305) - lu(k,2807) * lu(k,3304) + lu(k,3306) = lu(k,3306) - lu(k,2808) * lu(k,3304) + lu(k,3307) = lu(k,3307) - lu(k,2809) * lu(k,3304) + lu(k,3308) = lu(k,3308) - lu(k,2810) * lu(k,3304) + lu(k,3309) = lu(k,3309) - lu(k,2811) * lu(k,3304) + lu(k,3310) = lu(k,3310) - lu(k,2812) * lu(k,3304) + lu(k,3311) = lu(k,3311) - lu(k,2813) * lu(k,3304) + lu(k,3312) = lu(k,3312) - lu(k,2814) * lu(k,3304) + lu(k,3313) = lu(k,3313) - lu(k,2815) * lu(k,3304) + lu(k,3314) = lu(k,3314) - lu(k,2816) * lu(k,3304) + lu(k,3315) = lu(k,3315) - lu(k,2817) * lu(k,3304) + lu(k,3316) = lu(k,3316) - lu(k,2818) * lu(k,3304) + lu(k,3317) = lu(k,3317) - lu(k,2819) * lu(k,3304) + lu(k,3318) = lu(k,3318) - lu(k,2820) * lu(k,3304) + lu(k,3319) = lu(k,3319) - lu(k,2821) * lu(k,3304) + lu(k,3320) = lu(k,3320) - lu(k,2822) * lu(k,3304) + lu(k,3321) = lu(k,3321) - lu(k,2823) * lu(k,3304) + lu(k,3561) = lu(k,3561) - lu(k,2807) * lu(k,3560) + lu(k,3562) = lu(k,3562) - lu(k,2808) * lu(k,3560) + lu(k,3563) = lu(k,3563) - lu(k,2809) * lu(k,3560) + lu(k,3564) = lu(k,3564) - lu(k,2810) * lu(k,3560) + lu(k,3565) = lu(k,3565) - lu(k,2811) * lu(k,3560) + lu(k,3566) = lu(k,3566) - lu(k,2812) * lu(k,3560) + lu(k,3567) = lu(k,3567) - lu(k,2813) * lu(k,3560) + lu(k,3568) = lu(k,3568) - lu(k,2814) * lu(k,3560) + lu(k,3569) = lu(k,3569) - lu(k,2815) * lu(k,3560) + lu(k,3570) = lu(k,3570) - lu(k,2816) * lu(k,3560) + lu(k,3571) = lu(k,3571) - lu(k,2817) * lu(k,3560) + lu(k,3572) = lu(k,3572) - lu(k,2818) * lu(k,3560) + lu(k,3573) = lu(k,3573) - lu(k,2819) * lu(k,3560) + lu(k,3574) = lu(k,3574) - lu(k,2820) * lu(k,3560) + lu(k,3575) = lu(k,3575) - lu(k,2821) * lu(k,3560) + lu(k,3576) = lu(k,3576) - lu(k,2822) * lu(k,3560) + lu(k,3577) = lu(k,3577) - lu(k,2823) * lu(k,3560) + lu(k,3811) = lu(k,3811) - lu(k,2807) * lu(k,3810) + lu(k,3812) = lu(k,3812) - lu(k,2808) * lu(k,3810) + lu(k,3813) = lu(k,3813) - lu(k,2809) * lu(k,3810) + lu(k,3814) = lu(k,3814) - lu(k,2810) * lu(k,3810) + lu(k,3815) = lu(k,3815) - lu(k,2811) * lu(k,3810) + lu(k,3816) = lu(k,3816) - lu(k,2812) * lu(k,3810) + lu(k,3817) = lu(k,3817) - lu(k,2813) * lu(k,3810) + lu(k,3818) = lu(k,3818) - lu(k,2814) * lu(k,3810) + lu(k,3819) = lu(k,3819) - lu(k,2815) * lu(k,3810) + lu(k,3820) = lu(k,3820) - lu(k,2816) * lu(k,3810) + lu(k,3821) = lu(k,3821) - lu(k,2817) * lu(k,3810) + lu(k,3822) = lu(k,3822) - lu(k,2818) * lu(k,3810) + lu(k,3823) = lu(k,3823) - lu(k,2819) * lu(k,3810) + lu(k,3824) = lu(k,3824) - lu(k,2820) * lu(k,3810) + lu(k,3825) = lu(k,3825) - lu(k,2821) * lu(k,3810) + lu(k,3826) = lu(k,3826) - lu(k,2822) * lu(k,3810) + lu(k,3827) = lu(k,3827) - lu(k,2823) * lu(k,3810) + lu(k,3946) = lu(k,3946) - lu(k,2807) * lu(k,3945) + lu(k,3947) = lu(k,3947) - lu(k,2808) * lu(k,3945) + lu(k,3948) = lu(k,3948) - lu(k,2809) * lu(k,3945) + lu(k,3949) = lu(k,3949) - lu(k,2810) * lu(k,3945) + lu(k,3950) = lu(k,3950) - lu(k,2811) * lu(k,3945) + lu(k,3951) = lu(k,3951) - lu(k,2812) * lu(k,3945) + lu(k,3952) = lu(k,3952) - lu(k,2813) * lu(k,3945) + lu(k,3953) = lu(k,3953) - lu(k,2814) * lu(k,3945) + lu(k,3954) = lu(k,3954) - lu(k,2815) * lu(k,3945) + lu(k,3955) = lu(k,3955) - lu(k,2816) * lu(k,3945) + lu(k,3956) = lu(k,3956) - lu(k,2817) * lu(k,3945) + lu(k,3957) = lu(k,3957) - lu(k,2818) * lu(k,3945) + lu(k,3958) = lu(k,3958) - lu(k,2819) * lu(k,3945) + lu(k,3959) = lu(k,3959) - lu(k,2820) * lu(k,3945) + lu(k,3960) = lu(k,3960) - lu(k,2821) * lu(k,3945) + lu(k,3961) = lu(k,3961) - lu(k,2822) * lu(k,3945) + lu(k,3962) = lu(k,3962) - lu(k,2823) * lu(k,3945) + lu(k,4038) = lu(k,4038) - lu(k,2807) * lu(k,4037) + lu(k,4039) = lu(k,4039) - lu(k,2808) * lu(k,4037) + lu(k,4040) = lu(k,4040) - lu(k,2809) * lu(k,4037) + lu(k,4041) = lu(k,4041) - lu(k,2810) * lu(k,4037) + lu(k,4042) = lu(k,4042) - lu(k,2811) * lu(k,4037) + lu(k,4043) = lu(k,4043) - lu(k,2812) * lu(k,4037) + lu(k,4044) = lu(k,4044) - lu(k,2813) * lu(k,4037) + lu(k,4045) = lu(k,4045) - lu(k,2814) * lu(k,4037) + lu(k,4046) = lu(k,4046) - lu(k,2815) * lu(k,4037) + lu(k,4047) = lu(k,4047) - lu(k,2816) * lu(k,4037) + lu(k,4048) = lu(k,4048) - lu(k,2817) * lu(k,4037) + lu(k,4049) = lu(k,4049) - lu(k,2818) * lu(k,4037) + lu(k,4050) = lu(k,4050) - lu(k,2819) * lu(k,4037) + lu(k,4051) = lu(k,4051) - lu(k,2820) * lu(k,4037) + lu(k,4052) = lu(k,4052) - lu(k,2821) * lu(k,4037) + lu(k,4053) = lu(k,4053) - lu(k,2822) * lu(k,4037) + lu(k,4054) = lu(k,4054) - lu(k,2823) * lu(k,4037) + lu(k,2853) = 1._r8 / lu(k,2853) + lu(k,2854) = lu(k,2854) * lu(k,2853) + lu(k,2855) = lu(k,2855) * lu(k,2853) + lu(k,2856) = lu(k,2856) * lu(k,2853) + lu(k,2857) = lu(k,2857) * lu(k,2853) + lu(k,2858) = lu(k,2858) * lu(k,2853) + lu(k,2859) = lu(k,2859) * lu(k,2853) + lu(k,2860) = lu(k,2860) * lu(k,2853) + lu(k,2861) = lu(k,2861) * lu(k,2853) + lu(k,2862) = lu(k,2862) * lu(k,2853) + lu(k,2863) = lu(k,2863) * lu(k,2853) + lu(k,2864) = lu(k,2864) * lu(k,2853) + lu(k,2865) = lu(k,2865) * lu(k,2853) + lu(k,2866) = lu(k,2866) * lu(k,2853) + lu(k,2867) = lu(k,2867) * lu(k,2853) + lu(k,2868) = lu(k,2868) * lu(k,2853) + lu(k,2869) = lu(k,2869) * lu(k,2853) + lu(k,2901) = lu(k,2901) - lu(k,2854) * lu(k,2900) + lu(k,2902) = lu(k,2902) - lu(k,2855) * lu(k,2900) + lu(k,2903) = lu(k,2903) - lu(k,2856) * lu(k,2900) + lu(k,2904) = lu(k,2904) - lu(k,2857) * lu(k,2900) + lu(k,2905) = lu(k,2905) - lu(k,2858) * lu(k,2900) + lu(k,2906) = lu(k,2906) - lu(k,2859) * lu(k,2900) + lu(k,2907) = lu(k,2907) - lu(k,2860) * lu(k,2900) + lu(k,2908) = lu(k,2908) - lu(k,2861) * lu(k,2900) + lu(k,2909) = lu(k,2909) - lu(k,2862) * lu(k,2900) + lu(k,2910) = lu(k,2910) - lu(k,2863) * lu(k,2900) + lu(k,2911) = lu(k,2911) - lu(k,2864) * lu(k,2900) + lu(k,2912) = lu(k,2912) - lu(k,2865) * lu(k,2900) + lu(k,2913) = lu(k,2913) - lu(k,2866) * lu(k,2900) + lu(k,2914) = lu(k,2914) - lu(k,2867) * lu(k,2900) + lu(k,2915) = lu(k,2915) - lu(k,2868) * lu(k,2900) + lu(k,2916) = lu(k,2916) - lu(k,2869) * lu(k,2900) + lu(k,2947) = lu(k,2947) - lu(k,2854) * lu(k,2946) + lu(k,2948) = lu(k,2948) - lu(k,2855) * lu(k,2946) + lu(k,2949) = lu(k,2949) - lu(k,2856) * lu(k,2946) + lu(k,2950) = lu(k,2950) - lu(k,2857) * lu(k,2946) + lu(k,2951) = lu(k,2951) - lu(k,2858) * lu(k,2946) + lu(k,2952) = lu(k,2952) - lu(k,2859) * lu(k,2946) + lu(k,2953) = lu(k,2953) - lu(k,2860) * lu(k,2946) + lu(k,2954) = lu(k,2954) - lu(k,2861) * lu(k,2946) + lu(k,2955) = lu(k,2955) - lu(k,2862) * lu(k,2946) + lu(k,2956) = lu(k,2956) - lu(k,2863) * lu(k,2946) + lu(k,2957) = lu(k,2957) - lu(k,2864) * lu(k,2946) + lu(k,2958) = lu(k,2958) - lu(k,2865) * lu(k,2946) + lu(k,2959) = lu(k,2959) - lu(k,2866) * lu(k,2946) + lu(k,2960) = lu(k,2960) - lu(k,2867) * lu(k,2946) + lu(k,2961) = lu(k,2961) - lu(k,2868) * lu(k,2946) + lu(k,2962) = lu(k,2962) - lu(k,2869) * lu(k,2946) + lu(k,3021) = lu(k,3021) - lu(k,2854) * lu(k,3020) + lu(k,3022) = lu(k,3022) - lu(k,2855) * lu(k,3020) + lu(k,3023) = lu(k,3023) - lu(k,2856) * lu(k,3020) + lu(k,3024) = lu(k,3024) - lu(k,2857) * lu(k,3020) + lu(k,3025) = lu(k,3025) - lu(k,2858) * lu(k,3020) + lu(k,3026) = lu(k,3026) - lu(k,2859) * lu(k,3020) + lu(k,3027) = lu(k,3027) - lu(k,2860) * lu(k,3020) + lu(k,3028) = lu(k,3028) - lu(k,2861) * lu(k,3020) + lu(k,3029) = lu(k,3029) - lu(k,2862) * lu(k,3020) + lu(k,3030) = lu(k,3030) - lu(k,2863) * lu(k,3020) + lu(k,3031) = lu(k,3031) - lu(k,2864) * lu(k,3020) + lu(k,3032) = lu(k,3032) - lu(k,2865) * lu(k,3020) + lu(k,3033) = lu(k,3033) - lu(k,2866) * lu(k,3020) + lu(k,3034) = lu(k,3034) - lu(k,2867) * lu(k,3020) + lu(k,3035) = lu(k,3035) - lu(k,2868) * lu(k,3020) + lu(k,3036) = lu(k,3036) - lu(k,2869) * lu(k,3020) + lu(k,3124) = lu(k,3124) - lu(k,2854) * lu(k,3123) + lu(k,3125) = lu(k,3125) - lu(k,2855) * lu(k,3123) + lu(k,3126) = lu(k,3126) - lu(k,2856) * lu(k,3123) + lu(k,3127) = lu(k,3127) - lu(k,2857) * lu(k,3123) + lu(k,3128) = lu(k,3128) - lu(k,2858) * lu(k,3123) + lu(k,3129) = lu(k,3129) - lu(k,2859) * lu(k,3123) + lu(k,3130) = lu(k,3130) - lu(k,2860) * lu(k,3123) + lu(k,3131) = lu(k,3131) - lu(k,2861) * lu(k,3123) + lu(k,3132) = lu(k,3132) - lu(k,2862) * lu(k,3123) + lu(k,3133) = lu(k,3133) - lu(k,2863) * lu(k,3123) + lu(k,3134) = lu(k,3134) - lu(k,2864) * lu(k,3123) + lu(k,3135) = lu(k,3135) - lu(k,2865) * lu(k,3123) + lu(k,3136) = lu(k,3136) - lu(k,2866) * lu(k,3123) + lu(k,3137) = lu(k,3137) - lu(k,2867) * lu(k,3123) + lu(k,3138) = lu(k,3138) - lu(k,2868) * lu(k,3123) + lu(k,3139) = lu(k,3139) - lu(k,2869) * lu(k,3123) + lu(k,3306) = lu(k,3306) - lu(k,2854) * lu(k,3305) + lu(k,3307) = lu(k,3307) - lu(k,2855) * lu(k,3305) + lu(k,3308) = lu(k,3308) - lu(k,2856) * lu(k,3305) + lu(k,3309) = lu(k,3309) - lu(k,2857) * lu(k,3305) + lu(k,3310) = lu(k,3310) - lu(k,2858) * lu(k,3305) + lu(k,3311) = lu(k,3311) - lu(k,2859) * lu(k,3305) + lu(k,3312) = lu(k,3312) - lu(k,2860) * lu(k,3305) + lu(k,3313) = lu(k,3313) - lu(k,2861) * lu(k,3305) + lu(k,3314) = lu(k,3314) - lu(k,2862) * lu(k,3305) + lu(k,3315) = lu(k,3315) - lu(k,2863) * lu(k,3305) + lu(k,3316) = lu(k,3316) - lu(k,2864) * lu(k,3305) + lu(k,3317) = lu(k,3317) - lu(k,2865) * lu(k,3305) + lu(k,3318) = lu(k,3318) - lu(k,2866) * lu(k,3305) + lu(k,3319) = lu(k,3319) - lu(k,2867) * lu(k,3305) + lu(k,3320) = lu(k,3320) - lu(k,2868) * lu(k,3305) + lu(k,3321) = lu(k,3321) - lu(k,2869) * lu(k,3305) + lu(k,3562) = lu(k,3562) - lu(k,2854) * lu(k,3561) + lu(k,3563) = lu(k,3563) - lu(k,2855) * lu(k,3561) + lu(k,3564) = lu(k,3564) - lu(k,2856) * lu(k,3561) + lu(k,3565) = lu(k,3565) - lu(k,2857) * lu(k,3561) + lu(k,3566) = lu(k,3566) - lu(k,2858) * lu(k,3561) + lu(k,3567) = lu(k,3567) - lu(k,2859) * lu(k,3561) + lu(k,3568) = lu(k,3568) - lu(k,2860) * lu(k,3561) + lu(k,3569) = lu(k,3569) - lu(k,2861) * lu(k,3561) + lu(k,3570) = lu(k,3570) - lu(k,2862) * lu(k,3561) + lu(k,3571) = lu(k,3571) - lu(k,2863) * lu(k,3561) + lu(k,3572) = lu(k,3572) - lu(k,2864) * lu(k,3561) + lu(k,3573) = lu(k,3573) - lu(k,2865) * lu(k,3561) + lu(k,3574) = lu(k,3574) - lu(k,2866) * lu(k,3561) + lu(k,3575) = lu(k,3575) - lu(k,2867) * lu(k,3561) + lu(k,3576) = lu(k,3576) - lu(k,2868) * lu(k,3561) + lu(k,3577) = lu(k,3577) - lu(k,2869) * lu(k,3561) + lu(k,3812) = lu(k,3812) - lu(k,2854) * lu(k,3811) + lu(k,3813) = lu(k,3813) - lu(k,2855) * lu(k,3811) + lu(k,3814) = lu(k,3814) - lu(k,2856) * lu(k,3811) + lu(k,3815) = lu(k,3815) - lu(k,2857) * lu(k,3811) + lu(k,3816) = lu(k,3816) - lu(k,2858) * lu(k,3811) + lu(k,3817) = lu(k,3817) - lu(k,2859) * lu(k,3811) + lu(k,3818) = lu(k,3818) - lu(k,2860) * lu(k,3811) + lu(k,3819) = lu(k,3819) - lu(k,2861) * lu(k,3811) + lu(k,3820) = lu(k,3820) - lu(k,2862) * lu(k,3811) + lu(k,3821) = lu(k,3821) - lu(k,2863) * lu(k,3811) + lu(k,3822) = lu(k,3822) - lu(k,2864) * lu(k,3811) + lu(k,3823) = lu(k,3823) - lu(k,2865) * lu(k,3811) + lu(k,3824) = lu(k,3824) - lu(k,2866) * lu(k,3811) + lu(k,3825) = lu(k,3825) - lu(k,2867) * lu(k,3811) + lu(k,3826) = lu(k,3826) - lu(k,2868) * lu(k,3811) + lu(k,3827) = lu(k,3827) - lu(k,2869) * lu(k,3811) + lu(k,3947) = lu(k,3947) - lu(k,2854) * lu(k,3946) + lu(k,3948) = lu(k,3948) - lu(k,2855) * lu(k,3946) + lu(k,3949) = lu(k,3949) - lu(k,2856) * lu(k,3946) + lu(k,3950) = lu(k,3950) - lu(k,2857) * lu(k,3946) + lu(k,3951) = lu(k,3951) - lu(k,2858) * lu(k,3946) + lu(k,3952) = lu(k,3952) - lu(k,2859) * lu(k,3946) + lu(k,3953) = lu(k,3953) - lu(k,2860) * lu(k,3946) + lu(k,3954) = lu(k,3954) - lu(k,2861) * lu(k,3946) + lu(k,3955) = lu(k,3955) - lu(k,2862) * lu(k,3946) + lu(k,3956) = lu(k,3956) - lu(k,2863) * lu(k,3946) + lu(k,3957) = lu(k,3957) - lu(k,2864) * lu(k,3946) + lu(k,3958) = lu(k,3958) - lu(k,2865) * lu(k,3946) + lu(k,3959) = lu(k,3959) - lu(k,2866) * lu(k,3946) + lu(k,3960) = lu(k,3960) - lu(k,2867) * lu(k,3946) + lu(k,3961) = lu(k,3961) - lu(k,2868) * lu(k,3946) + lu(k,3962) = lu(k,3962) - lu(k,2869) * lu(k,3946) + lu(k,4039) = lu(k,4039) - lu(k,2854) * lu(k,4038) + lu(k,4040) = lu(k,4040) - lu(k,2855) * lu(k,4038) + lu(k,4041) = lu(k,4041) - lu(k,2856) * lu(k,4038) + lu(k,4042) = lu(k,4042) - lu(k,2857) * lu(k,4038) + lu(k,4043) = lu(k,4043) - lu(k,2858) * lu(k,4038) + lu(k,4044) = lu(k,4044) - lu(k,2859) * lu(k,4038) + lu(k,4045) = lu(k,4045) - lu(k,2860) * lu(k,4038) + lu(k,4046) = lu(k,4046) - lu(k,2861) * lu(k,4038) + lu(k,4047) = lu(k,4047) - lu(k,2862) * lu(k,4038) + lu(k,4048) = lu(k,4048) - lu(k,2863) * lu(k,4038) + lu(k,4049) = lu(k,4049) - lu(k,2864) * lu(k,4038) + lu(k,4050) = lu(k,4050) - lu(k,2865) * lu(k,4038) + lu(k,4051) = lu(k,4051) - lu(k,2866) * lu(k,4038) + lu(k,4052) = lu(k,4052) - lu(k,2867) * lu(k,4038) + lu(k,4053) = lu(k,4053) - lu(k,2868) * lu(k,4038) + lu(k,4054) = lu(k,4054) - lu(k,2869) * lu(k,4038) + lu(k,4091) = lu(k,4091) - lu(k,2854) * lu(k,4090) + lu(k,4092) = lu(k,4092) - lu(k,2855) * lu(k,4090) + lu(k,4093) = lu(k,4093) - lu(k,2856) * lu(k,4090) + lu(k,4094) = lu(k,4094) - lu(k,2857) * lu(k,4090) + lu(k,4095) = lu(k,4095) - lu(k,2858) * lu(k,4090) + lu(k,4096) = lu(k,4096) - lu(k,2859) * lu(k,4090) + lu(k,4097) = lu(k,4097) - lu(k,2860) * lu(k,4090) + lu(k,4098) = lu(k,4098) - lu(k,2861) * lu(k,4090) + lu(k,4099) = lu(k,4099) - lu(k,2862) * lu(k,4090) + lu(k,4100) = lu(k,4100) - lu(k,2863) * lu(k,4090) + lu(k,4101) = lu(k,4101) - lu(k,2864) * lu(k,4090) + lu(k,4102) = lu(k,4102) - lu(k,2865) * lu(k,4090) + lu(k,4103) = lu(k,4103) - lu(k,2866) * lu(k,4090) + lu(k,4104) = lu(k,4104) - lu(k,2867) * lu(k,4090) + lu(k,4105) = lu(k,4105) - lu(k,2868) * lu(k,4090) + lu(k,4106) = lu(k,4106) - lu(k,2869) * lu(k,4090) + lu(k,2901) = 1._r8 / lu(k,2901) + lu(k,2902) = lu(k,2902) * lu(k,2901) + lu(k,2903) = lu(k,2903) * lu(k,2901) + lu(k,2904) = lu(k,2904) * lu(k,2901) + lu(k,2905) = lu(k,2905) * lu(k,2901) + lu(k,2906) = lu(k,2906) * lu(k,2901) + lu(k,2907) = lu(k,2907) * lu(k,2901) + lu(k,2908) = lu(k,2908) * lu(k,2901) + lu(k,2909) = lu(k,2909) * lu(k,2901) + lu(k,2910) = lu(k,2910) * lu(k,2901) + lu(k,2911) = lu(k,2911) * lu(k,2901) + lu(k,2912) = lu(k,2912) * lu(k,2901) + lu(k,2913) = lu(k,2913) * lu(k,2901) + lu(k,2914) = lu(k,2914) * lu(k,2901) + lu(k,2915) = lu(k,2915) * lu(k,2901) + lu(k,2916) = lu(k,2916) * lu(k,2901) + lu(k,2948) = lu(k,2948) - lu(k,2902) * lu(k,2947) + lu(k,2949) = lu(k,2949) - lu(k,2903) * lu(k,2947) + lu(k,2950) = lu(k,2950) - lu(k,2904) * lu(k,2947) + lu(k,2951) = lu(k,2951) - lu(k,2905) * lu(k,2947) + lu(k,2952) = lu(k,2952) - lu(k,2906) * lu(k,2947) + lu(k,2953) = lu(k,2953) - lu(k,2907) * lu(k,2947) + lu(k,2954) = lu(k,2954) - lu(k,2908) * lu(k,2947) + lu(k,2955) = lu(k,2955) - lu(k,2909) * lu(k,2947) + lu(k,2956) = lu(k,2956) - lu(k,2910) * lu(k,2947) + lu(k,2957) = lu(k,2957) - lu(k,2911) * lu(k,2947) + lu(k,2958) = lu(k,2958) - lu(k,2912) * lu(k,2947) + lu(k,2959) = lu(k,2959) - lu(k,2913) * lu(k,2947) + lu(k,2960) = lu(k,2960) - lu(k,2914) * lu(k,2947) + lu(k,2961) = lu(k,2961) - lu(k,2915) * lu(k,2947) + lu(k,2962) = lu(k,2962) - lu(k,2916) * lu(k,2947) + lu(k,3022) = lu(k,3022) - lu(k,2902) * lu(k,3021) + lu(k,3023) = lu(k,3023) - lu(k,2903) * lu(k,3021) + lu(k,3024) = lu(k,3024) - lu(k,2904) * lu(k,3021) + lu(k,3025) = lu(k,3025) - lu(k,2905) * lu(k,3021) + lu(k,3026) = lu(k,3026) - lu(k,2906) * lu(k,3021) + lu(k,3027) = lu(k,3027) - lu(k,2907) * lu(k,3021) + lu(k,3028) = lu(k,3028) - lu(k,2908) * lu(k,3021) + lu(k,3029) = lu(k,3029) - lu(k,2909) * lu(k,3021) + lu(k,3030) = lu(k,3030) - lu(k,2910) * lu(k,3021) + lu(k,3031) = lu(k,3031) - lu(k,2911) * lu(k,3021) + lu(k,3032) = lu(k,3032) - lu(k,2912) * lu(k,3021) + lu(k,3033) = lu(k,3033) - lu(k,2913) * lu(k,3021) + lu(k,3034) = lu(k,3034) - lu(k,2914) * lu(k,3021) + lu(k,3035) = lu(k,3035) - lu(k,2915) * lu(k,3021) + lu(k,3036) = lu(k,3036) - lu(k,2916) * lu(k,3021) + lu(k,3125) = lu(k,3125) - lu(k,2902) * lu(k,3124) + lu(k,3126) = lu(k,3126) - lu(k,2903) * lu(k,3124) + lu(k,3127) = lu(k,3127) - lu(k,2904) * lu(k,3124) + lu(k,3128) = lu(k,3128) - lu(k,2905) * lu(k,3124) + lu(k,3129) = lu(k,3129) - lu(k,2906) * lu(k,3124) + lu(k,3130) = lu(k,3130) - lu(k,2907) * lu(k,3124) + lu(k,3131) = lu(k,3131) - lu(k,2908) * lu(k,3124) + lu(k,3132) = lu(k,3132) - lu(k,2909) * lu(k,3124) + lu(k,3133) = lu(k,3133) - lu(k,2910) * lu(k,3124) + lu(k,3134) = lu(k,3134) - lu(k,2911) * lu(k,3124) + lu(k,3135) = lu(k,3135) - lu(k,2912) * lu(k,3124) + lu(k,3136) = lu(k,3136) - lu(k,2913) * lu(k,3124) + lu(k,3137) = lu(k,3137) - lu(k,2914) * lu(k,3124) + lu(k,3138) = lu(k,3138) - lu(k,2915) * lu(k,3124) + lu(k,3139) = lu(k,3139) - lu(k,2916) * lu(k,3124) + lu(k,3307) = lu(k,3307) - lu(k,2902) * lu(k,3306) + lu(k,3308) = lu(k,3308) - lu(k,2903) * lu(k,3306) + lu(k,3309) = lu(k,3309) - lu(k,2904) * lu(k,3306) + lu(k,3310) = lu(k,3310) - lu(k,2905) * lu(k,3306) + lu(k,3311) = lu(k,3311) - lu(k,2906) * lu(k,3306) + lu(k,3312) = lu(k,3312) - lu(k,2907) * lu(k,3306) + lu(k,3313) = lu(k,3313) - lu(k,2908) * lu(k,3306) + lu(k,3314) = lu(k,3314) - lu(k,2909) * lu(k,3306) + lu(k,3315) = lu(k,3315) - lu(k,2910) * lu(k,3306) + lu(k,3316) = lu(k,3316) - lu(k,2911) * lu(k,3306) + lu(k,3317) = lu(k,3317) - lu(k,2912) * lu(k,3306) + lu(k,3318) = lu(k,3318) - lu(k,2913) * lu(k,3306) + lu(k,3319) = lu(k,3319) - lu(k,2914) * lu(k,3306) + lu(k,3320) = lu(k,3320) - lu(k,2915) * lu(k,3306) + lu(k,3321) = lu(k,3321) - lu(k,2916) * lu(k,3306) + lu(k,3563) = lu(k,3563) - lu(k,2902) * lu(k,3562) + lu(k,3564) = lu(k,3564) - lu(k,2903) * lu(k,3562) + lu(k,3565) = lu(k,3565) - lu(k,2904) * lu(k,3562) + lu(k,3566) = lu(k,3566) - lu(k,2905) * lu(k,3562) + lu(k,3567) = lu(k,3567) - lu(k,2906) * lu(k,3562) + lu(k,3568) = lu(k,3568) - lu(k,2907) * lu(k,3562) + lu(k,3569) = lu(k,3569) - lu(k,2908) * lu(k,3562) + lu(k,3570) = lu(k,3570) - lu(k,2909) * lu(k,3562) + lu(k,3571) = lu(k,3571) - lu(k,2910) * lu(k,3562) + lu(k,3572) = lu(k,3572) - lu(k,2911) * lu(k,3562) + lu(k,3573) = lu(k,3573) - lu(k,2912) * lu(k,3562) + lu(k,3574) = lu(k,3574) - lu(k,2913) * lu(k,3562) + lu(k,3575) = lu(k,3575) - lu(k,2914) * lu(k,3562) + lu(k,3576) = lu(k,3576) - lu(k,2915) * lu(k,3562) + lu(k,3577) = lu(k,3577) - lu(k,2916) * lu(k,3562) + lu(k,3813) = lu(k,3813) - lu(k,2902) * lu(k,3812) + lu(k,3814) = lu(k,3814) - lu(k,2903) * lu(k,3812) + lu(k,3815) = lu(k,3815) - lu(k,2904) * lu(k,3812) + lu(k,3816) = lu(k,3816) - lu(k,2905) * lu(k,3812) + lu(k,3817) = lu(k,3817) - lu(k,2906) * lu(k,3812) + lu(k,3818) = lu(k,3818) - lu(k,2907) * lu(k,3812) + lu(k,3819) = lu(k,3819) - lu(k,2908) * lu(k,3812) + lu(k,3820) = lu(k,3820) - lu(k,2909) * lu(k,3812) + lu(k,3821) = lu(k,3821) - lu(k,2910) * lu(k,3812) + lu(k,3822) = lu(k,3822) - lu(k,2911) * lu(k,3812) + lu(k,3823) = lu(k,3823) - lu(k,2912) * lu(k,3812) + lu(k,3824) = lu(k,3824) - lu(k,2913) * lu(k,3812) + lu(k,3825) = lu(k,3825) - lu(k,2914) * lu(k,3812) + lu(k,3826) = lu(k,3826) - lu(k,2915) * lu(k,3812) + lu(k,3827) = lu(k,3827) - lu(k,2916) * lu(k,3812) + lu(k,3948) = lu(k,3948) - lu(k,2902) * lu(k,3947) + lu(k,3949) = lu(k,3949) - lu(k,2903) * lu(k,3947) + lu(k,3950) = lu(k,3950) - lu(k,2904) * lu(k,3947) + lu(k,3951) = lu(k,3951) - lu(k,2905) * lu(k,3947) + lu(k,3952) = lu(k,3952) - lu(k,2906) * lu(k,3947) + lu(k,3953) = lu(k,3953) - lu(k,2907) * lu(k,3947) + lu(k,3954) = lu(k,3954) - lu(k,2908) * lu(k,3947) + lu(k,3955) = lu(k,3955) - lu(k,2909) * lu(k,3947) + lu(k,3956) = lu(k,3956) - lu(k,2910) * lu(k,3947) + lu(k,3957) = lu(k,3957) - lu(k,2911) * lu(k,3947) + lu(k,3958) = lu(k,3958) - lu(k,2912) * lu(k,3947) + lu(k,3959) = lu(k,3959) - lu(k,2913) * lu(k,3947) + lu(k,3960) = lu(k,3960) - lu(k,2914) * lu(k,3947) + lu(k,3961) = lu(k,3961) - lu(k,2915) * lu(k,3947) + lu(k,3962) = lu(k,3962) - lu(k,2916) * lu(k,3947) + lu(k,4040) = lu(k,4040) - lu(k,2902) * lu(k,4039) + lu(k,4041) = lu(k,4041) - lu(k,2903) * lu(k,4039) + lu(k,4042) = lu(k,4042) - lu(k,2904) * lu(k,4039) + lu(k,4043) = lu(k,4043) - lu(k,2905) * lu(k,4039) + lu(k,4044) = lu(k,4044) - lu(k,2906) * lu(k,4039) + lu(k,4045) = lu(k,4045) - lu(k,2907) * lu(k,4039) + lu(k,4046) = lu(k,4046) - lu(k,2908) * lu(k,4039) + lu(k,4047) = lu(k,4047) - lu(k,2909) * lu(k,4039) + lu(k,4048) = lu(k,4048) - lu(k,2910) * lu(k,4039) + lu(k,4049) = lu(k,4049) - lu(k,2911) * lu(k,4039) + lu(k,4050) = lu(k,4050) - lu(k,2912) * lu(k,4039) + lu(k,4051) = lu(k,4051) - lu(k,2913) * lu(k,4039) + lu(k,4052) = lu(k,4052) - lu(k,2914) * lu(k,4039) + lu(k,4053) = lu(k,4053) - lu(k,2915) * lu(k,4039) + lu(k,4054) = lu(k,4054) - lu(k,2916) * lu(k,4039) + lu(k,4092) = lu(k,4092) - lu(k,2902) * lu(k,4091) + lu(k,4093) = lu(k,4093) - lu(k,2903) * lu(k,4091) + lu(k,4094) = lu(k,4094) - lu(k,2904) * lu(k,4091) + lu(k,4095) = lu(k,4095) - lu(k,2905) * lu(k,4091) + lu(k,4096) = lu(k,4096) - lu(k,2906) * lu(k,4091) + lu(k,4097) = lu(k,4097) - lu(k,2907) * lu(k,4091) + lu(k,4098) = lu(k,4098) - lu(k,2908) * lu(k,4091) + lu(k,4099) = lu(k,4099) - lu(k,2909) * lu(k,4091) + lu(k,4100) = lu(k,4100) - lu(k,2910) * lu(k,4091) + lu(k,4101) = lu(k,4101) - lu(k,2911) * lu(k,4091) + lu(k,4102) = lu(k,4102) - lu(k,2912) * lu(k,4091) + lu(k,4103) = lu(k,4103) - lu(k,2913) * lu(k,4091) + lu(k,4104) = lu(k,4104) - lu(k,2914) * lu(k,4091) + lu(k,4105) = lu(k,4105) - lu(k,2915) * lu(k,4091) + lu(k,4106) = lu(k,4106) - lu(k,2916) * lu(k,4091) end do end subroutine lu_fac51 + subroutine lu_fac52( 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,2948) = 1._r8 / lu(k,2948) + lu(k,2949) = lu(k,2949) * lu(k,2948) + lu(k,2950) = lu(k,2950) * lu(k,2948) + lu(k,2951) = lu(k,2951) * lu(k,2948) + lu(k,2952) = lu(k,2952) * lu(k,2948) + lu(k,2953) = lu(k,2953) * lu(k,2948) + lu(k,2954) = lu(k,2954) * lu(k,2948) + lu(k,2955) = lu(k,2955) * lu(k,2948) + lu(k,2956) = lu(k,2956) * lu(k,2948) + lu(k,2957) = lu(k,2957) * lu(k,2948) + lu(k,2958) = lu(k,2958) * lu(k,2948) + lu(k,2959) = lu(k,2959) * lu(k,2948) + lu(k,2960) = lu(k,2960) * lu(k,2948) + lu(k,2961) = lu(k,2961) * lu(k,2948) + lu(k,2962) = lu(k,2962) * lu(k,2948) + lu(k,3023) = lu(k,3023) - lu(k,2949) * lu(k,3022) + lu(k,3024) = lu(k,3024) - lu(k,2950) * lu(k,3022) + lu(k,3025) = lu(k,3025) - lu(k,2951) * lu(k,3022) + lu(k,3026) = lu(k,3026) - lu(k,2952) * lu(k,3022) + lu(k,3027) = lu(k,3027) - lu(k,2953) * lu(k,3022) + lu(k,3028) = lu(k,3028) - lu(k,2954) * lu(k,3022) + lu(k,3029) = lu(k,3029) - lu(k,2955) * lu(k,3022) + lu(k,3030) = lu(k,3030) - lu(k,2956) * lu(k,3022) + lu(k,3031) = lu(k,3031) - lu(k,2957) * lu(k,3022) + lu(k,3032) = lu(k,3032) - lu(k,2958) * lu(k,3022) + lu(k,3033) = lu(k,3033) - lu(k,2959) * lu(k,3022) + lu(k,3034) = lu(k,3034) - lu(k,2960) * lu(k,3022) + lu(k,3035) = lu(k,3035) - lu(k,2961) * lu(k,3022) + lu(k,3036) = lu(k,3036) - lu(k,2962) * lu(k,3022) + lu(k,3126) = lu(k,3126) - lu(k,2949) * lu(k,3125) + lu(k,3127) = lu(k,3127) - lu(k,2950) * lu(k,3125) + lu(k,3128) = lu(k,3128) - lu(k,2951) * lu(k,3125) + lu(k,3129) = lu(k,3129) - lu(k,2952) * lu(k,3125) + lu(k,3130) = lu(k,3130) - lu(k,2953) * lu(k,3125) + lu(k,3131) = lu(k,3131) - lu(k,2954) * lu(k,3125) + lu(k,3132) = lu(k,3132) - lu(k,2955) * lu(k,3125) + lu(k,3133) = lu(k,3133) - lu(k,2956) * lu(k,3125) + lu(k,3134) = lu(k,3134) - lu(k,2957) * lu(k,3125) + lu(k,3135) = lu(k,3135) - lu(k,2958) * lu(k,3125) + lu(k,3136) = lu(k,3136) - lu(k,2959) * lu(k,3125) + lu(k,3137) = lu(k,3137) - lu(k,2960) * lu(k,3125) + lu(k,3138) = lu(k,3138) - lu(k,2961) * lu(k,3125) + lu(k,3139) = lu(k,3139) - lu(k,2962) * lu(k,3125) + lu(k,3308) = lu(k,3308) - lu(k,2949) * lu(k,3307) + lu(k,3309) = lu(k,3309) - lu(k,2950) * lu(k,3307) + lu(k,3310) = lu(k,3310) - lu(k,2951) * lu(k,3307) + lu(k,3311) = lu(k,3311) - lu(k,2952) * lu(k,3307) + lu(k,3312) = lu(k,3312) - lu(k,2953) * lu(k,3307) + lu(k,3313) = lu(k,3313) - lu(k,2954) * lu(k,3307) + lu(k,3314) = lu(k,3314) - lu(k,2955) * lu(k,3307) + lu(k,3315) = lu(k,3315) - lu(k,2956) * lu(k,3307) + lu(k,3316) = lu(k,3316) - lu(k,2957) * lu(k,3307) + lu(k,3317) = lu(k,3317) - lu(k,2958) * lu(k,3307) + lu(k,3318) = lu(k,3318) - lu(k,2959) * lu(k,3307) + lu(k,3319) = lu(k,3319) - lu(k,2960) * lu(k,3307) + lu(k,3320) = lu(k,3320) - lu(k,2961) * lu(k,3307) + lu(k,3321) = lu(k,3321) - lu(k,2962) * lu(k,3307) + lu(k,3564) = lu(k,3564) - lu(k,2949) * lu(k,3563) + lu(k,3565) = lu(k,3565) - lu(k,2950) * lu(k,3563) + lu(k,3566) = lu(k,3566) - lu(k,2951) * lu(k,3563) + lu(k,3567) = lu(k,3567) - lu(k,2952) * lu(k,3563) + lu(k,3568) = lu(k,3568) - lu(k,2953) * lu(k,3563) + lu(k,3569) = lu(k,3569) - lu(k,2954) * lu(k,3563) + lu(k,3570) = lu(k,3570) - lu(k,2955) * lu(k,3563) + lu(k,3571) = lu(k,3571) - lu(k,2956) * lu(k,3563) + lu(k,3572) = lu(k,3572) - lu(k,2957) * lu(k,3563) + lu(k,3573) = lu(k,3573) - lu(k,2958) * lu(k,3563) + lu(k,3574) = lu(k,3574) - lu(k,2959) * lu(k,3563) + lu(k,3575) = lu(k,3575) - lu(k,2960) * lu(k,3563) + lu(k,3576) = lu(k,3576) - lu(k,2961) * lu(k,3563) + lu(k,3577) = lu(k,3577) - lu(k,2962) * lu(k,3563) + lu(k,3814) = lu(k,3814) - lu(k,2949) * lu(k,3813) + lu(k,3815) = lu(k,3815) - lu(k,2950) * lu(k,3813) + lu(k,3816) = lu(k,3816) - lu(k,2951) * lu(k,3813) + lu(k,3817) = lu(k,3817) - lu(k,2952) * lu(k,3813) + lu(k,3818) = lu(k,3818) - lu(k,2953) * lu(k,3813) + lu(k,3819) = lu(k,3819) - lu(k,2954) * lu(k,3813) + lu(k,3820) = lu(k,3820) - lu(k,2955) * lu(k,3813) + lu(k,3821) = lu(k,3821) - lu(k,2956) * lu(k,3813) + lu(k,3822) = lu(k,3822) - lu(k,2957) * lu(k,3813) + lu(k,3823) = lu(k,3823) - lu(k,2958) * lu(k,3813) + lu(k,3824) = lu(k,3824) - lu(k,2959) * lu(k,3813) + lu(k,3825) = lu(k,3825) - lu(k,2960) * lu(k,3813) + lu(k,3826) = lu(k,3826) - lu(k,2961) * lu(k,3813) + lu(k,3827) = lu(k,3827) - lu(k,2962) * lu(k,3813) + lu(k,3949) = lu(k,3949) - lu(k,2949) * lu(k,3948) + lu(k,3950) = lu(k,3950) - lu(k,2950) * lu(k,3948) + lu(k,3951) = lu(k,3951) - lu(k,2951) * lu(k,3948) + lu(k,3952) = lu(k,3952) - lu(k,2952) * lu(k,3948) + lu(k,3953) = lu(k,3953) - lu(k,2953) * lu(k,3948) + lu(k,3954) = lu(k,3954) - lu(k,2954) * lu(k,3948) + lu(k,3955) = lu(k,3955) - lu(k,2955) * lu(k,3948) + lu(k,3956) = lu(k,3956) - lu(k,2956) * lu(k,3948) + lu(k,3957) = lu(k,3957) - lu(k,2957) * lu(k,3948) + lu(k,3958) = lu(k,3958) - lu(k,2958) * lu(k,3948) + lu(k,3959) = lu(k,3959) - lu(k,2959) * lu(k,3948) + lu(k,3960) = lu(k,3960) - lu(k,2960) * lu(k,3948) + lu(k,3961) = lu(k,3961) - lu(k,2961) * lu(k,3948) + lu(k,3962) = lu(k,3962) - lu(k,2962) * lu(k,3948) + lu(k,4041) = lu(k,4041) - lu(k,2949) * lu(k,4040) + lu(k,4042) = lu(k,4042) - lu(k,2950) * lu(k,4040) + lu(k,4043) = lu(k,4043) - lu(k,2951) * lu(k,4040) + lu(k,4044) = lu(k,4044) - lu(k,2952) * lu(k,4040) + lu(k,4045) = lu(k,4045) - lu(k,2953) * lu(k,4040) + lu(k,4046) = lu(k,4046) - lu(k,2954) * lu(k,4040) + lu(k,4047) = lu(k,4047) - lu(k,2955) * lu(k,4040) + lu(k,4048) = lu(k,4048) - lu(k,2956) * lu(k,4040) + lu(k,4049) = lu(k,4049) - lu(k,2957) * lu(k,4040) + lu(k,4050) = lu(k,4050) - lu(k,2958) * lu(k,4040) + lu(k,4051) = lu(k,4051) - lu(k,2959) * lu(k,4040) + lu(k,4052) = lu(k,4052) - lu(k,2960) * lu(k,4040) + lu(k,4053) = lu(k,4053) - lu(k,2961) * lu(k,4040) + lu(k,4054) = lu(k,4054) - lu(k,2962) * lu(k,4040) + lu(k,4093) = lu(k,4093) - lu(k,2949) * lu(k,4092) + lu(k,4094) = lu(k,4094) - lu(k,2950) * lu(k,4092) + lu(k,4095) = lu(k,4095) - lu(k,2951) * lu(k,4092) + lu(k,4096) = lu(k,4096) - lu(k,2952) * lu(k,4092) + lu(k,4097) = lu(k,4097) - lu(k,2953) * lu(k,4092) + lu(k,4098) = lu(k,4098) - lu(k,2954) * lu(k,4092) + lu(k,4099) = lu(k,4099) - lu(k,2955) * lu(k,4092) + lu(k,4100) = lu(k,4100) - lu(k,2956) * lu(k,4092) + lu(k,4101) = lu(k,4101) - lu(k,2957) * lu(k,4092) + lu(k,4102) = lu(k,4102) - lu(k,2958) * lu(k,4092) + lu(k,4103) = lu(k,4103) - lu(k,2959) * lu(k,4092) + lu(k,4104) = lu(k,4104) - lu(k,2960) * lu(k,4092) + lu(k,4105) = lu(k,4105) - lu(k,2961) * lu(k,4092) + lu(k,4106) = lu(k,4106) - lu(k,2962) * lu(k,4092) + lu(k,3023) = 1._r8 / lu(k,3023) + lu(k,3024) = lu(k,3024) * lu(k,3023) + lu(k,3025) = lu(k,3025) * lu(k,3023) + lu(k,3026) = lu(k,3026) * lu(k,3023) + lu(k,3027) = lu(k,3027) * lu(k,3023) + lu(k,3028) = lu(k,3028) * lu(k,3023) + lu(k,3029) = lu(k,3029) * lu(k,3023) + lu(k,3030) = lu(k,3030) * lu(k,3023) + lu(k,3031) = lu(k,3031) * lu(k,3023) + lu(k,3032) = lu(k,3032) * lu(k,3023) + lu(k,3033) = lu(k,3033) * lu(k,3023) + lu(k,3034) = lu(k,3034) * lu(k,3023) + lu(k,3035) = lu(k,3035) * lu(k,3023) + lu(k,3036) = lu(k,3036) * lu(k,3023) + lu(k,3127) = lu(k,3127) - lu(k,3024) * lu(k,3126) + lu(k,3128) = lu(k,3128) - lu(k,3025) * lu(k,3126) + lu(k,3129) = lu(k,3129) - lu(k,3026) * lu(k,3126) + lu(k,3130) = lu(k,3130) - lu(k,3027) * lu(k,3126) + lu(k,3131) = lu(k,3131) - lu(k,3028) * lu(k,3126) + lu(k,3132) = lu(k,3132) - lu(k,3029) * lu(k,3126) + lu(k,3133) = lu(k,3133) - lu(k,3030) * lu(k,3126) + lu(k,3134) = lu(k,3134) - lu(k,3031) * lu(k,3126) + lu(k,3135) = lu(k,3135) - lu(k,3032) * lu(k,3126) + lu(k,3136) = lu(k,3136) - lu(k,3033) * lu(k,3126) + lu(k,3137) = lu(k,3137) - lu(k,3034) * lu(k,3126) + lu(k,3138) = lu(k,3138) - lu(k,3035) * lu(k,3126) + lu(k,3139) = lu(k,3139) - lu(k,3036) * lu(k,3126) + lu(k,3309) = lu(k,3309) - lu(k,3024) * lu(k,3308) + lu(k,3310) = lu(k,3310) - lu(k,3025) * lu(k,3308) + lu(k,3311) = lu(k,3311) - lu(k,3026) * lu(k,3308) + lu(k,3312) = lu(k,3312) - lu(k,3027) * lu(k,3308) + lu(k,3313) = lu(k,3313) - lu(k,3028) * lu(k,3308) + lu(k,3314) = lu(k,3314) - lu(k,3029) * lu(k,3308) + lu(k,3315) = lu(k,3315) - lu(k,3030) * lu(k,3308) + lu(k,3316) = lu(k,3316) - lu(k,3031) * lu(k,3308) + lu(k,3317) = lu(k,3317) - lu(k,3032) * lu(k,3308) + lu(k,3318) = lu(k,3318) - lu(k,3033) * lu(k,3308) + lu(k,3319) = lu(k,3319) - lu(k,3034) * lu(k,3308) + lu(k,3320) = lu(k,3320) - lu(k,3035) * lu(k,3308) + lu(k,3321) = lu(k,3321) - lu(k,3036) * lu(k,3308) + lu(k,3565) = lu(k,3565) - lu(k,3024) * lu(k,3564) + lu(k,3566) = lu(k,3566) - lu(k,3025) * lu(k,3564) + lu(k,3567) = lu(k,3567) - lu(k,3026) * lu(k,3564) + lu(k,3568) = lu(k,3568) - lu(k,3027) * lu(k,3564) + lu(k,3569) = lu(k,3569) - lu(k,3028) * lu(k,3564) + lu(k,3570) = lu(k,3570) - lu(k,3029) * lu(k,3564) + lu(k,3571) = lu(k,3571) - lu(k,3030) * lu(k,3564) + lu(k,3572) = lu(k,3572) - lu(k,3031) * lu(k,3564) + lu(k,3573) = lu(k,3573) - lu(k,3032) * lu(k,3564) + lu(k,3574) = lu(k,3574) - lu(k,3033) * lu(k,3564) + lu(k,3575) = lu(k,3575) - lu(k,3034) * lu(k,3564) + lu(k,3576) = lu(k,3576) - lu(k,3035) * lu(k,3564) + lu(k,3577) = lu(k,3577) - lu(k,3036) * lu(k,3564) + lu(k,3815) = lu(k,3815) - lu(k,3024) * lu(k,3814) + lu(k,3816) = lu(k,3816) - lu(k,3025) * lu(k,3814) + lu(k,3817) = lu(k,3817) - lu(k,3026) * lu(k,3814) + lu(k,3818) = lu(k,3818) - lu(k,3027) * lu(k,3814) + lu(k,3819) = lu(k,3819) - lu(k,3028) * lu(k,3814) + lu(k,3820) = lu(k,3820) - lu(k,3029) * lu(k,3814) + lu(k,3821) = lu(k,3821) - lu(k,3030) * lu(k,3814) + lu(k,3822) = lu(k,3822) - lu(k,3031) * lu(k,3814) + lu(k,3823) = lu(k,3823) - lu(k,3032) * lu(k,3814) + lu(k,3824) = lu(k,3824) - lu(k,3033) * lu(k,3814) + lu(k,3825) = lu(k,3825) - lu(k,3034) * lu(k,3814) + lu(k,3826) = lu(k,3826) - lu(k,3035) * lu(k,3814) + lu(k,3827) = lu(k,3827) - lu(k,3036) * lu(k,3814) + lu(k,3856) = lu(k,3856) - lu(k,3024) * lu(k,3855) + lu(k,3857) = lu(k,3857) - lu(k,3025) * lu(k,3855) + lu(k,3858) = lu(k,3858) - lu(k,3026) * lu(k,3855) + lu(k,3859) = lu(k,3859) - lu(k,3027) * lu(k,3855) + lu(k,3860) = lu(k,3860) - lu(k,3028) * lu(k,3855) + lu(k,3861) = lu(k,3861) - lu(k,3029) * lu(k,3855) + lu(k,3862) = lu(k,3862) - lu(k,3030) * lu(k,3855) + lu(k,3863) = lu(k,3863) - lu(k,3031) * lu(k,3855) + lu(k,3864) = lu(k,3864) - lu(k,3032) * lu(k,3855) + lu(k,3865) = lu(k,3865) - lu(k,3033) * lu(k,3855) + lu(k,3866) = lu(k,3866) - lu(k,3034) * lu(k,3855) + lu(k,3867) = lu(k,3867) - lu(k,3035) * lu(k,3855) + lu(k,3868) = lu(k,3868) - lu(k,3036) * lu(k,3855) + lu(k,3950) = lu(k,3950) - lu(k,3024) * lu(k,3949) + lu(k,3951) = lu(k,3951) - lu(k,3025) * lu(k,3949) + lu(k,3952) = lu(k,3952) - lu(k,3026) * lu(k,3949) + lu(k,3953) = lu(k,3953) - lu(k,3027) * lu(k,3949) + lu(k,3954) = lu(k,3954) - lu(k,3028) * lu(k,3949) + lu(k,3955) = lu(k,3955) - lu(k,3029) * lu(k,3949) + lu(k,3956) = lu(k,3956) - lu(k,3030) * lu(k,3949) + lu(k,3957) = lu(k,3957) - lu(k,3031) * lu(k,3949) + lu(k,3958) = lu(k,3958) - lu(k,3032) * lu(k,3949) + lu(k,3959) = lu(k,3959) - lu(k,3033) * lu(k,3949) + lu(k,3960) = lu(k,3960) - lu(k,3034) * lu(k,3949) + lu(k,3961) = lu(k,3961) - lu(k,3035) * lu(k,3949) + lu(k,3962) = lu(k,3962) - lu(k,3036) * lu(k,3949) + lu(k,4042) = lu(k,4042) - lu(k,3024) * lu(k,4041) + lu(k,4043) = lu(k,4043) - lu(k,3025) * lu(k,4041) + lu(k,4044) = lu(k,4044) - lu(k,3026) * lu(k,4041) + lu(k,4045) = lu(k,4045) - lu(k,3027) * lu(k,4041) + lu(k,4046) = lu(k,4046) - lu(k,3028) * lu(k,4041) + lu(k,4047) = lu(k,4047) - lu(k,3029) * lu(k,4041) + lu(k,4048) = lu(k,4048) - lu(k,3030) * lu(k,4041) + lu(k,4049) = lu(k,4049) - lu(k,3031) * lu(k,4041) + lu(k,4050) = lu(k,4050) - lu(k,3032) * lu(k,4041) + lu(k,4051) = lu(k,4051) - lu(k,3033) * lu(k,4041) + lu(k,4052) = lu(k,4052) - lu(k,3034) * lu(k,4041) + lu(k,4053) = lu(k,4053) - lu(k,3035) * lu(k,4041) + lu(k,4054) = lu(k,4054) - lu(k,3036) * lu(k,4041) + lu(k,4094) = lu(k,4094) - lu(k,3024) * lu(k,4093) + lu(k,4095) = lu(k,4095) - lu(k,3025) * lu(k,4093) + lu(k,4096) = lu(k,4096) - lu(k,3026) * lu(k,4093) + lu(k,4097) = lu(k,4097) - lu(k,3027) * lu(k,4093) + lu(k,4098) = lu(k,4098) - lu(k,3028) * lu(k,4093) + lu(k,4099) = lu(k,4099) - lu(k,3029) * lu(k,4093) + lu(k,4100) = lu(k,4100) - lu(k,3030) * lu(k,4093) + lu(k,4101) = lu(k,4101) - lu(k,3031) * lu(k,4093) + lu(k,4102) = lu(k,4102) - lu(k,3032) * lu(k,4093) + lu(k,4103) = lu(k,4103) - lu(k,3033) * lu(k,4093) + lu(k,4104) = lu(k,4104) - lu(k,3034) * lu(k,4093) + lu(k,4105) = lu(k,4105) - lu(k,3035) * lu(k,4093) + lu(k,4106) = lu(k,4106) - lu(k,3036) * lu(k,4093) + lu(k,3127) = 1._r8 / lu(k,3127) + lu(k,3128) = lu(k,3128) * lu(k,3127) + lu(k,3129) = lu(k,3129) * lu(k,3127) + lu(k,3130) = lu(k,3130) * lu(k,3127) + lu(k,3131) = lu(k,3131) * lu(k,3127) + lu(k,3132) = lu(k,3132) * lu(k,3127) + lu(k,3133) = lu(k,3133) * lu(k,3127) + lu(k,3134) = lu(k,3134) * lu(k,3127) + lu(k,3135) = lu(k,3135) * lu(k,3127) + lu(k,3136) = lu(k,3136) * lu(k,3127) + lu(k,3137) = lu(k,3137) * lu(k,3127) + lu(k,3138) = lu(k,3138) * lu(k,3127) + lu(k,3139) = lu(k,3139) * lu(k,3127) + lu(k,3151) = lu(k,3151) - lu(k,3128) * lu(k,3150) + lu(k,3152) = lu(k,3152) - lu(k,3129) * lu(k,3150) + lu(k,3153) = lu(k,3153) - lu(k,3130) * lu(k,3150) + lu(k,3154) = lu(k,3154) - lu(k,3131) * lu(k,3150) + lu(k,3155) = lu(k,3155) - lu(k,3132) * lu(k,3150) + lu(k,3156) = lu(k,3156) - lu(k,3133) * lu(k,3150) + lu(k,3157) = lu(k,3157) - lu(k,3134) * lu(k,3150) + lu(k,3158) = lu(k,3158) - lu(k,3135) * lu(k,3150) + lu(k,3159) = lu(k,3159) - lu(k,3136) * lu(k,3150) + lu(k,3160) = lu(k,3160) - lu(k,3137) * lu(k,3150) + lu(k,3161) = lu(k,3161) - lu(k,3138) * lu(k,3150) + lu(k,3162) = lu(k,3162) - lu(k,3139) * lu(k,3150) + lu(k,3310) = lu(k,3310) - lu(k,3128) * lu(k,3309) + lu(k,3311) = lu(k,3311) - lu(k,3129) * lu(k,3309) + lu(k,3312) = lu(k,3312) - lu(k,3130) * lu(k,3309) + lu(k,3313) = lu(k,3313) - lu(k,3131) * lu(k,3309) + lu(k,3314) = lu(k,3314) - lu(k,3132) * lu(k,3309) + lu(k,3315) = lu(k,3315) - lu(k,3133) * lu(k,3309) + lu(k,3316) = lu(k,3316) - lu(k,3134) * lu(k,3309) + lu(k,3317) = lu(k,3317) - lu(k,3135) * lu(k,3309) + lu(k,3318) = lu(k,3318) - lu(k,3136) * lu(k,3309) + lu(k,3319) = lu(k,3319) - lu(k,3137) * lu(k,3309) + lu(k,3320) = lu(k,3320) - lu(k,3138) * lu(k,3309) + lu(k,3321) = lu(k,3321) - lu(k,3139) * lu(k,3309) + lu(k,3329) = lu(k,3329) - lu(k,3128) * lu(k,3328) + lu(k,3330) = lu(k,3330) - lu(k,3129) * lu(k,3328) + lu(k,3331) = lu(k,3331) - lu(k,3130) * lu(k,3328) + lu(k,3332) = lu(k,3332) - lu(k,3131) * lu(k,3328) + lu(k,3333) = lu(k,3333) - lu(k,3132) * lu(k,3328) + lu(k,3334) = lu(k,3334) - lu(k,3133) * lu(k,3328) + lu(k,3335) = lu(k,3335) - lu(k,3134) * lu(k,3328) + lu(k,3336) = lu(k,3336) - lu(k,3135) * lu(k,3328) + lu(k,3337) = lu(k,3337) - lu(k,3136) * lu(k,3328) + lu(k,3338) = lu(k,3338) - lu(k,3137) * lu(k,3328) + lu(k,3339) = lu(k,3339) - lu(k,3138) * lu(k,3328) + lu(k,3340) = lu(k,3340) - lu(k,3139) * lu(k,3328) + lu(k,3355) = lu(k,3355) - lu(k,3128) * lu(k,3354) + lu(k,3356) = lu(k,3356) - lu(k,3129) * lu(k,3354) + lu(k,3357) = lu(k,3357) - lu(k,3130) * lu(k,3354) + lu(k,3358) = lu(k,3358) - lu(k,3131) * lu(k,3354) + lu(k,3359) = lu(k,3359) - lu(k,3132) * lu(k,3354) + lu(k,3360) = lu(k,3360) - lu(k,3133) * lu(k,3354) + lu(k,3361) = lu(k,3361) - lu(k,3134) * lu(k,3354) + lu(k,3362) = lu(k,3362) - lu(k,3135) * lu(k,3354) + lu(k,3363) = lu(k,3363) - lu(k,3136) * lu(k,3354) + lu(k,3364) = lu(k,3364) - lu(k,3137) * lu(k,3354) + lu(k,3365) = lu(k,3365) - lu(k,3138) * lu(k,3354) + lu(k,3366) = lu(k,3366) - lu(k,3139) * lu(k,3354) + lu(k,3386) = lu(k,3386) - lu(k,3128) * lu(k,3385) + lu(k,3387) = lu(k,3387) - lu(k,3129) * lu(k,3385) + lu(k,3388) = lu(k,3388) - lu(k,3130) * lu(k,3385) + lu(k,3389) = lu(k,3389) - lu(k,3131) * lu(k,3385) + lu(k,3390) = lu(k,3390) - lu(k,3132) * lu(k,3385) + lu(k,3391) = lu(k,3391) - lu(k,3133) * lu(k,3385) + lu(k,3392) = lu(k,3392) - lu(k,3134) * lu(k,3385) + lu(k,3393) = lu(k,3393) - lu(k,3135) * lu(k,3385) + lu(k,3394) = lu(k,3394) - lu(k,3136) * lu(k,3385) + lu(k,3395) = lu(k,3395) - lu(k,3137) * lu(k,3385) + lu(k,3396) = lu(k,3396) - lu(k,3138) * lu(k,3385) + lu(k,3397) = lu(k,3397) - lu(k,3139) * lu(k,3385) + lu(k,3566) = lu(k,3566) - lu(k,3128) * lu(k,3565) + lu(k,3567) = lu(k,3567) - lu(k,3129) * lu(k,3565) + lu(k,3568) = lu(k,3568) - lu(k,3130) * lu(k,3565) + lu(k,3569) = lu(k,3569) - lu(k,3131) * lu(k,3565) + lu(k,3570) = lu(k,3570) - lu(k,3132) * lu(k,3565) + lu(k,3571) = lu(k,3571) - lu(k,3133) * lu(k,3565) + lu(k,3572) = lu(k,3572) - lu(k,3134) * lu(k,3565) + lu(k,3573) = lu(k,3573) - lu(k,3135) * lu(k,3565) + lu(k,3574) = lu(k,3574) - lu(k,3136) * lu(k,3565) + lu(k,3575) = lu(k,3575) - lu(k,3137) * lu(k,3565) + lu(k,3576) = lu(k,3576) - lu(k,3138) * lu(k,3565) + lu(k,3577) = lu(k,3577) - lu(k,3139) * lu(k,3565) + lu(k,3816) = lu(k,3816) - lu(k,3128) * lu(k,3815) + lu(k,3817) = lu(k,3817) - lu(k,3129) * lu(k,3815) + lu(k,3818) = lu(k,3818) - lu(k,3130) * lu(k,3815) + lu(k,3819) = lu(k,3819) - lu(k,3131) * lu(k,3815) + lu(k,3820) = lu(k,3820) - lu(k,3132) * lu(k,3815) + lu(k,3821) = lu(k,3821) - lu(k,3133) * lu(k,3815) + lu(k,3822) = lu(k,3822) - lu(k,3134) * lu(k,3815) + lu(k,3823) = lu(k,3823) - lu(k,3135) * lu(k,3815) + lu(k,3824) = lu(k,3824) - lu(k,3136) * lu(k,3815) + lu(k,3825) = lu(k,3825) - lu(k,3137) * lu(k,3815) + lu(k,3826) = lu(k,3826) - lu(k,3138) * lu(k,3815) + lu(k,3827) = lu(k,3827) - lu(k,3139) * lu(k,3815) + lu(k,3857) = lu(k,3857) - lu(k,3128) * lu(k,3856) + lu(k,3858) = lu(k,3858) - lu(k,3129) * lu(k,3856) + lu(k,3859) = lu(k,3859) - lu(k,3130) * lu(k,3856) + lu(k,3860) = lu(k,3860) - lu(k,3131) * lu(k,3856) + lu(k,3861) = lu(k,3861) - lu(k,3132) * lu(k,3856) + lu(k,3862) = lu(k,3862) - lu(k,3133) * lu(k,3856) + lu(k,3863) = lu(k,3863) - lu(k,3134) * lu(k,3856) + lu(k,3864) = lu(k,3864) - lu(k,3135) * lu(k,3856) + lu(k,3865) = lu(k,3865) - lu(k,3136) * lu(k,3856) + lu(k,3866) = lu(k,3866) - lu(k,3137) * lu(k,3856) + lu(k,3867) = lu(k,3867) - lu(k,3138) * lu(k,3856) + lu(k,3868) = lu(k,3868) - lu(k,3139) * lu(k,3856) + lu(k,3951) = lu(k,3951) - lu(k,3128) * lu(k,3950) + lu(k,3952) = lu(k,3952) - lu(k,3129) * lu(k,3950) + lu(k,3953) = lu(k,3953) - lu(k,3130) * lu(k,3950) + lu(k,3954) = lu(k,3954) - lu(k,3131) * lu(k,3950) + lu(k,3955) = lu(k,3955) - lu(k,3132) * lu(k,3950) + lu(k,3956) = lu(k,3956) - lu(k,3133) * lu(k,3950) + lu(k,3957) = lu(k,3957) - lu(k,3134) * lu(k,3950) + lu(k,3958) = lu(k,3958) - lu(k,3135) * lu(k,3950) + lu(k,3959) = lu(k,3959) - lu(k,3136) * lu(k,3950) + lu(k,3960) = lu(k,3960) - lu(k,3137) * lu(k,3950) + lu(k,3961) = lu(k,3961) - lu(k,3138) * lu(k,3950) + lu(k,3962) = lu(k,3962) - lu(k,3139) * lu(k,3950) + lu(k,4043) = lu(k,4043) - lu(k,3128) * lu(k,4042) + lu(k,4044) = lu(k,4044) - lu(k,3129) * lu(k,4042) + lu(k,4045) = lu(k,4045) - lu(k,3130) * lu(k,4042) + lu(k,4046) = lu(k,4046) - lu(k,3131) * lu(k,4042) + lu(k,4047) = lu(k,4047) - lu(k,3132) * lu(k,4042) + lu(k,4048) = lu(k,4048) - lu(k,3133) * lu(k,4042) + lu(k,4049) = lu(k,4049) - lu(k,3134) * lu(k,4042) + lu(k,4050) = lu(k,4050) - lu(k,3135) * lu(k,4042) + lu(k,4051) = lu(k,4051) - lu(k,3136) * lu(k,4042) + lu(k,4052) = lu(k,4052) - lu(k,3137) * lu(k,4042) + lu(k,4053) = lu(k,4053) - lu(k,3138) * lu(k,4042) + lu(k,4054) = lu(k,4054) - lu(k,3139) * lu(k,4042) + lu(k,4095) = lu(k,4095) - lu(k,3128) * lu(k,4094) + lu(k,4096) = lu(k,4096) - lu(k,3129) * lu(k,4094) + lu(k,4097) = lu(k,4097) - lu(k,3130) * lu(k,4094) + lu(k,4098) = lu(k,4098) - lu(k,3131) * lu(k,4094) + lu(k,4099) = lu(k,4099) - lu(k,3132) * lu(k,4094) + lu(k,4100) = lu(k,4100) - lu(k,3133) * lu(k,4094) + lu(k,4101) = lu(k,4101) - lu(k,3134) * lu(k,4094) + lu(k,4102) = lu(k,4102) - lu(k,3135) * lu(k,4094) + lu(k,4103) = lu(k,4103) - lu(k,3136) * lu(k,4094) + lu(k,4104) = lu(k,4104) - lu(k,3137) * lu(k,4094) + lu(k,4105) = lu(k,4105) - lu(k,3138) * lu(k,4094) + lu(k,4106) = lu(k,4106) - lu(k,3139) * lu(k,4094) + lu(k,4121) = lu(k,4121) - lu(k,3128) * lu(k,4120) + lu(k,4122) = lu(k,4122) - lu(k,3129) * lu(k,4120) + lu(k,4123) = lu(k,4123) - lu(k,3130) * lu(k,4120) + lu(k,4124) = lu(k,4124) - lu(k,3131) * lu(k,4120) + lu(k,4125) = lu(k,4125) - lu(k,3132) * lu(k,4120) + lu(k,4126) = lu(k,4126) - lu(k,3133) * lu(k,4120) + lu(k,4127) = lu(k,4127) - lu(k,3134) * lu(k,4120) + lu(k,4128) = lu(k,4128) - lu(k,3135) * lu(k,4120) + lu(k,4129) = lu(k,4129) - lu(k,3136) * lu(k,4120) + lu(k,4130) = lu(k,4130) - lu(k,3137) * lu(k,4120) + lu(k,4131) = lu(k,4131) - lu(k,3138) * lu(k,4120) + lu(k,4132) = lu(k,4132) - lu(k,3139) * lu(k,4120) + lu(k,3151) = 1._r8 / lu(k,3151) + lu(k,3152) = lu(k,3152) * lu(k,3151) + lu(k,3153) = lu(k,3153) * lu(k,3151) + lu(k,3154) = lu(k,3154) * lu(k,3151) + lu(k,3155) = lu(k,3155) * lu(k,3151) + lu(k,3156) = lu(k,3156) * lu(k,3151) + lu(k,3157) = lu(k,3157) * lu(k,3151) + lu(k,3158) = lu(k,3158) * lu(k,3151) + lu(k,3159) = lu(k,3159) * lu(k,3151) + lu(k,3160) = lu(k,3160) * lu(k,3151) + lu(k,3161) = lu(k,3161) * lu(k,3151) + lu(k,3162) = lu(k,3162) * lu(k,3151) + lu(k,3311) = lu(k,3311) - lu(k,3152) * lu(k,3310) + lu(k,3312) = lu(k,3312) - lu(k,3153) * lu(k,3310) + lu(k,3313) = lu(k,3313) - lu(k,3154) * lu(k,3310) + lu(k,3314) = lu(k,3314) - lu(k,3155) * lu(k,3310) + lu(k,3315) = lu(k,3315) - lu(k,3156) * lu(k,3310) + lu(k,3316) = lu(k,3316) - lu(k,3157) * lu(k,3310) + lu(k,3317) = lu(k,3317) - lu(k,3158) * lu(k,3310) + lu(k,3318) = lu(k,3318) - lu(k,3159) * lu(k,3310) + lu(k,3319) = lu(k,3319) - lu(k,3160) * lu(k,3310) + lu(k,3320) = lu(k,3320) - lu(k,3161) * lu(k,3310) + lu(k,3321) = lu(k,3321) - lu(k,3162) * lu(k,3310) + lu(k,3330) = lu(k,3330) - lu(k,3152) * lu(k,3329) + lu(k,3331) = lu(k,3331) - lu(k,3153) * lu(k,3329) + lu(k,3332) = lu(k,3332) - lu(k,3154) * lu(k,3329) + lu(k,3333) = lu(k,3333) - lu(k,3155) * lu(k,3329) + lu(k,3334) = lu(k,3334) - lu(k,3156) * lu(k,3329) + lu(k,3335) = lu(k,3335) - lu(k,3157) * lu(k,3329) + lu(k,3336) = lu(k,3336) - lu(k,3158) * lu(k,3329) + lu(k,3337) = lu(k,3337) - lu(k,3159) * lu(k,3329) + lu(k,3338) = lu(k,3338) - lu(k,3160) * lu(k,3329) + lu(k,3339) = lu(k,3339) - lu(k,3161) * lu(k,3329) + lu(k,3340) = lu(k,3340) - lu(k,3162) * lu(k,3329) + lu(k,3356) = lu(k,3356) - lu(k,3152) * lu(k,3355) + lu(k,3357) = lu(k,3357) - lu(k,3153) * lu(k,3355) + lu(k,3358) = lu(k,3358) - lu(k,3154) * lu(k,3355) + lu(k,3359) = lu(k,3359) - lu(k,3155) * lu(k,3355) + lu(k,3360) = lu(k,3360) - lu(k,3156) * lu(k,3355) + lu(k,3361) = lu(k,3361) - lu(k,3157) * lu(k,3355) + lu(k,3362) = lu(k,3362) - lu(k,3158) * lu(k,3355) + lu(k,3363) = lu(k,3363) - lu(k,3159) * lu(k,3355) + lu(k,3364) = lu(k,3364) - lu(k,3160) * lu(k,3355) + lu(k,3365) = lu(k,3365) - lu(k,3161) * lu(k,3355) + lu(k,3366) = lu(k,3366) - lu(k,3162) * lu(k,3355) + lu(k,3387) = lu(k,3387) - lu(k,3152) * lu(k,3386) + lu(k,3388) = lu(k,3388) - lu(k,3153) * lu(k,3386) + lu(k,3389) = lu(k,3389) - lu(k,3154) * lu(k,3386) + lu(k,3390) = lu(k,3390) - lu(k,3155) * lu(k,3386) + lu(k,3391) = lu(k,3391) - lu(k,3156) * lu(k,3386) + lu(k,3392) = lu(k,3392) - lu(k,3157) * lu(k,3386) + lu(k,3393) = lu(k,3393) - lu(k,3158) * lu(k,3386) + lu(k,3394) = lu(k,3394) - lu(k,3159) * lu(k,3386) + lu(k,3395) = lu(k,3395) - lu(k,3160) * lu(k,3386) + lu(k,3396) = lu(k,3396) - lu(k,3161) * lu(k,3386) + lu(k,3397) = lu(k,3397) - lu(k,3162) * lu(k,3386) + lu(k,3567) = lu(k,3567) - lu(k,3152) * lu(k,3566) + lu(k,3568) = lu(k,3568) - lu(k,3153) * lu(k,3566) + lu(k,3569) = lu(k,3569) - lu(k,3154) * lu(k,3566) + lu(k,3570) = lu(k,3570) - lu(k,3155) * lu(k,3566) + lu(k,3571) = lu(k,3571) - lu(k,3156) * lu(k,3566) + lu(k,3572) = lu(k,3572) - lu(k,3157) * lu(k,3566) + lu(k,3573) = lu(k,3573) - lu(k,3158) * lu(k,3566) + lu(k,3574) = lu(k,3574) - lu(k,3159) * lu(k,3566) + lu(k,3575) = lu(k,3575) - lu(k,3160) * lu(k,3566) + lu(k,3576) = lu(k,3576) - lu(k,3161) * lu(k,3566) + lu(k,3577) = lu(k,3577) - lu(k,3162) * lu(k,3566) + lu(k,3817) = lu(k,3817) - lu(k,3152) * lu(k,3816) + lu(k,3818) = lu(k,3818) - lu(k,3153) * lu(k,3816) + lu(k,3819) = lu(k,3819) - lu(k,3154) * lu(k,3816) + lu(k,3820) = lu(k,3820) - lu(k,3155) * lu(k,3816) + lu(k,3821) = lu(k,3821) - lu(k,3156) * lu(k,3816) + lu(k,3822) = lu(k,3822) - lu(k,3157) * lu(k,3816) + lu(k,3823) = lu(k,3823) - lu(k,3158) * lu(k,3816) + lu(k,3824) = lu(k,3824) - lu(k,3159) * lu(k,3816) + lu(k,3825) = lu(k,3825) - lu(k,3160) * lu(k,3816) + lu(k,3826) = lu(k,3826) - lu(k,3161) * lu(k,3816) + lu(k,3827) = lu(k,3827) - lu(k,3162) * lu(k,3816) + lu(k,3858) = lu(k,3858) - lu(k,3152) * lu(k,3857) + lu(k,3859) = lu(k,3859) - lu(k,3153) * lu(k,3857) + lu(k,3860) = lu(k,3860) - lu(k,3154) * lu(k,3857) + lu(k,3861) = lu(k,3861) - lu(k,3155) * lu(k,3857) + lu(k,3862) = lu(k,3862) - lu(k,3156) * lu(k,3857) + lu(k,3863) = lu(k,3863) - lu(k,3157) * lu(k,3857) + lu(k,3864) = lu(k,3864) - lu(k,3158) * lu(k,3857) + lu(k,3865) = lu(k,3865) - lu(k,3159) * lu(k,3857) + lu(k,3866) = lu(k,3866) - lu(k,3160) * lu(k,3857) + lu(k,3867) = lu(k,3867) - lu(k,3161) * lu(k,3857) + lu(k,3868) = lu(k,3868) - lu(k,3162) * lu(k,3857) + lu(k,3952) = lu(k,3952) - lu(k,3152) * lu(k,3951) + lu(k,3953) = lu(k,3953) - lu(k,3153) * lu(k,3951) + lu(k,3954) = lu(k,3954) - lu(k,3154) * lu(k,3951) + lu(k,3955) = lu(k,3955) - lu(k,3155) * lu(k,3951) + lu(k,3956) = lu(k,3956) - lu(k,3156) * lu(k,3951) + lu(k,3957) = lu(k,3957) - lu(k,3157) * lu(k,3951) + lu(k,3958) = lu(k,3958) - lu(k,3158) * lu(k,3951) + lu(k,3959) = lu(k,3959) - lu(k,3159) * lu(k,3951) + lu(k,3960) = lu(k,3960) - lu(k,3160) * lu(k,3951) + lu(k,3961) = lu(k,3961) - lu(k,3161) * lu(k,3951) + lu(k,3962) = lu(k,3962) - lu(k,3162) * lu(k,3951) + lu(k,4044) = lu(k,4044) - lu(k,3152) * lu(k,4043) + lu(k,4045) = lu(k,4045) - lu(k,3153) * lu(k,4043) + lu(k,4046) = lu(k,4046) - lu(k,3154) * lu(k,4043) + lu(k,4047) = lu(k,4047) - lu(k,3155) * lu(k,4043) + lu(k,4048) = lu(k,4048) - lu(k,3156) * lu(k,4043) + lu(k,4049) = lu(k,4049) - lu(k,3157) * lu(k,4043) + lu(k,4050) = lu(k,4050) - lu(k,3158) * lu(k,4043) + lu(k,4051) = lu(k,4051) - lu(k,3159) * lu(k,4043) + lu(k,4052) = lu(k,4052) - lu(k,3160) * lu(k,4043) + lu(k,4053) = lu(k,4053) - lu(k,3161) * lu(k,4043) + lu(k,4054) = lu(k,4054) - lu(k,3162) * lu(k,4043) + lu(k,4096) = lu(k,4096) - lu(k,3152) * lu(k,4095) + lu(k,4097) = lu(k,4097) - lu(k,3153) * lu(k,4095) + lu(k,4098) = lu(k,4098) - lu(k,3154) * lu(k,4095) + lu(k,4099) = lu(k,4099) - lu(k,3155) * lu(k,4095) + lu(k,4100) = lu(k,4100) - lu(k,3156) * lu(k,4095) + lu(k,4101) = lu(k,4101) - lu(k,3157) * lu(k,4095) + lu(k,4102) = lu(k,4102) - lu(k,3158) * lu(k,4095) + lu(k,4103) = lu(k,4103) - lu(k,3159) * lu(k,4095) + lu(k,4104) = lu(k,4104) - lu(k,3160) * lu(k,4095) + lu(k,4105) = lu(k,4105) - lu(k,3161) * lu(k,4095) + lu(k,4106) = lu(k,4106) - lu(k,3162) * lu(k,4095) + lu(k,4122) = lu(k,4122) - lu(k,3152) * lu(k,4121) + lu(k,4123) = lu(k,4123) - lu(k,3153) * lu(k,4121) + lu(k,4124) = lu(k,4124) - lu(k,3154) * lu(k,4121) + lu(k,4125) = lu(k,4125) - lu(k,3155) * lu(k,4121) + lu(k,4126) = lu(k,4126) - lu(k,3156) * lu(k,4121) + lu(k,4127) = lu(k,4127) - lu(k,3157) * lu(k,4121) + lu(k,4128) = lu(k,4128) - lu(k,3158) * lu(k,4121) + lu(k,4129) = lu(k,4129) - lu(k,3159) * lu(k,4121) + lu(k,4130) = lu(k,4130) - lu(k,3160) * lu(k,4121) + lu(k,4131) = lu(k,4131) - lu(k,3161) * lu(k,4121) + lu(k,4132) = lu(k,4132) - lu(k,3162) * lu(k,4121) + end do + end subroutine lu_fac52 + subroutine lu_fac53( 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,3311) = 1._r8 / lu(k,3311) + lu(k,3312) = lu(k,3312) * lu(k,3311) + lu(k,3313) = lu(k,3313) * lu(k,3311) + lu(k,3314) = lu(k,3314) * lu(k,3311) + lu(k,3315) = lu(k,3315) * lu(k,3311) + lu(k,3316) = lu(k,3316) * lu(k,3311) + lu(k,3317) = lu(k,3317) * lu(k,3311) + lu(k,3318) = lu(k,3318) * lu(k,3311) + lu(k,3319) = lu(k,3319) * lu(k,3311) + lu(k,3320) = lu(k,3320) * lu(k,3311) + lu(k,3321) = lu(k,3321) * lu(k,3311) + lu(k,3331) = lu(k,3331) - lu(k,3312) * lu(k,3330) + lu(k,3332) = lu(k,3332) - lu(k,3313) * lu(k,3330) + lu(k,3333) = lu(k,3333) - lu(k,3314) * lu(k,3330) + lu(k,3334) = lu(k,3334) - lu(k,3315) * lu(k,3330) + lu(k,3335) = lu(k,3335) - lu(k,3316) * lu(k,3330) + lu(k,3336) = lu(k,3336) - lu(k,3317) * lu(k,3330) + lu(k,3337) = lu(k,3337) - lu(k,3318) * lu(k,3330) + lu(k,3338) = lu(k,3338) - lu(k,3319) * lu(k,3330) + lu(k,3339) = lu(k,3339) - lu(k,3320) * lu(k,3330) + lu(k,3340) = lu(k,3340) - lu(k,3321) * lu(k,3330) + lu(k,3357) = lu(k,3357) - lu(k,3312) * lu(k,3356) + lu(k,3358) = lu(k,3358) - lu(k,3313) * lu(k,3356) + lu(k,3359) = lu(k,3359) - lu(k,3314) * lu(k,3356) + lu(k,3360) = lu(k,3360) - lu(k,3315) * lu(k,3356) + lu(k,3361) = lu(k,3361) - lu(k,3316) * lu(k,3356) + lu(k,3362) = lu(k,3362) - lu(k,3317) * lu(k,3356) + lu(k,3363) = lu(k,3363) - lu(k,3318) * lu(k,3356) + lu(k,3364) = lu(k,3364) - lu(k,3319) * lu(k,3356) + lu(k,3365) = lu(k,3365) - lu(k,3320) * lu(k,3356) + lu(k,3366) = lu(k,3366) - lu(k,3321) * lu(k,3356) + lu(k,3388) = lu(k,3388) - lu(k,3312) * lu(k,3387) + lu(k,3389) = lu(k,3389) - lu(k,3313) * lu(k,3387) + lu(k,3390) = lu(k,3390) - lu(k,3314) * lu(k,3387) + lu(k,3391) = lu(k,3391) - lu(k,3315) * lu(k,3387) + lu(k,3392) = lu(k,3392) - lu(k,3316) * lu(k,3387) + lu(k,3393) = lu(k,3393) - lu(k,3317) * lu(k,3387) + lu(k,3394) = lu(k,3394) - lu(k,3318) * lu(k,3387) + lu(k,3395) = lu(k,3395) - lu(k,3319) * lu(k,3387) + lu(k,3396) = lu(k,3396) - lu(k,3320) * lu(k,3387) + lu(k,3397) = lu(k,3397) - lu(k,3321) * lu(k,3387) + lu(k,3568) = lu(k,3568) - lu(k,3312) * lu(k,3567) + lu(k,3569) = lu(k,3569) - lu(k,3313) * lu(k,3567) + lu(k,3570) = lu(k,3570) - lu(k,3314) * lu(k,3567) + lu(k,3571) = lu(k,3571) - lu(k,3315) * lu(k,3567) + lu(k,3572) = lu(k,3572) - lu(k,3316) * lu(k,3567) + lu(k,3573) = lu(k,3573) - lu(k,3317) * lu(k,3567) + lu(k,3574) = lu(k,3574) - lu(k,3318) * lu(k,3567) + lu(k,3575) = lu(k,3575) - lu(k,3319) * lu(k,3567) + lu(k,3576) = lu(k,3576) - lu(k,3320) * lu(k,3567) + lu(k,3577) = lu(k,3577) - lu(k,3321) * lu(k,3567) + lu(k,3818) = lu(k,3818) - lu(k,3312) * lu(k,3817) + lu(k,3819) = lu(k,3819) - lu(k,3313) * lu(k,3817) + lu(k,3820) = lu(k,3820) - lu(k,3314) * lu(k,3817) + lu(k,3821) = lu(k,3821) - lu(k,3315) * lu(k,3817) + lu(k,3822) = lu(k,3822) - lu(k,3316) * lu(k,3817) + lu(k,3823) = lu(k,3823) - lu(k,3317) * lu(k,3817) + lu(k,3824) = lu(k,3824) - lu(k,3318) * lu(k,3817) + lu(k,3825) = lu(k,3825) - lu(k,3319) * lu(k,3817) + lu(k,3826) = lu(k,3826) - lu(k,3320) * lu(k,3817) + lu(k,3827) = lu(k,3827) - lu(k,3321) * lu(k,3817) + lu(k,3859) = lu(k,3859) - lu(k,3312) * lu(k,3858) + lu(k,3860) = lu(k,3860) - lu(k,3313) * lu(k,3858) + lu(k,3861) = lu(k,3861) - lu(k,3314) * lu(k,3858) + lu(k,3862) = lu(k,3862) - lu(k,3315) * lu(k,3858) + lu(k,3863) = lu(k,3863) - lu(k,3316) * lu(k,3858) + lu(k,3864) = lu(k,3864) - lu(k,3317) * lu(k,3858) + lu(k,3865) = lu(k,3865) - lu(k,3318) * lu(k,3858) + lu(k,3866) = lu(k,3866) - lu(k,3319) * lu(k,3858) + lu(k,3867) = lu(k,3867) - lu(k,3320) * lu(k,3858) + lu(k,3868) = lu(k,3868) - lu(k,3321) * lu(k,3858) + lu(k,3953) = lu(k,3953) - lu(k,3312) * lu(k,3952) + lu(k,3954) = lu(k,3954) - lu(k,3313) * lu(k,3952) + lu(k,3955) = lu(k,3955) - lu(k,3314) * lu(k,3952) + lu(k,3956) = lu(k,3956) - lu(k,3315) * lu(k,3952) + lu(k,3957) = lu(k,3957) - lu(k,3316) * lu(k,3952) + lu(k,3958) = lu(k,3958) - lu(k,3317) * lu(k,3952) + lu(k,3959) = lu(k,3959) - lu(k,3318) * lu(k,3952) + lu(k,3960) = lu(k,3960) - lu(k,3319) * lu(k,3952) + lu(k,3961) = lu(k,3961) - lu(k,3320) * lu(k,3952) + lu(k,3962) = lu(k,3962) - lu(k,3321) * lu(k,3952) + lu(k,4045) = lu(k,4045) - lu(k,3312) * lu(k,4044) + lu(k,4046) = lu(k,4046) - lu(k,3313) * lu(k,4044) + lu(k,4047) = lu(k,4047) - lu(k,3314) * lu(k,4044) + lu(k,4048) = lu(k,4048) - lu(k,3315) * lu(k,4044) + lu(k,4049) = lu(k,4049) - lu(k,3316) * lu(k,4044) + lu(k,4050) = lu(k,4050) - lu(k,3317) * lu(k,4044) + lu(k,4051) = lu(k,4051) - lu(k,3318) * lu(k,4044) + lu(k,4052) = lu(k,4052) - lu(k,3319) * lu(k,4044) + lu(k,4053) = lu(k,4053) - lu(k,3320) * lu(k,4044) + lu(k,4054) = lu(k,4054) - lu(k,3321) * lu(k,4044) + lu(k,4097) = lu(k,4097) - lu(k,3312) * lu(k,4096) + lu(k,4098) = lu(k,4098) - lu(k,3313) * lu(k,4096) + lu(k,4099) = lu(k,4099) - lu(k,3314) * lu(k,4096) + lu(k,4100) = lu(k,4100) - lu(k,3315) * lu(k,4096) + lu(k,4101) = lu(k,4101) - lu(k,3316) * lu(k,4096) + lu(k,4102) = lu(k,4102) - lu(k,3317) * lu(k,4096) + lu(k,4103) = lu(k,4103) - lu(k,3318) * lu(k,4096) + lu(k,4104) = lu(k,4104) - lu(k,3319) * lu(k,4096) + lu(k,4105) = lu(k,4105) - lu(k,3320) * lu(k,4096) + lu(k,4106) = lu(k,4106) - lu(k,3321) * lu(k,4096) + lu(k,4123) = lu(k,4123) - lu(k,3312) * lu(k,4122) + lu(k,4124) = lu(k,4124) - lu(k,3313) * lu(k,4122) + lu(k,4125) = lu(k,4125) - lu(k,3314) * lu(k,4122) + lu(k,4126) = lu(k,4126) - lu(k,3315) * lu(k,4122) + lu(k,4127) = lu(k,4127) - lu(k,3316) * lu(k,4122) + lu(k,4128) = lu(k,4128) - lu(k,3317) * lu(k,4122) + lu(k,4129) = lu(k,4129) - lu(k,3318) * lu(k,4122) + lu(k,4130) = lu(k,4130) - lu(k,3319) * lu(k,4122) + lu(k,4131) = lu(k,4131) - lu(k,3320) * lu(k,4122) + lu(k,4132) = lu(k,4132) - lu(k,3321) * lu(k,4122) + lu(k,3331) = 1._r8 / lu(k,3331) + lu(k,3332) = lu(k,3332) * lu(k,3331) + lu(k,3333) = lu(k,3333) * lu(k,3331) + lu(k,3334) = lu(k,3334) * lu(k,3331) + lu(k,3335) = lu(k,3335) * lu(k,3331) + lu(k,3336) = lu(k,3336) * lu(k,3331) + lu(k,3337) = lu(k,3337) * lu(k,3331) + lu(k,3338) = lu(k,3338) * lu(k,3331) + lu(k,3339) = lu(k,3339) * lu(k,3331) + lu(k,3340) = lu(k,3340) * lu(k,3331) + lu(k,3358) = lu(k,3358) - lu(k,3332) * lu(k,3357) + lu(k,3359) = lu(k,3359) - lu(k,3333) * lu(k,3357) + lu(k,3360) = lu(k,3360) - lu(k,3334) * lu(k,3357) + lu(k,3361) = lu(k,3361) - lu(k,3335) * lu(k,3357) + lu(k,3362) = lu(k,3362) - lu(k,3336) * lu(k,3357) + lu(k,3363) = lu(k,3363) - lu(k,3337) * lu(k,3357) + lu(k,3364) = lu(k,3364) - lu(k,3338) * lu(k,3357) + lu(k,3365) = lu(k,3365) - lu(k,3339) * lu(k,3357) + lu(k,3366) = lu(k,3366) - lu(k,3340) * lu(k,3357) + lu(k,3389) = lu(k,3389) - lu(k,3332) * lu(k,3388) + lu(k,3390) = lu(k,3390) - lu(k,3333) * lu(k,3388) + lu(k,3391) = lu(k,3391) - lu(k,3334) * lu(k,3388) + lu(k,3392) = lu(k,3392) - lu(k,3335) * lu(k,3388) + lu(k,3393) = lu(k,3393) - lu(k,3336) * lu(k,3388) + lu(k,3394) = lu(k,3394) - lu(k,3337) * lu(k,3388) + lu(k,3395) = lu(k,3395) - lu(k,3338) * lu(k,3388) + lu(k,3396) = lu(k,3396) - lu(k,3339) * lu(k,3388) + lu(k,3397) = lu(k,3397) - lu(k,3340) * lu(k,3388) + lu(k,3569) = lu(k,3569) - lu(k,3332) * lu(k,3568) + lu(k,3570) = lu(k,3570) - lu(k,3333) * lu(k,3568) + lu(k,3571) = lu(k,3571) - lu(k,3334) * lu(k,3568) + lu(k,3572) = lu(k,3572) - lu(k,3335) * lu(k,3568) + lu(k,3573) = lu(k,3573) - lu(k,3336) * lu(k,3568) + lu(k,3574) = lu(k,3574) - lu(k,3337) * lu(k,3568) + lu(k,3575) = lu(k,3575) - lu(k,3338) * lu(k,3568) + lu(k,3576) = lu(k,3576) - lu(k,3339) * lu(k,3568) + lu(k,3577) = lu(k,3577) - lu(k,3340) * lu(k,3568) + lu(k,3819) = lu(k,3819) - lu(k,3332) * lu(k,3818) + lu(k,3820) = lu(k,3820) - lu(k,3333) * lu(k,3818) + lu(k,3821) = lu(k,3821) - lu(k,3334) * lu(k,3818) + lu(k,3822) = lu(k,3822) - lu(k,3335) * lu(k,3818) + lu(k,3823) = lu(k,3823) - lu(k,3336) * lu(k,3818) + lu(k,3824) = lu(k,3824) - lu(k,3337) * lu(k,3818) + lu(k,3825) = lu(k,3825) - lu(k,3338) * lu(k,3818) + lu(k,3826) = lu(k,3826) - lu(k,3339) * lu(k,3818) + lu(k,3827) = lu(k,3827) - lu(k,3340) * lu(k,3818) + lu(k,3860) = lu(k,3860) - lu(k,3332) * lu(k,3859) + lu(k,3861) = lu(k,3861) - lu(k,3333) * lu(k,3859) + lu(k,3862) = lu(k,3862) - lu(k,3334) * lu(k,3859) + lu(k,3863) = lu(k,3863) - lu(k,3335) * lu(k,3859) + lu(k,3864) = lu(k,3864) - lu(k,3336) * lu(k,3859) + lu(k,3865) = lu(k,3865) - lu(k,3337) * lu(k,3859) + lu(k,3866) = lu(k,3866) - lu(k,3338) * lu(k,3859) + lu(k,3867) = lu(k,3867) - lu(k,3339) * lu(k,3859) + lu(k,3868) = lu(k,3868) - lu(k,3340) * lu(k,3859) + lu(k,3954) = lu(k,3954) - lu(k,3332) * lu(k,3953) + lu(k,3955) = lu(k,3955) - lu(k,3333) * lu(k,3953) + lu(k,3956) = lu(k,3956) - lu(k,3334) * lu(k,3953) + lu(k,3957) = lu(k,3957) - lu(k,3335) * lu(k,3953) + lu(k,3958) = lu(k,3958) - lu(k,3336) * lu(k,3953) + lu(k,3959) = lu(k,3959) - lu(k,3337) * lu(k,3953) + lu(k,3960) = lu(k,3960) - lu(k,3338) * lu(k,3953) + lu(k,3961) = lu(k,3961) - lu(k,3339) * lu(k,3953) + lu(k,3962) = lu(k,3962) - lu(k,3340) * lu(k,3953) + lu(k,4046) = lu(k,4046) - lu(k,3332) * lu(k,4045) + lu(k,4047) = lu(k,4047) - lu(k,3333) * lu(k,4045) + lu(k,4048) = lu(k,4048) - lu(k,3334) * lu(k,4045) + lu(k,4049) = lu(k,4049) - lu(k,3335) * lu(k,4045) + lu(k,4050) = lu(k,4050) - lu(k,3336) * lu(k,4045) + lu(k,4051) = lu(k,4051) - lu(k,3337) * lu(k,4045) + lu(k,4052) = lu(k,4052) - lu(k,3338) * lu(k,4045) + lu(k,4053) = lu(k,4053) - lu(k,3339) * lu(k,4045) + lu(k,4054) = lu(k,4054) - lu(k,3340) * lu(k,4045) + lu(k,4098) = lu(k,4098) - lu(k,3332) * lu(k,4097) + lu(k,4099) = lu(k,4099) - lu(k,3333) * lu(k,4097) + lu(k,4100) = lu(k,4100) - lu(k,3334) * lu(k,4097) + lu(k,4101) = lu(k,4101) - lu(k,3335) * lu(k,4097) + lu(k,4102) = lu(k,4102) - lu(k,3336) * lu(k,4097) + lu(k,4103) = lu(k,4103) - lu(k,3337) * lu(k,4097) + lu(k,4104) = lu(k,4104) - lu(k,3338) * lu(k,4097) + lu(k,4105) = lu(k,4105) - lu(k,3339) * lu(k,4097) + lu(k,4106) = lu(k,4106) - lu(k,3340) * lu(k,4097) + lu(k,4124) = lu(k,4124) - lu(k,3332) * lu(k,4123) + lu(k,4125) = lu(k,4125) - lu(k,3333) * lu(k,4123) + lu(k,4126) = lu(k,4126) - lu(k,3334) * lu(k,4123) + lu(k,4127) = lu(k,4127) - lu(k,3335) * lu(k,4123) + lu(k,4128) = lu(k,4128) - lu(k,3336) * lu(k,4123) + lu(k,4129) = lu(k,4129) - lu(k,3337) * lu(k,4123) + lu(k,4130) = lu(k,4130) - lu(k,3338) * lu(k,4123) + lu(k,4131) = lu(k,4131) - lu(k,3339) * lu(k,4123) + lu(k,4132) = lu(k,4132) - lu(k,3340) * lu(k,4123) + lu(k,3358) = 1._r8 / lu(k,3358) + lu(k,3359) = lu(k,3359) * lu(k,3358) + lu(k,3360) = lu(k,3360) * lu(k,3358) + lu(k,3361) = lu(k,3361) * lu(k,3358) + lu(k,3362) = lu(k,3362) * lu(k,3358) + lu(k,3363) = lu(k,3363) * lu(k,3358) + lu(k,3364) = lu(k,3364) * lu(k,3358) + lu(k,3365) = lu(k,3365) * lu(k,3358) + lu(k,3366) = lu(k,3366) * lu(k,3358) + lu(k,3390) = lu(k,3390) - lu(k,3359) * lu(k,3389) + lu(k,3391) = lu(k,3391) - lu(k,3360) * lu(k,3389) + lu(k,3392) = lu(k,3392) - lu(k,3361) * lu(k,3389) + lu(k,3393) = lu(k,3393) - lu(k,3362) * lu(k,3389) + lu(k,3394) = lu(k,3394) - lu(k,3363) * lu(k,3389) + lu(k,3395) = lu(k,3395) - lu(k,3364) * lu(k,3389) + lu(k,3396) = lu(k,3396) - lu(k,3365) * lu(k,3389) + lu(k,3397) = lu(k,3397) - lu(k,3366) * lu(k,3389) + lu(k,3570) = lu(k,3570) - lu(k,3359) * lu(k,3569) + lu(k,3571) = lu(k,3571) - lu(k,3360) * lu(k,3569) + lu(k,3572) = lu(k,3572) - lu(k,3361) * lu(k,3569) + lu(k,3573) = lu(k,3573) - lu(k,3362) * lu(k,3569) + lu(k,3574) = lu(k,3574) - lu(k,3363) * lu(k,3569) + lu(k,3575) = lu(k,3575) - lu(k,3364) * lu(k,3569) + lu(k,3576) = lu(k,3576) - lu(k,3365) * lu(k,3569) + lu(k,3577) = lu(k,3577) - lu(k,3366) * lu(k,3569) + lu(k,3820) = lu(k,3820) - lu(k,3359) * lu(k,3819) + lu(k,3821) = lu(k,3821) - lu(k,3360) * lu(k,3819) + lu(k,3822) = lu(k,3822) - lu(k,3361) * lu(k,3819) + lu(k,3823) = lu(k,3823) - lu(k,3362) * lu(k,3819) + lu(k,3824) = lu(k,3824) - lu(k,3363) * lu(k,3819) + lu(k,3825) = lu(k,3825) - lu(k,3364) * lu(k,3819) + lu(k,3826) = lu(k,3826) - lu(k,3365) * lu(k,3819) + lu(k,3827) = lu(k,3827) - lu(k,3366) * lu(k,3819) + lu(k,3861) = lu(k,3861) - lu(k,3359) * lu(k,3860) + lu(k,3862) = lu(k,3862) - lu(k,3360) * lu(k,3860) + lu(k,3863) = lu(k,3863) - lu(k,3361) * lu(k,3860) + lu(k,3864) = lu(k,3864) - lu(k,3362) * lu(k,3860) + lu(k,3865) = lu(k,3865) - lu(k,3363) * lu(k,3860) + lu(k,3866) = lu(k,3866) - lu(k,3364) * lu(k,3860) + lu(k,3867) = lu(k,3867) - lu(k,3365) * lu(k,3860) + lu(k,3868) = lu(k,3868) - lu(k,3366) * lu(k,3860) + lu(k,3955) = lu(k,3955) - lu(k,3359) * lu(k,3954) + lu(k,3956) = lu(k,3956) - lu(k,3360) * lu(k,3954) + lu(k,3957) = lu(k,3957) - lu(k,3361) * lu(k,3954) + lu(k,3958) = lu(k,3958) - lu(k,3362) * lu(k,3954) + lu(k,3959) = lu(k,3959) - lu(k,3363) * lu(k,3954) + lu(k,3960) = lu(k,3960) - lu(k,3364) * lu(k,3954) + lu(k,3961) = lu(k,3961) - lu(k,3365) * lu(k,3954) + lu(k,3962) = lu(k,3962) - lu(k,3366) * lu(k,3954) + lu(k,4047) = lu(k,4047) - lu(k,3359) * lu(k,4046) + lu(k,4048) = lu(k,4048) - lu(k,3360) * lu(k,4046) + lu(k,4049) = lu(k,4049) - lu(k,3361) * lu(k,4046) + lu(k,4050) = lu(k,4050) - lu(k,3362) * lu(k,4046) + lu(k,4051) = lu(k,4051) - lu(k,3363) * lu(k,4046) + lu(k,4052) = lu(k,4052) - lu(k,3364) * lu(k,4046) + lu(k,4053) = lu(k,4053) - lu(k,3365) * lu(k,4046) + lu(k,4054) = lu(k,4054) - lu(k,3366) * lu(k,4046) + lu(k,4099) = lu(k,4099) - lu(k,3359) * lu(k,4098) + lu(k,4100) = lu(k,4100) - lu(k,3360) * lu(k,4098) + lu(k,4101) = lu(k,4101) - lu(k,3361) * lu(k,4098) + lu(k,4102) = lu(k,4102) - lu(k,3362) * lu(k,4098) + lu(k,4103) = lu(k,4103) - lu(k,3363) * lu(k,4098) + lu(k,4104) = lu(k,4104) - lu(k,3364) * lu(k,4098) + lu(k,4105) = lu(k,4105) - lu(k,3365) * lu(k,4098) + lu(k,4106) = lu(k,4106) - lu(k,3366) * lu(k,4098) + lu(k,4125) = lu(k,4125) - lu(k,3359) * lu(k,4124) + lu(k,4126) = lu(k,4126) - lu(k,3360) * lu(k,4124) + lu(k,4127) = lu(k,4127) - lu(k,3361) * lu(k,4124) + lu(k,4128) = lu(k,4128) - lu(k,3362) * lu(k,4124) + lu(k,4129) = lu(k,4129) - lu(k,3363) * lu(k,4124) + lu(k,4130) = lu(k,4130) - lu(k,3364) * lu(k,4124) + lu(k,4131) = lu(k,4131) - lu(k,3365) * lu(k,4124) + lu(k,4132) = lu(k,4132) - lu(k,3366) * lu(k,4124) + lu(k,3390) = 1._r8 / lu(k,3390) + lu(k,3391) = lu(k,3391) * lu(k,3390) + lu(k,3392) = lu(k,3392) * lu(k,3390) + lu(k,3393) = lu(k,3393) * lu(k,3390) + lu(k,3394) = lu(k,3394) * lu(k,3390) + lu(k,3395) = lu(k,3395) * lu(k,3390) + lu(k,3396) = lu(k,3396) * lu(k,3390) + lu(k,3397) = lu(k,3397) * lu(k,3390) + lu(k,3571) = lu(k,3571) - lu(k,3391) * lu(k,3570) + lu(k,3572) = lu(k,3572) - lu(k,3392) * lu(k,3570) + lu(k,3573) = lu(k,3573) - lu(k,3393) * lu(k,3570) + lu(k,3574) = lu(k,3574) - lu(k,3394) * lu(k,3570) + lu(k,3575) = lu(k,3575) - lu(k,3395) * lu(k,3570) + lu(k,3576) = lu(k,3576) - lu(k,3396) * lu(k,3570) + lu(k,3577) = lu(k,3577) - lu(k,3397) * lu(k,3570) + lu(k,3821) = lu(k,3821) - lu(k,3391) * lu(k,3820) + lu(k,3822) = lu(k,3822) - lu(k,3392) * lu(k,3820) + lu(k,3823) = lu(k,3823) - lu(k,3393) * lu(k,3820) + lu(k,3824) = lu(k,3824) - lu(k,3394) * lu(k,3820) + lu(k,3825) = lu(k,3825) - lu(k,3395) * lu(k,3820) + lu(k,3826) = lu(k,3826) - lu(k,3396) * lu(k,3820) + lu(k,3827) = lu(k,3827) - lu(k,3397) * lu(k,3820) + lu(k,3862) = lu(k,3862) - lu(k,3391) * lu(k,3861) + lu(k,3863) = lu(k,3863) - lu(k,3392) * lu(k,3861) + lu(k,3864) = lu(k,3864) - lu(k,3393) * lu(k,3861) + lu(k,3865) = lu(k,3865) - lu(k,3394) * lu(k,3861) + lu(k,3866) = lu(k,3866) - lu(k,3395) * lu(k,3861) + lu(k,3867) = lu(k,3867) - lu(k,3396) * lu(k,3861) + lu(k,3868) = lu(k,3868) - lu(k,3397) * lu(k,3861) + lu(k,3956) = lu(k,3956) - lu(k,3391) * lu(k,3955) + lu(k,3957) = lu(k,3957) - lu(k,3392) * lu(k,3955) + lu(k,3958) = lu(k,3958) - lu(k,3393) * lu(k,3955) + lu(k,3959) = lu(k,3959) - lu(k,3394) * lu(k,3955) + lu(k,3960) = lu(k,3960) - lu(k,3395) * lu(k,3955) + lu(k,3961) = lu(k,3961) - lu(k,3396) * lu(k,3955) + lu(k,3962) = lu(k,3962) - lu(k,3397) * lu(k,3955) + lu(k,4048) = lu(k,4048) - lu(k,3391) * lu(k,4047) + lu(k,4049) = lu(k,4049) - lu(k,3392) * lu(k,4047) + lu(k,4050) = lu(k,4050) - lu(k,3393) * lu(k,4047) + lu(k,4051) = lu(k,4051) - lu(k,3394) * lu(k,4047) + lu(k,4052) = lu(k,4052) - lu(k,3395) * lu(k,4047) + lu(k,4053) = lu(k,4053) - lu(k,3396) * lu(k,4047) + lu(k,4054) = lu(k,4054) - lu(k,3397) * lu(k,4047) + lu(k,4100) = lu(k,4100) - lu(k,3391) * lu(k,4099) + lu(k,4101) = lu(k,4101) - lu(k,3392) * lu(k,4099) + lu(k,4102) = lu(k,4102) - lu(k,3393) * lu(k,4099) + lu(k,4103) = lu(k,4103) - lu(k,3394) * lu(k,4099) + lu(k,4104) = lu(k,4104) - lu(k,3395) * lu(k,4099) + lu(k,4105) = lu(k,4105) - lu(k,3396) * lu(k,4099) + lu(k,4106) = lu(k,4106) - lu(k,3397) * lu(k,4099) + lu(k,4126) = lu(k,4126) - lu(k,3391) * lu(k,4125) + lu(k,4127) = lu(k,4127) - lu(k,3392) * lu(k,4125) + lu(k,4128) = lu(k,4128) - lu(k,3393) * lu(k,4125) + lu(k,4129) = lu(k,4129) - lu(k,3394) * lu(k,4125) + lu(k,4130) = lu(k,4130) - lu(k,3395) * lu(k,4125) + lu(k,4131) = lu(k,4131) - lu(k,3396) * lu(k,4125) + lu(k,4132) = lu(k,4132) - lu(k,3397) * lu(k,4125) + lu(k,3571) = 1._r8 / lu(k,3571) + lu(k,3572) = lu(k,3572) * lu(k,3571) + lu(k,3573) = lu(k,3573) * lu(k,3571) + lu(k,3574) = lu(k,3574) * lu(k,3571) + lu(k,3575) = lu(k,3575) * lu(k,3571) + lu(k,3576) = lu(k,3576) * lu(k,3571) + lu(k,3577) = lu(k,3577) * lu(k,3571) + lu(k,3822) = lu(k,3822) - lu(k,3572) * lu(k,3821) + lu(k,3823) = lu(k,3823) - lu(k,3573) * lu(k,3821) + lu(k,3824) = lu(k,3824) - lu(k,3574) * lu(k,3821) + lu(k,3825) = lu(k,3825) - lu(k,3575) * lu(k,3821) + lu(k,3826) = lu(k,3826) - lu(k,3576) * lu(k,3821) + lu(k,3827) = lu(k,3827) - lu(k,3577) * lu(k,3821) + lu(k,3863) = lu(k,3863) - lu(k,3572) * lu(k,3862) + lu(k,3864) = lu(k,3864) - lu(k,3573) * lu(k,3862) + lu(k,3865) = lu(k,3865) - lu(k,3574) * lu(k,3862) + lu(k,3866) = lu(k,3866) - lu(k,3575) * lu(k,3862) + lu(k,3867) = lu(k,3867) - lu(k,3576) * lu(k,3862) + lu(k,3868) = lu(k,3868) - lu(k,3577) * lu(k,3862) + lu(k,3957) = lu(k,3957) - lu(k,3572) * lu(k,3956) + lu(k,3958) = lu(k,3958) - lu(k,3573) * lu(k,3956) + lu(k,3959) = lu(k,3959) - lu(k,3574) * lu(k,3956) + lu(k,3960) = lu(k,3960) - lu(k,3575) * lu(k,3956) + lu(k,3961) = lu(k,3961) - lu(k,3576) * lu(k,3956) + lu(k,3962) = lu(k,3962) - lu(k,3577) * lu(k,3956) + lu(k,4049) = lu(k,4049) - lu(k,3572) * lu(k,4048) + lu(k,4050) = lu(k,4050) - lu(k,3573) * lu(k,4048) + lu(k,4051) = lu(k,4051) - lu(k,3574) * lu(k,4048) + lu(k,4052) = lu(k,4052) - lu(k,3575) * lu(k,4048) + lu(k,4053) = lu(k,4053) - lu(k,3576) * lu(k,4048) + lu(k,4054) = lu(k,4054) - lu(k,3577) * lu(k,4048) + lu(k,4101) = lu(k,4101) - lu(k,3572) * lu(k,4100) + lu(k,4102) = lu(k,4102) - lu(k,3573) * lu(k,4100) + lu(k,4103) = lu(k,4103) - lu(k,3574) * lu(k,4100) + lu(k,4104) = lu(k,4104) - lu(k,3575) * lu(k,4100) + lu(k,4105) = lu(k,4105) - lu(k,3576) * lu(k,4100) + lu(k,4106) = lu(k,4106) - lu(k,3577) * lu(k,4100) + lu(k,4127) = lu(k,4127) - lu(k,3572) * lu(k,4126) + lu(k,4128) = lu(k,4128) - lu(k,3573) * lu(k,4126) + lu(k,4129) = lu(k,4129) - lu(k,3574) * lu(k,4126) + lu(k,4130) = lu(k,4130) - lu(k,3575) * lu(k,4126) + lu(k,4131) = lu(k,4131) - lu(k,3576) * lu(k,4126) + lu(k,4132) = lu(k,4132) - lu(k,3577) * lu(k,4126) + lu(k,3822) = 1._r8 / lu(k,3822) + lu(k,3823) = lu(k,3823) * lu(k,3822) + lu(k,3824) = lu(k,3824) * lu(k,3822) + lu(k,3825) = lu(k,3825) * lu(k,3822) + lu(k,3826) = lu(k,3826) * lu(k,3822) + lu(k,3827) = lu(k,3827) * lu(k,3822) + lu(k,3864) = lu(k,3864) - lu(k,3823) * lu(k,3863) + lu(k,3865) = lu(k,3865) - lu(k,3824) * lu(k,3863) + lu(k,3866) = lu(k,3866) - lu(k,3825) * lu(k,3863) + lu(k,3867) = lu(k,3867) - lu(k,3826) * lu(k,3863) + lu(k,3868) = lu(k,3868) - lu(k,3827) * lu(k,3863) + lu(k,3958) = lu(k,3958) - lu(k,3823) * lu(k,3957) + lu(k,3959) = lu(k,3959) - lu(k,3824) * lu(k,3957) + lu(k,3960) = lu(k,3960) - lu(k,3825) * lu(k,3957) + lu(k,3961) = lu(k,3961) - lu(k,3826) * lu(k,3957) + lu(k,3962) = lu(k,3962) - lu(k,3827) * lu(k,3957) + lu(k,4050) = lu(k,4050) - lu(k,3823) * lu(k,4049) + lu(k,4051) = lu(k,4051) - lu(k,3824) * lu(k,4049) + lu(k,4052) = lu(k,4052) - lu(k,3825) * lu(k,4049) + lu(k,4053) = lu(k,4053) - lu(k,3826) * lu(k,4049) + lu(k,4054) = lu(k,4054) - lu(k,3827) * lu(k,4049) + lu(k,4102) = lu(k,4102) - lu(k,3823) * lu(k,4101) + lu(k,4103) = lu(k,4103) - lu(k,3824) * lu(k,4101) + lu(k,4104) = lu(k,4104) - lu(k,3825) * lu(k,4101) + lu(k,4105) = lu(k,4105) - lu(k,3826) * lu(k,4101) + lu(k,4106) = lu(k,4106) - lu(k,3827) * lu(k,4101) + lu(k,4128) = lu(k,4128) - lu(k,3823) * lu(k,4127) + lu(k,4129) = lu(k,4129) - lu(k,3824) * lu(k,4127) + lu(k,4130) = lu(k,4130) - lu(k,3825) * lu(k,4127) + lu(k,4131) = lu(k,4131) - lu(k,3826) * lu(k,4127) + lu(k,4132) = lu(k,4132) - lu(k,3827) * lu(k,4127) + end do + end subroutine lu_fac53 + subroutine lu_fac54( 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,3864) = 1._r8 / lu(k,3864) + lu(k,3865) = lu(k,3865) * lu(k,3864) + lu(k,3866) = lu(k,3866) * lu(k,3864) + lu(k,3867) = lu(k,3867) * lu(k,3864) + lu(k,3868) = lu(k,3868) * lu(k,3864) + lu(k,3959) = lu(k,3959) - lu(k,3865) * lu(k,3958) + lu(k,3960) = lu(k,3960) - lu(k,3866) * lu(k,3958) + lu(k,3961) = lu(k,3961) - lu(k,3867) * lu(k,3958) + lu(k,3962) = lu(k,3962) - lu(k,3868) * lu(k,3958) + lu(k,4051) = lu(k,4051) - lu(k,3865) * lu(k,4050) + lu(k,4052) = lu(k,4052) - lu(k,3866) * lu(k,4050) + lu(k,4053) = lu(k,4053) - lu(k,3867) * lu(k,4050) + lu(k,4054) = lu(k,4054) - lu(k,3868) * lu(k,4050) + lu(k,4103) = lu(k,4103) - lu(k,3865) * lu(k,4102) + lu(k,4104) = lu(k,4104) - lu(k,3866) * lu(k,4102) + lu(k,4105) = lu(k,4105) - lu(k,3867) * lu(k,4102) + lu(k,4106) = lu(k,4106) - lu(k,3868) * lu(k,4102) + lu(k,4129) = lu(k,4129) - lu(k,3865) * lu(k,4128) + lu(k,4130) = lu(k,4130) - lu(k,3866) * lu(k,4128) + lu(k,4131) = lu(k,4131) - lu(k,3867) * lu(k,4128) + lu(k,4132) = lu(k,4132) - lu(k,3868) * lu(k,4128) + lu(k,3959) = 1._r8 / lu(k,3959) + lu(k,3960) = lu(k,3960) * lu(k,3959) + lu(k,3961) = lu(k,3961) * lu(k,3959) + lu(k,3962) = lu(k,3962) * lu(k,3959) + lu(k,4052) = lu(k,4052) - lu(k,3960) * lu(k,4051) + lu(k,4053) = lu(k,4053) - lu(k,3961) * lu(k,4051) + lu(k,4054) = lu(k,4054) - lu(k,3962) * lu(k,4051) + lu(k,4104) = lu(k,4104) - lu(k,3960) * lu(k,4103) + lu(k,4105) = lu(k,4105) - lu(k,3961) * lu(k,4103) + lu(k,4106) = lu(k,4106) - lu(k,3962) * lu(k,4103) + lu(k,4130) = lu(k,4130) - lu(k,3960) * lu(k,4129) + lu(k,4131) = lu(k,4131) - lu(k,3961) * lu(k,4129) + lu(k,4132) = lu(k,4132) - lu(k,3962) * lu(k,4129) + lu(k,4052) = 1._r8 / lu(k,4052) + lu(k,4053) = lu(k,4053) * lu(k,4052) + lu(k,4054) = lu(k,4054) * lu(k,4052) + lu(k,4105) = lu(k,4105) - lu(k,4053) * lu(k,4104) + lu(k,4106) = lu(k,4106) - lu(k,4054) * lu(k,4104) + lu(k,4131) = lu(k,4131) - lu(k,4053) * lu(k,4130) + lu(k,4132) = lu(k,4132) - lu(k,4054) * lu(k,4130) + lu(k,4105) = 1._r8 / lu(k,4105) + lu(k,4106) = lu(k,4106) * lu(k,4105) + lu(k,4132) = lu(k,4132) - lu(k,4106) * lu(k,4131) + lu(k,4132) = 1._r8 / lu(k,4132) + end do + end subroutine lu_fac54 subroutine lu_fac( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 @@ -16261,5 +17353,8 @@ subroutine lu_fac( avec_len, lu ) call lu_fac49( avec_len, lu ) call lu_fac50( avec_len, lu ) call lu_fac51( avec_len, lu ) + call lu_fac52( avec_len, lu ) + call lu_fac53( avec_len, lu ) + call lu_fac54( avec_len, lu ) end subroutine lu_fac end module mo_lu_factor diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/mo_lu_solve.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/mo_lu_solve.F90 index 5888b2a683..a64023e343 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/mo_lu_solve.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/mo_lu_solve.F90 @@ -21,208 +21,208 @@ subroutine lu_slv01( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,282) = b(k,282) - lu(k,104) * b(k,47) - b(k,286) = b(k,286) - lu(k,105) * b(k,47) - b(k,276) = b(k,276) - lu(k,107) * b(k,48) - b(k,282) = b(k,282) - lu(k,108) * b(k,48) - b(k,277) = b(k,277) - lu(k,110) * b(k,49) - b(k,285) = b(k,285) - lu(k,111) * b(k,49) - b(k,173) = b(k,173) - lu(k,113) * b(k,50) - b(k,282) = b(k,282) - lu(k,114) * b(k,50) - b(k,286) = b(k,286) - lu(k,115) * b(k,50) - b(k,80) = b(k,80) - lu(k,117) * b(k,51) - b(k,282) = b(k,282) - lu(k,118) * b(k,51) - b(k,75) = b(k,75) - lu(k,120) * b(k,52) - b(k,286) = b(k,286) - lu(k,121) * b(k,52) - b(k,167) = b(k,167) - lu(k,123) * b(k,53) - b(k,275) = b(k,275) - lu(k,124) * b(k,53) - b(k,118) = b(k,118) - lu(k,126) * b(k,54) - b(k,281) = b(k,281) - lu(k,127) * b(k,54) - b(k,285) = b(k,285) - lu(k,129) * b(k,55) - b(k,57) = b(k,57) - lu(k,132) * b(k,56) - b(k,58) = b(k,58) - lu(k,133) * b(k,56) - b(k,114) = b(k,114) - lu(k,134) * b(k,56) - b(k,276) = b(k,276) - lu(k,135) * b(k,56) - b(k,282) = b(k,282) - lu(k,136) * b(k,56) - b(k,106) = b(k,106) - lu(k,138) * b(k,57) - b(k,223) = b(k,223) - lu(k,139) * b(k,57) - b(k,276) = b(k,276) - lu(k,140) * b(k,57) - b(k,105) = b(k,105) - lu(k,142) * b(k,58) - b(k,110) = b(k,110) - lu(k,143) * b(k,58) - b(k,276) = b(k,276) - lu(k,144) * b(k,58) - b(k,282) = b(k,282) - lu(k,145) * b(k,58) - b(k,275) = b(k,275) - lu(k,147) * b(k,59) - b(k,276) = b(k,276) - lu(k,148) * b(k,59) - b(k,282) = b(k,282) - lu(k,149) * b(k,59) - b(k,270) = b(k,270) - lu(k,151) * b(k,60) - b(k,281) = b(k,281) - lu(k,152) * b(k,60) - b(k,188) = b(k,188) - lu(k,154) * b(k,61) - b(k,282) = b(k,282) - lu(k,155) * b(k,61) - b(k,167) = b(k,167) - lu(k,157) * b(k,62) - b(k,275) = b(k,275) - lu(k,158) * b(k,62) - b(k,285) = b(k,285) - lu(k,159) * b(k,62) - b(k,64) = b(k,64) - lu(k,162) * b(k,63) - b(k,65) = b(k,65) - lu(k,163) * b(k,63) - b(k,102) = b(k,102) - lu(k,164) * b(k,63) - b(k,153) = b(k,153) - lu(k,165) * b(k,63) - b(k,276) = b(k,276) - lu(k,166) * b(k,63) - b(k,282) = b(k,282) - lu(k,167) * b(k,63) - b(k,105) = b(k,105) - lu(k,169) * b(k,64) - b(k,110) = b(k,110) - lu(k,170) * b(k,64) - b(k,276) = b(k,276) - lu(k,171) * b(k,64) - b(k,282) = b(k,282) - lu(k,172) * b(k,64) - b(k,223) = b(k,223) - lu(k,174) * b(k,65) - b(k,269) = b(k,269) - lu(k,175) * b(k,65) - b(k,276) = b(k,276) - lu(k,176) * b(k,65) - b(k,67) = b(k,67) - lu(k,180) * b(k,66) - b(k,102) = b(k,102) - lu(k,181) * b(k,66) - b(k,154) = b(k,154) - lu(k,182) * b(k,66) - b(k,223) = b(k,223) - lu(k,183) * b(k,66) - b(k,269) = b(k,269) - lu(k,184) * b(k,66) - b(k,276) = b(k,276) - lu(k,185) * b(k,66) - b(k,282) = b(k,282) - lu(k,186) * b(k,66) - b(k,110) = b(k,110) - lu(k,188) * b(k,67) - b(k,115) = b(k,115) - lu(k,189) * b(k,67) - b(k,276) = b(k,276) - lu(k,190) * b(k,67) - b(k,282) = b(k,282) - lu(k,191) * b(k,67) - b(k,167) = b(k,167) - lu(k,193) * b(k,68) - b(k,271) = b(k,271) - lu(k,194) * b(k,68) - b(k,233) = b(k,233) - lu(k,196) * b(k,69) - b(k,285) = b(k,285) - lu(k,197) * b(k,69) - b(k,118) = b(k,118) - lu(k,199) * b(k,70) - b(k,282) = b(k,282) - lu(k,200) * b(k,70) - b(k,237) = b(k,237) - lu(k,202) * b(k,71) - b(k,239) = b(k,239) - lu(k,203) * b(k,71) - b(k,224) = b(k,224) - lu(k,205) * b(k,72) - b(k,239) = b(k,239) - lu(k,206) * b(k,72) - b(k,232) = b(k,232) - lu(k,208) * b(k,73) - b(k,235) = b(k,235) - lu(k,209) * b(k,73) - b(k,225) = b(k,225) - lu(k,211) * b(k,74) - b(k,235) = b(k,235) - lu(k,212) * b(k,74) - b(k,191) = b(k,191) - lu(k,215) * b(k,75) - b(k,280) = b(k,280) - lu(k,216) * b(k,75) - b(k,286) = b(k,286) - lu(k,217) * b(k,75) - b(k,203) = b(k,203) - lu(k,219) * b(k,76) - b(k,276) = b(k,276) - lu(k,220) * b(k,76) - b(k,282) = b(k,282) - lu(k,221) * b(k,76) - b(k,110) = b(k,110) - lu(k,223) * b(k,77) - b(k,137) = b(k,137) - lu(k,224) * b(k,77) - b(k,282) = b(k,282) - lu(k,225) * b(k,77) - b(k,265) = b(k,265) - lu(k,227) * b(k,78) - b(k,266) = b(k,266) - lu(k,228) * b(k,78) - b(k,282) = b(k,282) - lu(k,229) * b(k,78) - b(k,264) = b(k,264) - lu(k,231) * b(k,79) - b(k,267) = b(k,267) - lu(k,232) * b(k,79) - b(k,282) = b(k,282) - lu(k,233) * b(k,79) - b(k,218) = b(k,218) - lu(k,235) * b(k,80) - b(k,276) = b(k,276) - lu(k,236) * b(k,80) - b(k,278) = b(k,278) - lu(k,237) * b(k,80) - b(k,191) = b(k,191) - lu(k,239) * b(k,81) - b(k,270) = b(k,270) - lu(k,240) * b(k,81) - b(k,274) = b(k,274) - lu(k,241) * b(k,81) - b(k,276) = b(k,276) - lu(k,242) * b(k,81) - b(k,282) = b(k,282) - lu(k,243) * b(k,81) - b(k,270) = b(k,270) - lu(k,245) * b(k,82) - b(k,272) = b(k,272) - lu(k,246) * b(k,82) - b(k,274) = b(k,274) - lu(k,247) * b(k,82) - b(k,280) = b(k,280) - lu(k,248) * b(k,82) - b(k,281) = b(k,281) - lu(k,249) * b(k,82) - b(k,155) = b(k,155) - lu(k,251) * b(k,83) - b(k,276) = b(k,276) - lu(k,252) * b(k,83) - b(k,187) = b(k,187) - lu(k,254) * b(k,84) - b(k,193) = b(k,193) - lu(k,255) * b(k,84) - b(k,223) = b(k,223) - lu(k,256) * b(k,84) - b(k,276) = b(k,276) - lu(k,257) * b(k,84) - b(k,282) = b(k,282) - lu(k,258) * b(k,84) - b(k,199) = b(k,199) - lu(k,260) * b(k,85) - b(k,282) = b(k,282) - lu(k,261) * b(k,85) - b(k,283) = b(k,283) - lu(k,262) * b(k,85) - b(k,285) = b(k,285) - lu(k,263) * b(k,85) - b(k,286) = b(k,286) - lu(k,264) * b(k,85) - b(k,142) = b(k,142) - lu(k,266) * b(k,86) - b(k,203) = b(k,203) - lu(k,267) * b(k,86) - b(k,269) = b(k,269) - lu(k,268) * b(k,86) - b(k,282) = b(k,282) - lu(k,269) * b(k,86) - b(k,223) = b(k,223) - lu(k,271) * b(k,87) - b(k,240) = b(k,240) - lu(k,272) * b(k,87) - b(k,269) = b(k,269) - lu(k,273) * b(k,87) - b(k,276) = b(k,276) - lu(k,274) * b(k,87) - b(k,191) = b(k,191) - lu(k,276) * b(k,88) - b(k,221) = b(k,221) - lu(k,277) * b(k,88) - b(k,277) = b(k,277) - lu(k,278) * b(k,88) - b(k,280) = b(k,280) - lu(k,279) * b(k,88) - b(k,105) = b(k,105) - lu(k,281) * b(k,89) - b(k,193) = b(k,193) - lu(k,282) * b(k,89) - b(k,276) = b(k,276) - lu(k,283) * b(k,89) - b(k,282) = b(k,282) - lu(k,284) * b(k,89) - b(k,102) = b(k,102) - lu(k,287) * b(k,90) - b(k,118) = b(k,118) - lu(k,288) * b(k,90) - b(k,276) = b(k,276) - lu(k,289) * b(k,90) - b(k,282) = b(k,282) - lu(k,290) * b(k,90) - b(k,199) = b(k,199) - lu(k,292) * b(k,91) - b(k,203) = b(k,203) - lu(k,293) * b(k,91) - b(k,276) = b(k,276) - lu(k,294) * b(k,91) - b(k,282) = b(k,282) - lu(k,295) * b(k,91) - b(k,135) = b(k,135) - lu(k,297) * b(k,92) - b(k,276) = b(k,276) - lu(k,298) * b(k,92) - b(k,282) = b(k,282) - lu(k,299) * b(k,92) - b(k,117) = b(k,117) - lu(k,301) * b(k,93) - b(k,191) = b(k,191) - lu(k,302) * b(k,93) - b(k,221) = b(k,221) - lu(k,303) * b(k,93) - b(k,223) = b(k,223) - lu(k,304) * b(k,93) - b(k,271) = b(k,271) - lu(k,305) * b(k,93) - b(k,280) = b(k,280) - lu(k,306) * b(k,93) - b(k,282) = b(k,282) - lu(k,307) * b(k,93) - b(k,129) = b(k,129) - lu(k,309) * b(k,94) - b(k,203) = b(k,203) - lu(k,310) * b(k,94) - b(k,251) = b(k,251) - lu(k,311) * b(k,94) - b(k,274) = b(k,274) - lu(k,312) * b(k,94) - b(k,278) = b(k,278) - lu(k,313) * b(k,94) - b(k,281) = b(k,281) - lu(k,314) * b(k,94) - b(k,282) = b(k,282) - lu(k,315) * b(k,94) - b(k,271) = b(k,271) - lu(k,317) * b(k,95) - b(k,272) = b(k,272) - lu(k,318) * b(k,95) - b(k,280) = b(k,280) - lu(k,319) * b(k,95) - b(k,281) = b(k,281) - lu(k,320) * b(k,95) - b(k,282) = b(k,282) - lu(k,321) * b(k,95) - b(k,106) = b(k,106) - lu(k,323) * b(k,96) - b(k,114) = b(k,114) - lu(k,324) * b(k,96) - b(k,193) = b(k,193) - lu(k,325) * b(k,96) - b(k,276) = b(k,276) - lu(k,326) * b(k,96) - b(k,282) = b(k,282) - lu(k,327) * b(k,96) - b(k,159) = b(k,159) - lu(k,329) * b(k,97) - b(k,223) = b(k,223) - lu(k,330) * b(k,97) - b(k,276) = b(k,276) - lu(k,331) * b(k,97) - b(k,197) = b(k,197) - lu(k,333) * b(k,98) - b(k,269) = b(k,269) - lu(k,334) * b(k,98) - b(k,278) = b(k,278) - lu(k,335) * b(k,98) - b(k,282) = b(k,282) - lu(k,336) * b(k,98) - b(k,286) = b(k,286) - lu(k,337) * b(k,98) - b(k,173) = b(k,173) - lu(k,339) * b(k,99) - b(k,251) = b(k,251) - lu(k,340) * b(k,99) - b(k,276) = b(k,276) - lu(k,341) * b(k,99) - b(k,282) = b(k,282) - lu(k,342) * b(k,99) - b(k,286) = b(k,286) - lu(k,343) * b(k,99) - b(k,192) = b(k,192) - lu(k,345) * b(k,100) - b(k,223) = b(k,223) - lu(k,346) * b(k,100) - b(k,268) = b(k,268) - lu(k,347) * b(k,100) - b(k,281) = b(k,281) - lu(k,348) * b(k,100) - b(k,282) = b(k,282) - lu(k,349) * b(k,100) - b(k,115) = b(k,115) - lu(k,351) * b(k,101) - b(k,193) = b(k,193) - lu(k,352) * b(k,101) - b(k,240) = b(k,240) - lu(k,353) * b(k,101) - b(k,276) = b(k,276) - lu(k,354) * b(k,101) - b(k,282) = b(k,282) - lu(k,355) * b(k,101) - b(k,118) = b(k,118) - lu(k,359) * b(k,102) - b(k,272) = b(k,272) - lu(k,360) * b(k,102) - b(k,276) = b(k,276) - lu(k,361) * b(k,102) - b(k,281) = b(k,281) - lu(k,362) * b(k,102) - b(k,282) = b(k,282) - lu(k,363) * b(k,102) - b(k,274) = b(k,274) - lu(k,365) * b(k,103) - b(k,276) = b(k,276) - lu(k,366) * b(k,103) - b(k,281) = b(k,281) - lu(k,367) * b(k,103) - b(k,282) = b(k,282) - lu(k,368) * b(k,103) - b(k,286) = b(k,286) - lu(k,369) * b(k,103) + b(k,291) = b(k,291) - lu(k,113) * b(k,56) + b(k,311) = b(k,311) - lu(k,114) * b(k,56) + b(k,310) = b(k,310) - lu(k,116) * b(k,57) + b(k,315) = b(k,315) - lu(k,117) * b(k,57) + b(k,292) = b(k,292) - lu(k,119) * b(k,58) + b(k,311) = b(k,311) - lu(k,120) * b(k,58) + b(k,309) = b(k,309) - lu(k,122) * b(k,59) + b(k,310) = b(k,310) - lu(k,123) * b(k,59) + b(k,91) = b(k,91) - lu(k,125) * b(k,60) + b(k,274) = b(k,274) - lu(k,126) * b(k,60) + b(k,292) = b(k,292) - lu(k,127) * b(k,60) + b(k,197) = b(k,197) - lu(k,129) * b(k,61) + b(k,310) = b(k,310) - lu(k,130) * b(k,61) + b(k,315) = b(k,315) - lu(k,131) * b(k,61) + b(k,89) = b(k,89) - lu(k,133) * b(k,62) + b(k,292) = b(k,292) - lu(k,134) * b(k,62) + b(k,311) = b(k,311) - lu(k,135) * b(k,62) + b(k,91) = b(k,91) - lu(k,137) * b(k,63) + b(k,292) = b(k,292) - lu(k,138) * b(k,63) + b(k,311) = b(k,311) - lu(k,139) * b(k,63) + b(k,91) = b(k,91) - lu(k,141) * b(k,64) + b(k,292) = b(k,292) - lu(k,142) * b(k,64) + b(k,311) = b(k,311) - lu(k,143) * b(k,64) + b(k,310) = b(k,310) - lu(k,145) * b(k,65) + b(k,311) = b(k,311) - lu(k,146) * b(k,65) + b(k,315) = b(k,315) - lu(k,147) * b(k,65) + b(k,99) = b(k,99) - lu(k,149) * b(k,66) + b(k,310) = b(k,310) - lu(k,150) * b(k,66) + b(k,96) = b(k,96) - lu(k,152) * b(k,67) + b(k,315) = b(k,315) - lu(k,153) * b(k,67) + b(k,142) = b(k,142) - lu(k,155) * b(k,68) + b(k,314) = b(k,314) - lu(k,156) * b(k,68) + b(k,91) = b(k,91) - lu(k,158) * b(k,69) + b(k,274) = b(k,274) - lu(k,159) * b(k,69) + b(k,292) = b(k,292) - lu(k,160) * b(k,69) + b(k,311) = b(k,311) - lu(k,161) * b(k,69) + b(k,91) = b(k,91) - lu(k,163) * b(k,70) + b(k,217) = b(k,217) - lu(k,164) * b(k,70) + b(k,274) = b(k,274) - lu(k,165) * b(k,70) + b(k,292) = b(k,292) - lu(k,166) * b(k,70) + b(k,89) = b(k,89) - lu(k,168) * b(k,71) + b(k,91) = b(k,91) - lu(k,169) * b(k,71) + b(k,292) = b(k,292) - lu(k,170) * b(k,71) + b(k,311) = b(k,311) - lu(k,171) * b(k,71) + b(k,91) = b(k,91) - lu(k,173) * b(k,72) + b(k,217) = b(k,217) - lu(k,174) * b(k,72) + b(k,292) = b(k,292) - lu(k,175) * b(k,72) + b(k,311) = b(k,311) - lu(k,176) * b(k,72) + b(k,311) = b(k,311) - lu(k,178) * b(k,73) + b(k,75) = b(k,75) - lu(k,181) * b(k,74) + b(k,76) = b(k,76) - lu(k,182) * b(k,74) + b(k,139) = b(k,139) - lu(k,183) * b(k,74) + b(k,309) = b(k,309) - lu(k,184) * b(k,74) + b(k,310) = b(k,310) - lu(k,185) * b(k,74) + b(k,130) = b(k,130) - lu(k,187) * b(k,75) + b(k,264) = b(k,264) - lu(k,188) * b(k,75) + b(k,309) = b(k,309) - lu(k,189) * b(k,75) + b(k,128) = b(k,128) - lu(k,191) * b(k,76) + b(k,136) = b(k,136) - lu(k,192) * b(k,76) + b(k,309) = b(k,309) - lu(k,193) * b(k,76) + b(k,310) = b(k,310) - lu(k,194) * b(k,76) + b(k,292) = b(k,292) - lu(k,196) * b(k,77) + b(k,309) = b(k,309) - lu(k,197) * b(k,77) + b(k,310) = b(k,310) - lu(k,198) * b(k,77) + b(k,292) = b(k,292) - lu(k,200) * b(k,78) + b(k,305) = b(k,305) - lu(k,201) * b(k,78) + b(k,210) = b(k,210) - lu(k,203) * b(k,79) + b(k,310) = b(k,310) - lu(k,204) * b(k,79) + b(k,306) = b(k,306) - lu(k,206) * b(k,80) + b(k,314) = b(k,314) - lu(k,207) * b(k,80) + b(k,82) = b(k,82) - lu(k,210) * b(k,81) + b(k,83) = b(k,83) - lu(k,211) * b(k,81) + b(k,126) = b(k,126) - lu(k,212) * b(k,81) + b(k,180) = b(k,180) - lu(k,213) * b(k,81) + b(k,309) = b(k,309) - lu(k,214) * b(k,81) + b(k,310) = b(k,310) - lu(k,215) * b(k,81) + b(k,128) = b(k,128) - lu(k,217) * b(k,82) + b(k,136) = b(k,136) - lu(k,218) * b(k,82) + b(k,309) = b(k,309) - lu(k,219) * b(k,82) + b(k,310) = b(k,310) - lu(k,220) * b(k,82) + b(k,264) = b(k,264) - lu(k,222) * b(k,83) + b(k,302) = b(k,302) - lu(k,223) * b(k,83) + b(k,309) = b(k,309) - lu(k,224) * b(k,83) + b(k,85) = b(k,85) - lu(k,228) * b(k,84) + b(k,126) = b(k,126) - lu(k,229) * b(k,84) + b(k,181) = b(k,181) - lu(k,230) * b(k,84) + b(k,264) = b(k,264) - lu(k,231) * b(k,84) + b(k,302) = b(k,302) - lu(k,232) * b(k,84) + b(k,309) = b(k,309) - lu(k,233) * b(k,84) + b(k,310) = b(k,310) - lu(k,234) * b(k,84) + b(k,136) = b(k,136) - lu(k,236) * b(k,85) + b(k,140) = b(k,140) - lu(k,237) * b(k,85) + b(k,309) = b(k,309) - lu(k,238) * b(k,85) + b(k,310) = b(k,310) - lu(k,239) * b(k,85) + b(k,274) = b(k,274) - lu(k,241) * b(k,86) + b(k,311) = b(k,311) - lu(k,242) * b(k,86) + b(k,142) = b(k,142) - lu(k,244) * b(k,87) + b(k,310) = b(k,310) - lu(k,245) * b(k,87) + b(k,89) = b(k,89) - lu(k,247) * b(k,88) + b(k,292) = b(k,292) - lu(k,248) * b(k,88) + b(k,310) = b(k,310) - lu(k,249) * b(k,88) + b(k,311) = b(k,311) - lu(k,250) * b(k,88) + b(k,217) = b(k,217) - lu(k,252) * b(k,89) + b(k,292) = b(k,292) - lu(k,253) * b(k,89) + b(k,311) = b(k,311) - lu(k,254) * b(k,89) + b(k,91) = b(k,91) - lu(k,256) * b(k,90) + b(k,292) = b(k,292) - lu(k,257) * b(k,90) + b(k,310) = b(k,310) - lu(k,258) * b(k,90) + b(k,311) = b(k,311) - lu(k,259) * b(k,90) + b(k,217) = b(k,217) - lu(k,261) * b(k,91) + b(k,292) = b(k,292) - lu(k,262) * b(k,91) + b(k,260) = b(k,260) - lu(k,264) * b(k,92) + b(k,266) = b(k,266) - lu(k,265) * b(k,92) + b(k,255) = b(k,255) - lu(k,267) * b(k,93) + b(k,266) = b(k,266) - lu(k,268) * b(k,93) + b(k,259) = b(k,259) - lu(k,270) * b(k,94) + b(k,267) = b(k,267) - lu(k,271) * b(k,94) + b(k,257) = b(k,257) - lu(k,273) * b(k,95) + b(k,267) = b(k,267) - lu(k,274) * b(k,95) + b(k,214) = b(k,214) - lu(k,277) * b(k,96) + b(k,308) = b(k,308) - lu(k,278) * b(k,96) + b(k,315) = b(k,315) - lu(k,279) * b(k,96) + b(k,228) = b(k,228) - lu(k,281) * b(k,97) + b(k,309) = b(k,309) - lu(k,282) * b(k,97) + b(k,310) = b(k,310) - lu(k,283) * b(k,97) + b(k,136) = b(k,136) - lu(k,285) * b(k,98) + b(k,162) = b(k,162) - lu(k,286) * b(k,98) + b(k,310) = b(k,310) - lu(k,287) * b(k,98) + b(k,252) = b(k,252) - lu(k,289) * b(k,99) + b(k,307) = b(k,307) - lu(k,290) * b(k,99) + b(k,309) = b(k,309) - lu(k,291) * b(k,99) + b(k,305) = b(k,305) - lu(k,293) * b(k,100) + b(k,306) = b(k,306) - lu(k,294) * b(k,100) + b(k,308) = b(k,308) - lu(k,295) * b(k,100) + b(k,312) = b(k,312) - lu(k,296) * b(k,100) + b(k,314) = b(k,314) - lu(k,297) * b(k,100) + b(k,182) = b(k,182) - lu(k,299) * b(k,101) + b(k,309) = b(k,309) - lu(k,300) * b(k,101) + b(k,217) = b(k,217) - lu(k,303) * b(k,102) + b(k,292) = b(k,292) - lu(k,304) * b(k,102) + b(k,310) = b(k,310) - lu(k,305) * b(k,102) + b(k,311) = b(k,311) - lu(k,306) * b(k,102) + b(k,315) = b(k,315) - lu(k,307) * b(k,102) + b(k,224) = b(k,224) - lu(k,309) * b(k,103) + b(k,233) = b(k,233) - lu(k,310) * b(k,103) + b(k,264) = b(k,264) - lu(k,311) * b(k,103) + b(k,309) = b(k,309) - lu(k,312) * b(k,103) + b(k,310) = b(k,310) - lu(k,313) * b(k,103) + b(k,223) = b(k,223) - lu(k,315) * b(k,104) + b(k,304) = b(k,304) - lu(k,316) * b(k,104) + b(k,310) = b(k,310) - lu(k,317) * b(k,104) + b(k,311) = b(k,311) - lu(k,318) * b(k,104) + b(k,315) = b(k,315) - lu(k,319) * b(k,104) + b(k,214) = b(k,214) - lu(k,321) * b(k,105) + b(k,306) = b(k,306) - lu(k,322) * b(k,105) + b(k,309) = b(k,309) - lu(k,323) * b(k,105) + b(k,310) = b(k,310) - lu(k,324) * b(k,105) + b(k,312) = b(k,312) - lu(k,325) * b(k,105) + b(k,217) = b(k,217) - lu(k,327) * b(k,106) + b(k,290) = b(k,290) - lu(k,328) * b(k,106) + b(k,165) = b(k,165) - lu(k,330) * b(k,107) + b(k,228) = b(k,228) - lu(k,331) * b(k,107) + b(k,302) = b(k,302) - lu(k,332) * b(k,107) + b(k,310) = b(k,310) - lu(k,333) * b(k,107) + b(k,263) = b(k,263) - lu(k,335) * b(k,108) + b(k,264) = b(k,264) - lu(k,336) * b(k,108) + b(k,302) = b(k,302) - lu(k,337) * b(k,108) + b(k,309) = b(k,309) - lu(k,338) * b(k,108) + b(k,214) = b(k,214) - lu(k,340) * b(k,109) + b(k,244) = b(k,244) - lu(k,341) * b(k,109) + b(k,291) = b(k,291) - lu(k,342) * b(k,109) + b(k,308) = b(k,308) - lu(k,343) * b(k,109) + b(k,128) = b(k,128) - lu(k,345) * b(k,110) + b(k,233) = b(k,233) - lu(k,346) * b(k,110) + b(k,309) = b(k,309) - lu(k,347) * b(k,110) + b(k,310) = b(k,310) - lu(k,348) * b(k,110) + b(k,126) = b(k,126) - lu(k,351) * b(k,111) + b(k,142) = b(k,142) - lu(k,352) * b(k,111) + b(k,309) = b(k,309) - lu(k,353) * b(k,111) + b(k,310) = b(k,310) - lu(k,354) * b(k,111) + b(k,223) = b(k,223) - lu(k,356) * b(k,112) + b(k,228) = b(k,228) - lu(k,357) * b(k,112) + b(k,309) = b(k,309) - lu(k,358) * b(k,112) + b(k,310) = b(k,310) - lu(k,359) * b(k,112) + b(k,245) = b(k,245) - lu(k,361) * b(k,113) + b(k,297) = b(k,297) - lu(k,362) * b(k,113) + b(k,301) = b(k,301) - lu(k,363) * b(k,113) + b(k,310) = b(k,310) - lu(k,364) * b(k,113) + b(k,245) = b(k,245) - lu(k,366) * b(k,114) + b(k,296) = b(k,296) - lu(k,367) * b(k,114) + b(k,299) = b(k,299) - lu(k,368) * b(k,114) + b(k,310) = b(k,310) - lu(k,369) * b(k,114) + b(k,158) = b(k,158) - lu(k,371) * b(k,115) + b(k,309) = b(k,309) - lu(k,372) * b(k,115) + b(k,310) = b(k,310) - lu(k,373) * b(k,115) + b(k,150) = b(k,150) - lu(k,375) * b(k,116) + b(k,228) = b(k,228) - lu(k,376) * b(k,116) + b(k,278) = b(k,278) - lu(k,377) * b(k,116) + b(k,307) = b(k,307) - lu(k,378) * b(k,116) + b(k,310) = b(k,310) - lu(k,379) * b(k,116) + b(k,312) = b(k,312) - lu(k,380) * b(k,116) + b(k,314) = b(k,314) - lu(k,381) * b(k,116) end do end subroutine lu_slv01 subroutine lu_slv02( avec_len, lu, b ) @@ -243,214 +243,212 @@ subroutine lu_slv02( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,271) = b(k,271) - lu(k,371) * b(k,104) - b(k,278) = b(k,278) - lu(k,372) * b(k,104) - b(k,279) = b(k,279) - lu(k,373) * b(k,104) - b(k,282) = b(k,282) - lu(k,374) * b(k,104) - b(k,286) = b(k,286) - lu(k,375) * b(k,104) - b(k,193) = b(k,193) - lu(k,378) * b(k,105) - b(k,272) = b(k,272) - lu(k,379) * b(k,105) - b(k,276) = b(k,276) - lu(k,380) * b(k,105) - b(k,281) = b(k,281) - lu(k,381) * b(k,105) - b(k,282) = b(k,282) - lu(k,382) * b(k,105) - b(k,152) = b(k,152) - lu(k,384) * b(k,106) - b(k,276) = b(k,276) - lu(k,385) * b(k,106) - b(k,169) = b(k,169) - lu(k,387) * b(k,107) - b(k,261) = b(k,261) - lu(k,388) * b(k,107) - b(k,276) = b(k,276) - lu(k,389) * b(k,107) - b(k,282) = b(k,282) - lu(k,390) * b(k,107) - b(k,220) = b(k,220) - lu(k,392) * b(k,108) - b(k,223) = b(k,223) - lu(k,393) * b(k,108) - b(k,228) = b(k,228) - lu(k,394) * b(k,108) - b(k,274) = b(k,274) - lu(k,395) * b(k,108) - b(k,281) = b(k,281) - lu(k,396) * b(k,108) - b(k,282) = b(k,282) - lu(k,397) * b(k,108) - b(k,269) = b(k,269) - lu(k,399) * b(k,109) - b(k,274) = b(k,274) - lu(k,400) * b(k,109) - b(k,278) = b(k,278) - lu(k,401) * b(k,109) - b(k,279) = b(k,279) - lu(k,402) * b(k,109) - b(k,281) = b(k,281) - lu(k,403) * b(k,109) - b(k,282) = b(k,282) - lu(k,404) * b(k,109) - b(k,137) = b(k,137) - lu(k,406) * b(k,110) - b(k,273) = b(k,273) - lu(k,407) * b(k,110) - b(k,281) = b(k,281) - lu(k,408) * b(k,110) - b(k,187) = b(k,187) - lu(k,410) * b(k,111) - b(k,198) = b(k,198) - lu(k,411) * b(k,111) - b(k,219) = b(k,219) - lu(k,412) * b(k,111) - b(k,240) = b(k,240) - lu(k,413) * b(k,111) - b(k,270) = b(k,270) - lu(k,414) * b(k,111) - b(k,276) = b(k,276) - lu(k,415) * b(k,111) - b(k,278) = b(k,278) - lu(k,416) * b(k,111) - b(k,281) = b(k,281) - lu(k,417) * b(k,111) - b(k,282) = b(k,282) - lu(k,418) * b(k,111) - b(k,198) = b(k,198) - lu(k,420) * b(k,112) - b(k,210) = b(k,210) - lu(k,421) * b(k,112) - b(k,223) = b(k,223) - lu(k,422) * b(k,112) - b(k,241) = b(k,241) - lu(k,423) * b(k,112) - b(k,276) = b(k,276) - lu(k,424) * b(k,112) - b(k,282) = b(k,282) - lu(k,425) * b(k,112) - b(k,198) = b(k,198) - lu(k,427) * b(k,113) - b(k,205) = b(k,205) - lu(k,428) * b(k,113) - b(k,223) = b(k,223) - lu(k,429) * b(k,113) - b(k,236) = b(k,236) - lu(k,430) * b(k,113) - b(k,276) = b(k,276) - lu(k,431) * b(k,113) - b(k,282) = b(k,282) - lu(k,432) * b(k,113) - b(k,152) = b(k,152) - lu(k,436) * b(k,114) - b(k,193) = b(k,193) - lu(k,437) * b(k,114) - b(k,272) = b(k,272) - lu(k,438) * b(k,114) - b(k,276) = b(k,276) - lu(k,439) * b(k,114) - b(k,281) = b(k,281) - lu(k,440) * b(k,114) - b(k,282) = b(k,282) - lu(k,441) * b(k,114) - b(k,193) = b(k,193) - lu(k,444) * b(k,115) - b(k,240) = b(k,240) - lu(k,445) * b(k,115) - b(k,272) = b(k,272) - lu(k,446) * b(k,115) - b(k,276) = b(k,276) - lu(k,447) * b(k,115) - b(k,281) = b(k,281) - lu(k,448) * b(k,115) - b(k,282) = b(k,282) - lu(k,449) * b(k,115) - b(k,142) = b(k,142) - lu(k,451) * b(k,116) - b(k,199) = b(k,199) - lu(k,452) * b(k,116) - b(k,269) = b(k,269) - lu(k,453) * b(k,116) - b(k,282) = b(k,282) - lu(k,454) * b(k,116) - b(k,221) = b(k,221) - lu(k,456) * b(k,117) - b(k,271) = b(k,271) - lu(k,457) * b(k,117) - b(k,273) = b(k,273) - lu(k,458) * b(k,117) - b(k,280) = b(k,280) - lu(k,459) * b(k,117) - b(k,282) = b(k,282) - lu(k,460) * b(k,117) - b(k,137) = b(k,137) - lu(k,463) * b(k,118) - b(k,272) = b(k,272) - lu(k,464) * b(k,118) - b(k,276) = b(k,276) - lu(k,465) * b(k,118) - b(k,281) = b(k,281) - lu(k,466) * b(k,118) - b(k,282) = b(k,282) - lu(k,467) * b(k,118) - b(k,269) = b(k,269) - lu(k,469) * b(k,119) - b(k,278) = b(k,278) - lu(k,470) * b(k,119) - b(k,279) = b(k,279) - lu(k,471) * b(k,119) - b(k,282) = b(k,282) - lu(k,472) * b(k,119) - b(k,286) = b(k,286) - lu(k,473) * b(k,119) - b(k,157) = b(k,157) - lu(k,475) * b(k,120) - b(k,174) = b(k,174) - lu(k,476) * b(k,120) - b(k,236) = b(k,236) - lu(k,477) * b(k,120) - b(k,276) = b(k,276) - lu(k,478) * b(k,120) - b(k,278) = b(k,278) - lu(k,479) * b(k,120) - b(k,281) = b(k,281) - lu(k,480) * b(k,120) - b(k,282) = b(k,282) - lu(k,481) * b(k,120) - b(k,160) = b(k,160) - lu(k,483) * b(k,121) - b(k,203) = b(k,203) - lu(k,484) * b(k,121) - b(k,228) = b(k,228) - lu(k,485) * b(k,121) - b(k,276) = b(k,276) - lu(k,486) * b(k,121) - b(k,278) = b(k,278) - lu(k,487) * b(k,121) - b(k,282) = b(k,282) - lu(k,488) * b(k,121) - b(k,286) = b(k,286) - lu(k,489) * b(k,121) - b(k,168) = b(k,168) - lu(k,491) * b(k,122) - b(k,233) = b(k,233) - lu(k,492) * b(k,122) - b(k,270) = b(k,270) - lu(k,493) * b(k,122) - b(k,274) = b(k,274) - lu(k,494) * b(k,122) - b(k,280) = b(k,280) - lu(k,495) * b(k,122) - b(k,281) = b(k,281) - lu(k,496) * b(k,122) - b(k,284) = b(k,284) - lu(k,497) * b(k,122) - b(k,151) = b(k,151) - lu(k,499) * b(k,123) - b(k,187) = b(k,187) - lu(k,500) * b(k,123) - b(k,223) = b(k,223) - lu(k,501) * b(k,123) - b(k,273) = b(k,273) - lu(k,502) * b(k,123) - b(k,276) = b(k,276) - lu(k,503) * b(k,123) - b(k,278) = b(k,278) - lu(k,504) * b(k,123) - b(k,282) = b(k,282) - lu(k,505) * b(k,123) - b(k,223) = b(k,223) - lu(k,507) * b(k,124) - b(k,251) = b(k,251) - lu(k,508) * b(k,124) - b(k,266) = b(k,266) - lu(k,509) * b(k,124) - b(k,276) = b(k,276) - lu(k,510) * b(k,124) - b(k,278) = b(k,278) - lu(k,511) * b(k,124) - b(k,281) = b(k,281) - lu(k,512) * b(k,124) - b(k,282) = b(k,282) - lu(k,513) * b(k,124) - b(k,223) = b(k,223) - lu(k,515) * b(k,125) - b(k,267) = b(k,267) - lu(k,516) * b(k,125) - b(k,269) = b(k,269) - lu(k,517) * b(k,125) - b(k,276) = b(k,276) - lu(k,518) * b(k,125) - b(k,278) = b(k,278) - lu(k,519) * b(k,125) - b(k,281) = b(k,281) - lu(k,520) * b(k,125) - b(k,282) = b(k,282) - lu(k,521) * b(k,125) - b(k,263) = b(k,263) - lu(k,523) * b(k,126) - b(k,268) = b(k,268) - lu(k,524) * b(k,126) - b(k,282) = b(k,282) - lu(k,525) * b(k,126) - b(k,231) = b(k,231) - lu(k,527) * b(k,127) - b(k,276) = b(k,276) - lu(k,528) * b(k,127) - b(k,282) = b(k,282) - lu(k,529) * b(k,127) - b(k,279) = b(k,279) - lu(k,531) * b(k,128) - b(k,282) = b(k,282) - lu(k,532) * b(k,128) - b(k,286) = b(k,286) - lu(k,533) * b(k,128) - b(k,165) = b(k,165) - lu(k,535) * b(k,129) - b(k,203) = b(k,203) - lu(k,536) * b(k,129) - b(k,251) = b(k,251) - lu(k,537) * b(k,129) - b(k,272) = b(k,272) - lu(k,538) * b(k,129) - b(k,276) = b(k,276) - lu(k,539) * b(k,129) - b(k,278) = b(k,278) - lu(k,540) * b(k,129) - b(k,281) = b(k,281) - lu(k,541) * b(k,129) - b(k,132) = b(k,132) - lu(k,543) * b(k,130) - b(k,187) = b(k,187) - lu(k,544) * b(k,130) - b(k,198) = b(k,198) - lu(k,545) * b(k,130) - b(k,211) = b(k,211) - lu(k,546) * b(k,130) - b(k,223) = b(k,223) - lu(k,547) * b(k,130) - b(k,240) = b(k,240) - lu(k,548) * b(k,130) - b(k,241) = b(k,241) - lu(k,549) * b(k,130) - b(k,269) = b(k,269) - lu(k,550) * b(k,130) - b(k,276) = b(k,276) - lu(k,551) * b(k,130) - b(k,279) = b(k,279) - lu(k,552) * b(k,130) - b(k,282) = b(k,282) - lu(k,553) * b(k,130) - b(k,132) = b(k,132) - lu(k,555) * b(k,131) - b(k,158) = b(k,158) - lu(k,556) * b(k,131) - b(k,198) = b(k,198) - lu(k,557) * b(k,131) - b(k,212) = b(k,212) - lu(k,558) * b(k,131) - b(k,223) = b(k,223) - lu(k,559) * b(k,131) - b(k,236) = b(k,236) - lu(k,560) * b(k,131) - b(k,240) = b(k,240) - lu(k,561) * b(k,131) - b(k,269) = b(k,269) - lu(k,562) * b(k,131) - b(k,276) = b(k,276) - lu(k,563) * b(k,131) - b(k,279) = b(k,279) - lu(k,564) * b(k,131) - b(k,282) = b(k,282) - lu(k,565) * b(k,131) - b(k,158) = b(k,158) - lu(k,567) * b(k,132) - b(k,223) = b(k,223) - lu(k,568) * b(k,132) - b(k,240) = b(k,240) - lu(k,569) * b(k,132) - b(k,276) = b(k,276) - lu(k,570) * b(k,132) - b(k,278) = b(k,278) - lu(k,571) * b(k,132) - b(k,282) = b(k,282) - lu(k,572) * b(k,132) - b(k,157) = b(k,157) - lu(k,574) * b(k,133) - b(k,183) = b(k,183) - lu(k,575) * b(k,133) - b(k,241) = b(k,241) - lu(k,576) * b(k,133) - b(k,270) = b(k,270) - lu(k,577) * b(k,133) - b(k,276) = b(k,276) - lu(k,578) * b(k,133) - b(k,278) = b(k,278) - lu(k,579) * b(k,133) - b(k,281) = b(k,281) - lu(k,580) * b(k,133) - b(k,282) = b(k,282) - lu(k,581) * b(k,133) - b(k,189) = b(k,189) - lu(k,583) * b(k,134) - b(k,226) = b(k,226) - lu(k,584) * b(k,134) - b(k,262) = b(k,262) - lu(k,585) * b(k,134) - b(k,276) = b(k,276) - lu(k,586) * b(k,134) - b(k,281) = b(k,281) - lu(k,587) * b(k,134) - b(k,282) = b(k,282) - lu(k,588) * b(k,134) - b(k,254) = b(k,254) - lu(k,590) * b(k,135) - b(k,276) = b(k,276) - lu(k,591) * b(k,135) - b(k,282) = b(k,282) - lu(k,592) * b(k,135) - b(k,186) = b(k,186) - lu(k,594) * b(k,136) - b(k,187) = b(k,187) - lu(k,595) * b(k,136) - b(k,272) = b(k,272) - lu(k,596) * b(k,136) - b(k,276) = b(k,276) - lu(k,597) * b(k,136) - b(k,278) = b(k,278) - lu(k,598) * b(k,136) - b(k,281) = b(k,281) - lu(k,599) * b(k,136) - b(k,282) = b(k,282) - lu(k,600) * b(k,136) - b(k,286) = b(k,286) - lu(k,601) * b(k,136) - b(k,272) = b(k,272) - lu(k,605) * b(k,137) - b(k,273) = b(k,273) - lu(k,606) * b(k,137) - b(k,276) = b(k,276) - lu(k,607) * b(k,137) - b(k,281) = b(k,281) - lu(k,608) * b(k,137) - b(k,282) = b(k,282) - lu(k,609) * b(k,137) - b(k,152) = b(k,152) - lu(k,614) * b(k,138) - b(k,153) = b(k,153) - lu(k,615) * b(k,138) - b(k,155) = b(k,155) - lu(k,616) * b(k,138) - b(k,159) = b(k,159) - lu(k,617) * b(k,138) - b(k,193) = b(k,193) - lu(k,618) * b(k,138) - b(k,223) = b(k,223) - lu(k,619) * b(k,138) - b(k,240) = b(k,240) - lu(k,620) * b(k,138) - b(k,276) = b(k,276) - lu(k,621) * b(k,138) - b(k,282) = b(k,282) - lu(k,622) * b(k,138) + b(k,141) = b(k,141) - lu(k,383) * b(k,117) + b(k,214) = b(k,214) - lu(k,384) * b(k,117) + b(k,244) = b(k,244) - lu(k,385) * b(k,117) + b(k,264) = b(k,264) - lu(k,386) * b(k,117) + b(k,290) = b(k,290) - lu(k,387) * b(k,117) + b(k,308) = b(k,308) - lu(k,388) * b(k,117) + b(k,310) = b(k,310) - lu(k,389) * b(k,117) + b(k,264) = b(k,264) - lu(k,391) * b(k,118) + b(k,304) = b(k,304) - lu(k,392) * b(k,118) + b(k,309) = b(k,309) - lu(k,393) * b(k,118) + b(k,310) = b(k,310) - lu(k,394) * b(k,118) + b(k,311) = b(k,311) - lu(k,395) * b(k,118) + b(k,313) = b(k,313) - lu(k,396) * b(k,118) + b(k,315) = b(k,315) - lu(k,397) * b(k,118) + b(k,185) = b(k,185) - lu(k,399) * b(k,119) + b(k,264) = b(k,264) - lu(k,400) * b(k,119) + b(k,309) = b(k,309) - lu(k,401) * b(k,119) + b(k,222) = b(k,222) - lu(k,403) * b(k,120) + b(k,302) = b(k,302) - lu(k,404) * b(k,120) + b(k,307) = b(k,307) - lu(k,405) * b(k,120) + b(k,310) = b(k,310) - lu(k,406) * b(k,120) + b(k,315) = b(k,315) - lu(k,407) * b(k,120) + b(k,197) = b(k,197) - lu(k,409) * b(k,121) + b(k,278) = b(k,278) - lu(k,410) * b(k,121) + b(k,309) = b(k,309) - lu(k,411) * b(k,121) + b(k,310) = b(k,310) - lu(k,412) * b(k,121) + b(k,315) = b(k,315) - lu(k,413) * b(k,121) + b(k,130) = b(k,130) - lu(k,415) * b(k,122) + b(k,139) = b(k,139) - lu(k,416) * b(k,122) + b(k,233) = b(k,233) - lu(k,417) * b(k,122) + b(k,309) = b(k,309) - lu(k,418) * b(k,122) + b(k,310) = b(k,310) - lu(k,419) * b(k,122) + b(k,218) = b(k,218) - lu(k,421) * b(k,123) + b(k,264) = b(k,264) - lu(k,422) * b(k,123) + b(k,300) = b(k,300) - lu(k,423) * b(k,123) + b(k,310) = b(k,310) - lu(k,424) * b(k,123) + b(k,314) = b(k,314) - lu(k,425) * b(k,123) + b(k,140) = b(k,140) - lu(k,427) * b(k,124) + b(k,233) = b(k,233) - lu(k,428) * b(k,124) + b(k,263) = b(k,263) - lu(k,429) * b(k,124) + b(k,309) = b(k,309) - lu(k,430) * b(k,124) + b(k,310) = b(k,310) - lu(k,431) * b(k,124) + b(k,274) = b(k,274) - lu(k,433) * b(k,125) + b(k,292) = b(k,292) - lu(k,434) * b(k,125) + b(k,304) = b(k,304) - lu(k,435) * b(k,125) + b(k,310) = b(k,310) - lu(k,436) * b(k,125) + b(k,311) = b(k,311) - lu(k,437) * b(k,125) + b(k,142) = b(k,142) - lu(k,441) * b(k,126) + b(k,305) = b(k,305) - lu(k,442) * b(k,126) + b(k,309) = b(k,309) - lu(k,443) * b(k,126) + b(k,310) = b(k,310) - lu(k,444) * b(k,126) + b(k,314) = b(k,314) - lu(k,445) * b(k,126) + b(k,309) = b(k,309) - lu(k,447) * b(k,127) + b(k,310) = b(k,310) - lu(k,448) * b(k,127) + b(k,312) = b(k,312) - lu(k,449) * b(k,127) + b(k,314) = b(k,314) - lu(k,450) * b(k,127) + b(k,315) = b(k,315) - lu(k,451) * b(k,127) + b(k,233) = b(k,233) - lu(k,454) * b(k,128) + b(k,305) = b(k,305) - lu(k,455) * b(k,128) + b(k,309) = b(k,309) - lu(k,456) * b(k,128) + b(k,310) = b(k,310) - lu(k,457) * b(k,128) + b(k,314) = b(k,314) - lu(k,458) * b(k,128) + b(k,290) = b(k,290) - lu(k,460) * b(k,129) + b(k,307) = b(k,307) - lu(k,461) * b(k,129) + b(k,310) = b(k,310) - lu(k,462) * b(k,129) + b(k,313) = b(k,313) - lu(k,463) * b(k,129) + b(k,315) = b(k,315) - lu(k,464) * b(k,129) + b(k,179) = b(k,179) - lu(k,466) * b(k,130) + b(k,309) = b(k,309) - lu(k,467) * b(k,130) + b(k,194) = b(k,194) - lu(k,469) * b(k,131) + b(k,281) = b(k,281) - lu(k,470) * b(k,131) + b(k,309) = b(k,309) - lu(k,471) * b(k,131) + b(k,310) = b(k,310) - lu(k,472) * b(k,131) + b(k,290) = b(k,290) - lu(k,475) * b(k,132) + b(k,292) = b(k,292) - lu(k,476) * b(k,132) + b(k,305) = b(k,305) - lu(k,477) * b(k,132) + b(k,308) = b(k,308) - lu(k,478) * b(k,132) + b(k,310) = b(k,310) - lu(k,479) * b(k,132) + b(k,314) = b(k,314) - lu(k,480) * b(k,132) + b(k,184) = b(k,184) - lu(k,482) * b(k,133) + b(k,237) = b(k,237) - lu(k,483) * b(k,133) + b(k,264) = b(k,264) - lu(k,484) * b(k,133) + b(k,269) = b(k,269) - lu(k,485) * b(k,133) + b(k,309) = b(k,309) - lu(k,486) * b(k,133) + b(k,310) = b(k,310) - lu(k,487) * b(k,133) + b(k,184) = b(k,184) - lu(k,489) * b(k,134) + b(k,224) = b(k,224) - lu(k,490) * b(k,134) + b(k,247) = b(k,247) - lu(k,491) * b(k,134) + b(k,263) = b(k,263) - lu(k,492) * b(k,134) + b(k,306) = b(k,306) - lu(k,493) * b(k,134) + b(k,307) = b(k,307) - lu(k,494) * b(k,134) + b(k,309) = b(k,309) - lu(k,495) * b(k,134) + b(k,310) = b(k,310) - lu(k,496) * b(k,134) + b(k,314) = b(k,314) - lu(k,497) * b(k,134) + b(k,184) = b(k,184) - lu(k,499) * b(k,135) + b(k,231) = b(k,231) - lu(k,500) * b(k,135) + b(k,264) = b(k,264) - lu(k,501) * b(k,135) + b(k,268) = b(k,268) - lu(k,502) * b(k,135) + b(k,309) = b(k,309) - lu(k,503) * b(k,135) + b(k,310) = b(k,310) - lu(k,504) * b(k,135) + b(k,162) = b(k,162) - lu(k,506) * b(k,136) + b(k,303) = b(k,303) - lu(k,507) * b(k,136) + b(k,314) = b(k,314) - lu(k,508) * b(k,136) + b(k,274) = b(k,274) - lu(k,510) * b(k,137) + b(k,292) = b(k,292) - lu(k,511) * b(k,137) + b(k,304) = b(k,304) - lu(k,512) * b(k,137) + b(k,310) = b(k,310) - lu(k,513) * b(k,137) + b(k,311) = b(k,311) - lu(k,514) * b(k,137) + b(k,315) = b(k,315) - lu(k,515) * b(k,137) + b(k,246) = b(k,246) - lu(k,517) * b(k,138) + b(k,256) = b(k,256) - lu(k,518) * b(k,138) + b(k,264) = b(k,264) - lu(k,519) * b(k,138) + b(k,310) = b(k,310) - lu(k,520) * b(k,138) + b(k,312) = b(k,312) - lu(k,521) * b(k,138) + b(k,314) = b(k,314) - lu(k,522) * b(k,138) + b(k,179) = b(k,179) - lu(k,526) * b(k,139) + b(k,233) = b(k,233) - lu(k,527) * b(k,139) + b(k,305) = b(k,305) - lu(k,528) * b(k,139) + b(k,309) = b(k,309) - lu(k,529) * b(k,139) + b(k,310) = b(k,310) - lu(k,530) * b(k,139) + b(k,314) = b(k,314) - lu(k,531) * b(k,139) + b(k,233) = b(k,233) - lu(k,534) * b(k,140) + b(k,263) = b(k,263) - lu(k,535) * b(k,140) + b(k,305) = b(k,305) - lu(k,536) * b(k,140) + b(k,309) = b(k,309) - lu(k,537) * b(k,140) + b(k,310) = b(k,310) - lu(k,538) * b(k,140) + b(k,314) = b(k,314) - lu(k,539) * b(k,140) + b(k,244) = b(k,244) - lu(k,541) * b(k,141) + b(k,290) = b(k,290) - lu(k,542) * b(k,141) + b(k,303) = b(k,303) - lu(k,543) * b(k,141) + b(k,308) = b(k,308) - lu(k,544) * b(k,141) + b(k,310) = b(k,310) - lu(k,545) * b(k,141) + b(k,162) = b(k,162) - lu(k,548) * b(k,142) + b(k,305) = b(k,305) - lu(k,549) * b(k,142) + b(k,309) = b(k,309) - lu(k,550) * b(k,142) + b(k,310) = b(k,310) - lu(k,551) * b(k,142) + b(k,314) = b(k,314) - lu(k,552) * b(k,142) + b(k,165) = b(k,165) - lu(k,554) * b(k,143) + b(k,223) = b(k,223) - lu(k,555) * b(k,143) + b(k,302) = b(k,302) - lu(k,556) * b(k,143) + b(k,310) = b(k,310) - lu(k,557) * b(k,143) + b(k,198) = b(k,198) - lu(k,559) * b(k,144) + b(k,239) = b(k,239) - lu(k,560) * b(k,144) + b(k,268) = b(k,268) - lu(k,561) * b(k,144) + b(k,307) = b(k,307) - lu(k,562) * b(k,144) + b(k,309) = b(k,309) - lu(k,563) * b(k,144) + b(k,310) = b(k,310) - lu(k,564) * b(k,144) + b(k,314) = b(k,314) - lu(k,565) * b(k,144) + b(k,245) = b(k,245) - lu(k,567) * b(k,145) + b(k,302) = b(k,302) - lu(k,568) * b(k,145) + b(k,307) = b(k,307) - lu(k,569) * b(k,145) + b(k,310) = b(k,310) - lu(k,570) * b(k,145) + b(k,312) = b(k,312) - lu(k,571) * b(k,145) + b(k,313) = b(k,313) - lu(k,572) * b(k,145) + b(k,314) = b(k,314) - lu(k,573) * b(k,145) + b(k,193) = b(k,193) - lu(k,575) * b(k,146) + b(k,274) = b(k,274) - lu(k,576) * b(k,146) + b(k,289) = b(k,289) - lu(k,577) * b(k,146) + b(k,306) = b(k,306) - lu(k,578) * b(k,146) + b(k,308) = b(k,308) - lu(k,579) * b(k,146) + b(k,312) = b(k,312) - lu(k,580) * b(k,146) + b(k,314) = b(k,314) - lu(k,581) * b(k,146) + b(k,186) = b(k,186) - lu(k,583) * b(k,147) + b(k,228) = b(k,228) - lu(k,584) * b(k,147) + b(k,256) = b(k,256) - lu(k,585) * b(k,147) + b(k,307) = b(k,307) - lu(k,586) * b(k,147) + b(k,309) = b(k,309) - lu(k,587) * b(k,147) + b(k,310) = b(k,310) - lu(k,588) * b(k,147) + b(k,315) = b(k,315) - lu(k,589) * b(k,147) + b(k,178) = b(k,178) - lu(k,591) * b(k,148) + b(k,224) = b(k,224) - lu(k,592) * b(k,148) + b(k,264) = b(k,264) - lu(k,593) * b(k,148) + b(k,303) = b(k,303) - lu(k,594) * b(k,148) + b(k,307) = b(k,307) - lu(k,595) * b(k,148) + b(k,309) = b(k,309) - lu(k,596) * b(k,148) + b(k,310) = b(k,310) - lu(k,597) * b(k,148) + b(k,253) = b(k,253) - lu(k,599) * b(k,149) + b(k,309) = b(k,309) - lu(k,600) * b(k,149) + b(k,310) = b(k,310) - lu(k,601) * b(k,149) + b(k,191) = b(k,191) - lu(k,603) * b(k,150) + b(k,228) = b(k,228) - lu(k,604) * b(k,150) + b(k,278) = b(k,278) - lu(k,605) * b(k,150) + b(k,305) = b(k,305) - lu(k,606) * b(k,150) + b(k,307) = b(k,307) - lu(k,607) * b(k,150) + b(k,309) = b(k,309) - lu(k,608) * b(k,150) + b(k,314) = b(k,314) - lu(k,609) * b(k,150) + b(k,208) = b(k,208) - lu(k,611) * b(k,151) + b(k,239) = b(k,239) - lu(k,612) * b(k,151) + b(k,269) = b(k,269) - lu(k,613) * b(k,151) + b(k,306) = b(k,306) - lu(k,614) * b(k,151) + b(k,307) = b(k,307) - lu(k,615) * b(k,151) + b(k,309) = b(k,309) - lu(k,616) * b(k,151) + b(k,310) = b(k,310) - lu(k,617) * b(k,151) + b(k,314) = b(k,314) - lu(k,618) * b(k,151) + b(k,153) = b(k,153) - lu(k,620) * b(k,152) + b(k,184) = b(k,184) - lu(k,621) * b(k,152) + b(k,224) = b(k,224) - lu(k,622) * b(k,152) + b(k,238) = b(k,238) - lu(k,623) * b(k,152) + b(k,245) = b(k,245) - lu(k,624) * b(k,152) + b(k,263) = b(k,263) - lu(k,625) * b(k,152) + b(k,264) = b(k,264) - lu(k,626) * b(k,152) + b(k,269) = b(k,269) - lu(k,627) * b(k,152) + b(k,302) = b(k,302) - lu(k,628) * b(k,152) + b(k,309) = b(k,309) - lu(k,629) * b(k,152) + b(k,310) = b(k,310) - lu(k,630) * b(k,152) + b(k,313) = b(k,313) - lu(k,631) * b(k,152) end do end subroutine lu_slv02 subroutine lu_slv03( avec_len, lu, b ) @@ -471,212 +469,216 @@ subroutine lu_slv03( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,184) = b(k,184) - lu(k,624) * b(k,139) - b(k,204) = b(k,204) - lu(k,625) * b(k,139) - b(k,236) = b(k,236) - lu(k,626) * b(k,139) - b(k,241) = b(k,241) - lu(k,627) * b(k,139) - b(k,245) = b(k,245) - lu(k,628) * b(k,139) - b(k,276) = b(k,276) - lu(k,629) * b(k,139) - b(k,278) = b(k,278) - lu(k,630) * b(k,139) - b(k,281) = b(k,281) - lu(k,631) * b(k,139) - b(k,282) = b(k,282) - lu(k,632) * b(k,139) - b(k,142) = b(k,142) - lu(k,635) * b(k,140) - b(k,199) = b(k,199) - lu(k,636) * b(k,140) - b(k,203) = b(k,203) - lu(k,637) * b(k,140) - b(k,251) = b(k,251) - lu(k,638) * b(k,140) - b(k,269) = b(k,269) - lu(k,639) * b(k,140) - b(k,276) = b(k,276) - lu(k,640) * b(k,140) - b(k,278) = b(k,278) - lu(k,641) * b(k,140) - b(k,281) = b(k,281) - lu(k,642) * b(k,140) - b(k,282) = b(k,282) - lu(k,643) * b(k,140) - b(k,142) = b(k,142) - lu(k,646) * b(k,141) - b(k,188) = b(k,188) - lu(k,647) * b(k,141) - b(k,199) = b(k,199) - lu(k,648) * b(k,141) - b(k,203) = b(k,203) - lu(k,649) * b(k,141) - b(k,251) = b(k,251) - lu(k,650) * b(k,141) - b(k,269) = b(k,269) - lu(k,651) * b(k,141) - b(k,276) = b(k,276) - lu(k,652) * b(k,141) - b(k,278) = b(k,278) - lu(k,653) * b(k,141) - b(k,282) = b(k,282) - lu(k,654) * b(k,141) - b(k,203) = b(k,203) - lu(k,657) * b(k,142) - b(k,269) = b(k,269) - lu(k,658) * b(k,142) - b(k,272) = b(k,272) - lu(k,659) * b(k,142) - b(k,276) = b(k,276) - lu(k,660) * b(k,142) - b(k,281) = b(k,281) - lu(k,661) * b(k,142) - b(k,282) = b(k,282) - lu(k,662) * b(k,142) - b(k,193) = b(k,193) - lu(k,664) * b(k,143) - b(k,218) = b(k,218) - lu(k,665) * b(k,143) - b(k,223) = b(k,223) - lu(k,666) * b(k,143) - b(k,228) = b(k,228) - lu(k,667) * b(k,143) - b(k,240) = b(k,240) - lu(k,668) * b(k,143) - b(k,276) = b(k,276) - lu(k,669) * b(k,143) - b(k,282) = b(k,282) - lu(k,670) * b(k,143) - b(k,170) = b(k,170) - lu(k,672) * b(k,144) - b(k,227) = b(k,227) - lu(k,673) * b(k,144) - b(k,262) = b(k,262) - lu(k,674) * b(k,144) - b(k,270) = b(k,270) - lu(k,675) * b(k,144) - b(k,276) = b(k,276) - lu(k,676) * b(k,144) - b(k,281) = b(k,281) - lu(k,677) * b(k,144) - b(k,282) = b(k,282) - lu(k,678) * b(k,144) - b(k,164) = b(k,164) - lu(k,681) * b(k,145) - b(k,231) = b(k,231) - lu(k,682) * b(k,145) - b(k,272) = b(k,272) - lu(k,683) * b(k,145) - b(k,276) = b(k,276) - lu(k,684) * b(k,145) - b(k,278) = b(k,278) - lu(k,685) * b(k,145) - b(k,281) = b(k,281) - lu(k,686) * b(k,145) - b(k,282) = b(k,282) - lu(k,687) * b(k,145) - b(k,164) = b(k,164) - lu(k,689) * b(k,146) - b(k,190) = b(k,190) - lu(k,690) * b(k,146) - b(k,217) = b(k,217) - lu(k,691) * b(k,146) - b(k,272) = b(k,272) - lu(k,692) * b(k,146) - b(k,276) = b(k,276) - lu(k,693) * b(k,146) - b(k,281) = b(k,281) - lu(k,694) * b(k,146) - b(k,282) = b(k,282) - lu(k,695) * b(k,146) - b(k,164) = b(k,164) - lu(k,697) * b(k,147) - b(k,190) = b(k,190) - lu(k,698) * b(k,147) - b(k,213) = b(k,213) - lu(k,699) * b(k,147) - b(k,272) = b(k,272) - lu(k,700) * b(k,147) - b(k,276) = b(k,276) - lu(k,701) * b(k,147) - b(k,281) = b(k,281) - lu(k,702) * b(k,147) - b(k,282) = b(k,282) - lu(k,703) * b(k,147) - b(k,228) = b(k,228) - lu(k,711) * b(k,148) - b(k,251) = b(k,251) - lu(k,712) * b(k,148) - b(k,257) = b(k,257) - lu(k,713) * b(k,148) - b(k,260) = b(k,260) - lu(k,714) * b(k,148) - b(k,261) = b(k,261) - lu(k,715) * b(k,148) - b(k,273) = b(k,273) - lu(k,716) * b(k,148) - b(k,274) = b(k,274) - lu(k,717) * b(k,148) - b(k,276) = b(k,276) - lu(k,718) * b(k,148) - b(k,278) = b(k,278) - lu(k,719) * b(k,148) - b(k,282) = b(k,282) - lu(k,720) * b(k,148) - b(k,193) = b(k,193) - lu(k,722) * b(k,149) - b(k,223) = b(k,223) - lu(k,723) * b(k,149) - b(k,276) = b(k,276) - lu(k,724) * b(k,149) - b(k,278) = b(k,278) - lu(k,725) * b(k,149) - b(k,282) = b(k,282) - lu(k,726) * b(k,149) - b(k,152) = b(k,152) - lu(k,732) * b(k,150) - b(k,154) = b(k,154) - lu(k,733) * b(k,150) - b(k,155) = b(k,155) - lu(k,734) * b(k,150) - b(k,159) = b(k,159) - lu(k,735) * b(k,150) - b(k,193) = b(k,193) - lu(k,736) * b(k,150) - b(k,223) = b(k,223) - lu(k,737) * b(k,150) - b(k,240) = b(k,240) - lu(k,738) * b(k,150) - b(k,269) = b(k,269) - lu(k,739) * b(k,150) - b(k,276) = b(k,276) - lu(k,740) * b(k,150) - b(k,282) = b(k,282) - lu(k,741) * b(k,150) - b(k,218) = b(k,218) - lu(k,745) * b(k,151) - b(k,272) = b(k,272) - lu(k,746) * b(k,151) - b(k,276) = b(k,276) - lu(k,747) * b(k,151) - b(k,278) = b(k,278) - lu(k,748) * b(k,151) - b(k,281) = b(k,281) - lu(k,749) * b(k,151) - b(k,282) = b(k,282) - lu(k,750) * b(k,151) - b(k,193) = b(k,193) - lu(k,752) * b(k,152) - b(k,223) = b(k,223) - lu(k,753) * b(k,152) - b(k,272) = b(k,272) - lu(k,754) * b(k,152) - b(k,276) = b(k,276) - lu(k,755) * b(k,152) - b(k,281) = b(k,281) - lu(k,756) * b(k,152) - b(k,155) = b(k,155) - lu(k,763) * b(k,153) - b(k,159) = b(k,159) - lu(k,764) * b(k,153) - b(k,193) = b(k,193) - lu(k,765) * b(k,153) - b(k,223) = b(k,223) - lu(k,766) * b(k,153) - b(k,240) = b(k,240) - lu(k,767) * b(k,153) - b(k,272) = b(k,272) - lu(k,768) * b(k,153) - b(k,276) = b(k,276) - lu(k,769) * b(k,153) - b(k,281) = b(k,281) - lu(k,770) * b(k,153) - b(k,282) = b(k,282) - lu(k,771) * b(k,153) - b(k,155) = b(k,155) - lu(k,779) * b(k,154) - b(k,159) = b(k,159) - lu(k,780) * b(k,154) - b(k,193) = b(k,193) - lu(k,781) * b(k,154) - b(k,223) = b(k,223) - lu(k,782) * b(k,154) - b(k,240) = b(k,240) - lu(k,783) * b(k,154) - b(k,269) = b(k,269) - lu(k,784) * b(k,154) - b(k,272) = b(k,272) - lu(k,785) * b(k,154) - b(k,276) = b(k,276) - lu(k,786) * b(k,154) - b(k,281) = b(k,281) - lu(k,787) * b(k,154) - b(k,282) = b(k,282) - lu(k,788) * b(k,154) - b(k,223) = b(k,223) - lu(k,790) * b(k,155) - b(k,240) = b(k,240) - lu(k,791) * b(k,155) - b(k,272) = b(k,272) - lu(k,792) * b(k,155) - b(k,276) = b(k,276) - lu(k,793) * b(k,155) - b(k,279) = b(k,279) - lu(k,794) * b(k,155) - b(k,281) = b(k,281) - lu(k,795) * b(k,155) - b(k,282) = b(k,282) - lu(k,796) * b(k,155) - b(k,218) = b(k,218) - lu(k,798) * b(k,156) - b(k,228) = b(k,228) - lu(k,799) * b(k,156) - b(k,276) = b(k,276) - lu(k,800) * b(k,156) - b(k,282) = b(k,282) - lu(k,801) * b(k,156) - b(k,198) = b(k,198) - lu(k,803) * b(k,157) - b(k,214) = b(k,214) - lu(k,804) * b(k,157) - b(k,276) = b(k,276) - lu(k,805) * b(k,157) - b(k,282) = b(k,282) - lu(k,806) * b(k,157) - b(k,240) = b(k,240) - lu(k,808) * b(k,158) - b(k,269) = b(k,269) - lu(k,809) * b(k,158) - b(k,278) = b(k,278) - lu(k,810) * b(k,158) - b(k,282) = b(k,282) - lu(k,811) * b(k,158) - b(k,193) = b(k,193) - lu(k,813) * b(k,159) - b(k,223) = b(k,223) - lu(k,814) * b(k,159) - b(k,240) = b(k,240) - lu(k,815) * b(k,159) - b(k,272) = b(k,272) - lu(k,816) * b(k,159) - b(k,276) = b(k,276) - lu(k,817) * b(k,159) - b(k,279) = b(k,279) - lu(k,818) * b(k,159) - b(k,281) = b(k,281) - lu(k,819) * b(k,159) - b(k,282) = b(k,282) - lu(k,820) * b(k,159) - b(k,203) = b(k,203) - lu(k,823) * b(k,160) - b(k,228) = b(k,228) - lu(k,824) * b(k,160) - b(k,272) = b(k,272) - lu(k,825) * b(k,160) - b(k,276) = b(k,276) - lu(k,826) * b(k,160) - b(k,278) = b(k,278) - lu(k,827) * b(k,160) - b(k,281) = b(k,281) - lu(k,828) * b(k,160) - b(k,282) = b(k,282) - lu(k,829) * b(k,160) - b(k,286) = b(k,286) - lu(k,830) * b(k,160) - b(k,164) = b(k,164) - lu(k,835) * b(k,161) - b(k,231) = b(k,231) - lu(k,836) * b(k,161) - b(k,254) = b(k,254) - lu(k,837) * b(k,161) - b(k,272) = b(k,272) - lu(k,838) * b(k,161) - b(k,276) = b(k,276) - lu(k,839) * b(k,161) - b(k,278) = b(k,278) - lu(k,840) * b(k,161) - b(k,281) = b(k,281) - lu(k,841) * b(k,161) - b(k,282) = b(k,282) - lu(k,842) * b(k,161) - b(k,226) = b(k,226) - lu(k,844) * b(k,162) - b(k,227) = b(k,227) - lu(k,845) * b(k,162) - b(k,253) = b(k,253) - lu(k,846) * b(k,162) - b(k,262) = b(k,262) - lu(k,847) * b(k,162) - b(k,272) = b(k,272) - lu(k,848) * b(k,162) - b(k,276) = b(k,276) - lu(k,849) * b(k,162) - b(k,281) = b(k,281) - lu(k,850) * b(k,162) - b(k,282) = b(k,282) - lu(k,851) * b(k,162) - b(k,208) = b(k,208) - lu(k,860) * b(k,163) - b(k,247) = b(k,247) - lu(k,861) * b(k,163) - b(k,249) = b(k,249) - lu(k,862) * b(k,163) - b(k,261) = b(k,261) - lu(k,863) * b(k,163) - b(k,263) = b(k,263) - lu(k,864) * b(k,163) - b(k,268) = b(k,268) - lu(k,865) * b(k,163) - b(k,273) = b(k,273) - lu(k,866) * b(k,163) - b(k,274) = b(k,274) - lu(k,867) * b(k,163) - b(k,276) = b(k,276) - lu(k,868) * b(k,163) - b(k,278) = b(k,278) - lu(k,869) * b(k,163) - b(k,282) = b(k,282) - lu(k,870) * b(k,163) - b(k,217) = b(k,217) - lu(k,872) * b(k,164) - b(k,276) = b(k,276) - lu(k,873) * b(k,164) - b(k,282) = b(k,282) - lu(k,874) * b(k,164) - b(k,203) = b(k,203) - lu(k,877) * b(k,165) - b(k,218) = b(k,218) - lu(k,878) * b(k,165) - b(k,223) = b(k,223) - lu(k,879) * b(k,165) - b(k,228) = b(k,228) - lu(k,880) * b(k,165) - b(k,251) = b(k,251) - lu(k,881) * b(k,165) - b(k,269) = b(k,269) - lu(k,882) * b(k,165) - b(k,270) = b(k,270) - lu(k,883) * b(k,165) - b(k,276) = b(k,276) - lu(k,884) * b(k,165) - b(k,278) = b(k,278) - lu(k,885) * b(k,165) - b(k,281) = b(k,281) - lu(k,886) * b(k,165) - b(k,282) = b(k,282) - lu(k,887) * b(k,165) - b(k,217) = b(k,217) - lu(k,889) * b(k,166) - b(k,254) = b(k,254) - lu(k,890) * b(k,166) - b(k,259) = b(k,259) - lu(k,891) * b(k,166) - b(k,276) = b(k,276) - lu(k,892) * b(k,166) - b(k,281) = b(k,281) - lu(k,893) * b(k,166) - b(k,282) = b(k,282) - lu(k,894) * b(k,166) - b(k,286) = b(k,286) - lu(k,895) * b(k,166) + b(k,189) = b(k,189) - lu(k,633) * b(k,153) + b(k,263) = b(k,263) - lu(k,634) * b(k,153) + b(k,264) = b(k,264) - lu(k,635) * b(k,153) + b(k,307) = b(k,307) - lu(k,636) * b(k,153) + b(k,309) = b(k,309) - lu(k,637) * b(k,153) + b(k,310) = b(k,310) - lu(k,638) * b(k,153) + b(k,274) = b(k,274) - lu(k,640) * b(k,154) + b(k,292) = b(k,292) - lu(k,641) * b(k,154) + b(k,304) = b(k,304) - lu(k,642) * b(k,154) + b(k,309) = b(k,309) - lu(k,643) * b(k,154) + b(k,310) = b(k,310) - lu(k,644) * b(k,154) + b(k,311) = b(k,311) - lu(k,645) * b(k,154) + b(k,313) = b(k,313) - lu(k,646) * b(k,154) + b(k,315) = b(k,315) - lu(k,647) * b(k,154) + b(k,245) = b(k,245) - lu(k,649) * b(k,155) + b(k,264) = b(k,264) - lu(k,650) * b(k,155) + b(k,278) = b(k,278) - lu(k,651) * b(k,155) + b(k,301) = b(k,301) - lu(k,652) * b(k,155) + b(k,307) = b(k,307) - lu(k,653) * b(k,155) + b(k,309) = b(k,309) - lu(k,654) * b(k,155) + b(k,310) = b(k,310) - lu(k,655) * b(k,155) + b(k,314) = b(k,314) - lu(k,656) * b(k,155) + b(k,245) = b(k,245) - lu(k,658) * b(k,156) + b(k,264) = b(k,264) - lu(k,659) * b(k,156) + b(k,299) = b(k,299) - lu(k,660) * b(k,156) + b(k,302) = b(k,302) - lu(k,661) * b(k,156) + b(k,307) = b(k,307) - lu(k,662) * b(k,156) + b(k,309) = b(k,309) - lu(k,663) * b(k,156) + b(k,310) = b(k,310) - lu(k,664) * b(k,156) + b(k,314) = b(k,314) - lu(k,665) * b(k,156) + b(k,212) = b(k,212) - lu(k,667) * b(k,157) + b(k,250) = b(k,250) - lu(k,668) * b(k,157) + b(k,293) = b(k,293) - lu(k,669) * b(k,157) + b(k,309) = b(k,309) - lu(k,670) * b(k,157) + b(k,310) = b(k,310) - lu(k,671) * b(k,157) + b(k,314) = b(k,314) - lu(k,672) * b(k,157) + b(k,282) = b(k,282) - lu(k,674) * b(k,158) + b(k,309) = b(k,309) - lu(k,675) * b(k,158) + b(k,310) = b(k,310) - lu(k,676) * b(k,158) + b(k,184) = b(k,184) - lu(k,679) * b(k,159) + b(k,189) = b(k,189) - lu(k,680) * b(k,159) + b(k,241) = b(k,241) - lu(k,681) * b(k,159) + b(k,245) = b(k,245) - lu(k,682) * b(k,159) + b(k,263) = b(k,263) - lu(k,683) * b(k,159) + b(k,264) = b(k,264) - lu(k,684) * b(k,159) + b(k,268) = b(k,268) - lu(k,685) * b(k,159) + b(k,302) = b(k,302) - lu(k,686) * b(k,159) + b(k,307) = b(k,307) - lu(k,687) * b(k,159) + b(k,309) = b(k,309) - lu(k,688) * b(k,159) + b(k,310) = b(k,310) - lu(k,689) * b(k,159) + b(k,313) = b(k,313) - lu(k,690) * b(k,159) + b(k,211) = b(k,211) - lu(k,692) * b(k,160) + b(k,224) = b(k,224) - lu(k,693) * b(k,160) + b(k,305) = b(k,305) - lu(k,694) * b(k,160) + b(k,307) = b(k,307) - lu(k,695) * b(k,160) + b(k,309) = b(k,309) - lu(k,696) * b(k,160) + b(k,310) = b(k,310) - lu(k,697) * b(k,160) + b(k,314) = b(k,314) - lu(k,698) * b(k,160) + b(k,315) = b(k,315) - lu(k,699) * b(k,160) + b(k,245) = b(k,245) - lu(k,701) * b(k,161) + b(k,302) = b(k,302) - lu(k,702) * b(k,161) + b(k,307) = b(k,307) - lu(k,703) * b(k,161) + b(k,310) = b(k,310) - lu(k,704) * b(k,161) + b(k,313) = b(k,313) - lu(k,705) * b(k,161) + b(k,315) = b(k,315) - lu(k,706) * b(k,161) + b(k,303) = b(k,303) - lu(k,710) * b(k,162) + b(k,305) = b(k,305) - lu(k,711) * b(k,162) + b(k,309) = b(k,309) - lu(k,712) * b(k,162) + b(k,310) = b(k,310) - lu(k,713) * b(k,162) + b(k,314) = b(k,314) - lu(k,714) * b(k,162) + b(k,165) = b(k,165) - lu(k,717) * b(k,163) + b(k,223) = b(k,223) - lu(k,718) * b(k,163) + b(k,228) = b(k,228) - lu(k,719) * b(k,163) + b(k,278) = b(k,278) - lu(k,720) * b(k,163) + b(k,302) = b(k,302) - lu(k,721) * b(k,163) + b(k,307) = b(k,307) - lu(k,722) * b(k,163) + b(k,309) = b(k,309) - lu(k,723) * b(k,163) + b(k,310) = b(k,310) - lu(k,724) * b(k,163) + b(k,314) = b(k,314) - lu(k,725) * b(k,163) + b(k,165) = b(k,165) - lu(k,728) * b(k,164) + b(k,210) = b(k,210) - lu(k,729) * b(k,164) + b(k,223) = b(k,223) - lu(k,730) * b(k,164) + b(k,228) = b(k,228) - lu(k,731) * b(k,164) + b(k,278) = b(k,278) - lu(k,732) * b(k,164) + b(k,302) = b(k,302) - lu(k,733) * b(k,164) + b(k,307) = b(k,307) - lu(k,734) * b(k,164) + b(k,309) = b(k,309) - lu(k,735) * b(k,164) + b(k,310) = b(k,310) - lu(k,736) * b(k,164) + b(k,228) = b(k,228) - lu(k,739) * b(k,165) + b(k,302) = b(k,302) - lu(k,740) * b(k,165) + b(k,305) = b(k,305) - lu(k,741) * b(k,165) + b(k,309) = b(k,309) - lu(k,742) * b(k,165) + b(k,310) = b(k,310) - lu(k,743) * b(k,165) + b(k,314) = b(k,314) - lu(k,744) * b(k,165) + b(k,179) = b(k,179) - lu(k,749) * b(k,166) + b(k,180) = b(k,180) - lu(k,750) * b(k,166) + b(k,182) = b(k,182) - lu(k,751) * b(k,166) + b(k,185) = b(k,185) - lu(k,752) * b(k,166) + b(k,233) = b(k,233) - lu(k,753) * b(k,166) + b(k,263) = b(k,263) - lu(k,754) * b(k,166) + b(k,264) = b(k,264) - lu(k,755) * b(k,166) + b(k,309) = b(k,309) - lu(k,756) * b(k,166) + b(k,310) = b(k,310) - lu(k,757) * b(k,166) + b(k,216) = b(k,216) - lu(k,759) * b(k,167) + b(k,229) = b(k,229) - lu(k,760) * b(k,167) + b(k,268) = b(k,268) - lu(k,761) * b(k,167) + b(k,269) = b(k,269) - lu(k,762) * b(k,167) + b(k,272) = b(k,272) - lu(k,763) * b(k,167) + b(k,307) = b(k,307) - lu(k,764) * b(k,167) + b(k,309) = b(k,309) - lu(k,765) * b(k,167) + b(k,310) = b(k,310) - lu(k,766) * b(k,167) + b(k,314) = b(k,314) - lu(k,767) * b(k,167) + b(k,245) = b(k,245) - lu(k,769) * b(k,168) + b(k,295) = b(k,295) - lu(k,770) * b(k,168) + b(k,300) = b(k,300) - lu(k,771) * b(k,168) + b(k,310) = b(k,310) - lu(k,772) * b(k,168) + b(k,233) = b(k,233) - lu(k,774) * b(k,169) + b(k,252) = b(k,252) - lu(k,775) * b(k,169) + b(k,256) = b(k,256) - lu(k,776) * b(k,169) + b(k,263) = b(k,263) - lu(k,777) * b(k,169) + b(k,264) = b(k,264) - lu(k,778) * b(k,169) + b(k,309) = b(k,309) - lu(k,779) * b(k,169) + b(k,310) = b(k,310) - lu(k,780) * b(k,169) + b(k,195) = b(k,195) - lu(k,782) * b(k,170) + b(k,251) = b(k,251) - lu(k,783) * b(k,170) + b(k,293) = b(k,293) - lu(k,784) * b(k,170) + b(k,306) = b(k,306) - lu(k,785) * b(k,170) + b(k,309) = b(k,309) - lu(k,786) * b(k,170) + b(k,310) = b(k,310) - lu(k,787) * b(k,170) + b(k,314) = b(k,314) - lu(k,788) * b(k,170) + b(k,245) = b(k,245) - lu(k,790) * b(k,171) + b(k,310) = b(k,310) - lu(k,791) * b(k,171) + b(k,313) = b(k,313) - lu(k,792) * b(k,171) + b(k,315) = b(k,315) - lu(k,793) * b(k,171) + b(k,190) = b(k,190) - lu(k,796) * b(k,172) + b(k,253) = b(k,253) - lu(k,797) * b(k,172) + b(k,305) = b(k,305) - lu(k,798) * b(k,172) + b(k,307) = b(k,307) - lu(k,799) * b(k,172) + b(k,309) = b(k,309) - lu(k,800) * b(k,172) + b(k,310) = b(k,310) - lu(k,801) * b(k,172) + b(k,314) = b(k,314) - lu(k,802) * b(k,172) + b(k,190) = b(k,190) - lu(k,804) * b(k,173) + b(k,213) = b(k,213) - lu(k,805) * b(k,173) + b(k,242) = b(k,242) - lu(k,806) * b(k,173) + b(k,305) = b(k,305) - lu(k,807) * b(k,173) + b(k,309) = b(k,309) - lu(k,808) * b(k,173) + b(k,310) = b(k,310) - lu(k,809) * b(k,173) + b(k,314) = b(k,314) - lu(k,810) * b(k,173) + b(k,190) = b(k,190) - lu(k,812) * b(k,174) + b(k,213) = b(k,213) - lu(k,813) * b(k,174) + b(k,240) = b(k,240) - lu(k,814) * b(k,174) + b(k,305) = b(k,305) - lu(k,815) * b(k,174) + b(k,309) = b(k,309) - lu(k,816) * b(k,174) + b(k,310) = b(k,310) - lu(k,817) * b(k,174) + b(k,314) = b(k,314) - lu(k,818) * b(k,174) + b(k,233) = b(k,233) - lu(k,820) * b(k,175) + b(k,264) = b(k,264) - lu(k,821) * b(k,175) + b(k,307) = b(k,307) - lu(k,822) * b(k,175) + b(k,309) = b(k,309) - lu(k,823) * b(k,175) + b(k,310) = b(k,310) - lu(k,824) * b(k,175) + b(k,179) = b(k,179) - lu(k,830) * b(k,176) + b(k,181) = b(k,181) - lu(k,831) * b(k,176) + b(k,182) = b(k,182) - lu(k,832) * b(k,176) + b(k,185) = b(k,185) - lu(k,833) * b(k,176) + b(k,233) = b(k,233) - lu(k,834) * b(k,176) + b(k,263) = b(k,263) - lu(k,835) * b(k,176) + b(k,264) = b(k,264) - lu(k,836) * b(k,176) + b(k,302) = b(k,302) - lu(k,837) * b(k,176) + b(k,309) = b(k,309) - lu(k,838) * b(k,176) + b(k,310) = b(k,310) - lu(k,839) * b(k,176) + b(k,256) = b(k,256) - lu(k,847) * b(k,177) + b(k,278) = b(k,278) - lu(k,848) * b(k,177) + b(k,281) = b(k,281) - lu(k,849) * b(k,177) + b(k,294) = b(k,294) - lu(k,850) * b(k,177) + b(k,298) = b(k,298) - lu(k,851) * b(k,177) + b(k,303) = b(k,303) - lu(k,852) * b(k,177) + b(k,307) = b(k,307) - lu(k,853) * b(k,177) + b(k,309) = b(k,309) - lu(k,854) * b(k,177) + b(k,310) = b(k,310) - lu(k,855) * b(k,177) + b(k,312) = b(k,312) - lu(k,856) * b(k,177) + b(k,252) = b(k,252) - lu(k,860) * b(k,178) + b(k,305) = b(k,305) - lu(k,861) * b(k,178) + b(k,307) = b(k,307) - lu(k,862) * b(k,178) + b(k,309) = b(k,309) - lu(k,863) * b(k,178) + b(k,310) = b(k,310) - lu(k,864) * b(k,178) + b(k,314) = b(k,314) - lu(k,865) * b(k,178) + b(k,233) = b(k,233) - lu(k,867) * b(k,179) + b(k,264) = b(k,264) - lu(k,868) * b(k,179) + b(k,305) = b(k,305) - lu(k,869) * b(k,179) + b(k,309) = b(k,309) - lu(k,870) * b(k,179) + b(k,314) = b(k,314) - lu(k,871) * b(k,179) + b(k,182) = b(k,182) - lu(k,878) * b(k,180) + b(k,185) = b(k,185) - lu(k,879) * b(k,180) + b(k,233) = b(k,233) - lu(k,880) * b(k,180) + b(k,263) = b(k,263) - lu(k,881) * b(k,180) + b(k,264) = b(k,264) - lu(k,882) * b(k,180) + b(k,305) = b(k,305) - lu(k,883) * b(k,180) + b(k,309) = b(k,309) - lu(k,884) * b(k,180) + b(k,310) = b(k,310) - lu(k,885) * b(k,180) + b(k,314) = b(k,314) - lu(k,886) * b(k,180) + b(k,182) = b(k,182) - lu(k,894) * b(k,181) + b(k,185) = b(k,185) - lu(k,895) * b(k,181) + b(k,233) = b(k,233) - lu(k,896) * b(k,181) + b(k,263) = b(k,263) - lu(k,897) * b(k,181) + b(k,264) = b(k,264) - lu(k,898) * b(k,181) + b(k,302) = b(k,302) - lu(k,899) * b(k,181) + b(k,305) = b(k,305) - lu(k,900) * b(k,181) + b(k,309) = b(k,309) - lu(k,901) * b(k,181) + b(k,310) = b(k,310) - lu(k,902) * b(k,181) + b(k,314) = b(k,314) - lu(k,903) * b(k,181) end do end subroutine lu_slv03 subroutine lu_slv04( avec_len, lu, b ) @@ -697,210 +699,207 @@ subroutine lu_slv04( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,215) = b(k,215) - lu(k,898) * b(k,167) - b(k,270) = b(k,270) - lu(k,899) * b(k,167) - b(k,271) = b(k,271) - lu(k,900) * b(k,167) - b(k,274) = b(k,274) - lu(k,901) * b(k,167) - b(k,279) = b(k,279) - lu(k,902) * b(k,167) - b(k,282) = b(k,282) - lu(k,903) * b(k,167) - b(k,286) = b(k,286) - lu(k,904) * b(k,167) - b(k,233) = b(k,233) - lu(k,907) * b(k,168) - b(k,280) = b(k,280) - lu(k,908) * b(k,168) - b(k,282) = b(k,282) - lu(k,909) * b(k,168) - b(k,283) = b(k,283) - lu(k,910) * b(k,168) - b(k,284) = b(k,284) - lu(k,911) * b(k,168) - b(k,285) = b(k,285) - lu(k,912) * b(k,168) - b(k,286) = b(k,286) - lu(k,913) * b(k,168) - b(k,217) = b(k,217) - lu(k,918) * b(k,169) - b(k,253) = b(k,253) - lu(k,919) * b(k,169) - b(k,254) = b(k,254) - lu(k,920) * b(k,169) - b(k,272) = b(k,272) - lu(k,921) * b(k,169) - b(k,276) = b(k,276) - lu(k,922) * b(k,169) - b(k,281) = b(k,281) - lu(k,923) * b(k,169) - b(k,282) = b(k,282) - lu(k,924) * b(k,169) - b(k,179) = b(k,179) - lu(k,927) * b(k,170) - b(k,190) = b(k,190) - lu(k,928) * b(k,170) - b(k,217) = b(k,217) - lu(k,929) * b(k,170) - b(k,272) = b(k,272) - lu(k,930) * b(k,170) - b(k,276) = b(k,276) - lu(k,931) * b(k,170) - b(k,281) = b(k,281) - lu(k,932) * b(k,170) - b(k,282) = b(k,282) - lu(k,933) * b(k,170) - b(k,175) = b(k,175) - lu(k,942) * b(k,171) - b(k,186) = b(k,186) - lu(k,943) * b(k,171) - b(k,187) = b(k,187) - lu(k,944) * b(k,171) - b(k,188) = b(k,188) - lu(k,945) * b(k,171) - b(k,208) = b(k,208) - lu(k,946) * b(k,171) - b(k,256) = b(k,256) - lu(k,947) * b(k,171) - b(k,259) = b(k,259) - lu(k,948) * b(k,171) - b(k,266) = b(k,266) - lu(k,949) * b(k,171) - b(k,273) = b(k,273) - lu(k,950) * b(k,171) - b(k,274) = b(k,274) - lu(k,951) * b(k,171) - b(k,278) = b(k,278) - lu(k,952) * b(k,171) - b(k,282) = b(k,282) - lu(k,953) * b(k,171) - b(k,208) = b(k,208) - lu(k,962) * b(k,172) - b(k,252) = b(k,252) - lu(k,963) * b(k,172) - b(k,258) = b(k,258) - lu(k,964) * b(k,172) - b(k,262) = b(k,262) - lu(k,965) * b(k,172) - b(k,263) = b(k,263) - lu(k,966) * b(k,172) - b(k,267) = b(k,267) - lu(k,967) * b(k,172) - b(k,268) = b(k,268) - lu(k,968) * b(k,172) - b(k,269) = b(k,269) - lu(k,969) * b(k,172) - b(k,273) = b(k,273) - lu(k,970) * b(k,172) - b(k,274) = b(k,274) - lu(k,971) * b(k,172) - b(k,278) = b(k,278) - lu(k,972) * b(k,172) - b(k,282) = b(k,282) - lu(k,973) * b(k,172) - b(k,203) = b(k,203) - lu(k,976) * b(k,173) - b(k,251) = b(k,251) - lu(k,977) * b(k,173) - b(k,272) = b(k,272) - lu(k,978) * b(k,173) - b(k,276) = b(k,276) - lu(k,979) * b(k,173) - b(k,278) = b(k,278) - lu(k,980) * b(k,173) - b(k,279) = b(k,279) - lu(k,981) * b(k,173) - b(k,281) = b(k,281) - lu(k,982) * b(k,173) - b(k,282) = b(k,282) - lu(k,983) * b(k,173) - b(k,286) = b(k,286) - lu(k,984) * b(k,173) - b(k,206) = b(k,206) - lu(k,986) * b(k,174) - b(k,222) = b(k,222) - lu(k,987) * b(k,174) - b(k,230) = b(k,230) - lu(k,988) * b(k,174) - b(k,238) = b(k,238) - lu(k,989) * b(k,174) - b(k,272) = b(k,272) - lu(k,990) * b(k,174) - b(k,276) = b(k,276) - lu(k,991) * b(k,174) - b(k,278) = b(k,278) - lu(k,992) * b(k,174) - b(k,281) = b(k,281) - lu(k,993) * b(k,174) - b(k,282) = b(k,282) - lu(k,994) * b(k,174) - b(k,263) = b(k,263) - lu(k,996) * b(k,175) - b(k,266) = b(k,266) - lu(k,997) * b(k,175) - b(k,282) = b(k,282) - lu(k,998) * b(k,175) - b(k,206) = b(k,206) - lu(k,1000) * b(k,176) - b(k,207) = b(k,207) - lu(k,1001) * b(k,176) - b(k,218) = b(k,218) - lu(k,1002) * b(k,176) - b(k,222) = b(k,222) - lu(k,1003) * b(k,176) - b(k,229) = b(k,229) - lu(k,1004) * b(k,176) - b(k,272) = b(k,272) - lu(k,1005) * b(k,176) - b(k,276) = b(k,276) - lu(k,1006) * b(k,176) - b(k,278) = b(k,278) - lu(k,1007) * b(k,176) - b(k,281) = b(k,281) - lu(k,1008) * b(k,176) - b(k,282) = b(k,282) - lu(k,1009) * b(k,176) - b(k,201) = b(k,201) - lu(k,1011) * b(k,177) - b(k,206) = b(k,206) - lu(k,1012) * b(k,177) - b(k,222) = b(k,222) - lu(k,1013) * b(k,177) - b(k,228) = b(k,228) - lu(k,1014) * b(k,177) - b(k,238) = b(k,238) - lu(k,1015) * b(k,177) - b(k,272) = b(k,272) - lu(k,1016) * b(k,177) - b(k,276) = b(k,276) - lu(k,1017) * b(k,177) - b(k,278) = b(k,278) - lu(k,1018) * b(k,177) - b(k,281) = b(k,281) - lu(k,1019) * b(k,177) - b(k,282) = b(k,282) - lu(k,1020) * b(k,177) - b(k,193) = b(k,193) - lu(k,1022) * b(k,178) - b(k,218) = b(k,218) - lu(k,1023) * b(k,178) - b(k,223) = b(k,223) - lu(k,1024) * b(k,178) - b(k,228) = b(k,228) - lu(k,1025) * b(k,178) - b(k,229) = b(k,229) - lu(k,1026) * b(k,178) - b(k,238) = b(k,238) - lu(k,1027) * b(k,178) - b(k,240) = b(k,240) - lu(k,1028) * b(k,178) - b(k,270) = b(k,270) - lu(k,1029) * b(k,178) - b(k,281) = b(k,281) - lu(k,1030) * b(k,178) - b(k,282) = b(k,282) - lu(k,1031) * b(k,178) - b(k,213) = b(k,213) - lu(k,1033) * b(k,179) - b(k,254) = b(k,254) - lu(k,1034) * b(k,179) - b(k,270) = b(k,270) - lu(k,1035) * b(k,179) - b(k,281) = b(k,281) - lu(k,1036) * b(k,179) - b(k,282) = b(k,282) - lu(k,1037) * b(k,179) - b(k,286) = b(k,286) - lu(k,1038) * b(k,179) - b(k,233) = b(k,233) - lu(k,1040) * b(k,180) - b(k,271) = b(k,271) - lu(k,1041) * b(k,180) - b(k,275) = b(k,275) - lu(k,1042) * b(k,180) - b(k,280) = b(k,280) - lu(k,1043) * b(k,180) - b(k,282) = b(k,282) - lu(k,1044) * b(k,180) - b(k,284) = b(k,284) - lu(k,1045) * b(k,180) - b(k,286) = b(k,286) - lu(k,1046) * b(k,180) - b(k,187) = b(k,187) - lu(k,1049) * b(k,181) - b(k,194) = b(k,194) - lu(k,1050) * b(k,181) - b(k,198) = b(k,198) - lu(k,1051) * b(k,181) - b(k,219) = b(k,219) - lu(k,1052) * b(k,181) - b(k,236) = b(k,236) - lu(k,1053) * b(k,181) - b(k,240) = b(k,240) - lu(k,1054) * b(k,181) - b(k,241) = b(k,241) - lu(k,1055) * b(k,181) - b(k,245) = b(k,245) - lu(k,1056) * b(k,181) - b(k,246) = b(k,246) - lu(k,1057) * b(k,181) - b(k,270) = b(k,270) - lu(k,1058) * b(k,181) - b(k,276) = b(k,276) - lu(k,1059) * b(k,181) - b(k,278) = b(k,278) - lu(k,1060) * b(k,181) - b(k,281) = b(k,281) - lu(k,1061) * b(k,181) - b(k,282) = b(k,282) - lu(k,1062) * b(k,181) - b(k,277) = b(k,277) - lu(k,1065) * b(k,182) - b(k,280) = b(k,280) - lu(k,1066) * b(k,182) - b(k,282) = b(k,282) - lu(k,1067) * b(k,182) - b(k,283) = b(k,283) - lu(k,1068) * b(k,182) - b(k,285) = b(k,285) - lu(k,1069) * b(k,182) - b(k,286) = b(k,286) - lu(k,1070) * b(k,182) - b(k,206) = b(k,206) - lu(k,1072) * b(k,183) - b(k,218) = b(k,218) - lu(k,1073) * b(k,183) - b(k,222) = b(k,222) - lu(k,1074) * b(k,183) - b(k,228) = b(k,228) - lu(k,1075) * b(k,183) - b(k,229) = b(k,229) - lu(k,1076) * b(k,183) - b(k,230) = b(k,230) - lu(k,1077) * b(k,183) - b(k,272) = b(k,272) - lu(k,1078) * b(k,183) - b(k,276) = b(k,276) - lu(k,1079) * b(k,183) - b(k,278) = b(k,278) - lu(k,1080) * b(k,183) - b(k,281) = b(k,281) - lu(k,1081) * b(k,183) - b(k,282) = b(k,282) - lu(k,1082) * b(k,183) - b(k,198) = b(k,198) - lu(k,1084) * b(k,184) - b(k,207) = b(k,207) - lu(k,1085) * b(k,184) - b(k,219) = b(k,219) - lu(k,1086) * b(k,184) - b(k,223) = b(k,223) - lu(k,1087) * b(k,184) - b(k,228) = b(k,228) - lu(k,1088) * b(k,184) - b(k,238) = b(k,238) - lu(k,1089) * b(k,184) - b(k,270) = b(k,270) - lu(k,1090) * b(k,184) - b(k,276) = b(k,276) - lu(k,1091) * b(k,184) - b(k,278) = b(k,278) - lu(k,1092) * b(k,184) - b(k,281) = b(k,281) - lu(k,1093) * b(k,184) - b(k,282) = b(k,282) - lu(k,1094) * b(k,184) - b(k,192) = b(k,192) - lu(k,1103) * b(k,185) - b(k,208) = b(k,208) - lu(k,1104) * b(k,185) - b(k,223) = b(k,223) - lu(k,1105) * b(k,185) - b(k,250) = b(k,250) - lu(k,1106) * b(k,185) - b(k,254) = b(k,254) - lu(k,1107) * b(k,185) - b(k,255) = b(k,255) - lu(k,1108) * b(k,185) - b(k,263) = b(k,263) - lu(k,1109) * b(k,185) - b(k,265) = b(k,265) - lu(k,1110) * b(k,185) - b(k,266) = b(k,266) - lu(k,1111) * b(k,185) - b(k,268) = b(k,268) - lu(k,1112) * b(k,185) - b(k,273) = b(k,273) - lu(k,1113) * b(k,185) - b(k,274) = b(k,274) - lu(k,1114) * b(k,185) - b(k,276) = b(k,276) - lu(k,1115) * b(k,185) - b(k,278) = b(k,278) - lu(k,1116) * b(k,185) - b(k,282) = b(k,282) - lu(k,1117) * b(k,185) - b(k,187) = b(k,187) - lu(k,1119) * b(k,186) - b(k,276) = b(k,276) - lu(k,1120) * b(k,186) - b(k,278) = b(k,278) - lu(k,1121) * b(k,186) - b(k,282) = b(k,282) - lu(k,1122) * b(k,186) - b(k,286) = b(k,286) - lu(k,1123) * b(k,186) - b(k,276) = b(k,276) - lu(k,1125) * b(k,187) - b(k,282) = b(k,282) - lu(k,1126) * b(k,187) - b(k,286) = b(k,286) - lu(k,1127) * b(k,187) - b(k,199) = b(k,199) - lu(k,1133) * b(k,188) - b(k,203) = b(k,203) - lu(k,1134) * b(k,188) - b(k,251) = b(k,251) - lu(k,1135) * b(k,188) - b(k,269) = b(k,269) - lu(k,1136) * b(k,188) - b(k,272) = b(k,272) - lu(k,1137) * b(k,188) - b(k,276) = b(k,276) - lu(k,1138) * b(k,188) - b(k,278) = b(k,278) - lu(k,1139) * b(k,188) - b(k,281) = b(k,281) - lu(k,1140) * b(k,188) - b(k,282) = b(k,282) - lu(k,1141) * b(k,188) - b(k,190) = b(k,190) - lu(k,1145) * b(k,189) - b(k,217) = b(k,217) - lu(k,1146) * b(k,189) - b(k,254) = b(k,254) - lu(k,1147) * b(k,189) - b(k,259) = b(k,259) - lu(k,1148) * b(k,189) - b(k,272) = b(k,272) - lu(k,1149) * b(k,189) - b(k,276) = b(k,276) - lu(k,1150) * b(k,189) - b(k,281) = b(k,281) - lu(k,1151) * b(k,189) - b(k,282) = b(k,282) - lu(k,1152) * b(k,189) - b(k,286) = b(k,286) - lu(k,1153) * b(k,189) - b(k,217) = b(k,217) - lu(k,1155) * b(k,190) - b(k,270) = b(k,270) - lu(k,1156) * b(k,190) - b(k,276) = b(k,276) - lu(k,1157) * b(k,190) - b(k,281) = b(k,281) - lu(k,1158) * b(k,190) - b(k,282) = b(k,282) - lu(k,1159) * b(k,190) + b(k,263) = b(k,263) - lu(k,905) * b(k,182) + b(k,264) = b(k,264) - lu(k,906) * b(k,182) + b(k,305) = b(k,305) - lu(k,907) * b(k,182) + b(k,309) = b(k,309) - lu(k,908) * b(k,182) + b(k,310) = b(k,310) - lu(k,909) * b(k,182) + b(k,313) = b(k,313) - lu(k,910) * b(k,182) + b(k,314) = b(k,314) - lu(k,911) * b(k,182) + b(k,252) = b(k,252) - lu(k,913) * b(k,183) + b(k,256) = b(k,256) - lu(k,914) * b(k,183) + b(k,309) = b(k,309) - lu(k,915) * b(k,183) + b(k,310) = b(k,310) - lu(k,916) * b(k,183) + b(k,256) = b(k,256) - lu(k,918) * b(k,184) + b(k,263) = b(k,263) - lu(k,919) * b(k,184) + b(k,264) = b(k,264) - lu(k,920) * b(k,184) + b(k,307) = b(k,307) - lu(k,921) * b(k,184) + b(k,233) = b(k,233) - lu(k,923) * b(k,185) + b(k,263) = b(k,263) - lu(k,924) * b(k,185) + b(k,264) = b(k,264) - lu(k,925) * b(k,185) + b(k,305) = b(k,305) - lu(k,926) * b(k,185) + b(k,309) = b(k,309) - lu(k,927) * b(k,185) + b(k,310) = b(k,310) - lu(k,928) * b(k,185) + b(k,313) = b(k,313) - lu(k,929) * b(k,185) + b(k,314) = b(k,314) - lu(k,930) * b(k,185) + b(k,228) = b(k,228) - lu(k,933) * b(k,186) + b(k,256) = b(k,256) - lu(k,934) * b(k,186) + b(k,305) = b(k,305) - lu(k,935) * b(k,186) + b(k,307) = b(k,307) - lu(k,936) * b(k,186) + b(k,309) = b(k,309) - lu(k,937) * b(k,186) + b(k,310) = b(k,310) - lu(k,938) * b(k,186) + b(k,314) = b(k,314) - lu(k,939) * b(k,186) + b(k,315) = b(k,315) - lu(k,940) * b(k,186) + b(k,190) = b(k,190) - lu(k,945) * b(k,187) + b(k,253) = b(k,253) - lu(k,946) * b(k,187) + b(k,282) = b(k,282) - lu(k,947) * b(k,187) + b(k,305) = b(k,305) - lu(k,948) * b(k,187) + b(k,307) = b(k,307) - lu(k,949) * b(k,187) + b(k,309) = b(k,309) - lu(k,950) * b(k,187) + b(k,310) = b(k,310) - lu(k,951) * b(k,187) + b(k,314) = b(k,314) - lu(k,952) * b(k,187) + b(k,250) = b(k,250) - lu(k,954) * b(k,188) + b(k,251) = b(k,251) - lu(k,955) * b(k,188) + b(k,285) = b(k,285) - lu(k,956) * b(k,188) + b(k,293) = b(k,293) - lu(k,957) * b(k,188) + b(k,305) = b(k,305) - lu(k,958) * b(k,188) + b(k,309) = b(k,309) - lu(k,959) * b(k,188) + b(k,310) = b(k,310) - lu(k,960) * b(k,188) + b(k,314) = b(k,314) - lu(k,961) * b(k,188) + b(k,263) = b(k,263) - lu(k,963) * b(k,189) + b(k,302) = b(k,302) - lu(k,964) * b(k,189) + b(k,307) = b(k,307) - lu(k,965) * b(k,189) + b(k,310) = b(k,310) - lu(k,966) * b(k,189) + b(k,242) = b(k,242) - lu(k,968) * b(k,190) + b(k,309) = b(k,309) - lu(k,969) * b(k,190) + b(k,310) = b(k,310) - lu(k,970) * b(k,190) + b(k,228) = b(k,228) - lu(k,973) * b(k,191) + b(k,252) = b(k,252) - lu(k,974) * b(k,191) + b(k,256) = b(k,256) - lu(k,975) * b(k,191) + b(k,264) = b(k,264) - lu(k,976) * b(k,191) + b(k,278) = b(k,278) - lu(k,977) * b(k,191) + b(k,302) = b(k,302) - lu(k,978) * b(k,191) + b(k,306) = b(k,306) - lu(k,979) * b(k,191) + b(k,307) = b(k,307) - lu(k,980) * b(k,191) + b(k,309) = b(k,309) - lu(k,981) * b(k,191) + b(k,310) = b(k,310) - lu(k,982) * b(k,191) + b(k,314) = b(k,314) - lu(k,983) * b(k,191) + b(k,242) = b(k,242) - lu(k,985) * b(k,192) + b(k,282) = b(k,282) - lu(k,986) * b(k,192) + b(k,288) = b(k,288) - lu(k,987) * b(k,192) + b(k,309) = b(k,309) - lu(k,988) * b(k,192) + b(k,310) = b(k,310) - lu(k,989) * b(k,192) + b(k,314) = b(k,314) - lu(k,990) * b(k,192) + b(k,315) = b(k,315) - lu(k,991) * b(k,192) + b(k,274) = b(k,274) - lu(k,994) * b(k,193) + b(k,289) = b(k,289) - lu(k,995) * b(k,193) + b(k,304) = b(k,304) - lu(k,996) * b(k,193) + b(k,308) = b(k,308) - lu(k,997) * b(k,193) + b(k,310) = b(k,310) - lu(k,998) * b(k,193) + b(k,311) = b(k,311) - lu(k,999) * b(k,193) + b(k,315) = b(k,315) - lu(k,1000) * b(k,193) + b(k,242) = b(k,242) - lu(k,1005) * b(k,194) + b(k,282) = b(k,282) - lu(k,1006) * b(k,194) + b(k,285) = b(k,285) - lu(k,1007) * b(k,194) + b(k,305) = b(k,305) - lu(k,1008) * b(k,194) + b(k,309) = b(k,309) - lu(k,1009) * b(k,194) + b(k,310) = b(k,310) - lu(k,1010) * b(k,194) + b(k,314) = b(k,314) - lu(k,1011) * b(k,194) + b(k,206) = b(k,206) - lu(k,1014) * b(k,195) + b(k,213) = b(k,213) - lu(k,1015) * b(k,195) + b(k,242) = b(k,242) - lu(k,1016) * b(k,195) + b(k,305) = b(k,305) - lu(k,1017) * b(k,195) + b(k,309) = b(k,309) - lu(k,1018) * b(k,195) + b(k,310) = b(k,310) - lu(k,1019) * b(k,195) + b(k,314) = b(k,314) - lu(k,1020) * b(k,195) + b(k,235) = b(k,235) - lu(k,1029) * b(k,196) + b(k,245) = b(k,245) - lu(k,1030) * b(k,196) + b(k,275) = b(k,275) - lu(k,1031) * b(k,196) + b(k,280) = b(k,280) - lu(k,1032) * b(k,196) + b(k,281) = b(k,281) - lu(k,1033) * b(k,196) + b(k,295) = b(k,295) - lu(k,1034) * b(k,196) + b(k,300) = b(k,300) - lu(k,1035) * b(k,196) + b(k,303) = b(k,303) - lu(k,1036) * b(k,196) + b(k,307) = b(k,307) - lu(k,1037) * b(k,196) + b(k,309) = b(k,309) - lu(k,1038) * b(k,196) + b(k,310) = b(k,310) - lu(k,1039) * b(k,196) + b(k,312) = b(k,312) - lu(k,1040) * b(k,196) + b(k,228) = b(k,228) - lu(k,1043) * b(k,197) + b(k,278) = b(k,278) - lu(k,1044) * b(k,197) + b(k,305) = b(k,305) - lu(k,1045) * b(k,197) + b(k,307) = b(k,307) - lu(k,1046) * b(k,197) + b(k,309) = b(k,309) - lu(k,1047) * b(k,197) + b(k,310) = b(k,310) - lu(k,1048) * b(k,197) + b(k,313) = b(k,313) - lu(k,1049) * b(k,197) + b(k,314) = b(k,314) - lu(k,1050) * b(k,197) + b(k,315) = b(k,315) - lu(k,1051) * b(k,197) + b(k,232) = b(k,232) - lu(k,1053) * b(k,198) + b(k,248) = b(k,248) - lu(k,1054) * b(k,198) + b(k,258) = b(k,258) - lu(k,1055) * b(k,198) + b(k,265) = b(k,265) - lu(k,1056) * b(k,198) + b(k,305) = b(k,305) - lu(k,1057) * b(k,198) + b(k,307) = b(k,307) - lu(k,1058) * b(k,198) + b(k,309) = b(k,309) - lu(k,1059) * b(k,198) + b(k,310) = b(k,310) - lu(k,1060) * b(k,198) + b(k,314) = b(k,314) - lu(k,1061) * b(k,198) + b(k,235) = b(k,235) - lu(k,1070) * b(k,199) + b(k,245) = b(k,245) - lu(k,1071) * b(k,199) + b(k,283) = b(k,283) - lu(k,1072) * b(k,199) + b(k,287) = b(k,287) - lu(k,1073) * b(k,199) + b(k,293) = b(k,293) - lu(k,1074) * b(k,199) + b(k,295) = b(k,295) - lu(k,1075) * b(k,199) + b(k,299) = b(k,299) - lu(k,1076) * b(k,199) + b(k,300) = b(k,300) - lu(k,1077) * b(k,199) + b(k,302) = b(k,302) - lu(k,1078) * b(k,199) + b(k,303) = b(k,303) - lu(k,1079) * b(k,199) + b(k,307) = b(k,307) - lu(k,1080) * b(k,199) + b(k,310) = b(k,310) - lu(k,1081) * b(k,199) + b(k,312) = b(k,312) - lu(k,1082) * b(k,199) + b(k,201) = b(k,201) - lu(k,1091) * b(k,200) + b(k,210) = b(k,210) - lu(k,1092) * b(k,200) + b(k,211) = b(k,211) - lu(k,1093) * b(k,200) + b(k,224) = b(k,224) - lu(k,1094) * b(k,200) + b(k,235) = b(k,235) - lu(k,1095) * b(k,200) + b(k,245) = b(k,245) - lu(k,1096) * b(k,200) + b(k,284) = b(k,284) - lu(k,1097) * b(k,200) + b(k,288) = b(k,288) - lu(k,1098) * b(k,200) + b(k,301) = b(k,301) - lu(k,1099) * b(k,200) + b(k,303) = b(k,303) - lu(k,1100) * b(k,200) + b(k,307) = b(k,307) - lu(k,1101) * b(k,200) + b(k,310) = b(k,310) - lu(k,1102) * b(k,200) + b(k,312) = b(k,312) - lu(k,1103) * b(k,200) + b(k,295) = b(k,295) - lu(k,1105) * b(k,201) + b(k,301) = b(k,301) - lu(k,1106) * b(k,201) + b(k,310) = b(k,310) - lu(k,1107) * b(k,201) + b(k,233) = b(k,233) - lu(k,1109) * b(k,202) + b(k,252) = b(k,252) - lu(k,1110) * b(k,202) + b(k,254) = b(k,254) - lu(k,1111) * b(k,202) + b(k,256) = b(k,256) - lu(k,1112) * b(k,202) + b(k,263) = b(k,263) - lu(k,1113) * b(k,202) + b(k,264) = b(k,264) - lu(k,1114) * b(k,202) + b(k,265) = b(k,265) - lu(k,1115) * b(k,202) + b(k,306) = b(k,306) - lu(k,1116) * b(k,202) + b(k,310) = b(k,310) - lu(k,1117) * b(k,202) + b(k,314) = b(k,314) - lu(k,1118) * b(k,202) + b(k,232) = b(k,232) - lu(k,1120) * b(k,203) + b(k,234) = b(k,234) - lu(k,1121) * b(k,203) + b(k,248) = b(k,248) - lu(k,1122) * b(k,203) + b(k,252) = b(k,252) - lu(k,1123) * b(k,203) + b(k,254) = b(k,254) - lu(k,1124) * b(k,203) + b(k,305) = b(k,305) - lu(k,1125) * b(k,203) + b(k,307) = b(k,307) - lu(k,1126) * b(k,203) + b(k,309) = b(k,309) - lu(k,1127) * b(k,203) + b(k,310) = b(k,310) - lu(k,1128) * b(k,203) + b(k,314) = b(k,314) - lu(k,1129) * b(k,203) + b(k,230) = b(k,230) - lu(k,1131) * b(k,204) + b(k,232) = b(k,232) - lu(k,1132) * b(k,204) + b(k,248) = b(k,248) - lu(k,1133) * b(k,204) + b(k,256) = b(k,256) - lu(k,1134) * b(k,204) + b(k,265) = b(k,265) - lu(k,1135) * b(k,204) + b(k,305) = b(k,305) - lu(k,1136) * b(k,204) + b(k,307) = b(k,307) - lu(k,1137) * b(k,204) + b(k,309) = b(k,309) - lu(k,1138) * b(k,204) + b(k,310) = b(k,310) - lu(k,1139) * b(k,204) + b(k,314) = b(k,314) - lu(k,1140) * b(k,204) + b(k,291) = b(k,291) - lu(k,1143) * b(k,205) + b(k,304) = b(k,304) - lu(k,1144) * b(k,205) + b(k,308) = b(k,308) - lu(k,1145) * b(k,205) + b(k,310) = b(k,310) - lu(k,1146) * b(k,205) + b(k,311) = b(k,311) - lu(k,1147) * b(k,205) + b(k,315) = b(k,315) - lu(k,1148) * b(k,205) + b(k,240) = b(k,240) - lu(k,1150) * b(k,206) + b(k,282) = b(k,282) - lu(k,1151) * b(k,206) + b(k,306) = b(k,306) - lu(k,1152) * b(k,206) + b(k,310) = b(k,310) - lu(k,1153) * b(k,206) + b(k,314) = b(k,314) - lu(k,1154) * b(k,206) + b(k,315) = b(k,315) - lu(k,1155) * b(k,206) + b(k,274) = b(k,274) - lu(k,1157) * b(k,207) + b(k,289) = b(k,289) - lu(k,1158) * b(k,207) + b(k,290) = b(k,290) - lu(k,1159) * b(k,207) + b(k,292) = b(k,292) - lu(k,1160) * b(k,207) + b(k,308) = b(k,308) - lu(k,1161) * b(k,207) + b(k,310) = b(k,310) - lu(k,1162) * b(k,207) + b(k,315) = b(k,315) - lu(k,1163) * b(k,207) end do end subroutine lu_slv04 subroutine lu_slv05( avec_len, lu, b ) @@ -921,208 +920,213 @@ subroutine lu_slv05( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,221) = b(k,221) - lu(k,1162) * b(k,191) - b(k,276) = b(k,276) - lu(k,1163) * b(k,191) - b(k,280) = b(k,280) - lu(k,1164) * b(k,191) - b(k,282) = b(k,282) - lu(k,1165) * b(k,191) - b(k,286) = b(k,286) - lu(k,1166) * b(k,191) - b(k,223) = b(k,223) - lu(k,1168) * b(k,192) - b(k,265) = b(k,265) - lu(k,1169) * b(k,192) - b(k,266) = b(k,266) - lu(k,1170) * b(k,192) - b(k,270) = b(k,270) - lu(k,1171) * b(k,192) - b(k,274) = b(k,274) - lu(k,1172) * b(k,192) - b(k,276) = b(k,276) - lu(k,1173) * b(k,192) - b(k,282) = b(k,282) - lu(k,1174) * b(k,192) - b(k,223) = b(k,223) - lu(k,1177) * b(k,193) - b(k,276) = b(k,276) - lu(k,1178) * b(k,193) - b(k,282) = b(k,282) - lu(k,1179) * b(k,193) - b(k,201) = b(k,201) - lu(k,1181) * b(k,194) - b(k,206) = b(k,206) - lu(k,1182) * b(k,194) - b(k,207) = b(k,207) - lu(k,1183) * b(k,194) - b(k,218) = b(k,218) - lu(k,1184) * b(k,194) - b(k,222) = b(k,222) - lu(k,1185) * b(k,194) - b(k,228) = b(k,228) - lu(k,1186) * b(k,194) - b(k,229) = b(k,229) - lu(k,1187) * b(k,194) - b(k,238) = b(k,238) - lu(k,1188) * b(k,194) - b(k,272) = b(k,272) - lu(k,1189) * b(k,194) - b(k,276) = b(k,276) - lu(k,1190) * b(k,194) - b(k,278) = b(k,278) - lu(k,1191) * b(k,194) - b(k,281) = b(k,281) - lu(k,1192) * b(k,194) - b(k,282) = b(k,282) - lu(k,1193) * b(k,194) - b(k,203) = b(k,203) - lu(k,1198) * b(k,195) - b(k,207) = b(k,207) - lu(k,1199) * b(k,195) - b(k,223) = b(k,223) - lu(k,1200) * b(k,195) - b(k,228) = b(k,228) - lu(k,1201) * b(k,195) - b(k,272) = b(k,272) - lu(k,1202) * b(k,195) - b(k,273) = b(k,273) - lu(k,1203) * b(k,195) - b(k,274) = b(k,274) - lu(k,1204) * b(k,195) - b(k,276) = b(k,276) - lu(k,1205) * b(k,195) - b(k,278) = b(k,278) - lu(k,1206) * b(k,195) - b(k,279) = b(k,279) - lu(k,1207) * b(k,195) - b(k,281) = b(k,281) - lu(k,1208) * b(k,195) - b(k,282) = b(k,282) - lu(k,1209) * b(k,195) - b(k,286) = b(k,286) - lu(k,1210) * b(k,195) - b(k,270) = b(k,270) - lu(k,1214) * b(k,196) - b(k,274) = b(k,274) - lu(k,1215) * b(k,196) - b(k,277) = b(k,277) - lu(k,1216) * b(k,196) - b(k,280) = b(k,280) - lu(k,1217) * b(k,196) - b(k,281) = b(k,281) - lu(k,1218) * b(k,196) - b(k,282) = b(k,282) - lu(k,1219) * b(k,196) - b(k,283) = b(k,283) - lu(k,1220) * b(k,196) - b(k,285) = b(k,285) - lu(k,1221) * b(k,196) - b(k,286) = b(k,286) - lu(k,1222) * b(k,196) - b(k,209) = b(k,209) - lu(k,1225) * b(k,197) - b(k,228) = b(k,228) - lu(k,1226) * b(k,197) - b(k,240) = b(k,240) - lu(k,1227) * b(k,197) - b(k,269) = b(k,269) - lu(k,1228) * b(k,197) - b(k,272) = b(k,272) - lu(k,1229) * b(k,197) - b(k,276) = b(k,276) - lu(k,1230) * b(k,197) - b(k,278) = b(k,278) - lu(k,1231) * b(k,197) - b(k,279) = b(k,279) - lu(k,1232) * b(k,197) - b(k,281) = b(k,281) - lu(k,1233) * b(k,197) - b(k,282) = b(k,282) - lu(k,1234) * b(k,197) - b(k,286) = b(k,286) - lu(k,1235) * b(k,197) - b(k,223) = b(k,223) - lu(k,1237) * b(k,198) - b(k,228) = b(k,228) - lu(k,1238) * b(k,198) - b(k,240) = b(k,240) - lu(k,1239) * b(k,198) - b(k,278) = b(k,278) - lu(k,1240) * b(k,198) - b(k,203) = b(k,203) - lu(k,1244) * b(k,199) - b(k,209) = b(k,209) - lu(k,1245) * b(k,199) - b(k,272) = b(k,272) - lu(k,1246) * b(k,199) - b(k,276) = b(k,276) - lu(k,1247) * b(k,199) - b(k,278) = b(k,278) - lu(k,1248) * b(k,199) - b(k,279) = b(k,279) - lu(k,1249) * b(k,199) - b(k,281) = b(k,281) - lu(k,1250) * b(k,199) - b(k,282) = b(k,282) - lu(k,1251) * b(k,199) - b(k,201) = b(k,201) - lu(k,1256) * b(k,200) - b(k,206) = b(k,206) - lu(k,1257) * b(k,200) - b(k,207) = b(k,207) - lu(k,1258) * b(k,200) - b(k,222) = b(k,222) - lu(k,1259) * b(k,200) - b(k,223) = b(k,223) - lu(k,1260) * b(k,200) - b(k,229) = b(k,229) - lu(k,1261) * b(k,200) - b(k,238) = b(k,238) - lu(k,1262) * b(k,200) - b(k,240) = b(k,240) - lu(k,1263) * b(k,200) - b(k,269) = b(k,269) - lu(k,1264) * b(k,200) - b(k,272) = b(k,272) - lu(k,1265) * b(k,200) - b(k,276) = b(k,276) - lu(k,1266) * b(k,200) - b(k,278) = b(k,278) - lu(k,1267) * b(k,200) - b(k,281) = b(k,281) - lu(k,1268) * b(k,200) - b(k,282) = b(k,282) - lu(k,1269) * b(k,200) - b(k,223) = b(k,223) - lu(k,1271) * b(k,201) - b(k,276) = b(k,276) - lu(k,1272) * b(k,201) - b(k,278) = b(k,278) - lu(k,1273) * b(k,201) - b(k,281) = b(k,281) - lu(k,1274) * b(k,201) - b(k,282) = b(k,282) - lu(k,1275) * b(k,201) - b(k,208) = b(k,208) - lu(k,1286) * b(k,202) - b(k,223) = b(k,223) - lu(k,1287) * b(k,202) - b(k,224) = b(k,224) - lu(k,1288) * b(k,202) - b(k,225) = b(k,225) - lu(k,1289) * b(k,202) - b(k,232) = b(k,232) - lu(k,1290) * b(k,202) - b(k,235) = b(k,235) - lu(k,1291) * b(k,202) - b(k,236) = b(k,236) - lu(k,1292) * b(k,202) - b(k,237) = b(k,237) - lu(k,1293) * b(k,202) - b(k,239) = b(k,239) - lu(k,1294) * b(k,202) - b(k,241) = b(k,241) - lu(k,1295) * b(k,202) - b(k,246) = b(k,246) - lu(k,1296) * b(k,202) - b(k,269) = b(k,269) - lu(k,1297) * b(k,202) - b(k,273) = b(k,273) - lu(k,1298) * b(k,202) - b(k,274) = b(k,274) - lu(k,1299) * b(k,202) - b(k,276) = b(k,276) - lu(k,1300) * b(k,202) - b(k,278) = b(k,278) - lu(k,1301) * b(k,202) - b(k,279) = b(k,279) - lu(k,1302) * b(k,202) - b(k,282) = b(k,282) - lu(k,1303) * b(k,202) - b(k,286) = b(k,286) - lu(k,1304) * b(k,202) - b(k,223) = b(k,223) - lu(k,1306) * b(k,203) - b(k,269) = b(k,269) - lu(k,1307) * b(k,203) - b(k,270) = b(k,270) - lu(k,1308) * b(k,203) - b(k,274) = b(k,274) - lu(k,1309) * b(k,203) - b(k,276) = b(k,276) - lu(k,1310) * b(k,203) - b(k,279) = b(k,279) - lu(k,1311) * b(k,203) - b(k,282) = b(k,282) - lu(k,1312) * b(k,203) - b(k,286) = b(k,286) - lu(k,1313) * b(k,203) - b(k,206) = b(k,206) - lu(k,1316) * b(k,204) - b(k,207) = b(k,207) - lu(k,1317) * b(k,204) - b(k,218) = b(k,218) - lu(k,1318) * b(k,204) - b(k,222) = b(k,222) - lu(k,1319) * b(k,204) - b(k,223) = b(k,223) - lu(k,1320) * b(k,204) - b(k,228) = b(k,228) - lu(k,1321) * b(k,204) - b(k,229) = b(k,229) - lu(k,1322) * b(k,204) - b(k,238) = b(k,238) - lu(k,1323) * b(k,204) - b(k,272) = b(k,272) - lu(k,1324) * b(k,204) - b(k,276) = b(k,276) - lu(k,1325) * b(k,204) - b(k,278) = b(k,278) - lu(k,1326) * b(k,204) - b(k,281) = b(k,281) - lu(k,1327) * b(k,204) - b(k,282) = b(k,282) - lu(k,1328) * b(k,204) - b(k,223) = b(k,223) - lu(k,1330) * b(k,205) - b(k,228) = b(k,228) - lu(k,1331) * b(k,205) - b(k,240) = b(k,240) - lu(k,1332) * b(k,205) - b(k,276) = b(k,276) - lu(k,1333) * b(k,205) - b(k,278) = b(k,278) - lu(k,1334) * b(k,205) - b(k,282) = b(k,282) - lu(k,1335) * b(k,205) - b(k,218) = b(k,218) - lu(k,1337) * b(k,206) - b(k,228) = b(k,228) - lu(k,1338) * b(k,206) - b(k,230) = b(k,230) - lu(k,1339) * b(k,206) - b(k,276) = b(k,276) - lu(k,1340) * b(k,206) - b(k,281) = b(k,281) - lu(k,1341) * b(k,206) - b(k,282) = b(k,282) - lu(k,1342) * b(k,206) - b(k,240) = b(k,240) - lu(k,1344) * b(k,207) - b(k,269) = b(k,269) - lu(k,1345) * b(k,207) - b(k,278) = b(k,278) - lu(k,1346) * b(k,207) - b(k,281) = b(k,281) - lu(k,1347) * b(k,207) - b(k,282) = b(k,282) - lu(k,1348) * b(k,207) - b(k,276) = b(k,276) - lu(k,1350) * b(k,208) - b(k,280) = b(k,280) - lu(k,1351) * b(k,208) - b(k,282) = b(k,282) - lu(k,1352) * b(k,208) - b(k,283) = b(k,283) - lu(k,1353) * b(k,208) - b(k,285) = b(k,285) - lu(k,1354) * b(k,208) - b(k,286) = b(k,286) - lu(k,1355) * b(k,208) - b(k,276) = b(k,276) - lu(k,1357) * b(k,209) - b(k,278) = b(k,278) - lu(k,1358) * b(k,209) - b(k,282) = b(k,282) - lu(k,1359) * b(k,209) - b(k,218) = b(k,218) - lu(k,1361) * b(k,210) - b(k,223) = b(k,223) - lu(k,1362) * b(k,210) - b(k,240) = b(k,240) - lu(k,1363) * b(k,210) - b(k,269) = b(k,269) - lu(k,1364) * b(k,210) - b(k,276) = b(k,276) - lu(k,1365) * b(k,210) - b(k,278) = b(k,278) - lu(k,1366) * b(k,210) - b(k,282) = b(k,282) - lu(k,1367) * b(k,210) - b(k,218) = b(k,218) - lu(k,1371) * b(k,211) - b(k,223) = b(k,223) - lu(k,1372) * b(k,211) - b(k,238) = b(k,238) - lu(k,1373) * b(k,211) - b(k,240) = b(k,240) - lu(k,1374) * b(k,211) - b(k,269) = b(k,269) - lu(k,1375) * b(k,211) - b(k,272) = b(k,272) - lu(k,1376) * b(k,211) - b(k,276) = b(k,276) - lu(k,1377) * b(k,211) - b(k,278) = b(k,278) - lu(k,1378) * b(k,211) - b(k,279) = b(k,279) - lu(k,1379) * b(k,211) - b(k,281) = b(k,281) - lu(k,1380) * b(k,211) - b(k,282) = b(k,282) - lu(k,1381) * b(k,211) - b(k,223) = b(k,223) - lu(k,1384) * b(k,212) - b(k,228) = b(k,228) - lu(k,1385) * b(k,212) - b(k,229) = b(k,229) - lu(k,1386) * b(k,212) - b(k,240) = b(k,240) - lu(k,1387) * b(k,212) - b(k,251) = b(k,251) - lu(k,1388) * b(k,212) - b(k,269) = b(k,269) - lu(k,1389) * b(k,212) - b(k,272) = b(k,272) - lu(k,1390) * b(k,212) - b(k,276) = b(k,276) - lu(k,1391) * b(k,212) - b(k,278) = b(k,278) - lu(k,1392) * b(k,212) - b(k,279) = b(k,279) - lu(k,1393) * b(k,212) - b(k,281) = b(k,281) - lu(k,1394) * b(k,212) - b(k,282) = b(k,282) - lu(k,1395) * b(k,212) - b(k,254) = b(k,254) - lu(k,1397) * b(k,213) - b(k,270) = b(k,270) - lu(k,1398) * b(k,213) - b(k,276) = b(k,276) - lu(k,1399) * b(k,213) - b(k,281) = b(k,281) - lu(k,1400) * b(k,213) - b(k,282) = b(k,282) - lu(k,1401) * b(k,213) - b(k,218) = b(k,218) - lu(k,1405) * b(k,214) - b(k,223) = b(k,223) - lu(k,1406) * b(k,214) - b(k,228) = b(k,228) - lu(k,1407) * b(k,214) - b(k,230) = b(k,230) - lu(k,1408) * b(k,214) - b(k,240) = b(k,240) - lu(k,1409) * b(k,214) - b(k,272) = b(k,272) - lu(k,1410) * b(k,214) - b(k,276) = b(k,276) - lu(k,1411) * b(k,214) - b(k,281) = b(k,281) - lu(k,1412) * b(k,214) - b(k,282) = b(k,282) - lu(k,1413) * b(k,214) + b(k,232) = b(k,232) - lu(k,1165) * b(k,208) + b(k,248) = b(k,248) - lu(k,1166) * b(k,208) + b(k,252) = b(k,252) - lu(k,1167) * b(k,208) + b(k,254) = b(k,254) - lu(k,1168) * b(k,208) + b(k,256) = b(k,256) - lu(k,1169) * b(k,208) + b(k,258) = b(k,258) - lu(k,1170) * b(k,208) + b(k,305) = b(k,305) - lu(k,1171) * b(k,208) + b(k,307) = b(k,307) - lu(k,1172) * b(k,208) + b(k,309) = b(k,309) - lu(k,1173) * b(k,208) + b(k,310) = b(k,310) - lu(k,1174) * b(k,208) + b(k,314) = b(k,314) - lu(k,1175) * b(k,208) + b(k,220) = b(k,220) - lu(k,1179) * b(k,209) + b(k,224) = b(k,224) - lu(k,1180) * b(k,209) + b(k,247) = b(k,247) - lu(k,1181) * b(k,209) + b(k,256) = b(k,256) - lu(k,1182) * b(k,209) + b(k,263) = b(k,263) - lu(k,1183) * b(k,209) + b(k,264) = b(k,264) - lu(k,1184) * b(k,209) + b(k,268) = b(k,268) - lu(k,1185) * b(k,209) + b(k,269) = b(k,269) - lu(k,1186) * b(k,209) + b(k,272) = b(k,272) - lu(k,1187) * b(k,209) + b(k,273) = b(k,273) - lu(k,1188) * b(k,209) + b(k,306) = b(k,306) - lu(k,1189) * b(k,209) + b(k,307) = b(k,307) - lu(k,1190) * b(k,209) + b(k,309) = b(k,309) - lu(k,1191) * b(k,209) + b(k,310) = b(k,310) - lu(k,1192) * b(k,209) + b(k,314) = b(k,314) - lu(k,1193) * b(k,209) + b(k,223) = b(k,223) - lu(k,1199) * b(k,210) + b(k,228) = b(k,228) - lu(k,1200) * b(k,210) + b(k,278) = b(k,278) - lu(k,1201) * b(k,210) + b(k,302) = b(k,302) - lu(k,1202) * b(k,210) + b(k,305) = b(k,305) - lu(k,1203) * b(k,210) + b(k,307) = b(k,307) - lu(k,1204) * b(k,210) + b(k,309) = b(k,309) - lu(k,1205) * b(k,210) + b(k,310) = b(k,310) - lu(k,1206) * b(k,210) + b(k,314) = b(k,314) - lu(k,1207) * b(k,210) + b(k,224) = b(k,224) - lu(k,1209) * b(k,211) + b(k,307) = b(k,307) - lu(k,1210) * b(k,211) + b(k,309) = b(k,309) - lu(k,1211) * b(k,211) + b(k,310) = b(k,310) - lu(k,1212) * b(k,211) + b(k,315) = b(k,315) - lu(k,1213) * b(k,211) + b(k,213) = b(k,213) - lu(k,1217) * b(k,212) + b(k,242) = b(k,242) - lu(k,1218) * b(k,212) + b(k,282) = b(k,282) - lu(k,1219) * b(k,212) + b(k,288) = b(k,288) - lu(k,1220) * b(k,212) + b(k,305) = b(k,305) - lu(k,1221) * b(k,212) + b(k,309) = b(k,309) - lu(k,1222) * b(k,212) + b(k,310) = b(k,310) - lu(k,1223) * b(k,212) + b(k,314) = b(k,314) - lu(k,1224) * b(k,212) + b(k,315) = b(k,315) - lu(k,1225) * b(k,212) + b(k,242) = b(k,242) - lu(k,1227) * b(k,213) + b(k,306) = b(k,306) - lu(k,1228) * b(k,213) + b(k,309) = b(k,309) - lu(k,1229) * b(k,213) + b(k,310) = b(k,310) - lu(k,1230) * b(k,213) + b(k,314) = b(k,314) - lu(k,1231) * b(k,213) + b(k,244) = b(k,244) - lu(k,1234) * b(k,214) + b(k,308) = b(k,308) - lu(k,1235) * b(k,214) + b(k,309) = b(k,309) - lu(k,1236) * b(k,214) + b(k,310) = b(k,310) - lu(k,1237) * b(k,214) + b(k,315) = b(k,315) - lu(k,1238) * b(k,214) + b(k,218) = b(k,218) - lu(k,1247) * b(k,215) + b(k,235) = b(k,235) - lu(k,1248) * b(k,215) + b(k,245) = b(k,245) - lu(k,1249) * b(k,215) + b(k,264) = b(k,264) - lu(k,1250) * b(k,215) + b(k,279) = b(k,279) - lu(k,1251) * b(k,215) + b(k,282) = b(k,282) - lu(k,1252) * b(k,215) + b(k,286) = b(k,286) - lu(k,1253) * b(k,215) + b(k,295) = b(k,295) - lu(k,1254) * b(k,215) + b(k,297) = b(k,297) - lu(k,1255) * b(k,215) + b(k,300) = b(k,300) - lu(k,1256) * b(k,215) + b(k,301) = b(k,301) - lu(k,1257) * b(k,215) + b(k,303) = b(k,303) - lu(k,1258) * b(k,215) + b(k,307) = b(k,307) - lu(k,1259) * b(k,215) + b(k,309) = b(k,309) - lu(k,1260) * b(k,215) + b(k,310) = b(k,310) - lu(k,1261) * b(k,215) + b(k,312) = b(k,312) - lu(k,1262) * b(k,215) + b(k,234) = b(k,234) - lu(k,1265) * b(k,216) + b(k,245) = b(k,245) - lu(k,1266) * b(k,216) + b(k,247) = b(k,247) - lu(k,1267) * b(k,216) + b(k,256) = b(k,256) - lu(k,1268) * b(k,216) + b(k,263) = b(k,263) - lu(k,1269) * b(k,216) + b(k,264) = b(k,264) - lu(k,1270) * b(k,216) + b(k,265) = b(k,265) - lu(k,1271) * b(k,216) + b(k,306) = b(k,306) - lu(k,1272) * b(k,216) + b(k,307) = b(k,307) - lu(k,1273) * b(k,216) + b(k,309) = b(k,309) - lu(k,1274) * b(k,216) + b(k,310) = b(k,310) - lu(k,1275) * b(k,216) + b(k,314) = b(k,314) - lu(k,1276) * b(k,216) + b(k,249) = b(k,249) - lu(k,1279) * b(k,217) + b(k,277) = b(k,277) - lu(k,1280) * b(k,217) + b(k,290) = b(k,290) - lu(k,1281) * b(k,217) + b(k,306) = b(k,306) - lu(k,1282) * b(k,217) + b(k,310) = b(k,310) - lu(k,1283) * b(k,217) + b(k,312) = b(k,312) - lu(k,1284) * b(k,217) + b(k,313) = b(k,313) - lu(k,1285) * b(k,217) + b(k,315) = b(k,315) - lu(k,1286) * b(k,217) + b(k,264) = b(k,264) - lu(k,1288) * b(k,218) + b(k,297) = b(k,297) - lu(k,1289) * b(k,218) + b(k,301) = b(k,301) - lu(k,1290) * b(k,218) + b(k,306) = b(k,306) - lu(k,1291) * b(k,218) + b(k,309) = b(k,309) - lu(k,1292) * b(k,218) + b(k,310) = b(k,310) - lu(k,1293) * b(k,218) + b(k,312) = b(k,312) - lu(k,1294) * b(k,218) + b(k,233) = b(k,233) - lu(k,1297) * b(k,219) + b(k,252) = b(k,252) - lu(k,1298) * b(k,219) + b(k,256) = b(k,256) - lu(k,1299) * b(k,219) + b(k,258) = b(k,258) - lu(k,1300) * b(k,219) + b(k,263) = b(k,263) - lu(k,1301) * b(k,219) + b(k,264) = b(k,264) - lu(k,1302) * b(k,219) + b(k,305) = b(k,305) - lu(k,1303) * b(k,219) + b(k,309) = b(k,309) - lu(k,1304) * b(k,219) + b(k,310) = b(k,310) - lu(k,1305) * b(k,219) + b(k,314) = b(k,314) - lu(k,1306) * b(k,219) + b(k,230) = b(k,230) - lu(k,1308) * b(k,220) + b(k,232) = b(k,232) - lu(k,1309) * b(k,220) + b(k,234) = b(k,234) - lu(k,1310) * b(k,220) + b(k,248) = b(k,248) - lu(k,1311) * b(k,220) + b(k,252) = b(k,252) - lu(k,1312) * b(k,220) + b(k,254) = b(k,254) - lu(k,1313) * b(k,220) + b(k,256) = b(k,256) - lu(k,1314) * b(k,220) + b(k,265) = b(k,265) - lu(k,1315) * b(k,220) + b(k,305) = b(k,305) - lu(k,1316) * b(k,220) + b(k,307) = b(k,307) - lu(k,1317) * b(k,220) + b(k,309) = b(k,309) - lu(k,1318) * b(k,220) + b(k,310) = b(k,310) - lu(k,1319) * b(k,220) + b(k,314) = b(k,314) - lu(k,1320) * b(k,220) + b(k,291) = b(k,291) - lu(k,1324) * b(k,221) + b(k,304) = b(k,304) - lu(k,1325) * b(k,221) + b(k,306) = b(k,306) - lu(k,1326) * b(k,221) + b(k,308) = b(k,308) - lu(k,1327) * b(k,221) + b(k,310) = b(k,310) - lu(k,1328) * b(k,221) + b(k,311) = b(k,311) - lu(k,1329) * b(k,221) + b(k,312) = b(k,312) - lu(k,1330) * b(k,221) + b(k,314) = b(k,314) - lu(k,1331) * b(k,221) + b(k,315) = b(k,315) - lu(k,1332) * b(k,221) + b(k,236) = b(k,236) - lu(k,1335) * b(k,222) + b(k,256) = b(k,256) - lu(k,1336) * b(k,222) + b(k,263) = b(k,263) - lu(k,1337) * b(k,222) + b(k,302) = b(k,302) - lu(k,1338) * b(k,222) + b(k,305) = b(k,305) - lu(k,1339) * b(k,222) + b(k,307) = b(k,307) - lu(k,1340) * b(k,222) + b(k,309) = b(k,309) - lu(k,1341) * b(k,222) + b(k,310) = b(k,310) - lu(k,1342) * b(k,222) + b(k,313) = b(k,313) - lu(k,1343) * b(k,222) + b(k,314) = b(k,314) - lu(k,1344) * b(k,222) + b(k,315) = b(k,315) - lu(k,1345) * b(k,222) + b(k,228) = b(k,228) - lu(k,1349) * b(k,223) + b(k,236) = b(k,236) - lu(k,1350) * b(k,223) + b(k,305) = b(k,305) - lu(k,1351) * b(k,223) + b(k,307) = b(k,307) - lu(k,1352) * b(k,223) + b(k,309) = b(k,309) - lu(k,1353) * b(k,223) + b(k,310) = b(k,310) - lu(k,1354) * b(k,223) + b(k,313) = b(k,313) - lu(k,1355) * b(k,223) + b(k,314) = b(k,314) - lu(k,1356) * b(k,223) + b(k,245) = b(k,245) - lu(k,1358) * b(k,224) + b(k,309) = b(k,309) - lu(k,1359) * b(k,224) + b(k,310) = b(k,310) - lu(k,1360) * b(k,224) + b(k,315) = b(k,315) - lu(k,1361) * b(k,224) + b(k,228) = b(k,228) - lu(k,1366) * b(k,225) + b(k,234) = b(k,234) - lu(k,1367) * b(k,225) + b(k,245) = b(k,245) - lu(k,1368) * b(k,225) + b(k,256) = b(k,256) - lu(k,1369) * b(k,225) + b(k,264) = b(k,264) - lu(k,1370) * b(k,225) + b(k,277) = b(k,277) - lu(k,1371) * b(k,225) + b(k,303) = b(k,303) - lu(k,1372) * b(k,225) + b(k,305) = b(k,305) - lu(k,1373) * b(k,225) + b(k,307) = b(k,307) - lu(k,1374) * b(k,225) + b(k,309) = b(k,309) - lu(k,1375) * b(k,225) + b(k,310) = b(k,310) - lu(k,1376) * b(k,225) + b(k,312) = b(k,312) - lu(k,1377) * b(k,225) + b(k,313) = b(k,313) - lu(k,1378) * b(k,225) + b(k,314) = b(k,314) - lu(k,1379) * b(k,225) + b(k,315) = b(k,315) - lu(k,1380) * b(k,225) + b(k,235) = b(k,235) - lu(k,1391) * b(k,226) + b(k,245) = b(k,245) - lu(k,1392) * b(k,226) + b(k,255) = b(k,255) - lu(k,1393) * b(k,226) + b(k,257) = b(k,257) - lu(k,1394) * b(k,226) + b(k,259) = b(k,259) - lu(k,1395) * b(k,226) + b(k,260) = b(k,260) - lu(k,1396) * b(k,226) + b(k,264) = b(k,264) - lu(k,1397) * b(k,226) + b(k,266) = b(k,266) - lu(k,1398) * b(k,226) + b(k,267) = b(k,267) - lu(k,1399) * b(k,226) + b(k,268) = b(k,268) - lu(k,1400) * b(k,226) + b(k,269) = b(k,269) - lu(k,1401) * b(k,226) + b(k,273) = b(k,273) - lu(k,1402) * b(k,226) + b(k,302) = b(k,302) - lu(k,1403) * b(k,226) + b(k,303) = b(k,303) - lu(k,1404) * b(k,226) + b(k,307) = b(k,307) - lu(k,1405) * b(k,226) + b(k,309) = b(k,309) - lu(k,1406) * b(k,226) + b(k,310) = b(k,310) - lu(k,1407) * b(k,226) + b(k,312) = b(k,312) - lu(k,1408) * b(k,226) + b(k,313) = b(k,313) - lu(k,1409) * b(k,226) + b(k,315) = b(k,315) - lu(k,1410) * b(k,226) + b(k,230) = b(k,230) - lu(k,1414) * b(k,227) + b(k,232) = b(k,232) - lu(k,1415) * b(k,227) + b(k,233) = b(k,233) - lu(k,1416) * b(k,227) + b(k,234) = b(k,234) - lu(k,1417) * b(k,227) + b(k,248) = b(k,248) - lu(k,1418) * b(k,227) + b(k,254) = b(k,254) - lu(k,1419) * b(k,227) + b(k,263) = b(k,263) - lu(k,1420) * b(k,227) + b(k,264) = b(k,264) - lu(k,1421) * b(k,227) + b(k,265) = b(k,265) - lu(k,1422) * b(k,227) + b(k,302) = b(k,302) - lu(k,1423) * b(k,227) + b(k,305) = b(k,305) - lu(k,1424) * b(k,227) + b(k,307) = b(k,307) - lu(k,1425) * b(k,227) + b(k,309) = b(k,309) - lu(k,1426) * b(k,227) + b(k,310) = b(k,310) - lu(k,1427) * b(k,227) + b(k,314) = b(k,314) - lu(k,1428) * b(k,227) end do end subroutine lu_slv05 subroutine lu_slv06( avec_len, lu, b ) @@ -1143,214 +1147,210 @@ subroutine lu_slv06( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,270) = b(k,270) - lu(k,1417) * b(k,215) - b(k,271) = b(k,271) - lu(k,1418) * b(k,215) - b(k,274) = b(k,274) - lu(k,1419) * b(k,215) - b(k,275) = b(k,275) - lu(k,1420) * b(k,215) - b(k,279) = b(k,279) - lu(k,1421) * b(k,215) - b(k,280) = b(k,280) - lu(k,1422) * b(k,215) - b(k,282) = b(k,282) - lu(k,1423) * b(k,215) - b(k,283) = b(k,283) - lu(k,1424) * b(k,215) - b(k,285) = b(k,285) - lu(k,1425) * b(k,215) - b(k,286) = b(k,286) - lu(k,1426) * b(k,215) - b(k,218) = b(k,218) - lu(k,1440) * b(k,216) - b(k,219) = b(k,219) - lu(k,1441) * b(k,216) - b(k,222) = b(k,222) - lu(k,1442) * b(k,216) - b(k,223) = b(k,223) - lu(k,1443) * b(k,216) - b(k,228) = b(k,228) - lu(k,1444) * b(k,216) - b(k,229) = b(k,229) - lu(k,1445) * b(k,216) - b(k,230) = b(k,230) - lu(k,1446) * b(k,216) - b(k,238) = b(k,238) - lu(k,1447) * b(k,216) - b(k,240) = b(k,240) - lu(k,1448) * b(k,216) - b(k,245) = b(k,245) - lu(k,1449) * b(k,216) - b(k,246) = b(k,246) - lu(k,1450) * b(k,216) - b(k,269) = b(k,269) - lu(k,1451) * b(k,216) - b(k,270) = b(k,270) - lu(k,1452) * b(k,216) - b(k,272) = b(k,272) - lu(k,1453) * b(k,216) - b(k,273) = b(k,273) - lu(k,1454) * b(k,216) - b(k,276) = b(k,276) - lu(k,1455) * b(k,216) - b(k,278) = b(k,278) - lu(k,1456) * b(k,216) - b(k,280) = b(k,280) - lu(k,1457) * b(k,216) - b(k,281) = b(k,281) - lu(k,1458) * b(k,216) - b(k,282) = b(k,282) - lu(k,1459) * b(k,216) - b(k,283) = b(k,283) - lu(k,1460) * b(k,216) - b(k,285) = b(k,285) - lu(k,1461) * b(k,216) - b(k,286) = b(k,286) - lu(k,1462) * b(k,216) - b(k,254) = b(k,254) - lu(k,1464) * b(k,217) - b(k,276) = b(k,276) - lu(k,1465) * b(k,217) - b(k,281) = b(k,281) - lu(k,1466) * b(k,217) - b(k,282) = b(k,282) - lu(k,1467) * b(k,217) - b(k,223) = b(k,223) - lu(k,1470) * b(k,218) - b(k,276) = b(k,276) - lu(k,1471) * b(k,218) - b(k,278) = b(k,278) - lu(k,1472) * b(k,218) - b(k,282) = b(k,282) - lu(k,1473) * b(k,218) - b(k,223) = b(k,223) - lu(k,1481) * b(k,219) - b(k,228) = b(k,228) - lu(k,1482) * b(k,219) - b(k,229) = b(k,229) - lu(k,1483) * b(k,219) - b(k,230) = b(k,230) - lu(k,1484) * b(k,219) - b(k,238) = b(k,238) - lu(k,1485) * b(k,219) - b(k,240) = b(k,240) - lu(k,1486) * b(k,219) - b(k,269) = b(k,269) - lu(k,1487) * b(k,219) - b(k,270) = b(k,270) - lu(k,1488) * b(k,219) - b(k,272) = b(k,272) - lu(k,1489) * b(k,219) - b(k,276) = b(k,276) - lu(k,1490) * b(k,219) - b(k,278) = b(k,278) - lu(k,1491) * b(k,219) - b(k,281) = b(k,281) - lu(k,1492) * b(k,219) - b(k,282) = b(k,282) - lu(k,1493) * b(k,219) - b(k,223) = b(k,223) - lu(k,1498) * b(k,220) - b(k,228) = b(k,228) - lu(k,1499) * b(k,220) - b(k,269) = b(k,269) - lu(k,1500) * b(k,220) - b(k,272) = b(k,272) - lu(k,1501) * b(k,220) - b(k,273) = b(k,273) - lu(k,1502) * b(k,220) - b(k,274) = b(k,274) - lu(k,1503) * b(k,220) - b(k,276) = b(k,276) - lu(k,1504) * b(k,220) - b(k,278) = b(k,278) - lu(k,1505) * b(k,220) - b(k,279) = b(k,279) - lu(k,1506) * b(k,220) - b(k,281) = b(k,281) - lu(k,1507) * b(k,220) - b(k,282) = b(k,282) - lu(k,1508) * b(k,220) - b(k,286) = b(k,286) - lu(k,1509) * b(k,220) - b(k,233) = b(k,233) - lu(k,1514) * b(k,221) - b(k,271) = b(k,271) - lu(k,1515) * b(k,221) - b(k,272) = b(k,272) - lu(k,1516) * b(k,221) - b(k,273) = b(k,273) - lu(k,1517) * b(k,221) - b(k,276) = b(k,276) - lu(k,1518) * b(k,221) - b(k,277) = b(k,277) - lu(k,1519) * b(k,221) - b(k,280) = b(k,280) - lu(k,1520) * b(k,221) - b(k,281) = b(k,281) - lu(k,1521) * b(k,221) - b(k,282) = b(k,282) - lu(k,1522) * b(k,221) - b(k,284) = b(k,284) - lu(k,1523) * b(k,221) - b(k,285) = b(k,285) - lu(k,1524) * b(k,221) - b(k,286) = b(k,286) - lu(k,1525) * b(k,221) - b(k,223) = b(k,223) - lu(k,1530) * b(k,222) - b(k,228) = b(k,228) - lu(k,1531) * b(k,222) - b(k,229) = b(k,229) - lu(k,1532) * b(k,222) - b(k,238) = b(k,238) - lu(k,1533) * b(k,222) - b(k,240) = b(k,240) - lu(k,1534) * b(k,222) - b(k,270) = b(k,270) - lu(k,1535) * b(k,222) - b(k,276) = b(k,276) - lu(k,1536) * b(k,222) - b(k,278) = b(k,278) - lu(k,1537) * b(k,222) - b(k,281) = b(k,281) - lu(k,1538) * b(k,222) - b(k,282) = b(k,282) - lu(k,1539) * b(k,222) - b(k,271) = b(k,271) - lu(k,1541) * b(k,223) - b(k,276) = b(k,276) - lu(k,1542) * b(k,223) - b(k,282) = b(k,282) - lu(k,1543) * b(k,223) - b(k,228) = b(k,228) - lu(k,1551) * b(k,224) - b(k,234) = b(k,234) - lu(k,1552) * b(k,224) - b(k,239) = b(k,239) - lu(k,1553) * b(k,224) - b(k,240) = b(k,240) - lu(k,1554) * b(k,224) - b(k,242) = b(k,242) - lu(k,1555) * b(k,224) - b(k,244) = b(k,244) - lu(k,1556) * b(k,224) - b(k,269) = b(k,269) - lu(k,1557) * b(k,224) - b(k,271) = b(k,271) - lu(k,1558) * b(k,224) - b(k,272) = b(k,272) - lu(k,1559) * b(k,224) - b(k,276) = b(k,276) - lu(k,1560) * b(k,224) - b(k,278) = b(k,278) - lu(k,1561) * b(k,224) - b(k,279) = b(k,279) - lu(k,1562) * b(k,224) - b(k,281) = b(k,281) - lu(k,1563) * b(k,224) - b(k,282) = b(k,282) - lu(k,1564) * b(k,224) - b(k,228) = b(k,228) - lu(k,1572) * b(k,225) - b(k,234) = b(k,234) - lu(k,1573) * b(k,225) - b(k,235) = b(k,235) - lu(k,1574) * b(k,225) - b(k,240) = b(k,240) - lu(k,1575) * b(k,225) - b(k,242) = b(k,242) - lu(k,1576) * b(k,225) - b(k,243) = b(k,243) - lu(k,1577) * b(k,225) - b(k,269) = b(k,269) - lu(k,1578) * b(k,225) - b(k,271) = b(k,271) - lu(k,1579) * b(k,225) - b(k,272) = b(k,272) - lu(k,1580) * b(k,225) - b(k,276) = b(k,276) - lu(k,1581) * b(k,225) - b(k,278) = b(k,278) - lu(k,1582) * b(k,225) - b(k,279) = b(k,279) - lu(k,1583) * b(k,225) - b(k,281) = b(k,281) - lu(k,1584) * b(k,225) - b(k,282) = b(k,282) - lu(k,1585) * b(k,225) - b(k,254) = b(k,254) - lu(k,1591) * b(k,226) - b(k,262) = b(k,262) - lu(k,1592) * b(k,226) - b(k,270) = b(k,270) - lu(k,1593) * b(k,226) - b(k,272) = b(k,272) - lu(k,1594) * b(k,226) - b(k,276) = b(k,276) - lu(k,1595) * b(k,226) - b(k,281) = b(k,281) - lu(k,1596) * b(k,226) - b(k,282) = b(k,282) - lu(k,1597) * b(k,226) - b(k,254) = b(k,254) - lu(k,1604) * b(k,227) - b(k,262) = b(k,262) - lu(k,1605) * b(k,227) - b(k,270) = b(k,270) - lu(k,1606) * b(k,227) - b(k,272) = b(k,272) - lu(k,1607) * b(k,227) - b(k,276) = b(k,276) - lu(k,1608) * b(k,227) - b(k,281) = b(k,281) - lu(k,1609) * b(k,227) - b(k,282) = b(k,282) - lu(k,1610) * b(k,227) - b(k,240) = b(k,240) - lu(k,1612) * b(k,228) - b(k,269) = b(k,269) - lu(k,1613) * b(k,228) - b(k,276) = b(k,276) - lu(k,1614) * b(k,228) - b(k,278) = b(k,278) - lu(k,1615) * b(k,228) - b(k,282) = b(k,282) - lu(k,1616) * b(k,228) - b(k,240) = b(k,240) - lu(k,1621) * b(k,229) - b(k,269) = b(k,269) - lu(k,1622) * b(k,229) - b(k,271) = b(k,271) - lu(k,1623) * b(k,229) - b(k,276) = b(k,276) - lu(k,1624) * b(k,229) - b(k,278) = b(k,278) - lu(k,1625) * b(k,229) - b(k,281) = b(k,281) - lu(k,1626) * b(k,229) - b(k,282) = b(k,282) - lu(k,1627) * b(k,229) - b(k,238) = b(k,238) - lu(k,1636) * b(k,230) - b(k,240) = b(k,240) - lu(k,1637) * b(k,230) - b(k,269) = b(k,269) - lu(k,1638) * b(k,230) - b(k,271) = b(k,271) - lu(k,1639) * b(k,230) - b(k,276) = b(k,276) - lu(k,1640) * b(k,230) - b(k,278) = b(k,278) - lu(k,1641) * b(k,230) - b(k,281) = b(k,281) - lu(k,1642) * b(k,230) - b(k,282) = b(k,282) - lu(k,1643) * b(k,230) - b(k,264) = b(k,264) - lu(k,1646) * b(k,231) - b(k,267) = b(k,267) - lu(k,1647) * b(k,231) - b(k,270) = b(k,270) - lu(k,1648) * b(k,231) - b(k,271) = b(k,271) - lu(k,1649) * b(k,231) - b(k,274) = b(k,274) - lu(k,1650) * b(k,231) - b(k,276) = b(k,276) - lu(k,1651) * b(k,231) - b(k,282) = b(k,282) - lu(k,1652) * b(k,231) - b(k,234) = b(k,234) - lu(k,1668) * b(k,232) - b(k,235) = b(k,235) - lu(k,1669) * b(k,232) - b(k,236) = b(k,236) - lu(k,1670) * b(k,232) - b(k,240) = b(k,240) - lu(k,1671) * b(k,232) - b(k,242) = b(k,242) - lu(k,1672) * b(k,232) - b(k,243) = b(k,243) - lu(k,1673) * b(k,232) - b(k,251) = b(k,251) - lu(k,1674) * b(k,232) - b(k,269) = b(k,269) - lu(k,1675) * b(k,232) - b(k,271) = b(k,271) - lu(k,1676) * b(k,232) - b(k,272) = b(k,272) - lu(k,1677) * b(k,232) - b(k,276) = b(k,276) - lu(k,1678) * b(k,232) - b(k,278) = b(k,278) - lu(k,1679) * b(k,232) - b(k,279) = b(k,279) - lu(k,1680) * b(k,232) - b(k,281) = b(k,281) - lu(k,1681) * b(k,232) - b(k,282) = b(k,282) - lu(k,1682) * b(k,232) - b(k,271) = b(k,271) - lu(k,1686) * b(k,233) - b(k,273) = b(k,273) - lu(k,1687) * b(k,233) - b(k,275) = b(k,275) - lu(k,1688) * b(k,233) - b(k,276) = b(k,276) - lu(k,1689) * b(k,233) - b(k,278) = b(k,278) - lu(k,1690) * b(k,233) - b(k,280) = b(k,280) - lu(k,1691) * b(k,233) - b(k,282) = b(k,282) - lu(k,1692) * b(k,233) - b(k,284) = b(k,284) - lu(k,1693) * b(k,233) - b(k,286) = b(k,286) - lu(k,1694) * b(k,233) - b(k,238) = b(k,238) - lu(k,1701) * b(k,234) - b(k,240) = b(k,240) - lu(k,1702) * b(k,234) - b(k,269) = b(k,269) - lu(k,1703) * b(k,234) - b(k,271) = b(k,271) - lu(k,1704) * b(k,234) - b(k,272) = b(k,272) - lu(k,1705) * b(k,234) - b(k,276) = b(k,276) - lu(k,1706) * b(k,234) - b(k,278) = b(k,278) - lu(k,1707) * b(k,234) - b(k,281) = b(k,281) - lu(k,1708) * b(k,234) - b(k,282) = b(k,282) - lu(k,1709) * b(k,234) - b(k,236) = b(k,236) - lu(k,1730) * b(k,235) - b(k,238) = b(k,238) - lu(k,1731) * b(k,235) - b(k,240) = b(k,240) - lu(k,1732) * b(k,235) - b(k,242) = b(k,242) - lu(k,1733) * b(k,235) - b(k,243) = b(k,243) - lu(k,1734) * b(k,235) - b(k,251) = b(k,251) - lu(k,1735) * b(k,235) - b(k,269) = b(k,269) - lu(k,1736) * b(k,235) - b(k,270) = b(k,270) - lu(k,1737) * b(k,235) - b(k,271) = b(k,271) - lu(k,1738) * b(k,235) - b(k,272) = b(k,272) - lu(k,1739) * b(k,235) - b(k,276) = b(k,276) - lu(k,1740) * b(k,235) - b(k,278) = b(k,278) - lu(k,1741) * b(k,235) - b(k,279) = b(k,279) - lu(k,1742) * b(k,235) - b(k,281) = b(k,281) - lu(k,1743) * b(k,235) - b(k,282) = b(k,282) - lu(k,1744) * b(k,235) + b(k,264) = b(k,264) - lu(k,1430) * b(k,228) + b(k,302) = b(k,302) - lu(k,1431) * b(k,228) + b(k,306) = b(k,306) - lu(k,1432) * b(k,228) + b(k,309) = b(k,309) - lu(k,1433) * b(k,228) + b(k,310) = b(k,310) - lu(k,1434) * b(k,228) + b(k,312) = b(k,312) - lu(k,1435) * b(k,228) + b(k,313) = b(k,313) - lu(k,1436) * b(k,228) + b(k,315) = b(k,315) - lu(k,1437) * b(k,228) + b(k,230) = b(k,230) - lu(k,1439) * b(k,229) + b(k,232) = b(k,232) - lu(k,1440) * b(k,229) + b(k,234) = b(k,234) - lu(k,1441) * b(k,229) + b(k,248) = b(k,248) - lu(k,1442) * b(k,229) + b(k,252) = b(k,252) - lu(k,1443) * b(k,229) + b(k,254) = b(k,254) - lu(k,1444) * b(k,229) + b(k,256) = b(k,256) - lu(k,1445) * b(k,229) + b(k,265) = b(k,265) - lu(k,1446) * b(k,229) + b(k,305) = b(k,305) - lu(k,1447) * b(k,229) + b(k,307) = b(k,307) - lu(k,1448) * b(k,229) + b(k,309) = b(k,309) - lu(k,1449) * b(k,229) + b(k,310) = b(k,310) - lu(k,1450) * b(k,229) + b(k,314) = b(k,314) - lu(k,1451) * b(k,229) + b(k,245) = b(k,245) - lu(k,1453) * b(k,230) + b(k,264) = b(k,264) - lu(k,1454) * b(k,230) + b(k,307) = b(k,307) - lu(k,1455) * b(k,230) + b(k,309) = b(k,309) - lu(k,1456) * b(k,230) + b(k,310) = b(k,310) - lu(k,1457) * b(k,230) + b(k,314) = b(k,314) - lu(k,1458) * b(k,230) + b(k,256) = b(k,256) - lu(k,1460) * b(k,231) + b(k,263) = b(k,263) - lu(k,1461) * b(k,231) + b(k,264) = b(k,264) - lu(k,1462) * b(k,231) + b(k,307) = b(k,307) - lu(k,1463) * b(k,231) + b(k,309) = b(k,309) - lu(k,1464) * b(k,231) + b(k,310) = b(k,310) - lu(k,1465) * b(k,231) + b(k,252) = b(k,252) - lu(k,1467) * b(k,232) + b(k,256) = b(k,256) - lu(k,1468) * b(k,232) + b(k,258) = b(k,258) - lu(k,1469) * b(k,232) + b(k,309) = b(k,309) - lu(k,1470) * b(k,232) + b(k,310) = b(k,310) - lu(k,1471) * b(k,232) + b(k,314) = b(k,314) - lu(k,1472) * b(k,232) + b(k,245) = b(k,245) - lu(k,1475) * b(k,233) + b(k,264) = b(k,264) - lu(k,1476) * b(k,233) + b(k,309) = b(k,309) - lu(k,1477) * b(k,233) + b(k,310) = b(k,310) - lu(k,1478) * b(k,233) + b(k,263) = b(k,263) - lu(k,1480) * b(k,234) + b(k,302) = b(k,302) - lu(k,1481) * b(k,234) + b(k,307) = b(k,307) - lu(k,1482) * b(k,234) + b(k,310) = b(k,310) - lu(k,1483) * b(k,234) + b(k,314) = b(k,314) - lu(k,1484) * b(k,234) + b(k,304) = b(k,304) - lu(k,1486) * b(k,235) + b(k,308) = b(k,308) - lu(k,1487) * b(k,235) + b(k,309) = b(k,309) - lu(k,1488) * b(k,235) + b(k,310) = b(k,310) - lu(k,1489) * b(k,235) + b(k,311) = b(k,311) - lu(k,1490) * b(k,235) + b(k,315) = b(k,315) - lu(k,1491) * b(k,235) + b(k,307) = b(k,307) - lu(k,1493) * b(k,236) + b(k,309) = b(k,309) - lu(k,1494) * b(k,236) + b(k,310) = b(k,310) - lu(k,1495) * b(k,236) + b(k,252) = b(k,252) - lu(k,1497) * b(k,237) + b(k,263) = b(k,263) - lu(k,1498) * b(k,237) + b(k,264) = b(k,264) - lu(k,1499) * b(k,237) + b(k,302) = b(k,302) - lu(k,1500) * b(k,237) + b(k,307) = b(k,307) - lu(k,1501) * b(k,237) + b(k,309) = b(k,309) - lu(k,1502) * b(k,237) + b(k,310) = b(k,310) - lu(k,1503) * b(k,237) + b(k,245) = b(k,245) - lu(k,1507) * b(k,238) + b(k,252) = b(k,252) - lu(k,1508) * b(k,238) + b(k,263) = b(k,263) - lu(k,1509) * b(k,238) + b(k,264) = b(k,264) - lu(k,1510) * b(k,238) + b(k,265) = b(k,265) - lu(k,1511) * b(k,238) + b(k,302) = b(k,302) - lu(k,1512) * b(k,238) + b(k,305) = b(k,305) - lu(k,1513) * b(k,238) + b(k,307) = b(k,307) - lu(k,1514) * b(k,238) + b(k,309) = b(k,309) - lu(k,1515) * b(k,238) + b(k,310) = b(k,310) - lu(k,1516) * b(k,238) + b(k,313) = b(k,313) - lu(k,1517) * b(k,238) + b(k,314) = b(k,314) - lu(k,1518) * b(k,238) + b(k,245) = b(k,245) - lu(k,1523) * b(k,239) + b(k,252) = b(k,252) - lu(k,1524) * b(k,239) + b(k,256) = b(k,256) - lu(k,1525) * b(k,239) + b(k,258) = b(k,258) - lu(k,1526) * b(k,239) + b(k,263) = b(k,263) - lu(k,1527) * b(k,239) + b(k,264) = b(k,264) - lu(k,1528) * b(k,239) + b(k,305) = b(k,305) - lu(k,1529) * b(k,239) + b(k,307) = b(k,307) - lu(k,1530) * b(k,239) + b(k,309) = b(k,309) - lu(k,1531) * b(k,239) + b(k,310) = b(k,310) - lu(k,1532) * b(k,239) + b(k,314) = b(k,314) - lu(k,1533) * b(k,239) + b(k,282) = b(k,282) - lu(k,1535) * b(k,240) + b(k,306) = b(k,306) - lu(k,1536) * b(k,240) + b(k,309) = b(k,309) - lu(k,1537) * b(k,240) + b(k,310) = b(k,310) - lu(k,1538) * b(k,240) + b(k,314) = b(k,314) - lu(k,1539) * b(k,240) + b(k,245) = b(k,245) - lu(k,1542) * b(k,241) + b(k,254) = b(k,254) - lu(k,1543) * b(k,241) + b(k,256) = b(k,256) - lu(k,1544) * b(k,241) + b(k,263) = b(k,263) - lu(k,1545) * b(k,241) + b(k,264) = b(k,264) - lu(k,1546) * b(k,241) + b(k,278) = b(k,278) - lu(k,1547) * b(k,241) + b(k,302) = b(k,302) - lu(k,1548) * b(k,241) + b(k,305) = b(k,305) - lu(k,1549) * b(k,241) + b(k,307) = b(k,307) - lu(k,1550) * b(k,241) + b(k,309) = b(k,309) - lu(k,1551) * b(k,241) + b(k,310) = b(k,310) - lu(k,1552) * b(k,241) + b(k,313) = b(k,313) - lu(k,1553) * b(k,241) + b(k,314) = b(k,314) - lu(k,1554) * b(k,241) + b(k,282) = b(k,282) - lu(k,1556) * b(k,242) + b(k,309) = b(k,309) - lu(k,1557) * b(k,242) + b(k,310) = b(k,310) - lu(k,1558) * b(k,242) + b(k,314) = b(k,314) - lu(k,1559) * b(k,242) + b(k,245) = b(k,245) - lu(k,1571) * b(k,243) + b(k,247) = b(k,247) - lu(k,1572) * b(k,243) + b(k,248) = b(k,248) - lu(k,1573) * b(k,243) + b(k,252) = b(k,252) - lu(k,1574) * b(k,243) + b(k,254) = b(k,254) - lu(k,1575) * b(k,243) + b(k,256) = b(k,256) - lu(k,1576) * b(k,243) + b(k,258) = b(k,258) - lu(k,1577) * b(k,243) + b(k,263) = b(k,263) - lu(k,1578) * b(k,243) + b(k,264) = b(k,264) - lu(k,1579) * b(k,243) + b(k,265) = b(k,265) - lu(k,1580) * b(k,243) + b(k,272) = b(k,272) - lu(k,1581) * b(k,243) + b(k,273) = b(k,273) - lu(k,1582) * b(k,243) + b(k,302) = b(k,302) - lu(k,1583) * b(k,243) + b(k,303) = b(k,303) - lu(k,1584) * b(k,243) + b(k,304) = b(k,304) - lu(k,1585) * b(k,243) + b(k,305) = b(k,305) - lu(k,1586) * b(k,243) + b(k,306) = b(k,306) - lu(k,1587) * b(k,243) + b(k,307) = b(k,307) - lu(k,1588) * b(k,243) + b(k,308) = b(k,308) - lu(k,1589) * b(k,243) + b(k,309) = b(k,309) - lu(k,1590) * b(k,243) + b(k,310) = b(k,310) - lu(k,1591) * b(k,243) + b(k,311) = b(k,311) - lu(k,1592) * b(k,243) + b(k,314) = b(k,314) - lu(k,1593) * b(k,243) + b(k,315) = b(k,315) - lu(k,1594) * b(k,243) + b(k,274) = b(k,274) - lu(k,1599) * b(k,244) + b(k,289) = b(k,289) - lu(k,1600) * b(k,244) + b(k,290) = b(k,290) - lu(k,1601) * b(k,244) + b(k,291) = b(k,291) - lu(k,1602) * b(k,244) + b(k,303) = b(k,303) - lu(k,1603) * b(k,244) + b(k,305) = b(k,305) - lu(k,1604) * b(k,244) + b(k,308) = b(k,308) - lu(k,1605) * b(k,244) + b(k,309) = b(k,309) - lu(k,1606) * b(k,244) + b(k,310) = b(k,310) - lu(k,1607) * b(k,244) + b(k,311) = b(k,311) - lu(k,1608) * b(k,244) + b(k,314) = b(k,314) - lu(k,1609) * b(k,244) + b(k,315) = b(k,315) - lu(k,1610) * b(k,244) + b(k,264) = b(k,264) - lu(k,1612) * b(k,245) + b(k,308) = b(k,308) - lu(k,1613) * b(k,245) + b(k,256) = b(k,256) - lu(k,1619) * b(k,246) + b(k,264) = b(k,264) - lu(k,1620) * b(k,246) + b(k,302) = b(k,302) - lu(k,1621) * b(k,246) + b(k,303) = b(k,303) - lu(k,1622) * b(k,246) + b(k,305) = b(k,305) - lu(k,1623) * b(k,246) + b(k,307) = b(k,307) - lu(k,1624) * b(k,246) + b(k,308) = b(k,308) - lu(k,1625) * b(k,246) + b(k,309) = b(k,309) - lu(k,1626) * b(k,246) + b(k,310) = b(k,310) - lu(k,1627) * b(k,246) + b(k,312) = b(k,312) - lu(k,1628) * b(k,246) + b(k,313) = b(k,313) - lu(k,1629) * b(k,246) + b(k,314) = b(k,314) - lu(k,1630) * b(k,246) + b(k,315) = b(k,315) - lu(k,1631) * b(k,246) + b(k,252) = b(k,252) - lu(k,1639) * b(k,247) + b(k,254) = b(k,254) - lu(k,1640) * b(k,247) + b(k,256) = b(k,256) - lu(k,1641) * b(k,247) + b(k,258) = b(k,258) - lu(k,1642) * b(k,247) + b(k,263) = b(k,263) - lu(k,1643) * b(k,247) + b(k,264) = b(k,264) - lu(k,1644) * b(k,247) + b(k,265) = b(k,265) - lu(k,1645) * b(k,247) + b(k,302) = b(k,302) - lu(k,1646) * b(k,247) + b(k,305) = b(k,305) - lu(k,1647) * b(k,247) + b(k,306) = b(k,306) - lu(k,1648) * b(k,247) + b(k,307) = b(k,307) - lu(k,1649) * b(k,247) + b(k,308) = b(k,308) - lu(k,1650) * b(k,247) + b(k,309) = b(k,309) - lu(k,1651) * b(k,247) + b(k,310) = b(k,310) - lu(k,1652) * b(k,247) + b(k,314) = b(k,314) - lu(k,1653) * b(k,247) + b(k,252) = b(k,252) - lu(k,1658) * b(k,248) + b(k,254) = b(k,254) - lu(k,1659) * b(k,248) + b(k,256) = b(k,256) - lu(k,1660) * b(k,248) + b(k,263) = b(k,263) - lu(k,1661) * b(k,248) + b(k,264) = b(k,264) - lu(k,1662) * b(k,248) + b(k,265) = b(k,265) - lu(k,1663) * b(k,248) + b(k,306) = b(k,306) - lu(k,1664) * b(k,248) + b(k,308) = b(k,308) - lu(k,1665) * b(k,248) + b(k,309) = b(k,309) - lu(k,1666) * b(k,248) + b(k,310) = b(k,310) - lu(k,1667) * b(k,248) + b(k,314) = b(k,314) - lu(k,1668) * b(k,248) + b(k,277) = b(k,277) - lu(k,1672) * b(k,249) + b(k,290) = b(k,290) - lu(k,1673) * b(k,249) + b(k,292) = b(k,292) - lu(k,1674) * b(k,249) + b(k,304) = b(k,304) - lu(k,1675) * b(k,249) + b(k,306) = b(k,306) - lu(k,1676) * b(k,249) + b(k,308) = b(k,308) - lu(k,1677) * b(k,249) + b(k,310) = b(k,310) - lu(k,1678) * b(k,249) + b(k,311) = b(k,311) - lu(k,1679) * b(k,249) + b(k,312) = b(k,312) - lu(k,1680) * b(k,249) + b(k,313) = b(k,313) - lu(k,1681) * b(k,249) + b(k,315) = b(k,315) - lu(k,1682) * b(k,249) + b(k,282) = b(k,282) - lu(k,1688) * b(k,250) + b(k,293) = b(k,293) - lu(k,1689) * b(k,250) + b(k,305) = b(k,305) - lu(k,1690) * b(k,250) + b(k,306) = b(k,306) - lu(k,1691) * b(k,250) + b(k,309) = b(k,309) - lu(k,1692) * b(k,250) + b(k,310) = b(k,310) - lu(k,1693) * b(k,250) + b(k,314) = b(k,314) - lu(k,1694) * b(k,250) end do end subroutine lu_slv06 subroutine lu_slv07( avec_len, lu, b ) @@ -1371,217 +1371,209 @@ subroutine lu_slv07( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,240) = b(k,240) - lu(k,1752) * b(k,236) - b(k,251) = b(k,251) - lu(k,1753) * b(k,236) - b(k,269) = b(k,269) - lu(k,1754) * b(k,236) - b(k,271) = b(k,271) - lu(k,1755) * b(k,236) - b(k,272) = b(k,272) - lu(k,1756) * b(k,236) - b(k,273) = b(k,273) - lu(k,1757) * b(k,236) - b(k,274) = b(k,274) - lu(k,1758) * b(k,236) - b(k,276) = b(k,276) - lu(k,1759) * b(k,236) - b(k,278) = b(k,278) - lu(k,1760) * b(k,236) - b(k,279) = b(k,279) - lu(k,1761) * b(k,236) - b(k,281) = b(k,281) - lu(k,1762) * b(k,236) - b(k,282) = b(k,282) - lu(k,1763) * b(k,236) - b(k,286) = b(k,286) - lu(k,1764) * b(k,236) - b(k,238) = b(k,238) - lu(k,1781) * b(k,237) - b(k,239) = b(k,239) - lu(k,1782) * b(k,237) - b(k,240) = b(k,240) - lu(k,1783) * b(k,237) - b(k,241) = b(k,241) - lu(k,1784) * b(k,237) - b(k,242) = b(k,242) - lu(k,1785) * b(k,237) - b(k,244) = b(k,244) - lu(k,1786) * b(k,237) - b(k,269) = b(k,269) - lu(k,1787) * b(k,237) - b(k,271) = b(k,271) - lu(k,1788) * b(k,237) - b(k,272) = b(k,272) - lu(k,1789) * b(k,237) - b(k,276) = b(k,276) - lu(k,1790) * b(k,237) - b(k,278) = b(k,278) - lu(k,1791) * b(k,237) - b(k,279) = b(k,279) - lu(k,1792) * b(k,237) - b(k,281) = b(k,281) - lu(k,1793) * b(k,237) - b(k,282) = b(k,282) - lu(k,1794) * b(k,237) - b(k,286) = b(k,286) - lu(k,1795) * b(k,237) - b(k,240) = b(k,240) - lu(k,1802) * b(k,238) - b(k,269) = b(k,269) - lu(k,1803) * b(k,238) - b(k,270) = b(k,270) - lu(k,1804) * b(k,238) - b(k,271) = b(k,271) - lu(k,1805) * b(k,238) - b(k,276) = b(k,276) - lu(k,1806) * b(k,238) - b(k,278) = b(k,278) - lu(k,1807) * b(k,238) - b(k,281) = b(k,281) - lu(k,1808) * b(k,238) - b(k,282) = b(k,282) - lu(k,1809) * b(k,238) - b(k,240) = b(k,240) - lu(k,1830) * b(k,239) - b(k,241) = b(k,241) - lu(k,1831) * b(k,239) - b(k,242) = b(k,242) - lu(k,1832) * b(k,239) - b(k,244) = b(k,244) - lu(k,1833) * b(k,239) - b(k,269) = b(k,269) - lu(k,1834) * b(k,239) - b(k,270) = b(k,270) - lu(k,1835) * b(k,239) - b(k,271) = b(k,271) - lu(k,1836) * b(k,239) - b(k,272) = b(k,272) - lu(k,1837) * b(k,239) - b(k,276) = b(k,276) - lu(k,1838) * b(k,239) - b(k,278) = b(k,278) - lu(k,1839) * b(k,239) - b(k,279) = b(k,279) - lu(k,1840) * b(k,239) - b(k,281) = b(k,281) - lu(k,1841) * b(k,239) - b(k,282) = b(k,282) - lu(k,1842) * b(k,239) - b(k,286) = b(k,286) - lu(k,1843) * b(k,239) - b(k,269) = b(k,269) - lu(k,1846) * b(k,240) - b(k,270) = b(k,270) - lu(k,1847) * b(k,240) - b(k,271) = b(k,271) - lu(k,1848) * b(k,240) - b(k,274) = b(k,274) - lu(k,1849) * b(k,240) - b(k,276) = b(k,276) - lu(k,1850) * b(k,240) - b(k,282) = b(k,282) - lu(k,1851) * b(k,240) - b(k,286) = b(k,286) - lu(k,1852) * b(k,240) - b(k,269) = b(k,269) - lu(k,1864) * b(k,241) - b(k,270) = b(k,270) - lu(k,1865) * b(k,241) - b(k,271) = b(k,271) - lu(k,1866) * b(k,241) - b(k,272) = b(k,272) - lu(k,1867) * b(k,241) - b(k,273) = b(k,273) - lu(k,1868) * b(k,241) - b(k,274) = b(k,274) - lu(k,1869) * b(k,241) - b(k,276) = b(k,276) - lu(k,1870) * b(k,241) - b(k,278) = b(k,278) - lu(k,1871) * b(k,241) - b(k,279) = b(k,279) - lu(k,1872) * b(k,241) - b(k,281) = b(k,281) - lu(k,1873) * b(k,241) - b(k,282) = b(k,282) - lu(k,1874) * b(k,241) - b(k,286) = b(k,286) - lu(k,1875) * b(k,241) - b(k,243) = b(k,243) - lu(k,1897) * b(k,242) - b(k,244) = b(k,244) - lu(k,1898) * b(k,242) - b(k,251) = b(k,251) - lu(k,1899) * b(k,242) - b(k,269) = b(k,269) - lu(k,1900) * b(k,242) - b(k,270) = b(k,270) - lu(k,1901) * b(k,242) - b(k,271) = b(k,271) - lu(k,1902) * b(k,242) - b(k,272) = b(k,272) - lu(k,1903) * b(k,242) - b(k,273) = b(k,273) - lu(k,1904) * b(k,242) - b(k,274) = b(k,274) - lu(k,1905) * b(k,242) - b(k,276) = b(k,276) - lu(k,1906) * b(k,242) - b(k,278) = b(k,278) - lu(k,1907) * b(k,242) - b(k,279) = b(k,279) - lu(k,1908) * b(k,242) - b(k,281) = b(k,281) - lu(k,1909) * b(k,242) - b(k,282) = b(k,282) - lu(k,1910) * b(k,242) - b(k,286) = b(k,286) - lu(k,1911) * b(k,242) - b(k,245) = b(k,245) - lu(k,1931) * b(k,243) - b(k,269) = b(k,269) - lu(k,1932) * b(k,243) - b(k,270) = b(k,270) - lu(k,1933) * b(k,243) - b(k,271) = b(k,271) - lu(k,1934) * b(k,243) - b(k,272) = b(k,272) - lu(k,1935) * b(k,243) - b(k,273) = b(k,273) - lu(k,1936) * b(k,243) - b(k,274) = b(k,274) - lu(k,1937) * b(k,243) - b(k,276) = b(k,276) - lu(k,1938) * b(k,243) - b(k,278) = b(k,278) - lu(k,1939) * b(k,243) - b(k,280) = b(k,280) - lu(k,1940) * b(k,243) - b(k,281) = b(k,281) - lu(k,1941) * b(k,243) - b(k,282) = b(k,282) - lu(k,1942) * b(k,243) - b(k,283) = b(k,283) - lu(k,1943) * b(k,243) - b(k,285) = b(k,285) - lu(k,1944) * b(k,243) - b(k,286) = b(k,286) - lu(k,1945) * b(k,243) - b(k,245) = b(k,245) - lu(k,1965) * b(k,244) - b(k,269) = b(k,269) - lu(k,1966) * b(k,244) - b(k,270) = b(k,270) - lu(k,1967) * b(k,244) - b(k,271) = b(k,271) - lu(k,1968) * b(k,244) - b(k,272) = b(k,272) - lu(k,1969) * b(k,244) - b(k,273) = b(k,273) - lu(k,1970) * b(k,244) - b(k,274) = b(k,274) - lu(k,1971) * b(k,244) - b(k,276) = b(k,276) - lu(k,1972) * b(k,244) - b(k,278) = b(k,278) - lu(k,1973) * b(k,244) - b(k,280) = b(k,280) - lu(k,1974) * b(k,244) - b(k,281) = b(k,281) - lu(k,1975) * b(k,244) - b(k,282) = b(k,282) - lu(k,1976) * b(k,244) - b(k,283) = b(k,283) - lu(k,1977) * b(k,244) - b(k,285) = b(k,285) - lu(k,1978) * b(k,244) - b(k,286) = b(k,286) - lu(k,1979) * b(k,244) - b(k,269) = b(k,269) - lu(k,1994) * b(k,245) - b(k,270) = b(k,270) - lu(k,1995) * b(k,245) - b(k,271) = b(k,271) - lu(k,1996) * b(k,245) - b(k,272) = b(k,272) - lu(k,1997) * b(k,245) - b(k,273) = b(k,273) - lu(k,1998) * b(k,245) - b(k,274) = b(k,274) - lu(k,1999) * b(k,245) - b(k,276) = b(k,276) - lu(k,2000) * b(k,245) - b(k,278) = b(k,278) - lu(k,2001) * b(k,245) - b(k,280) = b(k,280) - lu(k,2002) * b(k,245) - b(k,281) = b(k,281) - lu(k,2003) * b(k,245) - b(k,282) = b(k,282) - lu(k,2004) * b(k,245) - b(k,283) = b(k,283) - lu(k,2005) * b(k,245) - b(k,285) = b(k,285) - lu(k,2006) * b(k,245) - b(k,286) = b(k,286) - lu(k,2007) * b(k,245) - b(k,251) = b(k,251) - lu(k,2035) * b(k,246) - b(k,269) = b(k,269) - lu(k,2036) * b(k,246) - b(k,270) = b(k,270) - lu(k,2037) * b(k,246) - b(k,271) = b(k,271) - lu(k,2038) * b(k,246) - b(k,272) = b(k,272) - lu(k,2039) * b(k,246) - b(k,273) = b(k,273) - lu(k,2040) * b(k,246) - b(k,274) = b(k,274) - lu(k,2041) * b(k,246) - b(k,276) = b(k,276) - lu(k,2042) * b(k,246) - b(k,278) = b(k,278) - lu(k,2043) * b(k,246) - b(k,279) = b(k,279) - lu(k,2044) * b(k,246) - b(k,280) = b(k,280) - lu(k,2045) * b(k,246) - b(k,281) = b(k,281) - lu(k,2046) * b(k,246) - b(k,282) = b(k,282) - lu(k,2047) * b(k,246) - b(k,283) = b(k,283) - lu(k,2048) * b(k,246) - b(k,285) = b(k,285) - lu(k,2049) * b(k,246) - b(k,286) = b(k,286) - lu(k,2050) * b(k,246) - b(k,261) = b(k,261) - lu(k,2054) * b(k,247) - b(k,263) = b(k,263) - lu(k,2055) * b(k,247) - b(k,264) = b(k,264) - lu(k,2056) * b(k,247) - b(k,265) = b(k,265) - lu(k,2057) * b(k,247) - b(k,266) = b(k,266) - lu(k,2058) * b(k,247) - b(k,267) = b(k,267) - lu(k,2059) * b(k,247) - b(k,268) = b(k,268) - lu(k,2060) * b(k,247) - b(k,269) = b(k,269) - lu(k,2061) * b(k,247) - b(k,272) = b(k,272) - lu(k,2062) * b(k,247) - b(k,274) = b(k,274) - lu(k,2063) * b(k,247) - b(k,276) = b(k,276) - lu(k,2064) * b(k,247) - b(k,278) = b(k,278) - lu(k,2065) * b(k,247) - b(k,279) = b(k,279) - lu(k,2066) * b(k,247) - b(k,281) = b(k,281) - lu(k,2067) * b(k,247) - b(k,282) = b(k,282) - lu(k,2068) * b(k,247) - b(k,251) = b(k,251) - lu(k,2073) * b(k,248) - b(k,254) = b(k,254) - lu(k,2074) * b(k,248) - b(k,263) = b(k,263) - lu(k,2075) * b(k,248) - b(k,264) = b(k,264) - lu(k,2076) * b(k,248) - b(k,265) = b(k,265) - lu(k,2077) * b(k,248) - b(k,266) = b(k,266) - lu(k,2078) * b(k,248) - b(k,267) = b(k,267) - lu(k,2079) * b(k,248) - b(k,268) = b(k,268) - lu(k,2080) * b(k,248) - b(k,269) = b(k,269) - lu(k,2081) * b(k,248) - b(k,270) = b(k,270) - lu(k,2082) * b(k,248) - b(k,271) = b(k,271) - lu(k,2083) * b(k,248) - b(k,272) = b(k,272) - lu(k,2084) * b(k,248) - b(k,274) = b(k,274) - lu(k,2085) * b(k,248) - b(k,276) = b(k,276) - lu(k,2086) * b(k,248) - b(k,278) = b(k,278) - lu(k,2087) * b(k,248) - b(k,279) = b(k,279) - lu(k,2088) * b(k,248) - b(k,281) = b(k,281) - lu(k,2089) * b(k,248) - b(k,282) = b(k,282) - lu(k,2090) * b(k,248) - b(k,253) = b(k,253) - lu(k,2097) * b(k,249) - b(k,254) = b(k,254) - lu(k,2098) * b(k,249) - b(k,261) = b(k,261) - lu(k,2099) * b(k,249) - b(k,263) = b(k,263) - lu(k,2100) * b(k,249) - b(k,264) = b(k,264) - lu(k,2101) * b(k,249) - b(k,265) = b(k,265) - lu(k,2102) * b(k,249) - b(k,266) = b(k,266) - lu(k,2103) * b(k,249) - b(k,267) = b(k,267) - lu(k,2104) * b(k,249) - b(k,268) = b(k,268) - lu(k,2105) * b(k,249) - b(k,269) = b(k,269) - lu(k,2106) * b(k,249) - b(k,272) = b(k,272) - lu(k,2107) * b(k,249) - b(k,274) = b(k,274) - lu(k,2108) * b(k,249) - b(k,276) = b(k,276) - lu(k,2109) * b(k,249) - b(k,278) = b(k,278) - lu(k,2110) * b(k,249) - b(k,279) = b(k,279) - lu(k,2111) * b(k,249) - b(k,281) = b(k,281) - lu(k,2112) * b(k,249) - b(k,282) = b(k,282) - lu(k,2113) * b(k,249) - b(k,254) = b(k,254) - lu(k,2120) * b(k,250) - b(k,263) = b(k,263) - lu(k,2121) * b(k,250) - b(k,264) = b(k,264) - lu(k,2122) * b(k,250) - b(k,265) = b(k,265) - lu(k,2123) * b(k,250) - b(k,266) = b(k,266) - lu(k,2124) * b(k,250) - b(k,267) = b(k,267) - lu(k,2125) * b(k,250) - b(k,268) = b(k,268) - lu(k,2126) * b(k,250) - b(k,269) = b(k,269) - lu(k,2127) * b(k,250) - b(k,270) = b(k,270) - lu(k,2128) * b(k,250) - b(k,272) = b(k,272) - lu(k,2129) * b(k,250) - b(k,274) = b(k,274) - lu(k,2130) * b(k,250) - b(k,276) = b(k,276) - lu(k,2131) * b(k,250) - b(k,278) = b(k,278) - lu(k,2132) * b(k,250) - b(k,279) = b(k,279) - lu(k,2133) * b(k,250) - b(k,281) = b(k,281) - lu(k,2134) * b(k,250) - b(k,282) = b(k,282) - lu(k,2135) * b(k,250) - b(k,286) = b(k,286) - lu(k,2136) * b(k,250) + b(k,282) = b(k,282) - lu(k,1701) * b(k,251) + b(k,293) = b(k,293) - lu(k,1702) * b(k,251) + b(k,305) = b(k,305) - lu(k,1703) * b(k,251) + b(k,306) = b(k,306) - lu(k,1704) * b(k,251) + b(k,309) = b(k,309) - lu(k,1705) * b(k,251) + b(k,310) = b(k,310) - lu(k,1706) * b(k,251) + b(k,314) = b(k,314) - lu(k,1707) * b(k,251) + b(k,264) = b(k,264) - lu(k,1711) * b(k,252) + b(k,307) = b(k,307) - lu(k,1712) * b(k,252) + b(k,308) = b(k,308) - lu(k,1713) * b(k,252) + b(k,309) = b(k,309) - lu(k,1714) * b(k,252) + b(k,310) = b(k,310) - lu(k,1715) * b(k,252) + b(k,264) = b(k,264) - lu(k,1717) * b(k,253) + b(k,296) = b(k,296) - lu(k,1718) * b(k,253) + b(k,299) = b(k,299) - lu(k,1719) * b(k,253) + b(k,306) = b(k,306) - lu(k,1720) * b(k,253) + b(k,309) = b(k,309) - lu(k,1721) * b(k,253) + b(k,310) = b(k,310) - lu(k,1722) * b(k,253) + b(k,312) = b(k,312) - lu(k,1723) * b(k,253) + b(k,256) = b(k,256) - lu(k,1726) * b(k,254) + b(k,263) = b(k,263) - lu(k,1727) * b(k,254) + b(k,264) = b(k,264) - lu(k,1728) * b(k,254) + b(k,302) = b(k,302) - lu(k,1729) * b(k,254) + b(k,307) = b(k,307) - lu(k,1730) * b(k,254) + b(k,309) = b(k,309) - lu(k,1731) * b(k,254) + b(k,310) = b(k,310) - lu(k,1732) * b(k,254) + b(k,314) = b(k,314) - lu(k,1733) * b(k,254) + b(k,256) = b(k,256) - lu(k,1741) * b(k,255) + b(k,261) = b(k,261) - lu(k,1742) * b(k,255) + b(k,262) = b(k,262) - lu(k,1743) * b(k,255) + b(k,263) = b(k,263) - lu(k,1744) * b(k,255) + b(k,264) = b(k,264) - lu(k,1745) * b(k,255) + b(k,266) = b(k,266) - lu(k,1746) * b(k,255) + b(k,270) = b(k,270) - lu(k,1747) * b(k,255) + b(k,302) = b(k,302) - lu(k,1748) * b(k,255) + b(k,305) = b(k,305) - lu(k,1749) * b(k,255) + b(k,307) = b(k,307) - lu(k,1750) * b(k,255) + b(k,308) = b(k,308) - lu(k,1751) * b(k,255) + b(k,309) = b(k,309) - lu(k,1752) * b(k,255) + b(k,310) = b(k,310) - lu(k,1753) * b(k,255) + b(k,313) = b(k,313) - lu(k,1754) * b(k,255) + b(k,314) = b(k,314) - lu(k,1755) * b(k,255) + b(k,263) = b(k,263) - lu(k,1757) * b(k,256) + b(k,302) = b(k,302) - lu(k,1758) * b(k,256) + b(k,307) = b(k,307) - lu(k,1759) * b(k,256) + b(k,309) = b(k,309) - lu(k,1760) * b(k,256) + b(k,310) = b(k,310) - lu(k,1761) * b(k,256) + b(k,261) = b(k,261) - lu(k,1770) * b(k,257) + b(k,262) = b(k,262) - lu(k,1771) * b(k,257) + b(k,263) = b(k,263) - lu(k,1772) * b(k,257) + b(k,264) = b(k,264) - lu(k,1773) * b(k,257) + b(k,267) = b(k,267) - lu(k,1774) * b(k,257) + b(k,271) = b(k,271) - lu(k,1775) * b(k,257) + b(k,302) = b(k,302) - lu(k,1776) * b(k,257) + b(k,305) = b(k,305) - lu(k,1777) * b(k,257) + b(k,307) = b(k,307) - lu(k,1778) * b(k,257) + b(k,308) = b(k,308) - lu(k,1779) * b(k,257) + b(k,309) = b(k,309) - lu(k,1780) * b(k,257) + b(k,310) = b(k,310) - lu(k,1781) * b(k,257) + b(k,313) = b(k,313) - lu(k,1782) * b(k,257) + b(k,314) = b(k,314) - lu(k,1783) * b(k,257) + b(k,263) = b(k,263) - lu(k,1792) * b(k,258) + b(k,264) = b(k,264) - lu(k,1793) * b(k,258) + b(k,265) = b(k,265) - lu(k,1794) * b(k,258) + b(k,302) = b(k,302) - lu(k,1795) * b(k,258) + b(k,307) = b(k,307) - lu(k,1796) * b(k,258) + b(k,308) = b(k,308) - lu(k,1797) * b(k,258) + b(k,309) = b(k,309) - lu(k,1798) * b(k,258) + b(k,310) = b(k,310) - lu(k,1799) * b(k,258) + b(k,314) = b(k,314) - lu(k,1800) * b(k,258) + b(k,261) = b(k,261) - lu(k,1816) * b(k,259) + b(k,262) = b(k,262) - lu(k,1817) * b(k,259) + b(k,263) = b(k,263) - lu(k,1818) * b(k,259) + b(k,264) = b(k,264) - lu(k,1819) * b(k,259) + b(k,267) = b(k,267) - lu(k,1820) * b(k,259) + b(k,268) = b(k,268) - lu(k,1821) * b(k,259) + b(k,271) = b(k,271) - lu(k,1822) * b(k,259) + b(k,278) = b(k,278) - lu(k,1823) * b(k,259) + b(k,302) = b(k,302) - lu(k,1824) * b(k,259) + b(k,305) = b(k,305) - lu(k,1825) * b(k,259) + b(k,307) = b(k,307) - lu(k,1826) * b(k,259) + b(k,308) = b(k,308) - lu(k,1827) * b(k,259) + b(k,309) = b(k,309) - lu(k,1828) * b(k,259) + b(k,310) = b(k,310) - lu(k,1829) * b(k,259) + b(k,313) = b(k,313) - lu(k,1830) * b(k,259) + b(k,314) = b(k,314) - lu(k,1831) * b(k,259) + b(k,261) = b(k,261) - lu(k,1847) * b(k,260) + b(k,262) = b(k,262) - lu(k,1848) * b(k,260) + b(k,263) = b(k,263) - lu(k,1849) * b(k,260) + b(k,264) = b(k,264) - lu(k,1850) * b(k,260) + b(k,265) = b(k,265) - lu(k,1851) * b(k,260) + b(k,266) = b(k,266) - lu(k,1852) * b(k,260) + b(k,269) = b(k,269) - lu(k,1853) * b(k,260) + b(k,270) = b(k,270) - lu(k,1854) * b(k,260) + b(k,302) = b(k,302) - lu(k,1855) * b(k,260) + b(k,305) = b(k,305) - lu(k,1856) * b(k,260) + b(k,307) = b(k,307) - lu(k,1857) * b(k,260) + b(k,308) = b(k,308) - lu(k,1858) * b(k,260) + b(k,309) = b(k,309) - lu(k,1859) * b(k,260) + b(k,310) = b(k,310) - lu(k,1860) * b(k,260) + b(k,313) = b(k,313) - lu(k,1861) * b(k,260) + b(k,314) = b(k,314) - lu(k,1862) * b(k,260) + b(k,315) = b(k,315) - lu(k,1863) * b(k,260) + b(k,263) = b(k,263) - lu(k,1871) * b(k,261) + b(k,264) = b(k,264) - lu(k,1872) * b(k,261) + b(k,265) = b(k,265) - lu(k,1873) * b(k,261) + b(k,302) = b(k,302) - lu(k,1874) * b(k,261) + b(k,305) = b(k,305) - lu(k,1875) * b(k,261) + b(k,307) = b(k,307) - lu(k,1876) * b(k,261) + b(k,308) = b(k,308) - lu(k,1877) * b(k,261) + b(k,309) = b(k,309) - lu(k,1878) * b(k,261) + b(k,310) = b(k,310) - lu(k,1879) * b(k,261) + b(k,314) = b(k,314) - lu(k,1880) * b(k,261) + b(k,263) = b(k,263) - lu(k,1895) * b(k,262) + b(k,264) = b(k,264) - lu(k,1896) * b(k,262) + b(k,265) = b(k,265) - lu(k,1897) * b(k,262) + b(k,266) = b(k,266) - lu(k,1898) * b(k,262) + b(k,267) = b(k,267) - lu(k,1899) * b(k,262) + b(k,268) = b(k,268) - lu(k,1900) * b(k,262) + b(k,269) = b(k,269) - lu(k,1901) * b(k,262) + b(k,302) = b(k,302) - lu(k,1902) * b(k,262) + b(k,305) = b(k,305) - lu(k,1903) * b(k,262) + b(k,307) = b(k,307) - lu(k,1904) * b(k,262) + b(k,308) = b(k,308) - lu(k,1905) * b(k,262) + b(k,309) = b(k,309) - lu(k,1906) * b(k,262) + b(k,310) = b(k,310) - lu(k,1907) * b(k,262) + b(k,314) = b(k,314) - lu(k,1908) * b(k,262) + b(k,264) = b(k,264) - lu(k,1910) * b(k,263) + b(k,302) = b(k,302) - lu(k,1911) * b(k,263) + b(k,306) = b(k,306) - lu(k,1912) * b(k,263) + b(k,309) = b(k,309) - lu(k,1913) * b(k,263) + b(k,310) = b(k,310) - lu(k,1914) * b(k,263) + b(k,312) = b(k,312) - lu(k,1915) * b(k,263) + b(k,315) = b(k,315) - lu(k,1916) * b(k,263) + b(k,308) = b(k,308) - lu(k,1919) * b(k,264) + b(k,309) = b(k,309) - lu(k,1920) * b(k,264) + b(k,310) = b(k,310) - lu(k,1921) * b(k,264) + b(k,302) = b(k,302) - lu(k,1930) * b(k,265) + b(k,306) = b(k,306) - lu(k,1931) * b(k,265) + b(k,307) = b(k,307) - lu(k,1932) * b(k,265) + b(k,308) = b(k,308) - lu(k,1933) * b(k,265) + b(k,309) = b(k,309) - lu(k,1934) * b(k,265) + b(k,310) = b(k,310) - lu(k,1935) * b(k,265) + b(k,312) = b(k,312) - lu(k,1936) * b(k,265) + b(k,314) = b(k,314) - lu(k,1937) * b(k,265) + b(k,315) = b(k,315) - lu(k,1938) * b(k,265) + b(k,267) = b(k,267) - lu(k,1960) * b(k,266) + b(k,268) = b(k,268) - lu(k,1961) * b(k,266) + b(k,269) = b(k,269) - lu(k,1962) * b(k,266) + b(k,270) = b(k,270) - lu(k,1963) * b(k,266) + b(k,302) = b(k,302) - lu(k,1964) * b(k,266) + b(k,305) = b(k,305) - lu(k,1965) * b(k,266) + b(k,306) = b(k,306) - lu(k,1966) * b(k,266) + b(k,307) = b(k,307) - lu(k,1967) * b(k,266) + b(k,308) = b(k,308) - lu(k,1968) * b(k,266) + b(k,309) = b(k,309) - lu(k,1969) * b(k,266) + b(k,310) = b(k,310) - lu(k,1970) * b(k,266) + b(k,312) = b(k,312) - lu(k,1971) * b(k,266) + b(k,313) = b(k,313) - lu(k,1972) * b(k,266) + b(k,314) = b(k,314) - lu(k,1973) * b(k,266) + b(k,315) = b(k,315) - lu(k,1974) * b(k,266) + b(k,268) = b(k,268) - lu(k,1998) * b(k,267) + b(k,269) = b(k,269) - lu(k,1999) * b(k,267) + b(k,270) = b(k,270) - lu(k,2000) * b(k,267) + b(k,271) = b(k,271) - lu(k,2001) * b(k,267) + b(k,278) = b(k,278) - lu(k,2002) * b(k,267) + b(k,302) = b(k,302) - lu(k,2003) * b(k,267) + b(k,305) = b(k,305) - lu(k,2004) * b(k,267) + b(k,306) = b(k,306) - lu(k,2005) * b(k,267) + b(k,307) = b(k,307) - lu(k,2006) * b(k,267) + b(k,308) = b(k,308) - lu(k,2007) * b(k,267) + b(k,309) = b(k,309) - lu(k,2008) * b(k,267) + b(k,310) = b(k,310) - lu(k,2009) * b(k,267) + b(k,312) = b(k,312) - lu(k,2010) * b(k,267) + b(k,313) = b(k,313) - lu(k,2011) * b(k,267) + b(k,314) = b(k,314) - lu(k,2012) * b(k,267) + b(k,315) = b(k,315) - lu(k,2013) * b(k,267) + b(k,278) = b(k,278) - lu(k,2023) * b(k,268) + b(k,302) = b(k,302) - lu(k,2024) * b(k,268) + b(k,303) = b(k,303) - lu(k,2025) * b(k,268) + b(k,305) = b(k,305) - lu(k,2026) * b(k,268) + b(k,306) = b(k,306) - lu(k,2027) * b(k,268) + b(k,307) = b(k,307) - lu(k,2028) * b(k,268) + b(k,308) = b(k,308) - lu(k,2029) * b(k,268) + b(k,309) = b(k,309) - lu(k,2030) * b(k,268) + b(k,310) = b(k,310) - lu(k,2031) * b(k,268) + b(k,312) = b(k,312) - lu(k,2032) * b(k,268) + b(k,313) = b(k,313) - lu(k,2033) * b(k,268) + b(k,314) = b(k,314) - lu(k,2034) * b(k,268) + b(k,315) = b(k,315) - lu(k,2035) * b(k,268) + b(k,277) = b(k,277) - lu(k,2048) * b(k,269) + b(k,302) = b(k,302) - lu(k,2049) * b(k,269) + b(k,303) = b(k,303) - lu(k,2050) * b(k,269) + b(k,305) = b(k,305) - lu(k,2051) * b(k,269) + b(k,306) = b(k,306) - lu(k,2052) * b(k,269) + b(k,307) = b(k,307) - lu(k,2053) * b(k,269) + b(k,308) = b(k,308) - lu(k,2054) * b(k,269) + b(k,309) = b(k,309) - lu(k,2055) * b(k,269) + b(k,310) = b(k,310) - lu(k,2056) * b(k,269) + b(k,312) = b(k,312) - lu(k,2057) * b(k,269) + b(k,313) = b(k,313) - lu(k,2058) * b(k,269) + b(k,314) = b(k,314) - lu(k,2059) * b(k,269) + b(k,315) = b(k,315) - lu(k,2060) * b(k,269) end do end subroutine lu_slv07 subroutine lu_slv08( avec_len, lu, b ) @@ -1602,217 +1594,225 @@ subroutine lu_slv08( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,269) = b(k,269) - lu(k,2142) * b(k,251) - b(k,270) = b(k,270) - lu(k,2143) * b(k,251) - b(k,271) = b(k,271) - lu(k,2144) * b(k,251) - b(k,272) = b(k,272) - lu(k,2145) * b(k,251) - b(k,274) = b(k,274) - lu(k,2146) * b(k,251) - b(k,276) = b(k,276) - lu(k,2147) * b(k,251) - b(k,278) = b(k,278) - lu(k,2148) * b(k,251) - b(k,279) = b(k,279) - lu(k,2149) * b(k,251) - b(k,281) = b(k,281) - lu(k,2150) * b(k,251) - b(k,282) = b(k,282) - lu(k,2151) * b(k,251) - b(k,286) = b(k,286) - lu(k,2152) * b(k,251) - b(k,253) = b(k,253) - lu(k,2157) * b(k,252) - b(k,254) = b(k,254) - lu(k,2158) * b(k,252) - b(k,262) = b(k,262) - lu(k,2159) * b(k,252) - b(k,263) = b(k,263) - lu(k,2160) * b(k,252) - b(k,264) = b(k,264) - lu(k,2161) * b(k,252) - b(k,265) = b(k,265) - lu(k,2162) * b(k,252) - b(k,266) = b(k,266) - lu(k,2163) * b(k,252) - b(k,267) = b(k,267) - lu(k,2164) * b(k,252) - b(k,268) = b(k,268) - lu(k,2165) * b(k,252) - b(k,269) = b(k,269) - lu(k,2166) * b(k,252) - b(k,270) = b(k,270) - lu(k,2167) * b(k,252) - b(k,272) = b(k,272) - lu(k,2168) * b(k,252) - b(k,274) = b(k,274) - lu(k,2169) * b(k,252) - b(k,276) = b(k,276) - lu(k,2170) * b(k,252) - b(k,278) = b(k,278) - lu(k,2171) * b(k,252) - b(k,279) = b(k,279) - lu(k,2172) * b(k,252) - b(k,281) = b(k,281) - lu(k,2173) * b(k,252) - b(k,282) = b(k,282) - lu(k,2174) * b(k,252) - b(k,254) = b(k,254) - lu(k,2180) * b(k,253) - b(k,262) = b(k,262) - lu(k,2181) * b(k,253) - b(k,264) = b(k,264) - lu(k,2182) * b(k,253) - b(k,267) = b(k,267) - lu(k,2183) * b(k,253) - b(k,270) = b(k,270) - lu(k,2184) * b(k,253) - b(k,271) = b(k,271) - lu(k,2185) * b(k,253) - b(k,272) = b(k,272) - lu(k,2186) * b(k,253) - b(k,274) = b(k,274) - lu(k,2187) * b(k,253) - b(k,276) = b(k,276) - lu(k,2188) * b(k,253) - b(k,278) = b(k,278) - lu(k,2189) * b(k,253) - b(k,281) = b(k,281) - lu(k,2190) * b(k,253) - b(k,282) = b(k,282) - lu(k,2191) * b(k,253) - b(k,263) = b(k,263) - lu(k,2194) * b(k,254) - b(k,265) = b(k,265) - lu(k,2195) * b(k,254) - b(k,268) = b(k,268) - lu(k,2196) * b(k,254) - b(k,270) = b(k,270) - lu(k,2197) * b(k,254) - b(k,271) = b(k,271) - lu(k,2198) * b(k,254) - b(k,274) = b(k,274) - lu(k,2199) * b(k,254) - b(k,276) = b(k,276) - lu(k,2200) * b(k,254) - b(k,282) = b(k,282) - lu(k,2201) * b(k,254) - b(k,262) = b(k,262) - lu(k,2215) * b(k,255) - b(k,263) = b(k,263) - lu(k,2216) * b(k,255) - b(k,264) = b(k,264) - lu(k,2217) * b(k,255) - b(k,265) = b(k,265) - lu(k,2218) * b(k,255) - b(k,266) = b(k,266) - lu(k,2219) * b(k,255) - b(k,267) = b(k,267) - lu(k,2220) * b(k,255) - b(k,268) = b(k,268) - lu(k,2221) * b(k,255) - b(k,269) = b(k,269) - lu(k,2222) * b(k,255) - b(k,270) = b(k,270) - lu(k,2223) * b(k,255) - b(k,271) = b(k,271) - lu(k,2224) * b(k,255) - b(k,272) = b(k,272) - lu(k,2225) * b(k,255) - b(k,274) = b(k,274) - lu(k,2226) * b(k,255) - b(k,276) = b(k,276) - lu(k,2227) * b(k,255) - b(k,278) = b(k,278) - lu(k,2228) * b(k,255) - b(k,279) = b(k,279) - lu(k,2229) * b(k,255) - b(k,281) = b(k,281) - lu(k,2230) * b(k,255) - b(k,282) = b(k,282) - lu(k,2231) * b(k,255) - b(k,286) = b(k,286) - lu(k,2232) * b(k,255) - b(k,262) = b(k,262) - lu(k,2244) * b(k,256) - b(k,263) = b(k,263) - lu(k,2245) * b(k,256) - b(k,264) = b(k,264) - lu(k,2246) * b(k,256) - b(k,265) = b(k,265) - lu(k,2247) * b(k,256) - b(k,266) = b(k,266) - lu(k,2248) * b(k,256) - b(k,267) = b(k,267) - lu(k,2249) * b(k,256) - b(k,268) = b(k,268) - lu(k,2250) * b(k,256) - b(k,269) = b(k,269) - lu(k,2251) * b(k,256) - b(k,270) = b(k,270) - lu(k,2252) * b(k,256) - b(k,271) = b(k,271) - lu(k,2253) * b(k,256) - b(k,272) = b(k,272) - lu(k,2254) * b(k,256) - b(k,274) = b(k,274) - lu(k,2255) * b(k,256) - b(k,276) = b(k,276) - lu(k,2256) * b(k,256) - b(k,278) = b(k,278) - lu(k,2257) * b(k,256) - b(k,279) = b(k,279) - lu(k,2258) * b(k,256) - b(k,281) = b(k,281) - lu(k,2259) * b(k,256) - b(k,282) = b(k,282) - lu(k,2260) * b(k,256) - b(k,286) = b(k,286) - lu(k,2261) * b(k,256) - b(k,261) = b(k,261) - lu(k,2272) * b(k,257) - b(k,262) = b(k,262) - lu(k,2273) * b(k,257) - b(k,263) = b(k,263) - lu(k,2274) * b(k,257) - b(k,264) = b(k,264) - lu(k,2275) * b(k,257) - b(k,265) = b(k,265) - lu(k,2276) * b(k,257) - b(k,266) = b(k,266) - lu(k,2277) * b(k,257) - b(k,267) = b(k,267) - lu(k,2278) * b(k,257) - b(k,268) = b(k,268) - lu(k,2279) * b(k,257) - b(k,269) = b(k,269) - lu(k,2280) * b(k,257) - b(k,270) = b(k,270) - lu(k,2281) * b(k,257) - b(k,271) = b(k,271) - lu(k,2282) * b(k,257) - b(k,272) = b(k,272) - lu(k,2283) * b(k,257) - b(k,274) = b(k,274) - lu(k,2284) * b(k,257) - b(k,276) = b(k,276) - lu(k,2285) * b(k,257) - b(k,278) = b(k,278) - lu(k,2286) * b(k,257) - b(k,279) = b(k,279) - lu(k,2287) * b(k,257) - b(k,281) = b(k,281) - lu(k,2288) * b(k,257) - b(k,282) = b(k,282) - lu(k,2289) * b(k,257) - b(k,286) = b(k,286) - lu(k,2290) * b(k,257) - b(k,259) = b(k,259) - lu(k,2304) * b(k,258) - b(k,262) = b(k,262) - lu(k,2305) * b(k,258) - b(k,263) = b(k,263) - lu(k,2306) * b(k,258) - b(k,264) = b(k,264) - lu(k,2307) * b(k,258) - b(k,265) = b(k,265) - lu(k,2308) * b(k,258) - b(k,266) = b(k,266) - lu(k,2309) * b(k,258) - b(k,267) = b(k,267) - lu(k,2310) * b(k,258) - b(k,268) = b(k,268) - lu(k,2311) * b(k,258) - b(k,269) = b(k,269) - lu(k,2312) * b(k,258) - b(k,270) = b(k,270) - lu(k,2313) * b(k,258) - b(k,271) = b(k,271) - lu(k,2314) * b(k,258) - b(k,272) = b(k,272) - lu(k,2315) * b(k,258) - b(k,274) = b(k,274) - lu(k,2316) * b(k,258) - b(k,276) = b(k,276) - lu(k,2317) * b(k,258) - b(k,278) = b(k,278) - lu(k,2318) * b(k,258) - b(k,279) = b(k,279) - lu(k,2319) * b(k,258) - b(k,281) = b(k,281) - lu(k,2320) * b(k,258) - b(k,282) = b(k,282) - lu(k,2321) * b(k,258) - b(k,286) = b(k,286) - lu(k,2322) * b(k,258) - b(k,263) = b(k,263) - lu(k,2333) * b(k,259) - b(k,264) = b(k,264) - lu(k,2334) * b(k,259) - b(k,265) = b(k,265) - lu(k,2335) * b(k,259) - b(k,266) = b(k,266) - lu(k,2336) * b(k,259) - b(k,267) = b(k,267) - lu(k,2337) * b(k,259) - b(k,268) = b(k,268) - lu(k,2338) * b(k,259) - b(k,269) = b(k,269) - lu(k,2339) * b(k,259) - b(k,270) = b(k,270) - lu(k,2340) * b(k,259) - b(k,271) = b(k,271) - lu(k,2341) * b(k,259) - b(k,272) = b(k,272) - lu(k,2342) * b(k,259) - b(k,274) = b(k,274) - lu(k,2343) * b(k,259) - b(k,276) = b(k,276) - lu(k,2344) * b(k,259) - b(k,278) = b(k,278) - lu(k,2345) * b(k,259) - b(k,279) = b(k,279) - lu(k,2346) * b(k,259) - b(k,281) = b(k,281) - lu(k,2347) * b(k,259) - b(k,282) = b(k,282) - lu(k,2348) * b(k,259) - b(k,286) = b(k,286) - lu(k,2349) * b(k,259) - b(k,261) = b(k,261) - lu(k,2365) * b(k,260) - b(k,262) = b(k,262) - lu(k,2366) * b(k,260) - b(k,263) = b(k,263) - lu(k,2367) * b(k,260) - b(k,264) = b(k,264) - lu(k,2368) * b(k,260) - b(k,265) = b(k,265) - lu(k,2369) * b(k,260) - b(k,266) = b(k,266) - lu(k,2370) * b(k,260) - b(k,267) = b(k,267) - lu(k,2371) * b(k,260) - b(k,268) = b(k,268) - lu(k,2372) * b(k,260) - b(k,269) = b(k,269) - lu(k,2373) * b(k,260) - b(k,270) = b(k,270) - lu(k,2374) * b(k,260) - b(k,271) = b(k,271) - lu(k,2375) * b(k,260) - b(k,272) = b(k,272) - lu(k,2376) * b(k,260) - b(k,274) = b(k,274) - lu(k,2377) * b(k,260) - b(k,276) = b(k,276) - lu(k,2378) * b(k,260) - b(k,278) = b(k,278) - lu(k,2379) * b(k,260) - b(k,279) = b(k,279) - lu(k,2380) * b(k,260) - b(k,281) = b(k,281) - lu(k,2381) * b(k,260) - b(k,282) = b(k,282) - lu(k,2382) * b(k,260) - b(k,286) = b(k,286) - lu(k,2383) * b(k,260) - b(k,262) = b(k,262) - lu(k,2393) * b(k,261) - b(k,263) = b(k,263) - lu(k,2394) * b(k,261) - b(k,264) = b(k,264) - lu(k,2395) * b(k,261) - b(k,265) = b(k,265) - lu(k,2396) * b(k,261) - b(k,267) = b(k,267) - lu(k,2397) * b(k,261) - b(k,268) = b(k,268) - lu(k,2398) * b(k,261) - b(k,270) = b(k,270) - lu(k,2399) * b(k,261) - b(k,271) = b(k,271) - lu(k,2400) * b(k,261) - b(k,272) = b(k,272) - lu(k,2401) * b(k,261) - b(k,273) = b(k,273) - lu(k,2402) * b(k,261) - b(k,274) = b(k,274) - lu(k,2403) * b(k,261) - b(k,276) = b(k,276) - lu(k,2404) * b(k,261) - b(k,278) = b(k,278) - lu(k,2405) * b(k,261) - b(k,280) = b(k,280) - lu(k,2406) * b(k,261) - b(k,281) = b(k,281) - lu(k,2407) * b(k,261) - b(k,282) = b(k,282) - lu(k,2408) * b(k,261) - b(k,283) = b(k,283) - lu(k,2409) * b(k,261) - b(k,285) = b(k,285) - lu(k,2410) * b(k,261) - b(k,286) = b(k,286) - lu(k,2411) * b(k,261) - b(k,263) = b(k,263) - lu(k,2421) * b(k,262) - b(k,264) = b(k,264) - lu(k,2422) * b(k,262) - b(k,265) = b(k,265) - lu(k,2423) * b(k,262) - b(k,267) = b(k,267) - lu(k,2424) * b(k,262) - b(k,268) = b(k,268) - lu(k,2425) * b(k,262) - b(k,270) = b(k,270) - lu(k,2426) * b(k,262) - b(k,271) = b(k,271) - lu(k,2427) * b(k,262) - b(k,272) = b(k,272) - lu(k,2428) * b(k,262) - b(k,273) = b(k,273) - lu(k,2429) * b(k,262) - b(k,274) = b(k,274) - lu(k,2430) * b(k,262) - b(k,276) = b(k,276) - lu(k,2431) * b(k,262) - b(k,278) = b(k,278) - lu(k,2432) * b(k,262) - b(k,280) = b(k,280) - lu(k,2433) * b(k,262) - b(k,281) = b(k,281) - lu(k,2434) * b(k,262) - b(k,282) = b(k,282) - lu(k,2435) * b(k,262) - b(k,283) = b(k,283) - lu(k,2436) * b(k,262) - b(k,285) = b(k,285) - lu(k,2437) * b(k,262) - b(k,286) = b(k,286) - lu(k,2438) * b(k,262) - b(k,264) = b(k,264) - lu(k,2446) * b(k,263) - b(k,265) = b(k,265) - lu(k,2447) * b(k,263) - b(k,266) = b(k,266) - lu(k,2448) * b(k,263) - b(k,267) = b(k,267) - lu(k,2449) * b(k,263) - b(k,268) = b(k,268) - lu(k,2450) * b(k,263) - b(k,269) = b(k,269) - lu(k,2451) * b(k,263) - b(k,270) = b(k,270) - lu(k,2452) * b(k,263) - b(k,271) = b(k,271) - lu(k,2453) * b(k,263) - b(k,272) = b(k,272) - lu(k,2454) * b(k,263) - b(k,274) = b(k,274) - lu(k,2455) * b(k,263) - b(k,276) = b(k,276) - lu(k,2456) * b(k,263) - b(k,278) = b(k,278) - lu(k,2457) * b(k,263) - b(k,279) = b(k,279) - lu(k,2458) * b(k,263) - b(k,281) = b(k,281) - lu(k,2459) * b(k,263) - b(k,282) = b(k,282) - lu(k,2460) * b(k,263) + b(k,272) = b(k,272) - lu(k,2079) * b(k,270) + b(k,302) = b(k,302) - lu(k,2080) * b(k,270) + b(k,303) = b(k,303) - lu(k,2081) * b(k,270) + b(k,304) = b(k,304) - lu(k,2082) * b(k,270) + b(k,305) = b(k,305) - lu(k,2083) * b(k,270) + b(k,306) = b(k,306) - lu(k,2084) * b(k,270) + b(k,307) = b(k,307) - lu(k,2085) * b(k,270) + b(k,308) = b(k,308) - lu(k,2086) * b(k,270) + b(k,309) = b(k,309) - lu(k,2087) * b(k,270) + b(k,310) = b(k,310) - lu(k,2088) * b(k,270) + b(k,311) = b(k,311) - lu(k,2089) * b(k,270) + b(k,312) = b(k,312) - lu(k,2090) * b(k,270) + b(k,314) = b(k,314) - lu(k,2091) * b(k,270) + b(k,315) = b(k,315) - lu(k,2092) * b(k,270) + b(k,272) = b(k,272) - lu(k,2111) * b(k,271) + b(k,302) = b(k,302) - lu(k,2112) * b(k,271) + b(k,303) = b(k,303) - lu(k,2113) * b(k,271) + b(k,304) = b(k,304) - lu(k,2114) * b(k,271) + b(k,305) = b(k,305) - lu(k,2115) * b(k,271) + b(k,306) = b(k,306) - lu(k,2116) * b(k,271) + b(k,307) = b(k,307) - lu(k,2117) * b(k,271) + b(k,308) = b(k,308) - lu(k,2118) * b(k,271) + b(k,309) = b(k,309) - lu(k,2119) * b(k,271) + b(k,310) = b(k,310) - lu(k,2120) * b(k,271) + b(k,311) = b(k,311) - lu(k,2121) * b(k,271) + b(k,312) = b(k,312) - lu(k,2122) * b(k,271) + b(k,314) = b(k,314) - lu(k,2123) * b(k,271) + b(k,315) = b(k,315) - lu(k,2124) * b(k,271) + b(k,302) = b(k,302) - lu(k,2141) * b(k,272) + b(k,303) = b(k,303) - lu(k,2142) * b(k,272) + b(k,304) = b(k,304) - lu(k,2143) * b(k,272) + b(k,305) = b(k,305) - lu(k,2144) * b(k,272) + b(k,306) = b(k,306) - lu(k,2145) * b(k,272) + b(k,307) = b(k,307) - lu(k,2146) * b(k,272) + b(k,308) = b(k,308) - lu(k,2147) * b(k,272) + b(k,309) = b(k,309) - lu(k,2148) * b(k,272) + b(k,310) = b(k,310) - lu(k,2149) * b(k,272) + b(k,311) = b(k,311) - lu(k,2150) * b(k,272) + b(k,312) = b(k,312) - lu(k,2151) * b(k,272) + b(k,314) = b(k,314) - lu(k,2152) * b(k,272) + b(k,315) = b(k,315) - lu(k,2153) * b(k,272) + b(k,277) = b(k,277) - lu(k,2181) * b(k,273) + b(k,278) = b(k,278) - lu(k,2182) * b(k,273) + b(k,302) = b(k,302) - lu(k,2183) * b(k,273) + b(k,303) = b(k,303) - lu(k,2184) * b(k,273) + b(k,304) = b(k,304) - lu(k,2185) * b(k,273) + b(k,305) = b(k,305) - lu(k,2186) * b(k,273) + b(k,306) = b(k,306) - lu(k,2187) * b(k,273) + b(k,307) = b(k,307) - lu(k,2188) * b(k,273) + b(k,308) = b(k,308) - lu(k,2189) * b(k,273) + b(k,309) = b(k,309) - lu(k,2190) * b(k,273) + b(k,310) = b(k,310) - lu(k,2191) * b(k,273) + b(k,311) = b(k,311) - lu(k,2192) * b(k,273) + b(k,312) = b(k,312) - lu(k,2193) * b(k,273) + b(k,313) = b(k,313) - lu(k,2194) * b(k,273) + b(k,314) = b(k,314) - lu(k,2195) * b(k,273) + b(k,315) = b(k,315) - lu(k,2196) * b(k,273) + b(k,289) = b(k,289) - lu(k,2200) * b(k,274) + b(k,290) = b(k,290) - lu(k,2201) * b(k,274) + b(k,292) = b(k,292) - lu(k,2202) * b(k,274) + b(k,303) = b(k,303) - lu(k,2203) * b(k,274) + b(k,307) = b(k,307) - lu(k,2204) * b(k,274) + b(k,308) = b(k,308) - lu(k,2205) * b(k,274) + b(k,309) = b(k,309) - lu(k,2206) * b(k,274) + b(k,310) = b(k,310) - lu(k,2207) * b(k,274) + b(k,315) = b(k,315) - lu(k,2208) * b(k,274) + b(k,281) = b(k,281) - lu(k,2214) * b(k,275) + b(k,295) = b(k,295) - lu(k,2215) * b(k,275) + b(k,296) = b(k,296) - lu(k,2216) * b(k,275) + b(k,297) = b(k,297) - lu(k,2217) * b(k,275) + b(k,299) = b(k,299) - lu(k,2218) * b(k,275) + b(k,300) = b(k,300) - lu(k,2219) * b(k,275) + b(k,301) = b(k,301) - lu(k,2220) * b(k,275) + b(k,302) = b(k,302) - lu(k,2221) * b(k,275) + b(k,305) = b(k,305) - lu(k,2222) * b(k,275) + b(k,307) = b(k,307) - lu(k,2223) * b(k,275) + b(k,308) = b(k,308) - lu(k,2224) * b(k,275) + b(k,309) = b(k,309) - lu(k,2225) * b(k,275) + b(k,310) = b(k,310) - lu(k,2226) * b(k,275) + b(k,312) = b(k,312) - lu(k,2227) * b(k,275) + b(k,313) = b(k,313) - lu(k,2228) * b(k,275) + b(k,314) = b(k,314) - lu(k,2229) * b(k,275) + b(k,278) = b(k,278) - lu(k,2236) * b(k,276) + b(k,282) = b(k,282) - lu(k,2237) * b(k,276) + b(k,295) = b(k,295) - lu(k,2238) * b(k,276) + b(k,296) = b(k,296) - lu(k,2239) * b(k,276) + b(k,297) = b(k,297) - lu(k,2240) * b(k,276) + b(k,299) = b(k,299) - lu(k,2241) * b(k,276) + b(k,300) = b(k,300) - lu(k,2242) * b(k,276) + b(k,301) = b(k,301) - lu(k,2243) * b(k,276) + b(k,302) = b(k,302) - lu(k,2244) * b(k,276) + b(k,305) = b(k,305) - lu(k,2245) * b(k,276) + b(k,306) = b(k,306) - lu(k,2246) * b(k,276) + b(k,307) = b(k,307) - lu(k,2247) * b(k,276) + b(k,308) = b(k,308) - lu(k,2248) * b(k,276) + b(k,309) = b(k,309) - lu(k,2249) * b(k,276) + b(k,310) = b(k,310) - lu(k,2250) * b(k,276) + b(k,312) = b(k,312) - lu(k,2251) * b(k,276) + b(k,313) = b(k,313) - lu(k,2252) * b(k,276) + b(k,314) = b(k,314) - lu(k,2253) * b(k,276) + b(k,290) = b(k,290) - lu(k,2260) * b(k,277) + b(k,292) = b(k,292) - lu(k,2261) * b(k,277) + b(k,304) = b(k,304) - lu(k,2262) * b(k,277) + b(k,306) = b(k,306) - lu(k,2263) * b(k,277) + b(k,307) = b(k,307) - lu(k,2264) * b(k,277) + b(k,308) = b(k,308) - lu(k,2265) * b(k,277) + b(k,309) = b(k,309) - lu(k,2266) * b(k,277) + b(k,310) = b(k,310) - lu(k,2267) * b(k,277) + b(k,311) = b(k,311) - lu(k,2268) * b(k,277) + b(k,312) = b(k,312) - lu(k,2269) * b(k,277) + b(k,313) = b(k,313) - lu(k,2270) * b(k,277) + b(k,315) = b(k,315) - lu(k,2271) * b(k,277) + b(k,302) = b(k,302) - lu(k,2278) * b(k,278) + b(k,305) = b(k,305) - lu(k,2279) * b(k,278) + b(k,306) = b(k,306) - lu(k,2280) * b(k,278) + b(k,307) = b(k,307) - lu(k,2281) * b(k,278) + b(k,308) = b(k,308) - lu(k,2282) * b(k,278) + b(k,309) = b(k,309) - lu(k,2283) * b(k,278) + b(k,310) = b(k,310) - lu(k,2284) * b(k,278) + b(k,312) = b(k,312) - lu(k,2285) * b(k,278) + b(k,313) = b(k,313) - lu(k,2286) * b(k,278) + b(k,314) = b(k,314) - lu(k,2287) * b(k,278) + b(k,315) = b(k,315) - lu(k,2288) * b(k,278) + b(k,282) = b(k,282) - lu(k,2297) * b(k,279) + b(k,295) = b(k,295) - lu(k,2298) * b(k,279) + b(k,296) = b(k,296) - lu(k,2299) * b(k,279) + b(k,297) = b(k,297) - lu(k,2300) * b(k,279) + b(k,299) = b(k,299) - lu(k,2301) * b(k,279) + b(k,300) = b(k,300) - lu(k,2302) * b(k,279) + b(k,301) = b(k,301) - lu(k,2303) * b(k,279) + b(k,302) = b(k,302) - lu(k,2304) * b(k,279) + b(k,305) = b(k,305) - lu(k,2305) * b(k,279) + b(k,306) = b(k,306) - lu(k,2306) * b(k,279) + b(k,307) = b(k,307) - lu(k,2307) * b(k,279) + b(k,308) = b(k,308) - lu(k,2308) * b(k,279) + b(k,309) = b(k,309) - lu(k,2309) * b(k,279) + b(k,310) = b(k,310) - lu(k,2310) * b(k,279) + b(k,312) = b(k,312) - lu(k,2311) * b(k,279) + b(k,313) = b(k,313) - lu(k,2312) * b(k,279) + b(k,314) = b(k,314) - lu(k,2313) * b(k,279) + b(k,315) = b(k,315) - lu(k,2314) * b(k,279) + b(k,281) = b(k,281) - lu(k,2323) * b(k,280) + b(k,282) = b(k,282) - lu(k,2324) * b(k,280) + b(k,285) = b(k,285) - lu(k,2325) * b(k,280) + b(k,295) = b(k,295) - lu(k,2326) * b(k,280) + b(k,296) = b(k,296) - lu(k,2327) * b(k,280) + b(k,297) = b(k,297) - lu(k,2328) * b(k,280) + b(k,299) = b(k,299) - lu(k,2329) * b(k,280) + b(k,300) = b(k,300) - lu(k,2330) * b(k,280) + b(k,301) = b(k,301) - lu(k,2331) * b(k,280) + b(k,302) = b(k,302) - lu(k,2332) * b(k,280) + b(k,305) = b(k,305) - lu(k,2333) * b(k,280) + b(k,307) = b(k,307) - lu(k,2334) * b(k,280) + b(k,308) = b(k,308) - lu(k,2335) * b(k,280) + b(k,309) = b(k,309) - lu(k,2336) * b(k,280) + b(k,310) = b(k,310) - lu(k,2337) * b(k,280) + b(k,312) = b(k,312) - lu(k,2338) * b(k,280) + b(k,313) = b(k,313) - lu(k,2339) * b(k,280) + b(k,314) = b(k,314) - lu(k,2340) * b(k,280) + b(k,282) = b(k,282) - lu(k,2350) * b(k,281) + b(k,285) = b(k,285) - lu(k,2351) * b(k,281) + b(k,293) = b(k,293) - lu(k,2352) * b(k,281) + b(k,303) = b(k,303) - lu(k,2353) * b(k,281) + b(k,304) = b(k,304) - lu(k,2354) * b(k,281) + b(k,305) = b(k,305) - lu(k,2355) * b(k,281) + b(k,306) = b(k,306) - lu(k,2356) * b(k,281) + b(k,307) = b(k,307) - lu(k,2357) * b(k,281) + b(k,308) = b(k,308) - lu(k,2358) * b(k,281) + b(k,309) = b(k,309) - lu(k,2359) * b(k,281) + b(k,310) = b(k,310) - lu(k,2360) * b(k,281) + b(k,311) = b(k,311) - lu(k,2361) * b(k,281) + b(k,312) = b(k,312) - lu(k,2362) * b(k,281) + b(k,314) = b(k,314) - lu(k,2363) * b(k,281) + b(k,315) = b(k,315) - lu(k,2364) * b(k,281) + b(k,295) = b(k,295) - lu(k,2367) * b(k,282) + b(k,297) = b(k,297) - lu(k,2368) * b(k,282) + b(k,300) = b(k,300) - lu(k,2369) * b(k,282) + b(k,306) = b(k,306) - lu(k,2370) * b(k,282) + b(k,308) = b(k,308) - lu(k,2371) * b(k,282) + b(k,309) = b(k,309) - lu(k,2372) * b(k,282) + b(k,310) = b(k,310) - lu(k,2373) * b(k,282) + b(k,312) = b(k,312) - lu(k,2374) * b(k,282) + b(k,285) = b(k,285) - lu(k,2382) * b(k,283) + b(k,293) = b(k,293) - lu(k,2383) * b(k,283) + b(k,295) = b(k,295) - lu(k,2384) * b(k,283) + b(k,296) = b(k,296) - lu(k,2385) * b(k,283) + b(k,297) = b(k,297) - lu(k,2386) * b(k,283) + b(k,299) = b(k,299) - lu(k,2387) * b(k,283) + b(k,300) = b(k,300) - lu(k,2388) * b(k,283) + b(k,301) = b(k,301) - lu(k,2389) * b(k,283) + b(k,302) = b(k,302) - lu(k,2390) * b(k,283) + b(k,305) = b(k,305) - lu(k,2391) * b(k,283) + b(k,306) = b(k,306) - lu(k,2392) * b(k,283) + b(k,307) = b(k,307) - lu(k,2393) * b(k,283) + b(k,308) = b(k,308) - lu(k,2394) * b(k,283) + b(k,309) = b(k,309) - lu(k,2395) * b(k,283) + b(k,310) = b(k,310) - lu(k,2396) * b(k,283) + b(k,312) = b(k,312) - lu(k,2397) * b(k,283) + b(k,313) = b(k,313) - lu(k,2398) * b(k,283) + b(k,314) = b(k,314) - lu(k,2399) * b(k,283) + b(k,285) = b(k,285) - lu(k,2412) * b(k,284) + b(k,293) = b(k,293) - lu(k,2413) * b(k,284) + b(k,295) = b(k,295) - lu(k,2414) * b(k,284) + b(k,296) = b(k,296) - lu(k,2415) * b(k,284) + b(k,297) = b(k,297) - lu(k,2416) * b(k,284) + b(k,299) = b(k,299) - lu(k,2417) * b(k,284) + b(k,300) = b(k,300) - lu(k,2418) * b(k,284) + b(k,301) = b(k,301) - lu(k,2419) * b(k,284) + b(k,302) = b(k,302) - lu(k,2420) * b(k,284) + b(k,305) = b(k,305) - lu(k,2421) * b(k,284) + b(k,306) = b(k,306) - lu(k,2422) * b(k,284) + b(k,307) = b(k,307) - lu(k,2423) * b(k,284) + b(k,308) = b(k,308) - lu(k,2424) * b(k,284) + b(k,309) = b(k,309) - lu(k,2425) * b(k,284) + b(k,310) = b(k,310) - lu(k,2426) * b(k,284) + b(k,312) = b(k,312) - lu(k,2427) * b(k,284) + b(k,313) = b(k,313) - lu(k,2428) * b(k,284) + b(k,314) = b(k,314) - lu(k,2429) * b(k,284) + b(k,315) = b(k,315) - lu(k,2430) * b(k,284) end do end subroutine lu_slv08 subroutine lu_slv09( avec_len, lu, b ) @@ -1833,207 +1833,208 @@ subroutine lu_slv09( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,265) = b(k,265) - lu(k,2468) * b(k,264) - b(k,266) = b(k,266) - lu(k,2469) * b(k,264) - b(k,267) = b(k,267) - lu(k,2470) * b(k,264) - b(k,268) = b(k,268) - lu(k,2471) * b(k,264) - b(k,269) = b(k,269) - lu(k,2472) * b(k,264) - b(k,270) = b(k,270) - lu(k,2473) * b(k,264) - b(k,271) = b(k,271) - lu(k,2474) * b(k,264) - b(k,272) = b(k,272) - lu(k,2475) * b(k,264) - b(k,274) = b(k,274) - lu(k,2476) * b(k,264) - b(k,276) = b(k,276) - lu(k,2477) * b(k,264) - b(k,278) = b(k,278) - lu(k,2478) * b(k,264) - b(k,279) = b(k,279) - lu(k,2479) * b(k,264) - b(k,281) = b(k,281) - lu(k,2480) * b(k,264) - b(k,282) = b(k,282) - lu(k,2481) * b(k,264) - b(k,266) = b(k,266) - lu(k,2490) * b(k,265) - b(k,267) = b(k,267) - lu(k,2491) * b(k,265) - b(k,268) = b(k,268) - lu(k,2492) * b(k,265) - b(k,269) = b(k,269) - lu(k,2493) * b(k,265) - b(k,270) = b(k,270) - lu(k,2494) * b(k,265) - b(k,271) = b(k,271) - lu(k,2495) * b(k,265) - b(k,272) = b(k,272) - lu(k,2496) * b(k,265) - b(k,274) = b(k,274) - lu(k,2497) * b(k,265) - b(k,276) = b(k,276) - lu(k,2498) * b(k,265) - b(k,278) = b(k,278) - lu(k,2499) * b(k,265) - b(k,279) = b(k,279) - lu(k,2500) * b(k,265) - b(k,281) = b(k,281) - lu(k,2501) * b(k,265) - b(k,282) = b(k,282) - lu(k,2502) * b(k,265) - b(k,286) = b(k,286) - lu(k,2503) * b(k,265) - b(k,267) = b(k,267) - lu(k,2533) * b(k,266) - b(k,268) = b(k,268) - lu(k,2534) * b(k,266) - b(k,269) = b(k,269) - lu(k,2535) * b(k,266) - b(k,270) = b(k,270) - lu(k,2536) * b(k,266) - b(k,271) = b(k,271) - lu(k,2537) * b(k,266) - b(k,272) = b(k,272) - lu(k,2538) * b(k,266) - b(k,273) = b(k,273) - lu(k,2539) * b(k,266) - b(k,274) = b(k,274) - lu(k,2540) * b(k,266) - b(k,276) = b(k,276) - lu(k,2541) * b(k,266) - b(k,278) = b(k,278) - lu(k,2542) * b(k,266) - b(k,279) = b(k,279) - lu(k,2543) * b(k,266) - b(k,280) = b(k,280) - lu(k,2544) * b(k,266) - b(k,281) = b(k,281) - lu(k,2545) * b(k,266) - b(k,282) = b(k,282) - lu(k,2546) * b(k,266) - b(k,283) = b(k,283) - lu(k,2547) * b(k,266) - b(k,285) = b(k,285) - lu(k,2548) * b(k,266) - b(k,286) = b(k,286) - lu(k,2549) * b(k,266) - b(k,268) = b(k,268) - lu(k,2580) * b(k,267) - b(k,269) = b(k,269) - lu(k,2581) * b(k,267) - b(k,270) = b(k,270) - lu(k,2582) * b(k,267) - b(k,271) = b(k,271) - lu(k,2583) * b(k,267) - b(k,272) = b(k,272) - lu(k,2584) * b(k,267) - b(k,273) = b(k,273) - lu(k,2585) * b(k,267) - b(k,274) = b(k,274) - lu(k,2586) * b(k,267) - b(k,276) = b(k,276) - lu(k,2587) * b(k,267) - b(k,278) = b(k,278) - lu(k,2588) * b(k,267) - b(k,279) = b(k,279) - lu(k,2589) * b(k,267) - b(k,280) = b(k,280) - lu(k,2590) * b(k,267) - b(k,281) = b(k,281) - lu(k,2591) * b(k,267) - b(k,282) = b(k,282) - lu(k,2592) * b(k,267) - b(k,283) = b(k,283) - lu(k,2593) * b(k,267) - b(k,285) = b(k,285) - lu(k,2594) * b(k,267) - b(k,286) = b(k,286) - lu(k,2595) * b(k,267) - b(k,269) = b(k,269) - lu(k,2628) * b(k,268) - b(k,270) = b(k,270) - lu(k,2629) * b(k,268) - b(k,271) = b(k,271) - lu(k,2630) * b(k,268) - b(k,272) = b(k,272) - lu(k,2631) * b(k,268) - b(k,273) = b(k,273) - lu(k,2632) * b(k,268) - b(k,274) = b(k,274) - lu(k,2633) * b(k,268) - b(k,276) = b(k,276) - lu(k,2634) * b(k,268) - b(k,278) = b(k,278) - lu(k,2635) * b(k,268) - b(k,279) = b(k,279) - lu(k,2636) * b(k,268) - b(k,280) = b(k,280) - lu(k,2637) * b(k,268) - b(k,281) = b(k,281) - lu(k,2638) * b(k,268) - b(k,282) = b(k,282) - lu(k,2639) * b(k,268) - b(k,283) = b(k,283) - lu(k,2640) * b(k,268) - b(k,285) = b(k,285) - lu(k,2641) * b(k,268) - b(k,286) = b(k,286) - lu(k,2642) * b(k,268) - b(k,270) = b(k,270) - lu(k,2700) * b(k,269) - b(k,271) = b(k,271) - lu(k,2701) * b(k,269) - b(k,272) = b(k,272) - lu(k,2702) * b(k,269) - b(k,273) = b(k,273) - lu(k,2703) * b(k,269) - b(k,274) = b(k,274) - lu(k,2704) * b(k,269) - b(k,276) = b(k,276) - lu(k,2705) * b(k,269) - b(k,278) = b(k,278) - lu(k,2706) * b(k,269) - b(k,279) = b(k,279) - lu(k,2707) * b(k,269) - b(k,280) = b(k,280) - lu(k,2708) * b(k,269) - b(k,281) = b(k,281) - lu(k,2709) * b(k,269) - b(k,282) = b(k,282) - lu(k,2710) * b(k,269) - b(k,283) = b(k,283) - lu(k,2711) * b(k,269) - b(k,285) = b(k,285) - lu(k,2712) * b(k,269) - b(k,286) = b(k,286) - lu(k,2713) * b(k,269) - b(k,271) = b(k,271) - lu(k,2718) * b(k,270) - b(k,274) = b(k,274) - lu(k,2719) * b(k,270) - b(k,275) = b(k,275) - lu(k,2720) * b(k,270) - b(k,279) = b(k,279) - lu(k,2721) * b(k,270) - b(k,280) = b(k,280) - lu(k,2722) * b(k,270) - b(k,281) = b(k,281) - lu(k,2723) * b(k,270) - b(k,282) = b(k,282) - lu(k,2724) * b(k,270) - b(k,283) = b(k,283) - lu(k,2725) * b(k,270) - b(k,285) = b(k,285) - lu(k,2726) * b(k,270) - b(k,286) = b(k,286) - lu(k,2727) * b(k,270) - b(k,273) = b(k,273) - lu(k,2731) * b(k,271) - b(k,274) = b(k,274) - lu(k,2732) * b(k,271) - b(k,275) = b(k,275) - lu(k,2733) * b(k,271) - b(k,276) = b(k,276) - lu(k,2734) * b(k,271) - b(k,279) = b(k,279) - lu(k,2735) * b(k,271) - b(k,280) = b(k,280) - lu(k,2736) * b(k,271) - b(k,281) = b(k,281) - lu(k,2737) * b(k,271) - b(k,282) = b(k,282) - lu(k,2738) * b(k,271) - b(k,283) = b(k,283) - lu(k,2739) * b(k,271) - b(k,285) = b(k,285) - lu(k,2740) * b(k,271) - b(k,286) = b(k,286) - lu(k,2741) * b(k,271) - b(k,273) = b(k,273) - lu(k,2886) * b(k,272) - b(k,274) = b(k,274) - lu(k,2887) * b(k,272) - b(k,275) = b(k,275) - lu(k,2888) * b(k,272) - b(k,276) = b(k,276) - lu(k,2889) * b(k,272) - b(k,277) = b(k,277) - lu(k,2890) * b(k,272) - b(k,278) = b(k,278) - lu(k,2891) * b(k,272) - b(k,279) = b(k,279) - lu(k,2892) * b(k,272) - b(k,280) = b(k,280) - lu(k,2893) * b(k,272) - b(k,281) = b(k,281) - lu(k,2894) * b(k,272) - b(k,282) = b(k,282) - lu(k,2895) * b(k,272) - b(k,283) = b(k,283) - lu(k,2896) * b(k,272) - b(k,284) = b(k,284) - lu(k,2897) * b(k,272) - b(k,285) = b(k,285) - lu(k,2898) * b(k,272) - b(k,286) = b(k,286) - lu(k,2899) * b(k,272) - b(k,274) = b(k,274) - lu(k,2988) * b(k,273) - b(k,275) = b(k,275) - lu(k,2989) * b(k,273) - b(k,276) = b(k,276) - lu(k,2990) * b(k,273) - b(k,277) = b(k,277) - lu(k,2991) * b(k,273) - b(k,278) = b(k,278) - lu(k,2992) * b(k,273) - b(k,279) = b(k,279) - lu(k,2993) * b(k,273) - b(k,280) = b(k,280) - lu(k,2994) * b(k,273) - b(k,281) = b(k,281) - lu(k,2995) * b(k,273) - b(k,282) = b(k,282) - lu(k,2996) * b(k,273) - b(k,283) = b(k,283) - lu(k,2997) * b(k,273) - b(k,284) = b(k,284) - lu(k,2998) * b(k,273) - b(k,285) = b(k,285) - lu(k,2999) * b(k,273) - b(k,286) = b(k,286) - lu(k,3000) * b(k,273) - b(k,275) = b(k,275) - lu(k,3081) * b(k,274) - b(k,276) = b(k,276) - lu(k,3082) * b(k,274) - b(k,277) = b(k,277) - lu(k,3083) * b(k,274) - b(k,278) = b(k,278) - lu(k,3084) * b(k,274) - b(k,279) = b(k,279) - lu(k,3085) * b(k,274) - b(k,280) = b(k,280) - lu(k,3086) * b(k,274) - b(k,281) = b(k,281) - lu(k,3087) * b(k,274) - b(k,282) = b(k,282) - lu(k,3088) * b(k,274) - b(k,283) = b(k,283) - lu(k,3089) * b(k,274) - b(k,284) = b(k,284) - lu(k,3090) * b(k,274) - b(k,285) = b(k,285) - lu(k,3091) * b(k,274) - b(k,286) = b(k,286) - lu(k,3092) * b(k,274) - b(k,276) = b(k,276) - lu(k,3106) * b(k,275) - b(k,277) = b(k,277) - lu(k,3107) * b(k,275) - b(k,278) = b(k,278) - lu(k,3108) * b(k,275) - b(k,279) = b(k,279) - lu(k,3109) * b(k,275) - b(k,280) = b(k,280) - lu(k,3110) * b(k,275) - b(k,281) = b(k,281) - lu(k,3111) * b(k,275) - b(k,282) = b(k,282) - lu(k,3112) * b(k,275) - b(k,283) = b(k,283) - lu(k,3113) * b(k,275) - b(k,284) = b(k,284) - lu(k,3114) * b(k,275) - b(k,285) = b(k,285) - lu(k,3115) * b(k,275) - b(k,286) = b(k,286) - lu(k,3116) * b(k,275) - b(k,277) = b(k,277) - lu(k,3286) * b(k,276) - b(k,278) = b(k,278) - lu(k,3287) * b(k,276) - b(k,279) = b(k,279) - lu(k,3288) * b(k,276) - b(k,280) = b(k,280) - lu(k,3289) * b(k,276) - b(k,281) = b(k,281) - lu(k,3290) * b(k,276) - b(k,282) = b(k,282) - lu(k,3291) * b(k,276) - b(k,283) = b(k,283) - lu(k,3292) * b(k,276) - b(k,284) = b(k,284) - lu(k,3293) * b(k,276) - b(k,285) = b(k,285) - lu(k,3294) * b(k,276) - b(k,286) = b(k,286) - lu(k,3295) * b(k,276) - b(k,278) = b(k,278) - lu(k,3313) * b(k,277) - b(k,279) = b(k,279) - lu(k,3314) * b(k,277) - b(k,280) = b(k,280) - lu(k,3315) * b(k,277) - b(k,281) = b(k,281) - lu(k,3316) * b(k,277) - b(k,282) = b(k,282) - lu(k,3317) * b(k,277) - b(k,283) = b(k,283) - lu(k,3318) * b(k,277) - b(k,284) = b(k,284) - lu(k,3319) * b(k,277) - b(k,285) = b(k,285) - lu(k,3320) * b(k,277) - b(k,286) = b(k,286) - lu(k,3321) * b(k,277) - b(k,279) = b(k,279) - lu(k,3338) * b(k,278) - b(k,280) = b(k,280) - lu(k,3339) * b(k,278) - b(k,281) = b(k,281) - lu(k,3340) * b(k,278) - b(k,282) = b(k,282) - lu(k,3341) * b(k,278) - b(k,283) = b(k,283) - lu(k,3342) * b(k,278) - b(k,284) = b(k,284) - lu(k,3343) * b(k,278) - b(k,285) = b(k,285) - lu(k,3344) * b(k,278) - b(k,286) = b(k,286) - lu(k,3345) * b(k,278) - b(k,280) = b(k,280) - lu(k,3430) * b(k,279) - b(k,281) = b(k,281) - lu(k,3431) * b(k,279) - b(k,282) = b(k,282) - lu(k,3432) * b(k,279) - b(k,283) = b(k,283) - lu(k,3433) * b(k,279) - b(k,284) = b(k,284) - lu(k,3434) * b(k,279) - b(k,285) = b(k,285) - lu(k,3435) * b(k,279) - b(k,286) = b(k,286) - lu(k,3436) * b(k,279) - b(k,281) = b(k,281) - lu(k,3461) * b(k,280) - b(k,282) = b(k,282) - lu(k,3462) * b(k,280) - b(k,283) = b(k,283) - lu(k,3463) * b(k,280) - b(k,284) = b(k,284) - lu(k,3464) * b(k,280) - b(k,285) = b(k,285) - lu(k,3465) * b(k,280) - b(k,286) = b(k,286) - lu(k,3466) * b(k,280) + b(k,293) = b(k,293) - lu(k,2438) * b(k,285) + b(k,295) = b(k,295) - lu(k,2439) * b(k,285) + b(k,296) = b(k,296) - lu(k,2440) * b(k,285) + b(k,297) = b(k,297) - lu(k,2441) * b(k,285) + b(k,299) = b(k,299) - lu(k,2442) * b(k,285) + b(k,300) = b(k,300) - lu(k,2443) * b(k,285) + b(k,305) = b(k,305) - lu(k,2444) * b(k,285) + b(k,306) = b(k,306) - lu(k,2445) * b(k,285) + b(k,307) = b(k,307) - lu(k,2446) * b(k,285) + b(k,308) = b(k,308) - lu(k,2447) * b(k,285) + b(k,309) = b(k,309) - lu(k,2448) * b(k,285) + b(k,310) = b(k,310) - lu(k,2449) * b(k,285) + b(k,312) = b(k,312) - lu(k,2450) * b(k,285) + b(k,314) = b(k,314) - lu(k,2451) * b(k,285) + b(k,293) = b(k,293) - lu(k,2467) * b(k,286) + b(k,295) = b(k,295) - lu(k,2468) * b(k,286) + b(k,296) = b(k,296) - lu(k,2469) * b(k,286) + b(k,297) = b(k,297) - lu(k,2470) * b(k,286) + b(k,299) = b(k,299) - lu(k,2471) * b(k,286) + b(k,300) = b(k,300) - lu(k,2472) * b(k,286) + b(k,301) = b(k,301) - lu(k,2473) * b(k,286) + b(k,302) = b(k,302) - lu(k,2474) * b(k,286) + b(k,305) = b(k,305) - lu(k,2475) * b(k,286) + b(k,306) = b(k,306) - lu(k,2476) * b(k,286) + b(k,307) = b(k,307) - lu(k,2477) * b(k,286) + b(k,308) = b(k,308) - lu(k,2478) * b(k,286) + b(k,309) = b(k,309) - lu(k,2479) * b(k,286) + b(k,310) = b(k,310) - lu(k,2480) * b(k,286) + b(k,312) = b(k,312) - lu(k,2481) * b(k,286) + b(k,313) = b(k,313) - lu(k,2482) * b(k,286) + b(k,314) = b(k,314) - lu(k,2483) * b(k,286) + b(k,315) = b(k,315) - lu(k,2484) * b(k,286) + b(k,288) = b(k,288) - lu(k,2500) * b(k,287) + b(k,293) = b(k,293) - lu(k,2501) * b(k,287) + b(k,295) = b(k,295) - lu(k,2502) * b(k,287) + b(k,296) = b(k,296) - lu(k,2503) * b(k,287) + b(k,297) = b(k,297) - lu(k,2504) * b(k,287) + b(k,299) = b(k,299) - lu(k,2505) * b(k,287) + b(k,300) = b(k,300) - lu(k,2506) * b(k,287) + b(k,301) = b(k,301) - lu(k,2507) * b(k,287) + b(k,302) = b(k,302) - lu(k,2508) * b(k,287) + b(k,305) = b(k,305) - lu(k,2509) * b(k,287) + b(k,306) = b(k,306) - lu(k,2510) * b(k,287) + b(k,307) = b(k,307) - lu(k,2511) * b(k,287) + b(k,308) = b(k,308) - lu(k,2512) * b(k,287) + b(k,309) = b(k,309) - lu(k,2513) * b(k,287) + b(k,310) = b(k,310) - lu(k,2514) * b(k,287) + b(k,312) = b(k,312) - lu(k,2515) * b(k,287) + b(k,313) = b(k,313) - lu(k,2516) * b(k,287) + b(k,314) = b(k,314) - lu(k,2517) * b(k,287) + b(k,315) = b(k,315) - lu(k,2518) * b(k,287) + b(k,295) = b(k,295) - lu(k,2531) * b(k,288) + b(k,296) = b(k,296) - lu(k,2532) * b(k,288) + b(k,297) = b(k,297) - lu(k,2533) * b(k,288) + b(k,299) = b(k,299) - lu(k,2534) * b(k,288) + b(k,300) = b(k,300) - lu(k,2535) * b(k,288) + b(k,301) = b(k,301) - lu(k,2536) * b(k,288) + b(k,302) = b(k,302) - lu(k,2537) * b(k,288) + b(k,305) = b(k,305) - lu(k,2538) * b(k,288) + b(k,306) = b(k,306) - lu(k,2539) * b(k,288) + b(k,307) = b(k,307) - lu(k,2540) * b(k,288) + b(k,308) = b(k,308) - lu(k,2541) * b(k,288) + b(k,309) = b(k,309) - lu(k,2542) * b(k,288) + b(k,310) = b(k,310) - lu(k,2543) * b(k,288) + b(k,312) = b(k,312) - lu(k,2544) * b(k,288) + b(k,313) = b(k,313) - lu(k,2545) * b(k,288) + b(k,314) = b(k,314) - lu(k,2546) * b(k,288) + b(k,315) = b(k,315) - lu(k,2547) * b(k,288) + b(k,290) = b(k,290) - lu(k,2556) * b(k,289) + b(k,291) = b(k,291) - lu(k,2557) * b(k,289) + b(k,292) = b(k,292) - lu(k,2558) * b(k,289) + b(k,303) = b(k,303) - lu(k,2559) * b(k,289) + b(k,304) = b(k,304) - lu(k,2560) * b(k,289) + b(k,305) = b(k,305) - lu(k,2561) * b(k,289) + b(k,306) = b(k,306) - lu(k,2562) * b(k,289) + b(k,307) = b(k,307) - lu(k,2563) * b(k,289) + b(k,308) = b(k,308) - lu(k,2564) * b(k,289) + b(k,309) = b(k,309) - lu(k,2565) * b(k,289) + b(k,310) = b(k,310) - lu(k,2566) * b(k,289) + b(k,311) = b(k,311) - lu(k,2567) * b(k,289) + b(k,312) = b(k,312) - lu(k,2568) * b(k,289) + b(k,314) = b(k,314) - lu(k,2569) * b(k,289) + b(k,315) = b(k,315) - lu(k,2570) * b(k,289) + b(k,292) = b(k,292) - lu(k,2574) * b(k,290) + b(k,303) = b(k,303) - lu(k,2575) * b(k,290) + b(k,304) = b(k,304) - lu(k,2576) * b(k,290) + b(k,306) = b(k,306) - lu(k,2577) * b(k,290) + b(k,307) = b(k,307) - lu(k,2578) * b(k,290) + b(k,308) = b(k,308) - lu(k,2579) * b(k,290) + b(k,309) = b(k,309) - lu(k,2580) * b(k,290) + b(k,310) = b(k,310) - lu(k,2581) * b(k,290) + b(k,311) = b(k,311) - lu(k,2582) * b(k,290) + b(k,312) = b(k,312) - lu(k,2583) * b(k,290) + b(k,313) = b(k,313) - lu(k,2584) * b(k,290) + b(k,315) = b(k,315) - lu(k,2585) * b(k,290) + b(k,292) = b(k,292) - lu(k,2598) * b(k,291) + b(k,303) = b(k,303) - lu(k,2599) * b(k,291) + b(k,304) = b(k,304) - lu(k,2600) * b(k,291) + b(k,305) = b(k,305) - lu(k,2601) * b(k,291) + b(k,306) = b(k,306) - lu(k,2602) * b(k,291) + b(k,307) = b(k,307) - lu(k,2603) * b(k,291) + b(k,308) = b(k,308) - lu(k,2604) * b(k,291) + b(k,309) = b(k,309) - lu(k,2605) * b(k,291) + b(k,310) = b(k,310) - lu(k,2606) * b(k,291) + b(k,311) = b(k,311) - lu(k,2607) * b(k,291) + b(k,312) = b(k,312) - lu(k,2608) * b(k,291) + b(k,313) = b(k,313) - lu(k,2609) * b(k,291) + b(k,314) = b(k,314) - lu(k,2610) * b(k,291) + b(k,315) = b(k,315) - lu(k,2611) * b(k,291) + b(k,303) = b(k,303) - lu(k,2640) * b(k,292) + b(k,304) = b(k,304) - lu(k,2641) * b(k,292) + b(k,305) = b(k,305) - lu(k,2642) * b(k,292) + b(k,306) = b(k,306) - lu(k,2643) * b(k,292) + b(k,307) = b(k,307) - lu(k,2644) * b(k,292) + b(k,308) = b(k,308) - lu(k,2645) * b(k,292) + b(k,309) = b(k,309) - lu(k,2646) * b(k,292) + b(k,310) = b(k,310) - lu(k,2647) * b(k,292) + b(k,311) = b(k,311) - lu(k,2648) * b(k,292) + b(k,312) = b(k,312) - lu(k,2649) * b(k,292) + b(k,313) = b(k,313) - lu(k,2650) * b(k,292) + b(k,314) = b(k,314) - lu(k,2651) * b(k,292) + b(k,315) = b(k,315) - lu(k,2652) * b(k,292) + b(k,295) = b(k,295) - lu(k,2664) * b(k,293) + b(k,296) = b(k,296) - lu(k,2665) * b(k,293) + b(k,297) = b(k,297) - lu(k,2666) * b(k,293) + b(k,299) = b(k,299) - lu(k,2667) * b(k,293) + b(k,300) = b(k,300) - lu(k,2668) * b(k,293) + b(k,303) = b(k,303) - lu(k,2669) * b(k,293) + b(k,304) = b(k,304) - lu(k,2670) * b(k,293) + b(k,305) = b(k,305) - lu(k,2671) * b(k,293) + b(k,306) = b(k,306) - lu(k,2672) * b(k,293) + b(k,307) = b(k,307) - lu(k,2673) * b(k,293) + b(k,308) = b(k,308) - lu(k,2674) * b(k,293) + b(k,309) = b(k,309) - lu(k,2675) * b(k,293) + b(k,310) = b(k,310) - lu(k,2676) * b(k,293) + b(k,311) = b(k,311) - lu(k,2677) * b(k,293) + b(k,312) = b(k,312) - lu(k,2678) * b(k,293) + b(k,314) = b(k,314) - lu(k,2679) * b(k,293) + b(k,315) = b(k,315) - lu(k,2680) * b(k,293) + b(k,295) = b(k,295) - lu(k,2701) * b(k,294) + b(k,296) = b(k,296) - lu(k,2702) * b(k,294) + b(k,297) = b(k,297) - lu(k,2703) * b(k,294) + b(k,299) = b(k,299) - lu(k,2704) * b(k,294) + b(k,300) = b(k,300) - lu(k,2705) * b(k,294) + b(k,301) = b(k,301) - lu(k,2706) * b(k,294) + b(k,302) = b(k,302) - lu(k,2707) * b(k,294) + b(k,303) = b(k,303) - lu(k,2708) * b(k,294) + b(k,304) = b(k,304) - lu(k,2709) * b(k,294) + b(k,305) = b(k,305) - lu(k,2710) * b(k,294) + b(k,306) = b(k,306) - lu(k,2711) * b(k,294) + b(k,307) = b(k,307) - lu(k,2712) * b(k,294) + b(k,308) = b(k,308) - lu(k,2713) * b(k,294) + b(k,309) = b(k,309) - lu(k,2714) * b(k,294) + b(k,310) = b(k,310) - lu(k,2715) * b(k,294) + b(k,311) = b(k,311) - lu(k,2716) * b(k,294) + b(k,312) = b(k,312) - lu(k,2717) * b(k,294) + b(k,313) = b(k,313) - lu(k,2718) * b(k,294) + b(k,314) = b(k,314) - lu(k,2719) * b(k,294) + b(k,315) = b(k,315) - lu(k,2720) * b(k,294) + b(k,296) = b(k,296) - lu(k,2729) * b(k,295) + b(k,297) = b(k,297) - lu(k,2730) * b(k,295) + b(k,299) = b(k,299) - lu(k,2731) * b(k,295) + b(k,300) = b(k,300) - lu(k,2732) * b(k,295) + b(k,301) = b(k,301) - lu(k,2733) * b(k,295) + b(k,302) = b(k,302) - lu(k,2734) * b(k,295) + b(k,305) = b(k,305) - lu(k,2735) * b(k,295) + b(k,306) = b(k,306) - lu(k,2736) * b(k,295) + b(k,307) = b(k,307) - lu(k,2737) * b(k,295) + b(k,308) = b(k,308) - lu(k,2738) * b(k,295) + b(k,309) = b(k,309) - lu(k,2739) * b(k,295) + b(k,310) = b(k,310) - lu(k,2740) * b(k,295) + b(k,312) = b(k,312) - lu(k,2741) * b(k,295) + b(k,313) = b(k,313) - lu(k,2742) * b(k,295) + b(k,314) = b(k,314) - lu(k,2743) * b(k,295) + b(k,297) = b(k,297) - lu(k,2752) * b(k,296) + b(k,299) = b(k,299) - lu(k,2753) * b(k,296) + b(k,300) = b(k,300) - lu(k,2754) * b(k,296) + b(k,301) = b(k,301) - lu(k,2755) * b(k,296) + b(k,302) = b(k,302) - lu(k,2756) * b(k,296) + b(k,305) = b(k,305) - lu(k,2757) * b(k,296) + b(k,306) = b(k,306) - lu(k,2758) * b(k,296) + b(k,307) = b(k,307) - lu(k,2759) * b(k,296) + b(k,308) = b(k,308) - lu(k,2760) * b(k,296) + b(k,309) = b(k,309) - lu(k,2761) * b(k,296) + b(k,310) = b(k,310) - lu(k,2762) * b(k,296) + b(k,312) = b(k,312) - lu(k,2763) * b(k,296) + b(k,313) = b(k,313) - lu(k,2764) * b(k,296) + b(k,314) = b(k,314) - lu(k,2765) * b(k,296) + b(k,299) = b(k,299) - lu(k,2776) * b(k,297) + b(k,300) = b(k,300) - lu(k,2777) * b(k,297) + b(k,301) = b(k,301) - lu(k,2778) * b(k,297) + b(k,302) = b(k,302) - lu(k,2779) * b(k,297) + b(k,305) = b(k,305) - lu(k,2780) * b(k,297) + b(k,306) = b(k,306) - lu(k,2781) * b(k,297) + b(k,307) = b(k,307) - lu(k,2782) * b(k,297) + b(k,308) = b(k,308) - lu(k,2783) * b(k,297) + b(k,309) = b(k,309) - lu(k,2784) * b(k,297) + b(k,310) = b(k,310) - lu(k,2785) * b(k,297) + b(k,312) = b(k,312) - lu(k,2786) * b(k,297) + b(k,313) = b(k,313) - lu(k,2787) * b(k,297) + b(k,314) = b(k,314) - lu(k,2788) * b(k,297) + b(k,315) = b(k,315) - lu(k,2789) * b(k,297) end do end subroutine lu_slv09 subroutine lu_slv10( avec_len, lu, b ) @@ -2054,21 +2055,159 @@ subroutine lu_slv10( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,282) = b(k,282) - lu(k,3512) * b(k,281) - b(k,283) = b(k,283) - lu(k,3513) * b(k,281) - b(k,284) = b(k,284) - lu(k,3514) * b(k,281) - b(k,285) = b(k,285) - lu(k,3515) * b(k,281) - b(k,286) = b(k,286) - lu(k,3516) * b(k,281) - b(k,283) = b(k,283) - lu(k,3753) * b(k,282) - b(k,284) = b(k,284) - lu(k,3754) * b(k,282) - b(k,285) = b(k,285) - lu(k,3755) * b(k,282) - b(k,286) = b(k,286) - lu(k,3756) * b(k,282) - b(k,284) = b(k,284) - lu(k,3776) * b(k,283) - b(k,285) = b(k,285) - lu(k,3777) * b(k,283) - b(k,286) = b(k,286) - lu(k,3778) * b(k,283) - b(k,285) = b(k,285) - lu(k,3801) * b(k,284) - b(k,286) = b(k,286) - lu(k,3802) * b(k,284) - b(k,286) = b(k,286) - lu(k,3837) * b(k,285) + b(k,299) = b(k,299) - lu(k,2807) * b(k,298) + b(k,300) = b(k,300) - lu(k,2808) * b(k,298) + b(k,301) = b(k,301) - lu(k,2809) * b(k,298) + b(k,302) = b(k,302) - lu(k,2810) * b(k,298) + b(k,303) = b(k,303) - lu(k,2811) * b(k,298) + b(k,304) = b(k,304) - lu(k,2812) * b(k,298) + b(k,305) = b(k,305) - lu(k,2813) * b(k,298) + b(k,306) = b(k,306) - lu(k,2814) * b(k,298) + b(k,307) = b(k,307) - lu(k,2815) * b(k,298) + b(k,308) = b(k,308) - lu(k,2816) * b(k,298) + b(k,309) = b(k,309) - lu(k,2817) * b(k,298) + b(k,310) = b(k,310) - lu(k,2818) * b(k,298) + b(k,311) = b(k,311) - lu(k,2819) * b(k,298) + b(k,312) = b(k,312) - lu(k,2820) * b(k,298) + b(k,313) = b(k,313) - lu(k,2821) * b(k,298) + b(k,314) = b(k,314) - lu(k,2822) * b(k,298) + b(k,315) = b(k,315) - lu(k,2823) * b(k,298) + b(k,300) = b(k,300) - lu(k,2854) * b(k,299) + b(k,301) = b(k,301) - lu(k,2855) * b(k,299) + b(k,302) = b(k,302) - lu(k,2856) * b(k,299) + b(k,303) = b(k,303) - lu(k,2857) * b(k,299) + b(k,304) = b(k,304) - lu(k,2858) * b(k,299) + b(k,305) = b(k,305) - lu(k,2859) * b(k,299) + b(k,306) = b(k,306) - lu(k,2860) * b(k,299) + b(k,307) = b(k,307) - lu(k,2861) * b(k,299) + b(k,308) = b(k,308) - lu(k,2862) * b(k,299) + b(k,309) = b(k,309) - lu(k,2863) * b(k,299) + b(k,310) = b(k,310) - lu(k,2864) * b(k,299) + b(k,311) = b(k,311) - lu(k,2865) * b(k,299) + b(k,312) = b(k,312) - lu(k,2866) * b(k,299) + b(k,313) = b(k,313) - lu(k,2867) * b(k,299) + b(k,314) = b(k,314) - lu(k,2868) * b(k,299) + b(k,315) = b(k,315) - lu(k,2869) * b(k,299) + b(k,301) = b(k,301) - lu(k,2902) * b(k,300) + b(k,302) = b(k,302) - lu(k,2903) * b(k,300) + b(k,303) = b(k,303) - lu(k,2904) * b(k,300) + b(k,304) = b(k,304) - lu(k,2905) * b(k,300) + b(k,305) = b(k,305) - lu(k,2906) * b(k,300) + b(k,306) = b(k,306) - lu(k,2907) * b(k,300) + b(k,307) = b(k,307) - lu(k,2908) * b(k,300) + b(k,308) = b(k,308) - lu(k,2909) * b(k,300) + b(k,309) = b(k,309) - lu(k,2910) * b(k,300) + b(k,310) = b(k,310) - lu(k,2911) * b(k,300) + b(k,311) = b(k,311) - lu(k,2912) * b(k,300) + b(k,312) = b(k,312) - lu(k,2913) * b(k,300) + b(k,313) = b(k,313) - lu(k,2914) * b(k,300) + b(k,314) = b(k,314) - lu(k,2915) * b(k,300) + b(k,315) = b(k,315) - lu(k,2916) * b(k,300) + b(k,302) = b(k,302) - lu(k,2949) * b(k,301) + b(k,303) = b(k,303) - lu(k,2950) * b(k,301) + b(k,304) = b(k,304) - lu(k,2951) * b(k,301) + b(k,305) = b(k,305) - lu(k,2952) * b(k,301) + b(k,306) = b(k,306) - lu(k,2953) * b(k,301) + b(k,307) = b(k,307) - lu(k,2954) * b(k,301) + b(k,308) = b(k,308) - lu(k,2955) * b(k,301) + b(k,309) = b(k,309) - lu(k,2956) * b(k,301) + b(k,310) = b(k,310) - lu(k,2957) * b(k,301) + b(k,311) = b(k,311) - lu(k,2958) * b(k,301) + b(k,312) = b(k,312) - lu(k,2959) * b(k,301) + b(k,313) = b(k,313) - lu(k,2960) * b(k,301) + b(k,314) = b(k,314) - lu(k,2961) * b(k,301) + b(k,315) = b(k,315) - lu(k,2962) * b(k,301) + b(k,303) = b(k,303) - lu(k,3024) * b(k,302) + b(k,304) = b(k,304) - lu(k,3025) * b(k,302) + b(k,305) = b(k,305) - lu(k,3026) * b(k,302) + b(k,306) = b(k,306) - lu(k,3027) * b(k,302) + b(k,307) = b(k,307) - lu(k,3028) * b(k,302) + b(k,308) = b(k,308) - lu(k,3029) * b(k,302) + b(k,309) = b(k,309) - lu(k,3030) * b(k,302) + b(k,310) = b(k,310) - lu(k,3031) * b(k,302) + b(k,311) = b(k,311) - lu(k,3032) * b(k,302) + b(k,312) = b(k,312) - lu(k,3033) * b(k,302) + b(k,313) = b(k,313) - lu(k,3034) * b(k,302) + b(k,314) = b(k,314) - lu(k,3035) * b(k,302) + b(k,315) = b(k,315) - lu(k,3036) * b(k,302) + b(k,304) = b(k,304) - lu(k,3128) * b(k,303) + b(k,305) = b(k,305) - lu(k,3129) * b(k,303) + b(k,306) = b(k,306) - lu(k,3130) * b(k,303) + b(k,307) = b(k,307) - lu(k,3131) * b(k,303) + b(k,308) = b(k,308) - lu(k,3132) * b(k,303) + b(k,309) = b(k,309) - lu(k,3133) * b(k,303) + b(k,310) = b(k,310) - lu(k,3134) * b(k,303) + b(k,311) = b(k,311) - lu(k,3135) * b(k,303) + b(k,312) = b(k,312) - lu(k,3136) * b(k,303) + b(k,313) = b(k,313) - lu(k,3137) * b(k,303) + b(k,314) = b(k,314) - lu(k,3138) * b(k,303) + b(k,315) = b(k,315) - lu(k,3139) * b(k,303) + b(k,305) = b(k,305) - lu(k,3152) * b(k,304) + b(k,306) = b(k,306) - lu(k,3153) * b(k,304) + b(k,307) = b(k,307) - lu(k,3154) * b(k,304) + b(k,308) = b(k,308) - lu(k,3155) * b(k,304) + b(k,309) = b(k,309) - lu(k,3156) * b(k,304) + b(k,310) = b(k,310) - lu(k,3157) * b(k,304) + b(k,311) = b(k,311) - lu(k,3158) * b(k,304) + b(k,312) = b(k,312) - lu(k,3159) * b(k,304) + b(k,313) = b(k,313) - lu(k,3160) * b(k,304) + b(k,314) = b(k,314) - lu(k,3161) * b(k,304) + b(k,315) = b(k,315) - lu(k,3162) * b(k,304) + b(k,306) = b(k,306) - lu(k,3312) * b(k,305) + b(k,307) = b(k,307) - lu(k,3313) * b(k,305) + b(k,308) = b(k,308) - lu(k,3314) * b(k,305) + b(k,309) = b(k,309) - lu(k,3315) * b(k,305) + b(k,310) = b(k,310) - lu(k,3316) * b(k,305) + b(k,311) = b(k,311) - lu(k,3317) * b(k,305) + b(k,312) = b(k,312) - lu(k,3318) * b(k,305) + b(k,313) = b(k,313) - lu(k,3319) * b(k,305) + b(k,314) = b(k,314) - lu(k,3320) * b(k,305) + b(k,315) = b(k,315) - lu(k,3321) * b(k,305) + b(k,307) = b(k,307) - lu(k,3332) * b(k,306) + b(k,308) = b(k,308) - lu(k,3333) * b(k,306) + b(k,309) = b(k,309) - lu(k,3334) * b(k,306) + b(k,310) = b(k,310) - lu(k,3335) * b(k,306) + b(k,311) = b(k,311) - lu(k,3336) * b(k,306) + b(k,312) = b(k,312) - lu(k,3337) * b(k,306) + b(k,313) = b(k,313) - lu(k,3338) * b(k,306) + b(k,314) = b(k,314) - lu(k,3339) * b(k,306) + b(k,315) = b(k,315) - lu(k,3340) * b(k,306) + b(k,308) = b(k,308) - lu(k,3359) * b(k,307) + b(k,309) = b(k,309) - lu(k,3360) * b(k,307) + b(k,310) = b(k,310) - lu(k,3361) * b(k,307) + b(k,311) = b(k,311) - lu(k,3362) * b(k,307) + b(k,312) = b(k,312) - lu(k,3363) * b(k,307) + b(k,313) = b(k,313) - lu(k,3364) * b(k,307) + b(k,314) = b(k,314) - lu(k,3365) * b(k,307) + b(k,315) = b(k,315) - lu(k,3366) * b(k,307) + b(k,309) = b(k,309) - lu(k,3391) * b(k,308) + b(k,310) = b(k,310) - lu(k,3392) * b(k,308) + b(k,311) = b(k,311) - lu(k,3393) * b(k,308) + b(k,312) = b(k,312) - lu(k,3394) * b(k,308) + b(k,313) = b(k,313) - lu(k,3395) * b(k,308) + b(k,314) = b(k,314) - lu(k,3396) * b(k,308) + b(k,315) = b(k,315) - lu(k,3397) * b(k,308) + b(k,310) = b(k,310) - lu(k,3572) * b(k,309) + b(k,311) = b(k,311) - lu(k,3573) * b(k,309) + b(k,312) = b(k,312) - lu(k,3574) * b(k,309) + b(k,313) = b(k,313) - lu(k,3575) * b(k,309) + b(k,314) = b(k,314) - lu(k,3576) * b(k,309) + b(k,315) = b(k,315) - lu(k,3577) * b(k,309) + b(k,311) = b(k,311) - lu(k,3823) * b(k,310) + b(k,312) = b(k,312) - lu(k,3824) * b(k,310) + b(k,313) = b(k,313) - lu(k,3825) * b(k,310) + b(k,314) = b(k,314) - lu(k,3826) * b(k,310) + b(k,315) = b(k,315) - lu(k,3827) * b(k,310) + b(k,312) = b(k,312) - lu(k,3865) * b(k,311) + b(k,313) = b(k,313) - lu(k,3866) * b(k,311) + b(k,314) = b(k,314) - lu(k,3867) * b(k,311) + b(k,315) = b(k,315) - lu(k,3868) * b(k,311) + b(k,313) = b(k,313) - lu(k,3960) * b(k,312) + b(k,314) = b(k,314) - lu(k,3961) * b(k,312) + b(k,315) = b(k,315) - lu(k,3962) * b(k,312) + b(k,314) = b(k,314) - lu(k,4053) * b(k,313) + b(k,315) = b(k,315) - lu(k,4054) * b(k,313) + b(k,315) = b(k,315) - lu(k,4106) * b(k,314) end do end subroutine lu_slv10 subroutine lu_slv11( avec_len, lu, b ) @@ -2092,342 +2231,264 @@ subroutine lu_slv11( avec_len, lu, b ) !----------------------------------------------------------------------- ! ... Solve U * x = y !----------------------------------------------------------------------- - b(k,286) = b(k,286) * lu(k,3862) - b(k,285) = b(k,285) - lu(k,3861) * b(k,286) - b(k,284) = b(k,284) - lu(k,3860) * b(k,286) - b(k,283) = b(k,283) - lu(k,3859) * b(k,286) - b(k,282) = b(k,282) - lu(k,3858) * b(k,286) - b(k,281) = b(k,281) - lu(k,3857) * b(k,286) - b(k,280) = b(k,280) - lu(k,3856) * b(k,286) - b(k,279) = b(k,279) - lu(k,3855) * b(k,286) - b(k,278) = b(k,278) - lu(k,3854) * b(k,286) - b(k,277) = b(k,277) - lu(k,3853) * b(k,286) - b(k,276) = b(k,276) - lu(k,3852) * b(k,286) - b(k,275) = b(k,275) - lu(k,3851) * b(k,286) - b(k,274) = b(k,274) - lu(k,3850) * b(k,286) - b(k,273) = b(k,273) - lu(k,3849) * b(k,286) - b(k,272) = b(k,272) - lu(k,3848) * b(k,286) - b(k,271) = b(k,271) - lu(k,3847) * b(k,286) - b(k,270) = b(k,270) - lu(k,3846) * b(k,286) - b(k,233) = b(k,233) - lu(k,3845) * b(k,286) - b(k,221) = b(k,221) - lu(k,3844) * b(k,286) - b(k,215) = b(k,215) - lu(k,3843) * b(k,286) - b(k,191) = b(k,191) - lu(k,3842) * b(k,286) - b(k,167) = b(k,167) - lu(k,3841) * b(k,286) - b(k,75) = b(k,75) - lu(k,3840) * b(k,286) - b(k,68) = b(k,68) - lu(k,3839) * b(k,286) - b(k,52) = b(k,52) - lu(k,3838) * b(k,286) - b(k,285) = b(k,285) * lu(k,3836) - b(k,284) = b(k,284) - lu(k,3835) * b(k,285) - b(k,283) = b(k,283) - lu(k,3834) * b(k,285) - b(k,282) = b(k,282) - lu(k,3833) * b(k,285) - b(k,281) = b(k,281) - lu(k,3832) * b(k,285) - b(k,280) = b(k,280) - lu(k,3831) * b(k,285) - b(k,279) = b(k,279) - lu(k,3830) * b(k,285) - b(k,278) = b(k,278) - lu(k,3829) * b(k,285) - b(k,277) = b(k,277) - lu(k,3828) * b(k,285) - b(k,276) = b(k,276) - lu(k,3827) * b(k,285) - b(k,275) = b(k,275) - lu(k,3826) * b(k,285) - b(k,274) = b(k,274) - lu(k,3825) * b(k,285) - b(k,273) = b(k,273) - lu(k,3824) * b(k,285) - b(k,272) = b(k,272) - lu(k,3823) * b(k,285) - b(k,271) = b(k,271) - lu(k,3822) * b(k,285) - b(k,270) = b(k,270) - lu(k,3821) * b(k,285) - b(k,269) = b(k,269) - lu(k,3820) * b(k,285) - b(k,233) = b(k,233) - lu(k,3819) * b(k,285) - b(k,223) = b(k,223) - lu(k,3818) * b(k,285) - b(k,218) = b(k,218) - lu(k,3817) * b(k,285) - b(k,215) = b(k,215) - lu(k,3816) * b(k,285) - b(k,209) = b(k,209) - lu(k,3815) * b(k,285) - b(k,208) = b(k,208) - lu(k,3814) * b(k,285) - b(k,203) = b(k,203) - lu(k,3813) * b(k,285) - b(k,199) = b(k,199) - lu(k,3812) * b(k,285) - b(k,196) = b(k,196) - lu(k,3811) * b(k,285) - b(k,193) = b(k,193) - lu(k,3810) * b(k,285) - b(k,187) = b(k,187) - lu(k,3809) * b(k,285) - b(k,182) = b(k,182) - lu(k,3808) * b(k,285) - b(k,151) = b(k,151) - lu(k,3807) * b(k,285) - b(k,123) = b(k,123) - lu(k,3806) * b(k,285) - b(k,85) = b(k,85) - lu(k,3805) * b(k,285) - b(k,84) = b(k,84) - lu(k,3804) * b(k,285) - b(k,55) = b(k,55) - lu(k,3803) * b(k,285) - b(k,284) = b(k,284) * lu(k,3800) - b(k,283) = b(k,283) - lu(k,3799) * b(k,284) - b(k,282) = b(k,282) - lu(k,3798) * b(k,284) - b(k,281) = b(k,281) - lu(k,3797) * b(k,284) - b(k,280) = b(k,280) - lu(k,3796) * b(k,284) - b(k,279) = b(k,279) - lu(k,3795) * b(k,284) - b(k,278) = b(k,278) - lu(k,3794) * b(k,284) - b(k,277) = b(k,277) - lu(k,3793) * b(k,284) - b(k,276) = b(k,276) - lu(k,3792) * b(k,284) - b(k,275) = b(k,275) - lu(k,3791) * b(k,284) - b(k,274) = b(k,274) - lu(k,3790) * b(k,284) - b(k,273) = b(k,273) - lu(k,3789) * b(k,284) - b(k,272) = b(k,272) - lu(k,3788) * b(k,284) - b(k,271) = b(k,271) - lu(k,3787) * b(k,284) - b(k,270) = b(k,270) - lu(k,3786) * b(k,284) - b(k,233) = b(k,233) - lu(k,3785) * b(k,284) - b(k,221) = b(k,221) - lu(k,3784) * b(k,284) - b(k,191) = b(k,191) - lu(k,3783) * b(k,284) - b(k,168) = b(k,168) - lu(k,3782) * b(k,284) - b(k,122) = b(k,122) - lu(k,3781) * b(k,284) - b(k,88) = b(k,88) - lu(k,3780) * b(k,284) - b(k,69) = b(k,69) - lu(k,3779) * b(k,284) - b(k,283) = b(k,283) * lu(k,3775) - b(k,282) = b(k,282) - lu(k,3774) * b(k,283) - b(k,281) = b(k,281) - lu(k,3773) * b(k,283) - b(k,280) = b(k,280) - lu(k,3772) * b(k,283) - b(k,279) = b(k,279) - lu(k,3771) * b(k,283) - b(k,278) = b(k,278) - lu(k,3770) * b(k,283) - b(k,277) = b(k,277) - lu(k,3769) * b(k,283) - b(k,276) = b(k,276) - lu(k,3768) * b(k,283) - b(k,275) = b(k,275) - lu(k,3767) * b(k,283) - b(k,274) = b(k,274) - lu(k,3766) * b(k,283) - b(k,273) = b(k,273) - lu(k,3765) * b(k,283) - b(k,271) = b(k,271) - lu(k,3764) * b(k,283) - b(k,270) = b(k,270) - lu(k,3763) * b(k,283) - b(k,233) = b(k,233) - lu(k,3762) * b(k,283) - b(k,196) = b(k,196) - lu(k,3761) * b(k,283) - b(k,182) = b(k,182) - lu(k,3760) * b(k,283) - b(k,168) = b(k,168) - lu(k,3759) * b(k,283) - b(k,69) = b(k,69) - lu(k,3758) * b(k,283) - b(k,55) = b(k,55) - lu(k,3757) * b(k,283) - b(k,282) = b(k,282) * lu(k,3752) - b(k,281) = b(k,281) - lu(k,3751) * b(k,282) - b(k,280) = b(k,280) - lu(k,3750) * b(k,282) - b(k,279) = b(k,279) - lu(k,3749) * b(k,282) - b(k,278) = b(k,278) - lu(k,3748) * b(k,282) - b(k,277) = b(k,277) - lu(k,3747) * b(k,282) - b(k,276) = b(k,276) - lu(k,3746) * b(k,282) - b(k,275) = b(k,275) - lu(k,3745) * b(k,282) - b(k,274) = b(k,274) - lu(k,3744) * b(k,282) - b(k,273) = b(k,273) - lu(k,3743) * b(k,282) - b(k,272) = b(k,272) - lu(k,3742) * b(k,282) - b(k,271) = b(k,271) - lu(k,3741) * b(k,282) - b(k,270) = b(k,270) - lu(k,3740) * b(k,282) - b(k,269) = b(k,269) - lu(k,3739) * b(k,282) - b(k,268) = b(k,268) - lu(k,3738) * b(k,282) - b(k,267) = b(k,267) - lu(k,3737) * b(k,282) - b(k,266) = b(k,266) - lu(k,3736) * b(k,282) - b(k,265) = b(k,265) - lu(k,3735) * b(k,282) - b(k,264) = b(k,264) - lu(k,3734) * b(k,282) - b(k,263) = b(k,263) - lu(k,3733) * b(k,282) - b(k,262) = b(k,262) - lu(k,3732) * b(k,282) - b(k,261) = b(k,261) - lu(k,3731) * b(k,282) - b(k,260) = b(k,260) - lu(k,3730) * b(k,282) - b(k,259) = b(k,259) - lu(k,3729) * b(k,282) - b(k,258) = b(k,258) - lu(k,3728) * b(k,282) - b(k,257) = b(k,257) - lu(k,3727) * b(k,282) - b(k,256) = b(k,256) - lu(k,3726) * b(k,282) - b(k,255) = b(k,255) - lu(k,3725) * b(k,282) - b(k,254) = b(k,254) - lu(k,3724) * b(k,282) - b(k,253) = b(k,253) - lu(k,3723) * b(k,282) - b(k,252) = b(k,252) - lu(k,3722) * b(k,282) - b(k,251) = b(k,251) - lu(k,3721) * b(k,282) - b(k,250) = b(k,250) - lu(k,3720) * b(k,282) - b(k,249) = b(k,249) - lu(k,3719) * b(k,282) - b(k,247) = b(k,247) - lu(k,3718) * b(k,282) - b(k,246) = b(k,246) - lu(k,3717) * b(k,282) - b(k,245) = b(k,245) - lu(k,3716) * b(k,282) - b(k,244) = b(k,244) - lu(k,3715) * b(k,282) - b(k,243) = b(k,243) - lu(k,3714) * b(k,282) - b(k,242) = b(k,242) - lu(k,3713) * b(k,282) - b(k,241) = b(k,241) - lu(k,3712) * b(k,282) - b(k,240) = b(k,240) - lu(k,3711) * b(k,282) - b(k,239) = b(k,239) - lu(k,3710) * b(k,282) - b(k,238) = b(k,238) - lu(k,3709) * b(k,282) - b(k,237) = b(k,237) - lu(k,3708) * b(k,282) - b(k,236) = b(k,236) - lu(k,3707) * b(k,282) - b(k,235) = b(k,235) - lu(k,3706) * b(k,282) - b(k,234) = b(k,234) - lu(k,3705) * b(k,282) - b(k,233) = b(k,233) - lu(k,3704) * b(k,282) - b(k,232) = b(k,232) - lu(k,3703) * b(k,282) - b(k,231) = b(k,231) - lu(k,3702) * b(k,282) - b(k,230) = b(k,230) - lu(k,3701) * b(k,282) - b(k,229) = b(k,229) - lu(k,3700) * b(k,282) - b(k,228) = b(k,228) - lu(k,3699) * b(k,282) - b(k,227) = b(k,227) - lu(k,3698) * b(k,282) - b(k,226) = b(k,226) - lu(k,3697) * b(k,282) - b(k,225) = b(k,225) - lu(k,3696) * b(k,282) - b(k,224) = b(k,224) - lu(k,3695) * b(k,282) - b(k,223) = b(k,223) - lu(k,3694) * b(k,282) - b(k,222) = b(k,222) - lu(k,3693) * b(k,282) - b(k,221) = b(k,221) - lu(k,3692) * b(k,282) - b(k,220) = b(k,220) - lu(k,3691) * b(k,282) - b(k,219) = b(k,219) - lu(k,3690) * b(k,282) - b(k,218) = b(k,218) - lu(k,3689) * b(k,282) - b(k,217) = b(k,217) - lu(k,3688) * b(k,282) - b(k,216) = b(k,216) - lu(k,3687) * b(k,282) - b(k,215) = b(k,215) - lu(k,3686) * b(k,282) - b(k,214) = b(k,214) - lu(k,3685) * b(k,282) - b(k,213) = b(k,213) - lu(k,3684) * b(k,282) - b(k,212) = b(k,212) - lu(k,3683) * b(k,282) - b(k,211) = b(k,211) - lu(k,3682) * b(k,282) - b(k,210) = b(k,210) - lu(k,3681) * b(k,282) - b(k,209) = b(k,209) - lu(k,3680) * b(k,282) - b(k,208) = b(k,208) - lu(k,3679) * b(k,282) - b(k,207) = b(k,207) - lu(k,3678) * b(k,282) - b(k,206) = b(k,206) - lu(k,3677) * b(k,282) - b(k,205) = b(k,205) - lu(k,3676) * b(k,282) - b(k,204) = b(k,204) - lu(k,3675) * b(k,282) - b(k,203) = b(k,203) - lu(k,3674) * b(k,282) - b(k,202) = b(k,202) - lu(k,3673) * b(k,282) - b(k,201) = b(k,201) - lu(k,3672) * b(k,282) - b(k,200) = b(k,200) - lu(k,3671) * b(k,282) - b(k,199) = b(k,199) - lu(k,3670) * b(k,282) - b(k,198) = b(k,198) - lu(k,3669) * b(k,282) - b(k,197) = b(k,197) - lu(k,3668) * b(k,282) - b(k,196) = b(k,196) - lu(k,3667) * b(k,282) - b(k,195) = b(k,195) - lu(k,3666) * b(k,282) - b(k,194) = b(k,194) - lu(k,3665) * b(k,282) - b(k,193) = b(k,193) - lu(k,3664) * b(k,282) - b(k,192) = b(k,192) - lu(k,3663) * b(k,282) - b(k,191) = b(k,191) - lu(k,3662) * b(k,282) - b(k,190) = b(k,190) - lu(k,3661) * b(k,282) - b(k,189) = b(k,189) - lu(k,3660) * b(k,282) - b(k,188) = b(k,188) - lu(k,3659) * b(k,282) - b(k,187) = b(k,187) - lu(k,3658) * b(k,282) - b(k,186) = b(k,186) - lu(k,3657) * b(k,282) - b(k,185) = b(k,185) - lu(k,3656) * b(k,282) - b(k,184) = b(k,184) - lu(k,3655) * b(k,282) - b(k,183) = b(k,183) - lu(k,3654) * b(k,282) - b(k,182) = b(k,182) - lu(k,3653) * b(k,282) - b(k,181) = b(k,181) - lu(k,3652) * b(k,282) - b(k,180) = b(k,180) - lu(k,3651) * b(k,282) - b(k,179) = b(k,179) - lu(k,3650) * b(k,282) - b(k,178) = b(k,178) - lu(k,3649) * b(k,282) - b(k,177) = b(k,177) - lu(k,3648) * b(k,282) - b(k,176) = b(k,176) - lu(k,3647) * b(k,282) - b(k,175) = b(k,175) - lu(k,3646) * b(k,282) - b(k,174) = b(k,174) - lu(k,3645) * b(k,282) - b(k,173) = b(k,173) - lu(k,3644) * b(k,282) - b(k,172) = b(k,172) - lu(k,3643) * b(k,282) - b(k,171) = b(k,171) - lu(k,3642) * b(k,282) - b(k,170) = b(k,170) - lu(k,3641) * b(k,282) - b(k,169) = b(k,169) - lu(k,3640) * b(k,282) - b(k,167) = b(k,167) - lu(k,3639) * b(k,282) - b(k,166) = b(k,166) - lu(k,3638) * b(k,282) - b(k,165) = b(k,165) - lu(k,3637) * b(k,282) - b(k,164) = b(k,164) - lu(k,3636) * b(k,282) - b(k,163) = b(k,163) - lu(k,3635) * b(k,282) - b(k,162) = b(k,162) - lu(k,3634) * b(k,282) - b(k,161) = b(k,161) - lu(k,3633) * b(k,282) - b(k,160) = b(k,160) - lu(k,3632) * b(k,282) - b(k,159) = b(k,159) - lu(k,3631) * b(k,282) - b(k,158) = b(k,158) - lu(k,3630) * b(k,282) - b(k,157) = b(k,157) - lu(k,3629) * b(k,282) - b(k,156) = b(k,156) - lu(k,3628) * b(k,282) - b(k,155) = b(k,155) - lu(k,3627) * b(k,282) - b(k,154) = b(k,154) - lu(k,3626) * b(k,282) - b(k,153) = b(k,153) - lu(k,3625) * b(k,282) - b(k,152) = b(k,152) - lu(k,3624) * b(k,282) - b(k,151) = b(k,151) - lu(k,3623) * b(k,282) - b(k,150) = b(k,150) - lu(k,3622) * b(k,282) - b(k,149) = b(k,149) - lu(k,3621) * b(k,282) - b(k,148) = b(k,148) - lu(k,3620) * b(k,282) - b(k,147) = b(k,147) - lu(k,3619) * b(k,282) - b(k,146) = b(k,146) - lu(k,3618) * b(k,282) - b(k,145) = b(k,145) - lu(k,3617) * b(k,282) - b(k,144) = b(k,144) - lu(k,3616) * b(k,282) - b(k,143) = b(k,143) - lu(k,3615) * b(k,282) - b(k,142) = b(k,142) - lu(k,3614) * b(k,282) - b(k,141) = b(k,141) - lu(k,3613) * b(k,282) - b(k,140) = b(k,140) - lu(k,3612) * b(k,282) - b(k,139) = b(k,139) - lu(k,3611) * b(k,282) - b(k,138) = b(k,138) - lu(k,3610) * b(k,282) - b(k,137) = b(k,137) - lu(k,3609) * b(k,282) - b(k,135) = b(k,135) - lu(k,3608) * b(k,282) - b(k,134) = b(k,134) - lu(k,3607) * b(k,282) - b(k,133) = b(k,133) - lu(k,3606) * b(k,282) - b(k,132) = b(k,132) - lu(k,3605) * b(k,282) - b(k,131) = b(k,131) - lu(k,3604) * b(k,282) - b(k,130) = b(k,130) - lu(k,3603) * b(k,282) - b(k,129) = b(k,129) - lu(k,3602) * b(k,282) - b(k,128) = b(k,128) - lu(k,3601) * b(k,282) - b(k,127) = b(k,127) - lu(k,3600) * b(k,282) - b(k,126) = b(k,126) - lu(k,3599) * b(k,282) - b(k,125) = b(k,125) - lu(k,3598) * b(k,282) - b(k,124) = b(k,124) - lu(k,3597) * b(k,282) - b(k,123) = b(k,123) - lu(k,3596) * b(k,282) - b(k,121) = b(k,121) - lu(k,3595) * b(k,282) - b(k,120) = b(k,120) - lu(k,3594) * b(k,282) - b(k,119) = b(k,119) - lu(k,3593) * b(k,282) - b(k,118) = b(k,118) - lu(k,3592) * b(k,282) - b(k,117) = b(k,117) - lu(k,3591) * b(k,282) - b(k,116) = b(k,116) - lu(k,3590) * b(k,282) - b(k,115) = b(k,115) - lu(k,3589) * b(k,282) - b(k,114) = b(k,114) - lu(k,3588) * b(k,282) - b(k,113) = b(k,113) - lu(k,3587) * b(k,282) - b(k,112) = b(k,112) - lu(k,3586) * b(k,282) - b(k,111) = b(k,111) - lu(k,3585) * b(k,282) - b(k,110) = b(k,110) - lu(k,3584) * b(k,282) - b(k,109) = b(k,109) - lu(k,3583) * b(k,282) - b(k,108) = b(k,108) - lu(k,3582) * b(k,282) - b(k,107) = b(k,107) - lu(k,3581) * b(k,282) - b(k,106) = b(k,106) - lu(k,3580) * b(k,282) - b(k,105) = b(k,105) - lu(k,3579) * b(k,282) - b(k,104) = b(k,104) - lu(k,3578) * b(k,282) - b(k,103) = b(k,103) - lu(k,3577) * b(k,282) - b(k,102) = b(k,102) - lu(k,3576) * b(k,282) - b(k,101) = b(k,101) - lu(k,3575) * b(k,282) - b(k,100) = b(k,100) - lu(k,3574) * b(k,282) - b(k,99) = b(k,99) - lu(k,3573) * b(k,282) - b(k,98) = b(k,98) - lu(k,3572) * b(k,282) - b(k,96) = b(k,96) - lu(k,3571) * b(k,282) - b(k,95) = b(k,95) - lu(k,3570) * b(k,282) - b(k,94) = b(k,94) - lu(k,3569) * b(k,282) - b(k,93) = b(k,93) - lu(k,3568) * b(k,282) - b(k,92) = b(k,92) - lu(k,3567) * b(k,282) - b(k,91) = b(k,91) - lu(k,3566) * b(k,282) - b(k,90) = b(k,90) - lu(k,3565) * b(k,282) - b(k,89) = b(k,89) - lu(k,3564) * b(k,282) - b(k,86) = b(k,86) - lu(k,3563) * b(k,282) - b(k,85) = b(k,85) - lu(k,3562) * b(k,282) - b(k,84) = b(k,84) - lu(k,3561) * b(k,282) - b(k,81) = b(k,81) - lu(k,3560) * b(k,282) - b(k,79) = b(k,79) - lu(k,3559) * b(k,282) - b(k,78) = b(k,78) - lu(k,3558) * b(k,282) - b(k,77) = b(k,77) - lu(k,3557) * b(k,282) - b(k,76) = b(k,76) - lu(k,3556) * b(k,282) - b(k,75) = b(k,75) - lu(k,3555) * b(k,282) - b(k,74) = b(k,74) - lu(k,3554) * b(k,282) - b(k,73) = b(k,73) - lu(k,3553) * b(k,282) - b(k,72) = b(k,72) - lu(k,3552) * b(k,282) - b(k,71) = b(k,71) - lu(k,3551) * b(k,282) - b(k,70) = b(k,70) - lu(k,3550) * b(k,282) - b(k,67) = b(k,67) - lu(k,3549) * b(k,282) - b(k,66) = b(k,66) - lu(k,3548) * b(k,282) - b(k,65) = b(k,65) - lu(k,3547) * b(k,282) - b(k,64) = b(k,64) - lu(k,3546) * b(k,282) - b(k,63) = b(k,63) - lu(k,3545) * b(k,282) - b(k,62) = b(k,62) - lu(k,3544) * b(k,282) - b(k,61) = b(k,61) - lu(k,3543) * b(k,282) - b(k,60) = b(k,60) - lu(k,3542) * b(k,282) - b(k,59) = b(k,59) - lu(k,3541) * b(k,282) - b(k,58) = b(k,58) - lu(k,3540) * b(k,282) - b(k,57) = b(k,57) - lu(k,3539) * b(k,282) - b(k,56) = b(k,56) - lu(k,3538) * b(k,282) - b(k,53) = b(k,53) - lu(k,3537) * b(k,282) - b(k,50) = b(k,50) - lu(k,3536) * b(k,282) - b(k,48) = b(k,48) - lu(k,3535) * b(k,282) - b(k,47) = b(k,47) - lu(k,3534) * b(k,282) - b(k,46) = b(k,46) - lu(k,3533) * b(k,282) - b(k,45) = b(k,45) - lu(k,3532) * b(k,282) - b(k,44) = b(k,44) - lu(k,3531) * b(k,282) - b(k,43) = b(k,43) - lu(k,3530) * b(k,282) - b(k,42) = b(k,42) - lu(k,3529) * b(k,282) - b(k,41) = b(k,41) - lu(k,3528) * b(k,282) - b(k,40) = b(k,40) - lu(k,3527) * b(k,282) - b(k,39) = b(k,39) - lu(k,3526) * b(k,282) - b(k,38) = b(k,38) - lu(k,3525) * b(k,282) - b(k,37) = b(k,37) - lu(k,3524) * b(k,282) - b(k,36) = b(k,36) - lu(k,3523) * b(k,282) - b(k,35) = b(k,35) - lu(k,3522) * b(k,282) - b(k,33) = b(k,33) - lu(k,3521) * b(k,282) - b(k,32) = b(k,32) - lu(k,3520) * b(k,282) - b(k,31) = b(k,31) - lu(k,3519) * b(k,282) - b(k,30) = b(k,30) - lu(k,3518) * b(k,282) - b(k,29) = b(k,29) - lu(k,3517) * b(k,282) + b(k,315) = b(k,315) * lu(k,4132) + b(k,314) = b(k,314) - lu(k,4131) * b(k,315) + b(k,313) = b(k,313) - lu(k,4130) * b(k,315) + b(k,312) = b(k,312) - lu(k,4129) * b(k,315) + b(k,311) = b(k,311) - lu(k,4128) * b(k,315) + b(k,310) = b(k,310) - lu(k,4127) * b(k,315) + b(k,309) = b(k,309) - lu(k,4126) * b(k,315) + b(k,308) = b(k,308) - lu(k,4125) * b(k,315) + b(k,307) = b(k,307) - lu(k,4124) * b(k,315) + b(k,306) = b(k,306) - lu(k,4123) * b(k,315) + b(k,305) = b(k,305) - lu(k,4122) * b(k,315) + b(k,304) = b(k,304) - lu(k,4121) * b(k,315) + b(k,303) = b(k,303) - lu(k,4120) * b(k,315) + b(k,292) = b(k,292) - lu(k,4119) * b(k,315) + b(k,291) = b(k,291) - lu(k,4118) * b(k,315) + b(k,290) = b(k,290) - lu(k,4117) * b(k,315) + b(k,289) = b(k,289) - lu(k,4116) * b(k,315) + b(k,277) = b(k,277) - lu(k,4115) * b(k,315) + b(k,274) = b(k,274) - lu(k,4114) * b(k,315) + b(k,249) = b(k,249) - lu(k,4113) * b(k,315) + b(k,244) = b(k,244) - lu(k,4112) * b(k,315) + b(k,217) = b(k,217) - lu(k,4111) * b(k,315) + b(k,214) = b(k,214) - lu(k,4110) * b(k,315) + b(k,106) = b(k,106) - lu(k,4109) * b(k,315) + b(k,96) = b(k,96) - lu(k,4108) * b(k,315) + b(k,67) = b(k,67) - lu(k,4107) * b(k,315) + b(k,314) = b(k,314) * lu(k,4105) + b(k,313) = b(k,313) - lu(k,4104) * b(k,314) + b(k,312) = b(k,312) - lu(k,4103) * b(k,314) + b(k,311) = b(k,311) - lu(k,4102) * b(k,314) + b(k,310) = b(k,310) - lu(k,4101) * b(k,314) + b(k,309) = b(k,309) - lu(k,4100) * b(k,314) + b(k,308) = b(k,308) - lu(k,4099) * b(k,314) + b(k,307) = b(k,307) - lu(k,4098) * b(k,314) + b(k,306) = b(k,306) - lu(k,4097) * b(k,314) + b(k,305) = b(k,305) - lu(k,4096) * b(k,314) + b(k,304) = b(k,304) - lu(k,4095) * b(k,314) + b(k,303) = b(k,303) - lu(k,4094) * b(k,314) + b(k,302) = b(k,302) - lu(k,4093) * b(k,314) + b(k,301) = b(k,301) - lu(k,4092) * b(k,314) + b(k,300) = b(k,300) - lu(k,4091) * b(k,314) + b(k,299) = b(k,299) - lu(k,4090) * b(k,314) + b(k,297) = b(k,297) - lu(k,4089) * b(k,314) + b(k,292) = b(k,292) - lu(k,4088) * b(k,314) + b(k,291) = b(k,291) - lu(k,4087) * b(k,314) + b(k,290) = b(k,290) - lu(k,4086) * b(k,314) + b(k,289) = b(k,289) - lu(k,4085) * b(k,314) + b(k,278) = b(k,278) - lu(k,4084) * b(k,314) + b(k,274) = b(k,274) - lu(k,4083) * b(k,314) + b(k,264) = b(k,264) - lu(k,4082) * b(k,314) + b(k,263) = b(k,263) - lu(k,4081) * b(k,314) + b(k,256) = b(k,256) - lu(k,4080) * b(k,314) + b(k,246) = b(k,246) - lu(k,4079) * b(k,314) + b(k,245) = b(k,245) - lu(k,4078) * b(k,314) + b(k,244) = b(k,244) - lu(k,4077) * b(k,314) + b(k,233) = b(k,233) - lu(k,4076) * b(k,314) + b(k,221) = b(k,221) - lu(k,4075) * b(k,314) + b(k,218) = b(k,218) - lu(k,4074) * b(k,314) + b(k,214) = b(k,214) - lu(k,4073) * b(k,314) + b(k,193) = b(k,193) - lu(k,4072) * b(k,314) + b(k,185) = b(k,185) - lu(k,4071) * b(k,314) + b(k,182) = b(k,182) - lu(k,4070) * b(k,314) + b(k,179) = b(k,179) - lu(k,4069) * b(k,314) + b(k,162) = b(k,162) - lu(k,4068) * b(k,314) + b(k,156) = b(k,156) - lu(k,4067) * b(k,314) + b(k,155) = b(k,155) - lu(k,4066) * b(k,314) + b(k,146) = b(k,146) - lu(k,4065) * b(k,314) + b(k,145) = b(k,145) - lu(k,4064) * b(k,314) + b(k,142) = b(k,142) - lu(k,4063) * b(k,314) + b(k,138) = b(k,138) - lu(k,4062) * b(k,314) + b(k,136) = b(k,136) - lu(k,4061) * b(k,314) + b(k,132) = b(k,132) - lu(k,4060) * b(k,314) + b(k,127) = b(k,127) - lu(k,4059) * b(k,314) + b(k,123) = b(k,123) - lu(k,4058) * b(k,314) + b(k,100) = b(k,100) - lu(k,4057) * b(k,314) + b(k,78) = b(k,78) - lu(k,4056) * b(k,314) + b(k,68) = b(k,68) - lu(k,4055) * b(k,314) + b(k,313) = b(k,313) * lu(k,4052) + b(k,312) = b(k,312) - lu(k,4051) * b(k,313) + b(k,311) = b(k,311) - lu(k,4050) * b(k,313) + b(k,310) = b(k,310) - lu(k,4049) * b(k,313) + b(k,309) = b(k,309) - lu(k,4048) * b(k,313) + b(k,308) = b(k,308) - lu(k,4047) * b(k,313) + b(k,307) = b(k,307) - lu(k,4046) * b(k,313) + b(k,306) = b(k,306) - lu(k,4045) * b(k,313) + b(k,305) = b(k,305) - lu(k,4044) * b(k,313) + b(k,304) = b(k,304) - lu(k,4043) * b(k,313) + b(k,303) = b(k,303) - lu(k,4042) * b(k,313) + b(k,302) = b(k,302) - lu(k,4041) * b(k,313) + b(k,301) = b(k,301) - lu(k,4040) * b(k,313) + b(k,300) = b(k,300) - lu(k,4039) * b(k,313) + b(k,299) = b(k,299) - lu(k,4038) * b(k,313) + b(k,298) = b(k,298) - lu(k,4037) * b(k,313) + b(k,297) = b(k,297) - lu(k,4036) * b(k,313) + b(k,296) = b(k,296) - lu(k,4035) * b(k,313) + b(k,295) = b(k,295) - lu(k,4034) * b(k,313) + b(k,294) = b(k,294) - lu(k,4033) * b(k,313) + b(k,293) = b(k,293) - lu(k,4032) * b(k,313) + b(k,292) = b(k,292) - lu(k,4031) * b(k,313) + b(k,291) = b(k,291) - lu(k,4030) * b(k,313) + b(k,290) = b(k,290) - lu(k,4029) * b(k,313) + b(k,288) = b(k,288) - lu(k,4028) * b(k,313) + b(k,287) = b(k,287) - lu(k,4027) * b(k,313) + b(k,286) = b(k,286) - lu(k,4026) * b(k,313) + b(k,285) = b(k,285) - lu(k,4025) * b(k,313) + b(k,284) = b(k,284) - lu(k,4024) * b(k,313) + b(k,283) = b(k,283) - lu(k,4023) * b(k,313) + b(k,282) = b(k,282) - lu(k,4022) * b(k,313) + b(k,281) = b(k,281) - lu(k,4021) * b(k,313) + b(k,280) = b(k,280) - lu(k,4020) * b(k,313) + b(k,279) = b(k,279) - lu(k,4019) * b(k,313) + b(k,278) = b(k,278) - lu(k,4018) * b(k,313) + b(k,277) = b(k,277) - lu(k,4017) * b(k,313) + b(k,276) = b(k,276) - lu(k,4016) * b(k,313) + b(k,275) = b(k,275) - lu(k,4015) * b(k,313) + b(k,273) = b(k,273) - lu(k,4014) * b(k,313) + b(k,272) = b(k,272) - lu(k,4013) * b(k,313) + b(k,271) = b(k,271) - lu(k,4012) * b(k,313) + b(k,270) = b(k,270) - lu(k,4011) * b(k,313) + b(k,269) = b(k,269) - lu(k,4010) * b(k,313) + b(k,268) = b(k,268) - lu(k,4009) * b(k,313) + b(k,267) = b(k,267) - lu(k,4008) * b(k,313) + b(k,266) = b(k,266) - lu(k,4007) * b(k,313) + b(k,265) = b(k,265) - lu(k,4006) * b(k,313) + b(k,264) = b(k,264) - lu(k,4005) * b(k,313) + b(k,263) = b(k,263) - lu(k,4004) * b(k,313) + b(k,262) = b(k,262) - lu(k,4003) * b(k,313) + b(k,261) = b(k,261) - lu(k,4002) * b(k,313) + b(k,260) = b(k,260) - lu(k,4001) * b(k,313) + b(k,259) = b(k,259) - lu(k,4000) * b(k,313) + b(k,258) = b(k,258) - lu(k,3999) * b(k,313) + b(k,257) = b(k,257) - lu(k,3998) * b(k,313) + b(k,256) = b(k,256) - lu(k,3997) * b(k,313) + b(k,255) = b(k,255) - lu(k,3996) * b(k,313) + b(k,254) = b(k,254) - lu(k,3995) * b(k,313) + b(k,253) = b(k,253) - lu(k,3994) * b(k,313) + b(k,252) = b(k,252) - lu(k,3993) * b(k,313) + b(k,251) = b(k,251) - lu(k,3992) * b(k,313) + b(k,250) = b(k,250) - lu(k,3991) * b(k,313) + b(k,248) = b(k,248) - lu(k,3990) * b(k,313) + b(k,247) = b(k,247) - lu(k,3989) * b(k,313) + b(k,246) = b(k,246) - lu(k,3988) * b(k,313) + b(k,245) = b(k,245) - lu(k,3987) * b(k,313) + b(k,242) = b(k,242) - lu(k,3986) * b(k,313) + b(k,241) = b(k,241) - lu(k,3985) * b(k,313) + b(k,240) = b(k,240) - lu(k,3984) * b(k,313) + b(k,238) = b(k,238) - lu(k,3983) * b(k,313) + b(k,237) = b(k,237) - lu(k,3982) * b(k,313) + b(k,236) = b(k,236) - lu(k,3981) * b(k,313) + b(k,234) = b(k,234) - lu(k,3980) * b(k,313) + b(k,232) = b(k,232) - lu(k,3979) * b(k,313) + b(k,231) = b(k,231) - lu(k,3978) * b(k,313) + b(k,230) = b(k,230) - lu(k,3977) * b(k,313) + b(k,229) = b(k,229) - lu(k,3976) * b(k,313) + b(k,228) = b(k,228) - lu(k,3975) * b(k,313) + b(k,223) = b(k,223) - lu(k,3974) * b(k,313) + b(k,222) = b(k,222) - lu(k,3973) * b(k,313) + b(k,218) = b(k,218) - lu(k,3972) * b(k,313) + b(k,216) = b(k,216) - lu(k,3971) * b(k,313) + b(k,201) = b(k,201) - lu(k,3970) * b(k,313) + b(k,197) = b(k,197) - lu(k,3969) * b(k,313) + b(k,183) = b(k,183) - lu(k,3968) * b(k,313) + b(k,171) = b(k,171) - lu(k,3967) * b(k,313) + b(k,167) = b(k,167) - lu(k,3966) * b(k,313) + b(k,129) = b(k,129) - lu(k,3965) * b(k,313) + b(k,97) = b(k,97) - lu(k,3964) * b(k,313) + b(k,42) = b(k,42) - lu(k,3963) * b(k,313) + b(k,312) = b(k,312) * lu(k,3959) + b(k,311) = b(k,311) - lu(k,3958) * b(k,312) + b(k,310) = b(k,310) - lu(k,3957) * b(k,312) + b(k,309) = b(k,309) - lu(k,3956) * b(k,312) + b(k,308) = b(k,308) - lu(k,3955) * b(k,312) + b(k,307) = b(k,307) - lu(k,3954) * b(k,312) + b(k,306) = b(k,306) - lu(k,3953) * b(k,312) + b(k,305) = b(k,305) - lu(k,3952) * b(k,312) + b(k,304) = b(k,304) - lu(k,3951) * b(k,312) + b(k,303) = b(k,303) - lu(k,3950) * b(k,312) + b(k,302) = b(k,302) - lu(k,3949) * b(k,312) + b(k,301) = b(k,301) - lu(k,3948) * b(k,312) + b(k,300) = b(k,300) - lu(k,3947) * b(k,312) + b(k,299) = b(k,299) - lu(k,3946) * b(k,312) + b(k,298) = b(k,298) - lu(k,3945) * b(k,312) + b(k,297) = b(k,297) - lu(k,3944) * b(k,312) + b(k,296) = b(k,296) - lu(k,3943) * b(k,312) + b(k,295) = b(k,295) - lu(k,3942) * b(k,312) + b(k,294) = b(k,294) - lu(k,3941) * b(k,312) + b(k,293) = b(k,293) - lu(k,3940) * b(k,312) + b(k,292) = b(k,292) - lu(k,3939) * b(k,312) + b(k,291) = b(k,291) - lu(k,3938) * b(k,312) + b(k,290) = b(k,290) - lu(k,3937) * b(k,312) + b(k,289) = b(k,289) - lu(k,3936) * b(k,312) + b(k,288) = b(k,288) - lu(k,3935) * b(k,312) + b(k,287) = b(k,287) - lu(k,3934) * b(k,312) + b(k,286) = b(k,286) - lu(k,3933) * b(k,312) + b(k,285) = b(k,285) - lu(k,3932) * b(k,312) + b(k,284) = b(k,284) - lu(k,3931) * b(k,312) + b(k,283) = b(k,283) - lu(k,3930) * b(k,312) + b(k,282) = b(k,282) - lu(k,3929) * b(k,312) + b(k,281) = b(k,281) - lu(k,3928) * b(k,312) + b(k,280) = b(k,280) - lu(k,3927) * b(k,312) + b(k,279) = b(k,279) - lu(k,3926) * b(k,312) + b(k,278) = b(k,278) - lu(k,3925) * b(k,312) + b(k,277) = b(k,277) - lu(k,3924) * b(k,312) + b(k,276) = b(k,276) - lu(k,3923) * b(k,312) + b(k,275) = b(k,275) - lu(k,3922) * b(k,312) + b(k,274) = b(k,274) - lu(k,3921) * b(k,312) + b(k,273) = b(k,273) - lu(k,3920) * b(k,312) + b(k,272) = b(k,272) - lu(k,3919) * b(k,312) + b(k,271) = b(k,271) - lu(k,3918) * b(k,312) + b(k,270) = b(k,270) - lu(k,3917) * b(k,312) + b(k,269) = b(k,269) - lu(k,3916) * b(k,312) + b(k,268) = b(k,268) - lu(k,3915) * b(k,312) + b(k,267) = b(k,267) - lu(k,3914) * b(k,312) + b(k,266) = b(k,266) - lu(k,3913) * b(k,312) + b(k,265) = b(k,265) - lu(k,3912) * b(k,312) + b(k,264) = b(k,264) - lu(k,3911) * b(k,312) + b(k,263) = b(k,263) - lu(k,3910) * b(k,312) + b(k,262) = b(k,262) - lu(k,3909) * b(k,312) + b(k,261) = b(k,261) - lu(k,3908) * b(k,312) + b(k,260) = b(k,260) - lu(k,3907) * b(k,312) + b(k,259) = b(k,259) - lu(k,3906) * b(k,312) + b(k,257) = b(k,257) - lu(k,3905) * b(k,312) + b(k,256) = b(k,256) - lu(k,3904) * b(k,312) + b(k,255) = b(k,255) - lu(k,3903) * b(k,312) + b(k,253) = b(k,253) - lu(k,3902) * b(k,312) + b(k,252) = b(k,252) - lu(k,3901) * b(k,312) + b(k,251) = b(k,251) - lu(k,3900) * b(k,312) + b(k,250) = b(k,250) - lu(k,3899) * b(k,312) + b(k,246) = b(k,246) - lu(k,3898) * b(k,312) + b(k,245) = b(k,245) - lu(k,3897) * b(k,312) + b(k,244) = b(k,244) - lu(k,3896) * b(k,312) + b(k,242) = b(k,242) - lu(k,3895) * b(k,312) + b(k,240) = b(k,240) - lu(k,3894) * b(k,312) + b(k,236) = b(k,236) - lu(k,3893) * b(k,312) + b(k,235) = b(k,235) - lu(k,3892) * b(k,312) + b(k,234) = b(k,234) - lu(k,3891) * b(k,312) + b(k,228) = b(k,228) - lu(k,3890) * b(k,312) + b(k,226) = b(k,226) - lu(k,3889) * b(k,312) + b(k,225) = b(k,225) - lu(k,3888) * b(k,312) + b(k,224) = b(k,224) - lu(k,3887) * b(k,312) + b(k,223) = b(k,223) - lu(k,3886) * b(k,312) + b(k,218) = b(k,218) - lu(k,3885) * b(k,312) + b(k,215) = b(k,215) - lu(k,3884) * b(k,312) + b(k,214) = b(k,214) - lu(k,3883) * b(k,312) + b(k,211) = b(k,211) - lu(k,3882) * b(k,312) + b(k,210) = b(k,210) - lu(k,3881) * b(k,312) + b(k,201) = b(k,201) - lu(k,3880) * b(k,312) + b(k,200) = b(k,200) - lu(k,3879) * b(k,312) + b(k,199) = b(k,199) - lu(k,3878) * b(k,312) + b(k,196) = b(k,196) - lu(k,3877) * b(k,312) + b(k,191) = b(k,191) - lu(k,3876) * b(k,312) + b(k,177) = b(k,177) - lu(k,3875) * b(k,312) + b(k,150) = b(k,150) - lu(k,3874) * b(k,312) + b(k,116) = b(k,116) - lu(k,3873) * b(k,312) + b(k,105) = b(k,105) - lu(k,3872) * b(k,312) + b(k,100) = b(k,100) - lu(k,3871) * b(k,312) + b(k,41) = b(k,41) - lu(k,3870) * b(k,312) + b(k,40) = b(k,40) - lu(k,3869) * b(k,312) end do end subroutine lu_slv11 subroutine lu_slv12( avec_len, lu, b ) @@ -2448,361 +2509,288 @@ subroutine lu_slv12( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,281) = b(k,281) * lu(k,3511) - b(k,280) = b(k,280) - lu(k,3510) * b(k,281) - b(k,279) = b(k,279) - lu(k,3509) * b(k,281) - b(k,278) = b(k,278) - lu(k,3508) * b(k,281) - b(k,277) = b(k,277) - lu(k,3507) * b(k,281) - b(k,276) = b(k,276) - lu(k,3506) * b(k,281) - b(k,275) = b(k,275) - lu(k,3505) * b(k,281) - b(k,274) = b(k,274) - lu(k,3504) * b(k,281) - b(k,273) = b(k,273) - lu(k,3503) * b(k,281) - b(k,272) = b(k,272) - lu(k,3502) * b(k,281) - b(k,271) = b(k,271) - lu(k,3501) * b(k,281) - b(k,270) = b(k,270) - lu(k,3500) * b(k,281) - b(k,269) = b(k,269) - lu(k,3499) * b(k,281) - b(k,268) = b(k,268) - lu(k,3498) * b(k,281) - b(k,267) = b(k,267) - lu(k,3497) * b(k,281) - b(k,266) = b(k,266) - lu(k,3496) * b(k,281) - b(k,265) = b(k,265) - lu(k,3495) * b(k,281) - b(k,251) = b(k,251) - lu(k,3494) * b(k,281) - b(k,240) = b(k,240) - lu(k,3493) * b(k,281) - b(k,233) = b(k,233) - lu(k,3492) * b(k,281) - b(k,228) = b(k,228) - lu(k,3491) * b(k,281) - b(k,223) = b(k,223) - lu(k,3490) * b(k,281) - b(k,221) = b(k,221) - lu(k,3489) * b(k,281) - b(k,220) = b(k,220) - lu(k,3488) * b(k,281) - b(k,196) = b(k,196) - lu(k,3487) * b(k,281) - b(k,193) = b(k,193) - lu(k,3486) * b(k,281) - b(k,192) = b(k,192) - lu(k,3485) * b(k,281) - b(k,191) = b(k,191) - lu(k,3484) * b(k,281) - b(k,168) = b(k,168) - lu(k,3483) * b(k,281) - b(k,159) = b(k,159) - lu(k,3482) * b(k,281) - b(k,155) = b(k,155) - lu(k,3481) * b(k,281) - b(k,152) = b(k,152) - lu(k,3480) * b(k,281) - b(k,137) = b(k,137) - lu(k,3479) * b(k,281) - b(k,125) = b(k,125) - lu(k,3478) * b(k,281) - b(k,124) = b(k,124) - lu(k,3477) * b(k,281) - b(k,122) = b(k,122) - lu(k,3476) * b(k,281) - b(k,118) = b(k,118) - lu(k,3475) * b(k,281) - b(k,110) = b(k,110) - lu(k,3474) * b(k,281) - b(k,109) = b(k,109) - lu(k,3473) * b(k,281) - b(k,108) = b(k,108) - lu(k,3472) * b(k,281) - b(k,103) = b(k,103) - lu(k,3471) * b(k,281) - b(k,100) = b(k,100) - lu(k,3470) * b(k,281) - b(k,95) = b(k,95) - lu(k,3469) * b(k,281) - b(k,82) = b(k,82) - lu(k,3468) * b(k,281) - b(k,54) = b(k,54) - lu(k,3467) * b(k,281) - b(k,280) = b(k,280) * lu(k,3460) - b(k,279) = b(k,279) - lu(k,3459) * b(k,280) - b(k,278) = b(k,278) - lu(k,3458) * b(k,280) - b(k,277) = b(k,277) - lu(k,3457) * b(k,280) - b(k,276) = b(k,276) - lu(k,3456) * b(k,280) - b(k,275) = b(k,275) - lu(k,3455) * b(k,280) - b(k,274) = b(k,274) - lu(k,3454) * b(k,280) - b(k,273) = b(k,273) - lu(k,3453) * b(k,280) - b(k,272) = b(k,272) - lu(k,3452) * b(k,280) - b(k,271) = b(k,271) - lu(k,3451) * b(k,280) - b(k,270) = b(k,270) - lu(k,3450) * b(k,280) - b(k,233) = b(k,233) - lu(k,3449) * b(k,280) - b(k,223) = b(k,223) - lu(k,3448) * b(k,280) - b(k,221) = b(k,221) - lu(k,3447) * b(k,280) - b(k,215) = b(k,215) - lu(k,3446) * b(k,280) - b(k,208) = b(k,208) - lu(k,3445) * b(k,280) - b(k,196) = b(k,196) - lu(k,3444) * b(k,280) - b(k,191) = b(k,191) - lu(k,3443) * b(k,280) - b(k,182) = b(k,182) - lu(k,3442) * b(k,280) - b(k,180) = b(k,180) - lu(k,3441) * b(k,280) - b(k,168) = b(k,168) - lu(k,3440) * b(k,280) - b(k,122) = b(k,122) - lu(k,3439) * b(k,280) - b(k,117) = b(k,117) - lu(k,3438) * b(k,280) - b(k,93) = b(k,93) - lu(k,3437) * b(k,280) - b(k,279) = b(k,279) * lu(k,3429) - b(k,278) = b(k,278) - lu(k,3428) * b(k,279) - b(k,277) = b(k,277) - lu(k,3427) * b(k,279) - b(k,276) = b(k,276) - lu(k,3426) * b(k,279) - b(k,275) = b(k,275) - lu(k,3425) * b(k,279) - b(k,274) = b(k,274) - lu(k,3424) * b(k,279) - b(k,273) = b(k,273) - lu(k,3423) * b(k,279) - b(k,272) = b(k,272) - lu(k,3422) * b(k,279) - b(k,271) = b(k,271) - lu(k,3421) * b(k,279) - b(k,270) = b(k,270) - lu(k,3420) * b(k,279) - b(k,269) = b(k,269) - lu(k,3419) * b(k,279) - b(k,268) = b(k,268) - lu(k,3418) * b(k,279) - b(k,267) = b(k,267) - lu(k,3417) * b(k,279) - b(k,266) = b(k,266) - lu(k,3416) * b(k,279) - b(k,265) = b(k,265) - lu(k,3415) * b(k,279) - b(k,264) = b(k,264) - lu(k,3414) * b(k,279) - b(k,263) = b(k,263) - lu(k,3413) * b(k,279) - b(k,262) = b(k,262) - lu(k,3412) * b(k,279) - b(k,261) = b(k,261) - lu(k,3411) * b(k,279) - b(k,260) = b(k,260) - lu(k,3410) * b(k,279) - b(k,259) = b(k,259) - lu(k,3409) * b(k,279) - b(k,258) = b(k,258) - lu(k,3408) * b(k,279) - b(k,257) = b(k,257) - lu(k,3407) * b(k,279) - b(k,256) = b(k,256) - lu(k,3406) * b(k,279) - b(k,255) = b(k,255) - lu(k,3405) * b(k,279) - b(k,254) = b(k,254) - lu(k,3404) * b(k,279) - b(k,253) = b(k,253) - lu(k,3403) * b(k,279) - b(k,252) = b(k,252) - lu(k,3402) * b(k,279) - b(k,251) = b(k,251) - lu(k,3401) * b(k,279) - b(k,250) = b(k,250) - lu(k,3400) * b(k,279) - b(k,249) = b(k,249) - lu(k,3399) * b(k,279) - b(k,248) = b(k,248) - lu(k,3398) * b(k,279) - b(k,247) = b(k,247) - lu(k,3397) * b(k,279) - b(k,246) = b(k,246) - lu(k,3396) * b(k,279) - b(k,245) = b(k,245) - lu(k,3395) * b(k,279) - b(k,244) = b(k,244) - lu(k,3394) * b(k,279) - b(k,243) = b(k,243) - lu(k,3393) * b(k,279) - b(k,242) = b(k,242) - lu(k,3392) * b(k,279) - b(k,241) = b(k,241) - lu(k,3391) * b(k,279) - b(k,240) = b(k,240) - lu(k,3390) * b(k,279) - b(k,239) = b(k,239) - lu(k,3389) * b(k,279) - b(k,238) = b(k,238) - lu(k,3388) * b(k,279) - b(k,237) = b(k,237) - lu(k,3387) * b(k,279) - b(k,236) = b(k,236) - lu(k,3386) * b(k,279) - b(k,235) = b(k,235) - lu(k,3385) * b(k,279) - b(k,234) = b(k,234) - lu(k,3384) * b(k,279) - b(k,232) = b(k,232) - lu(k,3383) * b(k,279) - b(k,231) = b(k,231) - lu(k,3382) * b(k,279) - b(k,230) = b(k,230) - lu(k,3381) * b(k,279) - b(k,229) = b(k,229) - lu(k,3380) * b(k,279) - b(k,228) = b(k,228) - lu(k,3379) * b(k,279) - b(k,227) = b(k,227) - lu(k,3378) * b(k,279) - b(k,226) = b(k,226) - lu(k,3377) * b(k,279) - b(k,225) = b(k,225) - lu(k,3376) * b(k,279) - b(k,224) = b(k,224) - lu(k,3375) * b(k,279) - b(k,223) = b(k,223) - lu(k,3374) * b(k,279) - b(k,222) = b(k,222) - lu(k,3373) * b(k,279) - b(k,220) = b(k,220) - lu(k,3372) * b(k,279) - b(k,219) = b(k,219) - lu(k,3371) * b(k,279) - b(k,218) = b(k,218) - lu(k,3370) * b(k,279) - b(k,217) = b(k,217) - lu(k,3369) * b(k,279) - b(k,213) = b(k,213) - lu(k,3368) * b(k,279) - b(k,212) = b(k,212) - lu(k,3367) * b(k,279) - b(k,211) = b(k,211) - lu(k,3366) * b(k,279) - b(k,210) = b(k,210) - lu(k,3365) * b(k,279) - b(k,209) = b(k,209) - lu(k,3364) * b(k,279) - b(k,207) = b(k,207) - lu(k,3363) * b(k,279) - b(k,206) = b(k,206) - lu(k,3362) * b(k,279) - b(k,205) = b(k,205) - lu(k,3361) * b(k,279) - b(k,204) = b(k,204) - lu(k,3360) * b(k,279) - b(k,203) = b(k,203) - lu(k,3359) * b(k,279) - b(k,199) = b(k,199) - lu(k,3358) * b(k,279) - b(k,198) = b(k,198) - lu(k,3357) * b(k,279) - b(k,197) = b(k,197) - lu(k,3356) * b(k,279) - b(k,192) = b(k,192) - lu(k,3355) * b(k,279) - b(k,184) = b(k,184) - lu(k,3354) * b(k,279) - b(k,175) = b(k,175) - lu(k,3353) * b(k,279) - b(k,173) = b(k,173) - lu(k,3352) * b(k,279) - b(k,156) = b(k,156) - lu(k,3351) * b(k,279) - b(k,139) = b(k,139) - lu(k,3350) * b(k,279) - b(k,128) = b(k,128) - lu(k,3349) * b(k,279) - b(k,104) = b(k,104) - lu(k,3348) * b(k,279) - b(k,76) = b(k,76) - lu(k,3347) * b(k,279) - b(k,34) = b(k,34) - lu(k,3346) * b(k,279) - b(k,278) = b(k,278) * lu(k,3337) - b(k,277) = b(k,277) - lu(k,3336) * b(k,278) - b(k,276) = b(k,276) - lu(k,3335) * b(k,278) - b(k,275) = b(k,275) - lu(k,3334) * b(k,278) - b(k,274) = b(k,274) - lu(k,3333) * b(k,278) - b(k,273) = b(k,273) - lu(k,3332) * b(k,278) - b(k,272) = b(k,272) - lu(k,3331) * b(k,278) - b(k,271) = b(k,271) - lu(k,3330) * b(k,278) - b(k,270) = b(k,270) - lu(k,3329) * b(k,278) - b(k,233) = b(k,233) - lu(k,3328) * b(k,278) - b(k,223) = b(k,223) - lu(k,3327) * b(k,278) - b(k,215) = b(k,215) - lu(k,3326) * b(k,278) - b(k,187) = b(k,187) - lu(k,3325) * b(k,278) - b(k,186) = b(k,186) - lu(k,3324) * b(k,278) - b(k,180) = b(k,180) - lu(k,3323) * b(k,278) - b(k,136) = b(k,136) - lu(k,3322) * b(k,278) - b(k,277) = b(k,277) * lu(k,3312) - b(k,276) = b(k,276) - lu(k,3311) * b(k,277) - b(k,275) = b(k,275) - lu(k,3310) * b(k,277) - b(k,274) = b(k,274) - lu(k,3309) * b(k,277) - b(k,273) = b(k,273) - lu(k,3308) * b(k,277) - b(k,272) = b(k,272) - lu(k,3307) * b(k,277) - b(k,271) = b(k,271) - lu(k,3306) * b(k,277) - b(k,270) = b(k,270) - lu(k,3305) * b(k,277) - b(k,233) = b(k,233) - lu(k,3304) * b(k,277) - b(k,221) = b(k,221) - lu(k,3303) * b(k,277) - b(k,196) = b(k,196) - lu(k,3302) * b(k,277) - b(k,191) = b(k,191) - lu(k,3301) * b(k,277) - b(k,182) = b(k,182) - lu(k,3300) * b(k,277) - b(k,88) = b(k,88) - lu(k,3299) * b(k,277) - b(k,69) = b(k,69) - lu(k,3298) * b(k,277) - b(k,55) = b(k,55) - lu(k,3297) * b(k,277) - b(k,49) = b(k,49) - lu(k,3296) * b(k,277) - b(k,276) = b(k,276) * lu(k,3285) - b(k,275) = b(k,275) - lu(k,3284) * b(k,276) - b(k,274) = b(k,274) - lu(k,3283) * b(k,276) - b(k,273) = b(k,273) - lu(k,3282) * b(k,276) - b(k,272) = b(k,272) - lu(k,3281) * b(k,276) - b(k,271) = b(k,271) - lu(k,3280) * b(k,276) - b(k,270) = b(k,270) - lu(k,3279) * b(k,276) - b(k,269) = b(k,269) - lu(k,3278) * b(k,276) - b(k,268) = b(k,268) - lu(k,3277) * b(k,276) - b(k,267) = b(k,267) - lu(k,3276) * b(k,276) - b(k,266) = b(k,266) - lu(k,3275) * b(k,276) - b(k,265) = b(k,265) - lu(k,3274) * b(k,276) - b(k,264) = b(k,264) - lu(k,3273) * b(k,276) - b(k,263) = b(k,263) - lu(k,3272) * b(k,276) - b(k,262) = b(k,262) - lu(k,3271) * b(k,276) - b(k,261) = b(k,261) - lu(k,3270) * b(k,276) - b(k,260) = b(k,260) - lu(k,3269) * b(k,276) - b(k,259) = b(k,259) - lu(k,3268) * b(k,276) - b(k,258) = b(k,258) - lu(k,3267) * b(k,276) - b(k,257) = b(k,257) - lu(k,3266) * b(k,276) - b(k,256) = b(k,256) - lu(k,3265) * b(k,276) - b(k,255) = b(k,255) - lu(k,3264) * b(k,276) - b(k,254) = b(k,254) - lu(k,3263) * b(k,276) - b(k,253) = b(k,253) - lu(k,3262) * b(k,276) - b(k,252) = b(k,252) - lu(k,3261) * b(k,276) - b(k,251) = b(k,251) - lu(k,3260) * b(k,276) - b(k,250) = b(k,250) - lu(k,3259) * b(k,276) - b(k,249) = b(k,249) - lu(k,3258) * b(k,276) - b(k,248) = b(k,248) - lu(k,3257) * b(k,276) - b(k,247) = b(k,247) - lu(k,3256) * b(k,276) - b(k,246) = b(k,246) - lu(k,3255) * b(k,276) - b(k,245) = b(k,245) - lu(k,3254) * b(k,276) - b(k,244) = b(k,244) - lu(k,3253) * b(k,276) - b(k,243) = b(k,243) - lu(k,3252) * b(k,276) - b(k,242) = b(k,242) - lu(k,3251) * b(k,276) - b(k,241) = b(k,241) - lu(k,3250) * b(k,276) - b(k,240) = b(k,240) - lu(k,3249) * b(k,276) - b(k,239) = b(k,239) - lu(k,3248) * b(k,276) - b(k,238) = b(k,238) - lu(k,3247) * b(k,276) - b(k,237) = b(k,237) - lu(k,3246) * b(k,276) - b(k,236) = b(k,236) - lu(k,3245) * b(k,276) - b(k,235) = b(k,235) - lu(k,3244) * b(k,276) - b(k,234) = b(k,234) - lu(k,3243) * b(k,276) - b(k,233) = b(k,233) - lu(k,3242) * b(k,276) - b(k,232) = b(k,232) - lu(k,3241) * b(k,276) - b(k,231) = b(k,231) - lu(k,3240) * b(k,276) - b(k,230) = b(k,230) - lu(k,3239) * b(k,276) - b(k,229) = b(k,229) - lu(k,3238) * b(k,276) - b(k,228) = b(k,228) - lu(k,3237) * b(k,276) - b(k,227) = b(k,227) - lu(k,3236) * b(k,276) - b(k,226) = b(k,226) - lu(k,3235) * b(k,276) - b(k,225) = b(k,225) - lu(k,3234) * b(k,276) - b(k,224) = b(k,224) - lu(k,3233) * b(k,276) - b(k,223) = b(k,223) - lu(k,3232) * b(k,276) - b(k,222) = b(k,222) - lu(k,3231) * b(k,276) - b(k,220) = b(k,220) - lu(k,3230) * b(k,276) - b(k,219) = b(k,219) - lu(k,3229) * b(k,276) - b(k,218) = b(k,218) - lu(k,3228) * b(k,276) - b(k,217) = b(k,217) - lu(k,3227) * b(k,276) - b(k,216) = b(k,216) - lu(k,3226) * b(k,276) - b(k,215) = b(k,215) - lu(k,3225) * b(k,276) - b(k,214) = b(k,214) - lu(k,3224) * b(k,276) - b(k,213) = b(k,213) - lu(k,3223) * b(k,276) - b(k,212) = b(k,212) - lu(k,3222) * b(k,276) - b(k,211) = b(k,211) - lu(k,3221) * b(k,276) - b(k,210) = b(k,210) - lu(k,3220) * b(k,276) - b(k,209) = b(k,209) - lu(k,3219) * b(k,276) - b(k,208) = b(k,208) - lu(k,3218) * b(k,276) - b(k,207) = b(k,207) - lu(k,3217) * b(k,276) - b(k,206) = b(k,206) - lu(k,3216) * b(k,276) - b(k,205) = b(k,205) - lu(k,3215) * b(k,276) - b(k,204) = b(k,204) - lu(k,3214) * b(k,276) - b(k,203) = b(k,203) - lu(k,3213) * b(k,276) - b(k,201) = b(k,201) - lu(k,3212) * b(k,276) - b(k,200) = b(k,200) - lu(k,3211) * b(k,276) - b(k,199) = b(k,199) - lu(k,3210) * b(k,276) - b(k,198) = b(k,198) - lu(k,3209) * b(k,276) - b(k,197) = b(k,197) - lu(k,3208) * b(k,276) - b(k,194) = b(k,194) - lu(k,3207) * b(k,276) - b(k,193) = b(k,193) - lu(k,3206) * b(k,276) - b(k,190) = b(k,190) - lu(k,3205) * b(k,276) - b(k,189) = b(k,189) - lu(k,3204) * b(k,276) - b(k,188) = b(k,188) - lu(k,3203) * b(k,276) - b(k,187) = b(k,187) - lu(k,3202) * b(k,276) - b(k,186) = b(k,186) - lu(k,3201) * b(k,276) - b(k,183) = b(k,183) - lu(k,3200) * b(k,276) - b(k,182) = b(k,182) - lu(k,3199) * b(k,276) - b(k,181) = b(k,181) - lu(k,3198) * b(k,276) - b(k,180) = b(k,180) - lu(k,3197) * b(k,276) - b(k,179) = b(k,179) - lu(k,3196) * b(k,276) - b(k,177) = b(k,177) - lu(k,3195) * b(k,276) - b(k,176) = b(k,176) - lu(k,3194) * b(k,276) - b(k,175) = b(k,175) - lu(k,3193) * b(k,276) - b(k,174) = b(k,174) - lu(k,3192) * b(k,276) - b(k,173) = b(k,173) - lu(k,3191) * b(k,276) - b(k,170) = b(k,170) - lu(k,3190) * b(k,276) - b(k,169) = b(k,169) - lu(k,3189) * b(k,276) - b(k,168) = b(k,168) - lu(k,3188) * b(k,276) - b(k,166) = b(k,166) - lu(k,3187) * b(k,276) - b(k,164) = b(k,164) - lu(k,3186) * b(k,276) - b(k,162) = b(k,162) - lu(k,3185) * b(k,276) - b(k,161) = b(k,161) - lu(k,3184) * b(k,276) - b(k,160) = b(k,160) - lu(k,3183) * b(k,276) - b(k,159) = b(k,159) - lu(k,3182) * b(k,276) - b(k,158) = b(k,158) - lu(k,3181) * b(k,276) - b(k,155) = b(k,155) - lu(k,3180) * b(k,276) - b(k,154) = b(k,154) - lu(k,3179) * b(k,276) - b(k,153) = b(k,153) - lu(k,3178) * b(k,276) - b(k,152) = b(k,152) - lu(k,3177) * b(k,276) - b(k,151) = b(k,151) - lu(k,3176) * b(k,276) - b(k,150) = b(k,150) - lu(k,3175) * b(k,276) - b(k,149) = b(k,149) - lu(k,3174) * b(k,276) - b(k,147) = b(k,147) - lu(k,3173) * b(k,276) - b(k,146) = b(k,146) - lu(k,3172) * b(k,276) - b(k,145) = b(k,145) - lu(k,3171) * b(k,276) - b(k,144) = b(k,144) - lu(k,3170) * b(k,276) - b(k,143) = b(k,143) - lu(k,3169) * b(k,276) - b(k,142) = b(k,142) - lu(k,3168) * b(k,276) - b(k,141) = b(k,141) - lu(k,3167) * b(k,276) - b(k,138) = b(k,138) - lu(k,3166) * b(k,276) - b(k,137) = b(k,137) - lu(k,3165) * b(k,276) - b(k,136) = b(k,136) - lu(k,3164) * b(k,276) - b(k,135) = b(k,135) - lu(k,3163) * b(k,276) - b(k,134) = b(k,134) - lu(k,3162) * b(k,276) - b(k,128) = b(k,128) - lu(k,3161) * b(k,276) - b(k,127) = b(k,127) - lu(k,3160) * b(k,276) - b(k,126) = b(k,126) - lu(k,3159) * b(k,276) - b(k,121) = b(k,121) - lu(k,3158) * b(k,276) - b(k,119) = b(k,119) - lu(k,3157) * b(k,276) - b(k,118) = b(k,118) - lu(k,3156) * b(k,276) - b(k,115) = b(k,115) - lu(k,3155) * b(k,276) - b(k,114) = b(k,114) - lu(k,3154) * b(k,276) - b(k,110) = b(k,110) - lu(k,3153) * b(k,276) - b(k,107) = b(k,107) - lu(k,3152) * b(k,276) - b(k,106) = b(k,106) - lu(k,3151) * b(k,276) - b(k,105) = b(k,105) - lu(k,3150) * b(k,276) - b(k,104) = b(k,104) - lu(k,3149) * b(k,276) - b(k,103) = b(k,103) - lu(k,3148) * b(k,276) - b(k,102) = b(k,102) - lu(k,3147) * b(k,276) - b(k,101) = b(k,101) - lu(k,3146) * b(k,276) - b(k,99) = b(k,99) - lu(k,3145) * b(k,276) - b(k,98) = b(k,98) - lu(k,3144) * b(k,276) - b(k,96) = b(k,96) - lu(k,3143) * b(k,276) - b(k,92) = b(k,92) - lu(k,3142) * b(k,276) - b(k,91) = b(k,91) - lu(k,3141) * b(k,276) - b(k,90) = b(k,90) - lu(k,3140) * b(k,276) - b(k,89) = b(k,89) - lu(k,3139) * b(k,276) - b(k,86) = b(k,86) - lu(k,3138) * b(k,276) - b(k,80) = b(k,80) - lu(k,3137) * b(k,276) - b(k,79) = b(k,79) - lu(k,3136) * b(k,276) - b(k,78) = b(k,78) - lu(k,3135) * b(k,276) - b(k,77) = b(k,77) - lu(k,3134) * b(k,276) - b(k,51) = b(k,51) - lu(k,3133) * b(k,276) - b(k,46) = b(k,46) - lu(k,3132) * b(k,276) - b(k,45) = b(k,45) - lu(k,3131) * b(k,276) - b(k,44) = b(k,44) - lu(k,3130) * b(k,276) - b(k,43) = b(k,43) - lu(k,3129) * b(k,276) - b(k,41) = b(k,41) - lu(k,3128) * b(k,276) - b(k,40) = b(k,40) - lu(k,3127) * b(k,276) - b(k,39) = b(k,39) - lu(k,3126) * b(k,276) - b(k,38) = b(k,38) - lu(k,3125) * b(k,276) - b(k,37) = b(k,37) - lu(k,3124) * b(k,276) - b(k,36) = b(k,36) - lu(k,3123) * b(k,276) - b(k,34) = b(k,34) - lu(k,3122) * b(k,276) - b(k,33) = b(k,33) - lu(k,3121) * b(k,276) - b(k,32) = b(k,32) - lu(k,3120) * b(k,276) - b(k,31) = b(k,31) - lu(k,3119) * b(k,276) - b(k,30) = b(k,30) - lu(k,3118) * b(k,276) - b(k,29) = b(k,29) - lu(k,3117) * b(k,276) + b(k,311) = b(k,311) * lu(k,3864) + b(k,310) = b(k,310) - lu(k,3863) * b(k,311) + b(k,309) = b(k,309) - lu(k,3862) * b(k,311) + b(k,308) = b(k,308) - lu(k,3861) * b(k,311) + b(k,307) = b(k,307) - lu(k,3860) * b(k,311) + b(k,306) = b(k,306) - lu(k,3859) * b(k,311) + b(k,305) = b(k,305) - lu(k,3858) * b(k,311) + b(k,304) = b(k,304) - lu(k,3857) * b(k,311) + b(k,303) = b(k,303) - lu(k,3856) * b(k,311) + b(k,302) = b(k,302) - lu(k,3855) * b(k,311) + b(k,292) = b(k,292) - lu(k,3854) * b(k,311) + b(k,291) = b(k,291) - lu(k,3853) * b(k,311) + b(k,290) = b(k,290) - lu(k,3852) * b(k,311) + b(k,289) = b(k,289) - lu(k,3851) * b(k,311) + b(k,277) = b(k,277) - lu(k,3850) * b(k,311) + b(k,274) = b(k,274) - lu(k,3849) * b(k,311) + b(k,264) = b(k,264) - lu(k,3848) * b(k,311) + b(k,252) = b(k,252) - lu(k,3847) * b(k,311) + b(k,249) = b(k,249) - lu(k,3846) * b(k,311) + b(k,245) = b(k,245) - lu(k,3845) * b(k,311) + b(k,236) = b(k,236) - lu(k,3844) * b(k,311) + b(k,235) = b(k,235) - lu(k,3843) * b(k,311) + b(k,233) = b(k,233) - lu(k,3842) * b(k,311) + b(k,228) = b(k,228) - lu(k,3841) * b(k,311) + b(k,224) = b(k,224) - lu(k,3840) * b(k,311) + b(k,223) = b(k,223) - lu(k,3839) * b(k,311) + b(k,221) = b(k,221) - lu(k,3838) * b(k,311) + b(k,205) = b(k,205) - lu(k,3837) * b(k,311) + b(k,178) = b(k,178) - lu(k,3836) * b(k,311) + b(k,154) = b(k,154) - lu(k,3835) * b(k,311) + b(k,148) = b(k,148) - lu(k,3834) * b(k,311) + b(k,137) = b(k,137) - lu(k,3833) * b(k,311) + b(k,125) = b(k,125) - lu(k,3832) * b(k,311) + b(k,118) = b(k,118) - lu(k,3831) * b(k,311) + b(k,104) = b(k,104) - lu(k,3830) * b(k,311) + b(k,103) = b(k,103) - lu(k,3829) * b(k,311) + b(k,73) = b(k,73) - lu(k,3828) * b(k,311) + b(k,310) = b(k,310) * lu(k,3822) + b(k,309) = b(k,309) - lu(k,3821) * b(k,310) + b(k,308) = b(k,308) - lu(k,3820) * b(k,310) + b(k,307) = b(k,307) - lu(k,3819) * b(k,310) + b(k,306) = b(k,306) - lu(k,3818) * b(k,310) + b(k,305) = b(k,305) - lu(k,3817) * b(k,310) + b(k,304) = b(k,304) - lu(k,3816) * b(k,310) + b(k,303) = b(k,303) - lu(k,3815) * b(k,310) + b(k,302) = b(k,302) - lu(k,3814) * b(k,310) + b(k,301) = b(k,301) - lu(k,3813) * b(k,310) + b(k,300) = b(k,300) - lu(k,3812) * b(k,310) + b(k,299) = b(k,299) - lu(k,3811) * b(k,310) + b(k,298) = b(k,298) - lu(k,3810) * b(k,310) + b(k,297) = b(k,297) - lu(k,3809) * b(k,310) + b(k,296) = b(k,296) - lu(k,3808) * b(k,310) + b(k,295) = b(k,295) - lu(k,3807) * b(k,310) + b(k,294) = b(k,294) - lu(k,3806) * b(k,310) + b(k,293) = b(k,293) - lu(k,3805) * b(k,310) + b(k,292) = b(k,292) - lu(k,3804) * b(k,310) + b(k,291) = b(k,291) - lu(k,3803) * b(k,310) + b(k,290) = b(k,290) - lu(k,3802) * b(k,310) + b(k,289) = b(k,289) - lu(k,3801) * b(k,310) + b(k,288) = b(k,288) - lu(k,3800) * b(k,310) + b(k,287) = b(k,287) - lu(k,3799) * b(k,310) + b(k,286) = b(k,286) - lu(k,3798) * b(k,310) + b(k,285) = b(k,285) - lu(k,3797) * b(k,310) + b(k,284) = b(k,284) - lu(k,3796) * b(k,310) + b(k,283) = b(k,283) - lu(k,3795) * b(k,310) + b(k,282) = b(k,282) - lu(k,3794) * b(k,310) + b(k,281) = b(k,281) - lu(k,3793) * b(k,310) + b(k,280) = b(k,280) - lu(k,3792) * b(k,310) + b(k,279) = b(k,279) - lu(k,3791) * b(k,310) + b(k,278) = b(k,278) - lu(k,3790) * b(k,310) + b(k,277) = b(k,277) - lu(k,3789) * b(k,310) + b(k,275) = b(k,275) - lu(k,3788) * b(k,310) + b(k,274) = b(k,274) - lu(k,3787) * b(k,310) + b(k,273) = b(k,273) - lu(k,3786) * b(k,310) + b(k,272) = b(k,272) - lu(k,3785) * b(k,310) + b(k,271) = b(k,271) - lu(k,3784) * b(k,310) + b(k,270) = b(k,270) - lu(k,3783) * b(k,310) + b(k,269) = b(k,269) - lu(k,3782) * b(k,310) + b(k,268) = b(k,268) - lu(k,3781) * b(k,310) + b(k,267) = b(k,267) - lu(k,3780) * b(k,310) + b(k,266) = b(k,266) - lu(k,3779) * b(k,310) + b(k,265) = b(k,265) - lu(k,3778) * b(k,310) + b(k,264) = b(k,264) - lu(k,3777) * b(k,310) + b(k,263) = b(k,263) - lu(k,3776) * b(k,310) + b(k,262) = b(k,262) - lu(k,3775) * b(k,310) + b(k,261) = b(k,261) - lu(k,3774) * b(k,310) + b(k,260) = b(k,260) - lu(k,3773) * b(k,310) + b(k,259) = b(k,259) - lu(k,3772) * b(k,310) + b(k,258) = b(k,258) - lu(k,3771) * b(k,310) + b(k,257) = b(k,257) - lu(k,3770) * b(k,310) + b(k,256) = b(k,256) - lu(k,3769) * b(k,310) + b(k,255) = b(k,255) - lu(k,3768) * b(k,310) + b(k,254) = b(k,254) - lu(k,3767) * b(k,310) + b(k,253) = b(k,253) - lu(k,3766) * b(k,310) + b(k,252) = b(k,252) - lu(k,3765) * b(k,310) + b(k,251) = b(k,251) - lu(k,3764) * b(k,310) + b(k,250) = b(k,250) - lu(k,3763) * b(k,310) + b(k,249) = b(k,249) - lu(k,3762) * b(k,310) + b(k,248) = b(k,248) - lu(k,3761) * b(k,310) + b(k,247) = b(k,247) - lu(k,3760) * b(k,310) + b(k,246) = b(k,246) - lu(k,3759) * b(k,310) + b(k,245) = b(k,245) - lu(k,3758) * b(k,310) + b(k,244) = b(k,244) - lu(k,3757) * b(k,310) + b(k,243) = b(k,243) - lu(k,3756) * b(k,310) + b(k,242) = b(k,242) - lu(k,3755) * b(k,310) + b(k,241) = b(k,241) - lu(k,3754) * b(k,310) + b(k,240) = b(k,240) - lu(k,3753) * b(k,310) + b(k,239) = b(k,239) - lu(k,3752) * b(k,310) + b(k,238) = b(k,238) - lu(k,3751) * b(k,310) + b(k,237) = b(k,237) - lu(k,3750) * b(k,310) + b(k,236) = b(k,236) - lu(k,3749) * b(k,310) + b(k,235) = b(k,235) - lu(k,3748) * b(k,310) + b(k,234) = b(k,234) - lu(k,3747) * b(k,310) + b(k,233) = b(k,233) - lu(k,3746) * b(k,310) + b(k,232) = b(k,232) - lu(k,3745) * b(k,310) + b(k,231) = b(k,231) - lu(k,3744) * b(k,310) + b(k,230) = b(k,230) - lu(k,3743) * b(k,310) + b(k,229) = b(k,229) - lu(k,3742) * b(k,310) + b(k,228) = b(k,228) - lu(k,3741) * b(k,310) + b(k,227) = b(k,227) - lu(k,3740) * b(k,310) + b(k,226) = b(k,226) - lu(k,3739) * b(k,310) + b(k,225) = b(k,225) - lu(k,3738) * b(k,310) + b(k,224) = b(k,224) - lu(k,3737) * b(k,310) + b(k,223) = b(k,223) - lu(k,3736) * b(k,310) + b(k,222) = b(k,222) - lu(k,3735) * b(k,310) + b(k,221) = b(k,221) - lu(k,3734) * b(k,310) + b(k,220) = b(k,220) - lu(k,3733) * b(k,310) + b(k,219) = b(k,219) - lu(k,3732) * b(k,310) + b(k,218) = b(k,218) - lu(k,3731) * b(k,310) + b(k,217) = b(k,217) - lu(k,3730) * b(k,310) + b(k,216) = b(k,216) - lu(k,3729) * b(k,310) + b(k,215) = b(k,215) - lu(k,3728) * b(k,310) + b(k,214) = b(k,214) - lu(k,3727) * b(k,310) + b(k,213) = b(k,213) - lu(k,3726) * b(k,310) + b(k,212) = b(k,212) - lu(k,3725) * b(k,310) + b(k,211) = b(k,211) - lu(k,3724) * b(k,310) + b(k,210) = b(k,210) - lu(k,3723) * b(k,310) + b(k,209) = b(k,209) - lu(k,3722) * b(k,310) + b(k,208) = b(k,208) - lu(k,3721) * b(k,310) + b(k,207) = b(k,207) - lu(k,3720) * b(k,310) + b(k,206) = b(k,206) - lu(k,3719) * b(k,310) + b(k,205) = b(k,205) - lu(k,3718) * b(k,310) + b(k,204) = b(k,204) - lu(k,3717) * b(k,310) + b(k,203) = b(k,203) - lu(k,3716) * b(k,310) + b(k,202) = b(k,202) - lu(k,3715) * b(k,310) + b(k,201) = b(k,201) - lu(k,3714) * b(k,310) + b(k,200) = b(k,200) - lu(k,3713) * b(k,310) + b(k,199) = b(k,199) - lu(k,3712) * b(k,310) + b(k,198) = b(k,198) - lu(k,3711) * b(k,310) + b(k,197) = b(k,197) - lu(k,3710) * b(k,310) + b(k,196) = b(k,196) - lu(k,3709) * b(k,310) + b(k,195) = b(k,195) - lu(k,3708) * b(k,310) + b(k,194) = b(k,194) - lu(k,3707) * b(k,310) + b(k,192) = b(k,192) - lu(k,3706) * b(k,310) + b(k,191) = b(k,191) - lu(k,3705) * b(k,310) + b(k,190) = b(k,190) - lu(k,3704) * b(k,310) + b(k,189) = b(k,189) - lu(k,3703) * b(k,310) + b(k,188) = b(k,188) - lu(k,3702) * b(k,310) + b(k,187) = b(k,187) - lu(k,3701) * b(k,310) + b(k,186) = b(k,186) - lu(k,3700) * b(k,310) + b(k,185) = b(k,185) - lu(k,3699) * b(k,310) + b(k,184) = b(k,184) - lu(k,3698) * b(k,310) + b(k,183) = b(k,183) - lu(k,3697) * b(k,310) + b(k,182) = b(k,182) - lu(k,3696) * b(k,310) + b(k,181) = b(k,181) - lu(k,3695) * b(k,310) + b(k,180) = b(k,180) - lu(k,3694) * b(k,310) + b(k,179) = b(k,179) - lu(k,3693) * b(k,310) + b(k,178) = b(k,178) - lu(k,3692) * b(k,310) + b(k,177) = b(k,177) - lu(k,3691) * b(k,310) + b(k,176) = b(k,176) - lu(k,3690) * b(k,310) + b(k,175) = b(k,175) - lu(k,3689) * b(k,310) + b(k,174) = b(k,174) - lu(k,3688) * b(k,310) + b(k,173) = b(k,173) - lu(k,3687) * b(k,310) + b(k,172) = b(k,172) - lu(k,3686) * b(k,310) + b(k,171) = b(k,171) - lu(k,3685) * b(k,310) + b(k,170) = b(k,170) - lu(k,3684) * b(k,310) + b(k,169) = b(k,169) - lu(k,3683) * b(k,310) + b(k,168) = b(k,168) - lu(k,3682) * b(k,310) + b(k,167) = b(k,167) - lu(k,3681) * b(k,310) + b(k,166) = b(k,166) - lu(k,3680) * b(k,310) + b(k,165) = b(k,165) - lu(k,3679) * b(k,310) + b(k,164) = b(k,164) - lu(k,3678) * b(k,310) + b(k,163) = b(k,163) - lu(k,3677) * b(k,310) + b(k,162) = b(k,162) - lu(k,3676) * b(k,310) + b(k,161) = b(k,161) - lu(k,3675) * b(k,310) + b(k,159) = b(k,159) - lu(k,3674) * b(k,310) + b(k,158) = b(k,158) - lu(k,3673) * b(k,310) + b(k,157) = b(k,157) - lu(k,3672) * b(k,310) + b(k,156) = b(k,156) - lu(k,3671) * b(k,310) + b(k,155) = b(k,155) - lu(k,3670) * b(k,310) + b(k,154) = b(k,154) - lu(k,3669) * b(k,310) + b(k,153) = b(k,153) - lu(k,3668) * b(k,310) + b(k,152) = b(k,152) - lu(k,3667) * b(k,310) + b(k,151) = b(k,151) - lu(k,3666) * b(k,310) + b(k,150) = b(k,150) - lu(k,3665) * b(k,310) + b(k,149) = b(k,149) - lu(k,3664) * b(k,310) + b(k,148) = b(k,148) - lu(k,3663) * b(k,310) + b(k,147) = b(k,147) - lu(k,3662) * b(k,310) + b(k,145) = b(k,145) - lu(k,3661) * b(k,310) + b(k,144) = b(k,144) - lu(k,3660) * b(k,310) + b(k,143) = b(k,143) - lu(k,3659) * b(k,310) + b(k,142) = b(k,142) - lu(k,3658) * b(k,310) + b(k,141) = b(k,141) - lu(k,3657) * b(k,310) + b(k,140) = b(k,140) - lu(k,3656) * b(k,310) + b(k,139) = b(k,139) - lu(k,3655) * b(k,310) + b(k,138) = b(k,138) - lu(k,3654) * b(k,310) + b(k,137) = b(k,137) - lu(k,3653) * b(k,310) + b(k,136) = b(k,136) - lu(k,3652) * b(k,310) + b(k,135) = b(k,135) - lu(k,3651) * b(k,310) + b(k,134) = b(k,134) - lu(k,3650) * b(k,310) + b(k,133) = b(k,133) - lu(k,3649) * b(k,310) + b(k,132) = b(k,132) - lu(k,3648) * b(k,310) + b(k,131) = b(k,131) - lu(k,3647) * b(k,310) + b(k,130) = b(k,130) - lu(k,3646) * b(k,310) + b(k,129) = b(k,129) - lu(k,3645) * b(k,310) + b(k,128) = b(k,128) - lu(k,3644) * b(k,310) + b(k,127) = b(k,127) - lu(k,3643) * b(k,310) + b(k,126) = b(k,126) - lu(k,3642) * b(k,310) + b(k,125) = b(k,125) - lu(k,3641) * b(k,310) + b(k,124) = b(k,124) - lu(k,3640) * b(k,310) + b(k,123) = b(k,123) - lu(k,3639) * b(k,310) + b(k,122) = b(k,122) - lu(k,3638) * b(k,310) + b(k,121) = b(k,121) - lu(k,3637) * b(k,310) + b(k,120) = b(k,120) - lu(k,3636) * b(k,310) + b(k,118) = b(k,118) - lu(k,3635) * b(k,310) + b(k,117) = b(k,117) - lu(k,3634) * b(k,310) + b(k,116) = b(k,116) - lu(k,3633) * b(k,310) + b(k,115) = b(k,115) - lu(k,3632) * b(k,310) + b(k,114) = b(k,114) - lu(k,3631) * b(k,310) + b(k,113) = b(k,113) - lu(k,3630) * b(k,310) + b(k,112) = b(k,112) - lu(k,3629) * b(k,310) + b(k,111) = b(k,111) - lu(k,3628) * b(k,310) + b(k,110) = b(k,110) - lu(k,3627) * b(k,310) + b(k,107) = b(k,107) - lu(k,3626) * b(k,310) + b(k,105) = b(k,105) - lu(k,3625) * b(k,310) + b(k,104) = b(k,104) - lu(k,3624) * b(k,310) + b(k,103) = b(k,103) - lu(k,3623) * b(k,310) + b(k,102) = b(k,102) - lu(k,3622) * b(k,310) + b(k,98) = b(k,98) - lu(k,3621) * b(k,310) + b(k,97) = b(k,97) - lu(k,3620) * b(k,310) + b(k,96) = b(k,96) - lu(k,3619) * b(k,310) + b(k,95) = b(k,95) - lu(k,3618) * b(k,310) + b(k,94) = b(k,94) - lu(k,3617) * b(k,310) + b(k,93) = b(k,93) - lu(k,3616) * b(k,310) + b(k,92) = b(k,92) - lu(k,3615) * b(k,310) + b(k,91) = b(k,91) - lu(k,3614) * b(k,310) + b(k,90) = b(k,90) - lu(k,3613) * b(k,310) + b(k,89) = b(k,89) - lu(k,3612) * b(k,310) + b(k,88) = b(k,88) - lu(k,3611) * b(k,310) + b(k,87) = b(k,87) - lu(k,3610) * b(k,310) + b(k,85) = b(k,85) - lu(k,3609) * b(k,310) + b(k,84) = b(k,84) - lu(k,3608) * b(k,310) + b(k,83) = b(k,83) - lu(k,3607) * b(k,310) + b(k,82) = b(k,82) - lu(k,3606) * b(k,310) + b(k,81) = b(k,81) - lu(k,3605) * b(k,310) + b(k,80) = b(k,80) - lu(k,3604) * b(k,310) + b(k,79) = b(k,79) - lu(k,3603) * b(k,310) + b(k,77) = b(k,77) - lu(k,3602) * b(k,310) + b(k,76) = b(k,76) - lu(k,3601) * b(k,310) + b(k,75) = b(k,75) - lu(k,3600) * b(k,310) + b(k,74) = b(k,74) - lu(k,3599) * b(k,310) + b(k,65) = b(k,65) - lu(k,3598) * b(k,310) + b(k,61) = b(k,61) - lu(k,3597) * b(k,310) + b(k,59) = b(k,59) - lu(k,3596) * b(k,310) + b(k,57) = b(k,57) - lu(k,3595) * b(k,310) + b(k,55) = b(k,55) - lu(k,3594) * b(k,310) + b(k,54) = b(k,54) - lu(k,3593) * b(k,310) + b(k,53) = b(k,53) - lu(k,3592) * b(k,310) + b(k,52) = b(k,52) - lu(k,3591) * b(k,310) + b(k,51) = b(k,51) - lu(k,3590) * b(k,310) + b(k,50) = b(k,50) - lu(k,3589) * b(k,310) + b(k,49) = b(k,49) - lu(k,3588) * b(k,310) + b(k,48) = b(k,48) - lu(k,3587) * b(k,310) + b(k,47) = b(k,47) - lu(k,3586) * b(k,310) + b(k,46) = b(k,46) - lu(k,3585) * b(k,310) + b(k,45) = b(k,45) - lu(k,3584) * b(k,310) + b(k,44) = b(k,44) - lu(k,3583) * b(k,310) + b(k,41) = b(k,41) - lu(k,3582) * b(k,310) + b(k,40) = b(k,40) - lu(k,3581) * b(k,310) + b(k,39) = b(k,39) - lu(k,3580) * b(k,310) + b(k,38) = b(k,38) - lu(k,3579) * b(k,310) + b(k,37) = b(k,37) - lu(k,3578) * b(k,310) end do end subroutine lu_slv12 subroutine lu_slv13( avec_len, lu, b ) @@ -2823,331 +2811,222 @@ subroutine lu_slv13( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,275) = b(k,275) * lu(k,3105) - b(k,274) = b(k,274) - lu(k,3104) * b(k,275) - b(k,273) = b(k,273) - lu(k,3103) * b(k,275) - b(k,272) = b(k,272) - lu(k,3102) * b(k,275) - b(k,271) = b(k,271) - lu(k,3101) * b(k,275) - b(k,270) = b(k,270) - lu(k,3100) * b(k,275) - b(k,233) = b(k,233) - lu(k,3099) * b(k,275) - b(k,215) = b(k,215) - lu(k,3098) * b(k,275) - b(k,180) = b(k,180) - lu(k,3097) * b(k,275) - b(k,167) = b(k,167) - lu(k,3096) * b(k,275) - b(k,62) = b(k,62) - lu(k,3095) * b(k,275) - b(k,59) = b(k,59) - lu(k,3094) * b(k,275) - b(k,53) = b(k,53) - lu(k,3093) * b(k,275) - b(k,274) = b(k,274) * lu(k,3080) - b(k,273) = b(k,273) - lu(k,3079) * b(k,274) - b(k,272) = b(k,272) - lu(k,3078) * b(k,274) - b(k,271) = b(k,271) - lu(k,3077) * b(k,274) - b(k,270) = b(k,270) - lu(k,3076) * b(k,274) - b(k,269) = b(k,269) - lu(k,3075) * b(k,274) - b(k,268) = b(k,268) - lu(k,3074) * b(k,274) - b(k,267) = b(k,267) - lu(k,3073) * b(k,274) - b(k,266) = b(k,266) - lu(k,3072) * b(k,274) - b(k,265) = b(k,265) - lu(k,3071) * b(k,274) - b(k,264) = b(k,264) - lu(k,3070) * b(k,274) - b(k,263) = b(k,263) - lu(k,3069) * b(k,274) - b(k,262) = b(k,262) - lu(k,3068) * b(k,274) - b(k,261) = b(k,261) - lu(k,3067) * b(k,274) - b(k,260) = b(k,260) - lu(k,3066) * b(k,274) - b(k,259) = b(k,259) - lu(k,3065) * b(k,274) - b(k,258) = b(k,258) - lu(k,3064) * b(k,274) - b(k,257) = b(k,257) - lu(k,3063) * b(k,274) - b(k,256) = b(k,256) - lu(k,3062) * b(k,274) - b(k,255) = b(k,255) - lu(k,3061) * b(k,274) - b(k,254) = b(k,254) - lu(k,3060) * b(k,274) - b(k,253) = b(k,253) - lu(k,3059) * b(k,274) - b(k,252) = b(k,252) - lu(k,3058) * b(k,274) - b(k,251) = b(k,251) - lu(k,3057) * b(k,274) - b(k,250) = b(k,250) - lu(k,3056) * b(k,274) - b(k,249) = b(k,249) - lu(k,3055) * b(k,274) - b(k,248) = b(k,248) - lu(k,3054) * b(k,274) - b(k,247) = b(k,247) - lu(k,3053) * b(k,274) - b(k,246) = b(k,246) - lu(k,3052) * b(k,274) - b(k,245) = b(k,245) - lu(k,3051) * b(k,274) - b(k,244) = b(k,244) - lu(k,3050) * b(k,274) - b(k,243) = b(k,243) - lu(k,3049) * b(k,274) - b(k,242) = b(k,242) - lu(k,3048) * b(k,274) - b(k,241) = b(k,241) - lu(k,3047) * b(k,274) - b(k,240) = b(k,240) - lu(k,3046) * b(k,274) - b(k,239) = b(k,239) - lu(k,3045) * b(k,274) - b(k,238) = b(k,238) - lu(k,3044) * b(k,274) - b(k,237) = b(k,237) - lu(k,3043) * b(k,274) - b(k,236) = b(k,236) - lu(k,3042) * b(k,274) - b(k,235) = b(k,235) - lu(k,3041) * b(k,274) - b(k,234) = b(k,234) - lu(k,3040) * b(k,274) - b(k,233) = b(k,233) - lu(k,3039) * b(k,274) - b(k,232) = b(k,232) - lu(k,3038) * b(k,274) - b(k,231) = b(k,231) - lu(k,3037) * b(k,274) - b(k,228) = b(k,228) - lu(k,3036) * b(k,274) - b(k,227) = b(k,227) - lu(k,3035) * b(k,274) - b(k,226) = b(k,226) - lu(k,3034) * b(k,274) - b(k,225) = b(k,225) - lu(k,3033) * b(k,274) - b(k,224) = b(k,224) - lu(k,3032) * b(k,274) - b(k,223) = b(k,223) - lu(k,3031) * b(k,274) - b(k,221) = b(k,221) - lu(k,3030) * b(k,274) - b(k,220) = b(k,220) - lu(k,3029) * b(k,274) - b(k,218) = b(k,218) - lu(k,3028) * b(k,274) - b(k,217) = b(k,217) - lu(k,3027) * b(k,274) - b(k,213) = b(k,213) - lu(k,3026) * b(k,274) - b(k,209) = b(k,209) - lu(k,3025) * b(k,274) - b(k,208) = b(k,208) - lu(k,3024) * b(k,274) - b(k,207) = b(k,207) - lu(k,3023) * b(k,274) - b(k,203) = b(k,203) - lu(k,3022) * b(k,274) - b(k,202) = b(k,202) - lu(k,3021) * b(k,274) - b(k,199) = b(k,199) - lu(k,3020) * b(k,274) - b(k,195) = b(k,195) - lu(k,3019) * b(k,274) - b(k,192) = b(k,192) - lu(k,3018) * b(k,274) - b(k,191) = b(k,191) - lu(k,3017) * b(k,274) - b(k,188) = b(k,188) - lu(k,3016) * b(k,274) - b(k,187) = b(k,187) - lu(k,3015) * b(k,274) - b(k,186) = b(k,186) - lu(k,3014) * b(k,274) - b(k,185) = b(k,185) - lu(k,3013) * b(k,274) - b(k,175) = b(k,175) - lu(k,3012) * b(k,274) - b(k,172) = b(k,172) - lu(k,3011) * b(k,274) - b(k,171) = b(k,171) - lu(k,3010) * b(k,274) - b(k,165) = b(k,165) - lu(k,3009) * b(k,274) - b(k,163) = b(k,163) - lu(k,3008) * b(k,274) - b(k,148) = b(k,148) - lu(k,3007) * b(k,274) - b(k,129) = b(k,129) - lu(k,3006) * b(k,274) - b(k,94) = b(k,94) - lu(k,3005) * b(k,274) - b(k,82) = b(k,82) - lu(k,3004) * b(k,274) - b(k,81) = b(k,81) - lu(k,3003) * b(k,274) - b(k,33) = b(k,33) - lu(k,3002) * b(k,274) - b(k,32) = b(k,32) - lu(k,3001) * b(k,274) - b(k,273) = b(k,273) * lu(k,2987) - b(k,272) = b(k,272) - lu(k,2986) * b(k,273) - b(k,271) = b(k,271) - lu(k,2985) * b(k,273) - b(k,270) = b(k,270) - lu(k,2984) * b(k,273) - b(k,269) = b(k,269) - lu(k,2983) * b(k,273) - b(k,268) = b(k,268) - lu(k,2982) * b(k,273) - b(k,267) = b(k,267) - lu(k,2981) * b(k,273) - b(k,266) = b(k,266) - lu(k,2980) * b(k,273) - b(k,265) = b(k,265) - lu(k,2979) * b(k,273) - b(k,264) = b(k,264) - lu(k,2978) * b(k,273) - b(k,263) = b(k,263) - lu(k,2977) * b(k,273) - b(k,262) = b(k,262) - lu(k,2976) * b(k,273) - b(k,261) = b(k,261) - lu(k,2975) * b(k,273) - b(k,260) = b(k,260) - lu(k,2974) * b(k,273) - b(k,259) = b(k,259) - lu(k,2973) * b(k,273) - b(k,258) = b(k,258) - lu(k,2972) * b(k,273) - b(k,257) = b(k,257) - lu(k,2971) * b(k,273) - b(k,256) = b(k,256) - lu(k,2970) * b(k,273) - b(k,255) = b(k,255) - lu(k,2969) * b(k,273) - b(k,254) = b(k,254) - lu(k,2968) * b(k,273) - b(k,253) = b(k,253) - lu(k,2967) * b(k,273) - b(k,252) = b(k,252) - lu(k,2966) * b(k,273) - b(k,251) = b(k,251) - lu(k,2965) * b(k,273) - b(k,250) = b(k,250) - lu(k,2964) * b(k,273) - b(k,249) = b(k,249) - lu(k,2963) * b(k,273) - b(k,247) = b(k,247) - lu(k,2962) * b(k,273) - b(k,246) = b(k,246) - lu(k,2961) * b(k,273) - b(k,245) = b(k,245) - lu(k,2960) * b(k,273) - b(k,244) = b(k,244) - lu(k,2959) * b(k,273) - b(k,243) = b(k,243) - lu(k,2958) * b(k,273) - b(k,242) = b(k,242) - lu(k,2957) * b(k,273) - b(k,241) = b(k,241) - lu(k,2956) * b(k,273) - b(k,240) = b(k,240) - lu(k,2955) * b(k,273) - b(k,239) = b(k,239) - lu(k,2954) * b(k,273) - b(k,238) = b(k,238) - lu(k,2953) * b(k,273) - b(k,237) = b(k,237) - lu(k,2952) * b(k,273) - b(k,236) = b(k,236) - lu(k,2951) * b(k,273) - b(k,235) = b(k,235) - lu(k,2950) * b(k,273) - b(k,234) = b(k,234) - lu(k,2949) * b(k,273) - b(k,233) = b(k,233) - lu(k,2948) * b(k,273) - b(k,232) = b(k,232) - lu(k,2947) * b(k,273) - b(k,231) = b(k,231) - lu(k,2946) * b(k,273) - b(k,230) = b(k,230) - lu(k,2945) * b(k,273) - b(k,229) = b(k,229) - lu(k,2944) * b(k,273) - b(k,228) = b(k,228) - lu(k,2943) * b(k,273) - b(k,225) = b(k,225) - lu(k,2942) * b(k,273) - b(k,224) = b(k,224) - lu(k,2941) * b(k,273) - b(k,223) = b(k,223) - lu(k,2940) * b(k,273) - b(k,222) = b(k,222) - lu(k,2939) * b(k,273) - b(k,221) = b(k,221) - lu(k,2938) * b(k,273) - b(k,219) = b(k,219) - lu(k,2937) * b(k,273) - b(k,218) = b(k,218) - lu(k,2936) * b(k,273) - b(k,216) = b(k,216) - lu(k,2935) * b(k,273) - b(k,209) = b(k,209) - lu(k,2934) * b(k,273) - b(k,208) = b(k,208) - lu(k,2933) * b(k,273) - b(k,207) = b(k,207) - lu(k,2932) * b(k,273) - b(k,203) = b(k,203) - lu(k,2931) * b(k,273) - b(k,202) = b(k,202) - lu(k,2930) * b(k,273) - b(k,201) = b(k,201) - lu(k,2929) * b(k,273) - b(k,199) = b(k,199) - lu(k,2928) * b(k,273) - b(k,195) = b(k,195) - lu(k,2927) * b(k,273) - b(k,193) = b(k,193) - lu(k,2926) * b(k,273) - b(k,192) = b(k,192) - lu(k,2925) * b(k,273) - b(k,191) = b(k,191) - lu(k,2924) * b(k,273) - b(k,188) = b(k,188) - lu(k,2923) * b(k,273) - b(k,187) = b(k,187) - lu(k,2922) * b(k,273) - b(k,186) = b(k,186) - lu(k,2921) * b(k,273) - b(k,185) = b(k,185) - lu(k,2920) * b(k,273) - b(k,175) = b(k,175) - lu(k,2919) * b(k,273) - b(k,172) = b(k,172) - lu(k,2918) * b(k,273) - b(k,171) = b(k,171) - lu(k,2917) * b(k,273) - b(k,163) = b(k,163) - lu(k,2916) * b(k,273) - b(k,158) = b(k,158) - lu(k,2915) * b(k,273) - b(k,151) = b(k,151) - lu(k,2914) * b(k,273) - b(k,149) = b(k,149) - lu(k,2913) * b(k,273) - b(k,148) = b(k,148) - lu(k,2912) * b(k,273) - b(k,137) = b(k,137) - lu(k,2911) * b(k,273) - b(k,128) = b(k,128) - lu(k,2910) * b(k,273) - b(k,126) = b(k,126) - lu(k,2909) * b(k,273) - b(k,123) = b(k,123) - lu(k,2908) * b(k,273) - b(k,117) = b(k,117) - lu(k,2907) * b(k,273) - b(k,110) = b(k,110) - lu(k,2906) * b(k,273) - b(k,61) = b(k,61) - lu(k,2905) * b(k,273) - b(k,33) = b(k,33) - lu(k,2904) * b(k,273) - b(k,32) = b(k,32) - lu(k,2903) * b(k,273) - b(k,31) = b(k,31) - lu(k,2902) * b(k,273) - b(k,30) = b(k,30) - lu(k,2901) * b(k,273) - b(k,29) = b(k,29) - lu(k,2900) * b(k,273) - b(k,272) = b(k,272) * lu(k,2885) - b(k,271) = b(k,271) - lu(k,2884) * b(k,272) - b(k,270) = b(k,270) - lu(k,2883) * b(k,272) - b(k,269) = b(k,269) - lu(k,2882) * b(k,272) - b(k,268) = b(k,268) - lu(k,2881) * b(k,272) - b(k,267) = b(k,267) - lu(k,2880) * b(k,272) - b(k,266) = b(k,266) - lu(k,2879) * b(k,272) - b(k,265) = b(k,265) - lu(k,2878) * b(k,272) - b(k,264) = b(k,264) - lu(k,2877) * b(k,272) - b(k,263) = b(k,263) - lu(k,2876) * b(k,272) - b(k,262) = b(k,262) - lu(k,2875) * b(k,272) - b(k,261) = b(k,261) - lu(k,2874) * b(k,272) - b(k,260) = b(k,260) - lu(k,2873) * b(k,272) - b(k,259) = b(k,259) - lu(k,2872) * b(k,272) - b(k,258) = b(k,258) - lu(k,2871) * b(k,272) - b(k,257) = b(k,257) - lu(k,2870) * b(k,272) - b(k,256) = b(k,256) - lu(k,2869) * b(k,272) - b(k,255) = b(k,255) - lu(k,2868) * b(k,272) - b(k,254) = b(k,254) - lu(k,2867) * b(k,272) - b(k,253) = b(k,253) - lu(k,2866) * b(k,272) - b(k,252) = b(k,252) - lu(k,2865) * b(k,272) - b(k,251) = b(k,251) - lu(k,2864) * b(k,272) - b(k,250) = b(k,250) - lu(k,2863) * b(k,272) - b(k,249) = b(k,249) - lu(k,2862) * b(k,272) - b(k,248) = b(k,248) - lu(k,2861) * b(k,272) - b(k,247) = b(k,247) - lu(k,2860) * b(k,272) - b(k,246) = b(k,246) - lu(k,2859) * b(k,272) - b(k,245) = b(k,245) - lu(k,2858) * b(k,272) - b(k,244) = b(k,244) - lu(k,2857) * b(k,272) - b(k,243) = b(k,243) - lu(k,2856) * b(k,272) - b(k,242) = b(k,242) - lu(k,2855) * b(k,272) - b(k,241) = b(k,241) - lu(k,2854) * b(k,272) - b(k,240) = b(k,240) - lu(k,2853) * b(k,272) - b(k,239) = b(k,239) - lu(k,2852) * b(k,272) - b(k,238) = b(k,238) - lu(k,2851) * b(k,272) - b(k,237) = b(k,237) - lu(k,2850) * b(k,272) - b(k,236) = b(k,236) - lu(k,2849) * b(k,272) - b(k,235) = b(k,235) - lu(k,2848) * b(k,272) - b(k,234) = b(k,234) - lu(k,2847) * b(k,272) - b(k,233) = b(k,233) - lu(k,2846) * b(k,272) - b(k,232) = b(k,232) - lu(k,2845) * b(k,272) - b(k,231) = b(k,231) - lu(k,2844) * b(k,272) - b(k,230) = b(k,230) - lu(k,2843) * b(k,272) - b(k,229) = b(k,229) - lu(k,2842) * b(k,272) - b(k,228) = b(k,228) - lu(k,2841) * b(k,272) - b(k,227) = b(k,227) - lu(k,2840) * b(k,272) - b(k,226) = b(k,226) - lu(k,2839) * b(k,272) - b(k,225) = b(k,225) - lu(k,2838) * b(k,272) - b(k,224) = b(k,224) - lu(k,2837) * b(k,272) - b(k,223) = b(k,223) - lu(k,2836) * b(k,272) - b(k,222) = b(k,222) - lu(k,2835) * b(k,272) - b(k,220) = b(k,220) - lu(k,2834) * b(k,272) - b(k,219) = b(k,219) - lu(k,2833) * b(k,272) - b(k,218) = b(k,218) - lu(k,2832) * b(k,272) - b(k,217) = b(k,217) - lu(k,2831) * b(k,272) - b(k,214) = b(k,214) - lu(k,2830) * b(k,272) - b(k,213) = b(k,213) - lu(k,2829) * b(k,272) - b(k,212) = b(k,212) - lu(k,2828) * b(k,272) - b(k,211) = b(k,211) - lu(k,2827) * b(k,272) - b(k,210) = b(k,210) - lu(k,2826) * b(k,272) - b(k,209) = b(k,209) - lu(k,2825) * b(k,272) - b(k,207) = b(k,207) - lu(k,2824) * b(k,272) - b(k,206) = b(k,206) - lu(k,2823) * b(k,272) - b(k,205) = b(k,205) - lu(k,2822) * b(k,272) - b(k,204) = b(k,204) - lu(k,2821) * b(k,272) - b(k,203) = b(k,203) - lu(k,2820) * b(k,272) - b(k,201) = b(k,201) - lu(k,2819) * b(k,272) - b(k,200) = b(k,200) - lu(k,2818) * b(k,272) - b(k,199) = b(k,199) - lu(k,2817) * b(k,272) - b(k,198) = b(k,198) - lu(k,2816) * b(k,272) - b(k,197) = b(k,197) - lu(k,2815) * b(k,272) - b(k,194) = b(k,194) - lu(k,2814) * b(k,272) - b(k,193) = b(k,193) - lu(k,2813) * b(k,272) - b(k,190) = b(k,190) - lu(k,2812) * b(k,272) - b(k,189) = b(k,189) - lu(k,2811) * b(k,272) - b(k,188) = b(k,188) - lu(k,2810) * b(k,272) - b(k,187) = b(k,187) - lu(k,2809) * b(k,272) - b(k,186) = b(k,186) - lu(k,2808) * b(k,272) - b(k,183) = b(k,183) - lu(k,2807) * b(k,272) - b(k,179) = b(k,179) - lu(k,2806) * b(k,272) - b(k,178) = b(k,178) - lu(k,2805) * b(k,272) - b(k,177) = b(k,177) - lu(k,2804) * b(k,272) - b(k,176) = b(k,176) - lu(k,2803) * b(k,272) - b(k,175) = b(k,175) - lu(k,2802) * b(k,272) - b(k,174) = b(k,174) - lu(k,2801) * b(k,272) - b(k,173) = b(k,173) - lu(k,2800) * b(k,272) - b(k,170) = b(k,170) - lu(k,2799) * b(k,272) - b(k,169) = b(k,169) - lu(k,2798) * b(k,272) - b(k,166) = b(k,166) - lu(k,2797) * b(k,272) - b(k,165) = b(k,165) - lu(k,2796) * b(k,272) - b(k,164) = b(k,164) - lu(k,2795) * b(k,272) - b(k,162) = b(k,162) - lu(k,2794) * b(k,272) - b(k,161) = b(k,161) - lu(k,2793) * b(k,272) - b(k,160) = b(k,160) - lu(k,2792) * b(k,272) - b(k,159) = b(k,159) - lu(k,2791) * b(k,272) - b(k,158) = b(k,158) - lu(k,2790) * b(k,272) - b(k,157) = b(k,157) - lu(k,2789) * b(k,272) - b(k,155) = b(k,155) - lu(k,2788) * b(k,272) - b(k,154) = b(k,154) - lu(k,2787) * b(k,272) - b(k,153) = b(k,153) - lu(k,2786) * b(k,272) - b(k,152) = b(k,152) - lu(k,2785) * b(k,272) - b(k,151) = b(k,151) - lu(k,2784) * b(k,272) - b(k,149) = b(k,149) - lu(k,2783) * b(k,272) - b(k,147) = b(k,147) - lu(k,2782) * b(k,272) - b(k,146) = b(k,146) - lu(k,2781) * b(k,272) - b(k,145) = b(k,145) - lu(k,2780) * b(k,272) - b(k,142) = b(k,142) - lu(k,2779) * b(k,272) - b(k,140) = b(k,140) - lu(k,2778) * b(k,272) - b(k,137) = b(k,137) - lu(k,2777) * b(k,272) - b(k,136) = b(k,136) - lu(k,2776) * b(k,272) - b(k,133) = b(k,133) - lu(k,2775) * b(k,272) - b(k,129) = b(k,129) - lu(k,2774) * b(k,272) - b(k,127) = b(k,127) - lu(k,2773) * b(k,272) - b(k,120) = b(k,120) - lu(k,2772) * b(k,272) - b(k,118) = b(k,118) - lu(k,2771) * b(k,272) - b(k,116) = b(k,116) - lu(k,2770) * b(k,272) - b(k,115) = b(k,115) - lu(k,2769) * b(k,272) - b(k,114) = b(k,114) - lu(k,2768) * b(k,272) - b(k,110) = b(k,110) - lu(k,2767) * b(k,272) - b(k,106) = b(k,106) - lu(k,2766) * b(k,272) - b(k,105) = b(k,105) - lu(k,2765) * b(k,272) - b(k,102) = b(k,102) - lu(k,2764) * b(k,272) - b(k,97) = b(k,97) - lu(k,2763) * b(k,272) - b(k,95) = b(k,95) - lu(k,2762) * b(k,272) - b(k,87) = b(k,87) - lu(k,2761) * b(k,272) - b(k,83) = b(k,83) - lu(k,2760) * b(k,272) - b(k,80) = b(k,80) - lu(k,2759) * b(k,272) - b(k,70) = b(k,70) - lu(k,2758) * b(k,272) - b(k,46) = b(k,46) - lu(k,2757) * b(k,272) - b(k,45) = b(k,45) - lu(k,2756) * b(k,272) - b(k,44) = b(k,44) - lu(k,2755) * b(k,272) - b(k,43) = b(k,43) - lu(k,2754) * b(k,272) - b(k,41) = b(k,41) - lu(k,2753) * b(k,272) - b(k,40) = b(k,40) - lu(k,2752) * b(k,272) - b(k,39) = b(k,39) - lu(k,2751) * b(k,272) - b(k,38) = b(k,38) - lu(k,2750) * b(k,272) - b(k,37) = b(k,37) - lu(k,2749) * b(k,272) - b(k,36) = b(k,36) - lu(k,2748) * b(k,272) - b(k,34) = b(k,34) - lu(k,2747) * b(k,272) - b(k,33) = b(k,33) - lu(k,2746) * b(k,272) - b(k,32) = b(k,32) - lu(k,2745) * b(k,272) - b(k,31) = b(k,31) - lu(k,2744) * b(k,272) - b(k,30) = b(k,30) - lu(k,2743) * b(k,272) - b(k,29) = b(k,29) - lu(k,2742) * b(k,272) + b(k,309) = b(k,309) * lu(k,3571) + b(k,308) = b(k,308) - lu(k,3570) * b(k,309) + b(k,307) = b(k,307) - lu(k,3569) * b(k,309) + b(k,306) = b(k,306) - lu(k,3568) * b(k,309) + b(k,305) = b(k,305) - lu(k,3567) * b(k,309) + b(k,304) = b(k,304) - lu(k,3566) * b(k,309) + b(k,303) = b(k,303) - lu(k,3565) * b(k,309) + b(k,302) = b(k,302) - lu(k,3564) * b(k,309) + b(k,301) = b(k,301) - lu(k,3563) * b(k,309) + b(k,300) = b(k,300) - lu(k,3562) * b(k,309) + b(k,299) = b(k,299) - lu(k,3561) * b(k,309) + b(k,298) = b(k,298) - lu(k,3560) * b(k,309) + b(k,297) = b(k,297) - lu(k,3559) * b(k,309) + b(k,296) = b(k,296) - lu(k,3558) * b(k,309) + b(k,295) = b(k,295) - lu(k,3557) * b(k,309) + b(k,294) = b(k,294) - lu(k,3556) * b(k,309) + b(k,293) = b(k,293) - lu(k,3555) * b(k,309) + b(k,292) = b(k,292) - lu(k,3554) * b(k,309) + b(k,291) = b(k,291) - lu(k,3553) * b(k,309) + b(k,290) = b(k,290) - lu(k,3552) * b(k,309) + b(k,289) = b(k,289) - lu(k,3551) * b(k,309) + b(k,288) = b(k,288) - lu(k,3550) * b(k,309) + b(k,287) = b(k,287) - lu(k,3549) * b(k,309) + b(k,286) = b(k,286) - lu(k,3548) * b(k,309) + b(k,285) = b(k,285) - lu(k,3547) * b(k,309) + b(k,284) = b(k,284) - lu(k,3546) * b(k,309) + b(k,283) = b(k,283) - lu(k,3545) * b(k,309) + b(k,282) = b(k,282) - lu(k,3544) * b(k,309) + b(k,281) = b(k,281) - lu(k,3543) * b(k,309) + b(k,280) = b(k,280) - lu(k,3542) * b(k,309) + b(k,279) = b(k,279) - lu(k,3541) * b(k,309) + b(k,278) = b(k,278) - lu(k,3540) * b(k,309) + b(k,277) = b(k,277) - lu(k,3539) * b(k,309) + b(k,276) = b(k,276) - lu(k,3538) * b(k,309) + b(k,275) = b(k,275) - lu(k,3537) * b(k,309) + b(k,274) = b(k,274) - lu(k,3536) * b(k,309) + b(k,273) = b(k,273) - lu(k,3535) * b(k,309) + b(k,272) = b(k,272) - lu(k,3534) * b(k,309) + b(k,271) = b(k,271) - lu(k,3533) * b(k,309) + b(k,270) = b(k,270) - lu(k,3532) * b(k,309) + b(k,269) = b(k,269) - lu(k,3531) * b(k,309) + b(k,268) = b(k,268) - lu(k,3530) * b(k,309) + b(k,267) = b(k,267) - lu(k,3529) * b(k,309) + b(k,266) = b(k,266) - lu(k,3528) * b(k,309) + b(k,265) = b(k,265) - lu(k,3527) * b(k,309) + b(k,264) = b(k,264) - lu(k,3526) * b(k,309) + b(k,263) = b(k,263) - lu(k,3525) * b(k,309) + b(k,262) = b(k,262) - lu(k,3524) * b(k,309) + b(k,261) = b(k,261) - lu(k,3523) * b(k,309) + b(k,260) = b(k,260) - lu(k,3522) * b(k,309) + b(k,259) = b(k,259) - lu(k,3521) * b(k,309) + b(k,258) = b(k,258) - lu(k,3520) * b(k,309) + b(k,257) = b(k,257) - lu(k,3519) * b(k,309) + b(k,256) = b(k,256) - lu(k,3518) * b(k,309) + b(k,255) = b(k,255) - lu(k,3517) * b(k,309) + b(k,254) = b(k,254) - lu(k,3516) * b(k,309) + b(k,253) = b(k,253) - lu(k,3515) * b(k,309) + b(k,252) = b(k,252) - lu(k,3514) * b(k,309) + b(k,251) = b(k,251) - lu(k,3513) * b(k,309) + b(k,250) = b(k,250) - lu(k,3512) * b(k,309) + b(k,249) = b(k,249) - lu(k,3511) * b(k,309) + b(k,248) = b(k,248) - lu(k,3510) * b(k,309) + b(k,247) = b(k,247) - lu(k,3509) * b(k,309) + b(k,246) = b(k,246) - lu(k,3508) * b(k,309) + b(k,245) = b(k,245) - lu(k,3507) * b(k,309) + b(k,243) = b(k,243) - lu(k,3506) * b(k,309) + b(k,242) = b(k,242) - lu(k,3505) * b(k,309) + b(k,241) = b(k,241) - lu(k,3504) * b(k,309) + b(k,240) = b(k,240) - lu(k,3503) * b(k,309) + b(k,238) = b(k,238) - lu(k,3502) * b(k,309) + b(k,237) = b(k,237) - lu(k,3501) * b(k,309) + b(k,236) = b(k,236) - lu(k,3500) * b(k,309) + b(k,235) = b(k,235) - lu(k,3499) * b(k,309) + b(k,234) = b(k,234) - lu(k,3498) * b(k,309) + b(k,233) = b(k,233) - lu(k,3497) * b(k,309) + b(k,232) = b(k,232) - lu(k,3496) * b(k,309) + b(k,231) = b(k,231) - lu(k,3495) * b(k,309) + b(k,230) = b(k,230) - lu(k,3494) * b(k,309) + b(k,229) = b(k,229) - lu(k,3493) * b(k,309) + b(k,228) = b(k,228) - lu(k,3492) * b(k,309) + b(k,227) = b(k,227) - lu(k,3491) * b(k,309) + b(k,224) = b(k,224) - lu(k,3490) * b(k,309) + b(k,223) = b(k,223) - lu(k,3489) * b(k,309) + b(k,222) = b(k,222) - lu(k,3488) * b(k,309) + b(k,220) = b(k,220) - lu(k,3487) * b(k,309) + b(k,219) = b(k,219) - lu(k,3486) * b(k,309) + b(k,213) = b(k,213) - lu(k,3485) * b(k,309) + b(k,212) = b(k,212) - lu(k,3484) * b(k,309) + b(k,211) = b(k,211) - lu(k,3483) * b(k,309) + b(k,210) = b(k,210) - lu(k,3482) * b(k,309) + b(k,209) = b(k,209) - lu(k,3481) * b(k,309) + b(k,208) = b(k,208) - lu(k,3480) * b(k,309) + b(k,207) = b(k,207) - lu(k,3479) * b(k,309) + b(k,206) = b(k,206) - lu(k,3478) * b(k,309) + b(k,205) = b(k,205) - lu(k,3477) * b(k,309) + b(k,204) = b(k,204) - lu(k,3476) * b(k,309) + b(k,203) = b(k,203) - lu(k,3475) * b(k,309) + b(k,201) = b(k,201) - lu(k,3474) * b(k,309) + b(k,198) = b(k,198) - lu(k,3473) * b(k,309) + b(k,197) = b(k,197) - lu(k,3472) * b(k,309) + b(k,195) = b(k,195) - lu(k,3471) * b(k,309) + b(k,194) = b(k,194) - lu(k,3470) * b(k,309) + b(k,193) = b(k,193) - lu(k,3469) * b(k,309) + b(k,192) = b(k,192) - lu(k,3468) * b(k,309) + b(k,190) = b(k,190) - lu(k,3467) * b(k,309) + b(k,189) = b(k,189) - lu(k,3466) * b(k,309) + b(k,188) = b(k,188) - lu(k,3465) * b(k,309) + b(k,187) = b(k,187) - lu(k,3464) * b(k,309) + b(k,186) = b(k,186) - lu(k,3463) * b(k,309) + b(k,185) = b(k,185) - lu(k,3462) * b(k,309) + b(k,182) = b(k,182) - lu(k,3461) * b(k,309) + b(k,181) = b(k,181) - lu(k,3460) * b(k,309) + b(k,180) = b(k,180) - lu(k,3459) * b(k,309) + b(k,179) = b(k,179) - lu(k,3458) * b(k,309) + b(k,178) = b(k,178) - lu(k,3457) * b(k,309) + b(k,176) = b(k,176) - lu(k,3456) * b(k,309) + b(k,175) = b(k,175) - lu(k,3455) * b(k,309) + b(k,174) = b(k,174) - lu(k,3454) * b(k,309) + b(k,173) = b(k,173) - lu(k,3453) * b(k,309) + b(k,172) = b(k,172) - lu(k,3452) * b(k,309) + b(k,171) = b(k,171) - lu(k,3451) * b(k,309) + b(k,170) = b(k,170) - lu(k,3450) * b(k,309) + b(k,169) = b(k,169) - lu(k,3449) * b(k,309) + b(k,168) = b(k,168) - lu(k,3448) * b(k,309) + b(k,166) = b(k,166) - lu(k,3447) * b(k,309) + b(k,165) = b(k,165) - lu(k,3446) * b(k,309) + b(k,164) = b(k,164) - lu(k,3445) * b(k,309) + b(k,162) = b(k,162) - lu(k,3444) * b(k,309) + b(k,161) = b(k,161) - lu(k,3443) * b(k,309) + b(k,160) = b(k,160) - lu(k,3442) * b(k,309) + b(k,158) = b(k,158) - lu(k,3441) * b(k,309) + b(k,157) = b(k,157) - lu(k,3440) * b(k,309) + b(k,149) = b(k,149) - lu(k,3439) * b(k,309) + b(k,147) = b(k,147) - lu(k,3438) * b(k,309) + b(k,142) = b(k,142) - lu(k,3437) * b(k,309) + b(k,140) = b(k,140) - lu(k,3436) * b(k,309) + b(k,139) = b(k,139) - lu(k,3435) * b(k,309) + b(k,136) = b(k,136) - lu(k,3434) * b(k,309) + b(k,131) = b(k,131) - lu(k,3433) * b(k,309) + b(k,130) = b(k,130) - lu(k,3432) * b(k,309) + b(k,129) = b(k,129) - lu(k,3431) * b(k,309) + b(k,128) = b(k,128) - lu(k,3430) * b(k,309) + b(k,127) = b(k,127) - lu(k,3429) * b(k,309) + b(k,126) = b(k,126) - lu(k,3428) * b(k,309) + b(k,124) = b(k,124) - lu(k,3427) * b(k,309) + b(k,122) = b(k,122) - lu(k,3426) * b(k,309) + b(k,121) = b(k,121) - lu(k,3425) * b(k,309) + b(k,120) = b(k,120) - lu(k,3424) * b(k,309) + b(k,115) = b(k,115) - lu(k,3423) * b(k,309) + b(k,114) = b(k,114) - lu(k,3422) * b(k,309) + b(k,113) = b(k,113) - lu(k,3421) * b(k,309) + b(k,112) = b(k,112) - lu(k,3420) * b(k,309) + b(k,111) = b(k,111) - lu(k,3419) * b(k,309) + b(k,110) = b(k,110) - lu(k,3418) * b(k,309) + b(k,107) = b(k,107) - lu(k,3417) * b(k,309) + b(k,99) = b(k,99) - lu(k,3416) * b(k,309) + b(k,98) = b(k,98) - lu(k,3415) * b(k,309) + b(k,66) = b(k,66) - lu(k,3414) * b(k,309) + b(k,55) = b(k,55) - lu(k,3413) * b(k,309) + b(k,54) = b(k,54) - lu(k,3412) * b(k,309) + b(k,53) = b(k,53) - lu(k,3411) * b(k,309) + b(k,52) = b(k,52) - lu(k,3410) * b(k,309) + b(k,50) = b(k,50) - lu(k,3409) * b(k,309) + b(k,49) = b(k,49) - lu(k,3408) * b(k,309) + b(k,48) = b(k,48) - lu(k,3407) * b(k,309) + b(k,47) = b(k,47) - lu(k,3406) * b(k,309) + b(k,46) = b(k,46) - lu(k,3405) * b(k,309) + b(k,45) = b(k,45) - lu(k,3404) * b(k,309) + b(k,42) = b(k,42) - lu(k,3403) * b(k,309) + b(k,41) = b(k,41) - lu(k,3402) * b(k,309) + b(k,40) = b(k,40) - lu(k,3401) * b(k,309) + b(k,39) = b(k,39) - lu(k,3400) * b(k,309) + b(k,38) = b(k,38) - lu(k,3399) * b(k,309) + b(k,37) = b(k,37) - lu(k,3398) * b(k,309) + b(k,308) = b(k,308) * lu(k,3390) + b(k,307) = b(k,307) - lu(k,3389) * b(k,308) + b(k,306) = b(k,306) - lu(k,3388) * b(k,308) + b(k,305) = b(k,305) - lu(k,3387) * b(k,308) + b(k,304) = b(k,304) - lu(k,3386) * b(k,308) + b(k,303) = b(k,303) - lu(k,3385) * b(k,308) + b(k,292) = b(k,292) - lu(k,3384) * b(k,308) + b(k,291) = b(k,291) - lu(k,3383) * b(k,308) + b(k,290) = b(k,290) - lu(k,3382) * b(k,308) + b(k,289) = b(k,289) - lu(k,3381) * b(k,308) + b(k,277) = b(k,277) - lu(k,3380) * b(k,308) + b(k,274) = b(k,274) - lu(k,3379) * b(k,308) + b(k,264) = b(k,264) - lu(k,3378) * b(k,308) + b(k,249) = b(k,249) - lu(k,3377) * b(k,308) + b(k,244) = b(k,244) - lu(k,3376) * b(k,308) + b(k,235) = b(k,235) - lu(k,3375) * b(k,308) + b(k,221) = b(k,221) - lu(k,3374) * b(k,308) + b(k,214) = b(k,214) - lu(k,3373) * b(k,308) + b(k,207) = b(k,207) - lu(k,3372) * b(k,308) + b(k,205) = b(k,205) - lu(k,3371) * b(k,308) + b(k,193) = b(k,193) - lu(k,3370) * b(k,308) + b(k,146) = b(k,146) - lu(k,3369) * b(k,308) + b(k,141) = b(k,141) - lu(k,3368) * b(k,308) + b(k,117) = b(k,117) - lu(k,3367) * b(k,308) + b(k,307) = b(k,307) * lu(k,3358) + b(k,306) = b(k,306) - lu(k,3357) * b(k,307) + b(k,305) = b(k,305) - lu(k,3356) * b(k,307) + b(k,304) = b(k,304) - lu(k,3355) * b(k,307) + b(k,303) = b(k,303) - lu(k,3354) * b(k,307) + b(k,292) = b(k,292) - lu(k,3353) * b(k,307) + b(k,291) = b(k,291) - lu(k,3352) * b(k,307) + b(k,290) = b(k,290) - lu(k,3351) * b(k,307) + b(k,289) = b(k,289) - lu(k,3350) * b(k,307) + b(k,277) = b(k,277) - lu(k,3349) * b(k,307) + b(k,274) = b(k,274) - lu(k,3348) * b(k,307) + b(k,264) = b(k,264) - lu(k,3347) * b(k,307) + b(k,249) = b(k,249) - lu(k,3346) * b(k,307) + b(k,245) = b(k,245) - lu(k,3345) * b(k,307) + b(k,224) = b(k,224) - lu(k,3344) * b(k,307) + b(k,211) = b(k,211) - lu(k,3343) * b(k,307) + b(k,207) = b(k,207) - lu(k,3342) * b(k,307) + b(k,160) = b(k,160) - lu(k,3341) * b(k,307) end do end subroutine lu_slv13 subroutine lu_slv14( avec_len, lu, b ) @@ -3168,216 +3047,268 @@ subroutine lu_slv14( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,271) = b(k,271) * lu(k,2730) - b(k,270) = b(k,270) - lu(k,2729) * b(k,271) - b(k,215) = b(k,215) - lu(k,2728) * b(k,271) - b(k,270) = b(k,270) * lu(k,2717) - b(k,215) = b(k,215) - lu(k,2716) * b(k,270) - b(k,167) = b(k,167) - lu(k,2715) * b(k,270) - b(k,68) = b(k,68) - lu(k,2714) * b(k,270) - b(k,269) = b(k,269) * lu(k,2699) - b(k,268) = b(k,268) - lu(k,2698) * b(k,269) - b(k,267) = b(k,267) - lu(k,2697) * b(k,269) - b(k,266) = b(k,266) - lu(k,2696) * b(k,269) - b(k,265) = b(k,265) - lu(k,2695) * b(k,269) - b(k,264) = b(k,264) - lu(k,2694) * b(k,269) - b(k,263) = b(k,263) - lu(k,2693) * b(k,269) - b(k,262) = b(k,262) - lu(k,2692) * b(k,269) - b(k,261) = b(k,261) - lu(k,2691) * b(k,269) - b(k,260) = b(k,260) - lu(k,2690) * b(k,269) - b(k,259) = b(k,259) - lu(k,2689) * b(k,269) - b(k,258) = b(k,258) - lu(k,2688) * b(k,269) - b(k,257) = b(k,257) - lu(k,2687) * b(k,269) - b(k,256) = b(k,256) - lu(k,2686) * b(k,269) - b(k,255) = b(k,255) - lu(k,2685) * b(k,269) - b(k,254) = b(k,254) - lu(k,2684) * b(k,269) - b(k,253) = b(k,253) - lu(k,2683) * b(k,269) - b(k,252) = b(k,252) - lu(k,2682) * b(k,269) - b(k,251) = b(k,251) - lu(k,2681) * b(k,269) - b(k,250) = b(k,250) - lu(k,2680) * b(k,269) - b(k,249) = b(k,249) - lu(k,2679) * b(k,269) - b(k,248) = b(k,248) - lu(k,2678) * b(k,269) - b(k,247) = b(k,247) - lu(k,2677) * b(k,269) - b(k,246) = b(k,246) - lu(k,2676) * b(k,269) - b(k,245) = b(k,245) - lu(k,2675) * b(k,269) - b(k,244) = b(k,244) - lu(k,2674) * b(k,269) - b(k,243) = b(k,243) - lu(k,2673) * b(k,269) - b(k,242) = b(k,242) - lu(k,2672) * b(k,269) - b(k,241) = b(k,241) - lu(k,2671) * b(k,269) - b(k,240) = b(k,240) - lu(k,2670) * b(k,269) - b(k,239) = b(k,239) - lu(k,2669) * b(k,269) - b(k,238) = b(k,238) - lu(k,2668) * b(k,269) - b(k,237) = b(k,237) - lu(k,2667) * b(k,269) - b(k,236) = b(k,236) - lu(k,2666) * b(k,269) - b(k,235) = b(k,235) - lu(k,2665) * b(k,269) - b(k,234) = b(k,234) - lu(k,2664) * b(k,269) - b(k,232) = b(k,232) - lu(k,2663) * b(k,269) - b(k,231) = b(k,231) - lu(k,2662) * b(k,269) - b(k,229) = b(k,229) - lu(k,2661) * b(k,269) - b(k,228) = b(k,228) - lu(k,2660) * b(k,269) - b(k,227) = b(k,227) - lu(k,2659) * b(k,269) - b(k,226) = b(k,226) - lu(k,2658) * b(k,269) - b(k,225) = b(k,225) - lu(k,2657) * b(k,269) - b(k,224) = b(k,224) - lu(k,2656) * b(k,269) - b(k,223) = b(k,223) - lu(k,2655) * b(k,269) - b(k,220) = b(k,220) - lu(k,2654) * b(k,269) - b(k,218) = b(k,218) - lu(k,2653) * b(k,269) - b(k,217) = b(k,217) - lu(k,2652) * b(k,269) - b(k,213) = b(k,213) - lu(k,2651) * b(k,269) - b(k,212) = b(k,212) - lu(k,2650) * b(k,269) - b(k,211) = b(k,211) - lu(k,2649) * b(k,269) - b(k,210) = b(k,210) - lu(k,2648) * b(k,269) - b(k,205) = b(k,205) - lu(k,2647) * b(k,269) - b(k,175) = b(k,175) - lu(k,2646) * b(k,269) - b(k,128) = b(k,128) - lu(k,2645) * b(k,269) - b(k,119) = b(k,119) - lu(k,2644) * b(k,269) - b(k,109) = b(k,109) - lu(k,2643) * b(k,269) - b(k,268) = b(k,268) * lu(k,2627) - b(k,267) = b(k,267) - lu(k,2626) * b(k,268) - b(k,266) = b(k,266) - lu(k,2625) * b(k,268) - b(k,265) = b(k,265) - lu(k,2624) * b(k,268) - b(k,264) = b(k,264) - lu(k,2623) * b(k,268) - b(k,263) = b(k,263) - lu(k,2622) * b(k,268) - b(k,262) = b(k,262) - lu(k,2621) * b(k,268) - b(k,261) = b(k,261) - lu(k,2620) * b(k,268) - b(k,260) = b(k,260) - lu(k,2619) * b(k,268) - b(k,259) = b(k,259) - lu(k,2618) * b(k,268) - b(k,258) = b(k,258) - lu(k,2617) * b(k,268) - b(k,257) = b(k,257) - lu(k,2616) * b(k,268) - b(k,256) = b(k,256) - lu(k,2615) * b(k,268) - b(k,255) = b(k,255) - lu(k,2614) * b(k,268) - b(k,254) = b(k,254) - lu(k,2613) * b(k,268) - b(k,253) = b(k,253) - lu(k,2612) * b(k,268) - b(k,252) = b(k,252) - lu(k,2611) * b(k,268) - b(k,251) = b(k,251) - lu(k,2610) * b(k,268) - b(k,250) = b(k,250) - lu(k,2609) * b(k,268) - b(k,249) = b(k,249) - lu(k,2608) * b(k,268) - b(k,248) = b(k,248) - lu(k,2607) * b(k,268) - b(k,247) = b(k,247) - lu(k,2606) * b(k,268) - b(k,231) = b(k,231) - lu(k,2605) * b(k,268) - b(k,227) = b(k,227) - lu(k,2604) * b(k,268) - b(k,226) = b(k,226) - lu(k,2603) * b(k,268) - b(k,223) = b(k,223) - lu(k,2602) * b(k,268) - b(k,217) = b(k,217) - lu(k,2601) * b(k,268) - b(k,213) = b(k,213) - lu(k,2600) * b(k,268) - b(k,192) = b(k,192) - lu(k,2599) * b(k,268) - b(k,175) = b(k,175) - lu(k,2598) * b(k,268) - b(k,126) = b(k,126) - lu(k,2597) * b(k,268) - b(k,100) = b(k,100) - lu(k,2596) * b(k,268) - b(k,267) = b(k,267) * lu(k,2579) - b(k,266) = b(k,266) - lu(k,2578) * b(k,267) - b(k,265) = b(k,265) - lu(k,2577) * b(k,267) - b(k,264) = b(k,264) - lu(k,2576) * b(k,267) - b(k,263) = b(k,263) - lu(k,2575) * b(k,267) - b(k,262) = b(k,262) - lu(k,2574) * b(k,267) - b(k,261) = b(k,261) - lu(k,2573) * b(k,267) - b(k,260) = b(k,260) - lu(k,2572) * b(k,267) - b(k,259) = b(k,259) - lu(k,2571) * b(k,267) - b(k,258) = b(k,258) - lu(k,2570) * b(k,267) - b(k,257) = b(k,257) - lu(k,2569) * b(k,267) - b(k,256) = b(k,256) - lu(k,2568) * b(k,267) - b(k,255) = b(k,255) - lu(k,2567) * b(k,267) - b(k,254) = b(k,254) - lu(k,2566) * b(k,267) - b(k,253) = b(k,253) - lu(k,2565) * b(k,267) - b(k,252) = b(k,252) - lu(k,2564) * b(k,267) - b(k,251) = b(k,251) - lu(k,2563) * b(k,267) - b(k,250) = b(k,250) - lu(k,2562) * b(k,267) - b(k,249) = b(k,249) - lu(k,2561) * b(k,267) - b(k,248) = b(k,248) - lu(k,2560) * b(k,267) - b(k,247) = b(k,247) - lu(k,2559) * b(k,267) - b(k,231) = b(k,231) - lu(k,2558) * b(k,267) - b(k,227) = b(k,227) - lu(k,2557) * b(k,267) - b(k,226) = b(k,226) - lu(k,2556) * b(k,267) - b(k,223) = b(k,223) - lu(k,2555) * b(k,267) - b(k,217) = b(k,217) - lu(k,2554) * b(k,267) - b(k,213) = b(k,213) - lu(k,2553) * b(k,267) - b(k,175) = b(k,175) - lu(k,2552) * b(k,267) - b(k,125) = b(k,125) - lu(k,2551) * b(k,267) - b(k,79) = b(k,79) - lu(k,2550) * b(k,267) - b(k,266) = b(k,266) * lu(k,2532) - b(k,265) = b(k,265) - lu(k,2531) * b(k,266) - b(k,264) = b(k,264) - lu(k,2530) * b(k,266) - b(k,263) = b(k,263) - lu(k,2529) * b(k,266) - b(k,262) = b(k,262) - lu(k,2528) * b(k,266) - b(k,261) = b(k,261) - lu(k,2527) * b(k,266) - b(k,260) = b(k,260) - lu(k,2526) * b(k,266) - b(k,259) = b(k,259) - lu(k,2525) * b(k,266) - b(k,258) = b(k,258) - lu(k,2524) * b(k,266) - b(k,257) = b(k,257) - lu(k,2523) * b(k,266) - b(k,256) = b(k,256) - lu(k,2522) * b(k,266) - b(k,255) = b(k,255) - lu(k,2521) * b(k,266) - b(k,254) = b(k,254) - lu(k,2520) * b(k,266) - b(k,253) = b(k,253) - lu(k,2519) * b(k,266) - b(k,252) = b(k,252) - lu(k,2518) * b(k,266) - b(k,251) = b(k,251) - lu(k,2517) * b(k,266) - b(k,250) = b(k,250) - lu(k,2516) * b(k,266) - b(k,249) = b(k,249) - lu(k,2515) * b(k,266) - b(k,248) = b(k,248) - lu(k,2514) * b(k,266) - b(k,247) = b(k,247) - lu(k,2513) * b(k,266) - b(k,231) = b(k,231) - lu(k,2512) * b(k,266) - b(k,227) = b(k,227) - lu(k,2511) * b(k,266) - b(k,226) = b(k,226) - lu(k,2510) * b(k,266) - b(k,223) = b(k,223) - lu(k,2509) * b(k,266) - b(k,217) = b(k,217) - lu(k,2508) * b(k,266) - b(k,213) = b(k,213) - lu(k,2507) * b(k,266) - b(k,175) = b(k,175) - lu(k,2506) * b(k,266) - b(k,124) = b(k,124) - lu(k,2505) * b(k,266) - b(k,78) = b(k,78) - lu(k,2504) * b(k,266) - b(k,265) = b(k,265) * lu(k,2489) - b(k,264) = b(k,264) - lu(k,2488) * b(k,265) - b(k,263) = b(k,263) - lu(k,2487) * b(k,265) - b(k,254) = b(k,254) - lu(k,2486) * b(k,265) - b(k,251) = b(k,251) - lu(k,2485) * b(k,265) - b(k,248) = b(k,248) - lu(k,2484) * b(k,265) - b(k,213) = b(k,213) - lu(k,2483) * b(k,265) - b(k,135) = b(k,135) - lu(k,2482) * b(k,265) - b(k,264) = b(k,264) * lu(k,2467) - b(k,263) = b(k,263) - lu(k,2466) * b(k,264) - b(k,254) = b(k,254) - lu(k,2465) * b(k,264) - b(k,231) = b(k,231) - lu(k,2464) * b(k,264) - b(k,223) = b(k,223) - lu(k,2463) * b(k,264) - b(k,217) = b(k,217) - lu(k,2462) * b(k,264) - b(k,127) = b(k,127) - lu(k,2461) * b(k,264) - b(k,263) = b(k,263) * lu(k,2445) - b(k,254) = b(k,254) - lu(k,2444) * b(k,263) - b(k,223) = b(k,223) - lu(k,2443) * b(k,263) - b(k,217) = b(k,217) - lu(k,2442) * b(k,263) - b(k,209) = b(k,209) - lu(k,2441) * b(k,263) - b(k,192) = b(k,192) - lu(k,2440) * b(k,263) - b(k,135) = b(k,135) - lu(k,2439) * b(k,263) - b(k,262) = b(k,262) * lu(k,2420) - b(k,254) = b(k,254) - lu(k,2419) * b(k,262) - b(k,231) = b(k,231) - lu(k,2418) * b(k,262) - b(k,217) = b(k,217) - lu(k,2417) * b(k,262) - b(k,208) = b(k,208) - lu(k,2416) * b(k,262) - b(k,187) = b(k,187) - lu(k,2415) * b(k,262) - b(k,186) = b(k,186) - lu(k,2414) * b(k,262) - b(k,164) = b(k,164) - lu(k,2413) * b(k,262) - b(k,145) = b(k,145) - lu(k,2412) * b(k,262) - b(k,261) = b(k,261) * lu(k,2392) - b(k,254) = b(k,254) - lu(k,2391) * b(k,261) - b(k,253) = b(k,253) - lu(k,2390) * b(k,261) - b(k,227) = b(k,227) - lu(k,2389) * b(k,261) - b(k,226) = b(k,226) - lu(k,2388) * b(k,261) - b(k,208) = b(k,208) - lu(k,2387) * b(k,261) - b(k,187) = b(k,187) - lu(k,2386) * b(k,261) - b(k,186) = b(k,186) - lu(k,2385) * b(k,261) - b(k,162) = b(k,162) - lu(k,2384) * b(k,261) - b(k,260) = b(k,260) * lu(k,2364) - b(k,259) = b(k,259) - lu(k,2363) * b(k,260) - b(k,254) = b(k,254) - lu(k,2362) * b(k,260) - b(k,251) = b(k,251) - lu(k,2361) * b(k,260) - b(k,227) = b(k,227) - lu(k,2360) * b(k,260) - b(k,226) = b(k,226) - lu(k,2359) * b(k,260) - b(k,217) = b(k,217) - lu(k,2358) * b(k,260) - b(k,213) = b(k,213) - lu(k,2357) * b(k,260) - b(k,209) = b(k,209) - lu(k,2356) * b(k,260) - b(k,190) = b(k,190) - lu(k,2355) * b(k,260) - b(k,189) = b(k,189) - lu(k,2354) * b(k,260) - b(k,179) = b(k,179) - lu(k,2353) * b(k,260) - b(k,170) = b(k,170) - lu(k,2352) * b(k,260) - b(k,144) = b(k,144) - lu(k,2351) * b(k,260) - b(k,134) = b(k,134) - lu(k,2350) * b(k,260) + b(k,306) = b(k,306) * lu(k,3331) + b(k,305) = b(k,305) - lu(k,3330) * b(k,306) + b(k,304) = b(k,304) - lu(k,3329) * b(k,306) + b(k,303) = b(k,303) - lu(k,3328) * b(k,306) + b(k,292) = b(k,292) - lu(k,3327) * b(k,306) + b(k,290) = b(k,290) - lu(k,3326) * b(k,306) + b(k,277) = b(k,277) - lu(k,3325) * b(k,306) + b(k,249) = b(k,249) - lu(k,3324) * b(k,306) + b(k,217) = b(k,217) - lu(k,3323) * b(k,306) + b(k,106) = b(k,106) - lu(k,3322) * b(k,306) + b(k,305) = b(k,305) * lu(k,3311) + b(k,304) = b(k,304) - lu(k,3310) * b(k,305) + b(k,303) = b(k,303) - lu(k,3309) * b(k,305) + b(k,302) = b(k,302) - lu(k,3308) * b(k,305) + b(k,301) = b(k,301) - lu(k,3307) * b(k,305) + b(k,300) = b(k,300) - lu(k,3306) * b(k,305) + b(k,299) = b(k,299) - lu(k,3305) * b(k,305) + b(k,298) = b(k,298) - lu(k,3304) * b(k,305) + b(k,297) = b(k,297) - lu(k,3303) * b(k,305) + b(k,296) = b(k,296) - lu(k,3302) * b(k,305) + b(k,295) = b(k,295) - lu(k,3301) * b(k,305) + b(k,294) = b(k,294) - lu(k,3300) * b(k,305) + b(k,293) = b(k,293) - lu(k,3299) * b(k,305) + b(k,292) = b(k,292) - lu(k,3298) * b(k,305) + b(k,291) = b(k,291) - lu(k,3297) * b(k,305) + b(k,290) = b(k,290) - lu(k,3296) * b(k,305) + b(k,289) = b(k,289) - lu(k,3295) * b(k,305) + b(k,288) = b(k,288) - lu(k,3294) * b(k,305) + b(k,287) = b(k,287) - lu(k,3293) * b(k,305) + b(k,286) = b(k,286) - lu(k,3292) * b(k,305) + b(k,285) = b(k,285) - lu(k,3291) * b(k,305) + b(k,284) = b(k,284) - lu(k,3290) * b(k,305) + b(k,283) = b(k,283) - lu(k,3289) * b(k,305) + b(k,282) = b(k,282) - lu(k,3288) * b(k,305) + b(k,281) = b(k,281) - lu(k,3287) * b(k,305) + b(k,280) = b(k,280) - lu(k,3286) * b(k,305) + b(k,279) = b(k,279) - lu(k,3285) * b(k,305) + b(k,278) = b(k,278) - lu(k,3284) * b(k,305) + b(k,277) = b(k,277) - lu(k,3283) * b(k,305) + b(k,276) = b(k,276) - lu(k,3282) * b(k,305) + b(k,275) = b(k,275) - lu(k,3281) * b(k,305) + b(k,274) = b(k,274) - lu(k,3280) * b(k,305) + b(k,273) = b(k,273) - lu(k,3279) * b(k,305) + b(k,272) = b(k,272) - lu(k,3278) * b(k,305) + b(k,271) = b(k,271) - lu(k,3277) * b(k,305) + b(k,270) = b(k,270) - lu(k,3276) * b(k,305) + b(k,269) = b(k,269) - lu(k,3275) * b(k,305) + b(k,268) = b(k,268) - lu(k,3274) * b(k,305) + b(k,267) = b(k,267) - lu(k,3273) * b(k,305) + b(k,266) = b(k,266) - lu(k,3272) * b(k,305) + b(k,265) = b(k,265) - lu(k,3271) * b(k,305) + b(k,264) = b(k,264) - lu(k,3270) * b(k,305) + b(k,263) = b(k,263) - lu(k,3269) * b(k,305) + b(k,262) = b(k,262) - lu(k,3268) * b(k,305) + b(k,261) = b(k,261) - lu(k,3267) * b(k,305) + b(k,260) = b(k,260) - lu(k,3266) * b(k,305) + b(k,259) = b(k,259) - lu(k,3265) * b(k,305) + b(k,258) = b(k,258) - lu(k,3264) * b(k,305) + b(k,257) = b(k,257) - lu(k,3263) * b(k,305) + b(k,256) = b(k,256) - lu(k,3262) * b(k,305) + b(k,255) = b(k,255) - lu(k,3261) * b(k,305) + b(k,254) = b(k,254) - lu(k,3260) * b(k,305) + b(k,253) = b(k,253) - lu(k,3259) * b(k,305) + b(k,252) = b(k,252) - lu(k,3258) * b(k,305) + b(k,251) = b(k,251) - lu(k,3257) * b(k,305) + b(k,250) = b(k,250) - lu(k,3256) * b(k,305) + b(k,248) = b(k,248) - lu(k,3255) * b(k,305) + b(k,247) = b(k,247) - lu(k,3254) * b(k,305) + b(k,246) = b(k,246) - lu(k,3253) * b(k,305) + b(k,245) = b(k,245) - lu(k,3252) * b(k,305) + b(k,242) = b(k,242) - lu(k,3251) * b(k,305) + b(k,241) = b(k,241) - lu(k,3250) * b(k,305) + b(k,240) = b(k,240) - lu(k,3249) * b(k,305) + b(k,239) = b(k,239) - lu(k,3248) * b(k,305) + b(k,238) = b(k,238) - lu(k,3247) * b(k,305) + b(k,237) = b(k,237) - lu(k,3246) * b(k,305) + b(k,236) = b(k,236) - lu(k,3245) * b(k,305) + b(k,234) = b(k,234) - lu(k,3244) * b(k,305) + b(k,233) = b(k,233) - lu(k,3243) * b(k,305) + b(k,232) = b(k,232) - lu(k,3242) * b(k,305) + b(k,231) = b(k,231) - lu(k,3241) * b(k,305) + b(k,230) = b(k,230) - lu(k,3240) * b(k,305) + b(k,229) = b(k,229) - lu(k,3239) * b(k,305) + b(k,228) = b(k,228) - lu(k,3238) * b(k,305) + b(k,227) = b(k,227) - lu(k,3237) * b(k,305) + b(k,224) = b(k,224) - lu(k,3236) * b(k,305) + b(k,223) = b(k,223) - lu(k,3235) * b(k,305) + b(k,222) = b(k,222) - lu(k,3234) * b(k,305) + b(k,220) = b(k,220) - lu(k,3233) * b(k,305) + b(k,219) = b(k,219) - lu(k,3232) * b(k,305) + b(k,213) = b(k,213) - lu(k,3231) * b(k,305) + b(k,212) = b(k,212) - lu(k,3230) * b(k,305) + b(k,211) = b(k,211) - lu(k,3229) * b(k,305) + b(k,210) = b(k,210) - lu(k,3228) * b(k,305) + b(k,208) = b(k,208) - lu(k,3227) * b(k,305) + b(k,206) = b(k,206) - lu(k,3226) * b(k,305) + b(k,204) = b(k,204) - lu(k,3225) * b(k,305) + b(k,203) = b(k,203) - lu(k,3224) * b(k,305) + b(k,202) = b(k,202) - lu(k,3223) * b(k,305) + b(k,201) = b(k,201) - lu(k,3222) * b(k,305) + b(k,198) = b(k,198) - lu(k,3221) * b(k,305) + b(k,197) = b(k,197) - lu(k,3220) * b(k,305) + b(k,195) = b(k,195) - lu(k,3219) * b(k,305) + b(k,194) = b(k,194) - lu(k,3218) * b(k,305) + b(k,192) = b(k,192) - lu(k,3217) * b(k,305) + b(k,191) = b(k,191) - lu(k,3216) * b(k,305) + b(k,190) = b(k,190) - lu(k,3215) * b(k,305) + b(k,189) = b(k,189) - lu(k,3214) * b(k,305) + b(k,188) = b(k,188) - lu(k,3213) * b(k,305) + b(k,187) = b(k,187) - lu(k,3212) * b(k,305) + b(k,186) = b(k,186) - lu(k,3211) * b(k,305) + b(k,185) = b(k,185) - lu(k,3210) * b(k,305) + b(k,182) = b(k,182) - lu(k,3209) * b(k,305) + b(k,181) = b(k,181) - lu(k,3208) * b(k,305) + b(k,180) = b(k,180) - lu(k,3207) * b(k,305) + b(k,179) = b(k,179) - lu(k,3206) * b(k,305) + b(k,178) = b(k,178) - lu(k,3205) * b(k,305) + b(k,175) = b(k,175) - lu(k,3204) * b(k,305) + b(k,174) = b(k,174) - lu(k,3203) * b(k,305) + b(k,173) = b(k,173) - lu(k,3202) * b(k,305) + b(k,172) = b(k,172) - lu(k,3201) * b(k,305) + b(k,165) = b(k,165) - lu(k,3200) * b(k,305) + b(k,163) = b(k,163) - lu(k,3199) * b(k,305) + b(k,162) = b(k,162) - lu(k,3198) * b(k,305) + b(k,160) = b(k,160) - lu(k,3197) * b(k,305) + b(k,151) = b(k,151) - lu(k,3196) * b(k,305) + b(k,150) = b(k,150) - lu(k,3195) * b(k,305) + b(k,149) = b(k,149) - lu(k,3194) * b(k,305) + b(k,144) = b(k,144) - lu(k,3193) * b(k,305) + b(k,143) = b(k,143) - lu(k,3192) * b(k,305) + b(k,142) = b(k,142) - lu(k,3191) * b(k,305) + b(k,140) = b(k,140) - lu(k,3190) * b(k,305) + b(k,139) = b(k,139) - lu(k,3189) * b(k,305) + b(k,136) = b(k,136) - lu(k,3188) * b(k,305) + b(k,132) = b(k,132) - lu(k,3187) * b(k,305) + b(k,130) = b(k,130) - lu(k,3186) * b(k,305) + b(k,128) = b(k,128) - lu(k,3185) * b(k,305) + b(k,126) = b(k,126) - lu(k,3184) * b(k,305) + b(k,119) = b(k,119) - lu(k,3183) * b(k,305) + b(k,108) = b(k,108) - lu(k,3182) * b(k,305) + b(k,101) = b(k,101) - lu(k,3181) * b(k,305) + b(k,99) = b(k,99) - lu(k,3180) * b(k,305) + b(k,87) = b(k,87) - lu(k,3179) * b(k,305) + b(k,55) = b(k,55) - lu(k,3178) * b(k,305) + b(k,54) = b(k,54) - lu(k,3177) * b(k,305) + b(k,53) = b(k,53) - lu(k,3176) * b(k,305) + b(k,52) = b(k,52) - lu(k,3175) * b(k,305) + b(k,50) = b(k,50) - lu(k,3174) * b(k,305) + b(k,49) = b(k,49) - lu(k,3173) * b(k,305) + b(k,48) = b(k,48) - lu(k,3172) * b(k,305) + b(k,47) = b(k,47) - lu(k,3171) * b(k,305) + b(k,46) = b(k,46) - lu(k,3170) * b(k,305) + b(k,45) = b(k,45) - lu(k,3169) * b(k,305) + b(k,42) = b(k,42) - lu(k,3168) * b(k,305) + b(k,41) = b(k,41) - lu(k,3167) * b(k,305) + b(k,40) = b(k,40) - lu(k,3166) * b(k,305) + b(k,39) = b(k,39) - lu(k,3165) * b(k,305) + b(k,38) = b(k,38) - lu(k,3164) * b(k,305) + b(k,37) = b(k,37) - lu(k,3163) * b(k,305) + b(k,304) = b(k,304) * lu(k,3151) + b(k,303) = b(k,303) - lu(k,3150) * b(k,304) + b(k,292) = b(k,292) - lu(k,3149) * b(k,304) + b(k,291) = b(k,291) - lu(k,3148) * b(k,304) + b(k,290) = b(k,290) - lu(k,3147) * b(k,304) + b(k,289) = b(k,289) - lu(k,3146) * b(k,304) + b(k,274) = b(k,274) - lu(k,3145) * b(k,304) + b(k,221) = b(k,221) - lu(k,3144) * b(k,304) + b(k,205) = b(k,205) - lu(k,3143) * b(k,304) + b(k,193) = b(k,193) - lu(k,3142) * b(k,304) + b(k,86) = b(k,86) - lu(k,3141) * b(k,304) + b(k,73) = b(k,73) - lu(k,3140) * b(k,304) + b(k,303) = b(k,303) * lu(k,3127) + b(k,302) = b(k,302) - lu(k,3126) * b(k,303) + b(k,301) = b(k,301) - lu(k,3125) * b(k,303) + b(k,300) = b(k,300) - lu(k,3124) * b(k,303) + b(k,299) = b(k,299) - lu(k,3123) * b(k,303) + b(k,298) = b(k,298) - lu(k,3122) * b(k,303) + b(k,297) = b(k,297) - lu(k,3121) * b(k,303) + b(k,296) = b(k,296) - lu(k,3120) * b(k,303) + b(k,295) = b(k,295) - lu(k,3119) * b(k,303) + b(k,294) = b(k,294) - lu(k,3118) * b(k,303) + b(k,293) = b(k,293) - lu(k,3117) * b(k,303) + b(k,292) = b(k,292) - lu(k,3116) * b(k,303) + b(k,291) = b(k,291) - lu(k,3115) * b(k,303) + b(k,290) = b(k,290) - lu(k,3114) * b(k,303) + b(k,289) = b(k,289) - lu(k,3113) * b(k,303) + b(k,288) = b(k,288) - lu(k,3112) * b(k,303) + b(k,287) = b(k,287) - lu(k,3111) * b(k,303) + b(k,286) = b(k,286) - lu(k,3110) * b(k,303) + b(k,285) = b(k,285) - lu(k,3109) * b(k,303) + b(k,284) = b(k,284) - lu(k,3108) * b(k,303) + b(k,283) = b(k,283) - lu(k,3107) * b(k,303) + b(k,282) = b(k,282) - lu(k,3106) * b(k,303) + b(k,281) = b(k,281) - lu(k,3105) * b(k,303) + b(k,280) = b(k,280) - lu(k,3104) * b(k,303) + b(k,279) = b(k,279) - lu(k,3103) * b(k,303) + b(k,278) = b(k,278) - lu(k,3102) * b(k,303) + b(k,277) = b(k,277) - lu(k,3101) * b(k,303) + b(k,275) = b(k,275) - lu(k,3100) * b(k,303) + b(k,274) = b(k,274) - lu(k,3099) * b(k,303) + b(k,273) = b(k,273) - lu(k,3098) * b(k,303) + b(k,272) = b(k,272) - lu(k,3097) * b(k,303) + b(k,271) = b(k,271) - lu(k,3096) * b(k,303) + b(k,270) = b(k,270) - lu(k,3095) * b(k,303) + b(k,269) = b(k,269) - lu(k,3094) * b(k,303) + b(k,268) = b(k,268) - lu(k,3093) * b(k,303) + b(k,267) = b(k,267) - lu(k,3092) * b(k,303) + b(k,266) = b(k,266) - lu(k,3091) * b(k,303) + b(k,265) = b(k,265) - lu(k,3090) * b(k,303) + b(k,264) = b(k,264) - lu(k,3089) * b(k,303) + b(k,263) = b(k,263) - lu(k,3088) * b(k,303) + b(k,262) = b(k,262) - lu(k,3087) * b(k,303) + b(k,261) = b(k,261) - lu(k,3086) * b(k,303) + b(k,260) = b(k,260) - lu(k,3085) * b(k,303) + b(k,259) = b(k,259) - lu(k,3084) * b(k,303) + b(k,258) = b(k,258) - lu(k,3083) * b(k,303) + b(k,257) = b(k,257) - lu(k,3082) * b(k,303) + b(k,256) = b(k,256) - lu(k,3081) * b(k,303) + b(k,255) = b(k,255) - lu(k,3080) * b(k,303) + b(k,254) = b(k,254) - lu(k,3079) * b(k,303) + b(k,253) = b(k,253) - lu(k,3078) * b(k,303) + b(k,252) = b(k,252) - lu(k,3077) * b(k,303) + b(k,248) = b(k,248) - lu(k,3076) * b(k,303) + b(k,247) = b(k,247) - lu(k,3075) * b(k,303) + b(k,245) = b(k,245) - lu(k,3074) * b(k,303) + b(k,244) = b(k,244) - lu(k,3073) * b(k,303) + b(k,243) = b(k,243) - lu(k,3072) * b(k,303) + b(k,236) = b(k,236) - lu(k,3071) * b(k,303) + b(k,235) = b(k,235) - lu(k,3070) * b(k,303) + b(k,234) = b(k,234) - lu(k,3069) * b(k,303) + b(k,233) = b(k,233) - lu(k,3068) * b(k,303) + b(k,230) = b(k,230) - lu(k,3067) * b(k,303) + b(k,228) = b(k,228) - lu(k,3066) * b(k,303) + b(k,226) = b(k,226) - lu(k,3065) * b(k,303) + b(k,225) = b(k,225) - lu(k,3064) * b(k,303) + b(k,224) = b(k,224) - lu(k,3063) * b(k,303) + b(k,223) = b(k,223) - lu(k,3062) * b(k,303) + b(k,218) = b(k,218) - lu(k,3061) * b(k,303) + b(k,215) = b(k,215) - lu(k,3060) * b(k,303) + b(k,214) = b(k,214) - lu(k,3059) * b(k,303) + b(k,211) = b(k,211) - lu(k,3058) * b(k,303) + b(k,210) = b(k,210) - lu(k,3057) * b(k,303) + b(k,201) = b(k,201) - lu(k,3056) * b(k,303) + b(k,200) = b(k,200) - lu(k,3055) * b(k,303) + b(k,199) = b(k,199) - lu(k,3054) * b(k,303) + b(k,196) = b(k,196) - lu(k,3053) * b(k,303) + b(k,189) = b(k,189) - lu(k,3052) * b(k,303) + b(k,178) = b(k,178) - lu(k,3051) * b(k,303) + b(k,177) = b(k,177) - lu(k,3050) * b(k,303) + b(k,175) = b(k,175) - lu(k,3049) * b(k,303) + b(k,171) = b(k,171) - lu(k,3048) * b(k,303) + b(k,168) = b(k,168) - lu(k,3047) * b(k,303) + b(k,162) = b(k,162) - lu(k,3046) * b(k,303) + b(k,148) = b(k,148) - lu(k,3045) * b(k,303) + b(k,141) = b(k,141) - lu(k,3044) * b(k,303) + b(k,136) = b(k,136) - lu(k,3043) * b(k,303) + b(k,79) = b(k,79) - lu(k,3042) * b(k,303) + b(k,41) = b(k,41) - lu(k,3041) * b(k,303) + b(k,40) = b(k,40) - lu(k,3040) * b(k,303) + b(k,39) = b(k,39) - lu(k,3039) * b(k,303) + b(k,38) = b(k,38) - lu(k,3038) * b(k,303) + b(k,37) = b(k,37) - lu(k,3037) * b(k,303) end do end subroutine lu_slv14 subroutine lu_slv15( avec_len, lu, b ) @@ -3398,209 +3329,224 @@ subroutine lu_slv15( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,259) = b(k,259) * lu(k,2332) - b(k,254) = b(k,254) - lu(k,2331) * b(k,259) - b(k,231) = b(k,231) - lu(k,2330) * b(k,259) - b(k,217) = b(k,217) - lu(k,2329) * b(k,259) - b(k,213) = b(k,213) - lu(k,2328) * b(k,259) - b(k,209) = b(k,209) - lu(k,2327) * b(k,259) - b(k,190) = b(k,190) - lu(k,2326) * b(k,259) - b(k,179) = b(k,179) - lu(k,2325) * b(k,259) - b(k,175) = b(k,175) - lu(k,2324) * b(k,259) - b(k,166) = b(k,166) - lu(k,2323) * b(k,259) - b(k,258) = b(k,258) * lu(k,2303) - b(k,254) = b(k,254) - lu(k,2302) * b(k,258) - b(k,227) = b(k,227) - lu(k,2301) * b(k,258) - b(k,226) = b(k,226) - lu(k,2300) * b(k,258) - b(k,217) = b(k,217) - lu(k,2299) * b(k,258) - b(k,213) = b(k,213) - lu(k,2298) * b(k,258) - b(k,209) = b(k,209) - lu(k,2297) * b(k,258) - b(k,190) = b(k,190) - lu(k,2296) * b(k,258) - b(k,189) = b(k,189) - lu(k,2295) * b(k,258) - b(k,179) = b(k,179) - lu(k,2294) * b(k,258) - b(k,170) = b(k,170) - lu(k,2293) * b(k,258) - b(k,144) = b(k,144) - lu(k,2292) * b(k,258) - b(k,134) = b(k,134) - lu(k,2291) * b(k,258) - b(k,257) = b(k,257) * lu(k,2271) - b(k,254) = b(k,254) - lu(k,2270) * b(k,257) - b(k,253) = b(k,253) - lu(k,2269) * b(k,257) - b(k,251) = b(k,251) - lu(k,2268) * b(k,257) - b(k,227) = b(k,227) - lu(k,2267) * b(k,257) - b(k,226) = b(k,226) - lu(k,2266) * b(k,257) - b(k,217) = b(k,217) - lu(k,2265) * b(k,257) - b(k,209) = b(k,209) - lu(k,2264) * b(k,257) - b(k,169) = b(k,169) - lu(k,2263) * b(k,257) - b(k,107) = b(k,107) - lu(k,2262) * b(k,257) - b(k,256) = b(k,256) * lu(k,2243) - b(k,254) = b(k,254) - lu(k,2242) * b(k,256) - b(k,253) = b(k,253) - lu(k,2241) * b(k,256) - b(k,251) = b(k,251) - lu(k,2240) * b(k,256) - b(k,231) = b(k,231) - lu(k,2239) * b(k,256) - b(k,227) = b(k,227) - lu(k,2238) * b(k,256) - b(k,226) = b(k,226) - lu(k,2237) * b(k,256) - b(k,217) = b(k,217) - lu(k,2236) * b(k,256) - b(k,213) = b(k,213) - lu(k,2235) * b(k,256) - b(k,175) = b(k,175) - lu(k,2234) * b(k,256) - b(k,135) = b(k,135) - lu(k,2233) * b(k,256) - b(k,255) = b(k,255) * lu(k,2214) - b(k,254) = b(k,254) - lu(k,2213) * b(k,255) - b(k,253) = b(k,253) - lu(k,2212) * b(k,255) - b(k,251) = b(k,251) - lu(k,2211) * b(k,255) - b(k,231) = b(k,231) - lu(k,2210) * b(k,255) - b(k,227) = b(k,227) - lu(k,2209) * b(k,255) - b(k,226) = b(k,226) - lu(k,2208) * b(k,255) - b(k,217) = b(k,217) - lu(k,2207) * b(k,255) - b(k,213) = b(k,213) - lu(k,2206) * b(k,255) - b(k,209) = b(k,209) - lu(k,2205) * b(k,255) - b(k,175) = b(k,175) - lu(k,2204) * b(k,255) - b(k,164) = b(k,164) - lu(k,2203) * b(k,255) - b(k,135) = b(k,135) - lu(k,2202) * b(k,255) - b(k,254) = b(k,254) * lu(k,2193) - b(k,223) = b(k,223) - lu(k,2192) * b(k,254) - b(k,253) = b(k,253) * lu(k,2179) - b(k,231) = b(k,231) - lu(k,2178) * b(k,253) - b(k,217) = b(k,217) - lu(k,2177) * b(k,253) - b(k,164) = b(k,164) - lu(k,2176) * b(k,253) - b(k,161) = b(k,161) - lu(k,2175) * b(k,253) - b(k,252) = b(k,252) * lu(k,2156) - b(k,227) = b(k,227) - lu(k,2155) * b(k,252) - b(k,226) = b(k,226) - lu(k,2154) * b(k,252) - b(k,209) = b(k,209) - lu(k,2153) * b(k,252) - b(k,251) = b(k,251) * lu(k,2141) - b(k,240) = b(k,240) - lu(k,2140) * b(k,251) - b(k,228) = b(k,228) - lu(k,2139) * b(k,251) - b(k,209) = b(k,209) - lu(k,2138) * b(k,251) - b(k,197) = b(k,197) - lu(k,2137) * b(k,251) - b(k,250) = b(k,250) * lu(k,2119) - b(k,217) = b(k,217) - lu(k,2118) * b(k,250) - b(k,213) = b(k,213) - lu(k,2117) * b(k,250) - b(k,209) = b(k,209) - lu(k,2116) * b(k,250) - b(k,190) = b(k,190) - lu(k,2115) * b(k,250) - b(k,179) = b(k,179) - lu(k,2114) * b(k,250) - b(k,249) = b(k,249) * lu(k,2096) - b(k,217) = b(k,217) - lu(k,2095) * b(k,249) - b(k,209) = b(k,209) - lu(k,2094) * b(k,249) - b(k,169) = b(k,169) - lu(k,2093) * b(k,249) - b(k,107) = b(k,107) - lu(k,2092) * b(k,249) - b(k,34) = b(k,34) - lu(k,2091) * b(k,249) - b(k,248) = b(k,248) * lu(k,2072) - b(k,231) = b(k,231) - lu(k,2071) * b(k,248) - b(k,213) = b(k,213) - lu(k,2070) * b(k,248) - b(k,127) = b(k,127) - lu(k,2069) * b(k,248) - b(k,247) = b(k,247) * lu(k,2053) - b(k,209) = b(k,209) - lu(k,2052) * b(k,247) - b(k,34) = b(k,34) - lu(k,2051) * b(k,247) - b(k,246) = b(k,246) * lu(k,2034) - b(k,245) = b(k,245) - lu(k,2033) * b(k,246) - b(k,244) = b(k,244) - lu(k,2032) * b(k,246) - b(k,243) = b(k,243) - lu(k,2031) * b(k,246) - b(k,241) = b(k,241) - lu(k,2030) * b(k,246) - b(k,240) = b(k,240) - lu(k,2029) * b(k,246) - b(k,238) = b(k,238) - lu(k,2028) * b(k,246) - b(k,236) = b(k,236) - lu(k,2027) * b(k,246) - b(k,230) = b(k,230) - lu(k,2026) * b(k,246) - b(k,229) = b(k,229) - lu(k,2025) * b(k,246) - b(k,228) = b(k,228) - lu(k,2024) * b(k,246) - b(k,223) = b(k,223) - lu(k,2023) * b(k,246) - b(k,222) = b(k,222) - lu(k,2022) * b(k,246) - b(k,219) = b(k,219) - lu(k,2021) * b(k,246) - b(k,218) = b(k,218) - lu(k,2020) * b(k,246) - b(k,216) = b(k,216) - lu(k,2019) * b(k,246) - b(k,209) = b(k,209) - lu(k,2018) * b(k,246) - b(k,207) = b(k,207) - lu(k,2017) * b(k,246) - b(k,206) = b(k,206) - lu(k,2016) * b(k,246) - b(k,204) = b(k,204) - lu(k,2015) * b(k,246) - b(k,201) = b(k,201) - lu(k,2014) * b(k,246) - b(k,198) = b(k,198) - lu(k,2013) * b(k,246) - b(k,194) = b(k,194) - lu(k,2012) * b(k,246) - b(k,187) = b(k,187) - lu(k,2011) * b(k,246) - b(k,184) = b(k,184) - lu(k,2010) * b(k,246) - b(k,181) = b(k,181) - lu(k,2009) * b(k,246) - b(k,139) = b(k,139) - lu(k,2008) * b(k,246) - b(k,245) = b(k,245) * lu(k,1993) - b(k,240) = b(k,240) - lu(k,1992) * b(k,245) - b(k,238) = b(k,238) - lu(k,1991) * b(k,245) - b(k,234) = b(k,234) - lu(k,1990) * b(k,245) - b(k,230) = b(k,230) - lu(k,1989) * b(k,245) - b(k,229) = b(k,229) - lu(k,1988) * b(k,245) - b(k,228) = b(k,228) - lu(k,1987) * b(k,245) - b(k,223) = b(k,223) - lu(k,1986) * b(k,245) - b(k,219) = b(k,219) - lu(k,1985) * b(k,245) - b(k,208) = b(k,208) - lu(k,1984) * b(k,245) - b(k,207) = b(k,207) - lu(k,1983) * b(k,245) - b(k,201) = b(k,201) - lu(k,1982) * b(k,245) - b(k,198) = b(k,198) - lu(k,1981) * b(k,245) - b(k,193) = b(k,193) - lu(k,1980) * b(k,245) - b(k,244) = b(k,244) * lu(k,1964) - b(k,240) = b(k,240) - lu(k,1963) * b(k,244) - b(k,238) = b(k,238) - lu(k,1962) * b(k,244) - b(k,234) = b(k,234) - lu(k,1961) * b(k,244) - b(k,230) = b(k,230) - lu(k,1960) * b(k,244) - b(k,229) = b(k,229) - lu(k,1959) * b(k,244) - b(k,228) = b(k,228) - lu(k,1958) * b(k,244) - b(k,223) = b(k,223) - lu(k,1957) * b(k,244) - b(k,222) = b(k,222) - lu(k,1956) * b(k,244) - b(k,218) = b(k,218) - lu(k,1955) * b(k,244) - b(k,214) = b(k,214) - lu(k,1954) * b(k,244) - b(k,210) = b(k,210) - lu(k,1953) * b(k,244) - b(k,208) = b(k,208) - lu(k,1952) * b(k,244) - b(k,206) = b(k,206) - lu(k,1951) * b(k,244) - b(k,201) = b(k,201) - lu(k,1950) * b(k,244) - b(k,198) = b(k,198) - lu(k,1949) * b(k,244) - b(k,193) = b(k,193) - lu(k,1948) * b(k,244) - b(k,177) = b(k,177) - lu(k,1947) * b(k,244) - b(k,157) = b(k,157) - lu(k,1946) * b(k,244) - b(k,243) = b(k,243) * lu(k,1930) - b(k,240) = b(k,240) - lu(k,1929) * b(k,243) - b(k,238) = b(k,238) - lu(k,1928) * b(k,243) - b(k,234) = b(k,234) - lu(k,1927) * b(k,243) - b(k,230) = b(k,230) - lu(k,1926) * b(k,243) - b(k,229) = b(k,229) - lu(k,1925) * b(k,243) - b(k,228) = b(k,228) - lu(k,1924) * b(k,243) - b(k,223) = b(k,223) - lu(k,1923) * b(k,243) - b(k,222) = b(k,222) - lu(k,1922) * b(k,243) - b(k,218) = b(k,218) - lu(k,1921) * b(k,243) - b(k,214) = b(k,214) - lu(k,1920) * b(k,243) - b(k,208) = b(k,208) - lu(k,1919) * b(k,243) - b(k,207) = b(k,207) - lu(k,1918) * b(k,243) - b(k,206) = b(k,206) - lu(k,1917) * b(k,243) - b(k,205) = b(k,205) - lu(k,1916) * b(k,243) - b(k,198) = b(k,198) - lu(k,1915) * b(k,243) - b(k,193) = b(k,193) - lu(k,1914) * b(k,243) - b(k,176) = b(k,176) - lu(k,1913) * b(k,243) - b(k,157) = b(k,157) - lu(k,1912) * b(k,243) - b(k,242) = b(k,242) * lu(k,1896) - b(k,241) = b(k,241) - lu(k,1895) * b(k,242) - b(k,240) = b(k,240) - lu(k,1894) * b(k,242) - b(k,239) = b(k,239) - lu(k,1893) * b(k,242) - b(k,238) = b(k,238) - lu(k,1892) * b(k,242) - b(k,236) = b(k,236) - lu(k,1891) * b(k,242) - b(k,235) = b(k,235) - lu(k,1890) * b(k,242) - b(k,234) = b(k,234) - lu(k,1889) * b(k,242) - b(k,230) = b(k,230) - lu(k,1888) * b(k,242) - b(k,228) = b(k,228) - lu(k,1887) * b(k,242) - b(k,223) = b(k,223) - lu(k,1886) * b(k,242) - b(k,218) = b(k,218) - lu(k,1885) * b(k,242) - b(k,214) = b(k,214) - lu(k,1884) * b(k,242) - b(k,210) = b(k,210) - lu(k,1883) * b(k,242) - b(k,205) = b(k,205) - lu(k,1882) * b(k,242) - b(k,198) = b(k,198) - lu(k,1881) * b(k,242) - b(k,193) = b(k,193) - lu(k,1880) * b(k,242) - b(k,157) = b(k,157) - lu(k,1879) * b(k,242) - b(k,143) = b(k,143) - lu(k,1878) * b(k,242) - b(k,113) = b(k,113) - lu(k,1877) * b(k,242) - b(k,112) = b(k,112) - lu(k,1876) * b(k,242) - b(k,241) = b(k,241) * lu(k,1863) - b(k,240) = b(k,240) - lu(k,1862) * b(k,241) - b(k,238) = b(k,238) - lu(k,1861) * b(k,241) - b(k,228) = b(k,228) - lu(k,1860) * b(k,241) - b(k,223) = b(k,223) - lu(k,1859) * b(k,241) - b(k,218) = b(k,218) - lu(k,1858) * b(k,241) - b(k,211) = b(k,211) - lu(k,1857) * b(k,241) - b(k,207) = b(k,207) - lu(k,1856) * b(k,241) - b(k,203) = b(k,203) - lu(k,1855) * b(k,241) - b(k,195) = b(k,195) - lu(k,1854) * b(k,241) - b(k,187) = b(k,187) - lu(k,1853) * b(k,241) + b(k,302) = b(k,302) * lu(k,3023) + b(k,301) = b(k,301) - lu(k,3022) * b(k,302) + b(k,300) = b(k,300) - lu(k,3021) * b(k,302) + b(k,299) = b(k,299) - lu(k,3020) * b(k,302) + b(k,298) = b(k,298) - lu(k,3019) * b(k,302) + b(k,297) = b(k,297) - lu(k,3018) * b(k,302) + b(k,296) = b(k,296) - lu(k,3017) * b(k,302) + b(k,295) = b(k,295) - lu(k,3016) * b(k,302) + b(k,294) = b(k,294) - lu(k,3015) * b(k,302) + b(k,293) = b(k,293) - lu(k,3014) * b(k,302) + b(k,292) = b(k,292) - lu(k,3013) * b(k,302) + b(k,290) = b(k,290) - lu(k,3012) * b(k,302) + b(k,288) = b(k,288) - lu(k,3011) * b(k,302) + b(k,287) = b(k,287) - lu(k,3010) * b(k,302) + b(k,286) = b(k,286) - lu(k,3009) * b(k,302) + b(k,285) = b(k,285) - lu(k,3008) * b(k,302) + b(k,284) = b(k,284) - lu(k,3007) * b(k,302) + b(k,283) = b(k,283) - lu(k,3006) * b(k,302) + b(k,282) = b(k,282) - lu(k,3005) * b(k,302) + b(k,281) = b(k,281) - lu(k,3004) * b(k,302) + b(k,280) = b(k,280) - lu(k,3003) * b(k,302) + b(k,279) = b(k,279) - lu(k,3002) * b(k,302) + b(k,278) = b(k,278) - lu(k,3001) * b(k,302) + b(k,277) = b(k,277) - lu(k,3000) * b(k,302) + b(k,276) = b(k,276) - lu(k,2999) * b(k,302) + b(k,275) = b(k,275) - lu(k,2998) * b(k,302) + b(k,273) = b(k,273) - lu(k,2997) * b(k,302) + b(k,272) = b(k,272) - lu(k,2996) * b(k,302) + b(k,271) = b(k,271) - lu(k,2995) * b(k,302) + b(k,270) = b(k,270) - lu(k,2994) * b(k,302) + b(k,269) = b(k,269) - lu(k,2993) * b(k,302) + b(k,268) = b(k,268) - lu(k,2992) * b(k,302) + b(k,267) = b(k,267) - lu(k,2991) * b(k,302) + b(k,266) = b(k,266) - lu(k,2990) * b(k,302) + b(k,265) = b(k,265) - lu(k,2989) * b(k,302) + b(k,264) = b(k,264) - lu(k,2988) * b(k,302) + b(k,263) = b(k,263) - lu(k,2987) * b(k,302) + b(k,262) = b(k,262) - lu(k,2986) * b(k,302) + b(k,261) = b(k,261) - lu(k,2985) * b(k,302) + b(k,260) = b(k,260) - lu(k,2984) * b(k,302) + b(k,259) = b(k,259) - lu(k,2983) * b(k,302) + b(k,257) = b(k,257) - lu(k,2982) * b(k,302) + b(k,256) = b(k,256) - lu(k,2981) * b(k,302) + b(k,255) = b(k,255) - lu(k,2980) * b(k,302) + b(k,254) = b(k,254) - lu(k,2979) * b(k,302) + b(k,253) = b(k,253) - lu(k,2978) * b(k,302) + b(k,252) = b(k,252) - lu(k,2977) * b(k,302) + b(k,251) = b(k,251) - lu(k,2976) * b(k,302) + b(k,250) = b(k,250) - lu(k,2975) * b(k,302) + b(k,246) = b(k,246) - lu(k,2974) * b(k,302) + b(k,245) = b(k,245) - lu(k,2973) * b(k,302) + b(k,242) = b(k,242) - lu(k,2972) * b(k,302) + b(k,241) = b(k,241) - lu(k,2971) * b(k,302) + b(k,240) = b(k,240) - lu(k,2970) * b(k,302) + b(k,238) = b(k,238) - lu(k,2969) * b(k,302) + b(k,237) = b(k,237) - lu(k,2968) * b(k,302) + b(k,231) = b(k,231) - lu(k,2967) * b(k,302) + b(k,201) = b(k,201) - lu(k,2966) * b(k,302) + b(k,171) = b(k,171) - lu(k,2965) * b(k,302) + b(k,161) = b(k,161) - lu(k,2964) * b(k,302) + b(k,145) = b(k,145) - lu(k,2963) * b(k,302) + b(k,301) = b(k,301) * lu(k,2948) + b(k,300) = b(k,300) - lu(k,2947) * b(k,301) + b(k,299) = b(k,299) - lu(k,2946) * b(k,301) + b(k,298) = b(k,298) - lu(k,2945) * b(k,301) + b(k,297) = b(k,297) - lu(k,2944) * b(k,301) + b(k,296) = b(k,296) - lu(k,2943) * b(k,301) + b(k,295) = b(k,295) - lu(k,2942) * b(k,301) + b(k,294) = b(k,294) - lu(k,2941) * b(k,301) + b(k,293) = b(k,293) - lu(k,2940) * b(k,301) + b(k,288) = b(k,288) - lu(k,2939) * b(k,301) + b(k,287) = b(k,287) - lu(k,2938) * b(k,301) + b(k,286) = b(k,286) - lu(k,2937) * b(k,301) + b(k,285) = b(k,285) - lu(k,2936) * b(k,301) + b(k,284) = b(k,284) - lu(k,2935) * b(k,301) + b(k,283) = b(k,283) - lu(k,2934) * b(k,301) + b(k,282) = b(k,282) - lu(k,2933) * b(k,301) + b(k,281) = b(k,281) - lu(k,2932) * b(k,301) + b(k,280) = b(k,280) - lu(k,2931) * b(k,301) + b(k,279) = b(k,279) - lu(k,2930) * b(k,301) + b(k,278) = b(k,278) - lu(k,2929) * b(k,301) + b(k,276) = b(k,276) - lu(k,2928) * b(k,301) + b(k,275) = b(k,275) - lu(k,2927) * b(k,301) + b(k,264) = b(k,264) - lu(k,2926) * b(k,301) + b(k,253) = b(k,253) - lu(k,2925) * b(k,301) + b(k,251) = b(k,251) - lu(k,2924) * b(k,301) + b(k,250) = b(k,250) - lu(k,2923) * b(k,301) + b(k,245) = b(k,245) - lu(k,2922) * b(k,301) + b(k,242) = b(k,242) - lu(k,2921) * b(k,301) + b(k,240) = b(k,240) - lu(k,2920) * b(k,301) + b(k,201) = b(k,201) - lu(k,2919) * b(k,301) + b(k,155) = b(k,155) - lu(k,2918) * b(k,301) + b(k,113) = b(k,113) - lu(k,2917) * b(k,301) + b(k,300) = b(k,300) * lu(k,2901) + b(k,299) = b(k,299) - lu(k,2900) * b(k,300) + b(k,298) = b(k,298) - lu(k,2899) * b(k,300) + b(k,297) = b(k,297) - lu(k,2898) * b(k,300) + b(k,296) = b(k,296) - lu(k,2897) * b(k,300) + b(k,295) = b(k,295) - lu(k,2896) * b(k,300) + b(k,294) = b(k,294) - lu(k,2895) * b(k,300) + b(k,293) = b(k,293) - lu(k,2894) * b(k,300) + b(k,288) = b(k,288) - lu(k,2893) * b(k,300) + b(k,287) = b(k,287) - lu(k,2892) * b(k,300) + b(k,286) = b(k,286) - lu(k,2891) * b(k,300) + b(k,285) = b(k,285) - lu(k,2890) * b(k,300) + b(k,284) = b(k,284) - lu(k,2889) * b(k,300) + b(k,283) = b(k,283) - lu(k,2888) * b(k,300) + b(k,282) = b(k,282) - lu(k,2887) * b(k,300) + b(k,281) = b(k,281) - lu(k,2886) * b(k,300) + b(k,280) = b(k,280) - lu(k,2885) * b(k,300) + b(k,279) = b(k,279) - lu(k,2884) * b(k,300) + b(k,278) = b(k,278) - lu(k,2883) * b(k,300) + b(k,276) = b(k,276) - lu(k,2882) * b(k,300) + b(k,275) = b(k,275) - lu(k,2881) * b(k,300) + b(k,264) = b(k,264) - lu(k,2880) * b(k,300) + b(k,253) = b(k,253) - lu(k,2879) * b(k,300) + b(k,251) = b(k,251) - lu(k,2878) * b(k,300) + b(k,250) = b(k,250) - lu(k,2877) * b(k,300) + b(k,245) = b(k,245) - lu(k,2876) * b(k,300) + b(k,242) = b(k,242) - lu(k,2875) * b(k,300) + b(k,240) = b(k,240) - lu(k,2874) * b(k,300) + b(k,218) = b(k,218) - lu(k,2873) * b(k,300) + b(k,201) = b(k,201) - lu(k,2872) * b(k,300) + b(k,168) = b(k,168) - lu(k,2871) * b(k,300) + b(k,123) = b(k,123) - lu(k,2870) * b(k,300) + b(k,299) = b(k,299) * lu(k,2853) + b(k,298) = b(k,298) - lu(k,2852) * b(k,299) + b(k,297) = b(k,297) - lu(k,2851) * b(k,299) + b(k,296) = b(k,296) - lu(k,2850) * b(k,299) + b(k,295) = b(k,295) - lu(k,2849) * b(k,299) + b(k,294) = b(k,294) - lu(k,2848) * b(k,299) + b(k,293) = b(k,293) - lu(k,2847) * b(k,299) + b(k,288) = b(k,288) - lu(k,2846) * b(k,299) + b(k,287) = b(k,287) - lu(k,2845) * b(k,299) + b(k,286) = b(k,286) - lu(k,2844) * b(k,299) + b(k,285) = b(k,285) - lu(k,2843) * b(k,299) + b(k,284) = b(k,284) - lu(k,2842) * b(k,299) + b(k,283) = b(k,283) - lu(k,2841) * b(k,299) + b(k,282) = b(k,282) - lu(k,2840) * b(k,299) + b(k,281) = b(k,281) - lu(k,2839) * b(k,299) + b(k,280) = b(k,280) - lu(k,2838) * b(k,299) + b(k,279) = b(k,279) - lu(k,2837) * b(k,299) + b(k,278) = b(k,278) - lu(k,2836) * b(k,299) + b(k,276) = b(k,276) - lu(k,2835) * b(k,299) + b(k,275) = b(k,275) - lu(k,2834) * b(k,299) + b(k,264) = b(k,264) - lu(k,2833) * b(k,299) + b(k,253) = b(k,253) - lu(k,2832) * b(k,299) + b(k,251) = b(k,251) - lu(k,2831) * b(k,299) + b(k,250) = b(k,250) - lu(k,2830) * b(k,299) + b(k,245) = b(k,245) - lu(k,2829) * b(k,299) + b(k,242) = b(k,242) - lu(k,2828) * b(k,299) + b(k,240) = b(k,240) - lu(k,2827) * b(k,299) + b(k,201) = b(k,201) - lu(k,2826) * b(k,299) + b(k,156) = b(k,156) - lu(k,2825) * b(k,299) + b(k,114) = b(k,114) - lu(k,2824) * b(k,299) + b(k,298) = b(k,298) * lu(k,2806) + b(k,297) = b(k,297) - lu(k,2805) * b(k,298) + b(k,296) = b(k,296) - lu(k,2804) * b(k,298) + b(k,295) = b(k,295) - lu(k,2803) * b(k,298) + b(k,293) = b(k,293) - lu(k,2802) * b(k,298) + b(k,285) = b(k,285) - lu(k,2801) * b(k,298) + b(k,282) = b(k,282) - lu(k,2800) * b(k,298) + b(k,281) = b(k,281) - lu(k,2799) * b(k,298) + b(k,278) = b(k,278) - lu(k,2798) * b(k,298) + b(k,264) = b(k,264) - lu(k,2797) * b(k,298) + b(k,251) = b(k,251) - lu(k,2796) * b(k,298) + b(k,250) = b(k,250) - lu(k,2795) * b(k,298) + b(k,245) = b(k,245) - lu(k,2794) * b(k,298) + b(k,242) = b(k,242) - lu(k,2793) * b(k,298) + b(k,236) = b(k,236) - lu(k,2792) * b(k,298) + b(k,194) = b(k,194) - lu(k,2791) * b(k,298) + b(k,131) = b(k,131) - lu(k,2790) * b(k,298) + b(k,297) = b(k,297) * lu(k,2775) + b(k,296) = b(k,296) - lu(k,2774) * b(k,297) + b(k,295) = b(k,295) - lu(k,2773) * b(k,297) + b(k,282) = b(k,282) - lu(k,2772) * b(k,297) + b(k,278) = b(k,278) - lu(k,2771) * b(k,297) + b(k,276) = b(k,276) - lu(k,2770) * b(k,297) + b(k,264) = b(k,264) - lu(k,2769) * b(k,297) + b(k,245) = b(k,245) - lu(k,2768) * b(k,297) + b(k,240) = b(k,240) - lu(k,2767) * b(k,297) + b(k,158) = b(k,158) - lu(k,2766) * b(k,297) + b(k,296) = b(k,296) * lu(k,2751) + b(k,295) = b(k,295) - lu(k,2750) * b(k,296) + b(k,282) = b(k,282) - lu(k,2749) * b(k,296) + b(k,264) = b(k,264) - lu(k,2748) * b(k,296) + b(k,253) = b(k,253) - lu(k,2747) * b(k,296) + b(k,245) = b(k,245) - lu(k,2746) * b(k,296) + b(k,242) = b(k,242) - lu(k,2745) * b(k,296) + b(k,149) = b(k,149) - lu(k,2744) * b(k,296) + b(k,295) = b(k,295) * lu(k,2728) + b(k,282) = b(k,282) - lu(k,2727) * b(k,295) + b(k,264) = b(k,264) - lu(k,2726) * b(k,295) + b(k,245) = b(k,245) - lu(k,2725) * b(k,295) + b(k,242) = b(k,242) - lu(k,2724) * b(k,295) + b(k,236) = b(k,236) - lu(k,2723) * b(k,295) + b(k,218) = b(k,218) - lu(k,2722) * b(k,295) + b(k,158) = b(k,158) - lu(k,2721) * b(k,295) + b(k,294) = b(k,294) * lu(k,2700) + b(k,293) = b(k,293) - lu(k,2699) * b(k,294) + b(k,288) = b(k,288) - lu(k,2698) * b(k,294) + b(k,285) = b(k,285) - lu(k,2697) * b(k,294) + b(k,282) = b(k,282) - lu(k,2696) * b(k,294) + b(k,281) = b(k,281) - lu(k,2695) * b(k,294) + b(k,278) = b(k,278) - lu(k,2694) * b(k,294) + b(k,264) = b(k,264) - lu(k,2693) * b(k,294) + b(k,251) = b(k,251) - lu(k,2692) * b(k,294) + b(k,250) = b(k,250) - lu(k,2691) * b(k,294) + b(k,245) = b(k,245) - lu(k,2690) * b(k,294) + b(k,242) = b(k,242) - lu(k,2689) * b(k,294) + b(k,240) = b(k,240) - lu(k,2688) * b(k,294) + b(k,236) = b(k,236) - lu(k,2687) * b(k,294) + b(k,213) = b(k,213) - lu(k,2686) * b(k,294) + b(k,212) = b(k,212) - lu(k,2685) * b(k,294) + b(k,206) = b(k,206) - lu(k,2684) * b(k,294) + b(k,195) = b(k,195) - lu(k,2683) * b(k,294) + b(k,170) = b(k,170) - lu(k,2682) * b(k,294) + b(k,157) = b(k,157) - lu(k,2681) * b(k,294) end do end subroutine lu_slv15 subroutine lu_slv16( avec_len, lu, b ) @@ -3621,208 +3567,216 @@ subroutine lu_slv16( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,240) = b(k,240) * lu(k,1845) - b(k,223) = b(k,223) - lu(k,1844) * b(k,240) - b(k,239) = b(k,239) * lu(k,1829) - b(k,238) = b(k,238) - lu(k,1828) * b(k,239) - b(k,237) = b(k,237) - lu(k,1827) * b(k,239) - b(k,234) = b(k,234) - lu(k,1826) * b(k,239) - b(k,230) = b(k,230) - lu(k,1825) * b(k,239) - b(k,229) = b(k,229) - lu(k,1824) * b(k,239) - b(k,228) = b(k,228) - lu(k,1823) * b(k,239) - b(k,224) = b(k,224) - lu(k,1822) * b(k,239) - b(k,223) = b(k,223) - lu(k,1821) * b(k,239) - b(k,222) = b(k,222) - lu(k,1820) * b(k,239) - b(k,218) = b(k,218) - lu(k,1819) * b(k,239) - b(k,214) = b(k,214) - lu(k,1818) * b(k,239) - b(k,206) = b(k,206) - lu(k,1817) * b(k,239) - b(k,198) = b(k,198) - lu(k,1816) * b(k,239) - b(k,183) = b(k,183) - lu(k,1815) * b(k,239) - b(k,157) = b(k,157) - lu(k,1814) * b(k,239) - b(k,156) = b(k,156) - lu(k,1813) * b(k,239) - b(k,133) = b(k,133) - lu(k,1812) * b(k,239) - b(k,72) = b(k,72) - lu(k,1811) * b(k,239) - b(k,71) = b(k,71) - lu(k,1810) * b(k,239) - b(k,238) = b(k,238) * lu(k,1801) - b(k,223) = b(k,223) - lu(k,1800) * b(k,238) - b(k,218) = b(k,218) - lu(k,1799) * b(k,238) - b(k,207) = b(k,207) - lu(k,1798) * b(k,238) - b(k,201) = b(k,201) - lu(k,1797) * b(k,238) - b(k,60) = b(k,60) - lu(k,1796) * b(k,238) - b(k,237) = b(k,237) * lu(k,1780) - b(k,234) = b(k,234) - lu(k,1779) * b(k,237) - b(k,228) = b(k,228) - lu(k,1778) * b(k,237) - b(k,223) = b(k,223) - lu(k,1777) * b(k,237) - b(k,218) = b(k,218) - lu(k,1776) * b(k,237) - b(k,211) = b(k,211) - lu(k,1775) * b(k,237) - b(k,210) = b(k,210) - lu(k,1774) * b(k,237) - b(k,209) = b(k,209) - lu(k,1773) * b(k,237) - b(k,198) = b(k,198) - lu(k,1772) * b(k,237) - b(k,187) = b(k,187) - lu(k,1771) * b(k,237) - b(k,158) = b(k,158) - lu(k,1770) * b(k,237) - b(k,156) = b(k,156) - lu(k,1769) * b(k,237) - b(k,132) = b(k,132) - lu(k,1768) * b(k,237) - b(k,130) = b(k,130) - lu(k,1767) * b(k,237) - b(k,112) = b(k,112) - lu(k,1766) * b(k,237) - b(k,71) = b(k,71) - lu(k,1765) * b(k,237) - b(k,236) = b(k,236) * lu(k,1751) - b(k,229) = b(k,229) - lu(k,1750) * b(k,236) - b(k,228) = b(k,228) - lu(k,1749) * b(k,236) - b(k,223) = b(k,223) - lu(k,1748) * b(k,236) - b(k,220) = b(k,220) - lu(k,1747) * b(k,236) - b(k,212) = b(k,212) - lu(k,1746) * b(k,236) - b(k,187) = b(k,187) - lu(k,1745) * b(k,236) - b(k,235) = b(k,235) * lu(k,1729) - b(k,234) = b(k,234) - lu(k,1728) * b(k,235) - b(k,232) = b(k,232) - lu(k,1727) * b(k,235) - b(k,230) = b(k,230) - lu(k,1726) * b(k,235) - b(k,229) = b(k,229) - lu(k,1725) * b(k,235) - b(k,228) = b(k,228) - lu(k,1724) * b(k,235) - b(k,225) = b(k,225) - lu(k,1723) * b(k,235) - b(k,223) = b(k,223) - lu(k,1722) * b(k,235) - b(k,222) = b(k,222) - lu(k,1721) * b(k,235) - b(k,218) = b(k,218) - lu(k,1720) * b(k,235) - b(k,214) = b(k,214) - lu(k,1719) * b(k,235) - b(k,209) = b(k,209) - lu(k,1718) * b(k,235) - b(k,206) = b(k,206) - lu(k,1717) * b(k,235) - b(k,198) = b(k,198) - lu(k,1716) * b(k,235) - b(k,174) = b(k,174) - lu(k,1715) * b(k,235) - b(k,157) = b(k,157) - lu(k,1714) * b(k,235) - b(k,156) = b(k,156) - lu(k,1713) * b(k,235) - b(k,120) = b(k,120) - lu(k,1712) * b(k,235) - b(k,74) = b(k,74) - lu(k,1711) * b(k,235) - b(k,73) = b(k,73) - lu(k,1710) * b(k,235) - b(k,234) = b(k,234) * lu(k,1700) - b(k,230) = b(k,230) - lu(k,1699) * b(k,234) - b(k,228) = b(k,228) - lu(k,1698) * b(k,234) - b(k,223) = b(k,223) - lu(k,1697) * b(k,234) - b(k,218) = b(k,218) - lu(k,1696) * b(k,234) - b(k,214) = b(k,214) - lu(k,1695) * b(k,234) - b(k,233) = b(k,233) * lu(k,1685) - b(k,223) = b(k,223) - lu(k,1684) * b(k,233) - b(k,180) = b(k,180) - lu(k,1683) * b(k,233) - b(k,232) = b(k,232) * lu(k,1667) - b(k,229) = b(k,229) - lu(k,1666) * b(k,232) - b(k,228) = b(k,228) - lu(k,1665) * b(k,232) - b(k,223) = b(k,223) - lu(k,1664) * b(k,232) - b(k,218) = b(k,218) - lu(k,1663) * b(k,232) - b(k,212) = b(k,212) - lu(k,1662) * b(k,232) - b(k,209) = b(k,209) - lu(k,1661) * b(k,232) - b(k,205) = b(k,205) - lu(k,1660) * b(k,232) - b(k,198) = b(k,198) - lu(k,1659) * b(k,232) - b(k,158) = b(k,158) - lu(k,1658) * b(k,232) - b(k,156) = b(k,156) - lu(k,1657) * b(k,232) - b(k,132) = b(k,132) - lu(k,1656) * b(k,232) - b(k,131) = b(k,131) - lu(k,1655) * b(k,232) - b(k,113) = b(k,113) - lu(k,1654) * b(k,232) - b(k,73) = b(k,73) - lu(k,1653) * b(k,232) - b(k,231) = b(k,231) * lu(k,1645) - b(k,223) = b(k,223) - lu(k,1644) * b(k,231) - b(k,230) = b(k,230) * lu(k,1635) - b(k,229) = b(k,229) - lu(k,1634) * b(k,230) - b(k,228) = b(k,228) - lu(k,1633) * b(k,230) - b(k,223) = b(k,223) - lu(k,1632) * b(k,230) - b(k,218) = b(k,218) - lu(k,1631) * b(k,230) - b(k,210) = b(k,210) - lu(k,1630) * b(k,230) - b(k,205) = b(k,205) - lu(k,1629) * b(k,230) - b(k,193) = b(k,193) - lu(k,1628) * b(k,230) - b(k,229) = b(k,229) * lu(k,1620) - b(k,228) = b(k,228) - lu(k,1619) * b(k,229) - b(k,223) = b(k,223) - lu(k,1618) * b(k,229) - b(k,207) = b(k,207) - lu(k,1617) * b(k,229) - b(k,228) = b(k,228) * lu(k,1611) - b(k,227) = b(k,227) * lu(k,1603) - b(k,217) = b(k,217) - lu(k,1602) * b(k,227) - b(k,213) = b(k,213) - lu(k,1601) * b(k,227) - b(k,190) = b(k,190) - lu(k,1600) * b(k,227) - b(k,164) = b(k,164) - lu(k,1599) * b(k,227) - b(k,147) = b(k,147) - lu(k,1598) * b(k,227) - b(k,226) = b(k,226) * lu(k,1590) - b(k,217) = b(k,217) - lu(k,1589) * b(k,226) - b(k,190) = b(k,190) - lu(k,1588) * b(k,226) - b(k,164) = b(k,164) - lu(k,1587) * b(k,226) - b(k,146) = b(k,146) - lu(k,1586) * b(k,226) - b(k,225) = b(k,225) * lu(k,1571) - b(k,223) = b(k,223) - lu(k,1570) * b(k,225) - b(k,218) = b(k,218) - lu(k,1569) * b(k,225) - b(k,209) = b(k,209) - lu(k,1568) * b(k,225) - b(k,205) = b(k,205) - lu(k,1567) * b(k,225) - b(k,156) = b(k,156) - lu(k,1566) * b(k,225) - b(k,74) = b(k,74) - lu(k,1565) * b(k,225) - b(k,224) = b(k,224) * lu(k,1550) - b(k,223) = b(k,223) - lu(k,1549) * b(k,224) - b(k,218) = b(k,218) - lu(k,1548) * b(k,224) - b(k,210) = b(k,210) - lu(k,1547) * b(k,224) - b(k,209) = b(k,209) - lu(k,1546) * b(k,224) - b(k,156) = b(k,156) - lu(k,1545) * b(k,224) - b(k,72) = b(k,72) - lu(k,1544) * b(k,224) - b(k,223) = b(k,223) * lu(k,1540) - b(k,222) = b(k,222) * lu(k,1529) - b(k,218) = b(k,218) - lu(k,1528) * b(k,222) - b(k,193) = b(k,193) - lu(k,1527) * b(k,222) - b(k,178) = b(k,178) - lu(k,1526) * b(k,222) - b(k,221) = b(k,221) * lu(k,1513) - b(k,191) = b(k,191) - lu(k,1512) * b(k,221) - b(k,117) = b(k,117) - lu(k,1511) * b(k,221) - b(k,88) = b(k,88) - lu(k,1510) * b(k,221) - b(k,220) = b(k,220) * lu(k,1497) - b(k,128) = b(k,128) - lu(k,1496) * b(k,220) - b(k,119) = b(k,119) - lu(k,1495) * b(k,220) - b(k,108) = b(k,108) - lu(k,1494) * b(k,220) - b(k,219) = b(k,219) * lu(k,1480) - b(k,218) = b(k,218) - lu(k,1479) * b(k,219) - b(k,207) = b(k,207) - lu(k,1478) * b(k,219) - b(k,206) = b(k,206) - lu(k,1477) * b(k,219) - b(k,201) = b(k,201) - lu(k,1476) * b(k,219) - b(k,193) = b(k,193) - lu(k,1475) * b(k,219) - b(k,178) = b(k,178) - lu(k,1474) * b(k,219) - b(k,218) = b(k,218) * lu(k,1469) - b(k,193) = b(k,193) - lu(k,1468) * b(k,218) - b(k,217) = b(k,217) * lu(k,1463) - b(k,216) = b(k,216) * lu(k,1439) - b(k,214) = b(k,214) - lu(k,1438) * b(k,216) - b(k,208) = b(k,208) - lu(k,1437) * b(k,216) - b(k,207) = b(k,207) - lu(k,1436) * b(k,216) - b(k,206) = b(k,206) - lu(k,1435) * b(k,216) - b(k,201) = b(k,201) - lu(k,1434) * b(k,216) - b(k,200) = b(k,200) - lu(k,1433) * b(k,216) - b(k,198) = b(k,198) - lu(k,1432) * b(k,216) - b(k,193) = b(k,193) - lu(k,1431) * b(k,216) - b(k,184) = b(k,184) - lu(k,1430) * b(k,216) - b(k,158) = b(k,158) - lu(k,1429) * b(k,216) - b(k,157) = b(k,157) - lu(k,1428) * b(k,216) - b(k,149) = b(k,149) - lu(k,1427) * b(k,216) - b(k,215) = b(k,215) * lu(k,1416) - b(k,167) = b(k,167) - lu(k,1415) * b(k,215) - b(k,68) = b(k,68) - lu(k,1414) * b(k,215) - b(k,214) = b(k,214) * lu(k,1404) - b(k,193) = b(k,193) - lu(k,1403) * b(k,214) - b(k,143) = b(k,143) - lu(k,1402) * b(k,214) - b(k,213) = b(k,213) * lu(k,1396) - b(k,212) = b(k,212) * lu(k,1383) - b(k,205) = b(k,205) - lu(k,1382) * b(k,212) - b(k,211) = b(k,211) * lu(k,1370) - b(k,210) = b(k,210) - lu(k,1369) * b(k,211) - b(k,209) = b(k,209) - lu(k,1368) * b(k,211) - b(k,210) = b(k,210) * lu(k,1360) - b(k,209) = b(k,209) * lu(k,1356) - b(k,208) = b(k,208) * lu(k,1349) - b(k,207) = b(k,207) * lu(k,1343) - b(k,206) = b(k,206) * lu(k,1336) - b(k,205) = b(k,205) * lu(k,1329) - b(k,204) = b(k,204) * lu(k,1315) - b(k,201) = b(k,201) - lu(k,1314) * b(k,204) - b(k,203) = b(k,203) * lu(k,1305) - b(k,202) = b(k,202) * lu(k,1285) - b(k,187) = b(k,187) - lu(k,1284) * b(k,202) - b(k,186) = b(k,186) - lu(k,1283) * b(k,202) - b(k,74) = b(k,74) - lu(k,1282) * b(k,202) - b(k,73) = b(k,73) - lu(k,1281) * b(k,202) - b(k,72) = b(k,72) - lu(k,1280) * b(k,202) - b(k,71) = b(k,71) - lu(k,1279) * b(k,202) - b(k,40) = b(k,40) - lu(k,1278) * b(k,202) - b(k,33) = b(k,33) - lu(k,1277) * b(k,202) - b(k,32) = b(k,32) - lu(k,1276) * b(k,202) + b(k,293) = b(k,293) * lu(k,2663) + b(k,282) = b(k,282) - lu(k,2662) * b(k,293) + b(k,264) = b(k,264) - lu(k,2661) * b(k,293) + b(k,253) = b(k,253) - lu(k,2660) * b(k,293) + b(k,245) = b(k,245) - lu(k,2659) * b(k,293) + b(k,242) = b(k,242) - lu(k,2658) * b(k,293) + b(k,235) = b(k,235) - lu(k,2657) * b(k,293) + b(k,224) = b(k,224) - lu(k,2656) * b(k,293) + b(k,211) = b(k,211) - lu(k,2655) * b(k,293) + b(k,190) = b(k,190) - lu(k,2654) * b(k,293) + b(k,172) = b(k,172) - lu(k,2653) * b(k,293) + b(k,292) = b(k,292) * lu(k,2639) + b(k,291) = b(k,291) - lu(k,2638) * b(k,292) + b(k,290) = b(k,290) - lu(k,2637) * b(k,292) + b(k,289) = b(k,289) - lu(k,2636) * b(k,292) + b(k,277) = b(k,277) - lu(k,2635) * b(k,292) + b(k,274) = b(k,274) - lu(k,2634) * b(k,292) + b(k,249) = b(k,249) - lu(k,2633) * b(k,292) + b(k,217) = b(k,217) - lu(k,2632) * b(k,292) + b(k,207) = b(k,207) - lu(k,2631) * b(k,292) + b(k,154) = b(k,154) - lu(k,2630) * b(k,292) + b(k,137) = b(k,137) - lu(k,2629) * b(k,292) + b(k,125) = b(k,125) - lu(k,2628) * b(k,292) + b(k,102) = b(k,102) - lu(k,2627) * b(k,292) + b(k,91) = b(k,91) - lu(k,2626) * b(k,292) + b(k,90) = b(k,90) - lu(k,2625) * b(k,292) + b(k,89) = b(k,89) - lu(k,2624) * b(k,292) + b(k,88) = b(k,88) - lu(k,2623) * b(k,292) + b(k,78) = b(k,78) - lu(k,2622) * b(k,292) + b(k,77) = b(k,77) - lu(k,2621) * b(k,292) + b(k,72) = b(k,72) - lu(k,2620) * b(k,292) + b(k,71) = b(k,71) - lu(k,2619) * b(k,292) + b(k,70) = b(k,70) - lu(k,2618) * b(k,292) + b(k,69) = b(k,69) - lu(k,2617) * b(k,292) + b(k,64) = b(k,64) - lu(k,2616) * b(k,292) + b(k,63) = b(k,63) - lu(k,2615) * b(k,292) + b(k,62) = b(k,62) - lu(k,2614) * b(k,292) + b(k,60) = b(k,60) - lu(k,2613) * b(k,292) + b(k,58) = b(k,58) - lu(k,2612) * b(k,292) + b(k,291) = b(k,291) * lu(k,2597) + b(k,290) = b(k,290) - lu(k,2596) * b(k,291) + b(k,289) = b(k,289) - lu(k,2595) * b(k,291) + b(k,274) = b(k,274) - lu(k,2594) * b(k,291) + b(k,244) = b(k,244) - lu(k,2593) * b(k,291) + b(k,221) = b(k,221) - lu(k,2592) * b(k,291) + b(k,214) = b(k,214) - lu(k,2591) * b(k,291) + b(k,205) = b(k,205) - lu(k,2590) * b(k,291) + b(k,109) = b(k,109) - lu(k,2589) * b(k,291) + b(k,86) = b(k,86) - lu(k,2588) * b(k,291) + b(k,73) = b(k,73) - lu(k,2587) * b(k,291) + b(k,56) = b(k,56) - lu(k,2586) * b(k,291) + b(k,290) = b(k,290) * lu(k,2573) + b(k,277) = b(k,277) - lu(k,2572) * b(k,290) + b(k,249) = b(k,249) - lu(k,2571) * b(k,290) + b(k,289) = b(k,289) * lu(k,2555) + b(k,274) = b(k,274) - lu(k,2554) * b(k,289) + b(k,244) = b(k,244) - lu(k,2553) * b(k,289) + b(k,214) = b(k,214) - lu(k,2552) * b(k,289) + b(k,193) = b(k,193) - lu(k,2551) * b(k,289) + b(k,146) = b(k,146) - lu(k,2550) * b(k,289) + b(k,109) = b(k,109) - lu(k,2549) * b(k,289) + b(k,86) = b(k,86) - lu(k,2548) * b(k,289) + b(k,288) = b(k,288) * lu(k,2530) + b(k,282) = b(k,282) - lu(k,2529) * b(k,288) + b(k,264) = b(k,264) - lu(k,2528) * b(k,288) + b(k,253) = b(k,253) - lu(k,2527) * b(k,288) + b(k,245) = b(k,245) - lu(k,2526) * b(k,288) + b(k,242) = b(k,242) - lu(k,2525) * b(k,288) + b(k,240) = b(k,240) - lu(k,2524) * b(k,288) + b(k,236) = b(k,236) - lu(k,2523) * b(k,288) + b(k,213) = b(k,213) - lu(k,2522) * b(k,288) + b(k,206) = b(k,206) - lu(k,2521) * b(k,288) + b(k,201) = b(k,201) - lu(k,2520) * b(k,288) + b(k,192) = b(k,192) - lu(k,2519) * b(k,288) + b(k,287) = b(k,287) * lu(k,2499) + b(k,282) = b(k,282) - lu(k,2498) * b(k,287) + b(k,264) = b(k,264) - lu(k,2497) * b(k,287) + b(k,251) = b(k,251) - lu(k,2496) * b(k,287) + b(k,250) = b(k,250) - lu(k,2495) * b(k,287) + b(k,245) = b(k,245) - lu(k,2494) * b(k,287) + b(k,242) = b(k,242) - lu(k,2493) * b(k,287) + b(k,240) = b(k,240) - lu(k,2492) * b(k,287) + b(k,236) = b(k,236) - lu(k,2491) * b(k,287) + b(k,213) = b(k,213) - lu(k,2490) * b(k,287) + b(k,212) = b(k,212) - lu(k,2489) * b(k,287) + b(k,206) = b(k,206) - lu(k,2488) * b(k,287) + b(k,195) = b(k,195) - lu(k,2487) * b(k,287) + b(k,170) = b(k,170) - lu(k,2486) * b(k,287) + b(k,157) = b(k,157) - lu(k,2485) * b(k,287) + b(k,286) = b(k,286) * lu(k,2466) + b(k,285) = b(k,285) - lu(k,2465) * b(k,286) + b(k,282) = b(k,282) - lu(k,2464) * b(k,286) + b(k,278) = b(k,278) - lu(k,2463) * b(k,286) + b(k,264) = b(k,264) - lu(k,2462) * b(k,286) + b(k,253) = b(k,253) - lu(k,2461) * b(k,286) + b(k,251) = b(k,251) - lu(k,2460) * b(k,286) + b(k,250) = b(k,250) - lu(k,2459) * b(k,286) + b(k,245) = b(k,245) - lu(k,2458) * b(k,286) + b(k,242) = b(k,242) - lu(k,2457) * b(k,286) + b(k,240) = b(k,240) - lu(k,2456) * b(k,286) + b(k,236) = b(k,236) - lu(k,2455) * b(k,286) + b(k,201) = b(k,201) - lu(k,2454) * b(k,286) + b(k,190) = b(k,190) - lu(k,2453) * b(k,286) + b(k,158) = b(k,158) - lu(k,2452) * b(k,286) + b(k,285) = b(k,285) * lu(k,2437) + b(k,282) = b(k,282) - lu(k,2436) * b(k,285) + b(k,264) = b(k,264) - lu(k,2435) * b(k,285) + b(k,253) = b(k,253) - lu(k,2434) * b(k,285) + b(k,242) = b(k,242) - lu(k,2433) * b(k,285) + b(k,190) = b(k,190) - lu(k,2432) * b(k,285) + b(k,187) = b(k,187) - lu(k,2431) * b(k,285) + b(k,284) = b(k,284) * lu(k,2411) + b(k,282) = b(k,282) - lu(k,2410) * b(k,284) + b(k,278) = b(k,278) - lu(k,2409) * b(k,284) + b(k,264) = b(k,264) - lu(k,2408) * b(k,284) + b(k,253) = b(k,253) - lu(k,2407) * b(k,284) + b(k,251) = b(k,251) - lu(k,2406) * b(k,284) + b(k,250) = b(k,250) - lu(k,2405) * b(k,284) + b(k,245) = b(k,245) - lu(k,2404) * b(k,284) + b(k,242) = b(k,242) - lu(k,2403) * b(k,284) + b(k,240) = b(k,240) - lu(k,2402) * b(k,284) + b(k,201) = b(k,201) - lu(k,2401) * b(k,284) + b(k,158) = b(k,158) - lu(k,2400) * b(k,284) + b(k,283) = b(k,283) * lu(k,2381) + b(k,282) = b(k,282) - lu(k,2380) * b(k,283) + b(k,264) = b(k,264) - lu(k,2379) * b(k,283) + b(k,251) = b(k,251) - lu(k,2378) * b(k,283) + b(k,250) = b(k,250) - lu(k,2377) * b(k,283) + b(k,245) = b(k,245) - lu(k,2376) * b(k,283) + b(k,236) = b(k,236) - lu(k,2375) * b(k,283) + b(k,282) = b(k,282) * lu(k,2366) + b(k,264) = b(k,264) - lu(k,2365) * b(k,282) + b(k,281) = b(k,281) * lu(k,2349) + b(k,264) = b(k,264) - lu(k,2348) * b(k,281) + b(k,251) = b(k,251) - lu(k,2347) * b(k,281) + b(k,250) = b(k,250) - lu(k,2346) * b(k,281) + b(k,245) = b(k,245) - lu(k,2345) * b(k,281) + b(k,235) = b(k,235) - lu(k,2344) * b(k,281) + b(k,224) = b(k,224) - lu(k,2343) * b(k,281) + b(k,211) = b(k,211) - lu(k,2342) * b(k,281) + b(k,188) = b(k,188) - lu(k,2341) * b(k,281) + b(k,280) = b(k,280) * lu(k,2322) + b(k,264) = b(k,264) - lu(k,2321) * b(k,280) + b(k,245) = b(k,245) - lu(k,2320) * b(k,280) + b(k,242) = b(k,242) - lu(k,2319) * b(k,280) + b(k,236) = b(k,236) - lu(k,2318) * b(k,280) + b(k,194) = b(k,194) - lu(k,2317) * b(k,280) + b(k,131) = b(k,131) - lu(k,2316) * b(k,280) + b(k,42) = b(k,42) - lu(k,2315) * b(k,280) + b(k,279) = b(k,279) * lu(k,2296) + b(k,264) = b(k,264) - lu(k,2295) * b(k,279) + b(k,245) = b(k,245) - lu(k,2294) * b(k,279) + b(k,242) = b(k,242) - lu(k,2293) * b(k,279) + b(k,240) = b(k,240) - lu(k,2292) * b(k,279) + b(k,236) = b(k,236) - lu(k,2291) * b(k,279) + b(k,213) = b(k,213) - lu(k,2290) * b(k,279) + b(k,206) = b(k,206) - lu(k,2289) * b(k,279) + b(k,278) = b(k,278) * lu(k,2277) + b(k,264) = b(k,264) - lu(k,2276) * b(k,278) + b(k,263) = b(k,263) - lu(k,2275) * b(k,278) + b(k,256) = b(k,256) - lu(k,2274) * b(k,278) + b(k,236) = b(k,236) - lu(k,2273) * b(k,278) + b(k,222) = b(k,222) - lu(k,2272) * b(k,278) + b(k,277) = b(k,277) * lu(k,2259) + b(k,264) = b(k,264) - lu(k,2258) * b(k,277) + b(k,249) = b(k,249) - lu(k,2257) * b(k,277) + b(k,245) = b(k,245) - lu(k,2256) * b(k,277) + b(k,217) = b(k,217) - lu(k,2255) * b(k,277) + b(k,106) = b(k,106) - lu(k,2254) * b(k,277) + b(k,276) = b(k,276) * lu(k,2235) + b(k,264) = b(k,264) - lu(k,2234) * b(k,276) + b(k,253) = b(k,253) - lu(k,2233) * b(k,276) + b(k,245) = b(k,245) - lu(k,2232) * b(k,276) + b(k,240) = b(k,240) - lu(k,2231) * b(k,276) + b(k,149) = b(k,149) - lu(k,2230) * b(k,276) + b(k,275) = b(k,275) * lu(k,2213) + b(k,264) = b(k,264) - lu(k,2212) * b(k,275) + b(k,245) = b(k,245) - lu(k,2211) * b(k,275) + b(k,236) = b(k,236) - lu(k,2210) * b(k,275) + b(k,42) = b(k,42) - lu(k,2209) * b(k,275) + b(k,274) = b(k,274) * lu(k,2199) + b(k,264) = b(k,264) - lu(k,2198) * b(k,274) + b(k,207) = b(k,207) - lu(k,2197) * b(k,274) + b(k,273) = b(k,273) * lu(k,2180) + b(k,272) = b(k,272) - lu(k,2179) * b(k,273) + b(k,271) = b(k,271) - lu(k,2178) * b(k,273) + b(k,270) = b(k,270) - lu(k,2177) * b(k,273) + b(k,269) = b(k,269) - lu(k,2176) * b(k,273) + b(k,268) = b(k,268) - lu(k,2175) * b(k,273) + b(k,265) = b(k,265) - lu(k,2174) * b(k,273) + b(k,264) = b(k,264) - lu(k,2173) * b(k,273) + b(k,263) = b(k,263) - lu(k,2172) * b(k,273) + b(k,258) = b(k,258) - lu(k,2171) * b(k,273) + b(k,256) = b(k,256) - lu(k,2170) * b(k,273) + b(k,254) = b(k,254) - lu(k,2169) * b(k,273) + b(k,252) = b(k,252) - lu(k,2168) * b(k,273) + b(k,248) = b(k,248) - lu(k,2167) * b(k,273) + b(k,247) = b(k,247) - lu(k,2166) * b(k,273) + b(k,245) = b(k,245) - lu(k,2165) * b(k,273) + b(k,243) = b(k,243) - lu(k,2164) * b(k,273) + b(k,236) = b(k,236) - lu(k,2163) * b(k,273) + b(k,234) = b(k,234) - lu(k,2162) * b(k,273) + b(k,232) = b(k,232) - lu(k,2161) * b(k,273) + b(k,230) = b(k,230) - lu(k,2160) * b(k,273) + b(k,229) = b(k,229) - lu(k,2159) * b(k,273) + b(k,224) = b(k,224) - lu(k,2158) * b(k,273) + b(k,220) = b(k,220) - lu(k,2157) * b(k,273) + b(k,216) = b(k,216) - lu(k,2156) * b(k,273) + b(k,209) = b(k,209) - lu(k,2155) * b(k,273) + b(k,167) = b(k,167) - lu(k,2154) * b(k,273) end do end subroutine lu_slv16 subroutine lu_slv17( avec_len, lu, b ) @@ -3843,207 +3797,209 @@ subroutine lu_slv17( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,201) = b(k,201) * lu(k,1270) - b(k,200) = b(k,200) * lu(k,1255) - b(k,193) = b(k,193) - lu(k,1254) * b(k,200) - b(k,158) = b(k,158) - lu(k,1253) * b(k,200) - b(k,149) = b(k,149) - lu(k,1252) * b(k,200) - b(k,199) = b(k,199) * lu(k,1243) - b(k,91) = b(k,91) - lu(k,1242) * b(k,199) - b(k,76) = b(k,76) - lu(k,1241) * b(k,199) - b(k,198) = b(k,198) * lu(k,1236) - b(k,197) = b(k,197) * lu(k,1224) - b(k,98) = b(k,98) - lu(k,1223) * b(k,197) - b(k,196) = b(k,196) * lu(k,1213) - b(k,182) = b(k,182) - lu(k,1212) * b(k,196) - b(k,55) = b(k,55) - lu(k,1211) * b(k,196) - b(k,195) = b(k,195) * lu(k,1197) - b(k,187) = b(k,187) - lu(k,1196) * b(k,195) - b(k,160) = b(k,160) - lu(k,1195) * b(k,195) - b(k,128) = b(k,128) - lu(k,1194) * b(k,195) - b(k,194) = b(k,194) * lu(k,1180) - b(k,193) = b(k,193) * lu(k,1176) - b(k,29) = b(k,29) - lu(k,1175) * b(k,193) - b(k,192) = b(k,192) * lu(k,1167) - b(k,191) = b(k,191) * lu(k,1161) - b(k,75) = b(k,75) - lu(k,1160) * b(k,191) - b(k,190) = b(k,190) * lu(k,1154) - b(k,189) = b(k,189) * lu(k,1144) - b(k,166) = b(k,166) - lu(k,1143) * b(k,189) - b(k,164) = b(k,164) - lu(k,1142) * b(k,189) - b(k,188) = b(k,188) * lu(k,1132) - b(k,142) = b(k,142) - lu(k,1131) * b(k,188) - b(k,141) = b(k,141) - lu(k,1130) * b(k,188) - b(k,140) = b(k,140) - lu(k,1129) * b(k,188) - b(k,116) = b(k,116) - lu(k,1128) * b(k,188) - b(k,187) = b(k,187) * lu(k,1124) - b(k,186) = b(k,186) * lu(k,1118) - b(k,185) = b(k,185) * lu(k,1102) - b(k,126) = b(k,126) - lu(k,1101) * b(k,185) - b(k,36) = b(k,36) - lu(k,1100) * b(k,185) - b(k,33) = b(k,33) - lu(k,1099) * b(k,185) - b(k,32) = b(k,32) - lu(k,1098) * b(k,185) - b(k,31) = b(k,31) - lu(k,1097) * b(k,185) - b(k,30) = b(k,30) - lu(k,1096) * b(k,185) - b(k,29) = b(k,29) - lu(k,1095) * b(k,185) - b(k,184) = b(k,184) * lu(k,1083) - b(k,183) = b(k,183) * lu(k,1071) - b(k,182) = b(k,182) * lu(k,1064) - b(k,55) = b(k,55) - lu(k,1063) * b(k,182) - b(k,181) = b(k,181) * lu(k,1048) - b(k,111) = b(k,111) - lu(k,1047) * b(k,181) - b(k,180) = b(k,180) * lu(k,1039) - b(k,179) = b(k,179) * lu(k,1032) - b(k,178) = b(k,178) * lu(k,1021) - b(k,177) = b(k,177) * lu(k,1010) - b(k,176) = b(k,176) * lu(k,999) - b(k,175) = b(k,175) * lu(k,995) - b(k,174) = b(k,174) * lu(k,985) - b(k,173) = b(k,173) * lu(k,975) - b(k,99) = b(k,99) - lu(k,974) * b(k,173) - b(k,172) = b(k,172) * lu(k,961) - b(k,126) = b(k,126) - lu(k,960) * b(k,172) - b(k,43) = b(k,43) - lu(k,959) * b(k,172) - b(k,33) = b(k,33) - lu(k,958) * b(k,172) - b(k,32) = b(k,32) - lu(k,957) * b(k,172) - b(k,31) = b(k,31) - lu(k,956) * b(k,172) - b(k,30) = b(k,30) - lu(k,955) * b(k,172) - b(k,29) = b(k,29) - lu(k,954) * b(k,172) - b(k,171) = b(k,171) * lu(k,941) - b(k,61) = b(k,61) - lu(k,940) * b(k,171) - b(k,39) = b(k,39) - lu(k,939) * b(k,171) - b(k,33) = b(k,33) - lu(k,938) * b(k,171) - b(k,32) = b(k,32) - lu(k,937) * b(k,171) - b(k,31) = b(k,31) - lu(k,936) * b(k,171) - b(k,30) = b(k,30) - lu(k,935) * b(k,171) - b(k,29) = b(k,29) - lu(k,934) * b(k,171) - b(k,170) = b(k,170) * lu(k,926) - b(k,164) = b(k,164) - lu(k,925) * b(k,170) - b(k,169) = b(k,169) * lu(k,917) - b(k,164) = b(k,164) - lu(k,916) * b(k,169) - b(k,135) = b(k,135) - lu(k,915) * b(k,169) - b(k,92) = b(k,92) - lu(k,914) * b(k,169) - b(k,168) = b(k,168) * lu(k,906) - b(k,69) = b(k,69) - lu(k,905) * b(k,168) - b(k,167) = b(k,167) * lu(k,897) - b(k,68) = b(k,68) - lu(k,896) * b(k,167) - b(k,166) = b(k,166) * lu(k,888) - b(k,165) = b(k,165) * lu(k,876) - b(k,60) = b(k,60) - lu(k,875) * b(k,165) - b(k,164) = b(k,164) * lu(k,871) - b(k,163) = b(k,163) * lu(k,859) - b(k,126) = b(k,126) - lu(k,858) * b(k,163) - b(k,37) = b(k,37) - lu(k,857) * b(k,163) - b(k,33) = b(k,33) - lu(k,856) * b(k,163) - b(k,32) = b(k,32) - lu(k,855) * b(k,163) - b(k,31) = b(k,31) - lu(k,854) * b(k,163) - b(k,30) = b(k,30) - lu(k,853) * b(k,163) - b(k,29) = b(k,29) - lu(k,852) * b(k,163) - b(k,162) = b(k,162) * lu(k,843) - b(k,161) = b(k,161) * lu(k,834) - b(k,135) = b(k,135) - lu(k,833) * b(k,161) - b(k,127) = b(k,127) - lu(k,832) * b(k,161) - b(k,92) = b(k,92) - lu(k,831) * b(k,161) - b(k,160) = b(k,160) * lu(k,822) - b(k,121) = b(k,121) - lu(k,821) * b(k,160) - b(k,159) = b(k,159) * lu(k,812) - b(k,158) = b(k,158) * lu(k,807) - b(k,157) = b(k,157) * lu(k,802) - b(k,156) = b(k,156) * lu(k,797) - b(k,155) = b(k,155) * lu(k,789) - b(k,154) = b(k,154) * lu(k,778) - b(k,152) = b(k,152) - lu(k,777) * b(k,154) - b(k,150) = b(k,150) - lu(k,776) * b(k,154) - b(k,106) = b(k,106) - lu(k,775) * b(k,154) - b(k,97) = b(k,97) - lu(k,774) * b(k,154) - b(k,87) = b(k,87) - lu(k,773) * b(k,154) - b(k,83) = b(k,83) - lu(k,772) * b(k,154) - b(k,153) = b(k,153) * lu(k,762) - b(k,152) = b(k,152) - lu(k,761) * b(k,153) - b(k,138) = b(k,138) - lu(k,760) * b(k,153) - b(k,106) = b(k,106) - lu(k,759) * b(k,153) - b(k,97) = b(k,97) - lu(k,758) * b(k,153) - b(k,83) = b(k,83) - lu(k,757) * b(k,153) - b(k,152) = b(k,152) * lu(k,751) - b(k,151) = b(k,151) * lu(k,744) - b(k,80) = b(k,80) - lu(k,743) * b(k,151) - b(k,51) = b(k,51) - lu(k,742) * b(k,151) - b(k,150) = b(k,150) * lu(k,731) - b(k,106) = b(k,106) - lu(k,730) * b(k,150) - b(k,97) = b(k,97) - lu(k,729) * b(k,150) - b(k,87) = b(k,87) - lu(k,728) * b(k,150) - b(k,83) = b(k,83) - lu(k,727) * b(k,150) - b(k,149) = b(k,149) * lu(k,721) - b(k,148) = b(k,148) * lu(k,710) - b(k,44) = b(k,44) - lu(k,709) * b(k,148) - b(k,33) = b(k,33) - lu(k,708) * b(k,148) - b(k,32) = b(k,32) - lu(k,707) * b(k,148) - b(k,31) = b(k,31) - lu(k,706) * b(k,148) - b(k,30) = b(k,30) - lu(k,705) * b(k,148) - b(k,29) = b(k,29) - lu(k,704) * b(k,148) - b(k,147) = b(k,147) * lu(k,696) - b(k,146) = b(k,146) * lu(k,688) - b(k,145) = b(k,145) * lu(k,680) - b(k,127) = b(k,127) - lu(k,679) * b(k,145) - b(k,144) = b(k,144) * lu(k,671) - b(k,143) = b(k,143) * lu(k,663) - b(k,142) = b(k,142) * lu(k,656) - b(k,86) = b(k,86) - lu(k,655) * b(k,142) - b(k,141) = b(k,141) * lu(k,645) - b(k,116) = b(k,116) - lu(k,644) * b(k,141) - b(k,140) = b(k,140) * lu(k,634) - b(k,116) = b(k,116) - lu(k,633) * b(k,140) - b(k,139) = b(k,139) * lu(k,623) - b(k,138) = b(k,138) * lu(k,613) - b(k,106) = b(k,106) - lu(k,612) * b(k,138) - b(k,97) = b(k,97) - lu(k,611) * b(k,138) - b(k,83) = b(k,83) - lu(k,610) * b(k,138) - b(k,137) = b(k,137) * lu(k,604) - b(k,110) = b(k,110) - lu(k,603) * b(k,137) - b(k,77) = b(k,77) - lu(k,602) * b(k,137) - b(k,136) = b(k,136) * lu(k,593) - b(k,135) = b(k,135) * lu(k,589) - b(k,134) = b(k,134) * lu(k,582) - b(k,133) = b(k,133) * lu(k,573) - b(k,132) = b(k,132) * lu(k,566) - b(k,131) = b(k,131) * lu(k,554) - b(k,130) = b(k,130) * lu(k,542) - b(k,129) = b(k,129) * lu(k,534) - b(k,128) = b(k,128) * lu(k,530) - b(k,127) = b(k,127) * lu(k,526) - b(k,126) = b(k,126) * lu(k,522) - b(k,125) = b(k,125) * lu(k,514) - b(k,124) = b(k,124) * lu(k,506) - b(k,123) = b(k,123) * lu(k,498) - b(k,122) = b(k,122) * lu(k,490) - b(k,121) = b(k,121) * lu(k,482) - b(k,120) = b(k,120) * lu(k,474) - b(k,119) = b(k,119) * lu(k,468) - b(k,118) = b(k,118) * lu(k,462) - b(k,54) = b(k,54) - lu(k,461) * b(k,118) - b(k,117) = b(k,117) * lu(k,455) - b(k,116) = b(k,116) * lu(k,450) - b(k,115) = b(k,115) * lu(k,443) - b(k,101) = b(k,101) - lu(k,442) * b(k,115) - b(k,114) = b(k,114) * lu(k,435) - b(k,106) = b(k,106) - lu(k,434) * b(k,114) - b(k,96) = b(k,96) - lu(k,433) * b(k,114) - b(k,113) = b(k,113) * lu(k,426) - b(k,112) = b(k,112) * lu(k,419) - b(k,111) = b(k,111) * lu(k,409) - b(k,110) = b(k,110) * lu(k,405) - b(k,109) = b(k,109) * lu(k,398) - b(k,108) = b(k,108) * lu(k,391) - b(k,107) = b(k,107) * lu(k,386) - b(k,106) = b(k,106) * lu(k,383) - b(k,105) = b(k,105) * lu(k,377) - b(k,89) = b(k,89) - lu(k,376) * b(k,105) - b(k,104) = b(k,104) * lu(k,370) - b(k,103) = b(k,103) * lu(k,364) - b(k,102) = b(k,102) * lu(k,358) - b(k,90) = b(k,90) - lu(k,357) * b(k,102) - b(k,70) = b(k,70) - lu(k,356) * b(k,102) - b(k,101) = b(k,101) * lu(k,350) + b(k,272) = b(k,272) * lu(k,2140) + b(k,265) = b(k,265) - lu(k,2139) * b(k,272) + b(k,264) = b(k,264) - lu(k,2138) * b(k,272) + b(k,263) = b(k,263) - lu(k,2137) * b(k,272) + b(k,261) = b(k,261) - lu(k,2136) * b(k,272) + b(k,258) = b(k,258) - lu(k,2135) * b(k,272) + b(k,256) = b(k,256) - lu(k,2134) * b(k,272) + b(k,254) = b(k,254) - lu(k,2133) * b(k,272) + b(k,252) = b(k,252) - lu(k,2132) * b(k,272) + b(k,247) = b(k,247) - lu(k,2131) * b(k,272) + b(k,245) = b(k,245) - lu(k,2130) * b(k,272) + b(k,235) = b(k,235) - lu(k,2129) * b(k,272) + b(k,234) = b(k,234) - lu(k,2128) * b(k,272) + b(k,233) = b(k,233) - lu(k,2127) * b(k,272) + b(k,230) = b(k,230) - lu(k,2126) * b(k,272) + b(k,184) = b(k,184) - lu(k,2125) * b(k,272) + b(k,271) = b(k,271) * lu(k,2110) + b(k,265) = b(k,265) - lu(k,2109) * b(k,271) + b(k,264) = b(k,264) - lu(k,2108) * b(k,271) + b(k,263) = b(k,263) - lu(k,2107) * b(k,271) + b(k,261) = b(k,261) - lu(k,2106) * b(k,271) + b(k,258) = b(k,258) - lu(k,2105) * b(k,271) + b(k,256) = b(k,256) - lu(k,2104) * b(k,271) + b(k,254) = b(k,254) - lu(k,2103) * b(k,271) + b(k,252) = b(k,252) - lu(k,2102) * b(k,271) + b(k,248) = b(k,248) - lu(k,2101) * b(k,271) + b(k,245) = b(k,245) - lu(k,2100) * b(k,271) + b(k,239) = b(k,239) - lu(k,2099) * b(k,271) + b(k,235) = b(k,235) - lu(k,2098) * b(k,271) + b(k,234) = b(k,234) - lu(k,2097) * b(k,271) + b(k,233) = b(k,233) - lu(k,2096) * b(k,271) + b(k,232) = b(k,232) - lu(k,2095) * b(k,271) + b(k,231) = b(k,231) - lu(k,2094) * b(k,271) + b(k,203) = b(k,203) - lu(k,2093) * b(k,271) + b(k,270) = b(k,270) * lu(k,2078) + b(k,265) = b(k,265) - lu(k,2077) * b(k,270) + b(k,264) = b(k,264) - lu(k,2076) * b(k,270) + b(k,263) = b(k,263) - lu(k,2075) * b(k,270) + b(k,261) = b(k,261) - lu(k,2074) * b(k,270) + b(k,258) = b(k,258) - lu(k,2073) * b(k,270) + b(k,256) = b(k,256) - lu(k,2072) * b(k,270) + b(k,254) = b(k,254) - lu(k,2071) * b(k,270) + b(k,252) = b(k,252) - lu(k,2070) * b(k,270) + b(k,248) = b(k,248) - lu(k,2069) * b(k,270) + b(k,245) = b(k,245) - lu(k,2068) * b(k,270) + b(k,239) = b(k,239) - lu(k,2067) * b(k,270) + b(k,237) = b(k,237) - lu(k,2066) * b(k,270) + b(k,235) = b(k,235) - lu(k,2065) * b(k,270) + b(k,233) = b(k,233) - lu(k,2064) * b(k,270) + b(k,232) = b(k,232) - lu(k,2063) * b(k,270) + b(k,230) = b(k,230) - lu(k,2062) * b(k,270) + b(k,204) = b(k,204) - lu(k,2061) * b(k,270) + b(k,269) = b(k,269) * lu(k,2047) + b(k,265) = b(k,265) - lu(k,2046) * b(k,269) + b(k,264) = b(k,264) - lu(k,2045) * b(k,269) + b(k,263) = b(k,263) - lu(k,2044) * b(k,269) + b(k,256) = b(k,256) - lu(k,2043) * b(k,269) + b(k,252) = b(k,252) - lu(k,2042) * b(k,269) + b(k,245) = b(k,245) - lu(k,2041) * b(k,269) + b(k,238) = b(k,238) - lu(k,2040) * b(k,269) + b(k,234) = b(k,234) - lu(k,2039) * b(k,269) + b(k,228) = b(k,228) - lu(k,2038) * b(k,269) + b(k,225) = b(k,225) - lu(k,2037) * b(k,269) + b(k,224) = b(k,224) - lu(k,2036) * b(k,269) + b(k,268) = b(k,268) * lu(k,2022) + b(k,264) = b(k,264) - lu(k,2021) * b(k,268) + b(k,263) = b(k,263) - lu(k,2020) * b(k,268) + b(k,256) = b(k,256) - lu(k,2019) * b(k,268) + b(k,254) = b(k,254) - lu(k,2018) * b(k,268) + b(k,246) = b(k,246) - lu(k,2017) * b(k,268) + b(k,245) = b(k,245) - lu(k,2016) * b(k,268) + b(k,241) = b(k,241) - lu(k,2015) * b(k,268) + b(k,224) = b(k,224) - lu(k,2014) * b(k,268) + b(k,267) = b(k,267) * lu(k,1997) + b(k,266) = b(k,266) - lu(k,1996) * b(k,267) + b(k,265) = b(k,265) - lu(k,1995) * b(k,267) + b(k,264) = b(k,264) - lu(k,1994) * b(k,267) + b(k,263) = b(k,263) - lu(k,1993) * b(k,267) + b(k,262) = b(k,262) - lu(k,1992) * b(k,267) + b(k,261) = b(k,261) - lu(k,1991) * b(k,267) + b(k,259) = b(k,259) - lu(k,1990) * b(k,267) + b(k,258) = b(k,258) - lu(k,1989) * b(k,267) + b(k,257) = b(k,257) - lu(k,1988) * b(k,267) + b(k,256) = b(k,256) - lu(k,1987) * b(k,267) + b(k,254) = b(k,254) - lu(k,1986) * b(k,267) + b(k,252) = b(k,252) - lu(k,1985) * b(k,267) + b(k,248) = b(k,248) - lu(k,1984) * b(k,267) + b(k,245) = b(k,245) - lu(k,1983) * b(k,267) + b(k,239) = b(k,239) - lu(k,1982) * b(k,267) + b(k,236) = b(k,236) - lu(k,1981) * b(k,267) + b(k,232) = b(k,232) - lu(k,1980) * b(k,267) + b(k,198) = b(k,198) - lu(k,1979) * b(k,267) + b(k,183) = b(k,183) - lu(k,1978) * b(k,267) + b(k,144) = b(k,144) - lu(k,1977) * b(k,267) + b(k,95) = b(k,95) - lu(k,1976) * b(k,267) + b(k,94) = b(k,94) - lu(k,1975) * b(k,267) + b(k,266) = b(k,266) * lu(k,1959) + b(k,265) = b(k,265) - lu(k,1958) * b(k,266) + b(k,264) = b(k,264) - lu(k,1957) * b(k,266) + b(k,263) = b(k,263) - lu(k,1956) * b(k,266) + b(k,262) = b(k,262) - lu(k,1955) * b(k,266) + b(k,261) = b(k,261) - lu(k,1954) * b(k,266) + b(k,260) = b(k,260) - lu(k,1953) * b(k,266) + b(k,258) = b(k,258) - lu(k,1952) * b(k,266) + b(k,256) = b(k,256) - lu(k,1951) * b(k,266) + b(k,255) = b(k,255) - lu(k,1950) * b(k,266) + b(k,254) = b(k,254) - lu(k,1949) * b(k,266) + b(k,252) = b(k,252) - lu(k,1948) * b(k,266) + b(k,248) = b(k,248) - lu(k,1947) * b(k,266) + b(k,245) = b(k,245) - lu(k,1946) * b(k,266) + b(k,239) = b(k,239) - lu(k,1945) * b(k,266) + b(k,232) = b(k,232) - lu(k,1944) * b(k,266) + b(k,208) = b(k,208) - lu(k,1943) * b(k,266) + b(k,183) = b(k,183) - lu(k,1942) * b(k,266) + b(k,151) = b(k,151) - lu(k,1941) * b(k,266) + b(k,93) = b(k,93) - lu(k,1940) * b(k,266) + b(k,92) = b(k,92) - lu(k,1939) * b(k,266) + b(k,265) = b(k,265) * lu(k,1929) + b(k,264) = b(k,264) - lu(k,1928) * b(k,265) + b(k,263) = b(k,263) - lu(k,1927) * b(k,265) + b(k,252) = b(k,252) - lu(k,1926) * b(k,265) + b(k,245) = b(k,245) - lu(k,1925) * b(k,265) + b(k,234) = b(k,234) - lu(k,1924) * b(k,265) + b(k,230) = b(k,230) - lu(k,1923) * b(k,265) + b(k,80) = b(k,80) - lu(k,1922) * b(k,265) + b(k,264) = b(k,264) * lu(k,1918) + b(k,245) = b(k,245) - lu(k,1917) * b(k,264) + b(k,263) = b(k,263) * lu(k,1909) + b(k,262) = b(k,262) * lu(k,1894) + b(k,261) = b(k,261) - lu(k,1893) * b(k,262) + b(k,258) = b(k,258) - lu(k,1892) * b(k,262) + b(k,256) = b(k,256) - lu(k,1891) * b(k,262) + b(k,252) = b(k,252) - lu(k,1890) * b(k,262) + b(k,245) = b(k,245) - lu(k,1889) * b(k,262) + b(k,239) = b(k,239) - lu(k,1888) * b(k,262) + b(k,237) = b(k,237) - lu(k,1887) * b(k,262) + b(k,233) = b(k,233) - lu(k,1886) * b(k,262) + b(k,231) = b(k,231) - lu(k,1885) * b(k,262) + b(k,184) = b(k,184) - lu(k,1884) * b(k,262) + b(k,169) = b(k,169) - lu(k,1883) * b(k,262) + b(k,135) = b(k,135) - lu(k,1882) * b(k,262) + b(k,133) = b(k,133) - lu(k,1881) * b(k,262) + b(k,261) = b(k,261) * lu(k,1870) + b(k,258) = b(k,258) - lu(k,1869) * b(k,261) + b(k,256) = b(k,256) - lu(k,1868) * b(k,261) + b(k,252) = b(k,252) - lu(k,1867) * b(k,261) + b(k,245) = b(k,245) - lu(k,1866) * b(k,261) + b(k,233) = b(k,233) - lu(k,1865) * b(k,261) + b(k,219) = b(k,219) - lu(k,1864) * b(k,261) + b(k,260) = b(k,260) * lu(k,1846) + b(k,256) = b(k,256) - lu(k,1845) * b(k,260) + b(k,252) = b(k,252) - lu(k,1844) * b(k,260) + b(k,245) = b(k,245) - lu(k,1843) * b(k,260) + b(k,238) = b(k,238) - lu(k,1842) * b(k,260) + b(k,237) = b(k,237) - lu(k,1841) * b(k,260) + b(k,236) = b(k,236) - lu(k,1840) * b(k,260) + b(k,224) = b(k,224) - lu(k,1839) * b(k,260) + b(k,189) = b(k,189) - lu(k,1838) * b(k,260) + b(k,184) = b(k,184) - lu(k,1837) * b(k,260) + b(k,183) = b(k,183) - lu(k,1836) * b(k,260) + b(k,153) = b(k,153) - lu(k,1835) * b(k,260) + b(k,152) = b(k,152) - lu(k,1834) * b(k,260) + b(k,133) = b(k,133) - lu(k,1833) * b(k,260) + b(k,92) = b(k,92) - lu(k,1832) * b(k,260) + b(k,259) = b(k,259) * lu(k,1815) + b(k,256) = b(k,256) - lu(k,1814) * b(k,259) + b(k,254) = b(k,254) - lu(k,1813) * b(k,259) + b(k,252) = b(k,252) - lu(k,1812) * b(k,259) + b(k,245) = b(k,245) - lu(k,1811) * b(k,259) + b(k,241) = b(k,241) - lu(k,1810) * b(k,259) + b(k,236) = b(k,236) - lu(k,1809) * b(k,259) + b(k,231) = b(k,231) - lu(k,1808) * b(k,259) + b(k,189) = b(k,189) - lu(k,1807) * b(k,259) + b(k,184) = b(k,184) - lu(k,1806) * b(k,259) + b(k,183) = b(k,183) - lu(k,1805) * b(k,259) + b(k,159) = b(k,159) - lu(k,1804) * b(k,259) + b(k,153) = b(k,153) - lu(k,1803) * b(k,259) + b(k,135) = b(k,135) - lu(k,1802) * b(k,259) + b(k,94) = b(k,94) - lu(k,1801) * b(k,259) + b(k,258) = b(k,258) * lu(k,1791) + b(k,256) = b(k,256) - lu(k,1790) * b(k,258) + b(k,254) = b(k,254) - lu(k,1789) * b(k,258) + b(k,252) = b(k,252) - lu(k,1788) * b(k,258) + b(k,245) = b(k,245) - lu(k,1787) * b(k,258) + b(k,237) = b(k,237) - lu(k,1786) * b(k,258) + b(k,233) = b(k,233) - lu(k,1785) * b(k,258) + b(k,231) = b(k,231) - lu(k,1784) * b(k,258) + b(k,257) = b(k,257) * lu(k,1769) + b(k,256) = b(k,256) - lu(k,1768) * b(k,257) + b(k,252) = b(k,252) - lu(k,1767) * b(k,257) + b(k,245) = b(k,245) - lu(k,1766) * b(k,257) + b(k,236) = b(k,236) - lu(k,1765) * b(k,257) + b(k,231) = b(k,231) - lu(k,1764) * b(k,257) + b(k,183) = b(k,183) - lu(k,1763) * b(k,257) + b(k,95) = b(k,95) - lu(k,1762) * b(k,257) + b(k,256) = b(k,256) * lu(k,1756) + b(k,255) = b(k,255) * lu(k,1740) + b(k,252) = b(k,252) - lu(k,1739) * b(k,255) + b(k,245) = b(k,245) - lu(k,1738) * b(k,255) + b(k,237) = b(k,237) - lu(k,1737) * b(k,255) + b(k,236) = b(k,236) - lu(k,1736) * b(k,255) + b(k,183) = b(k,183) - lu(k,1735) * b(k,255) + b(k,93) = b(k,93) - lu(k,1734) * b(k,255) end do end subroutine lu_slv17 subroutine lu_slv18( avec_len, lu, b ) @@ -4064,134 +4020,488 @@ subroutine lu_slv18( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,100) = b(k,100) * lu(k,344) - b(k,99) = b(k,99) * lu(k,338) - b(k,98) = b(k,98) * lu(k,332) - b(k,97) = b(k,97) * lu(k,328) - b(k,96) = b(k,96) * lu(k,322) - b(k,95) = b(k,95) * lu(k,316) - b(k,94) = b(k,94) * lu(k,308) - b(k,93) = b(k,93) * lu(k,300) - b(k,92) = b(k,92) * lu(k,296) - b(k,91) = b(k,91) * lu(k,291) - b(k,90) = b(k,90) * lu(k,286) - b(k,70) = b(k,70) - lu(k,285) * b(k,90) - b(k,89) = b(k,89) * lu(k,280) - b(k,88) = b(k,88) * lu(k,275) - b(k,87) = b(k,87) * lu(k,270) - b(k,86) = b(k,86) * lu(k,265) - b(k,85) = b(k,85) * lu(k,259) - b(k,84) = b(k,84) * lu(k,253) - b(k,83) = b(k,83) * lu(k,250) - b(k,82) = b(k,82) * lu(k,244) - b(k,81) = b(k,81) * lu(k,238) - b(k,80) = b(k,80) * lu(k,234) - b(k,79) = b(k,79) * lu(k,230) - b(k,78) = b(k,78) * lu(k,226) - b(k,77) = b(k,77) * lu(k,222) - b(k,76) = b(k,76) * lu(k,218) - b(k,75) = b(k,75) * lu(k,214) - b(k,52) = b(k,52) - lu(k,213) * b(k,75) - b(k,74) = b(k,74) * lu(k,210) - b(k,73) = b(k,73) * lu(k,207) - b(k,72) = b(k,72) * lu(k,204) - b(k,71) = b(k,71) * lu(k,201) - b(k,70) = b(k,70) * lu(k,198) - b(k,69) = b(k,69) * lu(k,195) - b(k,68) = b(k,68) * lu(k,192) - b(k,67) = b(k,67) * lu(k,187) - b(k,66) = b(k,66) * lu(k,179) - b(k,65) = b(k,65) - lu(k,178) * b(k,66) - b(k,46) = b(k,46) - lu(k,177) * b(k,66) - b(k,65) = b(k,65) * lu(k,173) - b(k,64) = b(k,64) * lu(k,168) - b(k,63) = b(k,63) * lu(k,161) - b(k,45) = b(k,45) - lu(k,160) * b(k,63) - b(k,62) = b(k,62) * lu(k,156) - b(k,61) = b(k,61) * lu(k,153) - b(k,60) = b(k,60) * lu(k,150) - b(k,59) = b(k,59) * lu(k,146) - b(k,58) = b(k,58) * lu(k,141) - b(k,57) = b(k,57) * lu(k,137) - b(k,56) = b(k,56) * lu(k,131) - b(k,38) = b(k,38) - lu(k,130) * b(k,56) - b(k,55) = b(k,55) * lu(k,128) - b(k,54) = b(k,54) * lu(k,125) - b(k,53) = b(k,53) * lu(k,122) - b(k,52) = b(k,52) * lu(k,119) - b(k,51) = b(k,51) * lu(k,116) - b(k,50) = b(k,50) * lu(k,112) - b(k,49) = b(k,49) * lu(k,109) - b(k,48) = b(k,48) * lu(k,106) - b(k,47) = b(k,47) * lu(k,103) - b(k,46) = b(k,46) * lu(k,102) - b(k,33) = b(k,33) - lu(k,101) * b(k,46) - b(k,32) = b(k,32) - lu(k,100) * b(k,46) - b(k,31) = b(k,31) - lu(k,99) * b(k,46) - b(k,30) = b(k,30) - lu(k,98) * b(k,46) - b(k,29) = b(k,29) - lu(k,97) * b(k,46) - b(k,45) = b(k,45) * lu(k,96) - b(k,33) = b(k,33) - lu(k,95) * b(k,45) - b(k,32) = b(k,32) - lu(k,94) * b(k,45) - b(k,31) = b(k,31) - lu(k,93) * b(k,45) - b(k,30) = b(k,30) - lu(k,92) * b(k,45) - b(k,29) = b(k,29) - lu(k,91) * b(k,45) - b(k,44) = b(k,44) * lu(k,90) - b(k,33) = b(k,33) - lu(k,89) * b(k,44) - b(k,32) = b(k,32) - lu(k,88) * b(k,44) - b(k,31) = b(k,31) - lu(k,87) * b(k,44) - b(k,30) = b(k,30) - lu(k,86) * b(k,44) - b(k,29) = b(k,29) - lu(k,85) * b(k,44) - b(k,43) = b(k,43) * lu(k,84) - b(k,33) = b(k,33) - lu(k,83) * b(k,43) - b(k,32) = b(k,32) - lu(k,82) * b(k,43) - b(k,31) = b(k,31) - lu(k,81) * b(k,43) - b(k,30) = b(k,30) - lu(k,80) * b(k,43) - b(k,29) = b(k,29) - lu(k,79) * b(k,43) - b(k,42) = b(k,42) * lu(k,78) - b(k,41) = b(k,41) - lu(k,77) * b(k,42) - b(k,41) = b(k,41) * lu(k,76) - b(k,33) = b(k,33) - lu(k,75) * b(k,41) - b(k,32) = b(k,32) - lu(k,74) * b(k,41) - b(k,31) = b(k,31) - lu(k,73) * b(k,41) - b(k,30) = b(k,30) - lu(k,72) * b(k,41) - b(k,29) = b(k,29) - lu(k,71) * b(k,41) - b(k,40) = b(k,40) * lu(k,70) - b(k,33) = b(k,33) - lu(k,69) * b(k,40) - b(k,32) = b(k,32) - lu(k,68) * b(k,40) - b(k,31) = b(k,31) - lu(k,67) * b(k,40) - b(k,30) = b(k,30) - lu(k,66) * b(k,40) - b(k,29) = b(k,29) - lu(k,65) * b(k,40) - b(k,39) = b(k,39) * lu(k,64) - b(k,33) = b(k,33) - lu(k,63) * b(k,39) - b(k,32) = b(k,32) - lu(k,62) * b(k,39) - b(k,31) = b(k,31) - lu(k,61) * b(k,39) - b(k,30) = b(k,30) - lu(k,60) * b(k,39) - b(k,29) = b(k,29) - lu(k,59) * b(k,39) - b(k,38) = b(k,38) * lu(k,58) - b(k,33) = b(k,33) - lu(k,57) * b(k,38) - b(k,32) = b(k,32) - lu(k,56) * b(k,38) - b(k,31) = b(k,31) - lu(k,55) * b(k,38) - b(k,30) = b(k,30) - lu(k,54) * b(k,38) - b(k,29) = b(k,29) - lu(k,53) * b(k,38) - b(k,37) = b(k,37) * lu(k,52) - b(k,33) = b(k,33) - lu(k,51) * b(k,37) - b(k,32) = b(k,32) - lu(k,50) * b(k,37) - b(k,31) = b(k,31) - lu(k,49) * b(k,37) - b(k,30) = b(k,30) - lu(k,48) * b(k,37) - b(k,29) = b(k,29) - lu(k,47) * b(k,37) - b(k,36) = b(k,36) * lu(k,46) - b(k,33) = b(k,33) - lu(k,45) * b(k,36) - b(k,32) = b(k,32) - lu(k,44) * b(k,36) - b(k,31) = b(k,31) - lu(k,43) * b(k,36) - b(k,30) = b(k,30) - lu(k,42) * b(k,36) - b(k,29) = b(k,29) - lu(k,41) * b(k,36) - b(k,35) = b(k,35) * lu(k,40) - b(k,33) = b(k,33) - lu(k,39) * b(k,35) - b(k,32) = b(k,32) - lu(k,38) * b(k,35) - b(k,31) = b(k,31) - lu(k,37) * b(k,35) - b(k,30) = b(k,30) - lu(k,36) * b(k,35) - b(k,29) = b(k,29) - lu(k,35) * b(k,35) + b(k,254) = b(k,254) * lu(k,1725) + b(k,234) = b(k,234) - lu(k,1724) * b(k,254) + b(k,253) = b(k,253) * lu(k,1716) + b(k,252) = b(k,252) * lu(k,1710) + b(k,245) = b(k,245) - lu(k,1709) * b(k,252) + b(k,233) = b(k,233) - lu(k,1708) * b(k,252) + b(k,251) = b(k,251) * lu(k,1700) + b(k,242) = b(k,242) - lu(k,1699) * b(k,251) + b(k,240) = b(k,240) - lu(k,1698) * b(k,251) + b(k,213) = b(k,213) - lu(k,1697) * b(k,251) + b(k,190) = b(k,190) - lu(k,1696) * b(k,251) + b(k,174) = b(k,174) - lu(k,1695) * b(k,251) + b(k,250) = b(k,250) * lu(k,1687) + b(k,242) = b(k,242) - lu(k,1686) * b(k,250) + b(k,213) = b(k,213) - lu(k,1685) * b(k,250) + b(k,190) = b(k,190) - lu(k,1684) * b(k,250) + b(k,173) = b(k,173) - lu(k,1683) * b(k,250) + b(k,249) = b(k,249) * lu(k,1671) + b(k,217) = b(k,217) - lu(k,1670) * b(k,249) + b(k,106) = b(k,106) - lu(k,1669) * b(k,249) + b(k,248) = b(k,248) * lu(k,1657) + b(k,245) = b(k,245) - lu(k,1656) * b(k,248) + b(k,233) = b(k,233) - lu(k,1655) * b(k,248) + b(k,202) = b(k,202) - lu(k,1654) * b(k,248) + b(k,247) = b(k,247) * lu(k,1638) + b(k,245) = b(k,245) - lu(k,1637) * b(k,247) + b(k,234) = b(k,234) - lu(k,1636) * b(k,247) + b(k,233) = b(k,233) - lu(k,1635) * b(k,247) + b(k,232) = b(k,232) - lu(k,1634) * b(k,247) + b(k,230) = b(k,230) - lu(k,1633) * b(k,247) + b(k,202) = b(k,202) - lu(k,1632) * b(k,247) + b(k,246) = b(k,246) * lu(k,1618) + b(k,245) = b(k,245) - lu(k,1617) * b(k,246) + b(k,171) = b(k,171) - lu(k,1616) * b(k,246) + b(k,161) = b(k,161) - lu(k,1615) * b(k,246) + b(k,138) = b(k,138) - lu(k,1614) * b(k,246) + b(k,245) = b(k,245) * lu(k,1611) + b(k,244) = b(k,244) * lu(k,1598) + b(k,214) = b(k,214) - lu(k,1597) * b(k,244) + b(k,141) = b(k,141) - lu(k,1596) * b(k,244) + b(k,109) = b(k,109) - lu(k,1595) * b(k,244) + b(k,243) = b(k,243) * lu(k,1570) + b(k,239) = b(k,239) - lu(k,1569) * b(k,243) + b(k,235) = b(k,235) - lu(k,1568) * b(k,243) + b(k,234) = b(k,234) - lu(k,1567) * b(k,243) + b(k,233) = b(k,233) - lu(k,1566) * b(k,243) + b(k,232) = b(k,232) - lu(k,1565) * b(k,243) + b(k,230) = b(k,230) - lu(k,1564) * b(k,243) + b(k,227) = b(k,227) - lu(k,1563) * b(k,243) + b(k,216) = b(k,216) - lu(k,1562) * b(k,243) + b(k,189) = b(k,189) - lu(k,1561) * b(k,243) + b(k,175) = b(k,175) - lu(k,1560) * b(k,243) + b(k,242) = b(k,242) * lu(k,1555) + b(k,241) = b(k,241) * lu(k,1541) + b(k,231) = b(k,231) - lu(k,1540) * b(k,241) + b(k,240) = b(k,240) * lu(k,1534) + b(k,239) = b(k,239) * lu(k,1522) + b(k,233) = b(k,233) - lu(k,1521) * b(k,239) + b(k,219) = b(k,219) - lu(k,1520) * b(k,239) + b(k,184) = b(k,184) - lu(k,1519) * b(k,239) + b(k,238) = b(k,238) * lu(k,1506) + b(k,237) = b(k,237) - lu(k,1505) * b(k,238) + b(k,236) = b(k,236) - lu(k,1504) * b(k,238) + b(k,237) = b(k,237) * lu(k,1496) + b(k,236) = b(k,236) * lu(k,1492) + b(k,235) = b(k,235) * lu(k,1485) + b(k,234) = b(k,234) * lu(k,1479) + b(k,233) = b(k,233) * lu(k,1474) + b(k,37) = b(k,37) - lu(k,1473) * b(k,233) + b(k,232) = b(k,232) * lu(k,1466) + b(k,231) = b(k,231) * lu(k,1459) + b(k,230) = b(k,230) * lu(k,1452) + b(k,229) = b(k,229) * lu(k,1438) + b(k,228) = b(k,228) * lu(k,1429) + b(k,227) = b(k,227) * lu(k,1413) + b(k,189) = b(k,189) - lu(k,1412) * b(k,227) + b(k,175) = b(k,175) - lu(k,1411) * b(k,227) + b(k,226) = b(k,226) * lu(k,1390) + b(k,224) = b(k,224) - lu(k,1389) * b(k,226) + b(k,211) = b(k,211) - lu(k,1388) * b(k,226) + b(k,95) = b(k,95) - lu(k,1387) * b(k,226) + b(k,94) = b(k,94) - lu(k,1386) * b(k,226) + b(k,93) = b(k,93) - lu(k,1385) * b(k,226) + b(k,92) = b(k,92) - lu(k,1384) * b(k,226) + b(k,49) = b(k,49) - lu(k,1383) * b(k,226) + b(k,41) = b(k,41) - lu(k,1382) * b(k,226) + b(k,40) = b(k,40) - lu(k,1381) * b(k,226) + b(k,225) = b(k,225) * lu(k,1365) + b(k,224) = b(k,224) - lu(k,1364) * b(k,225) + b(k,186) = b(k,186) - lu(k,1363) * b(k,225) + b(k,171) = b(k,171) - lu(k,1362) * b(k,225) + b(k,224) = b(k,224) * lu(k,1357) + b(k,223) = b(k,223) * lu(k,1348) + b(k,112) = b(k,112) - lu(k,1347) * b(k,223) + b(k,97) = b(k,97) - lu(k,1346) * b(k,223) + b(k,222) = b(k,222) * lu(k,1334) + b(k,120) = b(k,120) - lu(k,1333) * b(k,222) + b(k,221) = b(k,221) * lu(k,1323) + b(k,205) = b(k,205) - lu(k,1322) * b(k,221) + b(k,73) = b(k,73) - lu(k,1321) * b(k,221) + b(k,220) = b(k,220) * lu(k,1307) + b(k,219) = b(k,219) * lu(k,1296) + b(k,169) = b(k,169) - lu(k,1295) * b(k,219) + b(k,218) = b(k,218) * lu(k,1287) + b(k,217) = b(k,217) * lu(k,1278) + b(k,106) = b(k,106) - lu(k,1277) * b(k,217) + b(k,216) = b(k,216) * lu(k,1264) + b(k,184) = b(k,184) - lu(k,1263) * b(k,216) + b(k,215) = b(k,215) * lu(k,1246) + b(k,168) = b(k,168) - lu(k,1245) * b(k,215) + b(k,45) = b(k,45) - lu(k,1244) * b(k,215) + b(k,41) = b(k,41) - lu(k,1243) * b(k,215) + b(k,40) = b(k,40) - lu(k,1242) * b(k,215) + b(k,39) = b(k,39) - lu(k,1241) * b(k,215) + b(k,38) = b(k,38) - lu(k,1240) * b(k,215) + b(k,37) = b(k,37) - lu(k,1239) * b(k,215) + b(k,214) = b(k,214) * lu(k,1233) + b(k,96) = b(k,96) - lu(k,1232) * b(k,214) + b(k,213) = b(k,213) * lu(k,1226) + b(k,212) = b(k,212) * lu(k,1216) + b(k,192) = b(k,192) - lu(k,1215) * b(k,212) + b(k,190) = b(k,190) - lu(k,1214) * b(k,212) + b(k,211) = b(k,211) * lu(k,1208) + b(k,210) = b(k,210) * lu(k,1198) + b(k,165) = b(k,165) - lu(k,1197) * b(k,210) + b(k,164) = b(k,164) - lu(k,1196) * b(k,210) + b(k,163) = b(k,163) - lu(k,1195) * b(k,210) + b(k,143) = b(k,143) - lu(k,1194) * b(k,210) + b(k,209) = b(k,209) * lu(k,1178) + b(k,184) = b(k,184) - lu(k,1177) * b(k,209) + b(k,134) = b(k,134) - lu(k,1176) * b(k,209) + b(k,208) = b(k,208) * lu(k,1164) + b(k,207) = b(k,207) * lu(k,1156) + b(k,206) = b(k,206) * lu(k,1149) + b(k,205) = b(k,205) * lu(k,1142) + b(k,73) = b(k,73) - lu(k,1141) * b(k,205) + b(k,204) = b(k,204) * lu(k,1130) + b(k,203) = b(k,203) * lu(k,1119) + b(k,202) = b(k,202) * lu(k,1108) + b(k,201) = b(k,201) * lu(k,1104) + b(k,200) = b(k,200) * lu(k,1090) + b(k,79) = b(k,79) - lu(k,1089) * b(k,200) + b(k,48) = b(k,48) - lu(k,1088) * b(k,200) + b(k,41) = b(k,41) - lu(k,1087) * b(k,200) + b(k,40) = b(k,40) - lu(k,1086) * b(k,200) + b(k,39) = b(k,39) - lu(k,1085) * b(k,200) + b(k,38) = b(k,38) - lu(k,1084) * b(k,200) + b(k,37) = b(k,37) - lu(k,1083) * b(k,200) + b(k,199) = b(k,199) * lu(k,1069) + b(k,168) = b(k,168) - lu(k,1068) * b(k,199) + b(k,52) = b(k,52) - lu(k,1067) * b(k,199) + b(k,41) = b(k,41) - lu(k,1066) * b(k,199) + b(k,40) = b(k,40) - lu(k,1065) * b(k,199) + b(k,39) = b(k,39) - lu(k,1064) * b(k,199) + b(k,38) = b(k,38) - lu(k,1063) * b(k,199) + b(k,37) = b(k,37) - lu(k,1062) * b(k,199) + b(k,198) = b(k,198) * lu(k,1052) + b(k,197) = b(k,197) * lu(k,1042) + b(k,121) = b(k,121) - lu(k,1041) * b(k,197) + b(k,196) = b(k,196) * lu(k,1028) + b(k,168) = b(k,168) - lu(k,1027) * b(k,196) + b(k,46) = b(k,46) - lu(k,1026) * b(k,196) + b(k,41) = b(k,41) - lu(k,1025) * b(k,196) + b(k,40) = b(k,40) - lu(k,1024) * b(k,196) + b(k,39) = b(k,39) - lu(k,1023) * b(k,196) + b(k,38) = b(k,38) - lu(k,1022) * b(k,196) + b(k,37) = b(k,37) - lu(k,1021) * b(k,196) + b(k,195) = b(k,195) * lu(k,1013) + b(k,190) = b(k,190) - lu(k,1012) * b(k,195) + b(k,194) = b(k,194) * lu(k,1004) + b(k,190) = b(k,190) - lu(k,1003) * b(k,194) + b(k,158) = b(k,158) - lu(k,1002) * b(k,194) + b(k,115) = b(k,115) - lu(k,1001) * b(k,194) + b(k,193) = b(k,193) * lu(k,993) + b(k,86) = b(k,86) - lu(k,992) * b(k,193) + b(k,192) = b(k,192) * lu(k,984) + b(k,191) = b(k,191) * lu(k,972) + b(k,80) = b(k,80) - lu(k,971) * b(k,191) + b(k,190) = b(k,190) * lu(k,967) + b(k,189) = b(k,189) * lu(k,962) + b(k,188) = b(k,188) * lu(k,953) + b(k,187) = b(k,187) * lu(k,944) + b(k,158) = b(k,158) - lu(k,943) * b(k,187) + b(k,149) = b(k,149) - lu(k,942) * b(k,187) + b(k,115) = b(k,115) - lu(k,941) * b(k,187) + b(k,186) = b(k,186) * lu(k,932) + b(k,147) = b(k,147) - lu(k,931) * b(k,186) + b(k,185) = b(k,185) * lu(k,922) + b(k,184) = b(k,184) * lu(k,917) + b(k,183) = b(k,183) * lu(k,912) + b(k,182) = b(k,182) * lu(k,904) + b(k,181) = b(k,181) * lu(k,893) + b(k,179) = b(k,179) - lu(k,892) * b(k,181) + b(k,176) = b(k,176) - lu(k,891) * b(k,181) + b(k,130) = b(k,130) - lu(k,890) * b(k,181) + b(k,119) = b(k,119) - lu(k,889) * b(k,181) + b(k,108) = b(k,108) - lu(k,888) * b(k,181) + b(k,101) = b(k,101) - lu(k,887) * b(k,181) + b(k,180) = b(k,180) * lu(k,877) + b(k,179) = b(k,179) - lu(k,876) * b(k,180) + b(k,166) = b(k,166) - lu(k,875) * b(k,180) + b(k,130) = b(k,130) - lu(k,874) * b(k,180) + b(k,119) = b(k,119) - lu(k,873) * b(k,180) + b(k,101) = b(k,101) - lu(k,872) * b(k,180) + end do + end subroutine lu_slv18 + subroutine lu_slv19( 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,179) = b(k,179) * lu(k,866) + b(k,178) = b(k,178) * lu(k,859) + b(k,99) = b(k,99) - lu(k,858) * b(k,178) + b(k,66) = b(k,66) - lu(k,857) * b(k,178) + b(k,177) = b(k,177) * lu(k,846) + b(k,53) = b(k,53) - lu(k,845) * b(k,177) + b(k,41) = b(k,41) - lu(k,844) * b(k,177) + b(k,40) = b(k,40) - lu(k,843) * b(k,177) + b(k,39) = b(k,39) - lu(k,842) * b(k,177) + b(k,38) = b(k,38) - lu(k,841) * b(k,177) + b(k,37) = b(k,37) - lu(k,840) * b(k,177) + b(k,176) = b(k,176) * lu(k,829) + b(k,130) = b(k,130) - lu(k,828) * b(k,176) + b(k,119) = b(k,119) - lu(k,827) * b(k,176) + b(k,108) = b(k,108) - lu(k,826) * b(k,176) + b(k,101) = b(k,101) - lu(k,825) * b(k,176) + b(k,175) = b(k,175) * lu(k,819) + b(k,174) = b(k,174) * lu(k,811) + b(k,173) = b(k,173) * lu(k,803) + b(k,172) = b(k,172) * lu(k,795) + b(k,149) = b(k,149) - lu(k,794) * b(k,172) + b(k,171) = b(k,171) * lu(k,789) + b(k,170) = b(k,170) * lu(k,781) + b(k,169) = b(k,169) * lu(k,773) + b(k,168) = b(k,168) * lu(k,768) + b(k,167) = b(k,167) * lu(k,758) + b(k,166) = b(k,166) * lu(k,748) + b(k,130) = b(k,130) - lu(k,747) * b(k,166) + b(k,119) = b(k,119) - lu(k,746) * b(k,166) + b(k,101) = b(k,101) - lu(k,745) * b(k,166) + b(k,165) = b(k,165) * lu(k,738) + b(k,107) = b(k,107) - lu(k,737) * b(k,165) + b(k,164) = b(k,164) * lu(k,727) + b(k,143) = b(k,143) - lu(k,726) * b(k,164) + b(k,163) = b(k,163) * lu(k,716) + b(k,143) = b(k,143) - lu(k,715) * b(k,163) + b(k,162) = b(k,162) * lu(k,709) + b(k,136) = b(k,136) - lu(k,708) * b(k,162) + b(k,98) = b(k,98) - lu(k,707) * b(k,162) + b(k,161) = b(k,161) * lu(k,700) + b(k,160) = b(k,160) * lu(k,691) + b(k,159) = b(k,159) * lu(k,678) + b(k,153) = b(k,153) - lu(k,677) * b(k,159) + b(k,158) = b(k,158) * lu(k,673) + b(k,157) = b(k,157) * lu(k,666) + b(k,156) = b(k,156) * lu(k,657) + b(k,155) = b(k,155) * lu(k,648) + b(k,154) = b(k,154) * lu(k,639) + b(k,153) = b(k,153) * lu(k,632) + b(k,152) = b(k,152) * lu(k,619) + b(k,151) = b(k,151) * lu(k,610) + b(k,150) = b(k,150) * lu(k,602) + b(k,149) = b(k,149) * lu(k,598) + b(k,148) = b(k,148) * lu(k,590) + b(k,147) = b(k,147) * lu(k,582) + b(k,146) = b(k,146) * lu(k,574) + b(k,145) = b(k,145) * lu(k,566) + b(k,144) = b(k,144) * lu(k,558) + b(k,143) = b(k,143) * lu(k,553) + b(k,142) = b(k,142) * lu(k,547) + b(k,68) = b(k,68) - lu(k,546) * b(k,142) + b(k,141) = b(k,141) * lu(k,540) + b(k,140) = b(k,140) * lu(k,533) + b(k,124) = b(k,124) - lu(k,532) * b(k,140) + b(k,139) = b(k,139) * lu(k,525) + b(k,130) = b(k,130) - lu(k,524) * b(k,139) + b(k,122) = b(k,122) - lu(k,523) * b(k,139) + b(k,138) = b(k,138) * lu(k,516) + b(k,137) = b(k,137) * lu(k,509) + b(k,136) = b(k,136) * lu(k,505) + b(k,135) = b(k,135) * lu(k,498) + b(k,134) = b(k,134) * lu(k,488) + b(k,133) = b(k,133) * lu(k,481) + b(k,132) = b(k,132) * lu(k,474) + b(k,78) = b(k,78) - lu(k,473) * b(k,132) + b(k,131) = b(k,131) * lu(k,468) + b(k,130) = b(k,130) * lu(k,465) + b(k,129) = b(k,129) * lu(k,459) + b(k,128) = b(k,128) * lu(k,453) + b(k,110) = b(k,110) - lu(k,452) * b(k,128) + b(k,127) = b(k,127) * lu(k,446) + b(k,126) = b(k,126) * lu(k,440) + b(k,111) = b(k,111) - lu(k,439) * b(k,126) + b(k,87) = b(k,87) - lu(k,438) * b(k,126) + b(k,125) = b(k,125) * lu(k,432) + b(k,124) = b(k,124) * lu(k,426) + b(k,123) = b(k,123) * lu(k,420) + b(k,122) = b(k,122) * lu(k,414) + b(k,121) = b(k,121) * lu(k,408) + b(k,120) = b(k,120) * lu(k,402) + b(k,119) = b(k,119) * lu(k,398) + b(k,118) = b(k,118) * lu(k,390) + b(k,117) = b(k,117) * lu(k,382) + b(k,116) = b(k,116) * lu(k,374) + b(k,115) = b(k,115) * lu(k,370) + b(k,114) = b(k,114) * lu(k,365) + b(k,113) = b(k,113) * lu(k,360) + b(k,112) = b(k,112) * lu(k,355) + b(k,111) = b(k,111) * lu(k,350) + b(k,87) = b(k,87) - lu(k,349) * b(k,111) + b(k,110) = b(k,110) * lu(k,344) + b(k,109) = b(k,109) * lu(k,339) + b(k,108) = b(k,108) * lu(k,334) + b(k,107) = b(k,107) * lu(k,329) + b(k,106) = b(k,106) * lu(k,326) + b(k,105) = b(k,105) * lu(k,320) + b(k,104) = b(k,104) * lu(k,314) + b(k,103) = b(k,103) * lu(k,308) + b(k,102) = b(k,102) * lu(k,302) + b(k,91) = b(k,91) - lu(k,301) * b(k,102) + b(k,101) = b(k,101) * lu(k,298) + b(k,100) = b(k,100) * lu(k,292) + b(k,99) = b(k,99) * lu(k,288) + b(k,98) = b(k,98) * lu(k,284) + b(k,97) = b(k,97) * lu(k,280) + b(k,96) = b(k,96) * lu(k,276) + b(k,67) = b(k,67) - lu(k,275) * b(k,96) + b(k,95) = b(k,95) * lu(k,272) + b(k,94) = b(k,94) * lu(k,269) + b(k,93) = b(k,93) * lu(k,266) + b(k,92) = b(k,92) * lu(k,263) + b(k,91) = b(k,91) * lu(k,260) + b(k,90) = b(k,90) * lu(k,255) + b(k,89) = b(k,89) * lu(k,251) + b(k,88) = b(k,88) * lu(k,246) + b(k,87) = b(k,87) * lu(k,243) + b(k,86) = b(k,86) * lu(k,240) + b(k,85) = b(k,85) * lu(k,235) + b(k,84) = b(k,84) * lu(k,227) + b(k,83) = b(k,83) - lu(k,226) * b(k,84) + b(k,55) = b(k,55) - lu(k,225) * b(k,84) + b(k,83) = b(k,83) * lu(k,221) + b(k,82) = b(k,82) * lu(k,216) + b(k,81) = b(k,81) * lu(k,209) + b(k,54) = b(k,54) - lu(k,208) * b(k,81) + b(k,80) = b(k,80) * lu(k,205) + b(k,79) = b(k,79) * lu(k,202) + b(k,78) = b(k,78) * lu(k,199) + b(k,77) = b(k,77) * lu(k,195) + b(k,76) = b(k,76) * lu(k,190) + b(k,75) = b(k,75) * lu(k,186) + b(k,74) = b(k,74) * lu(k,180) + b(k,47) = b(k,47) - lu(k,179) * b(k,74) + b(k,73) = b(k,73) * lu(k,177) + b(k,72) = b(k,72) * lu(k,172) + b(k,71) = b(k,71) * lu(k,167) + b(k,70) = b(k,70) * lu(k,162) + b(k,69) = b(k,69) * lu(k,157) + b(k,68) = b(k,68) * lu(k,154) + b(k,67) = b(k,67) * lu(k,151) + b(k,66) = b(k,66) * lu(k,148) + b(k,65) = b(k,65) * lu(k,144) + b(k,64) = b(k,64) * lu(k,140) + b(k,63) = b(k,63) * lu(k,136) + b(k,62) = b(k,62) * lu(k,132) + b(k,61) = b(k,61) * lu(k,128) + b(k,60) = b(k,60) * lu(k,124) + b(k,59) = b(k,59) * lu(k,121) + b(k,58) = b(k,58) * lu(k,118) + b(k,57) = b(k,57) * lu(k,115) + b(k,56) = b(k,56) * lu(k,112) + b(k,55) = b(k,55) * lu(k,111) + b(k,41) = b(k,41) - lu(k,110) * b(k,55) + b(k,40) = b(k,40) - lu(k,109) * b(k,55) + b(k,39) = b(k,39) - lu(k,108) * b(k,55) + b(k,38) = b(k,38) - lu(k,107) * b(k,55) + b(k,37) = b(k,37) - lu(k,106) * b(k,55) + b(k,54) = b(k,54) * lu(k,105) + b(k,41) = b(k,41) - lu(k,104) * b(k,54) + b(k,40) = b(k,40) - lu(k,103) * b(k,54) + b(k,39) = b(k,39) - lu(k,102) * b(k,54) + b(k,38) = b(k,38) - lu(k,101) * b(k,54) + b(k,37) = b(k,37) - lu(k,100) * b(k,54) + b(k,53) = b(k,53) * lu(k,99) + b(k,41) = b(k,41) - lu(k,98) * b(k,53) + b(k,40) = b(k,40) - lu(k,97) * b(k,53) + b(k,39) = b(k,39) - lu(k,96) * b(k,53) + b(k,38) = b(k,38) - lu(k,95) * b(k,53) + b(k,37) = b(k,37) - lu(k,94) * b(k,53) + b(k,52) = b(k,52) * lu(k,93) + b(k,41) = b(k,41) - lu(k,92) * b(k,52) + b(k,40) = b(k,40) - lu(k,91) * b(k,52) + b(k,39) = b(k,39) - lu(k,90) * b(k,52) + b(k,38) = b(k,38) - lu(k,89) * b(k,52) + b(k,37) = b(k,37) - lu(k,88) * b(k,52) + b(k,51) = b(k,51) * lu(k,87) + b(k,50) = b(k,50) - lu(k,86) * b(k,51) + b(k,50) = b(k,50) * lu(k,85) + b(k,41) = b(k,41) - lu(k,84) * b(k,50) + b(k,40) = b(k,40) - lu(k,83) * b(k,50) + b(k,39) = b(k,39) - lu(k,82) * b(k,50) + b(k,38) = b(k,38) - lu(k,81) * b(k,50) + b(k,37) = b(k,37) - lu(k,80) * b(k,50) + b(k,49) = b(k,49) * lu(k,79) + b(k,41) = b(k,41) - lu(k,78) * b(k,49) + b(k,40) = b(k,40) - lu(k,77) * b(k,49) + b(k,39) = b(k,39) - lu(k,76) * b(k,49) + b(k,38) = b(k,38) - lu(k,75) * b(k,49) + b(k,37) = b(k,37) - lu(k,74) * b(k,49) + b(k,48) = b(k,48) * lu(k,73) + b(k,41) = b(k,41) - lu(k,72) * b(k,48) + b(k,40) = b(k,40) - lu(k,71) * b(k,48) + b(k,39) = b(k,39) - lu(k,70) * b(k,48) + b(k,38) = b(k,38) - lu(k,69) * b(k,48) + b(k,37) = b(k,37) - lu(k,68) * b(k,48) + end do + end subroutine lu_slv19 + subroutine lu_slv20( 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,47) = b(k,47) * lu(k,67) + b(k,41) = b(k,41) - lu(k,66) * b(k,47) + b(k,40) = b(k,40) - lu(k,65) * b(k,47) + b(k,39) = b(k,39) - lu(k,64) * b(k,47) + b(k,38) = b(k,38) - lu(k,63) * b(k,47) + b(k,37) = b(k,37) - lu(k,62) * b(k,47) + b(k,46) = b(k,46) * lu(k,61) + b(k,41) = b(k,41) - lu(k,60) * b(k,46) + b(k,40) = b(k,40) - lu(k,59) * b(k,46) + b(k,39) = b(k,39) - lu(k,58) * b(k,46) + b(k,38) = b(k,38) - lu(k,57) * b(k,46) + b(k,37) = b(k,37) - lu(k,56) * b(k,46) + b(k,45) = b(k,45) * lu(k,55) + b(k,41) = b(k,41) - lu(k,54) * b(k,45) + b(k,40) = b(k,40) - lu(k,53) * b(k,45) + b(k,39) = b(k,39) - lu(k,52) * b(k,45) + b(k,38) = b(k,38) - lu(k,51) * b(k,45) + b(k,37) = b(k,37) - lu(k,50) * b(k,45) + b(k,44) = b(k,44) * lu(k,49) + b(k,41) = b(k,41) - lu(k,48) * b(k,44) + b(k,40) = b(k,40) - lu(k,47) * b(k,44) + b(k,39) = b(k,39) - lu(k,46) * b(k,44) + b(k,38) = b(k,38) - lu(k,45) * b(k,44) + b(k,37) = b(k,37) - lu(k,44) * b(k,44) + b(k,43) = b(k,43) * lu(k,43) + b(k,42) = b(k,42) * lu(k,42) + b(k,41) = b(k,41) * lu(k,41) + b(k,40) = b(k,40) * lu(k,40) + b(k,39) = b(k,39) * lu(k,39) + b(k,38) = b(k,38) * lu(k,38) + b(k,37) = b(k,37) * lu(k,37) + b(k,36) = b(k,36) * lu(k,36) + b(k,35) = b(k,35) * lu(k,35) b(k,34) = b(k,34) * lu(k,34) b(k,33) = b(k,33) * lu(k,33) b(k,32) = b(k,32) * lu(k,32) @@ -4227,7 +4537,7 @@ subroutine lu_slv18( avec_len, lu, b ) b(k,2) = b(k,2) * lu(k,2) b(k,1) = b(k,1) * lu(k,1) end do - end subroutine lu_slv18 + end subroutine lu_slv20 subroutine lu_slv( avec_len, lu, b ) use shr_kind_mod, only : r8 => shr_kind_r8 use chem_mods, only : clscnt4, nzcnt @@ -4256,5 +4566,7 @@ subroutine lu_slv( avec_len, lu, b ) call lu_slv16( avec_len, lu, b ) call lu_slv17( avec_len, lu, b ) call lu_slv18( avec_len, lu, b ) + call lu_slv19( avec_len, lu, b ) + call lu_slv20( avec_len, lu, b ) end subroutine lu_slv end module mo_lu_solve diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/mo_nln_matrix.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/mo_nln_matrix.F90 index 05a51521b4..6d020e5cbf 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/mo_nln_matrix.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/mo_nln_matrix.F90 @@ -22,330 +22,365 @@ subroutine nlnmat01( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,634) = -(rxt(k,409)*y(k,293)) - mat(k,3612) = -rxt(k,409)*y(k,1) - mat(k,2778) = rxt(k,412)*y(k,234) - mat(k,1129) = rxt(k,412)*y(k,147) - mat(k,645) = -(rxt(k,413)*y(k,293)) - mat(k,3613) = -rxt(k,413)*y(k,2) - mat(k,1130) = rxt(k,410)*y(k,256) - mat(k,3167) = rxt(k,410)*y(k,234) - mat(k,1102) = -(rxt(k,585)*y(k,149) + rxt(k,603)*y(k,157) + rxt(k,604) & + mat(k,716) = -(rxt(k,408)*y(k,293)) + mat(k,3677) = -rxt(k,408)*y(k,1) + mat(k,3199) = rxt(k,411)*y(k,234) + mat(k,1195) = rxt(k,411)*y(k,147) + mat(k,727) = -(rxt(k,412)*y(k,293)) + mat(k,3678) = -rxt(k,412)*y(k,2) + mat(k,1196) = rxt(k,409)*y(k,256) + mat(k,3445) = rxt(k,409)*y(k,234) + mat(k,1246) = -(rxt(k,584)*y(k,149) + rxt(k,602)*y(k,157) + rxt(k,603) & *y(k,293)) - mat(k,3013) = -rxt(k,585)*y(k,4) - mat(k,2920) = -rxt(k,603)*y(k,4) - mat(k,3656) = -rxt(k,604)*y(k,4) - mat(k,859) = -(rxt(k,605)*y(k,149) + rxt(k,623)*y(k,157) + rxt(k,624) & + mat(k,3884) = -rxt(k,584)*y(k,4) + mat(k,3060) = -rxt(k,602)*y(k,4) + mat(k,3728) = -rxt(k,603)*y(k,4) + mat(k,1028) = -(rxt(k,604)*y(k,149) + rxt(k,622)*y(k,157) + rxt(k,623) & *y(k,293)) - mat(k,3008) = -rxt(k,605)*y(k,7) - mat(k,2916) = -rxt(k,623)*y(k,7) - mat(k,3635) = -rxt(k,624)*y(k,7) - mat(k,131) = -(rxt(k,544)*y(k,293)) - mat(k,3538) = -rxt(k,544)*y(k,8) - mat(k,322) = -(rxt(k,547)*y(k,293)) - mat(k,3571) = -rxt(k,547)*y(k,9) - mat(k,433) = rxt(k,545)*y(k,256) - mat(k,3143) = rxt(k,545)*y(k,241) - mat(k,132) = .120_r8*rxt(k,544)*y(k,293) - mat(k,3539) = .120_r8*rxt(k,544)*y(k,8) - mat(k,2766) = .500_r8*rxt(k,546)*y(k,241) + .200_r8*rxt(k,573)*y(k,312) & - + .060_r8*rxt(k,579)*y(k,314) - mat(k,434) = .500_r8*rxt(k,546)*y(k,147) - mat(k,759) = .200_r8*rxt(k,573)*y(k,147) - mat(k,775) = .060_r8*rxt(k,579)*y(k,147) - mat(k,2760) = .200_r8*rxt(k,573)*y(k,312) + .200_r8*rxt(k,579)*y(k,314) - mat(k,757) = .200_r8*rxt(k,573)*y(k,147) - mat(k,772) = .200_r8*rxt(k,579)*y(k,147) - mat(k,2763) = .200_r8*rxt(k,573)*y(k,312) + .150_r8*rxt(k,579)*y(k,314) - mat(k,758) = .200_r8*rxt(k,573)*y(k,147) - mat(k,774) = .150_r8*rxt(k,579)*y(k,147) - mat(k,2761) = .210_r8*rxt(k,579)*y(k,314) - mat(k,773) = .210_r8*rxt(k,579)*y(k,147) - mat(k,153) = -(rxt(k,414)*y(k,293)) - mat(k,3543) = -rxt(k,414)*y(k,15) - mat(k,940) = .190_r8*rxt(k,643)*y(k,157) - mat(k,2905) = .190_r8*rxt(k,643)*y(k,17) - mat(k,308) = -(rxt(k,375)*y(k,149) + rxt(k,376)*y(k,293)) - mat(k,3005) = -rxt(k,375)*y(k,16) - mat(k,3569) = -rxt(k,376)*y(k,16) - mat(k,941) = -(rxt(k,625)*y(k,149) + rxt(k,643)*y(k,157) + rxt(k,644) & + mat(k,3877) = -rxt(k,604)*y(k,7) + mat(k,3053) = -rxt(k,622)*y(k,7) + mat(k,3709) = -rxt(k,623)*y(k,7) + mat(k,180) = -(rxt(k,543)*y(k,293)) + mat(k,3599) = -rxt(k,543)*y(k,8) + mat(k,414) = -(rxt(k,546)*y(k,293)) + mat(k,3638) = -rxt(k,546)*y(k,9) + mat(k,523) = rxt(k,544)*y(k,256) + mat(k,3426) = rxt(k,544)*y(k,241) + mat(k,181) = .120_r8*rxt(k,543)*y(k,293) + mat(k,3600) = .120_r8*rxt(k,543)*y(k,8) + mat(k,3186) = .500_r8*rxt(k,545)*y(k,241) + .200_r8*rxt(k,572)*y(k,312) & + + .060_r8*rxt(k,578)*y(k,314) + mat(k,524) = .500_r8*rxt(k,545)*y(k,147) + mat(k,874) = .200_r8*rxt(k,572)*y(k,147) + mat(k,890) = .060_r8*rxt(k,578)*y(k,147) + mat(k,3181) = .200_r8*rxt(k,572)*y(k,312) + .200_r8*rxt(k,578)*y(k,314) + mat(k,872) = .200_r8*rxt(k,572)*y(k,147) + mat(k,887) = .200_r8*rxt(k,578)*y(k,147) + mat(k,3183) = .200_r8*rxt(k,572)*y(k,312) + .150_r8*rxt(k,578)*y(k,314) + mat(k,873) = .200_r8*rxt(k,572)*y(k,147) + mat(k,889) = .150_r8*rxt(k,578)*y(k,147) + mat(k,3182) = .210_r8*rxt(k,578)*y(k,314) + mat(k,888) = .210_r8*rxt(k,578)*y(k,147) + mat(k,202) = -(rxt(k,413)*y(k,293)) + mat(k,3603) = -rxt(k,413)*y(k,15) + mat(k,1089) = .190_r8*rxt(k,642)*y(k,157) + mat(k,3042) = .190_r8*rxt(k,642)*y(k,17) + mat(k,374) = -(rxt(k,374)*y(k,149) + rxt(k,375)*y(k,293)) + mat(k,3873) = -rxt(k,374)*y(k,16) + mat(k,3633) = -rxt(k,375)*y(k,16) + mat(k,1090) = -(rxt(k,624)*y(k,149) + rxt(k,642)*y(k,157) + rxt(k,643) & *y(k,293)) - mat(k,3010) = -rxt(k,625)*y(k,17) - mat(k,2917) = -rxt(k,643)*y(k,17) - mat(k,3642) = -rxt(k,644)*y(k,17) - mat(k,1685) = -(rxt(k,254)*y(k,43) + rxt(k,255)*y(k,256) + rxt(k,256) & + mat(k,3879) = -rxt(k,624)*y(k,17) + mat(k,3055) = -rxt(k,642)*y(k,17) + mat(k,3713) = -rxt(k,643)*y(k,17) + mat(k,2199) = -(rxt(k,254)*y(k,43) + rxt(k,255)*y(k,256) + rxt(k,256) & *y(k,157)) - mat(k,3328) = -rxt(k,254)*y(k,18) - mat(k,3242) = -rxt(k,255)*y(k,18) - mat(k,2948) = -rxt(k,256)*y(k,18) - mat(k,3785) = 4.000_r8*rxt(k,257)*y(k,20) + (rxt(k,258)+rxt(k,259))*y(k,60) & + mat(k,3348) = -rxt(k,254)*y(k,18) + mat(k,3536) = -rxt(k,255)*y(k,18) + mat(k,3099) = -rxt(k,256)*y(k,18) + mat(k,2554) = 4.000_r8*rxt(k,257)*y(k,20) + (rxt(k,258)+rxt(k,259))*y(k,60) & + rxt(k,262)*y(k,147) + rxt(k,265)*y(k,156) + rxt(k,800) & *y(k,173) + rxt(k,266)*y(k,293) - mat(k,3304) = (rxt(k,258)+rxt(k,259))*y(k,20) - mat(k,1040) = rxt(k,267)*y(k,156) + rxt(k,273)*y(k,292) + rxt(k,268)*y(k,293) - mat(k,2846) = rxt(k,262)*y(k,20) - mat(k,3449) = rxt(k,265)*y(k,20) + rxt(k,267)*y(k,83) - mat(k,1514) = rxt(k,800)*y(k,20) - mat(k,3099) = rxt(k,273)*y(k,83) - mat(k,3704) = rxt(k,266)*y(k,20) + rxt(k,268)*y(k,83) - mat(k,3779) = rxt(k,260)*y(k,60) - mat(k,3298) = rxt(k,260)*y(k,20) - mat(k,3758) = (rxt(k,893)+rxt(k,898))*y(k,95) - mat(k,905) = (rxt(k,893)+rxt(k,898))*y(k,87) - mat(k,3800) = -(4._r8*rxt(k,257)*y(k,20) + (rxt(k,258) + rxt(k,259) + rxt(k,260) & + mat(k,159) = rxt(k,244)*y(k,292) + mat(k,165) = rxt(k,270)*y(k,292) + mat(k,510) = 2.000_r8*rxt(k,281)*y(k,57) + 2.000_r8*rxt(k,293)*y(k,292) & + + 2.000_r8*rxt(k,282)*y(k,293) + mat(k,640) = rxt(k,283)*y(k,57) + rxt(k,294)*y(k,292) + rxt(k,284)*y(k,293) + mat(k,433) = 3.000_r8*rxt(k,288)*y(k,57) + 3.000_r8*rxt(k,271)*y(k,292) & + + 3.000_r8*rxt(k,289)*y(k,293) + mat(k,3849) = 2.000_r8*rxt(k,281)*y(k,42) + rxt(k,283)*y(k,44) & + + 3.000_r8*rxt(k,288)*y(k,56) + mat(k,2594) = (rxt(k,258)+rxt(k,259))*y(k,20) + mat(k,126) = 2.000_r8*rxt(k,272)*y(k,292) + mat(k,1157) = rxt(k,267)*y(k,156) + rxt(k,273)*y(k,292) + rxt(k,268)*y(k,293) + mat(k,3280) = rxt(k,262)*y(k,20) + mat(k,3379) = rxt(k,265)*y(k,20) + rxt(k,267)*y(k,83) + mat(k,1599) = rxt(k,800)*y(k,20) + mat(k,2634) = rxt(k,244)*y(k,35) + rxt(k,270)*y(k,36) + 2.000_r8*rxt(k,293) & + *y(k,42) + rxt(k,294)*y(k,44) + 3.000_r8*rxt(k,271)*y(k,56) & + + 2.000_r8*rxt(k,272)*y(k,80) + rxt(k,273)*y(k,83) + mat(k,3787) = rxt(k,266)*y(k,20) + 2.000_r8*rxt(k,282)*y(k,42) + rxt(k,284) & + *y(k,44) + 3.000_r8*rxt(k,289)*y(k,56) + rxt(k,268)*y(k,83) + mat(k,2548) = rxt(k,260)*y(k,60) + mat(k,2588) = rxt(k,260)*y(k,20) + mat(k,3141) = (rxt(k,892)+rxt(k,897))*y(k,95) + mat(k,992) = (rxt(k,892)+rxt(k,897))*y(k,87) + mat(k,2555) = -(4._r8*rxt(k,257)*y(k,20) + (rxt(k,258) + rxt(k,259) + rxt(k,260) & ) * y(k,60) + rxt(k,261)*y(k,256) + rxt(k,262)*y(k,147) & + rxt(k,263)*y(k,148) + rxt(k,265)*y(k,156) + rxt(k,266) & *y(k,293) + rxt(k,800)*y(k,173)) - mat(k,3319) = -(rxt(k,258) + rxt(k,259) + rxt(k,260)) * y(k,20) - mat(k,3293) = -rxt(k,261)*y(k,20) - mat(k,2897) = -rxt(k,262)*y(k,20) - mat(k,3514) = -rxt(k,263)*y(k,20) - mat(k,3464) = -rxt(k,265)*y(k,20) - mat(k,3754) = -rxt(k,266)*y(k,20) - mat(k,1523) = -rxt(k,800)*y(k,20) - mat(k,1693) = rxt(k,256)*y(k,157) - mat(k,497) = rxt(k,264)*y(k,156) - mat(k,1045) = rxt(k,274)*y(k,292) - mat(k,911) = rxt(k,269)*y(k,156) - mat(k,3464) = mat(k,3464) + rxt(k,264)*y(k,21) + rxt(k,269)*y(k,95) - mat(k,2998) = rxt(k,256)*y(k,18) - mat(k,3114) = rxt(k,274)*y(k,83) - mat(k,490) = -(rxt(k,264)*y(k,156)) - mat(k,3439) = -rxt(k,264)*y(k,21) - mat(k,3781) = rxt(k,263)*y(k,148) - mat(k,3476) = rxt(k,263)*y(k,20) - mat(k,198) = -(rxt(k,548)*y(k,293)) - mat(k,3550) = -rxt(k,548)*y(k,23) - mat(k,2758) = rxt(k,551)*y(k,246) - mat(k,356) = rxt(k,551)*y(k,147) - mat(k,286) = -(rxt(k,550)*y(k,293)) - mat(k,3565) = -rxt(k,550)*y(k,24) - mat(k,357) = rxt(k,549)*y(k,256) - mat(k,3140) = rxt(k,549)*y(k,246) - mat(k,253) = -(rxt(k,321)*y(k,57) + rxt(k,322)*y(k,293)) - mat(k,3804) = -rxt(k,321)*y(k,25) - mat(k,3561) = -rxt(k,322)*y(k,25) - mat(k,498) = -(rxt(k,323)*y(k,57) + rxt(k,324)*y(k,157) + rxt(k,351)*y(k,293)) - mat(k,3806) = -rxt(k,323)*y(k,26) - mat(k,2908) = -rxt(k,324)*y(k,26) - mat(k,3596) = -rxt(k,351)*y(k,26) - mat(k,218) = -(rxt(k,329)*y(k,293)) - mat(k,3556) = -rxt(k,329)*y(k,27) - mat(k,1241) = .800_r8*rxt(k,325)*y(k,247) + .200_r8*rxt(k,326)*y(k,251) - mat(k,3347) = .200_r8*rxt(k,326)*y(k,247) - mat(k,291) = -(rxt(k,330)*y(k,293)) - mat(k,3566) = -rxt(k,330)*y(k,28) - mat(k,1242) = rxt(k,327)*y(k,256) - mat(k,3141) = rxt(k,327)*y(k,247) - mat(k,259) = -(rxt(k,331)*y(k,57) + rxt(k,332)*y(k,293)) - mat(k,3805) = -rxt(k,331)*y(k,29) - mat(k,3562) = -rxt(k,332)*y(k,29) - mat(k,1197) = -(rxt(k,354)*y(k,149) + rxt(k,355)*y(k,157) + rxt(k,373) & + mat(k,2595) = -(rxt(k,258) + rxt(k,259) + rxt(k,260)) * y(k,20) + mat(k,3551) = -rxt(k,261)*y(k,20) + mat(k,3295) = -rxt(k,262)*y(k,20) + mat(k,4085) = -rxt(k,263)*y(k,20) + mat(k,3381) = -rxt(k,265)*y(k,20) + mat(k,3801) = -rxt(k,266)*y(k,20) + mat(k,1600) = -rxt(k,800)*y(k,20) + mat(k,2200) = rxt(k,256)*y(k,157) + mat(k,577) = rxt(k,264)*y(k,156) + mat(k,1158) = rxt(k,274)*y(k,292) + mat(k,995) = rxt(k,269)*y(k,156) + mat(k,3381) = mat(k,3381) + rxt(k,264)*y(k,21) + rxt(k,269)*y(k,95) + mat(k,3113) = rxt(k,256)*y(k,18) + mat(k,2636) = rxt(k,274)*y(k,83) + mat(k,574) = -(rxt(k,264)*y(k,156)) + mat(k,3369) = -rxt(k,264)*y(k,21) + mat(k,2550) = rxt(k,263)*y(k,148) + mat(k,4065) = rxt(k,263)*y(k,20) + mat(k,243) = -(rxt(k,547)*y(k,293)) + mat(k,3610) = -rxt(k,547)*y(k,23) + mat(k,3179) = rxt(k,550)*y(k,246) + mat(k,438) = rxt(k,550)*y(k,147) + mat(k,350) = -(rxt(k,549)*y(k,293)) + mat(k,3628) = -rxt(k,549)*y(k,24) + mat(k,439) = rxt(k,548)*y(k,256) + mat(k,3419) = rxt(k,548)*y(k,246) + mat(k,308) = -(rxt(k,320)*y(k,57) + rxt(k,321)*y(k,293)) + mat(k,3829) = -rxt(k,320)*y(k,25) + mat(k,3623) = -rxt(k,321)*y(k,25) + mat(k,590) = -(rxt(k,322)*y(k,57) + rxt(k,323)*y(k,157) + rxt(k,350)*y(k,293)) + mat(k,3834) = -rxt(k,322)*y(k,26) + mat(k,3045) = -rxt(k,323)*y(k,26) + mat(k,3663) = -rxt(k,350)*y(k,26) + mat(k,280) = -(rxt(k,328)*y(k,293)) + mat(k,3620) = -rxt(k,328)*y(k,27) + mat(k,1346) = .800_r8*rxt(k,324)*y(k,247) + .200_r8*rxt(k,325)*y(k,251) + mat(k,3964) = .200_r8*rxt(k,325)*y(k,247) + mat(k,355) = -(rxt(k,329)*y(k,293)) + mat(k,3629) = -rxt(k,329)*y(k,28) + mat(k,1347) = rxt(k,326)*y(k,256) + mat(k,3420) = rxt(k,326)*y(k,247) + mat(k,314) = -(rxt(k,330)*y(k,57) + rxt(k,331)*y(k,293)) + mat(k,3830) = -rxt(k,330)*y(k,29) + mat(k,3624) = -rxt(k,331)*y(k,29) + mat(k,1365) = -(rxt(k,353)*y(k,149) + rxt(k,354)*y(k,157) + rxt(k,372) & *y(k,293)) - mat(k,3019) = -rxt(k,354)*y(k,30) - mat(k,2927) = -rxt(k,355)*y(k,30) - mat(k,3666) = -rxt(k,373)*y(k,30) - mat(k,338) = -(rxt(k,359)*y(k,293)) - mat(k,3573) = -rxt(k,359)*y(k,31) - mat(k,974) = rxt(k,357)*y(k,256) - mat(k,3145) = rxt(k,357)*y(k,248) - mat(k,112) = -(rxt(k,360)*y(k,293)) - mat(k,3536) = -rxt(k,360)*y(k,32) - mat(k,222) = -(rxt(k,554)*y(k,293)) - mat(k,3557) = -rxt(k,554)*y(k,33) - mat(k,602) = rxt(k,552)*y(k,256) - mat(k,3134) = rxt(k,552)*y(k,249) - mat(k,3337) = -(rxt(k,218)*y(k,57) + rxt(k,254)*y(k,18) + rxt(k,298)*y(k,256) & + mat(k,3888) = -rxt(k,353)*y(k,30) + mat(k,3064) = -rxt(k,354)*y(k,30) + mat(k,3738) = -rxt(k,372)*y(k,30) + mat(k,408) = -(rxt(k,358)*y(k,293)) + mat(k,3637) = -rxt(k,358)*y(k,31) + mat(k,1041) = rxt(k,356)*y(k,256) + mat(k,3425) = rxt(k,356)*y(k,248) + mat(k,128) = -(rxt(k,359)*y(k,293)) + mat(k,3597) = -rxt(k,359)*y(k,32) + mat(k,284) = -(rxt(k,553)*y(k,293)) + mat(k,3621) = -rxt(k,553)*y(k,33) + mat(k,707) = rxt(k,551)*y(k,256) + mat(k,3415) = rxt(k,551)*y(k,249) + mat(k,118) = -(rxt(k,243)*y(k,292)) + mat(k,2612) = -rxt(k,243)*y(k,34) + mat(k,157) = -(rxt(k,244)*y(k,292)) + mat(k,2617) = -rxt(k,244)*y(k,35) + mat(k,162) = -(rxt(k,270)*y(k,292)) + mat(k,2618) = -rxt(k,270)*y(k,36) + mat(k,132) = -(rxt(k,245)*y(k,292)) + mat(k,2614) = -rxt(k,245)*y(k,37) + mat(k,167) = -(rxt(k,246)*y(k,292)) + mat(k,2619) = -rxt(k,246)*y(k,38) + mat(k,136) = -(rxt(k,247)*y(k,292)) + mat(k,2615) = -rxt(k,247)*y(k,39) + mat(k,172) = -(rxt(k,248)*y(k,292)) + mat(k,2620) = -rxt(k,248)*y(k,40) + mat(k,140) = -(rxt(k,249)*y(k,292)) + mat(k,2616) = -rxt(k,249)*y(k,41) + mat(k,509) = -(rxt(k,281)*y(k,57) + rxt(k,282)*y(k,293) + rxt(k,293)*y(k,292)) + mat(k,3833) = -rxt(k,281)*y(k,42) + mat(k,3653) = -rxt(k,282)*y(k,42) + mat(k,2629) = -rxt(k,293)*y(k,42) + mat(k,3358) = -(rxt(k,218)*y(k,57) + rxt(k,254)*y(k,18) + rxt(k,298)*y(k,256) & + rxt(k,299)*y(k,149) + rxt(k,300)*y(k,156) + rxt(k,301) & *y(k,293)) - mat(k,3829) = -rxt(k,218)*y(k,43) - mat(k,1690) = -rxt(k,254)*y(k,43) - mat(k,3287) = -rxt(k,298)*y(k,43) - mat(k,3084) = -rxt(k,299)*y(k,43) - mat(k,3458) = -rxt(k,300)*y(k,43) - mat(k,3748) = -rxt(k,301)*y(k,43) - mat(k,641) = .400_r8*rxt(k,409)*y(k,293) - mat(k,1116) = .270_r8*rxt(k,603)*y(k,157) - mat(k,869) = .080_r8*rxt(k,623)*y(k,157) - mat(k,313) = .500_r8*rxt(k,375)*y(k,149) - mat(k,952) = .810_r8*rxt(k,643)*y(k,157) - mat(k,504) = rxt(k,324)*y(k,157) - mat(k,1206) = .500_r8*rxt(k,355)*y(k,157) - mat(k,470) = .500_r8*rxt(k,341)*y(k,293) - mat(k,1358) = rxt(k,306)*y(k,293) - mat(k,372) = .300_r8*rxt(k,307)*y(k,293) - mat(k,3313) = rxt(k,225)*y(k,251) - mat(k,1472) = .800_r8*rxt(k,346)*y(k,293) - mat(k,725) = .110_r8*rxt(k,348)*y(k,293) - mat(k,1121) = .500_r8*rxt(k,312)*y(k,293) - mat(k,810) = .300_r8*rxt(k,364)*y(k,293) - mat(k,1240) = .500_r8*rxt(k,420)*y(k,293) - mat(k,416) = .400_r8*rxt(k,423)*y(k,293) - mat(k,1092) = .590_r8*rxt(k,424)*y(k,293) - mat(k,1301) = 1.010_r8*rxt(k,487)*y(k,157) - mat(k,972) = .330_r8*rxt(k,663)*y(k,157) - mat(k,1760) = .120_r8*rxt(k,386)*y(k,157) - mat(k,1871) = .600_r8*rxt(k,404)*y(k,157) - mat(k,719) = .390_r8*rxt(k,683)*y(k,157) - mat(k,2891) = .100_r8*rxt(k,411)*y(k,234) + .210_r8*rxt(k,598)*y(k,236) & - + .020_r8*rxt(k,630)*y(k,243) + .490_r8*rxt(k,638)*y(k,244) & - + rxt(k,305)*y(k,251) + .500_r8*rxt(k,378)*y(k,253) & - + .500_r8*rxt(k,343)*y(k,255) + rxt(k,506)*y(k,259) + rxt(k,508) & - *y(k,260) + .060_r8*rxt(k,514)*y(k,267) + .270_r8*rxt(k,516) & - *y(k,268) + rxt(k,518)*y(k,269) + .130_r8*rxt(k,520)*y(k,270) & - + .330_r8*rxt(k,522)*y(k,271) + .460_r8*rxt(k,524)*y(k,272) & - + .530_r8*rxt(k,526)*y(k,273) + .040_r8*rxt(k,528)*y(k,274) & - + .430_r8*rxt(k,658)*y(k,280) + .140_r8*rxt(k,536)*y(k,282) & - + rxt(k,393)*y(k,284) + .240_r8*rxt(k,538)*y(k,287) & - + .040_r8*rxt(k,670)*y(k,288) + .300_r8*rxt(k,678)*y(k,289) & - + rxt(k,367)*y(k,295) + rxt(k,371)*y(k,296) + .310_r8*rxt(k,689) & - *y(k,297) + 1.820_r8*rxt(k,742)*y(k,304) + .310_r8*rxt(k,762) & + mat(k,3860) = -rxt(k,218)*y(k,43) + mat(k,2204) = -rxt(k,254)*y(k,43) + mat(k,3569) = -rxt(k,298)*y(k,43) + mat(k,3954) = -rxt(k,299)*y(k,43) + mat(k,3389) = -rxt(k,300)*y(k,43) + mat(k,3819) = -rxt(k,301)*y(k,43) + mat(k,722) = .400_r8*rxt(k,408)*y(k,293) + mat(k,1259) = .270_r8*rxt(k,602)*y(k,157) + mat(k,1037) = .080_r8*rxt(k,622)*y(k,157) + mat(k,378) = .500_r8*rxt(k,374)*y(k,149) + mat(k,1101) = .810_r8*rxt(k,642)*y(k,157) + mat(k,595) = rxt(k,323)*y(k,157) + mat(k,1374) = .500_r8*rxt(k,354)*y(k,157) + mat(k,703) = .500_r8*rxt(k,340)*y(k,293) + mat(k,1493) = rxt(k,306)*y(k,293) + mat(k,461) = .300_r8*rxt(k,307)*y(k,293) + mat(k,2264) = (rxt(k,316)+rxt(k,317))*y(k,292) + mat(k,2603) = rxt(k,225)*y(k,251) + mat(k,1712) = .800_r8*rxt(k,345)*y(k,293) + mat(k,822) = .110_r8*rxt(k,347)*y(k,293) + mat(k,1210) = .500_r8*rxt(k,311)*y(k,293) + mat(k,965) = .300_r8*rxt(k,363)*y(k,293) + mat(k,921) = .500_r8*rxt(k,419)*y(k,293) + mat(k,494) = .400_r8*rxt(k,422)*y(k,293) + mat(k,1273) = .590_r8*rxt(k,423)*y(k,293) + mat(k,1405) = 1.010_r8*rxt(k,486)*y(k,157) + mat(k,1080) = .330_r8*rxt(k,662)*y(k,157) + mat(k,2028) = .120_r8*rxt(k,385)*y(k,157) + mat(k,2053) = .600_r8*rxt(k,403)*y(k,157) + mat(k,853) = .390_r8*rxt(k,682)*y(k,157) + mat(k,3313) = .100_r8*rxt(k,410)*y(k,234) + .210_r8*rxt(k,597)*y(k,236) & + + .020_r8*rxt(k,629)*y(k,243) + .490_r8*rxt(k,637)*y(k,244) & + + rxt(k,305)*y(k,251) + .500_r8*rxt(k,377)*y(k,253) & + + .500_r8*rxt(k,342)*y(k,255) + rxt(k,505)*y(k,259) + rxt(k,507) & + *y(k,260) + .060_r8*rxt(k,513)*y(k,267) + .270_r8*rxt(k,515) & + *y(k,268) + rxt(k,517)*y(k,269) + .130_r8*rxt(k,519)*y(k,270) & + + .330_r8*rxt(k,521)*y(k,271) + .460_r8*rxt(k,523)*y(k,272) & + + .530_r8*rxt(k,525)*y(k,273) + .040_r8*rxt(k,527)*y(k,274) & + + .430_r8*rxt(k,657)*y(k,280) + .140_r8*rxt(k,535)*y(k,282) & + + rxt(k,392)*y(k,284) + .240_r8*rxt(k,537)*y(k,287) & + + .040_r8*rxt(k,669)*y(k,288) + .300_r8*rxt(k,677)*y(k,289) & + + rxt(k,366)*y(k,295) + rxt(k,370)*y(k,296) + .310_r8*rxt(k,688) & + *y(k,297) + 1.820_r8*rxt(k,741)*y(k,304) + .310_r8*rxt(k,761) & *y(k,306) - mat(k,3084) = mat(k,3084) + .500_r8*rxt(k,375)*y(k,16) + .440_r8*rxt(k,760) & - *y(k,210) + .500_r8*rxt(k,765)*y(k,211) + .270_r8*rxt(k,599) & - *y(k,236) + .020_r8*rxt(k,631)*y(k,243) + .650_r8*rxt(k,639) & - *y(k,244) + .460_r8*rxt(k,479)*y(k,272) + .560_r8*rxt(k,659) & - *y(k,280) + rxt(k,394)*y(k,284) + .040_r8*rxt(k,671)*y(k,288) & - + .420_r8*rxt(k,679)*y(k,289) + 2.000_r8*rxt(k,743)*y(k,304) - mat(k,1273) = rxt(k,349)*y(k,293) - mat(k,2992) = .270_r8*rxt(k,603)*y(k,4) + .080_r8*rxt(k,623)*y(k,7) & - + .810_r8*rxt(k,643)*y(k,17) + rxt(k,324)*y(k,26) & - + .500_r8*rxt(k,355)*y(k,30) + 1.010_r8*rxt(k,487)*y(k,109) & - + .330_r8*rxt(k,663)*y(k,125) + .120_r8*rxt(k,386)*y(k,126) & - + .600_r8*rxt(k,404)*y(k,132) + .390_r8*rxt(k,683)*y(k,135) & - + .620_r8*rxt(k,763)*y(k,210) + .340_r8*rxt(k,768)*y(k,211) - mat(k,401) = rxt(k,350)*y(k,293) - mat(k,511) = 2.000_r8*rxt(k,719)*y(k,293) - mat(k,519) = rxt(k,738)*y(k,293) - mat(k,2432) = .440_r8*rxt(k,760)*y(k,149) + .620_r8*rxt(k,763)*y(k,157) - mat(k,2405) = .500_r8*rxt(k,765)*y(k,149) + .340_r8*rxt(k,768)*y(k,157) - mat(k,1139) = .100_r8*rxt(k,411)*y(k,147) - mat(k,2132) = .950_r8*rxt(k,588)*y(k,251) - mat(k,2228) = .210_r8*rxt(k,598)*y(k,147) + .270_r8*rxt(k,599)*y(k,149) & - + .270_r8*rxt(k,595)*y(k,250) + .830_r8*rxt(k,596)*y(k,251) & - + .080_r8*rxt(k,597)*y(k,256) + .270_r8*rxt(k,600)*y(k,300) & - + .270_r8*rxt(k,601)*y(k,302) + .270_r8*rxt(k,602)*y(k,305) - mat(k,2065) = .950_r8*rxt(k,608)*y(k,251) - mat(k,2110) = .750_r8*rxt(k,616)*y(k,251) - mat(k,2345) = .020_r8*rxt(k,630)*y(k,147) + .020_r8*rxt(k,631)*y(k,149) & - + .080_r8*rxt(k,626)*y(k,243) + .020_r8*rxt(k,627)*y(k,250) & - + .990_r8*rxt(k,628)*y(k,251) + .020_r8*rxt(k,629)*y(k,256) & - + .020_r8*rxt(k,632)*y(k,300) + .020_r8*rxt(k,633)*y(k,302) & - + .020_r8*rxt(k,634)*y(k,305) - mat(k,2257) = .490_r8*rxt(k,638)*y(k,147) + .650_r8*rxt(k,639)*y(k,149) & - + .650_r8*rxt(k,635)*y(k,250) + 1.400_r8*rxt(k,636)*y(k,251) & - + .030_r8*rxt(k,637)*y(k,256) + .650_r8*rxt(k,640)*y(k,300) & - + .650_r8*rxt(k,641)*y(k,302) + .650_r8*rxt(k,642)*y(k,305) - mat(k,1248) = .700_r8*rxt(k,326)*y(k,251) - mat(k,980) = rxt(k,356)*y(k,251) - mat(k,2706) = .270_r8*rxt(k,595)*y(k,236) + .020_r8*rxt(k,627)*y(k,243) & - + .650_r8*rxt(k,635)*y(k,244) + rxt(k,337)*y(k,251) + rxt(k,425) & - *y(k,259) + rxt(k,431)*y(k,260) + .460_r8*rxt(k,475)*y(k,272) & - + .560_r8*rxt(k,655)*y(k,280) + .140_r8*rxt(k,382)*y(k,282) & - + rxt(k,389)*y(k,284) + .250_r8*rxt(k,401)*y(k,287) & - + .040_r8*rxt(k,666)*y(k,288) + .420_r8*rxt(k,675)*y(k,289) & - + 2.000_r8*rxt(k,739)*y(k,304) - mat(k,3428) = rxt(k,225)*y(k,60) + rxt(k,305)*y(k,147) + .950_r8*rxt(k,588) & - *y(k,235) + .830_r8*rxt(k,596)*y(k,236) + .950_r8*rxt(k,608) & - *y(k,238) + .750_r8*rxt(k,616)*y(k,239) + .990_r8*rxt(k,628) & - *y(k,243) + 1.400_r8*rxt(k,636)*y(k,244) + .700_r8*rxt(k,326) & - *y(k,247) + rxt(k,356)*y(k,248) + rxt(k,337)*y(k,250) + ( & + mat(k,3954) = mat(k,3954) + .500_r8*rxt(k,374)*y(k,16) + .440_r8*rxt(k,759) & + *y(k,210) + .500_r8*rxt(k,764)*y(k,211) + .270_r8*rxt(k,598) & + *y(k,236) + .020_r8*rxt(k,630)*y(k,243) + .650_r8*rxt(k,638) & + *y(k,244) + .460_r8*rxt(k,478)*y(k,272) + .560_r8*rxt(k,658) & + *y(k,280) + rxt(k,393)*y(k,284) + .040_r8*rxt(k,670)*y(k,288) & + + .420_r8*rxt(k,678)*y(k,289) + 2.000_r8*rxt(k,742)*y(k,304) + mat(k,1455) = rxt(k,348)*y(k,293) + mat(k,3131) = .270_r8*rxt(k,602)*y(k,4) + .080_r8*rxt(k,622)*y(k,7) & + + .810_r8*rxt(k,642)*y(k,17) + rxt(k,323)*y(k,26) & + + .500_r8*rxt(k,354)*y(k,30) + 1.010_r8*rxt(k,486)*y(k,109) & + + .330_r8*rxt(k,662)*y(k,125) + .120_r8*rxt(k,385)*y(k,126) & + + .600_r8*rxt(k,403)*y(k,132) + .390_r8*rxt(k,682)*y(k,135) & + + .620_r8*rxt(k,762)*y(k,210) + .340_r8*rxt(k,767)*y(k,211) + mat(k,569) = rxt(k,349)*y(k,293) + mat(k,653) = 2.000_r8*rxt(k,718)*y(k,293) + mat(k,662) = rxt(k,737)*y(k,293) + mat(k,2673) = .440_r8*rxt(k,759)*y(k,149) + .620_r8*rxt(k,762)*y(k,157) + mat(k,2357) = .500_r8*rxt(k,764)*y(k,149) + .340_r8*rxt(k,767)*y(k,157) + mat(k,1204) = .100_r8*rxt(k,410)*y(k,147) + mat(k,2307) = .950_r8*rxt(k,587)*y(k,251) + mat(k,2477) = .210_r8*rxt(k,597)*y(k,147) + .270_r8*rxt(k,598)*y(k,149) & + + .270_r8*rxt(k,594)*y(k,250) + .830_r8*rxt(k,595)*y(k,251) & + + .080_r8*rxt(k,596)*y(k,256) + .270_r8*rxt(k,599)*y(k,300) & + + .270_r8*rxt(k,600)*y(k,302) + .270_r8*rxt(k,601)*y(k,305) + mat(k,2223) = .950_r8*rxt(k,607)*y(k,251) + mat(k,2334) = .750_r8*rxt(k,615)*y(k,251) + mat(k,2540) = .020_r8*rxt(k,629)*y(k,147) + .020_r8*rxt(k,630)*y(k,149) & + + .080_r8*rxt(k,625)*y(k,243) + .020_r8*rxt(k,626)*y(k,250) & + + .990_r8*rxt(k,627)*y(k,251) + .020_r8*rxt(k,628)*y(k,256) & + + .020_r8*rxt(k,631)*y(k,300) + .020_r8*rxt(k,632)*y(k,302) & + + .020_r8*rxt(k,633)*y(k,305) + mat(k,2423) = .490_r8*rxt(k,637)*y(k,147) + .650_r8*rxt(k,638)*y(k,149) & + + .650_r8*rxt(k,634)*y(k,250) + 1.400_r8*rxt(k,635)*y(k,251) & + + .030_r8*rxt(k,636)*y(k,256) + .650_r8*rxt(k,639)*y(k,300) & + + .650_r8*rxt(k,640)*y(k,302) + .650_r8*rxt(k,641)*y(k,305) + mat(k,1352) = .700_r8*rxt(k,325)*y(k,251) + mat(k,1046) = rxt(k,355)*y(k,251) + mat(k,3028) = .270_r8*rxt(k,594)*y(k,236) + .020_r8*rxt(k,626)*y(k,243) & + + .650_r8*rxt(k,634)*y(k,244) + rxt(k,336)*y(k,251) + rxt(k,424) & + *y(k,259) + rxt(k,430)*y(k,260) + .460_r8*rxt(k,474)*y(k,272) & + + .560_r8*rxt(k,654)*y(k,280) + .140_r8*rxt(k,381)*y(k,282) & + + rxt(k,388)*y(k,284) + .250_r8*rxt(k,400)*y(k,287) & + + .040_r8*rxt(k,665)*y(k,288) + .420_r8*rxt(k,674)*y(k,289) & + + 2.000_r8*rxt(k,738)*y(k,304) + mat(k,4046) = rxt(k,225)*y(k,60) + rxt(k,305)*y(k,147) + .950_r8*rxt(k,587) & + *y(k,235) + .830_r8*rxt(k,595)*y(k,236) + .950_r8*rxt(k,607) & + *y(k,238) + .750_r8*rxt(k,615)*y(k,239) + .990_r8*rxt(k,627) & + *y(k,243) + 1.400_r8*rxt(k,635)*y(k,244) + .700_r8*rxt(k,325) & + *y(k,247) + rxt(k,355)*y(k,248) + rxt(k,336)*y(k,250) + ( & + 4.000_r8*rxt(k,302)+2.000_r8*rxt(k,303))*y(k,251) & - + 1.750_r8*rxt(k,426)*y(k,259) + 1.250_r8*rxt(k,432)*y(k,260) & - + .750_r8*rxt(k,446)*y(k,265) + .750_r8*rxt(k,450)*y(k,266) & - + .710_r8*rxt(k,476)*y(k,272) + .750_r8*rxt(k,493)*y(k,276) & - + .750_r8*rxt(k,497)*y(k,277) + .910_r8*rxt(k,647)*y(k,279) & - + 1.030_r8*rxt(k,656)*y(k,280) + 1.100_r8*rxt(k,383)*y(k,282) & - + 2.000_r8*rxt(k,390)*y(k,284) + .870_r8*rxt(k,402)*y(k,287) & - + .980_r8*rxt(k,667)*y(k,288) + .750_r8*rxt(k,676)*y(k,289) & - + .800_r8*rxt(k,369)*y(k,296) + .750_r8*rxt(k,695)*y(k,299) & - + rxt(k,703)*y(k,300) + rxt(k,711)*y(k,301) + rxt(k,721) & - *y(k,302) + rxt(k,730)*y(k,303) + 3.000_r8*rxt(k,740)*y(k,304) & - + rxt(k,751)*y(k,305) - mat(k,540) = .500_r8*rxt(k,378)*y(k,147) - mat(k,748) = .500_r8*rxt(k,343)*y(k,147) - mat(k,3287) = mat(k,3287) + .080_r8*rxt(k,597)*y(k,236) + .020_r8*rxt(k,629) & - *y(k,243) + .030_r8*rxt(k,637)*y(k,244) + .060_r8*rxt(k,427) & - *y(k,259) + .060_r8*rxt(k,433)*y(k,260) + .030_r8*rxt(k,458) & - *y(k,267) + .060_r8*rxt(k,462)*y(k,268) + .600_r8*rxt(k,465) & - *y(k,269) + .060_r8*rxt(k,468)*y(k,270) + .100_r8*rxt(k,472) & - *y(k,271) + .240_r8*rxt(k,477)*y(k,272) + .170_r8*rxt(k,480) & - *y(k,273) + .030_r8*rxt(k,483)*y(k,274) + .060_r8*rxt(k,657) & - *y(k,280) + .080_r8*rxt(k,384)*y(k,282) + .490_r8*rxt(k,391) & - *y(k,284) + .050_r8*rxt(k,403)*y(k,287) + .020_r8*rxt(k,668) & - *y(k,288) + .040_r8*rxt(k,677)*y(k,289) + .150_r8*rxt(k,370) & - *y(k,296) + .080_r8*rxt(k,688)*y(k,297) + 1.060_r8*rxt(k,741) & - *y(k,304) + .040_r8*rxt(k,761)*y(k,306) - mat(k,1839) = rxt(k,506)*y(k,147) + rxt(k,425)*y(k,250) + 1.750_r8*rxt(k,426) & - *y(k,251) + .060_r8*rxt(k,427)*y(k,256) - mat(k,1741) = rxt(k,508)*y(k,147) + rxt(k,431)*y(k,250) + 1.250_r8*rxt(k,432) & - *y(k,251) + .060_r8*rxt(k,433)*y(k,256) - mat(k,1561) = .750_r8*rxt(k,446)*y(k,251) - mat(k,1582) = .750_r8*rxt(k,450)*y(k,251) - mat(k,1007) = .060_r8*rxt(k,514)*y(k,147) + .030_r8*rxt(k,458)*y(k,256) - mat(k,1080) = .270_r8*rxt(k,516)*y(k,147) + .060_r8*rxt(k,462)*y(k,256) - mat(k,992) = rxt(k,518)*y(k,147) + .600_r8*rxt(k,465)*y(k,256) - mat(k,1018) = .130_r8*rxt(k,520)*y(k,147) + .060_r8*rxt(k,468)*y(k,256) - mat(k,1326) = .330_r8*rxt(k,522)*y(k,147) + .100_r8*rxt(k,472)*y(k,256) - mat(k,2043) = .460_r8*rxt(k,524)*y(k,147) + .460_r8*rxt(k,479)*y(k,149) & - + .460_r8*rxt(k,475)*y(k,250) + .710_r8*rxt(k,476)*y(k,251) & - + .240_r8*rxt(k,477)*y(k,256) + .320_r8*rxt(k,478)*y(k,272) - mat(k,1191) = .530_r8*rxt(k,526)*y(k,147) + .170_r8*rxt(k,480)*y(k,256) - mat(k,1267) = .040_r8*rxt(k,528)*y(k,147) + .030_r8*rxt(k,483)*y(k,256) - mat(k,1791) = .750_r8*rxt(k,493)*y(k,251) - mat(k,1679) = .750_r8*rxt(k,497)*y(k,251) - mat(k,2318) = .910_r8*rxt(k,647)*y(k,251) - mat(k,2171) = .430_r8*rxt(k,658)*y(k,147) + .560_r8*rxt(k,659)*y(k,149) & - + .560_r8*rxt(k,655)*y(k,250) + 1.030_r8*rxt(k,656)*y(k,251) & - + .060_r8*rxt(k,657)*y(k,256) + .560_r8*rxt(k,660)*y(k,300) & - + .560_r8*rxt(k,661)*y(k,302) + .560_r8*rxt(k,662)*y(k,305) - mat(k,1392) = .140_r8*rxt(k,536)*y(k,147) + .140_r8*rxt(k,382)*y(k,250) & - + 1.100_r8*rxt(k,383)*y(k,251) + .080_r8*rxt(k,384)*y(k,256) - mat(k,1505) = rxt(k,393)*y(k,147) + rxt(k,394)*y(k,149) + rxt(k,389)*y(k,250) & - + 2.000_r8*rxt(k,390)*y(k,251) + .490_r8*rxt(k,391)*y(k,256) & - + 4.000_r8*rxt(k,392)*y(k,284) - mat(k,1378) = .240_r8*rxt(k,538)*y(k,147) + .250_r8*rxt(k,401)*y(k,250) & - + .870_r8*rxt(k,402)*y(k,251) + .050_r8*rxt(k,403)*y(k,256) - mat(k,2379) = .040_r8*rxt(k,670)*y(k,147) + .040_r8*rxt(k,671)*y(k,149) & - + .040_r8*rxt(k,666)*y(k,250) + .980_r8*rxt(k,667)*y(k,251) & - + .020_r8*rxt(k,668)*y(k,256) + .120_r8*rxt(k,669)*y(k,288) & - + .040_r8*rxt(k,672)*y(k,300) + .040_r8*rxt(k,673)*y(k,302) & - + .040_r8*rxt(k,674)*y(k,305) - mat(k,2286) = .300_r8*rxt(k,678)*y(k,147) + .420_r8*rxt(k,679)*y(k,149) & - + .420_r8*rxt(k,675)*y(k,250) + .750_r8*rxt(k,676)*y(k,251) & - + .040_r8*rxt(k,677)*y(k,256) + .420_r8*rxt(k,680)*y(k,300) & - + .420_r8*rxt(k,681)*y(k,302) + .420_r8*rxt(k,682)*y(k,305) - mat(k,3748) = mat(k,3748) + .400_r8*rxt(k,409)*y(k,1) + .500_r8*rxt(k,341) & + + 1.750_r8*rxt(k,425)*y(k,259) + 1.250_r8*rxt(k,431)*y(k,260) & + + .750_r8*rxt(k,445)*y(k,265) + .750_r8*rxt(k,449)*y(k,266) & + + .710_r8*rxt(k,475)*y(k,272) + .750_r8*rxt(k,492)*y(k,276) & + + .750_r8*rxt(k,496)*y(k,277) + .910_r8*rxt(k,646)*y(k,279) & + + 1.030_r8*rxt(k,655)*y(k,280) + 1.100_r8*rxt(k,382)*y(k,282) & + + 2.000_r8*rxt(k,389)*y(k,284) + .870_r8*rxt(k,401)*y(k,287) & + + .980_r8*rxt(k,666)*y(k,288) + .750_r8*rxt(k,675)*y(k,289) & + + .800_r8*rxt(k,368)*y(k,296) + .750_r8*rxt(k,694)*y(k,299) & + + rxt(k,702)*y(k,300) + rxt(k,710)*y(k,301) + rxt(k,720) & + *y(k,302) + rxt(k,729)*y(k,303) + 3.000_r8*rxt(k,739)*y(k,304) & + + rxt(k,750)*y(k,305) + mat(k,607) = .500_r8*rxt(k,377)*y(k,147) + mat(k,862) = .500_r8*rxt(k,342)*y(k,147) + mat(k,3569) = mat(k,3569) + .080_r8*rxt(k,596)*y(k,236) + .020_r8*rxt(k,628) & + *y(k,243) + .030_r8*rxt(k,636)*y(k,244) + .060_r8*rxt(k,426) & + *y(k,259) + .060_r8*rxt(k,432)*y(k,260) + .030_r8*rxt(k,457) & + *y(k,267) + .060_r8*rxt(k,461)*y(k,268) + .600_r8*rxt(k,464) & + *y(k,269) + .060_r8*rxt(k,467)*y(k,270) + .100_r8*rxt(k,471) & + *y(k,271) + .240_r8*rxt(k,476)*y(k,272) + .170_r8*rxt(k,479) & + *y(k,273) + .030_r8*rxt(k,482)*y(k,274) + .060_r8*rxt(k,656) & + *y(k,280) + .080_r8*rxt(k,383)*y(k,282) + .490_r8*rxt(k,390) & + *y(k,284) + .050_r8*rxt(k,402)*y(k,287) + .020_r8*rxt(k,667) & + *y(k,288) + .040_r8*rxt(k,676)*y(k,289) + .150_r8*rxt(k,369) & + *y(k,296) + .080_r8*rxt(k,687)*y(k,297) + 1.060_r8*rxt(k,740) & + *y(k,304) + .040_r8*rxt(k,760)*y(k,306) + mat(k,1967) = rxt(k,505)*y(k,147) + rxt(k,424)*y(k,250) + 1.750_r8*rxt(k,425) & + *y(k,251) + .060_r8*rxt(k,426)*y(k,256) + mat(k,2006) = rxt(k,507)*y(k,147) + rxt(k,430)*y(k,250) + 1.250_r8*rxt(k,431) & + *y(k,251) + .060_r8*rxt(k,432)*y(k,256) + mat(k,1750) = .750_r8*rxt(k,445)*y(k,251) + mat(k,1778) = .750_r8*rxt(k,449)*y(k,251) + mat(k,1126) = .060_r8*rxt(k,513)*y(k,147) + .030_r8*rxt(k,457)*y(k,256) + mat(k,1172) = .270_r8*rxt(k,515)*y(k,147) + .060_r8*rxt(k,461)*y(k,256) + mat(k,1058) = rxt(k,517)*y(k,147) + .600_r8*rxt(k,464)*y(k,256) + mat(k,1137) = .130_r8*rxt(k,519)*y(k,147) + .060_r8*rxt(k,467)*y(k,256) + mat(k,1448) = .330_r8*rxt(k,521)*y(k,147) + .100_r8*rxt(k,471)*y(k,256) + mat(k,2188) = .460_r8*rxt(k,523)*y(k,147) + .460_r8*rxt(k,478)*y(k,149) & + + .460_r8*rxt(k,474)*y(k,250) + .710_r8*rxt(k,475)*y(k,251) & + + .240_r8*rxt(k,476)*y(k,256) + .320_r8*rxt(k,477)*y(k,272) + mat(k,1317) = .530_r8*rxt(k,525)*y(k,147) + .170_r8*rxt(k,479)*y(k,256) + mat(k,1425) = .040_r8*rxt(k,527)*y(k,147) + .030_r8*rxt(k,482)*y(k,256) + mat(k,1857) = .750_r8*rxt(k,492)*y(k,251) + mat(k,1826) = .750_r8*rxt(k,496)*y(k,251) + mat(k,2511) = .910_r8*rxt(k,646)*y(k,251) + mat(k,2393) = .430_r8*rxt(k,657)*y(k,147) + .560_r8*rxt(k,658)*y(k,149) & + + .560_r8*rxt(k,654)*y(k,250) + 1.030_r8*rxt(k,655)*y(k,251) & + + .060_r8*rxt(k,656)*y(k,256) + .560_r8*rxt(k,659)*y(k,300) & + + .560_r8*rxt(k,660)*y(k,302) + .560_r8*rxt(k,661)*y(k,305) + mat(k,1550) = .140_r8*rxt(k,535)*y(k,147) + .140_r8*rxt(k,381)*y(k,250) & + + 1.100_r8*rxt(k,382)*y(k,251) + .080_r8*rxt(k,383)*y(k,256) + mat(k,1624) = rxt(k,392)*y(k,147) + rxt(k,393)*y(k,149) + rxt(k,388)*y(k,250) & + + 2.000_r8*rxt(k,389)*y(k,251) + .490_r8*rxt(k,390)*y(k,256) & + + 4.000_r8*rxt(k,391)*y(k,284) + mat(k,1514) = .240_r8*rxt(k,537)*y(k,147) + .250_r8*rxt(k,400)*y(k,250) & + + .870_r8*rxt(k,401)*y(k,251) + .050_r8*rxt(k,402)*y(k,256) + mat(k,2712) = .040_r8*rxt(k,669)*y(k,147) + .040_r8*rxt(k,670)*y(k,149) & + + .040_r8*rxt(k,665)*y(k,250) + .980_r8*rxt(k,666)*y(k,251) & + + .020_r8*rxt(k,667)*y(k,256) + .120_r8*rxt(k,668)*y(k,288) & + + .040_r8*rxt(k,671)*y(k,300) + .040_r8*rxt(k,672)*y(k,302) & + + .040_r8*rxt(k,673)*y(k,305) + mat(k,2815) = .300_r8*rxt(k,677)*y(k,147) + .420_r8*rxt(k,678)*y(k,149) & + + .420_r8*rxt(k,674)*y(k,250) + .750_r8*rxt(k,675)*y(k,251) & + + .040_r8*rxt(k,676)*y(k,256) + .420_r8*rxt(k,679)*y(k,300) & + + .420_r8*rxt(k,680)*y(k,302) + .420_r8*rxt(k,681)*y(k,305) + mat(k,2644) = (rxt(k,316)+rxt(k,317))*y(k,55) + mat(k,3819) = mat(k,3819) + .400_r8*rxt(k,408)*y(k,1) + .500_r8*rxt(k,340) & *y(k,52) + rxt(k,306)*y(k,53) + .300_r8*rxt(k,307)*y(k,54) & - + .800_r8*rxt(k,346)*y(k,76) + .110_r8*rxt(k,348)*y(k,89) & - + .500_r8*rxt(k,312)*y(k,92) + .300_r8*rxt(k,364)*y(k,104) & - + .500_r8*rxt(k,420)*y(k,105) + .400_r8*rxt(k,423)*y(k,107) & - + .590_r8*rxt(k,424)*y(k,108) + rxt(k,349)*y(k,150) + rxt(k,350) & - *y(k,162) + 2.000_r8*rxt(k,719)*y(k,202) + rxt(k,738)*y(k,204) - mat(k,827) = rxt(k,367)*y(k,147) - mat(k,1231) = rxt(k,371)*y(k,147) + .800_r8*rxt(k,369)*y(k,251) & - + .150_r8*rxt(k,370)*y(k,256) - mat(k,840) = .310_r8*rxt(k,689)*y(k,147) + .080_r8*rxt(k,688)*y(k,256) - mat(k,2457) = .750_r8*rxt(k,695)*y(k,251) - mat(k,2542) = .270_r8*rxt(k,600)*y(k,236) + .020_r8*rxt(k,632)*y(k,243) & - + .650_r8*rxt(k,640)*y(k,244) + rxt(k,703)*y(k,251) & + + .800_r8*rxt(k,345)*y(k,76) + .110_r8*rxt(k,347)*y(k,89) & + + .500_r8*rxt(k,311)*y(k,92) + .300_r8*rxt(k,363)*y(k,104) & + + .500_r8*rxt(k,419)*y(k,105) + .400_r8*rxt(k,422)*y(k,107) & + + .590_r8*rxt(k,423)*y(k,108) + rxt(k,348)*y(k,150) + rxt(k,349) & + *y(k,162) + 2.000_r8*rxt(k,718)*y(k,202) + rxt(k,737)*y(k,204) + mat(k,936) = rxt(k,366)*y(k,147) + mat(k,1340) = rxt(k,370)*y(k,147) + .800_r8*rxt(k,368)*y(k,251) & + + .150_r8*rxt(k,369)*y(k,256) + mat(k,949) = .310_r8*rxt(k,688)*y(k,147) + .080_r8*rxt(k,687)*y(k,256) + mat(k,2737) = .750_r8*rxt(k,694)*y(k,251) + mat(k,2954) = .270_r8*rxt(k,599)*y(k,236) + .020_r8*rxt(k,631)*y(k,243) & + + .650_r8*rxt(k,639)*y(k,244) + rxt(k,702)*y(k,251) & + + .560_r8*rxt(k,659)*y(k,280) + .040_r8*rxt(k,671)*y(k,288) & + + .420_r8*rxt(k,679)*y(k,289) + 2.000_r8*rxt(k,743)*y(k,304) + mat(k,2782) = rxt(k,710)*y(k,251) + mat(k,2861) = .270_r8*rxt(k,600)*y(k,236) + .020_r8*rxt(k,632)*y(k,243) & + + .650_r8*rxt(k,640)*y(k,244) + rxt(k,720)*y(k,251) & + .560_r8*rxt(k,660)*y(k,280) + .040_r8*rxt(k,672)*y(k,288) & + .420_r8*rxt(k,680)*y(k,289) + 2.000_r8*rxt(k,744)*y(k,304) - mat(k,2499) = rxt(k,711)*y(k,251) - mat(k,2588) = .270_r8*rxt(k,601)*y(k,236) + .020_r8*rxt(k,633)*y(k,243) & - + .650_r8*rxt(k,641)*y(k,244) + rxt(k,721)*y(k,251) & + mat(k,2247) = rxt(k,729)*y(k,251) + mat(k,2759) = 1.820_r8*rxt(k,741)*y(k,147) + 2.000_r8*rxt(k,742)*y(k,149) & + + 2.000_r8*rxt(k,738)*y(k,250) + 3.000_r8*rxt(k,739)*y(k,251) & + + 1.060_r8*rxt(k,740)*y(k,256) + 2.000_r8*rxt(k,743)*y(k,300) & + + 2.000_r8*rxt(k,744)*y(k,302) + 2.000_r8*rxt(k,745)*y(k,305) + mat(k,2908) = .270_r8*rxt(k,601)*y(k,236) + .020_r8*rxt(k,633)*y(k,243) & + + .650_r8*rxt(k,641)*y(k,244) + rxt(k,750)*y(k,251) & + .560_r8*rxt(k,661)*y(k,280) + .040_r8*rxt(k,673)*y(k,288) & + .420_r8*rxt(k,681)*y(k,289) + 2.000_r8*rxt(k,745)*y(k,304) - mat(k,2087) = rxt(k,730)*y(k,251) - mat(k,2478) = 1.820_r8*rxt(k,742)*y(k,147) + 2.000_r8*rxt(k,743)*y(k,149) & - + 2.000_r8*rxt(k,739)*y(k,250) + 3.000_r8*rxt(k,740)*y(k,251) & - + 1.060_r8*rxt(k,741)*y(k,256) + 2.000_r8*rxt(k,744)*y(k,300) & - + 2.000_r8*rxt(k,745)*y(k,302) + 2.000_r8*rxt(k,746)*y(k,305) - mat(k,2635) = .270_r8*rxt(k,602)*y(k,236) + .020_r8*rxt(k,634)*y(k,243) & - + .650_r8*rxt(k,642)*y(k,244) + rxt(k,751)*y(k,251) & - + .560_r8*rxt(k,662)*y(k,280) + .040_r8*rxt(k,674)*y(k,288) & - + .420_r8*rxt(k,682)*y(k,289) + 2.000_r8*rxt(k,746)*y(k,304) - mat(k,685) = .310_r8*rxt(k,762)*y(k,147) + .040_r8*rxt(k,761)*y(k,256) + mat(k,799) = .310_r8*rxt(k,761)*y(k,147) + .040_r8*rxt(k,760)*y(k,256) end do end subroutine nlnmat01 subroutine nlnmat02( avec_len, mat, y, rxt ) @@ -366,211 +401,258 @@ subroutine nlnmat02( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,1305) = -(rxt(k,333)*y(k,149) + rxt(k,334)*y(k,293)) - mat(k,3022) = -rxt(k,333)*y(k,46) - mat(k,3674) = -rxt(k,334)*y(k,46) - mat(k,637) = .800_r8*rxt(k,409)*y(k,293) - mat(k,310) = rxt(k,375)*y(k,149) - mat(k,219) = rxt(k,329)*y(k,293) - mat(k,293) = .500_r8*rxt(k,330)*y(k,293) - mat(k,1198) = .500_r8*rxt(k,355)*y(k,157) - mat(k,1855) = .100_r8*rxt(k,404)*y(k,157) - mat(k,2820) = .400_r8*rxt(k,411)*y(k,234) + rxt(k,328)*y(k,247) & - + .270_r8*rxt(k,358)*y(k,248) + rxt(k,378)*y(k,253) + rxt(k,396) & - *y(k,286) + rxt(k,367)*y(k,295) - mat(k,3022) = mat(k,3022) + rxt(k,375)*y(k,16) - mat(k,2931) = .500_r8*rxt(k,355)*y(k,30) + .100_r8*rxt(k,404)*y(k,132) - mat(k,1134) = .400_r8*rxt(k,411)*y(k,147) - mat(k,1244) = rxt(k,328)*y(k,147) + 3.200_r8*rxt(k,325)*y(k,247) & - + .800_r8*rxt(k,326)*y(k,251) - mat(k,976) = .270_r8*rxt(k,358)*y(k,147) - mat(k,3359) = .800_r8*rxt(k,326)*y(k,247) - mat(k,536) = rxt(k,378)*y(k,147) - mat(k,3213) = .200_r8*rxt(k,395)*y(k,286) - mat(k,657) = rxt(k,396)*y(k,147) + .200_r8*rxt(k,395)*y(k,256) - mat(k,3674) = mat(k,3674) + .800_r8*rxt(k,409)*y(k,1) + rxt(k,329)*y(k,27) & - + .500_r8*rxt(k,330)*y(k,28) - mat(k,823) = rxt(k,367)*y(k,147) - mat(k,106) = -(rxt(k,335)*y(k,293)) - mat(k,3535) = -rxt(k,335)*y(k,48) - mat(k,2141) = -(rxt(k,374)*y(k,293)) - mat(k,3721) = -rxt(k,374)*y(k,49) - mat(k,638) = .800_r8*rxt(k,409)*y(k,293) - mat(k,311) = .500_r8*rxt(k,375)*y(k,149) - mat(k,712) = .250_r8*rxt(k,683)*y(k,157) - mat(k,2864) = .250_r8*rxt(k,411)*y(k,234) + .090_r8*rxt(k,598)*y(k,236) & - + .080_r8*rxt(k,638)*y(k,244) + .820_r8*rxt(k,358)*y(k,248) & - + .500_r8*rxt(k,378)*y(k,253) + .850_r8*rxt(k,670)*y(k,288) & - + .330_r8*rxt(k,678)*y(k,289) + .700_r8*rxt(k,732)*y(k,303) - mat(k,3057) = .500_r8*rxt(k,375)*y(k,16) + .120_r8*rxt(k,599)*y(k,236) & - + .110_r8*rxt(k,639)*y(k,244) + .910_r8*rxt(k,671)*y(k,288) & - + .460_r8*rxt(k,679)*y(k,289) + rxt(k,733)*y(k,303) - mat(k,2965) = .250_r8*rxt(k,683)*y(k,135) - mat(k,508) = rxt(k,719)*y(k,293) - mat(k,1135) = .250_r8*rxt(k,411)*y(k,147) - mat(k,2211) = .090_r8*rxt(k,598)*y(k,147) + .120_r8*rxt(k,599)*y(k,149) & - + .120_r8*rxt(k,595)*y(k,250) + .060_r8*rxt(k,596)*y(k,251) & - + .060_r8*rxt(k,597)*y(k,256) + .120_r8*rxt(k,600)*y(k,300) & - + .120_r8*rxt(k,601)*y(k,302) + .120_r8*rxt(k,602)*y(k,305) - mat(k,2240) = .080_r8*rxt(k,638)*y(k,147) + .110_r8*rxt(k,639)*y(k,149) & - + .110_r8*rxt(k,635)*y(k,250) + .080_r8*rxt(k,636)*y(k,251) & - + .110_r8*rxt(k,640)*y(k,300) + .110_r8*rxt(k,641)*y(k,302) & - + .110_r8*rxt(k,642)*y(k,305) - mat(k,977) = .820_r8*rxt(k,358)*y(k,147) + .820_r8*rxt(k,356)*y(k,251) - mat(k,2681) = .120_r8*rxt(k,595)*y(k,236) + .110_r8*rxt(k,635)*y(k,244) & - + .910_r8*rxt(k,666)*y(k,288) + .460_r8*rxt(k,675)*y(k,289) & - + rxt(k,729)*y(k,303) - mat(k,3401) = .060_r8*rxt(k,596)*y(k,236) + .080_r8*rxt(k,636)*y(k,244) & - + .820_r8*rxt(k,356)*y(k,248) + .100_r8*rxt(k,383)*y(k,282) & - + .740_r8*rxt(k,667)*y(k,288) + rxt(k,730)*y(k,303) - mat(k,537) = .500_r8*rxt(k,378)*y(k,147) - mat(k,3260) = .060_r8*rxt(k,597)*y(k,236) + .460_r8*rxt(k,668)*y(k,288) & - + .050_r8*rxt(k,677)*y(k,289) + .150_r8*rxt(k,731)*y(k,303) - mat(k,1388) = .100_r8*rxt(k,383)*y(k,251) - mat(k,2361) = .850_r8*rxt(k,670)*y(k,147) + .910_r8*rxt(k,671)*y(k,149) & - + .910_r8*rxt(k,666)*y(k,250) + .740_r8*rxt(k,667)*y(k,251) & - + .460_r8*rxt(k,668)*y(k,256) + 2.960_r8*rxt(k,669)*y(k,288) & - + .910_r8*rxt(k,672)*y(k,300) + .910_r8*rxt(k,673)*y(k,302) & - + .910_r8*rxt(k,674)*y(k,305) - mat(k,2268) = .330_r8*rxt(k,678)*y(k,147) + .460_r8*rxt(k,679)*y(k,149) & - + .460_r8*rxt(k,675)*y(k,250) + .050_r8*rxt(k,677)*y(k,256) & - + .460_r8*rxt(k,680)*y(k,300) + .460_r8*rxt(k,681)*y(k,302) & - + .460_r8*rxt(k,682)*y(k,305) - mat(k,3721) = mat(k,3721) + .800_r8*rxt(k,409)*y(k,1) + rxt(k,719)*y(k,202) - mat(k,2517) = .120_r8*rxt(k,600)*y(k,236) + .110_r8*rxt(k,640)*y(k,244) & + mat(k,639) = -(rxt(k,283)*y(k,57) + rxt(k,284)*y(k,293) + rxt(k,294)*y(k,292)) + mat(k,3835) = -rxt(k,283)*y(k,44) + mat(k,3669) = -rxt(k,284)*y(k,44) + mat(k,2630) = -rxt(k,294)*y(k,44) + mat(k,144) = -(rxt(k,285)*y(k,293)) + mat(k,3598) = -rxt(k,285)*y(k,45) + mat(k,1429) = -(rxt(k,332)*y(k,149) + rxt(k,333)*y(k,293)) + mat(k,3890) = -rxt(k,332)*y(k,46) + mat(k,3741) = -rxt(k,333)*y(k,46) + mat(k,719) = .800_r8*rxt(k,408)*y(k,293) + mat(k,376) = rxt(k,374)*y(k,149) + mat(k,281) = rxt(k,328)*y(k,293) + mat(k,357) = .500_r8*rxt(k,329)*y(k,293) + mat(k,1366) = .500_r8*rxt(k,354)*y(k,157) + mat(k,2038) = .100_r8*rxt(k,403)*y(k,157) + mat(k,3238) = .400_r8*rxt(k,410)*y(k,234) + rxt(k,327)*y(k,247) & + + .270_r8*rxt(k,357)*y(k,248) + rxt(k,377)*y(k,253) + rxt(k,395) & + *y(k,286) + rxt(k,366)*y(k,295) + mat(k,3890) = mat(k,3890) + rxt(k,374)*y(k,16) + mat(k,3066) = .500_r8*rxt(k,354)*y(k,30) + .100_r8*rxt(k,403)*y(k,132) + mat(k,1200) = .400_r8*rxt(k,410)*y(k,147) + mat(k,1349) = rxt(k,327)*y(k,147) + 3.200_r8*rxt(k,324)*y(k,247) & + + .800_r8*rxt(k,325)*y(k,251) + mat(k,1043) = .270_r8*rxt(k,357)*y(k,147) + mat(k,3975) = .800_r8*rxt(k,325)*y(k,247) + mat(k,604) = rxt(k,377)*y(k,147) + mat(k,3492) = .200_r8*rxt(k,394)*y(k,286) + mat(k,739) = rxt(k,395)*y(k,147) + .200_r8*rxt(k,394)*y(k,256) + mat(k,3741) = mat(k,3741) + .800_r8*rxt(k,408)*y(k,1) + rxt(k,328)*y(k,27) & + + .500_r8*rxt(k,329)*y(k,28) + mat(k,933) = rxt(k,366)*y(k,147) + mat(k,390) = -(rxt(k,286)*y(k,57) + rxt(k,287)*y(k,293)) + mat(k,3831) = -rxt(k,286)*y(k,47) + mat(k,3635) = -rxt(k,287)*y(k,47) + mat(k,121) = -(rxt(k,334)*y(k,293)) + mat(k,3596) = -rxt(k,334)*y(k,48) + mat(k,2277) = -(rxt(k,373)*y(k,293)) + mat(k,3790) = -rxt(k,373)*y(k,49) + mat(k,720) = .800_r8*rxt(k,408)*y(k,293) + mat(k,377) = .500_r8*rxt(k,374)*y(k,149) + mat(k,848) = .250_r8*rxt(k,682)*y(k,157) + mat(k,3284) = .250_r8*rxt(k,410)*y(k,234) + .090_r8*rxt(k,597)*y(k,236) & + + .080_r8*rxt(k,637)*y(k,244) + .820_r8*rxt(k,357)*y(k,248) & + + .500_r8*rxt(k,377)*y(k,253) + .850_r8*rxt(k,669)*y(k,288) & + + .330_r8*rxt(k,677)*y(k,289) + .700_r8*rxt(k,731)*y(k,303) + mat(k,3925) = .500_r8*rxt(k,374)*y(k,16) + .120_r8*rxt(k,598)*y(k,236) & + + .110_r8*rxt(k,638)*y(k,244) + .910_r8*rxt(k,670)*y(k,288) & + + .460_r8*rxt(k,678)*y(k,289) + rxt(k,732)*y(k,303) + mat(k,3102) = .250_r8*rxt(k,682)*y(k,135) + mat(k,651) = rxt(k,718)*y(k,293) + mat(k,1201) = .250_r8*rxt(k,410)*y(k,147) + mat(k,2463) = .090_r8*rxt(k,597)*y(k,147) + .120_r8*rxt(k,598)*y(k,149) & + + .120_r8*rxt(k,594)*y(k,250) + .060_r8*rxt(k,595)*y(k,251) & + + .060_r8*rxt(k,596)*y(k,256) + .120_r8*rxt(k,599)*y(k,300) & + + .120_r8*rxt(k,600)*y(k,302) + .120_r8*rxt(k,601)*y(k,305) + mat(k,2409) = .080_r8*rxt(k,637)*y(k,147) + .110_r8*rxt(k,638)*y(k,149) & + + .110_r8*rxt(k,634)*y(k,250) + .080_r8*rxt(k,635)*y(k,251) & + + .110_r8*rxt(k,639)*y(k,300) + .110_r8*rxt(k,640)*y(k,302) & + + .110_r8*rxt(k,641)*y(k,305) + mat(k,1044) = .820_r8*rxt(k,357)*y(k,147) + .820_r8*rxt(k,355)*y(k,251) + mat(k,3001) = .120_r8*rxt(k,594)*y(k,236) + .110_r8*rxt(k,634)*y(k,244) & + + .910_r8*rxt(k,665)*y(k,288) + .460_r8*rxt(k,674)*y(k,289) & + + rxt(k,728)*y(k,303) + mat(k,4018) = .060_r8*rxt(k,595)*y(k,236) + .080_r8*rxt(k,635)*y(k,244) & + + .820_r8*rxt(k,355)*y(k,248) + .100_r8*rxt(k,382)*y(k,282) & + + .740_r8*rxt(k,666)*y(k,288) + rxt(k,729)*y(k,303) + mat(k,605) = .500_r8*rxt(k,377)*y(k,147) + mat(k,3540) = .060_r8*rxt(k,596)*y(k,236) + .460_r8*rxt(k,667)*y(k,288) & + + .050_r8*rxt(k,676)*y(k,289) + .150_r8*rxt(k,730)*y(k,303) + mat(k,1547) = .100_r8*rxt(k,382)*y(k,251) + mat(k,2694) = .850_r8*rxt(k,669)*y(k,147) + .910_r8*rxt(k,670)*y(k,149) & + + .910_r8*rxt(k,665)*y(k,250) + .740_r8*rxt(k,666)*y(k,251) & + + .460_r8*rxt(k,667)*y(k,256) + 2.960_r8*rxt(k,668)*y(k,288) & + + .910_r8*rxt(k,671)*y(k,300) + .910_r8*rxt(k,672)*y(k,302) & + + .910_r8*rxt(k,673)*y(k,305) + mat(k,2798) = .330_r8*rxt(k,677)*y(k,147) + .460_r8*rxt(k,678)*y(k,149) & + + .460_r8*rxt(k,674)*y(k,250) + .050_r8*rxt(k,676)*y(k,256) & + + .460_r8*rxt(k,679)*y(k,300) + .460_r8*rxt(k,680)*y(k,302) & + + .460_r8*rxt(k,681)*y(k,305) + mat(k,3790) = mat(k,3790) + .800_r8*rxt(k,408)*y(k,1) + rxt(k,718)*y(k,202) + mat(k,2929) = .120_r8*rxt(k,599)*y(k,236) + .110_r8*rxt(k,639)*y(k,244) & + + .910_r8*rxt(k,671)*y(k,288) + .460_r8*rxt(k,679)*y(k,289) & + + rxt(k,733)*y(k,303) + mat(k,2836) = .120_r8*rxt(k,600)*y(k,236) + .110_r8*rxt(k,640)*y(k,244) & + .910_r8*rxt(k,672)*y(k,288) + .460_r8*rxt(k,680)*y(k,289) & + rxt(k,734)*y(k,303) - mat(k,2563) = .120_r8*rxt(k,601)*y(k,236) + .110_r8*rxt(k,641)*y(k,244) & + mat(k,2236) = .700_r8*rxt(k,731)*y(k,147) + rxt(k,732)*y(k,149) + rxt(k,728) & + *y(k,250) + rxt(k,729)*y(k,251) + .150_r8*rxt(k,730)*y(k,256) & + + rxt(k,733)*y(k,300) + rxt(k,734)*y(k,302) + rxt(k,735) & + *y(k,305) + mat(k,2883) = .120_r8*rxt(k,601)*y(k,236) + .110_r8*rxt(k,641)*y(k,244) & + .910_r8*rxt(k,673)*y(k,288) + .460_r8*rxt(k,681)*y(k,289) & + rxt(k,735)*y(k,303) - mat(k,2073) = .700_r8*rxt(k,732)*y(k,147) + rxt(k,733)*y(k,149) + rxt(k,729) & - *y(k,250) + rxt(k,730)*y(k,251) + .150_r8*rxt(k,731)*y(k,256) & - + rxt(k,734)*y(k,300) + rxt(k,735)*y(k,302) + rxt(k,736) & - *y(k,305) - mat(k,2610) = .120_r8*rxt(k,602)*y(k,236) + .110_r8*rxt(k,642)*y(k,244) & - + .910_r8*rxt(k,674)*y(k,288) + .460_r8*rxt(k,682)*y(k,289) & - + rxt(k,736)*y(k,303) - mat(k,1845) = -(rxt(k,361)*y(k,149) + rxt(k,362)*y(k,293)) - mat(k,3046) = -rxt(k,361)*y(k,50) - mat(k,3711) = -rxt(k,362)*y(k,50) - mat(k,548) = .380_r8*rxt(k,415)*y(k,293) - mat(k,561) = .030_r8*rxt(k,416)*y(k,293) - mat(k,1612) = rxt(k,363)*y(k,293) - mat(k,1702) = .460_r8*rxt(k,419)*y(k,293) - mat(k,808) = .700_r8*rxt(k,364)*y(k,293) - mat(k,1239) = .500_r8*rxt(k,420)*y(k,293) - mat(k,413) = .400_r8*rxt(k,423)*y(k,293) - mat(k,668) = .720_r8*rxt(k,457)*y(k,293) - mat(k,1929) = .170_r8*rxt(k,460)*y(k,157) - mat(k,1963) = .170_r8*rxt(k,470)*y(k,157) - mat(k,1448) = .170_r8*rxt(k,485)*y(k,157) - mat(k,1752) = .880_r8*rxt(k,386)*y(k,157) - mat(k,1862) = .500_r8*rxt(k,404)*y(k,157) - mat(k,1363) = .440_r8*rxt(k,406)*y(k,293) - mat(k,1992) = .340_r8*rxt(k,502)*y(k,157) - mat(k,2853) = .170_r8*rxt(k,557)*y(k,252) + .710_r8*rxt(k,504)*y(k,258) & - + .140_r8*rxt(k,536)*y(k,282) + .170_r8*rxt(k,563)*y(k,285) & - + .240_r8*rxt(k,538)*y(k,287) + .120_r8*rxt(k,540)*y(k,291) & - + .400_r8*rxt(k,573)*y(k,312) + .540_r8*rxt(k,579)*y(k,314) & - + .510_r8*rxt(k,582)*y(k,316) - mat(k,1344) = rxt(k,365)*y(k,293) - mat(k,2955) = .170_r8*rxt(k,460)*y(k,115) + .170_r8*rxt(k,470)*y(k,118) & - + .170_r8*rxt(k,485)*y(k,121) + .880_r8*rxt(k,386)*y(k,126) & - + .500_r8*rxt(k,404)*y(k,132) + .340_r8*rxt(k,502)*y(k,139) - mat(k,2670) = .140_r8*rxt(k,382)*y(k,282) + .250_r8*rxt(k,401)*y(k,287) - mat(k,3390) = .120_r8*rxt(k,402)*y(k,287) + .500_r8*rxt(k,369)*y(k,296) - mat(k,791) = .170_r8*rxt(k,557)*y(k,147) + .070_r8*rxt(k,556)*y(k,256) - mat(k,3249) = .070_r8*rxt(k,556)*y(k,252) + .460_r8*rxt(k,422)*y(k,258) & - + .080_r8*rxt(k,384)*y(k,282) + .070_r8*rxt(k,562)*y(k,285) & - + .050_r8*rxt(k,403)*y(k,287) + .100_r8*rxt(k,500)*y(k,291) - mat(k,1409) = .710_r8*rxt(k,504)*y(k,147) + .460_r8*rxt(k,422)*y(k,256) - mat(k,1387) = .140_r8*rxt(k,536)*y(k,147) + .140_r8*rxt(k,382)*y(k,250) & - + .080_r8*rxt(k,384)*y(k,256) - mat(k,815) = .170_r8*rxt(k,563)*y(k,147) + .070_r8*rxt(k,562)*y(k,256) - mat(k,1374) = .240_r8*rxt(k,538)*y(k,147) + .250_r8*rxt(k,401)*y(k,250) & - + .120_r8*rxt(k,402)*y(k,251) + .050_r8*rxt(k,403)*y(k,256) - mat(k,1486) = .120_r8*rxt(k,540)*y(k,147) + .100_r8*rxt(k,500)*y(k,256) - mat(k,3711) = mat(k,3711) + .380_r8*rxt(k,415)*y(k,98) + .030_r8*rxt(k,416) & - *y(k,99) + rxt(k,363)*y(k,102) + .460_r8*rxt(k,419)*y(k,103) & - + .700_r8*rxt(k,364)*y(k,104) + .500_r8*rxt(k,420)*y(k,105) & - + .400_r8*rxt(k,423)*y(k,107) + .720_r8*rxt(k,457)*y(k,114) & - + .440_r8*rxt(k,406)*y(k,134) + rxt(k,365)*y(k,151) - mat(k,1227) = .500_r8*rxt(k,369)*y(k,251) - mat(k,767) = .400_r8*rxt(k,573)*y(k,147) - mat(k,783) = .540_r8*rxt(k,579)*y(k,147) - mat(k,445) = .510_r8*rxt(k,582)*y(k,147) - mat(k,530) = -(rxt(k,340)*y(k,293)) - mat(k,3601) = -rxt(k,340)*y(k,51) - mat(k,1194) = .120_r8*rxt(k,355)*y(k,157) - mat(k,2910) = .120_r8*rxt(k,355)*y(k,30) - mat(k,2645) = .100_r8*rxt(k,337)*y(k,251) + .150_r8*rxt(k,338)*y(k,256) - mat(k,3349) = .100_r8*rxt(k,337)*y(k,250) - mat(k,3161) = .150_r8*rxt(k,338)*y(k,250) + .150_r8*rxt(k,391)*y(k,284) - mat(k,1496) = .150_r8*rxt(k,391)*y(k,256) - mat(k,468) = -(rxt(k,341)*y(k,293)) - mat(k,3593) = -rxt(k,341)*y(k,52) - mat(k,2644) = .360_r8*rxt(k,338)*y(k,256) - mat(k,3157) = .360_r8*rxt(k,338)*y(k,250) + .360_r8*rxt(k,391)*y(k,284) - mat(k,1495) = .360_r8*rxt(k,391)*y(k,256) - mat(k,1356) = -(rxt(k,306)*y(k,293)) - mat(k,3680) = -rxt(k,306)*y(k,53) - mat(k,2116) = .050_r8*rxt(k,588)*y(k,251) - mat(k,2205) = .170_r8*rxt(k,596)*y(k,251) - mat(k,2052) = .050_r8*rxt(k,608)*y(k,251) - mat(k,2094) = .250_r8*rxt(k,616)*y(k,251) - mat(k,2327) = .030_r8*rxt(k,628)*y(k,251) - mat(k,1245) = .300_r8*rxt(k,326)*y(k,251) - mat(k,3364) = .050_r8*rxt(k,588)*y(k,235) + .170_r8*rxt(k,596)*y(k,236) & - + .050_r8*rxt(k,608)*y(k,238) + .250_r8*rxt(k,616)*y(k,239) & - + .030_r8*rxt(k,628)*y(k,243) + .300_r8*rxt(k,326)*y(k,247) & - + 2.000_r8*rxt(k,303)*y(k,251) + .250_r8*rxt(k,432)*y(k,260) & - + .250_r8*rxt(k,446)*y(k,265) + .250_r8*rxt(k,450)*y(k,266) & - + .360_r8*rxt(k,476)*y(k,272) + .250_r8*rxt(k,493)*y(k,276) & - + .250_r8*rxt(k,497)*y(k,277) + .090_r8*rxt(k,647)*y(k,279) & - + .250_r8*rxt(k,656)*y(k,280) + .250_r8*rxt(k,402)*y(k,287) & - + .050_r8*rxt(k,667)*y(k,288) + .250_r8*rxt(k,676)*y(k,289) & - + .500_r8*rxt(k,369)*y(k,296) + .250_r8*rxt(k,695)*y(k,299) - mat(k,1718) = .250_r8*rxt(k,432)*y(k,251) - mat(k,1546) = .250_r8*rxt(k,446)*y(k,251) - mat(k,1568) = .250_r8*rxt(k,450)*y(k,251) - mat(k,2018) = .360_r8*rxt(k,476)*y(k,251) - mat(k,1773) = .250_r8*rxt(k,493)*y(k,251) - mat(k,1661) = .250_r8*rxt(k,497)*y(k,251) - mat(k,2297) = .090_r8*rxt(k,647)*y(k,251) - mat(k,2153) = .250_r8*rxt(k,656)*y(k,251) - mat(k,1368) = .250_r8*rxt(k,402)*y(k,251) - mat(k,2356) = .050_r8*rxt(k,667)*y(k,251) - mat(k,2264) = .250_r8*rxt(k,676)*y(k,251) - mat(k,1225) = .500_r8*rxt(k,369)*y(k,251) - mat(k,2441) = .250_r8*rxt(k,695)*y(k,251) - mat(k,370) = -(rxt(k,307)*y(k,293)) - mat(k,3578) = -rxt(k,307)*y(k,54) - mat(k,3348) = rxt(k,304)*y(k,256) - mat(k,3149) = rxt(k,304)*y(k,251) - mat(k,3836) = -(rxt(k,218)*y(k,43) + rxt(k,220)*y(k,79) + rxt(k,221)*y(k,81) & - + (rxt(k,222) + rxt(k,223)) * y(k,256) + rxt(k,224)*y(k,157) & - + rxt(k,231)*y(k,61) + rxt(k,240)*y(k,96) + rxt(k,331)*y(k,29)) - mat(k,3344) = -rxt(k,218)*y(k,57) - mat(k,1425) = -rxt(k,220)*y(k,57) - mat(k,1354) = -rxt(k,221)*y(k,57) - mat(k,3294) = -(rxt(k,222) + rxt(k,223)) * y(k,57) - mat(k,2999) = -rxt(k,224)*y(k,57) - mat(k,1221) = -rxt(k,231)*y(k,57) - mat(k,1069) = -rxt(k,240)*y(k,57) - mat(k,263) = -rxt(k,331)*y(k,57) - mat(k,3801) = rxt(k,259)*y(k,60) - mat(k,3320) = rxt(k,259)*y(k,20) + (4.000_r8*rxt(k,226)+2.000_r8*rxt(k,228)) & + mat(k,1909) = -(rxt(k,360)*y(k,149) + rxt(k,361)*y(k,293)) + mat(k,3910) = -rxt(k,360)*y(k,50) + mat(k,3776) = -rxt(k,361)*y(k,50) + mat(k,625) = .380_r8*rxt(k,414)*y(k,293) + mat(k,683) = .030_r8*rxt(k,415)*y(k,293) + mat(k,1757) = rxt(k,362)*y(k,293) + mat(k,1871) = .460_r8*rxt(k,418)*y(k,293) + mat(k,963) = .700_r8*rxt(k,363)*y(k,293) + mat(k,919) = .500_r8*rxt(k,419)*y(k,293) + mat(k,492) = .400_r8*rxt(k,422)*y(k,293) + mat(k,777) = .720_r8*rxt(k,456)*y(k,293) + mat(k,2107) = .170_r8*rxt(k,459)*y(k,157) + mat(k,2075) = .170_r8*rxt(k,469)*y(k,157) + mat(k,1578) = .170_r8*rxt(k,484)*y(k,157) + mat(k,2020) = .880_r8*rxt(k,385)*y(k,157) + mat(k,2044) = .500_r8*rxt(k,403)*y(k,157) + mat(k,1498) = .440_r8*rxt(k,405)*y(k,293) + mat(k,2137) = .340_r8*rxt(k,501)*y(k,157) + mat(k,3269) = .170_r8*rxt(k,556)*y(k,252) + .710_r8*rxt(k,503)*y(k,258) & + + .140_r8*rxt(k,535)*y(k,282) + .170_r8*rxt(k,562)*y(k,285) & + + .240_r8*rxt(k,537)*y(k,287) + .120_r8*rxt(k,539)*y(k,291) & + + .400_r8*rxt(k,572)*y(k,312) + .540_r8*rxt(k,578)*y(k,314) & + + .510_r8*rxt(k,581)*y(k,316) + mat(k,1480) = rxt(k,364)*y(k,293) + mat(k,3088) = .170_r8*rxt(k,459)*y(k,115) + .170_r8*rxt(k,469)*y(k,118) & + + .170_r8*rxt(k,484)*y(k,121) + .880_r8*rxt(k,385)*y(k,126) & + + .500_r8*rxt(k,403)*y(k,132) + .340_r8*rxt(k,501)*y(k,139) + mat(k,2987) = .140_r8*rxt(k,381)*y(k,282) + .250_r8*rxt(k,400)*y(k,287) + mat(k,4004) = .120_r8*rxt(k,401)*y(k,287) + .500_r8*rxt(k,368)*y(k,296) + mat(k,905) = .170_r8*rxt(k,556)*y(k,147) + .070_r8*rxt(k,555)*y(k,256) + mat(k,3525) = .070_r8*rxt(k,555)*y(k,252) + .460_r8*rxt(k,421)*y(k,258) & + + .080_r8*rxt(k,383)*y(k,282) + .070_r8*rxt(k,561)*y(k,285) & + + .050_r8*rxt(k,402)*y(k,287) + .100_r8*rxt(k,499)*y(k,291) + mat(k,1301) = .710_r8*rxt(k,503)*y(k,147) + .460_r8*rxt(k,421)*y(k,256) + mat(k,1545) = .140_r8*rxt(k,535)*y(k,147) + .140_r8*rxt(k,381)*y(k,250) & + + .080_r8*rxt(k,383)*y(k,256) + mat(k,924) = .170_r8*rxt(k,562)*y(k,147) + .070_r8*rxt(k,561)*y(k,256) + mat(k,1509) = .240_r8*rxt(k,537)*y(k,147) + .250_r8*rxt(k,400)*y(k,250) & + + .120_r8*rxt(k,401)*y(k,251) + .050_r8*rxt(k,402)*y(k,256) + mat(k,1643) = .120_r8*rxt(k,539)*y(k,147) + .100_r8*rxt(k,499)*y(k,256) + mat(k,3776) = mat(k,3776) + .380_r8*rxt(k,414)*y(k,98) + .030_r8*rxt(k,415) & + *y(k,99) + rxt(k,362)*y(k,102) + .460_r8*rxt(k,418)*y(k,103) & + + .700_r8*rxt(k,363)*y(k,104) + .500_r8*rxt(k,419)*y(k,105) & + + .400_r8*rxt(k,422)*y(k,107) + .720_r8*rxt(k,456)*y(k,114) & + + .440_r8*rxt(k,405)*y(k,134) + rxt(k,364)*y(k,151) + mat(k,1337) = .500_r8*rxt(k,368)*y(k,251) + mat(k,881) = .400_r8*rxt(k,572)*y(k,147) + mat(k,897) = .540_r8*rxt(k,578)*y(k,147) + mat(k,535) = .510_r8*rxt(k,581)*y(k,147) + mat(k,789) = -(rxt(k,339)*y(k,293)) + mat(k,3685) = -rxt(k,339)*y(k,51) + mat(k,1362) = .120_r8*rxt(k,354)*y(k,157) + mat(k,3048) = .120_r8*rxt(k,354)*y(k,30) + mat(k,2965) = .100_r8*rxt(k,336)*y(k,251) + .150_r8*rxt(k,337)*y(k,256) + mat(k,3967) = .100_r8*rxt(k,336)*y(k,250) + mat(k,3451) = .150_r8*rxt(k,337)*y(k,250) + .150_r8*rxt(k,390)*y(k,284) + mat(k,1616) = .150_r8*rxt(k,390)*y(k,256) + mat(k,700) = -(rxt(k,340)*y(k,293)) + mat(k,3675) = -rxt(k,340)*y(k,52) + mat(k,2964) = .360_r8*rxt(k,337)*y(k,256) + mat(k,3443) = .360_r8*rxt(k,337)*y(k,250) + .360_r8*rxt(k,390)*y(k,284) + mat(k,1615) = .360_r8*rxt(k,390)*y(k,256) + mat(k,1492) = -(rxt(k,306)*y(k,293)) + mat(k,3749) = -rxt(k,306)*y(k,53) + mat(k,2291) = .050_r8*rxt(k,587)*y(k,251) + mat(k,2455) = .170_r8*rxt(k,595)*y(k,251) + mat(k,2210) = .050_r8*rxt(k,607)*y(k,251) + mat(k,2318) = .250_r8*rxt(k,615)*y(k,251) + mat(k,2523) = .030_r8*rxt(k,627)*y(k,251) + mat(k,1350) = .300_r8*rxt(k,325)*y(k,251) + mat(k,3981) = .050_r8*rxt(k,587)*y(k,235) + .170_r8*rxt(k,595)*y(k,236) & + + .050_r8*rxt(k,607)*y(k,238) + .250_r8*rxt(k,615)*y(k,239) & + + .030_r8*rxt(k,627)*y(k,243) + .300_r8*rxt(k,325)*y(k,247) & + + 2.000_r8*rxt(k,303)*y(k,251) + .250_r8*rxt(k,431)*y(k,260) & + + .250_r8*rxt(k,445)*y(k,265) + .250_r8*rxt(k,449)*y(k,266) & + + .360_r8*rxt(k,475)*y(k,272) + .250_r8*rxt(k,492)*y(k,276) & + + .250_r8*rxt(k,496)*y(k,277) + .090_r8*rxt(k,646)*y(k,279) & + + .250_r8*rxt(k,655)*y(k,280) + .250_r8*rxt(k,401)*y(k,287) & + + .050_r8*rxt(k,666)*y(k,288) + .250_r8*rxt(k,675)*y(k,289) & + + .500_r8*rxt(k,368)*y(k,296) + .250_r8*rxt(k,694)*y(k,299) + mat(k,1981) = .250_r8*rxt(k,431)*y(k,251) + mat(k,1736) = .250_r8*rxt(k,445)*y(k,251) + mat(k,1765) = .250_r8*rxt(k,449)*y(k,251) + mat(k,2163) = .360_r8*rxt(k,475)*y(k,251) + mat(k,1840) = .250_r8*rxt(k,492)*y(k,251) + mat(k,1809) = .250_r8*rxt(k,496)*y(k,251) + mat(k,2491) = .090_r8*rxt(k,646)*y(k,251) + mat(k,2375) = .250_r8*rxt(k,655)*y(k,251) + mat(k,1504) = .250_r8*rxt(k,401)*y(k,251) + mat(k,2687) = .050_r8*rxt(k,666)*y(k,251) + mat(k,2792) = .250_r8*rxt(k,675)*y(k,251) + mat(k,1335) = .500_r8*rxt(k,368)*y(k,251) + mat(k,2723) = .250_r8*rxt(k,694)*y(k,251) + mat(k,459) = -(rxt(k,307)*y(k,293)) + mat(k,3645) = -rxt(k,307)*y(k,54) + mat(k,3965) = rxt(k,304)*y(k,256) + mat(k,3431) = rxt(k,304)*y(k,251) + mat(k,2259) = -(rxt(k,219)*y(k,57) + rxt(k,275)*y(k,75) + rxt(k,308)*y(k,293) & + + (rxt(k,315) + rxt(k,316) + rxt(k,317)) * y(k,292)) + mat(k,3850) = -rxt(k,219)*y(k,55) + mat(k,1280) = -rxt(k,275)*y(k,55) + mat(k,3789) = -rxt(k,308)*y(k,55) + mat(k,2635) = -(rxt(k,315) + rxt(k,316) + rxt(k,317)) * y(k,55) + mat(k,1371) = .100_r8*rxt(k,354)*y(k,157) + mat(k,3101) = .100_r8*rxt(k,354)*y(k,30) + mat(k,432) = -(rxt(k,271)*y(k,292) + rxt(k,288)*y(k,57) + rxt(k,289)*y(k,293)) + mat(k,2628) = -rxt(k,271)*y(k,56) + mat(k,3832) = -rxt(k,288)*y(k,56) + mat(k,3641) = -rxt(k,289)*y(k,56) + mat(k,3864) = -(rxt(k,218)*y(k,43) + rxt(k,219)*y(k,55) + rxt(k,220)*y(k,79) & + + rxt(k,221)*y(k,81) + (rxt(k,222) + rxt(k,223)) * y(k,256) & + + rxt(k,224)*y(k,157) + rxt(k,231)*y(k,61) + rxt(k,240)*y(k,96) & + + rxt(k,281)*y(k,42) + rxt(k,283)*y(k,44) + rxt(k,286)*y(k,47) & + + rxt(k,288)*y(k,56) + rxt(k,330)*y(k,29)) + mat(k,3362) = -rxt(k,218)*y(k,57) + mat(k,2268) = -rxt(k,219)*y(k,57) + mat(k,1679) = -rxt(k,220)*y(k,57) + mat(k,1490) = -rxt(k,221)*y(k,57) + mat(k,3573) = -(rxt(k,222) + rxt(k,223)) * y(k,57) + mat(k,3135) = -rxt(k,224)*y(k,57) + mat(k,1329) = -rxt(k,231)*y(k,57) + mat(k,1147) = -rxt(k,240)*y(k,57) + mat(k,514) = -rxt(k,281)*y(k,57) + mat(k,645) = -rxt(k,283)*y(k,57) + mat(k,395) = -rxt(k,286)*y(k,57) + mat(k,437) = -rxt(k,288)*y(k,57) + mat(k,318) = -rxt(k,330)*y(k,57) + mat(k,2567) = rxt(k,259)*y(k,60) + mat(k,120) = 4.000_r8*rxt(k,243)*y(k,292) + mat(k,161) = rxt(k,244)*y(k,292) + mat(k,135) = 2.000_r8*rxt(k,245)*y(k,292) + mat(k,171) = 2.000_r8*rxt(k,246)*y(k,292) + mat(k,139) = 2.000_r8*rxt(k,247)*y(k,292) + mat(k,176) = rxt(k,248)*y(k,292) + mat(k,143) = 2.000_r8*rxt(k,249)*y(k,292) + mat(k,146) = 3.000_r8*rxt(k,285)*y(k,293) + mat(k,395) = mat(k,395) + rxt(k,287)*y(k,293) + mat(k,2607) = rxt(k,259)*y(k,20) + (4.000_r8*rxt(k,226)+2.000_r8*rxt(k,228)) & *y(k,60) + rxt(k,230)*y(k,147) + rxt(k,235)*y(k,156) & + rxt(k,801)*y(k,173) + rxt(k,225)*y(k,251) + rxt(k,236) & *y(k,293) - mat(k,159) = rxt(k,280)*y(k,292) - mat(k,3777) = rxt(k,238)*y(k,156) + rxt(k,250)*y(k,292) + rxt(k,239)*y(k,293) - mat(k,2898) = rxt(k,230)*y(k,60) - mat(k,3465) = rxt(k,235)*y(k,60) + rxt(k,238)*y(k,87) - mat(k,1524) = rxt(k,801)*y(k,60) - mat(k,3435) = rxt(k,225)*y(k,60) - mat(k,3115) = rxt(k,280)*y(k,66) + rxt(k,250)*y(k,87) - mat(k,3755) = rxt(k,236)*y(k,60) + rxt(k,239)*y(k,87) + mat(k,254) = rxt(k,280)*y(k,292) + mat(k,250) = rxt(k,295)*y(k,292) + rxt(k,290)*y(k,293) + mat(k,259) = rxt(k,296)*y(k,292) + rxt(k,291)*y(k,293) + mat(k,306) = rxt(k,297)*y(k,292) + rxt(k,292)*y(k,293) + mat(k,3158) = rxt(k,238)*y(k,156) + rxt(k,250)*y(k,292) + rxt(k,239)*y(k,293) + mat(k,3317) = rxt(k,230)*y(k,60) + mat(k,3393) = rxt(k,235)*y(k,60) + rxt(k,238)*y(k,87) + mat(k,1608) = rxt(k,801)*y(k,60) + mat(k,4050) = rxt(k,225)*y(k,60) + mat(k,2648) = 4.000_r8*rxt(k,243)*y(k,34) + rxt(k,244)*y(k,35) & + + 2.000_r8*rxt(k,245)*y(k,37) + 2.000_r8*rxt(k,246)*y(k,38) & + + 2.000_r8*rxt(k,247)*y(k,39) + rxt(k,248)*y(k,40) & + + 2.000_r8*rxt(k,249)*y(k,41) + rxt(k,280)*y(k,66) + rxt(k,295) & + *y(k,84) + rxt(k,296)*y(k,85) + rxt(k,297)*y(k,86) + rxt(k,250) & + *y(k,87) + mat(k,3823) = 3.000_r8*rxt(k,285)*y(k,45) + rxt(k,287)*y(k,47) + rxt(k,236) & + *y(k,60) + rxt(k,290)*y(k,84) + rxt(k,291)*y(k,85) + rxt(k,292) & + *y(k,86) + rxt(k,239)*y(k,87) end do end subroutine nlnmat02 subroutine nlnmat03( avec_len, mat, y, rxt ) @@ -591,226 +673,273 @@ subroutine nlnmat03( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,3803) = rxt(k,231)*y(k,61) - mat(k,3297) = 2.000_r8*rxt(k,227)*y(k,60) - mat(k,1211) = rxt(k,231)*y(k,57) + (rxt(k,891)+rxt(k,896)+rxt(k,901))*y(k,87) - mat(k,3757) = (rxt(k,891)+rxt(k,896)+rxt(k,901))*y(k,61) + (rxt(k,886) & - +rxt(k,892)+rxt(k,897))*y(k,96) - mat(k,1063) = (rxt(k,886)+rxt(k,892)+rxt(k,897))*y(k,87) - mat(k,3296) = 2.000_r8*rxt(k,252)*y(k,60) - mat(k,3312) = -(rxt(k,225)*y(k,251) + (4._r8*rxt(k,226) + 4._r8*rxt(k,227) & + mat(k,3828) = rxt(k,231)*y(k,61) + mat(k,2587) = 2.000_r8*rxt(k,227)*y(k,60) + mat(k,1321) = rxt(k,231)*y(k,57) + (rxt(k,890)+rxt(k,895)+rxt(k,900))*y(k,87) + mat(k,3140) = (rxt(k,890)+rxt(k,895)+rxt(k,900))*y(k,61) + (rxt(k,885) & + +rxt(k,891)+rxt(k,896))*y(k,96) + mat(k,1141) = (rxt(k,885)+rxt(k,891)+rxt(k,896))*y(k,87) + mat(k,2586) = 2.000_r8*rxt(k,252)*y(k,60) + mat(k,2597) = -(rxt(k,225)*y(k,251) + (4._r8*rxt(k,226) + 4._r8*rxt(k,227) & + 4._r8*rxt(k,228) + 4._r8*rxt(k,252)) * y(k,60) + rxt(k,229) & *y(k,256) + rxt(k,230)*y(k,147) + rxt(k,232)*y(k,148) + rxt(k,235) & *y(k,156) + (rxt(k,236) + rxt(k,237)) * y(k,293) + (rxt(k,258) & + rxt(k,259) + rxt(k,260)) * y(k,20) + rxt(k,801)*y(k,173)) - mat(k,3427) = -rxt(k,225)*y(k,60) - mat(k,3286) = -rxt(k,229)*y(k,60) - mat(k,2890) = -rxt(k,230)*y(k,60) - mat(k,3507) = -rxt(k,232)*y(k,60) - mat(k,3457) = -rxt(k,235)*y(k,60) - mat(k,3747) = -(rxt(k,236) + rxt(k,237)) * y(k,60) - mat(k,3793) = -(rxt(k,258) + rxt(k,259) + rxt(k,260)) * y(k,60) - mat(k,1519) = -rxt(k,801)*y(k,60) - mat(k,3828) = rxt(k,240)*y(k,96) + rxt(k,224)*y(k,157) + rxt(k,223)*y(k,256) - mat(k,1216) = rxt(k,233)*y(k,156) - mat(k,3769) = rxt(k,251)*y(k,292) - mat(k,1065) = rxt(k,240)*y(k,57) + rxt(k,241)*y(k,156) + rxt(k,242)*y(k,293) - mat(k,3457) = mat(k,3457) + rxt(k,233)*y(k,61) + rxt(k,241)*y(k,96) - mat(k,2991) = rxt(k,224)*y(k,57) - mat(k,278) = rxt(k,806)*y(k,173) - mat(k,1519) = mat(k,1519) + rxt(k,806)*y(k,159) - mat(k,3286) = mat(k,3286) + rxt(k,223)*y(k,57) - mat(k,3107) = rxt(k,251)*y(k,87) - mat(k,3747) = mat(k,3747) + rxt(k,242)*y(k,96) - mat(k,1213) = -(rxt(k,231)*y(k,57) + rxt(k,233)*y(k,156) + rxt(k,234) & - *y(k,293) + (rxt(k,891) + rxt(k,896) + rxt(k,901)) * y(k,87)) - mat(k,3811) = -rxt(k,231)*y(k,61) - mat(k,3444) = -rxt(k,233)*y(k,61) - mat(k,3667) = -rxt(k,234)*y(k,61) - mat(k,3761) = -(rxt(k,891) + rxt(k,896) + rxt(k,901)) * y(k,61) - mat(k,3302) = rxt(k,232)*y(k,148) - mat(k,3487) = rxt(k,232)*y(k,60) - mat(k,1540) = -((rxt(k,309) + rxt(k,320)) * y(k,293)) - mat(k,3694) = -(rxt(k,309) + rxt(k,320)) * y(k,63) - mat(k,1105) = .170_r8*rxt(k,603)*y(k,157) - mat(k,1684) = rxt(k,254)*y(k,43) - mat(k,256) = .350_r8*rxt(k,322)*y(k,293) - mat(k,501) = .630_r8*rxt(k,324)*y(k,157) - mat(k,1200) = .560_r8*rxt(k,355)*y(k,157) - mat(k,3327) = rxt(k,254)*y(k,18) + rxt(k,218)*y(k,57) + rxt(k,299)*y(k,149) & + mat(k,4030) = -rxt(k,225)*y(k,60) + mat(k,3553) = -rxt(k,229)*y(k,60) + mat(k,3297) = -rxt(k,230)*y(k,60) + mat(k,4087) = -rxt(k,232)*y(k,60) + mat(k,3383) = -rxt(k,235)*y(k,60) + mat(k,3803) = -(rxt(k,236) + rxt(k,237)) * y(k,60) + mat(k,2557) = -(rxt(k,258) + rxt(k,259) + rxt(k,260)) * y(k,60) + mat(k,1602) = -rxt(k,801)*y(k,60) + mat(k,3853) = rxt(k,240)*y(k,96) + rxt(k,224)*y(k,157) + rxt(k,223)*y(k,256) + mat(k,1324) = rxt(k,233)*y(k,156) + mat(k,3148) = rxt(k,251)*y(k,292) + mat(k,1143) = rxt(k,240)*y(k,57) + rxt(k,241)*y(k,156) + rxt(k,242)*y(k,293) + mat(k,3383) = mat(k,3383) + rxt(k,233)*y(k,61) + rxt(k,241)*y(k,96) + mat(k,3115) = rxt(k,224)*y(k,57) + mat(k,342) = rxt(k,806)*y(k,173) + mat(k,1602) = mat(k,1602) + rxt(k,806)*y(k,159) + mat(k,3553) = mat(k,3553) + rxt(k,223)*y(k,57) + mat(k,2638) = rxt(k,251)*y(k,87) + mat(k,3803) = mat(k,3803) + rxt(k,242)*y(k,96) + mat(k,1323) = -(rxt(k,231)*y(k,57) + rxt(k,233)*y(k,156) + rxt(k,234) & + *y(k,293) + (rxt(k,890) + rxt(k,895) + rxt(k,900)) * y(k,87)) + mat(k,3838) = -rxt(k,231)*y(k,61) + mat(k,3374) = -rxt(k,233)*y(k,61) + mat(k,3734) = -rxt(k,234)*y(k,61) + mat(k,3144) = -(rxt(k,890) + rxt(k,895) + rxt(k,900)) * y(k,61) + mat(k,2592) = rxt(k,232)*y(k,148) + mat(k,4075) = rxt(k,232)*y(k,60) + mat(k,1918) = -(rxt(k,319)*y(k,293)) + mat(k,3777) = -rxt(k,319)*y(k,63) + mat(k,1250) = .170_r8*rxt(k,602)*y(k,157) + mat(k,2198) = rxt(k,254)*y(k,43) + mat(k,311) = .350_r8*rxt(k,321)*y(k,293) + mat(k,593) = .630_r8*rxt(k,323)*y(k,157) + mat(k,1370) = .560_r8*rxt(k,354)*y(k,157) + mat(k,3347) = rxt(k,254)*y(k,18) + rxt(k,218)*y(k,57) + rxt(k,299)*y(k,149) & + rxt(k,300)*y(k,156) + rxt(k,301)*y(k,293) - mat(k,1844) = rxt(k,361)*y(k,149) + rxt(k,362)*y(k,293) - mat(k,3818) = rxt(k,218)*y(k,43) - mat(k,568) = rxt(k,377)*y(k,293) - mat(k,1177) = rxt(k,347)*y(k,293) - mat(k,723) = .110_r8*rxt(k,348)*y(k,293) - mat(k,547) = 1.060_r8*rxt(k,415)*y(k,293) - mat(k,559) = .760_r8*rxt(k,416)*y(k,293) - mat(k,422) = .420_r8*rxt(k,417)*y(k,293) - mat(k,429) = .230_r8*rxt(k,418)*y(k,293) - mat(k,1697) = rxt(k,419)*y(k,293) - mat(k,1237) = 1.500_r8*rxt(k,420)*y(k,293) - mat(k,1087) = .350_r8*rxt(k,424)*y(k,293) - mat(k,1287) = .350_r8*rxt(k,487)*y(k,157) - mat(k,1024) = rxt(k,453)*y(k,293) - mat(k,1632) = rxt(k,455)*y(k,293) - mat(k,666) = 2.000_r8*rxt(k,457)*y(k,293) - mat(k,1923) = .060_r8*rxt(k,461)*y(k,293) - mat(k,1957) = .040_r8*rxt(k,471)*y(k,293) - mat(k,1748) = .650_r8*rxt(k,386)*y(k,157) - mat(k,1618) = rxt(k,381)*y(k,293) - mat(k,1330) = rxt(k,388)*y(k,293) - mat(k,393) = .250_r8*rxt(k,399)*y(k,293) - mat(k,1859) = .560_r8*rxt(k,404)*y(k,157) - mat(k,1800) = .500_r8*rxt(k,400)*y(k,293) - mat(k,1362) = 1.560_r8*rxt(k,406)*y(k,293) - mat(k,1986) = .300_r8*rxt(k,502)*y(k,157) + .630_r8*rxt(k,503)*y(k,293) - mat(k,2836) = .170_r8*rxt(k,557)*y(k,252) + .400_r8*rxt(k,504)*y(k,258) & - + .550_r8*rxt(k,510)*y(k,265) + .550_r8*rxt(k,512)*y(k,266) & - + .550_r8*rxt(k,531)*y(k,276) + .550_r8*rxt(k,534)*y(k,277) & - + .860_r8*rxt(k,536)*y(k,282) + .400_r8*rxt(k,560)*y(k,283) & - + .650_r8*rxt(k,393)*y(k,284) + .350_r8*rxt(k,563)*y(k,285) & - + .750_r8*rxt(k,540)*y(k,291) + .910_r8*rxt(k,742)*y(k,304) - mat(k,3031) = rxt(k,299)*y(k,43) + rxt(k,361)*y(k,50) + .650_r8*rxt(k,394) & - *y(k,284) + rxt(k,743)*y(k,304) - mat(k,3448) = rxt(k,300)*y(k,43) + rxt(k,796)*y(k,160) - mat(k,2940) = .170_r8*rxt(k,603)*y(k,4) + .630_r8*rxt(k,324)*y(k,26) & - + .560_r8*rxt(k,355)*y(k,30) + .350_r8*rxt(k,487)*y(k,109) & - + .650_r8*rxt(k,386)*y(k,126) + .560_r8*rxt(k,404)*y(k,132) & - + .300_r8*rxt(k,502)*y(k,139) - mat(k,304) = rxt(k,796)*y(k,156) + rxt(k,797)*y(k,293) - mat(k,507) = 2.000_r8*rxt(k,719)*y(k,293) - mat(k,515) = rxt(k,738)*y(k,293) - mat(k,346) = rxt(k,758)*y(k,293) - mat(k,2655) = .550_r8*rxt(k,445)*y(k,265) + .550_r8*rxt(k,449)*y(k,266) & - + .550_r8*rxt(k,492)*y(k,276) + .550_r8*rxt(k,496)*y(k,277) & - + .860_r8*rxt(k,382)*y(k,282) + .650_r8*rxt(k,389)*y(k,284) & - + rxt(k,739)*y(k,304) - mat(k,3374) = .280_r8*rxt(k,446)*y(k,265) + .280_r8*rxt(k,450)*y(k,266) & - + .280_r8*rxt(k,493)*y(k,276) + .280_r8*rxt(k,497)*y(k,277) & - + .900_r8*rxt(k,383)*y(k,282) + .650_r8*rxt(k,390)*y(k,284) & - + rxt(k,402)*y(k,287) + rxt(k,740)*y(k,304) - mat(k,790) = .170_r8*rxt(k,557)*y(k,147) + .070_r8*rxt(k,556)*y(k,256) - mat(k,3232) = .070_r8*rxt(k,556)*y(k,252) + .260_r8*rxt(k,422)*y(k,258) & - + .510_r8*rxt(k,384)*y(k,282) + .160_r8*rxt(k,559)*y(k,283) & - + .320_r8*rxt(k,391)*y(k,284) + .140_r8*rxt(k,562)*y(k,285) & - + .260_r8*rxt(k,403)*y(k,287) + .600_r8*rxt(k,500)*y(k,291) & - + .530_r8*rxt(k,741)*y(k,304) - mat(k,1406) = .400_r8*rxt(k,504)*y(k,147) + .260_r8*rxt(k,422)*y(k,256) - mat(k,1549) = .550_r8*rxt(k,510)*y(k,147) + .550_r8*rxt(k,445)*y(k,250) & - + .280_r8*rxt(k,446)*y(k,251) - mat(k,1570) = .550_r8*rxt(k,512)*y(k,147) + .550_r8*rxt(k,449)*y(k,250) & - + .280_r8*rxt(k,450)*y(k,251) - mat(k,1777) = .550_r8*rxt(k,531)*y(k,147) + .550_r8*rxt(k,492)*y(k,250) & - + .280_r8*rxt(k,493)*y(k,251) - mat(k,1664) = .550_r8*rxt(k,534)*y(k,147) + .550_r8*rxt(k,496)*y(k,250) & - + .280_r8*rxt(k,497)*y(k,251) - mat(k,1384) = .860_r8*rxt(k,536)*y(k,147) + .860_r8*rxt(k,382)*y(k,250) & - + .900_r8*rxt(k,383)*y(k,251) + .510_r8*rxt(k,384)*y(k,256) - mat(k,753) = .400_r8*rxt(k,560)*y(k,147) + .160_r8*rxt(k,559)*y(k,256) - mat(k,1498) = .650_r8*rxt(k,393)*y(k,147) + .650_r8*rxt(k,394)*y(k,149) & - + .650_r8*rxt(k,389)*y(k,250) + .650_r8*rxt(k,390)*y(k,251) & - + .320_r8*rxt(k,391)*y(k,256) + 2.600_r8*rxt(k,392)*y(k,284) - mat(k,814) = .350_r8*rxt(k,563)*y(k,147) + .140_r8*rxt(k,562)*y(k,256) - mat(k,1372) = rxt(k,402)*y(k,251) + .260_r8*rxt(k,403)*y(k,256) - mat(k,1481) = .750_r8*rxt(k,540)*y(k,147) + .600_r8*rxt(k,500)*y(k,256) - mat(k,3694) = mat(k,3694) + .350_r8*rxt(k,322)*y(k,25) + rxt(k,301)*y(k,43) & - + rxt(k,362)*y(k,50) + rxt(k,377)*y(k,68) + rxt(k,347)*y(k,77) & - + .110_r8*rxt(k,348)*y(k,89) + 1.060_r8*rxt(k,415)*y(k,98) & - + .760_r8*rxt(k,416)*y(k,99) + .420_r8*rxt(k,417)*y(k,100) & - + .230_r8*rxt(k,418)*y(k,101) + rxt(k,419)*y(k,103) & - + 1.500_r8*rxt(k,420)*y(k,105) + .350_r8*rxt(k,424)*y(k,108) & - + rxt(k,453)*y(k,111) + rxt(k,455)*y(k,112) & - + 2.000_r8*rxt(k,457)*y(k,114) + .060_r8*rxt(k,461)*y(k,115) & - + .040_r8*rxt(k,471)*y(k,118) + rxt(k,381)*y(k,127) + rxt(k,388) & - *y(k,128) + .250_r8*rxt(k,399)*y(k,131) + .500_r8*rxt(k,400) & - *y(k,133) + 1.560_r8*rxt(k,406)*y(k,134) + .630_r8*rxt(k,503) & - *y(k,139) + rxt(k,797)*y(k,160) + 2.000_r8*rxt(k,719)*y(k,202) & - + rxt(k,738)*y(k,204) + rxt(k,758)*y(k,208) - mat(k,2509) = rxt(k,744)*y(k,304) - mat(k,2555) = rxt(k,745)*y(k,304) - mat(k,2463) = .910_r8*rxt(k,742)*y(k,147) + rxt(k,743)*y(k,149) + rxt(k,739) & - *y(k,250) + rxt(k,740)*y(k,251) + .530_r8*rxt(k,741)*y(k,256) & - + rxt(k,744)*y(k,300) + rxt(k,745)*y(k,302) + rxt(k,746) & + mat(k,391) = rxt(k,286)*y(k,57) + mat(k,1910) = rxt(k,360)*y(k,149) + rxt(k,361)*y(k,293) + mat(k,3848) = rxt(k,218)*y(k,43) + rxt(k,286)*y(k,47) + mat(k,635) = rxt(k,376)*y(k,293) + mat(k,1476) = rxt(k,346)*y(k,293) + mat(k,821) = .110_r8*rxt(k,347)*y(k,293) + mat(k,626) = 1.060_r8*rxt(k,414)*y(k,293) + mat(k,684) = .760_r8*rxt(k,415)*y(k,293) + mat(k,484) = .420_r8*rxt(k,416)*y(k,293) + mat(k,501) = .230_r8*rxt(k,417)*y(k,293) + mat(k,1872) = rxt(k,418)*y(k,293) + mat(k,920) = 1.500_r8*rxt(k,419)*y(k,293) + mat(k,1270) = .350_r8*rxt(k,423)*y(k,293) + mat(k,1397) = .350_r8*rxt(k,486)*y(k,157) + mat(k,1114) = rxt(k,452)*y(k,293) + mat(k,1793) = rxt(k,454)*y(k,293) + mat(k,778) = 2.000_r8*rxt(k,456)*y(k,293) + mat(k,2108) = .060_r8*rxt(k,460)*y(k,293) + mat(k,2076) = .040_r8*rxt(k,470)*y(k,293) + mat(k,2021) = .650_r8*rxt(k,385)*y(k,157) + mat(k,1728) = rxt(k,380)*y(k,293) + mat(k,1462) = rxt(k,387)*y(k,293) + mat(k,519) = .250_r8*rxt(k,398)*y(k,293) + mat(k,2045) = .560_r8*rxt(k,403)*y(k,157) + mat(k,1928) = .500_r8*rxt(k,399)*y(k,293) + mat(k,1499) = 1.560_r8*rxt(k,405)*y(k,293) + mat(k,2138) = .300_r8*rxt(k,501)*y(k,157) + .630_r8*rxt(k,502)*y(k,293) + mat(k,3270) = .170_r8*rxt(k,556)*y(k,252) + .400_r8*rxt(k,503)*y(k,258) & + + .550_r8*rxt(k,509)*y(k,265) + .550_r8*rxt(k,511)*y(k,266) & + + .550_r8*rxt(k,530)*y(k,276) + .550_r8*rxt(k,533)*y(k,277) & + + .860_r8*rxt(k,535)*y(k,282) + .400_r8*rxt(k,559)*y(k,283) & + + .650_r8*rxt(k,392)*y(k,284) + .350_r8*rxt(k,562)*y(k,285) & + + .750_r8*rxt(k,539)*y(k,291) + .910_r8*rxt(k,741)*y(k,304) + mat(k,3911) = rxt(k,299)*y(k,43) + rxt(k,360)*y(k,50) + .650_r8*rxt(k,393) & + *y(k,284) + rxt(k,742)*y(k,304) + mat(k,3378) = rxt(k,300)*y(k,43) + rxt(k,795)*y(k,160) + mat(k,3089) = .170_r8*rxt(k,602)*y(k,4) + .630_r8*rxt(k,323)*y(k,26) & + + .560_r8*rxt(k,354)*y(k,30) + .350_r8*rxt(k,486)*y(k,109) & + + .650_r8*rxt(k,385)*y(k,126) + .560_r8*rxt(k,403)*y(k,132) & + + .300_r8*rxt(k,501)*y(k,139) + mat(k,386) = rxt(k,795)*y(k,156) + rxt(k,796)*y(k,293) + mat(k,650) = 2.000_r8*rxt(k,718)*y(k,293) + mat(k,659) = rxt(k,737)*y(k,293) + mat(k,422) = rxt(k,757)*y(k,293) + mat(k,2988) = .550_r8*rxt(k,444)*y(k,265) + .550_r8*rxt(k,448)*y(k,266) & + + .550_r8*rxt(k,491)*y(k,276) + .550_r8*rxt(k,495)*y(k,277) & + + .860_r8*rxt(k,381)*y(k,282) + .650_r8*rxt(k,388)*y(k,284) & + + rxt(k,738)*y(k,304) + mat(k,4005) = .280_r8*rxt(k,445)*y(k,265) + .280_r8*rxt(k,449)*y(k,266) & + + .280_r8*rxt(k,492)*y(k,276) + .280_r8*rxt(k,496)*y(k,277) & + + .900_r8*rxt(k,382)*y(k,282) + .650_r8*rxt(k,389)*y(k,284) & + + rxt(k,401)*y(k,287) + rxt(k,739)*y(k,304) + mat(k,906) = .170_r8*rxt(k,556)*y(k,147) + .070_r8*rxt(k,555)*y(k,256) + mat(k,3526) = .070_r8*rxt(k,555)*y(k,252) + .260_r8*rxt(k,421)*y(k,258) & + + .510_r8*rxt(k,383)*y(k,282) + .160_r8*rxt(k,558)*y(k,283) & + + .320_r8*rxt(k,390)*y(k,284) + .140_r8*rxt(k,561)*y(k,285) & + + .260_r8*rxt(k,402)*y(k,287) + .600_r8*rxt(k,499)*y(k,291) & + + .530_r8*rxt(k,740)*y(k,304) + mat(k,1302) = .400_r8*rxt(k,503)*y(k,147) + .260_r8*rxt(k,421)*y(k,256) + mat(k,1745) = .550_r8*rxt(k,509)*y(k,147) + .550_r8*rxt(k,444)*y(k,250) & + + .280_r8*rxt(k,445)*y(k,251) + mat(k,1773) = .550_r8*rxt(k,511)*y(k,147) + .550_r8*rxt(k,448)*y(k,250) & + + .280_r8*rxt(k,449)*y(k,251) + mat(k,1850) = .550_r8*rxt(k,530)*y(k,147) + .550_r8*rxt(k,491)*y(k,250) & + + .280_r8*rxt(k,492)*y(k,251) + mat(k,1819) = .550_r8*rxt(k,533)*y(k,147) + .550_r8*rxt(k,495)*y(k,250) & + + .280_r8*rxt(k,496)*y(k,251) + mat(k,1546) = .860_r8*rxt(k,535)*y(k,147) + .860_r8*rxt(k,381)*y(k,250) & + + .900_r8*rxt(k,382)*y(k,251) + .510_r8*rxt(k,383)*y(k,256) + mat(k,868) = .400_r8*rxt(k,559)*y(k,147) + .160_r8*rxt(k,558)*y(k,256) + mat(k,1620) = .650_r8*rxt(k,392)*y(k,147) + .650_r8*rxt(k,393)*y(k,149) & + + .650_r8*rxt(k,388)*y(k,250) + .650_r8*rxt(k,389)*y(k,251) & + + .320_r8*rxt(k,390)*y(k,256) + 2.600_r8*rxt(k,391)*y(k,284) + mat(k,925) = .350_r8*rxt(k,562)*y(k,147) + .140_r8*rxt(k,561)*y(k,256) + mat(k,1510) = rxt(k,401)*y(k,251) + .260_r8*rxt(k,402)*y(k,256) + mat(k,1644) = .750_r8*rxt(k,539)*y(k,147) + .600_r8*rxt(k,499)*y(k,256) + mat(k,3777) = mat(k,3777) + .350_r8*rxt(k,321)*y(k,25) + rxt(k,301)*y(k,43) & + + rxt(k,361)*y(k,50) + rxt(k,376)*y(k,68) + rxt(k,346)*y(k,77) & + + .110_r8*rxt(k,347)*y(k,89) + 1.060_r8*rxt(k,414)*y(k,98) & + + .760_r8*rxt(k,415)*y(k,99) + .420_r8*rxt(k,416)*y(k,100) & + + .230_r8*rxt(k,417)*y(k,101) + rxt(k,418)*y(k,103) & + + 1.500_r8*rxt(k,419)*y(k,105) + .350_r8*rxt(k,423)*y(k,108) & + + rxt(k,452)*y(k,111) + rxt(k,454)*y(k,112) & + + 2.000_r8*rxt(k,456)*y(k,114) + .060_r8*rxt(k,460)*y(k,115) & + + .040_r8*rxt(k,470)*y(k,118) + rxt(k,380)*y(k,127) + rxt(k,387) & + *y(k,128) + .250_r8*rxt(k,398)*y(k,131) + .500_r8*rxt(k,399) & + *y(k,133) + 1.560_r8*rxt(k,405)*y(k,134) + .630_r8*rxt(k,502) & + *y(k,139) + rxt(k,796)*y(k,160) + 2.000_r8*rxt(k,718)*y(k,202) & + + rxt(k,737)*y(k,204) + rxt(k,757)*y(k,208) + mat(k,2926) = rxt(k,743)*y(k,304) + mat(k,2833) = rxt(k,744)*y(k,304) + mat(k,2748) = .910_r8*rxt(k,741)*y(k,147) + rxt(k,742)*y(k,149) + rxt(k,738) & + *y(k,250) + rxt(k,739)*y(k,251) + .530_r8*rxt(k,740)*y(k,256) & + + rxt(k,743)*y(k,300) + rxt(k,744)*y(k,302) + rxt(k,745) & *y(k,305) - mat(k,2602) = rxt(k,746)*y(k,304) - mat(k,122) = -(rxt(k,279)*y(k,292)) - mat(k,3093) = -rxt(k,279)*y(k,65) - mat(k,156) = -(rxt(k,280)*y(k,292)) - mat(k,3095) = -rxt(k,280)*y(k,66) - mat(k,168) = -(rxt(k,555)*y(k,293)) - mat(k,3546) = -rxt(k,555)*y(k,67) - mat(k,162) = .180_r8*rxt(k,575)*y(k,293) - mat(k,3546) = mat(k,3546) + .180_r8*rxt(k,575)*y(k,226) - mat(k,566) = -(rxt(k,377)*y(k,293)) - mat(k,3605) = -rxt(k,377)*y(k,68) - mat(k,543) = .070_r8*rxt(k,415)*y(k,293) - mat(k,555) = .170_r8*rxt(k,416)*y(k,293) - mat(k,3605) = mat(k,3605) + .070_r8*rxt(k,415)*y(k,98) + .170_r8*rxt(k,416) & - *y(k,99) - mat(k,238) = -(rxt(k,794)*y(k,149) + (rxt(k,795) + rxt(k,808)) * y(k,293)) - mat(k,3003) = -rxt(k,794)*y(k,69) - mat(k,3560) = -(rxt(k,795) + rxt(k,808)) * y(k,69) - mat(k,742) = rxt(k,342)*y(k,256) - mat(k,3133) = rxt(k,342)*y(k,255) - mat(k,897) = -(rxt(k,276)*y(k,79) + rxt(k,277)*y(k,317) + rxt(k,278)*y(k,93)) - mat(k,1415) = -rxt(k,276)*y(k,75) - mat(k,3841) = -rxt(k,277)*y(k,75) - mat(k,2715) = -rxt(k,278)*y(k,75) - mat(k,123) = 2.000_r8*rxt(k,279)*y(k,292) - mat(k,157) = rxt(k,280)*y(k,292) - mat(k,3096) = 2.000_r8*rxt(k,279)*y(k,65) + rxt(k,280)*y(k,66) - mat(k,1469) = -(rxt(k,346)*y(k,293)) - mat(k,3689) = -rxt(k,346)*y(k,76) - mat(k,1921) = .830_r8*rxt(k,460)*y(k,157) - mat(k,798) = rxt(k,489)*y(k,293) - mat(k,1885) = .070_r8*rxt(k,491)*y(k,293) - mat(k,2832) = .570_r8*rxt(k,504)*y(k,258) + .940_r8*rxt(k,514)*y(k,267) & - + .730_r8*rxt(k,516)*y(k,268) + .340_r8*rxt(k,522)*y(k,271) & - + .400_r8*rxt(k,526)*y(k,273) + .760_r8*rxt(k,538)*y(k,287) - mat(k,2936) = .830_r8*rxt(k,460)*y(k,115) - mat(k,2653) = .750_r8*rxt(k,401)*y(k,287) - mat(k,3370) = .380_r8*rxt(k,402)*y(k,287) - mat(k,3228) = .370_r8*rxt(k,422)*y(k,258) + .550_r8*rxt(k,458)*y(k,267) & - + .460_r8*rxt(k,462)*y(k,268) + .150_r8*rxt(k,472)*y(k,271) & - + .280_r8*rxt(k,480)*y(k,273) + .360_r8*rxt(k,403)*y(k,287) - mat(k,1405) = .570_r8*rxt(k,504)*y(k,147) + .370_r8*rxt(k,422)*y(k,256) - mat(k,1002) = .940_r8*rxt(k,514)*y(k,147) + .550_r8*rxt(k,458)*y(k,256) - mat(k,1073) = .730_r8*rxt(k,516)*y(k,147) + .460_r8*rxt(k,462)*y(k,256) - mat(k,1318) = .340_r8*rxt(k,522)*y(k,147) + .150_r8*rxt(k,472)*y(k,256) - mat(k,1184) = .400_r8*rxt(k,526)*y(k,147) + .280_r8*rxt(k,480)*y(k,256) - mat(k,1371) = .760_r8*rxt(k,538)*y(k,147) + .750_r8*rxt(k,401)*y(k,250) & - + .380_r8*rxt(k,402)*y(k,251) + .360_r8*rxt(k,403)*y(k,256) - mat(k,3689) = mat(k,3689) + rxt(k,489)*y(k,122) + .070_r8*rxt(k,491)*y(k,123) - mat(k,1176) = -(rxt(k,347)*y(k,293)) - mat(k,3664) = -rxt(k,347)*y(k,77) - mat(k,255) = .650_r8*rxt(k,322)*y(k,293) - mat(k,1468) = .200_r8*rxt(k,346)*y(k,293) - mat(k,722) = .890_r8*rxt(k,348)*y(k,293) - mat(k,1914) = .170_r8*rxt(k,460)*y(k,157) - mat(k,1948) = .170_r8*rxt(k,470)*y(k,157) - mat(k,1431) = .170_r8*rxt(k,485)*y(k,157) - mat(k,1980) = .660_r8*rxt(k,502)*y(k,157) - mat(k,2813) = rxt(k,546)*y(k,241) + .230_r8*rxt(k,504)*y(k,258) & - + .400_r8*rxt(k,560)*y(k,283) + .170_r8*rxt(k,563)*y(k,285) & - + .130_r8*rxt(k,540)*y(k,291) + .700_r8*rxt(k,566)*y(k,294) & - + .600_r8*rxt(k,573)*y(k,312) + .340_r8*rxt(k,579)*y(k,314) & - + .170_r8*rxt(k,582)*y(k,316) - mat(k,2926) = .170_r8*rxt(k,460)*y(k,115) + .170_r8*rxt(k,470)*y(k,118) & - + .170_r8*rxt(k,485)*y(k,121) + .660_r8*rxt(k,502)*y(k,139) - mat(k,437) = rxt(k,546)*y(k,147) - mat(k,3206) = .150_r8*rxt(k,422)*y(k,258) + .160_r8*rxt(k,559)*y(k,283) & - + .070_r8*rxt(k,562)*y(k,285) + .100_r8*rxt(k,500)*y(k,291) - mat(k,1403) = .230_r8*rxt(k,504)*y(k,147) + .150_r8*rxt(k,422)*y(k,256) - mat(k,752) = .400_r8*rxt(k,560)*y(k,147) + .160_r8*rxt(k,559)*y(k,256) - mat(k,813) = .170_r8*rxt(k,563)*y(k,147) + .070_r8*rxt(k,562)*y(k,256) - mat(k,1475) = .130_r8*rxt(k,540)*y(k,147) + .100_r8*rxt(k,500)*y(k,256) - mat(k,3664) = mat(k,3664) + .650_r8*rxt(k,322)*y(k,25) + .200_r8*rxt(k,346) & - *y(k,76) + .890_r8*rxt(k,348)*y(k,89) - mat(k,378) = .700_r8*rxt(k,566)*y(k,147) - mat(k,765) = .600_r8*rxt(k,573)*y(k,147) - mat(k,781) = .340_r8*rxt(k,579)*y(k,147) - mat(k,444) = .170_r8*rxt(k,582)*y(k,147) + mat(k,2880) = rxt(k,745)*y(k,304) + mat(k,1096) = .190_r8*rxt(k,642)*y(k,157) + mat(k,1368) = .200_r8*rxt(k,354)*y(k,157) + mat(k,790) = rxt(k,339)*y(k,293) + mat(k,701) = .500_r8*rxt(k,340)*y(k,293) + mat(k,1917) = rxt(k,319)*y(k,293) + mat(k,1709) = .800_r8*rxt(k,345)*y(k,293) + mat(k,1475) = rxt(k,346)*y(k,293) + mat(k,1358) = rxt(k,310)*y(k,293) + mat(k,624) = .540_r8*rxt(k,414)*y(k,293) + mat(k,682) = .540_r8*rxt(k,415)*y(k,293) + mat(k,1866) = .360_r8*rxt(k,418)*y(k,293) + mat(k,1266) = .190_r8*rxt(k,423)*y(k,293) + mat(k,1392) = .420_r8*rxt(k,486)*y(k,157) + mat(k,2041) = .100_r8*rxt(k,403)*y(k,157) + mat(k,2130) = .450_r8*rxt(k,502)*y(k,293) + mat(k,3252) = rxt(k,338)*y(k,250) + rxt(k,392)*y(k,284) + rxt(k,704)*y(k,300) & + + rxt(k,722)*y(k,302) + rxt(k,752)*y(k,305) + mat(k,3897) = rxt(k,393)*y(k,284) + rxt(k,705)*y(k,300) + rxt(k,723)*y(k,302) & + + rxt(k,753)*y(k,305) + mat(k,1453) = rxt(k,348)*y(k,293) + mat(k,3074) = .190_r8*rxt(k,642)*y(k,17) + .200_r8*rxt(k,354)*y(k,30) & + + .420_r8*rxt(k,486)*y(k,109) + .100_r8*rxt(k,403)*y(k,132) + mat(k,649) = 2.000_r8*rxt(k,718)*y(k,293) + mat(k,658) = 3.000_r8*rxt(k,737)*y(k,293) + mat(k,769) = .290_r8*rxt(k,748)*y(k,293) + mat(k,361) = .290_r8*rxt(k,746)*y(k,293) + mat(k,366) = .290_r8*rxt(k,747)*y(k,293) + mat(k,2294) = rxt(k,586)*y(k,250) + rxt(k,591)*y(k,300) + rxt(k,592)*y(k,302) & + + rxt(k,593)*y(k,305) + mat(k,2458) = rxt(k,594)*y(k,250) + rxt(k,599)*y(k,300) + rxt(k,600)*y(k,302) & + + rxt(k,601)*y(k,305) + mat(k,2211) = rxt(k,606)*y(k,250) + rxt(k,611)*y(k,300) + rxt(k,612)*y(k,302) & + + rxt(k,613)*y(k,305) + mat(k,2320) = rxt(k,614)*y(k,250) + rxt(k,619)*y(k,300) + rxt(k,620)*y(k,302) & + + rxt(k,621)*y(k,305) + mat(k,2526) = rxt(k,626)*y(k,250) + rxt(k,631)*y(k,300) + rxt(k,632)*y(k,302) & + + rxt(k,633)*y(k,305) + mat(k,2404) = rxt(k,634)*y(k,250) + rxt(k,639)*y(k,300) + rxt(k,640)*y(k,302) & + + rxt(k,641)*y(k,305) + mat(k,2973) = rxt(k,338)*y(k,147) + rxt(k,586)*y(k,235) + rxt(k,594)*y(k,236) & + + rxt(k,606)*y(k,238) + rxt(k,614)*y(k,239) + rxt(k,626) & + *y(k,243) + rxt(k,634)*y(k,244) + 4.000_r8*rxt(k,335)*y(k,250) & + + .900_r8*rxt(k,336)*y(k,251) + .490_r8*rxt(k,337)*y(k,256) & + + rxt(k,424)*y(k,259) + rxt(k,430)*y(k,260) + rxt(k,444) & + *y(k,265) + rxt(k,448)*y(k,266) + rxt(k,474)*y(k,272) & + + rxt(k,491)*y(k,276) + rxt(k,495)*y(k,277) + rxt(k,645) & + *y(k,279) + rxt(k,654)*y(k,280) + rxt(k,381)*y(k,282) & + + 2.000_r8*rxt(k,388)*y(k,284) + rxt(k,400)*y(k,287) & + + rxt(k,665)*y(k,288) + rxt(k,674)*y(k,289) + rxt(k,693) & + *y(k,299) + 2.000_r8*rxt(k,701)*y(k,300) + rxt(k,709)*y(k,301) & + + 2.000_r8*rxt(k,719)*y(k,302) + rxt(k,728)*y(k,303) & + + rxt(k,738)*y(k,304) + 2.000_r8*rxt(k,749)*y(k,305) + mat(k,3987) = .900_r8*rxt(k,336)*y(k,250) + rxt(k,389)*y(k,284) + rxt(k,702) & + *y(k,300) + rxt(k,720)*y(k,302) + rxt(k,750)*y(k,305) + mat(k,3507) = .490_r8*rxt(k,337)*y(k,250) + .490_r8*rxt(k,390)*y(k,284) & + + .490_r8*rxt(k,703)*y(k,300) + .490_r8*rxt(k,721)*y(k,302) & + + .490_r8*rxt(k,751)*y(k,305) + mat(k,1946) = rxt(k,424)*y(k,250) + mat(k,1983) = rxt(k,430)*y(k,250) + mat(k,1738) = rxt(k,444)*y(k,250) + mat(k,1766) = rxt(k,448)*y(k,250) + mat(k,2165) = rxt(k,474)*y(k,250) + mat(k,1843) = rxt(k,491)*y(k,250) + mat(k,1811) = rxt(k,495)*y(k,250) + mat(k,2494) = rxt(k,645)*y(k,250) + rxt(k,651)*y(k,300) + rxt(k,652)*y(k,302) & + + rxt(k,653)*y(k,305) + mat(k,2376) = rxt(k,654)*y(k,250) + rxt(k,659)*y(k,300) + rxt(k,660)*y(k,302) & + + rxt(k,661)*y(k,305) + mat(k,1542) = rxt(k,381)*y(k,250) + mat(k,1617) = rxt(k,392)*y(k,147) + rxt(k,393)*y(k,149) + 2.000_r8*rxt(k,388) & + *y(k,250) + rxt(k,389)*y(k,251) + .490_r8*rxt(k,390)*y(k,256) & + + 4.000_r8*rxt(k,391)*y(k,284) + mat(k,1507) = rxt(k,400)*y(k,250) + mat(k,2690) = rxt(k,665)*y(k,250) + rxt(k,671)*y(k,300) + rxt(k,672)*y(k,302) & + + rxt(k,673)*y(k,305) + mat(k,2794) = rxt(k,674)*y(k,250) + rxt(k,679)*y(k,300) + rxt(k,680)*y(k,302) & + + rxt(k,681)*y(k,305) + mat(k,3758) = rxt(k,339)*y(k,51) + .500_r8*rxt(k,340)*y(k,52) + rxt(k,319) & + *y(k,63) + .800_r8*rxt(k,345)*y(k,76) + rxt(k,346)*y(k,77) & + + rxt(k,310)*y(k,90) + .540_r8*rxt(k,414)*y(k,98) & + + .540_r8*rxt(k,415)*y(k,99) + .360_r8*rxt(k,418)*y(k,103) & + + .190_r8*rxt(k,423)*y(k,108) + .450_r8*rxt(k,502)*y(k,139) & + + rxt(k,348)*y(k,150) + 2.000_r8*rxt(k,718)*y(k,202) & + + 3.000_r8*rxt(k,737)*y(k,204) + .290_r8*rxt(k,748)*y(k,205) & + + .290_r8*rxt(k,746)*y(k,206) + .290_r8*rxt(k,747)*y(k,207) + mat(k,2725) = rxt(k,693)*y(k,250) + rxt(k,698)*y(k,300) + rxt(k,699)*y(k,302) & + + rxt(k,700)*y(k,305) + mat(k,2922) = rxt(k,704)*y(k,147) + rxt(k,705)*y(k,149) + rxt(k,591)*y(k,235) & + + rxt(k,599)*y(k,236) + rxt(k,611)*y(k,238) + rxt(k,619) & + *y(k,239) + rxt(k,631)*y(k,243) + rxt(k,639)*y(k,244) & + + 2.000_r8*rxt(k,701)*y(k,250) + rxt(k,702)*y(k,251) & + + .490_r8*rxt(k,703)*y(k,256) + rxt(k,651)*y(k,279) + rxt(k,659) & + *y(k,280) + rxt(k,671)*y(k,288) + rxt(k,679)*y(k,289) & + + rxt(k,698)*y(k,299) + 4.000_r8*rxt(k,706)*y(k,300) & + + rxt(k,714)*y(k,301) + 2.000_r8*rxt(k,724)*y(k,302) & + + rxt(k,733)*y(k,303) + rxt(k,743)*y(k,304) & + + 2.000_r8*rxt(k,707)*y(k,305) + mat(k,2768) = rxt(k,709)*y(k,250) + rxt(k,714)*y(k,300) + rxt(k,715)*y(k,302) & + + rxt(k,716)*y(k,305) + mat(k,2829) = rxt(k,722)*y(k,147) + rxt(k,723)*y(k,149) + rxt(k,592)*y(k,235) & + + rxt(k,600)*y(k,236) + rxt(k,612)*y(k,238) + rxt(k,620) & + *y(k,239) + rxt(k,632)*y(k,243) + rxt(k,640)*y(k,244) & + + 2.000_r8*rxt(k,719)*y(k,250) + rxt(k,720)*y(k,251) & + + .490_r8*rxt(k,721)*y(k,256) + rxt(k,652)*y(k,279) + rxt(k,660) & + *y(k,280) + rxt(k,672)*y(k,288) + rxt(k,680)*y(k,289) & + + rxt(k,699)*y(k,299) + 2.000_r8*rxt(k,724)*y(k,300) & + + rxt(k,715)*y(k,301) + 4.000_r8*rxt(k,725)*y(k,302) & + + rxt(k,734)*y(k,303) + rxt(k,744)*y(k,304) & + + 2.000_r8*rxt(k,726)*y(k,305) + mat(k,2232) = rxt(k,728)*y(k,250) + rxt(k,733)*y(k,300) + rxt(k,734)*y(k,302) & + + rxt(k,735)*y(k,305) + mat(k,2746) = rxt(k,738)*y(k,250) + rxt(k,743)*y(k,300) + rxt(k,744)*y(k,302) & + + rxt(k,745)*y(k,305) + mat(k,2876) = rxt(k,752)*y(k,147) + rxt(k,753)*y(k,149) + rxt(k,593)*y(k,235) & + + rxt(k,601)*y(k,236) + rxt(k,613)*y(k,238) + rxt(k,621) & + *y(k,239) + rxt(k,633)*y(k,243) + rxt(k,641)*y(k,244) & + + 2.000_r8*rxt(k,749)*y(k,250) + rxt(k,750)*y(k,251) & + + .490_r8*rxt(k,751)*y(k,256) + rxt(k,653)*y(k,279) + rxt(k,661) & + *y(k,280) + rxt(k,673)*y(k,288) + rxt(k,681)*y(k,289) & + + rxt(k,700)*y(k,299) + 2.000_r8*rxt(k,707)*y(k,300) & + + rxt(k,716)*y(k,301) + 2.000_r8*rxt(k,726)*y(k,302) & + + rxt(k,735)*y(k,303) + rxt(k,745)*y(k,304) & + + 4.000_r8*rxt(k,754)*y(k,305) end do end subroutine nlnmat03 subroutine nlnmat04( avec_len, mat, y, rxt ) @@ -831,224 +960,214 @@ subroutine nlnmat04( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,2730) = -((rxt(k,178) + rxt(k,179) + rxt(k,180)) * y(k,256) + rxt(k,184) & + mat(k,260) = -(rxt(k,279)*y(k,292)) + mat(k,2626) = -rxt(k,279)*y(k,65) + mat(k,158) = rxt(k,244)*y(k,292) + mat(k,163) = rxt(k,270)*y(k,292) + mat(k,169) = rxt(k,246)*y(k,292) + mat(k,137) = 2.000_r8*rxt(k,247)*y(k,292) + mat(k,173) = 2.000_r8*rxt(k,248)*y(k,292) + mat(k,141) = rxt(k,249)*y(k,292) + mat(k,125) = 2.000_r8*rxt(k,272)*y(k,292) + mat(k,256) = rxt(k,296)*y(k,292) + rxt(k,291)*y(k,293) + mat(k,301) = rxt(k,297)*y(k,292) + rxt(k,292)*y(k,293) + mat(k,2626) = mat(k,2626) + rxt(k,244)*y(k,35) + rxt(k,270)*y(k,36) & + + rxt(k,246)*y(k,38) + 2.000_r8*rxt(k,247)*y(k,39) & + + 2.000_r8*rxt(k,248)*y(k,40) + rxt(k,249)*y(k,41) & + + 2.000_r8*rxt(k,272)*y(k,80) + rxt(k,296)*y(k,85) + rxt(k,297) & + *y(k,86) + mat(k,3614) = rxt(k,291)*y(k,85) + rxt(k,292)*y(k,86) + mat(k,251) = -(rxt(k,280)*y(k,292)) + mat(k,2624) = -rxt(k,280)*y(k,66) + mat(k,133) = rxt(k,245)*y(k,292) + mat(k,168) = rxt(k,246)*y(k,292) + mat(k,247) = rxt(k,295)*y(k,292) + rxt(k,290)*y(k,293) + mat(k,2624) = mat(k,2624) + rxt(k,245)*y(k,37) + rxt(k,246)*y(k,38) & + + rxt(k,295)*y(k,84) + mat(k,3612) = rxt(k,290)*y(k,84) + mat(k,216) = -(rxt(k,554)*y(k,293)) + mat(k,3606) = -rxt(k,554)*y(k,67) + mat(k,210) = .180_r8*rxt(k,574)*y(k,293) + mat(k,3606) = mat(k,3606) + .180_r8*rxt(k,574)*y(k,226) + mat(k,632) = -(rxt(k,376)*y(k,293)) + mat(k,3668) = -rxt(k,376)*y(k,68) + mat(k,620) = .070_r8*rxt(k,414)*y(k,293) + mat(k,677) = .170_r8*rxt(k,415)*y(k,293) + mat(k,3668) = mat(k,3668) + .070_r8*rxt(k,414)*y(k,98) + .170_r8*rxt(k,415) & + *y(k,99) + mat(k,320) = -(rxt(k,793)*y(k,149) + (rxt(k,794) + rxt(k,808)) * y(k,293)) + mat(k,3872) = -rxt(k,793)*y(k,69) + mat(k,3625) = -(rxt(k,794) + rxt(k,808)) * y(k,69) + mat(k,857) = rxt(k,341)*y(k,256) + mat(k,3414) = rxt(k,341)*y(k,255) + mat(k,1278) = -(rxt(k,275)*y(k,55) + rxt(k,276)*y(k,79) + rxt(k,277)*y(k,317) & + + rxt(k,278)*y(k,93)) + mat(k,2255) = -rxt(k,275)*y(k,75) + mat(k,1670) = -rxt(k,276)*y(k,75) + mat(k,4111) = -rxt(k,277)*y(k,75) + mat(k,3323) = -rxt(k,278)*y(k,75) + mat(k,164) = rxt(k,270)*y(k,292) + mat(k,174) = rxt(k,248)*y(k,292) + mat(k,261) = 2.000_r8*rxt(k,279)*y(k,292) + mat(k,252) = rxt(k,280)*y(k,292) + mat(k,2632) = rxt(k,270)*y(k,36) + rxt(k,248)*y(k,40) + 2.000_r8*rxt(k,279) & + *y(k,65) + rxt(k,280)*y(k,66) + mat(k,1710) = -(rxt(k,345)*y(k,293)) + mat(k,3765) = -rxt(k,345)*y(k,76) + mat(k,2102) = .830_r8*rxt(k,459)*y(k,157) + mat(k,913) = rxt(k,488)*y(k,293) + mat(k,1890) = .070_r8*rxt(k,490)*y(k,293) + mat(k,3258) = .570_r8*rxt(k,503)*y(k,258) + .940_r8*rxt(k,513)*y(k,267) & + + .730_r8*rxt(k,515)*y(k,268) + .340_r8*rxt(k,521)*y(k,271) & + + .400_r8*rxt(k,525)*y(k,273) + .760_r8*rxt(k,537)*y(k,287) + mat(k,3077) = .830_r8*rxt(k,459)*y(k,115) + mat(k,2977) = .750_r8*rxt(k,400)*y(k,287) + mat(k,3993) = .380_r8*rxt(k,401)*y(k,287) + mat(k,3514) = .370_r8*rxt(k,421)*y(k,258) + .550_r8*rxt(k,457)*y(k,267) & + + .460_r8*rxt(k,461)*y(k,268) + .150_r8*rxt(k,471)*y(k,271) & + + .280_r8*rxt(k,479)*y(k,273) + .360_r8*rxt(k,402)*y(k,287) + mat(k,1298) = .570_r8*rxt(k,503)*y(k,147) + .370_r8*rxt(k,421)*y(k,256) + mat(k,1123) = .940_r8*rxt(k,513)*y(k,147) + .550_r8*rxt(k,457)*y(k,256) + mat(k,1167) = .730_r8*rxt(k,515)*y(k,147) + .460_r8*rxt(k,461)*y(k,256) + mat(k,1443) = .340_r8*rxt(k,521)*y(k,147) + .150_r8*rxt(k,471)*y(k,256) + mat(k,1312) = .400_r8*rxt(k,525)*y(k,147) + .280_r8*rxt(k,479)*y(k,256) + mat(k,1508) = .760_r8*rxt(k,537)*y(k,147) + .750_r8*rxt(k,400)*y(k,250) & + + .380_r8*rxt(k,401)*y(k,251) + .360_r8*rxt(k,402)*y(k,256) + mat(k,3765) = mat(k,3765) + rxt(k,488)*y(k,122) + .070_r8*rxt(k,490)*y(k,123) + mat(k,1474) = -(rxt(k,346)*y(k,293)) + mat(k,3746) = -rxt(k,346)*y(k,77) + mat(k,310) = .650_r8*rxt(k,321)*y(k,293) + mat(k,1708) = .200_r8*rxt(k,345)*y(k,293) + mat(k,820) = .890_r8*rxt(k,347)*y(k,293) + mat(k,2096) = .170_r8*rxt(k,459)*y(k,157) + mat(k,2064) = .170_r8*rxt(k,469)*y(k,157) + mat(k,1566) = .170_r8*rxt(k,484)*y(k,157) + mat(k,2127) = .660_r8*rxt(k,501)*y(k,157) + mat(k,3243) = rxt(k,545)*y(k,241) + .230_r8*rxt(k,503)*y(k,258) & + + .400_r8*rxt(k,559)*y(k,283) + .170_r8*rxt(k,562)*y(k,285) & + + .130_r8*rxt(k,539)*y(k,291) + .700_r8*rxt(k,565)*y(k,294) & + + .600_r8*rxt(k,572)*y(k,312) + .340_r8*rxt(k,578)*y(k,314) & + + .170_r8*rxt(k,581)*y(k,316) + mat(k,3068) = .170_r8*rxt(k,459)*y(k,115) + .170_r8*rxt(k,469)*y(k,118) & + + .170_r8*rxt(k,484)*y(k,121) + .660_r8*rxt(k,501)*y(k,139) + mat(k,527) = rxt(k,545)*y(k,147) + mat(k,3497) = .150_r8*rxt(k,421)*y(k,258) + .160_r8*rxt(k,558)*y(k,283) & + + .070_r8*rxt(k,561)*y(k,285) + .100_r8*rxt(k,499)*y(k,291) + mat(k,1297) = .230_r8*rxt(k,503)*y(k,147) + .150_r8*rxt(k,421)*y(k,256) + mat(k,867) = .400_r8*rxt(k,559)*y(k,147) + .160_r8*rxt(k,558)*y(k,256) + mat(k,923) = .170_r8*rxt(k,562)*y(k,147) + .070_r8*rxt(k,561)*y(k,256) + mat(k,1635) = .130_r8*rxt(k,539)*y(k,147) + .100_r8*rxt(k,499)*y(k,256) + mat(k,3746) = mat(k,3746) + .650_r8*rxt(k,321)*y(k,25) + .200_r8*rxt(k,345) & + *y(k,76) + .890_r8*rxt(k,347)*y(k,89) + mat(k,454) = .700_r8*rxt(k,565)*y(k,147) + mat(k,880) = .600_r8*rxt(k,572)*y(k,147) + mat(k,896) = .340_r8*rxt(k,578)*y(k,147) + mat(k,534) = .170_r8*rxt(k,581)*y(k,147) + mat(k,2573) = -((rxt(k,178) + rxt(k,179) + rxt(k,180)) * y(k,256) + rxt(k,184) & *y(k,157)) - mat(k,3280) = -(rxt(k,178) + rxt(k,179) + rxt(k,180)) * y(k,78) - mat(k,2985) = -rxt(k,184)*y(k,78) - mat(k,3330) = rxt(k,301)*y(k,293) - mat(k,3822) = rxt(k,220)*y(k,79) - mat(k,1541) = rxt(k,320)*y(k,293) - mat(k,900) = rxt(k,276)*y(k,79) - mat(k,1418) = rxt(k,220)*y(k,57) + rxt(k,276)*y(k,75) + rxt(k,176)*y(k,156) & + mat(k,3552) = -(rxt(k,178) + rxt(k,179) + rxt(k,180)) * y(k,78) + mat(k,3114) = -rxt(k,184)*y(k,78) + mat(k,3351) = rxt(k,301)*y(k,293) + mat(k,2260) = rxt(k,316)*y(k,292) + mat(k,3852) = rxt(k,220)*y(k,79) + mat(k,1281) = rxt(k,276)*y(k,79) + mat(k,1673) = rxt(k,220)*y(k,57) + rxt(k,276)*y(k,75) + rxt(k,176)*y(k,156) & + rxt(k,168)*y(k,292) + rxt(k,185)*y(k,293) - mat(k,1041) = rxt(k,274)*y(k,292) - mat(k,3764) = rxt(k,251)*y(k,292) - mat(k,317) = rxt(k,206)*y(k,293) - mat(k,3451) = rxt(k,176)*y(k,79) + rxt(k,188)*y(k,293) - mat(k,305) = rxt(k,797)*y(k,293) - mat(k,457) = rxt(k,802)*y(k,293) - mat(k,1515) = rxt(k,807)*y(k,293) - mat(k,3101) = rxt(k,168)*y(k,79) + rxt(k,274)*y(k,83) + rxt(k,251)*y(k,87) - mat(k,3741) = rxt(k,301)*y(k,43) + rxt(k,320)*y(k,63) + rxt(k,185)*y(k,79) & - + rxt(k,206)*y(k,136) + rxt(k,188)*y(k,156) + rxt(k,797) & - *y(k,160) + rxt(k,802)*y(k,171) + rxt(k,807)*y(k,173) - mat(k,1416) = -(rxt(k,168)*y(k,292) + rxt(k,176)*y(k,156) + rxt(k,185) & + mat(k,1159) = rxt(k,274)*y(k,292) + mat(k,3147) = rxt(k,251)*y(k,292) + mat(k,475) = rxt(k,206)*y(k,293) + mat(k,3382) = rxt(k,176)*y(k,79) + rxt(k,188)*y(k,293) + mat(k,387) = rxt(k,796)*y(k,293) + mat(k,542) = rxt(k,802)*y(k,293) + mat(k,1601) = rxt(k,807)*y(k,293) + mat(k,2637) = rxt(k,316)*y(k,55) + rxt(k,168)*y(k,79) + rxt(k,274)*y(k,83) & + + rxt(k,251)*y(k,87) + mat(k,3802) = rxt(k,301)*y(k,43) + rxt(k,185)*y(k,79) + rxt(k,206)*y(k,136) & + + rxt(k,188)*y(k,156) + rxt(k,796)*y(k,160) + rxt(k,802) & + *y(k,171) + rxt(k,807)*y(k,173) + mat(k,1671) = -(rxt(k,168)*y(k,292) + rxt(k,176)*y(k,156) + rxt(k,185) & *y(k,293) + rxt(k,220)*y(k,57) + rxt(k,276)*y(k,75)) - mat(k,3098) = -rxt(k,168)*y(k,79) - mat(k,3446) = -rxt(k,176)*y(k,79) - mat(k,3686) = -rxt(k,185)*y(k,79) - mat(k,3816) = -rxt(k,220)*y(k,79) - mat(k,898) = -rxt(k,276)*y(k,79) - mat(k,2728) = rxt(k,178)*y(k,256) - mat(k,3225) = rxt(k,178)*y(k,78) - mat(k,1349) = -(rxt(k,177)*y(k,156) + rxt(k,186)*y(k,293) + rxt(k,221) & + mat(k,2633) = -rxt(k,168)*y(k,79) + mat(k,3377) = -rxt(k,176)*y(k,79) + mat(k,3762) = -rxt(k,185)*y(k,79) + mat(k,3846) = -rxt(k,220)*y(k,79) + mat(k,1279) = -rxt(k,276)*y(k,79) + mat(k,2257) = rxt(k,317)*y(k,292) + mat(k,2571) = rxt(k,178)*y(k,256) + mat(k,3511) = rxt(k,178)*y(k,78) + mat(k,2633) = mat(k,2633) + rxt(k,317)*y(k,55) + mat(k,124) = -(rxt(k,272)*y(k,292)) + mat(k,2613) = -rxt(k,272)*y(k,80) + mat(k,1485) = -(rxt(k,177)*y(k,156) + rxt(k,186)*y(k,293) + rxt(k,221) & *y(k,57)) - mat(k,3445) = -rxt(k,177)*y(k,81) - mat(k,3679) = -rxt(k,186)*y(k,81) - mat(k,3814) = -rxt(k,221)*y(k,81) - mat(k,1104) = .220_r8*rxt(k,603)*y(k,157) - mat(k,860) = .170_r8*rxt(k,623)*y(k,157) - mat(k,946) = .320_r8*rxt(k,643)*y(k,157) - mat(k,1286) = .030_r8*rxt(k,487)*y(k,157) - mat(k,1919) = .660_r8*rxt(k,460)*y(k,157) - mat(k,1952) = .660_r8*rxt(k,470)*y(k,157) - mat(k,1437) = .660_r8*rxt(k,485)*y(k,157) - mat(k,962) = .330_r8*rxt(k,663)*y(k,157) - mat(k,1984) = .660_r8*rxt(k,502)*y(k,157) - mat(k,2933) = .220_r8*rxt(k,603)*y(k,4) + .170_r8*rxt(k,623)*y(k,7) & - + .320_r8*rxt(k,643)*y(k,17) + .030_r8*rxt(k,487)*y(k,109) & - + .660_r8*rxt(k,460)*y(k,115) + .660_r8*rxt(k,470)*y(k,118) & - + .660_r8*rxt(k,485)*y(k,121) + .330_r8*rxt(k,663)*y(k,125) & - + .660_r8*rxt(k,502)*y(k,139) + .020_r8*rxt(k,763)*y(k,210) & - + .040_r8*rxt(k,768)*y(k,211) - mat(k,2416) = .020_r8*rxt(k,763)*y(k,157) - mat(k,2387) = .040_r8*rxt(k,768)*y(k,157) - mat(k,3218) = 2.000_r8*rxt(k,192)*y(k,256) - mat(k,3679) = mat(k,3679) + 2.000_r8*rxt(k,191)*y(k,293) - mat(k,213) = rxt(k,810)*y(k,317) - mat(k,3838) = rxt(k,810)*y(k,175) - mat(k,1039) = -(rxt(k,267)*y(k,156) + rxt(k,268)*y(k,293) + (rxt(k,273) & + mat(k,3375) = -rxt(k,177)*y(k,81) + mat(k,3748) = -rxt(k,186)*y(k,81) + mat(k,3843) = -rxt(k,221)*y(k,81) + mat(k,1248) = .220_r8*rxt(k,602)*y(k,157) + mat(k,1029) = .170_r8*rxt(k,622)*y(k,157) + mat(k,1095) = .320_r8*rxt(k,642)*y(k,157) + mat(k,1391) = .030_r8*rxt(k,486)*y(k,157) + mat(k,2098) = .660_r8*rxt(k,459)*y(k,157) + mat(k,2065) = .660_r8*rxt(k,469)*y(k,157) + mat(k,1568) = .660_r8*rxt(k,484)*y(k,157) + mat(k,1070) = .330_r8*rxt(k,662)*y(k,157) + mat(k,2129) = .660_r8*rxt(k,501)*y(k,157) + mat(k,3070) = .220_r8*rxt(k,602)*y(k,4) + .170_r8*rxt(k,622)*y(k,7) & + + .320_r8*rxt(k,642)*y(k,17) + .030_r8*rxt(k,486)*y(k,109) & + + .660_r8*rxt(k,459)*y(k,115) + .660_r8*rxt(k,469)*y(k,118) & + + .660_r8*rxt(k,484)*y(k,121) + .330_r8*rxt(k,662)*y(k,125) & + + .660_r8*rxt(k,501)*y(k,139) + .020_r8*rxt(k,762)*y(k,210) & + + .040_r8*rxt(k,767)*y(k,211) + mat(k,2657) = .020_r8*rxt(k,762)*y(k,157) + mat(k,2344) = .040_r8*rxt(k,767)*y(k,157) + mat(k,3499) = 2.000_r8*rxt(k,192)*y(k,256) + mat(k,3748) = mat(k,3748) + 2.000_r8*rxt(k,191)*y(k,293) + mat(k,275) = rxt(k,809)*y(k,317) + mat(k,4107) = rxt(k,809)*y(k,175) + mat(k,1156) = -(rxt(k,267)*y(k,156) + rxt(k,268)*y(k,293) + (rxt(k,273) & + rxt(k,274)) * y(k,292)) - mat(k,3441) = -rxt(k,267)*y(k,83) - mat(k,3651) = -rxt(k,268)*y(k,83) - mat(k,3097) = -(rxt(k,273) + rxt(k,274)) * y(k,83) - mat(k,1683) = rxt(k,254)*y(k,43) + rxt(k,255)*y(k,256) - mat(k,3323) = rxt(k,254)*y(k,18) - mat(k,3197) = rxt(k,255)*y(k,18) - mat(k,3775) = -(rxt(k,238)*y(k,156) + rxt(k,239)*y(k,293) + (rxt(k,250) & - + rxt(k,251)) * y(k,292) + (rxt(k,886) + rxt(k,892) + rxt(k,897) & - ) * y(k,96) + (rxt(k,891) + rxt(k,896) + rxt(k,901)) * y(k,61) & - + (rxt(k,893) + rxt(k,898)) * y(k,95)) - mat(k,3463) = -rxt(k,238)*y(k,87) - mat(k,3753) = -rxt(k,239)*y(k,87) - mat(k,3113) = -(rxt(k,250) + rxt(k,251)) * y(k,87) - mat(k,1068) = -(rxt(k,886) + rxt(k,892) + rxt(k,897)) * y(k,87) - mat(k,1220) = -(rxt(k,891) + rxt(k,896) + rxt(k,901)) * y(k,87) - mat(k,910) = -(rxt(k,893) + rxt(k,898)) * y(k,87) - mat(k,262) = rxt(k,331)*y(k,57) - mat(k,3342) = rxt(k,218)*y(k,57) - mat(k,3834) = rxt(k,331)*y(k,29) + rxt(k,218)*y(k,43) + rxt(k,220)*y(k,79) & - + rxt(k,221)*y(k,81) + rxt(k,240)*y(k,96) + rxt(k,222)*y(k,256) - mat(k,3318) = rxt(k,237)*y(k,293) - mat(k,1424) = rxt(k,220)*y(k,57) - mat(k,1353) = rxt(k,221)*y(k,57) - mat(k,1068) = mat(k,1068) + rxt(k,240)*y(k,57) - mat(k,3292) = rxt(k,222)*y(k,57) - mat(k,3753) = mat(k,3753) + rxt(k,237)*y(k,60) - mat(k,146) = -(rxt(k,310)*y(k,293) + rxt(k,319)*y(k,292)) - mat(k,3541) = -rxt(k,310)*y(k,88) - mat(k,3094) = -rxt(k,319)*y(k,88) - mat(k,721) = -(rxt(k,348)*y(k,293)) - mat(k,3621) = -rxt(k,348)*y(k,89) - mat(k,1427) = .700_r8*rxt(k,485)*y(k,157) - mat(k,2783) = .810_r8*rxt(k,528)*y(k,274) - mat(k,2913) = .700_r8*rxt(k,485)*y(k,121) - mat(k,3174) = .680_r8*rxt(k,483)*y(k,274) - mat(k,1252) = .810_r8*rxt(k,528)*y(k,147) + .680_r8*rxt(k,483)*y(k,256) - mat(k,1124) = -(rxt(k,311)*y(k,293)) - mat(k,3658) = -rxt(k,311)*y(k,90) - mat(k,944) = .080_r8*rxt(k,643)*y(k,157) - mat(k,254) = .350_r8*rxt(k,322)*y(k,293) - mat(k,500) = .370_r8*rxt(k,324)*y(k,157) - mat(k,1196) = .120_r8*rxt(k,355)*y(k,157) - mat(k,1119) = .500_r8*rxt(k,312)*y(k,293) - mat(k,410) = .400_r8*rxt(k,423)*y(k,293) - mat(k,1284) = .220_r8*rxt(k,487)*y(k,157) - mat(k,1745) = .330_r8*rxt(k,386)*y(k,157) - mat(k,1853) = .120_r8*rxt(k,404)*y(k,157) - mat(k,2809) = rxt(k,315)*y(k,257) - mat(k,2922) = .080_r8*rxt(k,643)*y(k,17) + .370_r8*rxt(k,324)*y(k,26) & - + .120_r8*rxt(k,355)*y(k,30) + .220_r8*rxt(k,487)*y(k,109) & - + .330_r8*rxt(k,386)*y(k,126) + .120_r8*rxt(k,404)*y(k,132) & - + .150_r8*rxt(k,763)*y(k,210) + .260_r8*rxt(k,768)*y(k,211) - mat(k,2415) = .150_r8*rxt(k,763)*y(k,157) - mat(k,2386) = .260_r8*rxt(k,768)*y(k,157) - mat(k,3202) = .500_r8*rxt(k,313)*y(k,257) - mat(k,595) = rxt(k,315)*y(k,147) + .500_r8*rxt(k,313)*y(k,256) - mat(k,3658) = mat(k,3658) + .350_r8*rxt(k,322)*y(k,25) + .500_r8*rxt(k,312) & - *y(k,92) + .400_r8*rxt(k,423)*y(k,107) - mat(k,896) = rxt(k,276)*y(k,79) + rxt(k,278)*y(k,93) + rxt(k,277)*y(k,317) - mat(k,1414) = rxt(k,276)*y(k,75) - mat(k,2714) = rxt(k,278)*y(k,75) - mat(k,3839) = rxt(k,277)*y(k,75) - mat(k,1118) = -(rxt(k,312)*y(k,293)) - mat(k,3657) = -rxt(k,312)*y(k,92) - mat(k,943) = .110_r8*rxt(k,643)*y(k,157) - mat(k,1283) = .330_r8*rxt(k,487)*y(k,157) - mat(k,2921) = .110_r8*rxt(k,643)*y(k,17) + .330_r8*rxt(k,487)*y(k,109) & - + .230_r8*rxt(k,763)*y(k,210) + .400_r8*rxt(k,768)*y(k,211) - mat(k,2414) = .230_r8*rxt(k,763)*y(k,157) - mat(k,2385) = .400_r8*rxt(k,768)*y(k,157) - mat(k,3201) = .500_r8*rxt(k,313)*y(k,257) - mat(k,594) = .500_r8*rxt(k,313)*y(k,256) - mat(k,2717) = -(rxt(k,215)*y(k,293) + rxt(k,278)*y(k,75)) - mat(k,3740) = -rxt(k,215)*y(k,93) - mat(k,899) = -rxt(k,278)*y(k,93) - mat(k,3329) = rxt(k,299)*y(k,149) - mat(k,1308) = rxt(k,333)*y(k,149) - mat(k,1847) = rxt(k,361)*y(k,149) - mat(k,1214) = (rxt(k,891)+rxt(k,896)+rxt(k,901))*y(k,87) - mat(k,240) = rxt(k,794)*y(k,149) - mat(k,3763) = (rxt(k,891)+rxt(k,896)+rxt(k,901))*y(k,61) - mat(k,3500) = rxt(k,214)*y(k,293) - mat(k,3076) = rxt(k,299)*y(k,43) + rxt(k,333)*y(k,46) + rxt(k,361)*y(k,50) & - + rxt(k,794)*y(k,69) + rxt(k,756)*y(k,200) + rxt(k,709)*y(k,201) & - + rxt(k,728)*y(k,203) - mat(k,2197) = rxt(k,756)*y(k,149) - mat(k,1171) = rxt(k,709)*y(k,149) - mat(k,1648) = rxt(k,728)*y(k,149) - mat(k,3740) = mat(k,3740) + rxt(k,214)*y(k,148) - mat(k,364) = -(rxt(k,193)*y(k,293)) - mat(k,3577) = -rxt(k,193)*y(k,94) - mat(k,3471) = rxt(k,212)*y(k,256) - mat(k,3148) = rxt(k,212)*y(k,148) - mat(k,906) = -(rxt(k,269)*y(k,156) + (rxt(k,893) + rxt(k,898)) * y(k,87)) - mat(k,3440) = -rxt(k,269)*y(k,95) - mat(k,3759) = -(rxt(k,893) + rxt(k,898)) * y(k,95) - mat(k,3782) = rxt(k,261)*y(k,256) - mat(k,3188) = rxt(k,261)*y(k,20) - mat(k,1064) = -(rxt(k,240)*y(k,57) + rxt(k,241)*y(k,156) + rxt(k,242) & - *y(k,293) + (rxt(k,886) + rxt(k,892) + rxt(k,897)) * y(k,87)) - mat(k,3808) = -rxt(k,240)*y(k,96) - mat(k,3442) = -rxt(k,241)*y(k,96) - mat(k,3653) = -rxt(k,242)*y(k,96) - mat(k,3760) = -(rxt(k,886) + rxt(k,892) + rxt(k,897)) * y(k,96) - mat(k,3300) = rxt(k,229)*y(k,256) - mat(k,1212) = rxt(k,234)*y(k,293) - mat(k,3199) = rxt(k,229)*y(k,60) - mat(k,3653) = mat(k,3653) + rxt(k,234)*y(k,61) - mat(k,876) = -(rxt(k,380)*y(k,293)) - mat(k,3637) = -rxt(k,380)*y(k,97) - mat(k,2796) = rxt(k,379)*y(k,253) - mat(k,535) = rxt(k,379)*y(k,147) - mat(k,542) = -(rxt(k,415)*y(k,293)) - mat(k,3603) = -rxt(k,415)*y(k,98) - mat(k,554) = -(rxt(k,416)*y(k,293)) - mat(k,3604) = -rxt(k,416)*y(k,99) - mat(k,419) = -(rxt(k,417)*y(k,293)) - mat(k,3586) = -rxt(k,417)*y(k,100) - mat(k,1876) = .090_r8*rxt(k,490)*y(k,293) - mat(k,3586) = mat(k,3586) + .090_r8*rxt(k,490)*y(k,123) - mat(k,426) = -(rxt(k,418)*y(k,293)) - mat(k,3587) = -rxt(k,418)*y(k,101) - mat(k,1877) = .090_r8*rxt(k,490)*y(k,293) - mat(k,3587) = mat(k,3587) + .090_r8*rxt(k,490)*y(k,123) - mat(k,1611) = -(rxt(k,363)*y(k,293)) - mat(k,3699) = -rxt(k,363)*y(k,102) - mat(k,1698) = .220_r8*rxt(k,419)*y(k,293) - mat(k,1238) = .500_r8*rxt(k,420)*y(k,293) - mat(k,1088) = .190_r8*rxt(k,424)*y(k,293) - mat(k,667) = .280_r8*rxt(k,457)*y(k,293) - mat(k,1958) = .830_r8*rxt(k,470)*y(k,157) - mat(k,799) = rxt(k,489)*y(k,293) - mat(k,1887) = .070_r8*rxt(k,491)*y(k,293) - mat(k,1619) = .500_r8*rxt(k,381)*y(k,293) - mat(k,1331) = rxt(k,388)*y(k,293) - mat(k,394) = .250_r8*rxt(k,399)*y(k,293) - mat(k,711) = .180_r8*rxt(k,683)*y(k,157) - mat(k,2841) = .290_r8*rxt(k,504)*y(k,258) + .730_r8*rxt(k,516)*y(k,268) & - + .870_r8*rxt(k,520)*y(k,270) + .330_r8*rxt(k,522)*y(k,271) & - + .070_r8*rxt(k,526)*y(k,273) + .860_r8*rxt(k,536)*y(k,282) - mat(k,2943) = .830_r8*rxt(k,470)*y(k,118) + .180_r8*rxt(k,683)*y(k,135) - mat(k,485) = .500_r8*rxt(k,368)*y(k,293) - mat(k,2660) = .860_r8*rxt(k,382)*y(k,282) - mat(k,3379) = .900_r8*rxt(k,383)*y(k,282) + .200_r8*rxt(k,369)*y(k,296) - mat(k,3237) = .190_r8*rxt(k,422)*y(k,258) + .460_r8*rxt(k,462)*y(k,268) & - + .440_r8*rxt(k,468)*y(k,270) + .150_r8*rxt(k,472)*y(k,271) & - + .060_r8*rxt(k,480)*y(k,273) + .510_r8*rxt(k,384)*y(k,282) - mat(k,1407) = .290_r8*rxt(k,504)*y(k,147) + .190_r8*rxt(k,422)*y(k,256) - mat(k,1075) = .730_r8*rxt(k,516)*y(k,147) + .460_r8*rxt(k,462)*y(k,256) - mat(k,1014) = .870_r8*rxt(k,520)*y(k,147) + .440_r8*rxt(k,468)*y(k,256) - mat(k,1321) = .330_r8*rxt(k,522)*y(k,147) + .150_r8*rxt(k,472)*y(k,256) - mat(k,1186) = .070_r8*rxt(k,526)*y(k,147) + .060_r8*rxt(k,480)*y(k,256) - mat(k,1385) = .860_r8*rxt(k,536)*y(k,147) + .860_r8*rxt(k,382)*y(k,250) & - + .900_r8*rxt(k,383)*y(k,251) + .510_r8*rxt(k,384)*y(k,256) - mat(k,3699) = mat(k,3699) + .220_r8*rxt(k,419)*y(k,103) + .500_r8*rxt(k,420) & - *y(k,105) + .190_r8*rxt(k,424)*y(k,108) + .280_r8*rxt(k,457) & - *y(k,114) + rxt(k,489)*y(k,122) + .070_r8*rxt(k,491)*y(k,123) & - + .500_r8*rxt(k,381)*y(k,127) + rxt(k,388)*y(k,128) & - + .250_r8*rxt(k,399)*y(k,131) + .500_r8*rxt(k,368)*y(k,169) - mat(k,1226) = .200_r8*rxt(k,369)*y(k,251) + mat(k,3372) = -rxt(k,267)*y(k,83) + mat(k,3720) = -rxt(k,268)*y(k,83) + mat(k,2631) = -(rxt(k,273) + rxt(k,274)) * y(k,83) + mat(k,2197) = rxt(k,254)*y(k,43) + rxt(k,255)*y(k,256) + mat(k,3342) = rxt(k,254)*y(k,18) + mat(k,3479) = rxt(k,255)*y(k,18) + mat(k,246) = -(rxt(k,290)*y(k,293) + rxt(k,295)*y(k,292)) + mat(k,3611) = -rxt(k,290)*y(k,84) + mat(k,2623) = -rxt(k,295)*y(k,84) + mat(k,255) = -(rxt(k,291)*y(k,293) + rxt(k,296)*y(k,292)) + mat(k,3613) = -rxt(k,291)*y(k,85) + mat(k,2625) = -rxt(k,296)*y(k,85) + mat(k,302) = -(rxt(k,292)*y(k,293) + rxt(k,297)*y(k,292)) + mat(k,3622) = -rxt(k,292)*y(k,86) + mat(k,2627) = -rxt(k,297)*y(k,86) + mat(k,3151) = -(rxt(k,238)*y(k,156) + rxt(k,239)*y(k,293) + (rxt(k,250) & + + rxt(k,251)) * y(k,292) + (rxt(k,885) + rxt(k,891) + rxt(k,896) & + ) * y(k,96) + (rxt(k,890) + rxt(k,895) + rxt(k,900)) * y(k,61) & + + (rxt(k,892) + rxt(k,897)) * y(k,95)) + mat(k,3386) = -rxt(k,238)*y(k,87) + mat(k,3816) = -rxt(k,239)*y(k,87) + mat(k,2641) = -(rxt(k,250) + rxt(k,251)) * y(k,87) + mat(k,1144) = -(rxt(k,885) + rxt(k,891) + rxt(k,896)) * y(k,87) + mat(k,1325) = -(rxt(k,890) + rxt(k,895) + rxt(k,900)) * y(k,87) + mat(k,996) = -(rxt(k,892) + rxt(k,897)) * y(k,87) + mat(k,316) = rxt(k,330)*y(k,57) + mat(k,512) = rxt(k,281)*y(k,57) + mat(k,3355) = rxt(k,218)*y(k,57) + mat(k,642) = rxt(k,283)*y(k,57) + mat(k,392) = 2.000_r8*rxt(k,286)*y(k,57) + mat(k,2262) = rxt(k,219)*y(k,57) + mat(k,435) = rxt(k,288)*y(k,57) + mat(k,3857) = rxt(k,330)*y(k,29) + rxt(k,281)*y(k,42) + rxt(k,218)*y(k,43) & + + rxt(k,283)*y(k,44) + 2.000_r8*rxt(k,286)*y(k,47) + rxt(k,219) & + *y(k,55) + rxt(k,288)*y(k,56) + rxt(k,220)*y(k,79) + rxt(k,221) & + *y(k,81) + rxt(k,240)*y(k,96) + rxt(k,222)*y(k,256) + mat(k,2600) = rxt(k,237)*y(k,293) + mat(k,1675) = rxt(k,220)*y(k,57) + mat(k,1486) = rxt(k,221)*y(k,57) + mat(k,1144) = mat(k,1144) + rxt(k,240)*y(k,57) + mat(k,3566) = rxt(k,222)*y(k,57) + mat(k,3816) = mat(k,3816) + rxt(k,237)*y(k,60) end do end subroutine nlnmat04 subroutine nlnmat05( avec_len, mat, y, rxt ) @@ -1069,208 +1188,209 @@ subroutine nlnmat05( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,1700) = -(rxt(k,419)*y(k,293)) - mat(k,3705) = -rxt(k,419)*y(k,103) - mat(k,1889) = .130_r8*rxt(k,490)*y(k,293) - mat(k,2847) = .450_r8*rxt(k,510)*y(k,265) + .450_r8*rxt(k,512)*y(k,266) & - + .450_r8*rxt(k,531)*y(k,276) + .450_r8*rxt(k,534)*y(k,277) - mat(k,2664) = .450_r8*rxt(k,445)*y(k,265) + .450_r8*rxt(k,449)*y(k,266) & - + .450_r8*rxt(k,492)*y(k,276) + .450_r8*rxt(k,496)*y(k,277) - mat(k,3384) = .250_r8*rxt(k,432)*y(k,260) + .470_r8*rxt(k,446)*y(k,265) & - + .470_r8*rxt(k,450)*y(k,266) + .470_r8*rxt(k,493)*y(k,276) & - + .470_r8*rxt(k,497)*y(k,277) - mat(k,1728) = .250_r8*rxt(k,432)*y(k,251) - mat(k,1552) = .450_r8*rxt(k,510)*y(k,147) + .450_r8*rxt(k,445)*y(k,250) & - + .470_r8*rxt(k,446)*y(k,251) - mat(k,1573) = .450_r8*rxt(k,512)*y(k,147) + .450_r8*rxt(k,449)*y(k,250) & - + .470_r8*rxt(k,450)*y(k,251) - mat(k,1779) = .450_r8*rxt(k,531)*y(k,147) + .450_r8*rxt(k,492)*y(k,250) & - + .470_r8*rxt(k,493)*y(k,251) - mat(k,1668) = .450_r8*rxt(k,534)*y(k,147) + .450_r8*rxt(k,496)*y(k,250) & - + .470_r8*rxt(k,497)*y(k,251) - mat(k,3705) = mat(k,3705) + .130_r8*rxt(k,490)*y(k,123) - mat(k,807) = -(rxt(k,364)*y(k,293)) - mat(k,3630) = -rxt(k,364)*y(k,104) - mat(k,567) = rxt(k,377)*y(k,293) - mat(k,556) = .150_r8*rxt(k,416)*y(k,293) - mat(k,1429) = .130_r8*rxt(k,485)*y(k,157) - mat(k,2790) = .150_r8*rxt(k,528)*y(k,274) - mat(k,2915) = .130_r8*rxt(k,485)*y(k,121) - mat(k,3181) = .120_r8*rxt(k,483)*y(k,274) - mat(k,1253) = .150_r8*rxt(k,528)*y(k,147) + .120_r8*rxt(k,483)*y(k,256) - mat(k,3630) = mat(k,3630) + rxt(k,377)*y(k,68) + .150_r8*rxt(k,416)*y(k,99) - mat(k,1236) = -(rxt(k,420)*y(k,293)) - mat(k,3669) = -rxt(k,420)*y(k,105) - mat(k,545) = .080_r8*rxt(k,415)*y(k,293) - mat(k,557) = .180_r8*rxt(k,416)*y(k,293) - mat(k,420) = .580_r8*rxt(k,417)*y(k,293) - mat(k,427) = .770_r8*rxt(k,418)*y(k,293) - mat(k,803) = .190_r8*rxt(k,421)*y(k,293) - mat(k,1981) = .040_r8*rxt(k,503)*y(k,293) - mat(k,3669) = mat(k,3669) + .080_r8*rxt(k,415)*y(k,98) + .180_r8*rxt(k,416) & - *y(k,99) + .580_r8*rxt(k,417)*y(k,100) + .770_r8*rxt(k,418) & - *y(k,101) + .190_r8*rxt(k,421)*y(k,106) + .040_r8*rxt(k,503) & + mat(k,195) = -(rxt(k,309)*y(k,293) + rxt(k,318)*y(k,292)) + mat(k,3602) = -rxt(k,309)*y(k,88) + mat(k,2621) = -rxt(k,318)*y(k,88) + mat(k,819) = -(rxt(k,347)*y(k,293)) + mat(k,3689) = -rxt(k,347)*y(k,89) + mat(k,1560) = .700_r8*rxt(k,484)*y(k,157) + mat(k,3204) = .810_r8*rxt(k,527)*y(k,274) + mat(k,3049) = .700_r8*rxt(k,484)*y(k,121) + mat(k,3455) = .680_r8*rxt(k,482)*y(k,274) + mat(k,1411) = .810_r8*rxt(k,527)*y(k,147) + .680_r8*rxt(k,482)*y(k,256) + mat(k,1357) = -(rxt(k,310)*y(k,293)) + mat(k,3737) = -rxt(k,310)*y(k,90) + mat(k,1094) = .080_r8*rxt(k,642)*y(k,157) + mat(k,309) = .350_r8*rxt(k,321)*y(k,293) + mat(k,592) = .370_r8*rxt(k,323)*y(k,157) + mat(k,1364) = .120_r8*rxt(k,354)*y(k,157) + mat(k,1209) = .500_r8*rxt(k,311)*y(k,293) + mat(k,490) = .400_r8*rxt(k,422)*y(k,293) + mat(k,1389) = .220_r8*rxt(k,486)*y(k,157) + mat(k,2014) = .330_r8*rxt(k,385)*y(k,157) + mat(k,2036) = .120_r8*rxt(k,403)*y(k,157) + mat(k,3236) = rxt(k,314)*y(k,257) + mat(k,3063) = .080_r8*rxt(k,642)*y(k,17) + .370_r8*rxt(k,323)*y(k,26) & + + .120_r8*rxt(k,354)*y(k,30) + .220_r8*rxt(k,486)*y(k,109) & + + .330_r8*rxt(k,385)*y(k,126) + .120_r8*rxt(k,403)*y(k,132) & + + .150_r8*rxt(k,762)*y(k,210) + .260_r8*rxt(k,767)*y(k,211) + mat(k,2656) = .150_r8*rxt(k,762)*y(k,157) + mat(k,2343) = .260_r8*rxt(k,767)*y(k,157) + mat(k,3490) = .500_r8*rxt(k,312)*y(k,257) + mat(k,693) = rxt(k,314)*y(k,147) + .500_r8*rxt(k,312)*y(k,256) + mat(k,3737) = mat(k,3737) + .350_r8*rxt(k,321)*y(k,25) + .500_r8*rxt(k,311) & + *y(k,92) + .400_r8*rxt(k,422)*y(k,107) + mat(k,2254) = rxt(k,275)*y(k,75) + mat(k,1277) = rxt(k,275)*y(k,55) + rxt(k,276)*y(k,79) + rxt(k,278)*y(k,93) & + + rxt(k,277)*y(k,317) + mat(k,1669) = rxt(k,276)*y(k,75) + mat(k,3322) = rxt(k,278)*y(k,75) + mat(k,4109) = rxt(k,277)*y(k,75) + mat(k,1208) = -(rxt(k,311)*y(k,293)) + mat(k,3724) = -rxt(k,311)*y(k,92) + mat(k,1093) = .110_r8*rxt(k,642)*y(k,157) + mat(k,1388) = .330_r8*rxt(k,486)*y(k,157) + mat(k,3058) = .110_r8*rxt(k,642)*y(k,17) + .330_r8*rxt(k,486)*y(k,109) & + + .230_r8*rxt(k,762)*y(k,210) + .400_r8*rxt(k,767)*y(k,211) + mat(k,2655) = .230_r8*rxt(k,762)*y(k,157) + mat(k,2342) = .400_r8*rxt(k,767)*y(k,157) + mat(k,3483) = .500_r8*rxt(k,312)*y(k,257) + mat(k,692) = .500_r8*rxt(k,312)*y(k,256) + mat(k,3331) = -(rxt(k,215)*y(k,293) + rxt(k,278)*y(k,75)) + mat(k,3818) = -rxt(k,215)*y(k,93) + mat(k,1282) = -rxt(k,278)*y(k,93) + mat(k,3357) = rxt(k,299)*y(k,149) + mat(k,1432) = rxt(k,332)*y(k,149) + mat(k,1912) = rxt(k,360)*y(k,149) + mat(k,1326) = (rxt(k,890)+rxt(k,895)+rxt(k,900))*y(k,87) + mat(k,322) = rxt(k,793)*y(k,149) + mat(k,3153) = (rxt(k,890)+rxt(k,895)+rxt(k,900))*y(k,61) + mat(k,4097) = rxt(k,214)*y(k,293) + mat(k,3953) = rxt(k,299)*y(k,43) + rxt(k,332)*y(k,46) + rxt(k,360)*y(k,50) & + + rxt(k,793)*y(k,69) + rxt(k,755)*y(k,200) + rxt(k,708)*y(k,201) & + + rxt(k,727)*y(k,203) + mat(k,2370) = rxt(k,755)*y(k,149) + mat(k,1291) = rxt(k,708)*y(k,149) + mat(k,1720) = rxt(k,727)*y(k,149) + mat(k,3818) = mat(k,3818) + rxt(k,214)*y(k,148) + mat(k,446) = -(rxt(k,193)*y(k,293)) + mat(k,3643) = -rxt(k,193)*y(k,94) + mat(k,4059) = rxt(k,212)*y(k,256) + mat(k,3429) = rxt(k,212)*y(k,148) + mat(k,993) = -(rxt(k,269)*y(k,156) + (rxt(k,892) + rxt(k,897)) * y(k,87)) + mat(k,3370) = -rxt(k,269)*y(k,95) + mat(k,3142) = -(rxt(k,892) + rxt(k,897)) * y(k,95) + mat(k,2551) = rxt(k,261)*y(k,256) + mat(k,3469) = rxt(k,261)*y(k,20) + mat(k,1142) = -(rxt(k,240)*y(k,57) + rxt(k,241)*y(k,156) + rxt(k,242) & + *y(k,293) + (rxt(k,885) + rxt(k,891) + rxt(k,896)) * y(k,87)) + mat(k,3837) = -rxt(k,240)*y(k,96) + mat(k,3371) = -rxt(k,241)*y(k,96) + mat(k,3718) = -rxt(k,242)*y(k,96) + mat(k,3143) = -(rxt(k,885) + rxt(k,891) + rxt(k,896)) * y(k,96) + mat(k,2590) = rxt(k,229)*y(k,256) + mat(k,1322) = rxt(k,234)*y(k,293) + mat(k,3477) = rxt(k,229)*y(k,60) + mat(k,3718) = mat(k,3718) + rxt(k,234)*y(k,61) + mat(k,972) = -(rxt(k,379)*y(k,293)) + mat(k,3705) = -rxt(k,379)*y(k,97) + mat(k,3216) = rxt(k,378)*y(k,253) + mat(k,603) = rxt(k,378)*y(k,147) + mat(k,619) = -(rxt(k,414)*y(k,293)) + mat(k,3667) = -rxt(k,414)*y(k,98) + mat(k,678) = -(rxt(k,415)*y(k,293)) + mat(k,3674) = -rxt(k,415)*y(k,99) + mat(k,481) = -(rxt(k,416)*y(k,293)) + mat(k,3649) = -rxt(k,416)*y(k,100) + mat(k,1881) = .090_r8*rxt(k,489)*y(k,293) + mat(k,3649) = mat(k,3649) + .090_r8*rxt(k,489)*y(k,123) + mat(k,498) = -(rxt(k,417)*y(k,293)) + mat(k,3651) = -rxt(k,417)*y(k,101) + mat(k,1882) = .090_r8*rxt(k,489)*y(k,293) + mat(k,3651) = mat(k,3651) + .090_r8*rxt(k,489)*y(k,123) + mat(k,1756) = -(rxt(k,362)*y(k,293)) + mat(k,3769) = -rxt(k,362)*y(k,102) + mat(k,1868) = .220_r8*rxt(k,418)*y(k,293) + mat(k,918) = .500_r8*rxt(k,419)*y(k,293) + mat(k,1268) = .190_r8*rxt(k,423)*y(k,293) + mat(k,776) = .280_r8*rxt(k,456)*y(k,293) + mat(k,2072) = .830_r8*rxt(k,469)*y(k,157) + mat(k,914) = rxt(k,488)*y(k,293) + mat(k,1891) = .070_r8*rxt(k,490)*y(k,293) + mat(k,1726) = .500_r8*rxt(k,380)*y(k,293) + mat(k,1460) = rxt(k,387)*y(k,293) + mat(k,518) = .250_r8*rxt(k,398)*y(k,293) + mat(k,847) = .180_r8*rxt(k,682)*y(k,157) + mat(k,3262) = .290_r8*rxt(k,503)*y(k,258) + .730_r8*rxt(k,515)*y(k,268) & + + .870_r8*rxt(k,519)*y(k,270) + .330_r8*rxt(k,521)*y(k,271) & + + .070_r8*rxt(k,525)*y(k,273) + .860_r8*rxt(k,535)*y(k,282) + mat(k,3081) = .830_r8*rxt(k,469)*y(k,118) + .180_r8*rxt(k,682)*y(k,135) + mat(k,585) = .500_r8*rxt(k,367)*y(k,293) + mat(k,2981) = .860_r8*rxt(k,381)*y(k,282) + mat(k,3997) = .900_r8*rxt(k,382)*y(k,282) + .200_r8*rxt(k,368)*y(k,296) + mat(k,3518) = .190_r8*rxt(k,421)*y(k,258) + .460_r8*rxt(k,461)*y(k,268) & + + .440_r8*rxt(k,467)*y(k,270) + .150_r8*rxt(k,471)*y(k,271) & + + .060_r8*rxt(k,479)*y(k,273) + .510_r8*rxt(k,383)*y(k,282) + mat(k,1299) = .290_r8*rxt(k,503)*y(k,147) + .190_r8*rxt(k,421)*y(k,256) + mat(k,1169) = .730_r8*rxt(k,515)*y(k,147) + .460_r8*rxt(k,461)*y(k,256) + mat(k,1134) = .870_r8*rxt(k,519)*y(k,147) + .440_r8*rxt(k,467)*y(k,256) + mat(k,1445) = .330_r8*rxt(k,521)*y(k,147) + .150_r8*rxt(k,471)*y(k,256) + mat(k,1314) = .070_r8*rxt(k,525)*y(k,147) + .060_r8*rxt(k,479)*y(k,256) + mat(k,1544) = .860_r8*rxt(k,535)*y(k,147) + .860_r8*rxt(k,381)*y(k,250) & + + .900_r8*rxt(k,382)*y(k,251) + .510_r8*rxt(k,383)*y(k,256) + mat(k,3769) = mat(k,3769) + .220_r8*rxt(k,418)*y(k,103) + .500_r8*rxt(k,419) & + *y(k,105) + .190_r8*rxt(k,423)*y(k,108) + .280_r8*rxt(k,456) & + *y(k,114) + rxt(k,488)*y(k,122) + .070_r8*rxt(k,490)*y(k,123) & + + .500_r8*rxt(k,380)*y(k,127) + rxt(k,387)*y(k,128) & + + .250_r8*rxt(k,398)*y(k,131) + .500_r8*rxt(k,367)*y(k,169) + mat(k,1336) = .200_r8*rxt(k,368)*y(k,251) + mat(k,1870) = -(rxt(k,418)*y(k,293)) + mat(k,3774) = -rxt(k,418)*y(k,103) + mat(k,1893) = .130_r8*rxt(k,489)*y(k,293) + mat(k,3267) = .450_r8*rxt(k,509)*y(k,265) + .450_r8*rxt(k,511)*y(k,266) & + + .450_r8*rxt(k,530)*y(k,276) + .450_r8*rxt(k,533)*y(k,277) + mat(k,2985) = .450_r8*rxt(k,444)*y(k,265) + .450_r8*rxt(k,448)*y(k,266) & + + .450_r8*rxt(k,491)*y(k,276) + .450_r8*rxt(k,495)*y(k,277) + mat(k,4002) = .250_r8*rxt(k,431)*y(k,260) + .470_r8*rxt(k,445)*y(k,265) & + + .470_r8*rxt(k,449)*y(k,266) + .470_r8*rxt(k,492)*y(k,276) & + + .470_r8*rxt(k,496)*y(k,277) + mat(k,1991) = .250_r8*rxt(k,431)*y(k,251) + mat(k,1742) = .450_r8*rxt(k,509)*y(k,147) + .450_r8*rxt(k,444)*y(k,250) & + + .470_r8*rxt(k,445)*y(k,251) + mat(k,1770) = .450_r8*rxt(k,511)*y(k,147) + .450_r8*rxt(k,448)*y(k,250) & + + .470_r8*rxt(k,449)*y(k,251) + mat(k,1847) = .450_r8*rxt(k,530)*y(k,147) + .450_r8*rxt(k,491)*y(k,250) & + + .470_r8*rxt(k,492)*y(k,251) + mat(k,1816) = .450_r8*rxt(k,533)*y(k,147) + .450_r8*rxt(k,495)*y(k,250) & + + .470_r8*rxt(k,496)*y(k,251) + mat(k,3774) = mat(k,3774) + .130_r8*rxt(k,489)*y(k,123) + mat(k,962) = -(rxt(k,363)*y(k,293)) + mat(k,3703) = -rxt(k,363)*y(k,104) + mat(k,633) = rxt(k,376)*y(k,293) + mat(k,680) = .150_r8*rxt(k,415)*y(k,293) + mat(k,1561) = .130_r8*rxt(k,484)*y(k,157) + mat(k,3214) = .150_r8*rxt(k,527)*y(k,274) + mat(k,3052) = .130_r8*rxt(k,484)*y(k,121) + mat(k,3466) = .120_r8*rxt(k,482)*y(k,274) + mat(k,1412) = .150_r8*rxt(k,527)*y(k,147) + .120_r8*rxt(k,482)*y(k,256) + mat(k,3703) = mat(k,3703) + rxt(k,376)*y(k,68) + .150_r8*rxt(k,415)*y(k,99) + mat(k,917) = -(rxt(k,419)*y(k,293)) + mat(k,3698) = -rxt(k,419)*y(k,105) + mat(k,621) = .080_r8*rxt(k,414)*y(k,293) + mat(k,679) = .180_r8*rxt(k,415)*y(k,293) + mat(k,482) = .580_r8*rxt(k,416)*y(k,293) + mat(k,499) = .770_r8*rxt(k,417)*y(k,293) + mat(k,1519) = .190_r8*rxt(k,420)*y(k,293) + mat(k,2125) = .040_r8*rxt(k,502)*y(k,293) + mat(k,3698) = mat(k,3698) + .080_r8*rxt(k,414)*y(k,98) + .180_r8*rxt(k,415) & + *y(k,99) + .580_r8*rxt(k,416)*y(k,100) + .770_r8*rxt(k,417) & + *y(k,101) + .190_r8*rxt(k,420)*y(k,106) + .040_r8*rxt(k,502) & *y(k,139) - mat(k,802) = -(rxt(k,421)*y(k,293)) - mat(k,3629) = -rxt(k,421)*y(k,106) - mat(k,1912) = .080_r8*rxt(k,461)*y(k,293) - mat(k,574) = .150_r8*rxt(k,464)*y(k,293) - mat(k,475) = .130_r8*rxt(k,467)*y(k,293) - mat(k,1946) = .040_r8*rxt(k,471)*y(k,293) - mat(k,1428) = .070_r8*rxt(k,486)*y(k,293) - mat(k,1879) = .850_r8*rxt(k,491)*y(k,293) - mat(k,3629) = mat(k,3629) + .080_r8*rxt(k,461)*y(k,115) + .150_r8*rxt(k,464) & - *y(k,116) + .130_r8*rxt(k,467)*y(k,117) + .040_r8*rxt(k,471) & - *y(k,118) + .070_r8*rxt(k,486)*y(k,121) + .850_r8*rxt(k,491) & + mat(k,1522) = -(rxt(k,420)*y(k,293)) + mat(k,3752) = -rxt(k,420)*y(k,106) + mat(k,2099) = .080_r8*rxt(k,460)*y(k,293) + mat(k,612) = .150_r8*rxt(k,463)*y(k,293) + mat(k,560) = .130_r8*rxt(k,466)*y(k,293) + mat(k,2067) = .040_r8*rxt(k,470)*y(k,293) + mat(k,1569) = .070_r8*rxt(k,485)*y(k,293) + mat(k,1888) = .850_r8*rxt(k,490)*y(k,293) + mat(k,3752) = mat(k,3752) + .080_r8*rxt(k,460)*y(k,115) + .150_r8*rxt(k,463) & + *y(k,116) + .130_r8*rxt(k,466)*y(k,117) + .040_r8*rxt(k,470) & + *y(k,118) + .070_r8*rxt(k,485)*y(k,121) + .850_r8*rxt(k,490) & *y(k,123) - mat(k,409) = -(rxt(k,423)*y(k,293)) - mat(k,3585) = -rxt(k,423)*y(k,107) - mat(k,409) = mat(k,409) + .200_r8*rxt(k,423)*y(k,293) - mat(k,1047) = .400_r8*rxt(k,482)*y(k,293) - mat(k,3585) = mat(k,3585) + .200_r8*rxt(k,423)*y(k,107) + .400_r8*rxt(k,482) & + mat(k,488) = -(rxt(k,422)*y(k,293)) + mat(k,3650) = -rxt(k,422)*y(k,107) + mat(k,488) = mat(k,488) + .200_r8*rxt(k,422)*y(k,293) + mat(k,1176) = .400_r8*rxt(k,481)*y(k,293) + mat(k,3650) = mat(k,3650) + .200_r8*rxt(k,422)*y(k,107) + .400_r8*rxt(k,481) & *y(k,120) - mat(k,1083) = -(rxt(k,424)*y(k,293)) - mat(k,3655) = -rxt(k,424)*y(k,108) - mat(k,1083) = mat(k,1083) + .060_r8*rxt(k,424)*y(k,293) - mat(k,624) = .030_r8*rxt(k,473)*y(k,293) - mat(k,1430) = .200_r8*rxt(k,486)*y(k,293) - mat(k,3655) = mat(k,3655) + .060_r8*rxt(k,424)*y(k,108) + .030_r8*rxt(k,473) & - *y(k,119) + .200_r8*rxt(k,486)*y(k,121) - mat(k,1285) = -(rxt(k,474)*y(k,149) + rxt(k,487)*y(k,157) + rxt(k,488) & - *y(k,293)) - mat(k,3021) = -rxt(k,474)*y(k,109) - mat(k,2930) = -rxt(k,487)*y(k,109) - mat(k,3673) = -rxt(k,488)*y(k,109) - mat(k,1529) = -(rxt(k,454)*y(k,293)) - mat(k,3693) = -rxt(k,454)*y(k,110) - mat(k,2835) = rxt(k,515)*y(k,267) + rxt(k,517)*y(k,268) + rxt(k,519)*y(k,269) & - + rxt(k,521)*y(k,270) + rxt(k,523)*y(k,271) + rxt(k,525) & - *y(k,272) + rxt(k,527)*y(k,273) + rxt(k,529)*y(k,274) - mat(k,1003) = rxt(k,515)*y(k,147) - mat(k,1074) = rxt(k,517)*y(k,147) - mat(k,987) = rxt(k,519)*y(k,147) - mat(k,1013) = rxt(k,521)*y(k,147) - mat(k,1319) = rxt(k,523)*y(k,147) - mat(k,2022) = rxt(k,525)*y(k,147) - mat(k,1185) = rxt(k,527)*y(k,147) - mat(k,1259) = rxt(k,529)*y(k,147) - mat(k,1021) = -(rxt(k,453)*y(k,293)) - mat(k,3649) = -rxt(k,453)*y(k,111) - mat(k,1526) = rxt(k,454)*y(k,293) - mat(k,2805) = rxt(k,541)*y(k,291) - mat(k,1474) = rxt(k,541)*y(k,147) - mat(k,3649) = mat(k,3649) + rxt(k,454)*y(k,110) - mat(k,1635) = -(rxt(k,455)*y(k,293)) - mat(k,3701) = -rxt(k,455)*y(k,112) - mat(k,1339) = rxt(k,456)*y(k,293) - mat(k,2843) = rxt(k,505)*y(k,258) - mat(k,1408) = rxt(k,505)*y(k,147) - mat(k,3701) = mat(k,3701) + rxt(k,456)*y(k,113) - mat(k,1336) = -(rxt(k,456)*y(k,293)) - mat(k,3677) = -rxt(k,456)*y(k,113) - mat(k,3216) = .420_r8*rxt(k,458)*y(k,267) + .480_r8*rxt(k,462)*y(k,268) & - + .400_r8*rxt(k,465)*y(k,269) + .500_r8*rxt(k,468)*y(k,270) & - + .600_r8*rxt(k,472)*y(k,271) + .490_r8*rxt(k,480)*y(k,273) & - + .170_r8*rxt(k,483)*y(k,274) + .200_r8*rxt(k,500)*y(k,291) - mat(k,1000) = .420_r8*rxt(k,458)*y(k,256) - mat(k,1072) = .480_r8*rxt(k,462)*y(k,256) - mat(k,986) = .400_r8*rxt(k,465)*y(k,256) - mat(k,1012) = .500_r8*rxt(k,468)*y(k,256) - mat(k,1316) = .600_r8*rxt(k,472)*y(k,256) - mat(k,1182) = .490_r8*rxt(k,480)*y(k,256) - mat(k,1257) = .170_r8*rxt(k,483)*y(k,256) - mat(k,1477) = .200_r8*rxt(k,500)*y(k,256) - mat(k,663) = -(rxt(k,457)*y(k,293)) - mat(k,3615) = -rxt(k,457)*y(k,114) - mat(k,1878) = .080_r8*rxt(k,491)*y(k,293) - mat(k,3169) = .350_r8*rxt(k,422)*y(k,258) - mat(k,1402) = .350_r8*rxt(k,422)*y(k,256) - mat(k,3615) = mat(k,3615) + .080_r8*rxt(k,491)*y(k,123) - mat(k,1930) = -(rxt(k,460)*y(k,157) + rxt(k,461)*y(k,293)) - mat(k,2958) = -rxt(k,460)*y(k,115) - mat(k,3714) = -rxt(k,461)*y(k,115) - mat(k,2856) = rxt(k,513)*y(k,266) + rxt(k,535)*y(k,277) - mat(k,3393) = .280_r8*rxt(k,476)*y(k,272) - mat(k,1577) = rxt(k,513)*y(k,147) - mat(k,2031) = .280_r8*rxt(k,476)*y(k,251) + 1.060_r8*rxt(k,478)*y(k,272) - mat(k,1673) = rxt(k,535)*y(k,147) - mat(k,573) = -(rxt(k,464)*y(k,293)) - mat(k,3606) = -rxt(k,464)*y(k,116) - mat(k,2775) = rxt(k,507)*y(k,259) - mat(k,1812) = rxt(k,507)*y(k,147) - mat(k,474) = -(rxt(k,467)*y(k,293)) - mat(k,3594) = -rxt(k,467)*y(k,117) - mat(k,2772) = rxt(k,509)*y(k,260) - mat(k,1712) = rxt(k,509)*y(k,147) - mat(k,1964) = -(rxt(k,470)*y(k,157) + rxt(k,471)*y(k,293)) - mat(k,2959) = -rxt(k,470)*y(k,118) - mat(k,3715) = -rxt(k,471)*y(k,118) - mat(k,2857) = rxt(k,511)*y(k,265) + rxt(k,532)*y(k,276) - mat(k,3394) = .050_r8*rxt(k,476)*y(k,272) - mat(k,1556) = rxt(k,511)*y(k,147) - mat(k,2032) = .050_r8*rxt(k,476)*y(k,251) + .180_r8*rxt(k,478)*y(k,272) - mat(k,1786) = rxt(k,532)*y(k,147) - mat(k,623) = -(rxt(k,473)*y(k,293)) - mat(k,3611) = -rxt(k,473)*y(k,119) - mat(k,3350) = .070_r8*rxt(k,476)*y(k,272) - mat(k,2008) = .070_r8*rxt(k,476)*y(k,251) + .300_r8*rxt(k,478)*y(k,272) - mat(k,1048) = -(rxt(k,482)*y(k,293)) - mat(k,3652) = -rxt(k,482)*y(k,120) - mat(k,3198) = .230_r8*rxt(k,477)*y(k,272) - mat(k,2009) = .230_r8*rxt(k,477)*y(k,256) - mat(k,1439) = -(rxt(k,485)*y(k,157) + rxt(k,486)*y(k,293)) - mat(k,2935) = -rxt(k,485)*y(k,121) - mat(k,3687) = -rxt(k,486)*y(k,121) - mat(k,3226) = .530_r8*rxt(k,477)*y(k,272) - mat(k,2019) = .530_r8*rxt(k,477)*y(k,256) - mat(k,797) = -(rxt(k,489)*y(k,293)) - mat(k,3628) = -rxt(k,489)*y(k,122) - mat(k,3351) = .250_r8*rxt(k,426)*y(k,259) + .250_r8*rxt(k,432)*y(k,260) & - + .250_r8*rxt(k,446)*y(k,265) + .250_r8*rxt(k,450)*y(k,266) & - + .250_r8*rxt(k,493)*y(k,276) + .250_r8*rxt(k,497)*y(k,277) - mat(k,1813) = .250_r8*rxt(k,426)*y(k,251) - mat(k,1713) = .250_r8*rxt(k,432)*y(k,251) - mat(k,1545) = .250_r8*rxt(k,446)*y(k,251) - mat(k,1566) = .250_r8*rxt(k,450)*y(k,251) - mat(k,1769) = .250_r8*rxt(k,493)*y(k,251) - mat(k,1657) = .250_r8*rxt(k,497)*y(k,251) - mat(k,1896) = -((rxt(k,490) + rxt(k,491)) * y(k,293)) - mat(k,3713) = -(rxt(k,490) + rxt(k,491)) * y(k,123) - mat(k,3251) = .940_r8*rxt(k,427)*y(k,259) + .940_r8*rxt(k,433)*y(k,260) & - + rxt(k,447)*y(k,265) + rxt(k,451)*y(k,266) + rxt(k,494) & - *y(k,276) + rxt(k,498)*y(k,277) - mat(k,1832) = .940_r8*rxt(k,427)*y(k,256) - mat(k,1733) = .940_r8*rxt(k,433)*y(k,256) - mat(k,1555) = rxt(k,447)*y(k,256) - mat(k,1576) = rxt(k,451)*y(k,256) - mat(k,1785) = rxt(k,494)*y(k,256) - mat(k,1672) = rxt(k,498)*y(k,256) - mat(k,78) = -(rxt(k,867)*y(k,293)) - mat(k,3529) = -rxt(k,867)*y(k,124) - mat(k,961) = -(rxt(k,645)*y(k,149) + rxt(k,663)*y(k,157) + rxt(k,664) & - *y(k,293)) - mat(k,3011) = -rxt(k,645)*y(k,125) - mat(k,2918) = -rxt(k,663)*y(k,125) - mat(k,3643) = -rxt(k,664)*y(k,125) - mat(k,1751) = -(rxt(k,386)*y(k,157) + rxt(k,387)*y(k,293)) - mat(k,2951) = -rxt(k,386)*y(k,126) - mat(k,3707) = -rxt(k,387)*y(k,126) - mat(k,560) = .350_r8*rxt(k,416)*y(k,293) - mat(k,430) = .140_r8*rxt(k,418)*y(k,293) - mat(k,1292) = .410_r8*rxt(k,487)*y(k,157) - mat(k,2849) = rxt(k,508)*y(k,260) + .040_r8*rxt(k,524)*y(k,272) - mat(k,3042) = .040_r8*rxt(k,479)*y(k,272) - mat(k,2951) = mat(k,2951) + .410_r8*rxt(k,487)*y(k,109) - mat(k,2666) = rxt(k,431)*y(k,260) + .040_r8*rxt(k,475)*y(k,272) - mat(k,3386) = .500_r8*rxt(k,432)*y(k,260) + .020_r8*rxt(k,476)*y(k,272) - mat(k,3245) = .060_r8*rxt(k,433)*y(k,260) + .020_r8*rxt(k,477)*y(k,272) - mat(k,1730) = rxt(k,508)*y(k,147) + rxt(k,431)*y(k,250) + .500_r8*rxt(k,432) & - *y(k,251) + .060_r8*rxt(k,433)*y(k,256) - mat(k,2027) = .040_r8*rxt(k,524)*y(k,147) + .040_r8*rxt(k,479)*y(k,149) & - + .040_r8*rxt(k,475)*y(k,250) + .020_r8*rxt(k,476)*y(k,251) & - + .020_r8*rxt(k,477)*y(k,256) + .320_r8*rxt(k,478)*y(k,272) - mat(k,3707) = mat(k,3707) + .350_r8*rxt(k,416)*y(k,99) + .140_r8*rxt(k,418) & - *y(k,101) + mat(k,1264) = -(rxt(k,423)*y(k,293)) + mat(k,3729) = -rxt(k,423)*y(k,108) + mat(k,1264) = mat(k,1264) + .060_r8*rxt(k,423)*y(k,293) + mat(k,759) = .030_r8*rxt(k,472)*y(k,293) + mat(k,1562) = .200_r8*rxt(k,485)*y(k,293) + mat(k,3729) = mat(k,3729) + .060_r8*rxt(k,423)*y(k,108) + .030_r8*rxt(k,472) & + *y(k,119) + .200_r8*rxt(k,485)*y(k,121) end do end subroutine nlnmat05 subroutine nlnmat06( avec_len, mat, y, rxt ) @@ -1291,256 +1411,210 @@ subroutine nlnmat06( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,1620) = -(rxt(k,381)*y(k,293)) - mat(k,3700) = -rxt(k,381)*y(k,127) - mat(k,1026) = .500_r8*rxt(k,453)*y(k,293) - mat(k,1634) = .250_r8*rxt(k,455)*y(k,293) - mat(k,1925) = .060_r8*rxt(k,461)*y(k,293) - mat(k,1988) = .240_r8*rxt(k,503)*y(k,293) - mat(k,2842) = .060_r8*rxt(k,514)*y(k,267) + .270_r8*rxt(k,516)*y(k,268) & - + .210_r8*rxt(k,522)*y(k,271) + .490_r8*rxt(k,526)*y(k,273) & - + .020_r8*rxt(k,528)*y(k,274) + rxt(k,537)*y(k,282) & - + .390_r8*rxt(k,540)*y(k,291) - mat(k,3238) = .030_r8*rxt(k,458)*y(k,267) + .060_r8*rxt(k,462)*y(k,268) & - + .060_r8*rxt(k,472)*y(k,271) + .150_r8*rxt(k,480)*y(k,273) & - + .020_r8*rxt(k,483)*y(k,274) + .290_r8*rxt(k,500)*y(k,291) - mat(k,1004) = .060_r8*rxt(k,514)*y(k,147) + .030_r8*rxt(k,458)*y(k,256) - mat(k,1076) = .270_r8*rxt(k,516)*y(k,147) + .060_r8*rxt(k,462)*y(k,256) - mat(k,1322) = .210_r8*rxt(k,522)*y(k,147) + .060_r8*rxt(k,472)*y(k,256) - mat(k,1187) = .490_r8*rxt(k,526)*y(k,147) + .150_r8*rxt(k,480)*y(k,256) - mat(k,1261) = .020_r8*rxt(k,528)*y(k,147) + .020_r8*rxt(k,483)*y(k,256) - mat(k,1386) = rxt(k,537)*y(k,147) - mat(k,1483) = .390_r8*rxt(k,540)*y(k,147) + .290_r8*rxt(k,500)*y(k,256) - mat(k,3700) = mat(k,3700) + .500_r8*rxt(k,453)*y(k,111) + .250_r8*rxt(k,455) & - *y(k,112) + .060_r8*rxt(k,461)*y(k,115) + .240_r8*rxt(k,503) & + mat(k,1390) = -(rxt(k,473)*y(k,149) + rxt(k,486)*y(k,157) + rxt(k,487) & + *y(k,293)) + mat(k,3889) = -rxt(k,473)*y(k,109) + mat(k,3065) = -rxt(k,486)*y(k,109) + mat(k,3739) = -rxt(k,487)*y(k,109) + mat(k,1657) = -(rxt(k,453)*y(k,293)) + mat(k,3761) = -rxt(k,453)*y(k,110) + mat(k,3255) = rxt(k,514)*y(k,267) + rxt(k,516)*y(k,268) + rxt(k,518)*y(k,269) & + + rxt(k,520)*y(k,270) + rxt(k,522)*y(k,271) + rxt(k,524) & + *y(k,272) + rxt(k,526)*y(k,273) + rxt(k,528)*y(k,274) + mat(k,1122) = rxt(k,514)*y(k,147) + mat(k,1166) = rxt(k,516)*y(k,147) + mat(k,1054) = rxt(k,518)*y(k,147) + mat(k,1133) = rxt(k,520)*y(k,147) + mat(k,1442) = rxt(k,522)*y(k,147) + mat(k,2167) = rxt(k,524)*y(k,147) + mat(k,1311) = rxt(k,526)*y(k,147) + mat(k,1418) = rxt(k,528)*y(k,147) + mat(k,1108) = -(rxt(k,452)*y(k,293)) + mat(k,3715) = -rxt(k,452)*y(k,111) + mat(k,1654) = rxt(k,453)*y(k,293) + mat(k,3223) = rxt(k,540)*y(k,291) + mat(k,1632) = rxt(k,540)*y(k,147) + mat(k,3715) = mat(k,3715) + rxt(k,453)*y(k,110) + mat(k,1791) = -(rxt(k,454)*y(k,293)) + mat(k,3771) = -rxt(k,454)*y(k,112) + mat(k,1469) = rxt(k,455)*y(k,293) + mat(k,3264) = rxt(k,504)*y(k,258) + mat(k,1300) = rxt(k,504)*y(k,147) + mat(k,3771) = mat(k,3771) + rxt(k,455)*y(k,113) + mat(k,1466) = -(rxt(k,455)*y(k,293)) + mat(k,3745) = -rxt(k,455)*y(k,113) + mat(k,3496) = .420_r8*rxt(k,457)*y(k,267) + .480_r8*rxt(k,461)*y(k,268) & + + .400_r8*rxt(k,464)*y(k,269) + .500_r8*rxt(k,467)*y(k,270) & + + .600_r8*rxt(k,471)*y(k,271) + .490_r8*rxt(k,479)*y(k,273) & + + .170_r8*rxt(k,482)*y(k,274) + .200_r8*rxt(k,499)*y(k,291) + mat(k,1120) = .420_r8*rxt(k,457)*y(k,256) + mat(k,1165) = .480_r8*rxt(k,461)*y(k,256) + mat(k,1053) = .400_r8*rxt(k,464)*y(k,256) + mat(k,1132) = .500_r8*rxt(k,467)*y(k,256) + mat(k,1440) = .600_r8*rxt(k,471)*y(k,256) + mat(k,1309) = .490_r8*rxt(k,479)*y(k,256) + mat(k,1415) = .170_r8*rxt(k,482)*y(k,256) + mat(k,1634) = .200_r8*rxt(k,499)*y(k,256) + mat(k,773) = -(rxt(k,456)*y(k,293)) + mat(k,3683) = -rxt(k,456)*y(k,114) + mat(k,1883) = .080_r8*rxt(k,490)*y(k,293) + mat(k,3449) = .350_r8*rxt(k,421)*y(k,258) + mat(k,1295) = .350_r8*rxt(k,421)*y(k,256) + mat(k,3683) = mat(k,3683) + .080_r8*rxt(k,490)*y(k,123) + mat(k,2110) = -(rxt(k,459)*y(k,157) + rxt(k,460)*y(k,293)) + mat(k,3096) = -rxt(k,459)*y(k,115) + mat(k,3784) = -rxt(k,460)*y(k,115) + mat(k,3277) = rxt(k,512)*y(k,266) + rxt(k,534)*y(k,277) + mat(k,4012) = .280_r8*rxt(k,475)*y(k,272) + mat(k,1775) = rxt(k,512)*y(k,147) + mat(k,2178) = .280_r8*rxt(k,475)*y(k,251) + 1.060_r8*rxt(k,477)*y(k,272) + mat(k,1822) = rxt(k,534)*y(k,147) + mat(k,610) = -(rxt(k,463)*y(k,293)) + mat(k,3666) = -rxt(k,463)*y(k,116) + mat(k,3196) = rxt(k,506)*y(k,259) + mat(k,1941) = rxt(k,506)*y(k,147) + mat(k,558) = -(rxt(k,466)*y(k,293)) + mat(k,3660) = -rxt(k,466)*y(k,117) + mat(k,3193) = rxt(k,508)*y(k,260) + mat(k,1977) = rxt(k,508)*y(k,147) + mat(k,2078) = -(rxt(k,469)*y(k,157) + rxt(k,470)*y(k,293)) + mat(k,3095) = -rxt(k,469)*y(k,118) + mat(k,3783) = -rxt(k,470)*y(k,118) + mat(k,3276) = rxt(k,510)*y(k,265) + rxt(k,531)*y(k,276) + mat(k,4011) = .050_r8*rxt(k,475)*y(k,272) + mat(k,1747) = rxt(k,510)*y(k,147) + mat(k,2177) = .050_r8*rxt(k,475)*y(k,251) + .180_r8*rxt(k,477)*y(k,272) + mat(k,1854) = rxt(k,531)*y(k,147) + mat(k,758) = -(rxt(k,472)*y(k,293)) + mat(k,3681) = -rxt(k,472)*y(k,119) + mat(k,3966) = .070_r8*rxt(k,475)*y(k,272) + mat(k,2154) = .070_r8*rxt(k,475)*y(k,251) + .300_r8*rxt(k,477)*y(k,272) + mat(k,1178) = -(rxt(k,481)*y(k,293)) + mat(k,3722) = -rxt(k,481)*y(k,120) + mat(k,3481) = .230_r8*rxt(k,476)*y(k,272) + mat(k,2155) = .230_r8*rxt(k,476)*y(k,256) + mat(k,1570) = -(rxt(k,484)*y(k,157) + rxt(k,485)*y(k,293)) + mat(k,3072) = -rxt(k,484)*y(k,121) + mat(k,3756) = -rxt(k,485)*y(k,121) + mat(k,3506) = .530_r8*rxt(k,476)*y(k,272) + mat(k,2164) = .530_r8*rxt(k,476)*y(k,256) + mat(k,912) = -(rxt(k,488)*y(k,293)) + mat(k,3697) = -rxt(k,488)*y(k,122) + mat(k,3968) = .250_r8*rxt(k,425)*y(k,259) + .250_r8*rxt(k,431)*y(k,260) & + + .250_r8*rxt(k,445)*y(k,265) + .250_r8*rxt(k,449)*y(k,266) & + + .250_r8*rxt(k,492)*y(k,276) + .250_r8*rxt(k,496)*y(k,277) + mat(k,1942) = .250_r8*rxt(k,425)*y(k,251) + mat(k,1978) = .250_r8*rxt(k,431)*y(k,251) + mat(k,1735) = .250_r8*rxt(k,445)*y(k,251) + mat(k,1763) = .250_r8*rxt(k,449)*y(k,251) + mat(k,1836) = .250_r8*rxt(k,492)*y(k,251) + mat(k,1805) = .250_r8*rxt(k,496)*y(k,251) + mat(k,1894) = -((rxt(k,489) + rxt(k,490)) * y(k,293)) + mat(k,3775) = -(rxt(k,489) + rxt(k,490)) * y(k,123) + mat(k,3524) = .940_r8*rxt(k,426)*y(k,259) + .940_r8*rxt(k,432)*y(k,260) & + + rxt(k,446)*y(k,265) + rxt(k,450)*y(k,266) + rxt(k,493) & + *y(k,276) + rxt(k,497)*y(k,277) + mat(k,1955) = .940_r8*rxt(k,426)*y(k,256) + mat(k,1992) = .940_r8*rxt(k,432)*y(k,256) + mat(k,1743) = rxt(k,446)*y(k,256) + mat(k,1771) = rxt(k,450)*y(k,256) + mat(k,1848) = rxt(k,493)*y(k,256) + mat(k,1817) = rxt(k,497)*y(k,256) + mat(k,87) = -(rxt(k,866)*y(k,293)) + mat(k,3590) = -rxt(k,866)*y(k,124) + mat(k,1069) = -(rxt(k,644)*y(k,149) + rxt(k,662)*y(k,157) + rxt(k,663) & + *y(k,293)) + mat(k,3878) = -rxt(k,644)*y(k,125) + mat(k,3054) = -rxt(k,662)*y(k,125) + mat(k,3712) = -rxt(k,663)*y(k,125) + mat(k,2022) = -(rxt(k,385)*y(k,157) + rxt(k,386)*y(k,293)) + mat(k,3093) = -rxt(k,385)*y(k,126) + mat(k,3781) = -rxt(k,386)*y(k,126) + mat(k,685) = .350_r8*rxt(k,415)*y(k,293) + mat(k,502) = .140_r8*rxt(k,417)*y(k,293) + mat(k,1400) = .410_r8*rxt(k,486)*y(k,157) + mat(k,3274) = rxt(k,507)*y(k,260) + .040_r8*rxt(k,523)*y(k,272) + mat(k,3915) = .040_r8*rxt(k,478)*y(k,272) + mat(k,3093) = mat(k,3093) + .410_r8*rxt(k,486)*y(k,109) + mat(k,2992) = rxt(k,430)*y(k,260) + .040_r8*rxt(k,474)*y(k,272) + mat(k,4009) = .500_r8*rxt(k,431)*y(k,260) + .020_r8*rxt(k,475)*y(k,272) + mat(k,3530) = .060_r8*rxt(k,432)*y(k,260) + .020_r8*rxt(k,476)*y(k,272) + mat(k,1998) = rxt(k,507)*y(k,147) + rxt(k,430)*y(k,250) + .500_r8*rxt(k,431) & + *y(k,251) + .060_r8*rxt(k,432)*y(k,256) + mat(k,2175) = .040_r8*rxt(k,523)*y(k,147) + .040_r8*rxt(k,478)*y(k,149) & + + .040_r8*rxt(k,474)*y(k,250) + .020_r8*rxt(k,475)*y(k,251) & + + .020_r8*rxt(k,476)*y(k,256) + .320_r8*rxt(k,477)*y(k,272) + mat(k,3781) = mat(k,3781) + .350_r8*rxt(k,415)*y(k,99) + .140_r8*rxt(k,417) & + *y(k,101) + mat(k,1725) = -(rxt(k,380)*y(k,293)) + mat(k,3767) = -rxt(k,380)*y(k,127) + mat(k,1111) = .500_r8*rxt(k,452)*y(k,293) + mat(k,1789) = .250_r8*rxt(k,454)*y(k,293) + mat(k,2103) = .060_r8*rxt(k,460)*y(k,293) + mat(k,2133) = .240_r8*rxt(k,502)*y(k,293) + mat(k,3260) = .060_r8*rxt(k,513)*y(k,267) + .270_r8*rxt(k,515)*y(k,268) & + + .210_r8*rxt(k,521)*y(k,271) + .490_r8*rxt(k,525)*y(k,273) & + + .020_r8*rxt(k,527)*y(k,274) + rxt(k,536)*y(k,282) & + + .390_r8*rxt(k,539)*y(k,291) + mat(k,3516) = .030_r8*rxt(k,457)*y(k,267) + .060_r8*rxt(k,461)*y(k,268) & + + .060_r8*rxt(k,471)*y(k,271) + .150_r8*rxt(k,479)*y(k,273) & + + .020_r8*rxt(k,482)*y(k,274) + .290_r8*rxt(k,499)*y(k,291) + mat(k,1124) = .060_r8*rxt(k,513)*y(k,147) + .030_r8*rxt(k,457)*y(k,256) + mat(k,1168) = .270_r8*rxt(k,515)*y(k,147) + .060_r8*rxt(k,461)*y(k,256) + mat(k,1444) = .210_r8*rxt(k,521)*y(k,147) + .060_r8*rxt(k,471)*y(k,256) + mat(k,1313) = .490_r8*rxt(k,525)*y(k,147) + .150_r8*rxt(k,479)*y(k,256) + mat(k,1419) = .020_r8*rxt(k,527)*y(k,147) + .020_r8*rxt(k,482)*y(k,256) + mat(k,1543) = rxt(k,536)*y(k,147) + mat(k,1640) = .390_r8*rxt(k,539)*y(k,147) + .290_r8*rxt(k,499)*y(k,256) + mat(k,3767) = mat(k,3767) + .500_r8*rxt(k,452)*y(k,111) + .250_r8*rxt(k,454) & + *y(k,112) + .060_r8*rxt(k,460)*y(k,115) + .240_r8*rxt(k,502) & *y(k,139) - mat(k,1329) = -(rxt(k,388)*y(k,293)) - mat(k,3676) = -rxt(k,388)*y(k,128) - mat(k,428) = .090_r8*rxt(k,418)*y(k,293) - mat(k,1629) = .250_r8*rxt(k,455)*y(k,293) - mat(k,2822) = .550_r8*rxt(k,512)*y(k,266) + .550_r8*rxt(k,534)*y(k,277) - mat(k,2647) = .550_r8*rxt(k,449)*y(k,266) + .550_r8*rxt(k,496)*y(k,277) - mat(k,3361) = .280_r8*rxt(k,450)*y(k,266) + .280_r8*rxt(k,497)*y(k,277) - mat(k,3215) = .410_r8*rxt(k,384)*y(k,282) - mat(k,1567) = .550_r8*rxt(k,512)*y(k,147) + .550_r8*rxt(k,449)*y(k,250) & - + .280_r8*rxt(k,450)*y(k,251) - mat(k,1660) = .550_r8*rxt(k,534)*y(k,147) + .550_r8*rxt(k,496)*y(k,250) & - + .280_r8*rxt(k,497)*y(k,251) - mat(k,1382) = .410_r8*rxt(k,384)*y(k,256) - mat(k,3676) = mat(k,3676) + .090_r8*rxt(k,418)*y(k,101) + .250_r8*rxt(k,455) & + mat(k,1459) = -(rxt(k,387)*y(k,293)) + mat(k,3744) = -rxt(k,387)*y(k,128) + mat(k,500) = .090_r8*rxt(k,417)*y(k,293) + mat(k,1784) = .250_r8*rxt(k,454)*y(k,293) + mat(k,3241) = .550_r8*rxt(k,511)*y(k,266) + .550_r8*rxt(k,533)*y(k,277) + mat(k,2967) = .550_r8*rxt(k,448)*y(k,266) + .550_r8*rxt(k,495)*y(k,277) + mat(k,3978) = .280_r8*rxt(k,449)*y(k,266) + .280_r8*rxt(k,496)*y(k,277) + mat(k,3495) = .410_r8*rxt(k,383)*y(k,282) + mat(k,1764) = .550_r8*rxt(k,511)*y(k,147) + .550_r8*rxt(k,448)*y(k,250) & + + .280_r8*rxt(k,449)*y(k,251) + mat(k,1808) = .550_r8*rxt(k,533)*y(k,147) + .550_r8*rxt(k,495)*y(k,250) & + + .280_r8*rxt(k,496)*y(k,251) + mat(k,1540) = .410_r8*rxt(k,383)*y(k,256) + mat(k,3744) = mat(k,3744) + .090_r8*rxt(k,417)*y(k,101) + .250_r8*rxt(k,454) & *y(k,112) - mat(k,450) = -(rxt(k,397)*y(k,293)) - mat(k,3590) = -rxt(k,397)*y(k,129) - mat(k,2770) = .800_r8*rxt(k,411)*y(k,234) - mat(k,1128) = .800_r8*rxt(k,411)*y(k,147) - mat(k,265) = -(rxt(k,398)*y(k,293)) - mat(k,3563) = -rxt(k,398)*y(k,130) - mat(k,3138) = .800_r8*rxt(k,395)*y(k,286) - mat(k,655) = .800_r8*rxt(k,395)*y(k,256) - mat(k,391) = -(rxt(k,399)*y(k,293)) - mat(k,3582) = -rxt(k,399)*y(k,131) - mat(k,3472) = rxt(k,407)*y(k,284) - mat(k,1494) = rxt(k,407)*y(k,148) - mat(k,1863) = -(rxt(k,404)*y(k,157) + rxt(k,405)*y(k,293)) - mat(k,2956) = -rxt(k,404)*y(k,132) - mat(k,3712) = -rxt(k,405)*y(k,132) - mat(k,549) = .350_r8*rxt(k,415)*y(k,293) - mat(k,423) = .230_r8*rxt(k,417)*y(k,293) - mat(k,1295) = .170_r8*rxt(k,487)*y(k,157) - mat(k,2854) = rxt(k,506)*y(k,259) + .420_r8*rxt(k,524)*y(k,272) - mat(k,3047) = .420_r8*rxt(k,479)*y(k,272) - mat(k,2956) = mat(k,2956) + .170_r8*rxt(k,487)*y(k,109) - mat(k,2671) = rxt(k,425)*y(k,259) + .420_r8*rxt(k,475)*y(k,272) - mat(k,3391) = .750_r8*rxt(k,426)*y(k,259) + .050_r8*rxt(k,476)*y(k,272) - mat(k,3250) = .060_r8*rxt(k,427)*y(k,259) + .220_r8*rxt(k,477)*y(k,272) - mat(k,1831) = rxt(k,506)*y(k,147) + rxt(k,425)*y(k,250) + .750_r8*rxt(k,426) & - *y(k,251) + .060_r8*rxt(k,427)*y(k,256) - mat(k,2030) = .420_r8*rxt(k,524)*y(k,147) + .420_r8*rxt(k,479)*y(k,149) & - + .420_r8*rxt(k,475)*y(k,250) + .050_r8*rxt(k,476)*y(k,251) & - + .220_r8*rxt(k,477)*y(k,256) - mat(k,3712) = mat(k,3712) + .350_r8*rxt(k,415)*y(k,98) + .230_r8*rxt(k,417) & + mat(k,553) = -(rxt(k,396)*y(k,293)) + mat(k,3659) = -rxt(k,396)*y(k,129) + mat(k,3192) = .800_r8*rxt(k,410)*y(k,234) + mat(k,1194) = .800_r8*rxt(k,410)*y(k,147) + mat(k,329) = -(rxt(k,397)*y(k,293)) + mat(k,3626) = -rxt(k,397)*y(k,130) + mat(k,3417) = .800_r8*rxt(k,394)*y(k,286) + mat(k,737) = .800_r8*rxt(k,394)*y(k,256) + mat(k,516) = -(rxt(k,398)*y(k,293)) + mat(k,3654) = -rxt(k,398)*y(k,131) + mat(k,4062) = rxt(k,406)*y(k,284) + mat(k,1614) = rxt(k,406)*y(k,148) + mat(k,2047) = -(rxt(k,403)*y(k,157) + rxt(k,404)*y(k,293)) + mat(k,3094) = -rxt(k,403)*y(k,132) + mat(k,3782) = -rxt(k,404)*y(k,132) + mat(k,627) = .350_r8*rxt(k,414)*y(k,293) + mat(k,485) = .230_r8*rxt(k,416)*y(k,293) + mat(k,1401) = .170_r8*rxt(k,486)*y(k,157) + mat(k,3275) = rxt(k,505)*y(k,259) + .420_r8*rxt(k,523)*y(k,272) + mat(k,3916) = .420_r8*rxt(k,478)*y(k,272) + mat(k,3094) = mat(k,3094) + .170_r8*rxt(k,486)*y(k,109) + mat(k,2993) = rxt(k,424)*y(k,259) + .420_r8*rxt(k,474)*y(k,272) + mat(k,4010) = .750_r8*rxt(k,425)*y(k,259) + .050_r8*rxt(k,475)*y(k,272) + mat(k,3531) = .060_r8*rxt(k,426)*y(k,259) + .220_r8*rxt(k,476)*y(k,272) + mat(k,1962) = rxt(k,505)*y(k,147) + rxt(k,424)*y(k,250) + .750_r8*rxt(k,425) & + *y(k,251) + .060_r8*rxt(k,426)*y(k,256) + mat(k,2176) = .420_r8*rxt(k,523)*y(k,147) + .420_r8*rxt(k,478)*y(k,149) & + + .420_r8*rxt(k,474)*y(k,250) + .050_r8*rxt(k,475)*y(k,251) & + + .220_r8*rxt(k,476)*y(k,256) + mat(k,3782) = mat(k,3782) + .350_r8*rxt(k,414)*y(k,98) + .230_r8*rxt(k,416) & *y(k,100) - mat(k,1801) = -(rxt(k,400)*y(k,293)) - mat(k,3709) = -rxt(k,400)*y(k,133) - mat(k,1089) = .050_r8*rxt(k,424)*y(k,293) - mat(k,1027) = .500_r8*rxt(k,453)*y(k,293) - mat(k,1636) = .250_r8*rxt(k,455)*y(k,293) - mat(k,1962) = .040_r8*rxt(k,471)*y(k,293) - mat(k,1991) = .040_r8*rxt(k,503)*y(k,293) - mat(k,2851) = rxt(k,518)*y(k,269) + .130_r8*rxt(k,520)*y(k,270) & - + .120_r8*rxt(k,522)*y(k,271) + .040_r8*rxt(k,526)*y(k,273) & - + .020_r8*rxt(k,528)*y(k,274) + rxt(k,539)*y(k,287) & - + .360_r8*rxt(k,540)*y(k,291) - mat(k,3247) = .600_r8*rxt(k,465)*y(k,269) + .060_r8*rxt(k,468)*y(k,270) & - + .040_r8*rxt(k,472)*y(k,271) + .020_r8*rxt(k,480)*y(k,273) & - + .010_r8*rxt(k,483)*y(k,274) + .310_r8*rxt(k,500)*y(k,291) - mat(k,989) = rxt(k,518)*y(k,147) + .600_r8*rxt(k,465)*y(k,256) - mat(k,1015) = .130_r8*rxt(k,520)*y(k,147) + .060_r8*rxt(k,468)*y(k,256) - mat(k,1323) = .120_r8*rxt(k,522)*y(k,147) + .040_r8*rxt(k,472)*y(k,256) - mat(k,1188) = .040_r8*rxt(k,526)*y(k,147) + .020_r8*rxt(k,480)*y(k,256) - mat(k,1262) = .020_r8*rxt(k,528)*y(k,147) + .010_r8*rxt(k,483)*y(k,256) - mat(k,1373) = rxt(k,539)*y(k,147) - mat(k,1485) = .360_r8*rxt(k,540)*y(k,147) + .310_r8*rxt(k,500)*y(k,256) - mat(k,3709) = mat(k,3709) + .050_r8*rxt(k,424)*y(k,108) + .500_r8*rxt(k,453) & - *y(k,111) + .250_r8*rxt(k,455)*y(k,112) + .040_r8*rxt(k,471) & - *y(k,118) + .040_r8*rxt(k,503)*y(k,139) - mat(k,1360) = -(rxt(k,406)*y(k,293)) - mat(k,3681) = -rxt(k,406)*y(k,134) - mat(k,421) = .190_r8*rxt(k,417)*y(k,293) - mat(k,1630) = .250_r8*rxt(k,455)*y(k,293) - mat(k,2826) = .550_r8*rxt(k,510)*y(k,265) + .550_r8*rxt(k,531)*y(k,276) - mat(k,2648) = .550_r8*rxt(k,445)*y(k,265) + .550_r8*rxt(k,492)*y(k,276) - mat(k,3365) = .280_r8*rxt(k,446)*y(k,265) + .280_r8*rxt(k,493)*y(k,276) - mat(k,3220) = .460_r8*rxt(k,403)*y(k,287) - mat(k,1547) = .550_r8*rxt(k,510)*y(k,147) + .550_r8*rxt(k,445)*y(k,250) & - + .280_r8*rxt(k,446)*y(k,251) - mat(k,1774) = .550_r8*rxt(k,531)*y(k,147) + .550_r8*rxt(k,492)*y(k,250) & - + .280_r8*rxt(k,493)*y(k,251) - mat(k,1369) = .460_r8*rxt(k,403)*y(k,256) - mat(k,3681) = mat(k,3681) + .190_r8*rxt(k,417)*y(k,100) + .250_r8*rxt(k,455) & - *y(k,112) - mat(k,710) = -(rxt(k,665)*y(k,149) + rxt(k,683)*y(k,157) + rxt(k,684) & - *y(k,293)) - mat(k,3007) = -rxt(k,665)*y(k,135) - mat(k,2912) = -rxt(k,683)*y(k,135) - mat(k,3620) = -rxt(k,684)*y(k,135) - mat(k,316) = -(rxt(k,194)*y(k,147) + (rxt(k,195) + rxt(k,196) + rxt(k,197) & - ) * y(k,148) + rxt(k,206)*y(k,293)) - mat(k,2762) = -rxt(k,194)*y(k,136) - mat(k,3469) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,136) - mat(k,3570) = -rxt(k,206)*y(k,136) - mat(k,3468) = rxt(k,213)*y(k,149) - mat(k,3004) = rxt(k,213)*y(k,148) - mat(k,1993) = -(rxt(k,502)*y(k,157) + rxt(k,503)*y(k,293)) - mat(k,2960) = -rxt(k,502)*y(k,139) - mat(k,3716) = -rxt(k,503)*y(k,139) - mat(k,1931) = .040_r8*rxt(k,461)*y(k,293) - mat(k,1965) = .030_r8*rxt(k,471)*y(k,293) - mat(k,628) = .050_r8*rxt(k,473)*y(k,293) - mat(k,1056) = .020_r8*rxt(k,482)*y(k,293) - mat(k,1449) = .090_r8*rxt(k,486)*y(k,293) - mat(k,2858) = .540_r8*rxt(k,524)*y(k,272) - mat(k,3051) = .540_r8*rxt(k,479)*y(k,272) - mat(k,2675) = .540_r8*rxt(k,475)*y(k,272) - mat(k,3395) = .530_r8*rxt(k,476)*y(k,272) - mat(k,2033) = .540_r8*rxt(k,524)*y(k,147) + .540_r8*rxt(k,479)*y(k,149) & - + .540_r8*rxt(k,475)*y(k,250) + .530_r8*rxt(k,476)*y(k,251) & - + 2.140_r8*rxt(k,478)*y(k,272) - mat(k,3716) = mat(k,3716) + .040_r8*rxt(k,461)*y(k,115) + .030_r8*rxt(k,471) & - *y(k,118) + .050_r8*rxt(k,473)*y(k,119) + .020_r8*rxt(k,482) & - *y(k,120) + .090_r8*rxt(k,486)*y(k,121) - mat(k,103) = -(rxt(k,811)*y(k,293)) - mat(k,3534) = -rxt(k,811)*y(k,143) - mat(k,2885) = -(rxt(k,194)*y(k,136) + rxt(k,203)*y(k,149) + rxt(k,207) & - *y(k,256) + rxt(k,208)*y(k,157) + rxt(k,209)*y(k,156) + rxt(k,230) & - *y(k,60) + rxt(k,262)*y(k,20) + rxt(k,305)*y(k,251) + rxt(k,315) & - *y(k,257) + rxt(k,328)*y(k,247) + rxt(k,339)*y(k,250) + rxt(k,343) & - *y(k,255) + rxt(k,358)*y(k,248) + rxt(k,367)*y(k,295) + rxt(k,371) & - *y(k,296) + (rxt(k,378) + rxt(k,379)) * y(k,253) + rxt(k,393) & - *y(k,284) + rxt(k,396)*y(k,286) + (rxt(k,411) + rxt(k,412) & - ) * y(k,234) + (rxt(k,504) + rxt(k,505)) * y(k,258) + (rxt(k,506) & - + rxt(k,507)) * y(k,259) + (rxt(k,508) + rxt(k,509)) * y(k,260) & - + (rxt(k,510) + rxt(k,511)) * y(k,265) + (rxt(k,512) + rxt(k,513) & - ) * y(k,266) + (rxt(k,514) + rxt(k,515)) * y(k,267) + (rxt(k,516) & - + rxt(k,517)) * y(k,268) + (rxt(k,518) + rxt(k,519)) * y(k,269) & - + (rxt(k,520) + rxt(k,521)) * y(k,270) + (rxt(k,522) + rxt(k,523) & - ) * y(k,271) + (rxt(k,524) + rxt(k,525)) * y(k,272) + (rxt(k,526) & - + rxt(k,527)) * y(k,273) + (rxt(k,528) + rxt(k,529)) * y(k,274) & - + (rxt(k,531) + rxt(k,532)) * y(k,276) + (rxt(k,534) + rxt(k,535) & - ) * y(k,277) + (rxt(k,536) + rxt(k,537)) * y(k,282) + (rxt(k,538) & - + rxt(k,539)) * y(k,287) + (rxt(k,540) + rxt(k,541)) * y(k,291) & - + rxt(k,543)*y(k,233) + rxt(k,546)*y(k,241) + rxt(k,551) & - *y(k,246) + rxt(k,553)*y(k,249) + rxt(k,557)*y(k,252) + rxt(k,560) & - *y(k,283) + rxt(k,563)*y(k,285) + rxt(k,566)*y(k,294) + rxt(k,573) & - *y(k,312) + rxt(k,579)*y(k,314) + rxt(k,582)*y(k,316) + rxt(k,590) & - *y(k,235) + rxt(k,598)*y(k,236) + rxt(k,610)*y(k,238) + rxt(k,618) & - *y(k,239) + rxt(k,630)*y(k,243) + rxt(k,638)*y(k,244) + rxt(k,650) & - *y(k,279) + rxt(k,658)*y(k,280) + rxt(k,670)*y(k,288) + rxt(k,678) & - *y(k,289) + rxt(k,689)*y(k,297) + rxt(k,693)*y(k,298) + rxt(k,697) & - *y(k,299) + rxt(k,705)*y(k,300) + rxt(k,713)*y(k,301) + rxt(k,723) & - *y(k,302) + rxt(k,732)*y(k,303) + rxt(k,742)*y(k,304) + rxt(k,753) & - *y(k,305) + rxt(k,762)*y(k,306) + rxt(k,767)*y(k,307) + rxt(k,774) & - *y(k,308) + rxt(k,778)*y(k,309) + rxt(k,782)*y(k,310) + rxt(k,786) & - *y(k,311)) - mat(k,318) = -rxt(k,194)*y(k,147) - mat(k,3078) = -rxt(k,203)*y(k,147) - mat(k,3281) = -rxt(k,207)*y(k,147) - mat(k,2986) = -rxt(k,208)*y(k,147) - mat(k,3452) = -rxt(k,209)*y(k,147) - mat(k,3307) = -rxt(k,230)*y(k,147) - mat(k,3788) = -rxt(k,262)*y(k,147) - mat(k,3422) = -rxt(k,305)*y(k,147) - mat(k,596) = -rxt(k,315)*y(k,147) - mat(k,1246) = -rxt(k,328)*y(k,147) - mat(k,2702) = -rxt(k,339)*y(k,147) - mat(k,746) = -rxt(k,343)*y(k,147) - mat(k,978) = -rxt(k,358)*y(k,147) - mat(k,825) = -rxt(k,367)*y(k,147) - mat(k,1229) = -rxt(k,371)*y(k,147) - mat(k,538) = -(rxt(k,378) + rxt(k,379)) * y(k,147) - mat(k,1501) = -rxt(k,393)*y(k,147) - mat(k,659) = -rxt(k,396)*y(k,147) - mat(k,1137) = -(rxt(k,411) + rxt(k,412)) * y(k,147) - mat(k,1410) = -(rxt(k,504) + rxt(k,505)) * y(k,147) - mat(k,1837) = -(rxt(k,506) + rxt(k,507)) * y(k,147) - mat(k,1739) = -(rxt(k,508) + rxt(k,509)) * y(k,147) - mat(k,1559) = -(rxt(k,510) + rxt(k,511)) * y(k,147) - mat(k,1580) = -(rxt(k,512) + rxt(k,513)) * y(k,147) - mat(k,1005) = -(rxt(k,514) + rxt(k,515)) * y(k,147) - mat(k,1078) = -(rxt(k,516) + rxt(k,517)) * y(k,147) - mat(k,990) = -(rxt(k,518) + rxt(k,519)) * y(k,147) - mat(k,1016) = -(rxt(k,520) + rxt(k,521)) * y(k,147) - mat(k,1324) = -(rxt(k,522) + rxt(k,523)) * y(k,147) - mat(k,2039) = -(rxt(k,524) + rxt(k,525)) * y(k,147) - mat(k,1189) = -(rxt(k,526) + rxt(k,527)) * y(k,147) - mat(k,1265) = -(rxt(k,528) + rxt(k,529)) * y(k,147) - mat(k,1789) = -(rxt(k,531) + rxt(k,532)) * y(k,147) - mat(k,1677) = -(rxt(k,534) + rxt(k,535)) * y(k,147) - mat(k,1390) = -(rxt(k,536) + rxt(k,537)) * y(k,147) - mat(k,1376) = -(rxt(k,538) + rxt(k,539)) * y(k,147) - mat(k,1489) = -(rxt(k,540) + rxt(k,541)) * y(k,147) - mat(k,464) = -rxt(k,543)*y(k,147) - mat(k,438) = -rxt(k,546)*y(k,147) - mat(k,360) = -rxt(k,551)*y(k,147) - mat(k,605) = -rxt(k,553)*y(k,147) - mat(k,792) = -rxt(k,557)*y(k,147) - mat(k,754) = -rxt(k,560)*y(k,147) - mat(k,816) = -rxt(k,563)*y(k,147) - mat(k,379) = -rxt(k,566)*y(k,147) - mat(k,768) = -rxt(k,573)*y(k,147) - mat(k,785) = -rxt(k,579)*y(k,147) - mat(k,446) = -rxt(k,582)*y(k,147) - mat(k,2129) = -rxt(k,590)*y(k,147) - mat(k,2225) = -rxt(k,598)*y(k,147) - mat(k,2062) = -rxt(k,610)*y(k,147) - mat(k,2107) = -rxt(k,618)*y(k,147) - mat(k,2342) = -rxt(k,630)*y(k,147) - mat(k,2254) = -rxt(k,638)*y(k,147) - mat(k,2315) = -rxt(k,650)*y(k,147) - mat(k,2168) = -rxt(k,658)*y(k,147) - mat(k,2376) = -rxt(k,670)*y(k,147) - mat(k,2283) = -rxt(k,678)*y(k,147) - mat(k,838) = -rxt(k,689)*y(k,147) - mat(k,921) = -rxt(k,693)*y(k,147) - mat(k,2454) = -rxt(k,697)*y(k,147) - mat(k,2538) = -rxt(k,705)*y(k,147) - mat(k,2496) = -rxt(k,713)*y(k,147) - mat(k,2584) = -rxt(k,723)*y(k,147) - mat(k,2084) = -rxt(k,732)*y(k,147) - mat(k,2475) = -rxt(k,742)*y(k,147) - mat(k,2631) = -rxt(k,753)*y(k,147) - mat(k,683) = -rxt(k,762)*y(k,147) - mat(k,848) = -rxt(k,767)*y(k,147) - mat(k,1149) = -rxt(k,774)*y(k,147) - mat(k,930) = -rxt(k,778)*y(k,147) - mat(k,692) = -rxt(k,782)*y(k,147) - mat(k,700) = -rxt(k,786)*y(k,147) - mat(k,318) = mat(k,318) + 2.000_r8*rxt(k,196)*y(k,148) + rxt(k,206)*y(k,293) - mat(k,3502) = 2.000_r8*rxt(k,196)*y(k,136) + rxt(k,199)*y(k,156) + rxt(k,803) & - *y(k,173) - mat(k,3452) = mat(k,3452) + rxt(k,199)*y(k,148) - mat(k,1516) = rxt(k,803)*y(k,148) - mat(k,3742) = rxt(k,206)*y(k,136) end do end subroutine nlnmat06 subroutine nlnmat07( avec_len, mat, y, rxt ) @@ -1561,225 +1635,412 @@ subroutine nlnmat07( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,3511) = -((rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,136) + (rxt(k,199) & + mat(k,1929) = -(rxt(k,399)*y(k,293)) + mat(k,3778) = -rxt(k,399)*y(k,133) + mat(k,1271) = .050_r8*rxt(k,423)*y(k,293) + mat(k,1115) = .500_r8*rxt(k,452)*y(k,293) + mat(k,1794) = .250_r8*rxt(k,454)*y(k,293) + mat(k,2077) = .040_r8*rxt(k,470)*y(k,293) + mat(k,2139) = .040_r8*rxt(k,502)*y(k,293) + mat(k,3271) = rxt(k,517)*y(k,269) + .130_r8*rxt(k,519)*y(k,270) & + + .120_r8*rxt(k,521)*y(k,271) + .040_r8*rxt(k,525)*y(k,273) & + + .020_r8*rxt(k,527)*y(k,274) + rxt(k,538)*y(k,287) & + + .360_r8*rxt(k,539)*y(k,291) + mat(k,3527) = .600_r8*rxt(k,464)*y(k,269) + .060_r8*rxt(k,467)*y(k,270) & + + .040_r8*rxt(k,471)*y(k,271) + .020_r8*rxt(k,479)*y(k,273) & + + .010_r8*rxt(k,482)*y(k,274) + .310_r8*rxt(k,499)*y(k,291) + mat(k,1056) = rxt(k,517)*y(k,147) + .600_r8*rxt(k,464)*y(k,256) + mat(k,1135) = .130_r8*rxt(k,519)*y(k,147) + .060_r8*rxt(k,467)*y(k,256) + mat(k,1446) = .120_r8*rxt(k,521)*y(k,147) + .040_r8*rxt(k,471)*y(k,256) + mat(k,1315) = .040_r8*rxt(k,525)*y(k,147) + .020_r8*rxt(k,479)*y(k,256) + mat(k,1422) = .020_r8*rxt(k,527)*y(k,147) + .010_r8*rxt(k,482)*y(k,256) + mat(k,1511) = rxt(k,538)*y(k,147) + mat(k,1645) = .360_r8*rxt(k,539)*y(k,147) + .310_r8*rxt(k,499)*y(k,256) + mat(k,3778) = mat(k,3778) + .050_r8*rxt(k,423)*y(k,108) + .500_r8*rxt(k,452) & + *y(k,111) + .250_r8*rxt(k,454)*y(k,112) + .040_r8*rxt(k,470) & + *y(k,118) + .040_r8*rxt(k,502)*y(k,139) + mat(k,1496) = -(rxt(k,405)*y(k,293)) + mat(k,3750) = -rxt(k,405)*y(k,134) + mat(k,483) = .190_r8*rxt(k,416)*y(k,293) + mat(k,1786) = .250_r8*rxt(k,454)*y(k,293) + mat(k,3246) = .550_r8*rxt(k,509)*y(k,265) + .550_r8*rxt(k,530)*y(k,276) + mat(k,2968) = .550_r8*rxt(k,444)*y(k,265) + .550_r8*rxt(k,491)*y(k,276) + mat(k,3982) = .280_r8*rxt(k,445)*y(k,265) + .280_r8*rxt(k,492)*y(k,276) + mat(k,3501) = .460_r8*rxt(k,402)*y(k,287) + mat(k,1737) = .550_r8*rxt(k,509)*y(k,147) + .550_r8*rxt(k,444)*y(k,250) & + + .280_r8*rxt(k,445)*y(k,251) + mat(k,1841) = .550_r8*rxt(k,530)*y(k,147) + .550_r8*rxt(k,491)*y(k,250) & + + .280_r8*rxt(k,492)*y(k,251) + mat(k,1505) = .460_r8*rxt(k,402)*y(k,256) + mat(k,3750) = mat(k,3750) + .190_r8*rxt(k,416)*y(k,100) + .250_r8*rxt(k,454) & + *y(k,112) + mat(k,846) = -(rxt(k,664)*y(k,149) + rxt(k,682)*y(k,157) + rxt(k,683) & + *y(k,293)) + mat(k,3875) = -rxt(k,664)*y(k,135) + mat(k,3050) = -rxt(k,682)*y(k,135) + mat(k,3691) = -rxt(k,683)*y(k,135) + mat(k,474) = -(rxt(k,194)*y(k,147) + (rxt(k,195) + rxt(k,196) + rxt(k,197) & + ) * y(k,148) + rxt(k,206)*y(k,293)) + mat(k,3187) = -rxt(k,194)*y(k,136) + mat(k,4060) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,136) + mat(k,3648) = -rxt(k,206)*y(k,136) + mat(k,199) = -((rxt(k,210) + rxt(k,211)) * y(k,292)) + mat(k,2622) = -(rxt(k,210) + rxt(k,211)) * y(k,137) + mat(k,473) = rxt(k,195)*y(k,148) + mat(k,4056) = rxt(k,195)*y(k,136) + mat(k,4057) = rxt(k,213)*y(k,149) + mat(k,3871) = rxt(k,213)*y(k,148) + mat(k,2140) = -(rxt(k,501)*y(k,157) + rxt(k,502)*y(k,293)) + mat(k,3097) = -rxt(k,501)*y(k,139) + mat(k,3785) = -rxt(k,502)*y(k,139) + mat(k,2111) = .040_r8*rxt(k,460)*y(k,293) + mat(k,2079) = .030_r8*rxt(k,470)*y(k,293) + mat(k,763) = .050_r8*rxt(k,472)*y(k,293) + mat(k,1187) = .020_r8*rxt(k,481)*y(k,293) + mat(k,1581) = .090_r8*rxt(k,485)*y(k,293) + mat(k,3278) = .540_r8*rxt(k,523)*y(k,272) + mat(k,3919) = .540_r8*rxt(k,478)*y(k,272) + mat(k,2996) = .540_r8*rxt(k,474)*y(k,272) + mat(k,4013) = .530_r8*rxt(k,475)*y(k,272) + mat(k,2179) = .540_r8*rxt(k,523)*y(k,147) + .540_r8*rxt(k,478)*y(k,149) & + + .540_r8*rxt(k,474)*y(k,250) + .530_r8*rxt(k,475)*y(k,251) & + + 2.140_r8*rxt(k,477)*y(k,272) + mat(k,3785) = mat(k,3785) + .040_r8*rxt(k,460)*y(k,115) + .030_r8*rxt(k,470) & + *y(k,118) + .050_r8*rxt(k,472)*y(k,119) + .020_r8*rxt(k,481) & + *y(k,120) + .090_r8*rxt(k,485)*y(k,121) + mat(k,115) = -(rxt(k,810)*y(k,293)) + mat(k,3595) = -rxt(k,810)*y(k,143) + mat(k,3311) = -(rxt(k,194)*y(k,136) + rxt(k,203)*y(k,149) + rxt(k,207) & + *y(k,256) + rxt(k,208)*y(k,157) + rxt(k,209)*y(k,156) + rxt(k,230) & + *y(k,60) + rxt(k,262)*y(k,20) + rxt(k,305)*y(k,251) + rxt(k,314) & + *y(k,257) + rxt(k,327)*y(k,247) + rxt(k,338)*y(k,250) + rxt(k,342) & + *y(k,255) + rxt(k,357)*y(k,248) + rxt(k,366)*y(k,295) + rxt(k,370) & + *y(k,296) + (rxt(k,377) + rxt(k,378)) * y(k,253) + rxt(k,392) & + *y(k,284) + rxt(k,395)*y(k,286) + (rxt(k,410) + rxt(k,411) & + ) * y(k,234) + (rxt(k,503) + rxt(k,504)) * y(k,258) + (rxt(k,505) & + + rxt(k,506)) * y(k,259) + (rxt(k,507) + rxt(k,508)) * y(k,260) & + + (rxt(k,509) + rxt(k,510)) * y(k,265) + (rxt(k,511) + rxt(k,512) & + ) * y(k,266) + (rxt(k,513) + rxt(k,514)) * y(k,267) + (rxt(k,515) & + + rxt(k,516)) * y(k,268) + (rxt(k,517) + rxt(k,518)) * y(k,269) & + + (rxt(k,519) + rxt(k,520)) * y(k,270) + (rxt(k,521) + rxt(k,522) & + ) * y(k,271) + (rxt(k,523) + rxt(k,524)) * y(k,272) + (rxt(k,525) & + + rxt(k,526)) * y(k,273) + (rxt(k,527) + rxt(k,528)) * y(k,274) & + + (rxt(k,530) + rxt(k,531)) * y(k,276) + (rxt(k,533) + rxt(k,534) & + ) * y(k,277) + (rxt(k,535) + rxt(k,536)) * y(k,282) + (rxt(k,537) & + + rxt(k,538)) * y(k,287) + (rxt(k,539) + rxt(k,540)) * y(k,291) & + + rxt(k,542)*y(k,233) + rxt(k,545)*y(k,241) + rxt(k,550) & + *y(k,246) + rxt(k,552)*y(k,249) + rxt(k,556)*y(k,252) + rxt(k,559) & + *y(k,283) + rxt(k,562)*y(k,285) + rxt(k,565)*y(k,294) + rxt(k,572) & + *y(k,312) + rxt(k,578)*y(k,314) + rxt(k,581)*y(k,316) + rxt(k,589) & + *y(k,235) + rxt(k,597)*y(k,236) + rxt(k,609)*y(k,238) + rxt(k,617) & + *y(k,239) + rxt(k,629)*y(k,243) + rxt(k,637)*y(k,244) + rxt(k,649) & + *y(k,279) + rxt(k,657)*y(k,280) + rxt(k,669)*y(k,288) + rxt(k,677) & + *y(k,289) + rxt(k,688)*y(k,297) + rxt(k,692)*y(k,298) + rxt(k,696) & + *y(k,299) + rxt(k,704)*y(k,300) + rxt(k,712)*y(k,301) + rxt(k,722) & + *y(k,302) + rxt(k,731)*y(k,303) + rxt(k,741)*y(k,304) + rxt(k,752) & + *y(k,305) + rxt(k,761)*y(k,306) + rxt(k,766)*y(k,307) + rxt(k,773) & + *y(k,308) + rxt(k,777)*y(k,309) + rxt(k,781)*y(k,310) + rxt(k,785) & + *y(k,311)) + mat(k,477) = -rxt(k,194)*y(k,147) + mat(k,3952) = -rxt(k,203)*y(k,147) + mat(k,3567) = -rxt(k,207)*y(k,147) + mat(k,3129) = -rxt(k,208)*y(k,147) + mat(k,3387) = -rxt(k,209)*y(k,147) + mat(k,2601) = -rxt(k,230)*y(k,147) + mat(k,2561) = -rxt(k,262)*y(k,147) + mat(k,4044) = -rxt(k,305)*y(k,147) + mat(k,694) = -rxt(k,314)*y(k,147) + mat(k,1351) = -rxt(k,327)*y(k,147) + mat(k,3026) = -rxt(k,338)*y(k,147) + mat(k,861) = -rxt(k,342)*y(k,147) + mat(k,1045) = -rxt(k,357)*y(k,147) + mat(k,935) = -rxt(k,366)*y(k,147) + mat(k,1339) = -rxt(k,370)*y(k,147) + mat(k,606) = -(rxt(k,377) + rxt(k,378)) * y(k,147) + mat(k,1623) = -rxt(k,392)*y(k,147) + mat(k,741) = -rxt(k,395)*y(k,147) + mat(k,1203) = -(rxt(k,410) + rxt(k,411)) * y(k,147) + mat(k,1303) = -(rxt(k,503) + rxt(k,504)) * y(k,147) + mat(k,1965) = -(rxt(k,505) + rxt(k,506)) * y(k,147) + mat(k,2004) = -(rxt(k,507) + rxt(k,508)) * y(k,147) + mat(k,1749) = -(rxt(k,509) + rxt(k,510)) * y(k,147) + mat(k,1777) = -(rxt(k,511) + rxt(k,512)) * y(k,147) + mat(k,1125) = -(rxt(k,513) + rxt(k,514)) * y(k,147) + mat(k,1171) = -(rxt(k,515) + rxt(k,516)) * y(k,147) + mat(k,1057) = -(rxt(k,517) + rxt(k,518)) * y(k,147) + mat(k,1136) = -(rxt(k,519) + rxt(k,520)) * y(k,147) + mat(k,1447) = -(rxt(k,521) + rxt(k,522)) * y(k,147) + mat(k,2186) = -(rxt(k,523) + rxt(k,524)) * y(k,147) + mat(k,1316) = -(rxt(k,525) + rxt(k,526)) * y(k,147) + mat(k,1424) = -(rxt(k,527) + rxt(k,528)) * y(k,147) + mat(k,1856) = -(rxt(k,530) + rxt(k,531)) * y(k,147) + mat(k,1825) = -(rxt(k,533) + rxt(k,534)) * y(k,147) + mat(k,1549) = -(rxt(k,535) + rxt(k,536)) * y(k,147) + mat(k,1513) = -(rxt(k,537) + rxt(k,538)) * y(k,147) + mat(k,1647) = -(rxt(k,539) + rxt(k,540)) * y(k,147) + mat(k,549) = -rxt(k,542)*y(k,147) + mat(k,528) = -rxt(k,545)*y(k,147) + mat(k,442) = -rxt(k,550)*y(k,147) + mat(k,711) = -rxt(k,552)*y(k,147) + mat(k,907) = -rxt(k,556)*y(k,147) + mat(k,869) = -rxt(k,559)*y(k,147) + mat(k,926) = -rxt(k,562)*y(k,147) + mat(k,455) = -rxt(k,565)*y(k,147) + mat(k,883) = -rxt(k,572)*y(k,147) + mat(k,900) = -rxt(k,578)*y(k,147) + mat(k,536) = -rxt(k,581)*y(k,147) + mat(k,2305) = -rxt(k,589)*y(k,147) + mat(k,2475) = -rxt(k,597)*y(k,147) + mat(k,2222) = -rxt(k,609)*y(k,147) + mat(k,2333) = -rxt(k,617)*y(k,147) + mat(k,2538) = -rxt(k,629)*y(k,147) + mat(k,2421) = -rxt(k,637)*y(k,147) + mat(k,2509) = -rxt(k,649)*y(k,147) + mat(k,2391) = -rxt(k,657)*y(k,147) + mat(k,2710) = -rxt(k,669)*y(k,147) + mat(k,2813) = -rxt(k,677)*y(k,147) + mat(k,948) = -rxt(k,688)*y(k,147) + mat(k,1008) = -rxt(k,692)*y(k,147) + mat(k,2735) = -rxt(k,696)*y(k,147) + mat(k,2952) = -rxt(k,704)*y(k,147) + mat(k,2780) = -rxt(k,712)*y(k,147) + mat(k,2859) = -rxt(k,722)*y(k,147) + mat(k,2245) = -rxt(k,731)*y(k,147) + mat(k,2757) = -rxt(k,741)*y(k,147) + mat(k,2906) = -rxt(k,752)*y(k,147) + mat(k,798) = -rxt(k,761)*y(k,147) + mat(k,958) = -rxt(k,766)*y(k,147) + mat(k,1221) = -rxt(k,773)*y(k,147) + mat(k,1017) = -rxt(k,777)*y(k,147) + mat(k,807) = -rxt(k,781)*y(k,147) + mat(k,815) = -rxt(k,785)*y(k,147) + mat(k,477) = mat(k,477) + 2.000_r8*rxt(k,196)*y(k,148) + rxt(k,206)*y(k,293) + mat(k,201) = 2.000_r8*rxt(k,210)*y(k,292) + mat(k,4096) = 2.000_r8*rxt(k,196)*y(k,136) + rxt(k,199)*y(k,156) + rxt(k,803) & + *y(k,173) + mat(k,3387) = mat(k,3387) + rxt(k,199)*y(k,148) + mat(k,1604) = rxt(k,803)*y(k,148) + mat(k,2642) = 2.000_r8*rxt(k,210)*y(k,137) + mat(k,3817) = rxt(k,206)*y(k,136) + mat(k,4105) = -((rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,136) + (rxt(k,199) & + rxt(k,201)) * y(k,156) + rxt(k,200)*y(k,157) + rxt(k,212) & *y(k,256) + rxt(k,213)*y(k,149) + rxt(k,214)*y(k,293) + rxt(k,232) & - *y(k,60) + rxt(k,263)*y(k,20) + rxt(k,352)*y(k,250) + rxt(k,407) & - *y(k,284) + rxt(k,558)*y(k,252) + rxt(k,561)*y(k,283) + rxt(k,564) & - *y(k,285) + rxt(k,568)*y(k,164) + rxt(k,571)*y(k,233) + rxt(k,685) & - *y(k,300) + rxt(k,686)*y(k,302) + rxt(k,687)*y(k,305) + rxt(k,803) & + *y(k,60) + rxt(k,263)*y(k,20) + rxt(k,351)*y(k,250) + rxt(k,406) & + *y(k,284) + rxt(k,557)*y(k,252) + rxt(k,560)*y(k,283) + rxt(k,563) & + *y(k,285) + rxt(k,567)*y(k,164) + rxt(k,570)*y(k,233) + rxt(k,684) & + *y(k,300) + rxt(k,685)*y(k,302) + rxt(k,686)*y(k,305) + rxt(k,803) & *y(k,173)) - mat(k,320) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,148) - mat(k,3461) = -(rxt(k,199) + rxt(k,201)) * y(k,148) - mat(k,2995) = -rxt(k,200)*y(k,148) - mat(k,3290) = -rxt(k,212)*y(k,148) - mat(k,3087) = -rxt(k,213)*y(k,148) - mat(k,3751) = -rxt(k,214)*y(k,148) - mat(k,3316) = -rxt(k,232)*y(k,148) - mat(k,3797) = -rxt(k,263)*y(k,148) - mat(k,2709) = -rxt(k,352)*y(k,148) - mat(k,1507) = -rxt(k,407)*y(k,148) - mat(k,795) = -rxt(k,558)*y(k,148) - mat(k,756) = -rxt(k,561)*y(k,148) - mat(k,819) = -rxt(k,564)*y(k,148) - mat(k,408) = -rxt(k,568)*y(k,148) - mat(k,466) = -rxt(k,571)*y(k,148) - mat(k,2545) = -rxt(k,685)*y(k,148) - mat(k,2591) = -rxt(k,686)*y(k,148) - mat(k,2638) = -rxt(k,687)*y(k,148) - mat(k,1521) = -rxt(k,803)*y(k,148) - mat(k,642) = rxt(k,409)*y(k,293) - mat(k,314) = rxt(k,375)*y(k,149) - mat(k,3797) = mat(k,3797) + rxt(k,262)*y(k,147) - mat(k,3316) = mat(k,3316) + rxt(k,230)*y(k,147) - mat(k,367) = rxt(k,193)*y(k,293) - mat(k,417) = .400_r8*rxt(k,423)*y(k,293) - mat(k,1093) = .190_r8*rxt(k,424)*y(k,293) - mat(k,1030) = rxt(k,453)*y(k,293) - mat(k,1642) = .500_r8*rxt(k,455)*y(k,293) - mat(k,1941) = .170_r8*rxt(k,460)*y(k,157) + .080_r8*rxt(k,461)*y(k,293) - mat(k,580) = .150_r8*rxt(k,464)*y(k,293) - mat(k,480) = .130_r8*rxt(k,467)*y(k,293) - mat(k,1975) = .170_r8*rxt(k,470)*y(k,157) + .040_r8*rxt(k,471)*y(k,293) - mat(k,1458) = .170_r8*rxt(k,485)*y(k,157) + .070_r8*rxt(k,486)*y(k,293) - mat(k,1626) = .500_r8*rxt(k,381)*y(k,293) - mat(k,2003) = .170_r8*rxt(k,502)*y(k,157) + .040_r8*rxt(k,503)*y(k,293) - mat(k,2894) = rxt(k,262)*y(k,20) + rxt(k,230)*y(k,60) + 2.000_r8*rxt(k,203) & + mat(k,480) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,148) + mat(k,3396) = -(rxt(k,199) + rxt(k,201)) * y(k,148) + mat(k,3138) = -rxt(k,200)*y(k,148) + mat(k,3576) = -rxt(k,212)*y(k,148) + mat(k,3961) = -rxt(k,213)*y(k,148) + mat(k,3826) = -rxt(k,214)*y(k,148) + mat(k,2610) = -rxt(k,232)*y(k,148) + mat(k,2569) = -rxt(k,263)*y(k,148) + mat(k,3035) = -rxt(k,351)*y(k,148) + mat(k,1630) = -rxt(k,406)*y(k,148) + mat(k,911) = -rxt(k,557)*y(k,148) + mat(k,871) = -rxt(k,560)*y(k,148) + mat(k,930) = -rxt(k,563)*y(k,148) + mat(k,508) = -rxt(k,567)*y(k,148) + mat(k,552) = -rxt(k,570)*y(k,148) + mat(k,2961) = -rxt(k,684)*y(k,148) + mat(k,2868) = -rxt(k,685)*y(k,148) + mat(k,2915) = -rxt(k,686)*y(k,148) + mat(k,1609) = -rxt(k,803)*y(k,148) + mat(k,725) = rxt(k,408)*y(k,293) + mat(k,381) = rxt(k,374)*y(k,149) + mat(k,2569) = mat(k,2569) + rxt(k,262)*y(k,147) + mat(k,2610) = mat(k,2610) + rxt(k,230)*y(k,147) + mat(k,450) = rxt(k,193)*y(k,293) + mat(k,497) = .400_r8*rxt(k,422)*y(k,293) + mat(k,1276) = .190_r8*rxt(k,423)*y(k,293) + mat(k,1118) = rxt(k,452)*y(k,293) + mat(k,1800) = .500_r8*rxt(k,454)*y(k,293) + mat(k,2123) = .170_r8*rxt(k,459)*y(k,157) + .080_r8*rxt(k,460)*y(k,293) + mat(k,618) = .150_r8*rxt(k,463)*y(k,293) + mat(k,565) = .130_r8*rxt(k,466)*y(k,293) + mat(k,2091) = .170_r8*rxt(k,469)*y(k,157) + .040_r8*rxt(k,470)*y(k,293) + mat(k,1593) = .170_r8*rxt(k,484)*y(k,157) + .070_r8*rxt(k,485)*y(k,293) + mat(k,1733) = .500_r8*rxt(k,380)*y(k,293) + mat(k,2152) = .170_r8*rxt(k,501)*y(k,157) + .040_r8*rxt(k,502)*y(k,293) + mat(k,3320) = rxt(k,262)*y(k,20) + rxt(k,230)*y(k,60) + 2.000_r8*rxt(k,203) & *y(k,149) + rxt(k,209)*y(k,156) + rxt(k,208)*y(k,157) & - + rxt(k,543)*y(k,233) + rxt(k,411)*y(k,234) & - + 1.860_r8*rxt(k,590)*y(k,235) + .770_r8*rxt(k,598)*y(k,236) & - + 1.860_r8*rxt(k,610)*y(k,238) + .700_r8*rxt(k,618)*y(k,239) & - + rxt(k,546)*y(k,241) + 1.390_r8*rxt(k,630)*y(k,243) & - + .750_r8*rxt(k,638)*y(k,244) + rxt(k,551)*y(k,246) + rxt(k,328) & - *y(k,247) + rxt(k,358)*y(k,248) + rxt(k,553)*y(k,249) & - + rxt(k,339)*y(k,250) + rxt(k,305)*y(k,251) + rxt(k,557) & - *y(k,252) + rxt(k,378)*y(k,253) + rxt(k,343)*y(k,255) & - + rxt(k,207)*y(k,256) + rxt(k,315)*y(k,257) + rxt(k,504) & - *y(k,258) + rxt(k,506)*y(k,259) + rxt(k,508)*y(k,260) & - + rxt(k,510)*y(k,265) + rxt(k,512)*y(k,266) + rxt(k,514) & - *y(k,267) + 1.730_r8*rxt(k,516)*y(k,268) + rxt(k,518)*y(k,269) & - + rxt(k,520)*y(k,270) + rxt(k,522)*y(k,271) & - + 1.460_r8*rxt(k,524)*y(k,272) + rxt(k,526)*y(k,273) & - + rxt(k,528)*y(k,274) + rxt(k,531)*y(k,276) + rxt(k,534) & - *y(k,277) + 1.360_r8*rxt(k,650)*y(k,279) + .770_r8*rxt(k,658) & - *y(k,280) + rxt(k,536)*y(k,282) + rxt(k,560)*y(k,283) & - + rxt(k,393)*y(k,284) + rxt(k,563)*y(k,285) + rxt(k,396) & - *y(k,286) + rxt(k,538)*y(k,287) + 1.820_r8*rxt(k,670)*y(k,288) & - + .710_r8*rxt(k,678)*y(k,289) + rxt(k,540)*y(k,291) + rxt(k,566) & - *y(k,294) + rxt(k,367)*y(k,295) + rxt(k,371)*y(k,296) & - + .700_r8*rxt(k,689)*y(k,297) + .700_r8*rxt(k,693)*y(k,298) & - + .700_r8*rxt(k,697)*y(k,299) + rxt(k,705)*y(k,300) & - + .830_r8*rxt(k,713)*y(k,301) + rxt(k,723)*y(k,302) & - + .700_r8*rxt(k,732)*y(k,303) + .910_r8*rxt(k,742)*y(k,304) & - + rxt(k,753)*y(k,305) + .700_r8*rxt(k,762)*y(k,306) & - + .700_r8*rxt(k,767)*y(k,307) + .700_r8*rxt(k,774)*y(k,308) & - + .700_r8*rxt(k,778)*y(k,309) + .700_r8*rxt(k,782)*y(k,310) & - + .700_r8*rxt(k,786)*y(k,311) + rxt(k,573)*y(k,312) + rxt(k,579) & - *y(k,314) + rxt(k,582)*y(k,316) - mat(k,3087) = mat(k,3087) + rxt(k,375)*y(k,16) + 2.000_r8*rxt(k,203)*y(k,147) & - + rxt(k,204)*y(k,156) + rxt(k,760)*y(k,210) + .500_r8*rxt(k,765) & - *y(k,211) + 2.000_r8*rxt(k,591)*y(k,235) + rxt(k,599)*y(k,236) & - + 2.000_r8*rxt(k,611)*y(k,238) + rxt(k,619)*y(k,239) & - + 1.500_r8*rxt(k,631)*y(k,243) + rxt(k,639)*y(k,244) & - + rxt(k,202)*y(k,256) + 1.460_r8*rxt(k,479)*y(k,272) & - + 1.460_r8*rxt(k,651)*y(k,279) + rxt(k,659)*y(k,280) & - + rxt(k,394)*y(k,284) + 1.950_r8*rxt(k,671)*y(k,288) & - + rxt(k,679)*y(k,289) + rxt(k,205)*y(k,293) + rxt(k,698) & - *y(k,299) + rxt(k,706)*y(k,300) + rxt(k,714)*y(k,301) & - + rxt(k,724)*y(k,302) + rxt(k,733)*y(k,303) + rxt(k,743) & - *y(k,304) + rxt(k,754)*y(k,305) - mat(k,1274) = rxt(k,349)*y(k,293) - mat(k,1347) = rxt(k,365)*y(k,293) - mat(k,3461) = mat(k,3461) + rxt(k,209)*y(k,147) + rxt(k,204)*y(k,149) - mat(k,2995) = mat(k,2995) + .170_r8*rxt(k,460)*y(k,115) + .170_r8*rxt(k,470) & - *y(k,118) + .170_r8*rxt(k,485)*y(k,121) + .170_r8*rxt(k,502) & + + rxt(k,542)*y(k,233) + rxt(k,410)*y(k,234) & + + 1.860_r8*rxt(k,589)*y(k,235) + .770_r8*rxt(k,597)*y(k,236) & + + 1.860_r8*rxt(k,609)*y(k,238) + .700_r8*rxt(k,617)*y(k,239) & + + rxt(k,545)*y(k,241) + 1.390_r8*rxt(k,629)*y(k,243) & + + .750_r8*rxt(k,637)*y(k,244) + rxt(k,550)*y(k,246) + rxt(k,327) & + *y(k,247) + rxt(k,357)*y(k,248) + rxt(k,552)*y(k,249) & + + rxt(k,338)*y(k,250) + rxt(k,305)*y(k,251) + rxt(k,556) & + *y(k,252) + rxt(k,377)*y(k,253) + rxt(k,342)*y(k,255) & + + rxt(k,207)*y(k,256) + rxt(k,314)*y(k,257) + rxt(k,503) & + *y(k,258) + rxt(k,505)*y(k,259) + rxt(k,507)*y(k,260) & + + rxt(k,509)*y(k,265) + rxt(k,511)*y(k,266) + rxt(k,513) & + *y(k,267) + 1.730_r8*rxt(k,515)*y(k,268) + rxt(k,517)*y(k,269) & + + rxt(k,519)*y(k,270) + rxt(k,521)*y(k,271) & + + 1.460_r8*rxt(k,523)*y(k,272) + rxt(k,525)*y(k,273) & + + rxt(k,527)*y(k,274) + rxt(k,530)*y(k,276) + rxt(k,533) & + *y(k,277) + 1.360_r8*rxt(k,649)*y(k,279) + .770_r8*rxt(k,657) & + *y(k,280) + rxt(k,535)*y(k,282) + rxt(k,559)*y(k,283) & + + rxt(k,392)*y(k,284) + rxt(k,562)*y(k,285) + rxt(k,395) & + *y(k,286) + rxt(k,537)*y(k,287) + 1.820_r8*rxt(k,669)*y(k,288) & + + .710_r8*rxt(k,677)*y(k,289) + rxt(k,539)*y(k,291) + rxt(k,565) & + *y(k,294) + rxt(k,366)*y(k,295) + rxt(k,370)*y(k,296) & + + .700_r8*rxt(k,688)*y(k,297) + .700_r8*rxt(k,692)*y(k,298) & + + .700_r8*rxt(k,696)*y(k,299) + rxt(k,704)*y(k,300) & + + .830_r8*rxt(k,712)*y(k,301) + rxt(k,722)*y(k,302) & + + .700_r8*rxt(k,731)*y(k,303) + .910_r8*rxt(k,741)*y(k,304) & + + rxt(k,752)*y(k,305) + .700_r8*rxt(k,761)*y(k,306) & + + .700_r8*rxt(k,766)*y(k,307) + .700_r8*rxt(k,773)*y(k,308) & + + .700_r8*rxt(k,777)*y(k,309) + .700_r8*rxt(k,781)*y(k,310) & + + .700_r8*rxt(k,785)*y(k,311) + rxt(k,572)*y(k,312) + rxt(k,578) & + *y(k,314) + rxt(k,581)*y(k,316) + mat(k,3961) = mat(k,3961) + rxt(k,374)*y(k,16) + 2.000_r8*rxt(k,203)*y(k,147) & + + rxt(k,204)*y(k,156) + rxt(k,759)*y(k,210) + .500_r8*rxt(k,764) & + *y(k,211) + 2.000_r8*rxt(k,590)*y(k,235) + rxt(k,598)*y(k,236) & + + 2.000_r8*rxt(k,610)*y(k,238) + rxt(k,618)*y(k,239) & + + 1.500_r8*rxt(k,630)*y(k,243) + rxt(k,638)*y(k,244) & + + rxt(k,202)*y(k,256) + 1.460_r8*rxt(k,478)*y(k,272) & + + 1.460_r8*rxt(k,650)*y(k,279) + rxt(k,658)*y(k,280) & + + rxt(k,393)*y(k,284) + 1.950_r8*rxt(k,670)*y(k,288) & + + rxt(k,678)*y(k,289) + rxt(k,205)*y(k,293) + rxt(k,697) & + *y(k,299) + rxt(k,705)*y(k,300) + rxt(k,713)*y(k,301) & + + rxt(k,723)*y(k,302) + rxt(k,732)*y(k,303) + rxt(k,742) & + *y(k,304) + rxt(k,753)*y(k,305) + mat(k,1458) = rxt(k,348)*y(k,293) + mat(k,1484) = rxt(k,364)*y(k,293) + mat(k,3396) = mat(k,3396) + rxt(k,209)*y(k,147) + rxt(k,204)*y(k,149) + mat(k,3138) = mat(k,3138) + .170_r8*rxt(k,459)*y(k,115) + .170_r8*rxt(k,469) & + *y(k,118) + .170_r8*rxt(k,484)*y(k,121) + .170_r8*rxt(k,501) & *y(k,139) + rxt(k,208)*y(k,147) - mat(k,512) = rxt(k,719)*y(k,293) - mat(k,520) = rxt(k,738)*y(k,293) - mat(k,348) = rxt(k,758)*y(k,293) - mat(k,2434) = rxt(k,760)*y(k,149) - mat(k,2407) = .500_r8*rxt(k,765)*y(k,149) - mat(k,1158) = rxt(k,770)*y(k,293) - mat(k,1466) = rxt(k,784)*y(k,293) - mat(k,1400) = rxt(k,788)*y(k,293) - mat(k,466) = mat(k,466) + rxt(k,543)*y(k,147) - mat(k,1140) = rxt(k,411)*y(k,147) - mat(k,2134) = 1.860_r8*rxt(k,590)*y(k,147) + 2.000_r8*rxt(k,591)*y(k,149) & - + 3.280_r8*rxt(k,586)*y(k,235) + rxt(k,587)*y(k,250) & - + .820_r8*rxt(k,588)*y(k,251) + .700_r8*rxt(k,589)*y(k,256) & - + rxt(k,592)*y(k,300) + rxt(k,593)*y(k,302) + rxt(k,594) & + mat(k,656) = rxt(k,718)*y(k,293) + mat(k,665) = rxt(k,737)*y(k,293) + mat(k,425) = rxt(k,757)*y(k,293) + mat(k,2679) = rxt(k,759)*y(k,149) + mat(k,2363) = .500_r8*rxt(k,764)*y(k,149) + mat(k,1231) = rxt(k,769)*y(k,293) + mat(k,1559) = rxt(k,783)*y(k,293) + mat(k,1539) = rxt(k,787)*y(k,293) + mat(k,552) = mat(k,552) + rxt(k,542)*y(k,147) + mat(k,1207) = rxt(k,410)*y(k,147) + mat(k,2313) = 1.860_r8*rxt(k,589)*y(k,147) + 2.000_r8*rxt(k,590)*y(k,149) & + + 3.280_r8*rxt(k,585)*y(k,235) + rxt(k,586)*y(k,250) & + + .820_r8*rxt(k,587)*y(k,251) + .700_r8*rxt(k,588)*y(k,256) & + + rxt(k,591)*y(k,300) + rxt(k,592)*y(k,302) + rxt(k,593) & *y(k,305) - mat(k,2230) = .770_r8*rxt(k,598)*y(k,147) + rxt(k,599)*y(k,149) - mat(k,2067) = 1.860_r8*rxt(k,610)*y(k,147) + 2.000_r8*rxt(k,611)*y(k,149) & - + 3.280_r8*rxt(k,606)*y(k,238) + rxt(k,607)*y(k,250) & - + .820_r8*rxt(k,608)*y(k,251) + .500_r8*rxt(k,609)*y(k,256) & - + rxt(k,612)*y(k,300) + rxt(k,613)*y(k,302) + rxt(k,614) & + mat(k,2483) = .770_r8*rxt(k,597)*y(k,147) + rxt(k,598)*y(k,149) + mat(k,2229) = 1.860_r8*rxt(k,609)*y(k,147) + 2.000_r8*rxt(k,610)*y(k,149) & + + 3.280_r8*rxt(k,605)*y(k,238) + rxt(k,606)*y(k,250) & + + .820_r8*rxt(k,607)*y(k,251) + .500_r8*rxt(k,608)*y(k,256) & + + rxt(k,611)*y(k,300) + rxt(k,612)*y(k,302) + rxt(k,613) & *y(k,305) - mat(k,2112) = .700_r8*rxt(k,618)*y(k,147) + rxt(k,619)*y(k,149) - mat(k,440) = rxt(k,546)*y(k,147) - mat(k,2347) = 1.390_r8*rxt(k,630)*y(k,147) + 1.500_r8*rxt(k,631)*y(k,149) & - + 1.880_r8*rxt(k,626)*y(k,243) + .500_r8*rxt(k,627)*y(k,250) & - + .360_r8*rxt(k,628)*y(k,251) + .240_r8*rxt(k,629)*y(k,256) & - + .500_r8*rxt(k,632)*y(k,300) + .500_r8*rxt(k,633)*y(k,302) & - + .500_r8*rxt(k,634)*y(k,305) - mat(k,2259) = .750_r8*rxt(k,638)*y(k,147) + rxt(k,639)*y(k,149) - mat(k,362) = rxt(k,551)*y(k,147) - mat(k,1250) = rxt(k,328)*y(k,147) - mat(k,982) = rxt(k,358)*y(k,147) - mat(k,608) = rxt(k,553)*y(k,147) - mat(k,2709) = mat(k,2709) + rxt(k,339)*y(k,147) + rxt(k,587)*y(k,235) & - + rxt(k,607)*y(k,238) + .500_r8*rxt(k,627)*y(k,243) & - + .460_r8*rxt(k,475)*y(k,272) + .460_r8*rxt(k,646)*y(k,279) & - + .950_r8*rxt(k,666)*y(k,288) - mat(k,3431) = rxt(k,305)*y(k,147) + .820_r8*rxt(k,588)*y(k,235) & - + .820_r8*rxt(k,608)*y(k,238) + .360_r8*rxt(k,628)*y(k,243) & - + .070_r8*rxt(k,476)*y(k,272) + .310_r8*rxt(k,647)*y(k,279) & - + .770_r8*rxt(k,667)*y(k,288) - mat(k,795) = mat(k,795) + rxt(k,557)*y(k,147) - mat(k,541) = rxt(k,378)*y(k,147) - mat(k,749) = rxt(k,343)*y(k,147) - mat(k,3290) = mat(k,3290) + rxt(k,207)*y(k,147) + rxt(k,202)*y(k,149) & - + .700_r8*rxt(k,589)*y(k,235) + .500_r8*rxt(k,609)*y(k,238) & - + .240_r8*rxt(k,629)*y(k,243) + .460_r8*rxt(k,462)*y(k,268) & - + .240_r8*rxt(k,477)*y(k,272) + .230_r8*rxt(k,648)*y(k,279) & - + .480_r8*rxt(k,668)*y(k,288) - mat(k,599) = rxt(k,315)*y(k,147) - mat(k,1412) = rxt(k,504)*y(k,147) - mat(k,1841) = rxt(k,506)*y(k,147) - mat(k,1743) = rxt(k,508)*y(k,147) - mat(k,1563) = rxt(k,510)*y(k,147) - mat(k,1584) = rxt(k,512)*y(k,147) - mat(k,1008) = rxt(k,514)*y(k,147) - mat(k,1081) = 1.730_r8*rxt(k,516)*y(k,147) + .460_r8*rxt(k,462)*y(k,256) - mat(k,993) = rxt(k,518)*y(k,147) - mat(k,1019) = rxt(k,520)*y(k,147) - mat(k,1327) = rxt(k,522)*y(k,147) - mat(k,2046) = 1.460_r8*rxt(k,524)*y(k,147) + 1.460_r8*rxt(k,479)*y(k,149) & - + .460_r8*rxt(k,475)*y(k,250) + .070_r8*rxt(k,476)*y(k,251) & - + .240_r8*rxt(k,477)*y(k,256) + .320_r8*rxt(k,478)*y(k,272) - mat(k,1192) = rxt(k,526)*y(k,147) - mat(k,1268) = rxt(k,528)*y(k,147) - mat(k,1793) = rxt(k,531)*y(k,147) - mat(k,1681) = rxt(k,534)*y(k,147) - mat(k,2320) = 1.360_r8*rxt(k,650)*y(k,147) + 1.460_r8*rxt(k,651)*y(k,149) & - + .460_r8*rxt(k,646)*y(k,250) + .310_r8*rxt(k,647)*y(k,251) & - + .230_r8*rxt(k,648)*y(k,256) + 1.720_r8*rxt(k,649)*y(k,279) & - + .460_r8*rxt(k,652)*y(k,300) + .460_r8*rxt(k,653)*y(k,302) & - + .460_r8*rxt(k,654)*y(k,305) - mat(k,2173) = .770_r8*rxt(k,658)*y(k,147) + rxt(k,659)*y(k,149) - mat(k,1394) = rxt(k,536)*y(k,147) - mat(k,756) = mat(k,756) + rxt(k,560)*y(k,147) - mat(k,1507) = mat(k,1507) + rxt(k,393)*y(k,147) + rxt(k,394)*y(k,149) - mat(k,819) = mat(k,819) + rxt(k,563)*y(k,147) - mat(k,661) = rxt(k,396)*y(k,147) - mat(k,1380) = rxt(k,538)*y(k,147) - mat(k,2381) = 1.820_r8*rxt(k,670)*y(k,147) + 1.950_r8*rxt(k,671)*y(k,149) & - + .950_r8*rxt(k,666)*y(k,250) + .770_r8*rxt(k,667)*y(k,251) & - + .480_r8*rxt(k,668)*y(k,256) + 3.080_r8*rxt(k,669)*y(k,288) & - + .950_r8*rxt(k,672)*y(k,300) + .950_r8*rxt(k,673)*y(k,302) & - + .950_r8*rxt(k,674)*y(k,305) - mat(k,2288) = .710_r8*rxt(k,678)*y(k,147) + rxt(k,679)*y(k,149) - mat(k,1492) = rxt(k,540)*y(k,147) - mat(k,3751) = mat(k,3751) + rxt(k,409)*y(k,1) + rxt(k,193)*y(k,94) & - + .400_r8*rxt(k,423)*y(k,107) + .190_r8*rxt(k,424)*y(k,108) & - + rxt(k,453)*y(k,111) + .500_r8*rxt(k,455)*y(k,112) & - + .080_r8*rxt(k,461)*y(k,115) + .150_r8*rxt(k,464)*y(k,116) & - + .130_r8*rxt(k,467)*y(k,117) + .040_r8*rxt(k,471)*y(k,118) & - + .070_r8*rxt(k,486)*y(k,121) + .500_r8*rxt(k,381)*y(k,127) & - + .040_r8*rxt(k,503)*y(k,139) + rxt(k,205)*y(k,149) + rxt(k,349) & - *y(k,150) + rxt(k,365)*y(k,151) + rxt(k,719)*y(k,202) & - + rxt(k,738)*y(k,204) + rxt(k,758)*y(k,208) + rxt(k,770) & - *y(k,212) + rxt(k,784)*y(k,219) + rxt(k,788)*y(k,221) - mat(k,381) = rxt(k,566)*y(k,147) - mat(k,828) = rxt(k,367)*y(k,147) - mat(k,1233) = rxt(k,371)*y(k,147) - mat(k,841) = .700_r8*rxt(k,689)*y(k,147) - mat(k,923) = .700_r8*rxt(k,693)*y(k,147) - mat(k,2459) = .700_r8*rxt(k,697)*y(k,147) + rxt(k,698)*y(k,149) - mat(k,2545) = mat(k,2545) + rxt(k,705)*y(k,147) + rxt(k,706)*y(k,149) & + mat(k,2340) = .700_r8*rxt(k,617)*y(k,147) + rxt(k,618)*y(k,149) + mat(k,531) = rxt(k,545)*y(k,147) + mat(k,2546) = 1.390_r8*rxt(k,629)*y(k,147) + 1.500_r8*rxt(k,630)*y(k,149) & + + 1.880_r8*rxt(k,625)*y(k,243) + .500_r8*rxt(k,626)*y(k,250) & + + .360_r8*rxt(k,627)*y(k,251) + .240_r8*rxt(k,628)*y(k,256) & + + .500_r8*rxt(k,631)*y(k,300) + .500_r8*rxt(k,632)*y(k,302) & + + .500_r8*rxt(k,633)*y(k,305) + mat(k,2429) = .750_r8*rxt(k,637)*y(k,147) + rxt(k,638)*y(k,149) + mat(k,445) = rxt(k,550)*y(k,147) + mat(k,1356) = rxt(k,327)*y(k,147) + mat(k,1050) = rxt(k,357)*y(k,147) + mat(k,714) = rxt(k,552)*y(k,147) + mat(k,3035) = mat(k,3035) + rxt(k,338)*y(k,147) + rxt(k,586)*y(k,235) & + + rxt(k,606)*y(k,238) + .500_r8*rxt(k,626)*y(k,243) & + + .460_r8*rxt(k,474)*y(k,272) + .460_r8*rxt(k,645)*y(k,279) & + + .950_r8*rxt(k,665)*y(k,288) + mat(k,4053) = rxt(k,305)*y(k,147) + .820_r8*rxt(k,587)*y(k,235) & + + .820_r8*rxt(k,607)*y(k,238) + .360_r8*rxt(k,627)*y(k,243) & + + .070_r8*rxt(k,475)*y(k,272) + .310_r8*rxt(k,646)*y(k,279) & + + .770_r8*rxt(k,666)*y(k,288) + mat(k,911) = mat(k,911) + rxt(k,556)*y(k,147) + mat(k,609) = rxt(k,377)*y(k,147) + mat(k,865) = rxt(k,342)*y(k,147) + mat(k,3576) = mat(k,3576) + rxt(k,207)*y(k,147) + rxt(k,202)*y(k,149) & + + .700_r8*rxt(k,588)*y(k,235) + .500_r8*rxt(k,608)*y(k,238) & + + .240_r8*rxt(k,628)*y(k,243) + .460_r8*rxt(k,461)*y(k,268) & + + .240_r8*rxt(k,476)*y(k,272) + .230_r8*rxt(k,647)*y(k,279) & + + .480_r8*rxt(k,667)*y(k,288) + mat(k,698) = rxt(k,314)*y(k,147) + mat(k,1306) = rxt(k,503)*y(k,147) + mat(k,1973) = rxt(k,505)*y(k,147) + mat(k,2012) = rxt(k,507)*y(k,147) + mat(k,1755) = rxt(k,509)*y(k,147) + mat(k,1783) = rxt(k,511)*y(k,147) + mat(k,1129) = rxt(k,513)*y(k,147) + mat(k,1175) = 1.730_r8*rxt(k,515)*y(k,147) + .460_r8*rxt(k,461)*y(k,256) + mat(k,1061) = rxt(k,517)*y(k,147) + mat(k,1140) = rxt(k,519)*y(k,147) + mat(k,1451) = rxt(k,521)*y(k,147) + mat(k,2195) = 1.460_r8*rxt(k,523)*y(k,147) + 1.460_r8*rxt(k,478)*y(k,149) & + + .460_r8*rxt(k,474)*y(k,250) + .070_r8*rxt(k,475)*y(k,251) & + + .240_r8*rxt(k,476)*y(k,256) + .320_r8*rxt(k,477)*y(k,272) + mat(k,1320) = rxt(k,525)*y(k,147) + mat(k,1428) = rxt(k,527)*y(k,147) + mat(k,1862) = rxt(k,530)*y(k,147) + mat(k,1831) = rxt(k,533)*y(k,147) + mat(k,2517) = 1.360_r8*rxt(k,649)*y(k,147) + 1.460_r8*rxt(k,650)*y(k,149) & + + .460_r8*rxt(k,645)*y(k,250) + .310_r8*rxt(k,646)*y(k,251) & + + .230_r8*rxt(k,647)*y(k,256) + 1.720_r8*rxt(k,648)*y(k,279) & + + .460_r8*rxt(k,651)*y(k,300) + .460_r8*rxt(k,652)*y(k,302) & + + .460_r8*rxt(k,653)*y(k,305) + mat(k,2399) = .770_r8*rxt(k,657)*y(k,147) + rxt(k,658)*y(k,149) + mat(k,1554) = rxt(k,535)*y(k,147) + mat(k,871) = mat(k,871) + rxt(k,559)*y(k,147) + mat(k,1630) = mat(k,1630) + rxt(k,392)*y(k,147) + rxt(k,393)*y(k,149) + mat(k,930) = mat(k,930) + rxt(k,562)*y(k,147) + mat(k,744) = rxt(k,395)*y(k,147) + mat(k,1518) = rxt(k,537)*y(k,147) + mat(k,2719) = 1.820_r8*rxt(k,669)*y(k,147) + 1.950_r8*rxt(k,670)*y(k,149) & + + .950_r8*rxt(k,665)*y(k,250) + .770_r8*rxt(k,666)*y(k,251) & + + .480_r8*rxt(k,667)*y(k,256) + 3.080_r8*rxt(k,668)*y(k,288) & + + .950_r8*rxt(k,671)*y(k,300) + .950_r8*rxt(k,672)*y(k,302) & + + .950_r8*rxt(k,673)*y(k,305) + mat(k,2822) = .710_r8*rxt(k,677)*y(k,147) + rxt(k,678)*y(k,149) + mat(k,1653) = rxt(k,539)*y(k,147) + mat(k,3826) = mat(k,3826) + rxt(k,408)*y(k,1) + rxt(k,193)*y(k,94) & + + .400_r8*rxt(k,422)*y(k,107) + .190_r8*rxt(k,423)*y(k,108) & + + rxt(k,452)*y(k,111) + .500_r8*rxt(k,454)*y(k,112) & + + .080_r8*rxt(k,460)*y(k,115) + .150_r8*rxt(k,463)*y(k,116) & + + .130_r8*rxt(k,466)*y(k,117) + .040_r8*rxt(k,470)*y(k,118) & + + .070_r8*rxt(k,485)*y(k,121) + .500_r8*rxt(k,380)*y(k,127) & + + .040_r8*rxt(k,502)*y(k,139) + rxt(k,205)*y(k,149) + rxt(k,348) & + *y(k,150) + rxt(k,364)*y(k,151) + rxt(k,718)*y(k,202) & + + rxt(k,737)*y(k,204) + rxt(k,757)*y(k,208) + rxt(k,769) & + *y(k,212) + rxt(k,783)*y(k,219) + rxt(k,787)*y(k,221) + mat(k,458) = rxt(k,565)*y(k,147) + mat(k,939) = rxt(k,366)*y(k,147) + mat(k,1344) = rxt(k,370)*y(k,147) + mat(k,952) = .700_r8*rxt(k,688)*y(k,147) + mat(k,1011) = .700_r8*rxt(k,692)*y(k,147) + mat(k,2743) = .700_r8*rxt(k,696)*y(k,147) + rxt(k,697)*y(k,149) + mat(k,2961) = mat(k,2961) + rxt(k,704)*y(k,147) + rxt(k,705)*y(k,149) & + + rxt(k,591)*y(k,235) + rxt(k,611)*y(k,238) + .500_r8*rxt(k,631) & + *y(k,243) + .460_r8*rxt(k,651)*y(k,279) + .950_r8*rxt(k,671) & + *y(k,288) + mat(k,2788) = .830_r8*rxt(k,712)*y(k,147) + rxt(k,713)*y(k,149) + mat(k,2868) = mat(k,2868) + rxt(k,722)*y(k,147) + rxt(k,723)*y(k,149) & + rxt(k,592)*y(k,235) + rxt(k,612)*y(k,238) + .500_r8*rxt(k,632) & *y(k,243) + .460_r8*rxt(k,652)*y(k,279) + .950_r8*rxt(k,672) & *y(k,288) - mat(k,2501) = .830_r8*rxt(k,713)*y(k,147) + rxt(k,714)*y(k,149) - mat(k,2591) = mat(k,2591) + rxt(k,723)*y(k,147) + rxt(k,724)*y(k,149) & + mat(k,2253) = .700_r8*rxt(k,731)*y(k,147) + rxt(k,732)*y(k,149) + mat(k,2765) = .910_r8*rxt(k,741)*y(k,147) + rxt(k,742)*y(k,149) + mat(k,2915) = mat(k,2915) + rxt(k,752)*y(k,147) + rxt(k,753)*y(k,149) & + rxt(k,593)*y(k,235) + rxt(k,613)*y(k,238) + .500_r8*rxt(k,633) & *y(k,243) + .460_r8*rxt(k,653)*y(k,279) + .950_r8*rxt(k,673) & *y(k,288) - mat(k,2089) = .700_r8*rxt(k,732)*y(k,147) + rxt(k,733)*y(k,149) - mat(k,2480) = .910_r8*rxt(k,742)*y(k,147) + rxt(k,743)*y(k,149) - mat(k,2638) = mat(k,2638) + rxt(k,753)*y(k,147) + rxt(k,754)*y(k,149) & - + rxt(k,594)*y(k,235) + rxt(k,614)*y(k,238) + .500_r8*rxt(k,634) & - *y(k,243) + .460_r8*rxt(k,654)*y(k,279) + .950_r8*rxt(k,674) & - *y(k,288) - mat(k,686) = .700_r8*rxt(k,762)*y(k,147) - mat(k,850) = .700_r8*rxt(k,767)*y(k,147) - mat(k,1151) = .700_r8*rxt(k,774)*y(k,147) - mat(k,932) = .700_r8*rxt(k,778)*y(k,147) - mat(k,694) = .700_r8*rxt(k,782)*y(k,147) - mat(k,702) = .700_r8*rxt(k,786)*y(k,147) - mat(k,770) = rxt(k,573)*y(k,147) - mat(k,787) = rxt(k,579)*y(k,147) - mat(k,448) = rxt(k,582)*y(k,147) + mat(k,802) = .700_r8*rxt(k,761)*y(k,147) + mat(k,961) = .700_r8*rxt(k,766)*y(k,147) + mat(k,1224) = .700_r8*rxt(k,773)*y(k,147) + mat(k,1020) = .700_r8*rxt(k,777)*y(k,147) + mat(k,810) = .700_r8*rxt(k,781)*y(k,147) + mat(k,818) = .700_r8*rxt(k,785)*y(k,147) + mat(k,886) = rxt(k,572)*y(k,147) + mat(k,903) = rxt(k,578)*y(k,147) + mat(k,539) = rxt(k,581)*y(k,147) end do end subroutine nlnmat07 subroutine nlnmat08( avec_len, mat, y, rxt ) @@ -1800,210 +2061,210 @@ subroutine nlnmat08( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,3080) = -(rxt(k,202)*y(k,256) + rxt(k,203)*y(k,147) + rxt(k,204) & + mat(k,3959) = -(rxt(k,202)*y(k,256) + rxt(k,203)*y(k,147) + rxt(k,204) & *y(k,156) + rxt(k,205)*y(k,293) + rxt(k,213)*y(k,148) + rxt(k,299) & - *y(k,43) + rxt(k,333)*y(k,46) + rxt(k,354)*y(k,30) + rxt(k,361) & - *y(k,50) + rxt(k,375)*y(k,16) + rxt(k,394)*y(k,284) + rxt(k,474) & - *y(k,109) + rxt(k,479)*y(k,272) + rxt(k,585)*y(k,4) + rxt(k,591) & - *y(k,235) + rxt(k,599)*y(k,236) + rxt(k,605)*y(k,7) + rxt(k,611) & - *y(k,238) + rxt(k,619)*y(k,239) + rxt(k,625)*y(k,17) + rxt(k,631) & - *y(k,243) + rxt(k,639)*y(k,244) + rxt(k,645)*y(k,125) + rxt(k,651) & - *y(k,279) + rxt(k,659)*y(k,280) + rxt(k,665)*y(k,135) + rxt(k,671) & - *y(k,288) + rxt(k,679)*y(k,289) + rxt(k,698)*y(k,299) + rxt(k,706) & - *y(k,300) + rxt(k,709)*y(k,201) + rxt(k,714)*y(k,301) + rxt(k,724) & - *y(k,302) + rxt(k,728)*y(k,203) + rxt(k,733)*y(k,303) + rxt(k,743) & - *y(k,304) + rxt(k,754)*y(k,305) + rxt(k,756)*y(k,200) + rxt(k,760) & - *y(k,210) + rxt(k,765)*y(k,211) + rxt(k,794)*y(k,69)) - mat(k,3283) = -rxt(k,202)*y(k,149) - mat(k,2887) = -rxt(k,203)*y(k,149) - mat(k,3454) = -rxt(k,204)*y(k,149) - mat(k,3744) = -rxt(k,205)*y(k,149) - mat(k,3504) = -rxt(k,213)*y(k,149) - mat(k,3333) = -rxt(k,299)*y(k,149) - mat(k,1309) = -rxt(k,333)*y(k,149) - mat(k,1204) = -rxt(k,354)*y(k,149) - mat(k,1849) = -rxt(k,361)*y(k,149) - mat(k,312) = -rxt(k,375)*y(k,149) - mat(k,1503) = -rxt(k,394)*y(k,149) - mat(k,1299) = -rxt(k,474)*y(k,149) - mat(k,2041) = -rxt(k,479)*y(k,149) - mat(k,1114) = -rxt(k,585)*y(k,149) - mat(k,2130) = -rxt(k,591)*y(k,149) - mat(k,2226) = -rxt(k,599)*y(k,149) - mat(k,867) = -rxt(k,605)*y(k,149) - mat(k,2063) = -rxt(k,611)*y(k,149) - mat(k,2108) = -rxt(k,619)*y(k,149) - mat(k,951) = -rxt(k,625)*y(k,149) - mat(k,2343) = -rxt(k,631)*y(k,149) - mat(k,2255) = -rxt(k,639)*y(k,149) - mat(k,971) = -rxt(k,645)*y(k,149) - mat(k,2316) = -rxt(k,651)*y(k,149) - mat(k,2169) = -rxt(k,659)*y(k,149) - mat(k,717) = -rxt(k,665)*y(k,149) - mat(k,2377) = -rxt(k,671)*y(k,149) - mat(k,2284) = -rxt(k,679)*y(k,149) - mat(k,2455) = -rxt(k,698)*y(k,149) - mat(k,2540) = -rxt(k,706)*y(k,149) - mat(k,1172) = -rxt(k,709)*y(k,149) - mat(k,2497) = -rxt(k,714)*y(k,149) - mat(k,2586) = -rxt(k,724)*y(k,149) - mat(k,1650) = -rxt(k,728)*y(k,149) - mat(k,2085) = -rxt(k,733)*y(k,149) - mat(k,2476) = -rxt(k,743)*y(k,149) - mat(k,2633) = -rxt(k,754)*y(k,149) - mat(k,2199) = -rxt(k,756)*y(k,149) - mat(k,2430) = -rxt(k,760)*y(k,149) - mat(k,2403) = -rxt(k,765)*y(k,149) - mat(k,241) = -rxt(k,794)*y(k,149) - mat(k,494) = rxt(k,264)*y(k,156) - mat(k,3825) = rxt(k,231)*y(k,61) - mat(k,1215) = rxt(k,231)*y(k,57) + rxt(k,233)*y(k,156) + rxt(k,234)*y(k,293) - mat(k,901) = rxt(k,278)*y(k,93) - mat(k,2719) = rxt(k,278)*y(k,75) + rxt(k,215)*y(k,293) - mat(k,395) = rxt(k,399)*y(k,293) - mat(k,3504) = mat(k,3504) + rxt(k,201)*y(k,156) + rxt(k,200)*y(k,157) - mat(k,3454) = mat(k,3454) + rxt(k,264)*y(k,21) + rxt(k,233)*y(k,61) & + *y(k,43) + rxt(k,332)*y(k,46) + rxt(k,353)*y(k,30) + rxt(k,360) & + *y(k,50) + rxt(k,374)*y(k,16) + rxt(k,393)*y(k,284) + rxt(k,473) & + *y(k,109) + rxt(k,478)*y(k,272) + rxt(k,584)*y(k,4) + rxt(k,590) & + *y(k,235) + rxt(k,598)*y(k,236) + rxt(k,604)*y(k,7) + rxt(k,610) & + *y(k,238) + rxt(k,618)*y(k,239) + rxt(k,624)*y(k,17) + rxt(k,630) & + *y(k,243) + rxt(k,638)*y(k,244) + rxt(k,644)*y(k,125) + rxt(k,650) & + *y(k,279) + rxt(k,658)*y(k,280) + rxt(k,664)*y(k,135) + rxt(k,670) & + *y(k,288) + rxt(k,678)*y(k,289) + rxt(k,697)*y(k,299) + rxt(k,705) & + *y(k,300) + rxt(k,708)*y(k,201) + rxt(k,713)*y(k,301) + rxt(k,723) & + *y(k,302) + rxt(k,727)*y(k,203) + rxt(k,732)*y(k,303) + rxt(k,742) & + *y(k,304) + rxt(k,753)*y(k,305) + rxt(k,755)*y(k,200) + rxt(k,759) & + *y(k,210) + rxt(k,764)*y(k,211) + rxt(k,793)*y(k,69)) + mat(k,3574) = -rxt(k,202)*y(k,149) + mat(k,3318) = -rxt(k,203)*y(k,149) + mat(k,3394) = -rxt(k,204)*y(k,149) + mat(k,3824) = -rxt(k,205)*y(k,149) + mat(k,4103) = -rxt(k,213)*y(k,149) + mat(k,3363) = -rxt(k,299)*y(k,149) + mat(k,1435) = -rxt(k,332)*y(k,149) + mat(k,1377) = -rxt(k,353)*y(k,149) + mat(k,1915) = -rxt(k,360)*y(k,149) + mat(k,380) = -rxt(k,374)*y(k,149) + mat(k,1628) = -rxt(k,393)*y(k,149) + mat(k,1408) = -rxt(k,473)*y(k,149) + mat(k,2193) = -rxt(k,478)*y(k,149) + mat(k,1262) = -rxt(k,584)*y(k,149) + mat(k,2311) = -rxt(k,590)*y(k,149) + mat(k,2481) = -rxt(k,598)*y(k,149) + mat(k,1040) = -rxt(k,604)*y(k,149) + mat(k,2227) = -rxt(k,610)*y(k,149) + mat(k,2338) = -rxt(k,618)*y(k,149) + mat(k,1103) = -rxt(k,624)*y(k,149) + mat(k,2544) = -rxt(k,630)*y(k,149) + mat(k,2427) = -rxt(k,638)*y(k,149) + mat(k,1082) = -rxt(k,644)*y(k,149) + mat(k,2515) = -rxt(k,650)*y(k,149) + mat(k,2397) = -rxt(k,658)*y(k,149) + mat(k,856) = -rxt(k,664)*y(k,149) + mat(k,2717) = -rxt(k,670)*y(k,149) + mat(k,2820) = -rxt(k,678)*y(k,149) + mat(k,2741) = -rxt(k,697)*y(k,149) + mat(k,2959) = -rxt(k,705)*y(k,149) + mat(k,1294) = -rxt(k,708)*y(k,149) + mat(k,2786) = -rxt(k,713)*y(k,149) + mat(k,2866) = -rxt(k,723)*y(k,149) + mat(k,1723) = -rxt(k,727)*y(k,149) + mat(k,2251) = -rxt(k,732)*y(k,149) + mat(k,2763) = -rxt(k,742)*y(k,149) + mat(k,2913) = -rxt(k,753)*y(k,149) + mat(k,2374) = -rxt(k,755)*y(k,149) + mat(k,2678) = -rxt(k,759)*y(k,149) + mat(k,2362) = -rxt(k,764)*y(k,149) + mat(k,325) = -rxt(k,793)*y(k,149) + mat(k,580) = rxt(k,264)*y(k,156) + mat(k,3865) = rxt(k,231)*y(k,61) + mat(k,1330) = rxt(k,231)*y(k,57) + rxt(k,233)*y(k,156) + rxt(k,234)*y(k,293) + mat(k,1284) = rxt(k,278)*y(k,93) + mat(k,3337) = rxt(k,278)*y(k,75) + rxt(k,215)*y(k,293) + mat(k,521) = rxt(k,398)*y(k,293) + mat(k,4103) = mat(k,4103) + rxt(k,201)*y(k,156) + rxt(k,200)*y(k,157) + mat(k,3394) = mat(k,3394) + rxt(k,264)*y(k,21) + rxt(k,233)*y(k,61) & + rxt(k,201)*y(k,148) - mat(k,2988) = rxt(k,200)*y(k,148) - mat(k,400) = rxt(k,350)*y(k,293) - mat(k,3744) = mat(k,3744) + rxt(k,234)*y(k,61) + rxt(k,215)*y(k,93) & - + rxt(k,399)*y(k,131) + rxt(k,350)*y(k,162) - mat(k,1270) = -(rxt(k,349)*y(k,293)) - mat(k,3672) = -rxt(k,349)*y(k,150) - mat(k,1950) = .830_r8*rxt(k,470)*y(k,157) - mat(k,1434) = .130_r8*rxt(k,485)*y(k,157) - mat(k,1982) = .220_r8*rxt(k,502)*y(k,157) + .100_r8*rxt(k,503)*y(k,293) - mat(k,2819) = .870_r8*rxt(k,520)*y(k,270) + .330_r8*rxt(k,522)*y(k,271) & - + .070_r8*rxt(k,526)*y(k,273) + .150_r8*rxt(k,528)*y(k,274) & - + .120_r8*rxt(k,540)*y(k,291) - mat(k,2929) = .830_r8*rxt(k,470)*y(k,118) + .130_r8*rxt(k,485)*y(k,121) & - + .220_r8*rxt(k,502)*y(k,139) - mat(k,3212) = .440_r8*rxt(k,468)*y(k,270) + .150_r8*rxt(k,472)*y(k,271) & - + .060_r8*rxt(k,480)*y(k,273) + .120_r8*rxt(k,483)*y(k,274) & - + .100_r8*rxt(k,500)*y(k,291) - mat(k,1011) = .870_r8*rxt(k,520)*y(k,147) + .440_r8*rxt(k,468)*y(k,256) - mat(k,1314) = .330_r8*rxt(k,522)*y(k,147) + .150_r8*rxt(k,472)*y(k,256) - mat(k,1181) = .070_r8*rxt(k,526)*y(k,147) + .060_r8*rxt(k,480)*y(k,256) - mat(k,1256) = .150_r8*rxt(k,528)*y(k,147) + .120_r8*rxt(k,483)*y(k,256) - mat(k,1476) = .120_r8*rxt(k,540)*y(k,147) + .100_r8*rxt(k,500)*y(k,256) - mat(k,3672) = mat(k,3672) + .100_r8*rxt(k,503)*y(k,139) - mat(k,1343) = -(rxt(k,365)*y(k,293)) - mat(k,3678) = -rxt(k,365)*y(k,151) - mat(k,1199) = rxt(k,354)*y(k,149) - mat(k,1085) = .350_r8*rxt(k,424)*y(k,293) - mat(k,1918) = .830_r8*rxt(k,460)*y(k,157) - mat(k,1436) = .700_r8*rxt(k,485)*y(k,157) - mat(k,1617) = .500_r8*rxt(k,381)*y(k,293) - mat(k,1798) = .500_r8*rxt(k,400)*y(k,293) - mat(k,1983) = .610_r8*rxt(k,502)*y(k,157) + .350_r8*rxt(k,503)*y(k,293) - mat(k,2824) = .940_r8*rxt(k,514)*y(k,267) + .340_r8*rxt(k,522)*y(k,271) & - + .400_r8*rxt(k,526)*y(k,273) + .810_r8*rxt(k,528)*y(k,274) & - + .130_r8*rxt(k,540)*y(k,291) - mat(k,3023) = rxt(k,354)*y(k,30) - mat(k,2932) = .830_r8*rxt(k,460)*y(k,115) + .700_r8*rxt(k,485)*y(k,121) & - + .610_r8*rxt(k,502)*y(k,139) - mat(k,3217) = .550_r8*rxt(k,458)*y(k,267) + .150_r8*rxt(k,472)*y(k,271) & - + .280_r8*rxt(k,480)*y(k,273) + .680_r8*rxt(k,483)*y(k,274) & - + .100_r8*rxt(k,500)*y(k,291) - mat(k,1001) = .940_r8*rxt(k,514)*y(k,147) + .550_r8*rxt(k,458)*y(k,256) - mat(k,1317) = .340_r8*rxt(k,522)*y(k,147) + .150_r8*rxt(k,472)*y(k,256) - mat(k,1183) = .400_r8*rxt(k,526)*y(k,147) + .280_r8*rxt(k,480)*y(k,256) - mat(k,1258) = .810_r8*rxt(k,528)*y(k,147) + .680_r8*rxt(k,483)*y(k,256) - mat(k,1478) = .130_r8*rxt(k,540)*y(k,147) + .100_r8*rxt(k,500)*y(k,256) - mat(k,3678) = mat(k,3678) + .350_r8*rxt(k,424)*y(k,108) + .500_r8*rxt(k,381) & - *y(k,127) + .500_r8*rxt(k,400)*y(k,133) + .350_r8*rxt(k,503) & + mat(k,3136) = rxt(k,200)*y(k,148) + mat(k,571) = rxt(k,349)*y(k,293) + mat(k,3824) = mat(k,3824) + rxt(k,234)*y(k,61) + rxt(k,215)*y(k,93) & + + rxt(k,398)*y(k,131) + rxt(k,349)*y(k,162) + mat(k,1452) = -(rxt(k,348)*y(k,293)) + mat(k,3743) = -rxt(k,348)*y(k,150) + mat(k,2062) = .830_r8*rxt(k,469)*y(k,157) + mat(k,1564) = .130_r8*rxt(k,484)*y(k,157) + mat(k,2126) = .220_r8*rxt(k,501)*y(k,157) + .100_r8*rxt(k,502)*y(k,293) + mat(k,3240) = .870_r8*rxt(k,519)*y(k,270) + .330_r8*rxt(k,521)*y(k,271) & + + .070_r8*rxt(k,525)*y(k,273) + .150_r8*rxt(k,527)*y(k,274) & + + .120_r8*rxt(k,539)*y(k,291) + mat(k,3067) = .830_r8*rxt(k,469)*y(k,118) + .130_r8*rxt(k,484)*y(k,121) & + + .220_r8*rxt(k,501)*y(k,139) + mat(k,3494) = .440_r8*rxt(k,467)*y(k,270) + .150_r8*rxt(k,471)*y(k,271) & + + .060_r8*rxt(k,479)*y(k,273) + .120_r8*rxt(k,482)*y(k,274) & + + .100_r8*rxt(k,499)*y(k,291) + mat(k,1131) = .870_r8*rxt(k,519)*y(k,147) + .440_r8*rxt(k,467)*y(k,256) + mat(k,1439) = .330_r8*rxt(k,521)*y(k,147) + .150_r8*rxt(k,471)*y(k,256) + mat(k,1308) = .070_r8*rxt(k,525)*y(k,147) + .060_r8*rxt(k,479)*y(k,256) + mat(k,1414) = .150_r8*rxt(k,527)*y(k,147) + .120_r8*rxt(k,482)*y(k,256) + mat(k,1633) = .120_r8*rxt(k,539)*y(k,147) + .100_r8*rxt(k,499)*y(k,256) + mat(k,3743) = mat(k,3743) + .100_r8*rxt(k,502)*y(k,139) + mat(k,1479) = -(rxt(k,364)*y(k,293)) + mat(k,3747) = -rxt(k,364)*y(k,151) + mat(k,1367) = rxt(k,353)*y(k,149) + mat(k,1265) = .350_r8*rxt(k,423)*y(k,293) + mat(k,2097) = .830_r8*rxt(k,459)*y(k,157) + mat(k,1567) = .700_r8*rxt(k,484)*y(k,157) + mat(k,1724) = .500_r8*rxt(k,380)*y(k,293) + mat(k,1924) = .500_r8*rxt(k,399)*y(k,293) + mat(k,2128) = .610_r8*rxt(k,501)*y(k,157) + .350_r8*rxt(k,502)*y(k,293) + mat(k,3244) = .940_r8*rxt(k,513)*y(k,267) + .340_r8*rxt(k,521)*y(k,271) & + + .400_r8*rxt(k,525)*y(k,273) + .810_r8*rxt(k,527)*y(k,274) & + + .130_r8*rxt(k,539)*y(k,291) + mat(k,3891) = rxt(k,353)*y(k,30) + mat(k,3069) = .830_r8*rxt(k,459)*y(k,115) + .700_r8*rxt(k,484)*y(k,121) & + + .610_r8*rxt(k,501)*y(k,139) + mat(k,3498) = .550_r8*rxt(k,457)*y(k,267) + .150_r8*rxt(k,471)*y(k,271) & + + .280_r8*rxt(k,479)*y(k,273) + .680_r8*rxt(k,482)*y(k,274) & + + .100_r8*rxt(k,499)*y(k,291) + mat(k,1121) = .940_r8*rxt(k,513)*y(k,147) + .550_r8*rxt(k,457)*y(k,256) + mat(k,1441) = .340_r8*rxt(k,521)*y(k,147) + .150_r8*rxt(k,471)*y(k,256) + mat(k,1310) = .400_r8*rxt(k,525)*y(k,147) + .280_r8*rxt(k,479)*y(k,256) + mat(k,1417) = .810_r8*rxt(k,527)*y(k,147) + .680_r8*rxt(k,482)*y(k,256) + mat(k,1636) = .130_r8*rxt(k,539)*y(k,147) + .100_r8*rxt(k,499)*y(k,256) + mat(k,3747) = mat(k,3747) + .350_r8*rxt(k,423)*y(k,108) + .500_r8*rxt(k,380) & + *y(k,127) + .500_r8*rxt(k,399)*y(k,133) + .350_r8*rxt(k,502) & *y(k,139) - mat(k,3460) = -(rxt(k,173)*y(k,157) + 4._r8*rxt(k,174)*y(k,156) + rxt(k,176) & + mat(k,3390) = -(rxt(k,173)*y(k,157) + 4._r8*rxt(k,174)*y(k,156) + rxt(k,176) & *y(k,79) + rxt(k,177)*y(k,81) + rxt(k,182)*y(k,256) + rxt(k,188) & *y(k,293) + (rxt(k,199) + rxt(k,201)) * y(k,148) + rxt(k,204) & *y(k,149) + rxt(k,209)*y(k,147) + rxt(k,233)*y(k,61) + rxt(k,235) & *y(k,60) + rxt(k,238)*y(k,87) + rxt(k,241)*y(k,96) + rxt(k,264) & *y(k,21) + rxt(k,265)*y(k,20) + rxt(k,267)*y(k,83) + rxt(k,269) & - *y(k,95) + rxt(k,300)*y(k,43) + rxt(k,796)*y(k,160)) - mat(k,2994) = -rxt(k,173)*y(k,156) - mat(k,1422) = -rxt(k,176)*y(k,156) - mat(k,1351) = -rxt(k,177)*y(k,156) - mat(k,3289) = -rxt(k,182)*y(k,156) - mat(k,3750) = -rxt(k,188)*y(k,156) - mat(k,3510) = -(rxt(k,199) + rxt(k,201)) * y(k,156) - mat(k,3086) = -rxt(k,204)*y(k,156) - mat(k,2893) = -rxt(k,209)*y(k,156) - mat(k,1217) = -rxt(k,233)*y(k,156) - mat(k,3315) = -rxt(k,235)*y(k,156) - mat(k,3772) = -rxt(k,238)*y(k,156) - mat(k,1066) = -rxt(k,241)*y(k,156) - mat(k,495) = -rxt(k,264)*y(k,156) - mat(k,3796) = -rxt(k,265)*y(k,156) - mat(k,1043) = -rxt(k,267)*y(k,156) - mat(k,908) = -rxt(k,269)*y(k,156) - mat(k,3339) = -rxt(k,300)*y(k,156) - mat(k,306) = -rxt(k,796)*y(k,156) - mat(k,2736) = rxt(k,180)*y(k,256) - mat(k,319) = rxt(k,194)*y(k,147) + rxt(k,195)*y(k,148) - mat(k,2893) = mat(k,2893) + rxt(k,194)*y(k,136) - mat(k,3510) = mat(k,3510) + rxt(k,195)*y(k,136) - mat(k,3289) = mat(k,3289) + rxt(k,180)*y(k,78) - mat(k,3750) = mat(k,3750) + 2.000_r8*rxt(k,190)*y(k,293) - mat(k,2987) = -(rxt(k,172)*y(k,292) + rxt(k,173)*y(k,156) + rxt(k,183) & + *y(k,95) + rxt(k,300)*y(k,43) + rxt(k,795)*y(k,160)) + mat(k,3132) = -rxt(k,173)*y(k,156) + mat(k,1677) = -rxt(k,176)*y(k,156) + mat(k,1487) = -rxt(k,177)*y(k,156) + mat(k,3570) = -rxt(k,182)*y(k,156) + mat(k,3820) = -rxt(k,188)*y(k,156) + mat(k,4099) = -(rxt(k,199) + rxt(k,201)) * y(k,156) + mat(k,3955) = -rxt(k,204)*y(k,156) + mat(k,3314) = -rxt(k,209)*y(k,156) + mat(k,1327) = -rxt(k,233)*y(k,156) + mat(k,2604) = -rxt(k,235)*y(k,156) + mat(k,3155) = -rxt(k,238)*y(k,156) + mat(k,1145) = -rxt(k,241)*y(k,156) + mat(k,579) = -rxt(k,264)*y(k,156) + mat(k,2564) = -rxt(k,265)*y(k,156) + mat(k,1161) = -rxt(k,267)*y(k,156) + mat(k,997) = -rxt(k,269)*y(k,156) + mat(k,3359) = -rxt(k,300)*y(k,156) + mat(k,388) = -rxt(k,795)*y(k,156) + mat(k,2579) = rxt(k,180)*y(k,256) + mat(k,478) = rxt(k,194)*y(k,147) + rxt(k,195)*y(k,148) + mat(k,3314) = mat(k,3314) + rxt(k,194)*y(k,136) + mat(k,4099) = mat(k,4099) + rxt(k,195)*y(k,136) + mat(k,3570) = mat(k,3570) + rxt(k,180)*y(k,78) + mat(k,3820) = mat(k,3820) + 2.000_r8*rxt(k,190)*y(k,293) + mat(k,3127) = -(rxt(k,172)*y(k,292) + rxt(k,173)*y(k,156) + rxt(k,183) & *y(k,256) + rxt(k,184)*y(k,78) + rxt(k,189)*y(k,293) + rxt(k,200) & *y(k,148) + rxt(k,208)*y(k,147) + rxt(k,224)*y(k,57) + rxt(k,256) & - *y(k,18) + rxt(k,324)*y(k,26) + rxt(k,355)*y(k,30) + rxt(k,386) & - *y(k,126) + rxt(k,404)*y(k,132) + rxt(k,460)*y(k,115) + rxt(k,470) & - *y(k,118) + rxt(k,485)*y(k,121) + rxt(k,487)*y(k,109) + rxt(k,502) & - *y(k,139) + rxt(k,569)*y(k,164) + rxt(k,603)*y(k,4) + rxt(k,623) & - *y(k,7) + rxt(k,643)*y(k,17) + rxt(k,663)*y(k,125) + rxt(k,683) & - *y(k,135) + rxt(k,763)*y(k,210) + rxt(k,768)*y(k,211) + rxt(k,799) & + *y(k,18) + rxt(k,323)*y(k,26) + rxt(k,354)*y(k,30) + rxt(k,385) & + *y(k,126) + rxt(k,403)*y(k,132) + rxt(k,459)*y(k,115) + rxt(k,469) & + *y(k,118) + rxt(k,484)*y(k,121) + rxt(k,486)*y(k,109) + rxt(k,501) & + *y(k,139) + rxt(k,568)*y(k,164) + rxt(k,602)*y(k,4) + rxt(k,622) & + *y(k,7) + rxt(k,642)*y(k,17) + rxt(k,662)*y(k,125) + rxt(k,682) & + *y(k,135) + rxt(k,762)*y(k,210) + rxt(k,767)*y(k,211) + rxt(k,799) & *y(k,171) + rxt(k,805)*y(k,173)) - mat(k,3103) = -rxt(k,172)*y(k,157) - mat(k,3453) = -rxt(k,173)*y(k,157) - mat(k,3282) = -rxt(k,183)*y(k,157) - mat(k,2731) = -rxt(k,184)*y(k,157) - mat(k,3743) = -rxt(k,189)*y(k,157) - mat(k,3503) = -rxt(k,200)*y(k,157) - mat(k,2886) = -rxt(k,208)*y(k,157) - mat(k,3824) = -rxt(k,224)*y(k,157) - mat(k,1687) = -rxt(k,256)*y(k,157) - mat(k,502) = -rxt(k,324)*y(k,157) - mat(k,1203) = -rxt(k,355)*y(k,157) - mat(k,1757) = -rxt(k,386)*y(k,157) - mat(k,1868) = -rxt(k,404)*y(k,157) - mat(k,1936) = -rxt(k,460)*y(k,157) - mat(k,1970) = -rxt(k,470)*y(k,157) - mat(k,1454) = -rxt(k,485)*y(k,157) - mat(k,1298) = -rxt(k,487)*y(k,157) - mat(k,1998) = -rxt(k,502)*y(k,157) - mat(k,407) = -rxt(k,569)*y(k,157) - mat(k,1113) = -rxt(k,603)*y(k,157) - mat(k,866) = -rxt(k,623)*y(k,157) - mat(k,950) = -rxt(k,643)*y(k,157) - mat(k,970) = -rxt(k,663)*y(k,157) - mat(k,716) = -rxt(k,683)*y(k,157) - mat(k,2429) = -rxt(k,763)*y(k,157) - mat(k,2402) = -rxt(k,768)*y(k,157) - mat(k,458) = -rxt(k,799)*y(k,157) - mat(k,1517) = -rxt(k,805)*y(k,157) - mat(k,2703) = .150_r8*rxt(k,338)*y(k,256) - mat(k,3282) = mat(k,3282) + .150_r8*rxt(k,338)*y(k,250) + .150_r8*rxt(k,391) & - *y(k,284) + .150_r8*rxt(k,704)*y(k,300) + .150_r8*rxt(k,722) & - *y(k,302) + .150_r8*rxt(k,752)*y(k,305) - mat(k,1502) = .150_r8*rxt(k,391)*y(k,256) - mat(k,2539) = .150_r8*rxt(k,704)*y(k,256) - mat(k,2585) = .150_r8*rxt(k,722)*y(k,256) - mat(k,2632) = .150_r8*rxt(k,752)*y(k,256) - mat(k,275) = -(rxt(k,806)*y(k,173)) - mat(k,1510) = -rxt(k,806)*y(k,159) - mat(k,3780) = rxt(k,258)*y(k,60) - mat(k,3299) = rxt(k,258)*y(k,20) + 2.000_r8*rxt(k,228)*y(k,60) - mat(k,300) = -(rxt(k,796)*y(k,156) + rxt(k,797)*y(k,293)) - mat(k,3437) = -rxt(k,796)*y(k,160) - mat(k,3568) = -rxt(k,797)*y(k,160) - mat(k,875) = rxt(k,380)*y(k,293) - mat(k,1796) = .500_r8*rxt(k,400)*y(k,293) - mat(k,3542) = rxt(k,380)*y(k,97) + .500_r8*rxt(k,400)*y(k,133) - mat(k,398) = -(rxt(k,350)*y(k,293)) - mat(k,3583) = -rxt(k,350)*y(k,162) - mat(k,3473) = rxt(k,352)*y(k,250) - mat(k,2643) = rxt(k,352)*y(k,148) + mat(k,2640) = -rxt(k,172)*y(k,157) + mat(k,3385) = -rxt(k,173)*y(k,157) + mat(k,3565) = -rxt(k,183)*y(k,157) + mat(k,2575) = -rxt(k,184)*y(k,157) + mat(k,3815) = -rxt(k,189)*y(k,157) + mat(k,4094) = -rxt(k,200)*y(k,157) + mat(k,3309) = -rxt(k,208)*y(k,157) + mat(k,3856) = -rxt(k,224)*y(k,157) + mat(k,2203) = -rxt(k,256)*y(k,157) + mat(k,594) = -rxt(k,323)*y(k,157) + mat(k,1372) = -rxt(k,354)*y(k,157) + mat(k,2025) = -rxt(k,385)*y(k,157) + mat(k,2050) = -rxt(k,403)*y(k,157) + mat(k,2113) = -rxt(k,459)*y(k,157) + mat(k,2081) = -rxt(k,469)*y(k,157) + mat(k,1584) = -rxt(k,484)*y(k,157) + mat(k,1404) = -rxt(k,486)*y(k,157) + mat(k,2142) = -rxt(k,501)*y(k,157) + mat(k,507) = -rxt(k,568)*y(k,157) + mat(k,1258) = -rxt(k,602)*y(k,157) + mat(k,1036) = -rxt(k,622)*y(k,157) + mat(k,1100) = -rxt(k,642)*y(k,157) + mat(k,1079) = -rxt(k,662)*y(k,157) + mat(k,852) = -rxt(k,682)*y(k,157) + mat(k,2669) = -rxt(k,762)*y(k,157) + mat(k,2353) = -rxt(k,767)*y(k,157) + mat(k,543) = -rxt(k,799)*y(k,157) + mat(k,1603) = -rxt(k,805)*y(k,157) + mat(k,3024) = .150_r8*rxt(k,337)*y(k,256) + mat(k,3565) = mat(k,3565) + .150_r8*rxt(k,337)*y(k,250) + .150_r8*rxt(k,390) & + *y(k,284) + .150_r8*rxt(k,703)*y(k,300) + .150_r8*rxt(k,721) & + *y(k,302) + .150_r8*rxt(k,751)*y(k,305) + mat(k,1622) = .150_r8*rxt(k,390)*y(k,256) + mat(k,2950) = .150_r8*rxt(k,703)*y(k,256) + mat(k,2857) = .150_r8*rxt(k,721)*y(k,256) + mat(k,2904) = .150_r8*rxt(k,751)*y(k,256) + mat(k,339) = -(rxt(k,806)*y(k,173)) + mat(k,1595) = -rxt(k,806)*y(k,159) + mat(k,2549) = rxt(k,258)*y(k,60) + mat(k,2589) = rxt(k,258)*y(k,20) + 2.000_r8*rxt(k,228)*y(k,60) + mat(k,382) = -(rxt(k,795)*y(k,156) + rxt(k,796)*y(k,293)) + mat(k,3367) = -rxt(k,795)*y(k,160) + mat(k,3634) = -rxt(k,796)*y(k,160) + mat(k,971) = rxt(k,379)*y(k,293) + mat(k,1922) = .500_r8*rxt(k,399)*y(k,293) + mat(k,3604) = rxt(k,379)*y(k,97) + .500_r8*rxt(k,399)*y(k,133) + mat(k,566) = -(rxt(k,349)*y(k,293)) + mat(k,3661) = -rxt(k,349)*y(k,162) + mat(k,4064) = rxt(k,351)*y(k,250) + mat(k,2963) = rxt(k,351)*y(k,148) end do end subroutine nlnmat08 subroutine nlnmat09( avec_len, mat, y, rxt ) @@ -2024,217 +2285,223 @@ subroutine nlnmat09( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,3467) = rxt(k,571)*y(k,233) - mat(k,461) = rxt(k,571)*y(k,148) - mat(k,405) = -(rxt(k,568)*y(k,148) + rxt(k,569)*y(k,157)) - mat(k,3474) = -rxt(k,568)*y(k,164) - mat(k,2906) = -rxt(k,569)*y(k,164) - mat(k,170) = .070_r8*rxt(k,555)*y(k,293) - mat(k,2767) = rxt(k,553)*y(k,249) - mat(k,143) = .060_r8*rxt(k,567)*y(k,293) - mat(k,188) = .070_r8*rxt(k,583)*y(k,293) - mat(k,603) = rxt(k,553)*y(k,147) - mat(k,3584) = .070_r8*rxt(k,555)*y(k,67) + .060_r8*rxt(k,567)*y(k,165) & - + .070_r8*rxt(k,583)*y(k,229) - mat(k,141) = -(rxt(k,567)*y(k,293)) - mat(k,3540) = -rxt(k,567)*y(k,165) - mat(k,133) = .530_r8*rxt(k,544)*y(k,293) - mat(k,3540) = mat(k,3540) + .530_r8*rxt(k,544)*y(k,8) - mat(k,280) = -(rxt(k,570)*y(k,293)) - mat(k,3564) = -rxt(k,570)*y(k,166) - mat(k,3139) = rxt(k,565)*y(k,294) - mat(k,376) = rxt(k,565)*y(k,256) - mat(k,482) = -(rxt(k,368)*y(k,293)) - mat(k,3595) = -rxt(k,368)*y(k,169) - mat(k,3158) = rxt(k,366)*y(k,295) - mat(k,821) = rxt(k,366)*y(k,256) - mat(k,332) = -(rxt(k,372)*y(k,293)) - mat(k,3572) = -rxt(k,372)*y(k,170) - mat(k,3144) = .850_r8*rxt(k,370)*y(k,296) - mat(k,1223) = .850_r8*rxt(k,370)*y(k,256) - mat(k,455) = -(rxt(k,799)*y(k,157) + rxt(k,802)*y(k,293)) - mat(k,2907) = -rxt(k,799)*y(k,171) - mat(k,3591) = -rxt(k,802)*y(k,171) - mat(k,1513) = -(rxt(k,800)*y(k,20) + rxt(k,801)*y(k,60) + rxt(k,803)*y(k,148) & + mat(k,4055) = rxt(k,570)*y(k,233) + mat(k,546) = rxt(k,570)*y(k,148) + mat(k,505) = -(rxt(k,567)*y(k,148) + rxt(k,568)*y(k,157)) + mat(k,4061) = -rxt(k,567)*y(k,164) + mat(k,3043) = -rxt(k,568)*y(k,164) + mat(k,218) = .070_r8*rxt(k,554)*y(k,293) + mat(k,3188) = rxt(k,552)*y(k,249) + mat(k,192) = .060_r8*rxt(k,566)*y(k,293) + mat(k,236) = .070_r8*rxt(k,582)*y(k,293) + mat(k,708) = rxt(k,552)*y(k,147) + mat(k,3652) = .070_r8*rxt(k,554)*y(k,67) + .060_r8*rxt(k,566)*y(k,165) & + + .070_r8*rxt(k,582)*y(k,229) + mat(k,190) = -(rxt(k,566)*y(k,293)) + mat(k,3601) = -rxt(k,566)*y(k,165) + mat(k,182) = .530_r8*rxt(k,543)*y(k,293) + mat(k,3601) = mat(k,3601) + .530_r8*rxt(k,543)*y(k,8) + mat(k,344) = -(rxt(k,569)*y(k,293)) + mat(k,3627) = -rxt(k,569)*y(k,166) + mat(k,3418) = rxt(k,564)*y(k,294) + mat(k,452) = rxt(k,564)*y(k,256) + mat(k,582) = -(rxt(k,367)*y(k,293)) + mat(k,3662) = -rxt(k,367)*y(k,169) + mat(k,3438) = rxt(k,365)*y(k,295) + mat(k,931) = rxt(k,365)*y(k,256) + mat(k,402) = -(rxt(k,371)*y(k,293)) + mat(k,3636) = -rxt(k,371)*y(k,170) + mat(k,3424) = .850_r8*rxt(k,369)*y(k,296) + mat(k,1333) = .850_r8*rxt(k,369)*y(k,256) + mat(k,540) = -(rxt(k,799)*y(k,157) + rxt(k,802)*y(k,293)) + mat(k,3044) = -rxt(k,799)*y(k,171) + mat(k,3657) = -rxt(k,802)*y(k,171) + mat(k,1598) = -(rxt(k,800)*y(k,20) + rxt(k,801)*y(k,60) + rxt(k,803)*y(k,148) & + rxt(k,805)*y(k,157) + rxt(k,806)*y(k,159) + rxt(k,807) & *y(k,293)) - mat(k,3784) = -rxt(k,800)*y(k,173) - mat(k,3303) = -rxt(k,801)*y(k,173) - mat(k,3489) = -rxt(k,803)*y(k,173) - mat(k,2938) = -rxt(k,805)*y(k,173) - mat(k,277) = -rxt(k,806)*y(k,173) - mat(k,3692) = -rxt(k,807)*y(k,173) - mat(k,3447) = rxt(k,796)*y(k,160) - mat(k,2938) = mat(k,2938) + rxt(k,799)*y(k,171) - mat(k,303) = rxt(k,796)*y(k,156) - mat(k,456) = rxt(k,799)*y(k,157) + rxt(k,802)*y(k,293) - mat(k,3692) = mat(k,3692) + rxt(k,802)*y(k,171) - mat(k,1161) = -(rxt(k,809)*y(k,293)) - mat(k,3662) = -rxt(k,809)*y(k,174) - mat(k,3783) = rxt(k,800)*y(k,173) - mat(k,3301) = rxt(k,801)*y(k,173) - mat(k,239) = rxt(k,794)*y(k,149) + (rxt(k,795)+.500_r8*rxt(k,808))*y(k,293) - mat(k,3484) = rxt(k,803)*y(k,173) - mat(k,3017) = rxt(k,794)*y(k,69) - mat(k,2924) = rxt(k,805)*y(k,173) - mat(k,276) = rxt(k,806)*y(k,173) - mat(k,302) = rxt(k,797)*y(k,293) - mat(k,1512) = rxt(k,800)*y(k,20) + rxt(k,801)*y(k,60) + rxt(k,803)*y(k,148) & + mat(k,2553) = -rxt(k,800)*y(k,173) + mat(k,2593) = -rxt(k,801)*y(k,173) + mat(k,4077) = -rxt(k,803)*y(k,173) + mat(k,3073) = -rxt(k,805)*y(k,173) + mat(k,341) = -rxt(k,806)*y(k,173) + mat(k,3757) = -rxt(k,807)*y(k,173) + mat(k,3376) = rxt(k,795)*y(k,160) + mat(k,3073) = mat(k,3073) + rxt(k,799)*y(k,171) + mat(k,385) = rxt(k,795)*y(k,156) + mat(k,541) = rxt(k,799)*y(k,157) + rxt(k,802)*y(k,293) + mat(k,3757) = mat(k,3757) + rxt(k,802)*y(k,171) + mat(k,1233) = -(rxt(k,798)*y(k,293)) + mat(k,3727) = -rxt(k,798)*y(k,174) + mat(k,2552) = rxt(k,800)*y(k,173) + mat(k,2591) = rxt(k,801)*y(k,173) + mat(k,321) = rxt(k,793)*y(k,149) + (rxt(k,794)+.500_r8*rxt(k,808))*y(k,293) + mat(k,4073) = rxt(k,803)*y(k,173) + mat(k,3883) = rxt(k,793)*y(k,69) + mat(k,3059) = rxt(k,805)*y(k,173) + mat(k,340) = rxt(k,806)*y(k,173) + mat(k,384) = rxt(k,796)*y(k,293) + mat(k,1597) = rxt(k,800)*y(k,20) + rxt(k,801)*y(k,60) + rxt(k,803)*y(k,148) & + rxt(k,805)*y(k,157) + rxt(k,806)*y(k,159) + rxt(k,807) & *y(k,293) - mat(k,3662) = mat(k,3662) + (rxt(k,795)+.500_r8*rxt(k,808))*y(k,69) & - + rxt(k,797)*y(k,160) + rxt(k,807)*y(k,173) - mat(k,214) = -(rxt(k,810)*y(k,317)) - mat(k,3840) = -rxt(k,810)*y(k,175) - mat(k,1160) = rxt(k,809)*y(k,293) - mat(k,3555) = rxt(k,809)*y(k,174) - mat(k,1095) = .0508005_r8*rxt(k,845)*y(k,157) - mat(k,852) = .2202005_r8*rxt(k,850)*y(k,157) - mat(k,934) = .0508005_r8*rxt(k,858)*y(k,157) - mat(k,954) = .0508005_r8*rxt(k,871)*y(k,157) - mat(k,704) = .0508005_r8*rxt(k,876)*y(k,157) - mat(k,2742) = .0245005_r8*rxt(k,844)*y(k,237) + .1279005_r8*rxt(k,849) & - *y(k,240) + .0097005_r8*rxt(k,854)*y(k,242) & - + .0245005_r8*rxt(k,857)*y(k,245) + .0003005_r8*rxt(k,862) & - *y(k,275) + .1056005_r8*rxt(k,866)*y(k,278) & - + .0245005_r8*rxt(k,870)*y(k,281) + .0245005_r8*rxt(k,875) & - *y(k,290) + .0154005_r8*rxt(k,881)*y(k,313) & - + .0063005_r8*rxt(k,884)*y(k,315) - mat(k,2900) = .0508005_r8*rxt(k,845)*y(k,4) + .2202005_r8*rxt(k,850)*y(k,7) & - + .0508005_r8*rxt(k,858)*y(k,17) + .0508005_r8*rxt(k,871) & - *y(k,125) + .0508005_r8*rxt(k,876)*y(k,135) - mat(k,35) = .5931005_r8*rxt(k,878)*y(k,293) - mat(k,41) = .0245005_r8*rxt(k,844)*y(k,147) + .0508005_r8*rxt(k,843)*y(k,256) - mat(k,47) = .1279005_r8*rxt(k,849)*y(k,147) + .2202005_r8*rxt(k,848)*y(k,256) - mat(k,53) = .0097005_r8*rxt(k,854)*y(k,147) + .0023005_r8*rxt(k,853)*y(k,256) - mat(k,59) = .0245005_r8*rxt(k,857)*y(k,147) + .0508005_r8*rxt(k,856)*y(k,256) - mat(k,3117) = .0508005_r8*rxt(k,843)*y(k,237) + .2202005_r8*rxt(k,848) & - *y(k,240) + .0023005_r8*rxt(k,853)*y(k,242) & - + .0508005_r8*rxt(k,856)*y(k,245) + .0031005_r8*rxt(k,861) & - *y(k,275) + .2381005_r8*rxt(k,865)*y(k,278) & - + .0508005_r8*rxt(k,869)*y(k,281) + .0508005_r8*rxt(k,874) & - *y(k,290) + .1364005_r8*rxt(k,880)*y(k,313) & - + .1677005_r8*rxt(k,883)*y(k,315) - mat(k,65) = .0003005_r8*rxt(k,862)*y(k,147) + .0031005_r8*rxt(k,861)*y(k,256) - mat(k,71) = .1056005_r8*rxt(k,866)*y(k,147) + .2381005_r8*rxt(k,865)*y(k,256) - mat(k,79) = .0245005_r8*rxt(k,870)*y(k,147) + .0508005_r8*rxt(k,869)*y(k,256) - mat(k,85) = .0245005_r8*rxt(k,875)*y(k,147) + .0508005_r8*rxt(k,874)*y(k,256) - mat(k,3517) = .5931005_r8*rxt(k,878)*y(k,196) - mat(k,91) = .0154005_r8*rxt(k,881)*y(k,147) + .1364005_r8*rxt(k,880)*y(k,256) - mat(k,97) = .0063005_r8*rxt(k,884)*y(k,147) + .1677005_r8*rxt(k,883)*y(k,256) - mat(k,1096) = .1149005_r8*rxt(k,845)*y(k,157) - mat(k,853) = .2067005_r8*rxt(k,850)*y(k,157) - mat(k,935) = .1149005_r8*rxt(k,858)*y(k,157) - mat(k,955) = .1149005_r8*rxt(k,871)*y(k,157) - mat(k,705) = .1149005_r8*rxt(k,876)*y(k,157) - mat(k,2743) = .0082005_r8*rxt(k,844)*y(k,237) + .1792005_r8*rxt(k,849) & - *y(k,240) + .0034005_r8*rxt(k,854)*y(k,242) & - + .0082005_r8*rxt(k,857)*y(k,245) + .0003005_r8*rxt(k,862) & - *y(k,275) + .1026005_r8*rxt(k,866)*y(k,278) & - + .0082005_r8*rxt(k,870)*y(k,281) + .0082005_r8*rxt(k,875) & - *y(k,290) + .0452005_r8*rxt(k,881)*y(k,313) & - + .0237005_r8*rxt(k,884)*y(k,315) - mat(k,2901) = .1149005_r8*rxt(k,845)*y(k,4) + .2067005_r8*rxt(k,850)*y(k,7) & - + .1149005_r8*rxt(k,858)*y(k,17) + .1149005_r8*rxt(k,871) & - *y(k,125) + .1149005_r8*rxt(k,876)*y(k,135) - mat(k,36) = .1534005_r8*rxt(k,878)*y(k,293) - mat(k,42) = .0082005_r8*rxt(k,844)*y(k,147) + .1149005_r8*rxt(k,843)*y(k,256) - mat(k,48) = .1792005_r8*rxt(k,849)*y(k,147) + .2067005_r8*rxt(k,848)*y(k,256) - mat(k,54) = .0034005_r8*rxt(k,854)*y(k,147) + .0008005_r8*rxt(k,853)*y(k,256) - mat(k,60) = .0082005_r8*rxt(k,857)*y(k,147) + .1149005_r8*rxt(k,856)*y(k,256) - mat(k,3118) = .1149005_r8*rxt(k,843)*y(k,237) + .2067005_r8*rxt(k,848) & - *y(k,240) + .0008005_r8*rxt(k,853)*y(k,242) & - + .1149005_r8*rxt(k,856)*y(k,245) + .0035005_r8*rxt(k,861) & - *y(k,275) + .1308005_r8*rxt(k,865)*y(k,278) & - + .1149005_r8*rxt(k,869)*y(k,281) + .1149005_r8*rxt(k,874) & - *y(k,290) + .0101005_r8*rxt(k,880)*y(k,313) & - + .0174005_r8*rxt(k,883)*y(k,315) - mat(k,66) = .0003005_r8*rxt(k,862)*y(k,147) + .0035005_r8*rxt(k,861)*y(k,256) - mat(k,72) = .1026005_r8*rxt(k,866)*y(k,147) + .1308005_r8*rxt(k,865)*y(k,256) - mat(k,80) = .0082005_r8*rxt(k,870)*y(k,147) + .1149005_r8*rxt(k,869)*y(k,256) - mat(k,86) = .0082005_r8*rxt(k,875)*y(k,147) + .1149005_r8*rxt(k,874)*y(k,256) - mat(k,3518) = .1534005_r8*rxt(k,878)*y(k,196) - mat(k,92) = .0452005_r8*rxt(k,881)*y(k,147) + .0101005_r8*rxt(k,880)*y(k,256) - mat(k,98) = .0237005_r8*rxt(k,884)*y(k,147) + .0174005_r8*rxt(k,883)*y(k,256) - mat(k,1097) = .0348005_r8*rxt(k,845)*y(k,157) - mat(k,854) = .0653005_r8*rxt(k,850)*y(k,157) - mat(k,936) = .0348005_r8*rxt(k,858)*y(k,157) - mat(k,956) = .0348005_r8*rxt(k,871)*y(k,157) - mat(k,706) = .0348005_r8*rxt(k,876)*y(k,157) - mat(k,2744) = .0772005_r8*rxt(k,844)*y(k,237) + .0676005_r8*rxt(k,849) & - *y(k,240) + .1579005_r8*rxt(k,854)*y(k,242) & - + .0772005_r8*rxt(k,857)*y(k,245) + .0073005_r8*rxt(k,862) & - *y(k,275) + .0521005_r8*rxt(k,866)*y(k,278) & - + .0772005_r8*rxt(k,870)*y(k,281) + .0772005_r8*rxt(k,875) & - *y(k,290) + .0966005_r8*rxt(k,881)*y(k,313) & - + .0025005_r8*rxt(k,884)*y(k,315) - mat(k,2902) = .0348005_r8*rxt(k,845)*y(k,4) + .0653005_r8*rxt(k,850)*y(k,7) & - + .0348005_r8*rxt(k,858)*y(k,17) + .0348005_r8*rxt(k,871) & - *y(k,125) + .0348005_r8*rxt(k,876)*y(k,135) - mat(k,37) = .0459005_r8*rxt(k,878)*y(k,293) - mat(k,43) = .0772005_r8*rxt(k,844)*y(k,147) + .0348005_r8*rxt(k,843)*y(k,256) - mat(k,49) = .0676005_r8*rxt(k,849)*y(k,147) + .0653005_r8*rxt(k,848)*y(k,256) - mat(k,55) = .1579005_r8*rxt(k,854)*y(k,147) + .0843005_r8*rxt(k,853)*y(k,256) - mat(k,61) = .0772005_r8*rxt(k,857)*y(k,147) + .0348005_r8*rxt(k,856)*y(k,256) - mat(k,3119) = .0348005_r8*rxt(k,843)*y(k,237) + .0653005_r8*rxt(k,848) & - *y(k,240) + .0843005_r8*rxt(k,853)*y(k,242) & - + .0348005_r8*rxt(k,856)*y(k,245) + .0003005_r8*rxt(k,861) & - *y(k,275) + .0348005_r8*rxt(k,865)*y(k,278) & - + .0348005_r8*rxt(k,869)*y(k,281) + .0348005_r8*rxt(k,874) & - *y(k,290) + .0763005_r8*rxt(k,880)*y(k,313) + .086_r8*rxt(k,883) & + mat(k,3727) = mat(k,3727) + (rxt(k,794)+.500_r8*rxt(k,808))*y(k,69) & + + rxt(k,796)*y(k,160) + rxt(k,807)*y(k,173) + mat(k,276) = -(rxt(k,809)*y(k,317)) + mat(k,4108) = -rxt(k,809)*y(k,175) + mat(k,1232) = rxt(k,798)*y(k,293) + mat(k,3619) = rxt(k,798)*y(k,174) + mat(k,1239) = .0508005_r8*rxt(k,844)*y(k,157) + mat(k,1021) = .2202005_r8*rxt(k,849)*y(k,157) + mat(k,1083) = .0508005_r8*rxt(k,857)*y(k,157) + mat(k,1062) = .0508005_r8*rxt(k,870)*y(k,157) + mat(k,840) = .0508005_r8*rxt(k,875)*y(k,157) + mat(k,3163) = .0245005_r8*rxt(k,843)*y(k,237) + .1279005_r8*rxt(k,848) & + *y(k,240) + .0097005_r8*rxt(k,853)*y(k,242) & + + .0245005_r8*rxt(k,856)*y(k,245) + .0003005_r8*rxt(k,861) & + *y(k,275) + .1056005_r8*rxt(k,865)*y(k,278) & + + .0245005_r8*rxt(k,869)*y(k,281) + .0245005_r8*rxt(k,874) & + *y(k,290) + .0154005_r8*rxt(k,880)*y(k,313) & + + .0063005_r8*rxt(k,883)*y(k,315) + mat(k,3037) = .0508005_r8*rxt(k,844)*y(k,4) + .2202005_r8*rxt(k,849)*y(k,7) & + + .0508005_r8*rxt(k,857)*y(k,17) + .0508005_r8*rxt(k,870) & + *y(k,125) + .0508005_r8*rxt(k,875)*y(k,135) + mat(k,44) = .5931005_r8*rxt(k,877)*y(k,293) + mat(k,50) = .0245005_r8*rxt(k,843)*y(k,147) + .0508005_r8*rxt(k,842)*y(k,256) + mat(k,56) = .1279005_r8*rxt(k,848)*y(k,147) + .2202005_r8*rxt(k,847)*y(k,256) + mat(k,62) = .0097005_r8*rxt(k,853)*y(k,147) + .0023005_r8*rxt(k,852)*y(k,256) + mat(k,68) = .0245005_r8*rxt(k,856)*y(k,147) + .0508005_r8*rxt(k,855)*y(k,256) + mat(k,3398) = .0508005_r8*rxt(k,842)*y(k,237) + .2202005_r8*rxt(k,847) & + *y(k,240) + .0023005_r8*rxt(k,852)*y(k,242) & + + .0508005_r8*rxt(k,855)*y(k,245) + .0031005_r8*rxt(k,860) & + *y(k,275) + .2381005_r8*rxt(k,864)*y(k,278) & + + .0508005_r8*rxt(k,868)*y(k,281) + .0508005_r8*rxt(k,873) & + *y(k,290) + .1364005_r8*rxt(k,879)*y(k,313) & + + .1677005_r8*rxt(k,882)*y(k,315) + mat(k,74) = .0003005_r8*rxt(k,861)*y(k,147) + .0031005_r8*rxt(k,860)*y(k,256) + mat(k,80) = .1056005_r8*rxt(k,865)*y(k,147) + .2381005_r8*rxt(k,864)*y(k,256) + mat(k,88) = .0245005_r8*rxt(k,869)*y(k,147) + .0508005_r8*rxt(k,868)*y(k,256) + mat(k,94) = .0245005_r8*rxt(k,874)*y(k,147) + .0508005_r8*rxt(k,873)*y(k,256) + mat(k,3578) = .5931005_r8*rxt(k,877)*y(k,196) + mat(k,100) = .0154005_r8*rxt(k,880)*y(k,147) + .1364005_r8*rxt(k,879) & + *y(k,256) + mat(k,106) = .0063005_r8*rxt(k,883)*y(k,147) + .1677005_r8*rxt(k,882) & + *y(k,256) + mat(k,1240) = .1149005_r8*rxt(k,844)*y(k,157) + mat(k,1022) = .2067005_r8*rxt(k,849)*y(k,157) + mat(k,1084) = .1149005_r8*rxt(k,857)*y(k,157) + mat(k,1063) = .1149005_r8*rxt(k,870)*y(k,157) + mat(k,841) = .1149005_r8*rxt(k,875)*y(k,157) + mat(k,3164) = .0082005_r8*rxt(k,843)*y(k,237) + .1792005_r8*rxt(k,848) & + *y(k,240) + .0034005_r8*rxt(k,853)*y(k,242) & + + .0082005_r8*rxt(k,856)*y(k,245) + .0003005_r8*rxt(k,861) & + *y(k,275) + .1026005_r8*rxt(k,865)*y(k,278) & + + .0082005_r8*rxt(k,869)*y(k,281) + .0082005_r8*rxt(k,874) & + *y(k,290) + .0452005_r8*rxt(k,880)*y(k,313) & + + .0237005_r8*rxt(k,883)*y(k,315) + mat(k,3038) = .1149005_r8*rxt(k,844)*y(k,4) + .2067005_r8*rxt(k,849)*y(k,7) & + + .1149005_r8*rxt(k,857)*y(k,17) + .1149005_r8*rxt(k,870) & + *y(k,125) + .1149005_r8*rxt(k,875)*y(k,135) + mat(k,45) = .1534005_r8*rxt(k,877)*y(k,293) + mat(k,51) = .0082005_r8*rxt(k,843)*y(k,147) + .1149005_r8*rxt(k,842)*y(k,256) + mat(k,57) = .1792005_r8*rxt(k,848)*y(k,147) + .2067005_r8*rxt(k,847)*y(k,256) + mat(k,63) = .0034005_r8*rxt(k,853)*y(k,147) + .0008005_r8*rxt(k,852)*y(k,256) + mat(k,69) = .0082005_r8*rxt(k,856)*y(k,147) + .1149005_r8*rxt(k,855)*y(k,256) + mat(k,3399) = .1149005_r8*rxt(k,842)*y(k,237) + .2067005_r8*rxt(k,847) & + *y(k,240) + .0008005_r8*rxt(k,852)*y(k,242) & + + .1149005_r8*rxt(k,855)*y(k,245) + .0035005_r8*rxt(k,860) & + *y(k,275) + .1308005_r8*rxt(k,864)*y(k,278) & + + .1149005_r8*rxt(k,868)*y(k,281) + .1149005_r8*rxt(k,873) & + *y(k,290) + .0101005_r8*rxt(k,879)*y(k,313) & + + .0174005_r8*rxt(k,882)*y(k,315) + mat(k,75) = .0003005_r8*rxt(k,861)*y(k,147) + .0035005_r8*rxt(k,860)*y(k,256) + mat(k,81) = .1026005_r8*rxt(k,865)*y(k,147) + .1308005_r8*rxt(k,864)*y(k,256) + mat(k,89) = .0082005_r8*rxt(k,869)*y(k,147) + .1149005_r8*rxt(k,868)*y(k,256) + mat(k,95) = .0082005_r8*rxt(k,874)*y(k,147) + .1149005_r8*rxt(k,873)*y(k,256) + mat(k,3579) = .1534005_r8*rxt(k,877)*y(k,196) + mat(k,101) = .0452005_r8*rxt(k,880)*y(k,147) + .0101005_r8*rxt(k,879) & + *y(k,256) + mat(k,107) = .0237005_r8*rxt(k,883)*y(k,147) + .0174005_r8*rxt(k,882) & + *y(k,256) + mat(k,1241) = .0348005_r8*rxt(k,844)*y(k,157) + mat(k,1023) = .0653005_r8*rxt(k,849)*y(k,157) + mat(k,1085) = .0348005_r8*rxt(k,857)*y(k,157) + mat(k,1064) = .0348005_r8*rxt(k,870)*y(k,157) + mat(k,842) = .0348005_r8*rxt(k,875)*y(k,157) + mat(k,3165) = .0772005_r8*rxt(k,843)*y(k,237) + .0676005_r8*rxt(k,848) & + *y(k,240) + .1579005_r8*rxt(k,853)*y(k,242) & + + .0772005_r8*rxt(k,856)*y(k,245) + .0073005_r8*rxt(k,861) & + *y(k,275) + .0521005_r8*rxt(k,865)*y(k,278) & + + .0772005_r8*rxt(k,869)*y(k,281) + .0772005_r8*rxt(k,874) & + *y(k,290) + .0966005_r8*rxt(k,880)*y(k,313) & + + .0025005_r8*rxt(k,883)*y(k,315) + mat(k,3039) = .0348005_r8*rxt(k,844)*y(k,4) + .0653005_r8*rxt(k,849)*y(k,7) & + + .0348005_r8*rxt(k,857)*y(k,17) + .0348005_r8*rxt(k,870) & + *y(k,125) + .0348005_r8*rxt(k,875)*y(k,135) + mat(k,46) = .0459005_r8*rxt(k,877)*y(k,293) + mat(k,52) = .0772005_r8*rxt(k,843)*y(k,147) + .0348005_r8*rxt(k,842)*y(k,256) + mat(k,58) = .0676005_r8*rxt(k,848)*y(k,147) + .0653005_r8*rxt(k,847)*y(k,256) + mat(k,64) = .1579005_r8*rxt(k,853)*y(k,147) + .0843005_r8*rxt(k,852)*y(k,256) + mat(k,70) = .0772005_r8*rxt(k,856)*y(k,147) + .0348005_r8*rxt(k,855)*y(k,256) + mat(k,3400) = .0348005_r8*rxt(k,842)*y(k,237) + .0653005_r8*rxt(k,847) & + *y(k,240) + .0843005_r8*rxt(k,852)*y(k,242) & + + .0348005_r8*rxt(k,855)*y(k,245) + .0003005_r8*rxt(k,860) & + *y(k,275) + .0348005_r8*rxt(k,864)*y(k,278) & + + .0348005_r8*rxt(k,868)*y(k,281) + .0348005_r8*rxt(k,873) & + *y(k,290) + .0763005_r8*rxt(k,879)*y(k,313) + .086_r8*rxt(k,882) & *y(k,315) - mat(k,67) = .0073005_r8*rxt(k,862)*y(k,147) + .0003005_r8*rxt(k,861)*y(k,256) - mat(k,73) = .0521005_r8*rxt(k,866)*y(k,147) + .0348005_r8*rxt(k,865)*y(k,256) - mat(k,81) = .0772005_r8*rxt(k,870)*y(k,147) + .0348005_r8*rxt(k,869)*y(k,256) - mat(k,87) = .0772005_r8*rxt(k,875)*y(k,147) + .0348005_r8*rxt(k,874)*y(k,256) - mat(k,3519) = .0459005_r8*rxt(k,878)*y(k,196) - mat(k,93) = .0966005_r8*rxt(k,881)*y(k,147) + .0763005_r8*rxt(k,880)*y(k,256) - mat(k,99) = .0025005_r8*rxt(k,884)*y(k,147) + .086_r8*rxt(k,883)*y(k,256) - mat(k,1098) = .1749305_r8*rxt(k,842)*y(k,149) + .0554005_r8*rxt(k,845) & + mat(k,76) = .0073005_r8*rxt(k,861)*y(k,147) + .0003005_r8*rxt(k,860)*y(k,256) + mat(k,82) = .0521005_r8*rxt(k,865)*y(k,147) + .0348005_r8*rxt(k,864)*y(k,256) + mat(k,90) = .0772005_r8*rxt(k,869)*y(k,147) + .0348005_r8*rxt(k,868)*y(k,256) + mat(k,96) = .0772005_r8*rxt(k,874)*y(k,147) + .0348005_r8*rxt(k,873)*y(k,256) + mat(k,3580) = .0459005_r8*rxt(k,877)*y(k,196) + mat(k,102) = .0966005_r8*rxt(k,880)*y(k,147) + .0763005_r8*rxt(k,879) & + *y(k,256) + mat(k,108) = .0025005_r8*rxt(k,883)*y(k,147) + .086_r8*rxt(k,882)*y(k,256) + mat(k,1242) = .1749305_r8*rxt(k,841)*y(k,149) + .0554005_r8*rxt(k,844) & *y(k,157) - mat(k,855) = .1749305_r8*rxt(k,847)*y(k,149) + .1284005_r8*rxt(k,850) & + mat(k,1024) = .1749305_r8*rxt(k,846)*y(k,149) + .1284005_r8*rxt(k,849) & *y(k,157) - mat(k,937) = .1749305_r8*rxt(k,855)*y(k,149) + .0554005_r8*rxt(k,858) & + mat(k,1086) = .1749305_r8*rxt(k,854)*y(k,149) + .0554005_r8*rxt(k,857) & *y(k,157) - mat(k,1276) = .0590245_r8*rxt(k,860)*y(k,149) + .0033005_r8*rxt(k,863) & + mat(k,1381) = .0590245_r8*rxt(k,859)*y(k,149) + .0033005_r8*rxt(k,862) & *y(k,157) - mat(k,957) = .1749305_r8*rxt(k,868)*y(k,149) + .0554005_r8*rxt(k,871) & + mat(k,1065) = .1749305_r8*rxt(k,867)*y(k,149) + .0554005_r8*rxt(k,870) & *y(k,157) - mat(k,707) = .1749305_r8*rxt(k,873)*y(k,149) + .0554005_r8*rxt(k,876) & + mat(k,843) = .1749305_r8*rxt(k,872)*y(k,149) + .0554005_r8*rxt(k,875) & *y(k,157) - mat(k,2745) = .0332005_r8*rxt(k,844)*y(k,237) + .079_r8*rxt(k,849)*y(k,240) & - + .0059005_r8*rxt(k,854)*y(k,242) + .0332005_r8*rxt(k,857) & - *y(k,245) + .0057005_r8*rxt(k,862)*y(k,275) & - + .0143005_r8*rxt(k,866)*y(k,278) + .0332005_r8*rxt(k,870) & - *y(k,281) + .0332005_r8*rxt(k,875)*y(k,290) & - + .0073005_r8*rxt(k,881)*y(k,313) + .011_r8*rxt(k,884)*y(k,315) - mat(k,3001) = .1749305_r8*rxt(k,842)*y(k,4) + .1749305_r8*rxt(k,847)*y(k,7) & - + .1749305_r8*rxt(k,855)*y(k,17) + .0590245_r8*rxt(k,860) & - *y(k,109) + .1749305_r8*rxt(k,868)*y(k,125) & - + .1749305_r8*rxt(k,873)*y(k,135) - mat(k,2903) = .0554005_r8*rxt(k,845)*y(k,4) + .1284005_r8*rxt(k,850)*y(k,7) & - + .0554005_r8*rxt(k,858)*y(k,17) + .0033005_r8*rxt(k,863) & - *y(k,109) + .0554005_r8*rxt(k,871)*y(k,125) & - + .0554005_r8*rxt(k,876)*y(k,135) - mat(k,38) = .0085005_r8*rxt(k,878)*y(k,293) - mat(k,44) = .0332005_r8*rxt(k,844)*y(k,147) + .0554005_r8*rxt(k,843)*y(k,256) - mat(k,50) = .079_r8*rxt(k,849)*y(k,147) + .1284005_r8*rxt(k,848)*y(k,256) - mat(k,56) = .0059005_r8*rxt(k,854)*y(k,147) + .0443005_r8*rxt(k,853)*y(k,256) - mat(k,62) = .0332005_r8*rxt(k,857)*y(k,147) + .0554005_r8*rxt(k,856)*y(k,256) - mat(k,3120) = .0554005_r8*rxt(k,843)*y(k,237) + .1284005_r8*rxt(k,848) & - *y(k,240) + .0443005_r8*rxt(k,853)*y(k,242) & - + .0554005_r8*rxt(k,856)*y(k,245) + .0271005_r8*rxt(k,861) & - *y(k,275) + .0076005_r8*rxt(k,865)*y(k,278) & - + .0554005_r8*rxt(k,869)*y(k,281) + .0554005_r8*rxt(k,874) & - *y(k,290) + .2157005_r8*rxt(k,880)*y(k,313) & - + .0512005_r8*rxt(k,883)*y(k,315) - mat(k,68) = .0057005_r8*rxt(k,862)*y(k,147) + .0271005_r8*rxt(k,861)*y(k,256) - mat(k,74) = .0143005_r8*rxt(k,866)*y(k,147) + .0076005_r8*rxt(k,865)*y(k,256) - mat(k,82) = .0332005_r8*rxt(k,870)*y(k,147) + .0554005_r8*rxt(k,869)*y(k,256) - mat(k,88) = .0332005_r8*rxt(k,875)*y(k,147) + .0554005_r8*rxt(k,874)*y(k,256) - mat(k,3520) = .0085005_r8*rxt(k,878)*y(k,196) - mat(k,94) = .0073005_r8*rxt(k,881)*y(k,147) + .2157005_r8*rxt(k,880)*y(k,256) - mat(k,100) = .011_r8*rxt(k,884)*y(k,147) + .0512005_r8*rxt(k,883)*y(k,256) + mat(k,3166) = .0332005_r8*rxt(k,843)*y(k,237) + .079_r8*rxt(k,848)*y(k,240) & + + .0059005_r8*rxt(k,853)*y(k,242) + .0332005_r8*rxt(k,856) & + *y(k,245) + .0057005_r8*rxt(k,861)*y(k,275) & + + .0143005_r8*rxt(k,865)*y(k,278) + .0332005_r8*rxt(k,869) & + *y(k,281) + .0332005_r8*rxt(k,874)*y(k,290) & + + .0073005_r8*rxt(k,880)*y(k,313) + .011_r8*rxt(k,883)*y(k,315) + mat(k,3869) = .1749305_r8*rxt(k,841)*y(k,4) + .1749305_r8*rxt(k,846)*y(k,7) & + + .1749305_r8*rxt(k,854)*y(k,17) + .0590245_r8*rxt(k,859) & + *y(k,109) + .1749305_r8*rxt(k,867)*y(k,125) & + + .1749305_r8*rxt(k,872)*y(k,135) + mat(k,3040) = .0554005_r8*rxt(k,844)*y(k,4) + .1284005_r8*rxt(k,849)*y(k,7) & + + .0554005_r8*rxt(k,857)*y(k,17) + .0033005_r8*rxt(k,862) & + *y(k,109) + .0554005_r8*rxt(k,870)*y(k,125) & + + .0554005_r8*rxt(k,875)*y(k,135) + mat(k,47) = .0085005_r8*rxt(k,877)*y(k,293) + mat(k,53) = .0332005_r8*rxt(k,843)*y(k,147) + .0554005_r8*rxt(k,842)*y(k,256) + mat(k,59) = .079_r8*rxt(k,848)*y(k,147) + .1284005_r8*rxt(k,847)*y(k,256) + mat(k,65) = .0059005_r8*rxt(k,853)*y(k,147) + .0443005_r8*rxt(k,852)*y(k,256) + mat(k,71) = .0332005_r8*rxt(k,856)*y(k,147) + .0554005_r8*rxt(k,855)*y(k,256) + mat(k,3401) = .0554005_r8*rxt(k,842)*y(k,237) + .1284005_r8*rxt(k,847) & + *y(k,240) + .0443005_r8*rxt(k,852)*y(k,242) & + + .0554005_r8*rxt(k,855)*y(k,245) + .0271005_r8*rxt(k,860) & + *y(k,275) + .0076005_r8*rxt(k,864)*y(k,278) & + + .0554005_r8*rxt(k,868)*y(k,281) + .0554005_r8*rxt(k,873) & + *y(k,290) + .2157005_r8*rxt(k,879)*y(k,313) & + + .0512005_r8*rxt(k,882)*y(k,315) + mat(k,77) = .0057005_r8*rxt(k,861)*y(k,147) + .0271005_r8*rxt(k,860)*y(k,256) + mat(k,83) = .0143005_r8*rxt(k,865)*y(k,147) + .0076005_r8*rxt(k,864)*y(k,256) + mat(k,91) = .0332005_r8*rxt(k,869)*y(k,147) + .0554005_r8*rxt(k,868)*y(k,256) + mat(k,97) = .0332005_r8*rxt(k,874)*y(k,147) + .0554005_r8*rxt(k,873)*y(k,256) + mat(k,3581) = .0085005_r8*rxt(k,877)*y(k,196) + mat(k,103) = .0073005_r8*rxt(k,880)*y(k,147) + .2157005_r8*rxt(k,879) & + *y(k,256) + mat(k,109) = .011_r8*rxt(k,883)*y(k,147) + .0512005_r8*rxt(k,882)*y(k,256) end do end subroutine nlnmat09 subroutine nlnmat10( avec_len, mat, y, rxt ) @@ -2255,235 +2522,235 @@ subroutine nlnmat10( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,1099) = .5901905_r8*rxt(k,842)*y(k,149) + .1278005_r8*rxt(k,845) & + mat(k,1243) = .5901905_r8*rxt(k,841)*y(k,149) + .1278005_r8*rxt(k,844) & *y(k,157) - mat(k,856) = .5901905_r8*rxt(k,847)*y(k,149) + .114_r8*rxt(k,850)*y(k,157) - mat(k,938) = .5901905_r8*rxt(k,855)*y(k,149) + .1278005_r8*rxt(k,858) & + mat(k,1025) = .5901905_r8*rxt(k,846)*y(k,149) + .114_r8*rxt(k,849)*y(k,157) + mat(k,1087) = .5901905_r8*rxt(k,854)*y(k,149) + .1278005_r8*rxt(k,857) & *y(k,157) - mat(k,1277) = .0250245_r8*rxt(k,860)*y(k,149) - mat(k,958) = .5901905_r8*rxt(k,868)*y(k,149) + .1278005_r8*rxt(k,871) & + mat(k,1382) = .0250245_r8*rxt(k,859)*y(k,149) + mat(k,1066) = .5901905_r8*rxt(k,867)*y(k,149) + .1278005_r8*rxt(k,870) & *y(k,157) - mat(k,708) = .5901905_r8*rxt(k,873)*y(k,149) + .1278005_r8*rxt(k,876) & + mat(k,844) = .5901905_r8*rxt(k,872)*y(k,149) + .1278005_r8*rxt(k,875) & *y(k,157) - mat(k,2746) = .130_r8*rxt(k,844)*y(k,237) + .1254005_r8*rxt(k,849)*y(k,240) & - + .0536005_r8*rxt(k,854)*y(k,242) + .130_r8*rxt(k,857)*y(k,245) & - + .0623005_r8*rxt(k,862)*y(k,275) + .0166005_r8*rxt(k,866) & - *y(k,278) + .130_r8*rxt(k,870)*y(k,281) + .130_r8*rxt(k,875) & - *y(k,290) + .238_r8*rxt(k,881)*y(k,313) + .1185005_r8*rxt(k,884) & + mat(k,3167) = .130_r8*rxt(k,843)*y(k,237) + .1254005_r8*rxt(k,848)*y(k,240) & + + .0536005_r8*rxt(k,853)*y(k,242) + .130_r8*rxt(k,856)*y(k,245) & + + .0623005_r8*rxt(k,861)*y(k,275) + .0166005_r8*rxt(k,865) & + *y(k,278) + .130_r8*rxt(k,869)*y(k,281) + .130_r8*rxt(k,874) & + *y(k,290) + .238_r8*rxt(k,880)*y(k,313) + .1185005_r8*rxt(k,883) & *y(k,315) - mat(k,3002) = .5901905_r8*rxt(k,842)*y(k,4) + .5901905_r8*rxt(k,847)*y(k,7) & - + .5901905_r8*rxt(k,855)*y(k,17) + .0250245_r8*rxt(k,860) & - *y(k,109) + .5901905_r8*rxt(k,868)*y(k,125) & - + .5901905_r8*rxt(k,873)*y(k,135) - mat(k,2904) = .1278005_r8*rxt(k,845)*y(k,4) + .114_r8*rxt(k,850)*y(k,7) & - + .1278005_r8*rxt(k,858)*y(k,17) + .1278005_r8*rxt(k,871) & - *y(k,125) + .1278005_r8*rxt(k,876)*y(k,135) - mat(k,39) = .0128005_r8*rxt(k,878)*y(k,293) - mat(k,45) = .130_r8*rxt(k,844)*y(k,147) + .1278005_r8*rxt(k,843)*y(k,256) - mat(k,51) = .1254005_r8*rxt(k,849)*y(k,147) + .114_r8*rxt(k,848)*y(k,256) - mat(k,57) = .0536005_r8*rxt(k,854)*y(k,147) + .1621005_r8*rxt(k,853)*y(k,256) - mat(k,63) = .130_r8*rxt(k,857)*y(k,147) + .1278005_r8*rxt(k,856)*y(k,256) - mat(k,3121) = .1278005_r8*rxt(k,843)*y(k,237) + .114_r8*rxt(k,848)*y(k,240) & - + .1621005_r8*rxt(k,853)*y(k,242) + .1278005_r8*rxt(k,856) & - *y(k,245) + .0474005_r8*rxt(k,861)*y(k,275) & - + .0113005_r8*rxt(k,865)*y(k,278) + .1278005_r8*rxt(k,869) & - *y(k,281) + .1278005_r8*rxt(k,874)*y(k,290) & - + .0738005_r8*rxt(k,880)*y(k,313) + .1598005_r8*rxt(k,883) & + mat(k,3870) = .5901905_r8*rxt(k,841)*y(k,4) + .5901905_r8*rxt(k,846)*y(k,7) & + + .5901905_r8*rxt(k,854)*y(k,17) + .0250245_r8*rxt(k,859) & + *y(k,109) + .5901905_r8*rxt(k,867)*y(k,125) & + + .5901905_r8*rxt(k,872)*y(k,135) + mat(k,3041) = .1278005_r8*rxt(k,844)*y(k,4) + .114_r8*rxt(k,849)*y(k,7) & + + .1278005_r8*rxt(k,857)*y(k,17) + .1278005_r8*rxt(k,870) & + *y(k,125) + .1278005_r8*rxt(k,875)*y(k,135) + mat(k,48) = .0128005_r8*rxt(k,877)*y(k,293) + mat(k,54) = .130_r8*rxt(k,843)*y(k,147) + .1278005_r8*rxt(k,842)*y(k,256) + mat(k,60) = .1254005_r8*rxt(k,848)*y(k,147) + .114_r8*rxt(k,847)*y(k,256) + mat(k,66) = .0536005_r8*rxt(k,853)*y(k,147) + .1621005_r8*rxt(k,852)*y(k,256) + mat(k,72) = .130_r8*rxt(k,856)*y(k,147) + .1278005_r8*rxt(k,855)*y(k,256) + mat(k,3402) = .1278005_r8*rxt(k,842)*y(k,237) + .114_r8*rxt(k,847)*y(k,240) & + + .1621005_r8*rxt(k,852)*y(k,242) + .1278005_r8*rxt(k,855) & + *y(k,245) + .0474005_r8*rxt(k,860)*y(k,275) & + + .0113005_r8*rxt(k,864)*y(k,278) + .1278005_r8*rxt(k,868) & + *y(k,281) + .1278005_r8*rxt(k,873)*y(k,290) & + + .0738005_r8*rxt(k,879)*y(k,313) + .1598005_r8*rxt(k,882) & *y(k,315) - mat(k,69) = .0623005_r8*rxt(k,862)*y(k,147) + .0474005_r8*rxt(k,861)*y(k,256) - mat(k,75) = .0166005_r8*rxt(k,866)*y(k,147) + .0113005_r8*rxt(k,865)*y(k,256) - mat(k,83) = .130_r8*rxt(k,870)*y(k,147) + .1278005_r8*rxt(k,869)*y(k,256) - mat(k,89) = .130_r8*rxt(k,875)*y(k,147) + .1278005_r8*rxt(k,874)*y(k,256) - mat(k,3521) = .0128005_r8*rxt(k,878)*y(k,196) - mat(k,95) = .238_r8*rxt(k,881)*y(k,147) + .0738005_r8*rxt(k,880)*y(k,256) - mat(k,101) = .1185005_r8*rxt(k,884)*y(k,147) + .1598005_r8*rxt(k,883) & + mat(k,78) = .0623005_r8*rxt(k,861)*y(k,147) + .0474005_r8*rxt(k,860)*y(k,256) + mat(k,84) = .0166005_r8*rxt(k,865)*y(k,147) + .0113005_r8*rxt(k,864)*y(k,256) + mat(k,92) = .130_r8*rxt(k,869)*y(k,147) + .1278005_r8*rxt(k,868)*y(k,256) + mat(k,98) = .130_r8*rxt(k,874)*y(k,147) + .1278005_r8*rxt(k,873)*y(k,256) + mat(k,3582) = .0128005_r8*rxt(k,877)*y(k,196) + mat(k,104) = .238_r8*rxt(k,880)*y(k,147) + .0738005_r8*rxt(k,879)*y(k,256) + mat(k,110) = .1185005_r8*rxt(k,883)*y(k,147) + .1598005_r8*rxt(k,882) & *y(k,256) - mat(k,2747) = .070_r8*rxt(k,610)*y(k,238) + .300_r8*rxt(k,618)*y(k,239) - mat(k,2051) = .070_r8*rxt(k,610)*y(k,147) + .720_r8*rxt(k,606)*y(k,238) & - + .180_r8*rxt(k,608)*y(k,251) + .500_r8*rxt(k,609)*y(k,256) - mat(k,2091) = .300_r8*rxt(k,618)*y(k,147) - mat(k,3346) = .180_r8*rxt(k,608)*y(k,238) - mat(k,3122) = .500_r8*rxt(k,609)*y(k,238) - mat(k,40) = -(rxt(k,878)*y(k,293)) - mat(k,3522) = -rxt(k,878)*y(k,196) - mat(k,163) = .100_r8*rxt(k,575)*y(k,293) - mat(k,178) = .230_r8*rxt(k,577)*y(k,293) - mat(k,3547) = .100_r8*rxt(k,575)*y(k,226) + .230_r8*rxt(k,577)*y(k,227) - mat(k,2179) = -(rxt(k,690)*y(k,293)) - mat(k,3723) = -rxt(k,690)*y(k,198) - mat(k,2866) = .110_r8*rxt(k,598)*y(k,236) + .700_r8*rxt(k,693)*y(k,298) - mat(k,3059) = .140_r8*rxt(k,599)*y(k,236) - mat(k,2212) = .110_r8*rxt(k,598)*y(k,147) + .140_r8*rxt(k,599)*y(k,149) & - + .140_r8*rxt(k,595)*y(k,250) + .130_r8*rxt(k,596)*y(k,251) & - + .250_r8*rxt(k,597)*y(k,256) + .140_r8*rxt(k,600)*y(k,300) & - + .140_r8*rxt(k,601)*y(k,302) + .140_r8*rxt(k,602)*y(k,305) - mat(k,2241) = .680_r8*rxt(k,637)*y(k,256) - mat(k,2683) = .140_r8*rxt(k,595)*y(k,236) - mat(k,3403) = .130_r8*rxt(k,596)*y(k,236) - mat(k,3262) = .250_r8*rxt(k,597)*y(k,236) + .680_r8*rxt(k,637)*y(k,244) & - + .900_r8*rxt(k,657)*y(k,280) + .180_r8*rxt(k,692)*y(k,298) & - + .900_r8*rxt(k,766)*y(k,307) - mat(k,2157) = .900_r8*rxt(k,657)*y(k,256) - mat(k,919) = .700_r8*rxt(k,693)*y(k,147) + .180_r8*rxt(k,692)*y(k,256) - mat(k,2519) = .140_r8*rxt(k,600)*y(k,236) - mat(k,2565) = .140_r8*rxt(k,601)*y(k,236) - mat(k,2612) = .140_r8*rxt(k,602)*y(k,236) - mat(k,846) = .900_r8*rxt(k,766)*y(k,256) - mat(k,386) = -(rxt(k,691)*y(k,293)) - mat(k,3581) = -rxt(k,691)*y(k,199) - mat(k,2092) = .900_r8*rxt(k,617)*y(k,256) - mat(k,3152) = .900_r8*rxt(k,617)*y(k,239) + .900_r8*rxt(k,677)*y(k,289) - mat(k,2262) = .900_r8*rxt(k,677)*y(k,256) - mat(k,2193) = -(rxt(k,756)*y(k,149) + rxt(k,757)*y(k,293)) - mat(k,3060) = -rxt(k,756)*y(k,200) - mat(k,3724) = -rxt(k,757)*y(k,200) - mat(k,1107) = .220_r8*rxt(k,603)*y(k,157) - mat(k,2867) = .930_r8*rxt(k,590)*y(k,235) + .300_r8*rxt(k,598)*y(k,236) - mat(k,3060) = mat(k,3060) + rxt(k,591)*y(k,235) + .390_r8*rxt(k,599)*y(k,236) - mat(k,2968) = .220_r8*rxt(k,603)*y(k,4) - mat(k,1464) = rxt(k,784)*y(k,293) - mat(k,1397) = rxt(k,788)*y(k,293) - mat(k,590) = rxt(k,790)*y(k,293) - mat(k,2120) = .930_r8*rxt(k,590)*y(k,147) + rxt(k,591)*y(k,149) & - + 3.280_r8*rxt(k,586)*y(k,235) + rxt(k,587)*y(k,250) & - + .820_r8*rxt(k,588)*y(k,251) + .700_r8*rxt(k,589)*y(k,256) & - + rxt(k,592)*y(k,300) + rxt(k,593)*y(k,302) + rxt(k,594) & + mat(k,3168) = .070_r8*rxt(k,609)*y(k,238) + .300_r8*rxt(k,617)*y(k,239) + mat(k,2209) = .070_r8*rxt(k,609)*y(k,147) + .720_r8*rxt(k,605)*y(k,238) & + + .180_r8*rxt(k,607)*y(k,251) + .500_r8*rxt(k,608)*y(k,256) + mat(k,2315) = .300_r8*rxt(k,617)*y(k,147) + mat(k,3963) = .180_r8*rxt(k,607)*y(k,238) + mat(k,3403) = .500_r8*rxt(k,608)*y(k,238) + mat(k,49) = -(rxt(k,877)*y(k,293)) + mat(k,3583) = -rxt(k,877)*y(k,196) + mat(k,211) = .100_r8*rxt(k,574)*y(k,293) + mat(k,226) = .230_r8*rxt(k,576)*y(k,293) + mat(k,3607) = .100_r8*rxt(k,574)*y(k,226) + .230_r8*rxt(k,576)*y(k,227) + mat(k,2437) = -(rxt(k,689)*y(k,293)) + mat(k,3797) = -rxt(k,689)*y(k,198) + mat(k,3291) = .110_r8*rxt(k,597)*y(k,236) + .700_r8*rxt(k,692)*y(k,298) + mat(k,3932) = .140_r8*rxt(k,598)*y(k,236) + mat(k,2465) = .110_r8*rxt(k,597)*y(k,147) + .140_r8*rxt(k,598)*y(k,149) & + + .140_r8*rxt(k,594)*y(k,250) + .130_r8*rxt(k,595)*y(k,251) & + + .250_r8*rxt(k,596)*y(k,256) + .140_r8*rxt(k,599)*y(k,300) & + + .140_r8*rxt(k,600)*y(k,302) + .140_r8*rxt(k,601)*y(k,305) + mat(k,2412) = .680_r8*rxt(k,636)*y(k,256) + mat(k,3008) = .140_r8*rxt(k,594)*y(k,236) + mat(k,4025) = .130_r8*rxt(k,595)*y(k,236) + mat(k,3547) = .250_r8*rxt(k,596)*y(k,236) + .680_r8*rxt(k,636)*y(k,244) & + + .900_r8*rxt(k,656)*y(k,280) + .180_r8*rxt(k,691)*y(k,298) & + + .900_r8*rxt(k,765)*y(k,307) + mat(k,2382) = .900_r8*rxt(k,656)*y(k,256) + mat(k,1007) = .700_r8*rxt(k,692)*y(k,147) + .180_r8*rxt(k,691)*y(k,256) + mat(k,2936) = .140_r8*rxt(k,599)*y(k,236) + mat(k,2843) = .140_r8*rxt(k,600)*y(k,236) + mat(k,2890) = .140_r8*rxt(k,601)*y(k,236) + mat(k,956) = .900_r8*rxt(k,765)*y(k,256) + mat(k,468) = -(rxt(k,690)*y(k,293)) + mat(k,3647) = -rxt(k,690)*y(k,199) + mat(k,2316) = .900_r8*rxt(k,616)*y(k,256) + mat(k,3433) = .900_r8*rxt(k,616)*y(k,239) + .900_r8*rxt(k,676)*y(k,289) + mat(k,2790) = .900_r8*rxt(k,676)*y(k,256) + mat(k,2366) = -(rxt(k,755)*y(k,149) + rxt(k,756)*y(k,293)) + mat(k,3929) = -rxt(k,755)*y(k,200) + mat(k,3794) = -rxt(k,756)*y(k,200) + mat(k,1252) = .220_r8*rxt(k,602)*y(k,157) + mat(k,3288) = .930_r8*rxt(k,589)*y(k,235) + .300_r8*rxt(k,597)*y(k,236) + mat(k,3929) = mat(k,3929) + rxt(k,590)*y(k,235) + .390_r8*rxt(k,598)*y(k,236) + mat(k,3106) = .220_r8*rxt(k,602)*y(k,4) + mat(k,1556) = rxt(k,783)*y(k,293) + mat(k,1535) = rxt(k,787)*y(k,293) + mat(k,674) = rxt(k,789)*y(k,293) + mat(k,2297) = .930_r8*rxt(k,589)*y(k,147) + rxt(k,590)*y(k,149) & + + 3.280_r8*rxt(k,585)*y(k,235) + rxt(k,586)*y(k,250) & + + .820_r8*rxt(k,587)*y(k,251) + .700_r8*rxt(k,588)*y(k,256) & + + rxt(k,591)*y(k,300) + rxt(k,592)*y(k,302) + rxt(k,593) & *y(k,305) - mat(k,2213) = .300_r8*rxt(k,598)*y(k,147) + .390_r8*rxt(k,599)*y(k,149) & - + .390_r8*rxt(k,595)*y(k,250) + .420_r8*rxt(k,596)*y(k,251) & - + .290_r8*rxt(k,597)*y(k,256) + .390_r8*rxt(k,600)*y(k,300) & - + .390_r8*rxt(k,601)*y(k,302) + .390_r8*rxt(k,602)*y(k,305) - mat(k,2684) = rxt(k,587)*y(k,235) + .390_r8*rxt(k,595)*y(k,236) - mat(k,3404) = .820_r8*rxt(k,588)*y(k,235) + .420_r8*rxt(k,596)*y(k,236) - mat(k,3263) = .700_r8*rxt(k,589)*y(k,235) + .290_r8*rxt(k,597)*y(k,236) - mat(k,3724) = mat(k,3724) + rxt(k,784)*y(k,219) + rxt(k,788)*y(k,221) & - + rxt(k,790)*y(k,223) - mat(k,2520) = rxt(k,592)*y(k,235) + .390_r8*rxt(k,600)*y(k,236) - mat(k,2566) = rxt(k,593)*y(k,235) + .390_r8*rxt(k,601)*y(k,236) - mat(k,2613) = rxt(k,594)*y(k,235) + .390_r8*rxt(k,602)*y(k,236) - mat(k,1167) = -(rxt(k,709)*y(k,149) + rxt(k,718)*y(k,293)) - mat(k,3018) = -rxt(k,709)*y(k,201) - mat(k,3663) = -rxt(k,718)*y(k,201) - mat(k,1103) = .170_r8*rxt(k,603)*y(k,157) - mat(k,2925) = .170_r8*rxt(k,603)*y(k,4) - mat(k,345) = rxt(k,758)*y(k,293) - mat(k,3355) = .500_r8*rxt(k,695)*y(k,299) - mat(k,3663) = mat(k,3663) + rxt(k,758)*y(k,208) - mat(k,2440) = .500_r8*rxt(k,695)*y(k,251) - mat(k,506) = -(rxt(k,719)*y(k,293)) - mat(k,3597) = -rxt(k,719)*y(k,202) - mat(k,3477) = rxt(k,685)*y(k,300) - mat(k,2505) = rxt(k,685)*y(k,148) - mat(k,1645) = -(rxt(k,728)*y(k,149) + rxt(k,737)*y(k,293)) - mat(k,3037) = -rxt(k,728)*y(k,203) - mat(k,3702) = -rxt(k,737)*y(k,203) - mat(k,2844) = .270_r8*rxt(k,598)*y(k,236) + .440_r8*rxt(k,630)*y(k,243) & - + .310_r8*rxt(k,638)*y(k,244) + .700_r8*rxt(k,762)*y(k,306) - mat(k,3037) = mat(k,3037) + rxt(k,760)*y(k,210) + .350_r8*rxt(k,599)*y(k,236) & - + .480_r8*rxt(k,631)*y(k,243) + .410_r8*rxt(k,639)*y(k,244) - mat(k,2946) = rxt(k,763)*y(k,210) - mat(k,2418) = rxt(k,760)*y(k,149) + rxt(k,763)*y(k,157) - mat(k,527) = rxt(k,789)*y(k,293) - mat(k,2210) = .270_r8*rxt(k,598)*y(k,147) + .350_r8*rxt(k,599)*y(k,149) & - + .350_r8*rxt(k,595)*y(k,250) + .200_r8*rxt(k,596)*y(k,251) & - + .350_r8*rxt(k,600)*y(k,300) + .350_r8*rxt(k,601)*y(k,302) & - + .350_r8*rxt(k,602)*y(k,305) - mat(k,2330) = .440_r8*rxt(k,630)*y(k,147) + .480_r8*rxt(k,631)*y(k,149) & - + 1.800_r8*rxt(k,626)*y(k,243) + .480_r8*rxt(k,627)*y(k,250) & - + .340_r8*rxt(k,628)*y(k,251) + .220_r8*rxt(k,629)*y(k,256) & - + .480_r8*rxt(k,632)*y(k,300) + .480_r8*rxt(k,633)*y(k,302) & - + .480_r8*rxt(k,634)*y(k,305) - mat(k,2239) = .310_r8*rxt(k,638)*y(k,147) + .410_r8*rxt(k,639)*y(k,149) & - + .410_r8*rxt(k,635)*y(k,250) + .310_r8*rxt(k,636)*y(k,251) & - + .410_r8*rxt(k,640)*y(k,300) + .410_r8*rxt(k,641)*y(k,302) & - + .410_r8*rxt(k,642)*y(k,305) - mat(k,2662) = .350_r8*rxt(k,595)*y(k,236) + .480_r8*rxt(k,627)*y(k,243) & - + .410_r8*rxt(k,635)*y(k,244) - mat(k,3382) = .200_r8*rxt(k,596)*y(k,236) + .340_r8*rxt(k,628)*y(k,243) & - + .310_r8*rxt(k,636)*y(k,244) - mat(k,3240) = .220_r8*rxt(k,629)*y(k,243) + .100_r8*rxt(k,761)*y(k,306) - mat(k,3702) = mat(k,3702) + rxt(k,789)*y(k,224) - mat(k,2512) = .350_r8*rxt(k,600)*y(k,236) + .480_r8*rxt(k,632)*y(k,243) & + mat(k,2464) = .300_r8*rxt(k,597)*y(k,147) + .390_r8*rxt(k,598)*y(k,149) & + + .390_r8*rxt(k,594)*y(k,250) + .420_r8*rxt(k,595)*y(k,251) & + + .290_r8*rxt(k,596)*y(k,256) + .390_r8*rxt(k,599)*y(k,300) & + + .390_r8*rxt(k,600)*y(k,302) + .390_r8*rxt(k,601)*y(k,305) + mat(k,3005) = rxt(k,586)*y(k,235) + .390_r8*rxt(k,594)*y(k,236) + mat(k,4022) = .820_r8*rxt(k,587)*y(k,235) + .420_r8*rxt(k,595)*y(k,236) + mat(k,3544) = .700_r8*rxt(k,588)*y(k,235) + .290_r8*rxt(k,596)*y(k,236) + mat(k,3794) = mat(k,3794) + rxt(k,783)*y(k,219) + rxt(k,787)*y(k,221) & + + rxt(k,789)*y(k,223) + mat(k,2933) = rxt(k,591)*y(k,235) + .390_r8*rxt(k,599)*y(k,236) + mat(k,2840) = rxt(k,592)*y(k,235) + .390_r8*rxt(k,600)*y(k,236) + mat(k,2887) = rxt(k,593)*y(k,235) + .390_r8*rxt(k,601)*y(k,236) + mat(k,1287) = -(rxt(k,708)*y(k,149) + rxt(k,717)*y(k,293)) + mat(k,3885) = -rxt(k,708)*y(k,201) + mat(k,3731) = -rxt(k,717)*y(k,201) + mat(k,1247) = .170_r8*rxt(k,602)*y(k,157) + mat(k,3061) = .170_r8*rxt(k,602)*y(k,4) + mat(k,421) = rxt(k,757)*y(k,293) + mat(k,3972) = .500_r8*rxt(k,694)*y(k,299) + mat(k,3731) = mat(k,3731) + rxt(k,757)*y(k,208) + mat(k,2722) = .500_r8*rxt(k,694)*y(k,251) + mat(k,648) = -(rxt(k,718)*y(k,293)) + mat(k,3670) = -rxt(k,718)*y(k,202) + mat(k,4066) = rxt(k,684)*y(k,300) + mat(k,2918) = rxt(k,684)*y(k,148) + mat(k,1716) = -(rxt(k,727)*y(k,149) + rxt(k,736)*y(k,293)) + mat(k,3902) = -rxt(k,727)*y(k,203) + mat(k,3766) = -rxt(k,736)*y(k,203) + mat(k,3259) = .270_r8*rxt(k,597)*y(k,236) + .440_r8*rxt(k,629)*y(k,243) & + + .310_r8*rxt(k,637)*y(k,244) + .700_r8*rxt(k,761)*y(k,306) + mat(k,3902) = mat(k,3902) + rxt(k,759)*y(k,210) + .350_r8*rxt(k,598)*y(k,236) & + + .480_r8*rxt(k,630)*y(k,243) + .410_r8*rxt(k,638)*y(k,244) + mat(k,3078) = rxt(k,762)*y(k,210) + mat(k,2660) = rxt(k,759)*y(k,149) + rxt(k,762)*y(k,157) + mat(k,599) = rxt(k,788)*y(k,293) + mat(k,2461) = .270_r8*rxt(k,597)*y(k,147) + .350_r8*rxt(k,598)*y(k,149) & + + .350_r8*rxt(k,594)*y(k,250) + .200_r8*rxt(k,595)*y(k,251) & + + .350_r8*rxt(k,599)*y(k,300) + .350_r8*rxt(k,600)*y(k,302) & + + .350_r8*rxt(k,601)*y(k,305) + mat(k,2527) = .440_r8*rxt(k,629)*y(k,147) + .480_r8*rxt(k,630)*y(k,149) & + + 1.800_r8*rxt(k,625)*y(k,243) + .480_r8*rxt(k,626)*y(k,250) & + + .340_r8*rxt(k,627)*y(k,251) + .220_r8*rxt(k,628)*y(k,256) & + + .480_r8*rxt(k,631)*y(k,300) + .480_r8*rxt(k,632)*y(k,302) & + + .480_r8*rxt(k,633)*y(k,305) + mat(k,2407) = .310_r8*rxt(k,637)*y(k,147) + .410_r8*rxt(k,638)*y(k,149) & + + .410_r8*rxt(k,634)*y(k,250) + .310_r8*rxt(k,635)*y(k,251) & + + .410_r8*rxt(k,639)*y(k,300) + .410_r8*rxt(k,640)*y(k,302) & + + .410_r8*rxt(k,641)*y(k,305) + mat(k,2978) = .350_r8*rxt(k,594)*y(k,236) + .480_r8*rxt(k,626)*y(k,243) & + + .410_r8*rxt(k,634)*y(k,244) + mat(k,3994) = .200_r8*rxt(k,595)*y(k,236) + .340_r8*rxt(k,627)*y(k,243) & + + .310_r8*rxt(k,635)*y(k,244) + mat(k,3515) = .220_r8*rxt(k,628)*y(k,243) + .100_r8*rxt(k,760)*y(k,306) + mat(k,3766) = mat(k,3766) + rxt(k,788)*y(k,224) + mat(k,2925) = .350_r8*rxt(k,599)*y(k,236) + .480_r8*rxt(k,631)*y(k,243) & + + .410_r8*rxt(k,639)*y(k,244) + mat(k,2832) = .350_r8*rxt(k,600)*y(k,236) + .480_r8*rxt(k,632)*y(k,243) & + .410_r8*rxt(k,640)*y(k,244) - mat(k,2558) = .350_r8*rxt(k,601)*y(k,236) + .480_r8*rxt(k,633)*y(k,243) & + mat(k,2879) = .350_r8*rxt(k,601)*y(k,236) + .480_r8*rxt(k,633)*y(k,243) & + .410_r8*rxt(k,641)*y(k,244) - mat(k,2605) = .350_r8*rxt(k,602)*y(k,236) + .480_r8*rxt(k,634)*y(k,243) & - + .410_r8*rxt(k,642)*y(k,244) - mat(k,682) = .700_r8*rxt(k,762)*y(k,147) + .100_r8*rxt(k,761)*y(k,256) - mat(k,514) = -(rxt(k,738)*y(k,293)) - mat(k,3598) = -rxt(k,738)*y(k,204) - mat(k,3478) = rxt(k,686)*y(k,302) - mat(k,2551) = rxt(k,686)*y(k,148) - mat(k,522) = -(rxt(k,749)*y(k,293)) - mat(k,3599) = -rxt(k,749)*y(k,205) - mat(k,1101) = .010_r8*rxt(k,603)*y(k,157) - mat(k,858) = .130_r8*rxt(k,623)*y(k,157) - mat(k,960) = .010_r8*rxt(k,663)*y(k,157) - mat(k,2909) = .010_r8*rxt(k,603)*y(k,4) + .130_r8*rxt(k,623)*y(k,7) & - + .010_r8*rxt(k,663)*y(k,125) - mat(k,3159) = .510_r8*rxt(k,752)*y(k,305) - mat(k,2597) = .510_r8*rxt(k,752)*y(k,256) - mat(k,226) = -(rxt(k,747)*y(k,293)) - mat(k,3558) = -rxt(k,747)*y(k,206) - mat(k,3135) = .510_r8*rxt(k,704)*y(k,300) - mat(k,2504) = .510_r8*rxt(k,704)*y(k,256) - mat(k,230) = -(rxt(k,748)*y(k,293)) - mat(k,3559) = -rxt(k,748)*y(k,207) - mat(k,3136) = .510_r8*rxt(k,722)*y(k,302) - mat(k,2550) = .510_r8*rxt(k,722)*y(k,256) - mat(k,344) = -(rxt(k,758)*y(k,293)) - mat(k,3574) = -rxt(k,758)*y(k,208) - mat(k,3470) = rxt(k,687)*y(k,305) - mat(k,2596) = rxt(k,687)*y(k,148) - mat(k,296) = -(rxt(k,759)*y(k,293)) - mat(k,3567) = -rxt(k,759)*y(k,209) - mat(k,3142) = .820_r8*rxt(k,688)*y(k,297) + .820_r8*rxt(k,692)*y(k,298) - mat(k,831) = .820_r8*rxt(k,688)*y(k,256) - mat(k,914) = .820_r8*rxt(k,692)*y(k,256) - mat(k,2420) = -(rxt(k,760)*y(k,149) + rxt(k,763)*y(k,157) + rxt(k,764) & + mat(k,797) = .700_r8*rxt(k,761)*y(k,147) + .100_r8*rxt(k,760)*y(k,256) + mat(k,657) = -(rxt(k,737)*y(k,293)) + mat(k,3671) = -rxt(k,737)*y(k,204) + mat(k,4067) = rxt(k,685)*y(k,302) + mat(k,2825) = rxt(k,685)*y(k,148) + mat(k,768) = -(rxt(k,748)*y(k,293)) + mat(k,3682) = -rxt(k,748)*y(k,205) + mat(k,1245) = .010_r8*rxt(k,602)*y(k,157) + mat(k,1027) = .130_r8*rxt(k,622)*y(k,157) + mat(k,1068) = .010_r8*rxt(k,662)*y(k,157) + mat(k,3047) = .010_r8*rxt(k,602)*y(k,4) + .130_r8*rxt(k,622)*y(k,7) & + + .010_r8*rxt(k,662)*y(k,125) + mat(k,3448) = .510_r8*rxt(k,751)*y(k,305) + mat(k,2871) = .510_r8*rxt(k,751)*y(k,256) + mat(k,360) = -(rxt(k,746)*y(k,293)) + mat(k,3630) = -rxt(k,746)*y(k,206) + mat(k,3421) = .510_r8*rxt(k,703)*y(k,300) + mat(k,2917) = .510_r8*rxt(k,703)*y(k,256) + mat(k,365) = -(rxt(k,747)*y(k,293)) + mat(k,3631) = -rxt(k,747)*y(k,207) + mat(k,3422) = .510_r8*rxt(k,721)*y(k,302) + mat(k,2824) = .510_r8*rxt(k,721)*y(k,256) + mat(k,420) = -(rxt(k,757)*y(k,293)) + mat(k,3639) = -rxt(k,757)*y(k,208) + mat(k,4058) = rxt(k,686)*y(k,305) + mat(k,2870) = rxt(k,686)*y(k,148) + mat(k,370) = -(rxt(k,758)*y(k,293)) + mat(k,3632) = -rxt(k,758)*y(k,209) + mat(k,3423) = .820_r8*rxt(k,687)*y(k,297) + .820_r8*rxt(k,691)*y(k,298) + mat(k,941) = .820_r8*rxt(k,687)*y(k,256) + mat(k,1001) = .820_r8*rxt(k,691)*y(k,256) + mat(k,2663) = -(rxt(k,759)*y(k,149) + rxt(k,762)*y(k,157) + rxt(k,763) & *y(k,293)) - mat(k,3068) = -rxt(k,760)*y(k,210) - mat(k,2976) = -rxt(k,763)*y(k,210) - mat(k,3732) = -rxt(k,764)*y(k,210) - mat(k,965) = .660_r8*rxt(k,663)*y(k,157) - mat(k,2875) = .090_r8*rxt(k,598)*y(k,236) + .200_r8*rxt(k,638)*y(k,244) & - + .430_r8*rxt(k,650)*y(k,279) + .770_r8*rxt(k,658)*y(k,280) & - + .700_r8*rxt(k,767)*y(k,307) - mat(k,3068) = mat(k,3068) + .500_r8*rxt(k,765)*y(k,211) + .120_r8*rxt(k,599) & - *y(k,236) + .270_r8*rxt(k,639)*y(k,244) + .460_r8*rxt(k,651) & - *y(k,279) + rxt(k,659)*y(k,280) - mat(k,2976) = mat(k,2976) + .660_r8*rxt(k,663)*y(k,125) + rxt(k,768)*y(k,211) - mat(k,2393) = .500_r8*rxt(k,765)*y(k,149) + rxt(k,768)*y(k,157) - mat(k,2215) = .090_r8*rxt(k,598)*y(k,147) + .120_r8*rxt(k,599)*y(k,149) & - + .120_r8*rxt(k,595)*y(k,250) + .140_r8*rxt(k,596)*y(k,251) & - + .060_r8*rxt(k,597)*y(k,256) + .120_r8*rxt(k,600)*y(k,300) & - + .120_r8*rxt(k,601)*y(k,302) + .120_r8*rxt(k,602)*y(k,305) - mat(k,2244) = .200_r8*rxt(k,638)*y(k,147) + .270_r8*rxt(k,639)*y(k,149) & - + .270_r8*rxt(k,635)*y(k,250) + .370_r8*rxt(k,636)*y(k,251) & - + .270_r8*rxt(k,640)*y(k,300) + .270_r8*rxt(k,641)*y(k,302) & - + .270_r8*rxt(k,642)*y(k,305) - mat(k,2692) = .120_r8*rxt(k,595)*y(k,236) + .270_r8*rxt(k,635)*y(k,244) & - + .460_r8*rxt(k,646)*y(k,279) + rxt(k,655)*y(k,280) - mat(k,3412) = .140_r8*rxt(k,596)*y(k,236) + .370_r8*rxt(k,636)*y(k,244) & - + .310_r8*rxt(k,647)*y(k,279) + rxt(k,656)*y(k,280) - mat(k,3271) = .060_r8*rxt(k,597)*y(k,236) + .230_r8*rxt(k,648)*y(k,279) & - + .100_r8*rxt(k,657)*y(k,280) + .100_r8*rxt(k,766)*y(k,307) - mat(k,2305) = .430_r8*rxt(k,650)*y(k,147) + .460_r8*rxt(k,651)*y(k,149) & - + .460_r8*rxt(k,646)*y(k,250) + .310_r8*rxt(k,647)*y(k,251) & - + .230_r8*rxt(k,648)*y(k,256) + 1.720_r8*rxt(k,649)*y(k,279) & - + .460_r8*rxt(k,652)*y(k,300) + .460_r8*rxt(k,653)*y(k,302) & - + .460_r8*rxt(k,654)*y(k,305) - mat(k,2159) = .770_r8*rxt(k,658)*y(k,147) + rxt(k,659)*y(k,149) + rxt(k,655) & - *y(k,250) + rxt(k,656)*y(k,251) + .100_r8*rxt(k,657)*y(k,256) & - + rxt(k,660)*y(k,300) + rxt(k,661)*y(k,302) + rxt(k,662) & + mat(k,3940) = -rxt(k,759)*y(k,210) + mat(k,3117) = -rxt(k,762)*y(k,210) + mat(k,3805) = -rxt(k,763)*y(k,210) + mat(k,1074) = .660_r8*rxt(k,662)*y(k,157) + mat(k,3299) = .090_r8*rxt(k,597)*y(k,236) + .200_r8*rxt(k,637)*y(k,244) & + + .430_r8*rxt(k,649)*y(k,279) + .770_r8*rxt(k,657)*y(k,280) & + + .700_r8*rxt(k,766)*y(k,307) + mat(k,3940) = mat(k,3940) + .500_r8*rxt(k,764)*y(k,211) + .120_r8*rxt(k,598) & + *y(k,236) + .270_r8*rxt(k,638)*y(k,244) + .460_r8*rxt(k,650) & + *y(k,279) + rxt(k,658)*y(k,280) + mat(k,3117) = mat(k,3117) + .660_r8*rxt(k,662)*y(k,125) + rxt(k,767)*y(k,211) + mat(k,2352) = .500_r8*rxt(k,764)*y(k,149) + rxt(k,767)*y(k,157) + mat(k,2467) = .090_r8*rxt(k,597)*y(k,147) + .120_r8*rxt(k,598)*y(k,149) & + + .120_r8*rxt(k,594)*y(k,250) + .140_r8*rxt(k,595)*y(k,251) & + + .060_r8*rxt(k,596)*y(k,256) + .120_r8*rxt(k,599)*y(k,300) & + + .120_r8*rxt(k,600)*y(k,302) + .120_r8*rxt(k,601)*y(k,305) + mat(k,2413) = .200_r8*rxt(k,637)*y(k,147) + .270_r8*rxt(k,638)*y(k,149) & + + .270_r8*rxt(k,634)*y(k,250) + .370_r8*rxt(k,635)*y(k,251) & + + .270_r8*rxt(k,639)*y(k,300) + .270_r8*rxt(k,640)*y(k,302) & + + .270_r8*rxt(k,641)*y(k,305) + mat(k,3014) = .120_r8*rxt(k,594)*y(k,236) + .270_r8*rxt(k,634)*y(k,244) & + + .460_r8*rxt(k,645)*y(k,279) + rxt(k,654)*y(k,280) + mat(k,4032) = .140_r8*rxt(k,595)*y(k,236) + .370_r8*rxt(k,635)*y(k,244) & + + .310_r8*rxt(k,646)*y(k,279) + rxt(k,655)*y(k,280) + mat(k,3555) = .060_r8*rxt(k,596)*y(k,236) + .230_r8*rxt(k,647)*y(k,279) & + + .100_r8*rxt(k,656)*y(k,280) + .100_r8*rxt(k,765)*y(k,307) + mat(k,2501) = .430_r8*rxt(k,649)*y(k,147) + .460_r8*rxt(k,650)*y(k,149) & + + .460_r8*rxt(k,645)*y(k,250) + .310_r8*rxt(k,646)*y(k,251) & + + .230_r8*rxt(k,647)*y(k,256) + 1.720_r8*rxt(k,648)*y(k,279) & + + .460_r8*rxt(k,651)*y(k,300) + .460_r8*rxt(k,652)*y(k,302) & + + .460_r8*rxt(k,653)*y(k,305) + mat(k,2383) = .770_r8*rxt(k,657)*y(k,147) + rxt(k,658)*y(k,149) + rxt(k,654) & + *y(k,250) + rxt(k,655)*y(k,251) + .100_r8*rxt(k,656)*y(k,256) & + + rxt(k,659)*y(k,300) + rxt(k,660)*y(k,302) + rxt(k,661) & *y(k,305) - mat(k,2528) = .120_r8*rxt(k,600)*y(k,236) + .270_r8*rxt(k,640)*y(k,244) & + mat(k,2940) = .120_r8*rxt(k,599)*y(k,236) + .270_r8*rxt(k,639)*y(k,244) & + + .460_r8*rxt(k,651)*y(k,279) + rxt(k,659)*y(k,280) + mat(k,2847) = .120_r8*rxt(k,600)*y(k,236) + .270_r8*rxt(k,640)*y(k,244) & + .460_r8*rxt(k,652)*y(k,279) + rxt(k,660)*y(k,280) - mat(k,2574) = .120_r8*rxt(k,601)*y(k,236) + .270_r8*rxt(k,641)*y(k,244) & + mat(k,2894) = .120_r8*rxt(k,601)*y(k,236) + .270_r8*rxt(k,641)*y(k,244) & + .460_r8*rxt(k,653)*y(k,279) + rxt(k,661)*y(k,280) - mat(k,2621) = .120_r8*rxt(k,602)*y(k,236) + .270_r8*rxt(k,642)*y(k,244) & - + .460_r8*rxt(k,654)*y(k,279) + rxt(k,662)*y(k,280) - mat(k,847) = .700_r8*rxt(k,767)*y(k,147) + .100_r8*rxt(k,766)*y(k,256) + mat(k,957) = .700_r8*rxt(k,766)*y(k,147) + .100_r8*rxt(k,765)*y(k,256) end do end subroutine nlnmat10 subroutine nlnmat11( avec_len, mat, y, rxt ) @@ -2504,225 +2771,225 @@ subroutine nlnmat11( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,2392) = -(rxt(k,765)*y(k,149) + rxt(k,768)*y(k,157) + rxt(k,769) & + mat(k,2349) = -(rxt(k,764)*y(k,149) + rxt(k,767)*y(k,157) + rxt(k,768) & *y(k,293)) - mat(k,3067) = -rxt(k,765)*y(k,211) - mat(k,2975) = -rxt(k,768)*y(k,211) - mat(k,3731) = -rxt(k,769)*y(k,211) - mat(k,863) = .870_r8*rxt(k,623)*y(k,157) - mat(k,715) = rxt(k,683)*y(k,157) - mat(k,2874) = .930_r8*rxt(k,610)*y(k,238) + .700_r8*rxt(k,618)*y(k,239) & - + .890_r8*rxt(k,670)*y(k,288) + .710_r8*rxt(k,678)*y(k,289) - mat(k,3067) = mat(k,3067) + rxt(k,611)*y(k,238) + rxt(k,619)*y(k,239) & - + .950_r8*rxt(k,671)*y(k,288) + rxt(k,679)*y(k,289) - mat(k,2975) = mat(k,2975) + .870_r8*rxt(k,623)*y(k,7) + rxt(k,683)*y(k,135) - mat(k,2054) = .930_r8*rxt(k,610)*y(k,147) + rxt(k,611)*y(k,149) & - + 3.280_r8*rxt(k,606)*y(k,238) + rxt(k,607)*y(k,250) & - + .820_r8*rxt(k,608)*y(k,251) + .500_r8*rxt(k,609)*y(k,256) & - + rxt(k,612)*y(k,300) + rxt(k,613)*y(k,302) + rxt(k,614) & + mat(k,3928) = -rxt(k,764)*y(k,211) + mat(k,3105) = -rxt(k,767)*y(k,211) + mat(k,3793) = -rxt(k,768)*y(k,211) + mat(k,1033) = .870_r8*rxt(k,622)*y(k,157) + mat(k,849) = rxt(k,682)*y(k,157) + mat(k,3287) = .930_r8*rxt(k,609)*y(k,238) + .700_r8*rxt(k,617)*y(k,239) & + + .890_r8*rxt(k,669)*y(k,288) + .710_r8*rxt(k,677)*y(k,289) + mat(k,3928) = mat(k,3928) + rxt(k,610)*y(k,238) + rxt(k,618)*y(k,239) & + + .950_r8*rxt(k,670)*y(k,288) + rxt(k,678)*y(k,289) + mat(k,3105) = mat(k,3105) + .870_r8*rxt(k,622)*y(k,7) + rxt(k,682)*y(k,135) + mat(k,2214) = .930_r8*rxt(k,609)*y(k,147) + rxt(k,610)*y(k,149) & + + 3.280_r8*rxt(k,605)*y(k,238) + rxt(k,606)*y(k,250) & + + .820_r8*rxt(k,607)*y(k,251) + .500_r8*rxt(k,608)*y(k,256) & + + rxt(k,611)*y(k,300) + rxt(k,612)*y(k,302) + rxt(k,613) & *y(k,305) - mat(k,2099) = .700_r8*rxt(k,618)*y(k,147) + rxt(k,619)*y(k,149) + rxt(k,615) & - *y(k,250) + rxt(k,616)*y(k,251) + .100_r8*rxt(k,617)*y(k,256) & - + rxt(k,620)*y(k,300) + rxt(k,621)*y(k,302) + rxt(k,622) & + mat(k,2323) = .700_r8*rxt(k,617)*y(k,147) + rxt(k,618)*y(k,149) + rxt(k,614) & + *y(k,250) + rxt(k,615)*y(k,251) + .100_r8*rxt(k,616)*y(k,256) & + + rxt(k,619)*y(k,300) + rxt(k,620)*y(k,302) + rxt(k,621) & *y(k,305) - mat(k,2691) = rxt(k,607)*y(k,238) + rxt(k,615)*y(k,239) + .950_r8*rxt(k,666) & - *y(k,288) + rxt(k,675)*y(k,289) - mat(k,3411) = .820_r8*rxt(k,608)*y(k,238) + rxt(k,616)*y(k,239) & - + .770_r8*rxt(k,667)*y(k,288) + rxt(k,676)*y(k,289) - mat(k,3270) = .500_r8*rxt(k,609)*y(k,238) + .100_r8*rxt(k,617)*y(k,239) & - + .480_r8*rxt(k,668)*y(k,288) + .100_r8*rxt(k,677)*y(k,289) - mat(k,2365) = .890_r8*rxt(k,670)*y(k,147) + .950_r8*rxt(k,671)*y(k,149) & - + .950_r8*rxt(k,666)*y(k,250) + .770_r8*rxt(k,667)*y(k,251) & - + .480_r8*rxt(k,668)*y(k,256) + 3.080_r8*rxt(k,669)*y(k,288) & - + .950_r8*rxt(k,672)*y(k,300) + .950_r8*rxt(k,673)*y(k,302) & - + .950_r8*rxt(k,674)*y(k,305) - mat(k,2272) = .710_r8*rxt(k,678)*y(k,147) + rxt(k,679)*y(k,149) + rxt(k,675) & - *y(k,250) + rxt(k,676)*y(k,251) + .100_r8*rxt(k,677)*y(k,256) & - + rxt(k,680)*y(k,300) + rxt(k,681)*y(k,302) + rxt(k,682) & + mat(k,3004) = rxt(k,606)*y(k,238) + rxt(k,614)*y(k,239) + .950_r8*rxt(k,665) & + *y(k,288) + rxt(k,674)*y(k,289) + mat(k,4021) = .820_r8*rxt(k,607)*y(k,238) + rxt(k,615)*y(k,239) & + + .770_r8*rxt(k,666)*y(k,288) + rxt(k,675)*y(k,289) + mat(k,3543) = .500_r8*rxt(k,608)*y(k,238) + .100_r8*rxt(k,616)*y(k,239) & + + .480_r8*rxt(k,667)*y(k,288) + .100_r8*rxt(k,676)*y(k,289) + mat(k,2695) = .890_r8*rxt(k,669)*y(k,147) + .950_r8*rxt(k,670)*y(k,149) & + + .950_r8*rxt(k,665)*y(k,250) + .770_r8*rxt(k,666)*y(k,251) & + + .480_r8*rxt(k,667)*y(k,256) + 3.080_r8*rxt(k,668)*y(k,288) & + + .950_r8*rxt(k,671)*y(k,300) + .950_r8*rxt(k,672)*y(k,302) & + + .950_r8*rxt(k,673)*y(k,305) + mat(k,2799) = .710_r8*rxt(k,677)*y(k,147) + rxt(k,678)*y(k,149) + rxt(k,674) & + *y(k,250) + rxt(k,675)*y(k,251) + .100_r8*rxt(k,676)*y(k,256) & + + rxt(k,679)*y(k,300) + rxt(k,680)*y(k,302) + rxt(k,681) & *y(k,305) - mat(k,2527) = rxt(k,612)*y(k,238) + rxt(k,620)*y(k,239) + .950_r8*rxt(k,672) & + mat(k,2932) = rxt(k,611)*y(k,238) + rxt(k,619)*y(k,239) + .950_r8*rxt(k,671) & + *y(k,288) + rxt(k,679)*y(k,289) + mat(k,2839) = rxt(k,612)*y(k,238) + rxt(k,620)*y(k,239) + .950_r8*rxt(k,672) & *y(k,288) + rxt(k,680)*y(k,289) - mat(k,2573) = rxt(k,613)*y(k,238) + rxt(k,621)*y(k,239) + .950_r8*rxt(k,673) & + mat(k,2886) = rxt(k,613)*y(k,238) + rxt(k,621)*y(k,239) + .950_r8*rxt(k,673) & *y(k,288) + rxt(k,681)*y(k,289) - mat(k,2620) = rxt(k,614)*y(k,238) + rxt(k,622)*y(k,239) + .950_r8*rxt(k,674) & - *y(k,288) + rxt(k,682)*y(k,289) - mat(k,1154) = -(rxt(k,770)*y(k,293)) - mat(k,3661) = -rxt(k,770)*y(k,212) - mat(k,2812) = .070_r8*rxt(k,590)*y(k,235) + .070_r8*rxt(k,630)*y(k,243) & - + .070_r8*rxt(k,650)*y(k,279) + .070_r8*rxt(k,670)*y(k,288) & - + .300_r8*rxt(k,774)*y(k,308) + .300_r8*rxt(k,778)*y(k,309) & - + .300_r8*rxt(k,782)*y(k,310) + .300_r8*rxt(k,786)*y(k,311) - mat(k,2115) = .070_r8*rxt(k,590)*y(k,147) - mat(k,2326) = .070_r8*rxt(k,630)*y(k,147) - mat(k,2296) = .070_r8*rxt(k,650)*y(k,147) - mat(k,2355) = .070_r8*rxt(k,670)*y(k,147) - mat(k,1145) = .300_r8*rxt(k,774)*y(k,147) - mat(k,928) = .300_r8*rxt(k,778)*y(k,147) - mat(k,690) = .300_r8*rxt(k,782)*y(k,147) - mat(k,698) = .300_r8*rxt(k,786)*y(k,147) - mat(k,871) = -(rxt(k,771)*y(k,293)) - mat(k,3636) = -rxt(k,771)*y(k,213) - mat(k,2795) = .010_r8*rxt(k,598)*y(k,236) + .300_r8*rxt(k,689)*y(k,297) & - + .300_r8*rxt(k,693)*y(k,298) + .300_r8*rxt(k,762)*y(k,306) - mat(k,2203) = .010_r8*rxt(k,598)*y(k,147) - mat(k,3186) = .900_r8*rxt(k,773)*y(k,308) + .900_r8*rxt(k,777)*y(k,309) & - + .900_r8*rxt(k,781)*y(k,310) + .900_r8*rxt(k,785)*y(k,311) - mat(k,835) = .300_r8*rxt(k,689)*y(k,147) - mat(k,916) = .300_r8*rxt(k,693)*y(k,147) - mat(k,681) = .300_r8*rxt(k,762)*y(k,147) - mat(k,1142) = .900_r8*rxt(k,773)*y(k,256) - mat(k,925) = .900_r8*rxt(k,777)*y(k,256) - mat(k,689) = .900_r8*rxt(k,781)*y(k,256) - mat(k,697) = .900_r8*rxt(k,785)*y(k,256) - mat(k,995) = -(rxt(k,772)*y(k,293)) - mat(k,3646) = -rxt(k,772)*y(k,214) - mat(k,942) = .510_r8*rxt(k,643)*y(k,157) - mat(k,2802) = .020_r8*rxt(k,630)*y(k,243) + .240_r8*rxt(k,638)*y(k,244) - mat(k,3012) = .020_r8*rxt(k,631)*y(k,243) + .320_r8*rxt(k,639)*y(k,244) - mat(k,2919) = .510_r8*rxt(k,643)*y(k,17) - mat(k,2204) = .110_r8*rxt(k,596)*y(k,251) - mat(k,2324) = .020_r8*rxt(k,630)*y(k,147) + .020_r8*rxt(k,631)*y(k,149) & - + .080_r8*rxt(k,626)*y(k,243) + .020_r8*rxt(k,627)*y(k,250) & - + .020_r8*rxt(k,628)*y(k,251) + .020_r8*rxt(k,629)*y(k,256) & - + .020_r8*rxt(k,632)*y(k,300) + .020_r8*rxt(k,633)*y(k,302) & - + .020_r8*rxt(k,634)*y(k,305) - mat(k,2234) = .240_r8*rxt(k,638)*y(k,147) + .320_r8*rxt(k,639)*y(k,149) & - + .320_r8*rxt(k,635)*y(k,250) + .320_r8*rxt(k,636)*y(k,251) & - + .030_r8*rxt(k,637)*y(k,256) + .320_r8*rxt(k,640)*y(k,300) & - + .320_r8*rxt(k,641)*y(k,302) + .320_r8*rxt(k,642)*y(k,305) - mat(k,2646) = .020_r8*rxt(k,627)*y(k,243) + .320_r8*rxt(k,635)*y(k,244) - mat(k,3353) = .110_r8*rxt(k,596)*y(k,236) + .020_r8*rxt(k,628)*y(k,243) & - + .320_r8*rxt(k,636)*y(k,244) - mat(k,3193) = .020_r8*rxt(k,629)*y(k,243) + .030_r8*rxt(k,637)*y(k,244) - mat(k,2506) = .020_r8*rxt(k,632)*y(k,243) + .320_r8*rxt(k,640)*y(k,244) - mat(k,2552) = .020_r8*rxt(k,633)*y(k,243) + .320_r8*rxt(k,641)*y(k,244) - mat(k,2598) = .020_r8*rxt(k,634)*y(k,243) + .320_r8*rxt(k,642)*y(k,244) - mat(k,888) = -(rxt(k,776)*y(k,293)) - mat(k,3638) = -rxt(k,776)*y(k,215) - mat(k,2797) = .700_r8*rxt(k,774)*y(k,308) - mat(k,2323) = .450_r8*rxt(k,629)*y(k,256) - mat(k,3187) = .450_r8*rxt(k,629)*y(k,243) + .100_r8*rxt(k,773)*y(k,308) - mat(k,1143) = .700_r8*rxt(k,774)*y(k,147) + .100_r8*rxt(k,773)*y(k,256) - mat(k,582) = -(rxt(k,775)*y(k,293)) - mat(k,3607) = -rxt(k,775)*y(k,216) - mat(k,3162) = .320_r8*rxt(k,648)*y(k,279) + .360_r8*rxt(k,668)*y(k,288) - mat(k,2291) = .320_r8*rxt(k,648)*y(k,256) - mat(k,2350) = .360_r8*rxt(k,668)*y(k,256) - mat(k,1032) = -(rxt(k,780)*y(k,293)) - mat(k,3650) = -rxt(k,780)*y(k,217) - mat(k,2806) = .700_r8*rxt(k,778)*y(k,309) - mat(k,2114) = .300_r8*rxt(k,589)*y(k,256) - mat(k,2325) = .080_r8*rxt(k,629)*y(k,256) - mat(k,3196) = .300_r8*rxt(k,589)*y(k,235) + .080_r8*rxt(k,629)*y(k,243) & - + .100_r8*rxt(k,777)*y(k,309) - mat(k,927) = .700_r8*rxt(k,778)*y(k,147) + .100_r8*rxt(k,777)*y(k,256) - mat(k,671) = -(rxt(k,779)*y(k,293)) - mat(k,3616) = -rxt(k,779)*y(k,218) - mat(k,3170) = .180_r8*rxt(k,648)*y(k,279) + .160_r8*rxt(k,668)*y(k,288) - mat(k,2292) = .180_r8*rxt(k,648)*y(k,256) - mat(k,2351) = .160_r8*rxt(k,668)*y(k,256) - mat(k,1463) = -(rxt(k,784)*y(k,293)) - mat(k,3688) = -rxt(k,784)*y(k,219) - mat(k,2831) = .100_r8*rxt(k,598)*y(k,236) + .420_r8*rxt(k,630)*y(k,243) & - + .020_r8*rxt(k,638)*y(k,244) + .300_r8*rxt(k,697)*y(k,299) & - + .090_r8*rxt(k,742)*y(k,304) + .700_r8*rxt(k,782)*y(k,310) - mat(k,3027) = .450_r8*rxt(k,631)*y(k,243) - mat(k,1155) = rxt(k,770)*y(k,293) - mat(k,872) = rxt(k,771)*y(k,293) - mat(k,2118) = .180_r8*rxt(k,586)*y(k,235) + .090_r8*rxt(k,588)*y(k,251) - mat(k,2207) = .100_r8*rxt(k,598)*y(k,147) - mat(k,2329) = .420_r8*rxt(k,630)*y(k,147) + .450_r8*rxt(k,631)*y(k,149) & - + 1.840_r8*rxt(k,626)*y(k,243) + .450_r8*rxt(k,627)*y(k,250) & - + .560_r8*rxt(k,628)*y(k,251) + .230_r8*rxt(k,629)*y(k,256) & - + .450_r8*rxt(k,632)*y(k,300) + .450_r8*rxt(k,633)*y(k,302) & - + .450_r8*rxt(k,634)*y(k,305) - mat(k,2236) = .020_r8*rxt(k,638)*y(k,147) - mat(k,2652) = .450_r8*rxt(k,627)*y(k,243) - mat(k,3369) = .090_r8*rxt(k,588)*y(k,235) + .560_r8*rxt(k,628)*y(k,243) - mat(k,3227) = .230_r8*rxt(k,629)*y(k,243) + .100_r8*rxt(k,781)*y(k,310) - mat(k,3688) = mat(k,3688) + rxt(k,770)*y(k,212) + rxt(k,771)*y(k,213) - mat(k,2442) = .300_r8*rxt(k,697)*y(k,147) - mat(k,2508) = .450_r8*rxt(k,632)*y(k,243) - mat(k,2554) = .450_r8*rxt(k,633)*y(k,243) - mat(k,2462) = .090_r8*rxt(k,742)*y(k,147) - mat(k,2601) = .450_r8*rxt(k,634)*y(k,243) - mat(k,691) = .700_r8*rxt(k,782)*y(k,147) + .100_r8*rxt(k,781)*y(k,256) - mat(k,1590) = -(rxt(k,783)*y(k,293)) - mat(k,3697) = -rxt(k,783)*y(k,220) - mat(k,2839) = .020_r8*rxt(k,598)*y(k,236) + .040_r8*rxt(k,638)*y(k,244) & - + .330_r8*rxt(k,650)*y(k,279) + .060_r8*rxt(k,658)*y(k,280) & - + .040_r8*rxt(k,670)*y(k,288) + .100_r8*rxt(k,678)*y(k,289) & - + .120_r8*rxt(k,767)*y(k,307) - mat(k,3034) = .500_r8*rxt(k,765)*y(k,211) + .350_r8*rxt(k,651)*y(k,279) & - + .050_r8*rxt(k,671)*y(k,288) - mat(k,2388) = .500_r8*rxt(k,765)*y(k,149) - mat(k,2208) = .020_r8*rxt(k,598)*y(k,147) - mat(k,2237) = .040_r8*rxt(k,638)*y(k,147) - mat(k,2658) = .350_r8*rxt(k,646)*y(k,279) + .050_r8*rxt(k,666)*y(k,288) - mat(k,3377) = .420_r8*rxt(k,647)*y(k,279) + .140_r8*rxt(k,667)*y(k,288) - mat(k,3235) = .180_r8*rxt(k,648)*y(k,279) - mat(k,2300) = .330_r8*rxt(k,650)*y(k,147) + .350_r8*rxt(k,651)*y(k,149) & - + .350_r8*rxt(k,646)*y(k,250) + .420_r8*rxt(k,647)*y(k,251) & - + .180_r8*rxt(k,648)*y(k,256) + 1.440_r8*rxt(k,649)*y(k,279) & - + .350_r8*rxt(k,652)*y(k,300) + .350_r8*rxt(k,653)*y(k,302) & - + .350_r8*rxt(k,654)*y(k,305) - mat(k,2154) = .060_r8*rxt(k,658)*y(k,147) - mat(k,2359) = .040_r8*rxt(k,670)*y(k,147) + .050_r8*rxt(k,671)*y(k,149) & - + .050_r8*rxt(k,666)*y(k,250) + .140_r8*rxt(k,667)*y(k,251) & - + .380_r8*rxt(k,669)*y(k,288) + .050_r8*rxt(k,672)*y(k,300) & - + .050_r8*rxt(k,673)*y(k,302) + .050_r8*rxt(k,674)*y(k,305) - mat(k,2266) = .100_r8*rxt(k,678)*y(k,147) - mat(k,2510) = .350_r8*rxt(k,652)*y(k,279) + .050_r8*rxt(k,672)*y(k,288) - mat(k,2556) = .350_r8*rxt(k,653)*y(k,279) + .050_r8*rxt(k,673)*y(k,288) - mat(k,2603) = .350_r8*rxt(k,654)*y(k,279) + .050_r8*rxt(k,674)*y(k,288) - mat(k,844) = .120_r8*rxt(k,767)*y(k,147) - mat(k,1396) = -(rxt(k,788)*y(k,293)) - mat(k,3684) = -rxt(k,788)*y(k,221) - mat(k,2829) = .050_r8*rxt(k,598)*y(k,236) + .050_r8*rxt(k,630)*y(k,243) & - + .060_r8*rxt(k,638)*y(k,244) + .170_r8*rxt(k,713)*y(k,301) & - + .300_r8*rxt(k,732)*y(k,303) + .700_r8*rxt(k,786)*y(k,311) - mat(k,3026) = .050_r8*rxt(k,631)*y(k,243) - mat(k,1033) = rxt(k,780)*y(k,293) - mat(k,2117) = .540_r8*rxt(k,586)*y(k,235) + .090_r8*rxt(k,588)*y(k,251) - mat(k,2206) = .050_r8*rxt(k,598)*y(k,147) - mat(k,2328) = .050_r8*rxt(k,630)*y(k,147) + .050_r8*rxt(k,631)*y(k,149) & - + .280_r8*rxt(k,626)*y(k,243) + .050_r8*rxt(k,627)*y(k,250) & - + .080_r8*rxt(k,628)*y(k,251) + .050_r8*rxt(k,632)*y(k,300) & - + .050_r8*rxt(k,633)*y(k,302) + .050_r8*rxt(k,634)*y(k,305) - mat(k,2235) = .060_r8*rxt(k,638)*y(k,147) - mat(k,2651) = .050_r8*rxt(k,627)*y(k,243) - mat(k,3368) = .090_r8*rxt(k,588)*y(k,235) + .080_r8*rxt(k,628)*y(k,243) - mat(k,3223) = .100_r8*rxt(k,785)*y(k,311) - mat(k,3684) = mat(k,3684) + rxt(k,780)*y(k,217) - mat(k,2507) = .050_r8*rxt(k,632)*y(k,243) - mat(k,2483) = .170_r8*rxt(k,713)*y(k,147) - mat(k,2553) = .050_r8*rxt(k,633)*y(k,243) - mat(k,2070) = .300_r8*rxt(k,732)*y(k,147) - mat(k,2600) = .050_r8*rxt(k,634)*y(k,243) - mat(k,699) = .700_r8*rxt(k,786)*y(k,147) + .100_r8*rxt(k,785)*y(k,256) - mat(k,1603) = -(rxt(k,787)*y(k,293)) - mat(k,3698) = -rxt(k,787)*y(k,222) - mat(k,2840) = .050_r8*rxt(k,598)*y(k,236) + .130_r8*rxt(k,638)*y(k,244) & - + .170_r8*rxt(k,650)*y(k,279) + .170_r8*rxt(k,658)*y(k,280) & - + .190_r8*rxt(k,678)*y(k,289) + .180_r8*rxt(k,767)*y(k,307) - mat(k,3035) = .190_r8*rxt(k,651)*y(k,279) - mat(k,2209) = .050_r8*rxt(k,598)*y(k,147) - mat(k,2238) = .130_r8*rxt(k,638)*y(k,147) - mat(k,2659) = .190_r8*rxt(k,646)*y(k,279) - mat(k,3378) = .270_r8*rxt(k,647)*y(k,279) + .090_r8*rxt(k,667)*y(k,288) - mat(k,3236) = .090_r8*rxt(k,648)*y(k,279) - mat(k,2301) = .170_r8*rxt(k,650)*y(k,147) + .190_r8*rxt(k,651)*y(k,149) & - + .190_r8*rxt(k,646)*y(k,250) + .270_r8*rxt(k,647)*y(k,251) & - + .090_r8*rxt(k,648)*y(k,256) + .840_r8*rxt(k,649)*y(k,279) & - + .190_r8*rxt(k,652)*y(k,300) + .190_r8*rxt(k,653)*y(k,302) & - + .190_r8*rxt(k,654)*y(k,305) - mat(k,2155) = .170_r8*rxt(k,658)*y(k,147) - mat(k,2360) = .090_r8*rxt(k,667)*y(k,251) + .540_r8*rxt(k,669)*y(k,288) - mat(k,2267) = .190_r8*rxt(k,678)*y(k,147) - mat(k,2511) = .190_r8*rxt(k,652)*y(k,279) - mat(k,2557) = .190_r8*rxt(k,653)*y(k,279) - mat(k,2604) = .190_r8*rxt(k,654)*y(k,279) - mat(k,845) = .180_r8*rxt(k,767)*y(k,147) + mat(k,1226) = -(rxt(k,769)*y(k,293)) + mat(k,3726) = -rxt(k,769)*y(k,212) + mat(k,3231) = .070_r8*rxt(k,589)*y(k,235) + .070_r8*rxt(k,629)*y(k,243) & + + .070_r8*rxt(k,649)*y(k,279) + .070_r8*rxt(k,669)*y(k,288) & + + .300_r8*rxt(k,773)*y(k,308) + .300_r8*rxt(k,777)*y(k,309) & + + .300_r8*rxt(k,781)*y(k,310) + .300_r8*rxt(k,785)*y(k,311) + mat(k,2290) = .070_r8*rxt(k,589)*y(k,147) + mat(k,2522) = .070_r8*rxt(k,629)*y(k,147) + mat(k,2490) = .070_r8*rxt(k,649)*y(k,147) + mat(k,2686) = .070_r8*rxt(k,669)*y(k,147) + mat(k,1217) = .300_r8*rxt(k,773)*y(k,147) + mat(k,1015) = .300_r8*rxt(k,777)*y(k,147) + mat(k,805) = .300_r8*rxt(k,781)*y(k,147) + mat(k,813) = .300_r8*rxt(k,785)*y(k,147) + mat(k,967) = -(rxt(k,770)*y(k,293)) + mat(k,3704) = -rxt(k,770)*y(k,213) + mat(k,3215) = .010_r8*rxt(k,597)*y(k,236) + .300_r8*rxt(k,688)*y(k,297) & + + .300_r8*rxt(k,692)*y(k,298) + .300_r8*rxt(k,761)*y(k,306) + mat(k,2453) = .010_r8*rxt(k,597)*y(k,147) + mat(k,3467) = .900_r8*rxt(k,772)*y(k,308) + .900_r8*rxt(k,776)*y(k,309) & + + .900_r8*rxt(k,780)*y(k,310) + .900_r8*rxt(k,784)*y(k,311) + mat(k,945) = .300_r8*rxt(k,688)*y(k,147) + mat(k,1003) = .300_r8*rxt(k,692)*y(k,147) + mat(k,796) = .300_r8*rxt(k,761)*y(k,147) + mat(k,1214) = .900_r8*rxt(k,772)*y(k,256) + mat(k,1012) = .900_r8*rxt(k,776)*y(k,256) + mat(k,804) = .900_r8*rxt(k,780)*y(k,256) + mat(k,812) = .900_r8*rxt(k,784)*y(k,256) + mat(k,1104) = -(rxt(k,771)*y(k,293)) + mat(k,3714) = -rxt(k,771)*y(k,214) + mat(k,1091) = .510_r8*rxt(k,642)*y(k,157) + mat(k,3222) = .020_r8*rxt(k,629)*y(k,243) + .240_r8*rxt(k,637)*y(k,244) + mat(k,3880) = .020_r8*rxt(k,630)*y(k,243) + .320_r8*rxt(k,638)*y(k,244) + mat(k,3056) = .510_r8*rxt(k,642)*y(k,17) + mat(k,2454) = .110_r8*rxt(k,595)*y(k,251) + mat(k,2520) = .020_r8*rxt(k,629)*y(k,147) + .020_r8*rxt(k,630)*y(k,149) & + + .080_r8*rxt(k,625)*y(k,243) + .020_r8*rxt(k,626)*y(k,250) & + + .020_r8*rxt(k,627)*y(k,251) + .020_r8*rxt(k,628)*y(k,256) & + + .020_r8*rxt(k,631)*y(k,300) + .020_r8*rxt(k,632)*y(k,302) & + + .020_r8*rxt(k,633)*y(k,305) + mat(k,2401) = .240_r8*rxt(k,637)*y(k,147) + .320_r8*rxt(k,638)*y(k,149) & + + .320_r8*rxt(k,634)*y(k,250) + .320_r8*rxt(k,635)*y(k,251) & + + .030_r8*rxt(k,636)*y(k,256) + .320_r8*rxt(k,639)*y(k,300) & + + .320_r8*rxt(k,640)*y(k,302) + .320_r8*rxt(k,641)*y(k,305) + mat(k,2966) = .020_r8*rxt(k,626)*y(k,243) + .320_r8*rxt(k,634)*y(k,244) + mat(k,3970) = .110_r8*rxt(k,595)*y(k,236) + .020_r8*rxt(k,627)*y(k,243) & + + .320_r8*rxt(k,635)*y(k,244) + mat(k,3474) = .020_r8*rxt(k,628)*y(k,243) + .030_r8*rxt(k,636)*y(k,244) + mat(k,2919) = .020_r8*rxt(k,631)*y(k,243) + .320_r8*rxt(k,639)*y(k,244) + mat(k,2826) = .020_r8*rxt(k,632)*y(k,243) + .320_r8*rxt(k,640)*y(k,244) + mat(k,2872) = .020_r8*rxt(k,633)*y(k,243) + .320_r8*rxt(k,641)*y(k,244) + mat(k,984) = -(rxt(k,775)*y(k,293)) + mat(k,3706) = -rxt(k,775)*y(k,215) + mat(k,3217) = .700_r8*rxt(k,773)*y(k,308) + mat(k,2519) = .450_r8*rxt(k,628)*y(k,256) + mat(k,3468) = .450_r8*rxt(k,628)*y(k,243) + .100_r8*rxt(k,772)*y(k,308) + mat(k,1215) = .700_r8*rxt(k,773)*y(k,147) + .100_r8*rxt(k,772)*y(k,256) + mat(k,666) = -(rxt(k,774)*y(k,293)) + mat(k,3672) = -rxt(k,774)*y(k,216) + mat(k,3440) = .320_r8*rxt(k,647)*y(k,279) + .360_r8*rxt(k,667)*y(k,288) + mat(k,2485) = .320_r8*rxt(k,647)*y(k,256) + mat(k,2681) = .360_r8*rxt(k,667)*y(k,256) + mat(k,1149) = -(rxt(k,779)*y(k,293)) + mat(k,3719) = -rxt(k,779)*y(k,217) + mat(k,3226) = .700_r8*rxt(k,777)*y(k,309) + mat(k,2289) = .300_r8*rxt(k,588)*y(k,256) + mat(k,2521) = .080_r8*rxt(k,628)*y(k,256) + mat(k,3478) = .300_r8*rxt(k,588)*y(k,235) + .080_r8*rxt(k,628)*y(k,243) & + + .100_r8*rxt(k,776)*y(k,309) + mat(k,1014) = .700_r8*rxt(k,777)*y(k,147) + .100_r8*rxt(k,776)*y(k,256) + mat(k,781) = -(rxt(k,778)*y(k,293)) + mat(k,3684) = -rxt(k,778)*y(k,218) + mat(k,3450) = .180_r8*rxt(k,647)*y(k,279) + .160_r8*rxt(k,667)*y(k,288) + mat(k,2486) = .180_r8*rxt(k,647)*y(k,256) + mat(k,2682) = .160_r8*rxt(k,667)*y(k,256) + mat(k,1555) = -(rxt(k,783)*y(k,293)) + mat(k,3755) = -rxt(k,783)*y(k,219) + mat(k,3251) = .100_r8*rxt(k,597)*y(k,236) + .420_r8*rxt(k,629)*y(k,243) & + + .020_r8*rxt(k,637)*y(k,244) + .300_r8*rxt(k,696)*y(k,299) & + + .090_r8*rxt(k,741)*y(k,304) + .700_r8*rxt(k,781)*y(k,310) + mat(k,3895) = .450_r8*rxt(k,630)*y(k,243) + mat(k,1227) = rxt(k,769)*y(k,293) + mat(k,968) = rxt(k,770)*y(k,293) + mat(k,2293) = .180_r8*rxt(k,585)*y(k,235) + .090_r8*rxt(k,587)*y(k,251) + mat(k,2457) = .100_r8*rxt(k,597)*y(k,147) + mat(k,2525) = .420_r8*rxt(k,629)*y(k,147) + .450_r8*rxt(k,630)*y(k,149) & + + 1.840_r8*rxt(k,625)*y(k,243) + .450_r8*rxt(k,626)*y(k,250) & + + .560_r8*rxt(k,627)*y(k,251) + .230_r8*rxt(k,628)*y(k,256) & + + .450_r8*rxt(k,631)*y(k,300) + .450_r8*rxt(k,632)*y(k,302) & + + .450_r8*rxt(k,633)*y(k,305) + mat(k,2403) = .020_r8*rxt(k,637)*y(k,147) + mat(k,2972) = .450_r8*rxt(k,626)*y(k,243) + mat(k,3986) = .090_r8*rxt(k,587)*y(k,235) + .560_r8*rxt(k,627)*y(k,243) + mat(k,3505) = .230_r8*rxt(k,628)*y(k,243) + .100_r8*rxt(k,780)*y(k,310) + mat(k,3755) = mat(k,3755) + rxt(k,769)*y(k,212) + rxt(k,770)*y(k,213) + mat(k,2724) = .300_r8*rxt(k,696)*y(k,147) + mat(k,2921) = .450_r8*rxt(k,631)*y(k,243) + mat(k,2828) = .450_r8*rxt(k,632)*y(k,243) + mat(k,2745) = .090_r8*rxt(k,741)*y(k,147) + mat(k,2875) = .450_r8*rxt(k,633)*y(k,243) + mat(k,806) = .700_r8*rxt(k,781)*y(k,147) + .100_r8*rxt(k,780)*y(k,256) + mat(k,1687) = -(rxt(k,782)*y(k,293)) + mat(k,3763) = -rxt(k,782)*y(k,220) + mat(k,3256) = .020_r8*rxt(k,597)*y(k,236) + .040_r8*rxt(k,637)*y(k,244) & + + .330_r8*rxt(k,649)*y(k,279) + .060_r8*rxt(k,657)*y(k,280) & + + .040_r8*rxt(k,669)*y(k,288) + .100_r8*rxt(k,677)*y(k,289) & + + .120_r8*rxt(k,766)*y(k,307) + mat(k,3899) = .500_r8*rxt(k,764)*y(k,211) + .350_r8*rxt(k,650)*y(k,279) & + + .050_r8*rxt(k,670)*y(k,288) + mat(k,2346) = .500_r8*rxt(k,764)*y(k,149) + mat(k,2459) = .020_r8*rxt(k,597)*y(k,147) + mat(k,2405) = .040_r8*rxt(k,637)*y(k,147) + mat(k,2975) = .350_r8*rxt(k,645)*y(k,279) + .050_r8*rxt(k,665)*y(k,288) + mat(k,3991) = .420_r8*rxt(k,646)*y(k,279) + .140_r8*rxt(k,666)*y(k,288) + mat(k,3512) = .180_r8*rxt(k,647)*y(k,279) + mat(k,2495) = .330_r8*rxt(k,649)*y(k,147) + .350_r8*rxt(k,650)*y(k,149) & + + .350_r8*rxt(k,645)*y(k,250) + .420_r8*rxt(k,646)*y(k,251) & + + .180_r8*rxt(k,647)*y(k,256) + 1.440_r8*rxt(k,648)*y(k,279) & + + .350_r8*rxt(k,651)*y(k,300) + .350_r8*rxt(k,652)*y(k,302) & + + .350_r8*rxt(k,653)*y(k,305) + mat(k,2377) = .060_r8*rxt(k,657)*y(k,147) + mat(k,2691) = .040_r8*rxt(k,669)*y(k,147) + .050_r8*rxt(k,670)*y(k,149) & + + .050_r8*rxt(k,665)*y(k,250) + .140_r8*rxt(k,666)*y(k,251) & + + .380_r8*rxt(k,668)*y(k,288) + .050_r8*rxt(k,671)*y(k,300) & + + .050_r8*rxt(k,672)*y(k,302) + .050_r8*rxt(k,673)*y(k,305) + mat(k,2795) = .100_r8*rxt(k,677)*y(k,147) + mat(k,2923) = .350_r8*rxt(k,651)*y(k,279) + .050_r8*rxt(k,671)*y(k,288) + mat(k,2830) = .350_r8*rxt(k,652)*y(k,279) + .050_r8*rxt(k,672)*y(k,288) + mat(k,2877) = .350_r8*rxt(k,653)*y(k,279) + .050_r8*rxt(k,673)*y(k,288) + mat(k,954) = .120_r8*rxt(k,766)*y(k,147) + mat(k,1534) = -(rxt(k,787)*y(k,293)) + mat(k,3753) = -rxt(k,787)*y(k,221) + mat(k,3249) = .050_r8*rxt(k,597)*y(k,236) + .050_r8*rxt(k,629)*y(k,243) & + + .060_r8*rxt(k,637)*y(k,244) + .170_r8*rxt(k,712)*y(k,301) & + + .300_r8*rxt(k,731)*y(k,303) + .700_r8*rxt(k,785)*y(k,311) + mat(k,3894) = .050_r8*rxt(k,630)*y(k,243) + mat(k,1150) = rxt(k,779)*y(k,293) + mat(k,2292) = .540_r8*rxt(k,585)*y(k,235) + .090_r8*rxt(k,587)*y(k,251) + mat(k,2456) = .050_r8*rxt(k,597)*y(k,147) + mat(k,2524) = .050_r8*rxt(k,629)*y(k,147) + .050_r8*rxt(k,630)*y(k,149) & + + .280_r8*rxt(k,625)*y(k,243) + .050_r8*rxt(k,626)*y(k,250) & + + .080_r8*rxt(k,627)*y(k,251) + .050_r8*rxt(k,631)*y(k,300) & + + .050_r8*rxt(k,632)*y(k,302) + .050_r8*rxt(k,633)*y(k,305) + mat(k,2402) = .060_r8*rxt(k,637)*y(k,147) + mat(k,2970) = .050_r8*rxt(k,626)*y(k,243) + mat(k,3984) = .090_r8*rxt(k,587)*y(k,235) + .080_r8*rxt(k,627)*y(k,243) + mat(k,3503) = .100_r8*rxt(k,784)*y(k,311) + mat(k,3753) = mat(k,3753) + rxt(k,779)*y(k,217) + mat(k,2920) = .050_r8*rxt(k,631)*y(k,243) + mat(k,2767) = .170_r8*rxt(k,712)*y(k,147) + mat(k,2827) = .050_r8*rxt(k,632)*y(k,243) + mat(k,2231) = .300_r8*rxt(k,731)*y(k,147) + mat(k,2874) = .050_r8*rxt(k,633)*y(k,243) + mat(k,814) = .700_r8*rxt(k,785)*y(k,147) + .100_r8*rxt(k,784)*y(k,256) + mat(k,1700) = -(rxt(k,786)*y(k,293)) + mat(k,3764) = -rxt(k,786)*y(k,222) + mat(k,3257) = .050_r8*rxt(k,597)*y(k,236) + .130_r8*rxt(k,637)*y(k,244) & + + .170_r8*rxt(k,649)*y(k,279) + .170_r8*rxt(k,657)*y(k,280) & + + .190_r8*rxt(k,677)*y(k,289) + .180_r8*rxt(k,766)*y(k,307) + mat(k,3900) = .190_r8*rxt(k,650)*y(k,279) + mat(k,2460) = .050_r8*rxt(k,597)*y(k,147) + mat(k,2406) = .130_r8*rxt(k,637)*y(k,147) + mat(k,2976) = .190_r8*rxt(k,645)*y(k,279) + mat(k,3992) = .270_r8*rxt(k,646)*y(k,279) + .090_r8*rxt(k,666)*y(k,288) + mat(k,3513) = .090_r8*rxt(k,647)*y(k,279) + mat(k,2496) = .170_r8*rxt(k,649)*y(k,147) + .190_r8*rxt(k,650)*y(k,149) & + + .190_r8*rxt(k,645)*y(k,250) + .270_r8*rxt(k,646)*y(k,251) & + + .090_r8*rxt(k,647)*y(k,256) + .840_r8*rxt(k,648)*y(k,279) & + + .190_r8*rxt(k,651)*y(k,300) + .190_r8*rxt(k,652)*y(k,302) & + + .190_r8*rxt(k,653)*y(k,305) + mat(k,2378) = .170_r8*rxt(k,657)*y(k,147) + mat(k,2692) = .090_r8*rxt(k,666)*y(k,251) + .540_r8*rxt(k,668)*y(k,288) + mat(k,2796) = .190_r8*rxt(k,677)*y(k,147) + mat(k,2924) = .190_r8*rxt(k,651)*y(k,279) + mat(k,2831) = .190_r8*rxt(k,652)*y(k,279) + mat(k,2878) = .190_r8*rxt(k,653)*y(k,279) + mat(k,955) = .180_r8*rxt(k,766)*y(k,147) end do end subroutine nlnmat11 subroutine nlnmat12( avec_len, mat, y, rxt ) @@ -2743,292 +3010,292 @@ subroutine nlnmat12( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,589) = -(rxt(k,790)*y(k,293)) - mat(k,3608) = -rxt(k,790)*y(k,223) - mat(k,297) = rxt(k,759)*y(k,293) - mat(k,2202) = .400_r8*rxt(k,597)*y(k,256) - mat(k,2233) = .290_r8*rxt(k,637)*y(k,256) - mat(k,3163) = .400_r8*rxt(k,597)*y(k,236) + .290_r8*rxt(k,637)*y(k,244) & - + rxt(k,696)*y(k,299) + .620_r8*rxt(k,712)*y(k,301) - mat(k,3608) = mat(k,3608) + rxt(k,759)*y(k,209) - mat(k,2439) = rxt(k,696)*y(k,256) - mat(k,2482) = .620_r8*rxt(k,712)*y(k,256) - mat(k,526) = -(rxt(k,789)*y(k,293)) - mat(k,3600) = -rxt(k,789)*y(k,224) - mat(k,2773) = .700_r8*rxt(k,689)*y(k,297) - mat(k,3160) = .180_r8*rxt(k,688)*y(k,297) + .850_r8*rxt(k,731)*y(k,303) & - + .470_r8*rxt(k,741)*y(k,304) + .900_r8*rxt(k,761)*y(k,306) - mat(k,832) = .700_r8*rxt(k,689)*y(k,147) + .180_r8*rxt(k,688)*y(k,256) - mat(k,2069) = .850_r8*rxt(k,731)*y(k,256) - mat(k,2461) = .470_r8*rxt(k,741)*y(k,256) - mat(k,679) = .900_r8*rxt(k,761)*y(k,256) - mat(k,613) = -(rxt(k,574)*y(k,293)) - mat(k,3610) = -rxt(k,574)*y(k,225) - mat(k,3166) = rxt(k,572)*y(k,312) - mat(k,760) = rxt(k,572)*y(k,256) - mat(k,161) = -(rxt(k,575)*y(k,293)) - mat(k,3545) = -rxt(k,575)*y(k,226) - mat(k,179) = -(rxt(k,577)*y(k,293)) - mat(k,3548) = -rxt(k,577)*y(k,227) - mat(k,731) = -(rxt(k,580)*y(k,293)) - mat(k,3622) = -rxt(k,580)*y(k,228) - mat(k,3175) = rxt(k,578)*y(k,314) - mat(k,776) = rxt(k,578)*y(k,256) - mat(k,187) = -(rxt(k,583)*y(k,293)) - mat(k,3549) = -rxt(k,583)*y(k,229) - mat(k,180) = .150_r8*rxt(k,577)*y(k,293) - mat(k,3549) = mat(k,3549) + .150_r8*rxt(k,577)*y(k,227) - mat(k,350) = -(rxt(k,584)*y(k,293)) - mat(k,3575) = -rxt(k,584)*y(k,230) - mat(k,3146) = rxt(k,581)*y(k,316) - mat(k,442) = rxt(k,581)*y(k,256) - mat(k,462) = -(rxt(k,542)*y(k,256) + rxt(k,543)*y(k,147) + rxt(k,571) & + mat(k,673) = -(rxt(k,789)*y(k,293)) + mat(k,3673) = -rxt(k,789)*y(k,223) + mat(k,371) = rxt(k,758)*y(k,293) + mat(k,2452) = .400_r8*rxt(k,596)*y(k,256) + mat(k,2400) = .290_r8*rxt(k,636)*y(k,256) + mat(k,3441) = .400_r8*rxt(k,596)*y(k,236) + .290_r8*rxt(k,636)*y(k,244) & + + rxt(k,695)*y(k,299) + .620_r8*rxt(k,711)*y(k,301) + mat(k,3673) = mat(k,3673) + rxt(k,758)*y(k,209) + mat(k,2721) = rxt(k,695)*y(k,256) + mat(k,2766) = .620_r8*rxt(k,711)*y(k,256) + mat(k,598) = -(rxt(k,788)*y(k,293)) + mat(k,3664) = -rxt(k,788)*y(k,224) + mat(k,3194) = .700_r8*rxt(k,688)*y(k,297) + mat(k,3439) = .180_r8*rxt(k,687)*y(k,297) + .850_r8*rxt(k,730)*y(k,303) & + + .470_r8*rxt(k,740)*y(k,304) + .900_r8*rxt(k,760)*y(k,306) + mat(k,942) = .700_r8*rxt(k,688)*y(k,147) + .180_r8*rxt(k,687)*y(k,256) + mat(k,2230) = .850_r8*rxt(k,730)*y(k,256) + mat(k,2744) = .470_r8*rxt(k,740)*y(k,256) + mat(k,794) = .900_r8*rxt(k,760)*y(k,256) + mat(k,748) = -(rxt(k,573)*y(k,293)) + mat(k,3680) = -rxt(k,573)*y(k,225) + mat(k,3447) = rxt(k,571)*y(k,312) + mat(k,875) = rxt(k,571)*y(k,256) + mat(k,209) = -(rxt(k,574)*y(k,293)) + mat(k,3605) = -rxt(k,574)*y(k,226) + mat(k,227) = -(rxt(k,576)*y(k,293)) + mat(k,3608) = -rxt(k,576)*y(k,227) + mat(k,829) = -(rxt(k,579)*y(k,293)) + mat(k,3690) = -rxt(k,579)*y(k,228) + mat(k,3456) = rxt(k,577)*y(k,314) + mat(k,891) = rxt(k,577)*y(k,256) + mat(k,235) = -(rxt(k,582)*y(k,293)) + mat(k,3609) = -rxt(k,582)*y(k,229) + mat(k,228) = .150_r8*rxt(k,576)*y(k,293) + mat(k,3609) = mat(k,3609) + .150_r8*rxt(k,576)*y(k,227) + mat(k,426) = -(rxt(k,583)*y(k,293)) + mat(k,3640) = -rxt(k,583)*y(k,230) + mat(k,3427) = rxt(k,580)*y(k,316) + mat(k,532) = rxt(k,580)*y(k,256) + mat(k,547) = -(rxt(k,541)*y(k,256) + rxt(k,542)*y(k,147) + rxt(k,570) & *y(k,148)) - mat(k,3156) = -rxt(k,542)*y(k,233) - mat(k,2771) = -rxt(k,543)*y(k,233) - mat(k,3475) = -rxt(k,571)*y(k,233) - mat(k,199) = rxt(k,548)*y(k,293) - mat(k,3592) = rxt(k,548)*y(k,23) - mat(k,1132) = -(rxt(k,410)*y(k,256) + (rxt(k,411) + rxt(k,412)) * y(k,147)) - mat(k,3203) = -rxt(k,410)*y(k,234) - mat(k,2810) = -(rxt(k,411) + rxt(k,412)) * y(k,234) - mat(k,647) = rxt(k,413)*y(k,293) - mat(k,154) = rxt(k,414)*y(k,293) - mat(k,3659) = rxt(k,413)*y(k,2) + rxt(k,414)*y(k,15) - mat(k,2119) = -(4._r8*rxt(k,586)*y(k,235) + rxt(k,587)*y(k,250) + rxt(k,588) & - *y(k,251) + rxt(k,589)*y(k,256) + rxt(k,590)*y(k,147) + rxt(k,591) & - *y(k,149) + rxt(k,592)*y(k,300) + rxt(k,593)*y(k,302) + rxt(k,594) & + mat(k,3437) = -rxt(k,541)*y(k,233) + mat(k,3191) = -rxt(k,542)*y(k,233) + mat(k,4063) = -rxt(k,570)*y(k,233) + mat(k,244) = rxt(k,547)*y(k,293) + mat(k,3658) = rxt(k,547)*y(k,23) + mat(k,1198) = -(rxt(k,409)*y(k,256) + (rxt(k,410) + rxt(k,411)) * y(k,147)) + mat(k,3482) = -rxt(k,409)*y(k,234) + mat(k,3228) = -(rxt(k,410) + rxt(k,411)) * y(k,234) + mat(k,729) = rxt(k,412)*y(k,293) + mat(k,203) = rxt(k,413)*y(k,293) + mat(k,3723) = rxt(k,412)*y(k,2) + rxt(k,413)*y(k,15) + mat(k,2296) = -(4._r8*rxt(k,585)*y(k,235) + rxt(k,586)*y(k,250) + rxt(k,587) & + *y(k,251) + rxt(k,588)*y(k,256) + rxt(k,589)*y(k,147) + rxt(k,590) & + *y(k,149) + rxt(k,591)*y(k,300) + rxt(k,592)*y(k,302) + rxt(k,593) & *y(k,305)) - mat(k,2680) = -rxt(k,587)*y(k,235) - mat(k,3400) = -rxt(k,588)*y(k,235) - mat(k,3259) = -rxt(k,589)*y(k,235) - mat(k,2863) = -rxt(k,590)*y(k,235) - mat(k,3056) = -rxt(k,591)*y(k,235) - mat(k,2516) = -rxt(k,592)*y(k,235) - mat(k,2562) = -rxt(k,593)*y(k,235) - mat(k,2609) = -rxt(k,594)*y(k,235) - mat(k,1106) = rxt(k,585)*y(k,149) - mat(k,3056) = mat(k,3056) + rxt(k,585)*y(k,4) - mat(k,2214) = -(rxt(k,595)*y(k,250) + rxt(k,596)*y(k,251) + rxt(k,597) & - *y(k,256) + rxt(k,598)*y(k,147) + rxt(k,599)*y(k,149) + rxt(k,600) & - *y(k,300) + rxt(k,601)*y(k,302) + rxt(k,602)*y(k,305)) - mat(k,2685) = -rxt(k,595)*y(k,236) - mat(k,3405) = -rxt(k,596)*y(k,236) - mat(k,3264) = -rxt(k,597)*y(k,236) - mat(k,2868) = -rxt(k,598)*y(k,236) - mat(k,3061) = -rxt(k,599)*y(k,236) - mat(k,2521) = -rxt(k,600)*y(k,236) - mat(k,2567) = -rxt(k,601)*y(k,236) - mat(k,2614) = -rxt(k,602)*y(k,236) - mat(k,1108) = rxt(k,604)*y(k,293) - mat(k,3725) = rxt(k,604)*y(k,4) - mat(k,46) = -(rxt(k,843)*y(k,256) + rxt(k,844)*y(k,147)) - mat(k,3123) = -rxt(k,843)*y(k,237) - mat(k,2748) = -rxt(k,844)*y(k,237) - mat(k,1100) = rxt(k,846)*y(k,293) - mat(k,3523) = rxt(k,846)*y(k,4) - mat(k,2053) = -(4._r8*rxt(k,606)*y(k,238) + rxt(k,607)*y(k,250) + rxt(k,608) & - *y(k,251) + rxt(k,609)*y(k,256) + rxt(k,610)*y(k,147) + rxt(k,611) & - *y(k,149) + rxt(k,612)*y(k,300) + rxt(k,613)*y(k,302) + rxt(k,614) & + mat(k,3002) = -rxt(k,586)*y(k,235) + mat(k,4019) = -rxt(k,587)*y(k,235) + mat(k,3541) = -rxt(k,588)*y(k,235) + mat(k,3285) = -rxt(k,589)*y(k,235) + mat(k,3926) = -rxt(k,590)*y(k,235) + mat(k,2930) = -rxt(k,591)*y(k,235) + mat(k,2837) = -rxt(k,592)*y(k,235) + mat(k,2884) = -rxt(k,593)*y(k,235) + mat(k,1251) = rxt(k,584)*y(k,149) + mat(k,3926) = mat(k,3926) + rxt(k,584)*y(k,4) + mat(k,2466) = -(rxt(k,594)*y(k,250) + rxt(k,595)*y(k,251) + rxt(k,596) & + *y(k,256) + rxt(k,597)*y(k,147) + rxt(k,598)*y(k,149) + rxt(k,599) & + *y(k,300) + rxt(k,600)*y(k,302) + rxt(k,601)*y(k,305)) + mat(k,3009) = -rxt(k,594)*y(k,236) + mat(k,4026) = -rxt(k,595)*y(k,236) + mat(k,3548) = -rxt(k,596)*y(k,236) + mat(k,3292) = -rxt(k,597)*y(k,236) + mat(k,3933) = -rxt(k,598)*y(k,236) + mat(k,2937) = -rxt(k,599)*y(k,236) + mat(k,2844) = -rxt(k,600)*y(k,236) + mat(k,2891) = -rxt(k,601)*y(k,236) + mat(k,1253) = rxt(k,603)*y(k,293) + mat(k,3798) = rxt(k,603)*y(k,4) + mat(k,55) = -(rxt(k,842)*y(k,256) + rxt(k,843)*y(k,147)) + mat(k,3404) = -rxt(k,842)*y(k,237) + mat(k,3169) = -rxt(k,843)*y(k,237) + mat(k,1244) = rxt(k,845)*y(k,293) + mat(k,3584) = rxt(k,845)*y(k,4) + mat(k,2213) = -(4._r8*rxt(k,605)*y(k,238) + rxt(k,606)*y(k,250) + rxt(k,607) & + *y(k,251) + rxt(k,608)*y(k,256) + rxt(k,609)*y(k,147) + rxt(k,610) & + *y(k,149) + rxt(k,611)*y(k,300) + rxt(k,612)*y(k,302) + rxt(k,613) & *y(k,305)) - mat(k,2677) = -rxt(k,607)*y(k,238) - mat(k,3397) = -rxt(k,608)*y(k,238) - mat(k,3256) = -rxt(k,609)*y(k,238) - mat(k,2860) = -rxt(k,610)*y(k,238) - mat(k,3053) = -rxt(k,611)*y(k,238) - mat(k,2513) = -rxt(k,612)*y(k,238) - mat(k,2559) = -rxt(k,613)*y(k,238) - mat(k,2606) = -rxt(k,614)*y(k,238) - mat(k,861) = rxt(k,605)*y(k,149) - mat(k,3053) = mat(k,3053) + rxt(k,605)*y(k,7) - mat(k,2096) = -(rxt(k,615)*y(k,250) + rxt(k,616)*y(k,251) + rxt(k,617) & - *y(k,256) + rxt(k,618)*y(k,147) + rxt(k,619)*y(k,149) + rxt(k,620) & - *y(k,300) + rxt(k,621)*y(k,302) + rxt(k,622)*y(k,305)) - mat(k,2679) = -rxt(k,615)*y(k,239) - mat(k,3399) = -rxt(k,616)*y(k,239) - mat(k,3258) = -rxt(k,617)*y(k,239) - mat(k,2862) = -rxt(k,618)*y(k,239) - mat(k,3055) = -rxt(k,619)*y(k,239) - mat(k,2515) = -rxt(k,620)*y(k,239) - mat(k,2561) = -rxt(k,621)*y(k,239) - mat(k,2608) = -rxt(k,622)*y(k,239) - mat(k,862) = rxt(k,624)*y(k,293) - mat(k,3719) = rxt(k,624)*y(k,7) - mat(k,52) = -(rxt(k,848)*y(k,256) + rxt(k,849)*y(k,147)) - mat(k,3124) = -rxt(k,848)*y(k,240) - mat(k,2749) = -rxt(k,849)*y(k,240) - mat(k,857) = rxt(k,851)*y(k,293) - mat(k,3524) = rxt(k,851)*y(k,7) - mat(k,435) = -(rxt(k,545)*y(k,256) + rxt(k,546)*y(k,147)) - mat(k,3154) = -rxt(k,545)*y(k,241) - mat(k,2768) = -rxt(k,546)*y(k,241) - mat(k,134) = .350_r8*rxt(k,544)*y(k,293) - mat(k,324) = rxt(k,547)*y(k,293) - mat(k,3588) = .350_r8*rxt(k,544)*y(k,8) + rxt(k,547)*y(k,9) - mat(k,58) = -(rxt(k,853)*y(k,256) + rxt(k,854)*y(k,147)) - mat(k,3125) = -rxt(k,853)*y(k,242) - mat(k,2750) = -rxt(k,854)*y(k,242) - mat(k,130) = rxt(k,852)*y(k,293) - mat(k,3525) = rxt(k,852)*y(k,8) - mat(k,2332) = -(4._r8*rxt(k,626)*y(k,243) + rxt(k,627)*y(k,250) + rxt(k,628) & - *y(k,251) + rxt(k,629)*y(k,256) + rxt(k,630)*y(k,147) + rxt(k,631) & - *y(k,149) + rxt(k,632)*y(k,300) + rxt(k,633)*y(k,302) + rxt(k,634) & + mat(k,2998) = -rxt(k,606)*y(k,238) + mat(k,4015) = -rxt(k,607)*y(k,238) + mat(k,3537) = -rxt(k,608)*y(k,238) + mat(k,3281) = -rxt(k,609)*y(k,238) + mat(k,3922) = -rxt(k,610)*y(k,238) + mat(k,2927) = -rxt(k,611)*y(k,238) + mat(k,2834) = -rxt(k,612)*y(k,238) + mat(k,2881) = -rxt(k,613)*y(k,238) + mat(k,1031) = rxt(k,604)*y(k,149) + mat(k,3922) = mat(k,3922) + rxt(k,604)*y(k,7) + mat(k,2322) = -(rxt(k,614)*y(k,250) + rxt(k,615)*y(k,251) + rxt(k,616) & + *y(k,256) + rxt(k,617)*y(k,147) + rxt(k,618)*y(k,149) + rxt(k,619) & + *y(k,300) + rxt(k,620)*y(k,302) + rxt(k,621)*y(k,305)) + mat(k,3003) = -rxt(k,614)*y(k,239) + mat(k,4020) = -rxt(k,615)*y(k,239) + mat(k,3542) = -rxt(k,616)*y(k,239) + mat(k,3286) = -rxt(k,617)*y(k,239) + mat(k,3927) = -rxt(k,618)*y(k,239) + mat(k,2931) = -rxt(k,619)*y(k,239) + mat(k,2838) = -rxt(k,620)*y(k,239) + mat(k,2885) = -rxt(k,621)*y(k,239) + mat(k,1032) = rxt(k,623)*y(k,293) + mat(k,3792) = rxt(k,623)*y(k,7) + mat(k,61) = -(rxt(k,847)*y(k,256) + rxt(k,848)*y(k,147)) + mat(k,3405) = -rxt(k,847)*y(k,240) + mat(k,3170) = -rxt(k,848)*y(k,240) + mat(k,1026) = rxt(k,850)*y(k,293) + mat(k,3585) = rxt(k,850)*y(k,7) + mat(k,525) = -(rxt(k,544)*y(k,256) + rxt(k,545)*y(k,147)) + mat(k,3435) = -rxt(k,544)*y(k,241) + mat(k,3189) = -rxt(k,545)*y(k,241) + mat(k,183) = .350_r8*rxt(k,543)*y(k,293) + mat(k,416) = rxt(k,546)*y(k,293) + mat(k,3655) = .350_r8*rxt(k,543)*y(k,8) + rxt(k,546)*y(k,9) + mat(k,67) = -(rxt(k,852)*y(k,256) + rxt(k,853)*y(k,147)) + mat(k,3406) = -rxt(k,852)*y(k,242) + mat(k,3171) = -rxt(k,853)*y(k,242) + mat(k,179) = rxt(k,851)*y(k,293) + mat(k,3586) = rxt(k,851)*y(k,8) + mat(k,2530) = -(4._r8*rxt(k,625)*y(k,243) + rxt(k,626)*y(k,250) + rxt(k,627) & + *y(k,251) + rxt(k,628)*y(k,256) + rxt(k,629)*y(k,147) + rxt(k,630) & + *y(k,149) + rxt(k,631)*y(k,300) + rxt(k,632)*y(k,302) + rxt(k,633) & *y(k,305)) - mat(k,2689) = -rxt(k,627)*y(k,243) - mat(k,3409) = -rxt(k,628)*y(k,243) - mat(k,3268) = -rxt(k,629)*y(k,243) - mat(k,2872) = -rxt(k,630)*y(k,243) - mat(k,3065) = -rxt(k,631)*y(k,243) - mat(k,2525) = -rxt(k,632)*y(k,243) - mat(k,2571) = -rxt(k,633)*y(k,243) - mat(k,2618) = -rxt(k,634)*y(k,243) - mat(k,948) = rxt(k,625)*y(k,149) - mat(k,3065) = mat(k,3065) + rxt(k,625)*y(k,17) - mat(k,891) = rxt(k,776)*y(k,293) - mat(k,3729) = rxt(k,776)*y(k,215) - mat(k,2243) = -(rxt(k,635)*y(k,250) + rxt(k,636)*y(k,251) + rxt(k,637) & - *y(k,256) + rxt(k,638)*y(k,147) + rxt(k,639)*y(k,149) + rxt(k,640) & - *y(k,300) + rxt(k,641)*y(k,302) + rxt(k,642)*y(k,305)) - mat(k,2686) = -rxt(k,635)*y(k,244) - mat(k,3406) = -rxt(k,636)*y(k,244) - mat(k,3265) = -rxt(k,637)*y(k,244) - mat(k,2869) = -rxt(k,638)*y(k,244) - mat(k,3062) = -rxt(k,639)*y(k,244) - mat(k,2522) = -rxt(k,640)*y(k,244) - mat(k,2568) = -rxt(k,641)*y(k,244) - mat(k,2615) = -rxt(k,642)*y(k,244) - mat(k,947) = rxt(k,644)*y(k,293) - mat(k,3726) = rxt(k,644)*y(k,17) - mat(k,64) = -(rxt(k,856)*y(k,256) + rxt(k,857)*y(k,147)) - mat(k,3126) = -rxt(k,856)*y(k,245) - mat(k,2751) = -rxt(k,857)*y(k,245) - mat(k,939) = rxt(k,859)*y(k,293) - mat(k,3526) = rxt(k,859)*y(k,17) - mat(k,358) = -(rxt(k,549)*y(k,256) + rxt(k,551)*y(k,147)) - mat(k,3147) = -rxt(k,549)*y(k,246) - mat(k,2764) = -rxt(k,551)*y(k,246) - mat(k,287) = rxt(k,550)*y(k,293) - mat(k,164) = .070_r8*rxt(k,575)*y(k,293) - mat(k,181) = .060_r8*rxt(k,577)*y(k,293) - mat(k,3576) = rxt(k,550)*y(k,24) + .070_r8*rxt(k,575)*y(k,226) & - + .060_r8*rxt(k,577)*y(k,227) - mat(k,1243) = -(4._r8*rxt(k,325)*y(k,247) + rxt(k,326)*y(k,251) + rxt(k,327) & - *y(k,256) + rxt(k,328)*y(k,147)) - mat(k,3358) = -rxt(k,326)*y(k,247) - mat(k,3210) = -rxt(k,327)*y(k,247) - mat(k,2817) = -rxt(k,328)*y(k,247) - mat(k,292) = .500_r8*rxt(k,330)*y(k,293) - mat(k,260) = rxt(k,331)*y(k,57) + rxt(k,332)*y(k,293) - mat(k,3812) = rxt(k,331)*y(k,29) - mat(k,3670) = .500_r8*rxt(k,330)*y(k,28) + rxt(k,332)*y(k,29) - mat(k,975) = -(rxt(k,356)*y(k,251) + rxt(k,357)*y(k,256) + rxt(k,358) & + mat(k,3011) = -rxt(k,626)*y(k,243) + mat(k,4028) = -rxt(k,627)*y(k,243) + mat(k,3550) = -rxt(k,628)*y(k,243) + mat(k,3294) = -rxt(k,629)*y(k,243) + mat(k,3935) = -rxt(k,630)*y(k,243) + mat(k,2939) = -rxt(k,631)*y(k,243) + mat(k,2846) = -rxt(k,632)*y(k,243) + mat(k,2893) = -rxt(k,633)*y(k,243) + mat(k,1098) = rxt(k,624)*y(k,149) + mat(k,3935) = mat(k,3935) + rxt(k,624)*y(k,17) + mat(k,987) = rxt(k,775)*y(k,293) + mat(k,3800) = rxt(k,775)*y(k,215) + mat(k,2411) = -(rxt(k,634)*y(k,250) + rxt(k,635)*y(k,251) + rxt(k,636) & + *y(k,256) + rxt(k,637)*y(k,147) + rxt(k,638)*y(k,149) + rxt(k,639) & + *y(k,300) + rxt(k,640)*y(k,302) + rxt(k,641)*y(k,305)) + mat(k,3007) = -rxt(k,634)*y(k,244) + mat(k,4024) = -rxt(k,635)*y(k,244) + mat(k,3546) = -rxt(k,636)*y(k,244) + mat(k,3290) = -rxt(k,637)*y(k,244) + mat(k,3931) = -rxt(k,638)*y(k,244) + mat(k,2935) = -rxt(k,639)*y(k,244) + mat(k,2842) = -rxt(k,640)*y(k,244) + mat(k,2889) = -rxt(k,641)*y(k,244) + mat(k,1097) = rxt(k,643)*y(k,293) + mat(k,3796) = rxt(k,643)*y(k,17) + mat(k,73) = -(rxt(k,855)*y(k,256) + rxt(k,856)*y(k,147)) + mat(k,3407) = -rxt(k,855)*y(k,245) + mat(k,3172) = -rxt(k,856)*y(k,245) + mat(k,1088) = rxt(k,858)*y(k,293) + mat(k,3587) = rxt(k,858)*y(k,17) + mat(k,440) = -(rxt(k,548)*y(k,256) + rxt(k,550)*y(k,147)) + mat(k,3428) = -rxt(k,548)*y(k,246) + mat(k,3184) = -rxt(k,550)*y(k,246) + mat(k,351) = rxt(k,549)*y(k,293) + mat(k,212) = .070_r8*rxt(k,574)*y(k,293) + mat(k,229) = .060_r8*rxt(k,576)*y(k,293) + mat(k,3642) = rxt(k,549)*y(k,24) + .070_r8*rxt(k,574)*y(k,226) & + + .060_r8*rxt(k,576)*y(k,227) + mat(k,1348) = -(4._r8*rxt(k,324)*y(k,247) + rxt(k,325)*y(k,251) + rxt(k,326) & + *y(k,256) + rxt(k,327)*y(k,147)) + mat(k,3974) = -rxt(k,325)*y(k,247) + mat(k,3489) = -rxt(k,326)*y(k,247) + mat(k,3235) = -rxt(k,327)*y(k,247) + mat(k,356) = .500_r8*rxt(k,329)*y(k,293) + mat(k,315) = rxt(k,330)*y(k,57) + rxt(k,331)*y(k,293) + mat(k,3839) = rxt(k,330)*y(k,29) + mat(k,3736) = .500_r8*rxt(k,329)*y(k,28) + rxt(k,331)*y(k,29) + mat(k,1042) = -(rxt(k,355)*y(k,251) + rxt(k,356)*y(k,256) + rxt(k,357) & *y(k,147)) - mat(k,3352) = -rxt(k,356)*y(k,248) - mat(k,3191) = -rxt(k,357)*y(k,248) - mat(k,2800) = -rxt(k,358)*y(k,248) - mat(k,339) = rxt(k,359)*y(k,293) - mat(k,113) = rxt(k,360)*y(k,293) - mat(k,3644) = rxt(k,359)*y(k,31) + rxt(k,360)*y(k,32) - mat(k,604) = -(rxt(k,552)*y(k,256) + rxt(k,553)*y(k,147)) - mat(k,3165) = -rxt(k,552)*y(k,249) - mat(k,2777) = -rxt(k,553)*y(k,249) - mat(k,224) = rxt(k,554)*y(k,293) - mat(k,2777) = mat(k,2777) + rxt(k,543)*y(k,233) - mat(k,2911) = rxt(k,569)*y(k,164) - mat(k,406) = rxt(k,569)*y(k,157) - mat(k,463) = rxt(k,543)*y(k,147) + .400_r8*rxt(k,542)*y(k,256) - mat(k,3165) = mat(k,3165) + .400_r8*rxt(k,542)*y(k,233) - mat(k,3609) = rxt(k,554)*y(k,33) - mat(k,2699) = -(4._r8*rxt(k,336)*y(k,250) + rxt(k,337)*y(k,251) + rxt(k,338) & - *y(k,256) + rxt(k,339)*y(k,147) + rxt(k,352)*y(k,148) + rxt(k,382) & - *y(k,282) + rxt(k,389)*y(k,284) + rxt(k,401)*y(k,287) + rxt(k,425) & - *y(k,259) + rxt(k,431)*y(k,260) + rxt(k,445)*y(k,265) + rxt(k,449) & - *y(k,266) + rxt(k,475)*y(k,272) + rxt(k,492)*y(k,276) + rxt(k,496) & - *y(k,277) + rxt(k,587)*y(k,235) + rxt(k,595)*y(k,236) + rxt(k,607) & - *y(k,238) + rxt(k,615)*y(k,239) + rxt(k,627)*y(k,243) + rxt(k,635) & - *y(k,244) + rxt(k,646)*y(k,279) + rxt(k,655)*y(k,280) + rxt(k,666) & - *y(k,288) + rxt(k,675)*y(k,289) + rxt(k,694)*y(k,299) + rxt(k,702) & - *y(k,300) + rxt(k,710)*y(k,301) + rxt(k,720)*y(k,302) + rxt(k,729) & - *y(k,303) + rxt(k,750)*y(k,305)) - mat(k,3419) = -rxt(k,337)*y(k,250) - mat(k,3278) = -rxt(k,338)*y(k,250) - mat(k,2882) = -rxt(k,339)*y(k,250) - mat(k,3499) = -rxt(k,352)*y(k,250) - mat(k,1389) = -rxt(k,382)*y(k,250) - mat(k,1500) = -rxt(k,389)*y(k,250) - mat(k,1375) = -rxt(k,401)*y(k,250) - mat(k,1834) = -rxt(k,425)*y(k,250) - mat(k,1736) = -rxt(k,431)*y(k,250) - mat(k,1557) = -rxt(k,445)*y(k,250) - mat(k,1578) = -rxt(k,449)*y(k,250) - mat(k,2036) = -rxt(k,475)*y(k,250) - mat(k,1787) = -rxt(k,492)*y(k,250) - mat(k,1675) = -rxt(k,496)*y(k,250) - mat(k,2127) = -rxt(k,587)*y(k,250) - mat(k,2222) = -rxt(k,595)*y(k,250) - mat(k,2061) = -rxt(k,607)*y(k,250) - mat(k,2106) = -rxt(k,615)*y(k,250) - mat(k,2339) = -rxt(k,627)*y(k,250) - mat(k,2251) = -rxt(k,635)*y(k,250) - mat(k,2312) = -rxt(k,646)*y(k,250) - mat(k,2166) = -rxt(k,655)*y(k,250) - mat(k,2373) = -rxt(k,666)*y(k,250) - mat(k,2280) = -rxt(k,675)*y(k,250) - mat(k,2451) = -rxt(k,694)*y(k,250) - mat(k,2535) = -rxt(k,702)*y(k,250) - mat(k,2493) = -rxt(k,710)*y(k,250) - mat(k,2581) = -rxt(k,720)*y(k,250) - mat(k,2081) = -rxt(k,729)*y(k,250) - mat(k,2628) = -rxt(k,750)*y(k,250) - mat(k,1307) = rxt(k,333)*y(k,149) + rxt(k,334)*y(k,293) - mat(k,1846) = rxt(k,361)*y(k,149) + rxt(k,362)*y(k,293) - mat(k,469) = .500_r8*rxt(k,341)*y(k,293) - mat(k,550) = .060_r8*rxt(k,415)*y(k,293) - mat(k,562) = .060_r8*rxt(k,416)*y(k,293) - mat(k,809) = .300_r8*rxt(k,364)*y(k,293) - mat(k,1297) = .070_r8*rxt(k,487)*y(k,157) - mat(k,969) = .330_r8*rxt(k,663)*y(k,157) - mat(k,1754) = .100_r8*rxt(k,386)*y(k,157) - mat(k,1864) = .280_r8*rxt(k,404)*y(k,157) - mat(k,1364) = .560_r8*rxt(k,406)*y(k,293) - mat(k,1994) = .040_r8*rxt(k,502)*y(k,157) + .100_r8*rxt(k,503)*y(k,293) - mat(k,2882) = mat(k,2882) + .350_r8*rxt(k,393)*y(k,284) + rxt(k,396)*y(k,286) & - + .760_r8*rxt(k,538)*y(k,287) + rxt(k,371)*y(k,296) & - + .910_r8*rxt(k,742)*y(k,304) - mat(k,3075) = rxt(k,333)*y(k,46) + rxt(k,361)*y(k,50) + .350_r8*rxt(k,394) & - *y(k,284) + rxt(k,743)*y(k,304) - mat(k,2983) = .070_r8*rxt(k,487)*y(k,109) + .330_r8*rxt(k,663)*y(k,125) & - + .100_r8*rxt(k,386)*y(k,126) + .280_r8*rxt(k,404)*y(k,132) & - + .040_r8*rxt(k,502)*y(k,139) - mat(k,517) = 2.000_r8*rxt(k,738)*y(k,293) - mat(k,2699) = mat(k,2699) + .350_r8*rxt(k,389)*y(k,284) + .750_r8*rxt(k,401) & + mat(k,3969) = -rxt(k,355)*y(k,248) + mat(k,3472) = -rxt(k,356)*y(k,248) + mat(k,3220) = -rxt(k,357)*y(k,248) + mat(k,409) = rxt(k,358)*y(k,293) + mat(k,129) = rxt(k,359)*y(k,293) + mat(k,3710) = rxt(k,358)*y(k,31) + rxt(k,359)*y(k,32) + mat(k,709) = -(rxt(k,551)*y(k,256) + rxt(k,552)*y(k,147)) + mat(k,3444) = -rxt(k,551)*y(k,249) + mat(k,3198) = -rxt(k,552)*y(k,249) + mat(k,286) = rxt(k,553)*y(k,293) + mat(k,3198) = mat(k,3198) + rxt(k,542)*y(k,233) + mat(k,3046) = rxt(k,568)*y(k,164) + mat(k,506) = rxt(k,568)*y(k,157) + mat(k,548) = rxt(k,542)*y(k,147) + .400_r8*rxt(k,541)*y(k,256) + mat(k,3444) = mat(k,3444) + .400_r8*rxt(k,541)*y(k,233) + mat(k,3676) = rxt(k,553)*y(k,33) + mat(k,3023) = -(4._r8*rxt(k,335)*y(k,250) + rxt(k,336)*y(k,251) + rxt(k,337) & + *y(k,256) + rxt(k,338)*y(k,147) + rxt(k,351)*y(k,148) + rxt(k,381) & + *y(k,282) + rxt(k,388)*y(k,284) + rxt(k,400)*y(k,287) + rxt(k,424) & + *y(k,259) + rxt(k,430)*y(k,260) + rxt(k,444)*y(k,265) + rxt(k,448) & + *y(k,266) + rxt(k,474)*y(k,272) + rxt(k,491)*y(k,276) + rxt(k,495) & + *y(k,277) + rxt(k,586)*y(k,235) + rxt(k,594)*y(k,236) + rxt(k,606) & + *y(k,238) + rxt(k,614)*y(k,239) + rxt(k,626)*y(k,243) + rxt(k,634) & + *y(k,244) + rxt(k,645)*y(k,279) + rxt(k,654)*y(k,280) + rxt(k,665) & + *y(k,288) + rxt(k,674)*y(k,289) + rxt(k,693)*y(k,299) + rxt(k,701) & + *y(k,300) + rxt(k,709)*y(k,301) + rxt(k,719)*y(k,302) + rxt(k,728) & + *y(k,303) + rxt(k,749)*y(k,305)) + mat(k,4041) = -rxt(k,336)*y(k,250) + mat(k,3564) = -rxt(k,337)*y(k,250) + mat(k,3308) = -rxt(k,338)*y(k,250) + mat(k,4093) = -rxt(k,351)*y(k,250) + mat(k,1548) = -rxt(k,381)*y(k,250) + mat(k,1621) = -rxt(k,388)*y(k,250) + mat(k,1512) = -rxt(k,400)*y(k,250) + mat(k,1964) = -rxt(k,424)*y(k,250) + mat(k,2003) = -rxt(k,430)*y(k,250) + mat(k,1748) = -rxt(k,444)*y(k,250) + mat(k,1776) = -rxt(k,448)*y(k,250) + mat(k,2183) = -rxt(k,474)*y(k,250) + mat(k,1855) = -rxt(k,491)*y(k,250) + mat(k,1824) = -rxt(k,495)*y(k,250) + mat(k,2304) = -rxt(k,586)*y(k,250) + mat(k,2474) = -rxt(k,594)*y(k,250) + mat(k,2221) = -rxt(k,606)*y(k,250) + mat(k,2332) = -rxt(k,614)*y(k,250) + mat(k,2537) = -rxt(k,626)*y(k,250) + mat(k,2420) = -rxt(k,634)*y(k,250) + mat(k,2508) = -rxt(k,645)*y(k,250) + mat(k,2390) = -rxt(k,654)*y(k,250) + mat(k,2707) = -rxt(k,665)*y(k,250) + mat(k,2810) = -rxt(k,674)*y(k,250) + mat(k,2734) = -rxt(k,693)*y(k,250) + mat(k,2949) = -rxt(k,701)*y(k,250) + mat(k,2779) = -rxt(k,709)*y(k,250) + mat(k,2856) = -rxt(k,719)*y(k,250) + mat(k,2244) = -rxt(k,728)*y(k,250) + mat(k,2903) = -rxt(k,749)*y(k,250) + mat(k,1431) = rxt(k,332)*y(k,149) + rxt(k,333)*y(k,293) + mat(k,1911) = rxt(k,360)*y(k,149) + rxt(k,361)*y(k,293) + mat(k,702) = .500_r8*rxt(k,340)*y(k,293) + mat(k,628) = .060_r8*rxt(k,414)*y(k,293) + mat(k,686) = .060_r8*rxt(k,415)*y(k,293) + mat(k,964) = .300_r8*rxt(k,363)*y(k,293) + mat(k,1403) = .070_r8*rxt(k,486)*y(k,157) + mat(k,1078) = .330_r8*rxt(k,662)*y(k,157) + mat(k,2024) = .100_r8*rxt(k,385)*y(k,157) + mat(k,2049) = .280_r8*rxt(k,403)*y(k,157) + mat(k,1500) = .560_r8*rxt(k,405)*y(k,293) + mat(k,2141) = .040_r8*rxt(k,501)*y(k,157) + .100_r8*rxt(k,502)*y(k,293) + mat(k,3308) = mat(k,3308) + .350_r8*rxt(k,392)*y(k,284) + rxt(k,395)*y(k,286) & + + .760_r8*rxt(k,537)*y(k,287) + rxt(k,370)*y(k,296) & + + .910_r8*rxt(k,741)*y(k,304) + mat(k,3949) = rxt(k,332)*y(k,46) + rxt(k,360)*y(k,50) + .350_r8*rxt(k,393) & + *y(k,284) + rxt(k,742)*y(k,304) + mat(k,3126) = .070_r8*rxt(k,486)*y(k,109) + .330_r8*rxt(k,662)*y(k,125) & + + .100_r8*rxt(k,385)*y(k,126) + .280_r8*rxt(k,403)*y(k,132) & + + .040_r8*rxt(k,501)*y(k,139) + mat(k,661) = 2.000_r8*rxt(k,737)*y(k,293) + mat(k,3023) = mat(k,3023) + .350_r8*rxt(k,388)*y(k,284) + .750_r8*rxt(k,400) & *y(k,287) - mat(k,3419) = mat(k,3419) + .350_r8*rxt(k,390)*y(k,284) + .880_r8*rxt(k,402) & - *y(k,287) + .300_r8*rxt(k,369)*y(k,296) + rxt(k,740)*y(k,304) - mat(k,3278) = mat(k,3278) + .170_r8*rxt(k,391)*y(k,284) + .200_r8*rxt(k,395) & - *y(k,286) + .490_r8*rxt(k,403)*y(k,287) + .150_r8*rxt(k,370) & - *y(k,296) + .530_r8*rxt(k,741)*y(k,304) - mat(k,1500) = mat(k,1500) + .350_r8*rxt(k,393)*y(k,147) + .350_r8*rxt(k,394) & - *y(k,149) + .350_r8*rxt(k,389)*y(k,250) + .350_r8*rxt(k,390) & - *y(k,251) + .170_r8*rxt(k,391)*y(k,256) + 1.400_r8*rxt(k,392) & + mat(k,4041) = mat(k,4041) + .350_r8*rxt(k,389)*y(k,284) + .880_r8*rxt(k,401) & + *y(k,287) + .300_r8*rxt(k,368)*y(k,296) + rxt(k,739)*y(k,304) + mat(k,3564) = mat(k,3564) + .170_r8*rxt(k,390)*y(k,284) + .200_r8*rxt(k,394) & + *y(k,286) + .490_r8*rxt(k,402)*y(k,287) + .150_r8*rxt(k,369) & + *y(k,296) + .530_r8*rxt(k,740)*y(k,304) + mat(k,1621) = mat(k,1621) + .350_r8*rxt(k,392)*y(k,147) + .350_r8*rxt(k,393) & + *y(k,149) + .350_r8*rxt(k,388)*y(k,250) + .350_r8*rxt(k,389) & + *y(k,251) + .170_r8*rxt(k,390)*y(k,256) + 1.400_r8*rxt(k,391) & *y(k,284) - mat(k,658) = rxt(k,396)*y(k,147) + .200_r8*rxt(k,395)*y(k,256) - mat(k,1375) = mat(k,1375) + .760_r8*rxt(k,538)*y(k,147) + .750_r8*rxt(k,401) & - *y(k,250) + .880_r8*rxt(k,402)*y(k,251) + .490_r8*rxt(k,403) & + mat(k,740) = rxt(k,395)*y(k,147) + .200_r8*rxt(k,394)*y(k,256) + mat(k,1512) = mat(k,1512) + .760_r8*rxt(k,537)*y(k,147) + .750_r8*rxt(k,400) & + *y(k,250) + .880_r8*rxt(k,401)*y(k,251) + .490_r8*rxt(k,402) & *y(k,256) - mat(k,3739) = rxt(k,334)*y(k,46) + rxt(k,362)*y(k,50) + .500_r8*rxt(k,341) & - *y(k,52) + .060_r8*rxt(k,415)*y(k,98) + .060_r8*rxt(k,416) & - *y(k,99) + .300_r8*rxt(k,364)*y(k,104) + .560_r8*rxt(k,406) & - *y(k,134) + .100_r8*rxt(k,503)*y(k,139) + 2.000_r8*rxt(k,738) & + mat(k,3814) = rxt(k,333)*y(k,46) + rxt(k,361)*y(k,50) + .500_r8*rxt(k,340) & + *y(k,52) + .060_r8*rxt(k,414)*y(k,98) + .060_r8*rxt(k,415) & + *y(k,99) + .300_r8*rxt(k,363)*y(k,104) + .560_r8*rxt(k,405) & + *y(k,134) + .100_r8*rxt(k,502)*y(k,139) + 2.000_r8*rxt(k,737) & *y(k,204) - mat(k,1228) = rxt(k,371)*y(k,147) + .300_r8*rxt(k,369)*y(k,251) & - + .150_r8*rxt(k,370)*y(k,256) - mat(k,2535) = mat(k,2535) + rxt(k,744)*y(k,304) - mat(k,2581) = mat(k,2581) + rxt(k,745)*y(k,304) - mat(k,2472) = .910_r8*rxt(k,742)*y(k,147) + rxt(k,743)*y(k,149) + rxt(k,740) & - *y(k,251) + .530_r8*rxt(k,741)*y(k,256) + rxt(k,744)*y(k,300) & - + rxt(k,745)*y(k,302) + rxt(k,746)*y(k,305) - mat(k,2628) = mat(k,2628) + rxt(k,746)*y(k,304) + mat(k,1338) = rxt(k,370)*y(k,147) + .300_r8*rxt(k,368)*y(k,251) & + + .150_r8*rxt(k,369)*y(k,256) + mat(k,2949) = mat(k,2949) + rxt(k,743)*y(k,304) + mat(k,2856) = mat(k,2856) + rxt(k,744)*y(k,304) + mat(k,2756) = .910_r8*rxt(k,741)*y(k,147) + rxt(k,742)*y(k,149) + rxt(k,739) & + *y(k,251) + .530_r8*rxt(k,740)*y(k,256) + rxt(k,743)*y(k,300) & + + rxt(k,744)*y(k,302) + rxt(k,745)*y(k,305) + mat(k,2903) = mat(k,2903) + rxt(k,745)*y(k,304) end do end subroutine nlnmat12 subroutine nlnmat13( avec_len, mat, y, rxt ) @@ -3049,517 +3316,529 @@ subroutine nlnmat13( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,3429) = -(rxt(k,225)*y(k,60) + (4._r8*rxt(k,302) + 4._r8*rxt(k,303) & + mat(k,4052) = -(rxt(k,225)*y(k,60) + (4._r8*rxt(k,302) + 4._r8*rxt(k,303) & ) * y(k,251) + rxt(k,304)*y(k,256) + rxt(k,305)*y(k,147) & - + rxt(k,326)*y(k,247) + rxt(k,337)*y(k,250) + rxt(k,356) & - *y(k,248) + rxt(k,369)*y(k,296) + rxt(k,383)*y(k,282) + rxt(k,390) & - *y(k,284) + rxt(k,402)*y(k,287) + rxt(k,426)*y(k,259) + rxt(k,432) & - *y(k,260) + rxt(k,446)*y(k,265) + rxt(k,450)*y(k,266) + rxt(k,476) & - *y(k,272) + rxt(k,493)*y(k,276) + rxt(k,497)*y(k,277) + rxt(k,588) & - *y(k,235) + rxt(k,596)*y(k,236) + rxt(k,608)*y(k,238) + rxt(k,616) & - *y(k,239) + rxt(k,628)*y(k,243) + rxt(k,636)*y(k,244) + rxt(k,647) & - *y(k,279) + rxt(k,656)*y(k,280) + rxt(k,667)*y(k,288) + rxt(k,676) & - *y(k,289) + rxt(k,695)*y(k,299) + rxt(k,703)*y(k,300) + rxt(k,711) & - *y(k,301) + rxt(k,721)*y(k,302) + rxt(k,730)*y(k,303) + rxt(k,740) & - *y(k,304) + rxt(k,751)*y(k,305)) - mat(k,3314) = -rxt(k,225)*y(k,251) - mat(k,3288) = -rxt(k,304)*y(k,251) - mat(k,2892) = -rxt(k,305)*y(k,251) - mat(k,1249) = -rxt(k,326)*y(k,251) - mat(k,2707) = -rxt(k,337)*y(k,251) - mat(k,981) = -rxt(k,356)*y(k,251) - mat(k,1232) = -rxt(k,369)*y(k,251) - mat(k,1393) = -rxt(k,383)*y(k,251) - mat(k,1506) = -rxt(k,390)*y(k,251) - mat(k,1379) = -rxt(k,402)*y(k,251) - mat(k,1840) = -rxt(k,426)*y(k,251) - mat(k,1742) = -rxt(k,432)*y(k,251) - mat(k,1562) = -rxt(k,446)*y(k,251) - mat(k,1583) = -rxt(k,450)*y(k,251) - mat(k,2044) = -rxt(k,476)*y(k,251) - mat(k,1792) = -rxt(k,493)*y(k,251) - mat(k,1680) = -rxt(k,497)*y(k,251) - mat(k,2133) = -rxt(k,588)*y(k,251) - mat(k,2229) = -rxt(k,596)*y(k,251) - mat(k,2066) = -rxt(k,608)*y(k,251) - mat(k,2111) = -rxt(k,616)*y(k,251) - mat(k,2346) = -rxt(k,628)*y(k,251) - mat(k,2258) = -rxt(k,636)*y(k,251) - mat(k,2319) = -rxt(k,647)*y(k,251) - mat(k,2172) = -rxt(k,656)*y(k,251) - mat(k,2380) = -rxt(k,667)*y(k,251) - mat(k,2287) = -rxt(k,676)*y(k,251) - mat(k,2458) = -rxt(k,695)*y(k,251) - mat(k,2543) = -rxt(k,703)*y(k,251) - mat(k,2500) = -rxt(k,711)*y(k,251) - mat(k,2589) = -rxt(k,721)*y(k,251) - mat(k,2088) = -rxt(k,730)*y(k,251) - mat(k,2479) = -rxt(k,740)*y(k,251) - mat(k,2636) = -rxt(k,751)*y(k,251) - mat(k,1207) = .280_r8*rxt(k,355)*y(k,157) - mat(k,531) = rxt(k,340)*y(k,293) - mat(k,373) = .700_r8*rxt(k,307)*y(k,293) - mat(k,552) = .060_r8*rxt(k,415)*y(k,293) - mat(k,564) = .060_r8*rxt(k,416)*y(k,293) - mat(k,1302) = .210_r8*rxt(k,487)*y(k,157) - mat(k,2892) = mat(k,2892) + rxt(k,339)*y(k,250) + .830_r8*rxt(k,557)*y(k,252) & - + .650_r8*rxt(k,393)*y(k,284) + .170_r8*rxt(k,563)*y(k,285) - mat(k,3085) = .650_r8*rxt(k,394)*y(k,284) - mat(k,2993) = .280_r8*rxt(k,355)*y(k,30) + .210_r8*rxt(k,487)*y(k,109) - mat(k,2133) = mat(k,2133) + rxt(k,587)*y(k,250) - mat(k,2229) = mat(k,2229) + rxt(k,595)*y(k,250) - mat(k,2066) = mat(k,2066) + rxt(k,607)*y(k,250) - mat(k,2111) = mat(k,2111) + rxt(k,615)*y(k,250) - mat(k,2346) = mat(k,2346) + rxt(k,627)*y(k,250) - mat(k,2258) = mat(k,2258) + rxt(k,635)*y(k,250) - mat(k,2707) = mat(k,2707) + rxt(k,339)*y(k,147) + rxt(k,587)*y(k,235) & - + rxt(k,595)*y(k,236) + rxt(k,607)*y(k,238) + rxt(k,615) & - *y(k,239) + rxt(k,627)*y(k,243) + rxt(k,635)*y(k,244) & - + 4.000_r8*rxt(k,336)*y(k,250) + .900_r8*rxt(k,337)*y(k,251) & - + .490_r8*rxt(k,338)*y(k,256) + rxt(k,425)*y(k,259) + rxt(k,431) & - *y(k,260) + rxt(k,445)*y(k,265) + rxt(k,449)*y(k,266) & - + rxt(k,475)*y(k,272) + rxt(k,492)*y(k,276) + rxt(k,496) & - *y(k,277) + rxt(k,646)*y(k,279) + rxt(k,655)*y(k,280) & - + rxt(k,382)*y(k,282) + 1.650_r8*rxt(k,389)*y(k,284) & - + rxt(k,401)*y(k,287) + rxt(k,666)*y(k,288) + rxt(k,675) & - *y(k,289) + rxt(k,694)*y(k,299) + rxt(k,702)*y(k,300) & - + rxt(k,710)*y(k,301) + rxt(k,720)*y(k,302) + rxt(k,729) & - *y(k,303) + rxt(k,739)*y(k,304) + rxt(k,750)*y(k,305) - mat(k,3429) = mat(k,3429) + .900_r8*rxt(k,337)*y(k,250) + .650_r8*rxt(k,390) & + + rxt(k,325)*y(k,247) + rxt(k,336)*y(k,250) + rxt(k,355) & + *y(k,248) + rxt(k,368)*y(k,296) + rxt(k,382)*y(k,282) + rxt(k,389) & + *y(k,284) + rxt(k,401)*y(k,287) + rxt(k,425)*y(k,259) + rxt(k,431) & + *y(k,260) + rxt(k,445)*y(k,265) + rxt(k,449)*y(k,266) + rxt(k,475) & + *y(k,272) + rxt(k,492)*y(k,276) + rxt(k,496)*y(k,277) + rxt(k,587) & + *y(k,235) + rxt(k,595)*y(k,236) + rxt(k,607)*y(k,238) + rxt(k,615) & + *y(k,239) + rxt(k,627)*y(k,243) + rxt(k,635)*y(k,244) + rxt(k,646) & + *y(k,279) + rxt(k,655)*y(k,280) + rxt(k,666)*y(k,288) + rxt(k,675) & + *y(k,289) + rxt(k,694)*y(k,299) + rxt(k,702)*y(k,300) + rxt(k,710) & + *y(k,301) + rxt(k,720)*y(k,302) + rxt(k,729)*y(k,303) + rxt(k,739) & + *y(k,304) + rxt(k,750)*y(k,305)) + mat(k,2609) = -rxt(k,225)*y(k,251) + mat(k,3575) = -rxt(k,304)*y(k,251) + mat(k,3319) = -rxt(k,305)*y(k,251) + mat(k,1355) = -rxt(k,325)*y(k,251) + mat(k,3034) = -rxt(k,336)*y(k,251) + mat(k,1049) = -rxt(k,355)*y(k,251) + mat(k,1343) = -rxt(k,368)*y(k,251) + mat(k,1553) = -rxt(k,382)*y(k,251) + mat(k,1629) = -rxt(k,389)*y(k,251) + mat(k,1517) = -rxt(k,401)*y(k,251) + mat(k,1972) = -rxt(k,425)*y(k,251) + mat(k,2011) = -rxt(k,431)*y(k,251) + mat(k,1754) = -rxt(k,445)*y(k,251) + mat(k,1782) = -rxt(k,449)*y(k,251) + mat(k,2194) = -rxt(k,475)*y(k,251) + mat(k,1861) = -rxt(k,492)*y(k,251) + mat(k,1830) = -rxt(k,496)*y(k,251) + mat(k,2312) = -rxt(k,587)*y(k,251) + mat(k,2482) = -rxt(k,595)*y(k,251) + mat(k,2228) = -rxt(k,607)*y(k,251) + mat(k,2339) = -rxt(k,615)*y(k,251) + mat(k,2545) = -rxt(k,627)*y(k,251) + mat(k,2428) = -rxt(k,635)*y(k,251) + mat(k,2516) = -rxt(k,646)*y(k,251) + mat(k,2398) = -rxt(k,655)*y(k,251) + mat(k,2718) = -rxt(k,666)*y(k,251) + mat(k,2821) = -rxt(k,675)*y(k,251) + mat(k,2742) = -rxt(k,694)*y(k,251) + mat(k,2960) = -rxt(k,702)*y(k,251) + mat(k,2787) = -rxt(k,710)*y(k,251) + mat(k,2867) = -rxt(k,720)*y(k,251) + mat(k,2252) = -rxt(k,729)*y(k,251) + mat(k,2764) = -rxt(k,739)*y(k,251) + mat(k,2914) = -rxt(k,750)*y(k,251) + mat(k,1378) = .280_r8*rxt(k,354)*y(k,157) + mat(k,792) = rxt(k,339)*y(k,293) + mat(k,463) = .700_r8*rxt(k,307)*y(k,293) + mat(k,2270) = rxt(k,219)*y(k,57) + rxt(k,275)*y(k,75) + rxt(k,315)*y(k,292) & + + rxt(k,308)*y(k,293) + mat(k,3866) = rxt(k,219)*y(k,55) + mat(k,1285) = rxt(k,275)*y(k,55) + mat(k,631) = .060_r8*rxt(k,414)*y(k,293) + mat(k,690) = .060_r8*rxt(k,415)*y(k,293) + mat(k,1409) = .210_r8*rxt(k,486)*y(k,157) + mat(k,3319) = mat(k,3319) + rxt(k,338)*y(k,250) + .830_r8*rxt(k,556)*y(k,252) & + + .650_r8*rxt(k,392)*y(k,284) + .170_r8*rxt(k,562)*y(k,285) + mat(k,3960) = .650_r8*rxt(k,393)*y(k,284) + mat(k,3137) = .280_r8*rxt(k,354)*y(k,30) + .210_r8*rxt(k,486)*y(k,109) + mat(k,2312) = mat(k,2312) + rxt(k,586)*y(k,250) + mat(k,2482) = mat(k,2482) + rxt(k,594)*y(k,250) + mat(k,2228) = mat(k,2228) + rxt(k,606)*y(k,250) + mat(k,2339) = mat(k,2339) + rxt(k,614)*y(k,250) + mat(k,2545) = mat(k,2545) + rxt(k,626)*y(k,250) + mat(k,2428) = mat(k,2428) + rxt(k,634)*y(k,250) + mat(k,3034) = mat(k,3034) + rxt(k,338)*y(k,147) + rxt(k,586)*y(k,235) & + + rxt(k,594)*y(k,236) + rxt(k,606)*y(k,238) + rxt(k,614) & + *y(k,239) + rxt(k,626)*y(k,243) + rxt(k,634)*y(k,244) & + + 4.000_r8*rxt(k,335)*y(k,250) + .900_r8*rxt(k,336)*y(k,251) & + + .490_r8*rxt(k,337)*y(k,256) + rxt(k,424)*y(k,259) + rxt(k,430) & + *y(k,260) + rxt(k,444)*y(k,265) + rxt(k,448)*y(k,266) & + + rxt(k,474)*y(k,272) + rxt(k,491)*y(k,276) + rxt(k,495) & + *y(k,277) + rxt(k,645)*y(k,279) + rxt(k,654)*y(k,280) & + + rxt(k,381)*y(k,282) + 1.650_r8*rxt(k,388)*y(k,284) & + + rxt(k,400)*y(k,287) + rxt(k,665)*y(k,288) + rxt(k,674) & + *y(k,289) + rxt(k,693)*y(k,299) + rxt(k,701)*y(k,300) & + + rxt(k,709)*y(k,301) + rxt(k,719)*y(k,302) + rxt(k,728) & + *y(k,303) + rxt(k,738)*y(k,304) + rxt(k,749)*y(k,305) + mat(k,4052) = mat(k,4052) + .900_r8*rxt(k,336)*y(k,250) + .650_r8*rxt(k,389) & *y(k,284) - mat(k,794) = .830_r8*rxt(k,557)*y(k,147) + .330_r8*rxt(k,556)*y(k,256) - mat(k,3288) = mat(k,3288) + .490_r8*rxt(k,338)*y(k,250) + .330_r8*rxt(k,556) & - *y(k,252) + .320_r8*rxt(k,391)*y(k,284) + .070_r8*rxt(k,562) & + mat(k,910) = .830_r8*rxt(k,556)*y(k,147) + .330_r8*rxt(k,555)*y(k,256) + mat(k,3575) = mat(k,3575) + .490_r8*rxt(k,337)*y(k,250) + .330_r8*rxt(k,555) & + *y(k,252) + .320_r8*rxt(k,390)*y(k,284) + .070_r8*rxt(k,561) & *y(k,285) - mat(k,1840) = mat(k,1840) + rxt(k,425)*y(k,250) - mat(k,1742) = mat(k,1742) + rxt(k,431)*y(k,250) - mat(k,1562) = mat(k,1562) + rxt(k,445)*y(k,250) - mat(k,1583) = mat(k,1583) + rxt(k,449)*y(k,250) - mat(k,2044) = mat(k,2044) + rxt(k,475)*y(k,250) - mat(k,1792) = mat(k,1792) + rxt(k,492)*y(k,250) - mat(k,1680) = mat(k,1680) + rxt(k,496)*y(k,250) - mat(k,2319) = mat(k,2319) + rxt(k,646)*y(k,250) - mat(k,2172) = mat(k,2172) + rxt(k,655)*y(k,250) - mat(k,1393) = mat(k,1393) + rxt(k,382)*y(k,250) - mat(k,1506) = mat(k,1506) + .650_r8*rxt(k,393)*y(k,147) + .650_r8*rxt(k,394) & - *y(k,149) + 1.650_r8*rxt(k,389)*y(k,250) + .650_r8*rxt(k,390) & - *y(k,251) + .320_r8*rxt(k,391)*y(k,256) + 2.600_r8*rxt(k,392) & + mat(k,1972) = mat(k,1972) + rxt(k,424)*y(k,250) + mat(k,2011) = mat(k,2011) + rxt(k,430)*y(k,250) + mat(k,1754) = mat(k,1754) + rxt(k,444)*y(k,250) + mat(k,1782) = mat(k,1782) + rxt(k,448)*y(k,250) + mat(k,2194) = mat(k,2194) + rxt(k,474)*y(k,250) + mat(k,1861) = mat(k,1861) + rxt(k,491)*y(k,250) + mat(k,1830) = mat(k,1830) + rxt(k,495)*y(k,250) + mat(k,2516) = mat(k,2516) + rxt(k,645)*y(k,250) + mat(k,2398) = mat(k,2398) + rxt(k,654)*y(k,250) + mat(k,1553) = mat(k,1553) + rxt(k,381)*y(k,250) + mat(k,1629) = mat(k,1629) + .650_r8*rxt(k,392)*y(k,147) + .650_r8*rxt(k,393) & + *y(k,149) + 1.650_r8*rxt(k,388)*y(k,250) + .650_r8*rxt(k,389) & + *y(k,251) + .320_r8*rxt(k,390)*y(k,256) + 2.600_r8*rxt(k,391) & *y(k,284) - mat(k,818) = .170_r8*rxt(k,563)*y(k,147) + .070_r8*rxt(k,562)*y(k,256) - mat(k,1379) = mat(k,1379) + rxt(k,401)*y(k,250) - mat(k,2380) = mat(k,2380) + rxt(k,666)*y(k,250) - mat(k,2287) = mat(k,2287) + rxt(k,675)*y(k,250) - mat(k,3749) = rxt(k,340)*y(k,51) + .700_r8*rxt(k,307)*y(k,54) & - + .060_r8*rxt(k,415)*y(k,98) + .060_r8*rxt(k,416)*y(k,99) - mat(k,2458) = mat(k,2458) + rxt(k,694)*y(k,250) - mat(k,2543) = mat(k,2543) + rxt(k,702)*y(k,250) - mat(k,2500) = mat(k,2500) + rxt(k,710)*y(k,250) - mat(k,2589) = mat(k,2589) + rxt(k,720)*y(k,250) - mat(k,2088) = mat(k,2088) + rxt(k,729)*y(k,250) - mat(k,2479) = mat(k,2479) + rxt(k,739)*y(k,250) - mat(k,2636) = mat(k,2636) + rxt(k,750)*y(k,250) - mat(k,789) = -(rxt(k,556)*y(k,256) + rxt(k,557)*y(k,147) + rxt(k,558) & + mat(k,929) = .170_r8*rxt(k,562)*y(k,147) + .070_r8*rxt(k,561)*y(k,256) + mat(k,1517) = mat(k,1517) + rxt(k,400)*y(k,250) + mat(k,2718) = mat(k,2718) + rxt(k,665)*y(k,250) + mat(k,2821) = mat(k,2821) + rxt(k,674)*y(k,250) + mat(k,2650) = rxt(k,315)*y(k,55) + mat(k,3825) = rxt(k,339)*y(k,51) + .700_r8*rxt(k,307)*y(k,54) + rxt(k,308) & + *y(k,55) + .060_r8*rxt(k,414)*y(k,98) + .060_r8*rxt(k,415) & + *y(k,99) + mat(k,2742) = mat(k,2742) + rxt(k,693)*y(k,250) + mat(k,2960) = mat(k,2960) + rxt(k,701)*y(k,250) + mat(k,2787) = mat(k,2787) + rxt(k,709)*y(k,250) + mat(k,2867) = mat(k,2867) + rxt(k,719)*y(k,250) + mat(k,2252) = mat(k,2252) + rxt(k,728)*y(k,250) + mat(k,2764) = mat(k,2764) + rxt(k,738)*y(k,250) + mat(k,2914) = mat(k,2914) + rxt(k,749)*y(k,250) + mat(k,904) = -(rxt(k,555)*y(k,256) + rxt(k,556)*y(k,147) + rxt(k,557) & *y(k,148)) - mat(k,3180) = -rxt(k,556)*y(k,252) - mat(k,2788) = -rxt(k,557)*y(k,252) - mat(k,3481) = -rxt(k,558)*y(k,252) - mat(k,534) = -((rxt(k,378) + rxt(k,379)) * y(k,147)) - mat(k,2774) = -(rxt(k,378) + rxt(k,379)) * y(k,253) - mat(k,309) = rxt(k,376)*y(k,293) - mat(k,3602) = rxt(k,376)*y(k,16) - mat(k,2759) = .750_r8*rxt(k,343)*y(k,255) - mat(k,743) = .750_r8*rxt(k,343)*y(k,147) - mat(k,744) = -(rxt(k,342)*y(k,256) + rxt(k,343)*y(k,147)) - mat(k,3176) = -rxt(k,342)*y(k,255) - mat(k,2784) = -rxt(k,343)*y(k,255) - mat(k,499) = rxt(k,351)*y(k,293) - mat(k,3623) = rxt(k,351)*y(k,26) - mat(k,3285) = -((rxt(k,178) + rxt(k,179) + rxt(k,180)) * y(k,78) + rxt(k,182) & + mat(k,3461) = -rxt(k,555)*y(k,252) + mat(k,3209) = -rxt(k,556)*y(k,252) + mat(k,4070) = -rxt(k,557)*y(k,252) + mat(k,602) = -((rxt(k,377) + rxt(k,378)) * y(k,147)) + mat(k,3195) = -(rxt(k,377) + rxt(k,378)) * y(k,253) + mat(k,375) = rxt(k,375)*y(k,293) + mat(k,3665) = rxt(k,375)*y(k,16) + mat(k,3180) = .750_r8*rxt(k,342)*y(k,255) + mat(k,858) = .750_r8*rxt(k,342)*y(k,147) + mat(k,859) = -(rxt(k,341)*y(k,256) + rxt(k,342)*y(k,147)) + mat(k,3457) = -rxt(k,341)*y(k,255) + mat(k,3205) = -rxt(k,342)*y(k,255) + mat(k,591) = rxt(k,350)*y(k,293) + mat(k,3692) = rxt(k,350)*y(k,26) + mat(k,3571) = -((rxt(k,178) + rxt(k,179) + rxt(k,180)) * y(k,78) + rxt(k,182) & *y(k,156) + rxt(k,183)*y(k,157) + rxt(k,187)*y(k,293) & + 4._r8*rxt(k,192)*y(k,256) + rxt(k,202)*y(k,149) + rxt(k,207) & *y(k,147) + rxt(k,212)*y(k,148) + (rxt(k,222) + rxt(k,223) & ) * y(k,57) + rxt(k,229)*y(k,60) + rxt(k,255)*y(k,18) + rxt(k,261) & - *y(k,20) + rxt(k,298)*y(k,43) + rxt(k,304)*y(k,251) + rxt(k,313) & - *y(k,257) + rxt(k,327)*y(k,247) + rxt(k,338)*y(k,250) + rxt(k,342) & - *y(k,255) + rxt(k,357)*y(k,248) + rxt(k,366)*y(k,295) + rxt(k,370) & - *y(k,296) + rxt(k,384)*y(k,282) + rxt(k,391)*y(k,284) + rxt(k,395) & - *y(k,286) + rxt(k,403)*y(k,287) + rxt(k,410)*y(k,234) + rxt(k,422) & - *y(k,258) + rxt(k,427)*y(k,259) + rxt(k,433)*y(k,260) + rxt(k,447) & - *y(k,265) + rxt(k,451)*y(k,266) + rxt(k,458)*y(k,267) + rxt(k,462) & - *y(k,268) + rxt(k,465)*y(k,269) + rxt(k,468)*y(k,270) + rxt(k,472) & - *y(k,271) + rxt(k,477)*y(k,272) + rxt(k,480)*y(k,273) + rxt(k,483) & - *y(k,274) + rxt(k,494)*y(k,276) + rxt(k,498)*y(k,277) + rxt(k,500) & - *y(k,291) + rxt(k,542)*y(k,233) + rxt(k,545)*y(k,241) + rxt(k,549) & - *y(k,246) + rxt(k,552)*y(k,249) + rxt(k,556)*y(k,252) + rxt(k,559) & - *y(k,283) + rxt(k,562)*y(k,285) + rxt(k,565)*y(k,294) + rxt(k,572) & - *y(k,312) + rxt(k,578)*y(k,314) + rxt(k,581)*y(k,316) + rxt(k,589) & - *y(k,235) + rxt(k,597)*y(k,236) + rxt(k,609)*y(k,238) + rxt(k,617) & - *y(k,239) + rxt(k,629)*y(k,243) + rxt(k,637)*y(k,244) + rxt(k,648) & - *y(k,279) + rxt(k,657)*y(k,280) + rxt(k,668)*y(k,288) + rxt(k,677) & - *y(k,289) + rxt(k,688)*y(k,297) + rxt(k,692)*y(k,298) + rxt(k,696) & - *y(k,299) + rxt(k,704)*y(k,300) + rxt(k,712)*y(k,301) + rxt(k,722) & - *y(k,302) + rxt(k,731)*y(k,303) + rxt(k,741)*y(k,304) + rxt(k,752) & - *y(k,305) + rxt(k,761)*y(k,306) + rxt(k,766)*y(k,307) + rxt(k,773) & - *y(k,308) + rxt(k,777)*y(k,309) + rxt(k,781)*y(k,310) + rxt(k,785) & + *y(k,20) + rxt(k,298)*y(k,43) + rxt(k,304)*y(k,251) + rxt(k,312) & + *y(k,257) + rxt(k,326)*y(k,247) + rxt(k,337)*y(k,250) + rxt(k,341) & + *y(k,255) + rxt(k,356)*y(k,248) + rxt(k,365)*y(k,295) + rxt(k,369) & + *y(k,296) + rxt(k,383)*y(k,282) + rxt(k,390)*y(k,284) + rxt(k,394) & + *y(k,286) + rxt(k,402)*y(k,287) + rxt(k,409)*y(k,234) + rxt(k,421) & + *y(k,258) + rxt(k,426)*y(k,259) + rxt(k,432)*y(k,260) + rxt(k,446) & + *y(k,265) + rxt(k,450)*y(k,266) + rxt(k,457)*y(k,267) + rxt(k,461) & + *y(k,268) + rxt(k,464)*y(k,269) + rxt(k,467)*y(k,270) + rxt(k,471) & + *y(k,271) + rxt(k,476)*y(k,272) + rxt(k,479)*y(k,273) + rxt(k,482) & + *y(k,274) + rxt(k,493)*y(k,276) + rxt(k,497)*y(k,277) + rxt(k,499) & + *y(k,291) + rxt(k,541)*y(k,233) + rxt(k,544)*y(k,241) + rxt(k,548) & + *y(k,246) + rxt(k,551)*y(k,249) + rxt(k,555)*y(k,252) + rxt(k,558) & + *y(k,283) + rxt(k,561)*y(k,285) + rxt(k,564)*y(k,294) + rxt(k,571) & + *y(k,312) + rxt(k,577)*y(k,314) + rxt(k,580)*y(k,316) + rxt(k,588) & + *y(k,235) + rxt(k,596)*y(k,236) + rxt(k,608)*y(k,238) + rxt(k,616) & + *y(k,239) + rxt(k,628)*y(k,243) + rxt(k,636)*y(k,244) + rxt(k,647) & + *y(k,279) + rxt(k,656)*y(k,280) + rxt(k,667)*y(k,288) + rxt(k,676) & + *y(k,289) + rxt(k,687)*y(k,297) + rxt(k,691)*y(k,298) + rxt(k,695) & + *y(k,299) + rxt(k,703)*y(k,300) + rxt(k,711)*y(k,301) + rxt(k,721) & + *y(k,302) + rxt(k,730)*y(k,303) + rxt(k,740)*y(k,304) + rxt(k,751) & + *y(k,305) + rxt(k,760)*y(k,306) + rxt(k,765)*y(k,307) + rxt(k,772) & + *y(k,308) + rxt(k,776)*y(k,309) + rxt(k,780)*y(k,310) + rxt(k,784) & *y(k,311)) - mat(k,2734) = -(rxt(k,178) + rxt(k,179) + rxt(k,180)) * y(k,256) - mat(k,3456) = -rxt(k,182)*y(k,256) - mat(k,2990) = -rxt(k,183)*y(k,256) - mat(k,3746) = -rxt(k,187)*y(k,256) - mat(k,3082) = -rxt(k,202)*y(k,256) - mat(k,2889) = -rxt(k,207)*y(k,256) - mat(k,3506) = -rxt(k,212)*y(k,256) - mat(k,3827) = -(rxt(k,222) + rxt(k,223)) * y(k,256) - mat(k,3311) = -rxt(k,229)*y(k,256) - mat(k,1689) = -rxt(k,255)*y(k,256) - mat(k,3792) = -rxt(k,261)*y(k,256) - mat(k,3335) = -rxt(k,298)*y(k,256) - mat(k,3426) = -rxt(k,304)*y(k,256) - mat(k,597) = -rxt(k,313)*y(k,256) - mat(k,1247) = -rxt(k,327)*y(k,256) - mat(k,2705) = -rxt(k,338)*y(k,256) - mat(k,747) = -rxt(k,342)*y(k,256) - mat(k,979) = -rxt(k,357)*y(k,256) - mat(k,826) = -rxt(k,366)*y(k,256) - mat(k,1230) = -rxt(k,370)*y(k,256) - mat(k,1391) = -rxt(k,384)*y(k,256) - mat(k,1504) = -rxt(k,391)*y(k,256) - mat(k,660) = -rxt(k,395)*y(k,256) - mat(k,1377) = -rxt(k,403)*y(k,256) - mat(k,1138) = -rxt(k,410)*y(k,256) - mat(k,1411) = -rxt(k,422)*y(k,256) - mat(k,1838) = -rxt(k,427)*y(k,256) - mat(k,1740) = -rxt(k,433)*y(k,256) - mat(k,1560) = -rxt(k,447)*y(k,256) - mat(k,1581) = -rxt(k,451)*y(k,256) - mat(k,1006) = -rxt(k,458)*y(k,256) - mat(k,1079) = -rxt(k,462)*y(k,256) - mat(k,991) = -rxt(k,465)*y(k,256) - mat(k,1017) = -rxt(k,468)*y(k,256) - mat(k,1325) = -rxt(k,472)*y(k,256) - mat(k,2042) = -rxt(k,477)*y(k,256) - mat(k,1190) = -rxt(k,480)*y(k,256) - mat(k,1266) = -rxt(k,483)*y(k,256) - mat(k,1790) = -rxt(k,494)*y(k,256) - mat(k,1678) = -rxt(k,498)*y(k,256) - mat(k,1490) = -rxt(k,500)*y(k,256) - mat(k,465) = -rxt(k,542)*y(k,256) - mat(k,439) = -rxt(k,545)*y(k,256) - mat(k,361) = -rxt(k,549)*y(k,256) - mat(k,607) = -rxt(k,552)*y(k,256) - mat(k,793) = -rxt(k,556)*y(k,256) - mat(k,755) = -rxt(k,559)*y(k,256) - mat(k,817) = -rxt(k,562)*y(k,256) - mat(k,380) = -rxt(k,565)*y(k,256) - mat(k,769) = -rxt(k,572)*y(k,256) - mat(k,786) = -rxt(k,578)*y(k,256) - mat(k,447) = -rxt(k,581)*y(k,256) - mat(k,2131) = -rxt(k,589)*y(k,256) - mat(k,2227) = -rxt(k,597)*y(k,256) - mat(k,2064) = -rxt(k,609)*y(k,256) - mat(k,2109) = -rxt(k,617)*y(k,256) - mat(k,2344) = -rxt(k,629)*y(k,256) - mat(k,2256) = -rxt(k,637)*y(k,256) - mat(k,2317) = -rxt(k,648)*y(k,256) - mat(k,2170) = -rxt(k,657)*y(k,256) - mat(k,2378) = -rxt(k,668)*y(k,256) - mat(k,2285) = -rxt(k,677)*y(k,256) - mat(k,839) = -rxt(k,688)*y(k,256) - mat(k,922) = -rxt(k,692)*y(k,256) - mat(k,2456) = -rxt(k,696)*y(k,256) - mat(k,2541) = -rxt(k,704)*y(k,256) - mat(k,2498) = -rxt(k,712)*y(k,256) - mat(k,2587) = -rxt(k,722)*y(k,256) - mat(k,2086) = -rxt(k,731)*y(k,256) - mat(k,2477) = -rxt(k,741)*y(k,256) - mat(k,2634) = -rxt(k,752)*y(k,256) - mat(k,684) = -rxt(k,761)*y(k,256) - mat(k,849) = -rxt(k,766)*y(k,256) - mat(k,1150) = -rxt(k,773)*y(k,256) - mat(k,931) = -rxt(k,777)*y(k,256) - mat(k,693) = -rxt(k,781)*y(k,256) - mat(k,701) = -rxt(k,785)*y(k,256) - mat(k,1115) = .170_r8*rxt(k,603)*y(k,157) - mat(k,868) = .080_r8*rxt(k,623)*y(k,157) - mat(k,135) = .650_r8*rxt(k,544)*y(k,293) - mat(k,1689) = mat(k,1689) + rxt(k,254)*y(k,43) - mat(k,3792) = mat(k,3792) + rxt(k,266)*y(k,293) - mat(k,257) = .350_r8*rxt(k,322)*y(k,293) - mat(k,503) = .130_r8*rxt(k,324)*y(k,157) - mat(k,220) = rxt(k,329)*y(k,293) - mat(k,1205) = .280_r8*rxt(k,355)*y(k,157) - mat(k,3335) = mat(k,3335) + rxt(k,254)*y(k,18) + rxt(k,218)*y(k,57) & + mat(k,2580) = -(rxt(k,178) + rxt(k,179) + rxt(k,180)) * y(k,256) + mat(k,3391) = -rxt(k,182)*y(k,256) + mat(k,3133) = -rxt(k,183)*y(k,256) + mat(k,3821) = -rxt(k,187)*y(k,256) + mat(k,3956) = -rxt(k,202)*y(k,256) + mat(k,3315) = -rxt(k,207)*y(k,256) + mat(k,4100) = -rxt(k,212)*y(k,256) + mat(k,3862) = -(rxt(k,222) + rxt(k,223)) * y(k,256) + mat(k,2605) = -rxt(k,229)*y(k,256) + mat(k,2206) = -rxt(k,255)*y(k,256) + mat(k,2565) = -rxt(k,261)*y(k,256) + mat(k,3360) = -rxt(k,298)*y(k,256) + mat(k,4048) = -rxt(k,304)*y(k,256) + mat(k,696) = -rxt(k,312)*y(k,256) + mat(k,1353) = -rxt(k,326)*y(k,256) + mat(k,3030) = -rxt(k,337)*y(k,256) + mat(k,863) = -rxt(k,341)*y(k,256) + mat(k,1047) = -rxt(k,356)*y(k,256) + mat(k,937) = -rxt(k,365)*y(k,256) + mat(k,1341) = -rxt(k,369)*y(k,256) + mat(k,1551) = -rxt(k,383)*y(k,256) + mat(k,1626) = -rxt(k,390)*y(k,256) + mat(k,742) = -rxt(k,394)*y(k,256) + mat(k,1515) = -rxt(k,402)*y(k,256) + mat(k,1205) = -rxt(k,409)*y(k,256) + mat(k,1304) = -rxt(k,421)*y(k,256) + mat(k,1969) = -rxt(k,426)*y(k,256) + mat(k,2008) = -rxt(k,432)*y(k,256) + mat(k,1752) = -rxt(k,446)*y(k,256) + mat(k,1780) = -rxt(k,450)*y(k,256) + mat(k,1127) = -rxt(k,457)*y(k,256) + mat(k,1173) = -rxt(k,461)*y(k,256) + mat(k,1059) = -rxt(k,464)*y(k,256) + mat(k,1138) = -rxt(k,467)*y(k,256) + mat(k,1449) = -rxt(k,471)*y(k,256) + mat(k,2190) = -rxt(k,476)*y(k,256) + mat(k,1318) = -rxt(k,479)*y(k,256) + mat(k,1426) = -rxt(k,482)*y(k,256) + mat(k,1859) = -rxt(k,493)*y(k,256) + mat(k,1828) = -rxt(k,497)*y(k,256) + mat(k,1651) = -rxt(k,499)*y(k,256) + mat(k,550) = -rxt(k,541)*y(k,256) + mat(k,529) = -rxt(k,544)*y(k,256) + mat(k,443) = -rxt(k,548)*y(k,256) + mat(k,712) = -rxt(k,551)*y(k,256) + mat(k,908) = -rxt(k,555)*y(k,256) + mat(k,870) = -rxt(k,558)*y(k,256) + mat(k,927) = -rxt(k,561)*y(k,256) + mat(k,456) = -rxt(k,564)*y(k,256) + mat(k,884) = -rxt(k,571)*y(k,256) + mat(k,901) = -rxt(k,577)*y(k,256) + mat(k,537) = -rxt(k,580)*y(k,256) + mat(k,2309) = -rxt(k,588)*y(k,256) + mat(k,2479) = -rxt(k,596)*y(k,256) + mat(k,2225) = -rxt(k,608)*y(k,256) + mat(k,2336) = -rxt(k,616)*y(k,256) + mat(k,2542) = -rxt(k,628)*y(k,256) + mat(k,2425) = -rxt(k,636)*y(k,256) + mat(k,2513) = -rxt(k,647)*y(k,256) + mat(k,2395) = -rxt(k,656)*y(k,256) + mat(k,2714) = -rxt(k,667)*y(k,256) + mat(k,2817) = -rxt(k,676)*y(k,256) + mat(k,950) = -rxt(k,687)*y(k,256) + mat(k,1009) = -rxt(k,691)*y(k,256) + mat(k,2739) = -rxt(k,695)*y(k,256) + mat(k,2956) = -rxt(k,703)*y(k,256) + mat(k,2784) = -rxt(k,711)*y(k,256) + mat(k,2863) = -rxt(k,721)*y(k,256) + mat(k,2249) = -rxt(k,730)*y(k,256) + mat(k,2761) = -rxt(k,740)*y(k,256) + mat(k,2910) = -rxt(k,751)*y(k,256) + mat(k,800) = -rxt(k,760)*y(k,256) + mat(k,959) = -rxt(k,765)*y(k,256) + mat(k,1222) = -rxt(k,772)*y(k,256) + mat(k,1018) = -rxt(k,776)*y(k,256) + mat(k,808) = -rxt(k,780)*y(k,256) + mat(k,816) = -rxt(k,784)*y(k,256) + mat(k,1260) = .170_r8*rxt(k,602)*y(k,157) + mat(k,1038) = .080_r8*rxt(k,622)*y(k,157) + mat(k,184) = .650_r8*rxt(k,543)*y(k,293) + mat(k,2206) = mat(k,2206) + rxt(k,254)*y(k,43) + mat(k,2565) = mat(k,2565) + rxt(k,266)*y(k,293) + mat(k,312) = .350_r8*rxt(k,321)*y(k,293) + mat(k,596) = .130_r8*rxt(k,323)*y(k,157) + mat(k,282) = rxt(k,328)*y(k,293) + mat(k,1375) = .280_r8*rxt(k,354)*y(k,157) + mat(k,3360) = mat(k,3360) + rxt(k,254)*y(k,18) + rxt(k,218)*y(k,57) & + rxt(k,299)*y(k,149) + rxt(k,300)*y(k,156) - mat(k,107) = rxt(k,335)*y(k,293) - mat(k,1357) = rxt(k,306)*y(k,293) - mat(k,3827) = mat(k,3827) + rxt(k,218)*y(k,43) + rxt(k,221)*y(k,81) - mat(k,3311) = mat(k,3311) + rxt(k,225)*y(k,251) + rxt(k,236)*y(k,293) - mat(k,1542) = rxt(k,309)*y(k,293) - mat(k,171) = .730_r8*rxt(k,555)*y(k,293) - mat(k,242) = .500_r8*rxt(k,808)*y(k,293) - mat(k,1471) = rxt(k,346)*y(k,293) - mat(k,1178) = rxt(k,347)*y(k,293) - mat(k,1350) = rxt(k,221)*y(k,57) + rxt(k,177)*y(k,156) + rxt(k,186)*y(k,293) - mat(k,148) = rxt(k,310)*y(k,293) - mat(k,724) = .110_r8*rxt(k,348)*y(k,293) - mat(k,1125) = rxt(k,311)*y(k,293) - mat(k,1120) = .500_r8*rxt(k,312)*y(k,293) - mat(k,884) = rxt(k,380)*y(k,293) - mat(k,551) = .510_r8*rxt(k,415)*y(k,293) - mat(k,563) = .410_r8*rxt(k,416)*y(k,293) - mat(k,1614) = rxt(k,363)*y(k,293) - mat(k,1706) = .320_r8*rxt(k,419)*y(k,293) - mat(k,805) = .190_r8*rxt(k,421)*y(k,293) - mat(k,1091) = .400_r8*rxt(k,424)*y(k,293) - mat(k,1300) = .420_r8*rxt(k,487)*y(k,157) - mat(k,1536) = rxt(k,454)*y(k,293) - mat(k,1340) = rxt(k,456)*y(k,293) - mat(k,1938) = .170_r8*rxt(k,460)*y(k,157) + .040_r8*rxt(k,461)*y(k,293) - mat(k,1972) = .170_r8*rxt(k,470)*y(k,157) + .030_r8*rxt(k,471)*y(k,293) - mat(k,629) = .050_r8*rxt(k,473)*y(k,293) - mat(k,800) = rxt(k,489)*y(k,293) - mat(k,1906) = .180_r8*rxt(k,490)*y(k,293) - mat(k,1759) = .140_r8*rxt(k,386)*y(k,157) - mat(k,1624) = .500_r8*rxt(k,381)*y(k,293) - mat(k,1870) = .280_r8*rxt(k,404)*y(k,157) - mat(k,1806) = rxt(k,400)*y(k,293) - mat(k,1365) = .440_r8*rxt(k,406)*y(k,293) - mat(k,718) = .630_r8*rxt(k,683)*y(k,157) - mat(k,2000) = .130_r8*rxt(k,502)*y(k,157) + .630_r8*rxt(k,503)*y(k,293) - mat(k,2889) = mat(k,2889) + rxt(k,411)*y(k,234) + .770_r8*rxt(k,598)*y(k,236) & - + .700_r8*rxt(k,618)*y(k,239) + rxt(k,546)*y(k,241) & - + .470_r8*rxt(k,630)*y(k,243) + .750_r8*rxt(k,638)*y(k,244) & - + rxt(k,551)*y(k,246) + rxt(k,328)*y(k,247) + rxt(k,358) & - *y(k,248) + rxt(k,305)*y(k,251) + .170_r8*rxt(k,557)*y(k,252) & - + rxt(k,378)*y(k,253) + .250_r8*rxt(k,343)*y(k,255) + rxt(k,315) & - *y(k,257) + rxt(k,504)*y(k,258) + rxt(k,506)*y(k,259) & - + rxt(k,508)*y(k,260) + .450_r8*rxt(k,510)*y(k,265) & - + .450_r8*rxt(k,512)*y(k,266) + rxt(k,514)*y(k,267) & - + .270_r8*rxt(k,516)*y(k,268) + rxt(k,518)*y(k,269) + rxt(k,520) & - *y(k,270) + rxt(k,522)*y(k,271) + .540_r8*rxt(k,524)*y(k,272) & - + .530_r8*rxt(k,526)*y(k,273) + .960_r8*rxt(k,528)*y(k,274) & - + .450_r8*rxt(k,531)*y(k,276) + .450_r8*rxt(k,534)*y(k,277) & - + .500_r8*rxt(k,650)*y(k,279) + .770_r8*rxt(k,658)*y(k,280) & - + rxt(k,536)*y(k,282) + .400_r8*rxt(k,560)*y(k,283) & - + .830_r8*rxt(k,563)*y(k,285) + .240_r8*rxt(k,538)*y(k,287) & - + .040_r8*rxt(k,670)*y(k,288) + .710_r8*rxt(k,678)*y(k,289) & - + rxt(k,540)*y(k,291) + rxt(k,566)*y(k,294) + rxt(k,367) & - *y(k,295) + .700_r8*rxt(k,689)*y(k,297) + .700_r8*rxt(k,693) & - *y(k,298) + .910_r8*rxt(k,742)*y(k,304) + .700_r8*rxt(k,762) & - *y(k,306) + .700_r8*rxt(k,767)*y(k,307) + .700_r8*rxt(k,774) & - *y(k,308) + .700_r8*rxt(k,778)*y(k,309) + .700_r8*rxt(k,782) & - *y(k,310) + .700_r8*rxt(k,786)*y(k,311) + rxt(k,573)*y(k,312) & - + rxt(k,579)*y(k,314) + rxt(k,582)*y(k,316) - mat(k,3082) = mat(k,3082) + rxt(k,299)*y(k,43) + .500_r8*rxt(k,765)*y(k,211) & - + rxt(k,599)*y(k,236) + rxt(k,619)*y(k,239) + .500_r8*rxt(k,631) & - *y(k,243) + rxt(k,639)*y(k,244) + .540_r8*rxt(k,479)*y(k,272) & - + .540_r8*rxt(k,651)*y(k,279) + rxt(k,659)*y(k,280) & - + .050_r8*rxt(k,671)*y(k,288) + rxt(k,679)*y(k,289) + rxt(k,205) & - *y(k,293) + rxt(k,743)*y(k,304) - mat(k,3456) = mat(k,3456) + rxt(k,300)*y(k,43) + rxt(k,177)*y(k,81) - mat(k,2990) = mat(k,2990) + .170_r8*rxt(k,603)*y(k,4) + .080_r8*rxt(k,623) & - *y(k,7) + .130_r8*rxt(k,324)*y(k,26) + .280_r8*rxt(k,355) & - *y(k,30) + .420_r8*rxt(k,487)*y(k,109) + .170_r8*rxt(k,460) & - *y(k,115) + .170_r8*rxt(k,470)*y(k,118) + .140_r8*rxt(k,386) & - *y(k,126) + .280_r8*rxt(k,404)*y(k,132) + .630_r8*rxt(k,683) & - *y(k,135) + .130_r8*rxt(k,502)*y(k,139) + rxt(k,189)*y(k,293) - mat(k,144) = .800_r8*rxt(k,567)*y(k,293) - mat(k,1163) = rxt(k,809)*y(k,293) - mat(k,510) = rxt(k,719)*y(k,293) - mat(k,518) = rxt(k,738)*y(k,293) - mat(k,2404) = .500_r8*rxt(k,765)*y(k,149) - mat(k,166) = .280_r8*rxt(k,575)*y(k,293) - mat(k,185) = .380_r8*rxt(k,577)*y(k,293) - mat(k,190) = .630_r8*rxt(k,583)*y(k,293) - mat(k,1138) = mat(k,1138) + rxt(k,411)*y(k,147) - mat(k,2131) = mat(k,2131) + .820_r8*rxt(k,588)*y(k,251) - mat(k,2227) = mat(k,2227) + .770_r8*rxt(k,598)*y(k,147) + rxt(k,599)*y(k,149) & - + rxt(k,595)*y(k,250) + 1.160_r8*rxt(k,596)*y(k,251) & - + .480_r8*rxt(k,597)*y(k,256) + rxt(k,600)*y(k,300) + rxt(k,601) & - *y(k,302) + rxt(k,602)*y(k,305) - mat(k,2064) = mat(k,2064) + .820_r8*rxt(k,608)*y(k,251) - mat(k,2109) = mat(k,2109) + .700_r8*rxt(k,618)*y(k,147) + rxt(k,619)*y(k,149) & - + rxt(k,615)*y(k,250) + rxt(k,616)*y(k,251) + .100_r8*rxt(k,617) & - *y(k,256) + rxt(k,620)*y(k,300) + rxt(k,621)*y(k,302) & - + rxt(k,622)*y(k,305) - mat(k,439) = mat(k,439) + rxt(k,546)*y(k,147) - mat(k,2344) = mat(k,2344) + .470_r8*rxt(k,630)*y(k,147) + .500_r8*rxt(k,631) & - *y(k,149) + 1.880_r8*rxt(k,626)*y(k,243) + .500_r8*rxt(k,627) & - *y(k,250) + 1.100_r8*rxt(k,628)*y(k,251) + .500_r8*rxt(k,632) & - *y(k,300) + .500_r8*rxt(k,633)*y(k,302) + .500_r8*rxt(k,634) & + mat(k,643) = rxt(k,283)*y(k,57) + rxt(k,284)*y(k,293) + mat(k,393) = rxt(k,286)*y(k,57) + rxt(k,287)*y(k,293) + mat(k,122) = rxt(k,334)*y(k,293) + mat(k,1494) = rxt(k,306)*y(k,293) + mat(k,2266) = rxt(k,316)*y(k,292) + mat(k,3862) = mat(k,3862) + rxt(k,218)*y(k,43) + rxt(k,283)*y(k,44) & + + rxt(k,286)*y(k,47) + rxt(k,221)*y(k,81) + mat(k,2605) = mat(k,2605) + rxt(k,225)*y(k,251) + rxt(k,236)*y(k,293) + mat(k,1920) = rxt(k,319)*y(k,293) + mat(k,219) = .730_r8*rxt(k,554)*y(k,293) + mat(k,323) = .500_r8*rxt(k,808)*y(k,293) + mat(k,1714) = rxt(k,345)*y(k,293) + mat(k,1477) = rxt(k,346)*y(k,293) + mat(k,1488) = rxt(k,221)*y(k,57) + rxt(k,177)*y(k,156) + rxt(k,186)*y(k,293) + mat(k,197) = rxt(k,309)*y(k,293) + mat(k,823) = .110_r8*rxt(k,347)*y(k,293) + mat(k,1359) = rxt(k,310)*y(k,293) + mat(k,1211) = .500_r8*rxt(k,311)*y(k,293) + mat(k,981) = rxt(k,379)*y(k,293) + mat(k,629) = .510_r8*rxt(k,414)*y(k,293) + mat(k,688) = .410_r8*rxt(k,415)*y(k,293) + mat(k,1760) = rxt(k,362)*y(k,293) + mat(k,1878) = .320_r8*rxt(k,418)*y(k,293) + mat(k,1531) = .190_r8*rxt(k,420)*y(k,293) + mat(k,1274) = .400_r8*rxt(k,423)*y(k,293) + mat(k,1406) = .420_r8*rxt(k,486)*y(k,157) + mat(k,1666) = rxt(k,453)*y(k,293) + mat(k,1470) = rxt(k,455)*y(k,293) + mat(k,2119) = .170_r8*rxt(k,459)*y(k,157) + .040_r8*rxt(k,460)*y(k,293) + mat(k,2087) = .170_r8*rxt(k,469)*y(k,157) + .030_r8*rxt(k,470)*y(k,293) + mat(k,765) = .050_r8*rxt(k,472)*y(k,293) + mat(k,915) = rxt(k,488)*y(k,293) + mat(k,1906) = .180_r8*rxt(k,489)*y(k,293) + mat(k,2030) = .140_r8*rxt(k,385)*y(k,157) + mat(k,1731) = .500_r8*rxt(k,380)*y(k,293) + mat(k,2055) = .280_r8*rxt(k,403)*y(k,157) + mat(k,1934) = rxt(k,399)*y(k,293) + mat(k,1502) = .440_r8*rxt(k,405)*y(k,293) + mat(k,854) = .630_r8*rxt(k,682)*y(k,157) + mat(k,2148) = .130_r8*rxt(k,501)*y(k,157) + .630_r8*rxt(k,502)*y(k,293) + mat(k,3315) = mat(k,3315) + rxt(k,410)*y(k,234) + .770_r8*rxt(k,597)*y(k,236) & + + .700_r8*rxt(k,617)*y(k,239) + rxt(k,545)*y(k,241) & + + .470_r8*rxt(k,629)*y(k,243) + .750_r8*rxt(k,637)*y(k,244) & + + rxt(k,550)*y(k,246) + rxt(k,327)*y(k,247) + rxt(k,357) & + *y(k,248) + rxt(k,305)*y(k,251) + .170_r8*rxt(k,556)*y(k,252) & + + rxt(k,377)*y(k,253) + .250_r8*rxt(k,342)*y(k,255) + rxt(k,314) & + *y(k,257) + rxt(k,503)*y(k,258) + rxt(k,505)*y(k,259) & + + rxt(k,507)*y(k,260) + .450_r8*rxt(k,509)*y(k,265) & + + .450_r8*rxt(k,511)*y(k,266) + rxt(k,513)*y(k,267) & + + .270_r8*rxt(k,515)*y(k,268) + rxt(k,517)*y(k,269) + rxt(k,519) & + *y(k,270) + rxt(k,521)*y(k,271) + .540_r8*rxt(k,523)*y(k,272) & + + .530_r8*rxt(k,525)*y(k,273) + .960_r8*rxt(k,527)*y(k,274) & + + .450_r8*rxt(k,530)*y(k,276) + .450_r8*rxt(k,533)*y(k,277) & + + .500_r8*rxt(k,649)*y(k,279) + .770_r8*rxt(k,657)*y(k,280) & + + rxt(k,535)*y(k,282) + .400_r8*rxt(k,559)*y(k,283) & + + .830_r8*rxt(k,562)*y(k,285) + .240_r8*rxt(k,537)*y(k,287) & + + .040_r8*rxt(k,669)*y(k,288) + .710_r8*rxt(k,677)*y(k,289) & + + rxt(k,539)*y(k,291) + rxt(k,565)*y(k,294) + rxt(k,366) & + *y(k,295) + .700_r8*rxt(k,688)*y(k,297) + .700_r8*rxt(k,692) & + *y(k,298) + .910_r8*rxt(k,741)*y(k,304) + .700_r8*rxt(k,761) & + *y(k,306) + .700_r8*rxt(k,766)*y(k,307) + .700_r8*rxt(k,773) & + *y(k,308) + .700_r8*rxt(k,777)*y(k,309) + .700_r8*rxt(k,781) & + *y(k,310) + .700_r8*rxt(k,785)*y(k,311) + rxt(k,572)*y(k,312) & + + rxt(k,578)*y(k,314) + rxt(k,581)*y(k,316) + mat(k,3956) = mat(k,3956) + rxt(k,299)*y(k,43) + .500_r8*rxt(k,764)*y(k,211) & + + rxt(k,598)*y(k,236) + rxt(k,618)*y(k,239) + .500_r8*rxt(k,630) & + *y(k,243) + rxt(k,638)*y(k,244) + .540_r8*rxt(k,478)*y(k,272) & + + .540_r8*rxt(k,650)*y(k,279) + rxt(k,658)*y(k,280) & + + .050_r8*rxt(k,670)*y(k,288) + rxt(k,678)*y(k,289) + rxt(k,205) & + *y(k,293) + rxt(k,742)*y(k,304) + mat(k,3391) = mat(k,3391) + rxt(k,300)*y(k,43) + rxt(k,177)*y(k,81) + mat(k,3133) = mat(k,3133) + .170_r8*rxt(k,602)*y(k,4) + .080_r8*rxt(k,622) & + *y(k,7) + .130_r8*rxt(k,323)*y(k,26) + .280_r8*rxt(k,354) & + *y(k,30) + .420_r8*rxt(k,486)*y(k,109) + .170_r8*rxt(k,459) & + *y(k,115) + .170_r8*rxt(k,469)*y(k,118) + .140_r8*rxt(k,385) & + *y(k,126) + .280_r8*rxt(k,403)*y(k,132) + .630_r8*rxt(k,682) & + *y(k,135) + .130_r8*rxt(k,501)*y(k,139) + rxt(k,189)*y(k,293) + mat(k,193) = .800_r8*rxt(k,566)*y(k,293) + mat(k,1236) = rxt(k,798)*y(k,293) + mat(k,654) = rxt(k,718)*y(k,293) + mat(k,663) = rxt(k,737)*y(k,293) + mat(k,2359) = .500_r8*rxt(k,764)*y(k,149) + mat(k,214) = .280_r8*rxt(k,574)*y(k,293) + mat(k,233) = .380_r8*rxt(k,576)*y(k,293) + mat(k,238) = .630_r8*rxt(k,582)*y(k,293) + mat(k,1205) = mat(k,1205) + rxt(k,410)*y(k,147) + mat(k,2309) = mat(k,2309) + .820_r8*rxt(k,587)*y(k,251) + mat(k,2479) = mat(k,2479) + .770_r8*rxt(k,597)*y(k,147) + rxt(k,598)*y(k,149) & + + rxt(k,594)*y(k,250) + 1.160_r8*rxt(k,595)*y(k,251) & + + .480_r8*rxt(k,596)*y(k,256) + rxt(k,599)*y(k,300) + rxt(k,600) & + *y(k,302) + rxt(k,601)*y(k,305) + mat(k,2225) = mat(k,2225) + .820_r8*rxt(k,607)*y(k,251) + mat(k,2336) = mat(k,2336) + .700_r8*rxt(k,617)*y(k,147) + rxt(k,618)*y(k,149) & + + rxt(k,614)*y(k,250) + rxt(k,615)*y(k,251) + .100_r8*rxt(k,616) & + *y(k,256) + rxt(k,619)*y(k,300) + rxt(k,620)*y(k,302) & + + rxt(k,621)*y(k,305) + mat(k,529) = mat(k,529) + rxt(k,545)*y(k,147) + mat(k,2542) = mat(k,2542) + .470_r8*rxt(k,629)*y(k,147) + .500_r8*rxt(k,630) & + *y(k,149) + 1.880_r8*rxt(k,625)*y(k,243) + .500_r8*rxt(k,626) & + *y(k,250) + 1.100_r8*rxt(k,627)*y(k,251) + .500_r8*rxt(k,631) & + *y(k,300) + .500_r8*rxt(k,632)*y(k,302) + .500_r8*rxt(k,633) & *y(k,305) - mat(k,2256) = mat(k,2256) + .750_r8*rxt(k,638)*y(k,147) + rxt(k,639)*y(k,149) & - + rxt(k,635)*y(k,250) + 1.500_r8*rxt(k,636)*y(k,251) & - + .030_r8*rxt(k,637)*y(k,256) + rxt(k,640)*y(k,300) + rxt(k,641) & - *y(k,302) + rxt(k,642)*y(k,305) - mat(k,361) = mat(k,361) + rxt(k,551)*y(k,147) - mat(k,1247) = mat(k,1247) + rxt(k,328)*y(k,147) + 2.400_r8*rxt(k,325) & - *y(k,247) + rxt(k,326)*y(k,251) - mat(k,979) = mat(k,979) + rxt(k,358)*y(k,147) + rxt(k,356)*y(k,251) - mat(k,2705) = mat(k,2705) + rxt(k,595)*y(k,236) + rxt(k,615)*y(k,239) & - + .500_r8*rxt(k,627)*y(k,243) + rxt(k,635)*y(k,244) & - + .900_r8*rxt(k,337)*y(k,251) + rxt(k,425)*y(k,259) + rxt(k,431) & - *y(k,260) + .450_r8*rxt(k,445)*y(k,265) + .450_r8*rxt(k,449) & - *y(k,266) + .540_r8*rxt(k,475)*y(k,272) + .450_r8*rxt(k,492) & - *y(k,276) + .450_r8*rxt(k,496)*y(k,277) + .540_r8*rxt(k,646) & - *y(k,279) + rxt(k,655)*y(k,280) + rxt(k,382)*y(k,282) & - + .250_r8*rxt(k,401)*y(k,287) + .050_r8*rxt(k,666)*y(k,288) & - + rxt(k,675)*y(k,289) + rxt(k,739)*y(k,304) - mat(k,3426) = mat(k,3426) + rxt(k,225)*y(k,60) + rxt(k,305)*y(k,147) & - + .820_r8*rxt(k,588)*y(k,235) + 1.160_r8*rxt(k,596)*y(k,236) & - + .820_r8*rxt(k,608)*y(k,238) + rxt(k,616)*y(k,239) & - + 1.100_r8*rxt(k,628)*y(k,243) + 1.500_r8*rxt(k,636)*y(k,244) & - + rxt(k,326)*y(k,247) + rxt(k,356)*y(k,248) + .900_r8*rxt(k,337) & - *y(k,250) + 4.000_r8*rxt(k,302)*y(k,251) + 1.500_r8*rxt(k,426) & - *y(k,259) + rxt(k,432)*y(k,260) + .720_r8*rxt(k,446)*y(k,265) & - + .720_r8*rxt(k,450)*y(k,266) + .400_r8*rxt(k,476)*y(k,272) & - + .720_r8*rxt(k,493)*y(k,276) + .720_r8*rxt(k,497)*y(k,277) & - + 1.010_r8*rxt(k,647)*y(k,279) + rxt(k,656)*y(k,280) & - + 1.500_r8*rxt(k,383)*y(k,282) + rxt(k,390)*y(k,284) & - + .620_r8*rxt(k,402)*y(k,287) + .870_r8*rxt(k,667)*y(k,288) & - + rxt(k,676)*y(k,289) + .300_r8*rxt(k,369)*y(k,296) & - + .500_r8*rxt(k,695)*y(k,299) + rxt(k,703)*y(k,300) + rxt(k,711) & - *y(k,301) + rxt(k,721)*y(k,302) + rxt(k,730)*y(k,303) & - + 2.000_r8*rxt(k,740)*y(k,304) + rxt(k,751)*y(k,305) - mat(k,793) = mat(k,793) + .170_r8*rxt(k,557)*y(k,147) + .070_r8*rxt(k,556) & + mat(k,2425) = mat(k,2425) + .750_r8*rxt(k,637)*y(k,147) + rxt(k,638)*y(k,149) & + + rxt(k,634)*y(k,250) + 1.500_r8*rxt(k,635)*y(k,251) & + + .030_r8*rxt(k,636)*y(k,256) + rxt(k,639)*y(k,300) + rxt(k,640) & + *y(k,302) + rxt(k,641)*y(k,305) + mat(k,443) = mat(k,443) + rxt(k,550)*y(k,147) + mat(k,1353) = mat(k,1353) + rxt(k,327)*y(k,147) + 2.400_r8*rxt(k,324) & + *y(k,247) + rxt(k,325)*y(k,251) + mat(k,1047) = mat(k,1047) + rxt(k,357)*y(k,147) + rxt(k,355)*y(k,251) + mat(k,3030) = mat(k,3030) + rxt(k,594)*y(k,236) + rxt(k,614)*y(k,239) & + + .500_r8*rxt(k,626)*y(k,243) + rxt(k,634)*y(k,244) & + + .900_r8*rxt(k,336)*y(k,251) + rxt(k,424)*y(k,259) + rxt(k,430) & + *y(k,260) + .450_r8*rxt(k,444)*y(k,265) + .450_r8*rxt(k,448) & + *y(k,266) + .540_r8*rxt(k,474)*y(k,272) + .450_r8*rxt(k,491) & + *y(k,276) + .450_r8*rxt(k,495)*y(k,277) + .540_r8*rxt(k,645) & + *y(k,279) + rxt(k,654)*y(k,280) + rxt(k,381)*y(k,282) & + + .250_r8*rxt(k,400)*y(k,287) + .050_r8*rxt(k,665)*y(k,288) & + + rxt(k,674)*y(k,289) + rxt(k,738)*y(k,304) + mat(k,4048) = mat(k,4048) + rxt(k,225)*y(k,60) + rxt(k,305)*y(k,147) & + + .820_r8*rxt(k,587)*y(k,235) + 1.160_r8*rxt(k,595)*y(k,236) & + + .820_r8*rxt(k,607)*y(k,238) + rxt(k,615)*y(k,239) & + + 1.100_r8*rxt(k,627)*y(k,243) + 1.500_r8*rxt(k,635)*y(k,244) & + + rxt(k,325)*y(k,247) + rxt(k,355)*y(k,248) + .900_r8*rxt(k,336) & + *y(k,250) + 4.000_r8*rxt(k,302)*y(k,251) + 1.500_r8*rxt(k,425) & + *y(k,259) + rxt(k,431)*y(k,260) + .720_r8*rxt(k,445)*y(k,265) & + + .720_r8*rxt(k,449)*y(k,266) + .400_r8*rxt(k,475)*y(k,272) & + + .720_r8*rxt(k,492)*y(k,276) + .720_r8*rxt(k,496)*y(k,277) & + + 1.010_r8*rxt(k,646)*y(k,279) + rxt(k,655)*y(k,280) & + + 1.500_r8*rxt(k,382)*y(k,282) + rxt(k,389)*y(k,284) & + + .620_r8*rxt(k,401)*y(k,287) + .870_r8*rxt(k,666)*y(k,288) & + + rxt(k,675)*y(k,289) + .300_r8*rxt(k,368)*y(k,296) & + + .500_r8*rxt(k,694)*y(k,299) + rxt(k,702)*y(k,300) + rxt(k,710) & + *y(k,301) + rxt(k,720)*y(k,302) + rxt(k,729)*y(k,303) & + + 2.000_r8*rxt(k,739)*y(k,304) + rxt(k,750)*y(k,305) + mat(k,908) = mat(k,908) + .170_r8*rxt(k,556)*y(k,147) + .070_r8*rxt(k,555) & *y(k,256) - mat(k,539) = rxt(k,378)*y(k,147) - mat(k,747) = mat(k,747) + .250_r8*rxt(k,343)*y(k,147) - mat(k,3285) = mat(k,3285) + .480_r8*rxt(k,597)*y(k,236) + .100_r8*rxt(k,617) & - *y(k,239) + .030_r8*rxt(k,637)*y(k,244) + .070_r8*rxt(k,556) & - *y(k,252) + .200_r8*rxt(k,313)*y(k,257) + .650_r8*rxt(k,422) & - *y(k,258) + .060_r8*rxt(k,427)*y(k,259) + .060_r8*rxt(k,433) & - *y(k,260) + .580_r8*rxt(k,458)*y(k,267) + .060_r8*rxt(k,462) & - *y(k,268) + .600_r8*rxt(k,465)*y(k,269) + .500_r8*rxt(k,468) & - *y(k,270) + .400_r8*rxt(k,472)*y(k,271) + .170_r8*rxt(k,480) & - *y(k,273) + .800_r8*rxt(k,483)*y(k,274) + .270_r8*rxt(k,648) & - *y(k,279) + .100_r8*rxt(k,657)*y(k,280) + .590_r8*rxt(k,384) & - *y(k,282) + .160_r8*rxt(k,559)*y(k,283) + .330_r8*rxt(k,562) & - *y(k,285) + .180_r8*rxt(k,403)*y(k,287) + .100_r8*rxt(k,677) & - *y(k,289) + .800_r8*rxt(k,500)*y(k,291) + .180_r8*rxt(k,688) & - *y(k,297) + .180_r8*rxt(k,692)*y(k,298) + .530_r8*rxt(k,741) & - *y(k,304) + .100_r8*rxt(k,761)*y(k,306) + .100_r8*rxt(k,766) & - *y(k,307) + .100_r8*rxt(k,773)*y(k,308) + .100_r8*rxt(k,777) & - *y(k,309) + .100_r8*rxt(k,781)*y(k,310) + .100_r8*rxt(k,785) & + mat(k,608) = rxt(k,377)*y(k,147) + mat(k,863) = mat(k,863) + .250_r8*rxt(k,342)*y(k,147) + mat(k,3571) = mat(k,3571) + .480_r8*rxt(k,596)*y(k,236) + .100_r8*rxt(k,616) & + *y(k,239) + .030_r8*rxt(k,636)*y(k,244) + .070_r8*rxt(k,555) & + *y(k,252) + .200_r8*rxt(k,312)*y(k,257) + .650_r8*rxt(k,421) & + *y(k,258) + .060_r8*rxt(k,426)*y(k,259) + .060_r8*rxt(k,432) & + *y(k,260) + .580_r8*rxt(k,457)*y(k,267) + .060_r8*rxt(k,461) & + *y(k,268) + .600_r8*rxt(k,464)*y(k,269) + .500_r8*rxt(k,467) & + *y(k,270) + .400_r8*rxt(k,471)*y(k,271) + .170_r8*rxt(k,479) & + *y(k,273) + .800_r8*rxt(k,482)*y(k,274) + .270_r8*rxt(k,647) & + *y(k,279) + .100_r8*rxt(k,656)*y(k,280) + .590_r8*rxt(k,383) & + *y(k,282) + .160_r8*rxt(k,558)*y(k,283) + .330_r8*rxt(k,561) & + *y(k,285) + .180_r8*rxt(k,402)*y(k,287) + .100_r8*rxt(k,676) & + *y(k,289) + .800_r8*rxt(k,499)*y(k,291) + .180_r8*rxt(k,687) & + *y(k,297) + .180_r8*rxt(k,691)*y(k,298) + .530_r8*rxt(k,740) & + *y(k,304) + .100_r8*rxt(k,760)*y(k,306) + .100_r8*rxt(k,765) & + *y(k,307) + .100_r8*rxt(k,772)*y(k,308) + .100_r8*rxt(k,776) & + *y(k,309) + .100_r8*rxt(k,780)*y(k,310) + .100_r8*rxt(k,784) & *y(k,311) - mat(k,597) = mat(k,597) + rxt(k,315)*y(k,147) + .200_r8*rxt(k,313)*y(k,256) - mat(k,1411) = mat(k,1411) + rxt(k,504)*y(k,147) + .650_r8*rxt(k,422)*y(k,256) - mat(k,1838) = mat(k,1838) + rxt(k,506)*y(k,147) + rxt(k,425)*y(k,250) & - + 1.500_r8*rxt(k,426)*y(k,251) + .060_r8*rxt(k,427)*y(k,256) - mat(k,1740) = mat(k,1740) + rxt(k,508)*y(k,147) + rxt(k,431)*y(k,250) & - + rxt(k,432)*y(k,251) + .060_r8*rxt(k,433)*y(k,256) - mat(k,1560) = mat(k,1560) + .450_r8*rxt(k,510)*y(k,147) + .450_r8*rxt(k,445) & - *y(k,250) + .720_r8*rxt(k,446)*y(k,251) - mat(k,1581) = mat(k,1581) + .450_r8*rxt(k,512)*y(k,147) + .450_r8*rxt(k,449) & - *y(k,250) + .720_r8*rxt(k,450)*y(k,251) - mat(k,1006) = mat(k,1006) + rxt(k,514)*y(k,147) + .580_r8*rxt(k,458)*y(k,256) - mat(k,1079) = mat(k,1079) + .270_r8*rxt(k,516)*y(k,147) + .060_r8*rxt(k,462) & + mat(k,696) = mat(k,696) + rxt(k,314)*y(k,147) + .200_r8*rxt(k,312)*y(k,256) + mat(k,1304) = mat(k,1304) + rxt(k,503)*y(k,147) + .650_r8*rxt(k,421)*y(k,256) + mat(k,1969) = mat(k,1969) + rxt(k,505)*y(k,147) + rxt(k,424)*y(k,250) & + + 1.500_r8*rxt(k,425)*y(k,251) + .060_r8*rxt(k,426)*y(k,256) + mat(k,2008) = mat(k,2008) + rxt(k,507)*y(k,147) + rxt(k,430)*y(k,250) & + + rxt(k,431)*y(k,251) + .060_r8*rxt(k,432)*y(k,256) + mat(k,1752) = mat(k,1752) + .450_r8*rxt(k,509)*y(k,147) + .450_r8*rxt(k,444) & + *y(k,250) + .720_r8*rxt(k,445)*y(k,251) + mat(k,1780) = mat(k,1780) + .450_r8*rxt(k,511)*y(k,147) + .450_r8*rxt(k,448) & + *y(k,250) + .720_r8*rxt(k,449)*y(k,251) + mat(k,1127) = mat(k,1127) + rxt(k,513)*y(k,147) + .580_r8*rxt(k,457)*y(k,256) + mat(k,1173) = mat(k,1173) + .270_r8*rxt(k,515)*y(k,147) + .060_r8*rxt(k,461) & *y(k,256) - mat(k,991) = mat(k,991) + rxt(k,518)*y(k,147) + .600_r8*rxt(k,465)*y(k,256) - mat(k,1017) = mat(k,1017) + rxt(k,520)*y(k,147) + .500_r8*rxt(k,468)*y(k,256) - mat(k,1325) = mat(k,1325) + rxt(k,522)*y(k,147) + .400_r8*rxt(k,472)*y(k,256) - mat(k,2042) = mat(k,2042) + .540_r8*rxt(k,524)*y(k,147) + .540_r8*rxt(k,479) & - *y(k,149) + .540_r8*rxt(k,475)*y(k,250) + .400_r8*rxt(k,476) & - *y(k,251) + .800_r8*rxt(k,478)*y(k,272) - mat(k,1190) = mat(k,1190) + .530_r8*rxt(k,526)*y(k,147) + .170_r8*rxt(k,480) & + mat(k,1059) = mat(k,1059) + rxt(k,517)*y(k,147) + .600_r8*rxt(k,464)*y(k,256) + mat(k,1138) = mat(k,1138) + rxt(k,519)*y(k,147) + .500_r8*rxt(k,467)*y(k,256) + mat(k,1449) = mat(k,1449) + rxt(k,521)*y(k,147) + .400_r8*rxt(k,471)*y(k,256) + mat(k,2190) = mat(k,2190) + .540_r8*rxt(k,523)*y(k,147) + .540_r8*rxt(k,478) & + *y(k,149) + .540_r8*rxt(k,474)*y(k,250) + .400_r8*rxt(k,475) & + *y(k,251) + .800_r8*rxt(k,477)*y(k,272) + mat(k,1318) = mat(k,1318) + .530_r8*rxt(k,525)*y(k,147) + .170_r8*rxt(k,479) & *y(k,256) - mat(k,1266) = mat(k,1266) + .960_r8*rxt(k,528)*y(k,147) + .800_r8*rxt(k,483) & + mat(k,1426) = mat(k,1426) + .960_r8*rxt(k,527)*y(k,147) + .800_r8*rxt(k,482) & *y(k,256) - mat(k,1790) = mat(k,1790) + .450_r8*rxt(k,531)*y(k,147) + .450_r8*rxt(k,492) & - *y(k,250) + .720_r8*rxt(k,493)*y(k,251) - mat(k,1678) = mat(k,1678) + .450_r8*rxt(k,534)*y(k,147) + .450_r8*rxt(k,496) & - *y(k,250) + .720_r8*rxt(k,497)*y(k,251) - mat(k,2317) = mat(k,2317) + .500_r8*rxt(k,650)*y(k,147) + .540_r8*rxt(k,651) & - *y(k,149) + .540_r8*rxt(k,646)*y(k,250) + 1.010_r8*rxt(k,647) & - *y(k,251) + .270_r8*rxt(k,648)*y(k,256) + 1.980_r8*rxt(k,649) & - *y(k,279) + .540_r8*rxt(k,652)*y(k,300) + .540_r8*rxt(k,653) & - *y(k,302) + .540_r8*rxt(k,654)*y(k,305) - mat(k,2170) = mat(k,2170) + .770_r8*rxt(k,658)*y(k,147) + rxt(k,659)*y(k,149) & - + rxt(k,655)*y(k,250) + rxt(k,656)*y(k,251) + .100_r8*rxt(k,657) & - *y(k,256) + rxt(k,660)*y(k,300) + rxt(k,661)*y(k,302) & - + rxt(k,662)*y(k,305) - mat(k,1391) = mat(k,1391) + rxt(k,536)*y(k,147) + rxt(k,382)*y(k,250) & - + 1.500_r8*rxt(k,383)*y(k,251) + .590_r8*rxt(k,384)*y(k,256) - mat(k,755) = mat(k,755) + .400_r8*rxt(k,560)*y(k,147) + .160_r8*rxt(k,559) & + mat(k,1859) = mat(k,1859) + .450_r8*rxt(k,530)*y(k,147) + .450_r8*rxt(k,491) & + *y(k,250) + .720_r8*rxt(k,492)*y(k,251) + mat(k,1828) = mat(k,1828) + .450_r8*rxt(k,533)*y(k,147) + .450_r8*rxt(k,495) & + *y(k,250) + .720_r8*rxt(k,496)*y(k,251) + mat(k,2513) = mat(k,2513) + .500_r8*rxt(k,649)*y(k,147) + .540_r8*rxt(k,650) & + *y(k,149) + .540_r8*rxt(k,645)*y(k,250) + 1.010_r8*rxt(k,646) & + *y(k,251) + .270_r8*rxt(k,647)*y(k,256) + 1.980_r8*rxt(k,648) & + *y(k,279) + .540_r8*rxt(k,651)*y(k,300) + .540_r8*rxt(k,652) & + *y(k,302) + .540_r8*rxt(k,653)*y(k,305) + mat(k,2395) = mat(k,2395) + .770_r8*rxt(k,657)*y(k,147) + rxt(k,658)*y(k,149) & + + rxt(k,654)*y(k,250) + rxt(k,655)*y(k,251) + .100_r8*rxt(k,656) & + *y(k,256) + rxt(k,659)*y(k,300) + rxt(k,660)*y(k,302) & + + rxt(k,661)*y(k,305) + mat(k,1551) = mat(k,1551) + rxt(k,535)*y(k,147) + rxt(k,381)*y(k,250) & + + 1.500_r8*rxt(k,382)*y(k,251) + .590_r8*rxt(k,383)*y(k,256) + mat(k,870) = mat(k,870) + .400_r8*rxt(k,559)*y(k,147) + .160_r8*rxt(k,558) & *y(k,256) - mat(k,1504) = mat(k,1504) + rxt(k,390)*y(k,251) - mat(k,817) = mat(k,817) + .830_r8*rxt(k,563)*y(k,147) + .330_r8*rxt(k,562) & + mat(k,1626) = mat(k,1626) + rxt(k,389)*y(k,251) + mat(k,927) = mat(k,927) + .830_r8*rxt(k,562)*y(k,147) + .330_r8*rxt(k,561) & *y(k,256) - mat(k,1377) = mat(k,1377) + .240_r8*rxt(k,538)*y(k,147) + .250_r8*rxt(k,401) & - *y(k,250) + .620_r8*rxt(k,402)*y(k,251) + .180_r8*rxt(k,403) & + mat(k,1515) = mat(k,1515) + .240_r8*rxt(k,537)*y(k,147) + .250_r8*rxt(k,400) & + *y(k,250) + .620_r8*rxt(k,401)*y(k,251) + .180_r8*rxt(k,402) & *y(k,256) - mat(k,2378) = mat(k,2378) + .040_r8*rxt(k,670)*y(k,147) + .050_r8*rxt(k,671) & - *y(k,149) + .050_r8*rxt(k,666)*y(k,250) + .870_r8*rxt(k,667) & - *y(k,251) + .050_r8*rxt(k,672)*y(k,300) + .050_r8*rxt(k,673) & - *y(k,302) + .050_r8*rxt(k,674)*y(k,305) - mat(k,2285) = mat(k,2285) + .710_r8*rxt(k,678)*y(k,147) + rxt(k,679)*y(k,149) & - + rxt(k,675)*y(k,250) + rxt(k,676)*y(k,251) + .100_r8*rxt(k,677) & - *y(k,256) + rxt(k,680)*y(k,300) + rxt(k,681)*y(k,302) & - + rxt(k,682)*y(k,305) - mat(k,1490) = mat(k,1490) + rxt(k,540)*y(k,147) + .800_r8*rxt(k,500)*y(k,256) - mat(k,3746) = mat(k,3746) + .650_r8*rxt(k,544)*y(k,8) + rxt(k,266)*y(k,20) & - + .350_r8*rxt(k,322)*y(k,25) + rxt(k,329)*y(k,27) + rxt(k,335) & - *y(k,48) + rxt(k,306)*y(k,53) + rxt(k,236)*y(k,60) + rxt(k,309) & - *y(k,63) + .730_r8*rxt(k,555)*y(k,67) + .500_r8*rxt(k,808) & - *y(k,69) + rxt(k,346)*y(k,76) + rxt(k,347)*y(k,77) + rxt(k,186) & - *y(k,81) + rxt(k,310)*y(k,88) + .110_r8*rxt(k,348)*y(k,89) & - + rxt(k,311)*y(k,90) + .500_r8*rxt(k,312)*y(k,92) + rxt(k,380) & - *y(k,97) + .510_r8*rxt(k,415)*y(k,98) + .410_r8*rxt(k,416) & - *y(k,99) + rxt(k,363)*y(k,102) + .320_r8*rxt(k,419)*y(k,103) & - + .190_r8*rxt(k,421)*y(k,106) + .400_r8*rxt(k,424)*y(k,108) & - + rxt(k,454)*y(k,110) + rxt(k,456)*y(k,113) + .040_r8*rxt(k,461) & - *y(k,115) + .030_r8*rxt(k,471)*y(k,118) + .050_r8*rxt(k,473) & - *y(k,119) + rxt(k,489)*y(k,122) + .180_r8*rxt(k,490)*y(k,123) & - + .500_r8*rxt(k,381)*y(k,127) + rxt(k,400)*y(k,133) & - + .440_r8*rxt(k,406)*y(k,134) + .630_r8*rxt(k,503)*y(k,139) & - + rxt(k,205)*y(k,149) + rxt(k,189)*y(k,157) + .800_r8*rxt(k,567) & - *y(k,165) + rxt(k,809)*y(k,174) + rxt(k,719)*y(k,202) & - + rxt(k,738)*y(k,204) + .280_r8*rxt(k,575)*y(k,226) & - + .380_r8*rxt(k,577)*y(k,227) + .630_r8*rxt(k,583)*y(k,229) - mat(k,380) = mat(k,380) + rxt(k,566)*y(k,147) - mat(k,826) = mat(k,826) + rxt(k,367)*y(k,147) - mat(k,1230) = mat(k,1230) + .300_r8*rxt(k,369)*y(k,251) - mat(k,839) = mat(k,839) + .700_r8*rxt(k,689)*y(k,147) + .180_r8*rxt(k,688) & + mat(k,2714) = mat(k,2714) + .040_r8*rxt(k,669)*y(k,147) + .050_r8*rxt(k,670) & + *y(k,149) + .050_r8*rxt(k,665)*y(k,250) + .870_r8*rxt(k,666) & + *y(k,251) + .050_r8*rxt(k,671)*y(k,300) + .050_r8*rxt(k,672) & + *y(k,302) + .050_r8*rxt(k,673)*y(k,305) + mat(k,2817) = mat(k,2817) + .710_r8*rxt(k,677)*y(k,147) + rxt(k,678)*y(k,149) & + + rxt(k,674)*y(k,250) + rxt(k,675)*y(k,251) + .100_r8*rxt(k,676) & + *y(k,256) + rxt(k,679)*y(k,300) + rxt(k,680)*y(k,302) & + + rxt(k,681)*y(k,305) + mat(k,1651) = mat(k,1651) + rxt(k,539)*y(k,147) + .800_r8*rxt(k,499)*y(k,256) + mat(k,2646) = rxt(k,316)*y(k,55) + mat(k,3821) = mat(k,3821) + .650_r8*rxt(k,543)*y(k,8) + rxt(k,266)*y(k,20) & + + .350_r8*rxt(k,321)*y(k,25) + rxt(k,328)*y(k,27) + rxt(k,284) & + *y(k,44) + rxt(k,287)*y(k,47) + rxt(k,334)*y(k,48) + rxt(k,306) & + *y(k,53) + rxt(k,236)*y(k,60) + rxt(k,319)*y(k,63) & + + .730_r8*rxt(k,554)*y(k,67) + .500_r8*rxt(k,808)*y(k,69) & + + rxt(k,345)*y(k,76) + rxt(k,346)*y(k,77) + rxt(k,186)*y(k,81) & + + rxt(k,309)*y(k,88) + .110_r8*rxt(k,347)*y(k,89) + rxt(k,310) & + *y(k,90) + .500_r8*rxt(k,311)*y(k,92) + rxt(k,379)*y(k,97) & + + .510_r8*rxt(k,414)*y(k,98) + .410_r8*rxt(k,415)*y(k,99) & + + rxt(k,362)*y(k,102) + .320_r8*rxt(k,418)*y(k,103) & + + .190_r8*rxt(k,420)*y(k,106) + .400_r8*rxt(k,423)*y(k,108) & + + rxt(k,453)*y(k,110) + rxt(k,455)*y(k,113) + .040_r8*rxt(k,460) & + *y(k,115) + .030_r8*rxt(k,470)*y(k,118) + .050_r8*rxt(k,472) & + *y(k,119) + rxt(k,488)*y(k,122) + .180_r8*rxt(k,489)*y(k,123) & + + .500_r8*rxt(k,380)*y(k,127) + rxt(k,399)*y(k,133) & + + .440_r8*rxt(k,405)*y(k,134) + .630_r8*rxt(k,502)*y(k,139) & + + rxt(k,205)*y(k,149) + rxt(k,189)*y(k,157) + .800_r8*rxt(k,566) & + *y(k,165) + rxt(k,798)*y(k,174) + rxt(k,718)*y(k,202) & + + rxt(k,737)*y(k,204) + .280_r8*rxt(k,574)*y(k,226) & + + .380_r8*rxt(k,576)*y(k,227) + .630_r8*rxt(k,582)*y(k,229) + mat(k,456) = mat(k,456) + rxt(k,565)*y(k,147) + mat(k,937) = mat(k,937) + rxt(k,366)*y(k,147) + mat(k,1341) = mat(k,1341) + .300_r8*rxt(k,368)*y(k,251) + mat(k,950) = mat(k,950) + .700_r8*rxt(k,688)*y(k,147) + .180_r8*rxt(k,687) & *y(k,256) - mat(k,922) = mat(k,922) + .700_r8*rxt(k,693)*y(k,147) + .180_r8*rxt(k,692) & + mat(k,1009) = mat(k,1009) + .700_r8*rxt(k,692)*y(k,147) + .180_r8*rxt(k,691) & *y(k,256) - mat(k,2456) = mat(k,2456) + .500_r8*rxt(k,695)*y(k,251) - mat(k,2541) = mat(k,2541) + rxt(k,600)*y(k,236) + rxt(k,620)*y(k,239) & - + .500_r8*rxt(k,632)*y(k,243) + rxt(k,640)*y(k,244) + rxt(k,703) & + mat(k,2739) = mat(k,2739) + .500_r8*rxt(k,694)*y(k,251) + mat(k,2956) = mat(k,2956) + rxt(k,599)*y(k,236) + rxt(k,619)*y(k,239) & + + .500_r8*rxt(k,631)*y(k,243) + rxt(k,639)*y(k,244) + rxt(k,702) & + *y(k,251) + .540_r8*rxt(k,651)*y(k,279) + rxt(k,659)*y(k,280) & + + .050_r8*rxt(k,671)*y(k,288) + rxt(k,679)*y(k,289) + rxt(k,743) & + *y(k,304) + mat(k,2784) = mat(k,2784) + rxt(k,710)*y(k,251) + mat(k,2863) = mat(k,2863) + rxt(k,600)*y(k,236) + rxt(k,620)*y(k,239) & + + .500_r8*rxt(k,632)*y(k,243) + rxt(k,640)*y(k,244) + rxt(k,720) & *y(k,251) + .540_r8*rxt(k,652)*y(k,279) + rxt(k,660)*y(k,280) & + .050_r8*rxt(k,672)*y(k,288) + rxt(k,680)*y(k,289) + rxt(k,744) & *y(k,304) - mat(k,2498) = mat(k,2498) + rxt(k,711)*y(k,251) - mat(k,2587) = mat(k,2587) + rxt(k,601)*y(k,236) + rxt(k,621)*y(k,239) & - + .500_r8*rxt(k,633)*y(k,243) + rxt(k,641)*y(k,244) + rxt(k,721) & + mat(k,2249) = mat(k,2249) + rxt(k,729)*y(k,251) + mat(k,2761) = mat(k,2761) + .910_r8*rxt(k,741)*y(k,147) + rxt(k,742)*y(k,149) & + + rxt(k,738)*y(k,250) + 2.000_r8*rxt(k,739)*y(k,251) & + + .530_r8*rxt(k,740)*y(k,256) + rxt(k,743)*y(k,300) + rxt(k,744) & + *y(k,302) + rxt(k,745)*y(k,305) + mat(k,2910) = mat(k,2910) + rxt(k,601)*y(k,236) + rxt(k,621)*y(k,239) & + + .500_r8*rxt(k,633)*y(k,243) + rxt(k,641)*y(k,244) + rxt(k,750) & *y(k,251) + .540_r8*rxt(k,653)*y(k,279) + rxt(k,661)*y(k,280) & + .050_r8*rxt(k,673)*y(k,288) + rxt(k,681)*y(k,289) + rxt(k,745) & *y(k,304) - mat(k,2086) = mat(k,2086) + rxt(k,730)*y(k,251) - mat(k,2477) = mat(k,2477) + .910_r8*rxt(k,742)*y(k,147) + rxt(k,743)*y(k,149) & - + rxt(k,739)*y(k,250) + 2.000_r8*rxt(k,740)*y(k,251) & - + .530_r8*rxt(k,741)*y(k,256) + rxt(k,744)*y(k,300) + rxt(k,745) & - *y(k,302) + rxt(k,746)*y(k,305) - mat(k,2634) = mat(k,2634) + rxt(k,602)*y(k,236) + rxt(k,622)*y(k,239) & - + .500_r8*rxt(k,634)*y(k,243) + rxt(k,642)*y(k,244) + rxt(k,751) & - *y(k,251) + .540_r8*rxt(k,654)*y(k,279) + rxt(k,662)*y(k,280) & - + .050_r8*rxt(k,674)*y(k,288) + rxt(k,682)*y(k,289) + rxt(k,746) & - *y(k,304) - mat(k,684) = mat(k,684) + .700_r8*rxt(k,762)*y(k,147) + .100_r8*rxt(k,761) & + mat(k,800) = mat(k,800) + .700_r8*rxt(k,761)*y(k,147) + .100_r8*rxt(k,760) & *y(k,256) - mat(k,849) = mat(k,849) + .700_r8*rxt(k,767)*y(k,147) + .100_r8*rxt(k,766) & + mat(k,959) = mat(k,959) + .700_r8*rxt(k,766)*y(k,147) + .100_r8*rxt(k,765) & *y(k,256) - mat(k,1150) = mat(k,1150) + .700_r8*rxt(k,774)*y(k,147) + .100_r8*rxt(k,773) & + mat(k,1222) = mat(k,1222) + .700_r8*rxt(k,773)*y(k,147) + .100_r8*rxt(k,772) & *y(k,256) - mat(k,931) = mat(k,931) + .700_r8*rxt(k,778)*y(k,147) + .100_r8*rxt(k,777) & + mat(k,1018) = mat(k,1018) + .700_r8*rxt(k,777)*y(k,147) + .100_r8*rxt(k,776) & *y(k,256) - mat(k,693) = mat(k,693) + .700_r8*rxt(k,782)*y(k,147) + .100_r8*rxt(k,781) & + mat(k,808) = mat(k,808) + .700_r8*rxt(k,781)*y(k,147) + .100_r8*rxt(k,780) & *y(k,256) - mat(k,701) = mat(k,701) + .700_r8*rxt(k,786)*y(k,147) + .100_r8*rxt(k,785) & + mat(k,816) = mat(k,816) + .700_r8*rxt(k,785)*y(k,147) + .100_r8*rxt(k,784) & *y(k,256) - mat(k,769) = mat(k,769) + rxt(k,573)*y(k,147) - mat(k,786) = mat(k,786) + rxt(k,579)*y(k,147) - mat(k,447) = mat(k,447) + rxt(k,582)*y(k,147) + mat(k,884) = mat(k,884) + rxt(k,572)*y(k,147) + mat(k,901) = mat(k,901) + rxt(k,578)*y(k,147) + mat(k,537) = mat(k,537) + rxt(k,581)*y(k,147) end do end subroutine nlnmat13 subroutine nlnmat14( avec_len, mat, y, rxt ) @@ -3580,212 +3859,212 @@ subroutine nlnmat14( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,593) = -(rxt(k,313)*y(k,256) + rxt(k,315)*y(k,147)) - mat(k,3164) = -rxt(k,313)*y(k,257) - mat(k,2776) = -rxt(k,315)*y(k,257) - mat(k,3322) = rxt(k,298)*y(k,256) - mat(k,3164) = mat(k,3164) + rxt(k,298)*y(k,43) - mat(k,1404) = -(rxt(k,422)*y(k,256) + (rxt(k,504) + rxt(k,505)) * y(k,147)) - mat(k,3224) = -rxt(k,422)*y(k,258) - mat(k,2830) = -(rxt(k,504) + rxt(k,505)) * y(k,258) - mat(k,1695) = .320_r8*rxt(k,419)*y(k,293) - mat(k,804) = .810_r8*rxt(k,421)*y(k,293) - mat(k,3685) = .320_r8*rxt(k,419)*y(k,103) + .810_r8*rxt(k,421)*y(k,106) - mat(k,1829) = -(rxt(k,425)*y(k,250) + rxt(k,426)*y(k,251) + rxt(k,427) & - *y(k,256) + (rxt(k,506) + rxt(k,507)) * y(k,147)) - mat(k,2669) = -rxt(k,425)*y(k,259) - mat(k,3389) = -rxt(k,426)*y(k,259) - mat(k,3248) = -rxt(k,427)*y(k,259) - mat(k,2852) = -(rxt(k,506) + rxt(k,507)) * y(k,259) - mat(k,1893) = .530_r8*rxt(k,490)*y(k,293) - mat(k,3710) = .530_r8*rxt(k,490)*y(k,123) - mat(k,1729) = -(rxt(k,431)*y(k,250) + rxt(k,432)*y(k,251) + rxt(k,433) & - *y(k,256) + (rxt(k,508) + rxt(k,509)) * y(k,147)) - mat(k,2665) = -rxt(k,431)*y(k,260) - mat(k,3385) = -rxt(k,432)*y(k,260) - mat(k,3244) = -rxt(k,433)*y(k,260) - mat(k,2848) = -(rxt(k,508) + rxt(k,509)) * y(k,260) - mat(k,1890) = .160_r8*rxt(k,490)*y(k,293) - mat(k,3706) = .160_r8*rxt(k,490)*y(k,123) - mat(k,1279) = .315_r8*rxt(k,488)*y(k,293) - mat(k,3551) = .315_r8*rxt(k,488)*y(k,109) - mat(k,1280) = .315_r8*rxt(k,488)*y(k,293) - mat(k,3552) = .315_r8*rxt(k,488)*y(k,109) - mat(k,1281) = .259_r8*rxt(k,488)*y(k,293) - mat(k,3553) = .259_r8*rxt(k,488)*y(k,109) - mat(k,1282) = .111_r8*rxt(k,488)*y(k,293) - mat(k,3554) = .111_r8*rxt(k,488)*y(k,109) - mat(k,1550) = -(rxt(k,445)*y(k,250) + rxt(k,446)*y(k,251) + rxt(k,447) & - *y(k,256) + (rxt(k,510) + rxt(k,511)) * y(k,147)) - mat(k,2656) = -rxt(k,445)*y(k,265) - mat(k,3375) = -rxt(k,446)*y(k,265) - mat(k,3233) = -rxt(k,447)*y(k,265) - mat(k,2837) = -(rxt(k,510) + rxt(k,511)) * y(k,265) - mat(k,1571) = -(rxt(k,449)*y(k,250) + rxt(k,450)*y(k,251) + rxt(k,451) & - *y(k,256) + (rxt(k,512) + rxt(k,513)) * y(k,147)) - mat(k,2657) = -rxt(k,449)*y(k,266) - mat(k,3376) = -rxt(k,450)*y(k,266) - mat(k,3234) = -rxt(k,451)*y(k,266) - mat(k,2838) = -(rxt(k,512) + rxt(k,513)) * y(k,266) - mat(k,999) = -(rxt(k,458)*y(k,256) + (rxt(k,514) + rxt(k,515)) * y(k,147)) - mat(k,3194) = -rxt(k,458)*y(k,267) - mat(k,2803) = -(rxt(k,514) + rxt(k,515)) * y(k,267) - mat(k,1913) = .820_r8*rxt(k,461)*y(k,293) - mat(k,3647) = .820_r8*rxt(k,461)*y(k,115) - mat(k,1071) = -(rxt(k,462)*y(k,256) + (rxt(k,516) + rxt(k,517)) * y(k,147)) - mat(k,3200) = -rxt(k,462)*y(k,268) - mat(k,2807) = -(rxt(k,516) + rxt(k,517)) * y(k,268) - mat(k,575) = .850_r8*rxt(k,464)*y(k,293) - mat(k,3654) = .850_r8*rxt(k,464)*y(k,116) - mat(k,985) = -(rxt(k,465)*y(k,256) + (rxt(k,518) + rxt(k,519)) * y(k,147)) - mat(k,3192) = -rxt(k,465)*y(k,269) - mat(k,2801) = -(rxt(k,518) + rxt(k,519)) * y(k,269) - mat(k,476) = .870_r8*rxt(k,467)*y(k,293) - mat(k,3645) = .870_r8*rxt(k,467)*y(k,117) - mat(k,1010) = -(rxt(k,468)*y(k,256) + (rxt(k,520) + rxt(k,521)) * y(k,147)) - mat(k,3195) = -rxt(k,468)*y(k,270) - mat(k,2804) = -(rxt(k,520) + rxt(k,521)) * y(k,270) - mat(k,1947) = .890_r8*rxt(k,471)*y(k,293) - mat(k,3648) = .890_r8*rxt(k,471)*y(k,118) - mat(k,1315) = -(rxt(k,472)*y(k,256) + (rxt(k,522) + rxt(k,523)) * y(k,147)) - mat(k,3214) = -rxt(k,472)*y(k,271) - mat(k,2821) = -(rxt(k,522) + rxt(k,523)) * y(k,271) - mat(k,625) = .920_r8*rxt(k,473)*y(k,293) - mat(k,3675) = .920_r8*rxt(k,473)*y(k,119) - mat(k,2034) = -(rxt(k,475)*y(k,250) + rxt(k,476)*y(k,251) + rxt(k,477) & - *y(k,256) + 4._r8*rxt(k,478)*y(k,272) + rxt(k,479)*y(k,149) & - + (rxt(k,524) + rxt(k,525)) * y(k,147)) - mat(k,2676) = -rxt(k,475)*y(k,272) - mat(k,3396) = -rxt(k,476)*y(k,272) - mat(k,3255) = -rxt(k,477)*y(k,272) - mat(k,3052) = -rxt(k,479)*y(k,272) - mat(k,2859) = -(rxt(k,524) + rxt(k,525)) * y(k,272) - mat(k,1296) = rxt(k,474)*y(k,149) - mat(k,1057) = .170_r8*rxt(k,482)*y(k,293) - mat(k,1450) = .070_r8*rxt(k,486)*y(k,293) - mat(k,3052) = mat(k,3052) + rxt(k,474)*y(k,109) - mat(k,3717) = .170_r8*rxt(k,482)*y(k,120) + .070_r8*rxt(k,486)*y(k,121) - mat(k,1180) = -(rxt(k,480)*y(k,256) + (rxt(k,526) + rxt(k,527)) * y(k,147)) - mat(k,3207) = -rxt(k,480)*y(k,273) - mat(k,2814) = -(rxt(k,526) + rxt(k,527)) * y(k,273) - mat(k,1050) = .410_r8*rxt(k,482)*y(k,293) - mat(k,3665) = .410_r8*rxt(k,482)*y(k,120) - mat(k,1255) = -(rxt(k,483)*y(k,256) + (rxt(k,528) + rxt(k,529)) * y(k,147)) - mat(k,3211) = -rxt(k,483)*y(k,274) - mat(k,2818) = -(rxt(k,528) + rxt(k,529)) * y(k,274) - mat(k,1433) = .570_r8*rxt(k,486)*y(k,293) - mat(k,3671) = .570_r8*rxt(k,486)*y(k,121) - mat(k,70) = -(rxt(k,861)*y(k,256) + rxt(k,862)*y(k,147)) - mat(k,3127) = -rxt(k,861)*y(k,275) - mat(k,2752) = -rxt(k,862)*y(k,275) - mat(k,1278) = rxt(k,864)*y(k,293) - mat(k,3527) = rxt(k,864)*y(k,109) - mat(k,1780) = -(rxt(k,492)*y(k,250) + rxt(k,493)*y(k,251) + rxt(k,494) & - *y(k,256) + (rxt(k,531) + rxt(k,532)) * y(k,147)) - mat(k,2667) = -rxt(k,492)*y(k,276) - mat(k,3387) = -rxt(k,493)*y(k,276) - mat(k,3246) = -rxt(k,494)*y(k,276) - mat(k,2850) = -(rxt(k,531) + rxt(k,532)) * y(k,276) - mat(k,1667) = -(rxt(k,496)*y(k,250) + rxt(k,497)*y(k,251) + rxt(k,498) & - *y(k,256) + (rxt(k,534) + rxt(k,535)) * y(k,147)) - mat(k,2663) = -rxt(k,496)*y(k,277) - mat(k,3383) = -rxt(k,497)*y(k,277) - mat(k,3241) = -rxt(k,498)*y(k,277) - mat(k,2845) = -(rxt(k,534) + rxt(k,535)) * y(k,277) - mat(k,76) = -(rxt(k,865)*y(k,256) + rxt(k,866)*y(k,147)) - mat(k,3128) = -rxt(k,865)*y(k,278) - mat(k,2753) = -rxt(k,866)*y(k,278) - mat(k,77) = rxt(k,867)*y(k,293) - mat(k,3528) = rxt(k,867)*y(k,124) - mat(k,2303) = -(rxt(k,646)*y(k,250) + rxt(k,647)*y(k,251) + rxt(k,648) & - *y(k,256) + 4._r8*rxt(k,649)*y(k,279) + rxt(k,650)*y(k,147) & - + rxt(k,651)*y(k,149) + rxt(k,652)*y(k,300) + rxt(k,653) & - *y(k,302) + rxt(k,654)*y(k,305)) - mat(k,2688) = -rxt(k,646)*y(k,279) - mat(k,3408) = -rxt(k,647)*y(k,279) - mat(k,3267) = -rxt(k,648)*y(k,279) - mat(k,2871) = -rxt(k,650)*y(k,279) - mat(k,3064) = -rxt(k,651)*y(k,279) - mat(k,2524) = -rxt(k,652)*y(k,279) - mat(k,2570) = -rxt(k,653)*y(k,279) - mat(k,2617) = -rxt(k,654)*y(k,279) - mat(k,964) = rxt(k,645)*y(k,149) - mat(k,3064) = mat(k,3064) + rxt(k,645)*y(k,125) - mat(k,2156) = -(rxt(k,655)*y(k,250) + rxt(k,656)*y(k,251) + rxt(k,657) & - *y(k,256) + rxt(k,658)*y(k,147) + rxt(k,659)*y(k,149) + rxt(k,660) & - *y(k,300) + rxt(k,661)*y(k,302) + rxt(k,662)*y(k,305)) - mat(k,2682) = -rxt(k,655)*y(k,280) - mat(k,3402) = -rxt(k,656)*y(k,280) - mat(k,3261) = -rxt(k,657)*y(k,280) - mat(k,2865) = -rxt(k,658)*y(k,280) - mat(k,3058) = -rxt(k,659)*y(k,280) - mat(k,2518) = -rxt(k,660)*y(k,280) - mat(k,2564) = -rxt(k,661)*y(k,280) - mat(k,2611) = -rxt(k,662)*y(k,280) - mat(k,963) = rxt(k,664)*y(k,293) - mat(k,3722) = rxt(k,664)*y(k,125) - mat(k,84) = -(rxt(k,869)*y(k,256) + rxt(k,870)*y(k,147)) - mat(k,3129) = -rxt(k,869)*y(k,281) - mat(k,2754) = -rxt(k,870)*y(k,281) - mat(k,959) = rxt(k,872)*y(k,293) - mat(k,3530) = rxt(k,872)*y(k,125) - mat(k,1383) = -(rxt(k,382)*y(k,250) + rxt(k,383)*y(k,251) + rxt(k,384) & - *y(k,256) + (rxt(k,536) + rxt(k,537)) * y(k,147)) - mat(k,2650) = -rxt(k,382)*y(k,282) - mat(k,3367) = -rxt(k,383)*y(k,282) - mat(k,3222) = -rxt(k,384)*y(k,282) - mat(k,2828) = -(rxt(k,536) + rxt(k,537)) * y(k,282) - mat(k,1746) = .550_r8*rxt(k,387)*y(k,293) - mat(k,3683) = .550_r8*rxt(k,387)*y(k,126) - mat(k,751) = -(rxt(k,559)*y(k,256) + rxt(k,560)*y(k,147) + rxt(k,561) & + mat(k,691) = -(rxt(k,312)*y(k,256) + rxt(k,314)*y(k,147)) + mat(k,3442) = -rxt(k,312)*y(k,257) + mat(k,3197) = -rxt(k,314)*y(k,257) + mat(k,3341) = rxt(k,298)*y(k,256) + mat(k,3442) = mat(k,3442) + rxt(k,298)*y(k,43) + mat(k,1296) = -(rxt(k,421)*y(k,256) + (rxt(k,503) + rxt(k,504)) * y(k,147)) + mat(k,3486) = -rxt(k,421)*y(k,258) + mat(k,3232) = -(rxt(k,503) + rxt(k,504)) * y(k,258) + mat(k,1864) = .320_r8*rxt(k,418)*y(k,293) + mat(k,1520) = .810_r8*rxt(k,420)*y(k,293) + mat(k,3732) = .320_r8*rxt(k,418)*y(k,103) + .810_r8*rxt(k,420)*y(k,106) + mat(k,1959) = -(rxt(k,424)*y(k,250) + rxt(k,425)*y(k,251) + rxt(k,426) & + *y(k,256) + (rxt(k,505) + rxt(k,506)) * y(k,147)) + mat(k,2990) = -rxt(k,424)*y(k,259) + mat(k,4007) = -rxt(k,425)*y(k,259) + mat(k,3528) = -rxt(k,426)*y(k,259) + mat(k,3272) = -(rxt(k,505) + rxt(k,506)) * y(k,259) + mat(k,1898) = .530_r8*rxt(k,489)*y(k,293) + mat(k,3779) = .530_r8*rxt(k,489)*y(k,123) + mat(k,1997) = -(rxt(k,430)*y(k,250) + rxt(k,431)*y(k,251) + rxt(k,432) & + *y(k,256) + (rxt(k,507) + rxt(k,508)) * y(k,147)) + mat(k,2991) = -rxt(k,430)*y(k,260) + mat(k,4008) = -rxt(k,431)*y(k,260) + mat(k,3529) = -rxt(k,432)*y(k,260) + mat(k,3273) = -(rxt(k,507) + rxt(k,508)) * y(k,260) + mat(k,1899) = .160_r8*rxt(k,489)*y(k,293) + mat(k,3780) = .160_r8*rxt(k,489)*y(k,123) + mat(k,1384) = .315_r8*rxt(k,487)*y(k,293) + mat(k,3615) = .315_r8*rxt(k,487)*y(k,109) + mat(k,1385) = .315_r8*rxt(k,487)*y(k,293) + mat(k,3616) = .315_r8*rxt(k,487)*y(k,109) + mat(k,1386) = .259_r8*rxt(k,487)*y(k,293) + mat(k,3617) = .259_r8*rxt(k,487)*y(k,109) + mat(k,1387) = .111_r8*rxt(k,487)*y(k,293) + mat(k,3618) = .111_r8*rxt(k,487)*y(k,109) + mat(k,1740) = -(rxt(k,444)*y(k,250) + rxt(k,445)*y(k,251) + rxt(k,446) & + *y(k,256) + (rxt(k,509) + rxt(k,510)) * y(k,147)) + mat(k,2980) = -rxt(k,444)*y(k,265) + mat(k,3996) = -rxt(k,445)*y(k,265) + mat(k,3517) = -rxt(k,446)*y(k,265) + mat(k,3261) = -(rxt(k,509) + rxt(k,510)) * y(k,265) + mat(k,1769) = -(rxt(k,448)*y(k,250) + rxt(k,449)*y(k,251) + rxt(k,450) & + *y(k,256) + (rxt(k,511) + rxt(k,512)) * y(k,147)) + mat(k,2982) = -rxt(k,448)*y(k,266) + mat(k,3998) = -rxt(k,449)*y(k,266) + mat(k,3519) = -rxt(k,450)*y(k,266) + mat(k,3263) = -(rxt(k,511) + rxt(k,512)) * y(k,266) + mat(k,1119) = -(rxt(k,457)*y(k,256) + (rxt(k,513) + rxt(k,514)) * y(k,147)) + mat(k,3475) = -rxt(k,457)*y(k,267) + mat(k,3224) = -(rxt(k,513) + rxt(k,514)) * y(k,267) + mat(k,2093) = .820_r8*rxt(k,460)*y(k,293) + mat(k,3716) = .820_r8*rxt(k,460)*y(k,115) + mat(k,1164) = -(rxt(k,461)*y(k,256) + (rxt(k,515) + rxt(k,516)) * y(k,147)) + mat(k,3480) = -rxt(k,461)*y(k,268) + mat(k,3227) = -(rxt(k,515) + rxt(k,516)) * y(k,268) + mat(k,611) = .850_r8*rxt(k,463)*y(k,293) + mat(k,3721) = .850_r8*rxt(k,463)*y(k,116) + mat(k,1052) = -(rxt(k,464)*y(k,256) + (rxt(k,517) + rxt(k,518)) * y(k,147)) + mat(k,3473) = -rxt(k,464)*y(k,269) + mat(k,3221) = -(rxt(k,517) + rxt(k,518)) * y(k,269) + mat(k,559) = .870_r8*rxt(k,466)*y(k,293) + mat(k,3711) = .870_r8*rxt(k,466)*y(k,117) + mat(k,1130) = -(rxt(k,467)*y(k,256) + (rxt(k,519) + rxt(k,520)) * y(k,147)) + mat(k,3476) = -rxt(k,467)*y(k,270) + mat(k,3225) = -(rxt(k,519) + rxt(k,520)) * y(k,270) + mat(k,2061) = .890_r8*rxt(k,470)*y(k,293) + mat(k,3717) = .890_r8*rxt(k,470)*y(k,118) + mat(k,1438) = -(rxt(k,471)*y(k,256) + (rxt(k,521) + rxt(k,522)) * y(k,147)) + mat(k,3493) = -rxt(k,471)*y(k,271) + mat(k,3239) = -(rxt(k,521) + rxt(k,522)) * y(k,271) + mat(k,760) = .920_r8*rxt(k,472)*y(k,293) + mat(k,3742) = .920_r8*rxt(k,472)*y(k,119) + mat(k,2180) = -(rxt(k,474)*y(k,250) + rxt(k,475)*y(k,251) + rxt(k,476) & + *y(k,256) + 4._r8*rxt(k,477)*y(k,272) + rxt(k,478)*y(k,149) & + + (rxt(k,523) + rxt(k,524)) * y(k,147)) + mat(k,2997) = -rxt(k,474)*y(k,272) + mat(k,4014) = -rxt(k,475)*y(k,272) + mat(k,3535) = -rxt(k,476)*y(k,272) + mat(k,3920) = -rxt(k,478)*y(k,272) + mat(k,3279) = -(rxt(k,523) + rxt(k,524)) * y(k,272) + mat(k,1402) = rxt(k,473)*y(k,149) + mat(k,1188) = .170_r8*rxt(k,481)*y(k,293) + mat(k,1582) = .070_r8*rxt(k,485)*y(k,293) + mat(k,3920) = mat(k,3920) + rxt(k,473)*y(k,109) + mat(k,3786) = .170_r8*rxt(k,481)*y(k,120) + .070_r8*rxt(k,485)*y(k,121) + mat(k,1307) = -(rxt(k,479)*y(k,256) + (rxt(k,525) + rxt(k,526)) * y(k,147)) + mat(k,3487) = -rxt(k,479)*y(k,273) + mat(k,3233) = -(rxt(k,525) + rxt(k,526)) * y(k,273) + mat(k,1179) = .410_r8*rxt(k,481)*y(k,293) + mat(k,3733) = .410_r8*rxt(k,481)*y(k,120) + mat(k,1413) = -(rxt(k,482)*y(k,256) + (rxt(k,527) + rxt(k,528)) * y(k,147)) + mat(k,3491) = -rxt(k,482)*y(k,274) + mat(k,3237) = -(rxt(k,527) + rxt(k,528)) * y(k,274) + mat(k,1563) = .570_r8*rxt(k,485)*y(k,293) + mat(k,3740) = .570_r8*rxt(k,485)*y(k,121) + mat(k,79) = -(rxt(k,860)*y(k,256) + rxt(k,861)*y(k,147)) + mat(k,3408) = -rxt(k,860)*y(k,275) + mat(k,3173) = -rxt(k,861)*y(k,275) + mat(k,1383) = rxt(k,863)*y(k,293) + mat(k,3588) = rxt(k,863)*y(k,109) + mat(k,1846) = -(rxt(k,491)*y(k,250) + rxt(k,492)*y(k,251) + rxt(k,493) & + *y(k,256) + (rxt(k,530) + rxt(k,531)) * y(k,147)) + mat(k,2984) = -rxt(k,491)*y(k,276) + mat(k,4001) = -rxt(k,492)*y(k,276) + mat(k,3522) = -rxt(k,493)*y(k,276) + mat(k,3266) = -(rxt(k,530) + rxt(k,531)) * y(k,276) + mat(k,1815) = -(rxt(k,495)*y(k,250) + rxt(k,496)*y(k,251) + rxt(k,497) & + *y(k,256) + (rxt(k,533) + rxt(k,534)) * y(k,147)) + mat(k,2983) = -rxt(k,495)*y(k,277) + mat(k,4000) = -rxt(k,496)*y(k,277) + mat(k,3521) = -rxt(k,497)*y(k,277) + mat(k,3265) = -(rxt(k,533) + rxt(k,534)) * y(k,277) + mat(k,85) = -(rxt(k,864)*y(k,256) + rxt(k,865)*y(k,147)) + mat(k,3409) = -rxt(k,864)*y(k,278) + mat(k,3174) = -rxt(k,865)*y(k,278) + mat(k,86) = rxt(k,866)*y(k,293) + mat(k,3589) = rxt(k,866)*y(k,124) + mat(k,2499) = -(rxt(k,645)*y(k,250) + rxt(k,646)*y(k,251) + rxt(k,647) & + *y(k,256) + 4._r8*rxt(k,648)*y(k,279) + rxt(k,649)*y(k,147) & + + rxt(k,650)*y(k,149) + rxt(k,651)*y(k,300) + rxt(k,652) & + *y(k,302) + rxt(k,653)*y(k,305)) + mat(k,3010) = -rxt(k,645)*y(k,279) + mat(k,4027) = -rxt(k,646)*y(k,279) + mat(k,3549) = -rxt(k,647)*y(k,279) + mat(k,3293) = -rxt(k,649)*y(k,279) + mat(k,3934) = -rxt(k,650)*y(k,279) + mat(k,2938) = -rxt(k,651)*y(k,279) + mat(k,2845) = -rxt(k,652)*y(k,279) + mat(k,2892) = -rxt(k,653)*y(k,279) + mat(k,1073) = rxt(k,644)*y(k,149) + mat(k,3934) = mat(k,3934) + rxt(k,644)*y(k,125) + mat(k,2381) = -(rxt(k,654)*y(k,250) + rxt(k,655)*y(k,251) + rxt(k,656) & + *y(k,256) + rxt(k,657)*y(k,147) + rxt(k,658)*y(k,149) + rxt(k,659) & + *y(k,300) + rxt(k,660)*y(k,302) + rxt(k,661)*y(k,305)) + mat(k,3006) = -rxt(k,654)*y(k,280) + mat(k,4023) = -rxt(k,655)*y(k,280) + mat(k,3545) = -rxt(k,656)*y(k,280) + mat(k,3289) = -rxt(k,657)*y(k,280) + mat(k,3930) = -rxt(k,658)*y(k,280) + mat(k,2934) = -rxt(k,659)*y(k,280) + mat(k,2841) = -rxt(k,660)*y(k,280) + mat(k,2888) = -rxt(k,661)*y(k,280) + mat(k,1072) = rxt(k,663)*y(k,293) + mat(k,3795) = rxt(k,663)*y(k,125) + mat(k,93) = -(rxt(k,868)*y(k,256) + rxt(k,869)*y(k,147)) + mat(k,3410) = -rxt(k,868)*y(k,281) + mat(k,3175) = -rxt(k,869)*y(k,281) + mat(k,1067) = rxt(k,871)*y(k,293) + mat(k,3591) = rxt(k,871)*y(k,125) + mat(k,1541) = -(rxt(k,381)*y(k,250) + rxt(k,382)*y(k,251) + rxt(k,383) & + *y(k,256) + (rxt(k,535) + rxt(k,536)) * y(k,147)) + mat(k,2971) = -rxt(k,381)*y(k,282) + mat(k,3985) = -rxt(k,382)*y(k,282) + mat(k,3504) = -rxt(k,383)*y(k,282) + mat(k,3250) = -(rxt(k,535) + rxt(k,536)) * y(k,282) + mat(k,2015) = .550_r8*rxt(k,386)*y(k,293) + mat(k,3754) = .550_r8*rxt(k,386)*y(k,126) + mat(k,866) = -(rxt(k,558)*y(k,256) + rxt(k,559)*y(k,147) + rxt(k,560) & *y(k,148)) - mat(k,3177) = -rxt(k,559)*y(k,283) - mat(k,2785) = -rxt(k,560)*y(k,283) - mat(k,3480) = -rxt(k,561)*y(k,283) - mat(k,1497) = -(rxt(k,389)*y(k,250) + rxt(k,390)*y(k,251) + rxt(k,391) & - *y(k,256) + 4._r8*rxt(k,392)*y(k,284) + rxt(k,393)*y(k,147) & - + rxt(k,394)*y(k,149) + rxt(k,407)*y(k,148)) - mat(k,2654) = -rxt(k,389)*y(k,284) - mat(k,3372) = -rxt(k,390)*y(k,284) - mat(k,3230) = -rxt(k,391)*y(k,284) - mat(k,2834) = -rxt(k,393)*y(k,284) - mat(k,3029) = -rxt(k,394)*y(k,284) - mat(k,3488) = -rxt(k,407)*y(k,284) - mat(k,1747) = .450_r8*rxt(k,387)*y(k,293) - mat(k,3691) = .450_r8*rxt(k,387)*y(k,126) - mat(k,812) = -(rxt(k,562)*y(k,256) + rxt(k,563)*y(k,147) + rxt(k,564) & + mat(k,3458) = -rxt(k,558)*y(k,283) + mat(k,3206) = -rxt(k,559)*y(k,283) + mat(k,4069) = -rxt(k,560)*y(k,283) + mat(k,1618) = -(rxt(k,388)*y(k,250) + rxt(k,389)*y(k,251) + rxt(k,390) & + *y(k,256) + 4._r8*rxt(k,391)*y(k,284) + rxt(k,392)*y(k,147) & + + rxt(k,393)*y(k,149) + rxt(k,406)*y(k,148)) + mat(k,2974) = -rxt(k,388)*y(k,284) + mat(k,3988) = -rxt(k,389)*y(k,284) + mat(k,3508) = -rxt(k,390)*y(k,284) + mat(k,3253) = -rxt(k,392)*y(k,284) + mat(k,3898) = -rxt(k,393)*y(k,284) + mat(k,4079) = -rxt(k,406)*y(k,284) + mat(k,2017) = .450_r8*rxt(k,386)*y(k,293) + mat(k,3759) = .450_r8*rxt(k,386)*y(k,126) + mat(k,922) = -(rxt(k,561)*y(k,256) + rxt(k,562)*y(k,147) + rxt(k,563) & *y(k,148)) - mat(k,3182) = -rxt(k,562)*y(k,285) - mat(k,2791) = -rxt(k,563)*y(k,285) - mat(k,3482) = -rxt(k,564)*y(k,285) - mat(k,656) = -(rxt(k,395)*y(k,256) + rxt(k,396)*y(k,147)) - mat(k,3168) = -rxt(k,395)*y(k,286) - mat(k,2779) = -rxt(k,396)*y(k,286) - mat(k,451) = rxt(k,397)*y(k,293) - mat(k,266) = rxt(k,398)*y(k,293) - mat(k,3614) = rxt(k,397)*y(k,129) + rxt(k,398)*y(k,130) - mat(k,1370) = -(rxt(k,401)*y(k,250) + rxt(k,402)*y(k,251) + rxt(k,403) & - *y(k,256) + (rxt(k,538) + rxt(k,539)) * y(k,147)) - mat(k,2649) = -rxt(k,401)*y(k,287) - mat(k,3366) = -rxt(k,402)*y(k,287) - mat(k,3221) = -rxt(k,403)*y(k,287) - mat(k,2827) = -(rxt(k,538) + rxt(k,539)) * y(k,287) - mat(k,1857) = rxt(k,405)*y(k,293) - mat(k,3682) = rxt(k,405)*y(k,132) - mat(k,2364) = -(rxt(k,666)*y(k,250) + rxt(k,667)*y(k,251) + rxt(k,668) & - *y(k,256) + 4._r8*rxt(k,669)*y(k,288) + rxt(k,670)*y(k,147) & - + rxt(k,671)*y(k,149) + rxt(k,672)*y(k,300) + rxt(k,673) & - *y(k,302) + rxt(k,674)*y(k,305)) - mat(k,2690) = -rxt(k,666)*y(k,288) - mat(k,3410) = -rxt(k,667)*y(k,288) - mat(k,3269) = -rxt(k,668)*y(k,288) - mat(k,2873) = -rxt(k,670)*y(k,288) - mat(k,3066) = -rxt(k,671)*y(k,288) - mat(k,2526) = -rxt(k,672)*y(k,288) - mat(k,2572) = -rxt(k,673)*y(k,288) - mat(k,2619) = -rxt(k,674)*y(k,288) - mat(k,714) = rxt(k,665)*y(k,149) - mat(k,3066) = mat(k,3066) + rxt(k,665)*y(k,135) + mat(k,3462) = -rxt(k,561)*y(k,285) + mat(k,3210) = -rxt(k,562)*y(k,285) + mat(k,4071) = -rxt(k,563)*y(k,285) + mat(k,738) = -(rxt(k,394)*y(k,256) + rxt(k,395)*y(k,147)) + mat(k,3446) = -rxt(k,394)*y(k,286) + mat(k,3200) = -rxt(k,395)*y(k,286) + mat(k,554) = rxt(k,396)*y(k,293) + mat(k,330) = rxt(k,397)*y(k,293) + mat(k,3679) = rxt(k,396)*y(k,129) + rxt(k,397)*y(k,130) + mat(k,1506) = -(rxt(k,400)*y(k,250) + rxt(k,401)*y(k,251) + rxt(k,402) & + *y(k,256) + (rxt(k,537) + rxt(k,538)) * y(k,147)) + mat(k,2969) = -rxt(k,400)*y(k,287) + mat(k,3983) = -rxt(k,401)*y(k,287) + mat(k,3502) = -rxt(k,402)*y(k,287) + mat(k,3247) = -(rxt(k,537) + rxt(k,538)) * y(k,287) + mat(k,2040) = rxt(k,404)*y(k,293) + mat(k,3751) = rxt(k,404)*y(k,132) + mat(k,2700) = -(rxt(k,665)*y(k,250) + rxt(k,666)*y(k,251) + rxt(k,667) & + *y(k,256) + 4._r8*rxt(k,668)*y(k,288) + rxt(k,669)*y(k,147) & + + rxt(k,670)*y(k,149) + rxt(k,671)*y(k,300) + rxt(k,672) & + *y(k,302) + rxt(k,673)*y(k,305)) + mat(k,3015) = -rxt(k,665)*y(k,288) + mat(k,4033) = -rxt(k,666)*y(k,288) + mat(k,3556) = -rxt(k,667)*y(k,288) + mat(k,3300) = -rxt(k,669)*y(k,288) + mat(k,3941) = -rxt(k,670)*y(k,288) + mat(k,2941) = -rxt(k,671)*y(k,288) + mat(k,2848) = -rxt(k,672)*y(k,288) + mat(k,2895) = -rxt(k,673)*y(k,288) + mat(k,850) = rxt(k,664)*y(k,149) + mat(k,3941) = mat(k,3941) + rxt(k,664)*y(k,135) end do end subroutine nlnmat14 subroutine nlnmat15( avec_len, mat, y, rxt ) @@ -3806,374 +4085,410 @@ subroutine nlnmat15( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,2271) = -(rxt(k,675)*y(k,250) + rxt(k,676)*y(k,251) + rxt(k,677) & - *y(k,256) + rxt(k,678)*y(k,147) + rxt(k,679)*y(k,149) + rxt(k,680) & - *y(k,300) + rxt(k,681)*y(k,302) + rxt(k,682)*y(k,305)) - mat(k,2687) = -rxt(k,675)*y(k,289) - mat(k,3407) = -rxt(k,676)*y(k,289) - mat(k,3266) = -rxt(k,677)*y(k,289) - mat(k,2870) = -rxt(k,678)*y(k,289) - mat(k,3063) = -rxt(k,679)*y(k,289) - mat(k,2523) = -rxt(k,680)*y(k,289) - mat(k,2569) = -rxt(k,681)*y(k,289) - mat(k,2616) = -rxt(k,682)*y(k,289) - mat(k,713) = rxt(k,684)*y(k,293) - mat(k,3727) = rxt(k,684)*y(k,135) - mat(k,90) = -(rxt(k,874)*y(k,256) + rxt(k,875)*y(k,147)) - mat(k,3130) = -rxt(k,874)*y(k,290) - mat(k,2755) = -rxt(k,875)*y(k,290) - mat(k,709) = rxt(k,877)*y(k,293) - mat(k,3531) = rxt(k,877)*y(k,135) - mat(k,1480) = -(rxt(k,500)*y(k,256) + (rxt(k,540) + rxt(k,541)) * y(k,147)) - mat(k,3229) = -rxt(k,500)*y(k,291) - mat(k,2833) = -(rxt(k,540) + rxt(k,541)) * y(k,291) - mat(k,412) = .400_r8*rxt(k,423)*y(k,293) - mat(k,1086) = .350_r8*rxt(k,424)*y(k,293) - mat(k,1985) = .230_r8*rxt(k,503)*y(k,293) - mat(k,3690) = .400_r8*rxt(k,423)*y(k,107) + .350_r8*rxt(k,424)*y(k,108) & - + .230_r8*rxt(k,503)*y(k,139) - mat(k,3105) = -(rxt(k,168)*y(k,79) + rxt(k,169)*y(k,317) + rxt(k,172) & - *y(k,157) + (rxt(k,250) + rxt(k,251)) * y(k,87) + (rxt(k,273) & + mat(k,2806) = -(rxt(k,674)*y(k,250) + rxt(k,675)*y(k,251) + rxt(k,676) & + *y(k,256) + rxt(k,677)*y(k,147) + rxt(k,678)*y(k,149) + rxt(k,679) & + *y(k,300) + rxt(k,680)*y(k,302) + rxt(k,681)*y(k,305)) + mat(k,3019) = -rxt(k,674)*y(k,289) + mat(k,4037) = -rxt(k,675)*y(k,289) + mat(k,3560) = -rxt(k,676)*y(k,289) + mat(k,3304) = -rxt(k,677)*y(k,289) + mat(k,3945) = -rxt(k,678)*y(k,289) + mat(k,2945) = -rxt(k,679)*y(k,289) + mat(k,2852) = -rxt(k,680)*y(k,289) + mat(k,2899) = -rxt(k,681)*y(k,289) + mat(k,851) = rxt(k,683)*y(k,293) + mat(k,3810) = rxt(k,683)*y(k,135) + mat(k,99) = -(rxt(k,873)*y(k,256) + rxt(k,874)*y(k,147)) + mat(k,3411) = -rxt(k,873)*y(k,290) + mat(k,3176) = -rxt(k,874)*y(k,290) + mat(k,845) = rxt(k,876)*y(k,293) + mat(k,3592) = rxt(k,876)*y(k,135) + mat(k,1638) = -(rxt(k,499)*y(k,256) + (rxt(k,539) + rxt(k,540)) * y(k,147)) + mat(k,3509) = -rxt(k,499)*y(k,291) + mat(k,3254) = -(rxt(k,539) + rxt(k,540)) * y(k,291) + mat(k,491) = .400_r8*rxt(k,422)*y(k,293) + mat(k,1267) = .350_r8*rxt(k,423)*y(k,293) + mat(k,2131) = .230_r8*rxt(k,502)*y(k,293) + mat(k,3760) = .400_r8*rxt(k,422)*y(k,107) + .350_r8*rxt(k,423)*y(k,108) & + + .230_r8*rxt(k,502)*y(k,139) + mat(k,2639) = -(rxt(k,168)*y(k,79) + rxt(k,169)*y(k,317) + rxt(k,172) & + *y(k,157) + (rxt(k,210) + rxt(k,211)) * y(k,137) + rxt(k,243) & + *y(k,34) + rxt(k,244)*y(k,35) + rxt(k,245)*y(k,37) + rxt(k,246) & + *y(k,38) + rxt(k,247)*y(k,39) + rxt(k,248)*y(k,40) + rxt(k,249) & + *y(k,41) + (rxt(k,250) + rxt(k,251)) * y(k,87) + rxt(k,270) & + *y(k,36) + rxt(k,271)*y(k,56) + rxt(k,272)*y(k,80) + (rxt(k,273) & + rxt(k,274)) * y(k,83) + rxt(k,279)*y(k,65) + rxt(k,280) & - *y(k,66) + rxt(k,319)*y(k,88)) - mat(k,1420) = -rxt(k,168)*y(k,292) - mat(k,3851) = -rxt(k,169)*y(k,292) - mat(k,2989) = -rxt(k,172)*y(k,292) - mat(k,3767) = -(rxt(k,250) + rxt(k,251)) * y(k,292) - mat(k,1042) = -(rxt(k,273) + rxt(k,274)) * y(k,292) - mat(k,124) = -rxt(k,279)*y(k,292) - mat(k,158) = -rxt(k,280)*y(k,292) - mat(k,147) = -rxt(k,319)*y(k,292) - mat(k,3752) = -(rxt(k,185)*y(k,79) + rxt(k,186)*y(k,81) + rxt(k,187)*y(k,256) & + *y(k,66) + rxt(k,293)*y(k,42) + rxt(k,294)*y(k,44) + rxt(k,295) & + *y(k,84) + rxt(k,296)*y(k,85) + rxt(k,297)*y(k,86) + (rxt(k,315) & + + rxt(k,316) + rxt(k,317)) * y(k,55) + rxt(k,318)*y(k,88)) + mat(k,1674) = -rxt(k,168)*y(k,292) + mat(k,4119) = -rxt(k,169)*y(k,292) + mat(k,3116) = -rxt(k,172)*y(k,292) + mat(k,200) = -(rxt(k,210) + rxt(k,211)) * y(k,292) + mat(k,119) = -rxt(k,243)*y(k,292) + mat(k,160) = -rxt(k,244)*y(k,292) + mat(k,134) = -rxt(k,245)*y(k,292) + mat(k,170) = -rxt(k,246)*y(k,292) + mat(k,138) = -rxt(k,247)*y(k,292) + mat(k,175) = -rxt(k,248)*y(k,292) + mat(k,142) = -rxt(k,249)*y(k,292) + mat(k,3149) = -(rxt(k,250) + rxt(k,251)) * y(k,292) + mat(k,166) = -rxt(k,270)*y(k,292) + mat(k,434) = -rxt(k,271)*y(k,292) + mat(k,127) = -rxt(k,272)*y(k,292) + mat(k,1160) = -(rxt(k,273) + rxt(k,274)) * y(k,292) + mat(k,262) = -rxt(k,279)*y(k,292) + mat(k,253) = -rxt(k,280)*y(k,292) + mat(k,511) = -rxt(k,293)*y(k,292) + mat(k,641) = -rxt(k,294)*y(k,292) + mat(k,248) = -rxt(k,295)*y(k,292) + mat(k,257) = -rxt(k,296)*y(k,292) + mat(k,304) = -rxt(k,297)*y(k,292) + mat(k,2261) = -(rxt(k,315) + rxt(k,316) + rxt(k,317)) * y(k,292) + mat(k,196) = -rxt(k,318)*y(k,292) + mat(k,3822) = -(rxt(k,185)*y(k,79) + rxt(k,186)*y(k,81) + rxt(k,187)*y(k,256) & + rxt(k,188)*y(k,156) + rxt(k,189)*y(k,157) + (4._r8*rxt(k,190) & + 4._r8*rxt(k,191)) * y(k,293) + rxt(k,193)*y(k,94) + rxt(k,205) & *y(k,149) + rxt(k,206)*y(k,136) + rxt(k,214)*y(k,148) + rxt(k,215) & *y(k,93) + rxt(k,234)*y(k,61) + (rxt(k,236) + rxt(k,237) & ) * y(k,60) + rxt(k,239)*y(k,87) + rxt(k,242)*y(k,96) + rxt(k,266) & - *y(k,20) + rxt(k,268)*y(k,83) + rxt(k,301)*y(k,43) + rxt(k,306) & - *y(k,53) + rxt(k,307)*y(k,54) + (rxt(k,309) + rxt(k,320) & - ) * y(k,63) + rxt(k,310)*y(k,88) + rxt(k,311)*y(k,90) + rxt(k,312) & - *y(k,92) + rxt(k,322)*y(k,25) + rxt(k,329)*y(k,27) + rxt(k,330) & - *y(k,28) + rxt(k,332)*y(k,29) + rxt(k,334)*y(k,46) + rxt(k,335) & - *y(k,48) + rxt(k,340)*y(k,51) + rxt(k,341)*y(k,52) + rxt(k,346) & - *y(k,76) + rxt(k,347)*y(k,77) + rxt(k,348)*y(k,89) + rxt(k,349) & - *y(k,150) + rxt(k,350)*y(k,162) + rxt(k,351)*y(k,26) + rxt(k,359) & - *y(k,31) + rxt(k,360)*y(k,32) + rxt(k,362)*y(k,50) + rxt(k,363) & - *y(k,102) + rxt(k,364)*y(k,104) + rxt(k,365)*y(k,151) + rxt(k,368) & - *y(k,169) + rxt(k,372)*y(k,170) + rxt(k,373)*y(k,30) + rxt(k,374) & - *y(k,49) + rxt(k,376)*y(k,16) + rxt(k,380)*y(k,97) + rxt(k,381) & - *y(k,127) + rxt(k,387)*y(k,126) + rxt(k,397)*y(k,129) + rxt(k,398) & - *y(k,130) + rxt(k,399)*y(k,131) + rxt(k,400)*y(k,133) + rxt(k,405) & - *y(k,132) + rxt(k,406)*y(k,134) + rxt(k,409)*y(k,1) + rxt(k,413) & - *y(k,2) + rxt(k,414)*y(k,15) + rxt(k,415)*y(k,98) + rxt(k,416) & - *y(k,99) + rxt(k,419)*y(k,103) + rxt(k,421)*y(k,106) + rxt(k,423) & - *y(k,107) + rxt(k,424)*y(k,108) + rxt(k,453)*y(k,111) + rxt(k,454) & - *y(k,110) + rxt(k,455)*y(k,112) + rxt(k,456)*y(k,113) + rxt(k,461) & - *y(k,115) + rxt(k,464)*y(k,116) + rxt(k,467)*y(k,117) + rxt(k,471) & - *y(k,118) + rxt(k,473)*y(k,119) + rxt(k,482)*y(k,120) + rxt(k,486) & - *y(k,121) + rxt(k,488)*y(k,109) + rxt(k,489)*y(k,122) + (rxt(k,490) & - + rxt(k,491)) * y(k,123) + rxt(k,503)*y(k,139) + rxt(k,544) & - *y(k,8) + rxt(k,547)*y(k,9) + rxt(k,548)*y(k,23) + rxt(k,550) & - *y(k,24) + rxt(k,554)*y(k,33) + rxt(k,555)*y(k,67) + rxt(k,567) & - *y(k,165) + rxt(k,570)*y(k,166) + rxt(k,574)*y(k,225) + rxt(k,575) & - *y(k,226) + rxt(k,577)*y(k,227) + rxt(k,580)*y(k,228) + rxt(k,583) & - *y(k,229) + rxt(k,584)*y(k,230) + rxt(k,604)*y(k,4) + rxt(k,624) & - *y(k,7) + rxt(k,644)*y(k,17) + rxt(k,664)*y(k,125) + rxt(k,684) & - *y(k,135) + rxt(k,690)*y(k,198) + rxt(k,691)*y(k,199) + rxt(k,718) & - *y(k,201) + rxt(k,719)*y(k,202) + rxt(k,737)*y(k,203) + rxt(k,738) & - *y(k,204) + rxt(k,747)*y(k,206) + rxt(k,748)*y(k,207) + rxt(k,749) & - *y(k,205) + rxt(k,757)*y(k,200) + rxt(k,758)*y(k,208) + rxt(k,764) & - *y(k,210) + rxt(k,769)*y(k,211) + rxt(k,770)*y(k,212) + rxt(k,772) & - *y(k,214) + rxt(k,775)*y(k,216) + rxt(k,776)*y(k,215) + rxt(k,779) & - *y(k,218) + rxt(k,783)*y(k,220) + rxt(k,784)*y(k,219) + rxt(k,787) & - *y(k,222) + rxt(k,788)*y(k,221) + (rxt(k,795) + rxt(k,808) & - ) * y(k,69) + rxt(k,797)*y(k,160) + rxt(k,802)*y(k,171) & - + rxt(k,807)*y(k,173) + rxt(k,809)*y(k,174) + rxt(k,811) & - *y(k,143)) - mat(k,1423) = -rxt(k,185)*y(k,293) - mat(k,1352) = -rxt(k,186)*y(k,293) - mat(k,3291) = -rxt(k,187)*y(k,293) - mat(k,3462) = -rxt(k,188)*y(k,293) - mat(k,2996) = -rxt(k,189)*y(k,293) - mat(k,368) = -rxt(k,193)*y(k,293) - mat(k,3088) = -rxt(k,205)*y(k,293) - mat(k,321) = -rxt(k,206)*y(k,293) - mat(k,3512) = -rxt(k,214)*y(k,293) - mat(k,2724) = -rxt(k,215)*y(k,293) - mat(k,1219) = -rxt(k,234)*y(k,293) - mat(k,3317) = -(rxt(k,236) + rxt(k,237)) * y(k,293) - mat(k,3774) = -rxt(k,239)*y(k,293) - mat(k,1067) = -rxt(k,242)*y(k,293) - mat(k,3798) = -rxt(k,266)*y(k,293) - mat(k,1044) = -rxt(k,268)*y(k,293) - mat(k,3341) = -rxt(k,301)*y(k,293) - mat(k,1359) = -rxt(k,306)*y(k,293) - mat(k,374) = -rxt(k,307)*y(k,293) - mat(k,1543) = -(rxt(k,309) + rxt(k,320)) * y(k,293) - mat(k,149) = -rxt(k,310)*y(k,293) - mat(k,1126) = -rxt(k,311)*y(k,293) - mat(k,1122) = -rxt(k,312)*y(k,293) - mat(k,258) = -rxt(k,322)*y(k,293) - mat(k,221) = -rxt(k,329)*y(k,293) - mat(k,295) = -rxt(k,330)*y(k,293) - mat(k,261) = -rxt(k,332)*y(k,293) - mat(k,1312) = -rxt(k,334)*y(k,293) - mat(k,108) = -rxt(k,335)*y(k,293) - mat(k,532) = -rxt(k,340)*y(k,293) - mat(k,472) = -rxt(k,341)*y(k,293) - mat(k,1473) = -rxt(k,346)*y(k,293) - mat(k,1179) = -rxt(k,347)*y(k,293) - mat(k,726) = -rxt(k,348)*y(k,293) - mat(k,1275) = -rxt(k,349)*y(k,293) - mat(k,404) = -rxt(k,350)*y(k,293) - mat(k,505) = -rxt(k,351)*y(k,293) - mat(k,342) = -rxt(k,359)*y(k,293) - mat(k,114) = -rxt(k,360)*y(k,293) - mat(k,1851) = -rxt(k,362)*y(k,293) - mat(k,1616) = -rxt(k,363)*y(k,293) - mat(k,811) = -rxt(k,364)*y(k,293) - mat(k,1348) = -rxt(k,365)*y(k,293) - mat(k,488) = -rxt(k,368)*y(k,293) - mat(k,336) = -rxt(k,372)*y(k,293) - mat(k,1209) = -rxt(k,373)*y(k,293) - mat(k,2151) = -rxt(k,374)*y(k,293) - mat(k,315) = -rxt(k,376)*y(k,293) - mat(k,887) = -rxt(k,380)*y(k,293) - mat(k,1627) = -rxt(k,381)*y(k,293) - mat(k,1763) = -rxt(k,387)*y(k,293) - mat(k,454) = -rxt(k,397)*y(k,293) - mat(k,269) = -rxt(k,398)*y(k,293) - mat(k,397) = -rxt(k,399)*y(k,293) - mat(k,1809) = -rxt(k,400)*y(k,293) - mat(k,1874) = -rxt(k,405)*y(k,293) - mat(k,1367) = -rxt(k,406)*y(k,293) - mat(k,643) = -rxt(k,409)*y(k,293) - mat(k,654) = -rxt(k,413)*y(k,293) - mat(k,155) = -rxt(k,414)*y(k,293) - mat(k,553) = -rxt(k,415)*y(k,293) - mat(k,565) = -rxt(k,416)*y(k,293) - mat(k,1709) = -rxt(k,419)*y(k,293) - mat(k,806) = -rxt(k,421)*y(k,293) - mat(k,418) = -rxt(k,423)*y(k,293) - mat(k,1094) = -rxt(k,424)*y(k,293) - mat(k,1031) = -rxt(k,453)*y(k,293) - mat(k,1539) = -rxt(k,454)*y(k,293) - mat(k,1643) = -rxt(k,455)*y(k,293) - mat(k,1342) = -rxt(k,456)*y(k,293) - mat(k,1942) = -rxt(k,461)*y(k,293) - mat(k,581) = -rxt(k,464)*y(k,293) - mat(k,481) = -rxt(k,467)*y(k,293) - mat(k,1976) = -rxt(k,471)*y(k,293) - mat(k,632) = -rxt(k,473)*y(k,293) - mat(k,1062) = -rxt(k,482)*y(k,293) - mat(k,1459) = -rxt(k,486)*y(k,293) - mat(k,1303) = -rxt(k,488)*y(k,293) - mat(k,801) = -rxt(k,489)*y(k,293) - mat(k,1910) = -(rxt(k,490) + rxt(k,491)) * y(k,293) - mat(k,2004) = -rxt(k,503)*y(k,293) - mat(k,136) = -rxt(k,544)*y(k,293) - mat(k,327) = -rxt(k,547)*y(k,293) - mat(k,200) = -rxt(k,548)*y(k,293) - mat(k,290) = -rxt(k,550)*y(k,293) - mat(k,225) = -rxt(k,554)*y(k,293) - mat(k,172) = -rxt(k,555)*y(k,293) - mat(k,145) = -rxt(k,567)*y(k,293) - mat(k,284) = -rxt(k,570)*y(k,293) - mat(k,622) = -rxt(k,574)*y(k,293) - mat(k,167) = -rxt(k,575)*y(k,293) - mat(k,186) = -rxt(k,577)*y(k,293) - mat(k,741) = -rxt(k,580)*y(k,293) - mat(k,191) = -rxt(k,583)*y(k,293) - mat(k,355) = -rxt(k,584)*y(k,293) - mat(k,1117) = -rxt(k,604)*y(k,293) - mat(k,870) = -rxt(k,624)*y(k,293) - mat(k,953) = -rxt(k,644)*y(k,293) - mat(k,973) = -rxt(k,664)*y(k,293) - mat(k,720) = -rxt(k,684)*y(k,293) - mat(k,2191) = -rxt(k,690)*y(k,293) - mat(k,390) = -rxt(k,691)*y(k,293) - mat(k,1174) = -rxt(k,718)*y(k,293) - mat(k,513) = -rxt(k,719)*y(k,293) - mat(k,1652) = -rxt(k,737)*y(k,293) - mat(k,521) = -rxt(k,738)*y(k,293) - mat(k,229) = -rxt(k,747)*y(k,293) - mat(k,233) = -rxt(k,748)*y(k,293) - mat(k,525) = -rxt(k,749)*y(k,293) - mat(k,2201) = -rxt(k,757)*y(k,293) - mat(k,349) = -rxt(k,758)*y(k,293) - mat(k,2435) = -rxt(k,764)*y(k,293) - mat(k,2408) = -rxt(k,769)*y(k,293) - mat(k,1159) = -rxt(k,770)*y(k,293) - mat(k,998) = -rxt(k,772)*y(k,293) - mat(k,588) = -rxt(k,775)*y(k,293) - mat(k,894) = -rxt(k,776)*y(k,293) - mat(k,678) = -rxt(k,779)*y(k,293) - mat(k,1597) = -rxt(k,783)*y(k,293) - mat(k,1467) = -rxt(k,784)*y(k,293) - mat(k,1610) = -rxt(k,787)*y(k,293) - mat(k,1401) = -rxt(k,788)*y(k,293) - mat(k,243) = -(rxt(k,795) + rxt(k,808)) * y(k,293) - mat(k,307) = -rxt(k,797)*y(k,293) - mat(k,460) = -rxt(k,802)*y(k,293) - mat(k,1522) = -rxt(k,807)*y(k,293) - mat(k,1165) = -rxt(k,809)*y(k,293) - mat(k,104) = -rxt(k,811)*y(k,293) - mat(k,1117) = mat(k,1117) + .770_r8*rxt(k,603)*y(k,157) - mat(k,870) = mat(k,870) + .080_r8*rxt(k,623)*y(k,157) - mat(k,953) = mat(k,953) + .300_r8*rxt(k,643)*y(k,157) - mat(k,258) = mat(k,258) + .650_r8*rxt(k,322)*y(k,293) - mat(k,505) = mat(k,505) + .130_r8*rxt(k,324)*y(k,157) - mat(k,295) = mat(k,295) + .500_r8*rxt(k,330)*y(k,293) - mat(k,1209) = mat(k,1209) + .360_r8*rxt(k,355)*y(k,157) - mat(k,3341) = mat(k,3341) + rxt(k,300)*y(k,156) - mat(k,374) = mat(k,374) + .300_r8*rxt(k,307)*y(k,293) - mat(k,3833) = rxt(k,223)*y(k,256) - mat(k,903) = rxt(k,277)*y(k,317) - mat(k,2738) = rxt(k,184)*y(k,157) + 2.000_r8*rxt(k,179)*y(k,256) - mat(k,1423) = mat(k,1423) + rxt(k,176)*y(k,156) + rxt(k,168)*y(k,292) - mat(k,1352) = mat(k,1352) + rxt(k,177)*y(k,156) - mat(k,1044) = mat(k,1044) + rxt(k,267)*y(k,156) + rxt(k,273)*y(k,292) - mat(k,3774) = mat(k,3774) + rxt(k,238)*y(k,156) + rxt(k,250)*y(k,292) - mat(k,149) = mat(k,149) + rxt(k,319)*y(k,292) - mat(k,726) = mat(k,726) + .890_r8*rxt(k,348)*y(k,293) - mat(k,1122) = mat(k,1122) + .500_r8*rxt(k,312)*y(k,293) - mat(k,909) = rxt(k,269)*y(k,156) - mat(k,1067) = mat(k,1067) + rxt(k,241)*y(k,156) - mat(k,553) = mat(k,553) + .430_r8*rxt(k,415)*y(k,293) - mat(k,565) = mat(k,565) + .530_r8*rxt(k,416)*y(k,293) - mat(k,1709) = mat(k,1709) + 1.080_r8*rxt(k,419)*y(k,293) - mat(k,811) = mat(k,811) + .700_r8*rxt(k,364)*y(k,293) - mat(k,1303) = mat(k,1303) + .250_r8*rxt(k,487)*y(k,157) - mat(k,1643) = mat(k,1643) + .500_r8*rxt(k,455)*y(k,293) - mat(k,1942) = mat(k,1942) + .340_r8*rxt(k,460)*y(k,157) + .060_r8*rxt(k,461) & + *y(k,20) + rxt(k,268)*y(k,83) + rxt(k,282)*y(k,42) + rxt(k,284) & + *y(k,44) + rxt(k,285)*y(k,45) + rxt(k,287)*y(k,47) + rxt(k,289) & + *y(k,56) + rxt(k,290)*y(k,84) + rxt(k,291)*y(k,85) + rxt(k,292) & + *y(k,86) + rxt(k,301)*y(k,43) + rxt(k,306)*y(k,53) + rxt(k,307) & + *y(k,54) + rxt(k,308)*y(k,55) + rxt(k,309)*y(k,88) + rxt(k,310) & + *y(k,90) + rxt(k,311)*y(k,92) + rxt(k,319)*y(k,63) + rxt(k,321) & + *y(k,25) + rxt(k,328)*y(k,27) + rxt(k,329)*y(k,28) + rxt(k,331) & + *y(k,29) + rxt(k,333)*y(k,46) + rxt(k,334)*y(k,48) + rxt(k,339) & + *y(k,51) + rxt(k,340)*y(k,52) + rxt(k,345)*y(k,76) + rxt(k,346) & + *y(k,77) + rxt(k,347)*y(k,89) + rxt(k,348)*y(k,150) + rxt(k,349) & + *y(k,162) + rxt(k,350)*y(k,26) + rxt(k,358)*y(k,31) + rxt(k,359) & + *y(k,32) + rxt(k,361)*y(k,50) + rxt(k,362)*y(k,102) + rxt(k,363) & + *y(k,104) + rxt(k,364)*y(k,151) + rxt(k,367)*y(k,169) + rxt(k,371) & + *y(k,170) + rxt(k,372)*y(k,30) + rxt(k,373)*y(k,49) + rxt(k,375) & + *y(k,16) + rxt(k,379)*y(k,97) + rxt(k,380)*y(k,127) + rxt(k,386) & + *y(k,126) + rxt(k,396)*y(k,129) + rxt(k,397)*y(k,130) + rxt(k,398) & + *y(k,131) + rxt(k,399)*y(k,133) + rxt(k,404)*y(k,132) + rxt(k,405) & + *y(k,134) + rxt(k,408)*y(k,1) + rxt(k,412)*y(k,2) + rxt(k,413) & + *y(k,15) + rxt(k,414)*y(k,98) + rxt(k,415)*y(k,99) + rxt(k,418) & + *y(k,103) + rxt(k,420)*y(k,106) + rxt(k,422)*y(k,107) + rxt(k,423) & + *y(k,108) + rxt(k,452)*y(k,111) + rxt(k,453)*y(k,110) + rxt(k,454) & + *y(k,112) + rxt(k,455)*y(k,113) + rxt(k,460)*y(k,115) + rxt(k,463) & + *y(k,116) + rxt(k,466)*y(k,117) + rxt(k,470)*y(k,118) + rxt(k,472) & + *y(k,119) + rxt(k,481)*y(k,120) + rxt(k,485)*y(k,121) + rxt(k,487) & + *y(k,109) + rxt(k,488)*y(k,122) + (rxt(k,489) + rxt(k,490) & + ) * y(k,123) + rxt(k,502)*y(k,139) + rxt(k,543)*y(k,8) + rxt(k,546) & + *y(k,9) + rxt(k,547)*y(k,23) + rxt(k,549)*y(k,24) + rxt(k,553) & + *y(k,33) + rxt(k,554)*y(k,67) + rxt(k,566)*y(k,165) + rxt(k,569) & + *y(k,166) + rxt(k,573)*y(k,225) + rxt(k,574)*y(k,226) + rxt(k,576) & + *y(k,227) + rxt(k,579)*y(k,228) + rxt(k,582)*y(k,229) + rxt(k,583) & + *y(k,230) + rxt(k,603)*y(k,4) + rxt(k,623)*y(k,7) + rxt(k,643) & + *y(k,17) + rxt(k,663)*y(k,125) + rxt(k,683)*y(k,135) + rxt(k,689) & + *y(k,198) + rxt(k,690)*y(k,199) + rxt(k,717)*y(k,201) + rxt(k,718) & + *y(k,202) + rxt(k,736)*y(k,203) + rxt(k,737)*y(k,204) + rxt(k,746) & + *y(k,206) + rxt(k,747)*y(k,207) + rxt(k,748)*y(k,205) + rxt(k,756) & + *y(k,200) + rxt(k,757)*y(k,208) + rxt(k,763)*y(k,210) + rxt(k,768) & + *y(k,211) + rxt(k,769)*y(k,212) + rxt(k,771)*y(k,214) + rxt(k,774) & + *y(k,216) + rxt(k,775)*y(k,215) + rxt(k,778)*y(k,218) + rxt(k,782) & + *y(k,220) + rxt(k,783)*y(k,219) + rxt(k,786)*y(k,222) + rxt(k,787) & + *y(k,221) + (rxt(k,794) + rxt(k,808)) * y(k,69) + rxt(k,796) & + *y(k,160) + rxt(k,798)*y(k,174) + rxt(k,802)*y(k,171) + rxt(k,807) & + *y(k,173) + rxt(k,810)*y(k,143)) + mat(k,1678) = -rxt(k,185)*y(k,293) + mat(k,1489) = -rxt(k,186)*y(k,293) + mat(k,3572) = -rxt(k,187)*y(k,293) + mat(k,3392) = -rxt(k,188)*y(k,293) + mat(k,3134) = -rxt(k,189)*y(k,293) + mat(k,448) = -rxt(k,193)*y(k,293) + mat(k,3957) = -rxt(k,205)*y(k,293) + mat(k,479) = -rxt(k,206)*y(k,293) + mat(k,4101) = -rxt(k,214)*y(k,293) + mat(k,3335) = -rxt(k,215)*y(k,293) + mat(k,1328) = -rxt(k,234)*y(k,293) + mat(k,2606) = -(rxt(k,236) + rxt(k,237)) * y(k,293) + mat(k,3157) = -rxt(k,239)*y(k,293) + mat(k,1146) = -rxt(k,242)*y(k,293) + mat(k,2566) = -rxt(k,266)*y(k,293) + mat(k,1162) = -rxt(k,268)*y(k,293) + mat(k,513) = -rxt(k,282)*y(k,293) + mat(k,644) = -rxt(k,284)*y(k,293) + mat(k,145) = -rxt(k,285)*y(k,293) + mat(k,394) = -rxt(k,287)*y(k,293) + mat(k,436) = -rxt(k,289)*y(k,293) + mat(k,249) = -rxt(k,290)*y(k,293) + mat(k,258) = -rxt(k,291)*y(k,293) + mat(k,305) = -rxt(k,292)*y(k,293) + mat(k,3361) = -rxt(k,301)*y(k,293) + mat(k,1495) = -rxt(k,306)*y(k,293) + mat(k,462) = -rxt(k,307)*y(k,293) + mat(k,2267) = -rxt(k,308)*y(k,293) + mat(k,198) = -rxt(k,309)*y(k,293) + mat(k,1360) = -rxt(k,310)*y(k,293) + mat(k,1212) = -rxt(k,311)*y(k,293) + mat(k,1921) = -rxt(k,319)*y(k,293) + mat(k,313) = -rxt(k,321)*y(k,293) + mat(k,283) = -rxt(k,328)*y(k,293) + mat(k,359) = -rxt(k,329)*y(k,293) + mat(k,317) = -rxt(k,331)*y(k,293) + mat(k,1434) = -rxt(k,333)*y(k,293) + mat(k,123) = -rxt(k,334)*y(k,293) + mat(k,791) = -rxt(k,339)*y(k,293) + mat(k,704) = -rxt(k,340)*y(k,293) + mat(k,1715) = -rxt(k,345)*y(k,293) + mat(k,1478) = -rxt(k,346)*y(k,293) + mat(k,824) = -rxt(k,347)*y(k,293) + mat(k,1457) = -rxt(k,348)*y(k,293) + mat(k,570) = -rxt(k,349)*y(k,293) + mat(k,597) = -rxt(k,350)*y(k,293) + mat(k,412) = -rxt(k,358)*y(k,293) + mat(k,130) = -rxt(k,359)*y(k,293) + mat(k,1914) = -rxt(k,361)*y(k,293) + mat(k,1761) = -rxt(k,362)*y(k,293) + mat(k,966) = -rxt(k,363)*y(k,293) + mat(k,1483) = -rxt(k,364)*y(k,293) + mat(k,588) = -rxt(k,367)*y(k,293) + mat(k,406) = -rxt(k,371)*y(k,293) + mat(k,1376) = -rxt(k,372)*y(k,293) + mat(k,2284) = -rxt(k,373)*y(k,293) + mat(k,379) = -rxt(k,375)*y(k,293) + mat(k,982) = -rxt(k,379)*y(k,293) + mat(k,1732) = -rxt(k,380)*y(k,293) + mat(k,2031) = -rxt(k,386)*y(k,293) + mat(k,557) = -rxt(k,396)*y(k,293) + mat(k,333) = -rxt(k,397)*y(k,293) + mat(k,520) = -rxt(k,398)*y(k,293) + mat(k,1935) = -rxt(k,399)*y(k,293) + mat(k,2056) = -rxt(k,404)*y(k,293) + mat(k,1503) = -rxt(k,405)*y(k,293) + mat(k,724) = -rxt(k,408)*y(k,293) + mat(k,736) = -rxt(k,412)*y(k,293) + mat(k,204) = -rxt(k,413)*y(k,293) + mat(k,630) = -rxt(k,414)*y(k,293) + mat(k,689) = -rxt(k,415)*y(k,293) + mat(k,1879) = -rxt(k,418)*y(k,293) + mat(k,1532) = -rxt(k,420)*y(k,293) + mat(k,496) = -rxt(k,422)*y(k,293) + mat(k,1275) = -rxt(k,423)*y(k,293) + mat(k,1117) = -rxt(k,452)*y(k,293) + mat(k,1667) = -rxt(k,453)*y(k,293) + mat(k,1799) = -rxt(k,454)*y(k,293) + mat(k,1471) = -rxt(k,455)*y(k,293) + mat(k,2120) = -rxt(k,460)*y(k,293) + mat(k,617) = -rxt(k,463)*y(k,293) + mat(k,564) = -rxt(k,466)*y(k,293) + mat(k,2088) = -rxt(k,470)*y(k,293) + mat(k,766) = -rxt(k,472)*y(k,293) + mat(k,1192) = -rxt(k,481)*y(k,293) + mat(k,1591) = -rxt(k,485)*y(k,293) + mat(k,1407) = -rxt(k,487)*y(k,293) + mat(k,916) = -rxt(k,488)*y(k,293) + mat(k,1907) = -(rxt(k,489) + rxt(k,490)) * y(k,293) + mat(k,2149) = -rxt(k,502)*y(k,293) + mat(k,185) = -rxt(k,543)*y(k,293) + mat(k,419) = -rxt(k,546)*y(k,293) + mat(k,245) = -rxt(k,547)*y(k,293) + mat(k,354) = -rxt(k,549)*y(k,293) + mat(k,287) = -rxt(k,553)*y(k,293) + mat(k,220) = -rxt(k,554)*y(k,293) + mat(k,194) = -rxt(k,566)*y(k,293) + mat(k,348) = -rxt(k,569)*y(k,293) + mat(k,757) = -rxt(k,573)*y(k,293) + mat(k,215) = -rxt(k,574)*y(k,293) + mat(k,234) = -rxt(k,576)*y(k,293) + mat(k,839) = -rxt(k,579)*y(k,293) + mat(k,239) = -rxt(k,582)*y(k,293) + mat(k,431) = -rxt(k,583)*y(k,293) + mat(k,1261) = -rxt(k,603)*y(k,293) + mat(k,1039) = -rxt(k,623)*y(k,293) + mat(k,1102) = -rxt(k,643)*y(k,293) + mat(k,1081) = -rxt(k,663)*y(k,293) + mat(k,855) = -rxt(k,683)*y(k,293) + mat(k,2449) = -rxt(k,689)*y(k,293) + mat(k,472) = -rxt(k,690)*y(k,293) + mat(k,1293) = -rxt(k,717)*y(k,293) + mat(k,655) = -rxt(k,718)*y(k,293) + mat(k,1722) = -rxt(k,736)*y(k,293) + mat(k,664) = -rxt(k,737)*y(k,293) + mat(k,364) = -rxt(k,746)*y(k,293) + mat(k,369) = -rxt(k,747)*y(k,293) + mat(k,772) = -rxt(k,748)*y(k,293) + mat(k,2373) = -rxt(k,756)*y(k,293) + mat(k,424) = -rxt(k,757)*y(k,293) + mat(k,2676) = -rxt(k,763)*y(k,293) + mat(k,2360) = -rxt(k,768)*y(k,293) + mat(k,1230) = -rxt(k,769)*y(k,293) + mat(k,1107) = -rxt(k,771)*y(k,293) + mat(k,671) = -rxt(k,774)*y(k,293) + mat(k,989) = -rxt(k,775)*y(k,293) + mat(k,787) = -rxt(k,778)*y(k,293) + mat(k,1693) = -rxt(k,782)*y(k,293) + mat(k,1558) = -rxt(k,783)*y(k,293) + mat(k,1706) = -rxt(k,786)*y(k,293) + mat(k,1538) = -rxt(k,787)*y(k,293) + mat(k,324) = -(rxt(k,794) + rxt(k,808)) * y(k,293) + mat(k,389) = -rxt(k,796)*y(k,293) + mat(k,1237) = -rxt(k,798)*y(k,293) + mat(k,545) = -rxt(k,802)*y(k,293) + mat(k,1607) = -rxt(k,807)*y(k,293) + mat(k,116) = -rxt(k,810)*y(k,293) + mat(k,1261) = mat(k,1261) + .770_r8*rxt(k,602)*y(k,157) + mat(k,1039) = mat(k,1039) + .080_r8*rxt(k,622)*y(k,157) + mat(k,1102) = mat(k,1102) + .300_r8*rxt(k,642)*y(k,157) + mat(k,313) = mat(k,313) + .650_r8*rxt(k,321)*y(k,293) + mat(k,597) = mat(k,597) + .130_r8*rxt(k,323)*y(k,157) + mat(k,359) = mat(k,359) + .500_r8*rxt(k,329)*y(k,293) + mat(k,1376) = mat(k,1376) + .360_r8*rxt(k,354)*y(k,157) + mat(k,3361) = mat(k,3361) + rxt(k,300)*y(k,156) + mat(k,462) = mat(k,462) + .300_r8*rxt(k,307)*y(k,293) + mat(k,2267) = mat(k,2267) + rxt(k,315)*y(k,292) + mat(k,3863) = rxt(k,223)*y(k,256) + mat(k,1283) = rxt(k,277)*y(k,317) + mat(k,2581) = rxt(k,184)*y(k,157) + 2.000_r8*rxt(k,179)*y(k,256) + mat(k,1678) = mat(k,1678) + rxt(k,176)*y(k,156) + rxt(k,168)*y(k,292) + mat(k,1489) = mat(k,1489) + rxt(k,177)*y(k,156) + mat(k,1162) = mat(k,1162) + rxt(k,267)*y(k,156) + rxt(k,273)*y(k,292) + mat(k,3157) = mat(k,3157) + rxt(k,238)*y(k,156) + rxt(k,250)*y(k,292) + mat(k,198) = mat(k,198) + rxt(k,318)*y(k,292) + mat(k,824) = mat(k,824) + .890_r8*rxt(k,347)*y(k,293) + mat(k,1212) = mat(k,1212) + .500_r8*rxt(k,311)*y(k,293) + mat(k,998) = rxt(k,269)*y(k,156) + mat(k,1146) = mat(k,1146) + rxt(k,241)*y(k,156) + mat(k,630) = mat(k,630) + .430_r8*rxt(k,414)*y(k,293) + mat(k,689) = mat(k,689) + .530_r8*rxt(k,415)*y(k,293) + mat(k,1879) = mat(k,1879) + 1.080_r8*rxt(k,418)*y(k,293) + mat(k,966) = mat(k,966) + .700_r8*rxt(k,363)*y(k,293) + mat(k,1407) = mat(k,1407) + .250_r8*rxt(k,486)*y(k,157) + mat(k,1799) = mat(k,1799) + .500_r8*rxt(k,454)*y(k,293) + mat(k,2120) = mat(k,2120) + .340_r8*rxt(k,459)*y(k,157) + .060_r8*rxt(k,460) & *y(k,293) - mat(k,1976) = mat(k,1976) + .340_r8*rxt(k,470)*y(k,157) + .040_r8*rxt(k,471) & + mat(k,2088) = mat(k,2088) + .340_r8*rxt(k,469)*y(k,157) + .040_r8*rxt(k,470) & *y(k,293) - mat(k,632) = mat(k,632) + .030_r8*rxt(k,473)*y(k,293) - mat(k,1062) = mat(k,1062) + .420_r8*rxt(k,482)*y(k,293) - mat(k,1459) = mat(k,1459) + .510_r8*rxt(k,485)*y(k,157) + .290_r8*rxt(k,486) & + mat(k,766) = mat(k,766) + .030_r8*rxt(k,472)*y(k,293) + mat(k,1192) = mat(k,1192) + .420_r8*rxt(k,481)*y(k,293) + mat(k,1591) = mat(k,1591) + .510_r8*rxt(k,484)*y(k,157) + .290_r8*rxt(k,485) & *y(k,293) - mat(k,1910) = mat(k,1910) + (.130_r8*rxt(k,490)+.920_r8*rxt(k,491))*y(k,293) - mat(k,973) = mat(k,973) + .660_r8*rxt(k,663)*y(k,157) - mat(k,1763) = mat(k,1763) + .240_r8*rxt(k,386)*y(k,157) - mat(k,1874) = mat(k,1874) + .360_r8*rxt(k,404)*y(k,157) - mat(k,720) = mat(k,720) + .630_r8*rxt(k,683)*y(k,157) - mat(k,2004) = mat(k,2004) + .340_r8*rxt(k,502)*y(k,157) - mat(k,2895) = rxt(k,207)*y(k,256) + .550_r8*rxt(k,510)*y(k,265) & - + .550_r8*rxt(k,512)*y(k,266) + .470_r8*rxt(k,526)*y(k,273) & - + .040_r8*rxt(k,528)*y(k,274) + .550_r8*rxt(k,531)*y(k,276) & - + .550_r8*rxt(k,534)*y(k,277) - mat(k,3088) = mat(k,3088) + rxt(k,202)*y(k,256) - mat(k,3462) = mat(k,3462) + rxt(k,300)*y(k,43) + rxt(k,176)*y(k,79) & + mat(k,1907) = mat(k,1907) + (.130_r8*rxt(k,489)+.920_r8*rxt(k,490))*y(k,293) + mat(k,1081) = mat(k,1081) + .660_r8*rxt(k,662)*y(k,157) + mat(k,2031) = mat(k,2031) + .240_r8*rxt(k,385)*y(k,157) + mat(k,2056) = mat(k,2056) + .360_r8*rxt(k,403)*y(k,157) + mat(k,855) = mat(k,855) + .630_r8*rxt(k,682)*y(k,157) + mat(k,2149) = mat(k,2149) + .340_r8*rxt(k,501)*y(k,157) + mat(k,3316) = rxt(k,207)*y(k,256) + .550_r8*rxt(k,509)*y(k,265) & + + .550_r8*rxt(k,511)*y(k,266) + .470_r8*rxt(k,525)*y(k,273) & + + .040_r8*rxt(k,527)*y(k,274) + .550_r8*rxt(k,530)*y(k,276) & + + .550_r8*rxt(k,533)*y(k,277) + mat(k,3957) = mat(k,3957) + rxt(k,202)*y(k,256) + mat(k,3392) = mat(k,3392) + rxt(k,300)*y(k,43) + rxt(k,176)*y(k,79) & + rxt(k,177)*y(k,81) + rxt(k,267)*y(k,83) + rxt(k,238)*y(k,87) & + rxt(k,269)*y(k,95) + rxt(k,241)*y(k,96) + rxt(k,182)*y(k,256) - mat(k,2996) = mat(k,2996) + .770_r8*rxt(k,603)*y(k,4) + .080_r8*rxt(k,623) & - *y(k,7) + .300_r8*rxt(k,643)*y(k,17) + .130_r8*rxt(k,324) & - *y(k,26) + .360_r8*rxt(k,355)*y(k,30) + rxt(k,184)*y(k,78) & - + .250_r8*rxt(k,487)*y(k,109) + .340_r8*rxt(k,460)*y(k,115) & - + .340_r8*rxt(k,470)*y(k,118) + .510_r8*rxt(k,485)*y(k,121) & - + .660_r8*rxt(k,663)*y(k,125) + .240_r8*rxt(k,386)*y(k,126) & - + .360_r8*rxt(k,404)*y(k,132) + .630_r8*rxt(k,683)*y(k,135) & - + .340_r8*rxt(k,502)*y(k,139) + .090_r8*rxt(k,763)*y(k,210) & + mat(k,3134) = mat(k,3134) + .770_r8*rxt(k,602)*y(k,4) + .080_r8*rxt(k,622) & + *y(k,7) + .300_r8*rxt(k,642)*y(k,17) + .130_r8*rxt(k,323) & + *y(k,26) + .360_r8*rxt(k,354)*y(k,30) + rxt(k,184)*y(k,78) & + + .250_r8*rxt(k,486)*y(k,109) + .340_r8*rxt(k,459)*y(k,115) & + + .340_r8*rxt(k,469)*y(k,118) + .510_r8*rxt(k,484)*y(k,121) & + + .660_r8*rxt(k,662)*y(k,125) + .240_r8*rxt(k,385)*y(k,126) & + + .360_r8*rxt(k,403)*y(k,132) + .630_r8*rxt(k,682)*y(k,135) & + + .340_r8*rxt(k,501)*y(k,139) + .090_r8*rxt(k,762)*y(k,210) & + rxt(k,183)*y(k,256) - mat(k,488) = mat(k,488) + .500_r8*rxt(k,368)*y(k,293) - mat(k,2435) = mat(k,2435) + .090_r8*rxt(k,763)*y(k,157) - mat(k,467) = .400_r8*rxt(k,542)*y(k,256) - mat(k,2135) = .700_r8*rxt(k,589)*y(k,256) - mat(k,2231) = .350_r8*rxt(k,597)*y(k,256) - mat(k,2068) = .500_r8*rxt(k,609)*y(k,256) - mat(k,2113) = .100_r8*rxt(k,617)*y(k,256) - mat(k,2348) = .470_r8*rxt(k,629)*y(k,256) - mat(k,2260) = .030_r8*rxt(k,637)*y(k,256) - mat(k,2710) = .490_r8*rxt(k,338)*y(k,256) + .550_r8*rxt(k,445)*y(k,265) & - + .550_r8*rxt(k,449)*y(k,266) + .550_r8*rxt(k,492)*y(k,276) & - + .550_r8*rxt(k,496)*y(k,277) - mat(k,3432) = .280_r8*rxt(k,446)*y(k,265) + .280_r8*rxt(k,450)*y(k,266) & - + .280_r8*rxt(k,493)*y(k,276) + .280_r8*rxt(k,497)*y(k,277) - mat(k,796) = .400_r8*rxt(k,556)*y(k,256) - mat(k,3291) = mat(k,3291) + rxt(k,223)*y(k,57) + 2.000_r8*rxt(k,179)*y(k,78) & + mat(k,588) = mat(k,588) + .500_r8*rxt(k,367)*y(k,293) + mat(k,2676) = mat(k,2676) + .090_r8*rxt(k,762)*y(k,157) + mat(k,551) = .400_r8*rxt(k,541)*y(k,256) + mat(k,2310) = .700_r8*rxt(k,588)*y(k,256) + mat(k,2480) = .350_r8*rxt(k,596)*y(k,256) + mat(k,2226) = .500_r8*rxt(k,608)*y(k,256) + mat(k,2337) = .100_r8*rxt(k,616)*y(k,256) + mat(k,2543) = .470_r8*rxt(k,628)*y(k,256) + mat(k,2426) = .030_r8*rxt(k,636)*y(k,256) + mat(k,3031) = .490_r8*rxt(k,337)*y(k,256) + .550_r8*rxt(k,444)*y(k,265) & + + .550_r8*rxt(k,448)*y(k,266) + .550_r8*rxt(k,491)*y(k,276) & + + .550_r8*rxt(k,495)*y(k,277) + mat(k,4049) = .280_r8*rxt(k,445)*y(k,265) + .280_r8*rxt(k,449)*y(k,266) & + + .280_r8*rxt(k,492)*y(k,276) + .280_r8*rxt(k,496)*y(k,277) + mat(k,909) = .400_r8*rxt(k,555)*y(k,256) + mat(k,3572) = mat(k,3572) + rxt(k,223)*y(k,57) + 2.000_r8*rxt(k,179)*y(k,78) & + rxt(k,207)*y(k,147) + rxt(k,202)*y(k,149) + rxt(k,182) & - *y(k,156) + rxt(k,183)*y(k,157) + .400_r8*rxt(k,542)*y(k,233) & - + .700_r8*rxt(k,589)*y(k,235) + .350_r8*rxt(k,597)*y(k,236) & - + .500_r8*rxt(k,609)*y(k,238) + .100_r8*rxt(k,617)*y(k,239) & - + .470_r8*rxt(k,629)*y(k,243) + .030_r8*rxt(k,637)*y(k,244) & - + .490_r8*rxt(k,338)*y(k,250) + .400_r8*rxt(k,556)*y(k,252) & - + .200_r8*rxt(k,313)*y(k,257) + .650_r8*rxt(k,422)*y(k,258) & - + .060_r8*rxt(k,427)*y(k,259) + .060_r8*rxt(k,433)*y(k,260) & - + .580_r8*rxt(k,458)*y(k,267) + .520_r8*rxt(k,462)*y(k,268) & - + .600_r8*rxt(k,465)*y(k,269) + .500_r8*rxt(k,468)*y(k,270) & - + .400_r8*rxt(k,472)*y(k,271) + .240_r8*rxt(k,477)*y(k,272) & - + .850_r8*rxt(k,480)*y(k,273) + .860_r8*rxt(k,483)*y(k,274) & - + .500_r8*rxt(k,648)*y(k,279) + .100_r8*rxt(k,657)*y(k,280) & - + .590_r8*rxt(k,384)*y(k,282) + .490_r8*rxt(k,391)*y(k,284) & - + .400_r8*rxt(k,562)*y(k,285) + .200_r8*rxt(k,395)*y(k,286) & - + .540_r8*rxt(k,403)*y(k,287) + .480_r8*rxt(k,668)*y(k,288) & - + .100_r8*rxt(k,677)*y(k,289) + .800_r8*rxt(k,500)*y(k,291) & - + .150_r8*rxt(k,370)*y(k,296) + .180_r8*rxt(k,688)*y(k,297) & - + .180_r8*rxt(k,692)*y(k,298) + .490_r8*rxt(k,704)*y(k,300) & - + .380_r8*rxt(k,712)*y(k,301) + .490_r8*rxt(k,722)*y(k,302) & - + .150_r8*rxt(k,731)*y(k,303) + .530_r8*rxt(k,741)*y(k,304) & - + .490_r8*rxt(k,752)*y(k,305) + .100_r8*rxt(k,761)*y(k,306) & - + .100_r8*rxt(k,766)*y(k,307) + .100_r8*rxt(k,773)*y(k,308) & - + .100_r8*rxt(k,777)*y(k,309) + .100_r8*rxt(k,781)*y(k,310) & - + .100_r8*rxt(k,785)*y(k,311) - mat(k,600) = .200_r8*rxt(k,313)*y(k,256) - mat(k,1413) = .650_r8*rxt(k,422)*y(k,256) - mat(k,1842) = .060_r8*rxt(k,427)*y(k,256) - mat(k,1744) = .060_r8*rxt(k,433)*y(k,256) - mat(k,1564) = .550_r8*rxt(k,510)*y(k,147) + .550_r8*rxt(k,445)*y(k,250) & - + .280_r8*rxt(k,446)*y(k,251) - mat(k,1585) = .550_r8*rxt(k,512)*y(k,147) + .550_r8*rxt(k,449)*y(k,250) & - + .280_r8*rxt(k,450)*y(k,251) - mat(k,1009) = .580_r8*rxt(k,458)*y(k,256) - mat(k,1082) = .520_r8*rxt(k,462)*y(k,256) - mat(k,994) = .600_r8*rxt(k,465)*y(k,256) - mat(k,1020) = .500_r8*rxt(k,468)*y(k,256) - mat(k,1328) = .400_r8*rxt(k,472)*y(k,256) - mat(k,2047) = .240_r8*rxt(k,477)*y(k,256) - mat(k,1193) = .470_r8*rxt(k,526)*y(k,147) + .850_r8*rxt(k,480)*y(k,256) - mat(k,1269) = .040_r8*rxt(k,528)*y(k,147) + .860_r8*rxt(k,483)*y(k,256) - mat(k,1794) = .550_r8*rxt(k,531)*y(k,147) + .550_r8*rxt(k,492)*y(k,250) & - + .280_r8*rxt(k,493)*y(k,251) - mat(k,1682) = .550_r8*rxt(k,534)*y(k,147) + .550_r8*rxt(k,496)*y(k,250) & - + .280_r8*rxt(k,497)*y(k,251) - mat(k,2321) = .500_r8*rxt(k,648)*y(k,256) - mat(k,2174) = .100_r8*rxt(k,657)*y(k,256) - mat(k,1395) = .590_r8*rxt(k,384)*y(k,256) - mat(k,1508) = .490_r8*rxt(k,391)*y(k,256) - mat(k,820) = .400_r8*rxt(k,562)*y(k,256) - mat(k,662) = .200_r8*rxt(k,395)*y(k,256) - mat(k,1381) = .540_r8*rxt(k,403)*y(k,256) - mat(k,2382) = .480_r8*rxt(k,668)*y(k,256) - mat(k,2289) = .100_r8*rxt(k,677)*y(k,256) - mat(k,1493) = .800_r8*rxt(k,500)*y(k,256) - mat(k,3112) = rxt(k,168)*y(k,79) + rxt(k,273)*y(k,83) + rxt(k,250)*y(k,87) & - + rxt(k,319)*y(k,88) + 2.000_r8*rxt(k,169)*y(k,317) - mat(k,3752) = mat(k,3752) + .650_r8*rxt(k,322)*y(k,25) + .500_r8*rxt(k,330) & - *y(k,28) + .300_r8*rxt(k,307)*y(k,54) + .890_r8*rxt(k,348) & - *y(k,89) + .500_r8*rxt(k,312)*y(k,92) + .430_r8*rxt(k,415) & - *y(k,98) + .530_r8*rxt(k,416)*y(k,99) + 1.080_r8*rxt(k,419) & - *y(k,103) + .700_r8*rxt(k,364)*y(k,104) + .500_r8*rxt(k,455) & - *y(k,112) + .060_r8*rxt(k,461)*y(k,115) + .040_r8*rxt(k,471) & - *y(k,118) + .030_r8*rxt(k,473)*y(k,119) + .420_r8*rxt(k,482) & - *y(k,120) + .290_r8*rxt(k,486)*y(k,121) + (.130_r8*rxt(k,490) & - +.920_r8*rxt(k,491))*y(k,123) + .500_r8*rxt(k,368)*y(k,169) - mat(k,1234) = .150_r8*rxt(k,370)*y(k,256) - mat(k,842) = .180_r8*rxt(k,688)*y(k,256) - mat(k,924) = .180_r8*rxt(k,692)*y(k,256) - mat(k,2546) = .490_r8*rxt(k,704)*y(k,256) - mat(k,2502) = .380_r8*rxt(k,712)*y(k,256) - mat(k,2592) = .490_r8*rxt(k,722)*y(k,256) - mat(k,2090) = .150_r8*rxt(k,731)*y(k,256) - mat(k,2481) = .530_r8*rxt(k,741)*y(k,256) - mat(k,2639) = .490_r8*rxt(k,752)*y(k,256) - mat(k,687) = .100_r8*rxt(k,761)*y(k,256) - mat(k,851) = .100_r8*rxt(k,766)*y(k,256) - mat(k,1152) = .100_r8*rxt(k,773)*y(k,256) - mat(k,933) = .100_r8*rxt(k,777)*y(k,256) - mat(k,695) = .100_r8*rxt(k,781)*y(k,256) - mat(k,703) = .100_r8*rxt(k,785)*y(k,256) - mat(k,3858) = rxt(k,277)*y(k,75) + 2.000_r8*rxt(k,169)*y(k,292) + *y(k,156) + rxt(k,183)*y(k,157) + .400_r8*rxt(k,541)*y(k,233) & + + .700_r8*rxt(k,588)*y(k,235) + .350_r8*rxt(k,596)*y(k,236) & + + .500_r8*rxt(k,608)*y(k,238) + .100_r8*rxt(k,616)*y(k,239) & + + .470_r8*rxt(k,628)*y(k,243) + .030_r8*rxt(k,636)*y(k,244) & + + .490_r8*rxt(k,337)*y(k,250) + .400_r8*rxt(k,555)*y(k,252) & + + .200_r8*rxt(k,312)*y(k,257) + .650_r8*rxt(k,421)*y(k,258) & + + .060_r8*rxt(k,426)*y(k,259) + .060_r8*rxt(k,432)*y(k,260) & + + .580_r8*rxt(k,457)*y(k,267) + .520_r8*rxt(k,461)*y(k,268) & + + .600_r8*rxt(k,464)*y(k,269) + .500_r8*rxt(k,467)*y(k,270) & + + .400_r8*rxt(k,471)*y(k,271) + .240_r8*rxt(k,476)*y(k,272) & + + .850_r8*rxt(k,479)*y(k,273) + .860_r8*rxt(k,482)*y(k,274) & + + .500_r8*rxt(k,647)*y(k,279) + .100_r8*rxt(k,656)*y(k,280) & + + .590_r8*rxt(k,383)*y(k,282) + .490_r8*rxt(k,390)*y(k,284) & + + .400_r8*rxt(k,561)*y(k,285) + .200_r8*rxt(k,394)*y(k,286) & + + .540_r8*rxt(k,402)*y(k,287) + .480_r8*rxt(k,667)*y(k,288) & + + .100_r8*rxt(k,676)*y(k,289) + .800_r8*rxt(k,499)*y(k,291) & + + .150_r8*rxt(k,369)*y(k,296) + .180_r8*rxt(k,687)*y(k,297) & + + .180_r8*rxt(k,691)*y(k,298) + .490_r8*rxt(k,703)*y(k,300) & + + .380_r8*rxt(k,711)*y(k,301) + .490_r8*rxt(k,721)*y(k,302) & + + .150_r8*rxt(k,730)*y(k,303) + .530_r8*rxt(k,740)*y(k,304) & + + .490_r8*rxt(k,751)*y(k,305) + .100_r8*rxt(k,760)*y(k,306) & + + .100_r8*rxt(k,765)*y(k,307) + .100_r8*rxt(k,772)*y(k,308) & + + .100_r8*rxt(k,776)*y(k,309) + .100_r8*rxt(k,780)*y(k,310) & + + .100_r8*rxt(k,784)*y(k,311) + mat(k,697) = .200_r8*rxt(k,312)*y(k,256) + mat(k,1305) = .650_r8*rxt(k,421)*y(k,256) + mat(k,1970) = .060_r8*rxt(k,426)*y(k,256) + mat(k,2009) = .060_r8*rxt(k,432)*y(k,256) + mat(k,1753) = .550_r8*rxt(k,509)*y(k,147) + .550_r8*rxt(k,444)*y(k,250) & + + .280_r8*rxt(k,445)*y(k,251) + mat(k,1781) = .550_r8*rxt(k,511)*y(k,147) + .550_r8*rxt(k,448)*y(k,250) & + + .280_r8*rxt(k,449)*y(k,251) + mat(k,1128) = .580_r8*rxt(k,457)*y(k,256) + mat(k,1174) = .520_r8*rxt(k,461)*y(k,256) + mat(k,1060) = .600_r8*rxt(k,464)*y(k,256) + mat(k,1139) = .500_r8*rxt(k,467)*y(k,256) + mat(k,1450) = .400_r8*rxt(k,471)*y(k,256) + mat(k,2191) = .240_r8*rxt(k,476)*y(k,256) + mat(k,1319) = .470_r8*rxt(k,525)*y(k,147) + .850_r8*rxt(k,479)*y(k,256) + mat(k,1427) = .040_r8*rxt(k,527)*y(k,147) + .860_r8*rxt(k,482)*y(k,256) + mat(k,1860) = .550_r8*rxt(k,530)*y(k,147) + .550_r8*rxt(k,491)*y(k,250) & + + .280_r8*rxt(k,492)*y(k,251) + mat(k,1829) = .550_r8*rxt(k,533)*y(k,147) + .550_r8*rxt(k,495)*y(k,250) & + + .280_r8*rxt(k,496)*y(k,251) + mat(k,2514) = .500_r8*rxt(k,647)*y(k,256) + mat(k,2396) = .100_r8*rxt(k,656)*y(k,256) + mat(k,1552) = .590_r8*rxt(k,383)*y(k,256) + mat(k,1627) = .490_r8*rxt(k,390)*y(k,256) + mat(k,928) = .400_r8*rxt(k,561)*y(k,256) + mat(k,743) = .200_r8*rxt(k,394)*y(k,256) + mat(k,1516) = .540_r8*rxt(k,402)*y(k,256) + mat(k,2715) = .480_r8*rxt(k,667)*y(k,256) + mat(k,2818) = .100_r8*rxt(k,676)*y(k,256) + mat(k,1652) = .800_r8*rxt(k,499)*y(k,256) + mat(k,2647) = rxt(k,315)*y(k,55) + rxt(k,168)*y(k,79) + rxt(k,273)*y(k,83) & + + rxt(k,250)*y(k,87) + rxt(k,318)*y(k,88) + 2.000_r8*rxt(k,169) & + *y(k,317) + mat(k,3822) = mat(k,3822) + .650_r8*rxt(k,321)*y(k,25) + .500_r8*rxt(k,329) & + *y(k,28) + .300_r8*rxt(k,307)*y(k,54) + .890_r8*rxt(k,347) & + *y(k,89) + .500_r8*rxt(k,311)*y(k,92) + .430_r8*rxt(k,414) & + *y(k,98) + .530_r8*rxt(k,415)*y(k,99) + 1.080_r8*rxt(k,418) & + *y(k,103) + .700_r8*rxt(k,363)*y(k,104) + .500_r8*rxt(k,454) & + *y(k,112) + .060_r8*rxt(k,460)*y(k,115) + .040_r8*rxt(k,470) & + *y(k,118) + .030_r8*rxt(k,472)*y(k,119) + .420_r8*rxt(k,481) & + *y(k,120) + .290_r8*rxt(k,485)*y(k,121) + (.130_r8*rxt(k,489) & + +.920_r8*rxt(k,490))*y(k,123) + .500_r8*rxt(k,367)*y(k,169) + mat(k,1342) = .150_r8*rxt(k,369)*y(k,256) + mat(k,951) = .180_r8*rxt(k,687)*y(k,256) + mat(k,1010) = .180_r8*rxt(k,691)*y(k,256) + mat(k,2957) = .490_r8*rxt(k,703)*y(k,256) + mat(k,2785) = .380_r8*rxt(k,711)*y(k,256) + mat(k,2864) = .490_r8*rxt(k,721)*y(k,256) + mat(k,2250) = .150_r8*rxt(k,730)*y(k,256) + mat(k,2762) = .530_r8*rxt(k,740)*y(k,256) + mat(k,2911) = .490_r8*rxt(k,751)*y(k,256) + mat(k,801) = .100_r8*rxt(k,760)*y(k,256) + mat(k,960) = .100_r8*rxt(k,765)*y(k,256) + mat(k,1223) = .100_r8*rxt(k,772)*y(k,256) + mat(k,1019) = .100_r8*rxt(k,776)*y(k,256) + mat(k,809) = .100_r8*rxt(k,780)*y(k,256) + mat(k,817) = .100_r8*rxt(k,784)*y(k,256) + mat(k,4127) = rxt(k,277)*y(k,75) + 2.000_r8*rxt(k,169)*y(k,292) end do end subroutine nlnmat15 subroutine nlnmat16( avec_len, mat, y, rxt ) @@ -4194,228 +4509,228 @@ subroutine nlnmat16( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,377) = -(rxt(k,565)*y(k,256) + rxt(k,566)*y(k,147)) - mat(k,3150) = -rxt(k,565)*y(k,294) - mat(k,2765) = -rxt(k,566)*y(k,294) - mat(k,169) = .200_r8*rxt(k,555)*y(k,293) - mat(k,142) = .140_r8*rxt(k,567)*y(k,293) - mat(k,281) = rxt(k,570)*y(k,293) - mat(k,3579) = .200_r8*rxt(k,555)*y(k,67) + .140_r8*rxt(k,567)*y(k,165) & - + rxt(k,570)*y(k,166) - mat(k,822) = -(rxt(k,366)*y(k,256) + rxt(k,367)*y(k,147)) - mat(k,3183) = -rxt(k,366)*y(k,295) - mat(k,2792) = -rxt(k,367)*y(k,295) - mat(k,1195) = rxt(k,373)*y(k,293) - mat(k,483) = .500_r8*rxt(k,368)*y(k,293) - mat(k,3632) = rxt(k,373)*y(k,30) + .500_r8*rxt(k,368)*y(k,169) - mat(k,1224) = -(rxt(k,369)*y(k,251) + rxt(k,370)*y(k,256) + rxt(k,371) & + mat(k,453) = -(rxt(k,564)*y(k,256) + rxt(k,565)*y(k,147)) + mat(k,3430) = -rxt(k,564)*y(k,294) + mat(k,3185) = -rxt(k,565)*y(k,294) + mat(k,217) = .200_r8*rxt(k,554)*y(k,293) + mat(k,191) = .140_r8*rxt(k,566)*y(k,293) + mat(k,345) = rxt(k,569)*y(k,293) + mat(k,3644) = .200_r8*rxt(k,554)*y(k,67) + .140_r8*rxt(k,566)*y(k,165) & + + rxt(k,569)*y(k,166) + mat(k,932) = -(rxt(k,365)*y(k,256) + rxt(k,366)*y(k,147)) + mat(k,3463) = -rxt(k,365)*y(k,295) + mat(k,3211) = -rxt(k,366)*y(k,295) + mat(k,1363) = rxt(k,372)*y(k,293) + mat(k,583) = .500_r8*rxt(k,367)*y(k,293) + mat(k,3700) = rxt(k,372)*y(k,30) + .500_r8*rxt(k,367)*y(k,169) + mat(k,1334) = -(rxt(k,368)*y(k,251) + rxt(k,369)*y(k,256) + rxt(k,370) & *y(k,147)) - mat(k,3356) = -rxt(k,369)*y(k,296) - mat(k,3208) = -rxt(k,370)*y(k,296) - mat(k,2815) = -rxt(k,371)*y(k,296) - mat(k,2137) = rxt(k,374)*y(k,293) - mat(k,333) = rxt(k,372)*y(k,293) - mat(k,3668) = rxt(k,374)*y(k,49) + rxt(k,372)*y(k,170) - mat(k,834) = -(rxt(k,688)*y(k,256) + rxt(k,689)*y(k,147)) - mat(k,3184) = -rxt(k,688)*y(k,297) - mat(k,2793) = -rxt(k,689)*y(k,297) - mat(k,2175) = rxt(k,690)*y(k,293) - mat(k,3633) = rxt(k,690)*y(k,198) - mat(k,917) = -(rxt(k,692)*y(k,256) + rxt(k,693)*y(k,147)) - mat(k,3189) = -rxt(k,692)*y(k,298) - mat(k,2798) = -rxt(k,693)*y(k,298) - mat(k,387) = rxt(k,691)*y(k,293) - mat(k,3640) = rxt(k,691)*y(k,199) - mat(k,2445) = -(rxt(k,694)*y(k,250) + rxt(k,695)*y(k,251) + rxt(k,696) & - *y(k,256) + rxt(k,697)*y(k,147) + rxt(k,698)*y(k,149) + rxt(k,699) & - *y(k,300) + rxt(k,700)*y(k,302)) - mat(k,2693) = -rxt(k,694)*y(k,299) - mat(k,3413) = -rxt(k,695)*y(k,299) - mat(k,3272) = -rxt(k,696)*y(k,299) - mat(k,2876) = -rxt(k,697)*y(k,299) - mat(k,3069) = -rxt(k,698)*y(k,299) - mat(k,2529) = -rxt(k,699)*y(k,299) - mat(k,2575) = -rxt(k,700)*y(k,299) - mat(k,2876) = mat(k,2876) + rxt(k,753)*y(k,305) - mat(k,3069) = mat(k,3069) + rxt(k,754)*y(k,305) - mat(k,523) = .290_r8*rxt(k,749)*y(k,293) - mat(k,996) = .860_r8*rxt(k,772)*y(k,293) - mat(k,2121) = rxt(k,594)*y(k,305) - mat(k,2216) = rxt(k,602)*y(k,305) - mat(k,2055) = rxt(k,614)*y(k,305) - mat(k,2100) = rxt(k,622)*y(k,305) - mat(k,2333) = rxt(k,634)*y(k,305) - mat(k,2245) = rxt(k,642)*y(k,305) - mat(k,2693) = mat(k,2693) + rxt(k,750)*y(k,305) - mat(k,3413) = mat(k,3413) + rxt(k,751)*y(k,305) - mat(k,3272) = mat(k,3272) + .490_r8*rxt(k,752)*y(k,305) - mat(k,2306) = rxt(k,654)*y(k,305) - mat(k,2160) = rxt(k,662)*y(k,305) - mat(k,2367) = rxt(k,674)*y(k,305) - mat(k,2274) = rxt(k,682)*y(k,305) - mat(k,3733) = .290_r8*rxt(k,749)*y(k,205) + .860_r8*rxt(k,772)*y(k,214) - mat(k,2529) = mat(k,2529) + rxt(k,708)*y(k,305) - mat(k,2487) = rxt(k,717)*y(k,305) - mat(k,2575) = mat(k,2575) + rxt(k,727)*y(k,305) - mat(k,2075) = rxt(k,736)*y(k,305) - mat(k,2466) = rxt(k,746)*y(k,305) - mat(k,2622) = rxt(k,753)*y(k,147) + rxt(k,754)*y(k,149) + rxt(k,594)*y(k,235) & - + rxt(k,602)*y(k,236) + rxt(k,614)*y(k,238) + rxt(k,622) & - *y(k,239) + rxt(k,634)*y(k,243) + rxt(k,642)*y(k,244) & - + rxt(k,750)*y(k,250) + rxt(k,751)*y(k,251) + .490_r8*rxt(k,752) & - *y(k,256) + rxt(k,654)*y(k,279) + rxt(k,662)*y(k,280) & - + rxt(k,674)*y(k,288) + rxt(k,682)*y(k,289) + rxt(k,708) & - *y(k,300) + rxt(k,717)*y(k,301) + rxt(k,727)*y(k,302) & - + rxt(k,736)*y(k,303) + rxt(k,746)*y(k,304) & - + 4.000_r8*rxt(k,755)*y(k,305) - mat(k,2532) = -(rxt(k,592)*y(k,235) + rxt(k,600)*y(k,236) + rxt(k,612) & + mat(k,3973) = -rxt(k,368)*y(k,296) + mat(k,3488) = -rxt(k,369)*y(k,296) + mat(k,3234) = -rxt(k,370)*y(k,296) + mat(k,2272) = rxt(k,373)*y(k,293) + mat(k,403) = rxt(k,371)*y(k,293) + mat(k,3735) = rxt(k,373)*y(k,49) + rxt(k,371)*y(k,170) + mat(k,944) = -(rxt(k,687)*y(k,256) + rxt(k,688)*y(k,147)) + mat(k,3464) = -rxt(k,687)*y(k,297) + mat(k,3212) = -rxt(k,688)*y(k,297) + mat(k,2431) = rxt(k,689)*y(k,293) + mat(k,3701) = rxt(k,689)*y(k,198) + mat(k,1004) = -(rxt(k,691)*y(k,256) + rxt(k,692)*y(k,147)) + mat(k,3470) = -rxt(k,691)*y(k,298) + mat(k,3218) = -rxt(k,692)*y(k,298) + mat(k,469) = rxt(k,690)*y(k,293) + mat(k,3707) = rxt(k,690)*y(k,199) + mat(k,2728) = -(rxt(k,693)*y(k,250) + rxt(k,694)*y(k,251) + rxt(k,695) & + *y(k,256) + rxt(k,696)*y(k,147) + rxt(k,697)*y(k,149) + rxt(k,698) & + *y(k,300) + rxt(k,699)*y(k,302)) + mat(k,3016) = -rxt(k,693)*y(k,299) + mat(k,4034) = -rxt(k,694)*y(k,299) + mat(k,3557) = -rxt(k,695)*y(k,299) + mat(k,3301) = -rxt(k,696)*y(k,299) + mat(k,3942) = -rxt(k,697)*y(k,299) + mat(k,2942) = -rxt(k,698)*y(k,299) + mat(k,2849) = -rxt(k,699)*y(k,299) + mat(k,3301) = mat(k,3301) + rxt(k,752)*y(k,305) + mat(k,3942) = mat(k,3942) + rxt(k,753)*y(k,305) + mat(k,770) = .290_r8*rxt(k,748)*y(k,293) + mat(k,1105) = .860_r8*rxt(k,771)*y(k,293) + mat(k,2298) = rxt(k,593)*y(k,305) + mat(k,2468) = rxt(k,601)*y(k,305) + mat(k,2215) = rxt(k,613)*y(k,305) + mat(k,2326) = rxt(k,621)*y(k,305) + mat(k,2531) = rxt(k,633)*y(k,305) + mat(k,2414) = rxt(k,641)*y(k,305) + mat(k,3016) = mat(k,3016) + rxt(k,749)*y(k,305) + mat(k,4034) = mat(k,4034) + rxt(k,750)*y(k,305) + mat(k,3557) = mat(k,3557) + .490_r8*rxt(k,751)*y(k,305) + mat(k,2502) = rxt(k,653)*y(k,305) + mat(k,2384) = rxt(k,661)*y(k,305) + mat(k,2701) = rxt(k,673)*y(k,305) + mat(k,2803) = rxt(k,681)*y(k,305) + mat(k,3807) = .290_r8*rxt(k,748)*y(k,205) + .860_r8*rxt(k,771)*y(k,214) + mat(k,2942) = mat(k,2942) + rxt(k,707)*y(k,305) + mat(k,2773) = rxt(k,716)*y(k,305) + mat(k,2849) = mat(k,2849) + rxt(k,726)*y(k,305) + mat(k,2238) = rxt(k,735)*y(k,305) + mat(k,2750) = rxt(k,745)*y(k,305) + mat(k,2896) = rxt(k,752)*y(k,147) + rxt(k,753)*y(k,149) + rxt(k,593)*y(k,235) & + + rxt(k,601)*y(k,236) + rxt(k,613)*y(k,238) + rxt(k,621) & + *y(k,239) + rxt(k,633)*y(k,243) + rxt(k,641)*y(k,244) & + + rxt(k,749)*y(k,250) + rxt(k,750)*y(k,251) + .490_r8*rxt(k,751) & + *y(k,256) + rxt(k,653)*y(k,279) + rxt(k,661)*y(k,280) & + + rxt(k,673)*y(k,288) + rxt(k,681)*y(k,289) + rxt(k,707) & + *y(k,300) + rxt(k,716)*y(k,301) + rxt(k,726)*y(k,302) & + + rxt(k,735)*y(k,303) + rxt(k,745)*y(k,304) & + + 4.000_r8*rxt(k,754)*y(k,305) + mat(k,2948) = -(rxt(k,591)*y(k,235) + rxt(k,599)*y(k,236) + rxt(k,611) & + *y(k,238) + rxt(k,619)*y(k,239) + rxt(k,631)*y(k,243) + rxt(k,639) & + *y(k,244) + rxt(k,651)*y(k,279) + rxt(k,659)*y(k,280) + rxt(k,671) & + *y(k,288) + rxt(k,679)*y(k,289) + rxt(k,684)*y(k,148) + rxt(k,698) & + *y(k,299) + rxt(k,701)*y(k,250) + rxt(k,702)*y(k,251) + rxt(k,703) & + *y(k,256) + rxt(k,704)*y(k,147) + rxt(k,705)*y(k,149) & + + 4._r8*rxt(k,706)*y(k,300) + rxt(k,707)*y(k,305) + rxt(k,714) & + *y(k,301) + rxt(k,724)*y(k,302) + rxt(k,733)*y(k,303) + rxt(k,743) & + *y(k,304)) + mat(k,2303) = -rxt(k,591)*y(k,300) + mat(k,2473) = -rxt(k,599)*y(k,300) + mat(k,2220) = -rxt(k,611)*y(k,300) + mat(k,2331) = -rxt(k,619)*y(k,300) + mat(k,2536) = -rxt(k,631)*y(k,300) + mat(k,2419) = -rxt(k,639)*y(k,300) + mat(k,2507) = -rxt(k,651)*y(k,300) + mat(k,2389) = -rxt(k,659)*y(k,300) + mat(k,2706) = -rxt(k,671)*y(k,300) + mat(k,2809) = -rxt(k,679)*y(k,300) + mat(k,4092) = -rxt(k,684)*y(k,300) + mat(k,2733) = -rxt(k,698)*y(k,300) + mat(k,3022) = -rxt(k,701)*y(k,300) + mat(k,4040) = -rxt(k,702)*y(k,300) + mat(k,3563) = -rxt(k,703)*y(k,300) + mat(k,3307) = -rxt(k,704)*y(k,300) + mat(k,3948) = -rxt(k,705)*y(k,300) + mat(k,2902) = -rxt(k,707)*y(k,300) + mat(k,2778) = -rxt(k,714)*y(k,300) + mat(k,2855) = -rxt(k,724)*y(k,300) + mat(k,2243) = -rxt(k,733)*y(k,300) + mat(k,2755) = -rxt(k,743)*y(k,300) + mat(k,1257) = .270_r8*rxt(k,602)*y(k,157) + mat(k,1099) = .300_r8*rxt(k,642)*y(k,157) + mat(k,3948) = mat(k,3948) + rxt(k,708)*y(k,201) + mat(k,3125) = .270_r8*rxt(k,602)*y(k,4) + .300_r8*rxt(k,642)*y(k,17) + mat(k,1290) = rxt(k,708)*y(k,149) + rxt(k,717)*y(k,293) + mat(k,363) = .710_r8*rxt(k,746)*y(k,293) + mat(k,1106) = .140_r8*rxt(k,771)*y(k,293) + mat(k,3813) = rxt(k,717)*y(k,201) + .710_r8*rxt(k,746)*y(k,206) & + + .140_r8*rxt(k,771)*y(k,214) + mat(k,2775) = -(rxt(k,709)*y(k,250) + rxt(k,710)*y(k,251) + rxt(k,711) & + *y(k,256) + rxt(k,712)*y(k,147) + rxt(k,713)*y(k,149) + rxt(k,715) & + *y(k,302) + rxt(k,716)*y(k,305)) + mat(k,3018) = -rxt(k,709)*y(k,301) + mat(k,4036) = -rxt(k,710)*y(k,301) + mat(k,3559) = -rxt(k,711)*y(k,301) + mat(k,3303) = -rxt(k,712)*y(k,301) + mat(k,3944) = -rxt(k,713)*y(k,301) + mat(k,2851) = -rxt(k,715)*y(k,301) + mat(k,2898) = -rxt(k,716)*y(k,301) + mat(k,1255) = .330_r8*rxt(k,602)*y(k,157) + mat(k,3303) = mat(k,3303) + .700_r8*rxt(k,696)*y(k,299) + rxt(k,704)*y(k,300) + mat(k,3944) = mat(k,3944) + rxt(k,697)*y(k,299) + rxt(k,705)*y(k,300) + mat(k,3121) = .330_r8*rxt(k,602)*y(k,4) + mat(k,2368) = .230_r8*rxt(k,756)*y(k,293) + mat(k,362) = .290_r8*rxt(k,746)*y(k,293) + mat(k,2300) = rxt(k,591)*y(k,300) + mat(k,2470) = rxt(k,599)*y(k,300) + mat(k,2217) = rxt(k,611)*y(k,300) + mat(k,2328) = rxt(k,619)*y(k,300) + mat(k,2533) = rxt(k,631)*y(k,300) + mat(k,2416) = rxt(k,639)*y(k,300) + mat(k,3018) = mat(k,3018) + rxt(k,693)*y(k,299) + rxt(k,701)*y(k,300) + mat(k,4036) = mat(k,4036) + .500_r8*rxt(k,694)*y(k,299) + rxt(k,702)*y(k,300) + mat(k,3559) = mat(k,3559) + .490_r8*rxt(k,703)*y(k,300) + mat(k,2504) = rxt(k,651)*y(k,300) + mat(k,2386) = rxt(k,659)*y(k,300) + mat(k,2703) = rxt(k,671)*y(k,300) + mat(k,2805) = rxt(k,679)*y(k,300) + mat(k,3809) = .230_r8*rxt(k,756)*y(k,200) + .290_r8*rxt(k,746)*y(k,206) + mat(k,2730) = .700_r8*rxt(k,696)*y(k,147) + rxt(k,697)*y(k,149) + rxt(k,693) & + *y(k,250) + .500_r8*rxt(k,694)*y(k,251) + 2.000_r8*rxt(k,698) & + *y(k,300) + rxt(k,699)*y(k,302) + rxt(k,700)*y(k,305) + mat(k,2944) = rxt(k,704)*y(k,147) + rxt(k,705)*y(k,149) + rxt(k,591)*y(k,235) & + + rxt(k,599)*y(k,236) + rxt(k,611)*y(k,238) + rxt(k,619) & + *y(k,239) + rxt(k,631)*y(k,243) + rxt(k,639)*y(k,244) & + + rxt(k,701)*y(k,250) + rxt(k,702)*y(k,251) + .490_r8*rxt(k,703) & + *y(k,256) + rxt(k,651)*y(k,279) + rxt(k,659)*y(k,280) & + + rxt(k,671)*y(k,288) + rxt(k,679)*y(k,289) & + + 2.000_r8*rxt(k,698)*y(k,299) + 4.000_r8*rxt(k,706)*y(k,300) & + + rxt(k,724)*y(k,302) + rxt(k,733)*y(k,303) + rxt(k,743) & + *y(k,304) + rxt(k,707)*y(k,305) + mat(k,2851) = mat(k,2851) + rxt(k,699)*y(k,299) + rxt(k,724)*y(k,300) + mat(k,2240) = rxt(k,733)*y(k,300) + mat(k,2752) = rxt(k,743)*y(k,300) + mat(k,2898) = mat(k,2898) + rxt(k,700)*y(k,299) + rxt(k,707)*y(k,300) + mat(k,2853) = -(rxt(k,592)*y(k,235) + rxt(k,600)*y(k,236) + rxt(k,612) & *y(k,238) + rxt(k,620)*y(k,239) + rxt(k,632)*y(k,243) + rxt(k,640) & *y(k,244) + rxt(k,652)*y(k,279) + rxt(k,660)*y(k,280) + rxt(k,672) & *y(k,288) + rxt(k,680)*y(k,289) + rxt(k,685)*y(k,148) + rxt(k,699) & - *y(k,299) + rxt(k,702)*y(k,250) + rxt(k,703)*y(k,251) + rxt(k,704) & - *y(k,256) + rxt(k,705)*y(k,147) + rxt(k,706)*y(k,149) & - + 4._r8*rxt(k,707)*y(k,300) + rxt(k,708)*y(k,305) + rxt(k,715) & - *y(k,301) + rxt(k,725)*y(k,302) + rxt(k,734)*y(k,303) + rxt(k,744) & - *y(k,304)) - mat(k,2124) = -rxt(k,592)*y(k,300) - mat(k,2219) = -rxt(k,600)*y(k,300) - mat(k,2058) = -rxt(k,612)*y(k,300) - mat(k,2103) = -rxt(k,620)*y(k,300) - mat(k,2336) = -rxt(k,632)*y(k,300) - mat(k,2248) = -rxt(k,640)*y(k,300) - mat(k,2309) = -rxt(k,652)*y(k,300) - mat(k,2163) = -rxt(k,660)*y(k,300) - mat(k,2370) = -rxt(k,672)*y(k,300) - mat(k,2277) = -rxt(k,680)*y(k,300) - mat(k,3496) = -rxt(k,685)*y(k,300) - mat(k,2448) = -rxt(k,699)*y(k,300) - mat(k,2696) = -rxt(k,702)*y(k,300) - mat(k,3416) = -rxt(k,703)*y(k,300) - mat(k,3275) = -rxt(k,704)*y(k,300) - mat(k,2879) = -rxt(k,705)*y(k,300) - mat(k,3072) = -rxt(k,706)*y(k,300) - mat(k,2625) = -rxt(k,708)*y(k,300) - mat(k,2490) = -rxt(k,715)*y(k,300) - mat(k,2578) = -rxt(k,725)*y(k,300) - mat(k,2078) = -rxt(k,734)*y(k,300) - mat(k,2469) = -rxt(k,744)*y(k,300) - mat(k,1111) = .270_r8*rxt(k,603)*y(k,157) - mat(k,949) = .300_r8*rxt(k,643)*y(k,157) - mat(k,3072) = mat(k,3072) + rxt(k,709)*y(k,201) - mat(k,2980) = .270_r8*rxt(k,603)*y(k,4) + .300_r8*rxt(k,643)*y(k,17) - mat(k,1170) = rxt(k,709)*y(k,149) + rxt(k,718)*y(k,293) - mat(k,228) = .710_r8*rxt(k,747)*y(k,293) - mat(k,997) = .140_r8*rxt(k,772)*y(k,293) - mat(k,3736) = rxt(k,718)*y(k,201) + .710_r8*rxt(k,747)*y(k,206) & - + .140_r8*rxt(k,772)*y(k,214) - mat(k,2489) = -(rxt(k,710)*y(k,250) + rxt(k,711)*y(k,251) + rxt(k,712) & - *y(k,256) + rxt(k,713)*y(k,147) + rxt(k,714)*y(k,149) + rxt(k,716) & - *y(k,302) + rxt(k,717)*y(k,305)) - mat(k,2695) = -rxt(k,710)*y(k,301) - mat(k,3415) = -rxt(k,711)*y(k,301) - mat(k,3274) = -rxt(k,712)*y(k,301) - mat(k,2878) = -rxt(k,713)*y(k,301) - mat(k,3071) = -rxt(k,714)*y(k,301) - mat(k,2577) = -rxt(k,716)*y(k,301) - mat(k,2624) = -rxt(k,717)*y(k,301) - mat(k,1110) = .330_r8*rxt(k,603)*y(k,157) - mat(k,2878) = mat(k,2878) + .700_r8*rxt(k,697)*y(k,299) + rxt(k,705)*y(k,300) - mat(k,3071) = mat(k,3071) + rxt(k,698)*y(k,299) + rxt(k,706)*y(k,300) - mat(k,2979) = .330_r8*rxt(k,603)*y(k,4) - mat(k,2195) = .230_r8*rxt(k,757)*y(k,293) - mat(k,227) = .290_r8*rxt(k,747)*y(k,293) - mat(k,2123) = rxt(k,592)*y(k,300) - mat(k,2218) = rxt(k,600)*y(k,300) - mat(k,2057) = rxt(k,612)*y(k,300) - mat(k,2102) = rxt(k,620)*y(k,300) - mat(k,2335) = rxt(k,632)*y(k,300) - mat(k,2247) = rxt(k,640)*y(k,300) - mat(k,2695) = mat(k,2695) + rxt(k,694)*y(k,299) + rxt(k,702)*y(k,300) - mat(k,3415) = mat(k,3415) + .500_r8*rxt(k,695)*y(k,299) + rxt(k,703)*y(k,300) - mat(k,3274) = mat(k,3274) + .490_r8*rxt(k,704)*y(k,300) - mat(k,2308) = rxt(k,652)*y(k,300) - mat(k,2162) = rxt(k,660)*y(k,300) - mat(k,2369) = rxt(k,672)*y(k,300) - mat(k,2276) = rxt(k,680)*y(k,300) - mat(k,3735) = .230_r8*rxt(k,757)*y(k,200) + .290_r8*rxt(k,747)*y(k,206) - mat(k,2447) = .700_r8*rxt(k,697)*y(k,147) + rxt(k,698)*y(k,149) + rxt(k,694) & - *y(k,250) + .500_r8*rxt(k,695)*y(k,251) + 2.000_r8*rxt(k,699) & - *y(k,300) + rxt(k,700)*y(k,302) + rxt(k,701)*y(k,305) - mat(k,2531) = rxt(k,705)*y(k,147) + rxt(k,706)*y(k,149) + rxt(k,592)*y(k,235) & - + rxt(k,600)*y(k,236) + rxt(k,612)*y(k,238) + rxt(k,620) & - *y(k,239) + rxt(k,632)*y(k,243) + rxt(k,640)*y(k,244) & - + rxt(k,702)*y(k,250) + rxt(k,703)*y(k,251) + .490_r8*rxt(k,704) & - *y(k,256) + rxt(k,652)*y(k,279) + rxt(k,660)*y(k,280) & - + rxt(k,672)*y(k,288) + rxt(k,680)*y(k,289) & - + 2.000_r8*rxt(k,699)*y(k,299) + 4.000_r8*rxt(k,707)*y(k,300) & - + rxt(k,725)*y(k,302) + rxt(k,734)*y(k,303) + rxt(k,744) & - *y(k,304) + rxt(k,708)*y(k,305) - mat(k,2577) = mat(k,2577) + rxt(k,700)*y(k,299) + rxt(k,725)*y(k,300) - mat(k,2077) = rxt(k,734)*y(k,300) - mat(k,2468) = rxt(k,744)*y(k,300) - mat(k,2624) = mat(k,2624) + rxt(k,701)*y(k,299) + rxt(k,708)*y(k,300) - mat(k,2579) = -(rxt(k,593)*y(k,235) + rxt(k,601)*y(k,236) + rxt(k,613) & - *y(k,238) + rxt(k,621)*y(k,239) + rxt(k,633)*y(k,243) + rxt(k,641) & - *y(k,244) + rxt(k,653)*y(k,279) + rxt(k,661)*y(k,280) + rxt(k,673) & - *y(k,288) + rxt(k,681)*y(k,289) + rxt(k,686)*y(k,148) + rxt(k,700) & - *y(k,299) + rxt(k,716)*y(k,301) + rxt(k,720)*y(k,250) + rxt(k,721) & - *y(k,251) + rxt(k,722)*y(k,256) + rxt(k,723)*y(k,147) + rxt(k,724) & - *y(k,149) + rxt(k,725)*y(k,300) + 4._r8*rxt(k,726)*y(k,302) & - + rxt(k,727)*y(k,305) + rxt(k,735)*y(k,303) + rxt(k,745) & + *y(k,299) + rxt(k,715)*y(k,301) + rxt(k,719)*y(k,250) + rxt(k,720) & + *y(k,251) + rxt(k,721)*y(k,256) + rxt(k,722)*y(k,147) + rxt(k,723) & + *y(k,149) + rxt(k,724)*y(k,300) + 4._r8*rxt(k,725)*y(k,302) & + + rxt(k,726)*y(k,305) + rxt(k,734)*y(k,303) + rxt(k,744) & *y(k,304)) - mat(k,2125) = -rxt(k,593)*y(k,302) - mat(k,2220) = -rxt(k,601)*y(k,302) - mat(k,2059) = -rxt(k,613)*y(k,302) - mat(k,2104) = -rxt(k,621)*y(k,302) - mat(k,2337) = -rxt(k,633)*y(k,302) - mat(k,2249) = -rxt(k,641)*y(k,302) - mat(k,2310) = -rxt(k,653)*y(k,302) - mat(k,2164) = -rxt(k,661)*y(k,302) - mat(k,2371) = -rxt(k,673)*y(k,302) - mat(k,2278) = -rxt(k,681)*y(k,302) - mat(k,3497) = -rxt(k,686)*y(k,302) - mat(k,2449) = -rxt(k,700)*y(k,302) - mat(k,2491) = -rxt(k,716)*y(k,302) - mat(k,2697) = -rxt(k,720)*y(k,302) - mat(k,3417) = -rxt(k,721)*y(k,302) - mat(k,3276) = -rxt(k,722)*y(k,302) - mat(k,2880) = -rxt(k,723)*y(k,302) - mat(k,3073) = -rxt(k,724)*y(k,302) - mat(k,2533) = -rxt(k,725)*y(k,302) - mat(k,2626) = -rxt(k,727)*y(k,302) - mat(k,2079) = -rxt(k,735)*y(k,302) - mat(k,2470) = -rxt(k,745)*y(k,302) - mat(k,967) = .330_r8*rxt(k,663)*y(k,157) - mat(k,3073) = mat(k,3073) + rxt(k,728)*y(k,203) - mat(k,2981) = .330_r8*rxt(k,663)*y(k,125) - mat(k,1647) = rxt(k,728)*y(k,149) + .750_r8*rxt(k,737)*y(k,293) - mat(k,232) = .710_r8*rxt(k,748)*y(k,293) - mat(k,2424) = .170_r8*rxt(k,764)*y(k,293) - mat(k,3737) = .750_r8*rxt(k,737)*y(k,203) + .710_r8*rxt(k,748)*y(k,207) & - + .170_r8*rxt(k,764)*y(k,210) - mat(k,2072) = -(rxt(k,729)*y(k,250) + rxt(k,730)*y(k,251) + rxt(k,731) & - *y(k,256) + rxt(k,732)*y(k,147) + rxt(k,733)*y(k,149) + rxt(k,734) & - *y(k,300) + rxt(k,735)*y(k,302) + rxt(k,736)*y(k,305)) - mat(k,2678) = -rxt(k,729)*y(k,303) - mat(k,3398) = -rxt(k,730)*y(k,303) - mat(k,3257) = -rxt(k,731)*y(k,303) - mat(k,2861) = -rxt(k,732)*y(k,303) - mat(k,3054) = -rxt(k,733)*y(k,303) - mat(k,2514) = -rxt(k,734)*y(k,303) - mat(k,2560) = -rxt(k,735)*y(k,303) - mat(k,2607) = -rxt(k,736)*y(k,303) - mat(k,2861) = mat(k,2861) + .830_r8*rxt(k,713)*y(k,301) - mat(k,3054) = mat(k,3054) + rxt(k,714)*y(k,301) - mat(k,2678) = mat(k,2678) + rxt(k,710)*y(k,301) - mat(k,3398) = mat(k,3398) + rxt(k,711)*y(k,301) - mat(k,3257) = mat(k,3257) + .380_r8*rxt(k,712)*y(k,301) - mat(k,2514) = mat(k,2514) + rxt(k,715)*y(k,301) - mat(k,2484) = .830_r8*rxt(k,713)*y(k,147) + rxt(k,714)*y(k,149) + rxt(k,710) & - *y(k,250) + rxt(k,711)*y(k,251) + .380_r8*rxt(k,712)*y(k,256) & - + rxt(k,715)*y(k,300) + rxt(k,716)*y(k,302) + rxt(k,717) & + mat(k,2301) = -rxt(k,592)*y(k,302) + mat(k,2471) = -rxt(k,600)*y(k,302) + mat(k,2218) = -rxt(k,612)*y(k,302) + mat(k,2329) = -rxt(k,620)*y(k,302) + mat(k,2534) = -rxt(k,632)*y(k,302) + mat(k,2417) = -rxt(k,640)*y(k,302) + mat(k,2505) = -rxt(k,652)*y(k,302) + mat(k,2387) = -rxt(k,660)*y(k,302) + mat(k,2704) = -rxt(k,672)*y(k,302) + mat(k,2807) = -rxt(k,680)*y(k,302) + mat(k,4090) = -rxt(k,685)*y(k,302) + mat(k,2731) = -rxt(k,699)*y(k,302) + mat(k,2776) = -rxt(k,715)*y(k,302) + mat(k,3020) = -rxt(k,719)*y(k,302) + mat(k,4038) = -rxt(k,720)*y(k,302) + mat(k,3561) = -rxt(k,721)*y(k,302) + mat(k,3305) = -rxt(k,722)*y(k,302) + mat(k,3946) = -rxt(k,723)*y(k,302) + mat(k,2946) = -rxt(k,724)*y(k,302) + mat(k,2900) = -rxt(k,726)*y(k,302) + mat(k,2241) = -rxt(k,734)*y(k,302) + mat(k,2753) = -rxt(k,744)*y(k,302) + mat(k,1076) = .330_r8*rxt(k,662)*y(k,157) + mat(k,3946) = mat(k,3946) + rxt(k,727)*y(k,203) + mat(k,3123) = .330_r8*rxt(k,662)*y(k,125) + mat(k,1719) = rxt(k,727)*y(k,149) + .750_r8*rxt(k,736)*y(k,293) + mat(k,368) = .710_r8*rxt(k,747)*y(k,293) + mat(k,2667) = .170_r8*rxt(k,763)*y(k,293) + mat(k,3811) = .750_r8*rxt(k,736)*y(k,203) + .710_r8*rxt(k,747)*y(k,207) & + + .170_r8*rxt(k,763)*y(k,210) + mat(k,2235) = -(rxt(k,728)*y(k,250) + rxt(k,729)*y(k,251) + rxt(k,730) & + *y(k,256) + rxt(k,731)*y(k,147) + rxt(k,732)*y(k,149) + rxt(k,733) & + *y(k,300) + rxt(k,734)*y(k,302) + rxt(k,735)*y(k,305)) + mat(k,2999) = -rxt(k,728)*y(k,303) + mat(k,4016) = -rxt(k,729)*y(k,303) + mat(k,3538) = -rxt(k,730)*y(k,303) + mat(k,3282) = -rxt(k,731)*y(k,303) + mat(k,3923) = -rxt(k,732)*y(k,303) + mat(k,2928) = -rxt(k,733)*y(k,303) + mat(k,2835) = -rxt(k,734)*y(k,303) + mat(k,2882) = -rxt(k,735)*y(k,303) + mat(k,3282) = mat(k,3282) + .830_r8*rxt(k,712)*y(k,301) + mat(k,3923) = mat(k,3923) + rxt(k,713)*y(k,301) + mat(k,2999) = mat(k,2999) + rxt(k,709)*y(k,301) + mat(k,4016) = mat(k,4016) + rxt(k,710)*y(k,301) + mat(k,3538) = mat(k,3538) + .380_r8*rxt(k,711)*y(k,301) + mat(k,2928) = mat(k,2928) + rxt(k,714)*y(k,301) + mat(k,2770) = .830_r8*rxt(k,712)*y(k,147) + rxt(k,713)*y(k,149) + rxt(k,709) & + *y(k,250) + rxt(k,710)*y(k,251) + .380_r8*rxt(k,711)*y(k,256) & + + rxt(k,714)*y(k,300) + rxt(k,715)*y(k,302) + rxt(k,716) & *y(k,305) - mat(k,2560) = mat(k,2560) + rxt(k,716)*y(k,301) - mat(k,2607) = mat(k,2607) + rxt(k,717)*y(k,301) + mat(k,2835) = mat(k,2835) + rxt(k,715)*y(k,301) + mat(k,2882) = mat(k,2882) + rxt(k,716)*y(k,301) end do end subroutine nlnmat16 subroutine nlnmat17( avec_len, mat, y, rxt ) @@ -4436,190 +4751,198 @@ subroutine nlnmat17( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,2467) = -(rxt(k,739)*y(k,250) + rxt(k,740)*y(k,251) + rxt(k,741) & - *y(k,256) + rxt(k,742)*y(k,147) + rxt(k,743)*y(k,149) + rxt(k,744) & - *y(k,300) + rxt(k,746)*y(k,305)) - mat(k,2694) = -rxt(k,739)*y(k,304) - mat(k,3414) = -rxt(k,740)*y(k,304) - mat(k,3273) = -rxt(k,741)*y(k,304) - mat(k,2877) = -rxt(k,742)*y(k,304) - mat(k,3070) = -rxt(k,743)*y(k,304) - mat(k,2530) = -rxt(k,744)*y(k,304) - mat(k,2623) = -rxt(k,746)*y(k,304) - mat(k,2877) = mat(k,2877) + rxt(k,723)*y(k,302) + .700_r8*rxt(k,732)*y(k,303) - mat(k,3070) = mat(k,3070) + rxt(k,724)*y(k,302) + rxt(k,733)*y(k,303) - mat(k,1646) = .250_r8*rxt(k,737)*y(k,293) - mat(k,231) = .290_r8*rxt(k,748)*y(k,293) - mat(k,2122) = rxt(k,593)*y(k,302) - mat(k,2217) = rxt(k,601)*y(k,302) - mat(k,2056) = rxt(k,613)*y(k,302) - mat(k,2101) = rxt(k,621)*y(k,302) - mat(k,2334) = rxt(k,633)*y(k,302) - mat(k,2246) = rxt(k,641)*y(k,302) - mat(k,2694) = mat(k,2694) + rxt(k,720)*y(k,302) + rxt(k,729)*y(k,303) - mat(k,3414) = mat(k,3414) + rxt(k,721)*y(k,302) + rxt(k,730)*y(k,303) - mat(k,3273) = mat(k,3273) + .490_r8*rxt(k,722)*y(k,302) + .150_r8*rxt(k,731) & + mat(k,2751) = -(rxt(k,738)*y(k,250) + rxt(k,739)*y(k,251) + rxt(k,740) & + *y(k,256) + rxt(k,741)*y(k,147) + rxt(k,742)*y(k,149) + rxt(k,743) & + *y(k,300) + rxt(k,745)*y(k,305)) + mat(k,3017) = -rxt(k,738)*y(k,304) + mat(k,4035) = -rxt(k,739)*y(k,304) + mat(k,3558) = -rxt(k,740)*y(k,304) + mat(k,3302) = -rxt(k,741)*y(k,304) + mat(k,3943) = -rxt(k,742)*y(k,304) + mat(k,2943) = -rxt(k,743)*y(k,304) + mat(k,2897) = -rxt(k,745)*y(k,304) + mat(k,3302) = mat(k,3302) + rxt(k,722)*y(k,302) + .700_r8*rxt(k,731)*y(k,303) + mat(k,3943) = mat(k,3943) + rxt(k,723)*y(k,302) + rxt(k,732)*y(k,303) + mat(k,1718) = .250_r8*rxt(k,736)*y(k,293) + mat(k,367) = .290_r8*rxt(k,747)*y(k,293) + mat(k,2299) = rxt(k,592)*y(k,302) + mat(k,2469) = rxt(k,600)*y(k,302) + mat(k,2216) = rxt(k,612)*y(k,302) + mat(k,2327) = rxt(k,620)*y(k,302) + mat(k,2532) = rxt(k,632)*y(k,302) + mat(k,2415) = rxt(k,640)*y(k,302) + mat(k,3017) = mat(k,3017) + rxt(k,719)*y(k,302) + rxt(k,728)*y(k,303) + mat(k,4035) = mat(k,4035) + rxt(k,720)*y(k,302) + rxt(k,729)*y(k,303) + mat(k,3558) = mat(k,3558) + .490_r8*rxt(k,721)*y(k,302) + .150_r8*rxt(k,730) & *y(k,303) - mat(k,2307) = rxt(k,653)*y(k,302) - mat(k,2161) = rxt(k,661)*y(k,302) - mat(k,2368) = rxt(k,673)*y(k,302) - mat(k,2275) = rxt(k,681)*y(k,302) - mat(k,3734) = .250_r8*rxt(k,737)*y(k,203) + .290_r8*rxt(k,748)*y(k,207) - mat(k,2446) = rxt(k,700)*y(k,302) - mat(k,2530) = mat(k,2530) + rxt(k,725)*y(k,302) + rxt(k,734)*y(k,303) - mat(k,2488) = rxt(k,716)*y(k,302) - mat(k,2576) = rxt(k,723)*y(k,147) + rxt(k,724)*y(k,149) + rxt(k,593)*y(k,235) & - + rxt(k,601)*y(k,236) + rxt(k,613)*y(k,238) + rxt(k,621) & - *y(k,239) + rxt(k,633)*y(k,243) + rxt(k,641)*y(k,244) & - + rxt(k,720)*y(k,250) + rxt(k,721)*y(k,251) + .490_r8*rxt(k,722) & - *y(k,256) + rxt(k,653)*y(k,279) + rxt(k,661)*y(k,280) & - + rxt(k,673)*y(k,288) + rxt(k,681)*y(k,289) + rxt(k,700) & - *y(k,299) + rxt(k,725)*y(k,300) + rxt(k,716)*y(k,301) & - + 4.000_r8*rxt(k,726)*y(k,302) + 2.000_r8*rxt(k,735)*y(k,303) & - + rxt(k,727)*y(k,305) - mat(k,2076) = .700_r8*rxt(k,732)*y(k,147) + rxt(k,733)*y(k,149) + rxt(k,729) & - *y(k,250) + rxt(k,730)*y(k,251) + .150_r8*rxt(k,731)*y(k,256) & - + rxt(k,734)*y(k,300) + 2.000_r8*rxt(k,735)*y(k,302) & - + rxt(k,736)*y(k,305) - mat(k,2623) = mat(k,2623) + rxt(k,727)*y(k,302) + rxt(k,736)*y(k,303) - mat(k,2627) = -(rxt(k,594)*y(k,235) + rxt(k,602)*y(k,236) + rxt(k,614) & - *y(k,238) + rxt(k,622)*y(k,239) + rxt(k,634)*y(k,243) + rxt(k,642) & - *y(k,244) + rxt(k,654)*y(k,279) + rxt(k,662)*y(k,280) + rxt(k,674) & - *y(k,288) + rxt(k,682)*y(k,289) + rxt(k,687)*y(k,148) + rxt(k,701) & - *y(k,299) + rxt(k,708)*y(k,300) + rxt(k,717)*y(k,301) + rxt(k,727) & - *y(k,302) + rxt(k,736)*y(k,303) + rxt(k,746)*y(k,304) + rxt(k,750) & - *y(k,250) + rxt(k,751)*y(k,251) + rxt(k,752)*y(k,256) + rxt(k,753) & - *y(k,147) + rxt(k,754)*y(k,149) + 4._r8*rxt(k,755)*y(k,305)) - mat(k,2126) = -rxt(k,594)*y(k,305) - mat(k,2221) = -rxt(k,602)*y(k,305) - mat(k,2060) = -rxt(k,614)*y(k,305) - mat(k,2105) = -rxt(k,622)*y(k,305) - mat(k,2338) = -rxt(k,634)*y(k,305) - mat(k,2250) = -rxt(k,642)*y(k,305) - mat(k,2311) = -rxt(k,654)*y(k,305) - mat(k,2165) = -rxt(k,662)*y(k,305) - mat(k,2372) = -rxt(k,674)*y(k,305) - mat(k,2279) = -rxt(k,682)*y(k,305) - mat(k,3498) = -rxt(k,687)*y(k,305) - mat(k,2450) = -rxt(k,701)*y(k,305) - mat(k,2534) = -rxt(k,708)*y(k,305) - mat(k,2492) = -rxt(k,717)*y(k,305) - mat(k,2580) = -rxt(k,727)*y(k,305) - mat(k,2080) = -rxt(k,736)*y(k,305) - mat(k,2471) = -rxt(k,746)*y(k,305) - mat(k,2698) = -rxt(k,750)*y(k,305) - mat(k,3418) = -rxt(k,751)*y(k,305) - mat(k,3277) = -rxt(k,752)*y(k,305) - mat(k,2881) = -rxt(k,753)*y(k,305) - mat(k,3074) = -rxt(k,754)*y(k,305) - mat(k,3074) = mat(k,3074) + rxt(k,756)*y(k,200) - mat(k,2196) = rxt(k,756)*y(k,149) + .770_r8*rxt(k,757)*y(k,293) - mat(k,524) = .710_r8*rxt(k,749)*y(k,293) - mat(k,3738) = .770_r8*rxt(k,757)*y(k,200) + .710_r8*rxt(k,749)*y(k,205) - mat(k,680) = -(rxt(k,761)*y(k,256) + rxt(k,762)*y(k,147)) - mat(k,3171) = -rxt(k,761)*y(k,306) - mat(k,2780) = -rxt(k,762)*y(k,306) - mat(k,2412) = .830_r8*rxt(k,764)*y(k,293) - mat(k,3617) = .830_r8*rxt(k,764)*y(k,210) - mat(k,843) = -(rxt(k,766)*y(k,256) + rxt(k,767)*y(k,147)) - mat(k,3185) = -rxt(k,766)*y(k,307) - mat(k,2794) = -rxt(k,767)*y(k,307) - mat(k,2384) = rxt(k,769)*y(k,293) - mat(k,3634) = rxt(k,769)*y(k,211) - mat(k,1144) = -(rxt(k,773)*y(k,256) + rxt(k,774)*y(k,147)) - mat(k,3204) = -rxt(k,773)*y(k,308) - mat(k,2811) = -rxt(k,774)*y(k,308) - mat(k,583) = rxt(k,775)*y(k,293) - mat(k,3660) = rxt(k,775)*y(k,216) - mat(k,926) = -(rxt(k,777)*y(k,256) + rxt(k,778)*y(k,147)) - mat(k,3190) = -rxt(k,777)*y(k,309) - mat(k,2799) = -rxt(k,778)*y(k,309) - mat(k,672) = rxt(k,779)*y(k,293) - mat(k,3641) = rxt(k,779)*y(k,218) - mat(k,688) = -(rxt(k,781)*y(k,256) + rxt(k,782)*y(k,147)) - mat(k,3172) = -rxt(k,781)*y(k,310) - mat(k,2781) = -rxt(k,782)*y(k,310) - mat(k,1586) = rxt(k,783)*y(k,293) - mat(k,3618) = rxt(k,783)*y(k,220) - mat(k,696) = -(rxt(k,785)*y(k,256) + rxt(k,786)*y(k,147)) - mat(k,3173) = -rxt(k,785)*y(k,311) - mat(k,2782) = -rxt(k,786)*y(k,311) - mat(k,1598) = rxt(k,787)*y(k,293) - mat(k,3619) = rxt(k,787)*y(k,222) - mat(k,762) = -(rxt(k,572)*y(k,256) + rxt(k,573)*y(k,147)) - mat(k,3178) = -rxt(k,572)*y(k,312) - mat(k,2786) = -rxt(k,573)*y(k,312) - mat(k,615) = rxt(k,574)*y(k,293) - mat(k,165) = .650_r8*rxt(k,575)*y(k,293) - mat(k,3625) = rxt(k,574)*y(k,225) + .650_r8*rxt(k,575)*y(k,226) - mat(k,96) = -(rxt(k,880)*y(k,256) + rxt(k,881)*y(k,147)) - mat(k,3131) = -rxt(k,880)*y(k,313) - mat(k,2756) = -rxt(k,881)*y(k,313) - mat(k,160) = rxt(k,879)*y(k,293) - mat(k,3532) = rxt(k,879)*y(k,226) - mat(k,778) = -(rxt(k,578)*y(k,256) + rxt(k,579)*y(k,147)) - mat(k,3179) = -rxt(k,578)*y(k,314) - mat(k,2787) = -rxt(k,579)*y(k,314) - mat(k,182) = .560_r8*rxt(k,577)*y(k,293) - mat(k,733) = rxt(k,580)*y(k,293) - mat(k,3626) = .560_r8*rxt(k,577)*y(k,227) + rxt(k,580)*y(k,228) - mat(k,102) = -(rxt(k,883)*y(k,256) + rxt(k,884)*y(k,147)) - mat(k,3132) = -rxt(k,883)*y(k,315) - mat(k,2757) = -rxt(k,884)*y(k,315) - mat(k,177) = rxt(k,882)*y(k,293) - mat(k,3533) = rxt(k,882)*y(k,227) - mat(k,443) = -(rxt(k,581)*y(k,256) + rxt(k,582)*y(k,147)) - mat(k,3155) = -rxt(k,581)*y(k,316) - mat(k,2769) = -rxt(k,582)*y(k,316) - mat(k,189) = .300_r8*rxt(k,583)*y(k,293) - mat(k,351) = rxt(k,584)*y(k,293) - mat(k,3589) = .300_r8*rxt(k,583)*y(k,229) + rxt(k,584)*y(k,230) - mat(k,3862) = -(rxt(k,169)*y(k,292) + rxt(k,277)*y(k,75) + rxt(k,810) & + mat(k,2503) = rxt(k,652)*y(k,302) + mat(k,2385) = rxt(k,660)*y(k,302) + mat(k,2702) = rxt(k,672)*y(k,302) + mat(k,2804) = rxt(k,680)*y(k,302) + mat(k,3808) = .250_r8*rxt(k,736)*y(k,203) + .290_r8*rxt(k,747)*y(k,207) + mat(k,2729) = rxt(k,699)*y(k,302) + mat(k,2943) = mat(k,2943) + rxt(k,724)*y(k,302) + rxt(k,733)*y(k,303) + mat(k,2774) = rxt(k,715)*y(k,302) + mat(k,2850) = rxt(k,722)*y(k,147) + rxt(k,723)*y(k,149) + rxt(k,592)*y(k,235) & + + rxt(k,600)*y(k,236) + rxt(k,612)*y(k,238) + rxt(k,620) & + *y(k,239) + rxt(k,632)*y(k,243) + rxt(k,640)*y(k,244) & + + rxt(k,719)*y(k,250) + rxt(k,720)*y(k,251) + .490_r8*rxt(k,721) & + *y(k,256) + rxt(k,652)*y(k,279) + rxt(k,660)*y(k,280) & + + rxt(k,672)*y(k,288) + rxt(k,680)*y(k,289) + rxt(k,699) & + *y(k,299) + rxt(k,724)*y(k,300) + rxt(k,715)*y(k,301) & + + 4.000_r8*rxt(k,725)*y(k,302) + 2.000_r8*rxt(k,734)*y(k,303) & + + rxt(k,726)*y(k,305) + mat(k,2239) = .700_r8*rxt(k,731)*y(k,147) + rxt(k,732)*y(k,149) + rxt(k,728) & + *y(k,250) + rxt(k,729)*y(k,251) + .150_r8*rxt(k,730)*y(k,256) & + + rxt(k,733)*y(k,300) + 2.000_r8*rxt(k,734)*y(k,302) & + + rxt(k,735)*y(k,305) + mat(k,2897) = mat(k,2897) + rxt(k,726)*y(k,302) + rxt(k,735)*y(k,303) + mat(k,2901) = -(rxt(k,593)*y(k,235) + rxt(k,601)*y(k,236) + rxt(k,613) & + *y(k,238) + rxt(k,621)*y(k,239) + rxt(k,633)*y(k,243) + rxt(k,641) & + *y(k,244) + rxt(k,653)*y(k,279) + rxt(k,661)*y(k,280) + rxt(k,673) & + *y(k,288) + rxt(k,681)*y(k,289) + rxt(k,686)*y(k,148) + rxt(k,700) & + *y(k,299) + rxt(k,707)*y(k,300) + rxt(k,716)*y(k,301) + rxt(k,726) & + *y(k,302) + rxt(k,735)*y(k,303) + rxt(k,745)*y(k,304) + rxt(k,749) & + *y(k,250) + rxt(k,750)*y(k,251) + rxt(k,751)*y(k,256) + rxt(k,752) & + *y(k,147) + rxt(k,753)*y(k,149) + 4._r8*rxt(k,754)*y(k,305)) + mat(k,2302) = -rxt(k,593)*y(k,305) + mat(k,2472) = -rxt(k,601)*y(k,305) + mat(k,2219) = -rxt(k,613)*y(k,305) + mat(k,2330) = -rxt(k,621)*y(k,305) + mat(k,2535) = -rxt(k,633)*y(k,305) + mat(k,2418) = -rxt(k,641)*y(k,305) + mat(k,2506) = -rxt(k,653)*y(k,305) + mat(k,2388) = -rxt(k,661)*y(k,305) + mat(k,2705) = -rxt(k,673)*y(k,305) + mat(k,2808) = -rxt(k,681)*y(k,305) + mat(k,4091) = -rxt(k,686)*y(k,305) + mat(k,2732) = -rxt(k,700)*y(k,305) + mat(k,2947) = -rxt(k,707)*y(k,305) + mat(k,2777) = -rxt(k,716)*y(k,305) + mat(k,2854) = -rxt(k,726)*y(k,305) + mat(k,2242) = -rxt(k,735)*y(k,305) + mat(k,2754) = -rxt(k,745)*y(k,305) + mat(k,3021) = -rxt(k,749)*y(k,305) + mat(k,4039) = -rxt(k,750)*y(k,305) + mat(k,3562) = -rxt(k,751)*y(k,305) + mat(k,3306) = -rxt(k,752)*y(k,305) + mat(k,3947) = -rxt(k,753)*y(k,305) + mat(k,3947) = mat(k,3947) + rxt(k,755)*y(k,200) + mat(k,2369) = rxt(k,755)*y(k,149) + .770_r8*rxt(k,756)*y(k,293) + mat(k,771) = .710_r8*rxt(k,748)*y(k,293) + mat(k,3812) = .770_r8*rxt(k,756)*y(k,200) + .710_r8*rxt(k,748)*y(k,205) + mat(k,795) = -(rxt(k,760)*y(k,256) + rxt(k,761)*y(k,147)) + mat(k,3452) = -rxt(k,760)*y(k,306) + mat(k,3201) = -rxt(k,761)*y(k,306) + mat(k,2653) = .830_r8*rxt(k,763)*y(k,293) + mat(k,3686) = .830_r8*rxt(k,763)*y(k,210) + mat(k,953) = -(rxt(k,765)*y(k,256) + rxt(k,766)*y(k,147)) + mat(k,3465) = -rxt(k,765)*y(k,307) + mat(k,3213) = -rxt(k,766)*y(k,307) + mat(k,2341) = rxt(k,768)*y(k,293) + mat(k,3702) = rxt(k,768)*y(k,211) + mat(k,1216) = -(rxt(k,772)*y(k,256) + rxt(k,773)*y(k,147)) + mat(k,3484) = -rxt(k,772)*y(k,308) + mat(k,3230) = -rxt(k,773)*y(k,308) + mat(k,667) = rxt(k,774)*y(k,293) + mat(k,3725) = rxt(k,774)*y(k,216) + mat(k,1013) = -(rxt(k,776)*y(k,256) + rxt(k,777)*y(k,147)) + mat(k,3471) = -rxt(k,776)*y(k,309) + mat(k,3219) = -rxt(k,777)*y(k,309) + mat(k,782) = rxt(k,778)*y(k,293) + mat(k,3708) = rxt(k,778)*y(k,218) + mat(k,803) = -(rxt(k,780)*y(k,256) + rxt(k,781)*y(k,147)) + mat(k,3453) = -rxt(k,780)*y(k,310) + mat(k,3202) = -rxt(k,781)*y(k,310) + mat(k,1683) = rxt(k,782)*y(k,293) + mat(k,3687) = rxt(k,782)*y(k,220) + mat(k,811) = -(rxt(k,784)*y(k,256) + rxt(k,785)*y(k,147)) + mat(k,3454) = -rxt(k,784)*y(k,311) + mat(k,3203) = -rxt(k,785)*y(k,311) + mat(k,1695) = rxt(k,786)*y(k,293) + mat(k,3688) = rxt(k,786)*y(k,222) + mat(k,877) = -(rxt(k,571)*y(k,256) + rxt(k,572)*y(k,147)) + mat(k,3459) = -rxt(k,571)*y(k,312) + mat(k,3207) = -rxt(k,572)*y(k,312) + mat(k,750) = rxt(k,573)*y(k,293) + mat(k,213) = .650_r8*rxt(k,574)*y(k,293) + mat(k,3694) = rxt(k,573)*y(k,225) + .650_r8*rxt(k,574)*y(k,226) + mat(k,105) = -(rxt(k,879)*y(k,256) + rxt(k,880)*y(k,147)) + mat(k,3412) = -rxt(k,879)*y(k,313) + mat(k,3177) = -rxt(k,880)*y(k,313) + mat(k,208) = rxt(k,878)*y(k,293) + mat(k,3593) = rxt(k,878)*y(k,226) + mat(k,893) = -(rxt(k,577)*y(k,256) + rxt(k,578)*y(k,147)) + mat(k,3460) = -rxt(k,577)*y(k,314) + mat(k,3208) = -rxt(k,578)*y(k,314) + mat(k,230) = .560_r8*rxt(k,576)*y(k,293) + mat(k,831) = rxt(k,579)*y(k,293) + mat(k,3695) = .560_r8*rxt(k,576)*y(k,227) + rxt(k,579)*y(k,228) + mat(k,111) = -(rxt(k,882)*y(k,256) + rxt(k,883)*y(k,147)) + mat(k,3413) = -rxt(k,882)*y(k,315) + mat(k,3178) = -rxt(k,883)*y(k,315) + mat(k,225) = rxt(k,881)*y(k,293) + mat(k,3594) = rxt(k,881)*y(k,227) + mat(k,533) = -(rxt(k,580)*y(k,256) + rxt(k,581)*y(k,147)) + mat(k,3436) = -rxt(k,580)*y(k,316) + mat(k,3190) = -rxt(k,581)*y(k,316) + mat(k,237) = .300_r8*rxt(k,582)*y(k,293) + mat(k,427) = rxt(k,583)*y(k,293) + mat(k,3656) = .300_r8*rxt(k,582)*y(k,229) + rxt(k,583)*y(k,230) + mat(k,4132) = -(rxt(k,169)*y(k,292) + rxt(k,277)*y(k,75) + rxt(k,809) & *y(k,175)) - mat(k,3116) = -rxt(k,169)*y(k,317) - mat(k,904) = -rxt(k,277)*y(k,317) - mat(k,217) = -rxt(k,810)*y(k,317) - mat(k,264) = rxt(k,332)*y(k,293) - mat(k,343) = rxt(k,359)*y(k,293) - mat(k,115) = rxt(k,360)*y(k,293) - mat(k,3345) = rxt(k,301)*y(k,293) - mat(k,1313) = rxt(k,334)*y(k,293) - mat(k,2152) = rxt(k,374)*y(k,293) - mat(k,1852) = rxt(k,362)*y(k,293) - mat(k,533) = rxt(k,340)*y(k,293) - mat(k,473) = rxt(k,341)*y(k,293) - mat(k,375) = rxt(k,307)*y(k,293) - mat(k,2741) = rxt(k,180)*y(k,256) - mat(k,1426) = rxt(k,185)*y(k,293) - mat(k,1355) = rxt(k,186)*y(k,293) - mat(k,1046) = rxt(k,268)*y(k,293) - mat(k,3778) = (rxt(k,893)+rxt(k,898))*y(k,95) + (rxt(k,886)+rxt(k,892) & - +rxt(k,897))*y(k,96) + rxt(k,239)*y(k,293) - mat(k,1127) = rxt(k,311)*y(k,293) - mat(k,1123) = rxt(k,312)*y(k,293) - mat(k,2727) = rxt(k,215)*y(k,293) - mat(k,369) = rxt(k,193)*y(k,293) - mat(k,913) = (rxt(k,893)+rxt(k,898))*y(k,87) - mat(k,1070) = (rxt(k,886)+rxt(k,892)+rxt(k,897))*y(k,87) + rxt(k,242) & + mat(k,2652) = -rxt(k,169)*y(k,317) + mat(k,1286) = -rxt(k,277)*y(k,317) + mat(k,279) = -rxt(k,809)*y(k,317) + mat(k,319) = rxt(k,331)*y(k,293) + mat(k,413) = rxt(k,358)*y(k,293) + mat(k,131) = rxt(k,359)*y(k,293) + mat(k,515) = rxt(k,282)*y(k,293) + mat(k,3366) = rxt(k,301)*y(k,293) + mat(k,647) = rxt(k,284)*y(k,293) + mat(k,147) = rxt(k,285)*y(k,293) + mat(k,1437) = rxt(k,333)*y(k,293) + mat(k,397) = rxt(k,287)*y(k,293) + mat(k,2288) = rxt(k,373)*y(k,293) + mat(k,1916) = rxt(k,361)*y(k,293) + mat(k,793) = rxt(k,339)*y(k,293) + mat(k,706) = rxt(k,340)*y(k,293) + mat(k,464) = rxt(k,307)*y(k,293) + mat(k,2271) = rxt(k,308)*y(k,293) + mat(k,2585) = rxt(k,180)*y(k,256) + mat(k,1682) = rxt(k,185)*y(k,293) + mat(k,1491) = rxt(k,186)*y(k,293) + mat(k,1163) = rxt(k,268)*y(k,293) + mat(k,307) = rxt(k,292)*y(k,293) + mat(k,3162) = (rxt(k,892)+rxt(k,897))*y(k,95) + (rxt(k,885)+rxt(k,891) & + +rxt(k,896))*y(k,96) + rxt(k,239)*y(k,293) + mat(k,1361) = rxt(k,310)*y(k,293) + mat(k,1213) = rxt(k,311)*y(k,293) + mat(k,3340) = rxt(k,215)*y(k,293) + mat(k,451) = rxt(k,193)*y(k,293) + mat(k,1000) = (rxt(k,892)+rxt(k,897))*y(k,87) + mat(k,1148) = (rxt(k,885)+rxt(k,891)+rxt(k,896))*y(k,87) + rxt(k,242) & *y(k,293) - mat(k,1764) = .450_r8*rxt(k,387)*y(k,293) - mat(k,105) = rxt(k,811)*y(k,293) - mat(k,489) = rxt(k,368)*y(k,293) - mat(k,337) = rxt(k,372)*y(k,293) - mat(k,895) = rxt(k,776)*y(k,293) - mat(k,1038) = rxt(k,780)*y(k,293) - mat(k,3295) = rxt(k,180)*y(k,78) + .300_r8*rxt(k,313)*y(k,257) + rxt(k,187) & + mat(k,2035) = .450_r8*rxt(k,386)*y(k,293) + mat(k,117) = rxt(k,810)*y(k,293) + mat(k,589) = rxt(k,367)*y(k,293) + mat(k,407) = rxt(k,371)*y(k,293) + mat(k,991) = rxt(k,775)*y(k,293) + mat(k,1155) = rxt(k,779)*y(k,293) + mat(k,3577) = rxt(k,180)*y(k,78) + .300_r8*rxt(k,312)*y(k,257) + rxt(k,187) & *y(k,293) - mat(k,601) = .300_r8*rxt(k,313)*y(k,256) - mat(k,3756) = rxt(k,332)*y(k,29) + rxt(k,359)*y(k,31) + rxt(k,360)*y(k,32) & - + rxt(k,301)*y(k,43) + rxt(k,334)*y(k,46) + rxt(k,374)*y(k,49) & - + rxt(k,362)*y(k,50) + rxt(k,340)*y(k,51) + rxt(k,341)*y(k,52) & - + rxt(k,307)*y(k,54) + rxt(k,185)*y(k,79) + rxt(k,186)*y(k,81) & - + rxt(k,268)*y(k,83) + rxt(k,239)*y(k,87) + rxt(k,311)*y(k,90) & - + rxt(k,312)*y(k,92) + rxt(k,215)*y(k,93) + rxt(k,193)*y(k,94) & - + rxt(k,242)*y(k,96) + .450_r8*rxt(k,387)*y(k,126) + rxt(k,811) & - *y(k,143) + rxt(k,368)*y(k,169) + rxt(k,372)*y(k,170) & - + rxt(k,776)*y(k,215) + rxt(k,780)*y(k,217) + rxt(k,187) & + mat(k,699) = .300_r8*rxt(k,312)*y(k,256) + mat(k,3827) = rxt(k,331)*y(k,29) + rxt(k,358)*y(k,31) + rxt(k,359)*y(k,32) & + + rxt(k,282)*y(k,42) + rxt(k,301)*y(k,43) + rxt(k,284)*y(k,44) & + + rxt(k,285)*y(k,45) + rxt(k,333)*y(k,46) + rxt(k,287)*y(k,47) & + + rxt(k,373)*y(k,49) + rxt(k,361)*y(k,50) + rxt(k,339)*y(k,51) & + + rxt(k,340)*y(k,52) + rxt(k,307)*y(k,54) + rxt(k,308)*y(k,55) & + + rxt(k,185)*y(k,79) + rxt(k,186)*y(k,81) + rxt(k,268)*y(k,83) & + + rxt(k,292)*y(k,86) + rxt(k,239)*y(k,87) + rxt(k,310)*y(k,90) & + + rxt(k,311)*y(k,92) + rxt(k,215)*y(k,93) + rxt(k,193)*y(k,94) & + + rxt(k,242)*y(k,96) + .450_r8*rxt(k,386)*y(k,126) + rxt(k,810) & + *y(k,143) + rxt(k,367)*y(k,169) + rxt(k,371)*y(k,170) & + + rxt(k,775)*y(k,215) + rxt(k,779)*y(k,217) + rxt(k,187) & *y(k,256) + 2.000_r8*rxt(k,190)*y(k,293) end do end subroutine nlnmat17 @@ -4675,1511 +4998,1627 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 32) = lmat(k, 32) mat(k, 33) = lmat(k, 33) mat(k, 34) = lmat(k, 34) - mat(k, 40) = mat(k, 40) + lmat(k, 40) - mat(k, 46) = mat(k, 46) + lmat(k, 46) - mat(k, 52) = mat(k, 52) + lmat(k, 52) - mat(k, 58) = mat(k, 58) + lmat(k, 58) - mat(k, 64) = mat(k, 64) + lmat(k, 64) - mat(k, 70) = mat(k, 70) + lmat(k, 70) - mat(k, 76) = mat(k, 76) + lmat(k, 76) - mat(k, 78) = mat(k, 78) + lmat(k, 78) - mat(k, 84) = mat(k, 84) + lmat(k, 84) - mat(k, 90) = mat(k, 90) + lmat(k, 90) - mat(k, 96) = mat(k, 96) + lmat(k, 96) - mat(k, 102) = mat(k, 102) + lmat(k, 102) - mat(k, 103) = mat(k, 103) + lmat(k, 103) - mat(k, 106) = mat(k, 106) + lmat(k, 106) - mat(k, 109) = lmat(k, 109) - mat(k, 110) = lmat(k, 110) - mat(k, 111) = lmat(k, 111) - mat(k, 112) = mat(k, 112) + lmat(k, 112) - mat(k, 116) = lmat(k, 116) - mat(k, 117) = lmat(k, 117) - mat(k, 118) = lmat(k, 118) - mat(k, 119) = lmat(k, 119) - mat(k, 120) = lmat(k, 120) - mat(k, 121) = lmat(k, 121) - mat(k, 122) = mat(k, 122) + lmat(k, 122) - mat(k, 123) = mat(k, 123) + lmat(k, 123) - 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, 131) = mat(k, 131) + lmat(k, 131) - mat(k, 137) = lmat(k, 137) - mat(k, 138) = lmat(k, 138) - mat(k, 139) = lmat(k, 139) - mat(k, 140) = lmat(k, 140) + 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) = lmat(k, 39) + mat(k, 40) = lmat(k, 40) + mat(k, 41) = lmat(k, 41) + mat(k, 42) = lmat(k, 42) + mat(k, 43) = lmat(k, 43) + mat(k, 49) = mat(k, 49) + lmat(k, 49) + mat(k, 55) = mat(k, 55) + lmat(k, 55) + mat(k, 61) = mat(k, 61) + lmat(k, 61) + mat(k, 67) = mat(k, 67) + lmat(k, 67) + mat(k, 73) = mat(k, 73) + lmat(k, 73) + mat(k, 79) = mat(k, 79) + lmat(k, 79) + mat(k, 85) = mat(k, 85) + lmat(k, 85) + mat(k, 87) = mat(k, 87) + lmat(k, 87) + mat(k, 93) = mat(k, 93) + lmat(k, 93) + mat(k, 99) = mat(k, 99) + lmat(k, 99) + mat(k, 105) = mat(k, 105) + lmat(k, 105) + mat(k, 111) = mat(k, 111) + lmat(k, 111) + mat(k, 112) = lmat(k, 112) + mat(k, 113) = lmat(k, 113) + mat(k, 114) = lmat(k, 114) + mat(k, 115) = mat(k, 115) + lmat(k, 115) + mat(k, 118) = mat(k, 118) + lmat(k, 118) + mat(k, 120) = mat(k, 120) + lmat(k, 120) + mat(k, 121) = mat(k, 121) + lmat(k, 121) + mat(k, 124) = mat(k, 124) + lmat(k, 124) + mat(k, 125) = mat(k, 125) + lmat(k, 125) + mat(k, 126) = mat(k, 126) + lmat(k, 126) + mat(k, 128) = mat(k, 128) + lmat(k, 128) + mat(k, 132) = mat(k, 132) + lmat(k, 132) + mat(k, 133) = mat(k, 133) + lmat(k, 133) + mat(k, 135) = mat(k, 135) + lmat(k, 135) + mat(k, 136) = mat(k, 136) + lmat(k, 136) + mat(k, 137) = mat(k, 137) + lmat(k, 137) + mat(k, 139) = mat(k, 139) + lmat(k, 139) + mat(k, 140) = mat(k, 140) + lmat(k, 140) mat(k, 141) = mat(k, 141) + lmat(k, 141) + mat(k, 143) = mat(k, 143) + lmat(k, 143) + mat(k, 144) = mat(k, 144) + lmat(k, 144) mat(k, 146) = mat(k, 146) + lmat(k, 146) + mat(k, 148) = lmat(k, 148) + mat(k, 149) = lmat(k, 149) mat(k, 150) = lmat(k, 150) mat(k, 151) = lmat(k, 151) mat(k, 152) = lmat(k, 152) - mat(k, 153) = mat(k, 153) + lmat(k, 153) - mat(k, 156) = mat(k, 156) + lmat(k, 156) + mat(k, 153) = lmat(k, 153) + mat(k, 154) = lmat(k, 154) + mat(k, 155) = lmat(k, 155) + mat(k, 156) = lmat(k, 156) mat(k, 157) = mat(k, 157) + lmat(k, 157) + mat(k, 158) = mat(k, 158) + lmat(k, 158) mat(k, 159) = mat(k, 159) + lmat(k, 159) mat(k, 161) = mat(k, 161) + lmat(k, 161) + mat(k, 162) = mat(k, 162) + lmat(k, 162) + mat(k, 163) = mat(k, 163) + lmat(k, 163) + mat(k, 164) = mat(k, 164) + lmat(k, 164) + mat(k, 165) = mat(k, 165) + lmat(k, 165) + mat(k, 167) = mat(k, 167) + lmat(k, 167) mat(k, 168) = mat(k, 168) + lmat(k, 168) - mat(k, 173) = lmat(k, 173) - mat(k, 174) = lmat(k, 174) - mat(k, 175) = lmat(k, 175) - mat(k, 176) = lmat(k, 176) - mat(k, 179) = mat(k, 179) + lmat(k, 179) - mat(k, 187) = mat(k, 187) + lmat(k, 187) - mat(k, 192) = lmat(k, 192) - mat(k, 193) = lmat(k, 193) - mat(k, 194) = lmat(k, 194) - mat(k, 195) = lmat(k, 195) - mat(k, 196) = lmat(k, 196) - mat(k, 197) = lmat(k, 197) - mat(k, 198) = mat(k, 198) + lmat(k, 198) - mat(k, 201) = lmat(k, 201) - mat(k, 202) = lmat(k, 202) - mat(k, 203) = lmat(k, 203) - mat(k, 204) = lmat(k, 204) + mat(k, 169) = mat(k, 169) + lmat(k, 169) + mat(k, 171) = mat(k, 171) + lmat(k, 171) + mat(k, 172) = mat(k, 172) + lmat(k, 172) + mat(k, 173) = mat(k, 173) + lmat(k, 173) + mat(k, 174) = mat(k, 174) + lmat(k, 174) + mat(k, 176) = mat(k, 176) + lmat(k, 176) + mat(k, 177) = lmat(k, 177) + mat(k, 178) = lmat(k, 178) + mat(k, 180) = mat(k, 180) + lmat(k, 180) + mat(k, 186) = lmat(k, 186) + mat(k, 187) = lmat(k, 187) + mat(k, 188) = lmat(k, 188) + mat(k, 189) = lmat(k, 189) + mat(k, 190) = mat(k, 190) + lmat(k, 190) + mat(k, 195) = mat(k, 195) + lmat(k, 195) + mat(k, 199) = mat(k, 199) + lmat(k, 199) + mat(k, 200) = mat(k, 200) + lmat(k, 200) + mat(k, 202) = mat(k, 202) + lmat(k, 202) mat(k, 205) = lmat(k, 205) mat(k, 206) = lmat(k, 206) mat(k, 207) = lmat(k, 207) - mat(k, 208) = lmat(k, 208) - mat(k, 209) = lmat(k, 209) - mat(k, 210) = lmat(k, 210) - mat(k, 211) = lmat(k, 211) - mat(k, 212) = lmat(k, 212) - mat(k, 214) = mat(k, 214) + lmat(k, 214) - mat(k, 215) = lmat(k, 215) - mat(k, 216) = lmat(k, 216) - mat(k, 218) = mat(k, 218) + lmat(k, 218) - mat(k, 222) = mat(k, 222) + lmat(k, 222) + mat(k, 209) = mat(k, 209) + lmat(k, 209) + mat(k, 216) = mat(k, 216) + lmat(k, 216) + mat(k, 221) = lmat(k, 221) + mat(k, 222) = lmat(k, 222) mat(k, 223) = lmat(k, 223) - mat(k, 225) = mat(k, 225) + lmat(k, 225) - mat(k, 226) = mat(k, 226) + lmat(k, 226) + mat(k, 224) = lmat(k, 224) mat(k, 227) = mat(k, 227) + lmat(k, 227) - mat(k, 229) = mat(k, 229) + lmat(k, 229) - mat(k, 230) = mat(k, 230) + lmat(k, 230) - mat(k, 231) = mat(k, 231) + lmat(k, 231) - mat(k, 233) = mat(k, 233) + lmat(k, 233) - mat(k, 234) = lmat(k, 234) - mat(k, 235) = lmat(k, 235) - mat(k, 236) = lmat(k, 236) - mat(k, 237) = lmat(k, 237) - mat(k, 238) = mat(k, 238) + lmat(k, 238) - mat(k, 244) = lmat(k, 244) - mat(k, 245) = lmat(k, 245) - mat(k, 246) = lmat(k, 246) - mat(k, 247) = lmat(k, 247) - mat(k, 248) = lmat(k, 248) - mat(k, 249) = lmat(k, 249) - mat(k, 250) = lmat(k, 250) - mat(k, 251) = lmat(k, 251) - mat(k, 252) = lmat(k, 252) - mat(k, 253) = mat(k, 253) + lmat(k, 253) + mat(k, 235) = mat(k, 235) + lmat(k, 235) + mat(k, 240) = lmat(k, 240) + mat(k, 241) = lmat(k, 241) + mat(k, 242) = lmat(k, 242) + mat(k, 243) = mat(k, 243) + lmat(k, 243) + mat(k, 246) = mat(k, 246) + lmat(k, 246) + mat(k, 247) = mat(k, 247) + lmat(k, 247) + mat(k, 250) = mat(k, 250) + lmat(k, 250) + mat(k, 251) = mat(k, 251) + lmat(k, 251) + mat(k, 252) = mat(k, 252) + lmat(k, 252) + mat(k, 254) = mat(k, 254) + lmat(k, 254) + mat(k, 255) = mat(k, 255) + lmat(k, 255) + mat(k, 256) = mat(k, 256) + lmat(k, 256) mat(k, 259) = mat(k, 259) + lmat(k, 259) - mat(k, 265) = mat(k, 265) + lmat(k, 265) + mat(k, 260) = mat(k, 260) + lmat(k, 260) + mat(k, 261) = mat(k, 261) + lmat(k, 261) + mat(k, 263) = lmat(k, 263) + mat(k, 264) = lmat(k, 264) + mat(k, 265) = lmat(k, 265) + mat(k, 266) = lmat(k, 266) mat(k, 267) = lmat(k, 267) mat(k, 268) = lmat(k, 268) - mat(k, 269) = mat(k, 269) + lmat(k, 269) + mat(k, 269) = lmat(k, 269) mat(k, 270) = lmat(k, 270) mat(k, 271) = lmat(k, 271) mat(k, 272) = lmat(k, 272) mat(k, 273) = lmat(k, 273) mat(k, 274) = lmat(k, 274) - mat(k, 275) = mat(k, 275) + lmat(k, 275) - mat(k, 278) = mat(k, 278) + lmat(k, 278) - mat(k, 279) = lmat(k, 279) + mat(k, 276) = mat(k, 276) + lmat(k, 276) + mat(k, 277) = lmat(k, 277) + mat(k, 278) = lmat(k, 278) mat(k, 280) = mat(k, 280) + lmat(k, 280) - mat(k, 282) = lmat(k, 282) - mat(k, 283) = lmat(k, 283) mat(k, 284) = mat(k, 284) + lmat(k, 284) mat(k, 285) = lmat(k, 285) - mat(k, 286) = mat(k, 286) + lmat(k, 286) + mat(k, 287) = mat(k, 287) + lmat(k, 287) + mat(k, 288) = lmat(k, 288) mat(k, 289) = lmat(k, 289) - mat(k, 290) = mat(k, 290) + lmat(k, 290) - mat(k, 291) = mat(k, 291) + lmat(k, 291) - mat(k, 293) = mat(k, 293) + lmat(k, 293) + mat(k, 290) = lmat(k, 290) + mat(k, 291) = lmat(k, 291) + mat(k, 292) = lmat(k, 292) + mat(k, 293) = lmat(k, 293) mat(k, 294) = lmat(k, 294) - mat(k, 295) = mat(k, 295) + lmat(k, 295) - mat(k, 296) = mat(k, 296) + lmat(k, 296) - mat(k, 297) = mat(k, 297) + lmat(k, 297) + mat(k, 295) = lmat(k, 295) + mat(k, 296) = lmat(k, 296) + mat(k, 297) = lmat(k, 297) mat(k, 298) = lmat(k, 298) mat(k, 299) = lmat(k, 299) - mat(k, 300) = mat(k, 300) + lmat(k, 300) - mat(k, 301) = lmat(k, 301) - mat(k, 304) = mat(k, 304) + lmat(k, 304) + mat(k, 300) = lmat(k, 300) + mat(k, 301) = mat(k, 301) + lmat(k, 301) + mat(k, 302) = mat(k, 302) + lmat(k, 302) + mat(k, 306) = mat(k, 306) + lmat(k, 306) mat(k, 308) = mat(k, 308) + lmat(k, 308) - mat(k, 316) = mat(k, 316) + lmat(k, 316) - mat(k, 318) = mat(k, 318) + lmat(k, 318) - mat(k, 319) = mat(k, 319) + lmat(k, 319) - mat(k, 322) = mat(k, 322) + lmat(k, 322) - mat(k, 323) = lmat(k, 323) - mat(k, 325) = lmat(k, 325) + mat(k, 314) = mat(k, 314) + lmat(k, 314) + mat(k, 320) = mat(k, 320) + lmat(k, 320) mat(k, 326) = lmat(k, 326) - mat(k, 327) = mat(k, 327) + lmat(k, 327) + mat(k, 327) = lmat(k, 327) mat(k, 328) = lmat(k, 328) - mat(k, 329) = lmat(k, 329) - mat(k, 330) = lmat(k, 330) + mat(k, 329) = mat(k, 329) + lmat(k, 329) mat(k, 331) = lmat(k, 331) - mat(k, 332) = mat(k, 332) + lmat(k, 332) + mat(k, 332) = lmat(k, 332) + mat(k, 333) = mat(k, 333) + lmat(k, 333) mat(k, 334) = lmat(k, 334) mat(k, 335) = lmat(k, 335) - mat(k, 336) = mat(k, 336) + lmat(k, 336) - mat(k, 338) = mat(k, 338) + lmat(k, 338) - mat(k, 340) = lmat(k, 340) - mat(k, 341) = lmat(k, 341) + mat(k, 336) = lmat(k, 336) + mat(k, 337) = lmat(k, 337) + mat(k, 338) = lmat(k, 338) + mat(k, 339) = mat(k, 339) + lmat(k, 339) mat(k, 342) = mat(k, 342) + lmat(k, 342) + mat(k, 343) = lmat(k, 343) mat(k, 344) = mat(k, 344) + lmat(k, 344) + mat(k, 346) = lmat(k, 346) mat(k, 347) = lmat(k, 347) mat(k, 348) = mat(k, 348) + lmat(k, 348) + mat(k, 349) = lmat(k, 349) mat(k, 350) = mat(k, 350) + lmat(k, 350) - mat(k, 352) = lmat(k, 352) mat(k, 353) = lmat(k, 353) - mat(k, 354) = lmat(k, 354) + mat(k, 354) = mat(k, 354) + lmat(k, 354) mat(k, 355) = mat(k, 355) + lmat(k, 355) - mat(k, 358) = mat(k, 358) + lmat(k, 358) + mat(k, 357) = mat(k, 357) + lmat(k, 357) + mat(k, 358) = lmat(k, 358) + mat(k, 359) = mat(k, 359) + lmat(k, 359) + mat(k, 360) = mat(k, 360) + lmat(k, 360) + mat(k, 361) = mat(k, 361) + lmat(k, 361) + mat(k, 362) = mat(k, 362) + lmat(k, 362) mat(k, 364) = mat(k, 364) + lmat(k, 364) - mat(k, 365) = lmat(k, 365) - mat(k, 366) = lmat(k, 366) + mat(k, 365) = mat(k, 365) + lmat(k, 365) + mat(k, 366) = mat(k, 366) + lmat(k, 366) mat(k, 367) = mat(k, 367) + lmat(k, 367) - mat(k, 368) = mat(k, 368) + lmat(k, 368) + mat(k, 369) = mat(k, 369) + lmat(k, 369) mat(k, 370) = mat(k, 370) + lmat(k, 370) - mat(k, 371) = lmat(k, 371) - mat(k, 372) = mat(k, 372) + lmat(k, 372) + mat(k, 371) = mat(k, 371) + lmat(k, 371) + mat(k, 372) = lmat(k, 372) + mat(k, 373) = lmat(k, 373) mat(k, 374) = mat(k, 374) + lmat(k, 374) - mat(k, 377) = mat(k, 377) + lmat(k, 377) + mat(k, 382) = mat(k, 382) + lmat(k, 382) mat(k, 383) = lmat(k, 383) - mat(k, 384) = lmat(k, 384) - mat(k, 385) = lmat(k, 385) mat(k, 386) = mat(k, 386) + lmat(k, 386) - mat(k, 388) = lmat(k, 388) - mat(k, 389) = lmat(k, 389) mat(k, 390) = mat(k, 390) + lmat(k, 390) - mat(k, 391) = mat(k, 391) + lmat(k, 391) - mat(k, 392) = lmat(k, 392) + mat(k, 395) = mat(k, 395) + lmat(k, 395) mat(k, 396) = lmat(k, 396) - mat(k, 398) = mat(k, 398) + lmat(k, 398) + mat(k, 398) = lmat(k, 398) mat(k, 399) = lmat(k, 399) - mat(k, 400) = mat(k, 400) + lmat(k, 400) - mat(k, 402) = lmat(k, 402) - mat(k, 403) = lmat(k, 403) - mat(k, 405) = mat(k, 405) + lmat(k, 405) - mat(k, 409) = mat(k, 409) + lmat(k, 409) + mat(k, 400) = lmat(k, 400) + mat(k, 401) = lmat(k, 401) + mat(k, 402) = mat(k, 402) + lmat(k, 402) + mat(k, 404) = lmat(k, 404) + mat(k, 405) = lmat(k, 405) + mat(k, 406) = mat(k, 406) + lmat(k, 406) + mat(k, 408) = mat(k, 408) + lmat(k, 408) + mat(k, 410) = lmat(k, 410) mat(k, 411) = lmat(k, 411) - mat(k, 414) = lmat(k, 414) + mat(k, 412) = mat(k, 412) + lmat(k, 412) + mat(k, 414) = mat(k, 414) + lmat(k, 414) mat(k, 415) = lmat(k, 415) - mat(k, 417) = mat(k, 417) + lmat(k, 417) + mat(k, 417) = lmat(k, 417) + mat(k, 418) = lmat(k, 418) mat(k, 419) = mat(k, 419) + lmat(k, 419) - mat(k, 422) = mat(k, 422) + lmat(k, 422) - mat(k, 423) = mat(k, 423) + lmat(k, 423) - mat(k, 424) = lmat(k, 424) - mat(k, 425) = lmat(k, 425) + mat(k, 420) = mat(k, 420) + lmat(k, 420) + mat(k, 423) = lmat(k, 423) + mat(k, 425) = mat(k, 425) + lmat(k, 425) mat(k, 426) = mat(k, 426) + lmat(k, 426) - mat(k, 429) = mat(k, 429) + lmat(k, 429) - mat(k, 430) = mat(k, 430) + lmat(k, 430) - mat(k, 431) = lmat(k, 431) - mat(k, 432) = lmat(k, 432) - mat(k, 435) = mat(k, 435) + lmat(k, 435) - mat(k, 443) = mat(k, 443) + lmat(k, 443) + mat(k, 428) = lmat(k, 428) + mat(k, 429) = lmat(k, 429) + mat(k, 430) = lmat(k, 430) + mat(k, 431) = mat(k, 431) + lmat(k, 431) + mat(k, 432) = mat(k, 432) + lmat(k, 432) + mat(k, 433) = mat(k, 433) + lmat(k, 433) + mat(k, 440) = mat(k, 440) + lmat(k, 440) + mat(k, 446) = mat(k, 446) + lmat(k, 446) + mat(k, 447) = lmat(k, 447) + mat(k, 448) = mat(k, 448) + lmat(k, 448) + mat(k, 449) = lmat(k, 449) mat(k, 450) = mat(k, 450) + lmat(k, 450) - mat(k, 452) = lmat(k, 452) - mat(k, 453) = lmat(k, 453) - mat(k, 455) = mat(k, 455) + lmat(k, 455) - mat(k, 456) = mat(k, 456) + lmat(k, 456) - mat(k, 459) = lmat(k, 459) + mat(k, 453) = mat(k, 453) + lmat(k, 453) + 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, 462) = mat(k, 462) + lmat(k, 462) + mat(k, 465) = lmat(k, 465) + mat(k, 466) = lmat(k, 466) + mat(k, 467) = lmat(k, 467) mat(k, 468) = mat(k, 468) + lmat(k, 468) + mat(k, 470) = lmat(k, 470) mat(k, 471) = lmat(k, 471) mat(k, 472) = mat(k, 472) + lmat(k, 472) mat(k, 474) = mat(k, 474) + lmat(k, 474) - mat(k, 477) = lmat(k, 477) - mat(k, 478) = lmat(k, 478) - mat(k, 479) = lmat(k, 479) - mat(k, 480) = mat(k, 480) + lmat(k, 480) - mat(k, 482) = mat(k, 482) + lmat(k, 482) - mat(k, 484) = lmat(k, 484) + mat(k, 477) = mat(k, 477) + lmat(k, 477) + mat(k, 478) = mat(k, 478) + lmat(k, 478) + mat(k, 481) = mat(k, 481) + lmat(k, 481) + mat(k, 484) = mat(k, 484) + lmat(k, 484) + mat(k, 485) = mat(k, 485) + lmat(k, 485) mat(k, 486) = lmat(k, 486) mat(k, 487) = lmat(k, 487) mat(k, 488) = mat(k, 488) + lmat(k, 488) - mat(k, 490) = mat(k, 490) + lmat(k, 490) - mat(k, 491) = lmat(k, 491) - mat(k, 492) = lmat(k, 492) + mat(k, 489) = lmat(k, 489) mat(k, 493) = lmat(k, 493) - mat(k, 494) = mat(k, 494) + lmat(k, 494) - mat(k, 496) = lmat(k, 496) + mat(k, 495) = lmat(k, 495) mat(k, 497) = mat(k, 497) + lmat(k, 497) mat(k, 498) = mat(k, 498) + lmat(k, 498) - mat(k, 506) = mat(k, 506) + lmat(k, 506) - mat(k, 509) = lmat(k, 509) - mat(k, 512) = mat(k, 512) + lmat(k, 512) - mat(k, 514) = mat(k, 514) + lmat(k, 514) - mat(k, 516) = lmat(k, 516) - mat(k, 520) = mat(k, 520) + lmat(k, 520) - mat(k, 522) = mat(k, 522) + lmat(k, 522) - mat(k, 523) = mat(k, 523) + lmat(k, 523) + mat(k, 501) = mat(k, 501) + lmat(k, 501) + mat(k, 502) = mat(k, 502) + lmat(k, 502) + mat(k, 503) = lmat(k, 503) + mat(k, 504) = lmat(k, 504) + mat(k, 505) = mat(k, 505) + lmat(k, 505) + mat(k, 509) = mat(k, 509) + lmat(k, 509) + mat(k, 510) = mat(k, 510) + lmat(k, 510) + mat(k, 516) = mat(k, 516) + lmat(k, 516) + mat(k, 517) = lmat(k, 517) + mat(k, 522) = lmat(k, 522) mat(k, 525) = mat(k, 525) + lmat(k, 525) - mat(k, 526) = mat(k, 526) + lmat(k, 526) - mat(k, 527) = mat(k, 527) + lmat(k, 527) - mat(k, 528) = lmat(k, 528) - mat(k, 529) = lmat(k, 529) - mat(k, 530) = mat(k, 530) + lmat(k, 530) - mat(k, 534) = mat(k, 534) + lmat(k, 534) - mat(k, 542) = mat(k, 542) + lmat(k, 542) + mat(k, 533) = mat(k, 533) + lmat(k, 533) + mat(k, 540) = mat(k, 540) + lmat(k, 540) + mat(k, 541) = mat(k, 541) + lmat(k, 541) mat(k, 544) = lmat(k, 544) - mat(k, 546) = lmat(k, 546) mat(k, 547) = mat(k, 547) + lmat(k, 547) - mat(k, 548) = mat(k, 548) + lmat(k, 548) - mat(k, 550) = mat(k, 550) + lmat(k, 550) - mat(k, 551) = mat(k, 551) + lmat(k, 551) - mat(k, 552) = mat(k, 552) + lmat(k, 552) mat(k, 553) = mat(k, 553) + lmat(k, 553) - mat(k, 554) = mat(k, 554) + lmat(k, 554) - mat(k, 558) = lmat(k, 558) - mat(k, 559) = mat(k, 559) + lmat(k, 559) - mat(k, 561) = mat(k, 561) + lmat(k, 561) - mat(k, 562) = mat(k, 562) + lmat(k, 562) - mat(k, 563) = mat(k, 563) + lmat(k, 563) - mat(k, 564) = mat(k, 564) + lmat(k, 564) + mat(k, 555) = lmat(k, 555) + mat(k, 556) = lmat(k, 556) + mat(k, 558) = mat(k, 558) + lmat(k, 558) + mat(k, 561) = lmat(k, 561) + mat(k, 562) = lmat(k, 562) + mat(k, 563) = lmat(k, 563) mat(k, 565) = mat(k, 565) + lmat(k, 565) mat(k, 566) = mat(k, 566) + lmat(k, 566) - mat(k, 567) = mat(k, 567) + lmat(k, 567) - mat(k, 568) = mat(k, 568) + lmat(k, 568) - mat(k, 569) = lmat(k, 569) - mat(k, 570) = lmat(k, 570) - mat(k, 571) = lmat(k, 571) + mat(k, 567) = lmat(k, 567) + mat(k, 568) = lmat(k, 568) + mat(k, 571) = mat(k, 571) + lmat(k, 571) mat(k, 572) = lmat(k, 572) - mat(k, 573) = mat(k, 573) + lmat(k, 573) + mat(k, 573) = lmat(k, 573) + mat(k, 574) = mat(k, 574) + lmat(k, 574) + mat(k, 575) = lmat(k, 575) mat(k, 576) = lmat(k, 576) - mat(k, 577) = lmat(k, 577) + mat(k, 577) = mat(k, 577) + lmat(k, 577) mat(k, 578) = lmat(k, 578) - mat(k, 579) = lmat(k, 579) mat(k, 580) = mat(k, 580) + lmat(k, 580) + mat(k, 581) = lmat(k, 581) mat(k, 582) = mat(k, 582) + lmat(k, 582) mat(k, 584) = lmat(k, 584) - mat(k, 585) = lmat(k, 585) mat(k, 586) = lmat(k, 586) mat(k, 587) = lmat(k, 587) mat(k, 588) = mat(k, 588) + lmat(k, 588) - mat(k, 589) = mat(k, 589) + lmat(k, 589) mat(k, 590) = mat(k, 590) + lmat(k, 590) - mat(k, 591) = lmat(k, 591) - mat(k, 592) = lmat(k, 592) - mat(k, 593) = mat(k, 593) + lmat(k, 593) - mat(k, 597) = mat(k, 597) + lmat(k, 597) - mat(k, 598) = lmat(k, 598) - mat(k, 604) = mat(k, 604) + lmat(k, 604) - mat(k, 610) = lmat(k, 610) - mat(k, 611) = lmat(k, 611) - mat(k, 612) = lmat(k, 612) - mat(k, 613) = mat(k, 613) + lmat(k, 613) - mat(k, 618) = lmat(k, 618) - mat(k, 620) = lmat(k, 620) - mat(k, 621) = lmat(k, 621) - mat(k, 622) = mat(k, 622) + lmat(k, 622) - mat(k, 623) = mat(k, 623) + lmat(k, 623) - mat(k, 626) = lmat(k, 626) - mat(k, 627) = lmat(k, 627) + mat(k, 598) = mat(k, 598) + lmat(k, 598) + mat(k, 599) = mat(k, 599) + lmat(k, 599) + mat(k, 600) = lmat(k, 600) + mat(k, 601) = lmat(k, 601) + mat(k, 602) = mat(k, 602) + lmat(k, 602) + mat(k, 610) = mat(k, 610) + lmat(k, 610) + mat(k, 613) = lmat(k, 613) + mat(k, 614) = lmat(k, 614) + mat(k, 615) = lmat(k, 615) + mat(k, 616) = lmat(k, 616) + mat(k, 618) = mat(k, 618) + lmat(k, 618) + mat(k, 619) = mat(k, 619) + lmat(k, 619) + mat(k, 622) = lmat(k, 622) + mat(k, 623) = lmat(k, 623) + mat(k, 624) = mat(k, 624) + lmat(k, 624) + mat(k, 625) = mat(k, 625) + lmat(k, 625) + mat(k, 626) = mat(k, 626) + lmat(k, 626) + mat(k, 628) = mat(k, 628) + lmat(k, 628) mat(k, 629) = mat(k, 629) + lmat(k, 629) - mat(k, 630) = lmat(k, 630) - mat(k, 631) = lmat(k, 631) - mat(k, 633) = lmat(k, 633) - mat(k, 634) = mat(k, 634) + lmat(k, 634) - mat(k, 637) = mat(k, 637) + lmat(k, 637) - mat(k, 638) = mat(k, 638) + lmat(k, 638) - mat(k, 640) = lmat(k, 640) - mat(k, 641) = mat(k, 641) + lmat(k, 641) - mat(k, 642) = mat(k, 642) + lmat(k, 642) - mat(k, 644) = lmat(k, 644) - mat(k, 645) = mat(k, 645) + lmat(k, 645) - mat(k, 649) = lmat(k, 649) - mat(k, 650) = lmat(k, 650) + mat(k, 630) = mat(k, 630) + lmat(k, 630) + mat(k, 631) = mat(k, 631) + lmat(k, 631) + mat(k, 632) = mat(k, 632) + lmat(k, 632) + mat(k, 633) = mat(k, 633) + lmat(k, 633) + mat(k, 634) = lmat(k, 634) + mat(k, 635) = mat(k, 635) + lmat(k, 635) + mat(k, 636) = lmat(k, 636) + mat(k, 637) = lmat(k, 637) + mat(k, 638) = lmat(k, 638) + mat(k, 639) = mat(k, 639) + lmat(k, 639) + mat(k, 640) = mat(k, 640) + lmat(k, 640) + mat(k, 646) = lmat(k, 646) + mat(k, 648) = mat(k, 648) + lmat(k, 648) mat(k, 652) = lmat(k, 652) - mat(k, 653) = lmat(k, 653) - mat(k, 654) = mat(k, 654) + lmat(k, 654) mat(k, 656) = mat(k, 656) + lmat(k, 656) - mat(k, 663) = mat(k, 663) + lmat(k, 663) - mat(k, 664) = lmat(k, 664) - mat(k, 665) = lmat(k, 665) - mat(k, 667) = mat(k, 667) + lmat(k, 667) - mat(k, 668) = mat(k, 668) + lmat(k, 668) + mat(k, 657) = mat(k, 657) + lmat(k, 657) + mat(k, 660) = lmat(k, 660) + mat(k, 665) = mat(k, 665) + lmat(k, 665) + mat(k, 666) = mat(k, 666) + lmat(k, 666) + mat(k, 668) = lmat(k, 668) mat(k, 669) = lmat(k, 669) mat(k, 670) = lmat(k, 670) mat(k, 671) = mat(k, 671) + lmat(k, 671) - mat(k, 673) = lmat(k, 673) - mat(k, 674) = lmat(k, 674) + mat(k, 672) = lmat(k, 672) + mat(k, 673) = mat(k, 673) + lmat(k, 673) + mat(k, 674) = mat(k, 674) + lmat(k, 674) mat(k, 675) = lmat(k, 675) mat(k, 676) = lmat(k, 676) - mat(k, 677) = lmat(k, 677) mat(k, 678) = mat(k, 678) + lmat(k, 678) - mat(k, 680) = mat(k, 680) + lmat(k, 680) + mat(k, 681) = lmat(k, 681) + mat(k, 682) = mat(k, 682) + lmat(k, 682) + mat(k, 683) = mat(k, 683) + lmat(k, 683) + mat(k, 684) = mat(k, 684) + lmat(k, 684) + mat(k, 686) = mat(k, 686) + lmat(k, 686) mat(k, 688) = mat(k, 688) + lmat(k, 688) + mat(k, 689) = mat(k, 689) + lmat(k, 689) + mat(k, 690) = mat(k, 690) + lmat(k, 690) + mat(k, 691) = mat(k, 691) + lmat(k, 691) + mat(k, 695) = lmat(k, 695) mat(k, 696) = mat(k, 696) + lmat(k, 696) - mat(k, 710) = mat(k, 710) + lmat(k, 710) - mat(k, 721) = mat(k, 721) + lmat(k, 721) - mat(k, 723) = mat(k, 723) + lmat(k, 723) - mat(k, 724) = mat(k, 724) + lmat(k, 724) + mat(k, 700) = mat(k, 700) + lmat(k, 700) + mat(k, 701) = mat(k, 701) + lmat(k, 701) + mat(k, 704) = mat(k, 704) + lmat(k, 704) + mat(k, 705) = lmat(k, 705) + mat(k, 709) = mat(k, 709) + lmat(k, 709) + mat(k, 715) = lmat(k, 715) + mat(k, 716) = mat(k, 716) + lmat(k, 716) + mat(k, 719) = mat(k, 719) + lmat(k, 719) + mat(k, 720) = mat(k, 720) + lmat(k, 720) + mat(k, 722) = mat(k, 722) + lmat(k, 722) + mat(k, 723) = lmat(k, 723) mat(k, 725) = mat(k, 725) + lmat(k, 725) - mat(k, 726) = mat(k, 726) + lmat(k, 726) - mat(k, 727) = lmat(k, 727) - mat(k, 728) = lmat(k, 728) - mat(k, 729) = lmat(k, 729) - mat(k, 730) = lmat(k, 730) - mat(k, 731) = mat(k, 731) + lmat(k, 731) - mat(k, 736) = lmat(k, 736) - mat(k, 738) = lmat(k, 738) - mat(k, 740) = lmat(k, 740) - mat(k, 741) = mat(k, 741) + lmat(k, 741) - mat(k, 744) = mat(k, 744) + lmat(k, 744) - mat(k, 751) = mat(k, 751) + lmat(k, 751) - mat(k, 762) = mat(k, 762) + lmat(k, 762) - mat(k, 778) = mat(k, 778) + lmat(k, 778) + mat(k, 726) = lmat(k, 726) + mat(k, 727) = mat(k, 727) + lmat(k, 727) + mat(k, 731) = lmat(k, 731) + mat(k, 732) = lmat(k, 732) + mat(k, 734) = lmat(k, 734) + mat(k, 735) = lmat(k, 735) + mat(k, 736) = mat(k, 736) + lmat(k, 736) + mat(k, 738) = mat(k, 738) + lmat(k, 738) + mat(k, 745) = lmat(k, 745) + mat(k, 746) = lmat(k, 746) + mat(k, 747) = lmat(k, 747) + mat(k, 748) = mat(k, 748) + lmat(k, 748) + mat(k, 753) = lmat(k, 753) + mat(k, 754) = lmat(k, 754) + mat(k, 756) = lmat(k, 756) + mat(k, 757) = mat(k, 757) + lmat(k, 757) + mat(k, 758) = mat(k, 758) + lmat(k, 758) + mat(k, 761) = lmat(k, 761) + mat(k, 762) = lmat(k, 762) + mat(k, 764) = lmat(k, 764) + mat(k, 765) = mat(k, 765) + lmat(k, 765) + mat(k, 767) = lmat(k, 767) + mat(k, 768) = mat(k, 768) + lmat(k, 768) + mat(k, 769) = mat(k, 769) + lmat(k, 769) + mat(k, 770) = mat(k, 770) + lmat(k, 770) + mat(k, 772) = mat(k, 772) + lmat(k, 772) + mat(k, 773) = mat(k, 773) + lmat(k, 773) + mat(k, 774) = lmat(k, 774) + mat(k, 775) = lmat(k, 775) + mat(k, 776) = mat(k, 776) + lmat(k, 776) + mat(k, 777) = mat(k, 777) + lmat(k, 777) + mat(k, 779) = lmat(k, 779) + mat(k, 780) = lmat(k, 780) + mat(k, 781) = mat(k, 781) + lmat(k, 781) + mat(k, 783) = lmat(k, 783) + mat(k, 784) = lmat(k, 784) + mat(k, 785) = lmat(k, 785) + mat(k, 786) = lmat(k, 786) + mat(k, 787) = mat(k, 787) + lmat(k, 787) + mat(k, 788) = lmat(k, 788) mat(k, 789) = mat(k, 789) + lmat(k, 789) - mat(k, 797) = mat(k, 797) + lmat(k, 797) - mat(k, 802) = mat(k, 802) + lmat(k, 802) - mat(k, 807) = mat(k, 807) + lmat(k, 807) - mat(k, 809) = mat(k, 809) + lmat(k, 809) - mat(k, 810) = mat(k, 810) + lmat(k, 810) + mat(k, 795) = mat(k, 795) + lmat(k, 795) + mat(k, 803) = mat(k, 803) + lmat(k, 803) mat(k, 811) = mat(k, 811) + lmat(k, 811) - mat(k, 812) = mat(k, 812) + lmat(k, 812) + mat(k, 819) = mat(k, 819) + lmat(k, 819) + mat(k, 821) = mat(k, 821) + lmat(k, 821) mat(k, 822) = mat(k, 822) + lmat(k, 822) - mat(k, 834) = mat(k, 834) + lmat(k, 834) - mat(k, 843) = mat(k, 843) + lmat(k, 843) + mat(k, 823) = mat(k, 823) + lmat(k, 823) + mat(k, 824) = mat(k, 824) + lmat(k, 824) + mat(k, 825) = lmat(k, 825) + mat(k, 826) = lmat(k, 826) + mat(k, 827) = lmat(k, 827) + mat(k, 828) = lmat(k, 828) + mat(k, 829) = mat(k, 829) + lmat(k, 829) + mat(k, 834) = lmat(k, 834) + mat(k, 835) = lmat(k, 835) + mat(k, 838) = lmat(k, 838) + mat(k, 839) = mat(k, 839) + lmat(k, 839) + mat(k, 846) = mat(k, 846) + lmat(k, 846) mat(k, 859) = mat(k, 859) + lmat(k, 859) - mat(k, 871) = mat(k, 871) + lmat(k, 871) - mat(k, 872) = mat(k, 872) + lmat(k, 872) - mat(k, 873) = lmat(k, 873) - mat(k, 874) = lmat(k, 874) - mat(k, 876) = mat(k, 876) + lmat(k, 876) - mat(k, 877) = lmat(k, 877) - mat(k, 878) = lmat(k, 878) - mat(k, 879) = lmat(k, 879) - mat(k, 880) = lmat(k, 880) - mat(k, 881) = lmat(k, 881) - mat(k, 882) = lmat(k, 882) - mat(k, 883) = lmat(k, 883) - mat(k, 884) = mat(k, 884) + lmat(k, 884) - mat(k, 885) = lmat(k, 885) - mat(k, 886) = lmat(k, 886) - mat(k, 888) = mat(k, 888) + lmat(k, 888) - mat(k, 889) = lmat(k, 889) - mat(k, 890) = lmat(k, 890) - mat(k, 892) = lmat(k, 892) - mat(k, 893) = lmat(k, 893) - mat(k, 894) = mat(k, 894) + lmat(k, 894) - mat(k, 896) = mat(k, 896) + lmat(k, 896) - mat(k, 897) = mat(k, 897) + lmat(k, 897) - mat(k, 902) = lmat(k, 902) - mat(k, 906) = mat(k, 906) + lmat(k, 906) - mat(k, 907) = lmat(k, 907) - mat(k, 909) = mat(k, 909) + lmat(k, 909) + mat(k, 866) = mat(k, 866) + lmat(k, 866) + mat(k, 877) = mat(k, 877) + lmat(k, 877) + mat(k, 893) = mat(k, 893) + lmat(k, 893) + mat(k, 904) = mat(k, 904) + lmat(k, 904) + mat(k, 912) = mat(k, 912) + lmat(k, 912) mat(k, 917) = mat(k, 917) + lmat(k, 917) - mat(k, 926) = mat(k, 926) + lmat(k, 926) - mat(k, 941) = mat(k, 941) + lmat(k, 941) - mat(k, 961) = mat(k, 961) + lmat(k, 961) - mat(k, 975) = mat(k, 975) + lmat(k, 975) - mat(k, 985) = mat(k, 985) + lmat(k, 985) + mat(k, 922) = mat(k, 922) + lmat(k, 922) + mat(k, 932) = mat(k, 932) + lmat(k, 932) + mat(k, 944) = mat(k, 944) + lmat(k, 944) + mat(k, 953) = mat(k, 953) + lmat(k, 953) + mat(k, 962) = mat(k, 962) + lmat(k, 962) + mat(k, 964) = mat(k, 964) + lmat(k, 964) + mat(k, 965) = mat(k, 965) + lmat(k, 965) + mat(k, 966) = mat(k, 966) + lmat(k, 966) + mat(k, 967) = mat(k, 967) + lmat(k, 967) + mat(k, 968) = mat(k, 968) + lmat(k, 968) + mat(k, 969) = lmat(k, 969) + mat(k, 970) = lmat(k, 970) + mat(k, 972) = mat(k, 972) + lmat(k, 972) + mat(k, 973) = lmat(k, 973) + mat(k, 974) = lmat(k, 974) + mat(k, 975) = lmat(k, 975) + mat(k, 976) = lmat(k, 976) + mat(k, 977) = lmat(k, 977) + mat(k, 978) = lmat(k, 978) + mat(k, 979) = lmat(k, 979) + mat(k, 980) = lmat(k, 980) + mat(k, 981) = mat(k, 981) + lmat(k, 981) + mat(k, 983) = lmat(k, 983) + mat(k, 984) = mat(k, 984) + lmat(k, 984) + mat(k, 985) = lmat(k, 985) + mat(k, 986) = lmat(k, 986) mat(k, 988) = lmat(k, 988) - mat(k, 991) = mat(k, 991) + lmat(k, 991) - mat(k, 995) = mat(k, 995) + lmat(k, 995) - mat(k, 999) = mat(k, 999) + lmat(k, 999) - mat(k,1000) = mat(k,1000) + lmat(k,1000) - mat(k,1006) = mat(k,1006) + lmat(k,1006) - mat(k,1010) = mat(k,1010) + lmat(k,1010) - mat(k,1012) = mat(k,1012) + lmat(k,1012) - mat(k,1017) = mat(k,1017) + lmat(k,1017) - mat(k,1021) = mat(k,1021) + lmat(k,1021) - mat(k,1022) = lmat(k,1022) - mat(k,1023) = lmat(k,1023) - mat(k,1025) = lmat(k,1025) - mat(k,1028) = lmat(k,1028) - mat(k,1029) = lmat(k,1029) - mat(k,1030) = mat(k,1030) + lmat(k,1030) - mat(k,1032) = mat(k,1032) + lmat(k,1032) - mat(k,1034) = lmat(k,1034) - mat(k,1035) = lmat(k,1035) - mat(k,1036) = lmat(k,1036) - mat(k,1037) = lmat(k,1037) - mat(k,1039) = mat(k,1039) + lmat(k,1039) - mat(k,1040) = mat(k,1040) + lmat(k,1040) - mat(k,1041) = mat(k,1041) + lmat(k,1041) - mat(k,1048) = mat(k,1048) + lmat(k,1048) - mat(k,1053) = lmat(k,1053) + mat(k, 989) = mat(k, 989) + lmat(k, 989) + mat(k, 990) = lmat(k, 990) + mat(k, 993) = mat(k, 993) + lmat(k, 993) + mat(k, 994) = lmat(k, 994) + mat(k, 998) = mat(k, 998) + lmat(k, 998) + mat(k,1004) = mat(k,1004) + lmat(k,1004) + mat(k,1013) = mat(k,1013) + lmat(k,1013) + mat(k,1028) = mat(k,1028) + lmat(k,1028) + mat(k,1042) = mat(k,1042) + lmat(k,1042) + mat(k,1052) = mat(k,1052) + lmat(k,1052) mat(k,1055) = lmat(k,1055) - mat(k,1060) = lmat(k,1060) - mat(k,1061) = lmat(k,1061) - mat(k,1062) = mat(k,1062) + lmat(k,1062) - mat(k,1064) = mat(k,1064) + lmat(k,1064) - mat(k,1067) = mat(k,1067) + lmat(k,1067) + mat(k,1059) = mat(k,1059) + lmat(k,1059) mat(k,1069) = mat(k,1069) + lmat(k,1069) - mat(k,1071) = mat(k,1071) + lmat(k,1071) - mat(k,1077) = lmat(k,1077) - mat(k,1079) = mat(k,1079) + lmat(k,1079) - mat(k,1083) = mat(k,1083) + lmat(k,1083) - mat(k,1084) = lmat(k,1084) - mat(k,1090) = lmat(k,1090) - mat(k,1091) = mat(k,1091) + lmat(k,1091) - mat(k,1093) = mat(k,1093) + lmat(k,1093) - mat(k,1102) = mat(k,1102) + lmat(k,1102) + mat(k,1090) = mat(k,1090) + lmat(k,1090) + mat(k,1104) = mat(k,1104) + lmat(k,1104) + mat(k,1108) = mat(k,1108) + lmat(k,1108) + mat(k,1109) = lmat(k,1109) + mat(k,1110) = lmat(k,1110) + mat(k,1112) = lmat(k,1112) + mat(k,1113) = lmat(k,1113) + mat(k,1116) = lmat(k,1116) mat(k,1118) = mat(k,1118) + lmat(k,1118) - mat(k,1121) = mat(k,1121) + lmat(k,1121) - mat(k,1122) = mat(k,1122) + lmat(k,1122) - mat(k,1124) = mat(k,1124) + lmat(k,1124) + mat(k,1119) = mat(k,1119) + lmat(k,1119) + mat(k,1120) = mat(k,1120) + lmat(k,1120) + mat(k,1127) = mat(k,1127) + lmat(k,1127) + mat(k,1130) = mat(k,1130) + lmat(k,1130) mat(k,1132) = mat(k,1132) + lmat(k,1132) - mat(k,1144) = mat(k,1144) + lmat(k,1144) - mat(k,1154) = mat(k,1154) + lmat(k,1154) - mat(k,1155) = mat(k,1155) + lmat(k,1155) - mat(k,1156) = lmat(k,1156) - mat(k,1157) = lmat(k,1157) - mat(k,1158) = mat(k,1158) + lmat(k,1158) - mat(k,1161) = mat(k,1161) + lmat(k,1161) - mat(k,1162) = lmat(k,1162) - mat(k,1164) = lmat(k,1164) - mat(k,1167) = mat(k,1167) + lmat(k,1167) - mat(k,1168) = lmat(k,1168) - mat(k,1169) = lmat(k,1169) - mat(k,1173) = lmat(k,1173) - mat(k,1175) = lmat(k,1175) - mat(k,1176) = mat(k,1176) + lmat(k,1176) - mat(k,1177) = mat(k,1177) + lmat(k,1177) + mat(k,1138) = mat(k,1138) + lmat(k,1138) + mat(k,1142) = mat(k,1142) + lmat(k,1142) + mat(k,1146) = mat(k,1146) + lmat(k,1146) + mat(k,1147) = mat(k,1147) + lmat(k,1147) + mat(k,1149) = mat(k,1149) + lmat(k,1149) + mat(k,1151) = lmat(k,1151) + mat(k,1152) = lmat(k,1152) + mat(k,1153) = lmat(k,1153) + mat(k,1154) = lmat(k,1154) + mat(k,1156) = mat(k,1156) + lmat(k,1156) + mat(k,1157) = mat(k,1157) + lmat(k,1157) + mat(k,1159) = mat(k,1159) + lmat(k,1159) + mat(k,1164) = mat(k,1164) + lmat(k,1164) + mat(k,1170) = lmat(k,1170) + mat(k,1173) = mat(k,1173) + lmat(k,1173) mat(k,1178) = mat(k,1178) + lmat(k,1178) - mat(k,1180) = mat(k,1180) + lmat(k,1180) - mat(k,1182) = mat(k,1182) + lmat(k,1182) - mat(k,1193) = mat(k,1193) + lmat(k,1193) - mat(k,1197) = mat(k,1197) + lmat(k,1197) + mat(k,1185) = lmat(k,1185) + mat(k,1186) = lmat(k,1186) + mat(k,1190) = lmat(k,1190) + mat(k,1192) = mat(k,1192) + lmat(k,1192) + mat(k,1193) = lmat(k,1193) + mat(k,1198) = mat(k,1198) + lmat(k,1198) + mat(k,1208) = mat(k,1208) + lmat(k,1208) + mat(k,1210) = mat(k,1210) + lmat(k,1210) mat(k,1212) = mat(k,1212) + lmat(k,1212) - mat(k,1213) = mat(k,1213) + lmat(k,1213) - mat(k,1214) = mat(k,1214) + lmat(k,1214) - mat(k,1215) = mat(k,1215) + lmat(k,1215) mat(k,1216) = mat(k,1216) + lmat(k,1216) - mat(k,1218) = lmat(k,1218) - mat(k,1221) = mat(k,1221) + lmat(k,1221) - mat(k,1224) = mat(k,1224) + lmat(k,1224) - mat(k,1236) = mat(k,1236) + lmat(k,1236) - mat(k,1243) = mat(k,1243) + lmat(k,1243) - mat(k,1255) = mat(k,1255) + lmat(k,1255) - mat(k,1257) = mat(k,1257) + lmat(k,1257) - mat(k,1269) = mat(k,1269) + lmat(k,1269) - mat(k,1270) = mat(k,1270) + lmat(k,1270) - mat(k,1271) = lmat(k,1271) + mat(k,1226) = mat(k,1226) + lmat(k,1226) + mat(k,1227) = mat(k,1227) + lmat(k,1227) + mat(k,1228) = lmat(k,1228) + mat(k,1229) = lmat(k,1229) + mat(k,1231) = mat(k,1231) + lmat(k,1231) + mat(k,1233) = mat(k,1233) + lmat(k,1233) + mat(k,1234) = lmat(k,1234) + mat(k,1235) = lmat(k,1235) + mat(k,1246) = mat(k,1246) + lmat(k,1246) + mat(k,1263) = lmat(k,1263) + mat(k,1264) = mat(k,1264) + lmat(k,1264) mat(k,1272) = lmat(k,1272) - mat(k,1273) = mat(k,1273) + lmat(k,1273) mat(k,1274) = mat(k,1274) + lmat(k,1274) - mat(k,1285) = mat(k,1285) + lmat(k,1285) - mat(k,1305) = mat(k,1305) + lmat(k,1305) - mat(k,1306) = lmat(k,1306) - mat(k,1310) = lmat(k,1310) - mat(k,1311) = lmat(k,1311) - mat(k,1315) = mat(k,1315) + lmat(k,1315) + mat(k,1276) = mat(k,1276) + lmat(k,1276) + mat(k,1278) = mat(k,1278) + lmat(k,1278) + mat(k,1287) = mat(k,1287) + lmat(k,1287) + mat(k,1288) = lmat(k,1288) + mat(k,1289) = lmat(k,1289) + mat(k,1292) = lmat(k,1292) + mat(k,1296) = mat(k,1296) + lmat(k,1296) + mat(k,1307) = mat(k,1307) + lmat(k,1307) + mat(k,1309) = mat(k,1309) + lmat(k,1309) + mat(k,1319) = mat(k,1319) + lmat(k,1319) + mat(k,1322) = mat(k,1322) + lmat(k,1322) + mat(k,1323) = mat(k,1323) + lmat(k,1323) + mat(k,1324) = mat(k,1324) + lmat(k,1324) + mat(k,1326) = mat(k,1326) + lmat(k,1326) mat(k,1329) = mat(k,1329) + lmat(k,1329) mat(k,1330) = mat(k,1330) + lmat(k,1330) - mat(k,1331) = mat(k,1331) + lmat(k,1331) - mat(k,1332) = lmat(k,1332) - mat(k,1333) = lmat(k,1333) - mat(k,1334) = lmat(k,1334) - mat(k,1335) = lmat(k,1335) - mat(k,1336) = mat(k,1336) + lmat(k,1336) - mat(k,1337) = lmat(k,1337) - mat(k,1338) = lmat(k,1338) - mat(k,1341) = lmat(k,1341) - mat(k,1342) = mat(k,1342) + lmat(k,1342) - mat(k,1343) = mat(k,1343) + lmat(k,1343) - mat(k,1345) = lmat(k,1345) - mat(k,1346) = lmat(k,1346) - mat(k,1347) = mat(k,1347) + lmat(k,1347) - mat(k,1349) = mat(k,1349) + lmat(k,1349) - mat(k,1352) = mat(k,1352) + lmat(k,1352) - mat(k,1356) = mat(k,1356) + lmat(k,1356) - mat(k,1360) = mat(k,1360) + lmat(k,1360) - mat(k,1361) = lmat(k,1361) - mat(k,1363) = mat(k,1363) + lmat(k,1363) - mat(k,1364) = mat(k,1364) + lmat(k,1364) + mat(k,1331) = lmat(k,1331) + mat(k,1334) = mat(k,1334) + lmat(k,1334) + mat(k,1348) = mat(k,1348) + lmat(k,1348) + mat(k,1357) = mat(k,1357) + lmat(k,1357) mat(k,1365) = mat(k,1365) + lmat(k,1365) - mat(k,1366) = lmat(k,1366) - mat(k,1367) = mat(k,1367) + lmat(k,1367) - mat(k,1370) = mat(k,1370) + lmat(k,1370) - mat(k,1383) = mat(k,1383) + lmat(k,1383) - mat(k,1384) = mat(k,1384) + lmat(k,1384) - mat(k,1385) = mat(k,1385) + lmat(k,1385) - mat(k,1395) = mat(k,1395) + lmat(k,1395) - mat(k,1396) = mat(k,1396) + lmat(k,1396) - mat(k,1397) = mat(k,1397) + lmat(k,1397) - mat(k,1398) = lmat(k,1398) - mat(k,1399) = lmat(k,1399) - mat(k,1400) = mat(k,1400) + lmat(k,1400) - mat(k,1404) = mat(k,1404) + lmat(k,1404) - mat(k,1416) = mat(k,1416) + lmat(k,1416) - mat(k,1439) = mat(k,1439) + lmat(k,1439) - mat(k,1449) = mat(k,1449) + lmat(k,1449) - mat(k,1452) = lmat(k,1452) - mat(k,1455) = lmat(k,1455) + mat(k,1390) = mat(k,1390) + lmat(k,1390) + mat(k,1413) = mat(k,1413) + lmat(k,1413) + mat(k,1415) = mat(k,1415) + lmat(k,1415) + mat(k,1427) = mat(k,1427) + lmat(k,1427) + mat(k,1429) = mat(k,1429) + lmat(k,1429) + mat(k,1430) = lmat(k,1430) + mat(k,1433) = lmat(k,1433) + mat(k,1436) = lmat(k,1436) + mat(k,1438) = mat(k,1438) + lmat(k,1438) + mat(k,1452) = mat(k,1452) + lmat(k,1452) + mat(k,1454) = lmat(k,1454) + mat(k,1455) = mat(k,1455) + lmat(k,1455) + mat(k,1456) = lmat(k,1456) + mat(k,1458) = mat(k,1458) + lmat(k,1458) mat(k,1459) = mat(k,1459) + lmat(k,1459) - mat(k,1463) = mat(k,1463) + lmat(k,1463) - mat(k,1464) = mat(k,1464) + lmat(k,1464) + mat(k,1460) = mat(k,1460) + lmat(k,1460) + mat(k,1461) = lmat(k,1461) + mat(k,1462) = mat(k,1462) + lmat(k,1462) + mat(k,1463) = lmat(k,1463) + mat(k,1464) = lmat(k,1464) mat(k,1465) = lmat(k,1465) mat(k,1466) = mat(k,1466) + lmat(k,1466) - mat(k,1469) = mat(k,1469) + lmat(k,1469) - mat(k,1470) = lmat(k,1470) + mat(k,1467) = lmat(k,1467) + mat(k,1468) = lmat(k,1468) mat(k,1471) = mat(k,1471) + lmat(k,1471) - mat(k,1472) = mat(k,1472) + lmat(k,1472) - mat(k,1480) = mat(k,1480) + lmat(k,1480) - mat(k,1481) = mat(k,1481) + lmat(k,1481) - mat(k,1483) = mat(k,1483) + lmat(k,1483) + mat(k,1472) = lmat(k,1472) + mat(k,1473) = lmat(k,1473) + mat(k,1474) = mat(k,1474) + lmat(k,1474) + mat(k,1476) = mat(k,1476) + lmat(k,1476) + mat(k,1477) = mat(k,1477) + lmat(k,1477) + mat(k,1479) = mat(k,1479) + lmat(k,1479) + mat(k,1481) = lmat(k,1481) + mat(k,1482) = lmat(k,1482) + mat(k,1484) = mat(k,1484) + lmat(k,1484) mat(k,1485) = mat(k,1485) + lmat(k,1485) - mat(k,1493) = mat(k,1493) + lmat(k,1493) - mat(k,1497) = mat(k,1497) + lmat(k,1497) - mat(k,1511) = lmat(k,1511) - mat(k,1512) = mat(k,1512) + lmat(k,1512) - mat(k,1513) = mat(k,1513) + lmat(k,1513) - mat(k,1520) = lmat(k,1520) - mat(k,1528) = lmat(k,1528) - mat(k,1529) = mat(k,1529) + lmat(k,1529) - mat(k,1531) = lmat(k,1531) - mat(k,1535) = lmat(k,1535) - mat(k,1538) = lmat(k,1538) - mat(k,1540) = mat(k,1540) + lmat(k,1540) - mat(k,1544) = lmat(k,1544) - mat(k,1550) = mat(k,1550) + lmat(k,1550) - mat(k,1565) = lmat(k,1565) - mat(k,1571) = mat(k,1571) + lmat(k,1571) - mat(k,1590) = mat(k,1590) + lmat(k,1590) - mat(k,1592) = lmat(k,1592) - mat(k,1595) = lmat(k,1595) + mat(k,1489) = mat(k,1489) + lmat(k,1489) + mat(k,1492) = mat(k,1492) + lmat(k,1492) + mat(k,1496) = mat(k,1496) + lmat(k,1496) + mat(k,1497) = lmat(k,1497) + mat(k,1498) = mat(k,1498) + lmat(k,1498) + mat(k,1500) = mat(k,1500) + lmat(k,1500) + mat(k,1501) = lmat(k,1501) + mat(k,1502) = mat(k,1502) + lmat(k,1502) + mat(k,1503) = mat(k,1503) + lmat(k,1503) + mat(k,1506) = mat(k,1506) + lmat(k,1506) + mat(k,1522) = mat(k,1522) + lmat(k,1522) + mat(k,1534) = mat(k,1534) + lmat(k,1534) + mat(k,1535) = mat(k,1535) + lmat(k,1535) + mat(k,1536) = lmat(k,1536) + mat(k,1537) = lmat(k,1537) + mat(k,1539) = mat(k,1539) + lmat(k,1539) + mat(k,1541) = mat(k,1541) + lmat(k,1541) + mat(k,1544) = mat(k,1544) + lmat(k,1544) + mat(k,1546) = mat(k,1546) + lmat(k,1546) + mat(k,1552) = mat(k,1552) + lmat(k,1552) + mat(k,1555) = mat(k,1555) + lmat(k,1555) + mat(k,1556) = mat(k,1556) + lmat(k,1556) + mat(k,1557) = lmat(k,1557) + mat(k,1559) = mat(k,1559) + lmat(k,1559) + mat(k,1570) = mat(k,1570) + lmat(k,1570) + mat(k,1581) = mat(k,1581) + lmat(k,1581) + mat(k,1587) = lmat(k,1587) + mat(k,1590) = lmat(k,1590) + mat(k,1591) = mat(k,1591) + lmat(k,1591) mat(k,1596) = lmat(k,1596) - mat(k,1603) = mat(k,1603) + lmat(k,1603) + mat(k,1597) = mat(k,1597) + lmat(k,1597) + mat(k,1598) = mat(k,1598) + lmat(k,1598) mat(k,1605) = lmat(k,1605) - mat(k,1606) = lmat(k,1606) - mat(k,1608) = lmat(k,1608) - mat(k,1609) = lmat(k,1609) - mat(k,1611) = mat(k,1611) + lmat(k,1611) + mat(k,1611) = lmat(k,1611) + mat(k,1612) = lmat(k,1612) mat(k,1613) = lmat(k,1613) - mat(k,1614) = mat(k,1614) + lmat(k,1614) - mat(k,1615) = lmat(k,1615) - mat(k,1617) = mat(k,1617) + lmat(k,1617) mat(k,1618) = mat(k,1618) + lmat(k,1618) - mat(k,1619) = mat(k,1619) + lmat(k,1619) - mat(k,1620) = mat(k,1620) + lmat(k,1620) - mat(k,1621) = lmat(k,1621) - mat(k,1624) = mat(k,1624) + lmat(k,1624) - mat(k,1625) = lmat(k,1625) - mat(k,1626) = mat(k,1626) + lmat(k,1626) - mat(k,1628) = lmat(k,1628) - mat(k,1631) = lmat(k,1631) - mat(k,1633) = lmat(k,1633) - mat(k,1635) = mat(k,1635) + lmat(k,1635) - mat(k,1637) = lmat(k,1637) - mat(k,1642) = mat(k,1642) + lmat(k,1642) - mat(k,1643) = mat(k,1643) + lmat(k,1643) - mat(k,1644) = lmat(k,1644) + mat(k,1638) = mat(k,1638) + lmat(k,1638) + mat(k,1640) = mat(k,1640) + lmat(k,1640) + mat(k,1644) = mat(k,1644) + lmat(k,1644) mat(k,1645) = mat(k,1645) + lmat(k,1645) - mat(k,1646) = mat(k,1646) + lmat(k,1646) - mat(k,1651) = lmat(k,1651) - mat(k,1653) = lmat(k,1653) - mat(k,1654) = lmat(k,1654) - mat(k,1655) = lmat(k,1655) - mat(k,1656) = lmat(k,1656) - mat(k,1664) = mat(k,1664) + lmat(k,1664) - mat(k,1667) = mat(k,1667) + lmat(k,1667) - mat(k,1678) = mat(k,1678) + lmat(k,1678) - mat(k,1682) = mat(k,1682) + lmat(k,1682) - mat(k,1685) = mat(k,1685) + lmat(k,1685) - mat(k,1696) = lmat(k,1696) - mat(k,1697) = mat(k,1697) + lmat(k,1697) - mat(k,1698) = mat(k,1698) + lmat(k,1698) + mat(k,1652) = mat(k,1652) + lmat(k,1652) + mat(k,1657) = mat(k,1657) + lmat(k,1657) + mat(k,1658) = lmat(k,1658) + mat(k,1660) = lmat(k,1660) + mat(k,1664) = lmat(k,1664) + mat(k,1668) = lmat(k,1668) + mat(k,1671) = mat(k,1671) + lmat(k,1671) + mat(k,1687) = mat(k,1687) + lmat(k,1687) + mat(k,1689) = lmat(k,1689) + mat(k,1692) = lmat(k,1692) + mat(k,1694) = lmat(k,1694) mat(k,1700) = mat(k,1700) + lmat(k,1700) - mat(k,1702) = mat(k,1702) + lmat(k,1702) - mat(k,1703) = lmat(k,1703) - mat(k,1706) = mat(k,1706) + lmat(k,1706) - mat(k,1709) = mat(k,1709) + lmat(k,1709) - mat(k,1710) = lmat(k,1710) + mat(k,1702) = lmat(k,1702) + mat(k,1704) = lmat(k,1704) + mat(k,1705) = lmat(k,1705) + mat(k,1707) = lmat(k,1707) + mat(k,1710) = mat(k,1710) + lmat(k,1710) mat(k,1711) = lmat(k,1711) - mat(k,1729) = mat(k,1729) + lmat(k,1729) - mat(k,1730) = mat(k,1730) + lmat(k,1730) - mat(k,1741) = mat(k,1741) + lmat(k,1741) - mat(k,1744) = mat(k,1744) + lmat(k,1744) - mat(k,1747) = mat(k,1747) + lmat(k,1747) - mat(k,1748) = mat(k,1748) + lmat(k,1748) - mat(k,1751) = mat(k,1751) + lmat(k,1751) - mat(k,1754) = mat(k,1754) + lmat(k,1754) - mat(k,1759) = mat(k,1759) + lmat(k,1759) + mat(k,1712) = mat(k,1712) + lmat(k,1712) + mat(k,1714) = mat(k,1714) + lmat(k,1714) + mat(k,1716) = mat(k,1716) + lmat(k,1716) + mat(k,1717) = lmat(k,1717) + mat(k,1718) = mat(k,1718) + lmat(k,1718) + mat(k,1721) = lmat(k,1721) + mat(k,1724) = mat(k,1724) + lmat(k,1724) + mat(k,1725) = mat(k,1725) + lmat(k,1725) + mat(k,1726) = mat(k,1726) + lmat(k,1726) + mat(k,1727) = lmat(k,1727) + mat(k,1728) = mat(k,1728) + lmat(k,1728) + mat(k,1730) = lmat(k,1730) + mat(k,1731) = mat(k,1731) + lmat(k,1731) + mat(k,1733) = mat(k,1733) + lmat(k,1733) + mat(k,1734) = lmat(k,1734) + mat(k,1740) = mat(k,1740) + lmat(k,1740) + mat(k,1756) = mat(k,1756) + lmat(k,1756) + mat(k,1758) = lmat(k,1758) + mat(k,1759) = lmat(k,1759) mat(k,1760) = mat(k,1760) + lmat(k,1760) - mat(k,1761) = lmat(k,1761) - mat(k,1765) = lmat(k,1765) - mat(k,1766) = lmat(k,1766) - mat(k,1767) = lmat(k,1767) - mat(k,1768) = lmat(k,1768) - mat(k,1777) = mat(k,1777) + lmat(k,1777) - mat(k,1780) = mat(k,1780) + lmat(k,1780) - mat(k,1790) = mat(k,1790) + lmat(k,1790) - mat(k,1794) = mat(k,1794) + lmat(k,1794) - mat(k,1797) = lmat(k,1797) - mat(k,1799) = lmat(k,1799) - mat(k,1801) = mat(k,1801) + lmat(k,1801) + mat(k,1762) = lmat(k,1762) + mat(k,1769) = mat(k,1769) + lmat(k,1769) + mat(k,1785) = lmat(k,1785) + mat(k,1788) = lmat(k,1788) + mat(k,1790) = lmat(k,1790) + mat(k,1791) = mat(k,1791) + lmat(k,1791) + mat(k,1792) = lmat(k,1792) + mat(k,1799) = mat(k,1799) + lmat(k,1799) + mat(k,1800) = mat(k,1800) + lmat(k,1800) + mat(k,1801) = lmat(k,1801) mat(k,1802) = lmat(k,1802) mat(k,1803) = lmat(k,1803) - mat(k,1806) = mat(k,1806) + lmat(k,1806) - mat(k,1807) = lmat(k,1807) - mat(k,1808) = lmat(k,1808) - mat(k,1810) = lmat(k,1810) - mat(k,1811) = lmat(k,1811) + mat(k,1804) = lmat(k,1804) + mat(k,1815) = mat(k,1815) + lmat(k,1815) + mat(k,1819) = mat(k,1819) + lmat(k,1819) + mat(k,1828) = mat(k,1828) + lmat(k,1828) mat(k,1829) = mat(k,1829) + lmat(k,1829) - mat(k,1831) = mat(k,1831) + lmat(k,1831) - mat(k,1839) = mat(k,1839) + lmat(k,1839) - mat(k,1842) = mat(k,1842) + lmat(k,1842) - mat(k,1844) = mat(k,1844) + lmat(k,1844) - mat(k,1845) = mat(k,1845) + lmat(k,1845) + mat(k,1832) = lmat(k,1832) + mat(k,1833) = lmat(k,1833) + mat(k,1834) = lmat(k,1834) + mat(k,1835) = lmat(k,1835) mat(k,1846) = mat(k,1846) + lmat(k,1846) - mat(k,1850) = lmat(k,1850) - mat(k,1854) = lmat(k,1854) + mat(k,1850) = mat(k,1850) + lmat(k,1850) mat(k,1859) = mat(k,1859) + lmat(k,1859) - mat(k,1863) = mat(k,1863) + lmat(k,1863) - mat(k,1864) = mat(k,1864) + lmat(k,1864) - mat(k,1872) = lmat(k,1872) - mat(k,1891) = lmat(k,1891) - mat(k,1895) = lmat(k,1895) - mat(k,1896) = mat(k,1896) + lmat(k,1896) + mat(k,1860) = mat(k,1860) + lmat(k,1860) + mat(k,1866) = mat(k,1866) + lmat(k,1866) + mat(k,1867) = lmat(k,1867) + mat(k,1868) = mat(k,1868) + lmat(k,1868) + mat(k,1870) = mat(k,1870) + lmat(k,1870) + mat(k,1871) = mat(k,1871) + lmat(k,1871) + mat(k,1872) = mat(k,1872) + lmat(k,1872) + mat(k,1874) = lmat(k,1874) + mat(k,1878) = mat(k,1878) + lmat(k,1878) + mat(k,1879) = mat(k,1879) + lmat(k,1879) + mat(k,1894) = mat(k,1894) + lmat(k,1894) + mat(k,1900) = lmat(k,1900) + mat(k,1901) = lmat(k,1901) + mat(k,1904) = lmat(k,1904) mat(k,1906) = mat(k,1906) + lmat(k,1906) - mat(k,1907) = lmat(k,1907) + mat(k,1907) = mat(k,1907) + lmat(k,1907) + mat(k,1909) = mat(k,1909) + lmat(k,1909) mat(k,1910) = mat(k,1910) + lmat(k,1910) - mat(k,1916) = lmat(k,1916) - mat(k,1923) = mat(k,1923) + lmat(k,1923) + mat(k,1911) = mat(k,1911) + lmat(k,1911) + mat(k,1913) = lmat(k,1913) + mat(k,1918) = mat(k,1918) + lmat(k,1918) + mat(k,1923) = lmat(k,1923) + mat(k,1926) = lmat(k,1926) mat(k,1927) = lmat(k,1927) - mat(k,1930) = mat(k,1930) + lmat(k,1930) - mat(k,1933) = lmat(k,1933) - mat(k,1938) = mat(k,1938) + lmat(k,1938) - mat(k,1941) = mat(k,1941) + lmat(k,1941) - mat(k,1942) = mat(k,1942) + lmat(k,1942) - mat(k,1953) = lmat(k,1953) - mat(k,1957) = mat(k,1957) + lmat(k,1957) - mat(k,1961) = lmat(k,1961) - mat(k,1964) = mat(k,1964) + lmat(k,1964) - mat(k,1967) = lmat(k,1967) - mat(k,1972) = mat(k,1972) + lmat(k,1972) - mat(k,1975) = mat(k,1975) + lmat(k,1975) - mat(k,1976) = mat(k,1976) + lmat(k,1976) - mat(k,1990) = lmat(k,1990) - mat(k,1993) = mat(k,1993) + lmat(k,1993) - mat(k,1995) = lmat(k,1995) - mat(k,2000) = mat(k,2000) + lmat(k,2000) - mat(k,2003) = mat(k,2003) + lmat(k,2003) - mat(k,2034) = mat(k,2034) + lmat(k,2034) - mat(k,2053) = mat(k,2053) + lmat(k,2053) - mat(k,2072) = mat(k,2072) + lmat(k,2072) - mat(k,2096) = mat(k,2096) + lmat(k,2096) + mat(k,1929) = mat(k,1929) + lmat(k,1929) + mat(k,1930) = lmat(k,1930) + mat(k,1932) = lmat(k,1932) + mat(k,1934) = mat(k,1934) + lmat(k,1934) + mat(k,1937) = lmat(k,1937) + mat(k,1939) = lmat(k,1939) + mat(k,1940) = lmat(k,1940) + mat(k,1959) = mat(k,1959) + lmat(k,1959) + mat(k,1962) = mat(k,1962) + lmat(k,1962) + mat(k,1967) = mat(k,1967) + lmat(k,1967) + mat(k,1970) = mat(k,1970) + lmat(k,1970) + mat(k,1975) = lmat(k,1975) + mat(k,1976) = lmat(k,1976) + mat(k,1997) = mat(k,1997) + lmat(k,1997) + mat(k,1998) = mat(k,1998) + lmat(k,1998) + mat(k,2006) = mat(k,2006) + lmat(k,2006) + mat(k,2009) = mat(k,2009) + lmat(k,2009) + mat(k,2017) = mat(k,2017) + lmat(k,2017) + mat(k,2021) = mat(k,2021) + lmat(k,2021) + mat(k,2022) = mat(k,2022) + lmat(k,2022) + mat(k,2024) = mat(k,2024) + lmat(k,2024) + mat(k,2028) = mat(k,2028) + lmat(k,2028) + mat(k,2030) = mat(k,2030) + lmat(k,2030) + mat(k,2033) = lmat(k,2033) + mat(k,2037) = lmat(k,2037) + mat(k,2045) = mat(k,2045) + lmat(k,2045) + mat(k,2047) = mat(k,2047) + lmat(k,2047) + mat(k,2049) = mat(k,2049) + lmat(k,2049) + mat(k,2058) = lmat(k,2058) + mat(k,2066) = lmat(k,2066) + mat(k,2074) = lmat(k,2074) + mat(k,2076) = mat(k,2076) + lmat(k,2076) + mat(k,2078) = mat(k,2078) + lmat(k,2078) + mat(k,2084) = lmat(k,2084) + mat(k,2087) = mat(k,2087) + lmat(k,2087) + mat(k,2088) = mat(k,2088) + lmat(k,2088) + mat(k,2091) = mat(k,2091) + lmat(k,2091) + mat(k,2094) = lmat(k,2094) + mat(k,2106) = lmat(k,2106) + mat(k,2108) = mat(k,2108) + lmat(k,2108) + mat(k,2110) = mat(k,2110) + lmat(k,2110) + mat(k,2116) = lmat(k,2116) mat(k,2119) = mat(k,2119) + lmat(k,2119) - mat(k,2141) = mat(k,2141) + lmat(k,2141) - mat(k,2142) = lmat(k,2142) - mat(k,2149) = lmat(k,2149) - mat(k,2156) = mat(k,2156) + lmat(k,2156) - mat(k,2179) = mat(k,2179) + lmat(k,2179) - mat(k,2181) = lmat(k,2181) - mat(k,2188) = lmat(k,2188) - mat(k,2191) = mat(k,2191) + lmat(k,2191) - mat(k,2192) = lmat(k,2192) - mat(k,2193) = mat(k,2193) + lmat(k,2193) - mat(k,2194) = lmat(k,2194) - mat(k,2200) = lmat(k,2200) - mat(k,2214) = mat(k,2214) + lmat(k,2214) - mat(k,2243) = mat(k,2243) + lmat(k,2243) + mat(k,2120) = mat(k,2120) + lmat(k,2120) + mat(k,2123) = mat(k,2123) + lmat(k,2123) + mat(k,2136) = lmat(k,2136) + mat(k,2140) = mat(k,2140) + lmat(k,2140) + mat(k,2145) = lmat(k,2145) + mat(k,2148) = mat(k,2148) + lmat(k,2148) + mat(k,2152) = mat(k,2152) + lmat(k,2152) + mat(k,2180) = mat(k,2180) + lmat(k,2180) + mat(k,2199) = mat(k,2199) + lmat(k,2199) + mat(k,2213) = mat(k,2213) + lmat(k,2213) + mat(k,2235) = mat(k,2235) + lmat(k,2235) + mat(k,2256) = lmat(k,2256) + mat(k,2257) = mat(k,2257) + lmat(k,2257) + mat(k,2258) = lmat(k,2258) + mat(k,2259) = mat(k,2259) + lmat(k,2259) + mat(k,2260) = mat(k,2260) + lmat(k,2260) + mat(k,2264) = mat(k,2264) + lmat(k,2264) + mat(k,2265) = lmat(k,2265) + mat(k,2267) = mat(k,2267) + lmat(k,2267) + mat(k,2270) = mat(k,2270) + lmat(k,2270) mat(k,2271) = mat(k,2271) + lmat(k,2271) - mat(k,2303) = mat(k,2303) + lmat(k,2303) - mat(k,2332) = mat(k,2332) + lmat(k,2332) - mat(k,2364) = mat(k,2364) + lmat(k,2364) - mat(k,2392) = mat(k,2392) + lmat(k,2392) - mat(k,2420) = mat(k,2420) + lmat(k,2420) - mat(k,2445) = mat(k,2445) + lmat(k,2445) - mat(k,2467) = mat(k,2467) + lmat(k,2467) - mat(k,2489) = mat(k,2489) + lmat(k,2489) - mat(k,2532) = mat(k,2532) + lmat(k,2532) - mat(k,2579) = mat(k,2579) + lmat(k,2579) - mat(k,2627) = mat(k,2627) + lmat(k,2627) - mat(k,2699) = mat(k,2699) + lmat(k,2699) - mat(k,2717) = mat(k,2717) + lmat(k,2717) - mat(k,2723) = lmat(k,2723) - mat(k,2724) = mat(k,2724) + lmat(k,2724) - mat(k,2730) = mat(k,2730) + lmat(k,2730) - mat(k,2734) = mat(k,2734) + lmat(k,2734) - mat(k,2762) = mat(k,2762) + lmat(k,2762) - mat(k,2885) = mat(k,2885) + lmat(k,2885) - mat(k,2893) = mat(k,2893) + lmat(k,2893) - mat(k,2987) = mat(k,2987) + lmat(k,2987) - mat(k,2989) = mat(k,2989) + lmat(k,2989) - mat(k,2994) = mat(k,2994) + lmat(k,2994) - mat(k,3076) = mat(k,3076) + lmat(k,3076) - mat(k,3078) = mat(k,3078) + lmat(k,3078) - mat(k,3080) = mat(k,3080) + lmat(k,3080) - mat(k,3086) = mat(k,3086) + lmat(k,3086) - mat(k,3087) = mat(k,3087) + lmat(k,3087) - mat(k,3093) = mat(k,3093) + lmat(k,3093) - mat(k,3095) = mat(k,3095) + lmat(k,3095) - mat(k,3096) = mat(k,3096) + lmat(k,3096) - mat(k,3098) = mat(k,3098) + lmat(k,3098) - mat(k,3099) = mat(k,3099) + lmat(k,3099) - mat(k,3101) = mat(k,3101) + lmat(k,3101) - mat(k,3102) = lmat(k,3102) - mat(k,3105) = mat(k,3105) + lmat(k,3105) - mat(k,3106) = lmat(k,3106) - mat(k,3108) = lmat(k,3108) - mat(k,3109) = lmat(k,3109) - mat(k,3110) = lmat(k,3110) - mat(k,3112) = mat(k,3112) + lmat(k,3112) - mat(k,3115) = mat(k,3115) + lmat(k,3115) - mat(k,3218) = mat(k,3218) + lmat(k,3218) - mat(k,3285) = mat(k,3285) + lmat(k,3285) - mat(k,3312) = mat(k,3312) + lmat(k,3312) - mat(k,3315) = mat(k,3315) + lmat(k,3315) - mat(k,3320) = mat(k,3320) + lmat(k,3320) - mat(k,3326) = lmat(k,3326) - mat(k,3327) = mat(k,3327) + lmat(k,3327) - mat(k,3330) = mat(k,3330) + lmat(k,3330) - mat(k,3337) = mat(k,3337) + lmat(k,3337) - mat(k,3429) = mat(k,3429) + lmat(k,3429) - mat(k,3453) = mat(k,3453) + lmat(k,3453) - mat(k,3460) = mat(k,3460) + lmat(k,3460) - mat(k,3500) = mat(k,3500) + lmat(k,3500) - mat(k,3502) = mat(k,3502) + lmat(k,3502) - mat(k,3510) = mat(k,3510) + lmat(k,3510) - mat(k,3511) = mat(k,3511) + lmat(k,3511) - mat(k,3512) = mat(k,3512) + lmat(k,3512) - mat(k,3537) = lmat(k,3537) - mat(k,3544) = lmat(k,3544) - mat(k,3704) = mat(k,3704) + lmat(k,3704) - mat(k,3746) = mat(k,3746) + lmat(k,3746) - mat(k,3749) = mat(k,3749) + lmat(k,3749) - mat(k,3752) = mat(k,3752) + lmat(k,3752) - mat(k,3755) = mat(k,3755) + lmat(k,3755) - mat(k,3756) = mat(k,3756) + lmat(k,3756) - mat(k,3764) = mat(k,3764) + lmat(k,3764) - mat(k,3775) = mat(k,3775) + lmat(k,3775) - mat(k,3777) = mat(k,3777) + lmat(k,3777) - mat(k,3785) = mat(k,3785) + lmat(k,3785) - mat(k,3796) = mat(k,3796) + lmat(k,3796) - mat(k,3800) = mat(k,3800) + lmat(k,3800) - mat(k,3818) = mat(k,3818) + lmat(k,3818) - mat(k,3819) = lmat(k,3819) - mat(k,3827) = mat(k,3827) + lmat(k,3827) - mat(k,3830) = lmat(k,3830) - mat(k,3834) = mat(k,3834) + lmat(k,3834) - mat(k,3836) = mat(k,3836) + lmat(k,3836) - mat(k,3843) = lmat(k,3843) - mat(k,3847) = lmat(k,3847) - mat(k,3851) = mat(k,3851) + lmat(k,3851) - mat(k,3856) = lmat(k,3856) - mat(k,3858) = mat(k,3858) + lmat(k,3858) - mat(k,3862) = mat(k,3862) + lmat(k,3862) - mat(k, 183) = 0._r8 - mat(k, 184) = 0._r8 - mat(k, 288) = 0._r8 - mat(k, 359) = 0._r8 - mat(k, 363) = 0._r8 - mat(k, 382) = 0._r8 - mat(k, 436) = 0._r8 + mat(k,2277) = mat(k,2277) + lmat(k,2277) + mat(k,2278) = lmat(k,2278) + mat(k,2286) = lmat(k,2286) + mat(k,2296) = mat(k,2296) + lmat(k,2296) + mat(k,2322) = mat(k,2322) + lmat(k,2322) + mat(k,2349) = mat(k,2349) + lmat(k,2349) + mat(k,2365) = lmat(k,2365) + mat(k,2366) = mat(k,2366) + lmat(k,2366) + mat(k,2367) = lmat(k,2367) + mat(k,2372) = lmat(k,2372) + mat(k,2381) = mat(k,2381) + lmat(k,2381) + mat(k,2411) = mat(k,2411) + lmat(k,2411) + mat(k,2437) = mat(k,2437) + lmat(k,2437) + mat(k,2438) = lmat(k,2438) + mat(k,2448) = lmat(k,2448) + mat(k,2449) = mat(k,2449) + lmat(k,2449) + mat(k,2466) = mat(k,2466) + lmat(k,2466) + mat(k,2499) = mat(k,2499) + lmat(k,2499) + mat(k,2530) = mat(k,2530) + lmat(k,2530) + mat(k,2554) = mat(k,2554) + lmat(k,2554) + mat(k,2555) = mat(k,2555) + lmat(k,2555) + mat(k,2564) = mat(k,2564) + lmat(k,2564) + mat(k,2573) = mat(k,2573) + lmat(k,2573) + mat(k,2580) = mat(k,2580) + lmat(k,2580) + mat(k,2597) = mat(k,2597) + lmat(k,2597) + mat(k,2604) = mat(k,2604) + lmat(k,2604) + mat(k,2607) = mat(k,2607) + lmat(k,2607) + mat(k,2639) = mat(k,2639) + lmat(k,2639) + mat(k,2645) = lmat(k,2645) + mat(k,2663) = mat(k,2663) + lmat(k,2663) + mat(k,2700) = mat(k,2700) + lmat(k,2700) + mat(k,2728) = mat(k,2728) + lmat(k,2728) + mat(k,2751) = mat(k,2751) + lmat(k,2751) + mat(k,2775) = mat(k,2775) + lmat(k,2775) + mat(k,2806) = mat(k,2806) + lmat(k,2806) + mat(k,2853) = mat(k,2853) + lmat(k,2853) + mat(k,2901) = mat(k,2901) + lmat(k,2901) + mat(k,2948) = mat(k,2948) + lmat(k,2948) + mat(k,3023) = mat(k,3023) + lmat(k,3023) + mat(k,3116) = mat(k,3116) + lmat(k,3116) + mat(k,3127) = mat(k,3127) + lmat(k,3127) + mat(k,3132) = mat(k,3132) + lmat(k,3132) + mat(k,3147) = mat(k,3147) + lmat(k,3147) + mat(k,3151) = mat(k,3151) + lmat(k,3151) + mat(k,3158) = mat(k,3158) + lmat(k,3158) + mat(k,3187) = mat(k,3187) + lmat(k,3187) + mat(k,3311) = mat(k,3311) + lmat(k,3311) + mat(k,3314) = mat(k,3314) + lmat(k,3314) + mat(k,3331) = mat(k,3331) + lmat(k,3331) + mat(k,3335) = mat(k,3335) + lmat(k,3335) + mat(k,3339) = lmat(k,3339) + mat(k,3346) = lmat(k,3346) + mat(k,3347) = mat(k,3347) + lmat(k,3347) + mat(k,3351) = mat(k,3351) + lmat(k,3351) + mat(k,3358) = mat(k,3358) + lmat(k,3358) + mat(k,3385) = mat(k,3385) + lmat(k,3385) + mat(k,3390) = mat(k,3390) + lmat(k,3390) + mat(k,3571) = mat(k,3571) + lmat(k,3571) + mat(k,3577) = mat(k,3577) + lmat(k,3577) + mat(k,3822) = mat(k,3822) + lmat(k,3822) + mat(k,3864) = mat(k,3864) + lmat(k,3864) + mat(k,3952) = mat(k,3952) + lmat(k,3952) + mat(k,3953) = mat(k,3953) + lmat(k,3953) + mat(k,3955) = mat(k,3955) + lmat(k,3955) + mat(k,3959) = mat(k,3959) + lmat(k,3959) + mat(k,3961) = mat(k,3961) + lmat(k,3961) + mat(k,4052) = mat(k,4052) + lmat(k,4052) + mat(k,4096) = mat(k,4096) + lmat(k,4096) + mat(k,4097) = mat(k,4097) + lmat(k,4097) + mat(k,4099) = mat(k,4099) + lmat(k,4099) + mat(k,4101) = mat(k,4101) + lmat(k,4101) + mat(k,4105) = mat(k,4105) + lmat(k,4105) + mat(k,4113) = lmat(k,4113) + mat(k,4117) = lmat(k,4117) + mat(k,4119) = mat(k,4119) + lmat(k,4119) + mat(k,4125) = lmat(k,4125) + mat(k,4127) = mat(k,4127) + lmat(k,4127) + mat(k,4132) = mat(k,4132) + lmat(k,4132) + mat(k, 231) = 0._r8 + mat(k, 232) = 0._r8 + mat(k, 303) = 0._r8 + mat(k, 352) = 0._r8 mat(k, 441) = 0._r8 - mat(k, 449) = 0._r8 - mat(k, 606) = 0._r8 - mat(k, 609) = 0._r8 - mat(k, 614) = 0._r8 - mat(k, 616) = 0._r8 - mat(k, 617) = 0._r8 - mat(k, 619) = 0._r8 - mat(k, 635) = 0._r8 - mat(k, 636) = 0._r8 - mat(k, 639) = 0._r8 - mat(k, 646) = 0._r8 - mat(k, 648) = 0._r8 - mat(k, 651) = 0._r8 - mat(k, 732) = 0._r8 - mat(k, 734) = 0._r8 - mat(k, 735) = 0._r8 - mat(k, 737) = 0._r8 - mat(k, 739) = 0._r8 - mat(k, 745) = 0._r8 - mat(k, 750) = 0._r8 - mat(k, 761) = 0._r8 - mat(k, 763) = 0._r8 - mat(k, 764) = 0._r8 - mat(k, 766) = 0._r8 - mat(k, 771) = 0._r8 - mat(k, 777) = 0._r8 - mat(k, 779) = 0._r8 - mat(k, 780) = 0._r8 - mat(k, 782) = 0._r8 - mat(k, 784) = 0._r8 - mat(k, 788) = 0._r8 - mat(k, 824) = 0._r8 - mat(k, 829) = 0._r8 + mat(k, 444) = 0._r8 + mat(k, 457) = 0._r8 + mat(k, 476) = 0._r8 + mat(k, 526) = 0._r8 + mat(k, 530) = 0._r8 + mat(k, 538) = 0._r8 + mat(k, 687) = 0._r8 + mat(k, 710) = 0._r8 + mat(k, 713) = 0._r8 + mat(k, 717) = 0._r8 + mat(k, 718) = 0._r8 + mat(k, 721) = 0._r8 + mat(k, 728) = 0._r8 + mat(k, 730) = 0._r8 + mat(k, 733) = 0._r8 + mat(k, 749) = 0._r8 + mat(k, 751) = 0._r8 + mat(k, 752) = 0._r8 + mat(k, 755) = 0._r8 mat(k, 830) = 0._r8 + mat(k, 832) = 0._r8 mat(k, 833) = 0._r8 mat(k, 836) = 0._r8 mat(k, 837) = 0._r8 + mat(k, 860) = 0._r8 mat(k, 864) = 0._r8 - mat(k, 865) = 0._r8 - mat(k, 912) = 0._r8 - mat(k, 915) = 0._r8 - mat(k, 918) = 0._r8 - mat(k, 920) = 0._r8 - mat(k, 929) = 0._r8 - mat(k, 945) = 0._r8 - mat(k, 966) = 0._r8 - mat(k, 968) = 0._r8 - mat(k, 983) = 0._r8 - mat(k, 984) = 0._r8 - mat(k,1049) = 0._r8 + mat(k, 876) = 0._r8 + mat(k, 878) = 0._r8 + mat(k, 879) = 0._r8 + mat(k, 882) = 0._r8 + mat(k, 885) = 0._r8 + mat(k, 892) = 0._r8 + mat(k, 894) = 0._r8 + mat(k, 895) = 0._r8 + mat(k, 898) = 0._r8 + mat(k, 899) = 0._r8 + mat(k, 902) = 0._r8 + mat(k, 934) = 0._r8 + mat(k, 938) = 0._r8 + mat(k, 940) = 0._r8 + mat(k, 943) = 0._r8 + mat(k, 946) = 0._r8 + mat(k, 947) = 0._r8 + mat(k, 999) = 0._r8 + mat(k,1002) = 0._r8 + mat(k,1005) = 0._r8 + mat(k,1006) = 0._r8 + mat(k,1016) = 0._r8 + mat(k,1030) = 0._r8 + mat(k,1034) = 0._r8 + mat(k,1035) = 0._r8 + mat(k,1048) = 0._r8 mat(k,1051) = 0._r8 - mat(k,1052) = 0._r8 - mat(k,1054) = 0._r8 - mat(k,1058) = 0._r8 - mat(k,1059) = 0._r8 - mat(k,1109) = 0._r8 - mat(k,1112) = 0._r8 - mat(k,1131) = 0._r8 - mat(k,1133) = 0._r8 - mat(k,1136) = 0._r8 - mat(k,1141) = 0._r8 - mat(k,1146) = 0._r8 - mat(k,1147) = 0._r8 - mat(k,1148) = 0._r8 - mat(k,1153) = 0._r8 - mat(k,1166) = 0._r8 - mat(k,1201) = 0._r8 + mat(k,1071) = 0._r8 + mat(k,1075) = 0._r8 + mat(k,1077) = 0._r8 + mat(k,1092) = 0._r8 + mat(k,1177) = 0._r8 + mat(k,1180) = 0._r8 + mat(k,1181) = 0._r8 + mat(k,1182) = 0._r8 + mat(k,1183) = 0._r8 + mat(k,1184) = 0._r8 + mat(k,1189) = 0._r8 + mat(k,1191) = 0._r8 + mat(k,1197) = 0._r8 + mat(k,1199) = 0._r8 mat(k,1202) = 0._r8 - mat(k,1208) = 0._r8 - mat(k,1210) = 0._r8 - mat(k,1222) = 0._r8 - mat(k,1235) = 0._r8 - mat(k,1251) = 0._r8 + mat(k,1206) = 0._r8 + mat(k,1218) = 0._r8 + mat(k,1219) = 0._r8 + mat(k,1220) = 0._r8 + mat(k,1225) = 0._r8 + mat(k,1238) = 0._r8 + mat(k,1249) = 0._r8 mat(k,1254) = 0._r8 - mat(k,1260) = 0._r8 - mat(k,1263) = 0._r8 - mat(k,1264) = 0._r8 - mat(k,1288) = 0._r8 - mat(k,1289) = 0._r8 - mat(k,1290) = 0._r8 - mat(k,1291) = 0._r8 - mat(k,1293) = 0._r8 - mat(k,1294) = 0._r8 - mat(k,1304) = 0._r8 - mat(k,1320) = 0._r8 - mat(k,1417) = 0._r8 - mat(k,1419) = 0._r8 + mat(k,1256) = 0._r8 + mat(k,1269) = 0._r8 + mat(k,1332) = 0._r8 + mat(k,1345) = 0._r8 + mat(k,1354) = 0._r8 + mat(k,1369) = 0._r8 + mat(k,1373) = 0._r8 + mat(k,1379) = 0._r8 + mat(k,1380) = 0._r8 + mat(k,1393) = 0._r8 + mat(k,1394) = 0._r8 + mat(k,1395) = 0._r8 + mat(k,1396) = 0._r8 + mat(k,1398) = 0._r8 + mat(k,1399) = 0._r8 + mat(k,1410) = 0._r8 + mat(k,1416) = 0._r8 + mat(k,1420) = 0._r8 mat(k,1421) = 0._r8 - mat(k,1432) = 0._r8 - mat(k,1435) = 0._r8 - mat(k,1438) = 0._r8 - mat(k,1440) = 0._r8 - mat(k,1441) = 0._r8 - mat(k,1442) = 0._r8 - mat(k,1443) = 0._r8 - mat(k,1444) = 0._r8 - mat(k,1445) = 0._r8 - mat(k,1446) = 0._r8 - mat(k,1447) = 0._r8 - mat(k,1451) = 0._r8 - mat(k,1453) = 0._r8 - mat(k,1456) = 0._r8 - mat(k,1457) = 0._r8 - mat(k,1460) = 0._r8 - mat(k,1461) = 0._r8 - mat(k,1462) = 0._r8 - mat(k,1479) = 0._r8 - mat(k,1482) = 0._r8 - mat(k,1484) = 0._r8 - mat(k,1487) = 0._r8 - mat(k,1488) = 0._r8 - mat(k,1491) = 0._r8 - mat(k,1499) = 0._r8 - mat(k,1509) = 0._r8 - mat(k,1518) = 0._r8 + mat(k,1423) = 0._r8 + mat(k,1521) = 0._r8 + mat(k,1523) = 0._r8 + mat(k,1524) = 0._r8 mat(k,1525) = 0._r8 + mat(k,1526) = 0._r8 mat(k,1527) = 0._r8 + mat(k,1528) = 0._r8 + mat(k,1529) = 0._r8 mat(k,1530) = 0._r8 - mat(k,1532) = 0._r8 mat(k,1533) = 0._r8 - mat(k,1534) = 0._r8 - mat(k,1537) = 0._r8 - mat(k,1548) = 0._r8 - mat(k,1551) = 0._r8 - mat(k,1553) = 0._r8 - mat(k,1554) = 0._r8 - mat(k,1558) = 0._r8 - mat(k,1569) = 0._r8 + mat(k,1565) = 0._r8 + mat(k,1571) = 0._r8 mat(k,1572) = 0._r8 + mat(k,1573) = 0._r8 mat(k,1574) = 0._r8 mat(k,1575) = 0._r8 + mat(k,1576) = 0._r8 + mat(k,1577) = 0._r8 mat(k,1579) = 0._r8 - mat(k,1587) = 0._r8 + mat(k,1580) = 0._r8 + mat(k,1583) = 0._r8 + mat(k,1585) = 0._r8 + mat(k,1586) = 0._r8 mat(k,1588) = 0._r8 mat(k,1589) = 0._r8 - mat(k,1591) = 0._r8 - mat(k,1593) = 0._r8 + mat(k,1592) = 0._r8 mat(k,1594) = 0._r8 - mat(k,1599) = 0._r8 - mat(k,1600) = 0._r8 - mat(k,1601) = 0._r8 - mat(k,1602) = 0._r8 - mat(k,1604) = 0._r8 - mat(k,1607) = 0._r8 - mat(k,1622) = 0._r8 - mat(k,1623) = 0._r8 - mat(k,1638) = 0._r8 + mat(k,1606) = 0._r8 + mat(k,1610) = 0._r8 + mat(k,1619) = 0._r8 + mat(k,1625) = 0._r8 + mat(k,1631) = 0._r8 + mat(k,1637) = 0._r8 mat(k,1639) = 0._r8 - mat(k,1640) = 0._r8 mat(k,1641) = 0._r8 + mat(k,1642) = 0._r8 + mat(k,1646) = 0._r8 + mat(k,1648) = 0._r8 mat(k,1649) = 0._r8 - mat(k,1658) = 0._r8 + mat(k,1650) = 0._r8 + mat(k,1655) = 0._r8 + mat(k,1656) = 0._r8 mat(k,1659) = 0._r8 + mat(k,1661) = 0._r8 mat(k,1662) = 0._r8 mat(k,1663) = 0._r8 mat(k,1665) = 0._r8 - mat(k,1666) = 0._r8 - mat(k,1669) = 0._r8 - mat(k,1670) = 0._r8 - mat(k,1671) = 0._r8 - mat(k,1674) = 0._r8 + mat(k,1672) = 0._r8 mat(k,1676) = 0._r8 + mat(k,1680) = 0._r8 + mat(k,1681) = 0._r8 + mat(k,1684) = 0._r8 + mat(k,1685) = 0._r8 mat(k,1686) = 0._r8 mat(k,1688) = 0._r8 + mat(k,1690) = 0._r8 mat(k,1691) = 0._r8 - mat(k,1692) = 0._r8 - mat(k,1694) = 0._r8 + mat(k,1696) = 0._r8 + mat(k,1697) = 0._r8 + mat(k,1698) = 0._r8 mat(k,1699) = 0._r8 mat(k,1701) = 0._r8 - mat(k,1704) = 0._r8 - mat(k,1705) = 0._r8 - mat(k,1707) = 0._r8 - mat(k,1708) = 0._r8 - mat(k,1714) = 0._r8 - mat(k,1715) = 0._r8 - mat(k,1716) = 0._r8 - mat(k,1717) = 0._r8 - mat(k,1719) = 0._r8 - mat(k,1720) = 0._r8 - mat(k,1721) = 0._r8 - mat(k,1722) = 0._r8 - mat(k,1723) = 0._r8 - mat(k,1724) = 0._r8 - mat(k,1725) = 0._r8 - mat(k,1726) = 0._r8 - mat(k,1727) = 0._r8 - mat(k,1731) = 0._r8 - mat(k,1732) = 0._r8 - mat(k,1734) = 0._r8 - mat(k,1735) = 0._r8 - mat(k,1737) = 0._r8 - mat(k,1738) = 0._r8 - mat(k,1749) = 0._r8 - mat(k,1750) = 0._r8 - mat(k,1753) = 0._r8 - mat(k,1755) = 0._r8 - mat(k,1756) = 0._r8 - mat(k,1758) = 0._r8 - mat(k,1762) = 0._r8 - mat(k,1770) = 0._r8 - mat(k,1771) = 0._r8 + mat(k,1703) = 0._r8 + mat(k,1713) = 0._r8 + mat(k,1729) = 0._r8 + mat(k,1739) = 0._r8 + mat(k,1741) = 0._r8 + mat(k,1744) = 0._r8 + mat(k,1746) = 0._r8 + mat(k,1751) = 0._r8 + mat(k,1767) = 0._r8 + mat(k,1768) = 0._r8 mat(k,1772) = 0._r8 - mat(k,1775) = 0._r8 - mat(k,1776) = 0._r8 - mat(k,1778) = 0._r8 - mat(k,1781) = 0._r8 - mat(k,1782) = 0._r8 - mat(k,1783) = 0._r8 - mat(k,1784) = 0._r8 - mat(k,1788) = 0._r8 + mat(k,1774) = 0._r8 + mat(k,1779) = 0._r8 + mat(k,1787) = 0._r8 mat(k,1795) = 0._r8 - mat(k,1804) = 0._r8 - mat(k,1805) = 0._r8 + mat(k,1796) = 0._r8 + mat(k,1797) = 0._r8 + mat(k,1798) = 0._r8 + mat(k,1806) = 0._r8 + mat(k,1807) = 0._r8 + mat(k,1810) = 0._r8 + mat(k,1812) = 0._r8 + mat(k,1813) = 0._r8 mat(k,1814) = 0._r8 - mat(k,1815) = 0._r8 - mat(k,1816) = 0._r8 - mat(k,1817) = 0._r8 mat(k,1818) = 0._r8 - mat(k,1819) = 0._r8 mat(k,1820) = 0._r8 mat(k,1821) = 0._r8 - mat(k,1822) = 0._r8 mat(k,1823) = 0._r8 - mat(k,1824) = 0._r8 - mat(k,1825) = 0._r8 - mat(k,1826) = 0._r8 mat(k,1827) = 0._r8 - mat(k,1828) = 0._r8 - mat(k,1830) = 0._r8 - mat(k,1833) = 0._r8 - mat(k,1835) = 0._r8 - mat(k,1836) = 0._r8 - mat(k,1843) = 0._r8 - mat(k,1848) = 0._r8 - mat(k,1856) = 0._r8 + mat(k,1837) = 0._r8 + mat(k,1838) = 0._r8 + mat(k,1839) = 0._r8 + mat(k,1842) = 0._r8 + mat(k,1844) = 0._r8 + mat(k,1845) = 0._r8 + mat(k,1849) = 0._r8 + mat(k,1851) = 0._r8 + mat(k,1852) = 0._r8 + mat(k,1853) = 0._r8 mat(k,1858) = 0._r8 - mat(k,1860) = 0._r8 - mat(k,1861) = 0._r8 + mat(k,1863) = 0._r8 mat(k,1865) = 0._r8 - mat(k,1866) = 0._r8 - mat(k,1867) = 0._r8 mat(k,1869) = 0._r8 mat(k,1873) = 0._r8 mat(k,1875) = 0._r8 + mat(k,1876) = 0._r8 + mat(k,1877) = 0._r8 mat(k,1880) = 0._r8 - mat(k,1881) = 0._r8 - mat(k,1882) = 0._r8 - mat(k,1883) = 0._r8 mat(k,1884) = 0._r8 + mat(k,1885) = 0._r8 mat(k,1886) = 0._r8 - mat(k,1888) = 0._r8 + mat(k,1887) = 0._r8 + mat(k,1889) = 0._r8 mat(k,1892) = 0._r8 - mat(k,1894) = 0._r8 + mat(k,1895) = 0._r8 + mat(k,1896) = 0._r8 mat(k,1897) = 0._r8 - mat(k,1898) = 0._r8 - mat(k,1899) = 0._r8 - mat(k,1900) = 0._r8 - mat(k,1901) = 0._r8 mat(k,1902) = 0._r8 mat(k,1903) = 0._r8 - mat(k,1904) = 0._r8 mat(k,1905) = 0._r8 mat(k,1908) = 0._r8 - mat(k,1909) = 0._r8 - mat(k,1911) = 0._r8 - mat(k,1915) = 0._r8 - mat(k,1917) = 0._r8 - mat(k,1920) = 0._r8 - mat(k,1922) = 0._r8 - mat(k,1924) = 0._r8 - mat(k,1926) = 0._r8 - mat(k,1928) = 0._r8 - mat(k,1932) = 0._r8 - mat(k,1934) = 0._r8 - mat(k,1935) = 0._r8 - mat(k,1937) = 0._r8 - mat(k,1939) = 0._r8 - mat(k,1940) = 0._r8 + mat(k,1919) = 0._r8 + mat(k,1925) = 0._r8 + mat(k,1931) = 0._r8 + mat(k,1933) = 0._r8 + mat(k,1936) = 0._r8 + mat(k,1938) = 0._r8 mat(k,1943) = 0._r8 mat(k,1944) = 0._r8 mat(k,1945) = 0._r8 + mat(k,1947) = 0._r8 + mat(k,1948) = 0._r8 mat(k,1949) = 0._r8 + mat(k,1950) = 0._r8 mat(k,1951) = 0._r8 + mat(k,1952) = 0._r8 + mat(k,1953) = 0._r8 mat(k,1954) = 0._r8 - mat(k,1955) = 0._r8 mat(k,1956) = 0._r8 - mat(k,1959) = 0._r8 + mat(k,1957) = 0._r8 + mat(k,1958) = 0._r8 mat(k,1960) = 0._r8 + mat(k,1961) = 0._r8 + mat(k,1963) = 0._r8 mat(k,1966) = 0._r8 mat(k,1968) = 0._r8 - mat(k,1969) = 0._r8 mat(k,1971) = 0._r8 - mat(k,1973) = 0._r8 mat(k,1974) = 0._r8 - mat(k,1977) = 0._r8 - mat(k,1978) = 0._r8 mat(k,1979) = 0._r8 + mat(k,1980) = 0._r8 + mat(k,1982) = 0._r8 + mat(k,1984) = 0._r8 + mat(k,1985) = 0._r8 + mat(k,1986) = 0._r8 mat(k,1987) = 0._r8 + mat(k,1988) = 0._r8 mat(k,1989) = 0._r8 + mat(k,1990) = 0._r8 + mat(k,1993) = 0._r8 + mat(k,1994) = 0._r8 + mat(k,1995) = 0._r8 mat(k,1996) = 0._r8 - mat(k,1997) = 0._r8 mat(k,1999) = 0._r8 + mat(k,2000) = 0._r8 mat(k,2001) = 0._r8 mat(k,2002) = 0._r8 mat(k,2005) = 0._r8 - mat(k,2006) = 0._r8 mat(k,2007) = 0._r8 mat(k,2010) = 0._r8 - mat(k,2011) = 0._r8 - mat(k,2012) = 0._r8 mat(k,2013) = 0._r8 - mat(k,2014) = 0._r8 - mat(k,2015) = 0._r8 mat(k,2016) = 0._r8 - mat(k,2017) = 0._r8 - mat(k,2020) = 0._r8 - mat(k,2021) = 0._r8 + mat(k,2018) = 0._r8 + mat(k,2019) = 0._r8 mat(k,2023) = 0._r8 - mat(k,2024) = 0._r8 - mat(k,2025) = 0._r8 mat(k,2026) = 0._r8 - mat(k,2028) = 0._r8 + mat(k,2027) = 0._r8 mat(k,2029) = 0._r8 - mat(k,2035) = 0._r8 - mat(k,2037) = 0._r8 - mat(k,2038) = 0._r8 - mat(k,2040) = 0._r8 - mat(k,2045) = 0._r8 + mat(k,2032) = 0._r8 + mat(k,2034) = 0._r8 + mat(k,2039) = 0._r8 + mat(k,2042) = 0._r8 + mat(k,2043) = 0._r8 + mat(k,2046) = 0._r8 mat(k,2048) = 0._r8 - mat(k,2049) = 0._r8 - mat(k,2050) = 0._r8 + mat(k,2051) = 0._r8 + mat(k,2052) = 0._r8 + mat(k,2054) = 0._r8 + mat(k,2057) = 0._r8 + mat(k,2059) = 0._r8 + mat(k,2060) = 0._r8 + mat(k,2063) = 0._r8 + mat(k,2068) = 0._r8 + mat(k,2069) = 0._r8 + mat(k,2070) = 0._r8 mat(k,2071) = 0._r8 - mat(k,2074) = 0._r8 + mat(k,2073) = 0._r8 + mat(k,2080) = 0._r8 mat(k,2082) = 0._r8 mat(k,2083) = 0._r8 - mat(k,2093) = 0._r8 + mat(k,2085) = 0._r8 + mat(k,2086) = 0._r8 + mat(k,2089) = 0._r8 + mat(k,2090) = 0._r8 + mat(k,2092) = 0._r8 mat(k,2095) = 0._r8 - mat(k,2097) = 0._r8 - mat(k,2098) = 0._r8 - mat(k,2128) = 0._r8 - mat(k,2136) = 0._r8 - mat(k,2138) = 0._r8 - mat(k,2139) = 0._r8 - mat(k,2140) = 0._r8 + mat(k,2100) = 0._r8 + mat(k,2101) = 0._r8 + mat(k,2104) = 0._r8 + mat(k,2105) = 0._r8 + mat(k,2109) = 0._r8 + mat(k,2112) = 0._r8 + mat(k,2114) = 0._r8 + mat(k,2115) = 0._r8 + mat(k,2117) = 0._r8 + mat(k,2118) = 0._r8 + mat(k,2121) = 0._r8 + mat(k,2122) = 0._r8 + mat(k,2124) = 0._r8 + mat(k,2132) = 0._r8 + mat(k,2134) = 0._r8 + mat(k,2135) = 0._r8 mat(k,2143) = 0._r8 mat(k,2144) = 0._r8 - mat(k,2145) = 0._r8 mat(k,2146) = 0._r8 mat(k,2147) = 0._r8 - mat(k,2148) = 0._r8 mat(k,2150) = 0._r8 + mat(k,2151) = 0._r8 + mat(k,2153) = 0._r8 + mat(k,2156) = 0._r8 + mat(k,2157) = 0._r8 mat(k,2158) = 0._r8 - mat(k,2167) = 0._r8 - mat(k,2176) = 0._r8 - mat(k,2177) = 0._r8 - mat(k,2178) = 0._r8 - mat(k,2180) = 0._r8 + mat(k,2159) = 0._r8 + mat(k,2160) = 0._r8 + mat(k,2161) = 0._r8 + mat(k,2162) = 0._r8 + mat(k,2166) = 0._r8 + mat(k,2168) = 0._r8 + mat(k,2169) = 0._r8 + mat(k,2170) = 0._r8 + mat(k,2171) = 0._r8 + mat(k,2172) = 0._r8 + mat(k,2173) = 0._r8 + mat(k,2174) = 0._r8 + mat(k,2181) = 0._r8 mat(k,2182) = 0._r8 - mat(k,2183) = 0._r8 mat(k,2184) = 0._r8 mat(k,2185) = 0._r8 - mat(k,2186) = 0._r8 mat(k,2187) = 0._r8 mat(k,2189) = 0._r8 - mat(k,2190) = 0._r8 - mat(k,2198) = 0._r8 - mat(k,2223) = 0._r8 + mat(k,2192) = 0._r8 + mat(k,2196) = 0._r8 + mat(k,2201) = 0._r8 + mat(k,2202) = 0._r8 + mat(k,2205) = 0._r8 + mat(k,2207) = 0._r8 + mat(k,2208) = 0._r8 + mat(k,2212) = 0._r8 mat(k,2224) = 0._r8 - mat(k,2232) = 0._r8 - mat(k,2242) = 0._r8 - mat(k,2252) = 0._r8 - mat(k,2253) = 0._r8 - mat(k,2261) = 0._r8 + mat(k,2233) = 0._r8 + mat(k,2234) = 0._r8 + mat(k,2237) = 0._r8 + mat(k,2246) = 0._r8 + mat(k,2248) = 0._r8 mat(k,2263) = 0._r8 - mat(k,2265) = 0._r8 mat(k,2269) = 0._r8 - mat(k,2270) = 0._r8 mat(k,2273) = 0._r8 + mat(k,2274) = 0._r8 + mat(k,2275) = 0._r8 + mat(k,2276) = 0._r8 + mat(k,2279) = 0._r8 + mat(k,2280) = 0._r8 mat(k,2281) = 0._r8 mat(k,2282) = 0._r8 - mat(k,2290) = 0._r8 - mat(k,2293) = 0._r8 - mat(k,2294) = 0._r8 + mat(k,2283) = 0._r8 + mat(k,2285) = 0._r8 + mat(k,2287) = 0._r8 mat(k,2295) = 0._r8 - mat(k,2298) = 0._r8 - mat(k,2299) = 0._r8 - mat(k,2302) = 0._r8 - mat(k,2304) = 0._r8 - mat(k,2313) = 0._r8 + mat(k,2306) = 0._r8 + mat(k,2308) = 0._r8 mat(k,2314) = 0._r8 - mat(k,2322) = 0._r8 - mat(k,2331) = 0._r8 - mat(k,2340) = 0._r8 - mat(k,2341) = 0._r8 - mat(k,2349) = 0._r8 - mat(k,2352) = 0._r8 - mat(k,2353) = 0._r8 + mat(k,2317) = 0._r8 + mat(k,2319) = 0._r8 + mat(k,2321) = 0._r8 + mat(k,2324) = 0._r8 + mat(k,2325) = 0._r8 + mat(k,2335) = 0._r8 + mat(k,2345) = 0._r8 + mat(k,2347) = 0._r8 + mat(k,2348) = 0._r8 + mat(k,2350) = 0._r8 + mat(k,2351) = 0._r8 mat(k,2354) = 0._r8 - mat(k,2357) = 0._r8 + mat(k,2355) = 0._r8 + mat(k,2356) = 0._r8 mat(k,2358) = 0._r8 - mat(k,2362) = 0._r8 - mat(k,2363) = 0._r8 - mat(k,2366) = 0._r8 - mat(k,2374) = 0._r8 - mat(k,2375) = 0._r8 - mat(k,2383) = 0._r8 - mat(k,2389) = 0._r8 - mat(k,2390) = 0._r8 - mat(k,2391) = 0._r8 + mat(k,2361) = 0._r8 + mat(k,2364) = 0._r8 + mat(k,2371) = 0._r8 + mat(k,2379) = 0._r8 + mat(k,2380) = 0._r8 + mat(k,2392) = 0._r8 mat(k,2394) = 0._r8 - mat(k,2395) = 0._r8 - mat(k,2396) = 0._r8 - mat(k,2397) = 0._r8 - mat(k,2398) = 0._r8 - mat(k,2399) = 0._r8 - mat(k,2400) = 0._r8 - mat(k,2401) = 0._r8 - mat(k,2406) = 0._r8 - mat(k,2409) = 0._r8 + mat(k,2408) = 0._r8 mat(k,2410) = 0._r8 - mat(k,2411) = 0._r8 - mat(k,2413) = 0._r8 - mat(k,2417) = 0._r8 - mat(k,2419) = 0._r8 - mat(k,2421) = 0._r8 mat(k,2422) = 0._r8 - mat(k,2423) = 0._r8 - mat(k,2425) = 0._r8 - mat(k,2426) = 0._r8 - mat(k,2427) = 0._r8 - mat(k,2428) = 0._r8 - mat(k,2431) = 0._r8 + mat(k,2424) = 0._r8 + mat(k,2430) = 0._r8 + mat(k,2432) = 0._r8 mat(k,2433) = 0._r8 + mat(k,2434) = 0._r8 + mat(k,2435) = 0._r8 mat(k,2436) = 0._r8 - mat(k,2437) = 0._r8 - mat(k,2438) = 0._r8 + mat(k,2439) = 0._r8 + mat(k,2440) = 0._r8 + mat(k,2441) = 0._r8 + mat(k,2442) = 0._r8 mat(k,2443) = 0._r8 mat(k,2444) = 0._r8 - mat(k,2452) = 0._r8 - mat(k,2453) = 0._r8 - mat(k,2460) = 0._r8 - mat(k,2464) = 0._r8 - mat(k,2465) = 0._r8 - mat(k,2473) = 0._r8 - mat(k,2474) = 0._r8 - mat(k,2485) = 0._r8 - mat(k,2486) = 0._r8 - mat(k,2494) = 0._r8 - mat(k,2495) = 0._r8 - mat(k,2503) = 0._r8 - mat(k,2536) = 0._r8 - mat(k,2537) = 0._r8 - mat(k,2544) = 0._r8 + mat(k,2445) = 0._r8 + mat(k,2446) = 0._r8 + mat(k,2447) = 0._r8 + mat(k,2450) = 0._r8 + mat(k,2451) = 0._r8 + mat(k,2462) = 0._r8 + mat(k,2476) = 0._r8 + mat(k,2478) = 0._r8 + mat(k,2484) = 0._r8 + mat(k,2487) = 0._r8 + mat(k,2488) = 0._r8 + mat(k,2489) = 0._r8 + mat(k,2492) = 0._r8 + mat(k,2493) = 0._r8 + mat(k,2497) = 0._r8 + mat(k,2498) = 0._r8 + mat(k,2500) = 0._r8 + mat(k,2510) = 0._r8 + mat(k,2512) = 0._r8 + mat(k,2518) = 0._r8 + mat(k,2528) = 0._r8 + mat(k,2529) = 0._r8 + mat(k,2539) = 0._r8 + mat(k,2541) = 0._r8 mat(k,2547) = 0._r8 - mat(k,2548) = 0._r8 - mat(k,2549) = 0._r8 + mat(k,2556) = 0._r8 + mat(k,2558) = 0._r8 + mat(k,2559) = 0._r8 + mat(k,2560) = 0._r8 + mat(k,2562) = 0._r8 + mat(k,2563) = 0._r8 + mat(k,2568) = 0._r8 + mat(k,2570) = 0._r8 + mat(k,2572) = 0._r8 + mat(k,2574) = 0._r8 + mat(k,2576) = 0._r8 + mat(k,2577) = 0._r8 + mat(k,2578) = 0._r8 mat(k,2582) = 0._r8 mat(k,2583) = 0._r8 - mat(k,2590) = 0._r8 - mat(k,2593) = 0._r8 - mat(k,2594) = 0._r8 - mat(k,2595) = 0._r8 + mat(k,2584) = 0._r8 + mat(k,2596) = 0._r8 + mat(k,2598) = 0._r8 mat(k,2599) = 0._r8 - mat(k,2629) = 0._r8 - mat(k,2630) = 0._r8 - mat(k,2637) = 0._r8 - mat(k,2640) = 0._r8 - mat(k,2641) = 0._r8 - mat(k,2642) = 0._r8 + mat(k,2602) = 0._r8 + mat(k,2608) = 0._r8 + mat(k,2611) = 0._r8 + mat(k,2643) = 0._r8 + mat(k,2649) = 0._r8 + mat(k,2651) = 0._r8 + mat(k,2654) = 0._r8 + mat(k,2658) = 0._r8 + mat(k,2659) = 0._r8 mat(k,2661) = 0._r8 + mat(k,2662) = 0._r8 + mat(k,2664) = 0._r8 + mat(k,2665) = 0._r8 + mat(k,2666) = 0._r8 mat(k,2668) = 0._r8 + mat(k,2670) = 0._r8 + mat(k,2671) = 0._r8 mat(k,2672) = 0._r8 - mat(k,2673) = 0._r8 mat(k,2674) = 0._r8 - mat(k,2700) = 0._r8 - mat(k,2701) = 0._r8 - mat(k,2704) = 0._r8 + mat(k,2675) = 0._r8 + mat(k,2677) = 0._r8 + mat(k,2680) = 0._r8 + mat(k,2683) = 0._r8 + mat(k,2684) = 0._r8 + mat(k,2685) = 0._r8 + mat(k,2688) = 0._r8 + mat(k,2689) = 0._r8 + mat(k,2693) = 0._r8 + mat(k,2696) = 0._r8 + mat(k,2697) = 0._r8 + mat(k,2698) = 0._r8 + mat(k,2699) = 0._r8 mat(k,2708) = 0._r8 + mat(k,2709) = 0._r8 mat(k,2711) = 0._r8 - mat(k,2712) = 0._r8 mat(k,2713) = 0._r8 mat(k,2716) = 0._r8 - mat(k,2718) = 0._r8 mat(k,2720) = 0._r8 - mat(k,2721) = 0._r8 - mat(k,2722) = 0._r8 - mat(k,2725) = 0._r8 mat(k,2726) = 0._r8 - mat(k,2729) = 0._r8 - mat(k,2732) = 0._r8 - mat(k,2733) = 0._r8 - mat(k,2735) = 0._r8 - mat(k,2737) = 0._r8 - mat(k,2739) = 0._r8 + mat(k,2727) = 0._r8 + mat(k,2736) = 0._r8 + mat(k,2738) = 0._r8 mat(k,2740) = 0._r8 + mat(k,2747) = 0._r8 + mat(k,2749) = 0._r8 + mat(k,2758) = 0._r8 + mat(k,2760) = 0._r8 + mat(k,2769) = 0._r8 + mat(k,2771) = 0._r8 + mat(k,2772) = 0._r8 + mat(k,2781) = 0._r8 + mat(k,2783) = 0._r8 mat(k,2789) = 0._r8 - mat(k,2808) = 0._r8 + mat(k,2791) = 0._r8 + mat(k,2793) = 0._r8 + mat(k,2797) = 0._r8 + mat(k,2800) = 0._r8 + mat(k,2801) = 0._r8 + mat(k,2802) = 0._r8 + mat(k,2811) = 0._r8 + mat(k,2812) = 0._r8 + mat(k,2814) = 0._r8 mat(k,2816) = 0._r8 + mat(k,2819) = 0._r8 mat(k,2823) = 0._r8 - mat(k,2825) = 0._r8 - mat(k,2855) = 0._r8 - mat(k,2883) = 0._r8 - mat(k,2884) = 0._r8 - mat(k,2888) = 0._r8 - mat(k,2896) = 0._r8 - mat(k,2899) = 0._r8 - mat(k,2914) = 0._r8 - mat(k,2923) = 0._r8 - mat(k,2928) = 0._r8 - mat(k,2934) = 0._r8 - mat(k,2937) = 0._r8 - mat(k,2939) = 0._r8 - mat(k,2941) = 0._r8 - mat(k,2942) = 0._r8 - mat(k,2944) = 0._r8 - mat(k,2945) = 0._r8 - mat(k,2947) = 0._r8 - mat(k,2949) = 0._r8 - mat(k,2950) = 0._r8 - mat(k,2952) = 0._r8 + mat(k,2858) = 0._r8 + mat(k,2860) = 0._r8 + mat(k,2862) = 0._r8 + mat(k,2865) = 0._r8 + mat(k,2869) = 0._r8 + mat(k,2873) = 0._r8 + mat(k,2905) = 0._r8 + mat(k,2907) = 0._r8 + mat(k,2909) = 0._r8 + mat(k,2912) = 0._r8 + mat(k,2916) = 0._r8 + mat(k,2951) = 0._r8 mat(k,2953) = 0._r8 - mat(k,2954) = 0._r8 - mat(k,2957) = 0._r8 - mat(k,2961) = 0._r8 + mat(k,2955) = 0._r8 + mat(k,2958) = 0._r8 mat(k,2962) = 0._r8 - mat(k,2963) = 0._r8 - mat(k,2964) = 0._r8 - mat(k,2966) = 0._r8 - mat(k,2967) = 0._r8 - mat(k,2969) = 0._r8 - mat(k,2970) = 0._r8 - mat(k,2971) = 0._r8 - mat(k,2972) = 0._r8 - mat(k,2973) = 0._r8 - mat(k,2974) = 0._r8 - mat(k,2977) = 0._r8 - mat(k,2978) = 0._r8 - mat(k,2982) = 0._r8 - mat(k,2984) = 0._r8 - mat(k,2997) = 0._r8 + mat(k,2979) = 0._r8 + mat(k,2986) = 0._r8 + mat(k,2989) = 0._r8 + mat(k,2994) = 0._r8 + mat(k,2995) = 0._r8 mat(k,3000) = 0._r8 - mat(k,3006) = 0._r8 - mat(k,3009) = 0._r8 - mat(k,3014) = 0._r8 - mat(k,3015) = 0._r8 - mat(k,3016) = 0._r8 - mat(k,3020) = 0._r8 - mat(k,3024) = 0._r8 + mat(k,3012) = 0._r8 + mat(k,3013) = 0._r8 mat(k,3025) = 0._r8 - mat(k,3028) = 0._r8 - mat(k,3030) = 0._r8 + mat(k,3027) = 0._r8 + mat(k,3029) = 0._r8 mat(k,3032) = 0._r8 mat(k,3033) = 0._r8 mat(k,3036) = 0._r8 - mat(k,3038) = 0._r8 - mat(k,3039) = 0._r8 - mat(k,3040) = 0._r8 - mat(k,3041) = 0._r8 - mat(k,3043) = 0._r8 - mat(k,3044) = 0._r8 - mat(k,3045) = 0._r8 - mat(k,3048) = 0._r8 - mat(k,3049) = 0._r8 - mat(k,3050) = 0._r8 - mat(k,3077) = 0._r8 + mat(k,3051) = 0._r8 + mat(k,3057) = 0._r8 + mat(k,3062) = 0._r8 + mat(k,3071) = 0._r8 + mat(k,3075) = 0._r8 + mat(k,3076) = 0._r8 mat(k,3079) = 0._r8 - mat(k,3081) = 0._r8 + mat(k,3080) = 0._r8 + mat(k,3082) = 0._r8 mat(k,3083) = 0._r8 - mat(k,3089) = 0._r8 + mat(k,3084) = 0._r8 + mat(k,3085) = 0._r8 + mat(k,3086) = 0._r8 + mat(k,3087) = 0._r8 mat(k,3090) = 0._r8 mat(k,3091) = 0._r8 mat(k,3092) = 0._r8 + mat(k,3098) = 0._r8 mat(k,3100) = 0._r8 + mat(k,3103) = 0._r8 mat(k,3104) = 0._r8 + mat(k,3107) = 0._r8 + mat(k,3108) = 0._r8 + mat(k,3109) = 0._r8 + mat(k,3110) = 0._r8 mat(k,3111) = 0._r8 - mat(k,3137) = 0._r8 - mat(k,3151) = 0._r8 - mat(k,3153) = 0._r8 - mat(k,3205) = 0._r8 - mat(k,3209) = 0._r8 - mat(k,3219) = 0._r8 - mat(k,3231) = 0._r8 - mat(k,3239) = 0._r8 - mat(k,3243) = 0._r8 - mat(k,3252) = 0._r8 - mat(k,3253) = 0._r8 - mat(k,3254) = 0._r8 - mat(k,3279) = 0._r8 - mat(k,3284) = 0._r8 - mat(k,3305) = 0._r8 - mat(k,3306) = 0._r8 - mat(k,3308) = 0._r8 - mat(k,3309) = 0._r8 + mat(k,3112) = 0._r8 + mat(k,3118) = 0._r8 + mat(k,3119) = 0._r8 + mat(k,3120) = 0._r8 + mat(k,3122) = 0._r8 + mat(k,3124) = 0._r8 + mat(k,3128) = 0._r8 + mat(k,3130) = 0._r8 + mat(k,3139) = 0._r8 + mat(k,3145) = 0._r8 + mat(k,3146) = 0._r8 + mat(k,3150) = 0._r8 + mat(k,3152) = 0._r8 + mat(k,3154) = 0._r8 + mat(k,3156) = 0._r8 + mat(k,3159) = 0._r8 + mat(k,3160) = 0._r8 + mat(k,3161) = 0._r8 + mat(k,3229) = 0._r8 + mat(k,3242) = 0._r8 + mat(k,3245) = 0._r8 + mat(k,3248) = 0._r8 + mat(k,3268) = 0._r8 + mat(k,3283) = 0._r8 + mat(k,3296) = 0._r8 + mat(k,3298) = 0._r8 mat(k,3310) = 0._r8 + mat(k,3312) = 0._r8 mat(k,3321) = 0._r8 mat(k,3324) = 0._r8 mat(k,3325) = 0._r8 - mat(k,3331) = 0._r8 + mat(k,3326) = 0._r8 + mat(k,3327) = 0._r8 + mat(k,3328) = 0._r8 + mat(k,3329) = 0._r8 + mat(k,3330) = 0._r8 mat(k,3332) = 0._r8 + mat(k,3333) = 0._r8 mat(k,3334) = 0._r8 mat(k,3336) = 0._r8 mat(k,3338) = 0._r8 - mat(k,3340) = 0._r8 mat(k,3343) = 0._r8 + mat(k,3344) = 0._r8 + mat(k,3345) = 0._r8 + mat(k,3349) = 0._r8 + mat(k,3350) = 0._r8 + mat(k,3352) = 0._r8 + mat(k,3353) = 0._r8 mat(k,3354) = 0._r8 - mat(k,3357) = 0._r8 - mat(k,3360) = 0._r8 - mat(k,3362) = 0._r8 - mat(k,3363) = 0._r8 - mat(k,3371) = 0._r8 + mat(k,3356) = 0._r8 + mat(k,3364) = 0._r8 + mat(k,3365) = 0._r8 + mat(k,3368) = 0._r8 mat(k,3373) = 0._r8 mat(k,3380) = 0._r8 - mat(k,3381) = 0._r8 + mat(k,3384) = 0._r8 mat(k,3388) = 0._r8 - mat(k,3392) = 0._r8 - mat(k,3420) = 0._r8 - mat(k,3421) = 0._r8 - mat(k,3423) = 0._r8 - mat(k,3424) = 0._r8 - mat(k,3425) = 0._r8 - mat(k,3430) = 0._r8 - mat(k,3433) = 0._r8 + mat(k,3395) = 0._r8 + mat(k,3397) = 0._r8 + mat(k,3416) = 0._r8 + mat(k,3432) = 0._r8 mat(k,3434) = 0._r8 - mat(k,3436) = 0._r8 - mat(k,3438) = 0._r8 - mat(k,3443) = 0._r8 - mat(k,3450) = 0._r8 - mat(k,3455) = 0._r8 - mat(k,3459) = 0._r8 - mat(k,3466) = 0._r8 - mat(k,3479) = 0._r8 - mat(k,3483) = 0._r8 mat(k,3485) = 0._r8 - mat(k,3486) = 0._r8 - mat(k,3490) = 0._r8 - mat(k,3491) = 0._r8 - mat(k,3492) = 0._r8 - mat(k,3493) = 0._r8 - mat(k,3494) = 0._r8 - mat(k,3495) = 0._r8 - mat(k,3501) = 0._r8 - mat(k,3505) = 0._r8 - mat(k,3508) = 0._r8 - mat(k,3509) = 0._r8 - mat(k,3513) = 0._r8 - mat(k,3515) = 0._r8 - mat(k,3516) = 0._r8 - mat(k,3580) = 0._r8 - mat(k,3624) = 0._r8 - mat(k,3627) = 0._r8 - mat(k,3631) = 0._r8 - mat(k,3639) = 0._r8 - mat(k,3695) = 0._r8 + mat(k,3500) = 0._r8 + mat(k,3510) = 0._r8 + mat(k,3520) = 0._r8 + mat(k,3523) = 0._r8 + mat(k,3532) = 0._r8 + mat(k,3533) = 0._r8 + mat(k,3534) = 0._r8 + mat(k,3539) = 0._r8 + mat(k,3554) = 0._r8 + mat(k,3568) = 0._r8 + mat(k,3646) = 0._r8 + mat(k,3693) = 0._r8 mat(k,3696) = 0._r8 - mat(k,3703) = 0._r8 - mat(k,3708) = 0._r8 - mat(k,3718) = 0._r8 - mat(k,3720) = 0._r8 - mat(k,3728) = 0._r8 + mat(k,3699) = 0._r8 mat(k,3730) = 0._r8 - mat(k,3745) = 0._r8 - mat(k,3762) = 0._r8 - mat(k,3765) = 0._r8 - mat(k,3766) = 0._r8 mat(k,3768) = 0._r8 mat(k,3770) = 0._r8 - mat(k,3771) = 0._r8 + mat(k,3772) = 0._r8 mat(k,3773) = 0._r8 - mat(k,3776) = 0._r8 - mat(k,3786) = 0._r8 - mat(k,3787) = 0._r8 - mat(k,3789) = 0._r8 - mat(k,3790) = 0._r8 + mat(k,3788) = 0._r8 mat(k,3791) = 0._r8 - mat(k,3794) = 0._r8 - mat(k,3795) = 0._r8 mat(k,3799) = 0._r8 - mat(k,3802) = 0._r8 - mat(k,3807) = 0._r8 - mat(k,3809) = 0._r8 - mat(k,3810) = 0._r8 - mat(k,3813) = 0._r8 - mat(k,3815) = 0._r8 - mat(k,3817) = 0._r8 - mat(k,3820) = 0._r8 - mat(k,3821) = 0._r8 - mat(k,3823) = 0._r8 - mat(k,3826) = 0._r8 - mat(k,3831) = 0._r8 - mat(k,3832) = 0._r8 - mat(k,3835) = 0._r8 - mat(k,3837) = 0._r8 + mat(k,3804) = 0._r8 + mat(k,3806) = 0._r8 + mat(k,3836) = 0._r8 + mat(k,3840) = 0._r8 + mat(k,3841) = 0._r8 mat(k,3842) = 0._r8 mat(k,3844) = 0._r8 mat(k,3845) = 0._r8 - mat(k,3846) = 0._r8 - mat(k,3848) = 0._r8 - mat(k,3849) = 0._r8 - mat(k,3850) = 0._r8 - mat(k,3852) = 0._r8 - mat(k,3853) = 0._r8 + mat(k,3847) = 0._r8 + mat(k,3851) = 0._r8 mat(k,3854) = 0._r8 mat(k,3855) = 0._r8 - mat(k,3857) = 0._r8 + mat(k,3858) = 0._r8 mat(k,3859) = 0._r8 - mat(k,3860) = 0._r8 mat(k,3861) = 0._r8 + mat(k,3867) = 0._r8 + mat(k,3868) = 0._r8 + mat(k,3874) = 0._r8 + mat(k,3876) = 0._r8 + mat(k,3881) = 0._r8 + mat(k,3882) = 0._r8 + mat(k,3886) = 0._r8 + mat(k,3887) = 0._r8 + mat(k,3892) = 0._r8 + mat(k,3893) = 0._r8 + mat(k,3896) = 0._r8 + mat(k,3901) = 0._r8 + mat(k,3903) = 0._r8 + mat(k,3904) = 0._r8 + mat(k,3905) = 0._r8 + mat(k,3906) = 0._r8 + mat(k,3907) = 0._r8 + mat(k,3908) = 0._r8 + mat(k,3909) = 0._r8 + mat(k,3912) = 0._r8 + mat(k,3913) = 0._r8 + mat(k,3914) = 0._r8 + mat(k,3917) = 0._r8 + mat(k,3918) = 0._r8 + mat(k,3921) = 0._r8 + mat(k,3924) = 0._r8 + mat(k,3936) = 0._r8 + mat(k,3937) = 0._r8 + mat(k,3938) = 0._r8 + mat(k,3939) = 0._r8 + mat(k,3950) = 0._r8 + mat(k,3951) = 0._r8 + mat(k,3958) = 0._r8 + mat(k,3962) = 0._r8 + mat(k,3971) = 0._r8 + mat(k,3976) = 0._r8 + mat(k,3977) = 0._r8 + mat(k,3979) = 0._r8 + mat(k,3980) = 0._r8 + mat(k,3989) = 0._r8 + mat(k,3990) = 0._r8 + mat(k,3995) = 0._r8 + mat(k,3999) = 0._r8 + mat(k,4003) = 0._r8 + mat(k,4006) = 0._r8 + mat(k,4017) = 0._r8 + mat(k,4029) = 0._r8 + mat(k,4031) = 0._r8 + mat(k,4042) = 0._r8 + mat(k,4043) = 0._r8 + mat(k,4045) = 0._r8 + mat(k,4047) = 0._r8 + mat(k,4051) = 0._r8 + mat(k,4054) = 0._r8 + mat(k,4068) = 0._r8 + mat(k,4072) = 0._r8 + mat(k,4074) = 0._r8 + mat(k,4076) = 0._r8 + mat(k,4078) = 0._r8 + mat(k,4080) = 0._r8 + mat(k,4081) = 0._r8 + mat(k,4082) = 0._r8 + mat(k,4083) = 0._r8 + mat(k,4084) = 0._r8 + mat(k,4086) = 0._r8 + mat(k,4088) = 0._r8 + mat(k,4089) = 0._r8 + mat(k,4095) = 0._r8 + mat(k,4098) = 0._r8 + mat(k,4102) = 0._r8 + mat(k,4104) = 0._r8 + mat(k,4106) = 0._r8 + mat(k,4110) = 0._r8 + mat(k,4112) = 0._r8 + mat(k,4114) = 0._r8 + mat(k,4115) = 0._r8 + mat(k,4116) = 0._r8 + mat(k,4118) = 0._r8 + mat(k,4120) = 0._r8 + mat(k,4121) = 0._r8 + mat(k,4122) = 0._r8 + mat(k,4123) = 0._r8 + mat(k,4124) = 0._r8 + mat(k,4126) = 0._r8 + mat(k,4128) = 0._r8 + mat(k,4129) = 0._r8 + mat(k,4130) = 0._r8 + mat(k,4131) = 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) @@ -6214,258 +6653,287 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 32) = mat(k, 32) - dti(k) mat(k, 33) = mat(k, 33) - 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, 37) = mat(k, 37) - dti(k) + mat(k, 38) = mat(k, 38) - dti(k) + mat(k, 39) = mat(k, 39) - dti(k) mat(k, 40) = mat(k, 40) - dti(k) - mat(k, 46) = mat(k, 46) - dti(k) - mat(k, 52) = mat(k, 52) - dti(k) - mat(k, 58) = mat(k, 58) - dti(k) - mat(k, 64) = mat(k, 64) - dti(k) - mat(k, 70) = mat(k, 70) - dti(k) - mat(k, 76) = mat(k, 76) - dti(k) - mat(k, 78) = mat(k, 78) - dti(k) - mat(k, 84) = mat(k, 84) - dti(k) - mat(k, 90) = mat(k, 90) - dti(k) - mat(k, 96) = mat(k, 96) - dti(k) - mat(k, 102) = mat(k, 102) - dti(k) - mat(k, 103) = mat(k, 103) - dti(k) - mat(k, 106) = mat(k, 106) - dti(k) - mat(k, 109) = mat(k, 109) - dti(k) + mat(k, 41) = mat(k, 41) - dti(k) + mat(k, 42) = mat(k, 42) - dti(k) + mat(k, 43) = mat(k, 43) - dti(k) + mat(k, 49) = mat(k, 49) - dti(k) + mat(k, 55) = mat(k, 55) - dti(k) + mat(k, 61) = mat(k, 61) - dti(k) + mat(k, 67) = mat(k, 67) - dti(k) + mat(k, 73) = mat(k, 73) - dti(k) + mat(k, 79) = mat(k, 79) - dti(k) + mat(k, 85) = mat(k, 85) - dti(k) + mat(k, 87) = mat(k, 87) - dti(k) + mat(k, 93) = mat(k, 93) - dti(k) + mat(k, 99) = mat(k, 99) - dti(k) + mat(k, 105) = mat(k, 105) - dti(k) + mat(k, 111) = mat(k, 111) - dti(k) mat(k, 112) = mat(k, 112) - dti(k) - mat(k, 116) = mat(k, 116) - dti(k) - mat(k, 119) = mat(k, 119) - dti(k) - mat(k, 122) = mat(k, 122) - dti(k) - mat(k, 125) = mat(k, 125) - dti(k) + mat(k, 115) = mat(k, 115) - dti(k) + mat(k, 118) = mat(k, 118) - dti(k) + mat(k, 121) = mat(k, 121) - dti(k) + mat(k, 124) = mat(k, 124) - dti(k) mat(k, 128) = mat(k, 128) - dti(k) - mat(k, 131) = mat(k, 131) - dti(k) - mat(k, 137) = mat(k, 137) - dti(k) - mat(k, 141) = mat(k, 141) - dti(k) - mat(k, 146) = mat(k, 146) - dti(k) - mat(k, 150) = mat(k, 150) - dti(k) - mat(k, 153) = mat(k, 153) - dti(k) - mat(k, 156) = mat(k, 156) - dti(k) - mat(k, 161) = mat(k, 161) - dti(k) - mat(k, 168) = mat(k, 168) - dti(k) - mat(k, 173) = mat(k, 173) - dti(k) - mat(k, 179) = mat(k, 179) - dti(k) - mat(k, 187) = mat(k, 187) - dti(k) - mat(k, 192) = mat(k, 192) - dti(k) + mat(k, 132) = mat(k, 132) - dti(k) + mat(k, 136) = mat(k, 136) - dti(k) + mat(k, 140) = mat(k, 140) - dti(k) + mat(k, 144) = mat(k, 144) - dti(k) + mat(k, 148) = mat(k, 148) - dti(k) + mat(k, 151) = mat(k, 151) - dti(k) + mat(k, 154) = mat(k, 154) - dti(k) + mat(k, 157) = mat(k, 157) - dti(k) + mat(k, 162) = mat(k, 162) - dti(k) + mat(k, 167) = mat(k, 167) - dti(k) + mat(k, 172) = mat(k, 172) - dti(k) + mat(k, 177) = mat(k, 177) - dti(k) + mat(k, 180) = mat(k, 180) - dti(k) + mat(k, 186) = mat(k, 186) - dti(k) + mat(k, 190) = mat(k, 190) - dti(k) mat(k, 195) = mat(k, 195) - dti(k) - mat(k, 198) = mat(k, 198) - dti(k) - mat(k, 201) = mat(k, 201) - dti(k) - mat(k, 204) = mat(k, 204) - dti(k) - mat(k, 207) = mat(k, 207) - dti(k) - mat(k, 210) = mat(k, 210) - dti(k) - mat(k, 214) = mat(k, 214) - dti(k) - mat(k, 218) = mat(k, 218) - dti(k) - mat(k, 222) = mat(k, 222) - dti(k) - mat(k, 226) = mat(k, 226) - dti(k) - mat(k, 230) = mat(k, 230) - dti(k) - mat(k, 234) = mat(k, 234) - dti(k) - mat(k, 238) = mat(k, 238) - dti(k) - mat(k, 244) = mat(k, 244) - dti(k) - mat(k, 250) = mat(k, 250) - dti(k) - mat(k, 253) = mat(k, 253) - dti(k) - mat(k, 259) = mat(k, 259) - dti(k) - mat(k, 265) = mat(k, 265) - dti(k) - mat(k, 270) = mat(k, 270) - dti(k) - mat(k, 275) = mat(k, 275) - dti(k) + mat(k, 199) = mat(k, 199) - dti(k) + mat(k, 202) = mat(k, 202) - dti(k) + mat(k, 205) = mat(k, 205) - dti(k) + mat(k, 209) = mat(k, 209) - dti(k) + mat(k, 216) = mat(k, 216) - dti(k) + mat(k, 221) = mat(k, 221) - dti(k) + mat(k, 227) = mat(k, 227) - dti(k) + mat(k, 235) = mat(k, 235) - dti(k) + mat(k, 240) = mat(k, 240) - dti(k) + mat(k, 243) = mat(k, 243) - dti(k) + mat(k, 246) = mat(k, 246) - dti(k) + mat(k, 251) = mat(k, 251) - dti(k) + mat(k, 255) = mat(k, 255) - dti(k) + mat(k, 260) = mat(k, 260) - dti(k) + mat(k, 263) = mat(k, 263) - dti(k) + mat(k, 266) = mat(k, 266) - dti(k) + mat(k, 269) = mat(k, 269) - dti(k) + mat(k, 272) = mat(k, 272) - dti(k) + mat(k, 276) = mat(k, 276) - dti(k) mat(k, 280) = mat(k, 280) - dti(k) - mat(k, 286) = mat(k, 286) - dti(k) - mat(k, 291) = mat(k, 291) - dti(k) - mat(k, 296) = mat(k, 296) - dti(k) - mat(k, 300) = mat(k, 300) - dti(k) + mat(k, 284) = mat(k, 284) - dti(k) + mat(k, 288) = mat(k, 288) - dti(k) + mat(k, 292) = mat(k, 292) - dti(k) + mat(k, 298) = mat(k, 298) - dti(k) + mat(k, 302) = mat(k, 302) - dti(k) mat(k, 308) = mat(k, 308) - dti(k) - mat(k, 316) = mat(k, 316) - dti(k) - mat(k, 322) = mat(k, 322) - dti(k) - mat(k, 328) = mat(k, 328) - dti(k) - mat(k, 332) = mat(k, 332) - dti(k) - mat(k, 338) = mat(k, 338) - dti(k) + mat(k, 314) = mat(k, 314) - dti(k) + mat(k, 320) = mat(k, 320) - dti(k) + mat(k, 326) = mat(k, 326) - dti(k) + mat(k, 329) = mat(k, 329) - dti(k) + mat(k, 334) = mat(k, 334) - dti(k) + mat(k, 339) = mat(k, 339) - dti(k) mat(k, 344) = mat(k, 344) - dti(k) mat(k, 350) = mat(k, 350) - dti(k) - mat(k, 358) = mat(k, 358) - dti(k) - mat(k, 364) = mat(k, 364) - dti(k) + mat(k, 355) = mat(k, 355) - dti(k) + mat(k, 360) = mat(k, 360) - dti(k) + mat(k, 365) = mat(k, 365) - dti(k) mat(k, 370) = mat(k, 370) - dti(k) - mat(k, 377) = mat(k, 377) - dti(k) - mat(k, 383) = mat(k, 383) - dti(k) - mat(k, 386) = mat(k, 386) - dti(k) - mat(k, 391) = mat(k, 391) - dti(k) + mat(k, 374) = mat(k, 374) - dti(k) + mat(k, 382) = mat(k, 382) - dti(k) + mat(k, 390) = mat(k, 390) - dti(k) mat(k, 398) = mat(k, 398) - dti(k) - mat(k, 405) = mat(k, 405) - dti(k) - mat(k, 409) = mat(k, 409) - dti(k) - mat(k, 419) = mat(k, 419) - dti(k) + mat(k, 402) = mat(k, 402) - dti(k) + mat(k, 408) = mat(k, 408) - dti(k) + mat(k, 414) = mat(k, 414) - dti(k) + mat(k, 420) = mat(k, 420) - dti(k) mat(k, 426) = mat(k, 426) - dti(k) - mat(k, 435) = mat(k, 435) - dti(k) - mat(k, 443) = mat(k, 443) - dti(k) - mat(k, 450) = mat(k, 450) - dti(k) - mat(k, 455) = mat(k, 455) - dti(k) - mat(k, 462) = mat(k, 462) - dti(k) + mat(k, 432) = mat(k, 432) - dti(k) + mat(k, 440) = mat(k, 440) - dti(k) + mat(k, 446) = mat(k, 446) - dti(k) + mat(k, 453) = mat(k, 453) - dti(k) + mat(k, 459) = mat(k, 459) - dti(k) + mat(k, 465) = mat(k, 465) - dti(k) mat(k, 468) = mat(k, 468) - dti(k) mat(k, 474) = mat(k, 474) - dti(k) - mat(k, 482) = mat(k, 482) - dti(k) - mat(k, 490) = mat(k, 490) - dti(k) + mat(k, 481) = mat(k, 481) - dti(k) + mat(k, 488) = mat(k, 488) - dti(k) mat(k, 498) = mat(k, 498) - dti(k) - mat(k, 506) = mat(k, 506) - dti(k) - mat(k, 514) = mat(k, 514) - dti(k) - mat(k, 522) = mat(k, 522) - dti(k) - mat(k, 526) = mat(k, 526) - dti(k) - mat(k, 530) = mat(k, 530) - dti(k) - mat(k, 534) = mat(k, 534) - dti(k) - mat(k, 542) = mat(k, 542) - dti(k) - mat(k, 554) = mat(k, 554) - dti(k) + mat(k, 505) = mat(k, 505) - dti(k) + mat(k, 509) = mat(k, 509) - dti(k) + mat(k, 516) = mat(k, 516) - dti(k) + mat(k, 525) = mat(k, 525) - dti(k) + mat(k, 533) = mat(k, 533) - dti(k) + mat(k, 540) = mat(k, 540) - dti(k) + mat(k, 547) = mat(k, 547) - dti(k) + mat(k, 553) = mat(k, 553) - dti(k) + mat(k, 558) = mat(k, 558) - dti(k) mat(k, 566) = mat(k, 566) - dti(k) - mat(k, 573) = mat(k, 573) - dti(k) + mat(k, 574) = mat(k, 574) - dti(k) mat(k, 582) = mat(k, 582) - dti(k) - mat(k, 589) = mat(k, 589) - dti(k) - mat(k, 593) = mat(k, 593) - dti(k) - mat(k, 604) = mat(k, 604) - dti(k) - mat(k, 613) = mat(k, 613) - dti(k) - mat(k, 623) = mat(k, 623) - dti(k) - mat(k, 634) = mat(k, 634) - dti(k) - mat(k, 645) = mat(k, 645) - dti(k) - mat(k, 656) = mat(k, 656) - dti(k) - mat(k, 663) = mat(k, 663) - dti(k) - mat(k, 671) = mat(k, 671) - dti(k) - mat(k, 680) = mat(k, 680) - dti(k) - mat(k, 688) = mat(k, 688) - dti(k) - mat(k, 696) = mat(k, 696) - dti(k) - mat(k, 710) = mat(k, 710) - dti(k) - mat(k, 721) = mat(k, 721) - dti(k) - mat(k, 731) = mat(k, 731) - dti(k) - mat(k, 744) = mat(k, 744) - dti(k) - mat(k, 751) = mat(k, 751) - dti(k) - mat(k, 762) = mat(k, 762) - dti(k) - mat(k, 778) = mat(k, 778) - dti(k) + mat(k, 590) = mat(k, 590) - dti(k) + mat(k, 598) = mat(k, 598) - dti(k) + mat(k, 602) = mat(k, 602) - dti(k) + mat(k, 610) = mat(k, 610) - dti(k) + mat(k, 619) = mat(k, 619) - dti(k) + mat(k, 632) = mat(k, 632) - dti(k) + mat(k, 639) = mat(k, 639) - dti(k) + mat(k, 648) = mat(k, 648) - dti(k) + mat(k, 657) = mat(k, 657) - dti(k) + mat(k, 666) = mat(k, 666) - dti(k) + mat(k, 673) = mat(k, 673) - dti(k) + mat(k, 678) = mat(k, 678) - dti(k) + mat(k, 691) = mat(k, 691) - dti(k) + mat(k, 700) = mat(k, 700) - dti(k) + mat(k, 709) = mat(k, 709) - dti(k) + mat(k, 716) = mat(k, 716) - dti(k) + mat(k, 727) = mat(k, 727) - dti(k) + mat(k, 738) = mat(k, 738) - dti(k) + mat(k, 748) = mat(k, 748) - dti(k) + mat(k, 758) = mat(k, 758) - dti(k) + mat(k, 768) = mat(k, 768) - dti(k) + mat(k, 773) = mat(k, 773) - dti(k) + mat(k, 781) = mat(k, 781) - dti(k) mat(k, 789) = mat(k, 789) - dti(k) - mat(k, 797) = mat(k, 797) - dti(k) - mat(k, 802) = mat(k, 802) - dti(k) - mat(k, 807) = mat(k, 807) - dti(k) - mat(k, 812) = mat(k, 812) - dti(k) - mat(k, 822) = mat(k, 822) - dti(k) - mat(k, 834) = mat(k, 834) - dti(k) - mat(k, 843) = mat(k, 843) - dti(k) + mat(k, 795) = mat(k, 795) - dti(k) + mat(k, 803) = mat(k, 803) - dti(k) + mat(k, 811) = mat(k, 811) - dti(k) + mat(k, 819) = mat(k, 819) - dti(k) + mat(k, 829) = mat(k, 829) - dti(k) + mat(k, 846) = mat(k, 846) - dti(k) mat(k, 859) = mat(k, 859) - dti(k) - mat(k, 871) = mat(k, 871) - dti(k) - mat(k, 876) = mat(k, 876) - dti(k) - mat(k, 888) = mat(k, 888) - dti(k) - mat(k, 897) = mat(k, 897) - dti(k) - mat(k, 906) = mat(k, 906) - dti(k) + mat(k, 866) = mat(k, 866) - dti(k) + mat(k, 877) = mat(k, 877) - dti(k) + mat(k, 893) = mat(k, 893) - dti(k) + mat(k, 904) = mat(k, 904) - dti(k) + mat(k, 912) = mat(k, 912) - dti(k) mat(k, 917) = mat(k, 917) - dti(k) - mat(k, 926) = mat(k, 926) - dti(k) - mat(k, 941) = mat(k, 941) - dti(k) - mat(k, 961) = mat(k, 961) - dti(k) - mat(k, 975) = mat(k, 975) - dti(k) - mat(k, 985) = mat(k, 985) - dti(k) - mat(k, 995) = mat(k, 995) - dti(k) - mat(k, 999) = mat(k, 999) - dti(k) - mat(k,1010) = mat(k,1010) - dti(k) - mat(k,1021) = mat(k,1021) - dti(k) - mat(k,1032) = mat(k,1032) - dti(k) - mat(k,1039) = mat(k,1039) - dti(k) - mat(k,1048) = mat(k,1048) - dti(k) - mat(k,1064) = mat(k,1064) - dti(k) - mat(k,1071) = mat(k,1071) - dti(k) - mat(k,1083) = mat(k,1083) - dti(k) - mat(k,1102) = mat(k,1102) - dti(k) - mat(k,1118) = mat(k,1118) - dti(k) - mat(k,1124) = mat(k,1124) - dti(k) - mat(k,1132) = mat(k,1132) - dti(k) - mat(k,1144) = mat(k,1144) - dti(k) - mat(k,1154) = mat(k,1154) - dti(k) - mat(k,1161) = mat(k,1161) - dti(k) - mat(k,1167) = mat(k,1167) - dti(k) - mat(k,1176) = mat(k,1176) - dti(k) - mat(k,1180) = mat(k,1180) - dti(k) - mat(k,1197) = mat(k,1197) - dti(k) - mat(k,1213) = mat(k,1213) - dti(k) - mat(k,1224) = mat(k,1224) - dti(k) - mat(k,1236) = mat(k,1236) - dti(k) - mat(k,1243) = mat(k,1243) - dti(k) - mat(k,1255) = mat(k,1255) - dti(k) - mat(k,1270) = mat(k,1270) - dti(k) - mat(k,1285) = mat(k,1285) - dti(k) - mat(k,1305) = mat(k,1305) - dti(k) - mat(k,1315) = mat(k,1315) - dti(k) - mat(k,1329) = mat(k,1329) - dti(k) - mat(k,1336) = mat(k,1336) - dti(k) - mat(k,1343) = mat(k,1343) - dti(k) - mat(k,1349) = mat(k,1349) - dti(k) - mat(k,1356) = mat(k,1356) - dti(k) - mat(k,1360) = mat(k,1360) - dti(k) - mat(k,1370) = mat(k,1370) - dti(k) - mat(k,1383) = mat(k,1383) - dti(k) - mat(k,1396) = mat(k,1396) - dti(k) - mat(k,1404) = mat(k,1404) - dti(k) - mat(k,1416) = mat(k,1416) - dti(k) - mat(k,1439) = mat(k,1439) - dti(k) - mat(k,1463) = mat(k,1463) - dti(k) - mat(k,1469) = mat(k,1469) - dti(k) - mat(k,1480) = mat(k,1480) - dti(k) - mat(k,1497) = mat(k,1497) - dti(k) - mat(k,1513) = mat(k,1513) - dti(k) - mat(k,1529) = mat(k,1529) - dti(k) - mat(k,1540) = mat(k,1540) - dti(k) - mat(k,1550) = mat(k,1550) - dti(k) - mat(k,1571) = mat(k,1571) - dti(k) - mat(k,1590) = mat(k,1590) - dti(k) - mat(k,1603) = mat(k,1603) - dti(k) + mat(k, 922) = mat(k, 922) - dti(k) + mat(k, 932) = mat(k, 932) - dti(k) + mat(k, 944) = mat(k, 944) - dti(k) + mat(k, 953) = mat(k, 953) - dti(k) + mat(k, 962) = mat(k, 962) - dti(k) + mat(k, 967) = mat(k, 967) - dti(k) + mat(k, 972) = mat(k, 972) - dti(k) + mat(k, 984) = mat(k, 984) - dti(k) + mat(k, 993) = mat(k, 993) - dti(k) + mat(k,1004) = mat(k,1004) - dti(k) + mat(k,1013) = mat(k,1013) - dti(k) + mat(k,1028) = mat(k,1028) - dti(k) + mat(k,1042) = mat(k,1042) - dti(k) + mat(k,1052) = mat(k,1052) - dti(k) + mat(k,1069) = mat(k,1069) - dti(k) + mat(k,1090) = mat(k,1090) - dti(k) + mat(k,1104) = mat(k,1104) - dti(k) + mat(k,1108) = mat(k,1108) - dti(k) + mat(k,1119) = mat(k,1119) - dti(k) + mat(k,1130) = mat(k,1130) - dti(k) + mat(k,1142) = mat(k,1142) - dti(k) + mat(k,1149) = mat(k,1149) - dti(k) + mat(k,1156) = mat(k,1156) - dti(k) + mat(k,1164) = mat(k,1164) - dti(k) + mat(k,1178) = mat(k,1178) - dti(k) + mat(k,1198) = mat(k,1198) - dti(k) + mat(k,1208) = mat(k,1208) - dti(k) + mat(k,1216) = mat(k,1216) - dti(k) + mat(k,1226) = mat(k,1226) - dti(k) + mat(k,1233) = mat(k,1233) - dti(k) + mat(k,1246) = mat(k,1246) - dti(k) + mat(k,1264) = mat(k,1264) - dti(k) + mat(k,1278) = mat(k,1278) - dti(k) + mat(k,1287) = mat(k,1287) - dti(k) + mat(k,1296) = mat(k,1296) - dti(k) + mat(k,1307) = mat(k,1307) - dti(k) + mat(k,1323) = mat(k,1323) - dti(k) + mat(k,1334) = mat(k,1334) - dti(k) + mat(k,1348) = mat(k,1348) - dti(k) + mat(k,1357) = mat(k,1357) - dti(k) + mat(k,1365) = mat(k,1365) - dti(k) + mat(k,1390) = mat(k,1390) - dti(k) + mat(k,1413) = mat(k,1413) - dti(k) + mat(k,1429) = mat(k,1429) - dti(k) + mat(k,1438) = mat(k,1438) - dti(k) + mat(k,1452) = mat(k,1452) - dti(k) + mat(k,1459) = mat(k,1459) - dti(k) + mat(k,1466) = mat(k,1466) - dti(k) + mat(k,1474) = mat(k,1474) - dti(k) + mat(k,1479) = mat(k,1479) - dti(k) + mat(k,1485) = mat(k,1485) - dti(k) + mat(k,1492) = mat(k,1492) - dti(k) + mat(k,1496) = mat(k,1496) - dti(k) + mat(k,1506) = mat(k,1506) - dti(k) + mat(k,1522) = mat(k,1522) - dti(k) + mat(k,1534) = mat(k,1534) - dti(k) + mat(k,1541) = mat(k,1541) - dti(k) + mat(k,1555) = mat(k,1555) - dti(k) + mat(k,1570) = mat(k,1570) - dti(k) + mat(k,1598) = mat(k,1598) - dti(k) mat(k,1611) = mat(k,1611) - dti(k) - mat(k,1620) = mat(k,1620) - dti(k) - mat(k,1635) = mat(k,1635) - dti(k) - mat(k,1645) = mat(k,1645) - dti(k) - mat(k,1667) = mat(k,1667) - dti(k) - mat(k,1685) = mat(k,1685) - dti(k) + mat(k,1618) = mat(k,1618) - dti(k) + mat(k,1638) = mat(k,1638) - dti(k) + mat(k,1657) = mat(k,1657) - dti(k) + mat(k,1671) = mat(k,1671) - dti(k) + mat(k,1687) = mat(k,1687) - dti(k) mat(k,1700) = mat(k,1700) - dti(k) - mat(k,1729) = mat(k,1729) - dti(k) - mat(k,1751) = mat(k,1751) - dti(k) - mat(k,1780) = mat(k,1780) - dti(k) - mat(k,1801) = mat(k,1801) - dti(k) - mat(k,1829) = mat(k,1829) - dti(k) - mat(k,1845) = mat(k,1845) - dti(k) - mat(k,1863) = mat(k,1863) - dti(k) - mat(k,1896) = mat(k,1896) - dti(k) - mat(k,1930) = mat(k,1930) - dti(k) - mat(k,1964) = mat(k,1964) - dti(k) - mat(k,1993) = mat(k,1993) - dti(k) - mat(k,2034) = mat(k,2034) - dti(k) - mat(k,2053) = mat(k,2053) - dti(k) - mat(k,2072) = mat(k,2072) - dti(k) - mat(k,2096) = mat(k,2096) - dti(k) - mat(k,2119) = mat(k,2119) - dti(k) - mat(k,2141) = mat(k,2141) - dti(k) - mat(k,2156) = mat(k,2156) - dti(k) - mat(k,2179) = mat(k,2179) - dti(k) - mat(k,2193) = mat(k,2193) - dti(k) - mat(k,2214) = mat(k,2214) - dti(k) - mat(k,2243) = mat(k,2243) - dti(k) - mat(k,2271) = mat(k,2271) - dti(k) - mat(k,2303) = mat(k,2303) - dti(k) - mat(k,2332) = mat(k,2332) - dti(k) - mat(k,2364) = mat(k,2364) - dti(k) - mat(k,2392) = mat(k,2392) - dti(k) - mat(k,2420) = mat(k,2420) - dti(k) - mat(k,2445) = mat(k,2445) - dti(k) - mat(k,2467) = mat(k,2467) - dti(k) - mat(k,2489) = mat(k,2489) - dti(k) - mat(k,2532) = mat(k,2532) - dti(k) - mat(k,2579) = mat(k,2579) - dti(k) - mat(k,2627) = mat(k,2627) - dti(k) - mat(k,2699) = mat(k,2699) - dti(k) - mat(k,2717) = mat(k,2717) - dti(k) - mat(k,2730) = mat(k,2730) - dti(k) - mat(k,2885) = mat(k,2885) - dti(k) - mat(k,2987) = mat(k,2987) - dti(k) - mat(k,3080) = mat(k,3080) - dti(k) - mat(k,3105) = mat(k,3105) - dti(k) - mat(k,3285) = mat(k,3285) - dti(k) - mat(k,3312) = mat(k,3312) - dti(k) - mat(k,3337) = mat(k,3337) - dti(k) - mat(k,3429) = mat(k,3429) - dti(k) - mat(k,3460) = mat(k,3460) - dti(k) - mat(k,3511) = mat(k,3511) - dti(k) - mat(k,3752) = mat(k,3752) - dti(k) - mat(k,3775) = mat(k,3775) - dti(k) - mat(k,3800) = mat(k,3800) - dti(k) - mat(k,3836) = mat(k,3836) - dti(k) - mat(k,3862) = mat(k,3862) - dti(k) + mat(k,1710) = mat(k,1710) - dti(k) + mat(k,1716) = mat(k,1716) - dti(k) + mat(k,1725) = mat(k,1725) - dti(k) + mat(k,1740) = mat(k,1740) - dti(k) + mat(k,1756) = mat(k,1756) - dti(k) + mat(k,1769) = mat(k,1769) - dti(k) + mat(k,1791) = mat(k,1791) - dti(k) + mat(k,1815) = mat(k,1815) - dti(k) + mat(k,1846) = mat(k,1846) - dti(k) + mat(k,1870) = mat(k,1870) - dti(k) + mat(k,1894) = mat(k,1894) - dti(k) + mat(k,1909) = mat(k,1909) - dti(k) + mat(k,1918) = mat(k,1918) - dti(k) + mat(k,1929) = mat(k,1929) - dti(k) + mat(k,1959) = mat(k,1959) - dti(k) + mat(k,1997) = mat(k,1997) - dti(k) + mat(k,2022) = mat(k,2022) - dti(k) + mat(k,2047) = mat(k,2047) - dti(k) + mat(k,2078) = mat(k,2078) - dti(k) + mat(k,2110) = mat(k,2110) - dti(k) + mat(k,2140) = mat(k,2140) - dti(k) + mat(k,2180) = mat(k,2180) - dti(k) + mat(k,2199) = mat(k,2199) - dti(k) + mat(k,2213) = mat(k,2213) - dti(k) + mat(k,2235) = mat(k,2235) - dti(k) + mat(k,2259) = mat(k,2259) - dti(k) + mat(k,2277) = mat(k,2277) - dti(k) + mat(k,2296) = mat(k,2296) - dti(k) + mat(k,2322) = mat(k,2322) - dti(k) + mat(k,2349) = mat(k,2349) - dti(k) + mat(k,2366) = mat(k,2366) - dti(k) + mat(k,2381) = mat(k,2381) - dti(k) + mat(k,2411) = mat(k,2411) - dti(k) + mat(k,2437) = mat(k,2437) - dti(k) + mat(k,2466) = mat(k,2466) - dti(k) + mat(k,2499) = mat(k,2499) - dti(k) + mat(k,2530) = mat(k,2530) - dti(k) + mat(k,2555) = mat(k,2555) - dti(k) + mat(k,2573) = mat(k,2573) - dti(k) + mat(k,2597) = mat(k,2597) - dti(k) + mat(k,2639) = mat(k,2639) - dti(k) + mat(k,2663) = mat(k,2663) - dti(k) + mat(k,2700) = mat(k,2700) - dti(k) + mat(k,2728) = mat(k,2728) - dti(k) + mat(k,2751) = mat(k,2751) - dti(k) + mat(k,2775) = mat(k,2775) - dti(k) + mat(k,2806) = mat(k,2806) - dti(k) + mat(k,2853) = mat(k,2853) - dti(k) + mat(k,2901) = mat(k,2901) - dti(k) + mat(k,2948) = mat(k,2948) - dti(k) + mat(k,3023) = mat(k,3023) - dti(k) + mat(k,3127) = mat(k,3127) - dti(k) + mat(k,3151) = mat(k,3151) - dti(k) + mat(k,3311) = mat(k,3311) - dti(k) + mat(k,3331) = mat(k,3331) - dti(k) + mat(k,3358) = mat(k,3358) - dti(k) + mat(k,3390) = mat(k,3390) - dti(k) + mat(k,3571) = mat(k,3571) - dti(k) + mat(k,3822) = mat(k,3822) - dti(k) + mat(k,3864) = mat(k,3864) - dti(k) + mat(k,3959) = mat(k,3959) - dti(k) + mat(k,4052) = mat(k,4052) - dti(k) + mat(k,4105) = mat(k,4105) - dti(k) + mat(k,4132) = mat(k,4132) - dti(k) end do end subroutine nlnmat_finit subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/mo_prod_loss.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/mo_prod_loss.F90 index d573bf3b24..b35f6910be 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/mo_prod_loss.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/mo_prod_loss.F90 @@ -27,78 +27,10 @@ subroutine exp_prod_loss( ofl, ofu, prod, loss, y, & ! ... loss and production for Explicit method !-------------------------------------------------------------------- do k = ofl,ofu - loss(k,1) = ( + het_rates(k,3))* y(k,3) + loss(k,1) = ( + het_rates(k,231))* y(k,231) prod(k,1) = 0._r8 - loss(k,2) = ( + het_rates(k,22))* y(k,22) + loss(k,2) = ( + het_rates(k,232))* y(k,232) prod(k,2) = 0._r8 - loss(k,3) = (rxt(k,243)* y(k,292) + rxt(k,122) + het_rates(k,34))* y(k,34) - prod(k,3) = 0._r8 - loss(k,4) = (rxt(k,244)* y(k,292) + rxt(k,123) + het_rates(k,35))* y(k,35) - prod(k,4) = 0._r8 - loss(k,5) = (rxt(k,270)* y(k,292) + rxt(k,124) + het_rates(k,36))* y(k,36) - prod(k,5) = 0._r8 - loss(k,6) = (rxt(k,245)* y(k,292) + rxt(k,125) + het_rates(k,37))* y(k,37) - prod(k,6) = 0._r8 - loss(k,7) = (rxt(k,246)* y(k,292) + rxt(k,126) + het_rates(k,38))* y(k,38) - prod(k,7) = 0._r8 - loss(k,8) = (rxt(k,247)* y(k,292) + rxt(k,127) + het_rates(k,39))* y(k,39) - prod(k,8) = 0._r8 - loss(k,9) = (rxt(k,248)* y(k,292) + rxt(k,128) + het_rates(k,40))* y(k,40) - prod(k,9) = 0._r8 - loss(k,10) = (rxt(k,249)* y(k,292) + rxt(k,129) + het_rates(k,41))* y(k,41) - prod(k,10) = 0._r8 - loss(k,11) = (rxt(k,281)* y(k,57) +rxt(k,293)* y(k,292) +rxt(k,282)* y(k,293) & - + rxt(k,130) + het_rates(k,42))* y(k,42) - prod(k,11) = 0._r8 - loss(k,12) = (rxt(k,283)* y(k,57) +rxt(k,294)* y(k,292) +rxt(k,284)* y(k,293) & - + rxt(k,131) + het_rates(k,44))* y(k,44) - prod(k,12) = 0._r8 - loss(k,13) = (rxt(k,285)* y(k,293) + rxt(k,132) + het_rates(k,45))* y(k,45) - prod(k,13) = 0._r8 - loss(k,14) = (rxt(k,286)* y(k,57) +rxt(k,287)* y(k,293) + rxt(k,133) & - + het_rates(k,47))* y(k,47) - prod(k,14) = 0._r8 - loss(k,15) = (rxt(k,219)* y(k,57) +rxt(k,275)* y(k,75) + (rxt(k,316) + & - rxt(k,317) +rxt(k,318))* y(k,292) +rxt(k,308)* y(k,293) + rxt(k,38) & - + rxt(k,39) + het_rates(k,55))* y(k,55) - prod(k,15) = 0._r8 - loss(k,16) = (rxt(k,288)* y(k,57) +rxt(k,271)* y(k,292) +rxt(k,289)* y(k,293) & - + rxt(k,134) + het_rates(k,56))* y(k,56) - prod(k,16) = 0._r8 - loss(k,17) = ( + het_rates(k,62))* y(k,62) - prod(k,17) = 0._r8 - loss(k,18) = ( + rxt(k,40) + het_rates(k,64))* y(k,64) - prod(k,18) =.440_r8*rxt(k,39)*y(k,55) - loss(k,19) = ( + rxt(k,902) + het_rates(k,73))* y(k,73) - prod(k,19) = 0._r8 - loss(k,20) = (rxt(k,272)* y(k,292) + rxt(k,142) + het_rates(k,80))* y(k,80) - prod(k,20) = 0._r8 - loss(k,21) = (rxt(k,295)* y(k,292) +rxt(k,290)* y(k,293) + rxt(k,144) & - + het_rates(k,84))* y(k,84) - prod(k,21) = 0._r8 - loss(k,22) = (rxt(k,296)* y(k,292) +rxt(k,291)* y(k,293) + rxt(k,145) & - + het_rates(k,85))* y(k,85) - prod(k,22) = 0._r8 - loss(k,23) = (rxt(k,297)* y(k,292) +rxt(k,292)* y(k,293) + rxt(k,146) & - + het_rates(k,86))* y(k,86) - prod(k,23) = 0._r8 - loss(k,24) = ((rxt(k,210) +rxt(k,211))* y(k,292) + rxt(k,12) & - + het_rates(k,137))* y(k,137) - prod(k,24) = 0._r8 - loss(k,25) = ( + rxt(k,904) + het_rates(k,145))* y(k,145) - prod(k,25) = 0._r8 - loss(k,26) = ( + rxt(k,903) + het_rates(k,146))* y(k,146) - prod(k,26) = 0._r8 - loss(k,27) = ( + het_rates(k,158))* y(k,158) - prod(k,27) = 0._r8 - loss(k,28) = ( + rxt(k,152) + het_rates(k,172))* y(k,172) - prod(k,28) = 0._r8 - loss(k,29) = ( + rxt(k,905) + het_rates(k,195))* y(k,195) - prod(k,29) = 0._r8 - loss(k,30) = ( + het_rates(k,231))* y(k,231) - prod(k,30) = 0._r8 - loss(k,31) = ( + het_rates(k,232))* y(k,232) - prod(k,31) = 0._r8 end do end subroutine exp_prod_loss subroutine imp_prod_loss( avec_len, prod, loss, y, & @@ -123,260 +55,295 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & ! ... loss and production for Implicit method !-------------------------------------------------------------------- do k = 1,avec_len - loss(k,140) = (rxt(k,409)* y(k,293) + rxt(k,19) + het_rates(k,1))* y(k,1) - prod(k,140) =rxt(k,412)*y(k,234)*y(k,147) - loss(k,141) = (rxt(k,413)* y(k,293) + rxt(k,20) + het_rates(k,2))* y(k,2) - prod(k,141) =rxt(k,410)*y(k,256)*y(k,234) - loss(k,185) = (rxt(k,585)* y(k,149) +rxt(k,603)* y(k,157) +rxt(k,604) & - * y(k,293) + het_rates(k,4))* y(k,4) - prod(k,185) = 0._r8 - loss(k,1) = ( + het_rates(k,5))* y(k,5) + loss(k,163) = (rxt(k,408)* y(k,293) + rxt(k,19) + het_rates(k,1))* y(k,1) + prod(k,163) =rxt(k,411)*y(k,234)*y(k,147) + loss(k,164) = (rxt(k,412)* y(k,293) + rxt(k,20) + het_rates(k,2))* y(k,2) + prod(k,164) =rxt(k,409)*y(k,256)*y(k,234) + loss(k,1) = ( + het_rates(k,3))* y(k,3) prod(k,1) = 0._r8 - loss(k,2) = ( + het_rates(k,6))* y(k,6) + loss(k,215) = (rxt(k,584)* y(k,149) +rxt(k,602)* y(k,157) +rxt(k,603) & + * y(k,293) + het_rates(k,4))* y(k,4) + prod(k,215) = 0._r8 + loss(k,2) = ( + het_rates(k,5))* y(k,5) prod(k,2) = 0._r8 - loss(k,163) = (rxt(k,605)* y(k,149) +rxt(k,623)* y(k,157) +rxt(k,624) & + loss(k,3) = ( + het_rates(k,6))* y(k,6) + prod(k,3) = 0._r8 + loss(k,196) = (rxt(k,604)* y(k,149) +rxt(k,622)* y(k,157) +rxt(k,623) & * y(k,293) + het_rates(k,7))* y(k,7) - prod(k,163) = 0._r8 - loss(k,56) = (rxt(k,544)* y(k,293) + het_rates(k,8))* y(k,8) - prod(k,56) = 0._r8 - loss(k,96) = (rxt(k,547)* y(k,293) + rxt(k,21) + het_rates(k,9))* y(k,9) - prod(k,96) =rxt(k,545)*y(k,256)*y(k,241) - loss(k,57) = ( + rxt(k,22) + het_rates(k,10))* y(k,10) - prod(k,57) =.120_r8*rxt(k,544)*y(k,293)*y(k,8) - loss(k,106) = ( + rxt(k,23) + het_rates(k,11))* y(k,11) - prod(k,106) = (.500_r8*rxt(k,546)*y(k,241) +.200_r8*rxt(k,573)*y(k,312) + & - .060_r8*rxt(k,579)*y(k,314))*y(k,147) +.500_r8*rxt(k,21)*y(k,9) & + prod(k,196) = 0._r8 + loss(k,74) = (rxt(k,543)* y(k,293) + het_rates(k,8))* y(k,8) + prod(k,74) = 0._r8 + loss(k,122) = (rxt(k,546)* y(k,293) + rxt(k,21) + het_rates(k,9))* y(k,9) + prod(k,122) =rxt(k,544)*y(k,256)*y(k,241) + loss(k,75) = ( + rxt(k,22) + het_rates(k,10))* y(k,10) + prod(k,75) =.120_r8*rxt(k,543)*y(k,293)*y(k,8) + loss(k,130) = ( + rxt(k,23) + het_rates(k,11))* y(k,11) + prod(k,130) = (.500_r8*rxt(k,545)*y(k,241) +.200_r8*rxt(k,572)*y(k,312) + & + .060_r8*rxt(k,578)*y(k,314))*y(k,147) +.500_r8*rxt(k,21)*y(k,9) & +rxt(k,22)*y(k,10) +.200_r8*rxt(k,115)*y(k,225) +.060_r8*rxt(k,116) & *y(k,228) - loss(k,83) = ( + rxt(k,24) + het_rates(k,12))* y(k,12) - prod(k,83) = (.200_r8*rxt(k,573)*y(k,312) +.200_r8*rxt(k,579)*y(k,314)) & + loss(k,101) = ( + rxt(k,24) + het_rates(k,12))* y(k,12) + prod(k,101) = (.200_r8*rxt(k,572)*y(k,312) +.200_r8*rxt(k,578)*y(k,314)) & *y(k,147) +.200_r8*rxt(k,115)*y(k,225) +.200_r8*rxt(k,116)*y(k,228) - loss(k,97) = ( + rxt(k,25) + het_rates(k,13))* y(k,13) - prod(k,97) = (.200_r8*rxt(k,573)*y(k,312) +.150_r8*rxt(k,579)*y(k,314)) & + loss(k,119) = ( + rxt(k,25) + het_rates(k,13))* y(k,13) + prod(k,119) = (.200_r8*rxt(k,572)*y(k,312) +.150_r8*rxt(k,578)*y(k,314)) & *y(k,147) +.200_r8*rxt(k,115)*y(k,225) +.150_r8*rxt(k,116)*y(k,228) - loss(k,87) = ( + rxt(k,26) + het_rates(k,14))* y(k,14) - prod(k,87) =.210_r8*rxt(k,579)*y(k,314)*y(k,147) +.210_r8*rxt(k,116)*y(k,228) - loss(k,61) = (rxt(k,414)* y(k,293) + het_rates(k,15))* y(k,15) - prod(k,61) =.190_r8*rxt(k,643)*y(k,157)*y(k,17) - loss(k,94) = (rxt(k,375)* y(k,149) +rxt(k,376)* y(k,293) + het_rates(k,16)) & + loss(k,108) = ( + rxt(k,26) + het_rates(k,14))* y(k,14) + prod(k,108) =.210_r8*rxt(k,578)*y(k,314)*y(k,147) +.210_r8*rxt(k,116) & + *y(k,228) + loss(k,79) = (rxt(k,413)* y(k,293) + het_rates(k,15))* y(k,15) + prod(k,79) =.190_r8*rxt(k,642)*y(k,157)*y(k,17) + loss(k,116) = (rxt(k,374)* y(k,149) +rxt(k,375)* y(k,293) + het_rates(k,16)) & * y(k,16) - prod(k,94) = 0._r8 - loss(k,171) = (rxt(k,625)* y(k,149) +rxt(k,643)* y(k,157) +rxt(k,644) & + prod(k,116) = 0._r8 + loss(k,200) = (rxt(k,624)* y(k,149) +rxt(k,642)* y(k,157) +rxt(k,643) & * y(k,293) + het_rates(k,17))* y(k,17) - prod(k,171) = 0._r8 - loss(k,233) = (rxt(k,254)* y(k,43) +rxt(k,256)* y(k,157) +rxt(k,255) & + prod(k,200) = 0._r8 + loss(k,274) = (rxt(k,254)* y(k,43) +rxt(k,256)* y(k,157) +rxt(k,255) & * y(k,256) + het_rates(k,18))* y(k,18) - prod(k,233) = (rxt(k,119) +2.000_r8*rxt(k,257)*y(k,20) +rxt(k,258)*y(k,60) + & + prod(k,274) = (rxt(k,119) +2.000_r8*rxt(k,257)*y(k,20) +rxt(k,258)*y(k,60) + & rxt(k,259)*y(k,60) +rxt(k,262)*y(k,147) +rxt(k,265)*y(k,156) + & rxt(k,266)*y(k,293) +rxt(k,800)*y(k,173))*y(k,20) & + (rxt(k,244)*y(k,35) +rxt(k,270)*y(k,36) + & 3.000_r8*rxt(k,271)*y(k,56) +2.000_r8*rxt(k,272)*y(k,80) + & - 2.000_r8*rxt(k,293)*y(k,42) +rxt(k,294)*y(k,44) +rxt(k,273)*y(k,83)) & - *y(k,292) + (2.000_r8*rxt(k,282)*y(k,42) +rxt(k,284)*y(k,44) + & - 3.000_r8*rxt(k,289)*y(k,56) +rxt(k,268)*y(k,83))*y(k,293) & + rxt(k,273)*y(k,83) +2.000_r8*rxt(k,293)*y(k,42) +rxt(k,294)*y(k,44)) & + *y(k,292) + (rxt(k,268)*y(k,83) +2.000_r8*rxt(k,282)*y(k,42) + & + rxt(k,284)*y(k,44) +3.000_r8*rxt(k,289)*y(k,56))*y(k,293) & + (2.000_r8*rxt(k,281)*y(k,42) +rxt(k,283)*y(k,44) + & 3.000_r8*rxt(k,288)*y(k,56))*y(k,57) + (rxt(k,143) + & rxt(k,267)*y(k,156))*y(k,83) +rxt(k,118)*y(k,19) +rxt(k,121)*y(k,21) & - +rxt(k,149)*y(k,95) - loss(k,69) = ( + rxt(k,118) + het_rates(k,19))* y(k,19) - prod(k,69) = (rxt(k,893)*y(k,95) +rxt(k,898)*y(k,95))*y(k,87) & + +rxt(k,123)*y(k,35) +rxt(k,124)*y(k,36) +2.000_r8*rxt(k,130)*y(k,42) & + +rxt(k,131)*y(k,44) +3.000_r8*rxt(k,134)*y(k,56) & + +2.000_r8*rxt(k,142)*y(k,80) +rxt(k,149)*y(k,95) + loss(k,86) = ( + rxt(k,118) + het_rates(k,19))* y(k,19) + prod(k,86) = (rxt(k,892)*y(k,95) +rxt(k,897)*y(k,95))*y(k,87) & +rxt(k,260)*y(k,60)*y(k,20) - loss(k,284) = (2._r8*rxt(k,257)* y(k,20) + (rxt(k,258) +rxt(k,259) + & + loss(k,289) = (2._r8*rxt(k,257)* y(k,20) + (rxt(k,258) +rxt(k,259) + & rxt(k,260))* y(k,60) +rxt(k,262)* y(k,147) +rxt(k,263)* y(k,148) & +rxt(k,265)* y(k,156) +rxt(k,800)* y(k,173) +rxt(k,261)* y(k,256) & +rxt(k,266)* y(k,293) + rxt(k,119) + het_rates(k,20))* y(k,20) - prod(k,284) = (rxt(k,120) +rxt(k,264)*y(k,156))*y(k,21) +rxt(k,256)*y(k,157) & + prod(k,289) = (rxt(k,120) +rxt(k,264)*y(k,156))*y(k,21) +rxt(k,256)*y(k,157) & *y(k,18) +rxt(k,274)*y(k,292)*y(k,83) +rxt(k,269)*y(k,156)*y(k,95) - loss(k,122) = (rxt(k,264)* y(k,156) + rxt(k,120) + rxt(k,121) + rxt(k,887) & - + rxt(k,890) + rxt(k,895) + het_rates(k,21))* y(k,21) - prod(k,122) =rxt(k,263)*y(k,148)*y(k,20) - loss(k,70) = (rxt(k,548)* y(k,293) + het_rates(k,23))* y(k,23) - prod(k,70) =rxt(k,27)*y(k,24) +rxt(k,551)*y(k,246)*y(k,147) - loss(k,90) = (rxt(k,550)* y(k,293) + rxt(k,27) + het_rates(k,24))* y(k,24) - prod(k,90) =rxt(k,549)*y(k,256)*y(k,246) - loss(k,84) = (rxt(k,321)* y(k,57) +rxt(k,322)* y(k,293) + het_rates(k,25)) & + loss(k,146) = (rxt(k,264)* y(k,156) + rxt(k,120) + rxt(k,121) + rxt(k,886) & + + rxt(k,889) + rxt(k,894) + het_rates(k,21))* y(k,21) + prod(k,146) =rxt(k,263)*y(k,148)*y(k,20) + loss(k,4) = ( + het_rates(k,22))* y(k,22) + prod(k,4) = 0._r8 + loss(k,87) = (rxt(k,547)* y(k,293) + het_rates(k,23))* y(k,23) + prod(k,87) =rxt(k,27)*y(k,24) +rxt(k,550)*y(k,246)*y(k,147) + loss(k,111) = (rxt(k,549)* y(k,293) + rxt(k,27) + het_rates(k,24))* y(k,24) + prod(k,111) =rxt(k,548)*y(k,256)*y(k,246) + loss(k,103) = (rxt(k,320)* y(k,57) +rxt(k,321)* y(k,293) + het_rates(k,25)) & * y(k,25) - prod(k,84) = 0._r8 - loss(k,123) = (rxt(k,323)* y(k,57) +rxt(k,324)* y(k,157) +rxt(k,351) & + prod(k,103) = 0._r8 + loss(k,148) = (rxt(k,322)* y(k,57) +rxt(k,323)* y(k,157) +rxt(k,350) & * y(k,293) + het_rates(k,26))* y(k,26) - prod(k,123) = 0._r8 - loss(k,76) = (rxt(k,329)* y(k,293) + het_rates(k,27))* y(k,27) - prod(k,76) = (.400_r8*rxt(k,325)*y(k,247) +.200_r8*rxt(k,326)*y(k,251)) & + prod(k,148) = 0._r8 + loss(k,97) = (rxt(k,328)* y(k,293) + het_rates(k,27))* y(k,27) + prod(k,97) = (.400_r8*rxt(k,324)*y(k,247) +.200_r8*rxt(k,325)*y(k,251)) & *y(k,247) - loss(k,91) = (rxt(k,330)* y(k,293) + rxt(k,28) + het_rates(k,28))* y(k,28) - prod(k,91) =rxt(k,327)*y(k,256)*y(k,247) - loss(k,85) = (rxt(k,331)* y(k,57) +rxt(k,332)* y(k,293) + het_rates(k,29)) & + loss(k,112) = (rxt(k,329)* y(k,293) + rxt(k,28) + het_rates(k,28))* y(k,28) + prod(k,112) =rxt(k,326)*y(k,256)*y(k,247) + loss(k,104) = (rxt(k,330)* y(k,57) +rxt(k,331)* y(k,293) + het_rates(k,29)) & * y(k,29) - prod(k,85) = 0._r8 - loss(k,195) = (rxt(k,354)* y(k,149) +rxt(k,355)* y(k,157) +rxt(k,373) & + prod(k,104) = 0._r8 + loss(k,225) = (rxt(k,353)* y(k,149) +rxt(k,354)* y(k,157) +rxt(k,372) & * y(k,293) + het_rates(k,30))* y(k,30) - prod(k,195) =.700_r8*rxt(k,79)*y(k,132) - loss(k,99) = (rxt(k,359)* y(k,293) + rxt(k,29) + het_rates(k,31))* y(k,31) - prod(k,99) =rxt(k,357)*y(k,256)*y(k,248) - loss(k,50) = (rxt(k,360)* y(k,293) + het_rates(k,32))* y(k,32) - prod(k,50) = 0._r8 - loss(k,77) = (rxt(k,554)* y(k,293) + rxt(k,30) + het_rates(k,33))* y(k,33) - prod(k,77) =rxt(k,552)*y(k,256)*y(k,249) - loss(k,278) = (rxt(k,254)* y(k,18) +rxt(k,218)* y(k,57) +rxt(k,299)* y(k,149) & + prod(k,225) =.700_r8*rxt(k,79)*y(k,132) + loss(k,121) = (rxt(k,358)* y(k,293) + rxt(k,29) + het_rates(k,31))* y(k,31) + prod(k,121) =rxt(k,356)*y(k,256)*y(k,248) + loss(k,61) = (rxt(k,359)* y(k,293) + het_rates(k,32))* y(k,32) + prod(k,61) = 0._r8 + loss(k,98) = (rxt(k,553)* y(k,293) + rxt(k,30) + het_rates(k,33))* y(k,33) + prod(k,98) =rxt(k,551)*y(k,256)*y(k,249) + loss(k,58) = (rxt(k,243)* y(k,292) + rxt(k,122) + het_rates(k,34))* y(k,34) + prod(k,58) = 0._r8 + loss(k,69) = (rxt(k,244)* y(k,292) + rxt(k,123) + het_rates(k,35))* y(k,35) + prod(k,69) = 0._r8 + loss(k,70) = (rxt(k,270)* y(k,292) + rxt(k,124) + het_rates(k,36))* y(k,36) + prod(k,70) = 0._r8 + loss(k,62) = (rxt(k,245)* y(k,292) + rxt(k,125) + het_rates(k,37))* y(k,37) + prod(k,62) = 0._r8 + loss(k,71) = (rxt(k,246)* y(k,292) + rxt(k,126) + het_rates(k,38))* y(k,38) + prod(k,71) = 0._r8 + loss(k,63) = (rxt(k,247)* y(k,292) + rxt(k,127) + het_rates(k,39))* y(k,39) + prod(k,63) = 0._r8 + loss(k,72) = (rxt(k,248)* y(k,292) + rxt(k,128) + het_rates(k,40))* y(k,40) + prod(k,72) = 0._r8 + loss(k,64) = (rxt(k,249)* y(k,292) + rxt(k,129) + het_rates(k,41))* y(k,41) + prod(k,64) = 0._r8 + loss(k,137) = (rxt(k,281)* y(k,57) +rxt(k,293)* y(k,292) +rxt(k,282) & + * y(k,293) + rxt(k,130) + het_rates(k,42))* y(k,42) + prod(k,137) = 0._r8 + loss(k,307) = (rxt(k,254)* y(k,18) +rxt(k,218)* y(k,57) +rxt(k,299)* y(k,149) & +rxt(k,300)* y(k,156) +rxt(k,298)* y(k,256) +rxt(k,301)* y(k,293) & + rxt(k,31) + rxt(k,32) + het_rates(k,43))* y(k,43) - prod(k,278) = (rxt(k,225)*y(k,60) +2.000_r8*rxt(k,302)*y(k,251) + & + prod(k,307) = (rxt(k,225)*y(k,60) +2.000_r8*rxt(k,302)*y(k,251) + & rxt(k,303)*y(k,251) +rxt(k,305)*y(k,147) + & - .700_r8*rxt(k,326)*y(k,247) +rxt(k,337)*y(k,250) + & - rxt(k,356)*y(k,248) +.800_r8*rxt(k,369)*y(k,296) + & - 1.100_r8*rxt(k,383)*y(k,282) +2.000_r8*rxt(k,390)*y(k,284) + & - .870_r8*rxt(k,402)*y(k,287) +1.750_r8*rxt(k,426)*y(k,259) + & - 1.250_r8*rxt(k,432)*y(k,260) +.750_r8*rxt(k,446)*y(k,265) + & - .750_r8*rxt(k,450)*y(k,266) +.710_r8*rxt(k,476)*y(k,272) + & - .750_r8*rxt(k,493)*y(k,276) +.750_r8*rxt(k,497)*y(k,277) + & - .950_r8*rxt(k,588)*y(k,235) +.830_r8*rxt(k,596)*y(k,236) + & - .950_r8*rxt(k,608)*y(k,238) +.750_r8*rxt(k,616)*y(k,239) + & - .990_r8*rxt(k,628)*y(k,243) +1.400_r8*rxt(k,636)*y(k,244) + & - .910_r8*rxt(k,647)*y(k,279) +1.030_r8*rxt(k,656)*y(k,280) + & - .980_r8*rxt(k,667)*y(k,288) +.750_r8*rxt(k,676)*y(k,289) + & - .750_r8*rxt(k,695)*y(k,299) +rxt(k,703)*y(k,300) + & - rxt(k,711)*y(k,301) +rxt(k,721)*y(k,302) +rxt(k,730)*y(k,303) + & - 3.000_r8*rxt(k,740)*y(k,304) +rxt(k,751)*y(k,305))*y(k,251) & - + (.500_r8*rxt(k,343)*y(k,255) +rxt(k,367)*y(k,295) + & - rxt(k,371)*y(k,296) +.500_r8*rxt(k,378)*y(k,253) + & - rxt(k,393)*y(k,284) +.100_r8*rxt(k,411)*y(k,234) + & - rxt(k,506)*y(k,259) +rxt(k,508)*y(k,260) + & - .060_r8*rxt(k,514)*y(k,267) +.270_r8*rxt(k,516)*y(k,268) + & - rxt(k,518)*y(k,269) +.130_r8*rxt(k,520)*y(k,270) + & - .330_r8*rxt(k,522)*y(k,271) +.460_r8*rxt(k,524)*y(k,272) + & - .530_r8*rxt(k,526)*y(k,273) +.040_r8*rxt(k,528)*y(k,274) + & - .140_r8*rxt(k,536)*y(k,282) +.240_r8*rxt(k,538)*y(k,287) + & - .210_r8*rxt(k,598)*y(k,236) +.020_r8*rxt(k,630)*y(k,243) + & - .490_r8*rxt(k,638)*y(k,244) +.430_r8*rxt(k,658)*y(k,280) + & - .040_r8*rxt(k,670)*y(k,288) +.300_r8*rxt(k,678)*y(k,289) + & - .310_r8*rxt(k,689)*y(k,297) +1.820_r8*rxt(k,742)*y(k,304) + & - .310_r8*rxt(k,762)*y(k,306))*y(k,147) & - + (.150_r8*rxt(k,370)*y(k,296) +.080_r8*rxt(k,384)*y(k,282) + & - .490_r8*rxt(k,391)*y(k,284) +.050_r8*rxt(k,403)*y(k,287) + & - .060_r8*rxt(k,427)*y(k,259) +.060_r8*rxt(k,433)*y(k,260) + & - .030_r8*rxt(k,458)*y(k,267) +.060_r8*rxt(k,462)*y(k,268) + & - .600_r8*rxt(k,465)*y(k,269) +.060_r8*rxt(k,468)*y(k,270) + & - .100_r8*rxt(k,472)*y(k,271) +.240_r8*rxt(k,477)*y(k,272) + & - .170_r8*rxt(k,480)*y(k,273) +.030_r8*rxt(k,483)*y(k,274) + & - .080_r8*rxt(k,597)*y(k,236) +.020_r8*rxt(k,629)*y(k,243) + & - .030_r8*rxt(k,637)*y(k,244) +.060_r8*rxt(k,657)*y(k,280) + & - .020_r8*rxt(k,668)*y(k,288) +.040_r8*rxt(k,677)*y(k,289) + & - .080_r8*rxt(k,688)*y(k,297) +1.060_r8*rxt(k,741)*y(k,304) + & - .040_r8*rxt(k,761)*y(k,306))*y(k,256) + (rxt(k,306)*y(k,53) + & - .300_r8*rxt(k,307)*y(k,54) +.500_r8*rxt(k,312)*y(k,92) + & - .500_r8*rxt(k,341)*y(k,52) +.800_r8*rxt(k,346)*y(k,76) + & - .110_r8*rxt(k,348)*y(k,89) +rxt(k,349)*y(k,150) + & - rxt(k,350)*y(k,162) +.300_r8*rxt(k,364)*y(k,104) + & - .400_r8*rxt(k,409)*y(k,1) +.500_r8*rxt(k,420)*y(k,105) + & - .400_r8*rxt(k,423)*y(k,107) +.590_r8*rxt(k,424)*y(k,108) + & - 2.000_r8*rxt(k,719)*y(k,202) +rxt(k,738)*y(k,204))*y(k,293) & - + (.140_r8*rxt(k,382)*y(k,282) +rxt(k,389)*y(k,284) + & - .250_r8*rxt(k,401)*y(k,287) +rxt(k,425)*y(k,259) + & - rxt(k,431)*y(k,260) +.460_r8*rxt(k,475)*y(k,272) + & - .270_r8*rxt(k,595)*y(k,236) +.020_r8*rxt(k,627)*y(k,243) + & - .650_r8*rxt(k,635)*y(k,244) +.560_r8*rxt(k,655)*y(k,280) + & - .040_r8*rxt(k,666)*y(k,288) +.420_r8*rxt(k,675)*y(k,289) + & - 2.000_r8*rxt(k,739)*y(k,304))*y(k,250) & - + (.500_r8*rxt(k,375)*y(k,16) +rxt(k,394)*y(k,284) + & - .460_r8*rxt(k,479)*y(k,272) +.270_r8*rxt(k,599)*y(k,236) + & - .020_r8*rxt(k,631)*y(k,243) +.650_r8*rxt(k,639)*y(k,244) + & - .560_r8*rxt(k,659)*y(k,280) +.040_r8*rxt(k,671)*y(k,288) + & - .420_r8*rxt(k,679)*y(k,289) +2.000_r8*rxt(k,743)*y(k,304) + & - .440_r8*rxt(k,760)*y(k,210) +.500_r8*rxt(k,765)*y(k,211))*y(k,149) & - + (rxt(k,324)*y(k,26) +.500_r8*rxt(k,355)*y(k,30) + & - .120_r8*rxt(k,386)*y(k,126) +.600_r8*rxt(k,404)*y(k,132) + & - 1.010_r8*rxt(k,487)*y(k,109) +.270_r8*rxt(k,603)*y(k,4) + & - .080_r8*rxt(k,623)*y(k,7) +.810_r8*rxt(k,643)*y(k,17) + & - .330_r8*rxt(k,663)*y(k,125) +.390_r8*rxt(k,683)*y(k,135) + & - .620_r8*rxt(k,763)*y(k,210) +.340_r8*rxt(k,768)*y(k,211))*y(k,157) & + .700_r8*rxt(k,325)*y(k,247) +rxt(k,336)*y(k,250) + & + rxt(k,355)*y(k,248) +.800_r8*rxt(k,368)*y(k,296) + & + 1.100_r8*rxt(k,382)*y(k,282) +2.000_r8*rxt(k,389)*y(k,284) + & + .870_r8*rxt(k,401)*y(k,287) +1.750_r8*rxt(k,425)*y(k,259) + & + 1.250_r8*rxt(k,431)*y(k,260) +.750_r8*rxt(k,445)*y(k,265) + & + .750_r8*rxt(k,449)*y(k,266) +.710_r8*rxt(k,475)*y(k,272) + & + .750_r8*rxt(k,492)*y(k,276) +.750_r8*rxt(k,496)*y(k,277) + & + .950_r8*rxt(k,587)*y(k,235) +.830_r8*rxt(k,595)*y(k,236) + & + .950_r8*rxt(k,607)*y(k,238) +.750_r8*rxt(k,615)*y(k,239) + & + .990_r8*rxt(k,627)*y(k,243) +1.400_r8*rxt(k,635)*y(k,244) + & + .910_r8*rxt(k,646)*y(k,279) +1.030_r8*rxt(k,655)*y(k,280) + & + .980_r8*rxt(k,666)*y(k,288) +.750_r8*rxt(k,675)*y(k,289) + & + .750_r8*rxt(k,694)*y(k,299) +rxt(k,702)*y(k,300) + & + rxt(k,710)*y(k,301) +rxt(k,720)*y(k,302) +rxt(k,729)*y(k,303) + & + 3.000_r8*rxt(k,739)*y(k,304) +rxt(k,750)*y(k,305))*y(k,251) & + + (.500_r8*rxt(k,342)*y(k,255) +rxt(k,366)*y(k,295) + & + rxt(k,370)*y(k,296) +.500_r8*rxt(k,377)*y(k,253) + & + rxt(k,392)*y(k,284) +.100_r8*rxt(k,410)*y(k,234) + & + rxt(k,505)*y(k,259) +rxt(k,507)*y(k,260) + & + .060_r8*rxt(k,513)*y(k,267) +.270_r8*rxt(k,515)*y(k,268) + & + rxt(k,517)*y(k,269) +.130_r8*rxt(k,519)*y(k,270) + & + .330_r8*rxt(k,521)*y(k,271) +.460_r8*rxt(k,523)*y(k,272) + & + .530_r8*rxt(k,525)*y(k,273) +.040_r8*rxt(k,527)*y(k,274) + & + .140_r8*rxt(k,535)*y(k,282) +.240_r8*rxt(k,537)*y(k,287) + & + .210_r8*rxt(k,597)*y(k,236) +.020_r8*rxt(k,629)*y(k,243) + & + .490_r8*rxt(k,637)*y(k,244) +.430_r8*rxt(k,657)*y(k,280) + & + .040_r8*rxt(k,669)*y(k,288) +.300_r8*rxt(k,677)*y(k,289) + & + .310_r8*rxt(k,688)*y(k,297) +1.820_r8*rxt(k,741)*y(k,304) + & + .310_r8*rxt(k,761)*y(k,306))*y(k,147) & + + (.150_r8*rxt(k,369)*y(k,296) +.080_r8*rxt(k,383)*y(k,282) + & + .490_r8*rxt(k,390)*y(k,284) +.050_r8*rxt(k,402)*y(k,287) + & + .060_r8*rxt(k,426)*y(k,259) +.060_r8*rxt(k,432)*y(k,260) + & + .030_r8*rxt(k,457)*y(k,267) +.060_r8*rxt(k,461)*y(k,268) + & + .600_r8*rxt(k,464)*y(k,269) +.060_r8*rxt(k,467)*y(k,270) + & + .100_r8*rxt(k,471)*y(k,271) +.240_r8*rxt(k,476)*y(k,272) + & + .170_r8*rxt(k,479)*y(k,273) +.030_r8*rxt(k,482)*y(k,274) + & + .080_r8*rxt(k,596)*y(k,236) +.020_r8*rxt(k,628)*y(k,243) + & + .030_r8*rxt(k,636)*y(k,244) +.060_r8*rxt(k,656)*y(k,280) + & + .020_r8*rxt(k,667)*y(k,288) +.040_r8*rxt(k,676)*y(k,289) + & + .080_r8*rxt(k,687)*y(k,297) +1.060_r8*rxt(k,740)*y(k,304) + & + .040_r8*rxt(k,760)*y(k,306))*y(k,256) + (rxt(k,306)*y(k,53) + & + .300_r8*rxt(k,307)*y(k,54) +.500_r8*rxt(k,311)*y(k,92) + & + .500_r8*rxt(k,340)*y(k,52) +.800_r8*rxt(k,345)*y(k,76) + & + .110_r8*rxt(k,347)*y(k,89) +rxt(k,348)*y(k,150) + & + rxt(k,349)*y(k,162) +.300_r8*rxt(k,363)*y(k,104) + & + .400_r8*rxt(k,408)*y(k,1) +.500_r8*rxt(k,419)*y(k,105) + & + .400_r8*rxt(k,422)*y(k,107) +.590_r8*rxt(k,423)*y(k,108) + & + 2.000_r8*rxt(k,718)*y(k,202) +rxt(k,737)*y(k,204))*y(k,293) & + + (.140_r8*rxt(k,381)*y(k,282) +rxt(k,388)*y(k,284) + & + .250_r8*rxt(k,400)*y(k,287) +rxt(k,424)*y(k,259) + & + rxt(k,430)*y(k,260) +.460_r8*rxt(k,474)*y(k,272) + & + .270_r8*rxt(k,594)*y(k,236) +.020_r8*rxt(k,626)*y(k,243) + & + .650_r8*rxt(k,634)*y(k,244) +.560_r8*rxt(k,654)*y(k,280) + & + .040_r8*rxt(k,665)*y(k,288) +.420_r8*rxt(k,674)*y(k,289) + & + 2.000_r8*rxt(k,738)*y(k,304))*y(k,250) & + + (.500_r8*rxt(k,374)*y(k,16) +rxt(k,393)*y(k,284) + & + .460_r8*rxt(k,478)*y(k,272) +.270_r8*rxt(k,598)*y(k,236) + & + .020_r8*rxt(k,630)*y(k,243) +.650_r8*rxt(k,638)*y(k,244) + & + .560_r8*rxt(k,658)*y(k,280) +.040_r8*rxt(k,670)*y(k,288) + & + .420_r8*rxt(k,678)*y(k,289) +2.000_r8*rxt(k,742)*y(k,304) + & + .440_r8*rxt(k,759)*y(k,210) +.500_r8*rxt(k,764)*y(k,211))*y(k,149) & + + (rxt(k,323)*y(k,26) +.500_r8*rxt(k,354)*y(k,30) + & + .120_r8*rxt(k,385)*y(k,126) +.600_r8*rxt(k,403)*y(k,132) + & + 1.010_r8*rxt(k,486)*y(k,109) +.270_r8*rxt(k,602)*y(k,4) + & + .080_r8*rxt(k,622)*y(k,7) +.810_r8*rxt(k,642)*y(k,17) + & + .330_r8*rxt(k,662)*y(k,125) +.390_r8*rxt(k,682)*y(k,135) + & + .620_r8*rxt(k,762)*y(k,210) +.340_r8*rxt(k,767)*y(k,211))*y(k,157) & + + (.270_r8*rxt(k,599)*y(k,236) +.020_r8*rxt(k,631)*y(k,243) + & + .650_r8*rxt(k,639)*y(k,244) +.560_r8*rxt(k,659)*y(k,280) + & + .040_r8*rxt(k,671)*y(k,288) +.420_r8*rxt(k,679)*y(k,289) + & + 2.000_r8*rxt(k,743)*y(k,304))*y(k,300) & + (.270_r8*rxt(k,600)*y(k,236) +.020_r8*rxt(k,632)*y(k,243) + & .650_r8*rxt(k,640)*y(k,244) +.560_r8*rxt(k,660)*y(k,280) + & .040_r8*rxt(k,672)*y(k,288) +.420_r8*rxt(k,680)*y(k,289) + & - 2.000_r8*rxt(k,744)*y(k,304))*y(k,300) & + 2.000_r8*rxt(k,744)*y(k,304))*y(k,302) & + (.270_r8*rxt(k,601)*y(k,236) +.020_r8*rxt(k,633)*y(k,243) + & .650_r8*rxt(k,641)*y(k,244) +.560_r8*rxt(k,661)*y(k,280) + & .040_r8*rxt(k,673)*y(k,288) +.420_r8*rxt(k,681)*y(k,289) + & - 2.000_r8*rxt(k,745)*y(k,304))*y(k,302) & - + (.270_r8*rxt(k,602)*y(k,236) +.020_r8*rxt(k,634)*y(k,243) + & - .650_r8*rxt(k,642)*y(k,244) +.560_r8*rxt(k,662)*y(k,280) + & - .040_r8*rxt(k,674)*y(k,288) +.420_r8*rxt(k,682)*y(k,289) + & - 2.000_r8*rxt(k,746)*y(k,304))*y(k,305) + (rxt(k,317)*y(k,292) + & - rxt(k,318)*y(k,292))*y(k,55) + (rxt(k,55) +rxt(k,56))*y(k,104) & - +.100_r8*rxt(k,19)*y(k,1) +.100_r8*rxt(k,20)*y(k,2) +rxt(k,37) & - *y(k,54) +.500_r8*rxt(k,41)*y(k,68) +rxt(k,43)*y(k,76) +rxt(k,45) & - *y(k,89) +rxt(k,46)*y(k,92) +.330_r8*rxt(k,47)*y(k,97) +rxt(k,52) & - *y(k,102) +rxt(k,65)*y(k,116) +rxt(k,66)*y(k,117) +rxt(k,68)*y(k,119) & - +rxt(k,69)*y(k,120) +rxt(k,71)*y(k,123) +rxt(k,72)*y(k,126) & - +.250_r8*rxt(k,74)*y(k,127) +.140_r8*rxt(k,75)*y(k,128) & - +.250_r8*rxt(k,80)*y(k,133) +.440_r8*rxt(k,81)*y(k,134) +rxt(k,83) & - *y(k,150) +rxt(k,84)*y(k,151) +rxt(k,88)*y(k,169) +rxt(k,89)*y(k,170) & - +.040_r8*rxt(k,626)*y(k,243)*y(k,243) +2.000_r8*rxt(k,344)*y(k,254) & - +rxt(k,314)*y(k,257) +rxt(k,428)*y(k,259) +rxt(k,434)*y(k,260) & - +.160_r8*rxt(k,478)*y(k,272)*y(k,272) +2.000_r8*rxt(k,392)*y(k,284) & - *y(k,284) +.060_r8*rxt(k,669)*y(k,288)*y(k,288) - loss(k,203) = (rxt(k,333)* y(k,149) +rxt(k,334)* y(k,293) + rxt(k,33) & + 2.000_r8*rxt(k,745)*y(k,304))*y(k,305) + (.180_r8*rxt(k,39) + & + rxt(k,316)*y(k,292) +rxt(k,317)*y(k,292))*y(k,55) + (rxt(k,55) + & + rxt(k,56))*y(k,104) +.100_r8*rxt(k,19)*y(k,1) +.100_r8*rxt(k,20) & + *y(k,2) +rxt(k,37)*y(k,54) +.500_r8*rxt(k,41)*y(k,68) +rxt(k,43) & + *y(k,76) +rxt(k,45)*y(k,89) +rxt(k,46)*y(k,92) +.330_r8*rxt(k,47) & + *y(k,97) +rxt(k,52)*y(k,102) +rxt(k,65)*y(k,116) +rxt(k,66)*y(k,117) & + +rxt(k,68)*y(k,119) +rxt(k,69)*y(k,120) +rxt(k,71)*y(k,123) & + +rxt(k,72)*y(k,126) +.250_r8*rxt(k,74)*y(k,127) +.140_r8*rxt(k,75) & + *y(k,128) +.250_r8*rxt(k,80)*y(k,133) +.440_r8*rxt(k,81)*y(k,134) & + +rxt(k,83)*y(k,150) +rxt(k,84)*y(k,151) +rxt(k,88)*y(k,169) & + +rxt(k,89)*y(k,170) +.040_r8*rxt(k,625)*y(k,243)*y(k,243) & + +2.000_r8*rxt(k,343)*y(k,254) +rxt(k,313)*y(k,257) +rxt(k,427) & + *y(k,259) +rxt(k,433)*y(k,260) +.160_r8*rxt(k,477)*y(k,272)*y(k,272) & + +2.000_r8*rxt(k,391)*y(k,284)*y(k,284) +.060_r8*rxt(k,668)*y(k,288) & + *y(k,288) + loss(k,154) = (rxt(k,283)* y(k,57) +rxt(k,294)* y(k,292) +rxt(k,284) & + * y(k,293) + rxt(k,131) + het_rates(k,44))* y(k,44) + prod(k,154) = 0._r8 + loss(k,65) = (rxt(k,285)* y(k,293) + rxt(k,132) + het_rates(k,45))* y(k,45) + prod(k,65) = 0._r8 + loss(k,228) = (rxt(k,332)* y(k,149) +rxt(k,333)* y(k,293) + rxt(k,33) & + het_rates(k,46))* y(k,46) - prod(k,203) = (rxt(k,328)*y(k,247) +.270_r8*rxt(k,358)*y(k,248) + & - rxt(k,367)*y(k,295) +rxt(k,378)*y(k,253) +rxt(k,396)*y(k,286) + & - .400_r8*rxt(k,411)*y(k,234))*y(k,147) + (rxt(k,329)*y(k,27) + & - .500_r8*rxt(k,330)*y(k,28) +.800_r8*rxt(k,409)*y(k,1))*y(k,293) & - + (.500_r8*rxt(k,355)*y(k,30) +.100_r8*rxt(k,404)*y(k,132))*y(k,157) & - + (1.600_r8*rxt(k,325)*y(k,247) +.800_r8*rxt(k,326)*y(k,251)) & + prod(k,228) = (rxt(k,327)*y(k,247) +.270_r8*rxt(k,357)*y(k,248) + & + rxt(k,366)*y(k,295) +rxt(k,377)*y(k,253) +rxt(k,395)*y(k,286) + & + .400_r8*rxt(k,410)*y(k,234))*y(k,147) + (rxt(k,328)*y(k,27) + & + .500_r8*rxt(k,329)*y(k,28) +.800_r8*rxt(k,408)*y(k,1))*y(k,293) & + + (.500_r8*rxt(k,354)*y(k,30) +.100_r8*rxt(k,403)*y(k,132))*y(k,157) & + + (1.600_r8*rxt(k,324)*y(k,247) +.800_r8*rxt(k,325)*y(k,251)) & *y(k,247) +.400_r8*rxt(k,19)*y(k,1) +.400_r8*rxt(k,20)*y(k,2) & - +rxt(k,375)*y(k,149)*y(k,16) +rxt(k,28)*y(k,28) +.330_r8*rxt(k,47) & + +rxt(k,374)*y(k,149)*y(k,16) +rxt(k,28)*y(k,28) +.330_r8*rxt(k,47) & *y(k,97) +rxt(k,77)*y(k,130) +rxt(k,88)*y(k,169) & - +.200_r8*rxt(k,395)*y(k,286)*y(k,256) - loss(k,48) = (rxt(k,335)* y(k,293) + het_rates(k,48))* y(k,48) - prod(k,48) = 0._r8 - loss(k,251) = (rxt(k,374)* y(k,293) + rxt(k,34) + het_rates(k,49))* y(k,49) - prod(k,251) = (.910_r8*rxt(k,666)*y(k,250) +.740_r8*rxt(k,667)*y(k,251) + & - .460_r8*rxt(k,668)*y(k,256) +1.480_r8*rxt(k,669)*y(k,288) + & - .850_r8*rxt(k,670)*y(k,147) +.910_r8*rxt(k,671)*y(k,149) + & - .910_r8*rxt(k,672)*y(k,300) +.910_r8*rxt(k,673)*y(k,302) + & - .910_r8*rxt(k,674)*y(k,305))*y(k,288) & - + (.120_r8*rxt(k,595)*y(k,250) +.060_r8*rxt(k,596)*y(k,251) + & - .060_r8*rxt(k,597)*y(k,256) +.090_r8*rxt(k,598)*y(k,147) + & - .120_r8*rxt(k,599)*y(k,149) +.120_r8*rxt(k,600)*y(k,300) + & - .120_r8*rxt(k,601)*y(k,302) +.120_r8*rxt(k,602)*y(k,305))*y(k,236) & - + (rxt(k,729)*y(k,250) +rxt(k,730)*y(k,251) + & - .150_r8*rxt(k,731)*y(k,256) +.700_r8*rxt(k,732)*y(k,147) + & - rxt(k,733)*y(k,149) +rxt(k,734)*y(k,300) +rxt(k,735)*y(k,302) + & - rxt(k,736)*y(k,305))*y(k,303) + (.110_r8*rxt(k,635)*y(k,250) + & - .080_r8*rxt(k,636)*y(k,251) +.080_r8*rxt(k,638)*y(k,147) + & - .110_r8*rxt(k,639)*y(k,149) +.110_r8*rxt(k,640)*y(k,300) + & - .110_r8*rxt(k,641)*y(k,302) +.110_r8*rxt(k,642)*y(k,305))*y(k,244) & - + (.460_r8*rxt(k,675)*y(k,250) +.050_r8*rxt(k,677)*y(k,256) + & - .330_r8*rxt(k,678)*y(k,147) +.460_r8*rxt(k,679)*y(k,149) + & - .460_r8*rxt(k,680)*y(k,300) +.460_r8*rxt(k,681)*y(k,302) + & - .460_r8*rxt(k,682)*y(k,305))*y(k,289) & - + (.820_r8*rxt(k,358)*y(k,248) +.500_r8*rxt(k,378)*y(k,253) + & - .250_r8*rxt(k,411)*y(k,234))*y(k,147) + (.250_r8*rxt(k,19) + & - .800_r8*rxt(k,409)*y(k,293))*y(k,1) + (.820_r8*rxt(k,356)*y(k,248) + & - .100_r8*rxt(k,383)*y(k,282))*y(k,251) +.250_r8*rxt(k,20)*y(k,2) & - +.500_r8*rxt(k,375)*y(k,149)*y(k,16) +.820_r8*rxt(k,29)*y(k,31) & - +.170_r8*rxt(k,47)*y(k,97) +.250_r8*rxt(k,683)*y(k,157)*y(k,135) & - +rxt(k,719)*y(k,293)*y(k,202) - loss(k,240) = (rxt(k,361)* y(k,149) +rxt(k,362)* y(k,293) + rxt(k,35) & + +.200_r8*rxt(k,394)*y(k,286)*y(k,256) + loss(k,118) = (rxt(k,286)* y(k,57) +rxt(k,287)* y(k,293) + rxt(k,133) & + + het_rates(k,47))* y(k,47) + prod(k,118) = 0._r8 + loss(k,59) = (rxt(k,334)* y(k,293) + het_rates(k,48))* y(k,48) + prod(k,59) = 0._r8 + loss(k,278) = (rxt(k,373)* y(k,293) + rxt(k,34) + het_rates(k,49))* y(k,49) + prod(k,278) = (.910_r8*rxt(k,665)*y(k,250) +.740_r8*rxt(k,666)*y(k,251) + & + .460_r8*rxt(k,667)*y(k,256) +1.480_r8*rxt(k,668)*y(k,288) + & + .850_r8*rxt(k,669)*y(k,147) +.910_r8*rxt(k,670)*y(k,149) + & + .910_r8*rxt(k,671)*y(k,300) +.910_r8*rxt(k,672)*y(k,302) + & + .910_r8*rxt(k,673)*y(k,305))*y(k,288) & + + (.120_r8*rxt(k,594)*y(k,250) +.060_r8*rxt(k,595)*y(k,251) + & + .060_r8*rxt(k,596)*y(k,256) +.090_r8*rxt(k,597)*y(k,147) + & + .120_r8*rxt(k,598)*y(k,149) +.120_r8*rxt(k,599)*y(k,300) + & + .120_r8*rxt(k,600)*y(k,302) +.120_r8*rxt(k,601)*y(k,305))*y(k,236) & + + (rxt(k,728)*y(k,250) +rxt(k,729)*y(k,251) + & + .150_r8*rxt(k,730)*y(k,256) +.700_r8*rxt(k,731)*y(k,147) + & + rxt(k,732)*y(k,149) +rxt(k,733)*y(k,300) +rxt(k,734)*y(k,302) + & + rxt(k,735)*y(k,305))*y(k,303) + (.110_r8*rxt(k,634)*y(k,250) + & + .080_r8*rxt(k,635)*y(k,251) +.080_r8*rxt(k,637)*y(k,147) + & + .110_r8*rxt(k,638)*y(k,149) +.110_r8*rxt(k,639)*y(k,300) + & + .110_r8*rxt(k,640)*y(k,302) +.110_r8*rxt(k,641)*y(k,305))*y(k,244) & + + (.460_r8*rxt(k,674)*y(k,250) +.050_r8*rxt(k,676)*y(k,256) + & + .330_r8*rxt(k,677)*y(k,147) +.460_r8*rxt(k,678)*y(k,149) + & + .460_r8*rxt(k,679)*y(k,300) +.460_r8*rxt(k,680)*y(k,302) + & + .460_r8*rxt(k,681)*y(k,305))*y(k,289) & + + (.820_r8*rxt(k,357)*y(k,248) +.500_r8*rxt(k,377)*y(k,253) + & + .250_r8*rxt(k,410)*y(k,234))*y(k,147) + (.250_r8*rxt(k,19) + & + .800_r8*rxt(k,408)*y(k,293))*y(k,1) + (.820_r8*rxt(k,355)*y(k,248) + & + .100_r8*rxt(k,382)*y(k,282))*y(k,251) +.250_r8*rxt(k,20)*y(k,2) & + +.500_r8*rxt(k,374)*y(k,149)*y(k,16) +.820_r8*rxt(k,29)*y(k,31) & + +.170_r8*rxt(k,47)*y(k,97) +.250_r8*rxt(k,682)*y(k,157)*y(k,135) & + +rxt(k,718)*y(k,293)*y(k,202) + loss(k,263) = (rxt(k,360)* y(k,149) +rxt(k,361)* y(k,293) + rxt(k,35) & + het_rates(k,50))* y(k,50) - prod(k,240) = (rxt(k,363)*y(k,102) +.700_r8*rxt(k,364)*y(k,104) + & - rxt(k,365)*y(k,151) +.440_r8*rxt(k,406)*y(k,134) + & - .380_r8*rxt(k,415)*y(k,98) +.030_r8*rxt(k,416)*y(k,99) + & - .460_r8*rxt(k,419)*y(k,103) +.500_r8*rxt(k,420)*y(k,105) + & - .400_r8*rxt(k,423)*y(k,107) +.720_r8*rxt(k,457)*y(k,114))*y(k,293) & - + (.710_r8*rxt(k,504)*y(k,258) +.140_r8*rxt(k,536)*y(k,282) + & - .240_r8*rxt(k,538)*y(k,287) +.120_r8*rxt(k,540)*y(k,291) + & - .170_r8*rxt(k,557)*y(k,252) +.170_r8*rxt(k,563)*y(k,285) + & - .400_r8*rxt(k,573)*y(k,312) +.540_r8*rxt(k,579)*y(k,314) + & - .510_r8*rxt(k,582)*y(k,316))*y(k,147) & - + (.880_r8*rxt(k,386)*y(k,126) +.500_r8*rxt(k,404)*y(k,132) + & - .170_r8*rxt(k,460)*y(k,115) +.170_r8*rxt(k,470)*y(k,118) + & - .170_r8*rxt(k,485)*y(k,121) +.340_r8*rxt(k,502)*y(k,139))*y(k,157) & - + (.080_r8*rxt(k,384)*y(k,282) +.050_r8*rxt(k,403)*y(k,287) + & - .460_r8*rxt(k,422)*y(k,258) +.100_r8*rxt(k,500)*y(k,291) + & - .070_r8*rxt(k,556)*y(k,252) +.070_r8*rxt(k,562)*y(k,285))*y(k,256) & - + (.140_r8*rxt(k,382)*y(k,282) +.250_r8*rxt(k,401)*y(k,287)) & - *y(k,250) + (.500_r8*rxt(k,369)*y(k,296) + & - .120_r8*rxt(k,402)*y(k,287))*y(k,251) +rxt(k,26)*y(k,14) & + prod(k,263) = (rxt(k,362)*y(k,102) +.700_r8*rxt(k,363)*y(k,104) + & + rxt(k,364)*y(k,151) +.440_r8*rxt(k,405)*y(k,134) + & + .380_r8*rxt(k,414)*y(k,98) +.030_r8*rxt(k,415)*y(k,99) + & + .460_r8*rxt(k,418)*y(k,103) +.500_r8*rxt(k,419)*y(k,105) + & + .400_r8*rxt(k,422)*y(k,107) +.720_r8*rxt(k,456)*y(k,114))*y(k,293) & + + (.710_r8*rxt(k,503)*y(k,258) +.140_r8*rxt(k,535)*y(k,282) + & + .240_r8*rxt(k,537)*y(k,287) +.120_r8*rxt(k,539)*y(k,291) + & + .170_r8*rxt(k,556)*y(k,252) +.170_r8*rxt(k,562)*y(k,285) + & + .400_r8*rxt(k,572)*y(k,312) +.540_r8*rxt(k,578)*y(k,314) + & + .510_r8*rxt(k,581)*y(k,316))*y(k,147) & + + (.880_r8*rxt(k,385)*y(k,126) +.500_r8*rxt(k,403)*y(k,132) + & + .170_r8*rxt(k,459)*y(k,115) +.170_r8*rxt(k,469)*y(k,118) + & + .170_r8*rxt(k,484)*y(k,121) +.340_r8*rxt(k,501)*y(k,139))*y(k,157) & + + (.080_r8*rxt(k,383)*y(k,282) +.050_r8*rxt(k,402)*y(k,287) + & + .460_r8*rxt(k,421)*y(k,258) +.100_r8*rxt(k,499)*y(k,291) + & + .070_r8*rxt(k,555)*y(k,252) +.070_r8*rxt(k,561)*y(k,285))*y(k,256) & + + (.140_r8*rxt(k,381)*y(k,282) +.250_r8*rxt(k,400)*y(k,287)) & + *y(k,250) + (.500_r8*rxt(k,368)*y(k,296) + & + .120_r8*rxt(k,401)*y(k,287))*y(k,251) +rxt(k,26)*y(k,14) & +.500_r8*rxt(k,41)*y(k,68) +.680_r8*rxt(k,48)*y(k,98) & +.670_r8*rxt(k,49)*y(k,99) +rxt(k,54)*y(k,103) +.500_r8*rxt(k,60) & *y(k,111) +.500_r8*rxt(k,61)*y(k,112) +.720_r8*rxt(k,63)*y(k,114) & @@ -384,621 +351,714 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & +.250_r8*rxt(k,80)*y(k,133) +.440_r8*rxt(k,81)*y(k,134) & +.400_r8*rxt(k,115)*y(k,225) +.540_r8*rxt(k,116)*y(k,228) & +.510_r8*rxt(k,117)*y(k,230) - loss(k,128) = (rxt(k,340)* y(k,293) + het_rates(k,51))* y(k,51) - prod(k,128) = (.100_r8*rxt(k,337)*y(k,251) +.150_r8*rxt(k,338)*y(k,256)) & - *y(k,250) +.120_r8*rxt(k,355)*y(k,157)*y(k,30) & - +.150_r8*rxt(k,391)*y(k,284)*y(k,256) - loss(k,119) = (rxt(k,341)* y(k,293) + rxt(k,36) + het_rates(k,52))* y(k,52) - prod(k,119) = (.360_r8*rxt(k,338)*y(k,250) +.360_r8*rxt(k,391)*y(k,284)) & + loss(k,171) = (rxt(k,339)* y(k,293) + het_rates(k,51))* y(k,51) + prod(k,171) = (.100_r8*rxt(k,336)*y(k,251) +.150_r8*rxt(k,337)*y(k,256)) & + *y(k,250) +.120_r8*rxt(k,354)*y(k,157)*y(k,30) & + +.150_r8*rxt(k,390)*y(k,284)*y(k,256) + loss(k,161) = (rxt(k,340)* y(k,293) + rxt(k,36) + het_rates(k,52))* y(k,52) + prod(k,161) = (.360_r8*rxt(k,337)*y(k,250) +.360_r8*rxt(k,390)*y(k,284)) & *y(k,256) - loss(k,209) = (rxt(k,306)* y(k,293) + het_rates(k,53))* y(k,53) - prod(k,209) = (rxt(k,303)*y(k,251) +.300_r8*rxt(k,326)*y(k,247) + & - .500_r8*rxt(k,369)*y(k,296) +.250_r8*rxt(k,402)*y(k,287) + & - .250_r8*rxt(k,432)*y(k,260) +.250_r8*rxt(k,446)*y(k,265) + & - .250_r8*rxt(k,450)*y(k,266) +.360_r8*rxt(k,476)*y(k,272) + & - .250_r8*rxt(k,493)*y(k,276) +.250_r8*rxt(k,497)*y(k,277) + & - .050_r8*rxt(k,588)*y(k,235) +.170_r8*rxt(k,596)*y(k,236) + & - .050_r8*rxt(k,608)*y(k,238) +.250_r8*rxt(k,616)*y(k,239) + & - .030_r8*rxt(k,628)*y(k,243) +.090_r8*rxt(k,647)*y(k,279) + & - .250_r8*rxt(k,656)*y(k,280) +.050_r8*rxt(k,667)*y(k,288) + & - .250_r8*rxt(k,676)*y(k,289) +.250_r8*rxt(k,695)*y(k,299))*y(k,251) - loss(k,104) = (rxt(k,307)* y(k,293) + rxt(k,37) + het_rates(k,54))* y(k,54) - prod(k,104) =rxt(k,304)*y(k,256)*y(k,251) - loss(k,285) = (rxt(k,331)* y(k,29) +rxt(k,281)* y(k,42) +rxt(k,218)* y(k,43) & + loss(k,236) = (rxt(k,306)* y(k,293) + het_rates(k,53))* y(k,53) + prod(k,236) = (rxt(k,303)*y(k,251) +.300_r8*rxt(k,325)*y(k,247) + & + .500_r8*rxt(k,368)*y(k,296) +.250_r8*rxt(k,401)*y(k,287) + & + .250_r8*rxt(k,431)*y(k,260) +.250_r8*rxt(k,445)*y(k,265) + & + .250_r8*rxt(k,449)*y(k,266) +.360_r8*rxt(k,475)*y(k,272) + & + .250_r8*rxt(k,492)*y(k,276) +.250_r8*rxt(k,496)*y(k,277) + & + .050_r8*rxt(k,587)*y(k,235) +.170_r8*rxt(k,595)*y(k,236) + & + .050_r8*rxt(k,607)*y(k,238) +.250_r8*rxt(k,615)*y(k,239) + & + .030_r8*rxt(k,627)*y(k,243) +.090_r8*rxt(k,646)*y(k,279) + & + .250_r8*rxt(k,655)*y(k,280) +.050_r8*rxt(k,666)*y(k,288) + & + .250_r8*rxt(k,675)*y(k,289) +.250_r8*rxt(k,694)*y(k,299))*y(k,251) + loss(k,129) = (rxt(k,307)* y(k,293) + rxt(k,37) + het_rates(k,54))* y(k,54) + prod(k,129) =rxt(k,304)*y(k,256)*y(k,251) + loss(k,277) = (rxt(k,219)* y(k,57) +rxt(k,275)* y(k,75) + (rxt(k,315) + & + rxt(k,316) +rxt(k,317))* y(k,292) +rxt(k,308)* y(k,293) + rxt(k,38) & + + rxt(k,39) + het_rates(k,55))* y(k,55) + prod(k,277) =.100_r8*rxt(k,354)*y(k,157)*y(k,30) + loss(k,125) = (rxt(k,288)* y(k,57) +rxt(k,271)* y(k,292) +rxt(k,289) & + * y(k,293) + rxt(k,134) + het_rates(k,56))* y(k,56) + prod(k,125) = 0._r8 + loss(k,311) = (rxt(k,330)* y(k,29) +rxt(k,281)* y(k,42) +rxt(k,218)* y(k,43) & +rxt(k,283)* y(k,44) +rxt(k,286)* y(k,47) +rxt(k,219)* y(k,55) & +rxt(k,288)* y(k,56) +rxt(k,231)* y(k,61) +rxt(k,220)* y(k,79) & +rxt(k,221)* y(k,81) +rxt(k,240)* y(k,96) +rxt(k,224)* y(k,157) & + (rxt(k,222) +rxt(k,223))* y(k,256) + het_rates(k,57))* y(k,57) - prod(k,285) = (4.000_r8*rxt(k,243)*y(k,34) +rxt(k,244)*y(k,35) + & + prod(k,311) = (4.000_r8*rxt(k,243)*y(k,34) +rxt(k,244)*y(k,35) + & 2.000_r8*rxt(k,245)*y(k,37) +2.000_r8*rxt(k,246)*y(k,38) + & 2.000_r8*rxt(k,247)*y(k,39) +rxt(k,248)*y(k,40) + & - 2.000_r8*rxt(k,249)*y(k,41) +rxt(k,295)*y(k,84) +rxt(k,296)*y(k,85) + & - rxt(k,297)*y(k,86) +rxt(k,250)*y(k,87) +rxt(k,280)*y(k,66))*y(k,292) & + 2.000_r8*rxt(k,249)*y(k,41) +rxt(k,250)*y(k,87) +rxt(k,280)*y(k,66) + & + rxt(k,295)*y(k,84) +rxt(k,296)*y(k,85) +rxt(k,297)*y(k,86))*y(k,292) & + (rxt(k,137) +rxt(k,225)*y(k,251) +2.000_r8*rxt(k,226)*y(k,60) + & rxt(k,228)*y(k,60) +rxt(k,230)*y(k,147) +rxt(k,235)*y(k,156) + & rxt(k,236)*y(k,293) +rxt(k,259)*y(k,20) +rxt(k,801)*y(k,173))*y(k,60) & - + (3.000_r8*rxt(k,285)*y(k,45) +rxt(k,287)*y(k,47) + & - rxt(k,290)*y(k,84) +rxt(k,291)*y(k,85) +rxt(k,292)*y(k,86) + & - rxt(k,239)*y(k,87))*y(k,293) + (rxt(k,147) +rxt(k,238)*y(k,156)) & - *y(k,87) +rxt(k,118)*y(k,19) +2.000_r8*rxt(k,135)*y(k,58) & + + (rxt(k,239)*y(k,87) +3.000_r8*rxt(k,285)*y(k,45) + & + rxt(k,287)*y(k,47) +rxt(k,290)*y(k,84) +rxt(k,291)*y(k,85) + & + rxt(k,292)*y(k,86))*y(k,293) + (rxt(k,147) +rxt(k,238)*y(k,156)) & + *y(k,87) +rxt(k,118)*y(k,19) +4.000_r8*rxt(k,122)*y(k,34) +rxt(k,123) & + *y(k,35) +2.000_r8*rxt(k,125)*y(k,37) +2.000_r8*rxt(k,126)*y(k,38) & + +2.000_r8*rxt(k,127)*y(k,39) +rxt(k,128)*y(k,40) & + +2.000_r8*rxt(k,129)*y(k,41) +3.000_r8*rxt(k,132)*y(k,45) & + +rxt(k,133)*y(k,47) +2.000_r8*rxt(k,135)*y(k,58) & +2.000_r8*rxt(k,136)*y(k,59) +rxt(k,138)*y(k,61) +rxt(k,141)*y(k,66) & + +rxt(k,144)*y(k,84) +rxt(k,145)*y(k,85) +rxt(k,146)*y(k,86) & +rxt(k,150)*y(k,96) - loss(k,55) = ( + rxt(k,135) + het_rates(k,58))* y(k,58) - prod(k,55) = (rxt(k,886)*y(k,96) +rxt(k,891)*y(k,61) +rxt(k,892)*y(k,96) + & - rxt(k,896)*y(k,61) +rxt(k,897)*y(k,96) +rxt(k,901)*y(k,61))*y(k,87) & + loss(k,73) = ( + rxt(k,135) + het_rates(k,58))* y(k,58) + prod(k,73) = (rxt(k,885)*y(k,96) +rxt(k,890)*y(k,61) +rxt(k,891)*y(k,96) + & + rxt(k,895)*y(k,61) +rxt(k,896)*y(k,96) +rxt(k,900)*y(k,61))*y(k,87) & +rxt(k,231)*y(k,61)*y(k,57) +rxt(k,227)*y(k,60)*y(k,60) - loss(k,49) = ( + rxt(k,136) + rxt(k,253) + het_rates(k,59))* y(k,59) - prod(k,49) =rxt(k,252)*y(k,60)*y(k,60) - loss(k,277) = ((rxt(k,258) +rxt(k,259) +rxt(k,260))* y(k,20) & + loss(k,56) = ( + rxt(k,136) + rxt(k,253) + het_rates(k,59))* y(k,59) + prod(k,56) =rxt(k,252)*y(k,60)*y(k,60) + loss(k,291) = ((rxt(k,258) +rxt(k,259) +rxt(k,260))* y(k,20) & + 2._r8*(rxt(k,226) +rxt(k,227) +rxt(k,228) +rxt(k,252))* y(k,60) & +rxt(k,230)* y(k,147) +rxt(k,232)* y(k,148) +rxt(k,235)* y(k,156) & +rxt(k,801)* y(k,173) +rxt(k,225)* y(k,251) +rxt(k,229)* y(k,256) & + (rxt(k,236) +rxt(k,237))* y(k,293) + rxt(k,137) + het_rates(k,60)) & * y(k,60) - prod(k,277) = (rxt(k,223)*y(k,256) +rxt(k,224)*y(k,157) +rxt(k,240)*y(k,96)) & + prod(k,291) = (rxt(k,223)*y(k,256) +rxt(k,224)*y(k,157) +rxt(k,240)*y(k,96)) & *y(k,57) + (rxt(k,139) +rxt(k,233)*y(k,156))*y(k,61) & + (rxt(k,241)*y(k,156) +rxt(k,242)*y(k,293))*y(k,96) + (rxt(k,151) + & rxt(k,806)*y(k,173))*y(k,159) +2.000_r8*rxt(k,253)*y(k,59) & +rxt(k,251)*y(k,292)*y(k,87) - loss(k,196) = (rxt(k,231)* y(k,57) + (rxt(k,891) +rxt(k,896) +rxt(k,901)) & + loss(k,221) = (rxt(k,231)* y(k,57) + (rxt(k,890) +rxt(k,895) +rxt(k,900)) & * y(k,87) +rxt(k,233)* y(k,156) +rxt(k,234)* y(k,293) + rxt(k,138) & - + rxt(k,139) + rxt(k,889) + rxt(k,894) + rxt(k,900) & + + rxt(k,139) + rxt(k,888) + rxt(k,893) + rxt(k,899) & + het_rates(k,61))* y(k,61) - prod(k,196) =rxt(k,232)*y(k,148)*y(k,60) - loss(k,223) = ((rxt(k,309) +rxt(k,320))* y(k,293) + het_rates(k,63))* y(k,63) - prod(k,223) = (rxt(k,301)*y(k,43) +.350_r8*rxt(k,322)*y(k,25) + & - rxt(k,347)*y(k,77) +.110_r8*rxt(k,348)*y(k,89) +rxt(k,362)*y(k,50) + & - rxt(k,377)*y(k,68) +rxt(k,381)*y(k,127) +rxt(k,388)*y(k,128) + & - .250_r8*rxt(k,399)*y(k,131) +.500_r8*rxt(k,400)*y(k,133) + & - 1.560_r8*rxt(k,406)*y(k,134) +1.060_r8*rxt(k,415)*y(k,98) + & - .760_r8*rxt(k,416)*y(k,99) +.420_r8*rxt(k,417)*y(k,100) + & - .230_r8*rxt(k,418)*y(k,101) +rxt(k,419)*y(k,103) + & - 1.500_r8*rxt(k,420)*y(k,105) +.350_r8*rxt(k,424)*y(k,108) + & - rxt(k,453)*y(k,111) +rxt(k,455)*y(k,112) + & - 2.000_r8*rxt(k,457)*y(k,114) +.060_r8*rxt(k,461)*y(k,115) + & - .040_r8*rxt(k,471)*y(k,118) +.630_r8*rxt(k,503)*y(k,139) + & - 2.000_r8*rxt(k,719)*y(k,202) +rxt(k,738)*y(k,204) + & - rxt(k,758)*y(k,208) +rxt(k,797)*y(k,160))*y(k,293) & - + (.650_r8*rxt(k,393)*y(k,284) +.400_r8*rxt(k,504)*y(k,258) + & - .550_r8*rxt(k,510)*y(k,265) +.550_r8*rxt(k,512)*y(k,266) + & - .550_r8*rxt(k,531)*y(k,276) +.550_r8*rxt(k,534)*y(k,277) + & - .860_r8*rxt(k,536)*y(k,282) +.750_r8*rxt(k,540)*y(k,291) + & - .170_r8*rxt(k,557)*y(k,252) +.400_r8*rxt(k,560)*y(k,283) + & - .350_r8*rxt(k,563)*y(k,285) +.910_r8*rxt(k,742)*y(k,304))*y(k,147) & - + (.510_r8*rxt(k,384)*y(k,282) +.320_r8*rxt(k,391)*y(k,284) + & - .260_r8*rxt(k,403)*y(k,287) +.260_r8*rxt(k,422)*y(k,258) + & - .600_r8*rxt(k,500)*y(k,291) +.070_r8*rxt(k,556)*y(k,252) + & - .160_r8*rxt(k,559)*y(k,283) +.140_r8*rxt(k,562)*y(k,285) + & - .530_r8*rxt(k,741)*y(k,304))*y(k,256) & - + (.900_r8*rxt(k,383)*y(k,282) +.650_r8*rxt(k,390)*y(k,284) + & - rxt(k,402)*y(k,287) +.280_r8*rxt(k,446)*y(k,265) + & - .280_r8*rxt(k,450)*y(k,266) +.280_r8*rxt(k,493)*y(k,276) + & - .280_r8*rxt(k,497)*y(k,277) +rxt(k,740)*y(k,304))*y(k,251) & - + (.630_r8*rxt(k,324)*y(k,26) +.560_r8*rxt(k,355)*y(k,30) + & - .650_r8*rxt(k,386)*y(k,126) +.560_r8*rxt(k,404)*y(k,132) + & - .350_r8*rxt(k,487)*y(k,109) +.300_r8*rxt(k,502)*y(k,139) + & - .170_r8*rxt(k,603)*y(k,4))*y(k,157) + (.860_r8*rxt(k,382)*y(k,282) + & - .650_r8*rxt(k,389)*y(k,284) +.550_r8*rxt(k,445)*y(k,265) + & - .550_r8*rxt(k,449)*y(k,266) +.550_r8*rxt(k,492)*y(k,276) + & - .550_r8*rxt(k,496)*y(k,277) +rxt(k,739)*y(k,304))*y(k,250) & + prod(k,221) =rxt(k,232)*y(k,148)*y(k,60) + loss(k,5) = ( + het_rates(k,62))* y(k,62) + prod(k,5) = 0._r8 + loss(k,264) = (rxt(k,319)* y(k,293) + het_rates(k,63))* y(k,63) + prod(k,264) = (rxt(k,301)*y(k,43) +.350_r8*rxt(k,321)*y(k,25) + & + rxt(k,346)*y(k,77) +.110_r8*rxt(k,347)*y(k,89) +rxt(k,361)*y(k,50) + & + rxt(k,376)*y(k,68) +rxt(k,380)*y(k,127) +rxt(k,387)*y(k,128) + & + .250_r8*rxt(k,398)*y(k,131) +.500_r8*rxt(k,399)*y(k,133) + & + 1.560_r8*rxt(k,405)*y(k,134) +1.060_r8*rxt(k,414)*y(k,98) + & + .760_r8*rxt(k,415)*y(k,99) +.420_r8*rxt(k,416)*y(k,100) + & + .230_r8*rxt(k,417)*y(k,101) +rxt(k,418)*y(k,103) + & + 1.500_r8*rxt(k,419)*y(k,105) +.350_r8*rxt(k,423)*y(k,108) + & + rxt(k,452)*y(k,111) +rxt(k,454)*y(k,112) + & + 2.000_r8*rxt(k,456)*y(k,114) +.060_r8*rxt(k,460)*y(k,115) + & + .040_r8*rxt(k,470)*y(k,118) +.630_r8*rxt(k,502)*y(k,139) + & + 2.000_r8*rxt(k,718)*y(k,202) +rxt(k,737)*y(k,204) + & + rxt(k,757)*y(k,208) +rxt(k,796)*y(k,160))*y(k,293) & + + (.650_r8*rxt(k,392)*y(k,284) +.400_r8*rxt(k,503)*y(k,258) + & + .550_r8*rxt(k,509)*y(k,265) +.550_r8*rxt(k,511)*y(k,266) + & + .550_r8*rxt(k,530)*y(k,276) +.550_r8*rxt(k,533)*y(k,277) + & + .860_r8*rxt(k,535)*y(k,282) +.750_r8*rxt(k,539)*y(k,291) + & + .170_r8*rxt(k,556)*y(k,252) +.400_r8*rxt(k,559)*y(k,283) + & + .350_r8*rxt(k,562)*y(k,285) +.910_r8*rxt(k,741)*y(k,304))*y(k,147) & + + (.510_r8*rxt(k,383)*y(k,282) +.320_r8*rxt(k,390)*y(k,284) + & + .260_r8*rxt(k,402)*y(k,287) +.260_r8*rxt(k,421)*y(k,258) + & + .600_r8*rxt(k,499)*y(k,291) +.070_r8*rxt(k,555)*y(k,252) + & + .160_r8*rxt(k,558)*y(k,283) +.140_r8*rxt(k,561)*y(k,285) + & + .530_r8*rxt(k,740)*y(k,304))*y(k,256) & + + (.900_r8*rxt(k,382)*y(k,282) +.650_r8*rxt(k,389)*y(k,284) + & + rxt(k,401)*y(k,287) +.280_r8*rxt(k,445)*y(k,265) + & + .280_r8*rxt(k,449)*y(k,266) +.280_r8*rxt(k,492)*y(k,276) + & + .280_r8*rxt(k,496)*y(k,277) +rxt(k,739)*y(k,304))*y(k,251) & + + (.630_r8*rxt(k,323)*y(k,26) +.560_r8*rxt(k,354)*y(k,30) + & + .650_r8*rxt(k,385)*y(k,126) +.560_r8*rxt(k,403)*y(k,132) + & + .350_r8*rxt(k,486)*y(k,109) +.300_r8*rxt(k,501)*y(k,139) + & + .170_r8*rxt(k,602)*y(k,4))*y(k,157) + (.860_r8*rxt(k,381)*y(k,282) + & + .650_r8*rxt(k,388)*y(k,284) +.550_r8*rxt(k,444)*y(k,265) + & + .550_r8*rxt(k,448)*y(k,266) +.550_r8*rxt(k,491)*y(k,276) + & + .550_r8*rxt(k,495)*y(k,277) +rxt(k,738)*y(k,304))*y(k,250) & + (rxt(k,31) +rxt(k,32) +rxt(k,218)*y(k,57) +rxt(k,254)*y(k,18) + & rxt(k,299)*y(k,149) +rxt(k,300)*y(k,156))*y(k,43) & - + (rxt(k,743)*y(k,149) +rxt(k,744)*y(k,300) +rxt(k,745)*y(k,302) + & - rxt(k,746)*y(k,305))*y(k,304) + (rxt(k,35) +rxt(k,361)*y(k,149)) & + + (rxt(k,742)*y(k,149) +rxt(k,743)*y(k,300) +rxt(k,744)*y(k,302) + & + rxt(k,745)*y(k,305))*y(k,304) + (rxt(k,35) +rxt(k,360)*y(k,149)) & *y(k,50) + (1.500_r8*rxt(k,53) +rxt(k,54))*y(k,103) + (rxt(k,154) + & - rxt(k,796)*y(k,156))*y(k,160) + (1.300_r8*rxt(k,392)*y(k,284) + & - .650_r8*rxt(k,394)*y(k,149))*y(k,284) +1.500_r8*rxt(k,22)*y(k,10) & + rxt(k,795)*y(k,156))*y(k,160) + (1.300_r8*rxt(k,391)*y(k,284) + & + .650_r8*rxt(k,393)*y(k,149))*y(k,284) +1.500_r8*rxt(k,22)*y(k,10) & +.600_r8*rxt(k,25)*y(k,13) +rxt(k,26)*y(k,14) +rxt(k,33)*y(k,46) & - +rxt(k,286)*y(k,57)*y(k,47) +.500_r8*rxt(k,41)*y(k,68) +rxt(k,43) & - *y(k,76) +2.000_r8*rxt(k,44)*y(k,77) +rxt(k,45)*y(k,89) & - +.330_r8*rxt(k,47)*y(k,97) +1.320_r8*rxt(k,48)*y(k,98) & - +1.740_r8*rxt(k,49)*y(k,99) +rxt(k,50)*y(k,100) +rxt(k,51)*y(k,101) & - +.550_r8*rxt(k,64)*y(k,115) +.550_r8*rxt(k,67)*y(k,118) & - +1.650_r8*rxt(k,72)*y(k,126) +.750_r8*rxt(k,74)*y(k,127) & - +.860_r8*rxt(k,75)*y(k,128) +.700_r8*rxt(k,79)*y(k,132) +rxt(k,83) & - *y(k,150) +1.500_r8*rxt(k,90)*y(k,197) +rxt(k,93)*y(k,200) +rxt(k,94) & - *y(k,201) +rxt(k,96)*y(k,203) +.600_r8*rxt(k,530)*y(k,276) & - +.600_r8*rxt(k,533)*y(k,277) +rxt(k,385)*y(k,282) +rxt(k,501) & - *y(k,291) - loss(k,53) = (rxt(k,279)* y(k,292) + rxt(k,140) + het_rates(k,65))* y(k,65) - prod(k,53) = (rxt(k,244)*y(k,35) +rxt(k,246)*y(k,38) + & + +rxt(k,286)*y(k,57)*y(k,47) +.380_r8*rxt(k,39)*y(k,55) +rxt(k,40) & + *y(k,64) +.500_r8*rxt(k,41)*y(k,68) +rxt(k,43)*y(k,76) & + +2.000_r8*rxt(k,44)*y(k,77) +rxt(k,45)*y(k,89) +.330_r8*rxt(k,47) & + *y(k,97) +1.320_r8*rxt(k,48)*y(k,98) +1.740_r8*rxt(k,49)*y(k,99) & + +rxt(k,50)*y(k,100) +rxt(k,51)*y(k,101) +.550_r8*rxt(k,64)*y(k,115) & + +.550_r8*rxt(k,67)*y(k,118) +1.650_r8*rxt(k,72)*y(k,126) & + +.750_r8*rxt(k,74)*y(k,127) +.860_r8*rxt(k,75)*y(k,128) & + +.700_r8*rxt(k,79)*y(k,132) +rxt(k,83)*y(k,150) +1.500_r8*rxt(k,90) & + *y(k,197) +rxt(k,93)*y(k,200) +rxt(k,94)*y(k,201) +rxt(k,96)*y(k,203) & + +.600_r8*rxt(k,529)*y(k,276) +.600_r8*rxt(k,532)*y(k,277) & + +rxt(k,384)*y(k,282) +rxt(k,500)*y(k,291) + loss(k,245) = ( + rxt(k,40) + het_rates(k,64))* y(k,64) + prod(k,245) = (2.000_r8*rxt(k,335)*y(k,250) +.900_r8*rxt(k,336)*y(k,251) + & + .490_r8*rxt(k,337)*y(k,256) +rxt(k,338)*y(k,147) + & + rxt(k,381)*y(k,282) +2.000_r8*rxt(k,388)*y(k,284) + & + rxt(k,400)*y(k,287) +rxt(k,424)*y(k,259) +rxt(k,430)*y(k,260) + & + rxt(k,444)*y(k,265) +rxt(k,448)*y(k,266) +rxt(k,474)*y(k,272) + & + rxt(k,491)*y(k,276) +rxt(k,495)*y(k,277) +rxt(k,586)*y(k,235) + & + rxt(k,594)*y(k,236) +rxt(k,606)*y(k,238) +rxt(k,614)*y(k,239) + & + rxt(k,626)*y(k,243) +rxt(k,634)*y(k,244) +rxt(k,645)*y(k,279) + & + rxt(k,654)*y(k,280) +rxt(k,665)*y(k,288) +rxt(k,674)*y(k,289) + & + rxt(k,693)*y(k,299) +2.000_r8*rxt(k,701)*y(k,300) + & + rxt(k,709)*y(k,301) +2.000_r8*rxt(k,719)*y(k,302) + & + rxt(k,728)*y(k,303) +rxt(k,738)*y(k,304) + & + 2.000_r8*rxt(k,749)*y(k,305))*y(k,250) + (rxt(k,591)*y(k,235) + & + rxt(k,599)*y(k,236) +rxt(k,611)*y(k,238) +rxt(k,619)*y(k,239) + & + rxt(k,631)*y(k,243) +rxt(k,639)*y(k,244) +rxt(k,651)*y(k,279) + & + rxt(k,659)*y(k,280) +rxt(k,671)*y(k,288) +rxt(k,679)*y(k,289) + & + rxt(k,698)*y(k,299) +rxt(k,702)*y(k,251) + & + .490_r8*rxt(k,703)*y(k,256) +rxt(k,704)*y(k,147) + & + rxt(k,705)*y(k,149) +2.000_r8*rxt(k,706)*y(k,300) + & + 2.000_r8*rxt(k,707)*y(k,305) +rxt(k,714)*y(k,301) + & + 2.000_r8*rxt(k,724)*y(k,302) +rxt(k,733)*y(k,303) + & + rxt(k,743)*y(k,304))*y(k,300) + (rxt(k,592)*y(k,235) + & + rxt(k,600)*y(k,236) +rxt(k,612)*y(k,238) +rxt(k,620)*y(k,239) + & + rxt(k,632)*y(k,243) +rxt(k,640)*y(k,244) +rxt(k,652)*y(k,279) + & + rxt(k,660)*y(k,280) +rxt(k,672)*y(k,288) +rxt(k,680)*y(k,289) + & + rxt(k,699)*y(k,299) +rxt(k,715)*y(k,301) +rxt(k,720)*y(k,251) + & + .490_r8*rxt(k,721)*y(k,256) +rxt(k,722)*y(k,147) + & + rxt(k,723)*y(k,149) +2.000_r8*rxt(k,725)*y(k,302) + & + 2.000_r8*rxt(k,726)*y(k,305) +rxt(k,734)*y(k,303) + & + rxt(k,744)*y(k,304))*y(k,302) + (rxt(k,593)*y(k,235) + & + rxt(k,601)*y(k,236) +rxt(k,613)*y(k,238) +rxt(k,621)*y(k,239) + & + rxt(k,633)*y(k,243) +rxt(k,641)*y(k,244) +rxt(k,653)*y(k,279) + & + rxt(k,661)*y(k,280) +rxt(k,673)*y(k,288) +rxt(k,681)*y(k,289) + & + rxt(k,700)*y(k,299) +rxt(k,716)*y(k,301) +rxt(k,735)*y(k,303) + & + rxt(k,745)*y(k,304) +rxt(k,750)*y(k,251) + & + .490_r8*rxt(k,751)*y(k,256) +rxt(k,752)*y(k,147) + & + rxt(k,753)*y(k,149) +2.000_r8*rxt(k,754)*y(k,305))*y(k,305) & + + (rxt(k,310)*y(k,90) +rxt(k,319)*y(k,63) +rxt(k,339)*y(k,51) + & + .500_r8*rxt(k,340)*y(k,52) +.800_r8*rxt(k,345)*y(k,76) + & + rxt(k,346)*y(k,77) +rxt(k,348)*y(k,150) +.540_r8*rxt(k,414)*y(k,98) + & + .540_r8*rxt(k,415)*y(k,99) +.360_r8*rxt(k,418)*y(k,103) + & + .190_r8*rxt(k,423)*y(k,108) +.450_r8*rxt(k,502)*y(k,139) + & + 2.000_r8*rxt(k,718)*y(k,202) +3.000_r8*rxt(k,737)*y(k,204) + & + .290_r8*rxt(k,746)*y(k,206) +.290_r8*rxt(k,747)*y(k,207) + & + .290_r8*rxt(k,748)*y(k,205))*y(k,293) + (rxt(k,389)*y(k,251) + & + .490_r8*rxt(k,390)*y(k,256) +2.000_r8*rxt(k,391)*y(k,284) + & + rxt(k,392)*y(k,147) +rxt(k,393)*y(k,149))*y(k,284) & + + (.200_r8*rxt(k,354)*y(k,30) +.100_r8*rxt(k,403)*y(k,132) + & + .420_r8*rxt(k,486)*y(k,109) +.190_r8*rxt(k,642)*y(k,17))*y(k,157) & + +rxt(k,36)*y(k,52) +.440_r8*rxt(k,39)*y(k,55) +.170_r8*rxt(k,48) & + *y(k,98) +.280_r8*rxt(k,49)*y(k,99) +rxt(k,54)*y(k,103) & + +.400_r8*rxt(k,86)*y(k,162) +rxt(k,98)*y(k,205) +rxt(k,99)*y(k,206) & + +rxt(k,100)*y(k,207) + loss(k,91) = (rxt(k,279)* y(k,292) + rxt(k,140) + het_rates(k,65))* y(k,65) + prod(k,91) = (rxt(k,244)*y(k,35) +rxt(k,246)*y(k,38) + & 2.000_r8*rxt(k,247)*y(k,39) +2.000_r8*rxt(k,248)*y(k,40) + & rxt(k,249)*y(k,41) +rxt(k,270)*y(k,36) +2.000_r8*rxt(k,272)*y(k,80) + & - rxt(k,296)*y(k,85) +rxt(k,297)*y(k,86))*y(k,292) & - + (rxt(k,291)*y(k,85) +rxt(k,292)*y(k,86))*y(k,293) - loss(k,62) = (rxt(k,280)* y(k,292) + rxt(k,141) + het_rates(k,66))* y(k,66) - prod(k,62) = (rxt(k,245)*y(k,37) +rxt(k,246)*y(k,38) +rxt(k,295)*y(k,84)) & - *y(k,292) +rxt(k,290)*y(k,293)*y(k,84) - loss(k,64) = (rxt(k,555)* y(k,293) + het_rates(k,67))* y(k,67) - prod(k,64) =.180_r8*rxt(k,575)*y(k,293)*y(k,226) - loss(k,132) = (rxt(k,377)* y(k,293) + rxt(k,41) + het_rates(k,68))* y(k,68) - prod(k,132) = (.070_r8*rxt(k,415)*y(k,98) +.170_r8*rxt(k,416)*y(k,99)) & - *y(k,293) +.600_r8*rxt(k,530)*y(k,276) +.600_r8*rxt(k,533)*y(k,277) - loss(k,81) = (rxt(k,794)* y(k,149) + (rxt(k,795) +rxt(k,808))* y(k,293) & + rxt(k,296)*y(k,85) +rxt(k,297)*y(k,86))*y(k,292) + (rxt(k,145) + & + rxt(k,291)*y(k,293))*y(k,85) + (rxt(k,146) +rxt(k,292)*y(k,293)) & + *y(k,86) +rxt(k,123)*y(k,35) +rxt(k,124)*y(k,36) +rxt(k,126)*y(k,38) & + +2.000_r8*rxt(k,127)*y(k,39) +2.000_r8*rxt(k,128)*y(k,40) & + +rxt(k,129)*y(k,41) +2.000_r8*rxt(k,142)*y(k,80) + loss(k,89) = (rxt(k,280)* y(k,292) + rxt(k,141) + het_rates(k,66))* y(k,66) + prod(k,89) = (rxt(k,144) +rxt(k,290)*y(k,293) +rxt(k,295)*y(k,292))*y(k,84) & + + (rxt(k,125) +rxt(k,245)*y(k,292))*y(k,37) + (rxt(k,126) + & + rxt(k,246)*y(k,292))*y(k,38) + loss(k,82) = (rxt(k,554)* y(k,293) + het_rates(k,67))* y(k,67) + prod(k,82) =.180_r8*rxt(k,574)*y(k,293)*y(k,226) + loss(k,153) = (rxt(k,376)* y(k,293) + rxt(k,41) + het_rates(k,68))* y(k,68) + prod(k,153) = (.070_r8*rxt(k,414)*y(k,98) +.170_r8*rxt(k,415)*y(k,99)) & + *y(k,293) +.600_r8*rxt(k,529)*y(k,276) +.600_r8*rxt(k,532)*y(k,277) + loss(k,105) = (rxt(k,793)* y(k,149) + (rxt(k,794) +rxt(k,808))* y(k,293) & + het_rates(k,69))* y(k,69) - prod(k,81) = 0._r8 - loss(k,3) = ( + het_rates(k,70))* y(k,70) - prod(k,3) = 0._r8 - loss(k,4) = ( + het_rates(k,71))* y(k,71) - prod(k,4) = 0._r8 - loss(k,5) = ( + het_rates(k,72))* y(k,72) - prod(k,5) = 0._r8 - loss(k,51) = ( + rxt(k,42) + het_rates(k,74))* y(k,74) - prod(k,51) =rxt(k,342)*y(k,256)*y(k,255) - loss(k,167) = (rxt(k,275)* y(k,55) +rxt(k,276)* y(k,79) +rxt(k,278)* y(k,93) & + prod(k,105) = 0._r8 + loss(k,6) = ( + het_rates(k,70))* y(k,70) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,71))* y(k,71) + prod(k,7) = 0._r8 + loss(k,8) = ( + het_rates(k,72))* y(k,72) + prod(k,8) = 0._r8 + loss(k,9) = ( + rxt(k,901) + het_rates(k,73))* y(k,73) + prod(k,9) = 0._r8 + loss(k,66) = ( + rxt(k,42) + het_rates(k,74))* y(k,74) + prod(k,66) =rxt(k,341)*y(k,256)*y(k,255) + loss(k,217) = (rxt(k,275)* y(k,55) +rxt(k,276)* y(k,79) +rxt(k,278)* y(k,93) & +rxt(k,277)* y(k,317) + het_rates(k,75))* y(k,75) - prod(k,167) = (rxt(k,248)*y(k,40) +rxt(k,270)*y(k,36) + & - 2.000_r8*rxt(k,279)*y(k,65) +rxt(k,280)*y(k,66))*y(k,292) & - +2.000_r8*rxt(k,140)*y(k,65) +rxt(k,141)*y(k,66) +rxt(k,148)*y(k,91) - loss(k,218) = (rxt(k,346)* y(k,293) + rxt(k,43) + het_rates(k,76))* y(k,76) - prod(k,218) = (.570_r8*rxt(k,504)*y(k,258) +.940_r8*rxt(k,514)*y(k,267) + & - .730_r8*rxt(k,516)*y(k,268) +.340_r8*rxt(k,522)*y(k,271) + & - .400_r8*rxt(k,526)*y(k,273) +.760_r8*rxt(k,538)*y(k,287))*y(k,147) & - + (.360_r8*rxt(k,403)*y(k,287) +.370_r8*rxt(k,422)*y(k,258) + & - .550_r8*rxt(k,458)*y(k,267) +.460_r8*rxt(k,462)*y(k,268) + & - .150_r8*rxt(k,472)*y(k,271) +.280_r8*rxt(k,480)*y(k,273))*y(k,256) & - + (.750_r8*rxt(k,401)*y(k,250) +.380_r8*rxt(k,402)*y(k,251)) & - *y(k,287) + (rxt(k,489)*y(k,122) +.070_r8*rxt(k,491)*y(k,123)) & + prod(k,217) = (rxt(k,248)*y(k,40) +rxt(k,270)*y(k,36) + & + 2.000_r8*rxt(k,279)*y(k,65) +rxt(k,280)*y(k,66))*y(k,292) +rxt(k,124) & + *y(k,36) +rxt(k,128)*y(k,40) +2.000_r8*rxt(k,140)*y(k,65) +rxt(k,141) & + *y(k,66) +rxt(k,148)*y(k,91) + loss(k,252) = (rxt(k,345)* y(k,293) + rxt(k,43) + het_rates(k,76))* y(k,76) + prod(k,252) = (.570_r8*rxt(k,503)*y(k,258) +.940_r8*rxt(k,513)*y(k,267) + & + .730_r8*rxt(k,515)*y(k,268) +.340_r8*rxt(k,521)*y(k,271) + & + .400_r8*rxt(k,525)*y(k,273) +.760_r8*rxt(k,537)*y(k,287))*y(k,147) & + + (.360_r8*rxt(k,402)*y(k,287) +.370_r8*rxt(k,421)*y(k,258) + & + .550_r8*rxt(k,457)*y(k,267) +.460_r8*rxt(k,461)*y(k,268) + & + .150_r8*rxt(k,471)*y(k,271) +.280_r8*rxt(k,479)*y(k,273))*y(k,256) & + + (.750_r8*rxt(k,400)*y(k,250) +.380_r8*rxt(k,401)*y(k,251)) & + *y(k,287) + (rxt(k,488)*y(k,122) +.070_r8*rxt(k,490)*y(k,123)) & *y(k,293) +.330_r8*rxt(k,47)*y(k,97) +.500_r8*rxt(k,53)*y(k,103) & +rxt(k,59)*y(k,110) +.500_r8*rxt(k,60)*y(k,111) +.500_r8*rxt(k,61) & *y(k,112) +rxt(k,62)*y(k,113) +.720_r8*rxt(k,63)*y(k,114) & - +.830_r8*rxt(k,460)*y(k,157)*y(k,115) +.500_r8*rxt(k,80)*y(k,133) & - +.560_r8*rxt(k,81)*y(k,134) +rxt(k,345)*y(k,254) - loss(k,193) = (rxt(k,347)* y(k,293) + rxt(k,44) + rxt(k,812) & + +.830_r8*rxt(k,459)*y(k,157)*y(k,115) +.500_r8*rxt(k,80)*y(k,133) & + +.560_r8*rxt(k,81)*y(k,134) +rxt(k,344)*y(k,254) + loss(k,233) = (rxt(k,346)* y(k,293) + rxt(k,44) + rxt(k,811) & + het_rates(k,77))* y(k,77) - prod(k,193) = (.230_r8*rxt(k,504)*y(k,258) +.130_r8*rxt(k,540)*y(k,291) + & - rxt(k,546)*y(k,241) +.400_r8*rxt(k,560)*y(k,283) + & - .170_r8*rxt(k,563)*y(k,285) +.700_r8*rxt(k,566)*y(k,294) + & - .600_r8*rxt(k,573)*y(k,312) +.340_r8*rxt(k,579)*y(k,314) + & - .170_r8*rxt(k,582)*y(k,316))*y(k,147) & - + (.170_r8*rxt(k,460)*y(k,115) +.170_r8*rxt(k,470)*y(k,118) + & - .170_r8*rxt(k,485)*y(k,121) +.660_r8*rxt(k,502)*y(k,139))*y(k,157) & - + (.150_r8*rxt(k,422)*y(k,258) +.100_r8*rxt(k,500)*y(k,291) + & - .160_r8*rxt(k,559)*y(k,283) +.070_r8*rxt(k,562)*y(k,285))*y(k,256) & - + (.650_r8*rxt(k,322)*y(k,25) +.200_r8*rxt(k,346)*y(k,76) + & - .890_r8*rxt(k,348)*y(k,89))*y(k,293) +rxt(k,21)*y(k,9) & + prod(k,233) = (.230_r8*rxt(k,503)*y(k,258) +.130_r8*rxt(k,539)*y(k,291) + & + rxt(k,545)*y(k,241) +.400_r8*rxt(k,559)*y(k,283) + & + .170_r8*rxt(k,562)*y(k,285) +.700_r8*rxt(k,565)*y(k,294) + & + .600_r8*rxt(k,572)*y(k,312) +.340_r8*rxt(k,578)*y(k,314) + & + .170_r8*rxt(k,581)*y(k,316))*y(k,147) & + + (.170_r8*rxt(k,459)*y(k,115) +.170_r8*rxt(k,469)*y(k,118) + & + .170_r8*rxt(k,484)*y(k,121) +.660_r8*rxt(k,501)*y(k,139))*y(k,157) & + + (.150_r8*rxt(k,421)*y(k,258) +.100_r8*rxt(k,499)*y(k,291) + & + .160_r8*rxt(k,558)*y(k,283) +.070_r8*rxt(k,561)*y(k,285))*y(k,256) & + + (.650_r8*rxt(k,321)*y(k,25) +.200_r8*rxt(k,345)*y(k,76) + & + .890_r8*rxt(k,347)*y(k,89))*y(k,293) +rxt(k,21)*y(k,9) & +.500_r8*rxt(k,60)*y(k,111) +.500_r8*rxt(k,61)*y(k,112) & +.280_r8*rxt(k,63)*y(k,114) +.700_r8*rxt(k,87)*y(k,166) & +.600_r8*rxt(k,115)*y(k,225) +.340_r8*rxt(k,116)*y(k,228) & +.170_r8*rxt(k,117)*y(k,230) - loss(k,271) = (rxt(k,184)* y(k,157) + (rxt(k,178) +rxt(k,179) +rxt(k,180)) & + loss(k,290) = (rxt(k,184)* y(k,157) + (rxt(k,178) +rxt(k,179) +rxt(k,180)) & * y(k,256) + rxt(k,181) + het_rates(k,78))* y(k,78) - prod(k,271) = (rxt(k,185)*y(k,79) +rxt(k,188)*y(k,156) +rxt(k,206)*y(k,136) + & - rxt(k,301)*y(k,43) +rxt(k,320)*y(k,63) +rxt(k,797)*y(k,160) + & - rxt(k,802)*y(k,171) +rxt(k,807)*y(k,173))*y(k,293) & - + (rxt(k,168)*y(k,292) +rxt(k,176)*y(k,156) +rxt(k,220)*y(k,57) + & - rxt(k,276)*y(k,75))*y(k,79) + (rxt(k,317)*y(k,55) + & - rxt(k,251)*y(k,87) +rxt(k,274)*y(k,83))*y(k,292) + (rxt(k,2) + & - 2.000_r8*rxt(k,3))*y(k,317) +2.000_r8*rxt(k,31)*y(k,43) +rxt(k,37) & - *y(k,54) +rxt(k,143)*y(k,83) +rxt(k,147)*y(k,87) +rxt(k,148)*y(k,91) - loss(k,215) = (rxt(k,220)* y(k,57) +rxt(k,276)* y(k,75) +rxt(k,176)* y(k,156) & + prod(k,290) = (rxt(k,185)*y(k,79) +rxt(k,188)*y(k,156) +rxt(k,206)*y(k,136) + & + rxt(k,301)*y(k,43) +rxt(k,796)*y(k,160) +rxt(k,802)*y(k,171) + & + rxt(k,807)*y(k,173))*y(k,293) + (rxt(k,168)*y(k,292) + & + rxt(k,176)*y(k,156) +rxt(k,220)*y(k,57) +rxt(k,276)*y(k,75))*y(k,79) & + + (rxt(k,38) +.330_r8*rxt(k,39) +rxt(k,316)*y(k,292))*y(k,55) & + + (rxt(k,143) +rxt(k,274)*y(k,292))*y(k,83) + (rxt(k,147) + & + rxt(k,251)*y(k,292))*y(k,87) + (rxt(k,2) +2.000_r8*rxt(k,3))*y(k,317) & + +2.000_r8*rxt(k,31)*y(k,43) +rxt(k,37)*y(k,54) +rxt(k,148)*y(k,91) + loss(k,249) = (rxt(k,220)* y(k,57) +rxt(k,276)* y(k,75) +rxt(k,176)* y(k,156) & +rxt(k,168)* y(k,292) +rxt(k,185)* y(k,293) + het_rates(k,79)) & * y(k,79) - prod(k,215) =rxt(k,32)*y(k,43) +rxt(k,318)*y(k,292)*y(k,55) & - +rxt(k,178)*y(k,256)*y(k,78) +rxt(k,1)*y(k,317) - loss(k,208) = (rxt(k,221)* y(k,57) +rxt(k,177)* y(k,156) +rxt(k,186) & + prod(k,249) = (1.440_r8*rxt(k,39) +rxt(k,317)*y(k,292))*y(k,55) +rxt(k,32) & + *y(k,43) +rxt(k,178)*y(k,256)*y(k,78) +rxt(k,1)*y(k,317) + loss(k,60) = (rxt(k,272)* y(k,292) + rxt(k,142) + het_rates(k,80))* y(k,80) + prod(k,60) = 0._r8 + loss(k,235) = (rxt(k,221)* y(k,57) +rxt(k,177)* y(k,156) +rxt(k,186) & * y(k,293) + rxt(k,4) + het_rates(k,81))* y(k,81) - prod(k,208) = (.660_r8*rxt(k,460)*y(k,115) +.660_r8*rxt(k,470)*y(k,118) + & - .660_r8*rxt(k,485)*y(k,121) +.030_r8*rxt(k,487)*y(k,109) + & - .660_r8*rxt(k,502)*y(k,139) +.220_r8*rxt(k,603)*y(k,4) + & - .170_r8*rxt(k,623)*y(k,7) +.320_r8*rxt(k,643)*y(k,17) + & - .330_r8*rxt(k,663)*y(k,125) +.020_r8*rxt(k,763)*y(k,210) + & - .040_r8*rxt(k,768)*y(k,211))*y(k,157) + (.500_r8*rxt(k,813) + & - rxt(k,192)*y(k,256))*y(k,256) +rxt(k,191)*y(k,293)*y(k,293) - loss(k,52) = ( + rxt(k,153) + het_rates(k,82))* y(k,82) - prod(k,52) =rxt(k,810)*y(k,317)*y(k,175) - loss(k,180) = (rxt(k,267)* y(k,156) + (rxt(k,273) +rxt(k,274))* y(k,292) & + prod(k,235) = (.660_r8*rxt(k,459)*y(k,115) +.660_r8*rxt(k,469)*y(k,118) + & + .660_r8*rxt(k,484)*y(k,121) +.030_r8*rxt(k,486)*y(k,109) + & + .660_r8*rxt(k,501)*y(k,139) +.220_r8*rxt(k,602)*y(k,4) + & + .170_r8*rxt(k,622)*y(k,7) +.320_r8*rxt(k,642)*y(k,17) + & + .330_r8*rxt(k,662)*y(k,125) +.020_r8*rxt(k,762)*y(k,210) + & + .040_r8*rxt(k,767)*y(k,211))*y(k,157) +rxt(k,192)*y(k,256)*y(k,256) & + +rxt(k,191)*y(k,293)*y(k,293) + loss(k,67) = ( + rxt(k,153) + het_rates(k,82))* y(k,82) + prod(k,67) =rxt(k,809)*y(k,317)*y(k,175) + loss(k,207) = (rxt(k,267)* y(k,156) + (rxt(k,273) +rxt(k,274))* y(k,292) & +rxt(k,268)* y(k,293) + rxt(k,143) + het_rates(k,83))* y(k,83) - prod(k,180) = (rxt(k,254)*y(k,43) +rxt(k,255)*y(k,256))*y(k,18) - loss(k,283) = ((rxt(k,891) +rxt(k,896) +rxt(k,901))* y(k,61) + (rxt(k,893) + & - rxt(k,898))* y(k,95) + (rxt(k,886) +rxt(k,892) +rxt(k,897))* y(k,96) & + prod(k,207) = (rxt(k,254)*y(k,43) +rxt(k,255)*y(k,256))*y(k,18) + loss(k,88) = (rxt(k,295)* y(k,292) +rxt(k,290)* y(k,293) + rxt(k,144) & + + het_rates(k,84))* y(k,84) + prod(k,88) = 0._r8 + loss(k,90) = (rxt(k,296)* y(k,292) +rxt(k,291)* y(k,293) + rxt(k,145) & + + het_rates(k,85))* y(k,85) + prod(k,90) = 0._r8 + loss(k,102) = (rxt(k,297)* y(k,292) +rxt(k,292)* y(k,293) + rxt(k,146) & + + het_rates(k,86))* y(k,86) + prod(k,102) = 0._r8 + loss(k,304) = ((rxt(k,890) +rxt(k,895) +rxt(k,900))* y(k,61) + (rxt(k,892) + & + rxt(k,897))* y(k,95) + (rxt(k,885) +rxt(k,891) +rxt(k,896))* y(k,96) & +rxt(k,238)* y(k,156) + (rxt(k,250) +rxt(k,251))* y(k,292) & +rxt(k,239)* y(k,293) + rxt(k,147) + het_rates(k,87))* y(k,87) - prod(k,283) = (rxt(k,219)*y(k,55) +rxt(k,281)*y(k,42) +rxt(k,283)*y(k,44) + & - 2.000_r8*rxt(k,286)*y(k,47) +rxt(k,288)*y(k,56) +rxt(k,218)*y(k,43) + & - rxt(k,220)*y(k,79) +rxt(k,221)*y(k,81) +rxt(k,222)*y(k,256) + & - rxt(k,240)*y(k,96) +rxt(k,331)*y(k,29))*y(k,57) +rxt(k,237)*y(k,293) & + prod(k,304) = (rxt(k,218)*y(k,43) +rxt(k,219)*y(k,55) +rxt(k,220)*y(k,79) + & + rxt(k,221)*y(k,81) +rxt(k,222)*y(k,256) +rxt(k,240)*y(k,96) + & + rxt(k,281)*y(k,42) +rxt(k,283)*y(k,44) +2.000_r8*rxt(k,286)*y(k,47) + & + rxt(k,288)*y(k,56) +rxt(k,330)*y(k,29))*y(k,57) +rxt(k,237)*y(k,293) & *y(k,60) - loss(k,59) = (rxt(k,319)* y(k,292) +rxt(k,310)* y(k,293) + het_rates(k,88)) & + loss(k,77) = (rxt(k,318)* y(k,292) +rxt(k,309)* y(k,293) + het_rates(k,88)) & * y(k,88) - prod(k,59) = 0._r8 - loss(k,149) = (rxt(k,348)* y(k,293) + rxt(k,45) + het_rates(k,89))* y(k,89) - prod(k,149) = (.680_r8*rxt(k,483)*y(k,256) +.810_r8*rxt(k,528)*y(k,147)) & - *y(k,274) +.700_r8*rxt(k,485)*y(k,157)*y(k,121) - loss(k,187) = (rxt(k,311)* y(k,293) + het_rates(k,90))* y(k,90) - prod(k,187) = (.370_r8*rxt(k,324)*y(k,26) +.120_r8*rxt(k,355)*y(k,30) + & - .330_r8*rxt(k,386)*y(k,126) +.120_r8*rxt(k,404)*y(k,132) + & - .220_r8*rxt(k,487)*y(k,109) +.080_r8*rxt(k,643)*y(k,17) + & - .150_r8*rxt(k,763)*y(k,210) +.260_r8*rxt(k,768)*y(k,211))*y(k,157) & - + (.500_r8*rxt(k,312)*y(k,92) +.350_r8*rxt(k,322)*y(k,25) + & - .400_r8*rxt(k,423)*y(k,107))*y(k,293) & - + (.500_r8*rxt(k,313)*y(k,256) +rxt(k,315)*y(k,147))*y(k,257) & + prod(k,77) = 0._r8 + loss(k,175) = (rxt(k,347)* y(k,293) + rxt(k,45) + het_rates(k,89))* y(k,89) + prod(k,175) = (.680_r8*rxt(k,482)*y(k,256) +.810_r8*rxt(k,527)*y(k,147)) & + *y(k,274) +.700_r8*rxt(k,484)*y(k,157)*y(k,121) + loss(k,224) = (rxt(k,310)* y(k,293) + het_rates(k,90))* y(k,90) + prod(k,224) = (.370_r8*rxt(k,323)*y(k,26) +.120_r8*rxt(k,354)*y(k,30) + & + .330_r8*rxt(k,385)*y(k,126) +.120_r8*rxt(k,403)*y(k,132) + & + .220_r8*rxt(k,486)*y(k,109) +.080_r8*rxt(k,642)*y(k,17) + & + .150_r8*rxt(k,762)*y(k,210) +.260_r8*rxt(k,767)*y(k,211))*y(k,157) & + + (.500_r8*rxt(k,311)*y(k,92) +.350_r8*rxt(k,321)*y(k,25) + & + .400_r8*rxt(k,422)*y(k,107))*y(k,293) & + + (.500_r8*rxt(k,312)*y(k,256) +rxt(k,314)*y(k,147))*y(k,257) & +.410_r8*rxt(k,48)*y(k,98) - loss(k,68) = ( + rxt(k,148) + het_rates(k,91))* y(k,91) - prod(k,68) = (rxt(k,275)*y(k,55) +rxt(k,276)*y(k,79) +rxt(k,277)*y(k,317) + & + loss(k,106) = ( + rxt(k,148) + het_rates(k,91))* y(k,91) + prod(k,106) = (rxt(k,275)*y(k,55) +rxt(k,276)*y(k,79) +rxt(k,277)*y(k,317) + & rxt(k,278)*y(k,93))*y(k,75) - loss(k,186) = (rxt(k,312)* y(k,293) + rxt(k,46) + het_rates(k,92))* y(k,92) - prod(k,186) = (.330_r8*rxt(k,487)*y(k,109) +.110_r8*rxt(k,643)*y(k,17) + & - .230_r8*rxt(k,763)*y(k,210) +.400_r8*rxt(k,768)*y(k,211))*y(k,157) & - +.500_r8*rxt(k,313)*y(k,257)*y(k,256) - loss(k,270) = (rxt(k,278)* y(k,75) +rxt(k,215)* y(k,293) + rxt(k,9) & + loss(k,211) = (rxt(k,311)* y(k,293) + rxt(k,46) + het_rates(k,92))* y(k,92) + prod(k,211) = (.330_r8*rxt(k,486)*y(k,109) +.110_r8*rxt(k,642)*y(k,17) + & + .230_r8*rxt(k,762)*y(k,210) +.400_r8*rxt(k,767)*y(k,211))*y(k,157) & + +.500_r8*rxt(k,312)*y(k,257)*y(k,256) + loss(k,306) = (rxt(k,278)* y(k,75) +rxt(k,215)* y(k,293) + rxt(k,9) & + het_rates(k,93))* y(k,93) - prod(k,270) = (rxt(k,832) +rxt(k,299)*y(k,43) +rxt(k,333)*y(k,46) + & - rxt(k,361)*y(k,50) +rxt(k,709)*y(k,201) +rxt(k,728)*y(k,203) + & - rxt(k,756)*y(k,200) +rxt(k,794)*y(k,69))*y(k,149) + (rxt(k,889) + & - rxt(k,894) +rxt(k,900) +rxt(k,891)*y(k,87) +rxt(k,896)*y(k,87) + & - rxt(k,901)*y(k,87))*y(k,61) + (2.000_r8*rxt(k,828) + & - 2.000_r8*rxt(k,885) +2.000_r8*rxt(k,888) +2.000_r8*rxt(k,899)) & - *y(k,138) + (rxt(k,887) +rxt(k,890) +rxt(k,895))*y(k,21) & - + (.500_r8*rxt(k,831) +rxt(k,214)*y(k,293))*y(k,148) +rxt(k,814) & - *y(k,97) +rxt(k,817)*y(k,107) +rxt(k,818)*y(k,108) +rxt(k,820) & - *y(k,110) +rxt(k,821)*y(k,111) +rxt(k,825)*y(k,115) +rxt(k,826) & - *y(k,116) +rxt(k,827)*y(k,118) +rxt(k,819)*y(k,121) +rxt(k,829) & - *y(k,139) +rxt(k,833)*y(k,161) +rxt(k,836)*y(k,212) +rxt(k,839) & - *y(k,217) +rxt(k,838)*y(k,218) +rxt(k,841)*y(k,221) +rxt(k,840) & + prod(k,306) = (rxt(k,831) +rxt(k,299)*y(k,43) +rxt(k,332)*y(k,46) + & + rxt(k,360)*y(k,50) +rxt(k,708)*y(k,201) +rxt(k,727)*y(k,203) + & + rxt(k,755)*y(k,200) +rxt(k,793)*y(k,69))*y(k,149) + (rxt(k,888) + & + rxt(k,893) +rxt(k,899) +rxt(k,890)*y(k,87) +rxt(k,895)*y(k,87) + & + rxt(k,900)*y(k,87))*y(k,61) + (2.000_r8*rxt(k,827) + & + 2.000_r8*rxt(k,884) +2.000_r8*rxt(k,887) +2.000_r8*rxt(k,898)) & + *y(k,138) + (rxt(k,886) +rxt(k,889) +rxt(k,894))*y(k,21) & + + (.500_r8*rxt(k,830) +rxt(k,214)*y(k,293))*y(k,148) +rxt(k,813) & + *y(k,97) +rxt(k,816)*y(k,107) +rxt(k,817)*y(k,108) +rxt(k,819) & + *y(k,110) +rxt(k,820)*y(k,111) +rxt(k,824)*y(k,115) +rxt(k,825) & + *y(k,116) +rxt(k,826)*y(k,118) +rxt(k,818)*y(k,121) +rxt(k,828) & + *y(k,139) +rxt(k,832)*y(k,161) +rxt(k,835)*y(k,212) +rxt(k,838) & + *y(k,217) +rxt(k,837)*y(k,218) +rxt(k,840)*y(k,221) +rxt(k,839) & *y(k,222) - loss(k,103) = (rxt(k,193)* y(k,293) + rxt(k,10) + rxt(k,11) + rxt(k,216) & + loss(k,127) = (rxt(k,193)* y(k,293) + rxt(k,10) + rxt(k,11) + rxt(k,216) & + het_rates(k,94))* y(k,94) - prod(k,103) =rxt(k,212)*y(k,256)*y(k,148) - loss(k,168) = ((rxt(k,893) +rxt(k,898))* y(k,87) +rxt(k,269)* y(k,156) & + prod(k,127) =rxt(k,212)*y(k,256)*y(k,148) + loss(k,193) = ((rxt(k,892) +rxt(k,897))* y(k,87) +rxt(k,269)* y(k,156) & + rxt(k,149) + het_rates(k,95))* y(k,95) - prod(k,168) = (rxt(k,887) +rxt(k,890) +rxt(k,895))*y(k,21) & + prod(k,193) = (rxt(k,886) +rxt(k,889) +rxt(k,894))*y(k,21) & +rxt(k,261)*y(k,256)*y(k,20) - loss(k,182) = (rxt(k,240)* y(k,57) + (rxt(k,886) +rxt(k,892) +rxt(k,897)) & + loss(k,205) = (rxt(k,240)* y(k,57) + (rxt(k,885) +rxt(k,891) +rxt(k,896)) & * y(k,87) +rxt(k,241)* y(k,156) +rxt(k,242)* y(k,293) + rxt(k,150) & + het_rates(k,96))* y(k,96) - prod(k,182) = (rxt(k,889) +rxt(k,894) +rxt(k,900) +rxt(k,234)*y(k,293)) & + prod(k,205) = (rxt(k,888) +rxt(k,893) +rxt(k,899) +rxt(k,234)*y(k,293)) & *y(k,61) +rxt(k,229)*y(k,256)*y(k,60) - loss(k,165) = (rxt(k,380)* y(k,293) + rxt(k,47) + rxt(k,814) & + loss(k,191) = (rxt(k,379)* y(k,293) + rxt(k,47) + rxt(k,813) & + het_rates(k,97))* y(k,97) - prod(k,165) =rxt(k,379)*y(k,253)*y(k,147) - loss(k,130) = (rxt(k,415)* y(k,293) + rxt(k,48) + het_rates(k,98))* y(k,98) - prod(k,130) =.250_r8*rxt(k,530)*y(k,276) - loss(k,131) = (rxt(k,416)* y(k,293) + rxt(k,49) + het_rates(k,99))* y(k,99) - prod(k,131) =.250_r8*rxt(k,533)*y(k,277) - loss(k,112) = (rxt(k,417)* y(k,293) + rxt(k,50) + het_rates(k,100))* y(k,100) - prod(k,112) =.090_r8*rxt(k,490)*y(k,293)*y(k,123) +.150_r8*rxt(k,530) & + prod(k,191) =rxt(k,378)*y(k,253)*y(k,147) + loss(k,152) = (rxt(k,414)* y(k,293) + rxt(k,48) + het_rates(k,98))* y(k,98) + prod(k,152) =.250_r8*rxt(k,529)*y(k,276) + loss(k,159) = (rxt(k,415)* y(k,293) + rxt(k,49) + het_rates(k,99))* y(k,99) + prod(k,159) =.250_r8*rxt(k,532)*y(k,277) + loss(k,133) = (rxt(k,416)* y(k,293) + rxt(k,50) + het_rates(k,100))* y(k,100) + prod(k,133) =.090_r8*rxt(k,489)*y(k,293)*y(k,123) +.150_r8*rxt(k,529) & *y(k,276) - loss(k,113) = (rxt(k,418)* y(k,293) + rxt(k,51) + het_rates(k,101))* y(k,101) - prod(k,113) =.090_r8*rxt(k,490)*y(k,293)*y(k,123) +.150_r8*rxt(k,533) & + loss(k,135) = (rxt(k,417)* y(k,293) + rxt(k,51) + het_rates(k,101))* y(k,101) + prod(k,135) =.090_r8*rxt(k,489)*y(k,293)*y(k,123) +.150_r8*rxt(k,532) & *y(k,277) - loss(k,228) = (rxt(k,363)* y(k,293) + rxt(k,52) + het_rates(k,102))* y(k,102) - prod(k,228) = (.500_r8*rxt(k,368)*y(k,169) +.500_r8*rxt(k,381)*y(k,127) + & - rxt(k,388)*y(k,128) +.250_r8*rxt(k,399)*y(k,131) + & - .220_r8*rxt(k,419)*y(k,103) +.500_r8*rxt(k,420)*y(k,105) + & - .190_r8*rxt(k,424)*y(k,108) +.280_r8*rxt(k,457)*y(k,114) + & - rxt(k,489)*y(k,122) +.070_r8*rxt(k,491)*y(k,123))*y(k,293) & - + (.290_r8*rxt(k,504)*y(k,258) +.730_r8*rxt(k,516)*y(k,268) + & - .870_r8*rxt(k,520)*y(k,270) +.330_r8*rxt(k,522)*y(k,271) + & - .070_r8*rxt(k,526)*y(k,273) +.860_r8*rxt(k,536)*y(k,282))*y(k,147) & - + (.510_r8*rxt(k,384)*y(k,282) +.190_r8*rxt(k,422)*y(k,258) + & - .460_r8*rxt(k,462)*y(k,268) +.440_r8*rxt(k,468)*y(k,270) + & - .150_r8*rxt(k,472)*y(k,271) +.060_r8*rxt(k,480)*y(k,273))*y(k,256) & - + (rxt(k,385) +.860_r8*rxt(k,382)*y(k,250) + & - .900_r8*rxt(k,383)*y(k,251))*y(k,282) & - + (.830_r8*rxt(k,470)*y(k,118) +.180_r8*rxt(k,683)*y(k,135)) & + loss(k,256) = (rxt(k,362)* y(k,293) + rxt(k,52) + het_rates(k,102))* y(k,102) + prod(k,256) = (.500_r8*rxt(k,367)*y(k,169) +.500_r8*rxt(k,380)*y(k,127) + & + rxt(k,387)*y(k,128) +.250_r8*rxt(k,398)*y(k,131) + & + .220_r8*rxt(k,418)*y(k,103) +.500_r8*rxt(k,419)*y(k,105) + & + .190_r8*rxt(k,423)*y(k,108) +.280_r8*rxt(k,456)*y(k,114) + & + rxt(k,488)*y(k,122) +.070_r8*rxt(k,490)*y(k,123))*y(k,293) & + + (.290_r8*rxt(k,503)*y(k,258) +.730_r8*rxt(k,515)*y(k,268) + & + .870_r8*rxt(k,519)*y(k,270) +.330_r8*rxt(k,521)*y(k,271) + & + .070_r8*rxt(k,525)*y(k,273) +.860_r8*rxt(k,535)*y(k,282))*y(k,147) & + + (.510_r8*rxt(k,383)*y(k,282) +.190_r8*rxt(k,421)*y(k,258) + & + .460_r8*rxt(k,461)*y(k,268) +.440_r8*rxt(k,467)*y(k,270) + & + .150_r8*rxt(k,471)*y(k,271) +.060_r8*rxt(k,479)*y(k,273))*y(k,256) & + + (rxt(k,384) +.860_r8*rxt(k,381)*y(k,250) + & + .900_r8*rxt(k,382)*y(k,251))*y(k,282) & + + (.830_r8*rxt(k,469)*y(k,118) +.180_r8*rxt(k,682)*y(k,135)) & *y(k,157) +.170_r8*rxt(k,47)*y(k,97) +.500_r8*rxt(k,53)*y(k,103) & +rxt(k,59)*y(k,110) +.500_r8*rxt(k,60)*y(k,111) +.500_r8*rxt(k,61) & *y(k,112) +rxt(k,62)*y(k,113) +.280_r8*rxt(k,63)*y(k,114) & +.500_r8*rxt(k,74)*y(k,127) +.860_r8*rxt(k,75)*y(k,128) & - +.200_r8*rxt(k,369)*y(k,296)*y(k,251) - loss(k,234) = (rxt(k,419)* y(k,293) + rxt(k,53) + rxt(k,54) & + +.200_r8*rxt(k,368)*y(k,296)*y(k,251) + loss(k,261) = (rxt(k,418)* y(k,293) + rxt(k,53) + rxt(k,54) & + het_rates(k,103))* y(k,103) - prod(k,234) = (.250_r8*rxt(k,432)*y(k,260) +.470_r8*rxt(k,446)*y(k,265) + & - .470_r8*rxt(k,450)*y(k,266) +.470_r8*rxt(k,493)*y(k,276) + & - .470_r8*rxt(k,497)*y(k,277))*y(k,251) & - + (.450_r8*rxt(k,510)*y(k,265) +.450_r8*rxt(k,512)*y(k,266) + & - .450_r8*rxt(k,531)*y(k,276) +.450_r8*rxt(k,534)*y(k,277))*y(k,147) & - + (.450_r8*rxt(k,445)*y(k,265) +.450_r8*rxt(k,449)*y(k,266) + & - .450_r8*rxt(k,492)*y(k,276) +.450_r8*rxt(k,496)*y(k,277))*y(k,250) & + prod(k,261) = (.250_r8*rxt(k,431)*y(k,260) +.470_r8*rxt(k,445)*y(k,265) + & + .470_r8*rxt(k,449)*y(k,266) +.470_r8*rxt(k,492)*y(k,276) + & + .470_r8*rxt(k,496)*y(k,277))*y(k,251) & + + (.450_r8*rxt(k,509)*y(k,265) +.450_r8*rxt(k,511)*y(k,266) + & + .450_r8*rxt(k,530)*y(k,276) +.450_r8*rxt(k,533)*y(k,277))*y(k,147) & + + (.450_r8*rxt(k,444)*y(k,265) +.450_r8*rxt(k,448)*y(k,266) + & + .450_r8*rxt(k,491)*y(k,276) +.450_r8*rxt(k,495)*y(k,277))*y(k,250) & +.450_r8*rxt(k,64)*y(k,115) +.450_r8*rxt(k,67)*y(k,118) & - +.130_r8*rxt(k,490)*y(k,293)*y(k,123) +rxt(k,82)*y(k,139) - loss(k,158) = (rxt(k,364)* y(k,293) + rxt(k,55) + rxt(k,56) & + +.130_r8*rxt(k,489)*y(k,293)*y(k,123) +rxt(k,82)*y(k,139) + loss(k,189) = (rxt(k,363)* y(k,293) + rxt(k,55) + rxt(k,56) & + het_rates(k,104))* y(k,104) - prod(k,158) = (.500_r8*rxt(k,41) +rxt(k,377)*y(k,293))*y(k,68) & - + (.120_r8*rxt(k,483)*y(k,256) +.150_r8*rxt(k,528)*y(k,147)) & - *y(k,274) +.150_r8*rxt(k,416)*y(k,293)*y(k,99) & - +.130_r8*rxt(k,485)*y(k,157)*y(k,121) - loss(k,198) = (rxt(k,420)* y(k,293) + rxt(k,815) + het_rates(k,105)) & + prod(k,189) = (.500_r8*rxt(k,41) +rxt(k,376)*y(k,293))*y(k,68) & + + (.120_r8*rxt(k,482)*y(k,256) +.150_r8*rxt(k,527)*y(k,147)) & + *y(k,274) +.150_r8*rxt(k,415)*y(k,293)*y(k,99) & + +.130_r8*rxt(k,484)*y(k,157)*y(k,121) + loss(k,184) = (rxt(k,419)* y(k,293) + rxt(k,814) + het_rates(k,105)) & * y(k,105) - prod(k,198) = (.080_r8*rxt(k,415)*y(k,98) +.180_r8*rxt(k,416)*y(k,99) + & - .580_r8*rxt(k,417)*y(k,100) +.770_r8*rxt(k,418)*y(k,101) + & - .190_r8*rxt(k,421)*y(k,106) +.040_r8*rxt(k,503)*y(k,139))*y(k,293) & + prod(k,184) = (.080_r8*rxt(k,414)*y(k,98) +.180_r8*rxt(k,415)*y(k,99) + & + .580_r8*rxt(k,416)*y(k,100) +.770_r8*rxt(k,417)*y(k,101) + & + .190_r8*rxt(k,420)*y(k,106) +.040_r8*rxt(k,502)*y(k,139))*y(k,293) & +rxt(k,57)*y(k,107) +rxt(k,58)*y(k,108) - loss(k,157) = (rxt(k,421)* y(k,293) + rxt(k,816) + het_rates(k,106)) & + loss(k,239) = (rxt(k,420)* y(k,293) + rxt(k,815) + het_rates(k,106)) & * y(k,106) - prod(k,157) = (.080_r8*rxt(k,461)*y(k,115) +.150_r8*rxt(k,464)*y(k,116) + & - .130_r8*rxt(k,467)*y(k,117) +.040_r8*rxt(k,471)*y(k,118) + & - .070_r8*rxt(k,486)*y(k,121) +.850_r8*rxt(k,491)*y(k,123))*y(k,293) - loss(k,111) = (rxt(k,423)* y(k,293) + rxt(k,57) + rxt(k,817) & + prod(k,239) = (.080_r8*rxt(k,460)*y(k,115) +.150_r8*rxt(k,463)*y(k,116) + & + .130_r8*rxt(k,466)*y(k,117) +.040_r8*rxt(k,470)*y(k,118) + & + .070_r8*rxt(k,485)*y(k,121) +.850_r8*rxt(k,490)*y(k,123))*y(k,293) + loss(k,134) = (rxt(k,422)* y(k,293) + rxt(k,57) + rxt(k,816) & + het_rates(k,107))* y(k,107) - prod(k,111) = (.200_r8*rxt(k,423)*y(k,107) +.400_r8*rxt(k,482)*y(k,120)) & + prod(k,134) = (.200_r8*rxt(k,422)*y(k,107) +.400_r8*rxt(k,481)*y(k,120)) & *y(k,293) - loss(k,184) = (rxt(k,424)* y(k,293) + rxt(k,58) + rxt(k,818) & + loss(k,216) = (rxt(k,423)* y(k,293) + rxt(k,58) + rxt(k,817) & + het_rates(k,108))* y(k,108) - prod(k,184) = (.060_r8*rxt(k,424)*y(k,108) +.030_r8*rxt(k,473)*y(k,119) + & - .200_r8*rxt(k,486)*y(k,121))*y(k,293) - loss(k,202) = (rxt(k,474)* y(k,149) +rxt(k,487)* y(k,157) +rxt(k,488) & + prod(k,216) = (.060_r8*rxt(k,423)*y(k,108) +.030_r8*rxt(k,472)*y(k,119) + & + .200_r8*rxt(k,485)*y(k,121))*y(k,293) + loss(k,226) = (rxt(k,473)* y(k,149) +rxt(k,486)* y(k,157) +rxt(k,487) & * y(k,293) + het_rates(k,109))* y(k,109) - prod(k,202) = 0._r8 - loss(k,222) = (rxt(k,454)* y(k,293) + rxt(k,59) + rxt(k,820) & + prod(k,226) = 0._r8 + loss(k,248) = (rxt(k,453)* y(k,293) + rxt(k,59) + rxt(k,819) & + het_rates(k,110))* y(k,110) - prod(k,222) = (rxt(k,515)*y(k,267) +rxt(k,517)*y(k,268) + & - rxt(k,519)*y(k,269) +rxt(k,521)*y(k,270) +rxt(k,523)*y(k,271) + & - rxt(k,525)*y(k,272) +rxt(k,527)*y(k,273) +rxt(k,529)*y(k,274)) & + prod(k,248) = (rxt(k,514)*y(k,267) +rxt(k,516)*y(k,268) + & + rxt(k,518)*y(k,269) +rxt(k,520)*y(k,270) +rxt(k,522)*y(k,271) + & + rxt(k,524)*y(k,272) +rxt(k,526)*y(k,273) +rxt(k,528)*y(k,274)) & *y(k,147) - loss(k,178) = (rxt(k,453)* y(k,293) + rxt(k,60) + rxt(k,821) & + loss(k,202) = (rxt(k,452)* y(k,293) + rxt(k,60) + rxt(k,820) & + het_rates(k,111))* y(k,111) - prod(k,178) =rxt(k,454)*y(k,293)*y(k,110) +rxt(k,541)*y(k,291)*y(k,147) - loss(k,230) = (rxt(k,455)* y(k,293) + rxt(k,61) + rxt(k,822) & + prod(k,202) =rxt(k,453)*y(k,293)*y(k,110) +rxt(k,540)*y(k,291)*y(k,147) + loss(k,258) = (rxt(k,454)* y(k,293) + rxt(k,61) + rxt(k,821) & + het_rates(k,112))* y(k,112) - prod(k,230) =rxt(k,456)*y(k,293)*y(k,113) +rxt(k,505)*y(k,258)*y(k,147) & - +rxt(k,463)*y(k,268) +rxt(k,466)*y(k,269) - loss(k,206) = (rxt(k,456)* y(k,293) + rxt(k,62) + rxt(k,823) & + prod(k,258) =rxt(k,455)*y(k,293)*y(k,113) +rxt(k,504)*y(k,258)*y(k,147) & + +rxt(k,462)*y(k,268) +rxt(k,465)*y(k,269) + loss(k,232) = (rxt(k,455)* y(k,293) + rxt(k,62) + rxt(k,822) & + het_rates(k,113))* y(k,113) - prod(k,206) = (.420_r8*rxt(k,458)*y(k,267) +.480_r8*rxt(k,462)*y(k,268) + & - .400_r8*rxt(k,465)*y(k,269) +.500_r8*rxt(k,468)*y(k,270) + & - .600_r8*rxt(k,472)*y(k,271) +.490_r8*rxt(k,480)*y(k,273) + & - .170_r8*rxt(k,483)*y(k,274) +.200_r8*rxt(k,500)*y(k,291))*y(k,256) & - +rxt(k,459)*y(k,267) +rxt(k,469)*y(k,270) +rxt(k,481)*y(k,273) & - +rxt(k,484)*y(k,274) - loss(k,143) = (rxt(k,457)* y(k,293) + rxt(k,63) + rxt(k,824) & + prod(k,232) = (.420_r8*rxt(k,457)*y(k,267) +.480_r8*rxt(k,461)*y(k,268) + & + .400_r8*rxt(k,464)*y(k,269) +.500_r8*rxt(k,467)*y(k,270) + & + .600_r8*rxt(k,471)*y(k,271) +.490_r8*rxt(k,479)*y(k,273) + & + .170_r8*rxt(k,482)*y(k,274) +.200_r8*rxt(k,499)*y(k,291))*y(k,256) & + +rxt(k,458)*y(k,267) +rxt(k,468)*y(k,270) +rxt(k,480)*y(k,273) & + +rxt(k,483)*y(k,274) + loss(k,169) = (rxt(k,456)* y(k,293) + rxt(k,63) + rxt(k,823) & + het_rates(k,114))* y(k,114) - prod(k,143) =.080_r8*rxt(k,491)*y(k,293)*y(k,123) & - +.350_r8*rxt(k,422)*y(k,258)*y(k,256) - loss(k,243) = (rxt(k,460)* y(k,157) +rxt(k,461)* y(k,293) + rxt(k,64) & - + rxt(k,825) + het_rates(k,115))* y(k,115) - prod(k,243) = (rxt(k,513)*y(k,266) +rxt(k,535)*y(k,277))*y(k,147) & - + (.280_r8*rxt(k,476)*y(k,251) +.530_r8*rxt(k,478)*y(k,272)) & + prod(k,169) =.080_r8*rxt(k,490)*y(k,293)*y(k,123) & + +.350_r8*rxt(k,421)*y(k,258)*y(k,256) + loss(k,271) = (rxt(k,459)* y(k,157) +rxt(k,460)* y(k,293) + rxt(k,64) & + + rxt(k,824) + het_rates(k,115))* y(k,115) + prod(k,271) = (rxt(k,512)*y(k,266) +rxt(k,534)*y(k,277))*y(k,147) & + + (.280_r8*rxt(k,475)*y(k,251) +.530_r8*rxt(k,477)*y(k,272)) & *y(k,272) - loss(k,133) = (rxt(k,464)* y(k,293) + rxt(k,65) + rxt(k,826) & + loss(k,151) = (rxt(k,463)* y(k,293) + rxt(k,65) + rxt(k,825) & + het_rates(k,116))* y(k,116) - prod(k,133) =rxt(k,507)*y(k,259)*y(k,147) - loss(k,120) = (rxt(k,467)* y(k,293) + rxt(k,66) + het_rates(k,117))* y(k,117) - prod(k,120) =rxt(k,509)*y(k,260)*y(k,147) - loss(k,244) = (rxt(k,470)* y(k,157) +rxt(k,471)* y(k,293) + rxt(k,67) & - + rxt(k,827) + het_rates(k,118))* y(k,118) - prod(k,244) = (rxt(k,511)*y(k,265) +rxt(k,532)*y(k,276))*y(k,147) & - + (.050_r8*rxt(k,476)*y(k,251) +.090_r8*rxt(k,478)*y(k,272)) & + prod(k,151) =rxt(k,506)*y(k,259)*y(k,147) + loss(k,144) = (rxt(k,466)* y(k,293) + rxt(k,66) + het_rates(k,117))* y(k,117) + prod(k,144) =rxt(k,508)*y(k,260)*y(k,147) + loss(k,270) = (rxt(k,469)* y(k,157) +rxt(k,470)* y(k,293) + rxt(k,67) & + + rxt(k,826) + het_rates(k,118))* y(k,118) + prod(k,270) = (rxt(k,510)*y(k,265) +rxt(k,531)*y(k,276))*y(k,147) & + + (.050_r8*rxt(k,475)*y(k,251) +.090_r8*rxt(k,477)*y(k,272)) & *y(k,272) - loss(k,139) = (rxt(k,473)* y(k,293) + rxt(k,68) + het_rates(k,119))* y(k,119) - prod(k,139) = (.070_r8*rxt(k,476)*y(k,251) +.150_r8*rxt(k,478)*y(k,272)) & + loss(k,167) = (rxt(k,472)* y(k,293) + rxt(k,68) + het_rates(k,119))* y(k,119) + prod(k,167) = (.070_r8*rxt(k,475)*y(k,251) +.150_r8*rxt(k,477)*y(k,272)) & *y(k,272) - loss(k,181) = (rxt(k,482)* y(k,293) + rxt(k,69) + het_rates(k,120))* y(k,120) - prod(k,181) =.230_r8*rxt(k,477)*y(k,272)*y(k,256) - loss(k,216) = (rxt(k,485)* y(k,157) +rxt(k,486)* y(k,293) + rxt(k,70) & - + rxt(k,819) + het_rates(k,121))* y(k,121) - prod(k,216) =.530_r8*rxt(k,477)*y(k,272)*y(k,256) - loss(k,156) = (rxt(k,489)* y(k,293) + het_rates(k,122))* y(k,122) - prod(k,156) = (.250_r8*rxt(k,426)*y(k,259) +.250_r8*rxt(k,432)*y(k,260) + & - .250_r8*rxt(k,446)*y(k,265) +.250_r8*rxt(k,450)*y(k,266) + & - .250_r8*rxt(k,493)*y(k,276) +.250_r8*rxt(k,497)*y(k,277))*y(k,251) - loss(k,242) = ((rxt(k,490) +rxt(k,491))* y(k,293) + rxt(k,71) & + loss(k,209) = (rxt(k,481)* y(k,293) + rxt(k,69) + het_rates(k,120))* y(k,120) + prod(k,209) =.230_r8*rxt(k,476)*y(k,272)*y(k,256) + loss(k,243) = (rxt(k,484)* y(k,157) +rxt(k,485)* y(k,293) + rxt(k,70) & + + rxt(k,818) + het_rates(k,121))* y(k,121) + prod(k,243) =.530_r8*rxt(k,476)*y(k,272)*y(k,256) + loss(k,183) = (rxt(k,488)* y(k,293) + het_rates(k,122))* y(k,122) + prod(k,183) = (.250_r8*rxt(k,425)*y(k,259) +.250_r8*rxt(k,431)*y(k,260) + & + .250_r8*rxt(k,445)*y(k,265) +.250_r8*rxt(k,449)*y(k,266) + & + .250_r8*rxt(k,492)*y(k,276) +.250_r8*rxt(k,496)*y(k,277))*y(k,251) + loss(k,262) = ((rxt(k,489) +rxt(k,490))* y(k,293) + rxt(k,71) & + het_rates(k,123))* y(k,123) - prod(k,242) = (.940_r8*rxt(k,427)*y(k,259) +.940_r8*rxt(k,433)*y(k,260) + & - rxt(k,447)*y(k,265) +rxt(k,451)*y(k,266) +rxt(k,494)*y(k,276) + & - rxt(k,498)*y(k,277))*y(k,256) - loss(k,42) = (rxt(k,867)* y(k,293) + het_rates(k,124))* y(k,124) - prod(k,42) = 0._r8 - loss(k,172) = (rxt(k,645)* y(k,149) +rxt(k,663)* y(k,157) +rxt(k,664) & + prod(k,262) = (.940_r8*rxt(k,426)*y(k,259) +.940_r8*rxt(k,432)*y(k,260) + & + rxt(k,446)*y(k,265) +rxt(k,450)*y(k,266) +rxt(k,493)*y(k,276) + & + rxt(k,497)*y(k,277))*y(k,256) + loss(k,51) = (rxt(k,866)* y(k,293) + het_rates(k,124))* y(k,124) + prod(k,51) = 0._r8 + loss(k,199) = (rxt(k,644)* y(k,149) +rxt(k,662)* y(k,157) +rxt(k,663) & * y(k,293) + het_rates(k,125))* y(k,125) - prod(k,172) = 0._r8 - loss(k,236) = (rxt(k,386)* y(k,157) +rxt(k,387)* y(k,293) + rxt(k,72) & + prod(k,199) = 0._r8 + loss(k,268) = (rxt(k,385)* y(k,157) +rxt(k,386)* y(k,293) + rxt(k,72) & + rxt(k,73) + het_rates(k,126))* y(k,126) - prod(k,236) = (.040_r8*rxt(k,475)*y(k,250) +.020_r8*rxt(k,476)*y(k,251) + & - .020_r8*rxt(k,477)*y(k,256) +.160_r8*rxt(k,478)*y(k,272) + & - .040_r8*rxt(k,479)*y(k,149) +.040_r8*rxt(k,524)*y(k,147))*y(k,272) & - + (rxt(k,434) +rxt(k,431)*y(k,250) +.500_r8*rxt(k,432)*y(k,251) + & - .060_r8*rxt(k,433)*y(k,256) +rxt(k,508)*y(k,147))*y(k,260) & - + (rxt(k,51) +.140_r8*rxt(k,418)*y(k,293))*y(k,101) & - +.350_r8*rxt(k,416)*y(k,293)*y(k,99) +.410_r8*rxt(k,487)*y(k,157) & + prod(k,268) = (.040_r8*rxt(k,474)*y(k,250) +.020_r8*rxt(k,475)*y(k,251) + & + .020_r8*rxt(k,476)*y(k,256) +.160_r8*rxt(k,477)*y(k,272) + & + .040_r8*rxt(k,478)*y(k,149) +.040_r8*rxt(k,523)*y(k,147))*y(k,272) & + + (rxt(k,433) +rxt(k,430)*y(k,250) +.500_r8*rxt(k,431)*y(k,251) + & + .060_r8*rxt(k,432)*y(k,256) +rxt(k,507)*y(k,147))*y(k,260) & + + (rxt(k,51) +.140_r8*rxt(k,417)*y(k,293))*y(k,101) & + +.350_r8*rxt(k,415)*y(k,293)*y(k,99) +.410_r8*rxt(k,486)*y(k,157) & *y(k,109) +rxt(k,66)*y(k,117) +.500_r8*rxt(k,68)*y(k,119) & +.120_r8*rxt(k,69)*y(k,120) +.300_r8*rxt(k,71)*y(k,123) - loss(k,229) = (rxt(k,381)* y(k,293) + rxt(k,74) + het_rates(k,127))* y(k,127) - prod(k,229) = (.060_r8*rxt(k,514)*y(k,267) +.270_r8*rxt(k,516)*y(k,268) + & - .210_r8*rxt(k,522)*y(k,271) +.490_r8*rxt(k,526)*y(k,273) + & - .020_r8*rxt(k,528)*y(k,274) +rxt(k,537)*y(k,282) + & - .390_r8*rxt(k,540)*y(k,291))*y(k,147) & - + (.030_r8*rxt(k,458)*y(k,267) +.060_r8*rxt(k,462)*y(k,268) + & - .060_r8*rxt(k,472)*y(k,271) +.150_r8*rxt(k,480)*y(k,273) + & - .020_r8*rxt(k,483)*y(k,274) +.290_r8*rxt(k,500)*y(k,291))*y(k,256) & - + (.500_r8*rxt(k,453)*y(k,111) +.250_r8*rxt(k,455)*y(k,112) + & - .060_r8*rxt(k,461)*y(k,115) +.240_r8*rxt(k,503)*y(k,139))*y(k,293) & - +.510_r8*rxt(k,501)*y(k,291) - loss(k,205) = (rxt(k,388)* y(k,293) + rxt(k,75) + het_rates(k,128))* y(k,128) - prod(k,205) = (.550_r8*rxt(k,449)*y(k,250) +.280_r8*rxt(k,450)*y(k,251) + & - .550_r8*rxt(k,512)*y(k,147))*y(k,266) & - + (.550_r8*rxt(k,496)*y(k,250) +.280_r8*rxt(k,497)*y(k,251) + & - .550_r8*rxt(k,534)*y(k,147))*y(k,277) & - + (.090_r8*rxt(k,418)*y(k,101) +.250_r8*rxt(k,455)*y(k,112)) & - *y(k,293) +.550_r8*rxt(k,64)*y(k,115) +.410_r8*rxt(k,384)*y(k,282) & + loss(k,254) = (rxt(k,380)* y(k,293) + rxt(k,74) + het_rates(k,127))* y(k,127) + prod(k,254) = (.060_r8*rxt(k,513)*y(k,267) +.270_r8*rxt(k,515)*y(k,268) + & + .210_r8*rxt(k,521)*y(k,271) +.490_r8*rxt(k,525)*y(k,273) + & + .020_r8*rxt(k,527)*y(k,274) +rxt(k,536)*y(k,282) + & + .390_r8*rxt(k,539)*y(k,291))*y(k,147) & + + (.030_r8*rxt(k,457)*y(k,267) +.060_r8*rxt(k,461)*y(k,268) + & + .060_r8*rxt(k,471)*y(k,271) +.150_r8*rxt(k,479)*y(k,273) + & + .020_r8*rxt(k,482)*y(k,274) +.290_r8*rxt(k,499)*y(k,291))*y(k,256) & + + (.500_r8*rxt(k,452)*y(k,111) +.250_r8*rxt(k,454)*y(k,112) + & + .060_r8*rxt(k,460)*y(k,115) +.240_r8*rxt(k,502)*y(k,139))*y(k,293) & + +.510_r8*rxt(k,500)*y(k,291) + loss(k,231) = (rxt(k,387)* y(k,293) + rxt(k,75) + het_rates(k,128))* y(k,128) + prod(k,231) = (.550_r8*rxt(k,448)*y(k,250) +.280_r8*rxt(k,449)*y(k,251) + & + .550_r8*rxt(k,511)*y(k,147))*y(k,266) & + + (.550_r8*rxt(k,495)*y(k,250) +.280_r8*rxt(k,496)*y(k,251) + & + .550_r8*rxt(k,533)*y(k,147))*y(k,277) & + + (.090_r8*rxt(k,417)*y(k,101) +.250_r8*rxt(k,454)*y(k,112)) & + *y(k,293) +.550_r8*rxt(k,64)*y(k,115) +.410_r8*rxt(k,383)*y(k,282) & *y(k,256) - loss(k,116) = (rxt(k,397)* y(k,293) + rxt(k,76) + het_rates(k,129))* y(k,129) - prod(k,116) =.800_r8*rxt(k,19)*y(k,1) +.800_r8*rxt(k,20)*y(k,2) & - +.800_r8*rxt(k,411)*y(k,234)*y(k,147) - loss(k,86) = (rxt(k,398)* y(k,293) + rxt(k,77) + het_rates(k,130))* y(k,130) - prod(k,86) =.800_r8*rxt(k,395)*y(k,286)*y(k,256) - loss(k,108) = (rxt(k,399)* y(k,293) + rxt(k,78) + rxt(k,408) & + loss(k,143) = (rxt(k,396)* y(k,293) + rxt(k,76) + het_rates(k,129))* y(k,129) + prod(k,143) =.800_r8*rxt(k,19)*y(k,1) +.800_r8*rxt(k,20)*y(k,2) & + +.800_r8*rxt(k,410)*y(k,234)*y(k,147) + loss(k,107) = (rxt(k,397)* y(k,293) + rxt(k,77) + het_rates(k,130))* y(k,130) + prod(k,107) =.800_r8*rxt(k,394)*y(k,286)*y(k,256) + loss(k,138) = (rxt(k,398)* y(k,293) + rxt(k,78) + rxt(k,407) & + het_rates(k,131))* y(k,131) - prod(k,108) =rxt(k,407)*y(k,284)*y(k,148) - loss(k,241) = (rxt(k,404)* y(k,157) +rxt(k,405)* y(k,293) + rxt(k,79) & + prod(k,138) =rxt(k,406)*y(k,284)*y(k,148) + loss(k,269) = (rxt(k,403)* y(k,157) +rxt(k,404)* y(k,293) + rxt(k,79) & + het_rates(k,132))* y(k,132) - prod(k,241) = (rxt(k,428) +rxt(k,425)*y(k,250) +.750_r8*rxt(k,426)*y(k,251) + & - .060_r8*rxt(k,427)*y(k,256) +rxt(k,506)*y(k,147))*y(k,259) & - + (.420_r8*rxt(k,475)*y(k,250) +.050_r8*rxt(k,476)*y(k,251) + & - .220_r8*rxt(k,477)*y(k,256) +.420_r8*rxt(k,479)*y(k,149) + & - .420_r8*rxt(k,524)*y(k,147))*y(k,272) + (rxt(k,50) + & - .230_r8*rxt(k,417)*y(k,293))*y(k,100) +.350_r8*rxt(k,415)*y(k,293) & - *y(k,98) +.170_r8*rxt(k,487)*y(k,157)*y(k,109) +rxt(k,65)*y(k,116) & + prod(k,269) = (rxt(k,427) +rxt(k,424)*y(k,250) +.750_r8*rxt(k,425)*y(k,251) + & + .060_r8*rxt(k,426)*y(k,256) +rxt(k,505)*y(k,147))*y(k,259) & + + (.420_r8*rxt(k,474)*y(k,250) +.050_r8*rxt(k,475)*y(k,251) + & + .220_r8*rxt(k,476)*y(k,256) +.420_r8*rxt(k,478)*y(k,149) + & + .420_r8*rxt(k,523)*y(k,147))*y(k,272) + (rxt(k,50) + & + .230_r8*rxt(k,416)*y(k,293))*y(k,100) +.350_r8*rxt(k,414)*y(k,293) & + *y(k,98) +.170_r8*rxt(k,486)*y(k,157)*y(k,109) +rxt(k,65)*y(k,116) & +.500_r8*rxt(k,68)*y(k,119) +.880_r8*rxt(k,69)*y(k,120) & +.700_r8*rxt(k,71)*y(k,123) - loss(k,238) = (rxt(k,400)* y(k,293) + rxt(k,80) + het_rates(k,133))* y(k,133) - prod(k,238) = (rxt(k,518)*y(k,269) +.130_r8*rxt(k,520)*y(k,270) + & - .120_r8*rxt(k,522)*y(k,271) +.040_r8*rxt(k,526)*y(k,273) + & - .020_r8*rxt(k,528)*y(k,274) +rxt(k,539)*y(k,287) + & - .360_r8*rxt(k,540)*y(k,291))*y(k,147) & - + (.600_r8*rxt(k,465)*y(k,269) +.060_r8*rxt(k,468)*y(k,270) + & - .040_r8*rxt(k,472)*y(k,271) +.020_r8*rxt(k,480)*y(k,273) + & - .010_r8*rxt(k,483)*y(k,274) +.310_r8*rxt(k,500)*y(k,291))*y(k,256) & - + (.050_r8*rxt(k,424)*y(k,108) +.500_r8*rxt(k,453)*y(k,111) + & - .250_r8*rxt(k,455)*y(k,112) +.040_r8*rxt(k,471)*y(k,118) + & - .040_r8*rxt(k,503)*y(k,139))*y(k,293) +.490_r8*rxt(k,501)*y(k,291) - loss(k,210) = (rxt(k,406)* y(k,293) + rxt(k,81) + het_rates(k,134))* y(k,134) - prod(k,210) = (.550_r8*rxt(k,445)*y(k,250) +.280_r8*rxt(k,446)*y(k,251) + & - .550_r8*rxt(k,510)*y(k,147))*y(k,265) & - + (.550_r8*rxt(k,492)*y(k,250) +.280_r8*rxt(k,493)*y(k,251) + & - .550_r8*rxt(k,531)*y(k,147))*y(k,276) & - + (.190_r8*rxt(k,417)*y(k,100) +.250_r8*rxt(k,455)*y(k,112)) & - *y(k,293) +.550_r8*rxt(k,67)*y(k,118) +.460_r8*rxt(k,403)*y(k,287) & + loss(k,265) = (rxt(k,399)* y(k,293) + rxt(k,80) + het_rates(k,133))* y(k,133) + prod(k,265) = (rxt(k,517)*y(k,269) +.130_r8*rxt(k,519)*y(k,270) + & + .120_r8*rxt(k,521)*y(k,271) +.040_r8*rxt(k,525)*y(k,273) + & + .020_r8*rxt(k,527)*y(k,274) +rxt(k,538)*y(k,287) + & + .360_r8*rxt(k,539)*y(k,291))*y(k,147) & + + (.600_r8*rxt(k,464)*y(k,269) +.060_r8*rxt(k,467)*y(k,270) + & + .040_r8*rxt(k,471)*y(k,271) +.020_r8*rxt(k,479)*y(k,273) + & + .010_r8*rxt(k,482)*y(k,274) +.310_r8*rxt(k,499)*y(k,291))*y(k,256) & + + (.050_r8*rxt(k,423)*y(k,108) +.500_r8*rxt(k,452)*y(k,111) + & + .250_r8*rxt(k,454)*y(k,112) +.040_r8*rxt(k,470)*y(k,118) + & + .040_r8*rxt(k,502)*y(k,139))*y(k,293) +.490_r8*rxt(k,500)*y(k,291) + loss(k,237) = (rxt(k,405)* y(k,293) + rxt(k,81) + het_rates(k,134))* y(k,134) + prod(k,237) = (.550_r8*rxt(k,444)*y(k,250) +.280_r8*rxt(k,445)*y(k,251) + & + .550_r8*rxt(k,509)*y(k,147))*y(k,265) & + + (.550_r8*rxt(k,491)*y(k,250) +.280_r8*rxt(k,492)*y(k,251) + & + .550_r8*rxt(k,530)*y(k,147))*y(k,276) & + + (.190_r8*rxt(k,416)*y(k,100) +.250_r8*rxt(k,454)*y(k,112)) & + *y(k,293) +.550_r8*rxt(k,67)*y(k,118) +.460_r8*rxt(k,402)*y(k,287) & *y(k,256) - loss(k,148) = (rxt(k,665)* y(k,149) +rxt(k,683)* y(k,157) +rxt(k,684) & + loss(k,177) = (rxt(k,664)* y(k,149) +rxt(k,682)* y(k,157) +rxt(k,683) & * y(k,293) + het_rates(k,135))* y(k,135) - prod(k,148) = 0._r8 - loss(k,95) = (rxt(k,194)* y(k,147) + (rxt(k,195) +rxt(k,196) +rxt(k,197)) & + prod(k,177) = 0._r8 + loss(k,132) = (rxt(k,194)* y(k,147) + (rxt(k,195) +rxt(k,196) +rxt(k,197)) & * y(k,148) +rxt(k,206)* y(k,293) + rxt(k,198) + het_rates(k,136)) & * y(k,136) - prod(k,95) =rxt(k,15)*y(k,147) - loss(k,82) = ( + rxt(k,13) + rxt(k,14) + rxt(k,217) + rxt(k,828) + rxt(k,885) & - + rxt(k,888) + rxt(k,899) + het_rates(k,138))* y(k,138) - prod(k,82) =rxt(k,213)*y(k,149)*y(k,148) - loss(k,245) = (rxt(k,502)* y(k,157) +rxt(k,503)* y(k,293) + rxt(k,82) & - + rxt(k,829) + het_rates(k,139))* y(k,139) - prod(k,245) = (.540_r8*rxt(k,475)*y(k,250) +.530_r8*rxt(k,476)*y(k,251) + & - 1.070_r8*rxt(k,478)*y(k,272) +.540_r8*rxt(k,479)*y(k,149) + & - .540_r8*rxt(k,524)*y(k,147))*y(k,272) & - + (.040_r8*rxt(k,461)*y(k,115) +.030_r8*rxt(k,471)*y(k,118) + & - .050_r8*rxt(k,473)*y(k,119) +.020_r8*rxt(k,482)*y(k,120) + & - .090_r8*rxt(k,486)*y(k,121))*y(k,293) +rxt(k,70)*y(k,121) - loss(k,6) = ( + het_rates(k,140))* y(k,140) - prod(k,6) = 0._r8 - loss(k,7) = ( + het_rates(k,141))* y(k,141) - prod(k,7) = 0._r8 - loss(k,8) = ( + het_rates(k,142))* y(k,142) - prod(k,8) = 0._r8 - loss(k,47) = (rxt(k,811)* y(k,293) + het_rates(k,143))* y(k,143) - prod(k,47) = 0._r8 - loss(k,9) = ( + rxt(k,830) + het_rates(k,144))* y(k,144) - prod(k,9) = 0._r8 - loss(k,272) = (rxt(k,262)* y(k,20) +rxt(k,230)* y(k,60) +rxt(k,194)* y(k,136) & + prod(k,132) =rxt(k,15)*y(k,147) + loss(k,78) = ((rxt(k,210) +rxt(k,211))* y(k,292) + rxt(k,12) & + + het_rates(k,137))* y(k,137) + prod(k,78) =rxt(k,195)*y(k,148)*y(k,136) + loss(k,100) = ( + rxt(k,13) + rxt(k,14) + rxt(k,217) + rxt(k,827) & + + rxt(k,884) + rxt(k,887) + rxt(k,898) + het_rates(k,138))* y(k,138) + prod(k,100) =rxt(k,213)*y(k,149)*y(k,148) + loss(k,272) = (rxt(k,501)* y(k,157) +rxt(k,502)* y(k,293) + rxt(k,82) & + + rxt(k,828) + het_rates(k,139))* y(k,139) + prod(k,272) = (.540_r8*rxt(k,474)*y(k,250) +.530_r8*rxt(k,475)*y(k,251) + & + 1.070_r8*rxt(k,477)*y(k,272) +.540_r8*rxt(k,478)*y(k,149) + & + .540_r8*rxt(k,523)*y(k,147))*y(k,272) & + + (.040_r8*rxt(k,460)*y(k,115) +.030_r8*rxt(k,470)*y(k,118) + & + .050_r8*rxt(k,472)*y(k,119) +.020_r8*rxt(k,481)*y(k,120) + & + .090_r8*rxt(k,485)*y(k,121))*y(k,293) +rxt(k,70)*y(k,121) + loss(k,10) = ( + het_rates(k,140))* y(k,140) + prod(k,10) = 0._r8 + loss(k,11) = ( + het_rates(k,141))* y(k,141) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,142))* y(k,142) + prod(k,12) = 0._r8 + loss(k,57) = (rxt(k,810)* y(k,293) + het_rates(k,143))* y(k,143) + prod(k,57) = 0._r8 + loss(k,13) = ( + rxt(k,829) + het_rates(k,144))* y(k,144) + prod(k,13) = 0._r8 + loss(k,14) = ( + rxt(k,903) + het_rates(k,145))* y(k,145) + prod(k,14) = 0._r8 + loss(k,15) = ( + rxt(k,902) + het_rates(k,146))* y(k,146) + prod(k,15) = 0._r8 + loss(k,305) = (rxt(k,262)* y(k,20) +rxt(k,230)* y(k,60) +rxt(k,194)* y(k,136) & +rxt(k,203)* y(k,149) +rxt(k,209)* y(k,156) +rxt(k,208)* y(k,157) & - +rxt(k,543)* y(k,233) + (rxt(k,411) +rxt(k,412))* y(k,234) & - +rxt(k,590)* y(k,235) +rxt(k,598)* y(k,236) +rxt(k,610)* y(k,238) & - +rxt(k,618)* y(k,239) +rxt(k,546)* y(k,241) +rxt(k,630)* y(k,243) & - +rxt(k,638)* y(k,244) +rxt(k,551)* y(k,246) +rxt(k,328)* y(k,247) & - +rxt(k,358)* y(k,248) +rxt(k,553)* y(k,249) +rxt(k,339)* y(k,250) & - +rxt(k,305)* y(k,251) +rxt(k,557)* y(k,252) + (rxt(k,378) + & - rxt(k,379))* y(k,253) +rxt(k,343)* y(k,255) +rxt(k,207)* y(k,256) & - +rxt(k,315)* y(k,257) + (rxt(k,504) +rxt(k,505))* y(k,258) & - + (rxt(k,506) +rxt(k,507))* y(k,259) + (rxt(k,508) +rxt(k,509)) & - * y(k,260) + (rxt(k,510) +rxt(k,511))* y(k,265) + (rxt(k,512) + & - rxt(k,513))* y(k,266) + (rxt(k,514) +rxt(k,515))* y(k,267) & - + (rxt(k,516) +rxt(k,517))* y(k,268) + (rxt(k,518) +rxt(k,519)) & - * y(k,269) + (rxt(k,520) +rxt(k,521))* y(k,270) + (rxt(k,522) + & - rxt(k,523))* y(k,271) + (rxt(k,524) +rxt(k,525))* y(k,272) & - + (rxt(k,526) +rxt(k,527))* y(k,273) + (rxt(k,528) +rxt(k,529)) & - * y(k,274) + (rxt(k,531) +rxt(k,532))* y(k,276) + (rxt(k,534) + & - rxt(k,535))* y(k,277) +rxt(k,650)* y(k,279) +rxt(k,658)* y(k,280) & - + (rxt(k,536) +rxt(k,537))* y(k,282) +rxt(k,560)* y(k,283) & - +rxt(k,393)* y(k,284) +rxt(k,563)* y(k,285) +rxt(k,396)* y(k,286) & - + (rxt(k,538) +rxt(k,539))* y(k,287) +rxt(k,670)* y(k,288) & - +rxt(k,678)* y(k,289) + (rxt(k,540) +rxt(k,541))* y(k,291) & - +rxt(k,566)* y(k,294) +rxt(k,367)* y(k,295) +rxt(k,371)* y(k,296) & - +rxt(k,689)* y(k,297) +rxt(k,693)* y(k,298) +rxt(k,697)* y(k,299) & - +rxt(k,705)* y(k,300) +rxt(k,713)* y(k,301) +rxt(k,723)* y(k,302) & - +rxt(k,732)* y(k,303) +rxt(k,742)* y(k,304) +rxt(k,753)* y(k,305) & - +rxt(k,762)* y(k,306) +rxt(k,767)* y(k,307) +rxt(k,774)* y(k,308) & - +rxt(k,778)* y(k,309) +rxt(k,782)* y(k,310) +rxt(k,786)* y(k,311) & - +rxt(k,573)* y(k,312) +rxt(k,579)* y(k,314) +rxt(k,582)* y(k,316) & + +rxt(k,542)* y(k,233) + (rxt(k,410) +rxt(k,411))* y(k,234) & + +rxt(k,589)* y(k,235) +rxt(k,597)* y(k,236) +rxt(k,609)* y(k,238) & + +rxt(k,617)* y(k,239) +rxt(k,545)* y(k,241) +rxt(k,629)* y(k,243) & + +rxt(k,637)* y(k,244) +rxt(k,550)* y(k,246) +rxt(k,327)* y(k,247) & + +rxt(k,357)* y(k,248) +rxt(k,552)* y(k,249) +rxt(k,338)* y(k,250) & + +rxt(k,305)* y(k,251) +rxt(k,556)* y(k,252) + (rxt(k,377) + & + rxt(k,378))* y(k,253) +rxt(k,342)* y(k,255) +rxt(k,207)* y(k,256) & + +rxt(k,314)* y(k,257) + (rxt(k,503) +rxt(k,504))* y(k,258) & + + (rxt(k,505) +rxt(k,506))* y(k,259) + (rxt(k,507) +rxt(k,508)) & + * y(k,260) + (rxt(k,509) +rxt(k,510))* y(k,265) + (rxt(k,511) + & + rxt(k,512))* y(k,266) + (rxt(k,513) +rxt(k,514))* y(k,267) & + + (rxt(k,515) +rxt(k,516))* y(k,268) + (rxt(k,517) +rxt(k,518)) & + * y(k,269) + (rxt(k,519) +rxt(k,520))* y(k,270) + (rxt(k,521) + & + rxt(k,522))* y(k,271) + (rxt(k,523) +rxt(k,524))* y(k,272) & + + (rxt(k,525) +rxt(k,526))* y(k,273) + (rxt(k,527) +rxt(k,528)) & + * y(k,274) + (rxt(k,530) +rxt(k,531))* y(k,276) + (rxt(k,533) + & + rxt(k,534))* y(k,277) +rxt(k,649)* y(k,279) +rxt(k,657)* y(k,280) & + + (rxt(k,535) +rxt(k,536))* y(k,282) +rxt(k,559)* y(k,283) & + +rxt(k,392)* y(k,284) +rxt(k,562)* y(k,285) +rxt(k,395)* y(k,286) & + + (rxt(k,537) +rxt(k,538))* y(k,287) +rxt(k,669)* y(k,288) & + +rxt(k,677)* y(k,289) + (rxt(k,539) +rxt(k,540))* y(k,291) & + +rxt(k,565)* y(k,294) +rxt(k,366)* y(k,295) +rxt(k,370)* y(k,296) & + +rxt(k,688)* y(k,297) +rxt(k,692)* y(k,298) +rxt(k,696)* y(k,299) & + +rxt(k,704)* y(k,300) +rxt(k,712)* y(k,301) +rxt(k,722)* y(k,302) & + +rxt(k,731)* y(k,303) +rxt(k,741)* y(k,304) +rxt(k,752)* y(k,305) & + +rxt(k,761)* y(k,306) +rxt(k,766)* y(k,307) +rxt(k,773)* y(k,308) & + +rxt(k,777)* y(k,309) +rxt(k,781)* y(k,310) +rxt(k,785)* y(k,311) & + +rxt(k,572)* y(k,312) +rxt(k,578)* y(k,314) +rxt(k,581)* y(k,316) & + rxt(k,15) + het_rates(k,147))* y(k,147) - prod(k,272) = (rxt(k,16) +.500_r8*rxt(k,831) +2.000_r8*rxt(k,196)*y(k,136) + & + prod(k,305) = (rxt(k,16) +.500_r8*rxt(k,830) +2.000_r8*rxt(k,196)*y(k,136) + & rxt(k,199)*y(k,156) +rxt(k,803)*y(k,173))*y(k,148) + (rxt(k,198) + & rxt(k,206)*y(k,293))*y(k,136) +2.000_r8*rxt(k,210)*y(k,292)*y(k,137) & +rxt(k,14)*y(k,138) +rxt(k,17)*y(k,149) - loss(k,281) = (rxt(k,263)* y(k,20) +rxt(k,232)* y(k,60) + (rxt(k,195) + & + loss(k,314) = (rxt(k,263)* y(k,20) +rxt(k,232)* y(k,60) + (rxt(k,195) + & rxt(k,196) +rxt(k,197))* y(k,136) +rxt(k,213)* y(k,149) & + (rxt(k,199) +rxt(k,201))* y(k,156) +rxt(k,200)* y(k,157) & - +rxt(k,568)* y(k,164) +rxt(k,803)* y(k,173) +rxt(k,571)* y(k,233) & - +rxt(k,352)* y(k,250) +rxt(k,558)* y(k,252) +rxt(k,212)* y(k,256) & - +rxt(k,561)* y(k,283) +rxt(k,407)* y(k,284) +rxt(k,564)* y(k,285) & - +rxt(k,214)* y(k,293) +rxt(k,685)* y(k,300) +rxt(k,686)* y(k,302) & - +rxt(k,687)* y(k,305) + rxt(k,16) + rxt(k,831) + het_rates(k,148)) & + +rxt(k,567)* y(k,164) +rxt(k,803)* y(k,173) +rxt(k,570)* y(k,233) & + +rxt(k,351)* y(k,250) +rxt(k,557)* y(k,252) +rxt(k,212)* y(k,256) & + +rxt(k,560)* y(k,283) +rxt(k,406)* y(k,284) +rxt(k,563)* y(k,285) & + +rxt(k,214)* y(k,293) +rxt(k,684)* y(k,300) +rxt(k,685)* y(k,302) & + +rxt(k,686)* y(k,305) + rxt(k,16) + rxt(k,830) + het_rates(k,148)) & * y(k,148) - prod(k,281) = (2.000_r8*rxt(k,203)*y(k,149) +rxt(k,207)*y(k,256) + & + prod(k,314) = (2.000_r8*rxt(k,203)*y(k,149) +rxt(k,207)*y(k,256) + & rxt(k,208)*y(k,157) +rxt(k,209)*y(k,156) +rxt(k,230)*y(k,60) + & - rxt(k,262)*y(k,20) +rxt(k,305)*y(k,251) +rxt(k,315)*y(k,257) + & - rxt(k,328)*y(k,247) +rxt(k,339)*y(k,250) +rxt(k,343)*y(k,255) + & - rxt(k,358)*y(k,248) +rxt(k,367)*y(k,295) +rxt(k,371)*y(k,296) + & - rxt(k,378)*y(k,253) +rxt(k,393)*y(k,284) +rxt(k,396)*y(k,286) + & - rxt(k,411)*y(k,234) +rxt(k,504)*y(k,258) +rxt(k,506)*y(k,259) + & - rxt(k,508)*y(k,260) +rxt(k,510)*y(k,265) +rxt(k,512)*y(k,266) + & - rxt(k,514)*y(k,267) +1.730_r8*rxt(k,516)*y(k,268) + & - rxt(k,518)*y(k,269) +rxt(k,520)*y(k,270) +rxt(k,522)*y(k,271) + & - 1.460_r8*rxt(k,524)*y(k,272) +rxt(k,526)*y(k,273) + & - rxt(k,528)*y(k,274) +rxt(k,531)*y(k,276) +rxt(k,534)*y(k,277) + & - rxt(k,536)*y(k,282) +rxt(k,538)*y(k,287) +rxt(k,540)*y(k,291) + & - rxt(k,543)*y(k,233) +rxt(k,546)*y(k,241) +rxt(k,551)*y(k,246) + & - rxt(k,553)*y(k,249) +rxt(k,557)*y(k,252) +rxt(k,560)*y(k,283) + & - rxt(k,563)*y(k,285) +rxt(k,566)*y(k,294) +rxt(k,573)*y(k,312) + & - rxt(k,579)*y(k,314) +rxt(k,582)*y(k,316) + & - 1.860_r8*rxt(k,590)*y(k,235) +.770_r8*rxt(k,598)*y(k,236) + & - 1.860_r8*rxt(k,610)*y(k,238) +.700_r8*rxt(k,618)*y(k,239) + & - 1.390_r8*rxt(k,630)*y(k,243) +.750_r8*rxt(k,638)*y(k,244) + & - 1.360_r8*rxt(k,650)*y(k,279) +.770_r8*rxt(k,658)*y(k,280) + & - 1.820_r8*rxt(k,670)*y(k,288) +.710_r8*rxt(k,678)*y(k,289) + & - .700_r8*rxt(k,689)*y(k,297) +.700_r8*rxt(k,693)*y(k,298) + & - .700_r8*rxt(k,697)*y(k,299) +rxt(k,705)*y(k,300) + & - .830_r8*rxt(k,713)*y(k,301) +rxt(k,723)*y(k,302) + & - .700_r8*rxt(k,732)*y(k,303) +.910_r8*rxt(k,742)*y(k,304) + & - rxt(k,753)*y(k,305) +.700_r8*rxt(k,762)*y(k,306) + & - .700_r8*rxt(k,767)*y(k,307) +.700_r8*rxt(k,774)*y(k,308) + & - .700_r8*rxt(k,778)*y(k,309) +.700_r8*rxt(k,782)*y(k,310) + & - .700_r8*rxt(k,786)*y(k,311))*y(k,147) + (rxt(k,18) + & + rxt(k,262)*y(k,20) +rxt(k,305)*y(k,251) +rxt(k,314)*y(k,257) + & + rxt(k,327)*y(k,247) +rxt(k,338)*y(k,250) +rxt(k,342)*y(k,255) + & + rxt(k,357)*y(k,248) +rxt(k,366)*y(k,295) +rxt(k,370)*y(k,296) + & + rxt(k,377)*y(k,253) +rxt(k,392)*y(k,284) +rxt(k,395)*y(k,286) + & + rxt(k,410)*y(k,234) +rxt(k,503)*y(k,258) +rxt(k,505)*y(k,259) + & + rxt(k,507)*y(k,260) +rxt(k,509)*y(k,265) +rxt(k,511)*y(k,266) + & + rxt(k,513)*y(k,267) +1.730_r8*rxt(k,515)*y(k,268) + & + rxt(k,517)*y(k,269) +rxt(k,519)*y(k,270) +rxt(k,521)*y(k,271) + & + 1.460_r8*rxt(k,523)*y(k,272) +rxt(k,525)*y(k,273) + & + rxt(k,527)*y(k,274) +rxt(k,530)*y(k,276) +rxt(k,533)*y(k,277) + & + rxt(k,535)*y(k,282) +rxt(k,537)*y(k,287) +rxt(k,539)*y(k,291) + & + rxt(k,542)*y(k,233) +rxt(k,545)*y(k,241) +rxt(k,550)*y(k,246) + & + rxt(k,552)*y(k,249) +rxt(k,556)*y(k,252) +rxt(k,559)*y(k,283) + & + rxt(k,562)*y(k,285) +rxt(k,565)*y(k,294) +rxt(k,572)*y(k,312) + & + rxt(k,578)*y(k,314) +rxt(k,581)*y(k,316) + & + 1.860_r8*rxt(k,589)*y(k,235) +.770_r8*rxt(k,597)*y(k,236) + & + 1.860_r8*rxt(k,609)*y(k,238) +.700_r8*rxt(k,617)*y(k,239) + & + 1.390_r8*rxt(k,629)*y(k,243) +.750_r8*rxt(k,637)*y(k,244) + & + 1.360_r8*rxt(k,649)*y(k,279) +.770_r8*rxt(k,657)*y(k,280) + & + 1.820_r8*rxt(k,669)*y(k,288) +.710_r8*rxt(k,677)*y(k,289) + & + .700_r8*rxt(k,688)*y(k,297) +.700_r8*rxt(k,692)*y(k,298) + & + .700_r8*rxt(k,696)*y(k,299) +rxt(k,704)*y(k,300) + & + .830_r8*rxt(k,712)*y(k,301) +rxt(k,722)*y(k,302) + & + .700_r8*rxt(k,731)*y(k,303) +.910_r8*rxt(k,741)*y(k,304) + & + rxt(k,752)*y(k,305) +.700_r8*rxt(k,761)*y(k,306) + & + .700_r8*rxt(k,766)*y(k,307) +.700_r8*rxt(k,773)*y(k,308) + & + .700_r8*rxt(k,777)*y(k,309) +.700_r8*rxt(k,781)*y(k,310) + & + .700_r8*rxt(k,785)*y(k,311))*y(k,147) + (rxt(k,18) + & rxt(k,202)*y(k,256) +rxt(k,204)*y(k,156) +rxt(k,205)*y(k,293) + & - rxt(k,375)*y(k,16) +rxt(k,394)*y(k,284) + & - 1.460_r8*rxt(k,479)*y(k,272) +2.000_r8*rxt(k,591)*y(k,235) + & - rxt(k,599)*y(k,236) +2.000_r8*rxt(k,611)*y(k,238) + & - rxt(k,619)*y(k,239) +1.500_r8*rxt(k,631)*y(k,243) + & - rxt(k,639)*y(k,244) +1.460_r8*rxt(k,651)*y(k,279) + & - rxt(k,659)*y(k,280) +1.950_r8*rxt(k,671)*y(k,288) + & - rxt(k,679)*y(k,289) +rxt(k,698)*y(k,299) +rxt(k,706)*y(k,300) + & - rxt(k,714)*y(k,301) +rxt(k,724)*y(k,302) +rxt(k,733)*y(k,303) + & - rxt(k,743)*y(k,304) +rxt(k,754)*y(k,305) +rxt(k,760)*y(k,210) + & - .500_r8*rxt(k,765)*y(k,211))*y(k,149) + (rxt(k,193)*y(k,94) + & - rxt(k,349)*y(k,150) +rxt(k,365)*y(k,151) + & - .500_r8*rxt(k,381)*y(k,127) +rxt(k,409)*y(k,1) + & - .400_r8*rxt(k,423)*y(k,107) +.190_r8*rxt(k,424)*y(k,108) + & - rxt(k,453)*y(k,111) +.500_r8*rxt(k,455)*y(k,112) + & - .080_r8*rxt(k,461)*y(k,115) +.150_r8*rxt(k,464)*y(k,116) + & - .130_r8*rxt(k,467)*y(k,117) +.040_r8*rxt(k,471)*y(k,118) + & - .070_r8*rxt(k,486)*y(k,121) +.040_r8*rxt(k,503)*y(k,139) + & - rxt(k,719)*y(k,202) +rxt(k,738)*y(k,204) +rxt(k,758)*y(k,208) + & - rxt(k,770)*y(k,212) +rxt(k,784)*y(k,219) +rxt(k,788)*y(k,221)) & - *y(k,293) + (1.640_r8*rxt(k,586)*y(k,235) +rxt(k,587)*y(k,250) + & - .820_r8*rxt(k,588)*y(k,251) +.700_r8*rxt(k,589)*y(k,256) + & - rxt(k,592)*y(k,300) +rxt(k,593)*y(k,302) +rxt(k,594)*y(k,305)) & - *y(k,235) + (1.640_r8*rxt(k,606)*y(k,238) +rxt(k,607)*y(k,250) + & - .820_r8*rxt(k,608)*y(k,251) +.500_r8*rxt(k,609)*y(k,256) + & - rxt(k,612)*y(k,300) +rxt(k,613)*y(k,302) +rxt(k,614)*y(k,305)) & - *y(k,238) + (.940_r8*rxt(k,626)*y(k,243) + & - .500_r8*rxt(k,627)*y(k,250) +.360_r8*rxt(k,628)*y(k,251) + & - .240_r8*rxt(k,629)*y(k,256) +.500_r8*rxt(k,632)*y(k,300) + & - .500_r8*rxt(k,633)*y(k,302) +.500_r8*rxt(k,634)*y(k,305))*y(k,243) & - + (.460_r8*rxt(k,646)*y(k,250) +.310_r8*rxt(k,647)*y(k,251) + & - .230_r8*rxt(k,648)*y(k,256) +.860_r8*rxt(k,649)*y(k,279) + & - .460_r8*rxt(k,652)*y(k,300) +.460_r8*rxt(k,653)*y(k,302) + & - .460_r8*rxt(k,654)*y(k,305))*y(k,279) & - + (.950_r8*rxt(k,666)*y(k,250) +.770_r8*rxt(k,667)*y(k,251) + & - .480_r8*rxt(k,668)*y(k,256) +1.540_r8*rxt(k,669)*y(k,288) + & - .950_r8*rxt(k,672)*y(k,300) +.950_r8*rxt(k,673)*y(k,302) + & - .950_r8*rxt(k,674)*y(k,305))*y(k,288) & - + (.170_r8*rxt(k,460)*y(k,115) +.170_r8*rxt(k,470)*y(k,118) + & - .170_r8*rxt(k,485)*y(k,121) +.170_r8*rxt(k,502)*y(k,139))*y(k,157) & - + (.460_r8*rxt(k,475)*y(k,250) +.070_r8*rxt(k,476)*y(k,251) + & - .240_r8*rxt(k,477)*y(k,256) +.160_r8*rxt(k,478)*y(k,272))*y(k,272) & - + (rxt(k,11) +rxt(k,216))*y(k,94) + (rxt(k,78) +rxt(k,408))*y(k,131) & - + (rxt(k,13) +rxt(k,217))*y(k,138) + (.600_r8*rxt(k,86) +rxt(k,353)) & - *y(k,162) + (rxt(k,95) +rxt(k,791))*y(k,202) + (rxt(k,97) + & - rxt(k,792))*y(k,204) + (rxt(k,101) +rxt(k,793))*y(k,208) +rxt(k,19) & + rxt(k,374)*y(k,16) +rxt(k,393)*y(k,284) + & + 1.460_r8*rxt(k,478)*y(k,272) +2.000_r8*rxt(k,590)*y(k,235) + & + rxt(k,598)*y(k,236) +2.000_r8*rxt(k,610)*y(k,238) + & + rxt(k,618)*y(k,239) +1.500_r8*rxt(k,630)*y(k,243) + & + rxt(k,638)*y(k,244) +1.460_r8*rxt(k,650)*y(k,279) + & + rxt(k,658)*y(k,280) +1.950_r8*rxt(k,670)*y(k,288) + & + rxt(k,678)*y(k,289) +rxt(k,697)*y(k,299) +rxt(k,705)*y(k,300) + & + rxt(k,713)*y(k,301) +rxt(k,723)*y(k,302) +rxt(k,732)*y(k,303) + & + rxt(k,742)*y(k,304) +rxt(k,753)*y(k,305) +rxt(k,759)*y(k,210) + & + .500_r8*rxt(k,764)*y(k,211))*y(k,149) + (rxt(k,193)*y(k,94) + & + rxt(k,348)*y(k,150) +rxt(k,364)*y(k,151) + & + .500_r8*rxt(k,380)*y(k,127) +rxt(k,408)*y(k,1) + & + .400_r8*rxt(k,422)*y(k,107) +.190_r8*rxt(k,423)*y(k,108) + & + rxt(k,452)*y(k,111) +.500_r8*rxt(k,454)*y(k,112) + & + .080_r8*rxt(k,460)*y(k,115) +.150_r8*rxt(k,463)*y(k,116) + & + .130_r8*rxt(k,466)*y(k,117) +.040_r8*rxt(k,470)*y(k,118) + & + .070_r8*rxt(k,485)*y(k,121) +.040_r8*rxt(k,502)*y(k,139) + & + rxt(k,718)*y(k,202) +rxt(k,737)*y(k,204) +rxt(k,757)*y(k,208) + & + rxt(k,769)*y(k,212) +rxt(k,783)*y(k,219) +rxt(k,787)*y(k,221)) & + *y(k,293) + (1.640_r8*rxt(k,585)*y(k,235) +rxt(k,586)*y(k,250) + & + .820_r8*rxt(k,587)*y(k,251) +.700_r8*rxt(k,588)*y(k,256) + & + rxt(k,591)*y(k,300) +rxt(k,592)*y(k,302) +rxt(k,593)*y(k,305)) & + *y(k,235) + (1.640_r8*rxt(k,605)*y(k,238) +rxt(k,606)*y(k,250) + & + .820_r8*rxt(k,607)*y(k,251) +.500_r8*rxt(k,608)*y(k,256) + & + rxt(k,611)*y(k,300) +rxt(k,612)*y(k,302) +rxt(k,613)*y(k,305)) & + *y(k,238) + (.940_r8*rxt(k,625)*y(k,243) + & + .500_r8*rxt(k,626)*y(k,250) +.360_r8*rxt(k,627)*y(k,251) + & + .240_r8*rxt(k,628)*y(k,256) +.500_r8*rxt(k,631)*y(k,300) + & + .500_r8*rxt(k,632)*y(k,302) +.500_r8*rxt(k,633)*y(k,305))*y(k,243) & + + (.460_r8*rxt(k,645)*y(k,250) +.310_r8*rxt(k,646)*y(k,251) + & + .230_r8*rxt(k,647)*y(k,256) +.860_r8*rxt(k,648)*y(k,279) + & + .460_r8*rxt(k,651)*y(k,300) +.460_r8*rxt(k,652)*y(k,302) + & + .460_r8*rxt(k,653)*y(k,305))*y(k,279) & + + (.950_r8*rxt(k,665)*y(k,250) +.770_r8*rxt(k,666)*y(k,251) + & + .480_r8*rxt(k,667)*y(k,256) +1.540_r8*rxt(k,668)*y(k,288) + & + .950_r8*rxt(k,671)*y(k,300) +.950_r8*rxt(k,672)*y(k,302) + & + .950_r8*rxt(k,673)*y(k,305))*y(k,288) & + + (.170_r8*rxt(k,459)*y(k,115) +.170_r8*rxt(k,469)*y(k,118) + & + .170_r8*rxt(k,484)*y(k,121) +.170_r8*rxt(k,501)*y(k,139))*y(k,157) & + + (.460_r8*rxt(k,474)*y(k,250) +.070_r8*rxt(k,475)*y(k,251) + & + .240_r8*rxt(k,476)*y(k,256) +.160_r8*rxt(k,477)*y(k,272))*y(k,272) & + + (rxt(k,11) +rxt(k,216))*y(k,94) + (rxt(k,78) +rxt(k,407))*y(k,131) & + + (rxt(k,13) +rxt(k,217))*y(k,138) + (.600_r8*rxt(k,86) +rxt(k,352)) & + *y(k,162) + (rxt(k,95) +rxt(k,790))*y(k,202) + (rxt(k,97) + & + rxt(k,791))*y(k,204) + (rxt(k,101) +rxt(k,792))*y(k,208) +rxt(k,19) & *y(k,1) +rxt(k,120)*y(k,21) +rxt(k,139)*y(k,61) +rxt(k,9)*y(k,93) & +rxt(k,47)*y(k,97) +rxt(k,57)*y(k,107) +rxt(k,58)*y(k,108) & +2.000_r8*rxt(k,59)*y(k,110) +2.000_r8*rxt(k,60)*y(k,111) +rxt(k,61) & @@ -1006,1248 +1066,1256 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & +rxt(k,66)*y(k,117) +rxt(k,67)*y(k,118) +rxt(k,68)*y(k,119) & +rxt(k,69)*y(k,120) +.750_r8*rxt(k,74)*y(k,127) +.750_r8*rxt(k,80) & *y(k,133) +rxt(k,82)*y(k,139) +rxt(k,83)*y(k,150) +rxt(k,84)*y(k,151) & - +rxt(k,85)*y(k,161) +rxt(k,576)*y(k,163) +rxt(k,103)*y(k,212) & + +rxt(k,85)*y(k,161) +rxt(k,575)*y(k,163) +rxt(k,103)*y(k,212) & +.500_r8*rxt(k,105)*y(k,215) +.460_r8*rxt(k,106)*y(k,216) & +rxt(k,107)*y(k,217) +.460_r8*rxt(k,108)*y(k,218) +rxt(k,109) & *y(k,219) +rxt(k,110)*y(k,220) +rxt(k,111)*y(k,221) +rxt(k,112) & - *y(k,222) +.460_r8*rxt(k,462)*y(k,268)*y(k,256) - loss(k,274) = (rxt(k,585)* y(k,4) +rxt(k,605)* y(k,7) +rxt(k,375)* y(k,16) & - +rxt(k,625)* y(k,17) +rxt(k,354)* y(k,30) +rxt(k,299)* y(k,43) & - +rxt(k,333)* y(k,46) +rxt(k,361)* y(k,50) +rxt(k,794)* y(k,69) & - +rxt(k,474)* y(k,109) +rxt(k,645)* y(k,125) +rxt(k,665)* y(k,135) & + *y(k,222) +.460_r8*rxt(k,461)*y(k,268)*y(k,256) + loss(k,312) = (rxt(k,584)* y(k,4) +rxt(k,604)* y(k,7) +rxt(k,374)* y(k,16) & + +rxt(k,624)* y(k,17) +rxt(k,353)* y(k,30) +rxt(k,299)* y(k,43) & + +rxt(k,332)* y(k,46) +rxt(k,360)* y(k,50) +rxt(k,793)* y(k,69) & + +rxt(k,473)* y(k,109) +rxt(k,644)* y(k,125) +rxt(k,664)* y(k,135) & +rxt(k,203)* y(k,147) +rxt(k,213)* y(k,148) +rxt(k,204)* y(k,156) & - +rxt(k,756)* y(k,200) +rxt(k,709)* y(k,201) +rxt(k,728)* y(k,203) & - +rxt(k,760)* y(k,210) +rxt(k,765)* y(k,211) +rxt(k,591)* y(k,235) & - +rxt(k,599)* y(k,236) +rxt(k,611)* y(k,238) +rxt(k,619)* y(k,239) & - +rxt(k,631)* y(k,243) +rxt(k,639)* y(k,244) +rxt(k,202)* y(k,256) & - +rxt(k,479)* y(k,272) +rxt(k,651)* y(k,279) +rxt(k,659)* y(k,280) & - +rxt(k,394)* y(k,284) +rxt(k,671)* y(k,288) +rxt(k,679)* y(k,289) & - +rxt(k,205)* y(k,293) +rxt(k,698)* y(k,299) +rxt(k,706)* y(k,300) & - +rxt(k,714)* y(k,301) +rxt(k,724)* y(k,302) +rxt(k,733)* y(k,303) & - +rxt(k,743)* y(k,304) +rxt(k,754)* y(k,305) + rxt(k,17) + rxt(k,18) & - + rxt(k,832) + het_rates(k,149))* y(k,149) - prod(k,274) = (rxt(k,138) +rxt(k,231)*y(k,57) +rxt(k,233)*y(k,156) + & + +rxt(k,755)* y(k,200) +rxt(k,708)* y(k,201) +rxt(k,727)* y(k,203) & + +rxt(k,759)* y(k,210) +rxt(k,764)* y(k,211) +rxt(k,590)* y(k,235) & + +rxt(k,598)* y(k,236) +rxt(k,610)* y(k,238) +rxt(k,618)* y(k,239) & + +rxt(k,630)* y(k,243) +rxt(k,638)* y(k,244) +rxt(k,202)* y(k,256) & + +rxt(k,478)* y(k,272) +rxt(k,650)* y(k,279) +rxt(k,658)* y(k,280) & + +rxt(k,393)* y(k,284) +rxt(k,670)* y(k,288) +rxt(k,678)* y(k,289) & + +rxt(k,205)* y(k,293) +rxt(k,697)* y(k,299) +rxt(k,705)* y(k,300) & + +rxt(k,713)* y(k,301) +rxt(k,723)* y(k,302) +rxt(k,732)* y(k,303) & + +rxt(k,742)* y(k,304) +rxt(k,753)* y(k,305) + rxt(k,17) + rxt(k,18) & + + rxt(k,831) + het_rates(k,149))* y(k,149) + prod(k,312) = (rxt(k,138) +rxt(k,231)*y(k,57) +rxt(k,233)*y(k,156) + & rxt(k,234)*y(k,293))*y(k,61) + (rxt(k,13) +rxt(k,14) +rxt(k,217)) & - *y(k,138) + (rxt(k,215)*y(k,93) +rxt(k,350)*y(k,162) + & - rxt(k,399)*y(k,131))*y(k,293) + (rxt(k,121) +rxt(k,264)*y(k,156)) & + *y(k,138) + (rxt(k,215)*y(k,93) +rxt(k,349)*y(k,162) + & + rxt(k,398)*y(k,131))*y(k,293) + (rxt(k,121) +rxt(k,264)*y(k,156)) & *y(k,21) + (rxt(k,200)*y(k,157) +rxt(k,201)*y(k,156))*y(k,148) & +rxt(k,278)*y(k,93)*y(k,75) +rxt(k,10)*y(k,94) +.400_r8*rxt(k,86) & *y(k,162) - loss(k,201) = (rxt(k,349)* y(k,293) + rxt(k,83) + het_rates(k,150))* y(k,150) - prod(k,201) = (.870_r8*rxt(k,520)*y(k,270) +.330_r8*rxt(k,522)*y(k,271) + & - .070_r8*rxt(k,526)*y(k,273) +.150_r8*rxt(k,528)*y(k,274) + & - .120_r8*rxt(k,540)*y(k,291))*y(k,147) & - + (.440_r8*rxt(k,468)*y(k,270) +.150_r8*rxt(k,472)*y(k,271) + & - .060_r8*rxt(k,480)*y(k,273) +.120_r8*rxt(k,483)*y(k,274) + & - .100_r8*rxt(k,500)*y(k,291))*y(k,256) & - + (.830_r8*rxt(k,470)*y(k,118) +.130_r8*rxt(k,485)*y(k,121) + & - .220_r8*rxt(k,502)*y(k,139))*y(k,157) +.250_r8*rxt(k,80)*y(k,133) & - +.100_r8*rxt(k,503)*y(k,293)*y(k,139) - loss(k,207) = (rxt(k,365)* y(k,293) + rxt(k,84) + het_rates(k,151))* y(k,151) - prod(k,207) = (.940_r8*rxt(k,514)*y(k,267) +.340_r8*rxt(k,522)*y(k,271) + & - .400_r8*rxt(k,526)*y(k,273) +.810_r8*rxt(k,528)*y(k,274) + & - .130_r8*rxt(k,540)*y(k,291))*y(k,147) & - + (.550_r8*rxt(k,458)*y(k,267) +.150_r8*rxt(k,472)*y(k,271) + & - .280_r8*rxt(k,480)*y(k,273) +.680_r8*rxt(k,483)*y(k,274) + & - .100_r8*rxt(k,500)*y(k,291))*y(k,256) & - + (.500_r8*rxt(k,381)*y(k,127) +.500_r8*rxt(k,400)*y(k,133) + & - .350_r8*rxt(k,424)*y(k,108) +.350_r8*rxt(k,503)*y(k,139))*y(k,293) & - + (.830_r8*rxt(k,460)*y(k,115) +.700_r8*rxt(k,485)*y(k,121) + & - .610_r8*rxt(k,502)*y(k,139))*y(k,157) +rxt(k,354)*y(k,149)*y(k,30) & + loss(k,230) = (rxt(k,348)* y(k,293) + rxt(k,83) + het_rates(k,150))* y(k,150) + prod(k,230) = (.870_r8*rxt(k,519)*y(k,270) +.330_r8*rxt(k,521)*y(k,271) + & + .070_r8*rxt(k,525)*y(k,273) +.150_r8*rxt(k,527)*y(k,274) + & + .120_r8*rxt(k,539)*y(k,291))*y(k,147) & + + (.440_r8*rxt(k,467)*y(k,270) +.150_r8*rxt(k,471)*y(k,271) + & + .060_r8*rxt(k,479)*y(k,273) +.120_r8*rxt(k,482)*y(k,274) + & + .100_r8*rxt(k,499)*y(k,291))*y(k,256) & + + (.830_r8*rxt(k,469)*y(k,118) +.130_r8*rxt(k,484)*y(k,121) + & + .220_r8*rxt(k,501)*y(k,139))*y(k,157) +.250_r8*rxt(k,80)*y(k,133) & + +.100_r8*rxt(k,502)*y(k,293)*y(k,139) + loss(k,234) = (rxt(k,364)* y(k,293) + rxt(k,84) + het_rates(k,151))* y(k,151) + prod(k,234) = (.940_r8*rxt(k,513)*y(k,267) +.340_r8*rxt(k,521)*y(k,271) + & + .400_r8*rxt(k,525)*y(k,273) +.810_r8*rxt(k,527)*y(k,274) + & + .130_r8*rxt(k,539)*y(k,291))*y(k,147) & + + (.550_r8*rxt(k,457)*y(k,267) +.150_r8*rxt(k,471)*y(k,271) + & + .280_r8*rxt(k,479)*y(k,273) +.680_r8*rxt(k,482)*y(k,274) + & + .100_r8*rxt(k,499)*y(k,291))*y(k,256) & + + (.500_r8*rxt(k,380)*y(k,127) +.500_r8*rxt(k,399)*y(k,133) + & + .350_r8*rxt(k,423)*y(k,108) +.350_r8*rxt(k,502)*y(k,139))*y(k,293) & + + (.830_r8*rxt(k,459)*y(k,115) +.700_r8*rxt(k,484)*y(k,121) + & + .610_r8*rxt(k,501)*y(k,139))*y(k,157) +rxt(k,353)*y(k,149)*y(k,30) & +.250_r8*rxt(k,74)*y(k,127) - loss(k,10) = ( + het_rates(k,152))* y(k,152) - prod(k,10) = 0._r8 - loss(k,11) = ( + het_rates(k,153))* y(k,153) - prod(k,11) = 0._r8 - loss(k,12) = ( + het_rates(k,154))* y(k,154) - prod(k,12) = 0._r8 - loss(k,13) = ( + het_rates(k,155))* y(k,155) - prod(k,13) = 0._r8 - loss(k,280) = (rxt(k,265)* y(k,20) +rxt(k,264)* y(k,21) +rxt(k,300)* y(k,43) & + loss(k,16) = ( + het_rates(k,152))* y(k,152) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,153))* y(k,153) + prod(k,17) = 0._r8 + loss(k,18) = ( + het_rates(k,154))* y(k,154) + prod(k,18) = 0._r8 + loss(k,19) = ( + het_rates(k,155))* y(k,155) + prod(k,19) = 0._r8 + loss(k,308) = (rxt(k,265)* y(k,20) +rxt(k,264)* y(k,21) +rxt(k,300)* y(k,43) & +rxt(k,235)* y(k,60) +rxt(k,233)* y(k,61) +rxt(k,176)* y(k,79) & +rxt(k,177)* y(k,81) +rxt(k,267)* y(k,83) +rxt(k,238)* y(k,87) & +rxt(k,269)* y(k,95) +rxt(k,241)* y(k,96) +rxt(k,209)* y(k,147) & + (rxt(k,199) +rxt(k,201))* y(k,148) +rxt(k,204)* y(k,149) & - + 2._r8*rxt(k,174)* y(k,156) +rxt(k,173)* y(k,157) +rxt(k,796) & + + 2._r8*rxt(k,174)* y(k,156) +rxt(k,173)* y(k,157) +rxt(k,795) & * y(k,160) +rxt(k,182)* y(k,256) +rxt(k,188)* y(k,293) + rxt(k,175) & + het_rates(k,156))* y(k,156) - prod(k,280) = (rxt(k,198) +rxt(k,194)*y(k,147) +rxt(k,195)*y(k,148))*y(k,136) & + prod(k,308) = (rxt(k,198) +rxt(k,194)*y(k,147) +rxt(k,195)*y(k,148))*y(k,136) & + (rxt(k,155) +rxt(k,804))*y(k,173) + (rxt(k,170) +rxt(k,171)) & - *y(k,292) +rxt(k,119)*y(k,20) +rxt(k,137)*y(k,60) & - +rxt(k,180)*y(k,256)*y(k,78) +rxt(k,14)*y(k,138) +rxt(k,15)*y(k,147) & - +rxt(k,16)*y(k,148) +rxt(k,18)*y(k,149) +rxt(k,8)*y(k,157) & - +rxt(k,151)*y(k,159) +rxt(k,798)*y(k,171) +rxt(k,156)*y(k,174) & - +rxt(k,157)*y(k,175) +rxt(k,190)*y(k,293)*y(k,293) +rxt(k,3) & - *y(k,317) - loss(k,273) = (rxt(k,603)* y(k,4) +rxt(k,623)* y(k,7) +rxt(k,643)* y(k,17) & - +rxt(k,256)* y(k,18) +rxt(k,324)* y(k,26) +rxt(k,355)* y(k,30) & - +rxt(k,224)* y(k,57) +rxt(k,184)* y(k,78) +rxt(k,487)* y(k,109) & - +rxt(k,460)* y(k,115) +rxt(k,470)* y(k,118) +rxt(k,485)* y(k,121) & - +rxt(k,663)* y(k,125) +rxt(k,386)* y(k,126) +rxt(k,404)* y(k,132) & - +rxt(k,683)* y(k,135) +rxt(k,502)* y(k,139) +rxt(k,208)* y(k,147) & - +rxt(k,200)* y(k,148) +rxt(k,173)* y(k,156) +rxt(k,569)* y(k,164) & - +rxt(k,799)* y(k,171) +rxt(k,805)* y(k,173) +rxt(k,763)* y(k,210) & - +rxt(k,768)* y(k,211) +rxt(k,183)* y(k,256) +rxt(k,172)* y(k,292) & + *y(k,292) +rxt(k,119)*y(k,20) +.180_r8*rxt(k,39)*y(k,55) +rxt(k,137) & + *y(k,60) +rxt(k,40)*y(k,64) +rxt(k,180)*y(k,256)*y(k,78) +rxt(k,14) & + *y(k,138) +rxt(k,15)*y(k,147) +rxt(k,16)*y(k,148) +rxt(k,18)*y(k,149) & + +rxt(k,8)*y(k,157) +rxt(k,151)*y(k,159) +rxt(k,797)*y(k,171) & + +rxt(k,156)*y(k,174) +rxt(k,157)*y(k,175) +rxt(k,190)*y(k,293) & + *y(k,293) +rxt(k,3)*y(k,317) + loss(k,303) = (rxt(k,602)* y(k,4) +rxt(k,622)* y(k,7) +rxt(k,642)* y(k,17) & + +rxt(k,256)* y(k,18) +rxt(k,323)* y(k,26) +rxt(k,354)* y(k,30) & + +rxt(k,224)* y(k,57) +rxt(k,184)* y(k,78) +rxt(k,486)* y(k,109) & + +rxt(k,459)* y(k,115) +rxt(k,469)* y(k,118) +rxt(k,484)* y(k,121) & + +rxt(k,662)* y(k,125) +rxt(k,385)* y(k,126) +rxt(k,403)* y(k,132) & + +rxt(k,682)* y(k,135) +rxt(k,501)* y(k,139) +rxt(k,208)* y(k,147) & + +rxt(k,200)* y(k,148) +rxt(k,173)* y(k,156) +rxt(k,568)* y(k,164) & + +rxt(k,799)* y(k,171) +rxt(k,805)* y(k,173) +rxt(k,762)* y(k,210) & + +rxt(k,767)* y(k,211) +rxt(k,183)* y(k,256) +rxt(k,172)* y(k,292) & +rxt(k,189)* y(k,293) + rxt(k,7) + rxt(k,8) + het_rates(k,157)) & * y(k,157) - prod(k,273) = (.150_r8*rxt(k,338)*y(k,250) +.150_r8*rxt(k,391)*y(k,284) + & - .150_r8*rxt(k,704)*y(k,300) +.150_r8*rxt(k,722)*y(k,302) + & - .150_r8*rxt(k,752)*y(k,305))*y(k,256) +rxt(k,175)*y(k,156) - loss(k,88) = (rxt(k,806)* y(k,173) + rxt(k,151) + het_rates(k,159))* y(k,159) - prod(k,88) = (rxt(k,228)*y(k,60) +rxt(k,258)*y(k,20))*y(k,60) - loss(k,93) = (rxt(k,796)* y(k,156) +rxt(k,797)* y(k,293) + rxt(k,154) & + prod(k,303) = (.150_r8*rxt(k,337)*y(k,250) +.150_r8*rxt(k,390)*y(k,284) + & + .150_r8*rxt(k,703)*y(k,300) +.150_r8*rxt(k,721)*y(k,302) + & + .150_r8*rxt(k,751)*y(k,305))*y(k,256) +rxt(k,175)*y(k,156) + loss(k,20) = ( + het_rates(k,158))* y(k,158) + prod(k,20) = 0._r8 + loss(k,109) = (rxt(k,806)* y(k,173) + rxt(k,151) + het_rates(k,159)) & + * y(k,159) + prod(k,109) = (rxt(k,228)*y(k,60) +rxt(k,258)*y(k,20))*y(k,60) + loss(k,117) = (rxt(k,795)* y(k,156) +rxt(k,796)* y(k,293) + rxt(k,154) & + het_rates(k,160))* y(k,160) - prod(k,93) = 0._r8 - loss(k,60) = ( + rxt(k,85) + rxt(k,833) + het_rates(k,161))* y(k,161) - prod(k,60) = (rxt(k,380)*y(k,97) +.500_r8*rxt(k,400)*y(k,133))*y(k,293) - loss(k,109) = (rxt(k,350)* y(k,293) + rxt(k,86) + rxt(k,353) & + prod(k,117) = 0._r8 + loss(k,80) = ( + rxt(k,85) + rxt(k,832) + het_rates(k,161))* y(k,161) + prod(k,80) = (rxt(k,379)*y(k,97) +.500_r8*rxt(k,399)*y(k,133))*y(k,293) + loss(k,145) = (rxt(k,349)* y(k,293) + rxt(k,86) + rxt(k,352) & + het_rates(k,162))* y(k,162) - prod(k,109) =rxt(k,352)*y(k,250)*y(k,148) - loss(k,54) = ( + rxt(k,576) + het_rates(k,163))* y(k,163) - prod(k,54) =rxt(k,571)*y(k,233)*y(k,148) - loss(k,110) = (rxt(k,568)* y(k,148) +rxt(k,569)* y(k,157) + het_rates(k,164)) & + prod(k,145) =rxt(k,351)*y(k,250)*y(k,148) + loss(k,68) = ( + rxt(k,575) + het_rates(k,163))* y(k,163) + prod(k,68) =rxt(k,570)*y(k,233)*y(k,148) + loss(k,136) = (rxt(k,567)* y(k,148) +rxt(k,568)* y(k,157) + het_rates(k,164)) & * y(k,164) - prod(k,110) = (.070_r8*rxt(k,555)*y(k,67) +.060_r8*rxt(k,567)*y(k,165) + & - .070_r8*rxt(k,583)*y(k,229))*y(k,293) +rxt(k,30)*y(k,33) & - +rxt(k,553)*y(k,249)*y(k,147) - loss(k,58) = (rxt(k,567)* y(k,293) + het_rates(k,165))* y(k,165) - prod(k,58) =.530_r8*rxt(k,544)*y(k,293)*y(k,8) - loss(k,89) = (rxt(k,570)* y(k,293) + rxt(k,87) + het_rates(k,166))* y(k,166) - prod(k,89) =rxt(k,565)*y(k,294)*y(k,256) - loss(k,14) = ( + het_rates(k,167))* y(k,167) - prod(k,14) = 0._r8 - loss(k,15) = ( + het_rates(k,168))* y(k,168) - prod(k,15) = 0._r8 - loss(k,121) = (rxt(k,368)* y(k,293) + rxt(k,88) + het_rates(k,169))* y(k,169) - prod(k,121) =rxt(k,366)*y(k,295)*y(k,256) - loss(k,98) = (rxt(k,372)* y(k,293) + rxt(k,89) + het_rates(k,170))* y(k,170) - prod(k,98) =.850_r8*rxt(k,370)*y(k,296)*y(k,256) - loss(k,117) = (rxt(k,799)* y(k,157) +rxt(k,802)* y(k,293) + rxt(k,798) & + prod(k,136) = (.070_r8*rxt(k,554)*y(k,67) +.060_r8*rxt(k,566)*y(k,165) + & + .070_r8*rxt(k,582)*y(k,229))*y(k,293) +rxt(k,30)*y(k,33) & + +rxt(k,552)*y(k,249)*y(k,147) + loss(k,76) = (rxt(k,566)* y(k,293) + het_rates(k,165))* y(k,165) + prod(k,76) =.530_r8*rxt(k,543)*y(k,293)*y(k,8) + loss(k,110) = (rxt(k,569)* y(k,293) + rxt(k,87) + het_rates(k,166))* y(k,166) + prod(k,110) =rxt(k,564)*y(k,294)*y(k,256) + loss(k,21) = ( + het_rates(k,167))* y(k,167) + prod(k,21) = 0._r8 + loss(k,22) = ( + het_rates(k,168))* y(k,168) + prod(k,22) = 0._r8 + loss(k,147) = (rxt(k,367)* y(k,293) + rxt(k,88) + het_rates(k,169))* y(k,169) + prod(k,147) =rxt(k,365)*y(k,295)*y(k,256) + loss(k,120) = (rxt(k,371)* y(k,293) + rxt(k,89) + het_rates(k,170))* y(k,170) + prod(k,120) =.850_r8*rxt(k,369)*y(k,296)*y(k,256) + loss(k,141) = (rxt(k,799)* y(k,157) +rxt(k,802)* y(k,293) + rxt(k,797) & + het_rates(k,171))* y(k,171) - prod(k,117) =rxt(k,154)*y(k,160) +rxt(k,155)*y(k,173) - loss(k,221) = (rxt(k,800)* y(k,20) +rxt(k,801)* y(k,60) +rxt(k,803)* y(k,148) & + prod(k,141) =rxt(k,154)*y(k,160) +rxt(k,155)*y(k,173) + loss(k,23) = ( + rxt(k,152) + het_rates(k,172))* y(k,172) + prod(k,23) = 0._r8 + loss(k,244) = (rxt(k,800)* y(k,20) +rxt(k,801)* y(k,60) +rxt(k,803)* y(k,148) & +rxt(k,805)* y(k,157) +rxt(k,806)* y(k,159) +rxt(k,807)* y(k,293) & + rxt(k,155) + rxt(k,804) + het_rates(k,173))* y(k,173) - prod(k,221) = (rxt(k,798) +rxt(k,799)*y(k,157) +rxt(k,802)*y(k,293))*y(k,171) & - +rxt(k,796)*y(k,160)*y(k,156) +rxt(k,156)*y(k,174) - loss(k,191) = (rxt(k,809)* y(k,293) + rxt(k,156) + het_rates(k,174)) & + prod(k,244) = (rxt(k,797) +rxt(k,799)*y(k,157) +rxt(k,802)*y(k,293))*y(k,171) & + +rxt(k,795)*y(k,160)*y(k,156) +rxt(k,156)*y(k,174) + loss(k,214) = (rxt(k,798)* y(k,293) + rxt(k,156) + het_rates(k,174)) & * y(k,174) - prod(k,191) = (rxt(k,804) +rxt(k,800)*y(k,20) +rxt(k,801)*y(k,60) + & + prod(k,214) = (rxt(k,804) +rxt(k,800)*y(k,20) +rxt(k,801)*y(k,60) + & rxt(k,803)*y(k,148) +rxt(k,805)*y(k,157) +rxt(k,806)*y(k,159) + & - rxt(k,807)*y(k,293))*y(k,173) + (rxt(k,794)*y(k,149) + & - rxt(k,795)*y(k,293) +.500_r8*rxt(k,808)*y(k,293))*y(k,69) & - +rxt(k,797)*y(k,293)*y(k,160) +rxt(k,157)*y(k,175) - loss(k,75) = (rxt(k,810)* y(k,317) + rxt(k,157) + het_rates(k,175))* y(k,175) - prod(k,75) =rxt(k,153)*y(k,82) +rxt(k,809)*y(k,293)*y(k,174) - loss(k,16) = ( + het_rates(k,176))* y(k,176) - prod(k,16) = 0._r8 - loss(k,17) = ( + het_rates(k,177))* y(k,177) - prod(k,17) = 0._r8 - loss(k,18) = ( + het_rates(k,178))* y(k,178) - prod(k,18) = 0._r8 - loss(k,19) = ( + rxt(k,158) + het_rates(k,179))* y(k,179) - prod(k,19) = 0._r8 - loss(k,20) = ( + rxt(k,159) + het_rates(k,180))* y(k,180) - prod(k,20) = 0._r8 - loss(k,21) = ( + rxt(k,160) + het_rates(k,181))* y(k,181) - prod(k,21) = 0._r8 - loss(k,22) = ( + rxt(k,161) + het_rates(k,182))* y(k,182) - prod(k,22) = 0._r8 - loss(k,23) = ( + rxt(k,162) + het_rates(k,183))* y(k,183) - prod(k,23) = 0._r8 - loss(k,24) = ( + rxt(k,163) + het_rates(k,184))* y(k,184) + rxt(k,807)*y(k,293))*y(k,173) + (rxt(k,793)*y(k,149) + & + rxt(k,794)*y(k,293) +.500_r8*rxt(k,808)*y(k,293))*y(k,69) & + +rxt(k,796)*y(k,293)*y(k,160) +rxt(k,157)*y(k,175) + loss(k,96) = (rxt(k,809)* y(k,317) + rxt(k,157) + het_rates(k,175))* y(k,175) + prod(k,96) =rxt(k,153)*y(k,82) +rxt(k,798)*y(k,293)*y(k,174) + loss(k,24) = ( + het_rates(k,176))* y(k,176) prod(k,24) = 0._r8 - loss(k,25) = ( + rxt(k,164) + het_rates(k,185))* y(k,185) + loss(k,25) = ( + het_rates(k,177))* y(k,177) prod(k,25) = 0._r8 - loss(k,26) = ( + rxt(k,165) + het_rates(k,186))* y(k,186) + loss(k,26) = ( + het_rates(k,178))* y(k,178) prod(k,26) = 0._r8 - loss(k,27) = ( + rxt(k,166) + het_rates(k,187))* y(k,187) + loss(k,27) = ( + rxt(k,158) + het_rates(k,179))* y(k,179) prod(k,27) = 0._r8 - loss(k,28) = ( + rxt(k,167) + het_rates(k,188))* y(k,188) + loss(k,28) = ( + rxt(k,159) + het_rates(k,180))* y(k,180) prod(k,28) = 0._r8 - loss(k,29) = ( + het_rates(k,189))* y(k,189) - prod(k,29) = (.0245005_r8*rxt(k,844)*y(k,237) + & - .1279005_r8*rxt(k,849)*y(k,240) +.0097005_r8*rxt(k,854)*y(k,242) + & - .0245005_r8*rxt(k,857)*y(k,245) +.0003005_r8*rxt(k,862)*y(k,275) + & - .1056005_r8*rxt(k,866)*y(k,278) +.0245005_r8*rxt(k,870)*y(k,281) + & - .0245005_r8*rxt(k,875)*y(k,290) +.0154005_r8*rxt(k,881)*y(k,313) + & - .0063005_r8*rxt(k,884)*y(k,315))*y(k,147) & - + (.0508005_r8*rxt(k,843)*y(k,237) + & - .2202005_r8*rxt(k,848)*y(k,240) +.0023005_r8*rxt(k,853)*y(k,242) + & - .0508005_r8*rxt(k,856)*y(k,245) +.0031005_r8*rxt(k,861)*y(k,275) + & - .2381005_r8*rxt(k,865)*y(k,278) +.0508005_r8*rxt(k,869)*y(k,281) + & - .0508005_r8*rxt(k,874)*y(k,290) +.1364005_r8*rxt(k,880)*y(k,313) + & - .1677005_r8*rxt(k,883)*y(k,315))*y(k,256) & - + (.0508005_r8*rxt(k,845)*y(k,4) +.2202005_r8*rxt(k,850)*y(k,7) + & - .0508005_r8*rxt(k,858)*y(k,17) +.0508005_r8*rxt(k,871)*y(k,125) + & - .0508005_r8*rxt(k,876)*y(k,135))*y(k,157) +rxt(k,812)*y(k,77) & - +.5931005_r8*rxt(k,878)*y(k,293)*y(k,196) - loss(k,30) = ( + het_rates(k,190))* y(k,190) - prod(k,30) = (.0082005_r8*rxt(k,844)*y(k,237) + & - .1792005_r8*rxt(k,849)*y(k,240) +.0034005_r8*rxt(k,854)*y(k,242) + & - .0082005_r8*rxt(k,857)*y(k,245) +.0003005_r8*rxt(k,862)*y(k,275) + & - .1026005_r8*rxt(k,866)*y(k,278) +.0082005_r8*rxt(k,870)*y(k,281) + & - .0082005_r8*rxt(k,875)*y(k,290) +.0452005_r8*rxt(k,881)*y(k,313) + & - .0237005_r8*rxt(k,884)*y(k,315))*y(k,147) & - + (.1149005_r8*rxt(k,843)*y(k,237) + & - .2067005_r8*rxt(k,848)*y(k,240) +.0008005_r8*rxt(k,853)*y(k,242) + & - .1149005_r8*rxt(k,856)*y(k,245) +.0035005_r8*rxt(k,861)*y(k,275) + & - .1308005_r8*rxt(k,865)*y(k,278) +.1149005_r8*rxt(k,869)*y(k,281) + & - .1149005_r8*rxt(k,874)*y(k,290) +.0101005_r8*rxt(k,880)*y(k,313) + & - .0174005_r8*rxt(k,883)*y(k,315))*y(k,256) & - + (.1149005_r8*rxt(k,845)*y(k,4) +.2067005_r8*rxt(k,850)*y(k,7) + & - .1149005_r8*rxt(k,858)*y(k,17) +.1149005_r8*rxt(k,871)*y(k,125) + & - .1149005_r8*rxt(k,876)*y(k,135))*y(k,157) & - +.1534005_r8*rxt(k,878)*y(k,293)*y(k,196) - loss(k,31) = ( + het_rates(k,191))* y(k,191) - prod(k,31) = (.0772005_r8*rxt(k,844)*y(k,237) + & - .0676005_r8*rxt(k,849)*y(k,240) +.1579005_r8*rxt(k,854)*y(k,242) + & - .0772005_r8*rxt(k,857)*y(k,245) +.0073005_r8*rxt(k,862)*y(k,275) + & - .0521005_r8*rxt(k,866)*y(k,278) +.0772005_r8*rxt(k,870)*y(k,281) + & - .0772005_r8*rxt(k,875)*y(k,290) +.0966005_r8*rxt(k,881)*y(k,313) + & - .0025005_r8*rxt(k,884)*y(k,315))*y(k,147) & - + (.0348005_r8*rxt(k,843)*y(k,237) + & - .0653005_r8*rxt(k,848)*y(k,240) +.0843005_r8*rxt(k,853)*y(k,242) + & - .0348005_r8*rxt(k,856)*y(k,245) +.0003005_r8*rxt(k,861)*y(k,275) + & - .0348005_r8*rxt(k,865)*y(k,278) +.0348005_r8*rxt(k,869)*y(k,281) + & - .0348005_r8*rxt(k,874)*y(k,290) +.0763005_r8*rxt(k,880)*y(k,313) + & - .086_r8*rxt(k,883)*y(k,315))*y(k,256) & - + (.0348005_r8*rxt(k,845)*y(k,4) +.0653005_r8*rxt(k,850)*y(k,7) + & - .0348005_r8*rxt(k,858)*y(k,17) +.0348005_r8*rxt(k,871)*y(k,125) + & - .0348005_r8*rxt(k,876)*y(k,135))*y(k,157) & - +.0459005_r8*rxt(k,878)*y(k,293)*y(k,196) - loss(k,32) = ( + het_rates(k,192))* y(k,192) - prod(k,32) = (.0332005_r8*rxt(k,844)*y(k,237) +.079_r8*rxt(k,849)*y(k,240) + & - .0059005_r8*rxt(k,854)*y(k,242) +.0332005_r8*rxt(k,857)*y(k,245) + & - .0057005_r8*rxt(k,862)*y(k,275) +.0143005_r8*rxt(k,866)*y(k,278) + & - .0332005_r8*rxt(k,870)*y(k,281) +.0332005_r8*rxt(k,875)*y(k,290) + & - .0073005_r8*rxt(k,881)*y(k,313) +.011_r8*rxt(k,884)*y(k,315)) & - *y(k,147) + (.0554005_r8*rxt(k,843)*y(k,237) + & - .1284005_r8*rxt(k,848)*y(k,240) +.0443005_r8*rxt(k,853)*y(k,242) + & - .0554005_r8*rxt(k,856)*y(k,245) +.0271005_r8*rxt(k,861)*y(k,275) + & - .0076005_r8*rxt(k,865)*y(k,278) +.0554005_r8*rxt(k,869)*y(k,281) + & - .0554005_r8*rxt(k,874)*y(k,290) +.2157005_r8*rxt(k,880)*y(k,313) + & - .0512005_r8*rxt(k,883)*y(k,315))*y(k,256) & - + (.1749305_r8*rxt(k,842)*y(k,4) +.1749305_r8*rxt(k,847)*y(k,7) + & - .1749305_r8*rxt(k,855)*y(k,17) +.0590245_r8*rxt(k,860)*y(k,109) + & - .1749305_r8*rxt(k,868)*y(k,125) +.1749305_r8*rxt(k,873)*y(k,135)) & - *y(k,149) + (.0554005_r8*rxt(k,845)*y(k,4) + & - .1284005_r8*rxt(k,850)*y(k,7) +.0554005_r8*rxt(k,858)*y(k,17) + & - .0033005_r8*rxt(k,863)*y(k,109) +.0554005_r8*rxt(k,871)*y(k,125) + & - .0554005_r8*rxt(k,876)*y(k,135))*y(k,157) & - +.0085005_r8*rxt(k,878)*y(k,293)*y(k,196) - loss(k,33) = ( + het_rates(k,193))* y(k,193) - prod(k,33) = (.130_r8*rxt(k,844)*y(k,237) +.1254005_r8*rxt(k,849)*y(k,240) + & - .0536005_r8*rxt(k,854)*y(k,242) +.130_r8*rxt(k,857)*y(k,245) + & - .0623005_r8*rxt(k,862)*y(k,275) +.0166005_r8*rxt(k,866)*y(k,278) + & - .130_r8*rxt(k,870)*y(k,281) +.130_r8*rxt(k,875)*y(k,290) + & - .238_r8*rxt(k,881)*y(k,313) +.1185005_r8*rxt(k,884)*y(k,315)) & - *y(k,147) + (.1278005_r8*rxt(k,843)*y(k,237) + & - .114_r8*rxt(k,848)*y(k,240) +.1621005_r8*rxt(k,853)*y(k,242) + & - .1278005_r8*rxt(k,856)*y(k,245) +.0474005_r8*rxt(k,861)*y(k,275) + & - .0113005_r8*rxt(k,865)*y(k,278) +.1278005_r8*rxt(k,869)*y(k,281) + & - .1278005_r8*rxt(k,874)*y(k,290) +.0738005_r8*rxt(k,880)*y(k,313) + & - .1598005_r8*rxt(k,883)*y(k,315))*y(k,256) & - + (.5901905_r8*rxt(k,842)*y(k,4) +.5901905_r8*rxt(k,847)*y(k,7) + & - .5901905_r8*rxt(k,855)*y(k,17) +.0250245_r8*rxt(k,860)*y(k,109) + & - .5901905_r8*rxt(k,868)*y(k,125) +.5901905_r8*rxt(k,873)*y(k,135)) & - *y(k,149) + (.1278005_r8*rxt(k,845)*y(k,4) + & - .114_r8*rxt(k,850)*y(k,7) +.1278005_r8*rxt(k,858)*y(k,17) + & - .1278005_r8*rxt(k,871)*y(k,125) +.1278005_r8*rxt(k,876)*y(k,135)) & - *y(k,157) +.0128005_r8*rxt(k,878)*y(k,293)*y(k,196) - loss(k,34) = ( + rxt(k,834) + het_rates(k,194))* y(k,194) - prod(k,34) = (.360_r8*rxt(k,606)*y(k,238) +.180_r8*rxt(k,608)*y(k,251) + & - .500_r8*rxt(k,609)*y(k,256) +.070_r8*rxt(k,610)*y(k,147))*y(k,238) & - +.300_r8*rxt(k,618)*y(k,239)*y(k,147) - loss(k,35) = (rxt(k,878)* y(k,293) + het_rates(k,196))* y(k,196) + loss(k,29) = ( + rxt(k,160) + het_rates(k,181))* y(k,181) + prod(k,29) = 0._r8 + loss(k,30) = ( + rxt(k,161) + het_rates(k,182))* y(k,182) + prod(k,30) = 0._r8 + loss(k,31) = ( + rxt(k,162) + het_rates(k,183))* y(k,183) + prod(k,31) = 0._r8 + loss(k,32) = ( + rxt(k,163) + het_rates(k,184))* y(k,184) + prod(k,32) = 0._r8 + loss(k,33) = ( + rxt(k,164) + het_rates(k,185))* y(k,185) + prod(k,33) = 0._r8 + loss(k,34) = ( + rxt(k,165) + het_rates(k,186))* y(k,186) + prod(k,34) = 0._r8 + loss(k,35) = ( + rxt(k,166) + het_rates(k,187))* y(k,187) prod(k,35) = 0._r8 - loss(k,65) = ( + rxt(k,90) + het_rates(k,197))* y(k,197) - prod(k,65) = (.100_r8*rxt(k,575)*y(k,226) +.230_r8*rxt(k,577)*y(k,227)) & + loss(k,36) = ( + rxt(k,167) + het_rates(k,188))* y(k,188) + prod(k,36) = 0._r8 + loss(k,37) = ( + het_rates(k,189))* y(k,189) + prod(k,37) = (.0245005_r8*rxt(k,843)*y(k,237) + & + .1279005_r8*rxt(k,848)*y(k,240) +.0097005_r8*rxt(k,853)*y(k,242) + & + .0245005_r8*rxt(k,856)*y(k,245) +.0003005_r8*rxt(k,861)*y(k,275) + & + .1056005_r8*rxt(k,865)*y(k,278) +.0245005_r8*rxt(k,869)*y(k,281) + & + .0245005_r8*rxt(k,874)*y(k,290) +.0154005_r8*rxt(k,880)*y(k,313) + & + .0063005_r8*rxt(k,883)*y(k,315))*y(k,147) & + + (.0508005_r8*rxt(k,842)*y(k,237) + & + .2202005_r8*rxt(k,847)*y(k,240) +.0023005_r8*rxt(k,852)*y(k,242) + & + .0508005_r8*rxt(k,855)*y(k,245) +.0031005_r8*rxt(k,860)*y(k,275) + & + .2381005_r8*rxt(k,864)*y(k,278) +.0508005_r8*rxt(k,868)*y(k,281) + & + .0508005_r8*rxt(k,873)*y(k,290) +.1364005_r8*rxt(k,879)*y(k,313) + & + .1677005_r8*rxt(k,882)*y(k,315))*y(k,256) & + + (.0508005_r8*rxt(k,844)*y(k,4) +.2202005_r8*rxt(k,849)*y(k,7) + & + .0508005_r8*rxt(k,857)*y(k,17) +.0508005_r8*rxt(k,870)*y(k,125) + & + .0508005_r8*rxt(k,875)*y(k,135))*y(k,157) +rxt(k,811)*y(k,77) & + +.5931005_r8*rxt(k,877)*y(k,293)*y(k,196) + loss(k,38) = ( + het_rates(k,190))* y(k,190) + prod(k,38) = (.0082005_r8*rxt(k,843)*y(k,237) + & + .1792005_r8*rxt(k,848)*y(k,240) +.0034005_r8*rxt(k,853)*y(k,242) + & + .0082005_r8*rxt(k,856)*y(k,245) +.0003005_r8*rxt(k,861)*y(k,275) + & + .1026005_r8*rxt(k,865)*y(k,278) +.0082005_r8*rxt(k,869)*y(k,281) + & + .0082005_r8*rxt(k,874)*y(k,290) +.0452005_r8*rxt(k,880)*y(k,313) + & + .0237005_r8*rxt(k,883)*y(k,315))*y(k,147) & + + (.1149005_r8*rxt(k,842)*y(k,237) + & + .2067005_r8*rxt(k,847)*y(k,240) +.0008005_r8*rxt(k,852)*y(k,242) + & + .1149005_r8*rxt(k,855)*y(k,245) +.0035005_r8*rxt(k,860)*y(k,275) + & + .1308005_r8*rxt(k,864)*y(k,278) +.1149005_r8*rxt(k,868)*y(k,281) + & + .1149005_r8*rxt(k,873)*y(k,290) +.0101005_r8*rxt(k,879)*y(k,313) + & + .0174005_r8*rxt(k,882)*y(k,315))*y(k,256) & + + (.1149005_r8*rxt(k,844)*y(k,4) +.2067005_r8*rxt(k,849)*y(k,7) + & + .1149005_r8*rxt(k,857)*y(k,17) +.1149005_r8*rxt(k,870)*y(k,125) + & + .1149005_r8*rxt(k,875)*y(k,135))*y(k,157) & + +.1534005_r8*rxt(k,877)*y(k,293)*y(k,196) + loss(k,39) = ( + het_rates(k,191))* y(k,191) + prod(k,39) = (.0772005_r8*rxt(k,843)*y(k,237) + & + .0676005_r8*rxt(k,848)*y(k,240) +.1579005_r8*rxt(k,853)*y(k,242) + & + .0772005_r8*rxt(k,856)*y(k,245) +.0073005_r8*rxt(k,861)*y(k,275) + & + .0521005_r8*rxt(k,865)*y(k,278) +.0772005_r8*rxt(k,869)*y(k,281) + & + .0772005_r8*rxt(k,874)*y(k,290) +.0966005_r8*rxt(k,880)*y(k,313) + & + .0025005_r8*rxt(k,883)*y(k,315))*y(k,147) & + + (.0348005_r8*rxt(k,842)*y(k,237) + & + .0653005_r8*rxt(k,847)*y(k,240) +.0843005_r8*rxt(k,852)*y(k,242) + & + .0348005_r8*rxt(k,855)*y(k,245) +.0003005_r8*rxt(k,860)*y(k,275) + & + .0348005_r8*rxt(k,864)*y(k,278) +.0348005_r8*rxt(k,868)*y(k,281) + & + .0348005_r8*rxt(k,873)*y(k,290) +.0763005_r8*rxt(k,879)*y(k,313) + & + .086_r8*rxt(k,882)*y(k,315))*y(k,256) & + + (.0348005_r8*rxt(k,844)*y(k,4) +.0653005_r8*rxt(k,849)*y(k,7) + & + .0348005_r8*rxt(k,857)*y(k,17) +.0348005_r8*rxt(k,870)*y(k,125) + & + .0348005_r8*rxt(k,875)*y(k,135))*y(k,157) & + +.0459005_r8*rxt(k,877)*y(k,293)*y(k,196) + loss(k,40) = ( + het_rates(k,192))* y(k,192) + prod(k,40) = (.0332005_r8*rxt(k,843)*y(k,237) +.079_r8*rxt(k,848)*y(k,240) + & + .0059005_r8*rxt(k,853)*y(k,242) +.0332005_r8*rxt(k,856)*y(k,245) + & + .0057005_r8*rxt(k,861)*y(k,275) +.0143005_r8*rxt(k,865)*y(k,278) + & + .0332005_r8*rxt(k,869)*y(k,281) +.0332005_r8*rxt(k,874)*y(k,290) + & + .0073005_r8*rxt(k,880)*y(k,313) +.011_r8*rxt(k,883)*y(k,315)) & + *y(k,147) + (.0554005_r8*rxt(k,842)*y(k,237) + & + .1284005_r8*rxt(k,847)*y(k,240) +.0443005_r8*rxt(k,852)*y(k,242) + & + .0554005_r8*rxt(k,855)*y(k,245) +.0271005_r8*rxt(k,860)*y(k,275) + & + .0076005_r8*rxt(k,864)*y(k,278) +.0554005_r8*rxt(k,868)*y(k,281) + & + .0554005_r8*rxt(k,873)*y(k,290) +.2157005_r8*rxt(k,879)*y(k,313) + & + .0512005_r8*rxt(k,882)*y(k,315))*y(k,256) & + + (.1749305_r8*rxt(k,841)*y(k,4) +.1749305_r8*rxt(k,846)*y(k,7) + & + .1749305_r8*rxt(k,854)*y(k,17) +.0590245_r8*rxt(k,859)*y(k,109) + & + .1749305_r8*rxt(k,867)*y(k,125) +.1749305_r8*rxt(k,872)*y(k,135)) & + *y(k,149) + (.0554005_r8*rxt(k,844)*y(k,4) + & + .1284005_r8*rxt(k,849)*y(k,7) +.0554005_r8*rxt(k,857)*y(k,17) + & + .0033005_r8*rxt(k,862)*y(k,109) +.0554005_r8*rxt(k,870)*y(k,125) + & + .0554005_r8*rxt(k,875)*y(k,135))*y(k,157) & + +.0085005_r8*rxt(k,877)*y(k,293)*y(k,196) + loss(k,41) = ( + het_rates(k,193))* y(k,193) + prod(k,41) = (.130_r8*rxt(k,843)*y(k,237) +.1254005_r8*rxt(k,848)*y(k,240) + & + .0536005_r8*rxt(k,853)*y(k,242) +.130_r8*rxt(k,856)*y(k,245) + & + .0623005_r8*rxt(k,861)*y(k,275) +.0166005_r8*rxt(k,865)*y(k,278) + & + .130_r8*rxt(k,869)*y(k,281) +.130_r8*rxt(k,874)*y(k,290) + & + .238_r8*rxt(k,880)*y(k,313) +.1185005_r8*rxt(k,883)*y(k,315)) & + *y(k,147) + (.1278005_r8*rxt(k,842)*y(k,237) + & + .114_r8*rxt(k,847)*y(k,240) +.1621005_r8*rxt(k,852)*y(k,242) + & + .1278005_r8*rxt(k,855)*y(k,245) +.0474005_r8*rxt(k,860)*y(k,275) + & + .0113005_r8*rxt(k,864)*y(k,278) +.1278005_r8*rxt(k,868)*y(k,281) + & + .1278005_r8*rxt(k,873)*y(k,290) +.0738005_r8*rxt(k,879)*y(k,313) + & + .1598005_r8*rxt(k,882)*y(k,315))*y(k,256) & + + (.5901905_r8*rxt(k,841)*y(k,4) +.5901905_r8*rxt(k,846)*y(k,7) + & + .5901905_r8*rxt(k,854)*y(k,17) +.0250245_r8*rxt(k,859)*y(k,109) + & + .5901905_r8*rxt(k,867)*y(k,125) +.5901905_r8*rxt(k,872)*y(k,135)) & + *y(k,149) + (.1278005_r8*rxt(k,844)*y(k,4) + & + .114_r8*rxt(k,849)*y(k,7) +.1278005_r8*rxt(k,857)*y(k,17) + & + .1278005_r8*rxt(k,870)*y(k,125) +.1278005_r8*rxt(k,875)*y(k,135)) & + *y(k,157) +.0128005_r8*rxt(k,877)*y(k,293)*y(k,196) + loss(k,42) = ( + rxt(k,833) + het_rates(k,194))* y(k,194) + prod(k,42) = (.360_r8*rxt(k,605)*y(k,238) +.180_r8*rxt(k,607)*y(k,251) + & + .500_r8*rxt(k,608)*y(k,256) +.070_r8*rxt(k,609)*y(k,147))*y(k,238) & + +.300_r8*rxt(k,617)*y(k,239)*y(k,147) + loss(k,43) = ( + rxt(k,904) + het_rates(k,195))* y(k,195) + prod(k,43) = 0._r8 + loss(k,44) = (rxt(k,877)* y(k,293) + het_rates(k,196))* y(k,196) + prod(k,44) = 0._r8 + loss(k,83) = ( + rxt(k,90) + het_rates(k,197))* y(k,197) + prod(k,83) = (.100_r8*rxt(k,574)*y(k,226) +.230_r8*rxt(k,576)*y(k,227)) & *y(k,293) - loss(k,253) = (rxt(k,690)* y(k,293) + rxt(k,91) + het_rates(k,198))* y(k,198) - prod(k,253) = (.140_r8*rxt(k,595)*y(k,250) +.130_r8*rxt(k,596)*y(k,251) + & - .250_r8*rxt(k,597)*y(k,256) +.110_r8*rxt(k,598)*y(k,147) + & - .140_r8*rxt(k,599)*y(k,149) +.140_r8*rxt(k,600)*y(k,300) + & - .140_r8*rxt(k,601)*y(k,302) +.140_r8*rxt(k,602)*y(k,305))*y(k,236) & - + (.680_r8*rxt(k,637)*y(k,244) +.900_r8*rxt(k,657)*y(k,280) + & - .180_r8*rxt(k,692)*y(k,298) +.900_r8*rxt(k,766)*y(k,307))*y(k,256) & - +.700_r8*rxt(k,693)*y(k,298)*y(k,147) - loss(k,107) = (rxt(k,691)* y(k,293) + rxt(k,92) + het_rates(k,199))* y(k,199) - prod(k,107) = (.900_r8*rxt(k,617)*y(k,239) +.900_r8*rxt(k,677)*y(k,289)) & + loss(k,285) = (rxt(k,689)* y(k,293) + rxt(k,91) + het_rates(k,198))* y(k,198) + prod(k,285) = (.140_r8*rxt(k,594)*y(k,250) +.130_r8*rxt(k,595)*y(k,251) + & + .250_r8*rxt(k,596)*y(k,256) +.110_r8*rxt(k,597)*y(k,147) + & + .140_r8*rxt(k,598)*y(k,149) +.140_r8*rxt(k,599)*y(k,300) + & + .140_r8*rxt(k,600)*y(k,302) +.140_r8*rxt(k,601)*y(k,305))*y(k,236) & + + (.680_r8*rxt(k,636)*y(k,244) +.900_r8*rxt(k,656)*y(k,280) + & + .180_r8*rxt(k,691)*y(k,298) +.900_r8*rxt(k,765)*y(k,307))*y(k,256) & + +.700_r8*rxt(k,692)*y(k,298)*y(k,147) + loss(k,131) = (rxt(k,690)* y(k,293) + rxt(k,92) + het_rates(k,199))* y(k,199) + prod(k,131) = (.900_r8*rxt(k,616)*y(k,239) +.900_r8*rxt(k,676)*y(k,289)) & *y(k,256) - loss(k,254) = (rxt(k,756)* y(k,149) +rxt(k,757)* y(k,293) + rxt(k,93) & + loss(k,282) = (rxt(k,755)* y(k,149) +rxt(k,756)* y(k,293) + rxt(k,93) & + het_rates(k,200))* y(k,200) - prod(k,254) = (1.640_r8*rxt(k,586)*y(k,235) +rxt(k,587)*y(k,250) + & - .820_r8*rxt(k,588)*y(k,251) +.700_r8*rxt(k,589)*y(k,256) + & - .930_r8*rxt(k,590)*y(k,147) +rxt(k,591)*y(k,149) + & - rxt(k,592)*y(k,300) +rxt(k,593)*y(k,302) +rxt(k,594)*y(k,305)) & - *y(k,235) + (.390_r8*rxt(k,595)*y(k,250) + & - .420_r8*rxt(k,596)*y(k,251) +.290_r8*rxt(k,597)*y(k,256) + & - .300_r8*rxt(k,598)*y(k,147) +.390_r8*rxt(k,599)*y(k,149) + & - .390_r8*rxt(k,600)*y(k,300) +.390_r8*rxt(k,601)*y(k,302) + & - .390_r8*rxt(k,602)*y(k,305))*y(k,236) + (rxt(k,784)*y(k,219) + & - rxt(k,788)*y(k,221) +rxt(k,790)*y(k,223))*y(k,293) & - +.220_r8*rxt(k,603)*y(k,157)*y(k,4) +.500_r8*rxt(k,105)*y(k,215) & + prod(k,282) = (1.640_r8*rxt(k,585)*y(k,235) +rxt(k,586)*y(k,250) + & + .820_r8*rxt(k,587)*y(k,251) +.700_r8*rxt(k,588)*y(k,256) + & + .930_r8*rxt(k,589)*y(k,147) +rxt(k,590)*y(k,149) + & + rxt(k,591)*y(k,300) +rxt(k,592)*y(k,302) +rxt(k,593)*y(k,305)) & + *y(k,235) + (.390_r8*rxt(k,594)*y(k,250) + & + .420_r8*rxt(k,595)*y(k,251) +.290_r8*rxt(k,596)*y(k,256) + & + .300_r8*rxt(k,597)*y(k,147) +.390_r8*rxt(k,598)*y(k,149) + & + .390_r8*rxt(k,599)*y(k,300) +.390_r8*rxt(k,600)*y(k,302) + & + .390_r8*rxt(k,601)*y(k,305))*y(k,236) + (rxt(k,783)*y(k,219) + & + rxt(k,787)*y(k,221) +rxt(k,789)*y(k,223))*y(k,293) & + +.220_r8*rxt(k,602)*y(k,157)*y(k,4) +.500_r8*rxt(k,105)*y(k,215) & +rxt(k,107)*y(k,217) +rxt(k,109)*y(k,219) +rxt(k,111)*y(k,221) & +rxt(k,113)*y(k,223) - loss(k,192) = (rxt(k,709)* y(k,149) +rxt(k,718)* y(k,293) + rxt(k,94) & + loss(k,218) = (rxt(k,708)* y(k,149) +rxt(k,717)* y(k,293) + rxt(k,94) & + het_rates(k,201))* y(k,201) - prod(k,192) =.170_r8*rxt(k,603)*y(k,157)*y(k,4) +rxt(k,758)*y(k,293)*y(k,208) & - +.500_r8*rxt(k,695)*y(k,299)*y(k,251) - loss(k,124) = (rxt(k,719)* y(k,293) + rxt(k,95) + rxt(k,791) & + prod(k,218) =.170_r8*rxt(k,602)*y(k,157)*y(k,4) +rxt(k,757)*y(k,293)*y(k,208) & + +.500_r8*rxt(k,694)*y(k,299)*y(k,251) + loss(k,155) = (rxt(k,718)* y(k,293) + rxt(k,95) + rxt(k,790) & + het_rates(k,202))* y(k,202) - prod(k,124) =rxt(k,685)*y(k,300)*y(k,148) - loss(k,231) = (rxt(k,728)* y(k,149) +rxt(k,737)* y(k,293) + rxt(k,96) & + prod(k,155) =rxt(k,684)*y(k,300)*y(k,148) + loss(k,253) = (rxt(k,727)* y(k,149) +rxt(k,736)* y(k,293) + rxt(k,96) & + het_rates(k,203))* y(k,203) - prod(k,231) = (.900_r8*rxt(k,626)*y(k,243) +.480_r8*rxt(k,627)*y(k,250) + & - .340_r8*rxt(k,628)*y(k,251) +.220_r8*rxt(k,629)*y(k,256) + & - .440_r8*rxt(k,630)*y(k,147) +.480_r8*rxt(k,631)*y(k,149) + & - .480_r8*rxt(k,632)*y(k,300) +.480_r8*rxt(k,633)*y(k,302) + & - .480_r8*rxt(k,634)*y(k,305))*y(k,243) & - + (.350_r8*rxt(k,595)*y(k,250) +.200_r8*rxt(k,596)*y(k,251) + & - .270_r8*rxt(k,598)*y(k,147) +.350_r8*rxt(k,599)*y(k,149) + & - .350_r8*rxt(k,600)*y(k,300) +.350_r8*rxt(k,601)*y(k,302) + & - .350_r8*rxt(k,602)*y(k,305))*y(k,236) & - + (.410_r8*rxt(k,635)*y(k,250) +.310_r8*rxt(k,636)*y(k,251) + & - .310_r8*rxt(k,638)*y(k,147) +.410_r8*rxt(k,639)*y(k,149) + & - .410_r8*rxt(k,640)*y(k,300) +.410_r8*rxt(k,641)*y(k,302) + & - .410_r8*rxt(k,642)*y(k,305))*y(k,244) + (rxt(k,760)*y(k,149) + & - rxt(k,763)*y(k,157))*y(k,210) + (rxt(k,114) +rxt(k,789)*y(k,293)) & - *y(k,224) + (.100_r8*rxt(k,761)*y(k,256) + & - .700_r8*rxt(k,762)*y(k,147))*y(k,306) - loss(k,125) = (rxt(k,738)* y(k,293) + rxt(k,97) + rxt(k,792) & + prod(k,253) = (.900_r8*rxt(k,625)*y(k,243) +.480_r8*rxt(k,626)*y(k,250) + & + .340_r8*rxt(k,627)*y(k,251) +.220_r8*rxt(k,628)*y(k,256) + & + .440_r8*rxt(k,629)*y(k,147) +.480_r8*rxt(k,630)*y(k,149) + & + .480_r8*rxt(k,631)*y(k,300) +.480_r8*rxt(k,632)*y(k,302) + & + .480_r8*rxt(k,633)*y(k,305))*y(k,243) & + + (.350_r8*rxt(k,594)*y(k,250) +.200_r8*rxt(k,595)*y(k,251) + & + .270_r8*rxt(k,597)*y(k,147) +.350_r8*rxt(k,598)*y(k,149) + & + .350_r8*rxt(k,599)*y(k,300) +.350_r8*rxt(k,600)*y(k,302) + & + .350_r8*rxt(k,601)*y(k,305))*y(k,236) & + + (.410_r8*rxt(k,634)*y(k,250) +.310_r8*rxt(k,635)*y(k,251) + & + .310_r8*rxt(k,637)*y(k,147) +.410_r8*rxt(k,638)*y(k,149) + & + .410_r8*rxt(k,639)*y(k,300) +.410_r8*rxt(k,640)*y(k,302) + & + .410_r8*rxt(k,641)*y(k,305))*y(k,244) + (rxt(k,759)*y(k,149) + & + rxt(k,762)*y(k,157))*y(k,210) + (rxt(k,114) +rxt(k,788)*y(k,293)) & + *y(k,224) + (.100_r8*rxt(k,760)*y(k,256) + & + .700_r8*rxt(k,761)*y(k,147))*y(k,306) + loss(k,156) = (rxt(k,737)* y(k,293) + rxt(k,97) + rxt(k,791) & + het_rates(k,204))* y(k,204) - prod(k,125) =rxt(k,686)*y(k,302)*y(k,148) - loss(k,126) = (rxt(k,749)* y(k,293) + rxt(k,98) + het_rates(k,205))* y(k,205) - prod(k,126) = (.010_r8*rxt(k,603)*y(k,4) +.130_r8*rxt(k,623)*y(k,7) + & - .010_r8*rxt(k,663)*y(k,125))*y(k,157) +.510_r8*rxt(k,752)*y(k,305) & + prod(k,156) =rxt(k,685)*y(k,302)*y(k,148) + loss(k,168) = (rxt(k,748)* y(k,293) + rxt(k,98) + het_rates(k,205))* y(k,205) + prod(k,168) = (.010_r8*rxt(k,602)*y(k,4) +.130_r8*rxt(k,622)*y(k,7) + & + .010_r8*rxt(k,662)*y(k,125))*y(k,157) +.510_r8*rxt(k,751)*y(k,305) & *y(k,256) - loss(k,78) = (rxt(k,747)* y(k,293) + rxt(k,99) + het_rates(k,206))* y(k,206) - prod(k,78) =.510_r8*rxt(k,704)*y(k,300)*y(k,256) - loss(k,79) = (rxt(k,748)* y(k,293) + rxt(k,100) + het_rates(k,207))* y(k,207) - prod(k,79) =.510_r8*rxt(k,722)*y(k,302)*y(k,256) - loss(k,100) = (rxt(k,758)* y(k,293) + rxt(k,101) + rxt(k,793) & + loss(k,113) = (rxt(k,746)* y(k,293) + rxt(k,99) + het_rates(k,206))* y(k,206) + prod(k,113) =.510_r8*rxt(k,703)*y(k,300)*y(k,256) + loss(k,114) = (rxt(k,747)* y(k,293) + rxt(k,100) + het_rates(k,207)) & + * y(k,207) + prod(k,114) =.510_r8*rxt(k,721)*y(k,302)*y(k,256) + loss(k,123) = (rxt(k,757)* y(k,293) + rxt(k,101) + rxt(k,792) & + het_rates(k,208))* y(k,208) - prod(k,100) =rxt(k,687)*y(k,305)*y(k,148) - loss(k,92) = (rxt(k,759)* y(k,293) + rxt(k,102) + rxt(k,835) & + prod(k,123) =rxt(k,686)*y(k,305)*y(k,148) + loss(k,115) = (rxt(k,758)* y(k,293) + rxt(k,102) + rxt(k,834) & + het_rates(k,209))* y(k,209) - prod(k,92) = (.820_r8*rxt(k,688)*y(k,297) +.820_r8*rxt(k,692)*y(k,298)) & + prod(k,115) = (.820_r8*rxt(k,687)*y(k,297) +.820_r8*rxt(k,691)*y(k,298)) & *y(k,256) - loss(k,262) = (rxt(k,760)* y(k,149) +rxt(k,763)* y(k,157) +rxt(k,764) & + loss(k,293) = (rxt(k,759)* y(k,149) +rxt(k,762)* y(k,157) +rxt(k,763) & * y(k,293) + het_rates(k,210))* y(k,210) - prod(k,262) = (.460_r8*rxt(k,646)*y(k,250) +.310_r8*rxt(k,647)*y(k,251) + & - .230_r8*rxt(k,648)*y(k,256) +.860_r8*rxt(k,649)*y(k,279) + & - .430_r8*rxt(k,650)*y(k,147) +.460_r8*rxt(k,651)*y(k,149) + & - .460_r8*rxt(k,652)*y(k,300) +.460_r8*rxt(k,653)*y(k,302) + & - .460_r8*rxt(k,654)*y(k,305))*y(k,279) & - + (.120_r8*rxt(k,595)*y(k,250) +.140_r8*rxt(k,596)*y(k,251) + & - .060_r8*rxt(k,597)*y(k,256) +.090_r8*rxt(k,598)*y(k,147) + & - .120_r8*rxt(k,599)*y(k,149) +.120_r8*rxt(k,600)*y(k,300) + & - .120_r8*rxt(k,601)*y(k,302) +.120_r8*rxt(k,602)*y(k,305))*y(k,236) & - + (rxt(k,655)*y(k,250) +rxt(k,656)*y(k,251) + & - .100_r8*rxt(k,657)*y(k,256) +.770_r8*rxt(k,658)*y(k,147) + & - rxt(k,659)*y(k,149) +rxt(k,660)*y(k,300) +rxt(k,661)*y(k,302) + & - rxt(k,662)*y(k,305))*y(k,280) + (.270_r8*rxt(k,635)*y(k,250) + & - .370_r8*rxt(k,636)*y(k,251) +.200_r8*rxt(k,638)*y(k,147) + & - .270_r8*rxt(k,639)*y(k,149) +.270_r8*rxt(k,640)*y(k,300) + & - .270_r8*rxt(k,641)*y(k,302) +.270_r8*rxt(k,642)*y(k,305))*y(k,244) & - + (.660_r8*rxt(k,663)*y(k,125) +rxt(k,768)*y(k,211))*y(k,157) & - + (.100_r8*rxt(k,766)*y(k,256) +.700_r8*rxt(k,767)*y(k,147)) & - *y(k,307) +.500_r8*rxt(k,765)*y(k,211)*y(k,149) +rxt(k,91)*y(k,198) & + prod(k,293) = (.460_r8*rxt(k,645)*y(k,250) +.310_r8*rxt(k,646)*y(k,251) + & + .230_r8*rxt(k,647)*y(k,256) +.860_r8*rxt(k,648)*y(k,279) + & + .430_r8*rxt(k,649)*y(k,147) +.460_r8*rxt(k,650)*y(k,149) + & + .460_r8*rxt(k,651)*y(k,300) +.460_r8*rxt(k,652)*y(k,302) + & + .460_r8*rxt(k,653)*y(k,305))*y(k,279) & + + (.120_r8*rxt(k,594)*y(k,250) +.140_r8*rxt(k,595)*y(k,251) + & + .060_r8*rxt(k,596)*y(k,256) +.090_r8*rxt(k,597)*y(k,147) + & + .120_r8*rxt(k,598)*y(k,149) +.120_r8*rxt(k,599)*y(k,300) + & + .120_r8*rxt(k,600)*y(k,302) +.120_r8*rxt(k,601)*y(k,305))*y(k,236) & + + (rxt(k,654)*y(k,250) +rxt(k,655)*y(k,251) + & + .100_r8*rxt(k,656)*y(k,256) +.770_r8*rxt(k,657)*y(k,147) + & + rxt(k,658)*y(k,149) +rxt(k,659)*y(k,300) +rxt(k,660)*y(k,302) + & + rxt(k,661)*y(k,305))*y(k,280) + (.270_r8*rxt(k,634)*y(k,250) + & + .370_r8*rxt(k,635)*y(k,251) +.200_r8*rxt(k,637)*y(k,147) + & + .270_r8*rxt(k,638)*y(k,149) +.270_r8*rxt(k,639)*y(k,300) + & + .270_r8*rxt(k,640)*y(k,302) +.270_r8*rxt(k,641)*y(k,305))*y(k,244) & + + (.660_r8*rxt(k,662)*y(k,125) +rxt(k,767)*y(k,211))*y(k,157) & + + (.100_r8*rxt(k,765)*y(k,256) +.700_r8*rxt(k,766)*y(k,147)) & + *y(k,307) +.500_r8*rxt(k,764)*y(k,211)*y(k,149) +rxt(k,91)*y(k,198) & +.460_r8*rxt(k,106)*y(k,216) +.460_r8*rxt(k,108)*y(k,218) & +rxt(k,110)*y(k,220) +rxt(k,112)*y(k,222) - loss(k,261) = (rxt(k,765)* y(k,149) +rxt(k,768)* y(k,157) +rxt(k,769) & + loss(k,281) = (rxt(k,764)* y(k,149) +rxt(k,767)* y(k,157) +rxt(k,768) & * y(k,293) + het_rates(k,211))* y(k,211) - prod(k,261) = (1.640_r8*rxt(k,606)*y(k,238) +rxt(k,607)*y(k,250) + & - .820_r8*rxt(k,608)*y(k,251) +.500_r8*rxt(k,609)*y(k,256) + & - .930_r8*rxt(k,610)*y(k,147) +rxt(k,611)*y(k,149) + & - rxt(k,612)*y(k,300) +rxt(k,613)*y(k,302) +rxt(k,614)*y(k,305)) & - *y(k,238) + (.950_r8*rxt(k,666)*y(k,250) + & - .770_r8*rxt(k,667)*y(k,251) +.480_r8*rxt(k,668)*y(k,256) + & - 1.540_r8*rxt(k,669)*y(k,288) +.890_r8*rxt(k,670)*y(k,147) + & - .950_r8*rxt(k,671)*y(k,149) +.950_r8*rxt(k,672)*y(k,300) + & - .950_r8*rxt(k,673)*y(k,302) +.950_r8*rxt(k,674)*y(k,305))*y(k,288) & - + (rxt(k,615)*y(k,250) +rxt(k,616)*y(k,251) + & - .100_r8*rxt(k,617)*y(k,256) +.700_r8*rxt(k,618)*y(k,147) + & - rxt(k,619)*y(k,149) +rxt(k,620)*y(k,300) +rxt(k,621)*y(k,302) + & - rxt(k,622)*y(k,305))*y(k,239) + (rxt(k,675)*y(k,250) + & - rxt(k,676)*y(k,251) +.100_r8*rxt(k,677)*y(k,256) + & - .710_r8*rxt(k,678)*y(k,147) +rxt(k,679)*y(k,149) + & - rxt(k,680)*y(k,300) +rxt(k,681)*y(k,302) +rxt(k,682)*y(k,305)) & - *y(k,289) + (.870_r8*rxt(k,623)*y(k,7) +rxt(k,683)*y(k,135))*y(k,157) & + prod(k,281) = (1.640_r8*rxt(k,605)*y(k,238) +rxt(k,606)*y(k,250) + & + .820_r8*rxt(k,607)*y(k,251) +.500_r8*rxt(k,608)*y(k,256) + & + .930_r8*rxt(k,609)*y(k,147) +rxt(k,610)*y(k,149) + & + rxt(k,611)*y(k,300) +rxt(k,612)*y(k,302) +rxt(k,613)*y(k,305)) & + *y(k,238) + (.950_r8*rxt(k,665)*y(k,250) + & + .770_r8*rxt(k,666)*y(k,251) +.480_r8*rxt(k,667)*y(k,256) + & + 1.540_r8*rxt(k,668)*y(k,288) +.890_r8*rxt(k,669)*y(k,147) + & + .950_r8*rxt(k,670)*y(k,149) +.950_r8*rxt(k,671)*y(k,300) + & + .950_r8*rxt(k,672)*y(k,302) +.950_r8*rxt(k,673)*y(k,305))*y(k,288) & + + (rxt(k,614)*y(k,250) +rxt(k,615)*y(k,251) + & + .100_r8*rxt(k,616)*y(k,256) +.700_r8*rxt(k,617)*y(k,147) + & + rxt(k,618)*y(k,149) +rxt(k,619)*y(k,300) +rxt(k,620)*y(k,302) + & + rxt(k,621)*y(k,305))*y(k,239) + (rxt(k,674)*y(k,250) + & + rxt(k,675)*y(k,251) +.100_r8*rxt(k,676)*y(k,256) + & + .710_r8*rxt(k,677)*y(k,147) +rxt(k,678)*y(k,149) + & + rxt(k,679)*y(k,300) +rxt(k,680)*y(k,302) +rxt(k,681)*y(k,305)) & + *y(k,289) + (.870_r8*rxt(k,622)*y(k,7) +rxt(k,682)*y(k,135))*y(k,157) & +rxt(k,92)*y(k,199) - loss(k,190) = (rxt(k,770)* y(k,293) + rxt(k,103) + rxt(k,836) & + loss(k,213) = (rxt(k,769)* y(k,293) + rxt(k,103) + rxt(k,835) & + het_rates(k,212))* y(k,212) - prod(k,190) = (.070_r8*rxt(k,590)*y(k,235) +.070_r8*rxt(k,630)*y(k,243) + & - .070_r8*rxt(k,650)*y(k,279) +.070_r8*rxt(k,670)*y(k,288) + & - .300_r8*rxt(k,774)*y(k,308) +.300_r8*rxt(k,778)*y(k,309) + & - .300_r8*rxt(k,782)*y(k,310) +.300_r8*rxt(k,786)*y(k,311))*y(k,147) - loss(k,164) = (rxt(k,771)* y(k,293) + rxt(k,104) + rxt(k,837) & + prod(k,213) = (.070_r8*rxt(k,589)*y(k,235) +.070_r8*rxt(k,629)*y(k,243) + & + .070_r8*rxt(k,649)*y(k,279) +.070_r8*rxt(k,669)*y(k,288) + & + .300_r8*rxt(k,773)*y(k,308) +.300_r8*rxt(k,777)*y(k,309) + & + .300_r8*rxt(k,781)*y(k,310) +.300_r8*rxt(k,785)*y(k,311))*y(k,147) + loss(k,190) = (rxt(k,770)* y(k,293) + rxt(k,104) + rxt(k,836) & + het_rates(k,213))* y(k,213) - prod(k,164) = (.010_r8*rxt(k,598)*y(k,236) +.300_r8*rxt(k,689)*y(k,297) + & - .300_r8*rxt(k,693)*y(k,298) +.300_r8*rxt(k,762)*y(k,306))*y(k,147) & - + (.900_r8*rxt(k,773)*y(k,308) +.900_r8*rxt(k,777)*y(k,309) + & - .900_r8*rxt(k,781)*y(k,310) +.900_r8*rxt(k,785)*y(k,311))*y(k,256) - loss(k,175) = (rxt(k,772)* y(k,293) + het_rates(k,214))* y(k,214) - prod(k,175) = (.040_r8*rxt(k,626)*y(k,243) +.020_r8*rxt(k,627)*y(k,250) + & - .020_r8*rxt(k,628)*y(k,251) +.020_r8*rxt(k,629)*y(k,256) + & - .020_r8*rxt(k,630)*y(k,147) +.020_r8*rxt(k,631)*y(k,149) + & - .020_r8*rxt(k,632)*y(k,300) +.020_r8*rxt(k,633)*y(k,302) + & - .020_r8*rxt(k,634)*y(k,305))*y(k,243) & - + (.320_r8*rxt(k,635)*y(k,250) +.320_r8*rxt(k,636)*y(k,251) + & - .030_r8*rxt(k,637)*y(k,256) +.240_r8*rxt(k,638)*y(k,147) + & - .320_r8*rxt(k,639)*y(k,149) +.320_r8*rxt(k,640)*y(k,300) + & - .320_r8*rxt(k,641)*y(k,302) +.320_r8*rxt(k,642)*y(k,305))*y(k,244) & - +.510_r8*rxt(k,643)*y(k,157)*y(k,17) +.110_r8*rxt(k,596)*y(k,251) & + prod(k,190) = (.010_r8*rxt(k,597)*y(k,236) +.300_r8*rxt(k,688)*y(k,297) + & + .300_r8*rxt(k,692)*y(k,298) +.300_r8*rxt(k,761)*y(k,306))*y(k,147) & + + (.900_r8*rxt(k,772)*y(k,308) +.900_r8*rxt(k,776)*y(k,309) + & + .900_r8*rxt(k,780)*y(k,310) +.900_r8*rxt(k,784)*y(k,311))*y(k,256) + loss(k,201) = (rxt(k,771)* y(k,293) + het_rates(k,214))* y(k,214) + prod(k,201) = (.040_r8*rxt(k,625)*y(k,243) +.020_r8*rxt(k,626)*y(k,250) + & + .020_r8*rxt(k,627)*y(k,251) +.020_r8*rxt(k,628)*y(k,256) + & + .020_r8*rxt(k,629)*y(k,147) +.020_r8*rxt(k,630)*y(k,149) + & + .020_r8*rxt(k,631)*y(k,300) +.020_r8*rxt(k,632)*y(k,302) + & + .020_r8*rxt(k,633)*y(k,305))*y(k,243) & + + (.320_r8*rxt(k,634)*y(k,250) +.320_r8*rxt(k,635)*y(k,251) + & + .030_r8*rxt(k,636)*y(k,256) +.240_r8*rxt(k,637)*y(k,147) + & + .320_r8*rxt(k,638)*y(k,149) +.320_r8*rxt(k,639)*y(k,300) + & + .320_r8*rxt(k,640)*y(k,302) +.320_r8*rxt(k,641)*y(k,305))*y(k,244) & + +.510_r8*rxt(k,642)*y(k,157)*y(k,17) +.110_r8*rxt(k,595)*y(k,251) & *y(k,236) - loss(k,166) = (rxt(k,776)* y(k,293) + rxt(k,105) + het_rates(k,215)) & + loss(k,192) = (rxt(k,775)* y(k,293) + rxt(k,105) + het_rates(k,215)) & * y(k,215) - prod(k,166) = (.450_r8*rxt(k,629)*y(k,243) +.100_r8*rxt(k,773)*y(k,308)) & - *y(k,256) +.700_r8*rxt(k,774)*y(k,308)*y(k,147) - loss(k,134) = (rxt(k,775)* y(k,293) + rxt(k,106) + het_rates(k,216)) & + prod(k,192) = (.450_r8*rxt(k,628)*y(k,243) +.100_r8*rxt(k,772)*y(k,308)) & + *y(k,256) +.700_r8*rxt(k,773)*y(k,308)*y(k,147) + loss(k,157) = (rxt(k,774)* y(k,293) + rxt(k,106) + het_rates(k,216)) & * y(k,216) - prod(k,134) = (.320_r8*rxt(k,648)*y(k,279) +.360_r8*rxt(k,668)*y(k,288)) & + prod(k,157) = (.320_r8*rxt(k,647)*y(k,279) +.360_r8*rxt(k,667)*y(k,288)) & *y(k,256) - loss(k,179) = (rxt(k,780)* y(k,293) + rxt(k,107) + rxt(k,839) & + loss(k,206) = (rxt(k,779)* y(k,293) + rxt(k,107) + rxt(k,838) & + het_rates(k,217))* y(k,217) - prod(k,179) = (.300_r8*rxt(k,589)*y(k,235) +.080_r8*rxt(k,629)*y(k,243) + & - .100_r8*rxt(k,777)*y(k,309))*y(k,256) +.700_r8*rxt(k,778)*y(k,309) & + prod(k,206) = (.300_r8*rxt(k,588)*y(k,235) +.080_r8*rxt(k,628)*y(k,243) + & + .100_r8*rxt(k,776)*y(k,309))*y(k,256) +.700_r8*rxt(k,777)*y(k,309) & *y(k,147) - loss(k,144) = (rxt(k,779)* y(k,293) + rxt(k,108) + rxt(k,838) & + loss(k,170) = (rxt(k,778)* y(k,293) + rxt(k,108) + rxt(k,837) & + het_rates(k,218))* y(k,218) - prod(k,144) = (.180_r8*rxt(k,648)*y(k,279) +.160_r8*rxt(k,668)*y(k,288)) & + prod(k,170) = (.180_r8*rxt(k,647)*y(k,279) +.160_r8*rxt(k,667)*y(k,288)) & *y(k,256) - loss(k,217) = (rxt(k,784)* y(k,293) + rxt(k,109) + het_rates(k,219)) & + loss(k,242) = (rxt(k,783)* y(k,293) + rxt(k,109) + het_rates(k,219)) & * y(k,219) - prod(k,217) = (.920_r8*rxt(k,626)*y(k,243) +.450_r8*rxt(k,627)*y(k,250) + & - .560_r8*rxt(k,628)*y(k,251) +.230_r8*rxt(k,629)*y(k,256) + & - .420_r8*rxt(k,630)*y(k,147) +.450_r8*rxt(k,631)*y(k,149) + & - .450_r8*rxt(k,632)*y(k,300) +.450_r8*rxt(k,633)*y(k,302) + & - .450_r8*rxt(k,634)*y(k,305))*y(k,243) & - + (.100_r8*rxt(k,598)*y(k,236) +.020_r8*rxt(k,638)*y(k,244) + & - .300_r8*rxt(k,697)*y(k,299) +.090_r8*rxt(k,742)*y(k,304) + & - .700_r8*rxt(k,782)*y(k,310))*y(k,147) + (rxt(k,103) + & - rxt(k,770)*y(k,293))*y(k,212) + (rxt(k,104) +rxt(k,771)*y(k,293)) & - *y(k,213) + (.090_r8*rxt(k,586)*y(k,235) + & - .090_r8*rxt(k,588)*y(k,251))*y(k,235) +.500_r8*rxt(k,105)*y(k,215) & - +.100_r8*rxt(k,781)*y(k,310)*y(k,256) - loss(k,226) = (rxt(k,783)* y(k,293) + rxt(k,110) + het_rates(k,220)) & + prod(k,242) = (.920_r8*rxt(k,625)*y(k,243) +.450_r8*rxt(k,626)*y(k,250) + & + .560_r8*rxt(k,627)*y(k,251) +.230_r8*rxt(k,628)*y(k,256) + & + .420_r8*rxt(k,629)*y(k,147) +.450_r8*rxt(k,630)*y(k,149) + & + .450_r8*rxt(k,631)*y(k,300) +.450_r8*rxt(k,632)*y(k,302) + & + .450_r8*rxt(k,633)*y(k,305))*y(k,243) & + + (.100_r8*rxt(k,597)*y(k,236) +.020_r8*rxt(k,637)*y(k,244) + & + .300_r8*rxt(k,696)*y(k,299) +.090_r8*rxt(k,741)*y(k,304) + & + .700_r8*rxt(k,781)*y(k,310))*y(k,147) + (rxt(k,103) + & + rxt(k,769)*y(k,293))*y(k,212) + (rxt(k,104) +rxt(k,770)*y(k,293)) & + *y(k,213) + (.090_r8*rxt(k,585)*y(k,235) + & + .090_r8*rxt(k,587)*y(k,251))*y(k,235) +.500_r8*rxt(k,105)*y(k,215) & + +.100_r8*rxt(k,780)*y(k,310)*y(k,256) + loss(k,250) = (rxt(k,782)* y(k,293) + rxt(k,110) + het_rates(k,220)) & * y(k,220) - prod(k,226) = (.350_r8*rxt(k,646)*y(k,250) +.420_r8*rxt(k,647)*y(k,251) + & - .180_r8*rxt(k,648)*y(k,256) +.720_r8*rxt(k,649)*y(k,279) + & - .330_r8*rxt(k,650)*y(k,147) +.350_r8*rxt(k,651)*y(k,149) + & - .350_r8*rxt(k,652)*y(k,300) +.350_r8*rxt(k,653)*y(k,302) + & - .350_r8*rxt(k,654)*y(k,305))*y(k,279) & - + (.050_r8*rxt(k,666)*y(k,250) +.140_r8*rxt(k,667)*y(k,251) + & - .190_r8*rxt(k,669)*y(k,288) +.040_r8*rxt(k,670)*y(k,147) + & - .050_r8*rxt(k,671)*y(k,149) +.050_r8*rxt(k,672)*y(k,300) + & - .050_r8*rxt(k,673)*y(k,302) +.050_r8*rxt(k,674)*y(k,305))*y(k,288) & - + (.020_r8*rxt(k,598)*y(k,236) +.040_r8*rxt(k,638)*y(k,244) + & - .060_r8*rxt(k,658)*y(k,280) +.100_r8*rxt(k,678)*y(k,289) + & - .120_r8*rxt(k,767)*y(k,307))*y(k,147) +.500_r8*rxt(k,765)*y(k,211) & + prod(k,250) = (.350_r8*rxt(k,645)*y(k,250) +.420_r8*rxt(k,646)*y(k,251) + & + .180_r8*rxt(k,647)*y(k,256) +.720_r8*rxt(k,648)*y(k,279) + & + .330_r8*rxt(k,649)*y(k,147) +.350_r8*rxt(k,650)*y(k,149) + & + .350_r8*rxt(k,651)*y(k,300) +.350_r8*rxt(k,652)*y(k,302) + & + .350_r8*rxt(k,653)*y(k,305))*y(k,279) & + + (.050_r8*rxt(k,665)*y(k,250) +.140_r8*rxt(k,666)*y(k,251) + & + .190_r8*rxt(k,668)*y(k,288) +.040_r8*rxt(k,669)*y(k,147) + & + .050_r8*rxt(k,670)*y(k,149) +.050_r8*rxt(k,671)*y(k,300) + & + .050_r8*rxt(k,672)*y(k,302) +.050_r8*rxt(k,673)*y(k,305))*y(k,288) & + + (.020_r8*rxt(k,597)*y(k,236) +.040_r8*rxt(k,637)*y(k,244) + & + .060_r8*rxt(k,657)*y(k,280) +.100_r8*rxt(k,677)*y(k,289) + & + .120_r8*rxt(k,766)*y(k,307))*y(k,147) +.500_r8*rxt(k,764)*y(k,211) & *y(k,149) +.540_r8*rxt(k,106)*y(k,216) - loss(k,213) = (rxt(k,788)* y(k,293) + rxt(k,111) + rxt(k,841) & + loss(k,240) = (rxt(k,787)* y(k,293) + rxt(k,111) + rxt(k,840) & + het_rates(k,221))* y(k,221) - prod(k,213) = (.140_r8*rxt(k,626)*y(k,243) +.050_r8*rxt(k,627)*y(k,250) + & - .080_r8*rxt(k,628)*y(k,251) +.050_r8*rxt(k,630)*y(k,147) + & - .050_r8*rxt(k,631)*y(k,149) +.050_r8*rxt(k,632)*y(k,300) + & - .050_r8*rxt(k,633)*y(k,302) +.050_r8*rxt(k,634)*y(k,305))*y(k,243) & - + (.050_r8*rxt(k,598)*y(k,236) +.060_r8*rxt(k,638)*y(k,244) + & - .170_r8*rxt(k,713)*y(k,301) +.300_r8*rxt(k,732)*y(k,303) + & - .700_r8*rxt(k,786)*y(k,311))*y(k,147) & - + (.270_r8*rxt(k,586)*y(k,235) +.090_r8*rxt(k,588)*y(k,251)) & - *y(k,235) +rxt(k,780)*y(k,293)*y(k,217) +.100_r8*rxt(k,785)*y(k,311) & + prod(k,240) = (.140_r8*rxt(k,625)*y(k,243) +.050_r8*rxt(k,626)*y(k,250) + & + .080_r8*rxt(k,627)*y(k,251) +.050_r8*rxt(k,629)*y(k,147) + & + .050_r8*rxt(k,630)*y(k,149) +.050_r8*rxt(k,631)*y(k,300) + & + .050_r8*rxt(k,632)*y(k,302) +.050_r8*rxt(k,633)*y(k,305))*y(k,243) & + + (.050_r8*rxt(k,597)*y(k,236) +.060_r8*rxt(k,637)*y(k,244) + & + .170_r8*rxt(k,712)*y(k,301) +.300_r8*rxt(k,731)*y(k,303) + & + .700_r8*rxt(k,785)*y(k,311))*y(k,147) & + + (.270_r8*rxt(k,585)*y(k,235) +.090_r8*rxt(k,587)*y(k,251)) & + *y(k,235) +rxt(k,779)*y(k,293)*y(k,217) +.100_r8*rxt(k,784)*y(k,311) & *y(k,256) - loss(k,227) = (rxt(k,787)* y(k,293) + rxt(k,112) + rxt(k,840) & + loss(k,251) = (rxt(k,786)* y(k,293) + rxt(k,112) + rxt(k,839) & + het_rates(k,222))* y(k,222) - prod(k,227) = (.190_r8*rxt(k,646)*y(k,250) +.270_r8*rxt(k,647)*y(k,251) + & - .090_r8*rxt(k,648)*y(k,256) +.420_r8*rxt(k,649)*y(k,279) + & - .170_r8*rxt(k,650)*y(k,147) +.190_r8*rxt(k,651)*y(k,149) + & - .190_r8*rxt(k,652)*y(k,300) +.190_r8*rxt(k,653)*y(k,302) + & - .190_r8*rxt(k,654)*y(k,305))*y(k,279) & - + (.050_r8*rxt(k,598)*y(k,236) +.130_r8*rxt(k,638)*y(k,244) + & - .170_r8*rxt(k,658)*y(k,280) +.190_r8*rxt(k,678)*y(k,289) + & - .180_r8*rxt(k,767)*y(k,307))*y(k,147) & - + (.090_r8*rxt(k,667)*y(k,251) +.270_r8*rxt(k,669)*y(k,288)) & + prod(k,251) = (.190_r8*rxt(k,645)*y(k,250) +.270_r8*rxt(k,646)*y(k,251) + & + .090_r8*rxt(k,647)*y(k,256) +.420_r8*rxt(k,648)*y(k,279) + & + .170_r8*rxt(k,649)*y(k,147) +.190_r8*rxt(k,650)*y(k,149) + & + .190_r8*rxt(k,651)*y(k,300) +.190_r8*rxt(k,652)*y(k,302) + & + .190_r8*rxt(k,653)*y(k,305))*y(k,279) & + + (.050_r8*rxt(k,597)*y(k,236) +.130_r8*rxt(k,637)*y(k,244) + & + .170_r8*rxt(k,657)*y(k,280) +.190_r8*rxt(k,677)*y(k,289) + & + .180_r8*rxt(k,766)*y(k,307))*y(k,147) & + + (.090_r8*rxt(k,666)*y(k,251) +.270_r8*rxt(k,668)*y(k,288)) & *y(k,288) +.540_r8*rxt(k,108)*y(k,218) - loss(k,135) = (rxt(k,790)* y(k,293) + rxt(k,113) + het_rates(k,223)) & + loss(k,158) = (rxt(k,789)* y(k,293) + rxt(k,113) + het_rates(k,223)) & * y(k,223) - prod(k,135) = (.400_r8*rxt(k,597)*y(k,236) +.290_r8*rxt(k,637)*y(k,244) + & - rxt(k,696)*y(k,299) +.620_r8*rxt(k,712)*y(k,301))*y(k,256) & - + (rxt(k,102) +rxt(k,759)*y(k,293))*y(k,209) - loss(k,127) = (rxt(k,789)* y(k,293) + rxt(k,114) + het_rates(k,224)) & + prod(k,158) = (.400_r8*rxt(k,596)*y(k,236) +.290_r8*rxt(k,636)*y(k,244) + & + rxt(k,695)*y(k,299) +.620_r8*rxt(k,711)*y(k,301))*y(k,256) & + + (rxt(k,102) +rxt(k,758)*y(k,293))*y(k,209) + loss(k,149) = (rxt(k,788)* y(k,293) + rxt(k,114) + het_rates(k,224)) & * y(k,224) - prod(k,127) = (.180_r8*rxt(k,688)*y(k,297) +.850_r8*rxt(k,731)*y(k,303) + & - .470_r8*rxt(k,741)*y(k,304) +.900_r8*rxt(k,761)*y(k,306))*y(k,256) & - +.700_r8*rxt(k,689)*y(k,297)*y(k,147) - loss(k,138) = (rxt(k,574)* y(k,293) + rxt(k,115) + het_rates(k,225)) & + prod(k,149) = (.180_r8*rxt(k,687)*y(k,297) +.850_r8*rxt(k,730)*y(k,303) + & + .470_r8*rxt(k,740)*y(k,304) +.900_r8*rxt(k,760)*y(k,306))*y(k,256) & + +.700_r8*rxt(k,688)*y(k,297)*y(k,147) + loss(k,166) = (rxt(k,573)* y(k,293) + rxt(k,115) + het_rates(k,225)) & * y(k,225) - prod(k,138) =rxt(k,572)*y(k,312)*y(k,256) - loss(k,63) = (rxt(k,575)* y(k,293) + het_rates(k,226))* y(k,226) - prod(k,63) = 0._r8 - loss(k,66) = (rxt(k,577)* y(k,293) + het_rates(k,227))* y(k,227) - prod(k,66) = 0._r8 - loss(k,150) = (rxt(k,580)* y(k,293) + rxt(k,116) + het_rates(k,228)) & + prod(k,166) =rxt(k,571)*y(k,312)*y(k,256) + loss(k,81) = (rxt(k,574)* y(k,293) + het_rates(k,226))* y(k,226) + prod(k,81) = 0._r8 + loss(k,84) = (rxt(k,576)* y(k,293) + het_rates(k,227))* y(k,227) + prod(k,84) = 0._r8 + loss(k,176) = (rxt(k,579)* y(k,293) + rxt(k,116) + het_rates(k,228)) & * y(k,228) - prod(k,150) =rxt(k,578)*y(k,314)*y(k,256) - loss(k,67) = (rxt(k,583)* y(k,293) + het_rates(k,229))* y(k,229) - prod(k,67) =.150_r8*rxt(k,577)*y(k,293)*y(k,227) - loss(k,101) = (rxt(k,584)* y(k,293) + rxt(k,117) + het_rates(k,230)) & + prod(k,176) =rxt(k,577)*y(k,314)*y(k,256) + loss(k,85) = (rxt(k,582)* y(k,293) + het_rates(k,229))* y(k,229) + prod(k,85) =.150_r8*rxt(k,576)*y(k,293)*y(k,227) + loss(k,124) = (rxt(k,583)* y(k,293) + rxt(k,117) + het_rates(k,230)) & * y(k,230) - prod(k,101) =rxt(k,581)*y(k,316)*y(k,256) - loss(k,118) = (rxt(k,543)* y(k,147) +rxt(k,571)* y(k,148) +rxt(k,542) & + prod(k,124) =rxt(k,580)*y(k,316)*y(k,256) + loss(k,142) = (rxt(k,542)* y(k,147) +rxt(k,570)* y(k,148) +rxt(k,541) & * y(k,256) + het_rates(k,233))* y(k,233) - prod(k,118) =rxt(k,548)*y(k,293)*y(k,23) +rxt(k,576)*y(k,163) - loss(k,188) = ((rxt(k,411) +rxt(k,412))* y(k,147) +rxt(k,410)* y(k,256) & + prod(k,142) =rxt(k,547)*y(k,293)*y(k,23) +rxt(k,575)*y(k,163) + loss(k,210) = ((rxt(k,410) +rxt(k,411))* y(k,147) +rxt(k,409)* y(k,256) & + het_rates(k,234))* y(k,234) - prod(k,188) = (rxt(k,413)*y(k,2) +rxt(k,414)*y(k,15))*y(k,293) - loss(k,250) = (rxt(k,590)* y(k,147) +rxt(k,591)* y(k,149) + 2._r8*rxt(k,586) & - * y(k,235) +rxt(k,587)* y(k,250) +rxt(k,588)* y(k,251) +rxt(k,589) & - * y(k,256) +rxt(k,592)* y(k,300) +rxt(k,593)* y(k,302) +rxt(k,594) & + prod(k,210) = (rxt(k,412)*y(k,2) +rxt(k,413)*y(k,15))*y(k,293) + loss(k,279) = (rxt(k,589)* y(k,147) +rxt(k,590)* y(k,149) + 2._r8*rxt(k,585) & + * y(k,235) +rxt(k,586)* y(k,250) +rxt(k,587)* y(k,251) +rxt(k,588) & + * y(k,256) +rxt(k,591)* y(k,300) +rxt(k,592)* y(k,302) +rxt(k,593) & * y(k,305) + het_rates(k,235))* y(k,235) - prod(k,250) =rxt(k,585)*y(k,149)*y(k,4) - loss(k,255) = (rxt(k,598)* y(k,147) +rxt(k,599)* y(k,149) +rxt(k,595) & - * y(k,250) +rxt(k,596)* y(k,251) +rxt(k,597)* y(k,256) +rxt(k,600) & - * y(k,300) +rxt(k,601)* y(k,302) +rxt(k,602)* y(k,305) & + prod(k,279) =rxt(k,584)*y(k,149)*y(k,4) + loss(k,286) = (rxt(k,597)* y(k,147) +rxt(k,598)* y(k,149) +rxt(k,594) & + * y(k,250) +rxt(k,595)* y(k,251) +rxt(k,596)* y(k,256) +rxt(k,599) & + * y(k,300) +rxt(k,600)* y(k,302) +rxt(k,601)* y(k,305) & + het_rates(k,236))* y(k,236) - prod(k,255) =rxt(k,604)*y(k,293)*y(k,4) - loss(k,36) = (rxt(k,844)* y(k,147) +rxt(k,843)* y(k,256) + het_rates(k,237)) & + prod(k,286) =rxt(k,603)*y(k,293)*y(k,4) + loss(k,45) = (rxt(k,843)* y(k,147) +rxt(k,842)* y(k,256) + het_rates(k,237)) & * y(k,237) - prod(k,36) =rxt(k,846)*y(k,293)*y(k,4) - loss(k,247) = (rxt(k,610)* y(k,147) +rxt(k,611)* y(k,149) + 2._r8*rxt(k,606) & - * y(k,238) +rxt(k,607)* y(k,250) +rxt(k,608)* y(k,251) +rxt(k,609) & - * y(k,256) +rxt(k,612)* y(k,300) +rxt(k,613)* y(k,302) +rxt(k,614) & + prod(k,45) =rxt(k,845)*y(k,293)*y(k,4) + loss(k,275) = (rxt(k,609)* y(k,147) +rxt(k,610)* y(k,149) + 2._r8*rxt(k,605) & + * y(k,238) +rxt(k,606)* y(k,250) +rxt(k,607)* y(k,251) +rxt(k,608) & + * y(k,256) +rxt(k,611)* y(k,300) +rxt(k,612)* y(k,302) +rxt(k,613) & * y(k,305) + het_rates(k,238))* y(k,238) - prod(k,247) =rxt(k,605)*y(k,149)*y(k,7) - loss(k,249) = (rxt(k,618)* y(k,147) +rxt(k,619)* y(k,149) +rxt(k,615) & - * y(k,250) +rxt(k,616)* y(k,251) +rxt(k,617)* y(k,256) +rxt(k,620) & - * y(k,300) +rxt(k,621)* y(k,302) +rxt(k,622)* y(k,305) & + prod(k,275) =rxt(k,604)*y(k,149)*y(k,7) + loss(k,280) = (rxt(k,617)* y(k,147) +rxt(k,618)* y(k,149) +rxt(k,614) & + * y(k,250) +rxt(k,615)* y(k,251) +rxt(k,616)* y(k,256) +rxt(k,619) & + * y(k,300) +rxt(k,620)* y(k,302) +rxt(k,621)* y(k,305) & + het_rates(k,239))* y(k,239) - prod(k,249) =rxt(k,624)*y(k,293)*y(k,7) - loss(k,37) = (rxt(k,849)* y(k,147) +rxt(k,848)* y(k,256) + het_rates(k,240)) & + prod(k,280) =rxt(k,623)*y(k,293)*y(k,7) + loss(k,46) = (rxt(k,848)* y(k,147) +rxt(k,847)* y(k,256) + het_rates(k,240)) & * y(k,240) - prod(k,37) =rxt(k,851)*y(k,293)*y(k,7) - loss(k,114) = (rxt(k,546)* y(k,147) +rxt(k,545)* y(k,256) + het_rates(k,241)) & + prod(k,46) =rxt(k,850)*y(k,293)*y(k,7) + loss(k,139) = (rxt(k,545)* y(k,147) +rxt(k,544)* y(k,256) + het_rates(k,241)) & * y(k,241) - prod(k,114) = (.350_r8*rxt(k,544)*y(k,8) +rxt(k,547)*y(k,9))*y(k,293) - loss(k,38) = (rxt(k,854)* y(k,147) +rxt(k,853)* y(k,256) + het_rates(k,242)) & + prod(k,139) = (.350_r8*rxt(k,543)*y(k,8) +rxt(k,546)*y(k,9))*y(k,293) + loss(k,47) = (rxt(k,853)* y(k,147) +rxt(k,852)* y(k,256) + het_rates(k,242)) & * y(k,242) - prod(k,38) =rxt(k,852)*y(k,293)*y(k,8) - loss(k,259) = (rxt(k,630)* y(k,147) +rxt(k,631)* y(k,149) + 2._r8*rxt(k,626) & - * y(k,243) +rxt(k,627)* y(k,250) +rxt(k,628)* y(k,251) +rxt(k,629) & - * y(k,256) +rxt(k,632)* y(k,300) +rxt(k,633)* y(k,302) +rxt(k,634) & + prod(k,47) =rxt(k,851)*y(k,293)*y(k,8) + loss(k,288) = (rxt(k,629)* y(k,147) +rxt(k,630)* y(k,149) + 2._r8*rxt(k,625) & + * y(k,243) +rxt(k,626)* y(k,250) +rxt(k,627)* y(k,251) +rxt(k,628) & + * y(k,256) +rxt(k,631)* y(k,300) +rxt(k,632)* y(k,302) +rxt(k,633) & * y(k,305) + het_rates(k,243))* y(k,243) - prod(k,259) =rxt(k,625)*y(k,149)*y(k,17) +rxt(k,776)*y(k,293)*y(k,215) - loss(k,256) = (rxt(k,638)* y(k,147) +rxt(k,639)* y(k,149) +rxt(k,635) & - * y(k,250) +rxt(k,636)* y(k,251) +rxt(k,637)* y(k,256) +rxt(k,640) & - * y(k,300) +rxt(k,641)* y(k,302) +rxt(k,642)* y(k,305) & + prod(k,288) =rxt(k,624)*y(k,149)*y(k,17) +rxt(k,775)*y(k,293)*y(k,215) + loss(k,284) = (rxt(k,637)* y(k,147) +rxt(k,638)* y(k,149) +rxt(k,634) & + * y(k,250) +rxt(k,635)* y(k,251) +rxt(k,636)* y(k,256) +rxt(k,639) & + * y(k,300) +rxt(k,640)* y(k,302) +rxt(k,641)* y(k,305) & + het_rates(k,244))* y(k,244) - prod(k,256) =rxt(k,644)*y(k,293)*y(k,17) - loss(k,39) = (rxt(k,857)* y(k,147) +rxt(k,856)* y(k,256) + het_rates(k,245)) & + prod(k,284) =rxt(k,643)*y(k,293)*y(k,17) + loss(k,48) = (rxt(k,856)* y(k,147) +rxt(k,855)* y(k,256) + het_rates(k,245)) & * y(k,245) - prod(k,39) =rxt(k,859)*y(k,293)*y(k,17) - loss(k,102) = (rxt(k,551)* y(k,147) +rxt(k,549)* y(k,256) + het_rates(k,246)) & + prod(k,48) =rxt(k,858)*y(k,293)*y(k,17) + loss(k,126) = (rxt(k,550)* y(k,147) +rxt(k,548)* y(k,256) + het_rates(k,246)) & * y(k,246) - prod(k,102) = (rxt(k,550)*y(k,24) +.070_r8*rxt(k,575)*y(k,226) + & - .060_r8*rxt(k,577)*y(k,227))*y(k,293) - loss(k,199) = (rxt(k,328)* y(k,147) + 2._r8*rxt(k,325)* y(k,247) +rxt(k,326) & - * y(k,251) +rxt(k,327)* y(k,256) + het_rates(k,247))* y(k,247) - prod(k,199) = (rxt(k,331)*y(k,57) +rxt(k,332)*y(k,293))*y(k,29) & - +.500_r8*rxt(k,330)*y(k,293)*y(k,28) +rxt(k,76)*y(k,129) - loss(k,173) = (rxt(k,358)* y(k,147) +rxt(k,356)* y(k,251) +rxt(k,357) & + prod(k,126) = (rxt(k,549)*y(k,24) +.070_r8*rxt(k,574)*y(k,226) + & + .060_r8*rxt(k,576)*y(k,227))*y(k,293) + loss(k,223) = (rxt(k,327)* y(k,147) + 2._r8*rxt(k,324)* y(k,247) +rxt(k,325) & + * y(k,251) +rxt(k,326)* y(k,256) + het_rates(k,247))* y(k,247) + prod(k,223) = (rxt(k,330)*y(k,57) +rxt(k,331)*y(k,293))*y(k,29) & + +.500_r8*rxt(k,329)*y(k,293)*y(k,28) +rxt(k,76)*y(k,129) + loss(k,197) = (rxt(k,357)* y(k,147) +rxt(k,355)* y(k,251) +rxt(k,356) & * y(k,256) + het_rates(k,248))* y(k,248) - prod(k,173) = (rxt(k,359)*y(k,31) +rxt(k,360)*y(k,32))*y(k,293) - loss(k,137) = (rxt(k,553)* y(k,147) +rxt(k,552)* y(k,256) + het_rates(k,249)) & + prod(k,197) = (rxt(k,358)*y(k,31) +rxt(k,359)*y(k,32))*y(k,293) + loss(k,162) = (rxt(k,552)* y(k,147) +rxt(k,551)* y(k,256) + het_rates(k,249)) & * y(k,249) - prod(k,137) = (.400_r8*rxt(k,542)*y(k,256) +rxt(k,543)*y(k,147))*y(k,233) & - +rxt(k,554)*y(k,293)*y(k,33) +rxt(k,569)*y(k,164)*y(k,157) - loss(k,269) = (rxt(k,339)* y(k,147) +rxt(k,352)* y(k,148) +rxt(k,587) & - * y(k,235) +rxt(k,595)* y(k,236) +rxt(k,607)* y(k,238) +rxt(k,615) & - * y(k,239) +rxt(k,627)* y(k,243) +rxt(k,635)* y(k,244) & - + 2._r8*rxt(k,336)* y(k,250) +rxt(k,337)* y(k,251) +rxt(k,338) & - * y(k,256) +rxt(k,425)* y(k,259) +rxt(k,431)* y(k,260) +rxt(k,445) & - * y(k,265) +rxt(k,449)* y(k,266) +rxt(k,475)* y(k,272) +rxt(k,492) & - * y(k,276) +rxt(k,496)* y(k,277) +rxt(k,646)* y(k,279) +rxt(k,655) & - * y(k,280) +rxt(k,382)* y(k,282) +rxt(k,389)* y(k,284) +rxt(k,401) & - * y(k,287) +rxt(k,666)* y(k,288) +rxt(k,675)* y(k,289) +rxt(k,694) & - * y(k,299) +rxt(k,702)* y(k,300) +rxt(k,710)* y(k,301) +rxt(k,720) & - * y(k,302) +rxt(k,729)* y(k,303) +rxt(k,750)* y(k,305) & + prod(k,162) = (.400_r8*rxt(k,541)*y(k,256) +rxt(k,542)*y(k,147))*y(k,233) & + +rxt(k,553)*y(k,293)*y(k,33) +rxt(k,568)*y(k,164)*y(k,157) + loss(k,302) = (rxt(k,338)* y(k,147) +rxt(k,351)* y(k,148) +rxt(k,586) & + * y(k,235) +rxt(k,594)* y(k,236) +rxt(k,606)* y(k,238) +rxt(k,614) & + * y(k,239) +rxt(k,626)* y(k,243) +rxt(k,634)* y(k,244) & + + 2._r8*rxt(k,335)* y(k,250) +rxt(k,336)* y(k,251) +rxt(k,337) & + * y(k,256) +rxt(k,424)* y(k,259) +rxt(k,430)* y(k,260) +rxt(k,444) & + * y(k,265) +rxt(k,448)* y(k,266) +rxt(k,474)* y(k,272) +rxt(k,491) & + * y(k,276) +rxt(k,495)* y(k,277) +rxt(k,645)* y(k,279) +rxt(k,654) & + * y(k,280) +rxt(k,381)* y(k,282) +rxt(k,388)* y(k,284) +rxt(k,400) & + * y(k,287) +rxt(k,665)* y(k,288) +rxt(k,674)* y(k,289) +rxt(k,693) & + * y(k,299) +rxt(k,701)* y(k,300) +rxt(k,709)* y(k,301) +rxt(k,719) & + * y(k,302) +rxt(k,728)* y(k,303) +rxt(k,749)* y(k,305) & + het_rates(k,250))* y(k,250) - prod(k,269) = (rxt(k,334)*y(k,46) +.500_r8*rxt(k,341)*y(k,52) + & - rxt(k,362)*y(k,50) +.300_r8*rxt(k,364)*y(k,104) + & - .560_r8*rxt(k,406)*y(k,134) +.060_r8*rxt(k,415)*y(k,98) + & - .060_r8*rxt(k,416)*y(k,99) +.100_r8*rxt(k,503)*y(k,139) + & - 2.000_r8*rxt(k,738)*y(k,204))*y(k,293) + (rxt(k,740)*y(k,251) + & - .530_r8*rxt(k,741)*y(k,256) +.910_r8*rxt(k,742)*y(k,147) + & - rxt(k,743)*y(k,149) +rxt(k,744)*y(k,300) +rxt(k,745)*y(k,302) + & - rxt(k,746)*y(k,305))*y(k,304) + (.350_r8*rxt(k,389)*y(k,250) + & - .350_r8*rxt(k,390)*y(k,251) +.170_r8*rxt(k,391)*y(k,256) + & - .700_r8*rxt(k,392)*y(k,284) +.350_r8*rxt(k,393)*y(k,147) + & - .350_r8*rxt(k,394)*y(k,149))*y(k,284) & - + (.100_r8*rxt(k,386)*y(k,126) +.280_r8*rxt(k,404)*y(k,132) + & - .070_r8*rxt(k,487)*y(k,109) +.040_r8*rxt(k,502)*y(k,139) + & - .330_r8*rxt(k,663)*y(k,125))*y(k,157) & - + (.750_r8*rxt(k,401)*y(k,250) +.880_r8*rxt(k,402)*y(k,251) + & - .490_r8*rxt(k,403)*y(k,256) +.760_r8*rxt(k,538)*y(k,147))*y(k,287) & - + (.300_r8*rxt(k,369)*y(k,251) +.150_r8*rxt(k,370)*y(k,256) + & - rxt(k,371)*y(k,147))*y(k,296) + (rxt(k,35) +rxt(k,361)*y(k,149)) & + prod(k,302) = (rxt(k,333)*y(k,46) +.500_r8*rxt(k,340)*y(k,52) + & + rxt(k,361)*y(k,50) +.300_r8*rxt(k,363)*y(k,104) + & + .560_r8*rxt(k,405)*y(k,134) +.060_r8*rxt(k,414)*y(k,98) + & + .060_r8*rxt(k,415)*y(k,99) +.100_r8*rxt(k,502)*y(k,139) + & + 2.000_r8*rxt(k,737)*y(k,204))*y(k,293) + (rxt(k,739)*y(k,251) + & + .530_r8*rxt(k,740)*y(k,256) +.910_r8*rxt(k,741)*y(k,147) + & + rxt(k,742)*y(k,149) +rxt(k,743)*y(k,300) +rxt(k,744)*y(k,302) + & + rxt(k,745)*y(k,305))*y(k,304) + (.350_r8*rxt(k,388)*y(k,250) + & + .350_r8*rxt(k,389)*y(k,251) +.170_r8*rxt(k,390)*y(k,256) + & + .700_r8*rxt(k,391)*y(k,284) +.350_r8*rxt(k,392)*y(k,147) + & + .350_r8*rxt(k,393)*y(k,149))*y(k,284) & + + (.100_r8*rxt(k,385)*y(k,126) +.280_r8*rxt(k,403)*y(k,132) + & + .070_r8*rxt(k,486)*y(k,109) +.040_r8*rxt(k,501)*y(k,139) + & + .330_r8*rxt(k,662)*y(k,125))*y(k,157) & + + (.750_r8*rxt(k,400)*y(k,250) +.880_r8*rxt(k,401)*y(k,251) + & + .490_r8*rxt(k,402)*y(k,256) +.760_r8*rxt(k,537)*y(k,147))*y(k,287) & + + (.300_r8*rxt(k,368)*y(k,251) +.150_r8*rxt(k,369)*y(k,256) + & + rxt(k,370)*y(k,147))*y(k,296) + (rxt(k,35) +rxt(k,360)*y(k,149)) & *y(k,50) + (rxt(k,55) +rxt(k,56))*y(k,104) + (.600_r8*rxt(k,86) + & - rxt(k,353))*y(k,162) + (.200_r8*rxt(k,395)*y(k,256) + & - rxt(k,396)*y(k,147))*y(k,286) +rxt(k,26)*y(k,14) +rxt(k,333)*y(k,149) & + rxt(k,352))*y(k,162) + (.200_r8*rxt(k,394)*y(k,256) + & + rxt(k,395)*y(k,147))*y(k,286) +rxt(k,26)*y(k,14) +rxt(k,332)*y(k,149) & *y(k,46) +rxt(k,34)*y(k,49) +.330_r8*rxt(k,47)*y(k,97) & +.050_r8*rxt(k,48)*y(k,98) +.070_r8*rxt(k,49)*y(k,99) +rxt(k,52) & *y(k,102) +.500_r8*rxt(k,53)*y(k,103) +.350_r8*rxt(k,72)*y(k,126) & +rxt(k,76)*y(k,129) +rxt(k,77)*y(k,130) +.300_r8*rxt(k,79)*y(k,132) & +.750_r8*rxt(k,80)*y(k,133) +.560_r8*rxt(k,81)*y(k,134) +rxt(k,84) & *y(k,151) +rxt(k,89)*y(k,170) +.500_r8*rxt(k,90)*y(k,197) - loss(k,279) = (rxt(k,225)* y(k,60) +rxt(k,305)* y(k,147) +rxt(k,588) & - * y(k,235) +rxt(k,596)* y(k,236) +rxt(k,608)* y(k,238) +rxt(k,616) & - * y(k,239) +rxt(k,628)* y(k,243) +rxt(k,636)* y(k,244) +rxt(k,326) & - * y(k,247) +rxt(k,356)* y(k,248) +rxt(k,337)* y(k,250) & + loss(k,313) = (rxt(k,225)* y(k,60) +rxt(k,305)* y(k,147) +rxt(k,587) & + * y(k,235) +rxt(k,595)* y(k,236) +rxt(k,607)* y(k,238) +rxt(k,615) & + * y(k,239) +rxt(k,627)* y(k,243) +rxt(k,635)* y(k,244) +rxt(k,325) & + * y(k,247) +rxt(k,355)* y(k,248) +rxt(k,336)* y(k,250) & + 2._r8*(rxt(k,302) +rxt(k,303))* y(k,251) +rxt(k,304)* y(k,256) & - +rxt(k,426)* y(k,259) +rxt(k,432)* y(k,260) +rxt(k,446)* y(k,265) & - +rxt(k,450)* y(k,266) +rxt(k,476)* y(k,272) +rxt(k,493)* y(k,276) & - +rxt(k,497)* y(k,277) +rxt(k,647)* y(k,279) +rxt(k,656)* y(k,280) & - +rxt(k,383)* y(k,282) +rxt(k,390)* y(k,284) +rxt(k,402)* y(k,287) & - +rxt(k,667)* y(k,288) +rxt(k,676)* y(k,289) +rxt(k,369)* y(k,296) & - +rxt(k,695)* y(k,299) +rxt(k,703)* y(k,300) +rxt(k,711)* y(k,301) & - +rxt(k,721)* y(k,302) +rxt(k,730)* y(k,303) +rxt(k,740)* y(k,304) & - +rxt(k,751)* y(k,305) + het_rates(k,251))* y(k,251) - prod(k,279) = (2.000_r8*rxt(k,336)*y(k,250) +.900_r8*rxt(k,337)*y(k,251) + & - .490_r8*rxt(k,338)*y(k,256) +rxt(k,339)*y(k,147) + & - rxt(k,382)*y(k,282) +1.650_r8*rxt(k,389)*y(k,284) + & - rxt(k,401)*y(k,287) +rxt(k,425)*y(k,259) +rxt(k,431)*y(k,260) + & - rxt(k,445)*y(k,265) +rxt(k,449)*y(k,266) +rxt(k,475)*y(k,272) + & - rxt(k,492)*y(k,276) +rxt(k,496)*y(k,277) +rxt(k,587)*y(k,235) + & - rxt(k,595)*y(k,236) +rxt(k,607)*y(k,238) +rxt(k,615)*y(k,239) + & - rxt(k,627)*y(k,243) +rxt(k,635)*y(k,244) +rxt(k,646)*y(k,279) + & - rxt(k,655)*y(k,280) +rxt(k,666)*y(k,288) +rxt(k,675)*y(k,289) + & - rxt(k,694)*y(k,299) +rxt(k,702)*y(k,300) +rxt(k,710)*y(k,301) + & - rxt(k,720)*y(k,302) +rxt(k,729)*y(k,303) +rxt(k,739)*y(k,304) + & - rxt(k,750)*y(k,305))*y(k,250) + (.650_r8*rxt(k,390)*y(k,251) + & - .320_r8*rxt(k,391)*y(k,256) +1.300_r8*rxt(k,392)*y(k,284) + & - .650_r8*rxt(k,393)*y(k,147) +.650_r8*rxt(k,394)*y(k,149))*y(k,284) & - + (rxt(k,308)*y(k,55) +.700_r8*rxt(k,307)*y(k,54) + & - rxt(k,340)*y(k,51) +.060_r8*rxt(k,415)*y(k,98) + & - .060_r8*rxt(k,416)*y(k,99))*y(k,293) + (rxt(k,219)*y(k,57) + & - rxt(k,275)*y(k,75) +rxt(k,316)*y(k,292))*y(k,55) & - + (.830_r8*rxt(k,557)*y(k,252) +.170_r8*rxt(k,563)*y(k,285)) & - *y(k,147) + (.280_r8*rxt(k,355)*y(k,30) +.210_r8*rxt(k,487)*y(k,109)) & - *y(k,157) + (.330_r8*rxt(k,556)*y(k,252) + & - .070_r8*rxt(k,562)*y(k,285))*y(k,256) +rxt(k,33)*y(k,46) +rxt(k,34) & - *y(k,49) +rxt(k,36)*y(k,52) +.040_r8*rxt(k,48)*y(k,98) & + +rxt(k,425)* y(k,259) +rxt(k,431)* y(k,260) +rxt(k,445)* y(k,265) & + +rxt(k,449)* y(k,266) +rxt(k,475)* y(k,272) +rxt(k,492)* y(k,276) & + +rxt(k,496)* y(k,277) +rxt(k,646)* y(k,279) +rxt(k,655)* y(k,280) & + +rxt(k,382)* y(k,282) +rxt(k,389)* y(k,284) +rxt(k,401)* y(k,287) & + +rxt(k,666)* y(k,288) +rxt(k,675)* y(k,289) +rxt(k,368)* y(k,296) & + +rxt(k,694)* y(k,299) +rxt(k,702)* y(k,300) +rxt(k,710)* y(k,301) & + +rxt(k,720)* y(k,302) +rxt(k,729)* y(k,303) +rxt(k,739)* y(k,304) & + +rxt(k,750)* y(k,305) + het_rates(k,251))* y(k,251) + prod(k,313) = (2.000_r8*rxt(k,335)*y(k,250) +.900_r8*rxt(k,336)*y(k,251) + & + .490_r8*rxt(k,337)*y(k,256) +rxt(k,338)*y(k,147) + & + rxt(k,381)*y(k,282) +1.650_r8*rxt(k,388)*y(k,284) + & + rxt(k,400)*y(k,287) +rxt(k,424)*y(k,259) +rxt(k,430)*y(k,260) + & + rxt(k,444)*y(k,265) +rxt(k,448)*y(k,266) +rxt(k,474)*y(k,272) + & + rxt(k,491)*y(k,276) +rxt(k,495)*y(k,277) +rxt(k,586)*y(k,235) + & + rxt(k,594)*y(k,236) +rxt(k,606)*y(k,238) +rxt(k,614)*y(k,239) + & + rxt(k,626)*y(k,243) +rxt(k,634)*y(k,244) +rxt(k,645)*y(k,279) + & + rxt(k,654)*y(k,280) +rxt(k,665)*y(k,288) +rxt(k,674)*y(k,289) + & + rxt(k,693)*y(k,299) +rxt(k,701)*y(k,300) +rxt(k,709)*y(k,301) + & + rxt(k,719)*y(k,302) +rxt(k,728)*y(k,303) +rxt(k,738)*y(k,304) + & + rxt(k,749)*y(k,305))*y(k,250) + (rxt(k,38) +rxt(k,219)*y(k,57) + & + rxt(k,275)*y(k,75) +rxt(k,308)*y(k,293) +rxt(k,315)*y(k,292))*y(k,55) & + + (.650_r8*rxt(k,389)*y(k,251) +.320_r8*rxt(k,390)*y(k,256) + & + 1.300_r8*rxt(k,391)*y(k,284) +.650_r8*rxt(k,392)*y(k,147) + & + .650_r8*rxt(k,393)*y(k,149))*y(k,284) + (.700_r8*rxt(k,307)*y(k,54) + & + rxt(k,339)*y(k,51) +.060_r8*rxt(k,414)*y(k,98) + & + .060_r8*rxt(k,415)*y(k,99))*y(k,293) + (.830_r8*rxt(k,556)*y(k,252) + & + .170_r8*rxt(k,562)*y(k,285))*y(k,147) + (.280_r8*rxt(k,354)*y(k,30) + & + .210_r8*rxt(k,486)*y(k,109))*y(k,157) & + + (.330_r8*rxt(k,555)*y(k,252) +.070_r8*rxt(k,561)*y(k,285)) & + *y(k,256) +rxt(k,131)*y(k,44) +rxt(k,33)*y(k,46) +rxt(k,133)*y(k,47) & + +rxt(k,34)*y(k,49) +rxt(k,36)*y(k,52) +.040_r8*rxt(k,48)*y(k,98) & +.070_r8*rxt(k,49)*y(k,99) +.650_r8*rxt(k,72)*y(k,126) & +.300_r8*rxt(k,79)*y(k,132) +.400_r8*rxt(k,86)*y(k,162) - loss(k,155) = (rxt(k,557)* y(k,147) +rxt(k,558)* y(k,148) +rxt(k,556) & + loss(k,182) = (rxt(k,556)* y(k,147) +rxt(k,557)* y(k,148) +rxt(k,555) & * y(k,256) + het_rates(k,252))* y(k,252) - prod(k,155) =.600_r8*rxt(k,24)*y(k,12) - loss(k,129) = ((rxt(k,378) +rxt(k,379))* y(k,147) + het_rates(k,253)) & + prod(k,182) =.600_r8*rxt(k,24)*y(k,12) + loss(k,150) = ((rxt(k,377) +rxt(k,378))* y(k,147) + het_rates(k,253)) & * y(k,253) - prod(k,129) =rxt(k,376)*y(k,293)*y(k,16) - loss(k,80) = ( + rxt(k,344) + rxt(k,345) + het_rates(k,254))* y(k,254) - prod(k,80) =rxt(k,42)*y(k,74) +.750_r8*rxt(k,343)*y(k,255)*y(k,147) - loss(k,151) = (rxt(k,343)* y(k,147) +rxt(k,342)* y(k,256) + het_rates(k,255)) & + prod(k,150) =rxt(k,375)*y(k,293)*y(k,16) + loss(k,99) = ( + rxt(k,343) + rxt(k,344) + het_rates(k,254))* y(k,254) + prod(k,99) =rxt(k,42)*y(k,74) +.750_r8*rxt(k,342)*y(k,255)*y(k,147) + loss(k,178) = (rxt(k,342)* y(k,147) +rxt(k,341)* y(k,256) + het_rates(k,255)) & * y(k,255) - prod(k,151) =rxt(k,351)*y(k,293)*y(k,26) - loss(k,276) = (rxt(k,255)* y(k,18) +rxt(k,261)* y(k,20) +rxt(k,298)* y(k,43) & + prod(k,178) =rxt(k,350)*y(k,293)*y(k,26) + loss(k,309) = (rxt(k,255)* y(k,18) +rxt(k,261)* y(k,20) +rxt(k,298)* y(k,43) & + (rxt(k,222) +rxt(k,223))* y(k,57) +rxt(k,229)* y(k,60) & + (rxt(k,178) +rxt(k,179) +rxt(k,180))* y(k,78) +rxt(k,207) & * y(k,147) +rxt(k,212)* y(k,148) +rxt(k,202)* y(k,149) +rxt(k,182) & - * y(k,156) +rxt(k,183)* y(k,157) +rxt(k,542)* y(k,233) +rxt(k,410) & - * y(k,234) +rxt(k,589)* y(k,235) +rxt(k,597)* y(k,236) +rxt(k,609) & - * y(k,238) +rxt(k,617)* y(k,239) +rxt(k,545)* y(k,241) +rxt(k,629) & - * y(k,243) +rxt(k,637)* y(k,244) +rxt(k,549)* y(k,246) +rxt(k,327) & - * y(k,247) +rxt(k,357)* y(k,248) +rxt(k,552)* y(k,249) +rxt(k,338) & - * y(k,250) +rxt(k,304)* y(k,251) +rxt(k,556)* y(k,252) +rxt(k,342) & - * y(k,255) + 2._r8*rxt(k,192)* y(k,256) +rxt(k,313)* y(k,257) & - +rxt(k,422)* y(k,258) +rxt(k,427)* y(k,259) +rxt(k,433)* y(k,260) & - +rxt(k,447)* y(k,265) +rxt(k,451)* y(k,266) +rxt(k,458)* y(k,267) & - +rxt(k,462)* y(k,268) +rxt(k,465)* y(k,269) +rxt(k,468)* y(k,270) & - +rxt(k,472)* y(k,271) +rxt(k,477)* y(k,272) +rxt(k,480)* y(k,273) & - +rxt(k,483)* y(k,274) +rxt(k,494)* y(k,276) +rxt(k,498)* y(k,277) & - +rxt(k,648)* y(k,279) +rxt(k,657)* y(k,280) +rxt(k,384)* y(k,282) & - +rxt(k,559)* y(k,283) +rxt(k,391)* y(k,284) +rxt(k,562)* y(k,285) & - +rxt(k,395)* y(k,286) +rxt(k,403)* y(k,287) +rxt(k,668)* y(k,288) & - +rxt(k,677)* y(k,289) +rxt(k,500)* y(k,291) +rxt(k,187)* y(k,293) & - +rxt(k,565)* y(k,294) +rxt(k,366)* y(k,295) +rxt(k,370)* y(k,296) & - +rxt(k,688)* y(k,297) +rxt(k,692)* y(k,298) +rxt(k,696)* y(k,299) & - +rxt(k,704)* y(k,300) +rxt(k,712)* y(k,301) +rxt(k,722)* y(k,302) & - +rxt(k,731)* y(k,303) +rxt(k,741)* y(k,304) +rxt(k,752)* y(k,305) & - +rxt(k,761)* y(k,306) +rxt(k,766)* y(k,307) +rxt(k,773)* y(k,308) & - +rxt(k,777)* y(k,309) +rxt(k,781)* y(k,310) +rxt(k,785)* y(k,311) & - +rxt(k,572)* y(k,312) +rxt(k,578)* y(k,314) +rxt(k,581)* y(k,316) & - + rxt(k,813) + het_rates(k,256))* y(k,256) - prod(k,276) = (rxt(k,305)*y(k,251) +rxt(k,315)*y(k,257) + & - rxt(k,328)*y(k,247) +.250_r8*rxt(k,343)*y(k,255) + & - rxt(k,358)*y(k,248) +rxt(k,367)*y(k,295) +rxt(k,378)*y(k,253) + & - rxt(k,411)*y(k,234) +rxt(k,504)*y(k,258) +rxt(k,506)*y(k,259) + & - rxt(k,508)*y(k,260) +.450_r8*rxt(k,510)*y(k,265) + & - .450_r8*rxt(k,512)*y(k,266) +rxt(k,514)*y(k,267) + & - .270_r8*rxt(k,516)*y(k,268) +rxt(k,518)*y(k,269) + & - rxt(k,520)*y(k,270) +rxt(k,522)*y(k,271) + & - .540_r8*rxt(k,524)*y(k,272) +.530_r8*rxt(k,526)*y(k,273) + & - .960_r8*rxt(k,528)*y(k,274) +.450_r8*rxt(k,531)*y(k,276) + & - .450_r8*rxt(k,534)*y(k,277) +rxt(k,536)*y(k,282) + & - .240_r8*rxt(k,538)*y(k,287) +rxt(k,540)*y(k,291) + & - rxt(k,546)*y(k,241) +rxt(k,551)*y(k,246) + & - .170_r8*rxt(k,557)*y(k,252) +.400_r8*rxt(k,560)*y(k,283) + & - .830_r8*rxt(k,563)*y(k,285) +rxt(k,566)*y(k,294) + & - rxt(k,573)*y(k,312) +rxt(k,579)*y(k,314) +rxt(k,582)*y(k,316) + & - .770_r8*rxt(k,598)*y(k,236) +.700_r8*rxt(k,618)*y(k,239) + & - .470_r8*rxt(k,630)*y(k,243) +.750_r8*rxt(k,638)*y(k,244) + & - .500_r8*rxt(k,650)*y(k,279) +.770_r8*rxt(k,658)*y(k,280) + & - .040_r8*rxt(k,670)*y(k,288) +.710_r8*rxt(k,678)*y(k,289) + & - .700_r8*rxt(k,689)*y(k,297) +.700_r8*rxt(k,693)*y(k,298) + & - .910_r8*rxt(k,742)*y(k,304) +.700_r8*rxt(k,762)*y(k,306) + & - .700_r8*rxt(k,767)*y(k,307) +.700_r8*rxt(k,774)*y(k,308) + & - .700_r8*rxt(k,778)*y(k,309) +.700_r8*rxt(k,782)*y(k,310) + & - .700_r8*rxt(k,786)*y(k,311))*y(k,147) + (rxt(k,284)*y(k,44) + & - rxt(k,287)*y(k,47) +rxt(k,186)*y(k,81) +rxt(k,189)*y(k,157) + & - rxt(k,205)*y(k,149) +rxt(k,236)*y(k,60) +rxt(k,266)*y(k,20) + & - rxt(k,306)*y(k,53) +rxt(k,309)*y(k,63) +rxt(k,310)*y(k,88) + & - rxt(k,311)*y(k,90) +.500_r8*rxt(k,312)*y(k,92) + & - .350_r8*rxt(k,322)*y(k,25) +rxt(k,329)*y(k,27) +rxt(k,335)*y(k,48) + & - rxt(k,346)*y(k,76) +rxt(k,347)*y(k,77) +.110_r8*rxt(k,348)*y(k,89) + & - rxt(k,363)*y(k,102) +rxt(k,380)*y(k,97) + & - .500_r8*rxt(k,381)*y(k,127) +rxt(k,400)*y(k,133) + & - .440_r8*rxt(k,406)*y(k,134) +.510_r8*rxt(k,415)*y(k,98) + & - .410_r8*rxt(k,416)*y(k,99) +.320_r8*rxt(k,419)*y(k,103) + & - .190_r8*rxt(k,421)*y(k,106) +.400_r8*rxt(k,424)*y(k,108) + & - rxt(k,454)*y(k,110) +rxt(k,456)*y(k,113) + & - .040_r8*rxt(k,461)*y(k,115) +.030_r8*rxt(k,471)*y(k,118) + & - .050_r8*rxt(k,473)*y(k,119) +rxt(k,489)*y(k,122) + & - .180_r8*rxt(k,490)*y(k,123) +.630_r8*rxt(k,503)*y(k,139) + & - .650_r8*rxt(k,544)*y(k,8) +.730_r8*rxt(k,555)*y(k,67) + & - .800_r8*rxt(k,567)*y(k,165) +.280_r8*rxt(k,575)*y(k,226) + & - .380_r8*rxt(k,577)*y(k,227) +.630_r8*rxt(k,583)*y(k,229) + & - rxt(k,719)*y(k,202) +rxt(k,738)*y(k,204) + & - .500_r8*rxt(k,808)*y(k,69) +rxt(k,809)*y(k,174))*y(k,293) & - + (rxt(k,225)*y(k,60) +2.000_r8*rxt(k,302)*y(k,251) + & - rxt(k,326)*y(k,247) +.900_r8*rxt(k,337)*y(k,250) + & - rxt(k,356)*y(k,248) +.300_r8*rxt(k,369)*y(k,296) + & - 1.500_r8*rxt(k,383)*y(k,282) +rxt(k,390)*y(k,284) + & - .620_r8*rxt(k,402)*y(k,287) +1.500_r8*rxt(k,426)*y(k,259) + & - rxt(k,432)*y(k,260) +.720_r8*rxt(k,446)*y(k,265) + & - .720_r8*rxt(k,450)*y(k,266) +.400_r8*rxt(k,476)*y(k,272) + & - .720_r8*rxt(k,493)*y(k,276) +.720_r8*rxt(k,497)*y(k,277) + & - .820_r8*rxt(k,588)*y(k,235) +1.160_r8*rxt(k,596)*y(k,236) + & - .820_r8*rxt(k,608)*y(k,238) +rxt(k,616)*y(k,239) + & - 1.100_r8*rxt(k,628)*y(k,243) +1.500_r8*rxt(k,636)*y(k,244) + & - 1.010_r8*rxt(k,647)*y(k,279) +rxt(k,656)*y(k,280) + & - .870_r8*rxt(k,667)*y(k,288) +rxt(k,676)*y(k,289) + & - .500_r8*rxt(k,695)*y(k,299) +rxt(k,703)*y(k,300) + & - rxt(k,711)*y(k,301) +rxt(k,721)*y(k,302) +rxt(k,730)*y(k,303) + & - 2.000_r8*rxt(k,740)*y(k,304) +rxt(k,751)*y(k,305))*y(k,251) & - + (.200_r8*rxt(k,313)*y(k,257) +.590_r8*rxt(k,384)*y(k,282) + & - .180_r8*rxt(k,403)*y(k,287) +.650_r8*rxt(k,422)*y(k,258) + & - .060_r8*rxt(k,427)*y(k,259) +.060_r8*rxt(k,433)*y(k,260) + & - .580_r8*rxt(k,458)*y(k,267) +.060_r8*rxt(k,462)*y(k,268) + & - .600_r8*rxt(k,465)*y(k,269) +.500_r8*rxt(k,468)*y(k,270) + & - .400_r8*rxt(k,472)*y(k,271) +.170_r8*rxt(k,480)*y(k,273) + & - .800_r8*rxt(k,483)*y(k,274) +.800_r8*rxt(k,500)*y(k,291) + & - .070_r8*rxt(k,556)*y(k,252) +.160_r8*rxt(k,559)*y(k,283) + & - .330_r8*rxt(k,562)*y(k,285) +.480_r8*rxt(k,597)*y(k,236) + & - .100_r8*rxt(k,617)*y(k,239) +.030_r8*rxt(k,637)*y(k,244) + & - .270_r8*rxt(k,648)*y(k,279) +.100_r8*rxt(k,657)*y(k,280) + & - .100_r8*rxt(k,677)*y(k,289) +.180_r8*rxt(k,688)*y(k,297) + & - .180_r8*rxt(k,692)*y(k,298) +.530_r8*rxt(k,741)*y(k,304) + & - .100_r8*rxt(k,761)*y(k,306) +.100_r8*rxt(k,766)*y(k,307) + & - .100_r8*rxt(k,773)*y(k,308) +.100_r8*rxt(k,777)*y(k,309) + & - .100_r8*rxt(k,781)*y(k,310) +.100_r8*rxt(k,785)*y(k,311))*y(k,256) & - + (rxt(k,382)*y(k,282) +.250_r8*rxt(k,401)*y(k,287) + & - rxt(k,425)*y(k,259) +rxt(k,431)*y(k,260) + & - .450_r8*rxt(k,445)*y(k,265) +.450_r8*rxt(k,449)*y(k,266) + & - .540_r8*rxt(k,475)*y(k,272) +.450_r8*rxt(k,492)*y(k,276) + & - .450_r8*rxt(k,496)*y(k,277) +rxt(k,595)*y(k,236) + & - rxt(k,615)*y(k,239) +.500_r8*rxt(k,627)*y(k,243) + & - rxt(k,635)*y(k,244) +.540_r8*rxt(k,646)*y(k,279) + & - rxt(k,655)*y(k,280) +.050_r8*rxt(k,666)*y(k,288) + & - rxt(k,675)*y(k,289) +rxt(k,739)*y(k,304))*y(k,250) & - + (rxt(k,299)*y(k,43) +.540_r8*rxt(k,479)*y(k,272) + & - rxt(k,599)*y(k,236) +rxt(k,619)*y(k,239) + & + * y(k,156) +rxt(k,183)* y(k,157) +rxt(k,541)* y(k,233) +rxt(k,409) & + * y(k,234) +rxt(k,588)* y(k,235) +rxt(k,596)* y(k,236) +rxt(k,608) & + * y(k,238) +rxt(k,616)* y(k,239) +rxt(k,544)* y(k,241) +rxt(k,628) & + * y(k,243) +rxt(k,636)* y(k,244) +rxt(k,548)* y(k,246) +rxt(k,326) & + * y(k,247) +rxt(k,356)* y(k,248) +rxt(k,551)* y(k,249) +rxt(k,337) & + * y(k,250) +rxt(k,304)* y(k,251) +rxt(k,555)* y(k,252) +rxt(k,341) & + * y(k,255) + 2._r8*rxt(k,192)* y(k,256) +rxt(k,312)* y(k,257) & + +rxt(k,421)* y(k,258) +rxt(k,426)* y(k,259) +rxt(k,432)* y(k,260) & + +rxt(k,446)* y(k,265) +rxt(k,450)* y(k,266) +rxt(k,457)* y(k,267) & + +rxt(k,461)* y(k,268) +rxt(k,464)* y(k,269) +rxt(k,467)* y(k,270) & + +rxt(k,471)* y(k,271) +rxt(k,476)* y(k,272) +rxt(k,479)* y(k,273) & + +rxt(k,482)* y(k,274) +rxt(k,493)* y(k,276) +rxt(k,497)* y(k,277) & + +rxt(k,647)* y(k,279) +rxt(k,656)* y(k,280) +rxt(k,383)* y(k,282) & + +rxt(k,558)* y(k,283) +rxt(k,390)* y(k,284) +rxt(k,561)* y(k,285) & + +rxt(k,394)* y(k,286) +rxt(k,402)* y(k,287) +rxt(k,667)* y(k,288) & + +rxt(k,676)* y(k,289) +rxt(k,499)* y(k,291) +rxt(k,187)* y(k,293) & + +rxt(k,564)* y(k,294) +rxt(k,365)* y(k,295) +rxt(k,369)* y(k,296) & + +rxt(k,687)* y(k,297) +rxt(k,691)* y(k,298) +rxt(k,695)* y(k,299) & + +rxt(k,703)* y(k,300) +rxt(k,711)* y(k,301) +rxt(k,721)* y(k,302) & + +rxt(k,730)* y(k,303) +rxt(k,740)* y(k,304) +rxt(k,751)* y(k,305) & + +rxt(k,760)* y(k,306) +rxt(k,765)* y(k,307) +rxt(k,772)* y(k,308) & + +rxt(k,776)* y(k,309) +rxt(k,780)* y(k,310) +rxt(k,784)* y(k,311) & + +rxt(k,571)* y(k,312) +rxt(k,577)* y(k,314) +rxt(k,580)* y(k,316) & + + rxt(k,812) + het_rates(k,256))* y(k,256) + prod(k,309) = (rxt(k,305)*y(k,251) +rxt(k,314)*y(k,257) + & + rxt(k,327)*y(k,247) +.250_r8*rxt(k,342)*y(k,255) + & + rxt(k,357)*y(k,248) +rxt(k,366)*y(k,295) +rxt(k,377)*y(k,253) + & + rxt(k,410)*y(k,234) +rxt(k,503)*y(k,258) +rxt(k,505)*y(k,259) + & + rxt(k,507)*y(k,260) +.450_r8*rxt(k,509)*y(k,265) + & + .450_r8*rxt(k,511)*y(k,266) +rxt(k,513)*y(k,267) + & + .270_r8*rxt(k,515)*y(k,268) +rxt(k,517)*y(k,269) + & + rxt(k,519)*y(k,270) +rxt(k,521)*y(k,271) + & + .540_r8*rxt(k,523)*y(k,272) +.530_r8*rxt(k,525)*y(k,273) + & + .960_r8*rxt(k,527)*y(k,274) +.450_r8*rxt(k,530)*y(k,276) + & + .450_r8*rxt(k,533)*y(k,277) +rxt(k,535)*y(k,282) + & + .240_r8*rxt(k,537)*y(k,287) +rxt(k,539)*y(k,291) + & + rxt(k,545)*y(k,241) +rxt(k,550)*y(k,246) + & + .170_r8*rxt(k,556)*y(k,252) +.400_r8*rxt(k,559)*y(k,283) + & + .830_r8*rxt(k,562)*y(k,285) +rxt(k,565)*y(k,294) + & + rxt(k,572)*y(k,312) +rxt(k,578)*y(k,314) +rxt(k,581)*y(k,316) + & + .770_r8*rxt(k,597)*y(k,236) +.700_r8*rxt(k,617)*y(k,239) + & + .470_r8*rxt(k,629)*y(k,243) +.750_r8*rxt(k,637)*y(k,244) + & + .500_r8*rxt(k,649)*y(k,279) +.770_r8*rxt(k,657)*y(k,280) + & + .040_r8*rxt(k,669)*y(k,288) +.710_r8*rxt(k,677)*y(k,289) + & + .700_r8*rxt(k,688)*y(k,297) +.700_r8*rxt(k,692)*y(k,298) + & + .910_r8*rxt(k,741)*y(k,304) +.700_r8*rxt(k,761)*y(k,306) + & + .700_r8*rxt(k,766)*y(k,307) +.700_r8*rxt(k,773)*y(k,308) + & + .700_r8*rxt(k,777)*y(k,309) +.700_r8*rxt(k,781)*y(k,310) + & + .700_r8*rxt(k,785)*y(k,311))*y(k,147) + (rxt(k,186)*y(k,81) + & + rxt(k,189)*y(k,157) +rxt(k,205)*y(k,149) +rxt(k,236)*y(k,60) + & + rxt(k,266)*y(k,20) +rxt(k,284)*y(k,44) +rxt(k,287)*y(k,47) + & + rxt(k,306)*y(k,53) +rxt(k,309)*y(k,88) +rxt(k,310)*y(k,90) + & + .500_r8*rxt(k,311)*y(k,92) +rxt(k,319)*y(k,63) + & + .350_r8*rxt(k,321)*y(k,25) +rxt(k,328)*y(k,27) +rxt(k,334)*y(k,48) + & + rxt(k,345)*y(k,76) +rxt(k,346)*y(k,77) +.110_r8*rxt(k,347)*y(k,89) + & + rxt(k,362)*y(k,102) +rxt(k,379)*y(k,97) + & + .500_r8*rxt(k,380)*y(k,127) +rxt(k,399)*y(k,133) + & + .440_r8*rxt(k,405)*y(k,134) +.510_r8*rxt(k,414)*y(k,98) + & + .410_r8*rxt(k,415)*y(k,99) +.320_r8*rxt(k,418)*y(k,103) + & + .190_r8*rxt(k,420)*y(k,106) +.400_r8*rxt(k,423)*y(k,108) + & + rxt(k,453)*y(k,110) +rxt(k,455)*y(k,113) + & + .040_r8*rxt(k,460)*y(k,115) +.030_r8*rxt(k,470)*y(k,118) + & + .050_r8*rxt(k,472)*y(k,119) +rxt(k,488)*y(k,122) + & + .180_r8*rxt(k,489)*y(k,123) +.630_r8*rxt(k,502)*y(k,139) + & + .650_r8*rxt(k,543)*y(k,8) +.730_r8*rxt(k,554)*y(k,67) + & + .800_r8*rxt(k,566)*y(k,165) +.280_r8*rxt(k,574)*y(k,226) + & + .380_r8*rxt(k,576)*y(k,227) +.630_r8*rxt(k,582)*y(k,229) + & + rxt(k,718)*y(k,202) +rxt(k,737)*y(k,204) +rxt(k,798)*y(k,174) + & + .500_r8*rxt(k,808)*y(k,69))*y(k,293) + (rxt(k,225)*y(k,60) + & + 2.000_r8*rxt(k,302)*y(k,251) +rxt(k,325)*y(k,247) + & + .900_r8*rxt(k,336)*y(k,250) +rxt(k,355)*y(k,248) + & + .300_r8*rxt(k,368)*y(k,296) +1.500_r8*rxt(k,382)*y(k,282) + & + rxt(k,389)*y(k,284) +.620_r8*rxt(k,401)*y(k,287) + & + 1.500_r8*rxt(k,425)*y(k,259) +rxt(k,431)*y(k,260) + & + .720_r8*rxt(k,445)*y(k,265) +.720_r8*rxt(k,449)*y(k,266) + & + .400_r8*rxt(k,475)*y(k,272) +.720_r8*rxt(k,492)*y(k,276) + & + .720_r8*rxt(k,496)*y(k,277) +.820_r8*rxt(k,587)*y(k,235) + & + 1.160_r8*rxt(k,595)*y(k,236) +.820_r8*rxt(k,607)*y(k,238) + & + rxt(k,615)*y(k,239) +1.100_r8*rxt(k,627)*y(k,243) + & + 1.500_r8*rxt(k,635)*y(k,244) +1.010_r8*rxt(k,646)*y(k,279) + & + rxt(k,655)*y(k,280) +.870_r8*rxt(k,666)*y(k,288) + & + rxt(k,675)*y(k,289) +.500_r8*rxt(k,694)*y(k,299) + & + rxt(k,702)*y(k,300) +rxt(k,710)*y(k,301) +rxt(k,720)*y(k,302) + & + rxt(k,729)*y(k,303) +2.000_r8*rxt(k,739)*y(k,304) + & + rxt(k,750)*y(k,305))*y(k,251) + (.200_r8*rxt(k,312)*y(k,257) + & + .590_r8*rxt(k,383)*y(k,282) +.180_r8*rxt(k,402)*y(k,287) + & + .650_r8*rxt(k,421)*y(k,258) +.060_r8*rxt(k,426)*y(k,259) + & + .060_r8*rxt(k,432)*y(k,260) +.580_r8*rxt(k,457)*y(k,267) + & + .060_r8*rxt(k,461)*y(k,268) +.600_r8*rxt(k,464)*y(k,269) + & + .500_r8*rxt(k,467)*y(k,270) +.400_r8*rxt(k,471)*y(k,271) + & + .170_r8*rxt(k,479)*y(k,273) +.800_r8*rxt(k,482)*y(k,274) + & + .800_r8*rxt(k,499)*y(k,291) +.070_r8*rxt(k,555)*y(k,252) + & + .160_r8*rxt(k,558)*y(k,283) +.330_r8*rxt(k,561)*y(k,285) + & + .480_r8*rxt(k,596)*y(k,236) +.100_r8*rxt(k,616)*y(k,239) + & + .030_r8*rxt(k,636)*y(k,244) +.270_r8*rxt(k,647)*y(k,279) + & + .100_r8*rxt(k,656)*y(k,280) +.100_r8*rxt(k,676)*y(k,289) + & + .180_r8*rxt(k,687)*y(k,297) +.180_r8*rxt(k,691)*y(k,298) + & + .530_r8*rxt(k,740)*y(k,304) +.100_r8*rxt(k,760)*y(k,306) + & + .100_r8*rxt(k,765)*y(k,307) +.100_r8*rxt(k,772)*y(k,308) + & + .100_r8*rxt(k,776)*y(k,309) +.100_r8*rxt(k,780)*y(k,310) + & + .100_r8*rxt(k,784)*y(k,311))*y(k,256) + (rxt(k,381)*y(k,282) + & + .250_r8*rxt(k,400)*y(k,287) +rxt(k,424)*y(k,259) + & + rxt(k,430)*y(k,260) +.450_r8*rxt(k,444)*y(k,265) + & + .450_r8*rxt(k,448)*y(k,266) +.540_r8*rxt(k,474)*y(k,272) + & + .450_r8*rxt(k,491)*y(k,276) +.450_r8*rxt(k,495)*y(k,277) + & + rxt(k,594)*y(k,236) +rxt(k,614)*y(k,239) + & + .500_r8*rxt(k,626)*y(k,243) +rxt(k,634)*y(k,244) + & + .540_r8*rxt(k,645)*y(k,279) +rxt(k,654)*y(k,280) + & + .050_r8*rxt(k,665)*y(k,288) +rxt(k,674)*y(k,289) + & + rxt(k,738)*y(k,304))*y(k,250) + (rxt(k,299)*y(k,43) + & + .540_r8*rxt(k,478)*y(k,272) +rxt(k,598)*y(k,236) + & + rxt(k,618)*y(k,239) +.500_r8*rxt(k,630)*y(k,243) + & + rxt(k,638)*y(k,244) +.540_r8*rxt(k,650)*y(k,279) + & + rxt(k,658)*y(k,280) +.050_r8*rxt(k,670)*y(k,288) + & + rxt(k,678)*y(k,289) +rxt(k,742)*y(k,304) + & + .500_r8*rxt(k,764)*y(k,211))*y(k,149) + (.130_r8*rxt(k,323)*y(k,26) + & + .280_r8*rxt(k,354)*y(k,30) +.140_r8*rxt(k,385)*y(k,126) + & + .280_r8*rxt(k,403)*y(k,132) +.170_r8*rxt(k,459)*y(k,115) + & + .170_r8*rxt(k,469)*y(k,118) +.420_r8*rxt(k,486)*y(k,109) + & + .130_r8*rxt(k,501)*y(k,139) +.170_r8*rxt(k,602)*y(k,4) + & + .080_r8*rxt(k,622)*y(k,7) +.630_r8*rxt(k,682)*y(k,135))*y(k,157) & + + (rxt(k,599)*y(k,236) +rxt(k,619)*y(k,239) + & .500_r8*rxt(k,631)*y(k,243) +rxt(k,639)*y(k,244) + & .540_r8*rxt(k,651)*y(k,279) +rxt(k,659)*y(k,280) + & .050_r8*rxt(k,671)*y(k,288) +rxt(k,679)*y(k,289) + & - rxt(k,743)*y(k,304) +.500_r8*rxt(k,765)*y(k,211))*y(k,149) & - + (.130_r8*rxt(k,324)*y(k,26) +.280_r8*rxt(k,355)*y(k,30) + & - .140_r8*rxt(k,386)*y(k,126) +.280_r8*rxt(k,404)*y(k,132) + & - .170_r8*rxt(k,460)*y(k,115) +.170_r8*rxt(k,470)*y(k,118) + & - .420_r8*rxt(k,487)*y(k,109) +.130_r8*rxt(k,502)*y(k,139) + & - .170_r8*rxt(k,603)*y(k,4) +.080_r8*rxt(k,623)*y(k,7) + & - .630_r8*rxt(k,683)*y(k,135))*y(k,157) + (rxt(k,600)*y(k,236) + & + rxt(k,743)*y(k,304))*y(k,300) + (rxt(k,600)*y(k,236) + & rxt(k,620)*y(k,239) +.500_r8*rxt(k,632)*y(k,243) + & rxt(k,640)*y(k,244) +.540_r8*rxt(k,652)*y(k,279) + & rxt(k,660)*y(k,280) +.050_r8*rxt(k,672)*y(k,288) + & - rxt(k,680)*y(k,289) +rxt(k,744)*y(k,304))*y(k,300) & + rxt(k,680)*y(k,289) +rxt(k,744)*y(k,304))*y(k,302) & + (rxt(k,601)*y(k,236) +rxt(k,621)*y(k,239) + & .500_r8*rxt(k,633)*y(k,243) +rxt(k,641)*y(k,244) + & .540_r8*rxt(k,653)*y(k,279) +rxt(k,661)*y(k,280) + & .050_r8*rxt(k,673)*y(k,288) +rxt(k,681)*y(k,289) + & - rxt(k,745)*y(k,304))*y(k,302) + (rxt(k,602)*y(k,236) + & - rxt(k,622)*y(k,239) +.500_r8*rxt(k,634)*y(k,243) + & - rxt(k,642)*y(k,244) +.540_r8*rxt(k,654)*y(k,279) + & - rxt(k,662)*y(k,280) +.050_r8*rxt(k,674)*y(k,288) + & - rxt(k,682)*y(k,289) +rxt(k,746)*y(k,304))*y(k,305) & - + (rxt(k,283)*y(k,44) +rxt(k,286)*y(k,47) +rxt(k,218)*y(k,43) + & - rxt(k,221)*y(k,81))*y(k,57) + (rxt(k,254)*y(k,18) + & - rxt(k,300)*y(k,156))*y(k,43) + (rxt(k,11) +rxt(k,216))*y(k,94) & - + (1.500_r8*rxt(k,53) +rxt(k,54))*y(k,103) + (rxt(k,72) +rxt(k,73)) & - *y(k,126) + (rxt(k,344) +rxt(k,345))*y(k,254) +rxt(k,19)*y(k,1) & - +.900_r8*rxt(k,20)*y(k,2) +rxt(k,21)*y(k,9) +1.500_r8*rxt(k,22) & - *y(k,10) +rxt(k,23)*y(k,11) +.600_r8*rxt(k,24)*y(k,12) & - +.600_r8*rxt(k,25)*y(k,13) +rxt(k,26)*y(k,14) +rxt(k,27)*y(k,24) & - +rxt(k,28)*y(k,28) +rxt(k,29)*y(k,31) +rxt(k,33)*y(k,46) +rxt(k,35) & - *y(k,50) +rxt(k,317)*y(k,292)*y(k,55) +.500_r8*rxt(k,41)*y(k,68) & - +2.000_r8*rxt(k,43)*y(k,76) +2.000_r8*rxt(k,44)*y(k,77) +rxt(k,181) & - *y(k,78) +rxt(k,177)*y(k,156)*y(k,81) +rxt(k,45)*y(k,89) & - +.670_r8*rxt(k,47)*y(k,97) +.620_r8*rxt(k,48)*y(k,98) & - +.560_r8*rxt(k,49)*y(k,99) +rxt(k,50)*y(k,100) +rxt(k,51)*y(k,101) & - +rxt(k,52)*y(k,102) +rxt(k,57)*y(k,107) +rxt(k,58)*y(k,108) & - +rxt(k,63)*y(k,114) +.450_r8*rxt(k,64)*y(k,115) +rxt(k,65)*y(k,116) & - +rxt(k,66)*y(k,117) +.450_r8*rxt(k,67)*y(k,118) +rxt(k,68)*y(k,119) & - +rxt(k,70)*y(k,121) +rxt(k,71)*y(k,123) +1.250_r8*rxt(k,74)*y(k,127) & - +rxt(k,75)*y(k,128) +.500_r8*rxt(k,80)*y(k,133) +.440_r8*rxt(k,81) & - *y(k,134) +rxt(k,82)*y(k,139) +rxt(k,83)*y(k,150) +rxt(k,87)*y(k,166) & - +rxt(k,88)*y(k,169) +rxt(k,90)*y(k,197) +rxt(k,91)*y(k,198) & - +rxt(k,92)*y(k,199) +rxt(k,93)*y(k,200) +rxt(k,94)*y(k,201) & - +rxt(k,96)*y(k,203) +rxt(k,102)*y(k,209) +rxt(k,103)*y(k,212) & - +rxt(k,104)*y(k,213) +.500_r8*rxt(k,105)*y(k,215) & - +.540_r8*rxt(k,106)*y(k,216) +.540_r8*rxt(k,108)*y(k,218) & + rxt(k,745)*y(k,304))*y(k,305) + (rxt(k,218)*y(k,43) + & + rxt(k,221)*y(k,81) +rxt(k,283)*y(k,44) +rxt(k,286)*y(k,47))*y(k,57) & + + (rxt(k,254)*y(k,18) +rxt(k,300)*y(k,156))*y(k,43) + (rxt(k,11) + & + rxt(k,216))*y(k,94) + (1.500_r8*rxt(k,53) +rxt(k,54))*y(k,103) & + + (rxt(k,72) +rxt(k,73))*y(k,126) + (rxt(k,343) +rxt(k,344)) & + *y(k,254) +rxt(k,19)*y(k,1) +.900_r8*rxt(k,20)*y(k,2) +rxt(k,21) & + *y(k,9) +1.500_r8*rxt(k,22)*y(k,10) +rxt(k,23)*y(k,11) & + +.600_r8*rxt(k,24)*y(k,12) +.600_r8*rxt(k,25)*y(k,13) +rxt(k,26) & + *y(k,14) +rxt(k,27)*y(k,24) +rxt(k,28)*y(k,28) +rxt(k,29)*y(k,31) & + +rxt(k,33)*y(k,46) +rxt(k,35)*y(k,50) +rxt(k,316)*y(k,292)*y(k,55) & + +.500_r8*rxt(k,41)*y(k,68) +2.000_r8*rxt(k,43)*y(k,76) & + +2.000_r8*rxt(k,44)*y(k,77) +rxt(k,181)*y(k,78) +rxt(k,177)*y(k,156) & + *y(k,81) +rxt(k,45)*y(k,89) +.670_r8*rxt(k,47)*y(k,97) & + +.620_r8*rxt(k,48)*y(k,98) +.560_r8*rxt(k,49)*y(k,99) +rxt(k,50) & + *y(k,100) +rxt(k,51)*y(k,101) +rxt(k,52)*y(k,102) +rxt(k,57)*y(k,107) & + +rxt(k,58)*y(k,108) +rxt(k,63)*y(k,114) +.450_r8*rxt(k,64)*y(k,115) & + +rxt(k,65)*y(k,116) +rxt(k,66)*y(k,117) +.450_r8*rxt(k,67)*y(k,118) & + +rxt(k,68)*y(k,119) +rxt(k,70)*y(k,121) +rxt(k,71)*y(k,123) & + +1.250_r8*rxt(k,74)*y(k,127) +rxt(k,75)*y(k,128) +.500_r8*rxt(k,80) & + *y(k,133) +.440_r8*rxt(k,81)*y(k,134) +rxt(k,82)*y(k,139) +rxt(k,83) & + *y(k,150) +rxt(k,87)*y(k,166) +rxt(k,88)*y(k,169) +rxt(k,90)*y(k,197) & + +rxt(k,91)*y(k,198) +rxt(k,92)*y(k,199) +rxt(k,93)*y(k,200) & + +rxt(k,94)*y(k,201) +rxt(k,96)*y(k,203) +rxt(k,102)*y(k,209) & + +rxt(k,103)*y(k,212) +rxt(k,104)*y(k,213) +.500_r8*rxt(k,105) & + *y(k,215) +.540_r8*rxt(k,106)*y(k,216) +.540_r8*rxt(k,108)*y(k,218) & +rxt(k,109)*y(k,219) +rxt(k,110)*y(k,220) +rxt(k,111)*y(k,221) & +rxt(k,112)*y(k,222) +rxt(k,113)*y(k,223) +rxt(k,114)*y(k,224) & +rxt(k,115)*y(k,225) +rxt(k,116)*y(k,228) +rxt(k,117)*y(k,230) & - +.940_r8*rxt(k,626)*y(k,243)*y(k,243) +1.200_r8*rxt(k,325)*y(k,247) & - *y(k,247) +rxt(k,314)*y(k,257) +rxt(k,459)*y(k,267) +rxt(k,463) & - *y(k,268) +rxt(k,466)*y(k,269) +rxt(k,469)*y(k,270) & - +.400_r8*rxt(k,478)*y(k,272)*y(k,272) +.400_r8*rxt(k,530)*y(k,276) & - +.400_r8*rxt(k,533)*y(k,277) +.990_r8*rxt(k,649)*y(k,279)*y(k,279) - loss(k,136) = (rxt(k,315)* y(k,147) +rxt(k,313)* y(k,256) + rxt(k,314) & + +.940_r8*rxt(k,625)*y(k,243)*y(k,243) +1.200_r8*rxt(k,324)*y(k,247) & + *y(k,247) +rxt(k,313)*y(k,257) +rxt(k,458)*y(k,267) +rxt(k,462) & + *y(k,268) +rxt(k,465)*y(k,269) +rxt(k,468)*y(k,270) & + +.400_r8*rxt(k,477)*y(k,272)*y(k,272) +.400_r8*rxt(k,529)*y(k,276) & + +.400_r8*rxt(k,532)*y(k,277) +.990_r8*rxt(k,648)*y(k,279)*y(k,279) + loss(k,160) = (rxt(k,314)* y(k,147) +rxt(k,312)* y(k,256) + rxt(k,313) & + het_rates(k,257))* y(k,257) - prod(k,136) =rxt(k,298)*y(k,256)*y(k,43) - loss(k,214) = ((rxt(k,504) +rxt(k,505))* y(k,147) +rxt(k,422)* y(k,256) & + prod(k,160) =rxt(k,298)*y(k,256)*y(k,43) + loss(k,219) = ((rxt(k,503) +rxt(k,504))* y(k,147) +rxt(k,421)* y(k,256) & + het_rates(k,258))* y(k,258) - prod(k,214) = (.320_r8*rxt(k,419)*y(k,103) +.810_r8*rxt(k,421)*y(k,106)) & + prod(k,219) = (.320_r8*rxt(k,418)*y(k,103) +.810_r8*rxt(k,420)*y(k,106)) & *y(k,293) - loss(k,239) = ((rxt(k,506) +rxt(k,507))* y(k,147) +rxt(k,425)* y(k,250) & - +rxt(k,426)* y(k,251) +rxt(k,427)* y(k,256) + rxt(k,428) & - + rxt(k,429) + rxt(k,430) + het_rates(k,259))* y(k,259) - prod(k,239) =.530_r8*rxt(k,490)*y(k,293)*y(k,123) +rxt(k,437)*y(k,261) & - +rxt(k,439)*y(k,262) - loss(k,235) = ((rxt(k,508) +rxt(k,509))* y(k,147) +rxt(k,431)* y(k,250) & - +rxt(k,432)* y(k,251) +rxt(k,433)* y(k,256) + rxt(k,434) & - + rxt(k,435) + rxt(k,436) + het_rates(k,260))* y(k,260) - prod(k,235) =.160_r8*rxt(k,490)*y(k,293)*y(k,123) +rxt(k,441)*y(k,263) & - +rxt(k,443)*y(k,264) - loss(k,71) = ( + rxt(k,437) + rxt(k,438) + het_rates(k,261))* y(k,261) - prod(k,71) =.315_r8*rxt(k,488)*y(k,293)*y(k,109) +rxt(k,429)*y(k,259) & - +rxt(k,495)*y(k,276) - loss(k,72) = ( + rxt(k,439) + rxt(k,440) + het_rates(k,262))* y(k,262) - prod(k,72) =.315_r8*rxt(k,488)*y(k,293)*y(k,109) +rxt(k,430)*y(k,259) & - +rxt(k,448)*y(k,265) - loss(k,73) = ( + rxt(k,441) + rxt(k,442) + het_rates(k,263))* y(k,263) - prod(k,73) =.259_r8*rxt(k,488)*y(k,293)*y(k,109) +rxt(k,435)*y(k,260) & - +rxt(k,499)*y(k,277) - loss(k,74) = ( + rxt(k,443) + rxt(k,444) + het_rates(k,264))* y(k,264) - prod(k,74) =.111_r8*rxt(k,488)*y(k,293)*y(k,109) +rxt(k,436)*y(k,260) & - +rxt(k,452)*y(k,266) - loss(k,224) = ((rxt(k,510) +rxt(k,511))* y(k,147) +rxt(k,445)* y(k,250) & - +rxt(k,446)* y(k,251) +rxt(k,447)* y(k,256) + rxt(k,448) & + loss(k,266) = ((rxt(k,505) +rxt(k,506))* y(k,147) +rxt(k,424)* y(k,250) & + +rxt(k,425)* y(k,251) +rxt(k,426)* y(k,256) + rxt(k,427) & + + rxt(k,428) + rxt(k,429) + het_rates(k,259))* y(k,259) + prod(k,266) =.530_r8*rxt(k,489)*y(k,293)*y(k,123) +rxt(k,436)*y(k,261) & + +rxt(k,438)*y(k,262) + loss(k,267) = ((rxt(k,507) +rxt(k,508))* y(k,147) +rxt(k,430)* y(k,250) & + +rxt(k,431)* y(k,251) +rxt(k,432)* y(k,256) + rxt(k,433) & + + rxt(k,434) + rxt(k,435) + het_rates(k,260))* y(k,260) + prod(k,267) =.160_r8*rxt(k,489)*y(k,293)*y(k,123) +rxt(k,440)*y(k,263) & + +rxt(k,442)*y(k,264) + loss(k,92) = ( + rxt(k,436) + rxt(k,437) + het_rates(k,261))* y(k,261) + prod(k,92) =.315_r8*rxt(k,487)*y(k,293)*y(k,109) +rxt(k,428)*y(k,259) & + +rxt(k,494)*y(k,276) + loss(k,93) = ( + rxt(k,438) + rxt(k,439) + het_rates(k,262))* y(k,262) + prod(k,93) =.315_r8*rxt(k,487)*y(k,293)*y(k,109) +rxt(k,429)*y(k,259) & + +rxt(k,447)*y(k,265) + loss(k,94) = ( + rxt(k,440) + rxt(k,441) + het_rates(k,263))* y(k,263) + prod(k,94) =.259_r8*rxt(k,487)*y(k,293)*y(k,109) +rxt(k,434)*y(k,260) & + +rxt(k,498)*y(k,277) + loss(k,95) = ( + rxt(k,442) + rxt(k,443) + het_rates(k,264))* y(k,264) + prod(k,95) =.111_r8*rxt(k,487)*y(k,293)*y(k,109) +rxt(k,435)*y(k,260) & + +rxt(k,451)*y(k,266) + loss(k,255) = ((rxt(k,509) +rxt(k,510))* y(k,147) +rxt(k,444)* y(k,250) & + +rxt(k,445)* y(k,251) +rxt(k,446)* y(k,256) + rxt(k,447) & + het_rates(k,265))* y(k,265) - prod(k,224) =rxt(k,440)*y(k,262) - loss(k,225) = ((rxt(k,512) +rxt(k,513))* y(k,147) +rxt(k,449)* y(k,250) & - +rxt(k,450)* y(k,251) +rxt(k,451)* y(k,256) + rxt(k,452) & + prod(k,255) =rxt(k,439)*y(k,262) + loss(k,257) = ((rxt(k,511) +rxt(k,512))* y(k,147) +rxt(k,448)* y(k,250) & + +rxt(k,449)* y(k,251) +rxt(k,450)* y(k,256) + rxt(k,451) & + het_rates(k,266))* y(k,266) - prod(k,225) =rxt(k,444)*y(k,264) - loss(k,176) = ((rxt(k,514) +rxt(k,515))* y(k,147) +rxt(k,458)* y(k,256) & - + rxt(k,459) + het_rates(k,267))* y(k,267) - prod(k,176) =.820_r8*rxt(k,461)*y(k,293)*y(k,115) - loss(k,183) = ((rxt(k,516) +rxt(k,517))* y(k,147) +rxt(k,462)* y(k,256) & - + rxt(k,463) + het_rates(k,268))* y(k,268) - prod(k,183) =.850_r8*rxt(k,464)*y(k,293)*y(k,116) - loss(k,174) = ((rxt(k,518) +rxt(k,519))* y(k,147) +rxt(k,465)* y(k,256) & - + rxt(k,466) + het_rates(k,269))* y(k,269) - prod(k,174) =.870_r8*rxt(k,467)*y(k,293)*y(k,117) - loss(k,177) = ((rxt(k,520) +rxt(k,521))* y(k,147) +rxt(k,468)* y(k,256) & - + rxt(k,469) + het_rates(k,270))* y(k,270) - prod(k,177) =.890_r8*rxt(k,471)*y(k,293)*y(k,118) - loss(k,204) = ((rxt(k,522) +rxt(k,523))* y(k,147) +rxt(k,472)* y(k,256) & + prod(k,257) =rxt(k,443)*y(k,264) + loss(k,203) = ((rxt(k,513) +rxt(k,514))* y(k,147) +rxt(k,457)* y(k,256) & + + rxt(k,458) + het_rates(k,267))* y(k,267) + prod(k,203) =.820_r8*rxt(k,460)*y(k,293)*y(k,115) + loss(k,208) = ((rxt(k,515) +rxt(k,516))* y(k,147) +rxt(k,461)* y(k,256) & + + rxt(k,462) + het_rates(k,268))* y(k,268) + prod(k,208) =.850_r8*rxt(k,463)*y(k,293)*y(k,116) + loss(k,198) = ((rxt(k,517) +rxt(k,518))* y(k,147) +rxt(k,464)* y(k,256) & + + rxt(k,465) + het_rates(k,269))* y(k,269) + prod(k,198) =.870_r8*rxt(k,466)*y(k,293)*y(k,117) + loss(k,204) = ((rxt(k,519) +rxt(k,520))* y(k,147) +rxt(k,467)* y(k,256) & + + rxt(k,468) + het_rates(k,270))* y(k,270) + prod(k,204) =.890_r8*rxt(k,470)*y(k,293)*y(k,118) + loss(k,229) = ((rxt(k,521) +rxt(k,522))* y(k,147) +rxt(k,471)* y(k,256) & + het_rates(k,271))* y(k,271) - prod(k,204) =.920_r8*rxt(k,473)*y(k,293)*y(k,119) - loss(k,246) = ((rxt(k,524) +rxt(k,525))* y(k,147) +rxt(k,479)* y(k,149) & - +rxt(k,475)* y(k,250) +rxt(k,476)* y(k,251) +rxt(k,477)* y(k,256) & - + 2._r8*rxt(k,478)* y(k,272) + het_rates(k,272))* y(k,272) - prod(k,246) = (.170_r8*rxt(k,482)*y(k,120) +.070_r8*rxt(k,486)*y(k,121)) & - *y(k,293) +rxt(k,474)*y(k,149)*y(k,109) - loss(k,194) = ((rxt(k,526) +rxt(k,527))* y(k,147) +rxt(k,480)* y(k,256) & - + rxt(k,481) + het_rates(k,273))* y(k,273) - prod(k,194) =.410_r8*rxt(k,482)*y(k,293)*y(k,120) - loss(k,200) = ((rxt(k,528) +rxt(k,529))* y(k,147) +rxt(k,483)* y(k,256) & - + rxt(k,484) + het_rates(k,274))* y(k,274) - prod(k,200) =.570_r8*rxt(k,486)*y(k,293)*y(k,121) - loss(k,40) = (rxt(k,862)* y(k,147) +rxt(k,861)* y(k,256) + het_rates(k,275)) & + prod(k,229) =.920_r8*rxt(k,472)*y(k,293)*y(k,119) + loss(k,273) = ((rxt(k,523) +rxt(k,524))* y(k,147) +rxt(k,478)* y(k,149) & + +rxt(k,474)* y(k,250) +rxt(k,475)* y(k,251) +rxt(k,476)* y(k,256) & + + 2._r8*rxt(k,477)* y(k,272) + het_rates(k,272))* y(k,272) + prod(k,273) = (.170_r8*rxt(k,481)*y(k,120) +.070_r8*rxt(k,485)*y(k,121)) & + *y(k,293) +rxt(k,473)*y(k,149)*y(k,109) + loss(k,220) = ((rxt(k,525) +rxt(k,526))* y(k,147) +rxt(k,479)* y(k,256) & + + rxt(k,480) + het_rates(k,273))* y(k,273) + prod(k,220) =.410_r8*rxt(k,481)*y(k,293)*y(k,120) + loss(k,227) = ((rxt(k,527) +rxt(k,528))* y(k,147) +rxt(k,482)* y(k,256) & + + rxt(k,483) + het_rates(k,274))* y(k,274) + prod(k,227) =.570_r8*rxt(k,485)*y(k,293)*y(k,121) + loss(k,49) = (rxt(k,861)* y(k,147) +rxt(k,860)* y(k,256) + het_rates(k,275)) & * y(k,275) - prod(k,40) =rxt(k,864)*y(k,293)*y(k,109) - loss(k,237) = ((rxt(k,531) +rxt(k,532))* y(k,147) +rxt(k,492)* y(k,250) & - +rxt(k,493)* y(k,251) +rxt(k,494)* y(k,256) + rxt(k,495) & - + rxt(k,530) + het_rates(k,276))* y(k,276) - prod(k,237) =rxt(k,438)*y(k,261) - loss(k,232) = ((rxt(k,534) +rxt(k,535))* y(k,147) +rxt(k,496)* y(k,250) & - +rxt(k,497)* y(k,251) +rxt(k,498)* y(k,256) + rxt(k,499) & - + rxt(k,533) + het_rates(k,277))* y(k,277) - prod(k,232) =rxt(k,442)*y(k,263) - loss(k,41) = (rxt(k,866)* y(k,147) +rxt(k,865)* y(k,256) + het_rates(k,278)) & + prod(k,49) =rxt(k,863)*y(k,293)*y(k,109) + loss(k,260) = ((rxt(k,530) +rxt(k,531))* y(k,147) +rxt(k,491)* y(k,250) & + +rxt(k,492)* y(k,251) +rxt(k,493)* y(k,256) + rxt(k,494) & + + rxt(k,529) + het_rates(k,276))* y(k,276) + prod(k,260) =rxt(k,437)*y(k,261) + loss(k,259) = ((rxt(k,533) +rxt(k,534))* y(k,147) +rxt(k,495)* y(k,250) & + +rxt(k,496)* y(k,251) +rxt(k,497)* y(k,256) + rxt(k,498) & + + rxt(k,532) + het_rates(k,277))* y(k,277) + prod(k,259) =rxt(k,441)*y(k,263) + loss(k,50) = (rxt(k,865)* y(k,147) +rxt(k,864)* y(k,256) + het_rates(k,278)) & * y(k,278) - prod(k,41) =rxt(k,867)*y(k,293)*y(k,124) - loss(k,258) = (rxt(k,650)* y(k,147) +rxt(k,651)* y(k,149) +rxt(k,646) & - * y(k,250) +rxt(k,647)* y(k,251) +rxt(k,648)* y(k,256) & - + 2._r8*rxt(k,649)* y(k,279) +rxt(k,652)* y(k,300) +rxt(k,653) & - * y(k,302) +rxt(k,654)* y(k,305) + het_rates(k,279))* y(k,279) - prod(k,258) =rxt(k,645)*y(k,149)*y(k,125) - loss(k,252) = (rxt(k,658)* y(k,147) +rxt(k,659)* y(k,149) +rxt(k,655) & - * y(k,250) +rxt(k,656)* y(k,251) +rxt(k,657)* y(k,256) +rxt(k,660) & - * y(k,300) +rxt(k,661)* y(k,302) +rxt(k,662)* y(k,305) & + prod(k,50) =rxt(k,866)*y(k,293)*y(k,124) + loss(k,287) = (rxt(k,649)* y(k,147) +rxt(k,650)* y(k,149) +rxt(k,645) & + * y(k,250) +rxt(k,646)* y(k,251) +rxt(k,647)* y(k,256) & + + 2._r8*rxt(k,648)* y(k,279) +rxt(k,651)* y(k,300) +rxt(k,652) & + * y(k,302) +rxt(k,653)* y(k,305) + het_rates(k,279))* y(k,279) + prod(k,287) =rxt(k,644)*y(k,149)*y(k,125) + loss(k,283) = (rxt(k,657)* y(k,147) +rxt(k,658)* y(k,149) +rxt(k,654) & + * y(k,250) +rxt(k,655)* y(k,251) +rxt(k,656)* y(k,256) +rxt(k,659) & + * y(k,300) +rxt(k,660)* y(k,302) +rxt(k,661)* y(k,305) & + het_rates(k,280))* y(k,280) - prod(k,252) =rxt(k,664)*y(k,293)*y(k,125) - loss(k,43) = (rxt(k,870)* y(k,147) +rxt(k,869)* y(k,256) + het_rates(k,281)) & + prod(k,283) =rxt(k,663)*y(k,293)*y(k,125) + loss(k,52) = (rxt(k,869)* y(k,147) +rxt(k,868)* y(k,256) + het_rates(k,281)) & * y(k,281) - prod(k,43) =rxt(k,872)*y(k,293)*y(k,125) - loss(k,212) = ((rxt(k,536) +rxt(k,537))* y(k,147) +rxt(k,382)* y(k,250) & - +rxt(k,383)* y(k,251) +rxt(k,384)* y(k,256) + rxt(k,385) & + prod(k,52) =rxt(k,871)*y(k,293)*y(k,125) + loss(k,241) = ((rxt(k,535) +rxt(k,536))* y(k,147) +rxt(k,381)* y(k,250) & + +rxt(k,382)* y(k,251) +rxt(k,383)* y(k,256) + rxt(k,384) & + het_rates(k,282))* y(k,282) - prod(k,212) =.190_r8*rxt(k,49)*y(k,99) +.550_r8*rxt(k,387)*y(k,293)*y(k,126) - loss(k,152) = (rxt(k,560)* y(k,147) +rxt(k,561)* y(k,148) +rxt(k,559) & + prod(k,241) =.190_r8*rxt(k,49)*y(k,99) +.550_r8*rxt(k,386)*y(k,293)*y(k,126) + loss(k,179) = (rxt(k,559)* y(k,147) +rxt(k,560)* y(k,148) +rxt(k,558) & * y(k,256) + het_rates(k,283))* y(k,283) - prod(k,152) =.600_r8*rxt(k,23)*y(k,11) - loss(k,220) = (rxt(k,393)* y(k,147) +rxt(k,407)* y(k,148) +rxt(k,394) & - * y(k,149) +rxt(k,389)* y(k,250) +rxt(k,390)* y(k,251) +rxt(k,391) & - * y(k,256) + 2._r8*rxt(k,392)* y(k,284) + het_rates(k,284))* y(k,284) - prod(k,220) = (rxt(k,73) +.450_r8*rxt(k,387)*y(k,293))*y(k,126) & - + (rxt(k,78) +rxt(k,408))*y(k,131) - loss(k,159) = (rxt(k,563)* y(k,147) +rxt(k,564)* y(k,148) +rxt(k,562) & + prod(k,179) =.600_r8*rxt(k,23)*y(k,11) + loss(k,246) = (rxt(k,392)* y(k,147) +rxt(k,406)* y(k,148) +rxt(k,393) & + * y(k,149) +rxt(k,388)* y(k,250) +rxt(k,389)* y(k,251) +rxt(k,390) & + * y(k,256) + 2._r8*rxt(k,391)* y(k,284) + het_rates(k,284))* y(k,284) + prod(k,246) = (rxt(k,73) +.450_r8*rxt(k,386)*y(k,293))*y(k,126) & + + (rxt(k,78) +rxt(k,407))*y(k,131) + loss(k,185) = (rxt(k,562)* y(k,147) +rxt(k,563)* y(k,148) +rxt(k,561) & * y(k,256) + het_rates(k,285))* y(k,285) - prod(k,159) =.600_r8*rxt(k,25)*y(k,13) - loss(k,142) = (rxt(k,396)* y(k,147) +rxt(k,395)* y(k,256) + het_rates(k,286)) & + prod(k,185) =.600_r8*rxt(k,25)*y(k,13) + loss(k,165) = (rxt(k,395)* y(k,147) +rxt(k,394)* y(k,256) + het_rates(k,286)) & * y(k,286) - prod(k,142) = (rxt(k,397)*y(k,129) +rxt(k,398)*y(k,130))*y(k,293) - loss(k,211) = ((rxt(k,538) +rxt(k,539))* y(k,147) +rxt(k,401)* y(k,250) & - +rxt(k,402)* y(k,251) +rxt(k,403)* y(k,256) + het_rates(k,287)) & + prod(k,165) = (rxt(k,396)*y(k,129) +rxt(k,397)*y(k,130))*y(k,293) + loss(k,238) = ((rxt(k,537) +rxt(k,538))* y(k,147) +rxt(k,400)* y(k,250) & + +rxt(k,401)* y(k,251) +rxt(k,402)* y(k,256) + het_rates(k,287)) & * y(k,287) - prod(k,211) =.230_r8*rxt(k,48)*y(k,98) +rxt(k,405)*y(k,293)*y(k,132) - loss(k,260) = (rxt(k,670)* y(k,147) +rxt(k,671)* y(k,149) +rxt(k,666) & - * y(k,250) +rxt(k,667)* y(k,251) +rxt(k,668)* y(k,256) & - + 2._r8*rxt(k,669)* y(k,288) +rxt(k,672)* y(k,300) +rxt(k,673) & - * y(k,302) +rxt(k,674)* y(k,305) + het_rates(k,288))* y(k,288) - prod(k,260) =rxt(k,665)*y(k,149)*y(k,135) - loss(k,257) = (rxt(k,678)* y(k,147) +rxt(k,679)* y(k,149) +rxt(k,675) & - * y(k,250) +rxt(k,676)* y(k,251) +rxt(k,677)* y(k,256) +rxt(k,680) & - * y(k,300) +rxt(k,681)* y(k,302) +rxt(k,682)* y(k,305) & + prod(k,238) =.230_r8*rxt(k,48)*y(k,98) +rxt(k,404)*y(k,293)*y(k,132) + loss(k,294) = (rxt(k,669)* y(k,147) +rxt(k,670)* y(k,149) +rxt(k,665) & + * y(k,250) +rxt(k,666)* y(k,251) +rxt(k,667)* y(k,256) & + + 2._r8*rxt(k,668)* y(k,288) +rxt(k,671)* y(k,300) +rxt(k,672) & + * y(k,302) +rxt(k,673)* y(k,305) + het_rates(k,288))* y(k,288) + prod(k,294) =rxt(k,664)*y(k,149)*y(k,135) + loss(k,298) = (rxt(k,677)* y(k,147) +rxt(k,678)* y(k,149) +rxt(k,674) & + * y(k,250) +rxt(k,675)* y(k,251) +rxt(k,676)* y(k,256) +rxt(k,679) & + * y(k,300) +rxt(k,680)* y(k,302) +rxt(k,681)* y(k,305) & + het_rates(k,289))* y(k,289) - prod(k,257) =rxt(k,684)*y(k,293)*y(k,135) - loss(k,44) = (rxt(k,875)* y(k,147) +rxt(k,874)* y(k,256) + het_rates(k,290)) & + prod(k,298) =rxt(k,683)*y(k,293)*y(k,135) + loss(k,53) = (rxt(k,874)* y(k,147) +rxt(k,873)* y(k,256) + het_rates(k,290)) & * y(k,290) - prod(k,44) =rxt(k,877)*y(k,293)*y(k,135) - loss(k,219) = ((rxt(k,540) +rxt(k,541))* y(k,147) +rxt(k,500)* y(k,256) & - + rxt(k,501) + het_rates(k,291))* y(k,291) - prod(k,219) = (.400_r8*rxt(k,423)*y(k,107) +.350_r8*rxt(k,424)*y(k,108) + & - .230_r8*rxt(k,503)*y(k,139))*y(k,293) - loss(k,275) = (rxt(k,243)* y(k,34) +rxt(k,244)* y(k,35) +rxt(k,270)* y(k,36) & + prod(k,53) =rxt(k,876)*y(k,293)*y(k,135) + loss(k,247) = ((rxt(k,539) +rxt(k,540))* y(k,147) +rxt(k,499)* y(k,256) & + + rxt(k,500) + het_rates(k,291))* y(k,291) + prod(k,247) = (.400_r8*rxt(k,422)*y(k,107) +.350_r8*rxt(k,423)*y(k,108) + & + .230_r8*rxt(k,502)*y(k,139))*y(k,293) + loss(k,292) = (rxt(k,243)* y(k,34) +rxt(k,244)* y(k,35) +rxt(k,270)* y(k,36) & +rxt(k,245)* y(k,37) +rxt(k,246)* y(k,38) +rxt(k,247)* y(k,39) & +rxt(k,248)* y(k,40) +rxt(k,249)* y(k,41) +rxt(k,293)* y(k,42) & - +rxt(k,294)* y(k,44) + (rxt(k,316) +rxt(k,317) +rxt(k,318))* y(k,55) & + +rxt(k,294)* y(k,44) + (rxt(k,315) +rxt(k,316) +rxt(k,317))* y(k,55) & +rxt(k,271)* y(k,56) +rxt(k,279)* y(k,65) +rxt(k,280)* y(k,66) & +rxt(k,168)* y(k,79) +rxt(k,272)* y(k,80) + (rxt(k,273) +rxt(k,274)) & * y(k,83) +rxt(k,295)* y(k,84) +rxt(k,296)* y(k,85) +rxt(k,297) & - * y(k,86) + (rxt(k,250) +rxt(k,251))* y(k,87) +rxt(k,319)* y(k,88) & + * y(k,86) + (rxt(k,250) +rxt(k,251))* y(k,87) +rxt(k,318)* y(k,88) & + (rxt(k,210) +rxt(k,211))* y(k,137) +rxt(k,172)* y(k,157) & +rxt(k,169)* y(k,317) + rxt(k,170) + rxt(k,171) + het_rates(k,292)) & * y(k,292) - prod(k,275) =rxt(k,7)*y(k,157) +rxt(k,1)*y(k,317) - loss(k,282) = (rxt(k,409)* y(k,1) +rxt(k,413)* y(k,2) +rxt(k,604)* y(k,4) & - +rxt(k,624)* y(k,7) +rxt(k,544)* y(k,8) +rxt(k,547)* y(k,9) & - +rxt(k,414)* y(k,15) +rxt(k,376)* y(k,16) +rxt(k,644)* y(k,17) & - +rxt(k,266)* y(k,20) +rxt(k,548)* y(k,23) +rxt(k,550)* y(k,24) & - +rxt(k,322)* y(k,25) +rxt(k,351)* y(k,26) +rxt(k,329)* y(k,27) & - +rxt(k,330)* y(k,28) +rxt(k,332)* y(k,29) +rxt(k,373)* y(k,30) & - +rxt(k,359)* y(k,31) +rxt(k,360)* y(k,32) +rxt(k,554)* y(k,33) & + prod(k,292) =rxt(k,12)*y(k,137) +rxt(k,7)*y(k,157) +rxt(k,1)*y(k,317) + loss(k,310) = (rxt(k,408)* y(k,1) +rxt(k,412)* y(k,2) +rxt(k,603)* y(k,4) & + +rxt(k,623)* y(k,7) +rxt(k,543)* y(k,8) +rxt(k,546)* y(k,9) & + +rxt(k,413)* y(k,15) +rxt(k,375)* y(k,16) +rxt(k,643)* y(k,17) & + +rxt(k,266)* y(k,20) +rxt(k,547)* y(k,23) +rxt(k,549)* y(k,24) & + +rxt(k,321)* y(k,25) +rxt(k,350)* y(k,26) +rxt(k,328)* y(k,27) & + +rxt(k,329)* y(k,28) +rxt(k,331)* y(k,29) +rxt(k,372)* y(k,30) & + +rxt(k,358)* y(k,31) +rxt(k,359)* y(k,32) +rxt(k,553)* y(k,33) & +rxt(k,282)* y(k,42) +rxt(k,301)* y(k,43) +rxt(k,284)* y(k,44) & - +rxt(k,285)* y(k,45) +rxt(k,334)* y(k,46) +rxt(k,287)* y(k,47) & - +rxt(k,335)* y(k,48) +rxt(k,374)* y(k,49) +rxt(k,362)* y(k,50) & - +rxt(k,340)* y(k,51) +rxt(k,341)* y(k,52) +rxt(k,306)* y(k,53) & + +rxt(k,285)* y(k,45) +rxt(k,333)* y(k,46) +rxt(k,287)* y(k,47) & + +rxt(k,334)* y(k,48) +rxt(k,373)* y(k,49) +rxt(k,361)* y(k,50) & + +rxt(k,339)* y(k,51) +rxt(k,340)* y(k,52) +rxt(k,306)* y(k,53) & +rxt(k,307)* y(k,54) +rxt(k,308)* y(k,55) +rxt(k,289)* y(k,56) & - + (rxt(k,236) +rxt(k,237))* y(k,60) +rxt(k,234)* y(k,61) & - + (rxt(k,309) +rxt(k,320))* y(k,63) +rxt(k,555)* y(k,67) & - + (rxt(k,795) +rxt(k,808))* y(k,69) +rxt(k,346)* y(k,76) +rxt(k,347) & - * y(k,77) +rxt(k,185)* y(k,79) +rxt(k,186)* y(k,81) +rxt(k,268) & - * y(k,83) +rxt(k,290)* y(k,84) +rxt(k,291)* y(k,85) +rxt(k,292) & - * y(k,86) +rxt(k,239)* y(k,87) +rxt(k,310)* y(k,88) +rxt(k,348) & - * y(k,89) +rxt(k,311)* y(k,90) +rxt(k,312)* y(k,92) +rxt(k,215) & - * y(k,93) +rxt(k,193)* y(k,94) +rxt(k,242)* y(k,96) +rxt(k,380) & - * y(k,97) +rxt(k,415)* y(k,98) +rxt(k,416)* y(k,99) +rxt(k,363) & - * y(k,102) +rxt(k,419)* y(k,103) +rxt(k,364)* y(k,104) +rxt(k,421) & - * y(k,106) +rxt(k,423)* y(k,107) +rxt(k,424)* y(k,108) +rxt(k,488) & - * y(k,109) +rxt(k,454)* y(k,110) +rxt(k,453)* y(k,111) +rxt(k,455) & - * y(k,112) +rxt(k,456)* y(k,113) +rxt(k,461)* y(k,115) +rxt(k,464) & - * y(k,116) +rxt(k,467)* y(k,117) +rxt(k,471)* y(k,118) +rxt(k,473) & - * y(k,119) +rxt(k,482)* y(k,120) +rxt(k,486)* y(k,121) +rxt(k,489) & - * y(k,122) + (rxt(k,490) +rxt(k,491))* y(k,123) +rxt(k,664)* y(k,125) & - +rxt(k,387)* y(k,126) +rxt(k,381)* y(k,127) +rxt(k,397)* y(k,129) & - +rxt(k,398)* y(k,130) +rxt(k,399)* y(k,131) +rxt(k,405)* y(k,132) & - +rxt(k,400)* y(k,133) +rxt(k,406)* y(k,134) +rxt(k,684)* y(k,135) & - +rxt(k,206)* y(k,136) +rxt(k,503)* y(k,139) +rxt(k,811)* y(k,143) & - +rxt(k,214)* y(k,148) +rxt(k,205)* y(k,149) +rxt(k,349)* y(k,150) & - +rxt(k,365)* y(k,151) +rxt(k,188)* y(k,156) +rxt(k,189)* y(k,157) & - +rxt(k,797)* y(k,160) +rxt(k,350)* y(k,162) +rxt(k,567)* y(k,165) & - +rxt(k,570)* y(k,166) +rxt(k,368)* y(k,169) +rxt(k,372)* y(k,170) & - +rxt(k,802)* y(k,171) +rxt(k,807)* y(k,173) +rxt(k,809)* y(k,174) & - +rxt(k,690)* y(k,198) +rxt(k,691)* y(k,199) +rxt(k,757)* y(k,200) & - +rxt(k,718)* y(k,201) +rxt(k,719)* y(k,202) +rxt(k,737)* y(k,203) & - +rxt(k,738)* y(k,204) +rxt(k,749)* y(k,205) +rxt(k,747)* y(k,206) & - +rxt(k,748)* y(k,207) +rxt(k,758)* y(k,208) +rxt(k,764)* y(k,210) & - +rxt(k,769)* y(k,211) +rxt(k,770)* y(k,212) +rxt(k,772)* y(k,214) & - +rxt(k,776)* y(k,215) +rxt(k,775)* y(k,216) +rxt(k,779)* y(k,218) & - +rxt(k,784)* y(k,219) +rxt(k,783)* y(k,220) +rxt(k,788)* y(k,221) & - +rxt(k,787)* y(k,222) +rxt(k,574)* y(k,225) +rxt(k,575)* y(k,226) & - +rxt(k,577)* y(k,227) +rxt(k,580)* y(k,228) +rxt(k,583)* y(k,229) & - +rxt(k,584)* y(k,230) +rxt(k,187)* y(k,256) + 2._r8*(rxt(k,190) + & - rxt(k,191))* y(k,293) + het_rates(k,293))* y(k,293) - prod(k,282) = (2.000_r8*rxt(k,179)*y(k,78) +rxt(k,182)*y(k,156) + & + + (rxt(k,236) +rxt(k,237))* y(k,60) +rxt(k,234)* y(k,61) +rxt(k,319) & + * y(k,63) +rxt(k,554)* y(k,67) + (rxt(k,794) +rxt(k,808))* y(k,69) & + +rxt(k,345)* y(k,76) +rxt(k,346)* y(k,77) +rxt(k,185)* y(k,79) & + +rxt(k,186)* y(k,81) +rxt(k,268)* y(k,83) +rxt(k,290)* y(k,84) & + +rxt(k,291)* y(k,85) +rxt(k,292)* y(k,86) +rxt(k,239)* y(k,87) & + +rxt(k,309)* y(k,88) +rxt(k,347)* y(k,89) +rxt(k,310)* y(k,90) & + +rxt(k,311)* y(k,92) +rxt(k,215)* y(k,93) +rxt(k,193)* y(k,94) & + +rxt(k,242)* y(k,96) +rxt(k,379)* y(k,97) +rxt(k,414)* y(k,98) & + +rxt(k,415)* y(k,99) +rxt(k,362)* y(k,102) +rxt(k,418)* y(k,103) & + +rxt(k,363)* y(k,104) +rxt(k,420)* y(k,106) +rxt(k,422)* y(k,107) & + +rxt(k,423)* y(k,108) +rxt(k,487)* y(k,109) +rxt(k,453)* y(k,110) & + +rxt(k,452)* y(k,111) +rxt(k,454)* y(k,112) +rxt(k,455)* y(k,113) & + +rxt(k,460)* y(k,115) +rxt(k,463)* y(k,116) +rxt(k,466)* y(k,117) & + +rxt(k,470)* y(k,118) +rxt(k,472)* y(k,119) +rxt(k,481)* y(k,120) & + +rxt(k,485)* y(k,121) +rxt(k,488)* y(k,122) + (rxt(k,489) + & + rxt(k,490))* y(k,123) +rxt(k,663)* y(k,125) +rxt(k,386)* y(k,126) & + +rxt(k,380)* y(k,127) +rxt(k,396)* y(k,129) +rxt(k,397)* y(k,130) & + +rxt(k,398)* y(k,131) +rxt(k,404)* y(k,132) +rxt(k,399)* y(k,133) & + +rxt(k,405)* y(k,134) +rxt(k,683)* y(k,135) +rxt(k,206)* y(k,136) & + +rxt(k,502)* y(k,139) +rxt(k,810)* y(k,143) +rxt(k,214)* y(k,148) & + +rxt(k,205)* y(k,149) +rxt(k,348)* y(k,150) +rxt(k,364)* y(k,151) & + +rxt(k,188)* y(k,156) +rxt(k,189)* y(k,157) +rxt(k,796)* y(k,160) & + +rxt(k,349)* y(k,162) +rxt(k,566)* y(k,165) +rxt(k,569)* y(k,166) & + +rxt(k,367)* y(k,169) +rxt(k,371)* y(k,170) +rxt(k,802)* y(k,171) & + +rxt(k,807)* y(k,173) +rxt(k,798)* y(k,174) +rxt(k,689)* y(k,198) & + +rxt(k,690)* y(k,199) +rxt(k,756)* y(k,200) +rxt(k,717)* y(k,201) & + +rxt(k,718)* y(k,202) +rxt(k,736)* y(k,203) +rxt(k,737)* y(k,204) & + +rxt(k,748)* y(k,205) +rxt(k,746)* y(k,206) +rxt(k,747)* y(k,207) & + +rxt(k,757)* y(k,208) +rxt(k,763)* y(k,210) +rxt(k,768)* y(k,211) & + +rxt(k,769)* y(k,212) +rxt(k,771)* y(k,214) +rxt(k,775)* y(k,215) & + +rxt(k,774)* y(k,216) +rxt(k,778)* y(k,218) +rxt(k,783)* y(k,219) & + +rxt(k,782)* y(k,220) +rxt(k,787)* y(k,221) +rxt(k,786)* y(k,222) & + +rxt(k,573)* y(k,225) +rxt(k,574)* y(k,226) +rxt(k,576)* y(k,227) & + +rxt(k,579)* y(k,228) +rxt(k,582)* y(k,229) +rxt(k,583)* y(k,230) & + +rxt(k,187)* y(k,256) + 2._r8*(rxt(k,190) +rxt(k,191))* y(k,293) & + + het_rates(k,293))* y(k,293) + prod(k,310) = (2.000_r8*rxt(k,179)*y(k,78) +rxt(k,182)*y(k,156) + & rxt(k,183)*y(k,157) +rxt(k,202)*y(k,149) +rxt(k,207)*y(k,147) + & - rxt(k,223)*y(k,57) +.200_r8*rxt(k,313)*y(k,257) + & - .490_r8*rxt(k,338)*y(k,250) +.150_r8*rxt(k,370)*y(k,296) + & - .590_r8*rxt(k,384)*y(k,282) +.490_r8*rxt(k,391)*y(k,284) + & - .200_r8*rxt(k,395)*y(k,286) +.540_r8*rxt(k,403)*y(k,287) + & - .650_r8*rxt(k,422)*y(k,258) +.060_r8*rxt(k,427)*y(k,259) + & - .060_r8*rxt(k,433)*y(k,260) +.580_r8*rxt(k,458)*y(k,267) + & - .520_r8*rxt(k,462)*y(k,268) +.600_r8*rxt(k,465)*y(k,269) + & - .500_r8*rxt(k,468)*y(k,270) +.400_r8*rxt(k,472)*y(k,271) + & - .240_r8*rxt(k,477)*y(k,272) +.850_r8*rxt(k,480)*y(k,273) + & - .860_r8*rxt(k,483)*y(k,274) +.800_r8*rxt(k,500)*y(k,291) + & - .400_r8*rxt(k,542)*y(k,233) +.400_r8*rxt(k,556)*y(k,252) + & - .400_r8*rxt(k,562)*y(k,285) +.700_r8*rxt(k,589)*y(k,235) + & - .350_r8*rxt(k,597)*y(k,236) +.500_r8*rxt(k,609)*y(k,238) + & - .100_r8*rxt(k,617)*y(k,239) +.470_r8*rxt(k,629)*y(k,243) + & - .030_r8*rxt(k,637)*y(k,244) +.500_r8*rxt(k,648)*y(k,279) + & - .100_r8*rxt(k,657)*y(k,280) +.480_r8*rxt(k,668)*y(k,288) + & - .100_r8*rxt(k,677)*y(k,289) +.180_r8*rxt(k,688)*y(k,297) + & - .180_r8*rxt(k,692)*y(k,298) +.490_r8*rxt(k,704)*y(k,300) + & - .380_r8*rxt(k,712)*y(k,301) +.490_r8*rxt(k,722)*y(k,302) + & - .150_r8*rxt(k,731)*y(k,303) +.530_r8*rxt(k,741)*y(k,304) + & - .490_r8*rxt(k,752)*y(k,305) +.100_r8*rxt(k,761)*y(k,306) + & - .100_r8*rxt(k,766)*y(k,307) +.100_r8*rxt(k,773)*y(k,308) + & - .100_r8*rxt(k,777)*y(k,309) +.100_r8*rxt(k,781)*y(k,310) + & - .100_r8*rxt(k,785)*y(k,311))*y(k,256) + (.300_r8*rxt(k,307)*y(k,54) + & - .500_r8*rxt(k,312)*y(k,92) +.650_r8*rxt(k,322)*y(k,25) + & - .500_r8*rxt(k,330)*y(k,28) +.890_r8*rxt(k,348)*y(k,89) + & - .700_r8*rxt(k,364)*y(k,104) +.500_r8*rxt(k,368)*y(k,169) + & - .430_r8*rxt(k,415)*y(k,98) +.530_r8*rxt(k,416)*y(k,99) + & - 1.080_r8*rxt(k,419)*y(k,103) +.500_r8*rxt(k,455)*y(k,112) + & - .060_r8*rxt(k,461)*y(k,115) +.040_r8*rxt(k,471)*y(k,118) + & - .030_r8*rxt(k,473)*y(k,119) +.420_r8*rxt(k,482)*y(k,120) + & - .290_r8*rxt(k,486)*y(k,121) +.130_r8*rxt(k,490)*y(k,123) + & - .920_r8*rxt(k,491)*y(k,123))*y(k,293) + (rxt(k,184)*y(k,78) + & - .130_r8*rxt(k,324)*y(k,26) +.360_r8*rxt(k,355)*y(k,30) + & - .240_r8*rxt(k,386)*y(k,126) +.360_r8*rxt(k,404)*y(k,132) + & - .340_r8*rxt(k,460)*y(k,115) +.340_r8*rxt(k,470)*y(k,118) + & - .510_r8*rxt(k,485)*y(k,121) +.250_r8*rxt(k,487)*y(k,109) + & - .340_r8*rxt(k,502)*y(k,139) +.770_r8*rxt(k,603)*y(k,4) + & - .080_r8*rxt(k,623)*y(k,7) +.300_r8*rxt(k,643)*y(k,17) + & - .660_r8*rxt(k,663)*y(k,125) +.630_r8*rxt(k,683)*y(k,135) + & - .090_r8*rxt(k,763)*y(k,210))*y(k,157) + (rxt(k,176)*y(k,79) + & + rxt(k,223)*y(k,57) +.200_r8*rxt(k,312)*y(k,257) + & + .490_r8*rxt(k,337)*y(k,250) +.150_r8*rxt(k,369)*y(k,296) + & + .590_r8*rxt(k,383)*y(k,282) +.490_r8*rxt(k,390)*y(k,284) + & + .200_r8*rxt(k,394)*y(k,286) +.540_r8*rxt(k,402)*y(k,287) + & + .650_r8*rxt(k,421)*y(k,258) +.060_r8*rxt(k,426)*y(k,259) + & + .060_r8*rxt(k,432)*y(k,260) +.580_r8*rxt(k,457)*y(k,267) + & + .520_r8*rxt(k,461)*y(k,268) +.600_r8*rxt(k,464)*y(k,269) + & + .500_r8*rxt(k,467)*y(k,270) +.400_r8*rxt(k,471)*y(k,271) + & + .240_r8*rxt(k,476)*y(k,272) +.850_r8*rxt(k,479)*y(k,273) + & + .860_r8*rxt(k,482)*y(k,274) +.800_r8*rxt(k,499)*y(k,291) + & + .400_r8*rxt(k,541)*y(k,233) +.400_r8*rxt(k,555)*y(k,252) + & + .400_r8*rxt(k,561)*y(k,285) +.700_r8*rxt(k,588)*y(k,235) + & + .350_r8*rxt(k,596)*y(k,236) +.500_r8*rxt(k,608)*y(k,238) + & + .100_r8*rxt(k,616)*y(k,239) +.470_r8*rxt(k,628)*y(k,243) + & + .030_r8*rxt(k,636)*y(k,244) +.500_r8*rxt(k,647)*y(k,279) + & + .100_r8*rxt(k,656)*y(k,280) +.480_r8*rxt(k,667)*y(k,288) + & + .100_r8*rxt(k,676)*y(k,289) +.180_r8*rxt(k,687)*y(k,297) + & + .180_r8*rxt(k,691)*y(k,298) +.490_r8*rxt(k,703)*y(k,300) + & + .380_r8*rxt(k,711)*y(k,301) +.490_r8*rxt(k,721)*y(k,302) + & + .150_r8*rxt(k,730)*y(k,303) +.530_r8*rxt(k,740)*y(k,304) + & + .490_r8*rxt(k,751)*y(k,305) +.100_r8*rxt(k,760)*y(k,306) + & + .100_r8*rxt(k,765)*y(k,307) +.100_r8*rxt(k,772)*y(k,308) + & + .100_r8*rxt(k,776)*y(k,309) +.100_r8*rxt(k,780)*y(k,310) + & + .100_r8*rxt(k,784)*y(k,311))*y(k,256) + (.300_r8*rxt(k,307)*y(k,54) + & + .500_r8*rxt(k,311)*y(k,92) +.650_r8*rxt(k,321)*y(k,25) + & + .500_r8*rxt(k,329)*y(k,28) +.890_r8*rxt(k,347)*y(k,89) + & + .700_r8*rxt(k,363)*y(k,104) +.500_r8*rxt(k,367)*y(k,169) + & + .430_r8*rxt(k,414)*y(k,98) +.530_r8*rxt(k,415)*y(k,99) + & + 1.080_r8*rxt(k,418)*y(k,103) +.500_r8*rxt(k,454)*y(k,112) + & + .060_r8*rxt(k,460)*y(k,115) +.040_r8*rxt(k,470)*y(k,118) + & + .030_r8*rxt(k,472)*y(k,119) +.420_r8*rxt(k,481)*y(k,120) + & + .290_r8*rxt(k,485)*y(k,121) +.130_r8*rxt(k,489)*y(k,123) + & + .920_r8*rxt(k,490)*y(k,123))*y(k,293) + (rxt(k,184)*y(k,78) + & + .130_r8*rxt(k,323)*y(k,26) +.360_r8*rxt(k,354)*y(k,30) + & + .240_r8*rxt(k,385)*y(k,126) +.360_r8*rxt(k,403)*y(k,132) + & + .340_r8*rxt(k,459)*y(k,115) +.340_r8*rxt(k,469)*y(k,118) + & + .510_r8*rxt(k,484)*y(k,121) +.250_r8*rxt(k,486)*y(k,109) + & + .340_r8*rxt(k,501)*y(k,139) +.770_r8*rxt(k,602)*y(k,4) + & + .080_r8*rxt(k,622)*y(k,7) +.300_r8*rxt(k,642)*y(k,17) + & + .660_r8*rxt(k,662)*y(k,125) +.630_r8*rxt(k,682)*y(k,135) + & + .090_r8*rxt(k,762)*y(k,210))*y(k,157) + (rxt(k,176)*y(k,79) + & rxt(k,177)*y(k,81) +rxt(k,238)*y(k,87) +rxt(k,241)*y(k,96) + & rxt(k,267)*y(k,83) +rxt(k,269)*y(k,95) +rxt(k,300)*y(k,43))*y(k,156) & - + (.550_r8*rxt(k,510)*y(k,265) +.550_r8*rxt(k,512)*y(k,266) + & - .470_r8*rxt(k,526)*y(k,273) +.040_r8*rxt(k,528)*y(k,274) + & - .550_r8*rxt(k,531)*y(k,276) +.550_r8*rxt(k,534)*y(k,277))*y(k,147) & - + (rxt(k,316)*y(k,55) +rxt(k,168)*y(k,79) + & - 2.000_r8*rxt(k,169)*y(k,317) +rxt(k,250)*y(k,87) + & - rxt(k,273)*y(k,83) +rxt(k,319)*y(k,88))*y(k,292) & - + (.550_r8*rxt(k,445)*y(k,265) +.550_r8*rxt(k,449)*y(k,266) + & - .550_r8*rxt(k,492)*y(k,276) +.550_r8*rxt(k,496)*y(k,277))*y(k,250) & - + (.280_r8*rxt(k,446)*y(k,265) +.280_r8*rxt(k,450)*y(k,266) + & - .280_r8*rxt(k,493)*y(k,276) +.280_r8*rxt(k,497)*y(k,277))*y(k,251) & + + (.550_r8*rxt(k,509)*y(k,265) +.550_r8*rxt(k,511)*y(k,266) + & + .470_r8*rxt(k,525)*y(k,273) +.040_r8*rxt(k,527)*y(k,274) + & + .550_r8*rxt(k,530)*y(k,276) +.550_r8*rxt(k,533)*y(k,277))*y(k,147) & + + (rxt(k,168)*y(k,79) +2.000_r8*rxt(k,169)*y(k,317) + & + rxt(k,250)*y(k,87) +rxt(k,273)*y(k,83) +rxt(k,315)*y(k,55) + & + rxt(k,318)*y(k,88))*y(k,292) + (.550_r8*rxt(k,444)*y(k,265) + & + .550_r8*rxt(k,448)*y(k,266) +.550_r8*rxt(k,491)*y(k,276) + & + .550_r8*rxt(k,495)*y(k,277))*y(k,250) & + + (.280_r8*rxt(k,445)*y(k,265) +.280_r8*rxt(k,449)*y(k,266) + & + .280_r8*rxt(k,492)*y(k,276) +.280_r8*rxt(k,496)*y(k,277))*y(k,251) & + (rxt(k,55) +rxt(k,56))*y(k,104) + (rxt(k,2) +rxt(k,277)*y(k,75)) & *y(k,317) +rxt(k,20)*y(k,2) +rxt(k,21)*y(k,9) +rxt(k,27)*y(k,24) & +rxt(k,28)*y(k,28) +rxt(k,29)*y(k,31) +rxt(k,30)*y(k,33) +rxt(k,36) & - *y(k,52) +rxt(k,37)*y(k,54) +1.500_r8*rxt(k,41)*y(k,68) +rxt(k,42) & - *y(k,74) +2.000_r8*rxt(k,4)*y(k,81) +rxt(k,45)*y(k,89) & - +2.000_r8*rxt(k,46)*y(k,92) +rxt(k,9)*y(k,93) +rxt(k,10)*y(k,94) & - +rxt(k,149)*y(k,95) +rxt(k,150)*y(k,96) +1.110_r8*rxt(k,48)*y(k,98) & - +1.180_r8*rxt(k,49)*y(k,99) +rxt(k,50)*y(k,100) +rxt(k,51)*y(k,101) & - +3.000_r8*rxt(k,54)*y(k,103) +rxt(k,61)*y(k,112) +rxt(k,62)*y(k,113) & - +rxt(k,63)*y(k,114) +.550_r8*rxt(k,64)*y(k,115) +.550_r8*rxt(k,67) & - *y(k,118) +rxt(k,69)*y(k,120) +rxt(k,70)*y(k,121) +rxt(k,71)*y(k,123) & - +rxt(k,75)*y(k,128) +rxt(k,77)*y(k,130) +rxt(k,81)*y(k,134) & - +.500_r8*rxt(k,831)*y(k,148) +rxt(k,87)*y(k,166) +rxt(k,88)*y(k,169) & - +rxt(k,89)*y(k,170) +rxt(k,91)*y(k,198) +rxt(k,92)*y(k,199) & - +rxt(k,98)*y(k,205) +rxt(k,99)*y(k,206) +rxt(k,100)*y(k,207) & - +rxt(k,102)*y(k,209) +rxt(k,104)*y(k,213) +rxt(k,105)*y(k,215) & - +rxt(k,106)*y(k,216) +rxt(k,107)*y(k,217) +rxt(k,108)*y(k,218) & - +rxt(k,113)*y(k,223) +rxt(k,114)*y(k,224) +rxt(k,115)*y(k,225) & - +rxt(k,116)*y(k,228) +rxt(k,117)*y(k,230) +rxt(k,428)*y(k,259) & - +rxt(k,434)*y(k,260) +rxt(k,481)*y(k,273) +rxt(k,484)*y(k,274) & - +.600_r8*rxt(k,530)*y(k,276) +.600_r8*rxt(k,533)*y(k,277) & - +rxt(k,385)*y(k,282) +rxt(k,501)*y(k,291) - loss(k,105) = (rxt(k,566)* y(k,147) +rxt(k,565)* y(k,256) + het_rates(k,294)) & + *y(k,52) +rxt(k,37)*y(k,54) +.330_r8*rxt(k,39)*y(k,55) & + +1.500_r8*rxt(k,41)*y(k,68) +rxt(k,42)*y(k,74) +2.000_r8*rxt(k,4) & + *y(k,81) +rxt(k,45)*y(k,89) +2.000_r8*rxt(k,46)*y(k,92) +rxt(k,9) & + *y(k,93) +rxt(k,10)*y(k,94) +rxt(k,149)*y(k,95) +rxt(k,150)*y(k,96) & + +1.110_r8*rxt(k,48)*y(k,98) +1.180_r8*rxt(k,49)*y(k,99) +rxt(k,50) & + *y(k,100) +rxt(k,51)*y(k,101) +3.000_r8*rxt(k,54)*y(k,103) +rxt(k,61) & + *y(k,112) +rxt(k,62)*y(k,113) +rxt(k,63)*y(k,114) +.550_r8*rxt(k,64) & + *y(k,115) +.550_r8*rxt(k,67)*y(k,118) +rxt(k,69)*y(k,120) +rxt(k,70) & + *y(k,121) +rxt(k,71)*y(k,123) +rxt(k,75)*y(k,128) +rxt(k,77)*y(k,130) & + +rxt(k,81)*y(k,134) +.500_r8*rxt(k,830)*y(k,148) +rxt(k,87)*y(k,166) & + +rxt(k,88)*y(k,169) +rxt(k,89)*y(k,170) +rxt(k,91)*y(k,198) & + +rxt(k,92)*y(k,199) +rxt(k,98)*y(k,205) +rxt(k,99)*y(k,206) & + +rxt(k,100)*y(k,207) +rxt(k,102)*y(k,209) +rxt(k,104)*y(k,213) & + +rxt(k,105)*y(k,215) +rxt(k,106)*y(k,216) +rxt(k,107)*y(k,217) & + +rxt(k,108)*y(k,218) +rxt(k,113)*y(k,223) +rxt(k,114)*y(k,224) & + +rxt(k,115)*y(k,225) +rxt(k,116)*y(k,228) +rxt(k,117)*y(k,230) & + +rxt(k,427)*y(k,259) +rxt(k,433)*y(k,260) +rxt(k,480)*y(k,273) & + +rxt(k,483)*y(k,274) +.600_r8*rxt(k,529)*y(k,276) & + +.600_r8*rxt(k,532)*y(k,277) +rxt(k,384)*y(k,282) +rxt(k,500) & + *y(k,291) + loss(k,128) = (rxt(k,565)* y(k,147) +rxt(k,564)* y(k,256) + het_rates(k,294)) & * y(k,294) - prod(k,105) = (.200_r8*rxt(k,555)*y(k,67) +.140_r8*rxt(k,567)*y(k,165) + & - rxt(k,570)*y(k,166))*y(k,293) - loss(k,160) = (rxt(k,367)* y(k,147) +rxt(k,366)* y(k,256) + het_rates(k,295)) & + prod(k,128) = (.200_r8*rxt(k,554)*y(k,67) +.140_r8*rxt(k,566)*y(k,165) + & + rxt(k,569)*y(k,166))*y(k,293) + loss(k,186) = (rxt(k,366)* y(k,147) +rxt(k,365)* y(k,256) + het_rates(k,295)) & * y(k,295) - prod(k,160) = (.500_r8*rxt(k,368)*y(k,169) +rxt(k,373)*y(k,30))*y(k,293) - loss(k,197) = (rxt(k,371)* y(k,147) +rxt(k,369)* y(k,251) +rxt(k,370) & + prod(k,186) = (.500_r8*rxt(k,367)*y(k,169) +rxt(k,372)*y(k,30))*y(k,293) + loss(k,222) = (rxt(k,370)* y(k,147) +rxt(k,368)* y(k,251) +rxt(k,369) & * y(k,256) + het_rates(k,296))* y(k,296) - prod(k,197) = (rxt(k,372)*y(k,170) +rxt(k,374)*y(k,49))*y(k,293) - loss(k,161) = (rxt(k,689)* y(k,147) +rxt(k,688)* y(k,256) + het_rates(k,297)) & + prod(k,222) = (rxt(k,371)*y(k,170) +rxt(k,373)*y(k,49))*y(k,293) + loss(k,187) = (rxt(k,688)* y(k,147) +rxt(k,687)* y(k,256) + het_rates(k,297)) & * y(k,297) - prod(k,161) =rxt(k,690)*y(k,293)*y(k,198) - loss(k,169) = (rxt(k,693)* y(k,147) +rxt(k,692)* y(k,256) + het_rates(k,298)) & + prod(k,187) =rxt(k,689)*y(k,293)*y(k,198) + loss(k,194) = (rxt(k,692)* y(k,147) +rxt(k,691)* y(k,256) + het_rates(k,298)) & * y(k,298) - prod(k,169) =rxt(k,691)*y(k,293)*y(k,199) - loss(k,263) = (rxt(k,697)* y(k,147) +rxt(k,698)* y(k,149) +rxt(k,694) & - * y(k,250) +rxt(k,695)* y(k,251) +rxt(k,696)* y(k,256) +rxt(k,699) & - * y(k,300) +rxt(k,700)* y(k,302) + het_rates(k,299))* y(k,299) - prod(k,263) = (rxt(k,594)*y(k,235) +rxt(k,602)*y(k,236) + & - rxt(k,614)*y(k,238) +rxt(k,622)*y(k,239) +rxt(k,634)*y(k,243) + & - rxt(k,642)*y(k,244) +rxt(k,654)*y(k,279) +rxt(k,662)*y(k,280) + & - rxt(k,674)*y(k,288) +rxt(k,682)*y(k,289) +rxt(k,708)*y(k,300) + & - rxt(k,717)*y(k,301) +rxt(k,727)*y(k,302) +rxt(k,736)*y(k,303) + & - rxt(k,746)*y(k,304) +rxt(k,750)*y(k,250) +rxt(k,751)*y(k,251) + & - .490_r8*rxt(k,752)*y(k,256) +rxt(k,753)*y(k,147) + & - rxt(k,754)*y(k,149) +2.000_r8*rxt(k,755)*y(k,305))*y(k,305) & - + (rxt(k,98) +.290_r8*rxt(k,749)*y(k,293))*y(k,205) +rxt(k,93) & - *y(k,200) +.860_r8*rxt(k,772)*y(k,293)*y(k,214) - loss(k,266) = (rxt(k,705)* y(k,147) +rxt(k,685)* y(k,148) +rxt(k,706) & + prod(k,194) =rxt(k,690)*y(k,293)*y(k,199) + loss(k,295) = (rxt(k,696)* y(k,147) +rxt(k,697)* y(k,149) +rxt(k,693) & + * y(k,250) +rxt(k,694)* y(k,251) +rxt(k,695)* y(k,256) +rxt(k,698) & + * y(k,300) +rxt(k,699)* y(k,302) + het_rates(k,299))* y(k,299) + prod(k,295) = (rxt(k,593)*y(k,235) +rxt(k,601)*y(k,236) + & + rxt(k,613)*y(k,238) +rxt(k,621)*y(k,239) +rxt(k,633)*y(k,243) + & + rxt(k,641)*y(k,244) +rxt(k,653)*y(k,279) +rxt(k,661)*y(k,280) + & + rxt(k,673)*y(k,288) +rxt(k,681)*y(k,289) +rxt(k,707)*y(k,300) + & + rxt(k,716)*y(k,301) +rxt(k,726)*y(k,302) +rxt(k,735)*y(k,303) + & + rxt(k,745)*y(k,304) +rxt(k,749)*y(k,250) +rxt(k,750)*y(k,251) + & + .490_r8*rxt(k,751)*y(k,256) +rxt(k,752)*y(k,147) + & + rxt(k,753)*y(k,149) +2.000_r8*rxt(k,754)*y(k,305))*y(k,305) & + + (rxt(k,98) +.290_r8*rxt(k,748)*y(k,293))*y(k,205) +rxt(k,93) & + *y(k,200) +.860_r8*rxt(k,771)*y(k,293)*y(k,214) + loss(k,301) = (rxt(k,704)* y(k,147) +rxt(k,684)* y(k,148) +rxt(k,705) & + * y(k,149) +rxt(k,591)* y(k,235) +rxt(k,599)* y(k,236) +rxt(k,611) & + * y(k,238) +rxt(k,619)* y(k,239) +rxt(k,631)* y(k,243) +rxt(k,639) & + * y(k,244) +rxt(k,701)* y(k,250) +rxt(k,702)* y(k,251) +rxt(k,703) & + * y(k,256) +rxt(k,651)* y(k,279) +rxt(k,659)* y(k,280) +rxt(k,671) & + * y(k,288) +rxt(k,679)* y(k,289) +rxt(k,698)* y(k,299) & + + 2._r8*rxt(k,706)* y(k,300) +rxt(k,714)* y(k,301) +rxt(k,724) & + * y(k,302) +rxt(k,733)* y(k,303) +rxt(k,743)* y(k,304) +rxt(k,707) & + * y(k,305) + het_rates(k,300))* y(k,300) + prod(k,301) = (rxt(k,717)*y(k,201) +.710_r8*rxt(k,746)*y(k,206) + & + .140_r8*rxt(k,771)*y(k,214))*y(k,293) + (.270_r8*rxt(k,602)*y(k,4) + & + .300_r8*rxt(k,642)*y(k,17))*y(k,157) + (rxt(k,95) +rxt(k,790)) & + *y(k,202) +rxt(k,708)*y(k,201)*y(k,149) + loss(k,297) = (rxt(k,712)* y(k,147) +rxt(k,713)* y(k,149) +rxt(k,709) & + * y(k,250) +rxt(k,710)* y(k,251) +rxt(k,711)* y(k,256) +rxt(k,715) & + * y(k,302) +rxt(k,716)* y(k,305) + het_rates(k,301))* y(k,301) + prod(k,297) = (rxt(k,591)*y(k,235) +rxt(k,599)*y(k,236) + & + rxt(k,611)*y(k,238) +rxt(k,619)*y(k,239) +rxt(k,631)*y(k,243) + & + rxt(k,639)*y(k,244) +rxt(k,651)*y(k,279) +rxt(k,659)*y(k,280) + & + rxt(k,671)*y(k,288) +rxt(k,679)*y(k,289) + & + 2.000_r8*rxt(k,698)*y(k,299) +rxt(k,701)*y(k,250) + & + rxt(k,702)*y(k,251) +.490_r8*rxt(k,703)*y(k,256) + & + rxt(k,704)*y(k,147) +rxt(k,705)*y(k,149) + & + 2.000_r8*rxt(k,706)*y(k,300) +rxt(k,707)*y(k,305) + & + rxt(k,724)*y(k,302) +rxt(k,733)*y(k,303) +rxt(k,743)*y(k,304)) & + *y(k,300) + (rxt(k,693)*y(k,250) +.500_r8*rxt(k,694)*y(k,251) + & + .700_r8*rxt(k,696)*y(k,147) +rxt(k,697)*y(k,149) + & + rxt(k,699)*y(k,302) +rxt(k,700)*y(k,305))*y(k,299) + (rxt(k,99) + & + .290_r8*rxt(k,746)*y(k,293))*y(k,206) +.330_r8*rxt(k,602)*y(k,157) & + *y(k,4) +.230_r8*rxt(k,756)*y(k,293)*y(k,200) +rxt(k,94)*y(k,201) + loss(k,299) = (rxt(k,722)* y(k,147) +rxt(k,685)* y(k,148) +rxt(k,723) & * y(k,149) +rxt(k,592)* y(k,235) +rxt(k,600)* y(k,236) +rxt(k,612) & * y(k,238) +rxt(k,620)* y(k,239) +rxt(k,632)* y(k,243) +rxt(k,640) & - * y(k,244) +rxt(k,702)* y(k,250) +rxt(k,703)* y(k,251) +rxt(k,704) & + * y(k,244) +rxt(k,719)* y(k,250) +rxt(k,720)* y(k,251) +rxt(k,721) & * y(k,256) +rxt(k,652)* y(k,279) +rxt(k,660)* y(k,280) +rxt(k,672) & - * y(k,288) +rxt(k,680)* y(k,289) +rxt(k,699)* y(k,299) & - + 2._r8*rxt(k,707)* y(k,300) +rxt(k,715)* y(k,301) +rxt(k,725) & - * y(k,302) +rxt(k,734)* y(k,303) +rxt(k,744)* y(k,304) +rxt(k,708) & - * y(k,305) + het_rates(k,300))* y(k,300) - prod(k,266) = (rxt(k,718)*y(k,201) +.710_r8*rxt(k,747)*y(k,206) + & - .140_r8*rxt(k,772)*y(k,214))*y(k,293) + (.270_r8*rxt(k,603)*y(k,4) + & - .300_r8*rxt(k,643)*y(k,17))*y(k,157) + (rxt(k,95) +rxt(k,791)) & - *y(k,202) +rxt(k,709)*y(k,201)*y(k,149) - loss(k,265) = (rxt(k,713)* y(k,147) +rxt(k,714)* y(k,149) +rxt(k,710) & - * y(k,250) +rxt(k,711)* y(k,251) +rxt(k,712)* y(k,256) +rxt(k,716) & - * y(k,302) +rxt(k,717)* y(k,305) + het_rates(k,301))* y(k,301) - prod(k,265) = (rxt(k,592)*y(k,235) +rxt(k,600)*y(k,236) + & + * y(k,288) +rxt(k,680)* y(k,289) +rxt(k,699)* y(k,299) +rxt(k,724) & + * y(k,300) +rxt(k,715)* y(k,301) + 2._r8*rxt(k,725)* y(k,302) & + +rxt(k,734)* y(k,303) +rxt(k,744)* y(k,304) +rxt(k,726)* y(k,305) & + + het_rates(k,302))* y(k,302) + prod(k,299) = (.750_r8*rxt(k,736)*y(k,203) +.710_r8*rxt(k,747)*y(k,207) + & + .170_r8*rxt(k,763)*y(k,210))*y(k,293) + (rxt(k,97) +rxt(k,791)) & + *y(k,204) +.330_r8*rxt(k,662)*y(k,157)*y(k,125) +rxt(k,727)*y(k,203) & + *y(k,149) + loss(k,276) = (rxt(k,731)* y(k,147) +rxt(k,732)* y(k,149) +rxt(k,728) & + * y(k,250) +rxt(k,729)* y(k,251) +rxt(k,730)* y(k,256) +rxt(k,733) & + * y(k,300) +rxt(k,734)* y(k,302) +rxt(k,735)* y(k,305) & + + het_rates(k,303))* y(k,303) + prod(k,276) = (rxt(k,709)*y(k,250) +rxt(k,710)*y(k,251) + & + .380_r8*rxt(k,711)*y(k,256) +.830_r8*rxt(k,712)*y(k,147) + & + rxt(k,713)*y(k,149) +rxt(k,714)*y(k,300) +rxt(k,715)*y(k,302) + & + rxt(k,716)*y(k,305))*y(k,301) + loss(k,296) = (rxt(k,741)* y(k,147) +rxt(k,742)* y(k,149) +rxt(k,738) & + * y(k,250) +rxt(k,739)* y(k,251) +rxt(k,740)* y(k,256) +rxt(k,743) & + * y(k,300) +rxt(k,745)* y(k,305) + het_rates(k,304))* y(k,304) + prod(k,296) = (rxt(k,592)*y(k,235) +rxt(k,600)*y(k,236) + & rxt(k,612)*y(k,238) +rxt(k,620)*y(k,239) +rxt(k,632)*y(k,243) + & rxt(k,640)*y(k,244) +rxt(k,652)*y(k,279) +rxt(k,660)*y(k,280) + & - rxt(k,672)*y(k,288) +rxt(k,680)*y(k,289) + & - 2.000_r8*rxt(k,699)*y(k,299) +rxt(k,702)*y(k,250) + & - rxt(k,703)*y(k,251) +.490_r8*rxt(k,704)*y(k,256) + & - rxt(k,705)*y(k,147) +rxt(k,706)*y(k,149) + & - 2.000_r8*rxt(k,707)*y(k,300) +rxt(k,708)*y(k,305) + & - rxt(k,725)*y(k,302) +rxt(k,734)*y(k,303) +rxt(k,744)*y(k,304)) & - *y(k,300) + (rxt(k,694)*y(k,250) +.500_r8*rxt(k,695)*y(k,251) + & - .700_r8*rxt(k,697)*y(k,147) +rxt(k,698)*y(k,149) + & - rxt(k,700)*y(k,302) +rxt(k,701)*y(k,305))*y(k,299) + (rxt(k,99) + & - .290_r8*rxt(k,747)*y(k,293))*y(k,206) +.330_r8*rxt(k,603)*y(k,157) & - *y(k,4) +.230_r8*rxt(k,757)*y(k,293)*y(k,200) +rxt(k,94)*y(k,201) - loss(k,267) = (rxt(k,723)* y(k,147) +rxt(k,686)* y(k,148) +rxt(k,724) & + rxt(k,672)*y(k,288) +rxt(k,680)*y(k,289) +rxt(k,699)*y(k,299) + & + rxt(k,715)*y(k,301) +rxt(k,719)*y(k,250) +rxt(k,720)*y(k,251) + & + .490_r8*rxt(k,721)*y(k,256) +rxt(k,722)*y(k,147) + & + rxt(k,723)*y(k,149) +rxt(k,724)*y(k,300) + & + 2.000_r8*rxt(k,725)*y(k,302) +rxt(k,726)*y(k,305) + & + 2.000_r8*rxt(k,734)*y(k,303))*y(k,302) + (rxt(k,728)*y(k,250) + & + rxt(k,729)*y(k,251) +.150_r8*rxt(k,730)*y(k,256) + & + .700_r8*rxt(k,731)*y(k,147) +rxt(k,732)*y(k,149) + & + rxt(k,733)*y(k,300) +rxt(k,735)*y(k,305))*y(k,303) + (rxt(k,96) + & + .250_r8*rxt(k,736)*y(k,293))*y(k,203) + (rxt(k,100) + & + .290_r8*rxt(k,747)*y(k,293))*y(k,207) + loss(k,300) = (rxt(k,752)* y(k,147) +rxt(k,686)* y(k,148) +rxt(k,753) & * y(k,149) +rxt(k,593)* y(k,235) +rxt(k,601)* y(k,236) +rxt(k,613) & * y(k,238) +rxt(k,621)* y(k,239) +rxt(k,633)* y(k,243) +rxt(k,641) & - * y(k,244) +rxt(k,720)* y(k,250) +rxt(k,721)* y(k,251) +rxt(k,722) & + * y(k,244) +rxt(k,749)* y(k,250) +rxt(k,750)* y(k,251) +rxt(k,751) & * y(k,256) +rxt(k,653)* y(k,279) +rxt(k,661)* y(k,280) +rxt(k,673) & - * y(k,288) +rxt(k,681)* y(k,289) +rxt(k,700)* y(k,299) +rxt(k,725) & - * y(k,300) +rxt(k,716)* y(k,301) + 2._r8*rxt(k,726)* y(k,302) & - +rxt(k,735)* y(k,303) +rxt(k,745)* y(k,304) +rxt(k,727)* y(k,305) & - + het_rates(k,302))* y(k,302) - prod(k,267) = (.750_r8*rxt(k,737)*y(k,203) +.710_r8*rxt(k,748)*y(k,207) + & - .170_r8*rxt(k,764)*y(k,210))*y(k,293) + (rxt(k,97) +rxt(k,792)) & - *y(k,204) +.330_r8*rxt(k,663)*y(k,157)*y(k,125) +rxt(k,728)*y(k,203) & - *y(k,149) - loss(k,248) = (rxt(k,732)* y(k,147) +rxt(k,733)* y(k,149) +rxt(k,729) & - * y(k,250) +rxt(k,730)* y(k,251) +rxt(k,731)* y(k,256) +rxt(k,734) & - * y(k,300) +rxt(k,735)* y(k,302) +rxt(k,736)* y(k,305) & - + het_rates(k,303))* y(k,303) - prod(k,248) = (rxt(k,710)*y(k,250) +rxt(k,711)*y(k,251) + & - .380_r8*rxt(k,712)*y(k,256) +.830_r8*rxt(k,713)*y(k,147) + & - rxt(k,714)*y(k,149) +rxt(k,715)*y(k,300) +rxt(k,716)*y(k,302) + & - rxt(k,717)*y(k,305))*y(k,301) - loss(k,264) = (rxt(k,742)* y(k,147) +rxt(k,743)* y(k,149) +rxt(k,739) & - * y(k,250) +rxt(k,740)* y(k,251) +rxt(k,741)* y(k,256) +rxt(k,744) & - * y(k,300) +rxt(k,746)* y(k,305) + het_rates(k,304))* y(k,304) - prod(k,264) = (rxt(k,593)*y(k,235) +rxt(k,601)*y(k,236) + & - rxt(k,613)*y(k,238) +rxt(k,621)*y(k,239) +rxt(k,633)*y(k,243) + & - rxt(k,641)*y(k,244) +rxt(k,653)*y(k,279) +rxt(k,661)*y(k,280) + & - rxt(k,673)*y(k,288) +rxt(k,681)*y(k,289) +rxt(k,700)*y(k,299) + & - rxt(k,716)*y(k,301) +rxt(k,720)*y(k,250) +rxt(k,721)*y(k,251) + & - .490_r8*rxt(k,722)*y(k,256) +rxt(k,723)*y(k,147) + & - rxt(k,724)*y(k,149) +rxt(k,725)*y(k,300) + & - 2.000_r8*rxt(k,726)*y(k,302) +rxt(k,727)*y(k,305) + & - 2.000_r8*rxt(k,735)*y(k,303))*y(k,302) + (rxt(k,729)*y(k,250) + & - rxt(k,730)*y(k,251) +.150_r8*rxt(k,731)*y(k,256) + & - .700_r8*rxt(k,732)*y(k,147) +rxt(k,733)*y(k,149) + & - rxt(k,734)*y(k,300) +rxt(k,736)*y(k,305))*y(k,303) + (rxt(k,96) + & - .250_r8*rxt(k,737)*y(k,293))*y(k,203) + (rxt(k,100) + & - .290_r8*rxt(k,748)*y(k,293))*y(k,207) - loss(k,268) = (rxt(k,753)* y(k,147) +rxt(k,687)* y(k,148) +rxt(k,754) & - * y(k,149) +rxt(k,594)* y(k,235) +rxt(k,602)* y(k,236) +rxt(k,614) & - * y(k,238) +rxt(k,622)* y(k,239) +rxt(k,634)* y(k,243) +rxt(k,642) & - * y(k,244) +rxt(k,750)* y(k,250) +rxt(k,751)* y(k,251) +rxt(k,752) & - * y(k,256) +rxt(k,654)* y(k,279) +rxt(k,662)* y(k,280) +rxt(k,674) & - * y(k,288) +rxt(k,682)* y(k,289) +rxt(k,701)* y(k,299) +rxt(k,708) & - * y(k,300) +rxt(k,717)* y(k,301) +rxt(k,727)* y(k,302) +rxt(k,736) & - * y(k,303) +rxt(k,746)* y(k,304) + 2._r8*rxt(k,755)* y(k,305) & + * y(k,288) +rxt(k,681)* y(k,289) +rxt(k,700)* y(k,299) +rxt(k,707) & + * y(k,300) +rxt(k,716)* y(k,301) +rxt(k,726)* y(k,302) +rxt(k,735) & + * y(k,303) +rxt(k,745)* y(k,304) + 2._r8*rxt(k,754)* y(k,305) & + het_rates(k,305))* y(k,305) - prod(k,268) = (rxt(k,756)*y(k,149) +.770_r8*rxt(k,757)*y(k,293))*y(k,200) & - + (rxt(k,101) +rxt(k,793))*y(k,208) +.710_r8*rxt(k,749)*y(k,293) & + prod(k,300) = (rxt(k,755)*y(k,149) +.770_r8*rxt(k,756)*y(k,293))*y(k,200) & + + (rxt(k,101) +rxt(k,792))*y(k,208) +.710_r8*rxt(k,748)*y(k,293) & *y(k,205) - loss(k,145) = (rxt(k,762)* y(k,147) +rxt(k,761)* y(k,256) + het_rates(k,306)) & + loss(k,172) = (rxt(k,761)* y(k,147) +rxt(k,760)* y(k,256) + het_rates(k,306)) & * y(k,306) - prod(k,145) =.830_r8*rxt(k,764)*y(k,293)*y(k,210) - loss(k,162) = (rxt(k,767)* y(k,147) +rxt(k,766)* y(k,256) + het_rates(k,307)) & + prod(k,172) =.830_r8*rxt(k,763)*y(k,293)*y(k,210) + loss(k,188) = (rxt(k,766)* y(k,147) +rxt(k,765)* y(k,256) + het_rates(k,307)) & * y(k,307) - prod(k,162) =rxt(k,769)*y(k,293)*y(k,211) - loss(k,189) = (rxt(k,774)* y(k,147) +rxt(k,773)* y(k,256) + het_rates(k,308)) & + prod(k,188) =rxt(k,768)*y(k,293)*y(k,211) + loss(k,212) = (rxt(k,773)* y(k,147) +rxt(k,772)* y(k,256) + het_rates(k,308)) & * y(k,308) - prod(k,189) =rxt(k,775)*y(k,293)*y(k,216) - loss(k,170) = (rxt(k,778)* y(k,147) +rxt(k,777)* y(k,256) + het_rates(k,309)) & + prod(k,212) =rxt(k,774)*y(k,293)*y(k,216) + loss(k,195) = (rxt(k,777)* y(k,147) +rxt(k,776)* y(k,256) + het_rates(k,309)) & * y(k,309) - prod(k,170) =rxt(k,779)*y(k,293)*y(k,218) - loss(k,146) = (rxt(k,782)* y(k,147) +rxt(k,781)* y(k,256) + het_rates(k,310)) & + prod(k,195) =rxt(k,778)*y(k,293)*y(k,218) + loss(k,173) = (rxt(k,781)* y(k,147) +rxt(k,780)* y(k,256) + het_rates(k,310)) & * y(k,310) - prod(k,146) =rxt(k,783)*y(k,293)*y(k,220) - loss(k,147) = (rxt(k,786)* y(k,147) +rxt(k,785)* y(k,256) + het_rates(k,311)) & + prod(k,173) =rxt(k,782)*y(k,293)*y(k,220) + loss(k,174) = (rxt(k,785)* y(k,147) +rxt(k,784)* y(k,256) + het_rates(k,311)) & * y(k,311) - prod(k,147) =rxt(k,787)*y(k,293)*y(k,222) - loss(k,153) = (rxt(k,573)* y(k,147) +rxt(k,572)* y(k,256) + het_rates(k,312)) & + prod(k,174) =rxt(k,786)*y(k,293)*y(k,222) + loss(k,180) = (rxt(k,572)* y(k,147) +rxt(k,571)* y(k,256) + het_rates(k,312)) & * y(k,312) - prod(k,153) = (rxt(k,574)*y(k,225) +.650_r8*rxt(k,575)*y(k,226))*y(k,293) - loss(k,45) = (rxt(k,881)* y(k,147) +rxt(k,880)* y(k,256) + het_rates(k,313)) & + prod(k,180) = (rxt(k,573)*y(k,225) +.650_r8*rxt(k,574)*y(k,226))*y(k,293) + loss(k,54) = (rxt(k,880)* y(k,147) +rxt(k,879)* y(k,256) + het_rates(k,313)) & * y(k,313) - prod(k,45) =rxt(k,879)*y(k,293)*y(k,226) - loss(k,154) = (rxt(k,579)* y(k,147) +rxt(k,578)* y(k,256) + het_rates(k,314)) & + prod(k,54) =rxt(k,878)*y(k,293)*y(k,226) + loss(k,181) = (rxt(k,578)* y(k,147) +rxt(k,577)* y(k,256) + het_rates(k,314)) & * y(k,314) - prod(k,154) = (.560_r8*rxt(k,577)*y(k,227) +rxt(k,580)*y(k,228))*y(k,293) - loss(k,46) = (rxt(k,884)* y(k,147) +rxt(k,883)* y(k,256) + het_rates(k,315)) & + prod(k,181) = (.560_r8*rxt(k,576)*y(k,227) +rxt(k,579)*y(k,228))*y(k,293) + loss(k,55) = (rxt(k,883)* y(k,147) +rxt(k,882)* y(k,256) + het_rates(k,315)) & * y(k,315) - prod(k,46) =rxt(k,882)*y(k,293)*y(k,227) - loss(k,115) = (rxt(k,582)* y(k,147) +rxt(k,581)* y(k,256) + het_rates(k,316)) & + prod(k,55) =rxt(k,881)*y(k,293)*y(k,227) + loss(k,140) = (rxt(k,581)* y(k,147) +rxt(k,580)* y(k,256) + het_rates(k,316)) & * y(k,316) - prod(k,115) = (.300_r8*rxt(k,583)*y(k,229) +rxt(k,584)*y(k,230))*y(k,293) - loss(k,286) = (rxt(k,277)* y(k,75) +rxt(k,810)* y(k,175) +rxt(k,169) & + prod(k,140) = (.300_r8*rxt(k,582)*y(k,229) +rxt(k,583)*y(k,230))*y(k,293) + loss(k,315) = (rxt(k,277)* y(k,75) +rxt(k,809)* y(k,175) +rxt(k,169) & * y(k,292) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,317)) & * y(k,317) - prod(k,286) = (rxt(k,282)*y(k,42) +rxt(k,284)*y(k,44) +rxt(k,285)*y(k,45) + & - rxt(k,287)*y(k,47) +rxt(k,292)*y(k,86) +rxt(k,308)*y(k,55) + & - rxt(k,185)*y(k,79) +rxt(k,186)*y(k,81) +rxt(k,187)*y(k,256) + & + prod(k,315) = (rxt(k,185)*y(k,79) +rxt(k,186)*y(k,81) +rxt(k,187)*y(k,256) + & rxt(k,190)*y(k,293) +rxt(k,193)*y(k,94) +rxt(k,215)*y(k,93) + & rxt(k,239)*y(k,87) +rxt(k,242)*y(k,96) +rxt(k,268)*y(k,83) + & - rxt(k,301)*y(k,43) +rxt(k,307)*y(k,54) +rxt(k,311)*y(k,90) + & - rxt(k,312)*y(k,92) +rxt(k,332)*y(k,29) +rxt(k,334)*y(k,46) + & - rxt(k,340)*y(k,51) +rxt(k,341)*y(k,52) +rxt(k,359)*y(k,31) + & - rxt(k,360)*y(k,32) +rxt(k,362)*y(k,50) +rxt(k,368)*y(k,169) + & - rxt(k,372)*y(k,170) +rxt(k,374)*y(k,49) + & - .450_r8*rxt(k,387)*y(k,126) +rxt(k,776)*y(k,215) + & - rxt(k,780)*y(k,217) +rxt(k,811)*y(k,143))*y(k,293) & - + (rxt(k,886)*y(k,96) +rxt(k,892)*y(k,96) +rxt(k,893)*y(k,95) + & - rxt(k,897)*y(k,96) +rxt(k,898)*y(k,95))*y(k,87) & - + (rxt(k,180)*y(k,78) +.300_r8*rxt(k,313)*y(k,257))*y(k,256) & - +rxt(k,153)*y(k,82) + rxt(k,282)*y(k,42) +rxt(k,284)*y(k,44) +rxt(k,285)*y(k,45) + & + rxt(k,287)*y(k,47) +rxt(k,292)*y(k,86) +rxt(k,301)*y(k,43) + & + rxt(k,307)*y(k,54) +rxt(k,308)*y(k,55) +rxt(k,310)*y(k,90) + & + rxt(k,311)*y(k,92) +rxt(k,331)*y(k,29) +rxt(k,333)*y(k,46) + & + rxt(k,339)*y(k,51) +rxt(k,340)*y(k,52) +rxt(k,358)*y(k,31) + & + rxt(k,359)*y(k,32) +rxt(k,361)*y(k,50) +rxt(k,367)*y(k,169) + & + rxt(k,371)*y(k,170) +rxt(k,373)*y(k,49) + & + .450_r8*rxt(k,386)*y(k,126) +rxt(k,775)*y(k,215) + & + rxt(k,779)*y(k,217) +rxt(k,810)*y(k,143))*y(k,293) & + + (rxt(k,885)*y(k,96) +rxt(k,891)*y(k,96) +rxt(k,892)*y(k,95) + & + rxt(k,896)*y(k,96) +rxt(k,897)*y(k,95))*y(k,87) + (rxt(k,812) + & + rxt(k,180)*y(k,78) +.300_r8*rxt(k,312)*y(k,257))*y(k,256) & + +.050_r8*rxt(k,39)*y(k,55) +rxt(k,153)*y(k,82) end do end subroutine imp_prod_loss end module mo_prod_loss diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/mo_rxt_rates_conv.F90 index 68c2092c5a..96174001a5 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/mo_rxt_rates_conv.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/mo_rxt_rates_conv.F90 @@ -316,496 +316,496 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 53)*sol(:ncol,:, 293) ! rate_const*CH3OH*OH rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 54)*sol(:ncol,:, 293) ! rate_const*CH3OOH*OH rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 55)*sol(:ncol,:, 293) ! rate_const*CH4*OH - rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 63)*sol(:ncol,:, 293) ! rate_const*M*CO*OH - rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 88)*sol(:ncol,:, 293) ! rate_const*M*HCN*OH - rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 90)*sol(:ncol,:, 293) ! rate_const*HCOOH*OH - rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 92)*sol(:ncol,:, 293) ! rate_const*HMHP*OH - rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 257)*sol(:ncol,:, 256) ! rate_const*HOCH2OO*HO2 - rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 257) ! rate_const*HOCH2OO - rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 257)*sol(:ncol,:, 147) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 88)*sol(:ncol,:, 293) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 90)*sol(:ncol,:, 293) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 92)*sol(:ncol,:, 293) ! rate_const*HMHP*OH + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 257)*sol(:ncol,:, 256) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 257) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 257)*sol(:ncol,:, 147) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 292)*sol(:ncol,:, 55) ! rate_const*O1D*CH4 rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 292)*sol(:ncol,:, 55) ! rate_const*O1D*CH4 rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 292)*sol(:ncol,:, 55) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 292)*sol(:ncol,:, 55) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 292)*sol(:ncol,:, 88) ! rate_const*O1D*HCN - rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 63)*sol(:ncol,:, 293) ! rate_const*CO*OH - rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 25)*sol(:ncol,:, 57) ! rate_const*M*C2H2*CL - rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 25)*sol(:ncol,:, 293) ! rate_const*M*C2H2*OH - rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 26)*sol(:ncol,:, 57) ! rate_const*M*C2H4*CL - rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 26)*sol(:ncol,:, 157) ! rate_const*C2H4*O3 - rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 247)*sol(:ncol,:, 247) ! rate_const*C2H5O2*C2H5O2 - rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 247)*sol(:ncol,:, 251) ! rate_const*C2H5O2*CH3O2 - rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 247)*sol(:ncol,:, 256) ! rate_const*C2H5O2*HO2 - rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 247)*sol(:ncol,:, 147) ! rate_const*C2H5O2*NO - rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 27)*sol(:ncol,:, 293) ! rate_const*C2H5OH*OH - rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 28)*sol(:ncol,:, 293) ! rate_const*C2H5OOH*OH - rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 29)*sol(:ncol,:, 57) ! rate_const*C2H6*CL - rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 29)*sol(:ncol,:, 293) ! rate_const*C2H6*OH - rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 46)*sol(:ncol,:, 149) ! rate_const*CH3CHO*NO3 - rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 46)*sol(:ncol,:, 293) ! rate_const*CH3CHO*OH - rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 48)*sol(:ncol,:, 293) ! rate_const*CH3CN*OH - rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 250)*sol(:ncol,:, 250) ! rate_const*CH3CO3*CH3CO3 - rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 250)*sol(:ncol,:, 251) ! rate_const*CH3CO3*CH3O2 - rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 250)*sol(:ncol,:, 256) ! rate_const*CH3CO3*HO2 - rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 250)*sol(:ncol,:, 147) ! rate_const*CH3CO3*NO - rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 51)*sol(:ncol,:, 293) ! rate_const*CH3COOH*OH - rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 52)*sol(:ncol,:, 293) ! rate_const*CH3COOOH*OH - rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 255)*sol(:ncol,:, 256) ! rate_const*EO2*HO2 - rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 255)*sol(:ncol,:, 147) ! rate_const*EO2*NO - rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 254) ! rate_const*EO - rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 254) ! rate_const*O2*EO - rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 76)*sol(:ncol,:, 293) ! rate_const*GLYALD*OH - rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 77)*sol(:ncol,:, 293) ! rate_const*GLYOXAL*OH - rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 89)*sol(:ncol,:, 293) ! rate_const*HCOCH2OOH*OH - rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 150)*sol(:ncol,:, 293) ! rate_const*NO3CH2CHO*OH - rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 162)*sol(:ncol,:, 293) ! rate_const*PAN*OH - rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 26)*sol(:ncol,:, 293) ! rate_const*M*C2H4*OH - rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 250)*sol(:ncol,:, 148) ! rate_const*M*CH3CO3*NO2 - rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 162) ! rate_const*M*PAN - rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 30)*sol(:ncol,:, 149) ! rate_const*C3H6*NO3 - rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 30)*sol(:ncol,:, 157) ! rate_const*C3H6*O3 - rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 248)*sol(:ncol,:, 251) ! rate_const*C3H7O2*CH3O2 - rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 248)*sol(:ncol,:, 256) ! rate_const*C3H7O2*HO2 - rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 248)*sol(:ncol,:, 147) ! rate_const*C3H7O2*NO - rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 31)*sol(:ncol,:, 293) ! rate_const*C3H7OOH*OH - rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 32)*sol(:ncol,:, 293) ! rate_const*C3H8*OH - rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 50)*sol(:ncol,:, 149) ! rate_const*CH3COCHO*NO3 - rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 50)*sol(:ncol,:, 293) ! rate_const*CH3COCHO*OH - rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 102)*sol(:ncol,:, 293) ! rate_const*HYAC*OH - rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 104)*sol(:ncol,:, 293) ! rate_const*HYPERACET*OH - rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 151)*sol(:ncol,:, 293) ! rate_const*NOA*OH - rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 295)*sol(:ncol,:, 256) ! rate_const*PO2*HO2 - rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 295)*sol(:ncol,:, 147) ! rate_const*PO2*NO - rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 169)*sol(:ncol,:, 293) ! rate_const*POOH*OH - rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 296)*sol(:ncol,:, 251) ! rate_const*RO2*CH3O2 - rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 296)*sol(:ncol,:, 256) ! rate_const*RO2*HO2 - rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 296)*sol(:ncol,:, 147) ! rate_const*RO2*NO - rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 170)*sol(:ncol,:, 293) ! rate_const*ROOH*OH - rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 30)*sol(:ncol,:, 293) ! rate_const*M*C3H6*OH - rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 49)*sol(:ncol,:, 293) ! rate_const*CH3COCH3*OH - rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 16)*sol(:ncol,:, 149) ! rate_const*BIGENE*NO3 - rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 16)*sol(:ncol,:, 293) ! rate_const*BIGENE*OH - rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 68)*sol(:ncol,:, 293) ! rate_const*DHPMPAL*OH + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 292)*sol(:ncol,:, 88) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 63)*sol(:ncol,:, 293) ! rate_const*CO*OH + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 25)*sol(:ncol,:, 57) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 25)*sol(:ncol,:, 293) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 26)*sol(:ncol,:, 57) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 26)*sol(:ncol,:, 157) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 247)*sol(:ncol,:, 247) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 247)*sol(:ncol,:, 251) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 247)*sol(:ncol,:, 256) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 247)*sol(:ncol,:, 147) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 27)*sol(:ncol,:, 293) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 28)*sol(:ncol,:, 293) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 29)*sol(:ncol,:, 57) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 29)*sol(:ncol,:, 293) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 46)*sol(:ncol,:, 149) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 46)*sol(:ncol,:, 293) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 48)*sol(:ncol,:, 293) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 250)*sol(:ncol,:, 250) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 250)*sol(:ncol,:, 251) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 250)*sol(:ncol,:, 256) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 250)*sol(:ncol,:, 147) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 51)*sol(:ncol,:, 293) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 52)*sol(:ncol,:, 293) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 255)*sol(:ncol,:, 256) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 255)*sol(:ncol,:, 147) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 254) ! rate_const*EO + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 254) ! rate_const*O2*EO + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 76)*sol(:ncol,:, 293) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 77)*sol(:ncol,:, 293) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 89)*sol(:ncol,:, 293) ! rate_const*HCOCH2OOH*OH + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 150)*sol(:ncol,:, 293) ! rate_const*NO3CH2CHO*OH + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 162)*sol(:ncol,:, 293) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 26)*sol(:ncol,:, 293) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 250)*sol(:ncol,:, 148) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 162) ! rate_const*M*PAN + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 30)*sol(:ncol,:, 149) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 30)*sol(:ncol,:, 157) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 248)*sol(:ncol,:, 251) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 248)*sol(:ncol,:, 256) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 248)*sol(:ncol,:, 147) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 31)*sol(:ncol,:, 293) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 32)*sol(:ncol,:, 293) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 50)*sol(:ncol,:, 149) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 50)*sol(:ncol,:, 293) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 102)*sol(:ncol,:, 293) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 104)*sol(:ncol,:, 293) ! rate_const*HYPERACET*OH + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 151)*sol(:ncol,:, 293) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 295)*sol(:ncol,:, 256) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 295)*sol(:ncol,:, 147) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 169)*sol(:ncol,:, 293) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 296)*sol(:ncol,:, 251) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 296)*sol(:ncol,:, 256) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 296)*sol(:ncol,:, 147) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 170)*sol(:ncol,:, 293) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 30)*sol(:ncol,:, 293) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 49)*sol(:ncol,:, 293) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 16)*sol(:ncol,:, 149) ! rate_const*BIGENE*NO3 + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 16)*sol(:ncol,:, 293) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 68)*sol(:ncol,:, 293) ! rate_const*DHPMPAL*OH + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 253)*sol(:ncol,:, 147) ! rate_const*ENEO2*NO rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 253)*sol(:ncol,:, 147) ! rate_const*ENEO2*NO - rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 253)*sol(:ncol,:, 147) ! rate_const*ENEO2*NO - rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 97)*sol(:ncol,:, 293) ! rate_const*HONITR*OH - rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 127)*sol(:ncol,:, 293) ! rate_const*MACRN*OH - rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 282)*sol(:ncol,:, 250) ! rate_const*MACRO2*CH3CO3 - rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 282)*sol(:ncol,:, 251) ! rate_const*MACRO2*CH3O2 - rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 282)*sol(:ncol,:, 256) ! rate_const*MACRO2*HO2 - rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 282) ! rate_const*MACRO2 - rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 126)*sol(:ncol,:, 157) ! rate_const*MACR*O3 - rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 126)*sol(:ncol,:, 293) ! rate_const*MACR*OH - rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 128)*sol(:ncol,:, 293) ! rate_const*MACROOH*OH - rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 284)*sol(:ncol,:, 250) ! rate_const*MCO3*CH3CO3 - rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 284)*sol(:ncol,:, 251) ! rate_const*MCO3*CH3O2 - rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 284)*sol(:ncol,:, 256) ! rate_const*MCO3*HO2 - rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 284)*sol(:ncol,:, 284) ! rate_const*MCO3*MCO3 - rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 284)*sol(:ncol,:, 147) ! rate_const*MCO3*NO - rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 284)*sol(:ncol,:, 149) ! rate_const*MCO3*NO3 - rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 286)*sol(:ncol,:, 256) ! rate_const*MEKO2*HO2 - rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 286)*sol(:ncol,:, 147) ! rate_const*MEKO2*NO - rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 129)*sol(:ncol,:, 293) ! rate_const*MEK*OH - rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 130)*sol(:ncol,:, 293) ! rate_const*MEKOOH*OH - rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 131)*sol(:ncol,:, 293) ! rate_const*M*MPAN*OH - rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 133)*sol(:ncol,:, 293) ! rate_const*MVKN*OH - rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 287)*sol(:ncol,:, 250) ! rate_const*MVKO2*CH3CO3 - rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 287)*sol(:ncol,:, 251) ! rate_const*MVKO2*CH3O2 - rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 287)*sol(:ncol,:, 256) ! rate_const*MVKO2*HO2 - rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 132)*sol(:ncol,:, 157) ! rate_const*MVK*O3 - rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 132)*sol(:ncol,:, 293) ! rate_const*MVK*OH - rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 134)*sol(:ncol,:, 293) ! rate_const*MVKOOH*OH - rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 284)*sol(:ncol,:, 148) ! rate_const*M*MCO3*NO2 - rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 131) ! rate_const*M*MPAN - rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 1)*sol(:ncol,:, 293) ! rate_const*ALKNIT*OH - rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 234)*sol(:ncol,:, 256) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 97)*sol(:ncol,:, 293) ! rate_const*HONITR*OH + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 127)*sol(:ncol,:, 293) ! rate_const*MACRN*OH + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 282)*sol(:ncol,:, 250) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 282)*sol(:ncol,:, 251) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 282)*sol(:ncol,:, 256) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 282) ! rate_const*MACRO2 + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 126)*sol(:ncol,:, 157) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 126)*sol(:ncol,:, 293) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 128)*sol(:ncol,:, 293) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 284)*sol(:ncol,:, 250) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 284)*sol(:ncol,:, 251) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 284)*sol(:ncol,:, 256) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 284)*sol(:ncol,:, 284) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 284)*sol(:ncol,:, 147) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 284)*sol(:ncol,:, 149) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 286)*sol(:ncol,:, 256) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 286)*sol(:ncol,:, 147) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 129)*sol(:ncol,:, 293) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 130)*sol(:ncol,:, 293) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 131)*sol(:ncol,:, 293) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 133)*sol(:ncol,:, 293) ! rate_const*MVKN*OH + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 287)*sol(:ncol,:, 250) ! rate_const*MVKO2*CH3CO3 + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 287)*sol(:ncol,:, 251) ! rate_const*MVKO2*CH3O2 + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 287)*sol(:ncol,:, 256) ! rate_const*MVKO2*HO2 + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 132)*sol(:ncol,:, 157) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 132)*sol(:ncol,:, 293) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 134)*sol(:ncol,:, 293) ! rate_const*MVKOOH*OH + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 284)*sol(:ncol,:, 148) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 131) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 1)*sol(:ncol,:, 293) ! rate_const*ALKNIT*OH + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 234)*sol(:ncol,:, 256) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 234)*sol(:ncol,:, 147) ! rate_const*ALKO2*NO rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 234)*sol(:ncol,:, 147) ! rate_const*ALKO2*NO - rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 234)*sol(:ncol,:, 147) ! rate_const*ALKO2*NO - rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 2)*sol(:ncol,:, 293) ! rate_const*ALKOOH*OH - rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 15)*sol(:ncol,:, 293) ! rate_const*BIGALK*OH - rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 98)*sol(:ncol,:, 293) ! rate_const*HPALD1*OH - rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 99)*sol(:ncol,:, 293) ! rate_const*HPALD4*OH - rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 100)*sol(:ncol,:, 293) ! rate_const*HPALDB1C*OH - rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 101)*sol(:ncol,:, 293) ! rate_const*HPALDB4C*OH - rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 103)*sol(:ncol,:, 293) ! rate_const*HYDRALD*OH - rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 105)*sol(:ncol,:, 293) ! rate_const*ICHE*OH - rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 106)*sol(:ncol,:, 293) ! rate_const*IEPOX*OH - rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 258)*sol(:ncol,:, 256) ! rate_const*IEPOXOO*HO2 - rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 107)*sol(:ncol,:, 293) ! rate_const*INHEB*OH - rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 108)*sol(:ncol,:, 293) ! rate_const*INHED*OH - rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 259)*sol(:ncol,:, 250) ! rate_const*ISOPB1O2*CH3CO3 - rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 259)*sol(:ncol,:, 251) ! rate_const*ISOPB1O2*CH3O2 - rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 259)*sol(:ncol,:, 256) ! rate_const*ISOPB1O2*HO2 + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 2)*sol(:ncol,:, 293) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 15)*sol(:ncol,:, 293) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 98)*sol(:ncol,:, 293) ! rate_const*HPALD1*OH + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 99)*sol(:ncol,:, 293) ! rate_const*HPALD4*OH + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 100)*sol(:ncol,:, 293) ! rate_const*HPALDB1C*OH + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 101)*sol(:ncol,:, 293) ! rate_const*HPALDB4C*OH + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 103)*sol(:ncol,:, 293) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 105)*sol(:ncol,:, 293) ! rate_const*ICHE*OH + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 106)*sol(:ncol,:, 293) ! rate_const*IEPOX*OH + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 258)*sol(:ncol,:, 256) ! rate_const*IEPOXOO*HO2 + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 107)*sol(:ncol,:, 293) ! rate_const*INHEB*OH + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 108)*sol(:ncol,:, 293) ! rate_const*INHED*OH + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 259)*sol(:ncol,:, 250) ! rate_const*ISOPB1O2*CH3CO3 + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 259)*sol(:ncol,:, 251) ! rate_const*ISOPB1O2*CH3O2 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 259)*sol(:ncol,:, 256) ! rate_const*ISOPB1O2*HO2 + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 259) ! rate_const*ISOPB1O2 rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 259) ! rate_const*ISOPB1O2 rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 259) ! rate_const*ISOPB1O2 - rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 259) ! rate_const*ISOPB1O2 - rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 260)*sol(:ncol,:, 250) ! rate_const*ISOPB4O2*CH3CO3 - rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 260)*sol(:ncol,:, 251) ! rate_const*ISOPB4O2*CH3O2 - rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 260)*sol(:ncol,:, 256) ! rate_const*ISOPB4O2*HO2 + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 260)*sol(:ncol,:, 250) ! rate_const*ISOPB4O2*CH3CO3 + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 260)*sol(:ncol,:, 251) ! rate_const*ISOPB4O2*CH3O2 + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 260)*sol(:ncol,:, 256) ! rate_const*ISOPB4O2*HO2 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 260) ! rate_const*ISOPB4O2 rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 260) ! rate_const*ISOPB4O2 rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 260) ! rate_const*ISOPB4O2 - rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 260) ! rate_const*ISOPB4O2 + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 261) ! rate_const*O2*ISOPC1C rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 261) ! rate_const*O2*ISOPC1C - rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 261) ! rate_const*O2*ISOPC1C + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 262) ! rate_const*O2*ISOPC1T rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 262) ! rate_const*O2*ISOPC1T - rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 262) ! rate_const*O2*ISOPC1T + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 263) ! rate_const*O2*ISOPC4C rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 263) ! rate_const*O2*ISOPC4C - rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 263) ! rate_const*O2*ISOPC4C + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 264) ! rate_const*O2*ISOPC4T rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 264) ! rate_const*O2*ISOPC4T - rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 264) ! rate_const*O2*ISOPC4T - rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 265)*sol(:ncol,:, 250) ! rate_const*ISOPED1O2*CH3CO3 - rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 265)*sol(:ncol,:, 251) ! rate_const*ISOPED1O2*CH3O2 - rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 265)*sol(:ncol,:, 256) ! rate_const*ISOPED1O2*HO2 - rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 265) ! rate_const*ISOPED1O2 - rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 266)*sol(:ncol,:, 250) ! rate_const*ISOPED4O2*CH3CO3 - rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 266)*sol(:ncol,:, 251) ! rate_const*ISOPED4O2*CH3O2 - rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 266)*sol(:ncol,:, 256) ! rate_const*ISOPED4O2*HO2 - rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 266) ! rate_const*ISOPED4O2 - rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 111)*sol(:ncol,:, 293) ! rate_const*ISOPFDNC*OH - rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 110)*sol(:ncol,:, 293) ! rate_const*ISOPFDN*OH - rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 112)*sol(:ncol,:, 293) ! rate_const*ISOPFNC*OH - rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 113)*sol(:ncol,:, 293) ! rate_const*ISOPFNP*OH - rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 114)*sol(:ncol,:, 293) ! rate_const*ISOPHFP*OH - rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 267)*sol(:ncol,:, 256) ! rate_const*ISOPN1DO2*HO2 - rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 267) ! rate_const*ISOPN1DO2 - rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 115)*sol(:ncol,:, 157) ! rate_const*ISOPN1D*O3 - rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 115)*sol(:ncol,:, 293) ! rate_const*ISOPN1D*OH - rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 268)*sol(:ncol,:, 256) ! rate_const*ISOPN2BO2*HO2 - rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 268) ! rate_const*ISOPN2BO2 - rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 116)*sol(:ncol,:, 293) ! rate_const*ISOPN2B*OH - rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 269)*sol(:ncol,:, 256) ! rate_const*ISOPN3BO2*HO2 - rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 269) ! rate_const*ISOPN3BO2 - rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 117)*sol(:ncol,:, 293) ! rate_const*ISOPN3B*OH - rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 270)*sol(:ncol,:, 256) ! rate_const*ISOPN4DO2*HO2 - rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 270) ! rate_const*ISOPN4DO2 - rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 118)*sol(:ncol,:, 157) ! rate_const*ISOPN4D*O3 - rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 118)*sol(:ncol,:, 293) ! rate_const*ISOPN4D*OH - rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 271)*sol(:ncol,:, 256) ! rate_const*ISOPNBNO3O2*HO2 - rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 119)*sol(:ncol,:, 293) ! rate_const*ISOPNBNO3*OH - rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 109)*sol(:ncol,:, 149) ! rate_const*ISOP*NO3 - rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 272)*sol(:ncol,:, 250) ! rate_const*ISOPNO3*CH3CO3 - rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 272)*sol(:ncol,:, 251) ! rate_const*ISOPNO3*CH3O2 - rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 272)*sol(:ncol,:, 256) ! rate_const*ISOPNO3*HO2 - rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 272)*sol(:ncol,:, 272) ! rate_const*ISOPNO3*ISOPNO3 - rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 272)*sol(:ncol,:, 149) ! rate_const*ISOPNO3*NO3 - rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 273)*sol(:ncol,:, 256) ! rate_const*ISOPNOOHBO2*HO2 - rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 273) ! rate_const*ISOPNOOHBO2 - rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 120)*sol(:ncol,:, 293) ! rate_const*ISOPNOOHB*OH - rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 274)*sol(:ncol,:, 256) ! rate_const*ISOPNOOHDO2*HO2 - rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 274) ! rate_const*ISOPNOOHDO2 - rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 121)*sol(:ncol,:, 157) ! rate_const*ISOPNOOHD*O3 - rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 121)*sol(:ncol,:, 293) ! rate_const*ISOPNOOHD*OH - rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 109)*sol(:ncol,:, 157) ! rate_const*ISOP*O3 - rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 109)*sol(:ncol,:, 293) ! rate_const*ISOP*OH - rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 122)*sol(:ncol,:, 293) ! rate_const*ISOPOH*OH + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 265)*sol(:ncol,:, 250) ! rate_const*ISOPED1O2*CH3CO3 + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 265)*sol(:ncol,:, 251) ! rate_const*ISOPED1O2*CH3O2 + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 265)*sol(:ncol,:, 256) ! rate_const*ISOPED1O2*HO2 + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 265) ! rate_const*ISOPED1O2 + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 266)*sol(:ncol,:, 250) ! rate_const*ISOPED4O2*CH3CO3 + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 266)*sol(:ncol,:, 251) ! rate_const*ISOPED4O2*CH3O2 + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 266)*sol(:ncol,:, 256) ! rate_const*ISOPED4O2*HO2 + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 266) ! rate_const*ISOPED4O2 + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 111)*sol(:ncol,:, 293) ! rate_const*ISOPFDNC*OH + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 110)*sol(:ncol,:, 293) ! rate_const*ISOPFDN*OH + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 112)*sol(:ncol,:, 293) ! rate_const*ISOPFNC*OH + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 113)*sol(:ncol,:, 293) ! rate_const*ISOPFNP*OH + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 114)*sol(:ncol,:, 293) ! rate_const*ISOPHFP*OH + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 267)*sol(:ncol,:, 256) ! rate_const*ISOPN1DO2*HO2 + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 267) ! rate_const*ISOPN1DO2 + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 115)*sol(:ncol,:, 157) ! rate_const*ISOPN1D*O3 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 115)*sol(:ncol,:, 293) ! rate_const*ISOPN1D*OH + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 268)*sol(:ncol,:, 256) ! rate_const*ISOPN2BO2*HO2 + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 268) ! rate_const*ISOPN2BO2 + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 116)*sol(:ncol,:, 293) ! rate_const*ISOPN2B*OH + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 269)*sol(:ncol,:, 256) ! rate_const*ISOPN3BO2*HO2 + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 269) ! rate_const*ISOPN3BO2 + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 117)*sol(:ncol,:, 293) ! rate_const*ISOPN3B*OH + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 270)*sol(:ncol,:, 256) ! rate_const*ISOPN4DO2*HO2 + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 270) ! rate_const*ISOPN4DO2 + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 118)*sol(:ncol,:, 157) ! rate_const*ISOPN4D*O3 + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 118)*sol(:ncol,:, 293) ! rate_const*ISOPN4D*OH + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 271)*sol(:ncol,:, 256) ! rate_const*ISOPNBNO3O2*HO2 + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 119)*sol(:ncol,:, 293) ! rate_const*ISOPNBNO3*OH + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 109)*sol(:ncol,:, 149) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 272)*sol(:ncol,:, 250) ! rate_const*ISOPNO3*CH3CO3 + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 272)*sol(:ncol,:, 251) ! rate_const*ISOPNO3*CH3O2 + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 272)*sol(:ncol,:, 256) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 272)*sol(:ncol,:, 272) ! rate_const*ISOPNO3*ISOPNO3 + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 272)*sol(:ncol,:, 149) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 273)*sol(:ncol,:, 256) ! rate_const*ISOPNOOHBO2*HO2 + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 273) ! rate_const*ISOPNOOHBO2 + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 120)*sol(:ncol,:, 293) ! rate_const*ISOPNOOHB*OH + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 274)*sol(:ncol,:, 256) ! rate_const*ISOPNOOHDO2*HO2 + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 274) ! rate_const*ISOPNOOHDO2 + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 121)*sol(:ncol,:, 157) ! rate_const*ISOPNOOHD*O3 + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 121)*sol(:ncol,:, 293) ! rate_const*ISOPNOOHD*OH + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 109)*sol(:ncol,:, 157) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 109)*sol(:ncol,:, 293) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 122)*sol(:ncol,:, 293) ! rate_const*ISOPOH*OH + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 123)*sol(:ncol,:, 293) ! rate_const*ISOPOOH*OH rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 123)*sol(:ncol,:, 293) ! rate_const*ISOPOOH*OH - rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 123)*sol(:ncol,:, 293) ! rate_const*ISOPOOH*OH - rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 276)*sol(:ncol,:, 250) ! rate_const*ISOPZD1O2*CH3CO3 - rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 276)*sol(:ncol,:, 251) ! rate_const*ISOPZD1O2*CH3O2 - rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 276)*sol(:ncol,:, 256) ! rate_const*ISOPZD1O2*HO2 - rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 276) ! rate_const*ISOPZD1O2 - rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 277)*sol(:ncol,:, 250) ! rate_const*ISOPZD4O2*CH3CO3 - rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 277)*sol(:ncol,:, 251) ! rate_const*ISOPZD4O2*CH3O2 - rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 277)*sol(:ncol,:, 256) ! rate_const*ISOPZD4O2*HO2 - rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 277) ! rate_const*ISOPZD4O2 - rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 291)*sol(:ncol,:, 256) ! rate_const*NC4CHOO2*HO2 - rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 291) ! rate_const*NC4CHOO2 - rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 139)*sol(:ncol,:, 157) ! rate_const*NC4CHO*O3 - rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 139)*sol(:ncol,:, 293) ! rate_const*NC4CHO*OH + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 276)*sol(:ncol,:, 250) ! rate_const*ISOPZD1O2*CH3CO3 + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 276)*sol(:ncol,:, 251) ! rate_const*ISOPZD1O2*CH3O2 + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 276)*sol(:ncol,:, 256) ! rate_const*ISOPZD1O2*HO2 + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 276) ! rate_const*ISOPZD1O2 + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 277)*sol(:ncol,:, 250) ! rate_const*ISOPZD4O2*CH3CO3 + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 277)*sol(:ncol,:, 251) ! rate_const*ISOPZD4O2*CH3O2 + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 277)*sol(:ncol,:, 256) ! rate_const*ISOPZD4O2*HO2 + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 277) ! rate_const*ISOPZD4O2 + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 291)*sol(:ncol,:, 256) ! rate_const*NC4CHOO2*HO2 + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 291) ! rate_const*NC4CHOO2 + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 139)*sol(:ncol,:, 157) ! rate_const*NC4CHO*O3 + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 139)*sol(:ncol,:, 293) ! rate_const*NC4CHO*OH + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 258)*sol(:ncol,:, 147) ! rate_const*IEPOXOO*NO rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 258)*sol(:ncol,:, 147) ! rate_const*IEPOXOO*NO - rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 258)*sol(:ncol,:, 147) ! rate_const*IEPOXOO*NO + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 259)*sol(:ncol,:, 147) ! rate_const*ISOPB1O2*NO rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 259)*sol(:ncol,:, 147) ! rate_const*ISOPB1O2*NO - rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 259)*sol(:ncol,:, 147) ! rate_const*ISOPB1O2*NO + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 260)*sol(:ncol,:, 147) ! rate_const*ISOPB4O2*NO rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 260)*sol(:ncol,:, 147) ! rate_const*ISOPB4O2*NO - rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 260)*sol(:ncol,:, 147) ! rate_const*ISOPB4O2*NO + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 265)*sol(:ncol,:, 147) ! rate_const*ISOPED1O2*NO rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 265)*sol(:ncol,:, 147) ! rate_const*ISOPED1O2*NO - rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 265)*sol(:ncol,:, 147) ! rate_const*ISOPED1O2*NO + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 266)*sol(:ncol,:, 147) ! rate_const*ISOPED4O2*NO rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 266)*sol(:ncol,:, 147) ! rate_const*ISOPED4O2*NO - rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 266)*sol(:ncol,:, 147) ! rate_const*ISOPED4O2*NO + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 267)*sol(:ncol,:, 147) ! rate_const*ISOPN1DO2*NO rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 267)*sol(:ncol,:, 147) ! rate_const*ISOPN1DO2*NO - rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 267)*sol(:ncol,:, 147) ! rate_const*ISOPN1DO2*NO + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 268)*sol(:ncol,:, 147) ! rate_const*ISOPN2BO2*NO rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 268)*sol(:ncol,:, 147) ! rate_const*ISOPN2BO2*NO - rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 268)*sol(:ncol,:, 147) ! rate_const*ISOPN2BO2*NO + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 269)*sol(:ncol,:, 147) ! rate_const*ISOPN3BO2*NO rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 269)*sol(:ncol,:, 147) ! rate_const*ISOPN3BO2*NO - rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 269)*sol(:ncol,:, 147) ! rate_const*ISOPN3BO2*NO + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 270)*sol(:ncol,:, 147) ! rate_const*ISOPN4DO2*NO rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 270)*sol(:ncol,:, 147) ! rate_const*ISOPN4DO2*NO - rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 270)*sol(:ncol,:, 147) ! rate_const*ISOPN4DO2*NO + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 271)*sol(:ncol,:, 147) ! rate_const*ISOPNBNO3O2*NO rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 271)*sol(:ncol,:, 147) ! rate_const*ISOPNBNO3O2*NO - rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 271)*sol(:ncol,:, 147) ! rate_const*ISOPNBNO3O2*NO + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 272)*sol(:ncol,:, 147) ! rate_const*ISOPNO3*NO rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 272)*sol(:ncol,:, 147) ! rate_const*ISOPNO3*NO - rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 272)*sol(:ncol,:, 147) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 273)*sol(:ncol,:, 147) ! rate_const*ISOPNOOHBO2*NO rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 273)*sol(:ncol,:, 147) ! rate_const*ISOPNOOHBO2*NO - rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 273)*sol(:ncol,:, 147) ! rate_const*ISOPNOOHBO2*NO + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 274)*sol(:ncol,:, 147) ! rate_const*ISOPNOOHDO2*NO rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 274)*sol(:ncol,:, 147) ! rate_const*ISOPNOOHDO2*NO - rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 274)*sol(:ncol,:, 147) ! rate_const*ISOPNOOHDO2*NO - rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 276) ! rate_const*ISOPZD1O2 + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 276) ! rate_const*ISOPZD1O2 + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 276)*sol(:ncol,:, 147) ! rate_const*ISOPZD1O2*NO rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 276)*sol(:ncol,:, 147) ! rate_const*ISOPZD1O2*NO - rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 276)*sol(:ncol,:, 147) ! rate_const*ISOPZD1O2*NO - rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 277) ! rate_const*ISOPZD4O2 + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 277) ! rate_const*ISOPZD4O2 + rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 277)*sol(:ncol,:, 147) ! rate_const*ISOPZD4O2*NO rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 277)*sol(:ncol,:, 147) ! rate_const*ISOPZD4O2*NO - rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 277)*sol(:ncol,:, 147) ! rate_const*ISOPZD4O2*NO + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 282)*sol(:ncol,:, 147) ! rate_const*MACRO2*NO rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 282)*sol(:ncol,:, 147) ! rate_const*MACRO2*NO - rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 282)*sol(:ncol,:, 147) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 287)*sol(:ncol,:, 147) ! rate_const*MVKO2*NO rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 287)*sol(:ncol,:, 147) ! rate_const*MVKO2*NO - rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 287)*sol(:ncol,:, 147) ! rate_const*MVKO2*NO + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 291)*sol(:ncol,:, 147) ! rate_const*NC4CHOO2*NO rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 291)*sol(:ncol,:, 147) ! rate_const*NC4CHOO2*NO - rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 291)*sol(:ncol,:, 147) ! rate_const*NC4CHOO2*NO - rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 233)*sol(:ncol,:, 256) ! rate_const*ACBZO2*HO2 - rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 233)*sol(:ncol,:, 147) ! rate_const*ACBZO2*NO - rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 8)*sol(:ncol,:, 293) ! rate_const*BENZENE*OH - rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 241)*sol(:ncol,:, 256) ! rate_const*BENZO2*HO2 - rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 241)*sol(:ncol,:, 147) ! rate_const*BENZO2*NO - rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 9)*sol(:ncol,:, 293) ! rate_const*BENZOOH*OH - rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 23)*sol(:ncol,:, 293) ! rate_const*BZALD*OH - rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 246)*sol(:ncol,:, 256) ! rate_const*BZOO*HO2 - rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 24)*sol(:ncol,:, 293) ! rate_const*BZOOH*OH - rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 246)*sol(:ncol,:, 147) ! rate_const*BZOO*NO - rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 249)*sol(:ncol,:, 256) ! rate_const*C6H5O2*HO2 - rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 249)*sol(:ncol,:, 147) ! rate_const*C6H5O2*NO - rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 33)*sol(:ncol,:, 293) ! rate_const*C6H5OOH*OH - rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 67)*sol(:ncol,:, 293) ! rate_const*CRESOL*OH - rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 252)*sol(:ncol,:, 256) ! rate_const*DICARBO2*HO2 - rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 252)*sol(:ncol,:, 147) ! rate_const*DICARBO2*NO - rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 252)*sol(:ncol,:, 148) ! rate_const*M*DICARBO2*NO2 - rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 283)*sol(:ncol,:, 256) ! rate_const*MALO2*HO2 - rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 283)*sol(:ncol,:, 147) ! rate_const*MALO2*NO - rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 283)*sol(:ncol,:, 148) ! rate_const*M*MALO2*NO2 - rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 285)*sol(:ncol,:, 256) ! rate_const*MDIALO2*HO2 - rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 285)*sol(:ncol,:, 147) ! rate_const*MDIALO2*NO - rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 285)*sol(:ncol,:, 148) ! rate_const*M*MDIALO2*NO2 - rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 294)*sol(:ncol,:, 256) ! rate_const*PHENO2*HO2 - rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 294)*sol(:ncol,:, 147) ! rate_const*PHENO2*NO - rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 165)*sol(:ncol,:, 293) ! rate_const*PHENOL*OH - rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 164)*sol(:ncol,:, 148) ! rate_const*PHENO*NO2 - rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 164)*sol(:ncol,:, 157) ! rate_const*PHENO*O3 - rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 166)*sol(:ncol,:, 293) ! rate_const*PHENOOH*OH - rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 233)*sol(:ncol,:, 148) ! rate_const*M*ACBZO2*NO2 - rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 312)*sol(:ncol,:, 256) ! rate_const*TOLO2*HO2 - rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 312)*sol(:ncol,:, 147) ! rate_const*TOLO2*NO - rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 225)*sol(:ncol,:, 293) ! rate_const*TOLOOH*OH - rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 226)*sol(:ncol,:, 293) ! rate_const*TOLUENE*OH - rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 163) ! rate_const*M*PBZNIT - rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 227)*sol(:ncol,:, 293) ! rate_const*XYLENES*OH - rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 314)*sol(:ncol,:, 256) ! rate_const*XYLENO2*HO2 - rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 314)*sol(:ncol,:, 147) ! rate_const*XYLENO2*NO - rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 228)*sol(:ncol,:, 293) ! rate_const*XYLENOOH*OH - rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 316)*sol(:ncol,:, 256) ! rate_const*XYLOLO2*HO2 - rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 316)*sol(:ncol,:, 147) ! rate_const*XYLOLO2*NO - rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 229)*sol(:ncol,:, 293) ! rate_const*XYLOL*OH - rxt_rates(:ncol,:, 584) = rxt_rates(:ncol,:, 584)*sol(:ncol,:, 230)*sol(:ncol,:, 293) ! rate_const*XYLOLOOH*OH - rxt_rates(:ncol,:, 585) = rxt_rates(:ncol,:, 585)*sol(:ncol,:, 4)*sol(:ncol,:, 149) ! rate_const*APIN*NO3 - rxt_rates(:ncol,:, 586) = rxt_rates(:ncol,:, 586)*sol(:ncol,:, 235)*sol(:ncol,:, 235) ! rate_const*APINNO3*APINNO3 - rxt_rates(:ncol,:, 587) = rxt_rates(:ncol,:, 587)*sol(:ncol,:, 235)*sol(:ncol,:, 250) ! rate_const*APINNO3*CH3CO3 - rxt_rates(:ncol,:, 588) = rxt_rates(:ncol,:, 588)*sol(:ncol,:, 235)*sol(:ncol,:, 251) ! rate_const*APINNO3*CH3O2 - rxt_rates(:ncol,:, 589) = rxt_rates(:ncol,:, 589)*sol(:ncol,:, 235)*sol(:ncol,:, 256) ! rate_const*APINNO3*HO2 - rxt_rates(:ncol,:, 590) = rxt_rates(:ncol,:, 590)*sol(:ncol,:, 235)*sol(:ncol,:, 147) ! rate_const*APINNO3*NO - rxt_rates(:ncol,:, 591) = rxt_rates(:ncol,:, 591)*sol(:ncol,:, 235)*sol(:ncol,:, 149) ! rate_const*APINNO3*NO3 - rxt_rates(:ncol,:, 592) = rxt_rates(:ncol,:, 592)*sol(:ncol,:, 235)*sol(:ncol,:, 300) ! rate_const*APINNO3*TERPA2CO3 - rxt_rates(:ncol,:, 593) = rxt_rates(:ncol,:, 593)*sol(:ncol,:, 235)*sol(:ncol,:, 302) ! rate_const*APINNO3*TERPA3CO3 - rxt_rates(:ncol,:, 594) = rxt_rates(:ncol,:, 594)*sol(:ncol,:, 235)*sol(:ncol,:, 305) ! rate_const*APINNO3*TERPACO3 - rxt_rates(:ncol,:, 595) = rxt_rates(:ncol,:, 595)*sol(:ncol,:, 236)*sol(:ncol,:, 250) ! rate_const*APINO2*CH3CO3 - rxt_rates(:ncol,:, 596) = rxt_rates(:ncol,:, 596)*sol(:ncol,:, 236)*sol(:ncol,:, 251) ! rate_const*APINO2*CH3O2 - rxt_rates(:ncol,:, 597) = rxt_rates(:ncol,:, 597)*sol(:ncol,:, 236)*sol(:ncol,:, 256) ! rate_const*APINO2*HO2 - rxt_rates(:ncol,:, 598) = rxt_rates(:ncol,:, 598)*sol(:ncol,:, 236)*sol(:ncol,:, 147) ! rate_const*APINO2*NO - rxt_rates(:ncol,:, 599) = rxt_rates(:ncol,:, 599)*sol(:ncol,:, 236)*sol(:ncol,:, 149) ! rate_const*APINO2*NO3 - rxt_rates(:ncol,:, 600) = rxt_rates(:ncol,:, 600)*sol(:ncol,:, 236)*sol(:ncol,:, 300) ! rate_const*APINO2*TERPA2CO3 - rxt_rates(:ncol,:, 601) = rxt_rates(:ncol,:, 601)*sol(:ncol,:, 236)*sol(:ncol,:, 302) ! rate_const*APINO2*TERPA3CO3 - rxt_rates(:ncol,:, 602) = rxt_rates(:ncol,:, 602)*sol(:ncol,:, 236)*sol(:ncol,:, 305) ! rate_const*APINO2*TERPACO3 - rxt_rates(:ncol,:, 603) = rxt_rates(:ncol,:, 603)*sol(:ncol,:, 4)*sol(:ncol,:, 157) ! rate_const*APIN*O3 - rxt_rates(:ncol,:, 604) = rxt_rates(:ncol,:, 604)*sol(:ncol,:, 4)*sol(:ncol,:, 293) ! rate_const*APIN*OH - rxt_rates(:ncol,:, 605) = rxt_rates(:ncol,:, 605)*sol(:ncol,:, 7)*sol(:ncol,:, 149) ! rate_const*BCARY*NO3 - rxt_rates(:ncol,:, 606) = rxt_rates(:ncol,:, 606)*sol(:ncol,:, 238)*sol(:ncol,:, 238) ! rate_const*BCARYNO3*BCARYNO3 - rxt_rates(:ncol,:, 607) = rxt_rates(:ncol,:, 607)*sol(:ncol,:, 238)*sol(:ncol,:, 250) ! rate_const*BCARYNO3*CH3CO3 - rxt_rates(:ncol,:, 608) = rxt_rates(:ncol,:, 608)*sol(:ncol,:, 238)*sol(:ncol,:, 251) ! rate_const*BCARYNO3*CH3O2 - rxt_rates(:ncol,:, 609) = rxt_rates(:ncol,:, 609)*sol(:ncol,:, 238)*sol(:ncol,:, 256) ! rate_const*BCARYNO3*HO2 - rxt_rates(:ncol,:, 610) = rxt_rates(:ncol,:, 610)*sol(:ncol,:, 238)*sol(:ncol,:, 147) ! rate_const*BCARYNO3*NO - rxt_rates(:ncol,:, 611) = rxt_rates(:ncol,:, 611)*sol(:ncol,:, 238)*sol(:ncol,:, 149) ! rate_const*BCARYNO3*NO3 - rxt_rates(:ncol,:, 612) = rxt_rates(:ncol,:, 612)*sol(:ncol,:, 238)*sol(:ncol,:, 300) ! rate_const*BCARYNO3*TERPA2CO3 - rxt_rates(:ncol,:, 613) = rxt_rates(:ncol,:, 613)*sol(:ncol,:, 238)*sol(:ncol,:, 302) ! rate_const*BCARYNO3*TERPA3CO3 - rxt_rates(:ncol,:, 614) = rxt_rates(:ncol,:, 614)*sol(:ncol,:, 238)*sol(:ncol,:, 305) ! rate_const*BCARYNO3*TERPACO3 - rxt_rates(:ncol,:, 615) = rxt_rates(:ncol,:, 615)*sol(:ncol,:, 239)*sol(:ncol,:, 250) ! rate_const*BCARYO2*CH3CO3 - rxt_rates(:ncol,:, 616) = rxt_rates(:ncol,:, 616)*sol(:ncol,:, 239)*sol(:ncol,:, 251) ! rate_const*BCARYO2*CH3O2 - rxt_rates(:ncol,:, 617) = rxt_rates(:ncol,:, 617)*sol(:ncol,:, 239)*sol(:ncol,:, 256) ! rate_const*BCARYO2*HO2 - rxt_rates(:ncol,:, 618) = rxt_rates(:ncol,:, 618)*sol(:ncol,:, 239)*sol(:ncol,:, 147) ! rate_const*BCARYO2*NO - rxt_rates(:ncol,:, 619) = rxt_rates(:ncol,:, 619)*sol(:ncol,:, 239)*sol(:ncol,:, 149) ! rate_const*BCARYO2*NO3 - rxt_rates(:ncol,:, 620) = rxt_rates(:ncol,:, 620)*sol(:ncol,:, 239)*sol(:ncol,:, 300) ! rate_const*BCARYO2*TERPA2CO3 - rxt_rates(:ncol,:, 621) = rxt_rates(:ncol,:, 621)*sol(:ncol,:, 239)*sol(:ncol,:, 302) ! rate_const*BCARYO2*TERPA3CO3 - rxt_rates(:ncol,:, 622) = rxt_rates(:ncol,:, 622)*sol(:ncol,:, 239)*sol(:ncol,:, 305) ! rate_const*BCARYO2*TERPACO3 - rxt_rates(:ncol,:, 623) = rxt_rates(:ncol,:, 623)*sol(:ncol,:, 7)*sol(:ncol,:, 157) ! rate_const*BCARY*O3 - rxt_rates(:ncol,:, 624) = rxt_rates(:ncol,:, 624)*sol(:ncol,:, 7)*sol(:ncol,:, 293) ! rate_const*BCARY*OH - rxt_rates(:ncol,:, 625) = rxt_rates(:ncol,:, 625)*sol(:ncol,:, 17)*sol(:ncol,:, 149) ! rate_const*BPIN*NO3 - rxt_rates(:ncol,:, 626) = rxt_rates(:ncol,:, 626)*sol(:ncol,:, 243)*sol(:ncol,:, 243) ! rate_const*BPINNO3*BPINNO3 - rxt_rates(:ncol,:, 627) = rxt_rates(:ncol,:, 627)*sol(:ncol,:, 243)*sol(:ncol,:, 250) ! rate_const*BPINNO3*CH3CO3 - rxt_rates(:ncol,:, 628) = rxt_rates(:ncol,:, 628)*sol(:ncol,:, 243)*sol(:ncol,:, 251) ! rate_const*BPINNO3*CH3O2 - rxt_rates(:ncol,:, 629) = rxt_rates(:ncol,:, 629)*sol(:ncol,:, 243)*sol(:ncol,:, 256) ! rate_const*BPINNO3*HO2 - rxt_rates(:ncol,:, 630) = rxt_rates(:ncol,:, 630)*sol(:ncol,:, 243)*sol(:ncol,:, 147) ! rate_const*BPINNO3*NO - rxt_rates(:ncol,:, 631) = rxt_rates(:ncol,:, 631)*sol(:ncol,:, 243)*sol(:ncol,:, 149) ! rate_const*BPINNO3*NO3 - rxt_rates(:ncol,:, 632) = rxt_rates(:ncol,:, 632)*sol(:ncol,:, 243)*sol(:ncol,:, 300) ! rate_const*BPINNO3*TERPA2CO3 - rxt_rates(:ncol,:, 633) = rxt_rates(:ncol,:, 633)*sol(:ncol,:, 243)*sol(:ncol,:, 302) ! rate_const*BPINNO3*TERPA3CO3 - rxt_rates(:ncol,:, 634) = rxt_rates(:ncol,:, 634)*sol(:ncol,:, 243)*sol(:ncol,:, 305) ! rate_const*BPINNO3*TERPACO3 - rxt_rates(:ncol,:, 635) = rxt_rates(:ncol,:, 635)*sol(:ncol,:, 244)*sol(:ncol,:, 250) ! rate_const*BPINO2*CH3CO3 - rxt_rates(:ncol,:, 636) = rxt_rates(:ncol,:, 636)*sol(:ncol,:, 244)*sol(:ncol,:, 251) ! rate_const*BPINO2*CH3O2 - rxt_rates(:ncol,:, 637) = rxt_rates(:ncol,:, 637)*sol(:ncol,:, 244)*sol(:ncol,:, 256) ! rate_const*BPINO2*HO2 - rxt_rates(:ncol,:, 638) = rxt_rates(:ncol,:, 638)*sol(:ncol,:, 244)*sol(:ncol,:, 147) ! rate_const*BPINO2*NO - rxt_rates(:ncol,:, 639) = rxt_rates(:ncol,:, 639)*sol(:ncol,:, 244)*sol(:ncol,:, 149) ! rate_const*BPINO2*NO3 - rxt_rates(:ncol,:, 640) = rxt_rates(:ncol,:, 640)*sol(:ncol,:, 244)*sol(:ncol,:, 300) ! rate_const*BPINO2*TERPA2CO3 - rxt_rates(:ncol,:, 641) = rxt_rates(:ncol,:, 641)*sol(:ncol,:, 244)*sol(:ncol,:, 302) ! rate_const*BPINO2*TERPA3CO3 - rxt_rates(:ncol,:, 642) = rxt_rates(:ncol,:, 642)*sol(:ncol,:, 244)*sol(:ncol,:, 305) ! rate_const*BPINO2*TERPACO3 - rxt_rates(:ncol,:, 643) = rxt_rates(:ncol,:, 643)*sol(:ncol,:, 17)*sol(:ncol,:, 157) ! rate_const*BPIN*O3 - rxt_rates(:ncol,:, 644) = rxt_rates(:ncol,:, 644)*sol(:ncol,:, 17)*sol(:ncol,:, 293) ! rate_const*BPIN*OH - rxt_rates(:ncol,:, 645) = rxt_rates(:ncol,:, 645)*sol(:ncol,:, 125)*sol(:ncol,:, 149) ! rate_const*LIMON*NO3 - rxt_rates(:ncol,:, 646) = rxt_rates(:ncol,:, 646)*sol(:ncol,:, 279)*sol(:ncol,:, 250) ! rate_const*LIMONNO3*CH3CO3 - rxt_rates(:ncol,:, 647) = rxt_rates(:ncol,:, 647)*sol(:ncol,:, 279)*sol(:ncol,:, 251) ! rate_const*LIMONNO3*CH3O2 - rxt_rates(:ncol,:, 648) = rxt_rates(:ncol,:, 648)*sol(:ncol,:, 279)*sol(:ncol,:, 256) ! rate_const*LIMONNO3*HO2 - rxt_rates(:ncol,:, 649) = rxt_rates(:ncol,:, 649)*sol(:ncol,:, 279)*sol(:ncol,:, 279) ! rate_const*LIMONNO3*LIMONNO3 - rxt_rates(:ncol,:, 650) = rxt_rates(:ncol,:, 650)*sol(:ncol,:, 279)*sol(:ncol,:, 147) ! rate_const*LIMONNO3*NO - rxt_rates(:ncol,:, 651) = rxt_rates(:ncol,:, 651)*sol(:ncol,:, 279)*sol(:ncol,:, 149) ! rate_const*LIMONNO3*NO3 - rxt_rates(:ncol,:, 652) = rxt_rates(:ncol,:, 652)*sol(:ncol,:, 279)*sol(:ncol,:, 300) ! rate_const*LIMONNO3*TERPA2CO3 - rxt_rates(:ncol,:, 653) = rxt_rates(:ncol,:, 653)*sol(:ncol,:, 279)*sol(:ncol,:, 302) ! rate_const*LIMONNO3*TERPA3CO3 - rxt_rates(:ncol,:, 654) = rxt_rates(:ncol,:, 654)*sol(:ncol,:, 279)*sol(:ncol,:, 305) ! rate_const*LIMONNO3*TERPACO3 - rxt_rates(:ncol,:, 655) = rxt_rates(:ncol,:, 655)*sol(:ncol,:, 280)*sol(:ncol,:, 250) ! rate_const*LIMONO2*CH3CO3 - rxt_rates(:ncol,:, 656) = rxt_rates(:ncol,:, 656)*sol(:ncol,:, 280)*sol(:ncol,:, 251) ! rate_const*LIMONO2*CH3O2 - rxt_rates(:ncol,:, 657) = rxt_rates(:ncol,:, 657)*sol(:ncol,:, 280)*sol(:ncol,:, 256) ! rate_const*LIMONO2*HO2 - rxt_rates(:ncol,:, 658) = rxt_rates(:ncol,:, 658)*sol(:ncol,:, 280)*sol(:ncol,:, 147) ! rate_const*LIMONO2*NO - rxt_rates(:ncol,:, 659) = rxt_rates(:ncol,:, 659)*sol(:ncol,:, 280)*sol(:ncol,:, 149) ! rate_const*LIMONO2*NO3 - rxt_rates(:ncol,:, 660) = rxt_rates(:ncol,:, 660)*sol(:ncol,:, 280)*sol(:ncol,:, 300) ! rate_const*LIMONO2*TERPA2CO3 - rxt_rates(:ncol,:, 661) = rxt_rates(:ncol,:, 661)*sol(:ncol,:, 280)*sol(:ncol,:, 302) ! rate_const*LIMONO2*TERPA3CO3 - rxt_rates(:ncol,:, 662) = rxt_rates(:ncol,:, 662)*sol(:ncol,:, 280)*sol(:ncol,:, 305) ! rate_const*LIMONO2*TERPACO3 - rxt_rates(:ncol,:, 663) = rxt_rates(:ncol,:, 663)*sol(:ncol,:, 125)*sol(:ncol,:, 157) ! rate_const*LIMON*O3 - rxt_rates(:ncol,:, 664) = rxt_rates(:ncol,:, 664)*sol(:ncol,:, 125)*sol(:ncol,:, 293) ! rate_const*LIMON*OH - rxt_rates(:ncol,:, 665) = rxt_rates(:ncol,:, 665)*sol(:ncol,:, 135)*sol(:ncol,:, 149) ! rate_const*MYRC*NO3 - rxt_rates(:ncol,:, 666) = rxt_rates(:ncol,:, 666)*sol(:ncol,:, 288)*sol(:ncol,:, 250) ! rate_const*MYRCNO3*CH3CO3 - rxt_rates(:ncol,:, 667) = rxt_rates(:ncol,:, 667)*sol(:ncol,:, 288)*sol(:ncol,:, 251) ! rate_const*MYRCNO3*CH3O2 - rxt_rates(:ncol,:, 668) = rxt_rates(:ncol,:, 668)*sol(:ncol,:, 288)*sol(:ncol,:, 256) ! rate_const*MYRCNO3*HO2 - rxt_rates(:ncol,:, 669) = rxt_rates(:ncol,:, 669)*sol(:ncol,:, 288)*sol(:ncol,:, 288) ! rate_const*MYRCNO3*MYRCNO3 - rxt_rates(:ncol,:, 670) = rxt_rates(:ncol,:, 670)*sol(:ncol,:, 288)*sol(:ncol,:, 147) ! rate_const*MYRCNO3*NO - rxt_rates(:ncol,:, 671) = rxt_rates(:ncol,:, 671)*sol(:ncol,:, 288)*sol(:ncol,:, 149) ! rate_const*MYRCNO3*NO3 - rxt_rates(:ncol,:, 672) = rxt_rates(:ncol,:, 672)*sol(:ncol,:, 288)*sol(:ncol,:, 300) ! rate_const*MYRCNO3*TERPA2CO3 - rxt_rates(:ncol,:, 673) = rxt_rates(:ncol,:, 673)*sol(:ncol,:, 288)*sol(:ncol,:, 302) ! rate_const*MYRCNO3*TERPA3CO3 - rxt_rates(:ncol,:, 674) = rxt_rates(:ncol,:, 674)*sol(:ncol,:, 288)*sol(:ncol,:, 305) ! rate_const*MYRCNO3*TERPACO3 - rxt_rates(:ncol,:, 675) = rxt_rates(:ncol,:, 675)*sol(:ncol,:, 289)*sol(:ncol,:, 250) ! rate_const*MYRCO2*CH3CO3 - rxt_rates(:ncol,:, 676) = rxt_rates(:ncol,:, 676)*sol(:ncol,:, 289)*sol(:ncol,:, 251) ! rate_const*MYRCO2*CH3O2 - rxt_rates(:ncol,:, 677) = rxt_rates(:ncol,:, 677)*sol(:ncol,:, 289)*sol(:ncol,:, 256) ! rate_const*MYRCO2*HO2 - rxt_rates(:ncol,:, 678) = rxt_rates(:ncol,:, 678)*sol(:ncol,:, 289)*sol(:ncol,:, 147) ! rate_const*MYRCO2*NO - rxt_rates(:ncol,:, 679) = rxt_rates(:ncol,:, 679)*sol(:ncol,:, 289)*sol(:ncol,:, 149) ! rate_const*MYRCO2*NO3 - rxt_rates(:ncol,:, 680) = rxt_rates(:ncol,:, 680)*sol(:ncol,:, 289)*sol(:ncol,:, 300) ! rate_const*MYRCO2*TERPA2CO3 - rxt_rates(:ncol,:, 681) = rxt_rates(:ncol,:, 681)*sol(:ncol,:, 289)*sol(:ncol,:, 302) ! rate_const*MYRCO2*TERPA3CO3 - rxt_rates(:ncol,:, 682) = rxt_rates(:ncol,:, 682)*sol(:ncol,:, 289)*sol(:ncol,:, 305) ! rate_const*MYRCO2*TERPACO3 - rxt_rates(:ncol,:, 683) = rxt_rates(:ncol,:, 683)*sol(:ncol,:, 135)*sol(:ncol,:, 157) ! rate_const*MYRC*O3 - rxt_rates(:ncol,:, 684) = rxt_rates(:ncol,:, 684)*sol(:ncol,:, 135)*sol(:ncol,:, 293) ! rate_const*MYRC*OH - rxt_rates(:ncol,:, 685) = rxt_rates(:ncol,:, 685)*sol(:ncol,:, 300)*sol(:ncol,:, 148) ! rate_const*M*TERPA2CO3*NO2 - rxt_rates(:ncol,:, 686) = rxt_rates(:ncol,:, 686)*sol(:ncol,:, 302)*sol(:ncol,:, 148) ! rate_const*M*TERPA3CO3*NO2 - rxt_rates(:ncol,:, 687) = rxt_rates(:ncol,:, 687)*sol(:ncol,:, 305)*sol(:ncol,:, 148) ! rate_const*M*TERPACO3*NO2 - rxt_rates(:ncol,:, 688) = rxt_rates(:ncol,:, 688)*sol(:ncol,:, 297)*sol(:ncol,:, 256) ! rate_const*TERP1OOHO2*HO2 - rxt_rates(:ncol,:, 689) = rxt_rates(:ncol,:, 689)*sol(:ncol,:, 297)*sol(:ncol,:, 147) ! rate_const*TERP1OOHO2*NO - rxt_rates(:ncol,:, 690) = rxt_rates(:ncol,:, 690)*sol(:ncol,:, 198)*sol(:ncol,:, 293) ! rate_const*TERP1OOH*OH - rxt_rates(:ncol,:, 691) = rxt_rates(:ncol,:, 691)*sol(:ncol,:, 199)*sol(:ncol,:, 293) ! rate_const*TERP2AOOH*OH - rxt_rates(:ncol,:, 692) = rxt_rates(:ncol,:, 692)*sol(:ncol,:, 298)*sol(:ncol,:, 256) ! rate_const*TERP2OOHO2*HO2 - rxt_rates(:ncol,:, 693) = rxt_rates(:ncol,:, 693)*sol(:ncol,:, 298)*sol(:ncol,:, 147) ! rate_const*TERP2OOHO2*NO - rxt_rates(:ncol,:, 694) = rxt_rates(:ncol,:, 694)*sol(:ncol,:, 299)*sol(:ncol,:, 250) ! rate_const*TERPA1O2*CH3CO3 - rxt_rates(:ncol,:, 695) = rxt_rates(:ncol,:, 695)*sol(:ncol,:, 299)*sol(:ncol,:, 251) ! rate_const*TERPA1O2*CH3O2 - rxt_rates(:ncol,:, 696) = rxt_rates(:ncol,:, 696)*sol(:ncol,:, 299)*sol(:ncol,:, 256) ! rate_const*TERPA1O2*HO2 - rxt_rates(:ncol,:, 697) = rxt_rates(:ncol,:, 697)*sol(:ncol,:, 299)*sol(:ncol,:, 147) ! rate_const*TERPA1O2*NO - rxt_rates(:ncol,:, 698) = rxt_rates(:ncol,:, 698)*sol(:ncol,:, 299)*sol(:ncol,:, 149) ! rate_const*TERPA1O2*NO3 - rxt_rates(:ncol,:, 699) = rxt_rates(:ncol,:, 699)*sol(:ncol,:, 299)*sol(:ncol,:, 300) ! rate_const*TERPA1O2*TERPA2CO3 - rxt_rates(:ncol,:, 700) = rxt_rates(:ncol,:, 700)*sol(:ncol,:, 299)*sol(:ncol,:, 302) ! rate_const*TERPA1O2*TERPA3CO3 - rxt_rates(:ncol,:, 701) = rxt_rates(:ncol,:, 701)*sol(:ncol,:, 299)*sol(:ncol,:, 305) ! rate_const*TERPA1O2*TERPACO3 - rxt_rates(:ncol,:, 702) = rxt_rates(:ncol,:, 702)*sol(:ncol,:, 300)*sol(:ncol,:, 250) ! rate_const*TERPA2CO3*CH3CO3 - rxt_rates(:ncol,:, 703) = rxt_rates(:ncol,:, 703)*sol(:ncol,:, 300)*sol(:ncol,:, 251) ! rate_const*TERPA2CO3*CH3O2 - rxt_rates(:ncol,:, 704) = rxt_rates(:ncol,:, 704)*sol(:ncol,:, 300)*sol(:ncol,:, 256) ! rate_const*TERPA2CO3*HO2 - rxt_rates(:ncol,:, 705) = rxt_rates(:ncol,:, 705)*sol(:ncol,:, 300)*sol(:ncol,:, 147) ! rate_const*TERPA2CO3*NO - rxt_rates(:ncol,:, 706) = rxt_rates(:ncol,:, 706)*sol(:ncol,:, 300)*sol(:ncol,:, 149) ! rate_const*TERPA2CO3*NO3 - rxt_rates(:ncol,:, 707) = rxt_rates(:ncol,:, 707)*sol(:ncol,:, 300)*sol(:ncol,:, 300) ! rate_const*TERPA2CO3*TERPA2CO3 - rxt_rates(:ncol,:, 708) = rxt_rates(:ncol,:, 708)*sol(:ncol,:, 300)*sol(:ncol,:, 305) ! rate_const*TERPA2CO3*TERPACO3 - rxt_rates(:ncol,:, 709) = rxt_rates(:ncol,:, 709)*sol(:ncol,:, 201)*sol(:ncol,:, 149) ! rate_const*TERPA2*NO3 - rxt_rates(:ncol,:, 710) = rxt_rates(:ncol,:, 710)*sol(:ncol,:, 301)*sol(:ncol,:, 250) ! rate_const*TERPA2O2*CH3CO3 - rxt_rates(:ncol,:, 711) = rxt_rates(:ncol,:, 711)*sol(:ncol,:, 301)*sol(:ncol,:, 251) ! rate_const*TERPA2O2*CH3O2 - rxt_rates(:ncol,:, 712) = rxt_rates(:ncol,:, 712)*sol(:ncol,:, 301)*sol(:ncol,:, 256) ! rate_const*TERPA2O2*HO2 - rxt_rates(:ncol,:, 713) = rxt_rates(:ncol,:, 713)*sol(:ncol,:, 301)*sol(:ncol,:, 147) ! rate_const*TERPA2O2*NO - rxt_rates(:ncol,:, 714) = rxt_rates(:ncol,:, 714)*sol(:ncol,:, 301)*sol(:ncol,:, 149) ! rate_const*TERPA2O2*NO3 - rxt_rates(:ncol,:, 715) = rxt_rates(:ncol,:, 715)*sol(:ncol,:, 301)*sol(:ncol,:, 300) ! rate_const*TERPA2O2*TERPA2CO3 - rxt_rates(:ncol,:, 716) = rxt_rates(:ncol,:, 716)*sol(:ncol,:, 301)*sol(:ncol,:, 302) ! rate_const*TERPA2O2*TERPA3CO3 - rxt_rates(:ncol,:, 717) = rxt_rates(:ncol,:, 717)*sol(:ncol,:, 301)*sol(:ncol,:, 305) ! rate_const*TERPA2O2*TERPACO3 - rxt_rates(:ncol,:, 718) = rxt_rates(:ncol,:, 718)*sol(:ncol,:, 201)*sol(:ncol,:, 293) ! rate_const*TERPA2*OH - rxt_rates(:ncol,:, 719) = rxt_rates(:ncol,:, 719)*sol(:ncol,:, 202)*sol(:ncol,:, 293) ! rate_const*TERPA2PAN*OH - rxt_rates(:ncol,:, 720) = rxt_rates(:ncol,:, 720)*sol(:ncol,:, 302)*sol(:ncol,:, 250) ! rate_const*TERPA3CO3*CH3CO3 - rxt_rates(:ncol,:, 721) = rxt_rates(:ncol,:, 721)*sol(:ncol,:, 302)*sol(:ncol,:, 251) ! rate_const*TERPA3CO3*CH3O2 - rxt_rates(:ncol,:, 722) = rxt_rates(:ncol,:, 722)*sol(:ncol,:, 302)*sol(:ncol,:, 256) ! rate_const*TERPA3CO3*HO2 - rxt_rates(:ncol,:, 723) = rxt_rates(:ncol,:, 723)*sol(:ncol,:, 302)*sol(:ncol,:, 147) ! rate_const*TERPA3CO3*NO - rxt_rates(:ncol,:, 724) = rxt_rates(:ncol,:, 724)*sol(:ncol,:, 302)*sol(:ncol,:, 149) ! rate_const*TERPA3CO3*NO3 - rxt_rates(:ncol,:, 725) = rxt_rates(:ncol,:, 725)*sol(:ncol,:, 302)*sol(:ncol,:, 300) ! rate_const*TERPA3CO3*TERPA2CO3 - rxt_rates(:ncol,:, 726) = rxt_rates(:ncol,:, 726)*sol(:ncol,:, 302)*sol(:ncol,:, 302) ! rate_const*TERPA3CO3*TERPA3CO3 - rxt_rates(:ncol,:, 727) = rxt_rates(:ncol,:, 727)*sol(:ncol,:, 302)*sol(:ncol,:, 305) ! rate_const*TERPA3CO3*TERPACO3 - rxt_rates(:ncol,:, 728) = rxt_rates(:ncol,:, 728)*sol(:ncol,:, 203)*sol(:ncol,:, 149) ! rate_const*TERPA3*NO3 - rxt_rates(:ncol,:, 729) = rxt_rates(:ncol,:, 729)*sol(:ncol,:, 303)*sol(:ncol,:, 250) ! rate_const*TERPA3O2*CH3CO3 - rxt_rates(:ncol,:, 730) = rxt_rates(:ncol,:, 730)*sol(:ncol,:, 303)*sol(:ncol,:, 251) ! rate_const*TERPA3O2*CH3O2 - rxt_rates(:ncol,:, 731) = rxt_rates(:ncol,:, 731)*sol(:ncol,:, 303)*sol(:ncol,:, 256) ! rate_const*TERPA3O2*HO2 - rxt_rates(:ncol,:, 732) = rxt_rates(:ncol,:, 732)*sol(:ncol,:, 303)*sol(:ncol,:, 147) ! rate_const*TERPA3O2*NO - rxt_rates(:ncol,:, 733) = rxt_rates(:ncol,:, 733)*sol(:ncol,:, 303)*sol(:ncol,:, 149) ! rate_const*TERPA3O2*NO3 - rxt_rates(:ncol,:, 734) = rxt_rates(:ncol,:, 734)*sol(:ncol,:, 303)*sol(:ncol,:, 300) ! rate_const*TERPA3O2*TERPA2CO3 - rxt_rates(:ncol,:, 735) = rxt_rates(:ncol,:, 735)*sol(:ncol,:, 303)*sol(:ncol,:, 302) ! rate_const*TERPA3O2*TERPA3CO3 - rxt_rates(:ncol,:, 736) = rxt_rates(:ncol,:, 736)*sol(:ncol,:, 303)*sol(:ncol,:, 305) ! rate_const*TERPA3O2*TERPACO3 - rxt_rates(:ncol,:, 737) = rxt_rates(:ncol,:, 737)*sol(:ncol,:, 203)*sol(:ncol,:, 293) ! rate_const*TERPA3*OH - rxt_rates(:ncol,:, 738) = rxt_rates(:ncol,:, 738)*sol(:ncol,:, 204)*sol(:ncol,:, 293) ! rate_const*TERPA3PAN*OH - rxt_rates(:ncol,:, 739) = rxt_rates(:ncol,:, 739)*sol(:ncol,:, 304)*sol(:ncol,:, 250) ! rate_const*TERPA4O2*CH3CO3 - rxt_rates(:ncol,:, 740) = rxt_rates(:ncol,:, 740)*sol(:ncol,:, 304)*sol(:ncol,:, 251) ! rate_const*TERPA4O2*CH3O2 - rxt_rates(:ncol,:, 741) = rxt_rates(:ncol,:, 741)*sol(:ncol,:, 304)*sol(:ncol,:, 256) ! rate_const*TERPA4O2*HO2 - rxt_rates(:ncol,:, 742) = rxt_rates(:ncol,:, 742)*sol(:ncol,:, 304)*sol(:ncol,:, 147) ! rate_const*TERPA4O2*NO - rxt_rates(:ncol,:, 743) = rxt_rates(:ncol,:, 743)*sol(:ncol,:, 304)*sol(:ncol,:, 149) ! rate_const*TERPA4O2*NO3 - rxt_rates(:ncol,:, 744) = rxt_rates(:ncol,:, 744)*sol(:ncol,:, 304)*sol(:ncol,:, 300) ! rate_const*TERPA4O2*TERPA2CO3 - rxt_rates(:ncol,:, 745) = rxt_rates(:ncol,:, 745)*sol(:ncol,:, 304)*sol(:ncol,:, 302) ! rate_const*TERPA4O2*TERPA3CO3 - rxt_rates(:ncol,:, 746) = rxt_rates(:ncol,:, 746)*sol(:ncol,:, 304)*sol(:ncol,:, 305) ! rate_const*TERPA4O2*TERPACO3 - rxt_rates(:ncol,:, 747) = rxt_rates(:ncol,:, 747)*sol(:ncol,:, 206)*sol(:ncol,:, 293) ! rate_const*TERPACID2*OH - rxt_rates(:ncol,:, 748) = rxt_rates(:ncol,:, 748)*sol(:ncol,:, 207)*sol(:ncol,:, 293) ! rate_const*TERPACID3*OH - rxt_rates(:ncol,:, 749) = rxt_rates(:ncol,:, 749)*sol(:ncol,:, 205)*sol(:ncol,:, 293) ! rate_const*TERPACID*OH - rxt_rates(:ncol,:, 750) = rxt_rates(:ncol,:, 750)*sol(:ncol,:, 305)*sol(:ncol,:, 250) ! rate_const*TERPACO3*CH3CO3 - rxt_rates(:ncol,:, 751) = rxt_rates(:ncol,:, 751)*sol(:ncol,:, 305)*sol(:ncol,:, 251) ! rate_const*TERPACO3*CH3O2 - rxt_rates(:ncol,:, 752) = rxt_rates(:ncol,:, 752)*sol(:ncol,:, 305)*sol(:ncol,:, 256) ! rate_const*TERPACO3*HO2 - rxt_rates(:ncol,:, 753) = rxt_rates(:ncol,:, 753)*sol(:ncol,:, 305)*sol(:ncol,:, 147) ! rate_const*TERPACO3*NO - rxt_rates(:ncol,:, 754) = rxt_rates(:ncol,:, 754)*sol(:ncol,:, 305)*sol(:ncol,:, 149) ! rate_const*TERPACO3*NO3 - rxt_rates(:ncol,:, 755) = rxt_rates(:ncol,:, 755)*sol(:ncol,:, 305)*sol(:ncol,:, 305) ! rate_const*TERPACO3*TERPACO3 - rxt_rates(:ncol,:, 756) = rxt_rates(:ncol,:, 756)*sol(:ncol,:, 200)*sol(:ncol,:, 149) ! rate_const*TERPA*NO3 - rxt_rates(:ncol,:, 757) = rxt_rates(:ncol,:, 757)*sol(:ncol,:, 200)*sol(:ncol,:, 293) ! rate_const*TERPA*OH - rxt_rates(:ncol,:, 758) = rxt_rates(:ncol,:, 758)*sol(:ncol,:, 208)*sol(:ncol,:, 293) ! rate_const*TERPAPAN*OH - rxt_rates(:ncol,:, 759) = rxt_rates(:ncol,:, 759)*sol(:ncol,:, 209)*sol(:ncol,:, 293) ! rate_const*TERPDHDP*OH - rxt_rates(:ncol,:, 760) = rxt_rates(:ncol,:, 760)*sol(:ncol,:, 210)*sol(:ncol,:, 149) ! rate_const*TERPF1*NO3 - rxt_rates(:ncol,:, 761) = rxt_rates(:ncol,:, 761)*sol(:ncol,:, 306)*sol(:ncol,:, 256) ! rate_const*TERPF1O2*HO2 - rxt_rates(:ncol,:, 762) = rxt_rates(:ncol,:, 762)*sol(:ncol,:, 306)*sol(:ncol,:, 147) ! rate_const*TERPF1O2*NO - rxt_rates(:ncol,:, 763) = rxt_rates(:ncol,:, 763)*sol(:ncol,:, 210)*sol(:ncol,:, 157) ! rate_const*TERPF1*O3 - rxt_rates(:ncol,:, 764) = rxt_rates(:ncol,:, 764)*sol(:ncol,:, 210)*sol(:ncol,:, 293) ! rate_const*TERPF1*OH - rxt_rates(:ncol,:, 765) = rxt_rates(:ncol,:, 765)*sol(:ncol,:, 211)*sol(:ncol,:, 149) ! rate_const*TERPF2*NO3 - rxt_rates(:ncol,:, 766) = rxt_rates(:ncol,:, 766)*sol(:ncol,:, 307)*sol(:ncol,:, 256) ! rate_const*TERPF2O2*HO2 - rxt_rates(:ncol,:, 767) = rxt_rates(:ncol,:, 767)*sol(:ncol,:, 307)*sol(:ncol,:, 147) ! rate_const*TERPF2O2*NO - rxt_rates(:ncol,:, 768) = rxt_rates(:ncol,:, 768)*sol(:ncol,:, 211)*sol(:ncol,:, 157) ! rate_const*TERPF2*O3 - rxt_rates(:ncol,:, 769) = rxt_rates(:ncol,:, 769)*sol(:ncol,:, 211)*sol(:ncol,:, 293) ! rate_const*TERPF2*OH - rxt_rates(:ncol,:, 770) = rxt_rates(:ncol,:, 770)*sol(:ncol,:, 212)*sol(:ncol,:, 293) ! rate_const*TERPFDN*OH - rxt_rates(:ncol,:, 771) = rxt_rates(:ncol,:, 771)*sol(:ncol,:, 213)*sol(:ncol,:, 293) ! rate_const*TERPHFN*OH - rxt_rates(:ncol,:, 772) = rxt_rates(:ncol,:, 772)*sol(:ncol,:, 214)*sol(:ncol,:, 293) ! rate_const*TERPK*OH - rxt_rates(:ncol,:, 773) = rxt_rates(:ncol,:, 773)*sol(:ncol,:, 308)*sol(:ncol,:, 256) ! rate_const*TERPNPS1O2*HO2 - rxt_rates(:ncol,:, 774) = rxt_rates(:ncol,:, 774)*sol(:ncol,:, 308)*sol(:ncol,:, 147) ! rate_const*TERPNPS1O2*NO - rxt_rates(:ncol,:, 775) = rxt_rates(:ncol,:, 775)*sol(:ncol,:, 216)*sol(:ncol,:, 293) ! rate_const*TERPNPS1*OH - rxt_rates(:ncol,:, 776) = rxt_rates(:ncol,:, 776)*sol(:ncol,:, 215)*sol(:ncol,:, 293) ! rate_const*TERPNPS*OH - rxt_rates(:ncol,:, 777) = rxt_rates(:ncol,:, 777)*sol(:ncol,:, 309)*sol(:ncol,:, 256) ! rate_const*TERPNPT1O2*HO2 - rxt_rates(:ncol,:, 778) = rxt_rates(:ncol,:, 778)*sol(:ncol,:, 309)*sol(:ncol,:, 147) ! rate_const*TERPNPT1O2*NO - rxt_rates(:ncol,:, 779) = rxt_rates(:ncol,:, 779)*sol(:ncol,:, 218)*sol(:ncol,:, 293) ! rate_const*TERPNPT1*OH - rxt_rates(:ncol,:, 780) = rxt_rates(:ncol,:, 780)*sol(:ncol,:, 217)*sol(:ncol,:, 293) ! rate_const*TERPNPT*OH - rxt_rates(:ncol,:, 781) = rxt_rates(:ncol,:, 781)*sol(:ncol,:, 310)*sol(:ncol,:, 256) ! rate_const*TERPNS1O2*HO2 - rxt_rates(:ncol,:, 782) = rxt_rates(:ncol,:, 782)*sol(:ncol,:, 310)*sol(:ncol,:, 147) ! rate_const*TERPNS1O2*NO - rxt_rates(:ncol,:, 783) = rxt_rates(:ncol,:, 783)*sol(:ncol,:, 220)*sol(:ncol,:, 293) ! rate_const*TERPNS1*OH - rxt_rates(:ncol,:, 784) = rxt_rates(:ncol,:, 784)*sol(:ncol,:, 219)*sol(:ncol,:, 293) ! rate_const*TERPNS*OH - rxt_rates(:ncol,:, 785) = rxt_rates(:ncol,:, 785)*sol(:ncol,:, 311)*sol(:ncol,:, 256) ! rate_const*TERPNT1O2*HO2 - rxt_rates(:ncol,:, 786) = rxt_rates(:ncol,:, 786)*sol(:ncol,:, 311)*sol(:ncol,:, 147) ! rate_const*TERPNT1O2*NO - rxt_rates(:ncol,:, 787) = rxt_rates(:ncol,:, 787)*sol(:ncol,:, 222)*sol(:ncol,:, 293) ! rate_const*TERPNT1*OH - rxt_rates(:ncol,:, 788) = rxt_rates(:ncol,:, 788)*sol(:ncol,:, 221)*sol(:ncol,:, 293) ! rate_const*TERPNT*OH - rxt_rates(:ncol,:, 789) = rxt_rates(:ncol,:, 789)*sol(:ncol,:, 224)*sol(:ncol,:, 293) ! rate_const*TERPOOHL*OH - rxt_rates(:ncol,:, 790) = rxt_rates(:ncol,:, 790)*sol(:ncol,:, 223)*sol(:ncol,:, 293) ! rate_const*TERPOOH*OH - rxt_rates(:ncol,:, 791) = rxt_rates(:ncol,:, 791)*sol(:ncol,:, 202) ! rate_const*M*TERPA2PAN - rxt_rates(:ncol,:, 792) = rxt_rates(:ncol,:, 792)*sol(:ncol,:, 204) ! rate_const*M*TERPA3PAN - rxt_rates(:ncol,:, 793) = rxt_rates(:ncol,:, 793)*sol(:ncol,:, 208) ! rate_const*M*TERPAPAN - rxt_rates(:ncol,:, 794) = rxt_rates(:ncol,:, 794)*sol(:ncol,:, 69)*sol(:ncol,:, 149) ! rate_const*DMS*NO3 - rxt_rates(:ncol,:, 795) = rxt_rates(:ncol,:, 795)*sol(:ncol,:, 69)*sol(:ncol,:, 293) ! rate_const*DMS*OH - rxt_rates(:ncol,:, 796) = rxt_rates(:ncol,:, 796)*sol(:ncol,:, 160)*sol(:ncol,:, 156) ! rate_const*OCS*O - rxt_rates(:ncol,:, 797) = rxt_rates(:ncol,:, 797)*sol(:ncol,:, 160)*sol(:ncol,:, 293) ! rate_const*OCS*OH - rxt_rates(:ncol,:, 798) = rxt_rates(:ncol,:, 798)*sol(:ncol,:, 171) ! rate_const*O2*S + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 233)*sol(:ncol,:, 256) ! rate_const*ACBZO2*HO2 + rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 233)*sol(:ncol,:, 147) ! rate_const*ACBZO2*NO + rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 8)*sol(:ncol,:, 293) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 241)*sol(:ncol,:, 256) ! rate_const*BENZO2*HO2 + rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 241)*sol(:ncol,:, 147) ! rate_const*BENZO2*NO + rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 9)*sol(:ncol,:, 293) ! rate_const*BENZOOH*OH + rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 23)*sol(:ncol,:, 293) ! rate_const*BZALD*OH + rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 246)*sol(:ncol,:, 256) ! rate_const*BZOO*HO2 + rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 24)*sol(:ncol,:, 293) ! rate_const*BZOOH*OH + rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 246)*sol(:ncol,:, 147) ! rate_const*BZOO*NO + rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 249)*sol(:ncol,:, 256) ! rate_const*C6H5O2*HO2 + rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 249)*sol(:ncol,:, 147) ! rate_const*C6H5O2*NO + rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 33)*sol(:ncol,:, 293) ! rate_const*C6H5OOH*OH + rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 67)*sol(:ncol,:, 293) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 252)*sol(:ncol,:, 256) ! rate_const*DICARBO2*HO2 + rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 252)*sol(:ncol,:, 147) ! rate_const*DICARBO2*NO + rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 252)*sol(:ncol,:, 148) ! rate_const*M*DICARBO2*NO2 + rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 283)*sol(:ncol,:, 256) ! rate_const*MALO2*HO2 + rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 283)*sol(:ncol,:, 147) ! rate_const*MALO2*NO + rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 283)*sol(:ncol,:, 148) ! rate_const*M*MALO2*NO2 + rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 285)*sol(:ncol,:, 256) ! rate_const*MDIALO2*HO2 + rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 285)*sol(:ncol,:, 147) ! rate_const*MDIALO2*NO + rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 285)*sol(:ncol,:, 148) ! rate_const*M*MDIALO2*NO2 + rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 294)*sol(:ncol,:, 256) ! rate_const*PHENO2*HO2 + rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 294)*sol(:ncol,:, 147) ! rate_const*PHENO2*NO + rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 165)*sol(:ncol,:, 293) ! rate_const*PHENOL*OH + rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 164)*sol(:ncol,:, 148) ! rate_const*PHENO*NO2 + rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 164)*sol(:ncol,:, 157) ! rate_const*PHENO*O3 + rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 166)*sol(:ncol,:, 293) ! rate_const*PHENOOH*OH + rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 233)*sol(:ncol,:, 148) ! rate_const*M*ACBZO2*NO2 + rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 312)*sol(:ncol,:, 256) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 312)*sol(:ncol,:, 147) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 225)*sol(:ncol,:, 293) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 226)*sol(:ncol,:, 293) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 163) ! rate_const*M*PBZNIT + rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 227)*sol(:ncol,:, 293) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 314)*sol(:ncol,:, 256) ! rate_const*XYLENO2*HO2 + rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 314)*sol(:ncol,:, 147) ! rate_const*XYLENO2*NO + rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 228)*sol(:ncol,:, 293) ! rate_const*XYLENOOH*OH + rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 316)*sol(:ncol,:, 256) ! rate_const*XYLOLO2*HO2 + rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 316)*sol(:ncol,:, 147) ! rate_const*XYLOLO2*NO + rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 229)*sol(:ncol,:, 293) ! rate_const*XYLOL*OH + rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 230)*sol(:ncol,:, 293) ! rate_const*XYLOLOOH*OH + rxt_rates(:ncol,:, 584) = rxt_rates(:ncol,:, 584)*sol(:ncol,:, 4)*sol(:ncol,:, 149) ! rate_const*APIN*NO3 + rxt_rates(:ncol,:, 585) = rxt_rates(:ncol,:, 585)*sol(:ncol,:, 235)*sol(:ncol,:, 235) ! rate_const*APINNO3*APINNO3 + rxt_rates(:ncol,:, 586) = rxt_rates(:ncol,:, 586)*sol(:ncol,:, 235)*sol(:ncol,:, 250) ! rate_const*APINNO3*CH3CO3 + rxt_rates(:ncol,:, 587) = rxt_rates(:ncol,:, 587)*sol(:ncol,:, 235)*sol(:ncol,:, 251) ! rate_const*APINNO3*CH3O2 + rxt_rates(:ncol,:, 588) = rxt_rates(:ncol,:, 588)*sol(:ncol,:, 235)*sol(:ncol,:, 256) ! rate_const*APINNO3*HO2 + rxt_rates(:ncol,:, 589) = rxt_rates(:ncol,:, 589)*sol(:ncol,:, 235)*sol(:ncol,:, 147) ! rate_const*APINNO3*NO + rxt_rates(:ncol,:, 590) = rxt_rates(:ncol,:, 590)*sol(:ncol,:, 235)*sol(:ncol,:, 149) ! rate_const*APINNO3*NO3 + rxt_rates(:ncol,:, 591) = rxt_rates(:ncol,:, 591)*sol(:ncol,:, 235)*sol(:ncol,:, 300) ! rate_const*APINNO3*TERPA2CO3 + rxt_rates(:ncol,:, 592) = rxt_rates(:ncol,:, 592)*sol(:ncol,:, 235)*sol(:ncol,:, 302) ! rate_const*APINNO3*TERPA3CO3 + rxt_rates(:ncol,:, 593) = rxt_rates(:ncol,:, 593)*sol(:ncol,:, 235)*sol(:ncol,:, 305) ! rate_const*APINNO3*TERPACO3 + rxt_rates(:ncol,:, 594) = rxt_rates(:ncol,:, 594)*sol(:ncol,:, 236)*sol(:ncol,:, 250) ! rate_const*APINO2*CH3CO3 + rxt_rates(:ncol,:, 595) = rxt_rates(:ncol,:, 595)*sol(:ncol,:, 236)*sol(:ncol,:, 251) ! rate_const*APINO2*CH3O2 + rxt_rates(:ncol,:, 596) = rxt_rates(:ncol,:, 596)*sol(:ncol,:, 236)*sol(:ncol,:, 256) ! rate_const*APINO2*HO2 + rxt_rates(:ncol,:, 597) = rxt_rates(:ncol,:, 597)*sol(:ncol,:, 236)*sol(:ncol,:, 147) ! rate_const*APINO2*NO + rxt_rates(:ncol,:, 598) = rxt_rates(:ncol,:, 598)*sol(:ncol,:, 236)*sol(:ncol,:, 149) ! rate_const*APINO2*NO3 + rxt_rates(:ncol,:, 599) = rxt_rates(:ncol,:, 599)*sol(:ncol,:, 236)*sol(:ncol,:, 300) ! rate_const*APINO2*TERPA2CO3 + rxt_rates(:ncol,:, 600) = rxt_rates(:ncol,:, 600)*sol(:ncol,:, 236)*sol(:ncol,:, 302) ! rate_const*APINO2*TERPA3CO3 + rxt_rates(:ncol,:, 601) = rxt_rates(:ncol,:, 601)*sol(:ncol,:, 236)*sol(:ncol,:, 305) ! rate_const*APINO2*TERPACO3 + rxt_rates(:ncol,:, 602) = rxt_rates(:ncol,:, 602)*sol(:ncol,:, 4)*sol(:ncol,:, 157) ! rate_const*APIN*O3 + rxt_rates(:ncol,:, 603) = rxt_rates(:ncol,:, 603)*sol(:ncol,:, 4)*sol(:ncol,:, 293) ! rate_const*APIN*OH + rxt_rates(:ncol,:, 604) = rxt_rates(:ncol,:, 604)*sol(:ncol,:, 7)*sol(:ncol,:, 149) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 605) = rxt_rates(:ncol,:, 605)*sol(:ncol,:, 238)*sol(:ncol,:, 238) ! rate_const*BCARYNO3*BCARYNO3 + rxt_rates(:ncol,:, 606) = rxt_rates(:ncol,:, 606)*sol(:ncol,:, 238)*sol(:ncol,:, 250) ! rate_const*BCARYNO3*CH3CO3 + rxt_rates(:ncol,:, 607) = rxt_rates(:ncol,:, 607)*sol(:ncol,:, 238)*sol(:ncol,:, 251) ! rate_const*BCARYNO3*CH3O2 + rxt_rates(:ncol,:, 608) = rxt_rates(:ncol,:, 608)*sol(:ncol,:, 238)*sol(:ncol,:, 256) ! rate_const*BCARYNO3*HO2 + rxt_rates(:ncol,:, 609) = rxt_rates(:ncol,:, 609)*sol(:ncol,:, 238)*sol(:ncol,:, 147) ! rate_const*BCARYNO3*NO + rxt_rates(:ncol,:, 610) = rxt_rates(:ncol,:, 610)*sol(:ncol,:, 238)*sol(:ncol,:, 149) ! rate_const*BCARYNO3*NO3 + rxt_rates(:ncol,:, 611) = rxt_rates(:ncol,:, 611)*sol(:ncol,:, 238)*sol(:ncol,:, 300) ! rate_const*BCARYNO3*TERPA2CO3 + rxt_rates(:ncol,:, 612) = rxt_rates(:ncol,:, 612)*sol(:ncol,:, 238)*sol(:ncol,:, 302) ! rate_const*BCARYNO3*TERPA3CO3 + rxt_rates(:ncol,:, 613) = rxt_rates(:ncol,:, 613)*sol(:ncol,:, 238)*sol(:ncol,:, 305) ! rate_const*BCARYNO3*TERPACO3 + rxt_rates(:ncol,:, 614) = rxt_rates(:ncol,:, 614)*sol(:ncol,:, 239)*sol(:ncol,:, 250) ! rate_const*BCARYO2*CH3CO3 + rxt_rates(:ncol,:, 615) = rxt_rates(:ncol,:, 615)*sol(:ncol,:, 239)*sol(:ncol,:, 251) ! rate_const*BCARYO2*CH3O2 + rxt_rates(:ncol,:, 616) = rxt_rates(:ncol,:, 616)*sol(:ncol,:, 239)*sol(:ncol,:, 256) ! rate_const*BCARYO2*HO2 + rxt_rates(:ncol,:, 617) = rxt_rates(:ncol,:, 617)*sol(:ncol,:, 239)*sol(:ncol,:, 147) ! rate_const*BCARYO2*NO + rxt_rates(:ncol,:, 618) = rxt_rates(:ncol,:, 618)*sol(:ncol,:, 239)*sol(:ncol,:, 149) ! rate_const*BCARYO2*NO3 + rxt_rates(:ncol,:, 619) = rxt_rates(:ncol,:, 619)*sol(:ncol,:, 239)*sol(:ncol,:, 300) ! rate_const*BCARYO2*TERPA2CO3 + rxt_rates(:ncol,:, 620) = rxt_rates(:ncol,:, 620)*sol(:ncol,:, 239)*sol(:ncol,:, 302) ! rate_const*BCARYO2*TERPA3CO3 + rxt_rates(:ncol,:, 621) = rxt_rates(:ncol,:, 621)*sol(:ncol,:, 239)*sol(:ncol,:, 305) ! rate_const*BCARYO2*TERPACO3 + rxt_rates(:ncol,:, 622) = rxt_rates(:ncol,:, 622)*sol(:ncol,:, 7)*sol(:ncol,:, 157) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 623) = rxt_rates(:ncol,:, 623)*sol(:ncol,:, 7)*sol(:ncol,:, 293) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 624) = rxt_rates(:ncol,:, 624)*sol(:ncol,:, 17)*sol(:ncol,:, 149) ! rate_const*BPIN*NO3 + rxt_rates(:ncol,:, 625) = rxt_rates(:ncol,:, 625)*sol(:ncol,:, 243)*sol(:ncol,:, 243) ! rate_const*BPINNO3*BPINNO3 + rxt_rates(:ncol,:, 626) = rxt_rates(:ncol,:, 626)*sol(:ncol,:, 243)*sol(:ncol,:, 250) ! rate_const*BPINNO3*CH3CO3 + rxt_rates(:ncol,:, 627) = rxt_rates(:ncol,:, 627)*sol(:ncol,:, 243)*sol(:ncol,:, 251) ! rate_const*BPINNO3*CH3O2 + rxt_rates(:ncol,:, 628) = rxt_rates(:ncol,:, 628)*sol(:ncol,:, 243)*sol(:ncol,:, 256) ! rate_const*BPINNO3*HO2 + rxt_rates(:ncol,:, 629) = rxt_rates(:ncol,:, 629)*sol(:ncol,:, 243)*sol(:ncol,:, 147) ! rate_const*BPINNO3*NO + rxt_rates(:ncol,:, 630) = rxt_rates(:ncol,:, 630)*sol(:ncol,:, 243)*sol(:ncol,:, 149) ! rate_const*BPINNO3*NO3 + rxt_rates(:ncol,:, 631) = rxt_rates(:ncol,:, 631)*sol(:ncol,:, 243)*sol(:ncol,:, 300) ! rate_const*BPINNO3*TERPA2CO3 + rxt_rates(:ncol,:, 632) = rxt_rates(:ncol,:, 632)*sol(:ncol,:, 243)*sol(:ncol,:, 302) ! rate_const*BPINNO3*TERPA3CO3 + rxt_rates(:ncol,:, 633) = rxt_rates(:ncol,:, 633)*sol(:ncol,:, 243)*sol(:ncol,:, 305) ! rate_const*BPINNO3*TERPACO3 + rxt_rates(:ncol,:, 634) = rxt_rates(:ncol,:, 634)*sol(:ncol,:, 244)*sol(:ncol,:, 250) ! rate_const*BPINO2*CH3CO3 + rxt_rates(:ncol,:, 635) = rxt_rates(:ncol,:, 635)*sol(:ncol,:, 244)*sol(:ncol,:, 251) ! rate_const*BPINO2*CH3O2 + rxt_rates(:ncol,:, 636) = rxt_rates(:ncol,:, 636)*sol(:ncol,:, 244)*sol(:ncol,:, 256) ! rate_const*BPINO2*HO2 + rxt_rates(:ncol,:, 637) = rxt_rates(:ncol,:, 637)*sol(:ncol,:, 244)*sol(:ncol,:, 147) ! rate_const*BPINO2*NO + rxt_rates(:ncol,:, 638) = rxt_rates(:ncol,:, 638)*sol(:ncol,:, 244)*sol(:ncol,:, 149) ! rate_const*BPINO2*NO3 + rxt_rates(:ncol,:, 639) = rxt_rates(:ncol,:, 639)*sol(:ncol,:, 244)*sol(:ncol,:, 300) ! rate_const*BPINO2*TERPA2CO3 + rxt_rates(:ncol,:, 640) = rxt_rates(:ncol,:, 640)*sol(:ncol,:, 244)*sol(:ncol,:, 302) ! rate_const*BPINO2*TERPA3CO3 + rxt_rates(:ncol,:, 641) = rxt_rates(:ncol,:, 641)*sol(:ncol,:, 244)*sol(:ncol,:, 305) ! rate_const*BPINO2*TERPACO3 + rxt_rates(:ncol,:, 642) = rxt_rates(:ncol,:, 642)*sol(:ncol,:, 17)*sol(:ncol,:, 157) ! rate_const*BPIN*O3 + rxt_rates(:ncol,:, 643) = rxt_rates(:ncol,:, 643)*sol(:ncol,:, 17)*sol(:ncol,:, 293) ! rate_const*BPIN*OH + rxt_rates(:ncol,:, 644) = rxt_rates(:ncol,:, 644)*sol(:ncol,:, 125)*sol(:ncol,:, 149) ! rate_const*LIMON*NO3 + rxt_rates(:ncol,:, 645) = rxt_rates(:ncol,:, 645)*sol(:ncol,:, 279)*sol(:ncol,:, 250) ! rate_const*LIMONNO3*CH3CO3 + rxt_rates(:ncol,:, 646) = rxt_rates(:ncol,:, 646)*sol(:ncol,:, 279)*sol(:ncol,:, 251) ! rate_const*LIMONNO3*CH3O2 + rxt_rates(:ncol,:, 647) = rxt_rates(:ncol,:, 647)*sol(:ncol,:, 279)*sol(:ncol,:, 256) ! rate_const*LIMONNO3*HO2 + rxt_rates(:ncol,:, 648) = rxt_rates(:ncol,:, 648)*sol(:ncol,:, 279)*sol(:ncol,:, 279) ! rate_const*LIMONNO3*LIMONNO3 + rxt_rates(:ncol,:, 649) = rxt_rates(:ncol,:, 649)*sol(:ncol,:, 279)*sol(:ncol,:, 147) ! rate_const*LIMONNO3*NO + rxt_rates(:ncol,:, 650) = rxt_rates(:ncol,:, 650)*sol(:ncol,:, 279)*sol(:ncol,:, 149) ! rate_const*LIMONNO3*NO3 + rxt_rates(:ncol,:, 651) = rxt_rates(:ncol,:, 651)*sol(:ncol,:, 279)*sol(:ncol,:, 300) ! rate_const*LIMONNO3*TERPA2CO3 + rxt_rates(:ncol,:, 652) = rxt_rates(:ncol,:, 652)*sol(:ncol,:, 279)*sol(:ncol,:, 302) ! rate_const*LIMONNO3*TERPA3CO3 + rxt_rates(:ncol,:, 653) = rxt_rates(:ncol,:, 653)*sol(:ncol,:, 279)*sol(:ncol,:, 305) ! rate_const*LIMONNO3*TERPACO3 + rxt_rates(:ncol,:, 654) = rxt_rates(:ncol,:, 654)*sol(:ncol,:, 280)*sol(:ncol,:, 250) ! rate_const*LIMONO2*CH3CO3 + rxt_rates(:ncol,:, 655) = rxt_rates(:ncol,:, 655)*sol(:ncol,:, 280)*sol(:ncol,:, 251) ! rate_const*LIMONO2*CH3O2 + rxt_rates(:ncol,:, 656) = rxt_rates(:ncol,:, 656)*sol(:ncol,:, 280)*sol(:ncol,:, 256) ! rate_const*LIMONO2*HO2 + rxt_rates(:ncol,:, 657) = rxt_rates(:ncol,:, 657)*sol(:ncol,:, 280)*sol(:ncol,:, 147) ! rate_const*LIMONO2*NO + rxt_rates(:ncol,:, 658) = rxt_rates(:ncol,:, 658)*sol(:ncol,:, 280)*sol(:ncol,:, 149) ! rate_const*LIMONO2*NO3 + rxt_rates(:ncol,:, 659) = rxt_rates(:ncol,:, 659)*sol(:ncol,:, 280)*sol(:ncol,:, 300) ! rate_const*LIMONO2*TERPA2CO3 + rxt_rates(:ncol,:, 660) = rxt_rates(:ncol,:, 660)*sol(:ncol,:, 280)*sol(:ncol,:, 302) ! rate_const*LIMONO2*TERPA3CO3 + rxt_rates(:ncol,:, 661) = rxt_rates(:ncol,:, 661)*sol(:ncol,:, 280)*sol(:ncol,:, 305) ! rate_const*LIMONO2*TERPACO3 + rxt_rates(:ncol,:, 662) = rxt_rates(:ncol,:, 662)*sol(:ncol,:, 125)*sol(:ncol,:, 157) ! rate_const*LIMON*O3 + rxt_rates(:ncol,:, 663) = rxt_rates(:ncol,:, 663)*sol(:ncol,:, 125)*sol(:ncol,:, 293) ! rate_const*LIMON*OH + rxt_rates(:ncol,:, 664) = rxt_rates(:ncol,:, 664)*sol(:ncol,:, 135)*sol(:ncol,:, 149) ! rate_const*MYRC*NO3 + rxt_rates(:ncol,:, 665) = rxt_rates(:ncol,:, 665)*sol(:ncol,:, 288)*sol(:ncol,:, 250) ! rate_const*MYRCNO3*CH3CO3 + rxt_rates(:ncol,:, 666) = rxt_rates(:ncol,:, 666)*sol(:ncol,:, 288)*sol(:ncol,:, 251) ! rate_const*MYRCNO3*CH3O2 + rxt_rates(:ncol,:, 667) = rxt_rates(:ncol,:, 667)*sol(:ncol,:, 288)*sol(:ncol,:, 256) ! rate_const*MYRCNO3*HO2 + rxt_rates(:ncol,:, 668) = rxt_rates(:ncol,:, 668)*sol(:ncol,:, 288)*sol(:ncol,:, 288) ! rate_const*MYRCNO3*MYRCNO3 + rxt_rates(:ncol,:, 669) = rxt_rates(:ncol,:, 669)*sol(:ncol,:, 288)*sol(:ncol,:, 147) ! rate_const*MYRCNO3*NO + rxt_rates(:ncol,:, 670) = rxt_rates(:ncol,:, 670)*sol(:ncol,:, 288)*sol(:ncol,:, 149) ! rate_const*MYRCNO3*NO3 + rxt_rates(:ncol,:, 671) = rxt_rates(:ncol,:, 671)*sol(:ncol,:, 288)*sol(:ncol,:, 300) ! rate_const*MYRCNO3*TERPA2CO3 + rxt_rates(:ncol,:, 672) = rxt_rates(:ncol,:, 672)*sol(:ncol,:, 288)*sol(:ncol,:, 302) ! rate_const*MYRCNO3*TERPA3CO3 + rxt_rates(:ncol,:, 673) = rxt_rates(:ncol,:, 673)*sol(:ncol,:, 288)*sol(:ncol,:, 305) ! rate_const*MYRCNO3*TERPACO3 + rxt_rates(:ncol,:, 674) = rxt_rates(:ncol,:, 674)*sol(:ncol,:, 289)*sol(:ncol,:, 250) ! rate_const*MYRCO2*CH3CO3 + rxt_rates(:ncol,:, 675) = rxt_rates(:ncol,:, 675)*sol(:ncol,:, 289)*sol(:ncol,:, 251) ! rate_const*MYRCO2*CH3O2 + rxt_rates(:ncol,:, 676) = rxt_rates(:ncol,:, 676)*sol(:ncol,:, 289)*sol(:ncol,:, 256) ! rate_const*MYRCO2*HO2 + rxt_rates(:ncol,:, 677) = rxt_rates(:ncol,:, 677)*sol(:ncol,:, 289)*sol(:ncol,:, 147) ! rate_const*MYRCO2*NO + rxt_rates(:ncol,:, 678) = rxt_rates(:ncol,:, 678)*sol(:ncol,:, 289)*sol(:ncol,:, 149) ! rate_const*MYRCO2*NO3 + rxt_rates(:ncol,:, 679) = rxt_rates(:ncol,:, 679)*sol(:ncol,:, 289)*sol(:ncol,:, 300) ! rate_const*MYRCO2*TERPA2CO3 + rxt_rates(:ncol,:, 680) = rxt_rates(:ncol,:, 680)*sol(:ncol,:, 289)*sol(:ncol,:, 302) ! rate_const*MYRCO2*TERPA3CO3 + rxt_rates(:ncol,:, 681) = rxt_rates(:ncol,:, 681)*sol(:ncol,:, 289)*sol(:ncol,:, 305) ! rate_const*MYRCO2*TERPACO3 + rxt_rates(:ncol,:, 682) = rxt_rates(:ncol,:, 682)*sol(:ncol,:, 135)*sol(:ncol,:, 157) ! rate_const*MYRC*O3 + rxt_rates(:ncol,:, 683) = rxt_rates(:ncol,:, 683)*sol(:ncol,:, 135)*sol(:ncol,:, 293) ! rate_const*MYRC*OH + rxt_rates(:ncol,:, 684) = rxt_rates(:ncol,:, 684)*sol(:ncol,:, 300)*sol(:ncol,:, 148) ! rate_const*M*TERPA2CO3*NO2 + rxt_rates(:ncol,:, 685) = rxt_rates(:ncol,:, 685)*sol(:ncol,:, 302)*sol(:ncol,:, 148) ! rate_const*M*TERPA3CO3*NO2 + rxt_rates(:ncol,:, 686) = rxt_rates(:ncol,:, 686)*sol(:ncol,:, 305)*sol(:ncol,:, 148) ! rate_const*M*TERPACO3*NO2 + rxt_rates(:ncol,:, 687) = rxt_rates(:ncol,:, 687)*sol(:ncol,:, 297)*sol(:ncol,:, 256) ! rate_const*TERP1OOHO2*HO2 + rxt_rates(:ncol,:, 688) = rxt_rates(:ncol,:, 688)*sol(:ncol,:, 297)*sol(:ncol,:, 147) ! rate_const*TERP1OOHO2*NO + rxt_rates(:ncol,:, 689) = rxt_rates(:ncol,:, 689)*sol(:ncol,:, 198)*sol(:ncol,:, 293) ! rate_const*TERP1OOH*OH + rxt_rates(:ncol,:, 690) = rxt_rates(:ncol,:, 690)*sol(:ncol,:, 199)*sol(:ncol,:, 293) ! rate_const*TERP2AOOH*OH + rxt_rates(:ncol,:, 691) = rxt_rates(:ncol,:, 691)*sol(:ncol,:, 298)*sol(:ncol,:, 256) ! rate_const*TERP2OOHO2*HO2 + rxt_rates(:ncol,:, 692) = rxt_rates(:ncol,:, 692)*sol(:ncol,:, 298)*sol(:ncol,:, 147) ! rate_const*TERP2OOHO2*NO + rxt_rates(:ncol,:, 693) = rxt_rates(:ncol,:, 693)*sol(:ncol,:, 299)*sol(:ncol,:, 250) ! rate_const*TERPA1O2*CH3CO3 + rxt_rates(:ncol,:, 694) = rxt_rates(:ncol,:, 694)*sol(:ncol,:, 299)*sol(:ncol,:, 251) ! rate_const*TERPA1O2*CH3O2 + rxt_rates(:ncol,:, 695) = rxt_rates(:ncol,:, 695)*sol(:ncol,:, 299)*sol(:ncol,:, 256) ! rate_const*TERPA1O2*HO2 + rxt_rates(:ncol,:, 696) = rxt_rates(:ncol,:, 696)*sol(:ncol,:, 299)*sol(:ncol,:, 147) ! rate_const*TERPA1O2*NO + rxt_rates(:ncol,:, 697) = rxt_rates(:ncol,:, 697)*sol(:ncol,:, 299)*sol(:ncol,:, 149) ! rate_const*TERPA1O2*NO3 + rxt_rates(:ncol,:, 698) = rxt_rates(:ncol,:, 698)*sol(:ncol,:, 299)*sol(:ncol,:, 300) ! rate_const*TERPA1O2*TERPA2CO3 + rxt_rates(:ncol,:, 699) = rxt_rates(:ncol,:, 699)*sol(:ncol,:, 299)*sol(:ncol,:, 302) ! rate_const*TERPA1O2*TERPA3CO3 + rxt_rates(:ncol,:, 700) = rxt_rates(:ncol,:, 700)*sol(:ncol,:, 299)*sol(:ncol,:, 305) ! rate_const*TERPA1O2*TERPACO3 + rxt_rates(:ncol,:, 701) = rxt_rates(:ncol,:, 701)*sol(:ncol,:, 300)*sol(:ncol,:, 250) ! rate_const*TERPA2CO3*CH3CO3 + rxt_rates(:ncol,:, 702) = rxt_rates(:ncol,:, 702)*sol(:ncol,:, 300)*sol(:ncol,:, 251) ! rate_const*TERPA2CO3*CH3O2 + rxt_rates(:ncol,:, 703) = rxt_rates(:ncol,:, 703)*sol(:ncol,:, 300)*sol(:ncol,:, 256) ! rate_const*TERPA2CO3*HO2 + rxt_rates(:ncol,:, 704) = rxt_rates(:ncol,:, 704)*sol(:ncol,:, 300)*sol(:ncol,:, 147) ! rate_const*TERPA2CO3*NO + rxt_rates(:ncol,:, 705) = rxt_rates(:ncol,:, 705)*sol(:ncol,:, 300)*sol(:ncol,:, 149) ! rate_const*TERPA2CO3*NO3 + rxt_rates(:ncol,:, 706) = rxt_rates(:ncol,:, 706)*sol(:ncol,:, 300)*sol(:ncol,:, 300) ! rate_const*TERPA2CO3*TERPA2CO3 + rxt_rates(:ncol,:, 707) = rxt_rates(:ncol,:, 707)*sol(:ncol,:, 300)*sol(:ncol,:, 305) ! rate_const*TERPA2CO3*TERPACO3 + rxt_rates(:ncol,:, 708) = rxt_rates(:ncol,:, 708)*sol(:ncol,:, 201)*sol(:ncol,:, 149) ! rate_const*TERPA2*NO3 + rxt_rates(:ncol,:, 709) = rxt_rates(:ncol,:, 709)*sol(:ncol,:, 301)*sol(:ncol,:, 250) ! rate_const*TERPA2O2*CH3CO3 + rxt_rates(:ncol,:, 710) = rxt_rates(:ncol,:, 710)*sol(:ncol,:, 301)*sol(:ncol,:, 251) ! rate_const*TERPA2O2*CH3O2 + rxt_rates(:ncol,:, 711) = rxt_rates(:ncol,:, 711)*sol(:ncol,:, 301)*sol(:ncol,:, 256) ! rate_const*TERPA2O2*HO2 + rxt_rates(:ncol,:, 712) = rxt_rates(:ncol,:, 712)*sol(:ncol,:, 301)*sol(:ncol,:, 147) ! rate_const*TERPA2O2*NO + rxt_rates(:ncol,:, 713) = rxt_rates(:ncol,:, 713)*sol(:ncol,:, 301)*sol(:ncol,:, 149) ! rate_const*TERPA2O2*NO3 + rxt_rates(:ncol,:, 714) = rxt_rates(:ncol,:, 714)*sol(:ncol,:, 301)*sol(:ncol,:, 300) ! rate_const*TERPA2O2*TERPA2CO3 + rxt_rates(:ncol,:, 715) = rxt_rates(:ncol,:, 715)*sol(:ncol,:, 301)*sol(:ncol,:, 302) ! rate_const*TERPA2O2*TERPA3CO3 + rxt_rates(:ncol,:, 716) = rxt_rates(:ncol,:, 716)*sol(:ncol,:, 301)*sol(:ncol,:, 305) ! rate_const*TERPA2O2*TERPACO3 + rxt_rates(:ncol,:, 717) = rxt_rates(:ncol,:, 717)*sol(:ncol,:, 201)*sol(:ncol,:, 293) ! rate_const*TERPA2*OH + rxt_rates(:ncol,:, 718) = rxt_rates(:ncol,:, 718)*sol(:ncol,:, 202)*sol(:ncol,:, 293) ! rate_const*TERPA2PAN*OH + rxt_rates(:ncol,:, 719) = rxt_rates(:ncol,:, 719)*sol(:ncol,:, 302)*sol(:ncol,:, 250) ! rate_const*TERPA3CO3*CH3CO3 + rxt_rates(:ncol,:, 720) = rxt_rates(:ncol,:, 720)*sol(:ncol,:, 302)*sol(:ncol,:, 251) ! rate_const*TERPA3CO3*CH3O2 + rxt_rates(:ncol,:, 721) = rxt_rates(:ncol,:, 721)*sol(:ncol,:, 302)*sol(:ncol,:, 256) ! rate_const*TERPA3CO3*HO2 + rxt_rates(:ncol,:, 722) = rxt_rates(:ncol,:, 722)*sol(:ncol,:, 302)*sol(:ncol,:, 147) ! rate_const*TERPA3CO3*NO + rxt_rates(:ncol,:, 723) = rxt_rates(:ncol,:, 723)*sol(:ncol,:, 302)*sol(:ncol,:, 149) ! rate_const*TERPA3CO3*NO3 + rxt_rates(:ncol,:, 724) = rxt_rates(:ncol,:, 724)*sol(:ncol,:, 302)*sol(:ncol,:, 300) ! rate_const*TERPA3CO3*TERPA2CO3 + rxt_rates(:ncol,:, 725) = rxt_rates(:ncol,:, 725)*sol(:ncol,:, 302)*sol(:ncol,:, 302) ! rate_const*TERPA3CO3*TERPA3CO3 + rxt_rates(:ncol,:, 726) = rxt_rates(:ncol,:, 726)*sol(:ncol,:, 302)*sol(:ncol,:, 305) ! rate_const*TERPA3CO3*TERPACO3 + rxt_rates(:ncol,:, 727) = rxt_rates(:ncol,:, 727)*sol(:ncol,:, 203)*sol(:ncol,:, 149) ! rate_const*TERPA3*NO3 + rxt_rates(:ncol,:, 728) = rxt_rates(:ncol,:, 728)*sol(:ncol,:, 303)*sol(:ncol,:, 250) ! rate_const*TERPA3O2*CH3CO3 + rxt_rates(:ncol,:, 729) = rxt_rates(:ncol,:, 729)*sol(:ncol,:, 303)*sol(:ncol,:, 251) ! rate_const*TERPA3O2*CH3O2 + rxt_rates(:ncol,:, 730) = rxt_rates(:ncol,:, 730)*sol(:ncol,:, 303)*sol(:ncol,:, 256) ! rate_const*TERPA3O2*HO2 + rxt_rates(:ncol,:, 731) = rxt_rates(:ncol,:, 731)*sol(:ncol,:, 303)*sol(:ncol,:, 147) ! rate_const*TERPA3O2*NO + rxt_rates(:ncol,:, 732) = rxt_rates(:ncol,:, 732)*sol(:ncol,:, 303)*sol(:ncol,:, 149) ! rate_const*TERPA3O2*NO3 + rxt_rates(:ncol,:, 733) = rxt_rates(:ncol,:, 733)*sol(:ncol,:, 303)*sol(:ncol,:, 300) ! rate_const*TERPA3O2*TERPA2CO3 + rxt_rates(:ncol,:, 734) = rxt_rates(:ncol,:, 734)*sol(:ncol,:, 303)*sol(:ncol,:, 302) ! rate_const*TERPA3O2*TERPA3CO3 + rxt_rates(:ncol,:, 735) = rxt_rates(:ncol,:, 735)*sol(:ncol,:, 303)*sol(:ncol,:, 305) ! rate_const*TERPA3O2*TERPACO3 + rxt_rates(:ncol,:, 736) = rxt_rates(:ncol,:, 736)*sol(:ncol,:, 203)*sol(:ncol,:, 293) ! rate_const*TERPA3*OH + rxt_rates(:ncol,:, 737) = rxt_rates(:ncol,:, 737)*sol(:ncol,:, 204)*sol(:ncol,:, 293) ! rate_const*TERPA3PAN*OH + rxt_rates(:ncol,:, 738) = rxt_rates(:ncol,:, 738)*sol(:ncol,:, 304)*sol(:ncol,:, 250) ! rate_const*TERPA4O2*CH3CO3 + rxt_rates(:ncol,:, 739) = rxt_rates(:ncol,:, 739)*sol(:ncol,:, 304)*sol(:ncol,:, 251) ! rate_const*TERPA4O2*CH3O2 + rxt_rates(:ncol,:, 740) = rxt_rates(:ncol,:, 740)*sol(:ncol,:, 304)*sol(:ncol,:, 256) ! rate_const*TERPA4O2*HO2 + rxt_rates(:ncol,:, 741) = rxt_rates(:ncol,:, 741)*sol(:ncol,:, 304)*sol(:ncol,:, 147) ! rate_const*TERPA4O2*NO + rxt_rates(:ncol,:, 742) = rxt_rates(:ncol,:, 742)*sol(:ncol,:, 304)*sol(:ncol,:, 149) ! rate_const*TERPA4O2*NO3 + rxt_rates(:ncol,:, 743) = rxt_rates(:ncol,:, 743)*sol(:ncol,:, 304)*sol(:ncol,:, 300) ! rate_const*TERPA4O2*TERPA2CO3 + rxt_rates(:ncol,:, 744) = rxt_rates(:ncol,:, 744)*sol(:ncol,:, 304)*sol(:ncol,:, 302) ! rate_const*TERPA4O2*TERPA3CO3 + rxt_rates(:ncol,:, 745) = rxt_rates(:ncol,:, 745)*sol(:ncol,:, 304)*sol(:ncol,:, 305) ! rate_const*TERPA4O2*TERPACO3 + rxt_rates(:ncol,:, 746) = rxt_rates(:ncol,:, 746)*sol(:ncol,:, 206)*sol(:ncol,:, 293) ! rate_const*TERPACID2*OH + rxt_rates(:ncol,:, 747) = rxt_rates(:ncol,:, 747)*sol(:ncol,:, 207)*sol(:ncol,:, 293) ! rate_const*TERPACID3*OH + rxt_rates(:ncol,:, 748) = rxt_rates(:ncol,:, 748)*sol(:ncol,:, 205)*sol(:ncol,:, 293) ! rate_const*TERPACID*OH + rxt_rates(:ncol,:, 749) = rxt_rates(:ncol,:, 749)*sol(:ncol,:, 305)*sol(:ncol,:, 250) ! rate_const*TERPACO3*CH3CO3 + rxt_rates(:ncol,:, 750) = rxt_rates(:ncol,:, 750)*sol(:ncol,:, 305)*sol(:ncol,:, 251) ! rate_const*TERPACO3*CH3O2 + rxt_rates(:ncol,:, 751) = rxt_rates(:ncol,:, 751)*sol(:ncol,:, 305)*sol(:ncol,:, 256) ! rate_const*TERPACO3*HO2 + rxt_rates(:ncol,:, 752) = rxt_rates(:ncol,:, 752)*sol(:ncol,:, 305)*sol(:ncol,:, 147) ! rate_const*TERPACO3*NO + rxt_rates(:ncol,:, 753) = rxt_rates(:ncol,:, 753)*sol(:ncol,:, 305)*sol(:ncol,:, 149) ! rate_const*TERPACO3*NO3 + rxt_rates(:ncol,:, 754) = rxt_rates(:ncol,:, 754)*sol(:ncol,:, 305)*sol(:ncol,:, 305) ! rate_const*TERPACO3*TERPACO3 + rxt_rates(:ncol,:, 755) = rxt_rates(:ncol,:, 755)*sol(:ncol,:, 200)*sol(:ncol,:, 149) ! rate_const*TERPA*NO3 + rxt_rates(:ncol,:, 756) = rxt_rates(:ncol,:, 756)*sol(:ncol,:, 200)*sol(:ncol,:, 293) ! rate_const*TERPA*OH + rxt_rates(:ncol,:, 757) = rxt_rates(:ncol,:, 757)*sol(:ncol,:, 208)*sol(:ncol,:, 293) ! rate_const*TERPAPAN*OH + rxt_rates(:ncol,:, 758) = rxt_rates(:ncol,:, 758)*sol(:ncol,:, 209)*sol(:ncol,:, 293) ! rate_const*TERPDHDP*OH + rxt_rates(:ncol,:, 759) = rxt_rates(:ncol,:, 759)*sol(:ncol,:, 210)*sol(:ncol,:, 149) ! rate_const*TERPF1*NO3 + rxt_rates(:ncol,:, 760) = rxt_rates(:ncol,:, 760)*sol(:ncol,:, 306)*sol(:ncol,:, 256) ! rate_const*TERPF1O2*HO2 + rxt_rates(:ncol,:, 761) = rxt_rates(:ncol,:, 761)*sol(:ncol,:, 306)*sol(:ncol,:, 147) ! rate_const*TERPF1O2*NO + rxt_rates(:ncol,:, 762) = rxt_rates(:ncol,:, 762)*sol(:ncol,:, 210)*sol(:ncol,:, 157) ! rate_const*TERPF1*O3 + rxt_rates(:ncol,:, 763) = rxt_rates(:ncol,:, 763)*sol(:ncol,:, 210)*sol(:ncol,:, 293) ! rate_const*TERPF1*OH + rxt_rates(:ncol,:, 764) = rxt_rates(:ncol,:, 764)*sol(:ncol,:, 211)*sol(:ncol,:, 149) ! rate_const*TERPF2*NO3 + rxt_rates(:ncol,:, 765) = rxt_rates(:ncol,:, 765)*sol(:ncol,:, 307)*sol(:ncol,:, 256) ! rate_const*TERPF2O2*HO2 + rxt_rates(:ncol,:, 766) = rxt_rates(:ncol,:, 766)*sol(:ncol,:, 307)*sol(:ncol,:, 147) ! rate_const*TERPF2O2*NO + rxt_rates(:ncol,:, 767) = rxt_rates(:ncol,:, 767)*sol(:ncol,:, 211)*sol(:ncol,:, 157) ! rate_const*TERPF2*O3 + rxt_rates(:ncol,:, 768) = rxt_rates(:ncol,:, 768)*sol(:ncol,:, 211)*sol(:ncol,:, 293) ! rate_const*TERPF2*OH + rxt_rates(:ncol,:, 769) = rxt_rates(:ncol,:, 769)*sol(:ncol,:, 212)*sol(:ncol,:, 293) ! rate_const*TERPFDN*OH + rxt_rates(:ncol,:, 770) = rxt_rates(:ncol,:, 770)*sol(:ncol,:, 213)*sol(:ncol,:, 293) ! rate_const*TERPHFN*OH + rxt_rates(:ncol,:, 771) = rxt_rates(:ncol,:, 771)*sol(:ncol,:, 214)*sol(:ncol,:, 293) ! rate_const*TERPK*OH + rxt_rates(:ncol,:, 772) = rxt_rates(:ncol,:, 772)*sol(:ncol,:, 308)*sol(:ncol,:, 256) ! rate_const*TERPNPS1O2*HO2 + rxt_rates(:ncol,:, 773) = rxt_rates(:ncol,:, 773)*sol(:ncol,:, 308)*sol(:ncol,:, 147) ! rate_const*TERPNPS1O2*NO + rxt_rates(:ncol,:, 774) = rxt_rates(:ncol,:, 774)*sol(:ncol,:, 216)*sol(:ncol,:, 293) ! rate_const*TERPNPS1*OH + rxt_rates(:ncol,:, 775) = rxt_rates(:ncol,:, 775)*sol(:ncol,:, 215)*sol(:ncol,:, 293) ! rate_const*TERPNPS*OH + rxt_rates(:ncol,:, 776) = rxt_rates(:ncol,:, 776)*sol(:ncol,:, 309)*sol(:ncol,:, 256) ! rate_const*TERPNPT1O2*HO2 + rxt_rates(:ncol,:, 777) = rxt_rates(:ncol,:, 777)*sol(:ncol,:, 309)*sol(:ncol,:, 147) ! rate_const*TERPNPT1O2*NO + rxt_rates(:ncol,:, 778) = rxt_rates(:ncol,:, 778)*sol(:ncol,:, 218)*sol(:ncol,:, 293) ! rate_const*TERPNPT1*OH + rxt_rates(:ncol,:, 779) = rxt_rates(:ncol,:, 779)*sol(:ncol,:, 217)*sol(:ncol,:, 293) ! rate_const*TERPNPT*OH + rxt_rates(:ncol,:, 780) = rxt_rates(:ncol,:, 780)*sol(:ncol,:, 310)*sol(:ncol,:, 256) ! rate_const*TERPNS1O2*HO2 + rxt_rates(:ncol,:, 781) = rxt_rates(:ncol,:, 781)*sol(:ncol,:, 310)*sol(:ncol,:, 147) ! rate_const*TERPNS1O2*NO + rxt_rates(:ncol,:, 782) = rxt_rates(:ncol,:, 782)*sol(:ncol,:, 220)*sol(:ncol,:, 293) ! rate_const*TERPNS1*OH + rxt_rates(:ncol,:, 783) = rxt_rates(:ncol,:, 783)*sol(:ncol,:, 219)*sol(:ncol,:, 293) ! rate_const*TERPNS*OH + rxt_rates(:ncol,:, 784) = rxt_rates(:ncol,:, 784)*sol(:ncol,:, 311)*sol(:ncol,:, 256) ! rate_const*TERPNT1O2*HO2 + rxt_rates(:ncol,:, 785) = rxt_rates(:ncol,:, 785)*sol(:ncol,:, 311)*sol(:ncol,:, 147) ! rate_const*TERPNT1O2*NO + rxt_rates(:ncol,:, 786) = rxt_rates(:ncol,:, 786)*sol(:ncol,:, 222)*sol(:ncol,:, 293) ! rate_const*TERPNT1*OH + rxt_rates(:ncol,:, 787) = rxt_rates(:ncol,:, 787)*sol(:ncol,:, 221)*sol(:ncol,:, 293) ! rate_const*TERPNT*OH + rxt_rates(:ncol,:, 788) = rxt_rates(:ncol,:, 788)*sol(:ncol,:, 224)*sol(:ncol,:, 293) ! rate_const*TERPOOHL*OH + rxt_rates(:ncol,:, 789) = rxt_rates(:ncol,:, 789)*sol(:ncol,:, 223)*sol(:ncol,:, 293) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 790) = rxt_rates(:ncol,:, 790)*sol(:ncol,:, 202) ! rate_const*M*TERPA2PAN + rxt_rates(:ncol,:, 791) = rxt_rates(:ncol,:, 791)*sol(:ncol,:, 204) ! rate_const*M*TERPA3PAN + rxt_rates(:ncol,:, 792) = rxt_rates(:ncol,:, 792)*sol(:ncol,:, 208) ! rate_const*M*TERPAPAN + rxt_rates(:ncol,:, 793) = rxt_rates(:ncol,:, 793)*sol(:ncol,:, 69)*sol(:ncol,:, 149) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 794) = rxt_rates(:ncol,:, 794)*sol(:ncol,:, 69)*sol(:ncol,:, 293) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 795) = rxt_rates(:ncol,:, 795)*sol(:ncol,:, 160)*sol(:ncol,:, 156) ! rate_const*OCS*O + rxt_rates(:ncol,:, 796) = rxt_rates(:ncol,:, 796)*sol(:ncol,:, 160)*sol(:ncol,:, 293) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 797) = rxt_rates(:ncol,:, 797)*sol(:ncol,:, 171) ! rate_const*O2*S + rxt_rates(:ncol,:, 798) = rxt_rates(:ncol,:, 798)*sol(:ncol,:, 174)*sol(:ncol,:, 293) ! rate_const*M*SO2*OH rxt_rates(:ncol,:, 799) = rxt_rates(:ncol,:, 799)*sol(:ncol,:, 171)*sol(:ncol,:, 157) ! rate_const*S*O3 rxt_rates(:ncol,:, 800) = rxt_rates(:ncol,:, 800)*sol(:ncol,:, 173)*sol(:ncol,:, 20) ! rate_const*SO*BRO rxt_rates(:ncol,:, 801) = rxt_rates(:ncol,:, 801)*sol(:ncol,:, 173)*sol(:ncol,:, 60) ! rate_const*SO*CLO @@ -816,102 +816,101 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 806) = rxt_rates(:ncol,:, 806)*sol(:ncol,:, 173)*sol(:ncol,:, 159) ! rate_const*SO*OCLO rxt_rates(:ncol,:, 807) = rxt_rates(:ncol,:, 807)*sol(:ncol,:, 173)*sol(:ncol,:, 293) ! rate_const*SO*OH rxt_rates(:ncol,:, 808) = rxt_rates(:ncol,:, 808)*sol(:ncol,:, 69)*sol(:ncol,:, 293) ! rate_const*DMS*OH - rxt_rates(:ncol,:, 809) = rxt_rates(:ncol,:, 809)*sol(:ncol,:, 174)*sol(:ncol,:, 293) ! rate_const*SO2*OH - rxt_rates(:ncol,:, 810) = rxt_rates(:ncol,:, 810)*sol(:ncol,:, 175)*sol(:ncol,:, 317) ! rate_const*SO3*H2O - rxt_rates(:ncol,:, 811) = rxt_rates(:ncol,:, 811)*sol(:ncol,:, 143)*sol(:ncol,:, 293) ! rate_const*NH3*OH - rxt_rates(:ncol,:, 812) = rxt_rates(:ncol,:, 812)*sol(:ncol,:, 77) ! rate_const*GLYOXAL - rxt_rates(:ncol,:, 813) = rxt_rates(:ncol,:, 813)*sol(:ncol,:, 256) ! rate_const*HO2 - rxt_rates(:ncol,:, 814) = rxt_rates(:ncol,:, 814)*sol(:ncol,:, 97) ! rate_const*HONITR - rxt_rates(:ncol,:, 815) = rxt_rates(:ncol,:, 815)*sol(:ncol,:, 105) ! rate_const*ICHE - rxt_rates(:ncol,:, 816) = rxt_rates(:ncol,:, 816)*sol(:ncol,:, 106) ! rate_const*IEPOX - rxt_rates(:ncol,:, 817) = rxt_rates(:ncol,:, 817)*sol(:ncol,:, 107) ! rate_const*INHEB - rxt_rates(:ncol,:, 818) = rxt_rates(:ncol,:, 818)*sol(:ncol,:, 108) ! rate_const*INHED - rxt_rates(:ncol,:, 819) = rxt_rates(:ncol,:, 819)*sol(:ncol,:, 121) ! rate_const*ISOPNOOHD - rxt_rates(:ncol,:, 820) = rxt_rates(:ncol,:, 820)*sol(:ncol,:, 110) ! rate_const*ISOPFDN - rxt_rates(:ncol,:, 821) = rxt_rates(:ncol,:, 821)*sol(:ncol,:, 111) ! rate_const*ISOPFDNC - rxt_rates(:ncol,:, 822) = rxt_rates(:ncol,:, 822)*sol(:ncol,:, 112) ! rate_const*ISOPFNC - rxt_rates(:ncol,:, 823) = rxt_rates(:ncol,:, 823)*sol(:ncol,:, 113) ! rate_const*ISOPFNP - rxt_rates(:ncol,:, 824) = rxt_rates(:ncol,:, 824)*sol(:ncol,:, 114) ! rate_const*ISOPHFP - rxt_rates(:ncol,:, 825) = rxt_rates(:ncol,:, 825)*sol(:ncol,:, 115) ! rate_const*ISOPN1D - rxt_rates(:ncol,:, 826) = rxt_rates(:ncol,:, 826)*sol(:ncol,:, 116) ! rate_const*ISOPN2B - rxt_rates(:ncol,:, 827) = rxt_rates(:ncol,:, 827)*sol(:ncol,:, 118) ! rate_const*ISOPN4D - rxt_rates(:ncol,:, 828) = rxt_rates(:ncol,:, 828)*sol(:ncol,:, 138) ! rate_const*N2O5 - rxt_rates(:ncol,:, 829) = rxt_rates(:ncol,:, 829)*sol(:ncol,:, 139) ! rate_const*NC4CHO - rxt_rates(:ncol,:, 830) = rxt_rates(:ncol,:, 830)*sol(:ncol,:, 144) ! rate_const*NH4 - rxt_rates(:ncol,:, 831) = rxt_rates(:ncol,:, 831)*sol(:ncol,:, 148) ! rate_const*NO2 - rxt_rates(:ncol,:, 832) = rxt_rates(:ncol,:, 832)*sol(:ncol,:, 149) ! rate_const*NO3 - rxt_rates(:ncol,:, 833) = rxt_rates(:ncol,:, 833)*sol(:ncol,:, 161) ! rate_const*ONITR - rxt_rates(:ncol,:, 834) = rxt_rates(:ncol,:, 834)*sol(:ncol,:, 194) ! rate_const*SQTN - rxt_rates(:ncol,:, 835) = rxt_rates(:ncol,:, 835)*sol(:ncol,:, 209) ! rate_const*TERPDHDP - rxt_rates(:ncol,:, 836) = rxt_rates(:ncol,:, 836)*sol(:ncol,:, 212) ! rate_const*TERPFDN - rxt_rates(:ncol,:, 837) = rxt_rates(:ncol,:, 837)*sol(:ncol,:, 213) ! rate_const*TERPHFN - rxt_rates(:ncol,:, 838) = rxt_rates(:ncol,:, 838)*sol(:ncol,:, 218) ! rate_const*TERPNPT1 - rxt_rates(:ncol,:, 839) = rxt_rates(:ncol,:, 839)*sol(:ncol,:, 217) ! rate_const*TERPNPT - rxt_rates(:ncol,:, 840) = rxt_rates(:ncol,:, 840)*sol(:ncol,:, 222) ! rate_const*TERPNT1 - rxt_rates(:ncol,:, 841) = rxt_rates(:ncol,:, 841)*sol(:ncol,:, 221) ! rate_const*TERPNT - rxt_rates(:ncol,:, 842) = rxt_rates(:ncol,:, 842)*sol(:ncol,:, 4)*sol(:ncol,:, 149) ! rate_const*APIN*NO3 - rxt_rates(:ncol,:, 843) = rxt_rates(:ncol,:, 843)*sol(:ncol,:, 237)*sol(:ncol,:, 256) ! rate_const*APINO2VBS*HO2 - rxt_rates(:ncol,:, 844) = rxt_rates(:ncol,:, 844)*sol(:ncol,:, 237)*sol(:ncol,:, 147) ! rate_const*APINO2VBS*NO - rxt_rates(:ncol,:, 845) = rxt_rates(:ncol,:, 845)*sol(:ncol,:, 4)*sol(:ncol,:, 157) ! rate_const*APIN*O3 - rxt_rates(:ncol,:, 846) = rxt_rates(:ncol,:, 846)*sol(:ncol,:, 4)*sol(:ncol,:, 293) ! rate_const*APIN*OH - rxt_rates(:ncol,:, 847) = rxt_rates(:ncol,:, 847)*sol(:ncol,:, 7)*sol(:ncol,:, 149) ! rate_const*BCARY*NO3 - rxt_rates(:ncol,:, 848) = rxt_rates(:ncol,:, 848)*sol(:ncol,:, 240)*sol(:ncol,:, 256) ! rate_const*BCARYO2VBS*HO2 - rxt_rates(:ncol,:, 849) = rxt_rates(:ncol,:, 849)*sol(:ncol,:, 240)*sol(:ncol,:, 147) ! rate_const*BCARYO2VBS*NO - rxt_rates(:ncol,:, 850) = rxt_rates(:ncol,:, 850)*sol(:ncol,:, 7)*sol(:ncol,:, 157) ! rate_const*BCARY*O3 - rxt_rates(:ncol,:, 851) = rxt_rates(:ncol,:, 851)*sol(:ncol,:, 7)*sol(:ncol,:, 293) ! rate_const*BCARY*OH - rxt_rates(:ncol,:, 852) = rxt_rates(:ncol,:, 852)*sol(:ncol,:, 8)*sol(:ncol,:, 293) ! rate_const*BENZENE*OH - rxt_rates(:ncol,:, 853) = rxt_rates(:ncol,:, 853)*sol(:ncol,:, 242)*sol(:ncol,:, 256) ! rate_const*BENZO2VBS*HO2 - rxt_rates(:ncol,:, 854) = rxt_rates(:ncol,:, 854)*sol(:ncol,:, 242)*sol(:ncol,:, 147) ! rate_const*BENZO2VBS*NO - rxt_rates(:ncol,:, 855) = rxt_rates(:ncol,:, 855)*sol(:ncol,:, 17)*sol(:ncol,:, 149) ! rate_const*BPIN*NO3 - rxt_rates(:ncol,:, 856) = rxt_rates(:ncol,:, 856)*sol(:ncol,:, 245)*sol(:ncol,:, 256) ! rate_const*BPINO2VBS*HO2 - rxt_rates(:ncol,:, 857) = rxt_rates(:ncol,:, 857)*sol(:ncol,:, 245)*sol(:ncol,:, 147) ! rate_const*BPINO2VBS*NO - rxt_rates(:ncol,:, 858) = rxt_rates(:ncol,:, 858)*sol(:ncol,:, 17)*sol(:ncol,:, 157) ! rate_const*BPIN*O3 - rxt_rates(:ncol,:, 859) = rxt_rates(:ncol,:, 859)*sol(:ncol,:, 17)*sol(:ncol,:, 293) ! rate_const*BPIN*OH - rxt_rates(:ncol,:, 860) = rxt_rates(:ncol,:, 860)*sol(:ncol,:, 109)*sol(:ncol,:, 149) ! rate_const*ISOP*NO3 - rxt_rates(:ncol,:, 861) = rxt_rates(:ncol,:, 861)*sol(:ncol,:, 275)*sol(:ncol,:, 256) ! rate_const*ISOPO2VBS*HO2 - rxt_rates(:ncol,:, 862) = rxt_rates(:ncol,:, 862)*sol(:ncol,:, 275)*sol(:ncol,:, 147) ! rate_const*ISOPO2VBS*NO - rxt_rates(:ncol,:, 863) = rxt_rates(:ncol,:, 863)*sol(:ncol,:, 109)*sol(:ncol,:, 157) ! rate_const*ISOP*O3 - rxt_rates(:ncol,:, 864) = rxt_rates(:ncol,:, 864)*sol(:ncol,:, 109)*sol(:ncol,:, 293) ! rate_const*ISOP*OH - rxt_rates(:ncol,:, 865) = rxt_rates(:ncol,:, 865)*sol(:ncol,:, 278)*sol(:ncol,:, 256) ! rate_const*IVOCO2VBS*HO2 - rxt_rates(:ncol,:, 866) = rxt_rates(:ncol,:, 866)*sol(:ncol,:, 278)*sol(:ncol,:, 147) ! rate_const*IVOCO2VBS*NO - rxt_rates(:ncol,:, 867) = rxt_rates(:ncol,:, 867)*sol(:ncol,:, 124)*sol(:ncol,:, 293) ! rate_const*IVOC*OH - rxt_rates(:ncol,:, 868) = rxt_rates(:ncol,:, 868)*sol(:ncol,:, 125)*sol(:ncol,:, 149) ! rate_const*LIMON*NO3 - rxt_rates(:ncol,:, 869) = rxt_rates(:ncol,:, 869)*sol(:ncol,:, 281)*sol(:ncol,:, 256) ! rate_const*LIMONO2VBS*HO2 - rxt_rates(:ncol,:, 870) = rxt_rates(:ncol,:, 870)*sol(:ncol,:, 281)*sol(:ncol,:, 147) ! rate_const*LIMONO2VBS*NO - rxt_rates(:ncol,:, 871) = rxt_rates(:ncol,:, 871)*sol(:ncol,:, 125)*sol(:ncol,:, 157) ! rate_const*LIMON*O3 - rxt_rates(:ncol,:, 872) = rxt_rates(:ncol,:, 872)*sol(:ncol,:, 125)*sol(:ncol,:, 293) ! rate_const*LIMON*OH - rxt_rates(:ncol,:, 873) = rxt_rates(:ncol,:, 873)*sol(:ncol,:, 135)*sol(:ncol,:, 149) ! rate_const*MYRC*NO3 - rxt_rates(:ncol,:, 874) = rxt_rates(:ncol,:, 874)*sol(:ncol,:, 290)*sol(:ncol,:, 256) ! rate_const*MYRCO2VBS*HO2 - rxt_rates(:ncol,:, 875) = rxt_rates(:ncol,:, 875)*sol(:ncol,:, 290)*sol(:ncol,:, 147) ! rate_const*MYRCO2VBS*NO - rxt_rates(:ncol,:, 876) = rxt_rates(:ncol,:, 876)*sol(:ncol,:, 135)*sol(:ncol,:, 157) ! rate_const*MYRC*O3 - rxt_rates(:ncol,:, 877) = rxt_rates(:ncol,:, 877)*sol(:ncol,:, 135)*sol(:ncol,:, 293) ! rate_const*MYRC*OH - rxt_rates(:ncol,:, 878) = rxt_rates(:ncol,:, 878)*sol(:ncol,:, 196)*sol(:ncol,:, 293) ! rate_const*SVOC*OH - rxt_rates(:ncol,:, 879) = rxt_rates(:ncol,:, 879)*sol(:ncol,:, 226)*sol(:ncol,:, 293) ! rate_const*TOLUENE*OH - rxt_rates(:ncol,:, 880) = rxt_rates(:ncol,:, 880)*sol(:ncol,:, 313)*sol(:ncol,:, 256) ! rate_const*TOLUO2VBS*HO2 - rxt_rates(:ncol,:, 881) = rxt_rates(:ncol,:, 881)*sol(:ncol,:, 313)*sol(:ncol,:, 147) ! rate_const*TOLUO2VBS*NO - rxt_rates(:ncol,:, 882) = rxt_rates(:ncol,:, 882)*sol(:ncol,:, 227)*sol(:ncol,:, 293) ! rate_const*XYLENES*OH - rxt_rates(:ncol,:, 883) = rxt_rates(:ncol,:, 883)*sol(:ncol,:, 315)*sol(:ncol,:, 256) ! rate_const*XYLEO2VBS*HO2 - rxt_rates(:ncol,:, 884) = rxt_rates(:ncol,:, 884)*sol(:ncol,:, 315)*sol(:ncol,:, 147) ! rate_const*XYLEO2VBS*NO - rxt_rates(:ncol,:, 885) = rxt_rates(:ncol,:, 885)*sol(:ncol,:, 138) ! rate_const*N2O5 - rxt_rates(:ncol,:, 886) = rxt_rates(:ncol,:, 886)*sol(:ncol,:, 96)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 887) = rxt_rates(:ncol,:, 887)*sol(:ncol,:, 21) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 888) = rxt_rates(:ncol,:, 888)*sol(:ncol,:, 138) ! rate_const*N2O5 - rxt_rates(:ncol,:, 889) = rxt_rates(:ncol,:, 889)*sol(:ncol,:, 61) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 890) = rxt_rates(:ncol,:, 890)*sol(:ncol,:, 21) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 891) = rxt_rates(:ncol,:, 891)*sol(:ncol,:, 61)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 892) = rxt_rates(:ncol,:, 892)*sol(:ncol,:, 96)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 893) = rxt_rates(:ncol,:, 893)*sol(:ncol,:, 95)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL - rxt_rates(:ncol,:, 894) = rxt_rates(:ncol,:, 894)*sol(:ncol,:, 61) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 895) = rxt_rates(:ncol,:, 895)*sol(:ncol,:, 21) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 896) = rxt_rates(:ncol,:, 896)*sol(:ncol,:, 61)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 897) = rxt_rates(:ncol,:, 897)*sol(:ncol,:, 96)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 898) = rxt_rates(:ncol,:, 898)*sol(:ncol,:, 95)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL - rxt_rates(:ncol,:, 899) = rxt_rates(:ncol,:, 899)*sol(:ncol,:, 138) ! rate_const*N2O5 - rxt_rates(:ncol,:, 900) = rxt_rates(:ncol,:, 900)*sol(:ncol,:, 61) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 901) = rxt_rates(:ncol,:, 901)*sol(:ncol,:, 61)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 902) = rxt_rates(:ncol,:, 902)*sol(:ncol,:, 73) ! rate_const*E90 - rxt_rates(:ncol,:, 903) = rxt_rates(:ncol,:, 903)*sol(:ncol,:, 146) ! rate_const*NH_50 - rxt_rates(:ncol,:, 904) = rxt_rates(:ncol,:, 904)*sol(:ncol,:, 145) ! rate_const*NH_5 - rxt_rates(:ncol,:, 905) = rxt_rates(:ncol,:, 905)*sol(:ncol,:, 195) ! rate_const*ST80_25 + rxt_rates(:ncol,:, 809) = rxt_rates(:ncol,:, 809)*sol(:ncol,:, 175)*sol(:ncol,:, 317) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 810) = rxt_rates(:ncol,:, 810)*sol(:ncol,:, 143)*sol(:ncol,:, 293) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 811) = rxt_rates(:ncol,:, 811)*sol(:ncol,:, 77) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 812) = rxt_rates(:ncol,:, 812)*sol(:ncol,:, 256) ! rate_const*HO2 + rxt_rates(:ncol,:, 813) = rxt_rates(:ncol,:, 813)*sol(:ncol,:, 97) ! rate_const*HONITR + rxt_rates(:ncol,:, 814) = rxt_rates(:ncol,:, 814)*sol(:ncol,:, 105) ! rate_const*ICHE + rxt_rates(:ncol,:, 815) = rxt_rates(:ncol,:, 815)*sol(:ncol,:, 106) ! rate_const*IEPOX + rxt_rates(:ncol,:, 816) = rxt_rates(:ncol,:, 816)*sol(:ncol,:, 107) ! rate_const*INHEB + rxt_rates(:ncol,:, 817) = rxt_rates(:ncol,:, 817)*sol(:ncol,:, 108) ! rate_const*INHED + rxt_rates(:ncol,:, 818) = rxt_rates(:ncol,:, 818)*sol(:ncol,:, 121) ! rate_const*ISOPNOOHD + rxt_rates(:ncol,:, 819) = rxt_rates(:ncol,:, 819)*sol(:ncol,:, 110) ! rate_const*ISOPFDN + rxt_rates(:ncol,:, 820) = rxt_rates(:ncol,:, 820)*sol(:ncol,:, 111) ! rate_const*ISOPFDNC + rxt_rates(:ncol,:, 821) = rxt_rates(:ncol,:, 821)*sol(:ncol,:, 112) ! rate_const*ISOPFNC + rxt_rates(:ncol,:, 822) = rxt_rates(:ncol,:, 822)*sol(:ncol,:, 113) ! rate_const*ISOPFNP + rxt_rates(:ncol,:, 823) = rxt_rates(:ncol,:, 823)*sol(:ncol,:, 114) ! rate_const*ISOPHFP + rxt_rates(:ncol,:, 824) = rxt_rates(:ncol,:, 824)*sol(:ncol,:, 115) ! rate_const*ISOPN1D + rxt_rates(:ncol,:, 825) = rxt_rates(:ncol,:, 825)*sol(:ncol,:, 116) ! rate_const*ISOPN2B + rxt_rates(:ncol,:, 826) = rxt_rates(:ncol,:, 826)*sol(:ncol,:, 118) ! rate_const*ISOPN4D + rxt_rates(:ncol,:, 827) = rxt_rates(:ncol,:, 827)*sol(:ncol,:, 138) ! rate_const*N2O5 + rxt_rates(:ncol,:, 828) = rxt_rates(:ncol,:, 828)*sol(:ncol,:, 139) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 829) = rxt_rates(:ncol,:, 829)*sol(:ncol,:, 144) ! rate_const*NH4 + rxt_rates(:ncol,:, 830) = rxt_rates(:ncol,:, 830)*sol(:ncol,:, 148) ! rate_const*NO2 + rxt_rates(:ncol,:, 831) = rxt_rates(:ncol,:, 831)*sol(:ncol,:, 149) ! rate_const*NO3 + rxt_rates(:ncol,:, 832) = rxt_rates(:ncol,:, 832)*sol(:ncol,:, 161) ! rate_const*ONITR + rxt_rates(:ncol,:, 833) = rxt_rates(:ncol,:, 833)*sol(:ncol,:, 194) ! rate_const*SQTN + rxt_rates(:ncol,:, 834) = rxt_rates(:ncol,:, 834)*sol(:ncol,:, 209) ! rate_const*TERPDHDP + rxt_rates(:ncol,:, 835) = rxt_rates(:ncol,:, 835)*sol(:ncol,:, 212) ! rate_const*TERPFDN + rxt_rates(:ncol,:, 836) = rxt_rates(:ncol,:, 836)*sol(:ncol,:, 213) ! rate_const*TERPHFN + rxt_rates(:ncol,:, 837) = rxt_rates(:ncol,:, 837)*sol(:ncol,:, 218) ! rate_const*TERPNPT1 + rxt_rates(:ncol,:, 838) = rxt_rates(:ncol,:, 838)*sol(:ncol,:, 217) ! rate_const*TERPNPT + rxt_rates(:ncol,:, 839) = rxt_rates(:ncol,:, 839)*sol(:ncol,:, 222) ! rate_const*TERPNT1 + rxt_rates(:ncol,:, 840) = rxt_rates(:ncol,:, 840)*sol(:ncol,:, 221) ! rate_const*TERPNT + rxt_rates(:ncol,:, 841) = rxt_rates(:ncol,:, 841)*sol(:ncol,:, 4)*sol(:ncol,:, 149) ! rate_const*APIN*NO3 + rxt_rates(:ncol,:, 842) = rxt_rates(:ncol,:, 842)*sol(:ncol,:, 237)*sol(:ncol,:, 256) ! rate_const*APINO2VBS*HO2 + rxt_rates(:ncol,:, 843) = rxt_rates(:ncol,:, 843)*sol(:ncol,:, 237)*sol(:ncol,:, 147) ! rate_const*APINO2VBS*NO + rxt_rates(:ncol,:, 844) = rxt_rates(:ncol,:, 844)*sol(:ncol,:, 4)*sol(:ncol,:, 157) ! rate_const*APIN*O3 + rxt_rates(:ncol,:, 845) = rxt_rates(:ncol,:, 845)*sol(:ncol,:, 4)*sol(:ncol,:, 293) ! rate_const*APIN*OH + rxt_rates(:ncol,:, 846) = rxt_rates(:ncol,:, 846)*sol(:ncol,:, 7)*sol(:ncol,:, 149) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 847) = rxt_rates(:ncol,:, 847)*sol(:ncol,:, 240)*sol(:ncol,:, 256) ! rate_const*BCARYO2VBS*HO2 + rxt_rates(:ncol,:, 848) = rxt_rates(:ncol,:, 848)*sol(:ncol,:, 240)*sol(:ncol,:, 147) ! rate_const*BCARYO2VBS*NO + rxt_rates(:ncol,:, 849) = rxt_rates(:ncol,:, 849)*sol(:ncol,:, 7)*sol(:ncol,:, 157) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 850) = rxt_rates(:ncol,:, 850)*sol(:ncol,:, 7)*sol(:ncol,:, 293) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 851) = rxt_rates(:ncol,:, 851)*sol(:ncol,:, 8)*sol(:ncol,:, 293) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 852) = rxt_rates(:ncol,:, 852)*sol(:ncol,:, 242)*sol(:ncol,:, 256) ! rate_const*BENZO2VBS*HO2 + rxt_rates(:ncol,:, 853) = rxt_rates(:ncol,:, 853)*sol(:ncol,:, 242)*sol(:ncol,:, 147) ! rate_const*BENZO2VBS*NO + rxt_rates(:ncol,:, 854) = rxt_rates(:ncol,:, 854)*sol(:ncol,:, 17)*sol(:ncol,:, 149) ! rate_const*BPIN*NO3 + rxt_rates(:ncol,:, 855) = rxt_rates(:ncol,:, 855)*sol(:ncol,:, 245)*sol(:ncol,:, 256) ! rate_const*BPINO2VBS*HO2 + rxt_rates(:ncol,:, 856) = rxt_rates(:ncol,:, 856)*sol(:ncol,:, 245)*sol(:ncol,:, 147) ! rate_const*BPINO2VBS*NO + rxt_rates(:ncol,:, 857) = rxt_rates(:ncol,:, 857)*sol(:ncol,:, 17)*sol(:ncol,:, 157) ! rate_const*BPIN*O3 + rxt_rates(:ncol,:, 858) = rxt_rates(:ncol,:, 858)*sol(:ncol,:, 17)*sol(:ncol,:, 293) ! rate_const*BPIN*OH + rxt_rates(:ncol,:, 859) = rxt_rates(:ncol,:, 859)*sol(:ncol,:, 109)*sol(:ncol,:, 149) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 860) = rxt_rates(:ncol,:, 860)*sol(:ncol,:, 275)*sol(:ncol,:, 256) ! rate_const*ISOPO2VBS*HO2 + rxt_rates(:ncol,:, 861) = rxt_rates(:ncol,:, 861)*sol(:ncol,:, 275)*sol(:ncol,:, 147) ! rate_const*ISOPO2VBS*NO + rxt_rates(:ncol,:, 862) = rxt_rates(:ncol,:, 862)*sol(:ncol,:, 109)*sol(:ncol,:, 157) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 863) = rxt_rates(:ncol,:, 863)*sol(:ncol,:, 109)*sol(:ncol,:, 293) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 864) = rxt_rates(:ncol,:, 864)*sol(:ncol,:, 278)*sol(:ncol,:, 256) ! rate_const*IVOCO2VBS*HO2 + rxt_rates(:ncol,:, 865) = rxt_rates(:ncol,:, 865)*sol(:ncol,:, 278)*sol(:ncol,:, 147) ! rate_const*IVOCO2VBS*NO + rxt_rates(:ncol,:, 866) = rxt_rates(:ncol,:, 866)*sol(:ncol,:, 124)*sol(:ncol,:, 293) ! rate_const*IVOC*OH + rxt_rates(:ncol,:, 867) = rxt_rates(:ncol,:, 867)*sol(:ncol,:, 125)*sol(:ncol,:, 149) ! rate_const*LIMON*NO3 + rxt_rates(:ncol,:, 868) = rxt_rates(:ncol,:, 868)*sol(:ncol,:, 281)*sol(:ncol,:, 256) ! rate_const*LIMONO2VBS*HO2 + rxt_rates(:ncol,:, 869) = rxt_rates(:ncol,:, 869)*sol(:ncol,:, 281)*sol(:ncol,:, 147) ! rate_const*LIMONO2VBS*NO + rxt_rates(:ncol,:, 870) = rxt_rates(:ncol,:, 870)*sol(:ncol,:, 125)*sol(:ncol,:, 157) ! rate_const*LIMON*O3 + rxt_rates(:ncol,:, 871) = rxt_rates(:ncol,:, 871)*sol(:ncol,:, 125)*sol(:ncol,:, 293) ! rate_const*LIMON*OH + rxt_rates(:ncol,:, 872) = rxt_rates(:ncol,:, 872)*sol(:ncol,:, 135)*sol(:ncol,:, 149) ! rate_const*MYRC*NO3 + rxt_rates(:ncol,:, 873) = rxt_rates(:ncol,:, 873)*sol(:ncol,:, 290)*sol(:ncol,:, 256) ! rate_const*MYRCO2VBS*HO2 + rxt_rates(:ncol,:, 874) = rxt_rates(:ncol,:, 874)*sol(:ncol,:, 290)*sol(:ncol,:, 147) ! rate_const*MYRCO2VBS*NO + rxt_rates(:ncol,:, 875) = rxt_rates(:ncol,:, 875)*sol(:ncol,:, 135)*sol(:ncol,:, 157) ! rate_const*MYRC*O3 + rxt_rates(:ncol,:, 876) = rxt_rates(:ncol,:, 876)*sol(:ncol,:, 135)*sol(:ncol,:, 293) ! rate_const*MYRC*OH + rxt_rates(:ncol,:, 877) = rxt_rates(:ncol,:, 877)*sol(:ncol,:, 196)*sol(:ncol,:, 293) ! rate_const*SVOC*OH + rxt_rates(:ncol,:, 878) = rxt_rates(:ncol,:, 878)*sol(:ncol,:, 226)*sol(:ncol,:, 293) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 879) = rxt_rates(:ncol,:, 879)*sol(:ncol,:, 313)*sol(:ncol,:, 256) ! rate_const*TOLUO2VBS*HO2 + rxt_rates(:ncol,:, 880) = rxt_rates(:ncol,:, 880)*sol(:ncol,:, 313)*sol(:ncol,:, 147) ! rate_const*TOLUO2VBS*NO + rxt_rates(:ncol,:, 881) = rxt_rates(:ncol,:, 881)*sol(:ncol,:, 227)*sol(:ncol,:, 293) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 882) = rxt_rates(:ncol,:, 882)*sol(:ncol,:, 315)*sol(:ncol,:, 256) ! rate_const*XYLEO2VBS*HO2 + rxt_rates(:ncol,:, 883) = rxt_rates(:ncol,:, 883)*sol(:ncol,:, 315)*sol(:ncol,:, 147) ! rate_const*XYLEO2VBS*NO + rxt_rates(:ncol,:, 884) = rxt_rates(:ncol,:, 884)*sol(:ncol,:, 138) ! rate_const*N2O5 + rxt_rates(:ncol,:, 885) = rxt_rates(:ncol,:, 885)*sol(:ncol,:, 96)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 886) = rxt_rates(:ncol,:, 886)*sol(:ncol,:, 21) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 887) = rxt_rates(:ncol,:, 887)*sol(:ncol,:, 138) ! rate_const*N2O5 + rxt_rates(:ncol,:, 888) = rxt_rates(:ncol,:, 888)*sol(:ncol,:, 61) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 889) = rxt_rates(:ncol,:, 889)*sol(:ncol,:, 21) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 890) = rxt_rates(:ncol,:, 890)*sol(:ncol,:, 61)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 891) = rxt_rates(:ncol,:, 891)*sol(:ncol,:, 96)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 892) = rxt_rates(:ncol,:, 892)*sol(:ncol,:, 95)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 893) = rxt_rates(:ncol,:, 893)*sol(:ncol,:, 61) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 894) = rxt_rates(:ncol,:, 894)*sol(:ncol,:, 21) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 895) = rxt_rates(:ncol,:, 895)*sol(:ncol,:, 61)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 896) = rxt_rates(:ncol,:, 896)*sol(:ncol,:, 96)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 897) = rxt_rates(:ncol,:, 897)*sol(:ncol,:, 95)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 898) = rxt_rates(:ncol,:, 898)*sol(:ncol,:, 138) ! rate_const*N2O5 + rxt_rates(:ncol,:, 899) = rxt_rates(:ncol,:, 899)*sol(:ncol,:, 61) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 900) = rxt_rates(:ncol,:, 900)*sol(:ncol,:, 61)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 901) = rxt_rates(:ncol,:, 901)*sol(:ncol,:, 73) ! rate_const*E90 + rxt_rates(:ncol,:, 902) = rxt_rates(:ncol,:, 902)*sol(:ncol,:, 146) ! rate_const*NH_50 + rxt_rates(:ncol,:, 903) = rxt_rates(:ncol,:, 903)*sol(:ncol,:, 145) ! rate_const*NH_5 + rxt_rates(:ncol,:, 904) = rxt_rates(:ncol,:, 904)*sol(:ncol,:, 195) ! rate_const*ST80_25 end subroutine set_rates end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/mo_setrxt.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/mo_setrxt.F90 index 74a366df4a..3eacb8cb42 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/mo_setrxt.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/mo_setrxt.F90 @@ -45,7 +45,7 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,186) = 1.8e-12_r8 rate(:,190) = 1.8e-12_r8 rate(:,202) = 3.5e-12_r8 - rate(:,204) = 1e-11_r8 + rate(:,204) = 1.3e-11_r8 rate(:,205) = 2.2e-11_r8 rate(:,206) = 5e-11_r8 rate(:,241) = 1.7e-13_r8 @@ -70,172 +70,171 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,295) = 1.794e-10_r8 rate(:,296) = 1.3e-10_r8 rate(:,297) = 7.65e-11_r8 - rate(:,311) = 4e-13_r8 - rate(:,316) = 1.31e-10_r8 - rate(:,317) = 3.5e-11_r8 - rate(:,318) = 9e-12_r8 - rate(:,325) = 6.8e-14_r8 - rate(:,326) = 2e-13_r8 - rate(:,340) = 7e-13_r8 - rate(:,341) = 1e-12_r8 - rate(:,345) = 1e-14_r8 - rate(:,346) = 1e-11_r8 - rate(:,347) = 1.15e-11_r8 - rate(:,348) = 3.3e-11_r8 - rate(:,349) = 3.4e-12_r8 - rate(:,350) = 4e-14_r8 - rate(:,363) = 3e-12_r8 - rate(:,364) = 1.2e-11_r8 - rate(:,365) = 6.7e-13_r8 - rate(:,375) = 3.5e-13_r8 - rate(:,376) = 5.4e-11_r8 - rate(:,377) = 3.77e-11_r8 - rate(:,380) = 2e-12_r8 - rate(:,381) = 1.29e-11_r8 - rate(:,383) = 4.5e-14_r8 - rate(:,388) = 3.77e-11_r8 - rate(:,394) = 4e-12_r8 - rate(:,400) = 1.78e-12_r8 - rate(:,402) = 6.1e-13_r8 - rate(:,406) = 4.8e-11_r8 - rate(:,409) = 1.6e-12_r8 - rate(:,411) = 6.7e-12_r8 - rate(:,414) = 3.5e-12_r8 - rate(:,419) = 6.42e-11_r8 - rate(:,426) = 1.6e-13_r8 - rate(:,432) = 1.4e-12_r8 - rate(:,437) = 7.5e-13_r8 - rate(:,438) = 1.4e-13_r8 - rate(:,439) = 7.5e-13_r8 - rate(:,440) = 3.6e-13_r8 - rate(:,441) = 6.5e-13_r8 - rate(:,442) = 2.1e-13_r8 - rate(:,443) = 6.5e-13_r8 - rate(:,444) = 4.9e-13_r8 - rate(:,446) = 1.2e-12_r8 - rate(:,450) = 9.8e-13_r8 - rate(:,453) = 1.85e-11_r8 - rate(:,454) = 1.63e-12_r8 - rate(:,455) = 2.5e-11_r8 - rate(:,456) = 1.1e-11_r8 - rate(:,457) = 3.3e-11_r8 - rate(:,460) = 2.8e-17_r8 - rate(:,461) = 8e-11_r8 - rate(:,464) = 3e-11_r8 - rate(:,467) = 4.2e-11_r8 - rate(:,470) = 2.8e-17_r8 - rate(:,471) = 1.1e-10_r8 - rate(:,473) = 3.9e-11_r8 - rate(:,476) = 1.3e-12_r8 - rate(:,478) = 5e-12_r8 - rate(:,479) = 2.3e-12_r8 - rate(:,482) = 3.9e-11_r8 - rate(:,485) = 2.8e-17_r8 - rate(:,486) = 9.2e-11_r8 - rate(:,489) = 3.85e-11_r8 - rate(:,493) = 1.2e-12_r8 - rate(:,497) = 9.8e-13_r8 - rate(:,502) = 4.4e-18_r8 - rate(:,503) = 3.6e-11_r8 - rate(:,555) = 4.7e-11_r8 - rate(:,568) = 2.1e-12_r8 - rate(:,569) = 2.8e-13_r8 - rate(:,577) = 1.7e-11_r8 - rate(:,583) = 8.4e-11_r8 - rate(:,586) = 5.3e-13_r8 - rate(:,588) = 2e-12_r8 - rate(:,591) = 2.3e-12_r8 - rate(:,596) = 2e-12_r8 - rate(:,599) = 2.3e-12_r8 - rate(:,605) = 1.9e-11_r8 - rate(:,606) = 5.3e-13_r8 - rate(:,608) = 2e-12_r8 - rate(:,611) = 2.3e-12_r8 - rate(:,616) = 2e-12_r8 - rate(:,619) = 2.3e-12_r8 - rate(:,623) = 1.2e-14_r8 - rate(:,624) = 2e-10_r8 - rate(:,625) = 2.5e-12_r8 - rate(:,626) = 5.3e-13_r8 - rate(:,628) = 2e-12_r8 - rate(:,631) = 2.3e-12_r8 - rate(:,636) = 2e-12_r8 - rate(:,639) = 2.3e-12_r8 - rate(:,645) = 1.2e-11_r8 - rate(:,647) = 2e-12_r8 - rate(:,649) = 5.3e-13_r8 - rate(:,651) = 2.3e-12_r8 - rate(:,656) = 2e-12_r8 - rate(:,659) = 2.3e-12_r8 - rate(:,665) = 1.1e-11_r8 - rate(:,667) = 2e-12_r8 - rate(:,669) = 5.3e-13_r8 - rate(:,671) = 2.3e-12_r8 - rate(:,676) = 2e-12_r8 - rate(:,679) = 2.3e-12_r8 - rate(:,684) = 2.1e-10_r8 + rate(:,310) = 4e-13_r8 + rate(:,315) = 1.31e-10_r8 + rate(:,316) = 3.5e-11_r8 + rate(:,317) = 9e-12_r8 + rate(:,324) = 6.8e-14_r8 + rate(:,325) = 2e-13_r8 + rate(:,340) = 1e-12_r8 + rate(:,344) = 1e-14_r8 + rate(:,345) = 1e-11_r8 + rate(:,346) = 1.15e-11_r8 + rate(:,347) = 3.3e-11_r8 + rate(:,348) = 3.4e-12_r8 + rate(:,349) = 4e-14_r8 + rate(:,362) = 3e-12_r8 + rate(:,363) = 1.2e-11_r8 + rate(:,364) = 6.7e-13_r8 + rate(:,374) = 3.5e-13_r8 + rate(:,375) = 5.4e-11_r8 + rate(:,376) = 3.77e-11_r8 + rate(:,379) = 2e-12_r8 + rate(:,380) = 1.29e-11_r8 + rate(:,382) = 4.5e-14_r8 + rate(:,387) = 3.77e-11_r8 + rate(:,393) = 4e-12_r8 + rate(:,399) = 1.78e-12_r8 + rate(:,401) = 6.1e-13_r8 + rate(:,405) = 4.8e-11_r8 + rate(:,408) = 1.6e-12_r8 + rate(:,410) = 6.7e-12_r8 + rate(:,413) = 3.5e-12_r8 + rate(:,418) = 6.42e-11_r8 + rate(:,425) = 1.6e-13_r8 + rate(:,431) = 1.4e-12_r8 + rate(:,436) = 7.5e-13_r8 + rate(:,437) = 1.4e-13_r8 + rate(:,438) = 7.5e-13_r8 + rate(:,439) = 3.6e-13_r8 + rate(:,440) = 6.5e-13_r8 + rate(:,441) = 2.1e-13_r8 + rate(:,442) = 6.5e-13_r8 + rate(:,443) = 4.9e-13_r8 + rate(:,445) = 1.2e-12_r8 + rate(:,449) = 9.8e-13_r8 + rate(:,452) = 1.85e-11_r8 + rate(:,453) = 1.63e-12_r8 + rate(:,454) = 2.5e-11_r8 + rate(:,455) = 1.1e-11_r8 + rate(:,456) = 3.3e-11_r8 + rate(:,459) = 2.8e-17_r8 + rate(:,460) = 8e-11_r8 + rate(:,463) = 3e-11_r8 + rate(:,466) = 4.2e-11_r8 + rate(:,469) = 2.8e-17_r8 + rate(:,470) = 1.1e-10_r8 + rate(:,472) = 3.9e-11_r8 + rate(:,475) = 1.3e-12_r8 + rate(:,477) = 5e-12_r8 + rate(:,478) = 2.3e-12_r8 + rate(:,481) = 3.9e-11_r8 + rate(:,484) = 2.8e-17_r8 + rate(:,485) = 9.2e-11_r8 + rate(:,488) = 3.85e-11_r8 + rate(:,492) = 1.2e-12_r8 + rate(:,496) = 9.8e-13_r8 + rate(:,501) = 4.4e-18_r8 + rate(:,502) = 3.6e-11_r8 + rate(:,554) = 4.7e-11_r8 + rate(:,567) = 2.1e-12_r8 + rate(:,568) = 2.8e-13_r8 + rate(:,576) = 1.7e-11_r8 + rate(:,582) = 8.4e-11_r8 + rate(:,585) = 5.3e-13_r8 + rate(:,587) = 2e-12_r8 + rate(:,590) = 2.3e-12_r8 + rate(:,595) = 2e-12_r8 + rate(:,598) = 2.3e-12_r8 + rate(:,604) = 1.9e-11_r8 + rate(:,605) = 5.3e-13_r8 + rate(:,607) = 2e-12_r8 + rate(:,610) = 2.3e-12_r8 + rate(:,615) = 2e-12_r8 + rate(:,618) = 2.3e-12_r8 + rate(:,622) = 1.2e-14_r8 + rate(:,623) = 2e-10_r8 + rate(:,624) = 2.5e-12_r8 + rate(:,625) = 5.3e-13_r8 + rate(:,627) = 2e-12_r8 + rate(:,630) = 2.3e-12_r8 + rate(:,635) = 2e-12_r8 + rate(:,638) = 2.3e-12_r8 + rate(:,644) = 1.2e-11_r8 + rate(:,646) = 2e-12_r8 + rate(:,648) = 5.3e-13_r8 + rate(:,650) = 2.3e-12_r8 + rate(:,655) = 2e-12_r8 + rate(:,658) = 2.3e-12_r8 + rate(:,664) = 1.1e-11_r8 + rate(:,666) = 2e-12_r8 + rate(:,668) = 5.3e-13_r8 + rate(:,670) = 2.3e-12_r8 + rate(:,675) = 2e-12_r8 + rate(:,678) = 2.3e-12_r8 + rate(:,683) = 2.1e-10_r8 + rate(:,689) = 8.9e-11_r8 rate(:,690) = 8.9e-11_r8 - rate(:,691) = 8.9e-11_r8 - rate(:,695) = 2e-12_r8 - rate(:,698) = 2.3e-12_r8 - rate(:,706) = 4e-12_r8 - rate(:,709) = 2e-14_r8 - rate(:,711) = 2e-12_r8 - rate(:,714) = 2.3e-12_r8 - rate(:,719) = 2.52e-11_r8 - rate(:,724) = 4e-12_r8 - rate(:,728) = 2e-14_r8 - rate(:,730) = 2e-12_r8 - rate(:,733) = 2.3e-12_r8 - rate(:,738) = 1.92e-11_r8 - rate(:,740) = 2e-12_r8 - rate(:,743) = 2.3e-12_r8 + rate(:,694) = 2e-12_r8 + rate(:,697) = 2.3e-12_r8 + rate(:,705) = 4e-12_r8 + rate(:,708) = 2e-14_r8 + rate(:,710) = 2e-12_r8 + rate(:,713) = 2.3e-12_r8 + rate(:,718) = 2.52e-11_r8 + rate(:,723) = 4e-12_r8 + rate(:,727) = 2e-14_r8 + rate(:,729) = 2e-12_r8 + rate(:,732) = 2.3e-12_r8 + rate(:,737) = 1.92e-11_r8 + rate(:,739) = 2e-12_r8 + rate(:,742) = 2.3e-12_r8 + rate(:,746) = 8.8e-12_r8 rate(:,747) = 8.8e-12_r8 rate(:,748) = 8.8e-12_r8 - rate(:,749) = 8.8e-12_r8 - rate(:,754) = 4e-12_r8 - rate(:,756) = 2e-14_r8 - rate(:,758) = 3.66e-12_r8 - rate(:,759) = 2.8e-11_r8 - rate(:,760) = 2.6e-13_r8 - rate(:,763) = 8.3e-18_r8 - rate(:,764) = 1.1e-10_r8 - rate(:,768) = 1.1e-16_r8 - rate(:,770) = 3.64e-12_r8 - rate(:,771) = 2.8e-11_r8 - rate(:,772) = 1.7e-11_r8 - rate(:,775) = 1.1e-10_r8 - rate(:,776) = 9.58e-12_r8 - rate(:,779) = 1.1e-10_r8 - rate(:,780) = 1.23e-11_r8 - rate(:,783) = 1.1e-10_r8 - rate(:,784) = 3.64e-12_r8 - rate(:,787) = 1.1e-10_r8 - rate(:,788) = 5.5e-12_r8 - rate(:,789) = 4.65e-11_r8 - rate(:,790) = 2.8e-11_r8 - rate(:,798) = 2.3e-12_r8 + rate(:,753) = 4e-12_r8 + rate(:,755) = 2e-14_r8 + rate(:,757) = 3.66e-12_r8 + rate(:,758) = 2.8e-11_r8 + rate(:,759) = 2.6e-13_r8 + rate(:,762) = 8.3e-18_r8 + rate(:,763) = 1.1e-10_r8 + rate(:,767) = 1.1e-16_r8 + rate(:,769) = 3.64e-12_r8 + rate(:,770) = 2.8e-11_r8 + rate(:,771) = 1.7e-11_r8 + rate(:,774) = 1.1e-10_r8 + rate(:,775) = 9.58e-12_r8 + rate(:,778) = 1.1e-10_r8 + rate(:,779) = 1.23e-11_r8 + rate(:,782) = 1.1e-10_r8 + rate(:,783) = 3.64e-12_r8 + rate(:,786) = 1.1e-10_r8 + rate(:,787) = 5.5e-12_r8 + rate(:,788) = 4.65e-11_r8 + rate(:,789) = 2.8e-11_r8 + rate(:,797) = 2.3e-12_r8 rate(:,799) = 1.2e-11_r8 rate(:,800) = 5.7e-11_r8 rate(:,801) = 2.8e-11_r8 rate(:,802) = 6.6e-11_r8 rate(:,803) = 1.4e-11_r8 rate(:,806) = 1.9e-12_r8 - rate(:,830) = 6.34e-08_r8 - rate(:,847) = 1.9e-11_r8 - rate(:,850) = 1.2e-14_r8 - rate(:,851) = 2e-10_r8 - rate(:,855) = 2.5e-12_r8 - rate(:,867) = 1.34e-11_r8 - rate(:,868) = 1.2e-11_r8 - rate(:,873) = 1.1e-11_r8 - rate(:,877) = 2.1e-10_r8 - rate(:,878) = 1.34e-11_r8 - rate(:,882) = 1.7e-11_r8 - rate(:,902) = 1.29e-07_r8 - rate(:,903) = 2.31e-07_r8 - rate(:,904) = 2.31e-06_r8 - rate(:,905) = 4.63e-07_r8 + rate(:,829) = 6.34e-08_r8 + rate(:,846) = 1.9e-11_r8 + rate(:,849) = 1.2e-14_r8 + rate(:,850) = 2e-10_r8 + rate(:,854) = 2.5e-12_r8 + rate(:,866) = 1.34e-11_r8 + rate(:,867) = 1.2e-11_r8 + rate(:,872) = 1.1e-11_r8 + rate(:,876) = 2.1e-10_r8 + rate(:,877) = 1.34e-11_r8 + rate(:,881) = 1.7e-11_r8 + rate(:,901) = 1.29e-07_r8 + rate(:,902) = 2.31e-07_r8 + rate(:,903) = 2.31e-06_r8 + rate(:,904) = 4.63e-07_r8 do n = 1,pver offset = (n-1)*ncol @@ -252,20 +251,20 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,182) = 3e-11_r8 * exp_fac(:) rate(:,268) = 5.5e-12_r8 * exp_fac(:) rate(:,307) = 3.8e-12_r8 * exp_fac(:) - rate(:,330) = 3.8e-12_r8 * exp_fac(:) - rate(:,359) = 3.8e-12_r8 * exp_fac(:) - rate(:,368) = 3.8e-12_r8 * exp_fac(:) - rate(:,372) = 3.8e-12_r8 * exp_fac(:) - rate(:,398) = 3.8e-12_r8 * exp_fac(:) - rate(:,413) = 3.8e-12_r8 * exp_fac(:) - rate(:,490) = 5.53e-12_r8 * exp_fac(:) - rate(:,547) = 3.8e-12_r8 * exp_fac(:) - rate(:,550) = 3.8e-12_r8 * exp_fac(:) - rate(:,554) = 3.8e-12_r8 * exp_fac(:) - rate(:,570) = 3.8e-12_r8 * exp_fac(:) - rate(:,574) = 3.8e-12_r8 * exp_fac(:) - rate(:,580) = 3.8e-12_r8 * exp_fac(:) - rate(:,584) = 3.8e-12_r8 * exp_fac(:) + rate(:,329) = 3.8e-12_r8 * exp_fac(:) + rate(:,358) = 3.8e-12_r8 * exp_fac(:) + rate(:,367) = 3.8e-12_r8 * exp_fac(:) + rate(:,371) = 3.8e-12_r8 * exp_fac(:) + rate(:,397) = 3.8e-12_r8 * exp_fac(:) + rate(:,412) = 3.8e-12_r8 * exp_fac(:) + rate(:,489) = 5.53e-12_r8 * exp_fac(:) + rate(:,546) = 3.8e-12_r8 * exp_fac(:) + rate(:,549) = 3.8e-12_r8 * exp_fac(:) + rate(:,553) = 3.8e-12_r8 * exp_fac(:) + rate(:,569) = 3.8e-12_r8 * exp_fac(:) + rate(:,573) = 3.8e-12_r8 * exp_fac(:) + rate(:,579) = 3.8e-12_r8 * exp_fac(:) + rate(:,583) = 3.8e-12_r8 * exp_fac(:) rate(:,183) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) rate(:,184) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) rate(:,185) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) @@ -274,32 +273,29 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,266) = 1.7e-11_r8 * exp_fac(:) exp_fac(:) = exp( 180._r8 * itemp(:) ) rate(:,188) = 1.8e-11_r8 * exp_fac(:) - rate(:,343) = 4.2e-12_r8 * exp_fac(:) - rate(:,358) = 4.2e-12_r8 * exp_fac(:) - rate(:,367) = 4.2e-12_r8 * exp_fac(:) - rate(:,396) = 4.2e-12_r8 * exp_fac(:) + rate(:,342) = 4.2e-12_r8 * exp_fac(:) + rate(:,357) = 4.2e-12_r8 * exp_fac(:) + rate(:,366) = 4.2e-12_r8 * exp_fac(:) + rate(:,395) = 4.2e-12_r8 * exp_fac(:) rate(:,189) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) - rate(:,193) = 1.3e-12_r8 * exp( 380._r8 * itemp(:) ) + rate(:,193) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) rate(:,194) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) exp_fac(:) = exp( 220._r8 * itemp(:) ) rate(:,195) = 2.9e-12_r8 * exp_fac(:) rate(:,196) = 1.45e-12_r8 * exp_fac(:) rate(:,197) = 1.45e-12_r8 * exp_fac(:) - rate(:,198) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:,198) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) rate(:,199) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) exp_fac(:) = exp( -2450._r8 * itemp(:) ) rate(:,200) = 1.2e-13_r8 * exp_fac(:) rate(:,226) = 3e-11_r8 * exp_fac(:) - rate(:,203) = 1.5e-11_r8 * exp( 170._r8 * itemp(:) ) - exp_fac(:) = exp( 270._r8 * itemp(:) ) - rate(:,207) = 3.3e-12_r8 * exp_fac(:) - rate(:,222) = 1.4e-11_r8 * exp_fac(:) - rate(:,236) = 7.4e-12_r8 * exp_fac(:) - rate(:,339) = 8.1e-12_r8 * exp_fac(:) - rate(:,393) = 8.1e-12_r8 * exp_fac(:) - rate(:,705) = 8.1e-12_r8 * exp_fac(:) - rate(:,723) = 8.1e-12_r8 * exp_fac(:) - rate(:,753) = 8.1e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,203) = 1.7e-11_r8 * exp_fac(:) + rate(:,301) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,207) = 3.44e-12_r8 * exp_fac(:) + rate(:,259) = 2.3e-12_r8 * exp_fac(:) + rate(:,262) = 8.8e-12_r8 * exp_fac(:) exp_fac(:) = exp( -1500._r8 * itemp(:) ) rate(:,208) = 3e-12_r8 * exp_fac(:) rate(:,267) = 5.8e-12_r8 * exp_fac(:) @@ -309,10 +305,18 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,218) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) exp_fac(:) = exp( -1270._r8 * itemp(:) ) rate(:,219) = 7.1e-12_r8 * exp_fac(:) - rate(:,643) = 1.35e-15_r8 * exp_fac(:) - rate(:,858) = 1.35e-15_r8 * exp_fac(:) + rate(:,642) = 1.35e-15_r8 * exp_fac(:) + rate(:,857) = 1.35e-15_r8 * exp_fac(:) rate(:,220) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) rate(:,221) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,222) = 1.4e-11_r8 * exp_fac(:) + rate(:,236) = 7.4e-12_r8 * exp_fac(:) + rate(:,338) = 8.1e-12_r8 * exp_fac(:) + rate(:,392) = 8.1e-12_r8 * exp_fac(:) + rate(:,704) = 8.1e-12_r8 * exp_fac(:) + rate(:,722) = 8.1e-12_r8 * exp_fac(:) + rate(:,752) = 8.1e-12_r8 * exp_fac(:) rate(:,223) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) rate(:,224) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) rate(:,225) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) @@ -322,10 +326,10 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,229) = 2.6e-12_r8 * exp_fac(:) rate(:,230) = 6.4e-12_r8 * exp_fac(:) rate(:,260) = 4.1e-13_r8 * exp_fac(:) - rate(:,543) = 7.5e-12_r8 * exp_fac(:) - rate(:,557) = 7.5e-12_r8 * exp_fac(:) - rate(:,560) = 7.5e-12_r8 * exp_fac(:) - rate(:,563) = 7.5e-12_r8 * exp_fac(:) + rate(:,542) = 7.5e-12_r8 * exp_fac(:) + rate(:,556) = 7.5e-12_r8 * exp_fac(:) + rate(:,559) = 7.5e-12_r8 * exp_fac(:) + rate(:,562) = 7.5e-12_r8 * exp_fac(:) rate(:,231) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) exp_fac(:) = exp( -840._r8 * itemp(:) ) rate(:,233) = 3.6e-12_r8 * exp_fac(:) @@ -348,13 +352,10 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,255) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) rate(:,256) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) rate(:,258) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) - exp_fac(:) = exp( 260._r8 * itemp(:) ) - rate(:,259) = 2.3e-12_r8 * exp_fac(:) - rate(:,262) = 8.8e-12_r8 * exp_fac(:) exp_fac(:) = exp( 460._r8 * itemp(:) ) rate(:,261) = 4.5e-12_r8 * exp_fac(:) - rate(:,644) = 1.62e-11_r8 * exp_fac(:) - rate(:,859) = 1.62e-11_r8 * exp_fac(:) + rate(:,643) = 1.62e-11_r8 * exp_fac(:) + rate(:,858) = 1.62e-11_r8 * exp_fac(:) rate(:,264) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) rate(:,269) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) rate(:,275) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) @@ -367,178 +368,177 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,295) = 1.794e-10_r8 * exp_fac(:) rate(:,296) = 1.3e-10_r8 * exp_fac(:) rate(:,297) = 7.65e-11_r8 * exp_fac(:) - rate(:,311) = 4e-13_r8 * exp_fac(:) - rate(:,316) = 1.31e-10_r8 * exp_fac(:) - rate(:,317) = 3.5e-11_r8 * exp_fac(:) - rate(:,318) = 9e-12_r8 * exp_fac(:) - rate(:,325) = 6.8e-14_r8 * exp_fac(:) - rate(:,326) = 2e-13_r8 * exp_fac(:) - rate(:,340) = 7e-13_r8 * exp_fac(:) - rate(:,341) = 1e-12_r8 * exp_fac(:) - rate(:,345) = 1e-14_r8 * exp_fac(:) - rate(:,346) = 1e-11_r8 * exp_fac(:) - rate(:,347) = 1.15e-11_r8 * exp_fac(:) - rate(:,348) = 3.3e-11_r8 * exp_fac(:) - rate(:,349) = 3.4e-12_r8 * exp_fac(:) - rate(:,350) = 4e-14_r8 * exp_fac(:) - rate(:,363) = 3e-12_r8 * exp_fac(:) - rate(:,364) = 1.2e-11_r8 * exp_fac(:) - rate(:,365) = 6.7e-13_r8 * exp_fac(:) - rate(:,375) = 3.5e-13_r8 * exp_fac(:) - rate(:,376) = 5.4e-11_r8 * exp_fac(:) - rate(:,377) = 3.77e-11_r8 * exp_fac(:) - rate(:,380) = 2e-12_r8 * exp_fac(:) - rate(:,381) = 1.29e-11_r8 * exp_fac(:) - rate(:,383) = 4.5e-14_r8 * exp_fac(:) - rate(:,388) = 3.77e-11_r8 * exp_fac(:) - rate(:,394) = 4e-12_r8 * exp_fac(:) - rate(:,400) = 1.78e-12_r8 * exp_fac(:) - rate(:,402) = 6.1e-13_r8 * exp_fac(:) - rate(:,406) = 4.8e-11_r8 * exp_fac(:) - rate(:,409) = 1.6e-12_r8 * exp_fac(:) - rate(:,411) = 6.7e-12_r8 * exp_fac(:) - rate(:,414) = 3.5e-12_r8 * exp_fac(:) - rate(:,419) = 6.42e-11_r8 * exp_fac(:) - rate(:,426) = 1.6e-13_r8 * exp_fac(:) - rate(:,432) = 1.4e-12_r8 * exp_fac(:) - rate(:,437) = 7.5e-13_r8 * exp_fac(:) - rate(:,438) = 1.4e-13_r8 * exp_fac(:) - rate(:,439) = 7.5e-13_r8 * exp_fac(:) - rate(:,440) = 3.6e-13_r8 * exp_fac(:) - rate(:,441) = 6.5e-13_r8 * exp_fac(:) - rate(:,442) = 2.1e-13_r8 * exp_fac(:) - rate(:,443) = 6.5e-13_r8 * exp_fac(:) - rate(:,444) = 4.9e-13_r8 * exp_fac(:) - rate(:,446) = 1.2e-12_r8 * exp_fac(:) - rate(:,450) = 9.8e-13_r8 * exp_fac(:) - rate(:,453) = 1.85e-11_r8 * exp_fac(:) - rate(:,454) = 1.63e-12_r8 * exp_fac(:) - rate(:,455) = 2.5e-11_r8 * exp_fac(:) - rate(:,456) = 1.1e-11_r8 * exp_fac(:) - rate(:,457) = 3.3e-11_r8 * exp_fac(:) - rate(:,460) = 2.8e-17_r8 * exp_fac(:) - rate(:,461) = 8e-11_r8 * exp_fac(:) - rate(:,464) = 3e-11_r8 * exp_fac(:) - rate(:,467) = 4.2e-11_r8 * exp_fac(:) - rate(:,470) = 2.8e-17_r8 * exp_fac(:) - rate(:,471) = 1.1e-10_r8 * exp_fac(:) - rate(:,473) = 3.9e-11_r8 * exp_fac(:) - rate(:,476) = 1.3e-12_r8 * exp_fac(:) - rate(:,478) = 5e-12_r8 * exp_fac(:) - rate(:,479) = 2.3e-12_r8 * exp_fac(:) - rate(:,482) = 3.9e-11_r8 * exp_fac(:) - rate(:,485) = 2.8e-17_r8 * exp_fac(:) - rate(:,486) = 9.2e-11_r8 * exp_fac(:) - rate(:,489) = 3.85e-11_r8 * exp_fac(:) - rate(:,493) = 1.2e-12_r8 * exp_fac(:) - rate(:,497) = 9.8e-13_r8 * exp_fac(:) - rate(:,502) = 4.4e-18_r8 * exp_fac(:) - rate(:,503) = 3.6e-11_r8 * exp_fac(:) - rate(:,555) = 4.7e-11_r8 * exp_fac(:) - rate(:,568) = 2.1e-12_r8 * exp_fac(:) - rate(:,569) = 2.8e-13_r8 * exp_fac(:) - rate(:,577) = 1.7e-11_r8 * exp_fac(:) - rate(:,583) = 8.4e-11_r8 * exp_fac(:) - rate(:,586) = 5.3e-13_r8 * exp_fac(:) - rate(:,588) = 2e-12_r8 * exp_fac(:) - rate(:,591) = 2.3e-12_r8 * exp_fac(:) - rate(:,596) = 2e-12_r8 * exp_fac(:) - rate(:,599) = 2.3e-12_r8 * exp_fac(:) - rate(:,605) = 1.9e-11_r8 * exp_fac(:) - rate(:,606) = 5.3e-13_r8 * exp_fac(:) - rate(:,608) = 2e-12_r8 * exp_fac(:) - rate(:,611) = 2.3e-12_r8 * exp_fac(:) - rate(:,616) = 2e-12_r8 * exp_fac(:) - rate(:,619) = 2.3e-12_r8 * exp_fac(:) - rate(:,623) = 1.2e-14_r8 * exp_fac(:) - rate(:,624) = 2e-10_r8 * exp_fac(:) - rate(:,625) = 2.5e-12_r8 * exp_fac(:) - rate(:,626) = 5.3e-13_r8 * exp_fac(:) - rate(:,628) = 2e-12_r8 * exp_fac(:) - rate(:,631) = 2.3e-12_r8 * exp_fac(:) - rate(:,636) = 2e-12_r8 * exp_fac(:) - rate(:,639) = 2.3e-12_r8 * exp_fac(:) - rate(:,645) = 1.2e-11_r8 * exp_fac(:) - rate(:,647) = 2e-12_r8 * exp_fac(:) - rate(:,649) = 5.3e-13_r8 * exp_fac(:) - rate(:,651) = 2.3e-12_r8 * exp_fac(:) - rate(:,656) = 2e-12_r8 * exp_fac(:) - rate(:,659) = 2.3e-12_r8 * exp_fac(:) - rate(:,665) = 1.1e-11_r8 * exp_fac(:) - rate(:,667) = 2e-12_r8 * exp_fac(:) - rate(:,669) = 5.3e-13_r8 * exp_fac(:) - rate(:,671) = 2.3e-12_r8 * exp_fac(:) - rate(:,676) = 2e-12_r8 * exp_fac(:) - rate(:,679) = 2.3e-12_r8 * exp_fac(:) - rate(:,684) = 2.1e-10_r8 * exp_fac(:) + rate(:,310) = 4e-13_r8 * exp_fac(:) + rate(:,315) = 1.31e-10_r8 * exp_fac(:) + rate(:,316) = 3.5e-11_r8 * exp_fac(:) + rate(:,317) = 9e-12_r8 * exp_fac(:) + rate(:,324) = 6.8e-14_r8 * exp_fac(:) + rate(:,325) = 2e-13_r8 * exp_fac(:) + rate(:,340) = 1e-12_r8 * exp_fac(:) + rate(:,344) = 1e-14_r8 * exp_fac(:) + rate(:,345) = 1e-11_r8 * exp_fac(:) + rate(:,346) = 1.15e-11_r8 * exp_fac(:) + rate(:,347) = 3.3e-11_r8 * exp_fac(:) + rate(:,348) = 3.4e-12_r8 * exp_fac(:) + rate(:,349) = 4e-14_r8 * exp_fac(:) + rate(:,362) = 3e-12_r8 * exp_fac(:) + rate(:,363) = 1.2e-11_r8 * exp_fac(:) + rate(:,364) = 6.7e-13_r8 * exp_fac(:) + rate(:,374) = 3.5e-13_r8 * exp_fac(:) + rate(:,375) = 5.4e-11_r8 * exp_fac(:) + rate(:,376) = 3.77e-11_r8 * exp_fac(:) + rate(:,379) = 2e-12_r8 * exp_fac(:) + rate(:,380) = 1.29e-11_r8 * exp_fac(:) + rate(:,382) = 4.5e-14_r8 * exp_fac(:) + rate(:,387) = 3.77e-11_r8 * exp_fac(:) + rate(:,393) = 4e-12_r8 * exp_fac(:) + rate(:,399) = 1.78e-12_r8 * exp_fac(:) + rate(:,401) = 6.1e-13_r8 * exp_fac(:) + rate(:,405) = 4.8e-11_r8 * exp_fac(:) + rate(:,408) = 1.6e-12_r8 * exp_fac(:) + rate(:,410) = 6.7e-12_r8 * exp_fac(:) + rate(:,413) = 3.5e-12_r8 * exp_fac(:) + rate(:,418) = 6.42e-11_r8 * exp_fac(:) + rate(:,425) = 1.6e-13_r8 * exp_fac(:) + rate(:,431) = 1.4e-12_r8 * exp_fac(:) + rate(:,436) = 7.5e-13_r8 * exp_fac(:) + rate(:,437) = 1.4e-13_r8 * exp_fac(:) + rate(:,438) = 7.5e-13_r8 * exp_fac(:) + rate(:,439) = 3.6e-13_r8 * exp_fac(:) + rate(:,440) = 6.5e-13_r8 * exp_fac(:) + rate(:,441) = 2.1e-13_r8 * exp_fac(:) + rate(:,442) = 6.5e-13_r8 * exp_fac(:) + rate(:,443) = 4.9e-13_r8 * exp_fac(:) + rate(:,445) = 1.2e-12_r8 * exp_fac(:) + rate(:,449) = 9.8e-13_r8 * exp_fac(:) + rate(:,452) = 1.85e-11_r8 * exp_fac(:) + rate(:,453) = 1.63e-12_r8 * exp_fac(:) + rate(:,454) = 2.5e-11_r8 * exp_fac(:) + rate(:,455) = 1.1e-11_r8 * exp_fac(:) + rate(:,456) = 3.3e-11_r8 * exp_fac(:) + rate(:,459) = 2.8e-17_r8 * exp_fac(:) + rate(:,460) = 8e-11_r8 * exp_fac(:) + rate(:,463) = 3e-11_r8 * exp_fac(:) + rate(:,466) = 4.2e-11_r8 * exp_fac(:) + rate(:,469) = 2.8e-17_r8 * exp_fac(:) + rate(:,470) = 1.1e-10_r8 * exp_fac(:) + rate(:,472) = 3.9e-11_r8 * exp_fac(:) + rate(:,475) = 1.3e-12_r8 * exp_fac(:) + rate(:,477) = 5e-12_r8 * exp_fac(:) + rate(:,478) = 2.3e-12_r8 * exp_fac(:) + rate(:,481) = 3.9e-11_r8 * exp_fac(:) + rate(:,484) = 2.8e-17_r8 * exp_fac(:) + rate(:,485) = 9.2e-11_r8 * exp_fac(:) + rate(:,488) = 3.85e-11_r8 * exp_fac(:) + rate(:,492) = 1.2e-12_r8 * exp_fac(:) + rate(:,496) = 9.8e-13_r8 * exp_fac(:) + rate(:,501) = 4.4e-18_r8 * exp_fac(:) + rate(:,502) = 3.6e-11_r8 * exp_fac(:) + rate(:,554) = 4.7e-11_r8 * exp_fac(:) + rate(:,567) = 2.1e-12_r8 * exp_fac(:) + rate(:,568) = 2.8e-13_r8 * exp_fac(:) + rate(:,576) = 1.7e-11_r8 * exp_fac(:) + rate(:,582) = 8.4e-11_r8 * exp_fac(:) + rate(:,585) = 5.3e-13_r8 * exp_fac(:) + rate(:,587) = 2e-12_r8 * exp_fac(:) + rate(:,590) = 2.3e-12_r8 * exp_fac(:) + rate(:,595) = 2e-12_r8 * exp_fac(:) + rate(:,598) = 2.3e-12_r8 * exp_fac(:) + rate(:,604) = 1.9e-11_r8 * exp_fac(:) + rate(:,605) = 5.3e-13_r8 * exp_fac(:) + rate(:,607) = 2e-12_r8 * exp_fac(:) + rate(:,610) = 2.3e-12_r8 * exp_fac(:) + rate(:,615) = 2e-12_r8 * exp_fac(:) + rate(:,618) = 2.3e-12_r8 * exp_fac(:) + rate(:,622) = 1.2e-14_r8 * exp_fac(:) + rate(:,623) = 2e-10_r8 * exp_fac(:) + rate(:,624) = 2.5e-12_r8 * exp_fac(:) + rate(:,625) = 5.3e-13_r8 * exp_fac(:) + rate(:,627) = 2e-12_r8 * exp_fac(:) + rate(:,630) = 2.3e-12_r8 * exp_fac(:) + rate(:,635) = 2e-12_r8 * exp_fac(:) + rate(:,638) = 2.3e-12_r8 * exp_fac(:) + rate(:,644) = 1.2e-11_r8 * exp_fac(:) + rate(:,646) = 2e-12_r8 * exp_fac(:) + rate(:,648) = 5.3e-13_r8 * exp_fac(:) + rate(:,650) = 2.3e-12_r8 * exp_fac(:) + rate(:,655) = 2e-12_r8 * exp_fac(:) + rate(:,658) = 2.3e-12_r8 * exp_fac(:) + rate(:,664) = 1.1e-11_r8 * exp_fac(:) + rate(:,666) = 2e-12_r8 * exp_fac(:) + rate(:,668) = 5.3e-13_r8 * exp_fac(:) + rate(:,670) = 2.3e-12_r8 * exp_fac(:) + rate(:,675) = 2e-12_r8 * exp_fac(:) + rate(:,678) = 2.3e-12_r8 * exp_fac(:) + rate(:,683) = 2.1e-10_r8 * exp_fac(:) + rate(:,689) = 8.9e-11_r8 * exp_fac(:) rate(:,690) = 8.9e-11_r8 * exp_fac(:) - rate(:,691) = 8.9e-11_r8 * exp_fac(:) - rate(:,695) = 2e-12_r8 * exp_fac(:) - rate(:,698) = 2.3e-12_r8 * exp_fac(:) - rate(:,706) = 4e-12_r8 * exp_fac(:) - rate(:,709) = 2e-14_r8 * exp_fac(:) - rate(:,711) = 2e-12_r8 * exp_fac(:) - rate(:,714) = 2.3e-12_r8 * exp_fac(:) - rate(:,719) = 2.52e-11_r8 * exp_fac(:) - rate(:,724) = 4e-12_r8 * exp_fac(:) - rate(:,728) = 2e-14_r8 * exp_fac(:) - rate(:,730) = 2e-12_r8 * exp_fac(:) - rate(:,733) = 2.3e-12_r8 * exp_fac(:) - rate(:,738) = 1.92e-11_r8 * exp_fac(:) - rate(:,740) = 2e-12_r8 * exp_fac(:) - rate(:,743) = 2.3e-12_r8 * exp_fac(:) + rate(:,694) = 2e-12_r8 * exp_fac(:) + rate(:,697) = 2.3e-12_r8 * exp_fac(:) + rate(:,705) = 4e-12_r8 * exp_fac(:) + rate(:,708) = 2e-14_r8 * exp_fac(:) + rate(:,710) = 2e-12_r8 * exp_fac(:) + rate(:,713) = 2.3e-12_r8 * exp_fac(:) + rate(:,718) = 2.52e-11_r8 * exp_fac(:) + rate(:,723) = 4e-12_r8 * exp_fac(:) + rate(:,727) = 2e-14_r8 * exp_fac(:) + rate(:,729) = 2e-12_r8 * exp_fac(:) + rate(:,732) = 2.3e-12_r8 * exp_fac(:) + rate(:,737) = 1.92e-11_r8 * exp_fac(:) + rate(:,739) = 2e-12_r8 * exp_fac(:) + rate(:,742) = 2.3e-12_r8 * exp_fac(:) + rate(:,746) = 8.8e-12_r8 * exp_fac(:) rate(:,747) = 8.8e-12_r8 * exp_fac(:) rate(:,748) = 8.8e-12_r8 * exp_fac(:) - rate(:,749) = 8.8e-12_r8 * exp_fac(:) - rate(:,754) = 4e-12_r8 * exp_fac(:) - rate(:,756) = 2e-14_r8 * exp_fac(:) - rate(:,758) = 3.66e-12_r8 * exp_fac(:) - rate(:,759) = 2.8e-11_r8 * exp_fac(:) - rate(:,760) = 2.6e-13_r8 * exp_fac(:) - rate(:,763) = 8.3e-18_r8 * exp_fac(:) - rate(:,764) = 1.1e-10_r8 * exp_fac(:) - rate(:,768) = 1.1e-16_r8 * exp_fac(:) - rate(:,770) = 3.64e-12_r8 * exp_fac(:) - rate(:,771) = 2.8e-11_r8 * exp_fac(:) - rate(:,772) = 1.7e-11_r8 * exp_fac(:) - rate(:,775) = 1.1e-10_r8 * exp_fac(:) - rate(:,776) = 9.58e-12_r8 * exp_fac(:) - rate(:,779) = 1.1e-10_r8 * exp_fac(:) - rate(:,780) = 1.23e-11_r8 * exp_fac(:) - rate(:,783) = 1.1e-10_r8 * exp_fac(:) - rate(:,784) = 3.64e-12_r8 * exp_fac(:) - rate(:,787) = 1.1e-10_r8 * exp_fac(:) - rate(:,788) = 5.5e-12_r8 * exp_fac(:) - rate(:,789) = 4.65e-11_r8 * exp_fac(:) - rate(:,790) = 2.8e-11_r8 * exp_fac(:) - rate(:,798) = 2.3e-12_r8 * exp_fac(:) + rate(:,753) = 4e-12_r8 * exp_fac(:) + rate(:,755) = 2e-14_r8 * exp_fac(:) + rate(:,757) = 3.66e-12_r8 * exp_fac(:) + rate(:,758) = 2.8e-11_r8 * exp_fac(:) + rate(:,759) = 2.6e-13_r8 * exp_fac(:) + rate(:,762) = 8.3e-18_r8 * exp_fac(:) + rate(:,763) = 1.1e-10_r8 * exp_fac(:) + rate(:,767) = 1.1e-16_r8 * exp_fac(:) + rate(:,769) = 3.64e-12_r8 * exp_fac(:) + rate(:,770) = 2.8e-11_r8 * exp_fac(:) + rate(:,771) = 1.7e-11_r8 * exp_fac(:) + rate(:,774) = 1.1e-10_r8 * exp_fac(:) + rate(:,775) = 9.58e-12_r8 * exp_fac(:) + rate(:,778) = 1.1e-10_r8 * exp_fac(:) + rate(:,779) = 1.23e-11_r8 * exp_fac(:) + rate(:,782) = 1.1e-10_r8 * exp_fac(:) + rate(:,783) = 3.64e-12_r8 * exp_fac(:) + rate(:,786) = 1.1e-10_r8 * exp_fac(:) + rate(:,787) = 5.5e-12_r8 * exp_fac(:) + rate(:,788) = 4.65e-11_r8 * exp_fac(:) + rate(:,789) = 2.8e-11_r8 * exp_fac(:) + rate(:,797) = 2.3e-12_r8 * exp_fac(:) rate(:,799) = 1.2e-11_r8 * exp_fac(:) rate(:,800) = 5.7e-11_r8 * exp_fac(:) rate(:,801) = 2.8e-11_r8 * exp_fac(:) rate(:,802) = 6.6e-11_r8 * exp_fac(:) rate(:,803) = 1.4e-11_r8 * exp_fac(:) rate(:,806) = 1.9e-12_r8 * exp_fac(:) - rate(:,830) = 6.34e-08_r8 * exp_fac(:) - rate(:,847) = 1.9e-11_r8 * exp_fac(:) - rate(:,850) = 1.2e-14_r8 * exp_fac(:) - rate(:,851) = 2e-10_r8 * exp_fac(:) - rate(:,855) = 2.5e-12_r8 * exp_fac(:) - rate(:,867) = 1.34e-11_r8 * exp_fac(:) - rate(:,868) = 1.2e-11_r8 * exp_fac(:) - rate(:,873) = 1.1e-11_r8 * exp_fac(:) - rate(:,877) = 2.1e-10_r8 * exp_fac(:) - rate(:,878) = 1.34e-11_r8 * exp_fac(:) - rate(:,882) = 1.7e-11_r8 * exp_fac(:) - rate(:,902) = 1.29e-07_r8 * exp_fac(:) - rate(:,903) = 2.31e-07_r8 * exp_fac(:) - rate(:,904) = 2.31e-06_r8 * exp_fac(:) - rate(:,905) = 4.63e-07_r8 * exp_fac(:) + rate(:,829) = 6.34e-08_r8 * exp_fac(:) + rate(:,846) = 1.9e-11_r8 * exp_fac(:) + rate(:,849) = 1.2e-14_r8 * exp_fac(:) + rate(:,850) = 2e-10_r8 * exp_fac(:) + rate(:,854) = 2.5e-12_r8 * exp_fac(:) + rate(:,866) = 1.34e-11_r8 * exp_fac(:) + rate(:,867) = 1.2e-11_r8 * exp_fac(:) + rate(:,872) = 1.1e-11_r8 * exp_fac(:) + rate(:,876) = 2.1e-10_r8 * exp_fac(:) + rate(:,877) = 1.34e-11_r8 * exp_fac(:) + rate(:,881) = 1.7e-11_r8 * exp_fac(:) + rate(:,901) = 1.29e-07_r8 * exp_fac(:) + rate(:,902) = 2.31e-07_r8 * exp_fac(:) + rate(:,903) = 2.31e-06_r8 * exp_fac(:) + rate(:,904) = 4.63e-07_r8 * exp_fac(:) rate(:,278) = 6e-12_r8 * exp( 400._r8 * itemp(:) ) rate(:,283) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) rate(:,284) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) exp_fac(:) = exp( -1520._r8 * itemp(:) ) rate(:,285) = 1.64e-12_r8 * exp_fac(:) - rate(:,404) = 8.5e-16_r8 * exp_fac(:) + rate(:,403) = 8.5e-16_r8 * exp_fac(:) exp_fac(:) = exp( -1100._r8 * itemp(:) ) rate(:,286) = 2.03e-11_r8 * exp_fac(:) rate(:,805) = 3.4e-12_r8 * exp_fac(:) @@ -552,329 +552,329 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,292) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) rate(:,298) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) rate(:,299) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) - rate(:,301) = 5.5e-12_r8 * exp( 125._r8 * itemp(:) ) rate(:,302) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) rate(:,303) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) rate(:,304) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) exp_fac(:) = exp( 300._r8 * itemp(:) ) rate(:,305) = 2.8e-12_r8 * exp_fac(:) - rate(:,371) = 2.9e-12_r8 * exp_fac(:) + rate(:,370) = 2.9e-12_r8 * exp_fac(:) rate(:,306) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) rate(:,308) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) exp_fac(:) = exp( 500._r8 * itemp(:) ) - rate(:,312) = 1.3e-12_r8 * exp_fac(:) - rate(:,336) = 2.9e-12_r8 * exp_fac(:) - rate(:,337) = 2e-12_r8 * exp_fac(:) - rate(:,369) = 7.1e-13_r8 * exp_fac(:) - rate(:,382) = 2e-12_r8 * exp_fac(:) - rate(:,389) = 2.9e-12_r8 * exp_fac(:) - rate(:,390) = 2e-12_r8 * exp_fac(:) - rate(:,392) = 2.9e-12_r8 * exp_fac(:) - rate(:,401) = 2e-12_r8 * exp_fac(:) - rate(:,425) = 2e-12_r8 * exp_fac(:) - rate(:,431) = 2e-12_r8 * exp_fac(:) - rate(:,445) = 2e-12_r8 * exp_fac(:) - rate(:,449) = 2e-12_r8 * exp_fac(:) - rate(:,475) = 2e-12_r8 * exp_fac(:) - rate(:,492) = 2e-12_r8 * exp_fac(:) - rate(:,496) = 2e-12_r8 * exp_fac(:) - rate(:,587) = 2e-12_r8 * exp_fac(:) + rate(:,311) = 1.3e-12_r8 * exp_fac(:) + rate(:,335) = 2.9e-12_r8 * exp_fac(:) + rate(:,336) = 2e-12_r8 * exp_fac(:) + rate(:,368) = 7.1e-13_r8 * exp_fac(:) + rate(:,381) = 2e-12_r8 * exp_fac(:) + rate(:,388) = 2.9e-12_r8 * exp_fac(:) + rate(:,389) = 2e-12_r8 * exp_fac(:) + rate(:,391) = 2.9e-12_r8 * exp_fac(:) + rate(:,400) = 2e-12_r8 * exp_fac(:) + rate(:,424) = 2e-12_r8 * exp_fac(:) + rate(:,430) = 2e-12_r8 * exp_fac(:) + rate(:,444) = 2e-12_r8 * exp_fac(:) + rate(:,448) = 2e-12_r8 * exp_fac(:) + rate(:,474) = 2e-12_r8 * exp_fac(:) + rate(:,491) = 2e-12_r8 * exp_fac(:) + rate(:,495) = 2e-12_r8 * exp_fac(:) + rate(:,586) = 2e-12_r8 * exp_fac(:) + rate(:,591) = 2e-12_r8 * exp_fac(:) rate(:,592) = 2e-12_r8 * exp_fac(:) rate(:,593) = 2e-12_r8 * exp_fac(:) rate(:,594) = 2e-12_r8 * exp_fac(:) - rate(:,595) = 2e-12_r8 * exp_fac(:) + rate(:,599) = 2e-12_r8 * exp_fac(:) rate(:,600) = 2e-12_r8 * exp_fac(:) rate(:,601) = 2e-12_r8 * exp_fac(:) - rate(:,602) = 2e-12_r8 * exp_fac(:) - rate(:,607) = 2e-12_r8 * exp_fac(:) + rate(:,606) = 2e-12_r8 * exp_fac(:) + rate(:,611) = 2e-12_r8 * exp_fac(:) rate(:,612) = 2e-12_r8 * exp_fac(:) rate(:,613) = 2e-12_r8 * exp_fac(:) rate(:,614) = 2e-12_r8 * exp_fac(:) - rate(:,615) = 2e-12_r8 * exp_fac(:) + rate(:,619) = 2e-12_r8 * exp_fac(:) rate(:,620) = 2e-12_r8 * exp_fac(:) rate(:,621) = 2e-12_r8 * exp_fac(:) - rate(:,622) = 2e-12_r8 * exp_fac(:) - rate(:,627) = 2e-12_r8 * exp_fac(:) + rate(:,626) = 2e-12_r8 * exp_fac(:) + rate(:,631) = 2e-12_r8 * exp_fac(:) rate(:,632) = 2e-12_r8 * exp_fac(:) rate(:,633) = 2e-12_r8 * exp_fac(:) rate(:,634) = 2e-12_r8 * exp_fac(:) - rate(:,635) = 2e-12_r8 * exp_fac(:) + rate(:,639) = 2e-12_r8 * exp_fac(:) rate(:,640) = 2e-12_r8 * exp_fac(:) rate(:,641) = 2e-12_r8 * exp_fac(:) - rate(:,642) = 2e-12_r8 * exp_fac(:) - rate(:,646) = 2e-12_r8 * exp_fac(:) + rate(:,645) = 2e-12_r8 * exp_fac(:) + rate(:,651) = 2e-12_r8 * exp_fac(:) rate(:,652) = 2e-12_r8 * exp_fac(:) rate(:,653) = 2e-12_r8 * exp_fac(:) rate(:,654) = 2e-12_r8 * exp_fac(:) - rate(:,655) = 2e-12_r8 * exp_fac(:) + rate(:,659) = 2e-12_r8 * exp_fac(:) rate(:,660) = 2e-12_r8 * exp_fac(:) rate(:,661) = 2e-12_r8 * exp_fac(:) - rate(:,662) = 2e-12_r8 * exp_fac(:) - rate(:,666) = 2e-12_r8 * exp_fac(:) + rate(:,665) = 2e-12_r8 * exp_fac(:) + rate(:,671) = 2e-12_r8 * exp_fac(:) rate(:,672) = 2e-12_r8 * exp_fac(:) rate(:,673) = 2e-12_r8 * exp_fac(:) rate(:,674) = 2e-12_r8 * exp_fac(:) - rate(:,675) = 2e-12_r8 * exp_fac(:) + rate(:,679) = 2e-12_r8 * exp_fac(:) rate(:,680) = 2e-12_r8 * exp_fac(:) rate(:,681) = 2e-12_r8 * exp_fac(:) - rate(:,682) = 2e-12_r8 * exp_fac(:) - rate(:,694) = 2e-12_r8 * exp_fac(:) + rate(:,693) = 2e-12_r8 * exp_fac(:) + rate(:,698) = 2e-12_r8 * exp_fac(:) rate(:,699) = 2e-12_r8 * exp_fac(:) rate(:,700) = 2e-12_r8 * exp_fac(:) - rate(:,701) = 2e-12_r8 * exp_fac(:) - rate(:,702) = 2.9e-12_r8 * exp_fac(:) - rate(:,703) = 2e-12_r8 * exp_fac(:) + rate(:,701) = 2.9e-12_r8 * exp_fac(:) + rate(:,702) = 2e-12_r8 * exp_fac(:) + rate(:,706) = 2.9e-12_r8 * exp_fac(:) rate(:,707) = 2.9e-12_r8 * exp_fac(:) - rate(:,708) = 2.9e-12_r8 * exp_fac(:) - rate(:,710) = 2e-12_r8 * exp_fac(:) + rate(:,709) = 2e-12_r8 * exp_fac(:) + rate(:,714) = 2e-12_r8 * exp_fac(:) rate(:,715) = 2e-12_r8 * exp_fac(:) rate(:,716) = 2e-12_r8 * exp_fac(:) - rate(:,717) = 2e-12_r8 * exp_fac(:) - rate(:,720) = 2.9e-12_r8 * exp_fac(:) - rate(:,721) = 2e-12_r8 * exp_fac(:) + rate(:,719) = 2.9e-12_r8 * exp_fac(:) + rate(:,720) = 2e-12_r8 * exp_fac(:) + rate(:,724) = 2.9e-12_r8 * exp_fac(:) rate(:,725) = 2.9e-12_r8 * exp_fac(:) rate(:,726) = 2.9e-12_r8 * exp_fac(:) - rate(:,727) = 2.9e-12_r8 * exp_fac(:) - rate(:,729) = 2e-12_r8 * exp_fac(:) + rate(:,728) = 2e-12_r8 * exp_fac(:) + rate(:,733) = 2e-12_r8 * exp_fac(:) rate(:,734) = 2e-12_r8 * exp_fac(:) rate(:,735) = 2e-12_r8 * exp_fac(:) - rate(:,736) = 2e-12_r8 * exp_fac(:) - rate(:,739) = 2e-12_r8 * exp_fac(:) + rate(:,738) = 2e-12_r8 * exp_fac(:) + rate(:,743) = 2e-12_r8 * exp_fac(:) rate(:,744) = 2e-12_r8 * exp_fac(:) rate(:,745) = 2e-12_r8 * exp_fac(:) - rate(:,746) = 2e-12_r8 * exp_fac(:) - rate(:,750) = 2.9e-12_r8 * exp_fac(:) - rate(:,751) = 2e-12_r8 * exp_fac(:) - rate(:,755) = 2.9e-12_r8 * exp_fac(:) - rate(:,313) = 5.6e-15_r8 * exp( 2300._r8 * itemp(:) ) - rate(:,314) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) - rate(:,315) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) - rate(:,319) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) - rate(:,324) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + rate(:,749) = 2.9e-12_r8 * exp_fac(:) + rate(:,750) = 2e-12_r8 * exp_fac(:) + rate(:,754) = 2.9e-12_r8 * exp_fac(:) + rate(:,312) = 5.6e-15_r8 * exp( 2300._r8 * itemp(:) ) + rate(:,313) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) + rate(:,314) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) + rate(:,318) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) + rate(:,323) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) exp_fac(:) = exp( 700._r8 * itemp(:) ) - rate(:,327) = 7.5e-13_r8 * exp_fac(:) - rate(:,342) = 7.5e-13_r8 * exp_fac(:) - rate(:,357) = 7.5e-13_r8 * exp_fac(:) - rate(:,366) = 7.5e-13_r8 * exp_fac(:) - rate(:,370) = 8.6e-13_r8 * exp_fac(:) - rate(:,395) = 7.5e-13_r8 * exp_fac(:) - rate(:,410) = 7.5e-13_r8 * exp_fac(:) - rate(:,545) = 7.5e-13_r8 * exp_fac(:) - rate(:,549) = 7.5e-13_r8 * exp_fac(:) - rate(:,552) = 7.5e-13_r8 * exp_fac(:) - rate(:,565) = 7.5e-13_r8 * exp_fac(:) - rate(:,572) = 7.5e-13_r8 * exp_fac(:) - rate(:,578) = 7.5e-13_r8 * exp_fac(:) - rate(:,581) = 7.5e-13_r8 * exp_fac(:) - rate(:,853) = 7.5e-13_r8 * exp_fac(:) - rate(:,865) = 7.5e-13_r8 * exp_fac(:) - rate(:,880) = 7.5e-13_r8 * exp_fac(:) - rate(:,883) = 7.5e-13_r8 * exp_fac(:) + rate(:,326) = 7.5e-13_r8 * exp_fac(:) + rate(:,341) = 7.5e-13_r8 * exp_fac(:) + rate(:,356) = 7.5e-13_r8 * exp_fac(:) + rate(:,365) = 7.5e-13_r8 * exp_fac(:) + rate(:,369) = 8.6e-13_r8 * exp_fac(:) + rate(:,394) = 7.5e-13_r8 * exp_fac(:) + rate(:,409) = 7.5e-13_r8 * exp_fac(:) + rate(:,544) = 7.5e-13_r8 * exp_fac(:) + rate(:,548) = 7.5e-13_r8 * exp_fac(:) + rate(:,551) = 7.5e-13_r8 * exp_fac(:) + rate(:,564) = 7.5e-13_r8 * exp_fac(:) + rate(:,571) = 7.5e-13_r8 * exp_fac(:) + rate(:,577) = 7.5e-13_r8 * exp_fac(:) + rate(:,580) = 7.5e-13_r8 * exp_fac(:) + rate(:,852) = 7.5e-13_r8 * exp_fac(:) + rate(:,864) = 7.5e-13_r8 * exp_fac(:) + rate(:,879) = 7.5e-13_r8 * exp_fac(:) + rate(:,882) = 7.5e-13_r8 * exp_fac(:) exp_fac(:) = exp( 365._r8 * itemp(:) ) - rate(:,328) = 2.6e-12_r8 * exp_fac(:) - rate(:,546) = 2.6e-12_r8 * exp_fac(:) - rate(:,551) = 2.6e-12_r8 * exp_fac(:) - rate(:,553) = 2.6e-12_r8 * exp_fac(:) - rate(:,566) = 2.6e-12_r8 * exp_fac(:) - rate(:,573) = 2.6e-12_r8 * exp_fac(:) - rate(:,579) = 2.6e-12_r8 * exp_fac(:) - rate(:,582) = 2.6e-12_r8 * exp_fac(:) - rate(:,854) = 2.6e-12_r8 * exp_fac(:) - rate(:,866) = 2.6e-12_r8 * exp_fac(:) - rate(:,881) = 2.6e-12_r8 * exp_fac(:) - rate(:,884) = 2.6e-12_r8 * exp_fac(:) - rate(:,329) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) - rate(:,331) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) - rate(:,332) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + rate(:,327) = 2.6e-12_r8 * exp_fac(:) + rate(:,545) = 2.6e-12_r8 * exp_fac(:) + rate(:,550) = 2.6e-12_r8 * exp_fac(:) + rate(:,552) = 2.6e-12_r8 * exp_fac(:) + rate(:,565) = 2.6e-12_r8 * exp_fac(:) + rate(:,572) = 2.6e-12_r8 * exp_fac(:) + rate(:,578) = 2.6e-12_r8 * exp_fac(:) + rate(:,581) = 2.6e-12_r8 * exp_fac(:) + rate(:,853) = 2.6e-12_r8 * exp_fac(:) + rate(:,865) = 2.6e-12_r8 * exp_fac(:) + rate(:,880) = 2.6e-12_r8 * exp_fac(:) + rate(:,883) = 2.6e-12_r8 * exp_fac(:) + rate(:,328) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,330) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,331) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) exp_fac(:) = exp( -1900._r8 * itemp(:) ) - rate(:,333) = 1.4e-12_r8 * exp_fac(:) - rate(:,355) = 6.5e-15_r8 * exp_fac(:) - rate(:,334) = 4.63e-12_r8 * exp( 350._r8 * itemp(:) ) - rate(:,335) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) + rate(:,332) = 1.4e-12_r8 * exp_fac(:) + rate(:,354) = 6.5e-15_r8 * exp_fac(:) + rate(:,333) = 4.63e-12_r8 * exp( 350._r8 * itemp(:) ) + rate(:,334) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) exp_fac(:) = exp( 1040._r8 * itemp(:) ) - rate(:,338) = 4.3e-13_r8 * exp_fac(:) - rate(:,391) = 4.3e-13_r8 * exp_fac(:) - rate(:,542) = 4.3e-13_r8 * exp_fac(:) - rate(:,556) = 4.3e-13_r8 * exp_fac(:) - rate(:,559) = 4.3e-13_r8 * exp_fac(:) - rate(:,562) = 4.3e-13_r8 * exp_fac(:) - rate(:,704) = 4.3e-13_r8 * exp_fac(:) - rate(:,722) = 4.3e-13_r8 * exp_fac(:) - rate(:,752) = 4.3e-13_r8 * exp_fac(:) - rate(:,344) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) - rate(:,354) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) - rate(:,356) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) - rate(:,360) = 8.7e-12_r8 * exp( -615._r8 * itemp(:) ) - rate(:,361) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) - rate(:,362) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) - rate(:,378) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) - rate(:,379) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) + rate(:,337) = 4.3e-13_r8 * exp_fac(:) + rate(:,390) = 4.3e-13_r8 * exp_fac(:) + rate(:,541) = 4.3e-13_r8 * exp_fac(:) + rate(:,555) = 4.3e-13_r8 * exp_fac(:) + rate(:,558) = 4.3e-13_r8 * exp_fac(:) + rate(:,561) = 4.3e-13_r8 * exp_fac(:) + rate(:,703) = 4.3e-13_r8 * exp_fac(:) + rate(:,721) = 4.3e-13_r8 * exp_fac(:) + rate(:,751) = 4.3e-13_r8 * exp_fac(:) + rate(:,339) = 3.15e-14_r8 * exp( 920._r8 * itemp(:) ) + rate(:,343) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,353) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,355) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,359) = 9.19e-12_r8 * exp( -630._r8 * itemp(:) ) + rate(:,360) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) + rate(:,361) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + rate(:,377) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) + rate(:,378) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) exp_fac(:) = exp( 1300._r8 * itemp(:) ) - rate(:,384) = 2.11e-13_r8 * exp_fac(:) - rate(:,403) = 2.11e-13_r8 * exp_fac(:) - rate(:,422) = 2.38e-13_r8 * exp_fac(:) - rate(:,427) = 2.12e-13_r8 * exp_fac(:) - rate(:,433) = 2.12e-13_r8 * exp_fac(:) - rate(:,447) = 2.12e-13_r8 * exp_fac(:) - rate(:,451) = 2.12e-13_r8 * exp_fac(:) - rate(:,458) = 2.6e-13_r8 * exp_fac(:) - rate(:,462) = 2.6e-13_r8 * exp_fac(:) - rate(:,465) = 2.6e-13_r8 * exp_fac(:) - rate(:,468) = 2.6e-13_r8 * exp_fac(:) - rate(:,472) = 2.6e-13_r8 * exp_fac(:) - rate(:,477) = 2.47e-13_r8 * exp_fac(:) - rate(:,480) = 2.64e-13_r8 * exp_fac(:) - rate(:,483) = 2.64e-13_r8 * exp_fac(:) - rate(:,494) = 2.12e-13_r8 * exp_fac(:) - rate(:,498) = 2.12e-13_r8 * exp_fac(:) - rate(:,500) = 2.6e-13_r8 * exp_fac(:) - rate(:,589) = 2.71e-13_r8 * exp_fac(:) - rate(:,597) = 2.6e-13_r8 * exp_fac(:) - rate(:,609) = 2.78e-13_r8 * exp_fac(:) - rate(:,617) = 2.75e-13_r8 * exp_fac(:) - rate(:,629) = 2.71e-13_r8 * exp_fac(:) - rate(:,637) = 2.6e-13_r8 * exp_fac(:) - rate(:,648) = 2.71e-13_r8 * exp_fac(:) - rate(:,657) = 2.6e-13_r8 * exp_fac(:) - rate(:,668) = 2.71e-13_r8 * exp_fac(:) - rate(:,677) = 2.6e-13_r8 * exp_fac(:) - rate(:,688) = 2.71e-13_r8 * exp_fac(:) - rate(:,692) = 2.71e-13_r8 * exp_fac(:) - rate(:,696) = 2.54e-13_r8 * exp_fac(:) - rate(:,712) = 2.62e-13_r8 * exp_fac(:) - rate(:,731) = 2.66e-13_r8 * exp_fac(:) - rate(:,741) = 2.51e-13_r8 * exp_fac(:) - rate(:,761) = 2.68e-13_r8 * exp_fac(:) - rate(:,766) = 2.47e-13_r8 * exp_fac(:) - rate(:,773) = 2.76e-13_r8 * exp_fac(:) - rate(:,777) = 2.76e-13_r8 * exp_fac(:) - rate(:,781) = 2.75e-13_r8 * exp_fac(:) - rate(:,785) = 2.75e-13_r8 * exp_fac(:) - rate(:,843) = 2.6e-13_r8 * exp_fac(:) - rate(:,848) = 2.75e-13_r8 * exp_fac(:) - rate(:,856) = 2.6e-13_r8 * exp_fac(:) - rate(:,861) = 2.12e-13_r8 * exp_fac(:) - rate(:,869) = 2.6e-13_r8 * exp_fac(:) - rate(:,874) = 2.6e-13_r8 * exp_fac(:) - rate(:,385) = 2.9e+07_r8 * exp( -5297._r8 * itemp(:) ) - rate(:,386) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) + rate(:,383) = 2.11e-13_r8 * exp_fac(:) + rate(:,402) = 2.11e-13_r8 * exp_fac(:) + rate(:,421) = 2.38e-13_r8 * exp_fac(:) + rate(:,426) = 2.12e-13_r8 * exp_fac(:) + rate(:,432) = 2.12e-13_r8 * exp_fac(:) + rate(:,446) = 2.12e-13_r8 * exp_fac(:) + rate(:,450) = 2.12e-13_r8 * exp_fac(:) + rate(:,457) = 2.6e-13_r8 * exp_fac(:) + rate(:,461) = 2.6e-13_r8 * exp_fac(:) + rate(:,464) = 2.6e-13_r8 * exp_fac(:) + rate(:,467) = 2.6e-13_r8 * exp_fac(:) + rate(:,471) = 2.6e-13_r8 * exp_fac(:) + rate(:,476) = 2.47e-13_r8 * exp_fac(:) + rate(:,479) = 2.64e-13_r8 * exp_fac(:) + rate(:,482) = 2.64e-13_r8 * exp_fac(:) + rate(:,493) = 2.12e-13_r8 * exp_fac(:) + rate(:,497) = 2.12e-13_r8 * exp_fac(:) + rate(:,499) = 2.6e-13_r8 * exp_fac(:) + rate(:,588) = 2.71e-13_r8 * exp_fac(:) + rate(:,596) = 2.6e-13_r8 * exp_fac(:) + rate(:,608) = 2.78e-13_r8 * exp_fac(:) + rate(:,616) = 2.75e-13_r8 * exp_fac(:) + rate(:,628) = 2.71e-13_r8 * exp_fac(:) + rate(:,636) = 2.6e-13_r8 * exp_fac(:) + rate(:,647) = 2.71e-13_r8 * exp_fac(:) + rate(:,656) = 2.6e-13_r8 * exp_fac(:) + rate(:,667) = 2.71e-13_r8 * exp_fac(:) + rate(:,676) = 2.6e-13_r8 * exp_fac(:) + rate(:,687) = 2.71e-13_r8 * exp_fac(:) + rate(:,691) = 2.71e-13_r8 * exp_fac(:) + rate(:,695) = 2.54e-13_r8 * exp_fac(:) + rate(:,711) = 2.62e-13_r8 * exp_fac(:) + rate(:,730) = 2.66e-13_r8 * exp_fac(:) + rate(:,740) = 2.51e-13_r8 * exp_fac(:) + rate(:,760) = 2.68e-13_r8 * exp_fac(:) + rate(:,765) = 2.47e-13_r8 * exp_fac(:) + rate(:,772) = 2.76e-13_r8 * exp_fac(:) + rate(:,776) = 2.76e-13_r8 * exp_fac(:) + rate(:,780) = 2.75e-13_r8 * exp_fac(:) + rate(:,784) = 2.75e-13_r8 * exp_fac(:) + rate(:,842) = 2.6e-13_r8 * exp_fac(:) + rate(:,847) = 2.75e-13_r8 * exp_fac(:) + rate(:,855) = 2.6e-13_r8 * exp_fac(:) + rate(:,860) = 2.12e-13_r8 * exp_fac(:) + rate(:,868) = 2.6e-13_r8 * exp_fac(:) + rate(:,873) = 2.6e-13_r8 * exp_fac(:) + rate(:,384) = 2.9e+07_r8 * exp( -5297._r8 * itemp(:) ) + rate(:,385) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) exp_fac(:) = exp( 360._r8 * itemp(:) ) - rate(:,387) = 9.6e-12_r8 * exp_fac(:) - rate(:,590) = 2.7e-12_r8 * exp_fac(:) - rate(:,598) = 2.7e-12_r8 * exp_fac(:) - rate(:,610) = 2.7e-12_r8 * exp_fac(:) - rate(:,618) = 2.7e-12_r8 * exp_fac(:) - rate(:,630) = 2.7e-12_r8 * exp_fac(:) - rate(:,638) = 2.7e-12_r8 * exp_fac(:) - rate(:,650) = 2.7e-12_r8 * exp_fac(:) - rate(:,658) = 2.7e-12_r8 * exp_fac(:) - rate(:,670) = 2.7e-12_r8 * exp_fac(:) - rate(:,678) = 2.7e-12_r8 * exp_fac(:) - rate(:,689) = 2.7e-12_r8 * exp_fac(:) - rate(:,693) = 2.7e-12_r8 * exp_fac(:) - rate(:,697) = 2.7e-12_r8 * exp_fac(:) - rate(:,713) = 2.7e-12_r8 * exp_fac(:) - rate(:,732) = 2.7e-12_r8 * exp_fac(:) - rate(:,742) = 2.7e-12_r8 * exp_fac(:) - rate(:,762) = 2.7e-12_r8 * exp_fac(:) - rate(:,767) = 2.7e-12_r8 * exp_fac(:) - rate(:,774) = 2.7e-12_r8 * exp_fac(:) - rate(:,778) = 2.7e-12_r8 * exp_fac(:) - rate(:,782) = 2.7e-12_r8 * exp_fac(:) - rate(:,786) = 2.7e-12_r8 * exp_fac(:) - rate(:,844) = 2.7e-12_r8 * exp_fac(:) - rate(:,849) = 2.7e-12_r8 * exp_fac(:) - rate(:,857) = 2.7e-12_r8 * exp_fac(:) - rate(:,862) = 2.7e-12_r8 * exp_fac(:) - rate(:,870) = 2.7e-12_r8 * exp_fac(:) - rate(:,875) = 2.7e-12_r8 * exp_fac(:) - rate(:,397) = 2.3e-12_r8 * exp( -170._r8 * itemp(:) ) - rate(:,405) = 2.7e-12_r8 * exp( 580._r8 * itemp(:) ) - rate(:,412) = 5.4e-14_r8 * exp( 870._r8 * itemp(:) ) + rate(:,386) = 9.6e-12_r8 * exp_fac(:) + rate(:,589) = 2.7e-12_r8 * exp_fac(:) + rate(:,597) = 2.7e-12_r8 * exp_fac(:) + rate(:,609) = 2.7e-12_r8 * exp_fac(:) + rate(:,617) = 2.7e-12_r8 * exp_fac(:) + rate(:,629) = 2.7e-12_r8 * exp_fac(:) + rate(:,637) = 2.7e-12_r8 * exp_fac(:) + rate(:,649) = 2.7e-12_r8 * exp_fac(:) + rate(:,657) = 2.7e-12_r8 * exp_fac(:) + rate(:,669) = 2.7e-12_r8 * exp_fac(:) + rate(:,677) = 2.7e-12_r8 * exp_fac(:) + rate(:,688) = 2.7e-12_r8 * exp_fac(:) + rate(:,692) = 2.7e-12_r8 * exp_fac(:) + rate(:,696) = 2.7e-12_r8 * exp_fac(:) + rate(:,712) = 2.7e-12_r8 * exp_fac(:) + rate(:,731) = 2.7e-12_r8 * exp_fac(:) + rate(:,741) = 2.7e-12_r8 * exp_fac(:) + rate(:,761) = 2.7e-12_r8 * exp_fac(:) + rate(:,766) = 2.7e-12_r8 * exp_fac(:) + rate(:,773) = 2.7e-12_r8 * exp_fac(:) + rate(:,777) = 2.7e-12_r8 * exp_fac(:) + rate(:,781) = 2.7e-12_r8 * exp_fac(:) + rate(:,785) = 2.7e-12_r8 * exp_fac(:) + rate(:,843) = 2.7e-12_r8 * exp_fac(:) + rate(:,848) = 2.7e-12_r8 * exp_fac(:) + rate(:,856) = 2.7e-12_r8 * exp_fac(:) + rate(:,861) = 2.7e-12_r8 * exp_fac(:) + rate(:,869) = 2.7e-12_r8 * exp_fac(:) + rate(:,874) = 2.7e-12_r8 * exp_fac(:) + rate(:,396) = 2.3e-12_r8 * exp( -170._r8 * itemp(:) ) + rate(:,404) = 2.7e-12_r8 * exp( 580._r8 * itemp(:) ) + rate(:,411) = 5.4e-14_r8 * exp( 870._r8 * itemp(:) ) exp_fac(:) = exp( 450._r8 * itemp(:) ) + rate(:,414) = 1.17e-11_r8 * exp_fac(:) rate(:,415) = 1.17e-11_r8 * exp_fac(:) - rate(:,416) = 1.17e-11_r8 * exp_fac(:) exp_fac(:) = exp( 390._r8 * itemp(:) ) - rate(:,417) = 2.2e-11_r8 * exp_fac(:) - rate(:,418) = 3.5e-11_r8 * exp_fac(:) - rate(:,488) = 2.7e-11_r8 * exp_fac(:) - rate(:,491) = 2.08e-11_r8 * exp_fac(:) - rate(:,769) = 2.7e-11_r8 * exp_fac(:) - rate(:,864) = 2.7e-11_r8 * exp_fac(:) + rate(:,416) = 2.2e-11_r8 * exp_fac(:) + rate(:,417) = 3.5e-11_r8 * exp_fac(:) + rate(:,487) = 2.7e-11_r8 * exp_fac(:) + rate(:,490) = 2.08e-11_r8 * exp_fac(:) + rate(:,768) = 2.7e-11_r8 * exp_fac(:) + rate(:,863) = 2.7e-11_r8 * exp_fac(:) exp_fac(:) = exp( 410._r8 * itemp(:) ) - rate(:,420) = 9.85e-12_r8 * exp_fac(:) - rate(:,604) = 1.34e-11_r8 * exp_fac(:) - rate(:,846) = 1.34e-11_r8 * exp_fac(:) + rate(:,419) = 9.85e-12_r8 * exp_fac(:) + rate(:,603) = 1.34e-11_r8 * exp_fac(:) + rate(:,845) = 1.34e-11_r8 * exp_fac(:) exp_fac(:) = exp( -400._r8 * itemp(:) ) - rate(:,421) = 4.43e-11_r8 * exp_fac(:) - rate(:,423) = 4.43e-11_r8 * exp_fac(:) - rate(:,424) = 3.22e-11_r8 * exp_fac(:) - rate(:,428) = 1.04e+11_r8 * exp( -9746._r8 * itemp(:) ) - rate(:,429) = 2.24e+15_r8 * exp( -10865._r8 * itemp(:) ) - rate(:,430) = 2.22e+15_r8 * exp( -10355._r8 * itemp(:) ) - rate(:,434) = 1.88e+11_r8 * exp( -9752._r8 * itemp(:) ) - rate(:,435) = 2.49e+15_r8 * exp( -11112._r8 * itemp(:) ) - rate(:,436) = 2.49e+15_r8 * exp( -10890._r8 * itemp(:) ) - rate(:,448) = 1.83e+14_r8 * exp( -8930._r8 * itemp(:) ) - rate(:,452) = 2.08e+14_r8 * exp( -9400._r8 * itemp(:) ) + rate(:,420) = 4.43e-11_r8 * exp_fac(:) + rate(:,422) = 4.43e-11_r8 * exp_fac(:) + rate(:,423) = 3.22e-11_r8 * exp_fac(:) + rate(:,427) = 1.04e+11_r8 * exp( -9746._r8 * itemp(:) ) + rate(:,428) = 2.24e+15_r8 * exp( -10865._r8 * itemp(:) ) + rate(:,429) = 2.22e+15_r8 * exp( -10355._r8 * itemp(:) ) + rate(:,433) = 1.88e+11_r8 * exp( -9752._r8 * itemp(:) ) + rate(:,434) = 2.49e+15_r8 * exp( -11112._r8 * itemp(:) ) + rate(:,435) = 2.49e+15_r8 * exp( -10890._r8 * itemp(:) ) + rate(:,447) = 1.83e+14_r8 * exp( -8930._r8 * itemp(:) ) + rate(:,451) = 2.08e+14_r8 * exp( -9400._r8 * itemp(:) ) exp_fac(:) = exp( -10000._r8 * itemp(:) ) - rate(:,459) = 1.256e+13_r8 * exp_fac(:) - rate(:,463) = 1.875e+13_r8 * exp_fac(:) - rate(:,466) = 1.875e+13_r8 * exp_fac(:) - rate(:,469) = 5.092e+12_r8 * exp_fac(:) - rate(:,481) = 8.72e+12_r8 * exp_fac(:) - rate(:,484) = 6.55e+12_r8 * exp_fac(:) + rate(:,458) = 1.256e+13_r8 * exp_fac(:) + rate(:,462) = 1.875e+13_r8 * exp_fac(:) + rate(:,465) = 1.875e+13_r8 * exp_fac(:) + rate(:,468) = 5.092e+12_r8 * exp_fac(:) + rate(:,480) = 8.72e+12_r8 * exp_fac(:) + rate(:,483) = 6.55e+12_r8 * exp_fac(:) exp_fac(:) = exp( -450._r8 * itemp(:) ) - rate(:,474) = 2.95e-12_r8 * exp_fac(:) - rate(:,765) = 2.95e-12_r8 * exp_fac(:) - rate(:,860) = 2.95e-12_r8 * exp_fac(:) + rate(:,473) = 2.95e-12_r8 * exp_fac(:) + rate(:,764) = 2.95e-12_r8 * exp_fac(:) + rate(:,859) = 2.95e-12_r8 * exp_fac(:) exp_fac(:) = exp( -1995._r8 * itemp(:) ) - rate(:,487) = 1.03e-14_r8 * exp_fac(:) - rate(:,863) = 1.03e-14_r8 * exp_fac(:) - rate(:,495) = 1.79e+14_r8 * exp( -8830._r8 * itemp(:) ) - rate(:,499) = 1.75e+14_r8 * exp( -9054._r8 * itemp(:) ) - rate(:,501) = 1e+07_r8 * exp( -5000._r8 * itemp(:) ) + rate(:,486) = 1.03e-14_r8 * exp_fac(:) + rate(:,862) = 1.03e-14_r8 * exp_fac(:) + rate(:,494) = 1.79e+14_r8 * exp( -8830._r8 * itemp(:) ) + rate(:,498) = 1.75e+14_r8 * exp( -9054._r8 * itemp(:) ) + rate(:,500) = 1e+07_r8 * exp( -5000._r8 * itemp(:) ) exp_fac(:) = exp( -193._r8 * itemp(:) ) - rate(:,544) = 2.3e-12_r8 * exp_fac(:) - rate(:,852) = 2.3e-12_r8 * exp_fac(:) - rate(:,548) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) - rate(:,567) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) + rate(:,543) = 2.3e-12_r8 * exp_fac(:) + rate(:,851) = 2.3e-12_r8 * exp_fac(:) + rate(:,547) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) + rate(:,566) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) exp_fac(:) = exp( 352._r8 * itemp(:) ) - rate(:,575) = 1.7e-12_r8 * exp_fac(:) - rate(:,879) = 1.7e-12_r8 * exp_fac(:) + rate(:,574) = 1.7e-12_r8 * exp_fac(:) + rate(:,878) = 1.7e-12_r8 * exp_fac(:) exp_fac(:) = exp( 490._r8 * itemp(:) ) - rate(:,585) = 1.2e-12_r8 * exp_fac(:) - rate(:,842) = 1.2e-12_r8 * exp_fac(:) + rate(:,584) = 1.2e-12_r8 * exp_fac(:) + rate(:,841) = 1.2e-12_r8 * exp_fac(:) exp_fac(:) = exp( -640._r8 * itemp(:) ) - rate(:,603) = 8.05e-16_r8 * exp_fac(:) - rate(:,845) = 8.05e-16_r8 * exp_fac(:) + rate(:,602) = 8.05e-16_r8 * exp_fac(:) + rate(:,844) = 8.05e-16_r8 * exp_fac(:) exp_fac(:) = exp( -770._r8 * itemp(:) ) - rate(:,663) = 2.8e-15_r8 * exp_fac(:) - rate(:,871) = 2.8e-15_r8 * exp_fac(:) + rate(:,662) = 2.8e-15_r8 * exp_fac(:) + rate(:,870) = 2.8e-15_r8 * exp_fac(:) exp_fac(:) = exp( 470._r8 * itemp(:) ) - rate(:,664) = 3.41e-11_r8 * exp_fac(:) - rate(:,872) = 3.41e-11_r8 * exp_fac(:) + rate(:,663) = 3.41e-11_r8 * exp_fac(:) + rate(:,871) = 3.41e-11_r8 * exp_fac(:) exp_fac(:) = exp( -520._r8 * itemp(:) ) - rate(:,683) = 2.65e-15_r8 * exp_fac(:) - rate(:,876) = 2.65e-15_r8 * exp_fac(:) + rate(:,682) = 2.65e-15_r8 * exp_fac(:) + rate(:,875) = 2.65e-15_r8 * exp_fac(:) exp_fac(:) = exp( 600._r8 * itemp(:) ) - rate(:,718) = 5.2e-12_r8 * exp_fac(:) - rate(:,737) = 5.2e-12_r8 * exp_fac(:) - rate(:,757) = 5.2e-12_r8 * exp_fac(:) - rate(:,794) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) - rate(:,795) = 9.6e-12_r8 * exp( -234._r8 * itemp(:) ) - rate(:,796) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) - rate(:,797) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,717) = 5.2e-12_r8 * exp_fac(:) + rate(:,736) = 5.2e-12_r8 * exp_fac(:) + rate(:,756) = 5.2e-12_r8 * exp_fac(:) + rate(:,793) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,794) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,795) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,796) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) rate(:,804) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) - rate(:,807) = 2.7e-11_r8 * exp( 335._r8 * itemp(:) ) - rate(:,811) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + rate(:,807) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) + rate(:,810) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) itemp(:) = 300._r8 * itemp(:) n = ncol*pver - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + ko(:) = 5.3e-32_r8 * itemp(:)**1.8_r8 + kinf(:) = 9.5e-11_r8 * itemp(:)**(-0.4_r8) call jpl( rate(:,181), m, 0.6_r8, ko, kinf, n ) ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 @@ -913,73 +913,73 @@ subroutine setrxt( rate, temp, m, ncol ) kinf(:) = 6.9e-12_r8 * itemp(:)**2.9_r8 call jpl( rate(:,263), m, 0.6_r8, ko, kinf, n ) - ko(:) = 5.9e-33_r8 * itemp(:)**1._r8 - kinf(:) = 1.1e-12_r8 * itemp(:)**(-1.3_r8) - call jpl( rate(:,309), m, 0.6_r8, ko, kinf, n ) - - ko(:) = 4.28e-33_r8 - kinf(:) = 9.3e-15_r8 * itemp(:)**(-4.42_r8) - call jpl( rate(:,310), m, 0.8_r8, ko, kinf, n ) + ko(:) = 6.1e-33_r8 * itemp(:)**1.5_r8 + kinf(:) = 9.8e-15_r8 * itemp(:)**(-4.6_r8) + call jpl( rate(:,309), m, 0.8_r8, ko, kinf, n ) ko(:) = 5.2e-30_r8 * itemp(:)**2.4_r8 kinf(:) = 2.2e-10_r8 * itemp(:)**0.7_r8 - call jpl( rate(:,321), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,320), m, 0.6_r8, ko, kinf, n ) ko(:) = 5.5e-30_r8 kinf(:) = 8.3e-13_r8 * itemp(:)**(-2._r8) - call jpl( rate(:,322), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,321), 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(:,323), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,322), 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(:,351), m, 0.48_r8, ko, kinf, n ) + call jpl( rate(:,350), m, 0.48_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(:,352), m, 0.6_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(:,351), m, 0.6_r8, ko, kinf, n ) ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 kinf(:) = 3e-11_r8 - call jpl( rate(:,373), m, 0.5_r8, ko, kinf, n ) + call jpl( rate(:,372), m, 0.5_r8, ko, kinf, n ) ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 kinf(:) = 3e-11_r8 - call jpl( rate(:,399), m, 0.5_r8, ko, kinf, n ) + call jpl( rate(:,398), 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(:,407), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,406), m, 0.6_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(:,558), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,557), m, 0.6_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(:,561), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,560), m, 0.6_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(:,564), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,563), m, 0.6_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(:,571), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,570), m, 0.6_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(:,685), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,684), m, 0.6_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(:,686), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,685), m, 0.6_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(:,687), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,686), 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(:,798), m, 0.6_r8, ko, kinf, n ) end subroutine setrxt @@ -1033,15 +1033,15 @@ subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) rate(:n,188) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) rate(:n,189) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) rate(:n,194) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) - rate(:n,198) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:n,198) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) rate(:n,199) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) - rate(:n,207) = 3.3e-12_r8 * exp( 270._r8 * itemp(:) ) + rate(:n,207) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) rate(:n,208) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) itemp(:) = 300._r8 * itemp(:) - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + 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,181) = wrk(:) diff --git a/src/chemistry/pp_trop_strat_mam4_ts2/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_mam4_ts2/mo_sim_dat.F90 index 2cd4e01f73..468b7547dc 100644 --- a/src/chemistry/pp_trop_strat_mam4_ts2/mo_sim_dat.F90 +++ b/src/chemistry/pp_trop_strat_mam4_ts2/mo_sim_dat.F90 @@ -31,10 +31,10 @@ subroutine set_sim_dat is_scalar = .false. is_vector = .true. - clscnt(:) = (/ 31, 0, 0, 286, 0 /) + clscnt(:) = (/ 2, 0, 0, 315, 0 /) - cls_rxt_cnt(:,1) = (/ 133, 61, 0, 31 /) - cls_rxt_cnt(:,4) = (/ 23, 264, 613, 286 /) + cls_rxt_cnt(:,1) = (/ 6, 0, 0, 2 /) + cls_rxt_cnt(:,4) = (/ 2, 255, 647, 315 /) solsym(:317) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','APIN ','bc_a1 ', & 'bc_a4 ','BCARY ','BENZENE ','BENZOOH ','BEPOMUC ', & @@ -233,109 +233,113 @@ subroutine set_sim_dat fix_mass(: 3) = (/ 0.00000000_r8, 31.9988000_r8, 28.0134800_r8 /) - clsmap(: 31,1) = (/ 3, 22, 34, 35, 36, 37, 38, 39, 40, 41, & - 42, 44, 45, 47, 55, 56, 62, 64, 73, 80, & - 84, 85, 86, 137, 145, 146, 158, 172, 195, 231, & - 232 /) - clsmap(:286,4) = (/ 1, 2, 4, 5, 6, 7, 8, 9, 10, 11, & - 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, & - 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, & - 33, 43, 46, 48, 49, 50, 51, 52, 53, 54, & - 57, 58, 59, 60, 61, 63, 65, 66, 67, 68, & - 69, 70, 71, 72, 74, 75, 76, 77, 78, 79, & - 81, 82, 83, 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, 138, 139, 140, 141, 142, 143, 144, & - 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, & - 157, 159, 160, 161, 162, 163, 164, 165, 166, 167, & - 168, 169, 170, 171, 173, 174, 175, 176, 177, 178, & - 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, & - 189, 190, 191, 192, 193, 194, 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, 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 /) + clsmap(: 2,1) = (/ 231, 232 /) + clsmap(:315,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, 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, & + 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 /) - permute(:286,4) = (/ 140, 141, 185, 1, 2, 163, 56, 96, 57, 106, & - 83, 97, 87, 61, 94, 171, 233, 69, 284, 122, & - 70, 90, 84, 123, 76, 91, 85, 195, 99, 50, & - 77, 278, 203, 48, 251, 240, 128, 119, 209, 104, & - 285, 55, 49, 277, 196, 223, 53, 62, 64, 132, & - 81, 3, 4, 5, 51, 167, 218, 193, 271, 215, & - 208, 52, 180, 283, 59, 149, 187, 68, 186, 270, & - 103, 168, 182, 165, 130, 131, 112, 113, 228, 234, & - 158, 198, 157, 111, 184, 202, 222, 178, 230, 206, & - 143, 243, 133, 120, 244, 139, 181, 216, 156, 242, & - 42, 172, 236, 229, 205, 116, 86, 108, 241, 238, & - 210, 148, 95, 82, 245, 6, 7, 8, 47, 9, & - 272, 281, 274, 201, 207, 10, 11, 12, 13, 280, & - 273, 88, 93, 60, 109, 54, 110, 58, 89, 14, & - 15, 121, 98, 117, 221, 191, 75, 16, 17, 18, & - 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, & - 29, 30, 31, 32, 33, 34, 35, 65, 253, 107, & - 254, 192, 124, 231, 125, 126, 78, 79, 100, 92, & - 262, 261, 190, 164, 175, 166, 134, 179, 144, 217, & - 226, 213, 227, 135, 127, 138, 63, 66, 150, 67, & - 101, 118, 188, 250, 255, 36, 247, 249, 37, 114, & - 38, 259, 256, 39, 102, 199, 173, 137, 269, 279, & - 155, 129, 80, 151, 276, 136, 214, 239, 235, 71, & - 72, 73, 74, 224, 225, 176, 183, 174, 177, 204, & - 246, 194, 200, 40, 237, 232, 41, 258, 252, 43, & - 212, 152, 220, 159, 142, 211, 260, 257, 44, 219, & - 275, 282, 105, 160, 197, 161, 169, 263, 266, 265, & - 267, 248, 264, 268, 145, 162, 189, 170, 146, 147, & - 153, 45, 154, 46, 115, 286 /) + permute(:315,4) = (/ 163, 164, 1, 215, 2, 3, 196, 74, 122, 75, & + 130, 101, 119, 108, 79, 116, 200, 274, 86, 289, & + 146, 4, 87, 111, 103, 148, 97, 112, 104, 225, & + 121, 61, 98, 58, 69, 70, 62, 71, 63, 72, & + 64, 137, 307, 154, 65, 228, 118, 59, 278, 263, & + 171, 161, 236, 129, 277, 125, 311, 73, 56, 291, & + 221, 5, 264, 245, 91, 89, 82, 153, 105, 6, & + 7, 8, 9, 66, 217, 252, 233, 290, 249, 60, & + 235, 67, 207, 88, 90, 102, 304, 77, 175, 224, & + 106, 211, 306, 127, 193, 205, 191, 152, 159, 133, & + 135, 256, 261, 189, 184, 239, 134, 216, 226, 248, & + 202, 258, 232, 169, 271, 151, 144, 270, 167, 209, & + 243, 183, 262, 51, 199, 268, 254, 231, 143, 107, & + 138, 269, 265, 237, 177, 132, 78, 100, 272, 10, & + 11, 12, 57, 13, 14, 15, 305, 314, 312, 230, & + 234, 16, 17, 18, 19, 308, 303, 20, 109, 117, & + 80, 145, 68, 136, 76, 110, 21, 22, 147, 120, & + 141, 23, 244, 214, 96, 24, 25, 26, 27, 28, & + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, & + 39, 40, 41, 42, 43, 44, 83, 285, 131, 282, & + 218, 155, 253, 156, 168, 113, 114, 123, 115, 293, & + 281, 213, 190, 201, 192, 157, 206, 170, 242, 250, & + 240, 251, 158, 149, 166, 81, 84, 176, 85, 124, & + 142, 210, 279, 286, 45, 275, 280, 46, 139, 47, & + 288, 284, 48, 126, 223, 197, 162, 302, 313, 182, & + 150, 99, 178, 309, 160, 219, 266, 267, 92, 93, & + 94, 95, 255, 257, 203, 208, 198, 204, 229, 273, & + 220, 227, 49, 260, 259, 50, 287, 283, 52, 241, & + 179, 246, 185, 165, 238, 294, 298, 53, 247, 292, & + 310, 128, 186, 222, 187, 194, 295, 301, 297, 299, & + 276, 296, 300, 172, 188, 212, 195, 173, 174, 180, & + 54, 181, 55, 140, 315 /) - diag_map(:286) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + diag_map(:315) = (/ 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, 40, 46, 52, 58, 64, 70, & - 76, 78, 84, 90, 96, 102, 103, 106, 109, 112, & - 116, 119, 122, 125, 128, 131, 137, 141, 146, 150, & - 153, 156, 161, 168, 173, 179, 187, 192, 195, 198, & - 201, 204, 207, 210, 214, 218, 222, 226, 230, 234, & - 238, 244, 250, 253, 259, 265, 270, 275, 280, 286, & - 291, 296, 300, 308, 316, 322, 328, 332, 338, 344, & - 350, 358, 364, 370, 377, 383, 386, 391, 398, 405, & - 409, 419, 426, 435, 443, 450, 455, 462, 468, 474, & - 482, 490, 498, 506, 514, 522, 526, 530, 534, 542, & - 554, 566, 573, 582, 589, 593, 604, 613, 623, 634, & - 645, 656, 663, 671, 680, 688, 696, 710, 721, 731, & - 744, 751, 762, 778, 789, 797, 802, 807, 812, 822, & - 834, 843, 859, 871, 876, 888, 897, 906, 917, 926, & - 941, 961, 975, 985, 995, 999,1010,1021,1032,1039, & - 1048,1064,1071,1083,1102,1118,1124,1132,1144,1154, & - 1161,1167,1176,1180,1197,1213,1224,1236,1243,1255, & - 1270,1285,1305,1315,1329,1336,1343,1349,1356,1360, & - 1370,1383,1396,1404,1416,1439,1463,1469,1480,1497, & - 1513,1529,1540,1550,1571,1590,1603,1611,1620,1635, & - 1645,1667,1685,1700,1729,1751,1780,1801,1829,1845, & - 1863,1896,1930,1964,1993,2034,2053,2072,2096,2119, & - 2141,2156,2179,2193,2214,2243,2271,2303,2332,2364, & - 2392,2420,2445,2467,2489,2532,2579,2627,2699,2717, & - 2730,2885,2987,3080,3105,3285,3312,3337,3429,3460, & - 3511,3752,3775,3800,3836,3862 /) + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 49, 55, 61, 67, 73, 79, 85, & + 87, 93, 99, 105, 111, 112, 115, 118, 121, 124, & + 128, 132, 136, 140, 144, 148, 151, 154, 157, 162, & + 167, 172, 177, 180, 186, 190, 195, 199, 202, 205, & + 209, 216, 221, 227, 235, 240, 243, 246, 251, 255, & + 260, 263, 266, 269, 272, 276, 280, 284, 288, 292, & + 298, 302, 308, 314, 320, 326, 329, 334, 339, 344, & + 350, 355, 360, 365, 370, 374, 382, 390, 398, 402, & + 408, 414, 420, 426, 432, 440, 446, 453, 459, 465, & + 468, 474, 481, 488, 498, 505, 509, 516, 525, 533, & + 540, 547, 553, 558, 566, 574, 582, 590, 598, 602, & + 610, 619, 632, 639, 648, 657, 666, 673, 678, 691, & + 700, 709, 716, 727, 738, 748, 758, 768, 773, 781, & + 789, 795, 803, 811, 819, 829, 846, 859, 866, 877, & + 893, 904, 912, 917, 922, 932, 944, 953, 962, 967, & + 972, 984, 993,1004,1013,1028,1042,1052,1069,1090, & + 1104,1108,1119,1130,1142,1149,1156,1164,1178,1198, & + 1208,1216,1226,1233,1246,1264,1278,1287,1296,1307, & + 1323,1334,1348,1357,1365,1390,1413,1429,1438,1452, & + 1459,1466,1474,1479,1485,1492,1496,1506,1522,1534, & + 1541,1555,1570,1598,1611,1618,1638,1657,1671,1687, & + 1700,1710,1716,1725,1740,1756,1769,1791,1815,1846, & + 1870,1894,1909,1918,1929,1959,1997,2022,2047,2078, & + 2110,2140,2180,2199,2213,2235,2259,2277,2296,2322, & + 2349,2366,2381,2411,2437,2466,2499,2530,2555,2573, & + 2597,2639,2663,2700,2728,2751,2775,2806,2853,2901, & + 2948,3023,3127,3151,3311,3331,3358,3390,3571,3822, & + 3864,3959,4052,4105,4132 /) - extfrc_lst(: 17) = (/ 'so4_a2 ','NO ','NO2 ','SO2 ','SVOC ', & - 'pom_a1 ','pom_a4 ','so4_a1 ','CO ','bc_a1 ', & - 'bc_a4 ','num_a1 ','num_a2 ','num_a4 ','OH ', & - 'N ','AOA_NH ' /) + extfrc_lst(: 14) = (/ 'num_a4 ','pom_a4 ','bc_a4 ','SVOC ','SO2 ', & + 'NO2 ','so4_a1 ','so4_a2 ','CO ','num_a1 ', & + 'num_a2 ','NO ','N ','OH ' /) - frc_from_dataset(: 17) = (/ .true., .true., .true., .true., .true., & + frc_from_dataset(: 14) = (/ .true., .true., .true., .true., .true., & .true., .true., .true., .true., .true., & - .true., .true., .true., .true., .false., & - .false., .false. /) + .true., .false., .false., .false. /) inv_lst(: 3) = (/ 'M ', 'O2 ', 'N2 ' /) @@ -527,305 +531,304 @@ subroutine set_sim_dat 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & 'CH3O2_NO ', 'CH3OH_OH ', & 'CH3OOH_OH ', 'CH4_OH ', & - 'CO_OH_M ', 'HCN_OH ', & - 'HCOOH_OH ', 'HMHP_OH ', & - 'HOCH2OO_HO2 ', 'HOCH2OO_M ', & - 'HOCH2OO_NO ', 'O1D_CH4a ', & - 'O1D_CH4b ', 'O1D_CH4c ', & - 'O1D_HCN ', 'usr_CO_OH_b ', & - 'C2H2_CL_M ', 'C2H2_OH_M ', & - '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 ', & - 'CH3CN_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 ', 'HCOCH2OOH_OH ', & - 'NO3CH2CHO_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 ', 'HYPERACET_OH ', & - 'NOA_OH ', 'PO2_HO2 ', & - 'PO2_NO ', 'POOH_OH ', & - 'RO2_CH3O2 ', 'RO2_HO2 ', & - 'RO2_NO ', 'ROOH_OH ', & - 'tag_C3H6_OH ', 'usr_CH3COCH3_OH ', & - 'BIGENE_NO3 ', 'BIGENE_OH ', & - 'DHPMPAL_OH ', 'ENEO2_NO ', & - 'ENEO2_NOb ', 'HONITR_OH ', & - 'MACRN_OH ', 'MACRO2_CH3CO3 ', & - 'MACRO2_CH3O2 ', 'MACRO2_HO2 ', & - 'MACRO2_isom ', 'MACR_O3 ', & - 'MACR_OH ', 'MACROOH_OH ', & - 'MCO3_CH3CO3 ', 'MCO3_CH3O2 ', & - 'MCO3_HO2 ', 'MCO3_MCO3 ', & - 'MCO3_NO ', 'MCO3_NO3 ', & - 'MEKO2_HO2 ', 'MEKO2_NO ', & - 'MEK_OH ', 'MEKOOH_OH ', & - 'MPAN_OH_M ', 'MVKN_OH ' /) - rxt_tag_lst( 401: 600) = (/ 'MVKO2_CH3CO3 ', 'MVKO2_CH3O2 ', & - 'MVKO2_HO2 ', 'MVK_O3 ', & - 'MVK_OH ', 'MVKOOH_OH ', & - 'tag_MCO3_NO2 ', 'usr_MPAN_M ', & - 'ALKNIT_OH ', 'ALKO2_HO2 ', & - 'ALKO2_NO ', 'ALKO2_NOb ', & - 'ALKOOH_OH ', 'BIGALK_OH ', & - 'HPALD1_OH ', 'HPALD4_OH ', & - 'HPALDB1C_OH ', 'HPALDB4C_OH ', & - 'HYDRALD_OH ', 'ICHE_OH ', & - 'IEPOX_OH ', 'IEPOXOO_HO2 ', & - 'INHEB_OH ', 'INHED_OH ', & - 'ISOPB1O2_CH3CO3 ', 'ISOPB1O2_CH3O2 ', & - 'ISOPB1O2_HO2 ', 'ISOPB1O2_I ', & - 'ISOPB1O2_M_C ', 'ISOPB1O2_M_T ', & - 'ISOPB4O2_CH3CO3 ', 'ISOPB4O2_CH3O2 ', & - 'ISOPB4O2_HO2 ', 'ISOPB4O2_I ', & - 'ISOPB4O2_M_C ', 'ISOPB4O2_M_T ', & - 'ISOPC1C_O2_B ', 'ISOPC1C_O2_D ', & - 'ISOPC1T_O2_B ', 'ISOPC1T_O2_D ', & - 'ISOPC4C_O2_B ', 'ISOPC4C_O2_D ', & - 'ISOPC4T_O2_B ', 'ISOPC4T_O2_D ', & - 'ISOPED1O2_CH3CO3 ', 'ISOPED1O2_CH3O2 ', & - 'ISOPED1O2_HO2 ', 'ISOPED1O2_M_C ', & - 'ISOPED4O2_CH3CO3 ', 'ISOPED4O2_CH3O2 ', & - 'ISOPED4O2_HO2 ', 'ISOPED4O2_M ', & - 'ISOPFDNC_OH ', 'ISOPFDN_OH ', & - 'ISOPFNC_OH ', 'ISOPFNP_OH ', & - 'ISOPHFP_OH ', 'ISOPN1DO2_HO2 ', & - 'ISOPN1DO2_I ', 'ISOPN1D_O3 ', & - 'ISOPN1D_OH ', 'ISOPN2BO2_HO2 ', & - 'ISOPN2BO2_I ', 'ISOPN2B_OH ', & - 'ISOPN3BO2_HO2 ', 'ISOPN3BO2_I ', & - 'ISOPN3B_OH ', 'ISOPN4DO2_HO2 ', & - 'ISOPN4DO2_I ', 'ISOPN4D_O3 ', & - 'ISOPN4D_OH ', 'ISOPNBNO3O2_HO2 ', & - 'ISOPNBNO3_OH ', 'ISOP_NO3 ', & - 'ISOPNO3_CH3CO3 ', 'ISOPNO3_CH3O2 ', & - 'ISOPNO3_HO2 ', 'ISOPNO3_ISOPNO3 ', & - 'ISOPNO3_NO3 ', 'ISOPNOOHBO2_HO2 ', & - 'ISOPNOOHBO2_I ', 'ISOPNOOHB_OH ', & - 'ISOPNOOHDO2_HO2 ', 'ISOPNOOHDO2_I ', & - 'ISOPNOOHD_O3 ', 'ISOPNOOHD_OH ', & - 'ISOP_O3 ', 'ISOP_OH ', & - 'ISOPOH_OH ', 'ISOPOOH_OH_abs ', & - 'ISOPOOH_OH_add ', 'ISOPZD1O2_CH3CO3 ', & - 'ISOPZD1O2_CH3O2 ', 'ISOPZD1O2_HO2 ', & - 'ISOPZD1O2_M ', 'ISOPZD4O2_CH3CO3 ', & - 'ISOPZD4O2_CH3O2 ', 'ISOPZD4O2_HO2 ', & - 'ISOPZD4O2_M_C ', 'NC4CHOO2_HO2 ', & - 'NC4CHOO2_isom ', 'NC4CHO_O3 ', & - 'NC4CHO_OH ', 'usr_IEPOXOO_NOa ', & - 'usr_IEPOXOO_NOn ', 'usr_ISOPB1O2_NOa ', & - 'usr_ISOPB1O2_NOn ', 'usr_ISOPB4O2_NOa ', & - 'usr_ISOPB4O2_NOn ', 'usr_ISOPED1O2_NOa ', & - 'usr_ISOPED1O2_NOn ', 'usr_ISOPED4O2_NOa ', & - 'usr_ISOPED4O2_NOn ', 'usr_ISOPN1DO2_NOa ', & - 'usr_ISOPN1DO2_NOn ', 'usr_ISOPN2BO2_NOa ', & - 'usr_ISOPN2BO2_NOn ', 'usr_ISOPN3BO2_NOa ', & - 'usr_ISOPN3BO2_NOn ', 'usr_ISOPN4DO2_NOa ', & - 'usr_ISOPN4DO2_NOn ', 'usr_ISOPNBNO3O2_NOa ', & - 'usr_ISOPNBNO3O2_NOn ', 'usr_ISOPNO3_NOa ', & - 'usr_ISOPNO3_NOn ', 'usr_ISOPNOOHBO2_NOa ', & - 'usr_ISOPNOOHBO2_NOn ', 'usr_ISOPNOOHDO2_NOa ', & - 'usr_ISOPNOOHDO2_NOn ', 'usr_ISOPZD1O2 ', & - 'usr_ISOPZD1O2_NOa ', 'usr_ISOPZD1O2_NOn ', & - 'usr_ISOPZD4O2 ', 'usr_ISOPZD4O2_NOa ', & - 'usr_ISOPZD4O2_NOn ', 'usr_MACRO2_NOa ', & - 'usr_MACRO2_NOn ', 'usr_MVKO2_NOa ', & - 'usr_MVKO2_NOn ', 'usr_NC4CHOO2_NOa ', & - 'usr_NC4CHOO2_NOn ', 'ACBZO2_HO2 ', & - 'ACBZO2_NO ', 'BENZENE_OH ', & - 'BENZO2_HO2 ', 'BENZO2_NO ', & - 'BENZOOH_OH ', 'BZALD_OH ', & - 'BZOO_HO2 ', 'BZOOH_OH ', & - 'BZOO_NO ', 'C6H5O2_HO2 ', & - 'C6H5O2_NO ', 'C6H5OOH_OH ', & - 'CRESOL_OH ', 'DICARBO2_HO2 ', & - 'DICARBO2_NO ', 'DICARBO2_NO2 ', & - 'MALO2_HO2 ', 'MALO2_NO ', & - 'MALO2_NO2 ', 'MDIALO2_HO2 ', & - 'MDIALO2_NO ', 'MDIALO2_NO2 ', & - 'PHENO2_HO2 ', 'PHENO2_NO ', & - 'PHENOL_OH ', 'PHENO_NO2 ', & - 'PHENO_O3 ', 'PHENOOH_OH ', & - 'tag_ACBZO2_NO2 ', 'TOLO2_HO2 ', & - 'TOLO2_NO ', 'TOLOOH_OH ', & - 'TOLUENE_OH ', 'usr_PBZNIT_M ', & - 'XYLENES_OH ', 'XYLENO2_HO2 ', & - 'XYLENO2_NO ', 'XYLENOOH_OH ', & - 'XYLOLO2_HO2 ', 'XYLOLO2_NO ', & - 'XYLOL_OH ', 'XYLOLOOH_OH ', & - 'APIN_NO3 ', 'APINNO3_APINNO3 ', & - 'APINNO3_CH3CO3 ', 'APINNO3_CH3O2 ', & - 'APINNO3_HO2 ', 'APINNO3_NO ', & - 'APINNO3_NO3 ', 'APINNO3_TERPA2CO3 ', & - 'APINNO3_TERPA3CO3 ', 'APINNO3_TERPACO3 ', & - 'APINO2_CH3CO3 ', 'APINO2_CH3O2 ', & - 'APINO2_HO2 ', 'APINO2_NO ', & - 'APINO2_NO3 ', 'APINO2_TERPA2CO3 ' /) - rxt_tag_lst( 601: 800) = (/ 'APINO2_TERPA3CO3 ', 'APINO2_TERPACO3 ', & - 'APIN_O3 ', 'APIN_OH ', & - 'BCARY_NO3 ', 'BCARYNO3_BCARYNO3 ', & - 'BCARYNO3_CH3CO3 ', 'BCARYNO3_CH3O2 ', & - 'BCARYNO3_HO2 ', 'BCARYNO3_NO ', & - 'BCARYNO3_NO3 ', 'BCARYNO3_TERPA2CO3 ', & - 'BCARYNO3_TERPA3CO3 ', 'BCARYNO3_TERPACO3 ', & - 'BCARYO2_CH3CO3 ', 'BCARYO2_CH3O2 ', & - 'BCARYO2_HO2 ', 'BCARYO2_NO ', & - 'BCARYO2_NO3 ', 'BCARYO2_TERPA2CO3 ', & - 'BCARYO2_TERPA3CO3 ', 'BCARYO2_TERPACO3 ', & - 'BCARY_O3 ', 'BCARY_OH ', & - 'BPIN_NO3 ', 'BPINNO3_BPINNO3 ', & - 'BPINNO3_CH3CO3 ', 'BPINNO3_CH3O2 ', & - 'BPINNO3_HO2 ', 'BPINNO3_NO ', & - 'BPINNO3_NO3 ', 'BPINNO3_TERPA2CO3 ', & - 'BPINNO3_TERPA3CO3 ', 'BPINNO3_TERPACO3 ', & - 'BPINO2_CH3CO3 ', 'BPINO2_CH3O2 ', & - 'BPINO2_HO2 ', 'BPINO2_NO ', & - 'BPINO2_NO3 ', 'BPINO2_TERPA2CO3 ', & - 'BPINO2_TERPA3CO3 ', 'BPINO2_TERPACO3 ', & - 'BPIN_O3 ', 'BPIN_OH ', & - 'LIMON_NO3 ', 'LIMONNO3_CH3CO3 ', & - 'LIMONNO3_CH3O2 ', 'LIMONNO3_HO2 ', & - 'LIMONNO3_LIMONNO3 ', 'LIMONNO3_NO ', & - 'LIMONNO3_NO3 ', 'LIMONNO3_TERPA2CO3 ', & - 'LIMONNO3_TERPA3CO3 ', 'LIMONNO3_TERPACO3 ', & - 'LIMONO2_CH3CO3 ', 'LIMONO2_CH3O2 ', & - 'LIMONO2_HO2 ', 'LIMONO2_NO ', & - 'LIMONO2_NO3 ', 'LIMONO2_TERPA2CO3 ', & - 'LIMONO2_TERPA3CO3 ', 'LIMONO2_TERPACO3 ', & - 'LIMON_O3 ', 'LIMON_OH ', & - 'MYRC_NO3 ', 'MYRCNO3_CH3CO3 ', & - 'MYRCNO3_CH3O2 ', 'MYRCNO3_HO2 ', & - 'MYRCNO3_MYRCNO3 ', 'MYRCNO3_NO ', & - 'MYRCNO3_NO3 ', 'MYRCNO3_TERPA2CO3 ', & - 'MYRCNO3_TERPA3CO3 ', 'MYRCNO3_TERPACO3 ', & - 'MYRCO2_CH3CO3 ', 'MYRCO2_CH3O2 ', & - 'MYRCO2_HO2 ', 'MYRCO2_NO ', & - 'MYRCO2_NO3 ', 'MYRCO2_TERPA2CO3 ', & - 'MYRCO2_TERPA3CO3 ', 'MYRCO2_TERPACO3 ', & - 'MYRC_O3 ', 'MYRC_OH ', & - 'tag_TERPA2CO3_NO2 ', 'tag_TERPA3CO3_NO2 ', & - 'tag_TERPACO3_NO2 ', 'TERP1OOHO2_HO2 ', & - 'TERP1OOHO2_NO ', 'TERP1OOH_OH ', & - 'TERP2AOOH_OH ', 'TERP2OOHO2_HO2 ', & - 'TERP2OOHO2_NO ', 'TERPA1O2_CH3CO3 ', & - 'TERPA1O2_CH3O2 ', 'TERPA1O2_HO2 ', & - 'TERPA1O2_NO ', 'TERPA1O2_NO3 ', & - 'TERPA1O2_TERPA2CO3 ', 'TERPA1O2_TERPA3CO3 ', & - 'TERPA1O2_TERPACO3 ', 'TERPA2CO3_CH3CO3 ', & - 'TERPA2CO3_CH3O2 ', 'TERPA2CO3_HO2 ', & - 'TERPA2CO3_NO ', 'TERPA2CO3_NO3 ', & - 'TERPA2CO3_TERPA2CO3 ', 'TERPA2CO3_TERPACO3 ', & - 'TERPA2_NO3 ', 'TERPA2O2_CH3CO3 ', & - 'TERPA2O2_CH3O2 ', 'TERPA2O2_HO2 ', & - 'TERPA2O2_NO ', 'TERPA2O2_NO3 ', & - 'TERPA2O2_TERPA2CO3 ', 'TERPA2O2_TERPA3CO3 ', & - 'TERPA2O2_TERPACO3 ', 'TERPA2_OH ', & - 'TERPA2PAN_OH ', 'TERPA3CO3_CH3CO3 ', & - 'TERPA3CO3_CH3O2 ', 'TERPA3CO3_HO2 ', & - 'TERPA3CO3_NO ', 'TERPA3CO3_NO3 ', & - 'TERPA3CO3_TERPA2CO3 ', 'TERPA3CO3_TERPA3CO3 ', & - 'TERPA3CO3_TERPACO3 ', 'TERPA3_NO3 ', & - 'TERPA3O2_CH3CO3 ', 'TERPA3O2_CH3O2 ', & - 'TERPA3O2_HO2 ', 'TERPA3O2_NO ', & - 'TERPA3O2_NO3 ', 'TERPA3O2_TERPA2CO3 ', & - 'TERPA3O2_TERPA3CO3 ', 'TERPA3O2_TERPACO3 ', & - 'TERPA3_OH ', 'TERPA3PAN_OH ', & - 'TERPA4O2_CH3CO3 ', 'TERPA4O2_CH3O2 ', & - 'TERPA4O2_HO2 ', 'TERPA4O2_NO ', & - 'TERPA4O2_NO3 ', 'TERPA4O2_TERPA2CO3 ', & - 'TERPA4O2_TERPA3CO3 ', 'TERPA4O2_TERPACO3 ', & - 'TERPACID2_OH ', 'TERPACID3_OH ', & - 'TERPACID_OH ', 'TERPACO3_CH3CO3 ', & - 'TERPACO3_CH3O2 ', 'TERPACO3_HO2 ', & - 'TERPACO3_NO ', 'TERPACO3_NO3 ', & - 'TERPACO3_TERPACO3 ', 'TERPA_NO3 ', & - 'TERPA_OH ', 'TERPAPAN_OH ', & - 'TERPDHDP_OH ', 'TERPF1_NO3 ', & - 'TERPF1O2_HO2 ', 'TERPF1O2_NO ', & - 'TERPF1_O3 ', 'TERPF1_OH ', & - 'TERPF2_NO3 ', 'TERPF2O2_HO2 ', & - 'TERPF2O2_NO ', 'TERPF2_O3 ', & - 'TERPF2_OH ', 'TERPFDN_OH ', & - 'TERPHFN_OH ', 'TERPK_OH ', & - 'TERPNPS1O2_HO2 ', 'TERPNPS1O2_NO ', & - 'TERPNPS1_OH ', 'TERPNPS_OH ', & - 'TERPNPT1O2_HO2 ', 'TERPNPT1O2_NO ', & - 'TERPNPT1_OH ', 'TERPNPT_OH ', & - 'TERPNS1O2_HO2 ', 'TERPNS1O2_NO ', & - 'TERPNS1_OH ', 'TERPNS_OH ', & - 'TERPNT1O2_HO2 ', 'TERPNT1O2_NO ', & - 'TERPNT1_OH ', 'TERPNT_OH ', & - 'TERPOOHL_OH ', 'TERPOOH_OH ', & - 'usr_TERPA2PAN_M ', 'usr_TERPA3PAN_M ', & - 'usr_TERPAPAN_M ', 'DMS_NO3 ', & - 'DMS_OHa ', 'OCS_O ', & - 'OCS_OH ', 'S_O2 ', & + 'HCN_OH ', 'HCOOH_OH ', & + 'HMHP_OH ', 'HOCH2OO_HO2 ', & + 'HOCH2OO_M ', 'HOCH2OO_NO ', & + 'O1D_CH4a ', 'O1D_CH4b ', & + 'O1D_CH4c ', 'O1D_HCN ', & + 'usr_CO_OH ', 'C2H2_CL_M ', & + 'C2H2_OH_M ', '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 ', 'CH3CN_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 ', & + 'HCOCH2OOH_OH ', 'NO3CH2CHO_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 ', & + 'HYPERACET_OH ', 'NOA_OH ', & + 'PO2_HO2 ', 'PO2_NO ', & + 'POOH_OH ', 'RO2_CH3O2 ', & + 'RO2_HO2 ', 'RO2_NO ', & + 'ROOH_OH ', 'tag_C3H6_OH ', & + 'usr_CH3COCH3_OH ', 'BIGENE_NO3 ', & + 'BIGENE_OH ', 'DHPMPAL_OH ', & + 'ENEO2_NO ', 'ENEO2_NOb ', & + 'HONITR_OH ', 'MACRN_OH ', & + 'MACRO2_CH3CO3 ', 'MACRO2_CH3O2 ', & + 'MACRO2_HO2 ', 'MACRO2_isom ', & + 'MACR_O3 ', 'MACR_OH ', & + 'MACROOH_OH ', 'MCO3_CH3CO3 ', & + 'MCO3_CH3O2 ', 'MCO3_HO2 ', & + 'MCO3_MCO3 ', 'MCO3_NO ', & + 'MCO3_NO3 ', 'MEKO2_HO2 ', & + 'MEKO2_NO ', 'MEK_OH ', & + 'MEKOOH_OH ', 'MPAN_OH_M ', & + 'MVKN_OH ', 'MVKO2_CH3CO3 ' /) + rxt_tag_lst( 401: 600) = (/ 'MVKO2_CH3O2 ', 'MVKO2_HO2 ', & + 'MVK_O3 ', 'MVK_OH ', & + 'MVKOOH_OH ', 'tag_MCO3_NO2 ', & + 'usr_MPAN_M ', 'ALKNIT_OH ', & + 'ALKO2_HO2 ', 'ALKO2_NO ', & + 'ALKO2_NOb ', 'ALKOOH_OH ', & + 'BIGALK_OH ', 'HPALD1_OH ', & + 'HPALD4_OH ', 'HPALDB1C_OH ', & + 'HPALDB4C_OH ', 'HYDRALD_OH ', & + 'ICHE_OH ', 'IEPOX_OH ', & + 'IEPOXOO_HO2 ', 'INHEB_OH ', & + 'INHED_OH ', 'ISOPB1O2_CH3CO3 ', & + 'ISOPB1O2_CH3O2 ', 'ISOPB1O2_HO2 ', & + 'ISOPB1O2_I ', 'ISOPB1O2_M_C ', & + 'ISOPB1O2_M_T ', 'ISOPB4O2_CH3CO3 ', & + 'ISOPB4O2_CH3O2 ', 'ISOPB4O2_HO2 ', & + 'ISOPB4O2_I ', 'ISOPB4O2_M_C ', & + 'ISOPB4O2_M_T ', 'ISOPC1C_O2_B ', & + 'ISOPC1C_O2_D ', 'ISOPC1T_O2_B ', & + 'ISOPC1T_O2_D ', 'ISOPC4C_O2_B ', & + 'ISOPC4C_O2_D ', 'ISOPC4T_O2_B ', & + 'ISOPC4T_O2_D ', 'ISOPED1O2_CH3CO3 ', & + 'ISOPED1O2_CH3O2 ', 'ISOPED1O2_HO2 ', & + 'ISOPED1O2_M_C ', 'ISOPED4O2_CH3CO3 ', & + 'ISOPED4O2_CH3O2 ', 'ISOPED4O2_HO2 ', & + 'ISOPED4O2_M ', 'ISOPFDNC_OH ', & + 'ISOPFDN_OH ', 'ISOPFNC_OH ', & + 'ISOPFNP_OH ', 'ISOPHFP_OH ', & + 'ISOPN1DO2_HO2 ', 'ISOPN1DO2_I ', & + 'ISOPN1D_O3 ', 'ISOPN1D_OH ', & + 'ISOPN2BO2_HO2 ', 'ISOPN2BO2_I ', & + 'ISOPN2B_OH ', 'ISOPN3BO2_HO2 ', & + 'ISOPN3BO2_I ', 'ISOPN3B_OH ', & + 'ISOPN4DO2_HO2 ', 'ISOPN4DO2_I ', & + 'ISOPN4D_O3 ', 'ISOPN4D_OH ', & + 'ISOPNBNO3O2_HO2 ', 'ISOPNBNO3_OH ', & + 'ISOP_NO3 ', 'ISOPNO3_CH3CO3 ', & + 'ISOPNO3_CH3O2 ', 'ISOPNO3_HO2 ', & + 'ISOPNO3_ISOPNO3 ', 'ISOPNO3_NO3 ', & + 'ISOPNOOHBO2_HO2 ', 'ISOPNOOHBO2_I ', & + 'ISOPNOOHB_OH ', 'ISOPNOOHDO2_HO2 ', & + 'ISOPNOOHDO2_I ', 'ISOPNOOHD_O3 ', & + 'ISOPNOOHD_OH ', 'ISOP_O3 ', & + 'ISOP_OH ', 'ISOPOH_OH ', & + 'ISOPOOH_OH_abs ', 'ISOPOOH_OH_add ', & + 'ISOPZD1O2_CH3CO3 ', 'ISOPZD1O2_CH3O2 ', & + 'ISOPZD1O2_HO2 ', 'ISOPZD1O2_M ', & + 'ISOPZD4O2_CH3CO3 ', 'ISOPZD4O2_CH3O2 ', & + 'ISOPZD4O2_HO2 ', 'ISOPZD4O2_M_C ', & + 'NC4CHOO2_HO2 ', 'NC4CHOO2_isom ', & + 'NC4CHO_O3 ', 'NC4CHO_OH ', & + 'usr_IEPOXOO_NOa ', 'usr_IEPOXOO_NOn ', & + 'usr_ISOPB1O2_NOa ', 'usr_ISOPB1O2_NOn ', & + 'usr_ISOPB4O2_NOa ', 'usr_ISOPB4O2_NOn ', & + 'usr_ISOPED1O2_NOa ', 'usr_ISOPED1O2_NOn ', & + 'usr_ISOPED4O2_NOa ', 'usr_ISOPED4O2_NOn ', & + 'usr_ISOPN1DO2_NOa ', 'usr_ISOPN1DO2_NOn ', & + 'usr_ISOPN2BO2_NOa ', 'usr_ISOPN2BO2_NOn ', & + 'usr_ISOPN3BO2_NOa ', 'usr_ISOPN3BO2_NOn ', & + 'usr_ISOPN4DO2_NOa ', 'usr_ISOPN4DO2_NOn ', & + 'usr_ISOPNBNO3O2_NOa ', 'usr_ISOPNBNO3O2_NOn ', & + 'usr_ISOPNO3_NOa ', 'usr_ISOPNO3_NOn ', & + 'usr_ISOPNOOHBO2_NOa ', 'usr_ISOPNOOHBO2_NOn ', & + 'usr_ISOPNOOHDO2_NOa ', 'usr_ISOPNOOHDO2_NOn ', & + 'usr_ISOPZD1O2 ', 'usr_ISOPZD1O2_NOa ', & + 'usr_ISOPZD1O2_NOn ', 'usr_ISOPZD4O2 ', & + 'usr_ISOPZD4O2_NOa ', 'usr_ISOPZD4O2_NOn ', & + 'usr_MACRO2_NOa ', 'usr_MACRO2_NOn ', & + 'usr_MVKO2_NOa ', 'usr_MVKO2_NOn ', & + 'usr_NC4CHOO2_NOa ', 'usr_NC4CHOO2_NOn ', & + 'ACBZO2_HO2 ', 'ACBZO2_NO ', & + 'BENZENE_OH ', 'BENZO2_HO2 ', & + 'BENZO2_NO ', 'BENZOOH_OH ', & + 'BZALD_OH ', 'BZOO_HO2 ', & + 'BZOOH_OH ', 'BZOO_NO ', & + 'C6H5O2_HO2 ', 'C6H5O2_NO ', & + 'C6H5OOH_OH ', 'CRESOL_OH ', & + 'DICARBO2_HO2 ', 'DICARBO2_NO ', & + 'DICARBO2_NO2 ', 'MALO2_HO2 ', & + 'MALO2_NO ', 'MALO2_NO2 ', & + 'MDIALO2_HO2 ', 'MDIALO2_NO ', & + 'MDIALO2_NO2 ', 'PHENO2_HO2 ', & + 'PHENO2_NO ', 'PHENOL_OH ', & + 'PHENO_NO2 ', 'PHENO_O3 ', & + 'PHENOOH_OH ', 'tag_ACBZO2_NO2 ', & + 'TOLO2_HO2 ', 'TOLO2_NO ', & + 'TOLOOH_OH ', 'TOLUENE_OH ', & + 'usr_PBZNIT_M ', 'XYLENES_OH ', & + 'XYLENO2_HO2 ', 'XYLENO2_NO ', & + 'XYLENOOH_OH ', 'XYLOLO2_HO2 ', & + 'XYLOLO2_NO ', 'XYLOL_OH ', & + 'XYLOLOOH_OH ', 'APIN_NO3 ', & + 'APINNO3_APINNO3 ', 'APINNO3_CH3CO3 ', & + 'APINNO3_CH3O2 ', 'APINNO3_HO2 ', & + 'APINNO3_NO ', 'APINNO3_NO3 ', & + 'APINNO3_TERPA2CO3 ', 'APINNO3_TERPA3CO3 ', & + 'APINNO3_TERPACO3 ', 'APINO2_CH3CO3 ', & + 'APINO2_CH3O2 ', 'APINO2_HO2 ', & + 'APINO2_NO ', 'APINO2_NO3 ', & + 'APINO2_TERPA2CO3 ', 'APINO2_TERPA3CO3 ' /) + rxt_tag_lst( 601: 800) = (/ 'APINO2_TERPACO3 ', 'APIN_O3 ', & + 'APIN_OH ', 'BCARY_NO3 ', & + 'BCARYNO3_BCARYNO3 ', 'BCARYNO3_CH3CO3 ', & + 'BCARYNO3_CH3O2 ', 'BCARYNO3_HO2 ', & + 'BCARYNO3_NO ', 'BCARYNO3_NO3 ', & + 'BCARYNO3_TERPA2CO3 ', 'BCARYNO3_TERPA3CO3 ', & + 'BCARYNO3_TERPACO3 ', 'BCARYO2_CH3CO3 ', & + 'BCARYO2_CH3O2 ', 'BCARYO2_HO2 ', & + 'BCARYO2_NO ', 'BCARYO2_NO3 ', & + 'BCARYO2_TERPA2CO3 ', 'BCARYO2_TERPA3CO3 ', & + 'BCARYO2_TERPACO3 ', 'BCARY_O3 ', & + 'BCARY_OH ', 'BPIN_NO3 ', & + 'BPINNO3_BPINNO3 ', 'BPINNO3_CH3CO3 ', & + 'BPINNO3_CH3O2 ', 'BPINNO3_HO2 ', & + 'BPINNO3_NO ', 'BPINNO3_NO3 ', & + 'BPINNO3_TERPA2CO3 ', 'BPINNO3_TERPA3CO3 ', & + 'BPINNO3_TERPACO3 ', 'BPINO2_CH3CO3 ', & + 'BPINO2_CH3O2 ', 'BPINO2_HO2 ', & + 'BPINO2_NO ', 'BPINO2_NO3 ', & + 'BPINO2_TERPA2CO3 ', 'BPINO2_TERPA3CO3 ', & + 'BPINO2_TERPACO3 ', 'BPIN_O3 ', & + 'BPIN_OH ', 'LIMON_NO3 ', & + 'LIMONNO3_CH3CO3 ', 'LIMONNO3_CH3O2 ', & + 'LIMONNO3_HO2 ', 'LIMONNO3_LIMONNO3 ', & + 'LIMONNO3_NO ', 'LIMONNO3_NO3 ', & + 'LIMONNO3_TERPA2CO3 ', 'LIMONNO3_TERPA3CO3 ', & + 'LIMONNO3_TERPACO3 ', 'LIMONO2_CH3CO3 ', & + 'LIMONO2_CH3O2 ', 'LIMONO2_HO2 ', & + 'LIMONO2_NO ', 'LIMONO2_NO3 ', & + 'LIMONO2_TERPA2CO3 ', 'LIMONO2_TERPA3CO3 ', & + 'LIMONO2_TERPACO3 ', 'LIMON_O3 ', & + 'LIMON_OH ', 'MYRC_NO3 ', & + 'MYRCNO3_CH3CO3 ', 'MYRCNO3_CH3O2 ', & + 'MYRCNO3_HO2 ', 'MYRCNO3_MYRCNO3 ', & + 'MYRCNO3_NO ', 'MYRCNO3_NO3 ', & + 'MYRCNO3_TERPA2CO3 ', 'MYRCNO3_TERPA3CO3 ', & + 'MYRCNO3_TERPACO3 ', 'MYRCO2_CH3CO3 ', & + 'MYRCO2_CH3O2 ', 'MYRCO2_HO2 ', & + 'MYRCO2_NO ', 'MYRCO2_NO3 ', & + 'MYRCO2_TERPA2CO3 ', 'MYRCO2_TERPA3CO3 ', & + 'MYRCO2_TERPACO3 ', 'MYRC_O3 ', & + 'MYRC_OH ', 'tag_TERPA2CO3_NO2 ', & + 'tag_TERPA3CO3_NO2 ', 'tag_TERPACO3_NO2 ', & + 'TERP1OOHO2_HO2 ', 'TERP1OOHO2_NO ', & + 'TERP1OOH_OH ', 'TERP2AOOH_OH ', & + 'TERP2OOHO2_HO2 ', 'TERP2OOHO2_NO ', & + 'TERPA1O2_CH3CO3 ', 'TERPA1O2_CH3O2 ', & + 'TERPA1O2_HO2 ', 'TERPA1O2_NO ', & + 'TERPA1O2_NO3 ', 'TERPA1O2_TERPA2CO3 ', & + 'TERPA1O2_TERPA3CO3 ', 'TERPA1O2_TERPACO3 ', & + 'TERPA2CO3_CH3CO3 ', 'TERPA2CO3_CH3O2 ', & + 'TERPA2CO3_HO2 ', 'TERPA2CO3_NO ', & + 'TERPA2CO3_NO3 ', 'TERPA2CO3_TERPA2CO3 ', & + 'TERPA2CO3_TERPACO3 ', 'TERPA2_NO3 ', & + 'TERPA2O2_CH3CO3 ', 'TERPA2O2_CH3O2 ', & + 'TERPA2O2_HO2 ', 'TERPA2O2_NO ', & + 'TERPA2O2_NO3 ', 'TERPA2O2_TERPA2CO3 ', & + 'TERPA2O2_TERPA3CO3 ', 'TERPA2O2_TERPACO3 ', & + 'TERPA2_OH ', 'TERPA2PAN_OH ', & + 'TERPA3CO3_CH3CO3 ', 'TERPA3CO3_CH3O2 ', & + 'TERPA3CO3_HO2 ', 'TERPA3CO3_NO ', & + 'TERPA3CO3_NO3 ', 'TERPA3CO3_TERPA2CO3 ', & + 'TERPA3CO3_TERPA3CO3 ', 'TERPA3CO3_TERPACO3 ', & + 'TERPA3_NO3 ', 'TERPA3O2_CH3CO3 ', & + 'TERPA3O2_CH3O2 ', 'TERPA3O2_HO2 ', & + 'TERPA3O2_NO ', 'TERPA3O2_NO3 ', & + 'TERPA3O2_TERPA2CO3 ', 'TERPA3O2_TERPA3CO3 ', & + 'TERPA3O2_TERPACO3 ', 'TERPA3_OH ', & + 'TERPA3PAN_OH ', 'TERPA4O2_CH3CO3 ', & + 'TERPA4O2_CH3O2 ', 'TERPA4O2_HO2 ', & + 'TERPA4O2_NO ', 'TERPA4O2_NO3 ', & + 'TERPA4O2_TERPA2CO3 ', 'TERPA4O2_TERPA3CO3 ', & + 'TERPA4O2_TERPACO3 ', 'TERPACID2_OH ', & + 'TERPACID3_OH ', 'TERPACID_OH ', & + 'TERPACO3_CH3CO3 ', 'TERPACO3_CH3O2 ', & + 'TERPACO3_HO2 ', 'TERPACO3_NO ', & + 'TERPACO3_NO3 ', 'TERPACO3_TERPACO3 ', & + 'TERPA_NO3 ', 'TERPA_OH ', & + 'TERPAPAN_OH ', 'TERPDHDP_OH ', & + 'TERPF1_NO3 ', 'TERPF1O2_HO2 ', & + 'TERPF1O2_NO ', 'TERPF1_O3 ', & + 'TERPF1_OH ', 'TERPF2_NO3 ', & + 'TERPF2O2_HO2 ', 'TERPF2O2_NO ', & + 'TERPF2_O3 ', 'TERPF2_OH ', & + 'TERPFDN_OH ', 'TERPHFN_OH ', & + 'TERPK_OH ', 'TERPNPS1O2_HO2 ', & + 'TERPNPS1O2_NO ', 'TERPNPS1_OH ', & + 'TERPNPS_OH ', 'TERPNPT1O2_HO2 ', & + 'TERPNPT1O2_NO ', 'TERPNPT1_OH ', & + 'TERPNPT_OH ', 'TERPNS1O2_HO2 ', & + 'TERPNS1O2_NO ', 'TERPNS1_OH ', & + 'TERPNS_OH ', 'TERPNT1O2_HO2 ', & + 'TERPNT1O2_NO ', 'TERPNT1_OH ', & + 'TERPNT_OH ', 'TERPOOHL_OH ', & + 'TERPOOH_OH ', 'usr_TERPA2PAN_M ', & + 'usr_TERPA3PAN_M ', 'usr_TERPAPAN_M ', & + 'DMS_NO3 ', 'DMS_OHa ', & + 'OCS_O ', 'OCS_OH ', & + 'S_O2 ', 'SO2_OH_M ', & 'S_O3 ', 'SO_BRO ' /) - rxt_tag_lst( 801: 905) = (/ 'SO_CLO ', 'S_OH ', & + rxt_tag_lst( 801: 904) = (/ 'SO_CLO ', 'S_OH ', & 'SO_NO2 ', 'SO_O2 ', & 'SO_O3 ', 'SO_OCLO ', & 'SO_OH ', 'usr_DMS_OH ', & - 'usr_SO2_OH ', 'usr_SO3_H2O ', & - 'NH3_OH ', 'usr_GLYOXAL_aer ', & - 'usr_HO2_aer ', 'usr_HONITR_aer ', & - 'usr_ICHE_aer ', 'usr_IEPOX_aer ', & - 'usr_INHEB_aer ', 'usr_INHED_aer ', & - 'usr_INOOHD_aer ', 'usr_ISOPFDN_aer ', & - 'usr_ISOPFDNC_aer ', 'usr_ISOPFNC_aer ', & - 'usr_ISOPFNP_aer ', 'usr_ISOPHFP_aer ', & - 'usr_ISOPN1D_aer ', 'usr_ISOPN2B_aer ', & - 'usr_ISOPN4D_aer ', 'usr_N2O5_aer ', & - 'usr_NC4CHO_aer ', 'usr_NH4_strat_tau ', & - 'usr_NO2_aer ', 'usr_NO3_aer ', & - 'usr_ONITR_aer ', 'usr_SQTN_aer ', & - 'usr_TERPDHDP_aer ', 'usr_TERPFDN_aer ', & - 'usr_TERPHFN_aer ', 'usr_TERPNPT1_aer ', & - 'usr_TERPNPT_aer ', 'usr_TERPNT1_aer ', & - 'usr_TERPNT_aer ', 'APIN_NO3_vbs ', & - 'APINO2_HO2_vbs ', 'APINO2_NO_vbs ', & - 'APIN_O3_vbs ', 'APIN_OH_vbs ', & - 'BCARY_NO3_vbs ', 'BCARYO2_HO2_vbs ', & - 'BCARYO2_NO_vbs ', 'BCARY_O3_vbs ', & - 'BCARY_OH_vbs ', 'BENZENE_OH_vbs ', & - 'BENZO2_HO2_vbs ', 'BENZO2_NO_vbs ', & - 'BPIN_NO3_vbs ', 'BPINO2_HO2_vbs ', & - 'BPINO2_NO_vbs ', 'BPIN_O3_vbs ', & - 'BPIN_OH_vbs ', 'ISOP_NO3_vbs ', & - 'ISOPO2_HO2_vbs ', 'ISOPO2_NO_vbs ', & - 'ISOP_O3_vbs ', 'ISOP_OH_vbs ', & - 'IVOCO2_HO2_vbs ', 'IVOCO2_NO_vbs ', & - 'IVOC_OH_vbs ', 'LIMON_NO3_vbs ', & - 'LIMONO2_HO2_vbs ', 'LIMONO2_NO_vbs ', & - 'LIMON_O3_vbs ', 'LIMON_OH_vbs ', & - 'MYRC_NO3_vbs ', 'MYRCO2_HO2_vbs ', & - 'MYRCO2_NO_vbs ', 'MYRC_O3_vbs ', & - 'MYRC_OH_vbs ', 'SVOC_OH ', & - 'TOLUENE_OH_vbs ', 'TOLUO2_HO2_vbs ', & - 'TOLUO2_NO_vbs ', 'XYLENES_OH_vbs ', & - 'XYLEO2_HO2_vbs ', 'XYLEO2_NO_vbs ', & - '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 ' /) + 'usr_SO3_H2O ', 'NH3_OH ', & + 'usr_GLYOXAL_aer ', 'usr_HO2_aer ', & + 'usr_HONITR_aer ', 'usr_ICHE_aer ', & + 'usr_IEPOX_aer ', 'usr_INHEB_aer ', & + 'usr_INHED_aer ', 'usr_INOOHD_aer ', & + 'usr_ISOPFDN_aer ', 'usr_ISOPFDNC_aer ', & + 'usr_ISOPFNC_aer ', 'usr_ISOPFNP_aer ', & + 'usr_ISOPHFP_aer ', 'usr_ISOPN1D_aer ', & + 'usr_ISOPN2B_aer ', 'usr_ISOPN4D_aer ', & + 'usr_N2O5_aer ', 'usr_NC4CHO_aer ', & + 'usr_NH4_strat_tau ', 'usr_NO2_aer ', & + 'usr_NO3_aer ', 'usr_ONITR_aer ', & + 'usr_SQTN_aer ', 'usr_TERPDHDP_aer ', & + 'usr_TERPFDN_aer ', 'usr_TERPHFN_aer ', & + 'usr_TERPNPT1_aer ', 'usr_TERPNPT_aer ', & + 'usr_TERPNT1_aer ', 'usr_TERPNT_aer ', & + 'APIN_NO3_vbs ', 'APINO2_HO2_vbs ', & + 'APINO2_NO_vbs ', 'APIN_O3_vbs ', & + 'APIN_OH_vbs ', 'BCARY_NO3_vbs ', & + 'BCARYO2_HO2_vbs ', 'BCARYO2_NO_vbs ', & + 'BCARY_O3_vbs ', 'BCARY_OH_vbs ', & + 'BENZENE_OH_vbs ', 'BENZO2_HO2_vbs ', & + 'BENZO2_NO_vbs ', 'BPIN_NO3_vbs ', & + 'BPINO2_HO2_vbs ', 'BPINO2_NO_vbs ', & + 'BPIN_O3_vbs ', 'BPIN_OH_vbs ', & + 'ISOP_NO3_vbs ', 'ISOPO2_HO2_vbs ', & + 'ISOPO2_NO_vbs ', 'ISOP_O3_vbs ', & + 'ISOP_OH_vbs ', 'IVOCO2_HO2_vbs ', & + 'IVOCO2_NO_vbs ', 'IVOC_OH_vbs ', & + 'LIMON_NO3_vbs ', 'LIMONO2_HO2_vbs ', & + 'LIMONO2_NO_vbs ', 'LIMON_O3_vbs ', & + 'LIMON_OH_vbs ', 'MYRC_NO3_vbs ', & + 'MYRCO2_HO2_vbs ', 'MYRCO2_NO_vbs ', & + 'MYRC_O3_vbs ', 'MYRC_OH_vbs ', & + 'SVOC_OH ', 'TOLUENE_OH_vbs ', & + 'TOLUO2_HO2_vbs ', 'TOLUO2_NO_vbs ', & + 'XYLENES_OH_vbs ', 'XYLEO2_HO2_vbs ', & + 'XYLEO2_NO_vbs ', '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, & @@ -916,7 +919,7 @@ subroutine set_sim_dat 871, 872, 873, 874, 875, 876, 877, 878, 879, 880, & 881, 882, 883, 884, 885, 886, 887, 888, 889, 890, & 891, 892, 893, 894, 895, 896, 897, 898, 899, 900, & - 901, 902, 903, 904, 905 /) + 901, 902, 903, 904 /) if( allocated( pht_alias_lst ) ) then deallocate( pht_alias_lst ) end if @@ -1122,34 +1125,33 @@ subroutine set_sim_dat 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, 3, 2, 2, 2, 1, 2, 2, 2, & - 2, 2, 2, 3, 3, 3, 2, 2, 2, 2, & - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & - 2, 2, 2, 2, 2, 2, 1, 2, 2, 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, 2, 3, 2, 2, 2, 2, & - 2, 2, 2, 2, 2, 2, 2, 1, 2, 2, & - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & - 2, 3, 2, 2, 2, 2, 2, 2, 2, 3, & - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 3, 2, 2, 2, 1, 2, 2, 2, 2, & + 2, 2, 3, 3, 3, 2, 2, 2, 2, 2, & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & - 1, 1, 1, 2, 2, 2, 1, 1, 1, 2, & + 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, & + 2, 2, 3, 3, 2, 2, 2, 2, 2, 2, & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & - 1, 2, 2, 2, 1, 2, 2, 2, 2, 2, & - 2, 1, 2, 2, 2, 1, 2, 2, 1, 2, & - 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, & - 2, 2, 2, 1, 2, 2, 1, 2, 2, 2, & - 2, 2, 2, 2, 2, 2, 2, 1, 2, 2, & - 2, 1, 2, 1, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 3, 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, 1, & + 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & + 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, & + 1, 2, 2, 2, 1, 2, 2, 1, 2, 2, & + 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, & 2, 2, 1, 2, 2, 1, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, & + 1, 2, 1, 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, 3, 2, 2, 3, 2, 2, 2, & - 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 1, 2, 2, 1, 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, 3, 2, 2, 3, 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, & @@ -1159,8 +1161,8 @@ subroutine set_sim_dat 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, 3, 3, & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 3, 3, 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, & @@ -1172,16 +1174,17 @@ subroutine set_sim_dat 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, 1, 1, 1, 1, 1, 1, & + 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, & 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & - 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, & + 1, 1, 1, 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, 2, 2, 1, 2, 1, & - 1, 1, 1, 2, 2, 2, 1, 1, 2, 2, & - 2, 1, 1, 2, 1, 1, 1, 1 /) + 2, 2, 2, 2, 2, 2, 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 diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc index 6e34de4c4d..419c47a274 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc +++ b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.doc @@ -246,238 +246,238 @@ Class List ========== Explicit -------- - ( 1) AOA_NH - ( 2) BRY - ( 3) CCL4 - ( 4) CF2CLBR - ( 5) CF3BR - ( 6) CFC11 - ( 7) CFC113 - ( 8) CFC114 - ( 9) CFC115 - ( 10) CFC12 - ( 11) CH2BR2 - ( 12) CH3BR - ( 13) CH3CCL3 - ( 14) CH3CL - ( 15) CH4 - ( 16) CHBR3 - ( 17) CLY - ( 18) CO2 - ( 19) E90 - ( 20) H2402 - ( 21) HCFC141B - ( 22) HCFC142B - ( 23) HCFC22 - ( 24) N2O - ( 25) NH_5 - ( 26) NH_50 - ( 27) O3S - ( 28) SF6 - ( 29) ST80_25 - ( 30) NHDEP - ( 31) NDEP + ( 1) NHDEP + ( 2) NDEP Implicit -------- ( 1) ALKNIT ( 2) ALKOOH - ( 3) bc_a1 - ( 4) bc_a4 - ( 5) BCARY - ( 6) BENZENE - ( 7) BENZOOH - ( 8) BEPOMUC - ( 9) BIGALD - ( 10) BIGALD1 - ( 11) BIGALD2 - ( 12) BIGALD3 - ( 13) BIGALD4 - ( 14) BIGALK - ( 15) BIGENE - ( 16) BR - ( 17) BRCL - ( 18) BRO - ( 19) BRONO2 - ( 20) BZALD - ( 21) BZOOH - ( 22) C2H2 - ( 23) C2H4 - ( 24) C2H5OH - ( 25) C2H5OOH - ( 26) C2H6 - ( 27) C3H6 - ( 28) C3H7OOH - ( 29) C3H8 - ( 30) C6H5OOH - ( 31) CH2O - ( 32) CH3CHO - ( 33) CH3CN - ( 34) CH3COCH3 - ( 35) CH3COCHO - ( 36) CH3COOH - ( 37) CH3COOOH - ( 38) CH3OH - ( 39) CH3OOH - ( 40) CL - ( 41) CL2 - ( 42) CL2O2 - ( 43) CLO - ( 44) CLONO2 - ( 45) CO - ( 46) COF2 - ( 47) COFCL - ( 48) CRESOL - ( 49) DMS - ( 50) dst_a1 - ( 51) dst_a2 - ( 52) dst_a3 - ( 53) EOOH - ( 54) F - ( 55) GLYALD - ( 56) GLYOXAL - ( 57) H - ( 58) H2 - ( 59) H2O2 - ( 60) H2SO4 - ( 61) HBR - ( 62) HCL - ( 63) HCN - ( 64) HCOOH - ( 65) HF - ( 66) HNO3 - ( 67) HO2NO2 - ( 68) HOBR - ( 69) HOCL - ( 70) HONITR - ( 71) HPALD - ( 72) HYAC - ( 73) HYDRALD - ( 74) IEPOX - ( 75) ISOP - ( 76) ISOPNITA - ( 77) ISOPNITB - ( 78) ISOPNO3 - ( 79) ISOPNOOH - ( 80) ISOPOOH - ( 81) IVOC - ( 82) MACR - ( 83) MACROOH - ( 84) MEK - ( 85) MEKOOH - ( 86) MPAN - ( 87) MTERP - ( 88) MVK - ( 89) N - ( 90) N2O5 - ( 91) NC4CH2OH - ( 92) NC4CHO - ( 93) ncl_a1 - ( 94) ncl_a2 - ( 95) ncl_a3 - ( 96) NH3 - ( 97) NH4 - ( 98) NO - ( 99) NO2 - (100) NO3 - (101) NOA - (102) NTERPOOH - (103) num_a1 - (104) num_a2 - (105) num_a3 - (106) num_a4 - (107) O - (108) O3 - (109) OCLO - (110) OCS - (111) ONITR - (112) PAN - (113) PBZNIT - (114) PHENO - (115) PHENOL - (116) PHENOOH - (117) pom_a1 - (118) pom_a4 - (119) POOH - (120) ROOH - (121) S - (122) SO - (123) SO2 - (124) SO3 - (125) so4_a1 - (126) so4_a2 - (127) so4_a3 - (128) soa1_a1 - (129) soa1_a2 - (130) soa2_a1 - (131) soa2_a2 - (132) soa3_a1 - (133) soa3_a2 - (134) soa4_a1 - (135) soa4_a2 - (136) soa5_a1 - (137) soa5_a2 - (138) SOAG0 - (139) SOAG1 - (140) SOAG2 - (141) SOAG3 - (142) SOAG4 - (143) SVOC - (144) TEPOMUC - (145) TERP2OOH - (146) TERPNIT - (147) TERPOOH - (148) TERPROD1 - (149) TERPROD2 - (150) TOLOOH - (151) TOLUENE - (152) XOOH - (153) XYLENES - (154) XYLENOOH - (155) XYLOL - (156) XYLOLOOH - (157) ACBZO2 - (158) ALKO2 - (159) BCARYO2VBS - (160) BENZO2 - (161) BENZO2VBS - (162) BZOO - (163) C2H5O2 - (164) C3H7O2 - (165) C6H5O2 - (166) CH3CO3 - (167) CH3O2 - (168) DICARBO2 - (169) ENEO2 - (170) EO - (171) EO2 - (172) HO2 - (173) HOCH2OO - (174) ISOPAO2 - (175) ISOPBO2 - (176) ISOPO2VBS - (177) IVOCO2VBS - (178) MACRO2 - (179) MALO2 - (180) MCO3 - (181) MDIALO2 - (182) MEKO2 - (183) MTERPO2VBS - (184) NTERPO2 - (185) O1D - (186) OH - (187) PHENO2 - (188) PO2 - (189) RO2 - (190) TERP2O2 - (191) TERPO2 - (192) TOLO2 - (193) TOLUO2VBS - (194) XO2 - (195) XYLENO2 - (196) XYLEO2VBS - (197) XYLOLO2 - (198) H2O + ( 3) AOA_NH + ( 4) bc_a1 + ( 5) bc_a4 + ( 6) BCARY + ( 7) BENZENE + ( 8) BENZOOH + ( 9) BEPOMUC + ( 10) BIGALD + ( 11) BIGALD1 + ( 12) BIGALD2 + ( 13) BIGALD3 + ( 14) BIGALD4 + ( 15) BIGALK + ( 16) BIGENE + ( 17) BR + ( 18) BRCL + ( 19) BRO + ( 20) BRONO2 + ( 21) BRY + ( 22) BZALD + ( 23) BZOOH + ( 24) C2H2 + ( 25) C2H4 + ( 26) C2H5OH + ( 27) C2H5OOH + ( 28) C2H6 + ( 29) C3H6 + ( 30) C3H7OOH + ( 31) C3H8 + ( 32) C6H5OOH + ( 33) CCL4 + ( 34) CF2CLBR + ( 35) CF3BR + ( 36) CFC11 + ( 37) CFC113 + ( 38) CFC114 + ( 39) CFC115 + ( 40) CFC12 + ( 41) CH2BR2 + ( 42) CH2O + ( 43) CH3BR + ( 44) CH3CCL3 + ( 45) CH3CHO + ( 46) CH3CL + ( 47) CH3CN + ( 48) CH3COCH3 + ( 49) CH3COCHO + ( 50) CH3COOH + ( 51) CH3COOOH + ( 52) CH3OH + ( 53) CH3OOH + ( 54) CH4 + ( 55) CHBR3 + ( 56) CL + ( 57) CL2 + ( 58) CL2O2 + ( 59) CLO + ( 60) CLONO2 + ( 61) CLY + ( 62) CO + ( 63) CO2 + ( 64) COF2 + ( 65) COFCL + ( 66) CRESOL + ( 67) DMS + ( 68) dst_a1 + ( 69) dst_a2 + ( 70) dst_a3 + ( 71) E90 + ( 72) EOOH + ( 73) F + ( 74) GLYALD + ( 75) GLYOXAL + ( 76) H + ( 77) H2 + ( 78) H2402 + ( 79) H2O2 + ( 80) H2SO4 + ( 81) HBR + ( 82) HCFC141B + ( 83) HCFC142B + ( 84) HCFC22 + ( 85) HCL + ( 86) HCN + ( 87) HCOOH + ( 88) HF + ( 89) HNO3 + ( 90) HO2NO2 + ( 91) HOBR + ( 92) HOCL + ( 93) HONITR + ( 94) HPALD + ( 95) HYAC + ( 96) HYDRALD + ( 97) IEPOX + ( 98) ISOP + ( 99) ISOPNITA + (100) ISOPNITB + (101) ISOPNO3 + (102) ISOPNOOH + (103) ISOPOOH + (104) IVOC + (105) MACR + (106) MACROOH + (107) MEK + (108) MEKOOH + (109) MPAN + (110) MTERP + (111) MVK + (112) N + (113) N2O + (114) N2O5 + (115) NC4CH2OH + (116) NC4CHO + (117) ncl_a1 + (118) ncl_a2 + (119) ncl_a3 + (120) NH3 + (121) NH4 + (122) NH_5 + (123) NH_50 + (124) NO + (125) NO2 + (126) NO3 + (127) NOA + (128) NTERPOOH + (129) num_a1 + (130) num_a2 + (131) num_a3 + (132) num_a4 + (133) O + (134) O3 + (135) O3S + (136) OCLO + (137) OCS + (138) ONITR + (139) PAN + (140) PBZNIT + (141) PHENO + (142) PHENOL + (143) PHENOOH + (144) pom_a1 + (145) pom_a4 + (146) POOH + (147) ROOH + (148) S + (149) SF6 + (150) SO + (151) SO2 + (152) SO3 + (153) so4_a1 + (154) so4_a2 + (155) so4_a3 + (156) soa1_a1 + (157) soa1_a2 + (158) soa2_a1 + (159) soa2_a2 + (160) soa3_a1 + (161) soa3_a2 + (162) soa4_a1 + (163) soa4_a2 + (164) soa5_a1 + (165) soa5_a2 + (166) SOAG0 + (167) SOAG1 + (168) SOAG2 + (169) SOAG3 + (170) SOAG4 + (171) ST80_25 + (172) SVOC + (173) TEPOMUC + (174) TERP2OOH + (175) TERPNIT + (176) TERPOOH + (177) TERPROD1 + (178) TERPROD2 + (179) TOLOOH + (180) TOLUENE + (181) XOOH + (182) XYLENES + (183) XYLENOOH + (184) XYLOL + (185) XYLOLOOH + (186) ACBZO2 + (187) ALKO2 + (188) BCARYO2VBS + (189) BENZO2 + (190) BENZO2VBS + (191) BZOO + (192) C2H5O2 + (193) C3H7O2 + (194) C6H5O2 + (195) CH3CO3 + (196) CH3O2 + (197) DICARBO2 + (198) ENEO2 + (199) EO + (200) EO2 + (201) HO2 + (202) HOCH2OO + (203) ISOPAO2 + (204) ISOPBO2 + (205) ISOPO2VBS + (206) IVOCO2VBS + (207) MACRO2 + (208) MALO2 + (209) MCO3 + (210) MDIALO2 + (211) MEKO2 + (212) MTERPO2VBS + (213) NTERPO2 + (214) O1D + (215) OH + (216) PHENO2 + (217) PO2 + (218) RO2 + (219) TERP2O2 + (220) TERPO2 + (221) TOLO2 + (222) TOLUO2VBS + (223) XO2 + (224) XYLENO2 + (225) XYLEO2VBS + (226) XYLOLO2 + (227) H2O Photolysis jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) @@ -514,16 +514,16 @@ Class List jc2h5ooh ( 29) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 29) jc3h7ooh ( 30) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 30) jc6h5ooh ( 31) C6H5OOH + hv -> PHENO + OH rate = ** User defined ** ( 31) - jch2o_a ( 32) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 32) - jch2o_b ( 33) CH2O + hv -> CO + H2 rate = ** User defined ** ( 33) + jch2o_b ( 32) CH2O + hv -> CO + H2 rate = ** User defined ** ( 32) + jch2o_a ( 33) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 33) jch3cho ( 34) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 34) jacet ( 35) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 35) jmgly ( 36) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 36) jch3co3h ( 37) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 37) jch3ooh ( 38) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 38) - jch4_a ( 39) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 39) - jch4_b ( 40) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 40) + jch4_b ( 39) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 39) + 0.44*CO2 + 0.38*CO + 0.05*H2O + jch4_a ( 40) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 40) jco2 ( 41) CO2 + hv -> CO + O rate = ** User defined ** ( 41) jeooh ( 42) EOOH + hv -> EO + OH rate = ** User defined ** ( 42) jglyald ( 43) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 43) @@ -534,7 +534,7 @@ Class List jhpald ( 46) HPALD + hv -> BIGALD3 + OH + HO2 rate = ** User defined ** ( 46) jhyac ( 47) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 47) jisopnooh ( 48) ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH rate = ** User defined ** ( 48) - jisopooh ( 49) ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 rate = ** User defined ** ( 49) + jisopooh ( 49) ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + CH2O + HO2 rate = ** User defined ** ( 49) jmacr_a ( 50) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 50) jmacr_b ( 51) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 51) jmek ( 52) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 52) @@ -616,172 +616,170 @@ Class List jsoa5_a2 (123) soa5_a2 + hv -> (No products) rate = ** User defined ** (123) Reactions - O1D_H2 ( 1) O1D + H2 -> H + OH rate = 1.20E-10 (124) - O1D_H2O ( 2) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (125) - O1D_N2 ( 3) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (126) - O1D_O2ab ( 4) O1D + O2 -> O + O2 rate = 3.30E-11*exp( 55./t) (127) - O1D_O3 ( 5) O1D + O3 -> O2 + O2 rate = 1.20E-10 (128) - O_O3 ( 6) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (129) - usr_O_O ( 7) O + O + M -> O2 + M rate = ** User defined ** (130) - usr_O_O2 ( 8) O + O2 + M -> O3 + M rate = ** User defined ** (131) - H2_O ( 9) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (132) - H2O2_O ( 10) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (133) - H_HO2 ( 11) H + HO2 -> H2 + O2 rate = 6.90E-12 (134) - H_HO2a ( 12) H + HO2 -> 2*OH rate = 7.20E-11 (135) - H_HO2b ( 13) H + HO2 -> H2O + O rate = 1.60E-12 (136) - H_O2 ( 14) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (137) - ki=7.50E-11*(300/t)**-0.20 + E90_tau ( 1) E90 -> (No products) rate = 1.29E-07 (124) + O1D_H2 ( 2) O1D + H2 -> H + OH rate = 1.20E-10 (125) + O1D_H2O ( 3) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (126) + O1D_N2 ( 4) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (127) + O1D_O2ab ( 5) O1D + O2 -> O + O2 rate = 3.30E-11*exp( 55./t) (128) + O1D_O3 ( 6) O1D + O3 -> O2 + O2 rate = 1.20E-10 (129) + O_O3 ( 7) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (130) + usr_O_O ( 8) O + O + M -> O2 + M rate = ** User defined ** (131) + usr_O_O2 ( 9) O + O2 + M -> O3 + M rate = ** User defined ** (132) + H2_O ( 10) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (133) + H2O2_O ( 11) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (134) + H_HO2 ( 12) H + HO2 -> H2 + O2 rate = 6.90E-12 (135) + H_HO2a ( 13) H + HO2 -> 2*OH rate = 7.20E-11 (136) + H_HO2b ( 14) H + HO2 -> H2O + O rate = 1.60E-12 (137) + H_O2 ( 15) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (138) + ki=9.50E-11*(300/t)**-0.40 f=0.60 - HO2_O ( 15) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (138) - HO2_O3 ( 16) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (139) - H_O3 ( 17) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (140) - OH_H2 ( 18) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (141) - OH_H2O2 ( 19) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (142) - OH_HO2 ( 20) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (143) - OH_O ( 21) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (144) - OH_O3 ( 22) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (145) - OH_OH ( 23) OH + OH -> H2O + O rate = 1.80E-12 (146) - OH_OH_M ( 24) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (147) + HO2_O ( 16) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (139) + HO2_O3 ( 17) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (140) + H_O3 ( 18) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (141) + OH_H2 ( 19) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (142) + OH_H2O2 ( 20) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (143) + OH_HO2 ( 21) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (144) + OH_O ( 22) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (145) + OH_O3 ( 23) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (146) + OH_OH ( 24) OH + OH -> H2O + O rate = 1.80E-12 (147) + OH_OH_M ( 25) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (148) ki=2.60E-11 f=0.60 - usr_HO2_HO2 ( 25) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (148) - HO2NO2_OH ( 26) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (149) - N_NO ( 27) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (150) - N_NO2a ( 28) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (151) - N_NO2b ( 29) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (152) - N_NO2c ( 30) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (153) - N_O2 ( 31) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (154) - NO2_O ( 32) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (155) - NO2_O3 ( 33) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (156) - NO2_O_M ( 34) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (157) + usr_HO2_HO2 ( 26) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (149) + HO2NO2_OH ( 27) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (150) + N_NO ( 28) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (151) + N_NO2a ( 29) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (152) + N_NO2b ( 30) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (153) + N_NO2c ( 31) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (154) + N_O2 ( 32) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (155) + NO2_O ( 33) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (156) + NO2_O3 ( 34) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (157) + NO2_O_M ( 35) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (158) ki=2.20E-11*(300/t)**0.70 f=0.60 - NO3_HO2 ( 35) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (158) - NO3_NO ( 36) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (159) - NO3_O ( 37) NO3 + O -> NO2 + O2 rate = 1.00E-11 (160) - NO3_OH ( 38) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (161) - N_OH ( 39) N + OH -> NO + H rate = 5.00E-11 (162) - NO_HO2 ( 40) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (163) - NO_O3 ( 41) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (164) - NO_O_M ( 42) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (165) + NO3_HO2 ( 36) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (159) + NO3_NO ( 37) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (160) + NO3_O ( 38) NO3 + O -> NO2 + O2 rate = 1.30E-11 (161) + NO3_OH ( 39) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (162) + N_OH ( 40) N + OH -> NO + H rate = 5.00E-11 (163) + NO_HO2 ( 41) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (164) + NO_O3 ( 42) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (165) + NO_O_M ( 43) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (166) ki=3.00E-11 f=0.60 - O1D_N2Oa ( 43) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (166) - O1D_N2Ob ( 44) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (167) - tag_NO2_HO2 ( 45) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (168) + O1D_N2Oa ( 44) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (167) + O1D_N2Ob ( 45) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (168) + tag_NO2_HO2 ( 46) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (169) ki=4.00E-12*(300/t)**0.30 f=0.60 - tag_NO2_NO3 ( 46) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (169) + tag_NO2_NO3 ( 47) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (170) ki=1.60E-12*(300/t)**-0.10 f=0.60 - tag_NO2_OH ( 47) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (170) + tag_NO2_OH ( 48) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (171) ki=2.80E-11 f=0.60 - usr_HNO3_OH ( 48) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (171) - usr_HO2NO2_M ( 49) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (172) - usr_N2O5_M ( 50) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (173) - CL_CH2O ( 51) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (174) - CL_CH4 ( 52) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (175) - CL_H2 ( 53) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (176) - CL_H2O2 ( 54) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (177) - CL_HO2a ( 55) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (178) - CL_HO2b ( 56) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (179) - CL_O3 ( 57) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (180) - CLO_CH3O2 ( 58) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (181) - CLO_CLOa ( 59) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (182) - CLO_CLOb ( 60) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (183) - CLO_CLOc ( 61) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (184) - CLO_HO2 ( 62) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (185) - CLO_NO ( 63) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (186) - CLONO2_CL ( 64) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (187) - CLO_NO2_M ( 65) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (188) + usr_HNO3_OH ( 49) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (172) + usr_HO2NO2_M ( 50) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (173) + usr_N2O5_M ( 51) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (174) + CL_CH2O ( 52) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (175) + CL_CH4 ( 53) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (176) + CL_H2 ( 54) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (177) + CL_H2O2 ( 55) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (178) + CL_HO2a ( 56) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (179) + CL_HO2b ( 57) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (180) + CL_O3 ( 58) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (181) + CLO_CH3O2 ( 59) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (182) + CLO_CLOa ( 60) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (183) + CLO_CLOb ( 61) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (184) + CLO_CLOc ( 62) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (185) + CLO_HO2 ( 63) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (186) + CLO_NO ( 64) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (187) + CLONO2_CL ( 65) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (188) + CLO_NO2_M ( 66) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (189) ki=1.50E-11*(300/t)**1.90 f=0.60 - CLONO2_O ( 66) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (189) - CLONO2_OH ( 67) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (190) - CLO_O ( 68) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (191) - CLO_OHa ( 69) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (192) - CLO_OHb ( 70) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (193) - HCL_O ( 71) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (194) - HCL_OH ( 72) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (195) - HOCL_CL ( 73) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (196) - HOCL_O ( 74) HOCL + O -> CLO + OH rate = 1.70E-13 (197) - HOCL_OH ( 75) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (198) - O1D_CCL4 ( 76) O1D + CCL4 -> 4*CL rate = 2.61E-10 (199) - O1D_CF2CLBR ( 77) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (200) - O1D_CFC11 ( 78) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (201) - O1D_CFC113 ( 79) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (202) - O1D_CFC114 ( 80) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (203) - O1D_CFC115 ( 81) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (204) - O1D_CFC12 ( 82) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (205) - O1D_HCLa ( 83) O1D + HCL -> CL + OH rate = 9.90E-11 (206) - O1D_HCLb ( 84) O1D + HCL -> CLO + H rate = 3.30E-12 (207) - tag_CLO_CLO_M ( 85) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (208) + CLONO2_O ( 67) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (190) + CLONO2_OH ( 68) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (191) + CLO_O ( 69) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (192) + CLO_OHa ( 70) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (193) + CLO_OHb ( 71) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (194) + HCL_O ( 72) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (195) + HCL_OH ( 73) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (196) + HOCL_CL ( 74) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (197) + HOCL_O ( 75) HOCL + O -> CLO + OH rate = 1.70E-13 (198) + HOCL_OH ( 76) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (199) + O1D_CCL4 ( 77) O1D + CCL4 -> 4*CL rate = 2.61E-10 (200) + O1D_CF2CLBR ( 78) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (201) + O1D_CFC11 ( 79) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (202) + O1D_CFC113 ( 80) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (203) + O1D_CFC114 ( 81) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (204) + O1D_CFC115 ( 82) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (205) + O1D_CFC12 ( 83) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (206) + O1D_HCLa ( 84) O1D + HCL -> CL + OH rate = 9.90E-11 (207) + O1D_HCLb ( 85) O1D + HCL -> CLO + H rate = 3.30E-12 (208) + tag_CLO_CLO_M ( 86) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (209) ki=3.70E-12*(300/t)**1.60 f=0.60 - usr_CL2O2_M ( 86) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (209) - BR_CH2O ( 87) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (210) - BR_HO2 ( 88) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (211) - BR_O3 ( 89) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (212) - BRO_BRO ( 90) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (213) - BRO_CLOa ( 91) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (214) - BRO_CLOb ( 92) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (215) - BRO_CLOc ( 93) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (216) - BRO_HO2 ( 94) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (217) - BRO_NO ( 95) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (218) - BRO_NO2_M ( 96) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (219) + usr_CL2O2_M ( 87) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (210) + BR_CH2O ( 88) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (211) + BR_HO2 ( 89) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (212) + BR_O3 ( 90) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (213) + BRO_BRO ( 91) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (214) + BRO_CLOa ( 92) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (215) + BRO_CLOb ( 93) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (216) + BRO_CLOc ( 94) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (217) + BRO_HO2 ( 95) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (218) + BRO_NO ( 96) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (219) + BRO_NO2_M ( 97) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (220) ki=6.90E-12*(300/t)**2.90 f=0.60 - BRONO2_O ( 97) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (220) - BRO_O ( 98) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (221) - BRO_OH ( 99) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (222) - HBR_O (100) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (223) - HBR_OH (101) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (224) - HOBR_O (102) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (225) - O1D_CF3BR (103) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (226) - O1D_CHBR3 (104) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (227) - O1D_H2402 (105) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (228) - O1D_HBRa (106) O1D + HBR -> BR + OH rate = 9.00E-11 (229) - O1D_HBRb (107) O1D + HBR -> BRO + H rate = 3.00E-11 (230) - F_CH4 (108) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (231) - F_H2 (109) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (232) - F_H2O (110) F + H2O -> HF + OH rate = 1.40E-11 (233) - F_HNO3 (111) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (234) - O1D_COF2 (112) O1D + COF2 -> 2*F rate = 2.14E-11 (235) - O1D_COFCL (113) O1D + COFCL -> F + CL rate = 1.90E-10 (236) - CH2BR2_CL (114) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (237) - CH2BR2_OH (115) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (238) - CH3BR_CL (116) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (239) - CH3BR_OH (117) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (240) - CH3CCL3_OH (118) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (241) - CH3CL_CL (119) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (242) - CH3CL_OH (120) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (243) - CHBR3_CL (121) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (244) - CHBR3_OH (122) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (245) - HCFC141B_OH (123) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (246) - HCFC142B_OH (124) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (247) - HCFC22_OH (125) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (248) - O1D_CH2BR2 (126) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (249) - O1D_CH3BR (127) O1D + CH3BR -> BR rate = 1.80E-10 (250) - O1D_HCFC141B (128) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (251) - O1D_HCFC142B (129) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (252) - O1D_HCFC22 (130) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (253) - CH2O_HO2 (131) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) (254) - CH2O_NO3 (132) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (255) - CH2O_O (133) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (256) - CH2O_OH (134) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (257) - CH3O2_CH3O2a (135) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (258) - CH3O2_CH3O2b (136) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (259) - CH3O2_HO2 (137) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (260) - CH3O2_NO (138) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (261) - CH3OH_OH (139) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (262) - CH3OOH_OH (140) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (263) - CH4_OH (141) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (264) - CO_OH_M (142) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.00 (265) - ki=1.10E-12*(300/t)**-1.30 - f=0.60 - HCN_OH (143) HCN + OH + M -> HO2 + M troe : ko=4.28E-33 (266) - ki=9.30E-15*(300/t)**-4.42 + BRONO2_O ( 98) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (221) + BRO_O ( 99) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (222) + BRO_OH (100) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (223) + HBR_O (101) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (224) + HBR_OH (102) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (225) + HOBR_O (103) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (226) + O1D_CF3BR (104) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (227) + O1D_CHBR3 (105) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (228) + O1D_H2402 (106) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (229) + O1D_HBRa (107) O1D + HBR -> BR + OH rate = 9.00E-11 (230) + O1D_HBRb (108) O1D + HBR -> BRO + H rate = 3.00E-11 (231) + F_CH4 (109) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (232) + F_H2 (110) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (233) + F_H2O (111) F + H2O -> HF + OH rate = 1.40E-11 (234) + F_HNO3 (112) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (235) + O1D_COF2 (113) O1D + COF2 -> 2*F rate = 2.14E-11 (236) + O1D_COFCL (114) O1D + COFCL -> F + CL rate = 1.90E-10 (237) + CH2BR2_CL (115) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (238) + CH2BR2_OH (116) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (239) + CH3BR_CL (117) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (240) + CH3BR_OH (118) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (241) + CH3CCL3_OH (119) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (242) + CH3CL_CL (120) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (243) + CH3CL_OH (121) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (244) + CHBR3_CL (122) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (245) + CHBR3_OH (123) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (246) + HCFC141B_OH (124) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (247) + HCFC142B_OH (125) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (248) + HCFC22_OH (126) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (249) + O1D_CH2BR2 (127) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (250) + O1D_CH3BR (128) O1D + CH3BR -> BR rate = 1.80E-10 (251) + O1D_HCFC141B (129) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (252) + O1D_HCFC142B (130) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (253) + O1D_HCFC22 (131) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (254) + CH2O_HO2 (132) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) (255) + CH2O_NO3 (133) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (256) + CH2O_O (134) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (257) + CH2O_OH (135) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (258) + CH3O2_CH3O2a (136) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (259) + CH3O2_CH3O2b (137) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (260) + CH3O2_HO2 (138) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (261) + CH3O2_NO (139) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (262) + CH3OH_OH (140) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (263) + CH3OOH_OH (141) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (264) + CH4_OH (142) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (265) + HCN_OH (143) HCN + OH + M -> HO2 + M troe : ko=6.10E-33*(300/t)**1.50 (266) + ki=9.80E-15*(300/t)**-4.60 f=0.80 HCOOH_OH (144) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (267) HOCH2OO_HO2 (145) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (268) @@ -791,7 +789,7 @@ Class List O1D_CH4b (149) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (272) O1D_CH4c (150) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (273) O1D_HCN (151) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (274) - usr_CO_OH_b (152) CO + OH -> CO2 + H rate = ** User defined ** (275) + usr_CO_OH (152) CO + OH -> CO2 + HO2 rate = ** User defined ** (275) C2H2_CL_M (153) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (276) ki=2.20E-10*(300/t)**0.70 f=0.60 @@ -820,7 +818,7 @@ Class List CH3CO3_HO2 (170) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (293) + 0.45*CH3O2 CH3CO3_NO (171) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (294) - CH3COOH_OH (172) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 7.00E-13 (295) + CH3COOH_OH (172) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 3.15E-14*exp( 920./t) (295) CH3COOOH_OH (173) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (296) EO2_HO2 (174) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (297) EO2_NO (175) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (298) @@ -832,8 +830,8 @@ Class List tag_C2H4_OH (181) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (304) ki=9.00E-12*(300/t)**0.85 f=0.48 - tag_CH3CO3_NO2 (182) CH3CO3 + NO2 + M -> PAN + M troe : ko=9.70E-29*(300/t)**5.60 (305) - ki=9.30E-12*(300/t)**1.50 + tag_CH3CO3_NO2 (182) CH3CO3 + NO2 + M -> PAN + M troe : ko=7.30E-29*(300/t)**4.10 (305) + ki=9.50E-12*(300/t)**1.60 f=0.60 usr_PAN_M (183) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (306) C3H6_NO3 (184) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (307) @@ -844,7 +842,7 @@ Class List C3H7O2_HO2 (187) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (310) C3H7O2_NO (188) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (311) C3H7OOH_OH (189) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (312) - C3H8_OH (190) C3H8 + OH -> C3H7O2 + H2O rate = 8.70E-12*exp( -615./t) (313) + C3H8_OH (190) C3H8 + OH -> C3H7O2 + H2O rate = 9.19E-12*exp( -630./t) (313) CH3COCHO_NO3 (191) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (314) CH3COCHO_OH (192) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (315) HYAC_OH (193) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (316) @@ -899,7 +897,9 @@ Class List MVK_O3 (229) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (352) + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH MVK_OH (230) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (353) - usr_MCO3_NO2 (231) MCO3 + NO2 + M -> MPAN + M rate = ** User defined ** (354) + tag_MCO3_NO2 (231) MCO3 + NO2 + M -> MPAN + M troe : ko=9.70E-29*(300/t)**5.60 (354) + ki=9.30E-12*(300/t)**1.50 + f=0.60 usr_MPAN_M (232) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (355) ALKNIT_OH (233) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (356) ALKO2_HO2 (234) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (357) @@ -1053,25 +1053,27 @@ Class List TERPROD2_OH (338) TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 rate = 3.40E-11 (461) + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO DMS_NO3 (339) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (462) - DMS_OHa (340) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (463) + DMS_OHa (340) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (463) OCS_O (341) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (464) OCS_OH (342) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (465) S_O2 (343) S + O2 -> SO + O rate = 2.30E-12 (466) - S_O3 (344) S + O3 -> SO + O2 rate = 1.20E-11 (467) - SO_BRO (345) SO + BRO -> SO2 + BR rate = 5.70E-11 (468) - SO_CLO (346) SO + CLO -> SO2 + CL rate = 2.80E-11 (469) - S_OH (347) S + OH -> SO + H rate = 6.60E-11 (470) - SO_NO2 (348) SO + NO2 -> SO2 + NO rate = 1.40E-11 (471) - SO_O2 (349) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (472) - SO_O3 (350) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (473) - SO_OCLO (351) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (474) - SO_OH (352) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (475) - usr_DMS_OH (353) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (476) - usr_SO2_OH (354) SO2 + OH -> SO3 + HO2 rate = ** User defined ** (477) + SO2_OH_M (344) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (467) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + S_O3 (345) S + O3 -> SO + O2 rate = 1.20E-11 (468) + SO_BRO (346) SO + BRO -> SO2 + BR rate = 5.70E-11 (469) + SO_CLO (347) SO + CLO -> SO2 + CL rate = 2.80E-11 (470) + S_OH (348) S + OH -> SO + H rate = 6.60E-11 (471) + SO_NO2 (349) SO + NO2 -> SO2 + NO rate = 1.40E-11 (472) + SO_O2 (350) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (473) + SO_O3 (351) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (474) + SO_OCLO (352) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (475) + SO_OH (353) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (476) + usr_DMS_OH (354) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (477) usr_SO3_H2O (355) SO3 + H2O -> H2SO4 rate = ** User defined ** (478) NH3_OH (356) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (479) usr_GLYOXAL_aer (357) GLYOXAL -> SOAG0 rate = ** User defined ** (480) - usr_HO2_aer (358) HO2 -> 0.5*H2O2 rate = ** User defined ** (481) + usr_HO2_aer (358) HO2 -> H2O rate = ** User defined ** (481) usr_HONITR_aer (359) HONITR -> HNO3 rate = ** User defined ** (482) usr_ISOPNITA_aer (360) ISOPNITA -> HNO3 rate = ** User defined ** (483) usr_ISOPNITB_aer (361) ISOPNITB -> HNO3 rate = ** User defined ** (484) @@ -1146,28 +1148,25 @@ Class List het7 (413) N2O5 -> 2*HNO3 rate = ** User defined ** (536) het8 (414) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (537) het9 (415) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (538) - E90_tau (416) E90 -> {sink} rate = 1.29E-07 (539) - NH_50_tau (417) NH_50 -> (No products) rate = 2.31E-07 (540) - NH_5_tau (418) NH_5 -> (No products) rate = 2.31E-06 (541) - ST80_25_tau (419) ST80_25 -> (No products) rate = 4.63E-07 (542) + NH_50_tau (416) NH_50 -> (No products) rate = 2.31E-07 (539) + NH_5_tau (417) NH_5 -> (No products) rate = 2.31E-06 (540) + ST80_25_tau (418) ST80_25 -> (No products) rate = 4.63E-07 (541) Extraneous prod/loss species - ( 1) so4_a1 (dataset) - ( 2) bc_a4 (dataset) - ( 3) SVOC (dataset) - ( 4) bc_a1 (dataset) - ( 5) CO (dataset) - ( 6) NO (dataset) + ( 1) num_a1 (dataset) + ( 2) num_a2 (dataset) + ( 3) so4_a1 (dataset) + ( 4) so4_a2 (dataset) + ( 5) num_a4 (dataset) + ( 6) SO2 (dataset) ( 7) NO2 (dataset) - ( 8) num_a1 (dataset) - ( 9) num_a2 (dataset) - (10) num_a4 (dataset) - (11) pom_a1 (dataset) - (12) pom_a4 (dataset) - (13) so4_a2 (dataset) - (14) SO2 (dataset) - (15) AOA_NH - (16) N + ( 8) pom_a4 (dataset) + ( 9) bc_a4 (dataset) + (10) CO (dataset) + (11) SVOC (dataset) + (12) AOA_NH + (13) NO + (14) N Equation Report @@ -1201,19 +1200,19 @@ Extraneous prod/loss species - r238*OH*BIGALK d(BIGENE)/dt = - r204*NO3*BIGENE - r205*OH*BIGENE d(BR)/dt = j74*BRCL + j75*BRO + j77*BRONO2 + j79*CF2CLBR + j80*CF3BR + 2*j86*CH2BR2 + j87*CH3BR - + 3*j90*CHBR3 + 2*j98*H2402 + j99*HBR + j105*HOBR + r77*O1D*CF2CLBR + 2*r90*BRO*BRO - + r91*BRO*CLO + r92*BRO*CLO + r95*BRO*NO + r98*BRO*O + r99*BRO*OH + r100*HBR*O + r101*HBR*OH - + r103*O1D*CF3BR + 3*r104*O1D*CHBR3 + 2*r105*O1D*H2402 + r106*O1D*HBR + 2*r114*CH2BR2*CL - + 2*r115*CH2BR2*OH + r116*CH3BR*CL + r117*CH3BR*OH + 3*r121*CHBR3*CL + 3*r122*CHBR3*OH - + 2*r126*O1D*CH2BR2 + r127*O1D*CH3BR + r345*SO*BRO - - r87*CH2O*BR - r88*HO2*BR - r89*O3*BR - d(BRCL)/dt = r93*BRO*CLO + r407*HOBR*HCL + r412*HOBR*HCL + + 3*j90*CHBR3 + 2*j98*H2402 + j99*HBR + j105*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*r115*CH2BR2*CL + + 2*r116*CH2BR2*OH + r117*CH3BR*CL + r118*CH3BR*OH + 3*r122*CHBR3*CL + 3*r123*CHBR3*OH + + 2*r127*O1D*CH2BR2 + r128*O1D*CH3BR + r346*SO*BRO + - r88*CH2O*BR - r89*HO2*BR - r90*O3*BR + d(BRCL)/dt = r94*BRO*CLO + r407*HOBR*HCL + r412*HOBR*HCL - j74*BRCL - d(BRO)/dt = j76*BRONO2 + r89*BR*O3 + r97*BRONO2*O + r102*HOBR*O + r107*O1D*HBR - - j75*BRO - 2*r90*BRO*BRO - r91*CLO*BRO - r92*CLO*BRO - r93*CLO*BRO - r94*HO2*BRO - r95*NO*BRO - - r96*M*NO2*BRO - r98*O*BRO - r99*OH*BRO - r345*SO*BRO - d(BRONO2)/dt = r96*M*BRO*NO2 - - j76*BRONO2 - j77*BRONO2 - r401*BRONO2 - r404*BRONO2 - r409*BRONO2 - r97*O*BRONO2 + d(BRO)/dt = j76*BRONO2 + r90*BR*O3 + r98*BRONO2*O + r103*HOBR*O + r108*O1D*HBR + - j75*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 - r346*SO*BRO + d(BRONO2)/dt = r97*M*BRO*NO2 + - j76*BRONO2 - j77*BRONO2 - r401*BRONO2 - r404*BRONO2 - r409*BRONO2 - r98*O*BRONO2 d(BRY)/dt = 0 d(BZALD)/dt = j28*BZOOH + r282*BZOO*NO - r279*OH*BZALD @@ -1233,42 +1232,42 @@ Extraneous prod/loss species d(C3H8)/dt = - r190*OH*C3H8 d(C6H5OOH)/dt = r283*C6H5O2*HO2 - j31*C6H5OOH - r285*OH*C6H5OOH - d(CCL4)/dt = - j78*CCL4 - r76*O1D*CCL4 - d(CF2CLBR)/dt = - j79*CF2CLBR - r77*O1D*CF2CLBR - d(CF3BR)/dt = - j80*CF3BR - r103*O1D*CF3BR - d(CFC11)/dt = - j81*CFC11 - r78*O1D*CFC11 - d(CFC113)/dt = - j82*CFC113 - r79*O1D*CFC113 - d(CFC114)/dt = - j83*CFC114 - r80*O1D*CFC114 - d(CFC115)/dt = - j84*CFC115 - r81*O1D*CFC115 - d(CFC12)/dt = - j85*CFC12 - r82*O1D*CFC12 - d(CH2BR2)/dt = - j86*CH2BR2 - r114*CL*CH2BR2 - r115*OH*CH2BR2 - r126*O1D*CH2BR2 - d(CH2O)/dt = .1*j19*ALKNIT + .1*j20*ALKOOH + j38*CH3OOH + .18*j40*CH4 + j43*GLYALD + .33*j45*HONITR - + j47*HYAC + .69*j49*ISOPOOH + 1.34*j50*MACR + j57*NOA + j62*POOH + j63*ROOH - + .375*j65*TERP2OOH + .4*j67*TERPOOH + .68*j69*TERPROD2 + r146*HOCH2OO + 2*r176*EO - + r58*CLO*CH3O2 + 2*r135*CH3O2*CH3O2 + r136*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH - + .3*r140*CH3OOH*OH + r149*O1D*CH4 + r150*O1D*CH4 + r156*C2H4*O3 + .7*r158*C2H5O2*CH3O2 - + r169*CH3CO3*CH3O2 + .5*r173*CH3COOOH*OH + .5*r175*EO2*NO + .8*r178*GLYALD*OH + r180*PAN*OH - + .5*r185*C3H6*O3 + r186*C3H7O2*CH3O2 + r196*PO2*NO + .8*r198*RO2*CH3O2 + .15*r199*RO2*HO2 - + r200*RO2*NO + .5*r204*BIGENE*NO3 + .5*r206*ENEO2*NO + .25*r209*MACRO2*CH3CO3 - + .88*r210*MACRO2*CH3O2 + .25*r212*MACRO2*NO3 + .25*r213*MACRO2*NO + .12*r215*MACR*O3 - + r218*MCO3*CH3CO3 + 2*r219*MCO3*CH3O2 + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + r222*MCO3*NO - + r223*MCO3*NO3 + .5*r228*M*MPAN*OH + .6*r229*MVK*O3 + .4*r233*ALKNIT*OH + .1*r235*ALKO2*NO + d(CCL4)/dt = - j78*CCL4 - r77*O1D*CCL4 + d(CF2CLBR)/dt = - j79*CF2CLBR - r78*O1D*CF2CLBR + d(CF3BR)/dt = - j80*CF3BR - r104*O1D*CF3BR + d(CFC11)/dt = - j81*CFC11 - r79*O1D*CFC11 + d(CFC113)/dt = - j82*CFC113 - r80*O1D*CFC113 + d(CFC114)/dt = - j83*CFC114 - r81*O1D*CFC114 + d(CFC115)/dt = - j84*CFC115 - r82*O1D*CFC115 + d(CFC12)/dt = - j85*CFC12 - r83*O1D*CFC12 + d(CH2BR2)/dt = - j86*CH2BR2 - r115*CL*CH2BR2 - r116*OH*CH2BR2 - r127*O1D*CH2BR2 + d(CH2O)/dt = .1*j19*ALKNIT + .1*j20*ALKOOH + j38*CH3OOH + .18*j39*CH4 + j43*GLYALD + .33*j45*HONITR + + j47*HYAC + j49*ISOPOOH + 1.34*j50*MACR + j57*NOA + j62*POOH + j63*ROOH + .375*j65*TERP2OOH + + .4*j67*TERPOOH + .68*j69*TERPROD2 + r146*HOCH2OO + 2*r176*EO + r59*CLO*CH3O2 + + 2*r136*CH3O2*CH3O2 + r137*CH3O2*CH3O2 + r139*CH3O2*NO + r140*CH3OH*OH + .3*r141*CH3OOH*OH + + r149*O1D*CH4 + r150*O1D*CH4 + r156*C2H4*O3 + .7*r158*C2H5O2*CH3O2 + r169*CH3CO3*CH3O2 + + .5*r173*CH3COOOH*OH + .5*r175*EO2*NO + .8*r178*GLYALD*OH + r180*PAN*OH + .5*r185*C3H6*O3 + + r186*C3H7O2*CH3O2 + r196*PO2*NO + .8*r198*RO2*CH3O2 + .15*r199*RO2*HO2 + r200*RO2*NO + + .5*r204*BIGENE*NO3 + .5*r206*ENEO2*NO + .25*r209*MACRO2*CH3CO3 + .88*r210*MACRO2*CH3O2 + + .25*r212*MACRO2*NO3 + .25*r213*MACRO2*NO + .12*r215*MACR*O3 + r218*MCO3*CH3CO3 + + 2*r219*MCO3*CH3O2 + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + r222*MCO3*NO + r223*MCO3*NO3 + + .5*r228*M*MPAN*OH + .6*r229*MVK*O3 + .4*r233*ALKNIT*OH + .1*r235*ALKO2*NO + r242*ISOPAO2*CH3CO3 + 1.5*r243*ISOPAO2*CH3O2 + .92*r245*ISOPAO2*NO + r246*ISOPAO2*NO3 + .75*r248*ISOPBO2*CH3O2 + .3*r253*ISOPNITA*OH + .8*r257*ISOPNO3*CH3O2 + .91*r262*ISOP*O3 + .25*r267*XO2*CH3CO3 + .8*r268*XO2*CH3O2 + .25*r270*XO2*NO + .34*r317*BCARY*O3 + .34*r320*MTERP*O3 + .75*r322*NTERPO2*CH3O2 + .93*r327*TERP2O2*CH3O2 + .34*r329*TERP2O2*NO + .95*r332*TERPO2*CH3O2 + .32*r334*TERPO2*NO + .68*r338*TERPROD2*OH - - j32*CH2O - j33*CH2O - r51*CL*CH2O - r87*BR*CH2O - r131*HO2*CH2O - r132*NO3*CH2O - - r133*O*CH2O - r134*OH*CH2O - d(CH3BR)/dt = - j87*CH3BR - r116*CL*CH3BR - r117*OH*CH3BR - r127*O1D*CH3BR - d(CH3CCL3)/dt = - j88*CH3CCL3 - r118*OH*CH3CCL3 + - j32*CH2O - j33*CH2O - r52*CL*CH2O - r88*BR*CH2O - r132*HO2*CH2O - r133*NO3*CH2O + - r134*O*CH2O - r135*OH*CH2O + d(CH3BR)/dt = - j87*CH3BR - r117*CL*CH3BR - r118*OH*CH3BR - r128*O1D*CH3BR + d(CH3CCL3)/dt = - j88*CH3CCL3 - r119*OH*CH3CCL3 d(CH3CHO)/dt = .4*j19*ALKNIT + .4*j20*ALKOOH + j29*C2H5OOH + .33*j45*HONITR + j53*MEKOOH + j62*POOH + 1.6*r157*C2H5O2*C2H5O2 + .8*r158*C2H5O2*CH3O2 + r160*C2H5O2*NO + r161*C2H5OH*OH + .5*r162*C2H5OOH*OH + .5*r185*C3H6*O3 + .27*r188*C3H7O2*NO + r196*PO2*NO + r204*BIGENE*NO3 + r206*ENEO2*NO + .2*r224*MEKO2*HO2 + r225*MEKO2*NO + .1*r229*MVK*O3 + .8*r233*ALKNIT*OH + .4*r235*ALKO2*NO - j34*CH3CHO - r165*NO3*CH3CHO - r166*OH*CH3CHO - d(CH3CL)/dt = - j89*CH3CL - r119*CL*CH3CL - r120*OH*CH3CL + d(CH3CL)/dt = - j89*CH3CL - r120*CL*CH3CL - r121*OH*CH3CL d(CH3CN)/dt = - r167*OH*CH3CN d(CH3COCH3)/dt = .25*j19*ALKNIT + .25*j20*ALKOOH + .82*j30*C3H7OOH + .17*j45*HONITR + .3*j65*TERP2OOH + .05*j67*TERPOOH + .5*j69*TERPROD2 + .82*r186*C3H7O2*CH3O2 + .82*r188*C3H7O2*NO @@ -1288,46 +1287,46 @@ Extraneous prod/loss species - r172*OH*CH3COOH d(CH3COOOH)/dt = .4*r170*CH3CO3*HO2 + .4*r220*MCO3*HO2 - j37*CH3COOOH - r173*OH*CH3COOOH - d(CH3OH)/dt = r136*CH3O2*CH3O2 + .3*r158*C2H5O2*CH3O2 + .5*r198*RO2*CH3O2 + .25*r210*MACRO2*CH3O2 + d(CH3OH)/dt = r137*CH3O2*CH3O2 + .3*r158*C2H5O2*CH3O2 + .5*r198*RO2*CH3O2 + .25*r210*MACRO2*CH3O2 + .25*r243*ISOPAO2*CH3O2 + .25*r248*ISOPBO2*CH3O2 + .2*r257*ISOPNO3*CH3O2 + .3*r268*XO2*CH3O2 + .25*r322*NTERPO2*CH3O2 + .25*r327*TERP2O2*CH3O2 + .25*r332*TERPO2*CH3O2 - - r139*OH*CH3OH - d(CH3OOH)/dt = r137*CH3O2*HO2 - - j38*CH3OOH - r140*OH*CH3OOH + - r140*OH*CH3OH + d(CH3OOH)/dt = r138*CH3O2*HO2 + - j38*CH3OOH - r141*OH*CH3OOH d(CH4)/dt = .1*r185*C3H6*O3 - - j39*CH4 - j40*CH4 - r52*CL*CH4 - r108*F*CH4 - r141*OH*CH4 - r148*O1D*CH4 - r149*O1D*CH4 + - j39*CH4 - j40*CH4 - r53*CL*CH4 - r109*F*CH4 - r142*OH*CH4 - r148*O1D*CH4 - r149*O1D*CH4 - r150*O1D*CH4 - d(CHBR3)/dt = - j90*CHBR3 - r104*O1D*CHBR3 - r121*CL*CHBR3 - r122*OH*CHBR3 + d(CHBR3)/dt = - j90*CHBR3 - r105*O1D*CHBR3 - r122*CL*CHBR3 - r123*OH*CHBR3 d(CL)/dt = j74*BRCL + 4*j78*CCL4 + j79*CF2CLBR + 2*j81*CFC11 + 2*j82*CFC113 + 2*j83*CFC114 + j84*CFC115 + 2*j85*CFC12 + 3*j88*CH3CCL3 + j89*CH3CL + 2*j91*CL2 + 2*j92*CL2O2 + j93*CLO + j94*CLONO2 - + j97*COFCL + j100*HCFC141B + j101*HCFC142B + j102*HCFC22 + j103*HCL + j106*HOCL + r58*CLO*CH3O2 - + 2*r59*CLO*CLO + r61*CLO*CLO + r63*CLO*NO + r68*CLO*O + r69*CLO*OH + r71*HCL*O + r72*HCL*OH - + 4*r76*O1D*CCL4 + r77*O1D*CF2CLBR + 2*r78*O1D*CFC11 + 2*r79*O1D*CFC113 + 2*r80*O1D*CFC114 - + r81*O1D*CFC115 + 2*r82*O1D*CFC12 + r83*O1D*HCL + r92*BRO*CLO + r113*O1D*COFCL - + 3*r118*CH3CCL3*OH + r120*CH3CL*OH + r123*HCFC141B*OH + r124*HCFC142B*OH + r125*HCFC22*OH - + r128*O1D*HCFC141B + r129*O1D*HCFC142B + r130*O1D*HCFC22 + r346*SO*CLO - - r51*CH2O*CL - r52*CH4*CL - r53*H2*CL - r54*H2O2*CL - r55*HO2*CL - r56*HO2*CL - r57*O3*CL - - r64*CLONO2*CL - r73*HOCL*CL - r114*CH2BR2*CL - r116*CH3BR*CL - r119*CH3CL*CL - r121*CHBR3*CL + + j97*COFCL + j100*HCFC141B + j101*HCFC142B + j102*HCFC22 + j103*HCL + j106*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 + 2*r79*O1D*CFC11 + 2*r80*O1D*CFC113 + 2*r81*O1D*CFC114 + + r82*O1D*CFC115 + 2*r83*O1D*CFC12 + r84*O1D*HCL + r93*BRO*CLO + r114*O1D*COFCL + + 3*r119*CH3CCL3*OH + r121*CH3CL*OH + r124*HCFC141B*OH + r125*HCFC142B*OH + r126*HCFC22*OH + + r129*O1D*HCFC141B + r130*O1D*HCFC142B + r131*O1D*HCFC22 + r347*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 - r115*CH2BR2*CL - r117*CH3BR*CL - r120*CH3CL*CL - r122*CHBR3*CL - r163*C2H6*CL - d(CL2)/dt = r60*CLO*CLO + r64*CLONO2*CL + r400*HOCL*HCL + r405*CLONO2*HCL + r406*HOCL*HCL + r410*CLONO2*HCL + d(CL2)/dt = r61*CLO*CLO + r65*CLONO2*CL + r400*HOCL*HCL + r405*CLONO2*HCL + r406*HOCL*HCL + r410*CLONO2*HCL + r411*HOCL*HCL + r415*CLONO2*HCL - j91*CL2 - d(CL2O2)/dt = r85*M*CLO*CLO - - j92*CL2O2 - r86*M*CL2O2 - d(CLO)/dt = j95*CLONO2 + j107*OCLO + r86*M*CL2O2 + r86*M*CL2O2 + r56*CL*HO2 + r57*CL*O3 + r66*CLONO2*O - + r73*HOCL*CL + r74*HOCL*O + r75*HOCL*OH + r84*O1D*HCL + r351*SO*OCLO - - j93*CLO - r58*CH3O2*CLO - 2*r59*CLO*CLO - 2*r60*CLO*CLO - 2*r61*CLO*CLO - r62*HO2*CLO - - r63*NO*CLO - r65*M*NO2*CLO - r68*O*CLO - r69*OH*CLO - r70*OH*CLO - 2*r85*M*CLO*CLO - - r91*BRO*CLO - r92*BRO*CLO - r93*BRO*CLO - r346*SO*CLO - d(CLONO2)/dt = r65*M*CLO*NO2 - - j94*CLONO2 - j95*CLONO2 - r403*CLONO2 - r408*CLONO2 - r414*CLONO2 - r64*CL*CLONO2 - - r66*O*CLONO2 - r67*OH*CLONO2 - r405*HCL*CLONO2 - r410*HCL*CLONO2 - r415*HCL*CLONO2 + d(CL2O2)/dt = r86*M*CLO*CLO + - j92*CL2O2 - r87*M*CL2O2 + d(CLO)/dt = j95*CLONO2 + j107*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 + r352*SO*OCLO + - j93*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 - r347*SO*CLO + d(CLONO2)/dt = r66*M*CLO*NO2 + - j94*CLONO2 - j95*CLONO2 - r403*CLONO2 - r408*CLONO2 - r414*CLONO2 - r65*CL*CLONO2 + - r67*O*CLONO2 - r68*OH*CLONO2 - r405*HCL*CLONO2 - r410*HCL*CLONO2 - r415*HCL*CLONO2 d(CLY)/dt = 0 d(CO)/dt = 1.5*j22*BEPOMUC + .45*j23*BIGALD + .6*j26*BIGALD3 + j27*BIGALD4 + j32*CH2O + j33*CH2O - + j34*CH3CHO + j36*CH3COCHO + .38*j40*CH4 + j41*CO2 + j43*GLYALD + 2*j44*GLYOXAL + + j34*CH3CHO + j36*CH3COCHO + .38*j39*CH4 + j41*CO2 + j43*GLYALD + 2*j44*GLYOXAL + .33*j45*HONITR + 1.34*j51*MACR + .7*j55*MVK + 1.5*j64*TEPOMUC + .25*j65*TERP2OOH + j68*TERPROD1 - + 1.7*j69*TERPROD2 + j110*OCS + r51*CL*CH2O + r87*BR*CH2O + r119*CH3CL*CL + r132*CH2O*NO3 - + r133*CH2O*O + r134*CH2O*OH + .35*r154*M*C2H2*OH + .63*r156*C2H4*O3 + r179*GLYOXAL*OH + + 1.7*j69*TERPROD2 + j110*OCS + r52*CL*CH2O + r88*BR*CH2O + r120*CH3CL*CL + r133*CH2O*NO3 + + r134*CH2O*O + r135*CH2O*OH + .35*r154*M*C2H2*OH + .63*r156*C2H4*O3 + r179*GLYOXAL*OH + .56*r185*C3H6*O3 + r191*CH3COCHO*NO3 + r192*CH3COCHO*OH + .22*r209*MACRO2*CH3CO3 + .11*r210*MACRO2*CH3O2 + .22*r212*MACRO2*NO3 + .22*r213*MACRO2*NO + .65*r215*MACR*O3 + .56*r229*MVK*O3 + .62*r262*ISOP*O3 + .25*r267*XO2*CH3CO3 + .2*r268*XO2*CH3O2 + .25*r270*XO2*NO @@ -1335,34 +1334,34 @@ Extraneous prod/loss species + .4*r291*MALO2*NO + .14*r293*MDIALO2*HO2 + .35*r294*MDIALO2*NO + .23*r317*BCARY*O3 + .23*r320*MTERP*O3 + .125*r327*TERP2O2*CH3O2 + .225*r329*TERP2O2*NO + .7*r338*TERPROD2*OH + r341*OCS*O + r342*OCS*OH - - r142*M*OH*CO - r152*OH*CO - d(CO2)/dt = j37*CH3COOOH + .44*j40*CH4 + .4*j60*PAN + j65*TERP2OOH + .8*j69*TERPROD2 + r142*M*CO*OH - + r144*HCOOH*OH + r152*CO*OH + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + r171*CH3CO3*NO - + r172*CH3COOH*OH + .5*r173*CH3COOOH*OH + .8*r178*GLYALD*OH + r179*GLYOXAL*OH + .2*r185*C3H6*O3 + - r152*OH*CO + d(CO2)/dt = j37*CH3COOOH + .44*j39*CH4 + .4*j60*PAN + j65*TERP2OOH + .8*j69*TERPROD2 + r144*HCOOH*OH + + r152*CO*OH + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + r171*CH3CO3*NO + r172*CH3COOH*OH + + .5*r173*CH3COOOH*OH + .8*r178*GLYALD*OH + r179*GLYOXAL*OH + .2*r185*C3H6*O3 + 2*r218*MCO3*CH3CO3 + r219*MCO3*CH3O2 + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + .5*r228*M*MPAN*OH + .1*r229*MVK*O3 + r242*ISOPAO2*CH3CO3 + r267*XO2*CH3CO3 + .27*r317*BCARY*O3 + .27*r320*MTERP*O3 + .5*r327*TERP2O2*CH3O2 + .9*r329*TERP2O2*NO + 1.8*r338*TERPROD2*OH - j41*CO2 d(COF2)/dt = j79*CF2CLBR + j80*CF3BR + j82*CFC113 + 2*j83*CFC114 + 2*j84*CFC115 + j85*CFC12 + 2*j98*H2402 - + j101*HCFC142B + j102*HCFC22 + r77*O1D*CF2CLBR + r79*O1D*CFC113 + 2*r80*O1D*CFC114 - + 2*r81*O1D*CFC115 + r82*O1D*CFC12 + r103*O1D*CF3BR + 2*r105*O1D*H2402 + r124*HCFC142B*OH - + r125*HCFC22*OH + r129*O1D*HCFC142B + r130*O1D*HCFC22 - - j96*COF2 - r112*O1D*COF2 - d(COFCL)/dt = j81*CFC11 + j82*CFC113 + j100*HCFC141B + r78*O1D*CFC11 + r79*O1D*CFC113 + r123*HCFC141B*OH - + r128*O1D*HCFC141B - - j97*COFCL - r113*O1D*COFCL + + j101*HCFC142B + j102*HCFC22 + r78*O1D*CF2CLBR + r80*O1D*CFC113 + 2*r81*O1D*CFC114 + + 2*r82*O1D*CFC115 + r83*O1D*CFC12 + r104*O1D*CF3BR + 2*r106*O1D*H2402 + r125*HCFC142B*OH + + r126*HCFC22*OH + r130*O1D*HCFC142B + r131*O1D*HCFC22 + - j96*COF2 - r113*O1D*COF2 + d(COFCL)/dt = j81*CFC11 + j82*CFC113 + j100*HCFC141B + r79*O1D*CFC11 + r80*O1D*CFC113 + r124*HCFC141B*OH + + r129*O1D*HCFC141B + - j97*COFCL - r114*O1D*COFCL d(CRESOL)/dt = .18*r306*TOLUENE*OH - r286*OH*CRESOL - d(DMS)/dt = - r339*NO3*DMS - r340*OH*DMS - r353*OH*DMS + d(DMS)/dt = - r339*NO3*DMS - r340*OH*DMS - r354*OH*DMS d(dst_a1)/dt = 0 d(dst_a2)/dt = 0 d(dst_a3)/dt = 0 - d(E90)/dt = - r416*E90 + d(E90)/dt = - r1*E90 d(EOOH)/dt = r174*EO2*HO2 - j42*EOOH - d(F)/dt = j80*CF3BR + j84*CFC115 + 2*j96*COF2 + j97*COFCL + j104*HF + r81*O1D*CFC115 + r103*O1D*CF3BR - + 2*r112*O1D*COF2 + r113*O1D*COFCL - - r108*CH4*F - r109*H2*F - r110*H2O*F - r111*HNO3*F + d(F)/dt = j80*CF3BR + j84*CFC115 + 2*j96*COF2 + j97*COFCL + j104*HF + r82*O1D*CFC115 + r104*O1D*CF3BR + + 2*r113*O1D*COF2 + r114*O1D*COFCL + - r109*CH4*F - r110*H2*F - r111*H2O*F - r112*HNO3*F d(GLYALD)/dt = .33*j45*HONITR + .25*j65*TERP2OOH + r177*O2*EO + .53*r209*MACRO2*CH3CO3 + .26*r210*MACRO2*CH3O2 + .53*r212*MACRO2*NO3 + .53*r213*MACRO2*NO + .05*r251*ISOPBO2*NO + .05*r252*ISOPBO2*NO3 + .7*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH + r265*NC4CH2OH*OH + .25*r267*XO2*CH3CO3 @@ -1376,46 +1375,45 @@ Extraneous prod/loss species + .07*r293*MDIALO2*HO2 + .17*r294*MDIALO2*NO + .7*r297*PHENO2*NO + .6*r304*TOLO2*NO + .34*r310*XYLENO2*NO + .17*r313*XYLOLO2*NO - j44*GLYOXAL - r357*GLYOXAL - r179*OH*GLYOXAL - d(H)/dt = j2*H2O + 2*j3*H2O + 2*j32*CH2O + j38*CH3OOH + j39*CH4 + .33*j40*CH4 + j99*HBR + j103*HCL - + j104*HF + r1*O1D*H2 + r9*H2*O + r18*OH*H2 + r21*OH*O + r39*N*OH + r53*CL*H2 + r84*O1D*HCL - + r107*O1D*HBR + r109*F*H2 + r134*CH2O*OH + r149*O1D*CH4 + r152*CO*OH + r342*OCS*OH + r347*S*OH - + r352*SO*OH - - r14*O2*M*H - r11*HO2*H - r12*HO2*H - r13*HO2*H - r17*O3*H - d(H2)/dt = j1*H2O + j33*CH2O + 1.4400001*j40*CH4 + r11*H*HO2 + r150*O1D*CH4 - - r1*O1D*H2 - r9*O*H2 - r18*OH*H2 - r53*CL*H2 - r109*F*H2 - d(H2402)/dt = - j98*H2402 - r105*O1D*H2402 - d(H2O2)/dt = .5*r358*HO2 + r24*M*OH*OH + r25*HO2*HO2 - - j4*H2O2 - r10*O*H2O2 - r19*OH*H2O2 - r54*CL*H2O2 + d(H)/dt = j2*H2O + 2*j3*H2O + 2*j33*CH2O + j38*CH3OOH + .33*j39*CH4 + j40*CH4 + j99*HBR + j103*HCL + + j104*HF + r2*O1D*H2 + r10*H2*O + r19*OH*H2 + r22*OH*O + r40*N*OH + r54*CL*H2 + r85*O1D*HCL + + r108*O1D*HBR + r110*F*H2 + r135*CH2O*OH + r149*O1D*CH4 + r342*OCS*OH + r348*S*OH + r353*SO*OH + - r15*O2*M*H - r12*HO2*H - r13*HO2*H - r14*HO2*H - r18*O3*H + d(H2)/dt = j1*H2O + j32*CH2O + 1.4400001*j39*CH4 + r12*H*HO2 + r150*O1D*CH4 + - r2*O1D*H2 - r10*O*H2 - r19*OH*H2 - r54*CL*H2 - r110*F*H2 + d(H2402)/dt = - j98*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 = r355*SO3*H2O - j109*H2SO4 - d(HBR)/dt = r87*BR*CH2O + r88*BR*HO2 - - j99*HBR - r100*O*HBR - r101*OH*HBR - r106*O1D*HBR - r107*O1D*HBR - d(HCFC141B)/dt = - j100*HCFC141B - r123*OH*HCFC141B - r128*O1D*HCFC141B - d(HCFC142B)/dt = - j101*HCFC142B - r124*OH*HCFC142B - r129*O1D*HCFC142B - d(HCFC22)/dt = - j102*HCFC22 - r125*OH*HCFC22 - r130*O1D*HCFC22 - d(HCL)/dt = r51*CL*CH2O + r52*CL*CH4 + r53*CL*H2 + r54*CL*H2O2 + r55*CL*HO2 + r70*CLO*OH + r73*HOCL*CL - + r114*CH2BR2*CL + r116*CH3BR*CL + 2*r119*CH3CL*CL + r121*CHBR3*CL + r163*C2H6*CL - - j103*HCL - r71*O*HCL - r72*OH*HCL - r83*O1D*HCL - r84*O1D*HCL - r400*HOCL*HCL + d(HBR)/dt = r88*BR*CH2O + r89*BR*HO2 + - j99*HBR - r101*O*HBR - r102*OH*HBR - r107*O1D*HBR - r108*O1D*HBR + d(HCFC141B)/dt = - j100*HCFC141B - r124*OH*HCFC141B - r129*O1D*HCFC141B + d(HCFC142B)/dt = - j101*HCFC142B - r125*OH*HCFC142B - r130*O1D*HCFC142B + d(HCFC22)/dt = - j102*HCFC22 - r126*OH*HCFC22 - r131*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 + + r115*CH2BR2*CL + r117*CH3BR*CL + 2*r120*CH3CL*CL + r122*CHBR3*CL + r163*C2H6*CL + - j103*HCL - r72*O*HCL - r73*OH*HCL - r84*O1D*HCL - r85*O1D*HCL - r400*HOCL*HCL - r405*CLONO2*HCL - r406*HOCL*HCL - r407*HOBR*HCL - r410*CLONO2*HCL - r411*HOCL*HCL - r412*HOBR*HCL - r415*CLONO2*HCL d(HCN)/dt = - r143*M*OH*HCN - r151*O1D*HCN d(HCOOH)/dt = r145*HOCH2OO*HO2 + r147*HOCH2OO*NO + .35*r154*M*C2H2*OH + .37*r156*C2H4*O3 + .12*r185*C3H6*O3 + .33*r215*MACR*O3 + .12*r229*MVK*O3 + .11*r262*ISOP*O3 + .05*r317*BCARY*O3 + .05*r320*MTERP*O3 - r144*OH*HCOOH - d(HF)/dt = r108*F*CH4 + r109*F*H2 + r110*F*H2O + r111*F*HNO3 + d(HF)/dt = r109*F*CH4 + r110*F*H2 + r111*F*H2O + r112*F*HNO3 - j104*HF d(HNO3)/dt = r359*HONITR + r360*ISOPNITA + r361*ISOPNITB + 2*r362*N2O5 + r363*NC4CH2OH + r364*NC4CHO + .5*r366*NO2 + r367*NO3 + r368*NTERPOOH + r369*ONITR + r370*TERPNIT + 2*r399*N2O5 + r401*BRONO2 + 2*r402*N2O5 + r403*CLONO2 + r404*BRONO2 + r408*CLONO2 + r409*BRONO2 - + 2*r413*N2O5 + r414*CLONO2 + r47*M*NO2*OH + r132*CH2O*NO3 + r165*CH3CHO*NO3 + + 2*r413*N2O5 + r414*CLONO2 + r48*M*NO2*OH + r133*CH2O*NO3 + r165*CH3CHO*NO3 + r191*CH3COCHO*NO3 + r339*DMS*NO3 + r405*CLONO2*HCL + r410*CLONO2*HCL + r415*CLONO2*HCL - - j9*HNO3 - r48*OH*HNO3 - r111*F*HNO3 - d(HO2NO2)/dt = r45*M*NO2*HO2 - - j10*HO2NO2 - j11*HO2NO2 - r49*M*HO2NO2 - r26*OH*HO2NO2 - d(HOBR)/dt = r401*BRONO2 + r404*BRONO2 + r409*BRONO2 + r94*BRO*HO2 - - j105*HOBR - r102*O*HOBR - r407*HCL*HOBR - r412*HCL*HOBR - d(HOCL)/dt = r403*CLONO2 + r408*CLONO2 + r414*CLONO2 + r62*CLO*HO2 + r67*CLONO2*OH - - j106*HOCL - r73*CL*HOCL - r74*O*HOCL - r75*OH*HOCL - r400*HCL*HOCL - r406*HCL*HOCL + - j9*HNO3 - r49*OH*HNO3 - r112*F*HNO3 + d(HO2NO2)/dt = r46*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r50*M*HO2NO2 - r27*OH*HO2NO2 + d(HOBR)/dt = r401*BRONO2 + r404*BRONO2 + r409*BRONO2 + r95*BRO*HO2 + - j105*HOBR - r103*O*HOBR - r407*HCL*HOBR - r412*HCL*HOBR + d(HOCL)/dt = r403*CLONO2 + r408*CLONO2 + r414*CLONO2 + r63*CLO*HO2 + r68*CLONO2*OH + - j106*HOCL - r74*CL*HOCL - r75*O*HOCL - r76*OH*HOCL - r400*HCL*HOCL - r406*HCL*HOCL - r411*HCL*HOCL d(HONITR)/dt = r207*ENEO2*NO + r214*MACRO2*NO + .3*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH - j45*HONITR - r359*HONITR - r208*OH*HONITR @@ -1443,7 +1441,7 @@ Extraneous prod/loss species d(ISOPOOH)/dt = j48*ISOPNOOH + r244*ISOPAO2*HO2 + r249*ISOPBO2*HO2 - j49*ISOPOOH - r264*OH*ISOPOOH d(IVOC)/dt = - r386*OH*IVOC - d(MACR)/dt = .288*j49*ISOPOOH + .39*r242*ISOPAO2*CH3CO3 + .31*r243*ISOPAO2*CH3O2 + .36*r245*ISOPAO2*NO + d(MACR)/dt = .3*j49*ISOPOOH + .39*r242*ISOPAO2*CH3CO3 + .31*r243*ISOPAO2*CH3O2 + .36*r245*ISOPAO2*NO + .4*r246*ISOPAO2*NO3 + .3*r262*ISOP*O3 - j50*MACR - j51*MACR - r215*O3*MACR - r216*OH*MACR d(MACROOH)/dt = r211*MACRO2*HO2 @@ -1455,15 +1453,15 @@ Extraneous prod/loss species d(MPAN)/dt = r231*M*MCO3*NO2 - j54*MPAN - r232*M*MPAN - r228*M*OH*MPAN d(MTERP)/dt = - r319*NO3*MTERP - r320*O3*MTERP - r321*OH*MTERP - d(MVK)/dt = .402*j49*ISOPOOH + .61*r242*ISOPAO2*CH3CO3 + .44*r243*ISOPAO2*CH3O2 + .56*r245*ISOPAO2*NO + d(MVK)/dt = .7*j49*ISOPOOH + .61*r242*ISOPAO2*CH3CO3 + .44*r243*ISOPAO2*CH3O2 + .56*r245*ISOPAO2*NO + .6*r246*ISOPAO2*NO3 + .2*r262*ISOP*O3 - j55*MVK - r229*O3*MVK - r230*OH*MVK d(N)/dt = j15*NO - - r31*O2*N - r27*NO*N - r28*NO2*N - r29*NO2*N - r30*NO2*N - r39*OH*N - d(N2O)/dt = r28*N*NO2 - - j12*N2O - r43*O1D*N2O - r44*O1D*N2O - d(N2O5)/dt = r46*M*NO2*NO3 - - j13*N2O5 - j14*N2O5 - r50*M*N2O5 - r362*N2O5 - r399*N2O5 - r402*N2O5 - r413*N2O5 + - 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 - r362*N2O5 - r399*N2O5 - r402*N2O5 - r413*N2O5 d(NC4CH2OH)/dt = .2*r257*ISOPNO3*CH3O2 - r363*NC4CH2OH - r265*OH*NC4CH2OH d(NC4CHO)/dt = r256*ISOPNO3*CH3CO3 + .8*r257*ISOPNO3*CH3O2 + r259*ISOPNO3*NO + r260*ISOPNO3*NO3 @@ -1473,12 +1471,12 @@ Extraneous prod/loss species d(ncl_a3)/dt = 0 d(NH3)/dt = - r356*OH*NH3 d(NH4)/dt = - r365*NH4 - d(NH_5)/dt = - r418*NH_5 - d(NH_50)/dt = - r417*NH_50 - d(NO)/dt = j14*N2O5 + j16*NO2 + j17*NO3 + r31*O2*N + .5*r366*NO2 + 2*r29*N*NO2 + r32*NO2*O + r39*N*OH - + 2*r43*O1D*N2O + r348*SO*NO2 - - j15*NO - r27*N*NO - r36*NO3*NO - r40*HO2*NO - r41*O3*NO - r42*M*O*NO - r63*CLO*NO - - r95*BRO*NO - r138*CH3O2*NO - r147*HOCH2OO*NO - r160*C2H5O2*NO - r171*CH3CO3*NO - r175*EO2*NO + d(NH_5)/dt = - r417*NH_5 + d(NH_50)/dt = - r416*NH_50 + d(NO)/dt = j14*N2O5 + j16*NO2 + j17*NO3 + r32*O2*N + .5*r366*NO2 + 2*r30*N*NO2 + r33*NO2*O + r40*N*OH + + 2*r44*O1D*N2O + r349*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 - r139*CH3O2*NO - r147*HOCH2OO*NO - r160*C2H5O2*NO - r171*CH3CO3*NO - r175*EO2*NO - r188*C3H7O2*NO - r196*PO2*NO - r200*RO2*NO - r206*ENEO2*NO - r207*ENEO2*NO - r213*MACRO2*NO - r214*MACRO2*NO - r222*MCO3*NO - r225*MEKO2*NO - r235*ALKO2*NO - r236*ALKO2*NO - r245*ISOPAO2*NO - r251*ISOPBO2*NO - r259*ISOPNO3*NO - r270*XO2*NO - r274*ACBZO2*NO - r277*BENZO2*NO @@ -1487,9 +1485,9 @@ Extraneous prod/loss species - r329*TERP2O2*NO - r334*TERPO2*NO d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j19*ALKNIT + j45*HONITR + j48*ISOPNOOH + j54*MPAN + j56*NC4CHO + j57*NOA + j58*NTERPOOH + j59*ONITR + .6*j60*PAN + j66*TERPNIT + j76*BRONO2 - + j95*CLONO2 + r49*M*HO2NO2 + r50*M*N2O5 + r183*M*PAN + r232*M*MPAN + r307*M*PBZNIT - + r26*HO2NO2*OH + r35*NO3*HO2 + 2*r36*NO3*NO + r37*NO3*O + r38*NO3*OH + r40*NO*HO2 + r41*NO*O3 - + r42*M*NO*O + r63*CLO*NO + r95*BRO*NO + r138*CH3O2*NO + r147*HOCH2OO*NO + r160*C2H5O2*NO + + j95*CLONO2 + r50*M*HO2NO2 + r51*M*N2O5 + r183*M*PAN + r232*M*MPAN + r307*M*PBZNIT + + 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 + r139*CH3O2*NO + r147*HOCH2OO*NO + r160*C2H5O2*NO + r171*CH3CO3*NO + r175*EO2*NO + r188*C3H7O2*NO + r194*NOA*OH + r196*PO2*NO + r200*RO2*NO + r204*BIGENE*NO3 + r206*ENEO2*NO + r212*MACRO2*NO3 + r213*MACRO2*NO + r222*MCO3*NO + r223*MCO3*NO3 + r225*MEKO2*NO + r233*ALKNIT*OH + r235*ALKO2*NO + .92*r245*ISOPAO2*NO @@ -1499,15 +1497,15 @@ Extraneous prod/loss species + r294*MDIALO2*NO + r297*PHENO2*NO + r304*TOLO2*NO + r310*XYLENO2*NO + r313*XYLOLO2*NO + .5*r322*NTERPO2*CH3O2 + 1.6*r324*NTERPO2*NO + 2*r325*NTERPO2*NO3 + .9*r329*TERP2O2*NO + r331*TERPNIT*OH + .8*r334*TERPO2*NO - - j16*NO2 - r366*NO2 - r28*N*NO2 - r29*N*NO2 - r30*N*NO2 - r32*O*NO2 - r33*O3*NO2 - - r34*M*O*NO2 - r45*M*HO2*NO2 - r46*M*NO3*NO2 - r47*M*OH*NO2 - r65*M*CLO*NO2 - r96*M*BRO*NO2 + - j16*NO2 - r366*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 - r182*M*CH3CO3*NO2 - r231*M*MCO3*NO2 - r289*M*DICARBO2*NO2 - r292*M*MALO2*NO2 - - r295*M*MDIALO2*NO2 - r299*PHENO*NO2 - r302*M*ACBZO2*NO2 - r348*SO*NO2 - d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j60*PAN + j77*BRONO2 + j94*CLONO2 + r50*M*N2O5 - + r33*NO2*O3 + r34*M*NO2*O + r48*HNO3*OH + r64*CLONO2*CL + r66*CLONO2*O + r67*CLONO2*OH - + r97*BRONO2*O + r111*F*HNO3 + r180*PAN*OH + .5*r228*M*MPAN*OH - - j17*NO3 - j18*NO3 - r367*NO3 - r35*HO2*NO3 - r36*NO*NO3 - r37*O*NO3 - r38*OH*NO3 - - r46*M*NO2*NO3 - r132*CH2O*NO3 - r165*CH3CHO*NO3 - r184*C3H6*NO3 - r191*CH3COCHO*NO3 + - r295*M*MDIALO2*NO2 - r299*PHENO*NO2 - r302*M*ACBZO2*NO2 - r349*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j60*PAN + j77*BRONO2 + j94*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 + r112*F*HNO3 + r180*PAN*OH + .5*r228*M*MPAN*OH + - j17*NO3 - j18*NO3 - r367*NO3 - r36*HO2*NO3 - r37*NO*NO3 - r38*O*NO3 - r39*OH*NO3 + - r47*M*NO2*NO3 - r133*CH2O*NO3 - r165*CH3CHO*NO3 - r184*C3H6*NO3 - r191*CH3COCHO*NO3 - r204*BIGENE*NO3 - r212*MACRO2*NO3 - r223*MCO3*NO3 - r246*ISOPAO2*NO3 - r252*ISOPBO2*NO3 - r255*ISOP*NO3 - r260*ISOPNO3*NO3 - r271*XO2*NO3 - r316*BCARY*NO3 - r319*MTERP*NO3 - r325*NTERPO2*NO3 - r336*TERPROD1*NO3 - r339*DMS*NO3 @@ -1519,19 +1517,19 @@ Extraneous prod/loss species d(num_a2)/dt = 0 d(num_a3)/dt = 0 d(num_a4)/dt = 0 - d(O)/dt = j5*O2 + 2*j6*O2 + j3*H2O + j8*O3 + j14*N2O5 + j15*NO + j16*NO2 + j18*NO3 + .18*j40*CH4 - + j41*CO2 + j75*BRO + j93*CLO + j107*OCLO + j111*SO + j112*SO2 + j113*SO3 + r3*N2*O1D - + r4*O2*O1D + r31*O2*N + r343*O2*S + r349*O2*SO + r13*H*HO2 + r23*OH*OH + r27*N*NO + r28*N*NO2 - - r8*O2*M*O - r6*O3*O - 2*r7*M*O*O - r9*H2*O - r10*H2O2*O - r15*HO2*O - r21*OH*O - r32*NO2*O - - r34*M*NO2*O - r37*NO3*O - r42*M*NO*O - r66*CLONO2*O - r68*CLO*O - r71*HCL*O - r74*HOCL*O - - r97*BRONO2*O - r98*BRO*O - r100*HBR*O - r102*HOBR*O - r133*CH2O*O - r341*OCS*O - d(O3)/dt = r8*O2*M*O + .15*r170*CH3CO3*HO2 + .15*r220*MCO3*HO2 - - j7*O3 - j8*O3 - r5*O1D*O3 - r6*O*O3 - r16*HO2*O3 - r17*H*O3 - r22*OH*O3 - r33*NO2*O3 - - r41*NO*O3 - r57*CL*O3 - r89*BR*O3 - r156*C2H4*O3 - r185*C3H6*O3 - r215*MACR*O3 - r229*MVK*O3 - - r262*ISOP*O3 - r300*PHENO*O3 - r317*BCARY*O3 - r320*MTERP*O3 - r344*S*O3 - r350*SO*O3 + d(O)/dt = j5*O2 + 2*j6*O2 + j3*H2O + j8*O3 + j14*N2O5 + j15*NO + j16*NO2 + j18*NO3 + .18*j39*CH4 + + j41*CO2 + j75*BRO + j93*CLO + j107*OCLO + j111*SO + j112*SO2 + j113*SO3 + r4*N2*O1D + + r5*O2*O1D + r32*O2*N + r343*O2*S + r350*O2*SO + r14*H*HO2 + r24*OH*OH + r28*N*NO + r29*N*NO2 + - 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 - r134*CH2O*O - r341*OCS*O + d(O3)/dt = r9*O2*M*O + .15*r170*CH3CO3*HO2 + .15*r220*MCO3*HO2 + - j7*O3 - j8*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 - r156*C2H4*O3 - r185*C3H6*O3 - r215*MACR*O3 - r229*MVK*O3 + - r262*ISOP*O3 - r300*PHENO*O3 - r317*BCARY*O3 - r320*MTERP*O3 - r345*S*O3 - r351*SO*O3 d(O3S)/dt = 0 - d(OCLO)/dt = r61*CLO*CLO + r91*BRO*CLO - - j107*OCLO - r351*SO*OCLO + d(OCLO)/dt = r62*CLO*CLO + r92*BRO*CLO + - j107*OCLO - r352*SO*OCLO d(OCS)/dt = - j110*OCS - r341*O*OCS - r342*OH*OCS d(ONITR)/dt = r208*HONITR*OH + .1*r329*TERP2O2*NO - j59*ONITR - r369*ONITR @@ -1552,15 +1550,15 @@ Extraneous prod/loss species d(ROOH)/dt = .85*r199*RO2*HO2 - j63*ROOH - r201*OH*ROOH d(S)/dt = j110*OCS + j111*SO - - r343*O2*S - r344*O3*S - r347*OH*S + - r343*O2*S - r345*O3*S - r348*OH*S d(SF6)/dt = - j108*SF6 - d(SO)/dt = j112*SO2 + r343*O2*S + r341*OCS*O + r344*S*O3 + r347*S*OH - - j111*SO - r349*O2*SO - r345*BRO*SO - r346*CLO*SO - r348*NO2*SO - r350*O3*SO - r351*OCLO*SO - - r352*OH*SO - d(SO2)/dt = j113*SO3 + r349*O2*SO + r339*DMS*NO3 + r340*DMS*OH + r342*OCS*OH + r345*SO*BRO + r346*SO*CLO - + r348*SO*NO2 + r350*SO*O3 + r351*SO*OCLO + r352*SO*OH + .5*r353*DMS*OH - - j112*SO2 - r354*OH*SO2 - d(SO3)/dt = j109*H2SO4 + r354*SO2*OH + d(SO)/dt = j112*SO2 + r343*O2*S + r341*OCS*O + r345*S*O3 + r348*S*OH + - j111*SO - r350*O2*SO - r346*BRO*SO - r347*CLO*SO - r349*NO2*SO - r351*O3*SO - r352*OCLO*SO + - r353*OH*SO + d(SO2)/dt = j113*SO3 + r350*O2*SO + r339*DMS*NO3 + r340*DMS*OH + r342*OCS*OH + r346*SO*BRO + r347*SO*CLO + + r349*SO*NO2 + r351*SO*O3 + r352*SO*OCLO + r353*SO*OH + .5*r354*DMS*OH + - j112*SO2 - r344*M*OH*SO2 + d(SO3)/dt = j109*H2SO4 + r344*M*SO2*OH - j113*SO3 - r355*H2O*SO3 d(so4_a1)/dt = 0 d(so4_a2)/dt = 0 @@ -1606,7 +1604,7 @@ Extraneous prod/loss species + .0166*r385*IVOCO2VBS*NO + .59019*r387*MTERP*NO3 + .1278*r388*MTERPO2VBS*HO2 + .13*r389*MTERPO2VBS*NO + .1278*r390*MTERP*O3 + .0128*r392*SVOC*OH + .0738*r394*TOLUO2VBS*HO2 + .238*r395*TOLUO2VBS*NO + .1598*r397*XYLEO2VBS*HO2 + .1185*r398*XYLEO2VBS*NO - d(ST80_25)/dt = - r419*ST80_25 + d(ST80_25)/dt = - r418*ST80_25 d(SVOC)/dt = - r392*OH*SVOC d(TEPOMUC)/dt = .1*r306*TOLUENE*OH + .23*r308*XYLENES*OH - j64*TEPOMUC @@ -1668,14 +1666,14 @@ Extraneous prod/loss species - 2*r168*CH3CO3*CH3CO3 - r169*CH3O2*CH3CO3 - r170*HO2*CH3CO3 - r171*NO*CH3CO3 - r182*M*NO2*CH3CO3 - r209*MACRO2*CH3CO3 - r242*ISOPAO2*CH3CO3 - r247*ISOPBO2*CH3CO3 - r256*ISOPNO3*CH3CO3 - r267*XO2*CH3CO3 - d(CH3O2)/dt = j34*CH3CHO + j35*CH3COCH3 + j37*CH3COOOH + j39*CH4 + .3*j55*MVK + .4*j60*PAN + j87*CH3BR - + j89*CH3CL + r52*CL*CH4 + r108*F*CH4 + .7*r140*CH3OOH*OH + r141*CH4*OH + r148*O1D*CH4 + d(CH3O2)/dt = j34*CH3CHO + j35*CH3COCH3 + j37*CH3COOOH + j40*CH4 + .3*j55*MVK + .4*j60*PAN + j87*CH3BR + + j89*CH3CL + r53*CL*CH4 + r109*F*CH4 + .7*r141*CH3OOH*OH + r142*CH4*OH + r148*O1D*CH4 + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + .45*r170*CH3CO3*HO2 + r171*CH3CO3*NO + r172*CH3COOH*OH + .28*r185*C3H6*O3 + r209*MACRO2*CH3CO3 + r218*MCO3*CH3CO3 + r242*ISOPAO2*CH3CO3 + r247*ISOPBO2*CH3CO3 + r256*ISOPNO3*CH3CO3 + .05*r262*ISOP*O3 + r267*XO2*CH3CO3 + .33*r287*DICARBO2*HO2 + .83*r288*DICARBO2*NO + .07*r293*MDIALO2*HO2 + .17*r294*MDIALO2*NO - - r58*CLO*CH3O2 - 2*r135*CH3O2*CH3O2 - 2*r136*CH3O2*CH3O2 - r137*HO2*CH3O2 - r138*NO*CH3O2 + - r59*CLO*CH3O2 - 2*r136*CH3O2*CH3O2 - 2*r137*CH3O2*CH3O2 - r138*HO2*CH3O2 - r139*NO*CH3O2 - r158*C2H5O2*CH3O2 - r169*CH3CO3*CH3O2 - r186*C3H7O2*CH3O2 - r198*RO2*CH3O2 - r210*MACRO2*CH3O2 - r219*MCO3*CH3O2 - r243*ISOPAO2*CH3O2 - r248*ISOPBO2*CH3O2 - r257*ISOPNO3*CH3O2 - r268*XO2*CH3O2 - r322*NTERPO2*CH3O2 - r327*TERP2O2*CH3O2 @@ -1693,12 +1691,12 @@ Extraneous prod/loss species + j30*C3H7OOH + j34*CH3CHO + j36*CH3COCHO + 2*j43*GLYALD + 2*j44*GLYOXAL + .67*j45*HONITR + j46*HPALD + j47*HYAC + j48*ISOPNOOH + j49*ISOPOOH + 1.34*j50*MACR + .66*j51*MACR + j56*NC4CHO + j61*PHENOOH + j62*POOH + j64*TEPOMUC + j65*TERP2OOH + j66*TERPNIT + j67*TERPOOH - + j68*TERPROD1 + 1.2*j69*TERPROD2 + j70*TOLOOH + j72*XYLENOOH + j73*XYLOLOOH + r14*O2*M*H - + r49*M*HO2NO2 + r146*HOCH2OO + r176*EO + r177*O2*EO + r250*ISOPBO2 + r10*H2O2*O + r19*OH*H2O2 - + r22*OH*O3 + r38*NO3*OH + r51*CL*CH2O + r54*CL*H2O2 + r58*CLO*CH3O2 + r69*CLO*OH + r87*BR*CH2O - + r99*BRO*OH + r116*CH3BR*CL + r117*CH3BR*OH + r119*CH3CL*CL + r120*CH3CL*OH + r132*CH2O*NO3 - + r133*CH2O*O + 2*r135*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + r142*M*CO*OH - + r143*M*HCN*OH + r144*HCOOH*OH + r147*HOCH2OO*NO + r149*O1D*CH4 + .35*r154*M*C2H2*OH + + j68*TERPROD1 + 1.2*j69*TERPROD2 + j70*TOLOOH + j72*XYLENOOH + j73*XYLOLOOH + r15*O2*M*H + + r50*M*HO2NO2 + r146*HOCH2OO + r176*EO + r177*O2*EO + r250*ISOPBO2 + 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 + r117*CH3BR*CL + r118*CH3BR*OH + r120*CH3CL*CL + r121*CH3CL*OH + r133*CH2O*NO3 + + r134*CH2O*O + 2*r136*CH3O2*CH3O2 + r139*CH3O2*NO + r140*CH3OH*OH + r143*M*HCN*OH + + r144*HCOOH*OH + r147*HOCH2OO*NO + r149*O1D*CH4 + r152*CO*OH + .35*r154*M*C2H2*OH + .13*r156*C2H4*O3 + 1.2*r157*C2H5O2*C2H5O2 + r158*C2H5O2*CH3O2 + r160*C2H5O2*NO + r161*C2H5OH*OH + r167*CH3CN*OH + .9*r169*CH3CO3*CH3O2 + .25*r175*EO2*NO + r178*GLYALD*OH + r179*GLYOXAL*OH + .28*r185*C3H6*O3 + r186*C3H7O2*CH3O2 + r188*C3H7O2*NO + r193*HYAC*OH + r196*PO2*NO @@ -1716,17 +1714,17 @@ Extraneous prod/loss species + .28*r306*TOLUENE*OH + .38*r308*XYLENES*OH + r310*XYLENO2*NO + r313*XYLOLO2*NO + .63*r314*XYLOL*OH + .57*r317*BCARY*O3 + .57*r320*MTERP*O3 + .5*r322*NTERPO2*CH3O2 + r327*TERP2O2*CH3O2 + .9*r329*TERP2O2*NO + r332*TERPO2*CH3O2 + .8*r334*TERPO2*NO - + .2*r338*TERPROD2*OH + .5*r353*DMS*OH + r354*SO2*OH - - r358*HO2 - r11*H*HO2 - r12*H*HO2 - r13*H*HO2 - r15*O*HO2 - r16*O3*HO2 - r20*OH*HO2 - - 2*r25*HO2*HO2 - r35*NO3*HO2 - r40*NO*HO2 - r45*M*NO2*HO2 - r55*CL*HO2 - r56*CL*HO2 - - r62*CLO*HO2 - r88*BR*HO2 - r94*BRO*HO2 - r131*CH2O*HO2 - r137*CH3O2*HO2 - r145*HOCH2OO*HO2 + + .2*r338*TERPROD2*OH + r344*M*SO2*OH + .5*r354*DMS*OH + - r358*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 - r132*CH2O*HO2 - r138*CH3O2*HO2 - r145*HOCH2OO*HO2 - r159*C2H5O2*HO2 - r170*CH3CO3*HO2 - r174*EO2*HO2 - r187*C3H7O2*HO2 - r195*PO2*HO2 - r199*RO2*HO2 - r211*MACRO2*HO2 - r220*MCO3*HO2 - r224*MEKO2*HO2 - r234*ALKO2*HO2 - r244*ISOPAO2*HO2 - r249*ISOPBO2*HO2 - r258*ISOPNO3*HO2 - r269*XO2*HO2 - r273*ACBZO2*HO2 - r276*BENZO2*HO2 - r280*BZOO*HO2 - r283*C6H5O2*HO2 - r287*DICARBO2*HO2 - r290*MALO2*HO2 - r293*MDIALO2*HO2 - r296*PHENO2*HO2 - r303*TOLO2*HO2 - r309*XYLENO2*HO2 - r312*XYLOLO2*HO2 - r323*NTERPO2*HO2 - r328*TERP2O2*HO2 - r333*TERPO2*HO2 - d(HOCH2OO)/dt = r131*CH2O*HO2 + d(HOCH2OO)/dt = r132*CH2O*HO2 - r146*HOCH2OO - r145*HO2*HOCH2OO - r147*NO*HOCH2OO d(ISOPAO2)/dt = .6*r263*ISOP*OH - r242*CH3CO3*ISOPAO2 - r243*CH3O2*ISOPAO2 - r244*HO2*ISOPAO2 - r245*NO*ISOPAO2 @@ -1755,44 +1753,44 @@ Extraneous prod/loss species d(NTERPO2)/dt = r316*BCARY*NO3 + r319*MTERP*NO3 + r326*NTERPOOH*OH + .5*r336*TERPROD1*NO3 - r322*CH3O2*NTERPO2 - r323*HO2*NTERPO2 - r324*NO*NTERPO2 - r325*NO3*NTERPO2 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 - r43*N2O*O1D - r44*N2O*O1D - - r76*CCL4*O1D - r77*CF2CLBR*O1D - r78*CFC11*O1D - r79*CFC113*O1D - r80*CFC114*O1D - - r81*CFC115*O1D - r82*CFC12*O1D - r83*HCL*O1D - r84*HCL*O1D - r103*CF3BR*O1D - r104*CHBR3*O1D - - r105*H2402*O1D - r106*HBR*O1D - r107*HBR*O1D - r112*COF2*O1D - r113*COFCL*O1D - - r126*CH2BR2*O1D - r127*CH3BR*O1D - r128*HCFC141B*O1D - r129*HCFC142B*O1D - r130*HCFC22*O1D + - r4*N2*O1D - r5*O2*O1D - r2*H2*O1D - r3*H2O*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 - r113*COF2*O1D - r114*COFCL*O1D + - r127*CH2BR2*O1D - r128*CH3BR*O1D - r129*HCFC141B*O1D - r130*HCFC142B*O1D - r131*HCFC22*O1D - r148*CH4*O1D - r149*CH4*O1D - r150*CH4*O1D - r151*HCN*O1D d(OH)/dt = j2*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j20*ALKOOH + j21*BENZOOH + j28*BZOOH + j29*C2H5OOH - + j30*C3H7OOH + j31*C6H5OOH + j37*CH3COOOH + j38*CH3OOH + .33*j40*CH4 + j42*EOOH + j46*HPALD - + j53*MEKOOH + j58*NTERPOOH + j61*PHENOOH + j62*POOH + j63*ROOH + j65*TERP2OOH + j67*TERPOOH - + j70*TOLOOH + j71*XOOH + j72*XYLENOOH + j73*XYLOLOOH + j105*HOBR + j106*HOCL + .5*r366*NO2 - + r1*O1D*H2 + 2*r2*O1D*H2O + r9*H2*O + r10*H2O2*O + 2*r12*H*HO2 + r15*HO2*O + r16*HO2*O3 - + r17*H*O3 + r35*NO3*HO2 + r40*NO*HO2 + r56*CL*HO2 + r71*HCL*O + r74*HOCL*O + r83*O1D*HCL - + r100*HBR*O + r102*HOBR*O + r106*O1D*HBR + r110*F*H2O + r133*CH2O*O + .3*r140*CH3OOH*OH - + r148*O1D*CH4 + r151*O1D*HCN + .65*r154*M*C2H2*OH + .13*r156*C2H4*O3 + .5*r162*C2H5OOH*OH - + .45*r170*CH3CO3*HO2 + .36*r185*C3H6*O3 + .5*r197*POOH*OH + .15*r199*RO2*HO2 + .24*r215*MACR*O3 - + .1*r217*MACROOH*OH + .45*r220*MCO3*HO2 + .2*r224*MEKO2*HO2 + .36*r229*MVK*O3 + .32*r262*ISOP*O3 - + .6*r264*ISOPOOH*OH + .5*r272*XOOH*OH + .4*r273*ACBZO2*HO2 + .4*r287*DICARBO2*HO2 - + .4*r293*MDIALO2*HO2 + .63*r317*BCARY*O3 + .63*r320*MTERP*O3 - - r18*H2*OH - r19*H2O2*OH - r20*HO2*OH - r21*O*OH - r22*O3*OH - 2*r23*OH*OH - 2*r24*M*OH*OH - - r26*HO2NO2*OH - r38*NO3*OH - r39*N*OH - r47*M*NO2*OH - r48*HNO3*OH - r67*CLONO2*OH - - r69*CLO*OH - r70*CLO*OH - r72*HCL*OH - r75*HOCL*OH - r99*BRO*OH - r101*HBR*OH - r115*CH2BR2*OH - - r117*CH3BR*OH - r118*CH3CCL3*OH - r120*CH3CL*OH - r122*CHBR3*OH - r123*HCFC141B*OH - - r124*HCFC142B*OH - r125*HCFC22*OH - r134*CH2O*OH - r139*CH3OH*OH - r140*CH3OOH*OH - r141*CH4*OH - - r142*M*CO*OH - r143*M*HCN*OH - r144*HCOOH*OH - r152*CO*OH - r154*M*C2H2*OH - r161*C2H5OH*OH - - r162*C2H5OOH*OH - r164*C2H6*OH - r166*CH3CHO*OH - r167*CH3CN*OH - r172*CH3COOH*OH - - r173*CH3COOOH*OH - r178*GLYALD*OH - r179*GLYOXAL*OH - r180*PAN*OH - r181*M*C2H4*OH - - r189*C3H7OOH*OH - r190*C3H8*OH - r192*CH3COCHO*OH - r193*HYAC*OH - r194*NOA*OH - r197*POOH*OH - - r201*ROOH*OH - r202*M*C3H6*OH - r203*CH3COCH3*OH - r205*BIGENE*OH - r208*HONITR*OH - - r216*MACR*OH - r217*MACROOH*OH - r226*MEK*OH - r227*MEKOOH*OH - r228*M*MPAN*OH - r230*MVK*OH - - r233*ALKNIT*OH - r237*ALKOOH*OH - r238*BIGALK*OH - r239*HPALD*OH - r240*HYDRALD*OH - - r241*IEPOX*OH - r253*ISOPNITA*OH - r254*ISOPNITB*OH - r261*ISOPNOOH*OH - r263*ISOP*OH - - r264*ISOPOOH*OH - r265*NC4CH2OH*OH - r266*NC4CHO*OH - r272*XOOH*OH - r275*BENZENE*OH - - r278*BENZOOH*OH - r279*BZALD*OH - r281*BZOOH*OH - r285*C6H5OOH*OH - r286*CRESOL*OH - - r298*PHENOL*OH - r301*PHENOOH*OH - r305*TOLOOH*OH - r306*TOLUENE*OH - r308*XYLENES*OH - - r311*XYLENOOH*OH - r314*XYLOL*OH - r315*XYLOLOOH*OH - r318*BCARY*OH - r321*MTERP*OH - - r326*NTERPOOH*OH - r330*TERP2OOH*OH - r331*TERPNIT*OH - r335*TERPOOH*OH - r337*TERPROD1*OH - - r338*TERPROD2*OH - r340*DMS*OH - r342*OCS*OH - r347*S*OH - r352*SO*OH - r353*DMS*OH - - r354*SO2*OH - r356*NH3*OH + + j30*C3H7OOH + j31*C6H5OOH + j37*CH3COOOH + j38*CH3OOH + .33*j39*CH4 + j42*EOOH + j46*HPALD + + j49*ISOPOOH + j53*MEKOOH + j58*NTERPOOH + j61*PHENOOH + j62*POOH + j63*ROOH + j65*TERP2OOH + + j67*TERPOOH + j70*TOLOOH + j71*XOOH + j72*XYLENOOH + j73*XYLOLOOH + j105*HOBR + j106*HOCL + + .5*r366*NO2 + r2*O1D*H2 + 2*r3*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 + r111*F*H2O + r134*CH2O*O + + .3*r141*CH3OOH*OH + r148*O1D*CH4 + r151*O1D*HCN + .65*r154*M*C2H2*OH + .13*r156*C2H4*O3 + + .5*r162*C2H5OOH*OH + .45*r170*CH3CO3*HO2 + .36*r185*C3H6*O3 + .5*r197*POOH*OH + .15*r199*RO2*HO2 + + .24*r215*MACR*O3 + .1*r217*MACROOH*OH + .45*r220*MCO3*HO2 + .2*r224*MEKO2*HO2 + .36*r229*MVK*O3 + + .32*r262*ISOP*O3 + .6*r264*ISOPOOH*OH + .5*r272*XOOH*OH + .4*r273*ACBZO2*HO2 + + .4*r287*DICARBO2*HO2 + .4*r293*MDIALO2*HO2 + .63*r317*BCARY*O3 + .63*r320*MTERP*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 + - r116*CH2BR2*OH - r118*CH3BR*OH - r119*CH3CCL3*OH - r121*CH3CL*OH - r123*CHBR3*OH + - r124*HCFC141B*OH - r125*HCFC142B*OH - r126*HCFC22*OH - r135*CH2O*OH - r140*CH3OH*OH + - r141*CH3OOH*OH - r142*CH4*OH - r143*M*HCN*OH - r144*HCOOH*OH - r152*CO*OH - r154*M*C2H2*OH + - r161*C2H5OH*OH - r162*C2H5OOH*OH - r164*C2H6*OH - r166*CH3CHO*OH - r167*CH3CN*OH + - r172*CH3COOH*OH - r173*CH3COOOH*OH - r178*GLYALD*OH - r179*GLYOXAL*OH - r180*PAN*OH + - r181*M*C2H4*OH - r189*C3H7OOH*OH - r190*C3H8*OH - r192*CH3COCHO*OH - r193*HYAC*OH - r194*NOA*OH + - r197*POOH*OH - r201*ROOH*OH - r202*M*C3H6*OH - r203*CH3COCH3*OH - r205*BIGENE*OH + - r208*HONITR*OH - r216*MACR*OH - r217*MACROOH*OH - r226*MEK*OH - r227*MEKOOH*OH - r228*M*MPAN*OH + - r230*MVK*OH - r233*ALKNIT*OH - r237*ALKOOH*OH - r238*BIGALK*OH - r239*HPALD*OH + - r240*HYDRALD*OH - r241*IEPOX*OH - r253*ISOPNITA*OH - r254*ISOPNITB*OH - r261*ISOPNOOH*OH + - r263*ISOP*OH - r264*ISOPOOH*OH - r265*NC4CH2OH*OH - r266*NC4CHO*OH - r272*XOOH*OH + - r275*BENZENE*OH - r278*BENZOOH*OH - r279*BZALD*OH - r281*BZOOH*OH - r285*C6H5OOH*OH + - r286*CRESOL*OH - r298*PHENOL*OH - r301*PHENOOH*OH - r305*TOLOOH*OH - r306*TOLUENE*OH + - r308*XYLENES*OH - r311*XYLENOOH*OH - r314*XYLOL*OH - r315*XYLOLOOH*OH - r318*BCARY*OH + - r321*MTERP*OH - r326*NTERPOOH*OH - r330*TERP2OOH*OH - r331*TERPNIT*OH - r335*TERPOOH*OH + - r337*TERPROD1*OH - r338*TERPROD2*OH - r340*DMS*OH - r342*OCS*OH - r344*M*SO2*OH - r348*S*OH + - r353*SO*OH - r354*DMS*OH - r356*NH3*OH d(PHENO2)/dt = .2*r286*CRESOL*OH + .14*r298*PHENOL*OH + r301*PHENOOH*OH - r296*HO2*PHENO2 - r297*NO*PHENO2 d(PO2)/dt = .5*r197*POOH*OH + r202*M*C3H6*OH @@ -1816,11 +1814,11 @@ Extraneous prod/loss species - r397*HO2*XYLEO2VBS - r398*NO*XYLEO2VBS d(XYLOLO2)/dt = .3*r314*XYLOL*OH + r315*XYLOLOOH*OH - r312*HO2*XYLOLO2 - r313*NO*XYLOLO2 - d(H2O)/dt = .05*j40*CH4 + j109*H2SO4 + r13*H*HO2 + r18*OH*H2 + r19*OH*H2O2 + r20*OH*HO2 + r23*OH*OH - + r26*HO2NO2*OH + r48*HNO3*OH + r72*HCL*OH + r75*HOCL*OH + r101*HBR*OH + r115*CH2BR2*OH - + r117*CH3BR*OH + r118*CH3CCL3*OH + r120*CH3CL*OH + r125*HCFC22*OH + r134*CH2O*OH - + r140*CH3OOH*OH + r141*CH4*OH + r144*HCOOH*OH + r164*C2H6*OH + r166*CH3CHO*OH + r172*CH3COOH*OH - + r173*CH3COOOH*OH + r189*C3H7OOH*OH + r190*C3H8*OH + r192*CH3COCHO*OH + r197*POOH*OH - + r201*ROOH*OH + r203*CH3COCH3*OH + .5*r216*MACR*OH + r356*NH3*OH + r400*HOCL*HCL + d(H2O)/dt = .05*j39*CH4 + j109*H2SO4 + r358*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 + + r116*CH2BR2*OH + r118*CH3BR*OH + r119*CH3CCL3*OH + r121*CH3CL*OH + r126*HCFC22*OH + + r135*CH2O*OH + r141*CH3OOH*OH + r142*CH4*OH + r144*HCOOH*OH + r164*C2H6*OH + r166*CH3CHO*OH + + r172*CH3COOH*OH + r173*CH3COOOH*OH + r189*C3H7OOH*OH + r190*C3H8*OH + r192*CH3COCHO*OH + + r197*POOH*OH + r201*ROOH*OH + r203*CH3COCH3*OH + .5*r216*MACR*OH + r356*NH3*OH + r400*HOCL*HCL + r406*HOCL*HCL + r407*HOBR*HCL + r411*HOCL*HCL + r412*HOBR*HCL - - j1*H2O - j2*H2O - j3*H2O - r2*O1D*H2O - r110*F*H2O - r355*SO3*H2O + - j1*H2O - j2*H2O - j3*H2O - r3*O1D*H2O - r111*F*H2O - r355*SO3*H2O diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in index 1f658359c0..e275d43ed4 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in +++ b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mech.in @@ -1,11 +1,11 @@ * Comments -* User-given Tag Description: TS1.1-simple-NOxdep-VBS -* Tag database identifier : MZ272_TS1.1_simpleVBS_20200302 +* User-given Tag Description: TS1.2-simpleVBS +* Tag database identifier : MZ316_TS1.2_20221220 * Tag created by : lke -* Tag created from branch : TS1.1-simpleVBS -* Tag created on : 2020-03-02 16:38:42.063276-07 +* Tag created from branch : TS1.2 +* Tag created on : 2022-12-20 13:49:25.762835-07 * Comments for this tag follow: -* lke : 2020-03-02 : Update VBS-SOA for NOx-dependence +* lke : 2022-12-20 : TS1 with JPL19 updates, NOx-dependent VBS-SOA SPECIES @@ -301,35 +301,6 @@ Solution classes Explicit - AOA_NH - BRY - CCL4 - CF2CLBR - CF3BR - CFC11 - CFC113 - CFC114 - CFC115 - CFC12 - CH2BR2 - CH3BR - CH3CCL3 - CH3CL - CH4 - CHBR3 - CLY - CO2 - E90 - H2402 - HCFC141B - HCFC142B - HCFC22 - N2O - NH_5 - NH_50 - O3S - SF6 - ST80_25 NHDEP NDEP End Explicit @@ -337,6 +308,7 @@ Implicit ALKNIT ALKOOH + AOA_NH bc_a1 bc_a4 BCARY @@ -354,6 +326,7 @@ BRCL BRO BRONO2 + BRY BZALD BZOOH C2H2 @@ -365,8 +338,20 @@ C3H7OOH C3H8 C6H5OOH + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 CH2O + CH3BR + CH3CCL3 CH3CHO + CH3CL CH3CN CH3COCH3 CH3COCHO @@ -374,12 +359,16 @@ CH3COOOH CH3OH CH3OOH + CH4 + CHBR3 CL CL2 CL2O2 CLO CLONO2 + CLY CO + CO2 COF2 COFCL CRESOL @@ -387,15 +376,20 @@ dst_a1 dst_a2 dst_a3 + E90 EOOH F GLYALD GLYOXAL H H2 + H2402 H2O2 H2SO4 HBR + HCFC141B + HCFC142B + HCFC22 HCL HCN HCOOH @@ -424,6 +418,7 @@ MTERP MVK N + N2O N2O5 NC4CH2OH NC4CHO @@ -432,6 +427,8 @@ ncl_a3 NH3 NH4 + NH_5 + NH_50 NO NO2 NO3 @@ -443,6 +440,7 @@ num_a4 O O3 + O3S OCLO OCS ONITR @@ -456,6 +454,7 @@ POOH ROOH S + SF6 SO SO2 SO3 @@ -477,6 +476,7 @@ SOAG2 SOAG3 SOAG4 + ST80_25 SVOC TEPOMUC TERP2OOH @@ -580,15 +580,15 @@ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 [jc6h5ooh->,jch3ooh] C6H5OOH + hv -> PHENO + OH -[jch2o_a] CH2O + hv -> CO + 2*H [jch2o_b] CH2O + hv -> CO + H2 +[jch2o_a] CH2O + hv -> CO + 2*H [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_a] CH4 + hv -> H + CH3O2 [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 @@ -597,7 +597,7 @@ [jhpald->,.006*jno2] HPALD + hv -> BIGALD3 + OH + HO2 [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O [jisopnooh->,jch3ooh] ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH -[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + 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 [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 @@ -685,6 +685,10 @@ Reactions ********************************* +*** Not Assigned to a Section +********************************* +[E90_tau] E90 -> ; 1.29e-07 +********************************* *** odd-oxygen ********************************* [O1D_H2] O1D + H2 -> H + OH ; 1.2e-10 @@ -703,7 +707,7 @@ [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 ; 4.4e-32, 1.3, 7.5e-11, -0.2, 0.6 +[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 @@ -718,21 +722,21 @@ ********************************* *** odd-nitrogen ********************************* -[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 +[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 ; 1.5e-11, -3600 +[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.5e-11, 170 -[NO3_O] NO3 + O -> NO2 + O2 ; 1e-11 +[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.3e-12, 270 +[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 @@ -849,8 +853,7 @@ [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 -[CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.9e-33, 1, 1.1e-12, -1.3, 0.6 -[HCN_OH] HCN + OH + M -> HO2 + M ; 4.28e-33, 0, 9.3e-15, -4.42, 0.8 +[HCN_OH] HCN + OH + M -> HO2 + M ; 6.1e-33, 1.5, 9.8e-15, -4.6, 0.8 [HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4e-13 [HOCH2OO_HO2] HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 [HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.4e+12, -7000 @@ -859,7 +862,7 @@ [O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.5e-11 [O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9e-12 [O1D_HCN] O1D + HCN -> OH ; 1.08e-10, 105 -[usr_CO_OH_b] CO + OH -> CO2 + H +[usr_CO_OH] CO + OH -> CO2 + HO2 ********************************* *** C2 ********************************* @@ -882,7 +885,7 @@ [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 ; 7e-13 +[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 @@ -892,7 +895,7 @@ [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 ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[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 @@ -903,7 +906,7 @@ [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 ; 8.7e-12, -615 +[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 @@ -947,7 +950,7 @@ [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 -[usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M +[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 @@ -1068,10 +1071,11 @@ *** Sulfur ********************************* [DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 -[DMS_OHa] DMS + OH -> SO2 ; 9.6e-12, -234 +[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 @@ -1080,16 +1084,15 @@ [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.7e-11, 335 +[SO_OH] SO + OH -> SO2 + H ; 2.6e-11, 330 [usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 -[usr_SO2_OH] SO2 + OH -> SO3 + HO2 [usr_SO3_H2O] SO3 + H2O -> H2SO4 ********************************* *** Tropospheric Aerosol ********************************* [NH3_OH] NH3 + OH -> H2O + 1*NHDEP ; 1.7e-12, -710 [usr_GLYOXAL_aer] GLYOXAL -> SOAG0 -[usr_HO2_aer] HO2 -> 0.5*H2O2 +[usr_HO2_aer] HO2 -> H2O [usr_HONITR_aer] HONITR -> HNO3 [usr_ISOPNITA_aer] ISOPNITA -> HNO3 [usr_ISOPNITB_aer] ISOPNITB -> HNO3 @@ -1109,8 +1112,8 @@ [BCARYO2_HO2_vbs] BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 2.75e-13, 1300 [BCARYO2_NO_vbs] BCARYO2VBS + NO -> NO + 0.1279*SOAG0 + 0.1792*SOAG1 + 0.0676*SOAG2 + 0.079*SOAG3 + 0.1254*SOAG4 ; 2.7e-12, 360 [BCARY_O3_vbs] BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 1.2e-14 -[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + BCARYO2VBS ; 2e-10 -[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + BENZO2VBS ; 2.3e-12, -193 +[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + BCARYO2VBS ; 2e-10 +[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + BENZO2VBS ; 2.3e-12, -193 [BENZO2_HO2_vbs] BENZO2VBS + HO2 -> HO2 + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 + 0.0443*SOAG3 + 0.1621*SOAG4 ; 7.5e-13, 700 [BENZO2_NO_vbs] BENZO2VBS + NO -> NO + 0.0097*SOAG0 + 0.0034*SOAG1 + 0.1579*SOAG2 + 0.0059*SOAG3 + 0.0536*SOAG4 ; 2.6e-12, 365 [ISOP_NO3_vbs] ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 ; 3.03e-12, -446 @@ -1156,28 +1159,25 @@ ********************************* *** 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 - so4_a1 <- dataset - bc_a4 <- dataset - SVOC <- dataset - bc_a1 <- dataset - CO <- dataset - NO <- dataset - NO2 <- dataset num_a1 <- dataset num_a2 <- dataset - num_a4 <- dataset - pom_a1 <- dataset - pom_a4 <- dataset + so4_a1 <- dataset so4_a2 <- dataset + num_a4 <- dataset SO2 <- dataset + NO2 <- dataset + pom_a4 <- dataset + bc_a4 <- dataset + CO <- dataset + SVOC <- dataset AOA_NH + NO N End Ext Forcing diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 index 9af6c6de37..34b785fa88 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/chem_mods.F90 @@ -6,24 +6,24 @@ module chem_mods implicit none save integer, parameter :: phtcnt = 123, & ! number of photolysis reactions - rxntot = 542, & ! number of total reactions - gascnt = 419, & ! number of gas phase reactions + rxntot = 541, & ! number of total reactions + gascnt = 418, & ! number of gas phase reactions nabscol = 2, & ! number of absorbing column densities gas_pcnst = 229, & ! number of "gas phase" species nfs = 3, & ! number of "fixed" species relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members - nzcnt = 2080, & ! number of non-zero matrix entries - extcnt = 16, & ! number of species with external forcing - clscnt1 = 31, & ! number of species in explicit class + nzcnt = 2285, & ! number of non-zero matrix entries + extcnt = 14, & ! 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 = 198, & ! number of species in implicit class + clscnt4 = 227, & ! 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 = 542, & + rxt_tag_cnt = 541, & enthalpy_cnt = 18, & nslvd = 41 integer :: clscnt(5) = 0 diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 index 9095e34a68..46c4932def 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/m_rxt_id.F90 @@ -31,15 +31,15 @@ module m_rxt_id integer, parameter :: rid_jc2h5ooh = 29 integer, parameter :: rid_jc3h7ooh = 30 integer, parameter :: rid_jc6h5ooh = 31 - integer, parameter :: rid_jch2o_a = 32 - integer, parameter :: rid_jch2o_b = 33 + integer, parameter :: rid_jch2o_b = 32 + integer, parameter :: rid_jch2o_a = 33 integer, parameter :: rid_jch3cho = 34 integer, parameter :: rid_jacet = 35 integer, parameter :: rid_jmgly = 36 integer, parameter :: rid_jch3co3h = 37 integer, parameter :: rid_jch3ooh = 38 - integer, parameter :: rid_jch4_a = 39 - integer, parameter :: rid_jch4_b = 40 + integer, parameter :: rid_jch4_b = 39 + integer, parameter :: rid_jch4_a = 40 integer, parameter :: rid_jco2 = 41 integer, parameter :: rid_jeooh = 42 integer, parameter :: rid_jglyald = 43 @@ -123,148 +123,148 @@ module m_rxt_id integer, parameter :: rid_jsoa4_a2 = 121 integer, parameter :: rid_jsoa5_a1 = 122 integer, parameter :: rid_jsoa5_a2 = 123 - integer, parameter :: rid_O1D_H2 = 124 - integer, parameter :: rid_O1D_H2O = 125 - integer, parameter :: rid_O1D_N2 = 126 - integer, parameter :: rid_O1D_O2ab = 127 - integer, parameter :: rid_O1D_O3 = 128 - integer, parameter :: rid_O_O3 = 129 - integer, parameter :: rid_usr_O_O = 130 - integer, parameter :: rid_usr_O_O2 = 131 - integer, parameter :: rid_H2_O = 132 - integer, parameter :: rid_H2O2_O = 133 - integer, parameter :: rid_H_HO2 = 134 - integer, parameter :: rid_H_HO2a = 135 - integer, parameter :: rid_H_HO2b = 136 - integer, parameter :: rid_H_O2 = 137 - integer, parameter :: rid_HO2_O = 138 - integer, parameter :: rid_HO2_O3 = 139 - integer, parameter :: rid_H_O3 = 140 - integer, parameter :: rid_OH_H2 = 141 - integer, parameter :: rid_OH_H2O2 = 142 - integer, parameter :: rid_OH_HO2 = 143 - integer, parameter :: rid_OH_O = 144 - integer, parameter :: rid_OH_O3 = 145 - integer, parameter :: rid_OH_OH = 146 - integer, parameter :: rid_OH_OH_M = 147 - integer, parameter :: rid_usr_HO2_HO2 = 148 - integer, parameter :: rid_HO2NO2_OH = 149 - integer, parameter :: rid_N_NO = 150 - integer, parameter :: rid_N_NO2a = 151 - integer, parameter :: rid_N_NO2b = 152 - integer, parameter :: rid_N_NO2c = 153 - integer, parameter :: rid_N_O2 = 154 - integer, parameter :: rid_NO2_O = 155 - integer, parameter :: rid_NO2_O3 = 156 - integer, parameter :: rid_NO2_O_M = 157 - integer, parameter :: rid_NO3_HO2 = 158 - integer, parameter :: rid_NO3_NO = 159 - integer, parameter :: rid_NO3_O = 160 - integer, parameter :: rid_NO3_OH = 161 - integer, parameter :: rid_N_OH = 162 - integer, parameter :: rid_NO_HO2 = 163 - integer, parameter :: rid_NO_O3 = 164 - integer, parameter :: rid_NO_O_M = 165 - integer, parameter :: rid_O1D_N2Oa = 166 - integer, parameter :: rid_O1D_N2Ob = 167 - integer, parameter :: rid_tag_NO2_HO2 = 168 - integer, parameter :: rid_tag_NO2_NO3 = 169 - integer, parameter :: rid_tag_NO2_OH = 170 - integer, parameter :: rid_usr_HNO3_OH = 171 - integer, parameter :: rid_usr_HO2NO2_M = 172 - integer, parameter :: rid_usr_N2O5_M = 173 - integer, parameter :: rid_CL_CH2O = 174 - integer, parameter :: rid_CL_CH4 = 175 - integer, parameter :: rid_CL_H2 = 176 - integer, parameter :: rid_CL_H2O2 = 177 - integer, parameter :: rid_CL_HO2a = 178 - integer, parameter :: rid_CL_HO2b = 179 - integer, parameter :: rid_CL_O3 = 180 - integer, parameter :: rid_CLO_CH3O2 = 181 - integer, parameter :: rid_CLO_CLOa = 182 - integer, parameter :: rid_CLO_CLOb = 183 - integer, parameter :: rid_CLO_CLOc = 184 - integer, parameter :: rid_CLO_HO2 = 185 - integer, parameter :: rid_CLO_NO = 186 - integer, parameter :: rid_CLONO2_CL = 187 - integer, parameter :: rid_CLO_NO2_M = 188 - integer, parameter :: rid_CLONO2_O = 189 - integer, parameter :: rid_CLONO2_OH = 190 - integer, parameter :: rid_CLO_O = 191 - integer, parameter :: rid_CLO_OHa = 192 - integer, parameter :: rid_CLO_OHb = 193 - integer, parameter :: rid_HCL_O = 194 - integer, parameter :: rid_HCL_OH = 195 - integer, parameter :: rid_HOCL_CL = 196 - integer, parameter :: rid_HOCL_O = 197 - integer, parameter :: rid_HOCL_OH = 198 - integer, parameter :: rid_O1D_CCL4 = 199 - integer, parameter :: rid_O1D_CF2CLBR = 200 - integer, parameter :: rid_O1D_CFC11 = 201 - integer, parameter :: rid_O1D_CFC113 = 202 - integer, parameter :: rid_O1D_CFC114 = 203 - integer, parameter :: rid_O1D_CFC115 = 204 - integer, parameter :: rid_O1D_CFC12 = 205 - integer, parameter :: rid_O1D_HCLa = 206 - integer, parameter :: rid_O1D_HCLb = 207 - integer, parameter :: rid_tag_CLO_CLO_M = 208 - integer, parameter :: rid_usr_CL2O2_M = 209 - integer, parameter :: rid_BR_CH2O = 210 - integer, parameter :: rid_BR_HO2 = 211 - integer, parameter :: rid_BR_O3 = 212 - integer, parameter :: rid_BRO_BRO = 213 - integer, parameter :: rid_BRO_CLOa = 214 - integer, parameter :: rid_BRO_CLOb = 215 - integer, parameter :: rid_BRO_CLOc = 216 - integer, parameter :: rid_BRO_HO2 = 217 - integer, parameter :: rid_BRO_NO = 218 - integer, parameter :: rid_BRO_NO2_M = 219 - integer, parameter :: rid_BRONO2_O = 220 - integer, parameter :: rid_BRO_O = 221 - integer, parameter :: rid_BRO_OH = 222 - integer, parameter :: rid_HBR_O = 223 - integer, parameter :: rid_HBR_OH = 224 - integer, parameter :: rid_HOBR_O = 225 - integer, parameter :: rid_O1D_CF3BR = 226 - integer, parameter :: rid_O1D_CHBR3 = 227 - integer, parameter :: rid_O1D_H2402 = 228 - integer, parameter :: rid_O1D_HBRa = 229 - integer, parameter :: rid_O1D_HBRb = 230 - integer, parameter :: rid_F_CH4 = 231 - integer, parameter :: rid_F_H2 = 232 - integer, parameter :: rid_F_H2O = 233 - integer, parameter :: rid_F_HNO3 = 234 - integer, parameter :: rid_O1D_COF2 = 235 - integer, parameter :: rid_O1D_COFCL = 236 - integer, parameter :: rid_CH2BR2_CL = 237 - integer, parameter :: rid_CH2BR2_OH = 238 - integer, parameter :: rid_CH3BR_CL = 239 - integer, parameter :: rid_CH3BR_OH = 240 - integer, parameter :: rid_CH3CCL3_OH = 241 - integer, parameter :: rid_CH3CL_CL = 242 - integer, parameter :: rid_CH3CL_OH = 243 - integer, parameter :: rid_CHBR3_CL = 244 - integer, parameter :: rid_CHBR3_OH = 245 - integer, parameter :: rid_HCFC141B_OH = 246 - integer, parameter :: rid_HCFC142B_OH = 247 - integer, parameter :: rid_HCFC22_OH = 248 - integer, parameter :: rid_O1D_CH2BR2 = 249 - integer, parameter :: rid_O1D_CH3BR = 250 - integer, parameter :: rid_O1D_HCFC141B = 251 - integer, parameter :: rid_O1D_HCFC142B = 252 - integer, parameter :: rid_O1D_HCFC22 = 253 - integer, parameter :: rid_CH2O_HO2 = 254 - integer, parameter :: rid_CH2O_NO3 = 255 - integer, parameter :: rid_CH2O_O = 256 - integer, parameter :: rid_CH2O_OH = 257 - integer, parameter :: rid_CH3O2_CH3O2a = 258 - integer, parameter :: rid_CH3O2_CH3O2b = 259 - integer, parameter :: rid_CH3O2_HO2 = 260 - integer, parameter :: rid_CH3O2_NO = 261 - integer, parameter :: rid_CH3OH_OH = 262 - integer, parameter :: rid_CH3OOH_OH = 263 - integer, parameter :: rid_CH4_OH = 264 - integer, parameter :: rid_CO_OH_M = 265 + integer, parameter :: rid_E90_tau = 124 + integer, parameter :: rid_O1D_H2 = 125 + integer, parameter :: rid_O1D_H2O = 126 + integer, parameter :: rid_O1D_N2 = 127 + integer, parameter :: rid_O1D_O2ab = 128 + integer, parameter :: rid_O1D_O3 = 129 + integer, parameter :: rid_O_O3 = 130 + integer, parameter :: rid_usr_O_O = 131 + integer, parameter :: rid_usr_O_O2 = 132 + integer, parameter :: rid_H2_O = 133 + integer, parameter :: rid_H2O2_O = 134 + integer, parameter :: rid_H_HO2 = 135 + integer, parameter :: rid_H_HO2a = 136 + integer, parameter :: rid_H_HO2b = 137 + integer, parameter :: rid_H_O2 = 138 + integer, parameter :: rid_HO2_O = 139 + integer, parameter :: rid_HO2_O3 = 140 + integer, parameter :: rid_H_O3 = 141 + integer, parameter :: rid_OH_H2 = 142 + integer, parameter :: rid_OH_H2O2 = 143 + integer, parameter :: rid_OH_HO2 = 144 + integer, parameter :: rid_OH_O = 145 + integer, parameter :: rid_OH_O3 = 146 + integer, parameter :: rid_OH_OH = 147 + integer, parameter :: rid_OH_OH_M = 148 + integer, parameter :: rid_usr_HO2_HO2 = 149 + integer, parameter :: rid_HO2NO2_OH = 150 + integer, parameter :: rid_N_NO = 151 + integer, parameter :: rid_N_NO2a = 152 + integer, parameter :: rid_N_NO2b = 153 + integer, parameter :: rid_N_NO2c = 154 + integer, parameter :: rid_N_O2 = 155 + integer, parameter :: rid_NO2_O = 156 + integer, parameter :: rid_NO2_O3 = 157 + integer, parameter :: rid_NO2_O_M = 158 + integer, parameter :: rid_NO3_HO2 = 159 + integer, parameter :: rid_NO3_NO = 160 + integer, parameter :: rid_NO3_O = 161 + integer, parameter :: rid_NO3_OH = 162 + integer, parameter :: rid_N_OH = 163 + integer, parameter :: rid_NO_HO2 = 164 + integer, parameter :: rid_NO_O3 = 165 + integer, parameter :: rid_NO_O_M = 166 + integer, parameter :: rid_O1D_N2Oa = 167 + integer, parameter :: rid_O1D_N2Ob = 168 + integer, parameter :: rid_tag_NO2_HO2 = 169 + integer, parameter :: rid_tag_NO2_NO3 = 170 + integer, parameter :: rid_tag_NO2_OH = 171 + integer, parameter :: rid_usr_HNO3_OH = 172 + integer, parameter :: rid_usr_HO2NO2_M = 173 + integer, parameter :: rid_usr_N2O5_M = 174 + integer, parameter :: rid_CL_CH2O = 175 + integer, parameter :: rid_CL_CH4 = 176 + integer, parameter :: rid_CL_H2 = 177 + integer, parameter :: rid_CL_H2O2 = 178 + integer, parameter :: rid_CL_HO2a = 179 + integer, parameter :: rid_CL_HO2b = 180 + integer, parameter :: rid_CL_O3 = 181 + integer, parameter :: rid_CLO_CH3O2 = 182 + integer, parameter :: rid_CLO_CLOa = 183 + integer, parameter :: rid_CLO_CLOb = 184 + integer, parameter :: rid_CLO_CLOc = 185 + integer, parameter :: rid_CLO_HO2 = 186 + integer, parameter :: rid_CLO_NO = 187 + integer, parameter :: rid_CLONO2_CL = 188 + integer, parameter :: rid_CLO_NO2_M = 189 + integer, parameter :: rid_CLONO2_O = 190 + integer, parameter :: rid_CLONO2_OH = 191 + integer, parameter :: rid_CLO_O = 192 + integer, parameter :: rid_CLO_OHa = 193 + integer, parameter :: rid_CLO_OHb = 194 + integer, parameter :: rid_HCL_O = 195 + integer, parameter :: rid_HCL_OH = 196 + integer, parameter :: rid_HOCL_CL = 197 + integer, parameter :: rid_HOCL_O = 198 + integer, parameter :: rid_HOCL_OH = 199 + integer, parameter :: rid_O1D_CCL4 = 200 + integer, parameter :: rid_O1D_CF2CLBR = 201 + integer, parameter :: rid_O1D_CFC11 = 202 + integer, parameter :: rid_O1D_CFC113 = 203 + integer, parameter :: rid_O1D_CFC114 = 204 + integer, parameter :: rid_O1D_CFC115 = 205 + integer, parameter :: rid_O1D_CFC12 = 206 + integer, parameter :: rid_O1D_HCLa = 207 + integer, parameter :: rid_O1D_HCLb = 208 + integer, parameter :: rid_tag_CLO_CLO_M = 209 + integer, parameter :: rid_usr_CL2O2_M = 210 + integer, parameter :: rid_BR_CH2O = 211 + integer, parameter :: rid_BR_HO2 = 212 + integer, parameter :: rid_BR_O3 = 213 + integer, parameter :: rid_BRO_BRO = 214 + integer, parameter :: rid_BRO_CLOa = 215 + integer, parameter :: rid_BRO_CLOb = 216 + integer, parameter :: rid_BRO_CLOc = 217 + integer, parameter :: rid_BRO_HO2 = 218 + integer, parameter :: rid_BRO_NO = 219 + integer, parameter :: rid_BRO_NO2_M = 220 + integer, parameter :: rid_BRONO2_O = 221 + integer, parameter :: rid_BRO_O = 222 + integer, parameter :: rid_BRO_OH = 223 + integer, parameter :: rid_HBR_O = 224 + integer, parameter :: rid_HBR_OH = 225 + integer, parameter :: rid_HOBR_O = 226 + integer, parameter :: rid_O1D_CF3BR = 227 + integer, parameter :: rid_O1D_CHBR3 = 228 + integer, parameter :: rid_O1D_H2402 = 229 + integer, parameter :: rid_O1D_HBRa = 230 + integer, parameter :: rid_O1D_HBRb = 231 + integer, parameter :: rid_F_CH4 = 232 + integer, parameter :: rid_F_H2 = 233 + integer, parameter :: rid_F_H2O = 234 + integer, parameter :: rid_F_HNO3 = 235 + integer, parameter :: rid_O1D_COF2 = 236 + integer, parameter :: rid_O1D_COFCL = 237 + integer, parameter :: rid_CH2BR2_CL = 238 + integer, parameter :: rid_CH2BR2_OH = 239 + integer, parameter :: rid_CH3BR_CL = 240 + integer, parameter :: rid_CH3BR_OH = 241 + integer, parameter :: rid_CH3CCL3_OH = 242 + integer, parameter :: rid_CH3CL_CL = 243 + integer, parameter :: rid_CH3CL_OH = 244 + integer, parameter :: rid_CHBR3_CL = 245 + integer, parameter :: rid_CHBR3_OH = 246 + integer, parameter :: rid_HCFC141B_OH = 247 + integer, parameter :: rid_HCFC142B_OH = 248 + integer, parameter :: rid_HCFC22_OH = 249 + integer, parameter :: rid_O1D_CH2BR2 = 250 + integer, parameter :: rid_O1D_CH3BR = 251 + integer, parameter :: rid_O1D_HCFC141B = 252 + integer, parameter :: rid_O1D_HCFC142B = 253 + integer, parameter :: rid_O1D_HCFC22 = 254 + integer, parameter :: rid_CH2O_HO2 = 255 + integer, parameter :: rid_CH2O_NO3 = 256 + integer, parameter :: rid_CH2O_O = 257 + integer, parameter :: rid_CH2O_OH = 258 + integer, parameter :: rid_CH3O2_CH3O2a = 259 + integer, parameter :: rid_CH3O2_CH3O2b = 260 + integer, parameter :: rid_CH3O2_HO2 = 261 + integer, parameter :: rid_CH3O2_NO = 262 + integer, parameter :: rid_CH3OH_OH = 263 + integer, parameter :: rid_CH3OOH_OH = 264 + integer, parameter :: rid_CH4_OH = 265 integer, parameter :: rid_HCN_OH = 266 integer, parameter :: rid_HCOOH_OH = 267 integer, parameter :: rid_HOCH2OO_HO2 = 268 @@ -274,7 +274,7 @@ module m_rxt_id integer, parameter :: rid_O1D_CH4b = 272 integer, parameter :: rid_O1D_CH4c = 273 integer, parameter :: rid_O1D_HCN = 274 - integer, parameter :: rid_usr_CO_OH_b = 275 + integer, parameter :: rid_usr_CO_OH = 275 integer, parameter :: rid_C2H2_CL_M = 276 integer, parameter :: rid_C2H2_OH_M = 277 integer, parameter :: rid_C2H4_CL_M = 278 @@ -353,7 +353,7 @@ module m_rxt_id integer, parameter :: rid_MPAN_OH_M = 351 integer, parameter :: rid_MVK_O3 = 352 integer, parameter :: rid_MVK_OH = 353 - integer, parameter :: rid_usr_MCO3_NO2 = 354 + integer, parameter :: rid_tag_MCO3_NO2 = 354 integer, parameter :: rid_usr_MPAN_M = 355 integer, parameter :: rid_ALKNIT_OH = 356 integer, parameter :: rid_ALKO2_HO2 = 357 @@ -466,17 +466,17 @@ module m_rxt_id integer, parameter :: rid_OCS_O = 464 integer, parameter :: rid_OCS_OH = 465 integer, parameter :: rid_S_O2 = 466 - integer, parameter :: rid_S_O3 = 467 - integer, parameter :: rid_SO_BRO = 468 - integer, parameter :: rid_SO_CLO = 469 - integer, parameter :: rid_S_OH = 470 - integer, parameter :: rid_SO_NO2 = 471 - integer, parameter :: rid_SO_O2 = 472 - integer, parameter :: rid_SO_O3 = 473 - integer, parameter :: rid_SO_OCLO = 474 - integer, parameter :: rid_SO_OH = 475 - integer, parameter :: rid_usr_DMS_OH = 476 - integer, parameter :: rid_usr_SO2_OH = 477 + integer, parameter :: rid_SO2_OH_M = 467 + integer, parameter :: rid_S_O3 = 468 + integer, parameter :: rid_SO_BRO = 469 + integer, parameter :: rid_SO_CLO = 470 + integer, parameter :: rid_S_OH = 471 + integer, parameter :: rid_SO_NO2 = 472 + integer, parameter :: rid_SO_O2 = 473 + integer, parameter :: rid_SO_O3 = 474 + integer, parameter :: rid_SO_OCLO = 475 + integer, parameter :: rid_SO_OH = 476 + integer, parameter :: rid_usr_DMS_OH = 477 integer, parameter :: rid_usr_SO3_H2O = 478 integer, parameter :: rid_NH3_OH = 479 integer, parameter :: rid_usr_GLYOXAL_aer = 480 @@ -538,8 +538,7 @@ module m_rxt_id integer, parameter :: rid_het7 = 536 integer, parameter :: rid_het8 = 537 integer, parameter :: rid_het9 = 538 - integer, parameter :: rid_E90_tau = 539 - integer, parameter :: rid_NH_50_tau = 540 - integer, parameter :: rid_NH_5_tau = 541 - integer, parameter :: rid_ST80_25_tau = 542 + integer, parameter :: rid_NH_50_tau = 539 + integer, parameter :: rid_NH_5_tau = 540 + integer, parameter :: rid_ST80_25_tau = 541 end module m_rxt_id diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 index d5291151da..72c913307a 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_adjrxt.F90 @@ -13,23 +13,22 @@ subroutine adjrxt( rate, inv, m, 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(:,:, 126) = rate(:,:, 126) * inv(:,:, 3) - rate(:,:, 127) = rate(:,:, 127) * inv(:,:, 2) - rate(:,:, 130) = rate(:,:, 130) * inv(:,:, 1) - rate(:,:, 147) = rate(:,:, 147) * inv(:,:, 1) - rate(:,:, 154) = rate(:,:, 154) * inv(:,:, 2) - rate(:,:, 157) = rate(:,:, 157) * inv(:,:, 1) - rate(:,:, 165) = rate(:,:, 165) * inv(:,:, 1) - rate(:,:, 168) = rate(:,:, 168) * inv(:,:, 1) + rate(:,:, 127) = rate(:,:, 127) * inv(:,:, 3) + rate(:,:, 128) = rate(:,:, 128) * inv(:,:, 2) + rate(:,:, 131) = rate(:,:, 131) * inv(:,:, 1) + rate(:,:, 148) = rate(:,:, 148) * inv(:,:, 1) + rate(:,:, 155) = rate(:,:, 155) * inv(:,:, 2) + rate(:,:, 158) = rate(:,:, 158) * inv(:,:, 1) + rate(:,:, 166) = rate(:,:, 166) * inv(:,:, 1) rate(:,:, 169) = rate(:,:, 169) * inv(:,:, 1) rate(:,:, 170) = rate(:,:, 170) * inv(:,:, 1) - rate(:,:, 172) = rate(:,:, 172) * inv(:,:, 1) + rate(:,:, 171) = rate(:,:, 171) * inv(:,:, 1) rate(:,:, 173) = rate(:,:, 173) * inv(:,:, 1) - rate(:,:, 188) = rate(:,:, 188) * inv(:,:, 1) - rate(:,:, 208) = rate(:,:, 208) * inv(:,:, 1) + rate(:,:, 174) = rate(:,:, 174) * inv(:,:, 1) + rate(:,:, 189) = rate(:,:, 189) * inv(:,:, 1) rate(:,:, 209) = rate(:,:, 209) * inv(:,:, 1) - rate(:,:, 219) = rate(:,:, 219) * inv(:,:, 1) - rate(:,:, 265) = rate(:,:, 265) * inv(:,:, 1) + rate(:,:, 210) = rate(:,:, 210) * inv(:,:, 1) + rate(:,:, 220) = rate(:,:, 220) * inv(:,:, 1) rate(:,:, 266) = rate(:,:, 266) * inv(:,:, 1) rate(:,:, 276) = rate(:,:, 276) * inv(:,:, 1) rate(:,:, 277) = rate(:,:, 277) * inv(:,:, 1) @@ -48,20 +47,20 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) rate(:,:, 425) = rate(:,:, 425) * inv(:,:, 1) rate(:,:, 430) = rate(:,:, 430) * inv(:,:, 1) rate(:,:, 466) = rate(:,:, 466) * inv(:,:, 2) - rate(:,:, 472) = rate(:,:, 472) * inv(:,:, 2) - rate(:,:, 131) = rate(:,:, 131) * inv(:,:, 2) * inv(:,:, 1) - rate(:,:, 137) = rate(:,:, 137) * inv(:,:, 2) * inv(:,:, 1) - rate(:,:, 124) = rate(:,:, 124) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * inv(:,:, 1) + rate(:,:, 473) = rate(:,:, 473) * inv(:,:, 2) + rate(:,:, 132) = rate(:,:, 132) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 138) = rate(:,:, 138) * inv(:,:, 2) * inv(:,:, 1) rate(:,:, 125) = rate(:,:, 125) * m(:,:) - rate(:,:, 128) = rate(:,:, 128) * m(:,:) + rate(:,:, 126) = rate(:,:, 126) * m(:,:) rate(:,:, 129) = rate(:,:, 129) * m(:,:) rate(:,:, 130) = rate(:,:, 130) * m(:,:) - rate(:,:, 132) = rate(:,:, 132) * m(:,:) + rate(:,:, 131) = rate(:,:, 131) * m(:,:) rate(:,:, 133) = rate(:,:, 133) * m(:,:) rate(:,:, 134) = rate(:,:, 134) * m(:,:) rate(:,:, 135) = rate(:,:, 135) * m(:,:) rate(:,:, 136) = rate(:,:, 136) * m(:,:) - rate(:,:, 138) = rate(:,:, 138) * m(:,:) + rate(:,:, 137) = rate(:,:, 137) * m(:,:) rate(:,:, 139) = rate(:,:, 139) * m(:,:) rate(:,:, 140) = rate(:,:, 140) * m(:,:) rate(:,:, 141) = rate(:,:, 141) * m(:,:) @@ -77,7 +76,7 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) rate(:,:, 151) = rate(:,:, 151) * m(:,:) rate(:,:, 152) = rate(:,:, 152) * m(:,:) rate(:,:, 153) = rate(:,:, 153) * m(:,:) - rate(:,:, 155) = rate(:,:, 155) * m(:,:) + rate(:,:, 154) = rate(:,:, 154) * m(:,:) rate(:,:, 156) = rate(:,:, 156) * m(:,:) rate(:,:, 157) = rate(:,:, 157) * m(:,:) rate(:,:, 158) = rate(:,:, 158) * m(:,:) @@ -94,7 +93,7 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) rate(:,:, 169) = rate(:,:, 169) * m(:,:) rate(:,:, 170) = rate(:,:, 170) * m(:,:) rate(:,:, 171) = rate(:,:, 171) * m(:,:) - rate(:,:, 174) = rate(:,:, 174) * m(:,:) + rate(:,:, 172) = rate(:,:, 172) * m(:,:) rate(:,:, 175) = rate(:,:, 175) * m(:,:) rate(:,:, 176) = rate(:,:, 176) * m(:,:) rate(:,:, 177) = rate(:,:, 177) * m(:,:) @@ -129,7 +128,7 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) rate(:,:, 206) = rate(:,:, 206) * m(:,:) rate(:,:, 207) = rate(:,:, 207) * m(:,:) rate(:,:, 208) = rate(:,:, 208) * m(:,:) - rate(:,:, 210) = rate(:,:, 210) * m(:,:) + rate(:,:, 209) = rate(:,:, 209) * m(:,:) rate(:,:, 211) = rate(:,:, 211) * m(:,:) rate(:,:, 212) = rate(:,:, 212) * m(:,:) rate(:,:, 213) = rate(:,:, 213) * m(:,:) @@ -383,7 +382,7 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) rate(:,:, 469) = rate(:,:, 469) * m(:,:) rate(:,:, 470) = rate(:,:, 470) * m(:,:) rate(:,:, 471) = rate(:,:, 471) * m(:,:) - rate(:,:, 473) = rate(:,:, 473) * m(:,:) + rate(:,:, 472) = rate(:,:, 472) * m(:,:) rate(:,:, 474) = rate(:,:, 474) * m(:,:) rate(:,:, 475) = rate(:,:, 475) * m(:,:) rate(:,:, 476) = rate(:,:, 476) * m(:,:) diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 index 91ed2847e6..069b7f356f 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_indprd.F90 @@ -20,50 +20,8 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) ! ... "independent" production for Explicit species !-------------------------------------------------------------------- if( class == 1 ) then - prod(:,1) = + extfrc(:,15) - prod(:,2) = 0._r8 - prod(:,3) = 0._r8 - prod(:,4) = 0._r8 - prod(:,5) = 0._r8 - prod(:,6) = 0._r8 - prod(:,7) = 0._r8 - prod(:,8) = 0._r8 - prod(:,9) = 0._r8 - prod(:,10) = 0._r8 - prod(:,11) = 0._r8 - prod(:,12) = 0._r8 - prod(:,13) = 0._r8 - prod(:,14) = 0._r8 - prod(:,15) =.100_r8*rxt(:,308)*y(:,134)*y(:,29) - prod(:,16) = 0._r8 - prod(:,17) = 0._r8 - prod(:,18) = (rxt(:,265)*y(:,62) +rxt(:,267)*y(:,87) +rxt(:,275)*y(:,62) + & - rxt(:,295)*y(:,50) +.500_r8*rxt(:,296)*y(:,51) + & - .800_r8*rxt(:,301)*y(:,74) +rxt(:,302)*y(:,75) + & - .500_r8*rxt(:,351)*y(:,109) +1.800_r8*rxt(:,461)*y(:,178))*y(:,217) & - + (2.000_r8*rxt(:,291)*y(:,197) +.900_r8*rxt(:,292)*y(:,198) + & - rxt(:,294)*y(:,124) +2.000_r8*rxt(:,341)*y(:,211) + & - rxt(:,365)*y(:,205) +rxt(:,390)*y(:,225))*y(:,197) & - + (.200_r8*rxt(:,308)*y(:,29) +.100_r8*rxt(:,352)*y(:,111) + & - .270_r8*rxt(:,440)*y(:,6) +.270_r8*rxt(:,443)*y(:,110))*y(:,134) & - + (rxt(:,342)*y(:,198) +.450_r8*rxt(:,343)*y(:,203) + & - 2.000_r8*rxt(:,344)*y(:,211))*y(:,211) & - + (.500_r8*rxt(:,450)*y(:,198) +.900_r8*rxt(:,452)*y(:,124)) & - *y(:,221) +rxt(:,37)*y(:,51) +.400_r8*rxt(:,60)*y(:,139) +rxt(:,65) & - *y(:,174) +.800_r8*rxt(:,69)*y(:,178) - prod(:,19) = 0._r8 - prod(:,20) = 0._r8 - prod(:,21) = 0._r8 - prod(:,22) = 0._r8 - prod(:,23) = 0._r8 - prod(:,24) =rxt(:,151)*y(:,125)*y(:,112) - prod(:,25) = 0._r8 - prod(:,26) = 0._r8 - prod(:,27) = 0._r8 - prod(:,28) = 0._r8 - prod(:,29) = 0._r8 - prod(:,30) =rxt(:,479)*y(:,217)*y(:,120) +rxt(:,488)*y(:,121) - prod(:,31) = (rxt(:,412)*y(:,199) +rxt(:,415)*y(:,210) +rxt(:,418)*y(:,212) + & + prod(:,1) =rxt(:,479)*y(:,217)*y(:,120) +rxt(:,488)*y(:,121) + prod(:,2) = (rxt(:,412)*y(:,199) +rxt(:,415)*y(:,210) +rxt(:,418)*y(:,212) + & rxt(:,422)*y(:,141))*y(:,125) +.500_r8*rxt(:,351)*y(:,217)*y(:,109) & +.200_r8*rxt(:,447)*y(:,215)*y(:,124) +.500_r8*rxt(:,459)*y(:,177) & *y(:,126) @@ -71,150 +29,160 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) ! ... "independent" production for Implicit species !-------------------------------------------------------------------- else if( class == 4 ) then - prod(:,128) = 0._r8 - prod(:,126) = 0._r8 - prod(:,1) = + extfrc(:,4) - prod(:,2) = + extfrc(:,2) + prod(:,154) = 0._r8 prod(:,151) = 0._r8 - prod(:,52) = 0._r8 - prod(:,91) = 0._r8 - prod(:,53) = 0._r8 + prod(:,1) = + extfrc(:,12) + prod(:,2) = 0._r8 + prod(:,3) = + extfrc(:,9) + prod(:,185) = 0._r8 + prod(:,71) = 0._r8 + prod(:,121) = 0._r8 + prod(:,72) = 0._r8 + prod(:,114) = 0._r8 + prod(:,127) = 0._r8 + prod(:,96) = 0._r8 + prod(:,145) = 0._r8 + prod(:,105) = 0._r8 + prod(:,86) = 0._r8 + prod(:,110) = 0._r8 + prod(:,209) = 0._r8 + prod(:,87) = 0._r8 + prod(:,225) = 0._r8 + prod(:,139) = 0._r8 + prod(:,4) = 0._r8 + prod(:,90) = 0._r8 + prod(:,108) = 0._r8 + prod(:,98) = 0._r8 + prod(:,140) = 0._r8 prod(:,92) = 0._r8 - prod(:,103) = 0._r8 - prod(:,76) = 0._r8 + prod(:,109) = 0._r8 + prod(:,99) = 0._r8 + prod(:,186) = 0._r8 prod(:,120) = 0._r8 - prod(:,81) = 0._r8 + prod(:,57) = 0._r8 + prod(:,93) = 0._r8 + prod(:,54) = 0._r8 + prod(:,66) = 0._r8 prod(:,67) = 0._r8 - prod(:,88) = 0._r8 - prod(:,181) =rxt(:,79)*y(:,34) +rxt(:,80)*y(:,35) +2.000_r8*rxt(:,86)*y(:,41) & - +rxt(:,87)*y(:,43) +3.000_r8*rxt(:,90)*y(:,55) +2.000_r8*rxt(:,98) & - *y(:,78) + prod(:,58) = 0._r8 prod(:,68) = 0._r8 - prod(:,190) = 0._r8 - prod(:,114) = 0._r8 + prod(:,59) = 0._r8 prod(:,69) = 0._r8 - prod(:,84) = 0._r8 - prod(:,77) = 0._r8 - prod(:,116) = 0._r8 - prod(:,71) = 0._r8 - prod(:,85) = 0._r8 - prod(:,78) = 0._r8 - prod(:,156) = 0._r8 - prod(:,98) = 0._r8 - prod(:,46) = 0._r8 - prod(:,72) = 0._r8 - prod(:,191) =.180_r8*rxt(:,40)*y(:,54) - prod(:,168) = 0._r8 - prod(:,44) = 0._r8 - prod(:,154) = 0._r8 - prod(:,173) = 0._r8 - prod(:,117) = 0._r8 + prod(:,60) = 0._r8 + prod(:,129) = 0._r8 + prod(:,213) = 0._r8 + prod(:,146) = 0._r8 + prod(:,61) = 0._r8 + prod(:,190) = 0._r8 prod(:,112) = 0._r8 - prod(:,141) = 0._r8 - prod(:,94) = 0._r8 - prod(:,195) =4.000_r8*rxt(:,78)*y(:,33) +rxt(:,79)*y(:,34) & - +2.000_r8*rxt(:,81)*y(:,36) +2.000_r8*rxt(:,82)*y(:,37) & - +2.000_r8*rxt(:,83)*y(:,38) +rxt(:,84)*y(:,39) +2.000_r8*rxt(:,85) & - *y(:,40) +3.000_r8*rxt(:,88)*y(:,44) +rxt(:,89)*y(:,46) +rxt(:,100) & - *y(:,82) +rxt(:,101)*y(:,83) +rxt(:,102)*y(:,84) prod(:,55) = 0._r8 - prod(:,45) = 0._r8 - prod(:,184) = 0._r8 - prod(:,155) = 0._r8 - prod(:,162) =.380_r8*rxt(:,40)*y(:,54) +rxt(:,41)*y(:,63) + extfrc(:,5) - prod(:,51) =rxt(:,79)*y(:,34) +rxt(:,80)*y(:,35) +rxt(:,82)*y(:,37) & - +2.000_r8*rxt(:,83)*y(:,38) +2.000_r8*rxt(:,84)*y(:,39) +rxt(:,85) & - *y(:,40) +2.000_r8*rxt(:,98)*y(:,78) +rxt(:,101)*y(:,83) +rxt(:,102) & - *y(:,84) - prod(:,57) =rxt(:,81)*y(:,36) +rxt(:,82)*y(:,37) +rxt(:,100)*y(:,82) - prod(:,59) = 0._r8 - prod(:,74) = 0._r8 - prod(:,3) = 0._r8 - prod(:,4) = 0._r8 - prod(:,5) = 0._r8 - prod(:,47) = 0._r8 - prod(:,139) =rxt(:,80)*y(:,35) +rxt(:,84)*y(:,39) - prod(:,159) = 0._r8 - prod(:,149) = 0._r8 - prod(:,183) = (rxt(:,39) +.330_r8*rxt(:,40))*y(:,54) - prod(:,169) =1.440_r8*rxt(:,40)*y(:,54) - prod(:,121) = 0._r8 - prod(:,48) = 0._r8 - prod(:,143) = 0._r8 - prod(:,194) = 0._r8 - prod(:,56) = 0._r8 - prod(:,142) = 0._r8 - prod(:,64) = 0._r8 - prod(:,182) = 0._r8 - prod(:,96) = 0._r8 - prod(:,138) = 0._r8 - prod(:,145) = 0._r8 - prod(:,160) = 0._r8 - prod(:,65) = 0._r8 - prod(:,163) = 0._r8 - prod(:,86) = 0._r8 - prod(:,49) = 0._r8 - prod(:,146) = 0._r8 - prod(:,123) = 0._r8 + prod(:,180) = 0._r8 + prod(:,200) = 0._r8 + prod(:,156) = 0._r8 + prod(:,148) = 0._r8 + prod(:,166) = 0._r8 prod(:,115) = 0._r8 - prod(:,171) = 0._r8 - prod(:,95) = 0._r8 - prod(:,130) = 0._r8 - prod(:,39) = 0._r8 - prod(:,172) = 0._r8 - prod(:,79) = 0._r8 - prod(:,110) = 0._r8 - prod(:,80) = 0._r8 - prod(:,119) = 0._r8 - prod(:,152) = 0._r8 - prod(:,176) = 0._r8 - prod(:,89) = + extfrc(:,16) - prod(:,75) = 0._r8 - prod(:,90) = 0._r8 - prod(:,158) = 0._r8 + prod(:,210) = 0._r8 + prod(:,125) = 0._r8 + prod(:,220) = 0._r8 + prod(:,70) = 0._r8 + prod(:,52) = 0._r8 + prod(:,219) = 0._r8 + prod(:,177) = 0._r8 + prod(:,5) = 0._r8 + prod(:,192) = + extfrc(:,10) + prod(:,168) = 0._r8 + prod(:,85) = 0._r8 + prod(:,83) = 0._r8 + prod(:,77) = 0._r8 + prod(:,100) = 0._r8 prod(:,6) = 0._r8 prod(:,7) = 0._r8 prod(:,8) = 0._r8 - prod(:,43) = 0._r8 prod(:,9) = 0._r8 - prod(:,188) = + extfrc(:,6) - prod(:,187) = + extfrc(:,7) - prod(:,196) = 0._r8 + prod(:,62) = 0._r8 + prod(:,175) = 0._r8 + prod(:,191) = 0._r8 + prod(:,184) = 0._r8 + prod(:,212) = 0._r8 + prod(:,208) = 0._r8 + prod(:,56) = 0._r8 prod(:,147) = 0._r8 - prod(:,93) = 0._r8 - prod(:,10) = + extfrc(:,8) - prod(:,11) = + extfrc(:,9) - prod(:,12) = 0._r8 - prod(:,13) = + extfrc(:,10) - prod(:,193) =.180_r8*rxt(:,40)*y(:,54) +rxt(:,41)*y(:,63) + (rxt(:,5) + & - 2.000_r8*rxt(:,6)) - prod(:,197) = 0._r8 + prod(:,63) = 0._r8 + prod(:,169) = 0._r8 prod(:,82) = 0._r8 - prod(:,87) = 0._r8 - prod(:,66) = 0._r8 + prod(:,89) = 0._r8 + prod(:,101) = 0._r8 + prod(:,223) = 0._r8 + prod(:,74) = 0._r8 + prod(:,181) = 0._r8 + prod(:,97) = 0._r8 + prod(:,211) = 0._r8 + prod(:,118) = 0._r8 + prod(:,165) = 0._r8 + prod(:,171) = 0._r8 + prod(:,196) = 0._r8 + prod(:,84) = 0._r8 + prod(:,195) = 0._r8 prod(:,104) = 0._r8 - prod(:,50) = 0._r8 - prod(:,105) = 0._r8 - prod(:,54) = 0._r8 - prod(:,83) = 0._r8 - prod(:,14) = + extfrc(:,11) - prod(:,15) = + extfrc(:,12) + prod(:,64) = 0._r8 + prod(:,173) = 0._r8 + prod(:,144) = 0._r8 + prod(:,141) = 0._r8 + prod(:,198) = 0._r8 + prod(:,117) = 0._r8 + prod(:,157) = 0._r8 + prod(:,48) = 0._r8 + prod(:,199) = 0._r8 + prod(:,102) = 0._r8 + prod(:,134) = 0._r8 + prod(:,103) = 0._r8 + prod(:,143) = 0._r8 + prod(:,182) = 0._r8 + prod(:,205) = 0._r8 + prod(:,132) = + extfrc(:,14) + prod(:,75) = 0._r8 + prod(:,95) = 0._r8 prod(:,113) = 0._r8 - prod(:,97) = 0._r8 - prod(:,109) = 0._r8 + prod(:,189) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,53) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) = 0._r8 + prod(:,217) = + extfrc(:,13) + prod(:,224) = + extfrc(:,7) + prod(:,216) = 0._r8 prod(:,174) = 0._r8 - prod(:,148) = + extfrc(:,14) - prod(:,70) = 0._r8 + prod(:,116) = 0._r8 prod(:,16) = + extfrc(:,1) - prod(:,17) = + extfrc(:,13) + prod(:,17) = + extfrc(:,2) prod(:,18) = 0._r8 - prod(:,19) = 0._r8 + prod(:,19) = + extfrc(:,5) + prod(:,226) = (rxt(:,5) +2.000_r8*rxt(:,6)) + prod(:,222) = 0._r8 prod(:,20) = 0._r8 + prod(:,106) = 0._r8 + prod(:,111) = 0._r8 + prod(:,88) = 0._r8 + prod(:,137) = 0._r8 + prod(:,65) = 0._r8 + prod(:,128) = 0._r8 + prod(:,73) = 0._r8 + prod(:,107) = 0._r8 prod(:,21) = 0._r8 - prod(:,22) = 0._r8 + prod(:,22) = + extfrc(:,8) + prod(:,138) = 0._r8 + prod(:,119) = 0._r8 + prod(:,135) = 0._r8 prod(:,23) = 0._r8 - prod(:,24) = 0._r8 - prod(:,25) = 0._r8 + prod(:,201) = 0._r8 + prod(:,172) = + extfrc(:,6) + prod(:,91) = 0._r8 + prod(:,24) = + extfrc(:,3) + prod(:,25) = + extfrc(:,4) prod(:,26) = 0._r8 prod(:,27) = 0._r8 prod(:,28) = 0._r8 @@ -223,62 +191,71 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) prod(:,31) = 0._r8 prod(:,32) = 0._r8 prod(:,33) = 0._r8 - prod(:,34) = + extfrc(:,3) - prod(:,60) = 0._r8 - prod(:,122) = 0._r8 - prod(:,124) = 0._r8 - prod(:,106) = 0._r8 - prod(:,157) = 0._r8 - prod(:,161) = 0._r8 - prod(:,127) = 0._r8 - prod(:,58) = 0._r8 - prod(:,61) = 0._r8 - prod(:,62) = 0._r8 - prod(:,131) = 0._r8 - prod(:,63) = 0._r8 - prod(:,99) = 0._r8 - prod(:,111) = 0._r8 - prod(:,153) = 0._r8 + prod(:,34) = 0._r8 prod(:,35) = 0._r8 - prod(:,107) = 0._r8 prod(:,36) = 0._r8 - prod(:,100) = 0._r8 - prod(:,144) = 0._r8 - prod(:,140) = 0._r8 - prod(:,125) = 0._r8 - prod(:,180) = 0._r8 - prod(:,189) =rxt(:,87)*y(:,43) +rxt(:,89)*y(:,46) +rxt(:,39)*y(:,54) - prod(:,136) = 0._r8 - prod(:,118) = 0._r8 - prod(:,73) = 0._r8 - prod(:,132) = 0._r8 - prod(:,192) = 0._r8 - prod(:,101) = 0._r8 - prod(:,178) = 0._r8 - prod(:,175) = 0._r8 prod(:,37) = 0._r8 prod(:,38) = 0._r8 - prod(:,177) = 0._r8 - prod(:,133) = 0._r8 - prod(:,179) = 0._r8 - prod(:,150) = 0._r8 - prod(:,129) = 0._r8 + prod(:,39) = 0._r8 prod(:,40) = 0._r8 - prod(:,166) = 0._r8 - prod(:,185) =rxt(:,12)*y(:,113) +rxt(:,5) - prod(:,186) =.330_r8*rxt(:,40)*y(:,54) - prod(:,102) = 0._r8 - prod(:,137) = 0._r8 - prod(:,167) = 0._r8 - prod(:,165) = 0._r8 - prod(:,164) = 0._r8 - prod(:,134) = 0._r8 prod(:,41) = 0._r8 - prod(:,170) = 0._r8 - prod(:,135) = 0._r8 prod(:,42) = 0._r8 - prod(:,108) = 0._r8 - prod(:,198) =.050_r8*rxt(:,40)*y(:,54) + prod(:,43) = + extfrc(:,11) + prod(:,78) = 0._r8 + prod(:,152) = 0._r8 + prod(:,149) = 0._r8 + prod(:,130) = 0._r8 + prod(:,183) = 0._r8 + prod(:,188) = 0._r8 + prod(:,153) = 0._r8 + prod(:,76) = 0._r8 + prod(:,79) = 0._r8 + prod(:,80) = 0._r8 + prod(:,158) = 0._r8 + prod(:,81) = 0._r8 + prod(:,122) = 0._r8 + prod(:,136) = 0._r8 + prod(:,178) = 0._r8 + prod(:,44) = 0._r8 + prod(:,131) = 0._r8 + prod(:,45) = 0._r8 + prod(:,123) = 0._r8 + prod(:,170) = 0._r8 + prod(:,167) = 0._r8 + prod(:,150) = 0._r8 + prod(:,207) = 0._r8 + prod(:,221) = 0._r8 + prod(:,163) = 0._r8 + prod(:,142) = 0._r8 + prod(:,94) = 0._r8 + prod(:,159) = 0._r8 + prod(:,218) = 0._r8 + prod(:,124) = 0._r8 + prod(:,202) = 0._r8 + prod(:,203) = 0._r8 + prod(:,46) = 0._r8 + prod(:,47) = 0._r8 + prod(:,204) = 0._r8 + prod(:,160) = 0._r8 + prod(:,206) = 0._r8 + prod(:,176) = 0._r8 + prod(:,155) = 0._r8 + prod(:,49) = 0._r8 + prod(:,187) = 0._r8 + prod(:,214) =rxt(:,5) + prod(:,215) = 0._r8 + prod(:,126) = 0._r8 + prod(:,164) = 0._r8 + prod(:,194) = 0._r8 + prod(:,193) = 0._r8 + prod(:,179) = 0._r8 + prod(:,161) = 0._r8 + prod(:,50) = 0._r8 + prod(:,197) = 0._r8 + prod(:,162) = 0._r8 + prod(:,51) = 0._r8 + prod(:,133) = 0._r8 + prod(:,227) = 0._r8 end if end subroutine indprd end module mo_indprd diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 index 8468cbaf86..a87f37515a 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_lin_matrix.F90 @@ -23,221 +23,209 @@ subroutine linmat01( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,561) = -( rxt(k,19) + het_rates(k,1) ) - mat(k,537) = -( rxt(k,20) + het_rates(k,2) ) - mat(k,1) = -( het_rates(k,4) ) - mat(k,2) = -( het_rates(k,5) ) - mat(k,788) = -( het_rates(k,6) ) - mat(k,113) = -( het_rates(k,7) ) - mat(k,304) = -( rxt(k,21) + het_rates(k,8) ) - mat(k,119) = -( rxt(k,22) + het_rates(k,9) ) - mat(k,310) = -( rxt(k,23) + het_rates(k,10) ) - mat(k,379) = -( rxt(k,24) + het_rates(k,11) ) - mat(k,305) = .500_r8*rxt(k,21) - mat(k,120) = rxt(k,22) - mat(k,548) = .200_r8*rxt(k,70) - mat(k,589) = .060_r8*rxt(k,72) - mat(k,222) = -( rxt(k,25) + het_rates(k,12) ) - mat(k,547) = .200_r8*rxt(k,70) - mat(k,587) = .200_r8*rxt(k,72) - mat(k,493) = -( rxt(k,26) + het_rates(k,13) ) - mat(k,177) = rxt(k,46) - mat(k,892) = rxt(k,56) - mat(k,549) = .200_r8*rxt(k,70) - mat(k,590) = .150_r8*rxt(k,72) - mat(k,247) = -( rxt(k,27) + het_rates(k,14) ) - mat(k,588) = .210_r8*rxt(k,72) - mat(k,184) = -( het_rates(k,15) ) - mat(k,284) = -( het_rates(k,16) ) - mat(k,1278) = -( het_rates(k,17) ) - mat(k,188) = rxt(k,74) - mat(k,1707) = rxt(k,75) - mat(k,451) = rxt(k,77) - mat(k,705) = rxt(k,99) - mat(k,669) = rxt(k,105) - mat(k,1348) = rxt(k,200)*y(k,34) + rxt(k,226)*y(k,35) & - + 3.000_r8*rxt(k,227)*y(k,55) + 2.000_r8*rxt(k,228)*y(k,78) & - + 2.000_r8*rxt(k,249)*y(k,41) + rxt(k,250)*y(k,43) - mat(k,1921) = 2.000_r8*rxt(k,237)*y(k,41) + rxt(k,239)*y(k,43) & - + 3.000_r8*rxt(k,244)*y(k,55) - mat(k,1502) = 2.000_r8*rxt(k,238)*y(k,41) + rxt(k,240)*y(k,43) & - + 3.000_r8*rxt(k,245)*y(k,55) - mat(k,187) = -( rxt(k,74) + het_rates(k,18) ) - mat(k,1716) = -( rxt(k,75) + het_rates(k,19) ) - mat(k,454) = rxt(k,76) - mat(k,449) = -( rxt(k,76) + rxt(k,77) + rxt(k,524) + rxt(k,527) + rxt(k,532) & + mat(k,666) = -( rxt(k,19) + het_rates(k,1) ) + mat(k,632) = -( rxt(k,20) + het_rates(k,2) ) + mat(k,1) = -( het_rates(k,3) ) + mat(k,2) = -( het_rates(k,4) ) + mat(k,3) = -( het_rates(k,5) ) + mat(k,999) = -( het_rates(k,6) ) + mat(k,164) = -( het_rates(k,7) ) + mat(k,421) = -( rxt(k,21) + het_rates(k,8) ) + mat(k,170) = -( rxt(k,22) + het_rates(k,9) ) + mat(k,379) = -( rxt(k,23) + het_rates(k,10) ) + mat(k,460) = -( rxt(k,24) + het_rates(k,11) ) + mat(k,422) = .500_r8*rxt(k,21) + mat(k,171) = rxt(k,22) + mat(k,653) = .200_r8*rxt(k,70) + mat(k,699) = .060_r8*rxt(k,72) + mat(k,279) = -( rxt(k,25) + het_rates(k,12) ) + mat(k,652) = .200_r8*rxt(k,70) + mat(k,697) = .200_r8*rxt(k,72) + mat(k,590) = -( rxt(k,26) + het_rates(k,13) ) + mat(k,231) = rxt(k,46) + mat(k,1069) = rxt(k,56) + mat(k,654) = .200_r8*rxt(k,70) + mat(k,700) = .150_r8*rxt(k,72) + mat(k,323) = -( rxt(k,27) + het_rates(k,14) ) + mat(k,698) = .210_r8*rxt(k,72) + mat(k,238) = -( het_rates(k,15) ) + mat(k,349) = -( het_rates(k,16) ) + mat(k,1415) = -( het_rates(k,17) ) + mat(k,242) = rxt(k,74) + mat(k,2211) = rxt(k,75) + mat(k,542) = rxt(k,77) + mat(k,143) = rxt(k,79) + mat(k,149) = rxt(k,80) + mat(k,468) = 2.000_r8*rxt(k,86) + mat(k,595) = rxt(k,87) + mat(k,448) = 3.000_r8*rxt(k,90) + mat(k,107) = 2.000_r8*rxt(k,98) + mat(k,805) = rxt(k,99) + mat(k,779) = rxt(k,105) + mat(k,241) = -( rxt(k,74) + het_rates(k,18) ) + mat(k,2226) = -( rxt(k,75) + het_rates(k,19) ) + mat(k,546) = rxt(k,76) + mat(k,540) = -( rxt(k,76) + rxt(k,77) + rxt(k,524) + rxt(k,527) + rxt(k,532) & + het_rates(k,20) ) - mat(k,190) = -( het_rates(k,22) ) - mat(k,262) = rxt(k,28) - mat(k,263) = -( rxt(k,28) + het_rates(k,23) ) - mat(k,225) = -( het_rates(k,24) ) - mat(k,465) = -( het_rates(k,25) ) - mat(k,198) = -( het_rates(k,26) ) - mat(k,268) = -( rxt(k,29) + het_rates(k,27) ) - mat(k,231) = -( het_rates(k,28) ) - mat(k,869) = -( het_rates(k,29) ) - mat(k,1159) = .700_r8*rxt(k,55) - mat(k,346) = -( rxt(k,30) + het_rates(k,30) ) - mat(k,93) = -( het_rates(k,31) ) - mat(k,202) = -( rxt(k,31) + het_rates(k,32) ) - mat(k,1739) = -( rxt(k,32) + rxt(k,33) + het_rates(k,42) ) - mat(k,569) = .100_r8*rxt(k,19) - mat(k,545) = .100_r8*rxt(k,20) - mat(k,326) = rxt(k,38) - mat(k,911) = rxt(k,43) - mat(k,926) = .330_r8*rxt(k,45) - mat(k,947) = rxt(k,47) - mat(k,585) = .690_r8*rxt(k,49) - mat(k,1095) = 1.340_r8*rxt(k,50) - mat(k,756) = rxt(k,57) - mat(k,446) = rxt(k,62) - mat(k,344) = rxt(k,63) - mat(k,511) = .375_r8*rxt(k,65) - mat(k,398) = .400_r8*rxt(k,67) - mat(k,936) = .680_r8*rxt(k,69) - mat(k,370) = rxt(k,269) - mat(k,208) = 2.000_r8*rxt(k,299) - mat(k,1358) = rxt(k,272)*y(k,54) + rxt(k,273)*y(k,54) - mat(k,1024) = -( rxt(k,34) + het_rates(k,45) ) - mat(k,565) = .400_r8*rxt(k,19) - mat(k,542) = .400_r8*rxt(k,20) - mat(k,270) = rxt(k,29) - mat(k,920) = .330_r8*rxt(k,45) - mat(k,244) = rxt(k,53) - mat(k,444) = rxt(k,62) - mat(k,87) = -( het_rates(k,47) ) - mat(k,847) = -( rxt(k,35) + het_rates(k,48) ) - mat(k,564) = .250_r8*rxt(k,19) - mat(k,541) = .250_r8*rxt(k,20) - mat(k,348) = .820_r8*rxt(k,30) - mat(k,914) = .170_r8*rxt(k,45) - mat(k,505) = .300_r8*rxt(k,65) - mat(k,394) = .050_r8*rxt(k,67) - mat(k,929) = .500_r8*rxt(k,69) - mat(k,1100) = -( rxt(k,36) + het_rates(k,49) ) - mat(k,313) = .180_r8*rxt(k,23) - mat(k,249) = rxt(k,27) - mat(k,557) = .400_r8*rxt(k,70) - mat(k,598) = .540_r8*rxt(k,72) - mat(k,355) = .510_r8*rxt(k,73) - mat(k,473) = -( het_rates(k,50) ) - mat(k,435) = -( rxt(k,37) + het_rates(k,51) ) - mat(k,696) = -( het_rates(k,52) ) - mat(k,322) = -( rxt(k,38) + het_rates(k,53) ) - mat(k,1935) = -( rxt(k,175)*y(k,54) + rxt(k,237)*y(k,41) + rxt(k,239)*y(k,43) & - + rxt(k,242)*y(k,46) + rxt(k,244)*y(k,55) + het_rates(k,56) ) - mat(k,189) = rxt(k,74) - mat(k,129) = 2.000_r8*rxt(k,91) - mat(k,92) = 2.000_r8*rxt(k,92) - mat(k,1338) = rxt(k,93) - mat(k,862) = rxt(k,94) - mat(k,137) = rxt(k,97) - mat(k,1901) = rxt(k,103) - mat(k,729) = rxt(k,106) - mat(k,1362) = 4.000_r8*rxt(k,199)*y(k,33) + rxt(k,200)*y(k,34) & - + 2.000_r8*rxt(k,201)*y(k,36) + 2.000_r8*rxt(k,202)*y(k,37) & - + 2.000_r8*rxt(k,203)*y(k,38) + rxt(k,204)*y(k,39) & - + 2.000_r8*rxt(k,205)*y(k,40) + rxt(k,251)*y(k,82) & - + rxt(k,252)*y(k,83) + rxt(k,253)*y(k,84) - mat(k,1516) = 3.000_r8*rxt(k,241)*y(k,44) + rxt(k,243)*y(k,46) & - + rxt(k,246)*y(k,82) + rxt(k,247)*y(k,83) + rxt(k,248)*y(k,84) - mat(k,128) = -( rxt(k,91) + het_rates(k,57) ) - mat(k,90) = -( rxt(k,92) + rxt(k,209) + het_rates(k,58) ) - mat(k,1327) = -( rxt(k,93) + het_rates(k,59) ) - mat(k,857) = rxt(k,95) - mat(k,255) = rxt(k,107) - mat(k,91) = 2.000_r8*rxt(k,209) - mat(k,855) = -( rxt(k,94) + rxt(k,95) + rxt(k,526) + rxt(k,531) + rxt(k,537) & + mat(k,4) = -( het_rates(k,21) ) + mat(k,253) = -( het_rates(k,22) ) + mat(k,338) = rxt(k,28) + mat(k,339) = -( rxt(k,28) + het_rates(k,23) ) + mat(k,285) = -( het_rates(k,24) ) + mat(k,548) = -( het_rates(k,25) ) + mat(k,261) = -( het_rates(k,26) ) + mat(k,344) = -( rxt(k,29) + het_rates(k,27) ) + mat(k,291) = -( het_rates(k,28) ) + mat(k,1024) = -( het_rates(k,29) ) + mat(k,1326) = .700_r8*rxt(k,55) + mat(k,415) = -( rxt(k,30) + het_rates(k,30) ) + mat(k,109) = -( het_rates(k,31) ) + mat(k,265) = -( rxt(k,31) + het_rates(k,32) ) + mat(k,99) = -( rxt(k,78) + het_rates(k,33) ) + mat(k,141) = -( rxt(k,79) + het_rates(k,34) ) + mat(k,146) = -( rxt(k,80) + het_rates(k,35) ) + mat(k,113) = -( rxt(k,81) + het_rates(k,36) ) + mat(k,151) = -( rxt(k,82) + het_rates(k,37) ) + mat(k,117) = -( rxt(k,83) + het_rates(k,38) ) + mat(k,156) = -( rxt(k,84) + het_rates(k,39) ) + mat(k,121) = -( rxt(k,85) + het_rates(k,40) ) + mat(k,467) = -( rxt(k,86) + het_rates(k,41) ) + mat(k,1485) = -( rxt(k,32) + rxt(k,33) + het_rates(k,42) ) + mat(k,672) = .100_r8*rxt(k,19) + mat(k,639) = .100_r8*rxt(k,20) + mat(k,387) = rxt(k,38) + mat(k,1433) = .180_r8*rxt(k,39) + mat(k,1098) = rxt(k,43) + mat(k,1157) = .330_r8*rxt(k,45) + mat(k,1143) = rxt(k,47) + mat(k,694) = rxt(k,49) + mat(k,1214) = 1.340_r8*rxt(k,50) + mat(k,860) = rxt(k,57) + mat(k,536) = rxt(k,62) + mat(k,412) = rxt(k,63) + mat(k,649) = .375_r8*rxt(k,65) + mat(k,478) = .400_r8*rxt(k,67) + mat(k,1063) = .680_r8*rxt(k,69) + mat(k,443) = rxt(k,269) + mat(k,271) = 2.000_r8*rxt(k,299) + mat(k,594) = -( rxt(k,87) + het_rates(k,43) ) + mat(k,125) = -( rxt(k,88) + het_rates(k,44) ) + mat(k,1085) = -( rxt(k,34) + het_rates(k,45) ) + mat(k,670) = .400_r8*rxt(k,19) + mat(k,637) = .400_r8*rxt(k,20) + mat(k,346) = rxt(k,29) + mat(k,1148) = .330_r8*rxt(k,45) + mat(k,317) = rxt(k,53) + mat(k,534) = rxt(k,62) + mat(k,365) = -( rxt(k,89) + het_rates(k,46) ) + mat(k,102) = -( het_rates(k,47) ) + mat(k,922) = -( rxt(k,35) + het_rates(k,48) ) + mat(k,669) = .250_r8*rxt(k,19) + mat(k,636) = .250_r8*rxt(k,20) + mat(k,417) = .820_r8*rxt(k,30) + mat(k,1147) = .170_r8*rxt(k,45) + mat(k,644) = .300_r8*rxt(k,65) + mat(k,476) = .050_r8*rxt(k,67) + mat(k,1058) = .500_r8*rxt(k,69) + mat(k,1221) = -( rxt(k,36) + het_rates(k,49) ) + mat(k,382) = .180_r8*rxt(k,23) + mat(k,325) = rxt(k,27) + mat(k,662) = .400_r8*rxt(k,70) + mat(k,708) = .540_r8*rxt(k,72) + mat(k,430) = .510_r8*rxt(k,73) + mat(k,684) = -( het_rates(k,50) ) + mat(k,610) = -( rxt(k,37) + het_rates(k,51) ) + mat(k,786) = -( het_rates(k,52) ) + mat(k,385) = -( rxt(k,38) + het_rates(k,53) ) + mat(k,1430) = -( rxt(k,39) + rxt(k,40) + het_rates(k,54) ) + mat(k,447) = -( rxt(k,90) + het_rates(k,55) ) + mat(k,2017) = -( het_rates(k,56) ) + mat(k,243) = rxt(k,74) + mat(k,101) = 4.000_r8*rxt(k,78) + mat(k,145) = rxt(k,79) + mat(k,116) = 2.000_r8*rxt(k,81) + mat(k,155) = 2.000_r8*rxt(k,82) + mat(k,120) = 2.000_r8*rxt(k,83) + mat(k,160) = rxt(k,84) + mat(k,124) = 2.000_r8*rxt(k,85) + mat(k,127) = 3.000_r8*rxt(k,88) + mat(k,369) = rxt(k,89) + mat(k,162) = 2.000_r8*rxt(k,91) + mat(k,95) = 2.000_r8*rxt(k,92) + mat(k,1978) = rxt(k,93) + mat(k,889) = rxt(k,94) + mat(k,229) = rxt(k,97) + mat(k,225) = rxt(k,100) + mat(k,252) = rxt(k,101) + mat(k,308) = rxt(k,102) + mat(k,2153) = rxt(k,103) + mat(k,827) = rxt(k,106) + mat(k,161) = -( rxt(k,91) + het_rates(k,57) ) + mat(k,93) = -( rxt(k,92) + rxt(k,210) + het_rates(k,58) ) + mat(k,1977) = -( rxt(k,93) + het_rates(k,59) ) + mat(k,888) = rxt(k,95) + mat(k,331) = rxt(k,107) + mat(k,94) = 2.000_r8*rxt(k,210) + mat(k,884) = -( rxt(k,94) + rxt(k,95) + rxt(k,526) + rxt(k,531) + rxt(k,537) & + het_rates(k,60) ) - mat(k,939) = -( het_rates(k,62) ) - mat(k,121) = 1.500_r8*rxt(k,22) - mat(k,312) = .450_r8*rxt(k,23) - mat(k,495) = .600_r8*rxt(k,26) - mat(k,248) = rxt(k,27) - mat(k,1728) = rxt(k,32) + rxt(k,33) - mat(k,1023) = rxt(k,34) - mat(k,1099) = rxt(k,36) - mat(k,909) = rxt(k,43) - mat(k,766) = 2.000_r8*rxt(k,44) - mat(k,917) = .330_r8*rxt(k,45) - mat(k,1087) = 1.340_r8*rxt(k,51) - mat(k,1160) = .700_r8*rxt(k,55) - mat(k,152) = 1.500_r8*rxt(k,64) - mat(k,508) = .250_r8*rxt(k,65) - mat(k,886) = rxt(k,68) - mat(k,931) = 1.700_r8*rxt(k,69) - mat(k,279) = rxt(k,110) - mat(k,1917) = rxt(k,242)*y(k,46) - mat(k,109) = -( rxt(k,96) + het_rates(k,64) ) - mat(k,1342) = rxt(k,200)*y(k,34) + rxt(k,202)*y(k,37) & - + 2.000_r8*rxt(k,203)*y(k,38) + 2.000_r8*rxt(k,204)*y(k,39) & - + rxt(k,205)*y(k,40) + rxt(k,226)*y(k,35) & - + 2.000_r8*rxt(k,228)*y(k,78) + rxt(k,252)*y(k,83) & - + rxt(k,253)*y(k,84) - mat(k,1384) = rxt(k,247)*y(k,83) + rxt(k,248)*y(k,84) - mat(k,134) = -( rxt(k,97) + het_rates(k,65) ) - mat(k,1344) = rxt(k,201)*y(k,36) + rxt(k,202)*y(k,37) + rxt(k,251)*y(k,82) - mat(k,1389) = rxt(k,246)*y(k,82) - mat(k,146) = -( het_rates(k,66) ) - mat(k,210) = -( het_rates(k,67) ) - mat(k,3) = -( het_rates(k,68) ) - mat(k,4) = -( het_rates(k,69) ) - mat(k,5) = -( het_rates(k,70) ) - mat(k,97) = -( rxt(k,42) + het_rates(k,72) ) - mat(k,677) = -( rxt(k,231)*y(k,54) + het_rates(k,73) ) - mat(k,110) = 2.000_r8*rxt(k,96) - mat(k,135) = rxt(k,97) - mat(k,174) = rxt(k,104) - mat(k,1345) = rxt(k,204)*y(k,39) + rxt(k,226)*y(k,35) - mat(k,908) = -( rxt(k,43) + het_rates(k,74) ) - mat(k,915) = .330_r8*rxt(k,45) - mat(k,506) = .250_r8*rxt(k,65) - mat(k,207) = rxt(k,300) - mat(k,765) = -( rxt(k,44) + rxt(k,480) + het_rates(k,75) ) - mat(k,307) = rxt(k,21) - mat(k,311) = .130_r8*rxt(k,23) - mat(k,259) = .700_r8*rxt(k,61) - mat(k,554) = .600_r8*rxt(k,70) - mat(k,595) = .340_r8*rxt(k,72) - mat(k,354) = .170_r8*rxt(k,73) - mat(k,1304) = -( rxt(k,137) + het_rates(k,76) ) - mat(k,2065) = rxt(k,2) + 2.000_r8*rxt(k,3) - mat(k,1732) = 2.000_r8*rxt(k,32) - mat(k,323) = rxt(k,38) - mat(k,706) = rxt(k,99) - mat(k,1889) = rxt(k,103) - mat(k,175) = rxt(k,104) - mat(k,1350) = rxt(k,272)*y(k,54) - mat(k,1035) = -( het_rates(k,77) ) - mat(k,2061) = rxt(k,1) - mat(k,1729) = rxt(k,33) - mat(k,1347) = rxt(k,273)*y(k,54) - mat(k,497) = -( rxt(k,4) + het_rates(k,79) ) - mat(k,1788) = .500_r8*rxt(k,481) - mat(k,100) = -( rxt(k,109) + het_rates(k,80) ) - mat(k,704) = -( rxt(k,99) + het_rates(k,81) ) - mat(k,1900) = -( rxt(k,103) + het_rates(k,85) ) - mat(k,1934) = rxt(k,175)*y(k,54) + rxt(k,237)*y(k,41) + rxt(k,239)*y(k,43) & - + 2.000_r8*rxt(k,242)*y(k,46) + rxt(k,244)*y(k,55) - mat(k,130) = -( het_rates(k,86) ) - mat(k,700) = -( het_rates(k,87) ) - mat(k,173) = -( rxt(k,104) + het_rates(k,88) ) - mat(k,676) = rxt(k,231)*y(k,54) - mat(k,1291) = -( rxt(k,9) + het_rates(k,89) ) - mat(k,922) = rxt(k,482) - mat(k,517) = rxt(k,483) - mat(k,462) = rxt(k,484) - mat(k,217) = 2.000_r8*rxt(k,485) + 2.000_r8*rxt(k,522) + 2.000_r8*rxt(k,525) & - + 2.000_r8*rxt(k,536) - mat(k,301) = rxt(k,486) - mat(k,900) = rxt(k,487) - mat(k,1544) = .500_r8*rxt(k,489) - mat(k,1979) = rxt(k,490) - mat(k,319) = rxt(k,491) - mat(k,182) = rxt(k,492) - mat(k,524) = rxt(k,493) - mat(k,452) = rxt(k,524) + rxt(k,527) + rxt(k,532) - mat(k,856) = rxt(k,526) + rxt(k,531) + rxt(k,537) + mat(k,5) = -( het_rates(k,61) ) + mat(k,1103) = -( het_rates(k,62) ) + mat(k,172) = 1.500_r8*rxt(k,22) + mat(k,381) = .450_r8*rxt(k,23) + mat(k,592) = .600_r8*rxt(k,26) + mat(k,324) = rxt(k,27) + mat(k,1479) = rxt(k,32) + rxt(k,33) + mat(k,1086) = rxt(k,34) + mat(k,1220) = rxt(k,36) + mat(k,1428) = .380_r8*rxt(k,39) + mat(k,802) = rxt(k,41) + mat(k,1097) = rxt(k,43) + mat(k,980) = 2.000_r8*rxt(k,44) + mat(k,1150) = .330_r8*rxt(k,45) + mat(k,1208) = 1.340_r8*rxt(k,51) + mat(k,1328) = .700_r8*rxt(k,55) + mat(k,200) = 1.500_r8*rxt(k,64) + mat(k,647) = .250_r8*rxt(k,65) + mat(k,972) = rxt(k,68) + mat(k,1060) = 1.700_r8*rxt(k,69) + mat(k,360) = rxt(k,110) + mat(k,801) = -( rxt(k,41) + het_rates(k,63) ) + mat(k,611) = rxt(k,37) + mat(k,1426) = .440_r8*rxt(k,39) + mat(k,525) = .400_r8*rxt(k,60) + mat(k,643) = rxt(k,65) + mat(k,1057) = .800_r8*rxt(k,69) + mat(k,235) = -( rxt(k,96) + het_rates(k,64) ) + mat(k,142) = rxt(k,79) + mat(k,147) = rxt(k,80) + mat(k,153) = rxt(k,82) + mat(k,118) = 2.000_r8*rxt(k,83) + mat(k,157) = 2.000_r8*rxt(k,84) + mat(k,122) = rxt(k,85) + mat(k,106) = 2.000_r8*rxt(k,98) + mat(k,247) = rxt(k,101) + mat(k,303) = rxt(k,102) + mat(k,226) = -( rxt(k,97) + het_rates(k,65) ) + mat(k,114) = rxt(k,81) + mat(k,152) = rxt(k,82) + mat(k,222) = rxt(k,100) + mat(k,194) = -( het_rates(k,66) ) + mat(k,297) = -( het_rates(k,67) ) + mat(k,6) = -( het_rates(k,68) ) + mat(k,7) = -( het_rates(k,69) ) + mat(k,8) = -( het_rates(k,70) ) + mat(k,9) = -( rxt(k,124) + het_rates(k,71) ) + mat(k,129) = -( rxt(k,42) + het_rates(k,72) ) + mat(k,864) = -( het_rates(k,73) ) + mat(k,148) = rxt(k,80) + mat(k,158) = rxt(k,84) + mat(k,236) = 2.000_r8*rxt(k,96) + mat(k,227) = rxt(k,97) + mat(k,283) = rxt(k,104) + mat(k,1096) = -( rxt(k,43) + het_rates(k,74) ) + mat(k,1149) = .330_r8*rxt(k,45) + mat(k,646) = .250_r8*rxt(k,65) + mat(k,270) = rxt(k,300) end do end subroutine linmat01 subroutine linmat02( avec_len, mat, y, rxt, het_rates ) @@ -260,207 +248,209 @@ subroutine linmat02( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,334) = -( rxt(k,10) + rxt(k,11) + rxt(k,172) + het_rates(k,90) ) - mat(k,668) = -( rxt(k,105) + het_rates(k,91) ) - mat(k,450) = rxt(k,524) + rxt(k,527) + rxt(k,532) - mat(k,724) = -( rxt(k,106) + het_rates(k,92) ) - mat(k,854) = rxt(k,526) + rxt(k,531) + rxt(k,537) - mat(k,916) = -( rxt(k,45) + rxt(k,482) + het_rates(k,93) ) - mat(k,176) = -( rxt(k,46) + het_rates(k,94) ) - mat(k,1124) = rxt(k,373) - mat(k,943) = -( rxt(k,47) + het_rates(k,95) ) - mat(k,918) = .170_r8*rxt(k,45) - mat(k,273) = -( het_rates(k,96) ) - mat(k,103) = -( het_rates(k,97) ) - mat(k,735) = -( het_rates(k,98) ) - mat(k,513) = -( rxt(k,483) + het_rates(k,99) ) - mat(k,457) = -( rxt(k,484) + het_rates(k,100) ) - mat(k,1072) = -( het_rates(k,101) ) - mat(k,328) = -( rxt(k,48) + het_rates(k,102) ) - mat(k,580) = -( rxt(k,49) + het_rates(k,103) ) - mat(k,329) = rxt(k,48) - mat(k,65) = -( het_rates(k,104) ) - mat(k,1088) = -( rxt(k,50) + rxt(k,51) + het_rates(k,105) ) - mat(k,582) = .288_r8*rxt(k,49) - mat(k,237) = -( het_rates(k,106) ) - mat(k,423) = -( rxt(k,52) + het_rates(k,107) ) - mat(k,560) = .800_r8*rxt(k,19) - mat(k,536) = .800_r8*rxt(k,20) - mat(k,242) = -( rxt(k,53) + het_rates(k,108) ) - mat(k,485) = -( rxt(k,54) + rxt(k,355) + het_rates(k,109) ) - mat(k,815) = -( het_rates(k,110) ) - mat(k,1164) = -( rxt(k,55) + het_rates(k,111) ) - mat(k,583) = .402_r8*rxt(k,49) - mat(k,292) = -( rxt(k,154) + het_rates(k,112) ) - mat(k,1579) = rxt(k,15) - mat(k,216) = -( rxt(k,13) + rxt(k,14) + rxt(k,173) + rxt(k,485) + rxt(k,522) & + mat(k,979) = -( rxt(k,44) + rxt(k,480) + het_rates(k,75) ) + mat(k,424) = rxt(k,21) + mat(k,380) = .130_r8*rxt(k,23) + mat(k,335) = .700_r8*rxt(k,61) + mat(k,660) = .600_r8*rxt(k,70) + mat(k,706) = .340_r8*rxt(k,72) + mat(k,429) = .170_r8*rxt(k,73) + mat(k,1463) = -( rxt(k,138) + het_rates(k,76) ) + mat(k,2270) = rxt(k,2) + 2.000_r8*rxt(k,3) + mat(k,1484) = 2.000_r8*rxt(k,33) + mat(k,386) = rxt(k,38) + mat(k,1432) = .330_r8*rxt(k,39) + rxt(k,40) + mat(k,806) = rxt(k,99) + mat(k,2145) = rxt(k,103) + mat(k,284) = rxt(k,104) + mat(k,1401) = -( het_rates(k,77) ) + mat(k,2266) = rxt(k,1) + mat(k,1480) = rxt(k,32) + mat(k,1429) = 1.440_r8*rxt(k,39) + mat(k,105) = -( rxt(k,98) + het_rates(k,78) ) + mat(k,603) = -( rxt(k,4) + het_rates(k,79) ) + mat(k,132) = -( rxt(k,109) + het_rates(k,80) ) + mat(k,804) = -( rxt(k,99) + het_rates(k,81) ) + mat(k,221) = -( rxt(k,100) + het_rates(k,82) ) + mat(k,248) = -( rxt(k,101) + het_rates(k,83) ) + mat(k,304) = -( rxt(k,102) + het_rates(k,84) ) + mat(k,2156) = -( rxt(k,103) + het_rates(k,85) ) + mat(k,179) = -( het_rates(k,86) ) + mat(k,929) = -( het_rates(k,87) ) + mat(k,282) = -( rxt(k,104) + het_rates(k,88) ) + mat(k,1447) = -( rxt(k,9) + het_rates(k,89) ) + mat(k,1156) = rxt(k,482) + mat(k,585) = rxt(k,483) + mat(k,561) = rxt(k,484) + mat(k,274) = 2.000_r8*rxt(k,485) + 2.000_r8*rxt(k,522) + 2.000_r8*rxt(k,525) & + + 2.000_r8*rxt(k,536) + mat(k,376) = rxt(k,486) + mat(k,1077) = rxt(k,487) + mat(k,2188) = .500_r8*rxt(k,489) + mat(k,1744) = rxt(k,490) + mat(k,394) = rxt(k,491) + mat(k,245) = rxt(k,492) + mat(k,619) = rxt(k,493) + mat(k,543) = rxt(k,524) + rxt(k,527) + rxt(k,532) + mat(k,885) = rxt(k,526) + rxt(k,531) + rxt(k,537) + mat(k,403) = -( rxt(k,10) + rxt(k,11) + rxt(k,173) + het_rates(k,90) ) + mat(k,778) = -( rxt(k,105) + het_rates(k,91) ) + mat(k,541) = rxt(k,524) + rxt(k,527) + rxt(k,532) + mat(k,824) = -( rxt(k,106) + het_rates(k,92) ) + mat(k,883) = rxt(k,526) + rxt(k,531) + rxt(k,537) + mat(k,1153) = -( rxt(k,45) + rxt(k,482) + het_rates(k,93) ) + mat(k,230) = -( rxt(k,46) + het_rates(k,94) ) + mat(k,1272) = rxt(k,373) + mat(k,1140) = -( rxt(k,47) + het_rates(k,95) ) + mat(k,1152) = .170_r8*rxt(k,45) + mat(k,320) = -( het_rates(k,96) ) + mat(k,135) = -( het_rates(k,97) ) + mat(k,841) = -( het_rates(k,98) ) + mat(k,581) = -( rxt(k,483) + het_rates(k,99) ) + mat(k,556) = -( rxt(k,484) + het_rates(k,100) ) + mat(k,1193) = -( het_rates(k,101) ) + mat(k,397) = -( rxt(k,48) + het_rates(k,102) ) + mat(k,690) = -( rxt(k,49) + het_rates(k,103) ) + mat(k,398) = rxt(k,48) + mat(k,74) = -( het_rates(k,104) ) + mat(k,1209) = -( rxt(k,50) + rxt(k,51) + het_rates(k,105) ) + mat(k,692) = .300_r8*rxt(k,49) + mat(k,310) = -( het_rates(k,106) ) + mat(k,506) = -( rxt(k,52) + het_rates(k,107) ) + mat(k,665) = .800_r8*rxt(k,19) + mat(k,631) = .800_r8*rxt(k,20) + mat(k,315) = -( rxt(k,53) + het_rates(k,108) ) + mat(k,572) = -( rxt(k,54) + rxt(k,355) + het_rates(k,109) ) + mat(k,948) = -( het_rates(k,110) ) + mat(k,1332) = -( rxt(k,55) + het_rates(k,111) ) + mat(k,693) = .700_r8*rxt(k,49) + mat(k,491) = -( rxt(k,155) + het_rates(k,112) ) + mat(k,1785) = rxt(k,15) + mat(k,183) = -( rxt(k,12) + het_rates(k,113) ) + mat(k,273) = -( rxt(k,13) + rxt(k,14) + rxt(k,174) + rxt(k,485) + rxt(k,522) & + rxt(k,525) + rxt(k,536) + het_rates(k,114) ) - mat(k,298) = -( rxt(k,486) + het_rates(k,115) ) - mat(k,896) = -( rxt(k,56) + rxt(k,487) + het_rates(k,116) ) - mat(k,6) = -( het_rates(k,117) ) - mat(k,7) = -( het_rates(k,118) ) - mat(k,8) = -( het_rates(k,119) ) - mat(k,84) = -( het_rates(k,120) ) - mat(k,9) = -( rxt(k,488) + het_rates(k,121) ) - mat(k,1640) = -( rxt(k,15) + het_rates(k,124) ) - mat(k,219) = rxt(k,14) - mat(k,1550) = rxt(k,16) + .500_r8*rxt(k,489) - mat(k,1985) = rxt(k,17) - mat(k,296) = rxt(k,154) - mat(k,1355) = 2.000_r8*rxt(k,166)*y(k,113) - mat(k,1549) = -( rxt(k,16) + rxt(k,489) + het_rates(k,125) ) - mat(k,1295) = rxt(k,9) - mat(k,336) = rxt(k,11) + rxt(k,172) - mat(k,218) = rxt(k,13) + rxt(k,173) - mat(k,1984) = rxt(k,18) - mat(k,568) = rxt(k,19) - mat(k,924) = rxt(k,45) - mat(k,332) = rxt(k,48) - mat(k,489) = rxt(k,54) + rxt(k,355) - mat(k,902) = rxt(k,56) - mat(k,755) = rxt(k,57) - mat(k,321) = rxt(k,58) - mat(k,183) = rxt(k,59) - mat(k,385) = .600_r8*rxt(k,60) + rxt(k,306) - mat(k,526) = rxt(k,66) - mat(k,453) = rxt(k,76) - mat(k,859) = rxt(k,95) - mat(k,108) = rxt(k,430) - mat(k,1993) = -( rxt(k,17) + rxt(k,18) + rxt(k,490) + het_rates(k,126) ) - mat(k,338) = rxt(k,10) - mat(k,221) = rxt(k,13) + rxt(k,14) + rxt(k,173) - mat(k,388) = .400_r8*rxt(k,60) - mat(k,456) = rxt(k,77) - mat(k,863) = rxt(k,94) - mat(k,751) = -( rxt(k,57) + het_rates(k,127) ) - mat(k,316) = -( rxt(k,58) + rxt(k,491) + het_rates(k,128) ) - mat(k,10) = -( het_rates(k,129) ) - mat(k,11) = -( het_rates(k,130) ) - mat(k,12) = -( het_rates(k,131) ) - mat(k,13) = -( het_rates(k,132) ) - mat(k,1876) = -( rxt(k,131) + het_rates(k,133) ) - mat(k,2075) = rxt(k,3) - mat(k,2050) = rxt(k,8) - mat(k,220) = rxt(k,14) - mat(k,1645) = rxt(k,15) - mat(k,1555) = rxt(k,16) - mat(k,1990) = rxt(k,18) - mat(k,1719) = rxt(k,75) - mat(k,1336) = rxt(k,93) - mat(k,256) = rxt(k,107) - mat(k,1120) = rxt(k,111) + rxt(k,472) - mat(k,762) = rxt(k,112) - mat(k,196) = rxt(k,113) - mat(k,1360) = rxt(k,126) + rxt(k,127) - mat(k,297) = rxt(k,154) - mat(k,421) = rxt(k,466) - mat(k,2054) = -( rxt(k,7) + rxt(k,8) + het_rates(k,134) ) - mat(k,1880) = rxt(k,131) - mat(k,252) = -( rxt(k,107) + het_rates(k,136) ) - mat(k,276) = -( rxt(k,110) + het_rates(k,137) ) - mat(k,181) = -( rxt(k,59) + rxt(k,492) + het_rates(k,138) ) - mat(k,382) = -( rxt(k,60) + rxt(k,306) + het_rates(k,139) ) - mat(k,106) = -( rxt(k,430) + het_rates(k,140) ) - mat(k,389) = -( het_rates(k,141) ) - mat(k,203) = rxt(k,31) - mat(k,123) = -( het_rates(k,142) ) - mat(k,257) = -( rxt(k,61) + het_rates(k,143) ) - mat(k,14) = -( het_rates(k,144) ) - mat(k,15) = -( het_rates(k,145) ) - mat(k,441) = -( rxt(k,62) + het_rates(k,146) ) - mat(k,340) = -( rxt(k,63) + het_rates(k,147) ) - mat(k,417) = -( rxt(k,466) + het_rates(k,148) ) - mat(k,277) = rxt(k,110) - mat(k,1109) = rxt(k,111) - mat(k,1111) = -( rxt(k,111) + rxt(k,472) + het_rates(k,150) ) - mat(k,759) = rxt(k,112) - mat(k,418) = rxt(k,466) - mat(k,758) = -( rxt(k,112) + het_rates(k,151) ) - mat(k,195) = rxt(k,113) - mat(k,1110) = rxt(k,472) - mat(k,194) = -( rxt(k,113) + het_rates(k,152) ) - mat(k,101) = rxt(k,109) - mat(k,16) = -( het_rates(k,153) ) - mat(k,17) = -( het_rates(k,154) ) - mat(k,18) = -( het_rates(k,155) ) - mat(k,19) = -( rxt(k,114) + het_rates(k,156) ) - mat(k,20) = -( rxt(k,115) + het_rates(k,157) ) - mat(k,21) = -( rxt(k,116) + het_rates(k,158) ) - mat(k,22) = -( rxt(k,117) + het_rates(k,159) ) - mat(k,23) = -( rxt(k,118) + het_rates(k,160) ) - mat(k,24) = -( rxt(k,119) + het_rates(k,161) ) - mat(k,25) = -( rxt(k,120) + het_rates(k,162) ) - mat(k,26) = -( rxt(k,121) + het_rates(k,163) ) - mat(k,27) = -( rxt(k,122) + het_rates(k,164) ) - mat(k,28) = -( rxt(k,123) + het_rates(k,165) ) - mat(k,29) = -( het_rates(k,166) ) - mat(k,764) = rxt(k,480) - mat(k,30) = -( het_rates(k,167) ) - mat(k,31) = -( het_rates(k,168) ) - mat(k,32) = -( het_rates(k,169) ) - mat(k,33) = -( het_rates(k,170) ) - mat(k,39) = -( het_rates(k,172) ) - mat(k,151) = -( rxt(k,64) + het_rates(k,173) ) - mat(k,504) = -( rxt(k,65) + het_rates(k,174) ) - mat(k,522) = -( rxt(k,66) + rxt(k,493) + het_rates(k,175) ) - mat(k,393) = -( rxt(k,67) + het_rates(k,176) ) - mat(k,884) = -( rxt(k,68) + het_rates(k,177) ) - mat(k,317) = rxt(k,58) - mat(k,523) = rxt(k,66) - mat(k,395) = rxt(k,67) - mat(k,930) = -( rxt(k,69) + het_rates(k,178) ) - mat(k,507) = rxt(k,65) - mat(k,885) = rxt(k,68) - mat(k,550) = -( rxt(k,70) + het_rates(k,179) ) - mat(k,139) = -( het_rates(k,180) ) - mat(k,155) = -( rxt(k,71) + het_rates(k,181) ) - mat(k,160) = -( het_rates(k,182) ) - mat(k,591) = -( rxt(k,72) + het_rates(k,183) ) - mat(k,168) = -( het_rates(k,184) ) - mat(k,352) = -( rxt(k,73) + het_rates(k,185) ) - mat(k,429) = -( het_rates(k,188) ) - mat(k,107) = rxt(k,430) - mat(k,837) = -( het_rates(k,189) ) - mat(k,45) = -( het_rates(k,190) ) - mat(k,402) = -( het_rates(k,191) ) - mat(k,51) = -( het_rates(k,192) ) - mat(k,360) = -( het_rates(k,193) ) - mat(k,715) = -( het_rates(k,194) ) - mat(k,425) = rxt(k,52) - mat(k,686) = -( het_rates(k,195) ) - mat(k,530) = -( het_rates(k,196) ) - mat(k,1264) = -( het_rates(k,197) ) - mat(k,314) = .130_r8*rxt(k,23) - mat(k,250) = rxt(k,27) - mat(k,849) = rxt(k,35) - mat(k,1101) = rxt(k,36) - mat(k,921) = .330_r8*rxt(k,45) - mat(k,945) = rxt(k,47) - mat(k,1092) = 1.340_r8*rxt(k,50) - mat(k,426) = rxt(k,52) - mat(k,245) = rxt(k,53) - mat(k,1166) = .300_r8*rxt(k,55) - mat(k,753) = rxt(k,57) - mat(k,383) = .600_r8*rxt(k,60) + rxt(k,306) - mat(k,342) = rxt(k,63) - mat(k,153) = .500_r8*rxt(k,64) - mat(k,933) = .650_r8*rxt(k,69) - mat(k,1691) = -( het_rates(k,198) ) - mat(k,1029) = rxt(k,34) - mat(k,851) = rxt(k,35) - mat(k,438) = rxt(k,37) - mat(k,1172) = .300_r8*rxt(k,55) - mat(k,386) = .400_r8*rxt(k,60) - mat(k,1929) = rxt(k,175)*y(k,54) - mat(k,682) = rxt(k,231)*y(k,54) - mat(k,1510) = rxt(k,264)*y(k,54) - mat(k,1356) = rxt(k,271)*y(k,54) - mat(k,649) = -( het_rates(k,199) ) - mat(k,223) = .600_r8*rxt(k,25) - mat(k,477) = -( het_rates(k,200) ) - mat(k,206) = -( rxt(k,299) + rxt(k,300) + het_rates(k,201) ) - mat(k,98) = rxt(k,42) - mat(k,604) = -( het_rates(k,202) ) + mat(k,373) = -( rxt(k,486) + het_rates(k,115) ) + mat(k,1073) = -( rxt(k,56) + rxt(k,487) + het_rates(k,116) ) + mat(k,10) = -( het_rates(k,117) ) + mat(k,11) = -( het_rates(k,118) ) + mat(k,12) = -( het_rates(k,119) ) + mat(k,96) = -( het_rates(k,120) ) + mat(k,13) = -( rxt(k,488) + het_rates(k,121) ) + mat(k,14) = -( rxt(k,540) + het_rates(k,122) ) + mat(k,15) = -( rxt(k,539) + het_rates(k,123) ) + mat(k,1842) = -( rxt(k,15) + het_rates(k,124) ) + mat(k,276) = rxt(k,14) + mat(k,2194) = rxt(k,16) + .500_r8*rxt(k,489) + mat(k,1750) = rxt(k,17) + mat(k,495) = rxt(k,155) + mat(k,2201) = -( rxt(k,16) + rxt(k,489) + het_rates(k,125) ) + mat(k,1457) = rxt(k,9) + mat(k,407) = rxt(k,11) + rxt(k,173) + mat(k,277) = rxt(k,13) + rxt(k,174) + mat(k,1757) = rxt(k,18) + mat(k,675) = rxt(k,19) + mat(k,1163) = rxt(k,45) + mat(k,402) = rxt(k,48) + mat(k,580) = rxt(k,54) + rxt(k,355) + mat(k,1083) = rxt(k,56) + mat(k,862) = rxt(k,57) + mat(k,396) = rxt(k,58) + mat(k,246) = rxt(k,59) + mat(k,531) = .600_r8*rxt(k,60) + rxt(k,306) + mat(k,622) = rxt(k,66) + mat(k,545) = rxt(k,76) + mat(k,891) = rxt(k,95) + mat(k,140) = rxt(k,430) + mat(k,1749) = -( rxt(k,17) + rxt(k,18) + rxt(k,490) + het_rates(k,126) ) + mat(k,405) = rxt(k,10) + mat(k,275) = rxt(k,13) + rxt(k,14) + rxt(k,174) + mat(k,529) = .400_r8*rxt(k,60) + mat(k,544) = rxt(k,77) + mat(k,887) = rxt(k,94) + mat(k,857) = -( rxt(k,57) + het_rates(k,127) ) + mat(k,391) = -( rxt(k,58) + rxt(k,491) + het_rates(k,128) ) + mat(k,16) = -( het_rates(k,129) ) + mat(k,17) = -( het_rates(k,130) ) + mat(k,18) = -( het_rates(k,131) ) + mat(k,19) = -( het_rates(k,132) ) + mat(k,2258) = -( rxt(k,132) + het_rates(k,133) ) + mat(k,2284) = rxt(k,3) + mat(k,2136) = rxt(k,8) + mat(k,278) = rxt(k,14) + mat(k,1851) = rxt(k,15) + mat(k,2203) = rxt(k,16) + mat(k,1759) = rxt(k,18) + mat(k,1441) = .180_r8*rxt(k,39) + mat(k,803) = rxt(k,41) + mat(k,2227) = rxt(k,75) + mat(k,1984) = rxt(k,93) + mat(k,332) = rxt(k,107) + mat(k,1243) = rxt(k,111) + rxt(k,473) + mat(k,836) = rxt(k,112) + mat(k,259) = rxt(k,113) + mat(k,1538) = rxt(k,127) + rxt(k,128) + mat(k,497) = rxt(k,155) + mat(k,516) = rxt(k,466) + mat(k,2132) = -( rxt(k,7) + rxt(k,8) + het_rates(k,134) ) + mat(k,2254) = rxt(k,132) + mat(k,20) = -( het_rates(k,135) ) + mat(k,328) = -( rxt(k,107) + het_rates(k,136) ) + mat(k,357) = -( rxt(k,110) + het_rates(k,137) ) + mat(k,244) = -( rxt(k,59) + rxt(k,492) + het_rates(k,138) ) + mat(k,524) = -( rxt(k,60) + rxt(k,306) + het_rates(k,139) ) + mat(k,138) = -( rxt(k,430) + het_rates(k,140) ) + mat(k,463) = -( het_rates(k,141) ) + mat(k,266) = rxt(k,31) + mat(k,174) = -( het_rates(k,142) ) + mat(k,333) = -( rxt(k,61) + het_rates(k,143) ) + mat(k,21) = -( het_rates(k,144) ) + mat(k,22) = -( het_rates(k,145) ) + mat(k,532) = -( rxt(k,62) + het_rates(k,146) ) + mat(k,409) = -( rxt(k,63) + het_rates(k,147) ) + mat(k,511) = -( rxt(k,466) + het_rates(k,148) ) + mat(k,358) = rxt(k,110) + mat(k,1230) = rxt(k,111) + mat(k,23) = -( rxt(k,108) + het_rates(k,149) ) + mat(k,1232) = -( rxt(k,111) + rxt(k,473) + het_rates(k,150) ) + mat(k,833) = rxt(k,112) + mat(k,512) = rxt(k,466) + mat(k,832) = -( rxt(k,112) + het_rates(k,151) ) + mat(k,258) = rxt(k,113) + mat(k,1231) = rxt(k,473) + mat(k,257) = -( rxt(k,113) + het_rates(k,152) ) + mat(k,133) = rxt(k,109) + mat(k,24) = -( het_rates(k,153) ) + mat(k,25) = -( het_rates(k,154) ) + mat(k,26) = -( het_rates(k,155) ) + mat(k,27) = -( rxt(k,114) + het_rates(k,156) ) + mat(k,28) = -( rxt(k,115) + het_rates(k,157) ) + mat(k,29) = -( rxt(k,116) + het_rates(k,158) ) + mat(k,30) = -( rxt(k,117) + het_rates(k,159) ) + mat(k,31) = -( rxt(k,118) + het_rates(k,160) ) + mat(k,32) = -( rxt(k,119) + het_rates(k,161) ) + mat(k,33) = -( rxt(k,120) + het_rates(k,162) ) + mat(k,34) = -( rxt(k,121) + het_rates(k,163) ) + mat(k,35) = -( rxt(k,122) + het_rates(k,164) ) + mat(k,36) = -( rxt(k,123) + het_rates(k,165) ) + mat(k,37) = -( het_rates(k,166) ) + mat(k,977) = rxt(k,480) + mat(k,38) = -( het_rates(k,167) ) + mat(k,39) = -( het_rates(k,168) ) + mat(k,40) = -( het_rates(k,169) ) + mat(k,41) = -( het_rates(k,170) ) + mat(k,42) = -( rxt(k,541) + het_rates(k,171) ) + mat(k,48) = -( het_rates(k,172) ) + mat(k,199) = -( rxt(k,64) + het_rates(k,173) ) + mat(k,642) = -( rxt(k,65) + het_rates(k,174) ) + mat(k,617) = -( rxt(k,66) + rxt(k,493) + het_rates(k,175) ) + mat(k,474) = -( rxt(k,67) + het_rates(k,176) ) + mat(k,969) = -( rxt(k,68) + het_rates(k,177) ) + mat(k,392) = rxt(k,58) + mat(k,618) = rxt(k,66) + mat(k,477) = rxt(k,67) + mat(k,1059) = -( rxt(k,69) + het_rates(k,178) ) + mat(k,645) = rxt(k,65) + mat(k,971) = rxt(k,68) end do end subroutine linmat02 subroutine linmat03( avec_len, mat, y, rxt, het_rates ) @@ -483,124 +473,162 @@ subroutine linmat03( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,1845) = -( rxt(k,481) + het_rates(k,203) ) - mat(k,337) = rxt(k,11) + rxt(k,172) - mat(k,570) = rxt(k,19) - mat(k,546) = .900_r8*rxt(k,20) - mat(k,309) = rxt(k,21) - mat(k,122) = 1.500_r8*rxt(k,22) - mat(k,315) = .560_r8*rxt(k,23) - mat(k,381) = rxt(k,24) - mat(k,224) = .600_r8*rxt(k,25) - mat(k,496) = .600_r8*rxt(k,26) - mat(k,251) = rxt(k,27) - mat(k,267) = rxt(k,28) - mat(k,272) = rxt(k,29) - mat(k,350) = rxt(k,30) - mat(k,1030) = rxt(k,34) - mat(k,1105) = rxt(k,36) - mat(k,912) = 2.000_r8*rxt(k,43) - mat(k,768) = 2.000_r8*rxt(k,44) - mat(k,927) = .670_r8*rxt(k,45) - mat(k,180) = rxt(k,46) - mat(k,948) = rxt(k,47) - mat(k,333) = rxt(k,48) - mat(k,586) = rxt(k,49) - mat(k,1096) = 1.340_r8*rxt(k,50) + .660_r8*rxt(k,51) - mat(k,906) = rxt(k,56) - mat(k,261) = rxt(k,61) - mat(k,447) = rxt(k,62) - mat(k,154) = rxt(k,64) - mat(k,512) = rxt(k,65) - mat(k,527) = rxt(k,66) - mat(k,399) = rxt(k,67) - mat(k,890) = rxt(k,68) - mat(k,937) = 1.200_r8*rxt(k,69) - mat(k,559) = rxt(k,70) - mat(k,601) = rxt(k,72) - mat(k,357) = rxt(k,73) - mat(k,1309) = rxt(k,137) - mat(k,371) = rxt(k,269) - mat(k,209) = rxt(k,299) + rxt(k,300) - mat(k,1154) = rxt(k,373) - mat(k,1932) = rxt(k,239)*y(k,43) + rxt(k,242)*y(k,46) - mat(k,1513) = rxt(k,240)*y(k,43) + rxt(k,243)*y(k,46) - mat(k,1359) = rxt(k,272)*y(k,54) - mat(k,366) = -( rxt(k,269) + het_rates(k,204) ) - mat(k,1214) = -( het_rates(k,205) ) - mat(k,1142) = -( rxt(k,373) + het_rates(k,206) ) - mat(k,57) = -( het_rates(k,207) ) - mat(k,63) = -( het_rates(k,208) ) - mat(k,1187) = -( het_rates(k,209) ) - mat(k,611) = -( het_rates(k,210) ) - mat(k,380) = .600_r8*rxt(k,24) - mat(k,1233) = -( het_rates(k,211) ) - mat(k,1091) = .660_r8*rxt(k,50) - mat(k,487) = rxt(k,54) + rxt(k,355) - mat(k,770) = -( het_rates(k,212) ) - mat(k,494) = .600_r8*rxt(k,26) - mat(k,572) = -( het_rates(k,213) ) - mat(k,71) = -( het_rates(k,214) ) - mat(k,997) = -( het_rates(k,215) ) - mat(k,1352) = -( rxt(k,126) + rxt(k,127) + rxt(k,166)*y(k,113) & - + rxt(k,167)*y(k,113) + rxt(k,199)*y(k,33) + rxt(k,200)*y(k,34) & - + rxt(k,201)*y(k,36) + rxt(k,202)*y(k,37) + rxt(k,203)*y(k,38) & - + rxt(k,204)*y(k,39) + rxt(k,205)*y(k,40) + rxt(k,226)*y(k,35) & - + rxt(k,227)*y(k,55) + rxt(k,228)*y(k,78) + rxt(k,249)*y(k,41) & - + rxt(k,250)*y(k,43) + rxt(k,251)*y(k,82) + rxt(k,252)*y(k,83) & - + rxt(k,253)*y(k,84) + rxt(k,271)*y(k,54) + rxt(k,272)*y(k,54) & - + rxt(k,273)*y(k,54) + het_rates(k,216) ) - mat(k,2067) = rxt(k,1) - mat(k,2042) = rxt(k,7) - mat(k,1507) = -( rxt(k,238)*y(k,41) + rxt(k,240)*y(k,43) + rxt(k,241)*y(k,44) & - + rxt(k,243)*y(k,46) + rxt(k,245)*y(k,55) + rxt(k,246)*y(k,82) & - + rxt(k,247)*y(k,83) + rxt(k,248)*y(k,84) + rxt(k,264)*y(k,54) & - + het_rates(k,217) ) - mat(k,2068) = rxt(k,2) - mat(k,498) = 2.000_r8*rxt(k,4) - mat(k,1294) = rxt(k,9) - mat(k,335) = rxt(k,10) - mat(k,544) = rxt(k,20) - mat(k,308) = rxt(k,21) - mat(k,266) = rxt(k,28) - mat(k,271) = rxt(k,29) - mat(k,349) = rxt(k,30) - mat(k,205) = rxt(k,31) - mat(k,437) = rxt(k,37) - mat(k,324) = rxt(k,38) - mat(k,99) = rxt(k,42) - mat(k,179) = rxt(k,46) - mat(k,246) = rxt(k,53) - mat(k,320) = rxt(k,58) - mat(k,260) = rxt(k,61) - mat(k,445) = rxt(k,62) - mat(k,343) = rxt(k,63) - mat(k,510) = rxt(k,65) - mat(k,397) = rxt(k,67) - mat(k,558) = rxt(k,70) - mat(k,157) = rxt(k,71) - mat(k,600) = rxt(k,72) - mat(k,356) = rxt(k,73) - mat(k,670) = rxt(k,105) - mat(k,726) = rxt(k,106) - mat(k,1548) = .500_r8*rxt(k,489) - mat(k,1353) = rxt(k,271)*y(k,54) - mat(k,373) = -( het_rates(k,218) ) - mat(k,658) = -( het_rates(k,219) ) - mat(k,1013) = -( het_rates(k,220) ) - mat(k,932) = .150_r8*rxt(k,69) - mat(k,978) = -( het_rates(k,221) ) - mat(k,956) = -( het_rates(k,222) ) - mat(k,622) = -( het_rates(k,223) ) - mat(k,77) = -( het_rates(k,224) ) - mat(k,1052) = -( het_rates(k,225) ) - mat(k,638) = -( het_rates(k,226) ) - mat(k,83) = -( het_rates(k,227) ) - mat(k,410) = -( het_rates(k,228) ) - mat(k,2080) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,229) ) - mat(k,102) = rxt(k,109) - mat(k,1519) = rxt(k,238)*y(k,41) + rxt(k,240)*y(k,43) + rxt(k,241)*y(k,44) & - + rxt(k,243)*y(k,46) + rxt(k,248)*y(k,84) + rxt(k,264)*y(k,54) + mat(k,655) = -( rxt(k,70) + het_rates(k,179) ) + mat(k,187) = -( het_rates(k,180) ) + mat(k,203) = -( rxt(k,71) + het_rates(k,181) ) + mat(k,208) = -( het_rates(k,182) ) + mat(k,701) = -( rxt(k,72) + het_rates(k,183) ) + mat(k,216) = -( het_rates(k,184) ) + mat(k,427) = -( rxt(k,73) + het_rates(k,185) ) + mat(k,518) = -( het_rates(k,188) ) + mat(k,139) = rxt(k,430) + mat(k,899) = -( het_rates(k,189) ) + mat(k,54) = -( het_rates(k,190) ) + mat(k,483) = -( het_rates(k,191) ) + mat(k,60) = -( het_rates(k,192) ) + mat(k,435) = -( het_rates(k,193) ) + mat(k,815) = -( het_rates(k,194) ) + mat(k,508) = rxt(k,52) + mat(k,791) = -( het_rates(k,195) ) + mat(k,625) = -( het_rates(k,196) ) + mat(k,1386) = -( het_rates(k,197) ) + mat(k,383) = .130_r8*rxt(k,23) + mat(k,326) = rxt(k,27) + mat(k,924) = rxt(k,35) + mat(k,1222) = rxt(k,36) + mat(k,1155) = .330_r8*rxt(k,45) + mat(k,1142) = rxt(k,47) + mat(k,1213) = 1.340_r8*rxt(k,50) + mat(k,509) = rxt(k,52) + mat(k,318) = rxt(k,53) + mat(k,1334) = .300_r8*rxt(k,55) + mat(k,859) = rxt(k,57) + mat(k,526) = .600_r8*rxt(k,60) + rxt(k,306) + mat(k,411) = rxt(k,63) + mat(k,201) = .500_r8*rxt(k,64) + mat(k,1062) = .650_r8*rxt(k,69) + mat(k,2070) = -( het_rates(k,198) ) + mat(k,1092) = rxt(k,34) + mat(k,926) = rxt(k,35) + mat(k,615) = rxt(k,37) + mat(k,1439) = rxt(k,40) + mat(k,1342) = .300_r8*rxt(k,55) + mat(k,530) = .400_r8*rxt(k,60) + mat(k,600) = rxt(k,87) + mat(k,370) = rxt(k,89) + mat(k,759) = -( het_rates(k,199) ) + mat(k,280) = .600_r8*rxt(k,25) + mat(k,564) = -( het_rates(k,200) ) + mat(k,269) = -( rxt(k,299) + rxt(k,300) + het_rates(k,201) ) + mat(k,130) = rxt(k,42) + mat(k,714) = -( het_rates(k,202) ) + mat(k,1950) = -( rxt(k,481) + het_rates(k,203) ) + mat(k,406) = rxt(k,11) + rxt(k,173) + mat(k,674) = rxt(k,19) + mat(k,641) = .900_r8*rxt(k,20) + mat(k,426) = rxt(k,21) + mat(k,173) = 1.500_r8*rxt(k,22) + mat(k,384) = .560_r8*rxt(k,23) + mat(k,462) = rxt(k,24) + mat(k,281) = .600_r8*rxt(k,25) + mat(k,593) = .600_r8*rxt(k,26) + mat(k,327) = rxt(k,27) + mat(k,343) = rxt(k,28) + mat(k,348) = rxt(k,29) + mat(k,419) = rxt(k,30) + mat(k,1091) = rxt(k,34) + mat(k,1226) = rxt(k,36) + mat(k,1100) = 2.000_r8*rxt(k,43) + mat(k,982) = 2.000_r8*rxt(k,44) + mat(k,1161) = .670_r8*rxt(k,45) + mat(k,234) = rxt(k,46) + mat(k,1145) = rxt(k,47) + mat(k,401) = rxt(k,48) + mat(k,696) = rxt(k,49) + mat(k,1216) = 1.340_r8*rxt(k,50) + .660_r8*rxt(k,51) + mat(k,1081) = rxt(k,56) + mat(k,337) = rxt(k,61) + mat(k,538) = rxt(k,62) + mat(k,202) = rxt(k,64) + mat(k,651) = rxt(k,65) + mat(k,621) = rxt(k,66) + mat(k,480) = rxt(k,67) + mat(k,976) = rxt(k,68) + mat(k,1065) = 1.200_r8*rxt(k,69) + mat(k,664) = rxt(k,70) + mat(k,711) = rxt(k,72) + mat(k,432) = rxt(k,73) + mat(k,1468) = rxt(k,138) + mat(k,445) = rxt(k,269) + mat(k,272) = rxt(k,299) + rxt(k,300) + mat(k,1298) = rxt(k,373) + mat(k,441) = -( rxt(k,269) + het_rates(k,204) ) + mat(k,1256) = -( het_rates(k,205) ) + mat(k,1288) = -( rxt(k,373) + het_rates(k,206) ) + mat(k,66) = -( het_rates(k,207) ) + mat(k,72) = -( het_rates(k,208) ) + mat(k,1311) = -( het_rates(k,209) ) + mat(k,721) = -( het_rates(k,210) ) + mat(k,461) = .600_r8*rxt(k,24) + mat(k,1354) = -( het_rates(k,211) ) + mat(k,1212) = .660_r8*rxt(k,50) + mat(k,575) = rxt(k,54) + rxt(k,355) + mat(k,873) = -( het_rates(k,212) ) + mat(k,591) = .600_r8*rxt(k,26) + mat(k,677) = -( het_rates(k,213) ) + mat(k,80) = -( het_rates(k,214) ) + mat(k,1045) = -( het_rates(k,215) ) + mat(k,1526) = -( rxt(k,127) + rxt(k,128) + het_rates(k,216) ) + mat(k,2272) = rxt(k,1) + mat(k,2124) = rxt(k,7) + mat(k,184) = rxt(k,12) + mat(k,1691) = -( het_rates(k,217) ) + mat(k,2273) = rxt(k,2) + mat(k,604) = 2.000_r8*rxt(k,4) + mat(k,1451) = rxt(k,9) + mat(k,404) = rxt(k,10) + mat(k,640) = rxt(k,20) + mat(k,425) = rxt(k,21) + mat(k,342) = rxt(k,28) + mat(k,347) = rxt(k,29) + mat(k,418) = rxt(k,30) + mat(k,268) = rxt(k,31) + mat(k,614) = rxt(k,37) + mat(k,388) = rxt(k,38) + mat(k,1435) = .330_r8*rxt(k,39) + mat(k,131) = rxt(k,42) + mat(k,233) = rxt(k,46) + mat(k,695) = rxt(k,49) + mat(k,319) = rxt(k,53) + mat(k,395) = rxt(k,58) + mat(k,336) = rxt(k,61) + mat(k,537) = rxt(k,62) + mat(k,413) = rxt(k,63) + mat(k,650) = rxt(k,65) + mat(k,479) = rxt(k,67) + mat(k,663) = rxt(k,70) + mat(k,205) = rxt(k,71) + mat(k,710) = rxt(k,72) + mat(k,431) = rxt(k,73) + mat(k,780) = rxt(k,105) + mat(k,825) = rxt(k,106) + mat(k,2192) = .500_r8*rxt(k,489) + mat(k,454) = -( het_rates(k,218) ) + mat(k,768) = -( het_rates(k,219) ) + mat(k,1129) = -( het_rates(k,220) ) + mat(k,1061) = .150_r8*rxt(k,69) + mat(k,1115) = -( het_rates(k,221) ) + mat(k,912) = -( het_rates(k,222) ) + mat(k,732) = -( het_rates(k,223) ) + mat(k,86) = -( het_rates(k,224) ) + mat(k,1173) = -( het_rates(k,225) ) + mat(k,748) = -( het_rates(k,226) ) + mat(k,92) = -( het_rates(k,227) ) + mat(k,499) = -( het_rates(k,228) ) + mat(k,2285) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,229) ) + mat(k,1442) = .050_r8*rxt(k,39) + mat(k,134) = rxt(k,109) + mat(k,1959) = rxt(k,481) end do end subroutine linmat03 subroutine linmat( avec_len, mat, y, rxt, het_rates ) diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 index 20015e3b81..7b095e1f81 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_factor.F90 @@ -50,30 +50,24 @@ subroutine lu_fac01( avec_len, lu ) lu(k,31) = 1._r8 / lu(k,31) lu(k,32) = 1._r8 / lu(k,32) lu(k,33) = 1._r8 / lu(k,33) + 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) = 1._r8 / lu(k,37) + lu(k,38) = 1._r8 / lu(k,38) lu(k,39) = 1._r8 / lu(k,39) - lu(k,45) = 1._r8 / lu(k,45) - lu(k,51) = 1._r8 / lu(k,51) - lu(k,57) = 1._r8 / lu(k,57) - lu(k,63) = 1._r8 / lu(k,63) - lu(k,65) = 1._r8 / lu(k,65) - lu(k,71) = 1._r8 / lu(k,71) - lu(k,77) = 1._r8 / lu(k,77) - lu(k,83) = 1._r8 / lu(k,83) - 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,1507) = lu(k,1507) - lu(k,85) * lu(k,1380) - lu(k,1519) = lu(k,1519) - lu(k,86) * lu(k,1380) - lu(k,87) = 1._r8 / lu(k,87) - lu(k,88) = lu(k,88) * lu(k,87) - lu(k,89) = lu(k,89) * lu(k,87) - lu(k,1507) = lu(k,1507) - lu(k,88) * lu(k,1381) - lu(k,1513) = lu(k,1513) - lu(k,89) * lu(k,1381) - lu(k,90) = 1._r8 / lu(k,90) - lu(k,91) = lu(k,91) * lu(k,90) - lu(k,92) = lu(k,92) * lu(k,90) - lu(k,1327) = lu(k,1327) - lu(k,91) * lu(k,1316) - lu(k,1338) = lu(k,1338) - lu(k,92) * lu(k,1316) + lu(k,40) = 1._r8 / lu(k,40) + lu(k,41) = 1._r8 / lu(k,41) + lu(k,42) = 1._r8 / lu(k,42) + lu(k,48) = 1._r8 / lu(k,48) + lu(k,54) = 1._r8 / lu(k,54) + lu(k,60) = 1._r8 / lu(k,60) + lu(k,66) = 1._r8 / lu(k,66) + lu(k,72) = 1._r8 / lu(k,72) + lu(k,74) = 1._r8 / lu(k,74) + lu(k,80) = 1._r8 / lu(k,80) + lu(k,86) = 1._r8 / lu(k,86) + lu(k,92) = 1._r8 / lu(k,92) end do end subroutine lu_fac01 subroutine lu_fac02( avec_len, lu ) @@ -93,112 +87,102 @@ subroutine lu_fac02( avec_len, lu ) 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,1461) = lu(k,1461) - lu(k,94) * lu(k,1382) - lu(k,1507) = lu(k,1507) - lu(k,95) * lu(k,1382) - lu(k,1519) = lu(k,1519) - lu(k,96) * lu(k,1382) - 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,603) = lu(k,603) - lu(k,98) * lu(k,602) - lu(k,606) = - lu(k,99) * lu(k,602) - lu(k,1762) = - lu(k,98) * lu(k,1759) - lu(k,1839) = lu(k,1839) - lu(k,99) * lu(k,1759) - 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,194) = lu(k,194) - lu(k,101) * lu(k,193) - lu(k,197) = lu(k,197) - lu(k,102) * lu(k,193) - lu(k,2058) = lu(k,2058) - lu(k,101) * lu(k,2056) - lu(k,2080) = lu(k,2080) - lu(k,102) * lu(k,2056) - 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,581) = lu(k,581) - lu(k,104) * lu(k,579) - lu(k,584) = lu(k,584) - lu(k,105) * lu(k,579) - lu(k,1491) = lu(k,1491) - lu(k,104) * lu(k,1383) - lu(k,1507) = lu(k,1507) - lu(k,105) * lu(k,1383) - lu(k,106) = 1._r8 / lu(k,106) - lu(k,107) = lu(k,107) * lu(k,106) - lu(k,108) = lu(k,108) * lu(k,106) - lu(k,429) = lu(k,429) - lu(k,107) * lu(k,428) - lu(k,432) = lu(k,432) - lu(k,108) * lu(k,428) - lu(k,1526) = lu(k,1526) - lu(k,107) * lu(k,1520) - lu(k,1549) = lu(k,1549) - lu(k,108) * lu(k,1520) + lu(k,1977) = lu(k,1977) - lu(k,94) * lu(k,1960) + lu(k,1978) = lu(k,1978) - lu(k,95) * lu(k,1960) + lu(k,96) = 1._r8 / lu(k,96) + lu(k,97) = lu(k,97) * lu(k,96) + lu(k,98) = lu(k,98) * lu(k,96) + lu(k,1691) = lu(k,1691) - lu(k,97) * lu(k,1554) + lu(k,1703) = lu(k,1703) - lu(k,98) * lu(k,1554) + lu(k,99) = 1._r8 / lu(k,99) + lu(k,100) = lu(k,100) * lu(k,99) + lu(k,101) = lu(k,101) * lu(k,99) + lu(k,1526) = lu(k,1526) - lu(k,100) * lu(k,1499) + lu(k,1532) = lu(k,1532) - lu(k,101) * lu(k,1499) + lu(k,102) = 1._r8 / lu(k,102) + lu(k,103) = lu(k,103) * lu(k,102) + lu(k,104) = lu(k,104) * lu(k,102) + lu(k,1691) = lu(k,1691) - lu(k,103) * lu(k,1555) + lu(k,1694) = lu(k,1694) - lu(k,104) * lu(k,1555) + lu(k,105) = 1._r8 / lu(k,105) + lu(k,106) = lu(k,106) * lu(k,105) + lu(k,107) = lu(k,107) * lu(k,105) + lu(k,108) = lu(k,108) * lu(k,105) + lu(k,1512) = lu(k,1512) - lu(k,106) * lu(k,1500) + lu(k,1521) = lu(k,1521) - lu(k,107) * lu(k,1500) + lu(k,1526) = lu(k,1526) - lu(k,108) * lu(k,1500) lu(k,109) = 1._r8 / lu(k,109) lu(k,110) = lu(k,110) * lu(k,109) lu(k,111) = lu(k,111) * lu(k,109) - lu(k,1345) = lu(k,1345) - lu(k,110) * lu(k,1342) - lu(k,1352) = lu(k,1352) - lu(k,111) * lu(k,1342) - lu(k,1460) = - lu(k,110) * lu(k,1384) - lu(k,1506) = - lu(k,111) * lu(k,1384) + lu(k,112) = lu(k,112) * lu(k,109) + lu(k,1643) = lu(k,1643) - lu(k,110) * lu(k,1556) + lu(k,1691) = lu(k,1691) - lu(k,111) * lu(k,1556) + lu(k,1703) = lu(k,1703) - lu(k,112) * lu(k,1556) lu(k,113) = 1._r8 / lu(k,113) lu(k,114) = lu(k,114) * lu(k,113) lu(k,115) = lu(k,115) * lu(k,113) lu(k,116) = lu(k,116) * lu(k,113) - lu(k,117) = lu(k,117) * lu(k,113) - lu(k,118) = lu(k,118) * lu(k,113) - lu(k,1386) = lu(k,1386) - lu(k,114) * lu(k,1385) - lu(k,1387) = lu(k,1387) - lu(k,115) * lu(k,1385) - lu(k,1430) = lu(k,1430) - lu(k,116) * lu(k,1385) - lu(k,1507) = lu(k,1507) - lu(k,117) * lu(k,1385) - lu(k,1513) = lu(k,1513) - lu(k,118) * lu(k,1385) - lu(k,119) = 1._r8 / lu(k,119) - lu(k,120) = lu(k,120) * lu(k,119) - lu(k,121) = lu(k,121) * lu(k,119) - lu(k,122) = lu(k,122) * lu(k,119) - lu(k,1426) = - lu(k,120) * lu(k,1386) - lu(k,1483) = lu(k,1483) - lu(k,121) * lu(k,1386) - lu(k,1513) = lu(k,1513) - lu(k,122) * lu(k,1386) - lu(k,123) = 1._r8 / lu(k,123) - lu(k,124) = lu(k,124) * lu(k,123) - lu(k,125) = lu(k,125) * lu(k,123) - lu(k,126) = lu(k,126) * lu(k,123) - lu(k,127) = lu(k,127) * lu(k,123) - lu(k,1425) = lu(k,1425) - lu(k,124) * lu(k,1387) - lu(k,1428) = lu(k,1428) - lu(k,125) * lu(k,1387) - lu(k,1507) = lu(k,1507) - lu(k,126) * lu(k,1387) - lu(k,1513) = lu(k,1513) - lu(k,127) * lu(k,1387) - lu(k,128) = 1._r8 / lu(k,128) - lu(k,129) = lu(k,129) * lu(k,128) - lu(k,729) = lu(k,729) - lu(k,129) * lu(k,723) - lu(k,862) = lu(k,862) - lu(k,129) * lu(k,853) - lu(k,1338) = lu(k,1338) - lu(k,129) * lu(k,1317) - lu(k,1901) = lu(k,1901) - lu(k,129) * lu(k,1882) - lu(k,1935) = lu(k,1935) - lu(k,129) * lu(k,1905) - 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,1352) = lu(k,1352) - lu(k,131) * lu(k,1343) - lu(k,1353) = lu(k,1353) - lu(k,132) * lu(k,1343) - lu(k,1359) = lu(k,1359) - lu(k,133) * lu(k,1343) - lu(k,1506) = lu(k,1506) - lu(k,131) * lu(k,1388) - lu(k,1507) = lu(k,1507) - lu(k,132) * lu(k,1388) - lu(k,1513) = lu(k,1513) - lu(k,133) * lu(k,1388) - lu(k,134) = 1._r8 / lu(k,134) - lu(k,135) = lu(k,135) * lu(k,134) - lu(k,136) = lu(k,136) * lu(k,134) - lu(k,137) = lu(k,137) * lu(k,134) - lu(k,1345) = lu(k,1345) - lu(k,135) * lu(k,1344) - lu(k,1352) = lu(k,1352) - lu(k,136) * lu(k,1344) - lu(k,1362) = lu(k,1362) - lu(k,137) * lu(k,1344) - lu(k,1460) = lu(k,1460) - lu(k,135) * lu(k,1389) - lu(k,1506) = lu(k,1506) - lu(k,136) * lu(k,1389) - lu(k,1516) = lu(k,1516) - lu(k,137) * lu(k,1389) - lu(k,139) = 1._r8 / lu(k,139) - lu(k,140) = lu(k,140) * lu(k,139) - lu(k,141) = lu(k,141) * lu(k,139) - lu(k,142) = lu(k,142) * lu(k,139) - lu(k,143) = lu(k,143) * lu(k,139) - lu(k,144) = lu(k,144) * lu(k,139) - lu(k,145) = lu(k,145) * lu(k,139) - lu(k,1391) = lu(k,1391) - lu(k,140) * lu(k,1390) - lu(k,1392) = lu(k,1392) - lu(k,141) * lu(k,1390) - lu(k,1424) = lu(k,1424) - lu(k,142) * lu(k,1390) - lu(k,1456) = lu(k,1456) - lu(k,143) * lu(k,1390) - lu(k,1507) = lu(k,1507) - lu(k,144) * lu(k,1390) - lu(k,1513) = lu(k,1513) - lu(k,145) * lu(k,1390) + lu(k,1511) = lu(k,1511) - lu(k,114) * lu(k,1501) + lu(k,1526) = lu(k,1526) - lu(k,115) * lu(k,1501) + lu(k,1532) = lu(k,1532) - lu(k,116) * lu(k,1501) + lu(k,117) = 1._r8 / lu(k,117) + lu(k,118) = lu(k,118) * lu(k,117) + lu(k,119) = lu(k,119) * lu(k,117) + lu(k,120) = lu(k,120) * lu(k,117) + lu(k,1512) = lu(k,1512) - lu(k,118) * lu(k,1502) + lu(k,1526) = lu(k,1526) - lu(k,119) * lu(k,1502) + lu(k,1532) = lu(k,1532) - lu(k,120) * lu(k,1502) + lu(k,121) = 1._r8 / lu(k,121) + lu(k,122) = lu(k,122) * lu(k,121) + lu(k,123) = lu(k,123) * lu(k,121) + lu(k,124) = lu(k,124) * lu(k,121) + lu(k,1512) = lu(k,1512) - lu(k,122) * lu(k,1503) + lu(k,1526) = lu(k,1526) - lu(k,123) * lu(k,1503) + lu(k,1532) = lu(k,1532) - lu(k,124) * lu(k,1503) + lu(k,125) = 1._r8 / lu(k,125) + lu(k,126) = lu(k,126) * lu(k,125) + lu(k,127) = lu(k,127) * lu(k,125) + lu(k,128) = lu(k,128) * lu(k,125) + lu(k,1691) = lu(k,1691) - lu(k,126) * lu(k,1557) + lu(k,1696) = lu(k,1696) - lu(k,127) * lu(k,1557) + lu(k,1703) = lu(k,1703) - lu(k,128) * lu(k,1557) + lu(k,129) = 1._r8 / lu(k,129) + lu(k,130) = lu(k,130) * lu(k,129) + lu(k,131) = lu(k,131) * lu(k,129) + lu(k,713) = lu(k,713) - lu(k,130) * lu(k,712) + lu(k,717) = - lu(k,131) * lu(k,712) + lu(k,1868) = - lu(k,130) * lu(k,1865) + lu(k,1947) = lu(k,1947) - lu(k,131) * lu(k,1865) + lu(k,132) = 1._r8 / lu(k,132) + lu(k,133) = lu(k,133) * lu(k,132) + lu(k,134) = lu(k,134) * lu(k,132) + lu(k,257) = lu(k,257) - lu(k,133) * lu(k,256) + lu(k,260) = lu(k,260) - lu(k,134) * lu(k,256) + lu(k,2261) = lu(k,2261) - lu(k,133) * lu(k,2260) + lu(k,2285) = lu(k,2285) - lu(k,134) * lu(k,2260) + lu(k,135) = 1._r8 / lu(k,135) + lu(k,136) = lu(k,136) * lu(k,135) + lu(k,137) = lu(k,137) * lu(k,135) + lu(k,691) = lu(k,691) - lu(k,136) * lu(k,689) + lu(k,695) = lu(k,695) - lu(k,137) * lu(k,689) + lu(k,1673) = lu(k,1673) - lu(k,136) * lu(k,1558) + lu(k,1691) = lu(k,1691) - lu(k,137) * lu(k,1558) + lu(k,138) = 1._r8 / lu(k,138) + lu(k,139) = lu(k,139) * lu(k,138) + lu(k,140) = lu(k,140) * lu(k,138) + lu(k,518) = lu(k,518) - lu(k,139) * lu(k,517) + lu(k,523) = lu(k,523) - lu(k,140) * lu(k,517) + lu(k,2167) = lu(k,2167) - lu(k,139) * lu(k,2161) + lu(k,2201) = lu(k,2201) - lu(k,140) * lu(k,2161) + lu(k,141) = 1._r8 / lu(k,141) + lu(k,142) = lu(k,142) * lu(k,141) + lu(k,143) = lu(k,143) * lu(k,141) + lu(k,144) = lu(k,144) * lu(k,141) + lu(k,145) = lu(k,145) * lu(k,141) + lu(k,1512) = lu(k,1512) - lu(k,142) * lu(k,1504) + lu(k,1521) = lu(k,1521) - lu(k,143) * lu(k,1504) + lu(k,1526) = lu(k,1526) - lu(k,144) * lu(k,1504) + lu(k,1532) = lu(k,1532) - lu(k,145) * lu(k,1504) end do end subroutine lu_fac02 subroutine lu_fac03( avec_len, lu ) @@ -220,99 +204,103 @@ subroutine lu_fac03( avec_len, lu ) lu(k,148) = lu(k,148) * lu(k,146) lu(k,149) = lu(k,149) * lu(k,146) lu(k,150) = lu(k,150) * lu(k,146) - lu(k,1425) = lu(k,1425) - lu(k,147) * lu(k,1391) - lu(k,1428) = lu(k,1428) - lu(k,148) * lu(k,1391) - lu(k,1507) = lu(k,1507) - lu(k,149) * lu(k,1391) - lu(k,1513) = lu(k,1513) - lu(k,150) * lu(k,1391) + lu(k,1512) = lu(k,1512) - lu(k,147) * lu(k,1505) + lu(k,1519) = lu(k,1519) - lu(k,148) * lu(k,1505) + lu(k,1521) = lu(k,1521) - lu(k,149) * lu(k,1505) + lu(k,1526) = lu(k,1526) - lu(k,150) * lu(k,1505) lu(k,151) = 1._r8 / lu(k,151) lu(k,152) = lu(k,152) * lu(k,151) lu(k,153) = lu(k,153) * lu(k,151) lu(k,154) = lu(k,154) * lu(k,151) - lu(k,164) = - lu(k,152) * lu(k,159) - lu(k,165) = - lu(k,153) * lu(k,159) - lu(k,167) = lu(k,167) - lu(k,154) * lu(k,159) - lu(k,1483) = lu(k,1483) - lu(k,152) * lu(k,1392) - lu(k,1501) = lu(k,1501) - lu(k,153) * lu(k,1392) - lu(k,1513) = lu(k,1513) - lu(k,154) * lu(k,1392) - lu(k,155) = 1._r8 / lu(k,155) - lu(k,156) = lu(k,156) * lu(k,155) - lu(k,157) = lu(k,157) * lu(k,155) - lu(k,1052) = lu(k,1052) - lu(k,156) * lu(k,1046) - lu(k,1056) = - lu(k,157) * lu(k,1046) - lu(k,1491) = lu(k,1491) - lu(k,156) * lu(k,1393) - lu(k,1507) = lu(k,1507) - lu(k,157) * lu(k,1393) - lu(k,1824) = lu(k,1824) - lu(k,156) * lu(k,1760) - lu(k,1839) = lu(k,1839) - lu(k,157) * lu(k,1760) - 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,1395) = lu(k,1395) - lu(k,161) * lu(k,1394) - lu(k,1424) = lu(k,1424) - lu(k,162) * lu(k,1394) - lu(k,1457) = lu(k,1457) - lu(k,163) * lu(k,1394) - lu(k,1483) = lu(k,1483) - lu(k,164) * lu(k,1394) - lu(k,1501) = lu(k,1501) - lu(k,165) * lu(k,1394) - lu(k,1507) = lu(k,1507) - lu(k,166) * lu(k,1394) - lu(k,1513) = lu(k,1513) - lu(k,167) * lu(k,1394) - 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,1428) = lu(k,1428) - lu(k,169) * lu(k,1395) - lu(k,1431) = lu(k,1431) - lu(k,170) * lu(k,1395) - lu(k,1507) = lu(k,1507) - lu(k,171) * lu(k,1395) - lu(k,1513) = lu(k,1513) - lu(k,172) * lu(k,1395) - lu(k,173) = 1._r8 / lu(k,173) - lu(k,174) = lu(k,174) * lu(k,173) - lu(k,175) = lu(k,175) * lu(k,173) - lu(k,677) = lu(k,677) - lu(k,174) * lu(k,676) - lu(k,680) = lu(k,680) - lu(k,175) * lu(k,676) - lu(k,1034) = lu(k,1034) - lu(k,174) * lu(k,1033) - lu(k,1037) = lu(k,1037) - lu(k,175) * lu(k,1033) - lu(k,1289) = lu(k,1289) - lu(k,174) * lu(k,1288) - lu(k,1292) = - lu(k,175) * lu(k,1288) - lu(k,2059) = lu(k,2059) - lu(k,174) * lu(k,2057) - lu(k,2065) = lu(k,2065) - lu(k,175) * lu(k,2057) - 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,1127) = - lu(k,177) * lu(k,1124) - lu(k,1139) = - lu(k,178) * lu(k,1124) - lu(k,1149) = - lu(k,179) * lu(k,1124) - lu(k,1154) = lu(k,1154) - lu(k,180) * lu(k,1124) - lu(k,1442) = - lu(k,177) * lu(k,1396) - lu(k,1491) = lu(k,1491) - lu(k,178) * lu(k,1396) - lu(k,1507) = lu(k,1507) - lu(k,179) * lu(k,1396) - lu(k,1513) = lu(k,1513) - lu(k,180) * lu(k,1396) - lu(k,181) = 1._r8 / lu(k,181) - lu(k,182) = lu(k,182) * lu(k,181) - lu(k,183) = lu(k,183) * lu(k,181) - lu(k,922) = lu(k,922) - lu(k,182) * lu(k,913) - lu(k,924) = lu(k,924) - lu(k,183) * lu(k,913) - lu(k,981) = - lu(k,182) * lu(k,971) - lu(k,984) = lu(k,984) - lu(k,183) * lu(k,971) - lu(k,1503) = lu(k,1503) - lu(k,182) * lu(k,1397) - lu(k,1508) = lu(k,1508) - lu(k,183) * lu(k,1397) - lu(k,1634) = - lu(k,182) * lu(k,1573) - lu(k,1639) = lu(k,1639) - lu(k,183) * lu(k,1573) - lu(k,184) = 1._r8 / lu(k,184) - lu(k,185) = lu(k,185) * lu(k,184) - lu(k,186) = lu(k,186) * lu(k,184) - lu(k,789) = - lu(k,185) * lu(k,784) - lu(k,799) = lu(k,799) - lu(k,186) * lu(k,784) - lu(k,816) = - lu(k,185) * lu(k,811) - lu(k,826) = lu(k,826) - lu(k,186) * lu(k,811) - lu(k,1474) = lu(k,1474) - lu(k,185) * lu(k,1398) - lu(k,1507) = lu(k,1507) - lu(k,186) * lu(k,1398) - lu(k,2015) = - lu(k,185) * lu(k,2001) - lu(k,2043) = lu(k,2043) - lu(k,186) * lu(k,2001) + lu(k,155) = lu(k,155) * lu(k,151) + lu(k,1511) = lu(k,1511) - lu(k,152) * lu(k,1506) + lu(k,1512) = lu(k,1512) - lu(k,153) * lu(k,1506) + lu(k,1526) = lu(k,1526) - lu(k,154) * lu(k,1506) + lu(k,1532) = lu(k,1532) - lu(k,155) * lu(k,1506) + lu(k,156) = 1._r8 / lu(k,156) + lu(k,157) = lu(k,157) * lu(k,156) + lu(k,158) = lu(k,158) * lu(k,156) + lu(k,159) = lu(k,159) * lu(k,156) + lu(k,160) = lu(k,160) * lu(k,156) + lu(k,1512) = lu(k,1512) - lu(k,157) * lu(k,1507) + lu(k,1519) = lu(k,1519) - lu(k,158) * lu(k,1507) + lu(k,1526) = lu(k,1526) - lu(k,159) * lu(k,1507) + lu(k,1532) = lu(k,1532) - lu(k,160) * lu(k,1507) + lu(k,161) = 1._r8 / lu(k,161) + lu(k,162) = lu(k,162) * lu(k,161) + lu(k,827) = lu(k,827) - lu(k,162) * lu(k,823) + lu(k,889) = lu(k,889) - lu(k,162) * lu(k,882) + lu(k,1978) = lu(k,1978) - lu(k,162) * lu(k,1961) + lu(k,2017) = lu(k,2017) - lu(k,162) * lu(k,1986) + lu(k,2153) = lu(k,2153) - lu(k,162) * lu(k,2138) + lu(k,164) = 1._r8 / lu(k,164) + lu(k,165) = lu(k,165) * lu(k,164) + lu(k,166) = lu(k,166) * lu(k,164) + lu(k,167) = lu(k,167) * lu(k,164) + lu(k,168) = lu(k,168) * lu(k,164) + lu(k,169) = lu(k,169) * lu(k,164) + lu(k,1560) = lu(k,1560) - lu(k,165) * lu(k,1559) + lu(k,1561) = lu(k,1561) - lu(k,166) * lu(k,1559) + lu(k,1609) = lu(k,1609) - lu(k,167) * lu(k,1559) + lu(k,1691) = lu(k,1691) - lu(k,168) * lu(k,1559) + lu(k,1694) = lu(k,1694) - lu(k,169) * lu(k,1559) + lu(k,170) = 1._r8 / lu(k,170) + lu(k,171) = lu(k,171) * lu(k,170) + lu(k,172) = lu(k,172) * lu(k,170) + lu(k,173) = lu(k,173) * lu(k,170) + lu(k,1605) = - lu(k,171) * lu(k,1560) + lu(k,1668) = lu(k,1668) - lu(k,172) * lu(k,1560) + lu(k,1694) = lu(k,1694) - lu(k,173) * lu(k,1560) + lu(k,174) = 1._r8 / lu(k,174) + lu(k,175) = lu(k,175) * lu(k,174) + lu(k,176) = lu(k,176) * lu(k,174) + lu(k,177) = lu(k,177) * lu(k,174) + lu(k,178) = lu(k,178) * lu(k,174) + lu(k,1604) = lu(k,1604) - lu(k,175) * lu(k,1561) + lu(k,1606) = lu(k,1606) - lu(k,176) * lu(k,1561) + lu(k,1691) = lu(k,1691) - lu(k,177) * lu(k,1561) + lu(k,1694) = lu(k,1694) - lu(k,178) * lu(k,1561) + lu(k,179) = 1._r8 / lu(k,179) + lu(k,180) = lu(k,180) * lu(k,179) + lu(k,181) = lu(k,181) * lu(k,179) + lu(k,182) = lu(k,182) * lu(k,179) + lu(k,1526) = lu(k,1526) - lu(k,180) * lu(k,1508) + lu(k,1527) = lu(k,1527) - lu(k,181) * lu(k,1508) + lu(k,1530) = lu(k,1530) - lu(k,182) * lu(k,1508) + lu(k,1690) = - lu(k,180) * lu(k,1562) + lu(k,1691) = lu(k,1691) - lu(k,181) * lu(k,1562) + lu(k,1694) = lu(k,1694) - lu(k,182) * lu(k,1562) + lu(k,183) = 1._r8 / lu(k,183) + lu(k,184) = lu(k,184) * lu(k,183) + lu(k,185) = lu(k,185) * lu(k,183) + lu(k,493) = - lu(k,184) * lu(k,490) + lu(k,495) = lu(k,495) - lu(k,185) * lu(k,490) + lu(k,1526) = lu(k,1526) - lu(k,184) * lu(k,1509) + lu(k,1529) = lu(k,1529) - lu(k,185) * lu(k,1509) + lu(k,2191) = - lu(k,184) * lu(k,2162) + lu(k,2194) = lu(k,2194) - lu(k,185) * lu(k,2162) + lu(k,187) = 1._r8 / lu(k,187) + lu(k,188) = lu(k,188) * lu(k,187) + lu(k,189) = lu(k,189) * lu(k,187) + lu(k,190) = lu(k,190) * lu(k,187) + lu(k,191) = lu(k,191) * lu(k,187) + lu(k,192) = lu(k,192) * lu(k,187) + lu(k,193) = lu(k,193) * lu(k,187) + lu(k,1564) = lu(k,1564) - lu(k,188) * lu(k,1563) + lu(k,1565) = lu(k,1565) - lu(k,189) * lu(k,1563) + lu(k,1602) = lu(k,1602) - lu(k,190) * lu(k,1563) + lu(k,1638) = lu(k,1638) - lu(k,191) * lu(k,1563) + lu(k,1691) = lu(k,1691) - lu(k,192) * lu(k,1563) + lu(k,1694) = lu(k,1694) - lu(k,193) * lu(k,1563) + 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,1604) = lu(k,1604) - lu(k,195) * lu(k,1564) + lu(k,1606) = lu(k,1606) - lu(k,196) * lu(k,1564) + lu(k,1691) = lu(k,1691) - lu(k,197) * lu(k,1564) + lu(k,1694) = lu(k,1694) - lu(k,198) * lu(k,1564) end do end subroutine lu_fac03 subroutine lu_fac04( avec_len, lu ) @@ -329,125 +317,107 @@ subroutine lu_fac04( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,187) = 1._r8 / lu(k,187) - lu(k,188) = lu(k,188) * lu(k,187) - lu(k,189) = lu(k,189) * lu(k,187) - lu(k,669) = lu(k,669) - lu(k,188) * lu(k,667) - lu(k,674) = - lu(k,189) * lu(k,667) - lu(k,1324) = lu(k,1324) - lu(k,188) * lu(k,1318) - lu(k,1338) = lu(k,1338) - lu(k,189) * lu(k,1318) - lu(k,1707) = lu(k,1707) - lu(k,188) * lu(k,1701) - lu(k,1721) = lu(k,1721) - lu(k,189) * lu(k,1701) - lu(k,1887) = - lu(k,188) * lu(k,1883) - lu(k,1901) = lu(k,1901) - lu(k,189) * lu(k,1883) - lu(k,190) = 1._r8 / lu(k,190) - lu(k,191) = lu(k,191) * lu(k,190) - lu(k,192) = lu(k,192) * lu(k,190) - lu(k,265) = - lu(k,191) * lu(k,262) - lu(k,266) = lu(k,266) - lu(k,192) * lu(k,262) - lu(k,361) = - lu(k,191) * lu(k,358) - lu(k,362) = - lu(k,192) * lu(k,358) - lu(k,1434) = lu(k,1434) - lu(k,191) * lu(k,1399) - lu(k,1507) = lu(k,1507) - lu(k,192) * lu(k,1399) - lu(k,1588) = lu(k,1588) - lu(k,191) * lu(k,1574) - lu(k,1638) = lu(k,1638) - lu(k,192) * lu(k,1574) - 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,758) = lu(k,758) - lu(k,195) * lu(k,757) - lu(k,762) = lu(k,762) - lu(k,196) * lu(k,757) - lu(k,763) = - lu(k,197) * lu(k,757) - lu(k,1469) = lu(k,1469) - lu(k,195) * lu(k,1400) - lu(k,1514) = lu(k,1514) - lu(k,196) * lu(k,1400) - lu(k,1519) = lu(k,1519) - lu(k,197) * lu(k,1400) - lu(k,2060) = - lu(k,195) * lu(k,2058) - lu(k,2075) = lu(k,2075) - lu(k,196) * lu(k,2058) - lu(k,2080) = lu(k,2080) - lu(k,197) * lu(k,2058) - lu(k,198) = 1._r8 / lu(k,198) - lu(k,199) = lu(k,199) * lu(k,198) - lu(k,200) = lu(k,200) * lu(k,198) - lu(k,201) = lu(k,201) * lu(k,198) - lu(k,716) = lu(k,716) - lu(k,199) * lu(k,712) - lu(k,717) = - lu(k,200) * lu(k,712) - lu(k,722) = lu(k,722) - lu(k,201) * lu(k,712) - lu(k,1489) = lu(k,1489) - lu(k,199) * lu(k,1401) - lu(k,1507) = lu(k,1507) - lu(k,200) * lu(k,1401) - lu(k,1513) = lu(k,1513) - lu(k,201) * lu(k,1401) - lu(k,1673) = lu(k,1673) - lu(k,199) * lu(k,1651) - lu(k,1688) = - lu(k,200) * lu(k,1651) - lu(k,1694) = lu(k,1694) - lu(k,201) * lu(k,1651) - lu(k,202) = 1._r8 / lu(k,202) - lu(k,203) = lu(k,203) * lu(k,202) - lu(k,204) = lu(k,204) * lu(k,202) - lu(k,205) = lu(k,205) * lu(k,202) - lu(k,529) = lu(k,529) - lu(k,203) * lu(k,528) - lu(k,530) = lu(k,530) - lu(k,204) * lu(k,528) - lu(k,531) = - lu(k,205) * lu(k,528) - lu(k,1428) = lu(k,1428) - lu(k,203) * lu(k,1402) - lu(k,1447) = lu(k,1447) - lu(k,204) * lu(k,1402) - lu(k,1507) = lu(k,1507) - lu(k,205) * lu(k,1402) - lu(k,1780) = - lu(k,203) * lu(k,1761) - lu(k,1790) = lu(k,1790) - lu(k,204) * lu(k,1761) - lu(k,1839) = lu(k,1839) - lu(k,205) * lu(k,1761) - 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,605) = - lu(k,207) * lu(k,603) - lu(k,609) = lu(k,609) - lu(k,208) * lu(k,603) - lu(k,610) = lu(k,610) - lu(k,209) * lu(k,603) - lu(k,1613) = lu(k,1613) - lu(k,207) * lu(k,1575) - lu(k,1643) = lu(k,1643) - lu(k,208) * lu(k,1575) - lu(k,1644) = lu(k,1644) - lu(k,209) * lu(k,1575) - lu(k,1814) = - lu(k,207) * lu(k,1762) - lu(k,1844) = lu(k,1844) - lu(k,208) * lu(k,1762) - lu(k,1845) = lu(k,1845) - lu(k,209) * lu(k,1762) - lu(k,210) = 1._r8 / lu(k,210) - lu(k,211) = lu(k,211) * lu(k,210) - lu(k,212) = lu(k,212) * lu(k,210) - lu(k,213) = lu(k,213) * lu(k,210) - lu(k,214) = lu(k,214) * lu(k,210) - lu(k,215) = lu(k,215) * lu(k,210) - lu(k,1469) = lu(k,1469) - lu(k,211) * lu(k,1403) - lu(k,1503) = lu(k,1503) - lu(k,212) * lu(k,1403) - lu(k,1507) = lu(k,1507) - lu(k,213) * lu(k,1403) - lu(k,1513) = lu(k,1513) - lu(k,214) * lu(k,1403) - lu(k,1517) = lu(k,1517) - lu(k,215) * lu(k,1403) - lu(k,1948) = lu(k,1948) - lu(k,211) * lu(k,1941) - lu(k,1979) = lu(k,1979) - lu(k,212) * lu(k,1941) - lu(k,1983) = lu(k,1983) - lu(k,213) * lu(k,1941) - lu(k,1989) = lu(k,1989) - lu(k,214) * lu(k,1941) - lu(k,1993) = lu(k,1993) - lu(k,215) * lu(k,1941) + lu(k,199) = 1._r8 / lu(k,199) + lu(k,200) = lu(k,200) * lu(k,199) + lu(k,201) = lu(k,201) * lu(k,199) + lu(k,202) = lu(k,202) * lu(k,199) + lu(k,212) = - lu(k,200) * lu(k,207) + lu(k,213) = - lu(k,201) * lu(k,207) + lu(k,215) = lu(k,215) - lu(k,202) * lu(k,207) + lu(k,1668) = lu(k,1668) - lu(k,200) * lu(k,1565) + lu(k,1683) = lu(k,1683) - lu(k,201) * lu(k,1565) + lu(k,1694) = lu(k,1694) - lu(k,202) * lu(k,1565) + lu(k,203) = 1._r8 / lu(k,203) + lu(k,204) = lu(k,204) * lu(k,203) + lu(k,205) = lu(k,205) * lu(k,203) + lu(k,1173) = lu(k,1173) - lu(k,204) * lu(k,1166) + lu(k,1177) = - lu(k,205) * lu(k,1166) + lu(k,1673) = lu(k,1673) - lu(k,204) * lu(k,1566) + lu(k,1691) = lu(k,1691) - lu(k,205) * lu(k,1566) + lu(k,1930) = lu(k,1930) - lu(k,204) * lu(k,1866) + lu(k,1947) = lu(k,1947) - lu(k,205) * lu(k,1866) + lu(k,208) = 1._r8 / lu(k,208) + lu(k,209) = lu(k,209) * lu(k,208) + lu(k,210) = lu(k,210) * lu(k,208) + lu(k,211) = lu(k,211) * lu(k,208) + lu(k,212) = lu(k,212) * lu(k,208) + lu(k,213) = lu(k,213) * lu(k,208) + lu(k,214) = lu(k,214) * lu(k,208) + lu(k,215) = lu(k,215) * lu(k,208) + lu(k,1568) = lu(k,1568) - lu(k,209) * lu(k,1567) + lu(k,1602) = lu(k,1602) - lu(k,210) * lu(k,1567) + lu(k,1639) = lu(k,1639) - lu(k,211) * lu(k,1567) + lu(k,1668) = lu(k,1668) - lu(k,212) * lu(k,1567) + lu(k,1683) = lu(k,1683) - lu(k,213) * lu(k,1567) + lu(k,1691) = lu(k,1691) - lu(k,214) * lu(k,1567) + lu(k,1694) = lu(k,1694) - lu(k,215) * lu(k,1567) lu(k,216) = 1._r8 / lu(k,216) lu(k,217) = lu(k,217) * lu(k,216) lu(k,218) = lu(k,218) * lu(k,216) lu(k,219) = lu(k,219) * lu(k,216) lu(k,220) = lu(k,220) * lu(k,216) - lu(k,221) = lu(k,221) * lu(k,216) - lu(k,1544) = lu(k,1544) - lu(k,217) * lu(k,1521) - lu(k,1549) = lu(k,1549) - lu(k,218) * lu(k,1521) - lu(k,1550) = lu(k,1550) - lu(k,219) * lu(k,1521) - lu(k,1555) = lu(k,1555) - lu(k,220) * lu(k,1521) - lu(k,1558) = lu(k,1558) - lu(k,221) * lu(k,1521) - lu(k,1979) = lu(k,1979) - lu(k,217) * lu(k,1942) - lu(k,1984) = lu(k,1984) - lu(k,218) * lu(k,1942) - lu(k,1985) = lu(k,1985) - lu(k,219) * lu(k,1942) - lu(k,1990) = lu(k,1990) - lu(k,220) * lu(k,1942) - lu(k,1993) = lu(k,1993) - lu(k,221) * lu(k,1942) - lu(k,222) = 1._r8 / lu(k,222) - lu(k,223) = lu(k,223) * lu(k,222) - lu(k,224) = lu(k,224) * lu(k,222) - lu(k,553) = - lu(k,223) * lu(k,547) - lu(k,559) = lu(k,559) - lu(k,224) * lu(k,547) - lu(k,594) = - lu(k,223) * lu(k,587) - lu(k,601) = lu(k,601) - lu(k,224) * lu(k,587) - lu(k,623) = - lu(k,223) * lu(k,617) - lu(k,631) = lu(k,631) - lu(k,224) * lu(k,617) - lu(k,639) = - lu(k,223) * lu(k,632) - lu(k,648) = lu(k,648) - lu(k,224) * lu(k,632) - lu(k,1601) = lu(k,1601) - lu(k,223) * lu(k,1576) - lu(k,1644) = lu(k,1644) - lu(k,224) * lu(k,1576) + lu(k,1606) = lu(k,1606) - lu(k,217) * lu(k,1568) + lu(k,1611) = lu(k,1611) - lu(k,218) * lu(k,1568) + lu(k,1691) = lu(k,1691) - lu(k,219) * lu(k,1568) + lu(k,1694) = lu(k,1694) - lu(k,220) * lu(k,1568) + lu(k,221) = 1._r8 / lu(k,221) + lu(k,222) = lu(k,222) * lu(k,221) + lu(k,223) = lu(k,223) * lu(k,221) + lu(k,224) = lu(k,224) * lu(k,221) + lu(k,225) = lu(k,225) * lu(k,221) + lu(k,1511) = lu(k,1511) - lu(k,222) * lu(k,1510) + lu(k,1526) = lu(k,1526) - lu(k,223) * lu(k,1510) + lu(k,1527) = lu(k,1527) - lu(k,224) * lu(k,1510) + lu(k,1532) = lu(k,1532) - lu(k,225) * lu(k,1510) + lu(k,1570) = lu(k,1570) - lu(k,222) * lu(k,1569) + lu(k,1690) = lu(k,1690) - lu(k,223) * lu(k,1569) + lu(k,1691) = lu(k,1691) - lu(k,224) * lu(k,1569) + lu(k,1696) = lu(k,1696) - lu(k,225) * lu(k,1569) + lu(k,226) = 1._r8 / lu(k,226) + lu(k,227) = lu(k,227) * lu(k,226) + lu(k,228) = lu(k,228) * lu(k,226) + lu(k,229) = lu(k,229) * lu(k,226) + lu(k,1519) = lu(k,1519) - lu(k,227) * lu(k,1511) + lu(k,1526) = lu(k,1526) - lu(k,228) * lu(k,1511) + lu(k,1532) = lu(k,1532) - lu(k,229) * lu(k,1511) + lu(k,1651) = - lu(k,227) * lu(k,1570) + lu(k,1690) = lu(k,1690) - lu(k,228) * lu(k,1570) + lu(k,1696) = lu(k,1696) - lu(k,229) * lu(k,1570) + lu(k,230) = 1._r8 / lu(k,230) + lu(k,231) = lu(k,231) * lu(k,230) + lu(k,232) = lu(k,232) * lu(k,230) + lu(k,233) = lu(k,233) * lu(k,230) + lu(k,234) = lu(k,234) * lu(k,230) + lu(k,1275) = - lu(k,231) * lu(k,1272) + lu(k,1285) = - lu(k,232) * lu(k,1272) + lu(k,1295) = - lu(k,233) * lu(k,1272) + lu(k,1298) = lu(k,1298) - lu(k,234) * lu(k,1272) + lu(k,1622) = - lu(k,231) * lu(k,1571) + lu(k,1673) = lu(k,1673) - lu(k,232) * lu(k,1571) + lu(k,1691) = lu(k,1691) - lu(k,233) * lu(k,1571) + lu(k,1694) = lu(k,1694) - lu(k,234) * lu(k,1571) + lu(k,235) = 1._r8 / lu(k,235) + lu(k,236) = lu(k,236) * lu(k,235) + lu(k,237) = lu(k,237) * lu(k,235) + lu(k,249) = - lu(k,236) * lu(k,247) + lu(k,250) = lu(k,250) - lu(k,237) * lu(k,247) + lu(k,305) = - lu(k,236) * lu(k,303) + lu(k,306) = lu(k,306) - lu(k,237) * lu(k,303) + lu(k,1519) = lu(k,1519) - lu(k,236) * lu(k,1512) + lu(k,1526) = lu(k,1526) - lu(k,237) * lu(k,1512) + lu(k,1651) = lu(k,1651) - lu(k,236) * lu(k,1572) + lu(k,1690) = lu(k,1690) - lu(k,237) * lu(k,1572) + lu(k,238) = 1._r8 / lu(k,238) + lu(k,239) = lu(k,239) * lu(k,238) + lu(k,240) = lu(k,240) * lu(k,238) + lu(k,944) = - lu(k,239) * lu(k,941) + lu(k,960) = lu(k,960) - lu(k,240) * lu(k,941) + lu(k,993) = - lu(k,239) * lu(k,990) + lu(k,1010) = lu(k,1010) - lu(k,240) * lu(k,990) + lu(k,1654) = lu(k,1654) - lu(k,239) * lu(k,1573) + lu(k,1691) = lu(k,1691) - lu(k,240) * lu(k,1573) + lu(k,2093) = - lu(k,239) * lu(k,2082) + lu(k,2125) = lu(k,2125) - lu(k,240) * lu(k,2082) end do end subroutine lu_fac04 subroutine lu_fac05( avec_len, lu ) @@ -464,140 +434,120 @@ subroutine lu_fac05( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,225) = 1._r8 / lu(k,225) - lu(k,226) = lu(k,226) * lu(k,225) - lu(k,227) = lu(k,227) * lu(k,225) - lu(k,228) = lu(k,228) * lu(k,225) - lu(k,229) = lu(k,229) * lu(k,225) - lu(k,230) = lu(k,230) * lu(k,225) - lu(k,1463) = lu(k,1463) - lu(k,226) * lu(k,1404) - lu(k,1470) = lu(k,1470) - lu(k,227) * lu(k,1404) - lu(k,1483) = lu(k,1483) - lu(k,228) * lu(k,1404) - lu(k,1507) = lu(k,1507) - lu(k,229) * lu(k,1404) - lu(k,1513) = lu(k,1513) - lu(k,230) * lu(k,1404) - lu(k,1911) = - lu(k,226) * lu(k,1906) - lu(k,1914) = - lu(k,227) * lu(k,1906) - lu(k,1917) = lu(k,1917) - lu(k,228) * lu(k,1906) - lu(k,1926) = lu(k,1926) - lu(k,229) * lu(k,1906) - lu(k,1932) = lu(k,1932) - lu(k,230) * lu(k,1906) - lu(k,231) = 1._r8 / lu(k,231) - lu(k,232) = lu(k,232) * lu(k,231) - lu(k,233) = lu(k,233) * lu(k,231) - lu(k,234) = lu(k,234) * lu(k,231) - lu(k,235) = lu(k,235) * lu(k,231) - lu(k,236) = lu(k,236) * lu(k,231) - lu(k,1465) = lu(k,1465) - lu(k,232) * lu(k,1405) - lu(k,1507) = lu(k,1507) - lu(k,233) * lu(k,1405) - lu(k,1515) = lu(k,1515) - lu(k,234) * lu(k,1405) - lu(k,1516) = lu(k,1516) - lu(k,235) * lu(k,1405) - lu(k,1519) = lu(k,1519) - lu(k,236) * lu(k,1405) - lu(k,1912) = lu(k,1912) - lu(k,232) * lu(k,1907) - lu(k,1926) = lu(k,1926) - lu(k,233) * lu(k,1907) - lu(k,1934) = lu(k,1934) - lu(k,234) * lu(k,1907) - lu(k,1935) = lu(k,1935) - lu(k,235) * lu(k,1907) - lu(k,1938) = - lu(k,236) * lu(k,1907) - lu(k,237) = 1._r8 / lu(k,237) - lu(k,238) = lu(k,238) * lu(k,237) - lu(k,239) = lu(k,239) * lu(k,237) - lu(k,240) = lu(k,240) * lu(k,237) - lu(k,241) = lu(k,241) * lu(k,237) - lu(k,1187) = lu(k,1187) - lu(k,238) * lu(k,1178) - lu(k,1188) = - lu(k,239) * lu(k,1178) - lu(k,1192) = - lu(k,240) * lu(k,1178) - lu(k,1197) = lu(k,1197) - lu(k,241) * lu(k,1178) - lu(k,1498) = lu(k,1498) - lu(k,238) * lu(k,1406) - lu(k,1500) = lu(k,1500) - lu(k,239) * lu(k,1406) - lu(k,1507) = lu(k,1507) - lu(k,240) * lu(k,1406) - lu(k,1513) = lu(k,1513) - lu(k,241) * lu(k,1406) - lu(k,1830) = lu(k,1830) - lu(k,238) * lu(k,1763) - lu(k,1832) = lu(k,1832) - lu(k,239) * lu(k,1763) - lu(k,1839) = lu(k,1839) - lu(k,240) * lu(k,1763) - lu(k,1845) = lu(k,1845) - lu(k,241) * lu(k,1763) - lu(k,242) = 1._r8 / lu(k,242) - lu(k,243) = lu(k,243) * lu(k,242) - lu(k,244) = lu(k,244) * lu(k,242) - lu(k,245) = lu(k,245) * lu(k,242) - lu(k,246) = lu(k,246) * lu(k,242) - lu(k,572) = lu(k,572) - lu(k,243) * lu(k,571) - lu(k,573) = lu(k,573) - lu(k,244) * lu(k,571) - lu(k,574) = lu(k,574) - lu(k,245) * lu(k,571) - lu(k,575) = lu(k,575) - lu(k,246) * lu(k,571) - lu(k,1451) = lu(k,1451) - lu(k,243) * lu(k,1407) - lu(k,1489) = lu(k,1489) - lu(k,244) * lu(k,1407) - lu(k,1501) = lu(k,1501) - lu(k,245) * lu(k,1407) - lu(k,1507) = lu(k,1507) - lu(k,246) * lu(k,1407) - lu(k,1793) = lu(k,1793) - lu(k,243) * lu(k,1764) - lu(k,1822) = lu(k,1822) - lu(k,244) * lu(k,1764) - lu(k,1833) = lu(k,1833) - lu(k,245) * lu(k,1764) - lu(k,1839) = lu(k,1839) - lu(k,246) * lu(k,1764) - lu(k,247) = 1._r8 / lu(k,247) - lu(k,248) = lu(k,248) * lu(k,247) - lu(k,249) = lu(k,249) * lu(k,247) - lu(k,250) = lu(k,250) * lu(k,247) - lu(k,251) = lu(k,251) * lu(k,247) - lu(k,597) = - lu(k,248) * lu(k,588) - lu(k,598) = lu(k,598) - lu(k,249) * lu(k,588) - lu(k,599) = - lu(k,250) * lu(k,588) - lu(k,601) = lu(k,601) - lu(k,251) * lu(k,588) - lu(k,642) = - lu(k,248) * lu(k,633) - lu(k,643) = lu(k,643) - lu(k,249) * lu(k,633) - lu(k,644) = - lu(k,250) * lu(k,633) - lu(k,648) = lu(k,648) - lu(k,251) * lu(k,633) - lu(k,1616) = lu(k,1616) - lu(k,248) * lu(k,1577) - lu(k,1626) = lu(k,1626) - lu(k,249) * lu(k,1577) - lu(k,1632) = lu(k,1632) - lu(k,250) * lu(k,1577) - lu(k,1644) = lu(k,1644) - lu(k,251) * lu(k,1577) - 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,1110) = lu(k,1110) - lu(k,253) * lu(k,1108) - lu(k,1111) = lu(k,1111) - lu(k,254) * lu(k,1108) - lu(k,1114) = lu(k,1114) - lu(k,255) * lu(k,1108) - lu(k,1120) = lu(k,1120) - lu(k,256) * lu(k,1108) - lu(k,1321) = lu(k,1321) - lu(k,253) * lu(k,1319) - lu(k,1323) = lu(k,1323) - lu(k,254) * lu(k,1319) - lu(k,1327) = lu(k,1327) - lu(k,255) * lu(k,1319) - lu(k,1336) = lu(k,1336) - lu(k,256) * lu(k,1319) - lu(k,1705) = lu(k,1705) - lu(k,253) * lu(k,1702) - lu(k,1706) = lu(k,1706) - lu(k,254) * lu(k,1702) - lu(k,1710) = lu(k,1710) - lu(k,255) * lu(k,1702) - lu(k,1719) = lu(k,1719) - lu(k,256) * lu(k,1702) + lu(k,241) = 1._r8 / lu(k,241) + lu(k,242) = lu(k,242) * lu(k,241) + lu(k,243) = lu(k,243) * lu(k,241) + lu(k,779) = lu(k,779) - lu(k,242) * lu(k,777) + lu(k,781) = - lu(k,243) * lu(k,777) + lu(k,1968) = lu(k,1968) - lu(k,242) * lu(k,1962) + lu(k,1978) = lu(k,1978) - lu(k,243) * lu(k,1962) + lu(k,2143) = - lu(k,242) * lu(k,2139) + lu(k,2153) = lu(k,2153) - lu(k,243) * lu(k,2139) + lu(k,2211) = lu(k,2211) - lu(k,242) * lu(k,2205) + lu(k,2221) = lu(k,2221) - lu(k,243) * lu(k,2205) + lu(k,244) = 1._r8 / lu(k,244) + lu(k,245) = lu(k,245) * lu(k,244) + lu(k,246) = lu(k,246) * lu(k,244) + lu(k,1118) = - lu(k,245) * lu(k,1107) + lu(k,1124) = lu(k,1124) - lu(k,246) * lu(k,1107) + lu(k,1156) = lu(k,1156) - lu(k,245) * lu(k,1146) + lu(k,1163) = lu(k,1163) - lu(k,246) * lu(k,1146) + lu(k,1687) = lu(k,1687) - lu(k,245) * lu(k,1574) + lu(k,1700) = lu(k,1700) - lu(k,246) * lu(k,1574) + lu(k,1836) = - lu(k,245) * lu(k,1773) + lu(k,1849) = lu(k,1849) - lu(k,246) * lu(k,1773) + 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,252) = lu(k,252) * lu(k,248) + lu(k,1519) = lu(k,1519) - lu(k,249) * lu(k,1513) + lu(k,1526) = lu(k,1526) - lu(k,250) * lu(k,1513) + lu(k,1527) = lu(k,1527) - lu(k,251) * lu(k,1513) + lu(k,1532) = lu(k,1532) - lu(k,252) * lu(k,1513) + lu(k,1651) = lu(k,1651) - lu(k,249) * lu(k,1575) + lu(k,1690) = lu(k,1690) - lu(k,250) * lu(k,1575) + lu(k,1691) = lu(k,1691) - lu(k,251) * lu(k,1575) + lu(k,1696) = lu(k,1696) - lu(k,252) * lu(k,1575) + lu(k,253) = 1._r8 / lu(k,253) + lu(k,254) = lu(k,254) * lu(k,253) + lu(k,255) = lu(k,255) * lu(k,253) + lu(k,341) = - lu(k,254) * lu(k,338) + lu(k,342) = lu(k,342) - lu(k,255) * lu(k,338) + lu(k,436) = - lu(k,254) * lu(k,433) + lu(k,437) = - lu(k,255) * lu(k,433) + lu(k,1614) = lu(k,1614) - lu(k,254) * lu(k,1576) + lu(k,1691) = lu(k,1691) - lu(k,255) * lu(k,1576) + lu(k,1788) = lu(k,1788) - lu(k,254) * lu(k,1774) + lu(k,1840) = lu(k,1840) - lu(k,255) * lu(k,1774) lu(k,257) = 1._r8 / lu(k,257) lu(k,258) = lu(k,258) * lu(k,257) lu(k,259) = lu(k,259) * lu(k,257) lu(k,260) = lu(k,260) * lu(k,257) - lu(k,261) = lu(k,261) * lu(k,257) - lu(k,373) = lu(k,373) - lu(k,258) * lu(k,372) - lu(k,374) = lu(k,374) - lu(k,259) * lu(k,372) - lu(k,375) = - lu(k,260) * lu(k,372) - lu(k,378) = lu(k,378) - lu(k,261) * lu(k,372) - lu(k,1425) = lu(k,1425) - lu(k,258) * lu(k,1408) - lu(k,1470) = lu(k,1470) - lu(k,259) * lu(k,1408) - lu(k,1507) = lu(k,1507) - lu(k,260) * lu(k,1408) - lu(k,1513) = lu(k,1513) - lu(k,261) * lu(k,1408) - lu(k,1778) = lu(k,1778) - lu(k,258) * lu(k,1765) - lu(k,1809) = lu(k,1809) - lu(k,259) * lu(k,1765) - lu(k,1839) = lu(k,1839) - lu(k,260) * lu(k,1765) - lu(k,1845) = lu(k,1845) - lu(k,261) * lu(k,1765) - lu(k,263) = 1._r8 / lu(k,263) - lu(k,264) = lu(k,264) * lu(k,263) - lu(k,265) = lu(k,265) * lu(k,263) - lu(k,266) = lu(k,266) * lu(k,263) - lu(k,267) = lu(k,267) * lu(k,263) - lu(k,360) = lu(k,360) - lu(k,264) * lu(k,359) - lu(k,361) = lu(k,361) - lu(k,265) * lu(k,359) - lu(k,362) = lu(k,362) - lu(k,266) * lu(k,359) - lu(k,365) = lu(k,365) - lu(k,267) * lu(k,359) - lu(k,1424) = lu(k,1424) - lu(k,264) * lu(k,1409) - lu(k,1434) = lu(k,1434) - lu(k,265) * lu(k,1409) - lu(k,1507) = lu(k,1507) - lu(k,266) * lu(k,1409) - lu(k,1513) = lu(k,1513) - lu(k,267) * lu(k,1409) - lu(k,1776) = lu(k,1776) - lu(k,264) * lu(k,1766) - lu(k,1784) = lu(k,1784) - lu(k,265) * lu(k,1766) - lu(k,1839) = lu(k,1839) - lu(k,266) * lu(k,1766) - lu(k,1845) = lu(k,1845) - lu(k,267) * lu(k,1766) + lu(k,832) = lu(k,832) - lu(k,258) * lu(k,831) + lu(k,836) = lu(k,836) - lu(k,259) * lu(k,831) + lu(k,837) = - lu(k,260) * lu(k,831) + lu(k,1648) = lu(k,1648) - lu(k,258) * lu(k,1577) + lu(k,1702) = lu(k,1702) - lu(k,259) * lu(k,1577) + lu(k,1703) = lu(k,1703) - lu(k,260) * lu(k,1577) + lu(k,2263) = - lu(k,258) * lu(k,2261) + lu(k,2284) = lu(k,2284) - lu(k,259) * lu(k,2261) + lu(k,2285) = lu(k,2285) - lu(k,260) * lu(k,2261) + lu(k,261) = 1._r8 / lu(k,261) + lu(k,262) = lu(k,262) * lu(k,261) + lu(k,263) = lu(k,263) * lu(k,261) + lu(k,264) = lu(k,264) * lu(k,261) + lu(k,816) = lu(k,816) - lu(k,262) * lu(k,812) + lu(k,818) = - lu(k,263) * lu(k,812) + lu(k,820) = lu(k,820) - lu(k,264) * lu(k,812) + lu(k,1666) = lu(k,1666) - lu(k,262) * lu(k,1578) + lu(k,1691) = lu(k,1691) - lu(k,263) * lu(k,1578) + lu(k,1694) = lu(k,1694) - lu(k,264) * lu(k,1578) + lu(k,2043) = lu(k,2043) - lu(k,262) * lu(k,2025) + lu(k,2064) = - lu(k,263) * lu(k,2025) + lu(k,2067) = lu(k,2067) - lu(k,264) * lu(k,2025) + lu(k,265) = 1._r8 / lu(k,265) + lu(k,266) = lu(k,266) * lu(k,265) + lu(k,267) = lu(k,267) * lu(k,265) + lu(k,268) = lu(k,268) * lu(k,265) + lu(k,624) = lu(k,624) - lu(k,266) * lu(k,623) + lu(k,625) = lu(k,625) - lu(k,267) * lu(k,623) + lu(k,626) = - lu(k,268) * lu(k,623) + lu(k,1606) = lu(k,1606) - lu(k,266) * lu(k,1579) + lu(k,1627) = lu(k,1627) - lu(k,267) * lu(k,1579) + lu(k,1691) = lu(k,1691) - lu(k,268) * lu(k,1579) + lu(k,1886) = - lu(k,266) * lu(k,1867) + lu(k,1894) = lu(k,1894) - lu(k,267) * lu(k,1867) + lu(k,1947) = lu(k,1947) - lu(k,268) * lu(k,1867) + lu(k,269) = 1._r8 / lu(k,269) + lu(k,270) = lu(k,270) * lu(k,269) + lu(k,271) = lu(k,271) * lu(k,269) + lu(k,272) = lu(k,272) * lu(k,269) + lu(k,715) = - lu(k,270) * lu(k,713) + lu(k,716) = lu(k,716) - lu(k,271) * lu(k,713) + lu(k,719) = lu(k,719) - lu(k,272) * lu(k,713) + lu(k,1818) = lu(k,1818) - lu(k,270) * lu(k,1775) + lu(k,1838) = lu(k,1838) - lu(k,271) * lu(k,1775) + lu(k,1843) = lu(k,1843) - lu(k,272) * lu(k,1775) + lu(k,1925) = - lu(k,270) * lu(k,1868) + lu(k,1945) = lu(k,1945) - lu(k,271) * lu(k,1868) + lu(k,1950) = lu(k,1950) - lu(k,272) * lu(k,1868) + lu(k,273) = 1._r8 / lu(k,273) + lu(k,274) = lu(k,274) * lu(k,273) + lu(k,275) = lu(k,275) * lu(k,273) + lu(k,276) = lu(k,276) * lu(k,273) + lu(k,277) = lu(k,277) * lu(k,273) + lu(k,278) = lu(k,278) * lu(k,273) + lu(k,1744) = lu(k,1744) - lu(k,274) * lu(k,1706) + lu(k,1749) = lu(k,1749) - lu(k,275) * lu(k,1706) + lu(k,1750) = lu(k,1750) - lu(k,276) * lu(k,1706) + lu(k,1757) = lu(k,1757) - lu(k,277) * lu(k,1706) + lu(k,1759) = lu(k,1759) - lu(k,278) * lu(k,1706) + lu(k,2188) = lu(k,2188) - lu(k,274) * lu(k,2163) + lu(k,2193) = lu(k,2193) - lu(k,275) * lu(k,2163) + lu(k,2194) = lu(k,2194) - lu(k,276) * lu(k,2163) + lu(k,2201) = lu(k,2201) - lu(k,277) * lu(k,2163) + lu(k,2203) = lu(k,2203) - lu(k,278) * lu(k,2163) end do end subroutine lu_fac05 subroutine lu_fac06( avec_len, lu ) @@ -614,145 +564,145 @@ subroutine lu_fac06( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - 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,715) = lu(k,715) - lu(k,269) * lu(k,713) - lu(k,716) = lu(k,716) - lu(k,270) * lu(k,713) - lu(k,717) = lu(k,717) - lu(k,271) * lu(k,713) - lu(k,722) = lu(k,722) - lu(k,272) * lu(k,713) - lu(k,1465) = lu(k,1465) - lu(k,269) * lu(k,1410) - lu(k,1489) = lu(k,1489) - lu(k,270) * lu(k,1410) - lu(k,1507) = lu(k,1507) - lu(k,271) * lu(k,1410) - lu(k,1513) = lu(k,1513) - lu(k,272) * lu(k,1410) - lu(k,1806) = lu(k,1806) - lu(k,269) * lu(k,1767) - lu(k,1822) = lu(k,1822) - lu(k,270) * lu(k,1767) - lu(k,1839) = lu(k,1839) - lu(k,271) * lu(k,1767) - lu(k,1845) = lu(k,1845) - lu(k,272) * lu(k,1767) - lu(k,273) = 1._r8 / lu(k,273) - lu(k,274) = lu(k,274) * lu(k,273) - lu(k,275) = lu(k,275) * lu(k,273) - lu(k,1139) = lu(k,1139) - lu(k,274) * lu(k,1125) - lu(k,1149) = lu(k,1149) - lu(k,275) * lu(k,1125) - lu(k,1255) = lu(k,1255) - lu(k,274) * lu(k,1246) - lu(k,1267) = lu(k,1267) - lu(k,275) * lu(k,1246) - lu(k,1491) = lu(k,1491) - lu(k,274) * lu(k,1411) - lu(k,1507) = lu(k,1507) - lu(k,275) * lu(k,1411) - lu(k,1623) = lu(k,1623) - lu(k,274) * lu(k,1578) - lu(k,1638) = lu(k,1638) - lu(k,275) * lu(k,1578) - lu(k,1674) = lu(k,1674) - lu(k,274) * lu(k,1652) - lu(k,1688) = lu(k,1688) - lu(k,275) * lu(k,1652) - lu(k,1967) = lu(k,1967) - lu(k,274) * lu(k,1943) - lu(k,1983) = lu(k,1983) - lu(k,275) * lu(k,1943) - 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,283) = lu(k,283) * lu(k,276) - lu(k,1432) = lu(k,1432) - lu(k,277) * lu(k,1412) - lu(k,1469) = lu(k,1469) - lu(k,278) * lu(k,1412) - lu(k,1483) = lu(k,1483) - lu(k,279) * lu(k,1412) - lu(k,1495) = lu(k,1495) - lu(k,280) * lu(k,1412) - lu(k,1504) = lu(k,1504) - lu(k,281) * lu(k,1412) - lu(k,1507) = lu(k,1507) - lu(k,282) * lu(k,1412) - lu(k,1514) = lu(k,1514) - lu(k,283) * lu(k,1412) - lu(k,1853) = - lu(k,277) * lu(k,1852) - lu(k,1859) = - lu(k,278) * lu(k,1852) - lu(k,1861) = lu(k,1861) - lu(k,279) * lu(k,1852) - lu(k,1863) = lu(k,1863) - lu(k,280) * lu(k,1852) - lu(k,1866) = lu(k,1866) - lu(k,281) * lu(k,1852) - lu(k,1869) = lu(k,1869) - lu(k,282) * lu(k,1852) - lu(k,1876) = lu(k,1876) - lu(k,283) * lu(k,1852) - lu(k,284) = 1._r8 / lu(k,284) - lu(k,285) = lu(k,285) * lu(k,284) - lu(k,286) = lu(k,286) * lu(k,284) - lu(k,287) = lu(k,287) * lu(k,284) - lu(k,288) = lu(k,288) * lu(k,284) - lu(k,289) = lu(k,289) * lu(k,284) - lu(k,290) = lu(k,290) * lu(k,284) - lu(k,291) = lu(k,291) * lu(k,284) - lu(k,1440) = lu(k,1440) - lu(k,285) * lu(k,1413) - lu(k,1475) = lu(k,1475) - lu(k,286) * lu(k,1413) - lu(k,1489) = lu(k,1489) - lu(k,287) * lu(k,1413) - lu(k,1507) = lu(k,1507) - lu(k,288) * lu(k,1413) - lu(k,1508) = lu(k,1508) - lu(k,289) * lu(k,1413) - lu(k,1512) = lu(k,1512) - lu(k,290) * lu(k,1413) - lu(k,1517) = lu(k,1517) - lu(k,291) * lu(k,1413) - lu(k,1945) = - lu(k,285) * lu(k,1944) - lu(k,1953) = lu(k,1953) - lu(k,286) * lu(k,1944) - lu(k,1966) = lu(k,1966) - lu(k,287) * lu(k,1944) - lu(k,1983) = lu(k,1983) - lu(k,288) * lu(k,1944) - lu(k,1984) = lu(k,1984) - lu(k,289) * lu(k,1944) - lu(k,1988) = lu(k,1988) - lu(k,290) * lu(k,1944) - lu(k,1993) = lu(k,1993) - lu(k,291) * lu(k,1944) - 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,1504) = lu(k,1504) - lu(k,293) * lu(k,1414) - lu(k,1507) = lu(k,1507) - lu(k,294) * lu(k,1414) - lu(k,1508) = lu(k,1508) - lu(k,295) * lu(k,1414) - lu(k,1509) = lu(k,1509) - lu(k,296) * lu(k,1414) - lu(k,1514) = lu(k,1514) - lu(k,297) * lu(k,1414) - lu(k,1545) = - lu(k,293) * lu(k,1522) - lu(k,1548) = lu(k,1548) - lu(k,294) * lu(k,1522) - lu(k,1549) = lu(k,1549) - lu(k,295) * lu(k,1522) - lu(k,1550) = lu(k,1550) - lu(k,296) * lu(k,1522) - lu(k,1555) = lu(k,1555) - lu(k,297) * lu(k,1522) - lu(k,1635) = - lu(k,293) * lu(k,1579) - lu(k,1638) = lu(k,1638) - lu(k,294) * lu(k,1579) - lu(k,1639) = lu(k,1639) - lu(k,295) * lu(k,1579) - lu(k,1640) = lu(k,1640) - lu(k,296) * lu(k,1579) - lu(k,1645) = lu(k,1645) - lu(k,297) * lu(k,1579) - lu(k,298) = 1._r8 / lu(k,298) - lu(k,299) = lu(k,299) * lu(k,298) - lu(k,300) = lu(k,300) * lu(k,298) - lu(k,301) = lu(k,301) * lu(k,298) - lu(k,302) = lu(k,302) * lu(k,298) - lu(k,303) = lu(k,303) * lu(k,298) - lu(k,1067) = - lu(k,299) * lu(k,1063) - lu(k,1069) = - lu(k,300) * lu(k,1063) - lu(k,1077) = - lu(k,301) * lu(k,1063) - lu(k,1079) = - lu(k,302) * lu(k,1063) - lu(k,1084) = lu(k,1084) - lu(k,303) * lu(k,1063) - lu(k,1468) = lu(k,1468) - lu(k,299) * lu(k,1415) - lu(k,1480) = lu(k,1480) - lu(k,300) * lu(k,1415) - lu(k,1503) = lu(k,1503) - lu(k,301) * lu(k,1415) - lu(k,1507) = lu(k,1507) - lu(k,302) * lu(k,1415) - lu(k,1513) = lu(k,1513) - lu(k,303) * lu(k,1415) - lu(k,1660) = - lu(k,299) * lu(k,1653) - lu(k,1665) = lu(k,1665) - lu(k,300) * lu(k,1653) - lu(k,1684) = - lu(k,301) * lu(k,1653) - lu(k,1688) = lu(k,1688) - lu(k,302) * lu(k,1653) - lu(k,1694) = lu(k,1694) - lu(k,303) * lu(k,1653) + lu(k,279) = 1._r8 / lu(k,279) + lu(k,280) = lu(k,280) * lu(k,279) + lu(k,281) = lu(k,281) * lu(k,279) + lu(k,658) = - lu(k,280) * lu(k,652) + lu(k,664) = lu(k,664) - lu(k,281) * lu(k,652) + lu(k,704) = - lu(k,280) * lu(k,697) + lu(k,711) = lu(k,711) - lu(k,281) * lu(k,697) + lu(k,733) = - lu(k,280) * lu(k,727) + lu(k,740) = lu(k,740) - lu(k,281) * lu(k,727) + lu(k,749) = - lu(k,280) * lu(k,742) + lu(k,757) = lu(k,757) - lu(k,281) * lu(k,742) + lu(k,1801) = lu(k,1801) - lu(k,280) * lu(k,1776) + lu(k,1843) = lu(k,1843) - lu(k,281) * lu(k,1776) + lu(k,282) = 1._r8 / lu(k,282) + lu(k,283) = lu(k,283) * lu(k,282) + lu(k,284) = lu(k,284) * lu(k,282) + lu(k,864) = lu(k,864) - lu(k,283) * lu(k,863) + lu(k,868) = lu(k,868) - lu(k,284) * lu(k,863) + lu(k,1400) = lu(k,1400) - lu(k,283) * lu(k,1399) + lu(k,1404) = lu(k,1404) - lu(k,284) * lu(k,1399) + lu(k,1427) = lu(k,1427) - lu(k,283) * lu(k,1425) + lu(k,1432) = lu(k,1432) - lu(k,284) * lu(k,1425) + lu(k,1444) = lu(k,1444) - lu(k,283) * lu(k,1443) + lu(k,1448) = - lu(k,284) * lu(k,1443) + lu(k,2264) = lu(k,2264) - lu(k,283) * lu(k,2262) + lu(k,2270) = lu(k,2270) - lu(k,284) * lu(k,2262) + lu(k,285) = 1._r8 / lu(k,285) + lu(k,286) = lu(k,286) * lu(k,285) + lu(k,287) = lu(k,287) * lu(k,285) + lu(k,288) = lu(k,288) * lu(k,285) + lu(k,289) = lu(k,289) * lu(k,285) + lu(k,290) = lu(k,290) * lu(k,285) + lu(k,1657) = lu(k,1657) - lu(k,286) * lu(k,1580) + lu(k,1660) = lu(k,1660) - lu(k,287) * lu(k,1580) + lu(k,1668) = lu(k,1668) - lu(k,288) * lu(k,1580) + lu(k,1691) = lu(k,1691) - lu(k,289) * lu(k,1580) + lu(k,1694) = lu(k,1694) - lu(k,290) * lu(k,1580) + lu(k,1999) = - lu(k,286) * lu(k,1987) + lu(k,2000) = - lu(k,287) * lu(k,1987) + lu(k,2003) = lu(k,2003) - lu(k,288) * lu(k,1987) + lu(k,2012) = lu(k,2012) - lu(k,289) * lu(k,1987) + lu(k,2015) = lu(k,2015) - lu(k,290) * lu(k,1987) + lu(k,291) = 1._r8 / lu(k,291) + lu(k,292) = lu(k,292) * lu(k,291) + lu(k,293) = lu(k,293) * lu(k,291) + lu(k,294) = lu(k,294) * lu(k,291) + lu(k,295) = lu(k,295) * lu(k,291) + lu(k,296) = lu(k,296) * lu(k,291) + lu(k,1646) = lu(k,1646) - lu(k,292) * lu(k,1581) + lu(k,1691) = lu(k,1691) - lu(k,293) * lu(k,1581) + lu(k,1696) = lu(k,1696) - lu(k,294) * lu(k,1581) + lu(k,1699) = lu(k,1699) - lu(k,295) * lu(k,1581) + lu(k,1703) = lu(k,1703) - lu(k,296) * lu(k,1581) + lu(k,1996) = lu(k,1996) - lu(k,292) * lu(k,1988) + lu(k,2012) = lu(k,2012) - lu(k,293) * lu(k,1988) + lu(k,2017) = lu(k,2017) - lu(k,294) * lu(k,1988) + lu(k,2020) = lu(k,2020) - lu(k,295) * lu(k,1988) + lu(k,2024) = - lu(k,296) * lu(k,1988) + lu(k,297) = 1._r8 / lu(k,297) + lu(k,298) = lu(k,298) * lu(k,297) + lu(k,299) = lu(k,299) * lu(k,297) + lu(k,300) = lu(k,300) * lu(k,297) + lu(k,301) = lu(k,301) * lu(k,297) + lu(k,302) = lu(k,302) * lu(k,297) + lu(k,1648) = lu(k,1648) - lu(k,298) * lu(k,1582) + lu(k,1687) = lu(k,1687) - lu(k,299) * lu(k,1582) + lu(k,1691) = lu(k,1691) - lu(k,300) * lu(k,1582) + lu(k,1692) = lu(k,1692) - lu(k,301) * lu(k,1582) + lu(k,1694) = lu(k,1694) - lu(k,302) * lu(k,1582) + lu(k,1711) = lu(k,1711) - lu(k,298) * lu(k,1707) + lu(k,1744) = lu(k,1744) - lu(k,299) * lu(k,1707) + lu(k,1748) = lu(k,1748) - lu(k,300) * lu(k,1707) + lu(k,1749) = lu(k,1749) - lu(k,301) * lu(k,1707) + lu(k,1751) = lu(k,1751) - lu(k,302) * lu(k,1707) lu(k,304) = 1._r8 / lu(k,304) lu(k,305) = lu(k,305) * lu(k,304) lu(k,306) = lu(k,306) * lu(k,304) lu(k,307) = lu(k,307) * lu(k,304) lu(k,308) = lu(k,308) * lu(k,304) lu(k,309) = lu(k,309) * lu(k,304) - lu(k,401) = lu(k,401) - lu(k,305) * lu(k,400) - lu(k,402) = lu(k,402) - lu(k,306) * lu(k,400) - lu(k,404) = lu(k,404) - lu(k,307) * lu(k,400) - lu(k,405) = - lu(k,308) * lu(k,400) - lu(k,408) = lu(k,408) - lu(k,309) * lu(k,400) - lu(k,1426) = lu(k,1426) - lu(k,305) * lu(k,1416) - lu(k,1430) = lu(k,1430) - lu(k,306) * lu(k,1416) - lu(k,1470) = lu(k,1470) - lu(k,307) * lu(k,1416) - lu(k,1507) = lu(k,1507) - lu(k,308) * lu(k,1416) - lu(k,1513) = lu(k,1513) - lu(k,309) * lu(k,1416) - lu(k,1779) = - lu(k,305) * lu(k,1768) - lu(k,1782) = lu(k,1782) - lu(k,306) * lu(k,1768) - lu(k,1809) = lu(k,1809) - lu(k,307) * lu(k,1768) - lu(k,1839) = lu(k,1839) - lu(k,308) * lu(k,1768) - lu(k,1845) = lu(k,1845) - lu(k,309) * lu(k,1768) + lu(k,1519) = lu(k,1519) - lu(k,305) * lu(k,1514) + lu(k,1526) = lu(k,1526) - lu(k,306) * lu(k,1514) + lu(k,1527) = lu(k,1527) - lu(k,307) * lu(k,1514) + lu(k,1532) = lu(k,1532) - lu(k,308) * lu(k,1514) + lu(k,1539) = lu(k,1539) - lu(k,309) * lu(k,1514) + lu(k,1651) = lu(k,1651) - lu(k,305) * lu(k,1583) + lu(k,1690) = lu(k,1690) - lu(k,306) * lu(k,1583) + lu(k,1691) = lu(k,1691) - lu(k,307) * lu(k,1583) + lu(k,1696) = lu(k,1696) - lu(k,308) * lu(k,1583) + lu(k,1703) = lu(k,1703) - lu(k,309) * lu(k,1583) + lu(k,310) = 1._r8 / lu(k,310) + lu(k,311) = lu(k,311) * lu(k,310) + lu(k,312) = lu(k,312) * lu(k,310) + lu(k,313) = lu(k,313) * lu(k,310) + lu(k,314) = lu(k,314) * lu(k,310) + lu(k,1311) = lu(k,1311) - lu(k,311) * lu(k,1304) + lu(k,1312) = - lu(k,312) * lu(k,1304) + lu(k,1316) = - lu(k,313) * lu(k,1304) + lu(k,1319) = lu(k,1319) - lu(k,314) * lu(k,1304) + lu(k,1680) = lu(k,1680) - lu(k,311) * lu(k,1584) + lu(k,1682) = lu(k,1682) - lu(k,312) * lu(k,1584) + lu(k,1691) = lu(k,1691) - lu(k,313) * lu(k,1584) + lu(k,1694) = lu(k,1694) - lu(k,314) * lu(k,1584) + lu(k,1936) = lu(k,1936) - lu(k,311) * lu(k,1869) + lu(k,1938) = lu(k,1938) - lu(k,312) * lu(k,1869) + lu(k,1947) = lu(k,1947) - lu(k,313) * lu(k,1869) + lu(k,1950) = lu(k,1950) - lu(k,314) * lu(k,1869) + lu(k,315) = 1._r8 / lu(k,315) + lu(k,316) = lu(k,316) * lu(k,315) + lu(k,317) = lu(k,317) * lu(k,315) + lu(k,318) = lu(k,318) * lu(k,315) + lu(k,319) = lu(k,319) * lu(k,315) + lu(k,677) = lu(k,677) - lu(k,316) * lu(k,676) + lu(k,678) = lu(k,678) - lu(k,317) * lu(k,676) + lu(k,679) = lu(k,679) - lu(k,318) * lu(k,676) + lu(k,680) = lu(k,680) - lu(k,319) * lu(k,676) + lu(k,1632) = lu(k,1632) - lu(k,316) * lu(k,1585) + lu(k,1666) = lu(k,1666) - lu(k,317) * lu(k,1585) + lu(k,1683) = lu(k,1683) - lu(k,318) * lu(k,1585) + lu(k,1691) = lu(k,1691) - lu(k,319) * lu(k,1585) + lu(k,1898) = lu(k,1898) - lu(k,316) * lu(k,1870) + lu(k,1924) = lu(k,1924) - lu(k,317) * lu(k,1870) + lu(k,1939) = lu(k,1939) - lu(k,318) * lu(k,1870) + lu(k,1947) = lu(k,1947) - lu(k,319) * lu(k,1870) + lu(k,320) = 1._r8 / lu(k,320) + lu(k,321) = lu(k,321) * lu(k,320) + lu(k,322) = lu(k,322) * lu(k,320) + lu(k,1285) = lu(k,1285) - lu(k,321) * lu(k,1273) + lu(k,1295) = lu(k,1295) - lu(k,322) * lu(k,1273) + lu(k,1377) = lu(k,1377) - lu(k,321) * lu(k,1367) + lu(k,1390) = lu(k,1390) - lu(k,322) * lu(k,1367) + lu(k,1673) = lu(k,1673) - lu(k,321) * lu(k,1586) + lu(k,1691) = lu(k,1691) - lu(k,322) * lu(k,1586) + lu(k,1731) = lu(k,1731) - lu(k,321) * lu(k,1708) + lu(k,1748) = lu(k,1748) - lu(k,322) * lu(k,1708) + lu(k,1824) = lu(k,1824) - lu(k,321) * lu(k,1777) + lu(k,1840) = lu(k,1840) - lu(k,322) * lu(k,1777) + lu(k,2049) = lu(k,2049) - lu(k,321) * lu(k,2026) + lu(k,2064) = lu(k,2064) - lu(k,322) * lu(k,2026) end do end subroutine lu_fac06 subroutine lu_fac07( avec_len, lu ) @@ -769,132 +719,157 @@ subroutine lu_fac07( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,310) = 1._r8 / lu(k,310) - lu(k,311) = lu(k,311) * lu(k,310) - lu(k,312) = lu(k,312) * lu(k,310) - lu(k,313) = lu(k,313) * lu(k,310) - lu(k,314) = lu(k,314) * lu(k,310) - lu(k,315) = lu(k,315) * lu(k,310) - lu(k,787) = - lu(k,311) * lu(k,785) - lu(k,793) = lu(k,793) - lu(k,312) * lu(k,785) - lu(k,797) = - lu(k,313) * lu(k,785) - lu(k,798) = lu(k,798) - lu(k,314) * lu(k,785) - lu(k,801) = lu(k,801) - lu(k,315) * lu(k,785) - lu(k,814) = - lu(k,311) * lu(k,812) - lu(k,820) = lu(k,820) - lu(k,312) * lu(k,812) - lu(k,824) = - lu(k,313) * lu(k,812) - lu(k,825) = lu(k,825) - lu(k,314) * lu(k,812) - lu(k,828) = lu(k,828) - lu(k,315) * lu(k,812) - lu(k,2012) = - lu(k,311) * lu(k,2002) - lu(k,2021) = lu(k,2021) - lu(k,312) * lu(k,2002) - lu(k,2030) = lu(k,2030) - lu(k,313) * lu(k,2002) - lu(k,2037) = lu(k,2037) - lu(k,314) * lu(k,2002) - lu(k,2049) = lu(k,2049) - lu(k,315) * lu(k,2002) - lu(k,316) = 1._r8 / lu(k,316) - lu(k,317) = lu(k,317) * lu(k,316) - lu(k,318) = lu(k,318) * lu(k,316) - lu(k,319) = lu(k,319) * lu(k,316) - lu(k,320) = lu(k,320) * lu(k,316) - lu(k,321) = lu(k,321) * lu(k,316) - lu(k,993) = lu(k,993) - lu(k,317) * lu(k,990) - lu(k,997) = lu(k,997) - lu(k,318) * lu(k,990) - lu(k,1000) = - lu(k,319) * lu(k,990) - lu(k,1002) = - lu(k,320) * lu(k,990) - lu(k,1003) = lu(k,1003) - lu(k,321) * lu(k,990) - lu(k,1478) = lu(k,1478) - lu(k,317) * lu(k,1417) - lu(k,1487) = lu(k,1487) - lu(k,318) * lu(k,1417) - lu(k,1503) = lu(k,1503) - lu(k,319) * lu(k,1417) - lu(k,1507) = lu(k,1507) - lu(k,320) * lu(k,1417) - lu(k,1508) = lu(k,1508) - lu(k,321) * lu(k,1417) - lu(k,1813) = - lu(k,317) * lu(k,1769) - lu(k,1820) = lu(k,1820) - lu(k,318) * lu(k,1769) - lu(k,1835) = - lu(k,319) * lu(k,1769) - lu(k,1839) = lu(k,1839) - lu(k,320) * lu(k,1769) - lu(k,1840) = lu(k,1840) - lu(k,321) * lu(k,1769) - lu(k,322) = 1._r8 / lu(k,322) - lu(k,323) = lu(k,323) * lu(k,322) - lu(k,324) = lu(k,324) * lu(k,322) - lu(k,325) = lu(k,325) * lu(k,322) - lu(k,326) = lu(k,326) * lu(k,322) - lu(k,327) = lu(k,327) * lu(k,322) - lu(k,1504) = lu(k,1504) - lu(k,323) * lu(k,1418) - lu(k,1507) = lu(k,1507) - lu(k,324) * lu(k,1418) - lu(k,1510) = lu(k,1510) - lu(k,325) * lu(k,1418) - lu(k,1512) = lu(k,1512) - lu(k,326) * lu(k,1418) - lu(k,1519) = lu(k,1519) - lu(k,327) * lu(k,1418) - lu(k,1685) = - lu(k,323) * lu(k,1654) - lu(k,1688) = lu(k,1688) - lu(k,324) * lu(k,1654) - lu(k,1691) = lu(k,1691) - lu(k,325) * lu(k,1654) - lu(k,1693) = lu(k,1693) - lu(k,326) * lu(k,1654) - lu(k,1700) = - lu(k,327) * lu(k,1654) - lu(k,1836) = lu(k,1836) - lu(k,323) * lu(k,1770) - lu(k,1839) = lu(k,1839) - lu(k,324) * lu(k,1770) - lu(k,1842) = lu(k,1842) - lu(k,325) * lu(k,1770) - lu(k,1844) = lu(k,1844) - lu(k,326) * lu(k,1770) - lu(k,1851) = lu(k,1851) - lu(k,327) * lu(k,1770) + 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,326) = lu(k,326) * lu(k,323) + lu(k,327) = lu(k,327) * lu(k,323) + lu(k,707) = - lu(k,324) * lu(k,698) + lu(k,708) = lu(k,708) - lu(k,325) * lu(k,698) + lu(k,709) = - lu(k,326) * lu(k,698) + lu(k,711) = lu(k,711) - lu(k,327) * lu(k,698) + lu(k,752) = - lu(k,324) * lu(k,743) + lu(k,753) = lu(k,753) - lu(k,325) * lu(k,743) + lu(k,754) = - lu(k,326) * lu(k,743) + lu(k,757) = lu(k,757) - lu(k,327) * lu(k,743) + lu(k,1819) = lu(k,1819) - lu(k,324) * lu(k,1778) + lu(k,1827) = lu(k,1827) - lu(k,325) * lu(k,1778) + lu(k,1833) = lu(k,1833) - lu(k,326) * lu(k,1778) + lu(k,1843) = lu(k,1843) - lu(k,327) * lu(k,1778) 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,1065) = - lu(k,329) * lu(k,1064) - lu(k,1067) = lu(k,1067) - lu(k,330) * lu(k,1064) - lu(k,1079) = lu(k,1079) - lu(k,331) * lu(k,1064) - lu(k,1080) = lu(k,1080) - lu(k,332) * lu(k,1064) - lu(k,1084) = lu(k,1084) - lu(k,333) * lu(k,1064) - lu(k,1452) = lu(k,1452) - lu(k,329) * lu(k,1419) - lu(k,1468) = lu(k,1468) - lu(k,330) * lu(k,1419) - lu(k,1507) = lu(k,1507) - lu(k,331) * lu(k,1419) - lu(k,1508) = lu(k,1508) - lu(k,332) * lu(k,1419) - lu(k,1513) = lu(k,1513) - lu(k,333) * lu(k,1419) - lu(k,1794) = lu(k,1794) - lu(k,329) * lu(k,1771) - lu(k,1808) = - lu(k,330) * lu(k,1771) - lu(k,1839) = lu(k,1839) - lu(k,331) * lu(k,1771) - lu(k,1840) = lu(k,1840) - lu(k,332) * lu(k,1771) - lu(k,1845) = lu(k,1845) - lu(k,333) * lu(k,1771) - lu(k,334) = 1._r8 / lu(k,334) - lu(k,335) = lu(k,335) * lu(k,334) - lu(k,336) = lu(k,336) * lu(k,334) - lu(k,337) = lu(k,337) * lu(k,334) - lu(k,338) = lu(k,338) * lu(k,334) - lu(k,339) = lu(k,339) * lu(k,334) - lu(k,1507) = lu(k,1507) - lu(k,335) * lu(k,1420) - lu(k,1508) = lu(k,1508) - lu(k,336) * lu(k,1420) - lu(k,1513) = lu(k,1513) - lu(k,337) * lu(k,1420) - lu(k,1517) = lu(k,1517) - lu(k,338) * lu(k,1420) - lu(k,1519) = lu(k,1519) - lu(k,339) * lu(k,1420) - lu(k,1548) = lu(k,1548) - lu(k,335) * lu(k,1523) - lu(k,1549) = lu(k,1549) - lu(k,336) * lu(k,1523) - lu(k,1554) = lu(k,1554) - lu(k,337) * lu(k,1523) - lu(k,1558) = lu(k,1558) - lu(k,338) * lu(k,1523) - lu(k,1560) = - lu(k,339) * lu(k,1523) - lu(k,1839) = lu(k,1839) - lu(k,335) * lu(k,1772) - lu(k,1840) = lu(k,1840) - lu(k,336) * lu(k,1772) - lu(k,1845) = lu(k,1845) - lu(k,337) * lu(k,1772) - lu(k,1849) = lu(k,1849) - lu(k,338) * lu(k,1772) - lu(k,1851) = lu(k,1851) - lu(k,339) * lu(k,1772) - lu(k,340) = 1._r8 / lu(k,340) - lu(k,341) = lu(k,341) * lu(k,340) - lu(k,342) = lu(k,342) * lu(k,340) - lu(k,343) = lu(k,343) * lu(k,340) - lu(k,344) = lu(k,344) * lu(k,340) - lu(k,345) = lu(k,345) * lu(k,340) - lu(k,1013) = lu(k,1013) - lu(k,341) * lu(k,1010) - lu(k,1015) = lu(k,1015) - lu(k,342) * lu(k,1010) - lu(k,1016) = lu(k,1016) - lu(k,343) * lu(k,1010) - lu(k,1020) = lu(k,1020) - lu(k,344) * lu(k,1010) - lu(k,1022) = - lu(k,345) * lu(k,1010) - lu(k,1488) = lu(k,1488) - lu(k,341) * lu(k,1421) - lu(k,1501) = lu(k,1501) - lu(k,342) * lu(k,1421) - lu(k,1507) = lu(k,1507) - lu(k,343) * lu(k,1421) - lu(k,1512) = lu(k,1512) - lu(k,344) * lu(k,1421) - lu(k,1519) = lu(k,1519) - lu(k,345) * lu(k,1421) - lu(k,1821) = lu(k,1821) - lu(k,341) * lu(k,1773) - lu(k,1833) = lu(k,1833) - lu(k,342) * lu(k,1773) - lu(k,1839) = lu(k,1839) - lu(k,343) * lu(k,1773) - lu(k,1844) = lu(k,1844) - lu(k,344) * lu(k,1773) - lu(k,1851) = lu(k,1851) - lu(k,345) * lu(k,1773) + lu(k,1231) = lu(k,1231) - lu(k,329) * lu(k,1229) + lu(k,1232) = lu(k,1232) - lu(k,330) * lu(k,1229) + lu(k,1238) = lu(k,1238) - lu(k,331) * lu(k,1229) + lu(k,1243) = lu(k,1243) - lu(k,332) * lu(k,1229) + lu(k,1965) = lu(k,1965) - lu(k,329) * lu(k,1963) + lu(k,1967) = lu(k,1967) - lu(k,330) * lu(k,1963) + lu(k,1977) = lu(k,1977) - lu(k,331) * lu(k,1963) + lu(k,1984) = lu(k,1984) - lu(k,332) * lu(k,1963) + lu(k,2209) = lu(k,2209) - lu(k,329) * lu(k,2206) + lu(k,2210) = lu(k,2210) - lu(k,330) * lu(k,2206) + lu(k,2220) = lu(k,2220) - lu(k,331) * lu(k,2206) + lu(k,2227) = lu(k,2227) - lu(k,332) * lu(k,2206) + lu(k,333) = 1._r8 / lu(k,333) + lu(k,334) = lu(k,334) * lu(k,333) + lu(k,335) = lu(k,335) * lu(k,333) + lu(k,336) = lu(k,336) * lu(k,333) + lu(k,337) = lu(k,337) * lu(k,333) + lu(k,454) = lu(k,454) - lu(k,334) * lu(k,453) + lu(k,455) = lu(k,455) - lu(k,335) * lu(k,453) + lu(k,456) = - lu(k,336) * lu(k,453) + lu(k,458) = lu(k,458) - lu(k,337) * lu(k,453) + lu(k,1604) = lu(k,1604) - lu(k,334) * lu(k,1587) + lu(k,1660) = lu(k,1660) - lu(k,335) * lu(k,1587) + lu(k,1691) = lu(k,1691) - lu(k,336) * lu(k,1587) + lu(k,1694) = lu(k,1694) - lu(k,337) * lu(k,1587) + lu(k,1884) = lu(k,1884) - lu(k,334) * lu(k,1871) + lu(k,1921) = lu(k,1921) - lu(k,335) * lu(k,1871) + lu(k,1947) = lu(k,1947) - lu(k,336) * lu(k,1871) + lu(k,1950) = lu(k,1950) - lu(k,337) * lu(k,1871) + lu(k,339) = 1._r8 / lu(k,339) + lu(k,340) = lu(k,340) * lu(k,339) + lu(k,341) = lu(k,341) * lu(k,339) + lu(k,342) = lu(k,342) * lu(k,339) + lu(k,343) = lu(k,343) * lu(k,339) + lu(k,435) = lu(k,435) - lu(k,340) * lu(k,434) + lu(k,436) = lu(k,436) - lu(k,341) * lu(k,434) + lu(k,437) = lu(k,437) - lu(k,342) * lu(k,434) + lu(k,439) = lu(k,439) - lu(k,343) * lu(k,434) + lu(k,1602) = lu(k,1602) - lu(k,340) * lu(k,1588) + lu(k,1614) = lu(k,1614) - lu(k,341) * lu(k,1588) + lu(k,1691) = lu(k,1691) - lu(k,342) * lu(k,1588) + lu(k,1694) = lu(k,1694) - lu(k,343) * lu(k,1588) + lu(k,1882) = lu(k,1882) - lu(k,340) * lu(k,1872) + lu(k,1890) = lu(k,1890) - lu(k,341) * lu(k,1872) + lu(k,1947) = lu(k,1947) - lu(k,342) * lu(k,1872) + lu(k,1950) = lu(k,1950) - lu(k,343) * lu(k,1872) + lu(k,344) = 1._r8 / lu(k,344) + lu(k,345) = lu(k,345) * lu(k,344) + lu(k,346) = lu(k,346) * lu(k,344) + lu(k,347) = lu(k,347) * lu(k,344) + lu(k,348) = lu(k,348) * lu(k,344) + lu(k,815) = lu(k,815) - lu(k,345) * lu(k,813) + lu(k,816) = lu(k,816) - lu(k,346) * lu(k,813) + lu(k,818) = lu(k,818) - lu(k,347) * lu(k,813) + lu(k,820) = lu(k,820) - lu(k,348) * lu(k,813) + lu(k,1646) = lu(k,1646) - lu(k,345) * lu(k,1589) + lu(k,1666) = lu(k,1666) - lu(k,346) * lu(k,1589) + lu(k,1691) = lu(k,1691) - lu(k,347) * lu(k,1589) + lu(k,1694) = lu(k,1694) - lu(k,348) * lu(k,1589) + lu(k,1912) = lu(k,1912) - lu(k,345) * lu(k,1873) + lu(k,1924) = lu(k,1924) - lu(k,346) * lu(k,1873) + lu(k,1947) = lu(k,1947) - lu(k,347) * lu(k,1873) + lu(k,1950) = lu(k,1950) - lu(k,348) * lu(k,1873) + lu(k,349) = 1._r8 / lu(k,349) + lu(k,350) = lu(k,350) * lu(k,349) + lu(k,351) = lu(k,351) * lu(k,349) + lu(k,352) = lu(k,352) * lu(k,349) + lu(k,353) = lu(k,353) * lu(k,349) + lu(k,354) = lu(k,354) * lu(k,349) + lu(k,355) = lu(k,355) * lu(k,349) + lu(k,356) = lu(k,356) * lu(k,349) + lu(k,1619) = lu(k,1619) - lu(k,350) * lu(k,1590) + lu(k,1656) = lu(k,1656) - lu(k,351) * lu(k,1590) + lu(k,1666) = lu(k,1666) - lu(k,352) * lu(k,1590) + lu(k,1689) = lu(k,1689) - lu(k,353) * lu(k,1590) + lu(k,1691) = lu(k,1691) - lu(k,354) * lu(k,1590) + lu(k,1692) = lu(k,1692) - lu(k,355) * lu(k,1590) + lu(k,1700) = lu(k,1700) - lu(k,356) * lu(k,1590) + lu(k,1710) = - lu(k,350) * lu(k,1709) + lu(k,1714) = lu(k,1714) - lu(k,351) * lu(k,1709) + lu(k,1724) = lu(k,1724) - lu(k,352) * lu(k,1709) + lu(k,1746) = lu(k,1746) - lu(k,353) * lu(k,1709) + lu(k,1748) = lu(k,1748) - lu(k,354) * lu(k,1709) + lu(k,1749) = lu(k,1749) - lu(k,355) * lu(k,1709) + lu(k,1757) = lu(k,1757) - lu(k,356) * lu(k,1709) + lu(k,357) = 1._r8 / lu(k,357) + lu(k,358) = lu(k,358) * lu(k,357) + lu(k,359) = lu(k,359) * lu(k,357) + lu(k,360) = lu(k,360) * lu(k,357) + lu(k,361) = lu(k,361) * lu(k,357) + lu(k,362) = lu(k,362) * lu(k,357) + lu(k,363) = lu(k,363) * lu(k,357) + lu(k,364) = lu(k,364) * lu(k,357) + lu(k,1613) = lu(k,1613) - lu(k,358) * lu(k,1591) + lu(k,1648) = lu(k,1648) - lu(k,359) * lu(k,1591) + lu(k,1668) = lu(k,1668) - lu(k,360) * lu(k,1591) + lu(k,1677) = lu(k,1677) - lu(k,361) * lu(k,1591) + lu(k,1688) = lu(k,1688) - lu(k,362) * lu(k,1591) + lu(k,1691) = lu(k,1691) - lu(k,363) * lu(k,1591) + lu(k,1702) = lu(k,1702) - lu(k,364) * lu(k,1591) + lu(k,2230) = - lu(k,358) * lu(k,2229) + lu(k,2236) = - lu(k,359) * lu(k,2229) + lu(k,2238) = lu(k,2238) - lu(k,360) * lu(k,2229) + lu(k,2239) = lu(k,2239) - lu(k,361) * lu(k,2229) + lu(k,2244) = lu(k,2244) - lu(k,362) * lu(k,2229) + lu(k,2247) = lu(k,2247) - lu(k,363) * lu(k,2229) + lu(k,2258) = lu(k,2258) - lu(k,364) * lu(k,2229) + lu(k,365) = 1._r8 / lu(k,365) + lu(k,366) = lu(k,366) * lu(k,365) + lu(k,367) = lu(k,367) * lu(k,365) + lu(k,368) = lu(k,368) * lu(k,365) + lu(k,369) = lu(k,369) * lu(k,365) + lu(k,370) = lu(k,370) * lu(k,365) + lu(k,371) = lu(k,371) * lu(k,365) + lu(k,372) = lu(k,372) * lu(k,365) + lu(k,1668) = lu(k,1668) - lu(k,366) * lu(k,1592) + lu(k,1691) = lu(k,1691) - lu(k,367) * lu(k,1592) + lu(k,1694) = lu(k,1694) - lu(k,368) * lu(k,1592) + lu(k,1696) = lu(k,1696) - lu(k,369) * lu(k,1592) + lu(k,1697) = lu(k,1697) - lu(k,370) * lu(k,1592) + lu(k,1699) = lu(k,1699) - lu(k,371) * lu(k,1592) + lu(k,1703) = lu(k,1703) - lu(k,372) * lu(k,1592) + lu(k,2003) = lu(k,2003) - lu(k,366) * lu(k,1989) + lu(k,2012) = lu(k,2012) - lu(k,367) * lu(k,1989) + lu(k,2015) = lu(k,2015) - lu(k,368) * lu(k,1989) + lu(k,2017) = lu(k,2017) - lu(k,369) * lu(k,1989) + lu(k,2018) = lu(k,2018) - lu(k,370) * lu(k,1989) + lu(k,2020) = lu(k,2020) - lu(k,371) * lu(k,1989) + lu(k,2024) = lu(k,2024) - lu(k,372) * lu(k,1989) end do end subroutine lu_fac07 subroutine lu_fac08( avec_len, lu ) @@ -911,155 +886,132 @@ subroutine lu_fac08( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,346) = 1._r8 / lu(k,346) - lu(k,347) = lu(k,347) * lu(k,346) - lu(k,348) = lu(k,348) * lu(k,346) - lu(k,349) = lu(k,349) * lu(k,346) - lu(k,350) = lu(k,350) * lu(k,346) - lu(k,351) = lu(k,351) * lu(k,346) - lu(k,686) = lu(k,686) - lu(k,347) * lu(k,685) - lu(k,687) = lu(k,687) - lu(k,348) * lu(k,685) - lu(k,689) = - lu(k,349) * lu(k,685) - lu(k,694) = lu(k,694) - lu(k,350) * lu(k,685) - lu(k,695) = - lu(k,351) * lu(k,685) - lu(k,1461) = lu(k,1461) - lu(k,347) * lu(k,1422) - lu(k,1475) = lu(k,1475) - lu(k,348) * lu(k,1422) - lu(k,1507) = lu(k,1507) - lu(k,349) * lu(k,1422) - lu(k,1513) = lu(k,1513) - lu(k,350) * lu(k,1422) - lu(k,1519) = lu(k,1519) - lu(k,351) * lu(k,1422) - lu(k,1803) = lu(k,1803) - lu(k,347) * lu(k,1774) - lu(k,1812) = - lu(k,348) * lu(k,1774) - lu(k,1839) = lu(k,1839) - lu(k,349) * lu(k,1774) - lu(k,1845) = lu(k,1845) - lu(k,350) * lu(k,1774) - lu(k,1851) = lu(k,1851) - lu(k,351) * lu(k,1774) - 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,410) = lu(k,410) - lu(k,353) * lu(k,409) - lu(k,411) = lu(k,411) - lu(k,354) * lu(k,409) - lu(k,412) = lu(k,412) - lu(k,355) * lu(k,409) - lu(k,413) = - lu(k,356) * lu(k,409) - lu(k,416) = lu(k,416) - lu(k,357) * lu(k,409) - lu(k,1431) = lu(k,1431) - lu(k,353) * lu(k,1423) - lu(k,1470) = lu(k,1470) - lu(k,354) * lu(k,1423) - lu(k,1494) = lu(k,1494) - lu(k,355) * lu(k,1423) - lu(k,1507) = lu(k,1507) - lu(k,356) * lu(k,1423) - lu(k,1513) = lu(k,1513) - lu(k,357) * lu(k,1423) - lu(k,1783) = lu(k,1783) - lu(k,353) * lu(k,1775) - lu(k,1809) = lu(k,1809) - lu(k,354) * lu(k,1775) - lu(k,1827) = lu(k,1827) - lu(k,355) * lu(k,1775) - lu(k,1839) = lu(k,1839) - lu(k,356) * lu(k,1775) - lu(k,1845) = lu(k,1845) - lu(k,357) * lu(k,1775) - 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,1434) = lu(k,1434) - lu(k,361) * lu(k,1424) - lu(k,1507) = lu(k,1507) - lu(k,362) * lu(k,1424) - lu(k,1508) = lu(k,1508) - lu(k,363) * lu(k,1424) - lu(k,1509) = lu(k,1509) - lu(k,364) * lu(k,1424) - lu(k,1513) = lu(k,1513) - lu(k,365) * lu(k,1424) - lu(k,1588) = lu(k,1588) - lu(k,361) * lu(k,1580) - lu(k,1638) = lu(k,1638) - lu(k,362) * lu(k,1580) - lu(k,1639) = lu(k,1639) - lu(k,363) * lu(k,1580) - lu(k,1640) = lu(k,1640) - lu(k,364) * lu(k,1580) - lu(k,1644) = lu(k,1644) - lu(k,365) * lu(k,1580) - lu(k,1784) = lu(k,1784) - lu(k,361) * lu(k,1776) - lu(k,1839) = lu(k,1839) - lu(k,362) * lu(k,1776) - lu(k,1840) = lu(k,1840) - lu(k,363) * lu(k,1776) - lu(k,1841) = lu(k,1841) - lu(k,364) * lu(k,1776) - lu(k,1845) = lu(k,1845) - lu(k,365) * lu(k,1776) - lu(k,366) = 1._r8 / lu(k,366) - lu(k,367) = lu(k,367) * lu(k,366) - lu(k,368) = lu(k,368) * lu(k,366) - lu(k,369) = lu(k,369) * lu(k,366) - lu(k,370) = lu(k,370) * lu(k,366) - lu(k,371) = lu(k,371) * lu(k,366) - lu(k,1604) = lu(k,1604) - lu(k,367) * lu(k,1581) - lu(k,1639) = lu(k,1639) - lu(k,368) * lu(k,1581) - lu(k,1640) = lu(k,1640) - lu(k,369) * lu(k,1581) - lu(k,1643) = lu(k,1643) - lu(k,370) * lu(k,1581) - lu(k,1644) = lu(k,1644) - lu(k,371) * lu(k,1581) - lu(k,1726) = - lu(k,367) * lu(k,1725) - lu(k,1735) = - lu(k,368) * lu(k,1725) - lu(k,1736) = - lu(k,369) * lu(k,1725) - lu(k,1739) = lu(k,1739) - lu(k,370) * lu(k,1725) - lu(k,1740) = lu(k,1740) - lu(k,371) * lu(k,1725) - lu(k,1804) = lu(k,1804) - lu(k,367) * lu(k,1777) - lu(k,1840) = lu(k,1840) - lu(k,368) * lu(k,1777) - lu(k,1841) = lu(k,1841) - lu(k,369) * lu(k,1777) - lu(k,1844) = lu(k,1844) - lu(k,370) * lu(k,1777) - lu(k,1845) = lu(k,1845) - lu(k,371) * lu(k,1777) lu(k,373) = 1._r8 / lu(k,373) lu(k,374) = lu(k,374) * lu(k,373) lu(k,375) = lu(k,375) * lu(k,373) lu(k,376) = lu(k,376) * lu(k,373) lu(k,377) = lu(k,377) * lu(k,373) lu(k,378) = lu(k,378) * lu(k,373) - lu(k,1470) = lu(k,1470) - lu(k,374) * lu(k,1425) - lu(k,1507) = lu(k,1507) - lu(k,375) * lu(k,1425) - lu(k,1508) = lu(k,1508) - lu(k,376) * lu(k,1425) - lu(k,1509) = lu(k,1509) - lu(k,377) * lu(k,1425) - lu(k,1513) = lu(k,1513) - lu(k,378) * lu(k,1425) - lu(k,1607) = lu(k,1607) - lu(k,374) * lu(k,1582) - lu(k,1638) = lu(k,1638) - lu(k,375) * lu(k,1582) - lu(k,1639) = lu(k,1639) - lu(k,376) * lu(k,1582) - lu(k,1640) = lu(k,1640) - lu(k,377) * lu(k,1582) - lu(k,1644) = lu(k,1644) - lu(k,378) * lu(k,1582) - lu(k,1809) = lu(k,1809) - lu(k,374) * lu(k,1778) - lu(k,1839) = lu(k,1839) - lu(k,375) * lu(k,1778) - lu(k,1840) = lu(k,1840) - lu(k,376) * lu(k,1778) - lu(k,1841) = lu(k,1841) - lu(k,377) * lu(k,1778) - lu(k,1845) = lu(k,1845) - lu(k,378) * lu(k,1778) + lu(k,1188) = - lu(k,374) * lu(k,1184) + lu(k,1190) = - lu(k,375) * lu(k,1184) + lu(k,1198) = - lu(k,376) * lu(k,1184) + lu(k,1200) = - lu(k,377) * lu(k,1184) + lu(k,1203) = lu(k,1203) - lu(k,378) * lu(k,1184) + lu(k,1650) = lu(k,1650) - lu(k,374) * lu(k,1593) + lu(k,1667) = lu(k,1667) - lu(k,375) * lu(k,1593) + lu(k,1687) = lu(k,1687) - lu(k,376) * lu(k,1593) + lu(k,1691) = lu(k,1691) - lu(k,377) * lu(k,1593) + lu(k,1694) = lu(k,1694) - lu(k,378) * lu(k,1593) + lu(k,2035) = - lu(k,374) * lu(k,2027) + lu(k,2044) = lu(k,2044) - lu(k,375) * lu(k,2027) + lu(k,2060) = - lu(k,376) * lu(k,2027) + lu(k,2064) = lu(k,2064) - lu(k,377) * lu(k,2027) + lu(k,2067) = lu(k,2067) - lu(k,378) * lu(k,2027) lu(k,379) = 1._r8 / lu(k,379) lu(k,380) = lu(k,380) * lu(k,379) lu(k,381) = lu(k,381) * lu(k,379) - lu(k,403) = - lu(k,380) * lu(k,401) - lu(k,408) = lu(k,408) - lu(k,381) * lu(k,401) - lu(k,551) = - lu(k,380) * lu(k,548) - lu(k,559) = lu(k,559) - lu(k,381) * lu(k,548) - lu(k,592) = - lu(k,380) * lu(k,589) - lu(k,601) = lu(k,601) - lu(k,381) * lu(k,589) - lu(k,621) = - lu(k,380) * lu(k,618) - lu(k,631) = lu(k,631) - lu(k,381) * lu(k,618) - lu(k,637) = - lu(k,380) * lu(k,634) - lu(k,648) = lu(k,648) - lu(k,381) * lu(k,634) - lu(k,1455) = - lu(k,380) * lu(k,1426) - lu(k,1513) = lu(k,1513) - lu(k,381) * lu(k,1426) - lu(k,1598) = lu(k,1598) - lu(k,380) * lu(k,1583) - lu(k,1644) = lu(k,1644) - lu(k,381) * lu(k,1583) - lu(k,1797) = lu(k,1797) - lu(k,380) * lu(k,1779) - lu(k,1845) = lu(k,1845) - lu(k,381) * lu(k,1779) - lu(k,382) = 1._r8 / lu(k,382) - lu(k,383) = lu(k,383) * lu(k,382) - lu(k,384) = lu(k,384) * lu(k,382) - lu(k,385) = lu(k,385) * lu(k,382) - lu(k,386) = lu(k,386) * lu(k,382) - lu(k,387) = lu(k,387) * lu(k,382) - lu(k,388) = lu(k,388) * lu(k,382) - lu(k,1264) = lu(k,1264) - lu(k,383) * lu(k,1247) - lu(k,1267) = lu(k,1267) - lu(k,384) * lu(k,1247) - lu(k,1268) = lu(k,1268) - lu(k,385) * lu(k,1247) - lu(k,1270) = lu(k,1270) - lu(k,386) * lu(k,1247) - lu(k,1271) = lu(k,1271) - lu(k,387) * lu(k,1247) - lu(k,1273) = - lu(k,388) * lu(k,1247) - lu(k,1501) = lu(k,1501) - lu(k,383) * lu(k,1427) - lu(k,1507) = lu(k,1507) - lu(k,384) * lu(k,1427) - lu(k,1508) = lu(k,1508) - lu(k,385) * lu(k,1427) - lu(k,1510) = lu(k,1510) - lu(k,386) * lu(k,1427) - lu(k,1512) = lu(k,1512) - lu(k,387) * lu(k,1427) - lu(k,1517) = lu(k,1517) - lu(k,388) * lu(k,1427) - lu(k,1542) = lu(k,1542) - lu(k,383) * lu(k,1524) - lu(k,1548) = lu(k,1548) - lu(k,384) * lu(k,1524) - lu(k,1549) = lu(k,1549) - lu(k,385) * lu(k,1524) - lu(k,1551) = - lu(k,386) * lu(k,1524) - lu(k,1553) = - lu(k,387) * lu(k,1524) - lu(k,1558) = lu(k,1558) - lu(k,388) * lu(k,1524) + lu(k,382) = lu(k,382) * lu(k,379) + lu(k,383) = lu(k,383) * lu(k,379) + lu(k,384) = lu(k,384) * lu(k,379) + lu(k,950) = - lu(k,380) * lu(k,942) + lu(k,954) = lu(k,954) - lu(k,381) * lu(k,942) + lu(k,956) = - lu(k,382) * lu(k,942) + lu(k,957) = lu(k,957) - lu(k,383) * lu(k,942) + lu(k,963) = lu(k,963) - lu(k,384) * lu(k,942) + lu(k,998) = - lu(k,380) * lu(k,991) + lu(k,1003) = lu(k,1003) - lu(k,381) * lu(k,991) + lu(k,1006) = - lu(k,382) * lu(k,991) + lu(k,1007) = lu(k,1007) - lu(k,383) * lu(k,991) + lu(k,1013) = lu(k,1013) - lu(k,384) * lu(k,991) + lu(k,2098) = - lu(k,380) * lu(k,2083) + lu(k,2105) = lu(k,2105) - lu(k,381) * lu(k,2083) + lu(k,2111) = lu(k,2111) - lu(k,382) * lu(k,2083) + lu(k,2118) = lu(k,2118) - lu(k,383) * lu(k,2083) + lu(k,2128) = lu(k,2128) - lu(k,384) * lu(k,2083) + lu(k,385) = 1._r8 / lu(k,385) + lu(k,386) = lu(k,386) * lu(k,385) + lu(k,387) = lu(k,387) * lu(k,385) + lu(k,388) = lu(k,388) * lu(k,385) + lu(k,389) = lu(k,389) * lu(k,385) + lu(k,390) = lu(k,390) * lu(k,385) + lu(k,1688) = lu(k,1688) - lu(k,386) * lu(k,1594) + lu(k,1689) = lu(k,1689) - lu(k,387) * lu(k,1594) + lu(k,1691) = lu(k,1691) - lu(k,388) * lu(k,1594) + lu(k,1697) = lu(k,1697) - lu(k,389) * lu(k,1594) + lu(k,1703) = lu(k,1703) - lu(k,390) * lu(k,1594) + lu(k,1944) = lu(k,1944) - lu(k,386) * lu(k,1874) + lu(k,1945) = lu(k,1945) - lu(k,387) * lu(k,1874) + lu(k,1947) = lu(k,1947) - lu(k,388) * lu(k,1874) + lu(k,1953) = lu(k,1953) - lu(k,389) * lu(k,1874) + lu(k,1959) = lu(k,1959) - lu(k,390) * lu(k,1874) + lu(k,2061) = - lu(k,386) * lu(k,2028) + lu(k,2062) = lu(k,2062) - lu(k,387) * lu(k,2028) + lu(k,2064) = lu(k,2064) - lu(k,388) * lu(k,2028) + lu(k,2070) = lu(k,2070) - lu(k,389) * lu(k,2028) + lu(k,2076) = - lu(k,390) * lu(k,2028) + lu(k,391) = 1._r8 / lu(k,391) + lu(k,392) = lu(k,392) * lu(k,391) + lu(k,393) = lu(k,393) * lu(k,391) + lu(k,394) = lu(k,394) * lu(k,391) + lu(k,395) = lu(k,395) * lu(k,391) + lu(k,396) = lu(k,396) * lu(k,391) + lu(k,1044) = lu(k,1044) - lu(k,392) * lu(k,1041) + lu(k,1045) = lu(k,1045) - lu(k,393) * lu(k,1041) + lu(k,1049) = - lu(k,394) * lu(k,1041) + lu(k,1051) = - lu(k,395) * lu(k,1041) + lu(k,1056) = lu(k,1056) - lu(k,396) * lu(k,1041) + lu(k,1659) = lu(k,1659) - lu(k,392) * lu(k,1595) + lu(k,1663) = lu(k,1663) - lu(k,393) * lu(k,1595) + lu(k,1687) = lu(k,1687) - lu(k,394) * lu(k,1595) + lu(k,1691) = lu(k,1691) - lu(k,395) * lu(k,1595) + lu(k,1700) = lu(k,1700) - lu(k,396) * lu(k,1595) + lu(k,1920) = - lu(k,392) * lu(k,1875) + lu(k,1922) = lu(k,1922) - lu(k,393) * lu(k,1875) + lu(k,1943) = - lu(k,394) * lu(k,1875) + lu(k,1947) = lu(k,1947) - lu(k,395) * lu(k,1875) + lu(k,1956) = lu(k,1956) - lu(k,396) * lu(k,1875) + lu(k,397) = 1._r8 / lu(k,397) + lu(k,398) = lu(k,398) * lu(k,397) + lu(k,399) = lu(k,399) * lu(k,397) + lu(k,400) = lu(k,400) * lu(k,397) + lu(k,401) = lu(k,401) * lu(k,397) + lu(k,402) = lu(k,402) * lu(k,397) + lu(k,1186) = - lu(k,398) * lu(k,1185) + lu(k,1188) = lu(k,1188) - lu(k,399) * lu(k,1185) + lu(k,1200) = lu(k,1200) - lu(k,400) * lu(k,1185) + lu(k,1203) = lu(k,1203) - lu(k,401) * lu(k,1185) + lu(k,1205) = lu(k,1205) - lu(k,402) * lu(k,1185) + lu(k,1634) = lu(k,1634) - lu(k,398) * lu(k,1596) + lu(k,1650) = lu(k,1650) - lu(k,399) * lu(k,1596) + lu(k,1691) = lu(k,1691) - lu(k,400) * lu(k,1596) + lu(k,1694) = lu(k,1694) - lu(k,401) * lu(k,1596) + lu(k,1700) = lu(k,1700) - lu(k,402) * lu(k,1596) + lu(k,1900) = lu(k,1900) - lu(k,398) * lu(k,1876) + lu(k,1914) = - lu(k,399) * lu(k,1876) + lu(k,1947) = lu(k,1947) - lu(k,400) * lu(k,1876) + lu(k,1950) = lu(k,1950) - lu(k,401) * lu(k,1876) + lu(k,1956) = lu(k,1956) - lu(k,402) * lu(k,1876) + lu(k,403) = 1._r8 / lu(k,403) + lu(k,404) = lu(k,404) * lu(k,403) + lu(k,405) = lu(k,405) * lu(k,403) + lu(k,406) = lu(k,406) * lu(k,403) + lu(k,407) = lu(k,407) * lu(k,403) + lu(k,408) = lu(k,408) * lu(k,403) + lu(k,1691) = lu(k,1691) - lu(k,404) * lu(k,1597) + lu(k,1692) = lu(k,1692) - lu(k,405) * lu(k,1597) + lu(k,1694) = lu(k,1694) - lu(k,406) * lu(k,1597) + lu(k,1700) = lu(k,1700) - lu(k,407) * lu(k,1597) + lu(k,1703) = lu(k,1703) - lu(k,408) * lu(k,1597) + lu(k,1947) = lu(k,1947) - lu(k,404) * lu(k,1877) + lu(k,1948) = lu(k,1948) - lu(k,405) * lu(k,1877) + lu(k,1950) = lu(k,1950) - lu(k,406) * lu(k,1877) + lu(k,1956) = lu(k,1956) - lu(k,407) * lu(k,1877) + lu(k,1959) = lu(k,1959) - lu(k,408) * lu(k,1877) + lu(k,2192) = lu(k,2192) - lu(k,404) * lu(k,2164) + lu(k,2193) = lu(k,2193) - lu(k,405) * lu(k,2164) + lu(k,2195) = lu(k,2195) - lu(k,406) * lu(k,2164) + lu(k,2201) = lu(k,2201) - lu(k,407) * lu(k,2164) + lu(k,2204) = - lu(k,408) * lu(k,2164) end do end subroutine lu_fac08 subroutine lu_fac09( avec_len, lu ) @@ -1076,180 +1028,153 @@ subroutine lu_fac09( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - 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,530) = lu(k,530) - lu(k,390) * lu(k,529) - lu(k,532) = lu(k,532) - lu(k,391) * lu(k,529) - lu(k,535) = - lu(k,392) * lu(k,529) - lu(k,1447) = lu(k,1447) - lu(k,390) * lu(k,1428) - lu(k,1508) = lu(k,1508) - lu(k,391) * lu(k,1428) - lu(k,1518) = lu(k,1518) - lu(k,392) * lu(k,1428) - lu(k,1529) = - lu(k,390) * lu(k,1525) - lu(k,1549) = lu(k,1549) - lu(k,391) * lu(k,1525) - lu(k,1559) = lu(k,1559) - lu(k,392) * lu(k,1525) - lu(k,1594) = lu(k,1594) - lu(k,390) * lu(k,1584) - lu(k,1639) = lu(k,1639) - lu(k,391) * lu(k,1584) - lu(k,1649) = lu(k,1649) - lu(k,392) * lu(k,1584) - lu(k,1790) = lu(k,1790) - lu(k,390) * lu(k,1780) - lu(k,1840) = lu(k,1840) - lu(k,391) * lu(k,1780) - lu(k,1850) = lu(k,1850) - lu(k,392) * lu(k,1780) - lu(k,2007) = lu(k,2007) - lu(k,390) * lu(k,2003) - lu(k,2044) = lu(k,2044) - lu(k,391) * lu(k,2003) - lu(k,2054) = lu(k,2054) - lu(k,392) * lu(k,2003) - lu(k,393) = 1._r8 / lu(k,393) - lu(k,394) = lu(k,394) * lu(k,393) - lu(k,395) = lu(k,395) * lu(k,393) - lu(k,396) = lu(k,396) * lu(k,393) - lu(k,397) = lu(k,397) * lu(k,393) - lu(k,398) = lu(k,398) * lu(k,393) - lu(k,399) = lu(k,399) * lu(k,393) - lu(k,952) = lu(k,952) - lu(k,394) * lu(k,949) - lu(k,953) = lu(k,953) - lu(k,395) * lu(k,949) - lu(k,956) = lu(k,956) - lu(k,396) * lu(k,949) - lu(k,963) = - lu(k,397) * lu(k,949) - lu(k,967) = lu(k,967) - lu(k,398) * lu(k,949) - lu(k,968) = lu(k,968) - lu(k,399) * lu(k,949) - lu(k,1475) = lu(k,1475) - lu(k,394) * lu(k,1429) - lu(k,1478) = lu(k,1478) - lu(k,395) * lu(k,1429) - lu(k,1485) = lu(k,1485) - lu(k,396) * lu(k,1429) - lu(k,1507) = lu(k,1507) - lu(k,397) * lu(k,1429) - lu(k,1512) = lu(k,1512) - lu(k,398) * lu(k,1429) - lu(k,1513) = lu(k,1513) - lu(k,399) * lu(k,1429) - lu(k,1812) = lu(k,1812) - lu(k,394) * lu(k,1781) - lu(k,1813) = lu(k,1813) - lu(k,395) * lu(k,1781) - lu(k,1818) = lu(k,1818) - lu(k,396) * lu(k,1781) - lu(k,1839) = lu(k,1839) - lu(k,397) * lu(k,1781) - lu(k,1844) = lu(k,1844) - lu(k,398) * lu(k,1781) - lu(k,1845) = lu(k,1845) - lu(k,399) * lu(k,1781) - lu(k,402) = 1._r8 / lu(k,402) - lu(k,403) = lu(k,403) * lu(k,402) - lu(k,404) = lu(k,404) * lu(k,402) - lu(k,405) = lu(k,405) * lu(k,402) - lu(k,406) = lu(k,406) * lu(k,402) - lu(k,407) = lu(k,407) * lu(k,402) - lu(k,408) = lu(k,408) * lu(k,402) - lu(k,1455) = lu(k,1455) - lu(k,403) * lu(k,1430) - lu(k,1470) = lu(k,1470) - lu(k,404) * lu(k,1430) - lu(k,1507) = lu(k,1507) - lu(k,405) * lu(k,1430) - lu(k,1508) = lu(k,1508) - lu(k,406) * lu(k,1430) - lu(k,1509) = lu(k,1509) - lu(k,407) * lu(k,1430) - lu(k,1513) = lu(k,1513) - lu(k,408) * lu(k,1430) - lu(k,1598) = lu(k,1598) - lu(k,403) * lu(k,1585) - lu(k,1607) = lu(k,1607) - lu(k,404) * lu(k,1585) - lu(k,1638) = lu(k,1638) - lu(k,405) * lu(k,1585) - lu(k,1639) = lu(k,1639) - lu(k,406) * lu(k,1585) - lu(k,1640) = lu(k,1640) - lu(k,407) * lu(k,1585) - lu(k,1644) = lu(k,1644) - lu(k,408) * lu(k,1585) - lu(k,1797) = lu(k,1797) - lu(k,403) * lu(k,1782) - lu(k,1809) = lu(k,1809) - lu(k,404) * lu(k,1782) - lu(k,1839) = lu(k,1839) - lu(k,405) * lu(k,1782) - lu(k,1840) = lu(k,1840) - lu(k,406) * lu(k,1782) - lu(k,1841) = lu(k,1841) - lu(k,407) * lu(k,1782) - lu(k,1845) = lu(k,1845) - lu(k,408) * lu(k,1782) - lu(k,410) = 1._r8 / lu(k,410) - lu(k,411) = lu(k,411) * lu(k,410) - lu(k,412) = lu(k,412) * lu(k,410) - lu(k,413) = lu(k,413) * lu(k,410) - lu(k,414) = lu(k,414) * lu(k,410) - lu(k,415) = lu(k,415) * lu(k,410) - lu(k,416) = lu(k,416) * lu(k,410) - lu(k,1470) = lu(k,1470) - lu(k,411) * lu(k,1431) - lu(k,1494) = lu(k,1494) - lu(k,412) * lu(k,1431) - lu(k,1507) = lu(k,1507) - lu(k,413) * lu(k,1431) - lu(k,1508) = lu(k,1508) - lu(k,414) * lu(k,1431) - lu(k,1509) = lu(k,1509) - lu(k,415) * lu(k,1431) - lu(k,1513) = lu(k,1513) - lu(k,416) * lu(k,1431) - lu(k,1607) = lu(k,1607) - lu(k,411) * lu(k,1586) - lu(k,1626) = lu(k,1626) - lu(k,412) * lu(k,1586) - lu(k,1638) = lu(k,1638) - lu(k,413) * lu(k,1586) - lu(k,1639) = lu(k,1639) - lu(k,414) * lu(k,1586) - lu(k,1640) = lu(k,1640) - lu(k,415) * lu(k,1586) - lu(k,1644) = lu(k,1644) - lu(k,416) * lu(k,1586) - lu(k,1809) = lu(k,1809) - lu(k,411) * lu(k,1783) - lu(k,1827) = lu(k,1827) - lu(k,412) * lu(k,1783) - lu(k,1839) = lu(k,1839) - lu(k,413) * lu(k,1783) - lu(k,1840) = lu(k,1840) - lu(k,414) * lu(k,1783) - lu(k,1841) = lu(k,1841) - lu(k,415) * lu(k,1783) - lu(k,1845) = lu(k,1845) - lu(k,416) * lu(k,1783) - lu(k,417) = 1._r8 / lu(k,417) - lu(k,418) = lu(k,418) * lu(k,417) - lu(k,419) = lu(k,419) * lu(k,417) - lu(k,420) = lu(k,420) * lu(k,417) - lu(k,421) = lu(k,421) * lu(k,417) - lu(k,422) = lu(k,422) * lu(k,417) - lu(k,1111) = lu(k,1111) - lu(k,418) * lu(k,1109) - lu(k,1113) = lu(k,1113) - lu(k,419) * lu(k,1109) - lu(k,1115) = lu(k,1115) - lu(k,420) * lu(k,1109) - lu(k,1120) = lu(k,1120) - lu(k,421) * lu(k,1109) - lu(k,1122) = lu(k,1122) - lu(k,422) * lu(k,1109) - lu(k,1495) = lu(k,1495) - lu(k,418) * lu(k,1432) - lu(k,1504) = lu(k,1504) - lu(k,419) * lu(k,1432) - lu(k,1507) = lu(k,1507) - lu(k,420) * lu(k,1432) - lu(k,1514) = lu(k,1514) - lu(k,421) * lu(k,1432) - lu(k,1518) = lu(k,1518) - lu(k,422) * lu(k,1432) - lu(k,1863) = lu(k,1863) - lu(k,418) * lu(k,1853) - lu(k,1866) = lu(k,1866) - lu(k,419) * lu(k,1853) - lu(k,1869) = lu(k,1869) - lu(k,420) * lu(k,1853) - lu(k,1876) = lu(k,1876) - lu(k,421) * lu(k,1853) - lu(k,1880) = lu(k,1880) - lu(k,422) * lu(k,1853) - lu(k,2031) = lu(k,2031) - lu(k,418) * lu(k,2004) - lu(k,2040) = lu(k,2040) - lu(k,419) * lu(k,2004) - lu(k,2043) = lu(k,2043) - lu(k,420) * lu(k,2004) - lu(k,2050) = lu(k,2050) - lu(k,421) * lu(k,2004) - lu(k,2054) = lu(k,2054) - lu(k,422) * lu(k,2004) - lu(k,423) = 1._r8 / lu(k,423) - lu(k,424) = lu(k,424) * lu(k,423) - lu(k,425) = lu(k,425) * lu(k,423) - lu(k,426) = lu(k,426) * lu(k,423) - lu(k,427) = lu(k,427) * lu(k,423) - lu(k,538) = - lu(k,424) * lu(k,536) - lu(k,539) = - lu(k,425) * lu(k,536) - lu(k,543) = - lu(k,426) * lu(k,536) - lu(k,544) = lu(k,544) - lu(k,427) * lu(k,536) - lu(k,562) = - lu(k,424) * lu(k,560) - lu(k,563) = - lu(k,425) * lu(k,560) - lu(k,566) = - lu(k,426) * lu(k,560) - lu(k,567) = lu(k,567) - lu(k,427) * lu(k,560) - lu(k,835) = - lu(k,424) * lu(k,832) - lu(k,836) = - lu(k,425) * lu(k,832) - lu(k,840) = - lu(k,426) * lu(k,832) - lu(k,841) = - lu(k,427) * lu(k,832) - lu(k,1451) = lu(k,1451) - lu(k,424) * lu(k,1433) - lu(k,1465) = lu(k,1465) - lu(k,425) * lu(k,1433) - lu(k,1501) = lu(k,1501) - lu(k,426) * lu(k,1433) - lu(k,1507) = lu(k,1507) - lu(k,427) * lu(k,1433) - lu(k,1596) = lu(k,1596) - lu(k,424) * lu(k,1587) - lu(k,1605) = lu(k,1605) - lu(k,425) * lu(k,1587) - lu(k,1632) = lu(k,1632) - lu(k,426) * lu(k,1587) - lu(k,1638) = lu(k,1638) - lu(k,427) * lu(k,1587) - 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,1447) = lu(k,1447) - lu(k,430) * lu(k,1434) - lu(k,1507) = lu(k,1507) - lu(k,431) * lu(k,1434) - lu(k,1508) = lu(k,1508) - lu(k,432) * lu(k,1434) - lu(k,1509) = lu(k,1509) - lu(k,433) * lu(k,1434) - lu(k,1513) = lu(k,1513) - lu(k,434) * lu(k,1434) - lu(k,1529) = lu(k,1529) - lu(k,430) * lu(k,1526) - lu(k,1548) = lu(k,1548) - lu(k,431) * lu(k,1526) - lu(k,1549) = lu(k,1549) - lu(k,432) * lu(k,1526) - lu(k,1550) = lu(k,1550) - lu(k,433) * lu(k,1526) - lu(k,1554) = lu(k,1554) - lu(k,434) * lu(k,1526) - lu(k,1594) = lu(k,1594) - lu(k,430) * lu(k,1588) - lu(k,1638) = lu(k,1638) - lu(k,431) * lu(k,1588) - lu(k,1639) = lu(k,1639) - lu(k,432) * lu(k,1588) - lu(k,1640) = lu(k,1640) - lu(k,433) * lu(k,1588) - lu(k,1644) = lu(k,1644) - lu(k,434) * lu(k,1588) - lu(k,1790) = lu(k,1790) - lu(k,430) * lu(k,1784) - lu(k,1839) = lu(k,1839) - lu(k,431) * lu(k,1784) - lu(k,1840) = lu(k,1840) - lu(k,432) * lu(k,1784) - lu(k,1841) = lu(k,1841) - lu(k,433) * lu(k,1784) - lu(k,1845) = lu(k,1845) - lu(k,434) * lu(k,1784) + lu(k,409) = 1._r8 / lu(k,409) + lu(k,410) = lu(k,410) * lu(k,409) + lu(k,411) = lu(k,411) * lu(k,409) + lu(k,412) = lu(k,412) * lu(k,409) + lu(k,413) = lu(k,413) * lu(k,409) + lu(k,414) = lu(k,414) * lu(k,409) + lu(k,1129) = lu(k,1129) - lu(k,410) * lu(k,1127) + lu(k,1132) = lu(k,1132) - lu(k,411) * lu(k,1127) + lu(k,1133) = lu(k,1133) - lu(k,412) * lu(k,1127) + lu(k,1134) = lu(k,1134) - lu(k,413) * lu(k,1127) + lu(k,1139) = - lu(k,414) * lu(k,1127) + lu(k,1670) = lu(k,1670) - lu(k,410) * lu(k,1598) + lu(k,1683) = lu(k,1683) - lu(k,411) * lu(k,1598) + lu(k,1689) = lu(k,1689) - lu(k,412) * lu(k,1598) + lu(k,1691) = lu(k,1691) - lu(k,413) * lu(k,1598) + lu(k,1703) = lu(k,1703) - lu(k,414) * lu(k,1598) + lu(k,1928) = lu(k,1928) - lu(k,410) * lu(k,1878) + lu(k,1939) = lu(k,1939) - lu(k,411) * lu(k,1878) + lu(k,1945) = lu(k,1945) - lu(k,412) * lu(k,1878) + lu(k,1947) = lu(k,1947) - lu(k,413) * lu(k,1878) + lu(k,1959) = lu(k,1959) - lu(k,414) * lu(k,1878) + lu(k,415) = 1._r8 / lu(k,415) + lu(k,416) = lu(k,416) * lu(k,415) + lu(k,417) = lu(k,417) * lu(k,415) + lu(k,418) = lu(k,418) * lu(k,415) + lu(k,419) = lu(k,419) * lu(k,415) + lu(k,420) = lu(k,420) * lu(k,415) + lu(k,791) = lu(k,791) - lu(k,416) * lu(k,790) + lu(k,792) = lu(k,792) - lu(k,417) * lu(k,790) + lu(k,795) = - lu(k,418) * lu(k,790) + lu(k,797) = lu(k,797) - lu(k,419) * lu(k,790) + lu(k,800) = - lu(k,420) * lu(k,790) + lu(k,1643) = lu(k,1643) - lu(k,416) * lu(k,1599) + lu(k,1656) = lu(k,1656) - lu(k,417) * lu(k,1599) + lu(k,1691) = lu(k,1691) - lu(k,418) * lu(k,1599) + lu(k,1694) = lu(k,1694) - lu(k,419) * lu(k,1599) + lu(k,1703) = lu(k,1703) - lu(k,420) * lu(k,1599) + lu(k,1909) = lu(k,1909) - lu(k,416) * lu(k,1879) + lu(k,1918) = - lu(k,417) * lu(k,1879) + lu(k,1947) = lu(k,1947) - lu(k,418) * lu(k,1879) + lu(k,1950) = lu(k,1950) - lu(k,419) * lu(k,1879) + lu(k,1959) = lu(k,1959) - lu(k,420) * lu(k,1879) + lu(k,421) = 1._r8 / lu(k,421) + lu(k,422) = lu(k,422) * lu(k,421) + lu(k,423) = lu(k,423) * lu(k,421) + lu(k,424) = lu(k,424) * lu(k,421) + lu(k,425) = lu(k,425) * lu(k,421) + lu(k,426) = lu(k,426) * lu(k,421) + lu(k,482) = lu(k,482) - lu(k,422) * lu(k,481) + lu(k,483) = lu(k,483) - lu(k,423) * lu(k,481) + lu(k,485) = lu(k,485) - lu(k,424) * lu(k,481) + lu(k,486) = - lu(k,425) * lu(k,481) + lu(k,488) = lu(k,488) - lu(k,426) * lu(k,481) + lu(k,1605) = lu(k,1605) - lu(k,422) * lu(k,1600) + lu(k,1609) = lu(k,1609) - lu(k,423) * lu(k,1600) + lu(k,1660) = lu(k,1660) - lu(k,424) * lu(k,1600) + lu(k,1691) = lu(k,1691) - lu(k,425) * lu(k,1600) + lu(k,1694) = lu(k,1694) - lu(k,426) * lu(k,1600) + lu(k,1885) = - lu(k,422) * lu(k,1880) + lu(k,1888) = lu(k,1888) - lu(k,423) * lu(k,1880) + lu(k,1921) = lu(k,1921) - lu(k,424) * lu(k,1880) + lu(k,1947) = lu(k,1947) - lu(k,425) * lu(k,1880) + lu(k,1950) = lu(k,1950) - lu(k,426) * lu(k,1880) + lu(k,427) = 1._r8 / lu(k,427) + lu(k,428) = lu(k,428) * lu(k,427) + lu(k,429) = lu(k,429) * lu(k,427) + lu(k,430) = lu(k,430) * lu(k,427) + lu(k,431) = lu(k,431) * lu(k,427) + lu(k,432) = lu(k,432) * lu(k,427) + lu(k,499) = lu(k,499) - lu(k,428) * lu(k,498) + lu(k,500) = lu(k,500) - lu(k,429) * lu(k,498) + lu(k,501) = lu(k,501) - lu(k,430) * lu(k,498) + lu(k,502) = - lu(k,431) * lu(k,498) + lu(k,504) = lu(k,504) - lu(k,432) * lu(k,498) + lu(k,1611) = lu(k,1611) - lu(k,428) * lu(k,1601) + lu(k,1660) = lu(k,1660) - lu(k,429) * lu(k,1601) + lu(k,1676) = lu(k,1676) - lu(k,430) * lu(k,1601) + lu(k,1691) = lu(k,1691) - lu(k,431) * lu(k,1601) + lu(k,1694) = lu(k,1694) - lu(k,432) * lu(k,1601) + lu(k,1889) = lu(k,1889) - lu(k,428) * lu(k,1881) + lu(k,1921) = lu(k,1921) - lu(k,429) * lu(k,1881) + lu(k,1933) = lu(k,1933) - lu(k,430) * lu(k,1881) + lu(k,1947) = lu(k,1947) - lu(k,431) * lu(k,1881) + lu(k,1950) = lu(k,1950) - lu(k,432) * lu(k,1881) + lu(k,435) = 1._r8 / lu(k,435) + lu(k,436) = lu(k,436) * lu(k,435) + lu(k,437) = lu(k,437) * lu(k,435) + lu(k,438) = lu(k,438) * lu(k,435) + lu(k,439) = lu(k,439) * lu(k,435) + lu(k,440) = lu(k,440) * lu(k,435) + lu(k,1614) = lu(k,1614) - lu(k,436) * lu(k,1602) + lu(k,1691) = lu(k,1691) - lu(k,437) * lu(k,1602) + lu(k,1693) = lu(k,1693) - lu(k,438) * lu(k,1602) + lu(k,1694) = lu(k,1694) - lu(k,439) * lu(k,1602) + lu(k,1700) = lu(k,1700) - lu(k,440) * lu(k,1602) + lu(k,1788) = lu(k,1788) - lu(k,436) * lu(k,1779) + lu(k,1840) = lu(k,1840) - lu(k,437) * lu(k,1779) + lu(k,1842) = lu(k,1842) - lu(k,438) * lu(k,1779) + lu(k,1843) = lu(k,1843) - lu(k,439) * lu(k,1779) + lu(k,1849) = lu(k,1849) - lu(k,440) * lu(k,1779) + lu(k,1890) = lu(k,1890) - lu(k,436) * lu(k,1882) + lu(k,1947) = lu(k,1947) - lu(k,437) * lu(k,1882) + lu(k,1949) = lu(k,1949) - lu(k,438) * lu(k,1882) + lu(k,1950) = lu(k,1950) - lu(k,439) * lu(k,1882) + lu(k,1956) = lu(k,1956) - lu(k,440) * lu(k,1882) + lu(k,441) = 1._r8 / lu(k,441) + lu(k,442) = lu(k,442) * lu(k,441) + lu(k,443) = lu(k,443) * lu(k,441) + lu(k,444) = lu(k,444) * lu(k,441) + lu(k,445) = lu(k,445) * lu(k,441) + lu(k,446) = lu(k,446) * lu(k,441) + lu(k,1478) = - lu(k,442) * lu(k,1476) + lu(k,1485) = lu(k,1485) - lu(k,443) * lu(k,1476) + lu(k,1489) = - lu(k,444) * lu(k,1476) + lu(k,1490) = lu(k,1490) - lu(k,445) * lu(k,1476) + lu(k,1495) = - lu(k,446) * lu(k,1476) + lu(k,1811) = lu(k,1811) - lu(k,442) * lu(k,1780) + lu(k,1838) = lu(k,1838) - lu(k,443) * lu(k,1780) + lu(k,1842) = lu(k,1842) - lu(k,444) * lu(k,1780) + lu(k,1843) = lu(k,1843) - lu(k,445) * lu(k,1780) + lu(k,1849) = lu(k,1849) - lu(k,446) * lu(k,1780) + lu(k,1919) = lu(k,1919) - lu(k,442) * lu(k,1883) + lu(k,1945) = lu(k,1945) - lu(k,443) * lu(k,1883) + lu(k,1949) = lu(k,1949) - lu(k,444) * lu(k,1883) + lu(k,1950) = lu(k,1950) - lu(k,445) * lu(k,1883) + lu(k,1956) = lu(k,1956) - lu(k,446) * lu(k,1883) + lu(k,447) = 1._r8 / lu(k,447) + lu(k,448) = lu(k,448) * lu(k,447) + lu(k,449) = lu(k,449) * lu(k,447) + lu(k,450) = lu(k,450) * lu(k,447) + lu(k,451) = lu(k,451) * lu(k,447) + lu(k,452) = lu(k,452) * lu(k,447) + lu(k,1521) = lu(k,1521) - lu(k,448) * lu(k,1515) + lu(k,1526) = lu(k,1526) - lu(k,449) * lu(k,1515) + lu(k,1527) = lu(k,1527) - lu(k,450) * lu(k,1515) + lu(k,1532) = lu(k,1532) - lu(k,451) * lu(k,1515) + lu(k,1535) = lu(k,1535) - lu(k,452) * lu(k,1515) + lu(k,1685) = lu(k,1685) - lu(k,448) * lu(k,1603) + lu(k,1690) = lu(k,1690) - lu(k,449) * lu(k,1603) + lu(k,1691) = lu(k,1691) - lu(k,450) * lu(k,1603) + lu(k,1696) = lu(k,1696) - lu(k,451) * lu(k,1603) + lu(k,1699) = lu(k,1699) - lu(k,452) * lu(k,1603) + lu(k,2006) = lu(k,2006) - lu(k,448) * lu(k,1990) + lu(k,2011) = - lu(k,449) * lu(k,1990) + lu(k,2012) = lu(k,2012) - lu(k,450) * lu(k,1990) + lu(k,2017) = lu(k,2017) - lu(k,451) * lu(k,1990) + lu(k,2020) = lu(k,2020) - lu(k,452) * lu(k,1990) end do end subroutine lu_fac09 subroutine lu_fac10( avec_len, lu ) @@ -1266,148 +1191,168 @@ subroutine lu_fac10( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,435) = 1._r8 / lu(k,435) - lu(k,436) = lu(k,436) * lu(k,435) - lu(k,437) = lu(k,437) * lu(k,435) - lu(k,438) = lu(k,438) * lu(k,435) - lu(k,439) = lu(k,439) * lu(k,435) - lu(k,440) = lu(k,440) * lu(k,435) - lu(k,1234) = lu(k,1234) - lu(k,436) * lu(k,1228) - lu(k,1237) = lu(k,1237) - lu(k,437) * lu(k,1228) - lu(k,1240) = lu(k,1240) - lu(k,438) * lu(k,1228) - lu(k,1241) = lu(k,1241) - lu(k,439) * lu(k,1228) - lu(k,1245) = - lu(k,440) * lu(k,1228) - lu(k,1264) = lu(k,1264) - lu(k,436) * lu(k,1248) - lu(k,1267) = lu(k,1267) - lu(k,437) * lu(k,1248) - lu(k,1270) = lu(k,1270) - lu(k,438) * lu(k,1248) - lu(k,1271) = lu(k,1271) - lu(k,439) * lu(k,1248) - lu(k,1275) = - lu(k,440) * lu(k,1248) - lu(k,1501) = lu(k,1501) - lu(k,436) * lu(k,1435) - lu(k,1507) = lu(k,1507) - lu(k,437) * lu(k,1435) - lu(k,1510) = lu(k,1510) - lu(k,438) * lu(k,1435) - lu(k,1512) = lu(k,1512) - lu(k,439) * lu(k,1435) - lu(k,1519) = lu(k,1519) - lu(k,440) * lu(k,1435) - lu(k,1833) = lu(k,1833) - lu(k,436) * lu(k,1785) - lu(k,1839) = lu(k,1839) - lu(k,437) * lu(k,1785) - lu(k,1842) = lu(k,1842) - lu(k,438) * lu(k,1785) - lu(k,1844) = lu(k,1844) - lu(k,439) * lu(k,1785) - lu(k,1851) = lu(k,1851) - lu(k,440) * lu(k,1785) - lu(k,441) = 1._r8 / lu(k,441) - lu(k,442) = lu(k,442) * lu(k,441) - lu(k,443) = lu(k,443) * lu(k,441) - lu(k,444) = lu(k,444) * lu(k,441) - lu(k,445) = lu(k,445) * lu(k,441) - lu(k,446) = lu(k,446) * lu(k,441) - lu(k,447) = lu(k,447) * lu(k,441) - lu(k,448) = lu(k,448) * lu(k,441) - lu(k,658) = lu(k,658) - lu(k,442) * lu(k,657) - lu(k,659) = - lu(k,443) * lu(k,657) - lu(k,660) = lu(k,660) - lu(k,444) * lu(k,657) - lu(k,661) = - lu(k,445) * lu(k,657) - lu(k,664) = lu(k,664) - lu(k,446) * lu(k,657) - lu(k,665) = lu(k,665) - lu(k,447) * lu(k,657) - lu(k,666) = - lu(k,448) * lu(k,657) - lu(k,1459) = lu(k,1459) - lu(k,442) * lu(k,1436) - lu(k,1484) = lu(k,1484) - lu(k,443) * lu(k,1436) - lu(k,1489) = lu(k,1489) - lu(k,444) * lu(k,1436) - lu(k,1507) = lu(k,1507) - lu(k,445) * lu(k,1436) - lu(k,1512) = lu(k,1512) - lu(k,446) * lu(k,1436) - lu(k,1513) = lu(k,1513) - lu(k,447) * lu(k,1436) - lu(k,1519) = lu(k,1519) - lu(k,448) * lu(k,1436) - lu(k,1801) = lu(k,1801) - lu(k,442) * lu(k,1786) - lu(k,1817) = - lu(k,443) * lu(k,1786) - lu(k,1822) = lu(k,1822) - lu(k,444) * lu(k,1786) - lu(k,1839) = lu(k,1839) - lu(k,445) * lu(k,1786) - lu(k,1844) = lu(k,1844) - lu(k,446) * lu(k,1786) - lu(k,1845) = lu(k,1845) - lu(k,447) * lu(k,1786) - lu(k,1851) = lu(k,1851) - lu(k,448) * lu(k,1786) - lu(k,449) = 1._r8 / lu(k,449) - lu(k,450) = lu(k,450) * lu(k,449) - lu(k,451) = lu(k,451) * lu(k,449) - lu(k,452) = lu(k,452) * lu(k,449) - lu(k,453) = lu(k,453) * lu(k,449) - lu(k,454) = lu(k,454) * lu(k,449) - lu(k,455) = lu(k,455) * lu(k,449) - lu(k,456) = lu(k,456) * lu(k,449) - lu(k,1532) = - lu(k,450) * lu(k,1527) - lu(k,1543) = - lu(k,451) * lu(k,1527) - lu(k,1544) = lu(k,1544) - lu(k,452) * lu(k,1527) - lu(k,1549) = lu(k,1549) - lu(k,453) * lu(k,1527) - lu(k,1552) = lu(k,1552) - lu(k,454) * lu(k,1527) - lu(k,1555) = lu(k,1555) - lu(k,455) * lu(k,1527) - lu(k,1558) = lu(k,1558) - lu(k,456) * lu(k,1527) - lu(k,1704) = lu(k,1704) - lu(k,450) * lu(k,1703) - lu(k,1707) = lu(k,1707) - lu(k,451) * lu(k,1703) - lu(k,1708) = - lu(k,452) * lu(k,1703) - lu(k,1713) = lu(k,1713) - lu(k,453) * lu(k,1703) - lu(k,1716) = lu(k,1716) - lu(k,454) * lu(k,1703) - lu(k,1719) = lu(k,1719) - lu(k,455) * lu(k,1703) - lu(k,1722) = - lu(k,456) * lu(k,1703) - lu(k,1856) = lu(k,1856) - lu(k,450) * lu(k,1854) - lu(k,1864) = lu(k,1864) - lu(k,451) * lu(k,1854) - lu(k,1865) = - lu(k,452) * lu(k,1854) - lu(k,1870) = lu(k,1870) - lu(k,453) * lu(k,1854) - lu(k,1873) = lu(k,1873) - lu(k,454) * lu(k,1854) - lu(k,1876) = lu(k,1876) - lu(k,455) * lu(k,1854) - lu(k,1879) = lu(k,1879) - lu(k,456) * lu(k,1854) - lu(k,457) = 1._r8 / lu(k,457) - lu(k,458) = lu(k,458) * lu(k,457) - lu(k,459) = lu(k,459) * lu(k,457) - lu(k,460) = lu(k,460) * lu(k,457) - lu(k,461) = lu(k,461) * lu(k,457) - lu(k,462) = lu(k,462) * lu(k,457) - lu(k,463) = lu(k,463) * lu(k,457) - lu(k,464) = lu(k,464) * lu(k,457) - lu(k,1130) = - lu(k,458) * lu(k,1126) - lu(k,1133) = lu(k,1133) - lu(k,459) * lu(k,1126) - lu(k,1134) = - lu(k,460) * lu(k,1126) - lu(k,1136) = lu(k,1136) - lu(k,461) * lu(k,1126) - lu(k,1147) = - lu(k,462) * lu(k,1126) - lu(k,1149) = lu(k,1149) - lu(k,463) * lu(k,1126) - lu(k,1154) = lu(k,1154) - lu(k,464) * lu(k,1126) - lu(k,1468) = lu(k,1468) - lu(k,458) * lu(k,1437) - lu(k,1480) = lu(k,1480) - lu(k,459) * lu(k,1437) - lu(k,1481) = lu(k,1481) - lu(k,460) * lu(k,1437) - lu(k,1484) = lu(k,1484) - lu(k,461) * lu(k,1437) - lu(k,1503) = lu(k,1503) - lu(k,462) * lu(k,1437) - lu(k,1507) = lu(k,1507) - lu(k,463) * lu(k,1437) - lu(k,1513) = lu(k,1513) - lu(k,464) * lu(k,1437) - lu(k,1606) = - lu(k,458) * lu(k,1589) - lu(k,1613) = lu(k,1613) - lu(k,459) * lu(k,1589) - lu(k,1614) = lu(k,1614) - lu(k,460) * lu(k,1589) - lu(k,1617) = lu(k,1617) - lu(k,461) * lu(k,1589) - lu(k,1634) = lu(k,1634) - lu(k,462) * lu(k,1589) - lu(k,1638) = lu(k,1638) - lu(k,463) * lu(k,1589) - lu(k,1644) = lu(k,1644) - lu(k,464) * lu(k,1589) - lu(k,465) = 1._r8 / lu(k,465) - lu(k,466) = lu(k,466) * lu(k,465) - lu(k,467) = lu(k,467) * lu(k,465) - lu(k,468) = lu(k,468) * lu(k,465) - lu(k,469) = lu(k,469) * lu(k,465) - lu(k,470) = lu(k,470) * lu(k,465) - lu(k,471) = lu(k,471) * lu(k,465) - lu(k,472) = lu(k,472) * lu(k,465) - lu(k,1454) = lu(k,1454) - lu(k,466) * lu(k,1438) - lu(k,1463) = lu(k,1463) - lu(k,467) * lu(k,1438) - lu(k,1483) = lu(k,1483) - lu(k,468) * lu(k,1438) - lu(k,1507) = lu(k,1507) - lu(k,469) * lu(k,1438) - lu(k,1512) = lu(k,1512) - lu(k,470) * lu(k,1438) - lu(k,1513) = lu(k,1513) - lu(k,471) * lu(k,1438) - lu(k,1518) = lu(k,1518) - lu(k,472) * lu(k,1438) - lu(k,1910) = - lu(k,466) * lu(k,1908) - lu(k,1911) = lu(k,1911) - lu(k,467) * lu(k,1908) - lu(k,1917) = lu(k,1917) - lu(k,468) * lu(k,1908) - lu(k,1926) = lu(k,1926) - lu(k,469) * lu(k,1908) - lu(k,1931) = lu(k,1931) - lu(k,470) * lu(k,1908) - lu(k,1932) = lu(k,1932) - lu(k,471) * lu(k,1908) - lu(k,1937) = lu(k,1937) - lu(k,472) * lu(k,1908) - lu(k,2008) = - lu(k,466) * lu(k,2005) - lu(k,2009) = lu(k,2009) - lu(k,467) * lu(k,2005) - lu(k,2021) = lu(k,2021) - lu(k,468) * lu(k,2005) - lu(k,2043) = lu(k,2043) - lu(k,469) * lu(k,2005) - lu(k,2048) = lu(k,2048) - lu(k,470) * lu(k,2005) - lu(k,2049) = lu(k,2049) - lu(k,471) * lu(k,2005) - lu(k,2054) = lu(k,2054) - lu(k,472) * lu(k,2005) + lu(k,454) = 1._r8 / lu(k,454) + lu(k,455) = lu(k,455) * lu(k,454) + lu(k,456) = lu(k,456) * lu(k,454) + lu(k,457) = lu(k,457) * lu(k,454) + lu(k,458) = lu(k,458) * lu(k,454) + lu(k,459) = lu(k,459) * lu(k,454) + lu(k,1660) = lu(k,1660) - lu(k,455) * lu(k,1604) + lu(k,1691) = lu(k,1691) - lu(k,456) * lu(k,1604) + lu(k,1693) = lu(k,1693) - lu(k,457) * lu(k,1604) + lu(k,1694) = lu(k,1694) - lu(k,458) * lu(k,1604) + lu(k,1700) = lu(k,1700) - lu(k,459) * lu(k,1604) + lu(k,1813) = lu(k,1813) - lu(k,455) * lu(k,1781) + lu(k,1840) = lu(k,1840) - lu(k,456) * lu(k,1781) + lu(k,1842) = lu(k,1842) - lu(k,457) * lu(k,1781) + lu(k,1843) = lu(k,1843) - lu(k,458) * lu(k,1781) + lu(k,1849) = lu(k,1849) - lu(k,459) * lu(k,1781) + lu(k,1921) = lu(k,1921) - lu(k,455) * lu(k,1884) + lu(k,1947) = lu(k,1947) - lu(k,456) * lu(k,1884) + lu(k,1949) = lu(k,1949) - lu(k,457) * lu(k,1884) + lu(k,1950) = lu(k,1950) - lu(k,458) * lu(k,1884) + lu(k,1956) = lu(k,1956) - lu(k,459) * lu(k,1884) + lu(k,460) = 1._r8 / lu(k,460) + lu(k,461) = lu(k,461) * lu(k,460) + lu(k,462) = lu(k,462) * lu(k,460) + lu(k,484) = - lu(k,461) * lu(k,482) + lu(k,488) = lu(k,488) - lu(k,462) * lu(k,482) + lu(k,656) = - lu(k,461) * lu(k,653) + lu(k,664) = lu(k,664) - lu(k,462) * lu(k,653) + lu(k,702) = - lu(k,461) * lu(k,699) + lu(k,711) = lu(k,711) - lu(k,462) * lu(k,699) + lu(k,731) = - lu(k,461) * lu(k,728) + lu(k,740) = lu(k,740) - lu(k,462) * lu(k,728) + lu(k,747) = - lu(k,461) * lu(k,744) + lu(k,757) = lu(k,757) - lu(k,462) * lu(k,744) + lu(k,1637) = - lu(k,461) * lu(k,1605) + lu(k,1694) = lu(k,1694) - lu(k,462) * lu(k,1605) + lu(k,1798) = lu(k,1798) - lu(k,461) * lu(k,1782) + lu(k,1843) = lu(k,1843) - lu(k,462) * lu(k,1782) + lu(k,1903) = lu(k,1903) - lu(k,461) * lu(k,1885) + lu(k,1950) = lu(k,1950) - lu(k,462) * lu(k,1885) + lu(k,463) = 1._r8 / lu(k,463) + lu(k,464) = lu(k,464) * lu(k,463) + lu(k,465) = lu(k,465) * lu(k,463) + lu(k,466) = lu(k,466) * lu(k,463) + lu(k,625) = lu(k,625) - lu(k,464) * lu(k,624) + lu(k,629) = - lu(k,465) * lu(k,624) + lu(k,630) = lu(k,630) - lu(k,466) * lu(k,624) + lu(k,1627) = lu(k,1627) - lu(k,464) * lu(k,1606) + lu(k,1698) = lu(k,1698) - lu(k,465) * lu(k,1606) + lu(k,1700) = lu(k,1700) - lu(k,466) * lu(k,1606) + lu(k,1794) = lu(k,1794) - lu(k,464) * lu(k,1783) + lu(k,1847) = lu(k,1847) - lu(k,465) * lu(k,1783) + lu(k,1849) = lu(k,1849) - lu(k,466) * lu(k,1783) + lu(k,1894) = lu(k,1894) - lu(k,464) * lu(k,1886) + lu(k,1954) = lu(k,1954) - lu(k,465) * lu(k,1886) + lu(k,1956) = lu(k,1956) - lu(k,466) * lu(k,1886) + lu(k,2087) = lu(k,2087) - lu(k,464) * lu(k,2084) + lu(k,2132) = lu(k,2132) - lu(k,465) * lu(k,2084) + lu(k,2134) = lu(k,2134) - lu(k,466) * lu(k,2084) + lu(k,2171) = - lu(k,464) * lu(k,2165) + lu(k,2199) = lu(k,2199) - lu(k,465) * lu(k,2165) + lu(k,2201) = lu(k,2201) - lu(k,466) * lu(k,2165) + 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,1521) = lu(k,1521) - lu(k,468) * lu(k,1516) + lu(k,1526) = lu(k,1526) - lu(k,469) * lu(k,1516) + lu(k,1527) = lu(k,1527) - lu(k,470) * lu(k,1516) + lu(k,1532) = lu(k,1532) - lu(k,471) * lu(k,1516) + lu(k,1535) = lu(k,1535) - lu(k,472) * lu(k,1516) + lu(k,1539) = lu(k,1539) - lu(k,473) * lu(k,1516) + lu(k,1685) = lu(k,1685) - lu(k,468) * lu(k,1607) + lu(k,1690) = lu(k,1690) - lu(k,469) * lu(k,1607) + lu(k,1691) = lu(k,1691) - lu(k,470) * lu(k,1607) + lu(k,1696) = lu(k,1696) - lu(k,471) * lu(k,1607) + lu(k,1699) = lu(k,1699) - lu(k,472) * lu(k,1607) + lu(k,1703) = lu(k,1703) - lu(k,473) * lu(k,1607) + lu(k,2006) = lu(k,2006) - lu(k,468) * lu(k,1991) + lu(k,2011) = lu(k,2011) - lu(k,469) * lu(k,1991) + lu(k,2012) = lu(k,2012) - lu(k,470) * lu(k,1991) + lu(k,2017) = lu(k,2017) - lu(k,471) * lu(k,1991) + lu(k,2020) = lu(k,2020) - lu(k,472) * lu(k,1991) + lu(k,2024) = lu(k,2024) - lu(k,473) * lu(k,1991) + lu(k,474) = 1._r8 / lu(k,474) + lu(k,475) = lu(k,475) * lu(k,474) + lu(k,476) = lu(k,476) * lu(k,474) + lu(k,477) = lu(k,477) * lu(k,474) + lu(k,478) = lu(k,478) * lu(k,474) + lu(k,479) = lu(k,479) * lu(k,474) + lu(k,480) = lu(k,480) * lu(k,474) + lu(k,912) = lu(k,912) - lu(k,475) * lu(k,909) + lu(k,913) = lu(k,913) - lu(k,476) * lu(k,909) + lu(k,914) = lu(k,914) - lu(k,477) * lu(k,909) + lu(k,916) = lu(k,916) - lu(k,478) * lu(k,909) + lu(k,917) = - lu(k,479) * lu(k,909) + lu(k,919) = lu(k,919) - lu(k,480) * lu(k,909) + lu(k,1655) = lu(k,1655) - lu(k,475) * lu(k,1608) + lu(k,1656) = lu(k,1656) - lu(k,476) * lu(k,1608) + lu(k,1659) = lu(k,1659) - lu(k,477) * lu(k,1608) + lu(k,1689) = lu(k,1689) - lu(k,478) * lu(k,1608) + lu(k,1691) = lu(k,1691) - lu(k,479) * lu(k,1608) + lu(k,1694) = lu(k,1694) - lu(k,480) * lu(k,1608) + lu(k,1917) = lu(k,1917) - lu(k,475) * lu(k,1887) + lu(k,1918) = lu(k,1918) - lu(k,476) * lu(k,1887) + lu(k,1920) = lu(k,1920) - lu(k,477) * lu(k,1887) + lu(k,1945) = lu(k,1945) - lu(k,478) * lu(k,1887) + lu(k,1947) = lu(k,1947) - lu(k,479) * lu(k,1887) + lu(k,1950) = lu(k,1950) - lu(k,480) * lu(k,1887) + lu(k,483) = 1._r8 / lu(k,483) + lu(k,484) = lu(k,484) * lu(k,483) + lu(k,485) = lu(k,485) * lu(k,483) + lu(k,486) = lu(k,486) * lu(k,483) + lu(k,487) = lu(k,487) * lu(k,483) + lu(k,488) = lu(k,488) * lu(k,483) + lu(k,489) = lu(k,489) * lu(k,483) + lu(k,1637) = lu(k,1637) - lu(k,484) * lu(k,1609) + lu(k,1660) = lu(k,1660) - lu(k,485) * lu(k,1609) + lu(k,1691) = lu(k,1691) - lu(k,486) * lu(k,1609) + lu(k,1693) = lu(k,1693) - lu(k,487) * lu(k,1609) + lu(k,1694) = lu(k,1694) - lu(k,488) * lu(k,1609) + lu(k,1700) = lu(k,1700) - lu(k,489) * lu(k,1609) + lu(k,1798) = lu(k,1798) - lu(k,484) * lu(k,1784) + lu(k,1813) = lu(k,1813) - lu(k,485) * lu(k,1784) + lu(k,1840) = lu(k,1840) - lu(k,486) * lu(k,1784) + lu(k,1842) = lu(k,1842) - lu(k,487) * lu(k,1784) + lu(k,1843) = lu(k,1843) - lu(k,488) * lu(k,1784) + lu(k,1849) = lu(k,1849) - lu(k,489) * lu(k,1784) + lu(k,1903) = lu(k,1903) - lu(k,484) * lu(k,1888) + lu(k,1921) = lu(k,1921) - lu(k,485) * lu(k,1888) + lu(k,1947) = lu(k,1947) - lu(k,486) * lu(k,1888) + lu(k,1949) = lu(k,1949) - lu(k,487) * lu(k,1888) + lu(k,1950) = lu(k,1950) - lu(k,488) * lu(k,1888) + lu(k,1956) = lu(k,1956) - lu(k,489) * lu(k,1888) + lu(k,491) = 1._r8 / lu(k,491) + lu(k,492) = lu(k,492) * lu(k,491) + lu(k,493) = lu(k,493) * lu(k,491) + lu(k,494) = lu(k,494) * lu(k,491) + lu(k,495) = lu(k,495) * lu(k,491) + lu(k,496) = lu(k,496) * lu(k,491) + lu(k,497) = lu(k,497) * lu(k,491) + lu(k,1688) = lu(k,1688) - lu(k,492) * lu(k,1610) + lu(k,1690) = lu(k,1690) - lu(k,493) * lu(k,1610) + lu(k,1691) = lu(k,1691) - lu(k,494) * lu(k,1610) + lu(k,1693) = lu(k,1693) - lu(k,495) * lu(k,1610) + lu(k,1700) = lu(k,1700) - lu(k,496) * lu(k,1610) + lu(k,1702) = lu(k,1702) - lu(k,497) * lu(k,1610) + lu(k,1837) = - lu(k,492) * lu(k,1785) + lu(k,1839) = - lu(k,493) * lu(k,1785) + lu(k,1840) = lu(k,1840) - lu(k,494) * lu(k,1785) + lu(k,1842) = lu(k,1842) - lu(k,495) * lu(k,1785) + lu(k,1849) = lu(k,1849) - lu(k,496) * lu(k,1785) + lu(k,1851) = lu(k,1851) - lu(k,497) * lu(k,1785) + lu(k,2189) = - lu(k,492) * lu(k,2166) + lu(k,2191) = lu(k,2191) - lu(k,493) * lu(k,2166) + lu(k,2192) = lu(k,2192) - lu(k,494) * lu(k,2166) + lu(k,2194) = lu(k,2194) - lu(k,495) * lu(k,2166) + lu(k,2201) = lu(k,2201) - lu(k,496) * lu(k,2166) + lu(k,2203) = lu(k,2203) - lu(k,497) * lu(k,2166) end do end subroutine lu_fac10 subroutine lu_fac11( avec_len, lu ) @@ -1424,181 +1369,166 @@ subroutine lu_fac11( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,473) = 1._r8 / lu(k,473) - lu(k,474) = lu(k,474) * lu(k,473) - lu(k,475) = lu(k,475) * lu(k,473) - lu(k,476) = lu(k,476) * lu(k,473) - lu(k,875) = lu(k,875) - lu(k,474) * lu(k,865) - lu(k,878) = lu(k,878) - lu(k,475) * lu(k,865) - lu(k,883) = - lu(k,476) * lu(k,865) - lu(k,1237) = lu(k,1237) - lu(k,474) * lu(k,1229) - lu(k,1240) = lu(k,1240) - lu(k,475) * lu(k,1229) - lu(k,1245) = lu(k,1245) - lu(k,476) * lu(k,1229) - lu(k,1267) = lu(k,1267) - lu(k,474) * lu(k,1249) - lu(k,1270) = lu(k,1270) - lu(k,475) * lu(k,1249) - lu(k,1275) = lu(k,1275) - lu(k,476) * lu(k,1249) - lu(k,1507) = lu(k,1507) - lu(k,474) * lu(k,1439) - lu(k,1510) = lu(k,1510) - lu(k,475) * lu(k,1439) - lu(k,1519) = lu(k,1519) - lu(k,476) * lu(k,1439) - lu(k,1688) = lu(k,1688) - lu(k,474) * lu(k,1655) - lu(k,1691) = lu(k,1691) - lu(k,475) * lu(k,1655) - lu(k,1700) = lu(k,1700) - lu(k,476) * lu(k,1655) - lu(k,1839) = lu(k,1839) - lu(k,474) * lu(k,1787) - lu(k,1842) = lu(k,1842) - lu(k,475) * lu(k,1787) - lu(k,1851) = lu(k,1851) - lu(k,476) * lu(k,1787) - lu(k,2043) = lu(k,2043) - lu(k,474) * lu(k,2006) - lu(k,2046) = lu(k,2046) - lu(k,475) * lu(k,2006) - lu(k,2055) = - lu(k,476) * lu(k,2006) - 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,1475) = lu(k,1475) - lu(k,478) * lu(k,1440) - lu(k,1481) = lu(k,1481) - lu(k,479) * lu(k,1440) - lu(k,1489) = lu(k,1489) - lu(k,480) * lu(k,1440) - lu(k,1508) = lu(k,1508) - lu(k,481) * lu(k,1440) - lu(k,1509) = lu(k,1509) - lu(k,482) * lu(k,1440) - lu(k,1512) = lu(k,1512) - lu(k,483) * lu(k,1440) - lu(k,1513) = lu(k,1513) - lu(k,484) * lu(k,1440) - lu(k,1610) = lu(k,1610) - lu(k,478) * lu(k,1590) - lu(k,1614) = lu(k,1614) - lu(k,479) * lu(k,1590) - lu(k,1622) = lu(k,1622) - lu(k,480) * lu(k,1590) - lu(k,1639) = lu(k,1639) - lu(k,481) * lu(k,1590) - lu(k,1640) = lu(k,1640) - lu(k,482) * lu(k,1590) - lu(k,1643) = lu(k,1643) - lu(k,483) * lu(k,1590) - lu(k,1644) = lu(k,1644) - lu(k,484) * lu(k,1590) - lu(k,1953) = lu(k,1953) - lu(k,478) * lu(k,1945) - lu(k,1958) = - lu(k,479) * lu(k,1945) - lu(k,1966) = lu(k,1966) - lu(k,480) * lu(k,1945) - lu(k,1984) = lu(k,1984) - lu(k,481) * lu(k,1945) - lu(k,1985) = lu(k,1985) - lu(k,482) * lu(k,1945) - lu(k,1988) = lu(k,1988) - lu(k,483) * lu(k,1945) - lu(k,1989) = lu(k,1989) - lu(k,484) * lu(k,1945) - lu(k,485) = 1._r8 / lu(k,485) - lu(k,486) = lu(k,486) * lu(k,485) - lu(k,487) = lu(k,487) * lu(k,485) - lu(k,488) = lu(k,488) * lu(k,485) - lu(k,489) = lu(k,489) * lu(k,485) - lu(k,490) = lu(k,490) * lu(k,485) - lu(k,491) = lu(k,491) * lu(k,485) - lu(k,492) = lu(k,492) * lu(k,485) - lu(k,1231) = - lu(k,486) * lu(k,1230) - lu(k,1233) = lu(k,1233) - lu(k,487) * lu(k,1230) - lu(k,1237) = lu(k,1237) - lu(k,488) * lu(k,1230) - lu(k,1238) = lu(k,1238) - lu(k,489) * lu(k,1230) - lu(k,1241) = lu(k,1241) - lu(k,490) * lu(k,1230) - lu(k,1242) = lu(k,1242) - lu(k,491) * lu(k,1230) - lu(k,1243) = lu(k,1243) - lu(k,492) * lu(k,1230) - lu(k,1484) = lu(k,1484) - lu(k,486) * lu(k,1441) - lu(k,1500) = lu(k,1500) - lu(k,487) * lu(k,1441) - lu(k,1507) = lu(k,1507) - lu(k,488) * lu(k,1441) - lu(k,1508) = lu(k,1508) - lu(k,489) * lu(k,1441) - lu(k,1512) = lu(k,1512) - lu(k,490) * lu(k,1441) - lu(k,1513) = lu(k,1513) - lu(k,491) * lu(k,1441) - lu(k,1517) = lu(k,1517) - lu(k,492) * lu(k,1441) - lu(k,1538) = - lu(k,486) * lu(k,1528) - lu(k,1541) = lu(k,1541) - lu(k,487) * lu(k,1528) - lu(k,1548) = lu(k,1548) - lu(k,488) * lu(k,1528) - lu(k,1549) = lu(k,1549) - lu(k,489) * lu(k,1528) - lu(k,1553) = lu(k,1553) - lu(k,490) * lu(k,1528) - lu(k,1554) = lu(k,1554) - lu(k,491) * lu(k,1528) - lu(k,1558) = lu(k,1558) - lu(k,492) * lu(k,1528) - lu(k,493) = 1._r8 / lu(k,493) - lu(k,494) = lu(k,494) * lu(k,493) - lu(k,495) = lu(k,495) * lu(k,493) - lu(k,496) = lu(k,496) * lu(k,493) - lu(k,555) = - lu(k,494) * lu(k,549) - lu(k,556) = - lu(k,495) * lu(k,549) - lu(k,559) = lu(k,559) - lu(k,496) * lu(k,549) - lu(k,596) = - lu(k,494) * lu(k,590) - lu(k,597) = lu(k,597) - lu(k,495) * lu(k,590) - lu(k,601) = lu(k,601) - lu(k,496) * lu(k,590) - lu(k,625) = - lu(k,494) * lu(k,619) - lu(k,626) = - lu(k,495) * lu(k,619) - lu(k,631) = lu(k,631) - lu(k,496) * lu(k,619) - lu(k,641) = - lu(k,494) * lu(k,635) - lu(k,642) = lu(k,642) - lu(k,495) * lu(k,635) - lu(k,648) = lu(k,648) - lu(k,496) * lu(k,635) - lu(k,895) = - lu(k,494) * lu(k,892) - lu(k,897) = - lu(k,495) * lu(k,892) - lu(k,906) = lu(k,906) - lu(k,496) * lu(k,892) - lu(k,1132) = - lu(k,494) * lu(k,1127) - lu(k,1135) = - lu(k,495) * lu(k,1127) - lu(k,1154) = lu(k,1154) - lu(k,496) * lu(k,1127) - lu(k,1471) = - lu(k,494) * lu(k,1442) - lu(k,1483) = lu(k,1483) - lu(k,495) * lu(k,1442) - lu(k,1513) = lu(k,1513) - lu(k,496) * lu(k,1442) - lu(k,1608) = lu(k,1608) - lu(k,494) * lu(k,1591) - lu(k,1616) = lu(k,1616) - lu(k,495) * lu(k,1591) - lu(k,1644) = lu(k,1644) - lu(k,496) * lu(k,1591) - lu(k,497) = 1._r8 / lu(k,497) - lu(k,498) = lu(k,498) * lu(k,497) - lu(k,499) = lu(k,499) * lu(k,497) - lu(k,500) = lu(k,500) * lu(k,497) - lu(k,501) = lu(k,501) * lu(k,497) - lu(k,502) = lu(k,502) * lu(k,497) - lu(k,503) = lu(k,503) * lu(k,497) - lu(k,1507) = lu(k,1507) - lu(k,498) * lu(k,1443) - lu(k,1513) = lu(k,1513) - lu(k,499) * lu(k,1443) - lu(k,1514) = lu(k,1514) - lu(k,500) * lu(k,1443) - lu(k,1515) = lu(k,1515) - lu(k,501) * lu(k,1443) - lu(k,1516) = lu(k,1516) - lu(k,502) * lu(k,1443) - lu(k,1519) = lu(k,1519) - lu(k,503) * lu(k,1443) - lu(k,1839) = lu(k,1839) - lu(k,498) * lu(k,1788) - lu(k,1845) = lu(k,1845) - lu(k,499) * lu(k,1788) - lu(k,1846) = lu(k,1846) - lu(k,500) * lu(k,1788) - lu(k,1847) = lu(k,1847) - lu(k,501) * lu(k,1788) - lu(k,1848) = lu(k,1848) - lu(k,502) * lu(k,1788) - lu(k,1851) = lu(k,1851) - lu(k,503) * lu(k,1788) - lu(k,1869) = lu(k,1869) - lu(k,498) * lu(k,1855) - lu(k,1875) = lu(k,1875) - lu(k,499) * lu(k,1855) - lu(k,1876) = lu(k,1876) - lu(k,500) * lu(k,1855) - lu(k,1877) = lu(k,1877) - lu(k,501) * lu(k,1855) - lu(k,1878) = lu(k,1878) - lu(k,502) * lu(k,1855) - lu(k,1881) = - lu(k,503) * lu(k,1855) - lu(k,1926) = lu(k,1926) - lu(k,498) * lu(k,1909) - lu(k,1932) = lu(k,1932) - lu(k,499) * lu(k,1909) - lu(k,1933) = - lu(k,500) * lu(k,1909) - lu(k,1934) = lu(k,1934) - lu(k,501) * lu(k,1909) - lu(k,1935) = lu(k,1935) - lu(k,502) * lu(k,1909) - lu(k,1938) = lu(k,1938) - lu(k,503) * lu(k,1909) - lu(k,504) = 1._r8 / lu(k,504) - lu(k,505) = lu(k,505) * lu(k,504) - lu(k,506) = lu(k,506) * lu(k,504) - lu(k,507) = lu(k,507) * lu(k,504) - lu(k,508) = lu(k,508) * lu(k,504) - lu(k,509) = lu(k,509) * lu(k,504) - lu(k,510) = lu(k,510) * lu(k,504) - lu(k,511) = lu(k,511) * lu(k,504) - lu(k,512) = lu(k,512) * lu(k,504) - lu(k,974) = lu(k,974) - lu(k,505) * lu(k,972) - lu(k,975) = lu(k,975) - lu(k,506) * lu(k,972) - lu(k,976) = lu(k,976) - lu(k,507) * lu(k,972) - lu(k,977) = lu(k,977) - lu(k,508) * lu(k,972) - lu(k,978) = lu(k,978) - lu(k,509) * lu(k,972) - lu(k,983) = - lu(k,510) * lu(k,972) - lu(k,987) = lu(k,987) - lu(k,511) * lu(k,972) - lu(k,988) = lu(k,988) - lu(k,512) * lu(k,972) - lu(k,1475) = lu(k,1475) - lu(k,505) * lu(k,1444) - lu(k,1480) = lu(k,1480) - lu(k,506) * lu(k,1444) - lu(k,1482) = lu(k,1482) - lu(k,507) * lu(k,1444) - lu(k,1483) = lu(k,1483) - lu(k,508) * lu(k,1444) - lu(k,1486) = lu(k,1486) - lu(k,509) * lu(k,1444) - lu(k,1507) = lu(k,1507) - lu(k,510) * lu(k,1444) - lu(k,1512) = lu(k,1512) - lu(k,511) * lu(k,1444) - lu(k,1513) = lu(k,1513) - lu(k,512) * lu(k,1444) - lu(k,1812) = lu(k,1812) - lu(k,505) * lu(k,1789) - lu(k,1814) = lu(k,1814) - lu(k,506) * lu(k,1789) - lu(k,1815) = - lu(k,507) * lu(k,1789) - lu(k,1816) = lu(k,1816) - lu(k,508) * lu(k,1789) - lu(k,1819) = lu(k,1819) - lu(k,509) * lu(k,1789) - lu(k,1839) = lu(k,1839) - lu(k,510) * lu(k,1789) - lu(k,1844) = lu(k,1844) - lu(k,511) * lu(k,1789) - lu(k,1845) = lu(k,1845) - lu(k,512) * lu(k,1789) + lu(k,499) = 1._r8 / lu(k,499) + lu(k,500) = lu(k,500) * lu(k,499) + lu(k,501) = lu(k,501) * lu(k,499) + lu(k,502) = lu(k,502) * lu(k,499) + lu(k,503) = lu(k,503) * lu(k,499) + lu(k,504) = lu(k,504) * lu(k,499) + lu(k,505) = lu(k,505) * lu(k,499) + lu(k,1660) = lu(k,1660) - lu(k,500) * lu(k,1611) + lu(k,1676) = lu(k,1676) - lu(k,501) * lu(k,1611) + lu(k,1691) = lu(k,1691) - lu(k,502) * lu(k,1611) + lu(k,1693) = lu(k,1693) - lu(k,503) * lu(k,1611) + lu(k,1694) = lu(k,1694) - lu(k,504) * lu(k,1611) + lu(k,1700) = lu(k,1700) - lu(k,505) * lu(k,1611) + lu(k,1813) = lu(k,1813) - lu(k,500) * lu(k,1786) + lu(k,1827) = lu(k,1827) - lu(k,501) * lu(k,1786) + lu(k,1840) = lu(k,1840) - lu(k,502) * lu(k,1786) + lu(k,1842) = lu(k,1842) - lu(k,503) * lu(k,1786) + lu(k,1843) = lu(k,1843) - lu(k,504) * lu(k,1786) + lu(k,1849) = lu(k,1849) - lu(k,505) * lu(k,1786) + lu(k,1921) = lu(k,1921) - lu(k,500) * lu(k,1889) + lu(k,1933) = lu(k,1933) - lu(k,501) * lu(k,1889) + lu(k,1947) = lu(k,1947) - lu(k,502) * lu(k,1889) + lu(k,1949) = lu(k,1949) - lu(k,503) * lu(k,1889) + lu(k,1950) = lu(k,1950) - lu(k,504) * lu(k,1889) + lu(k,1956) = lu(k,1956) - lu(k,505) * lu(k,1889) + lu(k,506) = 1._r8 / lu(k,506) + lu(k,507) = lu(k,507) * lu(k,506) + lu(k,508) = lu(k,508) * lu(k,506) + lu(k,509) = lu(k,509) * lu(k,506) + lu(k,510) = lu(k,510) * lu(k,506) + lu(k,633) = - lu(k,507) * lu(k,631) + lu(k,634) = - lu(k,508) * lu(k,631) + lu(k,638) = - lu(k,509) * lu(k,631) + lu(k,640) = lu(k,640) - lu(k,510) * lu(k,631) + lu(k,667) = - lu(k,507) * lu(k,665) + lu(k,668) = - lu(k,508) * lu(k,665) + lu(k,671) = - lu(k,509) * lu(k,665) + lu(k,673) = lu(k,673) - lu(k,510) * lu(k,665) + lu(k,897) = - lu(k,507) * lu(k,894) + lu(k,898) = - lu(k,508) * lu(k,894) + lu(k,902) = - lu(k,509) * lu(k,894) + lu(k,904) = - lu(k,510) * lu(k,894) + lu(k,1632) = lu(k,1632) - lu(k,507) * lu(k,1612) + lu(k,1646) = lu(k,1646) - lu(k,508) * lu(k,1612) + lu(k,1683) = lu(k,1683) - lu(k,509) * lu(k,1612) + lu(k,1691) = lu(k,1691) - lu(k,510) * lu(k,1612) + lu(k,1796) = lu(k,1796) - lu(k,507) * lu(k,1787) + lu(k,1805) = lu(k,1805) - lu(k,508) * lu(k,1787) + lu(k,1833) = lu(k,1833) - lu(k,509) * lu(k,1787) + lu(k,1840) = lu(k,1840) - lu(k,510) * lu(k,1787) + lu(k,511) = 1._r8 / lu(k,511) + lu(k,512) = lu(k,512) * lu(k,511) + lu(k,513) = lu(k,513) * lu(k,511) + lu(k,514) = lu(k,514) * lu(k,511) + lu(k,515) = lu(k,515) * lu(k,511) + lu(k,516) = lu(k,516) * lu(k,511) + lu(k,1232) = lu(k,1232) - lu(k,512) * lu(k,1230) + lu(k,1234) = lu(k,1234) - lu(k,513) * lu(k,1230) + lu(k,1235) = lu(k,1235) - lu(k,514) * lu(k,1230) + lu(k,1240) = lu(k,1240) - lu(k,515) * lu(k,1230) + lu(k,1243) = lu(k,1243) - lu(k,516) * lu(k,1230) + lu(k,1677) = lu(k,1677) - lu(k,512) * lu(k,1613) + lu(k,1688) = lu(k,1688) - lu(k,513) * lu(k,1613) + lu(k,1691) = lu(k,1691) - lu(k,514) * lu(k,1613) + lu(k,1698) = lu(k,1698) - lu(k,515) * lu(k,1613) + lu(k,1702) = lu(k,1702) - lu(k,516) * lu(k,1613) + lu(k,2112) = lu(k,2112) - lu(k,512) * lu(k,2085) + lu(k,2122) = lu(k,2122) - lu(k,513) * lu(k,2085) + lu(k,2125) = lu(k,2125) - lu(k,514) * lu(k,2085) + lu(k,2132) = lu(k,2132) - lu(k,515) * lu(k,2085) + lu(k,2136) = lu(k,2136) - lu(k,516) * lu(k,2085) + lu(k,2239) = lu(k,2239) - lu(k,512) * lu(k,2230) + lu(k,2244) = lu(k,2244) - lu(k,513) * lu(k,2230) + lu(k,2247) = lu(k,2247) - lu(k,514) * lu(k,2230) + lu(k,2254) = lu(k,2254) - lu(k,515) * lu(k,2230) + lu(k,2258) = lu(k,2258) - lu(k,516) * lu(k,2230) + lu(k,518) = 1._r8 / lu(k,518) + lu(k,519) = lu(k,519) * lu(k,518) + lu(k,520) = lu(k,520) * lu(k,518) + lu(k,521) = lu(k,521) * lu(k,518) + lu(k,522) = lu(k,522) * lu(k,518) + lu(k,523) = lu(k,523) * lu(k,518) + lu(k,1627) = lu(k,1627) - lu(k,519) * lu(k,1614) + lu(k,1691) = lu(k,1691) - lu(k,520) * lu(k,1614) + lu(k,1693) = lu(k,1693) - lu(k,521) * lu(k,1614) + lu(k,1694) = lu(k,1694) - lu(k,522) * lu(k,1614) + lu(k,1700) = lu(k,1700) - lu(k,523) * lu(k,1614) + lu(k,1794) = lu(k,1794) - lu(k,519) * lu(k,1788) + lu(k,1840) = lu(k,1840) - lu(k,520) * lu(k,1788) + lu(k,1842) = lu(k,1842) - lu(k,521) * lu(k,1788) + lu(k,1843) = lu(k,1843) - lu(k,522) * lu(k,1788) + lu(k,1849) = lu(k,1849) - lu(k,523) * lu(k,1788) + lu(k,1894) = lu(k,1894) - lu(k,519) * lu(k,1890) + lu(k,1947) = lu(k,1947) - lu(k,520) * lu(k,1890) + lu(k,1949) = lu(k,1949) - lu(k,521) * lu(k,1890) + lu(k,1950) = lu(k,1950) - lu(k,522) * lu(k,1890) + lu(k,1956) = lu(k,1956) - lu(k,523) * lu(k,1890) + lu(k,2171) = lu(k,2171) - lu(k,519) * lu(k,2167) + lu(k,2192) = lu(k,2192) - lu(k,520) * lu(k,2167) + lu(k,2194) = lu(k,2194) - lu(k,521) * lu(k,2167) + lu(k,2195) = lu(k,2195) - lu(k,522) * lu(k,2167) + lu(k,2201) = lu(k,2201) - lu(k,523) * lu(k,2167) + lu(k,524) = 1._r8 / lu(k,524) + lu(k,525) = lu(k,525) * lu(k,524) + lu(k,526) = lu(k,526) * lu(k,524) + lu(k,527) = lu(k,527) * lu(k,524) + lu(k,528) = lu(k,528) * lu(k,524) + lu(k,529) = lu(k,529) * lu(k,524) + lu(k,530) = lu(k,530) * lu(k,524) + lu(k,531) = lu(k,531) * lu(k,524) + lu(k,1371) = lu(k,1371) - lu(k,525) * lu(k,1368) + lu(k,1386) = lu(k,1386) - lu(k,526) * lu(k,1368) + lu(k,1389) = lu(k,1389) - lu(k,527) * lu(k,1368) + lu(k,1390) = lu(k,1390) - lu(k,528) * lu(k,1368) + lu(k,1391) = - lu(k,529) * lu(k,1368) + lu(k,1394) = lu(k,1394) - lu(k,530) * lu(k,1368) + lu(k,1396) = lu(k,1396) - lu(k,531) * lu(k,1368) + lu(k,1644) = lu(k,1644) - lu(k,525) * lu(k,1615) + lu(k,1683) = lu(k,1683) - lu(k,526) * lu(k,1615) + lu(k,1689) = lu(k,1689) - lu(k,527) * lu(k,1615) + lu(k,1691) = lu(k,1691) - lu(k,528) * lu(k,1615) + lu(k,1692) = lu(k,1692) - lu(k,529) * lu(k,1615) + lu(k,1697) = lu(k,1697) - lu(k,530) * lu(k,1615) + lu(k,1700) = lu(k,1700) - lu(k,531) * lu(k,1615) + lu(k,2175) = - lu(k,525) * lu(k,2168) + lu(k,2185) = lu(k,2185) - lu(k,526) * lu(k,2168) + lu(k,2190) = - lu(k,527) * lu(k,2168) + lu(k,2192) = lu(k,2192) - lu(k,528) * lu(k,2168) + lu(k,2193) = lu(k,2193) - lu(k,529) * lu(k,2168) + lu(k,2198) = - lu(k,530) * lu(k,2168) + lu(k,2201) = lu(k,2201) - lu(k,531) * lu(k,2168) + lu(k,532) = 1._r8 / lu(k,532) + lu(k,533) = lu(k,533) * lu(k,532) + lu(k,534) = lu(k,534) * lu(k,532) + lu(k,535) = lu(k,535) * lu(k,532) + lu(k,536) = lu(k,536) * lu(k,532) + lu(k,537) = lu(k,537) * lu(k,532) + lu(k,538) = lu(k,538) * lu(k,532) + lu(k,539) = lu(k,539) * lu(k,532) + lu(k,768) = lu(k,768) - lu(k,533) * lu(k,767) + lu(k,769) = lu(k,769) - lu(k,534) * lu(k,767) + lu(k,770) = - lu(k,535) * lu(k,767) + lu(k,771) = lu(k,771) - lu(k,536) * lu(k,767) + lu(k,772) = - lu(k,537) * lu(k,767) + lu(k,774) = lu(k,774) - lu(k,538) * lu(k,767) + lu(k,776) = - lu(k,539) * lu(k,767) + lu(k,1641) = lu(k,1641) - lu(k,533) * lu(k,1616) + lu(k,1666) = lu(k,1666) - lu(k,534) * lu(k,1616) + lu(k,1671) = lu(k,1671) - lu(k,535) * lu(k,1616) + lu(k,1689) = lu(k,1689) - lu(k,536) * lu(k,1616) + lu(k,1691) = lu(k,1691) - lu(k,537) * lu(k,1616) + lu(k,1694) = lu(k,1694) - lu(k,538) * lu(k,1616) + lu(k,1703) = lu(k,1703) - lu(k,539) * lu(k,1616) + lu(k,1907) = lu(k,1907) - lu(k,533) * lu(k,1891) + lu(k,1924) = lu(k,1924) - lu(k,534) * lu(k,1891) + lu(k,1929) = - lu(k,535) * lu(k,1891) + lu(k,1945) = lu(k,1945) - lu(k,536) * lu(k,1891) + lu(k,1947) = lu(k,1947) - lu(k,537) * lu(k,1891) + lu(k,1950) = lu(k,1950) - lu(k,538) * lu(k,1891) + lu(k,1959) = lu(k,1959) - lu(k,539) * lu(k,1891) end do end subroutine lu_fac11 subroutine lu_fac12( avec_len, lu ) @@ -1615,212 +1545,155 @@ subroutine lu_fac12( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,513) = 1._r8 / lu(k,513) - lu(k,514) = lu(k,514) * lu(k,513) - lu(k,515) = lu(k,515) * lu(k,513) - lu(k,516) = lu(k,516) * lu(k,513) - lu(k,517) = lu(k,517) * lu(k,513) - lu(k,518) = lu(k,518) * lu(k,513) - lu(k,519) = lu(k,519) * lu(k,513) - lu(k,520) = lu(k,520) * lu(k,513) - lu(k,521) = lu(k,521) * lu(k,513) - lu(k,1203) = - lu(k,514) * lu(k,1200) - lu(k,1204) = - lu(k,515) * lu(k,1200) - lu(k,1206) = - lu(k,516) * lu(k,1200) - lu(k,1217) = - lu(k,517) * lu(k,1200) - lu(k,1219) = - lu(k,518) * lu(k,1200) - lu(k,1220) = lu(k,1220) - lu(k,519) * lu(k,1200) - lu(k,1223) = lu(k,1223) - lu(k,520) * lu(k,1200) - lu(k,1224) = lu(k,1224) - lu(k,521) * lu(k,1200) - lu(k,1480) = lu(k,1480) - lu(k,514) * lu(k,1445) - lu(k,1481) = lu(k,1481) - lu(k,515) * lu(k,1445) - lu(k,1484) = lu(k,1484) - lu(k,516) * lu(k,1445) - lu(k,1503) = lu(k,1503) - lu(k,517) * lu(k,1445) - lu(k,1507) = lu(k,1507) - lu(k,518) * lu(k,1445) - lu(k,1508) = lu(k,1508) - lu(k,519) * lu(k,1445) - lu(k,1512) = lu(k,1512) - lu(k,520) * lu(k,1445) - lu(k,1513) = lu(k,1513) - lu(k,521) * lu(k,1445) - lu(k,1613) = lu(k,1613) - lu(k,514) * lu(k,1592) - lu(k,1614) = lu(k,1614) - lu(k,515) * lu(k,1592) - lu(k,1617) = lu(k,1617) - lu(k,516) * lu(k,1592) - lu(k,1634) = lu(k,1634) - lu(k,517) * lu(k,1592) - lu(k,1638) = lu(k,1638) - lu(k,518) * lu(k,1592) - lu(k,1639) = lu(k,1639) - lu(k,519) * lu(k,1592) - lu(k,1643) = lu(k,1643) - lu(k,520) * lu(k,1592) - lu(k,1644) = lu(k,1644) - lu(k,521) * lu(k,1592) - lu(k,522) = 1._r8 / lu(k,522) - lu(k,523) = lu(k,523) * lu(k,522) - lu(k,524) = lu(k,524) * lu(k,522) - lu(k,525) = lu(k,525) * lu(k,522) - lu(k,526) = lu(k,526) * lu(k,522) - lu(k,527) = lu(k,527) * lu(k,522) - lu(k,953) = lu(k,953) - lu(k,523) * lu(k,950) - lu(k,961) = - lu(k,524) * lu(k,950) - lu(k,963) = lu(k,963) - lu(k,525) * lu(k,950) - lu(k,964) = lu(k,964) - lu(k,526) * lu(k,950) - lu(k,968) = lu(k,968) - lu(k,527) * lu(k,950) - lu(k,993) = lu(k,993) - lu(k,523) * lu(k,991) - lu(k,1000) = lu(k,1000) - lu(k,524) * lu(k,991) - lu(k,1002) = lu(k,1002) - lu(k,525) * lu(k,991) - lu(k,1003) = lu(k,1003) - lu(k,526) * lu(k,991) - lu(k,1007) = lu(k,1007) - lu(k,527) * lu(k,991) - lu(k,1478) = lu(k,1478) - lu(k,523) * lu(k,1446) - lu(k,1503) = lu(k,1503) - lu(k,524) * lu(k,1446) - lu(k,1507) = lu(k,1507) - lu(k,525) * lu(k,1446) - lu(k,1508) = lu(k,1508) - lu(k,526) * lu(k,1446) - lu(k,1513) = lu(k,1513) - lu(k,527) * lu(k,1446) - lu(k,1611) = lu(k,1611) - lu(k,523) * lu(k,1593) - lu(k,1634) = lu(k,1634) - lu(k,524) * lu(k,1593) - lu(k,1638) = lu(k,1638) - lu(k,525) * lu(k,1593) - lu(k,1639) = lu(k,1639) - lu(k,526) * lu(k,1593) - lu(k,1644) = lu(k,1644) - lu(k,527) * lu(k,1593) - lu(k,1663) = lu(k,1663) - lu(k,523) * lu(k,1656) - lu(k,1684) = lu(k,1684) - lu(k,524) * lu(k,1656) - lu(k,1688) = lu(k,1688) - lu(k,525) * lu(k,1656) - lu(k,1689) = lu(k,1689) - lu(k,526) * lu(k,1656) - lu(k,1694) = lu(k,1694) - lu(k,527) * lu(k,1656) - 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,1507) = lu(k,1507) - lu(k,531) * lu(k,1447) - lu(k,1508) = lu(k,1508) - lu(k,532) * lu(k,1447) - lu(k,1509) = lu(k,1509) - lu(k,533) * lu(k,1447) - lu(k,1513) = lu(k,1513) - lu(k,534) * lu(k,1447) - lu(k,1518) = lu(k,1518) - lu(k,535) * lu(k,1447) - lu(k,1548) = lu(k,1548) - lu(k,531) * lu(k,1529) - lu(k,1549) = lu(k,1549) - lu(k,532) * lu(k,1529) - lu(k,1550) = lu(k,1550) - lu(k,533) * lu(k,1529) - lu(k,1554) = lu(k,1554) - lu(k,534) * lu(k,1529) - lu(k,1559) = lu(k,1559) - lu(k,535) * lu(k,1529) - lu(k,1638) = lu(k,1638) - lu(k,531) * lu(k,1594) - lu(k,1639) = lu(k,1639) - lu(k,532) * lu(k,1594) - lu(k,1640) = lu(k,1640) - lu(k,533) * lu(k,1594) - lu(k,1644) = lu(k,1644) - lu(k,534) * lu(k,1594) - lu(k,1649) = lu(k,1649) - lu(k,535) * lu(k,1594) - lu(k,1839) = lu(k,1839) - lu(k,531) * lu(k,1790) - lu(k,1840) = lu(k,1840) - lu(k,532) * lu(k,1790) - lu(k,1841) = lu(k,1841) - lu(k,533) * lu(k,1790) - lu(k,1845) = lu(k,1845) - lu(k,534) * lu(k,1790) - lu(k,1850) = lu(k,1850) - lu(k,535) * lu(k,1790) - lu(k,2043) = lu(k,2043) - lu(k,531) * lu(k,2007) - lu(k,2044) = lu(k,2044) - lu(k,532) * lu(k,2007) - lu(k,2045) = lu(k,2045) - lu(k,533) * lu(k,2007) - lu(k,2049) = lu(k,2049) - lu(k,534) * lu(k,2007) - lu(k,2054) = lu(k,2054) - lu(k,535) * lu(k,2007) - lu(k,537) = 1._r8 / lu(k,537) - lu(k,538) = lu(k,538) * lu(k,537) - lu(k,539) = lu(k,539) * lu(k,537) - lu(k,540) = lu(k,540) * lu(k,537) - lu(k,541) = lu(k,541) * lu(k,537) - lu(k,542) = lu(k,542) * lu(k,537) - lu(k,543) = lu(k,543) * lu(k,537) - lu(k,544) = lu(k,544) * lu(k,537) - lu(k,545) = lu(k,545) * lu(k,537) - lu(k,546) = lu(k,546) * lu(k,537) - lu(k,835) = lu(k,835) - lu(k,538) * lu(k,833) - lu(k,836) = lu(k,836) - lu(k,539) * lu(k,833) - lu(k,837) = lu(k,837) - lu(k,540) * lu(k,833) - lu(k,838) = lu(k,838) - lu(k,541) * lu(k,833) - lu(k,839) = lu(k,839) - lu(k,542) * lu(k,833) - lu(k,840) = lu(k,840) - lu(k,543) * lu(k,833) - lu(k,841) = lu(k,841) - lu(k,544) * lu(k,833) - lu(k,845) = lu(k,845) - lu(k,545) * lu(k,833) - lu(k,846) = lu(k,846) - lu(k,546) * lu(k,833) - lu(k,1451) = lu(k,1451) - lu(k,538) * lu(k,1448) - lu(k,1465) = lu(k,1465) - lu(k,539) * lu(k,1448) - lu(k,1474) = lu(k,1474) - lu(k,540) * lu(k,1448) - lu(k,1475) = lu(k,1475) - lu(k,541) * lu(k,1448) - lu(k,1489) = lu(k,1489) - lu(k,542) * lu(k,1448) - lu(k,1501) = lu(k,1501) - lu(k,543) * lu(k,1448) - lu(k,1507) = lu(k,1507) - lu(k,544) * lu(k,1448) - lu(k,1512) = lu(k,1512) - lu(k,545) * lu(k,1448) - lu(k,1513) = lu(k,1513) - lu(k,546) * lu(k,1448) - lu(k,1793) = lu(k,1793) - lu(k,538) * lu(k,1791) - lu(k,1806) = lu(k,1806) - lu(k,539) * lu(k,1791) - lu(k,1811) = lu(k,1811) - lu(k,540) * lu(k,1791) - lu(k,1812) = lu(k,1812) - lu(k,541) * lu(k,1791) - lu(k,1822) = lu(k,1822) - lu(k,542) * lu(k,1791) - lu(k,1833) = lu(k,1833) - lu(k,543) * lu(k,1791) - lu(k,1839) = lu(k,1839) - lu(k,544) * lu(k,1791) - lu(k,1844) = lu(k,1844) - lu(k,545) * lu(k,1791) - lu(k,1845) = lu(k,1845) - lu(k,546) * lu(k,1791) - 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,559) = lu(k,559) * lu(k,550) - lu(k,621) = lu(k,621) - lu(k,551) * lu(k,620) - lu(k,622) = lu(k,622) - lu(k,552) * lu(k,620) - lu(k,623) = lu(k,623) - lu(k,553) * lu(k,620) - lu(k,624) = lu(k,624) - lu(k,554) * lu(k,620) - lu(k,625) = lu(k,625) - lu(k,555) * lu(k,620) - lu(k,626) = lu(k,626) - lu(k,556) * lu(k,620) - lu(k,627) = lu(k,627) - lu(k,557) * lu(k,620) - lu(k,628) = - lu(k,558) * lu(k,620) - lu(k,631) = lu(k,631) - lu(k,559) * lu(k,620) - lu(k,1455) = lu(k,1455) - lu(k,551) * lu(k,1449) - lu(k,1456) = lu(k,1456) - lu(k,552) * lu(k,1449) - lu(k,1458) = - lu(k,553) * lu(k,1449) - lu(k,1470) = lu(k,1470) - lu(k,554) * lu(k,1449) - lu(k,1471) = lu(k,1471) - lu(k,555) * lu(k,1449) - lu(k,1483) = lu(k,1483) - lu(k,556) * lu(k,1449) - lu(k,1494) = lu(k,1494) - lu(k,557) * lu(k,1449) - lu(k,1507) = lu(k,1507) - lu(k,558) * lu(k,1449) - lu(k,1513) = lu(k,1513) - lu(k,559) * lu(k,1449) - lu(k,1797) = lu(k,1797) - lu(k,551) * lu(k,1792) - lu(k,1798) = lu(k,1798) - lu(k,552) * lu(k,1792) - lu(k,1800) = lu(k,1800) - lu(k,553) * lu(k,1792) - lu(k,1809) = lu(k,1809) - lu(k,554) * lu(k,1792) - lu(k,1810) = lu(k,1810) - lu(k,555) * lu(k,1792) - lu(k,1816) = lu(k,1816) - lu(k,556) * lu(k,1792) - lu(k,1827) = lu(k,1827) - lu(k,557) * lu(k,1792) - lu(k,1839) = lu(k,1839) - lu(k,558) * lu(k,1792) - lu(k,1845) = lu(k,1845) - lu(k,559) * lu(k,1792) - lu(k,561) = 1._r8 / lu(k,561) - lu(k,562) = lu(k,562) * lu(k,561) - lu(k,563) = lu(k,563) * lu(k,561) - lu(k,564) = lu(k,564) * lu(k,561) - lu(k,565) = lu(k,565) * lu(k,561) - lu(k,566) = lu(k,566) * lu(k,561) - lu(k,567) = lu(k,567) * lu(k,561) - lu(k,568) = lu(k,568) * lu(k,561) - lu(k,569) = lu(k,569) * lu(k,561) - lu(k,570) = lu(k,570) * lu(k,561) - lu(k,835) = lu(k,835) - lu(k,562) * lu(k,834) - lu(k,836) = lu(k,836) - lu(k,563) * lu(k,834) - lu(k,838) = lu(k,838) - lu(k,564) * lu(k,834) - lu(k,839) = lu(k,839) - lu(k,565) * lu(k,834) - lu(k,840) = lu(k,840) - lu(k,566) * lu(k,834) - lu(k,841) = lu(k,841) - lu(k,567) * lu(k,834) - lu(k,842) = lu(k,842) - lu(k,568) * lu(k,834) - lu(k,845) = lu(k,845) - lu(k,569) * lu(k,834) - lu(k,846) = lu(k,846) - lu(k,570) * lu(k,834) - lu(k,1451) = lu(k,1451) - lu(k,562) * lu(k,1450) - lu(k,1465) = lu(k,1465) - lu(k,563) * lu(k,1450) - lu(k,1475) = lu(k,1475) - lu(k,564) * lu(k,1450) - lu(k,1489) = lu(k,1489) - lu(k,565) * lu(k,1450) - lu(k,1501) = lu(k,1501) - lu(k,566) * lu(k,1450) - lu(k,1507) = lu(k,1507) - lu(k,567) * lu(k,1450) - lu(k,1508) = lu(k,1508) - lu(k,568) * lu(k,1450) - lu(k,1512) = lu(k,1512) - lu(k,569) * lu(k,1450) - lu(k,1513) = lu(k,1513) - lu(k,570) * lu(k,1450) - lu(k,1596) = lu(k,1596) - lu(k,562) * lu(k,1595) - lu(k,1605) = lu(k,1605) - lu(k,563) * lu(k,1595) - lu(k,1610) = lu(k,1610) - lu(k,564) * lu(k,1595) - lu(k,1622) = lu(k,1622) - lu(k,565) * lu(k,1595) - lu(k,1632) = lu(k,1632) - lu(k,566) * lu(k,1595) - lu(k,1638) = lu(k,1638) - lu(k,567) * lu(k,1595) - lu(k,1639) = lu(k,1639) - lu(k,568) * lu(k,1595) - lu(k,1643) = lu(k,1643) - lu(k,569) * lu(k,1595) - lu(k,1644) = lu(k,1644) - lu(k,570) * lu(k,1595) + lu(k,540) = 1._r8 / lu(k,540) + lu(k,541) = lu(k,541) * lu(k,540) + lu(k,542) = lu(k,542) * lu(k,540) + lu(k,543) = lu(k,543) * lu(k,540) + lu(k,544) = lu(k,544) * lu(k,540) + lu(k,545) = lu(k,545) * lu(k,540) + lu(k,546) = lu(k,546) * lu(k,540) + lu(k,547) = lu(k,547) * lu(k,540) + lu(k,2174) = - lu(k,541) * lu(k,2169) + lu(k,2186) = - lu(k,542) * lu(k,2169) + lu(k,2188) = lu(k,2188) - lu(k,543) * lu(k,2169) + lu(k,2193) = lu(k,2193) - lu(k,544) * lu(k,2169) + lu(k,2201) = lu(k,2201) - lu(k,545) * lu(k,2169) + lu(k,2202) = lu(k,2202) - lu(k,546) * lu(k,2169) + lu(k,2203) = lu(k,2203) - lu(k,547) * lu(k,2169) + lu(k,2208) = lu(k,2208) - lu(k,541) * lu(k,2207) + lu(k,2211) = lu(k,2211) - lu(k,542) * lu(k,2207) + lu(k,2212) = - lu(k,543) * lu(k,2207) + lu(k,2217) = - lu(k,544) * lu(k,2207) + lu(k,2225) = lu(k,2225) - lu(k,545) * lu(k,2207) + lu(k,2226) = lu(k,2226) - lu(k,546) * lu(k,2207) + lu(k,2227) = lu(k,2227) - lu(k,547) * lu(k,2207) + lu(k,2233) = lu(k,2233) - lu(k,541) * lu(k,2231) + lu(k,2241) = lu(k,2241) - lu(k,542) * lu(k,2231) + lu(k,2243) = - lu(k,543) * lu(k,2231) + lu(k,2248) = lu(k,2248) - lu(k,544) * lu(k,2231) + lu(k,2256) = lu(k,2256) - lu(k,545) * lu(k,2231) + lu(k,2257) = lu(k,2257) - lu(k,546) * lu(k,2231) + lu(k,2258) = lu(k,2258) - lu(k,547) * lu(k,2231) + lu(k,548) = 1._r8 / lu(k,548) + lu(k,549) = lu(k,549) * lu(k,548) + lu(k,550) = lu(k,550) * lu(k,548) + lu(k,551) = lu(k,551) * lu(k,548) + lu(k,552) = lu(k,552) * lu(k,548) + lu(k,553) = lu(k,553) * lu(k,548) + lu(k,554) = lu(k,554) * lu(k,548) + lu(k,555) = lu(k,555) * lu(k,548) + lu(k,1636) = lu(k,1636) - lu(k,549) * lu(k,1617) + lu(k,1657) = lu(k,1657) - lu(k,550) * lu(k,1617) + lu(k,1668) = lu(k,1668) - lu(k,551) * lu(k,1617) + lu(k,1689) = lu(k,1689) - lu(k,552) * lu(k,1617) + lu(k,1691) = lu(k,1691) - lu(k,553) * lu(k,1617) + lu(k,1694) = lu(k,1694) - lu(k,554) * lu(k,1617) + lu(k,1698) = lu(k,1698) - lu(k,555) * lu(k,1617) + lu(k,1995) = - lu(k,549) * lu(k,1992) + lu(k,1999) = lu(k,1999) - lu(k,550) * lu(k,1992) + lu(k,2003) = lu(k,2003) - lu(k,551) * lu(k,1992) + lu(k,2010) = lu(k,2010) - lu(k,552) * lu(k,1992) + lu(k,2012) = lu(k,2012) - lu(k,553) * lu(k,1992) + lu(k,2015) = lu(k,2015) - lu(k,554) * lu(k,1992) + lu(k,2019) = lu(k,2019) - lu(k,555) * lu(k,1992) + lu(k,2089) = - lu(k,549) * lu(k,2086) + lu(k,2095) = lu(k,2095) - lu(k,550) * lu(k,2086) + lu(k,2105) = lu(k,2105) - lu(k,551) * lu(k,2086) + lu(k,2123) = lu(k,2123) - lu(k,552) * lu(k,2086) + lu(k,2125) = lu(k,2125) - lu(k,553) * lu(k,2086) + lu(k,2128) = lu(k,2128) - lu(k,554) * lu(k,2086) + lu(k,2132) = lu(k,2132) - lu(k,555) * lu(k,2086) + lu(k,556) = 1._r8 / lu(k,556) + lu(k,557) = lu(k,557) * lu(k,556) + lu(k,558) = lu(k,558) * lu(k,556) + lu(k,559) = lu(k,559) * lu(k,556) + lu(k,560) = lu(k,560) * lu(k,556) + lu(k,561) = lu(k,561) * lu(k,556) + lu(k,562) = lu(k,562) * lu(k,556) + lu(k,563) = lu(k,563) * lu(k,556) + lu(k,1278) = - lu(k,557) * lu(k,1274) + lu(k,1281) = lu(k,1281) - lu(k,558) * lu(k,1274) + lu(k,1283) = lu(k,1283) - lu(k,559) * lu(k,1274) + lu(k,1284) = - lu(k,560) * lu(k,1274) + lu(k,1293) = - lu(k,561) * lu(k,1274) + lu(k,1295) = lu(k,1295) - lu(k,562) * lu(k,1274) + lu(k,1298) = lu(k,1298) - lu(k,563) * lu(k,1274) + lu(k,1650) = lu(k,1650) - lu(k,557) * lu(k,1618) + lu(k,1667) = lu(k,1667) - lu(k,558) * lu(k,1618) + lu(k,1671) = lu(k,1671) - lu(k,559) * lu(k,1618) + lu(k,1672) = lu(k,1672) - lu(k,560) * lu(k,1618) + lu(k,1687) = lu(k,1687) - lu(k,561) * lu(k,1618) + lu(k,1691) = lu(k,1691) - lu(k,562) * lu(k,1618) + lu(k,1694) = lu(k,1694) - lu(k,563) * lu(k,1618) + lu(k,1806) = - lu(k,557) * lu(k,1789) + lu(k,1818) = lu(k,1818) - lu(k,558) * lu(k,1789) + lu(k,1822) = lu(k,1822) - lu(k,559) * lu(k,1789) + lu(k,1823) = lu(k,1823) - lu(k,560) * lu(k,1789) + lu(k,1836) = lu(k,1836) - lu(k,561) * lu(k,1789) + lu(k,1840) = lu(k,1840) - lu(k,562) * lu(k,1789) + lu(k,1843) = lu(k,1843) - lu(k,563) * lu(k,1789) + lu(k,564) = 1._r8 / lu(k,564) + lu(k,565) = lu(k,565) * lu(k,564) + lu(k,566) = lu(k,566) * lu(k,564) + lu(k,567) = lu(k,567) * lu(k,564) + lu(k,568) = lu(k,568) * lu(k,564) + lu(k,569) = lu(k,569) * lu(k,564) + lu(k,570) = lu(k,570) * lu(k,564) + lu(k,571) = lu(k,571) * lu(k,564) + lu(k,1656) = lu(k,1656) - lu(k,565) * lu(k,1619) + lu(k,1666) = lu(k,1666) - lu(k,566) * lu(k,1619) + lu(k,1672) = lu(k,1672) - lu(k,567) * lu(k,1619) + lu(k,1689) = lu(k,1689) - lu(k,568) * lu(k,1619) + lu(k,1693) = lu(k,1693) - lu(k,569) * lu(k,1619) + lu(k,1694) = lu(k,1694) - lu(k,570) * lu(k,1619) + lu(k,1700) = lu(k,1700) - lu(k,571) * lu(k,1619) + lu(k,1714) = lu(k,1714) - lu(k,565) * lu(k,1710) + lu(k,1724) = lu(k,1724) - lu(k,566) * lu(k,1710) + lu(k,1730) = - lu(k,567) * lu(k,1710) + lu(k,1746) = lu(k,1746) - lu(k,568) * lu(k,1710) + lu(k,1750) = lu(k,1750) - lu(k,569) * lu(k,1710) + lu(k,1751) = lu(k,1751) - lu(k,570) * lu(k,1710) + lu(k,1757) = lu(k,1757) - lu(k,571) * lu(k,1710) + lu(k,1810) = lu(k,1810) - lu(k,565) * lu(k,1790) + lu(k,1817) = lu(k,1817) - lu(k,566) * lu(k,1790) + lu(k,1823) = lu(k,1823) - lu(k,567) * lu(k,1790) + lu(k,1838) = lu(k,1838) - lu(k,568) * lu(k,1790) + lu(k,1842) = lu(k,1842) - lu(k,569) * lu(k,1790) + lu(k,1843) = lu(k,1843) - lu(k,570) * lu(k,1790) + lu(k,1849) = lu(k,1849) - lu(k,571) * lu(k,1790) + lu(k,572) = 1._r8 / lu(k,572) + lu(k,573) = lu(k,573) * lu(k,572) + lu(k,574) = lu(k,574) * lu(k,572) + lu(k,575) = lu(k,575) * lu(k,572) + lu(k,576) = lu(k,576) * lu(k,572) + lu(k,577) = lu(k,577) * lu(k,572) + lu(k,578) = lu(k,578) * lu(k,572) + lu(k,579) = lu(k,579) * lu(k,572) + lu(k,580) = lu(k,580) * lu(k,572) + lu(k,1350) = lu(k,1350) - lu(k,573) * lu(k,1347) + lu(k,1352) = - lu(k,574) * lu(k,1347) + lu(k,1354) = lu(k,1354) - lu(k,575) * lu(k,1347) + lu(k,1357) = lu(k,1357) - lu(k,576) * lu(k,1347) + lu(k,1358) = lu(k,1358) - lu(k,577) * lu(k,1347) + lu(k,1359) = lu(k,1359) - lu(k,578) * lu(k,1347) + lu(k,1361) = lu(k,1361) - lu(k,579) * lu(k,1347) + lu(k,1364) = lu(k,1364) - lu(k,580) * lu(k,1347) + lu(k,1644) = lu(k,1644) - lu(k,573) * lu(k,1620) + lu(k,1671) = lu(k,1671) - lu(k,574) * lu(k,1620) + lu(k,1682) = lu(k,1682) - lu(k,575) * lu(k,1620) + lu(k,1689) = lu(k,1689) - lu(k,576) * lu(k,1620) + lu(k,1691) = lu(k,1691) - lu(k,577) * lu(k,1620) + lu(k,1692) = lu(k,1692) - lu(k,578) * lu(k,1620) + lu(k,1694) = lu(k,1694) - lu(k,579) * lu(k,1620) + lu(k,1700) = lu(k,1700) - lu(k,580) * lu(k,1620) + lu(k,2175) = lu(k,2175) - lu(k,573) * lu(k,2170) + lu(k,2181) = - lu(k,574) * lu(k,2170) + lu(k,2184) = lu(k,2184) - lu(k,575) * lu(k,2170) + lu(k,2190) = lu(k,2190) - lu(k,576) * lu(k,2170) + lu(k,2192) = lu(k,2192) - lu(k,577) * lu(k,2170) + lu(k,2193) = lu(k,2193) - lu(k,578) * lu(k,2170) + lu(k,2195) = lu(k,2195) - lu(k,579) * lu(k,2170) + lu(k,2201) = lu(k,2201) - lu(k,580) * lu(k,2170) end do end subroutine lu_fac12 subroutine lu_fac13( avec_len, lu ) @@ -1837,188 +1710,162 @@ subroutine lu_fac13( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,572) = 1._r8 / lu(k,572) - lu(k,573) = lu(k,573) * lu(k,572) - lu(k,574) = lu(k,574) * lu(k,572) - lu(k,575) = lu(k,575) * lu(k,572) - lu(k,576) = lu(k,576) * lu(k,572) - lu(k,577) = lu(k,577) * lu(k,572) - lu(k,578) = lu(k,578) * lu(k,572) - lu(k,839) = lu(k,839) - lu(k,573) * lu(k,835) - lu(k,840) = lu(k,840) - lu(k,574) * lu(k,835) - lu(k,841) = lu(k,841) - lu(k,575) * lu(k,835) - lu(k,842) = lu(k,842) - lu(k,576) * lu(k,835) - lu(k,843) = lu(k,843) - lu(k,577) * lu(k,835) - lu(k,846) = lu(k,846) - lu(k,578) * lu(k,835) - lu(k,1489) = lu(k,1489) - lu(k,573) * lu(k,1451) - lu(k,1501) = lu(k,1501) - lu(k,574) * lu(k,1451) - lu(k,1507) = lu(k,1507) - lu(k,575) * lu(k,1451) - lu(k,1508) = lu(k,1508) - lu(k,576) * lu(k,1451) - lu(k,1509) = lu(k,1509) - lu(k,577) * lu(k,1451) - lu(k,1513) = lu(k,1513) - lu(k,578) * lu(k,1451) - lu(k,1622) = lu(k,1622) - lu(k,573) * lu(k,1596) - lu(k,1632) = lu(k,1632) - lu(k,574) * lu(k,1596) - lu(k,1638) = lu(k,1638) - lu(k,575) * lu(k,1596) - lu(k,1639) = lu(k,1639) - lu(k,576) * lu(k,1596) - lu(k,1640) = lu(k,1640) - lu(k,577) * lu(k,1596) - lu(k,1644) = lu(k,1644) - lu(k,578) * lu(k,1596) - lu(k,1822) = lu(k,1822) - lu(k,573) * lu(k,1793) - lu(k,1833) = lu(k,1833) - lu(k,574) * lu(k,1793) - lu(k,1839) = lu(k,1839) - lu(k,575) * lu(k,1793) - lu(k,1840) = lu(k,1840) - lu(k,576) * lu(k,1793) - lu(k,1841) = lu(k,1841) - lu(k,577) * lu(k,1793) - lu(k,1845) = lu(k,1845) - lu(k,578) * lu(k,1793) - lu(k,580) = 1._r8 / lu(k,580) - lu(k,581) = lu(k,581) * lu(k,580) - lu(k,582) = lu(k,582) * lu(k,580) - lu(k,583) = lu(k,583) * lu(k,580) - lu(k,584) = lu(k,584) * lu(k,580) - lu(k,585) = lu(k,585) * lu(k,580) - lu(k,586) = lu(k,586) * lu(k,580) - lu(k,1071) = - lu(k,581) * lu(k,1065) - lu(k,1073) = - lu(k,582) * lu(k,1065) - lu(k,1075) = - lu(k,583) * lu(k,1065) - lu(k,1079) = lu(k,1079) - lu(k,584) * lu(k,1065) - lu(k,1083) = lu(k,1083) - lu(k,585) * lu(k,1065) - lu(k,1084) = lu(k,1084) - lu(k,586) * lu(k,1065) - lu(k,1139) = lu(k,1139) - lu(k,581) * lu(k,1128) - lu(k,1140) = - lu(k,582) * lu(k,1128) - lu(k,1143) = - lu(k,583) * lu(k,1128) - lu(k,1149) = lu(k,1149) - lu(k,584) * lu(k,1128) - lu(k,1153) = lu(k,1153) - lu(k,585) * lu(k,1128) - lu(k,1154) = lu(k,1154) - lu(k,586) * lu(k,1128) - lu(k,1209) = - lu(k,581) * lu(k,1201) - lu(k,1210) = lu(k,1210) - lu(k,582) * lu(k,1201) - lu(k,1212) = lu(k,1212) - lu(k,583) * lu(k,1201) - lu(k,1219) = lu(k,1219) - lu(k,584) * lu(k,1201) - lu(k,1223) = lu(k,1223) - lu(k,585) * lu(k,1201) - lu(k,1224) = lu(k,1224) - lu(k,586) * lu(k,1201) - lu(k,1491) = lu(k,1491) - lu(k,581) * lu(k,1452) - lu(k,1493) = lu(k,1493) - lu(k,582) * lu(k,1452) - lu(k,1497) = lu(k,1497) - lu(k,583) * lu(k,1452) - lu(k,1507) = lu(k,1507) - lu(k,584) * lu(k,1452) - lu(k,1512) = lu(k,1512) - lu(k,585) * lu(k,1452) - lu(k,1513) = lu(k,1513) - lu(k,586) * lu(k,1452) - lu(k,1824) = lu(k,1824) - lu(k,581) * lu(k,1794) - lu(k,1826) = - lu(k,582) * lu(k,1794) - lu(k,1829) = - lu(k,583) * lu(k,1794) - lu(k,1839) = lu(k,1839) - lu(k,584) * lu(k,1794) - lu(k,1844) = lu(k,1844) - lu(k,585) * lu(k,1794) - lu(k,1845) = lu(k,1845) - lu(k,586) * lu(k,1794) - 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,599) = lu(k,599) * lu(k,591) - lu(k,600) = lu(k,600) * lu(k,591) - lu(k,601) = lu(k,601) * lu(k,591) - lu(k,637) = lu(k,637) - lu(k,592) * lu(k,636) - lu(k,638) = lu(k,638) - lu(k,593) * lu(k,636) - lu(k,639) = lu(k,639) - lu(k,594) * lu(k,636) - lu(k,640) = lu(k,640) - lu(k,595) * lu(k,636) - lu(k,641) = lu(k,641) - lu(k,596) * lu(k,636) - lu(k,642) = lu(k,642) - lu(k,597) * lu(k,636) - lu(k,643) = lu(k,643) - lu(k,598) * lu(k,636) - lu(k,644) = lu(k,644) - lu(k,599) * lu(k,636) - lu(k,645) = - lu(k,600) * lu(k,636) - lu(k,648) = lu(k,648) - lu(k,601) * lu(k,636) - lu(k,1455) = lu(k,1455) - lu(k,592) * lu(k,1453) - lu(k,1457) = lu(k,1457) - lu(k,593) * lu(k,1453) - lu(k,1458) = lu(k,1458) - lu(k,594) * lu(k,1453) - lu(k,1470) = lu(k,1470) - lu(k,595) * lu(k,1453) - lu(k,1471) = lu(k,1471) - lu(k,596) * lu(k,1453) - lu(k,1483) = lu(k,1483) - lu(k,597) * lu(k,1453) - lu(k,1494) = lu(k,1494) - lu(k,598) * lu(k,1453) - lu(k,1501) = lu(k,1501) - lu(k,599) * lu(k,1453) - lu(k,1507) = lu(k,1507) - lu(k,600) * lu(k,1453) - lu(k,1513) = lu(k,1513) - lu(k,601) * lu(k,1453) - lu(k,1797) = lu(k,1797) - lu(k,592) * lu(k,1795) - lu(k,1799) = lu(k,1799) - lu(k,593) * lu(k,1795) - lu(k,1800) = lu(k,1800) - lu(k,594) * lu(k,1795) - lu(k,1809) = lu(k,1809) - lu(k,595) * lu(k,1795) - lu(k,1810) = lu(k,1810) - lu(k,596) * lu(k,1795) - lu(k,1816) = lu(k,1816) - lu(k,597) * lu(k,1795) - lu(k,1827) = lu(k,1827) - lu(k,598) * lu(k,1795) - lu(k,1833) = lu(k,1833) - lu(k,599) * lu(k,1795) - lu(k,1839) = lu(k,1839) - lu(k,600) * lu(k,1795) - lu(k,1845) = lu(k,1845) - lu(k,601) * lu(k,1795) - lu(k,604) = 1._r8 / lu(k,604) - lu(k,605) = lu(k,605) * lu(k,604) - lu(k,606) = lu(k,606) * lu(k,604) - lu(k,607) = lu(k,607) * lu(k,604) - lu(k,608) = lu(k,608) * lu(k,604) - lu(k,609) = lu(k,609) * lu(k,604) - lu(k,610) = lu(k,610) * lu(k,604) - lu(k,1480) = lu(k,1480) - lu(k,605) * lu(k,1454) - lu(k,1507) = lu(k,1507) - lu(k,606) * lu(k,1454) - lu(k,1508) = lu(k,1508) - lu(k,607) * lu(k,1454) - lu(k,1509) = lu(k,1509) - lu(k,608) * lu(k,1454) - lu(k,1512) = lu(k,1512) - lu(k,609) * lu(k,1454) - lu(k,1513) = lu(k,1513) - lu(k,610) * lu(k,1454) - lu(k,1613) = lu(k,1613) - lu(k,605) * lu(k,1597) - lu(k,1638) = lu(k,1638) - lu(k,606) * lu(k,1597) - lu(k,1639) = lu(k,1639) - lu(k,607) * lu(k,1597) - lu(k,1640) = lu(k,1640) - lu(k,608) * lu(k,1597) - lu(k,1643) = lu(k,1643) - lu(k,609) * lu(k,1597) - lu(k,1644) = lu(k,1644) - lu(k,610) * lu(k,1597) - lu(k,1814) = lu(k,1814) - lu(k,605) * lu(k,1796) - lu(k,1839) = lu(k,1839) - lu(k,606) * lu(k,1796) - lu(k,1840) = lu(k,1840) - lu(k,607) * lu(k,1796) - lu(k,1841) = lu(k,1841) - lu(k,608) * lu(k,1796) - lu(k,1844) = lu(k,1844) - lu(k,609) * lu(k,1796) - lu(k,1845) = lu(k,1845) - lu(k,610) * lu(k,1796) - lu(k,1916) = - lu(k,605) * lu(k,1910) - lu(k,1926) = lu(k,1926) - lu(k,606) * lu(k,1910) - lu(k,1927) = - lu(k,607) * lu(k,1910) - lu(k,1928) = - lu(k,608) * lu(k,1910) - lu(k,1931) = lu(k,1931) - lu(k,609) * lu(k,1910) - lu(k,1932) = lu(k,1932) - lu(k,610) * lu(k,1910) - lu(k,2019) = - lu(k,605) * lu(k,2008) - lu(k,2043) = lu(k,2043) - lu(k,606) * lu(k,2008) - lu(k,2044) = lu(k,2044) - lu(k,607) * lu(k,2008) - lu(k,2045) = lu(k,2045) - lu(k,608) * lu(k,2008) - lu(k,2048) = lu(k,2048) - lu(k,609) * lu(k,2008) - lu(k,2049) = lu(k,2049) - lu(k,610) * lu(k,2008) - lu(k,611) = 1._r8 / lu(k,611) - lu(k,612) = lu(k,612) * lu(k,611) - lu(k,613) = lu(k,613) * lu(k,611) - lu(k,614) = lu(k,614) * lu(k,611) - lu(k,615) = lu(k,615) * lu(k,611) - lu(k,616) = lu(k,616) * lu(k,611) - lu(k,624) = lu(k,624) - lu(k,612) * lu(k,621) - lu(k,626) = lu(k,626) - lu(k,613) * lu(k,621) - lu(k,629) = lu(k,629) - lu(k,614) * lu(k,621) - lu(k,630) = lu(k,630) - lu(k,615) * lu(k,621) - lu(k,631) = lu(k,631) - lu(k,616) * lu(k,621) - lu(k,640) = lu(k,640) - lu(k,612) * lu(k,637) - lu(k,642) = lu(k,642) - lu(k,613) * lu(k,637) - lu(k,646) = lu(k,646) - lu(k,614) * lu(k,637) - lu(k,647) = lu(k,647) - lu(k,615) * lu(k,637) - lu(k,648) = lu(k,648) - lu(k,616) * lu(k,637) - lu(k,1470) = lu(k,1470) - lu(k,612) * lu(k,1455) - lu(k,1483) = lu(k,1483) - lu(k,613) * lu(k,1455) - lu(k,1508) = lu(k,1508) - lu(k,614) * lu(k,1455) - lu(k,1509) = lu(k,1509) - lu(k,615) * lu(k,1455) - lu(k,1513) = lu(k,1513) - lu(k,616) * lu(k,1455) - lu(k,1534) = - lu(k,612) * lu(k,1530) - lu(k,1537) = - lu(k,613) * lu(k,1530) - lu(k,1549) = lu(k,1549) - lu(k,614) * lu(k,1530) - lu(k,1550) = lu(k,1550) - lu(k,615) * lu(k,1530) - lu(k,1554) = lu(k,1554) - lu(k,616) * lu(k,1530) - lu(k,1607) = lu(k,1607) - lu(k,612) * lu(k,1598) - lu(k,1616) = lu(k,1616) - lu(k,613) * lu(k,1598) - lu(k,1639) = lu(k,1639) - lu(k,614) * lu(k,1598) - lu(k,1640) = lu(k,1640) - lu(k,615) * lu(k,1598) - lu(k,1644) = lu(k,1644) - lu(k,616) * lu(k,1598) - lu(k,1809) = lu(k,1809) - lu(k,612) * lu(k,1797) - lu(k,1816) = lu(k,1816) - lu(k,613) * lu(k,1797) - lu(k,1840) = lu(k,1840) - lu(k,614) * lu(k,1797) - lu(k,1841) = lu(k,1841) - lu(k,615) * lu(k,1797) - lu(k,1845) = lu(k,1845) - lu(k,616) * lu(k,1797) + lu(k,581) = 1._r8 / lu(k,581) + lu(k,582) = lu(k,582) * lu(k,581) + lu(k,583) = lu(k,583) * lu(k,581) + lu(k,584) = lu(k,584) * lu(k,581) + lu(k,585) = lu(k,585) * lu(k,581) + lu(k,586) = lu(k,586) * lu(k,581) + lu(k,587) = lu(k,587) * lu(k,581) + lu(k,588) = lu(k,588) * lu(k,581) + lu(k,589) = lu(k,589) * lu(k,581) + lu(k,1249) = - lu(k,582) * lu(k,1245) + lu(k,1251) = - lu(k,583) * lu(k,1245) + lu(k,1252) = - lu(k,584) * lu(k,1245) + lu(k,1261) = - lu(k,585) * lu(k,1245) + lu(k,1262) = lu(k,1262) - lu(k,586) * lu(k,1245) + lu(k,1263) = - lu(k,587) * lu(k,1245) + lu(k,1266) = lu(k,1266) - lu(k,588) * lu(k,1245) + lu(k,1269) = lu(k,1269) - lu(k,589) * lu(k,1245) + lu(k,1667) = lu(k,1667) - lu(k,582) * lu(k,1621) + lu(k,1671) = lu(k,1671) - lu(k,583) * lu(k,1621) + lu(k,1672) = lu(k,1672) - lu(k,584) * lu(k,1621) + lu(k,1687) = lu(k,1687) - lu(k,585) * lu(k,1621) + lu(k,1689) = lu(k,1689) - lu(k,586) * lu(k,1621) + lu(k,1691) = lu(k,1691) - lu(k,587) * lu(k,1621) + lu(k,1694) = lu(k,1694) - lu(k,588) * lu(k,1621) + lu(k,1700) = lu(k,1700) - lu(k,589) * lu(k,1621) + lu(k,1818) = lu(k,1818) - lu(k,582) * lu(k,1791) + lu(k,1822) = lu(k,1822) - lu(k,583) * lu(k,1791) + lu(k,1823) = lu(k,1823) - lu(k,584) * lu(k,1791) + lu(k,1836) = lu(k,1836) - lu(k,585) * lu(k,1791) + lu(k,1838) = lu(k,1838) - lu(k,586) * lu(k,1791) + lu(k,1840) = lu(k,1840) - lu(k,587) * lu(k,1791) + lu(k,1843) = lu(k,1843) - lu(k,588) * lu(k,1791) + lu(k,1849) = lu(k,1849) - lu(k,589) * lu(k,1791) + lu(k,590) = 1._r8 / lu(k,590) + lu(k,591) = lu(k,591) * lu(k,590) + lu(k,592) = lu(k,592) * lu(k,590) + lu(k,593) = lu(k,593) * lu(k,590) + lu(k,659) = - lu(k,591) * lu(k,654) + lu(k,661) = - lu(k,592) * lu(k,654) + lu(k,664) = lu(k,664) - lu(k,593) * lu(k,654) + lu(k,705) = - lu(k,591) * lu(k,700) + lu(k,707) = lu(k,707) - lu(k,592) * lu(k,700) + lu(k,711) = lu(k,711) - lu(k,593) * lu(k,700) + lu(k,734) = - lu(k,591) * lu(k,729) + lu(k,736) = - lu(k,592) * lu(k,729) + lu(k,740) = lu(k,740) - lu(k,593) * lu(k,729) + lu(k,750) = - lu(k,591) * lu(k,745) + lu(k,752) = lu(k,752) - lu(k,592) * lu(k,745) + lu(k,757) = lu(k,757) - lu(k,593) * lu(k,745) + lu(k,1071) = - lu(k,591) * lu(k,1069) + lu(k,1074) = - lu(k,592) * lu(k,1069) + lu(k,1081) = lu(k,1081) - lu(k,593) * lu(k,1069) + lu(k,1279) = - lu(k,591) * lu(k,1275) + lu(k,1282) = - lu(k,592) * lu(k,1275) + lu(k,1298) = lu(k,1298) - lu(k,593) * lu(k,1275) + lu(k,1652) = - lu(k,591) * lu(k,1622) + lu(k,1668) = lu(k,1668) - lu(k,592) * lu(k,1622) + lu(k,1694) = lu(k,1694) - lu(k,593) * lu(k,1622) + lu(k,1807) = lu(k,1807) - lu(k,591) * lu(k,1792) + lu(k,1819) = lu(k,1819) - lu(k,592) * lu(k,1792) + lu(k,1843) = lu(k,1843) - lu(k,593) * lu(k,1792) + lu(k,594) = 1._r8 / lu(k,594) + lu(k,595) = lu(k,595) * lu(k,594) + lu(k,596) = lu(k,596) * lu(k,594) + lu(k,597) = lu(k,597) * lu(k,594) + lu(k,598) = lu(k,598) * lu(k,594) + lu(k,599) = lu(k,599) * lu(k,594) + lu(k,600) = lu(k,600) * lu(k,594) + lu(k,601) = lu(k,601) * lu(k,594) + lu(k,602) = lu(k,602) * lu(k,594) + lu(k,1521) = lu(k,1521) - lu(k,595) * lu(k,1517) + lu(k,1526) = lu(k,1526) - lu(k,596) * lu(k,1517) + lu(k,1527) = lu(k,1527) - lu(k,597) * lu(k,1517) + lu(k,1530) = lu(k,1530) - lu(k,598) * lu(k,1517) + lu(k,1532) = lu(k,1532) - lu(k,599) * lu(k,1517) + lu(k,1533) = lu(k,1533) - lu(k,600) * lu(k,1517) + lu(k,1535) = lu(k,1535) - lu(k,601) * lu(k,1517) + lu(k,1539) = lu(k,1539) - lu(k,602) * lu(k,1517) + lu(k,1685) = lu(k,1685) - lu(k,595) * lu(k,1623) + lu(k,1690) = lu(k,1690) - lu(k,596) * lu(k,1623) + lu(k,1691) = lu(k,1691) - lu(k,597) * lu(k,1623) + lu(k,1694) = lu(k,1694) - lu(k,598) * lu(k,1623) + lu(k,1696) = lu(k,1696) - lu(k,599) * lu(k,1623) + lu(k,1697) = lu(k,1697) - lu(k,600) * lu(k,1623) + lu(k,1699) = lu(k,1699) - lu(k,601) * lu(k,1623) + lu(k,1703) = lu(k,1703) - lu(k,602) * lu(k,1623) + lu(k,2006) = lu(k,2006) - lu(k,595) * lu(k,1993) + lu(k,2011) = lu(k,2011) - lu(k,596) * lu(k,1993) + lu(k,2012) = lu(k,2012) - lu(k,597) * lu(k,1993) + lu(k,2015) = lu(k,2015) - lu(k,598) * lu(k,1993) + lu(k,2017) = lu(k,2017) - lu(k,599) * lu(k,1993) + lu(k,2018) = lu(k,2018) - lu(k,600) * lu(k,1993) + lu(k,2020) = lu(k,2020) - lu(k,601) * lu(k,1993) + lu(k,2024) = lu(k,2024) - lu(k,602) * lu(k,1993) + lu(k,603) = 1._r8 / lu(k,603) + lu(k,604) = lu(k,604) * lu(k,603) + lu(k,605) = lu(k,605) * lu(k,603) + lu(k,606) = lu(k,606) * lu(k,603) + lu(k,607) = lu(k,607) * lu(k,603) + lu(k,608) = lu(k,608) * lu(k,603) + lu(k,609) = lu(k,609) * lu(k,603) + lu(k,1691) = lu(k,1691) - lu(k,604) * lu(k,1624) + lu(k,1694) = lu(k,1694) - lu(k,605) * lu(k,1624) + lu(k,1696) = lu(k,1696) - lu(k,606) * lu(k,1624) + lu(k,1699) = lu(k,1699) - lu(k,607) * lu(k,1624) + lu(k,1702) = lu(k,1702) - lu(k,608) * lu(k,1624) + lu(k,1703) = lu(k,1703) - lu(k,609) * lu(k,1624) + lu(k,1947) = lu(k,1947) - lu(k,604) * lu(k,1892) + lu(k,1950) = lu(k,1950) - lu(k,605) * lu(k,1892) + lu(k,1952) = lu(k,1952) - lu(k,606) * lu(k,1892) + lu(k,1955) = lu(k,1955) - lu(k,607) * lu(k,1892) + lu(k,1958) = lu(k,1958) - lu(k,608) * lu(k,1892) + lu(k,1959) = lu(k,1959) - lu(k,609) * lu(k,1892) + lu(k,2012) = lu(k,2012) - lu(k,604) * lu(k,1994) + lu(k,2015) = lu(k,2015) - lu(k,605) * lu(k,1994) + lu(k,2017) = lu(k,2017) - lu(k,606) * lu(k,1994) + lu(k,2020) = lu(k,2020) - lu(k,607) * lu(k,1994) + lu(k,2023) = - lu(k,608) * lu(k,1994) + lu(k,2024) = lu(k,2024) - lu(k,609) * lu(k,1994) + lu(k,2247) = lu(k,2247) - lu(k,604) * lu(k,2232) + lu(k,2250) = lu(k,2250) - lu(k,605) * lu(k,2232) + lu(k,2252) = lu(k,2252) - lu(k,606) * lu(k,2232) + lu(k,2255) = lu(k,2255) - lu(k,607) * lu(k,2232) + lu(k,2258) = lu(k,2258) - lu(k,608) * lu(k,2232) + lu(k,2259) = - lu(k,609) * lu(k,2232) + lu(k,610) = 1._r8 / lu(k,610) + lu(k,611) = lu(k,611) * lu(k,610) + lu(k,612) = lu(k,612) * lu(k,610) + lu(k,613) = lu(k,613) * lu(k,610) + lu(k,614) = lu(k,614) * lu(k,610) + lu(k,615) = lu(k,615) * lu(k,610) + lu(k,616) = lu(k,616) * lu(k,610) + lu(k,1350) = lu(k,1350) - lu(k,611) * lu(k,1348) + lu(k,1355) = lu(k,1355) - lu(k,612) * lu(k,1348) + lu(k,1357) = lu(k,1357) - lu(k,613) * lu(k,1348) + lu(k,1358) = lu(k,1358) - lu(k,614) * lu(k,1348) + lu(k,1362) = lu(k,1362) - lu(k,615) * lu(k,1348) + lu(k,1366) = - lu(k,616) * lu(k,1348) + lu(k,1371) = lu(k,1371) - lu(k,611) * lu(k,1369) + lu(k,1386) = lu(k,1386) - lu(k,612) * lu(k,1369) + lu(k,1389) = lu(k,1389) - lu(k,613) * lu(k,1369) + lu(k,1390) = lu(k,1390) - lu(k,614) * lu(k,1369) + lu(k,1394) = lu(k,1394) - lu(k,615) * lu(k,1369) + lu(k,1398) = - lu(k,616) * lu(k,1369) + lu(k,1644) = lu(k,1644) - lu(k,611) * lu(k,1625) + lu(k,1683) = lu(k,1683) - lu(k,612) * lu(k,1625) + lu(k,1689) = lu(k,1689) - lu(k,613) * lu(k,1625) + lu(k,1691) = lu(k,1691) - lu(k,614) * lu(k,1625) + lu(k,1697) = lu(k,1697) - lu(k,615) * lu(k,1625) + lu(k,1703) = lu(k,1703) - lu(k,616) * lu(k,1625) + lu(k,1910) = lu(k,1910) - lu(k,611) * lu(k,1893) + lu(k,1939) = lu(k,1939) - lu(k,612) * lu(k,1893) + lu(k,1945) = lu(k,1945) - lu(k,613) * lu(k,1893) + lu(k,1947) = lu(k,1947) - lu(k,614) * lu(k,1893) + lu(k,1953) = lu(k,1953) - lu(k,615) * lu(k,1893) + lu(k,1959) = lu(k,1959) - lu(k,616) * lu(k,1893) end do end subroutine lu_fac13 subroutine lu_fac14( avec_len, lu ) @@ -2035,204 +1882,216 @@ subroutine lu_fac14( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,622) = 1._r8 / lu(k,622) - lu(k,623) = lu(k,623) * lu(k,622) - lu(k,624) = lu(k,624) * lu(k,622) - lu(k,625) = lu(k,625) * lu(k,622) - lu(k,626) = lu(k,626) * lu(k,622) - lu(k,627) = lu(k,627) * lu(k,622) - lu(k,628) = lu(k,628) * lu(k,622) - lu(k,629) = lu(k,629) * lu(k,622) - lu(k,630) = lu(k,630) * lu(k,622) - lu(k,631) = lu(k,631) * lu(k,622) - lu(k,1458) = lu(k,1458) - lu(k,623) * lu(k,1456) - lu(k,1470) = lu(k,1470) - lu(k,624) * lu(k,1456) - lu(k,1471) = lu(k,1471) - lu(k,625) * lu(k,1456) - lu(k,1483) = lu(k,1483) - lu(k,626) * lu(k,1456) - lu(k,1494) = lu(k,1494) - lu(k,627) * lu(k,1456) - lu(k,1507) = lu(k,1507) - lu(k,628) * lu(k,1456) - lu(k,1508) = lu(k,1508) - lu(k,629) * lu(k,1456) - lu(k,1509) = lu(k,1509) - lu(k,630) * lu(k,1456) - lu(k,1513) = lu(k,1513) - lu(k,631) * lu(k,1456) - lu(k,1601) = lu(k,1601) - lu(k,623) * lu(k,1599) - lu(k,1607) = lu(k,1607) - lu(k,624) * lu(k,1599) - lu(k,1608) = lu(k,1608) - lu(k,625) * lu(k,1599) - lu(k,1616) = lu(k,1616) - lu(k,626) * lu(k,1599) - lu(k,1626) = lu(k,1626) - lu(k,627) * lu(k,1599) - lu(k,1638) = lu(k,1638) - lu(k,628) * lu(k,1599) - lu(k,1639) = lu(k,1639) - lu(k,629) * lu(k,1599) - lu(k,1640) = lu(k,1640) - lu(k,630) * lu(k,1599) - lu(k,1644) = lu(k,1644) - lu(k,631) * lu(k,1599) - lu(k,1800) = lu(k,1800) - lu(k,623) * lu(k,1798) - lu(k,1809) = lu(k,1809) - lu(k,624) * lu(k,1798) - lu(k,1810) = lu(k,1810) - lu(k,625) * lu(k,1798) - lu(k,1816) = lu(k,1816) - lu(k,626) * lu(k,1798) - lu(k,1827) = lu(k,1827) - lu(k,627) * lu(k,1798) - lu(k,1839) = lu(k,1839) - lu(k,628) * lu(k,1798) - lu(k,1840) = lu(k,1840) - lu(k,629) * lu(k,1798) - lu(k,1841) = lu(k,1841) - lu(k,630) * lu(k,1798) - lu(k,1845) = lu(k,1845) - lu(k,631) * lu(k,1798) - lu(k,638) = 1._r8 / lu(k,638) - lu(k,639) = lu(k,639) * lu(k,638) - lu(k,640) = lu(k,640) * lu(k,638) - lu(k,641) = lu(k,641) * lu(k,638) - lu(k,642) = lu(k,642) * lu(k,638) - lu(k,643) = lu(k,643) * lu(k,638) - lu(k,644) = lu(k,644) * lu(k,638) - lu(k,645) = lu(k,645) * lu(k,638) - lu(k,646) = lu(k,646) * lu(k,638) - lu(k,647) = lu(k,647) * lu(k,638) - lu(k,648) = lu(k,648) * lu(k,638) - lu(k,1458) = lu(k,1458) - lu(k,639) * lu(k,1457) - lu(k,1470) = lu(k,1470) - lu(k,640) * lu(k,1457) - lu(k,1471) = lu(k,1471) - lu(k,641) * lu(k,1457) - lu(k,1483) = lu(k,1483) - lu(k,642) * lu(k,1457) - lu(k,1494) = lu(k,1494) - lu(k,643) * lu(k,1457) - lu(k,1501) = lu(k,1501) - lu(k,644) * lu(k,1457) - lu(k,1507) = lu(k,1507) - lu(k,645) * lu(k,1457) - lu(k,1508) = lu(k,1508) - lu(k,646) * lu(k,1457) - lu(k,1509) = lu(k,1509) - lu(k,647) * lu(k,1457) - lu(k,1513) = lu(k,1513) - lu(k,648) * lu(k,1457) - lu(k,1601) = lu(k,1601) - lu(k,639) * lu(k,1600) - lu(k,1607) = lu(k,1607) - lu(k,640) * lu(k,1600) - lu(k,1608) = lu(k,1608) - lu(k,641) * lu(k,1600) - lu(k,1616) = lu(k,1616) - lu(k,642) * lu(k,1600) - lu(k,1626) = lu(k,1626) - lu(k,643) * lu(k,1600) - lu(k,1632) = lu(k,1632) - lu(k,644) * lu(k,1600) - lu(k,1638) = lu(k,1638) - lu(k,645) * lu(k,1600) - lu(k,1639) = lu(k,1639) - lu(k,646) * lu(k,1600) - lu(k,1640) = lu(k,1640) - lu(k,647) * lu(k,1600) - lu(k,1644) = lu(k,1644) - lu(k,648) * lu(k,1600) - lu(k,1800) = lu(k,1800) - lu(k,639) * lu(k,1799) - lu(k,1809) = lu(k,1809) - lu(k,640) * lu(k,1799) - lu(k,1810) = lu(k,1810) - lu(k,641) * lu(k,1799) - lu(k,1816) = lu(k,1816) - lu(k,642) * lu(k,1799) - lu(k,1827) = lu(k,1827) - lu(k,643) * lu(k,1799) - lu(k,1833) = lu(k,1833) - lu(k,644) * lu(k,1799) - lu(k,1839) = lu(k,1839) - lu(k,645) * lu(k,1799) - lu(k,1840) = lu(k,1840) - lu(k,646) * lu(k,1799) - lu(k,1841) = lu(k,1841) - lu(k,647) * lu(k,1799) - lu(k,1845) = lu(k,1845) - lu(k,648) * lu(k,1799) - 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,1483) = lu(k,1483) - lu(k,650) * lu(k,1458) - lu(k,1494) = lu(k,1494) - lu(k,651) * lu(k,1458) - lu(k,1507) = lu(k,1507) - lu(k,652) * lu(k,1458) - lu(k,1508) = lu(k,1508) - lu(k,653) * lu(k,1458) - lu(k,1509) = lu(k,1509) - lu(k,654) * lu(k,1458) - lu(k,1510) = lu(k,1510) - lu(k,655) * lu(k,1458) - lu(k,1513) = lu(k,1513) - lu(k,656) * lu(k,1458) - lu(k,1537) = lu(k,1537) - lu(k,650) * lu(k,1531) - lu(k,1539) = - lu(k,651) * lu(k,1531) - lu(k,1548) = lu(k,1548) - lu(k,652) * lu(k,1531) - lu(k,1549) = lu(k,1549) - lu(k,653) * lu(k,1531) - lu(k,1550) = lu(k,1550) - lu(k,654) * lu(k,1531) - lu(k,1551) = lu(k,1551) - lu(k,655) * lu(k,1531) - lu(k,1554) = lu(k,1554) - lu(k,656) * lu(k,1531) - lu(k,1616) = lu(k,1616) - lu(k,650) * lu(k,1601) - lu(k,1626) = lu(k,1626) - lu(k,651) * lu(k,1601) - lu(k,1638) = lu(k,1638) - lu(k,652) * lu(k,1601) - lu(k,1639) = lu(k,1639) - lu(k,653) * lu(k,1601) - lu(k,1640) = lu(k,1640) - lu(k,654) * lu(k,1601) - lu(k,1641) = lu(k,1641) - lu(k,655) * lu(k,1601) - lu(k,1644) = lu(k,1644) - lu(k,656) * lu(k,1601) - lu(k,1816) = lu(k,1816) - lu(k,650) * lu(k,1800) - lu(k,1827) = lu(k,1827) - lu(k,651) * lu(k,1800) - lu(k,1839) = lu(k,1839) - lu(k,652) * lu(k,1800) - lu(k,1840) = lu(k,1840) - lu(k,653) * lu(k,1800) - lu(k,1841) = lu(k,1841) - lu(k,654) * lu(k,1800) - lu(k,1842) = lu(k,1842) - lu(k,655) * lu(k,1800) - lu(k,1845) = lu(k,1845) - lu(k,656) * lu(k,1800) - lu(k,658) = 1._r8 / lu(k,658) - lu(k,659) = lu(k,659) * lu(k,658) - lu(k,660) = lu(k,660) * lu(k,658) - lu(k,661) = lu(k,661) * lu(k,658) - lu(k,662) = lu(k,662) * lu(k,658) - lu(k,663) = lu(k,663) * lu(k,658) - lu(k,664) = lu(k,664) * lu(k,658) - lu(k,665) = lu(k,665) * lu(k,658) - lu(k,666) = lu(k,666) * lu(k,658) - lu(k,871) = - lu(k,659) * lu(k,866) - lu(k,872) = lu(k,872) - lu(k,660) * lu(k,866) - lu(k,875) = lu(k,875) - lu(k,661) * lu(k,866) - lu(k,876) = - lu(k,662) * lu(k,866) - lu(k,877) = - lu(k,663) * lu(k,866) - lu(k,879) = lu(k,879) - lu(k,664) * lu(k,866) - lu(k,880) = lu(k,880) - lu(k,665) * lu(k,866) - lu(k,883) = lu(k,883) - lu(k,666) * lu(k,866) - lu(k,1484) = lu(k,1484) - lu(k,659) * lu(k,1459) - lu(k,1489) = lu(k,1489) - lu(k,660) * lu(k,1459) - lu(k,1507) = lu(k,1507) - lu(k,661) * lu(k,1459) - lu(k,1508) = lu(k,1508) - lu(k,662) * lu(k,1459) - lu(k,1509) = lu(k,1509) - lu(k,663) * lu(k,1459) - lu(k,1512) = lu(k,1512) - lu(k,664) * lu(k,1459) - lu(k,1513) = lu(k,1513) - lu(k,665) * lu(k,1459) - lu(k,1519) = lu(k,1519) - lu(k,666) * lu(k,1459) - lu(k,1617) = lu(k,1617) - lu(k,659) * lu(k,1602) - lu(k,1622) = lu(k,1622) - lu(k,660) * lu(k,1602) - lu(k,1638) = lu(k,1638) - lu(k,661) * lu(k,1602) - lu(k,1639) = lu(k,1639) - lu(k,662) * lu(k,1602) - lu(k,1640) = lu(k,1640) - lu(k,663) * lu(k,1602) - lu(k,1643) = lu(k,1643) - lu(k,664) * lu(k,1602) - lu(k,1644) = lu(k,1644) - lu(k,665) * lu(k,1602) - lu(k,1650) = - lu(k,666) * lu(k,1602) - lu(k,1817) = lu(k,1817) - lu(k,659) * lu(k,1801) - lu(k,1822) = lu(k,1822) - lu(k,660) * lu(k,1801) - lu(k,1839) = lu(k,1839) - lu(k,661) * lu(k,1801) - lu(k,1840) = lu(k,1840) - lu(k,662) * lu(k,1801) - lu(k,1841) = lu(k,1841) - lu(k,663) * lu(k,1801) - lu(k,1844) = lu(k,1844) - lu(k,664) * lu(k,1801) - lu(k,1845) = lu(k,1845) - lu(k,665) * lu(k,1801) - lu(k,1851) = lu(k,1851) - lu(k,666) * lu(k,1801) - 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,1543) = lu(k,1543) - lu(k,669) * lu(k,1532) - lu(k,1548) = lu(k,1548) - lu(k,670) * lu(k,1532) - lu(k,1552) = lu(k,1552) - lu(k,671) * lu(k,1532) - lu(k,1555) = lu(k,1555) - lu(k,672) * lu(k,1532) - lu(k,1556) = - lu(k,673) * lu(k,1532) - lu(k,1557) = - lu(k,674) * lu(k,1532) - lu(k,1560) = lu(k,1560) - lu(k,675) * lu(k,1532) - lu(k,1707) = lu(k,1707) - lu(k,669) * lu(k,1704) - lu(k,1712) = lu(k,1712) - lu(k,670) * lu(k,1704) - lu(k,1716) = lu(k,1716) - lu(k,671) * lu(k,1704) - lu(k,1719) = lu(k,1719) - lu(k,672) * lu(k,1704) - lu(k,1720) = - lu(k,673) * lu(k,1704) - lu(k,1721) = lu(k,1721) - lu(k,674) * lu(k,1704) - lu(k,1724) = - lu(k,675) * lu(k,1704) - lu(k,1834) = lu(k,1834) - lu(k,669) * lu(k,1802) - lu(k,1839) = lu(k,1839) - lu(k,670) * lu(k,1802) - lu(k,1843) = lu(k,1843) - lu(k,671) * lu(k,1802) - lu(k,1846) = lu(k,1846) - lu(k,672) * lu(k,1802) - lu(k,1847) = lu(k,1847) - lu(k,673) * lu(k,1802) - lu(k,1848) = lu(k,1848) - lu(k,674) * lu(k,1802) - lu(k,1851) = lu(k,1851) - lu(k,675) * lu(k,1802) - lu(k,1864) = lu(k,1864) - lu(k,669) * lu(k,1856) - lu(k,1869) = lu(k,1869) - lu(k,670) * lu(k,1856) - lu(k,1873) = lu(k,1873) - lu(k,671) * lu(k,1856) - lu(k,1876) = lu(k,1876) - lu(k,672) * lu(k,1856) - lu(k,1877) = lu(k,1877) - lu(k,673) * lu(k,1856) - lu(k,1878) = lu(k,1878) - lu(k,674) * lu(k,1856) - lu(k,1881) = lu(k,1881) - lu(k,675) * lu(k,1856) - lu(k,1887) = lu(k,1887) - lu(k,669) * lu(k,1884) - lu(k,1892) = lu(k,1892) - lu(k,670) * lu(k,1884) - lu(k,1896) = - lu(k,671) * lu(k,1884) - lu(k,1899) = lu(k,1899) - lu(k,672) * lu(k,1884) - lu(k,1900) = lu(k,1900) - lu(k,673) * lu(k,1884) - lu(k,1901) = lu(k,1901) - lu(k,674) * lu(k,1884) - lu(k,1904) = lu(k,1904) - lu(k,675) * lu(k,1884) + lu(k,617) = 1._r8 / lu(k,617) + lu(k,618) = lu(k,618) * lu(k,617) + lu(k,619) = lu(k,619) * lu(k,617) + lu(k,620) = lu(k,620) * lu(k,617) + lu(k,621) = lu(k,621) * lu(k,617) + lu(k,622) = lu(k,622) * lu(k,617) + lu(k,914) = lu(k,914) - lu(k,618) * lu(k,910) + lu(k,915) = - lu(k,619) * lu(k,910) + lu(k,917) = lu(k,917) - lu(k,620) * lu(k,910) + lu(k,919) = lu(k,919) - lu(k,621) * lu(k,910) + lu(k,921) = lu(k,921) - lu(k,622) * lu(k,910) + lu(k,1044) = lu(k,1044) - lu(k,618) * lu(k,1042) + lu(k,1049) = lu(k,1049) - lu(k,619) * lu(k,1042) + lu(k,1051) = lu(k,1051) - lu(k,620) * lu(k,1042) + lu(k,1054) = lu(k,1054) - lu(k,621) * lu(k,1042) + lu(k,1056) = lu(k,1056) - lu(k,622) * lu(k,1042) + lu(k,1659) = lu(k,1659) - lu(k,618) * lu(k,1626) + lu(k,1687) = lu(k,1687) - lu(k,619) * lu(k,1626) + lu(k,1691) = lu(k,1691) - lu(k,620) * lu(k,1626) + lu(k,1694) = lu(k,1694) - lu(k,621) * lu(k,1626) + lu(k,1700) = lu(k,1700) - lu(k,622) * lu(k,1626) + lu(k,1812) = lu(k,1812) - lu(k,618) * lu(k,1793) + lu(k,1836) = lu(k,1836) - lu(k,619) * lu(k,1793) + lu(k,1840) = lu(k,1840) - lu(k,620) * lu(k,1793) + lu(k,1843) = lu(k,1843) - lu(k,621) * lu(k,1793) + lu(k,1849) = lu(k,1849) - lu(k,622) * lu(k,1793) + lu(k,2038) = lu(k,2038) - lu(k,618) * lu(k,2029) + lu(k,2060) = lu(k,2060) - lu(k,619) * lu(k,2029) + lu(k,2064) = lu(k,2064) - lu(k,620) * lu(k,2029) + lu(k,2067) = lu(k,2067) - lu(k,621) * lu(k,2029) + lu(k,2073) = lu(k,2073) - lu(k,622) * lu(k,2029) + lu(k,625) = 1._r8 / lu(k,625) + lu(k,626) = lu(k,626) * lu(k,625) + lu(k,627) = lu(k,627) * lu(k,625) + lu(k,628) = lu(k,628) * lu(k,625) + lu(k,629) = lu(k,629) * lu(k,625) + lu(k,630) = lu(k,630) * lu(k,625) + lu(k,1691) = lu(k,1691) - lu(k,626) * lu(k,1627) + lu(k,1693) = lu(k,1693) - lu(k,627) * lu(k,1627) + lu(k,1694) = lu(k,1694) - lu(k,628) * lu(k,1627) + lu(k,1698) = lu(k,1698) - lu(k,629) * lu(k,1627) + lu(k,1700) = lu(k,1700) - lu(k,630) * lu(k,1627) + lu(k,1840) = lu(k,1840) - lu(k,626) * lu(k,1794) + lu(k,1842) = lu(k,1842) - lu(k,627) * lu(k,1794) + lu(k,1843) = lu(k,1843) - lu(k,628) * lu(k,1794) + lu(k,1847) = lu(k,1847) - lu(k,629) * lu(k,1794) + lu(k,1849) = lu(k,1849) - lu(k,630) * lu(k,1794) + lu(k,1947) = lu(k,1947) - lu(k,626) * lu(k,1894) + lu(k,1949) = lu(k,1949) - lu(k,627) * lu(k,1894) + lu(k,1950) = lu(k,1950) - lu(k,628) * lu(k,1894) + lu(k,1954) = lu(k,1954) - lu(k,629) * lu(k,1894) + lu(k,1956) = lu(k,1956) - lu(k,630) * lu(k,1894) + lu(k,2125) = lu(k,2125) - lu(k,626) * lu(k,2087) + lu(k,2127) = lu(k,2127) - lu(k,627) * lu(k,2087) + lu(k,2128) = lu(k,2128) - lu(k,628) * lu(k,2087) + lu(k,2132) = lu(k,2132) - lu(k,629) * lu(k,2087) + lu(k,2134) = lu(k,2134) - lu(k,630) * lu(k,2087) + lu(k,2192) = lu(k,2192) - lu(k,626) * lu(k,2171) + lu(k,2194) = lu(k,2194) - lu(k,627) * lu(k,2171) + lu(k,2195) = lu(k,2195) - lu(k,628) * lu(k,2171) + lu(k,2199) = lu(k,2199) - lu(k,629) * lu(k,2171) + lu(k,2201) = lu(k,2201) - lu(k,630) * lu(k,2171) + lu(k,632) = 1._r8 / lu(k,632) + lu(k,633) = lu(k,633) * lu(k,632) + lu(k,634) = lu(k,634) * lu(k,632) + lu(k,635) = lu(k,635) * lu(k,632) + lu(k,636) = lu(k,636) * lu(k,632) + lu(k,637) = lu(k,637) * lu(k,632) + lu(k,638) = lu(k,638) * lu(k,632) + lu(k,639) = lu(k,639) * lu(k,632) + lu(k,640) = lu(k,640) * lu(k,632) + lu(k,641) = lu(k,641) * lu(k,632) + lu(k,897) = lu(k,897) - lu(k,633) * lu(k,895) + lu(k,898) = lu(k,898) - lu(k,634) * lu(k,895) + lu(k,899) = lu(k,899) - lu(k,635) * lu(k,895) + lu(k,900) = lu(k,900) - lu(k,636) * lu(k,895) + lu(k,901) = lu(k,901) - lu(k,637) * lu(k,895) + lu(k,902) = lu(k,902) - lu(k,638) * lu(k,895) + lu(k,903) = lu(k,903) - lu(k,639) * lu(k,895) + lu(k,904) = lu(k,904) - lu(k,640) * lu(k,895) + lu(k,906) = lu(k,906) - lu(k,641) * lu(k,895) + lu(k,1632) = lu(k,1632) - lu(k,633) * lu(k,1628) + lu(k,1646) = lu(k,1646) - lu(k,634) * lu(k,1628) + lu(k,1654) = lu(k,1654) - lu(k,635) * lu(k,1628) + lu(k,1656) = lu(k,1656) - lu(k,636) * lu(k,1628) + lu(k,1666) = lu(k,1666) - lu(k,637) * lu(k,1628) + lu(k,1683) = lu(k,1683) - lu(k,638) * lu(k,1628) + lu(k,1689) = lu(k,1689) - lu(k,639) * lu(k,1628) + lu(k,1691) = lu(k,1691) - lu(k,640) * lu(k,1628) + lu(k,1694) = lu(k,1694) - lu(k,641) * lu(k,1628) + lu(k,1898) = lu(k,1898) - lu(k,633) * lu(k,1895) + lu(k,1912) = lu(k,1912) - lu(k,634) * lu(k,1895) + lu(k,1916) = lu(k,1916) - lu(k,635) * lu(k,1895) + lu(k,1918) = lu(k,1918) - lu(k,636) * lu(k,1895) + lu(k,1924) = lu(k,1924) - lu(k,637) * lu(k,1895) + lu(k,1939) = lu(k,1939) - lu(k,638) * lu(k,1895) + lu(k,1945) = lu(k,1945) - lu(k,639) * lu(k,1895) + lu(k,1947) = lu(k,1947) - lu(k,640) * lu(k,1895) + lu(k,1950) = lu(k,1950) - lu(k,641) * lu(k,1895) + lu(k,642) = 1._r8 / lu(k,642) + lu(k,643) = lu(k,643) * lu(k,642) + lu(k,644) = lu(k,644) * lu(k,642) + lu(k,645) = lu(k,645) * lu(k,642) + lu(k,646) = lu(k,646) * lu(k,642) + lu(k,647) = lu(k,647) * lu(k,642) + lu(k,648) = lu(k,648) * lu(k,642) + lu(k,649) = lu(k,649) * lu(k,642) + lu(k,650) = lu(k,650) * lu(k,642) + lu(k,651) = lu(k,651) * lu(k,642) + lu(k,1110) = lu(k,1110) - lu(k,643) * lu(k,1108) + lu(k,1111) = lu(k,1111) - lu(k,644) * lu(k,1108) + lu(k,1112) = lu(k,1112) - lu(k,645) * lu(k,1108) + lu(k,1113) = lu(k,1113) - lu(k,646) * lu(k,1108) + lu(k,1114) = lu(k,1114) - lu(k,647) * lu(k,1108) + lu(k,1115) = lu(k,1115) - lu(k,648) * lu(k,1108) + lu(k,1119) = lu(k,1119) - lu(k,649) * lu(k,1108) + lu(k,1120) = - lu(k,650) * lu(k,1108) + lu(k,1122) = lu(k,1122) - lu(k,651) * lu(k,1108) + lu(k,1644) = lu(k,1644) - lu(k,643) * lu(k,1629) + lu(k,1656) = lu(k,1656) - lu(k,644) * lu(k,1629) + lu(k,1664) = lu(k,1664) - lu(k,645) * lu(k,1629) + lu(k,1667) = lu(k,1667) - lu(k,646) * lu(k,1629) + lu(k,1668) = lu(k,1668) - lu(k,647) * lu(k,1629) + lu(k,1669) = lu(k,1669) - lu(k,648) * lu(k,1629) + lu(k,1689) = lu(k,1689) - lu(k,649) * lu(k,1629) + lu(k,1691) = lu(k,1691) - lu(k,650) * lu(k,1629) + lu(k,1694) = lu(k,1694) - lu(k,651) * lu(k,1629) + lu(k,1910) = lu(k,1910) - lu(k,643) * lu(k,1896) + lu(k,1918) = lu(k,1918) - lu(k,644) * lu(k,1896) + lu(k,1923) = - lu(k,645) * lu(k,1896) + lu(k,1925) = lu(k,1925) - lu(k,646) * lu(k,1896) + lu(k,1926) = lu(k,1926) - lu(k,647) * lu(k,1896) + lu(k,1927) = lu(k,1927) - lu(k,648) * lu(k,1896) + lu(k,1945) = lu(k,1945) - lu(k,649) * lu(k,1896) + lu(k,1947) = lu(k,1947) - lu(k,650) * lu(k,1896) + lu(k,1950) = lu(k,1950) - lu(k,651) * lu(k,1896) + lu(k,655) = 1._r8 / lu(k,655) + lu(k,656) = lu(k,656) * lu(k,655) + lu(k,657) = lu(k,657) * lu(k,655) + lu(k,658) = lu(k,658) * lu(k,655) + lu(k,659) = lu(k,659) * lu(k,655) + lu(k,660) = lu(k,660) * lu(k,655) + lu(k,661) = lu(k,661) * lu(k,655) + lu(k,662) = lu(k,662) * lu(k,655) + lu(k,663) = lu(k,663) * lu(k,655) + lu(k,664) = lu(k,664) * lu(k,655) + lu(k,731) = lu(k,731) - lu(k,656) * lu(k,730) + lu(k,732) = lu(k,732) - lu(k,657) * lu(k,730) + lu(k,733) = lu(k,733) - lu(k,658) * lu(k,730) + lu(k,734) = lu(k,734) - lu(k,659) * lu(k,730) + lu(k,735) = lu(k,735) - lu(k,660) * lu(k,730) + lu(k,736) = lu(k,736) - lu(k,661) * lu(k,730) + lu(k,737) = lu(k,737) - lu(k,662) * lu(k,730) + lu(k,738) = - lu(k,663) * lu(k,730) + lu(k,740) = lu(k,740) - lu(k,664) * lu(k,730) + lu(k,1637) = lu(k,1637) - lu(k,656) * lu(k,1630) + lu(k,1638) = lu(k,1638) - lu(k,657) * lu(k,1630) + lu(k,1640) = - lu(k,658) * lu(k,1630) + lu(k,1652) = lu(k,1652) - lu(k,659) * lu(k,1630) + lu(k,1660) = lu(k,1660) - lu(k,660) * lu(k,1630) + lu(k,1668) = lu(k,1668) - lu(k,661) * lu(k,1630) + lu(k,1676) = lu(k,1676) - lu(k,662) * lu(k,1630) + lu(k,1691) = lu(k,1691) - lu(k,663) * lu(k,1630) + lu(k,1694) = lu(k,1694) - lu(k,664) * lu(k,1630) + lu(k,1903) = lu(k,1903) - lu(k,656) * lu(k,1897) + lu(k,1904) = lu(k,1904) - lu(k,657) * lu(k,1897) + lu(k,1906) = lu(k,1906) - lu(k,658) * lu(k,1897) + lu(k,1915) = lu(k,1915) - lu(k,659) * lu(k,1897) + lu(k,1921) = lu(k,1921) - lu(k,660) * lu(k,1897) + lu(k,1926) = lu(k,1926) - lu(k,661) * lu(k,1897) + lu(k,1933) = lu(k,1933) - lu(k,662) * lu(k,1897) + lu(k,1947) = lu(k,1947) - lu(k,663) * lu(k,1897) + lu(k,1950) = lu(k,1950) - lu(k,664) * lu(k,1897) + lu(k,666) = 1._r8 / lu(k,666) + lu(k,667) = lu(k,667) * lu(k,666) + lu(k,668) = lu(k,668) * lu(k,666) + lu(k,669) = lu(k,669) * lu(k,666) + lu(k,670) = lu(k,670) * lu(k,666) + lu(k,671) = lu(k,671) * lu(k,666) + lu(k,672) = lu(k,672) * lu(k,666) + lu(k,673) = lu(k,673) * lu(k,666) + lu(k,674) = lu(k,674) * lu(k,666) + lu(k,675) = lu(k,675) * lu(k,666) + lu(k,897) = lu(k,897) - lu(k,667) * lu(k,896) + lu(k,898) = lu(k,898) - lu(k,668) * lu(k,896) + lu(k,900) = lu(k,900) - lu(k,669) * lu(k,896) + lu(k,901) = lu(k,901) - lu(k,670) * lu(k,896) + lu(k,902) = lu(k,902) - lu(k,671) * lu(k,896) + lu(k,903) = lu(k,903) - lu(k,672) * lu(k,896) + lu(k,904) = lu(k,904) - lu(k,673) * lu(k,896) + lu(k,906) = lu(k,906) - lu(k,674) * lu(k,896) + lu(k,908) = lu(k,908) - lu(k,675) * lu(k,896) + lu(k,1632) = lu(k,1632) - lu(k,667) * lu(k,1631) + lu(k,1646) = lu(k,1646) - lu(k,668) * lu(k,1631) + lu(k,1656) = lu(k,1656) - lu(k,669) * lu(k,1631) + lu(k,1666) = lu(k,1666) - lu(k,670) * lu(k,1631) + lu(k,1683) = lu(k,1683) - lu(k,671) * lu(k,1631) + lu(k,1689) = lu(k,1689) - lu(k,672) * lu(k,1631) + lu(k,1691) = lu(k,1691) - lu(k,673) * lu(k,1631) + lu(k,1694) = lu(k,1694) - lu(k,674) * lu(k,1631) + lu(k,1700) = lu(k,1700) - lu(k,675) * lu(k,1631) + lu(k,1796) = lu(k,1796) - lu(k,667) * lu(k,1795) + lu(k,1805) = lu(k,1805) - lu(k,668) * lu(k,1795) + lu(k,1810) = lu(k,1810) - lu(k,669) * lu(k,1795) + lu(k,1817) = lu(k,1817) - lu(k,670) * lu(k,1795) + lu(k,1833) = lu(k,1833) - lu(k,671) * lu(k,1795) + lu(k,1838) = lu(k,1838) - lu(k,672) * lu(k,1795) + lu(k,1840) = lu(k,1840) - lu(k,673) * lu(k,1795) + lu(k,1843) = lu(k,1843) - lu(k,674) * lu(k,1795) + lu(k,1849) = lu(k,1849) - lu(k,675) * lu(k,1795) end do end subroutine lu_fac14 subroutine lu_fac15( avec_len, lu ) @@ -2256,218 +2115,178 @@ subroutine lu_fac15( avec_len, lu ) lu(k,681) = lu(k,681) * lu(k,677) lu(k,682) = lu(k,682) * lu(k,677) lu(k,683) = lu(k,683) * lu(k,677) - lu(k,684) = lu(k,684) * lu(k,677) - lu(k,1035) = lu(k,1035) - lu(k,678) * lu(k,1034) - lu(k,1036) = - lu(k,679) * lu(k,1034) - lu(k,1037) = lu(k,1037) - lu(k,680) * lu(k,1034) - lu(k,1039) = lu(k,1039) - lu(k,681) * lu(k,1034) - lu(k,1040) = - lu(k,682) * lu(k,1034) - lu(k,1044) = - lu(k,683) * lu(k,1034) - lu(k,1045) = lu(k,1045) - lu(k,684) * lu(k,1034) - lu(k,1290) = - lu(k,678) * lu(k,1289) - lu(k,1291) = lu(k,1291) - lu(k,679) * lu(k,1289) - lu(k,1292) = lu(k,1292) - lu(k,680) * lu(k,1289) - lu(k,1294) = lu(k,1294) - lu(k,681) * lu(k,1289) - lu(k,1296) = - lu(k,682) * lu(k,1289) - lu(k,1300) = lu(k,1300) - lu(k,683) * lu(k,1289) - lu(k,1301) = lu(k,1301) - lu(k,684) * lu(k,1289) - lu(k,1347) = lu(k,1347) - lu(k,678) * lu(k,1345) - lu(k,1349) = - lu(k,679) * lu(k,1345) - lu(k,1350) = lu(k,1350) - lu(k,680) * lu(k,1345) - lu(k,1353) = lu(k,1353) - lu(k,681) * lu(k,1345) - lu(k,1356) = lu(k,1356) - lu(k,682) * lu(k,1345) - lu(k,1363) = - lu(k,683) * lu(k,1345) - lu(k,1365) = lu(k,1365) - lu(k,684) * lu(k,1345) - lu(k,1490) = lu(k,1490) - lu(k,678) * lu(k,1460) - lu(k,1503) = lu(k,1503) - lu(k,679) * lu(k,1460) - lu(k,1504) = lu(k,1504) - lu(k,680) * lu(k,1460) - lu(k,1507) = lu(k,1507) - lu(k,681) * lu(k,1460) - lu(k,1510) = lu(k,1510) - lu(k,682) * lu(k,1460) - lu(k,1517) = lu(k,1517) - lu(k,683) * lu(k,1460) - lu(k,1519) = lu(k,1519) - lu(k,684) * lu(k,1460) - lu(k,2061) = lu(k,2061) - lu(k,678) * lu(k,2059) - lu(k,2064) = - lu(k,679) * lu(k,2059) - lu(k,2065) = lu(k,2065) - lu(k,680) * lu(k,2059) - lu(k,2068) = lu(k,2068) - lu(k,681) * lu(k,2059) - lu(k,2071) = - lu(k,682) * lu(k,2059) - lu(k,2078) = - lu(k,683) * lu(k,2059) - lu(k,2080) = lu(k,2080) - lu(k,684) * lu(k,2059) - lu(k,686) = 1._r8 / lu(k,686) - lu(k,687) = lu(k,687) * lu(k,686) - lu(k,688) = lu(k,688) * lu(k,686) - lu(k,689) = lu(k,689) * lu(k,686) - lu(k,690) = lu(k,690) * lu(k,686) - lu(k,691) = lu(k,691) * lu(k,686) - lu(k,692) = lu(k,692) * lu(k,686) - lu(k,693) = lu(k,693) * lu(k,686) - lu(k,694) = lu(k,694) * lu(k,686) - lu(k,695) = lu(k,695) * lu(k,686) - lu(k,1475) = lu(k,1475) - lu(k,687) * lu(k,1461) - lu(k,1489) = lu(k,1489) - lu(k,688) * lu(k,1461) - lu(k,1507) = lu(k,1507) - lu(k,689) * lu(k,1461) - lu(k,1508) = lu(k,1508) - lu(k,690) * lu(k,1461) - lu(k,1509) = lu(k,1509) - lu(k,691) * lu(k,1461) - lu(k,1510) = lu(k,1510) - lu(k,692) * lu(k,1461) - lu(k,1512) = lu(k,1512) - lu(k,693) * lu(k,1461) - lu(k,1513) = lu(k,1513) - lu(k,694) * lu(k,1461) - lu(k,1519) = lu(k,1519) - lu(k,695) * lu(k,1461) - lu(k,1610) = lu(k,1610) - lu(k,687) * lu(k,1603) - lu(k,1622) = lu(k,1622) - lu(k,688) * lu(k,1603) - lu(k,1638) = lu(k,1638) - lu(k,689) * lu(k,1603) - lu(k,1639) = lu(k,1639) - lu(k,690) * lu(k,1603) - lu(k,1640) = lu(k,1640) - lu(k,691) * lu(k,1603) - lu(k,1641) = lu(k,1641) - lu(k,692) * lu(k,1603) - lu(k,1643) = lu(k,1643) - lu(k,693) * lu(k,1603) - lu(k,1644) = lu(k,1644) - lu(k,694) * lu(k,1603) - lu(k,1650) = lu(k,1650) - lu(k,695) * lu(k,1603) - lu(k,1662) = lu(k,1662) - lu(k,687) * lu(k,1657) - lu(k,1673) = lu(k,1673) - lu(k,688) * lu(k,1657) - lu(k,1688) = lu(k,1688) - lu(k,689) * lu(k,1657) - lu(k,1689) = lu(k,1689) - lu(k,690) * lu(k,1657) - lu(k,1690) = lu(k,1690) - lu(k,691) * lu(k,1657) - lu(k,1691) = lu(k,1691) - lu(k,692) * lu(k,1657) - lu(k,1693) = lu(k,1693) - lu(k,693) * lu(k,1657) - lu(k,1694) = lu(k,1694) - lu(k,694) * lu(k,1657) - lu(k,1700) = lu(k,1700) - lu(k,695) * lu(k,1657) - lu(k,1812) = lu(k,1812) - lu(k,687) * lu(k,1803) - lu(k,1822) = lu(k,1822) - lu(k,688) * lu(k,1803) - lu(k,1839) = lu(k,1839) - lu(k,689) * lu(k,1803) - lu(k,1840) = lu(k,1840) - lu(k,690) * lu(k,1803) - lu(k,1841) = lu(k,1841) - lu(k,691) * lu(k,1803) - lu(k,1842) = lu(k,1842) - lu(k,692) * lu(k,1803) - lu(k,1844) = lu(k,1844) - lu(k,693) * lu(k,1803) - lu(k,1845) = lu(k,1845) - lu(k,694) * lu(k,1803) - lu(k,1851) = lu(k,1851) - lu(k,695) * lu(k,1803) - lu(k,696) = 1._r8 / lu(k,696) - lu(k,697) = lu(k,697) * lu(k,696) - lu(k,698) = lu(k,698) * lu(k,696) - lu(k,699) = lu(k,699) * lu(k,696) - lu(k,717) = lu(k,717) - lu(k,697) * lu(k,714) - lu(k,721) = lu(k,721) - lu(k,698) * lu(k,714) - lu(k,722) = lu(k,722) - lu(k,699) * lu(k,714) - lu(k,963) = lu(k,963) - lu(k,697) * lu(k,951) - lu(k,967) = lu(k,967) - lu(k,698) * lu(k,951) - lu(k,968) = lu(k,968) - lu(k,699) * lu(k,951) - lu(k,983) = lu(k,983) - lu(k,697) * lu(k,973) - lu(k,987) = lu(k,987) - lu(k,698) * lu(k,973) - lu(k,988) = lu(k,988) - lu(k,699) * lu(k,973) - lu(k,1002) = lu(k,1002) - lu(k,697) * lu(k,992) - lu(k,1006) = lu(k,1006) - lu(k,698) * lu(k,992) - lu(k,1007) = lu(k,1007) - lu(k,699) * lu(k,992) - lu(k,1016) = lu(k,1016) - lu(k,697) * lu(k,1011) - lu(k,1020) = lu(k,1020) - lu(k,698) * lu(k,1011) - lu(k,1021) = lu(k,1021) - lu(k,699) * lu(k,1011) - lu(k,1056) = lu(k,1056) - lu(k,697) * lu(k,1047) - lu(k,1060) = lu(k,1060) - lu(k,698) * lu(k,1047) - lu(k,1061) = lu(k,1061) - lu(k,699) * lu(k,1047) - lu(k,1079) = lu(k,1079) - lu(k,697) * lu(k,1066) - lu(k,1083) = lu(k,1083) - lu(k,698) * lu(k,1066) - lu(k,1084) = lu(k,1084) - lu(k,699) * lu(k,1066) - lu(k,1149) = lu(k,1149) - lu(k,697) * lu(k,1129) - lu(k,1153) = lu(k,1153) - lu(k,698) * lu(k,1129) - lu(k,1154) = lu(k,1154) - lu(k,699) * lu(k,1129) - lu(k,1192) = lu(k,1192) - lu(k,697) * lu(k,1179) - lu(k,1196) = lu(k,1196) - lu(k,698) * lu(k,1179) - lu(k,1197) = lu(k,1197) - lu(k,699) * lu(k,1179) - lu(k,1219) = lu(k,1219) - lu(k,697) * lu(k,1202) - lu(k,1223) = lu(k,1223) - lu(k,698) * lu(k,1202) - lu(k,1224) = lu(k,1224) - lu(k,699) * lu(k,1202) - lu(k,1507) = lu(k,1507) - lu(k,697) * lu(k,1462) - lu(k,1512) = lu(k,1512) - lu(k,698) * lu(k,1462) - lu(k,1513) = lu(k,1513) - lu(k,699) * lu(k,1462) - lu(k,1688) = lu(k,1688) - lu(k,697) * lu(k,1658) - lu(k,1693) = lu(k,1693) - lu(k,698) * lu(k,1658) - lu(k,1694) = lu(k,1694) - lu(k,699) * lu(k,1658) - lu(k,700) = 1._r8 / lu(k,700) - lu(k,701) = lu(k,701) * lu(k,700) - lu(k,702) = lu(k,702) * lu(k,700) - lu(k,703) = lu(k,703) * lu(k,700) - lu(k,744) = lu(k,744) - lu(k,701) * lu(k,734) - lu(k,747) = lu(k,747) - lu(k,702) * lu(k,734) - lu(k,750) = - lu(k,703) * lu(k,734) - lu(k,799) = lu(k,799) - lu(k,701) * lu(k,786) - lu(k,801) = lu(k,801) - lu(k,702) * lu(k,786) - lu(k,804) = - lu(k,703) * lu(k,786) - lu(k,826) = lu(k,826) - lu(k,701) * lu(k,813) - lu(k,828) = lu(k,828) - lu(k,702) * lu(k,813) - lu(k,831) = - lu(k,703) * lu(k,813) - lu(k,875) = lu(k,875) - lu(k,701) * lu(k,867) - lu(k,880) = lu(k,880) - lu(k,702) * lu(k,867) - lu(k,883) = lu(k,883) - lu(k,703) * lu(k,867) - lu(k,1094) = lu(k,1094) - lu(k,701) * lu(k,1086) - lu(k,1096) = lu(k,1096) - lu(k,702) * lu(k,1086) - lu(k,1098) = lu(k,1098) - lu(k,703) * lu(k,1086) - lu(k,1169) = lu(k,1169) - lu(k,701) * lu(k,1158) - lu(k,1174) = lu(k,1174) - lu(k,702) * lu(k,1158) - lu(k,1177) = - lu(k,703) * lu(k,1158) - lu(k,1507) = lu(k,1507) - lu(k,701) * lu(k,1463) - lu(k,1513) = lu(k,1513) - lu(k,702) * lu(k,1463) - lu(k,1519) = lu(k,1519) - lu(k,703) * lu(k,1463) - lu(k,1638) = lu(k,1638) - lu(k,701) * lu(k,1604) - lu(k,1644) = lu(k,1644) - lu(k,702) * lu(k,1604) - lu(k,1650) = lu(k,1650) - lu(k,703) * lu(k,1604) - lu(k,1734) = lu(k,1734) - lu(k,701) * lu(k,1726) - lu(k,1740) = lu(k,1740) - lu(k,702) * lu(k,1726) - lu(k,1746) = lu(k,1746) - lu(k,703) * lu(k,1726) - lu(k,1839) = lu(k,1839) - lu(k,701) * lu(k,1804) - lu(k,1845) = lu(k,1845) - lu(k,702) * lu(k,1804) - lu(k,1851) = lu(k,1851) - lu(k,703) * lu(k,1804) - lu(k,1926) = lu(k,1926) - lu(k,701) * lu(k,1911) - lu(k,1932) = lu(k,1932) - lu(k,702) * lu(k,1911) - lu(k,1938) = lu(k,1938) - lu(k,703) * lu(k,1911) - lu(k,2043) = lu(k,2043) - lu(k,701) * lu(k,2009) - lu(k,2049) = lu(k,2049) - lu(k,702) * lu(k,2009) - lu(k,2055) = lu(k,2055) - lu(k,703) * lu(k,2009) - lu(k,704) = 1._r8 / lu(k,704) - lu(k,705) = lu(k,705) * lu(k,704) - lu(k,706) = lu(k,706) * lu(k,704) - lu(k,707) = lu(k,707) * lu(k,704) - lu(k,708) = lu(k,708) * lu(k,704) - lu(k,709) = lu(k,709) * lu(k,704) - lu(k,710) = lu(k,710) * lu(k,704) - lu(k,711) = lu(k,711) * lu(k,704) - lu(k,1278) = lu(k,1278) - lu(k,705) * lu(k,1276) - lu(k,1279) = - lu(k,706) * lu(k,1276) - lu(k,1280) = - lu(k,707) * lu(k,1276) - lu(k,1281) = - lu(k,708) * lu(k,1276) - lu(k,1282) = lu(k,1282) - lu(k,709) * lu(k,1276) - lu(k,1285) = - lu(k,710) * lu(k,1276) - lu(k,1287) = - lu(k,711) * lu(k,1276) - lu(k,1348) = lu(k,1348) - lu(k,705) * lu(k,1346) - lu(k,1350) = lu(k,1350) - lu(k,706) * lu(k,1346) - lu(k,1352) = lu(k,1352) - lu(k,707) * lu(k,1346) - lu(k,1353) = lu(k,1353) - lu(k,708) * lu(k,1346) - lu(k,1357) = lu(k,1357) - lu(k,709) * lu(k,1346) - lu(k,1360) = lu(k,1360) - lu(k,710) * lu(k,1346) - lu(k,1365) = lu(k,1365) - lu(k,711) * lu(k,1346) - lu(k,1502) = lu(k,1502) - lu(k,705) * lu(k,1464) - lu(k,1504) = lu(k,1504) - lu(k,706) * lu(k,1464) - lu(k,1506) = lu(k,1506) - lu(k,707) * lu(k,1464) - lu(k,1507) = lu(k,1507) - lu(k,708) * lu(k,1464) - lu(k,1511) = lu(k,1511) - lu(k,709) * lu(k,1464) - lu(k,1514) = lu(k,1514) - lu(k,710) * lu(k,1464) - lu(k,1519) = lu(k,1519) - lu(k,711) * lu(k,1464) - lu(k,1730) = lu(k,1730) - lu(k,705) * lu(k,1727) - lu(k,1732) = lu(k,1732) - lu(k,706) * lu(k,1727) - lu(k,1733) = - lu(k,707) * lu(k,1727) - lu(k,1734) = lu(k,1734) - lu(k,708) * lu(k,1727) - lu(k,1738) = - lu(k,709) * lu(k,1727) - lu(k,1741) = lu(k,1741) - lu(k,710) * lu(k,1727) - lu(k,1746) = lu(k,1746) - lu(k,711) * lu(k,1727) - lu(k,1834) = lu(k,1834) - lu(k,705) * lu(k,1805) - lu(k,1836) = lu(k,1836) - lu(k,706) * lu(k,1805) - lu(k,1838) = - lu(k,707) * lu(k,1805) - lu(k,1839) = lu(k,1839) - lu(k,708) * lu(k,1805) - lu(k,1843) = lu(k,1843) - lu(k,709) * lu(k,1805) - lu(k,1846) = lu(k,1846) - lu(k,710) * lu(k,1805) - lu(k,1851) = lu(k,1851) - lu(k,711) * lu(k,1805) - lu(k,1864) = lu(k,1864) - lu(k,705) * lu(k,1857) - lu(k,1866) = lu(k,1866) - lu(k,706) * lu(k,1857) - lu(k,1868) = - lu(k,707) * lu(k,1857) - lu(k,1869) = lu(k,1869) - lu(k,708) * lu(k,1857) - lu(k,1873) = lu(k,1873) - lu(k,709) * lu(k,1857) - lu(k,1876) = lu(k,1876) - lu(k,710) * lu(k,1857) - lu(k,1881) = lu(k,1881) - lu(k,711) * lu(k,1857) + lu(k,901) = lu(k,901) - lu(k,678) * lu(k,897) + lu(k,902) = lu(k,902) - lu(k,679) * lu(k,897) + lu(k,904) = lu(k,904) - lu(k,680) * lu(k,897) + lu(k,905) = lu(k,905) - lu(k,681) * lu(k,897) + lu(k,906) = lu(k,906) - lu(k,682) * lu(k,897) + lu(k,908) = lu(k,908) - lu(k,683) * lu(k,897) + lu(k,1666) = lu(k,1666) - lu(k,678) * lu(k,1632) + lu(k,1683) = lu(k,1683) - lu(k,679) * lu(k,1632) + lu(k,1691) = lu(k,1691) - lu(k,680) * lu(k,1632) + lu(k,1693) = lu(k,1693) - lu(k,681) * lu(k,1632) + lu(k,1694) = lu(k,1694) - lu(k,682) * lu(k,1632) + lu(k,1700) = lu(k,1700) - lu(k,683) * lu(k,1632) + lu(k,1817) = lu(k,1817) - lu(k,678) * lu(k,1796) + lu(k,1833) = lu(k,1833) - lu(k,679) * lu(k,1796) + lu(k,1840) = lu(k,1840) - lu(k,680) * lu(k,1796) + lu(k,1842) = lu(k,1842) - lu(k,681) * lu(k,1796) + lu(k,1843) = lu(k,1843) - lu(k,682) * lu(k,1796) + lu(k,1849) = lu(k,1849) - lu(k,683) * lu(k,1796) + lu(k,1924) = lu(k,1924) - lu(k,678) * lu(k,1898) + lu(k,1939) = lu(k,1939) - lu(k,679) * lu(k,1898) + lu(k,1947) = lu(k,1947) - lu(k,680) * lu(k,1898) + lu(k,1949) = lu(k,1949) - lu(k,681) * lu(k,1898) + lu(k,1950) = lu(k,1950) - lu(k,682) * lu(k,1898) + lu(k,1956) = lu(k,1956) - lu(k,683) * lu(k,1898) + lu(k,684) = 1._r8 / lu(k,684) + lu(k,685) = lu(k,685) * lu(k,684) + lu(k,686) = lu(k,686) * lu(k,684) + lu(k,687) = lu(k,687) * lu(k,684) + lu(k,688) = lu(k,688) * lu(k,684) + lu(k,1021) = lu(k,1021) - lu(k,685) * lu(k,1019) + lu(k,1032) = lu(k,1032) - lu(k,686) * lu(k,1019) + lu(k,1036) = lu(k,1036) - lu(k,687) * lu(k,1019) + lu(k,1040) = - lu(k,688) * lu(k,1019) + lu(k,1350) = lu(k,1350) - lu(k,685) * lu(k,1349) + lu(k,1358) = lu(k,1358) - lu(k,686) * lu(k,1349) + lu(k,1362) = lu(k,1362) - lu(k,687) * lu(k,1349) + lu(k,1366) = lu(k,1366) - lu(k,688) * lu(k,1349) + lu(k,1371) = lu(k,1371) - lu(k,685) * lu(k,1370) + lu(k,1390) = lu(k,1390) - lu(k,686) * lu(k,1370) + lu(k,1394) = lu(k,1394) - lu(k,687) * lu(k,1370) + lu(k,1398) = lu(k,1398) - lu(k,688) * lu(k,1370) + lu(k,1644) = lu(k,1644) - lu(k,685) * lu(k,1633) + lu(k,1691) = lu(k,1691) - lu(k,686) * lu(k,1633) + lu(k,1697) = lu(k,1697) - lu(k,687) * lu(k,1633) + lu(k,1703) = lu(k,1703) - lu(k,688) * lu(k,1633) + lu(k,1910) = lu(k,1910) - lu(k,685) * lu(k,1899) + lu(k,1947) = lu(k,1947) - lu(k,686) * lu(k,1899) + lu(k,1953) = lu(k,1953) - lu(k,687) * lu(k,1899) + lu(k,1959) = lu(k,1959) - lu(k,688) * lu(k,1899) + lu(k,2033) = lu(k,2033) - lu(k,685) * lu(k,2030) + lu(k,2064) = lu(k,2064) - lu(k,686) * lu(k,2030) + lu(k,2070) = lu(k,2070) - lu(k,687) * lu(k,2030) + lu(k,2076) = lu(k,2076) - lu(k,688) * lu(k,2030) + lu(k,2090) = lu(k,2090) - lu(k,685) * lu(k,2088) + lu(k,2125) = lu(k,2125) - lu(k,686) * lu(k,2088) + lu(k,2131) = lu(k,2131) - lu(k,687) * lu(k,2088) + lu(k,2137) = - lu(k,688) * lu(k,2088) + lu(k,690) = 1._r8 / lu(k,690) + lu(k,691) = lu(k,691) * lu(k,690) + lu(k,692) = lu(k,692) * lu(k,690) + lu(k,693) = lu(k,693) * lu(k,690) + lu(k,694) = lu(k,694) * lu(k,690) + lu(k,695) = lu(k,695) * lu(k,690) + lu(k,696) = lu(k,696) * lu(k,690) + lu(k,1192) = - lu(k,691) * lu(k,1186) + lu(k,1194) = - lu(k,692) * lu(k,1186) + lu(k,1196) = - lu(k,693) * lu(k,1186) + lu(k,1199) = lu(k,1199) - lu(k,694) * lu(k,1186) + lu(k,1200) = lu(k,1200) - lu(k,695) * lu(k,1186) + lu(k,1203) = lu(k,1203) - lu(k,696) * lu(k,1186) + lu(k,1253) = - lu(k,691) * lu(k,1246) + lu(k,1254) = lu(k,1254) - lu(k,692) * lu(k,1246) + lu(k,1258) = lu(k,1258) - lu(k,693) * lu(k,1246) + lu(k,1262) = lu(k,1262) - lu(k,694) * lu(k,1246) + lu(k,1263) = lu(k,1263) - lu(k,695) * lu(k,1246) + lu(k,1266) = lu(k,1266) - lu(k,696) * lu(k,1246) + lu(k,1285) = lu(k,1285) - lu(k,691) * lu(k,1276) + lu(k,1286) = - lu(k,692) * lu(k,1276) + lu(k,1290) = - lu(k,693) * lu(k,1276) + lu(k,1294) = lu(k,1294) - lu(k,694) * lu(k,1276) + lu(k,1295) = lu(k,1295) - lu(k,695) * lu(k,1276) + lu(k,1298) = lu(k,1298) - lu(k,696) * lu(k,1276) + lu(k,1673) = lu(k,1673) - lu(k,691) * lu(k,1634) + lu(k,1675) = lu(k,1675) - lu(k,692) * lu(k,1634) + lu(k,1681) = lu(k,1681) - lu(k,693) * lu(k,1634) + lu(k,1689) = lu(k,1689) - lu(k,694) * lu(k,1634) + lu(k,1691) = lu(k,1691) - lu(k,695) * lu(k,1634) + lu(k,1694) = lu(k,1694) - lu(k,696) * lu(k,1634) + lu(k,1930) = lu(k,1930) - lu(k,691) * lu(k,1900) + lu(k,1932) = - lu(k,692) * lu(k,1900) + lu(k,1937) = - lu(k,693) * lu(k,1900) + lu(k,1945) = lu(k,1945) - lu(k,694) * lu(k,1900) + lu(k,1947) = lu(k,1947) - lu(k,695) * lu(k,1900) + lu(k,1950) = lu(k,1950) - lu(k,696) * lu(k,1900) + lu(k,701) = 1._r8 / lu(k,701) + lu(k,702) = lu(k,702) * lu(k,701) + lu(k,703) = lu(k,703) * lu(k,701) + lu(k,704) = lu(k,704) * lu(k,701) + lu(k,705) = lu(k,705) * lu(k,701) + lu(k,706) = lu(k,706) * lu(k,701) + lu(k,707) = lu(k,707) * lu(k,701) + lu(k,708) = lu(k,708) * lu(k,701) + lu(k,709) = lu(k,709) * lu(k,701) + lu(k,710) = lu(k,710) * lu(k,701) + lu(k,711) = lu(k,711) * lu(k,701) + lu(k,747) = lu(k,747) - lu(k,702) * lu(k,746) + lu(k,748) = lu(k,748) - lu(k,703) * lu(k,746) + lu(k,749) = lu(k,749) - lu(k,704) * lu(k,746) + lu(k,750) = lu(k,750) - lu(k,705) * lu(k,746) + lu(k,751) = lu(k,751) - lu(k,706) * lu(k,746) + lu(k,752) = lu(k,752) - lu(k,707) * lu(k,746) + lu(k,753) = lu(k,753) - lu(k,708) * lu(k,746) + lu(k,754) = lu(k,754) - lu(k,709) * lu(k,746) + lu(k,755) = - lu(k,710) * lu(k,746) + lu(k,757) = lu(k,757) - lu(k,711) * lu(k,746) + lu(k,1637) = lu(k,1637) - lu(k,702) * lu(k,1635) + lu(k,1639) = lu(k,1639) - lu(k,703) * lu(k,1635) + lu(k,1640) = lu(k,1640) - lu(k,704) * lu(k,1635) + lu(k,1652) = lu(k,1652) - lu(k,705) * lu(k,1635) + lu(k,1660) = lu(k,1660) - lu(k,706) * lu(k,1635) + lu(k,1668) = lu(k,1668) - lu(k,707) * lu(k,1635) + lu(k,1676) = lu(k,1676) - lu(k,708) * lu(k,1635) + lu(k,1683) = lu(k,1683) - lu(k,709) * lu(k,1635) + lu(k,1691) = lu(k,1691) - lu(k,710) * lu(k,1635) + lu(k,1694) = lu(k,1694) - lu(k,711) * lu(k,1635) + lu(k,1903) = lu(k,1903) - lu(k,702) * lu(k,1901) + lu(k,1905) = lu(k,1905) - lu(k,703) * lu(k,1901) + lu(k,1906) = lu(k,1906) - lu(k,704) * lu(k,1901) + lu(k,1915) = lu(k,1915) - lu(k,705) * lu(k,1901) + lu(k,1921) = lu(k,1921) - lu(k,706) * lu(k,1901) + lu(k,1926) = lu(k,1926) - lu(k,707) * lu(k,1901) + lu(k,1933) = lu(k,1933) - lu(k,708) * lu(k,1901) + lu(k,1939) = lu(k,1939) - lu(k,709) * lu(k,1901) + lu(k,1947) = lu(k,1947) - lu(k,710) * lu(k,1901) + lu(k,1950) = lu(k,1950) - lu(k,711) * lu(k,1901) + lu(k,714) = 1._r8 / lu(k,714) + lu(k,715) = lu(k,715) * lu(k,714) + lu(k,716) = lu(k,716) * lu(k,714) + lu(k,717) = lu(k,717) * lu(k,714) + lu(k,718) = lu(k,718) * lu(k,714) + lu(k,719) = lu(k,719) * lu(k,714) + lu(k,720) = lu(k,720) * lu(k,714) + lu(k,1667) = lu(k,1667) - lu(k,715) * lu(k,1636) + lu(k,1689) = lu(k,1689) - lu(k,716) * lu(k,1636) + lu(k,1691) = lu(k,1691) - lu(k,717) * lu(k,1636) + lu(k,1693) = lu(k,1693) - lu(k,718) * lu(k,1636) + lu(k,1694) = lu(k,1694) - lu(k,719) * lu(k,1636) + lu(k,1700) = lu(k,1700) - lu(k,720) * lu(k,1636) + lu(k,1818) = lu(k,1818) - lu(k,715) * lu(k,1797) + lu(k,1838) = lu(k,1838) - lu(k,716) * lu(k,1797) + lu(k,1840) = lu(k,1840) - lu(k,717) * lu(k,1797) + lu(k,1842) = lu(k,1842) - lu(k,718) * lu(k,1797) + lu(k,1843) = lu(k,1843) - lu(k,719) * lu(k,1797) + lu(k,1849) = lu(k,1849) - lu(k,720) * lu(k,1797) + lu(k,1925) = lu(k,1925) - lu(k,715) * lu(k,1902) + lu(k,1945) = lu(k,1945) - lu(k,716) * lu(k,1902) + lu(k,1947) = lu(k,1947) - lu(k,717) * lu(k,1902) + lu(k,1949) = lu(k,1949) - lu(k,718) * lu(k,1902) + lu(k,1950) = lu(k,1950) - lu(k,719) * lu(k,1902) + lu(k,1956) = lu(k,1956) - lu(k,720) * lu(k,1902) + lu(k,2002) = - lu(k,715) * lu(k,1995) + lu(k,2010) = lu(k,2010) - lu(k,716) * lu(k,1995) + lu(k,2012) = lu(k,2012) - lu(k,717) * lu(k,1995) + lu(k,2014) = - lu(k,718) * lu(k,1995) + lu(k,2015) = lu(k,2015) - lu(k,719) * lu(k,1995) + lu(k,2021) = - lu(k,720) * lu(k,1995) + lu(k,2104) = - lu(k,715) * lu(k,2089) + lu(k,2123) = lu(k,2123) - lu(k,716) * lu(k,2089) + lu(k,2125) = lu(k,2125) - lu(k,717) * lu(k,2089) + lu(k,2127) = lu(k,2127) - lu(k,718) * lu(k,2089) + lu(k,2128) = lu(k,2128) - lu(k,719) * lu(k,2089) + lu(k,2134) = lu(k,2134) - lu(k,720) * lu(k,2089) end do end subroutine lu_fac15 subroutine lu_fac16( avec_len, lu ) @@ -2484,217 +2303,197 @@ subroutine lu_fac16( avec_len, lu ) !----------------------------------------------------------------------- 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,839) = lu(k,839) - lu(k,716) * lu(k,836) - lu(k,841) = lu(k,841) - lu(k,717) * lu(k,836) - lu(k,842) = lu(k,842) - lu(k,718) * lu(k,836) - lu(k,843) = lu(k,843) - lu(k,719) * lu(k,836) - lu(k,844) = - lu(k,720) * lu(k,836) - lu(k,845) = lu(k,845) - lu(k,721) * lu(k,836) - lu(k,846) = lu(k,846) - lu(k,722) * lu(k,836) - lu(k,1489) = lu(k,1489) - lu(k,716) * lu(k,1465) - lu(k,1507) = lu(k,1507) - lu(k,717) * lu(k,1465) - lu(k,1508) = lu(k,1508) - lu(k,718) * lu(k,1465) - lu(k,1509) = lu(k,1509) - lu(k,719) * lu(k,1465) - lu(k,1510) = lu(k,1510) - lu(k,720) * lu(k,1465) - lu(k,1512) = lu(k,1512) - lu(k,721) * lu(k,1465) - lu(k,1513) = lu(k,1513) - lu(k,722) * lu(k,1465) - lu(k,1622) = lu(k,1622) - lu(k,716) * lu(k,1605) - lu(k,1638) = lu(k,1638) - lu(k,717) * lu(k,1605) - lu(k,1639) = lu(k,1639) - lu(k,718) * lu(k,1605) - lu(k,1640) = lu(k,1640) - lu(k,719) * lu(k,1605) - lu(k,1641) = lu(k,1641) - lu(k,720) * lu(k,1605) - lu(k,1643) = lu(k,1643) - lu(k,721) * lu(k,1605) - lu(k,1644) = lu(k,1644) - lu(k,722) * lu(k,1605) - lu(k,1673) = lu(k,1673) - lu(k,716) * lu(k,1659) - lu(k,1688) = lu(k,1688) - lu(k,717) * lu(k,1659) - lu(k,1689) = lu(k,1689) - lu(k,718) * lu(k,1659) - lu(k,1690) = lu(k,1690) - lu(k,719) * lu(k,1659) - lu(k,1691) = lu(k,1691) - lu(k,720) * lu(k,1659) - lu(k,1693) = lu(k,1693) - lu(k,721) * lu(k,1659) - lu(k,1694) = lu(k,1694) - lu(k,722) * lu(k,1659) - lu(k,1822) = lu(k,1822) - lu(k,716) * lu(k,1806) - lu(k,1839) = lu(k,1839) - lu(k,717) * lu(k,1806) - lu(k,1840) = lu(k,1840) - lu(k,718) * lu(k,1806) - lu(k,1841) = lu(k,1841) - lu(k,719) * lu(k,1806) - lu(k,1842) = lu(k,1842) - lu(k,720) * lu(k,1806) - lu(k,1844) = lu(k,1844) - lu(k,721) * lu(k,1806) - lu(k,1845) = lu(k,1845) - lu(k,722) * lu(k,1806) - lu(k,1918) = - lu(k,716) * lu(k,1912) - lu(k,1926) = lu(k,1926) - lu(k,717) * lu(k,1912) - lu(k,1927) = lu(k,1927) - lu(k,718) * lu(k,1912) - lu(k,1928) = lu(k,1928) - lu(k,719) * lu(k,1912) - lu(k,1929) = lu(k,1929) - lu(k,720) * lu(k,1912) - lu(k,1931) = lu(k,1931) - lu(k,721) * lu(k,1912) - lu(k,1932) = lu(k,1932) - lu(k,722) * lu(k,1912) - lu(k,724) = 1._r8 / lu(k,724) - lu(k,725) = lu(k,725) * lu(k,724) - lu(k,726) = lu(k,726) * lu(k,724) - lu(k,727) = lu(k,727) * lu(k,724) - lu(k,728) = lu(k,728) * lu(k,724) - lu(k,729) = lu(k,729) * lu(k,724) - lu(k,730) = lu(k,730) * lu(k,724) - lu(k,857) = lu(k,857) - lu(k,725) * lu(k,854) - lu(k,858) = lu(k,858) - lu(k,726) * lu(k,854) - lu(k,860) = lu(k,860) - lu(k,727) * lu(k,854) - lu(k,861) = lu(k,861) - lu(k,728) * lu(k,854) - lu(k,862) = lu(k,862) - lu(k,729) * lu(k,854) - lu(k,864) = - lu(k,730) * lu(k,854) - lu(k,1327) = lu(k,1327) - lu(k,725) * lu(k,1320) - lu(k,1329) = lu(k,1329) - lu(k,726) * lu(k,1320) - lu(k,1336) = lu(k,1336) - lu(k,727) * lu(k,1320) - lu(k,1337) = lu(k,1337) - lu(k,728) * lu(k,1320) - lu(k,1338) = lu(k,1338) - lu(k,729) * lu(k,1320) - lu(k,1341) = - lu(k,730) * lu(k,1320) - lu(k,1505) = lu(k,1505) - lu(k,725) * lu(k,1466) - lu(k,1507) = lu(k,1507) - lu(k,726) * lu(k,1466) - lu(k,1514) = lu(k,1514) - lu(k,727) * lu(k,1466) - lu(k,1515) = lu(k,1515) - lu(k,728) * lu(k,1466) - lu(k,1516) = lu(k,1516) - lu(k,729) * lu(k,1466) - lu(k,1519) = lu(k,1519) - lu(k,730) * lu(k,1466) - lu(k,1837) = lu(k,1837) - lu(k,725) * lu(k,1807) - lu(k,1839) = lu(k,1839) - lu(k,726) * lu(k,1807) - lu(k,1846) = lu(k,1846) - lu(k,727) * lu(k,1807) - lu(k,1847) = lu(k,1847) - lu(k,728) * lu(k,1807) - lu(k,1848) = lu(k,1848) - lu(k,729) * lu(k,1807) - lu(k,1851) = lu(k,1851) - lu(k,730) * lu(k,1807) - lu(k,1867) = lu(k,1867) - lu(k,725) * lu(k,1858) - lu(k,1869) = lu(k,1869) - lu(k,726) * lu(k,1858) - lu(k,1876) = lu(k,1876) - lu(k,727) * lu(k,1858) - lu(k,1877) = lu(k,1877) - lu(k,728) * lu(k,1858) - lu(k,1878) = lu(k,1878) - lu(k,729) * lu(k,1858) - lu(k,1881) = lu(k,1881) - lu(k,730) * lu(k,1858) - lu(k,1890) = lu(k,1890) - lu(k,725) * lu(k,1885) - lu(k,1892) = lu(k,1892) - lu(k,726) * lu(k,1885) - lu(k,1899) = lu(k,1899) - lu(k,727) * lu(k,1885) - lu(k,1900) = lu(k,1900) - lu(k,728) * lu(k,1885) - lu(k,1901) = lu(k,1901) - lu(k,729) * lu(k,1885) - lu(k,1904) = lu(k,1904) - lu(k,730) * lu(k,1885) - lu(k,1924) = lu(k,1924) - lu(k,725) * lu(k,1913) - lu(k,1926) = lu(k,1926) - lu(k,726) * lu(k,1913) - lu(k,1933) = lu(k,1933) - lu(k,727) * lu(k,1913) - lu(k,1934) = lu(k,1934) - lu(k,728) * lu(k,1913) - lu(k,1935) = lu(k,1935) - lu(k,729) * lu(k,1913) - lu(k,1938) = lu(k,1938) - lu(k,730) * lu(k,1913) - lu(k,735) = 1._r8 / lu(k,735) - lu(k,736) = lu(k,736) * lu(k,735) - lu(k,737) = lu(k,737) * lu(k,735) - lu(k,738) = lu(k,738) * lu(k,735) - lu(k,739) = lu(k,739) * lu(k,735) - lu(k,740) = lu(k,740) * lu(k,735) - lu(k,741) = lu(k,741) * lu(k,735) - lu(k,742) = lu(k,742) * lu(k,735) - lu(k,743) = lu(k,743) * lu(k,735) - lu(k,744) = lu(k,744) * lu(k,735) - lu(k,745) = lu(k,745) * lu(k,735) - lu(k,746) = lu(k,746) * lu(k,735) - lu(k,747) = lu(k,747) * lu(k,735) - lu(k,748) = lu(k,748) * lu(k,735) - lu(k,749) = lu(k,749) * lu(k,735) - lu(k,750) = lu(k,750) * lu(k,735) - lu(k,1477) = lu(k,1477) - lu(k,736) * lu(k,1467) - lu(k,1483) = lu(k,1483) - lu(k,737) * lu(k,1467) - lu(k,1492) = - lu(k,738) * lu(k,1467) - lu(k,1493) = lu(k,1493) - lu(k,739) * lu(k,1467) - lu(k,1496) = lu(k,1496) - lu(k,740) * lu(k,1467) - lu(k,1497) = lu(k,1497) - lu(k,741) * lu(k,1467) - lu(k,1499) = lu(k,1499) - lu(k,742) * lu(k,1467) - lu(k,1501) = lu(k,1501) - lu(k,743) * lu(k,1467) - lu(k,1507) = lu(k,1507) - lu(k,744) * lu(k,1467) - lu(k,1510) = lu(k,1510) - lu(k,745) * lu(k,1467) - lu(k,1512) = lu(k,1512) - lu(k,746) * lu(k,1467) - lu(k,1513) = lu(k,1513) - lu(k,747) * lu(k,1467) - lu(k,1517) = lu(k,1517) - lu(k,748) * lu(k,1467) - lu(k,1518) = lu(k,1518) - lu(k,749) * lu(k,1467) - lu(k,1519) = lu(k,1519) - lu(k,750) * lu(k,1467) - lu(k,1954) = lu(k,1954) - lu(k,736) * lu(k,1946) - lu(k,1960) = lu(k,1960) - lu(k,737) * lu(k,1946) - lu(k,1968) = lu(k,1968) - lu(k,738) * lu(k,1946) - lu(k,1969) = lu(k,1969) - lu(k,739) * lu(k,1946) - lu(k,1972) = lu(k,1972) - lu(k,740) * lu(k,1946) - lu(k,1973) = lu(k,1973) - lu(k,741) * lu(k,1946) - lu(k,1975) = lu(k,1975) - lu(k,742) * lu(k,1946) - lu(k,1977) = lu(k,1977) - lu(k,743) * lu(k,1946) - lu(k,1983) = lu(k,1983) - lu(k,744) * lu(k,1946) - lu(k,1986) = - lu(k,745) * lu(k,1946) - lu(k,1988) = lu(k,1988) - lu(k,746) * lu(k,1946) - lu(k,1989) = lu(k,1989) - lu(k,747) * lu(k,1946) - lu(k,1993) = lu(k,1993) - lu(k,748) * lu(k,1946) - lu(k,1994) = - lu(k,749) * lu(k,1946) - lu(k,1995) = - lu(k,750) * lu(k,1946) - lu(k,2017) = lu(k,2017) - lu(k,736) * lu(k,2010) - lu(k,2021) = lu(k,2021) - lu(k,737) * lu(k,2010) - lu(k,2028) = - lu(k,738) * lu(k,2010) - lu(k,2029) = lu(k,2029) - lu(k,739) * lu(k,2010) - lu(k,2032) = - lu(k,740) * lu(k,2010) - lu(k,2033) = lu(k,2033) - lu(k,741) * lu(k,2010) - lu(k,2035) = - lu(k,742) * lu(k,2010) - lu(k,2037) = lu(k,2037) - lu(k,743) * lu(k,2010) - lu(k,2043) = lu(k,2043) - lu(k,744) * lu(k,2010) - lu(k,2046) = lu(k,2046) - lu(k,745) * lu(k,2010) - lu(k,2048) = lu(k,2048) - lu(k,746) * lu(k,2010) - lu(k,2049) = lu(k,2049) - lu(k,747) * lu(k,2010) - lu(k,2053) = lu(k,2053) - lu(k,748) * lu(k,2010) - lu(k,2054) = lu(k,2054) - lu(k,749) * lu(k,2010) - lu(k,2055) = lu(k,2055) - lu(k,750) * lu(k,2010) - lu(k,751) = 1._r8 / lu(k,751) - lu(k,752) = lu(k,752) * lu(k,751) - lu(k,753) = lu(k,753) * lu(k,751) - lu(k,754) = lu(k,754) * lu(k,751) - lu(k,755) = lu(k,755) * lu(k,751) - lu(k,756) = lu(k,756) * lu(k,751) - lu(k,873) = - lu(k,752) * lu(k,868) - lu(k,874) = - lu(k,753) * lu(k,868) - lu(k,875) = lu(k,875) - lu(k,754) * lu(k,868) - lu(k,876) = lu(k,876) - lu(k,755) * lu(k,868) - lu(k,879) = lu(k,879) - lu(k,756) * lu(k,868) - lu(k,898) = - lu(k,752) * lu(k,893) - lu(k,899) = - lu(k,753) * lu(k,893) - lu(k,901) = lu(k,901) - lu(k,754) * lu(k,893) - lu(k,902) = lu(k,902) - lu(k,755) * lu(k,893) - lu(k,905) = - lu(k,756) * lu(k,893) - lu(k,1074) = - lu(k,752) * lu(k,1067) - lu(k,1076) = lu(k,1076) - lu(k,753) * lu(k,1067) - lu(k,1079) = lu(k,1079) - lu(k,754) * lu(k,1067) - lu(k,1080) = lu(k,1080) - lu(k,755) * lu(k,1067) - lu(k,1083) = lu(k,1083) - lu(k,756) * lu(k,1067) - lu(k,1141) = lu(k,1141) - lu(k,752) * lu(k,1130) - lu(k,1146) = lu(k,1146) - lu(k,753) * lu(k,1130) - lu(k,1149) = lu(k,1149) - lu(k,754) * lu(k,1130) - lu(k,1150) = lu(k,1150) - lu(k,755) * lu(k,1130) - lu(k,1153) = lu(k,1153) - lu(k,756) * lu(k,1130) - lu(k,1494) = lu(k,1494) - lu(k,752) * lu(k,1468) - lu(k,1501) = lu(k,1501) - lu(k,753) * lu(k,1468) - lu(k,1507) = lu(k,1507) - lu(k,754) * lu(k,1468) - lu(k,1508) = lu(k,1508) - lu(k,755) * lu(k,1468) - lu(k,1512) = lu(k,1512) - lu(k,756) * lu(k,1468) - lu(k,1626) = lu(k,1626) - lu(k,752) * lu(k,1606) - lu(k,1632) = lu(k,1632) - lu(k,753) * lu(k,1606) - lu(k,1638) = lu(k,1638) - lu(k,754) * lu(k,1606) - lu(k,1639) = lu(k,1639) - lu(k,755) * lu(k,1606) - lu(k,1643) = lu(k,1643) - lu(k,756) * lu(k,1606) - lu(k,1677) = lu(k,1677) - lu(k,752) * lu(k,1660) - lu(k,1683) = lu(k,1683) - lu(k,753) * lu(k,1660) - lu(k,1688) = lu(k,1688) - lu(k,754) * lu(k,1660) - lu(k,1689) = lu(k,1689) - lu(k,755) * lu(k,1660) - lu(k,1693) = lu(k,1693) - lu(k,756) * lu(k,1660) - lu(k,1827) = lu(k,1827) - lu(k,752) * lu(k,1808) - lu(k,1833) = lu(k,1833) - lu(k,753) * lu(k,1808) - lu(k,1839) = lu(k,1839) - lu(k,754) * lu(k,1808) - lu(k,1840) = lu(k,1840) - lu(k,755) * lu(k,1808) - lu(k,1844) = lu(k,1844) - lu(k,756) * lu(k,1808) - lu(k,1970) = lu(k,1970) - lu(k,752) * lu(k,1947) - lu(k,1977) = lu(k,1977) - lu(k,753) * lu(k,1947) - lu(k,1983) = lu(k,1983) - lu(k,754) * lu(k,1947) - lu(k,1984) = lu(k,1984) - lu(k,755) * lu(k,1947) - lu(k,1988) = lu(k,1988) - lu(k,756) * lu(k,1947) + lu(k,721) = 1._r8 / lu(k,721) + lu(k,722) = lu(k,722) * lu(k,721) + lu(k,723) = lu(k,723) * lu(k,721) + lu(k,724) = lu(k,724) * lu(k,721) + lu(k,725) = lu(k,725) * lu(k,721) + lu(k,726) = lu(k,726) * lu(k,721) + lu(k,735) = lu(k,735) - lu(k,722) * lu(k,731) + lu(k,736) = lu(k,736) - lu(k,723) * lu(k,731) + lu(k,739) = lu(k,739) - lu(k,724) * lu(k,731) + lu(k,740) = lu(k,740) - lu(k,725) * lu(k,731) + lu(k,741) = lu(k,741) - lu(k,726) * lu(k,731) + lu(k,751) = lu(k,751) - lu(k,722) * lu(k,747) + lu(k,752) = lu(k,752) - lu(k,723) * lu(k,747) + lu(k,756) = lu(k,756) - lu(k,724) * lu(k,747) + lu(k,757) = lu(k,757) - lu(k,725) * lu(k,747) + lu(k,758) = lu(k,758) - lu(k,726) * lu(k,747) + lu(k,1660) = lu(k,1660) - lu(k,722) * lu(k,1637) + lu(k,1668) = lu(k,1668) - lu(k,723) * lu(k,1637) + lu(k,1693) = lu(k,1693) - lu(k,724) * lu(k,1637) + lu(k,1694) = lu(k,1694) - lu(k,725) * lu(k,1637) + lu(k,1700) = lu(k,1700) - lu(k,726) * lu(k,1637) + lu(k,1813) = lu(k,1813) - lu(k,722) * lu(k,1798) + lu(k,1819) = lu(k,1819) - lu(k,723) * lu(k,1798) + lu(k,1842) = lu(k,1842) - lu(k,724) * lu(k,1798) + lu(k,1843) = lu(k,1843) - lu(k,725) * lu(k,1798) + lu(k,1849) = lu(k,1849) - lu(k,726) * lu(k,1798) + lu(k,1921) = lu(k,1921) - lu(k,722) * lu(k,1903) + lu(k,1926) = lu(k,1926) - lu(k,723) * lu(k,1903) + lu(k,1949) = lu(k,1949) - lu(k,724) * lu(k,1903) + lu(k,1950) = lu(k,1950) - lu(k,725) * lu(k,1903) + lu(k,1956) = lu(k,1956) - lu(k,726) * lu(k,1903) + lu(k,2179) = - lu(k,722) * lu(k,2172) + lu(k,2180) = - lu(k,723) * lu(k,2172) + lu(k,2194) = lu(k,2194) - lu(k,724) * lu(k,2172) + lu(k,2195) = lu(k,2195) - lu(k,725) * lu(k,2172) + lu(k,2201) = lu(k,2201) - lu(k,726) * lu(k,2172) + lu(k,732) = 1._r8 / lu(k,732) + lu(k,733) = lu(k,733) * lu(k,732) + lu(k,734) = lu(k,734) * lu(k,732) + lu(k,735) = lu(k,735) * lu(k,732) + lu(k,736) = lu(k,736) * lu(k,732) + lu(k,737) = lu(k,737) * lu(k,732) + lu(k,738) = lu(k,738) * lu(k,732) + lu(k,739) = lu(k,739) * lu(k,732) + lu(k,740) = lu(k,740) * lu(k,732) + lu(k,741) = lu(k,741) * lu(k,732) + lu(k,1640) = lu(k,1640) - lu(k,733) * lu(k,1638) + lu(k,1652) = lu(k,1652) - lu(k,734) * lu(k,1638) + lu(k,1660) = lu(k,1660) - lu(k,735) * lu(k,1638) + lu(k,1668) = lu(k,1668) - lu(k,736) * lu(k,1638) + lu(k,1676) = lu(k,1676) - lu(k,737) * lu(k,1638) + lu(k,1691) = lu(k,1691) - lu(k,738) * lu(k,1638) + lu(k,1693) = lu(k,1693) - lu(k,739) * lu(k,1638) + lu(k,1694) = lu(k,1694) - lu(k,740) * lu(k,1638) + lu(k,1700) = lu(k,1700) - lu(k,741) * lu(k,1638) + lu(k,1801) = lu(k,1801) - lu(k,733) * lu(k,1799) + lu(k,1807) = lu(k,1807) - lu(k,734) * lu(k,1799) + lu(k,1813) = lu(k,1813) - lu(k,735) * lu(k,1799) + lu(k,1819) = lu(k,1819) - lu(k,736) * lu(k,1799) + lu(k,1827) = lu(k,1827) - lu(k,737) * lu(k,1799) + lu(k,1840) = lu(k,1840) - lu(k,738) * lu(k,1799) + lu(k,1842) = lu(k,1842) - lu(k,739) * lu(k,1799) + lu(k,1843) = lu(k,1843) - lu(k,740) * lu(k,1799) + lu(k,1849) = lu(k,1849) - lu(k,741) * lu(k,1799) + lu(k,1906) = lu(k,1906) - lu(k,733) * lu(k,1904) + lu(k,1915) = lu(k,1915) - lu(k,734) * lu(k,1904) + lu(k,1921) = lu(k,1921) - lu(k,735) * lu(k,1904) + lu(k,1926) = lu(k,1926) - lu(k,736) * lu(k,1904) + lu(k,1933) = lu(k,1933) - lu(k,737) * lu(k,1904) + lu(k,1947) = lu(k,1947) - lu(k,738) * lu(k,1904) + lu(k,1949) = lu(k,1949) - lu(k,739) * lu(k,1904) + lu(k,1950) = lu(k,1950) - lu(k,740) * lu(k,1904) + lu(k,1956) = lu(k,1956) - lu(k,741) * lu(k,1904) + lu(k,748) = 1._r8 / lu(k,748) + lu(k,749) = lu(k,749) * lu(k,748) + lu(k,750) = lu(k,750) * lu(k,748) + lu(k,751) = lu(k,751) * lu(k,748) + lu(k,752) = lu(k,752) * lu(k,748) + lu(k,753) = lu(k,753) * lu(k,748) + lu(k,754) = lu(k,754) * lu(k,748) + lu(k,755) = lu(k,755) * lu(k,748) + lu(k,756) = lu(k,756) * lu(k,748) + lu(k,757) = lu(k,757) * lu(k,748) + lu(k,758) = lu(k,758) * lu(k,748) + lu(k,1640) = lu(k,1640) - lu(k,749) * lu(k,1639) + lu(k,1652) = lu(k,1652) - lu(k,750) * lu(k,1639) + lu(k,1660) = lu(k,1660) - lu(k,751) * lu(k,1639) + lu(k,1668) = lu(k,1668) - lu(k,752) * lu(k,1639) + lu(k,1676) = lu(k,1676) - lu(k,753) * lu(k,1639) + lu(k,1683) = lu(k,1683) - lu(k,754) * lu(k,1639) + lu(k,1691) = lu(k,1691) - lu(k,755) * lu(k,1639) + lu(k,1693) = lu(k,1693) - lu(k,756) * lu(k,1639) + lu(k,1694) = lu(k,1694) - lu(k,757) * lu(k,1639) + lu(k,1700) = lu(k,1700) - lu(k,758) * lu(k,1639) + lu(k,1801) = lu(k,1801) - lu(k,749) * lu(k,1800) + lu(k,1807) = lu(k,1807) - lu(k,750) * lu(k,1800) + lu(k,1813) = lu(k,1813) - lu(k,751) * lu(k,1800) + lu(k,1819) = lu(k,1819) - lu(k,752) * lu(k,1800) + lu(k,1827) = lu(k,1827) - lu(k,753) * lu(k,1800) + lu(k,1833) = lu(k,1833) - lu(k,754) * lu(k,1800) + lu(k,1840) = lu(k,1840) - lu(k,755) * lu(k,1800) + lu(k,1842) = lu(k,1842) - lu(k,756) * lu(k,1800) + lu(k,1843) = lu(k,1843) - lu(k,757) * lu(k,1800) + lu(k,1849) = lu(k,1849) - lu(k,758) * lu(k,1800) + lu(k,1906) = lu(k,1906) - lu(k,749) * lu(k,1905) + lu(k,1915) = lu(k,1915) - lu(k,750) * lu(k,1905) + lu(k,1921) = lu(k,1921) - lu(k,751) * lu(k,1905) + lu(k,1926) = lu(k,1926) - lu(k,752) * lu(k,1905) + lu(k,1933) = lu(k,1933) - lu(k,753) * lu(k,1905) + lu(k,1939) = lu(k,1939) - lu(k,754) * lu(k,1905) + lu(k,1947) = lu(k,1947) - lu(k,755) * lu(k,1905) + lu(k,1949) = lu(k,1949) - lu(k,756) * lu(k,1905) + lu(k,1950) = lu(k,1950) - lu(k,757) * lu(k,1905) + lu(k,1956) = lu(k,1956) - lu(k,758) * lu(k,1905) + lu(k,759) = 1._r8 / lu(k,759) + lu(k,760) = lu(k,760) * lu(k,759) + lu(k,761) = lu(k,761) * lu(k,759) + lu(k,762) = lu(k,762) * lu(k,759) + lu(k,763) = lu(k,763) * lu(k,759) + lu(k,764) = lu(k,764) * lu(k,759) + lu(k,765) = lu(k,765) * lu(k,759) + lu(k,766) = lu(k,766) * lu(k,759) + lu(k,1668) = lu(k,1668) - lu(k,760) * lu(k,1640) + lu(k,1676) = lu(k,1676) - lu(k,761) * lu(k,1640) + lu(k,1691) = lu(k,1691) - lu(k,762) * lu(k,1640) + lu(k,1693) = lu(k,1693) - lu(k,763) * lu(k,1640) + lu(k,1694) = lu(k,1694) - lu(k,764) * lu(k,1640) + lu(k,1697) = lu(k,1697) - lu(k,765) * lu(k,1640) + lu(k,1700) = lu(k,1700) - lu(k,766) * lu(k,1640) + lu(k,1819) = lu(k,1819) - lu(k,760) * lu(k,1801) + lu(k,1827) = lu(k,1827) - lu(k,761) * lu(k,1801) + lu(k,1840) = lu(k,1840) - lu(k,762) * lu(k,1801) + lu(k,1842) = lu(k,1842) - lu(k,763) * lu(k,1801) + lu(k,1843) = lu(k,1843) - lu(k,764) * lu(k,1801) + lu(k,1846) = lu(k,1846) - lu(k,765) * lu(k,1801) + lu(k,1849) = lu(k,1849) - lu(k,766) * lu(k,1801) + lu(k,1926) = lu(k,1926) - lu(k,760) * lu(k,1906) + lu(k,1933) = lu(k,1933) - lu(k,761) * lu(k,1906) + lu(k,1947) = lu(k,1947) - lu(k,762) * lu(k,1906) + lu(k,1949) = lu(k,1949) - lu(k,763) * lu(k,1906) + lu(k,1950) = lu(k,1950) - lu(k,764) * lu(k,1906) + lu(k,1953) = lu(k,1953) - lu(k,765) * lu(k,1906) + lu(k,1956) = lu(k,1956) - lu(k,766) * lu(k,1906) + lu(k,2180) = lu(k,2180) - lu(k,760) * lu(k,2173) + lu(k,2182) = - lu(k,761) * lu(k,2173) + lu(k,2192) = lu(k,2192) - lu(k,762) * lu(k,2173) + lu(k,2194) = lu(k,2194) - lu(k,763) * lu(k,2173) + lu(k,2195) = lu(k,2195) - lu(k,764) * lu(k,2173) + lu(k,2198) = lu(k,2198) - lu(k,765) * lu(k,2173) + lu(k,2201) = lu(k,2201) - lu(k,766) * lu(k,2173) + lu(k,768) = 1._r8 / lu(k,768) + lu(k,769) = lu(k,769) * lu(k,768) + lu(k,770) = lu(k,770) * lu(k,768) + lu(k,771) = lu(k,771) * lu(k,768) + lu(k,772) = lu(k,772) * lu(k,768) + lu(k,773) = lu(k,773) * lu(k,768) + lu(k,774) = lu(k,774) * lu(k,768) + lu(k,775) = lu(k,775) * lu(k,768) + lu(k,776) = lu(k,776) * lu(k,768) + lu(k,1025) = lu(k,1025) - lu(k,769) * lu(k,1020) + lu(k,1027) = - lu(k,770) * lu(k,1020) + lu(k,1031) = lu(k,1031) - lu(k,771) * lu(k,1020) + lu(k,1032) = lu(k,1032) - lu(k,772) * lu(k,1020) + lu(k,1034) = - lu(k,773) * lu(k,1020) + lu(k,1035) = lu(k,1035) - lu(k,774) * lu(k,1020) + lu(k,1038) = - lu(k,775) * lu(k,1020) + lu(k,1040) = lu(k,1040) - lu(k,776) * lu(k,1020) + lu(k,1666) = lu(k,1666) - lu(k,769) * lu(k,1641) + lu(k,1671) = lu(k,1671) - lu(k,770) * lu(k,1641) + lu(k,1689) = lu(k,1689) - lu(k,771) * lu(k,1641) + lu(k,1691) = lu(k,1691) - lu(k,772) * lu(k,1641) + lu(k,1693) = lu(k,1693) - lu(k,773) * lu(k,1641) + lu(k,1694) = lu(k,1694) - lu(k,774) * lu(k,1641) + lu(k,1700) = lu(k,1700) - lu(k,775) * lu(k,1641) + lu(k,1703) = lu(k,1703) - lu(k,776) * lu(k,1641) + lu(k,1817) = lu(k,1817) - lu(k,769) * lu(k,1802) + lu(k,1822) = lu(k,1822) - lu(k,770) * lu(k,1802) + lu(k,1838) = lu(k,1838) - lu(k,771) * lu(k,1802) + lu(k,1840) = lu(k,1840) - lu(k,772) * lu(k,1802) + lu(k,1842) = lu(k,1842) - lu(k,773) * lu(k,1802) + lu(k,1843) = lu(k,1843) - lu(k,774) * lu(k,1802) + lu(k,1849) = lu(k,1849) - lu(k,775) * lu(k,1802) + lu(k,1852) = - lu(k,776) * lu(k,1802) + lu(k,1924) = lu(k,1924) - lu(k,769) * lu(k,1907) + lu(k,1929) = lu(k,1929) - lu(k,770) * lu(k,1907) + lu(k,1945) = lu(k,1945) - lu(k,771) * lu(k,1907) + lu(k,1947) = lu(k,1947) - lu(k,772) * lu(k,1907) + lu(k,1949) = lu(k,1949) - lu(k,773) * lu(k,1907) + lu(k,1950) = lu(k,1950) - lu(k,774) * lu(k,1907) + lu(k,1956) = lu(k,1956) - lu(k,775) * lu(k,1907) + lu(k,1959) = lu(k,1959) - lu(k,776) * lu(k,1907) end do end subroutine lu_fac16 subroutine lu_fac17( avec_len, lu ) @@ -2711,289 +2510,230 @@ subroutine lu_fac17( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,758) = 1._r8 / lu(k,758) - lu(k,759) = lu(k,759) * lu(k,758) - lu(k,760) = lu(k,760) * lu(k,758) - lu(k,761) = lu(k,761) * lu(k,758) - lu(k,762) = lu(k,762) * lu(k,758) - lu(k,763) = lu(k,763) * lu(k,758) - lu(k,1111) = lu(k,1111) - lu(k,759) * lu(k,1110) - lu(k,1115) = lu(k,1115) - lu(k,760) * lu(k,1110) - lu(k,1119) = - lu(k,761) * lu(k,1110) - lu(k,1120) = lu(k,1120) - lu(k,762) * lu(k,1110) - lu(k,1123) = - lu(k,763) * lu(k,1110) - lu(k,1323) = lu(k,1323) - lu(k,759) * lu(k,1321) - lu(k,1329) = lu(k,1329) - lu(k,760) * lu(k,1321) - lu(k,1335) = lu(k,1335) - lu(k,761) * lu(k,1321) - lu(k,1336) = lu(k,1336) - lu(k,762) * lu(k,1321) - lu(k,1341) = lu(k,1341) - lu(k,763) * lu(k,1321) - lu(k,1495) = lu(k,1495) - lu(k,759) * lu(k,1469) - lu(k,1507) = lu(k,1507) - lu(k,760) * lu(k,1469) - lu(k,1513) = lu(k,1513) - lu(k,761) * lu(k,1469) - lu(k,1514) = lu(k,1514) - lu(k,762) * lu(k,1469) - lu(k,1519) = lu(k,1519) - lu(k,763) * lu(k,1469) - lu(k,1540) = lu(k,1540) - lu(k,759) * lu(k,1533) - lu(k,1548) = lu(k,1548) - lu(k,760) * lu(k,1533) - lu(k,1554) = lu(k,1554) - lu(k,761) * lu(k,1533) - lu(k,1555) = lu(k,1555) - lu(k,762) * lu(k,1533) - lu(k,1560) = lu(k,1560) - lu(k,763) * lu(k,1533) - lu(k,1706) = lu(k,1706) - lu(k,759) * lu(k,1705) - lu(k,1712) = lu(k,1712) - lu(k,760) * lu(k,1705) - lu(k,1718) = lu(k,1718) - lu(k,761) * lu(k,1705) - lu(k,1719) = lu(k,1719) - lu(k,762) * lu(k,1705) - lu(k,1724) = lu(k,1724) - lu(k,763) * lu(k,1705) - lu(k,1863) = lu(k,1863) - lu(k,759) * lu(k,1859) - lu(k,1869) = lu(k,1869) - lu(k,760) * lu(k,1859) - lu(k,1875) = lu(k,1875) - lu(k,761) * lu(k,1859) - lu(k,1876) = lu(k,1876) - lu(k,762) * lu(k,1859) - lu(k,1881) = lu(k,1881) - lu(k,763) * lu(k,1859) - lu(k,1971) = - lu(k,759) * lu(k,1948) - lu(k,1983) = lu(k,1983) - lu(k,760) * lu(k,1948) - lu(k,1989) = lu(k,1989) - lu(k,761) * lu(k,1948) - lu(k,1990) = lu(k,1990) - lu(k,762) * lu(k,1948) - lu(k,1995) = lu(k,1995) - lu(k,763) * lu(k,1948) - lu(k,2031) = lu(k,2031) - lu(k,759) * lu(k,2011) - lu(k,2043) = lu(k,2043) - lu(k,760) * lu(k,2011) - lu(k,2049) = lu(k,2049) - lu(k,761) * lu(k,2011) - lu(k,2050) = lu(k,2050) - lu(k,762) * lu(k,2011) - lu(k,2055) = lu(k,2055) - lu(k,763) * lu(k,2011) - lu(k,2062) = - lu(k,759) * lu(k,2060) - lu(k,2068) = lu(k,2068) - lu(k,760) * lu(k,2060) - lu(k,2074) = - lu(k,761) * lu(k,2060) - lu(k,2075) = lu(k,2075) - lu(k,762) * lu(k,2060) - lu(k,2080) = lu(k,2080) - lu(k,763) * lu(k,2060) - lu(k,765) = 1._r8 / lu(k,765) - lu(k,766) = lu(k,766) * lu(k,765) - lu(k,767) = lu(k,767) * lu(k,765) - lu(k,768) = lu(k,768) * lu(k,765) - lu(k,771) = lu(k,771) - lu(k,766) * lu(k,769) - lu(k,773) = lu(k,773) - lu(k,767) * lu(k,769) - lu(k,777) = lu(k,777) - lu(k,768) * lu(k,769) - lu(k,793) = lu(k,793) - lu(k,766) * lu(k,787) - lu(k,799) = lu(k,799) - lu(k,767) * lu(k,787) - lu(k,801) = lu(k,801) - lu(k,768) * lu(k,787) - lu(k,820) = lu(k,820) - lu(k,766) * lu(k,814) - lu(k,826) = lu(k,826) - lu(k,767) * lu(k,814) - lu(k,828) = lu(k,828) - lu(k,768) * lu(k,814) - lu(k,897) = lu(k,897) - lu(k,766) * lu(k,894) - lu(k,901) = lu(k,901) - lu(k,767) * lu(k,894) - lu(k,906) = lu(k,906) - lu(k,768) * lu(k,894) - lu(k,909) = lu(k,909) - lu(k,766) * lu(k,907) - lu(k,910) = lu(k,910) - lu(k,767) * lu(k,907) - lu(k,912) = lu(k,912) - lu(k,768) * lu(k,907) - lu(k,1050) = lu(k,1050) - lu(k,766) * lu(k,1048) - lu(k,1056) = lu(k,1056) - lu(k,767) * lu(k,1048) - lu(k,1061) = lu(k,1061) - lu(k,768) * lu(k,1048) - lu(k,1135) = lu(k,1135) - lu(k,766) * lu(k,1131) - lu(k,1149) = lu(k,1149) - lu(k,767) * lu(k,1131) - lu(k,1154) = lu(k,1154) - lu(k,768) * lu(k,1131) - lu(k,1253) = lu(k,1253) - lu(k,766) * lu(k,1250) - lu(k,1267) = lu(k,1267) - lu(k,767) * lu(k,1250) - lu(k,1272) = lu(k,1272) - lu(k,768) * lu(k,1250) - lu(k,1483) = lu(k,1483) - lu(k,766) * lu(k,1470) - lu(k,1507) = lu(k,1507) - lu(k,767) * lu(k,1470) - lu(k,1513) = lu(k,1513) - lu(k,768) * lu(k,1470) - lu(k,1537) = lu(k,1537) - lu(k,766) * lu(k,1534) - lu(k,1548) = lu(k,1548) - lu(k,767) * lu(k,1534) - lu(k,1554) = lu(k,1554) - lu(k,768) * lu(k,1534) - lu(k,1616) = lu(k,1616) - lu(k,766) * lu(k,1607) - lu(k,1638) = lu(k,1638) - lu(k,767) * lu(k,1607) - lu(k,1644) = lu(k,1644) - lu(k,768) * lu(k,1607) - lu(k,1667) = lu(k,1667) - lu(k,766) * lu(k,1661) - lu(k,1688) = lu(k,1688) - lu(k,767) * lu(k,1661) - lu(k,1694) = lu(k,1694) - lu(k,768) * lu(k,1661) - lu(k,1816) = lu(k,1816) - lu(k,766) * lu(k,1809) - lu(k,1839) = lu(k,1839) - lu(k,767) * lu(k,1809) - lu(k,1845) = lu(k,1845) - lu(k,768) * lu(k,1809) - lu(k,1917) = lu(k,1917) - lu(k,766) * lu(k,1914) - lu(k,1926) = lu(k,1926) - lu(k,767) * lu(k,1914) - lu(k,1932) = lu(k,1932) - lu(k,768) * lu(k,1914) - lu(k,1960) = lu(k,1960) - lu(k,766) * lu(k,1949) - lu(k,1983) = lu(k,1983) - lu(k,767) * lu(k,1949) - lu(k,1989) = lu(k,1989) - lu(k,768) * lu(k,1949) - lu(k,2021) = lu(k,2021) - lu(k,766) * lu(k,2012) - lu(k,2043) = lu(k,2043) - lu(k,767) * lu(k,2012) - lu(k,2049) = lu(k,2049) - lu(k,768) * lu(k,2012) - lu(k,770) = 1._r8 / lu(k,770) - lu(k,771) = lu(k,771) * lu(k,770) - lu(k,772) = lu(k,772) * lu(k,770) - lu(k,773) = lu(k,773) * lu(k,770) - lu(k,774) = lu(k,774) * lu(k,770) - lu(k,775) = lu(k,775) * lu(k,770) - lu(k,776) = lu(k,776) * lu(k,770) - lu(k,777) = lu(k,777) * lu(k,770) - lu(k,897) = lu(k,897) - lu(k,771) * lu(k,895) - lu(k,898) = lu(k,898) - lu(k,772) * lu(k,895) - lu(k,901) = lu(k,901) - lu(k,773) * lu(k,895) - lu(k,902) = lu(k,902) - lu(k,774) * lu(k,895) - lu(k,903) = - lu(k,775) * lu(k,895) - lu(k,904) = - lu(k,776) * lu(k,895) - lu(k,906) = lu(k,906) - lu(k,777) * lu(k,895) - lu(k,1135) = lu(k,1135) - lu(k,771) * lu(k,1132) - lu(k,1141) = lu(k,1141) - lu(k,772) * lu(k,1132) - lu(k,1149) = lu(k,1149) - lu(k,773) * lu(k,1132) - lu(k,1150) = lu(k,1150) - lu(k,774) * lu(k,1132) - lu(k,1151) = lu(k,1151) - lu(k,775) * lu(k,1132) - lu(k,1152) = lu(k,1152) - lu(k,776) * lu(k,1132) - lu(k,1154) = lu(k,1154) - lu(k,777) * lu(k,1132) - lu(k,1483) = lu(k,1483) - lu(k,771) * lu(k,1471) - lu(k,1494) = lu(k,1494) - lu(k,772) * lu(k,1471) - lu(k,1507) = lu(k,1507) - lu(k,773) * lu(k,1471) - lu(k,1508) = lu(k,1508) - lu(k,774) * lu(k,1471) - lu(k,1509) = lu(k,1509) - lu(k,775) * lu(k,1471) - lu(k,1510) = lu(k,1510) - lu(k,776) * lu(k,1471) - lu(k,1513) = lu(k,1513) - lu(k,777) * lu(k,1471) - lu(k,1537) = lu(k,1537) - lu(k,771) * lu(k,1535) - lu(k,1539) = lu(k,1539) - lu(k,772) * lu(k,1535) - lu(k,1548) = lu(k,1548) - lu(k,773) * lu(k,1535) - lu(k,1549) = lu(k,1549) - lu(k,774) * lu(k,1535) - lu(k,1550) = lu(k,1550) - lu(k,775) * lu(k,1535) - lu(k,1551) = lu(k,1551) - lu(k,776) * lu(k,1535) - lu(k,1554) = lu(k,1554) - lu(k,777) * lu(k,1535) - lu(k,1616) = lu(k,1616) - lu(k,771) * lu(k,1608) - lu(k,1626) = lu(k,1626) - lu(k,772) * lu(k,1608) - lu(k,1638) = lu(k,1638) - lu(k,773) * lu(k,1608) - lu(k,1639) = lu(k,1639) - lu(k,774) * lu(k,1608) - lu(k,1640) = lu(k,1640) - lu(k,775) * lu(k,1608) - lu(k,1641) = lu(k,1641) - lu(k,776) * lu(k,1608) - lu(k,1644) = lu(k,1644) - lu(k,777) * lu(k,1608) - lu(k,1816) = lu(k,1816) - lu(k,771) * lu(k,1810) - lu(k,1827) = lu(k,1827) - lu(k,772) * lu(k,1810) - lu(k,1839) = lu(k,1839) - lu(k,773) * lu(k,1810) - lu(k,1840) = lu(k,1840) - lu(k,774) * lu(k,1810) - lu(k,1841) = lu(k,1841) - lu(k,775) * lu(k,1810) - lu(k,1842) = lu(k,1842) - lu(k,776) * lu(k,1810) - lu(k,1845) = lu(k,1845) - lu(k,777) * lu(k,1810) - lu(k,788) = 1._r8 / lu(k,788) - lu(k,789) = lu(k,789) * lu(k,788) - lu(k,790) = lu(k,790) * lu(k,788) - lu(k,791) = lu(k,791) * lu(k,788) - lu(k,792) = lu(k,792) * lu(k,788) - lu(k,793) = lu(k,793) * lu(k,788) - lu(k,794) = lu(k,794) * lu(k,788) - lu(k,795) = lu(k,795) * lu(k,788) - lu(k,796) = lu(k,796) * lu(k,788) - lu(k,797) = lu(k,797) * lu(k,788) - lu(k,798) = lu(k,798) * lu(k,788) - lu(k,799) = lu(k,799) * lu(k,788) - lu(k,800) = lu(k,800) * lu(k,788) - lu(k,801) = lu(k,801) * lu(k,788) - lu(k,802) = lu(k,802) * lu(k,788) - lu(k,803) = lu(k,803) * lu(k,788) - lu(k,804) = lu(k,804) * lu(k,788) - lu(k,1474) = lu(k,1474) - lu(k,789) * lu(k,1472) - lu(k,1475) = lu(k,1475) - lu(k,790) * lu(k,1472) - lu(k,1478) = lu(k,1478) - lu(k,791) * lu(k,1472) - lu(k,1482) = lu(k,1482) - lu(k,792) * lu(k,1472) - lu(k,1483) = lu(k,1483) - lu(k,793) * lu(k,1472) - lu(k,1485) = lu(k,1485) - lu(k,794) * lu(k,1472) - lu(k,1487) = lu(k,1487) - lu(k,795) * lu(k,1472) - lu(k,1488) = lu(k,1488) - lu(k,796) * lu(k,1472) - lu(k,1494) = lu(k,1494) - lu(k,797) * lu(k,1472) - lu(k,1501) = lu(k,1501) - lu(k,798) * lu(k,1472) - lu(k,1507) = lu(k,1507) - lu(k,799) * lu(k,1472) - lu(k,1512) = lu(k,1512) - lu(k,800) * lu(k,1472) - lu(k,1513) = lu(k,1513) - lu(k,801) * lu(k,1472) - lu(k,1517) = lu(k,1517) - lu(k,802) * lu(k,1472) - lu(k,1518) = lu(k,1518) - lu(k,803) * lu(k,1472) - lu(k,1519) = lu(k,1519) - lu(k,804) * lu(k,1472) - lu(k,1952) = - lu(k,789) * lu(k,1950) - lu(k,1953) = lu(k,1953) - lu(k,790) * lu(k,1950) - lu(k,1955) = lu(k,1955) - lu(k,791) * lu(k,1950) - lu(k,1959) = - lu(k,792) * lu(k,1950) - lu(k,1960) = lu(k,1960) - lu(k,793) * lu(k,1950) - lu(k,1962) = - lu(k,794) * lu(k,1950) - lu(k,1964) = lu(k,1964) - lu(k,795) * lu(k,1950) - lu(k,1965) = - lu(k,796) * lu(k,1950) - lu(k,1970) = lu(k,1970) - lu(k,797) * lu(k,1950) - lu(k,1977) = lu(k,1977) - lu(k,798) * lu(k,1950) - lu(k,1983) = lu(k,1983) - lu(k,799) * lu(k,1950) - lu(k,1988) = lu(k,1988) - lu(k,800) * lu(k,1950) - lu(k,1989) = lu(k,1989) - lu(k,801) * lu(k,1950) - lu(k,1993) = lu(k,1993) - lu(k,802) * lu(k,1950) - lu(k,1994) = lu(k,1994) - lu(k,803) * lu(k,1950) - lu(k,1995) = lu(k,1995) - lu(k,804) * lu(k,1950) - lu(k,2015) = lu(k,2015) - lu(k,789) * lu(k,2013) - lu(k,2016) = lu(k,2016) - lu(k,790) * lu(k,2013) - lu(k,2018) = lu(k,2018) - lu(k,791) * lu(k,2013) - lu(k,2020) = lu(k,2020) - lu(k,792) * lu(k,2013) - lu(k,2021) = lu(k,2021) - lu(k,793) * lu(k,2013) - lu(k,2023) = - lu(k,794) * lu(k,2013) - lu(k,2025) = - lu(k,795) * lu(k,2013) - lu(k,2026) = lu(k,2026) - lu(k,796) * lu(k,2013) - lu(k,2030) = lu(k,2030) - lu(k,797) * lu(k,2013) - lu(k,2037) = lu(k,2037) - lu(k,798) * lu(k,2013) - lu(k,2043) = lu(k,2043) - lu(k,799) * lu(k,2013) - lu(k,2048) = lu(k,2048) - lu(k,800) * lu(k,2013) - lu(k,2049) = lu(k,2049) - lu(k,801) * lu(k,2013) - lu(k,2053) = lu(k,2053) - lu(k,802) * lu(k,2013) - lu(k,2054) = lu(k,2054) - lu(k,803) * lu(k,2013) - lu(k,2055) = lu(k,2055) - lu(k,804) * lu(k,2013) - lu(k,815) = 1._r8 / lu(k,815) - lu(k,816) = lu(k,816) * lu(k,815) - lu(k,817) = lu(k,817) * lu(k,815) - lu(k,818) = lu(k,818) * lu(k,815) - lu(k,819) = lu(k,819) * lu(k,815) - lu(k,820) = lu(k,820) * lu(k,815) - lu(k,821) = lu(k,821) * lu(k,815) - lu(k,822) = lu(k,822) * lu(k,815) - lu(k,823) = lu(k,823) * lu(k,815) - lu(k,824) = lu(k,824) * lu(k,815) - lu(k,825) = lu(k,825) * lu(k,815) - lu(k,826) = lu(k,826) * lu(k,815) - lu(k,827) = lu(k,827) * lu(k,815) - lu(k,828) = lu(k,828) * lu(k,815) - lu(k,829) = lu(k,829) * lu(k,815) - lu(k,830) = lu(k,830) * lu(k,815) - lu(k,831) = lu(k,831) * lu(k,815) - lu(k,1474) = lu(k,1474) - lu(k,816) * lu(k,1473) - lu(k,1475) = lu(k,1475) - lu(k,817) * lu(k,1473) - lu(k,1478) = lu(k,1478) - lu(k,818) * lu(k,1473) - lu(k,1482) = lu(k,1482) - lu(k,819) * lu(k,1473) - lu(k,1483) = lu(k,1483) - lu(k,820) * lu(k,1473) - lu(k,1485) = lu(k,1485) - lu(k,821) * lu(k,1473) - lu(k,1487) = lu(k,1487) - lu(k,822) * lu(k,1473) - lu(k,1488) = lu(k,1488) - lu(k,823) * lu(k,1473) - lu(k,1494) = lu(k,1494) - lu(k,824) * lu(k,1473) - lu(k,1501) = lu(k,1501) - lu(k,825) * lu(k,1473) - lu(k,1507) = lu(k,1507) - lu(k,826) * lu(k,1473) - lu(k,1512) = lu(k,1512) - lu(k,827) * lu(k,1473) - lu(k,1513) = lu(k,1513) - lu(k,828) * lu(k,1473) - lu(k,1517) = lu(k,1517) - lu(k,829) * lu(k,1473) - lu(k,1518) = lu(k,1518) - lu(k,830) * lu(k,1473) - lu(k,1519) = lu(k,1519) - lu(k,831) * lu(k,1473) - lu(k,1952) = lu(k,1952) - lu(k,816) * lu(k,1951) - lu(k,1953) = lu(k,1953) - lu(k,817) * lu(k,1951) - lu(k,1955) = lu(k,1955) - lu(k,818) * lu(k,1951) - lu(k,1959) = lu(k,1959) - lu(k,819) * lu(k,1951) - lu(k,1960) = lu(k,1960) - lu(k,820) * lu(k,1951) - lu(k,1962) = lu(k,1962) - lu(k,821) * lu(k,1951) - lu(k,1964) = lu(k,1964) - lu(k,822) * lu(k,1951) - lu(k,1965) = lu(k,1965) - lu(k,823) * lu(k,1951) - lu(k,1970) = lu(k,1970) - lu(k,824) * lu(k,1951) - lu(k,1977) = lu(k,1977) - lu(k,825) * lu(k,1951) - lu(k,1983) = lu(k,1983) - lu(k,826) * lu(k,1951) - lu(k,1988) = lu(k,1988) - lu(k,827) * lu(k,1951) - lu(k,1989) = lu(k,1989) - lu(k,828) * lu(k,1951) - lu(k,1993) = lu(k,1993) - lu(k,829) * lu(k,1951) - lu(k,1994) = lu(k,1994) - lu(k,830) * lu(k,1951) - lu(k,1995) = lu(k,1995) - lu(k,831) * lu(k,1951) - lu(k,2015) = lu(k,2015) - lu(k,816) * lu(k,2014) - lu(k,2016) = lu(k,2016) - lu(k,817) * lu(k,2014) - lu(k,2018) = lu(k,2018) - lu(k,818) * lu(k,2014) - lu(k,2020) = lu(k,2020) - lu(k,819) * lu(k,2014) - lu(k,2021) = lu(k,2021) - lu(k,820) * lu(k,2014) - lu(k,2023) = lu(k,2023) - lu(k,821) * lu(k,2014) - lu(k,2025) = lu(k,2025) - lu(k,822) * lu(k,2014) - lu(k,2026) = lu(k,2026) - lu(k,823) * lu(k,2014) - lu(k,2030) = lu(k,2030) - lu(k,824) * lu(k,2014) - lu(k,2037) = lu(k,2037) - lu(k,825) * lu(k,2014) - lu(k,2043) = lu(k,2043) - lu(k,826) * lu(k,2014) - lu(k,2048) = lu(k,2048) - lu(k,827) * lu(k,2014) - lu(k,2049) = lu(k,2049) - lu(k,828) * lu(k,2014) - lu(k,2053) = lu(k,2053) - lu(k,829) * lu(k,2014) - lu(k,2054) = lu(k,2054) - lu(k,830) * lu(k,2014) - lu(k,2055) = lu(k,2055) - lu(k,831) * lu(k,2014) + lu(k,778) = 1._r8 / lu(k,778) + lu(k,779) = lu(k,779) * lu(k,778) + lu(k,780) = lu(k,780) * lu(k,778) + lu(k,781) = lu(k,781) * lu(k,778) + lu(k,782) = lu(k,782) * lu(k,778) + lu(k,783) = lu(k,783) * lu(k,778) + lu(k,784) = lu(k,784) * lu(k,778) + lu(k,785) = lu(k,785) * lu(k,778) + lu(k,1941) = lu(k,1941) - lu(k,779) * lu(k,1908) + lu(k,1947) = lu(k,1947) - lu(k,780) * lu(k,1908) + lu(k,1952) = lu(k,1952) - lu(k,781) * lu(k,1908) + lu(k,1955) = lu(k,1955) - lu(k,782) * lu(k,1908) + lu(k,1957) = lu(k,1957) - lu(k,783) * lu(k,1908) + lu(k,1958) = lu(k,1958) - lu(k,784) * lu(k,1908) + lu(k,1959) = lu(k,1959) - lu(k,785) * lu(k,1908) + lu(k,2143) = lu(k,2143) - lu(k,779) * lu(k,2140) + lu(k,2148) = lu(k,2148) - lu(k,780) * lu(k,2140) + lu(k,2153) = lu(k,2153) - lu(k,781) * lu(k,2140) + lu(k,2156) = lu(k,2156) - lu(k,782) * lu(k,2140) + lu(k,2158) = - lu(k,783) * lu(k,2140) + lu(k,2159) = lu(k,2159) - lu(k,784) * lu(k,2140) + lu(k,2160) = lu(k,2160) - lu(k,785) * lu(k,2140) + lu(k,2186) = lu(k,2186) - lu(k,779) * lu(k,2174) + lu(k,2192) = lu(k,2192) - lu(k,780) * lu(k,2174) + lu(k,2197) = - lu(k,781) * lu(k,2174) + lu(k,2200) = - lu(k,782) * lu(k,2174) + lu(k,2202) = lu(k,2202) - lu(k,783) * lu(k,2174) + lu(k,2203) = lu(k,2203) - lu(k,784) * lu(k,2174) + lu(k,2204) = lu(k,2204) - lu(k,785) * lu(k,2174) + lu(k,2211) = lu(k,2211) - lu(k,779) * lu(k,2208) + lu(k,2216) = lu(k,2216) - lu(k,780) * lu(k,2208) + lu(k,2221) = lu(k,2221) - lu(k,781) * lu(k,2208) + lu(k,2224) = - lu(k,782) * lu(k,2208) + lu(k,2226) = lu(k,2226) - lu(k,783) * lu(k,2208) + lu(k,2227) = lu(k,2227) - lu(k,784) * lu(k,2208) + lu(k,2228) = - lu(k,785) * lu(k,2208) + lu(k,2241) = lu(k,2241) - lu(k,779) * lu(k,2233) + lu(k,2247) = lu(k,2247) - lu(k,780) * lu(k,2233) + lu(k,2252) = lu(k,2252) - lu(k,781) * lu(k,2233) + lu(k,2255) = lu(k,2255) - lu(k,782) * lu(k,2233) + lu(k,2257) = lu(k,2257) - lu(k,783) * lu(k,2233) + lu(k,2258) = lu(k,2258) - lu(k,784) * lu(k,2233) + lu(k,2259) = lu(k,2259) - lu(k,785) * lu(k,2233) + lu(k,786) = 1._r8 / lu(k,786) + lu(k,787) = lu(k,787) * lu(k,786) + lu(k,788) = lu(k,788) * lu(k,786) + lu(k,789) = lu(k,789) * lu(k,786) + lu(k,817) = lu(k,817) - lu(k,787) * lu(k,814) + lu(k,818) = lu(k,818) - lu(k,788) * lu(k,814) + lu(k,820) = lu(k,820) - lu(k,789) * lu(k,814) + lu(k,916) = lu(k,916) - lu(k,787) * lu(k,911) + lu(k,917) = lu(k,917) - lu(k,788) * lu(k,911) + lu(k,919) = lu(k,919) - lu(k,789) * lu(k,911) + lu(k,1050) = lu(k,1050) - lu(k,787) * lu(k,1043) + lu(k,1051) = lu(k,1051) - lu(k,788) * lu(k,1043) + lu(k,1054) = lu(k,1054) - lu(k,789) * lu(k,1043) + lu(k,1119) = lu(k,1119) - lu(k,787) * lu(k,1109) + lu(k,1120) = lu(k,1120) - lu(k,788) * lu(k,1109) + lu(k,1122) = lu(k,1122) - lu(k,789) * lu(k,1109) + lu(k,1133) = lu(k,1133) - lu(k,787) * lu(k,1128) + lu(k,1134) = lu(k,1134) - lu(k,788) * lu(k,1128) + lu(k,1136) = lu(k,1136) - lu(k,789) * lu(k,1128) + lu(k,1176) = lu(k,1176) - lu(k,787) * lu(k,1167) + lu(k,1177) = lu(k,1177) - lu(k,788) * lu(k,1167) + lu(k,1180) = lu(k,1180) - lu(k,789) * lu(k,1167) + lu(k,1199) = lu(k,1199) - lu(k,787) * lu(k,1187) + lu(k,1200) = lu(k,1200) - lu(k,788) * lu(k,1187) + lu(k,1203) = lu(k,1203) - lu(k,789) * lu(k,1187) + lu(k,1262) = lu(k,1262) - lu(k,787) * lu(k,1247) + lu(k,1263) = lu(k,1263) - lu(k,788) * lu(k,1247) + lu(k,1266) = lu(k,1266) - lu(k,789) * lu(k,1247) + lu(k,1294) = lu(k,1294) - lu(k,787) * lu(k,1277) + lu(k,1295) = lu(k,1295) - lu(k,788) * lu(k,1277) + lu(k,1298) = lu(k,1298) - lu(k,789) * lu(k,1277) + lu(k,1315) = lu(k,1315) - lu(k,787) * lu(k,1305) + lu(k,1316) = lu(k,1316) - lu(k,788) * lu(k,1305) + lu(k,1319) = lu(k,1319) - lu(k,789) * lu(k,1305) + lu(k,1689) = lu(k,1689) - lu(k,787) * lu(k,1642) + lu(k,1691) = lu(k,1691) - lu(k,788) * lu(k,1642) + lu(k,1694) = lu(k,1694) - lu(k,789) * lu(k,1642) + lu(k,2062) = lu(k,2062) - lu(k,787) * lu(k,2031) + lu(k,2064) = lu(k,2064) - lu(k,788) * lu(k,2031) + lu(k,2067) = lu(k,2067) - lu(k,789) * lu(k,2031) + lu(k,791) = 1._r8 / lu(k,791) + lu(k,792) = lu(k,792) * lu(k,791) + lu(k,793) = lu(k,793) * lu(k,791) + lu(k,794) = lu(k,794) * lu(k,791) + lu(k,795) = lu(k,795) * lu(k,791) + lu(k,796) = lu(k,796) * lu(k,791) + lu(k,797) = lu(k,797) * lu(k,791) + lu(k,798) = lu(k,798) * lu(k,791) + lu(k,799) = lu(k,799) * lu(k,791) + lu(k,800) = lu(k,800) * lu(k,791) + lu(k,1656) = lu(k,1656) - lu(k,792) * lu(k,1643) + lu(k,1666) = lu(k,1666) - lu(k,793) * lu(k,1643) + lu(k,1689) = lu(k,1689) - lu(k,794) * lu(k,1643) + lu(k,1691) = lu(k,1691) - lu(k,795) * lu(k,1643) + lu(k,1693) = lu(k,1693) - lu(k,796) * lu(k,1643) + lu(k,1694) = lu(k,1694) - lu(k,797) * lu(k,1643) + lu(k,1697) = lu(k,1697) - lu(k,798) * lu(k,1643) + lu(k,1700) = lu(k,1700) - lu(k,799) * lu(k,1643) + lu(k,1703) = lu(k,1703) - lu(k,800) * lu(k,1643) + lu(k,1810) = lu(k,1810) - lu(k,792) * lu(k,1803) + lu(k,1817) = lu(k,1817) - lu(k,793) * lu(k,1803) + lu(k,1838) = lu(k,1838) - lu(k,794) * lu(k,1803) + lu(k,1840) = lu(k,1840) - lu(k,795) * lu(k,1803) + lu(k,1842) = lu(k,1842) - lu(k,796) * lu(k,1803) + lu(k,1843) = lu(k,1843) - lu(k,797) * lu(k,1803) + lu(k,1846) = lu(k,1846) - lu(k,798) * lu(k,1803) + lu(k,1849) = lu(k,1849) - lu(k,799) * lu(k,1803) + lu(k,1852) = lu(k,1852) - lu(k,800) * lu(k,1803) + lu(k,1918) = lu(k,1918) - lu(k,792) * lu(k,1909) + lu(k,1924) = lu(k,1924) - lu(k,793) * lu(k,1909) + lu(k,1945) = lu(k,1945) - lu(k,794) * lu(k,1909) + lu(k,1947) = lu(k,1947) - lu(k,795) * lu(k,1909) + lu(k,1949) = lu(k,1949) - lu(k,796) * lu(k,1909) + lu(k,1950) = lu(k,1950) - lu(k,797) * lu(k,1909) + lu(k,1953) = lu(k,1953) - lu(k,798) * lu(k,1909) + lu(k,1956) = lu(k,1956) - lu(k,799) * lu(k,1909) + lu(k,1959) = lu(k,1959) - lu(k,800) * lu(k,1909) + lu(k,2037) = lu(k,2037) - lu(k,792) * lu(k,2032) + lu(k,2043) = lu(k,2043) - lu(k,793) * lu(k,2032) + lu(k,2062) = lu(k,2062) - lu(k,794) * lu(k,2032) + lu(k,2064) = lu(k,2064) - lu(k,795) * lu(k,2032) + lu(k,2066) = lu(k,2066) - lu(k,796) * lu(k,2032) + lu(k,2067) = lu(k,2067) - lu(k,797) * lu(k,2032) + lu(k,2070) = lu(k,2070) - lu(k,798) * lu(k,2032) + lu(k,2073) = lu(k,2073) - lu(k,799) * lu(k,2032) + lu(k,2076) = lu(k,2076) - lu(k,800) * lu(k,2032) + lu(k,801) = 1._r8 / lu(k,801) + lu(k,802) = lu(k,802) * lu(k,801) + lu(k,803) = lu(k,803) * lu(k,801) + lu(k,930) = - lu(k,802) * lu(k,928) + lu(k,933) = - lu(k,803) * lu(k,928) + lu(k,954) = lu(k,954) - lu(k,802) * lu(k,943) + lu(k,967) = - lu(k,803) * lu(k,943) + lu(k,980) = lu(k,980) - lu(k,802) * lu(k,978) + lu(k,983) = - lu(k,803) * lu(k,978) + lu(k,1003) = lu(k,1003) - lu(k,802) * lu(k,992) + lu(k,1017) = - lu(k,803) * lu(k,992) + lu(k,1026) = lu(k,1026) - lu(k,802) * lu(k,1021) + lu(k,1039) = - lu(k,803) * lu(k,1021) + lu(k,1060) = lu(k,1060) - lu(k,802) * lu(k,1057) + lu(k,1067) = - lu(k,803) * lu(k,1057) + lu(k,1097) = lu(k,1097) - lu(k,802) * lu(k,1094) + lu(k,1101) = - lu(k,803) * lu(k,1094) + lu(k,1103) = lu(k,1103) - lu(k,802) * lu(k,1102) + lu(k,1106) = - lu(k,803) * lu(k,1102) + lu(k,1114) = lu(k,1114) - lu(k,802) * lu(k,1110) + lu(k,1125) = - lu(k,803) * lu(k,1110) + lu(k,1171) = lu(k,1171) - lu(k,802) * lu(k,1168) + lu(k,1183) = - lu(k,803) * lu(k,1168) + lu(k,1250) = - lu(k,802) * lu(k,1248) + lu(k,1270) = - lu(k,803) * lu(k,1248) + lu(k,1328) = lu(k,1328) - lu(k,802) * lu(k,1324) + lu(k,1345) = - lu(k,803) * lu(k,1324) + lu(k,1351) = - lu(k,802) * lu(k,1350) + lu(k,1365) = - lu(k,803) * lu(k,1350) + lu(k,1375) = lu(k,1375) - lu(k,802) * lu(k,1371) + lu(k,1397) = - lu(k,803) * lu(k,1371) + lu(k,1428) = lu(k,1428) - lu(k,802) * lu(k,1426) + lu(k,1441) = lu(k,1441) - lu(k,803) * lu(k,1426) + lu(k,1668) = lu(k,1668) - lu(k,802) * lu(k,1644) + lu(k,1702) = lu(k,1702) - lu(k,803) * lu(k,1644) + lu(k,1819) = lu(k,1819) - lu(k,802) * lu(k,1804) + lu(k,1851) = lu(k,1851) - lu(k,803) * lu(k,1804) + lu(k,1926) = lu(k,1926) - lu(k,802) * lu(k,1910) + lu(k,1958) = lu(k,1958) - lu(k,803) * lu(k,1910) + lu(k,2045) = lu(k,2045) - lu(k,802) * lu(k,2033) + lu(k,2075) = - lu(k,803) * lu(k,2033) + lu(k,2105) = lu(k,2105) - lu(k,802) * lu(k,2090) + lu(k,2136) = lu(k,2136) - lu(k,803) * lu(k,2090) + lu(k,2180) = lu(k,2180) - lu(k,802) * lu(k,2175) + lu(k,2203) = lu(k,2203) - lu(k,803) * lu(k,2175) + lu(k,804) = 1._r8 / lu(k,804) + lu(k,805) = lu(k,805) * lu(k,804) + lu(k,806) = lu(k,806) * lu(k,804) + lu(k,807) = lu(k,807) * lu(k,804) + lu(k,808) = lu(k,808) * lu(k,804) + lu(k,809) = lu(k,809) * lu(k,804) + lu(k,810) = lu(k,810) * lu(k,804) + lu(k,811) = lu(k,811) * lu(k,804) + lu(k,1415) = lu(k,1415) - lu(k,805) * lu(k,1413) + lu(k,1416) = - lu(k,806) * lu(k,1413) + lu(k,1418) = - lu(k,807) * lu(k,1413) + lu(k,1419) = - lu(k,808) * lu(k,1413) + lu(k,1422) = lu(k,1422) - lu(k,809) * lu(k,1413) + lu(k,1423) = - lu(k,810) * lu(k,1413) + lu(k,1424) = - lu(k,811) * lu(k,1413) + lu(k,1481) = lu(k,1481) - lu(k,805) * lu(k,1477) + lu(k,1484) = lu(k,1484) - lu(k,806) * lu(k,1477) + lu(k,1486) = - lu(k,807) * lu(k,1477) + lu(k,1487) = lu(k,1487) - lu(k,808) * lu(k,1477) + lu(k,1496) = - lu(k,809) * lu(k,1477) + lu(k,1497) = lu(k,1497) - lu(k,810) * lu(k,1477) + lu(k,1498) = lu(k,1498) - lu(k,811) * lu(k,1477) + lu(k,1521) = lu(k,1521) - lu(k,805) * lu(k,1518) + lu(k,1524) = lu(k,1524) - lu(k,806) * lu(k,1518) + lu(k,1526) = lu(k,1526) - lu(k,807) * lu(k,1518) + lu(k,1527) = lu(k,1527) - lu(k,808) * lu(k,1518) + lu(k,1537) = lu(k,1537) - lu(k,809) * lu(k,1518) + lu(k,1538) = lu(k,1538) - lu(k,810) * lu(k,1518) + lu(k,1539) = lu(k,1539) - lu(k,811) * lu(k,1518) + lu(k,1685) = lu(k,1685) - lu(k,805) * lu(k,1645) + lu(k,1688) = lu(k,1688) - lu(k,806) * lu(k,1645) + lu(k,1690) = lu(k,1690) - lu(k,807) * lu(k,1645) + lu(k,1691) = lu(k,1691) - lu(k,808) * lu(k,1645) + lu(k,1701) = lu(k,1701) - lu(k,809) * lu(k,1645) + lu(k,1702) = lu(k,1702) - lu(k,810) * lu(k,1645) + lu(k,1703) = lu(k,1703) - lu(k,811) * lu(k,1645) + lu(k,1941) = lu(k,1941) - lu(k,805) * lu(k,1911) + lu(k,1944) = lu(k,1944) - lu(k,806) * lu(k,1911) + lu(k,1946) = - lu(k,807) * lu(k,1911) + lu(k,1947) = lu(k,1947) - lu(k,808) * lu(k,1911) + lu(k,1957) = lu(k,1957) - lu(k,809) * lu(k,1911) + lu(k,1958) = lu(k,1958) - lu(k,810) * lu(k,1911) + lu(k,1959) = lu(k,1959) - lu(k,811) * lu(k,1911) + lu(k,2241) = lu(k,2241) - lu(k,805) * lu(k,2234) + lu(k,2244) = lu(k,2244) - lu(k,806) * lu(k,2234) + lu(k,2246) = - lu(k,807) * lu(k,2234) + lu(k,2247) = lu(k,2247) - lu(k,808) * lu(k,2234) + lu(k,2257) = lu(k,2257) - lu(k,809) * lu(k,2234) + lu(k,2258) = lu(k,2258) - lu(k,810) * lu(k,2234) + lu(k,2259) = lu(k,2259) - lu(k,811) * lu(k,2234) end do end subroutine lu_fac17 subroutine lu_fac18( avec_len, lu ) @@ -3010,252 +2750,217 @@ subroutine lu_fac18( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,837) = 1._r8 / lu(k,837) - lu(k,838) = lu(k,838) * lu(k,837) - lu(k,839) = lu(k,839) * lu(k,837) - lu(k,840) = lu(k,840) * lu(k,837) - lu(k,841) = lu(k,841) * lu(k,837) - lu(k,842) = lu(k,842) * lu(k,837) - lu(k,843) = lu(k,843) * lu(k,837) - lu(k,844) = lu(k,844) * lu(k,837) - lu(k,845) = lu(k,845) * lu(k,837) - lu(k,846) = lu(k,846) * lu(k,837) - lu(k,1475) = lu(k,1475) - lu(k,838) * lu(k,1474) - lu(k,1489) = lu(k,1489) - lu(k,839) * lu(k,1474) - lu(k,1501) = lu(k,1501) - lu(k,840) * lu(k,1474) - lu(k,1507) = lu(k,1507) - lu(k,841) * lu(k,1474) - lu(k,1508) = lu(k,1508) - lu(k,842) * lu(k,1474) - lu(k,1509) = lu(k,1509) - lu(k,843) * lu(k,1474) - lu(k,1510) = lu(k,1510) - lu(k,844) * lu(k,1474) - lu(k,1512) = lu(k,1512) - lu(k,845) * lu(k,1474) - lu(k,1513) = lu(k,1513) - lu(k,846) * lu(k,1474) - lu(k,1610) = lu(k,1610) - lu(k,838) * lu(k,1609) - lu(k,1622) = lu(k,1622) - lu(k,839) * lu(k,1609) - lu(k,1632) = lu(k,1632) - lu(k,840) * lu(k,1609) - lu(k,1638) = lu(k,1638) - lu(k,841) * lu(k,1609) - lu(k,1639) = lu(k,1639) - lu(k,842) * lu(k,1609) - lu(k,1640) = lu(k,1640) - lu(k,843) * lu(k,1609) - lu(k,1641) = lu(k,1641) - lu(k,844) * lu(k,1609) - lu(k,1643) = lu(k,1643) - lu(k,845) * lu(k,1609) - lu(k,1644) = lu(k,1644) - lu(k,846) * lu(k,1609) - lu(k,1812) = lu(k,1812) - lu(k,838) * lu(k,1811) - lu(k,1822) = lu(k,1822) - lu(k,839) * lu(k,1811) - lu(k,1833) = lu(k,1833) - lu(k,840) * lu(k,1811) - lu(k,1839) = lu(k,1839) - lu(k,841) * lu(k,1811) - lu(k,1840) = lu(k,1840) - lu(k,842) * lu(k,1811) - lu(k,1841) = lu(k,1841) - lu(k,843) * lu(k,1811) - lu(k,1842) = lu(k,1842) - lu(k,844) * lu(k,1811) - lu(k,1844) = lu(k,1844) - lu(k,845) * lu(k,1811) - lu(k,1845) = lu(k,1845) - lu(k,846) * lu(k,1811) - lu(k,1953) = lu(k,1953) - lu(k,838) * lu(k,1952) - lu(k,1966) = lu(k,1966) - lu(k,839) * lu(k,1952) - lu(k,1977) = lu(k,1977) - lu(k,840) * lu(k,1952) - lu(k,1983) = lu(k,1983) - lu(k,841) * lu(k,1952) - lu(k,1984) = lu(k,1984) - lu(k,842) * lu(k,1952) - lu(k,1985) = lu(k,1985) - lu(k,843) * lu(k,1952) - lu(k,1986) = lu(k,1986) - lu(k,844) * lu(k,1952) - lu(k,1988) = lu(k,1988) - lu(k,845) * lu(k,1952) - lu(k,1989) = lu(k,1989) - lu(k,846) * lu(k,1952) - lu(k,2016) = lu(k,2016) - lu(k,838) * lu(k,2015) - lu(k,2027) = lu(k,2027) - lu(k,839) * lu(k,2015) - lu(k,2037) = lu(k,2037) - lu(k,840) * lu(k,2015) - lu(k,2043) = lu(k,2043) - lu(k,841) * lu(k,2015) - lu(k,2044) = lu(k,2044) - lu(k,842) * lu(k,2015) - lu(k,2045) = lu(k,2045) - lu(k,843) * lu(k,2015) - lu(k,2046) = lu(k,2046) - lu(k,844) * lu(k,2015) - lu(k,2048) = lu(k,2048) - lu(k,845) * lu(k,2015) - lu(k,2049) = lu(k,2049) - lu(k,846) * lu(k,2015) - lu(k,847) = 1._r8 / lu(k,847) - lu(k,848) = lu(k,848) * lu(k,847) - lu(k,849) = lu(k,849) * lu(k,847) - lu(k,850) = lu(k,850) * lu(k,847) - lu(k,851) = lu(k,851) * lu(k,847) - lu(k,852) = lu(k,852) * lu(k,847) - lu(k,919) = - lu(k,848) * lu(k,914) - lu(k,921) = lu(k,921) - lu(k,849) * lu(k,914) - lu(k,923) = lu(k,923) - lu(k,850) * lu(k,914) - lu(k,925) = - lu(k,851) * lu(k,914) - lu(k,928) = - lu(k,852) * lu(k,914) - lu(k,932) = lu(k,932) - lu(k,848) * lu(k,929) - lu(k,933) = lu(k,933) - lu(k,849) * lu(k,929) - lu(k,934) = lu(k,934) - lu(k,850) * lu(k,929) - lu(k,935) = - lu(k,851) * lu(k,929) - lu(k,938) = - lu(k,852) * lu(k,929) - lu(k,959) = - lu(k,848) * lu(k,952) - lu(k,960) = - lu(k,849) * lu(k,952) - lu(k,963) = lu(k,963) - lu(k,850) * lu(k,952) - lu(k,966) = lu(k,966) - lu(k,851) * lu(k,952) - lu(k,970) = - lu(k,852) * lu(k,952) - lu(k,979) = - lu(k,848) * lu(k,974) - lu(k,980) = - lu(k,849) * lu(k,974) - lu(k,983) = lu(k,983) - lu(k,850) * lu(k,974) - lu(k,986) = lu(k,986) - lu(k,851) * lu(k,974) - lu(k,989) = - lu(k,852) * lu(k,974) - lu(k,1488) = lu(k,1488) - lu(k,848) * lu(k,1475) - lu(k,1501) = lu(k,1501) - lu(k,849) * lu(k,1475) - lu(k,1507) = lu(k,1507) - lu(k,850) * lu(k,1475) - lu(k,1510) = lu(k,1510) - lu(k,851) * lu(k,1475) - lu(k,1519) = lu(k,1519) - lu(k,852) * lu(k,1475) - lu(k,1621) = lu(k,1621) - lu(k,848) * lu(k,1610) - lu(k,1632) = lu(k,1632) - lu(k,849) * lu(k,1610) - lu(k,1638) = lu(k,1638) - lu(k,850) * lu(k,1610) - lu(k,1641) = lu(k,1641) - lu(k,851) * lu(k,1610) - lu(k,1650) = lu(k,1650) - lu(k,852) * lu(k,1610) - lu(k,1672) = lu(k,1672) - lu(k,848) * lu(k,1662) - lu(k,1683) = lu(k,1683) - lu(k,849) * lu(k,1662) - lu(k,1688) = lu(k,1688) - lu(k,850) * lu(k,1662) - lu(k,1691) = lu(k,1691) - lu(k,851) * lu(k,1662) - lu(k,1700) = lu(k,1700) - lu(k,852) * lu(k,1662) - lu(k,1821) = lu(k,1821) - lu(k,848) * lu(k,1812) - lu(k,1833) = lu(k,1833) - lu(k,849) * lu(k,1812) - lu(k,1839) = lu(k,1839) - lu(k,850) * lu(k,1812) - lu(k,1842) = lu(k,1842) - lu(k,851) * lu(k,1812) - lu(k,1851) = lu(k,1851) - lu(k,852) * lu(k,1812) - lu(k,1965) = lu(k,1965) - lu(k,848) * lu(k,1953) - lu(k,1977) = lu(k,1977) - lu(k,849) * lu(k,1953) - lu(k,1983) = lu(k,1983) - lu(k,850) * lu(k,1953) - lu(k,1986) = lu(k,1986) - lu(k,851) * lu(k,1953) - lu(k,1995) = lu(k,1995) - lu(k,852) * lu(k,1953) - lu(k,2026) = lu(k,2026) - lu(k,848) * lu(k,2016) - lu(k,2037) = lu(k,2037) - lu(k,849) * lu(k,2016) - lu(k,2043) = lu(k,2043) - lu(k,850) * lu(k,2016) - lu(k,2046) = lu(k,2046) - lu(k,851) * lu(k,2016) - lu(k,2055) = lu(k,2055) - lu(k,852) * lu(k,2016) - lu(k,855) = 1._r8 / lu(k,855) - lu(k,856) = lu(k,856) * lu(k,855) - lu(k,857) = lu(k,857) * lu(k,855) - lu(k,858) = lu(k,858) * lu(k,855) - lu(k,859) = lu(k,859) * lu(k,855) - lu(k,860) = lu(k,860) * lu(k,855) - lu(k,861) = lu(k,861) * lu(k,855) - lu(k,862) = lu(k,862) * lu(k,855) - lu(k,863) = lu(k,863) * lu(k,855) - lu(k,864) = lu(k,864) * lu(k,855) - lu(k,1325) = - lu(k,856) * lu(k,1322) - lu(k,1327) = lu(k,1327) - lu(k,857) * lu(k,1322) - lu(k,1329) = lu(k,1329) - lu(k,858) * lu(k,1322) - lu(k,1330) = lu(k,1330) - lu(k,859) * lu(k,1322) - lu(k,1336) = lu(k,1336) - lu(k,860) * lu(k,1322) - lu(k,1337) = lu(k,1337) - lu(k,861) * lu(k,1322) - lu(k,1338) = lu(k,1338) - lu(k,862) * lu(k,1322) - lu(k,1339) = - lu(k,863) * lu(k,1322) - lu(k,1341) = lu(k,1341) - lu(k,864) * lu(k,1322) - lu(k,1503) = lu(k,1503) - lu(k,856) * lu(k,1476) - lu(k,1505) = lu(k,1505) - lu(k,857) * lu(k,1476) - lu(k,1507) = lu(k,1507) - lu(k,858) * lu(k,1476) - lu(k,1508) = lu(k,1508) - lu(k,859) * lu(k,1476) - lu(k,1514) = lu(k,1514) - lu(k,860) * lu(k,1476) - lu(k,1515) = lu(k,1515) - lu(k,861) * lu(k,1476) - lu(k,1516) = lu(k,1516) - lu(k,862) * lu(k,1476) - lu(k,1517) = lu(k,1517) - lu(k,863) * lu(k,1476) - lu(k,1519) = lu(k,1519) - lu(k,864) * lu(k,1476) - lu(k,1544) = lu(k,1544) - lu(k,856) * lu(k,1536) - lu(k,1546) = lu(k,1546) - lu(k,857) * lu(k,1536) - lu(k,1548) = lu(k,1548) - lu(k,858) * lu(k,1536) - lu(k,1549) = lu(k,1549) - lu(k,859) * lu(k,1536) - lu(k,1555) = lu(k,1555) - lu(k,860) * lu(k,1536) - lu(k,1556) = lu(k,1556) - lu(k,861) * lu(k,1536) - lu(k,1557) = lu(k,1557) - lu(k,862) * lu(k,1536) - lu(k,1558) = lu(k,1558) - lu(k,863) * lu(k,1536) - lu(k,1560) = lu(k,1560) - lu(k,864) * lu(k,1536) - lu(k,1865) = lu(k,1865) - lu(k,856) * lu(k,1860) - lu(k,1867) = lu(k,1867) - lu(k,857) * lu(k,1860) - lu(k,1869) = lu(k,1869) - lu(k,858) * lu(k,1860) - lu(k,1870) = lu(k,1870) - lu(k,859) * lu(k,1860) - lu(k,1876) = lu(k,1876) - lu(k,860) * lu(k,1860) - lu(k,1877) = lu(k,1877) - lu(k,861) * lu(k,1860) - lu(k,1878) = lu(k,1878) - lu(k,862) * lu(k,1860) - lu(k,1879) = lu(k,1879) - lu(k,863) * lu(k,1860) - lu(k,1881) = lu(k,1881) - lu(k,864) * lu(k,1860) - lu(k,1888) = lu(k,1888) - lu(k,856) * lu(k,1886) - lu(k,1890) = lu(k,1890) - lu(k,857) * lu(k,1886) - lu(k,1892) = lu(k,1892) - lu(k,858) * lu(k,1886) - lu(k,1893) = - lu(k,859) * lu(k,1886) - lu(k,1899) = lu(k,1899) - lu(k,860) * lu(k,1886) - lu(k,1900) = lu(k,1900) - lu(k,861) * lu(k,1886) - lu(k,1901) = lu(k,1901) - lu(k,862) * lu(k,1886) - lu(k,1902) = - lu(k,863) * lu(k,1886) - lu(k,1904) = lu(k,1904) - lu(k,864) * lu(k,1886) - lu(k,1922) = - lu(k,856) * lu(k,1915) - lu(k,1924) = lu(k,1924) - lu(k,857) * lu(k,1915) - lu(k,1926) = lu(k,1926) - lu(k,858) * lu(k,1915) - lu(k,1927) = lu(k,1927) - lu(k,859) * lu(k,1915) - lu(k,1933) = lu(k,1933) - lu(k,860) * lu(k,1915) - lu(k,1934) = lu(k,1934) - lu(k,861) * lu(k,1915) - lu(k,1935) = lu(k,1935) - lu(k,862) * lu(k,1915) - lu(k,1936) = lu(k,1936) - lu(k,863) * lu(k,1915) - lu(k,1938) = lu(k,1938) - lu(k,864) * lu(k,1915) - lu(k,869) = 1._r8 / lu(k,869) - lu(k,870) = lu(k,870) * lu(k,869) - lu(k,871) = lu(k,871) * lu(k,869) - lu(k,872) = lu(k,872) * lu(k,869) - lu(k,873) = lu(k,873) * lu(k,869) - lu(k,874) = lu(k,874) * lu(k,869) - lu(k,875) = lu(k,875) * lu(k,869) - lu(k,876) = lu(k,876) * lu(k,869) - lu(k,877) = lu(k,877) * lu(k,869) - lu(k,878) = lu(k,878) * lu(k,869) - lu(k,879) = lu(k,879) * lu(k,869) - lu(k,880) = lu(k,880) * lu(k,869) - lu(k,881) = lu(k,881) * lu(k,869) - lu(k,882) = lu(k,882) * lu(k,869) - lu(k,883) = lu(k,883) * lu(k,869) - lu(k,1160) = lu(k,1160) - lu(k,870) * lu(k,1159) - lu(k,1161) = - lu(k,871) * lu(k,1159) - lu(k,1162) = lu(k,1162) - lu(k,872) * lu(k,1159) - lu(k,1163) = lu(k,1163) - lu(k,873) * lu(k,1159) - lu(k,1166) = lu(k,1166) - lu(k,874) * lu(k,1159) - lu(k,1169) = lu(k,1169) - lu(k,875) * lu(k,1159) - lu(k,1170) = - lu(k,876) * lu(k,1159) - lu(k,1171) = - lu(k,877) * lu(k,1159) - lu(k,1172) = lu(k,1172) - lu(k,878) * lu(k,1159) - lu(k,1173) = lu(k,1173) - lu(k,879) * lu(k,1159) - lu(k,1174) = lu(k,1174) - lu(k,880) * lu(k,1159) - lu(k,1175) = - lu(k,881) * lu(k,1159) - lu(k,1176) = lu(k,1176) - lu(k,882) * lu(k,1159) - lu(k,1177) = lu(k,1177) - lu(k,883) * lu(k,1159) - lu(k,1483) = lu(k,1483) - lu(k,870) * lu(k,1477) - lu(k,1484) = lu(k,1484) - lu(k,871) * lu(k,1477) - lu(k,1489) = lu(k,1489) - lu(k,872) * lu(k,1477) - lu(k,1494) = lu(k,1494) - lu(k,873) * lu(k,1477) - lu(k,1501) = lu(k,1501) - lu(k,874) * lu(k,1477) - lu(k,1507) = lu(k,1507) - lu(k,875) * lu(k,1477) - lu(k,1508) = lu(k,1508) - lu(k,876) * lu(k,1477) - lu(k,1509) = lu(k,1509) - lu(k,877) * lu(k,1477) - lu(k,1510) = lu(k,1510) - lu(k,878) * lu(k,1477) - lu(k,1512) = lu(k,1512) - lu(k,879) * lu(k,1477) - lu(k,1513) = lu(k,1513) - lu(k,880) * lu(k,1477) - lu(k,1517) = lu(k,1517) - lu(k,881) * lu(k,1477) - lu(k,1518) = lu(k,1518) - lu(k,882) * lu(k,1477) - lu(k,1519) = lu(k,1519) - lu(k,883) * lu(k,1477) - lu(k,1960) = lu(k,1960) - lu(k,870) * lu(k,1954) - lu(k,1961) = lu(k,1961) - lu(k,871) * lu(k,1954) - lu(k,1966) = lu(k,1966) - lu(k,872) * lu(k,1954) - lu(k,1970) = lu(k,1970) - lu(k,873) * lu(k,1954) - lu(k,1977) = lu(k,1977) - lu(k,874) * lu(k,1954) - lu(k,1983) = lu(k,1983) - lu(k,875) * lu(k,1954) - lu(k,1984) = lu(k,1984) - lu(k,876) * lu(k,1954) - lu(k,1985) = lu(k,1985) - lu(k,877) * lu(k,1954) - lu(k,1986) = lu(k,1986) - lu(k,878) * lu(k,1954) - lu(k,1988) = lu(k,1988) - lu(k,879) * lu(k,1954) - lu(k,1989) = lu(k,1989) - lu(k,880) * lu(k,1954) - lu(k,1993) = lu(k,1993) - lu(k,881) * lu(k,1954) - lu(k,1994) = lu(k,1994) - lu(k,882) * lu(k,1954) - lu(k,1995) = lu(k,1995) - lu(k,883) * lu(k,1954) - lu(k,2021) = lu(k,2021) - lu(k,870) * lu(k,2017) - lu(k,2022) = - lu(k,871) * lu(k,2017) - lu(k,2027) = lu(k,2027) - lu(k,872) * lu(k,2017) - lu(k,2030) = lu(k,2030) - lu(k,873) * lu(k,2017) - lu(k,2037) = lu(k,2037) - lu(k,874) * lu(k,2017) - lu(k,2043) = lu(k,2043) - lu(k,875) * lu(k,2017) - lu(k,2044) = lu(k,2044) - lu(k,876) * lu(k,2017) - lu(k,2045) = lu(k,2045) - lu(k,877) * lu(k,2017) - lu(k,2046) = lu(k,2046) - lu(k,878) * lu(k,2017) - lu(k,2048) = lu(k,2048) - lu(k,879) * lu(k,2017) - lu(k,2049) = lu(k,2049) - lu(k,880) * lu(k,2017) - lu(k,2053) = lu(k,2053) - lu(k,881) * lu(k,2017) - lu(k,2054) = lu(k,2054) - lu(k,882) * lu(k,2017) - lu(k,2055) = lu(k,2055) - lu(k,883) * lu(k,2017) + lu(k,815) = 1._r8 / lu(k,815) + lu(k,816) = lu(k,816) * lu(k,815) + lu(k,817) = lu(k,817) * lu(k,815) + lu(k,818) = lu(k,818) * lu(k,815) + lu(k,819) = lu(k,819) * lu(k,815) + lu(k,820) = lu(k,820) * lu(k,815) + lu(k,821) = lu(k,821) * lu(k,815) + lu(k,822) = lu(k,822) * lu(k,815) + lu(k,901) = lu(k,901) - lu(k,816) * lu(k,898) + lu(k,903) = lu(k,903) - lu(k,817) * lu(k,898) + lu(k,904) = lu(k,904) - lu(k,818) * lu(k,898) + lu(k,905) = lu(k,905) - lu(k,819) * lu(k,898) + lu(k,906) = lu(k,906) - lu(k,820) * lu(k,898) + lu(k,907) = - lu(k,821) * lu(k,898) + lu(k,908) = lu(k,908) - lu(k,822) * lu(k,898) + lu(k,1666) = lu(k,1666) - lu(k,816) * lu(k,1646) + lu(k,1689) = lu(k,1689) - lu(k,817) * lu(k,1646) + lu(k,1691) = lu(k,1691) - lu(k,818) * lu(k,1646) + lu(k,1693) = lu(k,1693) - lu(k,819) * lu(k,1646) + lu(k,1694) = lu(k,1694) - lu(k,820) * lu(k,1646) + lu(k,1697) = lu(k,1697) - lu(k,821) * lu(k,1646) + lu(k,1700) = lu(k,1700) - lu(k,822) * lu(k,1646) + lu(k,1817) = lu(k,1817) - lu(k,816) * lu(k,1805) + lu(k,1838) = lu(k,1838) - lu(k,817) * lu(k,1805) + lu(k,1840) = lu(k,1840) - lu(k,818) * lu(k,1805) + lu(k,1842) = lu(k,1842) - lu(k,819) * lu(k,1805) + lu(k,1843) = lu(k,1843) - lu(k,820) * lu(k,1805) + lu(k,1846) = lu(k,1846) - lu(k,821) * lu(k,1805) + lu(k,1849) = lu(k,1849) - lu(k,822) * lu(k,1805) + lu(k,1924) = lu(k,1924) - lu(k,816) * lu(k,1912) + lu(k,1945) = lu(k,1945) - lu(k,817) * lu(k,1912) + lu(k,1947) = lu(k,1947) - lu(k,818) * lu(k,1912) + lu(k,1949) = lu(k,1949) - lu(k,819) * lu(k,1912) + lu(k,1950) = lu(k,1950) - lu(k,820) * lu(k,1912) + lu(k,1953) = lu(k,1953) - lu(k,821) * lu(k,1912) + lu(k,1956) = lu(k,1956) - lu(k,822) * lu(k,1912) + lu(k,2001) = - lu(k,816) * lu(k,1996) + lu(k,2010) = lu(k,2010) - lu(k,817) * lu(k,1996) + lu(k,2012) = lu(k,2012) - lu(k,818) * lu(k,1996) + lu(k,2014) = lu(k,2014) - lu(k,819) * lu(k,1996) + lu(k,2015) = lu(k,2015) - lu(k,820) * lu(k,1996) + lu(k,2018) = lu(k,2018) - lu(k,821) * lu(k,1996) + lu(k,2021) = lu(k,2021) - lu(k,822) * lu(k,1996) + lu(k,2043) = lu(k,2043) - lu(k,816) * lu(k,2034) + lu(k,2062) = lu(k,2062) - lu(k,817) * lu(k,2034) + lu(k,2064) = lu(k,2064) - lu(k,818) * lu(k,2034) + lu(k,2066) = lu(k,2066) - lu(k,819) * lu(k,2034) + lu(k,2067) = lu(k,2067) - lu(k,820) * lu(k,2034) + lu(k,2070) = lu(k,2070) - lu(k,821) * lu(k,2034) + lu(k,2073) = lu(k,2073) - lu(k,822) * lu(k,2034) + lu(k,824) = 1._r8 / lu(k,824) + lu(k,825) = lu(k,825) * lu(k,824) + lu(k,826) = lu(k,826) * lu(k,824) + lu(k,827) = lu(k,827) * lu(k,824) + lu(k,828) = lu(k,828) * lu(k,824) + lu(k,829) = lu(k,829) * lu(k,824) + lu(k,830) = lu(k,830) * lu(k,824) + lu(k,886) = lu(k,886) - lu(k,825) * lu(k,883) + lu(k,888) = lu(k,888) - lu(k,826) * lu(k,883) + lu(k,889) = lu(k,889) - lu(k,827) * lu(k,883) + lu(k,890) = lu(k,890) - lu(k,828) * lu(k,883) + lu(k,892) = lu(k,892) - lu(k,829) * lu(k,883) + lu(k,893) = - lu(k,830) * lu(k,883) + lu(k,1691) = lu(k,1691) - lu(k,825) * lu(k,1647) + lu(k,1695) = lu(k,1695) - lu(k,826) * lu(k,1647) + lu(k,1696) = lu(k,1696) - lu(k,827) * lu(k,1647) + lu(k,1699) = lu(k,1699) - lu(k,828) * lu(k,1647) + lu(k,1702) = lu(k,1702) - lu(k,829) * lu(k,1647) + lu(k,1703) = lu(k,1703) - lu(k,830) * lu(k,1647) + lu(k,1947) = lu(k,1947) - lu(k,825) * lu(k,1913) + lu(k,1951) = lu(k,1951) - lu(k,826) * lu(k,1913) + lu(k,1952) = lu(k,1952) - lu(k,827) * lu(k,1913) + lu(k,1955) = lu(k,1955) - lu(k,828) * lu(k,1913) + lu(k,1958) = lu(k,1958) - lu(k,829) * lu(k,1913) + lu(k,1959) = lu(k,1959) - lu(k,830) * lu(k,1913) + lu(k,1973) = lu(k,1973) - lu(k,825) * lu(k,1964) + lu(k,1977) = lu(k,1977) - lu(k,826) * lu(k,1964) + lu(k,1978) = lu(k,1978) - lu(k,827) * lu(k,1964) + lu(k,1981) = lu(k,1981) - lu(k,828) * lu(k,1964) + lu(k,1984) = lu(k,1984) - lu(k,829) * lu(k,1964) + lu(k,1985) = - lu(k,830) * lu(k,1964) + lu(k,2012) = lu(k,2012) - lu(k,825) * lu(k,1997) + lu(k,2016) = lu(k,2016) - lu(k,826) * lu(k,1997) + lu(k,2017) = lu(k,2017) - lu(k,827) * lu(k,1997) + lu(k,2020) = lu(k,2020) - lu(k,828) * lu(k,1997) + lu(k,2023) = lu(k,2023) - lu(k,829) * lu(k,1997) + lu(k,2024) = lu(k,2024) - lu(k,830) * lu(k,1997) + lu(k,2148) = lu(k,2148) - lu(k,825) * lu(k,2141) + lu(k,2152) = lu(k,2152) - lu(k,826) * lu(k,2141) + lu(k,2153) = lu(k,2153) - lu(k,827) * lu(k,2141) + lu(k,2156) = lu(k,2156) - lu(k,828) * lu(k,2141) + lu(k,2159) = lu(k,2159) - lu(k,829) * lu(k,2141) + lu(k,2160) = lu(k,2160) - lu(k,830) * lu(k,2141) + lu(k,2247) = lu(k,2247) - lu(k,825) * lu(k,2235) + lu(k,2251) = lu(k,2251) - lu(k,826) * lu(k,2235) + lu(k,2252) = lu(k,2252) - lu(k,827) * lu(k,2235) + lu(k,2255) = lu(k,2255) - lu(k,828) * lu(k,2235) + lu(k,2258) = lu(k,2258) - lu(k,829) * lu(k,2235) + lu(k,2259) = lu(k,2259) - lu(k,830) * lu(k,2235) + lu(k,832) = 1._r8 / lu(k,832) + lu(k,833) = lu(k,833) * lu(k,832) + lu(k,834) = lu(k,834) * lu(k,832) + lu(k,835) = lu(k,835) * lu(k,832) + lu(k,836) = lu(k,836) * lu(k,832) + lu(k,837) = lu(k,837) * lu(k,832) + lu(k,1232) = lu(k,1232) - lu(k,833) * lu(k,1231) + lu(k,1235) = lu(k,1235) - lu(k,834) * lu(k,1231) + lu(k,1237) = - lu(k,835) * lu(k,1231) + lu(k,1243) = lu(k,1243) - lu(k,836) * lu(k,1231) + lu(k,1244) = - lu(k,837) * lu(k,1231) + lu(k,1677) = lu(k,1677) - lu(k,833) * lu(k,1648) + lu(k,1691) = lu(k,1691) - lu(k,834) * lu(k,1648) + lu(k,1694) = lu(k,1694) - lu(k,835) * lu(k,1648) + lu(k,1702) = lu(k,1702) - lu(k,836) * lu(k,1648) + lu(k,1703) = lu(k,1703) - lu(k,837) * lu(k,1648) + lu(k,1735) = - lu(k,833) * lu(k,1711) + lu(k,1748) = lu(k,1748) - lu(k,834) * lu(k,1711) + lu(k,1751) = lu(k,1751) - lu(k,835) * lu(k,1711) + lu(k,1759) = lu(k,1759) - lu(k,836) * lu(k,1711) + lu(k,1760) = - lu(k,837) * lu(k,1711) + lu(k,1967) = lu(k,1967) - lu(k,833) * lu(k,1965) + lu(k,1973) = lu(k,1973) - lu(k,834) * lu(k,1965) + lu(k,1976) = lu(k,1976) - lu(k,835) * lu(k,1965) + lu(k,1984) = lu(k,1984) - lu(k,836) * lu(k,1965) + lu(k,1985) = lu(k,1985) - lu(k,837) * lu(k,1965) + lu(k,2112) = lu(k,2112) - lu(k,833) * lu(k,2091) + lu(k,2125) = lu(k,2125) - lu(k,834) * lu(k,2091) + lu(k,2128) = lu(k,2128) - lu(k,835) * lu(k,2091) + lu(k,2136) = lu(k,2136) - lu(k,836) * lu(k,2091) + lu(k,2137) = lu(k,2137) - lu(k,837) * lu(k,2091) + lu(k,2183) = lu(k,2183) - lu(k,833) * lu(k,2176) + lu(k,2192) = lu(k,2192) - lu(k,834) * lu(k,2176) + lu(k,2195) = lu(k,2195) - lu(k,835) * lu(k,2176) + lu(k,2203) = lu(k,2203) - lu(k,836) * lu(k,2176) + lu(k,2204) = lu(k,2204) - lu(k,837) * lu(k,2176) + lu(k,2210) = lu(k,2210) - lu(k,833) * lu(k,2209) + lu(k,2216) = lu(k,2216) - lu(k,834) * lu(k,2209) + lu(k,2219) = lu(k,2219) - lu(k,835) * lu(k,2209) + lu(k,2227) = lu(k,2227) - lu(k,836) * lu(k,2209) + lu(k,2228) = lu(k,2228) - lu(k,837) * lu(k,2209) + lu(k,2239) = lu(k,2239) - lu(k,833) * lu(k,2236) + lu(k,2247) = lu(k,2247) - lu(k,834) * lu(k,2236) + lu(k,2250) = lu(k,2250) - lu(k,835) * lu(k,2236) + lu(k,2258) = lu(k,2258) - lu(k,836) * lu(k,2236) + lu(k,2259) = lu(k,2259) - lu(k,837) * lu(k,2236) + lu(k,2265) = - lu(k,833) * lu(k,2263) + lu(k,2273) = lu(k,2273) - lu(k,834) * lu(k,2263) + lu(k,2276) = - lu(k,835) * lu(k,2263) + lu(k,2284) = lu(k,2284) - lu(k,836) * lu(k,2263) + lu(k,2285) = lu(k,2285) - lu(k,837) * lu(k,2263) + lu(k,841) = 1._r8 / lu(k,841) + lu(k,842) = lu(k,842) * lu(k,841) + lu(k,843) = lu(k,843) * lu(k,841) + lu(k,844) = lu(k,844) * lu(k,841) + lu(k,845) = lu(k,845) * lu(k,841) + lu(k,846) = lu(k,846) * lu(k,841) + lu(k,847) = lu(k,847) * lu(k,841) + lu(k,848) = lu(k,848) * lu(k,841) + lu(k,849) = lu(k,849) * lu(k,841) + lu(k,850) = lu(k,850) * lu(k,841) + lu(k,851) = lu(k,851) * lu(k,841) + lu(k,852) = lu(k,852) * lu(k,841) + lu(k,853) = lu(k,853) * lu(k,841) + lu(k,854) = lu(k,854) * lu(k,841) + lu(k,855) = lu(k,855) * lu(k,841) + lu(k,856) = lu(k,856) * lu(k,841) + lu(k,1657) = lu(k,1657) - lu(k,842) * lu(k,1649) + lu(k,1662) = lu(k,1662) - lu(k,843) * lu(k,1649) + lu(k,1668) = lu(k,1668) - lu(k,844) * lu(k,1649) + lu(k,1674) = - lu(k,845) * lu(k,1649) + lu(k,1675) = lu(k,1675) - lu(k,846) * lu(k,1649) + lu(k,1678) = lu(k,1678) - lu(k,847) * lu(k,1649) + lu(k,1679) = lu(k,1679) - lu(k,848) * lu(k,1649) + lu(k,1681) = lu(k,1681) - lu(k,849) * lu(k,1649) + lu(k,1683) = lu(k,1683) - lu(k,850) * lu(k,1649) + lu(k,1689) = lu(k,1689) - lu(k,851) * lu(k,1649) + lu(k,1691) = lu(k,1691) - lu(k,852) * lu(k,1649) + lu(k,1692) = lu(k,1692) - lu(k,853) * lu(k,1649) + lu(k,1694) = lu(k,1694) - lu(k,854) * lu(k,1649) + lu(k,1697) = lu(k,1697) - lu(k,855) * lu(k,1649) + lu(k,1698) = lu(k,1698) - lu(k,856) * lu(k,1649) + lu(k,1715) = - lu(k,842) * lu(k,1712) + lu(k,1720) = lu(k,1720) - lu(k,843) * lu(k,1712) + lu(k,1726) = lu(k,1726) - lu(k,844) * lu(k,1712) + lu(k,1732) = lu(k,1732) - lu(k,845) * lu(k,1712) + lu(k,1733) = lu(k,1733) - lu(k,846) * lu(k,1712) + lu(k,1736) = lu(k,1736) - lu(k,847) * lu(k,1712) + lu(k,1737) = lu(k,1737) - lu(k,848) * lu(k,1712) + lu(k,1739) = lu(k,1739) - lu(k,849) * lu(k,1712) + lu(k,1741) = lu(k,1741) - lu(k,850) * lu(k,1712) + lu(k,1746) = lu(k,1746) - lu(k,851) * lu(k,1712) + lu(k,1748) = lu(k,1748) - lu(k,852) * lu(k,1712) + lu(k,1749) = lu(k,1749) - lu(k,853) * lu(k,1712) + lu(k,1751) = lu(k,1751) - lu(k,854) * lu(k,1712) + lu(k,1754) = - lu(k,855) * lu(k,1712) + lu(k,1755) = - lu(k,856) * lu(k,1712) + lu(k,2095) = lu(k,2095) - lu(k,842) * lu(k,2092) + lu(k,2100) = lu(k,2100) - lu(k,843) * lu(k,2092) + lu(k,2105) = lu(k,2105) - lu(k,844) * lu(k,2092) + lu(k,2109) = - lu(k,845) * lu(k,2092) + lu(k,2110) = lu(k,2110) - lu(k,846) * lu(k,2092) + lu(k,2113) = - lu(k,847) * lu(k,2092) + lu(k,2114) = - lu(k,848) * lu(k,2092) + lu(k,2116) = lu(k,2116) - lu(k,849) * lu(k,2092) + lu(k,2118) = lu(k,2118) - lu(k,850) * lu(k,2092) + lu(k,2123) = lu(k,2123) - lu(k,851) * lu(k,2092) + lu(k,2125) = lu(k,2125) - lu(k,852) * lu(k,2092) + lu(k,2126) = lu(k,2126) - lu(k,853) * lu(k,2092) + lu(k,2128) = lu(k,2128) - lu(k,854) * lu(k,2092) + lu(k,2131) = lu(k,2131) - lu(k,855) * lu(k,2092) + lu(k,2132) = lu(k,2132) - lu(k,856) * lu(k,2092) end do end subroutine lu_fac18 subroutine lu_fac19( avec_len, lu ) @@ -3272,6 +2977,171 @@ subroutine lu_fac19( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len + lu(k,857) = 1._r8 / lu(k,857) + lu(k,858) = lu(k,858) * lu(k,857) + lu(k,859) = lu(k,859) * lu(k,857) + lu(k,860) = lu(k,860) * lu(k,857) + lu(k,861) = lu(k,861) * lu(k,857) + lu(k,862) = lu(k,862) * lu(k,857) + lu(k,1028) = - lu(k,858) * lu(k,1022) + lu(k,1029) = - lu(k,859) * lu(k,1022) + lu(k,1031) = lu(k,1031) - lu(k,860) * lu(k,1022) + lu(k,1032) = lu(k,1032) - lu(k,861) * lu(k,1022) + lu(k,1038) = lu(k,1038) - lu(k,862) * lu(k,1022) + lu(k,1075) = - lu(k,858) * lu(k,1070) + lu(k,1076) = - lu(k,859) * lu(k,1070) + lu(k,1078) = - lu(k,860) * lu(k,1070) + lu(k,1079) = lu(k,1079) - lu(k,861) * lu(k,1070) + lu(k,1083) = lu(k,1083) - lu(k,862) * lu(k,1070) + lu(k,1195) = - lu(k,858) * lu(k,1188) + lu(k,1197) = lu(k,1197) - lu(k,859) * lu(k,1188) + lu(k,1199) = lu(k,1199) - lu(k,860) * lu(k,1188) + lu(k,1200) = lu(k,1200) - lu(k,861) * lu(k,1188) + lu(k,1205) = lu(k,1205) - lu(k,862) * lu(k,1188) + lu(k,1287) = lu(k,1287) - lu(k,858) * lu(k,1278) + lu(k,1292) = lu(k,1292) - lu(k,859) * lu(k,1278) + lu(k,1294) = lu(k,1294) - lu(k,860) * lu(k,1278) + lu(k,1295) = lu(k,1295) - lu(k,861) * lu(k,1278) + lu(k,1301) = lu(k,1301) - lu(k,862) * lu(k,1278) + lu(k,1676) = lu(k,1676) - lu(k,858) * lu(k,1650) + lu(k,1683) = lu(k,1683) - lu(k,859) * lu(k,1650) + lu(k,1689) = lu(k,1689) - lu(k,860) * lu(k,1650) + lu(k,1691) = lu(k,1691) - lu(k,861) * lu(k,1650) + lu(k,1700) = lu(k,1700) - lu(k,862) * lu(k,1650) + lu(k,1734) = lu(k,1734) - lu(k,858) * lu(k,1713) + lu(k,1741) = lu(k,1741) - lu(k,859) * lu(k,1713) + lu(k,1746) = lu(k,1746) - lu(k,860) * lu(k,1713) + lu(k,1748) = lu(k,1748) - lu(k,861) * lu(k,1713) + lu(k,1757) = lu(k,1757) - lu(k,862) * lu(k,1713) + lu(k,1827) = lu(k,1827) - lu(k,858) * lu(k,1806) + lu(k,1833) = lu(k,1833) - lu(k,859) * lu(k,1806) + lu(k,1838) = lu(k,1838) - lu(k,860) * lu(k,1806) + lu(k,1840) = lu(k,1840) - lu(k,861) * lu(k,1806) + lu(k,1849) = lu(k,1849) - lu(k,862) * lu(k,1806) + lu(k,1933) = lu(k,1933) - lu(k,858) * lu(k,1914) + lu(k,1939) = lu(k,1939) - lu(k,859) * lu(k,1914) + lu(k,1945) = lu(k,1945) - lu(k,860) * lu(k,1914) + lu(k,1947) = lu(k,1947) - lu(k,861) * lu(k,1914) + lu(k,1956) = lu(k,1956) - lu(k,862) * lu(k,1914) + lu(k,2052) = lu(k,2052) - lu(k,858) * lu(k,2035) + lu(k,2058) = lu(k,2058) - lu(k,859) * lu(k,2035) + lu(k,2062) = lu(k,2062) - lu(k,860) * lu(k,2035) + lu(k,2064) = lu(k,2064) - lu(k,861) * lu(k,2035) + lu(k,2073) = lu(k,2073) - lu(k,862) * lu(k,2035) + lu(k,864) = 1._r8 / lu(k,864) + lu(k,865) = lu(k,865) * lu(k,864) + lu(k,866) = lu(k,866) * lu(k,864) + lu(k,867) = lu(k,867) * lu(k,864) + lu(k,868) = lu(k,868) * lu(k,864) + lu(k,869) = lu(k,869) * lu(k,864) + lu(k,870) = lu(k,870) * lu(k,864) + lu(k,871) = lu(k,871) * lu(k,864) + lu(k,872) = lu(k,872) * lu(k,864) + lu(k,1401) = lu(k,1401) - lu(k,865) * lu(k,1400) + lu(k,1402) = - lu(k,866) * lu(k,1400) + lu(k,1403) = - lu(k,867) * lu(k,1400) + lu(k,1404) = lu(k,1404) - lu(k,868) * lu(k,1400) + lu(k,1406) = lu(k,1406) - lu(k,869) * lu(k,1400) + lu(k,1407) = - lu(k,870) * lu(k,1400) + lu(k,1409) = - lu(k,871) * lu(k,1400) + lu(k,1412) = lu(k,1412) - lu(k,872) * lu(k,1400) + lu(k,1429) = lu(k,1429) - lu(k,865) * lu(k,1427) + lu(k,1430) = lu(k,1430) - lu(k,866) * lu(k,1427) + lu(k,1431) = - lu(k,867) * lu(k,1427) + lu(k,1432) = lu(k,1432) - lu(k,868) * lu(k,1427) + lu(k,1435) = lu(k,1435) - lu(k,869) * lu(k,1427) + lu(k,1436) = - lu(k,870) * lu(k,1427) + lu(k,1439) = lu(k,1439) - lu(k,871) * lu(k,1427) + lu(k,1442) = lu(k,1442) - lu(k,872) * lu(k,1427) + lu(k,1445) = - lu(k,865) * lu(k,1444) + lu(k,1446) = - lu(k,866) * lu(k,1444) + lu(k,1447) = lu(k,1447) - lu(k,867) * lu(k,1444) + lu(k,1448) = lu(k,1448) - lu(k,868) * lu(k,1444) + lu(k,1451) = lu(k,1451) - lu(k,869) * lu(k,1444) + lu(k,1452) = lu(k,1452) - lu(k,870) * lu(k,1444) + lu(k,1455) = - lu(k,871) * lu(k,1444) + lu(k,1459) = lu(k,1459) - lu(k,872) * lu(k,1444) + lu(k,1520) = lu(k,1520) - lu(k,865) * lu(k,1519) + lu(k,1522) = lu(k,1522) - lu(k,866) * lu(k,1519) + lu(k,1523) = - lu(k,867) * lu(k,1519) + lu(k,1524) = lu(k,1524) - lu(k,868) * lu(k,1519) + lu(k,1527) = lu(k,1527) - lu(k,869) * lu(k,1519) + lu(k,1528) = - lu(k,870) * lu(k,1519) + lu(k,1533) = lu(k,1533) - lu(k,871) * lu(k,1519) + lu(k,1539) = lu(k,1539) - lu(k,872) * lu(k,1519) + lu(k,1684) = lu(k,1684) - lu(k,865) * lu(k,1651) + lu(k,1686) = lu(k,1686) - lu(k,866) * lu(k,1651) + lu(k,1687) = lu(k,1687) - lu(k,867) * lu(k,1651) + lu(k,1688) = lu(k,1688) - lu(k,868) * lu(k,1651) + lu(k,1691) = lu(k,1691) - lu(k,869) * lu(k,1651) + lu(k,1692) = lu(k,1692) - lu(k,870) * lu(k,1651) + lu(k,1697) = lu(k,1697) - lu(k,871) * lu(k,1651) + lu(k,1703) = lu(k,1703) - lu(k,872) * lu(k,1651) + lu(k,2266) = lu(k,2266) - lu(k,865) * lu(k,2264) + lu(k,2268) = - lu(k,866) * lu(k,2264) + lu(k,2269) = - lu(k,867) * lu(k,2264) + lu(k,2270) = lu(k,2270) - lu(k,868) * lu(k,2264) + lu(k,2273) = lu(k,2273) - lu(k,869) * lu(k,2264) + lu(k,2274) = - lu(k,870) * lu(k,2264) + lu(k,2279) = - lu(k,871) * lu(k,2264) + lu(k,2285) = lu(k,2285) - lu(k,872) * lu(k,2264) + lu(k,873) = 1._r8 / lu(k,873) + lu(k,874) = lu(k,874) * lu(k,873) + lu(k,875) = lu(k,875) * lu(k,873) + lu(k,876) = lu(k,876) * lu(k,873) + lu(k,877) = lu(k,877) * lu(k,873) + lu(k,878) = lu(k,878) * lu(k,873) + lu(k,879) = lu(k,879) * lu(k,873) + lu(k,880) = lu(k,880) * lu(k,873) + lu(k,881) = lu(k,881) * lu(k,873) + lu(k,1072) = lu(k,1072) - lu(k,874) * lu(k,1071) + lu(k,1074) = lu(k,1074) - lu(k,875) * lu(k,1071) + lu(k,1075) = lu(k,1075) - lu(k,876) * lu(k,1071) + lu(k,1079) = lu(k,1079) - lu(k,877) * lu(k,1071) + lu(k,1080) = - lu(k,878) * lu(k,1071) + lu(k,1081) = lu(k,1081) - lu(k,879) * lu(k,1071) + lu(k,1082) = - lu(k,880) * lu(k,1071) + lu(k,1083) = lu(k,1083) - lu(k,881) * lu(k,1071) + lu(k,1280) = lu(k,1280) - lu(k,874) * lu(k,1279) + lu(k,1282) = lu(k,1282) - lu(k,875) * lu(k,1279) + lu(k,1287) = lu(k,1287) - lu(k,876) * lu(k,1279) + lu(k,1295) = lu(k,1295) - lu(k,877) * lu(k,1279) + lu(k,1297) = lu(k,1297) - lu(k,878) * lu(k,1279) + lu(k,1298) = lu(k,1298) - lu(k,879) * lu(k,1279) + lu(k,1299) = lu(k,1299) - lu(k,880) * lu(k,1279) + lu(k,1301) = lu(k,1301) - lu(k,881) * lu(k,1279) + lu(k,1660) = lu(k,1660) - lu(k,874) * lu(k,1652) + lu(k,1668) = lu(k,1668) - lu(k,875) * lu(k,1652) + lu(k,1676) = lu(k,1676) - lu(k,876) * lu(k,1652) + lu(k,1691) = lu(k,1691) - lu(k,877) * lu(k,1652) + lu(k,1693) = lu(k,1693) - lu(k,878) * lu(k,1652) + lu(k,1694) = lu(k,1694) - lu(k,879) * lu(k,1652) + lu(k,1697) = lu(k,1697) - lu(k,880) * lu(k,1652) + lu(k,1700) = lu(k,1700) - lu(k,881) * lu(k,1652) + lu(k,1813) = lu(k,1813) - lu(k,874) * lu(k,1807) + lu(k,1819) = lu(k,1819) - lu(k,875) * lu(k,1807) + lu(k,1827) = lu(k,1827) - lu(k,876) * lu(k,1807) + lu(k,1840) = lu(k,1840) - lu(k,877) * lu(k,1807) + lu(k,1842) = lu(k,1842) - lu(k,878) * lu(k,1807) + lu(k,1843) = lu(k,1843) - lu(k,879) * lu(k,1807) + lu(k,1846) = lu(k,1846) - lu(k,880) * lu(k,1807) + lu(k,1849) = lu(k,1849) - lu(k,881) * lu(k,1807) + lu(k,1921) = lu(k,1921) - lu(k,874) * lu(k,1915) + lu(k,1926) = lu(k,1926) - lu(k,875) * lu(k,1915) + lu(k,1933) = lu(k,1933) - lu(k,876) * lu(k,1915) + lu(k,1947) = lu(k,1947) - lu(k,877) * lu(k,1915) + lu(k,1949) = lu(k,1949) - lu(k,878) * lu(k,1915) + lu(k,1950) = lu(k,1950) - lu(k,879) * lu(k,1915) + lu(k,1953) = lu(k,1953) - lu(k,880) * lu(k,1915) + lu(k,1956) = lu(k,1956) - lu(k,881) * lu(k,1915) + lu(k,2179) = lu(k,2179) - lu(k,874) * lu(k,2177) + lu(k,2180) = lu(k,2180) - lu(k,875) * lu(k,2177) + lu(k,2182) = lu(k,2182) - lu(k,876) * lu(k,2177) + lu(k,2192) = lu(k,2192) - lu(k,877) * lu(k,2177) + lu(k,2194) = lu(k,2194) - lu(k,878) * lu(k,2177) + lu(k,2195) = lu(k,2195) - lu(k,879) * lu(k,2177) + lu(k,2198) = lu(k,2198) - lu(k,880) * lu(k,2177) + lu(k,2201) = lu(k,2201) - lu(k,881) * lu(k,2177) lu(k,884) = 1._r8 / lu(k,884) lu(k,885) = lu(k,885) * lu(k,884) lu(k,886) = lu(k,886) * lu(k,884) @@ -3280,283 +3150,62 @@ subroutine lu_fac19( avec_len, lu ) lu(k,889) = lu(k,889) * lu(k,884) lu(k,890) = lu(k,890) * lu(k,884) lu(k,891) = lu(k,891) * lu(k,884) - lu(k,954) = - lu(k,885) * lu(k,953) - lu(k,955) = - lu(k,886) * lu(k,953) - lu(k,957) = - lu(k,887) * lu(k,953) - lu(k,958) = - lu(k,888) * lu(k,953) - lu(k,963) = lu(k,963) - lu(k,889) * lu(k,953) - lu(k,968) = lu(k,968) - lu(k,890) * lu(k,953) - lu(k,969) = - lu(k,891) * lu(k,953) - lu(k,994) = - lu(k,885) * lu(k,993) - lu(k,995) = - lu(k,886) * lu(k,993) - lu(k,996) = - lu(k,887) * lu(k,993) - lu(k,997) = lu(k,997) - lu(k,888) * lu(k,993) - lu(k,1002) = lu(k,1002) - lu(k,889) * lu(k,993) - lu(k,1007) = lu(k,1007) - lu(k,890) * lu(k,993) - lu(k,1008) = lu(k,1008) - lu(k,891) * lu(k,993) - lu(k,1482) = lu(k,1482) - lu(k,885) * lu(k,1478) - lu(k,1483) = lu(k,1483) - lu(k,886) * lu(k,1478) - lu(k,1486) = lu(k,1486) - lu(k,887) * lu(k,1478) - lu(k,1487) = lu(k,1487) - lu(k,888) * lu(k,1478) - lu(k,1507) = lu(k,1507) - lu(k,889) * lu(k,1478) - lu(k,1513) = lu(k,1513) - lu(k,890) * lu(k,1478) - lu(k,1517) = lu(k,1517) - lu(k,891) * lu(k,1478) - lu(k,1615) = lu(k,1615) - lu(k,885) * lu(k,1611) - lu(k,1616) = lu(k,1616) - lu(k,886) * lu(k,1611) - lu(k,1619) = lu(k,1619) - lu(k,887) * lu(k,1611) - lu(k,1620) = lu(k,1620) - lu(k,888) * lu(k,1611) - lu(k,1638) = lu(k,1638) - lu(k,889) * lu(k,1611) - lu(k,1644) = lu(k,1644) - lu(k,890) * lu(k,1611) - lu(k,1648) = lu(k,1648) - lu(k,891) * lu(k,1611) - lu(k,1666) = lu(k,1666) - lu(k,885) * lu(k,1663) - lu(k,1667) = lu(k,1667) - lu(k,886) * lu(k,1663) - lu(k,1670) = lu(k,1670) - lu(k,887) * lu(k,1663) - lu(k,1671) = lu(k,1671) - lu(k,888) * lu(k,1663) - lu(k,1688) = lu(k,1688) - lu(k,889) * lu(k,1663) - lu(k,1694) = lu(k,1694) - lu(k,890) * lu(k,1663) - lu(k,1698) = - lu(k,891) * lu(k,1663) - lu(k,1815) = lu(k,1815) - lu(k,885) * lu(k,1813) - lu(k,1816) = lu(k,1816) - lu(k,886) * lu(k,1813) - lu(k,1819) = lu(k,1819) - lu(k,887) * lu(k,1813) - lu(k,1820) = lu(k,1820) - lu(k,888) * lu(k,1813) - lu(k,1839) = lu(k,1839) - lu(k,889) * lu(k,1813) - lu(k,1845) = lu(k,1845) - lu(k,890) * lu(k,1813) - lu(k,1849) = lu(k,1849) - lu(k,891) * lu(k,1813) - lu(k,1959) = lu(k,1959) - lu(k,885) * lu(k,1955) - lu(k,1960) = lu(k,1960) - lu(k,886) * lu(k,1955) - lu(k,1963) = lu(k,1963) - lu(k,887) * lu(k,1955) - lu(k,1964) = lu(k,1964) - lu(k,888) * lu(k,1955) - lu(k,1983) = lu(k,1983) - lu(k,889) * lu(k,1955) - lu(k,1989) = lu(k,1989) - lu(k,890) * lu(k,1955) - lu(k,1993) = lu(k,1993) - lu(k,891) * lu(k,1955) - lu(k,2020) = lu(k,2020) - lu(k,885) * lu(k,2018) - lu(k,2021) = lu(k,2021) - lu(k,886) * lu(k,2018) - lu(k,2024) = - lu(k,887) * lu(k,2018) - lu(k,2025) = lu(k,2025) - lu(k,888) * lu(k,2018) - lu(k,2043) = lu(k,2043) - lu(k,889) * lu(k,2018) - lu(k,2049) = lu(k,2049) - lu(k,890) * lu(k,2018) - lu(k,2053) = lu(k,2053) - lu(k,891) * lu(k,2018) - lu(k,896) = 1._r8 / lu(k,896) - lu(k,897) = lu(k,897) * lu(k,896) - lu(k,898) = lu(k,898) * lu(k,896) - lu(k,899) = lu(k,899) * lu(k,896) - lu(k,900) = lu(k,900) * lu(k,896) - lu(k,901) = lu(k,901) * lu(k,896) - lu(k,902) = lu(k,902) * lu(k,896) - lu(k,903) = lu(k,903) * lu(k,896) - lu(k,904) = lu(k,904) * lu(k,896) - lu(k,905) = lu(k,905) * lu(k,896) - lu(k,906) = lu(k,906) * lu(k,896) - lu(k,1070) = - lu(k,897) * lu(k,1068) - lu(k,1074) = lu(k,1074) - lu(k,898) * lu(k,1068) - lu(k,1076) = lu(k,1076) - lu(k,899) * lu(k,1068) - lu(k,1077) = lu(k,1077) - lu(k,900) * lu(k,1068) - lu(k,1079) = lu(k,1079) - lu(k,901) * lu(k,1068) - lu(k,1080) = lu(k,1080) - lu(k,902) * lu(k,1068) - lu(k,1081) = lu(k,1081) - lu(k,903) * lu(k,1068) - lu(k,1082) = lu(k,1082) - lu(k,904) * lu(k,1068) - lu(k,1083) = lu(k,1083) - lu(k,905) * lu(k,1068) - lu(k,1084) = lu(k,1084) - lu(k,906) * lu(k,1068) - lu(k,1253) = lu(k,1253) - lu(k,897) * lu(k,1251) - lu(k,1258) = lu(k,1258) - lu(k,898) * lu(k,1251) - lu(k,1264) = lu(k,1264) - lu(k,899) * lu(k,1251) - lu(k,1265) = - lu(k,900) * lu(k,1251) - lu(k,1267) = lu(k,1267) - lu(k,901) * lu(k,1251) - lu(k,1268) = lu(k,1268) - lu(k,902) * lu(k,1251) - lu(k,1269) = lu(k,1269) - lu(k,903) * lu(k,1251) - lu(k,1270) = lu(k,1270) - lu(k,904) * lu(k,1251) - lu(k,1271) = lu(k,1271) - lu(k,905) * lu(k,1251) - lu(k,1272) = lu(k,1272) - lu(k,906) * lu(k,1251) - lu(k,1483) = lu(k,1483) - lu(k,897) * lu(k,1479) - lu(k,1494) = lu(k,1494) - lu(k,898) * lu(k,1479) - lu(k,1501) = lu(k,1501) - lu(k,899) * lu(k,1479) - lu(k,1503) = lu(k,1503) - lu(k,900) * lu(k,1479) - lu(k,1507) = lu(k,1507) - lu(k,901) * lu(k,1479) - lu(k,1508) = lu(k,1508) - lu(k,902) * lu(k,1479) - lu(k,1509) = lu(k,1509) - lu(k,903) * lu(k,1479) - lu(k,1510) = lu(k,1510) - lu(k,904) * lu(k,1479) - lu(k,1512) = lu(k,1512) - lu(k,905) * lu(k,1479) - lu(k,1513) = lu(k,1513) - lu(k,906) * lu(k,1479) - lu(k,1616) = lu(k,1616) - lu(k,897) * lu(k,1612) - lu(k,1626) = lu(k,1626) - lu(k,898) * lu(k,1612) - lu(k,1632) = lu(k,1632) - lu(k,899) * lu(k,1612) - lu(k,1634) = lu(k,1634) - lu(k,900) * lu(k,1612) - lu(k,1638) = lu(k,1638) - lu(k,901) * lu(k,1612) - lu(k,1639) = lu(k,1639) - lu(k,902) * lu(k,1612) - lu(k,1640) = lu(k,1640) - lu(k,903) * lu(k,1612) - lu(k,1641) = lu(k,1641) - lu(k,904) * lu(k,1612) - lu(k,1643) = lu(k,1643) - lu(k,905) * lu(k,1612) - lu(k,1644) = lu(k,1644) - lu(k,906) * lu(k,1612) - lu(k,1667) = lu(k,1667) - lu(k,897) * lu(k,1664) - lu(k,1677) = lu(k,1677) - lu(k,898) * lu(k,1664) - lu(k,1683) = lu(k,1683) - lu(k,899) * lu(k,1664) - lu(k,1684) = lu(k,1684) - lu(k,900) * lu(k,1664) - lu(k,1688) = lu(k,1688) - lu(k,901) * lu(k,1664) - lu(k,1689) = lu(k,1689) - lu(k,902) * lu(k,1664) - lu(k,1690) = lu(k,1690) - lu(k,903) * lu(k,1664) - lu(k,1691) = lu(k,1691) - lu(k,904) * lu(k,1664) - lu(k,1693) = lu(k,1693) - lu(k,905) * lu(k,1664) - lu(k,1694) = lu(k,1694) - lu(k,906) * lu(k,1664) - lu(k,1960) = lu(k,1960) - lu(k,897) * lu(k,1956) - lu(k,1970) = lu(k,1970) - lu(k,898) * lu(k,1956) - lu(k,1977) = lu(k,1977) - lu(k,899) * lu(k,1956) - lu(k,1979) = lu(k,1979) - lu(k,900) * lu(k,1956) - lu(k,1983) = lu(k,1983) - lu(k,901) * lu(k,1956) - lu(k,1984) = lu(k,1984) - lu(k,902) * lu(k,1956) - lu(k,1985) = lu(k,1985) - lu(k,903) * lu(k,1956) - lu(k,1986) = lu(k,1986) - lu(k,904) * lu(k,1956) - lu(k,1988) = lu(k,1988) - lu(k,905) * lu(k,1956) - lu(k,1989) = lu(k,1989) - lu(k,906) * lu(k,1956) - lu(k,908) = 1._r8 / lu(k,908) - lu(k,909) = lu(k,909) * lu(k,908) - lu(k,910) = lu(k,910) * lu(k,908) - lu(k,911) = lu(k,911) * lu(k,908) - lu(k,912) = lu(k,912) * lu(k,908) - lu(k,917) = lu(k,917) - lu(k,909) * lu(k,915) - lu(k,923) = lu(k,923) - lu(k,910) * lu(k,915) - lu(k,926) = lu(k,926) - lu(k,911) * lu(k,915) - lu(k,927) = lu(k,927) - lu(k,912) * lu(k,915) - lu(k,977) = lu(k,977) - lu(k,909) * lu(k,975) - lu(k,983) = lu(k,983) - lu(k,910) * lu(k,975) - lu(k,987) = lu(k,987) - lu(k,911) * lu(k,975) - lu(k,988) = lu(k,988) - lu(k,912) * lu(k,975) - lu(k,1050) = lu(k,1050) - lu(k,909) * lu(k,1049) - lu(k,1056) = lu(k,1056) - lu(k,910) * lu(k,1049) - lu(k,1060) = lu(k,1060) - lu(k,911) * lu(k,1049) - lu(k,1061) = lu(k,1061) - lu(k,912) * lu(k,1049) - lu(k,1070) = lu(k,1070) - lu(k,909) * lu(k,1069) - lu(k,1079) = lu(k,1079) - lu(k,910) * lu(k,1069) - lu(k,1083) = lu(k,1083) - lu(k,911) * lu(k,1069) - lu(k,1084) = lu(k,1084) - lu(k,912) * lu(k,1069) - lu(k,1135) = lu(k,1135) - lu(k,909) * lu(k,1133) - lu(k,1149) = lu(k,1149) - lu(k,910) * lu(k,1133) - lu(k,1153) = lu(k,1153) - lu(k,911) * lu(k,1133) - lu(k,1154) = lu(k,1154) - lu(k,912) * lu(k,1133) - lu(k,1182) = lu(k,1182) - lu(k,909) * lu(k,1180) - lu(k,1192) = lu(k,1192) - lu(k,910) * lu(k,1180) - lu(k,1196) = lu(k,1196) - lu(k,911) * lu(k,1180) - lu(k,1197) = lu(k,1197) - lu(k,912) * lu(k,1180) - lu(k,1205) = - lu(k,909) * lu(k,1203) - lu(k,1219) = lu(k,1219) - lu(k,910) * lu(k,1203) - lu(k,1223) = lu(k,1223) - lu(k,911) * lu(k,1203) - lu(k,1224) = lu(k,1224) - lu(k,912) * lu(k,1203) - lu(k,1253) = lu(k,1253) - lu(k,909) * lu(k,1252) - lu(k,1267) = lu(k,1267) - lu(k,910) * lu(k,1252) - lu(k,1271) = lu(k,1271) - lu(k,911) * lu(k,1252) - lu(k,1272) = lu(k,1272) - lu(k,912) * lu(k,1252) - lu(k,1483) = lu(k,1483) - lu(k,909) * lu(k,1480) - lu(k,1507) = lu(k,1507) - lu(k,910) * lu(k,1480) - lu(k,1512) = lu(k,1512) - lu(k,911) * lu(k,1480) - lu(k,1513) = lu(k,1513) - lu(k,912) * lu(k,1480) - lu(k,1616) = lu(k,1616) - lu(k,909) * lu(k,1613) - lu(k,1638) = lu(k,1638) - lu(k,910) * lu(k,1613) - lu(k,1643) = lu(k,1643) - lu(k,911) * lu(k,1613) - lu(k,1644) = lu(k,1644) - lu(k,912) * lu(k,1613) - lu(k,1667) = lu(k,1667) - lu(k,909) * lu(k,1665) - lu(k,1688) = lu(k,1688) - lu(k,910) * lu(k,1665) - lu(k,1693) = lu(k,1693) - lu(k,911) * lu(k,1665) - lu(k,1694) = lu(k,1694) - lu(k,912) * lu(k,1665) - lu(k,1816) = lu(k,1816) - lu(k,909) * lu(k,1814) - lu(k,1839) = lu(k,1839) - lu(k,910) * lu(k,1814) - lu(k,1844) = lu(k,1844) - lu(k,911) * lu(k,1814) - lu(k,1845) = lu(k,1845) - lu(k,912) * lu(k,1814) - lu(k,1917) = lu(k,1917) - lu(k,909) * lu(k,1916) - lu(k,1926) = lu(k,1926) - lu(k,910) * lu(k,1916) - lu(k,1931) = lu(k,1931) - lu(k,911) * lu(k,1916) - lu(k,1932) = lu(k,1932) - lu(k,912) * lu(k,1916) - lu(k,1960) = lu(k,1960) - lu(k,909) * lu(k,1957) - lu(k,1983) = lu(k,1983) - lu(k,910) * lu(k,1957) - lu(k,1988) = lu(k,1988) - lu(k,911) * lu(k,1957) - lu(k,1989) = lu(k,1989) - lu(k,912) * lu(k,1957) - lu(k,2021) = lu(k,2021) - lu(k,909) * lu(k,2019) - lu(k,2043) = lu(k,2043) - lu(k,910) * lu(k,2019) - lu(k,2048) = lu(k,2048) - lu(k,911) * lu(k,2019) - lu(k,2049) = lu(k,2049) - lu(k,912) * lu(k,2019) - lu(k,916) = 1._r8 / lu(k,916) - lu(k,917) = lu(k,917) * lu(k,916) - lu(k,918) = lu(k,918) * lu(k,916) - lu(k,919) = lu(k,919) * lu(k,916) - lu(k,920) = lu(k,920) * lu(k,916) - lu(k,921) = lu(k,921) * lu(k,916) - lu(k,922) = lu(k,922) * lu(k,916) - lu(k,923) = lu(k,923) * lu(k,916) - lu(k,924) = lu(k,924) * lu(k,916) - lu(k,925) = lu(k,925) * lu(k,916) - lu(k,926) = lu(k,926) * lu(k,916) - lu(k,927) = lu(k,927) * lu(k,916) - lu(k,928) = lu(k,928) * lu(k,916) - lu(k,1135) = lu(k,1135) - lu(k,917) * lu(k,1134) - lu(k,1136) = lu(k,1136) - lu(k,918) * lu(k,1134) - lu(k,1137) = - lu(k,919) * lu(k,1134) - lu(k,1138) = - lu(k,920) * lu(k,1134) - lu(k,1146) = lu(k,1146) - lu(k,921) * lu(k,1134) - lu(k,1147) = lu(k,1147) - lu(k,922) * lu(k,1134) - lu(k,1149) = lu(k,1149) - lu(k,923) * lu(k,1134) - lu(k,1150) = lu(k,1150) - lu(k,924) * lu(k,1134) - lu(k,1152) = lu(k,1152) - lu(k,925) * lu(k,1134) - lu(k,1153) = lu(k,1153) - lu(k,926) * lu(k,1134) - lu(k,1154) = lu(k,1154) - lu(k,927) * lu(k,1134) - lu(k,1157) = - lu(k,928) * lu(k,1134) - lu(k,1182) = lu(k,1182) - lu(k,917) * lu(k,1181) - lu(k,1183) = lu(k,1183) - lu(k,918) * lu(k,1181) - lu(k,1184) = - lu(k,919) * lu(k,1181) - lu(k,1185) = - lu(k,920) * lu(k,1181) - lu(k,1189) = lu(k,1189) - lu(k,921) * lu(k,1181) - lu(k,1190) = - lu(k,922) * lu(k,1181) - lu(k,1192) = lu(k,1192) - lu(k,923) * lu(k,1181) - lu(k,1193) = lu(k,1193) - lu(k,924) * lu(k,1181) - lu(k,1195) = lu(k,1195) - lu(k,925) * lu(k,1181) - lu(k,1196) = lu(k,1196) - lu(k,926) * lu(k,1181) - lu(k,1197) = lu(k,1197) - lu(k,927) * lu(k,1181) - lu(k,1199) = - lu(k,928) * lu(k,1181) - lu(k,1205) = lu(k,1205) - lu(k,917) * lu(k,1204) - lu(k,1206) = lu(k,1206) - lu(k,918) * lu(k,1204) - lu(k,1207) = - lu(k,919) * lu(k,1204) - lu(k,1208) = - lu(k,920) * lu(k,1204) - lu(k,1216) = lu(k,1216) - lu(k,921) * lu(k,1204) - lu(k,1217) = lu(k,1217) - lu(k,922) * lu(k,1204) - lu(k,1219) = lu(k,1219) - lu(k,923) * lu(k,1204) - lu(k,1220) = lu(k,1220) - lu(k,924) * lu(k,1204) - lu(k,1222) = lu(k,1222) - lu(k,925) * lu(k,1204) - lu(k,1223) = lu(k,1223) - lu(k,926) * lu(k,1204) - lu(k,1224) = lu(k,1224) - lu(k,927) * lu(k,1204) - lu(k,1227) = - lu(k,928) * lu(k,1204) - lu(k,1483) = lu(k,1483) - lu(k,917) * lu(k,1481) - lu(k,1484) = lu(k,1484) - lu(k,918) * lu(k,1481) - lu(k,1488) = lu(k,1488) - lu(k,919) * lu(k,1481) - lu(k,1489) = lu(k,1489) - lu(k,920) * lu(k,1481) - lu(k,1501) = lu(k,1501) - lu(k,921) * lu(k,1481) - lu(k,1503) = lu(k,1503) - lu(k,922) * lu(k,1481) - lu(k,1507) = lu(k,1507) - lu(k,923) * lu(k,1481) - lu(k,1508) = lu(k,1508) - lu(k,924) * lu(k,1481) - lu(k,1510) = lu(k,1510) - lu(k,925) * lu(k,1481) - lu(k,1512) = lu(k,1512) - lu(k,926) * lu(k,1481) - lu(k,1513) = lu(k,1513) - lu(k,927) * lu(k,1481) - lu(k,1519) = lu(k,1519) - lu(k,928) * lu(k,1481) - lu(k,1616) = lu(k,1616) - lu(k,917) * lu(k,1614) - lu(k,1617) = lu(k,1617) - lu(k,918) * lu(k,1614) - lu(k,1621) = lu(k,1621) - lu(k,919) * lu(k,1614) - lu(k,1622) = lu(k,1622) - lu(k,920) * lu(k,1614) - lu(k,1632) = lu(k,1632) - lu(k,921) * lu(k,1614) - lu(k,1634) = lu(k,1634) - lu(k,922) * lu(k,1614) - lu(k,1638) = lu(k,1638) - lu(k,923) * lu(k,1614) - lu(k,1639) = lu(k,1639) - lu(k,924) * lu(k,1614) - lu(k,1641) = lu(k,1641) - lu(k,925) * lu(k,1614) - lu(k,1643) = lu(k,1643) - lu(k,926) * lu(k,1614) - lu(k,1644) = lu(k,1644) - lu(k,927) * lu(k,1614) - lu(k,1650) = lu(k,1650) - lu(k,928) * lu(k,1614) - lu(k,1960) = lu(k,1960) - lu(k,917) * lu(k,1958) - lu(k,1961) = lu(k,1961) - lu(k,918) * lu(k,1958) - lu(k,1965) = lu(k,1965) - lu(k,919) * lu(k,1958) - lu(k,1966) = lu(k,1966) - lu(k,920) * lu(k,1958) - lu(k,1977) = lu(k,1977) - lu(k,921) * lu(k,1958) - lu(k,1979) = lu(k,1979) - lu(k,922) * lu(k,1958) - lu(k,1983) = lu(k,1983) - lu(k,923) * lu(k,1958) - lu(k,1984) = lu(k,1984) - lu(k,924) * lu(k,1958) - lu(k,1986) = lu(k,1986) - lu(k,925) * lu(k,1958) - lu(k,1988) = lu(k,1988) - lu(k,926) * lu(k,1958) - lu(k,1989) = lu(k,1989) - lu(k,927) * lu(k,1958) - lu(k,1995) = lu(k,1995) - lu(k,928) * lu(k,1958) + lu(k,892) = lu(k,892) * lu(k,884) + lu(k,893) = lu(k,893) * lu(k,884) + lu(k,1687) = lu(k,1687) - lu(k,885) * lu(k,1653) + lu(k,1691) = lu(k,1691) - lu(k,886) * lu(k,1653) + lu(k,1692) = lu(k,1692) - lu(k,887) * lu(k,1653) + lu(k,1695) = lu(k,1695) - lu(k,888) * lu(k,1653) + lu(k,1696) = lu(k,1696) - lu(k,889) * lu(k,1653) + lu(k,1699) = lu(k,1699) - lu(k,890) * lu(k,1653) + lu(k,1700) = lu(k,1700) - lu(k,891) * lu(k,1653) + lu(k,1702) = lu(k,1702) - lu(k,892) * lu(k,1653) + lu(k,1703) = lu(k,1703) - lu(k,893) * lu(k,1653) + lu(k,1969) = - lu(k,885) * lu(k,1966) + lu(k,1973) = lu(k,1973) - lu(k,886) * lu(k,1966) + lu(k,1974) = - lu(k,887) * lu(k,1966) + lu(k,1977) = lu(k,1977) - lu(k,888) * lu(k,1966) + lu(k,1978) = lu(k,1978) - lu(k,889) * lu(k,1966) + lu(k,1981) = lu(k,1981) - lu(k,890) * lu(k,1966) + lu(k,1982) = lu(k,1982) - lu(k,891) * lu(k,1966) + lu(k,1984) = lu(k,1984) - lu(k,892) * lu(k,1966) + lu(k,1985) = lu(k,1985) - lu(k,893) * lu(k,1966) + lu(k,2008) = - lu(k,885) * lu(k,1998) + lu(k,2012) = lu(k,2012) - lu(k,886) * lu(k,1998) + lu(k,2013) = lu(k,2013) - lu(k,887) * lu(k,1998) + lu(k,2016) = lu(k,2016) - lu(k,888) * lu(k,1998) + lu(k,2017) = lu(k,2017) - lu(k,889) * lu(k,1998) + lu(k,2020) = lu(k,2020) - lu(k,890) * lu(k,1998) + lu(k,2021) = lu(k,2021) - lu(k,891) * lu(k,1998) + lu(k,2023) = lu(k,2023) - lu(k,892) * lu(k,1998) + lu(k,2024) = lu(k,2024) - lu(k,893) * lu(k,1998) + lu(k,2144) = lu(k,2144) - lu(k,885) * lu(k,2142) + lu(k,2148) = lu(k,2148) - lu(k,886) * lu(k,2142) + lu(k,2149) = - lu(k,887) * lu(k,2142) + lu(k,2152) = lu(k,2152) - lu(k,888) * lu(k,2142) + lu(k,2153) = lu(k,2153) - lu(k,889) * lu(k,2142) + lu(k,2156) = lu(k,2156) - lu(k,890) * lu(k,2142) + lu(k,2157) = - lu(k,891) * lu(k,2142) + lu(k,2159) = lu(k,2159) - lu(k,892) * lu(k,2142) + lu(k,2160) = lu(k,2160) - lu(k,893) * lu(k,2142) + lu(k,2188) = lu(k,2188) - lu(k,885) * lu(k,2178) + lu(k,2192) = lu(k,2192) - lu(k,886) * lu(k,2178) + lu(k,2193) = lu(k,2193) - lu(k,887) * lu(k,2178) + lu(k,2196) = lu(k,2196) - lu(k,888) * lu(k,2178) + lu(k,2197) = lu(k,2197) - lu(k,889) * lu(k,2178) + lu(k,2200) = lu(k,2200) - lu(k,890) * lu(k,2178) + lu(k,2201) = lu(k,2201) - lu(k,891) * lu(k,2178) + lu(k,2203) = lu(k,2203) - lu(k,892) * lu(k,2178) + lu(k,2204) = lu(k,2204) - lu(k,893) * lu(k,2178) + lu(k,2243) = lu(k,2243) - lu(k,885) * lu(k,2237) + lu(k,2247) = lu(k,2247) - lu(k,886) * lu(k,2237) + lu(k,2248) = lu(k,2248) - lu(k,887) * lu(k,2237) + lu(k,2251) = lu(k,2251) - lu(k,888) * lu(k,2237) + lu(k,2252) = lu(k,2252) - lu(k,889) * lu(k,2237) + lu(k,2255) = lu(k,2255) - lu(k,890) * lu(k,2237) + lu(k,2256) = lu(k,2256) - lu(k,891) * lu(k,2237) + lu(k,2258) = lu(k,2258) - lu(k,892) * lu(k,2237) + lu(k,2259) = lu(k,2259) - lu(k,893) * lu(k,2237) end do end subroutine lu_fac19 subroutine lu_fac20( avec_len, lu ) @@ -3573,343 +3222,261 @@ subroutine lu_fac20( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,930) = 1._r8 / lu(k,930) - lu(k,931) = lu(k,931) * lu(k,930) - lu(k,932) = lu(k,932) * lu(k,930) - lu(k,933) = lu(k,933) * lu(k,930) - lu(k,934) = lu(k,934) * lu(k,930) - lu(k,935) = lu(k,935) * lu(k,930) - lu(k,936) = lu(k,936) * lu(k,930) - lu(k,937) = lu(k,937) * lu(k,930) - lu(k,938) = lu(k,938) * lu(k,930) - lu(k,955) = lu(k,955) - lu(k,931) * lu(k,954) - lu(k,959) = lu(k,959) - lu(k,932) * lu(k,954) - lu(k,960) = lu(k,960) - lu(k,933) * lu(k,954) - lu(k,963) = lu(k,963) - lu(k,934) * lu(k,954) - lu(k,966) = lu(k,966) - lu(k,935) * lu(k,954) - lu(k,967) = lu(k,967) - lu(k,936) * lu(k,954) - lu(k,968) = lu(k,968) - lu(k,937) * lu(k,954) - lu(k,970) = lu(k,970) - lu(k,938) * lu(k,954) - lu(k,977) = lu(k,977) - lu(k,931) * lu(k,976) - lu(k,979) = lu(k,979) - lu(k,932) * lu(k,976) - lu(k,980) = lu(k,980) - lu(k,933) * lu(k,976) - lu(k,983) = lu(k,983) - lu(k,934) * lu(k,976) - lu(k,986) = lu(k,986) - lu(k,935) * lu(k,976) - lu(k,987) = lu(k,987) - lu(k,936) * lu(k,976) - lu(k,988) = lu(k,988) - lu(k,937) * lu(k,976) - lu(k,989) = lu(k,989) - lu(k,938) * lu(k,976) - lu(k,995) = lu(k,995) - lu(k,931) * lu(k,994) - lu(k,998) = - lu(k,932) * lu(k,994) - lu(k,999) = - lu(k,933) * lu(k,994) - lu(k,1002) = lu(k,1002) - lu(k,934) * lu(k,994) - lu(k,1005) = lu(k,1005) - lu(k,935) * lu(k,994) - lu(k,1006) = lu(k,1006) - lu(k,936) * lu(k,994) - lu(k,1007) = lu(k,1007) - lu(k,937) * lu(k,994) - lu(k,1009) = - lu(k,938) * lu(k,994) - lu(k,1483) = lu(k,1483) - lu(k,931) * lu(k,1482) - lu(k,1488) = lu(k,1488) - lu(k,932) * lu(k,1482) - lu(k,1501) = lu(k,1501) - lu(k,933) * lu(k,1482) - lu(k,1507) = lu(k,1507) - lu(k,934) * lu(k,1482) - lu(k,1510) = lu(k,1510) - lu(k,935) * lu(k,1482) - lu(k,1512) = lu(k,1512) - lu(k,936) * lu(k,1482) - lu(k,1513) = lu(k,1513) - lu(k,937) * lu(k,1482) - lu(k,1519) = lu(k,1519) - lu(k,938) * lu(k,1482) - lu(k,1616) = lu(k,1616) - lu(k,931) * lu(k,1615) - lu(k,1621) = lu(k,1621) - lu(k,932) * lu(k,1615) - lu(k,1632) = lu(k,1632) - lu(k,933) * lu(k,1615) - lu(k,1638) = lu(k,1638) - lu(k,934) * lu(k,1615) - lu(k,1641) = lu(k,1641) - lu(k,935) * lu(k,1615) - lu(k,1643) = lu(k,1643) - lu(k,936) * lu(k,1615) - lu(k,1644) = lu(k,1644) - lu(k,937) * lu(k,1615) - lu(k,1650) = lu(k,1650) - lu(k,938) * lu(k,1615) - lu(k,1667) = lu(k,1667) - lu(k,931) * lu(k,1666) - lu(k,1672) = lu(k,1672) - lu(k,932) * lu(k,1666) - lu(k,1683) = lu(k,1683) - lu(k,933) * lu(k,1666) - lu(k,1688) = lu(k,1688) - lu(k,934) * lu(k,1666) - lu(k,1691) = lu(k,1691) - lu(k,935) * lu(k,1666) - lu(k,1693) = lu(k,1693) - lu(k,936) * lu(k,1666) - lu(k,1694) = lu(k,1694) - lu(k,937) * lu(k,1666) - lu(k,1700) = lu(k,1700) - lu(k,938) * lu(k,1666) - lu(k,1816) = lu(k,1816) - lu(k,931) * lu(k,1815) - lu(k,1821) = lu(k,1821) - lu(k,932) * lu(k,1815) - lu(k,1833) = lu(k,1833) - lu(k,933) * lu(k,1815) - lu(k,1839) = lu(k,1839) - lu(k,934) * lu(k,1815) - lu(k,1842) = lu(k,1842) - lu(k,935) * lu(k,1815) - lu(k,1844) = lu(k,1844) - lu(k,936) * lu(k,1815) - lu(k,1845) = lu(k,1845) - lu(k,937) * lu(k,1815) - lu(k,1851) = lu(k,1851) - lu(k,938) * lu(k,1815) - lu(k,1960) = lu(k,1960) - lu(k,931) * lu(k,1959) - lu(k,1965) = lu(k,1965) - lu(k,932) * lu(k,1959) - lu(k,1977) = lu(k,1977) - lu(k,933) * lu(k,1959) - lu(k,1983) = lu(k,1983) - lu(k,934) * lu(k,1959) - lu(k,1986) = lu(k,1986) - lu(k,935) * lu(k,1959) - lu(k,1988) = lu(k,1988) - lu(k,936) * lu(k,1959) - lu(k,1989) = lu(k,1989) - lu(k,937) * lu(k,1959) - lu(k,1995) = lu(k,1995) - lu(k,938) * lu(k,1959) - lu(k,2021) = lu(k,2021) - lu(k,931) * lu(k,2020) - lu(k,2026) = lu(k,2026) - lu(k,932) * lu(k,2020) - lu(k,2037) = lu(k,2037) - lu(k,933) * lu(k,2020) - lu(k,2043) = lu(k,2043) - lu(k,934) * lu(k,2020) - lu(k,2046) = lu(k,2046) - lu(k,935) * lu(k,2020) - lu(k,2048) = lu(k,2048) - lu(k,936) * lu(k,2020) - lu(k,2049) = lu(k,2049) - lu(k,937) * lu(k,2020) - lu(k,2055) = lu(k,2055) - lu(k,938) * lu(k,2020) - lu(k,939) = 1._r8 / lu(k,939) - lu(k,940) = lu(k,940) * lu(k,939) - lu(k,941) = lu(k,941) * lu(k,939) - lu(k,942) = lu(k,942) * lu(k,939) - lu(k,962) = - lu(k,940) * lu(k,955) - lu(k,963) = lu(k,963) - lu(k,941) * lu(k,955) - lu(k,968) = lu(k,968) - lu(k,942) * lu(k,955) - lu(k,982) = - lu(k,940) * lu(k,977) - lu(k,983) = lu(k,983) - lu(k,941) * lu(k,977) - lu(k,988) = lu(k,988) - lu(k,942) * lu(k,977) - lu(k,1001) = - lu(k,940) * lu(k,995) - lu(k,1002) = lu(k,1002) - lu(k,941) * lu(k,995) - lu(k,1007) = lu(k,1007) - lu(k,942) * lu(k,995) - lu(k,1027) = - lu(k,940) * lu(k,1023) - lu(k,1028) = lu(k,1028) - lu(k,941) * lu(k,1023) - lu(k,1030) = lu(k,1030) - lu(k,942) * lu(k,1023) - lu(k,1055) = - lu(k,940) * lu(k,1050) - lu(k,1056) = lu(k,1056) - lu(k,941) * lu(k,1050) - lu(k,1061) = lu(k,1061) - lu(k,942) * lu(k,1050) - lu(k,1078) = - lu(k,940) * lu(k,1070) - lu(k,1079) = lu(k,1079) - lu(k,941) * lu(k,1070) - lu(k,1084) = lu(k,1084) - lu(k,942) * lu(k,1070) - lu(k,1093) = - lu(k,940) * lu(k,1087) - lu(k,1094) = lu(k,1094) - lu(k,941) * lu(k,1087) - lu(k,1096) = lu(k,1096) - lu(k,942) * lu(k,1087) - lu(k,1103) = - lu(k,940) * lu(k,1099) - lu(k,1104) = lu(k,1104) - lu(k,941) * lu(k,1099) - lu(k,1105) = lu(k,1105) - lu(k,942) * lu(k,1099) - lu(k,1148) = - lu(k,940) * lu(k,1135) - lu(k,1149) = lu(k,1149) - lu(k,941) * lu(k,1135) - lu(k,1154) = lu(k,1154) - lu(k,942) * lu(k,1135) - lu(k,1168) = - lu(k,940) * lu(k,1160) - lu(k,1169) = lu(k,1169) - lu(k,941) * lu(k,1160) - lu(k,1174) = lu(k,1174) - lu(k,942) * lu(k,1160) - lu(k,1191) = - lu(k,940) * lu(k,1182) - lu(k,1192) = lu(k,1192) - lu(k,941) * lu(k,1182) - lu(k,1197) = lu(k,1197) - lu(k,942) * lu(k,1182) - lu(k,1218) = - lu(k,940) * lu(k,1205) - lu(k,1219) = lu(k,1219) - lu(k,941) * lu(k,1205) - lu(k,1224) = lu(k,1224) - lu(k,942) * lu(k,1205) - lu(k,1266) = - lu(k,940) * lu(k,1253) - lu(k,1267) = lu(k,1267) - lu(k,941) * lu(k,1253) - lu(k,1272) = lu(k,1272) - lu(k,942) * lu(k,1253) - lu(k,1279) = lu(k,1279) - lu(k,940) * lu(k,1277) - lu(k,1281) = lu(k,1281) - lu(k,941) * lu(k,1277) - lu(k,1284) = lu(k,1284) - lu(k,942) * lu(k,1277) - lu(k,1504) = lu(k,1504) - lu(k,940) * lu(k,1483) - lu(k,1507) = lu(k,1507) - lu(k,941) * lu(k,1483) - lu(k,1513) = lu(k,1513) - lu(k,942) * lu(k,1483) - lu(k,1545) = lu(k,1545) - lu(k,940) * lu(k,1537) - lu(k,1548) = lu(k,1548) - lu(k,941) * lu(k,1537) - lu(k,1554) = lu(k,1554) - lu(k,942) * lu(k,1537) - lu(k,1635) = lu(k,1635) - lu(k,940) * lu(k,1616) - lu(k,1638) = lu(k,1638) - lu(k,941) * lu(k,1616) - lu(k,1644) = lu(k,1644) - lu(k,942) * lu(k,1616) - lu(k,1685) = lu(k,1685) - lu(k,940) * lu(k,1667) - lu(k,1688) = lu(k,1688) - lu(k,941) * lu(k,1667) - lu(k,1694) = lu(k,1694) - lu(k,942) * lu(k,1667) - lu(k,1732) = lu(k,1732) - lu(k,940) * lu(k,1728) - lu(k,1734) = lu(k,1734) - lu(k,941) * lu(k,1728) - lu(k,1740) = lu(k,1740) - lu(k,942) * lu(k,1728) - lu(k,1836) = lu(k,1836) - lu(k,940) * lu(k,1816) - lu(k,1839) = lu(k,1839) - lu(k,941) * lu(k,1816) - lu(k,1845) = lu(k,1845) - lu(k,942) * lu(k,1816) - lu(k,1866) = lu(k,1866) - lu(k,940) * lu(k,1861) - lu(k,1869) = lu(k,1869) - lu(k,941) * lu(k,1861) - lu(k,1875) = lu(k,1875) - lu(k,942) * lu(k,1861) - lu(k,1923) = lu(k,1923) - lu(k,940) * lu(k,1917) - lu(k,1926) = lu(k,1926) - lu(k,941) * lu(k,1917) - lu(k,1932) = lu(k,1932) - lu(k,942) * lu(k,1917) - lu(k,1980) = - lu(k,940) * lu(k,1960) - lu(k,1983) = lu(k,1983) - lu(k,941) * lu(k,1960) - lu(k,1989) = lu(k,1989) - lu(k,942) * lu(k,1960) - lu(k,2040) = lu(k,2040) - lu(k,940) * lu(k,2021) - lu(k,2043) = lu(k,2043) - lu(k,941) * lu(k,2021) - lu(k,2049) = lu(k,2049) - lu(k,942) * lu(k,2021) - 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,1014) = lu(k,1014) - lu(k,944) * lu(k,1012) - lu(k,1015) = lu(k,1015) - lu(k,945) * lu(k,1012) - lu(k,1016) = lu(k,1016) - lu(k,946) * lu(k,1012) - lu(k,1020) = lu(k,1020) - lu(k,947) * lu(k,1012) - lu(k,1021) = lu(k,1021) - lu(k,948) * lu(k,1012) - lu(k,1053) = lu(k,1053) - lu(k,944) * lu(k,1051) - lu(k,1054) = lu(k,1054) - lu(k,945) * lu(k,1051) - lu(k,1056) = lu(k,1056) - lu(k,946) * lu(k,1051) - lu(k,1060) = lu(k,1060) - lu(k,947) * lu(k,1051) - lu(k,1061) = lu(k,1061) - lu(k,948) * lu(k,1051) - lu(k,1141) = lu(k,1141) - lu(k,944) * lu(k,1136) - lu(k,1146) = lu(k,1146) - lu(k,945) * lu(k,1136) - lu(k,1149) = lu(k,1149) - lu(k,946) * lu(k,1136) - lu(k,1153) = lu(k,1153) - lu(k,947) * lu(k,1136) - lu(k,1154) = lu(k,1154) - lu(k,948) * lu(k,1136) - lu(k,1163) = lu(k,1163) - lu(k,944) * lu(k,1161) - lu(k,1166) = lu(k,1166) - lu(k,945) * lu(k,1161) - lu(k,1169) = lu(k,1169) - lu(k,946) * lu(k,1161) - lu(k,1173) = lu(k,1173) - lu(k,947) * lu(k,1161) - lu(k,1174) = lu(k,1174) - lu(k,948) * lu(k,1161) - lu(k,1186) = lu(k,1186) - lu(k,944) * lu(k,1183) - lu(k,1189) = lu(k,1189) - lu(k,945) * lu(k,1183) - lu(k,1192) = lu(k,1192) - lu(k,946) * lu(k,1183) - lu(k,1196) = lu(k,1196) - lu(k,947) * lu(k,1183) - lu(k,1197) = lu(k,1197) - lu(k,948) * lu(k,1183) - lu(k,1211) = - lu(k,944) * lu(k,1206) - lu(k,1216) = lu(k,1216) - lu(k,945) * lu(k,1206) - lu(k,1219) = lu(k,1219) - lu(k,946) * lu(k,1206) - lu(k,1223) = lu(k,1223) - lu(k,947) * lu(k,1206) - lu(k,1224) = lu(k,1224) - lu(k,948) * lu(k,1206) - lu(k,1232) = - lu(k,944) * lu(k,1231) - lu(k,1234) = lu(k,1234) - lu(k,945) * lu(k,1231) - lu(k,1237) = lu(k,1237) - lu(k,946) * lu(k,1231) - lu(k,1241) = lu(k,1241) - lu(k,947) * lu(k,1231) - lu(k,1242) = lu(k,1242) - lu(k,948) * lu(k,1231) - lu(k,1258) = lu(k,1258) - lu(k,944) * lu(k,1254) - lu(k,1264) = lu(k,1264) - lu(k,945) * lu(k,1254) - lu(k,1267) = lu(k,1267) - lu(k,946) * lu(k,1254) - lu(k,1271) = lu(k,1271) - lu(k,947) * lu(k,1254) - lu(k,1272) = lu(k,1272) - lu(k,948) * lu(k,1254) - lu(k,1494) = lu(k,1494) - lu(k,944) * lu(k,1484) - lu(k,1501) = lu(k,1501) - lu(k,945) * lu(k,1484) - lu(k,1507) = lu(k,1507) - lu(k,946) * lu(k,1484) - lu(k,1512) = lu(k,1512) - lu(k,947) * lu(k,1484) - lu(k,1513) = lu(k,1513) - lu(k,948) * lu(k,1484) - lu(k,1539) = lu(k,1539) - lu(k,944) * lu(k,1538) - lu(k,1542) = lu(k,1542) - lu(k,945) * lu(k,1538) - lu(k,1548) = lu(k,1548) - lu(k,946) * lu(k,1538) - lu(k,1553) = lu(k,1553) - lu(k,947) * lu(k,1538) - lu(k,1554) = lu(k,1554) - lu(k,948) * lu(k,1538) - lu(k,1626) = lu(k,1626) - lu(k,944) * lu(k,1617) - lu(k,1632) = lu(k,1632) - lu(k,945) * lu(k,1617) - lu(k,1638) = lu(k,1638) - lu(k,946) * lu(k,1617) - lu(k,1643) = lu(k,1643) - lu(k,947) * lu(k,1617) - lu(k,1644) = lu(k,1644) - lu(k,948) * lu(k,1617) - lu(k,1677) = lu(k,1677) - lu(k,944) * lu(k,1668) - lu(k,1683) = lu(k,1683) - lu(k,945) * lu(k,1668) - lu(k,1688) = lu(k,1688) - lu(k,946) * lu(k,1668) - lu(k,1693) = lu(k,1693) - lu(k,947) * lu(k,1668) - lu(k,1694) = lu(k,1694) - lu(k,948) * lu(k,1668) - lu(k,1827) = lu(k,1827) - lu(k,944) * lu(k,1817) - lu(k,1833) = lu(k,1833) - lu(k,945) * lu(k,1817) - lu(k,1839) = lu(k,1839) - lu(k,946) * lu(k,1817) - lu(k,1844) = lu(k,1844) - lu(k,947) * lu(k,1817) - lu(k,1845) = lu(k,1845) - lu(k,948) * lu(k,1817) - lu(k,1970) = lu(k,1970) - lu(k,944) * lu(k,1961) - lu(k,1977) = lu(k,1977) - lu(k,945) * lu(k,1961) - lu(k,1983) = lu(k,1983) - lu(k,946) * lu(k,1961) - lu(k,1988) = lu(k,1988) - lu(k,947) * lu(k,1961) - lu(k,1989) = lu(k,1989) - lu(k,948) * lu(k,1961) - lu(k,2030) = lu(k,2030) - lu(k,944) * lu(k,2022) - lu(k,2037) = lu(k,2037) - lu(k,945) * lu(k,2022) - lu(k,2043) = lu(k,2043) - lu(k,946) * lu(k,2022) - lu(k,2048) = lu(k,2048) - lu(k,947) * lu(k,2022) - lu(k,2049) = lu(k,2049) - lu(k,948) * lu(k,2022) - lu(k,956) = 1._r8 / lu(k,956) - lu(k,957) = lu(k,957) * lu(k,956) - lu(k,958) = lu(k,958) * lu(k,956) - lu(k,959) = lu(k,959) * lu(k,956) - lu(k,960) = lu(k,960) * lu(k,956) - lu(k,961) = lu(k,961) * lu(k,956) - lu(k,962) = lu(k,962) * lu(k,956) - lu(k,963) = lu(k,963) * lu(k,956) - lu(k,964) = lu(k,964) * lu(k,956) - lu(k,965) = lu(k,965) * lu(k,956) - lu(k,966) = lu(k,966) * lu(k,956) - lu(k,967) = lu(k,967) * lu(k,956) - lu(k,968) = lu(k,968) * lu(k,956) - lu(k,969) = lu(k,969) * lu(k,956) - lu(k,970) = lu(k,970) * lu(k,956) - lu(k,1486) = lu(k,1486) - lu(k,957) * lu(k,1485) - lu(k,1487) = lu(k,1487) - lu(k,958) * lu(k,1485) - lu(k,1488) = lu(k,1488) - lu(k,959) * lu(k,1485) - lu(k,1501) = lu(k,1501) - lu(k,960) * lu(k,1485) - lu(k,1503) = lu(k,1503) - lu(k,961) * lu(k,1485) - lu(k,1504) = lu(k,1504) - lu(k,962) * lu(k,1485) - lu(k,1507) = lu(k,1507) - lu(k,963) * lu(k,1485) - lu(k,1508) = lu(k,1508) - lu(k,964) * lu(k,1485) - lu(k,1509) = lu(k,1509) - lu(k,965) * lu(k,1485) - lu(k,1510) = lu(k,1510) - lu(k,966) * lu(k,1485) - lu(k,1512) = lu(k,1512) - lu(k,967) * lu(k,1485) - lu(k,1513) = lu(k,1513) - lu(k,968) * lu(k,1485) - lu(k,1517) = lu(k,1517) - lu(k,969) * lu(k,1485) - lu(k,1519) = lu(k,1519) - lu(k,970) * lu(k,1485) - lu(k,1619) = lu(k,1619) - lu(k,957) * lu(k,1618) - lu(k,1620) = lu(k,1620) - lu(k,958) * lu(k,1618) - lu(k,1621) = lu(k,1621) - lu(k,959) * lu(k,1618) - lu(k,1632) = lu(k,1632) - lu(k,960) * lu(k,1618) - lu(k,1634) = lu(k,1634) - lu(k,961) * lu(k,1618) - lu(k,1635) = lu(k,1635) - lu(k,962) * lu(k,1618) - lu(k,1638) = lu(k,1638) - lu(k,963) * lu(k,1618) - lu(k,1639) = lu(k,1639) - lu(k,964) * lu(k,1618) - lu(k,1640) = lu(k,1640) - lu(k,965) * lu(k,1618) - lu(k,1641) = lu(k,1641) - lu(k,966) * lu(k,1618) - lu(k,1643) = lu(k,1643) - lu(k,967) * lu(k,1618) - lu(k,1644) = lu(k,1644) - lu(k,968) * lu(k,1618) - lu(k,1648) = lu(k,1648) - lu(k,969) * lu(k,1618) - lu(k,1650) = lu(k,1650) - lu(k,970) * lu(k,1618) - lu(k,1670) = lu(k,1670) - lu(k,957) * lu(k,1669) - lu(k,1671) = lu(k,1671) - lu(k,958) * lu(k,1669) - lu(k,1672) = lu(k,1672) - lu(k,959) * lu(k,1669) - lu(k,1683) = lu(k,1683) - lu(k,960) * lu(k,1669) - lu(k,1684) = lu(k,1684) - lu(k,961) * lu(k,1669) - lu(k,1685) = lu(k,1685) - lu(k,962) * lu(k,1669) - lu(k,1688) = lu(k,1688) - lu(k,963) * lu(k,1669) - lu(k,1689) = lu(k,1689) - lu(k,964) * lu(k,1669) - lu(k,1690) = lu(k,1690) - lu(k,965) * lu(k,1669) - lu(k,1691) = lu(k,1691) - lu(k,966) * lu(k,1669) - lu(k,1693) = lu(k,1693) - lu(k,967) * lu(k,1669) - lu(k,1694) = lu(k,1694) - lu(k,968) * lu(k,1669) - lu(k,1698) = lu(k,1698) - lu(k,969) * lu(k,1669) - lu(k,1700) = lu(k,1700) - lu(k,970) * lu(k,1669) - lu(k,1819) = lu(k,1819) - lu(k,957) * lu(k,1818) - lu(k,1820) = lu(k,1820) - lu(k,958) * lu(k,1818) - lu(k,1821) = lu(k,1821) - lu(k,959) * lu(k,1818) - lu(k,1833) = lu(k,1833) - lu(k,960) * lu(k,1818) - lu(k,1835) = lu(k,1835) - lu(k,961) * lu(k,1818) - lu(k,1836) = lu(k,1836) - lu(k,962) * lu(k,1818) - lu(k,1839) = lu(k,1839) - lu(k,963) * lu(k,1818) - lu(k,1840) = lu(k,1840) - lu(k,964) * lu(k,1818) - lu(k,1841) = lu(k,1841) - lu(k,965) * lu(k,1818) - lu(k,1842) = lu(k,1842) - lu(k,966) * lu(k,1818) - lu(k,1844) = lu(k,1844) - lu(k,967) * lu(k,1818) - lu(k,1845) = lu(k,1845) - lu(k,968) * lu(k,1818) - lu(k,1849) = lu(k,1849) - lu(k,969) * lu(k,1818) - lu(k,1851) = lu(k,1851) - lu(k,970) * lu(k,1818) - lu(k,1963) = lu(k,1963) - lu(k,957) * lu(k,1962) - lu(k,1964) = lu(k,1964) - lu(k,958) * lu(k,1962) - lu(k,1965) = lu(k,1965) - lu(k,959) * lu(k,1962) - lu(k,1977) = lu(k,1977) - lu(k,960) * lu(k,1962) - lu(k,1979) = lu(k,1979) - lu(k,961) * lu(k,1962) - lu(k,1980) = lu(k,1980) - lu(k,962) * lu(k,1962) - lu(k,1983) = lu(k,1983) - lu(k,963) * lu(k,1962) - lu(k,1984) = lu(k,1984) - lu(k,964) * lu(k,1962) - lu(k,1985) = lu(k,1985) - lu(k,965) * lu(k,1962) - lu(k,1986) = lu(k,1986) - lu(k,966) * lu(k,1962) - lu(k,1988) = lu(k,1988) - lu(k,967) * lu(k,1962) - lu(k,1989) = lu(k,1989) - lu(k,968) * lu(k,1962) - lu(k,1993) = lu(k,1993) - lu(k,969) * lu(k,1962) - lu(k,1995) = lu(k,1995) - lu(k,970) * lu(k,1962) - lu(k,2024) = lu(k,2024) - lu(k,957) * lu(k,2023) - lu(k,2025) = lu(k,2025) - lu(k,958) * lu(k,2023) - lu(k,2026) = lu(k,2026) - lu(k,959) * lu(k,2023) - lu(k,2037) = lu(k,2037) - lu(k,960) * lu(k,2023) - lu(k,2039) = - lu(k,961) * lu(k,2023) - lu(k,2040) = lu(k,2040) - lu(k,962) * lu(k,2023) - lu(k,2043) = lu(k,2043) - lu(k,963) * lu(k,2023) - lu(k,2044) = lu(k,2044) - lu(k,964) * lu(k,2023) - lu(k,2045) = lu(k,2045) - lu(k,965) * lu(k,2023) - lu(k,2046) = lu(k,2046) - lu(k,966) * lu(k,2023) - lu(k,2048) = lu(k,2048) - lu(k,967) * lu(k,2023) - lu(k,2049) = lu(k,2049) - lu(k,968) * lu(k,2023) - lu(k,2053) = lu(k,2053) - lu(k,969) * lu(k,2023) - lu(k,2055) = lu(k,2055) - lu(k,970) * lu(k,2023) + lu(k,899) = 1._r8 / lu(k,899) + lu(k,900) = lu(k,900) * lu(k,899) + lu(k,901) = lu(k,901) * lu(k,899) + lu(k,902) = lu(k,902) * lu(k,899) + lu(k,903) = lu(k,903) * lu(k,899) + lu(k,904) = lu(k,904) * lu(k,899) + lu(k,905) = lu(k,905) * lu(k,899) + lu(k,906) = lu(k,906) * lu(k,899) + lu(k,907) = lu(k,907) * lu(k,899) + lu(k,908) = lu(k,908) * lu(k,899) + lu(k,946) = lu(k,946) - lu(k,900) * lu(k,944) + lu(k,953) = - lu(k,901) * lu(k,944) + lu(k,957) = lu(k,957) - lu(k,902) * lu(k,944) + lu(k,959) = lu(k,959) - lu(k,903) * lu(k,944) + lu(k,960) = lu(k,960) - lu(k,904) * lu(k,944) + lu(k,962) = - lu(k,905) * lu(k,944) + lu(k,963) = lu(k,963) - lu(k,906) * lu(k,944) + lu(k,964) = - lu(k,907) * lu(k,944) + lu(k,966) = - lu(k,908) * lu(k,944) + lu(k,995) = lu(k,995) - lu(k,900) * lu(k,993) + lu(k,1002) = - lu(k,901) * lu(k,993) + lu(k,1007) = lu(k,1007) - lu(k,902) * lu(k,993) + lu(k,1009) = lu(k,1009) - lu(k,903) * lu(k,993) + lu(k,1010) = lu(k,1010) - lu(k,904) * lu(k,993) + lu(k,1012) = - lu(k,905) * lu(k,993) + lu(k,1013) = lu(k,1013) - lu(k,906) * lu(k,993) + lu(k,1014) = - lu(k,907) * lu(k,993) + lu(k,1016) = - lu(k,908) * lu(k,993) + lu(k,1656) = lu(k,1656) - lu(k,900) * lu(k,1654) + lu(k,1666) = lu(k,1666) - lu(k,901) * lu(k,1654) + lu(k,1683) = lu(k,1683) - lu(k,902) * lu(k,1654) + lu(k,1689) = lu(k,1689) - lu(k,903) * lu(k,1654) + lu(k,1691) = lu(k,1691) - lu(k,904) * lu(k,1654) + lu(k,1693) = lu(k,1693) - lu(k,905) * lu(k,1654) + lu(k,1694) = lu(k,1694) - lu(k,906) * lu(k,1654) + lu(k,1697) = lu(k,1697) - lu(k,907) * lu(k,1654) + lu(k,1700) = lu(k,1700) - lu(k,908) * lu(k,1654) + lu(k,1810) = lu(k,1810) - lu(k,900) * lu(k,1808) + lu(k,1817) = lu(k,1817) - lu(k,901) * lu(k,1808) + lu(k,1833) = lu(k,1833) - lu(k,902) * lu(k,1808) + lu(k,1838) = lu(k,1838) - lu(k,903) * lu(k,1808) + lu(k,1840) = lu(k,1840) - lu(k,904) * lu(k,1808) + lu(k,1842) = lu(k,1842) - lu(k,905) * lu(k,1808) + lu(k,1843) = lu(k,1843) - lu(k,906) * lu(k,1808) + lu(k,1846) = lu(k,1846) - lu(k,907) * lu(k,1808) + lu(k,1849) = lu(k,1849) - lu(k,908) * lu(k,1808) + lu(k,1918) = lu(k,1918) - lu(k,900) * lu(k,1916) + lu(k,1924) = lu(k,1924) - lu(k,901) * lu(k,1916) + lu(k,1939) = lu(k,1939) - lu(k,902) * lu(k,1916) + lu(k,1945) = lu(k,1945) - lu(k,903) * lu(k,1916) + lu(k,1947) = lu(k,1947) - lu(k,904) * lu(k,1916) + lu(k,1949) = lu(k,1949) - lu(k,905) * lu(k,1916) + lu(k,1950) = lu(k,1950) - lu(k,906) * lu(k,1916) + lu(k,1953) = lu(k,1953) - lu(k,907) * lu(k,1916) + lu(k,1956) = lu(k,1956) - lu(k,908) * lu(k,1916) + lu(k,2094) = lu(k,2094) - lu(k,900) * lu(k,2093) + lu(k,2103) = lu(k,2103) - lu(k,901) * lu(k,2093) + lu(k,2118) = lu(k,2118) - lu(k,902) * lu(k,2093) + lu(k,2123) = lu(k,2123) - lu(k,903) * lu(k,2093) + lu(k,2125) = lu(k,2125) - lu(k,904) * lu(k,2093) + lu(k,2127) = lu(k,2127) - lu(k,905) * lu(k,2093) + lu(k,2128) = lu(k,2128) - lu(k,906) * lu(k,2093) + lu(k,2131) = lu(k,2131) - lu(k,907) * lu(k,2093) + lu(k,2134) = lu(k,2134) - lu(k,908) * lu(k,2093) + lu(k,912) = 1._r8 / lu(k,912) + lu(k,913) = lu(k,913) * lu(k,912) + lu(k,914) = lu(k,914) * lu(k,912) + lu(k,915) = lu(k,915) * lu(k,912) + lu(k,916) = lu(k,916) * lu(k,912) + lu(k,917) = lu(k,917) * lu(k,912) + lu(k,918) = lu(k,918) * lu(k,912) + lu(k,919) = lu(k,919) * lu(k,912) + lu(k,920) = lu(k,920) * lu(k,912) + lu(k,921) = lu(k,921) * lu(k,912) + lu(k,946) = lu(k,946) - lu(k,913) * lu(k,945) + lu(k,949) = lu(k,949) - lu(k,914) * lu(k,945) + lu(k,958) = - lu(k,915) * lu(k,945) + lu(k,959) = lu(k,959) - lu(k,916) * lu(k,945) + lu(k,960) = lu(k,960) - lu(k,917) * lu(k,945) + lu(k,962) = lu(k,962) - lu(k,918) * lu(k,945) + lu(k,963) = lu(k,963) - lu(k,919) * lu(k,945) + lu(k,964) = lu(k,964) - lu(k,920) * lu(k,945) + lu(k,966) = lu(k,966) - lu(k,921) * lu(k,945) + lu(k,995) = lu(k,995) - lu(k,913) * lu(k,994) + lu(k,997) = lu(k,997) - lu(k,914) * lu(k,994) + lu(k,1008) = - lu(k,915) * lu(k,994) + lu(k,1009) = lu(k,1009) - lu(k,916) * lu(k,994) + lu(k,1010) = lu(k,1010) - lu(k,917) * lu(k,994) + lu(k,1012) = lu(k,1012) - lu(k,918) * lu(k,994) + lu(k,1013) = lu(k,1013) - lu(k,919) * lu(k,994) + lu(k,1014) = lu(k,1014) - lu(k,920) * lu(k,994) + lu(k,1016) = lu(k,1016) - lu(k,921) * lu(k,994) + lu(k,1656) = lu(k,1656) - lu(k,913) * lu(k,1655) + lu(k,1659) = lu(k,1659) - lu(k,914) * lu(k,1655) + lu(k,1687) = lu(k,1687) - lu(k,915) * lu(k,1655) + lu(k,1689) = lu(k,1689) - lu(k,916) * lu(k,1655) + lu(k,1691) = lu(k,1691) - lu(k,917) * lu(k,1655) + lu(k,1693) = lu(k,1693) - lu(k,918) * lu(k,1655) + lu(k,1694) = lu(k,1694) - lu(k,919) * lu(k,1655) + lu(k,1697) = lu(k,1697) - lu(k,920) * lu(k,1655) + lu(k,1700) = lu(k,1700) - lu(k,921) * lu(k,1655) + lu(k,1810) = lu(k,1810) - lu(k,913) * lu(k,1809) + lu(k,1812) = lu(k,1812) - lu(k,914) * lu(k,1809) + lu(k,1836) = lu(k,1836) - lu(k,915) * lu(k,1809) + lu(k,1838) = lu(k,1838) - lu(k,916) * lu(k,1809) + lu(k,1840) = lu(k,1840) - lu(k,917) * lu(k,1809) + lu(k,1842) = lu(k,1842) - lu(k,918) * lu(k,1809) + lu(k,1843) = lu(k,1843) - lu(k,919) * lu(k,1809) + lu(k,1846) = lu(k,1846) - lu(k,920) * lu(k,1809) + lu(k,1849) = lu(k,1849) - lu(k,921) * lu(k,1809) + lu(k,1918) = lu(k,1918) - lu(k,913) * lu(k,1917) + lu(k,1920) = lu(k,1920) - lu(k,914) * lu(k,1917) + lu(k,1943) = lu(k,1943) - lu(k,915) * lu(k,1917) + lu(k,1945) = lu(k,1945) - lu(k,916) * lu(k,1917) + lu(k,1947) = lu(k,1947) - lu(k,917) * lu(k,1917) + lu(k,1949) = lu(k,1949) - lu(k,918) * lu(k,1917) + lu(k,1950) = lu(k,1950) - lu(k,919) * lu(k,1917) + lu(k,1953) = lu(k,1953) - lu(k,920) * lu(k,1917) + lu(k,1956) = lu(k,1956) - lu(k,921) * lu(k,1917) + lu(k,2037) = lu(k,2037) - lu(k,913) * lu(k,2036) + lu(k,2038) = lu(k,2038) - lu(k,914) * lu(k,2036) + lu(k,2060) = lu(k,2060) - lu(k,915) * lu(k,2036) + lu(k,2062) = lu(k,2062) - lu(k,916) * lu(k,2036) + lu(k,2064) = lu(k,2064) - lu(k,917) * lu(k,2036) + lu(k,2066) = lu(k,2066) - lu(k,918) * lu(k,2036) + lu(k,2067) = lu(k,2067) - lu(k,919) * lu(k,2036) + lu(k,2070) = lu(k,2070) - lu(k,920) * lu(k,2036) + lu(k,2073) = lu(k,2073) - lu(k,921) * lu(k,2036) + lu(k,922) = 1._r8 / lu(k,922) + lu(k,923) = lu(k,923) * lu(k,922) + lu(k,924) = lu(k,924) * lu(k,922) + lu(k,925) = lu(k,925) * lu(k,922) + lu(k,926) = lu(k,926) * lu(k,922) + lu(k,927) = lu(k,927) * lu(k,922) + lu(k,955) = lu(k,955) - lu(k,923) * lu(k,946) + lu(k,957) = lu(k,957) - lu(k,924) * lu(k,946) + lu(k,960) = lu(k,960) - lu(k,925) * lu(k,946) + lu(k,964) = lu(k,964) - lu(k,926) * lu(k,946) + lu(k,968) = - lu(k,927) * lu(k,946) + lu(k,1005) = lu(k,1005) - lu(k,923) * lu(k,995) + lu(k,1007) = lu(k,1007) - lu(k,924) * lu(k,995) + lu(k,1010) = lu(k,1010) - lu(k,925) * lu(k,995) + lu(k,1014) = lu(k,1014) - lu(k,926) * lu(k,995) + lu(k,1018) = - lu(k,927) * lu(k,995) + lu(k,1061) = lu(k,1061) - lu(k,923) * lu(k,1058) + lu(k,1062) = lu(k,1062) - lu(k,924) * lu(k,1058) + lu(k,1064) = lu(k,1064) - lu(k,925) * lu(k,1058) + lu(k,1066) = - lu(k,926) * lu(k,1058) + lu(k,1068) = - lu(k,927) * lu(k,1058) + lu(k,1116) = - lu(k,923) * lu(k,1111) + lu(k,1117) = - lu(k,924) * lu(k,1111) + lu(k,1120) = lu(k,1120) - lu(k,925) * lu(k,1111) + lu(k,1123) = lu(k,1123) - lu(k,926) * lu(k,1111) + lu(k,1126) = - lu(k,927) * lu(k,1111) + lu(k,1151) = - lu(k,923) * lu(k,1147) + lu(k,1155) = lu(k,1155) - lu(k,924) * lu(k,1147) + lu(k,1158) = lu(k,1158) - lu(k,925) * lu(k,1147) + lu(k,1162) = - lu(k,926) * lu(k,1147) + lu(k,1165) = - lu(k,927) * lu(k,1147) + lu(k,1670) = lu(k,1670) - lu(k,923) * lu(k,1656) + lu(k,1683) = lu(k,1683) - lu(k,924) * lu(k,1656) + lu(k,1691) = lu(k,1691) - lu(k,925) * lu(k,1656) + lu(k,1697) = lu(k,1697) - lu(k,926) * lu(k,1656) + lu(k,1703) = lu(k,1703) - lu(k,927) * lu(k,1656) + lu(k,1728) = - lu(k,923) * lu(k,1714) + lu(k,1741) = lu(k,1741) - lu(k,924) * lu(k,1714) + lu(k,1748) = lu(k,1748) - lu(k,925) * lu(k,1714) + lu(k,1754) = lu(k,1754) - lu(k,926) * lu(k,1714) + lu(k,1760) = lu(k,1760) - lu(k,927) * lu(k,1714) + lu(k,1821) = lu(k,1821) - lu(k,923) * lu(k,1810) + lu(k,1833) = lu(k,1833) - lu(k,924) * lu(k,1810) + lu(k,1840) = lu(k,1840) - lu(k,925) * lu(k,1810) + lu(k,1846) = lu(k,1846) - lu(k,926) * lu(k,1810) + lu(k,1852) = lu(k,1852) - lu(k,927) * lu(k,1810) + lu(k,1928) = lu(k,1928) - lu(k,923) * lu(k,1918) + lu(k,1939) = lu(k,1939) - lu(k,924) * lu(k,1918) + lu(k,1947) = lu(k,1947) - lu(k,925) * lu(k,1918) + lu(k,1953) = lu(k,1953) - lu(k,926) * lu(k,1918) + lu(k,1959) = lu(k,1959) - lu(k,927) * lu(k,1918) + lu(k,2047) = lu(k,2047) - lu(k,923) * lu(k,2037) + lu(k,2058) = lu(k,2058) - lu(k,924) * lu(k,2037) + lu(k,2064) = lu(k,2064) - lu(k,925) * lu(k,2037) + lu(k,2070) = lu(k,2070) - lu(k,926) * lu(k,2037) + lu(k,2076) = lu(k,2076) - lu(k,927) * lu(k,2037) + lu(k,2107) = lu(k,2107) - lu(k,923) * lu(k,2094) + lu(k,2118) = lu(k,2118) - lu(k,924) * lu(k,2094) + lu(k,2125) = lu(k,2125) - lu(k,925) * lu(k,2094) + lu(k,2131) = lu(k,2131) - lu(k,926) * lu(k,2094) + lu(k,2137) = lu(k,2137) - lu(k,927) * lu(k,2094) + lu(k,929) = 1._r8 / lu(k,929) + lu(k,930) = lu(k,930) * lu(k,929) + lu(k,931) = lu(k,931) * lu(k,929) + lu(k,932) = lu(k,932) * lu(k,929) + lu(k,933) = lu(k,933) * lu(k,929) + lu(k,934) = lu(k,934) * lu(k,929) + lu(k,954) = lu(k,954) - lu(k,930) * lu(k,947) + lu(k,960) = lu(k,960) - lu(k,931) * lu(k,947) + lu(k,963) = lu(k,963) - lu(k,932) * lu(k,947) + lu(k,967) = lu(k,967) - lu(k,933) * lu(k,947) + lu(k,968) = lu(k,968) - lu(k,934) * lu(k,947) + lu(k,1003) = lu(k,1003) - lu(k,930) * lu(k,996) + lu(k,1010) = lu(k,1010) - lu(k,931) * lu(k,996) + lu(k,1013) = lu(k,1013) - lu(k,932) * lu(k,996) + lu(k,1017) = lu(k,1017) - lu(k,933) * lu(k,996) + lu(k,1018) = lu(k,1018) - lu(k,934) * lu(k,996) + lu(k,1026) = lu(k,1026) - lu(k,930) * lu(k,1023) + lu(k,1032) = lu(k,1032) - lu(k,931) * lu(k,1023) + lu(k,1035) = lu(k,1035) - lu(k,932) * lu(k,1023) + lu(k,1039) = lu(k,1039) - lu(k,933) * lu(k,1023) + lu(k,1040) = lu(k,1040) - lu(k,934) * lu(k,1023) + lu(k,1208) = lu(k,1208) - lu(k,930) * lu(k,1207) + lu(k,1215) = lu(k,1215) - lu(k,931) * lu(k,1207) + lu(k,1216) = lu(k,1216) - lu(k,932) * lu(k,1207) + lu(k,1218) = - lu(k,933) * lu(k,1207) + lu(k,1219) = lu(k,1219) - lu(k,934) * lu(k,1207) + lu(k,1328) = lu(k,1328) - lu(k,930) * lu(k,1325) + lu(k,1338) = lu(k,1338) - lu(k,931) * lu(k,1325) + lu(k,1341) = lu(k,1341) - lu(k,932) * lu(k,1325) + lu(k,1345) = lu(k,1345) - lu(k,933) * lu(k,1325) + lu(k,1346) = - lu(k,934) * lu(k,1325) + lu(k,1479) = lu(k,1479) - lu(k,930) * lu(k,1478) + lu(k,1487) = lu(k,1487) - lu(k,931) * lu(k,1478) + lu(k,1490) = lu(k,1490) - lu(k,932) * lu(k,1478) + lu(k,1497) = lu(k,1497) - lu(k,933) * lu(k,1478) + lu(k,1498) = lu(k,1498) - lu(k,934) * lu(k,1478) + lu(k,1668) = lu(k,1668) - lu(k,930) * lu(k,1657) + lu(k,1691) = lu(k,1691) - lu(k,931) * lu(k,1657) + lu(k,1694) = lu(k,1694) - lu(k,932) * lu(k,1657) + lu(k,1702) = lu(k,1702) - lu(k,933) * lu(k,1657) + lu(k,1703) = lu(k,1703) - lu(k,934) * lu(k,1657) + lu(k,1726) = lu(k,1726) - lu(k,930) * lu(k,1715) + lu(k,1748) = lu(k,1748) - lu(k,931) * lu(k,1715) + lu(k,1751) = lu(k,1751) - lu(k,932) * lu(k,1715) + lu(k,1759) = lu(k,1759) - lu(k,933) * lu(k,1715) + lu(k,1760) = lu(k,1760) - lu(k,934) * lu(k,1715) + lu(k,1819) = lu(k,1819) - lu(k,930) * lu(k,1811) + lu(k,1840) = lu(k,1840) - lu(k,931) * lu(k,1811) + lu(k,1843) = lu(k,1843) - lu(k,932) * lu(k,1811) + lu(k,1851) = lu(k,1851) - lu(k,933) * lu(k,1811) + lu(k,1852) = lu(k,1852) - lu(k,934) * lu(k,1811) + lu(k,1926) = lu(k,1926) - lu(k,930) * lu(k,1919) + lu(k,1947) = lu(k,1947) - lu(k,931) * lu(k,1919) + lu(k,1950) = lu(k,1950) - lu(k,932) * lu(k,1919) + lu(k,1958) = lu(k,1958) - lu(k,933) * lu(k,1919) + lu(k,1959) = lu(k,1959) - lu(k,934) * lu(k,1919) + lu(k,2003) = lu(k,2003) - lu(k,930) * lu(k,1999) + lu(k,2012) = lu(k,2012) - lu(k,931) * lu(k,1999) + lu(k,2015) = lu(k,2015) - lu(k,932) * lu(k,1999) + lu(k,2023) = lu(k,2023) - lu(k,933) * lu(k,1999) + lu(k,2024) = lu(k,2024) - lu(k,934) * lu(k,1999) + lu(k,2105) = lu(k,2105) - lu(k,930) * lu(k,2095) + lu(k,2125) = lu(k,2125) - lu(k,931) * lu(k,2095) + lu(k,2128) = lu(k,2128) - lu(k,932) * lu(k,2095) + lu(k,2136) = lu(k,2136) - lu(k,933) * lu(k,2095) + lu(k,2137) = lu(k,2137) - lu(k,934) * lu(k,2095) end do end subroutine lu_fac20 subroutine lu_fac21( avec_len, lu ) @@ -3926,469 +3493,289 @@ subroutine lu_fac21( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,978) = 1._r8 / lu(k,978) - lu(k,979) = lu(k,979) * lu(k,978) - lu(k,980) = lu(k,980) * lu(k,978) - lu(k,981) = lu(k,981) * lu(k,978) - lu(k,982) = lu(k,982) * lu(k,978) - lu(k,983) = lu(k,983) * lu(k,978) - lu(k,984) = lu(k,984) * lu(k,978) - lu(k,985) = lu(k,985) * lu(k,978) - lu(k,986) = lu(k,986) * lu(k,978) - lu(k,987) = lu(k,987) * lu(k,978) - lu(k,988) = lu(k,988) * lu(k,978) - lu(k,989) = lu(k,989) * lu(k,978) - lu(k,998) = lu(k,998) - lu(k,979) * lu(k,996) - lu(k,999) = lu(k,999) - lu(k,980) * lu(k,996) - lu(k,1000) = lu(k,1000) - lu(k,981) * lu(k,996) - lu(k,1001) = lu(k,1001) - lu(k,982) * lu(k,996) - lu(k,1002) = lu(k,1002) - lu(k,983) * lu(k,996) - lu(k,1003) = lu(k,1003) - lu(k,984) * lu(k,996) - lu(k,1004) = lu(k,1004) - lu(k,985) * lu(k,996) - lu(k,1005) = lu(k,1005) - lu(k,986) * lu(k,996) - lu(k,1006) = lu(k,1006) - lu(k,987) * lu(k,996) - lu(k,1007) = lu(k,1007) - lu(k,988) * lu(k,996) - lu(k,1009) = lu(k,1009) - lu(k,989) * lu(k,996) - lu(k,1488) = lu(k,1488) - lu(k,979) * lu(k,1486) - lu(k,1501) = lu(k,1501) - lu(k,980) * lu(k,1486) - lu(k,1503) = lu(k,1503) - lu(k,981) * lu(k,1486) - lu(k,1504) = lu(k,1504) - lu(k,982) * lu(k,1486) - lu(k,1507) = lu(k,1507) - lu(k,983) * lu(k,1486) - lu(k,1508) = lu(k,1508) - lu(k,984) * lu(k,1486) - lu(k,1509) = lu(k,1509) - lu(k,985) * lu(k,1486) - lu(k,1510) = lu(k,1510) - lu(k,986) * lu(k,1486) - lu(k,1512) = lu(k,1512) - lu(k,987) * lu(k,1486) - lu(k,1513) = lu(k,1513) - lu(k,988) * lu(k,1486) - lu(k,1519) = lu(k,1519) - lu(k,989) * lu(k,1486) - lu(k,1621) = lu(k,1621) - lu(k,979) * lu(k,1619) - lu(k,1632) = lu(k,1632) - lu(k,980) * lu(k,1619) - lu(k,1634) = lu(k,1634) - lu(k,981) * lu(k,1619) - lu(k,1635) = lu(k,1635) - lu(k,982) * lu(k,1619) - lu(k,1638) = lu(k,1638) - lu(k,983) * lu(k,1619) - lu(k,1639) = lu(k,1639) - lu(k,984) * lu(k,1619) - lu(k,1640) = lu(k,1640) - lu(k,985) * lu(k,1619) - lu(k,1641) = lu(k,1641) - lu(k,986) * lu(k,1619) - lu(k,1643) = lu(k,1643) - lu(k,987) * lu(k,1619) - lu(k,1644) = lu(k,1644) - lu(k,988) * lu(k,1619) - lu(k,1650) = lu(k,1650) - lu(k,989) * lu(k,1619) - lu(k,1672) = lu(k,1672) - lu(k,979) * lu(k,1670) - lu(k,1683) = lu(k,1683) - lu(k,980) * lu(k,1670) - lu(k,1684) = lu(k,1684) - lu(k,981) * lu(k,1670) - lu(k,1685) = lu(k,1685) - lu(k,982) * lu(k,1670) - lu(k,1688) = lu(k,1688) - lu(k,983) * lu(k,1670) - lu(k,1689) = lu(k,1689) - lu(k,984) * lu(k,1670) - lu(k,1690) = lu(k,1690) - lu(k,985) * lu(k,1670) - lu(k,1691) = lu(k,1691) - lu(k,986) * lu(k,1670) - lu(k,1693) = lu(k,1693) - lu(k,987) * lu(k,1670) - lu(k,1694) = lu(k,1694) - lu(k,988) * lu(k,1670) - lu(k,1700) = lu(k,1700) - lu(k,989) * lu(k,1670) - lu(k,1821) = lu(k,1821) - lu(k,979) * lu(k,1819) - lu(k,1833) = lu(k,1833) - lu(k,980) * lu(k,1819) - lu(k,1835) = lu(k,1835) - lu(k,981) * lu(k,1819) - lu(k,1836) = lu(k,1836) - lu(k,982) * lu(k,1819) - lu(k,1839) = lu(k,1839) - lu(k,983) * lu(k,1819) - lu(k,1840) = lu(k,1840) - lu(k,984) * lu(k,1819) - lu(k,1841) = lu(k,1841) - lu(k,985) * lu(k,1819) - lu(k,1842) = lu(k,1842) - lu(k,986) * lu(k,1819) - lu(k,1844) = lu(k,1844) - lu(k,987) * lu(k,1819) - lu(k,1845) = lu(k,1845) - lu(k,988) * lu(k,1819) - lu(k,1851) = lu(k,1851) - lu(k,989) * lu(k,1819) - lu(k,1965) = lu(k,1965) - lu(k,979) * lu(k,1963) - lu(k,1977) = lu(k,1977) - lu(k,980) * lu(k,1963) - lu(k,1979) = lu(k,1979) - lu(k,981) * lu(k,1963) - lu(k,1980) = lu(k,1980) - lu(k,982) * lu(k,1963) - lu(k,1983) = lu(k,1983) - lu(k,983) * lu(k,1963) - lu(k,1984) = lu(k,1984) - lu(k,984) * lu(k,1963) - lu(k,1985) = lu(k,1985) - lu(k,985) * lu(k,1963) - lu(k,1986) = lu(k,1986) - lu(k,986) * lu(k,1963) - lu(k,1988) = lu(k,1988) - lu(k,987) * lu(k,1963) - lu(k,1989) = lu(k,1989) - lu(k,988) * lu(k,1963) - lu(k,1995) = lu(k,1995) - lu(k,989) * lu(k,1963) - lu(k,2026) = lu(k,2026) - lu(k,979) * lu(k,2024) - lu(k,2037) = lu(k,2037) - lu(k,980) * lu(k,2024) - lu(k,2039) = lu(k,2039) - lu(k,981) * lu(k,2024) - lu(k,2040) = lu(k,2040) - lu(k,982) * lu(k,2024) - lu(k,2043) = lu(k,2043) - lu(k,983) * lu(k,2024) - lu(k,2044) = lu(k,2044) - lu(k,984) * lu(k,2024) - lu(k,2045) = lu(k,2045) - lu(k,985) * lu(k,2024) - lu(k,2046) = lu(k,2046) - lu(k,986) * lu(k,2024) - lu(k,2048) = lu(k,2048) - lu(k,987) * lu(k,2024) - lu(k,2049) = lu(k,2049) - lu(k,988) * lu(k,2024) - lu(k,2055) = lu(k,2055) - lu(k,989) * lu(k,2024) - lu(k,997) = 1._r8 / lu(k,997) - lu(k,998) = lu(k,998) * lu(k,997) - lu(k,999) = lu(k,999) * lu(k,997) - lu(k,1000) = lu(k,1000) * lu(k,997) - lu(k,1001) = lu(k,1001) * lu(k,997) - lu(k,1002) = lu(k,1002) * lu(k,997) - lu(k,1003) = lu(k,1003) * lu(k,997) - lu(k,1004) = lu(k,1004) * lu(k,997) - lu(k,1005) = lu(k,1005) * lu(k,997) - lu(k,1006) = lu(k,1006) * lu(k,997) - lu(k,1007) = lu(k,1007) * lu(k,997) - lu(k,1008) = lu(k,1008) * lu(k,997) - lu(k,1009) = lu(k,1009) * lu(k,997) - lu(k,1488) = lu(k,1488) - lu(k,998) * lu(k,1487) - lu(k,1501) = lu(k,1501) - lu(k,999) * lu(k,1487) - lu(k,1503) = lu(k,1503) - lu(k,1000) * lu(k,1487) - lu(k,1504) = lu(k,1504) - lu(k,1001) * lu(k,1487) - lu(k,1507) = lu(k,1507) - lu(k,1002) * lu(k,1487) - lu(k,1508) = lu(k,1508) - lu(k,1003) * lu(k,1487) - lu(k,1509) = lu(k,1509) - lu(k,1004) * lu(k,1487) - lu(k,1510) = lu(k,1510) - lu(k,1005) * lu(k,1487) - lu(k,1512) = lu(k,1512) - lu(k,1006) * lu(k,1487) - lu(k,1513) = lu(k,1513) - lu(k,1007) * lu(k,1487) - lu(k,1517) = lu(k,1517) - lu(k,1008) * lu(k,1487) - lu(k,1519) = lu(k,1519) - lu(k,1009) * lu(k,1487) - lu(k,1621) = lu(k,1621) - lu(k,998) * lu(k,1620) - lu(k,1632) = lu(k,1632) - lu(k,999) * lu(k,1620) - lu(k,1634) = lu(k,1634) - lu(k,1000) * lu(k,1620) - lu(k,1635) = lu(k,1635) - lu(k,1001) * lu(k,1620) - lu(k,1638) = lu(k,1638) - lu(k,1002) * lu(k,1620) - lu(k,1639) = lu(k,1639) - lu(k,1003) * lu(k,1620) - lu(k,1640) = lu(k,1640) - lu(k,1004) * lu(k,1620) - lu(k,1641) = lu(k,1641) - lu(k,1005) * lu(k,1620) - lu(k,1643) = lu(k,1643) - lu(k,1006) * lu(k,1620) - lu(k,1644) = lu(k,1644) - lu(k,1007) * lu(k,1620) - lu(k,1648) = lu(k,1648) - lu(k,1008) * lu(k,1620) - lu(k,1650) = lu(k,1650) - lu(k,1009) * lu(k,1620) - lu(k,1672) = lu(k,1672) - lu(k,998) * lu(k,1671) - lu(k,1683) = lu(k,1683) - lu(k,999) * lu(k,1671) - lu(k,1684) = lu(k,1684) - lu(k,1000) * lu(k,1671) - lu(k,1685) = lu(k,1685) - lu(k,1001) * lu(k,1671) - lu(k,1688) = lu(k,1688) - lu(k,1002) * lu(k,1671) - lu(k,1689) = lu(k,1689) - lu(k,1003) * lu(k,1671) - lu(k,1690) = lu(k,1690) - lu(k,1004) * lu(k,1671) - lu(k,1691) = lu(k,1691) - lu(k,1005) * lu(k,1671) - lu(k,1693) = lu(k,1693) - lu(k,1006) * lu(k,1671) - lu(k,1694) = lu(k,1694) - lu(k,1007) * lu(k,1671) - lu(k,1698) = lu(k,1698) - lu(k,1008) * lu(k,1671) - lu(k,1700) = lu(k,1700) - lu(k,1009) * lu(k,1671) - lu(k,1821) = lu(k,1821) - lu(k,998) * lu(k,1820) - lu(k,1833) = lu(k,1833) - lu(k,999) * lu(k,1820) - lu(k,1835) = lu(k,1835) - lu(k,1000) * lu(k,1820) - lu(k,1836) = lu(k,1836) - lu(k,1001) * lu(k,1820) - lu(k,1839) = lu(k,1839) - lu(k,1002) * lu(k,1820) - lu(k,1840) = lu(k,1840) - lu(k,1003) * lu(k,1820) - lu(k,1841) = lu(k,1841) - lu(k,1004) * lu(k,1820) - lu(k,1842) = lu(k,1842) - lu(k,1005) * lu(k,1820) - lu(k,1844) = lu(k,1844) - lu(k,1006) * lu(k,1820) - lu(k,1845) = lu(k,1845) - lu(k,1007) * lu(k,1820) - lu(k,1849) = lu(k,1849) - lu(k,1008) * lu(k,1820) - lu(k,1851) = lu(k,1851) - lu(k,1009) * lu(k,1820) - lu(k,1965) = lu(k,1965) - lu(k,998) * lu(k,1964) - lu(k,1977) = lu(k,1977) - lu(k,999) * lu(k,1964) - lu(k,1979) = lu(k,1979) - lu(k,1000) * lu(k,1964) - lu(k,1980) = lu(k,1980) - lu(k,1001) * lu(k,1964) - lu(k,1983) = lu(k,1983) - lu(k,1002) * lu(k,1964) - lu(k,1984) = lu(k,1984) - lu(k,1003) * lu(k,1964) - lu(k,1985) = lu(k,1985) - lu(k,1004) * lu(k,1964) - lu(k,1986) = lu(k,1986) - lu(k,1005) * lu(k,1964) - lu(k,1988) = lu(k,1988) - lu(k,1006) * lu(k,1964) - lu(k,1989) = lu(k,1989) - lu(k,1007) * lu(k,1964) - lu(k,1993) = lu(k,1993) - lu(k,1008) * lu(k,1964) - lu(k,1995) = lu(k,1995) - lu(k,1009) * lu(k,1964) - lu(k,2026) = lu(k,2026) - lu(k,998) * lu(k,2025) - lu(k,2037) = lu(k,2037) - lu(k,999) * lu(k,2025) - lu(k,2039) = lu(k,2039) - lu(k,1000) * lu(k,2025) - lu(k,2040) = lu(k,2040) - lu(k,1001) * lu(k,2025) - lu(k,2043) = lu(k,2043) - lu(k,1002) * lu(k,2025) - lu(k,2044) = lu(k,2044) - lu(k,1003) * lu(k,2025) - lu(k,2045) = lu(k,2045) - lu(k,1004) * lu(k,2025) - lu(k,2046) = lu(k,2046) - lu(k,1005) * lu(k,2025) - lu(k,2048) = lu(k,2048) - lu(k,1006) * lu(k,2025) - lu(k,2049) = lu(k,2049) - lu(k,1007) * lu(k,2025) - lu(k,2053) = lu(k,2053) - lu(k,1008) * lu(k,2025) - lu(k,2055) = lu(k,2055) - lu(k,1009) * lu(k,2025) - lu(k,1013) = 1._r8 / lu(k,1013) - lu(k,1014) = lu(k,1014) * lu(k,1013) - lu(k,1015) = lu(k,1015) * lu(k,1013) - lu(k,1016) = lu(k,1016) * lu(k,1013) - lu(k,1017) = lu(k,1017) * lu(k,1013) - lu(k,1018) = lu(k,1018) * lu(k,1013) - lu(k,1019) = lu(k,1019) * lu(k,1013) - lu(k,1020) = lu(k,1020) * lu(k,1013) - lu(k,1021) = lu(k,1021) * lu(k,1013) - lu(k,1022) = lu(k,1022) * lu(k,1013) - lu(k,1141) = lu(k,1141) - lu(k,1014) * lu(k,1137) - lu(k,1146) = lu(k,1146) - lu(k,1015) * lu(k,1137) - lu(k,1149) = lu(k,1149) - lu(k,1016) * lu(k,1137) - lu(k,1150) = lu(k,1150) - lu(k,1017) * lu(k,1137) - lu(k,1151) = lu(k,1151) - lu(k,1018) * lu(k,1137) - lu(k,1152) = lu(k,1152) - lu(k,1019) * lu(k,1137) - lu(k,1153) = lu(k,1153) - lu(k,1020) * lu(k,1137) - lu(k,1154) = lu(k,1154) - lu(k,1021) * lu(k,1137) - lu(k,1157) = lu(k,1157) - lu(k,1022) * lu(k,1137) - lu(k,1186) = lu(k,1186) - lu(k,1014) * lu(k,1184) - lu(k,1189) = lu(k,1189) - lu(k,1015) * lu(k,1184) - lu(k,1192) = lu(k,1192) - lu(k,1016) * lu(k,1184) - lu(k,1193) = lu(k,1193) - lu(k,1017) * lu(k,1184) - lu(k,1194) = lu(k,1194) - lu(k,1018) * lu(k,1184) - lu(k,1195) = lu(k,1195) - lu(k,1019) * lu(k,1184) - lu(k,1196) = lu(k,1196) - lu(k,1020) * lu(k,1184) - lu(k,1197) = lu(k,1197) - lu(k,1021) * lu(k,1184) - lu(k,1199) = lu(k,1199) - lu(k,1022) * lu(k,1184) - lu(k,1211) = lu(k,1211) - lu(k,1014) * lu(k,1207) - lu(k,1216) = lu(k,1216) - lu(k,1015) * lu(k,1207) - lu(k,1219) = lu(k,1219) - lu(k,1016) * lu(k,1207) - lu(k,1220) = lu(k,1220) - lu(k,1017) * lu(k,1207) - lu(k,1221) = lu(k,1221) - lu(k,1018) * lu(k,1207) - lu(k,1222) = lu(k,1222) - lu(k,1019) * lu(k,1207) - lu(k,1223) = lu(k,1223) - lu(k,1020) * lu(k,1207) - lu(k,1224) = lu(k,1224) - lu(k,1021) * lu(k,1207) - lu(k,1227) = lu(k,1227) - lu(k,1022) * lu(k,1207) - lu(k,1494) = lu(k,1494) - lu(k,1014) * lu(k,1488) - lu(k,1501) = lu(k,1501) - lu(k,1015) * lu(k,1488) - lu(k,1507) = lu(k,1507) - lu(k,1016) * lu(k,1488) - lu(k,1508) = lu(k,1508) - lu(k,1017) * lu(k,1488) - lu(k,1509) = lu(k,1509) - lu(k,1018) * lu(k,1488) - lu(k,1510) = lu(k,1510) - lu(k,1019) * lu(k,1488) - lu(k,1512) = lu(k,1512) - lu(k,1020) * lu(k,1488) - lu(k,1513) = lu(k,1513) - lu(k,1021) * lu(k,1488) - lu(k,1519) = lu(k,1519) - lu(k,1022) * lu(k,1488) - lu(k,1626) = lu(k,1626) - lu(k,1014) * lu(k,1621) - lu(k,1632) = lu(k,1632) - lu(k,1015) * lu(k,1621) - lu(k,1638) = lu(k,1638) - lu(k,1016) * lu(k,1621) - lu(k,1639) = lu(k,1639) - lu(k,1017) * lu(k,1621) - lu(k,1640) = lu(k,1640) - lu(k,1018) * lu(k,1621) - lu(k,1641) = lu(k,1641) - lu(k,1019) * lu(k,1621) - lu(k,1643) = lu(k,1643) - lu(k,1020) * lu(k,1621) - lu(k,1644) = lu(k,1644) - lu(k,1021) * lu(k,1621) - lu(k,1650) = lu(k,1650) - lu(k,1022) * lu(k,1621) - lu(k,1677) = lu(k,1677) - lu(k,1014) * lu(k,1672) - lu(k,1683) = lu(k,1683) - lu(k,1015) * lu(k,1672) - lu(k,1688) = lu(k,1688) - lu(k,1016) * lu(k,1672) - lu(k,1689) = lu(k,1689) - lu(k,1017) * lu(k,1672) - lu(k,1690) = lu(k,1690) - lu(k,1018) * lu(k,1672) - lu(k,1691) = lu(k,1691) - lu(k,1019) * lu(k,1672) - lu(k,1693) = lu(k,1693) - lu(k,1020) * lu(k,1672) - lu(k,1694) = lu(k,1694) - lu(k,1021) * lu(k,1672) - lu(k,1700) = lu(k,1700) - lu(k,1022) * lu(k,1672) - lu(k,1827) = lu(k,1827) - lu(k,1014) * lu(k,1821) - lu(k,1833) = lu(k,1833) - lu(k,1015) * lu(k,1821) - lu(k,1839) = lu(k,1839) - lu(k,1016) * lu(k,1821) - lu(k,1840) = lu(k,1840) - lu(k,1017) * lu(k,1821) - lu(k,1841) = lu(k,1841) - lu(k,1018) * lu(k,1821) - lu(k,1842) = lu(k,1842) - lu(k,1019) * lu(k,1821) - lu(k,1844) = lu(k,1844) - lu(k,1020) * lu(k,1821) - lu(k,1845) = lu(k,1845) - lu(k,1021) * lu(k,1821) - lu(k,1851) = lu(k,1851) - lu(k,1022) * lu(k,1821) - lu(k,1970) = lu(k,1970) - lu(k,1014) * lu(k,1965) - lu(k,1977) = lu(k,1977) - lu(k,1015) * lu(k,1965) - lu(k,1983) = lu(k,1983) - lu(k,1016) * lu(k,1965) - lu(k,1984) = lu(k,1984) - lu(k,1017) * lu(k,1965) - lu(k,1985) = lu(k,1985) - lu(k,1018) * lu(k,1965) - lu(k,1986) = lu(k,1986) - lu(k,1019) * lu(k,1965) - lu(k,1988) = lu(k,1988) - lu(k,1020) * lu(k,1965) - lu(k,1989) = lu(k,1989) - lu(k,1021) * lu(k,1965) - lu(k,1995) = lu(k,1995) - lu(k,1022) * lu(k,1965) - lu(k,2030) = lu(k,2030) - lu(k,1014) * lu(k,2026) - lu(k,2037) = lu(k,2037) - lu(k,1015) * lu(k,2026) - lu(k,2043) = lu(k,2043) - lu(k,1016) * lu(k,2026) - lu(k,2044) = lu(k,2044) - lu(k,1017) * lu(k,2026) - lu(k,2045) = lu(k,2045) - lu(k,1018) * lu(k,2026) - lu(k,2046) = lu(k,2046) - lu(k,1019) * lu(k,2026) - lu(k,2048) = lu(k,2048) - lu(k,1020) * lu(k,2026) - lu(k,2049) = lu(k,2049) - lu(k,1021) * lu(k,2026) - lu(k,2055) = lu(k,2055) - lu(k,1022) * lu(k,2026) - lu(k,1024) = 1._r8 / lu(k,1024) - lu(k,1025) = lu(k,1025) * lu(k,1024) - lu(k,1026) = lu(k,1026) * lu(k,1024) - lu(k,1027) = lu(k,1027) * lu(k,1024) - lu(k,1028) = lu(k,1028) * lu(k,1024) - lu(k,1029) = lu(k,1029) * lu(k,1024) - lu(k,1030) = lu(k,1030) * lu(k,1024) - lu(k,1031) = lu(k,1031) * lu(k,1024) - lu(k,1032) = lu(k,1032) * lu(k,1024) - lu(k,1146) = lu(k,1146) - lu(k,1025) * lu(k,1138) - lu(k,1147) = lu(k,1147) - lu(k,1026) * lu(k,1138) - lu(k,1148) = lu(k,1148) - lu(k,1027) * lu(k,1138) - lu(k,1149) = lu(k,1149) - lu(k,1028) * lu(k,1138) - lu(k,1152) = lu(k,1152) - lu(k,1029) * lu(k,1138) - lu(k,1154) = lu(k,1154) - lu(k,1030) * lu(k,1138) - lu(k,1155) = lu(k,1155) - lu(k,1031) * lu(k,1138) - lu(k,1157) = lu(k,1157) - lu(k,1032) * lu(k,1138) - lu(k,1166) = lu(k,1166) - lu(k,1025) * lu(k,1162) - lu(k,1167) = - lu(k,1026) * lu(k,1162) - lu(k,1168) = lu(k,1168) - lu(k,1027) * lu(k,1162) - lu(k,1169) = lu(k,1169) - lu(k,1028) * lu(k,1162) - lu(k,1172) = lu(k,1172) - lu(k,1029) * lu(k,1162) - lu(k,1174) = lu(k,1174) - lu(k,1030) * lu(k,1162) - lu(k,1175) = lu(k,1175) - lu(k,1031) * lu(k,1162) - lu(k,1177) = lu(k,1177) - lu(k,1032) * lu(k,1162) - lu(k,1189) = lu(k,1189) - lu(k,1025) * lu(k,1185) - lu(k,1190) = lu(k,1190) - lu(k,1026) * lu(k,1185) - lu(k,1191) = lu(k,1191) - lu(k,1027) * lu(k,1185) - lu(k,1192) = lu(k,1192) - lu(k,1028) * lu(k,1185) - lu(k,1195) = lu(k,1195) - lu(k,1029) * lu(k,1185) - lu(k,1197) = lu(k,1197) - lu(k,1030) * lu(k,1185) - lu(k,1198) = lu(k,1198) - lu(k,1031) * lu(k,1185) - lu(k,1199) = lu(k,1199) - lu(k,1032) * lu(k,1185) - lu(k,1216) = lu(k,1216) - lu(k,1025) * lu(k,1208) - lu(k,1217) = lu(k,1217) - lu(k,1026) * lu(k,1208) - lu(k,1218) = lu(k,1218) - lu(k,1027) * lu(k,1208) - lu(k,1219) = lu(k,1219) - lu(k,1028) * lu(k,1208) - lu(k,1222) = lu(k,1222) - lu(k,1029) * lu(k,1208) - lu(k,1224) = lu(k,1224) - lu(k,1030) * lu(k,1208) - lu(k,1225) = lu(k,1225) - lu(k,1031) * lu(k,1208) - lu(k,1227) = lu(k,1227) - lu(k,1032) * lu(k,1208) - lu(k,1501) = lu(k,1501) - lu(k,1025) * lu(k,1489) - lu(k,1503) = lu(k,1503) - lu(k,1026) * lu(k,1489) - lu(k,1504) = lu(k,1504) - lu(k,1027) * lu(k,1489) - lu(k,1507) = lu(k,1507) - lu(k,1028) * lu(k,1489) - lu(k,1510) = lu(k,1510) - lu(k,1029) * lu(k,1489) - lu(k,1513) = lu(k,1513) - lu(k,1030) * lu(k,1489) - lu(k,1517) = lu(k,1517) - lu(k,1031) * lu(k,1489) - lu(k,1519) = lu(k,1519) - lu(k,1032) * lu(k,1489) - lu(k,1632) = lu(k,1632) - lu(k,1025) * lu(k,1622) - lu(k,1634) = lu(k,1634) - lu(k,1026) * lu(k,1622) - lu(k,1635) = lu(k,1635) - lu(k,1027) * lu(k,1622) - lu(k,1638) = lu(k,1638) - lu(k,1028) * lu(k,1622) - lu(k,1641) = lu(k,1641) - lu(k,1029) * lu(k,1622) - lu(k,1644) = lu(k,1644) - lu(k,1030) * lu(k,1622) - lu(k,1648) = lu(k,1648) - lu(k,1031) * lu(k,1622) - lu(k,1650) = lu(k,1650) - lu(k,1032) * lu(k,1622) - lu(k,1683) = lu(k,1683) - lu(k,1025) * lu(k,1673) - lu(k,1684) = lu(k,1684) - lu(k,1026) * lu(k,1673) - lu(k,1685) = lu(k,1685) - lu(k,1027) * lu(k,1673) - lu(k,1688) = lu(k,1688) - lu(k,1028) * lu(k,1673) - lu(k,1691) = lu(k,1691) - lu(k,1029) * lu(k,1673) - lu(k,1694) = lu(k,1694) - lu(k,1030) * lu(k,1673) - lu(k,1698) = lu(k,1698) - lu(k,1031) * lu(k,1673) - lu(k,1700) = lu(k,1700) - lu(k,1032) * lu(k,1673) - lu(k,1833) = lu(k,1833) - lu(k,1025) * lu(k,1822) - lu(k,1835) = lu(k,1835) - lu(k,1026) * lu(k,1822) - lu(k,1836) = lu(k,1836) - lu(k,1027) * lu(k,1822) - lu(k,1839) = lu(k,1839) - lu(k,1028) * lu(k,1822) - lu(k,1842) = lu(k,1842) - lu(k,1029) * lu(k,1822) - lu(k,1845) = lu(k,1845) - lu(k,1030) * lu(k,1822) - lu(k,1849) = lu(k,1849) - lu(k,1031) * lu(k,1822) - lu(k,1851) = lu(k,1851) - lu(k,1032) * lu(k,1822) - lu(k,1920) = - lu(k,1025) * lu(k,1918) - lu(k,1922) = lu(k,1922) - lu(k,1026) * lu(k,1918) - lu(k,1923) = lu(k,1923) - lu(k,1027) * lu(k,1918) - lu(k,1926) = lu(k,1926) - lu(k,1028) * lu(k,1918) - lu(k,1929) = lu(k,1929) - lu(k,1029) * lu(k,1918) - lu(k,1932) = lu(k,1932) - lu(k,1030) * lu(k,1918) - lu(k,1936) = lu(k,1936) - lu(k,1031) * lu(k,1918) - lu(k,1938) = lu(k,1938) - lu(k,1032) * lu(k,1918) - lu(k,1977) = lu(k,1977) - lu(k,1025) * lu(k,1966) - lu(k,1979) = lu(k,1979) - lu(k,1026) * lu(k,1966) - lu(k,1980) = lu(k,1980) - lu(k,1027) * lu(k,1966) - lu(k,1983) = lu(k,1983) - lu(k,1028) * lu(k,1966) - lu(k,1986) = lu(k,1986) - lu(k,1029) * lu(k,1966) - lu(k,1989) = lu(k,1989) - lu(k,1030) * lu(k,1966) - lu(k,1993) = lu(k,1993) - lu(k,1031) * lu(k,1966) - lu(k,1995) = lu(k,1995) - lu(k,1032) * lu(k,1966) - lu(k,2037) = lu(k,2037) - lu(k,1025) * lu(k,2027) - lu(k,2039) = lu(k,2039) - lu(k,1026) * lu(k,2027) - lu(k,2040) = lu(k,2040) - lu(k,1027) * lu(k,2027) - lu(k,2043) = lu(k,2043) - lu(k,1028) * lu(k,2027) - lu(k,2046) = lu(k,2046) - lu(k,1029) * lu(k,2027) - lu(k,2049) = lu(k,2049) - lu(k,1030) * lu(k,2027) - lu(k,2053) = lu(k,2053) - lu(k,1031) * lu(k,2027) - lu(k,2055) = lu(k,2055) - lu(k,1032) * lu(k,2027) - lu(k,1035) = 1._r8 / lu(k,1035) - lu(k,1036) = lu(k,1036) * lu(k,1035) - lu(k,1037) = lu(k,1037) * lu(k,1035) - lu(k,1038) = lu(k,1038) * lu(k,1035) - lu(k,1039) = lu(k,1039) * lu(k,1035) - lu(k,1040) = lu(k,1040) * lu(k,1035) - lu(k,1041) = lu(k,1041) * lu(k,1035) - lu(k,1042) = lu(k,1042) * lu(k,1035) - lu(k,1043) = lu(k,1043) * lu(k,1035) - lu(k,1044) = lu(k,1044) * lu(k,1035) - lu(k,1045) = lu(k,1045) * lu(k,1035) - lu(k,1291) = lu(k,1291) - lu(k,1036) * lu(k,1290) - lu(k,1292) = lu(k,1292) - lu(k,1037) * lu(k,1290) - lu(k,1293) = - lu(k,1038) * lu(k,1290) - lu(k,1294) = lu(k,1294) - lu(k,1039) * lu(k,1290) - lu(k,1296) = lu(k,1296) - lu(k,1040) * lu(k,1290) - lu(k,1297) = - lu(k,1041) * lu(k,1290) - lu(k,1298) = - lu(k,1042) * lu(k,1290) - lu(k,1299) = - lu(k,1043) * lu(k,1290) - lu(k,1300) = lu(k,1300) - lu(k,1044) * lu(k,1290) - lu(k,1301) = lu(k,1301) - lu(k,1045) * lu(k,1290) - lu(k,1303) = - lu(k,1036) * lu(k,1302) - lu(k,1304) = lu(k,1304) - lu(k,1037) * lu(k,1302) - lu(k,1305) = - lu(k,1038) * lu(k,1302) - lu(k,1306) = lu(k,1306) - lu(k,1039) * lu(k,1302) - lu(k,1308) = - lu(k,1040) * lu(k,1302) - lu(k,1310) = lu(k,1310) - lu(k,1041) * lu(k,1302) - lu(k,1311) = - lu(k,1042) * lu(k,1302) - lu(k,1312) = - lu(k,1043) * lu(k,1302) - lu(k,1313) = - lu(k,1044) * lu(k,1302) - lu(k,1315) = lu(k,1315) - lu(k,1045) * lu(k,1302) - lu(k,1349) = lu(k,1349) - lu(k,1036) * lu(k,1347) - lu(k,1350) = lu(k,1350) - lu(k,1037) * lu(k,1347) - lu(k,1352) = lu(k,1352) - lu(k,1038) * lu(k,1347) - lu(k,1353) = lu(k,1353) - lu(k,1039) * lu(k,1347) - lu(k,1356) = lu(k,1356) - lu(k,1040) * lu(k,1347) - lu(k,1360) = lu(k,1360) - lu(k,1041) * lu(k,1347) - lu(k,1361) = lu(k,1361) - lu(k,1042) * lu(k,1347) - lu(k,1362) = lu(k,1362) - lu(k,1043) * lu(k,1347) - lu(k,1363) = lu(k,1363) - lu(k,1044) * lu(k,1347) - lu(k,1365) = lu(k,1365) - lu(k,1045) * lu(k,1347) - lu(k,1503) = lu(k,1503) - lu(k,1036) * lu(k,1490) - lu(k,1504) = lu(k,1504) - lu(k,1037) * lu(k,1490) - lu(k,1506) = lu(k,1506) - lu(k,1038) * lu(k,1490) - lu(k,1507) = lu(k,1507) - lu(k,1039) * lu(k,1490) - lu(k,1510) = lu(k,1510) - lu(k,1040) * lu(k,1490) - lu(k,1514) = lu(k,1514) - lu(k,1041) * lu(k,1490) - lu(k,1515) = lu(k,1515) - lu(k,1042) * lu(k,1490) - lu(k,1516) = lu(k,1516) - lu(k,1043) * lu(k,1490) - lu(k,1517) = lu(k,1517) - lu(k,1044) * lu(k,1490) - lu(k,1519) = lu(k,1519) - lu(k,1045) * lu(k,1490) - lu(k,1731) = lu(k,1731) - lu(k,1036) * lu(k,1729) - lu(k,1732) = lu(k,1732) - lu(k,1037) * lu(k,1729) - lu(k,1733) = lu(k,1733) - lu(k,1038) * lu(k,1729) - lu(k,1734) = lu(k,1734) - lu(k,1039) * lu(k,1729) - lu(k,1737) = - lu(k,1040) * lu(k,1729) - lu(k,1741) = lu(k,1741) - lu(k,1041) * lu(k,1729) - lu(k,1742) = lu(k,1742) - lu(k,1042) * lu(k,1729) - lu(k,1743) = lu(k,1743) - lu(k,1043) * lu(k,1729) - lu(k,1744) = lu(k,1744) - lu(k,1044) * lu(k,1729) - lu(k,1746) = lu(k,1746) - lu(k,1045) * lu(k,1729) - lu(k,1835) = lu(k,1835) - lu(k,1036) * lu(k,1823) - lu(k,1836) = lu(k,1836) - lu(k,1037) * lu(k,1823) - lu(k,1838) = lu(k,1838) - lu(k,1038) * lu(k,1823) - lu(k,1839) = lu(k,1839) - lu(k,1039) * lu(k,1823) - lu(k,1842) = lu(k,1842) - lu(k,1040) * lu(k,1823) - lu(k,1846) = lu(k,1846) - lu(k,1041) * lu(k,1823) - lu(k,1847) = lu(k,1847) - lu(k,1042) * lu(k,1823) - lu(k,1848) = lu(k,1848) - lu(k,1043) * lu(k,1823) - lu(k,1849) = lu(k,1849) - lu(k,1044) * lu(k,1823) - lu(k,1851) = lu(k,1851) - lu(k,1045) * lu(k,1823) - lu(k,1865) = lu(k,1865) - lu(k,1036) * lu(k,1862) - lu(k,1866) = lu(k,1866) - lu(k,1037) * lu(k,1862) - lu(k,1868) = lu(k,1868) - lu(k,1038) * lu(k,1862) - lu(k,1869) = lu(k,1869) - lu(k,1039) * lu(k,1862) - lu(k,1872) = - lu(k,1040) * lu(k,1862) - lu(k,1876) = lu(k,1876) - lu(k,1041) * lu(k,1862) - lu(k,1877) = lu(k,1877) - lu(k,1042) * lu(k,1862) - lu(k,1878) = lu(k,1878) - lu(k,1043) * lu(k,1862) - lu(k,1879) = lu(k,1879) - lu(k,1044) * lu(k,1862) - lu(k,1881) = lu(k,1881) - lu(k,1045) * lu(k,1862) - lu(k,1922) = lu(k,1922) - lu(k,1036) * lu(k,1919) - lu(k,1923) = lu(k,1923) - lu(k,1037) * lu(k,1919) - lu(k,1925) = - lu(k,1038) * lu(k,1919) - lu(k,1926) = lu(k,1926) - lu(k,1039) * lu(k,1919) - lu(k,1929) = lu(k,1929) - lu(k,1040) * lu(k,1919) - lu(k,1933) = lu(k,1933) - lu(k,1041) * lu(k,1919) - lu(k,1934) = lu(k,1934) - lu(k,1042) * lu(k,1919) - lu(k,1935) = lu(k,1935) - lu(k,1043) * lu(k,1919) - lu(k,1936) = lu(k,1936) - lu(k,1044) * lu(k,1919) - lu(k,1938) = lu(k,1938) - lu(k,1045) * lu(k,1919) - lu(k,2064) = lu(k,2064) - lu(k,1036) * lu(k,2061) - lu(k,2065) = lu(k,2065) - lu(k,1037) * lu(k,2061) - lu(k,2067) = lu(k,2067) - lu(k,1038) * lu(k,2061) - lu(k,2068) = lu(k,2068) - lu(k,1039) * lu(k,2061) - lu(k,2071) = lu(k,2071) - lu(k,1040) * lu(k,2061) - lu(k,2075) = lu(k,2075) - lu(k,1041) * lu(k,2061) - lu(k,2076) = - lu(k,1042) * lu(k,2061) - lu(k,2077) = - lu(k,1043) * lu(k,2061) - lu(k,2078) = lu(k,2078) - lu(k,1044) * lu(k,2061) - lu(k,2080) = lu(k,2080) - lu(k,1045) * lu(k,2061) + lu(k,948) = 1._r8 / lu(k,948) + lu(k,949) = lu(k,949) * lu(k,948) + lu(k,950) = lu(k,950) * lu(k,948) + lu(k,951) = lu(k,951) * lu(k,948) + lu(k,952) = lu(k,952) * lu(k,948) + lu(k,953) = lu(k,953) * lu(k,948) + lu(k,954) = lu(k,954) * lu(k,948) + lu(k,955) = lu(k,955) * lu(k,948) + lu(k,956) = lu(k,956) * lu(k,948) + lu(k,957) = lu(k,957) * lu(k,948) + lu(k,958) = lu(k,958) * lu(k,948) + lu(k,959) = lu(k,959) * lu(k,948) + lu(k,960) = lu(k,960) * lu(k,948) + lu(k,961) = lu(k,961) * lu(k,948) + lu(k,962) = lu(k,962) * lu(k,948) + lu(k,963) = lu(k,963) * lu(k,948) + lu(k,964) = lu(k,964) * lu(k,948) + lu(k,965) = lu(k,965) * lu(k,948) + lu(k,966) = lu(k,966) * lu(k,948) + lu(k,967) = lu(k,967) * lu(k,948) + lu(k,968) = lu(k,968) * lu(k,948) + lu(k,1659) = lu(k,1659) - lu(k,949) * lu(k,1658) + lu(k,1660) = lu(k,1660) - lu(k,950) * lu(k,1658) + lu(k,1663) = lu(k,1663) - lu(k,951) * lu(k,1658) + lu(k,1664) = lu(k,1664) - lu(k,952) * lu(k,1658) + lu(k,1666) = lu(k,1666) - lu(k,953) * lu(k,1658) + lu(k,1668) = lu(k,1668) - lu(k,954) * lu(k,1658) + lu(k,1670) = lu(k,1670) - lu(k,955) * lu(k,1658) + lu(k,1676) = lu(k,1676) - lu(k,956) * lu(k,1658) + lu(k,1683) = lu(k,1683) - lu(k,957) * lu(k,1658) + lu(k,1687) = lu(k,1687) - lu(k,958) * lu(k,1658) + lu(k,1689) = lu(k,1689) - lu(k,959) * lu(k,1658) + lu(k,1691) = lu(k,1691) - lu(k,960) * lu(k,1658) + lu(k,1692) = lu(k,1692) - lu(k,961) * lu(k,1658) + lu(k,1693) = lu(k,1693) - lu(k,962) * lu(k,1658) + lu(k,1694) = lu(k,1694) - lu(k,963) * lu(k,1658) + lu(k,1697) = lu(k,1697) - lu(k,964) * lu(k,1658) + lu(k,1698) = lu(k,1698) - lu(k,965) * lu(k,1658) + lu(k,1700) = lu(k,1700) - lu(k,966) * lu(k,1658) + lu(k,1702) = lu(k,1702) - lu(k,967) * lu(k,1658) + lu(k,1703) = lu(k,1703) - lu(k,968) * lu(k,1658) + lu(k,1717) = lu(k,1717) - lu(k,949) * lu(k,1716) + lu(k,1718) = lu(k,1718) - lu(k,950) * lu(k,1716) + lu(k,1721) = lu(k,1721) - lu(k,951) * lu(k,1716) + lu(k,1722) = - lu(k,952) * lu(k,1716) + lu(k,1724) = lu(k,1724) - lu(k,953) * lu(k,1716) + lu(k,1726) = lu(k,1726) - lu(k,954) * lu(k,1716) + lu(k,1728) = lu(k,1728) - lu(k,955) * lu(k,1716) + lu(k,1734) = lu(k,1734) - lu(k,956) * lu(k,1716) + lu(k,1741) = lu(k,1741) - lu(k,957) * lu(k,1716) + lu(k,1744) = lu(k,1744) - lu(k,958) * lu(k,1716) + lu(k,1746) = lu(k,1746) - lu(k,959) * lu(k,1716) + lu(k,1748) = lu(k,1748) - lu(k,960) * lu(k,1716) + lu(k,1749) = lu(k,1749) - lu(k,961) * lu(k,1716) + lu(k,1750) = lu(k,1750) - lu(k,962) * lu(k,1716) + lu(k,1751) = lu(k,1751) - lu(k,963) * lu(k,1716) + lu(k,1754) = lu(k,1754) - lu(k,964) * lu(k,1716) + lu(k,1755) = lu(k,1755) - lu(k,965) * lu(k,1716) + lu(k,1757) = lu(k,1757) - lu(k,966) * lu(k,1716) + lu(k,1759) = lu(k,1759) - lu(k,967) * lu(k,1716) + lu(k,1760) = lu(k,1760) - lu(k,968) * lu(k,1716) + lu(k,2097) = lu(k,2097) - lu(k,949) * lu(k,2096) + lu(k,2098) = lu(k,2098) - lu(k,950) * lu(k,2096) + lu(k,2101) = - lu(k,951) * lu(k,2096) + lu(k,2102) = lu(k,2102) - lu(k,952) * lu(k,2096) + lu(k,2103) = lu(k,2103) - lu(k,953) * lu(k,2096) + lu(k,2105) = lu(k,2105) - lu(k,954) * lu(k,2096) + lu(k,2107) = lu(k,2107) - lu(k,955) * lu(k,2096) + lu(k,2111) = lu(k,2111) - lu(k,956) * lu(k,2096) + lu(k,2118) = lu(k,2118) - lu(k,957) * lu(k,2096) + lu(k,2121) = - lu(k,958) * lu(k,2096) + lu(k,2123) = lu(k,2123) - lu(k,959) * lu(k,2096) + lu(k,2125) = lu(k,2125) - lu(k,960) * lu(k,2096) + lu(k,2126) = lu(k,2126) - lu(k,961) * lu(k,2096) + lu(k,2127) = lu(k,2127) - lu(k,962) * lu(k,2096) + lu(k,2128) = lu(k,2128) - lu(k,963) * lu(k,2096) + lu(k,2131) = lu(k,2131) - lu(k,964) * lu(k,2096) + lu(k,2132) = lu(k,2132) - lu(k,965) * lu(k,2096) + lu(k,2134) = lu(k,2134) - lu(k,966) * lu(k,2096) + lu(k,2136) = lu(k,2136) - lu(k,967) * lu(k,2096) + lu(k,2137) = lu(k,2137) - lu(k,968) * lu(k,2096) + lu(k,969) = 1._r8 / lu(k,969) + lu(k,970) = lu(k,970) * lu(k,969) + lu(k,971) = lu(k,971) * lu(k,969) + lu(k,972) = lu(k,972) * lu(k,969) + lu(k,973) = lu(k,973) * lu(k,969) + lu(k,974) = lu(k,974) * lu(k,969) + lu(k,975) = lu(k,975) * lu(k,969) + lu(k,976) = lu(k,976) * lu(k,969) + lu(k,1000) = lu(k,1000) - lu(k,970) * lu(k,997) + lu(k,1001) = lu(k,1001) - lu(k,971) * lu(k,997) + lu(k,1003) = lu(k,1003) - lu(k,972) * lu(k,997) + lu(k,1004) = - lu(k,973) * lu(k,997) + lu(k,1010) = lu(k,1010) - lu(k,974) * lu(k,997) + lu(k,1011) = lu(k,1011) - lu(k,975) * lu(k,997) + lu(k,1013) = lu(k,1013) - lu(k,976) * lu(k,997) + lu(k,1045) = lu(k,1045) - lu(k,970) * lu(k,1044) + lu(k,1046) = - lu(k,971) * lu(k,1044) + lu(k,1047) = - lu(k,972) * lu(k,1044) + lu(k,1048) = - lu(k,973) * lu(k,1044) + lu(k,1051) = lu(k,1051) - lu(k,974) * lu(k,1044) + lu(k,1052) = lu(k,1052) - lu(k,975) * lu(k,1044) + lu(k,1054) = lu(k,1054) - lu(k,976) * lu(k,1044) + lu(k,1663) = lu(k,1663) - lu(k,970) * lu(k,1659) + lu(k,1664) = lu(k,1664) - lu(k,971) * lu(k,1659) + lu(k,1668) = lu(k,1668) - lu(k,972) * lu(k,1659) + lu(k,1669) = lu(k,1669) - lu(k,973) * lu(k,1659) + lu(k,1691) = lu(k,1691) - lu(k,974) * lu(k,1659) + lu(k,1692) = lu(k,1692) - lu(k,975) * lu(k,1659) + lu(k,1694) = lu(k,1694) - lu(k,976) * lu(k,1659) + lu(k,1721) = lu(k,1721) - lu(k,970) * lu(k,1717) + lu(k,1722) = lu(k,1722) - lu(k,971) * lu(k,1717) + lu(k,1726) = lu(k,1726) - lu(k,972) * lu(k,1717) + lu(k,1727) = lu(k,1727) - lu(k,973) * lu(k,1717) + lu(k,1748) = lu(k,1748) - lu(k,974) * lu(k,1717) + lu(k,1749) = lu(k,1749) - lu(k,975) * lu(k,1717) + lu(k,1751) = lu(k,1751) - lu(k,976) * lu(k,1717) + lu(k,1814) = lu(k,1814) - lu(k,970) * lu(k,1812) + lu(k,1815) = lu(k,1815) - lu(k,971) * lu(k,1812) + lu(k,1819) = lu(k,1819) - lu(k,972) * lu(k,1812) + lu(k,1820) = lu(k,1820) - lu(k,973) * lu(k,1812) + lu(k,1840) = lu(k,1840) - lu(k,974) * lu(k,1812) + lu(k,1841) = lu(k,1841) - lu(k,975) * lu(k,1812) + lu(k,1843) = lu(k,1843) - lu(k,976) * lu(k,1812) + lu(k,1922) = lu(k,1922) - lu(k,970) * lu(k,1920) + lu(k,1923) = lu(k,1923) - lu(k,971) * lu(k,1920) + lu(k,1926) = lu(k,1926) - lu(k,972) * lu(k,1920) + lu(k,1927) = lu(k,1927) - lu(k,973) * lu(k,1920) + lu(k,1947) = lu(k,1947) - lu(k,974) * lu(k,1920) + lu(k,1948) = lu(k,1948) - lu(k,975) * lu(k,1920) + lu(k,1950) = lu(k,1950) - lu(k,976) * lu(k,1920) + lu(k,2040) = lu(k,2040) - lu(k,970) * lu(k,2038) + lu(k,2041) = lu(k,2041) - lu(k,971) * lu(k,2038) + lu(k,2045) = lu(k,2045) - lu(k,972) * lu(k,2038) + lu(k,2046) = lu(k,2046) - lu(k,973) * lu(k,2038) + lu(k,2064) = lu(k,2064) - lu(k,974) * lu(k,2038) + lu(k,2065) = - lu(k,975) * lu(k,2038) + lu(k,2067) = lu(k,2067) - lu(k,976) * lu(k,2038) + lu(k,2101) = lu(k,2101) - lu(k,970) * lu(k,2097) + lu(k,2102) = lu(k,2102) - lu(k,971) * lu(k,2097) + lu(k,2105) = lu(k,2105) - lu(k,972) * lu(k,2097) + lu(k,2106) = - lu(k,973) * lu(k,2097) + lu(k,2125) = lu(k,2125) - lu(k,974) * lu(k,2097) + lu(k,2126) = lu(k,2126) - lu(k,975) * lu(k,2097) + lu(k,2128) = lu(k,2128) - lu(k,976) * lu(k,2097) + lu(k,979) = 1._r8 / lu(k,979) + lu(k,980) = lu(k,980) * lu(k,979) + lu(k,981) = lu(k,981) * lu(k,979) + lu(k,982) = lu(k,982) * lu(k,979) + lu(k,983) = lu(k,983) * lu(k,979) + lu(k,1003) = lu(k,1003) - lu(k,980) * lu(k,998) + lu(k,1010) = lu(k,1010) - lu(k,981) * lu(k,998) + lu(k,1013) = lu(k,1013) - lu(k,982) * lu(k,998) + lu(k,1017) = lu(k,1017) - lu(k,983) * lu(k,998) + lu(k,1074) = lu(k,1074) - lu(k,980) * lu(k,1072) + lu(k,1079) = lu(k,1079) - lu(k,981) * lu(k,1072) + lu(k,1081) = lu(k,1081) - lu(k,982) * lu(k,1072) + lu(k,1084) = - lu(k,983) * lu(k,1072) + lu(k,1097) = lu(k,1097) - lu(k,980) * lu(k,1095) + lu(k,1099) = lu(k,1099) - lu(k,981) * lu(k,1095) + lu(k,1100) = lu(k,1100) - lu(k,982) * lu(k,1095) + lu(k,1101) = lu(k,1101) - lu(k,983) * lu(k,1095) + lu(k,1171) = lu(k,1171) - lu(k,980) * lu(k,1169) + lu(k,1177) = lu(k,1177) - lu(k,981) * lu(k,1169) + lu(k,1180) = lu(k,1180) - lu(k,982) * lu(k,1169) + lu(k,1183) = lu(k,1183) - lu(k,983) * lu(k,1169) + lu(k,1282) = lu(k,1282) - lu(k,980) * lu(k,1280) + lu(k,1295) = lu(k,1295) - lu(k,981) * lu(k,1280) + lu(k,1298) = lu(k,1298) - lu(k,982) * lu(k,1280) + lu(k,1302) = - lu(k,983) * lu(k,1280) + lu(k,1375) = lu(k,1375) - lu(k,980) * lu(k,1372) + lu(k,1390) = lu(k,1390) - lu(k,981) * lu(k,1372) + lu(k,1393) = lu(k,1393) - lu(k,982) * lu(k,1372) + lu(k,1397) = lu(k,1397) - lu(k,983) * lu(k,1372) + lu(k,1668) = lu(k,1668) - lu(k,980) * lu(k,1660) + lu(k,1691) = lu(k,1691) - lu(k,981) * lu(k,1660) + lu(k,1694) = lu(k,1694) - lu(k,982) * lu(k,1660) + lu(k,1702) = lu(k,1702) - lu(k,983) * lu(k,1660) + lu(k,1726) = lu(k,1726) - lu(k,980) * lu(k,1718) + lu(k,1748) = lu(k,1748) - lu(k,981) * lu(k,1718) + lu(k,1751) = lu(k,1751) - lu(k,982) * lu(k,1718) + lu(k,1759) = lu(k,1759) - lu(k,983) * lu(k,1718) + lu(k,1819) = lu(k,1819) - lu(k,980) * lu(k,1813) + lu(k,1840) = lu(k,1840) - lu(k,981) * lu(k,1813) + lu(k,1843) = lu(k,1843) - lu(k,982) * lu(k,1813) + lu(k,1851) = lu(k,1851) - lu(k,983) * lu(k,1813) + lu(k,1926) = lu(k,1926) - lu(k,980) * lu(k,1921) + lu(k,1947) = lu(k,1947) - lu(k,981) * lu(k,1921) + lu(k,1950) = lu(k,1950) - lu(k,982) * lu(k,1921) + lu(k,1958) = lu(k,1958) - lu(k,983) * lu(k,1921) + lu(k,2003) = lu(k,2003) - lu(k,980) * lu(k,2000) + lu(k,2012) = lu(k,2012) - lu(k,981) * lu(k,2000) + lu(k,2015) = lu(k,2015) - lu(k,982) * lu(k,2000) + lu(k,2023) = lu(k,2023) - lu(k,983) * lu(k,2000) + lu(k,2045) = lu(k,2045) - lu(k,980) * lu(k,2039) + lu(k,2064) = lu(k,2064) - lu(k,981) * lu(k,2039) + lu(k,2067) = lu(k,2067) - lu(k,982) * lu(k,2039) + lu(k,2075) = lu(k,2075) - lu(k,983) * lu(k,2039) + lu(k,2105) = lu(k,2105) - lu(k,980) * lu(k,2098) + lu(k,2125) = lu(k,2125) - lu(k,981) * lu(k,2098) + lu(k,2128) = lu(k,2128) - lu(k,982) * lu(k,2098) + lu(k,2136) = lu(k,2136) - lu(k,983) * lu(k,2098) + lu(k,2180) = lu(k,2180) - lu(k,980) * lu(k,2179) + lu(k,2192) = lu(k,2192) - lu(k,981) * lu(k,2179) + lu(k,2195) = lu(k,2195) - lu(k,982) * lu(k,2179) + lu(k,2203) = lu(k,2203) - lu(k,983) * lu(k,2179) + lu(k,999) = 1._r8 / lu(k,999) + lu(k,1000) = lu(k,1000) * lu(k,999) + lu(k,1001) = lu(k,1001) * lu(k,999) + lu(k,1002) = lu(k,1002) * lu(k,999) + lu(k,1003) = lu(k,1003) * lu(k,999) + lu(k,1004) = lu(k,1004) * lu(k,999) + lu(k,1005) = lu(k,1005) * lu(k,999) + lu(k,1006) = lu(k,1006) * lu(k,999) + lu(k,1007) = lu(k,1007) * lu(k,999) + lu(k,1008) = lu(k,1008) * lu(k,999) + lu(k,1009) = lu(k,1009) * lu(k,999) + lu(k,1010) = lu(k,1010) * lu(k,999) + lu(k,1011) = lu(k,1011) * lu(k,999) + lu(k,1012) = lu(k,1012) * lu(k,999) + lu(k,1013) = lu(k,1013) * lu(k,999) + lu(k,1014) = lu(k,1014) * lu(k,999) + lu(k,1015) = lu(k,1015) * lu(k,999) + lu(k,1016) = lu(k,1016) * lu(k,999) + lu(k,1017) = lu(k,1017) * lu(k,999) + lu(k,1018) = lu(k,1018) * lu(k,999) + lu(k,1663) = lu(k,1663) - lu(k,1000) * lu(k,1661) + lu(k,1664) = lu(k,1664) - lu(k,1001) * lu(k,1661) + lu(k,1666) = lu(k,1666) - lu(k,1002) * lu(k,1661) + lu(k,1668) = lu(k,1668) - lu(k,1003) * lu(k,1661) + lu(k,1669) = lu(k,1669) - lu(k,1004) * lu(k,1661) + lu(k,1670) = lu(k,1670) - lu(k,1005) * lu(k,1661) + lu(k,1676) = lu(k,1676) - lu(k,1006) * lu(k,1661) + lu(k,1683) = lu(k,1683) - lu(k,1007) * lu(k,1661) + lu(k,1687) = lu(k,1687) - lu(k,1008) * lu(k,1661) + lu(k,1689) = lu(k,1689) - lu(k,1009) * lu(k,1661) + lu(k,1691) = lu(k,1691) - lu(k,1010) * lu(k,1661) + lu(k,1692) = lu(k,1692) - lu(k,1011) * lu(k,1661) + lu(k,1693) = lu(k,1693) - lu(k,1012) * lu(k,1661) + lu(k,1694) = lu(k,1694) - lu(k,1013) * lu(k,1661) + lu(k,1697) = lu(k,1697) - lu(k,1014) * lu(k,1661) + lu(k,1698) = lu(k,1698) - lu(k,1015) * lu(k,1661) + lu(k,1700) = lu(k,1700) - lu(k,1016) * lu(k,1661) + lu(k,1702) = lu(k,1702) - lu(k,1017) * lu(k,1661) + lu(k,1703) = lu(k,1703) - lu(k,1018) * lu(k,1661) + lu(k,1721) = lu(k,1721) - lu(k,1000) * lu(k,1719) + lu(k,1722) = lu(k,1722) - lu(k,1001) * lu(k,1719) + lu(k,1724) = lu(k,1724) - lu(k,1002) * lu(k,1719) + lu(k,1726) = lu(k,1726) - lu(k,1003) * lu(k,1719) + lu(k,1727) = lu(k,1727) - lu(k,1004) * lu(k,1719) + lu(k,1728) = lu(k,1728) - lu(k,1005) * lu(k,1719) + lu(k,1734) = lu(k,1734) - lu(k,1006) * lu(k,1719) + lu(k,1741) = lu(k,1741) - lu(k,1007) * lu(k,1719) + lu(k,1744) = lu(k,1744) - lu(k,1008) * lu(k,1719) + lu(k,1746) = lu(k,1746) - lu(k,1009) * lu(k,1719) + lu(k,1748) = lu(k,1748) - lu(k,1010) * lu(k,1719) + lu(k,1749) = lu(k,1749) - lu(k,1011) * lu(k,1719) + lu(k,1750) = lu(k,1750) - lu(k,1012) * lu(k,1719) + lu(k,1751) = lu(k,1751) - lu(k,1013) * lu(k,1719) + lu(k,1754) = lu(k,1754) - lu(k,1014) * lu(k,1719) + lu(k,1755) = lu(k,1755) - lu(k,1015) * lu(k,1719) + lu(k,1757) = lu(k,1757) - lu(k,1016) * lu(k,1719) + lu(k,1759) = lu(k,1759) - lu(k,1017) * lu(k,1719) + lu(k,1760) = lu(k,1760) - lu(k,1018) * lu(k,1719) + lu(k,2101) = lu(k,2101) - lu(k,1000) * lu(k,2099) + lu(k,2102) = lu(k,2102) - lu(k,1001) * lu(k,2099) + lu(k,2103) = lu(k,2103) - lu(k,1002) * lu(k,2099) + lu(k,2105) = lu(k,2105) - lu(k,1003) * lu(k,2099) + lu(k,2106) = lu(k,2106) - lu(k,1004) * lu(k,2099) + lu(k,2107) = lu(k,2107) - lu(k,1005) * lu(k,2099) + lu(k,2111) = lu(k,2111) - lu(k,1006) * lu(k,2099) + lu(k,2118) = lu(k,2118) - lu(k,1007) * lu(k,2099) + lu(k,2121) = lu(k,2121) - lu(k,1008) * lu(k,2099) + lu(k,2123) = lu(k,2123) - lu(k,1009) * lu(k,2099) + lu(k,2125) = lu(k,2125) - lu(k,1010) * lu(k,2099) + lu(k,2126) = lu(k,2126) - lu(k,1011) * lu(k,2099) + lu(k,2127) = lu(k,2127) - lu(k,1012) * lu(k,2099) + lu(k,2128) = lu(k,2128) - lu(k,1013) * lu(k,2099) + lu(k,2131) = lu(k,2131) - lu(k,1014) * lu(k,2099) + lu(k,2132) = lu(k,2132) - lu(k,1015) * lu(k,2099) + lu(k,2134) = lu(k,2134) - lu(k,1016) * lu(k,2099) + lu(k,2136) = lu(k,2136) - lu(k,1017) * lu(k,2099) + lu(k,2137) = lu(k,2137) - lu(k,1018) * lu(k,2099) end do end subroutine lu_fac21 subroutine lu_fac22( avec_len, lu ) @@ -4405,412 +3792,316 @@ subroutine lu_fac22( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1052) = 1._r8 / lu(k,1052) - lu(k,1053) = lu(k,1053) * lu(k,1052) - lu(k,1054) = lu(k,1054) * lu(k,1052) - lu(k,1055) = lu(k,1055) * lu(k,1052) - lu(k,1056) = lu(k,1056) * lu(k,1052) - lu(k,1057) = lu(k,1057) * lu(k,1052) - lu(k,1058) = lu(k,1058) * lu(k,1052) - lu(k,1059) = lu(k,1059) * lu(k,1052) - lu(k,1060) = lu(k,1060) * lu(k,1052) - lu(k,1061) = lu(k,1061) * lu(k,1052) - lu(k,1062) = lu(k,1062) * lu(k,1052) - lu(k,1074) = lu(k,1074) - lu(k,1053) * lu(k,1071) - lu(k,1076) = lu(k,1076) - lu(k,1054) * lu(k,1071) - lu(k,1078) = lu(k,1078) - lu(k,1055) * lu(k,1071) - lu(k,1079) = lu(k,1079) - lu(k,1056) * lu(k,1071) - lu(k,1080) = lu(k,1080) - lu(k,1057) * lu(k,1071) - lu(k,1081) = lu(k,1081) - lu(k,1058) * lu(k,1071) - lu(k,1082) = lu(k,1082) - lu(k,1059) * lu(k,1071) - lu(k,1083) = lu(k,1083) - lu(k,1060) * lu(k,1071) - lu(k,1084) = lu(k,1084) - lu(k,1061) * lu(k,1071) - lu(k,1085) = lu(k,1085) - lu(k,1062) * lu(k,1071) - lu(k,1141) = lu(k,1141) - lu(k,1053) * lu(k,1139) - lu(k,1146) = lu(k,1146) - lu(k,1054) * lu(k,1139) - lu(k,1148) = lu(k,1148) - lu(k,1055) * lu(k,1139) - lu(k,1149) = lu(k,1149) - lu(k,1056) * lu(k,1139) - lu(k,1150) = lu(k,1150) - lu(k,1057) * lu(k,1139) - lu(k,1151) = lu(k,1151) - lu(k,1058) * lu(k,1139) - lu(k,1152) = lu(k,1152) - lu(k,1059) * lu(k,1139) - lu(k,1153) = lu(k,1153) - lu(k,1060) * lu(k,1139) - lu(k,1154) = lu(k,1154) - lu(k,1061) * lu(k,1139) - lu(k,1155) = lu(k,1155) - lu(k,1062) * lu(k,1139) - lu(k,1211) = lu(k,1211) - lu(k,1053) * lu(k,1209) - lu(k,1216) = lu(k,1216) - lu(k,1054) * lu(k,1209) - lu(k,1218) = lu(k,1218) - lu(k,1055) * lu(k,1209) - lu(k,1219) = lu(k,1219) - lu(k,1056) * lu(k,1209) - lu(k,1220) = lu(k,1220) - lu(k,1057) * lu(k,1209) - lu(k,1221) = lu(k,1221) - lu(k,1058) * lu(k,1209) - lu(k,1222) = lu(k,1222) - lu(k,1059) * lu(k,1209) - lu(k,1223) = lu(k,1223) - lu(k,1060) * lu(k,1209) - lu(k,1224) = lu(k,1224) - lu(k,1061) * lu(k,1209) - lu(k,1225) = lu(k,1225) - lu(k,1062) * lu(k,1209) - lu(k,1258) = lu(k,1258) - lu(k,1053) * lu(k,1255) - lu(k,1264) = lu(k,1264) - lu(k,1054) * lu(k,1255) - lu(k,1266) = lu(k,1266) - lu(k,1055) * lu(k,1255) - lu(k,1267) = lu(k,1267) - lu(k,1056) * lu(k,1255) - lu(k,1268) = lu(k,1268) - lu(k,1057) * lu(k,1255) - lu(k,1269) = lu(k,1269) - lu(k,1058) * lu(k,1255) - lu(k,1270) = lu(k,1270) - lu(k,1059) * lu(k,1255) - lu(k,1271) = lu(k,1271) - lu(k,1060) * lu(k,1255) - lu(k,1272) = lu(k,1272) - lu(k,1061) * lu(k,1255) - lu(k,1273) = lu(k,1273) - lu(k,1062) * lu(k,1255) - lu(k,1494) = lu(k,1494) - lu(k,1053) * lu(k,1491) - lu(k,1501) = lu(k,1501) - lu(k,1054) * lu(k,1491) - lu(k,1504) = lu(k,1504) - lu(k,1055) * lu(k,1491) - lu(k,1507) = lu(k,1507) - lu(k,1056) * lu(k,1491) - lu(k,1508) = lu(k,1508) - lu(k,1057) * lu(k,1491) - lu(k,1509) = lu(k,1509) - lu(k,1058) * lu(k,1491) - lu(k,1510) = lu(k,1510) - lu(k,1059) * lu(k,1491) - lu(k,1512) = lu(k,1512) - lu(k,1060) * lu(k,1491) - lu(k,1513) = lu(k,1513) - lu(k,1061) * lu(k,1491) - lu(k,1517) = lu(k,1517) - lu(k,1062) * lu(k,1491) - lu(k,1626) = lu(k,1626) - lu(k,1053) * lu(k,1623) - lu(k,1632) = lu(k,1632) - lu(k,1054) * lu(k,1623) - lu(k,1635) = lu(k,1635) - lu(k,1055) * lu(k,1623) - lu(k,1638) = lu(k,1638) - lu(k,1056) * lu(k,1623) - lu(k,1639) = lu(k,1639) - lu(k,1057) * lu(k,1623) - lu(k,1640) = lu(k,1640) - lu(k,1058) * lu(k,1623) - lu(k,1641) = lu(k,1641) - lu(k,1059) * lu(k,1623) - lu(k,1643) = lu(k,1643) - lu(k,1060) * lu(k,1623) - lu(k,1644) = lu(k,1644) - lu(k,1061) * lu(k,1623) - lu(k,1648) = lu(k,1648) - lu(k,1062) * lu(k,1623) - lu(k,1677) = lu(k,1677) - lu(k,1053) * lu(k,1674) - lu(k,1683) = lu(k,1683) - lu(k,1054) * lu(k,1674) - lu(k,1685) = lu(k,1685) - lu(k,1055) * lu(k,1674) - lu(k,1688) = lu(k,1688) - lu(k,1056) * lu(k,1674) - lu(k,1689) = lu(k,1689) - lu(k,1057) * lu(k,1674) - lu(k,1690) = lu(k,1690) - lu(k,1058) * lu(k,1674) - lu(k,1691) = lu(k,1691) - lu(k,1059) * lu(k,1674) - lu(k,1693) = lu(k,1693) - lu(k,1060) * lu(k,1674) - lu(k,1694) = lu(k,1694) - lu(k,1061) * lu(k,1674) - lu(k,1698) = lu(k,1698) - lu(k,1062) * lu(k,1674) - lu(k,1827) = lu(k,1827) - lu(k,1053) * lu(k,1824) - lu(k,1833) = lu(k,1833) - lu(k,1054) * lu(k,1824) - lu(k,1836) = lu(k,1836) - lu(k,1055) * lu(k,1824) - lu(k,1839) = lu(k,1839) - lu(k,1056) * lu(k,1824) - lu(k,1840) = lu(k,1840) - lu(k,1057) * lu(k,1824) - lu(k,1841) = lu(k,1841) - lu(k,1058) * lu(k,1824) - lu(k,1842) = lu(k,1842) - lu(k,1059) * lu(k,1824) - lu(k,1844) = lu(k,1844) - lu(k,1060) * lu(k,1824) - lu(k,1845) = lu(k,1845) - lu(k,1061) * lu(k,1824) - lu(k,1849) = lu(k,1849) - lu(k,1062) * lu(k,1824) - lu(k,1970) = lu(k,1970) - lu(k,1053) * lu(k,1967) - lu(k,1977) = lu(k,1977) - lu(k,1054) * lu(k,1967) - lu(k,1980) = lu(k,1980) - lu(k,1055) * lu(k,1967) - lu(k,1983) = lu(k,1983) - lu(k,1056) * lu(k,1967) - lu(k,1984) = lu(k,1984) - lu(k,1057) * lu(k,1967) - lu(k,1985) = lu(k,1985) - lu(k,1058) * lu(k,1967) - lu(k,1986) = lu(k,1986) - lu(k,1059) * lu(k,1967) - lu(k,1988) = lu(k,1988) - lu(k,1060) * lu(k,1967) - lu(k,1989) = lu(k,1989) - lu(k,1061) * lu(k,1967) - lu(k,1993) = lu(k,1993) - lu(k,1062) * lu(k,1967) - lu(k,1072) = 1._r8 / lu(k,1072) - lu(k,1073) = lu(k,1073) * lu(k,1072) - lu(k,1074) = lu(k,1074) * lu(k,1072) - lu(k,1075) = lu(k,1075) * lu(k,1072) - lu(k,1076) = lu(k,1076) * lu(k,1072) - lu(k,1077) = lu(k,1077) * lu(k,1072) - lu(k,1078) = lu(k,1078) * lu(k,1072) - lu(k,1079) = lu(k,1079) * lu(k,1072) - lu(k,1080) = lu(k,1080) * lu(k,1072) - lu(k,1081) = lu(k,1081) * lu(k,1072) - lu(k,1082) = lu(k,1082) * lu(k,1072) - lu(k,1083) = lu(k,1083) * lu(k,1072) - lu(k,1084) = lu(k,1084) * lu(k,1072) - lu(k,1085) = lu(k,1085) * lu(k,1072) - lu(k,1257) = lu(k,1257) - lu(k,1073) * lu(k,1256) - lu(k,1258) = lu(k,1258) - lu(k,1074) * lu(k,1256) - lu(k,1260) = lu(k,1260) - lu(k,1075) * lu(k,1256) - lu(k,1264) = lu(k,1264) - lu(k,1076) * lu(k,1256) - lu(k,1265) = lu(k,1265) - lu(k,1077) * lu(k,1256) - lu(k,1266) = lu(k,1266) - lu(k,1078) * lu(k,1256) - lu(k,1267) = lu(k,1267) - lu(k,1079) * lu(k,1256) - lu(k,1268) = lu(k,1268) - lu(k,1080) * lu(k,1256) - lu(k,1269) = lu(k,1269) - lu(k,1081) * lu(k,1256) - lu(k,1270) = lu(k,1270) - lu(k,1082) * lu(k,1256) - lu(k,1271) = lu(k,1271) - lu(k,1083) * lu(k,1256) - lu(k,1272) = lu(k,1272) - lu(k,1084) * lu(k,1256) - lu(k,1273) = lu(k,1273) - lu(k,1085) * lu(k,1256) - lu(k,1493) = lu(k,1493) - lu(k,1073) * lu(k,1492) - lu(k,1494) = lu(k,1494) - lu(k,1074) * lu(k,1492) - lu(k,1497) = lu(k,1497) - lu(k,1075) * lu(k,1492) - lu(k,1501) = lu(k,1501) - lu(k,1076) * lu(k,1492) - lu(k,1503) = lu(k,1503) - lu(k,1077) * lu(k,1492) - lu(k,1504) = lu(k,1504) - lu(k,1078) * lu(k,1492) - lu(k,1507) = lu(k,1507) - lu(k,1079) * lu(k,1492) - lu(k,1508) = lu(k,1508) - lu(k,1080) * lu(k,1492) - lu(k,1509) = lu(k,1509) - lu(k,1081) * lu(k,1492) - lu(k,1510) = lu(k,1510) - lu(k,1082) * lu(k,1492) - lu(k,1512) = lu(k,1512) - lu(k,1083) * lu(k,1492) - lu(k,1513) = lu(k,1513) - lu(k,1084) * lu(k,1492) - lu(k,1517) = lu(k,1517) - lu(k,1085) * lu(k,1492) - lu(k,1625) = lu(k,1625) - lu(k,1073) * lu(k,1624) - lu(k,1626) = lu(k,1626) - lu(k,1074) * lu(k,1624) - lu(k,1628) = lu(k,1628) - lu(k,1075) * lu(k,1624) - lu(k,1632) = lu(k,1632) - lu(k,1076) * lu(k,1624) - lu(k,1634) = lu(k,1634) - lu(k,1077) * lu(k,1624) - lu(k,1635) = lu(k,1635) - lu(k,1078) * lu(k,1624) - lu(k,1638) = lu(k,1638) - lu(k,1079) * lu(k,1624) - lu(k,1639) = lu(k,1639) - lu(k,1080) * lu(k,1624) - lu(k,1640) = lu(k,1640) - lu(k,1081) * lu(k,1624) - lu(k,1641) = lu(k,1641) - lu(k,1082) * lu(k,1624) - lu(k,1643) = lu(k,1643) - lu(k,1083) * lu(k,1624) - lu(k,1644) = lu(k,1644) - lu(k,1084) * lu(k,1624) - lu(k,1648) = lu(k,1648) - lu(k,1085) * lu(k,1624) - lu(k,1676) = lu(k,1676) - lu(k,1073) * lu(k,1675) - lu(k,1677) = lu(k,1677) - lu(k,1074) * lu(k,1675) - lu(k,1679) = lu(k,1679) - lu(k,1075) * lu(k,1675) - lu(k,1683) = lu(k,1683) - lu(k,1076) * lu(k,1675) - lu(k,1684) = lu(k,1684) - lu(k,1077) * lu(k,1675) - lu(k,1685) = lu(k,1685) - lu(k,1078) * lu(k,1675) - lu(k,1688) = lu(k,1688) - lu(k,1079) * lu(k,1675) - lu(k,1689) = lu(k,1689) - lu(k,1080) * lu(k,1675) - lu(k,1690) = lu(k,1690) - lu(k,1081) * lu(k,1675) - lu(k,1691) = lu(k,1691) - lu(k,1082) * lu(k,1675) - lu(k,1693) = lu(k,1693) - lu(k,1083) * lu(k,1675) - lu(k,1694) = lu(k,1694) - lu(k,1084) * lu(k,1675) - lu(k,1698) = lu(k,1698) - lu(k,1085) * lu(k,1675) - lu(k,1826) = lu(k,1826) - lu(k,1073) * lu(k,1825) - lu(k,1827) = lu(k,1827) - lu(k,1074) * lu(k,1825) - lu(k,1829) = lu(k,1829) - lu(k,1075) * lu(k,1825) - lu(k,1833) = lu(k,1833) - lu(k,1076) * lu(k,1825) - lu(k,1835) = lu(k,1835) - lu(k,1077) * lu(k,1825) - lu(k,1836) = lu(k,1836) - lu(k,1078) * lu(k,1825) - lu(k,1839) = lu(k,1839) - lu(k,1079) * lu(k,1825) - lu(k,1840) = lu(k,1840) - lu(k,1080) * lu(k,1825) - lu(k,1841) = lu(k,1841) - lu(k,1081) * lu(k,1825) - lu(k,1842) = lu(k,1842) - lu(k,1082) * lu(k,1825) - lu(k,1844) = lu(k,1844) - lu(k,1083) * lu(k,1825) - lu(k,1845) = lu(k,1845) - lu(k,1084) * lu(k,1825) - lu(k,1849) = lu(k,1849) - lu(k,1085) * lu(k,1825) - lu(k,1969) = lu(k,1969) - lu(k,1073) * lu(k,1968) - lu(k,1970) = lu(k,1970) - lu(k,1074) * lu(k,1968) - lu(k,1973) = lu(k,1973) - lu(k,1075) * lu(k,1968) - lu(k,1977) = lu(k,1977) - lu(k,1076) * lu(k,1968) - lu(k,1979) = lu(k,1979) - lu(k,1077) * lu(k,1968) - lu(k,1980) = lu(k,1980) - lu(k,1078) * lu(k,1968) - lu(k,1983) = lu(k,1983) - lu(k,1079) * lu(k,1968) - lu(k,1984) = lu(k,1984) - lu(k,1080) * lu(k,1968) - lu(k,1985) = lu(k,1985) - lu(k,1081) * lu(k,1968) - lu(k,1986) = lu(k,1986) - lu(k,1082) * lu(k,1968) - lu(k,1988) = lu(k,1988) - lu(k,1083) * lu(k,1968) - lu(k,1989) = lu(k,1989) - lu(k,1084) * lu(k,1968) - lu(k,1993) = lu(k,1993) - lu(k,1085) * lu(k,1968) - lu(k,2029) = lu(k,2029) - lu(k,1073) * lu(k,2028) - lu(k,2030) = lu(k,2030) - lu(k,1074) * lu(k,2028) - lu(k,2033) = lu(k,2033) - lu(k,1075) * lu(k,2028) - lu(k,2037) = lu(k,2037) - lu(k,1076) * lu(k,2028) - lu(k,2039) = lu(k,2039) - lu(k,1077) * lu(k,2028) - lu(k,2040) = lu(k,2040) - lu(k,1078) * lu(k,2028) - lu(k,2043) = lu(k,2043) - lu(k,1079) * lu(k,2028) - lu(k,2044) = lu(k,2044) - lu(k,1080) * lu(k,2028) - lu(k,2045) = lu(k,2045) - lu(k,1081) * lu(k,2028) - lu(k,2046) = lu(k,2046) - lu(k,1082) * lu(k,2028) - lu(k,2048) = lu(k,2048) - lu(k,1083) * lu(k,2028) - lu(k,2049) = lu(k,2049) - lu(k,1084) * lu(k,2028) - lu(k,2053) = lu(k,2053) - lu(k,1085) * lu(k,2028) - lu(k,1088) = 1._r8 / lu(k,1088) - lu(k,1089) = lu(k,1089) * lu(k,1088) - lu(k,1090) = lu(k,1090) * lu(k,1088) - lu(k,1091) = lu(k,1091) * lu(k,1088) - lu(k,1092) = lu(k,1092) * lu(k,1088) - lu(k,1093) = lu(k,1093) * lu(k,1088) - lu(k,1094) = lu(k,1094) * lu(k,1088) - lu(k,1095) = lu(k,1095) * lu(k,1088) - lu(k,1096) = lu(k,1096) * lu(k,1088) - lu(k,1097) = lu(k,1097) * lu(k,1088) - lu(k,1098) = lu(k,1098) * lu(k,1088) - lu(k,1141) = lu(k,1141) - lu(k,1089) * lu(k,1140) - lu(k,1144) = - lu(k,1090) * lu(k,1140) - lu(k,1145) = - lu(k,1091) * lu(k,1140) - lu(k,1146) = lu(k,1146) - lu(k,1092) * lu(k,1140) - lu(k,1148) = lu(k,1148) - lu(k,1093) * lu(k,1140) - lu(k,1149) = lu(k,1149) - lu(k,1094) * lu(k,1140) - lu(k,1153) = lu(k,1153) - lu(k,1095) * lu(k,1140) - lu(k,1154) = lu(k,1154) - lu(k,1096) * lu(k,1140) - lu(k,1156) = - lu(k,1097) * lu(k,1140) - lu(k,1157) = lu(k,1157) - lu(k,1098) * lu(k,1140) - lu(k,1211) = lu(k,1211) - lu(k,1089) * lu(k,1210) - lu(k,1213) = - lu(k,1090) * lu(k,1210) - lu(k,1215) = - lu(k,1091) * lu(k,1210) - lu(k,1216) = lu(k,1216) - lu(k,1092) * lu(k,1210) - lu(k,1218) = lu(k,1218) - lu(k,1093) * lu(k,1210) - lu(k,1219) = lu(k,1219) - lu(k,1094) * lu(k,1210) - lu(k,1223) = lu(k,1223) - lu(k,1095) * lu(k,1210) - lu(k,1224) = lu(k,1224) - lu(k,1096) * lu(k,1210) - lu(k,1226) = - lu(k,1097) * lu(k,1210) - lu(k,1227) = lu(k,1227) - lu(k,1098) * lu(k,1210) - lu(k,1258) = lu(k,1258) - lu(k,1089) * lu(k,1257) - lu(k,1261) = lu(k,1261) - lu(k,1090) * lu(k,1257) - lu(k,1263) = lu(k,1263) - lu(k,1091) * lu(k,1257) - lu(k,1264) = lu(k,1264) - lu(k,1092) * lu(k,1257) - lu(k,1266) = lu(k,1266) - lu(k,1093) * lu(k,1257) - lu(k,1267) = lu(k,1267) - lu(k,1094) * lu(k,1257) - lu(k,1271) = lu(k,1271) - lu(k,1095) * lu(k,1257) - lu(k,1272) = lu(k,1272) - lu(k,1096) * lu(k,1257) - lu(k,1274) = lu(k,1274) - lu(k,1097) * lu(k,1257) - lu(k,1275) = lu(k,1275) - lu(k,1098) * lu(k,1257) - lu(k,1494) = lu(k,1494) - lu(k,1089) * lu(k,1493) - lu(k,1498) = lu(k,1498) - lu(k,1090) * lu(k,1493) - lu(k,1500) = lu(k,1500) - lu(k,1091) * lu(k,1493) - lu(k,1501) = lu(k,1501) - lu(k,1092) * lu(k,1493) - lu(k,1504) = lu(k,1504) - lu(k,1093) * lu(k,1493) - lu(k,1507) = lu(k,1507) - lu(k,1094) * lu(k,1493) - lu(k,1512) = lu(k,1512) - lu(k,1095) * lu(k,1493) - lu(k,1513) = lu(k,1513) - lu(k,1096) * lu(k,1493) - lu(k,1518) = lu(k,1518) - lu(k,1097) * lu(k,1493) - lu(k,1519) = lu(k,1519) - lu(k,1098) * lu(k,1493) - lu(k,1626) = lu(k,1626) - lu(k,1089) * lu(k,1625) - lu(k,1629) = lu(k,1629) - lu(k,1090) * lu(k,1625) - lu(k,1631) = lu(k,1631) - lu(k,1091) * lu(k,1625) - lu(k,1632) = lu(k,1632) - lu(k,1092) * lu(k,1625) - lu(k,1635) = lu(k,1635) - lu(k,1093) * lu(k,1625) - lu(k,1638) = lu(k,1638) - lu(k,1094) * lu(k,1625) - lu(k,1643) = lu(k,1643) - lu(k,1095) * lu(k,1625) - lu(k,1644) = lu(k,1644) - lu(k,1096) * lu(k,1625) - lu(k,1649) = lu(k,1649) - lu(k,1097) * lu(k,1625) - lu(k,1650) = lu(k,1650) - lu(k,1098) * lu(k,1625) - lu(k,1677) = lu(k,1677) - lu(k,1089) * lu(k,1676) - lu(k,1680) = lu(k,1680) - lu(k,1090) * lu(k,1676) - lu(k,1682) = lu(k,1682) - lu(k,1091) * lu(k,1676) - lu(k,1683) = lu(k,1683) - lu(k,1092) * lu(k,1676) - lu(k,1685) = lu(k,1685) - lu(k,1093) * lu(k,1676) - lu(k,1688) = lu(k,1688) - lu(k,1094) * lu(k,1676) - lu(k,1693) = lu(k,1693) - lu(k,1095) * lu(k,1676) - lu(k,1694) = lu(k,1694) - lu(k,1096) * lu(k,1676) - lu(k,1699) = - lu(k,1097) * lu(k,1676) - lu(k,1700) = lu(k,1700) - lu(k,1098) * lu(k,1676) - lu(k,1827) = lu(k,1827) - lu(k,1089) * lu(k,1826) - lu(k,1830) = lu(k,1830) - lu(k,1090) * lu(k,1826) - lu(k,1832) = lu(k,1832) - lu(k,1091) * lu(k,1826) - lu(k,1833) = lu(k,1833) - lu(k,1092) * lu(k,1826) - lu(k,1836) = lu(k,1836) - lu(k,1093) * lu(k,1826) - lu(k,1839) = lu(k,1839) - lu(k,1094) * lu(k,1826) - lu(k,1844) = lu(k,1844) - lu(k,1095) * lu(k,1826) - lu(k,1845) = lu(k,1845) - lu(k,1096) * lu(k,1826) - lu(k,1850) = lu(k,1850) - lu(k,1097) * lu(k,1826) - lu(k,1851) = lu(k,1851) - lu(k,1098) * lu(k,1826) - lu(k,1970) = lu(k,1970) - lu(k,1089) * lu(k,1969) - lu(k,1974) = lu(k,1974) - lu(k,1090) * lu(k,1969) - lu(k,1976) = lu(k,1976) - lu(k,1091) * lu(k,1969) - lu(k,1977) = lu(k,1977) - lu(k,1092) * lu(k,1969) - lu(k,1980) = lu(k,1980) - lu(k,1093) * lu(k,1969) - lu(k,1983) = lu(k,1983) - lu(k,1094) * lu(k,1969) - lu(k,1988) = lu(k,1988) - lu(k,1095) * lu(k,1969) - lu(k,1989) = lu(k,1989) - lu(k,1096) * lu(k,1969) - lu(k,1994) = lu(k,1994) - lu(k,1097) * lu(k,1969) - lu(k,1995) = lu(k,1995) - lu(k,1098) * lu(k,1969) - lu(k,2030) = lu(k,2030) - lu(k,1089) * lu(k,2029) - lu(k,2034) = - lu(k,1090) * lu(k,2029) - lu(k,2036) = - lu(k,1091) * lu(k,2029) - lu(k,2037) = lu(k,2037) - lu(k,1092) * lu(k,2029) - lu(k,2040) = lu(k,2040) - lu(k,1093) * lu(k,2029) - lu(k,2043) = lu(k,2043) - lu(k,1094) * lu(k,2029) - lu(k,2048) = lu(k,2048) - lu(k,1095) * lu(k,2029) - lu(k,2049) = lu(k,2049) - lu(k,1096) * lu(k,2029) - lu(k,2054) = lu(k,2054) - lu(k,1097) * lu(k,2029) - lu(k,2055) = lu(k,2055) - lu(k,1098) * lu(k,2029) - lu(k,1100) = 1._r8 / lu(k,1100) - lu(k,1101) = lu(k,1101) * lu(k,1100) - lu(k,1102) = lu(k,1102) * lu(k,1100) - lu(k,1103) = lu(k,1103) * lu(k,1100) - lu(k,1104) = lu(k,1104) * lu(k,1100) - lu(k,1105) = lu(k,1105) * lu(k,1100) - lu(k,1106) = lu(k,1106) * lu(k,1100) - lu(k,1107) = lu(k,1107) * lu(k,1100) - lu(k,1146) = lu(k,1146) - lu(k,1101) * lu(k,1141) - lu(k,1147) = lu(k,1147) - lu(k,1102) * lu(k,1141) - lu(k,1148) = lu(k,1148) - lu(k,1103) * lu(k,1141) - lu(k,1149) = lu(k,1149) - lu(k,1104) * lu(k,1141) - lu(k,1154) = lu(k,1154) - lu(k,1105) * lu(k,1141) - lu(k,1155) = lu(k,1155) - lu(k,1106) * lu(k,1141) - lu(k,1157) = lu(k,1157) - lu(k,1107) * lu(k,1141) - lu(k,1166) = lu(k,1166) - lu(k,1101) * lu(k,1163) - lu(k,1167) = lu(k,1167) - lu(k,1102) * lu(k,1163) - lu(k,1168) = lu(k,1168) - lu(k,1103) * lu(k,1163) - lu(k,1169) = lu(k,1169) - lu(k,1104) * lu(k,1163) - lu(k,1174) = lu(k,1174) - lu(k,1105) * lu(k,1163) - lu(k,1175) = lu(k,1175) - lu(k,1106) * lu(k,1163) - lu(k,1177) = lu(k,1177) - lu(k,1107) * lu(k,1163) - lu(k,1189) = lu(k,1189) - lu(k,1101) * lu(k,1186) - lu(k,1190) = lu(k,1190) - lu(k,1102) * lu(k,1186) - lu(k,1191) = lu(k,1191) - lu(k,1103) * lu(k,1186) - lu(k,1192) = lu(k,1192) - lu(k,1104) * lu(k,1186) - lu(k,1197) = lu(k,1197) - lu(k,1105) * lu(k,1186) - lu(k,1198) = lu(k,1198) - lu(k,1106) * lu(k,1186) - lu(k,1199) = lu(k,1199) - lu(k,1107) * lu(k,1186) - lu(k,1216) = lu(k,1216) - lu(k,1101) * lu(k,1211) - lu(k,1217) = lu(k,1217) - lu(k,1102) * lu(k,1211) - lu(k,1218) = lu(k,1218) - lu(k,1103) * lu(k,1211) - lu(k,1219) = lu(k,1219) - lu(k,1104) * lu(k,1211) - lu(k,1224) = lu(k,1224) - lu(k,1105) * lu(k,1211) - lu(k,1225) = lu(k,1225) - lu(k,1106) * lu(k,1211) - lu(k,1227) = lu(k,1227) - lu(k,1107) * lu(k,1211) - lu(k,1234) = lu(k,1234) - lu(k,1101) * lu(k,1232) - lu(k,1235) = - lu(k,1102) * lu(k,1232) - lu(k,1236) = - lu(k,1103) * lu(k,1232) - lu(k,1237) = lu(k,1237) - lu(k,1104) * lu(k,1232) - lu(k,1242) = lu(k,1242) - lu(k,1105) * lu(k,1232) - lu(k,1243) = lu(k,1243) - lu(k,1106) * lu(k,1232) - lu(k,1245) = lu(k,1245) - lu(k,1107) * lu(k,1232) - lu(k,1264) = lu(k,1264) - lu(k,1101) * lu(k,1258) - lu(k,1265) = lu(k,1265) - lu(k,1102) * lu(k,1258) - lu(k,1266) = lu(k,1266) - lu(k,1103) * lu(k,1258) - lu(k,1267) = lu(k,1267) - lu(k,1104) * lu(k,1258) - lu(k,1272) = lu(k,1272) - lu(k,1105) * lu(k,1258) - lu(k,1273) = lu(k,1273) - lu(k,1106) * lu(k,1258) - lu(k,1275) = lu(k,1275) - lu(k,1107) * lu(k,1258) - lu(k,1501) = lu(k,1501) - lu(k,1101) * lu(k,1494) - lu(k,1503) = lu(k,1503) - lu(k,1102) * lu(k,1494) - lu(k,1504) = lu(k,1504) - lu(k,1103) * lu(k,1494) - lu(k,1507) = lu(k,1507) - lu(k,1104) * lu(k,1494) - lu(k,1513) = lu(k,1513) - lu(k,1105) * lu(k,1494) - lu(k,1517) = lu(k,1517) - lu(k,1106) * lu(k,1494) - lu(k,1519) = lu(k,1519) - lu(k,1107) * lu(k,1494) - lu(k,1542) = lu(k,1542) - lu(k,1101) * lu(k,1539) - lu(k,1544) = lu(k,1544) - lu(k,1102) * lu(k,1539) - lu(k,1545) = lu(k,1545) - lu(k,1103) * lu(k,1539) - lu(k,1548) = lu(k,1548) - lu(k,1104) * lu(k,1539) - lu(k,1554) = lu(k,1554) - lu(k,1105) * lu(k,1539) - lu(k,1558) = lu(k,1558) - lu(k,1106) * lu(k,1539) - lu(k,1560) = lu(k,1560) - lu(k,1107) * lu(k,1539) - lu(k,1632) = lu(k,1632) - lu(k,1101) * lu(k,1626) - lu(k,1634) = lu(k,1634) - lu(k,1102) * lu(k,1626) - lu(k,1635) = lu(k,1635) - lu(k,1103) * lu(k,1626) - lu(k,1638) = lu(k,1638) - lu(k,1104) * lu(k,1626) - lu(k,1644) = lu(k,1644) - lu(k,1105) * lu(k,1626) - lu(k,1648) = lu(k,1648) - lu(k,1106) * lu(k,1626) - lu(k,1650) = lu(k,1650) - lu(k,1107) * lu(k,1626) - lu(k,1683) = lu(k,1683) - lu(k,1101) * lu(k,1677) - lu(k,1684) = lu(k,1684) - lu(k,1102) * lu(k,1677) - lu(k,1685) = lu(k,1685) - lu(k,1103) * lu(k,1677) - lu(k,1688) = lu(k,1688) - lu(k,1104) * lu(k,1677) - lu(k,1694) = lu(k,1694) - lu(k,1105) * lu(k,1677) - lu(k,1698) = lu(k,1698) - lu(k,1106) * lu(k,1677) - lu(k,1700) = lu(k,1700) - lu(k,1107) * lu(k,1677) - lu(k,1833) = lu(k,1833) - lu(k,1101) * lu(k,1827) - lu(k,1835) = lu(k,1835) - lu(k,1102) * lu(k,1827) - lu(k,1836) = lu(k,1836) - lu(k,1103) * lu(k,1827) - lu(k,1839) = lu(k,1839) - lu(k,1104) * lu(k,1827) - lu(k,1845) = lu(k,1845) - lu(k,1105) * lu(k,1827) - lu(k,1849) = lu(k,1849) - lu(k,1106) * lu(k,1827) - lu(k,1851) = lu(k,1851) - lu(k,1107) * lu(k,1827) - lu(k,1977) = lu(k,1977) - lu(k,1101) * lu(k,1970) - lu(k,1979) = lu(k,1979) - lu(k,1102) * lu(k,1970) - lu(k,1980) = lu(k,1980) - lu(k,1103) * lu(k,1970) - lu(k,1983) = lu(k,1983) - lu(k,1104) * lu(k,1970) - lu(k,1989) = lu(k,1989) - lu(k,1105) * lu(k,1970) - lu(k,1993) = lu(k,1993) - lu(k,1106) * lu(k,1970) - lu(k,1995) = lu(k,1995) - lu(k,1107) * lu(k,1970) - lu(k,2037) = lu(k,2037) - lu(k,1101) * lu(k,2030) - lu(k,2039) = lu(k,2039) - lu(k,1102) * lu(k,2030) - lu(k,2040) = lu(k,2040) - lu(k,1103) * lu(k,2030) - lu(k,2043) = lu(k,2043) - lu(k,1104) * lu(k,2030) - lu(k,2049) = lu(k,2049) - lu(k,1105) * lu(k,2030) - lu(k,2053) = lu(k,2053) - lu(k,1106) * lu(k,2030) - lu(k,2055) = lu(k,2055) - lu(k,1107) * lu(k,2030) + lu(k,1024) = 1._r8 / lu(k,1024) + lu(k,1025) = lu(k,1025) * lu(k,1024) + lu(k,1026) = lu(k,1026) * lu(k,1024) + lu(k,1027) = lu(k,1027) * lu(k,1024) + lu(k,1028) = lu(k,1028) * lu(k,1024) + lu(k,1029) = lu(k,1029) * lu(k,1024) + lu(k,1030) = lu(k,1030) * lu(k,1024) + lu(k,1031) = lu(k,1031) * lu(k,1024) + lu(k,1032) = lu(k,1032) * lu(k,1024) + lu(k,1033) = lu(k,1033) * lu(k,1024) + lu(k,1034) = lu(k,1034) * lu(k,1024) + lu(k,1035) = lu(k,1035) * lu(k,1024) + lu(k,1036) = lu(k,1036) * lu(k,1024) + lu(k,1037) = lu(k,1037) * lu(k,1024) + lu(k,1038) = lu(k,1038) * lu(k,1024) + lu(k,1039) = lu(k,1039) * lu(k,1024) + lu(k,1040) = lu(k,1040) * lu(k,1024) + lu(k,1327) = lu(k,1327) - lu(k,1025) * lu(k,1326) + lu(k,1328) = lu(k,1328) - lu(k,1026) * lu(k,1326) + lu(k,1329) = - lu(k,1027) * lu(k,1326) + lu(k,1330) = lu(k,1330) - lu(k,1028) * lu(k,1326) + lu(k,1334) = lu(k,1334) - lu(k,1029) * lu(k,1326) + lu(k,1335) = - lu(k,1030) * lu(k,1326) + lu(k,1337) = lu(k,1337) - lu(k,1031) * lu(k,1326) + lu(k,1338) = lu(k,1338) - lu(k,1032) * lu(k,1326) + lu(k,1339) = - lu(k,1033) * lu(k,1326) + lu(k,1340) = - lu(k,1034) * lu(k,1326) + lu(k,1341) = lu(k,1341) - lu(k,1035) * lu(k,1326) + lu(k,1342) = lu(k,1342) - lu(k,1036) * lu(k,1326) + lu(k,1343) = lu(k,1343) - lu(k,1037) * lu(k,1326) + lu(k,1344) = - lu(k,1038) * lu(k,1326) + lu(k,1345) = lu(k,1345) - lu(k,1039) * lu(k,1326) + lu(k,1346) = lu(k,1346) - lu(k,1040) * lu(k,1326) + lu(k,1666) = lu(k,1666) - lu(k,1025) * lu(k,1662) + lu(k,1668) = lu(k,1668) - lu(k,1026) * lu(k,1662) + lu(k,1671) = lu(k,1671) - lu(k,1027) * lu(k,1662) + lu(k,1676) = lu(k,1676) - lu(k,1028) * lu(k,1662) + lu(k,1683) = lu(k,1683) - lu(k,1029) * lu(k,1662) + lu(k,1686) = lu(k,1686) - lu(k,1030) * lu(k,1662) + lu(k,1689) = lu(k,1689) - lu(k,1031) * lu(k,1662) + lu(k,1691) = lu(k,1691) - lu(k,1032) * lu(k,1662) + lu(k,1692) = lu(k,1692) - lu(k,1033) * lu(k,1662) + lu(k,1693) = lu(k,1693) - lu(k,1034) * lu(k,1662) + lu(k,1694) = lu(k,1694) - lu(k,1035) * lu(k,1662) + lu(k,1697) = lu(k,1697) - lu(k,1036) * lu(k,1662) + lu(k,1698) = lu(k,1698) - lu(k,1037) * lu(k,1662) + lu(k,1700) = lu(k,1700) - lu(k,1038) * lu(k,1662) + lu(k,1702) = lu(k,1702) - lu(k,1039) * lu(k,1662) + lu(k,1703) = lu(k,1703) - lu(k,1040) * lu(k,1662) + lu(k,1724) = lu(k,1724) - lu(k,1025) * lu(k,1720) + lu(k,1726) = lu(k,1726) - lu(k,1026) * lu(k,1720) + lu(k,1729) = lu(k,1729) - lu(k,1027) * lu(k,1720) + lu(k,1734) = lu(k,1734) - lu(k,1028) * lu(k,1720) + lu(k,1741) = lu(k,1741) - lu(k,1029) * lu(k,1720) + lu(k,1743) = - lu(k,1030) * lu(k,1720) + lu(k,1746) = lu(k,1746) - lu(k,1031) * lu(k,1720) + lu(k,1748) = lu(k,1748) - lu(k,1032) * lu(k,1720) + lu(k,1749) = lu(k,1749) - lu(k,1033) * lu(k,1720) + lu(k,1750) = lu(k,1750) - lu(k,1034) * lu(k,1720) + lu(k,1751) = lu(k,1751) - lu(k,1035) * lu(k,1720) + lu(k,1754) = lu(k,1754) - lu(k,1036) * lu(k,1720) + lu(k,1755) = lu(k,1755) - lu(k,1037) * lu(k,1720) + lu(k,1757) = lu(k,1757) - lu(k,1038) * lu(k,1720) + lu(k,1759) = lu(k,1759) - lu(k,1039) * lu(k,1720) + lu(k,1760) = lu(k,1760) - lu(k,1040) * lu(k,1720) + lu(k,2103) = lu(k,2103) - lu(k,1025) * lu(k,2100) + lu(k,2105) = lu(k,2105) - lu(k,1026) * lu(k,2100) + lu(k,2108) = - lu(k,1027) * lu(k,2100) + lu(k,2111) = lu(k,2111) - lu(k,1028) * lu(k,2100) + lu(k,2118) = lu(k,2118) - lu(k,1029) * lu(k,2100) + lu(k,2120) = lu(k,2120) - lu(k,1030) * lu(k,2100) + lu(k,2123) = lu(k,2123) - lu(k,1031) * lu(k,2100) + lu(k,2125) = lu(k,2125) - lu(k,1032) * lu(k,2100) + lu(k,2126) = lu(k,2126) - lu(k,1033) * lu(k,2100) + lu(k,2127) = lu(k,2127) - lu(k,1034) * lu(k,2100) + lu(k,2128) = lu(k,2128) - lu(k,1035) * lu(k,2100) + lu(k,2131) = lu(k,2131) - lu(k,1036) * lu(k,2100) + lu(k,2132) = lu(k,2132) - lu(k,1037) * lu(k,2100) + lu(k,2134) = lu(k,2134) - lu(k,1038) * lu(k,2100) + lu(k,2136) = lu(k,2136) - lu(k,1039) * lu(k,2100) + lu(k,2137) = lu(k,2137) - lu(k,1040) * lu(k,2100) + lu(k,1045) = 1._r8 / lu(k,1045) + lu(k,1046) = lu(k,1046) * lu(k,1045) + lu(k,1047) = lu(k,1047) * lu(k,1045) + lu(k,1048) = lu(k,1048) * lu(k,1045) + lu(k,1049) = lu(k,1049) * lu(k,1045) + lu(k,1050) = lu(k,1050) * lu(k,1045) + lu(k,1051) = lu(k,1051) * lu(k,1045) + lu(k,1052) = lu(k,1052) * lu(k,1045) + lu(k,1053) = lu(k,1053) * lu(k,1045) + lu(k,1054) = lu(k,1054) * lu(k,1045) + lu(k,1055) = lu(k,1055) * lu(k,1045) + lu(k,1056) = lu(k,1056) * lu(k,1045) + lu(k,1664) = lu(k,1664) - lu(k,1046) * lu(k,1663) + lu(k,1668) = lu(k,1668) - lu(k,1047) * lu(k,1663) + lu(k,1669) = lu(k,1669) - lu(k,1048) * lu(k,1663) + lu(k,1687) = lu(k,1687) - lu(k,1049) * lu(k,1663) + lu(k,1689) = lu(k,1689) - lu(k,1050) * lu(k,1663) + lu(k,1691) = lu(k,1691) - lu(k,1051) * lu(k,1663) + lu(k,1692) = lu(k,1692) - lu(k,1052) * lu(k,1663) + lu(k,1693) = lu(k,1693) - lu(k,1053) * lu(k,1663) + lu(k,1694) = lu(k,1694) - lu(k,1054) * lu(k,1663) + lu(k,1697) = lu(k,1697) - lu(k,1055) * lu(k,1663) + lu(k,1700) = lu(k,1700) - lu(k,1056) * lu(k,1663) + lu(k,1722) = lu(k,1722) - lu(k,1046) * lu(k,1721) + lu(k,1726) = lu(k,1726) - lu(k,1047) * lu(k,1721) + lu(k,1727) = lu(k,1727) - lu(k,1048) * lu(k,1721) + lu(k,1744) = lu(k,1744) - lu(k,1049) * lu(k,1721) + lu(k,1746) = lu(k,1746) - lu(k,1050) * lu(k,1721) + lu(k,1748) = lu(k,1748) - lu(k,1051) * lu(k,1721) + lu(k,1749) = lu(k,1749) - lu(k,1052) * lu(k,1721) + lu(k,1750) = lu(k,1750) - lu(k,1053) * lu(k,1721) + lu(k,1751) = lu(k,1751) - lu(k,1054) * lu(k,1721) + lu(k,1754) = lu(k,1754) - lu(k,1055) * lu(k,1721) + lu(k,1757) = lu(k,1757) - lu(k,1056) * lu(k,1721) + lu(k,1815) = lu(k,1815) - lu(k,1046) * lu(k,1814) + lu(k,1819) = lu(k,1819) - lu(k,1047) * lu(k,1814) + lu(k,1820) = lu(k,1820) - lu(k,1048) * lu(k,1814) + lu(k,1836) = lu(k,1836) - lu(k,1049) * lu(k,1814) + lu(k,1838) = lu(k,1838) - lu(k,1050) * lu(k,1814) + lu(k,1840) = lu(k,1840) - lu(k,1051) * lu(k,1814) + lu(k,1841) = lu(k,1841) - lu(k,1052) * lu(k,1814) + lu(k,1842) = lu(k,1842) - lu(k,1053) * lu(k,1814) + lu(k,1843) = lu(k,1843) - lu(k,1054) * lu(k,1814) + lu(k,1846) = lu(k,1846) - lu(k,1055) * lu(k,1814) + lu(k,1849) = lu(k,1849) - lu(k,1056) * lu(k,1814) + lu(k,1923) = lu(k,1923) - lu(k,1046) * lu(k,1922) + lu(k,1926) = lu(k,1926) - lu(k,1047) * lu(k,1922) + lu(k,1927) = lu(k,1927) - lu(k,1048) * lu(k,1922) + lu(k,1943) = lu(k,1943) - lu(k,1049) * lu(k,1922) + lu(k,1945) = lu(k,1945) - lu(k,1050) * lu(k,1922) + lu(k,1947) = lu(k,1947) - lu(k,1051) * lu(k,1922) + lu(k,1948) = lu(k,1948) - lu(k,1052) * lu(k,1922) + lu(k,1949) = lu(k,1949) - lu(k,1053) * lu(k,1922) + lu(k,1950) = lu(k,1950) - lu(k,1054) * lu(k,1922) + lu(k,1953) = lu(k,1953) - lu(k,1055) * lu(k,1922) + lu(k,1956) = lu(k,1956) - lu(k,1056) * lu(k,1922) + lu(k,2041) = lu(k,2041) - lu(k,1046) * lu(k,2040) + lu(k,2045) = lu(k,2045) - lu(k,1047) * lu(k,2040) + lu(k,2046) = lu(k,2046) - lu(k,1048) * lu(k,2040) + lu(k,2060) = lu(k,2060) - lu(k,1049) * lu(k,2040) + lu(k,2062) = lu(k,2062) - lu(k,1050) * lu(k,2040) + lu(k,2064) = lu(k,2064) - lu(k,1051) * lu(k,2040) + lu(k,2065) = lu(k,2065) - lu(k,1052) * lu(k,2040) + lu(k,2066) = lu(k,2066) - lu(k,1053) * lu(k,2040) + lu(k,2067) = lu(k,2067) - lu(k,1054) * lu(k,2040) + lu(k,2070) = lu(k,2070) - lu(k,1055) * lu(k,2040) + lu(k,2073) = lu(k,2073) - lu(k,1056) * lu(k,2040) + lu(k,2102) = lu(k,2102) - lu(k,1046) * lu(k,2101) + lu(k,2105) = lu(k,2105) - lu(k,1047) * lu(k,2101) + lu(k,2106) = lu(k,2106) - lu(k,1048) * lu(k,2101) + lu(k,2121) = lu(k,2121) - lu(k,1049) * lu(k,2101) + lu(k,2123) = lu(k,2123) - lu(k,1050) * lu(k,2101) + lu(k,2125) = lu(k,2125) - lu(k,1051) * lu(k,2101) + lu(k,2126) = lu(k,2126) - lu(k,1052) * lu(k,2101) + lu(k,2127) = lu(k,2127) - lu(k,1053) * lu(k,2101) + lu(k,2128) = lu(k,2128) - lu(k,1054) * lu(k,2101) + lu(k,2131) = lu(k,2131) - lu(k,1055) * lu(k,2101) + lu(k,2134) = lu(k,2134) - lu(k,1056) * lu(k,2101) + lu(k,1059) = 1._r8 / lu(k,1059) + lu(k,1060) = lu(k,1060) * lu(k,1059) + lu(k,1061) = lu(k,1061) * lu(k,1059) + lu(k,1062) = lu(k,1062) * lu(k,1059) + lu(k,1063) = lu(k,1063) * lu(k,1059) + lu(k,1064) = lu(k,1064) * lu(k,1059) + lu(k,1065) = lu(k,1065) * lu(k,1059) + lu(k,1066) = lu(k,1066) * lu(k,1059) + lu(k,1067) = lu(k,1067) * lu(k,1059) + lu(k,1068) = lu(k,1068) * lu(k,1059) + lu(k,1114) = lu(k,1114) - lu(k,1060) * lu(k,1112) + lu(k,1116) = lu(k,1116) - lu(k,1061) * lu(k,1112) + lu(k,1117) = lu(k,1117) - lu(k,1062) * lu(k,1112) + lu(k,1119) = lu(k,1119) - lu(k,1063) * lu(k,1112) + lu(k,1120) = lu(k,1120) - lu(k,1064) * lu(k,1112) + lu(k,1122) = lu(k,1122) - lu(k,1065) * lu(k,1112) + lu(k,1123) = lu(k,1123) - lu(k,1066) * lu(k,1112) + lu(k,1125) = lu(k,1125) - lu(k,1067) * lu(k,1112) + lu(k,1126) = lu(k,1126) - lu(k,1068) * lu(k,1112) + lu(k,1668) = lu(k,1668) - lu(k,1060) * lu(k,1664) + lu(k,1670) = lu(k,1670) - lu(k,1061) * lu(k,1664) + lu(k,1683) = lu(k,1683) - lu(k,1062) * lu(k,1664) + lu(k,1689) = lu(k,1689) - lu(k,1063) * lu(k,1664) + lu(k,1691) = lu(k,1691) - lu(k,1064) * lu(k,1664) + lu(k,1694) = lu(k,1694) - lu(k,1065) * lu(k,1664) + lu(k,1697) = lu(k,1697) - lu(k,1066) * lu(k,1664) + lu(k,1702) = lu(k,1702) - lu(k,1067) * lu(k,1664) + lu(k,1703) = lu(k,1703) - lu(k,1068) * lu(k,1664) + lu(k,1726) = lu(k,1726) - lu(k,1060) * lu(k,1722) + lu(k,1728) = lu(k,1728) - lu(k,1061) * lu(k,1722) + lu(k,1741) = lu(k,1741) - lu(k,1062) * lu(k,1722) + lu(k,1746) = lu(k,1746) - lu(k,1063) * lu(k,1722) + lu(k,1748) = lu(k,1748) - lu(k,1064) * lu(k,1722) + lu(k,1751) = lu(k,1751) - lu(k,1065) * lu(k,1722) + lu(k,1754) = lu(k,1754) - lu(k,1066) * lu(k,1722) + lu(k,1759) = lu(k,1759) - lu(k,1067) * lu(k,1722) + lu(k,1760) = lu(k,1760) - lu(k,1068) * lu(k,1722) + lu(k,1819) = lu(k,1819) - lu(k,1060) * lu(k,1815) + lu(k,1821) = lu(k,1821) - lu(k,1061) * lu(k,1815) + lu(k,1833) = lu(k,1833) - lu(k,1062) * lu(k,1815) + lu(k,1838) = lu(k,1838) - lu(k,1063) * lu(k,1815) + lu(k,1840) = lu(k,1840) - lu(k,1064) * lu(k,1815) + lu(k,1843) = lu(k,1843) - lu(k,1065) * lu(k,1815) + lu(k,1846) = lu(k,1846) - lu(k,1066) * lu(k,1815) + lu(k,1851) = lu(k,1851) - lu(k,1067) * lu(k,1815) + lu(k,1852) = lu(k,1852) - lu(k,1068) * lu(k,1815) + lu(k,1926) = lu(k,1926) - lu(k,1060) * lu(k,1923) + lu(k,1928) = lu(k,1928) - lu(k,1061) * lu(k,1923) + lu(k,1939) = lu(k,1939) - lu(k,1062) * lu(k,1923) + lu(k,1945) = lu(k,1945) - lu(k,1063) * lu(k,1923) + lu(k,1947) = lu(k,1947) - lu(k,1064) * lu(k,1923) + lu(k,1950) = lu(k,1950) - lu(k,1065) * lu(k,1923) + lu(k,1953) = lu(k,1953) - lu(k,1066) * lu(k,1923) + lu(k,1958) = lu(k,1958) - lu(k,1067) * lu(k,1923) + lu(k,1959) = lu(k,1959) - lu(k,1068) * lu(k,1923) + lu(k,2045) = lu(k,2045) - lu(k,1060) * lu(k,2041) + lu(k,2047) = lu(k,2047) - lu(k,1061) * lu(k,2041) + lu(k,2058) = lu(k,2058) - lu(k,1062) * lu(k,2041) + lu(k,2062) = lu(k,2062) - lu(k,1063) * lu(k,2041) + lu(k,2064) = lu(k,2064) - lu(k,1064) * lu(k,2041) + lu(k,2067) = lu(k,2067) - lu(k,1065) * lu(k,2041) + lu(k,2070) = lu(k,2070) - lu(k,1066) * lu(k,2041) + lu(k,2075) = lu(k,2075) - lu(k,1067) * lu(k,2041) + lu(k,2076) = lu(k,2076) - lu(k,1068) * lu(k,2041) + lu(k,2105) = lu(k,2105) - lu(k,1060) * lu(k,2102) + lu(k,2107) = lu(k,2107) - lu(k,1061) * lu(k,2102) + lu(k,2118) = lu(k,2118) - lu(k,1062) * lu(k,2102) + lu(k,2123) = lu(k,2123) - lu(k,1063) * lu(k,2102) + lu(k,2125) = lu(k,2125) - lu(k,1064) * lu(k,2102) + lu(k,2128) = lu(k,2128) - lu(k,1065) * lu(k,2102) + lu(k,2131) = lu(k,2131) - lu(k,1066) * lu(k,2102) + lu(k,2136) = lu(k,2136) - lu(k,1067) * lu(k,2102) + lu(k,2137) = lu(k,2137) - lu(k,1068) * lu(k,2102) + lu(k,1073) = 1._r8 / lu(k,1073) + lu(k,1074) = lu(k,1074) * lu(k,1073) + lu(k,1075) = lu(k,1075) * lu(k,1073) + lu(k,1076) = lu(k,1076) * lu(k,1073) + lu(k,1077) = lu(k,1077) * lu(k,1073) + lu(k,1078) = lu(k,1078) * lu(k,1073) + lu(k,1079) = lu(k,1079) * lu(k,1073) + lu(k,1080) = lu(k,1080) * lu(k,1073) + lu(k,1081) = lu(k,1081) * lu(k,1073) + lu(k,1082) = lu(k,1082) * lu(k,1073) + lu(k,1083) = lu(k,1083) * lu(k,1073) + lu(k,1084) = lu(k,1084) * lu(k,1073) + lu(k,1191) = - lu(k,1074) * lu(k,1189) + lu(k,1195) = lu(k,1195) - lu(k,1075) * lu(k,1189) + lu(k,1197) = lu(k,1197) - lu(k,1076) * lu(k,1189) + lu(k,1198) = lu(k,1198) - lu(k,1077) * lu(k,1189) + lu(k,1199) = lu(k,1199) - lu(k,1078) * lu(k,1189) + lu(k,1200) = lu(k,1200) - lu(k,1079) * lu(k,1189) + lu(k,1202) = lu(k,1202) - lu(k,1080) * lu(k,1189) + lu(k,1203) = lu(k,1203) - lu(k,1081) * lu(k,1189) + lu(k,1204) = lu(k,1204) - lu(k,1082) * lu(k,1189) + lu(k,1205) = lu(k,1205) - lu(k,1083) * lu(k,1189) + lu(k,1206) = - lu(k,1084) * lu(k,1189) + lu(k,1375) = lu(k,1375) - lu(k,1074) * lu(k,1373) + lu(k,1380) = lu(k,1380) - lu(k,1075) * lu(k,1373) + lu(k,1386) = lu(k,1386) - lu(k,1076) * lu(k,1373) + lu(k,1388) = - lu(k,1077) * lu(k,1373) + lu(k,1389) = lu(k,1389) - lu(k,1078) * lu(k,1373) + lu(k,1390) = lu(k,1390) - lu(k,1079) * lu(k,1373) + lu(k,1392) = lu(k,1392) - lu(k,1080) * lu(k,1373) + lu(k,1393) = lu(k,1393) - lu(k,1081) * lu(k,1373) + lu(k,1394) = lu(k,1394) - lu(k,1082) * lu(k,1373) + lu(k,1396) = lu(k,1396) - lu(k,1083) * lu(k,1373) + lu(k,1397) = lu(k,1397) - lu(k,1084) * lu(k,1373) + lu(k,1668) = lu(k,1668) - lu(k,1074) * lu(k,1665) + lu(k,1676) = lu(k,1676) - lu(k,1075) * lu(k,1665) + lu(k,1683) = lu(k,1683) - lu(k,1076) * lu(k,1665) + lu(k,1687) = lu(k,1687) - lu(k,1077) * lu(k,1665) + lu(k,1689) = lu(k,1689) - lu(k,1078) * lu(k,1665) + lu(k,1691) = lu(k,1691) - lu(k,1079) * lu(k,1665) + lu(k,1693) = lu(k,1693) - lu(k,1080) * lu(k,1665) + lu(k,1694) = lu(k,1694) - lu(k,1081) * lu(k,1665) + lu(k,1697) = lu(k,1697) - lu(k,1082) * lu(k,1665) + lu(k,1700) = lu(k,1700) - lu(k,1083) * lu(k,1665) + lu(k,1702) = lu(k,1702) - lu(k,1084) * lu(k,1665) + lu(k,1726) = lu(k,1726) - lu(k,1074) * lu(k,1723) + lu(k,1734) = lu(k,1734) - lu(k,1075) * lu(k,1723) + lu(k,1741) = lu(k,1741) - lu(k,1076) * lu(k,1723) + lu(k,1744) = lu(k,1744) - lu(k,1077) * lu(k,1723) + lu(k,1746) = lu(k,1746) - lu(k,1078) * lu(k,1723) + lu(k,1748) = lu(k,1748) - lu(k,1079) * lu(k,1723) + lu(k,1750) = lu(k,1750) - lu(k,1080) * lu(k,1723) + lu(k,1751) = lu(k,1751) - lu(k,1081) * lu(k,1723) + lu(k,1754) = lu(k,1754) - lu(k,1082) * lu(k,1723) + lu(k,1757) = lu(k,1757) - lu(k,1083) * lu(k,1723) + lu(k,1759) = lu(k,1759) - lu(k,1084) * lu(k,1723) + lu(k,1819) = lu(k,1819) - lu(k,1074) * lu(k,1816) + lu(k,1827) = lu(k,1827) - lu(k,1075) * lu(k,1816) + lu(k,1833) = lu(k,1833) - lu(k,1076) * lu(k,1816) + lu(k,1836) = lu(k,1836) - lu(k,1077) * lu(k,1816) + lu(k,1838) = lu(k,1838) - lu(k,1078) * lu(k,1816) + lu(k,1840) = lu(k,1840) - lu(k,1079) * lu(k,1816) + lu(k,1842) = lu(k,1842) - lu(k,1080) * lu(k,1816) + lu(k,1843) = lu(k,1843) - lu(k,1081) * lu(k,1816) + lu(k,1846) = lu(k,1846) - lu(k,1082) * lu(k,1816) + lu(k,1849) = lu(k,1849) - lu(k,1083) * lu(k,1816) + lu(k,1851) = lu(k,1851) - lu(k,1084) * lu(k,1816) + lu(k,2045) = lu(k,2045) - lu(k,1074) * lu(k,2042) + lu(k,2052) = lu(k,2052) - lu(k,1075) * lu(k,2042) + lu(k,2058) = lu(k,2058) - lu(k,1076) * lu(k,2042) + lu(k,2060) = lu(k,2060) - lu(k,1077) * lu(k,2042) + lu(k,2062) = lu(k,2062) - lu(k,1078) * lu(k,2042) + lu(k,2064) = lu(k,2064) - lu(k,1079) * lu(k,2042) + lu(k,2066) = lu(k,2066) - lu(k,1080) * lu(k,2042) + lu(k,2067) = lu(k,2067) - lu(k,1081) * lu(k,2042) + lu(k,2070) = lu(k,2070) - lu(k,1082) * lu(k,2042) + lu(k,2073) = lu(k,2073) - lu(k,1083) * lu(k,2042) + lu(k,2075) = lu(k,2075) - lu(k,1084) * lu(k,2042) end do end subroutine lu_fac22 subroutine lu_fac23( avec_len, lu ) @@ -4827,354 +4118,484 @@ subroutine lu_fac23( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1111) = 1._r8 / lu(k,1111) - lu(k,1112) = lu(k,1112) * lu(k,1111) - lu(k,1113) = lu(k,1113) * lu(k,1111) - lu(k,1114) = lu(k,1114) * lu(k,1111) - lu(k,1115) = lu(k,1115) * lu(k,1111) - lu(k,1116) = lu(k,1116) * lu(k,1111) - lu(k,1117) = lu(k,1117) * lu(k,1111) - lu(k,1118) = lu(k,1118) * lu(k,1111) - lu(k,1119) = lu(k,1119) * lu(k,1111) - lu(k,1120) = lu(k,1120) * lu(k,1111) - lu(k,1121) = lu(k,1121) * lu(k,1111) - lu(k,1122) = lu(k,1122) * lu(k,1111) - lu(k,1123) = lu(k,1123) * lu(k,1111) - lu(k,1324) = lu(k,1324) - lu(k,1112) * lu(k,1323) - lu(k,1326) = - lu(k,1113) * lu(k,1323) - lu(k,1327) = lu(k,1327) - lu(k,1114) * lu(k,1323) - lu(k,1329) = lu(k,1329) - lu(k,1115) * lu(k,1323) - lu(k,1330) = lu(k,1330) - lu(k,1116) * lu(k,1323) - lu(k,1331) = lu(k,1331) - lu(k,1117) * lu(k,1323) - lu(k,1333) = lu(k,1333) - lu(k,1118) * lu(k,1323) - lu(k,1335) = lu(k,1335) - lu(k,1119) * lu(k,1323) - lu(k,1336) = lu(k,1336) - lu(k,1120) * lu(k,1323) - lu(k,1338) = lu(k,1338) - lu(k,1121) * lu(k,1323) - lu(k,1340) = - lu(k,1122) * lu(k,1323) - lu(k,1341) = lu(k,1341) - lu(k,1123) * lu(k,1323) - lu(k,1502) = lu(k,1502) - lu(k,1112) * lu(k,1495) - lu(k,1504) = lu(k,1504) - lu(k,1113) * lu(k,1495) - lu(k,1505) = lu(k,1505) - lu(k,1114) * lu(k,1495) - lu(k,1507) = lu(k,1507) - lu(k,1115) * lu(k,1495) - lu(k,1508) = lu(k,1508) - lu(k,1116) * lu(k,1495) - lu(k,1509) = lu(k,1509) - lu(k,1117) * lu(k,1495) - lu(k,1511) = lu(k,1511) - lu(k,1118) * lu(k,1495) - lu(k,1513) = lu(k,1513) - lu(k,1119) * lu(k,1495) - lu(k,1514) = lu(k,1514) - lu(k,1120) * lu(k,1495) - lu(k,1516) = lu(k,1516) - lu(k,1121) * lu(k,1495) - lu(k,1518) = lu(k,1518) - lu(k,1122) * lu(k,1495) - lu(k,1519) = lu(k,1519) - lu(k,1123) * lu(k,1495) - lu(k,1543) = lu(k,1543) - lu(k,1112) * lu(k,1540) - lu(k,1545) = lu(k,1545) - lu(k,1113) * lu(k,1540) - lu(k,1546) = lu(k,1546) - lu(k,1114) * lu(k,1540) - lu(k,1548) = lu(k,1548) - lu(k,1115) * lu(k,1540) - lu(k,1549) = lu(k,1549) - lu(k,1116) * lu(k,1540) - lu(k,1550) = lu(k,1550) - lu(k,1117) * lu(k,1540) - lu(k,1552) = lu(k,1552) - lu(k,1118) * lu(k,1540) - lu(k,1554) = lu(k,1554) - lu(k,1119) * lu(k,1540) - lu(k,1555) = lu(k,1555) - lu(k,1120) * lu(k,1540) - lu(k,1557) = lu(k,1557) - lu(k,1121) * lu(k,1540) - lu(k,1559) = lu(k,1559) - lu(k,1122) * lu(k,1540) - lu(k,1560) = lu(k,1560) - lu(k,1123) * lu(k,1540) - lu(k,1707) = lu(k,1707) - lu(k,1112) * lu(k,1706) - lu(k,1709) = - lu(k,1113) * lu(k,1706) - lu(k,1710) = lu(k,1710) - lu(k,1114) * lu(k,1706) - lu(k,1712) = lu(k,1712) - lu(k,1115) * lu(k,1706) - lu(k,1713) = lu(k,1713) - lu(k,1116) * lu(k,1706) - lu(k,1714) = lu(k,1714) - lu(k,1117) * lu(k,1706) - lu(k,1716) = lu(k,1716) - lu(k,1118) * lu(k,1706) - lu(k,1718) = lu(k,1718) - lu(k,1119) * lu(k,1706) - lu(k,1719) = lu(k,1719) - lu(k,1120) * lu(k,1706) - lu(k,1721) = lu(k,1721) - lu(k,1121) * lu(k,1706) - lu(k,1723) = - lu(k,1122) * lu(k,1706) - lu(k,1724) = lu(k,1724) - lu(k,1123) * lu(k,1706) - lu(k,1864) = lu(k,1864) - lu(k,1112) * lu(k,1863) - lu(k,1866) = lu(k,1866) - lu(k,1113) * lu(k,1863) - lu(k,1867) = lu(k,1867) - lu(k,1114) * lu(k,1863) - lu(k,1869) = lu(k,1869) - lu(k,1115) * lu(k,1863) - lu(k,1870) = lu(k,1870) - lu(k,1116) * lu(k,1863) - lu(k,1871) = lu(k,1871) - lu(k,1117) * lu(k,1863) - lu(k,1873) = lu(k,1873) - lu(k,1118) * lu(k,1863) - lu(k,1875) = lu(k,1875) - lu(k,1119) * lu(k,1863) - lu(k,1876) = lu(k,1876) - lu(k,1120) * lu(k,1863) - lu(k,1878) = lu(k,1878) - lu(k,1121) * lu(k,1863) - lu(k,1880) = lu(k,1880) - lu(k,1122) * lu(k,1863) - lu(k,1881) = lu(k,1881) - lu(k,1123) * lu(k,1863) - lu(k,1978) = - lu(k,1112) * lu(k,1971) - lu(k,1980) = lu(k,1980) - lu(k,1113) * lu(k,1971) - lu(k,1981) = - lu(k,1114) * lu(k,1971) - lu(k,1983) = lu(k,1983) - lu(k,1115) * lu(k,1971) - lu(k,1984) = lu(k,1984) - lu(k,1116) * lu(k,1971) - lu(k,1985) = lu(k,1985) - lu(k,1117) * lu(k,1971) - lu(k,1987) = - lu(k,1118) * lu(k,1971) - lu(k,1989) = lu(k,1989) - lu(k,1119) * lu(k,1971) - lu(k,1990) = lu(k,1990) - lu(k,1120) * lu(k,1971) - lu(k,1992) = - lu(k,1121) * lu(k,1971) - lu(k,1994) = lu(k,1994) - lu(k,1122) * lu(k,1971) - lu(k,1995) = lu(k,1995) - lu(k,1123) * lu(k,1971) - lu(k,2038) = lu(k,2038) - lu(k,1112) * lu(k,2031) - lu(k,2040) = lu(k,2040) - lu(k,1113) * lu(k,2031) - lu(k,2041) = lu(k,2041) - lu(k,1114) * lu(k,2031) - lu(k,2043) = lu(k,2043) - lu(k,1115) * lu(k,2031) - lu(k,2044) = lu(k,2044) - lu(k,1116) * lu(k,2031) - lu(k,2045) = lu(k,2045) - lu(k,1117) * lu(k,2031) - lu(k,2047) = lu(k,2047) - lu(k,1118) * lu(k,2031) - lu(k,2049) = lu(k,2049) - lu(k,1119) * lu(k,2031) - lu(k,2050) = lu(k,2050) - lu(k,1120) * lu(k,2031) - lu(k,2052) = lu(k,2052) - lu(k,1121) * lu(k,2031) - lu(k,2054) = lu(k,2054) - lu(k,1122) * lu(k,2031) - lu(k,2055) = lu(k,2055) - lu(k,1123) * lu(k,2031) - lu(k,2063) = - lu(k,1112) * lu(k,2062) - lu(k,2065) = lu(k,2065) - lu(k,1113) * lu(k,2062) - lu(k,2066) = - lu(k,1114) * lu(k,2062) - lu(k,2068) = lu(k,2068) - lu(k,1115) * lu(k,2062) - lu(k,2069) = - lu(k,1116) * lu(k,2062) - lu(k,2070) = - lu(k,1117) * lu(k,2062) - lu(k,2072) = - lu(k,1118) * lu(k,2062) - lu(k,2074) = lu(k,2074) - lu(k,1119) * lu(k,2062) - lu(k,2075) = lu(k,2075) - lu(k,1120) * lu(k,2062) - lu(k,2077) = lu(k,2077) - lu(k,1121) * lu(k,2062) - lu(k,2079) = - lu(k,1122) * lu(k,2062) - lu(k,2080) = lu(k,2080) - lu(k,1123) * lu(k,2062) - lu(k,1142) = 1._r8 / lu(k,1142) - lu(k,1143) = lu(k,1143) * lu(k,1142) - lu(k,1144) = lu(k,1144) * lu(k,1142) - lu(k,1145) = lu(k,1145) * lu(k,1142) - lu(k,1146) = lu(k,1146) * lu(k,1142) - lu(k,1147) = lu(k,1147) * lu(k,1142) - lu(k,1148) = lu(k,1148) * lu(k,1142) - lu(k,1149) = lu(k,1149) * lu(k,1142) - lu(k,1150) = lu(k,1150) * lu(k,1142) - lu(k,1151) = lu(k,1151) * lu(k,1142) - lu(k,1152) = lu(k,1152) * lu(k,1142) - lu(k,1153) = lu(k,1153) * lu(k,1142) - lu(k,1154) = lu(k,1154) * lu(k,1142) - lu(k,1155) = lu(k,1155) * lu(k,1142) - lu(k,1156) = lu(k,1156) * lu(k,1142) - lu(k,1157) = lu(k,1157) * lu(k,1142) - lu(k,1260) = lu(k,1260) - lu(k,1143) * lu(k,1259) - lu(k,1261) = lu(k,1261) - lu(k,1144) * lu(k,1259) - lu(k,1263) = lu(k,1263) - lu(k,1145) * lu(k,1259) - lu(k,1264) = lu(k,1264) - lu(k,1146) * lu(k,1259) - lu(k,1265) = lu(k,1265) - lu(k,1147) * lu(k,1259) - lu(k,1266) = lu(k,1266) - lu(k,1148) * lu(k,1259) - lu(k,1267) = lu(k,1267) - lu(k,1149) * lu(k,1259) - lu(k,1268) = lu(k,1268) - lu(k,1150) * lu(k,1259) - lu(k,1269) = lu(k,1269) - lu(k,1151) * lu(k,1259) - lu(k,1270) = lu(k,1270) - lu(k,1152) * lu(k,1259) - lu(k,1271) = lu(k,1271) - lu(k,1153) * lu(k,1259) - lu(k,1272) = lu(k,1272) - lu(k,1154) * lu(k,1259) - lu(k,1273) = lu(k,1273) - lu(k,1155) * lu(k,1259) - lu(k,1274) = lu(k,1274) - lu(k,1156) * lu(k,1259) - lu(k,1275) = lu(k,1275) - lu(k,1157) * lu(k,1259) - lu(k,1497) = lu(k,1497) - lu(k,1143) * lu(k,1496) - lu(k,1498) = lu(k,1498) - lu(k,1144) * lu(k,1496) - lu(k,1500) = lu(k,1500) - lu(k,1145) * lu(k,1496) - lu(k,1501) = lu(k,1501) - lu(k,1146) * lu(k,1496) - lu(k,1503) = lu(k,1503) - lu(k,1147) * lu(k,1496) - lu(k,1504) = lu(k,1504) - lu(k,1148) * lu(k,1496) - lu(k,1507) = lu(k,1507) - lu(k,1149) * lu(k,1496) - lu(k,1508) = lu(k,1508) - lu(k,1150) * lu(k,1496) - lu(k,1509) = lu(k,1509) - lu(k,1151) * lu(k,1496) - lu(k,1510) = lu(k,1510) - lu(k,1152) * lu(k,1496) - lu(k,1512) = lu(k,1512) - lu(k,1153) * lu(k,1496) - lu(k,1513) = lu(k,1513) - lu(k,1154) * lu(k,1496) - lu(k,1517) = lu(k,1517) - lu(k,1155) * lu(k,1496) - lu(k,1518) = lu(k,1518) - lu(k,1156) * lu(k,1496) - lu(k,1519) = lu(k,1519) - lu(k,1157) * lu(k,1496) - lu(k,1628) = lu(k,1628) - lu(k,1143) * lu(k,1627) - lu(k,1629) = lu(k,1629) - lu(k,1144) * lu(k,1627) - lu(k,1631) = lu(k,1631) - lu(k,1145) * lu(k,1627) - lu(k,1632) = lu(k,1632) - lu(k,1146) * lu(k,1627) - lu(k,1634) = lu(k,1634) - lu(k,1147) * lu(k,1627) - lu(k,1635) = lu(k,1635) - lu(k,1148) * lu(k,1627) - lu(k,1638) = lu(k,1638) - lu(k,1149) * lu(k,1627) - lu(k,1639) = lu(k,1639) - lu(k,1150) * lu(k,1627) - lu(k,1640) = lu(k,1640) - lu(k,1151) * lu(k,1627) - lu(k,1641) = lu(k,1641) - lu(k,1152) * lu(k,1627) - lu(k,1643) = lu(k,1643) - lu(k,1153) * lu(k,1627) - lu(k,1644) = lu(k,1644) - lu(k,1154) * lu(k,1627) - lu(k,1648) = lu(k,1648) - lu(k,1155) * lu(k,1627) - lu(k,1649) = lu(k,1649) - lu(k,1156) * lu(k,1627) - lu(k,1650) = lu(k,1650) - lu(k,1157) * lu(k,1627) - lu(k,1679) = lu(k,1679) - lu(k,1143) * lu(k,1678) - lu(k,1680) = lu(k,1680) - lu(k,1144) * lu(k,1678) - lu(k,1682) = lu(k,1682) - lu(k,1145) * lu(k,1678) - lu(k,1683) = lu(k,1683) - lu(k,1146) * lu(k,1678) - lu(k,1684) = lu(k,1684) - lu(k,1147) * lu(k,1678) - lu(k,1685) = lu(k,1685) - lu(k,1148) * lu(k,1678) - lu(k,1688) = lu(k,1688) - lu(k,1149) * lu(k,1678) - lu(k,1689) = lu(k,1689) - lu(k,1150) * lu(k,1678) - lu(k,1690) = lu(k,1690) - lu(k,1151) * lu(k,1678) - lu(k,1691) = lu(k,1691) - lu(k,1152) * lu(k,1678) - lu(k,1693) = lu(k,1693) - lu(k,1153) * lu(k,1678) - lu(k,1694) = lu(k,1694) - lu(k,1154) * lu(k,1678) - lu(k,1698) = lu(k,1698) - lu(k,1155) * lu(k,1678) - lu(k,1699) = lu(k,1699) - lu(k,1156) * lu(k,1678) - lu(k,1700) = lu(k,1700) - lu(k,1157) * lu(k,1678) - lu(k,1829) = lu(k,1829) - lu(k,1143) * lu(k,1828) - lu(k,1830) = lu(k,1830) - lu(k,1144) * lu(k,1828) - lu(k,1832) = lu(k,1832) - lu(k,1145) * lu(k,1828) - lu(k,1833) = lu(k,1833) - lu(k,1146) * lu(k,1828) - lu(k,1835) = lu(k,1835) - lu(k,1147) * lu(k,1828) - lu(k,1836) = lu(k,1836) - lu(k,1148) * lu(k,1828) - lu(k,1839) = lu(k,1839) - lu(k,1149) * lu(k,1828) - lu(k,1840) = lu(k,1840) - lu(k,1150) * lu(k,1828) - lu(k,1841) = lu(k,1841) - lu(k,1151) * lu(k,1828) - lu(k,1842) = lu(k,1842) - lu(k,1152) * lu(k,1828) - lu(k,1844) = lu(k,1844) - lu(k,1153) * lu(k,1828) - lu(k,1845) = lu(k,1845) - lu(k,1154) * lu(k,1828) - lu(k,1849) = lu(k,1849) - lu(k,1155) * lu(k,1828) - lu(k,1850) = lu(k,1850) - lu(k,1156) * lu(k,1828) - lu(k,1851) = lu(k,1851) - lu(k,1157) * lu(k,1828) - lu(k,1973) = lu(k,1973) - lu(k,1143) * lu(k,1972) - lu(k,1974) = lu(k,1974) - lu(k,1144) * lu(k,1972) - lu(k,1976) = lu(k,1976) - lu(k,1145) * lu(k,1972) - lu(k,1977) = lu(k,1977) - lu(k,1146) * lu(k,1972) - lu(k,1979) = lu(k,1979) - lu(k,1147) * lu(k,1972) - lu(k,1980) = lu(k,1980) - lu(k,1148) * lu(k,1972) - lu(k,1983) = lu(k,1983) - lu(k,1149) * lu(k,1972) - lu(k,1984) = lu(k,1984) - lu(k,1150) * lu(k,1972) - lu(k,1985) = lu(k,1985) - lu(k,1151) * lu(k,1972) - lu(k,1986) = lu(k,1986) - lu(k,1152) * lu(k,1972) - lu(k,1988) = lu(k,1988) - lu(k,1153) * lu(k,1972) - lu(k,1989) = lu(k,1989) - lu(k,1154) * lu(k,1972) - lu(k,1993) = lu(k,1993) - lu(k,1155) * lu(k,1972) - lu(k,1994) = lu(k,1994) - lu(k,1156) * lu(k,1972) - lu(k,1995) = lu(k,1995) - lu(k,1157) * lu(k,1972) - lu(k,2033) = lu(k,2033) - lu(k,1143) * lu(k,2032) - lu(k,2034) = lu(k,2034) - lu(k,1144) * lu(k,2032) - lu(k,2036) = lu(k,2036) - lu(k,1145) * lu(k,2032) - lu(k,2037) = lu(k,2037) - lu(k,1146) * lu(k,2032) - lu(k,2039) = lu(k,2039) - lu(k,1147) * lu(k,2032) - lu(k,2040) = lu(k,2040) - lu(k,1148) * lu(k,2032) - lu(k,2043) = lu(k,2043) - lu(k,1149) * lu(k,2032) - lu(k,2044) = lu(k,2044) - lu(k,1150) * lu(k,2032) - lu(k,2045) = lu(k,2045) - lu(k,1151) * lu(k,2032) - lu(k,2046) = lu(k,2046) - lu(k,1152) * lu(k,2032) - lu(k,2048) = lu(k,2048) - lu(k,1153) * lu(k,2032) - lu(k,2049) = lu(k,2049) - lu(k,1154) * lu(k,2032) - lu(k,2053) = lu(k,2053) - lu(k,1155) * lu(k,2032) - lu(k,2054) = lu(k,2054) - lu(k,1156) * lu(k,2032) - lu(k,2055) = lu(k,2055) - lu(k,1157) * lu(k,2032) - lu(k,1164) = 1._r8 / lu(k,1164) - lu(k,1165) = lu(k,1165) * lu(k,1164) - lu(k,1166) = lu(k,1166) * lu(k,1164) - lu(k,1167) = lu(k,1167) * lu(k,1164) - lu(k,1168) = lu(k,1168) * lu(k,1164) - lu(k,1169) = lu(k,1169) * lu(k,1164) - lu(k,1170) = lu(k,1170) * lu(k,1164) - lu(k,1171) = lu(k,1171) * lu(k,1164) - lu(k,1172) = lu(k,1172) * lu(k,1164) - lu(k,1173) = lu(k,1173) * lu(k,1164) - lu(k,1174) = lu(k,1174) * lu(k,1164) - lu(k,1175) = lu(k,1175) * lu(k,1164) - lu(k,1176) = lu(k,1176) * lu(k,1164) - lu(k,1177) = lu(k,1177) * lu(k,1164) - lu(k,1213) = lu(k,1213) - lu(k,1165) * lu(k,1212) - lu(k,1216) = lu(k,1216) - lu(k,1166) * lu(k,1212) - lu(k,1217) = lu(k,1217) - lu(k,1167) * lu(k,1212) - lu(k,1218) = lu(k,1218) - lu(k,1168) * lu(k,1212) - lu(k,1219) = lu(k,1219) - lu(k,1169) * lu(k,1212) - lu(k,1220) = lu(k,1220) - lu(k,1170) * lu(k,1212) - lu(k,1221) = lu(k,1221) - lu(k,1171) * lu(k,1212) - lu(k,1222) = lu(k,1222) - lu(k,1172) * lu(k,1212) - lu(k,1223) = lu(k,1223) - lu(k,1173) * lu(k,1212) - lu(k,1224) = lu(k,1224) - lu(k,1174) * lu(k,1212) - lu(k,1225) = lu(k,1225) - lu(k,1175) * lu(k,1212) - lu(k,1226) = lu(k,1226) - lu(k,1176) * lu(k,1212) - lu(k,1227) = lu(k,1227) - lu(k,1177) * lu(k,1212) - lu(k,1261) = lu(k,1261) - lu(k,1165) * lu(k,1260) - lu(k,1264) = lu(k,1264) - lu(k,1166) * lu(k,1260) - lu(k,1265) = lu(k,1265) - lu(k,1167) * lu(k,1260) - lu(k,1266) = lu(k,1266) - lu(k,1168) * lu(k,1260) - lu(k,1267) = lu(k,1267) - lu(k,1169) * lu(k,1260) - lu(k,1268) = lu(k,1268) - lu(k,1170) * lu(k,1260) - lu(k,1269) = lu(k,1269) - lu(k,1171) * lu(k,1260) - lu(k,1270) = lu(k,1270) - lu(k,1172) * lu(k,1260) - lu(k,1271) = lu(k,1271) - lu(k,1173) * lu(k,1260) - lu(k,1272) = lu(k,1272) - lu(k,1174) * lu(k,1260) - lu(k,1273) = lu(k,1273) - lu(k,1175) * lu(k,1260) - lu(k,1274) = lu(k,1274) - lu(k,1176) * lu(k,1260) - lu(k,1275) = lu(k,1275) - lu(k,1177) * lu(k,1260) - lu(k,1498) = lu(k,1498) - lu(k,1165) * lu(k,1497) - lu(k,1501) = lu(k,1501) - lu(k,1166) * lu(k,1497) - lu(k,1503) = lu(k,1503) - lu(k,1167) * lu(k,1497) - lu(k,1504) = lu(k,1504) - lu(k,1168) * lu(k,1497) - lu(k,1507) = lu(k,1507) - lu(k,1169) * lu(k,1497) - lu(k,1508) = lu(k,1508) - lu(k,1170) * lu(k,1497) - lu(k,1509) = lu(k,1509) - lu(k,1171) * lu(k,1497) - lu(k,1510) = lu(k,1510) - lu(k,1172) * lu(k,1497) - lu(k,1512) = lu(k,1512) - lu(k,1173) * lu(k,1497) - lu(k,1513) = lu(k,1513) - lu(k,1174) * lu(k,1497) - lu(k,1517) = lu(k,1517) - lu(k,1175) * lu(k,1497) - lu(k,1518) = lu(k,1518) - lu(k,1176) * lu(k,1497) - lu(k,1519) = lu(k,1519) - lu(k,1177) * lu(k,1497) - lu(k,1629) = lu(k,1629) - lu(k,1165) * lu(k,1628) - lu(k,1632) = lu(k,1632) - lu(k,1166) * lu(k,1628) - lu(k,1634) = lu(k,1634) - lu(k,1167) * lu(k,1628) - lu(k,1635) = lu(k,1635) - lu(k,1168) * lu(k,1628) - lu(k,1638) = lu(k,1638) - lu(k,1169) * lu(k,1628) - lu(k,1639) = lu(k,1639) - lu(k,1170) * lu(k,1628) - lu(k,1640) = lu(k,1640) - lu(k,1171) * lu(k,1628) - lu(k,1641) = lu(k,1641) - lu(k,1172) * lu(k,1628) - lu(k,1643) = lu(k,1643) - lu(k,1173) * lu(k,1628) - lu(k,1644) = lu(k,1644) - lu(k,1174) * lu(k,1628) - lu(k,1648) = lu(k,1648) - lu(k,1175) * lu(k,1628) - lu(k,1649) = lu(k,1649) - lu(k,1176) * lu(k,1628) - lu(k,1650) = lu(k,1650) - lu(k,1177) * lu(k,1628) - lu(k,1680) = lu(k,1680) - lu(k,1165) * lu(k,1679) - lu(k,1683) = lu(k,1683) - lu(k,1166) * lu(k,1679) - lu(k,1684) = lu(k,1684) - lu(k,1167) * lu(k,1679) - lu(k,1685) = lu(k,1685) - lu(k,1168) * lu(k,1679) - lu(k,1688) = lu(k,1688) - lu(k,1169) * lu(k,1679) - lu(k,1689) = lu(k,1689) - lu(k,1170) * lu(k,1679) - lu(k,1690) = lu(k,1690) - lu(k,1171) * lu(k,1679) - lu(k,1691) = lu(k,1691) - lu(k,1172) * lu(k,1679) - lu(k,1693) = lu(k,1693) - lu(k,1173) * lu(k,1679) - lu(k,1694) = lu(k,1694) - lu(k,1174) * lu(k,1679) - lu(k,1698) = lu(k,1698) - lu(k,1175) * lu(k,1679) - lu(k,1699) = lu(k,1699) - lu(k,1176) * lu(k,1679) - lu(k,1700) = lu(k,1700) - lu(k,1177) * lu(k,1679) - lu(k,1830) = lu(k,1830) - lu(k,1165) * lu(k,1829) - lu(k,1833) = lu(k,1833) - lu(k,1166) * lu(k,1829) - lu(k,1835) = lu(k,1835) - lu(k,1167) * lu(k,1829) - lu(k,1836) = lu(k,1836) - lu(k,1168) * lu(k,1829) - lu(k,1839) = lu(k,1839) - lu(k,1169) * lu(k,1829) - lu(k,1840) = lu(k,1840) - lu(k,1170) * lu(k,1829) - lu(k,1841) = lu(k,1841) - lu(k,1171) * lu(k,1829) - lu(k,1842) = lu(k,1842) - lu(k,1172) * lu(k,1829) - lu(k,1844) = lu(k,1844) - lu(k,1173) * lu(k,1829) - lu(k,1845) = lu(k,1845) - lu(k,1174) * lu(k,1829) - lu(k,1849) = lu(k,1849) - lu(k,1175) * lu(k,1829) - lu(k,1850) = lu(k,1850) - lu(k,1176) * lu(k,1829) - lu(k,1851) = lu(k,1851) - lu(k,1177) * lu(k,1829) - lu(k,1974) = lu(k,1974) - lu(k,1165) * lu(k,1973) - lu(k,1977) = lu(k,1977) - lu(k,1166) * lu(k,1973) - lu(k,1979) = lu(k,1979) - lu(k,1167) * lu(k,1973) - lu(k,1980) = lu(k,1980) - lu(k,1168) * lu(k,1973) - lu(k,1983) = lu(k,1983) - lu(k,1169) * lu(k,1973) - lu(k,1984) = lu(k,1984) - lu(k,1170) * lu(k,1973) - lu(k,1985) = lu(k,1985) - lu(k,1171) * lu(k,1973) - lu(k,1986) = lu(k,1986) - lu(k,1172) * lu(k,1973) - lu(k,1988) = lu(k,1988) - lu(k,1173) * lu(k,1973) - lu(k,1989) = lu(k,1989) - lu(k,1174) * lu(k,1973) - lu(k,1993) = lu(k,1993) - lu(k,1175) * lu(k,1973) - lu(k,1994) = lu(k,1994) - lu(k,1176) * lu(k,1973) - lu(k,1995) = lu(k,1995) - lu(k,1177) * lu(k,1973) - lu(k,2034) = lu(k,2034) - lu(k,1165) * lu(k,2033) - lu(k,2037) = lu(k,2037) - lu(k,1166) * lu(k,2033) - lu(k,2039) = lu(k,2039) - lu(k,1167) * lu(k,2033) - lu(k,2040) = lu(k,2040) - lu(k,1168) * lu(k,2033) - lu(k,2043) = lu(k,2043) - lu(k,1169) * lu(k,2033) - lu(k,2044) = lu(k,2044) - lu(k,1170) * lu(k,2033) - lu(k,2045) = lu(k,2045) - lu(k,1171) * lu(k,2033) - lu(k,2046) = lu(k,2046) - lu(k,1172) * lu(k,2033) - lu(k,2048) = lu(k,2048) - lu(k,1173) * lu(k,2033) - lu(k,2049) = lu(k,2049) - lu(k,1174) * lu(k,2033) - lu(k,2053) = lu(k,2053) - lu(k,1175) * lu(k,2033) - lu(k,2054) = lu(k,2054) - lu(k,1176) * lu(k,2033) - lu(k,2055) = lu(k,2055) - lu(k,1177) * lu(k,2033) + lu(k,1085) = 1._r8 / lu(k,1085) + lu(k,1086) = lu(k,1086) * lu(k,1085) + lu(k,1087) = lu(k,1087) * lu(k,1085) + lu(k,1088) = lu(k,1088) * lu(k,1085) + lu(k,1089) = lu(k,1089) * lu(k,1085) + lu(k,1090) = lu(k,1090) * lu(k,1085) + lu(k,1091) = lu(k,1091) * lu(k,1085) + lu(k,1092) = lu(k,1092) * lu(k,1085) + lu(k,1093) = lu(k,1093) * lu(k,1085) + lu(k,1150) = lu(k,1150) - lu(k,1086) * lu(k,1148) + lu(k,1155) = lu(k,1155) - lu(k,1087) * lu(k,1148) + lu(k,1156) = lu(k,1156) - lu(k,1088) * lu(k,1148) + lu(k,1158) = lu(k,1158) - lu(k,1089) * lu(k,1148) + lu(k,1159) = - lu(k,1090) * lu(k,1148) + lu(k,1161) = lu(k,1161) - lu(k,1091) * lu(k,1148) + lu(k,1162) = lu(k,1162) - lu(k,1092) * lu(k,1148) + lu(k,1165) = lu(k,1165) - lu(k,1093) * lu(k,1148) + lu(k,1328) = lu(k,1328) - lu(k,1086) * lu(k,1327) + lu(k,1334) = lu(k,1334) - lu(k,1087) * lu(k,1327) + lu(k,1336) = - lu(k,1088) * lu(k,1327) + lu(k,1338) = lu(k,1338) - lu(k,1089) * lu(k,1327) + lu(k,1339) = lu(k,1339) - lu(k,1090) * lu(k,1327) + lu(k,1341) = lu(k,1341) - lu(k,1091) * lu(k,1327) + lu(k,1342) = lu(k,1342) - lu(k,1092) * lu(k,1327) + lu(k,1346) = lu(k,1346) - lu(k,1093) * lu(k,1327) + lu(k,1668) = lu(k,1668) - lu(k,1086) * lu(k,1666) + lu(k,1683) = lu(k,1683) - lu(k,1087) * lu(k,1666) + lu(k,1687) = lu(k,1687) - lu(k,1088) * lu(k,1666) + lu(k,1691) = lu(k,1691) - lu(k,1089) * lu(k,1666) + lu(k,1692) = lu(k,1692) - lu(k,1090) * lu(k,1666) + lu(k,1694) = lu(k,1694) - lu(k,1091) * lu(k,1666) + lu(k,1697) = lu(k,1697) - lu(k,1092) * lu(k,1666) + lu(k,1703) = lu(k,1703) - lu(k,1093) * lu(k,1666) + lu(k,1726) = lu(k,1726) - lu(k,1086) * lu(k,1724) + lu(k,1741) = lu(k,1741) - lu(k,1087) * lu(k,1724) + lu(k,1744) = lu(k,1744) - lu(k,1088) * lu(k,1724) + lu(k,1748) = lu(k,1748) - lu(k,1089) * lu(k,1724) + lu(k,1749) = lu(k,1749) - lu(k,1090) * lu(k,1724) + lu(k,1751) = lu(k,1751) - lu(k,1091) * lu(k,1724) + lu(k,1754) = lu(k,1754) - lu(k,1092) * lu(k,1724) + lu(k,1760) = lu(k,1760) - lu(k,1093) * lu(k,1724) + lu(k,1819) = lu(k,1819) - lu(k,1086) * lu(k,1817) + lu(k,1833) = lu(k,1833) - lu(k,1087) * lu(k,1817) + lu(k,1836) = lu(k,1836) - lu(k,1088) * lu(k,1817) + lu(k,1840) = lu(k,1840) - lu(k,1089) * lu(k,1817) + lu(k,1841) = lu(k,1841) - lu(k,1090) * lu(k,1817) + lu(k,1843) = lu(k,1843) - lu(k,1091) * lu(k,1817) + lu(k,1846) = lu(k,1846) - lu(k,1092) * lu(k,1817) + lu(k,1852) = lu(k,1852) - lu(k,1093) * lu(k,1817) + lu(k,1926) = lu(k,1926) - lu(k,1086) * lu(k,1924) + lu(k,1939) = lu(k,1939) - lu(k,1087) * lu(k,1924) + lu(k,1943) = lu(k,1943) - lu(k,1088) * lu(k,1924) + lu(k,1947) = lu(k,1947) - lu(k,1089) * lu(k,1924) + lu(k,1948) = lu(k,1948) - lu(k,1090) * lu(k,1924) + lu(k,1950) = lu(k,1950) - lu(k,1091) * lu(k,1924) + lu(k,1953) = lu(k,1953) - lu(k,1092) * lu(k,1924) + lu(k,1959) = lu(k,1959) - lu(k,1093) * lu(k,1924) + lu(k,2003) = lu(k,2003) - lu(k,1086) * lu(k,2001) + lu(k,2004) = - lu(k,1087) * lu(k,2001) + lu(k,2008) = lu(k,2008) - lu(k,1088) * lu(k,2001) + lu(k,2012) = lu(k,2012) - lu(k,1089) * lu(k,2001) + lu(k,2013) = lu(k,2013) - lu(k,1090) * lu(k,2001) + lu(k,2015) = lu(k,2015) - lu(k,1091) * lu(k,2001) + lu(k,2018) = lu(k,2018) - lu(k,1092) * lu(k,2001) + lu(k,2024) = lu(k,2024) - lu(k,1093) * lu(k,2001) + lu(k,2045) = lu(k,2045) - lu(k,1086) * lu(k,2043) + lu(k,2058) = lu(k,2058) - lu(k,1087) * lu(k,2043) + lu(k,2060) = lu(k,2060) - lu(k,1088) * lu(k,2043) + lu(k,2064) = lu(k,2064) - lu(k,1089) * lu(k,2043) + lu(k,2065) = lu(k,2065) - lu(k,1090) * lu(k,2043) + lu(k,2067) = lu(k,2067) - lu(k,1091) * lu(k,2043) + lu(k,2070) = lu(k,2070) - lu(k,1092) * lu(k,2043) + lu(k,2076) = lu(k,2076) - lu(k,1093) * lu(k,2043) + lu(k,2105) = lu(k,2105) - lu(k,1086) * lu(k,2103) + lu(k,2118) = lu(k,2118) - lu(k,1087) * lu(k,2103) + lu(k,2121) = lu(k,2121) - lu(k,1088) * lu(k,2103) + lu(k,2125) = lu(k,2125) - lu(k,1089) * lu(k,2103) + lu(k,2126) = lu(k,2126) - lu(k,1090) * lu(k,2103) + lu(k,2128) = lu(k,2128) - lu(k,1091) * lu(k,2103) + lu(k,2131) = lu(k,2131) - lu(k,1092) * lu(k,2103) + lu(k,2137) = lu(k,2137) - lu(k,1093) * lu(k,2103) + lu(k,1096) = 1._r8 / lu(k,1096) + lu(k,1097) = lu(k,1097) * lu(k,1096) + lu(k,1098) = lu(k,1098) * lu(k,1096) + lu(k,1099) = lu(k,1099) * lu(k,1096) + lu(k,1100) = lu(k,1100) * lu(k,1096) + lu(k,1101) = lu(k,1101) * lu(k,1096) + lu(k,1114) = lu(k,1114) - lu(k,1097) * lu(k,1113) + lu(k,1119) = lu(k,1119) - lu(k,1098) * lu(k,1113) + lu(k,1120) = lu(k,1120) - lu(k,1099) * lu(k,1113) + lu(k,1122) = lu(k,1122) - lu(k,1100) * lu(k,1113) + lu(k,1125) = lu(k,1125) - lu(k,1101) * lu(k,1113) + lu(k,1150) = lu(k,1150) - lu(k,1097) * lu(k,1149) + lu(k,1157) = lu(k,1157) - lu(k,1098) * lu(k,1149) + lu(k,1158) = lu(k,1158) - lu(k,1099) * lu(k,1149) + lu(k,1161) = lu(k,1161) - lu(k,1100) * lu(k,1149) + lu(k,1164) = - lu(k,1101) * lu(k,1149) + lu(k,1171) = lu(k,1171) - lu(k,1097) * lu(k,1170) + lu(k,1176) = lu(k,1176) - lu(k,1098) * lu(k,1170) + lu(k,1177) = lu(k,1177) - lu(k,1099) * lu(k,1170) + lu(k,1180) = lu(k,1180) - lu(k,1100) * lu(k,1170) + lu(k,1183) = lu(k,1183) - lu(k,1101) * lu(k,1170) + lu(k,1191) = lu(k,1191) - lu(k,1097) * lu(k,1190) + lu(k,1199) = lu(k,1199) - lu(k,1098) * lu(k,1190) + lu(k,1200) = lu(k,1200) - lu(k,1099) * lu(k,1190) + lu(k,1203) = lu(k,1203) - lu(k,1100) * lu(k,1190) + lu(k,1206) = lu(k,1206) - lu(k,1101) * lu(k,1190) + lu(k,1250) = lu(k,1250) - lu(k,1097) * lu(k,1249) + lu(k,1262) = lu(k,1262) - lu(k,1098) * lu(k,1249) + lu(k,1263) = lu(k,1263) - lu(k,1099) * lu(k,1249) + lu(k,1266) = lu(k,1266) - lu(k,1100) * lu(k,1249) + lu(k,1270) = lu(k,1270) - lu(k,1101) * lu(k,1249) + lu(k,1282) = lu(k,1282) - lu(k,1097) * lu(k,1281) + lu(k,1294) = lu(k,1294) - lu(k,1098) * lu(k,1281) + lu(k,1295) = lu(k,1295) - lu(k,1099) * lu(k,1281) + lu(k,1298) = lu(k,1298) - lu(k,1100) * lu(k,1281) + lu(k,1302) = lu(k,1302) - lu(k,1101) * lu(k,1281) + lu(k,1307) = lu(k,1307) - lu(k,1097) * lu(k,1306) + lu(k,1315) = lu(k,1315) - lu(k,1098) * lu(k,1306) + lu(k,1316) = lu(k,1316) - lu(k,1099) * lu(k,1306) + lu(k,1319) = lu(k,1319) - lu(k,1100) * lu(k,1306) + lu(k,1322) = - lu(k,1101) * lu(k,1306) + lu(k,1375) = lu(k,1375) - lu(k,1097) * lu(k,1374) + lu(k,1389) = lu(k,1389) - lu(k,1098) * lu(k,1374) + lu(k,1390) = lu(k,1390) - lu(k,1099) * lu(k,1374) + lu(k,1393) = lu(k,1393) - lu(k,1100) * lu(k,1374) + lu(k,1397) = lu(k,1397) - lu(k,1101) * lu(k,1374) + lu(k,1668) = lu(k,1668) - lu(k,1097) * lu(k,1667) + lu(k,1689) = lu(k,1689) - lu(k,1098) * lu(k,1667) + lu(k,1691) = lu(k,1691) - lu(k,1099) * lu(k,1667) + lu(k,1694) = lu(k,1694) - lu(k,1100) * lu(k,1667) + lu(k,1702) = lu(k,1702) - lu(k,1101) * lu(k,1667) + lu(k,1726) = lu(k,1726) - lu(k,1097) * lu(k,1725) + lu(k,1746) = lu(k,1746) - lu(k,1098) * lu(k,1725) + lu(k,1748) = lu(k,1748) - lu(k,1099) * lu(k,1725) + lu(k,1751) = lu(k,1751) - lu(k,1100) * lu(k,1725) + lu(k,1759) = lu(k,1759) - lu(k,1101) * lu(k,1725) + lu(k,1819) = lu(k,1819) - lu(k,1097) * lu(k,1818) + lu(k,1838) = lu(k,1838) - lu(k,1098) * lu(k,1818) + lu(k,1840) = lu(k,1840) - lu(k,1099) * lu(k,1818) + lu(k,1843) = lu(k,1843) - lu(k,1100) * lu(k,1818) + lu(k,1851) = lu(k,1851) - lu(k,1101) * lu(k,1818) + lu(k,1926) = lu(k,1926) - lu(k,1097) * lu(k,1925) + lu(k,1945) = lu(k,1945) - lu(k,1098) * lu(k,1925) + lu(k,1947) = lu(k,1947) - lu(k,1099) * lu(k,1925) + lu(k,1950) = lu(k,1950) - lu(k,1100) * lu(k,1925) + lu(k,1958) = lu(k,1958) - lu(k,1101) * lu(k,1925) + lu(k,2003) = lu(k,2003) - lu(k,1097) * lu(k,2002) + lu(k,2010) = lu(k,2010) - lu(k,1098) * lu(k,2002) + lu(k,2012) = lu(k,2012) - lu(k,1099) * lu(k,2002) + lu(k,2015) = lu(k,2015) - lu(k,1100) * lu(k,2002) + lu(k,2023) = lu(k,2023) - lu(k,1101) * lu(k,2002) + lu(k,2045) = lu(k,2045) - lu(k,1097) * lu(k,2044) + lu(k,2062) = lu(k,2062) - lu(k,1098) * lu(k,2044) + lu(k,2064) = lu(k,2064) - lu(k,1099) * lu(k,2044) + lu(k,2067) = lu(k,2067) - lu(k,1100) * lu(k,2044) + lu(k,2075) = lu(k,2075) - lu(k,1101) * lu(k,2044) + lu(k,2105) = lu(k,2105) - lu(k,1097) * lu(k,2104) + lu(k,2123) = lu(k,2123) - lu(k,1098) * lu(k,2104) + lu(k,2125) = lu(k,2125) - lu(k,1099) * lu(k,2104) + lu(k,2128) = lu(k,2128) - lu(k,1100) * lu(k,2104) + lu(k,2136) = lu(k,2136) - lu(k,1101) * lu(k,2104) + lu(k,1103) = 1._r8 / lu(k,1103) + lu(k,1104) = lu(k,1104) * lu(k,1103) + lu(k,1105) = lu(k,1105) * lu(k,1103) + lu(k,1106) = lu(k,1106) * lu(k,1103) + lu(k,1120) = lu(k,1120) - lu(k,1104) * lu(k,1114) + lu(k,1122) = lu(k,1122) - lu(k,1105) * lu(k,1114) + lu(k,1125) = lu(k,1125) - lu(k,1106) * lu(k,1114) + lu(k,1158) = lu(k,1158) - lu(k,1104) * lu(k,1150) + lu(k,1161) = lu(k,1161) - lu(k,1105) * lu(k,1150) + lu(k,1164) = lu(k,1164) - lu(k,1106) * lu(k,1150) + lu(k,1177) = lu(k,1177) - lu(k,1104) * lu(k,1171) + lu(k,1180) = lu(k,1180) - lu(k,1105) * lu(k,1171) + lu(k,1183) = lu(k,1183) - lu(k,1106) * lu(k,1171) + lu(k,1200) = lu(k,1200) - lu(k,1104) * lu(k,1191) + lu(k,1203) = lu(k,1203) - lu(k,1105) * lu(k,1191) + lu(k,1206) = lu(k,1206) - lu(k,1106) * lu(k,1191) + lu(k,1215) = lu(k,1215) - lu(k,1104) * lu(k,1208) + lu(k,1216) = lu(k,1216) - lu(k,1105) * lu(k,1208) + lu(k,1218) = lu(k,1218) - lu(k,1106) * lu(k,1208) + lu(k,1224) = lu(k,1224) - lu(k,1104) * lu(k,1220) + lu(k,1226) = lu(k,1226) - lu(k,1105) * lu(k,1220) + lu(k,1227) = - lu(k,1106) * lu(k,1220) + lu(k,1263) = lu(k,1263) - lu(k,1104) * lu(k,1250) + lu(k,1266) = lu(k,1266) - lu(k,1105) * lu(k,1250) + lu(k,1270) = lu(k,1270) - lu(k,1106) * lu(k,1250) + lu(k,1295) = lu(k,1295) - lu(k,1104) * lu(k,1282) + lu(k,1298) = lu(k,1298) - lu(k,1105) * lu(k,1282) + lu(k,1302) = lu(k,1302) - lu(k,1106) * lu(k,1282) + lu(k,1316) = lu(k,1316) - lu(k,1104) * lu(k,1307) + lu(k,1319) = lu(k,1319) - lu(k,1105) * lu(k,1307) + lu(k,1322) = lu(k,1322) - lu(k,1106) * lu(k,1307) + lu(k,1338) = lu(k,1338) - lu(k,1104) * lu(k,1328) + lu(k,1341) = lu(k,1341) - lu(k,1105) * lu(k,1328) + lu(k,1345) = lu(k,1345) - lu(k,1106) * lu(k,1328) + lu(k,1358) = lu(k,1358) - lu(k,1104) * lu(k,1351) + lu(k,1361) = lu(k,1361) - lu(k,1105) * lu(k,1351) + lu(k,1365) = lu(k,1365) - lu(k,1106) * lu(k,1351) + lu(k,1390) = lu(k,1390) - lu(k,1104) * lu(k,1375) + lu(k,1393) = lu(k,1393) - lu(k,1105) * lu(k,1375) + lu(k,1397) = lu(k,1397) - lu(k,1106) * lu(k,1375) + lu(k,1419) = lu(k,1419) - lu(k,1104) * lu(k,1414) + lu(k,1420) = lu(k,1420) - lu(k,1105) * lu(k,1414) + lu(k,1423) = lu(k,1423) - lu(k,1106) * lu(k,1414) + lu(k,1435) = lu(k,1435) - lu(k,1104) * lu(k,1428) + lu(k,1437) = lu(k,1437) - lu(k,1105) * lu(k,1428) + lu(k,1441) = lu(k,1441) - lu(k,1106) * lu(k,1428) + lu(k,1487) = lu(k,1487) - lu(k,1104) * lu(k,1479) + lu(k,1490) = lu(k,1490) - lu(k,1105) * lu(k,1479) + lu(k,1497) = lu(k,1497) - lu(k,1106) * lu(k,1479) + lu(k,1691) = lu(k,1691) - lu(k,1104) * lu(k,1668) + lu(k,1694) = lu(k,1694) - lu(k,1105) * lu(k,1668) + lu(k,1702) = lu(k,1702) - lu(k,1106) * lu(k,1668) + lu(k,1748) = lu(k,1748) - lu(k,1104) * lu(k,1726) + lu(k,1751) = lu(k,1751) - lu(k,1105) * lu(k,1726) + lu(k,1759) = lu(k,1759) - lu(k,1106) * lu(k,1726) + lu(k,1840) = lu(k,1840) - lu(k,1104) * lu(k,1819) + lu(k,1843) = lu(k,1843) - lu(k,1105) * lu(k,1819) + lu(k,1851) = lu(k,1851) - lu(k,1106) * lu(k,1819) + lu(k,1947) = lu(k,1947) - lu(k,1104) * lu(k,1926) + lu(k,1950) = lu(k,1950) - lu(k,1105) * lu(k,1926) + lu(k,1958) = lu(k,1958) - lu(k,1106) * lu(k,1926) + lu(k,2012) = lu(k,2012) - lu(k,1104) * lu(k,2003) + lu(k,2015) = lu(k,2015) - lu(k,1105) * lu(k,2003) + lu(k,2023) = lu(k,2023) - lu(k,1106) * lu(k,2003) + lu(k,2064) = lu(k,2064) - lu(k,1104) * lu(k,2045) + lu(k,2067) = lu(k,2067) - lu(k,1105) * lu(k,2045) + lu(k,2075) = lu(k,2075) - lu(k,1106) * lu(k,2045) + lu(k,2125) = lu(k,2125) - lu(k,1104) * lu(k,2105) + lu(k,2128) = lu(k,2128) - lu(k,1105) * lu(k,2105) + lu(k,2136) = lu(k,2136) - lu(k,1106) * lu(k,2105) + lu(k,2192) = lu(k,2192) - lu(k,1104) * lu(k,2180) + lu(k,2195) = lu(k,2195) - lu(k,1105) * lu(k,2180) + lu(k,2203) = lu(k,2203) - lu(k,1106) * lu(k,2180) + lu(k,2247) = lu(k,2247) - lu(k,1104) * lu(k,2238) + lu(k,2250) = lu(k,2250) - lu(k,1105) * lu(k,2238) + lu(k,2258) = lu(k,2258) - lu(k,1106) * lu(k,2238) + lu(k,1115) = 1._r8 / lu(k,1115) + lu(k,1116) = lu(k,1116) * lu(k,1115) + lu(k,1117) = lu(k,1117) * lu(k,1115) + lu(k,1118) = lu(k,1118) * lu(k,1115) + lu(k,1119) = lu(k,1119) * lu(k,1115) + lu(k,1120) = lu(k,1120) * lu(k,1115) + lu(k,1121) = lu(k,1121) * lu(k,1115) + lu(k,1122) = lu(k,1122) * lu(k,1115) + lu(k,1123) = lu(k,1123) * lu(k,1115) + lu(k,1124) = lu(k,1124) * lu(k,1115) + lu(k,1125) = lu(k,1125) * lu(k,1115) + lu(k,1126) = lu(k,1126) * lu(k,1115) + lu(k,1670) = lu(k,1670) - lu(k,1116) * lu(k,1669) + lu(k,1683) = lu(k,1683) - lu(k,1117) * lu(k,1669) + lu(k,1687) = lu(k,1687) - lu(k,1118) * lu(k,1669) + lu(k,1689) = lu(k,1689) - lu(k,1119) * lu(k,1669) + lu(k,1691) = lu(k,1691) - lu(k,1120) * lu(k,1669) + lu(k,1693) = lu(k,1693) - lu(k,1121) * lu(k,1669) + lu(k,1694) = lu(k,1694) - lu(k,1122) * lu(k,1669) + lu(k,1697) = lu(k,1697) - lu(k,1123) * lu(k,1669) + lu(k,1700) = lu(k,1700) - lu(k,1124) * lu(k,1669) + lu(k,1702) = lu(k,1702) - lu(k,1125) * lu(k,1669) + lu(k,1703) = lu(k,1703) - lu(k,1126) * lu(k,1669) + lu(k,1728) = lu(k,1728) - lu(k,1116) * lu(k,1727) + lu(k,1741) = lu(k,1741) - lu(k,1117) * lu(k,1727) + lu(k,1744) = lu(k,1744) - lu(k,1118) * lu(k,1727) + lu(k,1746) = lu(k,1746) - lu(k,1119) * lu(k,1727) + lu(k,1748) = lu(k,1748) - lu(k,1120) * lu(k,1727) + lu(k,1750) = lu(k,1750) - lu(k,1121) * lu(k,1727) + lu(k,1751) = lu(k,1751) - lu(k,1122) * lu(k,1727) + lu(k,1754) = lu(k,1754) - lu(k,1123) * lu(k,1727) + lu(k,1757) = lu(k,1757) - lu(k,1124) * lu(k,1727) + lu(k,1759) = lu(k,1759) - lu(k,1125) * lu(k,1727) + lu(k,1760) = lu(k,1760) - lu(k,1126) * lu(k,1727) + lu(k,1821) = lu(k,1821) - lu(k,1116) * lu(k,1820) + lu(k,1833) = lu(k,1833) - lu(k,1117) * lu(k,1820) + lu(k,1836) = lu(k,1836) - lu(k,1118) * lu(k,1820) + lu(k,1838) = lu(k,1838) - lu(k,1119) * lu(k,1820) + lu(k,1840) = lu(k,1840) - lu(k,1120) * lu(k,1820) + lu(k,1842) = lu(k,1842) - lu(k,1121) * lu(k,1820) + lu(k,1843) = lu(k,1843) - lu(k,1122) * lu(k,1820) + lu(k,1846) = lu(k,1846) - lu(k,1123) * lu(k,1820) + lu(k,1849) = lu(k,1849) - lu(k,1124) * lu(k,1820) + lu(k,1851) = lu(k,1851) - lu(k,1125) * lu(k,1820) + lu(k,1852) = lu(k,1852) - lu(k,1126) * lu(k,1820) + lu(k,1928) = lu(k,1928) - lu(k,1116) * lu(k,1927) + lu(k,1939) = lu(k,1939) - lu(k,1117) * lu(k,1927) + lu(k,1943) = lu(k,1943) - lu(k,1118) * lu(k,1927) + lu(k,1945) = lu(k,1945) - lu(k,1119) * lu(k,1927) + lu(k,1947) = lu(k,1947) - lu(k,1120) * lu(k,1927) + lu(k,1949) = lu(k,1949) - lu(k,1121) * lu(k,1927) + lu(k,1950) = lu(k,1950) - lu(k,1122) * lu(k,1927) + lu(k,1953) = lu(k,1953) - lu(k,1123) * lu(k,1927) + lu(k,1956) = lu(k,1956) - lu(k,1124) * lu(k,1927) + lu(k,1958) = lu(k,1958) - lu(k,1125) * lu(k,1927) + lu(k,1959) = lu(k,1959) - lu(k,1126) * lu(k,1927) + lu(k,2047) = lu(k,2047) - lu(k,1116) * lu(k,2046) + lu(k,2058) = lu(k,2058) - lu(k,1117) * lu(k,2046) + lu(k,2060) = lu(k,2060) - lu(k,1118) * lu(k,2046) + lu(k,2062) = lu(k,2062) - lu(k,1119) * lu(k,2046) + lu(k,2064) = lu(k,2064) - lu(k,1120) * lu(k,2046) + lu(k,2066) = lu(k,2066) - lu(k,1121) * lu(k,2046) + lu(k,2067) = lu(k,2067) - lu(k,1122) * lu(k,2046) + lu(k,2070) = lu(k,2070) - lu(k,1123) * lu(k,2046) + lu(k,2073) = lu(k,2073) - lu(k,1124) * lu(k,2046) + lu(k,2075) = lu(k,2075) - lu(k,1125) * lu(k,2046) + lu(k,2076) = lu(k,2076) - lu(k,1126) * lu(k,2046) + lu(k,2107) = lu(k,2107) - lu(k,1116) * lu(k,2106) + lu(k,2118) = lu(k,2118) - lu(k,1117) * lu(k,2106) + lu(k,2121) = lu(k,2121) - lu(k,1118) * lu(k,2106) + lu(k,2123) = lu(k,2123) - lu(k,1119) * lu(k,2106) + lu(k,2125) = lu(k,2125) - lu(k,1120) * lu(k,2106) + lu(k,2127) = lu(k,2127) - lu(k,1121) * lu(k,2106) + lu(k,2128) = lu(k,2128) - lu(k,1122) * lu(k,2106) + lu(k,2131) = lu(k,2131) - lu(k,1123) * lu(k,2106) + lu(k,2134) = lu(k,2134) - lu(k,1124) * lu(k,2106) + lu(k,2136) = lu(k,2136) - lu(k,1125) * lu(k,2106) + lu(k,2137) = lu(k,2137) - lu(k,1126) * lu(k,2106) + lu(k,1129) = 1._r8 / lu(k,1129) + lu(k,1130) = lu(k,1130) * lu(k,1129) + lu(k,1131) = lu(k,1131) * lu(k,1129) + lu(k,1132) = lu(k,1132) * lu(k,1129) + lu(k,1133) = lu(k,1133) * lu(k,1129) + lu(k,1134) = lu(k,1134) * lu(k,1129) + lu(k,1135) = lu(k,1135) * lu(k,1129) + lu(k,1136) = lu(k,1136) * lu(k,1129) + lu(k,1137) = lu(k,1137) * lu(k,1129) + lu(k,1138) = lu(k,1138) * lu(k,1129) + lu(k,1139) = lu(k,1139) * lu(k,1129) + lu(k,1152) = lu(k,1152) - lu(k,1130) * lu(k,1151) + lu(k,1154) = - lu(k,1131) * lu(k,1151) + lu(k,1155) = lu(k,1155) - lu(k,1132) * lu(k,1151) + lu(k,1157) = lu(k,1157) - lu(k,1133) * lu(k,1151) + lu(k,1158) = lu(k,1158) - lu(k,1134) * lu(k,1151) + lu(k,1160) = - lu(k,1135) * lu(k,1151) + lu(k,1161) = lu(k,1161) - lu(k,1136) * lu(k,1151) + lu(k,1162) = lu(k,1162) - lu(k,1137) * lu(k,1151) + lu(k,1163) = lu(k,1163) - lu(k,1138) * lu(k,1151) + lu(k,1165) = lu(k,1165) - lu(k,1139) * lu(k,1151) + lu(k,1671) = lu(k,1671) - lu(k,1130) * lu(k,1670) + lu(k,1676) = lu(k,1676) - lu(k,1131) * lu(k,1670) + lu(k,1683) = lu(k,1683) - lu(k,1132) * lu(k,1670) + lu(k,1689) = lu(k,1689) - lu(k,1133) * lu(k,1670) + lu(k,1691) = lu(k,1691) - lu(k,1134) * lu(k,1670) + lu(k,1693) = lu(k,1693) - lu(k,1135) * lu(k,1670) + lu(k,1694) = lu(k,1694) - lu(k,1136) * lu(k,1670) + lu(k,1697) = lu(k,1697) - lu(k,1137) * lu(k,1670) + lu(k,1700) = lu(k,1700) - lu(k,1138) * lu(k,1670) + lu(k,1703) = lu(k,1703) - lu(k,1139) * lu(k,1670) + lu(k,1729) = lu(k,1729) - lu(k,1130) * lu(k,1728) + lu(k,1734) = lu(k,1734) - lu(k,1131) * lu(k,1728) + lu(k,1741) = lu(k,1741) - lu(k,1132) * lu(k,1728) + lu(k,1746) = lu(k,1746) - lu(k,1133) * lu(k,1728) + lu(k,1748) = lu(k,1748) - lu(k,1134) * lu(k,1728) + lu(k,1750) = lu(k,1750) - lu(k,1135) * lu(k,1728) + lu(k,1751) = lu(k,1751) - lu(k,1136) * lu(k,1728) + lu(k,1754) = lu(k,1754) - lu(k,1137) * lu(k,1728) + lu(k,1757) = lu(k,1757) - lu(k,1138) * lu(k,1728) + lu(k,1760) = lu(k,1760) - lu(k,1139) * lu(k,1728) + lu(k,1822) = lu(k,1822) - lu(k,1130) * lu(k,1821) + lu(k,1827) = lu(k,1827) - lu(k,1131) * lu(k,1821) + lu(k,1833) = lu(k,1833) - lu(k,1132) * lu(k,1821) + lu(k,1838) = lu(k,1838) - lu(k,1133) * lu(k,1821) + lu(k,1840) = lu(k,1840) - lu(k,1134) * lu(k,1821) + lu(k,1842) = lu(k,1842) - lu(k,1135) * lu(k,1821) + lu(k,1843) = lu(k,1843) - lu(k,1136) * lu(k,1821) + lu(k,1846) = lu(k,1846) - lu(k,1137) * lu(k,1821) + lu(k,1849) = lu(k,1849) - lu(k,1138) * lu(k,1821) + lu(k,1852) = lu(k,1852) - lu(k,1139) * lu(k,1821) + lu(k,1929) = lu(k,1929) - lu(k,1130) * lu(k,1928) + lu(k,1933) = lu(k,1933) - lu(k,1131) * lu(k,1928) + lu(k,1939) = lu(k,1939) - lu(k,1132) * lu(k,1928) + lu(k,1945) = lu(k,1945) - lu(k,1133) * lu(k,1928) + lu(k,1947) = lu(k,1947) - lu(k,1134) * lu(k,1928) + lu(k,1949) = lu(k,1949) - lu(k,1135) * lu(k,1928) + lu(k,1950) = lu(k,1950) - lu(k,1136) * lu(k,1928) + lu(k,1953) = lu(k,1953) - lu(k,1137) * lu(k,1928) + lu(k,1956) = lu(k,1956) - lu(k,1138) * lu(k,1928) + lu(k,1959) = lu(k,1959) - lu(k,1139) * lu(k,1928) + lu(k,2048) = lu(k,2048) - lu(k,1130) * lu(k,2047) + lu(k,2052) = lu(k,2052) - lu(k,1131) * lu(k,2047) + lu(k,2058) = lu(k,2058) - lu(k,1132) * lu(k,2047) + lu(k,2062) = lu(k,2062) - lu(k,1133) * lu(k,2047) + lu(k,2064) = lu(k,2064) - lu(k,1134) * lu(k,2047) + lu(k,2066) = lu(k,2066) - lu(k,1135) * lu(k,2047) + lu(k,2067) = lu(k,2067) - lu(k,1136) * lu(k,2047) + lu(k,2070) = lu(k,2070) - lu(k,1137) * lu(k,2047) + lu(k,2073) = lu(k,2073) - lu(k,1138) * lu(k,2047) + lu(k,2076) = lu(k,2076) - lu(k,1139) * lu(k,2047) + lu(k,2108) = lu(k,2108) - lu(k,1130) * lu(k,2107) + lu(k,2111) = lu(k,2111) - lu(k,1131) * lu(k,2107) + lu(k,2118) = lu(k,2118) - lu(k,1132) * lu(k,2107) + lu(k,2123) = lu(k,2123) - lu(k,1133) * lu(k,2107) + lu(k,2125) = lu(k,2125) - lu(k,1134) * lu(k,2107) + lu(k,2127) = lu(k,2127) - lu(k,1135) * lu(k,2107) + lu(k,2128) = lu(k,2128) - lu(k,1136) * lu(k,2107) + lu(k,2131) = lu(k,2131) - lu(k,1137) * lu(k,2107) + lu(k,2134) = lu(k,2134) - lu(k,1138) * lu(k,2107) + lu(k,2137) = lu(k,2137) - lu(k,1139) * lu(k,2107) + lu(k,1140) = 1._r8 / lu(k,1140) + lu(k,1141) = lu(k,1141) * lu(k,1140) + lu(k,1142) = lu(k,1142) * lu(k,1140) + lu(k,1143) = lu(k,1143) * lu(k,1140) + lu(k,1144) = lu(k,1144) * lu(k,1140) + lu(k,1145) = lu(k,1145) * lu(k,1140) + lu(k,1154) = lu(k,1154) - lu(k,1141) * lu(k,1152) + lu(k,1155) = lu(k,1155) - lu(k,1142) * lu(k,1152) + lu(k,1157) = lu(k,1157) - lu(k,1143) * lu(k,1152) + lu(k,1158) = lu(k,1158) - lu(k,1144) * lu(k,1152) + lu(k,1161) = lu(k,1161) - lu(k,1145) * lu(k,1152) + lu(k,1174) = lu(k,1174) - lu(k,1141) * lu(k,1172) + lu(k,1175) = lu(k,1175) - lu(k,1142) * lu(k,1172) + lu(k,1176) = lu(k,1176) - lu(k,1143) * lu(k,1172) + lu(k,1177) = lu(k,1177) - lu(k,1144) * lu(k,1172) + lu(k,1180) = lu(k,1180) - lu(k,1145) * lu(k,1172) + lu(k,1255) = - lu(k,1141) * lu(k,1251) + lu(k,1260) = lu(k,1260) - lu(k,1142) * lu(k,1251) + lu(k,1262) = lu(k,1262) - lu(k,1143) * lu(k,1251) + lu(k,1263) = lu(k,1263) - lu(k,1144) * lu(k,1251) + lu(k,1266) = lu(k,1266) - lu(k,1145) * lu(k,1251) + lu(k,1287) = lu(k,1287) - lu(k,1141) * lu(k,1283) + lu(k,1292) = lu(k,1292) - lu(k,1142) * lu(k,1283) + lu(k,1294) = lu(k,1294) - lu(k,1143) * lu(k,1283) + lu(k,1295) = lu(k,1295) - lu(k,1144) * lu(k,1283) + lu(k,1298) = lu(k,1298) - lu(k,1145) * lu(k,1283) + lu(k,1310) = lu(k,1310) - lu(k,1141) * lu(k,1308) + lu(k,1313) = lu(k,1313) - lu(k,1142) * lu(k,1308) + lu(k,1315) = lu(k,1315) - lu(k,1143) * lu(k,1308) + lu(k,1316) = lu(k,1316) - lu(k,1144) * lu(k,1308) + lu(k,1319) = lu(k,1319) - lu(k,1145) * lu(k,1308) + lu(k,1330) = lu(k,1330) - lu(k,1141) * lu(k,1329) + lu(k,1334) = lu(k,1334) - lu(k,1142) * lu(k,1329) + lu(k,1337) = lu(k,1337) - lu(k,1143) * lu(k,1329) + lu(k,1338) = lu(k,1338) - lu(k,1144) * lu(k,1329) + lu(k,1341) = lu(k,1341) - lu(k,1145) * lu(k,1329) + lu(k,1353) = - lu(k,1141) * lu(k,1352) + lu(k,1355) = lu(k,1355) - lu(k,1142) * lu(k,1352) + lu(k,1357) = lu(k,1357) - lu(k,1143) * lu(k,1352) + lu(k,1358) = lu(k,1358) - lu(k,1144) * lu(k,1352) + lu(k,1361) = lu(k,1361) - lu(k,1145) * lu(k,1352) + lu(k,1380) = lu(k,1380) - lu(k,1141) * lu(k,1376) + lu(k,1386) = lu(k,1386) - lu(k,1142) * lu(k,1376) + lu(k,1389) = lu(k,1389) - lu(k,1143) * lu(k,1376) + lu(k,1390) = lu(k,1390) - lu(k,1144) * lu(k,1376) + lu(k,1393) = lu(k,1393) - lu(k,1145) * lu(k,1376) + lu(k,1676) = lu(k,1676) - lu(k,1141) * lu(k,1671) + lu(k,1683) = lu(k,1683) - lu(k,1142) * lu(k,1671) + lu(k,1689) = lu(k,1689) - lu(k,1143) * lu(k,1671) + lu(k,1691) = lu(k,1691) - lu(k,1144) * lu(k,1671) + lu(k,1694) = lu(k,1694) - lu(k,1145) * lu(k,1671) + lu(k,1734) = lu(k,1734) - lu(k,1141) * lu(k,1729) + lu(k,1741) = lu(k,1741) - lu(k,1142) * lu(k,1729) + lu(k,1746) = lu(k,1746) - lu(k,1143) * lu(k,1729) + lu(k,1748) = lu(k,1748) - lu(k,1144) * lu(k,1729) + lu(k,1751) = lu(k,1751) - lu(k,1145) * lu(k,1729) + lu(k,1827) = lu(k,1827) - lu(k,1141) * lu(k,1822) + lu(k,1833) = lu(k,1833) - lu(k,1142) * lu(k,1822) + lu(k,1838) = lu(k,1838) - lu(k,1143) * lu(k,1822) + lu(k,1840) = lu(k,1840) - lu(k,1144) * lu(k,1822) + lu(k,1843) = lu(k,1843) - lu(k,1145) * lu(k,1822) + lu(k,1933) = lu(k,1933) - lu(k,1141) * lu(k,1929) + lu(k,1939) = lu(k,1939) - lu(k,1142) * lu(k,1929) + lu(k,1945) = lu(k,1945) - lu(k,1143) * lu(k,1929) + lu(k,1947) = lu(k,1947) - lu(k,1144) * lu(k,1929) + lu(k,1950) = lu(k,1950) - lu(k,1145) * lu(k,1929) + lu(k,2052) = lu(k,2052) - lu(k,1141) * lu(k,2048) + lu(k,2058) = lu(k,2058) - lu(k,1142) * lu(k,2048) + lu(k,2062) = lu(k,2062) - lu(k,1143) * lu(k,2048) + lu(k,2064) = lu(k,2064) - lu(k,1144) * lu(k,2048) + lu(k,2067) = lu(k,2067) - lu(k,1145) * lu(k,2048) + lu(k,2111) = lu(k,2111) - lu(k,1141) * lu(k,2108) + lu(k,2118) = lu(k,2118) - lu(k,1142) * lu(k,2108) + lu(k,2123) = lu(k,2123) - lu(k,1143) * lu(k,2108) + lu(k,2125) = lu(k,2125) - lu(k,1144) * lu(k,2108) + lu(k,2128) = lu(k,2128) - lu(k,1145) * lu(k,2108) + lu(k,2182) = lu(k,2182) - lu(k,1141) * lu(k,2181) + lu(k,2185) = lu(k,2185) - lu(k,1142) * lu(k,2181) + lu(k,2190) = lu(k,2190) - lu(k,1143) * lu(k,2181) + lu(k,2192) = lu(k,2192) - lu(k,1144) * lu(k,2181) + lu(k,2195) = lu(k,2195) - lu(k,1145) * lu(k,2181) end do end subroutine lu_fac23 subroutine lu_fac24( avec_len, lu ) @@ -5191,429 +4612,398 @@ subroutine lu_fac24( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1187) = 1._r8 / lu(k,1187) - lu(k,1188) = lu(k,1188) * lu(k,1187) - lu(k,1189) = lu(k,1189) * lu(k,1187) - lu(k,1190) = lu(k,1190) * lu(k,1187) - lu(k,1191) = lu(k,1191) * lu(k,1187) - lu(k,1192) = lu(k,1192) * lu(k,1187) - lu(k,1193) = lu(k,1193) * lu(k,1187) - lu(k,1194) = lu(k,1194) * lu(k,1187) - lu(k,1195) = lu(k,1195) * lu(k,1187) - lu(k,1196) = lu(k,1196) * lu(k,1187) - lu(k,1197) = lu(k,1197) * lu(k,1187) - lu(k,1198) = lu(k,1198) * lu(k,1187) - lu(k,1199) = lu(k,1199) * lu(k,1187) - lu(k,1215) = lu(k,1215) - lu(k,1188) * lu(k,1213) - lu(k,1216) = lu(k,1216) - lu(k,1189) * lu(k,1213) - lu(k,1217) = lu(k,1217) - lu(k,1190) * lu(k,1213) - lu(k,1218) = lu(k,1218) - lu(k,1191) * lu(k,1213) - lu(k,1219) = lu(k,1219) - lu(k,1192) * lu(k,1213) - lu(k,1220) = lu(k,1220) - lu(k,1193) * lu(k,1213) - lu(k,1221) = lu(k,1221) - lu(k,1194) * lu(k,1213) - lu(k,1222) = lu(k,1222) - lu(k,1195) * lu(k,1213) - lu(k,1223) = lu(k,1223) - lu(k,1196) * lu(k,1213) - lu(k,1224) = lu(k,1224) - lu(k,1197) * lu(k,1213) - lu(k,1225) = lu(k,1225) - lu(k,1198) * lu(k,1213) - lu(k,1227) = lu(k,1227) - lu(k,1199) * lu(k,1213) - lu(k,1263) = lu(k,1263) - lu(k,1188) * lu(k,1261) - lu(k,1264) = lu(k,1264) - lu(k,1189) * lu(k,1261) - lu(k,1265) = lu(k,1265) - lu(k,1190) * lu(k,1261) - lu(k,1266) = lu(k,1266) - lu(k,1191) * lu(k,1261) - lu(k,1267) = lu(k,1267) - lu(k,1192) * lu(k,1261) - lu(k,1268) = lu(k,1268) - lu(k,1193) * lu(k,1261) - lu(k,1269) = lu(k,1269) - lu(k,1194) * lu(k,1261) - lu(k,1270) = lu(k,1270) - lu(k,1195) * lu(k,1261) - lu(k,1271) = lu(k,1271) - lu(k,1196) * lu(k,1261) - lu(k,1272) = lu(k,1272) - lu(k,1197) * lu(k,1261) - lu(k,1273) = lu(k,1273) - lu(k,1198) * lu(k,1261) - lu(k,1275) = lu(k,1275) - lu(k,1199) * lu(k,1261) - lu(k,1500) = lu(k,1500) - lu(k,1188) * lu(k,1498) - lu(k,1501) = lu(k,1501) - lu(k,1189) * lu(k,1498) - lu(k,1503) = lu(k,1503) - lu(k,1190) * lu(k,1498) - lu(k,1504) = lu(k,1504) - lu(k,1191) * lu(k,1498) - lu(k,1507) = lu(k,1507) - lu(k,1192) * lu(k,1498) - lu(k,1508) = lu(k,1508) - lu(k,1193) * lu(k,1498) - lu(k,1509) = lu(k,1509) - lu(k,1194) * lu(k,1498) - lu(k,1510) = lu(k,1510) - lu(k,1195) * lu(k,1498) - lu(k,1512) = lu(k,1512) - lu(k,1196) * lu(k,1498) - lu(k,1513) = lu(k,1513) - lu(k,1197) * lu(k,1498) - lu(k,1517) = lu(k,1517) - lu(k,1198) * lu(k,1498) - lu(k,1519) = lu(k,1519) - lu(k,1199) * lu(k,1498) - lu(k,1631) = lu(k,1631) - lu(k,1188) * lu(k,1629) - lu(k,1632) = lu(k,1632) - lu(k,1189) * lu(k,1629) - lu(k,1634) = lu(k,1634) - lu(k,1190) * lu(k,1629) - lu(k,1635) = lu(k,1635) - lu(k,1191) * lu(k,1629) - lu(k,1638) = lu(k,1638) - lu(k,1192) * lu(k,1629) - lu(k,1639) = lu(k,1639) - lu(k,1193) * lu(k,1629) - lu(k,1640) = lu(k,1640) - lu(k,1194) * lu(k,1629) - lu(k,1641) = lu(k,1641) - lu(k,1195) * lu(k,1629) - lu(k,1643) = lu(k,1643) - lu(k,1196) * lu(k,1629) - lu(k,1644) = lu(k,1644) - lu(k,1197) * lu(k,1629) - lu(k,1648) = lu(k,1648) - lu(k,1198) * lu(k,1629) - lu(k,1650) = lu(k,1650) - lu(k,1199) * lu(k,1629) - lu(k,1682) = lu(k,1682) - lu(k,1188) * lu(k,1680) - lu(k,1683) = lu(k,1683) - lu(k,1189) * lu(k,1680) - lu(k,1684) = lu(k,1684) - lu(k,1190) * lu(k,1680) - lu(k,1685) = lu(k,1685) - lu(k,1191) * lu(k,1680) - lu(k,1688) = lu(k,1688) - lu(k,1192) * lu(k,1680) - lu(k,1689) = lu(k,1689) - lu(k,1193) * lu(k,1680) - lu(k,1690) = lu(k,1690) - lu(k,1194) * lu(k,1680) - lu(k,1691) = lu(k,1691) - lu(k,1195) * lu(k,1680) - lu(k,1693) = lu(k,1693) - lu(k,1196) * lu(k,1680) - lu(k,1694) = lu(k,1694) - lu(k,1197) * lu(k,1680) - lu(k,1698) = lu(k,1698) - lu(k,1198) * lu(k,1680) - lu(k,1700) = lu(k,1700) - lu(k,1199) * lu(k,1680) - lu(k,1832) = lu(k,1832) - lu(k,1188) * lu(k,1830) - lu(k,1833) = lu(k,1833) - lu(k,1189) * lu(k,1830) - lu(k,1835) = lu(k,1835) - lu(k,1190) * lu(k,1830) - lu(k,1836) = lu(k,1836) - lu(k,1191) * lu(k,1830) - lu(k,1839) = lu(k,1839) - lu(k,1192) * lu(k,1830) - lu(k,1840) = lu(k,1840) - lu(k,1193) * lu(k,1830) - lu(k,1841) = lu(k,1841) - lu(k,1194) * lu(k,1830) - lu(k,1842) = lu(k,1842) - lu(k,1195) * lu(k,1830) - lu(k,1844) = lu(k,1844) - lu(k,1196) * lu(k,1830) - lu(k,1845) = lu(k,1845) - lu(k,1197) * lu(k,1830) - lu(k,1849) = lu(k,1849) - lu(k,1198) * lu(k,1830) - lu(k,1851) = lu(k,1851) - lu(k,1199) * lu(k,1830) - lu(k,1976) = lu(k,1976) - lu(k,1188) * lu(k,1974) - lu(k,1977) = lu(k,1977) - lu(k,1189) * lu(k,1974) - lu(k,1979) = lu(k,1979) - lu(k,1190) * lu(k,1974) - lu(k,1980) = lu(k,1980) - lu(k,1191) * lu(k,1974) - lu(k,1983) = lu(k,1983) - lu(k,1192) * lu(k,1974) - lu(k,1984) = lu(k,1984) - lu(k,1193) * lu(k,1974) - lu(k,1985) = lu(k,1985) - lu(k,1194) * lu(k,1974) - lu(k,1986) = lu(k,1986) - lu(k,1195) * lu(k,1974) - lu(k,1988) = lu(k,1988) - lu(k,1196) * lu(k,1974) - lu(k,1989) = lu(k,1989) - lu(k,1197) * lu(k,1974) - lu(k,1993) = lu(k,1993) - lu(k,1198) * lu(k,1974) - lu(k,1995) = lu(k,1995) - lu(k,1199) * lu(k,1974) - lu(k,2036) = lu(k,2036) - lu(k,1188) * lu(k,2034) - lu(k,2037) = lu(k,2037) - lu(k,1189) * lu(k,2034) - lu(k,2039) = lu(k,2039) - lu(k,1190) * lu(k,2034) - lu(k,2040) = lu(k,2040) - lu(k,1191) * lu(k,2034) - lu(k,2043) = lu(k,2043) - lu(k,1192) * lu(k,2034) - lu(k,2044) = lu(k,2044) - lu(k,1193) * lu(k,2034) - lu(k,2045) = lu(k,2045) - lu(k,1194) * lu(k,2034) - lu(k,2046) = lu(k,2046) - lu(k,1195) * lu(k,2034) - lu(k,2048) = lu(k,2048) - lu(k,1196) * lu(k,2034) - lu(k,2049) = lu(k,2049) - lu(k,1197) * lu(k,2034) - lu(k,2053) = lu(k,2053) - lu(k,1198) * lu(k,2034) - lu(k,2055) = lu(k,2055) - lu(k,1199) * lu(k,2034) - lu(k,1214) = 1._r8 / lu(k,1214) - lu(k,1215) = lu(k,1215) * lu(k,1214) - lu(k,1216) = lu(k,1216) * lu(k,1214) - lu(k,1217) = lu(k,1217) * lu(k,1214) - lu(k,1218) = lu(k,1218) * lu(k,1214) - lu(k,1219) = lu(k,1219) * lu(k,1214) - lu(k,1220) = lu(k,1220) * lu(k,1214) - lu(k,1221) = lu(k,1221) * lu(k,1214) - lu(k,1222) = lu(k,1222) * lu(k,1214) - lu(k,1223) = lu(k,1223) * lu(k,1214) - lu(k,1224) = lu(k,1224) * lu(k,1214) - lu(k,1225) = lu(k,1225) * lu(k,1214) - lu(k,1226) = lu(k,1226) * lu(k,1214) - lu(k,1227) = lu(k,1227) * lu(k,1214) - lu(k,1263) = lu(k,1263) - lu(k,1215) * lu(k,1262) - lu(k,1264) = lu(k,1264) - lu(k,1216) * lu(k,1262) - lu(k,1265) = lu(k,1265) - lu(k,1217) * lu(k,1262) - lu(k,1266) = lu(k,1266) - lu(k,1218) * lu(k,1262) - lu(k,1267) = lu(k,1267) - lu(k,1219) * lu(k,1262) - lu(k,1268) = lu(k,1268) - lu(k,1220) * lu(k,1262) - lu(k,1269) = lu(k,1269) - lu(k,1221) * lu(k,1262) - lu(k,1270) = lu(k,1270) - lu(k,1222) * lu(k,1262) - lu(k,1271) = lu(k,1271) - lu(k,1223) * lu(k,1262) - lu(k,1272) = lu(k,1272) - lu(k,1224) * lu(k,1262) - lu(k,1273) = lu(k,1273) - lu(k,1225) * lu(k,1262) - lu(k,1274) = lu(k,1274) - lu(k,1226) * lu(k,1262) - lu(k,1275) = lu(k,1275) - lu(k,1227) * lu(k,1262) - lu(k,1500) = lu(k,1500) - lu(k,1215) * lu(k,1499) - lu(k,1501) = lu(k,1501) - lu(k,1216) * lu(k,1499) - lu(k,1503) = lu(k,1503) - lu(k,1217) * lu(k,1499) - lu(k,1504) = lu(k,1504) - lu(k,1218) * lu(k,1499) - lu(k,1507) = lu(k,1507) - lu(k,1219) * lu(k,1499) - lu(k,1508) = lu(k,1508) - lu(k,1220) * lu(k,1499) - lu(k,1509) = lu(k,1509) - lu(k,1221) * lu(k,1499) - lu(k,1510) = lu(k,1510) - lu(k,1222) * lu(k,1499) - lu(k,1512) = lu(k,1512) - lu(k,1223) * lu(k,1499) - lu(k,1513) = lu(k,1513) - lu(k,1224) * lu(k,1499) - lu(k,1517) = lu(k,1517) - lu(k,1225) * lu(k,1499) - lu(k,1518) = lu(k,1518) - lu(k,1226) * lu(k,1499) - lu(k,1519) = lu(k,1519) - lu(k,1227) * lu(k,1499) - lu(k,1631) = lu(k,1631) - lu(k,1215) * lu(k,1630) - lu(k,1632) = lu(k,1632) - lu(k,1216) * lu(k,1630) - lu(k,1634) = lu(k,1634) - lu(k,1217) * lu(k,1630) - lu(k,1635) = lu(k,1635) - lu(k,1218) * lu(k,1630) - lu(k,1638) = lu(k,1638) - lu(k,1219) * lu(k,1630) - lu(k,1639) = lu(k,1639) - lu(k,1220) * lu(k,1630) - lu(k,1640) = lu(k,1640) - lu(k,1221) * lu(k,1630) - lu(k,1641) = lu(k,1641) - lu(k,1222) * lu(k,1630) - lu(k,1643) = lu(k,1643) - lu(k,1223) * lu(k,1630) - lu(k,1644) = lu(k,1644) - lu(k,1224) * lu(k,1630) - lu(k,1648) = lu(k,1648) - lu(k,1225) * lu(k,1630) - lu(k,1649) = lu(k,1649) - lu(k,1226) * lu(k,1630) - lu(k,1650) = lu(k,1650) - lu(k,1227) * lu(k,1630) - lu(k,1682) = lu(k,1682) - lu(k,1215) * lu(k,1681) - lu(k,1683) = lu(k,1683) - lu(k,1216) * lu(k,1681) - lu(k,1684) = lu(k,1684) - lu(k,1217) * lu(k,1681) - lu(k,1685) = lu(k,1685) - lu(k,1218) * lu(k,1681) - lu(k,1688) = lu(k,1688) - lu(k,1219) * lu(k,1681) - lu(k,1689) = lu(k,1689) - lu(k,1220) * lu(k,1681) - lu(k,1690) = lu(k,1690) - lu(k,1221) * lu(k,1681) - lu(k,1691) = lu(k,1691) - lu(k,1222) * lu(k,1681) - lu(k,1693) = lu(k,1693) - lu(k,1223) * lu(k,1681) - lu(k,1694) = lu(k,1694) - lu(k,1224) * lu(k,1681) - lu(k,1698) = lu(k,1698) - lu(k,1225) * lu(k,1681) - lu(k,1699) = lu(k,1699) - lu(k,1226) * lu(k,1681) - lu(k,1700) = lu(k,1700) - lu(k,1227) * lu(k,1681) - lu(k,1832) = lu(k,1832) - lu(k,1215) * lu(k,1831) - lu(k,1833) = lu(k,1833) - lu(k,1216) * lu(k,1831) - lu(k,1835) = lu(k,1835) - lu(k,1217) * lu(k,1831) - lu(k,1836) = lu(k,1836) - lu(k,1218) * lu(k,1831) - lu(k,1839) = lu(k,1839) - lu(k,1219) * lu(k,1831) - lu(k,1840) = lu(k,1840) - lu(k,1220) * lu(k,1831) - lu(k,1841) = lu(k,1841) - lu(k,1221) * lu(k,1831) - lu(k,1842) = lu(k,1842) - lu(k,1222) * lu(k,1831) - lu(k,1844) = lu(k,1844) - lu(k,1223) * lu(k,1831) - lu(k,1845) = lu(k,1845) - lu(k,1224) * lu(k,1831) - lu(k,1849) = lu(k,1849) - lu(k,1225) * lu(k,1831) - lu(k,1850) = lu(k,1850) - lu(k,1226) * lu(k,1831) - lu(k,1851) = lu(k,1851) - lu(k,1227) * lu(k,1831) - lu(k,1976) = lu(k,1976) - lu(k,1215) * lu(k,1975) - lu(k,1977) = lu(k,1977) - lu(k,1216) * lu(k,1975) - lu(k,1979) = lu(k,1979) - lu(k,1217) * lu(k,1975) - lu(k,1980) = lu(k,1980) - lu(k,1218) * lu(k,1975) - lu(k,1983) = lu(k,1983) - lu(k,1219) * lu(k,1975) - lu(k,1984) = lu(k,1984) - lu(k,1220) * lu(k,1975) - lu(k,1985) = lu(k,1985) - lu(k,1221) * lu(k,1975) - lu(k,1986) = lu(k,1986) - lu(k,1222) * lu(k,1975) - lu(k,1988) = lu(k,1988) - lu(k,1223) * lu(k,1975) - lu(k,1989) = lu(k,1989) - lu(k,1224) * lu(k,1975) - lu(k,1993) = lu(k,1993) - lu(k,1225) * lu(k,1975) - lu(k,1994) = lu(k,1994) - lu(k,1226) * lu(k,1975) - lu(k,1995) = lu(k,1995) - lu(k,1227) * lu(k,1975) - lu(k,2036) = lu(k,2036) - lu(k,1215) * lu(k,2035) - lu(k,2037) = lu(k,2037) - lu(k,1216) * lu(k,2035) - lu(k,2039) = lu(k,2039) - lu(k,1217) * lu(k,2035) - lu(k,2040) = lu(k,2040) - lu(k,1218) * lu(k,2035) - lu(k,2043) = lu(k,2043) - lu(k,1219) * lu(k,2035) - lu(k,2044) = lu(k,2044) - lu(k,1220) * lu(k,2035) - lu(k,2045) = lu(k,2045) - lu(k,1221) * lu(k,2035) - lu(k,2046) = lu(k,2046) - lu(k,1222) * lu(k,2035) - lu(k,2048) = lu(k,2048) - lu(k,1223) * lu(k,2035) - lu(k,2049) = lu(k,2049) - lu(k,1224) * lu(k,2035) - lu(k,2053) = lu(k,2053) - lu(k,1225) * lu(k,2035) - lu(k,2054) = lu(k,2054) - lu(k,1226) * lu(k,2035) - lu(k,2055) = lu(k,2055) - lu(k,1227) * lu(k,2035) - lu(k,1233) = 1._r8 / lu(k,1233) - lu(k,1234) = lu(k,1234) * lu(k,1233) - lu(k,1235) = lu(k,1235) * lu(k,1233) - lu(k,1236) = lu(k,1236) * lu(k,1233) - lu(k,1237) = lu(k,1237) * lu(k,1233) - lu(k,1238) = lu(k,1238) * lu(k,1233) - lu(k,1239) = lu(k,1239) * lu(k,1233) - lu(k,1240) = lu(k,1240) * lu(k,1233) - lu(k,1241) = lu(k,1241) * lu(k,1233) - lu(k,1242) = lu(k,1242) * lu(k,1233) - lu(k,1243) = lu(k,1243) * lu(k,1233) - lu(k,1244) = lu(k,1244) * lu(k,1233) - lu(k,1245) = lu(k,1245) * lu(k,1233) - lu(k,1264) = lu(k,1264) - lu(k,1234) * lu(k,1263) - lu(k,1265) = lu(k,1265) - lu(k,1235) * lu(k,1263) - lu(k,1266) = lu(k,1266) - lu(k,1236) * lu(k,1263) - lu(k,1267) = lu(k,1267) - lu(k,1237) * lu(k,1263) - lu(k,1268) = lu(k,1268) - lu(k,1238) * lu(k,1263) - lu(k,1269) = lu(k,1269) - lu(k,1239) * lu(k,1263) - lu(k,1270) = lu(k,1270) - lu(k,1240) * lu(k,1263) - lu(k,1271) = lu(k,1271) - lu(k,1241) * lu(k,1263) - lu(k,1272) = lu(k,1272) - lu(k,1242) * lu(k,1263) - lu(k,1273) = lu(k,1273) - lu(k,1243) * lu(k,1263) - lu(k,1274) = lu(k,1274) - lu(k,1244) * lu(k,1263) - lu(k,1275) = lu(k,1275) - lu(k,1245) * lu(k,1263) - lu(k,1501) = lu(k,1501) - lu(k,1234) * lu(k,1500) - lu(k,1503) = lu(k,1503) - lu(k,1235) * lu(k,1500) - lu(k,1504) = lu(k,1504) - lu(k,1236) * lu(k,1500) - lu(k,1507) = lu(k,1507) - lu(k,1237) * lu(k,1500) - lu(k,1508) = lu(k,1508) - lu(k,1238) * lu(k,1500) - lu(k,1509) = lu(k,1509) - lu(k,1239) * lu(k,1500) - lu(k,1510) = lu(k,1510) - lu(k,1240) * lu(k,1500) - lu(k,1512) = lu(k,1512) - lu(k,1241) * lu(k,1500) - lu(k,1513) = lu(k,1513) - lu(k,1242) * lu(k,1500) - lu(k,1517) = lu(k,1517) - lu(k,1243) * lu(k,1500) - lu(k,1518) = lu(k,1518) - lu(k,1244) * lu(k,1500) - lu(k,1519) = lu(k,1519) - lu(k,1245) * lu(k,1500) - lu(k,1542) = lu(k,1542) - lu(k,1234) * lu(k,1541) - lu(k,1544) = lu(k,1544) - lu(k,1235) * lu(k,1541) - lu(k,1545) = lu(k,1545) - lu(k,1236) * lu(k,1541) - lu(k,1548) = lu(k,1548) - lu(k,1237) * lu(k,1541) - lu(k,1549) = lu(k,1549) - lu(k,1238) * lu(k,1541) - lu(k,1550) = lu(k,1550) - lu(k,1239) * lu(k,1541) - lu(k,1551) = lu(k,1551) - lu(k,1240) * lu(k,1541) - lu(k,1553) = lu(k,1553) - lu(k,1241) * lu(k,1541) - lu(k,1554) = lu(k,1554) - lu(k,1242) * lu(k,1541) - lu(k,1558) = lu(k,1558) - lu(k,1243) * lu(k,1541) - lu(k,1559) = lu(k,1559) - lu(k,1244) * lu(k,1541) - lu(k,1560) = lu(k,1560) - lu(k,1245) * lu(k,1541) - lu(k,1632) = lu(k,1632) - lu(k,1234) * lu(k,1631) - lu(k,1634) = lu(k,1634) - lu(k,1235) * lu(k,1631) - lu(k,1635) = lu(k,1635) - lu(k,1236) * lu(k,1631) - lu(k,1638) = lu(k,1638) - lu(k,1237) * lu(k,1631) - lu(k,1639) = lu(k,1639) - lu(k,1238) * lu(k,1631) - lu(k,1640) = lu(k,1640) - lu(k,1239) * lu(k,1631) - lu(k,1641) = lu(k,1641) - lu(k,1240) * lu(k,1631) - lu(k,1643) = lu(k,1643) - lu(k,1241) * lu(k,1631) - lu(k,1644) = lu(k,1644) - lu(k,1242) * lu(k,1631) - lu(k,1648) = lu(k,1648) - lu(k,1243) * lu(k,1631) - lu(k,1649) = lu(k,1649) - lu(k,1244) * lu(k,1631) - lu(k,1650) = lu(k,1650) - lu(k,1245) * lu(k,1631) - lu(k,1683) = lu(k,1683) - lu(k,1234) * lu(k,1682) - lu(k,1684) = lu(k,1684) - lu(k,1235) * lu(k,1682) - lu(k,1685) = lu(k,1685) - lu(k,1236) * lu(k,1682) - lu(k,1688) = lu(k,1688) - lu(k,1237) * lu(k,1682) - lu(k,1689) = lu(k,1689) - lu(k,1238) * lu(k,1682) - lu(k,1690) = lu(k,1690) - lu(k,1239) * lu(k,1682) - lu(k,1691) = lu(k,1691) - lu(k,1240) * lu(k,1682) - lu(k,1693) = lu(k,1693) - lu(k,1241) * lu(k,1682) - lu(k,1694) = lu(k,1694) - lu(k,1242) * lu(k,1682) - lu(k,1698) = lu(k,1698) - lu(k,1243) * lu(k,1682) - lu(k,1699) = lu(k,1699) - lu(k,1244) * lu(k,1682) - lu(k,1700) = lu(k,1700) - lu(k,1245) * lu(k,1682) - lu(k,1833) = lu(k,1833) - lu(k,1234) * lu(k,1832) - lu(k,1835) = lu(k,1835) - lu(k,1235) * lu(k,1832) - lu(k,1836) = lu(k,1836) - lu(k,1236) * lu(k,1832) - lu(k,1839) = lu(k,1839) - lu(k,1237) * lu(k,1832) - lu(k,1840) = lu(k,1840) - lu(k,1238) * lu(k,1832) - lu(k,1841) = lu(k,1841) - lu(k,1239) * lu(k,1832) - lu(k,1842) = lu(k,1842) - lu(k,1240) * lu(k,1832) - lu(k,1844) = lu(k,1844) - lu(k,1241) * lu(k,1832) - lu(k,1845) = lu(k,1845) - lu(k,1242) * lu(k,1832) - lu(k,1849) = lu(k,1849) - lu(k,1243) * lu(k,1832) - lu(k,1850) = lu(k,1850) - lu(k,1244) * lu(k,1832) - lu(k,1851) = lu(k,1851) - lu(k,1245) * lu(k,1832) - lu(k,1977) = lu(k,1977) - lu(k,1234) * lu(k,1976) - lu(k,1979) = lu(k,1979) - lu(k,1235) * lu(k,1976) - lu(k,1980) = lu(k,1980) - lu(k,1236) * lu(k,1976) - lu(k,1983) = lu(k,1983) - lu(k,1237) * lu(k,1976) - lu(k,1984) = lu(k,1984) - lu(k,1238) * lu(k,1976) - lu(k,1985) = lu(k,1985) - lu(k,1239) * lu(k,1976) - lu(k,1986) = lu(k,1986) - lu(k,1240) * lu(k,1976) - lu(k,1988) = lu(k,1988) - lu(k,1241) * lu(k,1976) - lu(k,1989) = lu(k,1989) - lu(k,1242) * lu(k,1976) - lu(k,1993) = lu(k,1993) - lu(k,1243) * lu(k,1976) - lu(k,1994) = lu(k,1994) - lu(k,1244) * lu(k,1976) - lu(k,1995) = lu(k,1995) - lu(k,1245) * lu(k,1976) - lu(k,2037) = lu(k,2037) - lu(k,1234) * lu(k,2036) - lu(k,2039) = lu(k,2039) - lu(k,1235) * lu(k,2036) - lu(k,2040) = lu(k,2040) - lu(k,1236) * lu(k,2036) - lu(k,2043) = lu(k,2043) - lu(k,1237) * lu(k,2036) - lu(k,2044) = lu(k,2044) - lu(k,1238) * lu(k,2036) - lu(k,2045) = lu(k,2045) - lu(k,1239) * lu(k,2036) - lu(k,2046) = lu(k,2046) - lu(k,1240) * lu(k,2036) - lu(k,2048) = lu(k,2048) - lu(k,1241) * lu(k,2036) - lu(k,2049) = lu(k,2049) - lu(k,1242) * lu(k,2036) - lu(k,2053) = lu(k,2053) - lu(k,1243) * lu(k,2036) - lu(k,2054) = lu(k,2054) - lu(k,1244) * lu(k,2036) - lu(k,2055) = lu(k,2055) - lu(k,1245) * lu(k,2036) - lu(k,1264) = 1._r8 / lu(k,1264) - lu(k,1265) = lu(k,1265) * lu(k,1264) - lu(k,1266) = lu(k,1266) * lu(k,1264) - lu(k,1267) = lu(k,1267) * lu(k,1264) - lu(k,1268) = lu(k,1268) * lu(k,1264) - lu(k,1269) = lu(k,1269) * lu(k,1264) - lu(k,1270) = lu(k,1270) * lu(k,1264) - lu(k,1271) = lu(k,1271) * lu(k,1264) - lu(k,1272) = lu(k,1272) * lu(k,1264) - lu(k,1273) = lu(k,1273) * lu(k,1264) - lu(k,1274) = lu(k,1274) * lu(k,1264) - lu(k,1275) = lu(k,1275) * lu(k,1264) - lu(k,1503) = lu(k,1503) - lu(k,1265) * lu(k,1501) - lu(k,1504) = lu(k,1504) - lu(k,1266) * lu(k,1501) - lu(k,1507) = lu(k,1507) - lu(k,1267) * lu(k,1501) - lu(k,1508) = lu(k,1508) - lu(k,1268) * lu(k,1501) - lu(k,1509) = lu(k,1509) - lu(k,1269) * lu(k,1501) - lu(k,1510) = lu(k,1510) - lu(k,1270) * lu(k,1501) - lu(k,1512) = lu(k,1512) - lu(k,1271) * lu(k,1501) - lu(k,1513) = lu(k,1513) - lu(k,1272) * lu(k,1501) - lu(k,1517) = lu(k,1517) - lu(k,1273) * lu(k,1501) - lu(k,1518) = lu(k,1518) - lu(k,1274) * lu(k,1501) - lu(k,1519) = lu(k,1519) - lu(k,1275) * lu(k,1501) - lu(k,1544) = lu(k,1544) - lu(k,1265) * lu(k,1542) - lu(k,1545) = lu(k,1545) - lu(k,1266) * lu(k,1542) - lu(k,1548) = lu(k,1548) - lu(k,1267) * lu(k,1542) - lu(k,1549) = lu(k,1549) - lu(k,1268) * lu(k,1542) - lu(k,1550) = lu(k,1550) - lu(k,1269) * lu(k,1542) - lu(k,1551) = lu(k,1551) - lu(k,1270) * lu(k,1542) - lu(k,1553) = lu(k,1553) - lu(k,1271) * lu(k,1542) - lu(k,1554) = lu(k,1554) - lu(k,1272) * lu(k,1542) - lu(k,1558) = lu(k,1558) - lu(k,1273) * lu(k,1542) - lu(k,1559) = lu(k,1559) - lu(k,1274) * lu(k,1542) - lu(k,1560) = lu(k,1560) - lu(k,1275) * lu(k,1542) - lu(k,1634) = lu(k,1634) - lu(k,1265) * lu(k,1632) - lu(k,1635) = lu(k,1635) - lu(k,1266) * lu(k,1632) - lu(k,1638) = lu(k,1638) - lu(k,1267) * lu(k,1632) - lu(k,1639) = lu(k,1639) - lu(k,1268) * lu(k,1632) - lu(k,1640) = lu(k,1640) - lu(k,1269) * lu(k,1632) - lu(k,1641) = lu(k,1641) - lu(k,1270) * lu(k,1632) - lu(k,1643) = lu(k,1643) - lu(k,1271) * lu(k,1632) - lu(k,1644) = lu(k,1644) - lu(k,1272) * lu(k,1632) - lu(k,1648) = lu(k,1648) - lu(k,1273) * lu(k,1632) - lu(k,1649) = lu(k,1649) - lu(k,1274) * lu(k,1632) - lu(k,1650) = lu(k,1650) - lu(k,1275) * lu(k,1632) - lu(k,1684) = lu(k,1684) - lu(k,1265) * lu(k,1683) - lu(k,1685) = lu(k,1685) - lu(k,1266) * lu(k,1683) - lu(k,1688) = lu(k,1688) - lu(k,1267) * lu(k,1683) - lu(k,1689) = lu(k,1689) - lu(k,1268) * lu(k,1683) - lu(k,1690) = lu(k,1690) - lu(k,1269) * lu(k,1683) - lu(k,1691) = lu(k,1691) - lu(k,1270) * lu(k,1683) - lu(k,1693) = lu(k,1693) - lu(k,1271) * lu(k,1683) - lu(k,1694) = lu(k,1694) - lu(k,1272) * lu(k,1683) - lu(k,1698) = lu(k,1698) - lu(k,1273) * lu(k,1683) - lu(k,1699) = lu(k,1699) - lu(k,1274) * lu(k,1683) - lu(k,1700) = lu(k,1700) - lu(k,1275) * lu(k,1683) - lu(k,1835) = lu(k,1835) - lu(k,1265) * lu(k,1833) - lu(k,1836) = lu(k,1836) - lu(k,1266) * lu(k,1833) - lu(k,1839) = lu(k,1839) - lu(k,1267) * lu(k,1833) - lu(k,1840) = lu(k,1840) - lu(k,1268) * lu(k,1833) - lu(k,1841) = lu(k,1841) - lu(k,1269) * lu(k,1833) - lu(k,1842) = lu(k,1842) - lu(k,1270) * lu(k,1833) - lu(k,1844) = lu(k,1844) - lu(k,1271) * lu(k,1833) - lu(k,1845) = lu(k,1845) - lu(k,1272) * lu(k,1833) - lu(k,1849) = lu(k,1849) - lu(k,1273) * lu(k,1833) - lu(k,1850) = lu(k,1850) - lu(k,1274) * lu(k,1833) - lu(k,1851) = lu(k,1851) - lu(k,1275) * lu(k,1833) - lu(k,1922) = lu(k,1922) - lu(k,1265) * lu(k,1920) - lu(k,1923) = lu(k,1923) - lu(k,1266) * lu(k,1920) - lu(k,1926) = lu(k,1926) - lu(k,1267) * lu(k,1920) - lu(k,1927) = lu(k,1927) - lu(k,1268) * lu(k,1920) - lu(k,1928) = lu(k,1928) - lu(k,1269) * lu(k,1920) - lu(k,1929) = lu(k,1929) - lu(k,1270) * lu(k,1920) - lu(k,1931) = lu(k,1931) - lu(k,1271) * lu(k,1920) - lu(k,1932) = lu(k,1932) - lu(k,1272) * lu(k,1920) - lu(k,1936) = lu(k,1936) - lu(k,1273) * lu(k,1920) - lu(k,1937) = lu(k,1937) - lu(k,1274) * lu(k,1920) - lu(k,1938) = lu(k,1938) - lu(k,1275) * lu(k,1920) - lu(k,1979) = lu(k,1979) - lu(k,1265) * lu(k,1977) - lu(k,1980) = lu(k,1980) - lu(k,1266) * lu(k,1977) - lu(k,1983) = lu(k,1983) - lu(k,1267) * lu(k,1977) - lu(k,1984) = lu(k,1984) - lu(k,1268) * lu(k,1977) - lu(k,1985) = lu(k,1985) - lu(k,1269) * lu(k,1977) - lu(k,1986) = lu(k,1986) - lu(k,1270) * lu(k,1977) - lu(k,1988) = lu(k,1988) - lu(k,1271) * lu(k,1977) - lu(k,1989) = lu(k,1989) - lu(k,1272) * lu(k,1977) - lu(k,1993) = lu(k,1993) - lu(k,1273) * lu(k,1977) - lu(k,1994) = lu(k,1994) - lu(k,1274) * lu(k,1977) - lu(k,1995) = lu(k,1995) - lu(k,1275) * lu(k,1977) - lu(k,2039) = lu(k,2039) - lu(k,1265) * lu(k,2037) - lu(k,2040) = lu(k,2040) - lu(k,1266) * lu(k,2037) - lu(k,2043) = lu(k,2043) - lu(k,1267) * lu(k,2037) - lu(k,2044) = lu(k,2044) - lu(k,1268) * lu(k,2037) - lu(k,2045) = lu(k,2045) - lu(k,1269) * lu(k,2037) - lu(k,2046) = lu(k,2046) - lu(k,1270) * lu(k,2037) - lu(k,2048) = lu(k,2048) - lu(k,1271) * lu(k,2037) - lu(k,2049) = lu(k,2049) - lu(k,1272) * lu(k,2037) - lu(k,2053) = lu(k,2053) - lu(k,1273) * lu(k,2037) - lu(k,2054) = lu(k,2054) - lu(k,1274) * lu(k,2037) - lu(k,2055) = lu(k,2055) - lu(k,1275) * lu(k,2037) + lu(k,1153) = 1._r8 / lu(k,1153) + lu(k,1154) = lu(k,1154) * lu(k,1153) + lu(k,1155) = lu(k,1155) * lu(k,1153) + lu(k,1156) = lu(k,1156) * lu(k,1153) + lu(k,1157) = lu(k,1157) * lu(k,1153) + lu(k,1158) = lu(k,1158) * lu(k,1153) + lu(k,1159) = lu(k,1159) * lu(k,1153) + lu(k,1160) = lu(k,1160) * lu(k,1153) + lu(k,1161) = lu(k,1161) * lu(k,1153) + lu(k,1162) = lu(k,1162) * lu(k,1153) + lu(k,1163) = lu(k,1163) * lu(k,1153) + lu(k,1164) = lu(k,1164) * lu(k,1153) + lu(k,1165) = lu(k,1165) * lu(k,1153) + lu(k,1255) = lu(k,1255) - lu(k,1154) * lu(k,1252) + lu(k,1260) = lu(k,1260) - lu(k,1155) * lu(k,1252) + lu(k,1261) = lu(k,1261) - lu(k,1156) * lu(k,1252) + lu(k,1262) = lu(k,1262) - lu(k,1157) * lu(k,1252) + lu(k,1263) = lu(k,1263) - lu(k,1158) * lu(k,1252) + lu(k,1264) = lu(k,1264) - lu(k,1159) * lu(k,1252) + lu(k,1265) = lu(k,1265) - lu(k,1160) * lu(k,1252) + lu(k,1266) = lu(k,1266) - lu(k,1161) * lu(k,1252) + lu(k,1267) = lu(k,1267) - lu(k,1162) * lu(k,1252) + lu(k,1269) = lu(k,1269) - lu(k,1163) * lu(k,1252) + lu(k,1270) = lu(k,1270) - lu(k,1164) * lu(k,1252) + lu(k,1271) = - lu(k,1165) * lu(k,1252) + lu(k,1287) = lu(k,1287) - lu(k,1154) * lu(k,1284) + lu(k,1292) = lu(k,1292) - lu(k,1155) * lu(k,1284) + lu(k,1293) = lu(k,1293) - lu(k,1156) * lu(k,1284) + lu(k,1294) = lu(k,1294) - lu(k,1157) * lu(k,1284) + lu(k,1295) = lu(k,1295) - lu(k,1158) * lu(k,1284) + lu(k,1296) = lu(k,1296) - lu(k,1159) * lu(k,1284) + lu(k,1297) = lu(k,1297) - lu(k,1160) * lu(k,1284) + lu(k,1298) = lu(k,1298) - lu(k,1161) * lu(k,1284) + lu(k,1299) = lu(k,1299) - lu(k,1162) * lu(k,1284) + lu(k,1301) = lu(k,1301) - lu(k,1163) * lu(k,1284) + lu(k,1302) = lu(k,1302) - lu(k,1164) * lu(k,1284) + lu(k,1303) = - lu(k,1165) * lu(k,1284) + lu(k,1310) = lu(k,1310) - lu(k,1154) * lu(k,1309) + lu(k,1313) = lu(k,1313) - lu(k,1155) * lu(k,1309) + lu(k,1314) = - lu(k,1156) * lu(k,1309) + lu(k,1315) = lu(k,1315) - lu(k,1157) * lu(k,1309) + lu(k,1316) = lu(k,1316) - lu(k,1158) * lu(k,1309) + lu(k,1317) = lu(k,1317) - lu(k,1159) * lu(k,1309) + lu(k,1318) = lu(k,1318) - lu(k,1160) * lu(k,1309) + lu(k,1319) = lu(k,1319) - lu(k,1161) * lu(k,1309) + lu(k,1320) = lu(k,1320) - lu(k,1162) * lu(k,1309) + lu(k,1321) = lu(k,1321) - lu(k,1163) * lu(k,1309) + lu(k,1322) = lu(k,1322) - lu(k,1164) * lu(k,1309) + lu(k,1323) = - lu(k,1165) * lu(k,1309) + lu(k,1676) = lu(k,1676) - lu(k,1154) * lu(k,1672) + lu(k,1683) = lu(k,1683) - lu(k,1155) * lu(k,1672) + lu(k,1687) = lu(k,1687) - lu(k,1156) * lu(k,1672) + lu(k,1689) = lu(k,1689) - lu(k,1157) * lu(k,1672) + lu(k,1691) = lu(k,1691) - lu(k,1158) * lu(k,1672) + lu(k,1692) = lu(k,1692) - lu(k,1159) * lu(k,1672) + lu(k,1693) = lu(k,1693) - lu(k,1160) * lu(k,1672) + lu(k,1694) = lu(k,1694) - lu(k,1161) * lu(k,1672) + lu(k,1697) = lu(k,1697) - lu(k,1162) * lu(k,1672) + lu(k,1700) = lu(k,1700) - lu(k,1163) * lu(k,1672) + lu(k,1702) = lu(k,1702) - lu(k,1164) * lu(k,1672) + lu(k,1703) = lu(k,1703) - lu(k,1165) * lu(k,1672) + lu(k,1734) = lu(k,1734) - lu(k,1154) * lu(k,1730) + lu(k,1741) = lu(k,1741) - lu(k,1155) * lu(k,1730) + lu(k,1744) = lu(k,1744) - lu(k,1156) * lu(k,1730) + lu(k,1746) = lu(k,1746) - lu(k,1157) * lu(k,1730) + lu(k,1748) = lu(k,1748) - lu(k,1158) * lu(k,1730) + lu(k,1749) = lu(k,1749) - lu(k,1159) * lu(k,1730) + lu(k,1750) = lu(k,1750) - lu(k,1160) * lu(k,1730) + lu(k,1751) = lu(k,1751) - lu(k,1161) * lu(k,1730) + lu(k,1754) = lu(k,1754) - lu(k,1162) * lu(k,1730) + lu(k,1757) = lu(k,1757) - lu(k,1163) * lu(k,1730) + lu(k,1759) = lu(k,1759) - lu(k,1164) * lu(k,1730) + lu(k,1760) = lu(k,1760) - lu(k,1165) * lu(k,1730) + lu(k,1827) = lu(k,1827) - lu(k,1154) * lu(k,1823) + lu(k,1833) = lu(k,1833) - lu(k,1155) * lu(k,1823) + lu(k,1836) = lu(k,1836) - lu(k,1156) * lu(k,1823) + lu(k,1838) = lu(k,1838) - lu(k,1157) * lu(k,1823) + lu(k,1840) = lu(k,1840) - lu(k,1158) * lu(k,1823) + lu(k,1841) = lu(k,1841) - lu(k,1159) * lu(k,1823) + lu(k,1842) = lu(k,1842) - lu(k,1160) * lu(k,1823) + lu(k,1843) = lu(k,1843) - lu(k,1161) * lu(k,1823) + lu(k,1846) = lu(k,1846) - lu(k,1162) * lu(k,1823) + lu(k,1849) = lu(k,1849) - lu(k,1163) * lu(k,1823) + lu(k,1851) = lu(k,1851) - lu(k,1164) * lu(k,1823) + lu(k,1852) = lu(k,1852) - lu(k,1165) * lu(k,1823) + lu(k,1173) = 1._r8 / lu(k,1173) + lu(k,1174) = lu(k,1174) * lu(k,1173) + lu(k,1175) = lu(k,1175) * lu(k,1173) + lu(k,1176) = lu(k,1176) * lu(k,1173) + lu(k,1177) = lu(k,1177) * lu(k,1173) + lu(k,1178) = lu(k,1178) * lu(k,1173) + lu(k,1179) = lu(k,1179) * lu(k,1173) + lu(k,1180) = lu(k,1180) * lu(k,1173) + lu(k,1181) = lu(k,1181) * lu(k,1173) + lu(k,1182) = lu(k,1182) * lu(k,1173) + lu(k,1183) = lu(k,1183) * lu(k,1173) + lu(k,1195) = lu(k,1195) - lu(k,1174) * lu(k,1192) + lu(k,1197) = lu(k,1197) - lu(k,1175) * lu(k,1192) + lu(k,1199) = lu(k,1199) - lu(k,1176) * lu(k,1192) + lu(k,1200) = lu(k,1200) - lu(k,1177) * lu(k,1192) + lu(k,1201) = lu(k,1201) - lu(k,1178) * lu(k,1192) + lu(k,1202) = lu(k,1202) - lu(k,1179) * lu(k,1192) + lu(k,1203) = lu(k,1203) - lu(k,1180) * lu(k,1192) + lu(k,1204) = lu(k,1204) - lu(k,1181) * lu(k,1192) + lu(k,1205) = lu(k,1205) - lu(k,1182) * lu(k,1192) + lu(k,1206) = lu(k,1206) - lu(k,1183) * lu(k,1192) + lu(k,1255) = lu(k,1255) - lu(k,1174) * lu(k,1253) + lu(k,1260) = lu(k,1260) - lu(k,1175) * lu(k,1253) + lu(k,1262) = lu(k,1262) - lu(k,1176) * lu(k,1253) + lu(k,1263) = lu(k,1263) - lu(k,1177) * lu(k,1253) + lu(k,1264) = lu(k,1264) - lu(k,1178) * lu(k,1253) + lu(k,1265) = lu(k,1265) - lu(k,1179) * lu(k,1253) + lu(k,1266) = lu(k,1266) - lu(k,1180) * lu(k,1253) + lu(k,1267) = lu(k,1267) - lu(k,1181) * lu(k,1253) + lu(k,1269) = lu(k,1269) - lu(k,1182) * lu(k,1253) + lu(k,1270) = lu(k,1270) - lu(k,1183) * lu(k,1253) + lu(k,1287) = lu(k,1287) - lu(k,1174) * lu(k,1285) + lu(k,1292) = lu(k,1292) - lu(k,1175) * lu(k,1285) + lu(k,1294) = lu(k,1294) - lu(k,1176) * lu(k,1285) + lu(k,1295) = lu(k,1295) - lu(k,1177) * lu(k,1285) + lu(k,1296) = lu(k,1296) - lu(k,1178) * lu(k,1285) + lu(k,1297) = lu(k,1297) - lu(k,1179) * lu(k,1285) + lu(k,1298) = lu(k,1298) - lu(k,1180) * lu(k,1285) + lu(k,1299) = lu(k,1299) - lu(k,1181) * lu(k,1285) + lu(k,1301) = lu(k,1301) - lu(k,1182) * lu(k,1285) + lu(k,1302) = lu(k,1302) - lu(k,1183) * lu(k,1285) + lu(k,1380) = lu(k,1380) - lu(k,1174) * lu(k,1377) + lu(k,1386) = lu(k,1386) - lu(k,1175) * lu(k,1377) + lu(k,1389) = lu(k,1389) - lu(k,1176) * lu(k,1377) + lu(k,1390) = lu(k,1390) - lu(k,1177) * lu(k,1377) + lu(k,1391) = lu(k,1391) - lu(k,1178) * lu(k,1377) + lu(k,1392) = lu(k,1392) - lu(k,1179) * lu(k,1377) + lu(k,1393) = lu(k,1393) - lu(k,1180) * lu(k,1377) + lu(k,1394) = lu(k,1394) - lu(k,1181) * lu(k,1377) + lu(k,1396) = lu(k,1396) - lu(k,1182) * lu(k,1377) + lu(k,1397) = lu(k,1397) - lu(k,1183) * lu(k,1377) + lu(k,1676) = lu(k,1676) - lu(k,1174) * lu(k,1673) + lu(k,1683) = lu(k,1683) - lu(k,1175) * lu(k,1673) + lu(k,1689) = lu(k,1689) - lu(k,1176) * lu(k,1673) + lu(k,1691) = lu(k,1691) - lu(k,1177) * lu(k,1673) + lu(k,1692) = lu(k,1692) - lu(k,1178) * lu(k,1673) + lu(k,1693) = lu(k,1693) - lu(k,1179) * lu(k,1673) + lu(k,1694) = lu(k,1694) - lu(k,1180) * lu(k,1673) + lu(k,1697) = lu(k,1697) - lu(k,1181) * lu(k,1673) + lu(k,1700) = lu(k,1700) - lu(k,1182) * lu(k,1673) + lu(k,1702) = lu(k,1702) - lu(k,1183) * lu(k,1673) + lu(k,1734) = lu(k,1734) - lu(k,1174) * lu(k,1731) + lu(k,1741) = lu(k,1741) - lu(k,1175) * lu(k,1731) + lu(k,1746) = lu(k,1746) - lu(k,1176) * lu(k,1731) + lu(k,1748) = lu(k,1748) - lu(k,1177) * lu(k,1731) + lu(k,1749) = lu(k,1749) - lu(k,1178) * lu(k,1731) + lu(k,1750) = lu(k,1750) - lu(k,1179) * lu(k,1731) + lu(k,1751) = lu(k,1751) - lu(k,1180) * lu(k,1731) + lu(k,1754) = lu(k,1754) - lu(k,1181) * lu(k,1731) + lu(k,1757) = lu(k,1757) - lu(k,1182) * lu(k,1731) + lu(k,1759) = lu(k,1759) - lu(k,1183) * lu(k,1731) + lu(k,1827) = lu(k,1827) - lu(k,1174) * lu(k,1824) + lu(k,1833) = lu(k,1833) - lu(k,1175) * lu(k,1824) + lu(k,1838) = lu(k,1838) - lu(k,1176) * lu(k,1824) + lu(k,1840) = lu(k,1840) - lu(k,1177) * lu(k,1824) + lu(k,1841) = lu(k,1841) - lu(k,1178) * lu(k,1824) + lu(k,1842) = lu(k,1842) - lu(k,1179) * lu(k,1824) + lu(k,1843) = lu(k,1843) - lu(k,1180) * lu(k,1824) + lu(k,1846) = lu(k,1846) - lu(k,1181) * lu(k,1824) + lu(k,1849) = lu(k,1849) - lu(k,1182) * lu(k,1824) + lu(k,1851) = lu(k,1851) - lu(k,1183) * lu(k,1824) + lu(k,1933) = lu(k,1933) - lu(k,1174) * lu(k,1930) + lu(k,1939) = lu(k,1939) - lu(k,1175) * lu(k,1930) + lu(k,1945) = lu(k,1945) - lu(k,1176) * lu(k,1930) + lu(k,1947) = lu(k,1947) - lu(k,1177) * lu(k,1930) + lu(k,1948) = lu(k,1948) - lu(k,1178) * lu(k,1930) + lu(k,1949) = lu(k,1949) - lu(k,1179) * lu(k,1930) + lu(k,1950) = lu(k,1950) - lu(k,1180) * lu(k,1930) + lu(k,1953) = lu(k,1953) - lu(k,1181) * lu(k,1930) + lu(k,1956) = lu(k,1956) - lu(k,1182) * lu(k,1930) + lu(k,1958) = lu(k,1958) - lu(k,1183) * lu(k,1930) + lu(k,2052) = lu(k,2052) - lu(k,1174) * lu(k,2049) + lu(k,2058) = lu(k,2058) - lu(k,1175) * lu(k,2049) + lu(k,2062) = lu(k,2062) - lu(k,1176) * lu(k,2049) + lu(k,2064) = lu(k,2064) - lu(k,1177) * lu(k,2049) + lu(k,2065) = lu(k,2065) - lu(k,1178) * lu(k,2049) + lu(k,2066) = lu(k,2066) - lu(k,1179) * lu(k,2049) + lu(k,2067) = lu(k,2067) - lu(k,1180) * lu(k,2049) + lu(k,2070) = lu(k,2070) - lu(k,1181) * lu(k,2049) + lu(k,2073) = lu(k,2073) - lu(k,1182) * lu(k,2049) + lu(k,2075) = lu(k,2075) - lu(k,1183) * lu(k,2049) + lu(k,1193) = 1._r8 / lu(k,1193) + lu(k,1194) = lu(k,1194) * lu(k,1193) + lu(k,1195) = lu(k,1195) * lu(k,1193) + lu(k,1196) = lu(k,1196) * lu(k,1193) + lu(k,1197) = lu(k,1197) * lu(k,1193) + lu(k,1198) = lu(k,1198) * lu(k,1193) + lu(k,1199) = lu(k,1199) * lu(k,1193) + lu(k,1200) = lu(k,1200) * lu(k,1193) + lu(k,1201) = lu(k,1201) * lu(k,1193) + lu(k,1202) = lu(k,1202) * lu(k,1193) + lu(k,1203) = lu(k,1203) * lu(k,1193) + lu(k,1204) = lu(k,1204) * lu(k,1193) + lu(k,1205) = lu(k,1205) * lu(k,1193) + lu(k,1206) = lu(k,1206) * lu(k,1193) + lu(k,1379) = lu(k,1379) - lu(k,1194) * lu(k,1378) + lu(k,1380) = lu(k,1380) - lu(k,1195) * lu(k,1378) + lu(k,1384) = lu(k,1384) - lu(k,1196) * lu(k,1378) + lu(k,1386) = lu(k,1386) - lu(k,1197) * lu(k,1378) + lu(k,1388) = lu(k,1388) - lu(k,1198) * lu(k,1378) + lu(k,1389) = lu(k,1389) - lu(k,1199) * lu(k,1378) + lu(k,1390) = lu(k,1390) - lu(k,1200) * lu(k,1378) + lu(k,1391) = lu(k,1391) - lu(k,1201) * lu(k,1378) + lu(k,1392) = lu(k,1392) - lu(k,1202) * lu(k,1378) + lu(k,1393) = lu(k,1393) - lu(k,1203) * lu(k,1378) + lu(k,1394) = lu(k,1394) - lu(k,1204) * lu(k,1378) + lu(k,1396) = lu(k,1396) - lu(k,1205) * lu(k,1378) + lu(k,1397) = lu(k,1397) - lu(k,1206) * lu(k,1378) + lu(k,1675) = lu(k,1675) - lu(k,1194) * lu(k,1674) + lu(k,1676) = lu(k,1676) - lu(k,1195) * lu(k,1674) + lu(k,1681) = lu(k,1681) - lu(k,1196) * lu(k,1674) + lu(k,1683) = lu(k,1683) - lu(k,1197) * lu(k,1674) + lu(k,1687) = lu(k,1687) - lu(k,1198) * lu(k,1674) + lu(k,1689) = lu(k,1689) - lu(k,1199) * lu(k,1674) + lu(k,1691) = lu(k,1691) - lu(k,1200) * lu(k,1674) + lu(k,1692) = lu(k,1692) - lu(k,1201) * lu(k,1674) + lu(k,1693) = lu(k,1693) - lu(k,1202) * lu(k,1674) + lu(k,1694) = lu(k,1694) - lu(k,1203) * lu(k,1674) + lu(k,1697) = lu(k,1697) - lu(k,1204) * lu(k,1674) + lu(k,1700) = lu(k,1700) - lu(k,1205) * lu(k,1674) + lu(k,1702) = lu(k,1702) - lu(k,1206) * lu(k,1674) + lu(k,1733) = lu(k,1733) - lu(k,1194) * lu(k,1732) + lu(k,1734) = lu(k,1734) - lu(k,1195) * lu(k,1732) + lu(k,1739) = lu(k,1739) - lu(k,1196) * lu(k,1732) + lu(k,1741) = lu(k,1741) - lu(k,1197) * lu(k,1732) + lu(k,1744) = lu(k,1744) - lu(k,1198) * lu(k,1732) + lu(k,1746) = lu(k,1746) - lu(k,1199) * lu(k,1732) + lu(k,1748) = lu(k,1748) - lu(k,1200) * lu(k,1732) + lu(k,1749) = lu(k,1749) - lu(k,1201) * lu(k,1732) + lu(k,1750) = lu(k,1750) - lu(k,1202) * lu(k,1732) + lu(k,1751) = lu(k,1751) - lu(k,1203) * lu(k,1732) + lu(k,1754) = lu(k,1754) - lu(k,1204) * lu(k,1732) + lu(k,1757) = lu(k,1757) - lu(k,1205) * lu(k,1732) + lu(k,1759) = lu(k,1759) - lu(k,1206) * lu(k,1732) + lu(k,1826) = lu(k,1826) - lu(k,1194) * lu(k,1825) + lu(k,1827) = lu(k,1827) - lu(k,1195) * lu(k,1825) + lu(k,1831) = lu(k,1831) - lu(k,1196) * lu(k,1825) + lu(k,1833) = lu(k,1833) - lu(k,1197) * lu(k,1825) + lu(k,1836) = lu(k,1836) - lu(k,1198) * lu(k,1825) + lu(k,1838) = lu(k,1838) - lu(k,1199) * lu(k,1825) + lu(k,1840) = lu(k,1840) - lu(k,1200) * lu(k,1825) + lu(k,1841) = lu(k,1841) - lu(k,1201) * lu(k,1825) + lu(k,1842) = lu(k,1842) - lu(k,1202) * lu(k,1825) + lu(k,1843) = lu(k,1843) - lu(k,1203) * lu(k,1825) + lu(k,1846) = lu(k,1846) - lu(k,1204) * lu(k,1825) + lu(k,1849) = lu(k,1849) - lu(k,1205) * lu(k,1825) + lu(k,1851) = lu(k,1851) - lu(k,1206) * lu(k,1825) + lu(k,1932) = lu(k,1932) - lu(k,1194) * lu(k,1931) + lu(k,1933) = lu(k,1933) - lu(k,1195) * lu(k,1931) + lu(k,1937) = lu(k,1937) - lu(k,1196) * lu(k,1931) + lu(k,1939) = lu(k,1939) - lu(k,1197) * lu(k,1931) + lu(k,1943) = lu(k,1943) - lu(k,1198) * lu(k,1931) + lu(k,1945) = lu(k,1945) - lu(k,1199) * lu(k,1931) + lu(k,1947) = lu(k,1947) - lu(k,1200) * lu(k,1931) + lu(k,1948) = lu(k,1948) - lu(k,1201) * lu(k,1931) + lu(k,1949) = lu(k,1949) - lu(k,1202) * lu(k,1931) + lu(k,1950) = lu(k,1950) - lu(k,1203) * lu(k,1931) + lu(k,1953) = lu(k,1953) - lu(k,1204) * lu(k,1931) + lu(k,1956) = lu(k,1956) - lu(k,1205) * lu(k,1931) + lu(k,1958) = lu(k,1958) - lu(k,1206) * lu(k,1931) + lu(k,2051) = lu(k,2051) - lu(k,1194) * lu(k,2050) + lu(k,2052) = lu(k,2052) - lu(k,1195) * lu(k,2050) + lu(k,2056) = lu(k,2056) - lu(k,1196) * lu(k,2050) + lu(k,2058) = lu(k,2058) - lu(k,1197) * lu(k,2050) + lu(k,2060) = lu(k,2060) - lu(k,1198) * lu(k,2050) + lu(k,2062) = lu(k,2062) - lu(k,1199) * lu(k,2050) + lu(k,2064) = lu(k,2064) - lu(k,1200) * lu(k,2050) + lu(k,2065) = lu(k,2065) - lu(k,1201) * lu(k,2050) + lu(k,2066) = lu(k,2066) - lu(k,1202) * lu(k,2050) + lu(k,2067) = lu(k,2067) - lu(k,1203) * lu(k,2050) + lu(k,2070) = lu(k,2070) - lu(k,1204) * lu(k,2050) + lu(k,2073) = lu(k,2073) - lu(k,1205) * lu(k,2050) + lu(k,2075) = lu(k,2075) - lu(k,1206) * lu(k,2050) + lu(k,2110) = lu(k,2110) - lu(k,1194) * lu(k,2109) + lu(k,2111) = lu(k,2111) - lu(k,1195) * lu(k,2109) + lu(k,2116) = lu(k,2116) - lu(k,1196) * lu(k,2109) + lu(k,2118) = lu(k,2118) - lu(k,1197) * lu(k,2109) + lu(k,2121) = lu(k,2121) - lu(k,1198) * lu(k,2109) + lu(k,2123) = lu(k,2123) - lu(k,1199) * lu(k,2109) + lu(k,2125) = lu(k,2125) - lu(k,1200) * lu(k,2109) + lu(k,2126) = lu(k,2126) - lu(k,1201) * lu(k,2109) + lu(k,2127) = lu(k,2127) - lu(k,1202) * lu(k,2109) + lu(k,2128) = lu(k,2128) - lu(k,1203) * lu(k,2109) + lu(k,2131) = lu(k,2131) - lu(k,1204) * lu(k,2109) + lu(k,2134) = lu(k,2134) - lu(k,1205) * lu(k,2109) + lu(k,2136) = lu(k,2136) - lu(k,1206) * lu(k,2109) + lu(k,1209) = 1._r8 / lu(k,1209) + lu(k,1210) = lu(k,1210) * lu(k,1209) + lu(k,1211) = lu(k,1211) * lu(k,1209) + lu(k,1212) = lu(k,1212) * lu(k,1209) + lu(k,1213) = lu(k,1213) * lu(k,1209) + lu(k,1214) = lu(k,1214) * lu(k,1209) + lu(k,1215) = lu(k,1215) * lu(k,1209) + lu(k,1216) = lu(k,1216) * lu(k,1209) + lu(k,1217) = lu(k,1217) * lu(k,1209) + lu(k,1218) = lu(k,1218) * lu(k,1209) + lu(k,1219) = lu(k,1219) * lu(k,1209) + lu(k,1255) = lu(k,1255) - lu(k,1210) * lu(k,1254) + lu(k,1257) = - lu(k,1211) * lu(k,1254) + lu(k,1259) = - lu(k,1212) * lu(k,1254) + lu(k,1260) = lu(k,1260) - lu(k,1213) * lu(k,1254) + lu(k,1262) = lu(k,1262) - lu(k,1214) * lu(k,1254) + lu(k,1263) = lu(k,1263) - lu(k,1215) * lu(k,1254) + lu(k,1266) = lu(k,1266) - lu(k,1216) * lu(k,1254) + lu(k,1268) = - lu(k,1217) * lu(k,1254) + lu(k,1270) = lu(k,1270) - lu(k,1218) * lu(k,1254) + lu(k,1271) = lu(k,1271) - lu(k,1219) * lu(k,1254) + lu(k,1287) = lu(k,1287) - lu(k,1210) * lu(k,1286) + lu(k,1289) = - lu(k,1211) * lu(k,1286) + lu(k,1291) = - lu(k,1212) * lu(k,1286) + lu(k,1292) = lu(k,1292) - lu(k,1213) * lu(k,1286) + lu(k,1294) = lu(k,1294) - lu(k,1214) * lu(k,1286) + lu(k,1295) = lu(k,1295) - lu(k,1215) * lu(k,1286) + lu(k,1298) = lu(k,1298) - lu(k,1216) * lu(k,1286) + lu(k,1300) = - lu(k,1217) * lu(k,1286) + lu(k,1302) = lu(k,1302) - lu(k,1218) * lu(k,1286) + lu(k,1303) = lu(k,1303) - lu(k,1219) * lu(k,1286) + lu(k,1380) = lu(k,1380) - lu(k,1210) * lu(k,1379) + lu(k,1383) = lu(k,1383) - lu(k,1211) * lu(k,1379) + lu(k,1385) = lu(k,1385) - lu(k,1212) * lu(k,1379) + lu(k,1386) = lu(k,1386) - lu(k,1213) * lu(k,1379) + lu(k,1389) = lu(k,1389) - lu(k,1214) * lu(k,1379) + lu(k,1390) = lu(k,1390) - lu(k,1215) * lu(k,1379) + lu(k,1393) = lu(k,1393) - lu(k,1216) * lu(k,1379) + lu(k,1395) = lu(k,1395) - lu(k,1217) * lu(k,1379) + lu(k,1397) = lu(k,1397) - lu(k,1218) * lu(k,1379) + lu(k,1398) = lu(k,1398) - lu(k,1219) * lu(k,1379) + lu(k,1676) = lu(k,1676) - lu(k,1210) * lu(k,1675) + lu(k,1680) = lu(k,1680) - lu(k,1211) * lu(k,1675) + lu(k,1682) = lu(k,1682) - lu(k,1212) * lu(k,1675) + lu(k,1683) = lu(k,1683) - lu(k,1213) * lu(k,1675) + lu(k,1689) = lu(k,1689) - lu(k,1214) * lu(k,1675) + lu(k,1691) = lu(k,1691) - lu(k,1215) * lu(k,1675) + lu(k,1694) = lu(k,1694) - lu(k,1216) * lu(k,1675) + lu(k,1698) = lu(k,1698) - lu(k,1217) * lu(k,1675) + lu(k,1702) = lu(k,1702) - lu(k,1218) * lu(k,1675) + lu(k,1703) = lu(k,1703) - lu(k,1219) * lu(k,1675) + lu(k,1734) = lu(k,1734) - lu(k,1210) * lu(k,1733) + lu(k,1738) = lu(k,1738) - lu(k,1211) * lu(k,1733) + lu(k,1740) = lu(k,1740) - lu(k,1212) * lu(k,1733) + lu(k,1741) = lu(k,1741) - lu(k,1213) * lu(k,1733) + lu(k,1746) = lu(k,1746) - lu(k,1214) * lu(k,1733) + lu(k,1748) = lu(k,1748) - lu(k,1215) * lu(k,1733) + lu(k,1751) = lu(k,1751) - lu(k,1216) * lu(k,1733) + lu(k,1755) = lu(k,1755) - lu(k,1217) * lu(k,1733) + lu(k,1759) = lu(k,1759) - lu(k,1218) * lu(k,1733) + lu(k,1760) = lu(k,1760) - lu(k,1219) * lu(k,1733) + lu(k,1827) = lu(k,1827) - lu(k,1210) * lu(k,1826) + lu(k,1830) = lu(k,1830) - lu(k,1211) * lu(k,1826) + lu(k,1832) = lu(k,1832) - lu(k,1212) * lu(k,1826) + lu(k,1833) = lu(k,1833) - lu(k,1213) * lu(k,1826) + lu(k,1838) = lu(k,1838) - lu(k,1214) * lu(k,1826) + lu(k,1840) = lu(k,1840) - lu(k,1215) * lu(k,1826) + lu(k,1843) = lu(k,1843) - lu(k,1216) * lu(k,1826) + lu(k,1847) = lu(k,1847) - lu(k,1217) * lu(k,1826) + lu(k,1851) = lu(k,1851) - lu(k,1218) * lu(k,1826) + lu(k,1852) = lu(k,1852) - lu(k,1219) * lu(k,1826) + lu(k,1933) = lu(k,1933) - lu(k,1210) * lu(k,1932) + lu(k,1936) = lu(k,1936) - lu(k,1211) * lu(k,1932) + lu(k,1938) = lu(k,1938) - lu(k,1212) * lu(k,1932) + lu(k,1939) = lu(k,1939) - lu(k,1213) * lu(k,1932) + lu(k,1945) = lu(k,1945) - lu(k,1214) * lu(k,1932) + lu(k,1947) = lu(k,1947) - lu(k,1215) * lu(k,1932) + lu(k,1950) = lu(k,1950) - lu(k,1216) * lu(k,1932) + lu(k,1954) = lu(k,1954) - lu(k,1217) * lu(k,1932) + lu(k,1958) = lu(k,1958) - lu(k,1218) * lu(k,1932) + lu(k,1959) = lu(k,1959) - lu(k,1219) * lu(k,1932) + lu(k,2052) = lu(k,2052) - lu(k,1210) * lu(k,2051) + lu(k,2055) = lu(k,2055) - lu(k,1211) * lu(k,2051) + lu(k,2057) = lu(k,2057) - lu(k,1212) * lu(k,2051) + lu(k,2058) = lu(k,2058) - lu(k,1213) * lu(k,2051) + lu(k,2062) = lu(k,2062) - lu(k,1214) * lu(k,2051) + lu(k,2064) = lu(k,2064) - lu(k,1215) * lu(k,2051) + lu(k,2067) = lu(k,2067) - lu(k,1216) * lu(k,2051) + lu(k,2071) = - lu(k,1217) * lu(k,2051) + lu(k,2075) = lu(k,2075) - lu(k,1218) * lu(k,2051) + lu(k,2076) = lu(k,2076) - lu(k,1219) * lu(k,2051) + lu(k,2111) = lu(k,2111) - lu(k,1210) * lu(k,2110) + lu(k,2115) = - lu(k,1211) * lu(k,2110) + lu(k,2117) = - lu(k,1212) * lu(k,2110) + lu(k,2118) = lu(k,2118) - lu(k,1213) * lu(k,2110) + lu(k,2123) = lu(k,2123) - lu(k,1214) * lu(k,2110) + lu(k,2125) = lu(k,2125) - lu(k,1215) * lu(k,2110) + lu(k,2128) = lu(k,2128) - lu(k,1216) * lu(k,2110) + lu(k,2132) = lu(k,2132) - lu(k,1217) * lu(k,2110) + lu(k,2136) = lu(k,2136) - lu(k,1218) * lu(k,2110) + lu(k,2137) = lu(k,2137) - lu(k,1219) * lu(k,2110) end do end subroutine lu_fac24 subroutine lu_fac25( avec_len, lu ) @@ -5630,490 +5020,335 @@ subroutine lu_fac25( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1278) = 1._r8 / lu(k,1278) - lu(k,1279) = lu(k,1279) * lu(k,1278) - lu(k,1280) = lu(k,1280) * lu(k,1278) - lu(k,1281) = lu(k,1281) * lu(k,1278) - lu(k,1282) = lu(k,1282) * lu(k,1278) - lu(k,1283) = lu(k,1283) * lu(k,1278) - lu(k,1284) = lu(k,1284) * lu(k,1278) - lu(k,1285) = lu(k,1285) * lu(k,1278) - lu(k,1286) = lu(k,1286) * lu(k,1278) - lu(k,1287) = lu(k,1287) * lu(k,1278) - lu(k,1326) = lu(k,1326) - lu(k,1279) * lu(k,1324) - lu(k,1328) = - lu(k,1280) * lu(k,1324) - lu(k,1329) = lu(k,1329) - lu(k,1281) * lu(k,1324) - lu(k,1333) = lu(k,1333) - lu(k,1282) * lu(k,1324) - lu(k,1334) = lu(k,1334) - lu(k,1283) * lu(k,1324) - lu(k,1335) = lu(k,1335) - lu(k,1284) * lu(k,1324) - lu(k,1336) = lu(k,1336) - lu(k,1285) * lu(k,1324) - lu(k,1340) = lu(k,1340) - lu(k,1286) * lu(k,1324) - lu(k,1341) = lu(k,1341) - lu(k,1287) * lu(k,1324) - lu(k,1350) = lu(k,1350) - lu(k,1279) * lu(k,1348) - lu(k,1352) = lu(k,1352) - lu(k,1280) * lu(k,1348) - lu(k,1353) = lu(k,1353) - lu(k,1281) * lu(k,1348) - lu(k,1357) = lu(k,1357) - lu(k,1282) * lu(k,1348) - lu(k,1358) = lu(k,1358) - lu(k,1283) * lu(k,1348) - lu(k,1359) = lu(k,1359) - lu(k,1284) * lu(k,1348) - lu(k,1360) = lu(k,1360) - lu(k,1285) * lu(k,1348) - lu(k,1364) = lu(k,1364) - lu(k,1286) * lu(k,1348) - lu(k,1365) = lu(k,1365) - lu(k,1287) * lu(k,1348) - lu(k,1504) = lu(k,1504) - lu(k,1279) * lu(k,1502) - lu(k,1506) = lu(k,1506) - lu(k,1280) * lu(k,1502) - lu(k,1507) = lu(k,1507) - lu(k,1281) * lu(k,1502) - lu(k,1511) = lu(k,1511) - lu(k,1282) * lu(k,1502) - lu(k,1512) = lu(k,1512) - lu(k,1283) * lu(k,1502) - lu(k,1513) = lu(k,1513) - lu(k,1284) * lu(k,1502) - lu(k,1514) = lu(k,1514) - lu(k,1285) * lu(k,1502) - lu(k,1518) = lu(k,1518) - lu(k,1286) * lu(k,1502) - lu(k,1519) = lu(k,1519) - lu(k,1287) * lu(k,1502) - lu(k,1545) = lu(k,1545) - lu(k,1279) * lu(k,1543) - lu(k,1547) = - lu(k,1280) * lu(k,1543) - lu(k,1548) = lu(k,1548) - lu(k,1281) * lu(k,1543) - lu(k,1552) = lu(k,1552) - lu(k,1282) * lu(k,1543) - lu(k,1553) = lu(k,1553) - lu(k,1283) * lu(k,1543) - lu(k,1554) = lu(k,1554) - lu(k,1284) * lu(k,1543) - lu(k,1555) = lu(k,1555) - lu(k,1285) * lu(k,1543) - lu(k,1559) = lu(k,1559) - lu(k,1286) * lu(k,1543) - lu(k,1560) = lu(k,1560) - lu(k,1287) * lu(k,1543) - lu(k,1635) = lu(k,1635) - lu(k,1279) * lu(k,1633) - lu(k,1637) = - lu(k,1280) * lu(k,1633) - lu(k,1638) = lu(k,1638) - lu(k,1281) * lu(k,1633) - lu(k,1642) = lu(k,1642) - lu(k,1282) * lu(k,1633) - lu(k,1643) = lu(k,1643) - lu(k,1283) * lu(k,1633) - lu(k,1644) = lu(k,1644) - lu(k,1284) * lu(k,1633) - lu(k,1645) = lu(k,1645) - lu(k,1285) * lu(k,1633) - lu(k,1649) = lu(k,1649) - lu(k,1286) * lu(k,1633) - lu(k,1650) = lu(k,1650) - lu(k,1287) * lu(k,1633) - lu(k,1709) = lu(k,1709) - lu(k,1279) * lu(k,1707) - lu(k,1711) = - lu(k,1280) * lu(k,1707) - lu(k,1712) = lu(k,1712) - lu(k,1281) * lu(k,1707) - lu(k,1716) = lu(k,1716) - lu(k,1282) * lu(k,1707) - lu(k,1717) = - lu(k,1283) * lu(k,1707) - lu(k,1718) = lu(k,1718) - lu(k,1284) * lu(k,1707) - lu(k,1719) = lu(k,1719) - lu(k,1285) * lu(k,1707) - lu(k,1723) = lu(k,1723) - lu(k,1286) * lu(k,1707) - lu(k,1724) = lu(k,1724) - lu(k,1287) * lu(k,1707) - lu(k,1732) = lu(k,1732) - lu(k,1279) * lu(k,1730) - lu(k,1733) = lu(k,1733) - lu(k,1280) * lu(k,1730) - lu(k,1734) = lu(k,1734) - lu(k,1281) * lu(k,1730) - lu(k,1738) = lu(k,1738) - lu(k,1282) * lu(k,1730) - lu(k,1739) = lu(k,1739) - lu(k,1283) * lu(k,1730) - lu(k,1740) = lu(k,1740) - lu(k,1284) * lu(k,1730) - lu(k,1741) = lu(k,1741) - lu(k,1285) * lu(k,1730) - lu(k,1745) = - lu(k,1286) * lu(k,1730) - lu(k,1746) = lu(k,1746) - lu(k,1287) * lu(k,1730) - lu(k,1836) = lu(k,1836) - lu(k,1279) * lu(k,1834) - lu(k,1838) = lu(k,1838) - lu(k,1280) * lu(k,1834) - lu(k,1839) = lu(k,1839) - lu(k,1281) * lu(k,1834) - lu(k,1843) = lu(k,1843) - lu(k,1282) * lu(k,1834) - lu(k,1844) = lu(k,1844) - lu(k,1283) * lu(k,1834) - lu(k,1845) = lu(k,1845) - lu(k,1284) * lu(k,1834) - lu(k,1846) = lu(k,1846) - lu(k,1285) * lu(k,1834) - lu(k,1850) = lu(k,1850) - lu(k,1286) * lu(k,1834) - lu(k,1851) = lu(k,1851) - lu(k,1287) * lu(k,1834) - lu(k,1866) = lu(k,1866) - lu(k,1279) * lu(k,1864) - lu(k,1868) = lu(k,1868) - lu(k,1280) * lu(k,1864) - lu(k,1869) = lu(k,1869) - lu(k,1281) * lu(k,1864) - lu(k,1873) = lu(k,1873) - lu(k,1282) * lu(k,1864) - lu(k,1874) = lu(k,1874) - lu(k,1283) * lu(k,1864) - lu(k,1875) = lu(k,1875) - lu(k,1284) * lu(k,1864) - lu(k,1876) = lu(k,1876) - lu(k,1285) * lu(k,1864) - lu(k,1880) = lu(k,1880) - lu(k,1286) * lu(k,1864) - lu(k,1881) = lu(k,1881) - lu(k,1287) * lu(k,1864) - lu(k,1889) = lu(k,1889) - lu(k,1279) * lu(k,1887) - lu(k,1891) = lu(k,1891) - lu(k,1280) * lu(k,1887) - lu(k,1892) = lu(k,1892) - lu(k,1281) * lu(k,1887) - lu(k,1896) = lu(k,1896) - lu(k,1282) * lu(k,1887) - lu(k,1897) = - lu(k,1283) * lu(k,1887) - lu(k,1898) = - lu(k,1284) * lu(k,1887) - lu(k,1899) = lu(k,1899) - lu(k,1285) * lu(k,1887) - lu(k,1903) = - lu(k,1286) * lu(k,1887) - lu(k,1904) = lu(k,1904) - lu(k,1287) * lu(k,1887) - lu(k,1923) = lu(k,1923) - lu(k,1279) * lu(k,1921) - lu(k,1925) = lu(k,1925) - lu(k,1280) * lu(k,1921) - lu(k,1926) = lu(k,1926) - lu(k,1281) * lu(k,1921) - lu(k,1930) = - lu(k,1282) * lu(k,1921) - lu(k,1931) = lu(k,1931) - lu(k,1283) * lu(k,1921) - lu(k,1932) = lu(k,1932) - lu(k,1284) * lu(k,1921) - lu(k,1933) = lu(k,1933) - lu(k,1285) * lu(k,1921) - lu(k,1937) = lu(k,1937) - lu(k,1286) * lu(k,1921) - lu(k,1938) = lu(k,1938) - lu(k,1287) * lu(k,1921) - lu(k,1980) = lu(k,1980) - lu(k,1279) * lu(k,1978) - lu(k,1982) = - lu(k,1280) * lu(k,1978) - lu(k,1983) = lu(k,1983) - lu(k,1281) * lu(k,1978) - lu(k,1987) = lu(k,1987) - lu(k,1282) * lu(k,1978) - lu(k,1988) = lu(k,1988) - lu(k,1283) * lu(k,1978) - lu(k,1989) = lu(k,1989) - lu(k,1284) * lu(k,1978) - lu(k,1990) = lu(k,1990) - lu(k,1285) * lu(k,1978) - lu(k,1994) = lu(k,1994) - lu(k,1286) * lu(k,1978) - lu(k,1995) = lu(k,1995) - lu(k,1287) * lu(k,1978) - lu(k,2040) = lu(k,2040) - lu(k,1279) * lu(k,2038) - lu(k,2042) = lu(k,2042) - lu(k,1280) * lu(k,2038) - lu(k,2043) = lu(k,2043) - lu(k,1281) * lu(k,2038) - lu(k,2047) = lu(k,2047) - lu(k,1282) * lu(k,2038) - lu(k,2048) = lu(k,2048) - lu(k,1283) * lu(k,2038) - lu(k,2049) = lu(k,2049) - lu(k,1284) * lu(k,2038) - lu(k,2050) = lu(k,2050) - lu(k,1285) * lu(k,2038) - lu(k,2054) = lu(k,2054) - lu(k,1286) * lu(k,2038) - lu(k,2055) = lu(k,2055) - lu(k,1287) * lu(k,2038) - lu(k,2065) = lu(k,2065) - lu(k,1279) * lu(k,2063) - lu(k,2067) = lu(k,2067) - lu(k,1280) * lu(k,2063) - lu(k,2068) = lu(k,2068) - lu(k,1281) * lu(k,2063) - lu(k,2072) = lu(k,2072) - lu(k,1282) * lu(k,2063) - lu(k,2073) = - lu(k,1283) * lu(k,2063) - lu(k,2074) = lu(k,2074) - lu(k,1284) * lu(k,2063) - lu(k,2075) = lu(k,2075) - lu(k,1285) * lu(k,2063) - lu(k,2079) = lu(k,2079) - lu(k,1286) * lu(k,2063) - lu(k,2080) = lu(k,2080) - lu(k,1287) * lu(k,2063) - lu(k,1291) = 1._r8 / lu(k,1291) - lu(k,1292) = lu(k,1292) * lu(k,1291) - lu(k,1293) = lu(k,1293) * lu(k,1291) - lu(k,1294) = lu(k,1294) * lu(k,1291) - lu(k,1295) = lu(k,1295) * lu(k,1291) - lu(k,1296) = lu(k,1296) * lu(k,1291) - lu(k,1297) = lu(k,1297) * lu(k,1291) - lu(k,1298) = lu(k,1298) * lu(k,1291) - lu(k,1299) = lu(k,1299) * lu(k,1291) - lu(k,1300) = lu(k,1300) * lu(k,1291) - lu(k,1301) = lu(k,1301) * lu(k,1291) - lu(k,1304) = lu(k,1304) - lu(k,1292) * lu(k,1303) - lu(k,1305) = lu(k,1305) - lu(k,1293) * lu(k,1303) - lu(k,1306) = lu(k,1306) - lu(k,1294) * lu(k,1303) - lu(k,1307) = - lu(k,1295) * lu(k,1303) - lu(k,1308) = lu(k,1308) - lu(k,1296) * lu(k,1303) - lu(k,1310) = lu(k,1310) - lu(k,1297) * lu(k,1303) - lu(k,1311) = lu(k,1311) - lu(k,1298) * lu(k,1303) - lu(k,1312) = lu(k,1312) - lu(k,1299) * lu(k,1303) - lu(k,1313) = lu(k,1313) - lu(k,1300) * lu(k,1303) - lu(k,1315) = lu(k,1315) - lu(k,1301) * lu(k,1303) - lu(k,1326) = lu(k,1326) - lu(k,1292) * lu(k,1325) - lu(k,1328) = lu(k,1328) - lu(k,1293) * lu(k,1325) - lu(k,1329) = lu(k,1329) - lu(k,1294) * lu(k,1325) - lu(k,1330) = lu(k,1330) - lu(k,1295) * lu(k,1325) - lu(k,1332) = lu(k,1332) - lu(k,1296) * lu(k,1325) - lu(k,1336) = lu(k,1336) - lu(k,1297) * lu(k,1325) - lu(k,1337) = lu(k,1337) - lu(k,1298) * lu(k,1325) - lu(k,1338) = lu(k,1338) - lu(k,1299) * lu(k,1325) - lu(k,1339) = lu(k,1339) - lu(k,1300) * lu(k,1325) - lu(k,1341) = lu(k,1341) - lu(k,1301) * lu(k,1325) - lu(k,1350) = lu(k,1350) - lu(k,1292) * lu(k,1349) - lu(k,1352) = lu(k,1352) - lu(k,1293) * lu(k,1349) - lu(k,1353) = lu(k,1353) - lu(k,1294) * lu(k,1349) - lu(k,1354) = - lu(k,1295) * lu(k,1349) - lu(k,1356) = lu(k,1356) - lu(k,1296) * lu(k,1349) - lu(k,1360) = lu(k,1360) - lu(k,1297) * lu(k,1349) - lu(k,1361) = lu(k,1361) - lu(k,1298) * lu(k,1349) - lu(k,1362) = lu(k,1362) - lu(k,1299) * lu(k,1349) - lu(k,1363) = lu(k,1363) - lu(k,1300) * lu(k,1349) - lu(k,1365) = lu(k,1365) - lu(k,1301) * lu(k,1349) - lu(k,1504) = lu(k,1504) - lu(k,1292) * lu(k,1503) - lu(k,1506) = lu(k,1506) - lu(k,1293) * lu(k,1503) - lu(k,1507) = lu(k,1507) - lu(k,1294) * lu(k,1503) - lu(k,1508) = lu(k,1508) - lu(k,1295) * lu(k,1503) - lu(k,1510) = lu(k,1510) - lu(k,1296) * lu(k,1503) - lu(k,1514) = lu(k,1514) - lu(k,1297) * lu(k,1503) - lu(k,1515) = lu(k,1515) - lu(k,1298) * lu(k,1503) - lu(k,1516) = lu(k,1516) - lu(k,1299) * lu(k,1503) - lu(k,1517) = lu(k,1517) - lu(k,1300) * lu(k,1503) - lu(k,1519) = lu(k,1519) - lu(k,1301) * lu(k,1503) - lu(k,1545) = lu(k,1545) - lu(k,1292) * lu(k,1544) - lu(k,1547) = lu(k,1547) - lu(k,1293) * lu(k,1544) - lu(k,1548) = lu(k,1548) - lu(k,1294) * lu(k,1544) - lu(k,1549) = lu(k,1549) - lu(k,1295) * lu(k,1544) - lu(k,1551) = lu(k,1551) - lu(k,1296) * lu(k,1544) - lu(k,1555) = lu(k,1555) - lu(k,1297) * lu(k,1544) - lu(k,1556) = lu(k,1556) - lu(k,1298) * lu(k,1544) - lu(k,1557) = lu(k,1557) - lu(k,1299) * lu(k,1544) - lu(k,1558) = lu(k,1558) - lu(k,1300) * lu(k,1544) - lu(k,1560) = lu(k,1560) - lu(k,1301) * lu(k,1544) - lu(k,1635) = lu(k,1635) - lu(k,1292) * lu(k,1634) - lu(k,1637) = lu(k,1637) - lu(k,1293) * lu(k,1634) - lu(k,1638) = lu(k,1638) - lu(k,1294) * lu(k,1634) - lu(k,1639) = lu(k,1639) - lu(k,1295) * lu(k,1634) - lu(k,1641) = lu(k,1641) - lu(k,1296) * lu(k,1634) - lu(k,1645) = lu(k,1645) - lu(k,1297) * lu(k,1634) - lu(k,1646) = - lu(k,1298) * lu(k,1634) - lu(k,1647) = lu(k,1647) - lu(k,1299) * lu(k,1634) - lu(k,1648) = lu(k,1648) - lu(k,1300) * lu(k,1634) - lu(k,1650) = lu(k,1650) - lu(k,1301) * lu(k,1634) - lu(k,1685) = lu(k,1685) - lu(k,1292) * lu(k,1684) - lu(k,1687) = - lu(k,1293) * lu(k,1684) - lu(k,1688) = lu(k,1688) - lu(k,1294) * lu(k,1684) - lu(k,1689) = lu(k,1689) - lu(k,1295) * lu(k,1684) - lu(k,1691) = lu(k,1691) - lu(k,1296) * lu(k,1684) - lu(k,1695) = - lu(k,1297) * lu(k,1684) - lu(k,1696) = - lu(k,1298) * lu(k,1684) - lu(k,1697) = lu(k,1697) - lu(k,1299) * lu(k,1684) - lu(k,1698) = lu(k,1698) - lu(k,1300) * lu(k,1684) - lu(k,1700) = lu(k,1700) - lu(k,1301) * lu(k,1684) - lu(k,1709) = lu(k,1709) - lu(k,1292) * lu(k,1708) - lu(k,1711) = lu(k,1711) - lu(k,1293) * lu(k,1708) - lu(k,1712) = lu(k,1712) - lu(k,1294) * lu(k,1708) - lu(k,1713) = lu(k,1713) - lu(k,1295) * lu(k,1708) - lu(k,1715) = - lu(k,1296) * lu(k,1708) - lu(k,1719) = lu(k,1719) - lu(k,1297) * lu(k,1708) - lu(k,1720) = lu(k,1720) - lu(k,1298) * lu(k,1708) - lu(k,1721) = lu(k,1721) - lu(k,1299) * lu(k,1708) - lu(k,1722) = lu(k,1722) - lu(k,1300) * lu(k,1708) - lu(k,1724) = lu(k,1724) - lu(k,1301) * lu(k,1708) - lu(k,1732) = lu(k,1732) - lu(k,1292) * lu(k,1731) - lu(k,1733) = lu(k,1733) - lu(k,1293) * lu(k,1731) - lu(k,1734) = lu(k,1734) - lu(k,1294) * lu(k,1731) - lu(k,1735) = lu(k,1735) - lu(k,1295) * lu(k,1731) - lu(k,1737) = lu(k,1737) - lu(k,1296) * lu(k,1731) - lu(k,1741) = lu(k,1741) - lu(k,1297) * lu(k,1731) - lu(k,1742) = lu(k,1742) - lu(k,1298) * lu(k,1731) - lu(k,1743) = lu(k,1743) - lu(k,1299) * lu(k,1731) - lu(k,1744) = lu(k,1744) - lu(k,1300) * lu(k,1731) - lu(k,1746) = lu(k,1746) - lu(k,1301) * lu(k,1731) - lu(k,1836) = lu(k,1836) - lu(k,1292) * lu(k,1835) - lu(k,1838) = lu(k,1838) - lu(k,1293) * lu(k,1835) - lu(k,1839) = lu(k,1839) - lu(k,1294) * lu(k,1835) - lu(k,1840) = lu(k,1840) - lu(k,1295) * lu(k,1835) - lu(k,1842) = lu(k,1842) - lu(k,1296) * lu(k,1835) - lu(k,1846) = lu(k,1846) - lu(k,1297) * lu(k,1835) - lu(k,1847) = lu(k,1847) - lu(k,1298) * lu(k,1835) - lu(k,1848) = lu(k,1848) - lu(k,1299) * lu(k,1835) - lu(k,1849) = lu(k,1849) - lu(k,1300) * lu(k,1835) - lu(k,1851) = lu(k,1851) - lu(k,1301) * lu(k,1835) - lu(k,1866) = lu(k,1866) - lu(k,1292) * lu(k,1865) - lu(k,1868) = lu(k,1868) - lu(k,1293) * lu(k,1865) - lu(k,1869) = lu(k,1869) - lu(k,1294) * lu(k,1865) - lu(k,1870) = lu(k,1870) - lu(k,1295) * lu(k,1865) - lu(k,1872) = lu(k,1872) - lu(k,1296) * lu(k,1865) - lu(k,1876) = lu(k,1876) - lu(k,1297) * lu(k,1865) - lu(k,1877) = lu(k,1877) - lu(k,1298) * lu(k,1865) - lu(k,1878) = lu(k,1878) - lu(k,1299) * lu(k,1865) - lu(k,1879) = lu(k,1879) - lu(k,1300) * lu(k,1865) - lu(k,1881) = lu(k,1881) - lu(k,1301) * lu(k,1865) - lu(k,1889) = lu(k,1889) - lu(k,1292) * lu(k,1888) - lu(k,1891) = lu(k,1891) - lu(k,1293) * lu(k,1888) - lu(k,1892) = lu(k,1892) - lu(k,1294) * lu(k,1888) - lu(k,1893) = lu(k,1893) - lu(k,1295) * lu(k,1888) - lu(k,1895) = - lu(k,1296) * lu(k,1888) - lu(k,1899) = lu(k,1899) - lu(k,1297) * lu(k,1888) - lu(k,1900) = lu(k,1900) - lu(k,1298) * lu(k,1888) - lu(k,1901) = lu(k,1901) - lu(k,1299) * lu(k,1888) - lu(k,1902) = lu(k,1902) - lu(k,1300) * lu(k,1888) - lu(k,1904) = lu(k,1904) - lu(k,1301) * lu(k,1888) - lu(k,1923) = lu(k,1923) - lu(k,1292) * lu(k,1922) - lu(k,1925) = lu(k,1925) - lu(k,1293) * lu(k,1922) - lu(k,1926) = lu(k,1926) - lu(k,1294) * lu(k,1922) - lu(k,1927) = lu(k,1927) - lu(k,1295) * lu(k,1922) - lu(k,1929) = lu(k,1929) - lu(k,1296) * lu(k,1922) - lu(k,1933) = lu(k,1933) - lu(k,1297) * lu(k,1922) - lu(k,1934) = lu(k,1934) - lu(k,1298) * lu(k,1922) - lu(k,1935) = lu(k,1935) - lu(k,1299) * lu(k,1922) - lu(k,1936) = lu(k,1936) - lu(k,1300) * lu(k,1922) - lu(k,1938) = lu(k,1938) - lu(k,1301) * lu(k,1922) - lu(k,1980) = lu(k,1980) - lu(k,1292) * lu(k,1979) - lu(k,1982) = lu(k,1982) - lu(k,1293) * lu(k,1979) - lu(k,1983) = lu(k,1983) - lu(k,1294) * lu(k,1979) - lu(k,1984) = lu(k,1984) - lu(k,1295) * lu(k,1979) - lu(k,1986) = lu(k,1986) - lu(k,1296) * lu(k,1979) - lu(k,1990) = lu(k,1990) - lu(k,1297) * lu(k,1979) - lu(k,1991) = - lu(k,1298) * lu(k,1979) - lu(k,1992) = lu(k,1992) - lu(k,1299) * lu(k,1979) - lu(k,1993) = lu(k,1993) - lu(k,1300) * lu(k,1979) - lu(k,1995) = lu(k,1995) - lu(k,1301) * lu(k,1979) - lu(k,2040) = lu(k,2040) - lu(k,1292) * lu(k,2039) - lu(k,2042) = lu(k,2042) - lu(k,1293) * lu(k,2039) - lu(k,2043) = lu(k,2043) - lu(k,1294) * lu(k,2039) - lu(k,2044) = lu(k,2044) - lu(k,1295) * lu(k,2039) - lu(k,2046) = lu(k,2046) - lu(k,1296) * lu(k,2039) - lu(k,2050) = lu(k,2050) - lu(k,1297) * lu(k,2039) - lu(k,2051) = - lu(k,1298) * lu(k,2039) - lu(k,2052) = lu(k,2052) - lu(k,1299) * lu(k,2039) - lu(k,2053) = lu(k,2053) - lu(k,1300) * lu(k,2039) - lu(k,2055) = lu(k,2055) - lu(k,1301) * lu(k,2039) - lu(k,2065) = lu(k,2065) - lu(k,1292) * lu(k,2064) - lu(k,2067) = lu(k,2067) - lu(k,1293) * lu(k,2064) - lu(k,2068) = lu(k,2068) - lu(k,1294) * lu(k,2064) - lu(k,2069) = lu(k,2069) - lu(k,1295) * lu(k,2064) - lu(k,2071) = lu(k,2071) - lu(k,1296) * lu(k,2064) - lu(k,2075) = lu(k,2075) - lu(k,1297) * lu(k,2064) - lu(k,2076) = lu(k,2076) - lu(k,1298) * lu(k,2064) - lu(k,2077) = lu(k,2077) - lu(k,1299) * lu(k,2064) - lu(k,2078) = lu(k,2078) - lu(k,1300) * lu(k,2064) - lu(k,2080) = lu(k,2080) - lu(k,1301) * lu(k,2064) - lu(k,1304) = 1._r8 / lu(k,1304) - lu(k,1305) = lu(k,1305) * lu(k,1304) - lu(k,1306) = lu(k,1306) * lu(k,1304) - lu(k,1307) = lu(k,1307) * lu(k,1304) - lu(k,1308) = lu(k,1308) * lu(k,1304) - lu(k,1309) = lu(k,1309) * lu(k,1304) - lu(k,1310) = lu(k,1310) * lu(k,1304) - lu(k,1311) = lu(k,1311) * lu(k,1304) - lu(k,1312) = lu(k,1312) * lu(k,1304) - lu(k,1313) = lu(k,1313) * lu(k,1304) - lu(k,1314) = lu(k,1314) * lu(k,1304) - lu(k,1315) = lu(k,1315) * lu(k,1304) - lu(k,1328) = lu(k,1328) - lu(k,1305) * lu(k,1326) - lu(k,1329) = lu(k,1329) - lu(k,1306) * lu(k,1326) - lu(k,1330) = lu(k,1330) - lu(k,1307) * lu(k,1326) - lu(k,1332) = lu(k,1332) - lu(k,1308) * lu(k,1326) - lu(k,1335) = lu(k,1335) - lu(k,1309) * lu(k,1326) - lu(k,1336) = lu(k,1336) - lu(k,1310) * lu(k,1326) - lu(k,1337) = lu(k,1337) - lu(k,1311) * lu(k,1326) - lu(k,1338) = lu(k,1338) - lu(k,1312) * lu(k,1326) - lu(k,1339) = lu(k,1339) - lu(k,1313) * lu(k,1326) - lu(k,1340) = lu(k,1340) - lu(k,1314) * lu(k,1326) - lu(k,1341) = lu(k,1341) - lu(k,1315) * lu(k,1326) - lu(k,1352) = lu(k,1352) - lu(k,1305) * lu(k,1350) - lu(k,1353) = lu(k,1353) - lu(k,1306) * lu(k,1350) - lu(k,1354) = lu(k,1354) - lu(k,1307) * lu(k,1350) - lu(k,1356) = lu(k,1356) - lu(k,1308) * lu(k,1350) - lu(k,1359) = lu(k,1359) - lu(k,1309) * lu(k,1350) - lu(k,1360) = lu(k,1360) - lu(k,1310) * lu(k,1350) - lu(k,1361) = lu(k,1361) - lu(k,1311) * lu(k,1350) - lu(k,1362) = lu(k,1362) - lu(k,1312) * lu(k,1350) - lu(k,1363) = lu(k,1363) - lu(k,1313) * lu(k,1350) - lu(k,1364) = lu(k,1364) - lu(k,1314) * lu(k,1350) - lu(k,1365) = lu(k,1365) - lu(k,1315) * lu(k,1350) - lu(k,1506) = lu(k,1506) - lu(k,1305) * lu(k,1504) - lu(k,1507) = lu(k,1507) - lu(k,1306) * lu(k,1504) - lu(k,1508) = lu(k,1508) - lu(k,1307) * lu(k,1504) - lu(k,1510) = lu(k,1510) - lu(k,1308) * lu(k,1504) - lu(k,1513) = lu(k,1513) - lu(k,1309) * lu(k,1504) - lu(k,1514) = lu(k,1514) - lu(k,1310) * lu(k,1504) - lu(k,1515) = lu(k,1515) - lu(k,1311) * lu(k,1504) - lu(k,1516) = lu(k,1516) - lu(k,1312) * lu(k,1504) - lu(k,1517) = lu(k,1517) - lu(k,1313) * lu(k,1504) - lu(k,1518) = lu(k,1518) - lu(k,1314) * lu(k,1504) - lu(k,1519) = lu(k,1519) - lu(k,1315) * lu(k,1504) - lu(k,1547) = lu(k,1547) - lu(k,1305) * lu(k,1545) - lu(k,1548) = lu(k,1548) - lu(k,1306) * lu(k,1545) - lu(k,1549) = lu(k,1549) - lu(k,1307) * lu(k,1545) - lu(k,1551) = lu(k,1551) - lu(k,1308) * lu(k,1545) - lu(k,1554) = lu(k,1554) - lu(k,1309) * lu(k,1545) - lu(k,1555) = lu(k,1555) - lu(k,1310) * lu(k,1545) - lu(k,1556) = lu(k,1556) - lu(k,1311) * lu(k,1545) - lu(k,1557) = lu(k,1557) - lu(k,1312) * lu(k,1545) - lu(k,1558) = lu(k,1558) - lu(k,1313) * lu(k,1545) - lu(k,1559) = lu(k,1559) - lu(k,1314) * lu(k,1545) - lu(k,1560) = lu(k,1560) - lu(k,1315) * lu(k,1545) - lu(k,1637) = lu(k,1637) - lu(k,1305) * lu(k,1635) - lu(k,1638) = lu(k,1638) - lu(k,1306) * lu(k,1635) - lu(k,1639) = lu(k,1639) - lu(k,1307) * lu(k,1635) - lu(k,1641) = lu(k,1641) - lu(k,1308) * lu(k,1635) - lu(k,1644) = lu(k,1644) - lu(k,1309) * lu(k,1635) - lu(k,1645) = lu(k,1645) - lu(k,1310) * lu(k,1635) - lu(k,1646) = lu(k,1646) - lu(k,1311) * lu(k,1635) - lu(k,1647) = lu(k,1647) - lu(k,1312) * lu(k,1635) - lu(k,1648) = lu(k,1648) - lu(k,1313) * lu(k,1635) - lu(k,1649) = lu(k,1649) - lu(k,1314) * lu(k,1635) - lu(k,1650) = lu(k,1650) - lu(k,1315) * lu(k,1635) - lu(k,1687) = lu(k,1687) - lu(k,1305) * lu(k,1685) - lu(k,1688) = lu(k,1688) - lu(k,1306) * lu(k,1685) - lu(k,1689) = lu(k,1689) - lu(k,1307) * lu(k,1685) - lu(k,1691) = lu(k,1691) - lu(k,1308) * lu(k,1685) - lu(k,1694) = lu(k,1694) - lu(k,1309) * lu(k,1685) - lu(k,1695) = lu(k,1695) - lu(k,1310) * lu(k,1685) - lu(k,1696) = lu(k,1696) - lu(k,1311) * lu(k,1685) - lu(k,1697) = lu(k,1697) - lu(k,1312) * lu(k,1685) - lu(k,1698) = lu(k,1698) - lu(k,1313) * lu(k,1685) - lu(k,1699) = lu(k,1699) - lu(k,1314) * lu(k,1685) - lu(k,1700) = lu(k,1700) - lu(k,1315) * lu(k,1685) - lu(k,1711) = lu(k,1711) - lu(k,1305) * lu(k,1709) - lu(k,1712) = lu(k,1712) - lu(k,1306) * lu(k,1709) - lu(k,1713) = lu(k,1713) - lu(k,1307) * lu(k,1709) - lu(k,1715) = lu(k,1715) - lu(k,1308) * lu(k,1709) - lu(k,1718) = lu(k,1718) - lu(k,1309) * lu(k,1709) - lu(k,1719) = lu(k,1719) - lu(k,1310) * lu(k,1709) - lu(k,1720) = lu(k,1720) - lu(k,1311) * lu(k,1709) - lu(k,1721) = lu(k,1721) - lu(k,1312) * lu(k,1709) - lu(k,1722) = lu(k,1722) - lu(k,1313) * lu(k,1709) - lu(k,1723) = lu(k,1723) - lu(k,1314) * lu(k,1709) - lu(k,1724) = lu(k,1724) - lu(k,1315) * lu(k,1709) - lu(k,1733) = lu(k,1733) - lu(k,1305) * lu(k,1732) - lu(k,1734) = lu(k,1734) - lu(k,1306) * lu(k,1732) - lu(k,1735) = lu(k,1735) - lu(k,1307) * lu(k,1732) - lu(k,1737) = lu(k,1737) - lu(k,1308) * lu(k,1732) - lu(k,1740) = lu(k,1740) - lu(k,1309) * lu(k,1732) - lu(k,1741) = lu(k,1741) - lu(k,1310) * lu(k,1732) - lu(k,1742) = lu(k,1742) - lu(k,1311) * lu(k,1732) - lu(k,1743) = lu(k,1743) - lu(k,1312) * lu(k,1732) - lu(k,1744) = lu(k,1744) - lu(k,1313) * lu(k,1732) - lu(k,1745) = lu(k,1745) - lu(k,1314) * lu(k,1732) - lu(k,1746) = lu(k,1746) - lu(k,1315) * lu(k,1732) - lu(k,1838) = lu(k,1838) - lu(k,1305) * lu(k,1836) - lu(k,1839) = lu(k,1839) - lu(k,1306) * lu(k,1836) - lu(k,1840) = lu(k,1840) - lu(k,1307) * lu(k,1836) - lu(k,1842) = lu(k,1842) - lu(k,1308) * lu(k,1836) - lu(k,1845) = lu(k,1845) - lu(k,1309) * lu(k,1836) - lu(k,1846) = lu(k,1846) - lu(k,1310) * lu(k,1836) - lu(k,1847) = lu(k,1847) - lu(k,1311) * lu(k,1836) - lu(k,1848) = lu(k,1848) - lu(k,1312) * lu(k,1836) - lu(k,1849) = lu(k,1849) - lu(k,1313) * lu(k,1836) - lu(k,1850) = lu(k,1850) - lu(k,1314) * lu(k,1836) - lu(k,1851) = lu(k,1851) - lu(k,1315) * lu(k,1836) - lu(k,1868) = lu(k,1868) - lu(k,1305) * lu(k,1866) - lu(k,1869) = lu(k,1869) - lu(k,1306) * lu(k,1866) - lu(k,1870) = lu(k,1870) - lu(k,1307) * lu(k,1866) - lu(k,1872) = lu(k,1872) - lu(k,1308) * lu(k,1866) - lu(k,1875) = lu(k,1875) - lu(k,1309) * lu(k,1866) - lu(k,1876) = lu(k,1876) - lu(k,1310) * lu(k,1866) - lu(k,1877) = lu(k,1877) - lu(k,1311) * lu(k,1866) - lu(k,1878) = lu(k,1878) - lu(k,1312) * lu(k,1866) - lu(k,1879) = lu(k,1879) - lu(k,1313) * lu(k,1866) - lu(k,1880) = lu(k,1880) - lu(k,1314) * lu(k,1866) - lu(k,1881) = lu(k,1881) - lu(k,1315) * lu(k,1866) - lu(k,1891) = lu(k,1891) - lu(k,1305) * lu(k,1889) - lu(k,1892) = lu(k,1892) - lu(k,1306) * lu(k,1889) - lu(k,1893) = lu(k,1893) - lu(k,1307) * lu(k,1889) - lu(k,1895) = lu(k,1895) - lu(k,1308) * lu(k,1889) - lu(k,1898) = lu(k,1898) - lu(k,1309) * lu(k,1889) - lu(k,1899) = lu(k,1899) - lu(k,1310) * lu(k,1889) - lu(k,1900) = lu(k,1900) - lu(k,1311) * lu(k,1889) - lu(k,1901) = lu(k,1901) - lu(k,1312) * lu(k,1889) - lu(k,1902) = lu(k,1902) - lu(k,1313) * lu(k,1889) - lu(k,1903) = lu(k,1903) - lu(k,1314) * lu(k,1889) - lu(k,1904) = lu(k,1904) - lu(k,1315) * lu(k,1889) - lu(k,1925) = lu(k,1925) - lu(k,1305) * lu(k,1923) - lu(k,1926) = lu(k,1926) - lu(k,1306) * lu(k,1923) - lu(k,1927) = lu(k,1927) - lu(k,1307) * lu(k,1923) - lu(k,1929) = lu(k,1929) - lu(k,1308) * lu(k,1923) - lu(k,1932) = lu(k,1932) - lu(k,1309) * lu(k,1923) - lu(k,1933) = lu(k,1933) - lu(k,1310) * lu(k,1923) - lu(k,1934) = lu(k,1934) - lu(k,1311) * lu(k,1923) - lu(k,1935) = lu(k,1935) - lu(k,1312) * lu(k,1923) - lu(k,1936) = lu(k,1936) - lu(k,1313) * lu(k,1923) - lu(k,1937) = lu(k,1937) - lu(k,1314) * lu(k,1923) - lu(k,1938) = lu(k,1938) - lu(k,1315) * lu(k,1923) - lu(k,1982) = lu(k,1982) - lu(k,1305) * lu(k,1980) - lu(k,1983) = lu(k,1983) - lu(k,1306) * lu(k,1980) - lu(k,1984) = lu(k,1984) - lu(k,1307) * lu(k,1980) - lu(k,1986) = lu(k,1986) - lu(k,1308) * lu(k,1980) - lu(k,1989) = lu(k,1989) - lu(k,1309) * lu(k,1980) - lu(k,1990) = lu(k,1990) - lu(k,1310) * lu(k,1980) - lu(k,1991) = lu(k,1991) - lu(k,1311) * lu(k,1980) - lu(k,1992) = lu(k,1992) - lu(k,1312) * lu(k,1980) - lu(k,1993) = lu(k,1993) - lu(k,1313) * lu(k,1980) - lu(k,1994) = lu(k,1994) - lu(k,1314) * lu(k,1980) - lu(k,1995) = lu(k,1995) - lu(k,1315) * lu(k,1980) - lu(k,2042) = lu(k,2042) - lu(k,1305) * lu(k,2040) - lu(k,2043) = lu(k,2043) - lu(k,1306) * lu(k,2040) - lu(k,2044) = lu(k,2044) - lu(k,1307) * lu(k,2040) - lu(k,2046) = lu(k,2046) - lu(k,1308) * lu(k,2040) - lu(k,2049) = lu(k,2049) - lu(k,1309) * lu(k,2040) - lu(k,2050) = lu(k,2050) - lu(k,1310) * lu(k,2040) - lu(k,2051) = lu(k,2051) - lu(k,1311) * lu(k,2040) - lu(k,2052) = lu(k,2052) - lu(k,1312) * lu(k,2040) - lu(k,2053) = lu(k,2053) - lu(k,1313) * lu(k,2040) - lu(k,2054) = lu(k,2054) - lu(k,1314) * lu(k,2040) - lu(k,2055) = lu(k,2055) - lu(k,1315) * lu(k,2040) - lu(k,2067) = lu(k,2067) - lu(k,1305) * lu(k,2065) - lu(k,2068) = lu(k,2068) - lu(k,1306) * lu(k,2065) - lu(k,2069) = lu(k,2069) - lu(k,1307) * lu(k,2065) - lu(k,2071) = lu(k,2071) - lu(k,1308) * lu(k,2065) - lu(k,2074) = lu(k,2074) - lu(k,1309) * lu(k,2065) - lu(k,2075) = lu(k,2075) - lu(k,1310) * lu(k,2065) - lu(k,2076) = lu(k,2076) - lu(k,1311) * lu(k,2065) - lu(k,2077) = lu(k,2077) - lu(k,1312) * lu(k,2065) - lu(k,2078) = lu(k,2078) - lu(k,1313) * lu(k,2065) - lu(k,2079) = lu(k,2079) - lu(k,1314) * lu(k,2065) - lu(k,2080) = lu(k,2080) - lu(k,1315) * lu(k,2065) + lu(k,1221) = 1._r8 / lu(k,1221) + lu(k,1222) = lu(k,1222) * lu(k,1221) + lu(k,1223) = lu(k,1223) * lu(k,1221) + lu(k,1224) = lu(k,1224) * lu(k,1221) + lu(k,1225) = lu(k,1225) * lu(k,1221) + lu(k,1226) = lu(k,1226) * lu(k,1221) + lu(k,1227) = lu(k,1227) * lu(k,1221) + lu(k,1228) = lu(k,1228) * lu(k,1221) + lu(k,1260) = lu(k,1260) - lu(k,1222) * lu(k,1255) + lu(k,1261) = lu(k,1261) - lu(k,1223) * lu(k,1255) + lu(k,1263) = lu(k,1263) - lu(k,1224) * lu(k,1255) + lu(k,1264) = lu(k,1264) - lu(k,1225) * lu(k,1255) + lu(k,1266) = lu(k,1266) - lu(k,1226) * lu(k,1255) + lu(k,1270) = lu(k,1270) - lu(k,1227) * lu(k,1255) + lu(k,1271) = lu(k,1271) - lu(k,1228) * lu(k,1255) + lu(k,1292) = lu(k,1292) - lu(k,1222) * lu(k,1287) + lu(k,1293) = lu(k,1293) - lu(k,1223) * lu(k,1287) + lu(k,1295) = lu(k,1295) - lu(k,1224) * lu(k,1287) + lu(k,1296) = lu(k,1296) - lu(k,1225) * lu(k,1287) + lu(k,1298) = lu(k,1298) - lu(k,1226) * lu(k,1287) + lu(k,1302) = lu(k,1302) - lu(k,1227) * lu(k,1287) + lu(k,1303) = lu(k,1303) - lu(k,1228) * lu(k,1287) + lu(k,1313) = lu(k,1313) - lu(k,1222) * lu(k,1310) + lu(k,1314) = lu(k,1314) - lu(k,1223) * lu(k,1310) + lu(k,1316) = lu(k,1316) - lu(k,1224) * lu(k,1310) + lu(k,1317) = lu(k,1317) - lu(k,1225) * lu(k,1310) + lu(k,1319) = lu(k,1319) - lu(k,1226) * lu(k,1310) + lu(k,1322) = lu(k,1322) - lu(k,1227) * lu(k,1310) + lu(k,1323) = lu(k,1323) - lu(k,1228) * lu(k,1310) + lu(k,1334) = lu(k,1334) - lu(k,1222) * lu(k,1330) + lu(k,1336) = lu(k,1336) - lu(k,1223) * lu(k,1330) + lu(k,1338) = lu(k,1338) - lu(k,1224) * lu(k,1330) + lu(k,1339) = lu(k,1339) - lu(k,1225) * lu(k,1330) + lu(k,1341) = lu(k,1341) - lu(k,1226) * lu(k,1330) + lu(k,1345) = lu(k,1345) - lu(k,1227) * lu(k,1330) + lu(k,1346) = lu(k,1346) - lu(k,1228) * lu(k,1330) + lu(k,1355) = lu(k,1355) - lu(k,1222) * lu(k,1353) + lu(k,1356) = - lu(k,1223) * lu(k,1353) + lu(k,1358) = lu(k,1358) - lu(k,1224) * lu(k,1353) + lu(k,1359) = lu(k,1359) - lu(k,1225) * lu(k,1353) + lu(k,1361) = lu(k,1361) - lu(k,1226) * lu(k,1353) + lu(k,1365) = lu(k,1365) - lu(k,1227) * lu(k,1353) + lu(k,1366) = lu(k,1366) - lu(k,1228) * lu(k,1353) + lu(k,1386) = lu(k,1386) - lu(k,1222) * lu(k,1380) + lu(k,1388) = lu(k,1388) - lu(k,1223) * lu(k,1380) + lu(k,1390) = lu(k,1390) - lu(k,1224) * lu(k,1380) + lu(k,1391) = lu(k,1391) - lu(k,1225) * lu(k,1380) + lu(k,1393) = lu(k,1393) - lu(k,1226) * lu(k,1380) + lu(k,1397) = lu(k,1397) - lu(k,1227) * lu(k,1380) + lu(k,1398) = lu(k,1398) - lu(k,1228) * lu(k,1380) + lu(k,1683) = lu(k,1683) - lu(k,1222) * lu(k,1676) + lu(k,1687) = lu(k,1687) - lu(k,1223) * lu(k,1676) + lu(k,1691) = lu(k,1691) - lu(k,1224) * lu(k,1676) + lu(k,1692) = lu(k,1692) - lu(k,1225) * lu(k,1676) + lu(k,1694) = lu(k,1694) - lu(k,1226) * lu(k,1676) + lu(k,1702) = lu(k,1702) - lu(k,1227) * lu(k,1676) + lu(k,1703) = lu(k,1703) - lu(k,1228) * lu(k,1676) + lu(k,1741) = lu(k,1741) - lu(k,1222) * lu(k,1734) + lu(k,1744) = lu(k,1744) - lu(k,1223) * lu(k,1734) + lu(k,1748) = lu(k,1748) - lu(k,1224) * lu(k,1734) + lu(k,1749) = lu(k,1749) - lu(k,1225) * lu(k,1734) + lu(k,1751) = lu(k,1751) - lu(k,1226) * lu(k,1734) + lu(k,1759) = lu(k,1759) - lu(k,1227) * lu(k,1734) + lu(k,1760) = lu(k,1760) - lu(k,1228) * lu(k,1734) + lu(k,1833) = lu(k,1833) - lu(k,1222) * lu(k,1827) + lu(k,1836) = lu(k,1836) - lu(k,1223) * lu(k,1827) + lu(k,1840) = lu(k,1840) - lu(k,1224) * lu(k,1827) + lu(k,1841) = lu(k,1841) - lu(k,1225) * lu(k,1827) + lu(k,1843) = lu(k,1843) - lu(k,1226) * lu(k,1827) + lu(k,1851) = lu(k,1851) - lu(k,1227) * lu(k,1827) + lu(k,1852) = lu(k,1852) - lu(k,1228) * lu(k,1827) + lu(k,1939) = lu(k,1939) - lu(k,1222) * lu(k,1933) + lu(k,1943) = lu(k,1943) - lu(k,1223) * lu(k,1933) + lu(k,1947) = lu(k,1947) - lu(k,1224) * lu(k,1933) + lu(k,1948) = lu(k,1948) - lu(k,1225) * lu(k,1933) + lu(k,1950) = lu(k,1950) - lu(k,1226) * lu(k,1933) + lu(k,1958) = lu(k,1958) - lu(k,1227) * lu(k,1933) + lu(k,1959) = lu(k,1959) - lu(k,1228) * lu(k,1933) + lu(k,2058) = lu(k,2058) - lu(k,1222) * lu(k,2052) + lu(k,2060) = lu(k,2060) - lu(k,1223) * lu(k,2052) + lu(k,2064) = lu(k,2064) - lu(k,1224) * lu(k,2052) + lu(k,2065) = lu(k,2065) - lu(k,1225) * lu(k,2052) + lu(k,2067) = lu(k,2067) - lu(k,1226) * lu(k,2052) + lu(k,2075) = lu(k,2075) - lu(k,1227) * lu(k,2052) + lu(k,2076) = lu(k,2076) - lu(k,1228) * lu(k,2052) + lu(k,2118) = lu(k,2118) - lu(k,1222) * lu(k,2111) + lu(k,2121) = lu(k,2121) - lu(k,1223) * lu(k,2111) + lu(k,2125) = lu(k,2125) - lu(k,1224) * lu(k,2111) + lu(k,2126) = lu(k,2126) - lu(k,1225) * lu(k,2111) + lu(k,2128) = lu(k,2128) - lu(k,1226) * lu(k,2111) + lu(k,2136) = lu(k,2136) - lu(k,1227) * lu(k,2111) + lu(k,2137) = lu(k,2137) - lu(k,1228) * lu(k,2111) + lu(k,2185) = lu(k,2185) - lu(k,1222) * lu(k,2182) + lu(k,2188) = lu(k,2188) - lu(k,1223) * lu(k,2182) + lu(k,2192) = lu(k,2192) - lu(k,1224) * lu(k,2182) + lu(k,2193) = lu(k,2193) - lu(k,1225) * lu(k,2182) + lu(k,2195) = lu(k,2195) - lu(k,1226) * lu(k,2182) + lu(k,2203) = lu(k,2203) - lu(k,1227) * lu(k,2182) + lu(k,2204) = lu(k,2204) - lu(k,1228) * lu(k,2182) + lu(k,1232) = 1._r8 / lu(k,1232) + lu(k,1233) = lu(k,1233) * lu(k,1232) + lu(k,1234) = lu(k,1234) * lu(k,1232) + lu(k,1235) = lu(k,1235) * lu(k,1232) + lu(k,1236) = lu(k,1236) * lu(k,1232) + lu(k,1237) = lu(k,1237) * lu(k,1232) + lu(k,1238) = lu(k,1238) * lu(k,1232) + lu(k,1239) = lu(k,1239) * lu(k,1232) + lu(k,1240) = lu(k,1240) * lu(k,1232) + lu(k,1241) = lu(k,1241) * lu(k,1232) + lu(k,1242) = lu(k,1242) * lu(k,1232) + lu(k,1243) = lu(k,1243) * lu(k,1232) + lu(k,1244) = lu(k,1244) * lu(k,1232) + lu(k,1685) = lu(k,1685) - lu(k,1233) * lu(k,1677) + lu(k,1688) = lu(k,1688) - lu(k,1234) * lu(k,1677) + lu(k,1691) = lu(k,1691) - lu(k,1235) * lu(k,1677) + lu(k,1693) = lu(k,1693) - lu(k,1236) * lu(k,1677) + lu(k,1694) = lu(k,1694) - lu(k,1237) * lu(k,1677) + lu(k,1695) = lu(k,1695) - lu(k,1238) * lu(k,1677) + lu(k,1696) = lu(k,1696) - lu(k,1239) * lu(k,1677) + lu(k,1698) = lu(k,1698) - lu(k,1240) * lu(k,1677) + lu(k,1700) = lu(k,1700) - lu(k,1241) * lu(k,1677) + lu(k,1701) = lu(k,1701) - lu(k,1242) * lu(k,1677) + lu(k,1702) = lu(k,1702) - lu(k,1243) * lu(k,1677) + lu(k,1703) = lu(k,1703) - lu(k,1244) * lu(k,1677) + lu(k,1742) = - lu(k,1233) * lu(k,1735) + lu(k,1745) = - lu(k,1234) * lu(k,1735) + lu(k,1748) = lu(k,1748) - lu(k,1235) * lu(k,1735) + lu(k,1750) = lu(k,1750) - lu(k,1236) * lu(k,1735) + lu(k,1751) = lu(k,1751) - lu(k,1237) * lu(k,1735) + lu(k,1752) = - lu(k,1238) * lu(k,1735) + lu(k,1753) = - lu(k,1239) * lu(k,1735) + lu(k,1755) = lu(k,1755) - lu(k,1240) * lu(k,1735) + lu(k,1757) = lu(k,1757) - lu(k,1241) * lu(k,1735) + lu(k,1758) = - lu(k,1242) * lu(k,1735) + lu(k,1759) = lu(k,1759) - lu(k,1243) * lu(k,1735) + lu(k,1760) = lu(k,1760) - lu(k,1244) * lu(k,1735) + lu(k,1968) = lu(k,1968) - lu(k,1233) * lu(k,1967) + lu(k,1970) = - lu(k,1234) * lu(k,1967) + lu(k,1973) = lu(k,1973) - lu(k,1235) * lu(k,1967) + lu(k,1975) = lu(k,1975) - lu(k,1236) * lu(k,1967) + lu(k,1976) = lu(k,1976) - lu(k,1237) * lu(k,1967) + lu(k,1977) = lu(k,1977) - lu(k,1238) * lu(k,1967) + lu(k,1978) = lu(k,1978) - lu(k,1239) * lu(k,1967) + lu(k,1980) = - lu(k,1240) * lu(k,1967) + lu(k,1982) = lu(k,1982) - lu(k,1241) * lu(k,1967) + lu(k,1983) = lu(k,1983) - lu(k,1242) * lu(k,1967) + lu(k,1984) = lu(k,1984) - lu(k,1243) * lu(k,1967) + lu(k,1985) = lu(k,1985) - lu(k,1244) * lu(k,1967) + lu(k,2119) = lu(k,2119) - lu(k,1233) * lu(k,2112) + lu(k,2122) = lu(k,2122) - lu(k,1234) * lu(k,2112) + lu(k,2125) = lu(k,2125) - lu(k,1235) * lu(k,2112) + lu(k,2127) = lu(k,2127) - lu(k,1236) * lu(k,2112) + lu(k,2128) = lu(k,2128) - lu(k,1237) * lu(k,2112) + lu(k,2129) = lu(k,2129) - lu(k,1238) * lu(k,2112) + lu(k,2130) = lu(k,2130) - lu(k,1239) * lu(k,2112) + lu(k,2132) = lu(k,2132) - lu(k,1240) * lu(k,2112) + lu(k,2134) = lu(k,2134) - lu(k,1241) * lu(k,2112) + lu(k,2135) = lu(k,2135) - lu(k,1242) * lu(k,2112) + lu(k,2136) = lu(k,2136) - lu(k,1243) * lu(k,2112) + lu(k,2137) = lu(k,2137) - lu(k,1244) * lu(k,2112) + lu(k,2186) = lu(k,2186) - lu(k,1233) * lu(k,2183) + lu(k,2189) = lu(k,2189) - lu(k,1234) * lu(k,2183) + lu(k,2192) = lu(k,2192) - lu(k,1235) * lu(k,2183) + lu(k,2194) = lu(k,2194) - lu(k,1236) * lu(k,2183) + lu(k,2195) = lu(k,2195) - lu(k,1237) * lu(k,2183) + lu(k,2196) = lu(k,2196) - lu(k,1238) * lu(k,2183) + lu(k,2197) = lu(k,2197) - lu(k,1239) * lu(k,2183) + lu(k,2199) = lu(k,2199) - lu(k,1240) * lu(k,2183) + lu(k,2201) = lu(k,2201) - lu(k,1241) * lu(k,2183) + lu(k,2202) = lu(k,2202) - lu(k,1242) * lu(k,2183) + lu(k,2203) = lu(k,2203) - lu(k,1243) * lu(k,2183) + lu(k,2204) = lu(k,2204) - lu(k,1244) * lu(k,2183) + lu(k,2211) = lu(k,2211) - lu(k,1233) * lu(k,2210) + lu(k,2213) = - lu(k,1234) * lu(k,2210) + lu(k,2216) = lu(k,2216) - lu(k,1235) * lu(k,2210) + lu(k,2218) = lu(k,2218) - lu(k,1236) * lu(k,2210) + lu(k,2219) = lu(k,2219) - lu(k,1237) * lu(k,2210) + lu(k,2220) = lu(k,2220) - lu(k,1238) * lu(k,2210) + lu(k,2221) = lu(k,2221) - lu(k,1239) * lu(k,2210) + lu(k,2223) = - lu(k,1240) * lu(k,2210) + lu(k,2225) = lu(k,2225) - lu(k,1241) * lu(k,2210) + lu(k,2226) = lu(k,2226) - lu(k,1242) * lu(k,2210) + lu(k,2227) = lu(k,2227) - lu(k,1243) * lu(k,2210) + lu(k,2228) = lu(k,2228) - lu(k,1244) * lu(k,2210) + lu(k,2241) = lu(k,2241) - lu(k,1233) * lu(k,2239) + lu(k,2244) = lu(k,2244) - lu(k,1234) * lu(k,2239) + lu(k,2247) = lu(k,2247) - lu(k,1235) * lu(k,2239) + lu(k,2249) = lu(k,2249) - lu(k,1236) * lu(k,2239) + lu(k,2250) = lu(k,2250) - lu(k,1237) * lu(k,2239) + lu(k,2251) = lu(k,2251) - lu(k,1238) * lu(k,2239) + lu(k,2252) = lu(k,2252) - lu(k,1239) * lu(k,2239) + lu(k,2254) = lu(k,2254) - lu(k,1240) * lu(k,2239) + lu(k,2256) = lu(k,2256) - lu(k,1241) * lu(k,2239) + lu(k,2257) = lu(k,2257) - lu(k,1242) * lu(k,2239) + lu(k,2258) = lu(k,2258) - lu(k,1243) * lu(k,2239) + lu(k,2259) = lu(k,2259) - lu(k,1244) * lu(k,2239) + lu(k,2267) = - lu(k,1233) * lu(k,2265) + lu(k,2270) = lu(k,2270) - lu(k,1234) * lu(k,2265) + lu(k,2273) = lu(k,2273) - lu(k,1235) * lu(k,2265) + lu(k,2275) = - lu(k,1236) * lu(k,2265) + lu(k,2276) = lu(k,2276) - lu(k,1237) * lu(k,2265) + lu(k,2277) = - lu(k,1238) * lu(k,2265) + lu(k,2278) = - lu(k,1239) * lu(k,2265) + lu(k,2280) = - lu(k,1240) * lu(k,2265) + lu(k,2282) = - lu(k,1241) * lu(k,2265) + lu(k,2283) = - lu(k,1242) * lu(k,2265) + lu(k,2284) = lu(k,2284) - lu(k,1243) * lu(k,2265) + lu(k,2285) = lu(k,2285) - lu(k,1244) * lu(k,2265) + lu(k,1256) = 1._r8 / lu(k,1256) + lu(k,1257) = lu(k,1257) * lu(k,1256) + lu(k,1258) = lu(k,1258) * lu(k,1256) + lu(k,1259) = lu(k,1259) * lu(k,1256) + lu(k,1260) = lu(k,1260) * lu(k,1256) + lu(k,1261) = lu(k,1261) * lu(k,1256) + lu(k,1262) = lu(k,1262) * lu(k,1256) + lu(k,1263) = lu(k,1263) * lu(k,1256) + lu(k,1264) = lu(k,1264) * lu(k,1256) + lu(k,1265) = lu(k,1265) * lu(k,1256) + lu(k,1266) = lu(k,1266) * lu(k,1256) + lu(k,1267) = lu(k,1267) * lu(k,1256) + lu(k,1268) = lu(k,1268) * lu(k,1256) + lu(k,1269) = lu(k,1269) * lu(k,1256) + lu(k,1270) = lu(k,1270) * lu(k,1256) + lu(k,1271) = lu(k,1271) * lu(k,1256) + lu(k,1383) = lu(k,1383) - lu(k,1257) * lu(k,1381) + lu(k,1384) = lu(k,1384) - lu(k,1258) * lu(k,1381) + lu(k,1385) = lu(k,1385) - lu(k,1259) * lu(k,1381) + lu(k,1386) = lu(k,1386) - lu(k,1260) * lu(k,1381) + lu(k,1388) = lu(k,1388) - lu(k,1261) * lu(k,1381) + lu(k,1389) = lu(k,1389) - lu(k,1262) * lu(k,1381) + lu(k,1390) = lu(k,1390) - lu(k,1263) * lu(k,1381) + lu(k,1391) = lu(k,1391) - lu(k,1264) * lu(k,1381) + lu(k,1392) = lu(k,1392) - lu(k,1265) * lu(k,1381) + lu(k,1393) = lu(k,1393) - lu(k,1266) * lu(k,1381) + lu(k,1394) = lu(k,1394) - lu(k,1267) * lu(k,1381) + lu(k,1395) = lu(k,1395) - lu(k,1268) * lu(k,1381) + lu(k,1396) = lu(k,1396) - lu(k,1269) * lu(k,1381) + lu(k,1397) = lu(k,1397) - lu(k,1270) * lu(k,1381) + lu(k,1398) = lu(k,1398) - lu(k,1271) * lu(k,1381) + lu(k,1680) = lu(k,1680) - lu(k,1257) * lu(k,1678) + lu(k,1681) = lu(k,1681) - lu(k,1258) * lu(k,1678) + lu(k,1682) = lu(k,1682) - lu(k,1259) * lu(k,1678) + lu(k,1683) = lu(k,1683) - lu(k,1260) * lu(k,1678) + lu(k,1687) = lu(k,1687) - lu(k,1261) * lu(k,1678) + lu(k,1689) = lu(k,1689) - lu(k,1262) * lu(k,1678) + lu(k,1691) = lu(k,1691) - lu(k,1263) * lu(k,1678) + lu(k,1692) = lu(k,1692) - lu(k,1264) * lu(k,1678) + lu(k,1693) = lu(k,1693) - lu(k,1265) * lu(k,1678) + lu(k,1694) = lu(k,1694) - lu(k,1266) * lu(k,1678) + lu(k,1697) = lu(k,1697) - lu(k,1267) * lu(k,1678) + lu(k,1698) = lu(k,1698) - lu(k,1268) * lu(k,1678) + lu(k,1700) = lu(k,1700) - lu(k,1269) * lu(k,1678) + lu(k,1702) = lu(k,1702) - lu(k,1270) * lu(k,1678) + lu(k,1703) = lu(k,1703) - lu(k,1271) * lu(k,1678) + lu(k,1738) = lu(k,1738) - lu(k,1257) * lu(k,1736) + lu(k,1739) = lu(k,1739) - lu(k,1258) * lu(k,1736) + lu(k,1740) = lu(k,1740) - lu(k,1259) * lu(k,1736) + lu(k,1741) = lu(k,1741) - lu(k,1260) * lu(k,1736) + lu(k,1744) = lu(k,1744) - lu(k,1261) * lu(k,1736) + lu(k,1746) = lu(k,1746) - lu(k,1262) * lu(k,1736) + lu(k,1748) = lu(k,1748) - lu(k,1263) * lu(k,1736) + lu(k,1749) = lu(k,1749) - lu(k,1264) * lu(k,1736) + lu(k,1750) = lu(k,1750) - lu(k,1265) * lu(k,1736) + lu(k,1751) = lu(k,1751) - lu(k,1266) * lu(k,1736) + lu(k,1754) = lu(k,1754) - lu(k,1267) * lu(k,1736) + lu(k,1755) = lu(k,1755) - lu(k,1268) * lu(k,1736) + lu(k,1757) = lu(k,1757) - lu(k,1269) * lu(k,1736) + lu(k,1759) = lu(k,1759) - lu(k,1270) * lu(k,1736) + lu(k,1760) = lu(k,1760) - lu(k,1271) * lu(k,1736) + lu(k,1830) = lu(k,1830) - lu(k,1257) * lu(k,1828) + lu(k,1831) = lu(k,1831) - lu(k,1258) * lu(k,1828) + lu(k,1832) = lu(k,1832) - lu(k,1259) * lu(k,1828) + lu(k,1833) = lu(k,1833) - lu(k,1260) * lu(k,1828) + lu(k,1836) = lu(k,1836) - lu(k,1261) * lu(k,1828) + lu(k,1838) = lu(k,1838) - lu(k,1262) * lu(k,1828) + lu(k,1840) = lu(k,1840) - lu(k,1263) * lu(k,1828) + lu(k,1841) = lu(k,1841) - lu(k,1264) * lu(k,1828) + lu(k,1842) = lu(k,1842) - lu(k,1265) * lu(k,1828) + lu(k,1843) = lu(k,1843) - lu(k,1266) * lu(k,1828) + lu(k,1846) = lu(k,1846) - lu(k,1267) * lu(k,1828) + lu(k,1847) = lu(k,1847) - lu(k,1268) * lu(k,1828) + lu(k,1849) = lu(k,1849) - lu(k,1269) * lu(k,1828) + lu(k,1851) = lu(k,1851) - lu(k,1270) * lu(k,1828) + lu(k,1852) = lu(k,1852) - lu(k,1271) * lu(k,1828) + lu(k,1936) = lu(k,1936) - lu(k,1257) * lu(k,1934) + lu(k,1937) = lu(k,1937) - lu(k,1258) * lu(k,1934) + lu(k,1938) = lu(k,1938) - lu(k,1259) * lu(k,1934) + lu(k,1939) = lu(k,1939) - lu(k,1260) * lu(k,1934) + lu(k,1943) = lu(k,1943) - lu(k,1261) * lu(k,1934) + lu(k,1945) = lu(k,1945) - lu(k,1262) * lu(k,1934) + lu(k,1947) = lu(k,1947) - lu(k,1263) * lu(k,1934) + lu(k,1948) = lu(k,1948) - lu(k,1264) * lu(k,1934) + lu(k,1949) = lu(k,1949) - lu(k,1265) * lu(k,1934) + lu(k,1950) = lu(k,1950) - lu(k,1266) * lu(k,1934) + lu(k,1953) = lu(k,1953) - lu(k,1267) * lu(k,1934) + lu(k,1954) = lu(k,1954) - lu(k,1268) * lu(k,1934) + lu(k,1956) = lu(k,1956) - lu(k,1269) * lu(k,1934) + lu(k,1958) = lu(k,1958) - lu(k,1270) * lu(k,1934) + lu(k,1959) = lu(k,1959) - lu(k,1271) * lu(k,1934) + lu(k,2055) = lu(k,2055) - lu(k,1257) * lu(k,2053) + lu(k,2056) = lu(k,2056) - lu(k,1258) * lu(k,2053) + lu(k,2057) = lu(k,2057) - lu(k,1259) * lu(k,2053) + lu(k,2058) = lu(k,2058) - lu(k,1260) * lu(k,2053) + lu(k,2060) = lu(k,2060) - lu(k,1261) * lu(k,2053) + lu(k,2062) = lu(k,2062) - lu(k,1262) * lu(k,2053) + lu(k,2064) = lu(k,2064) - lu(k,1263) * lu(k,2053) + lu(k,2065) = lu(k,2065) - lu(k,1264) * lu(k,2053) + lu(k,2066) = lu(k,2066) - lu(k,1265) * lu(k,2053) + lu(k,2067) = lu(k,2067) - lu(k,1266) * lu(k,2053) + lu(k,2070) = lu(k,2070) - lu(k,1267) * lu(k,2053) + lu(k,2071) = lu(k,2071) - lu(k,1268) * lu(k,2053) + lu(k,2073) = lu(k,2073) - lu(k,1269) * lu(k,2053) + lu(k,2075) = lu(k,2075) - lu(k,1270) * lu(k,2053) + lu(k,2076) = lu(k,2076) - lu(k,1271) * lu(k,2053) + lu(k,2115) = lu(k,2115) - lu(k,1257) * lu(k,2113) + lu(k,2116) = lu(k,2116) - lu(k,1258) * lu(k,2113) + lu(k,2117) = lu(k,2117) - lu(k,1259) * lu(k,2113) + lu(k,2118) = lu(k,2118) - lu(k,1260) * lu(k,2113) + lu(k,2121) = lu(k,2121) - lu(k,1261) * lu(k,2113) + lu(k,2123) = lu(k,2123) - lu(k,1262) * lu(k,2113) + lu(k,2125) = lu(k,2125) - lu(k,1263) * lu(k,2113) + lu(k,2126) = lu(k,2126) - lu(k,1264) * lu(k,2113) + lu(k,2127) = lu(k,2127) - lu(k,1265) * lu(k,2113) + lu(k,2128) = lu(k,2128) - lu(k,1266) * lu(k,2113) + lu(k,2131) = lu(k,2131) - lu(k,1267) * lu(k,2113) + lu(k,2132) = lu(k,2132) - lu(k,1268) * lu(k,2113) + lu(k,2134) = lu(k,2134) - lu(k,1269) * lu(k,2113) + lu(k,2136) = lu(k,2136) - lu(k,1270) * lu(k,2113) + lu(k,2137) = lu(k,2137) - lu(k,1271) * lu(k,2113) end do end subroutine lu_fac25 subroutine lu_fac26( avec_len, lu ) @@ -6130,676 +5365,458 @@ subroutine lu_fac26( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1327) = 1._r8 / lu(k,1327) - lu(k,1328) = lu(k,1328) * lu(k,1327) - lu(k,1329) = lu(k,1329) * lu(k,1327) - lu(k,1330) = lu(k,1330) * lu(k,1327) - lu(k,1331) = lu(k,1331) * lu(k,1327) - lu(k,1332) = lu(k,1332) * lu(k,1327) - lu(k,1333) = lu(k,1333) * lu(k,1327) - lu(k,1334) = lu(k,1334) * lu(k,1327) - lu(k,1335) = lu(k,1335) * lu(k,1327) - lu(k,1336) = lu(k,1336) * lu(k,1327) - lu(k,1337) = lu(k,1337) * lu(k,1327) - lu(k,1338) = lu(k,1338) * lu(k,1327) - lu(k,1339) = lu(k,1339) * lu(k,1327) - lu(k,1340) = lu(k,1340) * lu(k,1327) - lu(k,1341) = lu(k,1341) * lu(k,1327) - lu(k,1352) = lu(k,1352) - lu(k,1328) * lu(k,1351) - lu(k,1353) = lu(k,1353) - lu(k,1329) * lu(k,1351) - lu(k,1354) = lu(k,1354) - lu(k,1330) * lu(k,1351) - lu(k,1355) = lu(k,1355) - lu(k,1331) * lu(k,1351) - lu(k,1356) = lu(k,1356) - lu(k,1332) * lu(k,1351) - lu(k,1357) = lu(k,1357) - lu(k,1333) * lu(k,1351) - lu(k,1358) = lu(k,1358) - lu(k,1334) * lu(k,1351) - lu(k,1359) = lu(k,1359) - lu(k,1335) * lu(k,1351) - lu(k,1360) = lu(k,1360) - lu(k,1336) * lu(k,1351) - lu(k,1361) = lu(k,1361) - lu(k,1337) * lu(k,1351) - lu(k,1362) = lu(k,1362) - lu(k,1338) * lu(k,1351) - lu(k,1363) = lu(k,1363) - lu(k,1339) * lu(k,1351) - lu(k,1364) = lu(k,1364) - lu(k,1340) * lu(k,1351) - lu(k,1365) = lu(k,1365) - lu(k,1341) * lu(k,1351) - lu(k,1506) = lu(k,1506) - lu(k,1328) * lu(k,1505) - lu(k,1507) = lu(k,1507) - lu(k,1329) * lu(k,1505) - lu(k,1508) = lu(k,1508) - lu(k,1330) * lu(k,1505) - lu(k,1509) = lu(k,1509) - lu(k,1331) * lu(k,1505) - lu(k,1510) = lu(k,1510) - lu(k,1332) * lu(k,1505) - lu(k,1511) = lu(k,1511) - lu(k,1333) * lu(k,1505) - lu(k,1512) = lu(k,1512) - lu(k,1334) * lu(k,1505) - lu(k,1513) = lu(k,1513) - lu(k,1335) * lu(k,1505) - lu(k,1514) = lu(k,1514) - lu(k,1336) * lu(k,1505) - lu(k,1515) = lu(k,1515) - lu(k,1337) * lu(k,1505) - lu(k,1516) = lu(k,1516) - lu(k,1338) * lu(k,1505) - lu(k,1517) = lu(k,1517) - lu(k,1339) * lu(k,1505) - lu(k,1518) = lu(k,1518) - lu(k,1340) * lu(k,1505) - lu(k,1519) = lu(k,1519) - lu(k,1341) * lu(k,1505) - lu(k,1547) = lu(k,1547) - lu(k,1328) * lu(k,1546) - lu(k,1548) = lu(k,1548) - lu(k,1329) * lu(k,1546) - lu(k,1549) = lu(k,1549) - lu(k,1330) * lu(k,1546) - lu(k,1550) = lu(k,1550) - lu(k,1331) * lu(k,1546) - lu(k,1551) = lu(k,1551) - lu(k,1332) * lu(k,1546) - lu(k,1552) = lu(k,1552) - lu(k,1333) * lu(k,1546) - lu(k,1553) = lu(k,1553) - lu(k,1334) * lu(k,1546) - lu(k,1554) = lu(k,1554) - lu(k,1335) * lu(k,1546) - lu(k,1555) = lu(k,1555) - lu(k,1336) * lu(k,1546) - lu(k,1556) = lu(k,1556) - lu(k,1337) * lu(k,1546) - lu(k,1557) = lu(k,1557) - lu(k,1338) * lu(k,1546) - lu(k,1558) = lu(k,1558) - lu(k,1339) * lu(k,1546) - lu(k,1559) = lu(k,1559) - lu(k,1340) * lu(k,1546) - lu(k,1560) = lu(k,1560) - lu(k,1341) * lu(k,1546) - lu(k,1637) = lu(k,1637) - lu(k,1328) * lu(k,1636) - lu(k,1638) = lu(k,1638) - lu(k,1329) * lu(k,1636) - lu(k,1639) = lu(k,1639) - lu(k,1330) * lu(k,1636) - lu(k,1640) = lu(k,1640) - lu(k,1331) * lu(k,1636) - lu(k,1641) = lu(k,1641) - lu(k,1332) * lu(k,1636) - lu(k,1642) = lu(k,1642) - lu(k,1333) * lu(k,1636) - lu(k,1643) = lu(k,1643) - lu(k,1334) * lu(k,1636) - lu(k,1644) = lu(k,1644) - lu(k,1335) * lu(k,1636) - lu(k,1645) = lu(k,1645) - lu(k,1336) * lu(k,1636) - lu(k,1646) = lu(k,1646) - lu(k,1337) * lu(k,1636) - lu(k,1647) = lu(k,1647) - lu(k,1338) * lu(k,1636) - lu(k,1648) = lu(k,1648) - lu(k,1339) * lu(k,1636) - lu(k,1649) = lu(k,1649) - lu(k,1340) * lu(k,1636) - lu(k,1650) = lu(k,1650) - lu(k,1341) * lu(k,1636) - lu(k,1687) = lu(k,1687) - lu(k,1328) * lu(k,1686) - lu(k,1688) = lu(k,1688) - lu(k,1329) * lu(k,1686) - lu(k,1689) = lu(k,1689) - lu(k,1330) * lu(k,1686) - lu(k,1690) = lu(k,1690) - lu(k,1331) * lu(k,1686) - lu(k,1691) = lu(k,1691) - lu(k,1332) * lu(k,1686) - lu(k,1692) = - lu(k,1333) * lu(k,1686) - lu(k,1693) = lu(k,1693) - lu(k,1334) * lu(k,1686) - lu(k,1694) = lu(k,1694) - lu(k,1335) * lu(k,1686) - lu(k,1695) = lu(k,1695) - lu(k,1336) * lu(k,1686) - lu(k,1696) = lu(k,1696) - lu(k,1337) * lu(k,1686) - lu(k,1697) = lu(k,1697) - lu(k,1338) * lu(k,1686) - lu(k,1698) = lu(k,1698) - lu(k,1339) * lu(k,1686) - lu(k,1699) = lu(k,1699) - lu(k,1340) * lu(k,1686) - lu(k,1700) = lu(k,1700) - lu(k,1341) * lu(k,1686) - lu(k,1711) = lu(k,1711) - lu(k,1328) * lu(k,1710) - lu(k,1712) = lu(k,1712) - lu(k,1329) * lu(k,1710) - lu(k,1713) = lu(k,1713) - lu(k,1330) * lu(k,1710) - lu(k,1714) = lu(k,1714) - lu(k,1331) * lu(k,1710) - lu(k,1715) = lu(k,1715) - lu(k,1332) * lu(k,1710) - lu(k,1716) = lu(k,1716) - lu(k,1333) * lu(k,1710) - lu(k,1717) = lu(k,1717) - lu(k,1334) * lu(k,1710) - lu(k,1718) = lu(k,1718) - lu(k,1335) * lu(k,1710) - lu(k,1719) = lu(k,1719) - lu(k,1336) * lu(k,1710) - lu(k,1720) = lu(k,1720) - lu(k,1337) * lu(k,1710) - lu(k,1721) = lu(k,1721) - lu(k,1338) * lu(k,1710) - lu(k,1722) = lu(k,1722) - lu(k,1339) * lu(k,1710) - lu(k,1723) = lu(k,1723) - lu(k,1340) * lu(k,1710) - lu(k,1724) = lu(k,1724) - lu(k,1341) * lu(k,1710) - lu(k,1838) = lu(k,1838) - lu(k,1328) * lu(k,1837) - lu(k,1839) = lu(k,1839) - lu(k,1329) * lu(k,1837) - lu(k,1840) = lu(k,1840) - lu(k,1330) * lu(k,1837) - lu(k,1841) = lu(k,1841) - lu(k,1331) * lu(k,1837) - lu(k,1842) = lu(k,1842) - lu(k,1332) * lu(k,1837) - lu(k,1843) = lu(k,1843) - lu(k,1333) * lu(k,1837) - lu(k,1844) = lu(k,1844) - lu(k,1334) * lu(k,1837) - lu(k,1845) = lu(k,1845) - lu(k,1335) * lu(k,1837) - lu(k,1846) = lu(k,1846) - lu(k,1336) * lu(k,1837) - lu(k,1847) = lu(k,1847) - lu(k,1337) * lu(k,1837) - lu(k,1848) = lu(k,1848) - lu(k,1338) * lu(k,1837) - lu(k,1849) = lu(k,1849) - lu(k,1339) * lu(k,1837) - lu(k,1850) = lu(k,1850) - lu(k,1340) * lu(k,1837) - lu(k,1851) = lu(k,1851) - lu(k,1341) * lu(k,1837) - lu(k,1868) = lu(k,1868) - lu(k,1328) * lu(k,1867) - lu(k,1869) = lu(k,1869) - lu(k,1329) * lu(k,1867) - lu(k,1870) = lu(k,1870) - lu(k,1330) * lu(k,1867) - lu(k,1871) = lu(k,1871) - lu(k,1331) * lu(k,1867) - lu(k,1872) = lu(k,1872) - lu(k,1332) * lu(k,1867) - lu(k,1873) = lu(k,1873) - lu(k,1333) * lu(k,1867) - lu(k,1874) = lu(k,1874) - lu(k,1334) * lu(k,1867) - lu(k,1875) = lu(k,1875) - lu(k,1335) * lu(k,1867) - lu(k,1876) = lu(k,1876) - lu(k,1336) * lu(k,1867) - lu(k,1877) = lu(k,1877) - lu(k,1337) * lu(k,1867) - lu(k,1878) = lu(k,1878) - lu(k,1338) * lu(k,1867) - lu(k,1879) = lu(k,1879) - lu(k,1339) * lu(k,1867) - lu(k,1880) = lu(k,1880) - lu(k,1340) * lu(k,1867) - lu(k,1881) = lu(k,1881) - lu(k,1341) * lu(k,1867) - lu(k,1891) = lu(k,1891) - lu(k,1328) * lu(k,1890) - lu(k,1892) = lu(k,1892) - lu(k,1329) * lu(k,1890) - lu(k,1893) = lu(k,1893) - lu(k,1330) * lu(k,1890) - lu(k,1894) = - lu(k,1331) * lu(k,1890) - lu(k,1895) = lu(k,1895) - lu(k,1332) * lu(k,1890) - lu(k,1896) = lu(k,1896) - lu(k,1333) * lu(k,1890) - lu(k,1897) = lu(k,1897) - lu(k,1334) * lu(k,1890) - lu(k,1898) = lu(k,1898) - lu(k,1335) * lu(k,1890) - lu(k,1899) = lu(k,1899) - lu(k,1336) * lu(k,1890) - lu(k,1900) = lu(k,1900) - lu(k,1337) * lu(k,1890) - lu(k,1901) = lu(k,1901) - lu(k,1338) * lu(k,1890) - lu(k,1902) = lu(k,1902) - lu(k,1339) * lu(k,1890) - lu(k,1903) = lu(k,1903) - lu(k,1340) * lu(k,1890) - lu(k,1904) = lu(k,1904) - lu(k,1341) * lu(k,1890) - lu(k,1925) = lu(k,1925) - lu(k,1328) * lu(k,1924) - lu(k,1926) = lu(k,1926) - lu(k,1329) * lu(k,1924) - lu(k,1927) = lu(k,1927) - lu(k,1330) * lu(k,1924) - lu(k,1928) = lu(k,1928) - lu(k,1331) * lu(k,1924) - lu(k,1929) = lu(k,1929) - lu(k,1332) * lu(k,1924) - lu(k,1930) = lu(k,1930) - lu(k,1333) * lu(k,1924) - lu(k,1931) = lu(k,1931) - lu(k,1334) * lu(k,1924) - lu(k,1932) = lu(k,1932) - lu(k,1335) * lu(k,1924) - lu(k,1933) = lu(k,1933) - lu(k,1336) * lu(k,1924) - lu(k,1934) = lu(k,1934) - lu(k,1337) * lu(k,1924) - lu(k,1935) = lu(k,1935) - lu(k,1338) * lu(k,1924) - lu(k,1936) = lu(k,1936) - lu(k,1339) * lu(k,1924) - lu(k,1937) = lu(k,1937) - lu(k,1340) * lu(k,1924) - lu(k,1938) = lu(k,1938) - lu(k,1341) * lu(k,1924) - lu(k,1982) = lu(k,1982) - lu(k,1328) * lu(k,1981) - lu(k,1983) = lu(k,1983) - lu(k,1329) * lu(k,1981) - lu(k,1984) = lu(k,1984) - lu(k,1330) * lu(k,1981) - lu(k,1985) = lu(k,1985) - lu(k,1331) * lu(k,1981) - lu(k,1986) = lu(k,1986) - lu(k,1332) * lu(k,1981) - lu(k,1987) = lu(k,1987) - lu(k,1333) * lu(k,1981) - lu(k,1988) = lu(k,1988) - lu(k,1334) * lu(k,1981) - lu(k,1989) = lu(k,1989) - lu(k,1335) * lu(k,1981) - lu(k,1990) = lu(k,1990) - lu(k,1336) * lu(k,1981) - lu(k,1991) = lu(k,1991) - lu(k,1337) * lu(k,1981) - lu(k,1992) = lu(k,1992) - lu(k,1338) * lu(k,1981) - lu(k,1993) = lu(k,1993) - lu(k,1339) * lu(k,1981) - lu(k,1994) = lu(k,1994) - lu(k,1340) * lu(k,1981) - lu(k,1995) = lu(k,1995) - lu(k,1341) * lu(k,1981) - lu(k,2042) = lu(k,2042) - lu(k,1328) * lu(k,2041) - lu(k,2043) = lu(k,2043) - lu(k,1329) * lu(k,2041) - lu(k,2044) = lu(k,2044) - lu(k,1330) * lu(k,2041) - lu(k,2045) = lu(k,2045) - lu(k,1331) * lu(k,2041) - lu(k,2046) = lu(k,2046) - lu(k,1332) * lu(k,2041) - lu(k,2047) = lu(k,2047) - lu(k,1333) * lu(k,2041) - lu(k,2048) = lu(k,2048) - lu(k,1334) * lu(k,2041) - lu(k,2049) = lu(k,2049) - lu(k,1335) * lu(k,2041) - lu(k,2050) = lu(k,2050) - lu(k,1336) * lu(k,2041) - lu(k,2051) = lu(k,2051) - lu(k,1337) * lu(k,2041) - lu(k,2052) = lu(k,2052) - lu(k,1338) * lu(k,2041) - lu(k,2053) = lu(k,2053) - lu(k,1339) * lu(k,2041) - lu(k,2054) = lu(k,2054) - lu(k,1340) * lu(k,2041) - lu(k,2055) = lu(k,2055) - lu(k,1341) * lu(k,2041) - lu(k,2067) = lu(k,2067) - lu(k,1328) * lu(k,2066) - lu(k,2068) = lu(k,2068) - lu(k,1329) * lu(k,2066) - lu(k,2069) = lu(k,2069) - lu(k,1330) * lu(k,2066) - lu(k,2070) = lu(k,2070) - lu(k,1331) * lu(k,2066) - lu(k,2071) = lu(k,2071) - lu(k,1332) * lu(k,2066) - lu(k,2072) = lu(k,2072) - lu(k,1333) * lu(k,2066) - lu(k,2073) = lu(k,2073) - lu(k,1334) * lu(k,2066) - lu(k,2074) = lu(k,2074) - lu(k,1335) * lu(k,2066) - lu(k,2075) = lu(k,2075) - lu(k,1336) * lu(k,2066) - lu(k,2076) = lu(k,2076) - lu(k,1337) * lu(k,2066) - lu(k,2077) = lu(k,2077) - lu(k,1338) * lu(k,2066) - lu(k,2078) = lu(k,2078) - lu(k,1339) * lu(k,2066) - lu(k,2079) = lu(k,2079) - lu(k,1340) * lu(k,2066) - lu(k,2080) = lu(k,2080) - lu(k,1341) * lu(k,2066) - lu(k,1352) = 1._r8 / lu(k,1352) - lu(k,1353) = lu(k,1353) * lu(k,1352) - lu(k,1354) = lu(k,1354) * lu(k,1352) - lu(k,1355) = lu(k,1355) * lu(k,1352) - lu(k,1356) = lu(k,1356) * lu(k,1352) - lu(k,1357) = lu(k,1357) * lu(k,1352) - lu(k,1358) = lu(k,1358) * lu(k,1352) - lu(k,1359) = lu(k,1359) * lu(k,1352) - lu(k,1360) = lu(k,1360) * lu(k,1352) - lu(k,1361) = lu(k,1361) * lu(k,1352) - lu(k,1362) = lu(k,1362) * lu(k,1352) - lu(k,1363) = lu(k,1363) * lu(k,1352) - lu(k,1364) = lu(k,1364) * lu(k,1352) - lu(k,1365) = lu(k,1365) * lu(k,1352) - lu(k,1507) = lu(k,1507) - lu(k,1353) * lu(k,1506) - lu(k,1508) = lu(k,1508) - lu(k,1354) * lu(k,1506) - lu(k,1509) = lu(k,1509) - lu(k,1355) * lu(k,1506) - lu(k,1510) = lu(k,1510) - lu(k,1356) * lu(k,1506) - lu(k,1511) = lu(k,1511) - lu(k,1357) * lu(k,1506) - lu(k,1512) = lu(k,1512) - lu(k,1358) * lu(k,1506) - lu(k,1513) = lu(k,1513) - lu(k,1359) * lu(k,1506) - lu(k,1514) = lu(k,1514) - lu(k,1360) * lu(k,1506) - lu(k,1515) = lu(k,1515) - lu(k,1361) * lu(k,1506) - lu(k,1516) = lu(k,1516) - lu(k,1362) * lu(k,1506) - lu(k,1517) = lu(k,1517) - lu(k,1363) * lu(k,1506) - lu(k,1518) = lu(k,1518) - lu(k,1364) * lu(k,1506) - lu(k,1519) = lu(k,1519) - lu(k,1365) * lu(k,1506) - lu(k,1548) = lu(k,1548) - lu(k,1353) * lu(k,1547) - lu(k,1549) = lu(k,1549) - lu(k,1354) * lu(k,1547) - lu(k,1550) = lu(k,1550) - lu(k,1355) * lu(k,1547) - lu(k,1551) = lu(k,1551) - lu(k,1356) * lu(k,1547) - lu(k,1552) = lu(k,1552) - lu(k,1357) * lu(k,1547) - lu(k,1553) = lu(k,1553) - lu(k,1358) * lu(k,1547) - lu(k,1554) = lu(k,1554) - lu(k,1359) * lu(k,1547) - lu(k,1555) = lu(k,1555) - lu(k,1360) * lu(k,1547) - lu(k,1556) = lu(k,1556) - lu(k,1361) * lu(k,1547) - lu(k,1557) = lu(k,1557) - lu(k,1362) * lu(k,1547) - lu(k,1558) = lu(k,1558) - lu(k,1363) * lu(k,1547) - lu(k,1559) = lu(k,1559) - lu(k,1364) * lu(k,1547) - lu(k,1560) = lu(k,1560) - lu(k,1365) * lu(k,1547) - lu(k,1638) = lu(k,1638) - lu(k,1353) * lu(k,1637) - lu(k,1639) = lu(k,1639) - lu(k,1354) * lu(k,1637) - lu(k,1640) = lu(k,1640) - lu(k,1355) * lu(k,1637) - lu(k,1641) = lu(k,1641) - lu(k,1356) * lu(k,1637) - lu(k,1642) = lu(k,1642) - lu(k,1357) * lu(k,1637) - lu(k,1643) = lu(k,1643) - lu(k,1358) * lu(k,1637) - lu(k,1644) = lu(k,1644) - lu(k,1359) * lu(k,1637) - lu(k,1645) = lu(k,1645) - lu(k,1360) * lu(k,1637) - lu(k,1646) = lu(k,1646) - lu(k,1361) * lu(k,1637) - lu(k,1647) = lu(k,1647) - lu(k,1362) * lu(k,1637) - lu(k,1648) = lu(k,1648) - lu(k,1363) * lu(k,1637) - lu(k,1649) = lu(k,1649) - lu(k,1364) * lu(k,1637) - lu(k,1650) = lu(k,1650) - lu(k,1365) * lu(k,1637) - lu(k,1688) = lu(k,1688) - lu(k,1353) * lu(k,1687) - lu(k,1689) = lu(k,1689) - lu(k,1354) * lu(k,1687) - lu(k,1690) = lu(k,1690) - lu(k,1355) * lu(k,1687) - lu(k,1691) = lu(k,1691) - lu(k,1356) * lu(k,1687) - lu(k,1692) = lu(k,1692) - lu(k,1357) * lu(k,1687) - lu(k,1693) = lu(k,1693) - lu(k,1358) * lu(k,1687) - lu(k,1694) = lu(k,1694) - lu(k,1359) * lu(k,1687) - lu(k,1695) = lu(k,1695) - lu(k,1360) * lu(k,1687) - lu(k,1696) = lu(k,1696) - lu(k,1361) * lu(k,1687) - lu(k,1697) = lu(k,1697) - lu(k,1362) * lu(k,1687) - lu(k,1698) = lu(k,1698) - lu(k,1363) * lu(k,1687) - lu(k,1699) = lu(k,1699) - lu(k,1364) * lu(k,1687) - lu(k,1700) = lu(k,1700) - lu(k,1365) * lu(k,1687) - lu(k,1712) = lu(k,1712) - lu(k,1353) * lu(k,1711) - lu(k,1713) = lu(k,1713) - lu(k,1354) * lu(k,1711) - lu(k,1714) = lu(k,1714) - lu(k,1355) * lu(k,1711) - lu(k,1715) = lu(k,1715) - lu(k,1356) * lu(k,1711) - lu(k,1716) = lu(k,1716) - lu(k,1357) * lu(k,1711) - lu(k,1717) = lu(k,1717) - lu(k,1358) * lu(k,1711) - lu(k,1718) = lu(k,1718) - lu(k,1359) * lu(k,1711) - lu(k,1719) = lu(k,1719) - lu(k,1360) * lu(k,1711) - lu(k,1720) = lu(k,1720) - lu(k,1361) * lu(k,1711) - lu(k,1721) = lu(k,1721) - lu(k,1362) * lu(k,1711) - lu(k,1722) = lu(k,1722) - lu(k,1363) * lu(k,1711) - lu(k,1723) = lu(k,1723) - lu(k,1364) * lu(k,1711) - lu(k,1724) = lu(k,1724) - lu(k,1365) * lu(k,1711) - lu(k,1734) = lu(k,1734) - lu(k,1353) * lu(k,1733) - lu(k,1735) = lu(k,1735) - lu(k,1354) * lu(k,1733) - lu(k,1736) = lu(k,1736) - lu(k,1355) * lu(k,1733) - lu(k,1737) = lu(k,1737) - lu(k,1356) * lu(k,1733) - lu(k,1738) = lu(k,1738) - lu(k,1357) * lu(k,1733) - lu(k,1739) = lu(k,1739) - lu(k,1358) * lu(k,1733) - lu(k,1740) = lu(k,1740) - lu(k,1359) * lu(k,1733) - lu(k,1741) = lu(k,1741) - lu(k,1360) * lu(k,1733) - lu(k,1742) = lu(k,1742) - lu(k,1361) * lu(k,1733) - lu(k,1743) = lu(k,1743) - lu(k,1362) * lu(k,1733) - lu(k,1744) = lu(k,1744) - lu(k,1363) * lu(k,1733) - lu(k,1745) = lu(k,1745) - lu(k,1364) * lu(k,1733) - lu(k,1746) = lu(k,1746) - lu(k,1365) * lu(k,1733) - lu(k,1839) = lu(k,1839) - lu(k,1353) * lu(k,1838) - lu(k,1840) = lu(k,1840) - lu(k,1354) * lu(k,1838) - lu(k,1841) = lu(k,1841) - lu(k,1355) * lu(k,1838) - lu(k,1842) = lu(k,1842) - lu(k,1356) * lu(k,1838) - lu(k,1843) = lu(k,1843) - lu(k,1357) * lu(k,1838) - lu(k,1844) = lu(k,1844) - lu(k,1358) * lu(k,1838) - lu(k,1845) = lu(k,1845) - lu(k,1359) * lu(k,1838) - lu(k,1846) = lu(k,1846) - lu(k,1360) * lu(k,1838) - lu(k,1847) = lu(k,1847) - lu(k,1361) * lu(k,1838) - lu(k,1848) = lu(k,1848) - lu(k,1362) * lu(k,1838) - lu(k,1849) = lu(k,1849) - lu(k,1363) * lu(k,1838) - lu(k,1850) = lu(k,1850) - lu(k,1364) * lu(k,1838) - lu(k,1851) = lu(k,1851) - lu(k,1365) * lu(k,1838) - lu(k,1869) = lu(k,1869) - lu(k,1353) * lu(k,1868) - lu(k,1870) = lu(k,1870) - lu(k,1354) * lu(k,1868) - lu(k,1871) = lu(k,1871) - lu(k,1355) * lu(k,1868) - lu(k,1872) = lu(k,1872) - lu(k,1356) * lu(k,1868) - lu(k,1873) = lu(k,1873) - lu(k,1357) * lu(k,1868) - lu(k,1874) = lu(k,1874) - lu(k,1358) * lu(k,1868) - lu(k,1875) = lu(k,1875) - lu(k,1359) * lu(k,1868) - lu(k,1876) = lu(k,1876) - lu(k,1360) * lu(k,1868) - lu(k,1877) = lu(k,1877) - lu(k,1361) * lu(k,1868) - lu(k,1878) = lu(k,1878) - lu(k,1362) * lu(k,1868) - lu(k,1879) = lu(k,1879) - lu(k,1363) * lu(k,1868) - lu(k,1880) = lu(k,1880) - lu(k,1364) * lu(k,1868) - lu(k,1881) = lu(k,1881) - lu(k,1365) * lu(k,1868) - lu(k,1892) = lu(k,1892) - lu(k,1353) * lu(k,1891) - lu(k,1893) = lu(k,1893) - lu(k,1354) * lu(k,1891) - lu(k,1894) = lu(k,1894) - lu(k,1355) * lu(k,1891) - lu(k,1895) = lu(k,1895) - lu(k,1356) * lu(k,1891) - lu(k,1896) = lu(k,1896) - lu(k,1357) * lu(k,1891) - lu(k,1897) = lu(k,1897) - lu(k,1358) * lu(k,1891) - lu(k,1898) = lu(k,1898) - lu(k,1359) * lu(k,1891) - lu(k,1899) = lu(k,1899) - lu(k,1360) * lu(k,1891) - lu(k,1900) = lu(k,1900) - lu(k,1361) * lu(k,1891) - lu(k,1901) = lu(k,1901) - lu(k,1362) * lu(k,1891) - lu(k,1902) = lu(k,1902) - lu(k,1363) * lu(k,1891) - lu(k,1903) = lu(k,1903) - lu(k,1364) * lu(k,1891) - lu(k,1904) = lu(k,1904) - lu(k,1365) * lu(k,1891) - lu(k,1926) = lu(k,1926) - lu(k,1353) * lu(k,1925) - lu(k,1927) = lu(k,1927) - lu(k,1354) * lu(k,1925) - lu(k,1928) = lu(k,1928) - lu(k,1355) * lu(k,1925) - lu(k,1929) = lu(k,1929) - lu(k,1356) * lu(k,1925) - lu(k,1930) = lu(k,1930) - lu(k,1357) * lu(k,1925) - lu(k,1931) = lu(k,1931) - lu(k,1358) * lu(k,1925) - lu(k,1932) = lu(k,1932) - lu(k,1359) * lu(k,1925) - lu(k,1933) = lu(k,1933) - lu(k,1360) * lu(k,1925) - lu(k,1934) = lu(k,1934) - lu(k,1361) * lu(k,1925) - lu(k,1935) = lu(k,1935) - lu(k,1362) * lu(k,1925) - lu(k,1936) = lu(k,1936) - lu(k,1363) * lu(k,1925) - lu(k,1937) = lu(k,1937) - lu(k,1364) * lu(k,1925) - lu(k,1938) = lu(k,1938) - lu(k,1365) * lu(k,1925) - lu(k,1983) = lu(k,1983) - lu(k,1353) * lu(k,1982) - lu(k,1984) = lu(k,1984) - lu(k,1354) * lu(k,1982) - lu(k,1985) = lu(k,1985) - lu(k,1355) * lu(k,1982) - lu(k,1986) = lu(k,1986) - lu(k,1356) * lu(k,1982) - lu(k,1987) = lu(k,1987) - lu(k,1357) * lu(k,1982) - lu(k,1988) = lu(k,1988) - lu(k,1358) * lu(k,1982) - lu(k,1989) = lu(k,1989) - lu(k,1359) * lu(k,1982) - lu(k,1990) = lu(k,1990) - lu(k,1360) * lu(k,1982) - lu(k,1991) = lu(k,1991) - lu(k,1361) * lu(k,1982) - lu(k,1992) = lu(k,1992) - lu(k,1362) * lu(k,1982) - lu(k,1993) = lu(k,1993) - lu(k,1363) * lu(k,1982) - lu(k,1994) = lu(k,1994) - lu(k,1364) * lu(k,1982) - lu(k,1995) = lu(k,1995) - lu(k,1365) * lu(k,1982) - lu(k,2043) = lu(k,2043) - lu(k,1353) * lu(k,2042) - lu(k,2044) = lu(k,2044) - lu(k,1354) * lu(k,2042) - lu(k,2045) = lu(k,2045) - lu(k,1355) * lu(k,2042) - lu(k,2046) = lu(k,2046) - lu(k,1356) * lu(k,2042) - lu(k,2047) = lu(k,2047) - lu(k,1357) * lu(k,2042) - lu(k,2048) = lu(k,2048) - lu(k,1358) * lu(k,2042) - lu(k,2049) = lu(k,2049) - lu(k,1359) * lu(k,2042) - lu(k,2050) = lu(k,2050) - lu(k,1360) * lu(k,2042) - lu(k,2051) = lu(k,2051) - lu(k,1361) * lu(k,2042) - lu(k,2052) = lu(k,2052) - lu(k,1362) * lu(k,2042) - lu(k,2053) = lu(k,2053) - lu(k,1363) * lu(k,2042) - lu(k,2054) = lu(k,2054) - lu(k,1364) * lu(k,2042) - lu(k,2055) = lu(k,2055) - lu(k,1365) * lu(k,2042) - lu(k,2068) = lu(k,2068) - lu(k,1353) * lu(k,2067) - lu(k,2069) = lu(k,2069) - lu(k,1354) * lu(k,2067) - lu(k,2070) = lu(k,2070) - lu(k,1355) * lu(k,2067) - lu(k,2071) = lu(k,2071) - lu(k,1356) * lu(k,2067) - lu(k,2072) = lu(k,2072) - lu(k,1357) * lu(k,2067) - lu(k,2073) = lu(k,2073) - lu(k,1358) * lu(k,2067) - lu(k,2074) = lu(k,2074) - lu(k,1359) * lu(k,2067) - lu(k,2075) = lu(k,2075) - lu(k,1360) * lu(k,2067) - lu(k,2076) = lu(k,2076) - lu(k,1361) * lu(k,2067) - lu(k,2077) = lu(k,2077) - lu(k,1362) * lu(k,2067) - lu(k,2078) = lu(k,2078) - lu(k,1363) * lu(k,2067) - lu(k,2079) = lu(k,2079) - lu(k,1364) * lu(k,2067) - lu(k,2080) = lu(k,2080) - lu(k,1365) * lu(k,2067) - lu(k,1507) = 1._r8 / lu(k,1507) - lu(k,1508) = lu(k,1508) * lu(k,1507) - lu(k,1509) = lu(k,1509) * lu(k,1507) - lu(k,1510) = lu(k,1510) * lu(k,1507) - lu(k,1511) = lu(k,1511) * lu(k,1507) - lu(k,1512) = lu(k,1512) * lu(k,1507) - lu(k,1513) = lu(k,1513) * lu(k,1507) - lu(k,1514) = lu(k,1514) * lu(k,1507) - lu(k,1515) = lu(k,1515) * lu(k,1507) - lu(k,1516) = lu(k,1516) * lu(k,1507) - lu(k,1517) = lu(k,1517) * lu(k,1507) - lu(k,1518) = lu(k,1518) * lu(k,1507) - lu(k,1519) = lu(k,1519) * lu(k,1507) - lu(k,1549) = lu(k,1549) - lu(k,1508) * lu(k,1548) - lu(k,1550) = lu(k,1550) - lu(k,1509) * lu(k,1548) - lu(k,1551) = lu(k,1551) - lu(k,1510) * lu(k,1548) - lu(k,1552) = lu(k,1552) - lu(k,1511) * lu(k,1548) - lu(k,1553) = lu(k,1553) - lu(k,1512) * lu(k,1548) - lu(k,1554) = lu(k,1554) - lu(k,1513) * lu(k,1548) - lu(k,1555) = lu(k,1555) - lu(k,1514) * lu(k,1548) - lu(k,1556) = lu(k,1556) - lu(k,1515) * lu(k,1548) - lu(k,1557) = lu(k,1557) - lu(k,1516) * lu(k,1548) - lu(k,1558) = lu(k,1558) - lu(k,1517) * lu(k,1548) - lu(k,1559) = lu(k,1559) - lu(k,1518) * lu(k,1548) - lu(k,1560) = lu(k,1560) - lu(k,1519) * lu(k,1548) - lu(k,1639) = lu(k,1639) - lu(k,1508) * lu(k,1638) - lu(k,1640) = lu(k,1640) - lu(k,1509) * lu(k,1638) - lu(k,1641) = lu(k,1641) - lu(k,1510) * lu(k,1638) - lu(k,1642) = lu(k,1642) - lu(k,1511) * lu(k,1638) - lu(k,1643) = lu(k,1643) - lu(k,1512) * lu(k,1638) - lu(k,1644) = lu(k,1644) - lu(k,1513) * lu(k,1638) - lu(k,1645) = lu(k,1645) - lu(k,1514) * lu(k,1638) - lu(k,1646) = lu(k,1646) - lu(k,1515) * lu(k,1638) - lu(k,1647) = lu(k,1647) - lu(k,1516) * lu(k,1638) - lu(k,1648) = lu(k,1648) - lu(k,1517) * lu(k,1638) - lu(k,1649) = lu(k,1649) - lu(k,1518) * lu(k,1638) - lu(k,1650) = lu(k,1650) - lu(k,1519) * lu(k,1638) - lu(k,1689) = lu(k,1689) - lu(k,1508) * lu(k,1688) - lu(k,1690) = lu(k,1690) - lu(k,1509) * lu(k,1688) - lu(k,1691) = lu(k,1691) - lu(k,1510) * lu(k,1688) - lu(k,1692) = lu(k,1692) - lu(k,1511) * lu(k,1688) - lu(k,1693) = lu(k,1693) - lu(k,1512) * lu(k,1688) - lu(k,1694) = lu(k,1694) - lu(k,1513) * lu(k,1688) - lu(k,1695) = lu(k,1695) - lu(k,1514) * lu(k,1688) - lu(k,1696) = lu(k,1696) - lu(k,1515) * lu(k,1688) - lu(k,1697) = lu(k,1697) - lu(k,1516) * lu(k,1688) - lu(k,1698) = lu(k,1698) - lu(k,1517) * lu(k,1688) - lu(k,1699) = lu(k,1699) - lu(k,1518) * lu(k,1688) - lu(k,1700) = lu(k,1700) - lu(k,1519) * lu(k,1688) - lu(k,1713) = lu(k,1713) - lu(k,1508) * lu(k,1712) - lu(k,1714) = lu(k,1714) - lu(k,1509) * lu(k,1712) - lu(k,1715) = lu(k,1715) - lu(k,1510) * lu(k,1712) - lu(k,1716) = lu(k,1716) - lu(k,1511) * lu(k,1712) - lu(k,1717) = lu(k,1717) - lu(k,1512) * lu(k,1712) - lu(k,1718) = lu(k,1718) - lu(k,1513) * lu(k,1712) - lu(k,1719) = lu(k,1719) - lu(k,1514) * lu(k,1712) - lu(k,1720) = lu(k,1720) - lu(k,1515) * lu(k,1712) - lu(k,1721) = lu(k,1721) - lu(k,1516) * lu(k,1712) - lu(k,1722) = lu(k,1722) - lu(k,1517) * lu(k,1712) - lu(k,1723) = lu(k,1723) - lu(k,1518) * lu(k,1712) - lu(k,1724) = lu(k,1724) - lu(k,1519) * lu(k,1712) - lu(k,1735) = lu(k,1735) - lu(k,1508) * lu(k,1734) - lu(k,1736) = lu(k,1736) - lu(k,1509) * lu(k,1734) - lu(k,1737) = lu(k,1737) - lu(k,1510) * lu(k,1734) - lu(k,1738) = lu(k,1738) - lu(k,1511) * lu(k,1734) - lu(k,1739) = lu(k,1739) - lu(k,1512) * lu(k,1734) - lu(k,1740) = lu(k,1740) - lu(k,1513) * lu(k,1734) - lu(k,1741) = lu(k,1741) - lu(k,1514) * lu(k,1734) - lu(k,1742) = lu(k,1742) - lu(k,1515) * lu(k,1734) - lu(k,1743) = lu(k,1743) - lu(k,1516) * lu(k,1734) - lu(k,1744) = lu(k,1744) - lu(k,1517) * lu(k,1734) - lu(k,1745) = lu(k,1745) - lu(k,1518) * lu(k,1734) - lu(k,1746) = lu(k,1746) - lu(k,1519) * lu(k,1734) - lu(k,1840) = lu(k,1840) - lu(k,1508) * lu(k,1839) - lu(k,1841) = lu(k,1841) - lu(k,1509) * lu(k,1839) - lu(k,1842) = lu(k,1842) - lu(k,1510) * lu(k,1839) - lu(k,1843) = lu(k,1843) - lu(k,1511) * lu(k,1839) - lu(k,1844) = lu(k,1844) - lu(k,1512) * lu(k,1839) - lu(k,1845) = lu(k,1845) - lu(k,1513) * lu(k,1839) - lu(k,1846) = lu(k,1846) - lu(k,1514) * lu(k,1839) - lu(k,1847) = lu(k,1847) - lu(k,1515) * lu(k,1839) - lu(k,1848) = lu(k,1848) - lu(k,1516) * lu(k,1839) - lu(k,1849) = lu(k,1849) - lu(k,1517) * lu(k,1839) - lu(k,1850) = lu(k,1850) - lu(k,1518) * lu(k,1839) - lu(k,1851) = lu(k,1851) - lu(k,1519) * lu(k,1839) - lu(k,1870) = lu(k,1870) - lu(k,1508) * lu(k,1869) - lu(k,1871) = lu(k,1871) - lu(k,1509) * lu(k,1869) - lu(k,1872) = lu(k,1872) - lu(k,1510) * lu(k,1869) - lu(k,1873) = lu(k,1873) - lu(k,1511) * lu(k,1869) - lu(k,1874) = lu(k,1874) - lu(k,1512) * lu(k,1869) - lu(k,1875) = lu(k,1875) - lu(k,1513) * lu(k,1869) - lu(k,1876) = lu(k,1876) - lu(k,1514) * lu(k,1869) - lu(k,1877) = lu(k,1877) - lu(k,1515) * lu(k,1869) - lu(k,1878) = lu(k,1878) - lu(k,1516) * lu(k,1869) - lu(k,1879) = lu(k,1879) - lu(k,1517) * lu(k,1869) - lu(k,1880) = lu(k,1880) - lu(k,1518) * lu(k,1869) - lu(k,1881) = lu(k,1881) - lu(k,1519) * lu(k,1869) - lu(k,1893) = lu(k,1893) - lu(k,1508) * lu(k,1892) - lu(k,1894) = lu(k,1894) - lu(k,1509) * lu(k,1892) - lu(k,1895) = lu(k,1895) - lu(k,1510) * lu(k,1892) - lu(k,1896) = lu(k,1896) - lu(k,1511) * lu(k,1892) - lu(k,1897) = lu(k,1897) - lu(k,1512) * lu(k,1892) - lu(k,1898) = lu(k,1898) - lu(k,1513) * lu(k,1892) - lu(k,1899) = lu(k,1899) - lu(k,1514) * lu(k,1892) - lu(k,1900) = lu(k,1900) - lu(k,1515) * lu(k,1892) - lu(k,1901) = lu(k,1901) - lu(k,1516) * lu(k,1892) - lu(k,1902) = lu(k,1902) - lu(k,1517) * lu(k,1892) - lu(k,1903) = lu(k,1903) - lu(k,1518) * lu(k,1892) - lu(k,1904) = lu(k,1904) - lu(k,1519) * lu(k,1892) - lu(k,1927) = lu(k,1927) - lu(k,1508) * lu(k,1926) - lu(k,1928) = lu(k,1928) - lu(k,1509) * lu(k,1926) - lu(k,1929) = lu(k,1929) - lu(k,1510) * lu(k,1926) - lu(k,1930) = lu(k,1930) - lu(k,1511) * lu(k,1926) - lu(k,1931) = lu(k,1931) - lu(k,1512) * lu(k,1926) - lu(k,1932) = lu(k,1932) - lu(k,1513) * lu(k,1926) - lu(k,1933) = lu(k,1933) - lu(k,1514) * lu(k,1926) - lu(k,1934) = lu(k,1934) - lu(k,1515) * lu(k,1926) - lu(k,1935) = lu(k,1935) - lu(k,1516) * lu(k,1926) - lu(k,1936) = lu(k,1936) - lu(k,1517) * lu(k,1926) - lu(k,1937) = lu(k,1937) - lu(k,1518) * lu(k,1926) - lu(k,1938) = lu(k,1938) - lu(k,1519) * lu(k,1926) - lu(k,1984) = lu(k,1984) - lu(k,1508) * lu(k,1983) - lu(k,1985) = lu(k,1985) - lu(k,1509) * lu(k,1983) - lu(k,1986) = lu(k,1986) - lu(k,1510) * lu(k,1983) - lu(k,1987) = lu(k,1987) - lu(k,1511) * lu(k,1983) - lu(k,1988) = lu(k,1988) - lu(k,1512) * lu(k,1983) - lu(k,1989) = lu(k,1989) - lu(k,1513) * lu(k,1983) - lu(k,1990) = lu(k,1990) - lu(k,1514) * lu(k,1983) - lu(k,1991) = lu(k,1991) - lu(k,1515) * lu(k,1983) - lu(k,1992) = lu(k,1992) - lu(k,1516) * lu(k,1983) - lu(k,1993) = lu(k,1993) - lu(k,1517) * lu(k,1983) - lu(k,1994) = lu(k,1994) - lu(k,1518) * lu(k,1983) - lu(k,1995) = lu(k,1995) - lu(k,1519) * lu(k,1983) - lu(k,2044) = lu(k,2044) - lu(k,1508) * lu(k,2043) - lu(k,2045) = lu(k,2045) - lu(k,1509) * lu(k,2043) - lu(k,2046) = lu(k,2046) - lu(k,1510) * lu(k,2043) - lu(k,2047) = lu(k,2047) - lu(k,1511) * lu(k,2043) - lu(k,2048) = lu(k,2048) - lu(k,1512) * lu(k,2043) - lu(k,2049) = lu(k,2049) - lu(k,1513) * lu(k,2043) - lu(k,2050) = lu(k,2050) - lu(k,1514) * lu(k,2043) - lu(k,2051) = lu(k,2051) - lu(k,1515) * lu(k,2043) - lu(k,2052) = lu(k,2052) - lu(k,1516) * lu(k,2043) - lu(k,2053) = lu(k,2053) - lu(k,1517) * lu(k,2043) - lu(k,2054) = lu(k,2054) - lu(k,1518) * lu(k,2043) - lu(k,2055) = lu(k,2055) - lu(k,1519) * lu(k,2043) - lu(k,2069) = lu(k,2069) - lu(k,1508) * lu(k,2068) - lu(k,2070) = lu(k,2070) - lu(k,1509) * lu(k,2068) - lu(k,2071) = lu(k,2071) - lu(k,1510) * lu(k,2068) - lu(k,2072) = lu(k,2072) - lu(k,1511) * lu(k,2068) - lu(k,2073) = lu(k,2073) - lu(k,1512) * lu(k,2068) - lu(k,2074) = lu(k,2074) - lu(k,1513) * lu(k,2068) - lu(k,2075) = lu(k,2075) - lu(k,1514) * lu(k,2068) - lu(k,2076) = lu(k,2076) - lu(k,1515) * lu(k,2068) - lu(k,2077) = lu(k,2077) - lu(k,1516) * lu(k,2068) - lu(k,2078) = lu(k,2078) - lu(k,1517) * lu(k,2068) - lu(k,2079) = lu(k,2079) - lu(k,1518) * lu(k,2068) - lu(k,2080) = lu(k,2080) - lu(k,1519) * lu(k,2068) - lu(k,1549) = 1._r8 / lu(k,1549) - lu(k,1550) = lu(k,1550) * lu(k,1549) - lu(k,1551) = lu(k,1551) * lu(k,1549) - lu(k,1552) = lu(k,1552) * lu(k,1549) - lu(k,1553) = lu(k,1553) * lu(k,1549) - lu(k,1554) = lu(k,1554) * lu(k,1549) - lu(k,1555) = lu(k,1555) * lu(k,1549) - lu(k,1556) = lu(k,1556) * lu(k,1549) - lu(k,1557) = lu(k,1557) * lu(k,1549) - lu(k,1558) = lu(k,1558) * lu(k,1549) - lu(k,1559) = lu(k,1559) * lu(k,1549) - lu(k,1560) = lu(k,1560) * lu(k,1549) - lu(k,1640) = lu(k,1640) - lu(k,1550) * lu(k,1639) - lu(k,1641) = lu(k,1641) - lu(k,1551) * lu(k,1639) - lu(k,1642) = lu(k,1642) - lu(k,1552) * lu(k,1639) - lu(k,1643) = lu(k,1643) - lu(k,1553) * lu(k,1639) - lu(k,1644) = lu(k,1644) - lu(k,1554) * lu(k,1639) - lu(k,1645) = lu(k,1645) - lu(k,1555) * lu(k,1639) - lu(k,1646) = lu(k,1646) - lu(k,1556) * lu(k,1639) - lu(k,1647) = lu(k,1647) - lu(k,1557) * lu(k,1639) - lu(k,1648) = lu(k,1648) - lu(k,1558) * lu(k,1639) - lu(k,1649) = lu(k,1649) - lu(k,1559) * lu(k,1639) - lu(k,1650) = lu(k,1650) - lu(k,1560) * lu(k,1639) - lu(k,1690) = lu(k,1690) - lu(k,1550) * lu(k,1689) - lu(k,1691) = lu(k,1691) - lu(k,1551) * lu(k,1689) - lu(k,1692) = lu(k,1692) - lu(k,1552) * lu(k,1689) - lu(k,1693) = lu(k,1693) - lu(k,1553) * lu(k,1689) - lu(k,1694) = lu(k,1694) - lu(k,1554) * lu(k,1689) - lu(k,1695) = lu(k,1695) - lu(k,1555) * lu(k,1689) - lu(k,1696) = lu(k,1696) - lu(k,1556) * lu(k,1689) - lu(k,1697) = lu(k,1697) - lu(k,1557) * lu(k,1689) - lu(k,1698) = lu(k,1698) - lu(k,1558) * lu(k,1689) - lu(k,1699) = lu(k,1699) - lu(k,1559) * lu(k,1689) - lu(k,1700) = lu(k,1700) - lu(k,1560) * lu(k,1689) - lu(k,1714) = lu(k,1714) - lu(k,1550) * lu(k,1713) - lu(k,1715) = lu(k,1715) - lu(k,1551) * lu(k,1713) - lu(k,1716) = lu(k,1716) - lu(k,1552) * lu(k,1713) - lu(k,1717) = lu(k,1717) - lu(k,1553) * lu(k,1713) - lu(k,1718) = lu(k,1718) - lu(k,1554) * lu(k,1713) - lu(k,1719) = lu(k,1719) - lu(k,1555) * lu(k,1713) - lu(k,1720) = lu(k,1720) - lu(k,1556) * lu(k,1713) - lu(k,1721) = lu(k,1721) - lu(k,1557) * lu(k,1713) - lu(k,1722) = lu(k,1722) - lu(k,1558) * lu(k,1713) - lu(k,1723) = lu(k,1723) - lu(k,1559) * lu(k,1713) - lu(k,1724) = lu(k,1724) - lu(k,1560) * lu(k,1713) - lu(k,1736) = lu(k,1736) - lu(k,1550) * lu(k,1735) - lu(k,1737) = lu(k,1737) - lu(k,1551) * lu(k,1735) - lu(k,1738) = lu(k,1738) - lu(k,1552) * lu(k,1735) - lu(k,1739) = lu(k,1739) - lu(k,1553) * lu(k,1735) - lu(k,1740) = lu(k,1740) - lu(k,1554) * lu(k,1735) - lu(k,1741) = lu(k,1741) - lu(k,1555) * lu(k,1735) - lu(k,1742) = lu(k,1742) - lu(k,1556) * lu(k,1735) - lu(k,1743) = lu(k,1743) - lu(k,1557) * lu(k,1735) - lu(k,1744) = lu(k,1744) - lu(k,1558) * lu(k,1735) - lu(k,1745) = lu(k,1745) - lu(k,1559) * lu(k,1735) - lu(k,1746) = lu(k,1746) - lu(k,1560) * lu(k,1735) - lu(k,1841) = lu(k,1841) - lu(k,1550) * lu(k,1840) - lu(k,1842) = lu(k,1842) - lu(k,1551) * lu(k,1840) - lu(k,1843) = lu(k,1843) - lu(k,1552) * lu(k,1840) - lu(k,1844) = lu(k,1844) - lu(k,1553) * lu(k,1840) - lu(k,1845) = lu(k,1845) - lu(k,1554) * lu(k,1840) - lu(k,1846) = lu(k,1846) - lu(k,1555) * lu(k,1840) - lu(k,1847) = lu(k,1847) - lu(k,1556) * lu(k,1840) - lu(k,1848) = lu(k,1848) - lu(k,1557) * lu(k,1840) - lu(k,1849) = lu(k,1849) - lu(k,1558) * lu(k,1840) - lu(k,1850) = lu(k,1850) - lu(k,1559) * lu(k,1840) - lu(k,1851) = lu(k,1851) - lu(k,1560) * lu(k,1840) - lu(k,1871) = lu(k,1871) - lu(k,1550) * lu(k,1870) - lu(k,1872) = lu(k,1872) - lu(k,1551) * lu(k,1870) - lu(k,1873) = lu(k,1873) - lu(k,1552) * lu(k,1870) - lu(k,1874) = lu(k,1874) - lu(k,1553) * lu(k,1870) - lu(k,1875) = lu(k,1875) - lu(k,1554) * lu(k,1870) - lu(k,1876) = lu(k,1876) - lu(k,1555) * lu(k,1870) - lu(k,1877) = lu(k,1877) - lu(k,1556) * lu(k,1870) - lu(k,1878) = lu(k,1878) - lu(k,1557) * lu(k,1870) - lu(k,1879) = lu(k,1879) - lu(k,1558) * lu(k,1870) - lu(k,1880) = lu(k,1880) - lu(k,1559) * lu(k,1870) - lu(k,1881) = lu(k,1881) - lu(k,1560) * lu(k,1870) - lu(k,1894) = lu(k,1894) - lu(k,1550) * lu(k,1893) - lu(k,1895) = lu(k,1895) - lu(k,1551) * lu(k,1893) - lu(k,1896) = lu(k,1896) - lu(k,1552) * lu(k,1893) - lu(k,1897) = lu(k,1897) - lu(k,1553) * lu(k,1893) - lu(k,1898) = lu(k,1898) - lu(k,1554) * lu(k,1893) - lu(k,1899) = lu(k,1899) - lu(k,1555) * lu(k,1893) - lu(k,1900) = lu(k,1900) - lu(k,1556) * lu(k,1893) - lu(k,1901) = lu(k,1901) - lu(k,1557) * lu(k,1893) - lu(k,1902) = lu(k,1902) - lu(k,1558) * lu(k,1893) - lu(k,1903) = lu(k,1903) - lu(k,1559) * lu(k,1893) - lu(k,1904) = lu(k,1904) - lu(k,1560) * lu(k,1893) - lu(k,1928) = lu(k,1928) - lu(k,1550) * lu(k,1927) - lu(k,1929) = lu(k,1929) - lu(k,1551) * lu(k,1927) - lu(k,1930) = lu(k,1930) - lu(k,1552) * lu(k,1927) - lu(k,1931) = lu(k,1931) - lu(k,1553) * lu(k,1927) - lu(k,1932) = lu(k,1932) - lu(k,1554) * lu(k,1927) - lu(k,1933) = lu(k,1933) - lu(k,1555) * lu(k,1927) - lu(k,1934) = lu(k,1934) - lu(k,1556) * lu(k,1927) - lu(k,1935) = lu(k,1935) - lu(k,1557) * lu(k,1927) - lu(k,1936) = lu(k,1936) - lu(k,1558) * lu(k,1927) - lu(k,1937) = lu(k,1937) - lu(k,1559) * lu(k,1927) - lu(k,1938) = lu(k,1938) - lu(k,1560) * lu(k,1927) - lu(k,1985) = lu(k,1985) - lu(k,1550) * lu(k,1984) - lu(k,1986) = lu(k,1986) - lu(k,1551) * lu(k,1984) - lu(k,1987) = lu(k,1987) - lu(k,1552) * lu(k,1984) - lu(k,1988) = lu(k,1988) - lu(k,1553) * lu(k,1984) - lu(k,1989) = lu(k,1989) - lu(k,1554) * lu(k,1984) - lu(k,1990) = lu(k,1990) - lu(k,1555) * lu(k,1984) - lu(k,1991) = lu(k,1991) - lu(k,1556) * lu(k,1984) - lu(k,1992) = lu(k,1992) - lu(k,1557) * lu(k,1984) - lu(k,1993) = lu(k,1993) - lu(k,1558) * lu(k,1984) - lu(k,1994) = lu(k,1994) - lu(k,1559) * lu(k,1984) - lu(k,1995) = lu(k,1995) - lu(k,1560) * lu(k,1984) - lu(k,2045) = lu(k,2045) - lu(k,1550) * lu(k,2044) - lu(k,2046) = lu(k,2046) - lu(k,1551) * lu(k,2044) - lu(k,2047) = lu(k,2047) - lu(k,1552) * lu(k,2044) - lu(k,2048) = lu(k,2048) - lu(k,1553) * lu(k,2044) - lu(k,2049) = lu(k,2049) - lu(k,1554) * lu(k,2044) - lu(k,2050) = lu(k,2050) - lu(k,1555) * lu(k,2044) - lu(k,2051) = lu(k,2051) - lu(k,1556) * lu(k,2044) - lu(k,2052) = lu(k,2052) - lu(k,1557) * lu(k,2044) - lu(k,2053) = lu(k,2053) - lu(k,1558) * lu(k,2044) - lu(k,2054) = lu(k,2054) - lu(k,1559) * lu(k,2044) - lu(k,2055) = lu(k,2055) - lu(k,1560) * lu(k,2044) - lu(k,2070) = lu(k,2070) - lu(k,1550) * lu(k,2069) - lu(k,2071) = lu(k,2071) - lu(k,1551) * lu(k,2069) - lu(k,2072) = lu(k,2072) - lu(k,1552) * lu(k,2069) - lu(k,2073) = lu(k,2073) - lu(k,1553) * lu(k,2069) - lu(k,2074) = lu(k,2074) - lu(k,1554) * lu(k,2069) - lu(k,2075) = lu(k,2075) - lu(k,1555) * lu(k,2069) - lu(k,2076) = lu(k,2076) - lu(k,1556) * lu(k,2069) - lu(k,2077) = lu(k,2077) - lu(k,1557) * lu(k,2069) - lu(k,2078) = lu(k,2078) - lu(k,1558) * lu(k,2069) - lu(k,2079) = lu(k,2079) - lu(k,1559) * lu(k,2069) - lu(k,2080) = lu(k,2080) - lu(k,1560) * lu(k,2069) + lu(k,1288) = 1._r8 / lu(k,1288) + lu(k,1289) = lu(k,1289) * lu(k,1288) + lu(k,1290) = lu(k,1290) * lu(k,1288) + lu(k,1291) = lu(k,1291) * lu(k,1288) + lu(k,1292) = lu(k,1292) * lu(k,1288) + lu(k,1293) = lu(k,1293) * lu(k,1288) + lu(k,1294) = lu(k,1294) * lu(k,1288) + lu(k,1295) = lu(k,1295) * lu(k,1288) + lu(k,1296) = lu(k,1296) * lu(k,1288) + lu(k,1297) = lu(k,1297) * lu(k,1288) + lu(k,1298) = lu(k,1298) * lu(k,1288) + lu(k,1299) = lu(k,1299) * lu(k,1288) + lu(k,1300) = lu(k,1300) * lu(k,1288) + lu(k,1301) = lu(k,1301) * lu(k,1288) + lu(k,1302) = lu(k,1302) * lu(k,1288) + lu(k,1303) = lu(k,1303) * lu(k,1288) + lu(k,1383) = lu(k,1383) - lu(k,1289) * lu(k,1382) + lu(k,1384) = lu(k,1384) - lu(k,1290) * lu(k,1382) + lu(k,1385) = lu(k,1385) - lu(k,1291) * lu(k,1382) + lu(k,1386) = lu(k,1386) - lu(k,1292) * lu(k,1382) + lu(k,1388) = lu(k,1388) - lu(k,1293) * lu(k,1382) + lu(k,1389) = lu(k,1389) - lu(k,1294) * lu(k,1382) + lu(k,1390) = lu(k,1390) - lu(k,1295) * lu(k,1382) + lu(k,1391) = lu(k,1391) - lu(k,1296) * lu(k,1382) + lu(k,1392) = lu(k,1392) - lu(k,1297) * lu(k,1382) + lu(k,1393) = lu(k,1393) - lu(k,1298) * lu(k,1382) + lu(k,1394) = lu(k,1394) - lu(k,1299) * lu(k,1382) + lu(k,1395) = lu(k,1395) - lu(k,1300) * lu(k,1382) + lu(k,1396) = lu(k,1396) - lu(k,1301) * lu(k,1382) + lu(k,1397) = lu(k,1397) - lu(k,1302) * lu(k,1382) + lu(k,1398) = lu(k,1398) - lu(k,1303) * lu(k,1382) + lu(k,1680) = lu(k,1680) - lu(k,1289) * lu(k,1679) + lu(k,1681) = lu(k,1681) - lu(k,1290) * lu(k,1679) + lu(k,1682) = lu(k,1682) - lu(k,1291) * lu(k,1679) + lu(k,1683) = lu(k,1683) - lu(k,1292) * lu(k,1679) + lu(k,1687) = lu(k,1687) - lu(k,1293) * lu(k,1679) + lu(k,1689) = lu(k,1689) - lu(k,1294) * lu(k,1679) + lu(k,1691) = lu(k,1691) - lu(k,1295) * lu(k,1679) + lu(k,1692) = lu(k,1692) - lu(k,1296) * lu(k,1679) + lu(k,1693) = lu(k,1693) - lu(k,1297) * lu(k,1679) + lu(k,1694) = lu(k,1694) - lu(k,1298) * lu(k,1679) + lu(k,1697) = lu(k,1697) - lu(k,1299) * lu(k,1679) + lu(k,1698) = lu(k,1698) - lu(k,1300) * lu(k,1679) + lu(k,1700) = lu(k,1700) - lu(k,1301) * lu(k,1679) + lu(k,1702) = lu(k,1702) - lu(k,1302) * lu(k,1679) + lu(k,1703) = lu(k,1703) - lu(k,1303) * lu(k,1679) + lu(k,1738) = lu(k,1738) - lu(k,1289) * lu(k,1737) + lu(k,1739) = lu(k,1739) - lu(k,1290) * lu(k,1737) + lu(k,1740) = lu(k,1740) - lu(k,1291) * lu(k,1737) + lu(k,1741) = lu(k,1741) - lu(k,1292) * lu(k,1737) + lu(k,1744) = lu(k,1744) - lu(k,1293) * lu(k,1737) + lu(k,1746) = lu(k,1746) - lu(k,1294) * lu(k,1737) + lu(k,1748) = lu(k,1748) - lu(k,1295) * lu(k,1737) + lu(k,1749) = lu(k,1749) - lu(k,1296) * lu(k,1737) + lu(k,1750) = lu(k,1750) - lu(k,1297) * lu(k,1737) + lu(k,1751) = lu(k,1751) - lu(k,1298) * lu(k,1737) + lu(k,1754) = lu(k,1754) - lu(k,1299) * lu(k,1737) + lu(k,1755) = lu(k,1755) - lu(k,1300) * lu(k,1737) + lu(k,1757) = lu(k,1757) - lu(k,1301) * lu(k,1737) + lu(k,1759) = lu(k,1759) - lu(k,1302) * lu(k,1737) + lu(k,1760) = lu(k,1760) - lu(k,1303) * lu(k,1737) + lu(k,1830) = lu(k,1830) - lu(k,1289) * lu(k,1829) + lu(k,1831) = lu(k,1831) - lu(k,1290) * lu(k,1829) + lu(k,1832) = lu(k,1832) - lu(k,1291) * lu(k,1829) + lu(k,1833) = lu(k,1833) - lu(k,1292) * lu(k,1829) + lu(k,1836) = lu(k,1836) - lu(k,1293) * lu(k,1829) + lu(k,1838) = lu(k,1838) - lu(k,1294) * lu(k,1829) + lu(k,1840) = lu(k,1840) - lu(k,1295) * lu(k,1829) + lu(k,1841) = lu(k,1841) - lu(k,1296) * lu(k,1829) + lu(k,1842) = lu(k,1842) - lu(k,1297) * lu(k,1829) + lu(k,1843) = lu(k,1843) - lu(k,1298) * lu(k,1829) + lu(k,1846) = lu(k,1846) - lu(k,1299) * lu(k,1829) + lu(k,1847) = lu(k,1847) - lu(k,1300) * lu(k,1829) + lu(k,1849) = lu(k,1849) - lu(k,1301) * lu(k,1829) + lu(k,1851) = lu(k,1851) - lu(k,1302) * lu(k,1829) + lu(k,1852) = lu(k,1852) - lu(k,1303) * lu(k,1829) + lu(k,1936) = lu(k,1936) - lu(k,1289) * lu(k,1935) + lu(k,1937) = lu(k,1937) - lu(k,1290) * lu(k,1935) + lu(k,1938) = lu(k,1938) - lu(k,1291) * lu(k,1935) + lu(k,1939) = lu(k,1939) - lu(k,1292) * lu(k,1935) + lu(k,1943) = lu(k,1943) - lu(k,1293) * lu(k,1935) + lu(k,1945) = lu(k,1945) - lu(k,1294) * lu(k,1935) + lu(k,1947) = lu(k,1947) - lu(k,1295) * lu(k,1935) + lu(k,1948) = lu(k,1948) - lu(k,1296) * lu(k,1935) + lu(k,1949) = lu(k,1949) - lu(k,1297) * lu(k,1935) + lu(k,1950) = lu(k,1950) - lu(k,1298) * lu(k,1935) + lu(k,1953) = lu(k,1953) - lu(k,1299) * lu(k,1935) + lu(k,1954) = lu(k,1954) - lu(k,1300) * lu(k,1935) + lu(k,1956) = lu(k,1956) - lu(k,1301) * lu(k,1935) + lu(k,1958) = lu(k,1958) - lu(k,1302) * lu(k,1935) + lu(k,1959) = lu(k,1959) - lu(k,1303) * lu(k,1935) + lu(k,2055) = lu(k,2055) - lu(k,1289) * lu(k,2054) + lu(k,2056) = lu(k,2056) - lu(k,1290) * lu(k,2054) + lu(k,2057) = lu(k,2057) - lu(k,1291) * lu(k,2054) + lu(k,2058) = lu(k,2058) - lu(k,1292) * lu(k,2054) + lu(k,2060) = lu(k,2060) - lu(k,1293) * lu(k,2054) + lu(k,2062) = lu(k,2062) - lu(k,1294) * lu(k,2054) + lu(k,2064) = lu(k,2064) - lu(k,1295) * lu(k,2054) + lu(k,2065) = lu(k,2065) - lu(k,1296) * lu(k,2054) + lu(k,2066) = lu(k,2066) - lu(k,1297) * lu(k,2054) + lu(k,2067) = lu(k,2067) - lu(k,1298) * lu(k,2054) + lu(k,2070) = lu(k,2070) - lu(k,1299) * lu(k,2054) + lu(k,2071) = lu(k,2071) - lu(k,1300) * lu(k,2054) + lu(k,2073) = lu(k,2073) - lu(k,1301) * lu(k,2054) + lu(k,2075) = lu(k,2075) - lu(k,1302) * lu(k,2054) + lu(k,2076) = lu(k,2076) - lu(k,1303) * lu(k,2054) + lu(k,2115) = lu(k,2115) - lu(k,1289) * lu(k,2114) + lu(k,2116) = lu(k,2116) - lu(k,1290) * lu(k,2114) + lu(k,2117) = lu(k,2117) - lu(k,1291) * lu(k,2114) + lu(k,2118) = lu(k,2118) - lu(k,1292) * lu(k,2114) + lu(k,2121) = lu(k,2121) - lu(k,1293) * lu(k,2114) + lu(k,2123) = lu(k,2123) - lu(k,1294) * lu(k,2114) + lu(k,2125) = lu(k,2125) - lu(k,1295) * lu(k,2114) + lu(k,2126) = lu(k,2126) - lu(k,1296) * lu(k,2114) + lu(k,2127) = lu(k,2127) - lu(k,1297) * lu(k,2114) + lu(k,2128) = lu(k,2128) - lu(k,1298) * lu(k,2114) + lu(k,2131) = lu(k,2131) - lu(k,1299) * lu(k,2114) + lu(k,2132) = lu(k,2132) - lu(k,1300) * lu(k,2114) + lu(k,2134) = lu(k,2134) - lu(k,1301) * lu(k,2114) + lu(k,2136) = lu(k,2136) - lu(k,1302) * lu(k,2114) + lu(k,2137) = lu(k,2137) - lu(k,1303) * lu(k,2114) + lu(k,1311) = 1._r8 / lu(k,1311) + lu(k,1312) = lu(k,1312) * lu(k,1311) + lu(k,1313) = lu(k,1313) * lu(k,1311) + lu(k,1314) = lu(k,1314) * lu(k,1311) + lu(k,1315) = lu(k,1315) * lu(k,1311) + lu(k,1316) = lu(k,1316) * lu(k,1311) + lu(k,1317) = lu(k,1317) * lu(k,1311) + lu(k,1318) = lu(k,1318) * lu(k,1311) + lu(k,1319) = lu(k,1319) * lu(k,1311) + lu(k,1320) = lu(k,1320) * lu(k,1311) + lu(k,1321) = lu(k,1321) * lu(k,1311) + lu(k,1322) = lu(k,1322) * lu(k,1311) + lu(k,1323) = lu(k,1323) * lu(k,1311) + lu(k,1333) = - lu(k,1312) * lu(k,1331) + lu(k,1334) = lu(k,1334) - lu(k,1313) * lu(k,1331) + lu(k,1336) = lu(k,1336) - lu(k,1314) * lu(k,1331) + lu(k,1337) = lu(k,1337) - lu(k,1315) * lu(k,1331) + lu(k,1338) = lu(k,1338) - lu(k,1316) * lu(k,1331) + lu(k,1339) = lu(k,1339) - lu(k,1317) * lu(k,1331) + lu(k,1340) = lu(k,1340) - lu(k,1318) * lu(k,1331) + lu(k,1341) = lu(k,1341) - lu(k,1319) * lu(k,1331) + lu(k,1342) = lu(k,1342) - lu(k,1320) * lu(k,1331) + lu(k,1344) = lu(k,1344) - lu(k,1321) * lu(k,1331) + lu(k,1345) = lu(k,1345) - lu(k,1322) * lu(k,1331) + lu(k,1346) = lu(k,1346) - lu(k,1323) * lu(k,1331) + lu(k,1385) = lu(k,1385) - lu(k,1312) * lu(k,1383) + lu(k,1386) = lu(k,1386) - lu(k,1313) * lu(k,1383) + lu(k,1388) = lu(k,1388) - lu(k,1314) * lu(k,1383) + lu(k,1389) = lu(k,1389) - lu(k,1315) * lu(k,1383) + lu(k,1390) = lu(k,1390) - lu(k,1316) * lu(k,1383) + lu(k,1391) = lu(k,1391) - lu(k,1317) * lu(k,1383) + lu(k,1392) = lu(k,1392) - lu(k,1318) * lu(k,1383) + lu(k,1393) = lu(k,1393) - lu(k,1319) * lu(k,1383) + lu(k,1394) = lu(k,1394) - lu(k,1320) * lu(k,1383) + lu(k,1396) = lu(k,1396) - lu(k,1321) * lu(k,1383) + lu(k,1397) = lu(k,1397) - lu(k,1322) * lu(k,1383) + lu(k,1398) = lu(k,1398) - lu(k,1323) * lu(k,1383) + lu(k,1682) = lu(k,1682) - lu(k,1312) * lu(k,1680) + lu(k,1683) = lu(k,1683) - lu(k,1313) * lu(k,1680) + lu(k,1687) = lu(k,1687) - lu(k,1314) * lu(k,1680) + lu(k,1689) = lu(k,1689) - lu(k,1315) * lu(k,1680) + lu(k,1691) = lu(k,1691) - lu(k,1316) * lu(k,1680) + lu(k,1692) = lu(k,1692) - lu(k,1317) * lu(k,1680) + lu(k,1693) = lu(k,1693) - lu(k,1318) * lu(k,1680) + lu(k,1694) = lu(k,1694) - lu(k,1319) * lu(k,1680) + lu(k,1697) = lu(k,1697) - lu(k,1320) * lu(k,1680) + lu(k,1700) = lu(k,1700) - lu(k,1321) * lu(k,1680) + lu(k,1702) = lu(k,1702) - lu(k,1322) * lu(k,1680) + lu(k,1703) = lu(k,1703) - lu(k,1323) * lu(k,1680) + lu(k,1740) = lu(k,1740) - lu(k,1312) * lu(k,1738) + lu(k,1741) = lu(k,1741) - lu(k,1313) * lu(k,1738) + lu(k,1744) = lu(k,1744) - lu(k,1314) * lu(k,1738) + lu(k,1746) = lu(k,1746) - lu(k,1315) * lu(k,1738) + lu(k,1748) = lu(k,1748) - lu(k,1316) * lu(k,1738) + lu(k,1749) = lu(k,1749) - lu(k,1317) * lu(k,1738) + lu(k,1750) = lu(k,1750) - lu(k,1318) * lu(k,1738) + lu(k,1751) = lu(k,1751) - lu(k,1319) * lu(k,1738) + lu(k,1754) = lu(k,1754) - lu(k,1320) * lu(k,1738) + lu(k,1757) = lu(k,1757) - lu(k,1321) * lu(k,1738) + lu(k,1759) = lu(k,1759) - lu(k,1322) * lu(k,1738) + lu(k,1760) = lu(k,1760) - lu(k,1323) * lu(k,1738) + lu(k,1832) = lu(k,1832) - lu(k,1312) * lu(k,1830) + lu(k,1833) = lu(k,1833) - lu(k,1313) * lu(k,1830) + lu(k,1836) = lu(k,1836) - lu(k,1314) * lu(k,1830) + lu(k,1838) = lu(k,1838) - lu(k,1315) * lu(k,1830) + lu(k,1840) = lu(k,1840) - lu(k,1316) * lu(k,1830) + lu(k,1841) = lu(k,1841) - lu(k,1317) * lu(k,1830) + lu(k,1842) = lu(k,1842) - lu(k,1318) * lu(k,1830) + lu(k,1843) = lu(k,1843) - lu(k,1319) * lu(k,1830) + lu(k,1846) = lu(k,1846) - lu(k,1320) * lu(k,1830) + lu(k,1849) = lu(k,1849) - lu(k,1321) * lu(k,1830) + lu(k,1851) = lu(k,1851) - lu(k,1322) * lu(k,1830) + lu(k,1852) = lu(k,1852) - lu(k,1323) * lu(k,1830) + lu(k,1938) = lu(k,1938) - lu(k,1312) * lu(k,1936) + lu(k,1939) = lu(k,1939) - lu(k,1313) * lu(k,1936) + lu(k,1943) = lu(k,1943) - lu(k,1314) * lu(k,1936) + lu(k,1945) = lu(k,1945) - lu(k,1315) * lu(k,1936) + lu(k,1947) = lu(k,1947) - lu(k,1316) * lu(k,1936) + lu(k,1948) = lu(k,1948) - lu(k,1317) * lu(k,1936) + lu(k,1949) = lu(k,1949) - lu(k,1318) * lu(k,1936) + lu(k,1950) = lu(k,1950) - lu(k,1319) * lu(k,1936) + lu(k,1953) = lu(k,1953) - lu(k,1320) * lu(k,1936) + lu(k,1956) = lu(k,1956) - lu(k,1321) * lu(k,1936) + lu(k,1958) = lu(k,1958) - lu(k,1322) * lu(k,1936) + lu(k,1959) = lu(k,1959) - lu(k,1323) * lu(k,1936) + lu(k,2057) = lu(k,2057) - lu(k,1312) * lu(k,2055) + lu(k,2058) = lu(k,2058) - lu(k,1313) * lu(k,2055) + lu(k,2060) = lu(k,2060) - lu(k,1314) * lu(k,2055) + lu(k,2062) = lu(k,2062) - lu(k,1315) * lu(k,2055) + lu(k,2064) = lu(k,2064) - lu(k,1316) * lu(k,2055) + lu(k,2065) = lu(k,2065) - lu(k,1317) * lu(k,2055) + lu(k,2066) = lu(k,2066) - lu(k,1318) * lu(k,2055) + lu(k,2067) = lu(k,2067) - lu(k,1319) * lu(k,2055) + lu(k,2070) = lu(k,2070) - lu(k,1320) * lu(k,2055) + lu(k,2073) = lu(k,2073) - lu(k,1321) * lu(k,2055) + lu(k,2075) = lu(k,2075) - lu(k,1322) * lu(k,2055) + lu(k,2076) = lu(k,2076) - lu(k,1323) * lu(k,2055) + lu(k,2117) = lu(k,2117) - lu(k,1312) * lu(k,2115) + lu(k,2118) = lu(k,2118) - lu(k,1313) * lu(k,2115) + lu(k,2121) = lu(k,2121) - lu(k,1314) * lu(k,2115) + lu(k,2123) = lu(k,2123) - lu(k,1315) * lu(k,2115) + lu(k,2125) = lu(k,2125) - lu(k,1316) * lu(k,2115) + lu(k,2126) = lu(k,2126) - lu(k,1317) * lu(k,2115) + lu(k,2127) = lu(k,2127) - lu(k,1318) * lu(k,2115) + lu(k,2128) = lu(k,2128) - lu(k,1319) * lu(k,2115) + lu(k,2131) = lu(k,2131) - lu(k,1320) * lu(k,2115) + lu(k,2134) = lu(k,2134) - lu(k,1321) * lu(k,2115) + lu(k,2136) = lu(k,2136) - lu(k,1322) * lu(k,2115) + lu(k,2137) = lu(k,2137) - lu(k,1323) * lu(k,2115) + lu(k,1332) = 1._r8 / lu(k,1332) + lu(k,1333) = lu(k,1333) * lu(k,1332) + lu(k,1334) = lu(k,1334) * lu(k,1332) + lu(k,1335) = lu(k,1335) * lu(k,1332) + lu(k,1336) = lu(k,1336) * lu(k,1332) + lu(k,1337) = lu(k,1337) * lu(k,1332) + lu(k,1338) = lu(k,1338) * lu(k,1332) + lu(k,1339) = lu(k,1339) * lu(k,1332) + lu(k,1340) = lu(k,1340) * lu(k,1332) + lu(k,1341) = lu(k,1341) * lu(k,1332) + lu(k,1342) = lu(k,1342) * lu(k,1332) + lu(k,1343) = lu(k,1343) * lu(k,1332) + lu(k,1344) = lu(k,1344) * lu(k,1332) + lu(k,1345) = lu(k,1345) * lu(k,1332) + lu(k,1346) = lu(k,1346) * lu(k,1332) + lu(k,1385) = lu(k,1385) - lu(k,1333) * lu(k,1384) + lu(k,1386) = lu(k,1386) - lu(k,1334) * lu(k,1384) + lu(k,1387) = - lu(k,1335) * lu(k,1384) + lu(k,1388) = lu(k,1388) - lu(k,1336) * lu(k,1384) + lu(k,1389) = lu(k,1389) - lu(k,1337) * lu(k,1384) + lu(k,1390) = lu(k,1390) - lu(k,1338) * lu(k,1384) + lu(k,1391) = lu(k,1391) - lu(k,1339) * lu(k,1384) + lu(k,1392) = lu(k,1392) - lu(k,1340) * lu(k,1384) + lu(k,1393) = lu(k,1393) - lu(k,1341) * lu(k,1384) + lu(k,1394) = lu(k,1394) - lu(k,1342) * lu(k,1384) + lu(k,1395) = lu(k,1395) - lu(k,1343) * lu(k,1384) + lu(k,1396) = lu(k,1396) - lu(k,1344) * lu(k,1384) + lu(k,1397) = lu(k,1397) - lu(k,1345) * lu(k,1384) + lu(k,1398) = lu(k,1398) - lu(k,1346) * lu(k,1384) + lu(k,1682) = lu(k,1682) - lu(k,1333) * lu(k,1681) + lu(k,1683) = lu(k,1683) - lu(k,1334) * lu(k,1681) + lu(k,1686) = lu(k,1686) - lu(k,1335) * lu(k,1681) + lu(k,1687) = lu(k,1687) - lu(k,1336) * lu(k,1681) + lu(k,1689) = lu(k,1689) - lu(k,1337) * lu(k,1681) + lu(k,1691) = lu(k,1691) - lu(k,1338) * lu(k,1681) + lu(k,1692) = lu(k,1692) - lu(k,1339) * lu(k,1681) + lu(k,1693) = lu(k,1693) - lu(k,1340) * lu(k,1681) + lu(k,1694) = lu(k,1694) - lu(k,1341) * lu(k,1681) + lu(k,1697) = lu(k,1697) - lu(k,1342) * lu(k,1681) + lu(k,1698) = lu(k,1698) - lu(k,1343) * lu(k,1681) + lu(k,1700) = lu(k,1700) - lu(k,1344) * lu(k,1681) + lu(k,1702) = lu(k,1702) - lu(k,1345) * lu(k,1681) + lu(k,1703) = lu(k,1703) - lu(k,1346) * lu(k,1681) + lu(k,1740) = lu(k,1740) - lu(k,1333) * lu(k,1739) + lu(k,1741) = lu(k,1741) - lu(k,1334) * lu(k,1739) + lu(k,1743) = lu(k,1743) - lu(k,1335) * lu(k,1739) + lu(k,1744) = lu(k,1744) - lu(k,1336) * lu(k,1739) + lu(k,1746) = lu(k,1746) - lu(k,1337) * lu(k,1739) + lu(k,1748) = lu(k,1748) - lu(k,1338) * lu(k,1739) + lu(k,1749) = lu(k,1749) - lu(k,1339) * lu(k,1739) + lu(k,1750) = lu(k,1750) - lu(k,1340) * lu(k,1739) + lu(k,1751) = lu(k,1751) - lu(k,1341) * lu(k,1739) + lu(k,1754) = lu(k,1754) - lu(k,1342) * lu(k,1739) + lu(k,1755) = lu(k,1755) - lu(k,1343) * lu(k,1739) + lu(k,1757) = lu(k,1757) - lu(k,1344) * lu(k,1739) + lu(k,1759) = lu(k,1759) - lu(k,1345) * lu(k,1739) + lu(k,1760) = lu(k,1760) - lu(k,1346) * lu(k,1739) + lu(k,1832) = lu(k,1832) - lu(k,1333) * lu(k,1831) + lu(k,1833) = lu(k,1833) - lu(k,1334) * lu(k,1831) + lu(k,1835) = - lu(k,1335) * lu(k,1831) + lu(k,1836) = lu(k,1836) - lu(k,1336) * lu(k,1831) + lu(k,1838) = lu(k,1838) - lu(k,1337) * lu(k,1831) + lu(k,1840) = lu(k,1840) - lu(k,1338) * lu(k,1831) + lu(k,1841) = lu(k,1841) - lu(k,1339) * lu(k,1831) + lu(k,1842) = lu(k,1842) - lu(k,1340) * lu(k,1831) + lu(k,1843) = lu(k,1843) - lu(k,1341) * lu(k,1831) + lu(k,1846) = lu(k,1846) - lu(k,1342) * lu(k,1831) + lu(k,1847) = lu(k,1847) - lu(k,1343) * lu(k,1831) + lu(k,1849) = lu(k,1849) - lu(k,1344) * lu(k,1831) + lu(k,1851) = lu(k,1851) - lu(k,1345) * lu(k,1831) + lu(k,1852) = lu(k,1852) - lu(k,1346) * lu(k,1831) + lu(k,1938) = lu(k,1938) - lu(k,1333) * lu(k,1937) + lu(k,1939) = lu(k,1939) - lu(k,1334) * lu(k,1937) + lu(k,1942) = - lu(k,1335) * lu(k,1937) + lu(k,1943) = lu(k,1943) - lu(k,1336) * lu(k,1937) + lu(k,1945) = lu(k,1945) - lu(k,1337) * lu(k,1937) + lu(k,1947) = lu(k,1947) - lu(k,1338) * lu(k,1937) + lu(k,1948) = lu(k,1948) - lu(k,1339) * lu(k,1937) + lu(k,1949) = lu(k,1949) - lu(k,1340) * lu(k,1937) + lu(k,1950) = lu(k,1950) - lu(k,1341) * lu(k,1937) + lu(k,1953) = lu(k,1953) - lu(k,1342) * lu(k,1937) + lu(k,1954) = lu(k,1954) - lu(k,1343) * lu(k,1937) + lu(k,1956) = lu(k,1956) - lu(k,1344) * lu(k,1937) + lu(k,1958) = lu(k,1958) - lu(k,1345) * lu(k,1937) + lu(k,1959) = lu(k,1959) - lu(k,1346) * lu(k,1937) + lu(k,2057) = lu(k,2057) - lu(k,1333) * lu(k,2056) + lu(k,2058) = lu(k,2058) - lu(k,1334) * lu(k,2056) + lu(k,2059) = - lu(k,1335) * lu(k,2056) + lu(k,2060) = lu(k,2060) - lu(k,1336) * lu(k,2056) + lu(k,2062) = lu(k,2062) - lu(k,1337) * lu(k,2056) + lu(k,2064) = lu(k,2064) - lu(k,1338) * lu(k,2056) + lu(k,2065) = lu(k,2065) - lu(k,1339) * lu(k,2056) + lu(k,2066) = lu(k,2066) - lu(k,1340) * lu(k,2056) + lu(k,2067) = lu(k,2067) - lu(k,1341) * lu(k,2056) + lu(k,2070) = lu(k,2070) - lu(k,1342) * lu(k,2056) + lu(k,2071) = lu(k,2071) - lu(k,1343) * lu(k,2056) + lu(k,2073) = lu(k,2073) - lu(k,1344) * lu(k,2056) + lu(k,2075) = lu(k,2075) - lu(k,1345) * lu(k,2056) + lu(k,2076) = lu(k,2076) - lu(k,1346) * lu(k,2056) + lu(k,2117) = lu(k,2117) - lu(k,1333) * lu(k,2116) + lu(k,2118) = lu(k,2118) - lu(k,1334) * lu(k,2116) + lu(k,2120) = lu(k,2120) - lu(k,1335) * lu(k,2116) + lu(k,2121) = lu(k,2121) - lu(k,1336) * lu(k,2116) + lu(k,2123) = lu(k,2123) - lu(k,1337) * lu(k,2116) + lu(k,2125) = lu(k,2125) - lu(k,1338) * lu(k,2116) + lu(k,2126) = lu(k,2126) - lu(k,1339) * lu(k,2116) + lu(k,2127) = lu(k,2127) - lu(k,1340) * lu(k,2116) + lu(k,2128) = lu(k,2128) - lu(k,1341) * lu(k,2116) + lu(k,2131) = lu(k,2131) - lu(k,1342) * lu(k,2116) + lu(k,2132) = lu(k,2132) - lu(k,1343) * lu(k,2116) + lu(k,2134) = lu(k,2134) - lu(k,1344) * lu(k,2116) + lu(k,2136) = lu(k,2136) - lu(k,1345) * lu(k,2116) + lu(k,2137) = lu(k,2137) - lu(k,1346) * lu(k,2116) + lu(k,1354) = 1._r8 / lu(k,1354) + lu(k,1355) = lu(k,1355) * lu(k,1354) + lu(k,1356) = lu(k,1356) * lu(k,1354) + lu(k,1357) = lu(k,1357) * lu(k,1354) + lu(k,1358) = lu(k,1358) * lu(k,1354) + lu(k,1359) = lu(k,1359) * lu(k,1354) + lu(k,1360) = lu(k,1360) * lu(k,1354) + lu(k,1361) = lu(k,1361) * lu(k,1354) + lu(k,1362) = lu(k,1362) * lu(k,1354) + lu(k,1363) = lu(k,1363) * lu(k,1354) + lu(k,1364) = lu(k,1364) * lu(k,1354) + lu(k,1365) = lu(k,1365) * lu(k,1354) + lu(k,1366) = lu(k,1366) * lu(k,1354) + lu(k,1386) = lu(k,1386) - lu(k,1355) * lu(k,1385) + lu(k,1388) = lu(k,1388) - lu(k,1356) * lu(k,1385) + lu(k,1389) = lu(k,1389) - lu(k,1357) * lu(k,1385) + lu(k,1390) = lu(k,1390) - lu(k,1358) * lu(k,1385) + lu(k,1391) = lu(k,1391) - lu(k,1359) * lu(k,1385) + lu(k,1392) = lu(k,1392) - lu(k,1360) * lu(k,1385) + lu(k,1393) = lu(k,1393) - lu(k,1361) * lu(k,1385) + lu(k,1394) = lu(k,1394) - lu(k,1362) * lu(k,1385) + lu(k,1395) = lu(k,1395) - lu(k,1363) * lu(k,1385) + lu(k,1396) = lu(k,1396) - lu(k,1364) * lu(k,1385) + lu(k,1397) = lu(k,1397) - lu(k,1365) * lu(k,1385) + lu(k,1398) = lu(k,1398) - lu(k,1366) * lu(k,1385) + lu(k,1683) = lu(k,1683) - lu(k,1355) * lu(k,1682) + lu(k,1687) = lu(k,1687) - lu(k,1356) * lu(k,1682) + lu(k,1689) = lu(k,1689) - lu(k,1357) * lu(k,1682) + lu(k,1691) = lu(k,1691) - lu(k,1358) * lu(k,1682) + lu(k,1692) = lu(k,1692) - lu(k,1359) * lu(k,1682) + lu(k,1693) = lu(k,1693) - lu(k,1360) * lu(k,1682) + lu(k,1694) = lu(k,1694) - lu(k,1361) * lu(k,1682) + lu(k,1697) = lu(k,1697) - lu(k,1362) * lu(k,1682) + lu(k,1698) = lu(k,1698) - lu(k,1363) * lu(k,1682) + lu(k,1700) = lu(k,1700) - lu(k,1364) * lu(k,1682) + lu(k,1702) = lu(k,1702) - lu(k,1365) * lu(k,1682) + lu(k,1703) = lu(k,1703) - lu(k,1366) * lu(k,1682) + lu(k,1741) = lu(k,1741) - lu(k,1355) * lu(k,1740) + lu(k,1744) = lu(k,1744) - lu(k,1356) * lu(k,1740) + lu(k,1746) = lu(k,1746) - lu(k,1357) * lu(k,1740) + lu(k,1748) = lu(k,1748) - lu(k,1358) * lu(k,1740) + lu(k,1749) = lu(k,1749) - lu(k,1359) * lu(k,1740) + lu(k,1750) = lu(k,1750) - lu(k,1360) * lu(k,1740) + lu(k,1751) = lu(k,1751) - lu(k,1361) * lu(k,1740) + lu(k,1754) = lu(k,1754) - lu(k,1362) * lu(k,1740) + lu(k,1755) = lu(k,1755) - lu(k,1363) * lu(k,1740) + lu(k,1757) = lu(k,1757) - lu(k,1364) * lu(k,1740) + lu(k,1759) = lu(k,1759) - lu(k,1365) * lu(k,1740) + lu(k,1760) = lu(k,1760) - lu(k,1366) * lu(k,1740) + lu(k,1833) = lu(k,1833) - lu(k,1355) * lu(k,1832) + lu(k,1836) = lu(k,1836) - lu(k,1356) * lu(k,1832) + lu(k,1838) = lu(k,1838) - lu(k,1357) * lu(k,1832) + lu(k,1840) = lu(k,1840) - lu(k,1358) * lu(k,1832) + lu(k,1841) = lu(k,1841) - lu(k,1359) * lu(k,1832) + lu(k,1842) = lu(k,1842) - lu(k,1360) * lu(k,1832) + lu(k,1843) = lu(k,1843) - lu(k,1361) * lu(k,1832) + lu(k,1846) = lu(k,1846) - lu(k,1362) * lu(k,1832) + lu(k,1847) = lu(k,1847) - lu(k,1363) * lu(k,1832) + lu(k,1849) = lu(k,1849) - lu(k,1364) * lu(k,1832) + lu(k,1851) = lu(k,1851) - lu(k,1365) * lu(k,1832) + lu(k,1852) = lu(k,1852) - lu(k,1366) * lu(k,1832) + lu(k,1939) = lu(k,1939) - lu(k,1355) * lu(k,1938) + lu(k,1943) = lu(k,1943) - lu(k,1356) * lu(k,1938) + lu(k,1945) = lu(k,1945) - lu(k,1357) * lu(k,1938) + lu(k,1947) = lu(k,1947) - lu(k,1358) * lu(k,1938) + lu(k,1948) = lu(k,1948) - lu(k,1359) * lu(k,1938) + lu(k,1949) = lu(k,1949) - lu(k,1360) * lu(k,1938) + lu(k,1950) = lu(k,1950) - lu(k,1361) * lu(k,1938) + lu(k,1953) = lu(k,1953) - lu(k,1362) * lu(k,1938) + lu(k,1954) = lu(k,1954) - lu(k,1363) * lu(k,1938) + lu(k,1956) = lu(k,1956) - lu(k,1364) * lu(k,1938) + lu(k,1958) = lu(k,1958) - lu(k,1365) * lu(k,1938) + lu(k,1959) = lu(k,1959) - lu(k,1366) * lu(k,1938) + lu(k,2058) = lu(k,2058) - lu(k,1355) * lu(k,2057) + lu(k,2060) = lu(k,2060) - lu(k,1356) * lu(k,2057) + lu(k,2062) = lu(k,2062) - lu(k,1357) * lu(k,2057) + lu(k,2064) = lu(k,2064) - lu(k,1358) * lu(k,2057) + lu(k,2065) = lu(k,2065) - lu(k,1359) * lu(k,2057) + lu(k,2066) = lu(k,2066) - lu(k,1360) * lu(k,2057) + lu(k,2067) = lu(k,2067) - lu(k,1361) * lu(k,2057) + lu(k,2070) = lu(k,2070) - lu(k,1362) * lu(k,2057) + lu(k,2071) = lu(k,2071) - lu(k,1363) * lu(k,2057) + lu(k,2073) = lu(k,2073) - lu(k,1364) * lu(k,2057) + lu(k,2075) = lu(k,2075) - lu(k,1365) * lu(k,2057) + lu(k,2076) = lu(k,2076) - lu(k,1366) * lu(k,2057) + lu(k,2118) = lu(k,2118) - lu(k,1355) * lu(k,2117) + lu(k,2121) = lu(k,2121) - lu(k,1356) * lu(k,2117) + lu(k,2123) = lu(k,2123) - lu(k,1357) * lu(k,2117) + lu(k,2125) = lu(k,2125) - lu(k,1358) * lu(k,2117) + lu(k,2126) = lu(k,2126) - lu(k,1359) * lu(k,2117) + lu(k,2127) = lu(k,2127) - lu(k,1360) * lu(k,2117) + lu(k,2128) = lu(k,2128) - lu(k,1361) * lu(k,2117) + lu(k,2131) = lu(k,2131) - lu(k,1362) * lu(k,2117) + lu(k,2132) = lu(k,2132) - lu(k,1363) * lu(k,2117) + lu(k,2134) = lu(k,2134) - lu(k,1364) * lu(k,2117) + lu(k,2136) = lu(k,2136) - lu(k,1365) * lu(k,2117) + lu(k,2137) = lu(k,2137) - lu(k,1366) * lu(k,2117) + lu(k,2185) = lu(k,2185) - lu(k,1355) * lu(k,2184) + lu(k,2188) = lu(k,2188) - lu(k,1356) * lu(k,2184) + lu(k,2190) = lu(k,2190) - lu(k,1357) * lu(k,2184) + lu(k,2192) = lu(k,2192) - lu(k,1358) * lu(k,2184) + lu(k,2193) = lu(k,2193) - lu(k,1359) * lu(k,2184) + lu(k,2194) = lu(k,2194) - lu(k,1360) * lu(k,2184) + lu(k,2195) = lu(k,2195) - lu(k,1361) * lu(k,2184) + lu(k,2198) = lu(k,2198) - lu(k,1362) * lu(k,2184) + lu(k,2199) = lu(k,2199) - lu(k,1363) * lu(k,2184) + lu(k,2201) = lu(k,2201) - lu(k,1364) * lu(k,2184) + lu(k,2203) = lu(k,2203) - lu(k,1365) * lu(k,2184) + lu(k,2204) = lu(k,2204) - lu(k,1366) * lu(k,2184) end do end subroutine lu_fac26 subroutine lu_fac27( avec_len, lu ) @@ -6816,117 +5833,1363 @@ subroutine lu_fac27( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1640) = 1._r8 / lu(k,1640) - lu(k,1641) = lu(k,1641) * lu(k,1640) - lu(k,1642) = lu(k,1642) * lu(k,1640) - lu(k,1643) = lu(k,1643) * lu(k,1640) - lu(k,1644) = lu(k,1644) * lu(k,1640) - lu(k,1645) = lu(k,1645) * lu(k,1640) - lu(k,1646) = lu(k,1646) * lu(k,1640) - lu(k,1647) = lu(k,1647) * lu(k,1640) - lu(k,1648) = lu(k,1648) * lu(k,1640) - lu(k,1649) = lu(k,1649) * lu(k,1640) - lu(k,1650) = lu(k,1650) * lu(k,1640) - lu(k,1691) = lu(k,1691) - lu(k,1641) * lu(k,1690) - lu(k,1692) = lu(k,1692) - lu(k,1642) * lu(k,1690) - lu(k,1693) = lu(k,1693) - lu(k,1643) * lu(k,1690) - lu(k,1694) = lu(k,1694) - lu(k,1644) * lu(k,1690) - lu(k,1695) = lu(k,1695) - lu(k,1645) * lu(k,1690) - lu(k,1696) = lu(k,1696) - lu(k,1646) * lu(k,1690) - lu(k,1697) = lu(k,1697) - lu(k,1647) * lu(k,1690) - lu(k,1698) = lu(k,1698) - lu(k,1648) * lu(k,1690) - lu(k,1699) = lu(k,1699) - lu(k,1649) * lu(k,1690) - lu(k,1700) = lu(k,1700) - lu(k,1650) * lu(k,1690) - lu(k,1715) = lu(k,1715) - lu(k,1641) * lu(k,1714) - lu(k,1716) = lu(k,1716) - lu(k,1642) * lu(k,1714) - lu(k,1717) = lu(k,1717) - lu(k,1643) * lu(k,1714) - lu(k,1718) = lu(k,1718) - lu(k,1644) * lu(k,1714) - lu(k,1719) = lu(k,1719) - lu(k,1645) * lu(k,1714) - lu(k,1720) = lu(k,1720) - lu(k,1646) * lu(k,1714) - lu(k,1721) = lu(k,1721) - lu(k,1647) * lu(k,1714) - lu(k,1722) = lu(k,1722) - lu(k,1648) * lu(k,1714) - lu(k,1723) = lu(k,1723) - lu(k,1649) * lu(k,1714) - lu(k,1724) = lu(k,1724) - lu(k,1650) * lu(k,1714) - lu(k,1737) = lu(k,1737) - lu(k,1641) * lu(k,1736) - lu(k,1738) = lu(k,1738) - lu(k,1642) * lu(k,1736) - lu(k,1739) = lu(k,1739) - lu(k,1643) * lu(k,1736) - lu(k,1740) = lu(k,1740) - lu(k,1644) * lu(k,1736) - lu(k,1741) = lu(k,1741) - lu(k,1645) * lu(k,1736) - lu(k,1742) = lu(k,1742) - lu(k,1646) * lu(k,1736) - lu(k,1743) = lu(k,1743) - lu(k,1647) * lu(k,1736) - lu(k,1744) = lu(k,1744) - lu(k,1648) * lu(k,1736) - lu(k,1745) = lu(k,1745) - lu(k,1649) * lu(k,1736) - lu(k,1746) = lu(k,1746) - lu(k,1650) * lu(k,1736) - lu(k,1842) = lu(k,1842) - lu(k,1641) * lu(k,1841) - lu(k,1843) = lu(k,1843) - lu(k,1642) * lu(k,1841) - lu(k,1844) = lu(k,1844) - lu(k,1643) * lu(k,1841) - lu(k,1845) = lu(k,1845) - lu(k,1644) * lu(k,1841) - lu(k,1846) = lu(k,1846) - lu(k,1645) * lu(k,1841) - lu(k,1847) = lu(k,1847) - lu(k,1646) * lu(k,1841) - lu(k,1848) = lu(k,1848) - lu(k,1647) * lu(k,1841) - lu(k,1849) = lu(k,1849) - lu(k,1648) * lu(k,1841) - lu(k,1850) = lu(k,1850) - lu(k,1649) * lu(k,1841) - lu(k,1851) = lu(k,1851) - lu(k,1650) * lu(k,1841) - lu(k,1872) = lu(k,1872) - lu(k,1641) * lu(k,1871) - lu(k,1873) = lu(k,1873) - lu(k,1642) * lu(k,1871) - lu(k,1874) = lu(k,1874) - lu(k,1643) * lu(k,1871) - lu(k,1875) = lu(k,1875) - lu(k,1644) * lu(k,1871) - lu(k,1876) = lu(k,1876) - lu(k,1645) * lu(k,1871) - lu(k,1877) = lu(k,1877) - lu(k,1646) * lu(k,1871) - lu(k,1878) = lu(k,1878) - lu(k,1647) * lu(k,1871) - lu(k,1879) = lu(k,1879) - lu(k,1648) * lu(k,1871) - lu(k,1880) = lu(k,1880) - lu(k,1649) * lu(k,1871) - lu(k,1881) = lu(k,1881) - lu(k,1650) * lu(k,1871) - lu(k,1895) = lu(k,1895) - lu(k,1641) * lu(k,1894) - lu(k,1896) = lu(k,1896) - lu(k,1642) * lu(k,1894) - lu(k,1897) = lu(k,1897) - lu(k,1643) * lu(k,1894) - lu(k,1898) = lu(k,1898) - lu(k,1644) * lu(k,1894) - lu(k,1899) = lu(k,1899) - lu(k,1645) * lu(k,1894) - lu(k,1900) = lu(k,1900) - lu(k,1646) * lu(k,1894) - lu(k,1901) = lu(k,1901) - lu(k,1647) * lu(k,1894) - lu(k,1902) = lu(k,1902) - lu(k,1648) * lu(k,1894) - lu(k,1903) = lu(k,1903) - lu(k,1649) * lu(k,1894) - lu(k,1904) = lu(k,1904) - lu(k,1650) * lu(k,1894) - lu(k,1929) = lu(k,1929) - lu(k,1641) * lu(k,1928) - lu(k,1930) = lu(k,1930) - lu(k,1642) * lu(k,1928) - lu(k,1931) = lu(k,1931) - lu(k,1643) * lu(k,1928) - lu(k,1932) = lu(k,1932) - lu(k,1644) * lu(k,1928) - lu(k,1933) = lu(k,1933) - lu(k,1645) * lu(k,1928) - lu(k,1934) = lu(k,1934) - lu(k,1646) * lu(k,1928) - lu(k,1935) = lu(k,1935) - lu(k,1647) * lu(k,1928) - lu(k,1936) = lu(k,1936) - lu(k,1648) * lu(k,1928) - lu(k,1937) = lu(k,1937) - lu(k,1649) * lu(k,1928) - lu(k,1938) = lu(k,1938) - lu(k,1650) * lu(k,1928) - lu(k,1986) = lu(k,1986) - lu(k,1641) * lu(k,1985) - lu(k,1987) = lu(k,1987) - lu(k,1642) * lu(k,1985) - lu(k,1988) = lu(k,1988) - lu(k,1643) * lu(k,1985) - lu(k,1989) = lu(k,1989) - lu(k,1644) * lu(k,1985) - lu(k,1990) = lu(k,1990) - lu(k,1645) * lu(k,1985) - lu(k,1991) = lu(k,1991) - lu(k,1646) * lu(k,1985) - lu(k,1992) = lu(k,1992) - lu(k,1647) * lu(k,1985) - lu(k,1993) = lu(k,1993) - lu(k,1648) * lu(k,1985) - lu(k,1994) = lu(k,1994) - lu(k,1649) * lu(k,1985) - lu(k,1995) = lu(k,1995) - lu(k,1650) * lu(k,1985) - lu(k,2046) = lu(k,2046) - lu(k,1641) * lu(k,2045) - lu(k,2047) = lu(k,2047) - lu(k,1642) * lu(k,2045) - lu(k,2048) = lu(k,2048) - lu(k,1643) * lu(k,2045) - lu(k,2049) = lu(k,2049) - lu(k,1644) * lu(k,2045) - lu(k,2050) = lu(k,2050) - lu(k,1645) * lu(k,2045) - lu(k,2051) = lu(k,2051) - lu(k,1646) * lu(k,2045) - lu(k,2052) = lu(k,2052) - lu(k,1647) * lu(k,2045) - lu(k,2053) = lu(k,2053) - lu(k,1648) * lu(k,2045) - lu(k,2054) = lu(k,2054) - lu(k,1649) * lu(k,2045) - lu(k,2055) = lu(k,2055) - lu(k,1650) * lu(k,2045) - lu(k,2071) = lu(k,2071) - lu(k,1641) * lu(k,2070) - lu(k,2072) = lu(k,2072) - lu(k,1642) * lu(k,2070) - lu(k,2073) = lu(k,2073) - lu(k,1643) * lu(k,2070) - lu(k,2074) = lu(k,2074) - lu(k,1644) * lu(k,2070) - lu(k,2075) = lu(k,2075) - lu(k,1645) * lu(k,2070) - lu(k,2076) = lu(k,2076) - lu(k,1646) * lu(k,2070) - lu(k,2077) = lu(k,2077) - lu(k,1647) * lu(k,2070) - lu(k,2078) = lu(k,2078) - lu(k,1648) * lu(k,2070) - lu(k,2079) = lu(k,2079) - lu(k,1649) * lu(k,2070) - lu(k,2080) = lu(k,2080) - lu(k,1650) * lu(k,2070) + lu(k,1386) = 1._r8 / lu(k,1386) + lu(k,1387) = lu(k,1387) * lu(k,1386) + lu(k,1388) = lu(k,1388) * lu(k,1386) + lu(k,1389) = lu(k,1389) * lu(k,1386) + lu(k,1390) = lu(k,1390) * lu(k,1386) + lu(k,1391) = lu(k,1391) * lu(k,1386) + lu(k,1392) = lu(k,1392) * lu(k,1386) + lu(k,1393) = lu(k,1393) * lu(k,1386) + lu(k,1394) = lu(k,1394) * lu(k,1386) + lu(k,1395) = lu(k,1395) * lu(k,1386) + lu(k,1396) = lu(k,1396) * lu(k,1386) + lu(k,1397) = lu(k,1397) * lu(k,1386) + lu(k,1398) = lu(k,1398) * lu(k,1386) + lu(k,1686) = lu(k,1686) - lu(k,1387) * lu(k,1683) + lu(k,1687) = lu(k,1687) - lu(k,1388) * lu(k,1683) + lu(k,1689) = lu(k,1689) - lu(k,1389) * lu(k,1683) + lu(k,1691) = lu(k,1691) - lu(k,1390) * lu(k,1683) + lu(k,1692) = lu(k,1692) - lu(k,1391) * lu(k,1683) + lu(k,1693) = lu(k,1693) - lu(k,1392) * lu(k,1683) + lu(k,1694) = lu(k,1694) - lu(k,1393) * lu(k,1683) + lu(k,1697) = lu(k,1697) - lu(k,1394) * lu(k,1683) + lu(k,1698) = lu(k,1698) - lu(k,1395) * lu(k,1683) + lu(k,1700) = lu(k,1700) - lu(k,1396) * lu(k,1683) + lu(k,1702) = lu(k,1702) - lu(k,1397) * lu(k,1683) + lu(k,1703) = lu(k,1703) - lu(k,1398) * lu(k,1683) + lu(k,1743) = lu(k,1743) - lu(k,1387) * lu(k,1741) + lu(k,1744) = lu(k,1744) - lu(k,1388) * lu(k,1741) + lu(k,1746) = lu(k,1746) - lu(k,1389) * lu(k,1741) + lu(k,1748) = lu(k,1748) - lu(k,1390) * lu(k,1741) + lu(k,1749) = lu(k,1749) - lu(k,1391) * lu(k,1741) + lu(k,1750) = lu(k,1750) - lu(k,1392) * lu(k,1741) + lu(k,1751) = lu(k,1751) - lu(k,1393) * lu(k,1741) + lu(k,1754) = lu(k,1754) - lu(k,1394) * lu(k,1741) + lu(k,1755) = lu(k,1755) - lu(k,1395) * lu(k,1741) + lu(k,1757) = lu(k,1757) - lu(k,1396) * lu(k,1741) + lu(k,1759) = lu(k,1759) - lu(k,1397) * lu(k,1741) + lu(k,1760) = lu(k,1760) - lu(k,1398) * lu(k,1741) + lu(k,1835) = lu(k,1835) - lu(k,1387) * lu(k,1833) + lu(k,1836) = lu(k,1836) - lu(k,1388) * lu(k,1833) + lu(k,1838) = lu(k,1838) - lu(k,1389) * lu(k,1833) + lu(k,1840) = lu(k,1840) - lu(k,1390) * lu(k,1833) + lu(k,1841) = lu(k,1841) - lu(k,1391) * lu(k,1833) + lu(k,1842) = lu(k,1842) - lu(k,1392) * lu(k,1833) + lu(k,1843) = lu(k,1843) - lu(k,1393) * lu(k,1833) + lu(k,1846) = lu(k,1846) - lu(k,1394) * lu(k,1833) + lu(k,1847) = lu(k,1847) - lu(k,1395) * lu(k,1833) + lu(k,1849) = lu(k,1849) - lu(k,1396) * lu(k,1833) + lu(k,1851) = lu(k,1851) - lu(k,1397) * lu(k,1833) + lu(k,1852) = lu(k,1852) - lu(k,1398) * lu(k,1833) + lu(k,1942) = lu(k,1942) - lu(k,1387) * lu(k,1939) + lu(k,1943) = lu(k,1943) - lu(k,1388) * lu(k,1939) + lu(k,1945) = lu(k,1945) - lu(k,1389) * lu(k,1939) + lu(k,1947) = lu(k,1947) - lu(k,1390) * lu(k,1939) + lu(k,1948) = lu(k,1948) - lu(k,1391) * lu(k,1939) + lu(k,1949) = lu(k,1949) - lu(k,1392) * lu(k,1939) + lu(k,1950) = lu(k,1950) - lu(k,1393) * lu(k,1939) + lu(k,1953) = lu(k,1953) - lu(k,1394) * lu(k,1939) + lu(k,1954) = lu(k,1954) - lu(k,1395) * lu(k,1939) + lu(k,1956) = lu(k,1956) - lu(k,1396) * lu(k,1939) + lu(k,1958) = lu(k,1958) - lu(k,1397) * lu(k,1939) + lu(k,1959) = lu(k,1959) - lu(k,1398) * lu(k,1939) + lu(k,2007) = lu(k,2007) - lu(k,1387) * lu(k,2004) + lu(k,2008) = lu(k,2008) - lu(k,1388) * lu(k,2004) + lu(k,2010) = lu(k,2010) - lu(k,1389) * lu(k,2004) + lu(k,2012) = lu(k,2012) - lu(k,1390) * lu(k,2004) + lu(k,2013) = lu(k,2013) - lu(k,1391) * lu(k,2004) + lu(k,2014) = lu(k,2014) - lu(k,1392) * lu(k,2004) + lu(k,2015) = lu(k,2015) - lu(k,1393) * lu(k,2004) + lu(k,2018) = lu(k,2018) - lu(k,1394) * lu(k,2004) + lu(k,2019) = lu(k,2019) - lu(k,1395) * lu(k,2004) + lu(k,2021) = lu(k,2021) - lu(k,1396) * lu(k,2004) + lu(k,2023) = lu(k,2023) - lu(k,1397) * lu(k,2004) + lu(k,2024) = lu(k,2024) - lu(k,1398) * lu(k,2004) + lu(k,2059) = lu(k,2059) - lu(k,1387) * lu(k,2058) + lu(k,2060) = lu(k,2060) - lu(k,1388) * lu(k,2058) + lu(k,2062) = lu(k,2062) - lu(k,1389) * lu(k,2058) + lu(k,2064) = lu(k,2064) - lu(k,1390) * lu(k,2058) + lu(k,2065) = lu(k,2065) - lu(k,1391) * lu(k,2058) + lu(k,2066) = lu(k,2066) - lu(k,1392) * lu(k,2058) + lu(k,2067) = lu(k,2067) - lu(k,1393) * lu(k,2058) + lu(k,2070) = lu(k,2070) - lu(k,1394) * lu(k,2058) + lu(k,2071) = lu(k,2071) - lu(k,1395) * lu(k,2058) + lu(k,2073) = lu(k,2073) - lu(k,1396) * lu(k,2058) + lu(k,2075) = lu(k,2075) - lu(k,1397) * lu(k,2058) + lu(k,2076) = lu(k,2076) - lu(k,1398) * lu(k,2058) + lu(k,2120) = lu(k,2120) - lu(k,1387) * lu(k,2118) + lu(k,2121) = lu(k,2121) - lu(k,1388) * lu(k,2118) + lu(k,2123) = lu(k,2123) - lu(k,1389) * lu(k,2118) + lu(k,2125) = lu(k,2125) - lu(k,1390) * lu(k,2118) + lu(k,2126) = lu(k,2126) - lu(k,1391) * lu(k,2118) + lu(k,2127) = lu(k,2127) - lu(k,1392) * lu(k,2118) + lu(k,2128) = lu(k,2128) - lu(k,1393) * lu(k,2118) + lu(k,2131) = lu(k,2131) - lu(k,1394) * lu(k,2118) + lu(k,2132) = lu(k,2132) - lu(k,1395) * lu(k,2118) + lu(k,2134) = lu(k,2134) - lu(k,1396) * lu(k,2118) + lu(k,2136) = lu(k,2136) - lu(k,1397) * lu(k,2118) + lu(k,2137) = lu(k,2137) - lu(k,1398) * lu(k,2118) + lu(k,2187) = - lu(k,1387) * lu(k,2185) + lu(k,2188) = lu(k,2188) - lu(k,1388) * lu(k,2185) + lu(k,2190) = lu(k,2190) - lu(k,1389) * lu(k,2185) + lu(k,2192) = lu(k,2192) - lu(k,1390) * lu(k,2185) + lu(k,2193) = lu(k,2193) - lu(k,1391) * lu(k,2185) + lu(k,2194) = lu(k,2194) - lu(k,1392) * lu(k,2185) + lu(k,2195) = lu(k,2195) - lu(k,1393) * lu(k,2185) + lu(k,2198) = lu(k,2198) - lu(k,1394) * lu(k,2185) + lu(k,2199) = lu(k,2199) - lu(k,1395) * lu(k,2185) + lu(k,2201) = lu(k,2201) - lu(k,1396) * lu(k,2185) + lu(k,2203) = lu(k,2203) - lu(k,1397) * lu(k,2185) + lu(k,2204) = lu(k,2204) - lu(k,1398) * lu(k,2185) + lu(k,1401) = 1._r8 / lu(k,1401) + lu(k,1402) = lu(k,1402) * lu(k,1401) + lu(k,1403) = lu(k,1403) * lu(k,1401) + lu(k,1404) = lu(k,1404) * lu(k,1401) + lu(k,1405) = lu(k,1405) * lu(k,1401) + lu(k,1406) = lu(k,1406) * lu(k,1401) + lu(k,1407) = lu(k,1407) * lu(k,1401) + lu(k,1408) = lu(k,1408) * lu(k,1401) + lu(k,1409) = lu(k,1409) * lu(k,1401) + lu(k,1410) = lu(k,1410) * lu(k,1401) + lu(k,1411) = lu(k,1411) * lu(k,1401) + lu(k,1412) = lu(k,1412) * lu(k,1401) + lu(k,1430) = lu(k,1430) - lu(k,1402) * lu(k,1429) + lu(k,1431) = lu(k,1431) - lu(k,1403) * lu(k,1429) + lu(k,1432) = lu(k,1432) - lu(k,1404) * lu(k,1429) + lu(k,1434) = lu(k,1434) - lu(k,1405) * lu(k,1429) + lu(k,1435) = lu(k,1435) - lu(k,1406) * lu(k,1429) + lu(k,1436) = lu(k,1436) - lu(k,1407) * lu(k,1429) + lu(k,1438) = lu(k,1438) - lu(k,1408) * lu(k,1429) + lu(k,1439) = lu(k,1439) - lu(k,1409) * lu(k,1429) + lu(k,1440) = lu(k,1440) - lu(k,1410) * lu(k,1429) + lu(k,1441) = lu(k,1441) - lu(k,1411) * lu(k,1429) + lu(k,1442) = lu(k,1442) - lu(k,1412) * lu(k,1429) + lu(k,1446) = lu(k,1446) - lu(k,1402) * lu(k,1445) + lu(k,1447) = lu(k,1447) - lu(k,1403) * lu(k,1445) + lu(k,1448) = lu(k,1448) - lu(k,1404) * lu(k,1445) + lu(k,1450) = - lu(k,1405) * lu(k,1445) + lu(k,1451) = lu(k,1451) - lu(k,1406) * lu(k,1445) + lu(k,1452) = lu(k,1452) - lu(k,1407) * lu(k,1445) + lu(k,1454) = - lu(k,1408) * lu(k,1445) + lu(k,1455) = lu(k,1455) - lu(k,1409) * lu(k,1445) + lu(k,1456) = - lu(k,1410) * lu(k,1445) + lu(k,1458) = - lu(k,1411) * lu(k,1445) + lu(k,1459) = lu(k,1459) - lu(k,1412) * lu(k,1445) + lu(k,1461) = - lu(k,1402) * lu(k,1460) + lu(k,1462) = - lu(k,1403) * lu(k,1460) + lu(k,1463) = lu(k,1463) - lu(k,1404) * lu(k,1460) + lu(k,1465) = - lu(k,1405) * lu(k,1460) + lu(k,1466) = lu(k,1466) - lu(k,1406) * lu(k,1460) + lu(k,1467) = - lu(k,1407) * lu(k,1460) + lu(k,1469) = - lu(k,1408) * lu(k,1460) + lu(k,1470) = - lu(k,1409) * lu(k,1460) + lu(k,1472) = - lu(k,1410) * lu(k,1460) + lu(k,1474) = lu(k,1474) - lu(k,1411) * lu(k,1460) + lu(k,1475) = lu(k,1475) - lu(k,1412) * lu(k,1460) + lu(k,1482) = - lu(k,1402) * lu(k,1480) + lu(k,1483) = lu(k,1483) - lu(k,1403) * lu(k,1480) + lu(k,1484) = lu(k,1484) - lu(k,1404) * lu(k,1480) + lu(k,1486) = lu(k,1486) - lu(k,1405) * lu(k,1480) + lu(k,1487) = lu(k,1487) - lu(k,1406) * lu(k,1480) + lu(k,1488) = lu(k,1488) - lu(k,1407) * lu(k,1480) + lu(k,1491) = lu(k,1491) - lu(k,1408) * lu(k,1480) + lu(k,1492) = - lu(k,1409) * lu(k,1480) + lu(k,1494) = lu(k,1494) - lu(k,1410) * lu(k,1480) + lu(k,1497) = lu(k,1497) - lu(k,1411) * lu(k,1480) + lu(k,1498) = lu(k,1498) - lu(k,1412) * lu(k,1480) + lu(k,1522) = lu(k,1522) - lu(k,1402) * lu(k,1520) + lu(k,1523) = lu(k,1523) - lu(k,1403) * lu(k,1520) + lu(k,1524) = lu(k,1524) - lu(k,1404) * lu(k,1520) + lu(k,1526) = lu(k,1526) - lu(k,1405) * lu(k,1520) + lu(k,1527) = lu(k,1527) - lu(k,1406) * lu(k,1520) + lu(k,1528) = lu(k,1528) - lu(k,1407) * lu(k,1520) + lu(k,1532) = lu(k,1532) - lu(k,1408) * lu(k,1520) + lu(k,1533) = lu(k,1533) - lu(k,1409) * lu(k,1520) + lu(k,1535) = lu(k,1535) - lu(k,1410) * lu(k,1520) + lu(k,1538) = lu(k,1538) - lu(k,1411) * lu(k,1520) + lu(k,1539) = lu(k,1539) - lu(k,1412) * lu(k,1520) + lu(k,1686) = lu(k,1686) - lu(k,1402) * lu(k,1684) + lu(k,1687) = lu(k,1687) - lu(k,1403) * lu(k,1684) + lu(k,1688) = lu(k,1688) - lu(k,1404) * lu(k,1684) + lu(k,1690) = lu(k,1690) - lu(k,1405) * lu(k,1684) + lu(k,1691) = lu(k,1691) - lu(k,1406) * lu(k,1684) + lu(k,1692) = lu(k,1692) - lu(k,1407) * lu(k,1684) + lu(k,1696) = lu(k,1696) - lu(k,1408) * lu(k,1684) + lu(k,1697) = lu(k,1697) - lu(k,1409) * lu(k,1684) + lu(k,1699) = lu(k,1699) - lu(k,1410) * lu(k,1684) + lu(k,1702) = lu(k,1702) - lu(k,1411) * lu(k,1684) + lu(k,1703) = lu(k,1703) - lu(k,1412) * lu(k,1684) + lu(k,1942) = lu(k,1942) - lu(k,1402) * lu(k,1940) + lu(k,1943) = lu(k,1943) - lu(k,1403) * lu(k,1940) + lu(k,1944) = lu(k,1944) - lu(k,1404) * lu(k,1940) + lu(k,1946) = lu(k,1946) - lu(k,1405) * lu(k,1940) + lu(k,1947) = lu(k,1947) - lu(k,1406) * lu(k,1940) + lu(k,1948) = lu(k,1948) - lu(k,1407) * lu(k,1940) + lu(k,1952) = lu(k,1952) - lu(k,1408) * lu(k,1940) + lu(k,1953) = lu(k,1953) - lu(k,1409) * lu(k,1940) + lu(k,1955) = lu(k,1955) - lu(k,1410) * lu(k,1940) + lu(k,1958) = lu(k,1958) - lu(k,1411) * lu(k,1940) + lu(k,1959) = lu(k,1959) - lu(k,1412) * lu(k,1940) + lu(k,2007) = lu(k,2007) - lu(k,1402) * lu(k,2005) + lu(k,2008) = lu(k,2008) - lu(k,1403) * lu(k,2005) + lu(k,2009) = lu(k,2009) - lu(k,1404) * lu(k,2005) + lu(k,2011) = lu(k,2011) - lu(k,1405) * lu(k,2005) + lu(k,2012) = lu(k,2012) - lu(k,1406) * lu(k,2005) + lu(k,2013) = lu(k,2013) - lu(k,1407) * lu(k,2005) + lu(k,2017) = lu(k,2017) - lu(k,1408) * lu(k,2005) + lu(k,2018) = lu(k,2018) - lu(k,1409) * lu(k,2005) + lu(k,2020) = lu(k,2020) - lu(k,1410) * lu(k,2005) + lu(k,2023) = lu(k,2023) - lu(k,1411) * lu(k,2005) + lu(k,2024) = lu(k,2024) - lu(k,1412) * lu(k,2005) + lu(k,2242) = - lu(k,1402) * lu(k,2240) + lu(k,2243) = lu(k,2243) - lu(k,1403) * lu(k,2240) + lu(k,2244) = lu(k,2244) - lu(k,1404) * lu(k,2240) + lu(k,2246) = lu(k,2246) - lu(k,1405) * lu(k,2240) + lu(k,2247) = lu(k,2247) - lu(k,1406) * lu(k,2240) + lu(k,2248) = lu(k,2248) - lu(k,1407) * lu(k,2240) + lu(k,2252) = lu(k,2252) - lu(k,1408) * lu(k,2240) + lu(k,2253) = - lu(k,1409) * lu(k,2240) + lu(k,2255) = lu(k,2255) - lu(k,1410) * lu(k,2240) + lu(k,2258) = lu(k,2258) - lu(k,1411) * lu(k,2240) + lu(k,2259) = lu(k,2259) - lu(k,1412) * lu(k,2240) + lu(k,2268) = lu(k,2268) - lu(k,1402) * lu(k,2266) + lu(k,2269) = lu(k,2269) - lu(k,1403) * lu(k,2266) + lu(k,2270) = lu(k,2270) - lu(k,1404) * lu(k,2266) + lu(k,2272) = lu(k,2272) - lu(k,1405) * lu(k,2266) + lu(k,2273) = lu(k,2273) - lu(k,1406) * lu(k,2266) + lu(k,2274) = lu(k,2274) - lu(k,1407) * lu(k,2266) + lu(k,2278) = lu(k,2278) - lu(k,1408) * lu(k,2266) + lu(k,2279) = lu(k,2279) - lu(k,1409) * lu(k,2266) + lu(k,2281) = - lu(k,1410) * lu(k,2266) + lu(k,2284) = lu(k,2284) - lu(k,1411) * lu(k,2266) + lu(k,2285) = lu(k,2285) - lu(k,1412) * lu(k,2266) + lu(k,1415) = 1._r8 / lu(k,1415) + lu(k,1416) = lu(k,1416) * lu(k,1415) + lu(k,1417) = lu(k,1417) * lu(k,1415) + lu(k,1418) = lu(k,1418) * lu(k,1415) + lu(k,1419) = lu(k,1419) * lu(k,1415) + lu(k,1420) = lu(k,1420) * lu(k,1415) + lu(k,1421) = lu(k,1421) * lu(k,1415) + lu(k,1422) = lu(k,1422) * lu(k,1415) + lu(k,1423) = lu(k,1423) * lu(k,1415) + lu(k,1424) = lu(k,1424) * lu(k,1415) + lu(k,1484) = lu(k,1484) - lu(k,1416) * lu(k,1481) + lu(k,1485) = lu(k,1485) - lu(k,1417) * lu(k,1481) + lu(k,1486) = lu(k,1486) - lu(k,1418) * lu(k,1481) + lu(k,1487) = lu(k,1487) - lu(k,1419) * lu(k,1481) + lu(k,1490) = lu(k,1490) - lu(k,1420) * lu(k,1481) + lu(k,1493) = - lu(k,1421) * lu(k,1481) + lu(k,1496) = lu(k,1496) - lu(k,1422) * lu(k,1481) + lu(k,1497) = lu(k,1497) - lu(k,1423) * lu(k,1481) + lu(k,1498) = lu(k,1498) - lu(k,1424) * lu(k,1481) + lu(k,1524) = lu(k,1524) - lu(k,1416) * lu(k,1521) + lu(k,1525) = lu(k,1525) - lu(k,1417) * lu(k,1521) + lu(k,1526) = lu(k,1526) - lu(k,1418) * lu(k,1521) + lu(k,1527) = lu(k,1527) - lu(k,1419) * lu(k,1521) + lu(k,1530) = lu(k,1530) - lu(k,1420) * lu(k,1521) + lu(k,1534) = lu(k,1534) - lu(k,1421) * lu(k,1521) + lu(k,1537) = lu(k,1537) - lu(k,1422) * lu(k,1521) + lu(k,1538) = lu(k,1538) - lu(k,1423) * lu(k,1521) + lu(k,1539) = lu(k,1539) - lu(k,1424) * lu(k,1521) + lu(k,1688) = lu(k,1688) - lu(k,1416) * lu(k,1685) + lu(k,1689) = lu(k,1689) - lu(k,1417) * lu(k,1685) + lu(k,1690) = lu(k,1690) - lu(k,1418) * lu(k,1685) + lu(k,1691) = lu(k,1691) - lu(k,1419) * lu(k,1685) + lu(k,1694) = lu(k,1694) - lu(k,1420) * lu(k,1685) + lu(k,1698) = lu(k,1698) - lu(k,1421) * lu(k,1685) + lu(k,1701) = lu(k,1701) - lu(k,1422) * lu(k,1685) + lu(k,1702) = lu(k,1702) - lu(k,1423) * lu(k,1685) + lu(k,1703) = lu(k,1703) - lu(k,1424) * lu(k,1685) + lu(k,1745) = lu(k,1745) - lu(k,1416) * lu(k,1742) + lu(k,1746) = lu(k,1746) - lu(k,1417) * lu(k,1742) + lu(k,1747) = - lu(k,1418) * lu(k,1742) + lu(k,1748) = lu(k,1748) - lu(k,1419) * lu(k,1742) + lu(k,1751) = lu(k,1751) - lu(k,1420) * lu(k,1742) + lu(k,1755) = lu(k,1755) - lu(k,1421) * lu(k,1742) + lu(k,1758) = lu(k,1758) - lu(k,1422) * lu(k,1742) + lu(k,1759) = lu(k,1759) - lu(k,1423) * lu(k,1742) + lu(k,1760) = lu(k,1760) - lu(k,1424) * lu(k,1742) + lu(k,1837) = lu(k,1837) - lu(k,1416) * lu(k,1834) + lu(k,1838) = lu(k,1838) - lu(k,1417) * lu(k,1834) + lu(k,1839) = lu(k,1839) - lu(k,1418) * lu(k,1834) + lu(k,1840) = lu(k,1840) - lu(k,1419) * lu(k,1834) + lu(k,1843) = lu(k,1843) - lu(k,1420) * lu(k,1834) + lu(k,1847) = lu(k,1847) - lu(k,1421) * lu(k,1834) + lu(k,1850) = lu(k,1850) - lu(k,1422) * lu(k,1834) + lu(k,1851) = lu(k,1851) - lu(k,1423) * lu(k,1834) + lu(k,1852) = lu(k,1852) - lu(k,1424) * lu(k,1834) + lu(k,1944) = lu(k,1944) - lu(k,1416) * lu(k,1941) + lu(k,1945) = lu(k,1945) - lu(k,1417) * lu(k,1941) + lu(k,1946) = lu(k,1946) - lu(k,1418) * lu(k,1941) + lu(k,1947) = lu(k,1947) - lu(k,1419) * lu(k,1941) + lu(k,1950) = lu(k,1950) - lu(k,1420) * lu(k,1941) + lu(k,1954) = lu(k,1954) - lu(k,1421) * lu(k,1941) + lu(k,1957) = lu(k,1957) - lu(k,1422) * lu(k,1941) + lu(k,1958) = lu(k,1958) - lu(k,1423) * lu(k,1941) + lu(k,1959) = lu(k,1959) - lu(k,1424) * lu(k,1941) + lu(k,1970) = lu(k,1970) - lu(k,1416) * lu(k,1968) + lu(k,1971) = lu(k,1971) - lu(k,1417) * lu(k,1968) + lu(k,1972) = - lu(k,1418) * lu(k,1968) + lu(k,1973) = lu(k,1973) - lu(k,1419) * lu(k,1968) + lu(k,1976) = lu(k,1976) - lu(k,1420) * lu(k,1968) + lu(k,1980) = lu(k,1980) - lu(k,1421) * lu(k,1968) + lu(k,1983) = lu(k,1983) - lu(k,1422) * lu(k,1968) + lu(k,1984) = lu(k,1984) - lu(k,1423) * lu(k,1968) + lu(k,1985) = lu(k,1985) - lu(k,1424) * lu(k,1968) + lu(k,2009) = lu(k,2009) - lu(k,1416) * lu(k,2006) + lu(k,2010) = lu(k,2010) - lu(k,1417) * lu(k,2006) + lu(k,2011) = lu(k,2011) - lu(k,1418) * lu(k,2006) + lu(k,2012) = lu(k,2012) - lu(k,1419) * lu(k,2006) + lu(k,2015) = lu(k,2015) - lu(k,1420) * lu(k,2006) + lu(k,2019) = lu(k,2019) - lu(k,1421) * lu(k,2006) + lu(k,2022) = - lu(k,1422) * lu(k,2006) + lu(k,2023) = lu(k,2023) - lu(k,1423) * lu(k,2006) + lu(k,2024) = lu(k,2024) - lu(k,1424) * lu(k,2006) + lu(k,2122) = lu(k,2122) - lu(k,1416) * lu(k,2119) + lu(k,2123) = lu(k,2123) - lu(k,1417) * lu(k,2119) + lu(k,2124) = lu(k,2124) - lu(k,1418) * lu(k,2119) + lu(k,2125) = lu(k,2125) - lu(k,1419) * lu(k,2119) + lu(k,2128) = lu(k,2128) - lu(k,1420) * lu(k,2119) + lu(k,2132) = lu(k,2132) - lu(k,1421) * lu(k,2119) + lu(k,2135) = lu(k,2135) - lu(k,1422) * lu(k,2119) + lu(k,2136) = lu(k,2136) - lu(k,1423) * lu(k,2119) + lu(k,2137) = lu(k,2137) - lu(k,1424) * lu(k,2119) + lu(k,2145) = lu(k,2145) - lu(k,1416) * lu(k,2143) + lu(k,2146) = - lu(k,1417) * lu(k,2143) + lu(k,2147) = lu(k,2147) - lu(k,1418) * lu(k,2143) + lu(k,2148) = lu(k,2148) - lu(k,1419) * lu(k,2143) + lu(k,2151) = - lu(k,1420) * lu(k,2143) + lu(k,2155) = - lu(k,1421) * lu(k,2143) + lu(k,2158) = lu(k,2158) - lu(k,1422) * lu(k,2143) + lu(k,2159) = lu(k,2159) - lu(k,1423) * lu(k,2143) + lu(k,2160) = lu(k,2160) - lu(k,1424) * lu(k,2143) + lu(k,2189) = lu(k,2189) - lu(k,1416) * lu(k,2186) + lu(k,2190) = lu(k,2190) - lu(k,1417) * lu(k,2186) + lu(k,2191) = lu(k,2191) - lu(k,1418) * lu(k,2186) + lu(k,2192) = lu(k,2192) - lu(k,1419) * lu(k,2186) + lu(k,2195) = lu(k,2195) - lu(k,1420) * lu(k,2186) + lu(k,2199) = lu(k,2199) - lu(k,1421) * lu(k,2186) + lu(k,2202) = lu(k,2202) - lu(k,1422) * lu(k,2186) + lu(k,2203) = lu(k,2203) - lu(k,1423) * lu(k,2186) + lu(k,2204) = lu(k,2204) - lu(k,1424) * lu(k,2186) + lu(k,2213) = lu(k,2213) - lu(k,1416) * lu(k,2211) + lu(k,2214) = - lu(k,1417) * lu(k,2211) + lu(k,2215) = - lu(k,1418) * lu(k,2211) + lu(k,2216) = lu(k,2216) - lu(k,1419) * lu(k,2211) + lu(k,2219) = lu(k,2219) - lu(k,1420) * lu(k,2211) + lu(k,2223) = lu(k,2223) - lu(k,1421) * lu(k,2211) + lu(k,2226) = lu(k,2226) - lu(k,1422) * lu(k,2211) + lu(k,2227) = lu(k,2227) - lu(k,1423) * lu(k,2211) + lu(k,2228) = lu(k,2228) - lu(k,1424) * lu(k,2211) + lu(k,2244) = lu(k,2244) - lu(k,1416) * lu(k,2241) + lu(k,2245) = lu(k,2245) - lu(k,1417) * lu(k,2241) + lu(k,2246) = lu(k,2246) - lu(k,1418) * lu(k,2241) + lu(k,2247) = lu(k,2247) - lu(k,1419) * lu(k,2241) + lu(k,2250) = lu(k,2250) - lu(k,1420) * lu(k,2241) + lu(k,2254) = lu(k,2254) - lu(k,1421) * lu(k,2241) + lu(k,2257) = lu(k,2257) - lu(k,1422) * lu(k,2241) + lu(k,2258) = lu(k,2258) - lu(k,1423) * lu(k,2241) + lu(k,2259) = lu(k,2259) - lu(k,1424) * lu(k,2241) + lu(k,2270) = lu(k,2270) - lu(k,1416) * lu(k,2267) + lu(k,2271) = - lu(k,1417) * lu(k,2267) + lu(k,2272) = lu(k,2272) - lu(k,1418) * lu(k,2267) + lu(k,2273) = lu(k,2273) - lu(k,1419) * lu(k,2267) + lu(k,2276) = lu(k,2276) - lu(k,1420) * lu(k,2267) + lu(k,2280) = lu(k,2280) - lu(k,1421) * lu(k,2267) + lu(k,2283) = lu(k,2283) - lu(k,1422) * lu(k,2267) + lu(k,2284) = lu(k,2284) - lu(k,1423) * lu(k,2267) + lu(k,2285) = lu(k,2285) - lu(k,1424) * lu(k,2267) + end do + end subroutine lu_fac27 + subroutine lu_fac28( 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,1430) = 1._r8 / lu(k,1430) + lu(k,1431) = lu(k,1431) * lu(k,1430) + lu(k,1432) = lu(k,1432) * lu(k,1430) + lu(k,1433) = lu(k,1433) * lu(k,1430) + lu(k,1434) = lu(k,1434) * lu(k,1430) + lu(k,1435) = lu(k,1435) * lu(k,1430) + lu(k,1436) = lu(k,1436) * lu(k,1430) + lu(k,1437) = lu(k,1437) * lu(k,1430) + lu(k,1438) = lu(k,1438) * lu(k,1430) + lu(k,1439) = lu(k,1439) * lu(k,1430) + lu(k,1440) = lu(k,1440) * lu(k,1430) + lu(k,1441) = lu(k,1441) * lu(k,1430) + lu(k,1442) = lu(k,1442) * lu(k,1430) + lu(k,1447) = lu(k,1447) - lu(k,1431) * lu(k,1446) + lu(k,1448) = lu(k,1448) - lu(k,1432) * lu(k,1446) + lu(k,1449) = - lu(k,1433) * lu(k,1446) + lu(k,1450) = lu(k,1450) - lu(k,1434) * lu(k,1446) + lu(k,1451) = lu(k,1451) - lu(k,1435) * lu(k,1446) + lu(k,1452) = lu(k,1452) - lu(k,1436) * lu(k,1446) + lu(k,1453) = - lu(k,1437) * lu(k,1446) + lu(k,1454) = lu(k,1454) - lu(k,1438) * lu(k,1446) + lu(k,1455) = lu(k,1455) - lu(k,1439) * lu(k,1446) + lu(k,1456) = lu(k,1456) - lu(k,1440) * lu(k,1446) + lu(k,1458) = lu(k,1458) - lu(k,1441) * lu(k,1446) + lu(k,1459) = lu(k,1459) - lu(k,1442) * lu(k,1446) + lu(k,1462) = lu(k,1462) - lu(k,1431) * lu(k,1461) + lu(k,1463) = lu(k,1463) - lu(k,1432) * lu(k,1461) + lu(k,1464) = - lu(k,1433) * lu(k,1461) + lu(k,1465) = lu(k,1465) - lu(k,1434) * lu(k,1461) + lu(k,1466) = lu(k,1466) - lu(k,1435) * lu(k,1461) + lu(k,1467) = lu(k,1467) - lu(k,1436) * lu(k,1461) + lu(k,1468) = lu(k,1468) - lu(k,1437) * lu(k,1461) + lu(k,1469) = lu(k,1469) - lu(k,1438) * lu(k,1461) + lu(k,1470) = lu(k,1470) - lu(k,1439) * lu(k,1461) + lu(k,1472) = lu(k,1472) - lu(k,1440) * lu(k,1461) + lu(k,1474) = lu(k,1474) - lu(k,1441) * lu(k,1461) + lu(k,1475) = lu(k,1475) - lu(k,1442) * lu(k,1461) + lu(k,1483) = lu(k,1483) - lu(k,1431) * lu(k,1482) + lu(k,1484) = lu(k,1484) - lu(k,1432) * lu(k,1482) + lu(k,1485) = lu(k,1485) - lu(k,1433) * lu(k,1482) + lu(k,1486) = lu(k,1486) - lu(k,1434) * lu(k,1482) + lu(k,1487) = lu(k,1487) - lu(k,1435) * lu(k,1482) + lu(k,1488) = lu(k,1488) - lu(k,1436) * lu(k,1482) + lu(k,1490) = lu(k,1490) - lu(k,1437) * lu(k,1482) + lu(k,1491) = lu(k,1491) - lu(k,1438) * lu(k,1482) + lu(k,1492) = lu(k,1492) - lu(k,1439) * lu(k,1482) + lu(k,1494) = lu(k,1494) - lu(k,1440) * lu(k,1482) + lu(k,1497) = lu(k,1497) - lu(k,1441) * lu(k,1482) + lu(k,1498) = lu(k,1498) - lu(k,1442) * lu(k,1482) + lu(k,1523) = lu(k,1523) - lu(k,1431) * lu(k,1522) + lu(k,1524) = lu(k,1524) - lu(k,1432) * lu(k,1522) + lu(k,1525) = lu(k,1525) - lu(k,1433) * lu(k,1522) + lu(k,1526) = lu(k,1526) - lu(k,1434) * lu(k,1522) + lu(k,1527) = lu(k,1527) - lu(k,1435) * lu(k,1522) + lu(k,1528) = lu(k,1528) - lu(k,1436) * lu(k,1522) + lu(k,1530) = lu(k,1530) - lu(k,1437) * lu(k,1522) + lu(k,1532) = lu(k,1532) - lu(k,1438) * lu(k,1522) + lu(k,1533) = lu(k,1533) - lu(k,1439) * lu(k,1522) + lu(k,1535) = lu(k,1535) - lu(k,1440) * lu(k,1522) + lu(k,1538) = lu(k,1538) - lu(k,1441) * lu(k,1522) + lu(k,1539) = lu(k,1539) - lu(k,1442) * lu(k,1522) + lu(k,1687) = lu(k,1687) - lu(k,1431) * lu(k,1686) + lu(k,1688) = lu(k,1688) - lu(k,1432) * lu(k,1686) + lu(k,1689) = lu(k,1689) - lu(k,1433) * lu(k,1686) + lu(k,1690) = lu(k,1690) - lu(k,1434) * lu(k,1686) + lu(k,1691) = lu(k,1691) - lu(k,1435) * lu(k,1686) + lu(k,1692) = lu(k,1692) - lu(k,1436) * lu(k,1686) + lu(k,1694) = lu(k,1694) - lu(k,1437) * lu(k,1686) + lu(k,1696) = lu(k,1696) - lu(k,1438) * lu(k,1686) + lu(k,1697) = lu(k,1697) - lu(k,1439) * lu(k,1686) + lu(k,1699) = lu(k,1699) - lu(k,1440) * lu(k,1686) + lu(k,1702) = lu(k,1702) - lu(k,1441) * lu(k,1686) + lu(k,1703) = lu(k,1703) - lu(k,1442) * lu(k,1686) + lu(k,1744) = lu(k,1744) - lu(k,1431) * lu(k,1743) + lu(k,1745) = lu(k,1745) - lu(k,1432) * lu(k,1743) + lu(k,1746) = lu(k,1746) - lu(k,1433) * lu(k,1743) + lu(k,1747) = lu(k,1747) - lu(k,1434) * lu(k,1743) + lu(k,1748) = lu(k,1748) - lu(k,1435) * lu(k,1743) + lu(k,1749) = lu(k,1749) - lu(k,1436) * lu(k,1743) + lu(k,1751) = lu(k,1751) - lu(k,1437) * lu(k,1743) + lu(k,1753) = lu(k,1753) - lu(k,1438) * lu(k,1743) + lu(k,1754) = lu(k,1754) - lu(k,1439) * lu(k,1743) + lu(k,1756) = - lu(k,1440) * lu(k,1743) + lu(k,1759) = lu(k,1759) - lu(k,1441) * lu(k,1743) + lu(k,1760) = lu(k,1760) - lu(k,1442) * lu(k,1743) + lu(k,1836) = lu(k,1836) - lu(k,1431) * lu(k,1835) + lu(k,1837) = lu(k,1837) - lu(k,1432) * lu(k,1835) + lu(k,1838) = lu(k,1838) - lu(k,1433) * lu(k,1835) + lu(k,1839) = lu(k,1839) - lu(k,1434) * lu(k,1835) + lu(k,1840) = lu(k,1840) - lu(k,1435) * lu(k,1835) + lu(k,1841) = lu(k,1841) - lu(k,1436) * lu(k,1835) + lu(k,1843) = lu(k,1843) - lu(k,1437) * lu(k,1835) + lu(k,1845) = lu(k,1845) - lu(k,1438) * lu(k,1835) + lu(k,1846) = lu(k,1846) - lu(k,1439) * lu(k,1835) + lu(k,1848) = - lu(k,1440) * lu(k,1835) + lu(k,1851) = lu(k,1851) - lu(k,1441) * lu(k,1835) + lu(k,1852) = lu(k,1852) - lu(k,1442) * lu(k,1835) + lu(k,1943) = lu(k,1943) - lu(k,1431) * lu(k,1942) + lu(k,1944) = lu(k,1944) - lu(k,1432) * lu(k,1942) + lu(k,1945) = lu(k,1945) - lu(k,1433) * lu(k,1942) + lu(k,1946) = lu(k,1946) - lu(k,1434) * lu(k,1942) + lu(k,1947) = lu(k,1947) - lu(k,1435) * lu(k,1942) + lu(k,1948) = lu(k,1948) - lu(k,1436) * lu(k,1942) + lu(k,1950) = lu(k,1950) - lu(k,1437) * lu(k,1942) + lu(k,1952) = lu(k,1952) - lu(k,1438) * lu(k,1942) + lu(k,1953) = lu(k,1953) - lu(k,1439) * lu(k,1942) + lu(k,1955) = lu(k,1955) - lu(k,1440) * lu(k,1942) + lu(k,1958) = lu(k,1958) - lu(k,1441) * lu(k,1942) + lu(k,1959) = lu(k,1959) - lu(k,1442) * lu(k,1942) + lu(k,2008) = lu(k,2008) - lu(k,1431) * lu(k,2007) + lu(k,2009) = lu(k,2009) - lu(k,1432) * lu(k,2007) + lu(k,2010) = lu(k,2010) - lu(k,1433) * lu(k,2007) + lu(k,2011) = lu(k,2011) - lu(k,1434) * lu(k,2007) + lu(k,2012) = lu(k,2012) - lu(k,1435) * lu(k,2007) + lu(k,2013) = lu(k,2013) - lu(k,1436) * lu(k,2007) + lu(k,2015) = lu(k,2015) - lu(k,1437) * lu(k,2007) + lu(k,2017) = lu(k,2017) - lu(k,1438) * lu(k,2007) + lu(k,2018) = lu(k,2018) - lu(k,1439) * lu(k,2007) + lu(k,2020) = lu(k,2020) - lu(k,1440) * lu(k,2007) + lu(k,2023) = lu(k,2023) - lu(k,1441) * lu(k,2007) + lu(k,2024) = lu(k,2024) - lu(k,1442) * lu(k,2007) + lu(k,2060) = lu(k,2060) - lu(k,1431) * lu(k,2059) + lu(k,2061) = lu(k,2061) - lu(k,1432) * lu(k,2059) + lu(k,2062) = lu(k,2062) - lu(k,1433) * lu(k,2059) + lu(k,2063) = - lu(k,1434) * lu(k,2059) + lu(k,2064) = lu(k,2064) - lu(k,1435) * lu(k,2059) + lu(k,2065) = lu(k,2065) - lu(k,1436) * lu(k,2059) + lu(k,2067) = lu(k,2067) - lu(k,1437) * lu(k,2059) + lu(k,2069) = lu(k,2069) - lu(k,1438) * lu(k,2059) + lu(k,2070) = lu(k,2070) - lu(k,1439) * lu(k,2059) + lu(k,2072) = - lu(k,1440) * lu(k,2059) + lu(k,2075) = lu(k,2075) - lu(k,1441) * lu(k,2059) + lu(k,2076) = lu(k,2076) - lu(k,1442) * lu(k,2059) + lu(k,2121) = lu(k,2121) - lu(k,1431) * lu(k,2120) + lu(k,2122) = lu(k,2122) - lu(k,1432) * lu(k,2120) + lu(k,2123) = lu(k,2123) - lu(k,1433) * lu(k,2120) + lu(k,2124) = lu(k,2124) - lu(k,1434) * lu(k,2120) + lu(k,2125) = lu(k,2125) - lu(k,1435) * lu(k,2120) + lu(k,2126) = lu(k,2126) - lu(k,1436) * lu(k,2120) + lu(k,2128) = lu(k,2128) - lu(k,1437) * lu(k,2120) + lu(k,2130) = lu(k,2130) - lu(k,1438) * lu(k,2120) + lu(k,2131) = lu(k,2131) - lu(k,1439) * lu(k,2120) + lu(k,2133) = - lu(k,1440) * lu(k,2120) + lu(k,2136) = lu(k,2136) - lu(k,1441) * lu(k,2120) + lu(k,2137) = lu(k,2137) - lu(k,1442) * lu(k,2120) + lu(k,2188) = lu(k,2188) - lu(k,1431) * lu(k,2187) + lu(k,2189) = lu(k,2189) - lu(k,1432) * lu(k,2187) + lu(k,2190) = lu(k,2190) - lu(k,1433) * lu(k,2187) + lu(k,2191) = lu(k,2191) - lu(k,1434) * lu(k,2187) + lu(k,2192) = lu(k,2192) - lu(k,1435) * lu(k,2187) + lu(k,2193) = lu(k,2193) - lu(k,1436) * lu(k,2187) + lu(k,2195) = lu(k,2195) - lu(k,1437) * lu(k,2187) + lu(k,2197) = lu(k,2197) - lu(k,1438) * lu(k,2187) + lu(k,2198) = lu(k,2198) - lu(k,1439) * lu(k,2187) + lu(k,2200) = lu(k,2200) - lu(k,1440) * lu(k,2187) + lu(k,2203) = lu(k,2203) - lu(k,1441) * lu(k,2187) + lu(k,2204) = lu(k,2204) - lu(k,1442) * lu(k,2187) + lu(k,2243) = lu(k,2243) - lu(k,1431) * lu(k,2242) + lu(k,2244) = lu(k,2244) - lu(k,1432) * lu(k,2242) + lu(k,2245) = lu(k,2245) - lu(k,1433) * lu(k,2242) + lu(k,2246) = lu(k,2246) - lu(k,1434) * lu(k,2242) + lu(k,2247) = lu(k,2247) - lu(k,1435) * lu(k,2242) + lu(k,2248) = lu(k,2248) - lu(k,1436) * lu(k,2242) + lu(k,2250) = lu(k,2250) - lu(k,1437) * lu(k,2242) + lu(k,2252) = lu(k,2252) - lu(k,1438) * lu(k,2242) + lu(k,2253) = lu(k,2253) - lu(k,1439) * lu(k,2242) + lu(k,2255) = lu(k,2255) - lu(k,1440) * lu(k,2242) + lu(k,2258) = lu(k,2258) - lu(k,1441) * lu(k,2242) + lu(k,2259) = lu(k,2259) - lu(k,1442) * lu(k,2242) + lu(k,2269) = lu(k,2269) - lu(k,1431) * lu(k,2268) + lu(k,2270) = lu(k,2270) - lu(k,1432) * lu(k,2268) + lu(k,2271) = lu(k,2271) - lu(k,1433) * lu(k,2268) + lu(k,2272) = lu(k,2272) - lu(k,1434) * lu(k,2268) + lu(k,2273) = lu(k,2273) - lu(k,1435) * lu(k,2268) + lu(k,2274) = lu(k,2274) - lu(k,1436) * lu(k,2268) + lu(k,2276) = lu(k,2276) - lu(k,1437) * lu(k,2268) + lu(k,2278) = lu(k,2278) - lu(k,1438) * lu(k,2268) + lu(k,2279) = lu(k,2279) - lu(k,1439) * lu(k,2268) + lu(k,2281) = lu(k,2281) - lu(k,1440) * lu(k,2268) + lu(k,2284) = lu(k,2284) - lu(k,1441) * lu(k,2268) + lu(k,2285) = lu(k,2285) - lu(k,1442) * lu(k,2268) + lu(k,1447) = 1._r8 / lu(k,1447) + lu(k,1448) = lu(k,1448) * lu(k,1447) + lu(k,1449) = lu(k,1449) * lu(k,1447) + lu(k,1450) = lu(k,1450) * lu(k,1447) + lu(k,1451) = lu(k,1451) * lu(k,1447) + lu(k,1452) = lu(k,1452) * lu(k,1447) + lu(k,1453) = lu(k,1453) * lu(k,1447) + lu(k,1454) = lu(k,1454) * lu(k,1447) + lu(k,1455) = lu(k,1455) * lu(k,1447) + lu(k,1456) = lu(k,1456) * lu(k,1447) + lu(k,1457) = lu(k,1457) * lu(k,1447) + lu(k,1458) = lu(k,1458) * lu(k,1447) + lu(k,1459) = lu(k,1459) * lu(k,1447) + lu(k,1463) = lu(k,1463) - lu(k,1448) * lu(k,1462) + lu(k,1464) = lu(k,1464) - lu(k,1449) * lu(k,1462) + lu(k,1465) = lu(k,1465) - lu(k,1450) * lu(k,1462) + lu(k,1466) = lu(k,1466) - lu(k,1451) * lu(k,1462) + lu(k,1467) = lu(k,1467) - lu(k,1452) * lu(k,1462) + lu(k,1468) = lu(k,1468) - lu(k,1453) * lu(k,1462) + lu(k,1469) = lu(k,1469) - lu(k,1454) * lu(k,1462) + lu(k,1470) = lu(k,1470) - lu(k,1455) * lu(k,1462) + lu(k,1472) = lu(k,1472) - lu(k,1456) * lu(k,1462) + lu(k,1473) = - lu(k,1457) * lu(k,1462) + lu(k,1474) = lu(k,1474) - lu(k,1458) * lu(k,1462) + lu(k,1475) = lu(k,1475) - lu(k,1459) * lu(k,1462) + lu(k,1484) = lu(k,1484) - lu(k,1448) * lu(k,1483) + lu(k,1485) = lu(k,1485) - lu(k,1449) * lu(k,1483) + lu(k,1486) = lu(k,1486) - lu(k,1450) * lu(k,1483) + lu(k,1487) = lu(k,1487) - lu(k,1451) * lu(k,1483) + lu(k,1488) = lu(k,1488) - lu(k,1452) * lu(k,1483) + lu(k,1490) = lu(k,1490) - lu(k,1453) * lu(k,1483) + lu(k,1491) = lu(k,1491) - lu(k,1454) * lu(k,1483) + lu(k,1492) = lu(k,1492) - lu(k,1455) * lu(k,1483) + lu(k,1494) = lu(k,1494) - lu(k,1456) * lu(k,1483) + lu(k,1495) = lu(k,1495) - lu(k,1457) * lu(k,1483) + lu(k,1497) = lu(k,1497) - lu(k,1458) * lu(k,1483) + lu(k,1498) = lu(k,1498) - lu(k,1459) * lu(k,1483) + lu(k,1524) = lu(k,1524) - lu(k,1448) * lu(k,1523) + lu(k,1525) = lu(k,1525) - lu(k,1449) * lu(k,1523) + lu(k,1526) = lu(k,1526) - lu(k,1450) * lu(k,1523) + lu(k,1527) = lu(k,1527) - lu(k,1451) * lu(k,1523) + lu(k,1528) = lu(k,1528) - lu(k,1452) * lu(k,1523) + lu(k,1530) = lu(k,1530) - lu(k,1453) * lu(k,1523) + lu(k,1532) = lu(k,1532) - lu(k,1454) * lu(k,1523) + lu(k,1533) = lu(k,1533) - lu(k,1455) * lu(k,1523) + lu(k,1535) = lu(k,1535) - lu(k,1456) * lu(k,1523) + lu(k,1536) = - lu(k,1457) * lu(k,1523) + lu(k,1538) = lu(k,1538) - lu(k,1458) * lu(k,1523) + lu(k,1539) = lu(k,1539) - lu(k,1459) * lu(k,1523) + lu(k,1688) = lu(k,1688) - lu(k,1448) * lu(k,1687) + lu(k,1689) = lu(k,1689) - lu(k,1449) * lu(k,1687) + lu(k,1690) = lu(k,1690) - lu(k,1450) * lu(k,1687) + lu(k,1691) = lu(k,1691) - lu(k,1451) * lu(k,1687) + lu(k,1692) = lu(k,1692) - lu(k,1452) * lu(k,1687) + lu(k,1694) = lu(k,1694) - lu(k,1453) * lu(k,1687) + lu(k,1696) = lu(k,1696) - lu(k,1454) * lu(k,1687) + lu(k,1697) = lu(k,1697) - lu(k,1455) * lu(k,1687) + lu(k,1699) = lu(k,1699) - lu(k,1456) * lu(k,1687) + lu(k,1700) = lu(k,1700) - lu(k,1457) * lu(k,1687) + lu(k,1702) = lu(k,1702) - lu(k,1458) * lu(k,1687) + lu(k,1703) = lu(k,1703) - lu(k,1459) * lu(k,1687) + lu(k,1745) = lu(k,1745) - lu(k,1448) * lu(k,1744) + lu(k,1746) = lu(k,1746) - lu(k,1449) * lu(k,1744) + lu(k,1747) = lu(k,1747) - lu(k,1450) * lu(k,1744) + lu(k,1748) = lu(k,1748) - lu(k,1451) * lu(k,1744) + lu(k,1749) = lu(k,1749) - lu(k,1452) * lu(k,1744) + lu(k,1751) = lu(k,1751) - lu(k,1453) * lu(k,1744) + lu(k,1753) = lu(k,1753) - lu(k,1454) * lu(k,1744) + lu(k,1754) = lu(k,1754) - lu(k,1455) * lu(k,1744) + lu(k,1756) = lu(k,1756) - lu(k,1456) * lu(k,1744) + lu(k,1757) = lu(k,1757) - lu(k,1457) * lu(k,1744) + lu(k,1759) = lu(k,1759) - lu(k,1458) * lu(k,1744) + lu(k,1760) = lu(k,1760) - lu(k,1459) * lu(k,1744) + lu(k,1837) = lu(k,1837) - lu(k,1448) * lu(k,1836) + lu(k,1838) = lu(k,1838) - lu(k,1449) * lu(k,1836) + lu(k,1839) = lu(k,1839) - lu(k,1450) * lu(k,1836) + lu(k,1840) = lu(k,1840) - lu(k,1451) * lu(k,1836) + lu(k,1841) = lu(k,1841) - lu(k,1452) * lu(k,1836) + lu(k,1843) = lu(k,1843) - lu(k,1453) * lu(k,1836) + lu(k,1845) = lu(k,1845) - lu(k,1454) * lu(k,1836) + lu(k,1846) = lu(k,1846) - lu(k,1455) * lu(k,1836) + lu(k,1848) = lu(k,1848) - lu(k,1456) * lu(k,1836) + lu(k,1849) = lu(k,1849) - lu(k,1457) * lu(k,1836) + lu(k,1851) = lu(k,1851) - lu(k,1458) * lu(k,1836) + lu(k,1852) = lu(k,1852) - lu(k,1459) * lu(k,1836) + lu(k,1944) = lu(k,1944) - lu(k,1448) * lu(k,1943) + lu(k,1945) = lu(k,1945) - lu(k,1449) * lu(k,1943) + lu(k,1946) = lu(k,1946) - lu(k,1450) * lu(k,1943) + lu(k,1947) = lu(k,1947) - lu(k,1451) * lu(k,1943) + lu(k,1948) = lu(k,1948) - lu(k,1452) * lu(k,1943) + lu(k,1950) = lu(k,1950) - lu(k,1453) * lu(k,1943) + lu(k,1952) = lu(k,1952) - lu(k,1454) * lu(k,1943) + lu(k,1953) = lu(k,1953) - lu(k,1455) * lu(k,1943) + lu(k,1955) = lu(k,1955) - lu(k,1456) * lu(k,1943) + lu(k,1956) = lu(k,1956) - lu(k,1457) * lu(k,1943) + lu(k,1958) = lu(k,1958) - lu(k,1458) * lu(k,1943) + lu(k,1959) = lu(k,1959) - lu(k,1459) * lu(k,1943) + lu(k,1970) = lu(k,1970) - lu(k,1448) * lu(k,1969) + lu(k,1971) = lu(k,1971) - lu(k,1449) * lu(k,1969) + lu(k,1972) = lu(k,1972) - lu(k,1450) * lu(k,1969) + lu(k,1973) = lu(k,1973) - lu(k,1451) * lu(k,1969) + lu(k,1974) = lu(k,1974) - lu(k,1452) * lu(k,1969) + lu(k,1976) = lu(k,1976) - lu(k,1453) * lu(k,1969) + lu(k,1978) = lu(k,1978) - lu(k,1454) * lu(k,1969) + lu(k,1979) = lu(k,1979) - lu(k,1455) * lu(k,1969) + lu(k,1981) = lu(k,1981) - lu(k,1456) * lu(k,1969) + lu(k,1982) = lu(k,1982) - lu(k,1457) * lu(k,1969) + lu(k,1984) = lu(k,1984) - lu(k,1458) * lu(k,1969) + lu(k,1985) = lu(k,1985) - lu(k,1459) * lu(k,1969) + lu(k,2009) = lu(k,2009) - lu(k,1448) * lu(k,2008) + lu(k,2010) = lu(k,2010) - lu(k,1449) * lu(k,2008) + lu(k,2011) = lu(k,2011) - lu(k,1450) * lu(k,2008) + lu(k,2012) = lu(k,2012) - lu(k,1451) * lu(k,2008) + lu(k,2013) = lu(k,2013) - lu(k,1452) * lu(k,2008) + lu(k,2015) = lu(k,2015) - lu(k,1453) * lu(k,2008) + lu(k,2017) = lu(k,2017) - lu(k,1454) * lu(k,2008) + lu(k,2018) = lu(k,2018) - lu(k,1455) * lu(k,2008) + lu(k,2020) = lu(k,2020) - lu(k,1456) * lu(k,2008) + lu(k,2021) = lu(k,2021) - lu(k,1457) * lu(k,2008) + lu(k,2023) = lu(k,2023) - lu(k,1458) * lu(k,2008) + lu(k,2024) = lu(k,2024) - lu(k,1459) * lu(k,2008) + lu(k,2061) = lu(k,2061) - lu(k,1448) * lu(k,2060) + lu(k,2062) = lu(k,2062) - lu(k,1449) * lu(k,2060) + lu(k,2063) = lu(k,2063) - lu(k,1450) * lu(k,2060) + lu(k,2064) = lu(k,2064) - lu(k,1451) * lu(k,2060) + lu(k,2065) = lu(k,2065) - lu(k,1452) * lu(k,2060) + lu(k,2067) = lu(k,2067) - lu(k,1453) * lu(k,2060) + lu(k,2069) = lu(k,2069) - lu(k,1454) * lu(k,2060) + lu(k,2070) = lu(k,2070) - lu(k,1455) * lu(k,2060) + lu(k,2072) = lu(k,2072) - lu(k,1456) * lu(k,2060) + lu(k,2073) = lu(k,2073) - lu(k,1457) * lu(k,2060) + lu(k,2075) = lu(k,2075) - lu(k,1458) * lu(k,2060) + lu(k,2076) = lu(k,2076) - lu(k,1459) * lu(k,2060) + lu(k,2122) = lu(k,2122) - lu(k,1448) * lu(k,2121) + lu(k,2123) = lu(k,2123) - lu(k,1449) * lu(k,2121) + lu(k,2124) = lu(k,2124) - lu(k,1450) * lu(k,2121) + lu(k,2125) = lu(k,2125) - lu(k,1451) * lu(k,2121) + lu(k,2126) = lu(k,2126) - lu(k,1452) * lu(k,2121) + lu(k,2128) = lu(k,2128) - lu(k,1453) * lu(k,2121) + lu(k,2130) = lu(k,2130) - lu(k,1454) * lu(k,2121) + lu(k,2131) = lu(k,2131) - lu(k,1455) * lu(k,2121) + lu(k,2133) = lu(k,2133) - lu(k,1456) * lu(k,2121) + lu(k,2134) = lu(k,2134) - lu(k,1457) * lu(k,2121) + lu(k,2136) = lu(k,2136) - lu(k,1458) * lu(k,2121) + lu(k,2137) = lu(k,2137) - lu(k,1459) * lu(k,2121) + lu(k,2145) = lu(k,2145) - lu(k,1448) * lu(k,2144) + lu(k,2146) = lu(k,2146) - lu(k,1449) * lu(k,2144) + lu(k,2147) = lu(k,2147) - lu(k,1450) * lu(k,2144) + lu(k,2148) = lu(k,2148) - lu(k,1451) * lu(k,2144) + lu(k,2149) = lu(k,2149) - lu(k,1452) * lu(k,2144) + lu(k,2151) = lu(k,2151) - lu(k,1453) * lu(k,2144) + lu(k,2153) = lu(k,2153) - lu(k,1454) * lu(k,2144) + lu(k,2154) = - lu(k,1455) * lu(k,2144) + lu(k,2156) = lu(k,2156) - lu(k,1456) * lu(k,2144) + lu(k,2157) = lu(k,2157) - lu(k,1457) * lu(k,2144) + lu(k,2159) = lu(k,2159) - lu(k,1458) * lu(k,2144) + lu(k,2160) = lu(k,2160) - lu(k,1459) * lu(k,2144) + lu(k,2189) = lu(k,2189) - lu(k,1448) * lu(k,2188) + lu(k,2190) = lu(k,2190) - lu(k,1449) * lu(k,2188) + lu(k,2191) = lu(k,2191) - lu(k,1450) * lu(k,2188) + lu(k,2192) = lu(k,2192) - lu(k,1451) * lu(k,2188) + lu(k,2193) = lu(k,2193) - lu(k,1452) * lu(k,2188) + lu(k,2195) = lu(k,2195) - lu(k,1453) * lu(k,2188) + lu(k,2197) = lu(k,2197) - lu(k,1454) * lu(k,2188) + lu(k,2198) = lu(k,2198) - lu(k,1455) * lu(k,2188) + lu(k,2200) = lu(k,2200) - lu(k,1456) * lu(k,2188) + lu(k,2201) = lu(k,2201) - lu(k,1457) * lu(k,2188) + lu(k,2203) = lu(k,2203) - lu(k,1458) * lu(k,2188) + lu(k,2204) = lu(k,2204) - lu(k,1459) * lu(k,2188) + lu(k,2213) = lu(k,2213) - lu(k,1448) * lu(k,2212) + lu(k,2214) = lu(k,2214) - lu(k,1449) * lu(k,2212) + lu(k,2215) = lu(k,2215) - lu(k,1450) * lu(k,2212) + lu(k,2216) = lu(k,2216) - lu(k,1451) * lu(k,2212) + lu(k,2217) = lu(k,2217) - lu(k,1452) * lu(k,2212) + lu(k,2219) = lu(k,2219) - lu(k,1453) * lu(k,2212) + lu(k,2221) = lu(k,2221) - lu(k,1454) * lu(k,2212) + lu(k,2222) = - lu(k,1455) * lu(k,2212) + lu(k,2224) = lu(k,2224) - lu(k,1456) * lu(k,2212) + lu(k,2225) = lu(k,2225) - lu(k,1457) * lu(k,2212) + lu(k,2227) = lu(k,2227) - lu(k,1458) * lu(k,2212) + lu(k,2228) = lu(k,2228) - lu(k,1459) * lu(k,2212) + lu(k,2244) = lu(k,2244) - lu(k,1448) * lu(k,2243) + lu(k,2245) = lu(k,2245) - lu(k,1449) * lu(k,2243) + lu(k,2246) = lu(k,2246) - lu(k,1450) * lu(k,2243) + lu(k,2247) = lu(k,2247) - lu(k,1451) * lu(k,2243) + lu(k,2248) = lu(k,2248) - lu(k,1452) * lu(k,2243) + lu(k,2250) = lu(k,2250) - lu(k,1453) * lu(k,2243) + lu(k,2252) = lu(k,2252) - lu(k,1454) * lu(k,2243) + lu(k,2253) = lu(k,2253) - lu(k,1455) * lu(k,2243) + lu(k,2255) = lu(k,2255) - lu(k,1456) * lu(k,2243) + lu(k,2256) = lu(k,2256) - lu(k,1457) * lu(k,2243) + lu(k,2258) = lu(k,2258) - lu(k,1458) * lu(k,2243) + lu(k,2259) = lu(k,2259) - lu(k,1459) * lu(k,2243) + lu(k,2270) = lu(k,2270) - lu(k,1448) * lu(k,2269) + lu(k,2271) = lu(k,2271) - lu(k,1449) * lu(k,2269) + lu(k,2272) = lu(k,2272) - lu(k,1450) * lu(k,2269) + lu(k,2273) = lu(k,2273) - lu(k,1451) * lu(k,2269) + lu(k,2274) = lu(k,2274) - lu(k,1452) * lu(k,2269) + lu(k,2276) = lu(k,2276) - lu(k,1453) * lu(k,2269) + lu(k,2278) = lu(k,2278) - lu(k,1454) * lu(k,2269) + lu(k,2279) = lu(k,2279) - lu(k,1455) * lu(k,2269) + lu(k,2281) = lu(k,2281) - lu(k,1456) * lu(k,2269) + lu(k,2282) = lu(k,2282) - lu(k,1457) * lu(k,2269) + lu(k,2284) = lu(k,2284) - lu(k,1458) * lu(k,2269) + lu(k,2285) = lu(k,2285) - lu(k,1459) * lu(k,2269) + lu(k,1463) = 1._r8 / lu(k,1463) + lu(k,1464) = lu(k,1464) * lu(k,1463) + lu(k,1465) = lu(k,1465) * lu(k,1463) + lu(k,1466) = lu(k,1466) * lu(k,1463) + lu(k,1467) = lu(k,1467) * lu(k,1463) + lu(k,1468) = lu(k,1468) * lu(k,1463) + lu(k,1469) = lu(k,1469) * lu(k,1463) + lu(k,1470) = lu(k,1470) * lu(k,1463) + lu(k,1471) = lu(k,1471) * lu(k,1463) + lu(k,1472) = lu(k,1472) * lu(k,1463) + lu(k,1473) = lu(k,1473) * lu(k,1463) + lu(k,1474) = lu(k,1474) * lu(k,1463) + lu(k,1475) = lu(k,1475) * lu(k,1463) + lu(k,1485) = lu(k,1485) - lu(k,1464) * lu(k,1484) + lu(k,1486) = lu(k,1486) - lu(k,1465) * lu(k,1484) + lu(k,1487) = lu(k,1487) - lu(k,1466) * lu(k,1484) + lu(k,1488) = lu(k,1488) - lu(k,1467) * lu(k,1484) + lu(k,1490) = lu(k,1490) - lu(k,1468) * lu(k,1484) + lu(k,1491) = lu(k,1491) - lu(k,1469) * lu(k,1484) + lu(k,1492) = lu(k,1492) - lu(k,1470) * lu(k,1484) + lu(k,1493) = lu(k,1493) - lu(k,1471) * lu(k,1484) + lu(k,1494) = lu(k,1494) - lu(k,1472) * lu(k,1484) + lu(k,1495) = lu(k,1495) - lu(k,1473) * lu(k,1484) + lu(k,1497) = lu(k,1497) - lu(k,1474) * lu(k,1484) + lu(k,1498) = lu(k,1498) - lu(k,1475) * lu(k,1484) + lu(k,1525) = lu(k,1525) - lu(k,1464) * lu(k,1524) + lu(k,1526) = lu(k,1526) - lu(k,1465) * lu(k,1524) + lu(k,1527) = lu(k,1527) - lu(k,1466) * lu(k,1524) + lu(k,1528) = lu(k,1528) - lu(k,1467) * lu(k,1524) + lu(k,1530) = lu(k,1530) - lu(k,1468) * lu(k,1524) + lu(k,1532) = lu(k,1532) - lu(k,1469) * lu(k,1524) + lu(k,1533) = lu(k,1533) - lu(k,1470) * lu(k,1524) + lu(k,1534) = lu(k,1534) - lu(k,1471) * lu(k,1524) + lu(k,1535) = lu(k,1535) - lu(k,1472) * lu(k,1524) + lu(k,1536) = lu(k,1536) - lu(k,1473) * lu(k,1524) + lu(k,1538) = lu(k,1538) - lu(k,1474) * lu(k,1524) + lu(k,1539) = lu(k,1539) - lu(k,1475) * lu(k,1524) + lu(k,1689) = lu(k,1689) - lu(k,1464) * lu(k,1688) + lu(k,1690) = lu(k,1690) - lu(k,1465) * lu(k,1688) + lu(k,1691) = lu(k,1691) - lu(k,1466) * lu(k,1688) + lu(k,1692) = lu(k,1692) - lu(k,1467) * lu(k,1688) + lu(k,1694) = lu(k,1694) - lu(k,1468) * lu(k,1688) + lu(k,1696) = lu(k,1696) - lu(k,1469) * lu(k,1688) + lu(k,1697) = lu(k,1697) - lu(k,1470) * lu(k,1688) + lu(k,1698) = lu(k,1698) - lu(k,1471) * lu(k,1688) + lu(k,1699) = lu(k,1699) - lu(k,1472) * lu(k,1688) + lu(k,1700) = lu(k,1700) - lu(k,1473) * lu(k,1688) + lu(k,1702) = lu(k,1702) - lu(k,1474) * lu(k,1688) + lu(k,1703) = lu(k,1703) - lu(k,1475) * lu(k,1688) + lu(k,1746) = lu(k,1746) - lu(k,1464) * lu(k,1745) + lu(k,1747) = lu(k,1747) - lu(k,1465) * lu(k,1745) + lu(k,1748) = lu(k,1748) - lu(k,1466) * lu(k,1745) + lu(k,1749) = lu(k,1749) - lu(k,1467) * lu(k,1745) + lu(k,1751) = lu(k,1751) - lu(k,1468) * lu(k,1745) + lu(k,1753) = lu(k,1753) - lu(k,1469) * lu(k,1745) + lu(k,1754) = lu(k,1754) - lu(k,1470) * lu(k,1745) + lu(k,1755) = lu(k,1755) - lu(k,1471) * lu(k,1745) + lu(k,1756) = lu(k,1756) - lu(k,1472) * lu(k,1745) + lu(k,1757) = lu(k,1757) - lu(k,1473) * lu(k,1745) + lu(k,1759) = lu(k,1759) - lu(k,1474) * lu(k,1745) + lu(k,1760) = lu(k,1760) - lu(k,1475) * lu(k,1745) + lu(k,1838) = lu(k,1838) - lu(k,1464) * lu(k,1837) + lu(k,1839) = lu(k,1839) - lu(k,1465) * lu(k,1837) + lu(k,1840) = lu(k,1840) - lu(k,1466) * lu(k,1837) + lu(k,1841) = lu(k,1841) - lu(k,1467) * lu(k,1837) + lu(k,1843) = lu(k,1843) - lu(k,1468) * lu(k,1837) + lu(k,1845) = lu(k,1845) - lu(k,1469) * lu(k,1837) + lu(k,1846) = lu(k,1846) - lu(k,1470) * lu(k,1837) + lu(k,1847) = lu(k,1847) - lu(k,1471) * lu(k,1837) + lu(k,1848) = lu(k,1848) - lu(k,1472) * lu(k,1837) + lu(k,1849) = lu(k,1849) - lu(k,1473) * lu(k,1837) + lu(k,1851) = lu(k,1851) - lu(k,1474) * lu(k,1837) + lu(k,1852) = lu(k,1852) - lu(k,1475) * lu(k,1837) + lu(k,1945) = lu(k,1945) - lu(k,1464) * lu(k,1944) + lu(k,1946) = lu(k,1946) - lu(k,1465) * lu(k,1944) + lu(k,1947) = lu(k,1947) - lu(k,1466) * lu(k,1944) + lu(k,1948) = lu(k,1948) - lu(k,1467) * lu(k,1944) + lu(k,1950) = lu(k,1950) - lu(k,1468) * lu(k,1944) + lu(k,1952) = lu(k,1952) - lu(k,1469) * lu(k,1944) + lu(k,1953) = lu(k,1953) - lu(k,1470) * lu(k,1944) + lu(k,1954) = lu(k,1954) - lu(k,1471) * lu(k,1944) + lu(k,1955) = lu(k,1955) - lu(k,1472) * lu(k,1944) + lu(k,1956) = lu(k,1956) - lu(k,1473) * lu(k,1944) + lu(k,1958) = lu(k,1958) - lu(k,1474) * lu(k,1944) + lu(k,1959) = lu(k,1959) - lu(k,1475) * lu(k,1944) + lu(k,1971) = lu(k,1971) - lu(k,1464) * lu(k,1970) + lu(k,1972) = lu(k,1972) - lu(k,1465) * lu(k,1970) + lu(k,1973) = lu(k,1973) - lu(k,1466) * lu(k,1970) + lu(k,1974) = lu(k,1974) - lu(k,1467) * lu(k,1970) + lu(k,1976) = lu(k,1976) - lu(k,1468) * lu(k,1970) + lu(k,1978) = lu(k,1978) - lu(k,1469) * lu(k,1970) + lu(k,1979) = lu(k,1979) - lu(k,1470) * lu(k,1970) + lu(k,1980) = lu(k,1980) - lu(k,1471) * lu(k,1970) + lu(k,1981) = lu(k,1981) - lu(k,1472) * lu(k,1970) + lu(k,1982) = lu(k,1982) - lu(k,1473) * lu(k,1970) + lu(k,1984) = lu(k,1984) - lu(k,1474) * lu(k,1970) + lu(k,1985) = lu(k,1985) - lu(k,1475) * lu(k,1970) + lu(k,2010) = lu(k,2010) - lu(k,1464) * lu(k,2009) + lu(k,2011) = lu(k,2011) - lu(k,1465) * lu(k,2009) + lu(k,2012) = lu(k,2012) - lu(k,1466) * lu(k,2009) + lu(k,2013) = lu(k,2013) - lu(k,1467) * lu(k,2009) + lu(k,2015) = lu(k,2015) - lu(k,1468) * lu(k,2009) + lu(k,2017) = lu(k,2017) - lu(k,1469) * lu(k,2009) + lu(k,2018) = lu(k,2018) - lu(k,1470) * lu(k,2009) + lu(k,2019) = lu(k,2019) - lu(k,1471) * lu(k,2009) + lu(k,2020) = lu(k,2020) - lu(k,1472) * lu(k,2009) + lu(k,2021) = lu(k,2021) - lu(k,1473) * lu(k,2009) + lu(k,2023) = lu(k,2023) - lu(k,1474) * lu(k,2009) + lu(k,2024) = lu(k,2024) - lu(k,1475) * lu(k,2009) + lu(k,2062) = lu(k,2062) - lu(k,1464) * lu(k,2061) + lu(k,2063) = lu(k,2063) - lu(k,1465) * lu(k,2061) + lu(k,2064) = lu(k,2064) - lu(k,1466) * lu(k,2061) + lu(k,2065) = lu(k,2065) - lu(k,1467) * lu(k,2061) + lu(k,2067) = lu(k,2067) - lu(k,1468) * lu(k,2061) + lu(k,2069) = lu(k,2069) - lu(k,1469) * lu(k,2061) + lu(k,2070) = lu(k,2070) - lu(k,1470) * lu(k,2061) + lu(k,2071) = lu(k,2071) - lu(k,1471) * lu(k,2061) + lu(k,2072) = lu(k,2072) - lu(k,1472) * lu(k,2061) + lu(k,2073) = lu(k,2073) - lu(k,1473) * lu(k,2061) + lu(k,2075) = lu(k,2075) - lu(k,1474) * lu(k,2061) + lu(k,2076) = lu(k,2076) - lu(k,1475) * lu(k,2061) + lu(k,2123) = lu(k,2123) - lu(k,1464) * lu(k,2122) + lu(k,2124) = lu(k,2124) - lu(k,1465) * lu(k,2122) + lu(k,2125) = lu(k,2125) - lu(k,1466) * lu(k,2122) + lu(k,2126) = lu(k,2126) - lu(k,1467) * lu(k,2122) + lu(k,2128) = lu(k,2128) - lu(k,1468) * lu(k,2122) + lu(k,2130) = lu(k,2130) - lu(k,1469) * lu(k,2122) + lu(k,2131) = lu(k,2131) - lu(k,1470) * lu(k,2122) + lu(k,2132) = lu(k,2132) - lu(k,1471) * lu(k,2122) + lu(k,2133) = lu(k,2133) - lu(k,1472) * lu(k,2122) + lu(k,2134) = lu(k,2134) - lu(k,1473) * lu(k,2122) + lu(k,2136) = lu(k,2136) - lu(k,1474) * lu(k,2122) + lu(k,2137) = lu(k,2137) - lu(k,1475) * lu(k,2122) + lu(k,2146) = lu(k,2146) - lu(k,1464) * lu(k,2145) + lu(k,2147) = lu(k,2147) - lu(k,1465) * lu(k,2145) + lu(k,2148) = lu(k,2148) - lu(k,1466) * lu(k,2145) + lu(k,2149) = lu(k,2149) - lu(k,1467) * lu(k,2145) + lu(k,2151) = lu(k,2151) - lu(k,1468) * lu(k,2145) + lu(k,2153) = lu(k,2153) - lu(k,1469) * lu(k,2145) + lu(k,2154) = lu(k,2154) - lu(k,1470) * lu(k,2145) + lu(k,2155) = lu(k,2155) - lu(k,1471) * lu(k,2145) + lu(k,2156) = lu(k,2156) - lu(k,1472) * lu(k,2145) + lu(k,2157) = lu(k,2157) - lu(k,1473) * lu(k,2145) + lu(k,2159) = lu(k,2159) - lu(k,1474) * lu(k,2145) + lu(k,2160) = lu(k,2160) - lu(k,1475) * lu(k,2145) + lu(k,2190) = lu(k,2190) - lu(k,1464) * lu(k,2189) + lu(k,2191) = lu(k,2191) - lu(k,1465) * lu(k,2189) + lu(k,2192) = lu(k,2192) - lu(k,1466) * lu(k,2189) + lu(k,2193) = lu(k,2193) - lu(k,1467) * lu(k,2189) + lu(k,2195) = lu(k,2195) - lu(k,1468) * lu(k,2189) + lu(k,2197) = lu(k,2197) - lu(k,1469) * lu(k,2189) + lu(k,2198) = lu(k,2198) - lu(k,1470) * lu(k,2189) + lu(k,2199) = lu(k,2199) - lu(k,1471) * lu(k,2189) + lu(k,2200) = lu(k,2200) - lu(k,1472) * lu(k,2189) + lu(k,2201) = lu(k,2201) - lu(k,1473) * lu(k,2189) + lu(k,2203) = lu(k,2203) - lu(k,1474) * lu(k,2189) + lu(k,2204) = lu(k,2204) - lu(k,1475) * lu(k,2189) + lu(k,2214) = lu(k,2214) - lu(k,1464) * lu(k,2213) + lu(k,2215) = lu(k,2215) - lu(k,1465) * lu(k,2213) + lu(k,2216) = lu(k,2216) - lu(k,1466) * lu(k,2213) + lu(k,2217) = lu(k,2217) - lu(k,1467) * lu(k,2213) + lu(k,2219) = lu(k,2219) - lu(k,1468) * lu(k,2213) + lu(k,2221) = lu(k,2221) - lu(k,1469) * lu(k,2213) + lu(k,2222) = lu(k,2222) - lu(k,1470) * lu(k,2213) + lu(k,2223) = lu(k,2223) - lu(k,1471) * lu(k,2213) + lu(k,2224) = lu(k,2224) - lu(k,1472) * lu(k,2213) + lu(k,2225) = lu(k,2225) - lu(k,1473) * lu(k,2213) + lu(k,2227) = lu(k,2227) - lu(k,1474) * lu(k,2213) + lu(k,2228) = lu(k,2228) - lu(k,1475) * lu(k,2213) + lu(k,2245) = lu(k,2245) - lu(k,1464) * lu(k,2244) + lu(k,2246) = lu(k,2246) - lu(k,1465) * lu(k,2244) + lu(k,2247) = lu(k,2247) - lu(k,1466) * lu(k,2244) + lu(k,2248) = lu(k,2248) - lu(k,1467) * lu(k,2244) + lu(k,2250) = lu(k,2250) - lu(k,1468) * lu(k,2244) + lu(k,2252) = lu(k,2252) - lu(k,1469) * lu(k,2244) + lu(k,2253) = lu(k,2253) - lu(k,1470) * lu(k,2244) + lu(k,2254) = lu(k,2254) - lu(k,1471) * lu(k,2244) + lu(k,2255) = lu(k,2255) - lu(k,1472) * lu(k,2244) + lu(k,2256) = lu(k,2256) - lu(k,1473) * lu(k,2244) + lu(k,2258) = lu(k,2258) - lu(k,1474) * lu(k,2244) + lu(k,2259) = lu(k,2259) - lu(k,1475) * lu(k,2244) + lu(k,2271) = lu(k,2271) - lu(k,1464) * lu(k,2270) + lu(k,2272) = lu(k,2272) - lu(k,1465) * lu(k,2270) + lu(k,2273) = lu(k,2273) - lu(k,1466) * lu(k,2270) + lu(k,2274) = lu(k,2274) - lu(k,1467) * lu(k,2270) + lu(k,2276) = lu(k,2276) - lu(k,1468) * lu(k,2270) + lu(k,2278) = lu(k,2278) - lu(k,1469) * lu(k,2270) + lu(k,2279) = lu(k,2279) - lu(k,1470) * lu(k,2270) + lu(k,2280) = lu(k,2280) - lu(k,1471) * lu(k,2270) + lu(k,2281) = lu(k,2281) - lu(k,1472) * lu(k,2270) + lu(k,2282) = lu(k,2282) - lu(k,1473) * lu(k,2270) + lu(k,2284) = lu(k,2284) - lu(k,1474) * lu(k,2270) + lu(k,2285) = lu(k,2285) - lu(k,1475) * lu(k,2270) + end do + end subroutine lu_fac28 + subroutine lu_fac29( 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,1485) = 1._r8 / lu(k,1485) + lu(k,1486) = lu(k,1486) * lu(k,1485) + lu(k,1487) = lu(k,1487) * lu(k,1485) + lu(k,1488) = lu(k,1488) * lu(k,1485) + lu(k,1489) = lu(k,1489) * lu(k,1485) + lu(k,1490) = lu(k,1490) * lu(k,1485) + lu(k,1491) = lu(k,1491) * lu(k,1485) + lu(k,1492) = lu(k,1492) * lu(k,1485) + lu(k,1493) = lu(k,1493) * lu(k,1485) + lu(k,1494) = lu(k,1494) * lu(k,1485) + lu(k,1495) = lu(k,1495) * lu(k,1485) + lu(k,1496) = lu(k,1496) * lu(k,1485) + lu(k,1497) = lu(k,1497) * lu(k,1485) + lu(k,1498) = lu(k,1498) * lu(k,1485) + lu(k,1526) = lu(k,1526) - lu(k,1486) * lu(k,1525) + lu(k,1527) = lu(k,1527) - lu(k,1487) * lu(k,1525) + lu(k,1528) = lu(k,1528) - lu(k,1488) * lu(k,1525) + lu(k,1529) = lu(k,1529) - lu(k,1489) * lu(k,1525) + lu(k,1530) = lu(k,1530) - lu(k,1490) * lu(k,1525) + lu(k,1532) = lu(k,1532) - lu(k,1491) * lu(k,1525) + lu(k,1533) = lu(k,1533) - lu(k,1492) * lu(k,1525) + lu(k,1534) = lu(k,1534) - lu(k,1493) * lu(k,1525) + lu(k,1535) = lu(k,1535) - lu(k,1494) * lu(k,1525) + lu(k,1536) = lu(k,1536) - lu(k,1495) * lu(k,1525) + lu(k,1537) = lu(k,1537) - lu(k,1496) * lu(k,1525) + lu(k,1538) = lu(k,1538) - lu(k,1497) * lu(k,1525) + lu(k,1539) = lu(k,1539) - lu(k,1498) * lu(k,1525) + lu(k,1690) = lu(k,1690) - lu(k,1486) * lu(k,1689) + lu(k,1691) = lu(k,1691) - lu(k,1487) * lu(k,1689) + lu(k,1692) = lu(k,1692) - lu(k,1488) * lu(k,1689) + lu(k,1693) = lu(k,1693) - lu(k,1489) * lu(k,1689) + lu(k,1694) = lu(k,1694) - lu(k,1490) * lu(k,1689) + lu(k,1696) = lu(k,1696) - lu(k,1491) * lu(k,1689) + lu(k,1697) = lu(k,1697) - lu(k,1492) * lu(k,1689) + lu(k,1698) = lu(k,1698) - lu(k,1493) * lu(k,1689) + lu(k,1699) = lu(k,1699) - lu(k,1494) * lu(k,1689) + lu(k,1700) = lu(k,1700) - lu(k,1495) * lu(k,1689) + lu(k,1701) = lu(k,1701) - lu(k,1496) * lu(k,1689) + lu(k,1702) = lu(k,1702) - lu(k,1497) * lu(k,1689) + lu(k,1703) = lu(k,1703) - lu(k,1498) * lu(k,1689) + lu(k,1747) = lu(k,1747) - lu(k,1486) * lu(k,1746) + lu(k,1748) = lu(k,1748) - lu(k,1487) * lu(k,1746) + lu(k,1749) = lu(k,1749) - lu(k,1488) * lu(k,1746) + lu(k,1750) = lu(k,1750) - lu(k,1489) * lu(k,1746) + lu(k,1751) = lu(k,1751) - lu(k,1490) * lu(k,1746) + lu(k,1753) = lu(k,1753) - lu(k,1491) * lu(k,1746) + lu(k,1754) = lu(k,1754) - lu(k,1492) * lu(k,1746) + lu(k,1755) = lu(k,1755) - lu(k,1493) * lu(k,1746) + lu(k,1756) = lu(k,1756) - lu(k,1494) * lu(k,1746) + lu(k,1757) = lu(k,1757) - lu(k,1495) * lu(k,1746) + lu(k,1758) = lu(k,1758) - lu(k,1496) * lu(k,1746) + lu(k,1759) = lu(k,1759) - lu(k,1497) * lu(k,1746) + lu(k,1760) = lu(k,1760) - lu(k,1498) * lu(k,1746) + lu(k,1839) = lu(k,1839) - lu(k,1486) * lu(k,1838) + lu(k,1840) = lu(k,1840) - lu(k,1487) * lu(k,1838) + lu(k,1841) = lu(k,1841) - lu(k,1488) * lu(k,1838) + lu(k,1842) = lu(k,1842) - lu(k,1489) * lu(k,1838) + lu(k,1843) = lu(k,1843) - lu(k,1490) * lu(k,1838) + lu(k,1845) = lu(k,1845) - lu(k,1491) * lu(k,1838) + lu(k,1846) = lu(k,1846) - lu(k,1492) * lu(k,1838) + lu(k,1847) = lu(k,1847) - lu(k,1493) * lu(k,1838) + lu(k,1848) = lu(k,1848) - lu(k,1494) * lu(k,1838) + lu(k,1849) = lu(k,1849) - lu(k,1495) * lu(k,1838) + lu(k,1850) = lu(k,1850) - lu(k,1496) * lu(k,1838) + lu(k,1851) = lu(k,1851) - lu(k,1497) * lu(k,1838) + lu(k,1852) = lu(k,1852) - lu(k,1498) * lu(k,1838) + lu(k,1946) = lu(k,1946) - lu(k,1486) * lu(k,1945) + lu(k,1947) = lu(k,1947) - lu(k,1487) * lu(k,1945) + lu(k,1948) = lu(k,1948) - lu(k,1488) * lu(k,1945) + lu(k,1949) = lu(k,1949) - lu(k,1489) * lu(k,1945) + lu(k,1950) = lu(k,1950) - lu(k,1490) * lu(k,1945) + lu(k,1952) = lu(k,1952) - lu(k,1491) * lu(k,1945) + lu(k,1953) = lu(k,1953) - lu(k,1492) * lu(k,1945) + lu(k,1954) = lu(k,1954) - lu(k,1493) * lu(k,1945) + lu(k,1955) = lu(k,1955) - lu(k,1494) * lu(k,1945) + lu(k,1956) = lu(k,1956) - lu(k,1495) * lu(k,1945) + lu(k,1957) = lu(k,1957) - lu(k,1496) * lu(k,1945) + lu(k,1958) = lu(k,1958) - lu(k,1497) * lu(k,1945) + lu(k,1959) = lu(k,1959) - lu(k,1498) * lu(k,1945) + lu(k,1972) = lu(k,1972) - lu(k,1486) * lu(k,1971) + lu(k,1973) = lu(k,1973) - lu(k,1487) * lu(k,1971) + lu(k,1974) = lu(k,1974) - lu(k,1488) * lu(k,1971) + lu(k,1975) = lu(k,1975) - lu(k,1489) * lu(k,1971) + lu(k,1976) = lu(k,1976) - lu(k,1490) * lu(k,1971) + lu(k,1978) = lu(k,1978) - lu(k,1491) * lu(k,1971) + lu(k,1979) = lu(k,1979) - lu(k,1492) * lu(k,1971) + lu(k,1980) = lu(k,1980) - lu(k,1493) * lu(k,1971) + lu(k,1981) = lu(k,1981) - lu(k,1494) * lu(k,1971) + lu(k,1982) = lu(k,1982) - lu(k,1495) * lu(k,1971) + lu(k,1983) = lu(k,1983) - lu(k,1496) * lu(k,1971) + lu(k,1984) = lu(k,1984) - lu(k,1497) * lu(k,1971) + lu(k,1985) = lu(k,1985) - lu(k,1498) * lu(k,1971) + lu(k,2011) = lu(k,2011) - lu(k,1486) * lu(k,2010) + lu(k,2012) = lu(k,2012) - lu(k,1487) * lu(k,2010) + lu(k,2013) = lu(k,2013) - lu(k,1488) * lu(k,2010) + lu(k,2014) = lu(k,2014) - lu(k,1489) * lu(k,2010) + lu(k,2015) = lu(k,2015) - lu(k,1490) * lu(k,2010) + lu(k,2017) = lu(k,2017) - lu(k,1491) * lu(k,2010) + lu(k,2018) = lu(k,2018) - lu(k,1492) * lu(k,2010) + lu(k,2019) = lu(k,2019) - lu(k,1493) * lu(k,2010) + lu(k,2020) = lu(k,2020) - lu(k,1494) * lu(k,2010) + lu(k,2021) = lu(k,2021) - lu(k,1495) * lu(k,2010) + lu(k,2022) = lu(k,2022) - lu(k,1496) * lu(k,2010) + lu(k,2023) = lu(k,2023) - lu(k,1497) * lu(k,2010) + lu(k,2024) = lu(k,2024) - lu(k,1498) * lu(k,2010) + lu(k,2063) = lu(k,2063) - lu(k,1486) * lu(k,2062) + lu(k,2064) = lu(k,2064) - lu(k,1487) * lu(k,2062) + lu(k,2065) = lu(k,2065) - lu(k,1488) * lu(k,2062) + lu(k,2066) = lu(k,2066) - lu(k,1489) * lu(k,2062) + lu(k,2067) = lu(k,2067) - lu(k,1490) * lu(k,2062) + lu(k,2069) = lu(k,2069) - lu(k,1491) * lu(k,2062) + lu(k,2070) = lu(k,2070) - lu(k,1492) * lu(k,2062) + lu(k,2071) = lu(k,2071) - lu(k,1493) * lu(k,2062) + lu(k,2072) = lu(k,2072) - lu(k,1494) * lu(k,2062) + lu(k,2073) = lu(k,2073) - lu(k,1495) * lu(k,2062) + lu(k,2074) = - lu(k,1496) * lu(k,2062) + lu(k,2075) = lu(k,2075) - lu(k,1497) * lu(k,2062) + lu(k,2076) = lu(k,2076) - lu(k,1498) * lu(k,2062) + lu(k,2124) = lu(k,2124) - lu(k,1486) * lu(k,2123) + lu(k,2125) = lu(k,2125) - lu(k,1487) * lu(k,2123) + lu(k,2126) = lu(k,2126) - lu(k,1488) * lu(k,2123) + lu(k,2127) = lu(k,2127) - lu(k,1489) * lu(k,2123) + lu(k,2128) = lu(k,2128) - lu(k,1490) * lu(k,2123) + lu(k,2130) = lu(k,2130) - lu(k,1491) * lu(k,2123) + lu(k,2131) = lu(k,2131) - lu(k,1492) * lu(k,2123) + lu(k,2132) = lu(k,2132) - lu(k,1493) * lu(k,2123) + lu(k,2133) = lu(k,2133) - lu(k,1494) * lu(k,2123) + lu(k,2134) = lu(k,2134) - lu(k,1495) * lu(k,2123) + lu(k,2135) = lu(k,2135) - lu(k,1496) * lu(k,2123) + lu(k,2136) = lu(k,2136) - lu(k,1497) * lu(k,2123) + lu(k,2137) = lu(k,2137) - lu(k,1498) * lu(k,2123) + lu(k,2147) = lu(k,2147) - lu(k,1486) * lu(k,2146) + lu(k,2148) = lu(k,2148) - lu(k,1487) * lu(k,2146) + lu(k,2149) = lu(k,2149) - lu(k,1488) * lu(k,2146) + lu(k,2150) = - lu(k,1489) * lu(k,2146) + lu(k,2151) = lu(k,2151) - lu(k,1490) * lu(k,2146) + lu(k,2153) = lu(k,2153) - lu(k,1491) * lu(k,2146) + lu(k,2154) = lu(k,2154) - lu(k,1492) * lu(k,2146) + lu(k,2155) = lu(k,2155) - lu(k,1493) * lu(k,2146) + lu(k,2156) = lu(k,2156) - lu(k,1494) * lu(k,2146) + lu(k,2157) = lu(k,2157) - lu(k,1495) * lu(k,2146) + lu(k,2158) = lu(k,2158) - lu(k,1496) * lu(k,2146) + lu(k,2159) = lu(k,2159) - lu(k,1497) * lu(k,2146) + lu(k,2160) = lu(k,2160) - lu(k,1498) * lu(k,2146) + lu(k,2191) = lu(k,2191) - lu(k,1486) * lu(k,2190) + lu(k,2192) = lu(k,2192) - lu(k,1487) * lu(k,2190) + lu(k,2193) = lu(k,2193) - lu(k,1488) * lu(k,2190) + lu(k,2194) = lu(k,2194) - lu(k,1489) * lu(k,2190) + lu(k,2195) = lu(k,2195) - lu(k,1490) * lu(k,2190) + lu(k,2197) = lu(k,2197) - lu(k,1491) * lu(k,2190) + lu(k,2198) = lu(k,2198) - lu(k,1492) * lu(k,2190) + lu(k,2199) = lu(k,2199) - lu(k,1493) * lu(k,2190) + lu(k,2200) = lu(k,2200) - lu(k,1494) * lu(k,2190) + lu(k,2201) = lu(k,2201) - lu(k,1495) * lu(k,2190) + lu(k,2202) = lu(k,2202) - lu(k,1496) * lu(k,2190) + lu(k,2203) = lu(k,2203) - lu(k,1497) * lu(k,2190) + lu(k,2204) = lu(k,2204) - lu(k,1498) * lu(k,2190) + lu(k,2215) = lu(k,2215) - lu(k,1486) * lu(k,2214) + lu(k,2216) = lu(k,2216) - lu(k,1487) * lu(k,2214) + lu(k,2217) = lu(k,2217) - lu(k,1488) * lu(k,2214) + lu(k,2218) = lu(k,2218) - lu(k,1489) * lu(k,2214) + lu(k,2219) = lu(k,2219) - lu(k,1490) * lu(k,2214) + lu(k,2221) = lu(k,2221) - lu(k,1491) * lu(k,2214) + lu(k,2222) = lu(k,2222) - lu(k,1492) * lu(k,2214) + lu(k,2223) = lu(k,2223) - lu(k,1493) * lu(k,2214) + lu(k,2224) = lu(k,2224) - lu(k,1494) * lu(k,2214) + lu(k,2225) = lu(k,2225) - lu(k,1495) * lu(k,2214) + lu(k,2226) = lu(k,2226) - lu(k,1496) * lu(k,2214) + lu(k,2227) = lu(k,2227) - lu(k,1497) * lu(k,2214) + lu(k,2228) = lu(k,2228) - lu(k,1498) * lu(k,2214) + lu(k,2246) = lu(k,2246) - lu(k,1486) * lu(k,2245) + lu(k,2247) = lu(k,2247) - lu(k,1487) * lu(k,2245) + lu(k,2248) = lu(k,2248) - lu(k,1488) * lu(k,2245) + lu(k,2249) = lu(k,2249) - lu(k,1489) * lu(k,2245) + lu(k,2250) = lu(k,2250) - lu(k,1490) * lu(k,2245) + lu(k,2252) = lu(k,2252) - lu(k,1491) * lu(k,2245) + lu(k,2253) = lu(k,2253) - lu(k,1492) * lu(k,2245) + lu(k,2254) = lu(k,2254) - lu(k,1493) * lu(k,2245) + lu(k,2255) = lu(k,2255) - lu(k,1494) * lu(k,2245) + lu(k,2256) = lu(k,2256) - lu(k,1495) * lu(k,2245) + lu(k,2257) = lu(k,2257) - lu(k,1496) * lu(k,2245) + lu(k,2258) = lu(k,2258) - lu(k,1497) * lu(k,2245) + lu(k,2259) = lu(k,2259) - lu(k,1498) * lu(k,2245) + lu(k,2272) = lu(k,2272) - lu(k,1486) * lu(k,2271) + lu(k,2273) = lu(k,2273) - lu(k,1487) * lu(k,2271) + lu(k,2274) = lu(k,2274) - lu(k,1488) * lu(k,2271) + lu(k,2275) = lu(k,2275) - lu(k,1489) * lu(k,2271) + lu(k,2276) = lu(k,2276) - lu(k,1490) * lu(k,2271) + lu(k,2278) = lu(k,2278) - lu(k,1491) * lu(k,2271) + lu(k,2279) = lu(k,2279) - lu(k,1492) * lu(k,2271) + lu(k,2280) = lu(k,2280) - lu(k,1493) * lu(k,2271) + lu(k,2281) = lu(k,2281) - lu(k,1494) * lu(k,2271) + lu(k,2282) = lu(k,2282) - lu(k,1495) * lu(k,2271) + lu(k,2283) = lu(k,2283) - lu(k,1496) * lu(k,2271) + lu(k,2284) = lu(k,2284) - lu(k,1497) * lu(k,2271) + lu(k,2285) = lu(k,2285) - lu(k,1498) * lu(k,2271) + lu(k,1526) = 1._r8 / lu(k,1526) + lu(k,1527) = lu(k,1527) * lu(k,1526) + lu(k,1528) = lu(k,1528) * lu(k,1526) + lu(k,1529) = lu(k,1529) * lu(k,1526) + lu(k,1530) = lu(k,1530) * lu(k,1526) + lu(k,1531) = lu(k,1531) * lu(k,1526) + lu(k,1532) = lu(k,1532) * lu(k,1526) + lu(k,1533) = lu(k,1533) * lu(k,1526) + lu(k,1534) = lu(k,1534) * lu(k,1526) + lu(k,1535) = lu(k,1535) * lu(k,1526) + lu(k,1536) = lu(k,1536) * lu(k,1526) + lu(k,1537) = lu(k,1537) * lu(k,1526) + lu(k,1538) = lu(k,1538) * lu(k,1526) + lu(k,1539) = lu(k,1539) * lu(k,1526) + lu(k,1691) = lu(k,1691) - lu(k,1527) * lu(k,1690) + lu(k,1692) = lu(k,1692) - lu(k,1528) * lu(k,1690) + lu(k,1693) = lu(k,1693) - lu(k,1529) * lu(k,1690) + lu(k,1694) = lu(k,1694) - lu(k,1530) * lu(k,1690) + lu(k,1695) = lu(k,1695) - lu(k,1531) * lu(k,1690) + lu(k,1696) = lu(k,1696) - lu(k,1532) * lu(k,1690) + lu(k,1697) = lu(k,1697) - lu(k,1533) * lu(k,1690) + lu(k,1698) = lu(k,1698) - lu(k,1534) * lu(k,1690) + lu(k,1699) = lu(k,1699) - lu(k,1535) * lu(k,1690) + lu(k,1700) = lu(k,1700) - lu(k,1536) * lu(k,1690) + lu(k,1701) = lu(k,1701) - lu(k,1537) * lu(k,1690) + lu(k,1702) = lu(k,1702) - lu(k,1538) * lu(k,1690) + lu(k,1703) = lu(k,1703) - lu(k,1539) * lu(k,1690) + lu(k,1748) = lu(k,1748) - lu(k,1527) * lu(k,1747) + lu(k,1749) = lu(k,1749) - lu(k,1528) * lu(k,1747) + lu(k,1750) = lu(k,1750) - lu(k,1529) * lu(k,1747) + lu(k,1751) = lu(k,1751) - lu(k,1530) * lu(k,1747) + lu(k,1752) = lu(k,1752) - lu(k,1531) * lu(k,1747) + lu(k,1753) = lu(k,1753) - lu(k,1532) * lu(k,1747) + lu(k,1754) = lu(k,1754) - lu(k,1533) * lu(k,1747) + lu(k,1755) = lu(k,1755) - lu(k,1534) * lu(k,1747) + lu(k,1756) = lu(k,1756) - lu(k,1535) * lu(k,1747) + lu(k,1757) = lu(k,1757) - lu(k,1536) * lu(k,1747) + lu(k,1758) = lu(k,1758) - lu(k,1537) * lu(k,1747) + lu(k,1759) = lu(k,1759) - lu(k,1538) * lu(k,1747) + lu(k,1760) = lu(k,1760) - lu(k,1539) * lu(k,1747) + lu(k,1840) = lu(k,1840) - lu(k,1527) * lu(k,1839) + lu(k,1841) = lu(k,1841) - lu(k,1528) * lu(k,1839) + lu(k,1842) = lu(k,1842) - lu(k,1529) * lu(k,1839) + lu(k,1843) = lu(k,1843) - lu(k,1530) * lu(k,1839) + lu(k,1844) = lu(k,1844) - lu(k,1531) * lu(k,1839) + lu(k,1845) = lu(k,1845) - lu(k,1532) * lu(k,1839) + lu(k,1846) = lu(k,1846) - lu(k,1533) * lu(k,1839) + lu(k,1847) = lu(k,1847) - lu(k,1534) * lu(k,1839) + lu(k,1848) = lu(k,1848) - lu(k,1535) * lu(k,1839) + lu(k,1849) = lu(k,1849) - lu(k,1536) * lu(k,1839) + lu(k,1850) = lu(k,1850) - lu(k,1537) * lu(k,1839) + lu(k,1851) = lu(k,1851) - lu(k,1538) * lu(k,1839) + lu(k,1852) = lu(k,1852) - lu(k,1539) * lu(k,1839) + lu(k,1947) = lu(k,1947) - lu(k,1527) * lu(k,1946) + lu(k,1948) = lu(k,1948) - lu(k,1528) * lu(k,1946) + lu(k,1949) = lu(k,1949) - lu(k,1529) * lu(k,1946) + lu(k,1950) = lu(k,1950) - lu(k,1530) * lu(k,1946) + lu(k,1951) = lu(k,1951) - lu(k,1531) * lu(k,1946) + lu(k,1952) = lu(k,1952) - lu(k,1532) * lu(k,1946) + lu(k,1953) = lu(k,1953) - lu(k,1533) * lu(k,1946) + lu(k,1954) = lu(k,1954) - lu(k,1534) * lu(k,1946) + lu(k,1955) = lu(k,1955) - lu(k,1535) * lu(k,1946) + lu(k,1956) = lu(k,1956) - lu(k,1536) * lu(k,1946) + lu(k,1957) = lu(k,1957) - lu(k,1537) * lu(k,1946) + lu(k,1958) = lu(k,1958) - lu(k,1538) * lu(k,1946) + lu(k,1959) = lu(k,1959) - lu(k,1539) * lu(k,1946) + lu(k,1973) = lu(k,1973) - lu(k,1527) * lu(k,1972) + lu(k,1974) = lu(k,1974) - lu(k,1528) * lu(k,1972) + lu(k,1975) = lu(k,1975) - lu(k,1529) * lu(k,1972) + lu(k,1976) = lu(k,1976) - lu(k,1530) * lu(k,1972) + lu(k,1977) = lu(k,1977) - lu(k,1531) * lu(k,1972) + lu(k,1978) = lu(k,1978) - lu(k,1532) * lu(k,1972) + lu(k,1979) = lu(k,1979) - lu(k,1533) * lu(k,1972) + lu(k,1980) = lu(k,1980) - lu(k,1534) * lu(k,1972) + lu(k,1981) = lu(k,1981) - lu(k,1535) * lu(k,1972) + lu(k,1982) = lu(k,1982) - lu(k,1536) * lu(k,1972) + lu(k,1983) = lu(k,1983) - lu(k,1537) * lu(k,1972) + lu(k,1984) = lu(k,1984) - lu(k,1538) * lu(k,1972) + lu(k,1985) = lu(k,1985) - lu(k,1539) * lu(k,1972) + lu(k,2012) = lu(k,2012) - lu(k,1527) * lu(k,2011) + lu(k,2013) = lu(k,2013) - lu(k,1528) * lu(k,2011) + lu(k,2014) = lu(k,2014) - lu(k,1529) * lu(k,2011) + lu(k,2015) = lu(k,2015) - lu(k,1530) * lu(k,2011) + lu(k,2016) = lu(k,2016) - lu(k,1531) * lu(k,2011) + lu(k,2017) = lu(k,2017) - lu(k,1532) * lu(k,2011) + lu(k,2018) = lu(k,2018) - lu(k,1533) * lu(k,2011) + lu(k,2019) = lu(k,2019) - lu(k,1534) * lu(k,2011) + lu(k,2020) = lu(k,2020) - lu(k,1535) * lu(k,2011) + lu(k,2021) = lu(k,2021) - lu(k,1536) * lu(k,2011) + lu(k,2022) = lu(k,2022) - lu(k,1537) * lu(k,2011) + lu(k,2023) = lu(k,2023) - lu(k,1538) * lu(k,2011) + lu(k,2024) = lu(k,2024) - lu(k,1539) * lu(k,2011) + lu(k,2064) = lu(k,2064) - lu(k,1527) * lu(k,2063) + lu(k,2065) = lu(k,2065) - lu(k,1528) * lu(k,2063) + lu(k,2066) = lu(k,2066) - lu(k,1529) * lu(k,2063) + lu(k,2067) = lu(k,2067) - lu(k,1530) * lu(k,2063) + lu(k,2068) = lu(k,2068) - lu(k,1531) * lu(k,2063) + lu(k,2069) = lu(k,2069) - lu(k,1532) * lu(k,2063) + lu(k,2070) = lu(k,2070) - lu(k,1533) * lu(k,2063) + lu(k,2071) = lu(k,2071) - lu(k,1534) * lu(k,2063) + lu(k,2072) = lu(k,2072) - lu(k,1535) * lu(k,2063) + lu(k,2073) = lu(k,2073) - lu(k,1536) * lu(k,2063) + lu(k,2074) = lu(k,2074) - lu(k,1537) * lu(k,2063) + lu(k,2075) = lu(k,2075) - lu(k,1538) * lu(k,2063) + lu(k,2076) = lu(k,2076) - lu(k,1539) * lu(k,2063) + lu(k,2125) = lu(k,2125) - lu(k,1527) * lu(k,2124) + lu(k,2126) = lu(k,2126) - lu(k,1528) * lu(k,2124) + lu(k,2127) = lu(k,2127) - lu(k,1529) * lu(k,2124) + lu(k,2128) = lu(k,2128) - lu(k,1530) * lu(k,2124) + lu(k,2129) = lu(k,2129) - lu(k,1531) * lu(k,2124) + lu(k,2130) = lu(k,2130) - lu(k,1532) * lu(k,2124) + lu(k,2131) = lu(k,2131) - lu(k,1533) * lu(k,2124) + lu(k,2132) = lu(k,2132) - lu(k,1534) * lu(k,2124) + lu(k,2133) = lu(k,2133) - lu(k,1535) * lu(k,2124) + lu(k,2134) = lu(k,2134) - lu(k,1536) * lu(k,2124) + lu(k,2135) = lu(k,2135) - lu(k,1537) * lu(k,2124) + lu(k,2136) = lu(k,2136) - lu(k,1538) * lu(k,2124) + lu(k,2137) = lu(k,2137) - lu(k,1539) * lu(k,2124) + lu(k,2148) = lu(k,2148) - lu(k,1527) * lu(k,2147) + lu(k,2149) = lu(k,2149) - lu(k,1528) * lu(k,2147) + lu(k,2150) = lu(k,2150) - lu(k,1529) * lu(k,2147) + lu(k,2151) = lu(k,2151) - lu(k,1530) * lu(k,2147) + lu(k,2152) = lu(k,2152) - lu(k,1531) * lu(k,2147) + lu(k,2153) = lu(k,2153) - lu(k,1532) * lu(k,2147) + lu(k,2154) = lu(k,2154) - lu(k,1533) * lu(k,2147) + lu(k,2155) = lu(k,2155) - lu(k,1534) * lu(k,2147) + lu(k,2156) = lu(k,2156) - lu(k,1535) * lu(k,2147) + lu(k,2157) = lu(k,2157) - lu(k,1536) * lu(k,2147) + lu(k,2158) = lu(k,2158) - lu(k,1537) * lu(k,2147) + lu(k,2159) = lu(k,2159) - lu(k,1538) * lu(k,2147) + lu(k,2160) = lu(k,2160) - lu(k,1539) * lu(k,2147) + lu(k,2192) = lu(k,2192) - lu(k,1527) * lu(k,2191) + lu(k,2193) = lu(k,2193) - lu(k,1528) * lu(k,2191) + lu(k,2194) = lu(k,2194) - lu(k,1529) * lu(k,2191) + lu(k,2195) = lu(k,2195) - lu(k,1530) * lu(k,2191) + lu(k,2196) = lu(k,2196) - lu(k,1531) * lu(k,2191) + lu(k,2197) = lu(k,2197) - lu(k,1532) * lu(k,2191) + lu(k,2198) = lu(k,2198) - lu(k,1533) * lu(k,2191) + lu(k,2199) = lu(k,2199) - lu(k,1534) * lu(k,2191) + lu(k,2200) = lu(k,2200) - lu(k,1535) * lu(k,2191) + lu(k,2201) = lu(k,2201) - lu(k,1536) * lu(k,2191) + lu(k,2202) = lu(k,2202) - lu(k,1537) * lu(k,2191) + lu(k,2203) = lu(k,2203) - lu(k,1538) * lu(k,2191) + lu(k,2204) = lu(k,2204) - lu(k,1539) * lu(k,2191) + lu(k,2216) = lu(k,2216) - lu(k,1527) * lu(k,2215) + lu(k,2217) = lu(k,2217) - lu(k,1528) * lu(k,2215) + lu(k,2218) = lu(k,2218) - lu(k,1529) * lu(k,2215) + lu(k,2219) = lu(k,2219) - lu(k,1530) * lu(k,2215) + lu(k,2220) = lu(k,2220) - lu(k,1531) * lu(k,2215) + lu(k,2221) = lu(k,2221) - lu(k,1532) * lu(k,2215) + lu(k,2222) = lu(k,2222) - lu(k,1533) * lu(k,2215) + lu(k,2223) = lu(k,2223) - lu(k,1534) * lu(k,2215) + lu(k,2224) = lu(k,2224) - lu(k,1535) * lu(k,2215) + lu(k,2225) = lu(k,2225) - lu(k,1536) * lu(k,2215) + lu(k,2226) = lu(k,2226) - lu(k,1537) * lu(k,2215) + lu(k,2227) = lu(k,2227) - lu(k,1538) * lu(k,2215) + lu(k,2228) = lu(k,2228) - lu(k,1539) * lu(k,2215) + lu(k,2247) = lu(k,2247) - lu(k,1527) * lu(k,2246) + lu(k,2248) = lu(k,2248) - lu(k,1528) * lu(k,2246) + lu(k,2249) = lu(k,2249) - lu(k,1529) * lu(k,2246) + lu(k,2250) = lu(k,2250) - lu(k,1530) * lu(k,2246) + lu(k,2251) = lu(k,2251) - lu(k,1531) * lu(k,2246) + lu(k,2252) = lu(k,2252) - lu(k,1532) * lu(k,2246) + lu(k,2253) = lu(k,2253) - lu(k,1533) * lu(k,2246) + lu(k,2254) = lu(k,2254) - lu(k,1534) * lu(k,2246) + lu(k,2255) = lu(k,2255) - lu(k,1535) * lu(k,2246) + lu(k,2256) = lu(k,2256) - lu(k,1536) * lu(k,2246) + lu(k,2257) = lu(k,2257) - lu(k,1537) * lu(k,2246) + lu(k,2258) = lu(k,2258) - lu(k,1538) * lu(k,2246) + lu(k,2259) = lu(k,2259) - lu(k,1539) * lu(k,2246) + lu(k,2273) = lu(k,2273) - lu(k,1527) * lu(k,2272) + lu(k,2274) = lu(k,2274) - lu(k,1528) * lu(k,2272) + lu(k,2275) = lu(k,2275) - lu(k,1529) * lu(k,2272) + lu(k,2276) = lu(k,2276) - lu(k,1530) * lu(k,2272) + lu(k,2277) = lu(k,2277) - lu(k,1531) * lu(k,2272) + lu(k,2278) = lu(k,2278) - lu(k,1532) * lu(k,2272) + lu(k,2279) = lu(k,2279) - lu(k,1533) * lu(k,2272) + lu(k,2280) = lu(k,2280) - lu(k,1534) * lu(k,2272) + lu(k,2281) = lu(k,2281) - lu(k,1535) * lu(k,2272) + lu(k,2282) = lu(k,2282) - lu(k,1536) * lu(k,2272) + lu(k,2283) = lu(k,2283) - lu(k,1537) * lu(k,2272) + lu(k,2284) = lu(k,2284) - lu(k,1538) * lu(k,2272) + lu(k,2285) = lu(k,2285) - lu(k,1539) * lu(k,2272) lu(k,1691) = 1._r8 / lu(k,1691) lu(k,1692) = lu(k,1692) * lu(k,1691) lu(k,1693) = lu(k,1693) * lu(k,1691) @@ -6937,294 +7200,289 @@ subroutine lu_fac27( avec_len, lu ) lu(k,1698) = lu(k,1698) * lu(k,1691) lu(k,1699) = lu(k,1699) * lu(k,1691) lu(k,1700) = lu(k,1700) * lu(k,1691) - lu(k,1716) = lu(k,1716) - lu(k,1692) * lu(k,1715) - lu(k,1717) = lu(k,1717) - lu(k,1693) * lu(k,1715) - lu(k,1718) = lu(k,1718) - lu(k,1694) * lu(k,1715) - lu(k,1719) = lu(k,1719) - lu(k,1695) * lu(k,1715) - lu(k,1720) = lu(k,1720) - lu(k,1696) * lu(k,1715) - lu(k,1721) = lu(k,1721) - lu(k,1697) * lu(k,1715) - lu(k,1722) = lu(k,1722) - lu(k,1698) * lu(k,1715) - lu(k,1723) = lu(k,1723) - lu(k,1699) * lu(k,1715) - lu(k,1724) = lu(k,1724) - lu(k,1700) * lu(k,1715) - lu(k,1738) = lu(k,1738) - lu(k,1692) * lu(k,1737) - lu(k,1739) = lu(k,1739) - lu(k,1693) * lu(k,1737) - lu(k,1740) = lu(k,1740) - lu(k,1694) * lu(k,1737) - lu(k,1741) = lu(k,1741) - lu(k,1695) * lu(k,1737) - lu(k,1742) = lu(k,1742) - lu(k,1696) * lu(k,1737) - lu(k,1743) = lu(k,1743) - lu(k,1697) * lu(k,1737) - lu(k,1744) = lu(k,1744) - lu(k,1698) * lu(k,1737) - lu(k,1745) = lu(k,1745) - lu(k,1699) * lu(k,1737) - lu(k,1746) = lu(k,1746) - lu(k,1700) * lu(k,1737) - lu(k,1843) = lu(k,1843) - lu(k,1692) * lu(k,1842) - lu(k,1844) = lu(k,1844) - lu(k,1693) * lu(k,1842) - lu(k,1845) = lu(k,1845) - lu(k,1694) * lu(k,1842) - lu(k,1846) = lu(k,1846) - lu(k,1695) * lu(k,1842) - lu(k,1847) = lu(k,1847) - lu(k,1696) * lu(k,1842) - lu(k,1848) = lu(k,1848) - lu(k,1697) * lu(k,1842) - lu(k,1849) = lu(k,1849) - lu(k,1698) * lu(k,1842) - lu(k,1850) = lu(k,1850) - lu(k,1699) * lu(k,1842) - lu(k,1851) = lu(k,1851) - lu(k,1700) * lu(k,1842) - lu(k,1873) = lu(k,1873) - lu(k,1692) * lu(k,1872) - lu(k,1874) = lu(k,1874) - lu(k,1693) * lu(k,1872) - lu(k,1875) = lu(k,1875) - lu(k,1694) * lu(k,1872) - lu(k,1876) = lu(k,1876) - lu(k,1695) * lu(k,1872) - lu(k,1877) = lu(k,1877) - lu(k,1696) * lu(k,1872) - lu(k,1878) = lu(k,1878) - lu(k,1697) * lu(k,1872) - lu(k,1879) = lu(k,1879) - lu(k,1698) * lu(k,1872) - lu(k,1880) = lu(k,1880) - lu(k,1699) * lu(k,1872) - lu(k,1881) = lu(k,1881) - lu(k,1700) * lu(k,1872) - lu(k,1896) = lu(k,1896) - lu(k,1692) * lu(k,1895) - lu(k,1897) = lu(k,1897) - lu(k,1693) * lu(k,1895) - lu(k,1898) = lu(k,1898) - lu(k,1694) * lu(k,1895) - lu(k,1899) = lu(k,1899) - lu(k,1695) * lu(k,1895) - lu(k,1900) = lu(k,1900) - lu(k,1696) * lu(k,1895) - lu(k,1901) = lu(k,1901) - lu(k,1697) * lu(k,1895) - lu(k,1902) = lu(k,1902) - lu(k,1698) * lu(k,1895) - lu(k,1903) = lu(k,1903) - lu(k,1699) * lu(k,1895) - lu(k,1904) = lu(k,1904) - lu(k,1700) * lu(k,1895) - lu(k,1930) = lu(k,1930) - lu(k,1692) * lu(k,1929) - lu(k,1931) = lu(k,1931) - lu(k,1693) * lu(k,1929) - lu(k,1932) = lu(k,1932) - lu(k,1694) * lu(k,1929) - lu(k,1933) = lu(k,1933) - lu(k,1695) * lu(k,1929) - lu(k,1934) = lu(k,1934) - lu(k,1696) * lu(k,1929) - lu(k,1935) = lu(k,1935) - lu(k,1697) * lu(k,1929) - lu(k,1936) = lu(k,1936) - lu(k,1698) * lu(k,1929) - lu(k,1937) = lu(k,1937) - lu(k,1699) * lu(k,1929) - lu(k,1938) = lu(k,1938) - lu(k,1700) * lu(k,1929) - lu(k,1987) = lu(k,1987) - lu(k,1692) * lu(k,1986) - lu(k,1988) = lu(k,1988) - lu(k,1693) * lu(k,1986) - lu(k,1989) = lu(k,1989) - lu(k,1694) * lu(k,1986) - lu(k,1990) = lu(k,1990) - lu(k,1695) * lu(k,1986) - lu(k,1991) = lu(k,1991) - lu(k,1696) * lu(k,1986) - lu(k,1992) = lu(k,1992) - lu(k,1697) * lu(k,1986) - lu(k,1993) = lu(k,1993) - lu(k,1698) * lu(k,1986) - lu(k,1994) = lu(k,1994) - lu(k,1699) * lu(k,1986) - lu(k,1995) = lu(k,1995) - lu(k,1700) * lu(k,1986) - lu(k,2047) = lu(k,2047) - lu(k,1692) * lu(k,2046) - lu(k,2048) = lu(k,2048) - lu(k,1693) * lu(k,2046) - lu(k,2049) = lu(k,2049) - lu(k,1694) * lu(k,2046) - lu(k,2050) = lu(k,2050) - lu(k,1695) * lu(k,2046) - lu(k,2051) = lu(k,2051) - lu(k,1696) * lu(k,2046) - lu(k,2052) = lu(k,2052) - lu(k,1697) * lu(k,2046) - lu(k,2053) = lu(k,2053) - lu(k,1698) * lu(k,2046) - lu(k,2054) = lu(k,2054) - lu(k,1699) * lu(k,2046) - lu(k,2055) = lu(k,2055) - lu(k,1700) * lu(k,2046) - lu(k,2072) = lu(k,2072) - lu(k,1692) * lu(k,2071) - lu(k,2073) = lu(k,2073) - lu(k,1693) * lu(k,2071) - lu(k,2074) = lu(k,2074) - lu(k,1694) * lu(k,2071) - lu(k,2075) = lu(k,2075) - lu(k,1695) * lu(k,2071) - lu(k,2076) = lu(k,2076) - lu(k,1696) * lu(k,2071) - lu(k,2077) = lu(k,2077) - lu(k,1697) * lu(k,2071) - lu(k,2078) = lu(k,2078) - lu(k,1698) * lu(k,2071) - lu(k,2079) = lu(k,2079) - lu(k,1699) * lu(k,2071) - lu(k,2080) = lu(k,2080) - lu(k,1700) * lu(k,2071) - lu(k,1716) = 1._r8 / lu(k,1716) - lu(k,1717) = lu(k,1717) * lu(k,1716) - lu(k,1718) = lu(k,1718) * lu(k,1716) - lu(k,1719) = lu(k,1719) * lu(k,1716) - lu(k,1720) = lu(k,1720) * lu(k,1716) - lu(k,1721) = lu(k,1721) * lu(k,1716) - lu(k,1722) = lu(k,1722) * lu(k,1716) - lu(k,1723) = lu(k,1723) * lu(k,1716) - lu(k,1724) = lu(k,1724) * lu(k,1716) - lu(k,1739) = lu(k,1739) - lu(k,1717) * lu(k,1738) - lu(k,1740) = lu(k,1740) - lu(k,1718) * lu(k,1738) - lu(k,1741) = lu(k,1741) - lu(k,1719) * lu(k,1738) - lu(k,1742) = lu(k,1742) - lu(k,1720) * lu(k,1738) - lu(k,1743) = lu(k,1743) - lu(k,1721) * lu(k,1738) - lu(k,1744) = lu(k,1744) - lu(k,1722) * lu(k,1738) - lu(k,1745) = lu(k,1745) - lu(k,1723) * lu(k,1738) - lu(k,1746) = lu(k,1746) - lu(k,1724) * lu(k,1738) - lu(k,1844) = lu(k,1844) - lu(k,1717) * lu(k,1843) - lu(k,1845) = lu(k,1845) - lu(k,1718) * lu(k,1843) - lu(k,1846) = lu(k,1846) - lu(k,1719) * lu(k,1843) - lu(k,1847) = lu(k,1847) - lu(k,1720) * lu(k,1843) - lu(k,1848) = lu(k,1848) - lu(k,1721) * lu(k,1843) - lu(k,1849) = lu(k,1849) - lu(k,1722) * lu(k,1843) - lu(k,1850) = lu(k,1850) - lu(k,1723) * lu(k,1843) - lu(k,1851) = lu(k,1851) - lu(k,1724) * lu(k,1843) - lu(k,1874) = lu(k,1874) - lu(k,1717) * lu(k,1873) - lu(k,1875) = lu(k,1875) - lu(k,1718) * lu(k,1873) - lu(k,1876) = lu(k,1876) - lu(k,1719) * lu(k,1873) - lu(k,1877) = lu(k,1877) - lu(k,1720) * lu(k,1873) - lu(k,1878) = lu(k,1878) - lu(k,1721) * lu(k,1873) - lu(k,1879) = lu(k,1879) - lu(k,1722) * lu(k,1873) - lu(k,1880) = lu(k,1880) - lu(k,1723) * lu(k,1873) - lu(k,1881) = lu(k,1881) - lu(k,1724) * lu(k,1873) - lu(k,1897) = lu(k,1897) - lu(k,1717) * lu(k,1896) - lu(k,1898) = lu(k,1898) - lu(k,1718) * lu(k,1896) - lu(k,1899) = lu(k,1899) - lu(k,1719) * lu(k,1896) - lu(k,1900) = lu(k,1900) - lu(k,1720) * lu(k,1896) - lu(k,1901) = lu(k,1901) - lu(k,1721) * lu(k,1896) - lu(k,1902) = lu(k,1902) - lu(k,1722) * lu(k,1896) - lu(k,1903) = lu(k,1903) - lu(k,1723) * lu(k,1896) - lu(k,1904) = lu(k,1904) - lu(k,1724) * lu(k,1896) - lu(k,1931) = lu(k,1931) - lu(k,1717) * lu(k,1930) - lu(k,1932) = lu(k,1932) - lu(k,1718) * lu(k,1930) - lu(k,1933) = lu(k,1933) - lu(k,1719) * lu(k,1930) - lu(k,1934) = lu(k,1934) - lu(k,1720) * lu(k,1930) - lu(k,1935) = lu(k,1935) - lu(k,1721) * lu(k,1930) - lu(k,1936) = lu(k,1936) - lu(k,1722) * lu(k,1930) - lu(k,1937) = lu(k,1937) - lu(k,1723) * lu(k,1930) - lu(k,1938) = lu(k,1938) - lu(k,1724) * lu(k,1930) - lu(k,1988) = lu(k,1988) - lu(k,1717) * lu(k,1987) - lu(k,1989) = lu(k,1989) - lu(k,1718) * lu(k,1987) - lu(k,1990) = lu(k,1990) - lu(k,1719) * lu(k,1987) - lu(k,1991) = lu(k,1991) - lu(k,1720) * lu(k,1987) - lu(k,1992) = lu(k,1992) - lu(k,1721) * lu(k,1987) - lu(k,1993) = lu(k,1993) - lu(k,1722) * lu(k,1987) - lu(k,1994) = lu(k,1994) - lu(k,1723) * lu(k,1987) - lu(k,1995) = lu(k,1995) - lu(k,1724) * lu(k,1987) - lu(k,2048) = lu(k,2048) - lu(k,1717) * lu(k,2047) - lu(k,2049) = lu(k,2049) - lu(k,1718) * lu(k,2047) - lu(k,2050) = lu(k,2050) - lu(k,1719) * lu(k,2047) - lu(k,2051) = lu(k,2051) - lu(k,1720) * lu(k,2047) - lu(k,2052) = lu(k,2052) - lu(k,1721) * lu(k,2047) - lu(k,2053) = lu(k,2053) - lu(k,1722) * lu(k,2047) - lu(k,2054) = lu(k,2054) - lu(k,1723) * lu(k,2047) - lu(k,2055) = lu(k,2055) - lu(k,1724) * lu(k,2047) - lu(k,2073) = lu(k,2073) - lu(k,1717) * lu(k,2072) - lu(k,2074) = lu(k,2074) - lu(k,1718) * lu(k,2072) - lu(k,2075) = lu(k,2075) - lu(k,1719) * lu(k,2072) - lu(k,2076) = lu(k,2076) - lu(k,1720) * lu(k,2072) - lu(k,2077) = lu(k,2077) - lu(k,1721) * lu(k,2072) - lu(k,2078) = lu(k,2078) - lu(k,1722) * lu(k,2072) - lu(k,2079) = lu(k,2079) - lu(k,1723) * lu(k,2072) - lu(k,2080) = lu(k,2080) - lu(k,1724) * lu(k,2072) - lu(k,1739) = 1._r8 / lu(k,1739) - lu(k,1740) = lu(k,1740) * lu(k,1739) - lu(k,1741) = lu(k,1741) * lu(k,1739) - lu(k,1742) = lu(k,1742) * lu(k,1739) - lu(k,1743) = lu(k,1743) * lu(k,1739) - lu(k,1744) = lu(k,1744) * lu(k,1739) - lu(k,1745) = lu(k,1745) * lu(k,1739) - lu(k,1746) = lu(k,1746) * lu(k,1739) - lu(k,1845) = lu(k,1845) - lu(k,1740) * lu(k,1844) - lu(k,1846) = lu(k,1846) - lu(k,1741) * lu(k,1844) - lu(k,1847) = lu(k,1847) - lu(k,1742) * lu(k,1844) - lu(k,1848) = lu(k,1848) - lu(k,1743) * lu(k,1844) - lu(k,1849) = lu(k,1849) - lu(k,1744) * lu(k,1844) - lu(k,1850) = lu(k,1850) - lu(k,1745) * lu(k,1844) - lu(k,1851) = lu(k,1851) - lu(k,1746) * lu(k,1844) - lu(k,1875) = lu(k,1875) - lu(k,1740) * lu(k,1874) - lu(k,1876) = lu(k,1876) - lu(k,1741) * lu(k,1874) - lu(k,1877) = lu(k,1877) - lu(k,1742) * lu(k,1874) - lu(k,1878) = lu(k,1878) - lu(k,1743) * lu(k,1874) - lu(k,1879) = lu(k,1879) - lu(k,1744) * lu(k,1874) - lu(k,1880) = lu(k,1880) - lu(k,1745) * lu(k,1874) - lu(k,1881) = lu(k,1881) - lu(k,1746) * lu(k,1874) - lu(k,1898) = lu(k,1898) - lu(k,1740) * lu(k,1897) - lu(k,1899) = lu(k,1899) - lu(k,1741) * lu(k,1897) - lu(k,1900) = lu(k,1900) - lu(k,1742) * lu(k,1897) - lu(k,1901) = lu(k,1901) - lu(k,1743) * lu(k,1897) - lu(k,1902) = lu(k,1902) - lu(k,1744) * lu(k,1897) - lu(k,1903) = lu(k,1903) - lu(k,1745) * lu(k,1897) - lu(k,1904) = lu(k,1904) - lu(k,1746) * lu(k,1897) - lu(k,1932) = lu(k,1932) - lu(k,1740) * lu(k,1931) - lu(k,1933) = lu(k,1933) - lu(k,1741) * lu(k,1931) - lu(k,1934) = lu(k,1934) - lu(k,1742) * lu(k,1931) - lu(k,1935) = lu(k,1935) - lu(k,1743) * lu(k,1931) - lu(k,1936) = lu(k,1936) - lu(k,1744) * lu(k,1931) - lu(k,1937) = lu(k,1937) - lu(k,1745) * lu(k,1931) - lu(k,1938) = lu(k,1938) - lu(k,1746) * lu(k,1931) - lu(k,1989) = lu(k,1989) - lu(k,1740) * lu(k,1988) - lu(k,1990) = lu(k,1990) - lu(k,1741) * lu(k,1988) - lu(k,1991) = lu(k,1991) - lu(k,1742) * lu(k,1988) - lu(k,1992) = lu(k,1992) - lu(k,1743) * lu(k,1988) - lu(k,1993) = lu(k,1993) - lu(k,1744) * lu(k,1988) - lu(k,1994) = lu(k,1994) - lu(k,1745) * lu(k,1988) - lu(k,1995) = lu(k,1995) - lu(k,1746) * lu(k,1988) - lu(k,2049) = lu(k,2049) - lu(k,1740) * lu(k,2048) - lu(k,2050) = lu(k,2050) - lu(k,1741) * lu(k,2048) - lu(k,2051) = lu(k,2051) - lu(k,1742) * lu(k,2048) - lu(k,2052) = lu(k,2052) - lu(k,1743) * lu(k,2048) - lu(k,2053) = lu(k,2053) - lu(k,1744) * lu(k,2048) - lu(k,2054) = lu(k,2054) - lu(k,1745) * lu(k,2048) - lu(k,2055) = lu(k,2055) - lu(k,1746) * lu(k,2048) - lu(k,2074) = lu(k,2074) - lu(k,1740) * lu(k,2073) - lu(k,2075) = lu(k,2075) - lu(k,1741) * lu(k,2073) - lu(k,2076) = lu(k,2076) - lu(k,1742) * lu(k,2073) - lu(k,2077) = lu(k,2077) - lu(k,1743) * lu(k,2073) - lu(k,2078) = lu(k,2078) - lu(k,1744) * lu(k,2073) - lu(k,2079) = lu(k,2079) - lu(k,1745) * lu(k,2073) - lu(k,2080) = lu(k,2080) - lu(k,1746) * lu(k,2073) - lu(k,1845) = 1._r8 / lu(k,1845) - lu(k,1846) = lu(k,1846) * lu(k,1845) - lu(k,1847) = lu(k,1847) * lu(k,1845) - lu(k,1848) = lu(k,1848) * lu(k,1845) - lu(k,1849) = lu(k,1849) * lu(k,1845) - lu(k,1850) = lu(k,1850) * lu(k,1845) - lu(k,1851) = lu(k,1851) * lu(k,1845) - lu(k,1876) = lu(k,1876) - lu(k,1846) * lu(k,1875) - lu(k,1877) = lu(k,1877) - lu(k,1847) * lu(k,1875) - lu(k,1878) = lu(k,1878) - lu(k,1848) * lu(k,1875) - lu(k,1879) = lu(k,1879) - lu(k,1849) * lu(k,1875) - lu(k,1880) = lu(k,1880) - lu(k,1850) * lu(k,1875) - lu(k,1881) = lu(k,1881) - lu(k,1851) * lu(k,1875) - lu(k,1899) = lu(k,1899) - lu(k,1846) * lu(k,1898) - lu(k,1900) = lu(k,1900) - lu(k,1847) * lu(k,1898) - lu(k,1901) = lu(k,1901) - lu(k,1848) * lu(k,1898) - lu(k,1902) = lu(k,1902) - lu(k,1849) * lu(k,1898) - lu(k,1903) = lu(k,1903) - lu(k,1850) * lu(k,1898) - lu(k,1904) = lu(k,1904) - lu(k,1851) * lu(k,1898) - lu(k,1933) = lu(k,1933) - lu(k,1846) * lu(k,1932) - lu(k,1934) = lu(k,1934) - lu(k,1847) * lu(k,1932) - lu(k,1935) = lu(k,1935) - lu(k,1848) * lu(k,1932) - lu(k,1936) = lu(k,1936) - lu(k,1849) * lu(k,1932) - lu(k,1937) = lu(k,1937) - lu(k,1850) * lu(k,1932) - lu(k,1938) = lu(k,1938) - lu(k,1851) * lu(k,1932) - lu(k,1990) = lu(k,1990) - lu(k,1846) * lu(k,1989) - lu(k,1991) = lu(k,1991) - lu(k,1847) * lu(k,1989) - lu(k,1992) = lu(k,1992) - lu(k,1848) * lu(k,1989) - lu(k,1993) = lu(k,1993) - lu(k,1849) * lu(k,1989) - lu(k,1994) = lu(k,1994) - lu(k,1850) * lu(k,1989) - lu(k,1995) = lu(k,1995) - lu(k,1851) * lu(k,1989) - lu(k,2050) = lu(k,2050) - lu(k,1846) * lu(k,2049) - lu(k,2051) = lu(k,2051) - lu(k,1847) * lu(k,2049) - lu(k,2052) = lu(k,2052) - lu(k,1848) * lu(k,2049) - lu(k,2053) = lu(k,2053) - lu(k,1849) * lu(k,2049) - lu(k,2054) = lu(k,2054) - lu(k,1850) * lu(k,2049) - lu(k,2055) = lu(k,2055) - lu(k,1851) * lu(k,2049) - lu(k,2075) = lu(k,2075) - lu(k,1846) * lu(k,2074) - lu(k,2076) = lu(k,2076) - lu(k,1847) * lu(k,2074) - lu(k,2077) = lu(k,2077) - lu(k,1848) * lu(k,2074) - lu(k,2078) = lu(k,2078) - lu(k,1849) * lu(k,2074) - lu(k,2079) = lu(k,2079) - lu(k,1850) * lu(k,2074) - lu(k,2080) = lu(k,2080) - lu(k,1851) * lu(k,2074) - lu(k,1876) = 1._r8 / lu(k,1876) - lu(k,1877) = lu(k,1877) * lu(k,1876) - lu(k,1878) = lu(k,1878) * lu(k,1876) - lu(k,1879) = lu(k,1879) * lu(k,1876) - lu(k,1880) = lu(k,1880) * lu(k,1876) - lu(k,1881) = lu(k,1881) * lu(k,1876) - lu(k,1900) = lu(k,1900) - lu(k,1877) * lu(k,1899) - lu(k,1901) = lu(k,1901) - lu(k,1878) * lu(k,1899) - lu(k,1902) = lu(k,1902) - lu(k,1879) * lu(k,1899) - lu(k,1903) = lu(k,1903) - lu(k,1880) * lu(k,1899) - lu(k,1904) = lu(k,1904) - lu(k,1881) * lu(k,1899) - lu(k,1934) = lu(k,1934) - lu(k,1877) * lu(k,1933) - lu(k,1935) = lu(k,1935) - lu(k,1878) * lu(k,1933) - lu(k,1936) = lu(k,1936) - lu(k,1879) * lu(k,1933) - lu(k,1937) = lu(k,1937) - lu(k,1880) * lu(k,1933) - lu(k,1938) = lu(k,1938) - lu(k,1881) * lu(k,1933) - lu(k,1991) = lu(k,1991) - lu(k,1877) * lu(k,1990) - lu(k,1992) = lu(k,1992) - lu(k,1878) * lu(k,1990) - lu(k,1993) = lu(k,1993) - lu(k,1879) * lu(k,1990) - lu(k,1994) = lu(k,1994) - lu(k,1880) * lu(k,1990) - lu(k,1995) = lu(k,1995) - lu(k,1881) * lu(k,1990) - lu(k,2051) = lu(k,2051) - lu(k,1877) * lu(k,2050) - lu(k,2052) = lu(k,2052) - lu(k,1878) * lu(k,2050) - lu(k,2053) = lu(k,2053) - lu(k,1879) * lu(k,2050) - lu(k,2054) = lu(k,2054) - lu(k,1880) * lu(k,2050) - lu(k,2055) = lu(k,2055) - lu(k,1881) * lu(k,2050) - lu(k,2076) = lu(k,2076) - lu(k,1877) * lu(k,2075) - lu(k,2077) = lu(k,2077) - lu(k,1878) * lu(k,2075) - lu(k,2078) = lu(k,2078) - lu(k,1879) * lu(k,2075) - lu(k,2079) = lu(k,2079) - lu(k,1880) * lu(k,2075) - lu(k,2080) = lu(k,2080) - lu(k,1881) * lu(k,2075) + lu(k,1701) = lu(k,1701) * lu(k,1691) + lu(k,1702) = lu(k,1702) * lu(k,1691) + lu(k,1703) = lu(k,1703) * lu(k,1691) + lu(k,1749) = lu(k,1749) - lu(k,1692) * lu(k,1748) + lu(k,1750) = lu(k,1750) - lu(k,1693) * lu(k,1748) + lu(k,1751) = lu(k,1751) - lu(k,1694) * lu(k,1748) + lu(k,1752) = lu(k,1752) - lu(k,1695) * lu(k,1748) + lu(k,1753) = lu(k,1753) - lu(k,1696) * lu(k,1748) + lu(k,1754) = lu(k,1754) - lu(k,1697) * lu(k,1748) + lu(k,1755) = lu(k,1755) - lu(k,1698) * lu(k,1748) + lu(k,1756) = lu(k,1756) - lu(k,1699) * lu(k,1748) + lu(k,1757) = lu(k,1757) - lu(k,1700) * lu(k,1748) + lu(k,1758) = lu(k,1758) - lu(k,1701) * lu(k,1748) + lu(k,1759) = lu(k,1759) - lu(k,1702) * lu(k,1748) + lu(k,1760) = lu(k,1760) - lu(k,1703) * lu(k,1748) + lu(k,1841) = lu(k,1841) - lu(k,1692) * lu(k,1840) + lu(k,1842) = lu(k,1842) - lu(k,1693) * lu(k,1840) + lu(k,1843) = lu(k,1843) - lu(k,1694) * lu(k,1840) + lu(k,1844) = lu(k,1844) - lu(k,1695) * lu(k,1840) + lu(k,1845) = lu(k,1845) - lu(k,1696) * lu(k,1840) + lu(k,1846) = lu(k,1846) - lu(k,1697) * lu(k,1840) + lu(k,1847) = lu(k,1847) - lu(k,1698) * lu(k,1840) + lu(k,1848) = lu(k,1848) - lu(k,1699) * lu(k,1840) + lu(k,1849) = lu(k,1849) - lu(k,1700) * lu(k,1840) + lu(k,1850) = lu(k,1850) - lu(k,1701) * lu(k,1840) + lu(k,1851) = lu(k,1851) - lu(k,1702) * lu(k,1840) + lu(k,1852) = lu(k,1852) - lu(k,1703) * lu(k,1840) + lu(k,1948) = lu(k,1948) - lu(k,1692) * lu(k,1947) + lu(k,1949) = lu(k,1949) - lu(k,1693) * lu(k,1947) + lu(k,1950) = lu(k,1950) - lu(k,1694) * lu(k,1947) + lu(k,1951) = lu(k,1951) - lu(k,1695) * lu(k,1947) + lu(k,1952) = lu(k,1952) - lu(k,1696) * lu(k,1947) + lu(k,1953) = lu(k,1953) - lu(k,1697) * lu(k,1947) + lu(k,1954) = lu(k,1954) - lu(k,1698) * lu(k,1947) + lu(k,1955) = lu(k,1955) - lu(k,1699) * lu(k,1947) + lu(k,1956) = lu(k,1956) - lu(k,1700) * lu(k,1947) + lu(k,1957) = lu(k,1957) - lu(k,1701) * lu(k,1947) + lu(k,1958) = lu(k,1958) - lu(k,1702) * lu(k,1947) + lu(k,1959) = lu(k,1959) - lu(k,1703) * lu(k,1947) + lu(k,1974) = lu(k,1974) - lu(k,1692) * lu(k,1973) + lu(k,1975) = lu(k,1975) - lu(k,1693) * lu(k,1973) + lu(k,1976) = lu(k,1976) - lu(k,1694) * lu(k,1973) + lu(k,1977) = lu(k,1977) - lu(k,1695) * lu(k,1973) + lu(k,1978) = lu(k,1978) - lu(k,1696) * lu(k,1973) + lu(k,1979) = lu(k,1979) - lu(k,1697) * lu(k,1973) + lu(k,1980) = lu(k,1980) - lu(k,1698) * lu(k,1973) + lu(k,1981) = lu(k,1981) - lu(k,1699) * lu(k,1973) + lu(k,1982) = lu(k,1982) - lu(k,1700) * lu(k,1973) + lu(k,1983) = lu(k,1983) - lu(k,1701) * lu(k,1973) + lu(k,1984) = lu(k,1984) - lu(k,1702) * lu(k,1973) + lu(k,1985) = lu(k,1985) - lu(k,1703) * lu(k,1973) + lu(k,2013) = lu(k,2013) - lu(k,1692) * lu(k,2012) + lu(k,2014) = lu(k,2014) - lu(k,1693) * lu(k,2012) + lu(k,2015) = lu(k,2015) - lu(k,1694) * lu(k,2012) + lu(k,2016) = lu(k,2016) - lu(k,1695) * lu(k,2012) + lu(k,2017) = lu(k,2017) - lu(k,1696) * lu(k,2012) + lu(k,2018) = lu(k,2018) - lu(k,1697) * lu(k,2012) + lu(k,2019) = lu(k,2019) - lu(k,1698) * lu(k,2012) + lu(k,2020) = lu(k,2020) - lu(k,1699) * lu(k,2012) + lu(k,2021) = lu(k,2021) - lu(k,1700) * lu(k,2012) + lu(k,2022) = lu(k,2022) - lu(k,1701) * lu(k,2012) + lu(k,2023) = lu(k,2023) - lu(k,1702) * lu(k,2012) + lu(k,2024) = lu(k,2024) - lu(k,1703) * lu(k,2012) + lu(k,2065) = lu(k,2065) - lu(k,1692) * lu(k,2064) + lu(k,2066) = lu(k,2066) - lu(k,1693) * lu(k,2064) + lu(k,2067) = lu(k,2067) - lu(k,1694) * lu(k,2064) + lu(k,2068) = lu(k,2068) - lu(k,1695) * lu(k,2064) + lu(k,2069) = lu(k,2069) - lu(k,1696) * lu(k,2064) + lu(k,2070) = lu(k,2070) - lu(k,1697) * lu(k,2064) + lu(k,2071) = lu(k,2071) - lu(k,1698) * lu(k,2064) + lu(k,2072) = lu(k,2072) - lu(k,1699) * lu(k,2064) + lu(k,2073) = lu(k,2073) - lu(k,1700) * lu(k,2064) + lu(k,2074) = lu(k,2074) - lu(k,1701) * lu(k,2064) + lu(k,2075) = lu(k,2075) - lu(k,1702) * lu(k,2064) + lu(k,2076) = lu(k,2076) - lu(k,1703) * lu(k,2064) + lu(k,2126) = lu(k,2126) - lu(k,1692) * lu(k,2125) + lu(k,2127) = lu(k,2127) - lu(k,1693) * lu(k,2125) + lu(k,2128) = lu(k,2128) - lu(k,1694) * lu(k,2125) + lu(k,2129) = lu(k,2129) - lu(k,1695) * lu(k,2125) + lu(k,2130) = lu(k,2130) - lu(k,1696) * lu(k,2125) + lu(k,2131) = lu(k,2131) - lu(k,1697) * lu(k,2125) + lu(k,2132) = lu(k,2132) - lu(k,1698) * lu(k,2125) + lu(k,2133) = lu(k,2133) - lu(k,1699) * lu(k,2125) + lu(k,2134) = lu(k,2134) - lu(k,1700) * lu(k,2125) + lu(k,2135) = lu(k,2135) - lu(k,1701) * lu(k,2125) + lu(k,2136) = lu(k,2136) - lu(k,1702) * lu(k,2125) + lu(k,2137) = lu(k,2137) - lu(k,1703) * lu(k,2125) + lu(k,2149) = lu(k,2149) - lu(k,1692) * lu(k,2148) + lu(k,2150) = lu(k,2150) - lu(k,1693) * lu(k,2148) + lu(k,2151) = lu(k,2151) - lu(k,1694) * lu(k,2148) + lu(k,2152) = lu(k,2152) - lu(k,1695) * lu(k,2148) + lu(k,2153) = lu(k,2153) - lu(k,1696) * lu(k,2148) + lu(k,2154) = lu(k,2154) - lu(k,1697) * lu(k,2148) + lu(k,2155) = lu(k,2155) - lu(k,1698) * lu(k,2148) + lu(k,2156) = lu(k,2156) - lu(k,1699) * lu(k,2148) + lu(k,2157) = lu(k,2157) - lu(k,1700) * lu(k,2148) + lu(k,2158) = lu(k,2158) - lu(k,1701) * lu(k,2148) + lu(k,2159) = lu(k,2159) - lu(k,1702) * lu(k,2148) + lu(k,2160) = lu(k,2160) - lu(k,1703) * lu(k,2148) + lu(k,2193) = lu(k,2193) - lu(k,1692) * lu(k,2192) + lu(k,2194) = lu(k,2194) - lu(k,1693) * lu(k,2192) + lu(k,2195) = lu(k,2195) - lu(k,1694) * lu(k,2192) + lu(k,2196) = lu(k,2196) - lu(k,1695) * lu(k,2192) + lu(k,2197) = lu(k,2197) - lu(k,1696) * lu(k,2192) + lu(k,2198) = lu(k,2198) - lu(k,1697) * lu(k,2192) + lu(k,2199) = lu(k,2199) - lu(k,1698) * lu(k,2192) + lu(k,2200) = lu(k,2200) - lu(k,1699) * lu(k,2192) + lu(k,2201) = lu(k,2201) - lu(k,1700) * lu(k,2192) + lu(k,2202) = lu(k,2202) - lu(k,1701) * lu(k,2192) + lu(k,2203) = lu(k,2203) - lu(k,1702) * lu(k,2192) + lu(k,2204) = lu(k,2204) - lu(k,1703) * lu(k,2192) + lu(k,2217) = lu(k,2217) - lu(k,1692) * lu(k,2216) + lu(k,2218) = lu(k,2218) - lu(k,1693) * lu(k,2216) + lu(k,2219) = lu(k,2219) - lu(k,1694) * lu(k,2216) + lu(k,2220) = lu(k,2220) - lu(k,1695) * lu(k,2216) + lu(k,2221) = lu(k,2221) - lu(k,1696) * lu(k,2216) + lu(k,2222) = lu(k,2222) - lu(k,1697) * lu(k,2216) + lu(k,2223) = lu(k,2223) - lu(k,1698) * lu(k,2216) + lu(k,2224) = lu(k,2224) - lu(k,1699) * lu(k,2216) + lu(k,2225) = lu(k,2225) - lu(k,1700) * lu(k,2216) + lu(k,2226) = lu(k,2226) - lu(k,1701) * lu(k,2216) + lu(k,2227) = lu(k,2227) - lu(k,1702) * lu(k,2216) + lu(k,2228) = lu(k,2228) - lu(k,1703) * lu(k,2216) + lu(k,2248) = lu(k,2248) - lu(k,1692) * lu(k,2247) + lu(k,2249) = lu(k,2249) - lu(k,1693) * lu(k,2247) + lu(k,2250) = lu(k,2250) - lu(k,1694) * lu(k,2247) + lu(k,2251) = lu(k,2251) - lu(k,1695) * lu(k,2247) + lu(k,2252) = lu(k,2252) - lu(k,1696) * lu(k,2247) + lu(k,2253) = lu(k,2253) - lu(k,1697) * lu(k,2247) + lu(k,2254) = lu(k,2254) - lu(k,1698) * lu(k,2247) + lu(k,2255) = lu(k,2255) - lu(k,1699) * lu(k,2247) + lu(k,2256) = lu(k,2256) - lu(k,1700) * lu(k,2247) + lu(k,2257) = lu(k,2257) - lu(k,1701) * lu(k,2247) + lu(k,2258) = lu(k,2258) - lu(k,1702) * lu(k,2247) + lu(k,2259) = lu(k,2259) - lu(k,1703) * lu(k,2247) + lu(k,2274) = lu(k,2274) - lu(k,1692) * lu(k,2273) + lu(k,2275) = lu(k,2275) - lu(k,1693) * lu(k,2273) + lu(k,2276) = lu(k,2276) - lu(k,1694) * lu(k,2273) + lu(k,2277) = lu(k,2277) - lu(k,1695) * lu(k,2273) + lu(k,2278) = lu(k,2278) - lu(k,1696) * lu(k,2273) + lu(k,2279) = lu(k,2279) - lu(k,1697) * lu(k,2273) + lu(k,2280) = lu(k,2280) - lu(k,1698) * lu(k,2273) + lu(k,2281) = lu(k,2281) - lu(k,1699) * lu(k,2273) + lu(k,2282) = lu(k,2282) - lu(k,1700) * lu(k,2273) + lu(k,2283) = lu(k,2283) - lu(k,1701) * lu(k,2273) + lu(k,2284) = lu(k,2284) - lu(k,1702) * lu(k,2273) + lu(k,2285) = lu(k,2285) - lu(k,1703) * lu(k,2273) + lu(k,1749) = 1._r8 / lu(k,1749) + lu(k,1750) = lu(k,1750) * lu(k,1749) + lu(k,1751) = lu(k,1751) * lu(k,1749) + lu(k,1752) = lu(k,1752) * lu(k,1749) + lu(k,1753) = lu(k,1753) * lu(k,1749) + lu(k,1754) = lu(k,1754) * lu(k,1749) + lu(k,1755) = lu(k,1755) * lu(k,1749) + lu(k,1756) = lu(k,1756) * lu(k,1749) + lu(k,1757) = lu(k,1757) * lu(k,1749) + lu(k,1758) = lu(k,1758) * lu(k,1749) + lu(k,1759) = lu(k,1759) * lu(k,1749) + lu(k,1760) = lu(k,1760) * lu(k,1749) + lu(k,1842) = lu(k,1842) - lu(k,1750) * lu(k,1841) + lu(k,1843) = lu(k,1843) - lu(k,1751) * lu(k,1841) + lu(k,1844) = lu(k,1844) - lu(k,1752) * lu(k,1841) + lu(k,1845) = lu(k,1845) - lu(k,1753) * lu(k,1841) + lu(k,1846) = lu(k,1846) - lu(k,1754) * lu(k,1841) + lu(k,1847) = lu(k,1847) - lu(k,1755) * lu(k,1841) + lu(k,1848) = lu(k,1848) - lu(k,1756) * lu(k,1841) + lu(k,1849) = lu(k,1849) - lu(k,1757) * lu(k,1841) + lu(k,1850) = lu(k,1850) - lu(k,1758) * lu(k,1841) + lu(k,1851) = lu(k,1851) - lu(k,1759) * lu(k,1841) + lu(k,1852) = lu(k,1852) - lu(k,1760) * lu(k,1841) + lu(k,1949) = lu(k,1949) - lu(k,1750) * lu(k,1948) + lu(k,1950) = lu(k,1950) - lu(k,1751) * lu(k,1948) + lu(k,1951) = lu(k,1951) - lu(k,1752) * lu(k,1948) + lu(k,1952) = lu(k,1952) - lu(k,1753) * lu(k,1948) + lu(k,1953) = lu(k,1953) - lu(k,1754) * lu(k,1948) + lu(k,1954) = lu(k,1954) - lu(k,1755) * lu(k,1948) + lu(k,1955) = lu(k,1955) - lu(k,1756) * lu(k,1948) + lu(k,1956) = lu(k,1956) - lu(k,1757) * lu(k,1948) + lu(k,1957) = lu(k,1957) - lu(k,1758) * lu(k,1948) + lu(k,1958) = lu(k,1958) - lu(k,1759) * lu(k,1948) + lu(k,1959) = lu(k,1959) - lu(k,1760) * lu(k,1948) + lu(k,1975) = lu(k,1975) - lu(k,1750) * lu(k,1974) + lu(k,1976) = lu(k,1976) - lu(k,1751) * lu(k,1974) + lu(k,1977) = lu(k,1977) - lu(k,1752) * lu(k,1974) + lu(k,1978) = lu(k,1978) - lu(k,1753) * lu(k,1974) + lu(k,1979) = lu(k,1979) - lu(k,1754) * lu(k,1974) + lu(k,1980) = lu(k,1980) - lu(k,1755) * lu(k,1974) + lu(k,1981) = lu(k,1981) - lu(k,1756) * lu(k,1974) + lu(k,1982) = lu(k,1982) - lu(k,1757) * lu(k,1974) + lu(k,1983) = lu(k,1983) - lu(k,1758) * lu(k,1974) + lu(k,1984) = lu(k,1984) - lu(k,1759) * lu(k,1974) + lu(k,1985) = lu(k,1985) - lu(k,1760) * lu(k,1974) + lu(k,2014) = lu(k,2014) - lu(k,1750) * lu(k,2013) + lu(k,2015) = lu(k,2015) - lu(k,1751) * lu(k,2013) + lu(k,2016) = lu(k,2016) - lu(k,1752) * lu(k,2013) + lu(k,2017) = lu(k,2017) - lu(k,1753) * lu(k,2013) + lu(k,2018) = lu(k,2018) - lu(k,1754) * lu(k,2013) + lu(k,2019) = lu(k,2019) - lu(k,1755) * lu(k,2013) + lu(k,2020) = lu(k,2020) - lu(k,1756) * lu(k,2013) + lu(k,2021) = lu(k,2021) - lu(k,1757) * lu(k,2013) + lu(k,2022) = lu(k,2022) - lu(k,1758) * lu(k,2013) + lu(k,2023) = lu(k,2023) - lu(k,1759) * lu(k,2013) + lu(k,2024) = lu(k,2024) - lu(k,1760) * lu(k,2013) + lu(k,2066) = lu(k,2066) - lu(k,1750) * lu(k,2065) + lu(k,2067) = lu(k,2067) - lu(k,1751) * lu(k,2065) + lu(k,2068) = lu(k,2068) - lu(k,1752) * lu(k,2065) + lu(k,2069) = lu(k,2069) - lu(k,1753) * lu(k,2065) + lu(k,2070) = lu(k,2070) - lu(k,1754) * lu(k,2065) + lu(k,2071) = lu(k,2071) - lu(k,1755) * lu(k,2065) + lu(k,2072) = lu(k,2072) - lu(k,1756) * lu(k,2065) + lu(k,2073) = lu(k,2073) - lu(k,1757) * lu(k,2065) + lu(k,2074) = lu(k,2074) - lu(k,1758) * lu(k,2065) + lu(k,2075) = lu(k,2075) - lu(k,1759) * lu(k,2065) + lu(k,2076) = lu(k,2076) - lu(k,1760) * lu(k,2065) + lu(k,2127) = lu(k,2127) - lu(k,1750) * lu(k,2126) + lu(k,2128) = lu(k,2128) - lu(k,1751) * lu(k,2126) + lu(k,2129) = lu(k,2129) - lu(k,1752) * lu(k,2126) + lu(k,2130) = lu(k,2130) - lu(k,1753) * lu(k,2126) + lu(k,2131) = lu(k,2131) - lu(k,1754) * lu(k,2126) + lu(k,2132) = lu(k,2132) - lu(k,1755) * lu(k,2126) + lu(k,2133) = lu(k,2133) - lu(k,1756) * lu(k,2126) + lu(k,2134) = lu(k,2134) - lu(k,1757) * lu(k,2126) + lu(k,2135) = lu(k,2135) - lu(k,1758) * lu(k,2126) + lu(k,2136) = lu(k,2136) - lu(k,1759) * lu(k,2126) + lu(k,2137) = lu(k,2137) - lu(k,1760) * lu(k,2126) + lu(k,2150) = lu(k,2150) - lu(k,1750) * lu(k,2149) + lu(k,2151) = lu(k,2151) - lu(k,1751) * lu(k,2149) + lu(k,2152) = lu(k,2152) - lu(k,1752) * lu(k,2149) + lu(k,2153) = lu(k,2153) - lu(k,1753) * lu(k,2149) + lu(k,2154) = lu(k,2154) - lu(k,1754) * lu(k,2149) + lu(k,2155) = lu(k,2155) - lu(k,1755) * lu(k,2149) + lu(k,2156) = lu(k,2156) - lu(k,1756) * lu(k,2149) + lu(k,2157) = lu(k,2157) - lu(k,1757) * lu(k,2149) + lu(k,2158) = lu(k,2158) - lu(k,1758) * lu(k,2149) + lu(k,2159) = lu(k,2159) - lu(k,1759) * lu(k,2149) + lu(k,2160) = lu(k,2160) - lu(k,1760) * lu(k,2149) + lu(k,2194) = lu(k,2194) - lu(k,1750) * lu(k,2193) + lu(k,2195) = lu(k,2195) - lu(k,1751) * lu(k,2193) + lu(k,2196) = lu(k,2196) - lu(k,1752) * lu(k,2193) + lu(k,2197) = lu(k,2197) - lu(k,1753) * lu(k,2193) + lu(k,2198) = lu(k,2198) - lu(k,1754) * lu(k,2193) + lu(k,2199) = lu(k,2199) - lu(k,1755) * lu(k,2193) + lu(k,2200) = lu(k,2200) - lu(k,1756) * lu(k,2193) + lu(k,2201) = lu(k,2201) - lu(k,1757) * lu(k,2193) + lu(k,2202) = lu(k,2202) - lu(k,1758) * lu(k,2193) + lu(k,2203) = lu(k,2203) - lu(k,1759) * lu(k,2193) + lu(k,2204) = lu(k,2204) - lu(k,1760) * lu(k,2193) + lu(k,2218) = lu(k,2218) - lu(k,1750) * lu(k,2217) + lu(k,2219) = lu(k,2219) - lu(k,1751) * lu(k,2217) + lu(k,2220) = lu(k,2220) - lu(k,1752) * lu(k,2217) + lu(k,2221) = lu(k,2221) - lu(k,1753) * lu(k,2217) + lu(k,2222) = lu(k,2222) - lu(k,1754) * lu(k,2217) + lu(k,2223) = lu(k,2223) - lu(k,1755) * lu(k,2217) + lu(k,2224) = lu(k,2224) - lu(k,1756) * lu(k,2217) + lu(k,2225) = lu(k,2225) - lu(k,1757) * lu(k,2217) + lu(k,2226) = lu(k,2226) - lu(k,1758) * lu(k,2217) + lu(k,2227) = lu(k,2227) - lu(k,1759) * lu(k,2217) + lu(k,2228) = lu(k,2228) - lu(k,1760) * lu(k,2217) + lu(k,2249) = lu(k,2249) - lu(k,1750) * lu(k,2248) + lu(k,2250) = lu(k,2250) - lu(k,1751) * lu(k,2248) + lu(k,2251) = lu(k,2251) - lu(k,1752) * lu(k,2248) + lu(k,2252) = lu(k,2252) - lu(k,1753) * lu(k,2248) + lu(k,2253) = lu(k,2253) - lu(k,1754) * lu(k,2248) + lu(k,2254) = lu(k,2254) - lu(k,1755) * lu(k,2248) + lu(k,2255) = lu(k,2255) - lu(k,1756) * lu(k,2248) + lu(k,2256) = lu(k,2256) - lu(k,1757) * lu(k,2248) + lu(k,2257) = lu(k,2257) - lu(k,1758) * lu(k,2248) + lu(k,2258) = lu(k,2258) - lu(k,1759) * lu(k,2248) + lu(k,2259) = lu(k,2259) - lu(k,1760) * lu(k,2248) + lu(k,2275) = lu(k,2275) - lu(k,1750) * lu(k,2274) + lu(k,2276) = lu(k,2276) - lu(k,1751) * lu(k,2274) + lu(k,2277) = lu(k,2277) - lu(k,1752) * lu(k,2274) + lu(k,2278) = lu(k,2278) - lu(k,1753) * lu(k,2274) + lu(k,2279) = lu(k,2279) - lu(k,1754) * lu(k,2274) + lu(k,2280) = lu(k,2280) - lu(k,1755) * lu(k,2274) + lu(k,2281) = lu(k,2281) - lu(k,1756) * lu(k,2274) + lu(k,2282) = lu(k,2282) - lu(k,1757) * lu(k,2274) + lu(k,2283) = lu(k,2283) - lu(k,1758) * lu(k,2274) + lu(k,2284) = lu(k,2284) - lu(k,1759) * lu(k,2274) + lu(k,2285) = lu(k,2285) - lu(k,1760) * lu(k,2274) end do - end subroutine lu_fac27 - subroutine lu_fac28( avec_len, lu ) + end subroutine lu_fac29 + subroutine lu_fac30( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 implicit none @@ -7238,53 +7496,475 @@ subroutine lu_fac28( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1900) = 1._r8 / lu(k,1900) - lu(k,1901) = lu(k,1901) * lu(k,1900) - lu(k,1902) = lu(k,1902) * lu(k,1900) - lu(k,1903) = lu(k,1903) * lu(k,1900) - lu(k,1904) = lu(k,1904) * lu(k,1900) - lu(k,1935) = lu(k,1935) - lu(k,1901) * lu(k,1934) - lu(k,1936) = lu(k,1936) - lu(k,1902) * lu(k,1934) - lu(k,1937) = lu(k,1937) - lu(k,1903) * lu(k,1934) - lu(k,1938) = lu(k,1938) - lu(k,1904) * lu(k,1934) - lu(k,1992) = lu(k,1992) - lu(k,1901) * lu(k,1991) - lu(k,1993) = lu(k,1993) - lu(k,1902) * lu(k,1991) - lu(k,1994) = lu(k,1994) - lu(k,1903) * lu(k,1991) - lu(k,1995) = lu(k,1995) - lu(k,1904) * lu(k,1991) - lu(k,2052) = lu(k,2052) - lu(k,1901) * lu(k,2051) - lu(k,2053) = lu(k,2053) - lu(k,1902) * lu(k,2051) - lu(k,2054) = lu(k,2054) - lu(k,1903) * lu(k,2051) - lu(k,2055) = lu(k,2055) - lu(k,1904) * lu(k,2051) - lu(k,2077) = lu(k,2077) - lu(k,1901) * lu(k,2076) - lu(k,2078) = lu(k,2078) - lu(k,1902) * lu(k,2076) - lu(k,2079) = lu(k,2079) - lu(k,1903) * lu(k,2076) - lu(k,2080) = lu(k,2080) - lu(k,1904) * lu(k,2076) - lu(k,1935) = 1._r8 / lu(k,1935) - lu(k,1936) = lu(k,1936) * lu(k,1935) - lu(k,1937) = lu(k,1937) * lu(k,1935) - lu(k,1938) = lu(k,1938) * lu(k,1935) - lu(k,1993) = lu(k,1993) - lu(k,1936) * lu(k,1992) - lu(k,1994) = lu(k,1994) - lu(k,1937) * lu(k,1992) - lu(k,1995) = lu(k,1995) - lu(k,1938) * lu(k,1992) - lu(k,2053) = lu(k,2053) - lu(k,1936) * lu(k,2052) - lu(k,2054) = lu(k,2054) - lu(k,1937) * lu(k,2052) - lu(k,2055) = lu(k,2055) - lu(k,1938) * lu(k,2052) - lu(k,2078) = lu(k,2078) - lu(k,1936) * lu(k,2077) - lu(k,2079) = lu(k,2079) - lu(k,1937) * lu(k,2077) - lu(k,2080) = lu(k,2080) - lu(k,1938) * lu(k,2077) - lu(k,1993) = 1._r8 / lu(k,1993) - lu(k,1994) = lu(k,1994) * lu(k,1993) - lu(k,1995) = lu(k,1995) * lu(k,1993) - lu(k,2054) = lu(k,2054) - lu(k,1994) * lu(k,2053) - lu(k,2055) = lu(k,2055) - lu(k,1995) * lu(k,2053) - lu(k,2079) = lu(k,2079) - lu(k,1994) * lu(k,2078) - lu(k,2080) = lu(k,2080) - lu(k,1995) * lu(k,2078) - lu(k,2054) = 1._r8 / lu(k,2054) - lu(k,2055) = lu(k,2055) * lu(k,2054) - lu(k,2080) = lu(k,2080) - lu(k,2055) * lu(k,2079) - lu(k,2080) = 1._r8 / lu(k,2080) + lu(k,1842) = 1._r8 / lu(k,1842) + lu(k,1843) = lu(k,1843) * lu(k,1842) + lu(k,1844) = lu(k,1844) * lu(k,1842) + lu(k,1845) = lu(k,1845) * lu(k,1842) + lu(k,1846) = lu(k,1846) * lu(k,1842) + lu(k,1847) = lu(k,1847) * lu(k,1842) + lu(k,1848) = lu(k,1848) * lu(k,1842) + lu(k,1849) = lu(k,1849) * lu(k,1842) + lu(k,1850) = lu(k,1850) * lu(k,1842) + lu(k,1851) = lu(k,1851) * lu(k,1842) + lu(k,1852) = lu(k,1852) * lu(k,1842) + lu(k,1950) = lu(k,1950) - lu(k,1843) * lu(k,1949) + lu(k,1951) = lu(k,1951) - lu(k,1844) * lu(k,1949) + lu(k,1952) = lu(k,1952) - lu(k,1845) * lu(k,1949) + lu(k,1953) = lu(k,1953) - lu(k,1846) * lu(k,1949) + lu(k,1954) = lu(k,1954) - lu(k,1847) * lu(k,1949) + lu(k,1955) = lu(k,1955) - lu(k,1848) * lu(k,1949) + lu(k,1956) = lu(k,1956) - lu(k,1849) * lu(k,1949) + lu(k,1957) = lu(k,1957) - lu(k,1850) * lu(k,1949) + lu(k,1958) = lu(k,1958) - lu(k,1851) * lu(k,1949) + lu(k,1959) = lu(k,1959) - lu(k,1852) * lu(k,1949) + lu(k,1976) = lu(k,1976) - lu(k,1843) * lu(k,1975) + lu(k,1977) = lu(k,1977) - lu(k,1844) * lu(k,1975) + lu(k,1978) = lu(k,1978) - lu(k,1845) * lu(k,1975) + lu(k,1979) = lu(k,1979) - lu(k,1846) * lu(k,1975) + lu(k,1980) = lu(k,1980) - lu(k,1847) * lu(k,1975) + lu(k,1981) = lu(k,1981) - lu(k,1848) * lu(k,1975) + lu(k,1982) = lu(k,1982) - lu(k,1849) * lu(k,1975) + lu(k,1983) = lu(k,1983) - lu(k,1850) * lu(k,1975) + lu(k,1984) = lu(k,1984) - lu(k,1851) * lu(k,1975) + lu(k,1985) = lu(k,1985) - lu(k,1852) * lu(k,1975) + lu(k,2015) = lu(k,2015) - lu(k,1843) * lu(k,2014) + lu(k,2016) = lu(k,2016) - lu(k,1844) * lu(k,2014) + lu(k,2017) = lu(k,2017) - lu(k,1845) * lu(k,2014) + lu(k,2018) = lu(k,2018) - lu(k,1846) * lu(k,2014) + lu(k,2019) = lu(k,2019) - lu(k,1847) * lu(k,2014) + lu(k,2020) = lu(k,2020) - lu(k,1848) * lu(k,2014) + lu(k,2021) = lu(k,2021) - lu(k,1849) * lu(k,2014) + lu(k,2022) = lu(k,2022) - lu(k,1850) * lu(k,2014) + lu(k,2023) = lu(k,2023) - lu(k,1851) * lu(k,2014) + lu(k,2024) = lu(k,2024) - lu(k,1852) * lu(k,2014) + lu(k,2067) = lu(k,2067) - lu(k,1843) * lu(k,2066) + lu(k,2068) = lu(k,2068) - lu(k,1844) * lu(k,2066) + lu(k,2069) = lu(k,2069) - lu(k,1845) * lu(k,2066) + lu(k,2070) = lu(k,2070) - lu(k,1846) * lu(k,2066) + lu(k,2071) = lu(k,2071) - lu(k,1847) * lu(k,2066) + lu(k,2072) = lu(k,2072) - lu(k,1848) * lu(k,2066) + lu(k,2073) = lu(k,2073) - lu(k,1849) * lu(k,2066) + lu(k,2074) = lu(k,2074) - lu(k,1850) * lu(k,2066) + lu(k,2075) = lu(k,2075) - lu(k,1851) * lu(k,2066) + lu(k,2076) = lu(k,2076) - lu(k,1852) * lu(k,2066) + lu(k,2128) = lu(k,2128) - lu(k,1843) * lu(k,2127) + lu(k,2129) = lu(k,2129) - lu(k,1844) * lu(k,2127) + lu(k,2130) = lu(k,2130) - lu(k,1845) * lu(k,2127) + lu(k,2131) = lu(k,2131) - lu(k,1846) * lu(k,2127) + lu(k,2132) = lu(k,2132) - lu(k,1847) * lu(k,2127) + lu(k,2133) = lu(k,2133) - lu(k,1848) * lu(k,2127) + lu(k,2134) = lu(k,2134) - lu(k,1849) * lu(k,2127) + lu(k,2135) = lu(k,2135) - lu(k,1850) * lu(k,2127) + lu(k,2136) = lu(k,2136) - lu(k,1851) * lu(k,2127) + lu(k,2137) = lu(k,2137) - lu(k,1852) * lu(k,2127) + lu(k,2151) = lu(k,2151) - lu(k,1843) * lu(k,2150) + lu(k,2152) = lu(k,2152) - lu(k,1844) * lu(k,2150) + lu(k,2153) = lu(k,2153) - lu(k,1845) * lu(k,2150) + lu(k,2154) = lu(k,2154) - lu(k,1846) * lu(k,2150) + lu(k,2155) = lu(k,2155) - lu(k,1847) * lu(k,2150) + lu(k,2156) = lu(k,2156) - lu(k,1848) * lu(k,2150) + lu(k,2157) = lu(k,2157) - lu(k,1849) * lu(k,2150) + lu(k,2158) = lu(k,2158) - lu(k,1850) * lu(k,2150) + lu(k,2159) = lu(k,2159) - lu(k,1851) * lu(k,2150) + lu(k,2160) = lu(k,2160) - lu(k,1852) * lu(k,2150) + lu(k,2195) = lu(k,2195) - lu(k,1843) * lu(k,2194) + lu(k,2196) = lu(k,2196) - lu(k,1844) * lu(k,2194) + lu(k,2197) = lu(k,2197) - lu(k,1845) * lu(k,2194) + lu(k,2198) = lu(k,2198) - lu(k,1846) * lu(k,2194) + lu(k,2199) = lu(k,2199) - lu(k,1847) * lu(k,2194) + lu(k,2200) = lu(k,2200) - lu(k,1848) * lu(k,2194) + lu(k,2201) = lu(k,2201) - lu(k,1849) * lu(k,2194) + lu(k,2202) = lu(k,2202) - lu(k,1850) * lu(k,2194) + lu(k,2203) = lu(k,2203) - lu(k,1851) * lu(k,2194) + lu(k,2204) = lu(k,2204) - lu(k,1852) * lu(k,2194) + lu(k,2219) = lu(k,2219) - lu(k,1843) * lu(k,2218) + lu(k,2220) = lu(k,2220) - lu(k,1844) * lu(k,2218) + lu(k,2221) = lu(k,2221) - lu(k,1845) * lu(k,2218) + lu(k,2222) = lu(k,2222) - lu(k,1846) * lu(k,2218) + lu(k,2223) = lu(k,2223) - lu(k,1847) * lu(k,2218) + lu(k,2224) = lu(k,2224) - lu(k,1848) * lu(k,2218) + lu(k,2225) = lu(k,2225) - lu(k,1849) * lu(k,2218) + lu(k,2226) = lu(k,2226) - lu(k,1850) * lu(k,2218) + lu(k,2227) = lu(k,2227) - lu(k,1851) * lu(k,2218) + lu(k,2228) = lu(k,2228) - lu(k,1852) * lu(k,2218) + lu(k,2250) = lu(k,2250) - lu(k,1843) * lu(k,2249) + lu(k,2251) = lu(k,2251) - lu(k,1844) * lu(k,2249) + lu(k,2252) = lu(k,2252) - lu(k,1845) * lu(k,2249) + lu(k,2253) = lu(k,2253) - lu(k,1846) * lu(k,2249) + lu(k,2254) = lu(k,2254) - lu(k,1847) * lu(k,2249) + lu(k,2255) = lu(k,2255) - lu(k,1848) * lu(k,2249) + lu(k,2256) = lu(k,2256) - lu(k,1849) * lu(k,2249) + lu(k,2257) = lu(k,2257) - lu(k,1850) * lu(k,2249) + lu(k,2258) = lu(k,2258) - lu(k,1851) * lu(k,2249) + lu(k,2259) = lu(k,2259) - lu(k,1852) * lu(k,2249) + lu(k,2276) = lu(k,2276) - lu(k,1843) * lu(k,2275) + lu(k,2277) = lu(k,2277) - lu(k,1844) * lu(k,2275) + lu(k,2278) = lu(k,2278) - lu(k,1845) * lu(k,2275) + lu(k,2279) = lu(k,2279) - lu(k,1846) * lu(k,2275) + lu(k,2280) = lu(k,2280) - lu(k,1847) * lu(k,2275) + lu(k,2281) = lu(k,2281) - lu(k,1848) * lu(k,2275) + lu(k,2282) = lu(k,2282) - lu(k,1849) * lu(k,2275) + lu(k,2283) = lu(k,2283) - lu(k,1850) * lu(k,2275) + lu(k,2284) = lu(k,2284) - lu(k,1851) * lu(k,2275) + lu(k,2285) = lu(k,2285) - lu(k,1852) * lu(k,2275) + lu(k,1950) = 1._r8 / lu(k,1950) + lu(k,1951) = lu(k,1951) * lu(k,1950) + lu(k,1952) = lu(k,1952) * lu(k,1950) + lu(k,1953) = lu(k,1953) * lu(k,1950) + lu(k,1954) = lu(k,1954) * lu(k,1950) + lu(k,1955) = lu(k,1955) * lu(k,1950) + lu(k,1956) = lu(k,1956) * lu(k,1950) + lu(k,1957) = lu(k,1957) * lu(k,1950) + lu(k,1958) = lu(k,1958) * lu(k,1950) + lu(k,1959) = lu(k,1959) * lu(k,1950) + lu(k,1977) = lu(k,1977) - lu(k,1951) * lu(k,1976) + lu(k,1978) = lu(k,1978) - lu(k,1952) * lu(k,1976) + lu(k,1979) = lu(k,1979) - lu(k,1953) * lu(k,1976) + lu(k,1980) = lu(k,1980) - lu(k,1954) * lu(k,1976) + lu(k,1981) = lu(k,1981) - lu(k,1955) * lu(k,1976) + lu(k,1982) = lu(k,1982) - lu(k,1956) * lu(k,1976) + lu(k,1983) = lu(k,1983) - lu(k,1957) * lu(k,1976) + lu(k,1984) = lu(k,1984) - lu(k,1958) * lu(k,1976) + lu(k,1985) = lu(k,1985) - lu(k,1959) * lu(k,1976) + lu(k,2016) = lu(k,2016) - lu(k,1951) * lu(k,2015) + lu(k,2017) = lu(k,2017) - lu(k,1952) * lu(k,2015) + lu(k,2018) = lu(k,2018) - lu(k,1953) * lu(k,2015) + lu(k,2019) = lu(k,2019) - lu(k,1954) * lu(k,2015) + lu(k,2020) = lu(k,2020) - lu(k,1955) * lu(k,2015) + lu(k,2021) = lu(k,2021) - lu(k,1956) * lu(k,2015) + lu(k,2022) = lu(k,2022) - lu(k,1957) * lu(k,2015) + lu(k,2023) = lu(k,2023) - lu(k,1958) * lu(k,2015) + lu(k,2024) = lu(k,2024) - lu(k,1959) * lu(k,2015) + lu(k,2068) = lu(k,2068) - lu(k,1951) * lu(k,2067) + lu(k,2069) = lu(k,2069) - lu(k,1952) * lu(k,2067) + lu(k,2070) = lu(k,2070) - lu(k,1953) * lu(k,2067) + lu(k,2071) = lu(k,2071) - lu(k,1954) * lu(k,2067) + lu(k,2072) = lu(k,2072) - lu(k,1955) * lu(k,2067) + lu(k,2073) = lu(k,2073) - lu(k,1956) * lu(k,2067) + lu(k,2074) = lu(k,2074) - lu(k,1957) * lu(k,2067) + lu(k,2075) = lu(k,2075) - lu(k,1958) * lu(k,2067) + lu(k,2076) = lu(k,2076) - lu(k,1959) * lu(k,2067) + lu(k,2129) = lu(k,2129) - lu(k,1951) * lu(k,2128) + lu(k,2130) = lu(k,2130) - lu(k,1952) * lu(k,2128) + lu(k,2131) = lu(k,2131) - lu(k,1953) * lu(k,2128) + lu(k,2132) = lu(k,2132) - lu(k,1954) * lu(k,2128) + lu(k,2133) = lu(k,2133) - lu(k,1955) * lu(k,2128) + lu(k,2134) = lu(k,2134) - lu(k,1956) * lu(k,2128) + lu(k,2135) = lu(k,2135) - lu(k,1957) * lu(k,2128) + lu(k,2136) = lu(k,2136) - lu(k,1958) * lu(k,2128) + lu(k,2137) = lu(k,2137) - lu(k,1959) * lu(k,2128) + lu(k,2152) = lu(k,2152) - lu(k,1951) * lu(k,2151) + lu(k,2153) = lu(k,2153) - lu(k,1952) * lu(k,2151) + lu(k,2154) = lu(k,2154) - lu(k,1953) * lu(k,2151) + lu(k,2155) = lu(k,2155) - lu(k,1954) * lu(k,2151) + lu(k,2156) = lu(k,2156) - lu(k,1955) * lu(k,2151) + lu(k,2157) = lu(k,2157) - lu(k,1956) * lu(k,2151) + lu(k,2158) = lu(k,2158) - lu(k,1957) * lu(k,2151) + lu(k,2159) = lu(k,2159) - lu(k,1958) * lu(k,2151) + lu(k,2160) = lu(k,2160) - lu(k,1959) * lu(k,2151) + lu(k,2196) = lu(k,2196) - lu(k,1951) * lu(k,2195) + lu(k,2197) = lu(k,2197) - lu(k,1952) * lu(k,2195) + lu(k,2198) = lu(k,2198) - lu(k,1953) * lu(k,2195) + lu(k,2199) = lu(k,2199) - lu(k,1954) * lu(k,2195) + lu(k,2200) = lu(k,2200) - lu(k,1955) * lu(k,2195) + lu(k,2201) = lu(k,2201) - lu(k,1956) * lu(k,2195) + lu(k,2202) = lu(k,2202) - lu(k,1957) * lu(k,2195) + lu(k,2203) = lu(k,2203) - lu(k,1958) * lu(k,2195) + lu(k,2204) = lu(k,2204) - lu(k,1959) * lu(k,2195) + lu(k,2220) = lu(k,2220) - lu(k,1951) * lu(k,2219) + lu(k,2221) = lu(k,2221) - lu(k,1952) * lu(k,2219) + lu(k,2222) = lu(k,2222) - lu(k,1953) * lu(k,2219) + lu(k,2223) = lu(k,2223) - lu(k,1954) * lu(k,2219) + lu(k,2224) = lu(k,2224) - lu(k,1955) * lu(k,2219) + lu(k,2225) = lu(k,2225) - lu(k,1956) * lu(k,2219) + lu(k,2226) = lu(k,2226) - lu(k,1957) * lu(k,2219) + lu(k,2227) = lu(k,2227) - lu(k,1958) * lu(k,2219) + lu(k,2228) = lu(k,2228) - lu(k,1959) * lu(k,2219) + lu(k,2251) = lu(k,2251) - lu(k,1951) * lu(k,2250) + lu(k,2252) = lu(k,2252) - lu(k,1952) * lu(k,2250) + lu(k,2253) = lu(k,2253) - lu(k,1953) * lu(k,2250) + lu(k,2254) = lu(k,2254) - lu(k,1954) * lu(k,2250) + lu(k,2255) = lu(k,2255) - lu(k,1955) * lu(k,2250) + lu(k,2256) = lu(k,2256) - lu(k,1956) * lu(k,2250) + lu(k,2257) = lu(k,2257) - lu(k,1957) * lu(k,2250) + lu(k,2258) = lu(k,2258) - lu(k,1958) * lu(k,2250) + lu(k,2259) = lu(k,2259) - lu(k,1959) * lu(k,2250) + lu(k,2277) = lu(k,2277) - lu(k,1951) * lu(k,2276) + lu(k,2278) = lu(k,2278) - lu(k,1952) * lu(k,2276) + lu(k,2279) = lu(k,2279) - lu(k,1953) * lu(k,2276) + lu(k,2280) = lu(k,2280) - lu(k,1954) * lu(k,2276) + lu(k,2281) = lu(k,2281) - lu(k,1955) * lu(k,2276) + lu(k,2282) = lu(k,2282) - lu(k,1956) * lu(k,2276) + lu(k,2283) = lu(k,2283) - lu(k,1957) * lu(k,2276) + lu(k,2284) = lu(k,2284) - lu(k,1958) * lu(k,2276) + lu(k,2285) = lu(k,2285) - lu(k,1959) * lu(k,2276) + lu(k,1977) = 1._r8 / lu(k,1977) + lu(k,1978) = lu(k,1978) * lu(k,1977) + lu(k,1979) = lu(k,1979) * lu(k,1977) + lu(k,1980) = lu(k,1980) * lu(k,1977) + lu(k,1981) = lu(k,1981) * lu(k,1977) + lu(k,1982) = lu(k,1982) * lu(k,1977) + lu(k,1983) = lu(k,1983) * lu(k,1977) + lu(k,1984) = lu(k,1984) * lu(k,1977) + lu(k,1985) = lu(k,1985) * lu(k,1977) + lu(k,2017) = lu(k,2017) - lu(k,1978) * lu(k,2016) + lu(k,2018) = lu(k,2018) - lu(k,1979) * lu(k,2016) + lu(k,2019) = lu(k,2019) - lu(k,1980) * lu(k,2016) + lu(k,2020) = lu(k,2020) - lu(k,1981) * lu(k,2016) + lu(k,2021) = lu(k,2021) - lu(k,1982) * lu(k,2016) + lu(k,2022) = lu(k,2022) - lu(k,1983) * lu(k,2016) + lu(k,2023) = lu(k,2023) - lu(k,1984) * lu(k,2016) + lu(k,2024) = lu(k,2024) - lu(k,1985) * lu(k,2016) + lu(k,2069) = lu(k,2069) - lu(k,1978) * lu(k,2068) + lu(k,2070) = lu(k,2070) - lu(k,1979) * lu(k,2068) + lu(k,2071) = lu(k,2071) - lu(k,1980) * lu(k,2068) + lu(k,2072) = lu(k,2072) - lu(k,1981) * lu(k,2068) + lu(k,2073) = lu(k,2073) - lu(k,1982) * lu(k,2068) + lu(k,2074) = lu(k,2074) - lu(k,1983) * lu(k,2068) + lu(k,2075) = lu(k,2075) - lu(k,1984) * lu(k,2068) + lu(k,2076) = lu(k,2076) - lu(k,1985) * lu(k,2068) + lu(k,2130) = lu(k,2130) - lu(k,1978) * lu(k,2129) + lu(k,2131) = lu(k,2131) - lu(k,1979) * lu(k,2129) + lu(k,2132) = lu(k,2132) - lu(k,1980) * lu(k,2129) + lu(k,2133) = lu(k,2133) - lu(k,1981) * lu(k,2129) + lu(k,2134) = lu(k,2134) - lu(k,1982) * lu(k,2129) + lu(k,2135) = lu(k,2135) - lu(k,1983) * lu(k,2129) + lu(k,2136) = lu(k,2136) - lu(k,1984) * lu(k,2129) + lu(k,2137) = lu(k,2137) - lu(k,1985) * lu(k,2129) + lu(k,2153) = lu(k,2153) - lu(k,1978) * lu(k,2152) + lu(k,2154) = lu(k,2154) - lu(k,1979) * lu(k,2152) + lu(k,2155) = lu(k,2155) - lu(k,1980) * lu(k,2152) + lu(k,2156) = lu(k,2156) - lu(k,1981) * lu(k,2152) + lu(k,2157) = lu(k,2157) - lu(k,1982) * lu(k,2152) + lu(k,2158) = lu(k,2158) - lu(k,1983) * lu(k,2152) + lu(k,2159) = lu(k,2159) - lu(k,1984) * lu(k,2152) + lu(k,2160) = lu(k,2160) - lu(k,1985) * lu(k,2152) + lu(k,2197) = lu(k,2197) - lu(k,1978) * lu(k,2196) + lu(k,2198) = lu(k,2198) - lu(k,1979) * lu(k,2196) + lu(k,2199) = lu(k,2199) - lu(k,1980) * lu(k,2196) + lu(k,2200) = lu(k,2200) - lu(k,1981) * lu(k,2196) + lu(k,2201) = lu(k,2201) - lu(k,1982) * lu(k,2196) + lu(k,2202) = lu(k,2202) - lu(k,1983) * lu(k,2196) + lu(k,2203) = lu(k,2203) - lu(k,1984) * lu(k,2196) + lu(k,2204) = lu(k,2204) - lu(k,1985) * lu(k,2196) + lu(k,2221) = lu(k,2221) - lu(k,1978) * lu(k,2220) + lu(k,2222) = lu(k,2222) - lu(k,1979) * lu(k,2220) + lu(k,2223) = lu(k,2223) - lu(k,1980) * lu(k,2220) + lu(k,2224) = lu(k,2224) - lu(k,1981) * lu(k,2220) + lu(k,2225) = lu(k,2225) - lu(k,1982) * lu(k,2220) + lu(k,2226) = lu(k,2226) - lu(k,1983) * lu(k,2220) + lu(k,2227) = lu(k,2227) - lu(k,1984) * lu(k,2220) + lu(k,2228) = lu(k,2228) - lu(k,1985) * lu(k,2220) + lu(k,2252) = lu(k,2252) - lu(k,1978) * lu(k,2251) + lu(k,2253) = lu(k,2253) - lu(k,1979) * lu(k,2251) + lu(k,2254) = lu(k,2254) - lu(k,1980) * lu(k,2251) + lu(k,2255) = lu(k,2255) - lu(k,1981) * lu(k,2251) + lu(k,2256) = lu(k,2256) - lu(k,1982) * lu(k,2251) + lu(k,2257) = lu(k,2257) - lu(k,1983) * lu(k,2251) + lu(k,2258) = lu(k,2258) - lu(k,1984) * lu(k,2251) + lu(k,2259) = lu(k,2259) - lu(k,1985) * lu(k,2251) + lu(k,2278) = lu(k,2278) - lu(k,1978) * lu(k,2277) + lu(k,2279) = lu(k,2279) - lu(k,1979) * lu(k,2277) + lu(k,2280) = lu(k,2280) - lu(k,1980) * lu(k,2277) + lu(k,2281) = lu(k,2281) - lu(k,1981) * lu(k,2277) + lu(k,2282) = lu(k,2282) - lu(k,1982) * lu(k,2277) + lu(k,2283) = lu(k,2283) - lu(k,1983) * lu(k,2277) + lu(k,2284) = lu(k,2284) - lu(k,1984) * lu(k,2277) + lu(k,2285) = lu(k,2285) - lu(k,1985) * lu(k,2277) + lu(k,2017) = 1._r8 / lu(k,2017) + lu(k,2018) = lu(k,2018) * lu(k,2017) + lu(k,2019) = lu(k,2019) * lu(k,2017) + lu(k,2020) = lu(k,2020) * lu(k,2017) + lu(k,2021) = lu(k,2021) * lu(k,2017) + lu(k,2022) = lu(k,2022) * lu(k,2017) + lu(k,2023) = lu(k,2023) * lu(k,2017) + lu(k,2024) = lu(k,2024) * lu(k,2017) + lu(k,2070) = lu(k,2070) - lu(k,2018) * lu(k,2069) + lu(k,2071) = lu(k,2071) - lu(k,2019) * lu(k,2069) + lu(k,2072) = lu(k,2072) - lu(k,2020) * lu(k,2069) + lu(k,2073) = lu(k,2073) - lu(k,2021) * lu(k,2069) + lu(k,2074) = lu(k,2074) - lu(k,2022) * lu(k,2069) + lu(k,2075) = lu(k,2075) - lu(k,2023) * lu(k,2069) + lu(k,2076) = lu(k,2076) - lu(k,2024) * lu(k,2069) + lu(k,2131) = lu(k,2131) - lu(k,2018) * lu(k,2130) + lu(k,2132) = lu(k,2132) - lu(k,2019) * lu(k,2130) + lu(k,2133) = lu(k,2133) - lu(k,2020) * lu(k,2130) + lu(k,2134) = lu(k,2134) - lu(k,2021) * lu(k,2130) + lu(k,2135) = lu(k,2135) - lu(k,2022) * lu(k,2130) + lu(k,2136) = lu(k,2136) - lu(k,2023) * lu(k,2130) + lu(k,2137) = lu(k,2137) - lu(k,2024) * lu(k,2130) + lu(k,2154) = lu(k,2154) - lu(k,2018) * lu(k,2153) + lu(k,2155) = lu(k,2155) - lu(k,2019) * lu(k,2153) + lu(k,2156) = lu(k,2156) - lu(k,2020) * lu(k,2153) + lu(k,2157) = lu(k,2157) - lu(k,2021) * lu(k,2153) + lu(k,2158) = lu(k,2158) - lu(k,2022) * lu(k,2153) + lu(k,2159) = lu(k,2159) - lu(k,2023) * lu(k,2153) + lu(k,2160) = lu(k,2160) - lu(k,2024) * lu(k,2153) + lu(k,2198) = lu(k,2198) - lu(k,2018) * lu(k,2197) + lu(k,2199) = lu(k,2199) - lu(k,2019) * lu(k,2197) + lu(k,2200) = lu(k,2200) - lu(k,2020) * lu(k,2197) + lu(k,2201) = lu(k,2201) - lu(k,2021) * lu(k,2197) + lu(k,2202) = lu(k,2202) - lu(k,2022) * lu(k,2197) + lu(k,2203) = lu(k,2203) - lu(k,2023) * lu(k,2197) + lu(k,2204) = lu(k,2204) - lu(k,2024) * lu(k,2197) + lu(k,2222) = lu(k,2222) - lu(k,2018) * lu(k,2221) + lu(k,2223) = lu(k,2223) - lu(k,2019) * lu(k,2221) + lu(k,2224) = lu(k,2224) - lu(k,2020) * lu(k,2221) + lu(k,2225) = lu(k,2225) - lu(k,2021) * lu(k,2221) + lu(k,2226) = lu(k,2226) - lu(k,2022) * lu(k,2221) + lu(k,2227) = lu(k,2227) - lu(k,2023) * lu(k,2221) + lu(k,2228) = lu(k,2228) - lu(k,2024) * lu(k,2221) + lu(k,2253) = lu(k,2253) - lu(k,2018) * lu(k,2252) + lu(k,2254) = lu(k,2254) - lu(k,2019) * lu(k,2252) + lu(k,2255) = lu(k,2255) - lu(k,2020) * lu(k,2252) + lu(k,2256) = lu(k,2256) - lu(k,2021) * lu(k,2252) + lu(k,2257) = lu(k,2257) - lu(k,2022) * lu(k,2252) + lu(k,2258) = lu(k,2258) - lu(k,2023) * lu(k,2252) + lu(k,2259) = lu(k,2259) - lu(k,2024) * lu(k,2252) + lu(k,2279) = lu(k,2279) - lu(k,2018) * lu(k,2278) + lu(k,2280) = lu(k,2280) - lu(k,2019) * lu(k,2278) + lu(k,2281) = lu(k,2281) - lu(k,2020) * lu(k,2278) + lu(k,2282) = lu(k,2282) - lu(k,2021) * lu(k,2278) + lu(k,2283) = lu(k,2283) - lu(k,2022) * lu(k,2278) + lu(k,2284) = lu(k,2284) - lu(k,2023) * lu(k,2278) + lu(k,2285) = lu(k,2285) - lu(k,2024) * lu(k,2278) + lu(k,2070) = 1._r8 / lu(k,2070) + lu(k,2071) = lu(k,2071) * lu(k,2070) + lu(k,2072) = lu(k,2072) * lu(k,2070) + lu(k,2073) = lu(k,2073) * lu(k,2070) + lu(k,2074) = lu(k,2074) * lu(k,2070) + lu(k,2075) = lu(k,2075) * lu(k,2070) + lu(k,2076) = lu(k,2076) * lu(k,2070) + lu(k,2132) = lu(k,2132) - lu(k,2071) * lu(k,2131) + lu(k,2133) = lu(k,2133) - lu(k,2072) * lu(k,2131) + lu(k,2134) = lu(k,2134) - lu(k,2073) * lu(k,2131) + lu(k,2135) = lu(k,2135) - lu(k,2074) * lu(k,2131) + lu(k,2136) = lu(k,2136) - lu(k,2075) * lu(k,2131) + lu(k,2137) = lu(k,2137) - lu(k,2076) * lu(k,2131) + lu(k,2155) = lu(k,2155) - lu(k,2071) * lu(k,2154) + lu(k,2156) = lu(k,2156) - lu(k,2072) * lu(k,2154) + lu(k,2157) = lu(k,2157) - lu(k,2073) * lu(k,2154) + lu(k,2158) = lu(k,2158) - lu(k,2074) * lu(k,2154) + lu(k,2159) = lu(k,2159) - lu(k,2075) * lu(k,2154) + lu(k,2160) = lu(k,2160) - lu(k,2076) * lu(k,2154) + lu(k,2199) = lu(k,2199) - lu(k,2071) * lu(k,2198) + lu(k,2200) = lu(k,2200) - lu(k,2072) * lu(k,2198) + lu(k,2201) = lu(k,2201) - lu(k,2073) * lu(k,2198) + lu(k,2202) = lu(k,2202) - lu(k,2074) * lu(k,2198) + lu(k,2203) = lu(k,2203) - lu(k,2075) * lu(k,2198) + lu(k,2204) = lu(k,2204) - lu(k,2076) * lu(k,2198) + lu(k,2223) = lu(k,2223) - lu(k,2071) * lu(k,2222) + lu(k,2224) = lu(k,2224) - lu(k,2072) * lu(k,2222) + lu(k,2225) = lu(k,2225) - lu(k,2073) * lu(k,2222) + lu(k,2226) = lu(k,2226) - lu(k,2074) * lu(k,2222) + lu(k,2227) = lu(k,2227) - lu(k,2075) * lu(k,2222) + lu(k,2228) = lu(k,2228) - lu(k,2076) * lu(k,2222) + lu(k,2254) = lu(k,2254) - lu(k,2071) * lu(k,2253) + lu(k,2255) = lu(k,2255) - lu(k,2072) * lu(k,2253) + lu(k,2256) = lu(k,2256) - lu(k,2073) * lu(k,2253) + lu(k,2257) = lu(k,2257) - lu(k,2074) * lu(k,2253) + lu(k,2258) = lu(k,2258) - lu(k,2075) * lu(k,2253) + lu(k,2259) = lu(k,2259) - lu(k,2076) * lu(k,2253) + lu(k,2280) = lu(k,2280) - lu(k,2071) * lu(k,2279) + lu(k,2281) = lu(k,2281) - lu(k,2072) * lu(k,2279) + lu(k,2282) = lu(k,2282) - lu(k,2073) * lu(k,2279) + lu(k,2283) = lu(k,2283) - lu(k,2074) * lu(k,2279) + lu(k,2284) = lu(k,2284) - lu(k,2075) * lu(k,2279) + lu(k,2285) = lu(k,2285) - lu(k,2076) * lu(k,2279) + lu(k,2132) = 1._r8 / lu(k,2132) + lu(k,2133) = lu(k,2133) * lu(k,2132) + lu(k,2134) = lu(k,2134) * lu(k,2132) + lu(k,2135) = lu(k,2135) * lu(k,2132) + lu(k,2136) = lu(k,2136) * lu(k,2132) + lu(k,2137) = lu(k,2137) * lu(k,2132) + lu(k,2156) = lu(k,2156) - lu(k,2133) * lu(k,2155) + lu(k,2157) = lu(k,2157) - lu(k,2134) * lu(k,2155) + lu(k,2158) = lu(k,2158) - lu(k,2135) * lu(k,2155) + lu(k,2159) = lu(k,2159) - lu(k,2136) * lu(k,2155) + lu(k,2160) = lu(k,2160) - lu(k,2137) * lu(k,2155) + lu(k,2200) = lu(k,2200) - lu(k,2133) * lu(k,2199) + lu(k,2201) = lu(k,2201) - lu(k,2134) * lu(k,2199) + lu(k,2202) = lu(k,2202) - lu(k,2135) * lu(k,2199) + lu(k,2203) = lu(k,2203) - lu(k,2136) * lu(k,2199) + lu(k,2204) = lu(k,2204) - lu(k,2137) * lu(k,2199) + lu(k,2224) = lu(k,2224) - lu(k,2133) * lu(k,2223) + lu(k,2225) = lu(k,2225) - lu(k,2134) * lu(k,2223) + lu(k,2226) = lu(k,2226) - lu(k,2135) * lu(k,2223) + lu(k,2227) = lu(k,2227) - lu(k,2136) * lu(k,2223) + lu(k,2228) = lu(k,2228) - lu(k,2137) * lu(k,2223) + lu(k,2255) = lu(k,2255) - lu(k,2133) * lu(k,2254) + lu(k,2256) = lu(k,2256) - lu(k,2134) * lu(k,2254) + lu(k,2257) = lu(k,2257) - lu(k,2135) * lu(k,2254) + lu(k,2258) = lu(k,2258) - lu(k,2136) * lu(k,2254) + lu(k,2259) = lu(k,2259) - lu(k,2137) * lu(k,2254) + lu(k,2281) = lu(k,2281) - lu(k,2133) * lu(k,2280) + lu(k,2282) = lu(k,2282) - lu(k,2134) * lu(k,2280) + lu(k,2283) = lu(k,2283) - lu(k,2135) * lu(k,2280) + lu(k,2284) = lu(k,2284) - lu(k,2136) * lu(k,2280) + lu(k,2285) = lu(k,2285) - lu(k,2137) * lu(k,2280) end do - end subroutine lu_fac28 + end subroutine lu_fac30 + subroutine lu_fac31( 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,2156) = 1._r8 / lu(k,2156) + lu(k,2157) = lu(k,2157) * lu(k,2156) + lu(k,2158) = lu(k,2158) * lu(k,2156) + lu(k,2159) = lu(k,2159) * lu(k,2156) + lu(k,2160) = lu(k,2160) * lu(k,2156) + lu(k,2201) = lu(k,2201) - lu(k,2157) * lu(k,2200) + lu(k,2202) = lu(k,2202) - lu(k,2158) * lu(k,2200) + lu(k,2203) = lu(k,2203) - lu(k,2159) * lu(k,2200) + lu(k,2204) = lu(k,2204) - lu(k,2160) * lu(k,2200) + lu(k,2225) = lu(k,2225) - lu(k,2157) * lu(k,2224) + lu(k,2226) = lu(k,2226) - lu(k,2158) * lu(k,2224) + lu(k,2227) = lu(k,2227) - lu(k,2159) * lu(k,2224) + lu(k,2228) = lu(k,2228) - lu(k,2160) * lu(k,2224) + lu(k,2256) = lu(k,2256) - lu(k,2157) * lu(k,2255) + lu(k,2257) = lu(k,2257) - lu(k,2158) * lu(k,2255) + lu(k,2258) = lu(k,2258) - lu(k,2159) * lu(k,2255) + lu(k,2259) = lu(k,2259) - lu(k,2160) * lu(k,2255) + lu(k,2282) = lu(k,2282) - lu(k,2157) * lu(k,2281) + lu(k,2283) = lu(k,2283) - lu(k,2158) * lu(k,2281) + lu(k,2284) = lu(k,2284) - lu(k,2159) * lu(k,2281) + lu(k,2285) = lu(k,2285) - lu(k,2160) * lu(k,2281) + lu(k,2201) = 1._r8 / lu(k,2201) + lu(k,2202) = lu(k,2202) * lu(k,2201) + lu(k,2203) = lu(k,2203) * lu(k,2201) + lu(k,2204) = lu(k,2204) * lu(k,2201) + lu(k,2226) = lu(k,2226) - lu(k,2202) * lu(k,2225) + lu(k,2227) = lu(k,2227) - lu(k,2203) * lu(k,2225) + lu(k,2228) = lu(k,2228) - lu(k,2204) * lu(k,2225) + lu(k,2257) = lu(k,2257) - lu(k,2202) * lu(k,2256) + lu(k,2258) = lu(k,2258) - lu(k,2203) * lu(k,2256) + lu(k,2259) = lu(k,2259) - lu(k,2204) * lu(k,2256) + lu(k,2283) = lu(k,2283) - lu(k,2202) * lu(k,2282) + lu(k,2284) = lu(k,2284) - lu(k,2203) * lu(k,2282) + lu(k,2285) = lu(k,2285) - lu(k,2204) * lu(k,2282) + lu(k,2226) = 1._r8 / lu(k,2226) + lu(k,2227) = lu(k,2227) * lu(k,2226) + lu(k,2228) = lu(k,2228) * lu(k,2226) + lu(k,2258) = lu(k,2258) - lu(k,2227) * lu(k,2257) + lu(k,2259) = lu(k,2259) - lu(k,2228) * lu(k,2257) + lu(k,2284) = lu(k,2284) - lu(k,2227) * lu(k,2283) + lu(k,2285) = lu(k,2285) - lu(k,2228) * lu(k,2283) + lu(k,2258) = 1._r8 / lu(k,2258) + lu(k,2259) = lu(k,2259) * lu(k,2258) + lu(k,2285) = lu(k,2285) - lu(k,2259) * lu(k,2284) + lu(k,2285) = 1._r8 / lu(k,2285) + end do + end subroutine lu_fac31 subroutine lu_fac( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 @@ -7322,5 +8002,8 @@ subroutine lu_fac( avec_len, lu ) call lu_fac26( avec_len, lu ) call lu_fac27( avec_len, lu ) call lu_fac28( avec_len, lu ) + call lu_fac29( avec_len, lu ) + call lu_fac30( avec_len, lu ) + call lu_fac31( avec_len, lu ) end subroutine lu_fac end module mo_lu_factor diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 index b1de77a1e4..e3810184ef 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_lu_solve.F90 @@ -21,207 +21,210 @@ subroutine lu_slv01( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,186) = b(k,186) - lu(k,85) * b(k,43) - b(k,198) = b(k,198) - lu(k,86) * b(k,43) - b(k,186) = b(k,186) - lu(k,88) * b(k,44) - b(k,192) = b(k,192) - lu(k,89) * b(k,44) - b(k,184) = b(k,184) - lu(k,91) * b(k,45) - b(k,195) = b(k,195) - lu(k,92) * b(k,45) - b(k,140) = b(k,140) - lu(k,94) * b(k,46) - b(k,186) = b(k,186) - lu(k,95) * b(k,46) - b(k,198) = b(k,198) - lu(k,96) * b(k,46) - b(k,73) = b(k,73) - lu(k,98) * b(k,47) - b(k,186) = b(k,186) - lu(k,99) * b(k,47) - b(k,70) = b(k,70) - lu(k,101) * b(k,48) - b(k,198) = b(k,198) - lu(k,102) * b(k,48) - b(k,170) = b(k,170) - lu(k,104) * b(k,49) - b(k,186) = b(k,186) - lu(k,105) * b(k,49) - b(k,111) = b(k,111) - lu(k,107) * b(k,50) - b(k,187) = b(k,187) - lu(k,108) * b(k,50) - b(k,139) = b(k,139) - lu(k,110) * b(k,51) - b(k,185) = b(k,185) - lu(k,111) * b(k,51) - b(k,53) = b(k,53) - lu(k,114) * b(k,52) - b(k,54) = b(k,54) - lu(k,115) * b(k,52) - b(k,107) = b(k,107) - lu(k,116) * b(k,52) - b(k,186) = b(k,186) - lu(k,117) * b(k,52) - b(k,192) = b(k,192) - lu(k,118) * b(k,52) - b(k,103) = b(k,103) - lu(k,120) * b(k,53) - b(k,162) = b(k,162) - lu(k,121) * b(k,53) - b(k,192) = b(k,192) - lu(k,122) * b(k,53) - b(k,102) = b(k,102) - lu(k,124) * b(k,54) - b(k,105) = b(k,105) - lu(k,125) * b(k,54) - b(k,186) = b(k,186) - lu(k,126) * b(k,54) - b(k,192) = b(k,192) - lu(k,127) * b(k,54) - b(k,195) = b(k,195) - lu(k,129) * b(k,55) - b(k,185) = b(k,185) - lu(k,131) * b(k,56) - b(k,186) = b(k,186) - lu(k,132) * b(k,56) - b(k,192) = b(k,192) - lu(k,133) * b(k,56) - b(k,139) = b(k,139) - lu(k,135) * b(k,57) - b(k,185) = b(k,185) - lu(k,136) * b(k,57) - b(k,195) = b(k,195) - lu(k,137) * b(k,57) - b(k,59) = b(k,59) - lu(k,140) * b(k,58) - b(k,60) = b(k,60) - lu(k,141) * b(k,58) - b(k,100) = b(k,100) - lu(k,142) * b(k,58) - b(k,134) = b(k,134) - lu(k,143) * b(k,58) - b(k,186) = b(k,186) - lu(k,144) * b(k,58) - b(k,192) = b(k,192) - lu(k,145) * b(k,58) - b(k,102) = b(k,102) - lu(k,147) * b(k,59) - b(k,105) = b(k,105) - lu(k,148) * b(k,59) - b(k,186) = b(k,186) - lu(k,149) * b(k,59) - b(k,192) = b(k,192) - lu(k,150) * b(k,59) - b(k,162) = b(k,162) - lu(k,152) * b(k,60) - b(k,180) = b(k,180) - lu(k,153) * b(k,60) - b(k,192) = b(k,192) - lu(k,154) * b(k,60) - b(k,170) = b(k,170) - lu(k,156) * b(k,61) - b(k,186) = b(k,186) - lu(k,157) * b(k,61) - b(k,63) = b(k,63) - lu(k,161) * b(k,62) - b(k,100) = b(k,100) - lu(k,162) * b(k,62) - b(k,135) = b(k,135) - lu(k,163) * b(k,62) - b(k,162) = b(k,162) - lu(k,164) * b(k,62) - b(k,180) = b(k,180) - lu(k,165) * b(k,62) - b(k,186) = b(k,186) - lu(k,166) * b(k,62) - b(k,192) = b(k,192) - lu(k,167) * b(k,62) - b(k,105) = b(k,105) - lu(k,169) * b(k,63) - b(k,108) = b(k,108) - lu(k,170) * b(k,63) - b(k,186) = b(k,186) - lu(k,171) * b(k,63) - b(k,192) = b(k,192) - lu(k,172) * b(k,63) - b(k,139) = b(k,139) - lu(k,174) * b(k,64) - b(k,183) = b(k,183) - lu(k,175) * b(k,64) - b(k,120) = b(k,120) - lu(k,177) * b(k,65) - b(k,170) = b(k,170) - lu(k,178) * b(k,65) - b(k,186) = b(k,186) - lu(k,179) * b(k,65) - b(k,192) = b(k,192) - lu(k,180) * b(k,65) - b(k,182) = b(k,182) - lu(k,182) * b(k,66) - b(k,187) = b(k,187) - lu(k,183) * b(k,66) - b(k,153) = b(k,153) - lu(k,185) * b(k,67) - b(k,186) = b(k,186) - lu(k,186) * b(k,67) - b(k,181) = b(k,181) - lu(k,188) * b(k,68) - b(k,195) = b(k,195) - lu(k,189) * b(k,68) - b(k,111) = b(k,111) - lu(k,191) * b(k,69) - b(k,186) = b(k,186) - lu(k,192) * b(k,69) - b(k,148) = b(k,148) - lu(k,195) * b(k,70) - b(k,193) = b(k,193) - lu(k,196) * b(k,70) - b(k,198) = b(k,198) - lu(k,197) * b(k,70) - b(k,168) = b(k,168) - lu(k,199) * b(k,71) - b(k,186) = b(k,186) - lu(k,200) * b(k,71) - b(k,192) = b(k,192) - lu(k,201) * b(k,71) - b(k,105) = b(k,105) - lu(k,203) * b(k,72) - b(k,125) = b(k,125) - lu(k,204) * b(k,72) - b(k,186) = b(k,186) - lu(k,205) * b(k,72) - b(k,159) = b(k,159) - lu(k,207) * b(k,73) - b(k,191) = b(k,191) - lu(k,208) * b(k,73) - b(k,192) = b(k,192) - lu(k,209) * b(k,73) - b(k,148) = b(k,148) - lu(k,211) * b(k,74) - b(k,182) = b(k,182) - lu(k,212) * b(k,74) - b(k,186) = b(k,186) - lu(k,213) * b(k,74) - b(k,192) = b(k,192) - lu(k,214) * b(k,74) - b(k,196) = b(k,196) - lu(k,215) * b(k,74) - b(k,182) = b(k,182) - lu(k,217) * b(k,75) - b(k,187) = b(k,187) - lu(k,218) * b(k,75) - b(k,188) = b(k,188) - lu(k,219) * b(k,75) - b(k,193) = b(k,193) - lu(k,220) * b(k,75) - b(k,196) = b(k,196) - lu(k,221) * b(k,75) - b(k,136) = b(k,136) - lu(k,223) * b(k,76) - b(k,192) = b(k,192) - lu(k,224) * b(k,76) - b(k,142) = b(k,142) - lu(k,226) * b(k,77) - b(k,149) = b(k,149) - lu(k,227) * b(k,77) - b(k,162) = b(k,162) - lu(k,228) * b(k,77) - b(k,186) = b(k,186) - lu(k,229) * b(k,77) - b(k,192) = b(k,192) - lu(k,230) * b(k,77) - b(k,144) = b(k,144) - lu(k,232) * b(k,78) - b(k,186) = b(k,186) - lu(k,233) * b(k,78) - b(k,194) = b(k,194) - lu(k,234) * b(k,78) - b(k,195) = b(k,195) - lu(k,235) * b(k,78) - b(k,198) = b(k,198) - lu(k,236) * b(k,78) - b(k,177) = b(k,177) - lu(k,238) * b(k,79) - b(k,179) = b(k,179) - lu(k,239) * b(k,79) - b(k,186) = b(k,186) - lu(k,240) * b(k,79) - b(k,192) = b(k,192) - lu(k,241) * b(k,79) - b(k,129) = b(k,129) - lu(k,243) * b(k,80) - b(k,168) = b(k,168) - lu(k,244) * b(k,80) - b(k,180) = b(k,180) - lu(k,245) * b(k,80) - b(k,186) = b(k,186) - lu(k,246) * b(k,80) - b(k,162) = b(k,162) - lu(k,248) * b(k,81) - b(k,173) = b(k,173) - lu(k,249) * b(k,81) - b(k,180) = b(k,180) - lu(k,250) * b(k,81) - b(k,192) = b(k,192) - lu(k,251) * b(k,81) - b(k,148) = b(k,148) - lu(k,253) * b(k,82) - b(k,174) = b(k,174) - lu(k,254) * b(k,82) - b(k,184) = b(k,184) - lu(k,255) * b(k,82) - b(k,193) = b(k,193) - lu(k,256) * b(k,82) - b(k,102) = b(k,102) - lu(k,258) * b(k,83) - b(k,149) = b(k,149) - lu(k,259) * b(k,83) - b(k,186) = b(k,186) - lu(k,260) * b(k,83) - b(k,192) = b(k,192) - lu(k,261) * b(k,83) - b(k,100) = b(k,100) - lu(k,264) * b(k,84) - b(k,111) = b(k,111) - lu(k,265) * b(k,84) - b(k,186) = b(k,186) - lu(k,266) * b(k,84) - b(k,192) = b(k,192) - lu(k,267) * b(k,84) - b(k,144) = b(k,144) - lu(k,269) * b(k,85) - b(k,168) = b(k,168) - lu(k,270) * b(k,85) - b(k,186) = b(k,186) - lu(k,271) * b(k,85) - b(k,192) = b(k,192) - lu(k,272) * b(k,85) - b(k,170) = b(k,170) - lu(k,274) * b(k,86) - b(k,186) = b(k,186) - lu(k,275) * b(k,86) - b(k,109) = b(k,109) - lu(k,277) * b(k,87) - b(k,148) = b(k,148) - lu(k,278) * b(k,87) - b(k,162) = b(k,162) - lu(k,279) * b(k,87) - b(k,174) = b(k,174) - lu(k,280) * b(k,87) - b(k,183) = b(k,183) - lu(k,281) * b(k,87) - b(k,186) = b(k,186) - lu(k,282) * b(k,87) - b(k,193) = b(k,193) - lu(k,283) * b(k,87) - b(k,118) = b(k,118) - lu(k,285) * b(k,88) - b(k,154) = b(k,154) - lu(k,286) * b(k,88) - b(k,168) = b(k,168) - lu(k,287) * b(k,88) - b(k,186) = b(k,186) - lu(k,288) * b(k,88) - b(k,187) = b(k,187) - lu(k,289) * b(k,88) - b(k,191) = b(k,191) - lu(k,290) * b(k,88) - b(k,196) = b(k,196) - lu(k,291) * b(k,88) - b(k,183) = b(k,183) - lu(k,293) * b(k,89) - b(k,186) = b(k,186) - lu(k,294) * b(k,89) - b(k,187) = b(k,187) - lu(k,295) * b(k,89) - b(k,188) = b(k,188) - lu(k,296) * b(k,89) - b(k,193) = b(k,193) - lu(k,297) * b(k,89) - b(k,147) = b(k,147) - lu(k,299) * b(k,90) - b(k,159) = b(k,159) - lu(k,300) * b(k,90) - b(k,182) = b(k,182) - lu(k,301) * b(k,90) - b(k,186) = b(k,186) - lu(k,302) * b(k,90) - b(k,192) = b(k,192) - lu(k,303) * b(k,90) - b(k,103) = b(k,103) - lu(k,305) * b(k,91) - b(k,107) = b(k,107) - lu(k,306) * b(k,91) - b(k,149) = b(k,149) - lu(k,307) * b(k,91) - b(k,186) = b(k,186) - lu(k,308) * b(k,91) - b(k,192) = b(k,192) - lu(k,309) * b(k,91) - b(k,149) = b(k,149) - lu(k,311) * b(k,92) - b(k,162) = b(k,162) - lu(k,312) * b(k,92) - b(k,173) = b(k,173) - lu(k,313) * b(k,92) - b(k,180) = b(k,180) - lu(k,314) * b(k,92) - b(k,192) = b(k,192) - lu(k,315) * b(k,92) - b(k,157) = b(k,157) - lu(k,317) * b(k,93) - b(k,166) = b(k,166) - lu(k,318) * b(k,93) - b(k,182) = b(k,182) - lu(k,319) * b(k,93) - b(k,186) = b(k,186) - lu(k,320) * b(k,93) - b(k,187) = b(k,187) - lu(k,321) * b(k,93) - b(k,183) = b(k,183) - lu(k,323) * b(k,94) - b(k,186) = b(k,186) - lu(k,324) * b(k,94) - b(k,189) = b(k,189) - lu(k,325) * b(k,94) - b(k,191) = b(k,191) - lu(k,326) * b(k,94) - b(k,198) = b(k,198) - lu(k,327) * b(k,94) - b(k,130) = b(k,130) - lu(k,329) * b(k,95) - b(k,147) = b(k,147) - lu(k,330) * b(k,95) - b(k,186) = b(k,186) - lu(k,331) * b(k,95) - b(k,187) = b(k,187) - lu(k,332) * b(k,95) - b(k,192) = b(k,192) - lu(k,333) * b(k,95) - b(k,186) = b(k,186) - lu(k,335) * b(k,96) - b(k,187) = b(k,187) - lu(k,336) * b(k,96) - b(k,192) = b(k,192) - lu(k,337) * b(k,96) - b(k,196) = b(k,196) - lu(k,338) * b(k,96) - b(k,198) = b(k,198) - lu(k,339) * b(k,96) - b(k,167) = b(k,167) - lu(k,341) * b(k,97) - b(k,180) = b(k,180) - lu(k,342) * b(k,97) - b(k,186) = b(k,186) - lu(k,343) * b(k,97) - b(k,191) = b(k,191) - lu(k,344) * b(k,97) - b(k,198) = b(k,198) - lu(k,345) * b(k,97) + b(k,219) = b(k,219) - lu(k,94) * b(k,52) + b(k,220) = b(k,220) - lu(k,95) * b(k,52) + b(k,215) = b(k,215) - lu(k,97) * b(k,53) + b(k,227) = b(k,227) - lu(k,98) * b(k,53) + b(k,214) = b(k,214) - lu(k,100) * b(k,54) + b(k,220) = b(k,220) - lu(k,101) * b(k,54) + b(k,215) = b(k,215) - lu(k,103) * b(k,55) + b(k,218) = b(k,218) - lu(k,104) * b(k,55) + b(k,85) = b(k,85) - lu(k,106) * b(k,56) + b(k,209) = b(k,209) - lu(k,107) * b(k,56) + b(k,214) = b(k,214) - lu(k,108) * b(k,56) + b(k,167) = b(k,167) - lu(k,110) * b(k,57) + b(k,215) = b(k,215) - lu(k,111) * b(k,57) + b(k,227) = b(k,227) - lu(k,112) * b(k,57) + b(k,83) = b(k,83) - lu(k,114) * b(k,58) + b(k,214) = b(k,214) - lu(k,115) * b(k,58) + b(k,220) = b(k,220) - lu(k,116) * b(k,58) + b(k,85) = b(k,85) - lu(k,118) * b(k,59) + b(k,214) = b(k,214) - lu(k,119) * b(k,59) + b(k,220) = b(k,220) - lu(k,120) * b(k,59) + b(k,85) = b(k,85) - lu(k,122) * b(k,60) + b(k,214) = b(k,214) - lu(k,123) * b(k,60) + b(k,220) = b(k,220) - lu(k,124) * b(k,60) + b(k,215) = b(k,215) - lu(k,126) * b(k,61) + b(k,220) = b(k,220) - lu(k,127) * b(k,61) + b(k,227) = b(k,227) - lu(k,128) * b(k,61) + b(k,94) = b(k,94) - lu(k,130) * b(k,62) + b(k,215) = b(k,215) - lu(k,131) * b(k,62) + b(k,91) = b(k,91) - lu(k,133) * b(k,63) + b(k,227) = b(k,227) - lu(k,134) * b(k,63) + b(k,197) = b(k,197) - lu(k,136) * b(k,64) + b(k,215) = b(k,215) - lu(k,137) * b(k,64) + b(k,136) = b(k,136) - lu(k,139) * b(k,65) + b(k,224) = b(k,224) - lu(k,140) * b(k,65) + b(k,85) = b(k,85) - lu(k,142) * b(k,66) + b(k,209) = b(k,209) - lu(k,143) * b(k,66) + b(k,214) = b(k,214) - lu(k,144) * b(k,66) + b(k,220) = b(k,220) - lu(k,145) * b(k,66) + b(k,85) = b(k,85) - lu(k,147) * b(k,67) + b(k,175) = b(k,175) - lu(k,148) * b(k,67) + b(k,209) = b(k,209) - lu(k,149) * b(k,67) + b(k,214) = b(k,214) - lu(k,150) * b(k,67) + b(k,83) = b(k,83) - lu(k,152) * b(k,68) + b(k,85) = b(k,85) - lu(k,153) * b(k,68) + b(k,214) = b(k,214) - lu(k,154) * b(k,68) + b(k,220) = b(k,220) - lu(k,155) * b(k,68) + b(k,85) = b(k,85) - lu(k,157) * b(k,69) + b(k,175) = b(k,175) - lu(k,158) * b(k,69) + b(k,214) = b(k,214) - lu(k,159) * b(k,69) + b(k,220) = b(k,220) - lu(k,160) * b(k,69) + b(k,220) = b(k,220) - lu(k,162) * b(k,70) + b(k,72) = b(k,72) - lu(k,165) * b(k,71) + b(k,73) = b(k,73) - lu(k,166) * b(k,71) + b(k,131) = b(k,131) - lu(k,167) * b(k,71) + b(k,215) = b(k,215) - lu(k,168) * b(k,71) + b(k,218) = b(k,218) - lu(k,169) * b(k,71) + b(k,127) = b(k,127) - lu(k,171) * b(k,72) + b(k,192) = b(k,192) - lu(k,172) * b(k,72) + b(k,218) = b(k,218) - lu(k,173) * b(k,72) + b(k,126) = b(k,126) - lu(k,175) * b(k,73) + b(k,128) = b(k,128) - lu(k,176) * b(k,73) + b(k,215) = b(k,215) - lu(k,177) * b(k,73) + b(k,218) = b(k,218) - lu(k,178) * b(k,73) + b(k,214) = b(k,214) - lu(k,180) * b(k,74) + b(k,215) = b(k,215) - lu(k,181) * b(k,74) + b(k,218) = b(k,218) - lu(k,182) * b(k,74) + b(k,214) = b(k,214) - lu(k,184) * b(k,75) + b(k,217) = b(k,217) - lu(k,185) * b(k,75) + b(k,77) = b(k,77) - lu(k,188) * b(k,76) + b(k,78) = b(k,78) - lu(k,189) * b(k,76) + b(k,123) = b(k,123) - lu(k,190) * b(k,76) + b(k,161) = b(k,161) - lu(k,191) * b(k,76) + b(k,215) = b(k,215) - lu(k,192) * b(k,76) + b(k,218) = b(k,218) - lu(k,193) * b(k,76) + b(k,126) = b(k,126) - lu(k,195) * b(k,77) + b(k,128) = b(k,128) - lu(k,196) * b(k,77) + b(k,215) = b(k,215) - lu(k,197) * b(k,77) + b(k,218) = b(k,218) - lu(k,198) * b(k,77) + b(k,192) = b(k,192) - lu(k,200) * b(k,78) + b(k,207) = b(k,207) - lu(k,201) * b(k,78) + b(k,218) = b(k,218) - lu(k,202) * b(k,78) + b(k,197) = b(k,197) - lu(k,204) * b(k,79) + b(k,215) = b(k,215) - lu(k,205) * b(k,79) + b(k,81) = b(k,81) - lu(k,209) * b(k,80) + b(k,123) = b(k,123) - lu(k,210) * b(k,80) + b(k,162) = b(k,162) - lu(k,211) * b(k,80) + b(k,192) = b(k,192) - lu(k,212) * b(k,80) + b(k,207) = b(k,207) - lu(k,213) * b(k,80) + b(k,215) = b(k,215) - lu(k,214) * b(k,80) + b(k,218) = b(k,218) - lu(k,215) * b(k,80) + b(k,128) = b(k,128) - lu(k,217) * b(k,81) + b(k,133) = b(k,133) - lu(k,218) * b(k,81) + b(k,215) = b(k,215) - lu(k,219) * b(k,81) + b(k,218) = b(k,218) - lu(k,220) * b(k,81) + b(k,83) = b(k,83) - lu(k,222) * b(k,82) + b(k,214) = b(k,214) - lu(k,223) * b(k,82) + b(k,215) = b(k,215) - lu(k,224) * b(k,82) + b(k,220) = b(k,220) - lu(k,225) * b(k,82) + b(k,175) = b(k,175) - lu(k,227) * b(k,83) + b(k,214) = b(k,214) - lu(k,228) * b(k,83) + b(k,220) = b(k,220) - lu(k,229) * b(k,83) + b(k,145) = b(k,145) - lu(k,231) * b(k,84) + b(k,197) = b(k,197) - lu(k,232) * b(k,84) + b(k,215) = b(k,215) - lu(k,233) * b(k,84) + b(k,218) = b(k,218) - lu(k,234) * b(k,84) + b(k,175) = b(k,175) - lu(k,236) * b(k,85) + b(k,214) = b(k,214) - lu(k,237) * b(k,85) + b(k,178) = b(k,178) - lu(k,239) * b(k,86) + b(k,215) = b(k,215) - lu(k,240) * b(k,86) + b(k,209) = b(k,209) - lu(k,242) * b(k,87) + b(k,220) = b(k,220) - lu(k,243) * b(k,87) + b(k,211) = b(k,211) - lu(k,245) * b(k,88) + b(k,224) = b(k,224) - lu(k,246) * b(k,88) + b(k,175) = b(k,175) - lu(k,249) * b(k,89) + b(k,214) = b(k,214) - lu(k,250) * b(k,89) + b(k,215) = b(k,215) - lu(k,251) * b(k,89) + b(k,220) = b(k,220) - lu(k,252) * b(k,89) + b(k,136) = b(k,136) - lu(k,254) * b(k,90) + b(k,215) = b(k,215) - lu(k,255) * b(k,90) + b(k,172) = b(k,172) - lu(k,258) * b(k,91) + b(k,226) = b(k,226) - lu(k,259) * b(k,91) + b(k,227) = b(k,227) - lu(k,260) * b(k,91) + b(k,190) = b(k,190) - lu(k,262) * b(k,92) + b(k,215) = b(k,215) - lu(k,263) * b(k,92) + b(k,218) = b(k,218) - lu(k,264) * b(k,92) + b(k,128) = b(k,128) - lu(k,266) * b(k,93) + b(k,150) = b(k,150) - lu(k,267) * b(k,93) + b(k,215) = b(k,215) - lu(k,268) * b(k,93) + b(k,191) = b(k,191) - lu(k,270) * b(k,94) + b(k,213) = b(k,213) - lu(k,271) * b(k,94) + b(k,218) = b(k,218) - lu(k,272) * b(k,94) + b(k,211) = b(k,211) - lu(k,274) * b(k,95) + b(k,216) = b(k,216) - lu(k,275) * b(k,95) + b(k,217) = b(k,217) - lu(k,276) * b(k,95) + b(k,224) = b(k,224) - lu(k,277) * b(k,95) + b(k,226) = b(k,226) - lu(k,278) * b(k,95) + b(k,163) = b(k,163) - lu(k,280) * b(k,96) + b(k,218) = b(k,218) - lu(k,281) * b(k,96) + b(k,175) = b(k,175) - lu(k,283) * b(k,97) + b(k,212) = b(k,212) - lu(k,284) * b(k,97) + b(k,181) = b(k,181) - lu(k,286) * b(k,98) + b(k,184) = b(k,184) - lu(k,287) * b(k,98) + b(k,192) = b(k,192) - lu(k,288) * b(k,98) + b(k,215) = b(k,215) - lu(k,289) * b(k,98) + b(k,218) = b(k,218) - lu(k,290) * b(k,98) + b(k,170) = b(k,170) - lu(k,292) * b(k,99) + b(k,215) = b(k,215) - lu(k,293) * b(k,99) + b(k,220) = b(k,220) - lu(k,294) * b(k,99) + b(k,223) = b(k,223) - lu(k,295) * b(k,99) + b(k,227) = b(k,227) - lu(k,296) * b(k,99) + b(k,172) = b(k,172) - lu(k,298) * b(k,100) + b(k,211) = b(k,211) - lu(k,299) * b(k,100) + b(k,215) = b(k,215) - lu(k,300) * b(k,100) + b(k,216) = b(k,216) - lu(k,301) * b(k,100) + b(k,218) = b(k,218) - lu(k,302) * b(k,100) + b(k,175) = b(k,175) - lu(k,305) * b(k,101) + b(k,214) = b(k,214) - lu(k,306) * b(k,101) + b(k,215) = b(k,215) - lu(k,307) * b(k,101) + b(k,220) = b(k,220) - lu(k,308) * b(k,101) + b(k,227) = b(k,227) - lu(k,309) * b(k,101) + b(k,204) = b(k,204) - lu(k,311) * b(k,102) + b(k,206) = b(k,206) - lu(k,312) * b(k,102) + b(k,215) = b(k,215) - lu(k,313) * b(k,102) + b(k,218) = b(k,218) - lu(k,314) * b(k,102) + b(k,155) = b(k,155) - lu(k,316) * b(k,103) + b(k,190) = b(k,190) - lu(k,317) * b(k,103) + b(k,207) = b(k,207) - lu(k,318) * b(k,103) + b(k,215) = b(k,215) - lu(k,319) * b(k,103) + b(k,197) = b(k,197) - lu(k,321) * b(k,104) + b(k,215) = b(k,215) - lu(k,322) * b(k,104) + b(k,192) = b(k,192) - lu(k,324) * b(k,105) + b(k,200) = b(k,200) - lu(k,325) * b(k,105) + b(k,207) = b(k,207) - lu(k,326) * b(k,105) + b(k,218) = b(k,218) - lu(k,327) * b(k,105) + b(k,172) = b(k,172) - lu(k,329) * b(k,106) + b(k,201) = b(k,201) - lu(k,330) * b(k,106) + b(k,219) = b(k,219) - lu(k,331) * b(k,106) + b(k,226) = b(k,226) - lu(k,332) * b(k,106) + b(k,126) = b(k,126) - lu(k,334) * b(k,107) + b(k,184) = b(k,184) - lu(k,335) * b(k,107) + b(k,215) = b(k,215) - lu(k,336) * b(k,107) + b(k,218) = b(k,218) - lu(k,337) * b(k,107) + b(k,123) = b(k,123) - lu(k,340) * b(k,108) + b(k,136) = b(k,136) - lu(k,341) * b(k,108) + b(k,215) = b(k,215) - lu(k,342) * b(k,108) + b(k,218) = b(k,218) - lu(k,343) * b(k,108) + b(k,170) = b(k,170) - lu(k,345) * b(k,109) + b(k,190) = b(k,190) - lu(k,346) * b(k,109) + b(k,215) = b(k,215) - lu(k,347) * b(k,109) + b(k,218) = b(k,218) - lu(k,348) * b(k,109) + b(k,142) = b(k,142) - lu(k,350) * b(k,110) + b(k,180) = b(k,180) - lu(k,351) * b(k,110) + b(k,190) = b(k,190) - lu(k,352) * b(k,110) + b(k,213) = b(k,213) - lu(k,353) * b(k,110) + b(k,215) = b(k,215) - lu(k,354) * b(k,110) + b(k,216) = b(k,216) - lu(k,355) * b(k,110) + b(k,224) = b(k,224) - lu(k,356) * b(k,110) + b(k,135) = b(k,135) - lu(k,358) * b(k,111) + b(k,172) = b(k,172) - lu(k,359) * b(k,111) + b(k,192) = b(k,192) - lu(k,360) * b(k,111) + b(k,201) = b(k,201) - lu(k,361) * b(k,111) + b(k,212) = b(k,212) - lu(k,362) * b(k,111) + b(k,215) = b(k,215) - lu(k,363) * b(k,111) + b(k,226) = b(k,226) - lu(k,364) * b(k,111) end do end subroutine lu_slv01 subroutine lu_slv02( avec_len, lu, b ) @@ -242,208 +245,207 @@ subroutine lu_slv02( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,140) = b(k,140) - lu(k,347) * b(k,98) - b(k,154) = b(k,154) - lu(k,348) * b(k,98) - b(k,186) = b(k,186) - lu(k,349) * b(k,98) - b(k,192) = b(k,192) - lu(k,350) * b(k,98) - b(k,198) = b(k,198) - lu(k,351) * b(k,98) - b(k,108) = b(k,108) - lu(k,353) * b(k,99) - b(k,149) = b(k,149) - lu(k,354) * b(k,99) - b(k,173) = b(k,173) - lu(k,355) * b(k,99) - b(k,186) = b(k,186) - lu(k,356) * b(k,99) - b(k,192) = b(k,192) - lu(k,357) * b(k,99) - b(k,111) = b(k,111) - lu(k,361) * b(k,100) - b(k,186) = b(k,186) - lu(k,362) * b(k,100) - b(k,187) = b(k,187) - lu(k,363) * b(k,100) - b(k,188) = b(k,188) - lu(k,364) * b(k,100) - b(k,192) = b(k,192) - lu(k,365) * b(k,100) - b(k,142) = b(k,142) - lu(k,367) * b(k,101) - b(k,187) = b(k,187) - lu(k,368) * b(k,101) - b(k,188) = b(k,188) - lu(k,369) * b(k,101) - b(k,191) = b(k,191) - lu(k,370) * b(k,101) - b(k,192) = b(k,192) - lu(k,371) * b(k,101) - b(k,149) = b(k,149) - lu(k,374) * b(k,102) - b(k,186) = b(k,186) - lu(k,375) * b(k,102) - b(k,187) = b(k,187) - lu(k,376) * b(k,102) - b(k,188) = b(k,188) - lu(k,377) * b(k,102) - b(k,192) = b(k,192) - lu(k,378) * b(k,102) - b(k,133) = b(k,133) - lu(k,380) * b(k,103) - b(k,192) = b(k,192) - lu(k,381) * b(k,103) - b(k,180) = b(k,180) - lu(k,383) * b(k,104) - b(k,186) = b(k,186) - lu(k,384) * b(k,104) - b(k,187) = b(k,187) - lu(k,385) * b(k,104) - b(k,189) = b(k,189) - lu(k,386) * b(k,104) - b(k,191) = b(k,191) - lu(k,387) * b(k,104) - b(k,196) = b(k,196) - lu(k,388) * b(k,104) - b(k,125) = b(k,125) - lu(k,390) * b(k,105) - b(k,187) = b(k,187) - lu(k,391) * b(k,105) - b(k,197) = b(k,197) - lu(k,392) * b(k,105) - b(k,154) = b(k,154) - lu(k,394) * b(k,106) - b(k,157) = b(k,157) - lu(k,395) * b(k,106) - b(k,164) = b(k,164) - lu(k,396) * b(k,106) - b(k,186) = b(k,186) - lu(k,397) * b(k,106) - b(k,191) = b(k,191) - lu(k,398) * b(k,106) - b(k,192) = b(k,192) - lu(k,399) * b(k,106) - b(k,133) = b(k,133) - lu(k,403) * b(k,107) - b(k,149) = b(k,149) - lu(k,404) * b(k,107) - b(k,186) = b(k,186) - lu(k,405) * b(k,107) - b(k,187) = b(k,187) - lu(k,406) * b(k,107) - b(k,188) = b(k,188) - lu(k,407) * b(k,107) - b(k,192) = b(k,192) - lu(k,408) * b(k,107) - b(k,149) = b(k,149) - lu(k,411) * b(k,108) - b(k,173) = b(k,173) - lu(k,412) * b(k,108) - b(k,186) = b(k,186) - lu(k,413) * b(k,108) - b(k,187) = b(k,187) - lu(k,414) * b(k,108) - b(k,188) = b(k,188) - lu(k,415) * b(k,108) - b(k,192) = b(k,192) - lu(k,416) * b(k,108) - b(k,174) = b(k,174) - lu(k,418) * b(k,109) - b(k,183) = b(k,183) - lu(k,419) * b(k,109) - b(k,186) = b(k,186) - lu(k,420) * b(k,109) - b(k,193) = b(k,193) - lu(k,421) * b(k,109) - b(k,197) = b(k,197) - lu(k,422) * b(k,109) - b(k,129) = b(k,129) - lu(k,424) * b(k,110) - b(k,144) = b(k,144) - lu(k,425) * b(k,110) - b(k,180) = b(k,180) - lu(k,426) * b(k,110) - b(k,186) = b(k,186) - lu(k,427) * b(k,110) - b(k,125) = b(k,125) - lu(k,430) * b(k,111) - b(k,186) = b(k,186) - lu(k,431) * b(k,111) - b(k,187) = b(k,187) - lu(k,432) * b(k,111) - b(k,188) = b(k,188) - lu(k,433) * b(k,111) - b(k,192) = b(k,192) - lu(k,434) * b(k,111) - b(k,180) = b(k,180) - lu(k,436) * b(k,112) - b(k,186) = b(k,186) - lu(k,437) * b(k,112) - b(k,189) = b(k,189) - lu(k,438) * b(k,112) - b(k,191) = b(k,191) - lu(k,439) * b(k,112) - b(k,198) = b(k,198) - lu(k,440) * b(k,112) - b(k,137) = b(k,137) - lu(k,442) * b(k,113) - b(k,163) = b(k,163) - lu(k,443) * b(k,113) - b(k,168) = b(k,168) - lu(k,444) * b(k,113) - b(k,186) = b(k,186) - lu(k,445) * b(k,113) - b(k,191) = b(k,191) - lu(k,446) * b(k,113) - b(k,192) = b(k,192) - lu(k,447) * b(k,113) - b(k,198) = b(k,198) - lu(k,448) * b(k,113) - b(k,138) = b(k,138) - lu(k,450) * b(k,114) - b(k,181) = b(k,181) - lu(k,451) * b(k,114) - b(k,182) = b(k,182) - lu(k,452) * b(k,114) - b(k,187) = b(k,187) - lu(k,453) * b(k,114) - b(k,190) = b(k,190) - lu(k,454) * b(k,114) - b(k,193) = b(k,193) - lu(k,455) * b(k,114) - b(k,196) = b(k,196) - lu(k,456) * b(k,114) - b(k,147) = b(k,147) - lu(k,458) * b(k,115) - b(k,159) = b(k,159) - lu(k,459) * b(k,115) - b(k,160) = b(k,160) - lu(k,460) * b(k,115) - b(k,163) = b(k,163) - lu(k,461) * b(k,115) - b(k,182) = b(k,182) - lu(k,462) * b(k,115) - b(k,186) = b(k,186) - lu(k,463) * b(k,115) - b(k,192) = b(k,192) - lu(k,464) * b(k,115) - b(k,132) = b(k,132) - lu(k,466) * b(k,116) - b(k,142) = b(k,142) - lu(k,467) * b(k,116) - b(k,162) = b(k,162) - lu(k,468) * b(k,116) - b(k,186) = b(k,186) - lu(k,469) * b(k,116) - b(k,191) = b(k,191) - lu(k,470) * b(k,116) - b(k,192) = b(k,192) - lu(k,471) * b(k,116) - b(k,197) = b(k,197) - lu(k,472) * b(k,116) - b(k,186) = b(k,186) - lu(k,474) * b(k,117) - b(k,189) = b(k,189) - lu(k,475) * b(k,117) - b(k,198) = b(k,198) - lu(k,476) * b(k,117) - b(k,154) = b(k,154) - lu(k,478) * b(k,118) - b(k,160) = b(k,160) - lu(k,479) * b(k,118) - b(k,168) = b(k,168) - lu(k,480) * b(k,118) - b(k,187) = b(k,187) - lu(k,481) * b(k,118) - b(k,188) = b(k,188) - lu(k,482) * b(k,118) - b(k,191) = b(k,191) - lu(k,483) * b(k,118) - b(k,192) = b(k,192) - lu(k,484) * b(k,118) - b(k,163) = b(k,163) - lu(k,486) * b(k,119) - b(k,179) = b(k,179) - lu(k,487) * b(k,119) - b(k,186) = b(k,186) - lu(k,488) * b(k,119) - b(k,187) = b(k,187) - lu(k,489) * b(k,119) - b(k,191) = b(k,191) - lu(k,490) * b(k,119) - b(k,192) = b(k,192) - lu(k,491) * b(k,119) - b(k,196) = b(k,196) - lu(k,492) * b(k,119) - b(k,150) = b(k,150) - lu(k,494) * b(k,120) - b(k,162) = b(k,162) - lu(k,495) * b(k,120) - b(k,192) = b(k,192) - lu(k,496) * b(k,120) - b(k,186) = b(k,186) - lu(k,498) * b(k,121) - b(k,192) = b(k,192) - lu(k,499) * b(k,121) - b(k,193) = b(k,193) - lu(k,500) * b(k,121) - b(k,194) = b(k,194) - lu(k,501) * b(k,121) - b(k,195) = b(k,195) - lu(k,502) * b(k,121) - b(k,198) = b(k,198) - lu(k,503) * b(k,121) - b(k,154) = b(k,154) - lu(k,505) * b(k,122) - b(k,159) = b(k,159) - lu(k,506) * b(k,122) - b(k,161) = b(k,161) - lu(k,507) * b(k,122) - b(k,162) = b(k,162) - lu(k,508) * b(k,122) - b(k,165) = b(k,165) - lu(k,509) * b(k,122) - b(k,186) = b(k,186) - lu(k,510) * b(k,122) - b(k,191) = b(k,191) - lu(k,511) * b(k,122) - b(k,192) = b(k,192) - lu(k,512) * b(k,122) - b(k,159) = b(k,159) - lu(k,514) * b(k,123) - b(k,160) = b(k,160) - lu(k,515) * b(k,123) - b(k,163) = b(k,163) - lu(k,516) * b(k,123) - b(k,182) = b(k,182) - lu(k,517) * b(k,123) - b(k,186) = b(k,186) - lu(k,518) * b(k,123) - b(k,187) = b(k,187) - lu(k,519) * b(k,123) - b(k,191) = b(k,191) - lu(k,520) * b(k,123) - b(k,192) = b(k,192) - lu(k,521) * b(k,123) - b(k,157) = b(k,157) - lu(k,523) * b(k,124) - b(k,182) = b(k,182) - lu(k,524) * b(k,124) - b(k,186) = b(k,186) - lu(k,525) * b(k,124) - b(k,187) = b(k,187) - lu(k,526) * b(k,124) - b(k,192) = b(k,192) - lu(k,527) * b(k,124) - b(k,186) = b(k,186) - lu(k,531) * b(k,125) - b(k,187) = b(k,187) - lu(k,532) * b(k,125) - b(k,188) = b(k,188) - lu(k,533) * b(k,125) - b(k,192) = b(k,192) - lu(k,534) * b(k,125) - b(k,197) = b(k,197) - lu(k,535) * b(k,125) - b(k,129) = b(k,129) - lu(k,538) * b(k,126) - b(k,144) = b(k,144) - lu(k,539) * b(k,126) - b(k,153) = b(k,153) - lu(k,540) * b(k,126) - b(k,154) = b(k,154) - lu(k,541) * b(k,126) - b(k,168) = b(k,168) - lu(k,542) * b(k,126) - b(k,180) = b(k,180) - lu(k,543) * b(k,126) - b(k,186) = b(k,186) - lu(k,544) * b(k,126) - b(k,191) = b(k,191) - lu(k,545) * b(k,126) - b(k,192) = b(k,192) - lu(k,546) * b(k,126) - b(k,133) = b(k,133) - lu(k,551) * b(k,127) - b(k,134) = b(k,134) - lu(k,552) * b(k,127) - b(k,136) = b(k,136) - lu(k,553) * b(k,127) - b(k,149) = b(k,149) - lu(k,554) * b(k,127) - b(k,150) = b(k,150) - lu(k,555) * b(k,127) - b(k,162) = b(k,162) - lu(k,556) * b(k,127) - b(k,173) = b(k,173) - lu(k,557) * b(k,127) - b(k,186) = b(k,186) - lu(k,558) * b(k,127) - b(k,192) = b(k,192) - lu(k,559) * b(k,127) - b(k,129) = b(k,129) - lu(k,562) * b(k,128) - b(k,144) = b(k,144) - lu(k,563) * b(k,128) - b(k,154) = b(k,154) - lu(k,564) * b(k,128) - b(k,168) = b(k,168) - lu(k,565) * b(k,128) - b(k,180) = b(k,180) - lu(k,566) * b(k,128) - b(k,186) = b(k,186) - lu(k,567) * b(k,128) - b(k,187) = b(k,187) - lu(k,568) * b(k,128) - b(k,191) = b(k,191) - lu(k,569) * b(k,128) - b(k,192) = b(k,192) - lu(k,570) * b(k,128) - b(k,168) = b(k,168) - lu(k,573) * b(k,129) - b(k,180) = b(k,180) - lu(k,574) * b(k,129) - b(k,186) = b(k,186) - lu(k,575) * b(k,129) - b(k,187) = b(k,187) - lu(k,576) * b(k,129) - b(k,188) = b(k,188) - lu(k,577) * b(k,129) - b(k,192) = b(k,192) - lu(k,578) * b(k,129) - b(k,170) = b(k,170) - lu(k,581) * b(k,130) - b(k,172) = b(k,172) - lu(k,582) * b(k,130) - b(k,176) = b(k,176) - lu(k,583) * b(k,130) - b(k,186) = b(k,186) - lu(k,584) * b(k,130) - b(k,191) = b(k,191) - lu(k,585) * b(k,130) - b(k,192) = b(k,192) - lu(k,586) * b(k,130) - b(k,133) = b(k,133) - lu(k,592) * b(k,131) - b(k,135) = b(k,135) - lu(k,593) * b(k,131) - b(k,136) = b(k,136) - lu(k,594) * b(k,131) - b(k,149) = b(k,149) - lu(k,595) * b(k,131) - b(k,150) = b(k,150) - lu(k,596) * b(k,131) - b(k,162) = b(k,162) - lu(k,597) * b(k,131) - b(k,173) = b(k,173) - lu(k,598) * b(k,131) - b(k,180) = b(k,180) - lu(k,599) * b(k,131) - b(k,186) = b(k,186) - lu(k,600) * b(k,131) - b(k,192) = b(k,192) - lu(k,601) * b(k,131) + b(k,192) = b(k,192) - lu(k,366) * b(k,112) + b(k,215) = b(k,215) - lu(k,367) * b(k,112) + b(k,218) = b(k,218) - lu(k,368) * b(k,112) + b(k,220) = b(k,220) - lu(k,369) * b(k,112) + b(k,221) = b(k,221) - lu(k,370) * b(k,112) + b(k,223) = b(k,223) - lu(k,371) * b(k,112) + b(k,227) = b(k,227) - lu(k,372) * b(k,112) + b(k,174) = b(k,174) - lu(k,374) * b(k,113) + b(k,191) = b(k,191) - lu(k,375) * b(k,113) + b(k,211) = b(k,211) - lu(k,376) * b(k,113) + b(k,215) = b(k,215) - lu(k,377) * b(k,113) + b(k,218) = b(k,218) - lu(k,378) * b(k,113) + b(k,184) = b(k,184) - lu(k,380) * b(k,114) + b(k,192) = b(k,192) - lu(k,381) * b(k,114) + b(k,200) = b(k,200) - lu(k,382) * b(k,114) + b(k,207) = b(k,207) - lu(k,383) * b(k,114) + b(k,218) = b(k,218) - lu(k,384) * b(k,114) + b(k,212) = b(k,212) - lu(k,386) * b(k,115) + b(k,213) = b(k,213) - lu(k,387) * b(k,115) + b(k,215) = b(k,215) - lu(k,388) * b(k,115) + b(k,221) = b(k,221) - lu(k,389) * b(k,115) + b(k,227) = b(k,227) - lu(k,390) * b(k,115) + b(k,183) = b(k,183) - lu(k,392) * b(k,116) + b(k,187) = b(k,187) - lu(k,393) * b(k,116) + b(k,211) = b(k,211) - lu(k,394) * b(k,116) + b(k,215) = b(k,215) - lu(k,395) * b(k,116) + b(k,224) = b(k,224) - lu(k,396) * b(k,116) + b(k,157) = b(k,157) - lu(k,398) * b(k,117) + b(k,174) = b(k,174) - lu(k,399) * b(k,117) + b(k,215) = b(k,215) - lu(k,400) * b(k,117) + b(k,218) = b(k,218) - lu(k,401) * b(k,117) + b(k,224) = b(k,224) - lu(k,402) * b(k,117) + b(k,215) = b(k,215) - lu(k,404) * b(k,118) + b(k,216) = b(k,216) - lu(k,405) * b(k,118) + b(k,218) = b(k,218) - lu(k,406) * b(k,118) + b(k,224) = b(k,224) - lu(k,407) * b(k,118) + b(k,227) = b(k,227) - lu(k,408) * b(k,118) + b(k,194) = b(k,194) - lu(k,410) * b(k,119) + b(k,207) = b(k,207) - lu(k,411) * b(k,119) + b(k,213) = b(k,213) - lu(k,412) * b(k,119) + b(k,215) = b(k,215) - lu(k,413) * b(k,119) + b(k,227) = b(k,227) - lu(k,414) * b(k,119) + b(k,167) = b(k,167) - lu(k,416) * b(k,120) + b(k,180) = b(k,180) - lu(k,417) * b(k,120) + b(k,215) = b(k,215) - lu(k,418) * b(k,120) + b(k,218) = b(k,218) - lu(k,419) * b(k,120) + b(k,227) = b(k,227) - lu(k,420) * b(k,120) + b(k,127) = b(k,127) - lu(k,422) * b(k,121) + b(k,131) = b(k,131) - lu(k,423) * b(k,121) + b(k,184) = b(k,184) - lu(k,424) * b(k,121) + b(k,215) = b(k,215) - lu(k,425) * b(k,121) + b(k,218) = b(k,218) - lu(k,426) * b(k,121) + b(k,133) = b(k,133) - lu(k,428) * b(k,122) + b(k,184) = b(k,184) - lu(k,429) * b(k,122) + b(k,200) = b(k,200) - lu(k,430) * b(k,122) + b(k,215) = b(k,215) - lu(k,431) * b(k,122) + b(k,218) = b(k,218) - lu(k,432) * b(k,122) + b(k,136) = b(k,136) - lu(k,436) * b(k,123) + b(k,215) = b(k,215) - lu(k,437) * b(k,123) + b(k,217) = b(k,217) - lu(k,438) * b(k,123) + b(k,218) = b(k,218) - lu(k,439) * b(k,123) + b(k,224) = b(k,224) - lu(k,440) * b(k,123) + b(k,181) = b(k,181) - lu(k,442) * b(k,124) + b(k,213) = b(k,213) - lu(k,443) * b(k,124) + b(k,217) = b(k,217) - lu(k,444) * b(k,124) + b(k,218) = b(k,218) - lu(k,445) * b(k,124) + b(k,224) = b(k,224) - lu(k,446) * b(k,124) + b(k,209) = b(k,209) - lu(k,448) * b(k,125) + b(k,214) = b(k,214) - lu(k,449) * b(k,125) + b(k,215) = b(k,215) - lu(k,450) * b(k,125) + b(k,220) = b(k,220) - lu(k,451) * b(k,125) + b(k,223) = b(k,223) - lu(k,452) * b(k,125) + b(k,184) = b(k,184) - lu(k,455) * b(k,126) + b(k,215) = b(k,215) - lu(k,456) * b(k,126) + b(k,217) = b(k,217) - lu(k,457) * b(k,126) + b(k,218) = b(k,218) - lu(k,458) * b(k,126) + b(k,224) = b(k,224) - lu(k,459) * b(k,126) + b(k,160) = b(k,160) - lu(k,461) * b(k,127) + b(k,218) = b(k,218) - lu(k,462) * b(k,127) + b(k,150) = b(k,150) - lu(k,464) * b(k,128) + b(k,222) = b(k,222) - lu(k,465) * b(k,128) + b(k,224) = b(k,224) - lu(k,466) * b(k,128) + b(k,209) = b(k,209) - lu(k,468) * b(k,129) + b(k,214) = b(k,214) - lu(k,469) * b(k,129) + b(k,215) = b(k,215) - lu(k,470) * b(k,129) + b(k,220) = b(k,220) - lu(k,471) * b(k,129) + b(k,223) = b(k,223) - lu(k,472) * b(k,129) + b(k,227) = b(k,227) - lu(k,473) * b(k,129) + b(k,179) = b(k,179) - lu(k,475) * b(k,130) + b(k,180) = b(k,180) - lu(k,476) * b(k,130) + b(k,183) = b(k,183) - lu(k,477) * b(k,130) + b(k,213) = b(k,213) - lu(k,478) * b(k,130) + b(k,215) = b(k,215) - lu(k,479) * b(k,130) + b(k,218) = b(k,218) - lu(k,480) * b(k,130) + b(k,160) = b(k,160) - lu(k,484) * b(k,131) + b(k,184) = b(k,184) - lu(k,485) * b(k,131) + b(k,215) = b(k,215) - lu(k,486) * b(k,131) + b(k,217) = b(k,217) - lu(k,487) * b(k,131) + b(k,218) = b(k,218) - lu(k,488) * b(k,131) + b(k,224) = b(k,224) - lu(k,489) * b(k,131) + b(k,212) = b(k,212) - lu(k,492) * b(k,132) + b(k,214) = b(k,214) - lu(k,493) * b(k,132) + b(k,215) = b(k,215) - lu(k,494) * b(k,132) + b(k,217) = b(k,217) - lu(k,495) * b(k,132) + b(k,224) = b(k,224) - lu(k,496) * b(k,132) + b(k,226) = b(k,226) - lu(k,497) * b(k,132) + b(k,184) = b(k,184) - lu(k,500) * b(k,133) + b(k,200) = b(k,200) - lu(k,501) * b(k,133) + b(k,215) = b(k,215) - lu(k,502) * b(k,133) + b(k,217) = b(k,217) - lu(k,503) * b(k,133) + b(k,218) = b(k,218) - lu(k,504) * b(k,133) + b(k,224) = b(k,224) - lu(k,505) * b(k,133) + b(k,155) = b(k,155) - lu(k,507) * b(k,134) + b(k,170) = b(k,170) - lu(k,508) * b(k,134) + b(k,207) = b(k,207) - lu(k,509) * b(k,134) + b(k,215) = b(k,215) - lu(k,510) * b(k,134) + b(k,201) = b(k,201) - lu(k,512) * b(k,135) + b(k,212) = b(k,212) - lu(k,513) * b(k,135) + b(k,215) = b(k,215) - lu(k,514) * b(k,135) + b(k,222) = b(k,222) - lu(k,515) * b(k,135) + b(k,226) = b(k,226) - lu(k,516) * b(k,135) + b(k,150) = b(k,150) - lu(k,519) * b(k,136) + b(k,215) = b(k,215) - lu(k,520) * b(k,136) + b(k,217) = b(k,217) - lu(k,521) * b(k,136) + b(k,218) = b(k,218) - lu(k,522) * b(k,136) + b(k,224) = b(k,224) - lu(k,523) * b(k,136) + b(k,168) = b(k,168) - lu(k,525) * b(k,137) + b(k,207) = b(k,207) - lu(k,526) * b(k,137) + b(k,213) = b(k,213) - lu(k,527) * b(k,137) + b(k,215) = b(k,215) - lu(k,528) * b(k,137) + b(k,216) = b(k,216) - lu(k,529) * b(k,137) + b(k,221) = b(k,221) - lu(k,530) * b(k,137) + b(k,224) = b(k,224) - lu(k,531) * b(k,137) + b(k,164) = b(k,164) - lu(k,533) * b(k,138) + b(k,190) = b(k,190) - lu(k,534) * b(k,138) + b(k,195) = b(k,195) - lu(k,535) * b(k,138) + b(k,213) = b(k,213) - lu(k,536) * b(k,138) + b(k,215) = b(k,215) - lu(k,537) * b(k,138) + b(k,218) = b(k,218) - lu(k,538) * b(k,138) + b(k,227) = b(k,227) - lu(k,539) * b(k,138) + b(k,165) = b(k,165) - lu(k,541) * b(k,139) + b(k,209) = b(k,209) - lu(k,542) * b(k,139) + b(k,211) = b(k,211) - lu(k,543) * b(k,139) + b(k,216) = b(k,216) - lu(k,544) * b(k,139) + b(k,224) = b(k,224) - lu(k,545) * b(k,139) + b(k,225) = b(k,225) - lu(k,546) * b(k,139) + b(k,226) = b(k,226) - lu(k,547) * b(k,139) + b(k,159) = b(k,159) - lu(k,549) * b(k,140) + b(k,181) = b(k,181) - lu(k,550) * b(k,140) + b(k,192) = b(k,192) - lu(k,551) * b(k,140) + b(k,213) = b(k,213) - lu(k,552) * b(k,140) + b(k,215) = b(k,215) - lu(k,553) * b(k,140) + b(k,218) = b(k,218) - lu(k,554) * b(k,140) + b(k,222) = b(k,222) - lu(k,555) * b(k,140) + b(k,174) = b(k,174) - lu(k,557) * b(k,141) + b(k,191) = b(k,191) - lu(k,558) * b(k,141) + b(k,195) = b(k,195) - lu(k,559) * b(k,141) + b(k,196) = b(k,196) - lu(k,560) * b(k,141) + b(k,211) = b(k,211) - lu(k,561) * b(k,141) + b(k,215) = b(k,215) - lu(k,562) * b(k,141) + b(k,218) = b(k,218) - lu(k,563) * b(k,141) + b(k,180) = b(k,180) - lu(k,565) * b(k,142) + b(k,190) = b(k,190) - lu(k,566) * b(k,142) + b(k,196) = b(k,196) - lu(k,567) * b(k,142) + b(k,213) = b(k,213) - lu(k,568) * b(k,142) + b(k,217) = b(k,217) - lu(k,569) * b(k,142) + b(k,218) = b(k,218) - lu(k,570) * b(k,142) + b(k,224) = b(k,224) - lu(k,571) * b(k,142) + b(k,168) = b(k,168) - lu(k,573) * b(k,143) + b(k,195) = b(k,195) - lu(k,574) * b(k,143) + b(k,206) = b(k,206) - lu(k,575) * b(k,143) + b(k,213) = b(k,213) - lu(k,576) * b(k,143) + b(k,215) = b(k,215) - lu(k,577) * b(k,143) + b(k,216) = b(k,216) - lu(k,578) * b(k,143) + b(k,218) = b(k,218) - lu(k,579) * b(k,143) + b(k,224) = b(k,224) - lu(k,580) * b(k,143) + b(k,191) = b(k,191) - lu(k,582) * b(k,144) + b(k,195) = b(k,195) - lu(k,583) * b(k,144) + b(k,196) = b(k,196) - lu(k,584) * b(k,144) + b(k,211) = b(k,211) - lu(k,585) * b(k,144) + b(k,213) = b(k,213) - lu(k,586) * b(k,144) + b(k,215) = b(k,215) - lu(k,587) * b(k,144) + b(k,218) = b(k,218) - lu(k,588) * b(k,144) + b(k,224) = b(k,224) - lu(k,589) * b(k,144) + b(k,176) = b(k,176) - lu(k,591) * b(k,145) + b(k,192) = b(k,192) - lu(k,592) * b(k,145) + b(k,218) = b(k,218) - lu(k,593) * b(k,145) + b(k,209) = b(k,209) - lu(k,595) * b(k,146) + b(k,214) = b(k,214) - lu(k,596) * b(k,146) + b(k,215) = b(k,215) - lu(k,597) * b(k,146) + b(k,218) = b(k,218) - lu(k,598) * b(k,146) + b(k,220) = b(k,220) - lu(k,599) * b(k,146) + b(k,221) = b(k,221) - lu(k,600) * b(k,146) + b(k,223) = b(k,223) - lu(k,601) * b(k,146) + b(k,227) = b(k,227) - lu(k,602) * b(k,146) + b(k,215) = b(k,215) - lu(k,604) * b(k,147) + b(k,218) = b(k,218) - lu(k,605) * b(k,147) + b(k,220) = b(k,220) - lu(k,606) * b(k,147) + b(k,223) = b(k,223) - lu(k,607) * b(k,147) + b(k,226) = b(k,226) - lu(k,608) * b(k,147) + b(k,227) = b(k,227) - lu(k,609) * b(k,147) end do end subroutine lu_slv02 subroutine lu_slv03( avec_len, lu, b ) @@ -464,211 +466,211 @@ subroutine lu_slv03( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,159) = b(k,159) - lu(k,605) * b(k,132) - b(k,186) = b(k,186) - lu(k,606) * b(k,132) - b(k,187) = b(k,187) - lu(k,607) * b(k,132) - b(k,188) = b(k,188) - lu(k,608) * b(k,132) - b(k,191) = b(k,191) - lu(k,609) * b(k,132) - b(k,192) = b(k,192) - lu(k,610) * b(k,132) - b(k,149) = b(k,149) - lu(k,612) * b(k,133) - b(k,162) = b(k,162) - lu(k,613) * b(k,133) - b(k,187) = b(k,187) - lu(k,614) * b(k,133) - b(k,188) = b(k,188) - lu(k,615) * b(k,133) - b(k,192) = b(k,192) - lu(k,616) * b(k,133) - b(k,136) = b(k,136) - lu(k,623) * b(k,134) - b(k,149) = b(k,149) - lu(k,624) * b(k,134) - b(k,150) = b(k,150) - lu(k,625) * b(k,134) - b(k,162) = b(k,162) - lu(k,626) * b(k,134) - b(k,173) = b(k,173) - lu(k,627) * b(k,134) - b(k,186) = b(k,186) - lu(k,628) * b(k,134) - b(k,187) = b(k,187) - lu(k,629) * b(k,134) - b(k,188) = b(k,188) - lu(k,630) * b(k,134) - b(k,192) = b(k,192) - lu(k,631) * b(k,134) - b(k,136) = b(k,136) - lu(k,639) * b(k,135) - b(k,149) = b(k,149) - lu(k,640) * b(k,135) - b(k,150) = b(k,150) - lu(k,641) * b(k,135) - b(k,162) = b(k,162) - lu(k,642) * b(k,135) - b(k,173) = b(k,173) - lu(k,643) * b(k,135) - b(k,180) = b(k,180) - lu(k,644) * b(k,135) - b(k,186) = b(k,186) - lu(k,645) * b(k,135) - b(k,187) = b(k,187) - lu(k,646) * b(k,135) - b(k,188) = b(k,188) - lu(k,647) * b(k,135) - b(k,192) = b(k,192) - lu(k,648) * b(k,135) - b(k,162) = b(k,162) - lu(k,650) * b(k,136) - b(k,173) = b(k,173) - lu(k,651) * b(k,136) - b(k,186) = b(k,186) - lu(k,652) * b(k,136) - b(k,187) = b(k,187) - lu(k,653) * b(k,136) - b(k,188) = b(k,188) - lu(k,654) * b(k,136) - b(k,189) = b(k,189) - lu(k,655) * b(k,136) - b(k,192) = b(k,192) - lu(k,656) * b(k,136) - b(k,163) = b(k,163) - lu(k,659) * b(k,137) - b(k,168) = b(k,168) - lu(k,660) * b(k,137) - b(k,186) = b(k,186) - lu(k,661) * b(k,137) - b(k,187) = b(k,187) - lu(k,662) * b(k,137) - b(k,188) = b(k,188) - lu(k,663) * b(k,137) - b(k,191) = b(k,191) - lu(k,664) * b(k,137) - b(k,192) = b(k,192) - lu(k,665) * b(k,137) - b(k,198) = b(k,198) - lu(k,666) * b(k,137) - b(k,181) = b(k,181) - lu(k,669) * b(k,138) - b(k,186) = b(k,186) - lu(k,670) * b(k,138) - b(k,190) = b(k,190) - lu(k,671) * b(k,138) - b(k,193) = b(k,193) - lu(k,672) * b(k,138) - b(k,194) = b(k,194) - lu(k,673) * b(k,138) - b(k,195) = b(k,195) - lu(k,674) * b(k,138) - b(k,198) = b(k,198) - lu(k,675) * b(k,138) - b(k,169) = b(k,169) - lu(k,678) * b(k,139) - b(k,182) = b(k,182) - lu(k,679) * b(k,139) - b(k,183) = b(k,183) - lu(k,680) * b(k,139) - b(k,186) = b(k,186) - lu(k,681) * b(k,139) - b(k,189) = b(k,189) - lu(k,682) * b(k,139) - b(k,196) = b(k,196) - lu(k,683) * b(k,139) - b(k,198) = b(k,198) - lu(k,684) * b(k,139) - b(k,154) = b(k,154) - lu(k,687) * b(k,140) - b(k,168) = b(k,168) - lu(k,688) * b(k,140) - b(k,186) = b(k,186) - lu(k,689) * b(k,140) - b(k,187) = b(k,187) - lu(k,690) * b(k,140) - b(k,188) = b(k,188) - lu(k,691) * b(k,140) - b(k,189) = b(k,189) - lu(k,692) * b(k,140) - b(k,191) = b(k,191) - lu(k,693) * b(k,140) - b(k,192) = b(k,192) - lu(k,694) * b(k,140) - b(k,198) = b(k,198) - lu(k,695) * b(k,140) - b(k,186) = b(k,186) - lu(k,697) * b(k,141) - b(k,191) = b(k,191) - lu(k,698) * b(k,141) - b(k,192) = b(k,192) - lu(k,699) * b(k,141) - b(k,186) = b(k,186) - lu(k,701) * b(k,142) - b(k,192) = b(k,192) - lu(k,702) * b(k,142) - b(k,198) = b(k,198) - lu(k,703) * b(k,142) - b(k,181) = b(k,181) - lu(k,705) * b(k,143) - b(k,183) = b(k,183) - lu(k,706) * b(k,143) - b(k,185) = b(k,185) - lu(k,707) * b(k,143) - b(k,186) = b(k,186) - lu(k,708) * b(k,143) - b(k,190) = b(k,190) - lu(k,709) * b(k,143) - b(k,193) = b(k,193) - lu(k,710) * b(k,143) - b(k,198) = b(k,198) - lu(k,711) * b(k,143) - b(k,168) = b(k,168) - lu(k,716) * b(k,144) - b(k,186) = b(k,186) - lu(k,717) * b(k,144) - b(k,187) = b(k,187) - lu(k,718) * b(k,144) - b(k,188) = b(k,188) - lu(k,719) * b(k,144) - b(k,189) = b(k,189) - lu(k,720) * b(k,144) - b(k,191) = b(k,191) - lu(k,721) * b(k,144) - b(k,192) = b(k,192) - lu(k,722) * b(k,144) - b(k,184) = b(k,184) - lu(k,725) * b(k,145) - b(k,186) = b(k,186) - lu(k,726) * b(k,145) - b(k,193) = b(k,193) - lu(k,727) * b(k,145) - b(k,194) = b(k,194) - lu(k,728) * b(k,145) - b(k,195) = b(k,195) - lu(k,729) * b(k,145) - b(k,198) = b(k,198) - lu(k,730) * b(k,145) - b(k,156) = b(k,156) - lu(k,736) * b(k,146) - b(k,162) = b(k,162) - lu(k,737) * b(k,146) - b(k,171) = b(k,171) - lu(k,738) * b(k,146) - b(k,172) = b(k,172) - lu(k,739) * b(k,146) - b(k,175) = b(k,175) - lu(k,740) * b(k,146) - b(k,176) = b(k,176) - lu(k,741) * b(k,146) - b(k,178) = b(k,178) - lu(k,742) * b(k,146) - b(k,180) = b(k,180) - lu(k,743) * b(k,146) - b(k,186) = b(k,186) - lu(k,744) * b(k,146) - b(k,189) = b(k,189) - lu(k,745) * b(k,146) - b(k,191) = b(k,191) - lu(k,746) * b(k,146) - b(k,192) = b(k,192) - lu(k,747) * b(k,146) - b(k,196) = b(k,196) - lu(k,748) * b(k,146) - b(k,197) = b(k,197) - lu(k,749) * b(k,146) - b(k,198) = b(k,198) - lu(k,750) * b(k,146) - b(k,173) = b(k,173) - lu(k,752) * b(k,147) - b(k,180) = b(k,180) - lu(k,753) * b(k,147) - b(k,186) = b(k,186) - lu(k,754) * b(k,147) - b(k,187) = b(k,187) - lu(k,755) * b(k,147) - b(k,191) = b(k,191) - lu(k,756) * b(k,147) - b(k,174) = b(k,174) - lu(k,759) * b(k,148) - b(k,186) = b(k,186) - lu(k,760) * b(k,148) - b(k,192) = b(k,192) - lu(k,761) * b(k,148) - b(k,193) = b(k,193) - lu(k,762) * b(k,148) - b(k,198) = b(k,198) - lu(k,763) * b(k,148) - b(k,162) = b(k,162) - lu(k,766) * b(k,149) - b(k,186) = b(k,186) - lu(k,767) * b(k,149) - b(k,192) = b(k,192) - lu(k,768) * b(k,149) - b(k,162) = b(k,162) - lu(k,771) * b(k,150) - b(k,173) = b(k,173) - lu(k,772) * b(k,150) - b(k,186) = b(k,186) - lu(k,773) * b(k,150) - b(k,187) = b(k,187) - lu(k,774) * b(k,150) - b(k,188) = b(k,188) - lu(k,775) * b(k,150) - b(k,189) = b(k,189) - lu(k,776) * b(k,150) - b(k,192) = b(k,192) - lu(k,777) * b(k,150) - b(k,153) = b(k,153) - lu(k,789) * b(k,151) - b(k,154) = b(k,154) - lu(k,790) * b(k,151) - b(k,157) = b(k,157) - lu(k,791) * b(k,151) - b(k,161) = b(k,161) - lu(k,792) * b(k,151) - b(k,162) = b(k,162) - lu(k,793) * b(k,151) - b(k,164) = b(k,164) - lu(k,794) * b(k,151) - b(k,166) = b(k,166) - lu(k,795) * b(k,151) - b(k,167) = b(k,167) - lu(k,796) * b(k,151) - b(k,173) = b(k,173) - lu(k,797) * b(k,151) - b(k,180) = b(k,180) - lu(k,798) * b(k,151) - b(k,186) = b(k,186) - lu(k,799) * b(k,151) - b(k,191) = b(k,191) - lu(k,800) * b(k,151) - b(k,192) = b(k,192) - lu(k,801) * b(k,151) - b(k,196) = b(k,196) - lu(k,802) * b(k,151) - b(k,197) = b(k,197) - lu(k,803) * b(k,151) - b(k,198) = b(k,198) - lu(k,804) * b(k,151) - b(k,153) = b(k,153) - lu(k,816) * b(k,152) - b(k,154) = b(k,154) - lu(k,817) * b(k,152) - b(k,157) = b(k,157) - lu(k,818) * b(k,152) - b(k,161) = b(k,161) - lu(k,819) * b(k,152) - b(k,162) = b(k,162) - lu(k,820) * b(k,152) - b(k,164) = b(k,164) - lu(k,821) * b(k,152) - b(k,166) = b(k,166) - lu(k,822) * b(k,152) - b(k,167) = b(k,167) - lu(k,823) * b(k,152) - b(k,173) = b(k,173) - lu(k,824) * b(k,152) - b(k,180) = b(k,180) - lu(k,825) * b(k,152) - b(k,186) = b(k,186) - lu(k,826) * b(k,152) - b(k,191) = b(k,191) - lu(k,827) * b(k,152) - b(k,192) = b(k,192) - lu(k,828) * b(k,152) - b(k,196) = b(k,196) - lu(k,829) * b(k,152) - b(k,197) = b(k,197) - lu(k,830) * b(k,152) - b(k,198) = b(k,198) - lu(k,831) * b(k,152) - b(k,154) = b(k,154) - lu(k,838) * b(k,153) - b(k,168) = b(k,168) - lu(k,839) * b(k,153) - b(k,180) = b(k,180) - lu(k,840) * b(k,153) - b(k,186) = b(k,186) - lu(k,841) * b(k,153) - b(k,187) = b(k,187) - lu(k,842) * b(k,153) - b(k,188) = b(k,188) - lu(k,843) * b(k,153) - b(k,189) = b(k,189) - lu(k,844) * b(k,153) - b(k,191) = b(k,191) - lu(k,845) * b(k,153) - b(k,192) = b(k,192) - lu(k,846) * b(k,153) - b(k,167) = b(k,167) - lu(k,848) * b(k,154) - b(k,180) = b(k,180) - lu(k,849) * b(k,154) - b(k,186) = b(k,186) - lu(k,850) * b(k,154) - b(k,189) = b(k,189) - lu(k,851) * b(k,154) - b(k,198) = b(k,198) - lu(k,852) * b(k,154) - b(k,182) = b(k,182) - lu(k,856) * b(k,155) - b(k,184) = b(k,184) - lu(k,857) * b(k,155) - b(k,186) = b(k,186) - lu(k,858) * b(k,155) - b(k,187) = b(k,187) - lu(k,859) * b(k,155) - b(k,193) = b(k,193) - lu(k,860) * b(k,155) - b(k,194) = b(k,194) - lu(k,861) * b(k,155) - b(k,195) = b(k,195) - lu(k,862) * b(k,155) - b(k,196) = b(k,196) - lu(k,863) * b(k,155) - b(k,198) = b(k,198) - lu(k,864) * b(k,155) - b(k,162) = b(k,162) - lu(k,870) * b(k,156) - b(k,163) = b(k,163) - lu(k,871) * b(k,156) - b(k,168) = b(k,168) - lu(k,872) * b(k,156) - b(k,173) = b(k,173) - lu(k,873) * b(k,156) - b(k,180) = b(k,180) - lu(k,874) * b(k,156) - b(k,186) = b(k,186) - lu(k,875) * b(k,156) - b(k,187) = b(k,187) - lu(k,876) * b(k,156) - b(k,188) = b(k,188) - lu(k,877) * b(k,156) - b(k,189) = b(k,189) - lu(k,878) * b(k,156) - b(k,191) = b(k,191) - lu(k,879) * b(k,156) - b(k,192) = b(k,192) - lu(k,880) * b(k,156) - b(k,196) = b(k,196) - lu(k,881) * b(k,156) - b(k,197) = b(k,197) - lu(k,882) * b(k,156) - b(k,198) = b(k,198) - lu(k,883) * b(k,156) - b(k,161) = b(k,161) - lu(k,885) * b(k,157) - b(k,162) = b(k,162) - lu(k,886) * b(k,157) - b(k,165) = b(k,165) - lu(k,887) * b(k,157) - b(k,166) = b(k,166) - lu(k,888) * b(k,157) - b(k,186) = b(k,186) - lu(k,889) * b(k,157) - b(k,192) = b(k,192) - lu(k,890) * b(k,157) - b(k,196) = b(k,196) - lu(k,891) * b(k,157) + b(k,168) = b(k,168) - lu(k,611) * b(k,148) + b(k,207) = b(k,207) - lu(k,612) * b(k,148) + b(k,213) = b(k,213) - lu(k,613) * b(k,148) + b(k,215) = b(k,215) - lu(k,614) * b(k,148) + b(k,221) = b(k,221) - lu(k,615) * b(k,148) + b(k,227) = b(k,227) - lu(k,616) * b(k,148) + b(k,183) = b(k,183) - lu(k,618) * b(k,149) + b(k,211) = b(k,211) - lu(k,619) * b(k,149) + b(k,215) = b(k,215) - lu(k,620) * b(k,149) + b(k,218) = b(k,218) - lu(k,621) * b(k,149) + b(k,224) = b(k,224) - lu(k,622) * b(k,149) + b(k,215) = b(k,215) - lu(k,626) * b(k,150) + b(k,217) = b(k,217) - lu(k,627) * b(k,150) + b(k,218) = b(k,218) - lu(k,628) * b(k,150) + b(k,222) = b(k,222) - lu(k,629) * b(k,150) + b(k,224) = b(k,224) - lu(k,630) * b(k,150) + b(k,155) = b(k,155) - lu(k,633) * b(k,151) + b(k,170) = b(k,170) - lu(k,634) * b(k,151) + b(k,178) = b(k,178) - lu(k,635) * b(k,151) + b(k,180) = b(k,180) - lu(k,636) * b(k,151) + b(k,190) = b(k,190) - lu(k,637) * b(k,151) + b(k,207) = b(k,207) - lu(k,638) * b(k,151) + b(k,213) = b(k,213) - lu(k,639) * b(k,151) + b(k,215) = b(k,215) - lu(k,640) * b(k,151) + b(k,218) = b(k,218) - lu(k,641) * b(k,151) + b(k,168) = b(k,168) - lu(k,643) * b(k,152) + b(k,180) = b(k,180) - lu(k,644) * b(k,152) + b(k,188) = b(k,188) - lu(k,645) * b(k,152) + b(k,191) = b(k,191) - lu(k,646) * b(k,152) + b(k,192) = b(k,192) - lu(k,647) * b(k,152) + b(k,193) = b(k,193) - lu(k,648) * b(k,152) + b(k,213) = b(k,213) - lu(k,649) * b(k,152) + b(k,215) = b(k,215) - lu(k,650) * b(k,152) + b(k,218) = b(k,218) - lu(k,651) * b(k,152) + b(k,160) = b(k,160) - lu(k,656) * b(k,153) + b(k,161) = b(k,161) - lu(k,657) * b(k,153) + b(k,163) = b(k,163) - lu(k,658) * b(k,153) + b(k,176) = b(k,176) - lu(k,659) * b(k,153) + b(k,184) = b(k,184) - lu(k,660) * b(k,153) + b(k,192) = b(k,192) - lu(k,661) * b(k,153) + b(k,200) = b(k,200) - lu(k,662) * b(k,153) + b(k,215) = b(k,215) - lu(k,663) * b(k,153) + b(k,218) = b(k,218) - lu(k,664) * b(k,153) + b(k,155) = b(k,155) - lu(k,667) * b(k,154) + b(k,170) = b(k,170) - lu(k,668) * b(k,154) + b(k,180) = b(k,180) - lu(k,669) * b(k,154) + b(k,190) = b(k,190) - lu(k,670) * b(k,154) + b(k,207) = b(k,207) - lu(k,671) * b(k,154) + b(k,213) = b(k,213) - lu(k,672) * b(k,154) + b(k,215) = b(k,215) - lu(k,673) * b(k,154) + b(k,218) = b(k,218) - lu(k,674) * b(k,154) + b(k,224) = b(k,224) - lu(k,675) * b(k,154) + b(k,190) = b(k,190) - lu(k,678) * b(k,155) + b(k,207) = b(k,207) - lu(k,679) * b(k,155) + b(k,215) = b(k,215) - lu(k,680) * b(k,155) + b(k,217) = b(k,217) - lu(k,681) * b(k,155) + b(k,218) = b(k,218) - lu(k,682) * b(k,155) + b(k,224) = b(k,224) - lu(k,683) * b(k,155) + b(k,168) = b(k,168) - lu(k,685) * b(k,156) + b(k,215) = b(k,215) - lu(k,686) * b(k,156) + b(k,221) = b(k,221) - lu(k,687) * b(k,156) + b(k,227) = b(k,227) - lu(k,688) * b(k,156) + b(k,197) = b(k,197) - lu(k,691) * b(k,157) + b(k,199) = b(k,199) - lu(k,692) * b(k,157) + b(k,205) = b(k,205) - lu(k,693) * b(k,157) + b(k,213) = b(k,213) - lu(k,694) * b(k,157) + b(k,215) = b(k,215) - lu(k,695) * b(k,157) + b(k,218) = b(k,218) - lu(k,696) * b(k,157) + b(k,160) = b(k,160) - lu(k,702) * b(k,158) + b(k,162) = b(k,162) - lu(k,703) * b(k,158) + b(k,163) = b(k,163) - lu(k,704) * b(k,158) + b(k,176) = b(k,176) - lu(k,705) * b(k,158) + b(k,184) = b(k,184) - lu(k,706) * b(k,158) + b(k,192) = b(k,192) - lu(k,707) * b(k,158) + b(k,200) = b(k,200) - lu(k,708) * b(k,158) + b(k,207) = b(k,207) - lu(k,709) * b(k,158) + b(k,215) = b(k,215) - lu(k,710) * b(k,158) + b(k,218) = b(k,218) - lu(k,711) * b(k,158) + b(k,191) = b(k,191) - lu(k,715) * b(k,159) + b(k,213) = b(k,213) - lu(k,716) * b(k,159) + b(k,215) = b(k,215) - lu(k,717) * b(k,159) + b(k,217) = b(k,217) - lu(k,718) * b(k,159) + b(k,218) = b(k,218) - lu(k,719) * b(k,159) + b(k,224) = b(k,224) - lu(k,720) * b(k,159) + b(k,184) = b(k,184) - lu(k,722) * b(k,160) + b(k,192) = b(k,192) - lu(k,723) * b(k,160) + b(k,217) = b(k,217) - lu(k,724) * b(k,160) + b(k,218) = b(k,218) - lu(k,725) * b(k,160) + b(k,224) = b(k,224) - lu(k,726) * b(k,160) + b(k,163) = b(k,163) - lu(k,733) * b(k,161) + b(k,176) = b(k,176) - lu(k,734) * b(k,161) + b(k,184) = b(k,184) - lu(k,735) * b(k,161) + b(k,192) = b(k,192) - lu(k,736) * b(k,161) + b(k,200) = b(k,200) - lu(k,737) * b(k,161) + b(k,215) = b(k,215) - lu(k,738) * b(k,161) + b(k,217) = b(k,217) - lu(k,739) * b(k,161) + b(k,218) = b(k,218) - lu(k,740) * b(k,161) + b(k,224) = b(k,224) - lu(k,741) * b(k,161) + b(k,163) = b(k,163) - lu(k,749) * b(k,162) + b(k,176) = b(k,176) - lu(k,750) * b(k,162) + b(k,184) = b(k,184) - lu(k,751) * b(k,162) + b(k,192) = b(k,192) - lu(k,752) * b(k,162) + b(k,200) = b(k,200) - lu(k,753) * b(k,162) + b(k,207) = b(k,207) - lu(k,754) * b(k,162) + b(k,215) = b(k,215) - lu(k,755) * b(k,162) + b(k,217) = b(k,217) - lu(k,756) * b(k,162) + b(k,218) = b(k,218) - lu(k,757) * b(k,162) + b(k,224) = b(k,224) - lu(k,758) * b(k,162) + b(k,192) = b(k,192) - lu(k,760) * b(k,163) + b(k,200) = b(k,200) - lu(k,761) * b(k,163) + b(k,215) = b(k,215) - lu(k,762) * b(k,163) + b(k,217) = b(k,217) - lu(k,763) * b(k,163) + b(k,218) = b(k,218) - lu(k,764) * b(k,163) + b(k,221) = b(k,221) - lu(k,765) * b(k,163) + b(k,224) = b(k,224) - lu(k,766) * b(k,163) + b(k,190) = b(k,190) - lu(k,769) * b(k,164) + b(k,195) = b(k,195) - lu(k,770) * b(k,164) + b(k,213) = b(k,213) - lu(k,771) * b(k,164) + b(k,215) = b(k,215) - lu(k,772) * b(k,164) + b(k,217) = b(k,217) - lu(k,773) * b(k,164) + b(k,218) = b(k,218) - lu(k,774) * b(k,164) + b(k,224) = b(k,224) - lu(k,775) * b(k,164) + b(k,227) = b(k,227) - lu(k,776) * b(k,164) + b(k,209) = b(k,209) - lu(k,779) * b(k,165) + b(k,215) = b(k,215) - lu(k,780) * b(k,165) + b(k,220) = b(k,220) - lu(k,781) * b(k,165) + b(k,223) = b(k,223) - lu(k,782) * b(k,165) + b(k,225) = b(k,225) - lu(k,783) * b(k,165) + b(k,226) = b(k,226) - lu(k,784) * b(k,165) + b(k,227) = b(k,227) - lu(k,785) * b(k,165) + b(k,213) = b(k,213) - lu(k,787) * b(k,166) + b(k,215) = b(k,215) - lu(k,788) * b(k,166) + b(k,218) = b(k,218) - lu(k,789) * b(k,166) + b(k,180) = b(k,180) - lu(k,792) * b(k,167) + b(k,190) = b(k,190) - lu(k,793) * b(k,167) + b(k,213) = b(k,213) - lu(k,794) * b(k,167) + b(k,215) = b(k,215) - lu(k,795) * b(k,167) + b(k,217) = b(k,217) - lu(k,796) * b(k,167) + b(k,218) = b(k,218) - lu(k,797) * b(k,167) + b(k,221) = b(k,221) - lu(k,798) * b(k,167) + b(k,224) = b(k,224) - lu(k,799) * b(k,167) + b(k,227) = b(k,227) - lu(k,800) * b(k,167) + b(k,192) = b(k,192) - lu(k,802) * b(k,168) + b(k,226) = b(k,226) - lu(k,803) * b(k,168) + b(k,209) = b(k,209) - lu(k,805) * b(k,169) + b(k,212) = b(k,212) - lu(k,806) * b(k,169) + b(k,214) = b(k,214) - lu(k,807) * b(k,169) + b(k,215) = b(k,215) - lu(k,808) * b(k,169) + b(k,225) = b(k,225) - lu(k,809) * b(k,169) + b(k,226) = b(k,226) - lu(k,810) * b(k,169) + b(k,227) = b(k,227) - lu(k,811) * b(k,169) + b(k,190) = b(k,190) - lu(k,816) * b(k,170) + b(k,213) = b(k,213) - lu(k,817) * b(k,170) + b(k,215) = b(k,215) - lu(k,818) * b(k,170) + b(k,217) = b(k,217) - lu(k,819) * b(k,170) + b(k,218) = b(k,218) - lu(k,820) * b(k,170) + b(k,221) = b(k,221) - lu(k,821) * b(k,170) + b(k,224) = b(k,224) - lu(k,822) * b(k,170) + b(k,215) = b(k,215) - lu(k,825) * b(k,171) + b(k,219) = b(k,219) - lu(k,826) * b(k,171) + b(k,220) = b(k,220) - lu(k,827) * b(k,171) + b(k,223) = b(k,223) - lu(k,828) * b(k,171) + b(k,226) = b(k,226) - lu(k,829) * b(k,171) + b(k,227) = b(k,227) - lu(k,830) * b(k,171) + b(k,201) = b(k,201) - lu(k,833) * b(k,172) + b(k,215) = b(k,215) - lu(k,834) * b(k,172) + b(k,218) = b(k,218) - lu(k,835) * b(k,172) + b(k,226) = b(k,226) - lu(k,836) * b(k,172) + b(k,227) = b(k,227) - lu(k,837) * b(k,172) + b(k,181) = b(k,181) - lu(k,842) * b(k,173) + b(k,186) = b(k,186) - lu(k,843) * b(k,173) + b(k,192) = b(k,192) - lu(k,844) * b(k,173) + b(k,198) = b(k,198) - lu(k,845) * b(k,173) + b(k,199) = b(k,199) - lu(k,846) * b(k,173) + b(k,202) = b(k,202) - lu(k,847) * b(k,173) + b(k,203) = b(k,203) - lu(k,848) * b(k,173) + b(k,205) = b(k,205) - lu(k,849) * b(k,173) + b(k,207) = b(k,207) - lu(k,850) * b(k,173) + b(k,213) = b(k,213) - lu(k,851) * b(k,173) + b(k,215) = b(k,215) - lu(k,852) * b(k,173) + b(k,216) = b(k,216) - lu(k,853) * b(k,173) + b(k,218) = b(k,218) - lu(k,854) * b(k,173) + b(k,221) = b(k,221) - lu(k,855) * b(k,173) + b(k,222) = b(k,222) - lu(k,856) * b(k,173) + b(k,200) = b(k,200) - lu(k,858) * b(k,174) + b(k,207) = b(k,207) - lu(k,859) * b(k,174) + b(k,213) = b(k,213) - lu(k,860) * b(k,174) + b(k,215) = b(k,215) - lu(k,861) * b(k,174) + b(k,224) = b(k,224) - lu(k,862) * b(k,174) + b(k,208) = b(k,208) - lu(k,865) * b(k,175) + b(k,210) = b(k,210) - lu(k,866) * b(k,175) + b(k,211) = b(k,211) - lu(k,867) * b(k,175) + b(k,212) = b(k,212) - lu(k,868) * b(k,175) + b(k,215) = b(k,215) - lu(k,869) * b(k,175) + b(k,216) = b(k,216) - lu(k,870) * b(k,175) + b(k,221) = b(k,221) - lu(k,871) * b(k,175) + b(k,227) = b(k,227) - lu(k,872) * b(k,175) + b(k,184) = b(k,184) - lu(k,874) * b(k,176) + b(k,192) = b(k,192) - lu(k,875) * b(k,176) + b(k,200) = b(k,200) - lu(k,876) * b(k,176) + b(k,215) = b(k,215) - lu(k,877) * b(k,176) + b(k,217) = b(k,217) - lu(k,878) * b(k,176) + b(k,218) = b(k,218) - lu(k,879) * b(k,176) + b(k,221) = b(k,221) - lu(k,880) * b(k,176) + b(k,224) = b(k,224) - lu(k,881) * b(k,176) end do end subroutine lu_slv03 subroutine lu_slv04( avec_len, lu, b ) @@ -689,217 +691,217 @@ subroutine lu_slv04( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,162) = b(k,162) - lu(k,897) * b(k,158) - b(k,173) = b(k,173) - lu(k,898) * b(k,158) - b(k,180) = b(k,180) - lu(k,899) * b(k,158) - b(k,182) = b(k,182) - lu(k,900) * b(k,158) - b(k,186) = b(k,186) - lu(k,901) * b(k,158) - b(k,187) = b(k,187) - lu(k,902) * b(k,158) - b(k,188) = b(k,188) - lu(k,903) * b(k,158) - b(k,189) = b(k,189) - lu(k,904) * b(k,158) - b(k,191) = b(k,191) - lu(k,905) * b(k,158) - b(k,192) = b(k,192) - lu(k,906) * b(k,158) - b(k,162) = b(k,162) - lu(k,909) * b(k,159) - b(k,186) = b(k,186) - lu(k,910) * b(k,159) - b(k,191) = b(k,191) - lu(k,911) * b(k,159) - b(k,192) = b(k,192) - lu(k,912) * b(k,159) - b(k,162) = b(k,162) - lu(k,917) * b(k,160) - b(k,163) = b(k,163) - lu(k,918) * b(k,160) - b(k,167) = b(k,167) - lu(k,919) * b(k,160) - b(k,168) = b(k,168) - lu(k,920) * b(k,160) - b(k,180) = b(k,180) - lu(k,921) * b(k,160) - b(k,182) = b(k,182) - lu(k,922) * b(k,160) - b(k,186) = b(k,186) - lu(k,923) * b(k,160) - b(k,187) = b(k,187) - lu(k,924) * b(k,160) - b(k,189) = b(k,189) - lu(k,925) * b(k,160) - b(k,191) = b(k,191) - lu(k,926) * b(k,160) - b(k,192) = b(k,192) - lu(k,927) * b(k,160) - b(k,198) = b(k,198) - lu(k,928) * b(k,160) - b(k,162) = b(k,162) - lu(k,931) * b(k,161) - b(k,167) = b(k,167) - lu(k,932) * b(k,161) - b(k,180) = b(k,180) - lu(k,933) * b(k,161) - b(k,186) = b(k,186) - lu(k,934) * b(k,161) - b(k,189) = b(k,189) - lu(k,935) * b(k,161) - b(k,191) = b(k,191) - lu(k,936) * b(k,161) - b(k,192) = b(k,192) - lu(k,937) * b(k,161) - b(k,198) = b(k,198) - lu(k,938) * b(k,161) - b(k,183) = b(k,183) - lu(k,940) * b(k,162) - b(k,186) = b(k,186) - lu(k,941) * b(k,162) - b(k,192) = b(k,192) - lu(k,942) * b(k,162) - b(k,173) = b(k,173) - lu(k,944) * b(k,163) - b(k,180) = b(k,180) - lu(k,945) * b(k,163) - b(k,186) = b(k,186) - lu(k,946) * b(k,163) - b(k,191) = b(k,191) - lu(k,947) * b(k,163) - b(k,192) = b(k,192) - lu(k,948) * b(k,163) - b(k,165) = b(k,165) - lu(k,957) * b(k,164) - b(k,166) = b(k,166) - lu(k,958) * b(k,164) - b(k,167) = b(k,167) - lu(k,959) * b(k,164) - b(k,180) = b(k,180) - lu(k,960) * b(k,164) - b(k,182) = b(k,182) - lu(k,961) * b(k,164) - b(k,183) = b(k,183) - lu(k,962) * b(k,164) - b(k,186) = b(k,186) - lu(k,963) * b(k,164) - b(k,187) = b(k,187) - lu(k,964) * b(k,164) - b(k,188) = b(k,188) - lu(k,965) * b(k,164) - b(k,189) = b(k,189) - lu(k,966) * b(k,164) - b(k,191) = b(k,191) - lu(k,967) * b(k,164) - b(k,192) = b(k,192) - lu(k,968) * b(k,164) - b(k,196) = b(k,196) - lu(k,969) * b(k,164) - b(k,198) = b(k,198) - lu(k,970) * b(k,164) - b(k,167) = b(k,167) - lu(k,979) * b(k,165) - b(k,180) = b(k,180) - lu(k,980) * b(k,165) - b(k,182) = b(k,182) - lu(k,981) * b(k,165) - b(k,183) = b(k,183) - lu(k,982) * b(k,165) - b(k,186) = b(k,186) - lu(k,983) * b(k,165) - b(k,187) = b(k,187) - lu(k,984) * b(k,165) - b(k,188) = b(k,188) - lu(k,985) * b(k,165) - b(k,189) = b(k,189) - lu(k,986) * b(k,165) - b(k,191) = b(k,191) - lu(k,987) * b(k,165) - b(k,192) = b(k,192) - lu(k,988) * b(k,165) - b(k,198) = b(k,198) - lu(k,989) * b(k,165) - b(k,167) = b(k,167) - lu(k,998) * b(k,166) - b(k,180) = b(k,180) - lu(k,999) * b(k,166) - b(k,182) = b(k,182) - lu(k,1000) * b(k,166) - b(k,183) = b(k,183) - lu(k,1001) * b(k,166) - b(k,186) = b(k,186) - lu(k,1002) * b(k,166) - b(k,187) = b(k,187) - lu(k,1003) * b(k,166) - b(k,188) = b(k,188) - lu(k,1004) * b(k,166) - b(k,189) = b(k,189) - lu(k,1005) * b(k,166) - b(k,191) = b(k,191) - lu(k,1006) * b(k,166) - b(k,192) = b(k,192) - lu(k,1007) * b(k,166) - b(k,196) = b(k,196) - lu(k,1008) * b(k,166) - b(k,198) = b(k,198) - lu(k,1009) * b(k,166) - b(k,173) = b(k,173) - lu(k,1014) * b(k,167) - b(k,180) = b(k,180) - lu(k,1015) * b(k,167) - b(k,186) = b(k,186) - lu(k,1016) * b(k,167) - b(k,187) = b(k,187) - lu(k,1017) * b(k,167) - b(k,188) = b(k,188) - lu(k,1018) * b(k,167) - b(k,189) = b(k,189) - lu(k,1019) * b(k,167) - b(k,191) = b(k,191) - lu(k,1020) * b(k,167) - b(k,192) = b(k,192) - lu(k,1021) * b(k,167) - b(k,198) = b(k,198) - lu(k,1022) * b(k,167) - b(k,180) = b(k,180) - lu(k,1025) * b(k,168) - b(k,182) = b(k,182) - lu(k,1026) * b(k,168) - b(k,183) = b(k,183) - lu(k,1027) * b(k,168) - b(k,186) = b(k,186) - lu(k,1028) * b(k,168) - b(k,189) = b(k,189) - lu(k,1029) * b(k,168) - b(k,192) = b(k,192) - lu(k,1030) * b(k,168) - b(k,196) = b(k,196) - lu(k,1031) * b(k,168) - b(k,198) = b(k,198) - lu(k,1032) * b(k,168) - b(k,182) = b(k,182) - lu(k,1036) * b(k,169) - b(k,183) = b(k,183) - lu(k,1037) * b(k,169) - b(k,185) = b(k,185) - lu(k,1038) * b(k,169) - b(k,186) = b(k,186) - lu(k,1039) * b(k,169) - b(k,189) = b(k,189) - lu(k,1040) * b(k,169) - b(k,193) = b(k,193) - lu(k,1041) * b(k,169) - b(k,194) = b(k,194) - lu(k,1042) * b(k,169) - b(k,195) = b(k,195) - lu(k,1043) * b(k,169) - b(k,196) = b(k,196) - lu(k,1044) * b(k,169) - b(k,198) = b(k,198) - lu(k,1045) * b(k,169) - b(k,173) = b(k,173) - lu(k,1053) * b(k,170) - b(k,180) = b(k,180) - lu(k,1054) * b(k,170) - b(k,183) = b(k,183) - lu(k,1055) * b(k,170) - b(k,186) = b(k,186) - lu(k,1056) * b(k,170) - b(k,187) = b(k,187) - lu(k,1057) * b(k,170) - b(k,188) = b(k,188) - lu(k,1058) * b(k,170) - b(k,189) = b(k,189) - lu(k,1059) * b(k,170) - b(k,191) = b(k,191) - lu(k,1060) * b(k,170) - b(k,192) = b(k,192) - lu(k,1061) * b(k,170) - b(k,196) = b(k,196) - lu(k,1062) * b(k,170) - b(k,172) = b(k,172) - lu(k,1073) * b(k,171) - b(k,173) = b(k,173) - lu(k,1074) * b(k,171) - b(k,176) = b(k,176) - lu(k,1075) * b(k,171) - b(k,180) = b(k,180) - lu(k,1076) * b(k,171) - b(k,182) = b(k,182) - lu(k,1077) * b(k,171) - b(k,183) = b(k,183) - lu(k,1078) * b(k,171) - b(k,186) = b(k,186) - lu(k,1079) * b(k,171) - b(k,187) = b(k,187) - lu(k,1080) * b(k,171) - b(k,188) = b(k,188) - lu(k,1081) * b(k,171) - b(k,189) = b(k,189) - lu(k,1082) * b(k,171) - b(k,191) = b(k,191) - lu(k,1083) * b(k,171) - b(k,192) = b(k,192) - lu(k,1084) * b(k,171) - b(k,196) = b(k,196) - lu(k,1085) * b(k,171) - b(k,173) = b(k,173) - lu(k,1089) * b(k,172) - b(k,177) = b(k,177) - lu(k,1090) * b(k,172) - b(k,179) = b(k,179) - lu(k,1091) * b(k,172) - b(k,180) = b(k,180) - lu(k,1092) * b(k,172) - b(k,183) = b(k,183) - lu(k,1093) * b(k,172) - b(k,186) = b(k,186) - lu(k,1094) * b(k,172) - b(k,191) = b(k,191) - lu(k,1095) * b(k,172) - b(k,192) = b(k,192) - lu(k,1096) * b(k,172) - b(k,197) = b(k,197) - lu(k,1097) * b(k,172) - b(k,198) = b(k,198) - lu(k,1098) * b(k,172) - b(k,180) = b(k,180) - lu(k,1101) * b(k,173) - b(k,182) = b(k,182) - lu(k,1102) * b(k,173) - b(k,183) = b(k,183) - lu(k,1103) * b(k,173) - b(k,186) = b(k,186) - lu(k,1104) * b(k,173) - b(k,192) = b(k,192) - lu(k,1105) * b(k,173) - b(k,196) = b(k,196) - lu(k,1106) * b(k,173) - b(k,198) = b(k,198) - lu(k,1107) * b(k,173) - b(k,181) = b(k,181) - lu(k,1112) * b(k,174) - b(k,183) = b(k,183) - lu(k,1113) * b(k,174) - b(k,184) = b(k,184) - lu(k,1114) * b(k,174) - b(k,186) = b(k,186) - lu(k,1115) * b(k,174) - b(k,187) = b(k,187) - lu(k,1116) * b(k,174) - b(k,188) = b(k,188) - lu(k,1117) * b(k,174) - b(k,190) = b(k,190) - lu(k,1118) * b(k,174) - b(k,192) = b(k,192) - lu(k,1119) * b(k,174) - b(k,193) = b(k,193) - lu(k,1120) * b(k,174) - b(k,195) = b(k,195) - lu(k,1121) * b(k,174) - b(k,197) = b(k,197) - lu(k,1122) * b(k,174) - b(k,198) = b(k,198) - lu(k,1123) * b(k,174) - b(k,176) = b(k,176) - lu(k,1143) * b(k,175) - b(k,177) = b(k,177) - lu(k,1144) * b(k,175) - b(k,179) = b(k,179) - lu(k,1145) * b(k,175) - b(k,180) = b(k,180) - lu(k,1146) * b(k,175) - b(k,182) = b(k,182) - lu(k,1147) * b(k,175) - b(k,183) = b(k,183) - lu(k,1148) * b(k,175) - b(k,186) = b(k,186) - lu(k,1149) * b(k,175) - b(k,187) = b(k,187) - lu(k,1150) * b(k,175) - b(k,188) = b(k,188) - lu(k,1151) * b(k,175) - b(k,189) = b(k,189) - lu(k,1152) * b(k,175) - b(k,191) = b(k,191) - lu(k,1153) * b(k,175) - b(k,192) = b(k,192) - lu(k,1154) * b(k,175) - b(k,196) = b(k,196) - lu(k,1155) * b(k,175) - b(k,197) = b(k,197) - lu(k,1156) * b(k,175) - b(k,198) = b(k,198) - lu(k,1157) * b(k,175) - b(k,177) = b(k,177) - lu(k,1165) * b(k,176) - b(k,180) = b(k,180) - lu(k,1166) * b(k,176) - b(k,182) = b(k,182) - lu(k,1167) * b(k,176) - b(k,183) = b(k,183) - lu(k,1168) * b(k,176) - b(k,186) = b(k,186) - lu(k,1169) * b(k,176) - b(k,187) = b(k,187) - lu(k,1170) * b(k,176) - b(k,188) = b(k,188) - lu(k,1171) * b(k,176) - b(k,189) = b(k,189) - lu(k,1172) * b(k,176) - b(k,191) = b(k,191) - lu(k,1173) * b(k,176) - b(k,192) = b(k,192) - lu(k,1174) * b(k,176) - b(k,196) = b(k,196) - lu(k,1175) * b(k,176) - b(k,197) = b(k,197) - lu(k,1176) * b(k,176) - b(k,198) = b(k,198) - lu(k,1177) * b(k,176) - b(k,179) = b(k,179) - lu(k,1188) * b(k,177) - b(k,180) = b(k,180) - lu(k,1189) * b(k,177) - b(k,182) = b(k,182) - lu(k,1190) * b(k,177) - b(k,183) = b(k,183) - lu(k,1191) * b(k,177) - b(k,186) = b(k,186) - lu(k,1192) * b(k,177) - b(k,187) = b(k,187) - lu(k,1193) * b(k,177) - b(k,188) = b(k,188) - lu(k,1194) * b(k,177) - b(k,189) = b(k,189) - lu(k,1195) * b(k,177) - b(k,191) = b(k,191) - lu(k,1196) * b(k,177) - b(k,192) = b(k,192) - lu(k,1197) * b(k,177) - b(k,196) = b(k,196) - lu(k,1198) * b(k,177) - b(k,198) = b(k,198) - lu(k,1199) * b(k,177) - b(k,179) = b(k,179) - lu(k,1215) * b(k,178) - b(k,180) = b(k,180) - lu(k,1216) * b(k,178) - b(k,182) = b(k,182) - lu(k,1217) * b(k,178) - b(k,183) = b(k,183) - lu(k,1218) * b(k,178) - b(k,186) = b(k,186) - lu(k,1219) * b(k,178) - b(k,187) = b(k,187) - lu(k,1220) * b(k,178) - b(k,188) = b(k,188) - lu(k,1221) * b(k,178) - b(k,189) = b(k,189) - lu(k,1222) * b(k,178) - b(k,191) = b(k,191) - lu(k,1223) * b(k,178) - b(k,192) = b(k,192) - lu(k,1224) * b(k,178) - b(k,196) = b(k,196) - lu(k,1225) * b(k,178) - b(k,197) = b(k,197) - lu(k,1226) * b(k,178) - b(k,198) = b(k,198) - lu(k,1227) * b(k,178) + b(k,211) = b(k,211) - lu(k,885) * b(k,177) + b(k,215) = b(k,215) - lu(k,886) * b(k,177) + b(k,216) = b(k,216) - lu(k,887) * b(k,177) + b(k,219) = b(k,219) - lu(k,888) * b(k,177) + b(k,220) = b(k,220) - lu(k,889) * b(k,177) + b(k,223) = b(k,223) - lu(k,890) * b(k,177) + b(k,224) = b(k,224) - lu(k,891) * b(k,177) + b(k,226) = b(k,226) - lu(k,892) * b(k,177) + b(k,227) = b(k,227) - lu(k,893) * b(k,177) + b(k,180) = b(k,180) - lu(k,900) * b(k,178) + b(k,190) = b(k,190) - lu(k,901) * b(k,178) + b(k,207) = b(k,207) - lu(k,902) * b(k,178) + b(k,213) = b(k,213) - lu(k,903) * b(k,178) + b(k,215) = b(k,215) - lu(k,904) * b(k,178) + b(k,217) = b(k,217) - lu(k,905) * b(k,178) + b(k,218) = b(k,218) - lu(k,906) * b(k,178) + b(k,221) = b(k,221) - lu(k,907) * b(k,178) + b(k,224) = b(k,224) - lu(k,908) * b(k,178) + b(k,180) = b(k,180) - lu(k,913) * b(k,179) + b(k,183) = b(k,183) - lu(k,914) * b(k,179) + b(k,211) = b(k,211) - lu(k,915) * b(k,179) + b(k,213) = b(k,213) - lu(k,916) * b(k,179) + b(k,215) = b(k,215) - lu(k,917) * b(k,179) + b(k,217) = b(k,217) - lu(k,918) * b(k,179) + b(k,218) = b(k,218) - lu(k,919) * b(k,179) + b(k,221) = b(k,221) - lu(k,920) * b(k,179) + b(k,224) = b(k,224) - lu(k,921) * b(k,179) + b(k,194) = b(k,194) - lu(k,923) * b(k,180) + b(k,207) = b(k,207) - lu(k,924) * b(k,180) + b(k,215) = b(k,215) - lu(k,925) * b(k,180) + b(k,221) = b(k,221) - lu(k,926) * b(k,180) + b(k,227) = b(k,227) - lu(k,927) * b(k,180) + b(k,192) = b(k,192) - lu(k,930) * b(k,181) + b(k,215) = b(k,215) - lu(k,931) * b(k,181) + b(k,218) = b(k,218) - lu(k,932) * b(k,181) + b(k,226) = b(k,226) - lu(k,933) * b(k,181) + b(k,227) = b(k,227) - lu(k,934) * b(k,181) + b(k,183) = b(k,183) - lu(k,949) * b(k,182) + b(k,184) = b(k,184) - lu(k,950) * b(k,182) + b(k,187) = b(k,187) - lu(k,951) * b(k,182) + b(k,188) = b(k,188) - lu(k,952) * b(k,182) + b(k,190) = b(k,190) - lu(k,953) * b(k,182) + b(k,192) = b(k,192) - lu(k,954) * b(k,182) + b(k,194) = b(k,194) - lu(k,955) * b(k,182) + b(k,200) = b(k,200) - lu(k,956) * b(k,182) + b(k,207) = b(k,207) - lu(k,957) * b(k,182) + b(k,211) = b(k,211) - lu(k,958) * b(k,182) + b(k,213) = b(k,213) - lu(k,959) * b(k,182) + b(k,215) = b(k,215) - lu(k,960) * b(k,182) + b(k,216) = b(k,216) - lu(k,961) * b(k,182) + b(k,217) = b(k,217) - lu(k,962) * b(k,182) + b(k,218) = b(k,218) - lu(k,963) * b(k,182) + b(k,221) = b(k,221) - lu(k,964) * b(k,182) + b(k,222) = b(k,222) - lu(k,965) * b(k,182) + b(k,224) = b(k,224) - lu(k,966) * b(k,182) + b(k,226) = b(k,226) - lu(k,967) * b(k,182) + b(k,227) = b(k,227) - lu(k,968) * b(k,182) + b(k,187) = b(k,187) - lu(k,970) * b(k,183) + b(k,188) = b(k,188) - lu(k,971) * b(k,183) + b(k,192) = b(k,192) - lu(k,972) * b(k,183) + b(k,193) = b(k,193) - lu(k,973) * b(k,183) + b(k,215) = b(k,215) - lu(k,974) * b(k,183) + b(k,216) = b(k,216) - lu(k,975) * b(k,183) + b(k,218) = b(k,218) - lu(k,976) * b(k,183) + b(k,192) = b(k,192) - lu(k,980) * b(k,184) + b(k,215) = b(k,215) - lu(k,981) * b(k,184) + b(k,218) = b(k,218) - lu(k,982) * b(k,184) + b(k,226) = b(k,226) - lu(k,983) * b(k,184) + b(k,187) = b(k,187) - lu(k,1000) * b(k,185) + b(k,188) = b(k,188) - lu(k,1001) * b(k,185) + b(k,190) = b(k,190) - lu(k,1002) * b(k,185) + b(k,192) = b(k,192) - lu(k,1003) * b(k,185) + b(k,193) = b(k,193) - lu(k,1004) * b(k,185) + b(k,194) = b(k,194) - lu(k,1005) * b(k,185) + b(k,200) = b(k,200) - lu(k,1006) * b(k,185) + b(k,207) = b(k,207) - lu(k,1007) * b(k,185) + b(k,211) = b(k,211) - lu(k,1008) * b(k,185) + b(k,213) = b(k,213) - lu(k,1009) * b(k,185) + b(k,215) = b(k,215) - lu(k,1010) * b(k,185) + b(k,216) = b(k,216) - lu(k,1011) * b(k,185) + b(k,217) = b(k,217) - lu(k,1012) * b(k,185) + b(k,218) = b(k,218) - lu(k,1013) * b(k,185) + b(k,221) = b(k,221) - lu(k,1014) * b(k,185) + b(k,222) = b(k,222) - lu(k,1015) * b(k,185) + b(k,224) = b(k,224) - lu(k,1016) * b(k,185) + b(k,226) = b(k,226) - lu(k,1017) * b(k,185) + b(k,227) = b(k,227) - lu(k,1018) * b(k,185) + b(k,190) = b(k,190) - lu(k,1025) * b(k,186) + b(k,192) = b(k,192) - lu(k,1026) * b(k,186) + b(k,195) = b(k,195) - lu(k,1027) * b(k,186) + b(k,200) = b(k,200) - lu(k,1028) * b(k,186) + b(k,207) = b(k,207) - lu(k,1029) * b(k,186) + b(k,210) = b(k,210) - lu(k,1030) * b(k,186) + b(k,213) = b(k,213) - lu(k,1031) * b(k,186) + b(k,215) = b(k,215) - lu(k,1032) * b(k,186) + b(k,216) = b(k,216) - lu(k,1033) * b(k,186) + b(k,217) = b(k,217) - lu(k,1034) * b(k,186) + b(k,218) = b(k,218) - lu(k,1035) * b(k,186) + b(k,221) = b(k,221) - lu(k,1036) * b(k,186) + b(k,222) = b(k,222) - lu(k,1037) * b(k,186) + b(k,224) = b(k,224) - lu(k,1038) * b(k,186) + b(k,226) = b(k,226) - lu(k,1039) * b(k,186) + b(k,227) = b(k,227) - lu(k,1040) * b(k,186) + b(k,188) = b(k,188) - lu(k,1046) * b(k,187) + b(k,192) = b(k,192) - lu(k,1047) * b(k,187) + b(k,193) = b(k,193) - lu(k,1048) * b(k,187) + b(k,211) = b(k,211) - lu(k,1049) * b(k,187) + b(k,213) = b(k,213) - lu(k,1050) * b(k,187) + b(k,215) = b(k,215) - lu(k,1051) * b(k,187) + b(k,216) = b(k,216) - lu(k,1052) * b(k,187) + b(k,217) = b(k,217) - lu(k,1053) * b(k,187) + b(k,218) = b(k,218) - lu(k,1054) * b(k,187) + b(k,221) = b(k,221) - lu(k,1055) * b(k,187) + b(k,224) = b(k,224) - lu(k,1056) * b(k,187) + b(k,192) = b(k,192) - lu(k,1060) * b(k,188) + b(k,194) = b(k,194) - lu(k,1061) * b(k,188) + b(k,207) = b(k,207) - lu(k,1062) * b(k,188) + b(k,213) = b(k,213) - lu(k,1063) * b(k,188) + b(k,215) = b(k,215) - lu(k,1064) * b(k,188) + b(k,218) = b(k,218) - lu(k,1065) * b(k,188) + b(k,221) = b(k,221) - lu(k,1066) * b(k,188) + b(k,226) = b(k,226) - lu(k,1067) * b(k,188) + b(k,227) = b(k,227) - lu(k,1068) * b(k,188) + b(k,192) = b(k,192) - lu(k,1074) * b(k,189) + b(k,200) = b(k,200) - lu(k,1075) * b(k,189) + b(k,207) = b(k,207) - lu(k,1076) * b(k,189) + b(k,211) = b(k,211) - lu(k,1077) * b(k,189) + b(k,213) = b(k,213) - lu(k,1078) * b(k,189) + b(k,215) = b(k,215) - lu(k,1079) * b(k,189) + b(k,217) = b(k,217) - lu(k,1080) * b(k,189) + b(k,218) = b(k,218) - lu(k,1081) * b(k,189) + b(k,221) = b(k,221) - lu(k,1082) * b(k,189) + b(k,224) = b(k,224) - lu(k,1083) * b(k,189) + b(k,226) = b(k,226) - lu(k,1084) * b(k,189) + b(k,192) = b(k,192) - lu(k,1086) * b(k,190) + b(k,207) = b(k,207) - lu(k,1087) * b(k,190) + b(k,211) = b(k,211) - lu(k,1088) * b(k,190) + b(k,215) = b(k,215) - lu(k,1089) * b(k,190) + b(k,216) = b(k,216) - lu(k,1090) * b(k,190) + b(k,218) = b(k,218) - lu(k,1091) * b(k,190) + b(k,221) = b(k,221) - lu(k,1092) * b(k,190) + b(k,227) = b(k,227) - lu(k,1093) * b(k,190) + b(k,192) = b(k,192) - lu(k,1097) * b(k,191) + b(k,213) = b(k,213) - lu(k,1098) * b(k,191) + b(k,215) = b(k,215) - lu(k,1099) * b(k,191) + b(k,218) = b(k,218) - lu(k,1100) * b(k,191) + b(k,226) = b(k,226) - lu(k,1101) * b(k,191) + b(k,215) = b(k,215) - lu(k,1104) * b(k,192) + b(k,218) = b(k,218) - lu(k,1105) * b(k,192) + b(k,226) = b(k,226) - lu(k,1106) * b(k,192) + b(k,194) = b(k,194) - lu(k,1116) * b(k,193) + b(k,207) = b(k,207) - lu(k,1117) * b(k,193) + b(k,211) = b(k,211) - lu(k,1118) * b(k,193) + b(k,213) = b(k,213) - lu(k,1119) * b(k,193) + b(k,215) = b(k,215) - lu(k,1120) * b(k,193) + b(k,217) = b(k,217) - lu(k,1121) * b(k,193) + b(k,218) = b(k,218) - lu(k,1122) * b(k,193) + b(k,221) = b(k,221) - lu(k,1123) * b(k,193) + b(k,224) = b(k,224) - lu(k,1124) * b(k,193) + b(k,226) = b(k,226) - lu(k,1125) * b(k,193) + b(k,227) = b(k,227) - lu(k,1126) * b(k,193) + b(k,195) = b(k,195) - lu(k,1130) * b(k,194) + b(k,200) = b(k,200) - lu(k,1131) * b(k,194) + b(k,207) = b(k,207) - lu(k,1132) * b(k,194) + b(k,213) = b(k,213) - lu(k,1133) * b(k,194) + b(k,215) = b(k,215) - lu(k,1134) * b(k,194) + b(k,217) = b(k,217) - lu(k,1135) * b(k,194) + b(k,218) = b(k,218) - lu(k,1136) * b(k,194) + b(k,221) = b(k,221) - lu(k,1137) * b(k,194) + b(k,224) = b(k,224) - lu(k,1138) * b(k,194) + b(k,227) = b(k,227) - lu(k,1139) * b(k,194) + b(k,200) = b(k,200) - lu(k,1141) * b(k,195) + b(k,207) = b(k,207) - lu(k,1142) * b(k,195) + b(k,213) = b(k,213) - lu(k,1143) * b(k,195) + b(k,215) = b(k,215) - lu(k,1144) * b(k,195) + b(k,218) = b(k,218) - lu(k,1145) * b(k,195) + b(k,200) = b(k,200) - lu(k,1154) * b(k,196) + b(k,207) = b(k,207) - lu(k,1155) * b(k,196) + b(k,211) = b(k,211) - lu(k,1156) * b(k,196) + b(k,213) = b(k,213) - lu(k,1157) * b(k,196) + b(k,215) = b(k,215) - lu(k,1158) * b(k,196) + b(k,216) = b(k,216) - lu(k,1159) * b(k,196) + b(k,217) = b(k,217) - lu(k,1160) * b(k,196) + b(k,218) = b(k,218) - lu(k,1161) * b(k,196) + b(k,221) = b(k,221) - lu(k,1162) * b(k,196) + b(k,224) = b(k,224) - lu(k,1163) * b(k,196) + b(k,226) = b(k,226) - lu(k,1164) * b(k,196) + b(k,227) = b(k,227) - lu(k,1165) * b(k,196) + b(k,200) = b(k,200) - lu(k,1174) * b(k,197) + b(k,207) = b(k,207) - lu(k,1175) * b(k,197) + b(k,213) = b(k,213) - lu(k,1176) * b(k,197) + b(k,215) = b(k,215) - lu(k,1177) * b(k,197) + b(k,216) = b(k,216) - lu(k,1178) * b(k,197) + b(k,217) = b(k,217) - lu(k,1179) * b(k,197) + b(k,218) = b(k,218) - lu(k,1180) * b(k,197) + b(k,221) = b(k,221) - lu(k,1181) * b(k,197) + b(k,224) = b(k,224) - lu(k,1182) * b(k,197) + b(k,226) = b(k,226) - lu(k,1183) * b(k,197) + b(k,199) = b(k,199) - lu(k,1194) * b(k,198) + b(k,200) = b(k,200) - lu(k,1195) * b(k,198) + b(k,205) = b(k,205) - lu(k,1196) * b(k,198) + b(k,207) = b(k,207) - lu(k,1197) * b(k,198) + b(k,211) = b(k,211) - lu(k,1198) * b(k,198) + b(k,213) = b(k,213) - lu(k,1199) * b(k,198) + b(k,215) = b(k,215) - lu(k,1200) * b(k,198) + b(k,216) = b(k,216) - lu(k,1201) * b(k,198) + b(k,217) = b(k,217) - lu(k,1202) * b(k,198) + b(k,218) = b(k,218) - lu(k,1203) * b(k,198) + b(k,221) = b(k,221) - lu(k,1204) * b(k,198) + b(k,224) = b(k,224) - lu(k,1205) * b(k,198) + b(k,226) = b(k,226) - lu(k,1206) * b(k,198) end do end subroutine lu_slv04 subroutine lu_slv05( avec_len, lu, b ) @@ -920,164 +922,209 @@ subroutine lu_slv05( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,180) = b(k,180) - lu(k,1234) * b(k,179) - b(k,182) = b(k,182) - lu(k,1235) * b(k,179) - b(k,183) = b(k,183) - lu(k,1236) * b(k,179) - b(k,186) = b(k,186) - lu(k,1237) * b(k,179) - b(k,187) = b(k,187) - lu(k,1238) * b(k,179) - b(k,188) = b(k,188) - lu(k,1239) * b(k,179) - b(k,189) = b(k,189) - lu(k,1240) * b(k,179) - b(k,191) = b(k,191) - lu(k,1241) * b(k,179) - b(k,192) = b(k,192) - lu(k,1242) * b(k,179) - b(k,196) = b(k,196) - lu(k,1243) * b(k,179) - b(k,197) = b(k,197) - lu(k,1244) * b(k,179) - b(k,198) = b(k,198) - lu(k,1245) * b(k,179) - b(k,182) = b(k,182) - lu(k,1265) * b(k,180) - b(k,183) = b(k,183) - lu(k,1266) * b(k,180) - b(k,186) = b(k,186) - lu(k,1267) * b(k,180) - b(k,187) = b(k,187) - lu(k,1268) * b(k,180) - b(k,188) = b(k,188) - lu(k,1269) * b(k,180) - b(k,189) = b(k,189) - lu(k,1270) * b(k,180) - b(k,191) = b(k,191) - lu(k,1271) * b(k,180) - b(k,192) = b(k,192) - lu(k,1272) * b(k,180) - b(k,196) = b(k,196) - lu(k,1273) * b(k,180) - b(k,197) = b(k,197) - lu(k,1274) * b(k,180) - b(k,198) = b(k,198) - lu(k,1275) * b(k,180) - b(k,183) = b(k,183) - lu(k,1279) * b(k,181) - b(k,185) = b(k,185) - lu(k,1280) * b(k,181) - b(k,186) = b(k,186) - lu(k,1281) * b(k,181) - b(k,190) = b(k,190) - lu(k,1282) * b(k,181) - b(k,191) = b(k,191) - lu(k,1283) * b(k,181) - b(k,192) = b(k,192) - lu(k,1284) * b(k,181) - b(k,193) = b(k,193) - lu(k,1285) * b(k,181) - b(k,197) = b(k,197) - lu(k,1286) * b(k,181) - b(k,198) = b(k,198) - lu(k,1287) * b(k,181) - b(k,183) = b(k,183) - lu(k,1292) * b(k,182) - b(k,185) = b(k,185) - lu(k,1293) * b(k,182) - b(k,186) = b(k,186) - lu(k,1294) * b(k,182) - b(k,187) = b(k,187) - lu(k,1295) * b(k,182) - b(k,189) = b(k,189) - lu(k,1296) * b(k,182) - b(k,193) = b(k,193) - lu(k,1297) * b(k,182) - b(k,194) = b(k,194) - lu(k,1298) * b(k,182) - b(k,195) = b(k,195) - lu(k,1299) * b(k,182) - b(k,196) = b(k,196) - lu(k,1300) * b(k,182) - b(k,198) = b(k,198) - lu(k,1301) * b(k,182) - b(k,185) = b(k,185) - lu(k,1305) * b(k,183) - b(k,186) = b(k,186) - lu(k,1306) * b(k,183) - b(k,187) = b(k,187) - lu(k,1307) * b(k,183) - b(k,189) = b(k,189) - lu(k,1308) * b(k,183) - b(k,192) = b(k,192) - lu(k,1309) * b(k,183) - b(k,193) = b(k,193) - lu(k,1310) * b(k,183) - b(k,194) = b(k,194) - lu(k,1311) * b(k,183) - b(k,195) = b(k,195) - lu(k,1312) * b(k,183) - b(k,196) = b(k,196) - lu(k,1313) * b(k,183) - b(k,197) = b(k,197) - lu(k,1314) * b(k,183) - b(k,198) = b(k,198) - lu(k,1315) * b(k,183) - b(k,185) = b(k,185) - lu(k,1328) * b(k,184) - b(k,186) = b(k,186) - lu(k,1329) * b(k,184) - b(k,187) = b(k,187) - lu(k,1330) * b(k,184) - b(k,188) = b(k,188) - lu(k,1331) * b(k,184) - b(k,189) = b(k,189) - lu(k,1332) * b(k,184) - b(k,190) = b(k,190) - lu(k,1333) * b(k,184) - b(k,191) = b(k,191) - lu(k,1334) * b(k,184) - b(k,192) = b(k,192) - lu(k,1335) * b(k,184) - b(k,193) = b(k,193) - lu(k,1336) * b(k,184) - b(k,194) = b(k,194) - lu(k,1337) * b(k,184) - b(k,195) = b(k,195) - lu(k,1338) * b(k,184) - b(k,196) = b(k,196) - lu(k,1339) * b(k,184) - b(k,197) = b(k,197) - lu(k,1340) * b(k,184) - b(k,198) = b(k,198) - lu(k,1341) * b(k,184) - b(k,186) = b(k,186) - lu(k,1353) * b(k,185) - b(k,187) = b(k,187) - lu(k,1354) * b(k,185) - b(k,188) = b(k,188) - lu(k,1355) * b(k,185) - b(k,189) = b(k,189) - lu(k,1356) * b(k,185) - b(k,190) = b(k,190) - lu(k,1357) * b(k,185) - b(k,191) = b(k,191) - lu(k,1358) * b(k,185) - b(k,192) = b(k,192) - lu(k,1359) * b(k,185) - b(k,193) = b(k,193) - lu(k,1360) * b(k,185) - b(k,194) = b(k,194) - lu(k,1361) * b(k,185) - b(k,195) = b(k,195) - lu(k,1362) * b(k,185) - b(k,196) = b(k,196) - lu(k,1363) * b(k,185) - b(k,197) = b(k,197) - lu(k,1364) * b(k,185) - b(k,198) = b(k,198) - lu(k,1365) * b(k,185) - b(k,187) = b(k,187) - lu(k,1508) * b(k,186) - b(k,188) = b(k,188) - lu(k,1509) * b(k,186) - b(k,189) = b(k,189) - lu(k,1510) * b(k,186) - b(k,190) = b(k,190) - lu(k,1511) * b(k,186) - b(k,191) = b(k,191) - lu(k,1512) * b(k,186) - b(k,192) = b(k,192) - lu(k,1513) * b(k,186) - b(k,193) = b(k,193) - lu(k,1514) * b(k,186) - b(k,194) = b(k,194) - lu(k,1515) * b(k,186) - b(k,195) = b(k,195) - lu(k,1516) * b(k,186) - b(k,196) = b(k,196) - lu(k,1517) * b(k,186) - b(k,197) = b(k,197) - lu(k,1518) * b(k,186) - b(k,198) = b(k,198) - lu(k,1519) * b(k,186) - b(k,188) = b(k,188) - lu(k,1550) * b(k,187) - b(k,189) = b(k,189) - lu(k,1551) * b(k,187) - b(k,190) = b(k,190) - lu(k,1552) * b(k,187) - b(k,191) = b(k,191) - lu(k,1553) * b(k,187) - b(k,192) = b(k,192) - lu(k,1554) * b(k,187) - b(k,193) = b(k,193) - lu(k,1555) * b(k,187) - b(k,194) = b(k,194) - lu(k,1556) * b(k,187) - b(k,195) = b(k,195) - lu(k,1557) * b(k,187) - b(k,196) = b(k,196) - lu(k,1558) * b(k,187) - b(k,197) = b(k,197) - lu(k,1559) * b(k,187) - b(k,198) = b(k,198) - lu(k,1560) * b(k,187) - b(k,189) = b(k,189) - lu(k,1641) * b(k,188) - b(k,190) = b(k,190) - lu(k,1642) * b(k,188) - b(k,191) = b(k,191) - lu(k,1643) * b(k,188) - b(k,192) = b(k,192) - lu(k,1644) * b(k,188) - b(k,193) = b(k,193) - lu(k,1645) * b(k,188) - b(k,194) = b(k,194) - lu(k,1646) * b(k,188) - b(k,195) = b(k,195) - lu(k,1647) * b(k,188) - b(k,196) = b(k,196) - lu(k,1648) * b(k,188) - b(k,197) = b(k,197) - lu(k,1649) * b(k,188) - b(k,198) = b(k,198) - lu(k,1650) * b(k,188) - b(k,190) = b(k,190) - lu(k,1692) * b(k,189) - b(k,191) = b(k,191) - lu(k,1693) * b(k,189) - b(k,192) = b(k,192) - lu(k,1694) * b(k,189) - b(k,193) = b(k,193) - lu(k,1695) * b(k,189) - b(k,194) = b(k,194) - lu(k,1696) * b(k,189) - b(k,195) = b(k,195) - lu(k,1697) * b(k,189) - b(k,196) = b(k,196) - lu(k,1698) * b(k,189) - b(k,197) = b(k,197) - lu(k,1699) * b(k,189) - b(k,198) = b(k,198) - lu(k,1700) * b(k,189) - b(k,191) = b(k,191) - lu(k,1717) * b(k,190) - b(k,192) = b(k,192) - lu(k,1718) * b(k,190) - b(k,193) = b(k,193) - lu(k,1719) * b(k,190) - b(k,194) = b(k,194) - lu(k,1720) * b(k,190) - b(k,195) = b(k,195) - lu(k,1721) * b(k,190) - b(k,196) = b(k,196) - lu(k,1722) * b(k,190) - b(k,197) = b(k,197) - lu(k,1723) * b(k,190) - b(k,198) = b(k,198) - lu(k,1724) * b(k,190) - b(k,192) = b(k,192) - lu(k,1740) * b(k,191) - b(k,193) = b(k,193) - lu(k,1741) * b(k,191) - b(k,194) = b(k,194) - lu(k,1742) * b(k,191) - b(k,195) = b(k,195) - lu(k,1743) * b(k,191) - b(k,196) = b(k,196) - lu(k,1744) * b(k,191) - b(k,197) = b(k,197) - lu(k,1745) * b(k,191) - b(k,198) = b(k,198) - lu(k,1746) * b(k,191) - b(k,193) = b(k,193) - lu(k,1846) * b(k,192) - b(k,194) = b(k,194) - lu(k,1847) * b(k,192) - b(k,195) = b(k,195) - lu(k,1848) * b(k,192) - b(k,196) = b(k,196) - lu(k,1849) * b(k,192) - b(k,197) = b(k,197) - lu(k,1850) * b(k,192) - b(k,198) = b(k,198) - lu(k,1851) * b(k,192) - b(k,194) = b(k,194) - lu(k,1877) * b(k,193) - b(k,195) = b(k,195) - lu(k,1878) * b(k,193) - b(k,196) = b(k,196) - lu(k,1879) * b(k,193) - b(k,197) = b(k,197) - lu(k,1880) * b(k,193) - b(k,198) = b(k,198) - lu(k,1881) * b(k,193) - b(k,195) = b(k,195) - lu(k,1901) * b(k,194) - b(k,196) = b(k,196) - lu(k,1902) * b(k,194) - b(k,197) = b(k,197) - lu(k,1903) * b(k,194) - b(k,198) = b(k,198) - lu(k,1904) * b(k,194) - b(k,196) = b(k,196) - lu(k,1936) * b(k,195) - b(k,197) = b(k,197) - lu(k,1937) * b(k,195) - b(k,198) = b(k,198) - lu(k,1938) * b(k,195) - b(k,197) = b(k,197) - lu(k,1994) * b(k,196) - b(k,198) = b(k,198) - lu(k,1995) * b(k,196) - b(k,198) = b(k,198) - lu(k,2055) * b(k,197) + b(k,200) = b(k,200) - lu(k,1210) * b(k,199) + b(k,204) = b(k,204) - lu(k,1211) * b(k,199) + b(k,206) = b(k,206) - lu(k,1212) * b(k,199) + b(k,207) = b(k,207) - lu(k,1213) * b(k,199) + b(k,213) = b(k,213) - lu(k,1214) * b(k,199) + b(k,215) = b(k,215) - lu(k,1215) * b(k,199) + b(k,218) = b(k,218) - lu(k,1216) * b(k,199) + b(k,222) = b(k,222) - lu(k,1217) * b(k,199) + b(k,226) = b(k,226) - lu(k,1218) * b(k,199) + b(k,227) = b(k,227) - lu(k,1219) * b(k,199) + b(k,207) = b(k,207) - lu(k,1222) * b(k,200) + b(k,211) = b(k,211) - lu(k,1223) * b(k,200) + b(k,215) = b(k,215) - lu(k,1224) * b(k,200) + b(k,216) = b(k,216) - lu(k,1225) * b(k,200) + b(k,218) = b(k,218) - lu(k,1226) * b(k,200) + b(k,226) = b(k,226) - lu(k,1227) * b(k,200) + b(k,227) = b(k,227) - lu(k,1228) * b(k,200) + b(k,209) = b(k,209) - lu(k,1233) * b(k,201) + b(k,212) = b(k,212) - lu(k,1234) * b(k,201) + b(k,215) = b(k,215) - lu(k,1235) * b(k,201) + b(k,217) = b(k,217) - lu(k,1236) * b(k,201) + b(k,218) = b(k,218) - lu(k,1237) * b(k,201) + b(k,219) = b(k,219) - lu(k,1238) * b(k,201) + b(k,220) = b(k,220) - lu(k,1239) * b(k,201) + b(k,222) = b(k,222) - lu(k,1240) * b(k,201) + b(k,224) = b(k,224) - lu(k,1241) * b(k,201) + b(k,225) = b(k,225) - lu(k,1242) * b(k,201) + b(k,226) = b(k,226) - lu(k,1243) * b(k,201) + b(k,227) = b(k,227) - lu(k,1244) * b(k,201) + b(k,204) = b(k,204) - lu(k,1257) * b(k,202) + b(k,205) = b(k,205) - lu(k,1258) * b(k,202) + b(k,206) = b(k,206) - lu(k,1259) * b(k,202) + b(k,207) = b(k,207) - lu(k,1260) * b(k,202) + b(k,211) = b(k,211) - lu(k,1261) * b(k,202) + b(k,213) = b(k,213) - lu(k,1262) * b(k,202) + b(k,215) = b(k,215) - lu(k,1263) * b(k,202) + b(k,216) = b(k,216) - lu(k,1264) * b(k,202) + b(k,217) = b(k,217) - lu(k,1265) * b(k,202) + b(k,218) = b(k,218) - lu(k,1266) * b(k,202) + b(k,221) = b(k,221) - lu(k,1267) * b(k,202) + b(k,222) = b(k,222) - lu(k,1268) * b(k,202) + b(k,224) = b(k,224) - lu(k,1269) * b(k,202) + b(k,226) = b(k,226) - lu(k,1270) * b(k,202) + b(k,227) = b(k,227) - lu(k,1271) * b(k,202) + b(k,204) = b(k,204) - lu(k,1289) * b(k,203) + b(k,205) = b(k,205) - lu(k,1290) * b(k,203) + b(k,206) = b(k,206) - lu(k,1291) * b(k,203) + b(k,207) = b(k,207) - lu(k,1292) * b(k,203) + b(k,211) = b(k,211) - lu(k,1293) * b(k,203) + b(k,213) = b(k,213) - lu(k,1294) * b(k,203) + b(k,215) = b(k,215) - lu(k,1295) * b(k,203) + b(k,216) = b(k,216) - lu(k,1296) * b(k,203) + b(k,217) = b(k,217) - lu(k,1297) * b(k,203) + b(k,218) = b(k,218) - lu(k,1298) * b(k,203) + b(k,221) = b(k,221) - lu(k,1299) * b(k,203) + b(k,222) = b(k,222) - lu(k,1300) * b(k,203) + b(k,224) = b(k,224) - lu(k,1301) * b(k,203) + b(k,226) = b(k,226) - lu(k,1302) * b(k,203) + b(k,227) = b(k,227) - lu(k,1303) * b(k,203) + b(k,206) = b(k,206) - lu(k,1312) * b(k,204) + b(k,207) = b(k,207) - lu(k,1313) * b(k,204) + b(k,211) = b(k,211) - lu(k,1314) * b(k,204) + b(k,213) = b(k,213) - lu(k,1315) * b(k,204) + b(k,215) = b(k,215) - lu(k,1316) * b(k,204) + b(k,216) = b(k,216) - lu(k,1317) * b(k,204) + b(k,217) = b(k,217) - lu(k,1318) * b(k,204) + b(k,218) = b(k,218) - lu(k,1319) * b(k,204) + b(k,221) = b(k,221) - lu(k,1320) * b(k,204) + b(k,224) = b(k,224) - lu(k,1321) * b(k,204) + b(k,226) = b(k,226) - lu(k,1322) * b(k,204) + b(k,227) = b(k,227) - lu(k,1323) * b(k,204) + b(k,206) = b(k,206) - lu(k,1333) * b(k,205) + b(k,207) = b(k,207) - lu(k,1334) * b(k,205) + b(k,210) = b(k,210) - lu(k,1335) * b(k,205) + b(k,211) = b(k,211) - lu(k,1336) * b(k,205) + b(k,213) = b(k,213) - lu(k,1337) * b(k,205) + b(k,215) = b(k,215) - lu(k,1338) * b(k,205) + b(k,216) = b(k,216) - lu(k,1339) * b(k,205) + b(k,217) = b(k,217) - lu(k,1340) * b(k,205) + b(k,218) = b(k,218) - lu(k,1341) * b(k,205) + b(k,221) = b(k,221) - lu(k,1342) * b(k,205) + b(k,222) = b(k,222) - lu(k,1343) * b(k,205) + b(k,224) = b(k,224) - lu(k,1344) * b(k,205) + b(k,226) = b(k,226) - lu(k,1345) * b(k,205) + b(k,227) = b(k,227) - lu(k,1346) * b(k,205) + b(k,207) = b(k,207) - lu(k,1355) * b(k,206) + b(k,211) = b(k,211) - lu(k,1356) * b(k,206) + b(k,213) = b(k,213) - lu(k,1357) * b(k,206) + b(k,215) = b(k,215) - lu(k,1358) * b(k,206) + b(k,216) = b(k,216) - lu(k,1359) * b(k,206) + b(k,217) = b(k,217) - lu(k,1360) * b(k,206) + b(k,218) = b(k,218) - lu(k,1361) * b(k,206) + b(k,221) = b(k,221) - lu(k,1362) * b(k,206) + b(k,222) = b(k,222) - lu(k,1363) * b(k,206) + b(k,224) = b(k,224) - lu(k,1364) * b(k,206) + b(k,226) = b(k,226) - lu(k,1365) * b(k,206) + b(k,227) = b(k,227) - lu(k,1366) * b(k,206) + b(k,210) = b(k,210) - lu(k,1387) * b(k,207) + b(k,211) = b(k,211) - lu(k,1388) * b(k,207) + b(k,213) = b(k,213) - lu(k,1389) * b(k,207) + b(k,215) = b(k,215) - lu(k,1390) * b(k,207) + b(k,216) = b(k,216) - lu(k,1391) * b(k,207) + b(k,217) = b(k,217) - lu(k,1392) * b(k,207) + b(k,218) = b(k,218) - lu(k,1393) * b(k,207) + b(k,221) = b(k,221) - lu(k,1394) * b(k,207) + b(k,222) = b(k,222) - lu(k,1395) * b(k,207) + b(k,224) = b(k,224) - lu(k,1396) * b(k,207) + b(k,226) = b(k,226) - lu(k,1397) * b(k,207) + b(k,227) = b(k,227) - lu(k,1398) * b(k,207) + b(k,210) = b(k,210) - lu(k,1402) * b(k,208) + b(k,211) = b(k,211) - lu(k,1403) * b(k,208) + b(k,212) = b(k,212) - lu(k,1404) * b(k,208) + b(k,214) = b(k,214) - lu(k,1405) * b(k,208) + b(k,215) = b(k,215) - lu(k,1406) * b(k,208) + b(k,216) = b(k,216) - lu(k,1407) * b(k,208) + b(k,220) = b(k,220) - lu(k,1408) * b(k,208) + b(k,221) = b(k,221) - lu(k,1409) * b(k,208) + b(k,223) = b(k,223) - lu(k,1410) * b(k,208) + b(k,226) = b(k,226) - lu(k,1411) * b(k,208) + b(k,227) = b(k,227) - lu(k,1412) * b(k,208) + b(k,212) = b(k,212) - lu(k,1416) * b(k,209) + b(k,213) = b(k,213) - lu(k,1417) * b(k,209) + b(k,214) = b(k,214) - lu(k,1418) * b(k,209) + b(k,215) = b(k,215) - lu(k,1419) * b(k,209) + b(k,218) = b(k,218) - lu(k,1420) * b(k,209) + b(k,222) = b(k,222) - lu(k,1421) * b(k,209) + b(k,225) = b(k,225) - lu(k,1422) * b(k,209) + b(k,226) = b(k,226) - lu(k,1423) * b(k,209) + b(k,227) = b(k,227) - lu(k,1424) * b(k,209) + b(k,211) = b(k,211) - lu(k,1431) * b(k,210) + b(k,212) = b(k,212) - lu(k,1432) * b(k,210) + b(k,213) = b(k,213) - lu(k,1433) * b(k,210) + b(k,214) = b(k,214) - lu(k,1434) * b(k,210) + b(k,215) = b(k,215) - lu(k,1435) * b(k,210) + b(k,216) = b(k,216) - lu(k,1436) * b(k,210) + b(k,218) = b(k,218) - lu(k,1437) * b(k,210) + b(k,220) = b(k,220) - lu(k,1438) * b(k,210) + b(k,221) = b(k,221) - lu(k,1439) * b(k,210) + b(k,223) = b(k,223) - lu(k,1440) * b(k,210) + b(k,226) = b(k,226) - lu(k,1441) * b(k,210) + b(k,227) = b(k,227) - lu(k,1442) * b(k,210) + b(k,212) = b(k,212) - lu(k,1448) * b(k,211) + b(k,213) = b(k,213) - lu(k,1449) * b(k,211) + b(k,214) = b(k,214) - lu(k,1450) * b(k,211) + b(k,215) = b(k,215) - lu(k,1451) * b(k,211) + b(k,216) = b(k,216) - lu(k,1452) * b(k,211) + b(k,218) = b(k,218) - lu(k,1453) * b(k,211) + b(k,220) = b(k,220) - lu(k,1454) * b(k,211) + b(k,221) = b(k,221) - lu(k,1455) * b(k,211) + b(k,223) = b(k,223) - lu(k,1456) * b(k,211) + b(k,224) = b(k,224) - lu(k,1457) * b(k,211) + b(k,226) = b(k,226) - lu(k,1458) * b(k,211) + b(k,227) = b(k,227) - lu(k,1459) * b(k,211) + b(k,213) = b(k,213) - lu(k,1464) * b(k,212) + b(k,214) = b(k,214) - lu(k,1465) * b(k,212) + b(k,215) = b(k,215) - lu(k,1466) * b(k,212) + b(k,216) = b(k,216) - lu(k,1467) * b(k,212) + b(k,218) = b(k,218) - lu(k,1468) * b(k,212) + b(k,220) = b(k,220) - lu(k,1469) * b(k,212) + b(k,221) = b(k,221) - lu(k,1470) * b(k,212) + b(k,222) = b(k,222) - lu(k,1471) * b(k,212) + b(k,223) = b(k,223) - lu(k,1472) * b(k,212) + b(k,224) = b(k,224) - lu(k,1473) * b(k,212) + b(k,226) = b(k,226) - lu(k,1474) * b(k,212) + b(k,227) = b(k,227) - lu(k,1475) * b(k,212) + b(k,214) = b(k,214) - lu(k,1486) * b(k,213) + b(k,215) = b(k,215) - lu(k,1487) * b(k,213) + b(k,216) = b(k,216) - lu(k,1488) * b(k,213) + b(k,217) = b(k,217) - lu(k,1489) * b(k,213) + b(k,218) = b(k,218) - lu(k,1490) * b(k,213) + b(k,220) = b(k,220) - lu(k,1491) * b(k,213) + b(k,221) = b(k,221) - lu(k,1492) * b(k,213) + b(k,222) = b(k,222) - lu(k,1493) * b(k,213) + b(k,223) = b(k,223) - lu(k,1494) * b(k,213) + b(k,224) = b(k,224) - lu(k,1495) * b(k,213) + b(k,225) = b(k,225) - lu(k,1496) * b(k,213) + b(k,226) = b(k,226) - lu(k,1497) * b(k,213) + b(k,227) = b(k,227) - lu(k,1498) * b(k,213) + b(k,215) = b(k,215) - lu(k,1527) * b(k,214) + b(k,216) = b(k,216) - lu(k,1528) * b(k,214) + b(k,217) = b(k,217) - lu(k,1529) * b(k,214) + b(k,218) = b(k,218) - lu(k,1530) * b(k,214) + b(k,219) = b(k,219) - lu(k,1531) * b(k,214) + b(k,220) = b(k,220) - lu(k,1532) * b(k,214) + b(k,221) = b(k,221) - lu(k,1533) * b(k,214) + b(k,222) = b(k,222) - lu(k,1534) * b(k,214) + b(k,223) = b(k,223) - lu(k,1535) * b(k,214) + b(k,224) = b(k,224) - lu(k,1536) * b(k,214) + b(k,225) = b(k,225) - lu(k,1537) * b(k,214) + b(k,226) = b(k,226) - lu(k,1538) * b(k,214) + b(k,227) = b(k,227) - lu(k,1539) * b(k,214) + b(k,216) = b(k,216) - lu(k,1692) * b(k,215) + b(k,217) = b(k,217) - lu(k,1693) * b(k,215) + b(k,218) = b(k,218) - lu(k,1694) * b(k,215) + b(k,219) = b(k,219) - lu(k,1695) * b(k,215) + b(k,220) = b(k,220) - lu(k,1696) * b(k,215) + b(k,221) = b(k,221) - lu(k,1697) * b(k,215) + b(k,222) = b(k,222) - lu(k,1698) * b(k,215) + b(k,223) = b(k,223) - lu(k,1699) * b(k,215) + b(k,224) = b(k,224) - lu(k,1700) * b(k,215) + b(k,225) = b(k,225) - lu(k,1701) * b(k,215) + b(k,226) = b(k,226) - lu(k,1702) * b(k,215) + b(k,227) = b(k,227) - lu(k,1703) * b(k,215) end do end subroutine lu_slv05 subroutine lu_slv06( avec_len, lu, b ) @@ -1098,223 +1145,72 @@ subroutine lu_slv06( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len -!----------------------------------------------------------------------- -! ... Solve U * x = y -!----------------------------------------------------------------------- - b(k,198) = b(k,198) * lu(k,2080) - b(k,197) = b(k,197) - lu(k,2079) * b(k,198) - b(k,196) = b(k,196) - lu(k,2078) * b(k,198) - b(k,195) = b(k,195) - lu(k,2077) * b(k,198) - b(k,194) = b(k,194) - lu(k,2076) * b(k,198) - b(k,193) = b(k,193) - lu(k,2075) * b(k,198) - b(k,192) = b(k,192) - lu(k,2074) * b(k,198) - b(k,191) = b(k,191) - lu(k,2073) * b(k,198) - b(k,190) = b(k,190) - lu(k,2072) * b(k,198) - b(k,189) = b(k,189) - lu(k,2071) * b(k,198) - b(k,188) = b(k,188) - lu(k,2070) * b(k,198) - b(k,187) = b(k,187) - lu(k,2069) * b(k,198) - b(k,186) = b(k,186) - lu(k,2068) * b(k,198) - b(k,185) = b(k,185) - lu(k,2067) * b(k,198) - b(k,184) = b(k,184) - lu(k,2066) * b(k,198) - b(k,183) = b(k,183) - lu(k,2065) * b(k,198) - b(k,182) = b(k,182) - lu(k,2064) * b(k,198) - b(k,181) = b(k,181) - lu(k,2063) * b(k,198) - b(k,174) = b(k,174) - lu(k,2062) * b(k,198) - b(k,169) = b(k,169) - lu(k,2061) * b(k,198) - b(k,148) = b(k,148) - lu(k,2060) * b(k,198) - b(k,139) = b(k,139) - lu(k,2059) * b(k,198) - b(k,70) = b(k,70) - lu(k,2058) * b(k,198) - b(k,64) = b(k,64) - lu(k,2057) * b(k,198) - b(k,48) = b(k,48) - lu(k,2056) * b(k,198) - b(k,197) = b(k,197) * lu(k,2054) - b(k,196) = b(k,196) - lu(k,2053) * b(k,197) - b(k,195) = b(k,195) - lu(k,2052) * b(k,197) - b(k,194) = b(k,194) - lu(k,2051) * b(k,197) - b(k,193) = b(k,193) - lu(k,2050) * b(k,197) - b(k,192) = b(k,192) - lu(k,2049) * b(k,197) - b(k,191) = b(k,191) - lu(k,2048) * b(k,197) - b(k,190) = b(k,190) - lu(k,2047) * b(k,197) - b(k,189) = b(k,189) - lu(k,2046) * b(k,197) - b(k,188) = b(k,188) - lu(k,2045) * b(k,197) - b(k,187) = b(k,187) - lu(k,2044) * b(k,197) - b(k,186) = b(k,186) - lu(k,2043) * b(k,197) - b(k,185) = b(k,185) - lu(k,2042) * b(k,197) - b(k,184) = b(k,184) - lu(k,2041) * b(k,197) - b(k,183) = b(k,183) - lu(k,2040) * b(k,197) - b(k,182) = b(k,182) - lu(k,2039) * b(k,197) - b(k,181) = b(k,181) - lu(k,2038) * b(k,197) - b(k,180) = b(k,180) - lu(k,2037) * b(k,197) - b(k,179) = b(k,179) - lu(k,2036) * b(k,197) - b(k,178) = b(k,178) - lu(k,2035) * b(k,197) - b(k,177) = b(k,177) - lu(k,2034) * b(k,197) - b(k,176) = b(k,176) - lu(k,2033) * b(k,197) - b(k,175) = b(k,175) - lu(k,2032) * b(k,197) - b(k,174) = b(k,174) - lu(k,2031) * b(k,197) - b(k,173) = b(k,173) - lu(k,2030) * b(k,197) - b(k,172) = b(k,172) - lu(k,2029) * b(k,197) - b(k,171) = b(k,171) - lu(k,2028) * b(k,197) - b(k,168) = b(k,168) - lu(k,2027) * b(k,197) - b(k,167) = b(k,167) - lu(k,2026) * b(k,197) - b(k,166) = b(k,166) - lu(k,2025) * b(k,197) - b(k,165) = b(k,165) - lu(k,2024) * b(k,197) - b(k,164) = b(k,164) - lu(k,2023) * b(k,197) - b(k,163) = b(k,163) - lu(k,2022) * b(k,197) - b(k,162) = b(k,162) - lu(k,2021) * b(k,197) - b(k,161) = b(k,161) - lu(k,2020) * b(k,197) - b(k,159) = b(k,159) - lu(k,2019) * b(k,197) - b(k,157) = b(k,157) - lu(k,2018) * b(k,197) - b(k,156) = b(k,156) - lu(k,2017) * b(k,197) - b(k,154) = b(k,154) - lu(k,2016) * b(k,197) - b(k,153) = b(k,153) - lu(k,2015) * b(k,197) - b(k,152) = b(k,152) - lu(k,2014) * b(k,197) - b(k,151) = b(k,151) - lu(k,2013) * b(k,197) - b(k,149) = b(k,149) - lu(k,2012) * b(k,197) - b(k,148) = b(k,148) - lu(k,2011) * b(k,197) - b(k,146) = b(k,146) - lu(k,2010) * b(k,197) - b(k,142) = b(k,142) - lu(k,2009) * b(k,197) - b(k,132) = b(k,132) - lu(k,2008) * b(k,197) - b(k,125) = b(k,125) - lu(k,2007) * b(k,197) - b(k,117) = b(k,117) - lu(k,2006) * b(k,197) - b(k,116) = b(k,116) - lu(k,2005) * b(k,197) - b(k,109) = b(k,109) - lu(k,2004) * b(k,197) - b(k,105) = b(k,105) - lu(k,2003) * b(k,197) - b(k,92) = b(k,92) - lu(k,2002) * b(k,197) - b(k,67) = b(k,67) - lu(k,2001) * b(k,197) - b(k,33) = b(k,33) - lu(k,2000) * b(k,197) - b(k,32) = b(k,32) - lu(k,1999) * b(k,197) - b(k,31) = b(k,31) - lu(k,1998) * b(k,197) - b(k,30) = b(k,30) - lu(k,1997) * b(k,197) - b(k,29) = b(k,29) - lu(k,1996) * b(k,197) - b(k,196) = b(k,196) * lu(k,1993) - b(k,195) = b(k,195) - lu(k,1992) * b(k,196) - b(k,194) = b(k,194) - lu(k,1991) * b(k,196) - b(k,193) = b(k,193) - lu(k,1990) * b(k,196) - b(k,192) = b(k,192) - lu(k,1989) * b(k,196) - b(k,191) = b(k,191) - lu(k,1988) * b(k,196) - b(k,190) = b(k,190) - lu(k,1987) * b(k,196) - b(k,189) = b(k,189) - lu(k,1986) * b(k,196) - b(k,188) = b(k,188) - lu(k,1985) * b(k,196) - b(k,187) = b(k,187) - lu(k,1984) * b(k,196) - b(k,186) = b(k,186) - lu(k,1983) * b(k,196) - b(k,185) = b(k,185) - lu(k,1982) * b(k,196) - b(k,184) = b(k,184) - lu(k,1981) * b(k,196) - b(k,183) = b(k,183) - lu(k,1980) * b(k,196) - b(k,182) = b(k,182) - lu(k,1979) * b(k,196) - b(k,181) = b(k,181) - lu(k,1978) * b(k,196) - b(k,180) = b(k,180) - lu(k,1977) * b(k,196) - b(k,179) = b(k,179) - lu(k,1976) * b(k,196) - b(k,178) = b(k,178) - lu(k,1975) * b(k,196) - b(k,177) = b(k,177) - lu(k,1974) * b(k,196) - b(k,176) = b(k,176) - lu(k,1973) * b(k,196) - b(k,175) = b(k,175) - lu(k,1972) * b(k,196) - b(k,174) = b(k,174) - lu(k,1971) * b(k,196) - b(k,173) = b(k,173) - lu(k,1970) * b(k,196) - b(k,172) = b(k,172) - lu(k,1969) * b(k,196) - b(k,171) = b(k,171) - lu(k,1968) * b(k,196) - b(k,170) = b(k,170) - lu(k,1967) * b(k,196) - b(k,168) = b(k,168) - lu(k,1966) * b(k,196) - b(k,167) = b(k,167) - lu(k,1965) * b(k,196) - b(k,166) = b(k,166) - lu(k,1964) * b(k,196) - b(k,165) = b(k,165) - lu(k,1963) * b(k,196) - b(k,164) = b(k,164) - lu(k,1962) * b(k,196) - b(k,163) = b(k,163) - lu(k,1961) * b(k,196) - b(k,162) = b(k,162) - lu(k,1960) * b(k,196) - b(k,161) = b(k,161) - lu(k,1959) * b(k,196) - b(k,160) = b(k,160) - lu(k,1958) * b(k,196) - b(k,159) = b(k,159) - lu(k,1957) * b(k,196) - b(k,158) = b(k,158) - lu(k,1956) * b(k,196) - b(k,157) = b(k,157) - lu(k,1955) * b(k,196) - b(k,156) = b(k,156) - lu(k,1954) * b(k,196) - b(k,154) = b(k,154) - lu(k,1953) * b(k,196) - b(k,153) = b(k,153) - lu(k,1952) * b(k,196) - b(k,152) = b(k,152) - lu(k,1951) * b(k,196) - b(k,151) = b(k,151) - lu(k,1950) * b(k,196) - b(k,149) = b(k,149) - lu(k,1949) * b(k,196) - b(k,148) = b(k,148) - lu(k,1948) * b(k,196) - b(k,147) = b(k,147) - lu(k,1947) * b(k,196) - b(k,146) = b(k,146) - lu(k,1946) * b(k,196) - b(k,118) = b(k,118) - lu(k,1945) * b(k,196) - b(k,88) = b(k,88) - lu(k,1944) * b(k,196) - b(k,86) = b(k,86) - lu(k,1943) * b(k,196) - b(k,75) = b(k,75) - lu(k,1942) * b(k,196) - b(k,74) = b(k,74) - lu(k,1941) * b(k,196) - b(k,33) = b(k,33) - lu(k,1940) * b(k,196) - b(k,32) = b(k,32) - lu(k,1939) * b(k,196) - b(k,195) = b(k,195) * lu(k,1935) - b(k,194) = b(k,194) - lu(k,1934) * b(k,195) - b(k,193) = b(k,193) - lu(k,1933) * b(k,195) - b(k,192) = b(k,192) - lu(k,1932) * b(k,195) - b(k,191) = b(k,191) - lu(k,1931) * b(k,195) - b(k,190) = b(k,190) - lu(k,1930) * b(k,195) - b(k,189) = b(k,189) - lu(k,1929) * b(k,195) - b(k,188) = b(k,188) - lu(k,1928) * b(k,195) - b(k,187) = b(k,187) - lu(k,1927) * b(k,195) - b(k,186) = b(k,186) - lu(k,1926) * b(k,195) - b(k,185) = b(k,185) - lu(k,1925) * b(k,195) - b(k,184) = b(k,184) - lu(k,1924) * b(k,195) - b(k,183) = b(k,183) - lu(k,1923) * b(k,195) - b(k,182) = b(k,182) - lu(k,1922) * b(k,195) - b(k,181) = b(k,181) - lu(k,1921) * b(k,195) - b(k,180) = b(k,180) - lu(k,1920) * b(k,195) - b(k,169) = b(k,169) - lu(k,1919) * b(k,195) - b(k,168) = b(k,168) - lu(k,1918) * b(k,195) - b(k,162) = b(k,162) - lu(k,1917) * b(k,195) - b(k,159) = b(k,159) - lu(k,1916) * b(k,195) - b(k,155) = b(k,155) - lu(k,1915) * b(k,195) - b(k,149) = b(k,149) - lu(k,1914) * b(k,195) - b(k,145) = b(k,145) - lu(k,1913) * b(k,195) - b(k,144) = b(k,144) - lu(k,1912) * b(k,195) - b(k,142) = b(k,142) - lu(k,1911) * b(k,195) - b(k,132) = b(k,132) - lu(k,1910) * b(k,195) - b(k,121) = b(k,121) - lu(k,1909) * b(k,195) - b(k,116) = b(k,116) - lu(k,1908) * b(k,195) - b(k,78) = b(k,78) - lu(k,1907) * b(k,195) - b(k,77) = b(k,77) - lu(k,1906) * b(k,195) - b(k,55) = b(k,55) - lu(k,1905) * b(k,195) - b(k,194) = b(k,194) * lu(k,1900) - b(k,193) = b(k,193) - lu(k,1899) * b(k,194) - b(k,192) = b(k,192) - lu(k,1898) * b(k,194) - b(k,191) = b(k,191) - lu(k,1897) * b(k,194) - b(k,190) = b(k,190) - lu(k,1896) * b(k,194) - b(k,189) = b(k,189) - lu(k,1895) * b(k,194) - b(k,188) = b(k,188) - lu(k,1894) * b(k,194) - b(k,187) = b(k,187) - lu(k,1893) * b(k,194) - b(k,186) = b(k,186) - lu(k,1892) * b(k,194) - b(k,185) = b(k,185) - lu(k,1891) * b(k,194) - b(k,184) = b(k,184) - lu(k,1890) * b(k,194) - b(k,183) = b(k,183) - lu(k,1889) * b(k,194) - b(k,182) = b(k,182) - lu(k,1888) * b(k,194) - b(k,181) = b(k,181) - lu(k,1887) * b(k,194) - b(k,155) = b(k,155) - lu(k,1886) * b(k,194) - b(k,145) = b(k,145) - lu(k,1885) * b(k,194) - b(k,138) = b(k,138) - lu(k,1884) * b(k,194) - b(k,68) = b(k,68) - lu(k,1883) * b(k,194) - b(k,55) = b(k,55) - lu(k,1882) * b(k,194) - b(k,193) = b(k,193) * lu(k,1876) - b(k,192) = b(k,192) - lu(k,1875) * b(k,193) - b(k,191) = b(k,191) - lu(k,1874) * b(k,193) - b(k,190) = b(k,190) - lu(k,1873) * b(k,193) - b(k,189) = b(k,189) - lu(k,1872) * b(k,193) - b(k,188) = b(k,188) - lu(k,1871) * b(k,193) - b(k,187) = b(k,187) - lu(k,1870) * b(k,193) - b(k,186) = b(k,186) - lu(k,1869) * b(k,193) - b(k,185) = b(k,185) - lu(k,1868) * b(k,193) - b(k,184) = b(k,184) - lu(k,1867) * b(k,193) - b(k,183) = b(k,183) - lu(k,1866) * b(k,193) - b(k,182) = b(k,182) - lu(k,1865) * b(k,193) - b(k,181) = b(k,181) - lu(k,1864) * b(k,193) - b(k,174) = b(k,174) - lu(k,1863) * b(k,193) - b(k,169) = b(k,169) - lu(k,1862) * b(k,193) - b(k,162) = b(k,162) - lu(k,1861) * b(k,193) - b(k,155) = b(k,155) - lu(k,1860) * b(k,193) - b(k,148) = b(k,148) - lu(k,1859) * b(k,193) - b(k,145) = b(k,145) - lu(k,1858) * b(k,193) - b(k,143) = b(k,143) - lu(k,1857) * b(k,193) - b(k,138) = b(k,138) - lu(k,1856) * b(k,193) - b(k,121) = b(k,121) - lu(k,1855) * b(k,193) - b(k,114) = b(k,114) - lu(k,1854) * b(k,193) - b(k,109) = b(k,109) - lu(k,1853) * b(k,193) - b(k,87) = b(k,87) - lu(k,1852) * b(k,193) + b(k,217) = b(k,217) - lu(k,1750) * b(k,216) + b(k,218) = b(k,218) - lu(k,1751) * b(k,216) + b(k,219) = b(k,219) - lu(k,1752) * b(k,216) + b(k,220) = b(k,220) - lu(k,1753) * b(k,216) + b(k,221) = b(k,221) - lu(k,1754) * b(k,216) + b(k,222) = b(k,222) - lu(k,1755) * b(k,216) + b(k,223) = b(k,223) - lu(k,1756) * b(k,216) + b(k,224) = b(k,224) - lu(k,1757) * b(k,216) + b(k,225) = b(k,225) - lu(k,1758) * b(k,216) + b(k,226) = b(k,226) - lu(k,1759) * b(k,216) + b(k,227) = b(k,227) - lu(k,1760) * b(k,216) + b(k,218) = b(k,218) - lu(k,1843) * b(k,217) + b(k,219) = b(k,219) - lu(k,1844) * b(k,217) + b(k,220) = b(k,220) - lu(k,1845) * b(k,217) + b(k,221) = b(k,221) - lu(k,1846) * b(k,217) + b(k,222) = b(k,222) - lu(k,1847) * b(k,217) + b(k,223) = b(k,223) - lu(k,1848) * b(k,217) + b(k,224) = b(k,224) - lu(k,1849) * b(k,217) + b(k,225) = b(k,225) - lu(k,1850) * b(k,217) + b(k,226) = b(k,226) - lu(k,1851) * b(k,217) + b(k,227) = b(k,227) - lu(k,1852) * b(k,217) + b(k,219) = b(k,219) - lu(k,1951) * b(k,218) + b(k,220) = b(k,220) - lu(k,1952) * b(k,218) + b(k,221) = b(k,221) - lu(k,1953) * b(k,218) + b(k,222) = b(k,222) - lu(k,1954) * b(k,218) + b(k,223) = b(k,223) - lu(k,1955) * b(k,218) + b(k,224) = b(k,224) - lu(k,1956) * b(k,218) + b(k,225) = b(k,225) - lu(k,1957) * b(k,218) + b(k,226) = b(k,226) - lu(k,1958) * b(k,218) + b(k,227) = b(k,227) - lu(k,1959) * b(k,218) + b(k,220) = b(k,220) - lu(k,1978) * b(k,219) + b(k,221) = b(k,221) - lu(k,1979) * b(k,219) + b(k,222) = b(k,222) - lu(k,1980) * b(k,219) + b(k,223) = b(k,223) - lu(k,1981) * b(k,219) + b(k,224) = b(k,224) - lu(k,1982) * b(k,219) + b(k,225) = b(k,225) - lu(k,1983) * b(k,219) + b(k,226) = b(k,226) - lu(k,1984) * b(k,219) + b(k,227) = b(k,227) - lu(k,1985) * b(k,219) + b(k,221) = b(k,221) - lu(k,2018) * b(k,220) + b(k,222) = b(k,222) - lu(k,2019) * b(k,220) + b(k,223) = b(k,223) - lu(k,2020) * b(k,220) + b(k,224) = b(k,224) - lu(k,2021) * b(k,220) + b(k,225) = b(k,225) - lu(k,2022) * b(k,220) + b(k,226) = b(k,226) - lu(k,2023) * b(k,220) + b(k,227) = b(k,227) - lu(k,2024) * b(k,220) + b(k,222) = b(k,222) - lu(k,2071) * b(k,221) + b(k,223) = b(k,223) - lu(k,2072) * b(k,221) + b(k,224) = b(k,224) - lu(k,2073) * b(k,221) + b(k,225) = b(k,225) - lu(k,2074) * b(k,221) + b(k,226) = b(k,226) - lu(k,2075) * b(k,221) + b(k,227) = b(k,227) - lu(k,2076) * b(k,221) + b(k,223) = b(k,223) - lu(k,2133) * b(k,222) + b(k,224) = b(k,224) - lu(k,2134) * b(k,222) + b(k,225) = b(k,225) - lu(k,2135) * b(k,222) + b(k,226) = b(k,226) - lu(k,2136) * b(k,222) + b(k,227) = b(k,227) - lu(k,2137) * b(k,222) + b(k,224) = b(k,224) - lu(k,2157) * b(k,223) + b(k,225) = b(k,225) - lu(k,2158) * b(k,223) + b(k,226) = b(k,226) - lu(k,2159) * b(k,223) + b(k,227) = b(k,227) - lu(k,2160) * b(k,223) + b(k,225) = b(k,225) - lu(k,2202) * b(k,224) + b(k,226) = b(k,226) - lu(k,2203) * b(k,224) + b(k,227) = b(k,227) - lu(k,2204) * b(k,224) + b(k,226) = b(k,226) - lu(k,2227) * b(k,225) + b(k,227) = b(k,227) - lu(k,2228) * b(k,225) + b(k,227) = b(k,227) - lu(k,2259) * b(k,226) end do end subroutine lu_slv06 subroutine lu_slv07( avec_len, lu, b ) @@ -1335,257 +1231,249 @@ subroutine lu_slv07( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,192) = b(k,192) * lu(k,1845) - b(k,191) = b(k,191) - lu(k,1844) * b(k,192) - b(k,190) = b(k,190) - lu(k,1843) * b(k,192) - b(k,189) = b(k,189) - lu(k,1842) * b(k,192) - b(k,188) = b(k,188) - lu(k,1841) * b(k,192) - b(k,187) = b(k,187) - lu(k,1840) * b(k,192) - b(k,186) = b(k,186) - lu(k,1839) * b(k,192) - b(k,185) = b(k,185) - lu(k,1838) * b(k,192) - b(k,184) = b(k,184) - lu(k,1837) * b(k,192) - b(k,183) = b(k,183) - lu(k,1836) * b(k,192) - b(k,182) = b(k,182) - lu(k,1835) * b(k,192) - b(k,181) = b(k,181) - lu(k,1834) * b(k,192) - b(k,180) = b(k,180) - lu(k,1833) * b(k,192) - b(k,179) = b(k,179) - lu(k,1832) * b(k,192) - b(k,178) = b(k,178) - lu(k,1831) * b(k,192) - b(k,177) = b(k,177) - lu(k,1830) * b(k,192) - b(k,176) = b(k,176) - lu(k,1829) * b(k,192) - b(k,175) = b(k,175) - lu(k,1828) * b(k,192) - b(k,173) = b(k,173) - lu(k,1827) * b(k,192) - b(k,172) = b(k,172) - lu(k,1826) * b(k,192) - b(k,171) = b(k,171) - lu(k,1825) * b(k,192) - b(k,170) = b(k,170) - lu(k,1824) * b(k,192) - b(k,169) = b(k,169) - lu(k,1823) * b(k,192) - b(k,168) = b(k,168) - lu(k,1822) * b(k,192) - b(k,167) = b(k,167) - lu(k,1821) * b(k,192) - b(k,166) = b(k,166) - lu(k,1820) * b(k,192) - b(k,165) = b(k,165) - lu(k,1819) * b(k,192) - b(k,164) = b(k,164) - lu(k,1818) * b(k,192) - b(k,163) = b(k,163) - lu(k,1817) * b(k,192) - b(k,162) = b(k,162) - lu(k,1816) * b(k,192) - b(k,161) = b(k,161) - lu(k,1815) * b(k,192) - b(k,159) = b(k,159) - lu(k,1814) * b(k,192) - b(k,157) = b(k,157) - lu(k,1813) * b(k,192) - b(k,154) = b(k,154) - lu(k,1812) * b(k,192) - b(k,153) = b(k,153) - lu(k,1811) * b(k,192) - b(k,150) = b(k,150) - lu(k,1810) * b(k,192) - b(k,149) = b(k,149) - lu(k,1809) * b(k,192) - b(k,147) = b(k,147) - lu(k,1808) * b(k,192) - b(k,145) = b(k,145) - lu(k,1807) * b(k,192) - b(k,144) = b(k,144) - lu(k,1806) * b(k,192) - b(k,143) = b(k,143) - lu(k,1805) * b(k,192) - b(k,142) = b(k,142) - lu(k,1804) * b(k,192) - b(k,140) = b(k,140) - lu(k,1803) * b(k,192) - b(k,138) = b(k,138) - lu(k,1802) * b(k,192) - b(k,137) = b(k,137) - lu(k,1801) * b(k,192) - b(k,136) = b(k,136) - lu(k,1800) * b(k,192) - b(k,135) = b(k,135) - lu(k,1799) * b(k,192) - b(k,134) = b(k,134) - lu(k,1798) * b(k,192) - b(k,133) = b(k,133) - lu(k,1797) * b(k,192) - b(k,132) = b(k,132) - lu(k,1796) * b(k,192) - b(k,131) = b(k,131) - lu(k,1795) * b(k,192) - b(k,130) = b(k,130) - lu(k,1794) * b(k,192) - b(k,129) = b(k,129) - lu(k,1793) * b(k,192) - b(k,127) = b(k,127) - lu(k,1792) * b(k,192) - b(k,126) = b(k,126) - lu(k,1791) * b(k,192) - b(k,125) = b(k,125) - lu(k,1790) * b(k,192) - b(k,122) = b(k,122) - lu(k,1789) * b(k,192) - b(k,121) = b(k,121) - lu(k,1788) * b(k,192) - b(k,117) = b(k,117) - lu(k,1787) * b(k,192) - b(k,113) = b(k,113) - lu(k,1786) * b(k,192) - b(k,112) = b(k,112) - lu(k,1785) * b(k,192) - b(k,111) = b(k,111) - lu(k,1784) * b(k,192) - b(k,108) = b(k,108) - lu(k,1783) * b(k,192) - b(k,107) = b(k,107) - lu(k,1782) * b(k,192) - b(k,106) = b(k,106) - lu(k,1781) * b(k,192) - b(k,105) = b(k,105) - lu(k,1780) * b(k,192) - b(k,103) = b(k,103) - lu(k,1779) * b(k,192) - b(k,102) = b(k,102) - lu(k,1778) * b(k,192) - b(k,101) = b(k,101) - lu(k,1777) * b(k,192) - b(k,100) = b(k,100) - lu(k,1776) * b(k,192) - b(k,99) = b(k,99) - lu(k,1775) * b(k,192) - b(k,98) = b(k,98) - lu(k,1774) * b(k,192) - b(k,97) = b(k,97) - lu(k,1773) * b(k,192) - b(k,96) = b(k,96) - lu(k,1772) * b(k,192) - b(k,95) = b(k,95) - lu(k,1771) * b(k,192) - b(k,94) = b(k,94) - lu(k,1770) * b(k,192) - b(k,93) = b(k,93) - lu(k,1769) * b(k,192) - b(k,91) = b(k,91) - lu(k,1768) * b(k,192) - b(k,85) = b(k,85) - lu(k,1767) * b(k,192) - b(k,84) = b(k,84) - lu(k,1766) * b(k,192) - b(k,83) = b(k,83) - lu(k,1765) * b(k,192) - b(k,80) = b(k,80) - lu(k,1764) * b(k,192) - b(k,79) = b(k,79) - lu(k,1763) * b(k,192) - b(k,73) = b(k,73) - lu(k,1762) * b(k,192) - b(k,72) = b(k,72) - lu(k,1761) * b(k,192) - b(k,61) = b(k,61) - lu(k,1760) * b(k,192) - b(k,47) = b(k,47) - lu(k,1759) * b(k,192) - b(k,42) = b(k,42) - lu(k,1758) * b(k,192) - b(k,41) = b(k,41) - lu(k,1757) * b(k,192) - b(k,40) = b(k,40) - lu(k,1756) * b(k,192) - b(k,38) = b(k,38) - lu(k,1755) * b(k,192) - b(k,37) = b(k,37) - lu(k,1754) * b(k,192) - b(k,36) = b(k,36) - lu(k,1753) * b(k,192) - b(k,35) = b(k,35) - lu(k,1752) * b(k,192) - b(k,33) = b(k,33) - lu(k,1751) * b(k,192) - b(k,32) = b(k,32) - lu(k,1750) * b(k,192) - b(k,31) = b(k,31) - lu(k,1749) * b(k,192) - b(k,30) = b(k,30) - lu(k,1748) * b(k,192) - b(k,29) = b(k,29) - lu(k,1747) * b(k,192) - b(k,191) = b(k,191) * lu(k,1739) - b(k,190) = b(k,190) - lu(k,1738) * b(k,191) - b(k,189) = b(k,189) - lu(k,1737) * b(k,191) - b(k,188) = b(k,188) - lu(k,1736) * b(k,191) - b(k,187) = b(k,187) - lu(k,1735) * b(k,191) - b(k,186) = b(k,186) - lu(k,1734) * b(k,191) - b(k,185) = b(k,185) - lu(k,1733) * b(k,191) - b(k,183) = b(k,183) - lu(k,1732) * b(k,191) - b(k,182) = b(k,182) - lu(k,1731) * b(k,191) - b(k,181) = b(k,181) - lu(k,1730) * b(k,191) - b(k,169) = b(k,169) - lu(k,1729) * b(k,191) - b(k,162) = b(k,162) - lu(k,1728) * b(k,191) - b(k,143) = b(k,143) - lu(k,1727) * b(k,191) - b(k,142) = b(k,142) - lu(k,1726) * b(k,191) - b(k,101) = b(k,101) - lu(k,1725) * b(k,191) - b(k,190) = b(k,190) * lu(k,1716) - b(k,189) = b(k,189) - lu(k,1715) * b(k,190) - b(k,188) = b(k,188) - lu(k,1714) * b(k,190) - b(k,187) = b(k,187) - lu(k,1713) * b(k,190) - b(k,186) = b(k,186) - lu(k,1712) * b(k,190) - b(k,185) = b(k,185) - lu(k,1711) * b(k,190) - b(k,184) = b(k,184) - lu(k,1710) * b(k,190) - b(k,183) = b(k,183) - lu(k,1709) * b(k,190) - b(k,182) = b(k,182) - lu(k,1708) * b(k,190) - b(k,181) = b(k,181) - lu(k,1707) * b(k,190) - b(k,174) = b(k,174) - lu(k,1706) * b(k,190) - b(k,148) = b(k,148) - lu(k,1705) * b(k,190) - b(k,138) = b(k,138) - lu(k,1704) * b(k,190) - b(k,114) = b(k,114) - lu(k,1703) * b(k,190) - b(k,82) = b(k,82) - lu(k,1702) * b(k,190) - b(k,68) = b(k,68) - lu(k,1701) * b(k,190) - b(k,189) = b(k,189) * lu(k,1691) - b(k,188) = b(k,188) - lu(k,1690) * b(k,189) - b(k,187) = b(k,187) - lu(k,1689) * b(k,189) - b(k,186) = b(k,186) - lu(k,1688) * b(k,189) - b(k,185) = b(k,185) - lu(k,1687) * b(k,189) - b(k,184) = b(k,184) - lu(k,1686) * b(k,189) - b(k,183) = b(k,183) - lu(k,1685) * b(k,189) - b(k,182) = b(k,182) - lu(k,1684) * b(k,189) - b(k,180) = b(k,180) - lu(k,1683) * b(k,189) - b(k,179) = b(k,179) - lu(k,1682) * b(k,189) - b(k,178) = b(k,178) - lu(k,1681) * b(k,189) - b(k,177) = b(k,177) - lu(k,1680) * b(k,189) - b(k,176) = b(k,176) - lu(k,1679) * b(k,189) - b(k,175) = b(k,175) - lu(k,1678) * b(k,189) - b(k,173) = b(k,173) - lu(k,1677) * b(k,189) - b(k,172) = b(k,172) - lu(k,1676) * b(k,189) - b(k,171) = b(k,171) - lu(k,1675) * b(k,189) - b(k,170) = b(k,170) - lu(k,1674) * b(k,189) - b(k,168) = b(k,168) - lu(k,1673) * b(k,189) - b(k,167) = b(k,167) - lu(k,1672) * b(k,189) - b(k,166) = b(k,166) - lu(k,1671) * b(k,189) - b(k,165) = b(k,165) - lu(k,1670) * b(k,189) - b(k,164) = b(k,164) - lu(k,1669) * b(k,189) - b(k,163) = b(k,163) - lu(k,1668) * b(k,189) - b(k,162) = b(k,162) - lu(k,1667) * b(k,189) - b(k,161) = b(k,161) - lu(k,1666) * b(k,189) - b(k,159) = b(k,159) - lu(k,1665) * b(k,189) - b(k,158) = b(k,158) - lu(k,1664) * b(k,189) - b(k,157) = b(k,157) - lu(k,1663) * b(k,189) - b(k,154) = b(k,154) - lu(k,1662) * b(k,189) - b(k,149) = b(k,149) - lu(k,1661) * b(k,189) - b(k,147) = b(k,147) - lu(k,1660) * b(k,189) - b(k,144) = b(k,144) - lu(k,1659) * b(k,189) - b(k,141) = b(k,141) - lu(k,1658) * b(k,189) - b(k,140) = b(k,140) - lu(k,1657) * b(k,189) - b(k,124) = b(k,124) - lu(k,1656) * b(k,189) - b(k,117) = b(k,117) - lu(k,1655) * b(k,189) - b(k,94) = b(k,94) - lu(k,1654) * b(k,189) - b(k,90) = b(k,90) - lu(k,1653) * b(k,189) - b(k,86) = b(k,86) - lu(k,1652) * b(k,189) - b(k,71) = b(k,71) - lu(k,1651) * b(k,189) - b(k,188) = b(k,188) * lu(k,1640) - b(k,187) = b(k,187) - lu(k,1639) * b(k,188) - b(k,186) = b(k,186) - lu(k,1638) * b(k,188) - b(k,185) = b(k,185) - lu(k,1637) * b(k,188) - b(k,184) = b(k,184) - lu(k,1636) * b(k,188) - b(k,183) = b(k,183) - lu(k,1635) * b(k,188) - b(k,182) = b(k,182) - lu(k,1634) * b(k,188) - b(k,181) = b(k,181) - lu(k,1633) * b(k,188) - b(k,180) = b(k,180) - lu(k,1632) * b(k,188) - b(k,179) = b(k,179) - lu(k,1631) * b(k,188) - b(k,178) = b(k,178) - lu(k,1630) * b(k,188) - b(k,177) = b(k,177) - lu(k,1629) * b(k,188) - b(k,176) = b(k,176) - lu(k,1628) * b(k,188) - b(k,175) = b(k,175) - lu(k,1627) * b(k,188) - b(k,173) = b(k,173) - lu(k,1626) * b(k,188) - b(k,172) = b(k,172) - lu(k,1625) * b(k,188) - b(k,171) = b(k,171) - lu(k,1624) * b(k,188) - b(k,170) = b(k,170) - lu(k,1623) * b(k,188) - b(k,168) = b(k,168) - lu(k,1622) * b(k,188) - b(k,167) = b(k,167) - lu(k,1621) * b(k,188) - b(k,166) = b(k,166) - lu(k,1620) * b(k,188) - b(k,165) = b(k,165) - lu(k,1619) * b(k,188) - b(k,164) = b(k,164) - lu(k,1618) * b(k,188) - b(k,163) = b(k,163) - lu(k,1617) * b(k,188) - b(k,162) = b(k,162) - lu(k,1616) * b(k,188) - b(k,161) = b(k,161) - lu(k,1615) * b(k,188) - b(k,160) = b(k,160) - lu(k,1614) * b(k,188) - b(k,159) = b(k,159) - lu(k,1613) * b(k,188) - b(k,158) = b(k,158) - lu(k,1612) * b(k,188) - b(k,157) = b(k,157) - lu(k,1611) * b(k,188) - b(k,154) = b(k,154) - lu(k,1610) * b(k,188) - b(k,153) = b(k,153) - lu(k,1609) * b(k,188) - b(k,150) = b(k,150) - lu(k,1608) * b(k,188) - b(k,149) = b(k,149) - lu(k,1607) * b(k,188) - b(k,147) = b(k,147) - lu(k,1606) * b(k,188) - b(k,144) = b(k,144) - lu(k,1605) * b(k,188) - b(k,142) = b(k,142) - lu(k,1604) * b(k,188) - b(k,140) = b(k,140) - lu(k,1603) * b(k,188) - b(k,137) = b(k,137) - lu(k,1602) * b(k,188) - b(k,136) = b(k,136) - lu(k,1601) * b(k,188) - b(k,135) = b(k,135) - lu(k,1600) * b(k,188) - b(k,134) = b(k,134) - lu(k,1599) * b(k,188) - b(k,133) = b(k,133) - lu(k,1598) * b(k,188) - b(k,132) = b(k,132) - lu(k,1597) * b(k,188) - b(k,129) = b(k,129) - lu(k,1596) * b(k,188) - b(k,128) = b(k,128) - lu(k,1595) * b(k,188) - b(k,125) = b(k,125) - lu(k,1594) * b(k,188) - b(k,124) = b(k,124) - lu(k,1593) * b(k,188) - b(k,123) = b(k,123) - lu(k,1592) * b(k,188) - b(k,120) = b(k,120) - lu(k,1591) * b(k,188) - b(k,118) = b(k,118) - lu(k,1590) * b(k,188) - b(k,115) = b(k,115) - lu(k,1589) * b(k,188) - b(k,111) = b(k,111) - lu(k,1588) * b(k,188) - b(k,110) = b(k,110) - lu(k,1587) * b(k,188) - b(k,108) = b(k,108) - lu(k,1586) * b(k,188) - b(k,107) = b(k,107) - lu(k,1585) * b(k,188) - b(k,105) = b(k,105) - lu(k,1584) * b(k,188) - b(k,103) = b(k,103) - lu(k,1583) * b(k,188) - b(k,102) = b(k,102) - lu(k,1582) * b(k,188) - b(k,101) = b(k,101) - lu(k,1581) * b(k,188) - b(k,100) = b(k,100) - lu(k,1580) * b(k,188) - b(k,89) = b(k,89) - lu(k,1579) * b(k,188) - b(k,86) = b(k,86) - lu(k,1578) * b(k,188) - b(k,81) = b(k,81) - lu(k,1577) * b(k,188) - b(k,76) = b(k,76) - lu(k,1576) * b(k,188) - b(k,73) = b(k,73) - lu(k,1575) * b(k,188) - b(k,69) = b(k,69) - lu(k,1574) * b(k,188) - b(k,66) = b(k,66) - lu(k,1573) * b(k,188) - b(k,42) = b(k,42) - lu(k,1572) * b(k,188) - b(k,41) = b(k,41) - lu(k,1571) * b(k,188) - b(k,40) = b(k,40) - lu(k,1570) * b(k,188) - b(k,38) = b(k,38) - lu(k,1569) * b(k,188) - b(k,37) = b(k,37) - lu(k,1568) * b(k,188) - b(k,36) = b(k,36) - lu(k,1567) * b(k,188) - b(k,35) = b(k,35) - lu(k,1566) * b(k,188) - b(k,33) = b(k,33) - lu(k,1565) * b(k,188) - b(k,32) = b(k,32) - lu(k,1564) * b(k,188) - b(k,31) = b(k,31) - lu(k,1563) * b(k,188) - b(k,30) = b(k,30) - lu(k,1562) * b(k,188) - b(k,29) = b(k,29) - lu(k,1561) * b(k,188) +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,227) = b(k,227) * lu(k,2285) + b(k,226) = b(k,226) - lu(k,2284) * b(k,227) + b(k,225) = b(k,225) - lu(k,2283) * b(k,227) + b(k,224) = b(k,224) - lu(k,2282) * b(k,227) + b(k,223) = b(k,223) - lu(k,2281) * b(k,227) + b(k,222) = b(k,222) - lu(k,2280) * b(k,227) + b(k,221) = b(k,221) - lu(k,2279) * b(k,227) + b(k,220) = b(k,220) - lu(k,2278) * b(k,227) + b(k,219) = b(k,219) - lu(k,2277) * b(k,227) + b(k,218) = b(k,218) - lu(k,2276) * b(k,227) + b(k,217) = b(k,217) - lu(k,2275) * b(k,227) + b(k,216) = b(k,216) - lu(k,2274) * b(k,227) + b(k,215) = b(k,215) - lu(k,2273) * b(k,227) + b(k,214) = b(k,214) - lu(k,2272) * b(k,227) + b(k,213) = b(k,213) - lu(k,2271) * b(k,227) + b(k,212) = b(k,212) - lu(k,2270) * b(k,227) + b(k,211) = b(k,211) - lu(k,2269) * b(k,227) + b(k,210) = b(k,210) - lu(k,2268) * b(k,227) + b(k,209) = b(k,209) - lu(k,2267) * b(k,227) + b(k,208) = b(k,208) - lu(k,2266) * b(k,227) + b(k,201) = b(k,201) - lu(k,2265) * b(k,227) + b(k,175) = b(k,175) - lu(k,2264) * b(k,227) + b(k,172) = b(k,172) - lu(k,2263) * b(k,227) + b(k,97) = b(k,97) - lu(k,2262) * b(k,227) + b(k,91) = b(k,91) - lu(k,2261) * b(k,227) + b(k,63) = b(k,63) - lu(k,2260) * b(k,227) + b(k,226) = b(k,226) * lu(k,2258) + b(k,225) = b(k,225) - lu(k,2257) * b(k,226) + b(k,224) = b(k,224) - lu(k,2256) * b(k,226) + b(k,223) = b(k,223) - lu(k,2255) * b(k,226) + b(k,222) = b(k,222) - lu(k,2254) * b(k,226) + b(k,221) = b(k,221) - lu(k,2253) * b(k,226) + b(k,220) = b(k,220) - lu(k,2252) * b(k,226) + b(k,219) = b(k,219) - lu(k,2251) * b(k,226) + b(k,218) = b(k,218) - lu(k,2250) * b(k,226) + b(k,217) = b(k,217) - lu(k,2249) * b(k,226) + b(k,216) = b(k,216) - lu(k,2248) * b(k,226) + b(k,215) = b(k,215) - lu(k,2247) * b(k,226) + b(k,214) = b(k,214) - lu(k,2246) * b(k,226) + b(k,213) = b(k,213) - lu(k,2245) * b(k,226) + b(k,212) = b(k,212) - lu(k,2244) * b(k,226) + b(k,211) = b(k,211) - lu(k,2243) * b(k,226) + b(k,210) = b(k,210) - lu(k,2242) * b(k,226) + b(k,209) = b(k,209) - lu(k,2241) * b(k,226) + b(k,208) = b(k,208) - lu(k,2240) * b(k,226) + b(k,201) = b(k,201) - lu(k,2239) * b(k,226) + b(k,192) = b(k,192) - lu(k,2238) * b(k,226) + b(k,177) = b(k,177) - lu(k,2237) * b(k,226) + b(k,172) = b(k,172) - lu(k,2236) * b(k,226) + b(k,171) = b(k,171) - lu(k,2235) * b(k,226) + b(k,169) = b(k,169) - lu(k,2234) * b(k,226) + b(k,165) = b(k,165) - lu(k,2233) * b(k,226) + b(k,147) = b(k,147) - lu(k,2232) * b(k,226) + b(k,139) = b(k,139) - lu(k,2231) * b(k,226) + b(k,135) = b(k,135) - lu(k,2230) * b(k,226) + b(k,111) = b(k,111) - lu(k,2229) * b(k,226) + b(k,225) = b(k,225) * lu(k,2226) + b(k,224) = b(k,224) - lu(k,2225) * b(k,225) + b(k,223) = b(k,223) - lu(k,2224) * b(k,225) + b(k,222) = b(k,222) - lu(k,2223) * b(k,225) + b(k,221) = b(k,221) - lu(k,2222) * b(k,225) + b(k,220) = b(k,220) - lu(k,2221) * b(k,225) + b(k,219) = b(k,219) - lu(k,2220) * b(k,225) + b(k,218) = b(k,218) - lu(k,2219) * b(k,225) + b(k,217) = b(k,217) - lu(k,2218) * b(k,225) + b(k,216) = b(k,216) - lu(k,2217) * b(k,225) + b(k,215) = b(k,215) - lu(k,2216) * b(k,225) + b(k,214) = b(k,214) - lu(k,2215) * b(k,225) + b(k,213) = b(k,213) - lu(k,2214) * b(k,225) + b(k,212) = b(k,212) - lu(k,2213) * b(k,225) + b(k,211) = b(k,211) - lu(k,2212) * b(k,225) + b(k,209) = b(k,209) - lu(k,2211) * b(k,225) + b(k,201) = b(k,201) - lu(k,2210) * b(k,225) + b(k,172) = b(k,172) - lu(k,2209) * b(k,225) + b(k,165) = b(k,165) - lu(k,2208) * b(k,225) + b(k,139) = b(k,139) - lu(k,2207) * b(k,225) + b(k,106) = b(k,106) - lu(k,2206) * b(k,225) + b(k,87) = b(k,87) - lu(k,2205) * b(k,225) + b(k,224) = b(k,224) * lu(k,2201) + b(k,223) = b(k,223) - lu(k,2200) * b(k,224) + b(k,222) = b(k,222) - lu(k,2199) * b(k,224) + b(k,221) = b(k,221) - lu(k,2198) * b(k,224) + b(k,220) = b(k,220) - lu(k,2197) * b(k,224) + b(k,219) = b(k,219) - lu(k,2196) * b(k,224) + b(k,218) = b(k,218) - lu(k,2195) * b(k,224) + b(k,217) = b(k,217) - lu(k,2194) * b(k,224) + b(k,216) = b(k,216) - lu(k,2193) * b(k,224) + b(k,215) = b(k,215) - lu(k,2192) * b(k,224) + b(k,214) = b(k,214) - lu(k,2191) * b(k,224) + b(k,213) = b(k,213) - lu(k,2190) * b(k,224) + b(k,212) = b(k,212) - lu(k,2189) * b(k,224) + b(k,211) = b(k,211) - lu(k,2188) * b(k,224) + b(k,210) = b(k,210) - lu(k,2187) * b(k,224) + b(k,209) = b(k,209) - lu(k,2186) * b(k,224) + b(k,207) = b(k,207) - lu(k,2185) * b(k,224) + b(k,206) = b(k,206) - lu(k,2184) * b(k,224) + b(k,201) = b(k,201) - lu(k,2183) * b(k,224) + b(k,200) = b(k,200) - lu(k,2182) * b(k,224) + b(k,195) = b(k,195) - lu(k,2181) * b(k,224) + b(k,192) = b(k,192) - lu(k,2180) * b(k,224) + b(k,184) = b(k,184) - lu(k,2179) * b(k,224) + b(k,177) = b(k,177) - lu(k,2178) * b(k,224) + b(k,176) = b(k,176) - lu(k,2177) * b(k,224) + b(k,172) = b(k,172) - lu(k,2176) * b(k,224) + b(k,168) = b(k,168) - lu(k,2175) * b(k,224) + b(k,165) = b(k,165) - lu(k,2174) * b(k,224) + b(k,163) = b(k,163) - lu(k,2173) * b(k,224) + b(k,160) = b(k,160) - lu(k,2172) * b(k,224) + b(k,150) = b(k,150) - lu(k,2171) * b(k,224) + b(k,143) = b(k,143) - lu(k,2170) * b(k,224) + b(k,139) = b(k,139) - lu(k,2169) * b(k,224) + b(k,137) = b(k,137) - lu(k,2168) * b(k,224) + b(k,136) = b(k,136) - lu(k,2167) * b(k,224) + b(k,132) = b(k,132) - lu(k,2166) * b(k,224) + b(k,128) = b(k,128) - lu(k,2165) * b(k,224) + b(k,118) = b(k,118) - lu(k,2164) * b(k,224) + b(k,95) = b(k,95) - lu(k,2163) * b(k,224) + b(k,75) = b(k,75) - lu(k,2162) * b(k,224) + b(k,65) = b(k,65) - lu(k,2161) * b(k,224) + b(k,223) = b(k,223) * lu(k,2156) + b(k,222) = b(k,222) - lu(k,2155) * b(k,223) + b(k,221) = b(k,221) - lu(k,2154) * b(k,223) + b(k,220) = b(k,220) - lu(k,2153) * b(k,223) + b(k,219) = b(k,219) - lu(k,2152) * b(k,223) + b(k,218) = b(k,218) - lu(k,2151) * b(k,223) + b(k,217) = b(k,217) - lu(k,2150) * b(k,223) + b(k,216) = b(k,216) - lu(k,2149) * b(k,223) + b(k,215) = b(k,215) - lu(k,2148) * b(k,223) + b(k,214) = b(k,214) - lu(k,2147) * b(k,223) + b(k,213) = b(k,213) - lu(k,2146) * b(k,223) + b(k,212) = b(k,212) - lu(k,2145) * b(k,223) + b(k,211) = b(k,211) - lu(k,2144) * b(k,223) + b(k,209) = b(k,209) - lu(k,2143) * b(k,223) + b(k,177) = b(k,177) - lu(k,2142) * b(k,223) + b(k,171) = b(k,171) - lu(k,2141) * b(k,223) + b(k,165) = b(k,165) - lu(k,2140) * b(k,223) + b(k,87) = b(k,87) - lu(k,2139) * b(k,223) + b(k,70) = b(k,70) - lu(k,2138) * b(k,223) + b(k,222) = b(k,222) * lu(k,2132) + b(k,221) = b(k,221) - lu(k,2131) * b(k,222) + b(k,220) = b(k,220) - lu(k,2130) * b(k,222) + b(k,219) = b(k,219) - lu(k,2129) * b(k,222) + b(k,218) = b(k,218) - lu(k,2128) * b(k,222) + b(k,217) = b(k,217) - lu(k,2127) * b(k,222) + b(k,216) = b(k,216) - lu(k,2126) * b(k,222) + b(k,215) = b(k,215) - lu(k,2125) * b(k,222) + b(k,214) = b(k,214) - lu(k,2124) * b(k,222) + b(k,213) = b(k,213) - lu(k,2123) * b(k,222) + b(k,212) = b(k,212) - lu(k,2122) * b(k,222) + b(k,211) = b(k,211) - lu(k,2121) * b(k,222) + b(k,210) = b(k,210) - lu(k,2120) * b(k,222) + b(k,209) = b(k,209) - lu(k,2119) * b(k,222) + b(k,207) = b(k,207) - lu(k,2118) * b(k,222) + b(k,206) = b(k,206) - lu(k,2117) * b(k,222) + b(k,205) = b(k,205) - lu(k,2116) * b(k,222) + b(k,204) = b(k,204) - lu(k,2115) * b(k,222) + b(k,203) = b(k,203) - lu(k,2114) * b(k,222) + b(k,202) = b(k,202) - lu(k,2113) * b(k,222) + b(k,201) = b(k,201) - lu(k,2112) * b(k,222) + b(k,200) = b(k,200) - lu(k,2111) * b(k,222) + b(k,199) = b(k,199) - lu(k,2110) * b(k,222) + b(k,198) = b(k,198) - lu(k,2109) * b(k,222) + b(k,195) = b(k,195) - lu(k,2108) * b(k,222) + b(k,194) = b(k,194) - lu(k,2107) * b(k,222) + b(k,193) = b(k,193) - lu(k,2106) * b(k,222) + b(k,192) = b(k,192) - lu(k,2105) * b(k,222) + b(k,191) = b(k,191) - lu(k,2104) * b(k,222) + b(k,190) = b(k,190) - lu(k,2103) * b(k,222) + b(k,188) = b(k,188) - lu(k,2102) * b(k,222) + b(k,187) = b(k,187) - lu(k,2101) * b(k,222) + b(k,186) = b(k,186) - lu(k,2100) * b(k,222) + b(k,185) = b(k,185) - lu(k,2099) * b(k,222) + b(k,184) = b(k,184) - lu(k,2098) * b(k,222) + b(k,183) = b(k,183) - lu(k,2097) * b(k,222) + b(k,182) = b(k,182) - lu(k,2096) * b(k,222) + b(k,181) = b(k,181) - lu(k,2095) * b(k,222) + b(k,180) = b(k,180) - lu(k,2094) * b(k,222) + b(k,178) = b(k,178) - lu(k,2093) * b(k,222) + b(k,173) = b(k,173) - lu(k,2092) * b(k,222) + b(k,172) = b(k,172) - lu(k,2091) * b(k,222) + b(k,168) = b(k,168) - lu(k,2090) * b(k,222) + b(k,159) = b(k,159) - lu(k,2089) * b(k,222) + b(k,156) = b(k,156) - lu(k,2088) * b(k,222) + b(k,150) = b(k,150) - lu(k,2087) * b(k,222) + b(k,140) = b(k,140) - lu(k,2086) * b(k,222) + b(k,135) = b(k,135) - lu(k,2085) * b(k,222) + b(k,128) = b(k,128) - lu(k,2084) * b(k,222) + b(k,114) = b(k,114) - lu(k,2083) * b(k,222) + b(k,86) = b(k,86) - lu(k,2082) * b(k,222) + b(k,41) = b(k,41) - lu(k,2081) * b(k,222) + b(k,40) = b(k,40) - lu(k,2080) * b(k,222) + b(k,39) = b(k,39) - lu(k,2079) * b(k,222) + b(k,38) = b(k,38) - lu(k,2078) * b(k,222) + b(k,37) = b(k,37) - lu(k,2077) * b(k,222) + b(k,221) = b(k,221) * lu(k,2070) + b(k,220) = b(k,220) - lu(k,2069) * b(k,221) + b(k,219) = b(k,219) - lu(k,2068) * b(k,221) + b(k,218) = b(k,218) - lu(k,2067) * b(k,221) + b(k,217) = b(k,217) - lu(k,2066) * b(k,221) + b(k,216) = b(k,216) - lu(k,2065) * b(k,221) + b(k,215) = b(k,215) - lu(k,2064) * b(k,221) + b(k,214) = b(k,214) - lu(k,2063) * b(k,221) + b(k,213) = b(k,213) - lu(k,2062) * b(k,221) + b(k,212) = b(k,212) - lu(k,2061) * b(k,221) + b(k,211) = b(k,211) - lu(k,2060) * b(k,221) + b(k,210) = b(k,210) - lu(k,2059) * b(k,221) + b(k,207) = b(k,207) - lu(k,2058) * b(k,221) + b(k,206) = b(k,206) - lu(k,2057) * b(k,221) + b(k,205) = b(k,205) - lu(k,2056) * b(k,221) + b(k,204) = b(k,204) - lu(k,2055) * b(k,221) + b(k,203) = b(k,203) - lu(k,2054) * b(k,221) + b(k,202) = b(k,202) - lu(k,2053) * b(k,221) + b(k,200) = b(k,200) - lu(k,2052) * b(k,221) + b(k,199) = b(k,199) - lu(k,2051) * b(k,221) + b(k,198) = b(k,198) - lu(k,2050) * b(k,221) + b(k,197) = b(k,197) - lu(k,2049) * b(k,221) + b(k,195) = b(k,195) - lu(k,2048) * b(k,221) + b(k,194) = b(k,194) - lu(k,2047) * b(k,221) + b(k,193) = b(k,193) - lu(k,2046) * b(k,221) + b(k,192) = b(k,192) - lu(k,2045) * b(k,221) + b(k,191) = b(k,191) - lu(k,2044) * b(k,221) + b(k,190) = b(k,190) - lu(k,2043) * b(k,221) + b(k,189) = b(k,189) - lu(k,2042) * b(k,221) + b(k,188) = b(k,188) - lu(k,2041) * b(k,221) + b(k,187) = b(k,187) - lu(k,2040) * b(k,221) + b(k,184) = b(k,184) - lu(k,2039) * b(k,221) + b(k,183) = b(k,183) - lu(k,2038) * b(k,221) + b(k,180) = b(k,180) - lu(k,2037) * b(k,221) + b(k,179) = b(k,179) - lu(k,2036) * b(k,221) + b(k,174) = b(k,174) - lu(k,2035) * b(k,221) + b(k,170) = b(k,170) - lu(k,2034) * b(k,221) + b(k,168) = b(k,168) - lu(k,2033) * b(k,221) + b(k,167) = b(k,167) - lu(k,2032) * b(k,221) + b(k,166) = b(k,166) - lu(k,2031) * b(k,221) + b(k,156) = b(k,156) - lu(k,2030) * b(k,221) + b(k,149) = b(k,149) - lu(k,2029) * b(k,221) + b(k,115) = b(k,115) - lu(k,2028) * b(k,221) + b(k,113) = b(k,113) - lu(k,2027) * b(k,221) + b(k,104) = b(k,104) - lu(k,2026) * b(k,221) + b(k,92) = b(k,92) - lu(k,2025) * b(k,221) end do end subroutine lu_slv07 subroutine lu_slv08( avec_len, lu, b ) @@ -1606,208 +1494,236 @@ subroutine lu_slv08( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,187) = b(k,187) * lu(k,1549) - b(k,186) = b(k,186) - lu(k,1548) * b(k,187) - b(k,185) = b(k,185) - lu(k,1547) * b(k,187) - b(k,184) = b(k,184) - lu(k,1546) * b(k,187) - b(k,183) = b(k,183) - lu(k,1545) * b(k,187) - b(k,182) = b(k,182) - lu(k,1544) * b(k,187) - b(k,181) = b(k,181) - lu(k,1543) * b(k,187) - b(k,180) = b(k,180) - lu(k,1542) * b(k,187) - b(k,179) = b(k,179) - lu(k,1541) * b(k,187) - b(k,174) = b(k,174) - lu(k,1540) * b(k,187) - b(k,173) = b(k,173) - lu(k,1539) * b(k,187) - b(k,163) = b(k,163) - lu(k,1538) * b(k,187) - b(k,162) = b(k,162) - lu(k,1537) * b(k,187) - b(k,155) = b(k,155) - lu(k,1536) * b(k,187) - b(k,150) = b(k,150) - lu(k,1535) * b(k,187) - b(k,149) = b(k,149) - lu(k,1534) * b(k,187) - b(k,148) = b(k,148) - lu(k,1533) * b(k,187) - b(k,138) = b(k,138) - lu(k,1532) * b(k,187) - b(k,136) = b(k,136) - lu(k,1531) * b(k,187) - b(k,133) = b(k,133) - lu(k,1530) * b(k,187) - b(k,125) = b(k,125) - lu(k,1529) * b(k,187) - b(k,119) = b(k,119) - lu(k,1528) * b(k,187) - b(k,114) = b(k,114) - lu(k,1527) * b(k,187) - b(k,111) = b(k,111) - lu(k,1526) * b(k,187) - b(k,105) = b(k,105) - lu(k,1525) * b(k,187) - b(k,104) = b(k,104) - lu(k,1524) * b(k,187) - b(k,96) = b(k,96) - lu(k,1523) * b(k,187) - b(k,89) = b(k,89) - lu(k,1522) * b(k,187) - b(k,75) = b(k,75) - lu(k,1521) * b(k,187) - b(k,50) = b(k,50) - lu(k,1520) * b(k,187) - b(k,186) = b(k,186) * lu(k,1507) - b(k,185) = b(k,185) - lu(k,1506) * b(k,186) - b(k,184) = b(k,184) - lu(k,1505) * b(k,186) - b(k,183) = b(k,183) - lu(k,1504) * b(k,186) - b(k,182) = b(k,182) - lu(k,1503) * b(k,186) - b(k,181) = b(k,181) - lu(k,1502) * b(k,186) - b(k,180) = b(k,180) - lu(k,1501) * b(k,186) - b(k,179) = b(k,179) - lu(k,1500) * b(k,186) - b(k,178) = b(k,178) - lu(k,1499) * b(k,186) - b(k,177) = b(k,177) - lu(k,1498) * b(k,186) - b(k,176) = b(k,176) - lu(k,1497) * b(k,186) - b(k,175) = b(k,175) - lu(k,1496) * b(k,186) - b(k,174) = b(k,174) - lu(k,1495) * b(k,186) - b(k,173) = b(k,173) - lu(k,1494) * b(k,186) - b(k,172) = b(k,172) - lu(k,1493) * b(k,186) - b(k,171) = b(k,171) - lu(k,1492) * b(k,186) - b(k,170) = b(k,170) - lu(k,1491) * b(k,186) - b(k,169) = b(k,169) - lu(k,1490) * b(k,186) - b(k,168) = b(k,168) - lu(k,1489) * b(k,186) - b(k,167) = b(k,167) - lu(k,1488) * b(k,186) - b(k,166) = b(k,166) - lu(k,1487) * b(k,186) - b(k,165) = b(k,165) - lu(k,1486) * b(k,186) - b(k,164) = b(k,164) - lu(k,1485) * b(k,186) - b(k,163) = b(k,163) - lu(k,1484) * b(k,186) - b(k,162) = b(k,162) - lu(k,1483) * b(k,186) - b(k,161) = b(k,161) - lu(k,1482) * b(k,186) - b(k,160) = b(k,160) - lu(k,1481) * b(k,186) - b(k,159) = b(k,159) - lu(k,1480) * b(k,186) - b(k,158) = b(k,158) - lu(k,1479) * b(k,186) - b(k,157) = b(k,157) - lu(k,1478) * b(k,186) - b(k,156) = b(k,156) - lu(k,1477) * b(k,186) - b(k,155) = b(k,155) - lu(k,1476) * b(k,186) - b(k,154) = b(k,154) - lu(k,1475) * b(k,186) - b(k,153) = b(k,153) - lu(k,1474) * b(k,186) - b(k,152) = b(k,152) - lu(k,1473) * b(k,186) - b(k,151) = b(k,151) - lu(k,1472) * b(k,186) - b(k,150) = b(k,150) - lu(k,1471) * b(k,186) - b(k,149) = b(k,149) - lu(k,1470) * b(k,186) - b(k,148) = b(k,148) - lu(k,1469) * b(k,186) - b(k,147) = b(k,147) - lu(k,1468) * b(k,186) - b(k,146) = b(k,146) - lu(k,1467) * b(k,186) - b(k,145) = b(k,145) - lu(k,1466) * b(k,186) - b(k,144) = b(k,144) - lu(k,1465) * b(k,186) - b(k,143) = b(k,143) - lu(k,1464) * b(k,186) - b(k,142) = b(k,142) - lu(k,1463) * b(k,186) - b(k,141) = b(k,141) - lu(k,1462) * b(k,186) - b(k,140) = b(k,140) - lu(k,1461) * b(k,186) - b(k,139) = b(k,139) - lu(k,1460) * b(k,186) - b(k,137) = b(k,137) - lu(k,1459) * b(k,186) - b(k,136) = b(k,136) - lu(k,1458) * b(k,186) - b(k,135) = b(k,135) - lu(k,1457) * b(k,186) - b(k,134) = b(k,134) - lu(k,1456) * b(k,186) - b(k,133) = b(k,133) - lu(k,1455) * b(k,186) - b(k,132) = b(k,132) - lu(k,1454) * b(k,186) - b(k,131) = b(k,131) - lu(k,1453) * b(k,186) - b(k,130) = b(k,130) - lu(k,1452) * b(k,186) - b(k,129) = b(k,129) - lu(k,1451) * b(k,186) - b(k,128) = b(k,128) - lu(k,1450) * b(k,186) - b(k,127) = b(k,127) - lu(k,1449) * b(k,186) - b(k,126) = b(k,126) - lu(k,1448) * b(k,186) - b(k,125) = b(k,125) - lu(k,1447) * b(k,186) - b(k,124) = b(k,124) - lu(k,1446) * b(k,186) - b(k,123) = b(k,123) - lu(k,1445) * b(k,186) - b(k,122) = b(k,122) - lu(k,1444) * b(k,186) - b(k,121) = b(k,121) - lu(k,1443) * b(k,186) - b(k,120) = b(k,120) - lu(k,1442) * b(k,186) - b(k,119) = b(k,119) - lu(k,1441) * b(k,186) - b(k,118) = b(k,118) - lu(k,1440) * b(k,186) - b(k,117) = b(k,117) - lu(k,1439) * b(k,186) - b(k,116) = b(k,116) - lu(k,1438) * b(k,186) - b(k,115) = b(k,115) - lu(k,1437) * b(k,186) - b(k,113) = b(k,113) - lu(k,1436) * b(k,186) - b(k,112) = b(k,112) - lu(k,1435) * b(k,186) - b(k,111) = b(k,111) - lu(k,1434) * b(k,186) - b(k,110) = b(k,110) - lu(k,1433) * b(k,186) - b(k,109) = b(k,109) - lu(k,1432) * b(k,186) - b(k,108) = b(k,108) - lu(k,1431) * b(k,186) - b(k,107) = b(k,107) - lu(k,1430) * b(k,186) - b(k,106) = b(k,106) - lu(k,1429) * b(k,186) - b(k,105) = b(k,105) - lu(k,1428) * b(k,186) - b(k,104) = b(k,104) - lu(k,1427) * b(k,186) - b(k,103) = b(k,103) - lu(k,1426) * b(k,186) - b(k,102) = b(k,102) - lu(k,1425) * b(k,186) - b(k,100) = b(k,100) - lu(k,1424) * b(k,186) - b(k,99) = b(k,99) - lu(k,1423) * b(k,186) - b(k,98) = b(k,98) - lu(k,1422) * b(k,186) - b(k,97) = b(k,97) - lu(k,1421) * b(k,186) - b(k,96) = b(k,96) - lu(k,1420) * b(k,186) - b(k,95) = b(k,95) - lu(k,1419) * b(k,186) - b(k,94) = b(k,94) - lu(k,1418) * b(k,186) - b(k,93) = b(k,93) - lu(k,1417) * b(k,186) - b(k,91) = b(k,91) - lu(k,1416) * b(k,186) - b(k,90) = b(k,90) - lu(k,1415) * b(k,186) - b(k,89) = b(k,89) - lu(k,1414) * b(k,186) - b(k,88) = b(k,88) - lu(k,1413) * b(k,186) - b(k,87) = b(k,87) - lu(k,1412) * b(k,186) - b(k,86) = b(k,86) - lu(k,1411) * b(k,186) - b(k,85) = b(k,85) - lu(k,1410) * b(k,186) - b(k,84) = b(k,84) - lu(k,1409) * b(k,186) - b(k,83) = b(k,83) - lu(k,1408) * b(k,186) - b(k,80) = b(k,80) - lu(k,1407) * b(k,186) - b(k,79) = b(k,79) - lu(k,1406) * b(k,186) - b(k,78) = b(k,78) - lu(k,1405) * b(k,186) - b(k,77) = b(k,77) - lu(k,1404) * b(k,186) - b(k,74) = b(k,74) - lu(k,1403) * b(k,186) - b(k,72) = b(k,72) - lu(k,1402) * b(k,186) - b(k,71) = b(k,71) - lu(k,1401) * b(k,186) - b(k,70) = b(k,70) - lu(k,1400) * b(k,186) - b(k,69) = b(k,69) - lu(k,1399) * b(k,186) - b(k,67) = b(k,67) - lu(k,1398) * b(k,186) - b(k,66) = b(k,66) - lu(k,1397) * b(k,186) - b(k,65) = b(k,65) - lu(k,1396) * b(k,186) - b(k,63) = b(k,63) - lu(k,1395) * b(k,186) - b(k,62) = b(k,62) - lu(k,1394) * b(k,186) - b(k,61) = b(k,61) - lu(k,1393) * b(k,186) - b(k,60) = b(k,60) - lu(k,1392) * b(k,186) - b(k,59) = b(k,59) - lu(k,1391) * b(k,186) - b(k,58) = b(k,58) - lu(k,1390) * b(k,186) - b(k,57) = b(k,57) - lu(k,1389) * b(k,186) - b(k,56) = b(k,56) - lu(k,1388) * b(k,186) - b(k,54) = b(k,54) - lu(k,1387) * b(k,186) - b(k,53) = b(k,53) - lu(k,1386) * b(k,186) - b(k,52) = b(k,52) - lu(k,1385) * b(k,186) - b(k,51) = b(k,51) - lu(k,1384) * b(k,186) - b(k,49) = b(k,49) - lu(k,1383) * b(k,186) - b(k,46) = b(k,46) - lu(k,1382) * b(k,186) - b(k,44) = b(k,44) - lu(k,1381) * b(k,186) - b(k,43) = b(k,43) - lu(k,1380) * b(k,186) - b(k,42) = b(k,42) - lu(k,1379) * b(k,186) - b(k,41) = b(k,41) - lu(k,1378) * b(k,186) - b(k,40) = b(k,40) - lu(k,1377) * b(k,186) - b(k,39) = b(k,39) - lu(k,1376) * b(k,186) - b(k,38) = b(k,38) - lu(k,1375) * b(k,186) - b(k,37) = b(k,37) - lu(k,1374) * b(k,186) - b(k,36) = b(k,36) - lu(k,1373) * b(k,186) - b(k,35) = b(k,35) - lu(k,1372) * b(k,186) - b(k,34) = b(k,34) - lu(k,1371) * b(k,186) - b(k,33) = b(k,33) - lu(k,1370) * b(k,186) - b(k,32) = b(k,32) - lu(k,1369) * b(k,186) - b(k,31) = b(k,31) - lu(k,1368) * b(k,186) - b(k,30) = b(k,30) - lu(k,1367) * b(k,186) - b(k,29) = b(k,29) - lu(k,1366) * b(k,186) - b(k,185) = b(k,185) * lu(k,1352) - b(k,184) = b(k,184) - lu(k,1351) * b(k,185) - b(k,183) = b(k,183) - lu(k,1350) * b(k,185) - b(k,182) = b(k,182) - lu(k,1349) * b(k,185) - b(k,181) = b(k,181) - lu(k,1348) * b(k,185) - b(k,169) = b(k,169) - lu(k,1347) * b(k,185) - b(k,143) = b(k,143) - lu(k,1346) * b(k,185) - b(k,139) = b(k,139) - lu(k,1345) * b(k,185) - b(k,57) = b(k,57) - lu(k,1344) * b(k,185) - b(k,56) = b(k,56) - lu(k,1343) * b(k,185) - b(k,51) = b(k,51) - lu(k,1342) * b(k,185) - b(k,184) = b(k,184) * lu(k,1327) - b(k,183) = b(k,183) - lu(k,1326) * b(k,184) - b(k,182) = b(k,182) - lu(k,1325) * b(k,184) - b(k,181) = b(k,181) - lu(k,1324) * b(k,184) - b(k,174) = b(k,174) - lu(k,1323) * b(k,184) - b(k,155) = b(k,155) - lu(k,1322) * b(k,184) - b(k,148) = b(k,148) - lu(k,1321) * b(k,184) - b(k,145) = b(k,145) - lu(k,1320) * b(k,184) - b(k,82) = b(k,82) - lu(k,1319) * b(k,184) - b(k,68) = b(k,68) - lu(k,1318) * b(k,184) - b(k,55) = b(k,55) - lu(k,1317) * b(k,184) - b(k,45) = b(k,45) - lu(k,1316) * b(k,184) - b(k,183) = b(k,183) * lu(k,1304) - b(k,182) = b(k,182) - lu(k,1303) * b(k,183) - b(k,169) = b(k,169) - lu(k,1302) * b(k,183) - b(k,182) = b(k,182) * lu(k,1291) - b(k,169) = b(k,169) - lu(k,1290) * b(k,182) - b(k,139) = b(k,139) - lu(k,1289) * b(k,182) - b(k,64) = b(k,64) - lu(k,1288) * b(k,182) + b(k,220) = b(k,220) * lu(k,2017) + b(k,219) = b(k,219) - lu(k,2016) * b(k,220) + b(k,218) = b(k,218) - lu(k,2015) * b(k,220) + b(k,217) = b(k,217) - lu(k,2014) * b(k,220) + b(k,216) = b(k,216) - lu(k,2013) * b(k,220) + b(k,215) = b(k,215) - lu(k,2012) * b(k,220) + b(k,214) = b(k,214) - lu(k,2011) * b(k,220) + b(k,213) = b(k,213) - lu(k,2010) * b(k,220) + b(k,212) = b(k,212) - lu(k,2009) * b(k,220) + b(k,211) = b(k,211) - lu(k,2008) * b(k,220) + b(k,210) = b(k,210) - lu(k,2007) * b(k,220) + b(k,209) = b(k,209) - lu(k,2006) * b(k,220) + b(k,208) = b(k,208) - lu(k,2005) * b(k,220) + b(k,207) = b(k,207) - lu(k,2004) * b(k,220) + b(k,192) = b(k,192) - lu(k,2003) * b(k,220) + b(k,191) = b(k,191) - lu(k,2002) * b(k,220) + b(k,190) = b(k,190) - lu(k,2001) * b(k,220) + b(k,184) = b(k,184) - lu(k,2000) * b(k,220) + b(k,181) = b(k,181) - lu(k,1999) * b(k,220) + b(k,177) = b(k,177) - lu(k,1998) * b(k,220) + b(k,171) = b(k,171) - lu(k,1997) * b(k,220) + b(k,170) = b(k,170) - lu(k,1996) * b(k,220) + b(k,159) = b(k,159) - lu(k,1995) * b(k,220) + b(k,147) = b(k,147) - lu(k,1994) * b(k,220) + b(k,146) = b(k,146) - lu(k,1993) * b(k,220) + b(k,140) = b(k,140) - lu(k,1992) * b(k,220) + b(k,129) = b(k,129) - lu(k,1991) * b(k,220) + b(k,125) = b(k,125) - lu(k,1990) * b(k,220) + b(k,112) = b(k,112) - lu(k,1989) * b(k,220) + b(k,99) = b(k,99) - lu(k,1988) * b(k,220) + b(k,98) = b(k,98) - lu(k,1987) * b(k,220) + b(k,70) = b(k,70) - lu(k,1986) * b(k,220) + b(k,219) = b(k,219) * lu(k,1977) + b(k,218) = b(k,218) - lu(k,1976) * b(k,219) + b(k,217) = b(k,217) - lu(k,1975) * b(k,219) + b(k,216) = b(k,216) - lu(k,1974) * b(k,219) + b(k,215) = b(k,215) - lu(k,1973) * b(k,219) + b(k,214) = b(k,214) - lu(k,1972) * b(k,219) + b(k,213) = b(k,213) - lu(k,1971) * b(k,219) + b(k,212) = b(k,212) - lu(k,1970) * b(k,219) + b(k,211) = b(k,211) - lu(k,1969) * b(k,219) + b(k,209) = b(k,209) - lu(k,1968) * b(k,219) + b(k,201) = b(k,201) - lu(k,1967) * b(k,219) + b(k,177) = b(k,177) - lu(k,1966) * b(k,219) + b(k,172) = b(k,172) - lu(k,1965) * b(k,219) + b(k,171) = b(k,171) - lu(k,1964) * b(k,219) + b(k,106) = b(k,106) - lu(k,1963) * b(k,219) + b(k,87) = b(k,87) - lu(k,1962) * b(k,219) + b(k,70) = b(k,70) - lu(k,1961) * b(k,219) + b(k,52) = b(k,52) - lu(k,1960) * b(k,219) + b(k,218) = b(k,218) * lu(k,1950) + b(k,217) = b(k,217) - lu(k,1949) * b(k,218) + b(k,216) = b(k,216) - lu(k,1948) * b(k,218) + b(k,215) = b(k,215) - lu(k,1947) * b(k,218) + b(k,214) = b(k,214) - lu(k,1946) * b(k,218) + b(k,213) = b(k,213) - lu(k,1945) * b(k,218) + b(k,212) = b(k,212) - lu(k,1944) * b(k,218) + b(k,211) = b(k,211) - lu(k,1943) * b(k,218) + b(k,210) = b(k,210) - lu(k,1942) * b(k,218) + b(k,209) = b(k,209) - lu(k,1941) * b(k,218) + b(k,208) = b(k,208) - lu(k,1940) * b(k,218) + b(k,207) = b(k,207) - lu(k,1939) * b(k,218) + b(k,206) = b(k,206) - lu(k,1938) * b(k,218) + b(k,205) = b(k,205) - lu(k,1937) * b(k,218) + b(k,204) = b(k,204) - lu(k,1936) * b(k,218) + b(k,203) = b(k,203) - lu(k,1935) * b(k,218) + b(k,202) = b(k,202) - lu(k,1934) * b(k,218) + b(k,200) = b(k,200) - lu(k,1933) * b(k,218) + b(k,199) = b(k,199) - lu(k,1932) * b(k,218) + b(k,198) = b(k,198) - lu(k,1931) * b(k,218) + b(k,197) = b(k,197) - lu(k,1930) * b(k,218) + b(k,195) = b(k,195) - lu(k,1929) * b(k,218) + b(k,194) = b(k,194) - lu(k,1928) * b(k,218) + b(k,193) = b(k,193) - lu(k,1927) * b(k,218) + b(k,192) = b(k,192) - lu(k,1926) * b(k,218) + b(k,191) = b(k,191) - lu(k,1925) * b(k,218) + b(k,190) = b(k,190) - lu(k,1924) * b(k,218) + b(k,188) = b(k,188) - lu(k,1923) * b(k,218) + b(k,187) = b(k,187) - lu(k,1922) * b(k,218) + b(k,184) = b(k,184) - lu(k,1921) * b(k,218) + b(k,183) = b(k,183) - lu(k,1920) * b(k,218) + b(k,181) = b(k,181) - lu(k,1919) * b(k,218) + b(k,180) = b(k,180) - lu(k,1918) * b(k,218) + b(k,179) = b(k,179) - lu(k,1917) * b(k,218) + b(k,178) = b(k,178) - lu(k,1916) * b(k,218) + b(k,176) = b(k,176) - lu(k,1915) * b(k,218) + b(k,174) = b(k,174) - lu(k,1914) * b(k,218) + b(k,171) = b(k,171) - lu(k,1913) * b(k,218) + b(k,170) = b(k,170) - lu(k,1912) * b(k,218) + b(k,169) = b(k,169) - lu(k,1911) * b(k,218) + b(k,168) = b(k,168) - lu(k,1910) * b(k,218) + b(k,167) = b(k,167) - lu(k,1909) * b(k,218) + b(k,165) = b(k,165) - lu(k,1908) * b(k,218) + b(k,164) = b(k,164) - lu(k,1907) * b(k,218) + b(k,163) = b(k,163) - lu(k,1906) * b(k,218) + b(k,162) = b(k,162) - lu(k,1905) * b(k,218) + b(k,161) = b(k,161) - lu(k,1904) * b(k,218) + b(k,160) = b(k,160) - lu(k,1903) * b(k,218) + b(k,159) = b(k,159) - lu(k,1902) * b(k,218) + b(k,158) = b(k,158) - lu(k,1901) * b(k,218) + b(k,157) = b(k,157) - lu(k,1900) * b(k,218) + b(k,156) = b(k,156) - lu(k,1899) * b(k,218) + b(k,155) = b(k,155) - lu(k,1898) * b(k,218) + b(k,153) = b(k,153) - lu(k,1897) * b(k,218) + b(k,152) = b(k,152) - lu(k,1896) * b(k,218) + b(k,151) = b(k,151) - lu(k,1895) * b(k,218) + b(k,150) = b(k,150) - lu(k,1894) * b(k,218) + b(k,148) = b(k,148) - lu(k,1893) * b(k,218) + b(k,147) = b(k,147) - lu(k,1892) * b(k,218) + b(k,138) = b(k,138) - lu(k,1891) * b(k,218) + b(k,136) = b(k,136) - lu(k,1890) * b(k,218) + b(k,133) = b(k,133) - lu(k,1889) * b(k,218) + b(k,131) = b(k,131) - lu(k,1888) * b(k,218) + b(k,130) = b(k,130) - lu(k,1887) * b(k,218) + b(k,128) = b(k,128) - lu(k,1886) * b(k,218) + b(k,127) = b(k,127) - lu(k,1885) * b(k,218) + b(k,126) = b(k,126) - lu(k,1884) * b(k,218) + b(k,124) = b(k,124) - lu(k,1883) * b(k,218) + b(k,123) = b(k,123) - lu(k,1882) * b(k,218) + b(k,122) = b(k,122) - lu(k,1881) * b(k,218) + b(k,121) = b(k,121) - lu(k,1880) * b(k,218) + b(k,120) = b(k,120) - lu(k,1879) * b(k,218) + b(k,119) = b(k,119) - lu(k,1878) * b(k,218) + b(k,118) = b(k,118) - lu(k,1877) * b(k,218) + b(k,117) = b(k,117) - lu(k,1876) * b(k,218) + b(k,116) = b(k,116) - lu(k,1875) * b(k,218) + b(k,115) = b(k,115) - lu(k,1874) * b(k,218) + b(k,109) = b(k,109) - lu(k,1873) * b(k,218) + b(k,108) = b(k,108) - lu(k,1872) * b(k,218) + b(k,107) = b(k,107) - lu(k,1871) * b(k,218) + b(k,103) = b(k,103) - lu(k,1870) * b(k,218) + b(k,102) = b(k,102) - lu(k,1869) * b(k,218) + b(k,94) = b(k,94) - lu(k,1868) * b(k,218) + b(k,93) = b(k,93) - lu(k,1867) * b(k,218) + b(k,79) = b(k,79) - lu(k,1866) * b(k,218) + b(k,62) = b(k,62) - lu(k,1865) * b(k,218) + b(k,51) = b(k,51) - lu(k,1864) * b(k,218) + b(k,50) = b(k,50) - lu(k,1863) * b(k,218) + b(k,49) = b(k,49) - lu(k,1862) * b(k,218) + b(k,47) = b(k,47) - lu(k,1861) * b(k,218) + b(k,46) = b(k,46) - lu(k,1860) * b(k,218) + b(k,45) = b(k,45) - lu(k,1859) * b(k,218) + b(k,44) = b(k,44) - lu(k,1858) * b(k,218) + b(k,41) = b(k,41) - lu(k,1857) * b(k,218) + b(k,40) = b(k,40) - lu(k,1856) * b(k,218) + b(k,39) = b(k,39) - lu(k,1855) * b(k,218) + b(k,38) = b(k,38) - lu(k,1854) * b(k,218) + b(k,37) = b(k,37) - lu(k,1853) * b(k,218) + b(k,217) = b(k,217) * lu(k,1842) + b(k,216) = b(k,216) - lu(k,1841) * b(k,217) + b(k,215) = b(k,215) - lu(k,1840) * b(k,217) + b(k,214) = b(k,214) - lu(k,1839) * b(k,217) + b(k,213) = b(k,213) - lu(k,1838) * b(k,217) + b(k,212) = b(k,212) - lu(k,1837) * b(k,217) + b(k,211) = b(k,211) - lu(k,1836) * b(k,217) + b(k,210) = b(k,210) - lu(k,1835) * b(k,217) + b(k,209) = b(k,209) - lu(k,1834) * b(k,217) + b(k,207) = b(k,207) - lu(k,1833) * b(k,217) + b(k,206) = b(k,206) - lu(k,1832) * b(k,217) + b(k,205) = b(k,205) - lu(k,1831) * b(k,217) + b(k,204) = b(k,204) - lu(k,1830) * b(k,217) + b(k,203) = b(k,203) - lu(k,1829) * b(k,217) + b(k,202) = b(k,202) - lu(k,1828) * b(k,217) + b(k,200) = b(k,200) - lu(k,1827) * b(k,217) + b(k,199) = b(k,199) - lu(k,1826) * b(k,217) + b(k,198) = b(k,198) - lu(k,1825) * b(k,217) + b(k,197) = b(k,197) - lu(k,1824) * b(k,217) + b(k,196) = b(k,196) - lu(k,1823) * b(k,217) + b(k,195) = b(k,195) - lu(k,1822) * b(k,217) + b(k,194) = b(k,194) - lu(k,1821) * b(k,217) + b(k,193) = b(k,193) - lu(k,1820) * b(k,217) + b(k,192) = b(k,192) - lu(k,1819) * b(k,217) + b(k,191) = b(k,191) - lu(k,1818) * b(k,217) + b(k,190) = b(k,190) - lu(k,1817) * b(k,217) + b(k,189) = b(k,189) - lu(k,1816) * b(k,217) + b(k,188) = b(k,188) - lu(k,1815) * b(k,217) + b(k,187) = b(k,187) - lu(k,1814) * b(k,217) + b(k,184) = b(k,184) - lu(k,1813) * b(k,217) + b(k,183) = b(k,183) - lu(k,1812) * b(k,217) + b(k,181) = b(k,181) - lu(k,1811) * b(k,217) + b(k,180) = b(k,180) - lu(k,1810) * b(k,217) + b(k,179) = b(k,179) - lu(k,1809) * b(k,217) + b(k,178) = b(k,178) - lu(k,1808) * b(k,217) + b(k,176) = b(k,176) - lu(k,1807) * b(k,217) + b(k,174) = b(k,174) - lu(k,1806) * b(k,217) + b(k,170) = b(k,170) - lu(k,1805) * b(k,217) + b(k,168) = b(k,168) - lu(k,1804) * b(k,217) + b(k,167) = b(k,167) - lu(k,1803) * b(k,217) + b(k,164) = b(k,164) - lu(k,1802) * b(k,217) + b(k,163) = b(k,163) - lu(k,1801) * b(k,217) + b(k,162) = b(k,162) - lu(k,1800) * b(k,217) + b(k,161) = b(k,161) - lu(k,1799) * b(k,217) + b(k,160) = b(k,160) - lu(k,1798) * b(k,217) + b(k,159) = b(k,159) - lu(k,1797) * b(k,217) + b(k,155) = b(k,155) - lu(k,1796) * b(k,217) + b(k,154) = b(k,154) - lu(k,1795) * b(k,217) + b(k,150) = b(k,150) - lu(k,1794) * b(k,217) + b(k,149) = b(k,149) - lu(k,1793) * b(k,217) + b(k,145) = b(k,145) - lu(k,1792) * b(k,217) + b(k,144) = b(k,144) - lu(k,1791) * b(k,217) + b(k,142) = b(k,142) - lu(k,1790) * b(k,217) + b(k,141) = b(k,141) - lu(k,1789) * b(k,217) + b(k,136) = b(k,136) - lu(k,1788) * b(k,217) + b(k,134) = b(k,134) - lu(k,1787) * b(k,217) + b(k,133) = b(k,133) - lu(k,1786) * b(k,217) + b(k,132) = b(k,132) - lu(k,1785) * b(k,217) + b(k,131) = b(k,131) - lu(k,1784) * b(k,217) + b(k,128) = b(k,128) - lu(k,1783) * b(k,217) + b(k,127) = b(k,127) - lu(k,1782) * b(k,217) + b(k,126) = b(k,126) - lu(k,1781) * b(k,217) + b(k,124) = b(k,124) - lu(k,1780) * b(k,217) + b(k,123) = b(k,123) - lu(k,1779) * b(k,217) + b(k,105) = b(k,105) - lu(k,1778) * b(k,217) + b(k,104) = b(k,104) - lu(k,1777) * b(k,217) + b(k,96) = b(k,96) - lu(k,1776) * b(k,217) + b(k,94) = b(k,94) - lu(k,1775) * b(k,217) + b(k,90) = b(k,90) - lu(k,1774) * b(k,217) + b(k,88) = b(k,88) - lu(k,1773) * b(k,217) + b(k,51) = b(k,51) - lu(k,1772) * b(k,217) + b(k,50) = b(k,50) - lu(k,1771) * b(k,217) + b(k,49) = b(k,49) - lu(k,1770) * b(k,217) + b(k,47) = b(k,47) - lu(k,1769) * b(k,217) + b(k,46) = b(k,46) - lu(k,1768) * b(k,217) + b(k,45) = b(k,45) - lu(k,1767) * b(k,217) + b(k,44) = b(k,44) - lu(k,1766) * b(k,217) + b(k,41) = b(k,41) - lu(k,1765) * b(k,217) + b(k,40) = b(k,40) - lu(k,1764) * b(k,217) + b(k,39) = b(k,39) - lu(k,1763) * b(k,217) + b(k,38) = b(k,38) - lu(k,1762) * b(k,217) + b(k,37) = b(k,37) - lu(k,1761) * b(k,217) end do end subroutine lu_slv08 subroutine lu_slv09( avec_len, lu, b ) @@ -1828,209 +1744,232 @@ subroutine lu_slv09( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,181) = b(k,181) * lu(k,1278) - b(k,162) = b(k,162) - lu(k,1277) * b(k,181) - b(k,143) = b(k,143) - lu(k,1276) * b(k,181) - b(k,180) = b(k,180) * lu(k,1264) - b(k,179) = b(k,179) - lu(k,1263) * b(k,180) - b(k,178) = b(k,178) - lu(k,1262) * b(k,180) - b(k,177) = b(k,177) - lu(k,1261) * b(k,180) - b(k,176) = b(k,176) - lu(k,1260) * b(k,180) - b(k,175) = b(k,175) - lu(k,1259) * b(k,180) - b(k,173) = b(k,173) - lu(k,1258) * b(k,180) - b(k,172) = b(k,172) - lu(k,1257) * b(k,180) - b(k,171) = b(k,171) - lu(k,1256) * b(k,180) - b(k,170) = b(k,170) - lu(k,1255) * b(k,180) - b(k,163) = b(k,163) - lu(k,1254) * b(k,180) - b(k,162) = b(k,162) - lu(k,1253) * b(k,180) - b(k,159) = b(k,159) - lu(k,1252) * b(k,180) - b(k,158) = b(k,158) - lu(k,1251) * b(k,180) - b(k,149) = b(k,149) - lu(k,1250) * b(k,180) - b(k,117) = b(k,117) - lu(k,1249) * b(k,180) - b(k,112) = b(k,112) - lu(k,1248) * b(k,180) - b(k,104) = b(k,104) - lu(k,1247) * b(k,180) - b(k,86) = b(k,86) - lu(k,1246) * b(k,180) - b(k,179) = b(k,179) * lu(k,1233) - b(k,173) = b(k,173) - lu(k,1232) * b(k,179) - b(k,163) = b(k,163) - lu(k,1231) * b(k,179) - b(k,119) = b(k,119) - lu(k,1230) * b(k,179) - b(k,117) = b(k,117) - lu(k,1229) * b(k,179) - b(k,112) = b(k,112) - lu(k,1228) * b(k,179) - b(k,178) = b(k,178) * lu(k,1214) - b(k,177) = b(k,177) - lu(k,1213) * b(k,178) - b(k,176) = b(k,176) - lu(k,1212) * b(k,178) - b(k,173) = b(k,173) - lu(k,1211) * b(k,178) - b(k,172) = b(k,172) - lu(k,1210) * b(k,178) - b(k,170) = b(k,170) - lu(k,1209) * b(k,178) - b(k,168) = b(k,168) - lu(k,1208) * b(k,178) - b(k,167) = b(k,167) - lu(k,1207) * b(k,178) - b(k,163) = b(k,163) - lu(k,1206) * b(k,178) - b(k,162) = b(k,162) - lu(k,1205) * b(k,178) - b(k,160) = b(k,160) - lu(k,1204) * b(k,178) - b(k,159) = b(k,159) - lu(k,1203) * b(k,178) - b(k,141) = b(k,141) - lu(k,1202) * b(k,178) - b(k,130) = b(k,130) - lu(k,1201) * b(k,178) - b(k,123) = b(k,123) - lu(k,1200) * b(k,178) - b(k,177) = b(k,177) * lu(k,1187) - b(k,173) = b(k,173) - lu(k,1186) * b(k,177) - b(k,168) = b(k,168) - lu(k,1185) * b(k,177) - b(k,167) = b(k,167) - lu(k,1184) * b(k,177) - b(k,163) = b(k,163) - lu(k,1183) * b(k,177) - b(k,162) = b(k,162) - lu(k,1182) * b(k,177) - b(k,160) = b(k,160) - lu(k,1181) * b(k,177) - b(k,159) = b(k,159) - lu(k,1180) * b(k,177) - b(k,141) = b(k,141) - lu(k,1179) * b(k,177) - b(k,79) = b(k,79) - lu(k,1178) * b(k,177) - b(k,176) = b(k,176) * lu(k,1164) - b(k,173) = b(k,173) - lu(k,1163) * b(k,176) - b(k,168) = b(k,168) - lu(k,1162) * b(k,176) - b(k,163) = b(k,163) - lu(k,1161) * b(k,176) - b(k,162) = b(k,162) - lu(k,1160) * b(k,176) - b(k,156) = b(k,156) - lu(k,1159) * b(k,176) - b(k,142) = b(k,142) - lu(k,1158) * b(k,176) - b(k,175) = b(k,175) * lu(k,1142) - b(k,173) = b(k,173) - lu(k,1141) * b(k,175) - b(k,172) = b(k,172) - lu(k,1140) * b(k,175) - b(k,170) = b(k,170) - lu(k,1139) * b(k,175) - b(k,168) = b(k,168) - lu(k,1138) * b(k,175) - b(k,167) = b(k,167) - lu(k,1137) * b(k,175) - b(k,163) = b(k,163) - lu(k,1136) * b(k,175) - b(k,162) = b(k,162) - lu(k,1135) * b(k,175) - b(k,160) = b(k,160) - lu(k,1134) * b(k,175) - b(k,159) = b(k,159) - lu(k,1133) * b(k,175) - b(k,150) = b(k,150) - lu(k,1132) * b(k,175) - b(k,149) = b(k,149) - lu(k,1131) * b(k,175) - b(k,147) = b(k,147) - lu(k,1130) * b(k,175) - b(k,141) = b(k,141) - lu(k,1129) * b(k,175) - b(k,130) = b(k,130) - lu(k,1128) * b(k,175) - b(k,120) = b(k,120) - lu(k,1127) * b(k,175) - b(k,115) = b(k,115) - lu(k,1126) * b(k,175) - b(k,86) = b(k,86) - lu(k,1125) * b(k,175) - b(k,65) = b(k,65) - lu(k,1124) * b(k,175) - b(k,174) = b(k,174) * lu(k,1111) - b(k,148) = b(k,148) - lu(k,1110) * b(k,174) - b(k,109) = b(k,109) - lu(k,1109) * b(k,174) - b(k,82) = b(k,82) - lu(k,1108) * b(k,174) - b(k,173) = b(k,173) * lu(k,1100) - b(k,162) = b(k,162) - lu(k,1099) * b(k,173) - b(k,172) = b(k,172) * lu(k,1088) - b(k,162) = b(k,162) - lu(k,1087) * b(k,172) - b(k,142) = b(k,142) - lu(k,1086) * b(k,172) - b(k,171) = b(k,171) * lu(k,1072) - b(k,170) = b(k,170) - lu(k,1071) * b(k,171) - b(k,162) = b(k,162) - lu(k,1070) * b(k,171) - b(k,159) = b(k,159) - lu(k,1069) * b(k,171) - b(k,158) = b(k,158) - lu(k,1068) * b(k,171) - b(k,147) = b(k,147) - lu(k,1067) * b(k,171) - b(k,141) = b(k,141) - lu(k,1066) * b(k,171) - b(k,130) = b(k,130) - lu(k,1065) * b(k,171) - b(k,95) = b(k,95) - lu(k,1064) * b(k,171) - b(k,90) = b(k,90) - lu(k,1063) * b(k,171) - b(k,170) = b(k,170) * lu(k,1052) - b(k,163) = b(k,163) - lu(k,1051) * b(k,170) - b(k,162) = b(k,162) - lu(k,1050) * b(k,170) - b(k,159) = b(k,159) - lu(k,1049) * b(k,170) - b(k,149) = b(k,149) - lu(k,1048) * b(k,170) - b(k,141) = b(k,141) - lu(k,1047) * b(k,170) - b(k,61) = b(k,61) - lu(k,1046) * b(k,170) - b(k,169) = b(k,169) * lu(k,1035) - b(k,139) = b(k,139) - lu(k,1034) * b(k,169) - b(k,64) = b(k,64) - lu(k,1033) * b(k,169) - b(k,168) = b(k,168) * lu(k,1024) - b(k,162) = b(k,162) - lu(k,1023) * b(k,168) - b(k,167) = b(k,167) * lu(k,1013) - b(k,163) = b(k,163) - lu(k,1012) * b(k,167) - b(k,141) = b(k,141) - lu(k,1011) * b(k,167) - b(k,97) = b(k,97) - lu(k,1010) * b(k,167) - b(k,166) = b(k,166) * lu(k,997) - b(k,165) = b(k,165) - lu(k,996) * b(k,166) - b(k,162) = b(k,162) - lu(k,995) * b(k,166) - b(k,161) = b(k,161) - lu(k,994) * b(k,166) - b(k,157) = b(k,157) - lu(k,993) * b(k,166) - b(k,141) = b(k,141) - lu(k,992) * b(k,166) - b(k,124) = b(k,124) - lu(k,991) * b(k,166) - b(k,93) = b(k,93) - lu(k,990) * b(k,166) - b(k,165) = b(k,165) * lu(k,978) - b(k,162) = b(k,162) - lu(k,977) * b(k,165) - b(k,161) = b(k,161) - lu(k,976) * b(k,165) - b(k,159) = b(k,159) - lu(k,975) * b(k,165) - b(k,154) = b(k,154) - lu(k,974) * b(k,165) - b(k,141) = b(k,141) - lu(k,973) * b(k,165) - b(k,122) = b(k,122) - lu(k,972) * b(k,165) - b(k,66) = b(k,66) - lu(k,971) * b(k,165) - b(k,164) = b(k,164) * lu(k,956) - b(k,162) = b(k,162) - lu(k,955) * b(k,164) - b(k,161) = b(k,161) - lu(k,954) * b(k,164) - b(k,157) = b(k,157) - lu(k,953) * b(k,164) - b(k,154) = b(k,154) - lu(k,952) * b(k,164) - b(k,141) = b(k,141) - lu(k,951) * b(k,164) - b(k,124) = b(k,124) - lu(k,950) * b(k,164) - b(k,106) = b(k,106) - lu(k,949) * b(k,164) - b(k,163) = b(k,163) * lu(k,943) - b(k,162) = b(k,162) * lu(k,939) - b(k,161) = b(k,161) * lu(k,930) - b(k,154) = b(k,154) - lu(k,929) * b(k,161) - b(k,160) = b(k,160) * lu(k,916) - b(k,159) = b(k,159) - lu(k,915) * b(k,160) - b(k,154) = b(k,154) - lu(k,914) * b(k,160) - b(k,66) = b(k,66) - lu(k,913) * b(k,160) - b(k,159) = b(k,159) * lu(k,908) - b(k,149) = b(k,149) - lu(k,907) * b(k,159) - b(k,158) = b(k,158) * lu(k,896) - b(k,150) = b(k,150) - lu(k,895) * b(k,158) - b(k,149) = b(k,149) - lu(k,894) * b(k,158) - b(k,147) = b(k,147) - lu(k,893) * b(k,158) - b(k,120) = b(k,120) - lu(k,892) * b(k,158) - b(k,157) = b(k,157) * lu(k,884) - b(k,156) = b(k,156) * lu(k,869) - b(k,147) = b(k,147) - lu(k,868) * b(k,156) - b(k,142) = b(k,142) - lu(k,867) * b(k,156) - b(k,137) = b(k,137) - lu(k,866) * b(k,156) - b(k,117) = b(k,117) - lu(k,865) * b(k,156) - b(k,155) = b(k,155) * lu(k,855) - b(k,145) = b(k,145) - lu(k,854) * b(k,155) - b(k,55) = b(k,55) - lu(k,853) * b(k,155) - b(k,154) = b(k,154) * lu(k,847) - b(k,153) = b(k,153) * lu(k,837) - b(k,144) = b(k,144) - lu(k,836) * b(k,153) - b(k,129) = b(k,129) - lu(k,835) * b(k,153) - b(k,128) = b(k,128) - lu(k,834) * b(k,153) - b(k,126) = b(k,126) - lu(k,833) * b(k,153) - b(k,110) = b(k,110) - lu(k,832) * b(k,153) - b(k,152) = b(k,152) * lu(k,815) - b(k,149) = b(k,149) - lu(k,814) * b(k,152) - b(k,142) = b(k,142) - lu(k,813) * b(k,152) - b(k,92) = b(k,92) - lu(k,812) * b(k,152) - b(k,67) = b(k,67) - lu(k,811) * b(k,152) - b(k,40) = b(k,40) - lu(k,810) * b(k,152) - b(k,33) = b(k,33) - lu(k,809) * b(k,152) - b(k,32) = b(k,32) - lu(k,808) * b(k,152) - b(k,31) = b(k,31) - lu(k,807) * b(k,152) - b(k,30) = b(k,30) - lu(k,806) * b(k,152) - b(k,29) = b(k,29) - lu(k,805) * b(k,152) - b(k,151) = b(k,151) * lu(k,788) - b(k,149) = b(k,149) - lu(k,787) * b(k,151) - b(k,142) = b(k,142) - lu(k,786) * b(k,151) - b(k,92) = b(k,92) - lu(k,785) * b(k,151) - b(k,67) = b(k,67) - lu(k,784) * b(k,151) - b(k,35) = b(k,35) - lu(k,783) * b(k,151) - b(k,33) = b(k,33) - lu(k,782) * b(k,151) - b(k,32) = b(k,32) - lu(k,781) * b(k,151) - b(k,31) = b(k,31) - lu(k,780) * b(k,151) - b(k,30) = b(k,30) - lu(k,779) * b(k,151) - b(k,29) = b(k,29) - lu(k,778) * b(k,151) - b(k,150) = b(k,150) * lu(k,770) - b(k,149) = b(k,149) - lu(k,769) * b(k,150) - b(k,149) = b(k,149) * lu(k,765) - b(k,29) = b(k,29) - lu(k,764) * b(k,149) - b(k,148) = b(k,148) * lu(k,758) - b(k,70) = b(k,70) - lu(k,757) * b(k,148) - b(k,147) = b(k,147) * lu(k,751) - b(k,146) = b(k,146) * lu(k,735) - b(k,142) = b(k,142) - lu(k,734) * b(k,146) - b(k,37) = b(k,37) - lu(k,733) * b(k,146) - b(k,33) = b(k,33) - lu(k,732) * b(k,146) - b(k,32) = b(k,32) - lu(k,731) * b(k,146) + b(k,216) = b(k,216) * lu(k,1749) + b(k,215) = b(k,215) - lu(k,1748) * b(k,216) + b(k,214) = b(k,214) - lu(k,1747) * b(k,216) + b(k,213) = b(k,213) - lu(k,1746) * b(k,216) + b(k,212) = b(k,212) - lu(k,1745) * b(k,216) + b(k,211) = b(k,211) - lu(k,1744) * b(k,216) + b(k,210) = b(k,210) - lu(k,1743) * b(k,216) + b(k,209) = b(k,209) - lu(k,1742) * b(k,216) + b(k,207) = b(k,207) - lu(k,1741) * b(k,216) + b(k,206) = b(k,206) - lu(k,1740) * b(k,216) + b(k,205) = b(k,205) - lu(k,1739) * b(k,216) + b(k,204) = b(k,204) - lu(k,1738) * b(k,216) + b(k,203) = b(k,203) - lu(k,1737) * b(k,216) + b(k,202) = b(k,202) - lu(k,1736) * b(k,216) + b(k,201) = b(k,201) - lu(k,1735) * b(k,216) + b(k,200) = b(k,200) - lu(k,1734) * b(k,216) + b(k,199) = b(k,199) - lu(k,1733) * b(k,216) + b(k,198) = b(k,198) - lu(k,1732) * b(k,216) + b(k,197) = b(k,197) - lu(k,1731) * b(k,216) + b(k,196) = b(k,196) - lu(k,1730) * b(k,216) + b(k,195) = b(k,195) - lu(k,1729) * b(k,216) + b(k,194) = b(k,194) - lu(k,1728) * b(k,216) + b(k,193) = b(k,193) - lu(k,1727) * b(k,216) + b(k,192) = b(k,192) - lu(k,1726) * b(k,216) + b(k,191) = b(k,191) - lu(k,1725) * b(k,216) + b(k,190) = b(k,190) - lu(k,1724) * b(k,216) + b(k,189) = b(k,189) - lu(k,1723) * b(k,216) + b(k,188) = b(k,188) - lu(k,1722) * b(k,216) + b(k,187) = b(k,187) - lu(k,1721) * b(k,216) + b(k,186) = b(k,186) - lu(k,1720) * b(k,216) + b(k,185) = b(k,185) - lu(k,1719) * b(k,216) + b(k,184) = b(k,184) - lu(k,1718) * b(k,216) + b(k,183) = b(k,183) - lu(k,1717) * b(k,216) + b(k,182) = b(k,182) - lu(k,1716) * b(k,216) + b(k,181) = b(k,181) - lu(k,1715) * b(k,216) + b(k,180) = b(k,180) - lu(k,1714) * b(k,216) + b(k,174) = b(k,174) - lu(k,1713) * b(k,216) + b(k,173) = b(k,173) - lu(k,1712) * b(k,216) + b(k,172) = b(k,172) - lu(k,1711) * b(k,216) + b(k,142) = b(k,142) - lu(k,1710) * b(k,216) + b(k,110) = b(k,110) - lu(k,1709) * b(k,216) + b(k,104) = b(k,104) - lu(k,1708) * b(k,216) + b(k,100) = b(k,100) - lu(k,1707) * b(k,216) + b(k,95) = b(k,95) - lu(k,1706) * b(k,216) + b(k,41) = b(k,41) - lu(k,1705) * b(k,216) + b(k,40) = b(k,40) - lu(k,1704) * b(k,216) + b(k,215) = b(k,215) * lu(k,1691) + b(k,214) = b(k,214) - lu(k,1690) * b(k,215) + b(k,213) = b(k,213) - lu(k,1689) * b(k,215) + b(k,212) = b(k,212) - lu(k,1688) * b(k,215) + b(k,211) = b(k,211) - lu(k,1687) * b(k,215) + b(k,210) = b(k,210) - lu(k,1686) * b(k,215) + b(k,209) = b(k,209) - lu(k,1685) * b(k,215) + b(k,208) = b(k,208) - lu(k,1684) * b(k,215) + b(k,207) = b(k,207) - lu(k,1683) * b(k,215) + b(k,206) = b(k,206) - lu(k,1682) * b(k,215) + b(k,205) = b(k,205) - lu(k,1681) * b(k,215) + b(k,204) = b(k,204) - lu(k,1680) * b(k,215) + b(k,203) = b(k,203) - lu(k,1679) * b(k,215) + b(k,202) = b(k,202) - lu(k,1678) * b(k,215) + b(k,201) = b(k,201) - lu(k,1677) * b(k,215) + b(k,200) = b(k,200) - lu(k,1676) * b(k,215) + b(k,199) = b(k,199) - lu(k,1675) * b(k,215) + b(k,198) = b(k,198) - lu(k,1674) * b(k,215) + b(k,197) = b(k,197) - lu(k,1673) * b(k,215) + b(k,196) = b(k,196) - lu(k,1672) * b(k,215) + b(k,195) = b(k,195) - lu(k,1671) * b(k,215) + b(k,194) = b(k,194) - lu(k,1670) * b(k,215) + b(k,193) = b(k,193) - lu(k,1669) * b(k,215) + b(k,192) = b(k,192) - lu(k,1668) * b(k,215) + b(k,191) = b(k,191) - lu(k,1667) * b(k,215) + b(k,190) = b(k,190) - lu(k,1666) * b(k,215) + b(k,189) = b(k,189) - lu(k,1665) * b(k,215) + b(k,188) = b(k,188) - lu(k,1664) * b(k,215) + b(k,187) = b(k,187) - lu(k,1663) * b(k,215) + b(k,186) = b(k,186) - lu(k,1662) * b(k,215) + b(k,185) = b(k,185) - lu(k,1661) * b(k,215) + b(k,184) = b(k,184) - lu(k,1660) * b(k,215) + b(k,183) = b(k,183) - lu(k,1659) * b(k,215) + b(k,182) = b(k,182) - lu(k,1658) * b(k,215) + b(k,181) = b(k,181) - lu(k,1657) * b(k,215) + b(k,180) = b(k,180) - lu(k,1656) * b(k,215) + b(k,179) = b(k,179) - lu(k,1655) * b(k,215) + b(k,178) = b(k,178) - lu(k,1654) * b(k,215) + b(k,177) = b(k,177) - lu(k,1653) * b(k,215) + b(k,176) = b(k,176) - lu(k,1652) * b(k,215) + b(k,175) = b(k,175) - lu(k,1651) * b(k,215) + b(k,174) = b(k,174) - lu(k,1650) * b(k,215) + b(k,173) = b(k,173) - lu(k,1649) * b(k,215) + b(k,172) = b(k,172) - lu(k,1648) * b(k,215) + b(k,171) = b(k,171) - lu(k,1647) * b(k,215) + b(k,170) = b(k,170) - lu(k,1646) * b(k,215) + b(k,169) = b(k,169) - lu(k,1645) * b(k,215) + b(k,168) = b(k,168) - lu(k,1644) * b(k,215) + b(k,167) = b(k,167) - lu(k,1643) * b(k,215) + b(k,166) = b(k,166) - lu(k,1642) * b(k,215) + b(k,164) = b(k,164) - lu(k,1641) * b(k,215) + b(k,163) = b(k,163) - lu(k,1640) * b(k,215) + b(k,162) = b(k,162) - lu(k,1639) * b(k,215) + b(k,161) = b(k,161) - lu(k,1638) * b(k,215) + b(k,160) = b(k,160) - lu(k,1637) * b(k,215) + b(k,159) = b(k,159) - lu(k,1636) * b(k,215) + b(k,158) = b(k,158) - lu(k,1635) * b(k,215) + b(k,157) = b(k,157) - lu(k,1634) * b(k,215) + b(k,156) = b(k,156) - lu(k,1633) * b(k,215) + b(k,155) = b(k,155) - lu(k,1632) * b(k,215) + b(k,154) = b(k,154) - lu(k,1631) * b(k,215) + b(k,153) = b(k,153) - lu(k,1630) * b(k,215) + b(k,152) = b(k,152) - lu(k,1629) * b(k,215) + b(k,151) = b(k,151) - lu(k,1628) * b(k,215) + b(k,150) = b(k,150) - lu(k,1627) * b(k,215) + b(k,149) = b(k,149) - lu(k,1626) * b(k,215) + b(k,148) = b(k,148) - lu(k,1625) * b(k,215) + b(k,147) = b(k,147) - lu(k,1624) * b(k,215) + b(k,146) = b(k,146) - lu(k,1623) * b(k,215) + b(k,145) = b(k,145) - lu(k,1622) * b(k,215) + b(k,144) = b(k,144) - lu(k,1621) * b(k,215) + b(k,143) = b(k,143) - lu(k,1620) * b(k,215) + b(k,142) = b(k,142) - lu(k,1619) * b(k,215) + b(k,141) = b(k,141) - lu(k,1618) * b(k,215) + b(k,140) = b(k,140) - lu(k,1617) * b(k,215) + b(k,138) = b(k,138) - lu(k,1616) * b(k,215) + b(k,137) = b(k,137) - lu(k,1615) * b(k,215) + b(k,136) = b(k,136) - lu(k,1614) * b(k,215) + b(k,135) = b(k,135) - lu(k,1613) * b(k,215) + b(k,134) = b(k,134) - lu(k,1612) * b(k,215) + b(k,133) = b(k,133) - lu(k,1611) * b(k,215) + b(k,132) = b(k,132) - lu(k,1610) * b(k,215) + b(k,131) = b(k,131) - lu(k,1609) * b(k,215) + b(k,130) = b(k,130) - lu(k,1608) * b(k,215) + b(k,129) = b(k,129) - lu(k,1607) * b(k,215) + b(k,128) = b(k,128) - lu(k,1606) * b(k,215) + b(k,127) = b(k,127) - lu(k,1605) * b(k,215) + b(k,126) = b(k,126) - lu(k,1604) * b(k,215) + b(k,125) = b(k,125) - lu(k,1603) * b(k,215) + b(k,123) = b(k,123) - lu(k,1602) * b(k,215) + b(k,122) = b(k,122) - lu(k,1601) * b(k,215) + b(k,121) = b(k,121) - lu(k,1600) * b(k,215) + b(k,120) = b(k,120) - lu(k,1599) * b(k,215) + b(k,119) = b(k,119) - lu(k,1598) * b(k,215) + b(k,118) = b(k,118) - lu(k,1597) * b(k,215) + b(k,117) = b(k,117) - lu(k,1596) * b(k,215) + b(k,116) = b(k,116) - lu(k,1595) * b(k,215) + b(k,115) = b(k,115) - lu(k,1594) * b(k,215) + b(k,113) = b(k,113) - lu(k,1593) * b(k,215) + b(k,112) = b(k,112) - lu(k,1592) * b(k,215) + b(k,111) = b(k,111) - lu(k,1591) * b(k,215) + b(k,110) = b(k,110) - lu(k,1590) * b(k,215) + b(k,109) = b(k,109) - lu(k,1589) * b(k,215) + b(k,108) = b(k,108) - lu(k,1588) * b(k,215) + b(k,107) = b(k,107) - lu(k,1587) * b(k,215) + b(k,104) = b(k,104) - lu(k,1586) * b(k,215) + b(k,103) = b(k,103) - lu(k,1585) * b(k,215) + b(k,102) = b(k,102) - lu(k,1584) * b(k,215) + b(k,101) = b(k,101) - lu(k,1583) * b(k,215) + b(k,100) = b(k,100) - lu(k,1582) * b(k,215) + b(k,99) = b(k,99) - lu(k,1581) * b(k,215) + b(k,98) = b(k,98) - lu(k,1580) * b(k,215) + b(k,93) = b(k,93) - lu(k,1579) * b(k,215) + b(k,92) = b(k,92) - lu(k,1578) * b(k,215) + b(k,91) = b(k,91) - lu(k,1577) * b(k,215) + b(k,90) = b(k,90) - lu(k,1576) * b(k,215) + b(k,89) = b(k,89) - lu(k,1575) * b(k,215) + b(k,88) = b(k,88) - lu(k,1574) * b(k,215) + b(k,86) = b(k,86) - lu(k,1573) * b(k,215) + b(k,85) = b(k,85) - lu(k,1572) * b(k,215) + b(k,84) = b(k,84) - lu(k,1571) * b(k,215) + b(k,83) = b(k,83) - lu(k,1570) * b(k,215) + b(k,82) = b(k,82) - lu(k,1569) * b(k,215) + b(k,81) = b(k,81) - lu(k,1568) * b(k,215) + b(k,80) = b(k,80) - lu(k,1567) * b(k,215) + b(k,79) = b(k,79) - lu(k,1566) * b(k,215) + b(k,78) = b(k,78) - lu(k,1565) * b(k,215) + b(k,77) = b(k,77) - lu(k,1564) * b(k,215) + b(k,76) = b(k,76) - lu(k,1563) * b(k,215) + b(k,74) = b(k,74) - lu(k,1562) * b(k,215) + b(k,73) = b(k,73) - lu(k,1561) * b(k,215) + b(k,72) = b(k,72) - lu(k,1560) * b(k,215) + b(k,71) = b(k,71) - lu(k,1559) * b(k,215) + b(k,64) = b(k,64) - lu(k,1558) * b(k,215) + b(k,61) = b(k,61) - lu(k,1557) * b(k,215) + b(k,57) = b(k,57) - lu(k,1556) * b(k,215) + b(k,55) = b(k,55) - lu(k,1555) * b(k,215) + b(k,53) = b(k,53) - lu(k,1554) * b(k,215) + b(k,51) = b(k,51) - lu(k,1553) * b(k,215) + b(k,50) = b(k,50) - lu(k,1552) * b(k,215) + b(k,49) = b(k,49) - lu(k,1551) * b(k,215) + b(k,48) = b(k,48) - lu(k,1550) * b(k,215) + b(k,47) = b(k,47) - lu(k,1549) * b(k,215) + b(k,46) = b(k,46) - lu(k,1548) * b(k,215) + b(k,45) = b(k,45) - lu(k,1547) * b(k,215) + b(k,44) = b(k,44) - lu(k,1546) * b(k,215) + b(k,43) = b(k,43) - lu(k,1545) * b(k,215) + b(k,41) = b(k,41) - lu(k,1544) * b(k,215) + b(k,40) = b(k,40) - lu(k,1543) * b(k,215) + b(k,39) = b(k,39) - lu(k,1542) * b(k,215) + b(k,38) = b(k,38) - lu(k,1541) * b(k,215) + b(k,37) = b(k,37) - lu(k,1540) * b(k,215) + b(k,214) = b(k,214) * lu(k,1526) + b(k,213) = b(k,213) - lu(k,1525) * b(k,214) + b(k,212) = b(k,212) - lu(k,1524) * b(k,214) + b(k,211) = b(k,211) - lu(k,1523) * b(k,214) + b(k,210) = b(k,210) - lu(k,1522) * b(k,214) + b(k,209) = b(k,209) - lu(k,1521) * b(k,214) + b(k,208) = b(k,208) - lu(k,1520) * b(k,214) + b(k,175) = b(k,175) - lu(k,1519) * b(k,214) + b(k,169) = b(k,169) - lu(k,1518) * b(k,214) + b(k,146) = b(k,146) - lu(k,1517) * b(k,214) + b(k,129) = b(k,129) - lu(k,1516) * b(k,214) + b(k,125) = b(k,125) - lu(k,1515) * b(k,214) + b(k,101) = b(k,101) - lu(k,1514) * b(k,214) + b(k,89) = b(k,89) - lu(k,1513) * b(k,214) + b(k,85) = b(k,85) - lu(k,1512) * b(k,214) + b(k,83) = b(k,83) - lu(k,1511) * b(k,214) + b(k,82) = b(k,82) - lu(k,1510) * b(k,214) + b(k,75) = b(k,75) - lu(k,1509) * b(k,214) + b(k,74) = b(k,74) - lu(k,1508) * b(k,214) + b(k,69) = b(k,69) - lu(k,1507) * b(k,214) + b(k,68) = b(k,68) - lu(k,1506) * b(k,214) + b(k,67) = b(k,67) - lu(k,1505) * b(k,214) + b(k,66) = b(k,66) - lu(k,1504) * b(k,214) + b(k,60) = b(k,60) - lu(k,1503) * b(k,214) + b(k,59) = b(k,59) - lu(k,1502) * b(k,214) + b(k,58) = b(k,58) - lu(k,1501) * b(k,214) + b(k,56) = b(k,56) - lu(k,1500) * b(k,214) + b(k,54) = b(k,54) - lu(k,1499) * b(k,214) end do end subroutine lu_slv09 subroutine lu_slv10( avec_len, lu, b ) @@ -2051,207 +1990,218 @@ subroutine lu_slv10( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,145) = b(k,145) * lu(k,724) - b(k,55) = b(k,55) - lu(k,723) * b(k,145) - b(k,144) = b(k,144) * lu(k,715) - b(k,141) = b(k,141) - lu(k,714) * b(k,144) - b(k,85) = b(k,85) - lu(k,713) * b(k,144) - b(k,71) = b(k,71) - lu(k,712) * b(k,144) - b(k,143) = b(k,143) * lu(k,704) - b(k,142) = b(k,142) * lu(k,700) - b(k,141) = b(k,141) * lu(k,696) - b(k,140) = b(k,140) * lu(k,686) - b(k,98) = b(k,98) - lu(k,685) * b(k,140) - b(k,139) = b(k,139) * lu(k,677) - b(k,64) = b(k,64) - lu(k,676) * b(k,139) - b(k,138) = b(k,138) * lu(k,668) - b(k,68) = b(k,68) - lu(k,667) * b(k,138) - b(k,137) = b(k,137) * lu(k,658) - b(k,113) = b(k,113) - lu(k,657) * b(k,137) - b(k,136) = b(k,136) * lu(k,649) - b(k,135) = b(k,135) * lu(k,638) - b(k,133) = b(k,133) - lu(k,637) * b(k,135) - b(k,131) = b(k,131) - lu(k,636) * b(k,135) - b(k,120) = b(k,120) - lu(k,635) * b(k,135) - b(k,103) = b(k,103) - lu(k,634) * b(k,135) - b(k,81) = b(k,81) - lu(k,633) * b(k,135) - b(k,76) = b(k,76) - lu(k,632) * b(k,135) - b(k,134) = b(k,134) * lu(k,622) - b(k,133) = b(k,133) - lu(k,621) * b(k,134) - b(k,127) = b(k,127) - lu(k,620) * b(k,134) - b(k,120) = b(k,120) - lu(k,619) * b(k,134) - b(k,103) = b(k,103) - lu(k,618) * b(k,134) - b(k,76) = b(k,76) - lu(k,617) * b(k,134) - b(k,133) = b(k,133) * lu(k,611) - b(k,132) = b(k,132) * lu(k,604) - b(k,73) = b(k,73) - lu(k,603) * b(k,132) - b(k,47) = b(k,47) - lu(k,602) * b(k,132) - b(k,131) = b(k,131) * lu(k,591) - b(k,120) = b(k,120) - lu(k,590) * b(k,131) - b(k,103) = b(k,103) - lu(k,589) * b(k,131) - b(k,81) = b(k,81) - lu(k,588) * b(k,131) - b(k,76) = b(k,76) - lu(k,587) * b(k,131) - b(k,130) = b(k,130) * lu(k,580) - b(k,49) = b(k,49) - lu(k,579) * b(k,130) - b(k,129) = b(k,129) * lu(k,572) - b(k,80) = b(k,80) - lu(k,571) * b(k,129) - b(k,128) = b(k,128) * lu(k,561) - b(k,110) = b(k,110) - lu(k,560) * b(k,128) - b(k,127) = b(k,127) * lu(k,550) - b(k,120) = b(k,120) - lu(k,549) * b(k,127) - b(k,103) = b(k,103) - lu(k,548) * b(k,127) - b(k,76) = b(k,76) - lu(k,547) * b(k,127) - b(k,126) = b(k,126) * lu(k,537) - b(k,110) = b(k,110) - lu(k,536) * b(k,126) - b(k,125) = b(k,125) * lu(k,530) - b(k,105) = b(k,105) - lu(k,529) * b(k,125) - b(k,72) = b(k,72) - lu(k,528) * b(k,125) - b(k,124) = b(k,124) * lu(k,522) - b(k,123) = b(k,123) * lu(k,513) - b(k,122) = b(k,122) * lu(k,504) - b(k,121) = b(k,121) * lu(k,497) - b(k,120) = b(k,120) * lu(k,493) - b(k,119) = b(k,119) * lu(k,485) - b(k,118) = b(k,118) * lu(k,477) - b(k,117) = b(k,117) * lu(k,473) - b(k,116) = b(k,116) * lu(k,465) - b(k,115) = b(k,115) * lu(k,457) - b(k,114) = b(k,114) * lu(k,449) - b(k,113) = b(k,113) * lu(k,441) - b(k,112) = b(k,112) * lu(k,435) - b(k,111) = b(k,111) * lu(k,429) - b(k,50) = b(k,50) - lu(k,428) * b(k,111) - b(k,110) = b(k,110) * lu(k,423) - b(k,109) = b(k,109) * lu(k,417) - b(k,108) = b(k,108) * lu(k,410) - b(k,99) = b(k,99) - lu(k,409) * b(k,108) - b(k,107) = b(k,107) * lu(k,402) - b(k,103) = b(k,103) - lu(k,401) * b(k,107) - b(k,91) = b(k,91) - lu(k,400) * b(k,107) - b(k,106) = b(k,106) * lu(k,393) - b(k,105) = b(k,105) * lu(k,389) - b(k,104) = b(k,104) * lu(k,382) - b(k,103) = b(k,103) * lu(k,379) - b(k,102) = b(k,102) * lu(k,373) - b(k,83) = b(k,83) - lu(k,372) * b(k,102) - b(k,101) = b(k,101) * lu(k,366) - b(k,100) = b(k,100) * lu(k,360) - b(k,84) = b(k,84) - lu(k,359) * b(k,100) - b(k,69) = b(k,69) - lu(k,358) * b(k,100) - b(k,99) = b(k,99) * lu(k,352) - b(k,98) = b(k,98) * lu(k,346) - b(k,97) = b(k,97) * lu(k,340) - b(k,96) = b(k,96) * lu(k,334) - b(k,95) = b(k,95) * lu(k,328) - b(k,94) = b(k,94) * lu(k,322) - b(k,93) = b(k,93) * lu(k,316) - b(k,92) = b(k,92) * lu(k,310) - b(k,91) = b(k,91) * lu(k,304) - b(k,90) = b(k,90) * lu(k,298) - b(k,89) = b(k,89) * lu(k,292) - b(k,88) = b(k,88) * lu(k,284) - b(k,87) = b(k,87) * lu(k,276) - b(k,86) = b(k,86) * lu(k,273) - b(k,85) = b(k,85) * lu(k,268) - b(k,84) = b(k,84) * lu(k,263) - b(k,69) = b(k,69) - lu(k,262) * b(k,84) - b(k,83) = b(k,83) * lu(k,257) - b(k,82) = b(k,82) * lu(k,252) - b(k,81) = b(k,81) * lu(k,247) - b(k,80) = b(k,80) * lu(k,242) - b(k,79) = b(k,79) * lu(k,237) - b(k,78) = b(k,78) * lu(k,231) - b(k,77) = b(k,77) * lu(k,225) - b(k,76) = b(k,76) * lu(k,222) - b(k,75) = b(k,75) * lu(k,216) - b(k,74) = b(k,74) * lu(k,210) - b(k,73) = b(k,73) * lu(k,206) - b(k,72) = b(k,72) * lu(k,202) - b(k,71) = b(k,71) * lu(k,198) - b(k,70) = b(k,70) * lu(k,194) - b(k,48) = b(k,48) - lu(k,193) * b(k,70) - b(k,69) = b(k,69) * lu(k,190) - b(k,68) = b(k,68) * lu(k,187) - b(k,67) = b(k,67) * lu(k,184) - b(k,66) = b(k,66) * lu(k,181) - b(k,65) = b(k,65) * lu(k,176) - b(k,64) = b(k,64) * lu(k,173) - b(k,63) = b(k,63) * lu(k,168) - b(k,62) = b(k,62) * lu(k,160) - b(k,60) = b(k,60) - lu(k,159) * b(k,62) - b(k,42) = b(k,42) - lu(k,158) * b(k,62) - b(k,61) = b(k,61) * lu(k,155) - b(k,60) = b(k,60) * lu(k,151) - b(k,59) = b(k,59) * lu(k,146) - b(k,58) = b(k,58) * lu(k,139) - b(k,41) = b(k,41) - lu(k,138) * b(k,58) - b(k,57) = b(k,57) * lu(k,134) - b(k,56) = b(k,56) * lu(k,130) - b(k,55) = b(k,55) * lu(k,128) - b(k,54) = b(k,54) * lu(k,123) - b(k,53) = b(k,53) * lu(k,119) - b(k,52) = b(k,52) * lu(k,113) - b(k,36) = b(k,36) - lu(k,112) * b(k,52) - b(k,51) = b(k,51) * lu(k,109) - b(k,50) = b(k,50) * lu(k,106) - b(k,49) = b(k,49) * lu(k,103) - b(k,48) = b(k,48) * lu(k,100) - b(k,47) = b(k,47) * lu(k,97) - b(k,46) = b(k,46) * lu(k,93) - b(k,45) = b(k,45) * lu(k,90) - b(k,44) = b(k,44) * lu(k,87) - b(k,43) = b(k,43) * lu(k,84) - b(k,42) = b(k,42) * lu(k,83) - b(k,33) = b(k,33) - lu(k,82) * b(k,42) - b(k,32) = b(k,32) - lu(k,81) * b(k,42) - b(k,31) = b(k,31) - lu(k,80) * b(k,42) - b(k,30) = b(k,30) - lu(k,79) * b(k,42) - b(k,29) = b(k,29) - lu(k,78) * b(k,42) - b(k,41) = b(k,41) * lu(k,77) - b(k,33) = b(k,33) - lu(k,76) * b(k,41) - b(k,32) = b(k,32) - lu(k,75) * b(k,41) - b(k,31) = b(k,31) - lu(k,74) * b(k,41) - b(k,30) = b(k,30) - lu(k,73) * b(k,41) - b(k,29) = b(k,29) - lu(k,72) * b(k,41) - b(k,40) = b(k,40) * lu(k,71) - b(k,33) = b(k,33) - lu(k,70) * b(k,40) - b(k,32) = b(k,32) - lu(k,69) * b(k,40) - b(k,31) = b(k,31) - lu(k,68) * b(k,40) - b(k,30) = b(k,30) - lu(k,67) * b(k,40) - b(k,29) = b(k,29) - lu(k,66) * b(k,40) - b(k,39) = b(k,39) * lu(k,65) - b(k,38) = b(k,38) - lu(k,64) * b(k,39) - b(k,38) = b(k,38) * lu(k,63) - b(k,33) = b(k,33) - lu(k,62) * b(k,38) - b(k,32) = b(k,32) - lu(k,61) * b(k,38) - b(k,31) = b(k,31) - lu(k,60) * b(k,38) - b(k,30) = b(k,30) - lu(k,59) * b(k,38) - b(k,29) = b(k,29) - lu(k,58) * b(k,38) - b(k,37) = b(k,37) * lu(k,57) - b(k,33) = b(k,33) - lu(k,56) * b(k,37) - b(k,32) = b(k,32) - lu(k,55) * b(k,37) - b(k,31) = b(k,31) - lu(k,54) * b(k,37) - b(k,30) = b(k,30) - lu(k,53) * b(k,37) - b(k,29) = b(k,29) - lu(k,52) * b(k,37) - b(k,36) = b(k,36) * lu(k,51) - b(k,33) = b(k,33) - lu(k,50) * b(k,36) - b(k,32) = b(k,32) - lu(k,49) * b(k,36) - b(k,31) = b(k,31) - lu(k,48) * b(k,36) - b(k,30) = b(k,30) - lu(k,47) * b(k,36) - b(k,29) = b(k,29) - lu(k,46) * b(k,36) - b(k,35) = b(k,35) * lu(k,45) - b(k,33) = b(k,33) - lu(k,44) * b(k,35) - b(k,32) = b(k,32) - lu(k,43) * b(k,35) - b(k,31) = b(k,31) - lu(k,42) * b(k,35) - b(k,30) = b(k,30) - lu(k,41) * b(k,35) - b(k,29) = b(k,29) - lu(k,40) * b(k,35) - b(k,34) = b(k,34) * lu(k,39) - b(k,33) = b(k,33) - lu(k,38) * b(k,34) - b(k,32) = b(k,32) - lu(k,37) * b(k,34) - b(k,31) = b(k,31) - lu(k,36) * b(k,34) - b(k,30) = b(k,30) - lu(k,35) * b(k,34) - b(k,29) = b(k,29) - lu(k,34) * b(k,34) - b(k,33) = b(k,33) * lu(k,33) + b(k,213) = b(k,213) * lu(k,1485) + b(k,212) = b(k,212) - lu(k,1484) * b(k,213) + b(k,211) = b(k,211) - lu(k,1483) * b(k,213) + b(k,210) = b(k,210) - lu(k,1482) * b(k,213) + b(k,209) = b(k,209) - lu(k,1481) * b(k,213) + b(k,208) = b(k,208) - lu(k,1480) * b(k,213) + b(k,192) = b(k,192) - lu(k,1479) * b(k,213) + b(k,181) = b(k,181) - lu(k,1478) * b(k,213) + b(k,169) = b(k,169) - lu(k,1477) * b(k,213) + b(k,124) = b(k,124) - lu(k,1476) * b(k,213) + b(k,212) = b(k,212) * lu(k,1463) + b(k,211) = b(k,211) - lu(k,1462) * b(k,212) + b(k,210) = b(k,210) - lu(k,1461) * b(k,212) + b(k,208) = b(k,208) - lu(k,1460) * b(k,212) + b(k,211) = b(k,211) * lu(k,1447) + b(k,210) = b(k,210) - lu(k,1446) * b(k,211) + b(k,208) = b(k,208) - lu(k,1445) * b(k,211) + b(k,175) = b(k,175) - lu(k,1444) * b(k,211) + b(k,97) = b(k,97) - lu(k,1443) * b(k,211) + b(k,210) = b(k,210) * lu(k,1430) + b(k,208) = b(k,208) - lu(k,1429) * b(k,210) + b(k,192) = b(k,192) - lu(k,1428) * b(k,210) + b(k,175) = b(k,175) - lu(k,1427) * b(k,210) + b(k,168) = b(k,168) - lu(k,1426) * b(k,210) + b(k,97) = b(k,97) - lu(k,1425) * b(k,210) + b(k,209) = b(k,209) * lu(k,1415) + b(k,192) = b(k,192) - lu(k,1414) * b(k,209) + b(k,169) = b(k,169) - lu(k,1413) * b(k,209) + b(k,208) = b(k,208) * lu(k,1401) + b(k,175) = b(k,175) - lu(k,1400) * b(k,208) + b(k,97) = b(k,97) - lu(k,1399) * b(k,208) + b(k,207) = b(k,207) * lu(k,1386) + b(k,206) = b(k,206) - lu(k,1385) * b(k,207) + b(k,205) = b(k,205) - lu(k,1384) * b(k,207) + b(k,204) = b(k,204) - lu(k,1383) * b(k,207) + b(k,203) = b(k,203) - lu(k,1382) * b(k,207) + b(k,202) = b(k,202) - lu(k,1381) * b(k,207) + b(k,200) = b(k,200) - lu(k,1380) * b(k,207) + b(k,199) = b(k,199) - lu(k,1379) * b(k,207) + b(k,198) = b(k,198) - lu(k,1378) * b(k,207) + b(k,197) = b(k,197) - lu(k,1377) * b(k,207) + b(k,195) = b(k,195) - lu(k,1376) * b(k,207) + b(k,192) = b(k,192) - lu(k,1375) * b(k,207) + b(k,191) = b(k,191) - lu(k,1374) * b(k,207) + b(k,189) = b(k,189) - lu(k,1373) * b(k,207) + b(k,184) = b(k,184) - lu(k,1372) * b(k,207) + b(k,168) = b(k,168) - lu(k,1371) * b(k,207) + b(k,156) = b(k,156) - lu(k,1370) * b(k,207) + b(k,148) = b(k,148) - lu(k,1369) * b(k,207) + b(k,137) = b(k,137) - lu(k,1368) * b(k,207) + b(k,104) = b(k,104) - lu(k,1367) * b(k,207) + b(k,206) = b(k,206) * lu(k,1354) + b(k,200) = b(k,200) - lu(k,1353) * b(k,206) + b(k,195) = b(k,195) - lu(k,1352) * b(k,206) + b(k,192) = b(k,192) - lu(k,1351) * b(k,206) + b(k,168) = b(k,168) - lu(k,1350) * b(k,206) + b(k,156) = b(k,156) - lu(k,1349) * b(k,206) + b(k,148) = b(k,148) - lu(k,1348) * b(k,206) + b(k,143) = b(k,143) - lu(k,1347) * b(k,206) + b(k,205) = b(k,205) * lu(k,1332) + b(k,204) = b(k,204) - lu(k,1331) * b(k,205) + b(k,200) = b(k,200) - lu(k,1330) * b(k,205) + b(k,195) = b(k,195) - lu(k,1329) * b(k,205) + b(k,192) = b(k,192) - lu(k,1328) * b(k,205) + b(k,190) = b(k,190) - lu(k,1327) * b(k,205) + b(k,186) = b(k,186) - lu(k,1326) * b(k,205) + b(k,181) = b(k,181) - lu(k,1325) * b(k,205) + b(k,168) = b(k,168) - lu(k,1324) * b(k,205) + b(k,204) = b(k,204) * lu(k,1311) + b(k,200) = b(k,200) - lu(k,1310) * b(k,204) + b(k,196) = b(k,196) - lu(k,1309) * b(k,204) + b(k,195) = b(k,195) - lu(k,1308) * b(k,204) + b(k,192) = b(k,192) - lu(k,1307) * b(k,204) + b(k,191) = b(k,191) - lu(k,1306) * b(k,204) + b(k,166) = b(k,166) - lu(k,1305) * b(k,204) + b(k,102) = b(k,102) - lu(k,1304) * b(k,204) + b(k,203) = b(k,203) * lu(k,1288) + b(k,200) = b(k,200) - lu(k,1287) * b(k,203) + b(k,199) = b(k,199) - lu(k,1286) * b(k,203) + b(k,197) = b(k,197) - lu(k,1285) * b(k,203) + b(k,196) = b(k,196) - lu(k,1284) * b(k,203) + b(k,195) = b(k,195) - lu(k,1283) * b(k,203) + b(k,192) = b(k,192) - lu(k,1282) * b(k,203) + b(k,191) = b(k,191) - lu(k,1281) * b(k,203) + b(k,184) = b(k,184) - lu(k,1280) * b(k,203) + b(k,176) = b(k,176) - lu(k,1279) * b(k,203) + b(k,174) = b(k,174) - lu(k,1278) * b(k,203) + b(k,166) = b(k,166) - lu(k,1277) * b(k,203) + b(k,157) = b(k,157) - lu(k,1276) * b(k,203) + b(k,145) = b(k,145) - lu(k,1275) * b(k,203) + b(k,141) = b(k,141) - lu(k,1274) * b(k,203) + b(k,104) = b(k,104) - lu(k,1273) * b(k,203) + b(k,84) = b(k,84) - lu(k,1272) * b(k,203) + b(k,202) = b(k,202) * lu(k,1256) + b(k,200) = b(k,200) - lu(k,1255) * b(k,202) + b(k,199) = b(k,199) - lu(k,1254) * b(k,202) + b(k,197) = b(k,197) - lu(k,1253) * b(k,202) + b(k,196) = b(k,196) - lu(k,1252) * b(k,202) + b(k,195) = b(k,195) - lu(k,1251) * b(k,202) + b(k,192) = b(k,192) - lu(k,1250) * b(k,202) + b(k,191) = b(k,191) - lu(k,1249) * b(k,202) + b(k,168) = b(k,168) - lu(k,1248) * b(k,202) + b(k,166) = b(k,166) - lu(k,1247) * b(k,202) + b(k,157) = b(k,157) - lu(k,1246) * b(k,202) + b(k,144) = b(k,144) - lu(k,1245) * b(k,202) + b(k,201) = b(k,201) * lu(k,1232) + b(k,172) = b(k,172) - lu(k,1231) * b(k,201) + b(k,135) = b(k,135) - lu(k,1230) * b(k,201) + b(k,106) = b(k,106) - lu(k,1229) * b(k,201) + b(k,200) = b(k,200) * lu(k,1221) + b(k,192) = b(k,192) - lu(k,1220) * b(k,200) + b(k,199) = b(k,199) * lu(k,1209) + b(k,192) = b(k,192) - lu(k,1208) * b(k,199) + b(k,181) = b(k,181) - lu(k,1207) * b(k,199) + b(k,198) = b(k,198) * lu(k,1193) + b(k,197) = b(k,197) - lu(k,1192) * b(k,198) + b(k,192) = b(k,192) - lu(k,1191) * b(k,198) + b(k,191) = b(k,191) - lu(k,1190) * b(k,198) + b(k,189) = b(k,189) - lu(k,1189) * b(k,198) + b(k,174) = b(k,174) - lu(k,1188) * b(k,198) + b(k,166) = b(k,166) - lu(k,1187) * b(k,198) + b(k,157) = b(k,157) - lu(k,1186) * b(k,198) + b(k,117) = b(k,117) - lu(k,1185) * b(k,198) + b(k,113) = b(k,113) - lu(k,1184) * b(k,198) + b(k,197) = b(k,197) * lu(k,1173) + b(k,195) = b(k,195) - lu(k,1172) * b(k,197) + b(k,192) = b(k,192) - lu(k,1171) * b(k,197) + b(k,191) = b(k,191) - lu(k,1170) * b(k,197) + b(k,184) = b(k,184) - lu(k,1169) * b(k,197) + b(k,168) = b(k,168) - lu(k,1168) * b(k,197) + b(k,166) = b(k,166) - lu(k,1167) * b(k,197) + b(k,79) = b(k,79) - lu(k,1166) * b(k,197) + b(k,196) = b(k,196) * lu(k,1153) + b(k,195) = b(k,195) - lu(k,1152) * b(k,196) + b(k,194) = b(k,194) - lu(k,1151) * b(k,196) + b(k,192) = b(k,192) - lu(k,1150) * b(k,196) + b(k,191) = b(k,191) - lu(k,1149) * b(k,196) + b(k,190) = b(k,190) - lu(k,1148) * b(k,196) + b(k,180) = b(k,180) - lu(k,1147) * b(k,196) + b(k,88) = b(k,88) - lu(k,1146) * b(k,196) + b(k,195) = b(k,195) * lu(k,1140) + b(k,194) = b(k,194) * lu(k,1129) + b(k,166) = b(k,166) - lu(k,1128) * b(k,194) + b(k,119) = b(k,119) - lu(k,1127) * b(k,194) + b(k,193) = b(k,193) * lu(k,1115) + b(k,192) = b(k,192) - lu(k,1114) * b(k,193) + b(k,191) = b(k,191) - lu(k,1113) * b(k,193) + b(k,188) = b(k,188) - lu(k,1112) * b(k,193) + b(k,180) = b(k,180) - lu(k,1111) * b(k,193) + b(k,168) = b(k,168) - lu(k,1110) * b(k,193) + b(k,166) = b(k,166) - lu(k,1109) * b(k,193) + b(k,152) = b(k,152) - lu(k,1108) * b(k,193) + b(k,88) = b(k,88) - lu(k,1107) * b(k,193) + b(k,192) = b(k,192) * lu(k,1103) + b(k,168) = b(k,168) - lu(k,1102) * b(k,192) + b(k,191) = b(k,191) * lu(k,1096) + b(k,184) = b(k,184) - lu(k,1095) * b(k,191) + b(k,168) = b(k,168) - lu(k,1094) * b(k,191) + b(k,190) = b(k,190) * lu(k,1085) + b(k,189) = b(k,189) * lu(k,1073) + b(k,184) = b(k,184) - lu(k,1072) * b(k,189) + b(k,176) = b(k,176) - lu(k,1071) * b(k,189) + b(k,174) = b(k,174) - lu(k,1070) * b(k,189) + b(k,145) = b(k,145) - lu(k,1069) * b(k,189) + b(k,188) = b(k,188) * lu(k,1059) + b(k,180) = b(k,180) - lu(k,1058) * b(k,188) + b(k,168) = b(k,168) - lu(k,1057) * b(k,188) + b(k,187) = b(k,187) * lu(k,1045) + b(k,183) = b(k,183) - lu(k,1044) * b(k,187) + b(k,166) = b(k,166) - lu(k,1043) * b(k,187) + b(k,149) = b(k,149) - lu(k,1042) * b(k,187) + b(k,116) = b(k,116) - lu(k,1041) * b(k,187) + b(k,186) = b(k,186) * lu(k,1024) + b(k,181) = b(k,181) - lu(k,1023) * b(k,186) + b(k,174) = b(k,174) - lu(k,1022) * b(k,186) + b(k,168) = b(k,168) - lu(k,1021) * b(k,186) + b(k,164) = b(k,164) - lu(k,1020) * b(k,186) + b(k,156) = b(k,156) - lu(k,1019) * b(k,186) + b(k,185) = b(k,185) * lu(k,999) + b(k,184) = b(k,184) - lu(k,998) * b(k,185) + b(k,183) = b(k,183) - lu(k,997) * b(k,185) + b(k,181) = b(k,181) - lu(k,996) * b(k,185) + b(k,180) = b(k,180) - lu(k,995) * b(k,185) + b(k,179) = b(k,179) - lu(k,994) * b(k,185) + b(k,178) = b(k,178) - lu(k,993) * b(k,185) + b(k,168) = b(k,168) - lu(k,992) * b(k,185) + b(k,114) = b(k,114) - lu(k,991) * b(k,185) + b(k,86) = b(k,86) - lu(k,990) * b(k,185) + b(k,44) = b(k,44) - lu(k,989) * b(k,185) + b(k,41) = b(k,41) - lu(k,988) * b(k,185) + b(k,40) = b(k,40) - lu(k,987) * b(k,185) + b(k,39) = b(k,39) - lu(k,986) * b(k,185) + b(k,38) = b(k,38) - lu(k,985) * b(k,185) + b(k,37) = b(k,37) - lu(k,984) * b(k,185) + b(k,184) = b(k,184) * lu(k,979) + b(k,168) = b(k,168) - lu(k,978) * b(k,184) + b(k,37) = b(k,37) - lu(k,977) * b(k,184) + b(k,183) = b(k,183) * lu(k,969) + b(k,182) = b(k,182) * lu(k,948) + b(k,181) = b(k,181) - lu(k,947) * b(k,182) + b(k,180) = b(k,180) - lu(k,946) * b(k,182) + b(k,179) = b(k,179) - lu(k,945) * b(k,182) + b(k,178) = b(k,178) - lu(k,944) * b(k,182) + b(k,168) = b(k,168) - lu(k,943) * b(k,182) + b(k,114) = b(k,114) - lu(k,942) * b(k,182) + b(k,86) = b(k,86) - lu(k,941) * b(k,182) + b(k,49) = b(k,49) - lu(k,940) * b(k,182) + b(k,41) = b(k,41) - lu(k,939) * b(k,182) + b(k,40) = b(k,40) - lu(k,938) * b(k,182) + b(k,39) = b(k,39) - lu(k,937) * b(k,182) + b(k,38) = b(k,38) - lu(k,936) * b(k,182) + b(k,37) = b(k,37) - lu(k,935) * b(k,182) end do end subroutine lu_slv10 subroutine lu_slv11( avec_len, lu, b ) @@ -2272,6 +2222,281 @@ subroutine lu_slv11( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len + b(k,181) = b(k,181) * lu(k,929) + b(k,168) = b(k,168) - lu(k,928) * b(k,181) + b(k,180) = b(k,180) * lu(k,922) + b(k,179) = b(k,179) * lu(k,912) + b(k,166) = b(k,166) - lu(k,911) * b(k,179) + b(k,149) = b(k,149) - lu(k,910) * b(k,179) + b(k,130) = b(k,130) - lu(k,909) * b(k,179) + b(k,178) = b(k,178) * lu(k,899) + b(k,170) = b(k,170) - lu(k,898) * b(k,178) + b(k,155) = b(k,155) - lu(k,897) * b(k,178) + b(k,154) = b(k,154) - lu(k,896) * b(k,178) + b(k,151) = b(k,151) - lu(k,895) * b(k,178) + b(k,134) = b(k,134) - lu(k,894) * b(k,178) + b(k,177) = b(k,177) * lu(k,884) + b(k,171) = b(k,171) - lu(k,883) * b(k,177) + b(k,70) = b(k,70) - lu(k,882) * b(k,177) + b(k,176) = b(k,176) * lu(k,873) + b(k,175) = b(k,175) * lu(k,864) + b(k,97) = b(k,97) - lu(k,863) * b(k,175) + b(k,174) = b(k,174) * lu(k,857) + b(k,173) = b(k,173) * lu(k,841) + b(k,46) = b(k,46) - lu(k,840) * b(k,173) + b(k,41) = b(k,41) - lu(k,839) * b(k,173) + b(k,40) = b(k,40) - lu(k,838) * b(k,173) + b(k,172) = b(k,172) * lu(k,832) + b(k,91) = b(k,91) - lu(k,831) * b(k,172) + b(k,171) = b(k,171) * lu(k,824) + b(k,70) = b(k,70) - lu(k,823) * b(k,171) + b(k,170) = b(k,170) * lu(k,815) + b(k,166) = b(k,166) - lu(k,814) * b(k,170) + b(k,109) = b(k,109) - lu(k,813) * b(k,170) + b(k,92) = b(k,92) - lu(k,812) * b(k,170) + b(k,169) = b(k,169) * lu(k,804) + b(k,168) = b(k,168) * lu(k,801) + b(k,167) = b(k,167) * lu(k,791) + b(k,120) = b(k,120) - lu(k,790) * b(k,167) + b(k,166) = b(k,166) * lu(k,786) + b(k,165) = b(k,165) * lu(k,778) + b(k,87) = b(k,87) - lu(k,777) * b(k,165) + b(k,164) = b(k,164) * lu(k,768) + b(k,138) = b(k,138) - lu(k,767) * b(k,164) + b(k,163) = b(k,163) * lu(k,759) + b(k,162) = b(k,162) * lu(k,748) + b(k,160) = b(k,160) - lu(k,747) * b(k,162) + b(k,158) = b(k,158) - lu(k,746) * b(k,162) + b(k,145) = b(k,145) - lu(k,745) * b(k,162) + b(k,127) = b(k,127) - lu(k,744) * b(k,162) + b(k,105) = b(k,105) - lu(k,743) * b(k,162) + b(k,96) = b(k,96) - lu(k,742) * b(k,162) + b(k,161) = b(k,161) * lu(k,732) + b(k,160) = b(k,160) - lu(k,731) * b(k,161) + b(k,153) = b(k,153) - lu(k,730) * b(k,161) + b(k,145) = b(k,145) - lu(k,729) * b(k,161) + b(k,127) = b(k,127) - lu(k,728) * b(k,161) + b(k,96) = b(k,96) - lu(k,727) * b(k,161) + b(k,160) = b(k,160) * lu(k,721) + b(k,159) = b(k,159) * lu(k,714) + b(k,94) = b(k,94) - lu(k,713) * b(k,159) + b(k,62) = b(k,62) - lu(k,712) * b(k,159) + b(k,158) = b(k,158) * lu(k,701) + b(k,145) = b(k,145) - lu(k,700) * b(k,158) + b(k,127) = b(k,127) - lu(k,699) * b(k,158) + b(k,105) = b(k,105) - lu(k,698) * b(k,158) + b(k,96) = b(k,96) - lu(k,697) * b(k,158) + b(k,157) = b(k,157) * lu(k,690) + b(k,64) = b(k,64) - lu(k,689) * b(k,157) + b(k,156) = b(k,156) * lu(k,684) + b(k,155) = b(k,155) * lu(k,677) + b(k,103) = b(k,103) - lu(k,676) * b(k,155) + b(k,154) = b(k,154) * lu(k,666) + b(k,134) = b(k,134) - lu(k,665) * b(k,154) + b(k,153) = b(k,153) * lu(k,655) + b(k,145) = b(k,145) - lu(k,654) * b(k,153) + b(k,127) = b(k,127) - lu(k,653) * b(k,153) + b(k,96) = b(k,96) - lu(k,652) * b(k,153) + b(k,152) = b(k,152) * lu(k,642) + b(k,151) = b(k,151) * lu(k,632) + b(k,134) = b(k,134) - lu(k,631) * b(k,151) + b(k,150) = b(k,150) * lu(k,625) + b(k,128) = b(k,128) - lu(k,624) * b(k,150) + b(k,93) = b(k,93) - lu(k,623) * b(k,150) + b(k,149) = b(k,149) * lu(k,617) + b(k,148) = b(k,148) * lu(k,610) + b(k,147) = b(k,147) * lu(k,603) + b(k,146) = b(k,146) * lu(k,594) + b(k,145) = b(k,145) * lu(k,590) + b(k,144) = b(k,144) * lu(k,581) + b(k,143) = b(k,143) * lu(k,572) + b(k,142) = b(k,142) * lu(k,564) + b(k,141) = b(k,141) * lu(k,556) + b(k,140) = b(k,140) * lu(k,548) + b(k,139) = b(k,139) * lu(k,540) + b(k,138) = b(k,138) * lu(k,532) + b(k,137) = b(k,137) * lu(k,524) + b(k,136) = b(k,136) * lu(k,518) + b(k,65) = b(k,65) - lu(k,517) * b(k,136) + b(k,135) = b(k,135) * lu(k,511) + b(k,134) = b(k,134) * lu(k,506) + b(k,133) = b(k,133) * lu(k,499) + b(k,122) = b(k,122) - lu(k,498) * b(k,133) + b(k,132) = b(k,132) * lu(k,491) + b(k,75) = b(k,75) - lu(k,490) * b(k,132) + b(k,131) = b(k,131) * lu(k,483) + b(k,127) = b(k,127) - lu(k,482) * b(k,131) + b(k,121) = b(k,121) - lu(k,481) * b(k,131) + b(k,130) = b(k,130) * lu(k,474) + b(k,129) = b(k,129) * lu(k,467) + b(k,128) = b(k,128) * lu(k,463) + b(k,127) = b(k,127) * lu(k,460) + b(k,126) = b(k,126) * lu(k,454) + b(k,107) = b(k,107) - lu(k,453) * b(k,126) + b(k,125) = b(k,125) * lu(k,447) + b(k,124) = b(k,124) * lu(k,441) + b(k,123) = b(k,123) * lu(k,435) + b(k,108) = b(k,108) - lu(k,434) * b(k,123) + b(k,90) = b(k,90) - lu(k,433) * b(k,123) + b(k,122) = b(k,122) * lu(k,427) + b(k,121) = b(k,121) * lu(k,421) + b(k,120) = b(k,120) * lu(k,415) + b(k,119) = b(k,119) * lu(k,409) + b(k,118) = b(k,118) * lu(k,403) + b(k,117) = b(k,117) * lu(k,397) + b(k,116) = b(k,116) * lu(k,391) + b(k,115) = b(k,115) * lu(k,385) + b(k,114) = b(k,114) * lu(k,379) + b(k,113) = b(k,113) * lu(k,373) + b(k,112) = b(k,112) * lu(k,365) + b(k,111) = b(k,111) * lu(k,357) + b(k,110) = b(k,110) * lu(k,349) + b(k,109) = b(k,109) * lu(k,344) + b(k,108) = b(k,108) * lu(k,339) + b(k,90) = b(k,90) - lu(k,338) * b(k,108) + b(k,107) = b(k,107) * lu(k,333) + b(k,106) = b(k,106) * lu(k,328) + b(k,105) = b(k,105) * lu(k,323) + b(k,104) = b(k,104) * lu(k,320) + b(k,103) = b(k,103) * lu(k,315) + b(k,102) = b(k,102) * lu(k,310) + b(k,101) = b(k,101) * lu(k,304) + b(k,85) = b(k,85) - lu(k,303) * b(k,101) + b(k,100) = b(k,100) * lu(k,297) + b(k,99) = b(k,99) * lu(k,291) + b(k,98) = b(k,98) * lu(k,285) + b(k,97) = b(k,97) * lu(k,282) + b(k,96) = b(k,96) * lu(k,279) + b(k,95) = b(k,95) * lu(k,273) + b(k,94) = b(k,94) * lu(k,269) + b(k,93) = b(k,93) * lu(k,265) + b(k,92) = b(k,92) * lu(k,261) + b(k,91) = b(k,91) * lu(k,257) + b(k,63) = b(k,63) - lu(k,256) * b(k,91) + b(k,90) = b(k,90) * lu(k,253) + b(k,89) = b(k,89) * lu(k,248) + b(k,85) = b(k,85) - lu(k,247) * b(k,89) + b(k,88) = b(k,88) * lu(k,244) + b(k,87) = b(k,87) * lu(k,241) + b(k,86) = b(k,86) * lu(k,238) + b(k,85) = b(k,85) * lu(k,235) + b(k,84) = b(k,84) * lu(k,230) + b(k,83) = b(k,83) * lu(k,226) + b(k,82) = b(k,82) * lu(k,221) + b(k,81) = b(k,81) * lu(k,216) + b(k,80) = b(k,80) * lu(k,208) + b(k,78) = b(k,78) - lu(k,207) * b(k,80) + b(k,51) = b(k,51) - lu(k,206) * b(k,80) + b(k,79) = b(k,79) * lu(k,203) + b(k,78) = b(k,78) * lu(k,199) + b(k,77) = b(k,77) * lu(k,194) + b(k,76) = b(k,76) * lu(k,187) + b(k,50) = b(k,50) - lu(k,186) * b(k,76) + b(k,75) = b(k,75) * lu(k,183) + b(k,74) = b(k,74) * lu(k,179) + b(k,73) = b(k,73) * lu(k,174) + b(k,72) = b(k,72) * lu(k,170) + b(k,71) = b(k,71) * lu(k,164) + b(k,45) = b(k,45) - lu(k,163) * b(k,71) + b(k,70) = b(k,70) * lu(k,161) + b(k,69) = b(k,69) * lu(k,156) + b(k,68) = b(k,68) * lu(k,151) + b(k,67) = b(k,67) * lu(k,146) + b(k,66) = b(k,66) * lu(k,141) + b(k,65) = b(k,65) * lu(k,138) + b(k,64) = b(k,64) * lu(k,135) + b(k,63) = b(k,63) * lu(k,132) + b(k,62) = b(k,62) * lu(k,129) + b(k,61) = b(k,61) * lu(k,125) + b(k,60) = b(k,60) * lu(k,121) + b(k,59) = b(k,59) * lu(k,117) + b(k,58) = b(k,58) * lu(k,113) + b(k,57) = b(k,57) * lu(k,109) + b(k,56) = b(k,56) * lu(k,105) + b(k,55) = b(k,55) * lu(k,102) + b(k,54) = b(k,54) * lu(k,99) + b(k,53) = b(k,53) * lu(k,96) + b(k,52) = b(k,52) * lu(k,93) + b(k,51) = b(k,51) * lu(k,92) + b(k,41) = b(k,41) - lu(k,91) * b(k,51) + b(k,40) = b(k,40) - lu(k,90) * b(k,51) + b(k,39) = b(k,39) - lu(k,89) * b(k,51) + b(k,38) = b(k,38) - lu(k,88) * b(k,51) + b(k,37) = b(k,37) - lu(k,87) * b(k,51) + end do + end subroutine lu_slv11 + subroutine lu_slv12( 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,50) = b(k,50) * lu(k,86) + b(k,41) = b(k,41) - lu(k,85) * b(k,50) + b(k,40) = b(k,40) - lu(k,84) * b(k,50) + b(k,39) = b(k,39) - lu(k,83) * b(k,50) + b(k,38) = b(k,38) - lu(k,82) * b(k,50) + b(k,37) = b(k,37) - lu(k,81) * b(k,50) + b(k,49) = b(k,49) * lu(k,80) + b(k,41) = b(k,41) - lu(k,79) * b(k,49) + b(k,40) = b(k,40) - lu(k,78) * b(k,49) + b(k,39) = b(k,39) - lu(k,77) * b(k,49) + b(k,38) = b(k,38) - lu(k,76) * b(k,49) + b(k,37) = b(k,37) - lu(k,75) * b(k,49) + b(k,48) = b(k,48) * lu(k,74) + b(k,47) = b(k,47) - lu(k,73) * b(k,48) + b(k,47) = b(k,47) * lu(k,72) + b(k,41) = b(k,41) - lu(k,71) * b(k,47) + b(k,40) = b(k,40) - lu(k,70) * b(k,47) + b(k,39) = b(k,39) - lu(k,69) * b(k,47) + b(k,38) = b(k,38) - lu(k,68) * b(k,47) + b(k,37) = b(k,37) - lu(k,67) * b(k,47) + b(k,46) = b(k,46) * lu(k,66) + b(k,41) = b(k,41) - lu(k,65) * b(k,46) + b(k,40) = b(k,40) - lu(k,64) * b(k,46) + b(k,39) = b(k,39) - lu(k,63) * b(k,46) + b(k,38) = b(k,38) - lu(k,62) * b(k,46) + b(k,37) = b(k,37) - lu(k,61) * b(k,46) + b(k,45) = b(k,45) * lu(k,60) + b(k,41) = b(k,41) - lu(k,59) * b(k,45) + b(k,40) = b(k,40) - lu(k,58) * b(k,45) + b(k,39) = b(k,39) - lu(k,57) * b(k,45) + b(k,38) = b(k,38) - lu(k,56) * b(k,45) + b(k,37) = b(k,37) - lu(k,55) * b(k,45) + b(k,44) = b(k,44) * lu(k,54) + b(k,41) = b(k,41) - lu(k,53) * b(k,44) + b(k,40) = b(k,40) - lu(k,52) * b(k,44) + b(k,39) = b(k,39) - lu(k,51) * b(k,44) + b(k,38) = b(k,38) - lu(k,50) * b(k,44) + b(k,37) = b(k,37) - lu(k,49) * b(k,44) + b(k,43) = b(k,43) * lu(k,48) + b(k,41) = b(k,41) - lu(k,47) * b(k,43) + b(k,40) = b(k,40) - lu(k,46) * b(k,43) + b(k,39) = b(k,39) - lu(k,45) * b(k,43) + b(k,38) = b(k,38) - lu(k,44) * b(k,43) + b(k,37) = b(k,37) - lu(k,43) * b(k,43) + b(k,42) = b(k,42) * lu(k,42) + b(k,41) = b(k,41) * lu(k,41) + b(k,40) = b(k,40) * lu(k,40) + b(k,39) = b(k,39) * lu(k,39) + b(k,38) = b(k,38) * lu(k,38) + b(k,37) = b(k,37) * lu(k,37) + b(k,36) = b(k,36) * lu(k,36) + b(k,35) = b(k,35) * lu(k,35) + b(k,34) = b(k,34) * lu(k,34) + b(k,33) = b(k,33) * lu(k,33) b(k,32) = b(k,32) * lu(k,32) b(k,31) = b(k,31) * lu(k,31) b(k,30) = b(k,30) * lu(k,30) @@ -2305,7 +2530,7 @@ subroutine lu_slv11( avec_len, lu, b ) b(k,2) = b(k,2) * lu(k,2) b(k,1) = b(k,1) * lu(k,1) end do - end subroutine lu_slv11 + end subroutine lu_slv12 subroutine lu_slv( avec_len, lu, b ) use shr_kind_mod, only : r8 => shr_kind_r8 use chem_mods, only : clscnt4, nzcnt @@ -2327,5 +2552,6 @@ subroutine lu_slv( avec_len, lu, b ) call lu_slv09( avec_len, lu, b ) call lu_slv10( avec_len, lu, b ) call lu_slv11( avec_len, lu, b ) + call lu_slv12( avec_len, lu, b ) end subroutine lu_slv end module mo_lu_solve diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 index e6df8c6eae..e71cd8879d 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_nln_matrix.F90 @@ -22,212 +22,247 @@ subroutine nlnmat01( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,561) = -(rxt(k,356)*y(k,217)) - mat(k,1450) = -rxt(k,356)*y(k,1) - mat(k,1595) = rxt(k,359)*y(k,189) - mat(k,834) = rxt(k,359)*y(k,124) - mat(k,537) = -(rxt(k,360)*y(k,217)) - mat(k,1448) = -rxt(k,360)*y(k,2) - mat(k,833) = rxt(k,357)*y(k,203) - mat(k,1791) = rxt(k,357)*y(k,189) - mat(k,788) = -(rxt(k,439)*y(k,126) + rxt(k,440)*y(k,134) + rxt(k,441) & + mat(k,666) = -(rxt(k,356)*y(k,217)) + mat(k,1631) = -rxt(k,356)*y(k,1) + mat(k,1795) = rxt(k,359)*y(k,189) + mat(k,896) = rxt(k,359)*y(k,124) + mat(k,632) = -(rxt(k,360)*y(k,217)) + mat(k,1628) = -rxt(k,360)*y(k,2) + mat(k,895) = rxt(k,357)*y(k,203) + mat(k,1895) = rxt(k,357)*y(k,189) + mat(k,999) = -(rxt(k,439)*y(k,126) + rxt(k,440)*y(k,134) + rxt(k,441) & *y(k,217)) - mat(k,1950) = -rxt(k,439)*y(k,6) - mat(k,2013) = -rxt(k,440)*y(k,6) - mat(k,1472) = -rxt(k,441)*y(k,6) - mat(k,113) = -(rxt(k,398)*y(k,217)) - mat(k,1385) = -rxt(k,398)*y(k,7) - mat(k,304) = -(rxt(k,401)*y(k,217)) - mat(k,1416) = -rxt(k,401)*y(k,8) - mat(k,400) = rxt(k,399)*y(k,203) - mat(k,1768) = rxt(k,399)*y(k,191) - mat(k,114) = .120_r8*rxt(k,398)*y(k,217) - mat(k,1386) = .120_r8*rxt(k,398)*y(k,7) - mat(k,785) = .100_r8*rxt(k,440)*y(k,134) - mat(k,812) = .100_r8*rxt(k,443)*y(k,134) - mat(k,2002) = .100_r8*rxt(k,440)*y(k,6) + .100_r8*rxt(k,443)*y(k,110) - mat(k,1583) = .500_r8*rxt(k,400)*y(k,191) + .200_r8*rxt(k,427)*y(k,223) & + mat(k,1719) = -rxt(k,439)*y(k,6) + mat(k,2099) = -rxt(k,440)*y(k,6) + mat(k,1661) = -rxt(k,441)*y(k,6) + mat(k,164) = -(rxt(k,398)*y(k,217)) + mat(k,1559) = -rxt(k,398)*y(k,7) + mat(k,421) = -(rxt(k,401)*y(k,217)) + mat(k,1600) = -rxt(k,401)*y(k,8) + mat(k,481) = rxt(k,399)*y(k,203) + mat(k,1880) = rxt(k,399)*y(k,191) + mat(k,165) = .120_r8*rxt(k,398)*y(k,217) + mat(k,1560) = .120_r8*rxt(k,398)*y(k,7) + mat(k,991) = .100_r8*rxt(k,440)*y(k,134) + mat(k,942) = .100_r8*rxt(k,443)*y(k,134) + mat(k,2083) = .100_r8*rxt(k,440)*y(k,6) + .100_r8*rxt(k,443)*y(k,110) + mat(k,1782) = .500_r8*rxt(k,400)*y(k,191) + .200_r8*rxt(k,427)*y(k,223) & + .060_r8*rxt(k,433)*y(k,226) - mat(k,401) = .500_r8*rxt(k,400)*y(k,124) - mat(k,618) = .200_r8*rxt(k,427)*y(k,124) - mat(k,634) = .060_r8*rxt(k,433)*y(k,124) - mat(k,1576) = .200_r8*rxt(k,427)*y(k,223) + .200_r8*rxt(k,433)*y(k,226) - mat(k,617) = .200_r8*rxt(k,427)*y(k,124) - mat(k,632) = .200_r8*rxt(k,433)*y(k,124) - mat(k,1591) = .200_r8*rxt(k,427)*y(k,223) + .150_r8*rxt(k,433)*y(k,226) - mat(k,619) = .200_r8*rxt(k,427)*y(k,124) - mat(k,635) = .150_r8*rxt(k,433)*y(k,124) - mat(k,1577) = .210_r8*rxt(k,433)*y(k,226) - mat(k,633) = .210_r8*rxt(k,433)*y(k,124) - mat(k,184) = -(rxt(k,361)*y(k,217)) - mat(k,1398) = -rxt(k,361)*y(k,15) - mat(k,784) = .050_r8*rxt(k,440)*y(k,134) - mat(k,811) = .050_r8*rxt(k,443)*y(k,134) - mat(k,2001) = .050_r8*rxt(k,440)*y(k,6) + .050_r8*rxt(k,443)*y(k,110) - mat(k,284) = -(rxt(k,327)*y(k,126) + rxt(k,328)*y(k,217)) - mat(k,1944) = -rxt(k,327)*y(k,16) - mat(k,1413) = -rxt(k,328)*y(k,16) - mat(k,1278) = -(rxt(k,210)*y(k,42) + rxt(k,211)*y(k,203) + rxt(k,212) & + mat(k,482) = .500_r8*rxt(k,400)*y(k,124) + mat(k,728) = .200_r8*rxt(k,427)*y(k,124) + mat(k,744) = .060_r8*rxt(k,433)*y(k,124) + mat(k,1776) = .200_r8*rxt(k,427)*y(k,223) + .200_r8*rxt(k,433)*y(k,226) + mat(k,727) = .200_r8*rxt(k,427)*y(k,124) + mat(k,742) = .200_r8*rxt(k,433)*y(k,124) + mat(k,1792) = .200_r8*rxt(k,427)*y(k,223) + .150_r8*rxt(k,433)*y(k,226) + mat(k,729) = .200_r8*rxt(k,427)*y(k,124) + mat(k,745) = .150_r8*rxt(k,433)*y(k,124) + mat(k,1778) = .210_r8*rxt(k,433)*y(k,226) + mat(k,743) = .210_r8*rxt(k,433)*y(k,124) + mat(k,238) = -(rxt(k,361)*y(k,217)) + mat(k,1573) = -rxt(k,361)*y(k,15) + mat(k,990) = .050_r8*rxt(k,440)*y(k,134) + mat(k,941) = .050_r8*rxt(k,443)*y(k,134) + mat(k,2082) = .050_r8*rxt(k,440)*y(k,6) + .050_r8*rxt(k,443)*y(k,110) + mat(k,349) = -(rxt(k,327)*y(k,126) + rxt(k,328)*y(k,217)) + mat(k,1709) = -rxt(k,327)*y(k,16) + mat(k,1590) = -rxt(k,328)*y(k,16) + mat(k,1415) = -(rxt(k,211)*y(k,42) + rxt(k,212)*y(k,203) + rxt(k,213) & *y(k,134)) - mat(k,1730) = -rxt(k,210)*y(k,17) - mat(k,1834) = -rxt(k,211)*y(k,17) - mat(k,2038) = -rxt(k,212)*y(k,17) - mat(k,1707) = 4.000_r8*rxt(k,213)*y(k,19) + (rxt(k,214)+rxt(k,215))*y(k,59) & - + rxt(k,218)*y(k,124) + rxt(k,221)*y(k,133) + rxt(k,468) & - *y(k,150) + rxt(k,222)*y(k,217) - mat(k,1324) = (rxt(k,214)+rxt(k,215))*y(k,19) - mat(k,705) = rxt(k,223)*y(k,133) + rxt(k,229)*y(k,216) + rxt(k,224)*y(k,217) - mat(k,1633) = rxt(k,218)*y(k,19) - mat(k,1864) = rxt(k,221)*y(k,19) + rxt(k,223)*y(k,81) - mat(k,1112) = rxt(k,468)*y(k,19) - mat(k,1348) = rxt(k,229)*y(k,81) - mat(k,1502) = rxt(k,222)*y(k,19) + rxt(k,224)*y(k,81) - mat(k,1701) = rxt(k,216)*y(k,59) - mat(k,1318) = rxt(k,216)*y(k,19) - mat(k,1883) = (rxt(k,530)+rxt(k,535))*y(k,91) - mat(k,667) = (rxt(k,530)+rxt(k,535))*y(k,85) - mat(k,1716) = -(4._r8*rxt(k,213)*y(k,19) + (rxt(k,214) + rxt(k,215) + rxt(k,216) & - ) * y(k,59) + rxt(k,217)*y(k,203) + rxt(k,218)*y(k,124) & - + rxt(k,219)*y(k,125) + rxt(k,221)*y(k,133) + rxt(k,222) & - *y(k,217) + rxt(k,468)*y(k,150)) - mat(k,1333) = -(rxt(k,214) + rxt(k,215) + rxt(k,216)) * y(k,19) - mat(k,1843) = -rxt(k,217)*y(k,19) - mat(k,1642) = -rxt(k,218)*y(k,19) - mat(k,1552) = -rxt(k,219)*y(k,19) - mat(k,1873) = -rxt(k,221)*y(k,19) - mat(k,1511) = -rxt(k,222)*y(k,19) - mat(k,1118) = -rxt(k,468)*y(k,19) - mat(k,1282) = rxt(k,212)*y(k,134) - mat(k,454) = rxt(k,220)*y(k,133) - mat(k,709) = rxt(k,230)*y(k,216) - mat(k,671) = rxt(k,225)*y(k,133) - mat(k,1873) = mat(k,1873) + rxt(k,220)*y(k,20) + rxt(k,225)*y(k,91) - mat(k,2047) = rxt(k,212)*y(k,17) - mat(k,1357) = rxt(k,230)*y(k,81) - mat(k,449) = -(rxt(k,220)*y(k,133)) - mat(k,1854) = -rxt(k,220)*y(k,20) - mat(k,1703) = rxt(k,219)*y(k,125) - mat(k,1527) = rxt(k,219)*y(k,19) - mat(k,190) = -(rxt(k,402)*y(k,217)) - mat(k,1399) = -rxt(k,402)*y(k,22) - mat(k,1574) = rxt(k,405)*y(k,193) - mat(k,358) = rxt(k,405)*y(k,124) - mat(k,263) = -(rxt(k,404)*y(k,217)) - mat(k,1409) = -rxt(k,404)*y(k,23) - mat(k,359) = rxt(k,403)*y(k,203) - mat(k,1766) = rxt(k,403)*y(k,193) - mat(k,225) = -(rxt(k,276)*y(k,56) + rxt(k,277)*y(k,217)) - mat(k,1906) = -rxt(k,276)*y(k,24) - mat(k,1404) = -rxt(k,277)*y(k,24) - mat(k,465) = -(rxt(k,278)*y(k,56) + rxt(k,279)*y(k,134) + rxt(k,304)*y(k,217)) - mat(k,1908) = -rxt(k,278)*y(k,25) - mat(k,2005) = -rxt(k,279)*y(k,25) - mat(k,1438) = -rxt(k,304)*y(k,25) - mat(k,198) = -(rxt(k,284)*y(k,217)) - mat(k,1401) = -rxt(k,284)*y(k,26) - mat(k,712) = .800_r8*rxt(k,280)*y(k,194) + .200_r8*rxt(k,281)*y(k,198) - mat(k,1651) = .200_r8*rxt(k,281)*y(k,194) - mat(k,268) = -(rxt(k,285)*y(k,217)) - mat(k,1410) = -rxt(k,285)*y(k,27) - mat(k,713) = rxt(k,282)*y(k,203) - mat(k,1767) = rxt(k,282)*y(k,194) - mat(k,231) = -(rxt(k,286)*y(k,56) + rxt(k,287)*y(k,217)) - mat(k,1907) = -rxt(k,286)*y(k,28) - mat(k,1405) = -rxt(k,287)*y(k,28) - mat(k,869) = -(rxt(k,307)*y(k,126) + rxt(k,308)*y(k,134) + rxt(k,325) & + mat(k,1481) = -rxt(k,211)*y(k,17) + mat(k,1941) = -rxt(k,212)*y(k,17) + mat(k,2119) = -rxt(k,213)*y(k,17) + mat(k,2211) = 4.000_r8*rxt(k,214)*y(k,19) + (rxt(k,215)+rxt(k,216))*y(k,59) & + + rxt(k,219)*y(k,124) + rxt(k,222)*y(k,133) + rxt(k,469) & + *y(k,150) + rxt(k,223)*y(k,217) + mat(k,143) = rxt(k,201)*y(k,216) + mat(k,149) = rxt(k,227)*y(k,216) + mat(k,468) = 2.000_r8*rxt(k,238)*y(k,56) + 2.000_r8*rxt(k,250)*y(k,216) & + + 2.000_r8*rxt(k,239)*y(k,217) + mat(k,595) = rxt(k,240)*y(k,56) + rxt(k,251)*y(k,216) + rxt(k,241)*y(k,217) + mat(k,448) = 3.000_r8*rxt(k,245)*y(k,56) + 3.000_r8*rxt(k,228)*y(k,216) & + + 3.000_r8*rxt(k,246)*y(k,217) + mat(k,2006) = 2.000_r8*rxt(k,238)*y(k,41) + rxt(k,240)*y(k,43) & + + 3.000_r8*rxt(k,245)*y(k,55) + mat(k,1968) = (rxt(k,215)+rxt(k,216))*y(k,19) + mat(k,107) = 2.000_r8*rxt(k,229)*y(k,216) + mat(k,805) = rxt(k,224)*y(k,133) + rxt(k,230)*y(k,216) + rxt(k,225)*y(k,217) + mat(k,1834) = rxt(k,219)*y(k,19) + mat(k,2241) = rxt(k,222)*y(k,19) + rxt(k,224)*y(k,81) + mat(k,1233) = rxt(k,469)*y(k,19) + mat(k,1521) = rxt(k,201)*y(k,34) + rxt(k,227)*y(k,35) + 2.000_r8*rxt(k,250) & + *y(k,41) + rxt(k,251)*y(k,43) + 3.000_r8*rxt(k,228)*y(k,55) & + + 2.000_r8*rxt(k,229)*y(k,78) + rxt(k,230)*y(k,81) + mat(k,1685) = rxt(k,223)*y(k,19) + 2.000_r8*rxt(k,239)*y(k,41) + rxt(k,241) & + *y(k,43) + 3.000_r8*rxt(k,246)*y(k,55) + rxt(k,225)*y(k,81) + mat(k,2205) = rxt(k,217)*y(k,59) + mat(k,1962) = rxt(k,217)*y(k,19) + mat(k,2139) = (rxt(k,530)+rxt(k,535))*y(k,91) + mat(k,777) = (rxt(k,530)+rxt(k,535))*y(k,85) + mat(k,2226) = -(4._r8*rxt(k,214)*y(k,19) + (rxt(k,215) + rxt(k,216) + rxt(k,217) & + ) * y(k,59) + rxt(k,218)*y(k,203) + rxt(k,219)*y(k,124) & + + rxt(k,220)*y(k,125) + rxt(k,222)*y(k,133) + rxt(k,223) & + *y(k,217) + rxt(k,469)*y(k,150)) + mat(k,1983) = -(rxt(k,215) + rxt(k,216) + rxt(k,217)) * y(k,19) + mat(k,1957) = -rxt(k,218)*y(k,19) + mat(k,1850) = -rxt(k,219)*y(k,19) + mat(k,2202) = -rxt(k,220)*y(k,19) + mat(k,2257) = -rxt(k,222)*y(k,19) + mat(k,1701) = -rxt(k,223)*y(k,19) + mat(k,1242) = -rxt(k,469)*y(k,19) + mat(k,1422) = rxt(k,213)*y(k,134) + mat(k,546) = rxt(k,221)*y(k,133) + mat(k,809) = rxt(k,231)*y(k,216) + mat(k,783) = rxt(k,226)*y(k,133) + mat(k,2257) = mat(k,2257) + rxt(k,221)*y(k,20) + rxt(k,226)*y(k,91) + mat(k,2135) = rxt(k,213)*y(k,17) + mat(k,1537) = rxt(k,231)*y(k,81) + mat(k,540) = -(rxt(k,221)*y(k,133)) + mat(k,2231) = -rxt(k,221)*y(k,20) + mat(k,2207) = rxt(k,220)*y(k,125) + mat(k,2169) = rxt(k,220)*y(k,19) + mat(k,253) = -(rxt(k,402)*y(k,217)) + mat(k,1576) = -rxt(k,402)*y(k,22) + mat(k,1774) = rxt(k,405)*y(k,193) + mat(k,433) = rxt(k,405)*y(k,124) + mat(k,339) = -(rxt(k,404)*y(k,217)) + mat(k,1588) = -rxt(k,404)*y(k,23) + mat(k,434) = rxt(k,403)*y(k,203) + mat(k,1872) = rxt(k,403)*y(k,193) + mat(k,285) = -(rxt(k,276)*y(k,56) + rxt(k,277)*y(k,217)) + mat(k,1987) = -rxt(k,276)*y(k,24) + mat(k,1580) = -rxt(k,277)*y(k,24) + mat(k,548) = -(rxt(k,278)*y(k,56) + rxt(k,279)*y(k,134) + rxt(k,304)*y(k,217)) + mat(k,1992) = -rxt(k,278)*y(k,25) + mat(k,2086) = -rxt(k,279)*y(k,25) + mat(k,1617) = -rxt(k,304)*y(k,25) + mat(k,261) = -(rxt(k,284)*y(k,217)) + mat(k,1578) = -rxt(k,284)*y(k,26) + mat(k,812) = .800_r8*rxt(k,280)*y(k,194) + .200_r8*rxt(k,281)*y(k,198) + mat(k,2025) = .200_r8*rxt(k,281)*y(k,194) + mat(k,344) = -(rxt(k,285)*y(k,217)) + mat(k,1589) = -rxt(k,285)*y(k,27) + mat(k,813) = rxt(k,282)*y(k,203) + mat(k,1873) = rxt(k,282)*y(k,194) + mat(k,291) = -(rxt(k,286)*y(k,56) + rxt(k,287)*y(k,217)) + mat(k,1988) = -rxt(k,286)*y(k,28) + mat(k,1581) = -rxt(k,287)*y(k,28) + mat(k,1024) = -(rxt(k,307)*y(k,126) + rxt(k,308)*y(k,134) + rxt(k,325) & *y(k,217)) - mat(k,1954) = -rxt(k,307)*y(k,29) - mat(k,2017) = -rxt(k,308)*y(k,29) - mat(k,1477) = -rxt(k,325)*y(k,29) - mat(k,736) = .130_r8*rxt(k,385)*y(k,134) - mat(k,2017) = mat(k,2017) + .130_r8*rxt(k,385)*y(k,98) - mat(k,346) = -(rxt(k,312)*y(k,217)) - mat(k,1422) = -rxt(k,312)*y(k,30) - mat(k,685) = rxt(k,310)*y(k,203) - mat(k,1774) = rxt(k,310)*y(k,195) - mat(k,93) = -(rxt(k,313)*y(k,217)) - mat(k,1382) = -rxt(k,313)*y(k,31) - mat(k,202) = -(rxt(k,408)*y(k,217)) - mat(k,1402) = -rxt(k,408)*y(k,32) - mat(k,528) = rxt(k,406)*y(k,203) - mat(k,1761) = rxt(k,406)*y(k,196) - mat(k,1739) = -(rxt(k,174)*y(k,56) + rxt(k,210)*y(k,17) + rxt(k,254)*y(k,203) & - + rxt(k,255)*y(k,126) + rxt(k,256)*y(k,133) + rxt(k,257) & + mat(k,1720) = -rxt(k,307)*y(k,29) + mat(k,2100) = -rxt(k,308)*y(k,29) + mat(k,1662) = -rxt(k,325)*y(k,29) + mat(k,843) = .130_r8*rxt(k,385)*y(k,134) + mat(k,2100) = mat(k,2100) + .130_r8*rxt(k,385)*y(k,98) + mat(k,415) = -(rxt(k,312)*y(k,217)) + mat(k,1599) = -rxt(k,312)*y(k,30) + mat(k,790) = rxt(k,310)*y(k,203) + mat(k,1879) = rxt(k,310)*y(k,195) + mat(k,109) = -(rxt(k,313)*y(k,217)) + mat(k,1556) = -rxt(k,313)*y(k,31) + mat(k,265) = -(rxt(k,408)*y(k,217)) + mat(k,1579) = -rxt(k,408)*y(k,32) + mat(k,623) = rxt(k,406)*y(k,203) + mat(k,1867) = rxt(k,406)*y(k,196) + mat(k,99) = -(rxt(k,200)*y(k,216)) + mat(k,1499) = -rxt(k,200)*y(k,33) + mat(k,141) = -(rxt(k,201)*y(k,216)) + mat(k,1504) = -rxt(k,201)*y(k,34) + mat(k,146) = -(rxt(k,227)*y(k,216)) + mat(k,1505) = -rxt(k,227)*y(k,35) + mat(k,113) = -(rxt(k,202)*y(k,216)) + mat(k,1501) = -rxt(k,202)*y(k,36) + mat(k,151) = -(rxt(k,203)*y(k,216)) + mat(k,1506) = -rxt(k,203)*y(k,37) + mat(k,117) = -(rxt(k,204)*y(k,216)) + mat(k,1502) = -rxt(k,204)*y(k,38) + mat(k,156) = -(rxt(k,205)*y(k,216)) + mat(k,1507) = -rxt(k,205)*y(k,39) + mat(k,121) = -(rxt(k,206)*y(k,216)) + mat(k,1503) = -rxt(k,206)*y(k,40) + mat(k,467) = -(rxt(k,238)*y(k,56) + rxt(k,239)*y(k,217) + rxt(k,250)*y(k,216)) + mat(k,1991) = -rxt(k,238)*y(k,41) + mat(k,1607) = -rxt(k,239)*y(k,41) + mat(k,1516) = -rxt(k,250)*y(k,41) + mat(k,1485) = -(rxt(k,175)*y(k,56) + rxt(k,211)*y(k,17) + rxt(k,255)*y(k,203) & + + rxt(k,256)*y(k,126) + rxt(k,257)*y(k,133) + rxt(k,258) & *y(k,217)) - mat(k,1931) = -rxt(k,174)*y(k,42) - mat(k,1283) = -rxt(k,210)*y(k,42) - mat(k,1844) = -rxt(k,254)*y(k,42) - mat(k,1988) = -rxt(k,255)*y(k,42) - mat(k,1874) = -rxt(k,256)*y(k,42) - mat(k,1512) = -rxt(k,257)*y(k,42) - mat(k,569) = .400_r8*rxt(k,356)*y(k,217) - mat(k,800) = .340_r8*rxt(k,440)*y(k,134) - mat(k,290) = .500_r8*rxt(k,327)*y(k,126) - mat(k,470) = rxt(k,279)*y(k,134) - mat(k,879) = .500_r8*rxt(k,308)*y(k,134) - mat(k,439) = .500_r8*rxt(k,296)*y(k,217) - mat(k,698) = rxt(k,262)*y(k,217) - mat(k,326) = .300_r8*rxt(k,263)*y(k,217) - mat(k,1334) = rxt(k,181)*y(k,198) - mat(k,911) = .800_r8*rxt(k,301)*y(k,217) - mat(k,746) = .910_r8*rxt(k,385)*y(k,134) - mat(k,520) = .300_r8*rxt(k,376)*y(k,217) - mat(k,1083) = .800_r8*rxt(k,380)*y(k,198) - mat(k,1095) = .120_r8*rxt(k,338)*y(k,134) - mat(k,490) = .500_r8*rxt(k,351)*y(k,217) - mat(k,827) = .340_r8*rxt(k,443)*y(k,134) - mat(k,1173) = .600_r8*rxt(k,352)*y(k,134) - mat(k,1643) = .100_r8*rxt(k,358)*y(k,189) + rxt(k,261)*y(k,198) & + mat(k,2010) = -rxt(k,175)*y(k,42) + mat(k,1417) = -rxt(k,211)*y(k,42) + mat(k,1945) = -rxt(k,255)*y(k,42) + mat(k,1746) = -rxt(k,256)*y(k,42) + mat(k,2245) = -rxt(k,257)*y(k,42) + mat(k,1689) = -rxt(k,258)*y(k,42) + mat(k,672) = .400_r8*rxt(k,356)*y(k,217) + mat(k,1009) = .340_r8*rxt(k,440)*y(k,134) + mat(k,353) = .500_r8*rxt(k,327)*y(k,126) + mat(k,552) = rxt(k,279)*y(k,134) + mat(k,1031) = .500_r8*rxt(k,308)*y(k,134) + mat(k,613) = .500_r8*rxt(k,296)*y(k,217) + mat(k,787) = rxt(k,263)*y(k,217) + mat(k,387) = .300_r8*rxt(k,264)*y(k,217) + mat(k,1433) = (rxt(k,272)+rxt(k,273))*y(k,216) + mat(k,1971) = rxt(k,182)*y(k,198) + mat(k,1098) = .800_r8*rxt(k,301)*y(k,217) + mat(k,851) = .910_r8*rxt(k,385)*y(k,134) + mat(k,586) = .300_r8*rxt(k,376)*y(k,217) + mat(k,1199) = .800_r8*rxt(k,380)*y(k,198) + mat(k,1214) = .120_r8*rxt(k,338)*y(k,134) + mat(k,576) = .500_r8*rxt(k,351)*y(k,217) + mat(k,959) = .340_r8*rxt(k,443)*y(k,134) + mat(k,1337) = .600_r8*rxt(k,352)*y(k,134) + mat(k,1838) = .100_r8*rxt(k,358)*y(k,189) + rxt(k,262)*y(k,198) & + .500_r8*rxt(k,329)*y(k,200) + .500_r8*rxt(k,298)*y(k,202) & + .920_r8*rxt(k,368)*y(k,205) + .250_r8*rxt(k,336)*y(k,209) & + rxt(k,345)*y(k,211) + rxt(k,319)*y(k,219) + rxt(k,323) & *y(k,220) + .340_r8*rxt(k,452)*y(k,221) + .320_r8*rxt(k,457) & *y(k,222) + .250_r8*rxt(k,393)*y(k,225) - mat(k,1988) = mat(k,1988) + .500_r8*rxt(k,327)*y(k,16) + rxt(k,369)*y(k,205) & + mat(k,1746) = mat(k,1746) + .500_r8*rxt(k,327)*y(k,16) + rxt(k,369)*y(k,205) & + .250_r8*rxt(k,335)*y(k,209) + rxt(k,346)*y(k,211) - mat(k,2048) = .340_r8*rxt(k,440)*y(k,6) + rxt(k,279)*y(k,25) & + mat(k,2123) = .340_r8*rxt(k,440)*y(k,6) + rxt(k,279)*y(k,25) & + .500_r8*rxt(k,308)*y(k,29) + .910_r8*rxt(k,385)*y(k,98) & + .120_r8*rxt(k,338)*y(k,105) + .340_r8*rxt(k,443)*y(k,110) & + .600_r8*rxt(k,352)*y(k,111) - mat(k,387) = rxt(k,303)*y(k,217) - mat(k,936) = .680_r8*rxt(k,461)*y(k,217) - mat(k,845) = .100_r8*rxt(k,358)*y(k,124) - mat(k,721) = .700_r8*rxt(k,281)*y(k,198) - mat(k,693) = rxt(k,309)*y(k,198) - mat(k,1271) = rxt(k,292)*y(k,198) + rxt(k,365)*y(k,205) + .250_r8*rxt(k,332) & + mat(k,527) = rxt(k,303)*y(k,217) + mat(k,1063) = .680_r8*rxt(k,461)*y(k,217) + mat(k,903) = .100_r8*rxt(k,358)*y(k,124) + mat(k,817) = .700_r8*rxt(k,281)*y(k,198) + mat(k,794) = rxt(k,309)*y(k,198) + mat(k,1389) = rxt(k,292)*y(k,198) + rxt(k,365)*y(k,205) + .250_r8*rxt(k,332) & *y(k,209) + rxt(k,341)*y(k,211) + .250_r8*rxt(k,390)*y(k,225) - mat(k,1693) = rxt(k,181)*y(k,59) + .800_r8*rxt(k,380)*y(k,101) + rxt(k,261) & + mat(k,2062) = rxt(k,182)*y(k,59) + .800_r8*rxt(k,380)*y(k,101) + rxt(k,262) & *y(k,124) + .700_r8*rxt(k,281)*y(k,194) + rxt(k,309)*y(k,195) & - + rxt(k,292)*y(k,197) + (4.000_r8*rxt(k,258)+2.000_r8*rxt(k,259)) & + + rxt(k,292)*y(k,197) + (4.000_r8*rxt(k,259)+2.000_r8*rxt(k,260)) & *y(k,198) + 1.500_r8*rxt(k,366)*y(k,205) + .750_r8*rxt(k,371) & *y(k,206) + .880_r8*rxt(k,333)*y(k,209) + 2.000_r8*rxt(k,342) & *y(k,211) + .750_r8*rxt(k,445)*y(k,215) + .800_r8*rxt(k,321) & *y(k,220) + .930_r8*rxt(k,450)*y(k,221) + .950_r8*rxt(k,455) & *y(k,222) + .800_r8*rxt(k,391)*y(k,225) - mat(k,483) = .500_r8*rxt(k,329)*y(k,124) - mat(k,609) = .500_r8*rxt(k,298)*y(k,124) - mat(k,1844) = mat(k,1844) + .450_r8*rxt(k,343)*y(k,211) + .150_r8*rxt(k,322) & + mat(k,568) = .500_r8*rxt(k,329)*y(k,124) + mat(k,716) = .500_r8*rxt(k,298)*y(k,124) + mat(k,1945) = mat(k,1945) + .450_r8*rxt(k,343)*y(k,211) + .150_r8*rxt(k,322) & *y(k,220) - mat(k,1223) = .920_r8*rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126) + rxt(k,365) & + mat(k,1262) = .920_r8*rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126) + rxt(k,365) & *y(k,197) + 1.500_r8*rxt(k,366)*y(k,198) - mat(k,1153) = .750_r8*rxt(k,371)*y(k,198) - mat(k,1196) = .250_r8*rxt(k,336)*y(k,124) + .250_r8*rxt(k,335)*y(k,126) & + mat(k,1294) = .750_r8*rxt(k,371)*y(k,198) + mat(k,1315) = .250_r8*rxt(k,336)*y(k,124) + .250_r8*rxt(k,335)*y(k,126) & + .250_r8*rxt(k,332)*y(k,197) + .880_r8*rxt(k,333)*y(k,198) - mat(k,1241) = rxt(k,345)*y(k,124) + rxt(k,346)*y(k,126) + rxt(k,341)*y(k,197) & + mat(k,1357) = rxt(k,345)*y(k,124) + rxt(k,346)*y(k,126) + rxt(k,341)*y(k,197) & + 2.000_r8*rxt(k,342)*y(k,198) + .450_r8*rxt(k,343)*y(k,203) & + 4.000_r8*rxt(k,344)*y(k,211) - mat(k,1006) = .750_r8*rxt(k,445)*y(k,198) - mat(k,1512) = mat(k,1512) + .400_r8*rxt(k,356)*y(k,1) + .500_r8*rxt(k,296) & - *y(k,51) + rxt(k,262)*y(k,52) + .300_r8*rxt(k,263)*y(k,53) & + mat(k,1050) = .750_r8*rxt(k,445)*y(k,198) + mat(k,1525) = (rxt(k,272)+rxt(k,273))*y(k,54) + mat(k,1689) = mat(k,1689) + .400_r8*rxt(k,356)*y(k,1) + .500_r8*rxt(k,296) & + *y(k,51) + rxt(k,263)*y(k,52) + .300_r8*rxt(k,264)*y(k,53) & + .800_r8*rxt(k,301)*y(k,74) + .300_r8*rxt(k,376)*y(k,99) & + .500_r8*rxt(k,351)*y(k,109) + rxt(k,303)*y(k,139) & + .680_r8*rxt(k,461)*y(k,178) - mat(k,664) = rxt(k,319)*y(k,124) - mat(k,1020) = rxt(k,323)*y(k,124) + .800_r8*rxt(k,321)*y(k,198) & + mat(k,771) = rxt(k,319)*y(k,124) + mat(k,1133) = rxt(k,323)*y(k,124) + .800_r8*rxt(k,321)*y(k,198) & + .150_r8*rxt(k,322)*y(k,203) - mat(k,987) = .340_r8*rxt(k,452)*y(k,124) + .930_r8*rxt(k,450)*y(k,198) - mat(k,967) = .320_r8*rxt(k,457)*y(k,124) + .950_r8*rxt(k,455)*y(k,198) - mat(k,1060) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,390)*y(k,197) & + mat(k,1119) = .340_r8*rxt(k,452)*y(k,124) + .930_r8*rxt(k,450)*y(k,198) + mat(k,916) = .320_r8*rxt(k,457)*y(k,124) + .950_r8*rxt(k,455)*y(k,198) + mat(k,1176) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,390)*y(k,197) & + .800_r8*rxt(k,391)*y(k,198) end do end subroutine nlnmat01 @@ -249,226 +284,221 @@ subroutine nlnmat02( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,1024) = -(rxt(k,288)*y(k,126) + rxt(k,289)*y(k,217)) - mat(k,1966) = -rxt(k,288)*y(k,45) - mat(k,1489) = -rxt(k,289)*y(k,45) - mat(k,565) = .800_r8*rxt(k,356)*y(k,217) - mat(k,287) = rxt(k,327)*y(k,126) - mat(k,199) = rxt(k,284)*y(k,217) - mat(k,270) = .500_r8*rxt(k,285)*y(k,217) - mat(k,872) = .500_r8*rxt(k,308)*y(k,134) - mat(k,1162) = .100_r8*rxt(k,352)*y(k,134) - mat(k,1622) = .400_r8*rxt(k,358)*y(k,189) + rxt(k,283)*y(k,194) & + mat(k,594) = -(rxt(k,240)*y(k,56) + rxt(k,241)*y(k,217) + rxt(k,251)*y(k,216)) + mat(k,1993) = -rxt(k,240)*y(k,43) + mat(k,1623) = -rxt(k,241)*y(k,43) + mat(k,1517) = -rxt(k,251)*y(k,43) + mat(k,125) = -(rxt(k,242)*y(k,217)) + mat(k,1557) = -rxt(k,242)*y(k,44) + mat(k,1085) = -(rxt(k,288)*y(k,126) + rxt(k,289)*y(k,217)) + mat(k,1724) = -rxt(k,288)*y(k,45) + mat(k,1666) = -rxt(k,289)*y(k,45) + mat(k,670) = .800_r8*rxt(k,356)*y(k,217) + mat(k,352) = rxt(k,327)*y(k,126) + mat(k,262) = rxt(k,284)*y(k,217) + mat(k,346) = .500_r8*rxt(k,285)*y(k,217) + mat(k,1025) = .500_r8*rxt(k,308)*y(k,134) + mat(k,1327) = .100_r8*rxt(k,352)*y(k,134) + mat(k,1817) = .400_r8*rxt(k,358)*y(k,189) + rxt(k,283)*y(k,194) & + .270_r8*rxt(k,311)*y(k,195) + rxt(k,329)*y(k,200) + rxt(k,348) & *y(k,213) + rxt(k,319)*y(k,219) - mat(k,1966) = mat(k,1966) + rxt(k,327)*y(k,16) - mat(k,2027) = .500_r8*rxt(k,308)*y(k,29) + .100_r8*rxt(k,352)*y(k,111) - mat(k,839) = .400_r8*rxt(k,358)*y(k,124) - mat(k,716) = rxt(k,283)*y(k,124) + 3.200_r8*rxt(k,280)*y(k,194) & + mat(k,1724) = mat(k,1724) + rxt(k,327)*y(k,16) + mat(k,2103) = .500_r8*rxt(k,308)*y(k,29) + .100_r8*rxt(k,352)*y(k,111) + mat(k,901) = .400_r8*rxt(k,358)*y(k,124) + mat(k,816) = rxt(k,283)*y(k,124) + 3.200_r8*rxt(k,280)*y(k,194) & + .800_r8*rxt(k,281)*y(k,198) - mat(k,688) = .270_r8*rxt(k,311)*y(k,124) - mat(k,1673) = .800_r8*rxt(k,281)*y(k,194) - mat(k,480) = rxt(k,329)*y(k,124) - mat(k,1822) = .200_r8*rxt(k,347)*y(k,213) - mat(k,573) = rxt(k,348)*y(k,124) + .200_r8*rxt(k,347)*y(k,203) - mat(k,1489) = mat(k,1489) + .800_r8*rxt(k,356)*y(k,1) + rxt(k,284)*y(k,26) & + mat(k,793) = .270_r8*rxt(k,311)*y(k,124) + mat(k,2043) = .800_r8*rxt(k,281)*y(k,194) + mat(k,566) = rxt(k,329)*y(k,124) + mat(k,1924) = .200_r8*rxt(k,347)*y(k,213) + mat(k,678) = rxt(k,348)*y(k,124) + .200_r8*rxt(k,347)*y(k,203) + mat(k,1666) = mat(k,1666) + .800_r8*rxt(k,356)*y(k,1) + rxt(k,284)*y(k,26) & + .500_r8*rxt(k,285)*y(k,27) - mat(k,660) = rxt(k,319)*y(k,124) - mat(k,87) = -(rxt(k,290)*y(k,217)) - mat(k,1381) = -rxt(k,290)*y(k,47) - mat(k,847) = -(rxt(k,326)*y(k,217)) - mat(k,1475) = -rxt(k,326)*y(k,48) - mat(k,564) = .800_r8*rxt(k,356)*y(k,217) - mat(k,790) = .520_r8*rxt(k,440)*y(k,134) - mat(k,286) = .500_r8*rxt(k,327)*y(k,126) - mat(k,817) = .520_r8*rxt(k,443)*y(k,134) - mat(k,1610) = .250_r8*rxt(k,358)*y(k,189) + .820_r8*rxt(k,311)*y(k,195) & + mat(k,769) = rxt(k,319)*y(k,124) + mat(k,365) = -(rxt(k,243)*y(k,56) + rxt(k,244)*y(k,217)) + mat(k,1989) = -rxt(k,243)*y(k,46) + mat(k,1592) = -rxt(k,244)*y(k,46) + mat(k,102) = -(rxt(k,290)*y(k,217)) + mat(k,1555) = -rxt(k,290)*y(k,47) + mat(k,922) = -(rxt(k,326)*y(k,217)) + mat(k,1656) = -rxt(k,326)*y(k,48) + mat(k,669) = .800_r8*rxt(k,356)*y(k,217) + mat(k,995) = .520_r8*rxt(k,440)*y(k,134) + mat(k,351) = .500_r8*rxt(k,327)*y(k,126) + mat(k,946) = .520_r8*rxt(k,443)*y(k,134) + mat(k,1810) = .250_r8*rxt(k,358)*y(k,189) + .820_r8*rxt(k,311)*y(k,195) & + .500_r8*rxt(k,329)*y(k,200) + .270_r8*rxt(k,452)*y(k,221) & + .040_r8*rxt(k,457)*y(k,222) - mat(k,1953) = .500_r8*rxt(k,327)*y(k,16) - mat(k,2016) = .520_r8*rxt(k,440)*y(k,6) + .520_r8*rxt(k,443)*y(k,110) - mat(k,929) = .500_r8*rxt(k,461)*y(k,217) - mat(k,838) = .250_r8*rxt(k,358)*y(k,124) - mat(k,687) = .820_r8*rxt(k,311)*y(k,124) + .820_r8*rxt(k,309)*y(k,198) - mat(k,1662) = .820_r8*rxt(k,309)*y(k,195) + .150_r8*rxt(k,450)*y(k,221) & + mat(k,1714) = .500_r8*rxt(k,327)*y(k,16) + mat(k,2094) = .520_r8*rxt(k,440)*y(k,6) + .520_r8*rxt(k,443)*y(k,110) + mat(k,1058) = .500_r8*rxt(k,461)*y(k,217) + mat(k,900) = .250_r8*rxt(k,358)*y(k,124) + mat(k,792) = .820_r8*rxt(k,311)*y(k,124) + .820_r8*rxt(k,309)*y(k,198) + mat(k,2037) = .820_r8*rxt(k,309)*y(k,195) + .150_r8*rxt(k,450)*y(k,221) & + .025_r8*rxt(k,455)*y(k,222) - mat(k,478) = .500_r8*rxt(k,329)*y(k,124) - mat(k,1475) = mat(k,1475) + .800_r8*rxt(k,356)*y(k,1) + .500_r8*rxt(k,461) & + mat(k,565) = .500_r8*rxt(k,329)*y(k,124) + mat(k,1656) = mat(k,1656) + .800_r8*rxt(k,356)*y(k,1) + .500_r8*rxt(k,461) & *y(k,178) - mat(k,974) = .270_r8*rxt(k,452)*y(k,124) + .150_r8*rxt(k,450)*y(k,198) - mat(k,952) = .040_r8*rxt(k,457)*y(k,124) + .025_r8*rxt(k,455)*y(k,198) - mat(k,1100) = -(rxt(k,314)*y(k,126) + rxt(k,315)*y(k,217)) - mat(k,1970) = -rxt(k,314)*y(k,49) - mat(k,1494) = -rxt(k,315)*y(k,49) - mat(k,944) = rxt(k,316)*y(k,217) - mat(k,1089) = .880_r8*rxt(k,338)*y(k,134) - mat(k,1163) = .500_r8*rxt(k,352)*y(k,134) - mat(k,1626) = .170_r8*rxt(k,411)*y(k,199) + .050_r8*rxt(k,374)*y(k,206) & + mat(k,1111) = .270_r8*rxt(k,452)*y(k,124) + .150_r8*rxt(k,450)*y(k,198) + mat(k,913) = .040_r8*rxt(k,457)*y(k,124) + .025_r8*rxt(k,455)*y(k,198) + mat(k,1221) = -(rxt(k,314)*y(k,126) + rxt(k,315)*y(k,217)) + mat(k,1734) = -rxt(k,314)*y(k,49) + mat(k,1676) = -rxt(k,315)*y(k,49) + mat(k,1141) = rxt(k,316)*y(k,217) + mat(k,1210) = .880_r8*rxt(k,338)*y(k,134) + mat(k,1330) = .500_r8*rxt(k,352)*y(k,134) + mat(k,1827) = .170_r8*rxt(k,411)*y(k,199) + .050_r8*rxt(k,374)*y(k,206) & + .250_r8*rxt(k,336)*y(k,209) + .170_r8*rxt(k,417)*y(k,212) & + .400_r8*rxt(k,427)*y(k,223) + .250_r8*rxt(k,393)*y(k,225) & + .540_r8*rxt(k,433)*y(k,226) + .510_r8*rxt(k,436)*y(k,228) - mat(k,1970) = mat(k,1970) + .050_r8*rxt(k,375)*y(k,206) + .250_r8*rxt(k,335) & + mat(k,1734) = mat(k,1734) + .050_r8*rxt(k,375)*y(k,206) + .250_r8*rxt(k,335) & *y(k,209) + .250_r8*rxt(k,394)*y(k,225) - mat(k,752) = rxt(k,317)*y(k,217) - mat(k,2030) = .880_r8*rxt(k,338)*y(k,105) + .500_r8*rxt(k,352)*y(k,111) - mat(k,1258) = .250_r8*rxt(k,332)*y(k,209) + .250_r8*rxt(k,390)*y(k,225) - mat(k,1677) = .240_r8*rxt(k,333)*y(k,209) + .500_r8*rxt(k,321)*y(k,220) & + mat(k,858) = rxt(k,317)*y(k,217) + mat(k,2111) = .880_r8*rxt(k,338)*y(k,105) + .500_r8*rxt(k,352)*y(k,111) + mat(k,1380) = .250_r8*rxt(k,332)*y(k,209) + .250_r8*rxt(k,390)*y(k,225) + mat(k,2052) = .240_r8*rxt(k,333)*y(k,209) + .500_r8*rxt(k,321)*y(k,220) & + .100_r8*rxt(k,391)*y(k,225) - mat(k,651) = .170_r8*rxt(k,411)*y(k,124) + .070_r8*rxt(k,410)*y(k,203) - mat(k,1827) = .070_r8*rxt(k,410)*y(k,199) + .070_r8*rxt(k,416)*y(k,212) - mat(k,1141) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) - mat(k,1186) = .250_r8*rxt(k,336)*y(k,124) + .250_r8*rxt(k,335)*y(k,126) & + mat(k,761) = .170_r8*rxt(k,411)*y(k,124) + .070_r8*rxt(k,410)*y(k,203) + mat(k,1933) = .070_r8*rxt(k,410)*y(k,199) + .070_r8*rxt(k,416)*y(k,212) + mat(k,1287) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) + mat(k,1310) = .250_r8*rxt(k,336)*y(k,124) + .250_r8*rxt(k,335)*y(k,126) & + .250_r8*rxt(k,332)*y(k,197) + .240_r8*rxt(k,333)*y(k,198) - mat(k,772) = .170_r8*rxt(k,417)*y(k,124) + .070_r8*rxt(k,416)*y(k,203) - mat(k,1494) = mat(k,1494) + rxt(k,316)*y(k,95) + rxt(k,317)*y(k,127) - mat(k,1014) = .500_r8*rxt(k,321)*y(k,198) - mat(k,627) = .400_r8*rxt(k,427)*y(k,124) - mat(k,1053) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + mat(k,876) = .170_r8*rxt(k,417)*y(k,124) + .070_r8*rxt(k,416)*y(k,203) + mat(k,1676) = mat(k,1676) + rxt(k,316)*y(k,95) + rxt(k,317)*y(k,127) + mat(k,1131) = .500_r8*rxt(k,321)*y(k,198) + mat(k,737) = .400_r8*rxt(k,427)*y(k,124) + mat(k,1174) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + .250_r8*rxt(k,390)*y(k,197) + .100_r8*rxt(k,391)*y(k,198) - mat(k,643) = .540_r8*rxt(k,433)*y(k,124) - mat(k,412) = .510_r8*rxt(k,436)*y(k,124) - mat(k,473) = -(rxt(k,295)*y(k,217)) - mat(k,1439) = -rxt(k,295)*y(k,50) - mat(k,865) = .120_r8*rxt(k,308)*y(k,134) - mat(k,2006) = .120_r8*rxt(k,308)*y(k,29) - mat(k,1249) = .100_r8*rxt(k,292)*y(k,198) + .150_r8*rxt(k,293)*y(k,203) - mat(k,1655) = .100_r8*rxt(k,292)*y(k,197) - mat(k,1787) = .150_r8*rxt(k,293)*y(k,197) + .150_r8*rxt(k,343)*y(k,211) - mat(k,1229) = .150_r8*rxt(k,343)*y(k,203) - mat(k,435) = -(rxt(k,296)*y(k,217)) - mat(k,1435) = -rxt(k,296)*y(k,51) - mat(k,1248) = .400_r8*rxt(k,293)*y(k,203) - mat(k,1785) = .400_r8*rxt(k,293)*y(k,197) + .400_r8*rxt(k,343)*y(k,211) - mat(k,1228) = .400_r8*rxt(k,343)*y(k,203) - mat(k,696) = -(rxt(k,262)*y(k,217)) - mat(k,1462) = -rxt(k,262)*y(k,52) - mat(k,1066) = .200_r8*rxt(k,380)*y(k,198) - mat(k,714) = .300_r8*rxt(k,281)*y(k,198) - mat(k,1658) = .200_r8*rxt(k,380)*y(k,101) + .300_r8*rxt(k,281)*y(k,194) & - + 2.000_r8*rxt(k,259)*y(k,198) + .250_r8*rxt(k,366)*y(k,205) & + mat(k,753) = .540_r8*rxt(k,433)*y(k,124) + mat(k,501) = .510_r8*rxt(k,436)*y(k,124) + mat(k,684) = -(rxt(k,295)*y(k,217)) + mat(k,1633) = -rxt(k,295)*y(k,50) + mat(k,1019) = .120_r8*rxt(k,308)*y(k,134) + mat(k,2088) = .120_r8*rxt(k,308)*y(k,29) + mat(k,1370) = .100_r8*rxt(k,292)*y(k,198) + .150_r8*rxt(k,293)*y(k,203) + mat(k,2030) = .100_r8*rxt(k,292)*y(k,197) + mat(k,1899) = .150_r8*rxt(k,293)*y(k,197) + .150_r8*rxt(k,343)*y(k,211) + mat(k,1349) = .150_r8*rxt(k,343)*y(k,203) + mat(k,610) = -(rxt(k,296)*y(k,217)) + mat(k,1625) = -rxt(k,296)*y(k,51) + mat(k,1369) = .400_r8*rxt(k,293)*y(k,203) + mat(k,1893) = .400_r8*rxt(k,293)*y(k,197) + .400_r8*rxt(k,343)*y(k,211) + mat(k,1348) = .400_r8*rxt(k,343)*y(k,203) + mat(k,786) = -(rxt(k,263)*y(k,217)) + mat(k,1642) = -rxt(k,263)*y(k,52) + mat(k,1187) = .200_r8*rxt(k,380)*y(k,198) + mat(k,814) = .300_r8*rxt(k,281)*y(k,198) + mat(k,2031) = .200_r8*rxt(k,380)*y(k,101) + .300_r8*rxt(k,281)*y(k,194) & + + 2.000_r8*rxt(k,260)*y(k,198) + .250_r8*rxt(k,366)*y(k,205) & + .250_r8*rxt(k,371)*y(k,206) + .250_r8*rxt(k,333)*y(k,209) & + .250_r8*rxt(k,445)*y(k,215) + .500_r8*rxt(k,321)*y(k,220) & + .250_r8*rxt(k,450)*y(k,221) + .250_r8*rxt(k,455)*y(k,222) & + .300_r8*rxt(k,391)*y(k,225) - mat(k,1202) = .250_r8*rxt(k,366)*y(k,198) - mat(k,1129) = .250_r8*rxt(k,371)*y(k,198) - mat(k,1179) = .250_r8*rxt(k,333)*y(k,198) - mat(k,992) = .250_r8*rxt(k,445)*y(k,198) - mat(k,1011) = .500_r8*rxt(k,321)*y(k,198) - mat(k,973) = .250_r8*rxt(k,450)*y(k,198) - mat(k,951) = .250_r8*rxt(k,455)*y(k,198) - mat(k,1047) = .300_r8*rxt(k,391)*y(k,198) - mat(k,322) = -(rxt(k,263)*y(k,217)) - mat(k,1418) = -rxt(k,263)*y(k,53) - mat(k,1654) = rxt(k,260)*y(k,203) - mat(k,1770) = rxt(k,260)*y(k,198) - mat(k,1935) = -(rxt(k,174)*y(k,42) + rxt(k,176)*y(k,77) + rxt(k,177)*y(k,79) & - + (rxt(k,178) + rxt(k,179)) * y(k,203) + rxt(k,180)*y(k,134) & - + rxt(k,187)*y(k,60) + rxt(k,196)*y(k,92) + rxt(k,286)*y(k,28)) - mat(k,1743) = -rxt(k,174)*y(k,56) - mat(k,1043) = -rxt(k,176)*y(k,56) - mat(k,502) = -rxt(k,177)*y(k,56) - mat(k,1848) = -(rxt(k,178) + rxt(k,179)) * y(k,56) - mat(k,2052) = -rxt(k,180)*y(k,56) - mat(k,862) = -rxt(k,187)*y(k,56) - mat(k,729) = -rxt(k,196)*y(k,56) - mat(k,235) = -rxt(k,286)*y(k,56) - mat(k,1721) = rxt(k,215)*y(k,59) - mat(k,1338) = rxt(k,215)*y(k,19) + (4.000_r8*rxt(k,182)+2.000_r8*rxt(k,184)) & - *y(k,59) + rxt(k,186)*y(k,124) + rxt(k,191)*y(k,133) & - + rxt(k,469)*y(k,150) + rxt(k,181)*y(k,198) + rxt(k,192) & + mat(k,1247) = .250_r8*rxt(k,366)*y(k,198) + mat(k,1277) = .250_r8*rxt(k,371)*y(k,198) + mat(k,1305) = .250_r8*rxt(k,333)*y(k,198) + mat(k,1043) = .250_r8*rxt(k,445)*y(k,198) + mat(k,1128) = .500_r8*rxt(k,321)*y(k,198) + mat(k,1109) = .250_r8*rxt(k,450)*y(k,198) + mat(k,911) = .250_r8*rxt(k,455)*y(k,198) + mat(k,1167) = .300_r8*rxt(k,391)*y(k,198) + mat(k,385) = -(rxt(k,264)*y(k,217)) + mat(k,1594) = -rxt(k,264)*y(k,53) + mat(k,2028) = rxt(k,261)*y(k,203) + mat(k,1874) = rxt(k,261)*y(k,198) + mat(k,1430) = -(rxt(k,176)*y(k,56) + rxt(k,232)*y(k,73) + rxt(k,265)*y(k,217) & + + (rxt(k,271) + rxt(k,272) + rxt(k,273)) * y(k,216)) + mat(k,2007) = -rxt(k,176)*y(k,54) + mat(k,866) = -rxt(k,232)*y(k,54) + mat(k,1686) = -rxt(k,265)*y(k,54) + mat(k,1522) = -(rxt(k,271) + rxt(k,272) + rxt(k,273)) * y(k,54) + mat(k,1030) = .100_r8*rxt(k,308)*y(k,134) + mat(k,2120) = .100_r8*rxt(k,308)*y(k,29) + mat(k,447) = -(rxt(k,228)*y(k,216) + rxt(k,245)*y(k,56) + rxt(k,246)*y(k,217)) + mat(k,1515) = -rxt(k,228)*y(k,55) + mat(k,1990) = -rxt(k,245)*y(k,55) + mat(k,1603) = -rxt(k,246)*y(k,55) + mat(k,2017) = -(rxt(k,175)*y(k,42) + rxt(k,176)*y(k,54) + rxt(k,177)*y(k,77) & + + rxt(k,178)*y(k,79) + (rxt(k,179) + rxt(k,180)) * y(k,203) & + + rxt(k,181)*y(k,134) + rxt(k,188)*y(k,60) + rxt(k,197)*y(k,92) & + + rxt(k,238)*y(k,41) + rxt(k,240)*y(k,43) + rxt(k,243)*y(k,46) & + + rxt(k,245)*y(k,55) + rxt(k,286)*y(k,28)) + mat(k,1491) = -rxt(k,175)*y(k,56) + mat(k,1438) = -rxt(k,176)*y(k,56) + mat(k,1408) = -rxt(k,177)*y(k,56) + mat(k,606) = -rxt(k,178)*y(k,56) + mat(k,1952) = -(rxt(k,179) + rxt(k,180)) * y(k,56) + mat(k,2130) = -rxt(k,181)*y(k,56) + mat(k,889) = -rxt(k,188)*y(k,56) + mat(k,827) = -rxt(k,197)*y(k,56) + mat(k,471) = -rxt(k,238)*y(k,56) + mat(k,599) = -rxt(k,240)*y(k,56) + mat(k,369) = -rxt(k,243)*y(k,56) + mat(k,451) = -rxt(k,245)*y(k,56) + mat(k,294) = -rxt(k,286)*y(k,56) + mat(k,2221) = rxt(k,216)*y(k,59) + mat(k,101) = 4.000_r8*rxt(k,200)*y(k,216) + mat(k,145) = rxt(k,201)*y(k,216) + mat(k,116) = 2.000_r8*rxt(k,202)*y(k,216) + mat(k,155) = 2.000_r8*rxt(k,203)*y(k,216) + mat(k,120) = 2.000_r8*rxt(k,204)*y(k,216) + mat(k,160) = rxt(k,205)*y(k,216) + mat(k,124) = 2.000_r8*rxt(k,206)*y(k,216) + mat(k,127) = 3.000_r8*rxt(k,242)*y(k,217) + mat(k,369) = mat(k,369) + rxt(k,244)*y(k,217) + mat(k,1978) = rxt(k,216)*y(k,19) + (4.000_r8*rxt(k,183)+2.000_r8*rxt(k,185)) & + *y(k,59) + rxt(k,187)*y(k,124) + rxt(k,192)*y(k,133) & + + rxt(k,470)*y(k,150) + rxt(k,182)*y(k,198) + rxt(k,193) & *y(k,217) - mat(k,137) = rxt(k,236)*y(k,216) - mat(k,1901) = rxt(k,194)*y(k,133) + rxt(k,206)*y(k,216) + rxt(k,195)*y(k,217) - mat(k,1647) = rxt(k,186)*y(k,59) - mat(k,1878) = rxt(k,191)*y(k,59) + rxt(k,194)*y(k,85) - mat(k,1121) = rxt(k,469)*y(k,59) - mat(k,1697) = rxt(k,181)*y(k,59) - mat(k,1362) = rxt(k,236)*y(k,65) + rxt(k,206)*y(k,85) - mat(k,1516) = rxt(k,192)*y(k,59) + rxt(k,195)*y(k,85) - mat(k,1905) = rxt(k,187)*y(k,60) - mat(k,1317) = 2.000_r8*rxt(k,183)*y(k,59) - mat(k,853) = rxt(k,187)*y(k,56) + (rxt(k,528)+rxt(k,533)+rxt(k,538))*y(k,85) - mat(k,1882) = (rxt(k,528)+rxt(k,533)+rxt(k,538))*y(k,60) + (rxt(k,523) & + mat(k,229) = rxt(k,237)*y(k,216) + mat(k,225) = rxt(k,252)*y(k,216) + rxt(k,247)*y(k,217) + mat(k,252) = rxt(k,253)*y(k,216) + rxt(k,248)*y(k,217) + mat(k,308) = rxt(k,254)*y(k,216) + rxt(k,249)*y(k,217) + mat(k,2153) = rxt(k,195)*y(k,133) + rxt(k,207)*y(k,216) + rxt(k,196)*y(k,217) + mat(k,1845) = rxt(k,187)*y(k,59) + mat(k,2252) = rxt(k,192)*y(k,59) + rxt(k,195)*y(k,85) + mat(k,1239) = rxt(k,470)*y(k,59) + mat(k,2069) = rxt(k,182)*y(k,59) + mat(k,1532) = 4.000_r8*rxt(k,200)*y(k,33) + rxt(k,201)*y(k,34) & + + 2.000_r8*rxt(k,202)*y(k,36) + 2.000_r8*rxt(k,203)*y(k,37) & + + 2.000_r8*rxt(k,204)*y(k,38) + rxt(k,205)*y(k,39) & + + 2.000_r8*rxt(k,206)*y(k,40) + rxt(k,237)*y(k,65) + rxt(k,252) & + *y(k,82) + rxt(k,253)*y(k,83) + rxt(k,254)*y(k,84) + rxt(k,207) & + *y(k,85) + mat(k,1696) = 3.000_r8*rxt(k,242)*y(k,44) + rxt(k,244)*y(k,46) + rxt(k,193) & + *y(k,59) + rxt(k,247)*y(k,82) + rxt(k,248)*y(k,83) + rxt(k,249) & + *y(k,84) + rxt(k,196)*y(k,85) + mat(k,1986) = rxt(k,188)*y(k,60) + mat(k,1961) = 2.000_r8*rxt(k,184)*y(k,59) + mat(k,882) = rxt(k,188)*y(k,56) + (rxt(k,528)+rxt(k,533)+rxt(k,538))*y(k,85) + mat(k,2138) = (rxt(k,528)+rxt(k,533)+rxt(k,538))*y(k,60) + (rxt(k,523) & +rxt(k,529)+rxt(k,534))*y(k,92) - mat(k,723) = (rxt(k,523)+rxt(k,529)+rxt(k,534))*y(k,85) - mat(k,1316) = 2.000_r8*rxt(k,208)*y(k,59) - mat(k,1327) = -(rxt(k,181)*y(k,198) + (4._r8*rxt(k,182) + 4._r8*rxt(k,183) & - + 4._r8*rxt(k,184) + 4._r8*rxt(k,208)) * y(k,59) + rxt(k,185) & - *y(k,203) + rxt(k,186)*y(k,124) + rxt(k,188)*y(k,125) + rxt(k,191) & - *y(k,133) + (rxt(k,192) + rxt(k,193)) * y(k,217) + (rxt(k,214) & - + rxt(k,215) + rxt(k,216)) * y(k,19) + rxt(k,469)*y(k,150)) - mat(k,1686) = -rxt(k,181)*y(k,59) - mat(k,1837) = -rxt(k,185)*y(k,59) - mat(k,1636) = -rxt(k,186)*y(k,59) - mat(k,1546) = -rxt(k,188)*y(k,59) - mat(k,1867) = -rxt(k,191)*y(k,59) - mat(k,1505) = -(rxt(k,192) + rxt(k,193)) * y(k,59) - mat(k,1710) = -(rxt(k,214) + rxt(k,215) + rxt(k,216)) * y(k,59) - mat(k,1114) = -rxt(k,469)*y(k,59) - mat(k,1924) = rxt(k,196)*y(k,92) + rxt(k,180)*y(k,134) + rxt(k,179)*y(k,203) - mat(k,857) = rxt(k,189)*y(k,133) - mat(k,1890) = rxt(k,207)*y(k,216) - mat(k,725) = rxt(k,196)*y(k,56) + rxt(k,197)*y(k,133) + rxt(k,198)*y(k,217) - mat(k,1867) = mat(k,1867) + rxt(k,189)*y(k,60) + rxt(k,197)*y(k,92) - mat(k,2041) = rxt(k,180)*y(k,56) - mat(k,255) = rxt(k,474)*y(k,150) - mat(k,1114) = mat(k,1114) + rxt(k,474)*y(k,136) - mat(k,1837) = mat(k,1837) + rxt(k,179)*y(k,56) - mat(k,1351) = rxt(k,207)*y(k,85) - mat(k,1505) = mat(k,1505) + rxt(k,198)*y(k,92) - mat(k,855) = -(rxt(k,187)*y(k,56) + rxt(k,189)*y(k,133) + rxt(k,190)*y(k,217) & - + (rxt(k,528) + rxt(k,533) + rxt(k,538)) * y(k,85)) - mat(k,1915) = -rxt(k,187)*y(k,60) - mat(k,1860) = -rxt(k,189)*y(k,60) - mat(k,1476) = -rxt(k,190)*y(k,60) - mat(k,1886) = -(rxt(k,528) + rxt(k,533) + rxt(k,538)) * y(k,60) - mat(k,1322) = rxt(k,188)*y(k,125) - mat(k,1536) = rxt(k,188)*y(k,59) - mat(k,939) = -((rxt(k,265) + rxt(k,275)) * y(k,217)) - mat(k,1483) = -(rxt(k,265) + rxt(k,275)) * y(k,62) - mat(k,793) = .230_r8*rxt(k,440)*y(k,134) - mat(k,1277) = rxt(k,210)*y(k,42) - mat(k,228) = .350_r8*rxt(k,277)*y(k,217) - mat(k,468) = .630_r8*rxt(k,279)*y(k,134) - mat(k,870) = .560_r8*rxt(k,308)*y(k,134) - mat(k,1728) = rxt(k,210)*y(k,17) + rxt(k,174)*y(k,56) + rxt(k,255)*y(k,126) & - + rxt(k,256)*y(k,133) + rxt(k,257)*y(k,217) - mat(k,1099) = rxt(k,314)*y(k,126) + rxt(k,315)*y(k,217) - mat(k,1917) = rxt(k,174)*y(k,42) - mat(k,766) = rxt(k,302)*y(k,217) - mat(k,737) = .620_r8*rxt(k,385)*y(k,134) - mat(k,1087) = .650_r8*rxt(k,338)*y(k,134) - mat(k,820) = .230_r8*rxt(k,443)*y(k,134) - mat(k,1160) = .560_r8*rxt(k,352)*y(k,134) - mat(k,1616) = .170_r8*rxt(k,411)*y(k,199) + .220_r8*rxt(k,336)*y(k,209) & - + .400_r8*rxt(k,414)*y(k,210) + .350_r8*rxt(k,417)*y(k,212) & - + .225_r8*rxt(k,452)*y(k,221) + .250_r8*rxt(k,393)*y(k,225) - mat(k,1960) = rxt(k,255)*y(k,42) + rxt(k,314)*y(k,49) + .220_r8*rxt(k,335) & - *y(k,209) + .500_r8*rxt(k,394)*y(k,225) - mat(k,1861) = rxt(k,256)*y(k,42) + rxt(k,464)*y(k,137) - mat(k,2021) = .230_r8*rxt(k,440)*y(k,6) + .630_r8*rxt(k,279)*y(k,25) & - + .560_r8*rxt(k,308)*y(k,29) + .620_r8*rxt(k,385)*y(k,98) & - + .650_r8*rxt(k,338)*y(k,105) + .230_r8*rxt(k,443)*y(k,110) & - + .560_r8*rxt(k,352)*y(k,111) - mat(k,279) = rxt(k,464)*y(k,133) + rxt(k,465)*y(k,217) - mat(k,931) = .700_r8*rxt(k,461)*y(k,217) - mat(k,1253) = .220_r8*rxt(k,332)*y(k,209) + .250_r8*rxt(k,390)*y(k,225) - mat(k,1667) = .110_r8*rxt(k,333)*y(k,209) + .125_r8*rxt(k,450)*y(k,221) & - + .200_r8*rxt(k,391)*y(k,225) - mat(k,650) = .170_r8*rxt(k,411)*y(k,124) + .070_r8*rxt(k,410)*y(k,203) - mat(k,1816) = .070_r8*rxt(k,410)*y(k,199) + .160_r8*rxt(k,413)*y(k,210) & - + .140_r8*rxt(k,416)*y(k,212) - mat(k,1182) = .220_r8*rxt(k,336)*y(k,124) + .220_r8*rxt(k,335)*y(k,126) & - + .220_r8*rxt(k,332)*y(k,197) + .110_r8*rxt(k,333)*y(k,198) - mat(k,613) = .400_r8*rxt(k,414)*y(k,124) + .160_r8*rxt(k,413)*y(k,203) - mat(k,771) = .350_r8*rxt(k,417)*y(k,124) + .140_r8*rxt(k,416)*y(k,203) - mat(k,1483) = mat(k,1483) + .350_r8*rxt(k,277)*y(k,24) + rxt(k,257)*y(k,42) & - + rxt(k,315)*y(k,49) + rxt(k,302)*y(k,75) + rxt(k,465)*y(k,137) & - + .700_r8*rxt(k,461)*y(k,178) - mat(k,977) = .225_r8*rxt(k,452)*y(k,124) + .125_r8*rxt(k,450)*y(k,198) - mat(k,1050) = .250_r8*rxt(k,393)*y(k,124) + .500_r8*rxt(k,394)*y(k,126) & - + .250_r8*rxt(k,390)*y(k,197) + .200_r8*rxt(k,391)*y(k,198) + mat(k,823) = (rxt(k,523)+rxt(k,529)+rxt(k,534))*y(k,85) + mat(k,1960) = 2.000_r8*rxt(k,209)*y(k,59) + mat(k,1977) = -(rxt(k,182)*y(k,198) + (4._r8*rxt(k,183) + 4._r8*rxt(k,184) & + + 4._r8*rxt(k,185) + 4._r8*rxt(k,209)) * y(k,59) + rxt(k,186) & + *y(k,203) + rxt(k,187)*y(k,124) + rxt(k,189)*y(k,125) + rxt(k,192) & + *y(k,133) + (rxt(k,193) + rxt(k,194)) * y(k,217) + (rxt(k,215) & + + rxt(k,216) + rxt(k,217)) * y(k,19) + rxt(k,470)*y(k,150)) + mat(k,2068) = -rxt(k,182)*y(k,59) + mat(k,1951) = -rxt(k,186)*y(k,59) + mat(k,1844) = -rxt(k,187)*y(k,59) + mat(k,2196) = -rxt(k,189)*y(k,59) + mat(k,2251) = -rxt(k,192)*y(k,59) + mat(k,1695) = -(rxt(k,193) + rxt(k,194)) * y(k,59) + mat(k,2220) = -(rxt(k,215) + rxt(k,216) + rxt(k,217)) * y(k,59) + mat(k,1238) = -rxt(k,470)*y(k,59) + mat(k,2016) = rxt(k,197)*y(k,92) + rxt(k,181)*y(k,134) + rxt(k,180)*y(k,203) + mat(k,888) = rxt(k,190)*y(k,133) + mat(k,2152) = rxt(k,208)*y(k,216) + mat(k,826) = rxt(k,197)*y(k,56) + rxt(k,198)*y(k,133) + rxt(k,199)*y(k,217) + mat(k,2251) = mat(k,2251) + rxt(k,190)*y(k,60) + rxt(k,198)*y(k,92) + mat(k,2129) = rxt(k,181)*y(k,56) + mat(k,331) = rxt(k,475)*y(k,150) + mat(k,1238) = mat(k,1238) + rxt(k,475)*y(k,136) + mat(k,1951) = mat(k,1951) + rxt(k,180)*y(k,56) + mat(k,1531) = rxt(k,208)*y(k,85) + mat(k,1695) = mat(k,1695) + rxt(k,199)*y(k,92) end do end subroutine nlnmat02 subroutine nlnmat03( avec_len, mat, y, rxt ) @@ -489,231 +519,439 @@ subroutine nlnmat03( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,109) = -(rxt(k,235)*y(k,216)) - mat(k,1342) = -rxt(k,235)*y(k,64) - mat(k,134) = -(rxt(k,236)*y(k,216)) - mat(k,1344) = -rxt(k,236)*y(k,65) - mat(k,146) = -(rxt(k,409)*y(k,217)) - mat(k,1391) = -rxt(k,409)*y(k,66) - mat(k,140) = .180_r8*rxt(k,429)*y(k,217) - mat(k,1391) = mat(k,1391) + .180_r8*rxt(k,429)*y(k,180) - mat(k,210) = -(rxt(k,462)*y(k,126) + (rxt(k,463) + rxt(k,476)) * y(k,217)) - mat(k,1941) = -rxt(k,462)*y(k,67) - mat(k,1403) = -(rxt(k,463) + rxt(k,476)) * y(k,67) - mat(k,602) = rxt(k,297)*y(k,203) - mat(k,1759) = rxt(k,297)*y(k,202) - mat(k,677) = -(rxt(k,232)*y(k,77) + rxt(k,233)*y(k,229) + rxt(k,234)*y(k,89)) - mat(k,1034) = -rxt(k,232)*y(k,73) - mat(k,2059) = -rxt(k,233)*y(k,73) - mat(k,1289) = -rxt(k,234)*y(k,73) - mat(k,110) = 2.000_r8*rxt(k,235)*y(k,216) - mat(k,135) = rxt(k,236)*y(k,216) - mat(k,1345) = 2.000_r8*rxt(k,235)*y(k,64) + rxt(k,236)*y(k,65) - mat(k,908) = -(rxt(k,301)*y(k,217)) - mat(k,1480) = -rxt(k,301)*y(k,74) - mat(k,514) = .700_r8*rxt(k,376)*y(k,217) - mat(k,459) = .500_r8*rxt(k,377)*y(k,217) - mat(k,300) = rxt(k,388)*y(k,217) - mat(k,1613) = .050_r8*rxt(k,374)*y(k,206) + .530_r8*rxt(k,336)*y(k,209) & + mat(k,884) = -(rxt(k,188)*y(k,56) + rxt(k,190)*y(k,133) + rxt(k,191)*y(k,217) & + + (rxt(k,528) + rxt(k,533) + rxt(k,538)) * y(k,85)) + mat(k,1998) = -rxt(k,188)*y(k,60) + mat(k,2237) = -rxt(k,190)*y(k,60) + mat(k,1653) = -rxt(k,191)*y(k,60) + mat(k,2142) = -(rxt(k,528) + rxt(k,533) + rxt(k,538)) * y(k,60) + mat(k,1966) = rxt(k,189)*y(k,125) + mat(k,2178) = rxt(k,189)*y(k,59) + mat(k,1103) = -(rxt(k,275)*y(k,217)) + mat(k,1668) = -rxt(k,275)*y(k,62) + mat(k,1003) = .230_r8*rxt(k,440)*y(k,134) + mat(k,1414) = rxt(k,211)*y(k,42) + mat(k,288) = .350_r8*rxt(k,277)*y(k,217) + mat(k,551) = .630_r8*rxt(k,279)*y(k,134) + mat(k,1026) = .560_r8*rxt(k,308)*y(k,134) + mat(k,1479) = rxt(k,211)*y(k,17) + rxt(k,175)*y(k,56) + rxt(k,256)*y(k,126) & + + rxt(k,257)*y(k,133) + rxt(k,258)*y(k,217) + mat(k,366) = rxt(k,243)*y(k,56) + mat(k,1220) = rxt(k,314)*y(k,126) + rxt(k,315)*y(k,217) + mat(k,2003) = rxt(k,175)*y(k,42) + rxt(k,243)*y(k,46) + mat(k,980) = rxt(k,302)*y(k,217) + mat(k,844) = .620_r8*rxt(k,385)*y(k,134) + mat(k,1208) = .650_r8*rxt(k,338)*y(k,134) + mat(k,954) = .230_r8*rxt(k,443)*y(k,134) + mat(k,1328) = .560_r8*rxt(k,352)*y(k,134) + mat(k,1819) = .170_r8*rxt(k,411)*y(k,199) + .220_r8*rxt(k,336)*y(k,209) & + + .400_r8*rxt(k,414)*y(k,210) + .350_r8*rxt(k,417)*y(k,212) & + + .225_r8*rxt(k,452)*y(k,221) + .250_r8*rxt(k,393)*y(k,225) + mat(k,1726) = rxt(k,256)*y(k,42) + rxt(k,314)*y(k,49) + .220_r8*rxt(k,335) & + *y(k,209) + .500_r8*rxt(k,394)*y(k,225) + mat(k,2238) = rxt(k,257)*y(k,42) + rxt(k,464)*y(k,137) + mat(k,2105) = .230_r8*rxt(k,440)*y(k,6) + .630_r8*rxt(k,279)*y(k,25) & + + .560_r8*rxt(k,308)*y(k,29) + .620_r8*rxt(k,385)*y(k,98) & + + .650_r8*rxt(k,338)*y(k,105) + .230_r8*rxt(k,443)*y(k,110) & + + .560_r8*rxt(k,352)*y(k,111) + mat(k,360) = rxt(k,464)*y(k,133) + rxt(k,465)*y(k,217) + mat(k,1060) = .700_r8*rxt(k,461)*y(k,217) + mat(k,1375) = .220_r8*rxt(k,332)*y(k,209) + .250_r8*rxt(k,390)*y(k,225) + mat(k,2045) = .110_r8*rxt(k,333)*y(k,209) + .125_r8*rxt(k,450)*y(k,221) & + + .200_r8*rxt(k,391)*y(k,225) + mat(k,760) = .170_r8*rxt(k,411)*y(k,124) + .070_r8*rxt(k,410)*y(k,203) + mat(k,1926) = .070_r8*rxt(k,410)*y(k,199) + .160_r8*rxt(k,413)*y(k,210) & + + .140_r8*rxt(k,416)*y(k,212) + mat(k,1307) = .220_r8*rxt(k,336)*y(k,124) + .220_r8*rxt(k,335)*y(k,126) & + + .220_r8*rxt(k,332)*y(k,197) + .110_r8*rxt(k,333)*y(k,198) + mat(k,723) = .400_r8*rxt(k,414)*y(k,124) + .160_r8*rxt(k,413)*y(k,203) + mat(k,875) = .350_r8*rxt(k,417)*y(k,124) + .140_r8*rxt(k,416)*y(k,203) + mat(k,1668) = mat(k,1668) + .350_r8*rxt(k,277)*y(k,24) + rxt(k,258)*y(k,42) & + + rxt(k,315)*y(k,49) + rxt(k,302)*y(k,75) + rxt(k,465)*y(k,137) & + + .700_r8*rxt(k,461)*y(k,178) + mat(k,1114) = .225_r8*rxt(k,452)*y(k,124) + .125_r8*rxt(k,450)*y(k,198) + mat(k,1171) = .250_r8*rxt(k,393)*y(k,124) + .500_r8*rxt(k,394)*y(k,126) & + + .250_r8*rxt(k,390)*y(k,197) + .200_r8*rxt(k,391)*y(k,198) + mat(k,992) = .270_r8*rxt(k,440)*y(k,134) + mat(k,1021) = .200_r8*rxt(k,308)*y(k,134) + mat(k,685) = rxt(k,295)*y(k,217) + mat(k,611) = .500_r8*rxt(k,296)*y(k,217) + mat(k,1102) = rxt(k,275)*y(k,217) + mat(k,1094) = .800_r8*rxt(k,301)*y(k,217) + mat(k,978) = rxt(k,302)*y(k,217) + mat(k,928) = rxt(k,267)*y(k,217) + mat(k,573) = .500_r8*rxt(k,351)*y(k,217) + mat(k,943) = .270_r8*rxt(k,443)*y(k,134) + mat(k,1324) = .100_r8*rxt(k,352)*y(k,134) + mat(k,1804) = rxt(k,294)*y(k,197) + .900_r8*rxt(k,452)*y(k,221) + mat(k,2090) = .270_r8*rxt(k,440)*y(k,6) + .200_r8*rxt(k,308)*y(k,29) & + + .270_r8*rxt(k,443)*y(k,110) + .100_r8*rxt(k,352)*y(k,111) + mat(k,1057) = 1.800_r8*rxt(k,461)*y(k,217) + mat(k,1371) = rxt(k,294)*y(k,124) + 4.000_r8*rxt(k,291)*y(k,197) & + + .900_r8*rxt(k,292)*y(k,198) + rxt(k,365)*y(k,205) & + + 2.000_r8*rxt(k,341)*y(k,211) + rxt(k,390)*y(k,225) + mat(k,2033) = .900_r8*rxt(k,292)*y(k,197) + rxt(k,342)*y(k,211) & + + .500_r8*rxt(k,450)*y(k,221) + mat(k,1910) = .450_r8*rxt(k,343)*y(k,211) + mat(k,1248) = rxt(k,365)*y(k,197) + mat(k,1350) = 2.000_r8*rxt(k,341)*y(k,197) + rxt(k,342)*y(k,198) & + + .450_r8*rxt(k,343)*y(k,203) + 4.000_r8*rxt(k,344)*y(k,211) + mat(k,1644) = rxt(k,295)*y(k,50) + .500_r8*rxt(k,296)*y(k,51) + rxt(k,275) & + *y(k,62) + .800_r8*rxt(k,301)*y(k,74) + rxt(k,302)*y(k,75) & + + rxt(k,267)*y(k,87) + .500_r8*rxt(k,351)*y(k,109) & + + 1.800_r8*rxt(k,461)*y(k,178) + mat(k,1110) = .900_r8*rxt(k,452)*y(k,124) + .500_r8*rxt(k,450)*y(k,198) + mat(k,1168) = rxt(k,390)*y(k,197) + mat(k,235) = -(rxt(k,236)*y(k,216)) + mat(k,1512) = -rxt(k,236)*y(k,64) + mat(k,142) = rxt(k,201)*y(k,216) + mat(k,147) = rxt(k,227)*y(k,216) + mat(k,153) = rxt(k,203)*y(k,216) + mat(k,118) = 2.000_r8*rxt(k,204)*y(k,216) + mat(k,157) = 2.000_r8*rxt(k,205)*y(k,216) + mat(k,122) = rxt(k,206)*y(k,216) + mat(k,106) = 2.000_r8*rxt(k,229)*y(k,216) + mat(k,247) = rxt(k,253)*y(k,216) + rxt(k,248)*y(k,217) + mat(k,303) = rxt(k,254)*y(k,216) + rxt(k,249)*y(k,217) + mat(k,1512) = mat(k,1512) + rxt(k,201)*y(k,34) + rxt(k,227)*y(k,35) & + + rxt(k,203)*y(k,37) + 2.000_r8*rxt(k,204)*y(k,38) & + + 2.000_r8*rxt(k,205)*y(k,39) + rxt(k,206)*y(k,40) & + + 2.000_r8*rxt(k,229)*y(k,78) + rxt(k,253)*y(k,83) + rxt(k,254) & + *y(k,84) + mat(k,1572) = rxt(k,248)*y(k,83) + rxt(k,249)*y(k,84) + mat(k,226) = -(rxt(k,237)*y(k,216)) + mat(k,1511) = -rxt(k,237)*y(k,65) + mat(k,114) = rxt(k,202)*y(k,216) + mat(k,152) = rxt(k,203)*y(k,216) + mat(k,222) = rxt(k,252)*y(k,216) + rxt(k,247)*y(k,217) + mat(k,1511) = mat(k,1511) + rxt(k,202)*y(k,36) + rxt(k,203)*y(k,37) & + + rxt(k,252)*y(k,82) + mat(k,1570) = rxt(k,247)*y(k,82) + mat(k,194) = -(rxt(k,409)*y(k,217)) + mat(k,1564) = -rxt(k,409)*y(k,66) + mat(k,188) = .180_r8*rxt(k,429)*y(k,217) + mat(k,1564) = mat(k,1564) + .180_r8*rxt(k,429)*y(k,180) + mat(k,297) = -(rxt(k,462)*y(k,126) + (rxt(k,463) + rxt(k,477)) * y(k,217)) + mat(k,1707) = -rxt(k,462)*y(k,67) + mat(k,1582) = -(rxt(k,463) + rxt(k,477)) * y(k,67) + mat(k,712) = rxt(k,297)*y(k,203) + mat(k,1865) = rxt(k,297)*y(k,202) + mat(k,864) = -(rxt(k,232)*y(k,54) + rxt(k,233)*y(k,77) + rxt(k,234)*y(k,229) & + + rxt(k,235)*y(k,89)) + mat(k,1427) = -rxt(k,232)*y(k,73) + mat(k,1400) = -rxt(k,233)*y(k,73) + mat(k,2264) = -rxt(k,234)*y(k,73) + mat(k,1444) = -rxt(k,235)*y(k,73) + mat(k,148) = rxt(k,227)*y(k,216) + mat(k,158) = rxt(k,205)*y(k,216) + mat(k,236) = 2.000_r8*rxt(k,236)*y(k,216) + mat(k,227) = rxt(k,237)*y(k,216) + mat(k,1519) = rxt(k,227)*y(k,35) + rxt(k,205)*y(k,39) + 2.000_r8*rxt(k,236) & + *y(k,64) + rxt(k,237)*y(k,65) + mat(k,1096) = -(rxt(k,301)*y(k,217)) + mat(k,1667) = -rxt(k,301)*y(k,74) + mat(k,582) = .700_r8*rxt(k,376)*y(k,217) + mat(k,558) = .500_r8*rxt(k,377)*y(k,217) + mat(k,375) = rxt(k,388)*y(k,217) + mat(k,1818) = .050_r8*rxt(k,374)*y(k,206) + .530_r8*rxt(k,336)*y(k,209) & + .225_r8*rxt(k,452)*y(k,221) + .250_r8*rxt(k,393)*y(k,225) - mat(k,1957) = .050_r8*rxt(k,375)*y(k,206) + .530_r8*rxt(k,335)*y(k,209) & + mat(k,1725) = .050_r8*rxt(k,375)*y(k,206) + .530_r8*rxt(k,335)*y(k,209) & + .250_r8*rxt(k,394)*y(k,225) - mat(k,1252) = .530_r8*rxt(k,332)*y(k,209) + .250_r8*rxt(k,390)*y(k,225) - mat(k,1665) = .260_r8*rxt(k,333)*y(k,209) + .125_r8*rxt(k,450)*y(k,221) & + mat(k,1374) = .530_r8*rxt(k,332)*y(k,209) + .250_r8*rxt(k,390)*y(k,225) + mat(k,2044) = .260_r8*rxt(k,333)*y(k,209) + .125_r8*rxt(k,450)*y(k,221) & + .100_r8*rxt(k,391)*y(k,225) - mat(k,1133) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) - mat(k,1180) = .530_r8*rxt(k,336)*y(k,124) + .530_r8*rxt(k,335)*y(k,126) & + mat(k,1281) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) + mat(k,1306) = .530_r8*rxt(k,336)*y(k,124) + .530_r8*rxt(k,335)*y(k,126) & + .530_r8*rxt(k,332)*y(k,197) + .260_r8*rxt(k,333)*y(k,198) - mat(k,1480) = mat(k,1480) + .700_r8*rxt(k,376)*y(k,99) + .500_r8*rxt(k,377) & + mat(k,1667) = mat(k,1667) + .700_r8*rxt(k,376)*y(k,99) + .500_r8*rxt(k,377) & *y(k,100) + rxt(k,388)*y(k,115) - mat(k,975) = .225_r8*rxt(k,452)*y(k,124) + .125_r8*rxt(k,450)*y(k,198) - mat(k,1049) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + mat(k,1113) = .225_r8*rxt(k,452)*y(k,124) + .125_r8*rxt(k,450)*y(k,198) + mat(k,1170) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + .250_r8*rxt(k,390)*y(k,197) + .100_r8*rxt(k,391)*y(k,198) - mat(k,765) = -(rxt(k,302)*y(k,217)) - mat(k,1470) = -rxt(k,302)*y(k,75) - mat(k,227) = .650_r8*rxt(k,277)*y(k,217) - mat(k,907) = .200_r8*rxt(k,301)*y(k,217) - mat(k,894) = rxt(k,389)*y(k,217) - mat(k,1607) = rxt(k,400)*y(k,191) + .050_r8*rxt(k,374)*y(k,206) & + mat(k,979) = -(rxt(k,302)*y(k,217)) + mat(k,1660) = -rxt(k,302)*y(k,75) + mat(k,287) = .650_r8*rxt(k,277)*y(k,217) + mat(k,1095) = .200_r8*rxt(k,301)*y(k,217) + mat(k,1072) = rxt(k,389)*y(k,217) + mat(k,1813) = rxt(k,400)*y(k,191) + .050_r8*rxt(k,374)*y(k,206) & + .400_r8*rxt(k,414)*y(k,210) + .170_r8*rxt(k,417)*y(k,212) & + .700_r8*rxt(k,420)*y(k,218) + .600_r8*rxt(k,427)*y(k,223) & + .250_r8*rxt(k,393)*y(k,225) + .340_r8*rxt(k,433)*y(k,226) & + .170_r8*rxt(k,436)*y(k,228) - mat(k,1949) = .050_r8*rxt(k,375)*y(k,206) + .250_r8*rxt(k,394)*y(k,225) - mat(k,404) = rxt(k,400)*y(k,124) - mat(k,1250) = .250_r8*rxt(k,390)*y(k,225) - mat(k,1661) = .100_r8*rxt(k,391)*y(k,225) - mat(k,1809) = .160_r8*rxt(k,413)*y(k,210) + .070_r8*rxt(k,416)*y(k,212) - mat(k,1131) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) - mat(k,612) = .400_r8*rxt(k,414)*y(k,124) + .160_r8*rxt(k,413)*y(k,203) - mat(k,769) = .170_r8*rxt(k,417)*y(k,124) + .070_r8*rxt(k,416)*y(k,203) - mat(k,1470) = mat(k,1470) + .650_r8*rxt(k,277)*y(k,24) + .200_r8*rxt(k,301) & + mat(k,1718) = .050_r8*rxt(k,375)*y(k,206) + .250_r8*rxt(k,394)*y(k,225) + mat(k,485) = rxt(k,400)*y(k,124) + mat(k,1372) = .250_r8*rxt(k,390)*y(k,225) + mat(k,2039) = .100_r8*rxt(k,391)*y(k,225) + mat(k,1921) = .160_r8*rxt(k,413)*y(k,210) + .070_r8*rxt(k,416)*y(k,212) + mat(k,1280) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) + mat(k,722) = .400_r8*rxt(k,414)*y(k,124) + .160_r8*rxt(k,413)*y(k,203) + mat(k,874) = .170_r8*rxt(k,417)*y(k,124) + .070_r8*rxt(k,416)*y(k,203) + mat(k,1660) = mat(k,1660) + .650_r8*rxt(k,277)*y(k,24) + .200_r8*rxt(k,301) & *y(k,74) + rxt(k,389)*y(k,116) - mat(k,374) = .700_r8*rxt(k,420)*y(k,124) - mat(k,624) = .600_r8*rxt(k,427)*y(k,124) - mat(k,1048) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + mat(k,455) = .700_r8*rxt(k,420)*y(k,124) + mat(k,735) = .600_r8*rxt(k,427)*y(k,124) + mat(k,1169) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + .250_r8*rxt(k,390)*y(k,197) + .100_r8*rxt(k,391)*y(k,198) - mat(k,640) = .340_r8*rxt(k,433)*y(k,124) - mat(k,411) = .170_r8*rxt(k,436)*y(k,124) - mat(k,1304) = -((rxt(k,134) + rxt(k,135) + rxt(k,136)) * y(k,203) + rxt(k,140) & + mat(k,751) = .340_r8*rxt(k,433)*y(k,124) + mat(k,500) = .170_r8*rxt(k,436)*y(k,124) + mat(k,1463) = -((rxt(k,135) + rxt(k,136) + rxt(k,137)) * y(k,203) + rxt(k,141) & *y(k,134)) - mat(k,1836) = -(rxt(k,134) + rxt(k,135) + rxt(k,136)) * y(k,76) - mat(k,2040) = -rxt(k,140)*y(k,76) - mat(k,1732) = rxt(k,257)*y(k,217) - mat(k,1923) = rxt(k,176)*y(k,77) - mat(k,940) = rxt(k,275)*y(k,217) - mat(k,680) = rxt(k,232)*y(k,77) - mat(k,1037) = rxt(k,176)*y(k,56) + rxt(k,232)*y(k,73) + rxt(k,132)*y(k,133) & - + rxt(k,124)*y(k,216) + rxt(k,141)*y(k,217) - mat(k,706) = rxt(k,230)*y(k,216) - mat(k,1889) = rxt(k,207)*y(k,216) - mat(k,293) = rxt(k,162)*y(k,217) - mat(k,1866) = rxt(k,132)*y(k,77) + rxt(k,144)*y(k,217) - mat(k,281) = rxt(k,465)*y(k,217) - mat(k,419) = rxt(k,470)*y(k,217) - mat(k,1113) = rxt(k,475)*y(k,217) - mat(k,1350) = rxt(k,124)*y(k,77) + rxt(k,230)*y(k,81) + rxt(k,207)*y(k,85) - mat(k,1504) = rxt(k,257)*y(k,42) + rxt(k,275)*y(k,62) + rxt(k,141)*y(k,77) & - + rxt(k,162)*y(k,112) + rxt(k,144)*y(k,133) + rxt(k,465) & - *y(k,137) + rxt(k,470)*y(k,148) + rxt(k,475)*y(k,150) - mat(k,1035) = -(rxt(k,124)*y(k,216) + rxt(k,132)*y(k,133) + rxt(k,141) & - *y(k,217) + rxt(k,176)*y(k,56) + rxt(k,232)*y(k,73)) - mat(k,1347) = -rxt(k,124)*y(k,77) - mat(k,1862) = -rxt(k,132)*y(k,77) - mat(k,1490) = -rxt(k,141)*y(k,77) - mat(k,1919) = -rxt(k,176)*y(k,77) - mat(k,678) = -rxt(k,232)*y(k,77) - mat(k,1302) = rxt(k,134)*y(k,203) - mat(k,1823) = rxt(k,134)*y(k,76) - mat(k,497) = -(rxt(k,133)*y(k,133) + rxt(k,142)*y(k,217) + rxt(k,177)*y(k,56)) - mat(k,1855) = -rxt(k,133)*y(k,79) - mat(k,1443) = -rxt(k,142)*y(k,79) - mat(k,1909) = -rxt(k,177)*y(k,79) - mat(k,1788) = 2.000_r8*rxt(k,148)*y(k,203) - mat(k,1443) = mat(k,1443) + 2.000_r8*rxt(k,147)*y(k,217) - mat(k,193) = rxt(k,478)*y(k,229) - mat(k,2056) = rxt(k,478)*y(k,152) - mat(k,704) = -(rxt(k,223)*y(k,133) + rxt(k,224)*y(k,217) + (rxt(k,229) & - + rxt(k,230)) * y(k,216)) - mat(k,1857) = -rxt(k,223)*y(k,81) - mat(k,1464) = -rxt(k,224)*y(k,81) - mat(k,1346) = -(rxt(k,229) + rxt(k,230)) * y(k,81) - mat(k,1276) = rxt(k,210)*y(k,42) + rxt(k,211)*y(k,203) - mat(k,1727) = rxt(k,210)*y(k,17) - mat(k,1805) = rxt(k,211)*y(k,17) - mat(k,1900) = -(rxt(k,194)*y(k,133) + rxt(k,195)*y(k,217) + (rxt(k,206) & - + rxt(k,207)) * y(k,216) + (rxt(k,523) + rxt(k,529) + rxt(k,534) & + mat(k,1944) = -(rxt(k,135) + rxt(k,136) + rxt(k,137)) * y(k,76) + mat(k,2122) = -rxt(k,141)*y(k,76) + mat(k,1484) = rxt(k,258)*y(k,217) + mat(k,1432) = rxt(k,272)*y(k,216) + mat(k,2009) = rxt(k,177)*y(k,77) + mat(k,868) = rxt(k,233)*y(k,77) + mat(k,1404) = rxt(k,177)*y(k,56) + rxt(k,233)*y(k,73) + rxt(k,133)*y(k,133) & + + rxt(k,125)*y(k,216) + rxt(k,142)*y(k,217) + mat(k,806) = rxt(k,231)*y(k,216) + mat(k,2145) = rxt(k,208)*y(k,216) + mat(k,492) = rxt(k,163)*y(k,217) + mat(k,2244) = rxt(k,133)*y(k,77) + rxt(k,145)*y(k,217) + mat(k,362) = rxt(k,465)*y(k,217) + mat(k,513) = rxt(k,471)*y(k,217) + mat(k,1234) = rxt(k,476)*y(k,217) + mat(k,1524) = rxt(k,272)*y(k,54) + rxt(k,125)*y(k,77) + rxt(k,231)*y(k,81) & + + rxt(k,208)*y(k,85) + mat(k,1688) = rxt(k,258)*y(k,42) + rxt(k,142)*y(k,77) + rxt(k,163)*y(k,112) & + + rxt(k,145)*y(k,133) + rxt(k,465)*y(k,137) + rxt(k,471) & + *y(k,148) + rxt(k,476)*y(k,150) + mat(k,1401) = -(rxt(k,125)*y(k,216) + rxt(k,133)*y(k,133) + rxt(k,142) & + *y(k,217) + rxt(k,177)*y(k,56) + rxt(k,233)*y(k,73)) + mat(k,1520) = -rxt(k,125)*y(k,77) + mat(k,2240) = -rxt(k,133)*y(k,77) + mat(k,1684) = -rxt(k,142)*y(k,77) + mat(k,2005) = -rxt(k,177)*y(k,77) + mat(k,865) = -rxt(k,233)*y(k,77) + mat(k,1429) = rxt(k,273)*y(k,216) + mat(k,1460) = rxt(k,135)*y(k,203) + mat(k,1940) = rxt(k,135)*y(k,76) + mat(k,1520) = mat(k,1520) + rxt(k,273)*y(k,54) + 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,105) = -(rxt(k,229)*y(k,216)) + mat(k,1500) = -rxt(k,229)*y(k,78) + mat(k,603) = -(rxt(k,134)*y(k,133) + rxt(k,143)*y(k,217) + rxt(k,178)*y(k,56)) + mat(k,2232) = -rxt(k,134)*y(k,79) + mat(k,1624) = -rxt(k,143)*y(k,79) + mat(k,1994) = -rxt(k,178)*y(k,79) + mat(k,1892) = 2.000_r8*rxt(k,149)*y(k,203) + mat(k,1624) = mat(k,1624) + 2.000_r8*rxt(k,148)*y(k,217) + mat(k,256) = rxt(k,478)*y(k,229) + mat(k,2260) = rxt(k,478)*y(k,152) + mat(k,804) = -(rxt(k,224)*y(k,133) + rxt(k,225)*y(k,217) + (rxt(k,230) & + + rxt(k,231)) * y(k,216)) + mat(k,2234) = -rxt(k,224)*y(k,81) + mat(k,1645) = -rxt(k,225)*y(k,81) + mat(k,1518) = -(rxt(k,230) + rxt(k,231)) * y(k,81) + mat(k,1413) = rxt(k,211)*y(k,42) + rxt(k,212)*y(k,203) + mat(k,1477) = rxt(k,211)*y(k,17) + mat(k,1911) = rxt(k,212)*y(k,17) + mat(k,221) = -(rxt(k,247)*y(k,217) + rxt(k,252)*y(k,216)) + mat(k,1569) = -rxt(k,247)*y(k,82) + mat(k,1510) = -rxt(k,252)*y(k,82) + mat(k,248) = -(rxt(k,248)*y(k,217) + rxt(k,253)*y(k,216)) + mat(k,1575) = -rxt(k,248)*y(k,83) + mat(k,1513) = -rxt(k,253)*y(k,83) + mat(k,304) = -(rxt(k,249)*y(k,217) + rxt(k,254)*y(k,216)) + mat(k,1583) = -rxt(k,249)*y(k,84) + mat(k,1514) = -rxt(k,254)*y(k,84) + mat(k,2156) = -(rxt(k,195)*y(k,133) + rxt(k,196)*y(k,217) + (rxt(k,207) & + + rxt(k,208)) * y(k,216) + (rxt(k,523) + rxt(k,529) + rxt(k,534) & ) * y(k,92) + (rxt(k,528) + rxt(k,533) + rxt(k,538)) * y(k,60) & + (rxt(k,530) + rxt(k,535)) * y(k,91)) - mat(k,1877) = -rxt(k,194)*y(k,85) - mat(k,1515) = -rxt(k,195)*y(k,85) - mat(k,1361) = -(rxt(k,206) + rxt(k,207)) * y(k,85) - mat(k,728) = -(rxt(k,523) + rxt(k,529) + rxt(k,534)) * y(k,85) - mat(k,861) = -(rxt(k,528) + rxt(k,533) + rxt(k,538)) * y(k,85) - mat(k,673) = -(rxt(k,530) + rxt(k,535)) * y(k,85) - mat(k,234) = rxt(k,286)*y(k,56) - mat(k,1742) = rxt(k,174)*y(k,56) - mat(k,1934) = rxt(k,286)*y(k,28) + rxt(k,174)*y(k,42) + rxt(k,176)*y(k,77) & - + rxt(k,177)*y(k,79) + rxt(k,196)*y(k,92) + rxt(k,178)*y(k,203) - mat(k,1337) = rxt(k,193)*y(k,217) - mat(k,1042) = rxt(k,176)*y(k,56) - mat(k,501) = rxt(k,177)*y(k,56) - mat(k,728) = mat(k,728) + rxt(k,196)*y(k,56) - mat(k,1847) = rxt(k,178)*y(k,56) - mat(k,1515) = mat(k,1515) + rxt(k,193)*y(k,59) - mat(k,130) = -(rxt(k,266)*y(k,217) + rxt(k,274)*y(k,216)) - mat(k,1388) = -rxt(k,266)*y(k,86) - mat(k,1343) = -rxt(k,274)*y(k,86) - mat(k,700) = -(rxt(k,267)*y(k,217)) - mat(k,1463) = -rxt(k,267)*y(k,87) - mat(k,786) = .050_r8*rxt(k,440)*y(k,134) - mat(k,226) = .350_r8*rxt(k,277)*y(k,217) - mat(k,467) = .370_r8*rxt(k,279)*y(k,134) - mat(k,867) = .120_r8*rxt(k,308)*y(k,134) - mat(k,734) = .110_r8*rxt(k,385)*y(k,134) - mat(k,1086) = .330_r8*rxt(k,338)*y(k,134) - mat(k,813) = .050_r8*rxt(k,443)*y(k,134) - mat(k,1158) = .120_r8*rxt(k,352)*y(k,134) - mat(k,1604) = rxt(k,270)*y(k,204) - mat(k,2009) = .050_r8*rxt(k,440)*y(k,6) + .370_r8*rxt(k,279)*y(k,25) & + mat(k,2255) = -rxt(k,195)*y(k,85) + mat(k,1699) = -rxt(k,196)*y(k,85) + mat(k,1535) = -(rxt(k,207) + rxt(k,208)) * y(k,85) + mat(k,828) = -(rxt(k,523) + rxt(k,529) + rxt(k,534)) * y(k,85) + mat(k,890) = -(rxt(k,528) + rxt(k,533) + rxt(k,538)) * y(k,85) + mat(k,782) = -(rxt(k,530) + rxt(k,535)) * y(k,85) + mat(k,295) = rxt(k,286)*y(k,56) + mat(k,472) = rxt(k,238)*y(k,56) + mat(k,1494) = rxt(k,175)*y(k,56) + mat(k,601) = rxt(k,240)*y(k,56) + mat(k,371) = 2.000_r8*rxt(k,243)*y(k,56) + mat(k,1440) = rxt(k,176)*y(k,56) + mat(k,452) = rxt(k,245)*y(k,56) + mat(k,2020) = rxt(k,286)*y(k,28) + rxt(k,238)*y(k,41) + rxt(k,175)*y(k,42) & + + rxt(k,240)*y(k,43) + 2.000_r8*rxt(k,243)*y(k,46) + rxt(k,176) & + *y(k,54) + rxt(k,245)*y(k,55) + rxt(k,177)*y(k,77) + rxt(k,178) & + *y(k,79) + rxt(k,197)*y(k,92) + rxt(k,179)*y(k,203) + mat(k,1981) = rxt(k,194)*y(k,217) + mat(k,1410) = rxt(k,177)*y(k,56) + mat(k,607) = rxt(k,178)*y(k,56) + mat(k,828) = mat(k,828) + rxt(k,197)*y(k,56) + mat(k,1955) = rxt(k,179)*y(k,56) + mat(k,1699) = mat(k,1699) + rxt(k,194)*y(k,59) + mat(k,179) = -(rxt(k,266)*y(k,217) + rxt(k,274)*y(k,216)) + mat(k,1562) = -rxt(k,266)*y(k,86) + mat(k,1508) = -rxt(k,274)*y(k,86) + mat(k,929) = -(rxt(k,267)*y(k,217)) + mat(k,1657) = -rxt(k,267)*y(k,87) + mat(k,996) = .050_r8*rxt(k,440)*y(k,134) + mat(k,286) = .350_r8*rxt(k,277)*y(k,217) + mat(k,550) = .370_r8*rxt(k,279)*y(k,134) + mat(k,1023) = .120_r8*rxt(k,308)*y(k,134) + mat(k,842) = .110_r8*rxt(k,385)*y(k,134) + mat(k,1207) = .330_r8*rxt(k,338)*y(k,134) + mat(k,947) = .050_r8*rxt(k,443)*y(k,134) + mat(k,1325) = .120_r8*rxt(k,352)*y(k,134) + mat(k,1811) = rxt(k,270)*y(k,204) + mat(k,2095) = .050_r8*rxt(k,440)*y(k,6) + .370_r8*rxt(k,279)*y(k,25) & + .120_r8*rxt(k,308)*y(k,29) + .110_r8*rxt(k,385)*y(k,98) & + .330_r8*rxt(k,338)*y(k,105) + .050_r8*rxt(k,443)*y(k,110) & + .120_r8*rxt(k,352)*y(k,111) - mat(k,1804) = rxt(k,268)*y(k,204) - mat(k,367) = rxt(k,270)*y(k,124) + rxt(k,268)*y(k,203) - mat(k,1463) = mat(k,1463) + .350_r8*rxt(k,277)*y(k,24) - mat(k,676) = rxt(k,232)*y(k,77) + rxt(k,234)*y(k,89) + rxt(k,233)*y(k,229) - mat(k,1033) = rxt(k,232)*y(k,73) - mat(k,1288) = rxt(k,234)*y(k,73) - mat(k,2057) = rxt(k,233)*y(k,73) - mat(k,1291) = -(rxt(k,171)*y(k,217) + rxt(k,234)*y(k,73)) - mat(k,1503) = -rxt(k,171)*y(k,89) - mat(k,679) = -rxt(k,234)*y(k,89) - mat(k,1731) = rxt(k,255)*y(k,126) - mat(k,1026) = rxt(k,288)*y(k,126) - mat(k,1102) = rxt(k,314)*y(k,126) - mat(k,856) = (rxt(k,528)+rxt(k,533)+rxt(k,538))*y(k,85) - mat(k,212) = rxt(k,462)*y(k,126) - mat(k,1888) = (rxt(k,528)+rxt(k,533)+rxt(k,538))*y(k,60) - mat(k,1544) = rxt(k,170)*y(k,217) - mat(k,1979) = rxt(k,255)*y(k,42) + rxt(k,288)*y(k,45) + rxt(k,314)*y(k,49) & + mat(k,1919) = rxt(k,268)*y(k,204) + mat(k,442) = rxt(k,270)*y(k,124) + rxt(k,268)*y(k,203) + mat(k,1657) = mat(k,1657) + .350_r8*rxt(k,277)*y(k,24) + mat(k,1425) = rxt(k,232)*y(k,73) + mat(k,863) = rxt(k,232)*y(k,54) + rxt(k,233)*y(k,77) + rxt(k,235)*y(k,89) & + + rxt(k,234)*y(k,229) + mat(k,1399) = rxt(k,233)*y(k,73) + mat(k,1443) = rxt(k,235)*y(k,73) + mat(k,2262) = rxt(k,234)*y(k,73) + mat(k,1447) = -(rxt(k,172)*y(k,217) + rxt(k,235)*y(k,73)) + mat(k,1687) = -rxt(k,172)*y(k,89) + mat(k,867) = -rxt(k,235)*y(k,89) + mat(k,1483) = rxt(k,256)*y(k,126) + mat(k,1088) = rxt(k,288)*y(k,126) + mat(k,1223) = rxt(k,314)*y(k,126) + mat(k,885) = (rxt(k,528)+rxt(k,533)+rxt(k,538))*y(k,85) + mat(k,299) = rxt(k,462)*y(k,126) + mat(k,2144) = (rxt(k,528)+rxt(k,533)+rxt(k,538))*y(k,60) + mat(k,2188) = rxt(k,171)*y(k,217) + mat(k,1744) = rxt(k,256)*y(k,42) + rxt(k,288)*y(k,45) + rxt(k,314)*y(k,49) & + rxt(k,462)*y(k,67) - mat(k,1503) = mat(k,1503) + rxt(k,170)*y(k,125) - mat(k,334) = -(rxt(k,149)*y(k,217)) - mat(k,1420) = -rxt(k,149)*y(k,90) - mat(k,1523) = rxt(k,168)*y(k,203) - mat(k,1772) = rxt(k,168)*y(k,125) - mat(k,668) = -(rxt(k,225)*y(k,133) + (rxt(k,530) + rxt(k,535)) * y(k,85)) - mat(k,1856) = -rxt(k,225)*y(k,91) - mat(k,1884) = -(rxt(k,530) + rxt(k,535)) * y(k,91) - mat(k,1704) = rxt(k,217)*y(k,203) - mat(k,1802) = rxt(k,217)*y(k,19) - mat(k,724) = -(rxt(k,196)*y(k,56) + rxt(k,197)*y(k,133) + rxt(k,198)*y(k,217) & + mat(k,1687) = mat(k,1687) + rxt(k,171)*y(k,125) + mat(k,403) = -(rxt(k,150)*y(k,217)) + mat(k,1597) = -rxt(k,150)*y(k,90) + mat(k,2164) = rxt(k,169)*y(k,203) + mat(k,1877) = rxt(k,169)*y(k,125) + mat(k,778) = -(rxt(k,226)*y(k,133) + (rxt(k,530) + rxt(k,535)) * y(k,85)) + mat(k,2233) = -rxt(k,226)*y(k,91) + mat(k,2140) = -(rxt(k,530) + rxt(k,535)) * y(k,91) + mat(k,2208) = rxt(k,218)*y(k,203) + mat(k,1908) = rxt(k,218)*y(k,19) + mat(k,824) = -(rxt(k,197)*y(k,56) + rxt(k,198)*y(k,133) + rxt(k,199)*y(k,217) & + (rxt(k,523) + rxt(k,529) + rxt(k,534)) * y(k,85)) - mat(k,1913) = -rxt(k,196)*y(k,92) - mat(k,1858) = -rxt(k,197)*y(k,92) - mat(k,1466) = -rxt(k,198)*y(k,92) - mat(k,1885) = -(rxt(k,523) + rxt(k,529) + rxt(k,534)) * y(k,92) - mat(k,1320) = rxt(k,185)*y(k,203) - mat(k,854) = rxt(k,190)*y(k,217) - mat(k,1807) = rxt(k,185)*y(k,59) - mat(k,1466) = mat(k,1466) + rxt(k,190)*y(k,60) - mat(k,916) = -(rxt(k,331)*y(k,217)) - mat(k,1481) = -rxt(k,331)*y(k,93) - mat(k,515) = .300_r8*rxt(k,376)*y(k,217) - mat(k,460) = .500_r8*rxt(k,377)*y(k,217) - mat(k,1614) = rxt(k,330)*y(k,200) + rxt(k,337)*y(k,209) - mat(k,479) = rxt(k,330)*y(k,124) - mat(k,1181) = rxt(k,337)*y(k,124) - mat(k,1481) = mat(k,1481) + .300_r8*rxt(k,376)*y(k,99) + .500_r8*rxt(k,377) & + mat(k,1997) = -rxt(k,197)*y(k,92) + mat(k,2235) = -rxt(k,198)*y(k,92) + mat(k,1647) = -rxt(k,199)*y(k,92) + mat(k,2141) = -(rxt(k,523) + rxt(k,529) + rxt(k,534)) * y(k,92) + mat(k,1964) = rxt(k,186)*y(k,203) + mat(k,883) = rxt(k,191)*y(k,217) + mat(k,1913) = rxt(k,186)*y(k,59) + mat(k,1647) = mat(k,1647) + rxt(k,191)*y(k,60) + mat(k,1153) = -(rxt(k,331)*y(k,217)) + mat(k,1672) = -rxt(k,331)*y(k,93) + mat(k,584) = .300_r8*rxt(k,376)*y(k,217) + mat(k,560) = .500_r8*rxt(k,377)*y(k,217) + mat(k,1823) = rxt(k,330)*y(k,200) + rxt(k,337)*y(k,209) + mat(k,567) = rxt(k,330)*y(k,124) + mat(k,1309) = rxt(k,337)*y(k,124) + mat(k,1672) = mat(k,1672) + .300_r8*rxt(k,376)*y(k,99) + .500_r8*rxt(k,377) & *y(k,100) - mat(k,176) = -(rxt(k,362)*y(k,217)) - mat(k,1396) = -rxt(k,362)*y(k,94) - mat(k,943) = -(rxt(k,316)*y(k,217)) - mat(k,1484) = -rxt(k,316)*y(k,95) - mat(k,516) = .700_r8*rxt(k,376)*y(k,217) - mat(k,461) = .500_r8*rxt(k,377)*y(k,217) - mat(k,486) = .500_r8*rxt(k,351)*y(k,217) - mat(k,1617) = .050_r8*rxt(k,374)*y(k,206) + .220_r8*rxt(k,336)*y(k,209) & + mat(k,230) = -(rxt(k,362)*y(k,217)) + mat(k,1571) = -rxt(k,362)*y(k,94) + mat(k,1140) = -(rxt(k,316)*y(k,217)) + mat(k,1671) = -rxt(k,316)*y(k,95) + mat(k,583) = .700_r8*rxt(k,376)*y(k,217) + mat(k,559) = .500_r8*rxt(k,377)*y(k,217) + mat(k,574) = .500_r8*rxt(k,351)*y(k,217) + mat(k,1822) = .050_r8*rxt(k,374)*y(k,206) + .220_r8*rxt(k,336)*y(k,209) & + .250_r8*rxt(k,393)*y(k,225) - mat(k,1961) = .050_r8*rxt(k,375)*y(k,206) + .220_r8*rxt(k,335)*y(k,209) & + mat(k,1729) = .050_r8*rxt(k,375)*y(k,206) + .220_r8*rxt(k,335)*y(k,209) & + .250_r8*rxt(k,394)*y(k,225) - mat(k,443) = .500_r8*rxt(k,320)*y(k,217) - mat(k,1254) = .220_r8*rxt(k,332)*y(k,209) + .250_r8*rxt(k,390)*y(k,225) - mat(k,1668) = .230_r8*rxt(k,333)*y(k,209) + .200_r8*rxt(k,321)*y(k,220) & + mat(k,535) = .500_r8*rxt(k,320)*y(k,217) + mat(k,1376) = .220_r8*rxt(k,332)*y(k,209) + .250_r8*rxt(k,390)*y(k,225) + mat(k,2048) = .230_r8*rxt(k,333)*y(k,209) + .200_r8*rxt(k,321)*y(k,220) & + .100_r8*rxt(k,391)*y(k,225) - mat(k,1136) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) - mat(k,1183) = .220_r8*rxt(k,336)*y(k,124) + .220_r8*rxt(k,335)*y(k,126) & + mat(k,1283) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) + mat(k,1308) = .220_r8*rxt(k,336)*y(k,124) + .220_r8*rxt(k,335)*y(k,126) & + .220_r8*rxt(k,332)*y(k,197) + .230_r8*rxt(k,333)*y(k,198) - mat(k,1484) = mat(k,1484) + .700_r8*rxt(k,376)*y(k,99) + .500_r8*rxt(k,377) & + mat(k,1671) = mat(k,1671) + .700_r8*rxt(k,376)*y(k,99) + .500_r8*rxt(k,377) & *y(k,100) + .500_r8*rxt(k,351)*y(k,109) + .500_r8*rxt(k,320) & *y(k,146) - mat(k,1012) = .200_r8*rxt(k,321)*y(k,198) - mat(k,1051) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + mat(k,1130) = .200_r8*rxt(k,321)*y(k,198) + mat(k,1172) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + .250_r8*rxt(k,390)*y(k,197) + .100_r8*rxt(k,391)*y(k,198) + mat(k,320) = -(rxt(k,363)*y(k,217)) + mat(k,1586) = -rxt(k,363)*y(k,96) + mat(k,1777) = .870_r8*rxt(k,374)*y(k,206) + mat(k,1708) = .950_r8*rxt(k,375)*y(k,206) + mat(k,1367) = rxt(k,370)*y(k,206) + mat(k,2026) = .750_r8*rxt(k,371)*y(k,206) + mat(k,1273) = .870_r8*rxt(k,374)*y(k,124) + .950_r8*rxt(k,375)*y(k,126) & + + rxt(k,370)*y(k,197) + .750_r8*rxt(k,371)*y(k,198) + mat(k,135) = -(rxt(k,364)*y(k,217)) + mat(k,1558) = -rxt(k,364)*y(k,97) + mat(k,689) = .600_r8*rxt(k,387)*y(k,217) + mat(k,1558) = mat(k,1558) + .600_r8*rxt(k,387)*y(k,103) + mat(k,841) = -(rxt(k,378)*y(k,126) + rxt(k,385)*y(k,134) + rxt(k,386) & + *y(k,217)) + mat(k,1712) = -rxt(k,378)*y(k,98) + mat(k,2092) = -rxt(k,385)*y(k,98) + mat(k,1649) = -rxt(k,386)*y(k,98) + mat(k,581) = -(rxt(k,376)*y(k,217)) + mat(k,1621) = -rxt(k,376)*y(k,99) + mat(k,1791) = .080_r8*rxt(k,368)*y(k,205) + mat(k,1245) = .080_r8*rxt(k,368)*y(k,124) + mat(k,556) = -(rxt(k,377)*y(k,217)) + mat(k,1618) = -rxt(k,377)*y(k,100) + mat(k,1789) = .080_r8*rxt(k,374)*y(k,206) + mat(k,1274) = .080_r8*rxt(k,374)*y(k,124) + mat(k,1193) = -(rxt(k,379)*y(k,197) + rxt(k,380)*y(k,198) + rxt(k,381) & + *y(k,203) + rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126)) + mat(k,1378) = -rxt(k,379)*y(k,101) + mat(k,2050) = -rxt(k,380)*y(k,101) + mat(k,1931) = -rxt(k,381)*y(k,101) + mat(k,1825) = -rxt(k,382)*y(k,101) + mat(k,1732) = -rxt(k,383)*y(k,101) + mat(k,845) = rxt(k,378)*y(k,126) + mat(k,1732) = mat(k,1732) + rxt(k,378)*y(k,98) + mat(k,397) = -(rxt(k,384)*y(k,217)) + mat(k,1596) = -rxt(k,384)*y(k,102) + mat(k,1185) = rxt(k,381)*y(k,203) + mat(k,1876) = rxt(k,381)*y(k,101) + mat(k,690) = -(rxt(k,387)*y(k,217)) + mat(k,1634) = -rxt(k,387)*y(k,103) + mat(k,1900) = rxt(k,367)*y(k,205) + rxt(k,372)*y(k,206) + mat(k,1246) = rxt(k,367)*y(k,203) + mat(k,1276) = rxt(k,372)*y(k,203) + mat(k,74) = -(rxt(k,509)*y(k,217)) + mat(k,1550) = -rxt(k,509)*y(k,104) + mat(k,1209) = -(rxt(k,338)*y(k,134) + rxt(k,339)*y(k,217)) + mat(k,2110) = -rxt(k,338)*y(k,105) + mat(k,1675) = -rxt(k,339)*y(k,105) + mat(k,846) = .300_r8*rxt(k,385)*y(k,134) + mat(k,1826) = .360_r8*rxt(k,368)*y(k,205) + mat(k,1733) = .400_r8*rxt(k,369)*y(k,205) + mat(k,2110) = mat(k,2110) + .300_r8*rxt(k,385)*y(k,98) + mat(k,1379) = .390_r8*rxt(k,365)*y(k,205) + mat(k,2051) = .310_r8*rxt(k,366)*y(k,205) + mat(k,1254) = .360_r8*rxt(k,368)*y(k,124) + .400_r8*rxt(k,369)*y(k,126) & + + .390_r8*rxt(k,365)*y(k,197) + .310_r8*rxt(k,366)*y(k,198) end do - end subroutine nlnmat03 - subroutine nlnmat04( avec_len, mat, y, rxt ) + end subroutine nlnmat04 + subroutine nlnmat05( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -731,118 +969,66 @@ subroutine nlnmat04( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,273) = -(rxt(k,363)*y(k,217)) - mat(k,1411) = -rxt(k,363)*y(k,96) - mat(k,1578) = .870_r8*rxt(k,374)*y(k,206) - mat(k,1943) = .950_r8*rxt(k,375)*y(k,206) - mat(k,1246) = rxt(k,370)*y(k,206) - mat(k,1652) = .750_r8*rxt(k,371)*y(k,206) - mat(k,1125) = .870_r8*rxt(k,374)*y(k,124) + .950_r8*rxt(k,375)*y(k,126) & - + rxt(k,370)*y(k,197) + .750_r8*rxt(k,371)*y(k,198) - mat(k,103) = -(rxt(k,364)*y(k,217)) - mat(k,1383) = -rxt(k,364)*y(k,97) - mat(k,579) = .600_r8*rxt(k,387)*y(k,217) - mat(k,1383) = mat(k,1383) + .600_r8*rxt(k,387)*y(k,103) - mat(k,735) = -(rxt(k,378)*y(k,126) + rxt(k,385)*y(k,134) + rxt(k,386) & + mat(k,310) = -(rxt(k,340)*y(k,217)) + mat(k,1584) = -rxt(k,340)*y(k,106) + mat(k,1869) = rxt(k,334)*y(k,209) + mat(k,1304) = rxt(k,334)*y(k,203) + mat(k,506) = -(rxt(k,349)*y(k,217)) + mat(k,1612) = -rxt(k,349)*y(k,107) + mat(k,1787) = .800_r8*rxt(k,358)*y(k,189) + mat(k,894) = .800_r8*rxt(k,358)*y(k,124) + mat(k,315) = -(rxt(k,350)*y(k,217)) + mat(k,1585) = -rxt(k,350)*y(k,108) + mat(k,1870) = .800_r8*rxt(k,347)*y(k,213) + mat(k,676) = .800_r8*rxt(k,347)*y(k,203) + mat(k,572) = -(rxt(k,351)*y(k,217)) + mat(k,1620) = -rxt(k,351)*y(k,109) + mat(k,2170) = rxt(k,354)*y(k,211) + mat(k,1347) = rxt(k,354)*y(k,125) + mat(k,948) = -(rxt(k,442)*y(k,126) + rxt(k,443)*y(k,134) + rxt(k,444) & *y(k,217)) - mat(k,1946) = -rxt(k,378)*y(k,98) - mat(k,2010) = -rxt(k,385)*y(k,98) - mat(k,1467) = -rxt(k,386)*y(k,98) - mat(k,513) = -(rxt(k,376)*y(k,217)) - mat(k,1445) = -rxt(k,376)*y(k,99) - mat(k,1592) = .080_r8*rxt(k,368)*y(k,205) - mat(k,1200) = .080_r8*rxt(k,368)*y(k,124) - mat(k,457) = -(rxt(k,377)*y(k,217)) - mat(k,1437) = -rxt(k,377)*y(k,100) - mat(k,1589) = .080_r8*rxt(k,374)*y(k,206) - mat(k,1126) = .080_r8*rxt(k,374)*y(k,124) - mat(k,1072) = -(rxt(k,379)*y(k,197) + rxt(k,380)*y(k,198) + rxt(k,381) & - *y(k,203) + rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126)) - mat(k,1256) = -rxt(k,379)*y(k,101) - mat(k,1675) = -rxt(k,380)*y(k,101) - mat(k,1825) = -rxt(k,381)*y(k,101) - mat(k,1624) = -rxt(k,382)*y(k,101) - mat(k,1968) = -rxt(k,383)*y(k,101) - mat(k,738) = rxt(k,378)*y(k,126) - mat(k,1968) = mat(k,1968) + rxt(k,378)*y(k,98) - mat(k,328) = -(rxt(k,384)*y(k,217)) - mat(k,1419) = -rxt(k,384)*y(k,102) - mat(k,1064) = rxt(k,381)*y(k,203) - mat(k,1771) = rxt(k,381)*y(k,101) - mat(k,580) = -(rxt(k,387)*y(k,217)) - mat(k,1452) = -rxt(k,387)*y(k,103) - mat(k,1794) = rxt(k,367)*y(k,205) + rxt(k,372)*y(k,206) - mat(k,1201) = rxt(k,367)*y(k,203) - mat(k,1128) = rxt(k,372)*y(k,203) - mat(k,65) = -(rxt(k,509)*y(k,217)) - mat(k,1376) = -rxt(k,509)*y(k,104) - mat(k,1088) = -(rxt(k,338)*y(k,134) + rxt(k,339)*y(k,217)) - mat(k,2029) = -rxt(k,338)*y(k,105) - mat(k,1493) = -rxt(k,339)*y(k,105) - mat(k,739) = .300_r8*rxt(k,385)*y(k,134) - mat(k,1625) = .360_r8*rxt(k,368)*y(k,205) - mat(k,1969) = .400_r8*rxt(k,369)*y(k,205) - mat(k,2029) = mat(k,2029) + .300_r8*rxt(k,385)*y(k,98) - mat(k,1257) = .390_r8*rxt(k,365)*y(k,205) - mat(k,1676) = .310_r8*rxt(k,366)*y(k,205) - mat(k,1210) = .360_r8*rxt(k,368)*y(k,124) + .400_r8*rxt(k,369)*y(k,126) & - + .390_r8*rxt(k,365)*y(k,197) + .310_r8*rxt(k,366)*y(k,198) - mat(k,237) = -(rxt(k,340)*y(k,217)) - mat(k,1406) = -rxt(k,340)*y(k,106) - mat(k,1763) = rxt(k,334)*y(k,209) - mat(k,1178) = rxt(k,334)*y(k,203) - mat(k,423) = -(rxt(k,349)*y(k,217)) - mat(k,1433) = -rxt(k,349)*y(k,107) - mat(k,1587) = .800_r8*rxt(k,358)*y(k,189) - mat(k,832) = .800_r8*rxt(k,358)*y(k,124) - mat(k,242) = -(rxt(k,350)*y(k,217)) - mat(k,1407) = -rxt(k,350)*y(k,108) - mat(k,1764) = .800_r8*rxt(k,347)*y(k,213) - mat(k,571) = .800_r8*rxt(k,347)*y(k,203) - mat(k,485) = -(rxt(k,351)*y(k,217)) - mat(k,1441) = -rxt(k,351)*y(k,109) - mat(k,1528) = rxt(k,354)*y(k,211) - mat(k,1230) = rxt(k,354)*y(k,125) - mat(k,815) = -(rxt(k,442)*y(k,126) + rxt(k,443)*y(k,134) + rxt(k,444) & - *y(k,217)) - mat(k,1951) = -rxt(k,442)*y(k,110) - mat(k,2014) = -rxt(k,443)*y(k,110) - mat(k,1473) = -rxt(k,444)*y(k,110) - mat(k,1164) = -(rxt(k,352)*y(k,134) + rxt(k,353)*y(k,217)) - mat(k,2033) = -rxt(k,352)*y(k,111) - mat(k,1497) = -rxt(k,353)*y(k,111) - mat(k,741) = .200_r8*rxt(k,385)*y(k,134) - mat(k,1628) = .560_r8*rxt(k,368)*y(k,205) - mat(k,1973) = .600_r8*rxt(k,369)*y(k,205) - mat(k,2033) = mat(k,2033) + .200_r8*rxt(k,385)*y(k,98) - mat(k,1260) = .610_r8*rxt(k,365)*y(k,205) - mat(k,1679) = .440_r8*rxt(k,366)*y(k,205) - mat(k,1212) = .560_r8*rxt(k,368)*y(k,124) + .600_r8*rxt(k,369)*y(k,126) & + mat(k,1716) = -rxt(k,442)*y(k,110) + mat(k,2096) = -rxt(k,443)*y(k,110) + mat(k,1658) = -rxt(k,444)*y(k,110) + mat(k,1332) = -(rxt(k,352)*y(k,134) + rxt(k,353)*y(k,217)) + mat(k,2116) = -rxt(k,352)*y(k,111) + mat(k,1681) = -rxt(k,353)*y(k,111) + mat(k,849) = .200_r8*rxt(k,385)*y(k,134) + mat(k,1831) = .560_r8*rxt(k,368)*y(k,205) + mat(k,1739) = .600_r8*rxt(k,369)*y(k,205) + mat(k,2116) = mat(k,2116) + .200_r8*rxt(k,385)*y(k,98) + mat(k,1384) = .610_r8*rxt(k,365)*y(k,205) + mat(k,2056) = .440_r8*rxt(k,366)*y(k,205) + mat(k,1258) = .560_r8*rxt(k,368)*y(k,124) + .600_r8*rxt(k,369)*y(k,126) & + .610_r8*rxt(k,365)*y(k,197) + .440_r8*rxt(k,366)*y(k,198) - mat(k,292) = -(rxt(k,150)*y(k,124) + (rxt(k,151) + rxt(k,152) + rxt(k,153) & - ) * y(k,125) + rxt(k,162)*y(k,217)) - mat(k,1579) = -rxt(k,150)*y(k,112) - mat(k,1522) = -(rxt(k,151) + rxt(k,152) + rxt(k,153)) * y(k,112) - mat(k,1414) = -rxt(k,162)*y(k,112) - mat(k,1521) = rxt(k,169)*y(k,126) - mat(k,1942) = rxt(k,169)*y(k,125) - mat(k,298) = -(rxt(k,388)*y(k,217)) - mat(k,1415) = -rxt(k,388)*y(k,115) - mat(k,1063) = .200_r8*rxt(k,380)*y(k,198) - mat(k,1653) = .200_r8*rxt(k,380)*y(k,101) - mat(k,896) = -(rxt(k,389)*y(k,217)) - mat(k,1479) = -rxt(k,389)*y(k,116) - mat(k,1068) = rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126) + rxt(k,379)*y(k,197) & + mat(k,491) = -(rxt(k,151)*y(k,124) + (rxt(k,152) + rxt(k,153) + rxt(k,154) & + ) * y(k,125) + rxt(k,163)*y(k,217)) + mat(k,1785) = -rxt(k,151)*y(k,112) + mat(k,2166) = -(rxt(k,152) + rxt(k,153) + rxt(k,154)) * y(k,112) + mat(k,1610) = -rxt(k,163)*y(k,112) + mat(k,183) = -((rxt(k,167) + rxt(k,168)) * y(k,216)) + mat(k,1509) = -(rxt(k,167) + rxt(k,168)) * y(k,113) + mat(k,490) = rxt(k,152)*y(k,125) + mat(k,2162) = rxt(k,152)*y(k,112) + mat(k,2163) = rxt(k,170)*y(k,126) + mat(k,1706) = rxt(k,170)*y(k,125) + mat(k,373) = -(rxt(k,388)*y(k,217)) + mat(k,1593) = -rxt(k,388)*y(k,115) + mat(k,1184) = .200_r8*rxt(k,380)*y(k,198) + mat(k,2027) = .200_r8*rxt(k,380)*y(k,101) + mat(k,1073) = -(rxt(k,389)*y(k,217)) + mat(k,1665) = -rxt(k,389)*y(k,116) + mat(k,1189) = rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126) + rxt(k,379)*y(k,197) & + .800_r8*rxt(k,380)*y(k,198) - mat(k,1612) = rxt(k,382)*y(k,101) - mat(k,1956) = rxt(k,383)*y(k,101) - mat(k,1251) = rxt(k,379)*y(k,101) - mat(k,1664) = .800_r8*rxt(k,380)*y(k,101) - mat(k,84) = -(rxt(k,479)*y(k,217)) - mat(k,1380) = -rxt(k,479)*y(k,120) - mat(k,1640) = -(rxt(k,150)*y(k,112) + rxt(k,159)*y(k,126) + rxt(k,163) & - *y(k,203) + rxt(k,164)*y(k,134) + rxt(k,165)*y(k,133) + rxt(k,186) & - *y(k,59) + rxt(k,218)*y(k,19) + rxt(k,261)*y(k,198) + rxt(k,270) & + mat(k,1816) = rxt(k,382)*y(k,101) + mat(k,1723) = rxt(k,383)*y(k,101) + mat(k,1373) = rxt(k,379)*y(k,101) + mat(k,2042) = .800_r8*rxt(k,380)*y(k,101) + mat(k,96) = -(rxt(k,479)*y(k,217)) + mat(k,1554) = -rxt(k,479)*y(k,120) + mat(k,1842) = -(rxt(k,151)*y(k,112) + rxt(k,160)*y(k,126) + rxt(k,164) & + *y(k,203) + rxt(k,165)*y(k,134) + rxt(k,166)*y(k,133) + rxt(k,187) & + *y(k,59) + rxt(k,219)*y(k,19) + rxt(k,262)*y(k,198) + rxt(k,270) & *y(k,204) + rxt(k,283)*y(k,194) + rxt(k,294)*y(k,197) + rxt(k,298) & *y(k,202) + rxt(k,311)*y(k,195) + rxt(k,319)*y(k,219) + rxt(k,323) & *y(k,220) + (rxt(k,329) + rxt(k,330)) * y(k,200) + (rxt(k,336) & @@ -854,88 +1040,90 @@ subroutine nlnmat04( avec_len, mat, y, rxt ) *y(k,210) + rxt(k,417)*y(k,212) + rxt(k,420)*y(k,218) + rxt(k,427) & *y(k,223) + rxt(k,433)*y(k,226) + rxt(k,436)*y(k,228) + rxt(k,447) & *y(k,215) + rxt(k,452)*y(k,221) + rxt(k,457)*y(k,222)) - mat(k,296) = -rxt(k,150)*y(k,124) - mat(k,1985) = -rxt(k,159)*y(k,124) - mat(k,1841) = -rxt(k,163)*y(k,124) - mat(k,2045) = -rxt(k,164)*y(k,124) - mat(k,1871) = -rxt(k,165)*y(k,124) - mat(k,1331) = -rxt(k,186)*y(k,124) - mat(k,1714) = -rxt(k,218)*y(k,124) - mat(k,1690) = -rxt(k,261)*y(k,124) - mat(k,369) = -rxt(k,270)*y(k,124) - mat(k,719) = -rxt(k,283)*y(k,124) - mat(k,1269) = -rxt(k,294)*y(k,124) - mat(k,608) = -rxt(k,298)*y(k,124) - mat(k,691) = -rxt(k,311)*y(k,124) - mat(k,663) = -rxt(k,319)*y(k,124) - mat(k,1018) = -rxt(k,323)*y(k,124) - mat(k,482) = -(rxt(k,329) + rxt(k,330)) * y(k,124) - mat(k,1194) = -(rxt(k,336) + rxt(k,337)) * y(k,124) - mat(k,1239) = -rxt(k,345)*y(k,124) - mat(k,577) = -rxt(k,348)*y(k,124) - mat(k,843) = -(rxt(k,358) + rxt(k,359)) * y(k,124) - mat(k,1221) = -rxt(k,368)*y(k,124) - mat(k,1151) = -rxt(k,374)*y(k,124) - mat(k,1081) = -rxt(k,382)*y(k,124) - mat(k,1058) = -rxt(k,393)*y(k,124) - mat(k,433) = -rxt(k,397)*y(k,124) - mat(k,407) = -rxt(k,400)*y(k,124) - mat(k,364) = -rxt(k,405)*y(k,124) - mat(k,533) = -rxt(k,407)*y(k,124) - mat(k,654) = -rxt(k,411)*y(k,124) - mat(k,615) = -rxt(k,414)*y(k,124) - mat(k,775) = -rxt(k,417)*y(k,124) - mat(k,377) = -rxt(k,420)*y(k,124) - mat(k,630) = -rxt(k,427)*y(k,124) - mat(k,647) = -rxt(k,433)*y(k,124) - mat(k,415) = -rxt(k,436)*y(k,124) - mat(k,1004) = -rxt(k,447)*y(k,124) - mat(k,985) = -rxt(k,452)*y(k,124) - mat(k,965) = -rxt(k,457)*y(k,124) - mat(k,296) = mat(k,296) + 2.000_r8*rxt(k,152)*y(k,125) + rxt(k,162)*y(k,217) - mat(k,1550) = 2.000_r8*rxt(k,152)*y(k,112) + rxt(k,155)*y(k,133) + rxt(k,471) & + mat(k,495) = -rxt(k,151)*y(k,124) + mat(k,1750) = -rxt(k,160)*y(k,124) + mat(k,1949) = -rxt(k,164)*y(k,124) + mat(k,2127) = -rxt(k,165)*y(k,124) + mat(k,2249) = -rxt(k,166)*y(k,124) + mat(k,1975) = -rxt(k,187)*y(k,124) + mat(k,2218) = -rxt(k,219)*y(k,124) + mat(k,2066) = -rxt(k,262)*y(k,124) + mat(k,444) = -rxt(k,270)*y(k,124) + mat(k,819) = -rxt(k,283)*y(k,124) + mat(k,1392) = -rxt(k,294)*y(k,124) + mat(k,718) = -rxt(k,298)*y(k,124) + mat(k,796) = -rxt(k,311)*y(k,124) + mat(k,773) = -rxt(k,319)*y(k,124) + mat(k,1135) = -rxt(k,323)*y(k,124) + mat(k,569) = -(rxt(k,329) + rxt(k,330)) * y(k,124) + mat(k,1318) = -(rxt(k,336) + rxt(k,337)) * y(k,124) + mat(k,1360) = -rxt(k,345)*y(k,124) + mat(k,681) = -rxt(k,348)*y(k,124) + mat(k,905) = -(rxt(k,358) + rxt(k,359)) * y(k,124) + mat(k,1265) = -rxt(k,368)*y(k,124) + mat(k,1297) = -rxt(k,374)*y(k,124) + mat(k,1202) = -rxt(k,382)*y(k,124) + mat(k,1179) = -rxt(k,393)*y(k,124) + mat(k,521) = -rxt(k,397)*y(k,124) + mat(k,487) = -rxt(k,400)*y(k,124) + mat(k,438) = -rxt(k,405)*y(k,124) + mat(k,627) = -rxt(k,407)*y(k,124) + mat(k,763) = -rxt(k,411)*y(k,124) + mat(k,724) = -rxt(k,414)*y(k,124) + mat(k,878) = -rxt(k,417)*y(k,124) + mat(k,457) = -rxt(k,420)*y(k,124) + mat(k,739) = -rxt(k,427)*y(k,124) + mat(k,756) = -rxt(k,433)*y(k,124) + mat(k,503) = -rxt(k,436)*y(k,124) + mat(k,1053) = -rxt(k,447)*y(k,124) + mat(k,1121) = -rxt(k,452)*y(k,124) + mat(k,918) = -rxt(k,457)*y(k,124) + mat(k,495) = mat(k,495) + 2.000_r8*rxt(k,153)*y(k,125) + rxt(k,163)*y(k,217) + mat(k,185) = 2.000_r8*rxt(k,167)*y(k,216) + mat(k,2194) = 2.000_r8*rxt(k,153)*y(k,112) + rxt(k,156)*y(k,133) + rxt(k,472) & *y(k,150) - mat(k,1871) = mat(k,1871) + rxt(k,155)*y(k,125) - mat(k,1117) = rxt(k,471)*y(k,125) - mat(k,1509) = rxt(k,162)*y(k,112) - mat(k,1549) = -((rxt(k,151) + rxt(k,152) + rxt(k,153)) * y(k,112) + (rxt(k,155) & - + rxt(k,157)) * y(k,133) + rxt(k,156)*y(k,134) + rxt(k,168) & - *y(k,203) + rxt(k,169)*y(k,126) + rxt(k,170)*y(k,217) + rxt(k,188) & - *y(k,59) + rxt(k,219)*y(k,19) + rxt(k,305)*y(k,197) + rxt(k,354) & + mat(k,2249) = mat(k,2249) + rxt(k,156)*y(k,125) + mat(k,1236) = rxt(k,472)*y(k,125) + mat(k,1529) = 2.000_r8*rxt(k,167)*y(k,113) + mat(k,1693) = rxt(k,163)*y(k,112) + mat(k,2201) = -((rxt(k,152) + rxt(k,153) + rxt(k,154)) * y(k,112) + (rxt(k,156) & + + rxt(k,158)) * y(k,133) + rxt(k,157)*y(k,134) + rxt(k,169) & + *y(k,203) + rxt(k,170)*y(k,126) + rxt(k,171)*y(k,217) + rxt(k,189) & + *y(k,59) + rxt(k,220)*y(k,19) + rxt(k,305)*y(k,197) + rxt(k,354) & *y(k,211) + rxt(k,412)*y(k,199) + rxt(k,415)*y(k,210) + rxt(k,418) & - *y(k,212) + rxt(k,422)*y(k,141) + rxt(k,425)*y(k,188) + rxt(k,471) & + *y(k,212) + rxt(k,422)*y(k,141) + rxt(k,425)*y(k,188) + rxt(k,472) & *y(k,150)) - mat(k,295) = -(rxt(k,151) + rxt(k,152) + rxt(k,153)) * y(k,125) - mat(k,1870) = -(rxt(k,155) + rxt(k,157)) * y(k,125) - mat(k,2044) = -rxt(k,156)*y(k,125) - mat(k,1840) = -rxt(k,168)*y(k,125) - mat(k,1984) = -rxt(k,169)*y(k,125) - mat(k,1508) = -rxt(k,170)*y(k,125) - mat(k,1330) = -rxt(k,188)*y(k,125) - mat(k,1713) = -rxt(k,219)*y(k,125) - mat(k,1268) = -rxt(k,305)*y(k,125) - mat(k,1238) = -rxt(k,354)*y(k,125) - mat(k,653) = -rxt(k,412)*y(k,125) - mat(k,614) = -rxt(k,415)*y(k,125) - mat(k,774) = -rxt(k,418)*y(k,125) - mat(k,391) = -rxt(k,422)*y(k,125) - mat(k,432) = -rxt(k,425)*y(k,125) - mat(k,1116) = -rxt(k,471)*y(k,125) - mat(k,568) = rxt(k,356)*y(k,217) - mat(k,289) = rxt(k,327)*y(k,126) - mat(k,1713) = mat(k,1713) + rxt(k,218)*y(k,124) - mat(k,1330) = mat(k,1330) + rxt(k,186)*y(k,124) - mat(k,336) = rxt(k,149)*y(k,217) - mat(k,519) = .700_r8*rxt(k,376)*y(k,217) - mat(k,1080) = rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126) - mat(k,1639) = rxt(k,218)*y(k,19) + rxt(k,186)*y(k,59) + rxt(k,382)*y(k,101) & - + 2.000_r8*rxt(k,159)*y(k,126) + rxt(k,165)*y(k,133) & - + rxt(k,164)*y(k,134) + rxt(k,397)*y(k,188) + rxt(k,358) & + mat(k,496) = -(rxt(k,152) + rxt(k,153) + rxt(k,154)) * y(k,125) + mat(k,2256) = -(rxt(k,156) + rxt(k,158)) * y(k,125) + mat(k,2134) = -rxt(k,157)*y(k,125) + mat(k,1956) = -rxt(k,169)*y(k,125) + mat(k,1757) = -rxt(k,170)*y(k,125) + mat(k,1700) = -rxt(k,171)*y(k,125) + mat(k,1982) = -rxt(k,189)*y(k,125) + mat(k,2225) = -rxt(k,220)*y(k,125) + mat(k,1396) = -rxt(k,305)*y(k,125) + mat(k,1364) = -rxt(k,354)*y(k,125) + mat(k,766) = -rxt(k,412)*y(k,125) + mat(k,726) = -rxt(k,415)*y(k,125) + mat(k,881) = -rxt(k,418)*y(k,125) + mat(k,466) = -rxt(k,422)*y(k,125) + mat(k,523) = -rxt(k,425)*y(k,125) + mat(k,1241) = -rxt(k,472)*y(k,125) + mat(k,675) = rxt(k,356)*y(k,217) + mat(k,356) = rxt(k,327)*y(k,126) + mat(k,2225) = mat(k,2225) + rxt(k,219)*y(k,124) + mat(k,1982) = mat(k,1982) + rxt(k,187)*y(k,124) + mat(k,407) = rxt(k,150)*y(k,217) + mat(k,589) = .700_r8*rxt(k,376)*y(k,217) + mat(k,1205) = rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126) + mat(k,1849) = rxt(k,219)*y(k,19) + rxt(k,187)*y(k,59) + rxt(k,382)*y(k,101) & + + 2.000_r8*rxt(k,160)*y(k,126) + rxt(k,166)*y(k,133) & + + rxt(k,165)*y(k,134) + rxt(k,397)*y(k,188) + rxt(k,358) & *y(k,189) + rxt(k,400)*y(k,191) + rxt(k,405)*y(k,193) & + rxt(k,283)*y(k,194) + rxt(k,311)*y(k,195) + rxt(k,407) & - *y(k,196) + rxt(k,294)*y(k,197) + rxt(k,261)*y(k,198) & + *y(k,196) + rxt(k,294)*y(k,197) + rxt(k,262)*y(k,198) & + rxt(k,411)*y(k,199) + rxt(k,329)*y(k,200) + rxt(k,298) & - *y(k,202) + rxt(k,163)*y(k,203) + rxt(k,270)*y(k,204) & + *y(k,202) + rxt(k,164)*y(k,203) + rxt(k,270)*y(k,204) & + .920_r8*rxt(k,368)*y(k,205) + .920_r8*rxt(k,374)*y(k,206) & + rxt(k,336)*y(k,209) + rxt(k,414)*y(k,210) + rxt(k,345) & *y(k,211) + rxt(k,417)*y(k,212) + rxt(k,348)*y(k,213) & @@ -944,54 +1132,54 @@ subroutine nlnmat04( avec_len, mat, y, rxt ) *y(k,221) + .800_r8*rxt(k,457)*y(k,222) + rxt(k,427)*y(k,223) & + rxt(k,393)*y(k,225) + rxt(k,433)*y(k,226) + rxt(k,436) & *y(k,228) - mat(k,1984) = mat(k,1984) + rxt(k,327)*y(k,16) + rxt(k,383)*y(k,101) & - + 2.000_r8*rxt(k,159)*y(k,124) + rxt(k,160)*y(k,133) & - + rxt(k,158)*y(k,203) + rxt(k,369)*y(k,205) + rxt(k,375) & + mat(k,1757) = mat(k,1757) + rxt(k,327)*y(k,16) + rxt(k,383)*y(k,101) & + + 2.000_r8*rxt(k,160)*y(k,124) + rxt(k,161)*y(k,133) & + + rxt(k,159)*y(k,203) + rxt(k,369)*y(k,205) + rxt(k,375) & *y(k,206) + rxt(k,335)*y(k,209) + rxt(k,346)*y(k,211) & - + 2.000_r8*rxt(k,448)*y(k,215) + rxt(k,161)*y(k,217) & + + 2.000_r8*rxt(k,448)*y(k,215) + rxt(k,162)*y(k,217) & + rxt(k,394)*y(k,225) - mat(k,755) = rxt(k,317)*y(k,217) - mat(k,1870) = mat(k,1870) + rxt(k,165)*y(k,124) + rxt(k,160)*y(k,126) - mat(k,2044) = mat(k,2044) + rxt(k,164)*y(k,124) - mat(k,526) = rxt(k,454)*y(k,217) - mat(k,432) = mat(k,432) + rxt(k,397)*y(k,124) - mat(k,842) = rxt(k,358)*y(k,124) - mat(k,406) = rxt(k,400)*y(k,124) - mat(k,363) = rxt(k,405)*y(k,124) - mat(k,718) = rxt(k,283)*y(k,124) - mat(k,690) = rxt(k,311)*y(k,124) - mat(k,532) = rxt(k,407)*y(k,124) - mat(k,1268) = mat(k,1268) + rxt(k,294)*y(k,124) - mat(k,1689) = rxt(k,261)*y(k,124) + .500_r8*rxt(k,445)*y(k,215) - mat(k,653) = mat(k,653) + rxt(k,411)*y(k,124) - mat(k,481) = rxt(k,329)*y(k,124) - mat(k,607) = rxt(k,298)*y(k,124) - mat(k,1840) = mat(k,1840) + rxt(k,163)*y(k,124) + rxt(k,158)*y(k,126) - mat(k,368) = rxt(k,270)*y(k,124) - mat(k,1220) = .920_r8*rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126) - mat(k,1150) = .920_r8*rxt(k,374)*y(k,124) + rxt(k,375)*y(k,126) - mat(k,1193) = rxt(k,336)*y(k,124) + rxt(k,335)*y(k,126) - mat(k,614) = mat(k,614) + rxt(k,414)*y(k,124) - mat(k,1238) = mat(k,1238) + rxt(k,345)*y(k,124) + rxt(k,346)*y(k,126) - mat(k,774) = mat(k,774) + rxt(k,417)*y(k,124) - mat(k,576) = rxt(k,348)*y(k,124) - mat(k,1003) = 1.600_r8*rxt(k,447)*y(k,124) + 2.000_r8*rxt(k,448)*y(k,126) & + mat(k,862) = rxt(k,317)*y(k,217) + mat(k,2256) = mat(k,2256) + rxt(k,166)*y(k,124) + rxt(k,161)*y(k,126) + mat(k,2134) = mat(k,2134) + rxt(k,165)*y(k,124) + mat(k,622) = rxt(k,454)*y(k,217) + mat(k,523) = mat(k,523) + rxt(k,397)*y(k,124) + mat(k,908) = rxt(k,358)*y(k,124) + mat(k,489) = rxt(k,400)*y(k,124) + mat(k,440) = rxt(k,405)*y(k,124) + mat(k,822) = rxt(k,283)*y(k,124) + mat(k,799) = rxt(k,311)*y(k,124) + mat(k,630) = rxt(k,407)*y(k,124) + mat(k,1396) = mat(k,1396) + rxt(k,294)*y(k,124) + mat(k,2073) = rxt(k,262)*y(k,124) + .500_r8*rxt(k,445)*y(k,215) + mat(k,766) = mat(k,766) + rxt(k,411)*y(k,124) + mat(k,571) = rxt(k,329)*y(k,124) + mat(k,720) = rxt(k,298)*y(k,124) + mat(k,1956) = mat(k,1956) + rxt(k,164)*y(k,124) + rxt(k,159)*y(k,126) + mat(k,446) = rxt(k,270)*y(k,124) + mat(k,1269) = .920_r8*rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126) + mat(k,1301) = .920_r8*rxt(k,374)*y(k,124) + rxt(k,375)*y(k,126) + mat(k,1321) = rxt(k,336)*y(k,124) + rxt(k,335)*y(k,126) + mat(k,726) = mat(k,726) + rxt(k,414)*y(k,124) + mat(k,1364) = mat(k,1364) + rxt(k,345)*y(k,124) + rxt(k,346)*y(k,126) + mat(k,881) = mat(k,881) + rxt(k,417)*y(k,124) + mat(k,683) = rxt(k,348)*y(k,124) + mat(k,1056) = 1.600_r8*rxt(k,447)*y(k,124) + 2.000_r8*rxt(k,448)*y(k,126) & + .500_r8*rxt(k,445)*y(k,198) - mat(k,1508) = mat(k,1508) + rxt(k,356)*y(k,1) + rxt(k,149)*y(k,90) & - + .700_r8*rxt(k,376)*y(k,99) + rxt(k,161)*y(k,126) + rxt(k,317) & + mat(k,1700) = mat(k,1700) + rxt(k,356)*y(k,1) + rxt(k,150)*y(k,90) & + + .700_r8*rxt(k,376)*y(k,99) + rxt(k,162)*y(k,126) + rxt(k,317) & *y(k,127) + rxt(k,454)*y(k,175) - mat(k,376) = rxt(k,420)*y(k,124) - mat(k,662) = rxt(k,319)*y(k,124) - mat(k,1017) = rxt(k,323)*y(k,124) - mat(k,984) = .900_r8*rxt(k,452)*y(k,124) - mat(k,964) = .800_r8*rxt(k,457)*y(k,124) - mat(k,629) = rxt(k,427)*y(k,124) - mat(k,1057) = rxt(k,393)*y(k,124) + rxt(k,394)*y(k,126) - mat(k,646) = rxt(k,433)*y(k,124) - mat(k,414) = rxt(k,436)*y(k,124) + mat(k,459) = rxt(k,420)*y(k,124) + mat(k,775) = rxt(k,319)*y(k,124) + mat(k,1138) = rxt(k,323)*y(k,124) + mat(k,1124) = .900_r8*rxt(k,452)*y(k,124) + mat(k,921) = .800_r8*rxt(k,457)*y(k,124) + mat(k,741) = rxt(k,427)*y(k,124) + mat(k,1182) = rxt(k,393)*y(k,124) + rxt(k,394)*y(k,126) + mat(k,758) = rxt(k,433)*y(k,124) + mat(k,505) = rxt(k,436)*y(k,124) end do - end subroutine nlnmat04 - subroutine nlnmat05( avec_len, mat, y, rxt ) + end subroutine nlnmat05 + subroutine nlnmat06( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -1009,228 +1197,228 @@ subroutine nlnmat05( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,1993) = -(rxt(k,158)*y(k,203) + rxt(k,159)*y(k,124) + rxt(k,160) & - *y(k,133) + rxt(k,161)*y(k,217) + rxt(k,169)*y(k,125) + rxt(k,255) & + mat(k,1749) = -(rxt(k,159)*y(k,203) + rxt(k,160)*y(k,124) + rxt(k,161) & + *y(k,133) + rxt(k,162)*y(k,217) + rxt(k,170)*y(k,125) + rxt(k,256) & *y(k,42) + rxt(k,288)*y(k,45) + rxt(k,307)*y(k,29) + rxt(k,314) & *y(k,49) + rxt(k,327)*y(k,16) + rxt(k,335)*y(k,209) + rxt(k,346) & *y(k,211) + rxt(k,369)*y(k,205) + rxt(k,375)*y(k,206) + rxt(k,378) & *y(k,98) + rxt(k,383)*y(k,101) + rxt(k,394)*y(k,225) + rxt(k,439) & *y(k,6) + rxt(k,442)*y(k,110) + rxt(k,448)*y(k,215) + rxt(k,459) & *y(k,177) + rxt(k,462)*y(k,67)) - mat(k,1849) = -rxt(k,158)*y(k,126) - mat(k,1648) = -rxt(k,159)*y(k,126) - mat(k,1879) = -rxt(k,160)*y(k,126) - mat(k,1517) = -rxt(k,161)*y(k,126) - mat(k,1558) = -rxt(k,169)*y(k,126) - mat(k,1744) = -rxt(k,255)*y(k,126) - mat(k,1031) = -rxt(k,288)*y(k,126) - mat(k,881) = -rxt(k,307)*y(k,126) - mat(k,1106) = -rxt(k,314)*y(k,126) - mat(k,291) = -rxt(k,327)*y(k,126) - mat(k,1198) = -rxt(k,335)*y(k,126) - mat(k,1243) = -rxt(k,346)*y(k,126) - mat(k,1225) = -rxt(k,369)*y(k,126) - mat(k,1155) = -rxt(k,375)*y(k,126) - mat(k,748) = -rxt(k,378)*y(k,126) - mat(k,1085) = -rxt(k,383)*y(k,126) - mat(k,1062) = -rxt(k,394)*y(k,126) - mat(k,802) = -rxt(k,439)*y(k,126) - mat(k,829) = -rxt(k,442)*y(k,126) - mat(k,1008) = -rxt(k,448)*y(k,126) - mat(k,891) = -rxt(k,459)*y(k,126) - mat(k,215) = -rxt(k,462)*y(k,126) - mat(k,456) = rxt(k,220)*y(k,133) - mat(k,1936) = rxt(k,187)*y(k,60) - mat(k,863) = rxt(k,187)*y(k,56) + rxt(k,189)*y(k,133) + rxt(k,190)*y(k,217) - mat(k,683) = rxt(k,234)*y(k,89) - mat(k,1300) = rxt(k,234)*y(k,73) + rxt(k,171)*y(k,217) - mat(k,492) = .500_r8*rxt(k,351)*y(k,217) - mat(k,1558) = mat(k,1558) + rxt(k,157)*y(k,133) + rxt(k,156)*y(k,134) - mat(k,1879) = mat(k,1879) + rxt(k,220)*y(k,20) + rxt(k,189)*y(k,60) & - + rxt(k,157)*y(k,125) - mat(k,2053) = rxt(k,156)*y(k,125) - mat(k,388) = rxt(k,303)*y(k,217) - mat(k,1517) = mat(k,1517) + rxt(k,190)*y(k,60) + rxt(k,171)*y(k,89) & + mat(k,1948) = -rxt(k,159)*y(k,126) + mat(k,1841) = -rxt(k,160)*y(k,126) + mat(k,2248) = -rxt(k,161)*y(k,126) + mat(k,1692) = -rxt(k,162)*y(k,126) + mat(k,2193) = -rxt(k,170)*y(k,126) + mat(k,1488) = -rxt(k,256)*y(k,126) + mat(k,1090) = -rxt(k,288)*y(k,126) + mat(k,1033) = -rxt(k,307)*y(k,126) + mat(k,1225) = -rxt(k,314)*y(k,126) + mat(k,355) = -rxt(k,327)*y(k,126) + mat(k,1317) = -rxt(k,335)*y(k,126) + mat(k,1359) = -rxt(k,346)*y(k,126) + mat(k,1264) = -rxt(k,369)*y(k,126) + mat(k,1296) = -rxt(k,375)*y(k,126) + mat(k,853) = -rxt(k,378)*y(k,126) + mat(k,1201) = -rxt(k,383)*y(k,126) + mat(k,1178) = -rxt(k,394)*y(k,126) + mat(k,1011) = -rxt(k,439)*y(k,126) + mat(k,961) = -rxt(k,442)*y(k,126) + mat(k,1052) = -rxt(k,448)*y(k,126) + mat(k,975) = -rxt(k,459)*y(k,126) + mat(k,301) = -rxt(k,462)*y(k,126) + mat(k,544) = rxt(k,221)*y(k,133) + mat(k,2013) = rxt(k,188)*y(k,60) + mat(k,887) = rxt(k,188)*y(k,56) + rxt(k,190)*y(k,133) + rxt(k,191)*y(k,217) + mat(k,870) = rxt(k,235)*y(k,89) + mat(k,1452) = rxt(k,235)*y(k,73) + rxt(k,172)*y(k,217) + mat(k,578) = .500_r8*rxt(k,351)*y(k,217) + mat(k,2193) = mat(k,2193) + rxt(k,158)*y(k,133) + rxt(k,157)*y(k,134) + mat(k,2248) = mat(k,2248) + rxt(k,221)*y(k,20) + rxt(k,190)*y(k,60) & + + rxt(k,158)*y(k,125) + mat(k,2126) = rxt(k,157)*y(k,125) + mat(k,529) = rxt(k,303)*y(k,217) + mat(k,1692) = mat(k,1692) + rxt(k,191)*y(k,60) + rxt(k,172)*y(k,89) & + .500_r8*rxt(k,351)*y(k,109) + rxt(k,303)*y(k,139) - mat(k,751) = -(rxt(k,317)*y(k,217)) - mat(k,1468) = -rxt(k,317)*y(k,127) - mat(k,868) = rxt(k,307)*y(k,126) - mat(k,458) = .500_r8*rxt(k,377)*y(k,217) - mat(k,330) = rxt(k,384)*y(k,217) - mat(k,299) = rxt(k,388)*y(k,217) - mat(k,893) = rxt(k,389)*y(k,217) - mat(k,1947) = rxt(k,307)*y(k,29) - mat(k,1468) = mat(k,1468) + .500_r8*rxt(k,377)*y(k,100) + rxt(k,384)*y(k,102) & + mat(k,857) = -(rxt(k,317)*y(k,217)) + mat(k,1650) = -rxt(k,317)*y(k,127) + mat(k,1022) = rxt(k,307)*y(k,126) + mat(k,557) = .500_r8*rxt(k,377)*y(k,217) + mat(k,399) = rxt(k,384)*y(k,217) + mat(k,374) = rxt(k,388)*y(k,217) + mat(k,1070) = rxt(k,389)*y(k,217) + mat(k,1713) = rxt(k,307)*y(k,29) + mat(k,1650) = mat(k,1650) + .500_r8*rxt(k,377)*y(k,100) + rxt(k,384)*y(k,102) & + rxt(k,388)*y(k,115) + rxt(k,389)*y(k,116) - mat(k,316) = -(rxt(k,449)*y(k,217)) - mat(k,1417) = -rxt(k,449)*y(k,128) - mat(k,1769) = rxt(k,446)*y(k,215) - mat(k,990) = rxt(k,446)*y(k,203) - mat(k,1876) = -(rxt(k,129)*y(k,134) + 4._r8*rxt(k,130)*y(k,133) + rxt(k,132) & - *y(k,77) + rxt(k,133)*y(k,79) + rxt(k,138)*y(k,203) + rxt(k,144) & - *y(k,217) + (rxt(k,155) + rxt(k,157)) * y(k,125) + rxt(k,160) & - *y(k,126) + rxt(k,165)*y(k,124) + rxt(k,189)*y(k,60) + rxt(k,191) & - *y(k,59) + rxt(k,194)*y(k,85) + rxt(k,197)*y(k,92) + rxt(k,220) & - *y(k,20) + rxt(k,221)*y(k,19) + rxt(k,223)*y(k,81) + rxt(k,225) & - *y(k,91) + rxt(k,256)*y(k,42) + rxt(k,464)*y(k,137)) - mat(k,2050) = -rxt(k,129)*y(k,133) - mat(k,1041) = -rxt(k,132)*y(k,133) - mat(k,500) = -rxt(k,133)*y(k,133) - mat(k,1846) = -rxt(k,138)*y(k,133) - mat(k,1514) = -rxt(k,144)*y(k,133) - mat(k,1555) = -(rxt(k,155) + rxt(k,157)) * y(k,133) - mat(k,1990) = -rxt(k,160)*y(k,133) - mat(k,1645) = -rxt(k,165)*y(k,133) - mat(k,860) = -rxt(k,189)*y(k,133) - mat(k,1336) = -rxt(k,191)*y(k,133) - mat(k,1899) = -rxt(k,194)*y(k,133) - mat(k,727) = -rxt(k,197)*y(k,133) - mat(k,455) = -rxt(k,220)*y(k,133) - mat(k,1719) = -rxt(k,221)*y(k,133) - mat(k,710) = -rxt(k,223)*y(k,133) - mat(k,672) = -rxt(k,225)*y(k,133) - mat(k,1741) = -rxt(k,256)*y(k,133) - mat(k,283) = -rxt(k,464)*y(k,133) - mat(k,1310) = rxt(k,136)*y(k,203) - mat(k,297) = rxt(k,150)*y(k,124) + rxt(k,151)*y(k,125) - mat(k,1645) = mat(k,1645) + rxt(k,150)*y(k,112) - mat(k,1555) = mat(k,1555) + rxt(k,151)*y(k,112) - mat(k,1846) = mat(k,1846) + rxt(k,136)*y(k,76) - mat(k,1514) = mat(k,1514) + 2.000_r8*rxt(k,146)*y(k,217) - mat(k,2054) = -(rxt(k,128)*y(k,216) + rxt(k,129)*y(k,133) + rxt(k,139) & - *y(k,203) + rxt(k,140)*y(k,76) + rxt(k,145)*y(k,217) + rxt(k,156) & - *y(k,125) + rxt(k,164)*y(k,124) + rxt(k,180)*y(k,56) + rxt(k,212) & + mat(k,391) = -(rxt(k,449)*y(k,217)) + mat(k,1595) = -rxt(k,449)*y(k,128) + mat(k,1875) = rxt(k,446)*y(k,215) + mat(k,1041) = rxt(k,446)*y(k,203) + mat(k,2258) = -(rxt(k,130)*y(k,134) + 4._r8*rxt(k,131)*y(k,133) + rxt(k,133) & + *y(k,77) + rxt(k,134)*y(k,79) + rxt(k,139)*y(k,203) + rxt(k,145) & + *y(k,217) + (rxt(k,156) + rxt(k,158)) * y(k,125) + rxt(k,161) & + *y(k,126) + rxt(k,166)*y(k,124) + rxt(k,190)*y(k,60) + rxt(k,192) & + *y(k,59) + rxt(k,195)*y(k,85) + rxt(k,198)*y(k,92) + rxt(k,221) & + *y(k,20) + rxt(k,222)*y(k,19) + rxt(k,224)*y(k,81) + rxt(k,226) & + *y(k,91) + rxt(k,257)*y(k,42) + rxt(k,464)*y(k,137)) + mat(k,2136) = -rxt(k,130)*y(k,133) + mat(k,1411) = -rxt(k,133)*y(k,133) + mat(k,608) = -rxt(k,134)*y(k,133) + mat(k,1958) = -rxt(k,139)*y(k,133) + mat(k,1702) = -rxt(k,145)*y(k,133) + mat(k,2203) = -(rxt(k,156) + rxt(k,158)) * y(k,133) + mat(k,1759) = -rxt(k,161)*y(k,133) + mat(k,1851) = -rxt(k,166)*y(k,133) + mat(k,892) = -rxt(k,190)*y(k,133) + mat(k,1984) = -rxt(k,192)*y(k,133) + mat(k,2159) = -rxt(k,195)*y(k,133) + mat(k,829) = -rxt(k,198)*y(k,133) + mat(k,547) = -rxt(k,221)*y(k,133) + mat(k,2227) = -rxt(k,222)*y(k,133) + mat(k,810) = -rxt(k,224)*y(k,133) + mat(k,784) = -rxt(k,226)*y(k,133) + mat(k,1497) = -rxt(k,257)*y(k,133) + mat(k,364) = -rxt(k,464)*y(k,133) + mat(k,1474) = rxt(k,137)*y(k,203) + mat(k,497) = rxt(k,151)*y(k,124) + rxt(k,152)*y(k,125) + mat(k,1851) = mat(k,1851) + rxt(k,151)*y(k,112) + mat(k,2203) = mat(k,2203) + rxt(k,152)*y(k,112) + mat(k,1958) = mat(k,1958) + rxt(k,137)*y(k,76) + mat(k,1702) = mat(k,1702) + 2.000_r8*rxt(k,147)*y(k,217) + mat(k,2132) = -(rxt(k,129)*y(k,216) + rxt(k,130)*y(k,133) + rxt(k,140) & + *y(k,203) + rxt(k,141)*y(k,76) + rxt(k,146)*y(k,217) + rxt(k,157) & + *y(k,125) + rxt(k,165)*y(k,124) + rxt(k,181)*y(k,56) + rxt(k,213) & *y(k,17) + rxt(k,279)*y(k,25) + rxt(k,308)*y(k,29) + rxt(k,338) & *y(k,105) + rxt(k,352)*y(k,111) + rxt(k,385)*y(k,98) + rxt(k,423) & - *y(k,141) + rxt(k,440)*y(k,6) + rxt(k,443)*y(k,110) + rxt(k,467) & - *y(k,148) + rxt(k,473)*y(k,150)) - mat(k,1364) = -rxt(k,128)*y(k,134) - mat(k,1880) = -rxt(k,129)*y(k,134) - mat(k,1850) = -rxt(k,139)*y(k,134) - mat(k,1314) = -rxt(k,140)*y(k,134) - mat(k,1518) = -rxt(k,145)*y(k,134) - mat(k,1559) = -rxt(k,156)*y(k,134) - mat(k,1649) = -rxt(k,164)*y(k,134) - mat(k,1937) = -rxt(k,180)*y(k,134) - mat(k,1286) = -rxt(k,212)*y(k,134) - mat(k,472) = -rxt(k,279)*y(k,134) - mat(k,882) = -rxt(k,308)*y(k,134) - mat(k,1097) = -rxt(k,338)*y(k,134) - mat(k,1176) = -rxt(k,352)*y(k,134) - mat(k,749) = -rxt(k,385)*y(k,134) - mat(k,392) = -rxt(k,423)*y(k,134) - mat(k,803) = -rxt(k,440)*y(k,134) - mat(k,830) = -rxt(k,443)*y(k,134) - mat(k,422) = -rxt(k,467)*y(k,134) - mat(k,1122) = -rxt(k,473)*y(k,134) - mat(k,1274) = .150_r8*rxt(k,293)*y(k,203) - mat(k,1850) = mat(k,1850) + .150_r8*rxt(k,293)*y(k,197) + .150_r8*rxt(k,343) & + *y(k,141) + rxt(k,440)*y(k,6) + rxt(k,443)*y(k,110) + rxt(k,468) & + *y(k,148) + rxt(k,474)*y(k,150)) + mat(k,1534) = -rxt(k,129)*y(k,134) + mat(k,2254) = -rxt(k,130)*y(k,134) + mat(k,1954) = -rxt(k,140)*y(k,134) + mat(k,1471) = -rxt(k,141)*y(k,134) + mat(k,1698) = -rxt(k,146)*y(k,134) + mat(k,2199) = -rxt(k,157)*y(k,134) + mat(k,1847) = -rxt(k,165)*y(k,134) + mat(k,2019) = -rxt(k,181)*y(k,134) + mat(k,1421) = -rxt(k,213)*y(k,134) + mat(k,555) = -rxt(k,279)*y(k,134) + mat(k,1037) = -rxt(k,308)*y(k,134) + mat(k,1217) = -rxt(k,338)*y(k,134) + mat(k,1343) = -rxt(k,352)*y(k,134) + mat(k,856) = -rxt(k,385)*y(k,134) + mat(k,465) = -rxt(k,423)*y(k,134) + mat(k,1015) = -rxt(k,440)*y(k,134) + mat(k,965) = -rxt(k,443)*y(k,134) + mat(k,515) = -rxt(k,468)*y(k,134) + mat(k,1240) = -rxt(k,474)*y(k,134) + mat(k,1395) = .150_r8*rxt(k,293)*y(k,203) + mat(k,1954) = mat(k,1954) + .150_r8*rxt(k,293)*y(k,197) + .150_r8*rxt(k,343) & *y(k,211) - mat(k,1244) = .150_r8*rxt(k,343)*y(k,203) - mat(k,252) = -(rxt(k,474)*y(k,150)) - mat(k,1108) = -rxt(k,474)*y(k,136) - mat(k,1702) = rxt(k,214)*y(k,59) - mat(k,1319) = rxt(k,214)*y(k,19) + 2.000_r8*rxt(k,184)*y(k,59) - mat(k,276) = -(rxt(k,464)*y(k,133) + rxt(k,465)*y(k,217)) - mat(k,1852) = -rxt(k,464)*y(k,137) - mat(k,1412) = -rxt(k,465)*y(k,137) - mat(k,913) = rxt(k,331)*y(k,217) - mat(k,1573) = .100_r8*rxt(k,452)*y(k,221) - mat(k,1397) = rxt(k,331)*y(k,93) - mat(k,971) = .100_r8*rxt(k,452)*y(k,124) - mat(k,382) = -(rxt(k,303)*y(k,217)) - mat(k,1427) = -rxt(k,303)*y(k,139) - mat(k,1524) = rxt(k,305)*y(k,197) - mat(k,1247) = rxt(k,305)*y(k,125) - mat(k,1520) = rxt(k,425)*y(k,188) - mat(k,428) = rxt(k,425)*y(k,125) - mat(k,389) = -(rxt(k,422)*y(k,125) + rxt(k,423)*y(k,134)) - mat(k,1525) = -rxt(k,422)*y(k,141) - mat(k,2003) = -rxt(k,423)*y(k,141) - mat(k,148) = .070_r8*rxt(k,409)*y(k,217) - mat(k,1584) = rxt(k,407)*y(k,196) - mat(k,125) = .060_r8*rxt(k,421)*y(k,217) - mat(k,169) = .070_r8*rxt(k,437)*y(k,217) - mat(k,529) = rxt(k,407)*y(k,124) - mat(k,1428) = .070_r8*rxt(k,409)*y(k,66) + .060_r8*rxt(k,421)*y(k,142) & + mat(k,1363) = .150_r8*rxt(k,343)*y(k,203) + mat(k,328) = -(rxt(k,475)*y(k,150)) + mat(k,1229) = -rxt(k,475)*y(k,136) + mat(k,2206) = rxt(k,215)*y(k,59) + mat(k,1963) = rxt(k,215)*y(k,19) + 2.000_r8*rxt(k,185)*y(k,59) + mat(k,357) = -(rxt(k,464)*y(k,133) + rxt(k,465)*y(k,217)) + mat(k,2229) = -rxt(k,464)*y(k,137) + mat(k,1591) = -rxt(k,465)*y(k,137) + mat(k,1146) = rxt(k,331)*y(k,217) + mat(k,1773) = .100_r8*rxt(k,452)*y(k,221) + mat(k,1574) = rxt(k,331)*y(k,93) + mat(k,1107) = .100_r8*rxt(k,452)*y(k,124) + mat(k,524) = -(rxt(k,303)*y(k,217)) + mat(k,1615) = -rxt(k,303)*y(k,139) + mat(k,2168) = rxt(k,305)*y(k,197) + mat(k,1368) = rxt(k,305)*y(k,125) + mat(k,2161) = rxt(k,425)*y(k,188) + mat(k,517) = rxt(k,425)*y(k,125) + mat(k,463) = -(rxt(k,422)*y(k,125) + rxt(k,423)*y(k,134)) + mat(k,2165) = -rxt(k,422)*y(k,141) + mat(k,2084) = -rxt(k,423)*y(k,141) + mat(k,196) = .070_r8*rxt(k,409)*y(k,217) + mat(k,1783) = rxt(k,407)*y(k,196) + mat(k,176) = .060_r8*rxt(k,421)*y(k,217) + mat(k,217) = .070_r8*rxt(k,437)*y(k,217) + mat(k,624) = rxt(k,407)*y(k,124) + mat(k,1606) = .070_r8*rxt(k,409)*y(k,66) + .060_r8*rxt(k,421)*y(k,142) & + .070_r8*rxt(k,437)*y(k,184) - mat(k,123) = -(rxt(k,421)*y(k,217)) - mat(k,1387) = -rxt(k,421)*y(k,142) - mat(k,115) = .530_r8*rxt(k,398)*y(k,217) - mat(k,1387) = mat(k,1387) + .530_r8*rxt(k,398)*y(k,7) - mat(k,257) = -(rxt(k,424)*y(k,217)) - mat(k,1408) = -rxt(k,424)*y(k,143) - mat(k,1765) = rxt(k,419)*y(k,218) - mat(k,372) = rxt(k,419)*y(k,203) - mat(k,441) = -(rxt(k,320)*y(k,217)) - mat(k,1436) = -rxt(k,320)*y(k,146) - mat(k,1786) = rxt(k,318)*y(k,219) - mat(k,657) = rxt(k,318)*y(k,203) - mat(k,340) = -(rxt(k,324)*y(k,217)) - mat(k,1421) = -rxt(k,324)*y(k,147) - mat(k,1773) = .850_r8*rxt(k,322)*y(k,220) - mat(k,1010) = .850_r8*rxt(k,322)*y(k,203) - mat(k,417) = -(rxt(k,467)*y(k,134) + rxt(k,470)*y(k,217)) - mat(k,2004) = -rxt(k,467)*y(k,148) - mat(k,1432) = -rxt(k,470)*y(k,148) - mat(k,1111) = -(rxt(k,468)*y(k,19) + rxt(k,469)*y(k,59) + rxt(k,471)*y(k,125) & - + rxt(k,473)*y(k,134) + rxt(k,474)*y(k,136) + rxt(k,475) & + mat(k,174) = -(rxt(k,421)*y(k,217)) + mat(k,1561) = -rxt(k,421)*y(k,142) + mat(k,166) = .530_r8*rxt(k,398)*y(k,217) + mat(k,1561) = mat(k,1561) + .530_r8*rxt(k,398)*y(k,7) + mat(k,333) = -(rxt(k,424)*y(k,217)) + mat(k,1587) = -rxt(k,424)*y(k,143) + mat(k,1871) = rxt(k,419)*y(k,218) + mat(k,453) = rxt(k,419)*y(k,203) + mat(k,532) = -(rxt(k,320)*y(k,217)) + mat(k,1616) = -rxt(k,320)*y(k,146) + mat(k,1891) = rxt(k,318)*y(k,219) + mat(k,767) = rxt(k,318)*y(k,203) + mat(k,409) = -(rxt(k,324)*y(k,217)) + mat(k,1598) = -rxt(k,324)*y(k,147) + mat(k,1878) = .850_r8*rxt(k,322)*y(k,220) + mat(k,1127) = .850_r8*rxt(k,322)*y(k,203) + mat(k,511) = -(rxt(k,468)*y(k,134) + rxt(k,471)*y(k,217)) + mat(k,2085) = -rxt(k,468)*y(k,148) + mat(k,1613) = -rxt(k,471)*y(k,148) + mat(k,1232) = -(rxt(k,469)*y(k,19) + rxt(k,470)*y(k,59) + rxt(k,472)*y(k,125) & + + rxt(k,474)*y(k,134) + rxt(k,475)*y(k,136) + rxt(k,476) & *y(k,217)) - mat(k,1706) = -rxt(k,468)*y(k,150) - mat(k,1323) = -rxt(k,469)*y(k,150) - mat(k,1540) = -rxt(k,471)*y(k,150) - mat(k,2031) = -rxt(k,473)*y(k,150) - mat(k,254) = -rxt(k,474)*y(k,150) - mat(k,1495) = -rxt(k,475)*y(k,150) - mat(k,1863) = rxt(k,464)*y(k,137) - mat(k,2031) = mat(k,2031) + rxt(k,467)*y(k,148) - mat(k,280) = rxt(k,464)*y(k,133) - mat(k,418) = rxt(k,467)*y(k,134) + rxt(k,470)*y(k,217) - mat(k,1495) = mat(k,1495) + rxt(k,470)*y(k,148) - mat(k,758) = -(rxt(k,477)*y(k,217)) - mat(k,1469) = -rxt(k,477)*y(k,151) - mat(k,1705) = rxt(k,468)*y(k,150) - mat(k,1321) = rxt(k,469)*y(k,150) - mat(k,211) = rxt(k,462)*y(k,126) + (rxt(k,463)+.500_r8*rxt(k,476))*y(k,217) - mat(k,1533) = rxt(k,471)*y(k,150) - mat(k,1948) = rxt(k,462)*y(k,67) - mat(k,2011) = rxt(k,473)*y(k,150) - mat(k,253) = rxt(k,474)*y(k,150) - mat(k,278) = rxt(k,465)*y(k,217) - mat(k,1110) = rxt(k,468)*y(k,19) + rxt(k,469)*y(k,59) + rxt(k,471)*y(k,125) & - + rxt(k,473)*y(k,134) + rxt(k,474)*y(k,136) + rxt(k,475) & + mat(k,2210) = -rxt(k,469)*y(k,150) + mat(k,1967) = -rxt(k,470)*y(k,150) + mat(k,2183) = -rxt(k,472)*y(k,150) + mat(k,2112) = -rxt(k,474)*y(k,150) + mat(k,330) = -rxt(k,475)*y(k,150) + mat(k,1677) = -rxt(k,476)*y(k,150) + mat(k,2239) = rxt(k,464)*y(k,137) + mat(k,2112) = mat(k,2112) + rxt(k,468)*y(k,148) + mat(k,361) = rxt(k,464)*y(k,133) + mat(k,512) = rxt(k,468)*y(k,134) + rxt(k,471)*y(k,217) + mat(k,1677) = mat(k,1677) + rxt(k,471)*y(k,148) + mat(k,832) = -(rxt(k,467)*y(k,217)) + mat(k,1648) = -rxt(k,467)*y(k,151) + mat(k,2209) = rxt(k,469)*y(k,150) + mat(k,1965) = rxt(k,470)*y(k,150) + mat(k,298) = rxt(k,462)*y(k,126) + (rxt(k,463)+.500_r8*rxt(k,477))*y(k,217) + mat(k,2176) = rxt(k,472)*y(k,150) + mat(k,1711) = rxt(k,462)*y(k,67) + mat(k,2091) = rxt(k,474)*y(k,150) + mat(k,329) = rxt(k,475)*y(k,150) + mat(k,359) = rxt(k,465)*y(k,217) + mat(k,1231) = rxt(k,469)*y(k,19) + rxt(k,470)*y(k,59) + rxt(k,472)*y(k,125) & + + rxt(k,474)*y(k,134) + rxt(k,475)*y(k,136) + rxt(k,476) & *y(k,217) - mat(k,1469) = mat(k,1469) + (rxt(k,463)+.500_r8*rxt(k,476))*y(k,67) & - + rxt(k,465)*y(k,137) + rxt(k,475)*y(k,150) - mat(k,194) = -(rxt(k,478)*y(k,229)) - mat(k,2058) = -rxt(k,478)*y(k,152) - mat(k,757) = rxt(k,477)*y(k,217) - mat(k,1400) = rxt(k,477)*y(k,151) - mat(k,778) = .2202005_r8*rxt(k,497)*y(k,134) - mat(k,805) = .0508005_r8*rxt(k,513)*y(k,134) - mat(k,1561) = .1279005_r8*rxt(k,496)*y(k,190) + .0097005_r8*rxt(k,501) & + mat(k,1648) = mat(k,1648) + (rxt(k,463)+.500_r8*rxt(k,477))*y(k,67) & + + rxt(k,465)*y(k,137) + rxt(k,476)*y(k,150) + mat(k,257) = -(rxt(k,478)*y(k,229)) + mat(k,2261) = -rxt(k,478)*y(k,152) + mat(k,831) = rxt(k,467)*y(k,217) + mat(k,1577) = rxt(k,467)*y(k,151) + mat(k,984) = .2202005_r8*rxt(k,497)*y(k,134) + mat(k,935) = .0508005_r8*rxt(k,513)*y(k,134) + mat(k,1761) = .1279005_r8*rxt(k,496)*y(k,190) + .0097005_r8*rxt(k,501) & *y(k,192) + .0003005_r8*rxt(k,504)*y(k,207) & + .1056005_r8*rxt(k,508)*y(k,208) + .0245005_r8*rxt(k,512) & *y(k,214) + .0154005_r8*rxt(k,518)*y(k,224) & + .0063005_r8*rxt(k,521)*y(k,227) - mat(k,1996) = .2202005_r8*rxt(k,497)*y(k,6) + .0508005_r8*rxt(k,513)*y(k,110) - mat(k,34) = .5931005_r8*rxt(k,515)*y(k,217) - mat(k,40) = .1279005_r8*rxt(k,496)*y(k,124) + .2202005_r8*rxt(k,495)*y(k,203) - mat(k,46) = .0097005_r8*rxt(k,501)*y(k,124) + .0023005_r8*rxt(k,500)*y(k,203) - mat(k,1747) = .2202005_r8*rxt(k,495)*y(k,190) + .0023005_r8*rxt(k,500) & + mat(k,2077) = .2202005_r8*rxt(k,497)*y(k,6) + .0508005_r8*rxt(k,513)*y(k,110) + mat(k,43) = .5931005_r8*rxt(k,515)*y(k,217) + mat(k,49) = .1279005_r8*rxt(k,496)*y(k,124) + .2202005_r8*rxt(k,495)*y(k,203) + mat(k,55) = .0097005_r8*rxt(k,501)*y(k,124) + .0023005_r8*rxt(k,500)*y(k,203) + mat(k,1853) = .2202005_r8*rxt(k,495)*y(k,190) + .0023005_r8*rxt(k,500) & *y(k,192) + .0031005_r8*rxt(k,503)*y(k,207) & + .2381005_r8*rxt(k,507)*y(k,208) + .0508005_r8*rxt(k,511) & *y(k,214) + .1364005_r8*rxt(k,517)*y(k,224) & + .1677005_r8*rxt(k,520)*y(k,227) - mat(k,52) = .0003005_r8*rxt(k,504)*y(k,124) + .0031005_r8*rxt(k,503)*y(k,203) - mat(k,58) = .1056005_r8*rxt(k,508)*y(k,124) + .2381005_r8*rxt(k,507)*y(k,203) - mat(k,66) = .0245005_r8*rxt(k,512)*y(k,124) + .0508005_r8*rxt(k,511)*y(k,203) - mat(k,1366) = .5931005_r8*rxt(k,515)*y(k,172) - mat(k,72) = .0154005_r8*rxt(k,518)*y(k,124) + .1364005_r8*rxt(k,517)*y(k,203) - mat(k,78) = .0063005_r8*rxt(k,521)*y(k,124) + .1677005_r8*rxt(k,520)*y(k,203) + mat(k,61) = .0003005_r8*rxt(k,504)*y(k,124) + .0031005_r8*rxt(k,503)*y(k,203) + mat(k,67) = .1056005_r8*rxt(k,508)*y(k,124) + .2381005_r8*rxt(k,507)*y(k,203) + mat(k,75) = .0245005_r8*rxt(k,512)*y(k,124) + .0508005_r8*rxt(k,511)*y(k,203) + mat(k,1540) = .5931005_r8*rxt(k,515)*y(k,172) + mat(k,81) = .0154005_r8*rxt(k,518)*y(k,124) + .1364005_r8*rxt(k,517)*y(k,203) + mat(k,87) = .0063005_r8*rxt(k,521)*y(k,124) + .1677005_r8*rxt(k,520)*y(k,203) end do - end subroutine nlnmat05 - subroutine nlnmat06( avec_len, mat, y, rxt ) + end subroutine nlnmat06 + subroutine nlnmat07( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -1248,217 +1436,217 @@ subroutine nlnmat06( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,779) = .2067005_r8*rxt(k,497)*y(k,134) - mat(k,806) = .1149005_r8*rxt(k,513)*y(k,134) - mat(k,1562) = .1792005_r8*rxt(k,496)*y(k,190) + .0034005_r8*rxt(k,501) & + mat(k,985) = .2067005_r8*rxt(k,497)*y(k,134) + mat(k,936) = .1149005_r8*rxt(k,513)*y(k,134) + mat(k,1762) = .1792005_r8*rxt(k,496)*y(k,190) + .0034005_r8*rxt(k,501) & *y(k,192) + .0003005_r8*rxt(k,504)*y(k,207) & + .1026005_r8*rxt(k,508)*y(k,208) + .0082005_r8*rxt(k,512) & *y(k,214) + .0452005_r8*rxt(k,518)*y(k,224) & + .0237005_r8*rxt(k,521)*y(k,227) - mat(k,1997) = .2067005_r8*rxt(k,497)*y(k,6) + .1149005_r8*rxt(k,513)*y(k,110) - mat(k,35) = .1534005_r8*rxt(k,515)*y(k,217) - mat(k,41) = .1792005_r8*rxt(k,496)*y(k,124) + .2067005_r8*rxt(k,495)*y(k,203) - mat(k,47) = .0034005_r8*rxt(k,501)*y(k,124) + .0008005_r8*rxt(k,500)*y(k,203) - mat(k,1748) = .2067005_r8*rxt(k,495)*y(k,190) + .0008005_r8*rxt(k,500) & + mat(k,2078) = .2067005_r8*rxt(k,497)*y(k,6) + .1149005_r8*rxt(k,513)*y(k,110) + mat(k,44) = .1534005_r8*rxt(k,515)*y(k,217) + mat(k,50) = .1792005_r8*rxt(k,496)*y(k,124) + .2067005_r8*rxt(k,495)*y(k,203) + mat(k,56) = .0034005_r8*rxt(k,501)*y(k,124) + .0008005_r8*rxt(k,500)*y(k,203) + mat(k,1854) = .2067005_r8*rxt(k,495)*y(k,190) + .0008005_r8*rxt(k,500) & *y(k,192) + .0035005_r8*rxt(k,503)*y(k,207) & + .1308005_r8*rxt(k,507)*y(k,208) + .1149005_r8*rxt(k,511) & *y(k,214) + .0101005_r8*rxt(k,517)*y(k,224) & + .0174005_r8*rxt(k,520)*y(k,227) - mat(k,53) = .0003005_r8*rxt(k,504)*y(k,124) + .0035005_r8*rxt(k,503)*y(k,203) - mat(k,59) = .1026005_r8*rxt(k,508)*y(k,124) + .1308005_r8*rxt(k,507)*y(k,203) - mat(k,67) = .0082005_r8*rxt(k,512)*y(k,124) + .1149005_r8*rxt(k,511)*y(k,203) - mat(k,1367) = .1534005_r8*rxt(k,515)*y(k,172) - mat(k,73) = .0452005_r8*rxt(k,518)*y(k,124) + .0101005_r8*rxt(k,517)*y(k,203) - mat(k,79) = .0237005_r8*rxt(k,521)*y(k,124) + .0174005_r8*rxt(k,520)*y(k,203) - mat(k,780) = .0653005_r8*rxt(k,497)*y(k,134) - mat(k,807) = .0348005_r8*rxt(k,513)*y(k,134) - mat(k,1563) = .0676005_r8*rxt(k,496)*y(k,190) + .1579005_r8*rxt(k,501) & + mat(k,62) = .0003005_r8*rxt(k,504)*y(k,124) + .0035005_r8*rxt(k,503)*y(k,203) + mat(k,68) = .1026005_r8*rxt(k,508)*y(k,124) + .1308005_r8*rxt(k,507)*y(k,203) + mat(k,76) = .0082005_r8*rxt(k,512)*y(k,124) + .1149005_r8*rxt(k,511)*y(k,203) + mat(k,1541) = .1534005_r8*rxt(k,515)*y(k,172) + mat(k,82) = .0452005_r8*rxt(k,518)*y(k,124) + .0101005_r8*rxt(k,517)*y(k,203) + mat(k,88) = .0237005_r8*rxt(k,521)*y(k,124) + .0174005_r8*rxt(k,520)*y(k,203) + mat(k,986) = .0653005_r8*rxt(k,497)*y(k,134) + mat(k,937) = .0348005_r8*rxt(k,513)*y(k,134) + mat(k,1763) = .0676005_r8*rxt(k,496)*y(k,190) + .1579005_r8*rxt(k,501) & *y(k,192) + .0073005_r8*rxt(k,504)*y(k,207) & + .0521005_r8*rxt(k,508)*y(k,208) + .0772005_r8*rxt(k,512) & *y(k,214) + .0966005_r8*rxt(k,518)*y(k,224) & + .0025005_r8*rxt(k,521)*y(k,227) - mat(k,1998) = .0653005_r8*rxt(k,497)*y(k,6) + .0348005_r8*rxt(k,513)*y(k,110) - mat(k,36) = .0459005_r8*rxt(k,515)*y(k,217) - mat(k,42) = .0676005_r8*rxt(k,496)*y(k,124) + .0653005_r8*rxt(k,495)*y(k,203) - mat(k,48) = .1579005_r8*rxt(k,501)*y(k,124) + .0843005_r8*rxt(k,500)*y(k,203) - mat(k,1749) = .0653005_r8*rxt(k,495)*y(k,190) + .0843005_r8*rxt(k,500) & + mat(k,2079) = .0653005_r8*rxt(k,497)*y(k,6) + .0348005_r8*rxt(k,513)*y(k,110) + mat(k,45) = .0459005_r8*rxt(k,515)*y(k,217) + mat(k,51) = .0676005_r8*rxt(k,496)*y(k,124) + .0653005_r8*rxt(k,495)*y(k,203) + mat(k,57) = .1579005_r8*rxt(k,501)*y(k,124) + .0843005_r8*rxt(k,500)*y(k,203) + mat(k,1855) = .0653005_r8*rxt(k,495)*y(k,190) + .0843005_r8*rxt(k,500) & *y(k,192) + .0003005_r8*rxt(k,503)*y(k,207) & + .0348005_r8*rxt(k,507)*y(k,208) + .0348005_r8*rxt(k,511) & *y(k,214) + .0763005_r8*rxt(k,517)*y(k,224) + .086_r8*rxt(k,520) & *y(k,227) - mat(k,54) = .0073005_r8*rxt(k,504)*y(k,124) + .0003005_r8*rxt(k,503)*y(k,203) - mat(k,60) = .0521005_r8*rxt(k,508)*y(k,124) + .0348005_r8*rxt(k,507)*y(k,203) - mat(k,68) = .0772005_r8*rxt(k,512)*y(k,124) + .0348005_r8*rxt(k,511)*y(k,203) - mat(k,1368) = .0459005_r8*rxt(k,515)*y(k,172) - mat(k,74) = .0966005_r8*rxt(k,518)*y(k,124) + .0763005_r8*rxt(k,517)*y(k,203) - mat(k,80) = .0025005_r8*rxt(k,521)*y(k,124) + .086_r8*rxt(k,520)*y(k,203) - mat(k,781) = .1749305_r8*rxt(k,494)*y(k,126) + .1284005_r8*rxt(k,497) & + mat(k,63) = .0073005_r8*rxt(k,504)*y(k,124) + .0003005_r8*rxt(k,503)*y(k,203) + mat(k,69) = .0521005_r8*rxt(k,508)*y(k,124) + .0348005_r8*rxt(k,507)*y(k,203) + mat(k,77) = .0772005_r8*rxt(k,512)*y(k,124) + .0348005_r8*rxt(k,511)*y(k,203) + mat(k,1542) = .0459005_r8*rxt(k,515)*y(k,172) + mat(k,83) = .0966005_r8*rxt(k,518)*y(k,124) + .0763005_r8*rxt(k,517)*y(k,203) + mat(k,89) = .0025005_r8*rxt(k,521)*y(k,124) + .086_r8*rxt(k,520)*y(k,203) + mat(k,987) = .1749305_r8*rxt(k,494)*y(k,126) + .1284005_r8*rxt(k,497) & *y(k,134) - mat(k,731) = .0590245_r8*rxt(k,502)*y(k,126) + .0033005_r8*rxt(k,505) & + mat(k,838) = .0590245_r8*rxt(k,502)*y(k,126) + .0033005_r8*rxt(k,505) & *y(k,134) - mat(k,808) = .1749305_r8*rxt(k,510)*y(k,126) + .0554005_r8*rxt(k,513) & + mat(k,938) = .1749305_r8*rxt(k,510)*y(k,126) + .0554005_r8*rxt(k,513) & *y(k,134) - mat(k,1564) = .079_r8*rxt(k,496)*y(k,190) + .0059005_r8*rxt(k,501)*y(k,192) & + mat(k,1764) = .079_r8*rxt(k,496)*y(k,190) + .0059005_r8*rxt(k,501)*y(k,192) & + .0057005_r8*rxt(k,504)*y(k,207) + .0143005_r8*rxt(k,508) & *y(k,208) + .0332005_r8*rxt(k,512)*y(k,214) & + .0073005_r8*rxt(k,518)*y(k,224) + .011_r8*rxt(k,521)*y(k,227) - mat(k,1939) = .1749305_r8*rxt(k,494)*y(k,6) + .0590245_r8*rxt(k,502)*y(k,98) & + mat(k,1704) = .1749305_r8*rxt(k,494)*y(k,6) + .0590245_r8*rxt(k,502)*y(k,98) & + .1749305_r8*rxt(k,510)*y(k,110) - mat(k,1999) = .1284005_r8*rxt(k,497)*y(k,6) + .0033005_r8*rxt(k,505)*y(k,98) & + mat(k,2080) = .1284005_r8*rxt(k,497)*y(k,6) + .0033005_r8*rxt(k,505)*y(k,98) & + .0554005_r8*rxt(k,513)*y(k,110) - mat(k,37) = .0085005_r8*rxt(k,515)*y(k,217) - mat(k,43) = .079_r8*rxt(k,496)*y(k,124) + .1284005_r8*rxt(k,495)*y(k,203) - mat(k,49) = .0059005_r8*rxt(k,501)*y(k,124) + .0443005_r8*rxt(k,500)*y(k,203) - mat(k,1750) = .1284005_r8*rxt(k,495)*y(k,190) + .0443005_r8*rxt(k,500) & + mat(k,46) = .0085005_r8*rxt(k,515)*y(k,217) + mat(k,52) = .079_r8*rxt(k,496)*y(k,124) + .1284005_r8*rxt(k,495)*y(k,203) + mat(k,58) = .0059005_r8*rxt(k,501)*y(k,124) + .0443005_r8*rxt(k,500)*y(k,203) + mat(k,1856) = .1284005_r8*rxt(k,495)*y(k,190) + .0443005_r8*rxt(k,500) & *y(k,192) + .0271005_r8*rxt(k,503)*y(k,207) & + .0076005_r8*rxt(k,507)*y(k,208) + .0554005_r8*rxt(k,511) & *y(k,214) + .2157005_r8*rxt(k,517)*y(k,224) & + .0512005_r8*rxt(k,520)*y(k,227) - mat(k,55) = .0057005_r8*rxt(k,504)*y(k,124) + .0271005_r8*rxt(k,503)*y(k,203) - mat(k,61) = .0143005_r8*rxt(k,508)*y(k,124) + .0076005_r8*rxt(k,507)*y(k,203) - mat(k,69) = .0332005_r8*rxt(k,512)*y(k,124) + .0554005_r8*rxt(k,511)*y(k,203) - mat(k,1369) = .0085005_r8*rxt(k,515)*y(k,172) - mat(k,75) = .0073005_r8*rxt(k,518)*y(k,124) + .2157005_r8*rxt(k,517)*y(k,203) - mat(k,81) = .011_r8*rxt(k,521)*y(k,124) + .0512005_r8*rxt(k,520)*y(k,203) - mat(k,782) = .5901905_r8*rxt(k,494)*y(k,126) + .114_r8*rxt(k,497)*y(k,134) - mat(k,732) = .0250245_r8*rxt(k,502)*y(k,126) - mat(k,809) = .5901905_r8*rxt(k,510)*y(k,126) + .1278005_r8*rxt(k,513) & + mat(k,64) = .0057005_r8*rxt(k,504)*y(k,124) + .0271005_r8*rxt(k,503)*y(k,203) + mat(k,70) = .0143005_r8*rxt(k,508)*y(k,124) + .0076005_r8*rxt(k,507)*y(k,203) + mat(k,78) = .0332005_r8*rxt(k,512)*y(k,124) + .0554005_r8*rxt(k,511)*y(k,203) + mat(k,1543) = .0085005_r8*rxt(k,515)*y(k,172) + mat(k,84) = .0073005_r8*rxt(k,518)*y(k,124) + .2157005_r8*rxt(k,517)*y(k,203) + mat(k,90) = .011_r8*rxt(k,521)*y(k,124) + .0512005_r8*rxt(k,520)*y(k,203) + mat(k,988) = .5901905_r8*rxt(k,494)*y(k,126) + .114_r8*rxt(k,497)*y(k,134) + mat(k,839) = .0250245_r8*rxt(k,502)*y(k,126) + mat(k,939) = .5901905_r8*rxt(k,510)*y(k,126) + .1278005_r8*rxt(k,513) & *y(k,134) - mat(k,1565) = .1254005_r8*rxt(k,496)*y(k,190) + .0536005_r8*rxt(k,501) & + mat(k,1765) = .1254005_r8*rxt(k,496)*y(k,190) + .0536005_r8*rxt(k,501) & *y(k,192) + .0623005_r8*rxt(k,504)*y(k,207) & + .0166005_r8*rxt(k,508)*y(k,208) + .130_r8*rxt(k,512)*y(k,214) & + .238_r8*rxt(k,518)*y(k,224) + .1185005_r8*rxt(k,521)*y(k,227) - mat(k,1940) = .5901905_r8*rxt(k,494)*y(k,6) + .0250245_r8*rxt(k,502)*y(k,98) & + mat(k,1705) = .5901905_r8*rxt(k,494)*y(k,6) + .0250245_r8*rxt(k,502)*y(k,98) & + .5901905_r8*rxt(k,510)*y(k,110) - mat(k,2000) = .114_r8*rxt(k,497)*y(k,6) + .1278005_r8*rxt(k,513)*y(k,110) - mat(k,38) = .0128005_r8*rxt(k,515)*y(k,217) - mat(k,44) = .1254005_r8*rxt(k,496)*y(k,124) + .114_r8*rxt(k,495)*y(k,203) - mat(k,50) = .0536005_r8*rxt(k,501)*y(k,124) + .1621005_r8*rxt(k,500)*y(k,203) - mat(k,1751) = .114_r8*rxt(k,495)*y(k,190) + .1621005_r8*rxt(k,500)*y(k,192) & + mat(k,2081) = .114_r8*rxt(k,497)*y(k,6) + .1278005_r8*rxt(k,513)*y(k,110) + mat(k,47) = .0128005_r8*rxt(k,515)*y(k,217) + mat(k,53) = .1254005_r8*rxt(k,496)*y(k,124) + .114_r8*rxt(k,495)*y(k,203) + mat(k,59) = .0536005_r8*rxt(k,501)*y(k,124) + .1621005_r8*rxt(k,500)*y(k,203) + mat(k,1857) = .114_r8*rxt(k,495)*y(k,190) + .1621005_r8*rxt(k,500)*y(k,192) & + .0474005_r8*rxt(k,503)*y(k,207) + .0113005_r8*rxt(k,507) & *y(k,208) + .1278005_r8*rxt(k,511)*y(k,214) & + .0738005_r8*rxt(k,517)*y(k,224) + .1598005_r8*rxt(k,520) & *y(k,227) - mat(k,56) = .0623005_r8*rxt(k,504)*y(k,124) + .0474005_r8*rxt(k,503)*y(k,203) - mat(k,62) = .0166005_r8*rxt(k,508)*y(k,124) + .0113005_r8*rxt(k,507)*y(k,203) - mat(k,70) = .130_r8*rxt(k,512)*y(k,124) + .1278005_r8*rxt(k,511)*y(k,203) - mat(k,1370) = .0128005_r8*rxt(k,515)*y(k,172) - mat(k,76) = .238_r8*rxt(k,518)*y(k,124) + .0738005_r8*rxt(k,517)*y(k,203) - mat(k,82) = .1185005_r8*rxt(k,521)*y(k,124) + .1598005_r8*rxt(k,520)*y(k,203) - mat(k,39) = -(rxt(k,515)*y(k,217)) - mat(k,1371) = -rxt(k,515)*y(k,172) - mat(k,141) = .100_r8*rxt(k,429)*y(k,217) - mat(k,159) = .230_r8*rxt(k,431)*y(k,217) - mat(k,1392) = .100_r8*rxt(k,429)*y(k,180) + .230_r8*rxt(k,431)*y(k,182) - mat(k,504) = -(rxt(k,453)*y(k,217)) - mat(k,1444) = -rxt(k,453)*y(k,174) - mat(k,1789) = rxt(k,451)*y(k,221) - mat(k,972) = rxt(k,451)*y(k,203) - mat(k,522) = -(rxt(k,454)*y(k,217)) - mat(k,1446) = -rxt(k,454)*y(k,175) - mat(k,1593) = .200_r8*rxt(k,447)*y(k,215) + .200_r8*rxt(k,457)*y(k,222) - mat(k,1656) = .500_r8*rxt(k,445)*y(k,215) - mat(k,991) = .200_r8*rxt(k,447)*y(k,124) + .500_r8*rxt(k,445)*y(k,198) - mat(k,950) = .200_r8*rxt(k,457)*y(k,124) - mat(k,393) = -(rxt(k,458)*y(k,217)) - mat(k,1429) = -rxt(k,458)*y(k,176) - mat(k,1781) = rxt(k,456)*y(k,222) - mat(k,949) = rxt(k,456)*y(k,203) - mat(k,884) = -(rxt(k,459)*y(k,126) + rxt(k,460)*y(k,217)) - mat(k,1955) = -rxt(k,459)*y(k,177) - mat(k,1478) = -rxt(k,460)*y(k,177) - mat(k,791) = .330_r8*rxt(k,440)*y(k,134) - mat(k,818) = .330_r8*rxt(k,443)*y(k,134) - mat(k,1611) = .800_r8*rxt(k,447)*y(k,215) + .800_r8*rxt(k,457)*y(k,222) - mat(k,1955) = mat(k,1955) + rxt(k,448)*y(k,215) - mat(k,2018) = .330_r8*rxt(k,440)*y(k,6) + .330_r8*rxt(k,443)*y(k,110) - mat(k,523) = rxt(k,454)*y(k,217) - mat(k,1663) = .500_r8*rxt(k,445)*y(k,215) + rxt(k,455)*y(k,222) - mat(k,993) = .800_r8*rxt(k,447)*y(k,124) + rxt(k,448)*y(k,126) & + mat(k,65) = .0623005_r8*rxt(k,504)*y(k,124) + .0474005_r8*rxt(k,503)*y(k,203) + mat(k,71) = .0166005_r8*rxt(k,508)*y(k,124) + .0113005_r8*rxt(k,507)*y(k,203) + mat(k,79) = .130_r8*rxt(k,512)*y(k,124) + .1278005_r8*rxt(k,511)*y(k,203) + mat(k,1544) = .0128005_r8*rxt(k,515)*y(k,172) + mat(k,85) = .238_r8*rxt(k,518)*y(k,124) + .0738005_r8*rxt(k,517)*y(k,203) + mat(k,91) = .1185005_r8*rxt(k,521)*y(k,124) + .1598005_r8*rxt(k,520)*y(k,203) + mat(k,48) = -(rxt(k,515)*y(k,217)) + mat(k,1545) = -rxt(k,515)*y(k,172) + mat(k,189) = .100_r8*rxt(k,429)*y(k,217) + mat(k,207) = .230_r8*rxt(k,431)*y(k,217) + mat(k,1565) = .100_r8*rxt(k,429)*y(k,180) + .230_r8*rxt(k,431)*y(k,182) + mat(k,642) = -(rxt(k,453)*y(k,217)) + mat(k,1629) = -rxt(k,453)*y(k,174) + mat(k,1896) = rxt(k,451)*y(k,221) + mat(k,1108) = rxt(k,451)*y(k,203) + mat(k,617) = -(rxt(k,454)*y(k,217)) + mat(k,1626) = -rxt(k,454)*y(k,175) + mat(k,1793) = .200_r8*rxt(k,447)*y(k,215) + .200_r8*rxt(k,457)*y(k,222) + mat(k,2029) = .500_r8*rxt(k,445)*y(k,215) + mat(k,1042) = .200_r8*rxt(k,447)*y(k,124) + .500_r8*rxt(k,445)*y(k,198) + mat(k,910) = .200_r8*rxt(k,457)*y(k,124) + mat(k,474) = -(rxt(k,458)*y(k,217)) + mat(k,1608) = -rxt(k,458)*y(k,176) + mat(k,1887) = rxt(k,456)*y(k,222) + mat(k,909) = rxt(k,456)*y(k,203) + mat(k,969) = -(rxt(k,459)*y(k,126) + rxt(k,460)*y(k,217)) + mat(k,1717) = -rxt(k,459)*y(k,177) + mat(k,1659) = -rxt(k,460)*y(k,177) + mat(k,997) = .330_r8*rxt(k,440)*y(k,134) + mat(k,949) = .330_r8*rxt(k,443)*y(k,134) + mat(k,1812) = .800_r8*rxt(k,447)*y(k,215) + .800_r8*rxt(k,457)*y(k,222) + mat(k,1717) = mat(k,1717) + rxt(k,448)*y(k,215) + mat(k,2097) = .330_r8*rxt(k,440)*y(k,6) + .330_r8*rxt(k,443)*y(k,110) + mat(k,618) = rxt(k,454)*y(k,217) + mat(k,2038) = .500_r8*rxt(k,445)*y(k,215) + rxt(k,455)*y(k,222) + mat(k,1044) = .800_r8*rxt(k,447)*y(k,124) + rxt(k,448)*y(k,126) & + .500_r8*rxt(k,445)*y(k,198) - mat(k,1478) = mat(k,1478) + rxt(k,454)*y(k,175) - mat(k,953) = .800_r8*rxt(k,457)*y(k,124) + rxt(k,455)*y(k,198) - mat(k,930) = -(rxt(k,461)*y(k,217)) - mat(k,1482) = -rxt(k,461)*y(k,178) - mat(k,792) = .300_r8*rxt(k,440)*y(k,134) - mat(k,819) = .300_r8*rxt(k,443)*y(k,134) - mat(k,1615) = .900_r8*rxt(k,452)*y(k,221) - mat(k,2020) = .300_r8*rxt(k,440)*y(k,6) + .300_r8*rxt(k,443)*y(k,110) - mat(k,1666) = rxt(k,450)*y(k,221) - mat(k,976) = .900_r8*rxt(k,452)*y(k,124) + rxt(k,450)*y(k,198) - mat(k,550) = -(rxt(k,428)*y(k,217)) - mat(k,1449) = -rxt(k,428)*y(k,179) - mat(k,1792) = rxt(k,426)*y(k,223) - mat(k,620) = rxt(k,426)*y(k,203) - mat(k,139) = -(rxt(k,429)*y(k,217)) - mat(k,1390) = -rxt(k,429)*y(k,180) - mat(k,155) = -(rxt(k,395)*y(k,217)) - mat(k,1393) = -rxt(k,395)*y(k,181) - mat(k,1760) = rxt(k,392)*y(k,225) - mat(k,1046) = rxt(k,392)*y(k,203) - mat(k,160) = -(rxt(k,431)*y(k,217)) - mat(k,1394) = -rxt(k,431)*y(k,182) - mat(k,591) = -(rxt(k,434)*y(k,217)) - mat(k,1453) = -rxt(k,434)*y(k,183) - mat(k,1795) = rxt(k,432)*y(k,226) - mat(k,636) = rxt(k,432)*y(k,203) - mat(k,168) = -(rxt(k,437)*y(k,217)) - mat(k,1395) = -rxt(k,437)*y(k,184) - mat(k,161) = .150_r8*rxt(k,431)*y(k,217) - mat(k,1395) = mat(k,1395) + .150_r8*rxt(k,431)*y(k,182) - mat(k,352) = -(rxt(k,438)*y(k,217)) - mat(k,1423) = -rxt(k,438)*y(k,185) - mat(k,1775) = rxt(k,435)*y(k,228) - mat(k,409) = rxt(k,435)*y(k,203) - mat(k,429) = -(rxt(k,396)*y(k,203) + rxt(k,397)*y(k,124) + rxt(k,425) & + mat(k,1659) = mat(k,1659) + rxt(k,454)*y(k,175) + mat(k,914) = .800_r8*rxt(k,457)*y(k,124) + rxt(k,455)*y(k,198) + mat(k,1059) = -(rxt(k,461)*y(k,217)) + mat(k,1664) = -rxt(k,461)*y(k,178) + mat(k,1001) = .300_r8*rxt(k,440)*y(k,134) + mat(k,952) = .300_r8*rxt(k,443)*y(k,134) + mat(k,1815) = .900_r8*rxt(k,452)*y(k,221) + mat(k,2102) = .300_r8*rxt(k,440)*y(k,6) + .300_r8*rxt(k,443)*y(k,110) + mat(k,2041) = rxt(k,450)*y(k,221) + mat(k,1112) = .900_r8*rxt(k,452)*y(k,124) + rxt(k,450)*y(k,198) + mat(k,655) = -(rxt(k,428)*y(k,217)) + mat(k,1630) = -rxt(k,428)*y(k,179) + mat(k,1897) = rxt(k,426)*y(k,223) + mat(k,730) = rxt(k,426)*y(k,203) + mat(k,187) = -(rxt(k,429)*y(k,217)) + mat(k,1563) = -rxt(k,429)*y(k,180) + mat(k,203) = -(rxt(k,395)*y(k,217)) + mat(k,1566) = -rxt(k,395)*y(k,181) + mat(k,1866) = rxt(k,392)*y(k,225) + mat(k,1166) = rxt(k,392)*y(k,203) + mat(k,208) = -(rxt(k,431)*y(k,217)) + mat(k,1567) = -rxt(k,431)*y(k,182) + mat(k,701) = -(rxt(k,434)*y(k,217)) + mat(k,1635) = -rxt(k,434)*y(k,183) + mat(k,1901) = rxt(k,432)*y(k,226) + mat(k,746) = rxt(k,432)*y(k,203) + mat(k,216) = -(rxt(k,437)*y(k,217)) + mat(k,1568) = -rxt(k,437)*y(k,184) + mat(k,209) = .150_r8*rxt(k,431)*y(k,217) + mat(k,1568) = mat(k,1568) + .150_r8*rxt(k,431)*y(k,182) + mat(k,427) = -(rxt(k,438)*y(k,217)) + mat(k,1601) = -rxt(k,438)*y(k,185) + mat(k,1881) = rxt(k,435)*y(k,228) + mat(k,498) = rxt(k,435)*y(k,203) + mat(k,518) = -(rxt(k,396)*y(k,203) + rxt(k,397)*y(k,124) + rxt(k,425) & *y(k,125)) - mat(k,1784) = -rxt(k,396)*y(k,188) - mat(k,1588) = -rxt(k,397)*y(k,188) - mat(k,1526) = -rxt(k,425)*y(k,188) - mat(k,191) = rxt(k,402)*y(k,217) - mat(k,1434) = rxt(k,402)*y(k,22) - mat(k,837) = -(rxt(k,357)*y(k,203) + (rxt(k,358) + rxt(k,359)) * y(k,124)) - mat(k,1811) = -rxt(k,357)*y(k,189) - mat(k,1609) = -(rxt(k,358) + rxt(k,359)) * y(k,189) - mat(k,540) = rxt(k,360)*y(k,217) - mat(k,185) = rxt(k,361)*y(k,217) - mat(k,1474) = rxt(k,360)*y(k,2) + rxt(k,361)*y(k,15) - mat(k,45) = -(rxt(k,495)*y(k,203) + rxt(k,496)*y(k,124)) - mat(k,1752) = -rxt(k,495)*y(k,190) - mat(k,1566) = -rxt(k,496)*y(k,190) - mat(k,783) = rxt(k,498)*y(k,217) - mat(k,1372) = rxt(k,498)*y(k,6) - mat(k,402) = -(rxt(k,399)*y(k,203) + rxt(k,400)*y(k,124)) - mat(k,1782) = -rxt(k,399)*y(k,191) - mat(k,1585) = -rxt(k,400)*y(k,191) - mat(k,116) = .350_r8*rxt(k,398)*y(k,217) - mat(k,306) = rxt(k,401)*y(k,217) - mat(k,1430) = .350_r8*rxt(k,398)*y(k,7) + rxt(k,401)*y(k,8) - mat(k,51) = -(rxt(k,500)*y(k,203) + rxt(k,501)*y(k,124)) - mat(k,1753) = -rxt(k,500)*y(k,192) - mat(k,1567) = -rxt(k,501)*y(k,192) - mat(k,112) = rxt(k,499)*y(k,217) - mat(k,1373) = rxt(k,499)*y(k,7) - mat(k,360) = -(rxt(k,403)*y(k,203) + rxt(k,405)*y(k,124)) - mat(k,1776) = -rxt(k,403)*y(k,193) - mat(k,1580) = -rxt(k,405)*y(k,193) - mat(k,264) = rxt(k,404)*y(k,217) - mat(k,142) = .070_r8*rxt(k,429)*y(k,217) - mat(k,162) = .060_r8*rxt(k,431)*y(k,217) - mat(k,1424) = rxt(k,404)*y(k,23) + .070_r8*rxt(k,429)*y(k,180) & + mat(k,1890) = -rxt(k,396)*y(k,188) + mat(k,1788) = -rxt(k,397)*y(k,188) + mat(k,2167) = -rxt(k,425)*y(k,188) + mat(k,254) = rxt(k,402)*y(k,217) + mat(k,1614) = rxt(k,402)*y(k,22) + mat(k,899) = -(rxt(k,357)*y(k,203) + (rxt(k,358) + rxt(k,359)) * y(k,124)) + mat(k,1916) = -rxt(k,357)*y(k,189) + mat(k,1808) = -(rxt(k,358) + rxt(k,359)) * y(k,189) + mat(k,635) = rxt(k,360)*y(k,217) + mat(k,239) = rxt(k,361)*y(k,217) + mat(k,1654) = rxt(k,360)*y(k,2) + rxt(k,361)*y(k,15) + mat(k,54) = -(rxt(k,495)*y(k,203) + rxt(k,496)*y(k,124)) + mat(k,1858) = -rxt(k,495)*y(k,190) + mat(k,1766) = -rxt(k,496)*y(k,190) + mat(k,989) = rxt(k,498)*y(k,217) + mat(k,1546) = rxt(k,498)*y(k,6) + mat(k,483) = -(rxt(k,399)*y(k,203) + rxt(k,400)*y(k,124)) + mat(k,1888) = -rxt(k,399)*y(k,191) + mat(k,1784) = -rxt(k,400)*y(k,191) + mat(k,167) = .350_r8*rxt(k,398)*y(k,217) + mat(k,423) = rxt(k,401)*y(k,217) + mat(k,1609) = .350_r8*rxt(k,398)*y(k,7) + rxt(k,401)*y(k,8) + mat(k,60) = -(rxt(k,500)*y(k,203) + rxt(k,501)*y(k,124)) + mat(k,1859) = -rxt(k,500)*y(k,192) + mat(k,1767) = -rxt(k,501)*y(k,192) + mat(k,163) = rxt(k,499)*y(k,217) + mat(k,1547) = rxt(k,499)*y(k,7) + mat(k,435) = -(rxt(k,403)*y(k,203) + rxt(k,405)*y(k,124)) + mat(k,1882) = -rxt(k,403)*y(k,193) + mat(k,1779) = -rxt(k,405)*y(k,193) + mat(k,340) = rxt(k,404)*y(k,217) + mat(k,190) = .070_r8*rxt(k,429)*y(k,217) + mat(k,210) = .060_r8*rxt(k,431)*y(k,217) + mat(k,1602) = rxt(k,404)*y(k,23) + .070_r8*rxt(k,429)*y(k,180) & + .060_r8*rxt(k,431)*y(k,182) - mat(k,715) = -(4._r8*rxt(k,280)*y(k,194) + rxt(k,281)*y(k,198) + rxt(k,282) & + mat(k,815) = -(4._r8*rxt(k,280)*y(k,194) + rxt(k,281)*y(k,198) + rxt(k,282) & *y(k,203) + rxt(k,283)*y(k,124)) - mat(k,1659) = -rxt(k,281)*y(k,194) - mat(k,1806) = -rxt(k,282)*y(k,194) - mat(k,1605) = -rxt(k,283)*y(k,194) - mat(k,269) = .500_r8*rxt(k,285)*y(k,217) - mat(k,232) = rxt(k,286)*y(k,56) + rxt(k,287)*y(k,217) - mat(k,1912) = rxt(k,286)*y(k,28) - mat(k,1465) = .500_r8*rxt(k,285)*y(k,27) + rxt(k,287)*y(k,28) + mat(k,2034) = -rxt(k,281)*y(k,194) + mat(k,1912) = -rxt(k,282)*y(k,194) + mat(k,1805) = -rxt(k,283)*y(k,194) + mat(k,345) = .500_r8*rxt(k,285)*y(k,217) + mat(k,292) = rxt(k,286)*y(k,56) + rxt(k,287)*y(k,217) + mat(k,1996) = rxt(k,286)*y(k,28) + mat(k,1646) = .500_r8*rxt(k,285)*y(k,27) + rxt(k,287)*y(k,28) end do - end subroutine nlnmat06 - subroutine nlnmat07( avec_len, mat, y, rxt ) + end subroutine nlnmat07 + subroutine nlnmat08( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -1476,137 +1664,143 @@ subroutine nlnmat07( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,686) = -(rxt(k,309)*y(k,198) + rxt(k,310)*y(k,203) + rxt(k,311) & + mat(k,791) = -(rxt(k,309)*y(k,198) + rxt(k,310)*y(k,203) + rxt(k,311) & *y(k,124)) - mat(k,1657) = -rxt(k,309)*y(k,195) - mat(k,1803) = -rxt(k,310)*y(k,195) - mat(k,1603) = -rxt(k,311)*y(k,195) - mat(k,347) = rxt(k,312)*y(k,217) - mat(k,94) = rxt(k,313)*y(k,217) - mat(k,1461) = rxt(k,312)*y(k,30) + rxt(k,313)*y(k,31) - mat(k,530) = -(rxt(k,406)*y(k,203) + rxt(k,407)*y(k,124)) - mat(k,1790) = -rxt(k,406)*y(k,196) - mat(k,1594) = -rxt(k,407)*y(k,196) - mat(k,204) = rxt(k,408)*y(k,217) - mat(k,1594) = mat(k,1594) + rxt(k,397)*y(k,188) - mat(k,2007) = rxt(k,423)*y(k,141) - mat(k,390) = rxt(k,423)*y(k,134) - mat(k,430) = rxt(k,397)*y(k,124) + .400_r8*rxt(k,396)*y(k,203) - mat(k,1790) = mat(k,1790) + .400_r8*rxt(k,396)*y(k,188) - mat(k,1447) = rxt(k,408)*y(k,32) - mat(k,1264) = -(4._r8*rxt(k,291)*y(k,197) + rxt(k,292)*y(k,198) + rxt(k,293) & + mat(k,2032) = -rxt(k,309)*y(k,195) + mat(k,1909) = -rxt(k,310)*y(k,195) + mat(k,1803) = -rxt(k,311)*y(k,195) + mat(k,416) = rxt(k,312)*y(k,217) + mat(k,110) = rxt(k,313)*y(k,217) + mat(k,1643) = rxt(k,312)*y(k,30) + rxt(k,313)*y(k,31) + mat(k,625) = -(rxt(k,406)*y(k,203) + rxt(k,407)*y(k,124)) + mat(k,1894) = -rxt(k,406)*y(k,196) + mat(k,1794) = -rxt(k,407)*y(k,196) + mat(k,267) = rxt(k,408)*y(k,217) + mat(k,1794) = mat(k,1794) + rxt(k,397)*y(k,188) + mat(k,2087) = rxt(k,423)*y(k,141) + mat(k,464) = rxt(k,423)*y(k,134) + mat(k,519) = rxt(k,397)*y(k,124) + .400_r8*rxt(k,396)*y(k,203) + mat(k,1894) = mat(k,1894) + .400_r8*rxt(k,396)*y(k,188) + mat(k,1627) = rxt(k,408)*y(k,32) + mat(k,1386) = -(4._r8*rxt(k,291)*y(k,197) + rxt(k,292)*y(k,198) + rxt(k,293) & *y(k,203) + rxt(k,294)*y(k,124) + rxt(k,305)*y(k,125) + rxt(k,332) & *y(k,209) + rxt(k,365)*y(k,205) + rxt(k,370)*y(k,206) + rxt(k,379) & *y(k,101) + rxt(k,390)*y(k,225)) - mat(k,1683) = -rxt(k,292)*y(k,197) - mat(k,1833) = -rxt(k,293)*y(k,197) - mat(k,1632) = -rxt(k,294)*y(k,197) - mat(k,1542) = -rxt(k,305)*y(k,197) - mat(k,1189) = -rxt(k,332)*y(k,197) - mat(k,1216) = -rxt(k,365)*y(k,197) - mat(k,1146) = -rxt(k,370)*y(k,197) - mat(k,1076) = -rxt(k,379)*y(k,197) - mat(k,1054) = -rxt(k,390)*y(k,197) - mat(k,798) = .060_r8*rxt(k,440)*y(k,134) - mat(k,1025) = rxt(k,288)*y(k,126) + rxt(k,289)*y(k,217) - mat(k,1101) = rxt(k,314)*y(k,126) + rxt(k,315)*y(k,217) - mat(k,436) = .500_r8*rxt(k,296)*y(k,217) - mat(k,743) = .080_r8*rxt(k,385)*y(k,134) - mat(k,1092) = .100_r8*rxt(k,338)*y(k,134) - mat(k,825) = .060_r8*rxt(k,443)*y(k,134) - mat(k,1166) = .280_r8*rxt(k,352)*y(k,134) - mat(k,1632) = mat(k,1632) + .530_r8*rxt(k,336)*y(k,209) + rxt(k,345)*y(k,211) & + mat(k,2058) = -rxt(k,292)*y(k,197) + mat(k,1939) = -rxt(k,293)*y(k,197) + mat(k,1833) = -rxt(k,294)*y(k,197) + mat(k,2185) = -rxt(k,305)*y(k,197) + mat(k,1313) = -rxt(k,332)*y(k,197) + mat(k,1260) = -rxt(k,365)*y(k,197) + mat(k,1292) = -rxt(k,370)*y(k,197) + mat(k,1197) = -rxt(k,379)*y(k,197) + mat(k,1175) = -rxt(k,390)*y(k,197) + mat(k,1007) = .060_r8*rxt(k,440)*y(k,134) + mat(k,1087) = rxt(k,288)*y(k,126) + rxt(k,289)*y(k,217) + mat(k,1222) = rxt(k,314)*y(k,126) + rxt(k,315)*y(k,217) + mat(k,612) = .500_r8*rxt(k,296)*y(k,217) + mat(k,850) = .080_r8*rxt(k,385)*y(k,134) + mat(k,1213) = .100_r8*rxt(k,338)*y(k,134) + mat(k,957) = .060_r8*rxt(k,443)*y(k,134) + mat(k,1334) = .280_r8*rxt(k,352)*y(k,134) + mat(k,1833) = mat(k,1833) + .530_r8*rxt(k,336)*y(k,209) + rxt(k,345)*y(k,211) & + rxt(k,348)*y(k,213) + rxt(k,323)*y(k,220) - mat(k,1977) = rxt(k,288)*y(k,45) + rxt(k,314)*y(k,49) + .530_r8*rxt(k,335) & + mat(k,1741) = rxt(k,288)*y(k,45) + rxt(k,314)*y(k,49) + .530_r8*rxt(k,335) & *y(k,209) + rxt(k,346)*y(k,211) - mat(k,2037) = .060_r8*rxt(k,440)*y(k,6) + .080_r8*rxt(k,385)*y(k,98) & + mat(k,2118) = .060_r8*rxt(k,440)*y(k,6) + .080_r8*rxt(k,385)*y(k,98) & + .100_r8*rxt(k,338)*y(k,105) + .060_r8*rxt(k,443)*y(k,110) & + .280_r8*rxt(k,352)*y(k,111) - mat(k,933) = .650_r8*rxt(k,461)*y(k,217) - mat(k,1264) = mat(k,1264) + .530_r8*rxt(k,332)*y(k,209) - mat(k,1683) = mat(k,1683) + .260_r8*rxt(k,333)*y(k,209) + rxt(k,342)*y(k,211) & + mat(k,1062) = .650_r8*rxt(k,461)*y(k,217) + mat(k,1386) = mat(k,1386) + .530_r8*rxt(k,332)*y(k,209) + mat(k,2058) = mat(k,2058) + .260_r8*rxt(k,333)*y(k,209) + rxt(k,342)*y(k,211) & + .300_r8*rxt(k,321)*y(k,220) - mat(k,1833) = mat(k,1833) + .450_r8*rxt(k,343)*y(k,211) + .200_r8*rxt(k,347) & + mat(k,1939) = mat(k,1939) + .450_r8*rxt(k,343)*y(k,211) + .200_r8*rxt(k,347) & *y(k,213) + .150_r8*rxt(k,322)*y(k,220) - mat(k,1189) = mat(k,1189) + .530_r8*rxt(k,336)*y(k,124) + .530_r8*rxt(k,335) & + mat(k,1313) = mat(k,1313) + .530_r8*rxt(k,336)*y(k,124) + .530_r8*rxt(k,335) & *y(k,126) + .530_r8*rxt(k,332)*y(k,197) + .260_r8*rxt(k,333) & *y(k,198) - mat(k,1234) = rxt(k,345)*y(k,124) + rxt(k,346)*y(k,126) + rxt(k,342)*y(k,198) & + mat(k,1355) = rxt(k,345)*y(k,124) + rxt(k,346)*y(k,126) + rxt(k,342)*y(k,198) & + .450_r8*rxt(k,343)*y(k,203) + 4.000_r8*rxt(k,344)*y(k,211) - mat(k,574) = rxt(k,348)*y(k,124) + .200_r8*rxt(k,347)*y(k,203) - mat(k,1501) = rxt(k,289)*y(k,45) + rxt(k,315)*y(k,49) + .500_r8*rxt(k,296) & + mat(k,679) = rxt(k,348)*y(k,124) + .200_r8*rxt(k,347)*y(k,203) + mat(k,1683) = rxt(k,289)*y(k,45) + rxt(k,315)*y(k,49) + .500_r8*rxt(k,296) & *y(k,51) + .650_r8*rxt(k,461)*y(k,178) - mat(k,1015) = rxt(k,323)*y(k,124) + .300_r8*rxt(k,321)*y(k,198) & + mat(k,1132) = rxt(k,323)*y(k,124) + .300_r8*rxt(k,321)*y(k,198) & + .150_r8*rxt(k,322)*y(k,203) - mat(k,1691) = -(rxt(k,181)*y(k,59) + (4._r8*rxt(k,258) + 4._r8*rxt(k,259) & - ) * y(k,198) + rxt(k,260)*y(k,203) + rxt(k,261)*y(k,124) & + mat(k,2070) = -(rxt(k,182)*y(k,59) + (4._r8*rxt(k,259) + 4._r8*rxt(k,260) & + ) * y(k,198) + rxt(k,261)*y(k,203) + rxt(k,262)*y(k,124) & + rxt(k,281)*y(k,194) + rxt(k,292)*y(k,197) + rxt(k,309) & *y(k,195) + rxt(k,321)*y(k,220) + rxt(k,333)*y(k,209) + rxt(k,342) & *y(k,211) + rxt(k,366)*y(k,205) + rxt(k,371)*y(k,206) + rxt(k,380) & *y(k,101) + rxt(k,391)*y(k,225) + rxt(k,445)*y(k,215) + rxt(k,450) & *y(k,221) + rxt(k,455)*y(k,222)) - mat(k,1332) = -rxt(k,181)*y(k,198) - mat(k,1842) = -rxt(k,260)*y(k,198) - mat(k,1641) = -rxt(k,261)*y(k,198) - mat(k,720) = -rxt(k,281)*y(k,198) - mat(k,1270) = -rxt(k,292)*y(k,198) - mat(k,692) = -rxt(k,309)*y(k,198) - mat(k,1019) = -rxt(k,321)*y(k,198) - mat(k,1195) = -rxt(k,333)*y(k,198) - mat(k,1240) = -rxt(k,342)*y(k,198) - mat(k,1222) = -rxt(k,366)*y(k,198) - mat(k,1152) = -rxt(k,371)*y(k,198) - mat(k,1082) = -rxt(k,380)*y(k,198) - mat(k,1059) = -rxt(k,391)*y(k,198) - mat(k,1005) = -rxt(k,445)*y(k,198) - mat(k,986) = -rxt(k,450)*y(k,198) - mat(k,966) = -rxt(k,455)*y(k,198) - mat(k,878) = .280_r8*rxt(k,308)*y(k,134) - mat(k,475) = rxt(k,295)*y(k,217) - mat(k,325) = .700_r8*rxt(k,263)*y(k,217) - mat(k,745) = .050_r8*rxt(k,385)*y(k,134) - mat(k,1082) = mat(k,1082) + rxt(k,379)*y(k,197) - mat(k,1641) = mat(k,1641) + rxt(k,294)*y(k,197) + .830_r8*rxt(k,411)*y(k,199) & + mat(k,1979) = -rxt(k,182)*y(k,198) + mat(k,1953) = -rxt(k,261)*y(k,198) + mat(k,1846) = -rxt(k,262)*y(k,198) + mat(k,821) = -rxt(k,281)*y(k,198) + mat(k,1394) = -rxt(k,292)*y(k,198) + mat(k,798) = -rxt(k,309)*y(k,198) + mat(k,1137) = -rxt(k,321)*y(k,198) + mat(k,1320) = -rxt(k,333)*y(k,198) + mat(k,1362) = -rxt(k,342)*y(k,198) + mat(k,1267) = -rxt(k,366)*y(k,198) + mat(k,1299) = -rxt(k,371)*y(k,198) + mat(k,1204) = -rxt(k,380)*y(k,198) + mat(k,1181) = -rxt(k,391)*y(k,198) + mat(k,1055) = -rxt(k,445)*y(k,198) + mat(k,1123) = -rxt(k,450)*y(k,198) + mat(k,920) = -rxt(k,455)*y(k,198) + mat(k,1036) = .280_r8*rxt(k,308)*y(k,134) + mat(k,687) = rxt(k,295)*y(k,217) + mat(k,389) = .700_r8*rxt(k,264)*y(k,217) + mat(k,1439) = rxt(k,176)*y(k,56) + rxt(k,232)*y(k,73) + rxt(k,271)*y(k,216) & + + rxt(k,265)*y(k,217) + mat(k,2018) = rxt(k,176)*y(k,54) + mat(k,871) = rxt(k,232)*y(k,54) + mat(k,855) = .050_r8*rxt(k,385)*y(k,134) + mat(k,1204) = mat(k,1204) + rxt(k,379)*y(k,197) + mat(k,1846) = mat(k,1846) + rxt(k,294)*y(k,197) + .830_r8*rxt(k,411)*y(k,199) & + .170_r8*rxt(k,417)*y(k,212) - mat(k,2046) = .280_r8*rxt(k,308)*y(k,29) + .050_r8*rxt(k,385)*y(k,98) - mat(k,1270) = mat(k,1270) + rxt(k,379)*y(k,101) + rxt(k,294)*y(k,124) & + mat(k,2131) = .280_r8*rxt(k,308)*y(k,29) + .050_r8*rxt(k,385)*y(k,98) + mat(k,1394) = mat(k,1394) + rxt(k,379)*y(k,101) + rxt(k,294)*y(k,124) & + 4.000_r8*rxt(k,291)*y(k,197) + .900_r8*rxt(k,292)*y(k,198) & + .450_r8*rxt(k,293)*y(k,203) + rxt(k,365)*y(k,205) + rxt(k,370) & *y(k,206) + rxt(k,332)*y(k,209) + rxt(k,341)*y(k,211) & + rxt(k,390)*y(k,225) - mat(k,1691) = mat(k,1691) + .900_r8*rxt(k,292)*y(k,197) - mat(k,655) = .830_r8*rxt(k,411)*y(k,124) + .330_r8*rxt(k,410)*y(k,203) - mat(k,1842) = mat(k,1842) + .450_r8*rxt(k,293)*y(k,197) + .330_r8*rxt(k,410) & + mat(k,2070) = mat(k,2070) + .900_r8*rxt(k,292)*y(k,197) + mat(k,765) = .830_r8*rxt(k,411)*y(k,124) + .330_r8*rxt(k,410)*y(k,203) + mat(k,1953) = mat(k,1953) + .450_r8*rxt(k,293)*y(k,197) + .330_r8*rxt(k,410) & *y(k,199) + .070_r8*rxt(k,416)*y(k,212) - mat(k,1222) = mat(k,1222) + rxt(k,365)*y(k,197) - mat(k,1152) = mat(k,1152) + rxt(k,370)*y(k,197) - mat(k,1195) = mat(k,1195) + rxt(k,332)*y(k,197) - mat(k,1240) = mat(k,1240) + rxt(k,341)*y(k,197) - mat(k,776) = .170_r8*rxt(k,417)*y(k,124) + .070_r8*rxt(k,416)*y(k,203) - mat(k,1510) = rxt(k,295)*y(k,50) + .700_r8*rxt(k,263)*y(k,53) - mat(k,1059) = mat(k,1059) + rxt(k,390)*y(k,197) - mat(k,649) = -(rxt(k,410)*y(k,203) + rxt(k,411)*y(k,124) + rxt(k,412) & + mat(k,1267) = mat(k,1267) + rxt(k,365)*y(k,197) + mat(k,1299) = mat(k,1299) + rxt(k,370)*y(k,197) + mat(k,1320) = mat(k,1320) + rxt(k,332)*y(k,197) + mat(k,1362) = mat(k,1362) + rxt(k,341)*y(k,197) + mat(k,880) = .170_r8*rxt(k,417)*y(k,124) + .070_r8*rxt(k,416)*y(k,203) + mat(k,1533) = rxt(k,271)*y(k,54) + mat(k,1697) = rxt(k,295)*y(k,50) + .700_r8*rxt(k,264)*y(k,53) + rxt(k,265) & + *y(k,54) + mat(k,1181) = mat(k,1181) + rxt(k,390)*y(k,197) + mat(k,759) = -(rxt(k,410)*y(k,203) + rxt(k,411)*y(k,124) + rxt(k,412) & *y(k,125)) - mat(k,1800) = -rxt(k,410)*y(k,199) - mat(k,1601) = -rxt(k,411)*y(k,199) - mat(k,1531) = -rxt(k,412)*y(k,199) - mat(k,477) = -((rxt(k,329) + rxt(k,330)) * y(k,124)) - mat(k,1590) = -(rxt(k,329) + rxt(k,330)) * y(k,200) - mat(k,285) = rxt(k,328)*y(k,217) - mat(k,1440) = rxt(k,328)*y(k,16) - mat(k,1575) = .750_r8*rxt(k,298)*y(k,202) - mat(k,603) = .750_r8*rxt(k,298)*y(k,124) - mat(k,604) = -(rxt(k,297)*y(k,203) + rxt(k,298)*y(k,124)) - mat(k,1796) = -rxt(k,297)*y(k,202) - mat(k,1597) = -rxt(k,298)*y(k,202) - mat(k,466) = rxt(k,304)*y(k,217) - mat(k,1454) = rxt(k,304)*y(k,25) - mat(k,1845) = -((rxt(k,134) + rxt(k,135) + rxt(k,136)) * y(k,76) + rxt(k,138) & - *y(k,133) + rxt(k,139)*y(k,134) + rxt(k,143)*y(k,217) & - + 4._r8*rxt(k,148)*y(k,203) + rxt(k,158)*y(k,126) + rxt(k,163) & - *y(k,124) + rxt(k,168)*y(k,125) + (rxt(k,178) + rxt(k,179) & - ) * y(k,56) + rxt(k,185)*y(k,59) + rxt(k,211)*y(k,17) + rxt(k,217) & - *y(k,19) + rxt(k,254)*y(k,42) + rxt(k,260)*y(k,198) + rxt(k,268) & + mat(k,1906) = -rxt(k,410)*y(k,199) + mat(k,1801) = -rxt(k,411)*y(k,199) + mat(k,2173) = -rxt(k,412)*y(k,199) + mat(k,564) = -((rxt(k,329) + rxt(k,330)) * y(k,124)) + mat(k,1790) = -(rxt(k,329) + rxt(k,330)) * y(k,200) + mat(k,350) = rxt(k,328)*y(k,217) + mat(k,1619) = rxt(k,328)*y(k,16) + mat(k,1775) = .750_r8*rxt(k,298)*y(k,202) + mat(k,713) = .750_r8*rxt(k,298)*y(k,124) + mat(k,714) = -(rxt(k,297)*y(k,203) + rxt(k,298)*y(k,124)) + mat(k,1902) = -rxt(k,297)*y(k,202) + mat(k,1797) = -rxt(k,298)*y(k,202) + mat(k,549) = rxt(k,304)*y(k,217) + mat(k,1636) = rxt(k,304)*y(k,25) + mat(k,1950) = -((rxt(k,135) + rxt(k,136) + rxt(k,137)) * y(k,76) + rxt(k,139) & + *y(k,133) + rxt(k,140)*y(k,134) + rxt(k,144)*y(k,217) & + + 4._r8*rxt(k,149)*y(k,203) + rxt(k,159)*y(k,126) + rxt(k,164) & + *y(k,124) + rxt(k,169)*y(k,125) + (rxt(k,179) + rxt(k,180) & + ) * y(k,56) + rxt(k,186)*y(k,59) + rxt(k,212)*y(k,17) + rxt(k,218) & + *y(k,19) + rxt(k,255)*y(k,42) + rxt(k,261)*y(k,198) + rxt(k,268) & *y(k,204) + rxt(k,282)*y(k,194) + rxt(k,293)*y(k,197) + rxt(k,297) & *y(k,202) + rxt(k,310)*y(k,195) + rxt(k,318)*y(k,219) + rxt(k,322) & *y(k,220) + rxt(k,334)*y(k,209) + rxt(k,343)*y(k,211) + rxt(k,347) & @@ -1617,88 +1811,92 @@ subroutine nlnmat07( avec_len, mat, y, rxt ) *y(k,212) + rxt(k,419)*y(k,218) + rxt(k,426)*y(k,223) + rxt(k,432) & *y(k,226) + rxt(k,435)*y(k,228) + rxt(k,446)*y(k,215) + rxt(k,451) & *y(k,221) + rxt(k,456)*y(k,222)) - mat(k,1309) = -(rxt(k,134) + rxt(k,135) + rxt(k,136)) * y(k,203) - mat(k,1875) = -rxt(k,138)*y(k,203) - mat(k,2049) = -rxt(k,139)*y(k,203) - mat(k,1513) = -rxt(k,143)*y(k,203) - mat(k,1989) = -rxt(k,158)*y(k,203) - mat(k,1644) = -rxt(k,163)*y(k,203) - mat(k,1554) = -rxt(k,168)*y(k,203) - mat(k,1932) = -(rxt(k,178) + rxt(k,179)) * y(k,203) - mat(k,1335) = -rxt(k,185)*y(k,203) - mat(k,1284) = -rxt(k,211)*y(k,203) - mat(k,1718) = -rxt(k,217)*y(k,203) - mat(k,1740) = -rxt(k,254)*y(k,203) - mat(k,1694) = -rxt(k,260)*y(k,203) - mat(k,371) = -rxt(k,268)*y(k,203) - mat(k,722) = -rxt(k,282)*y(k,203) - mat(k,1272) = -rxt(k,293)*y(k,203) - mat(k,610) = -rxt(k,297)*y(k,203) - mat(k,694) = -rxt(k,310)*y(k,203) - mat(k,665) = -rxt(k,318)*y(k,203) - mat(k,1021) = -rxt(k,322)*y(k,203) - mat(k,1197) = -rxt(k,334)*y(k,203) - mat(k,1242) = -rxt(k,343)*y(k,203) - mat(k,578) = -rxt(k,347)*y(k,203) - mat(k,846) = -rxt(k,357)*y(k,203) - mat(k,1224) = -rxt(k,367)*y(k,203) - mat(k,1154) = -rxt(k,372)*y(k,203) - mat(k,1084) = -rxt(k,381)*y(k,203) - mat(k,1061) = -rxt(k,392)*y(k,203) - mat(k,434) = -rxt(k,396)*y(k,203) - mat(k,408) = -rxt(k,399)*y(k,203) - mat(k,365) = -rxt(k,403)*y(k,203) - mat(k,534) = -rxt(k,406)*y(k,203) - mat(k,656) = -rxt(k,410)*y(k,203) - mat(k,616) = -rxt(k,413)*y(k,203) - mat(k,777) = -rxt(k,416)*y(k,203) - mat(k,378) = -rxt(k,419)*y(k,203) - mat(k,631) = -rxt(k,426)*y(k,203) - mat(k,648) = -rxt(k,432)*y(k,203) - mat(k,416) = -rxt(k,435)*y(k,203) - mat(k,1007) = -rxt(k,446)*y(k,203) - mat(k,988) = -rxt(k,451)*y(k,203) - mat(k,968) = -rxt(k,456)*y(k,203) - mat(k,801) = .570_r8*rxt(k,440)*y(k,134) - mat(k,118) = .650_r8*rxt(k,398)*y(k,217) - mat(k,1284) = mat(k,1284) + rxt(k,210)*y(k,42) - mat(k,1718) = mat(k,1718) + rxt(k,222)*y(k,217) - mat(k,230) = .350_r8*rxt(k,277)*y(k,217) - mat(k,471) = .130_r8*rxt(k,279)*y(k,134) - mat(k,201) = rxt(k,284)*y(k,217) - mat(k,880) = .280_r8*rxt(k,308)*y(k,134) - mat(k,1740) = mat(k,1740) + rxt(k,210)*y(k,17) + rxt(k,174)*y(k,56) & - + rxt(k,255)*y(k,126) + rxt(k,256)*y(k,133) - mat(k,89) = rxt(k,290)*y(k,217) - mat(k,699) = rxt(k,262)*y(k,217) - mat(k,1932) = mat(k,1932) + rxt(k,174)*y(k,42) + rxt(k,177)*y(k,79) - mat(k,1335) = mat(k,1335) + rxt(k,181)*y(k,198) + rxt(k,192)*y(k,217) - mat(k,942) = rxt(k,265)*y(k,217) - mat(k,150) = .730_r8*rxt(k,409)*y(k,217) - mat(k,214) = .500_r8*rxt(k,476)*y(k,217) - mat(k,912) = rxt(k,301)*y(k,217) - mat(k,768) = rxt(k,302)*y(k,217) - mat(k,499) = rxt(k,177)*y(k,56) + rxt(k,133)*y(k,133) + rxt(k,142)*y(k,217) - mat(k,133) = rxt(k,266)*y(k,217) - mat(k,702) = rxt(k,267)*y(k,217) - mat(k,927) = rxt(k,331)*y(k,217) - mat(k,948) = rxt(k,316)*y(k,217) - mat(k,747) = .370_r8*rxt(k,385)*y(k,134) - mat(k,521) = .300_r8*rxt(k,376)*y(k,217) - mat(k,464) = rxt(k,377)*y(k,217) - mat(k,1084) = mat(k,1084) + rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126) & + mat(k,1468) = -(rxt(k,135) + rxt(k,136) + rxt(k,137)) * y(k,203) + mat(k,2250) = -rxt(k,139)*y(k,203) + mat(k,2128) = -rxt(k,140)*y(k,203) + mat(k,1694) = -rxt(k,144)*y(k,203) + mat(k,1751) = -rxt(k,159)*y(k,203) + mat(k,1843) = -rxt(k,164)*y(k,203) + mat(k,2195) = -rxt(k,169)*y(k,203) + mat(k,2015) = -(rxt(k,179) + rxt(k,180)) * y(k,203) + mat(k,1976) = -rxt(k,186)*y(k,203) + mat(k,1420) = -rxt(k,212)*y(k,203) + mat(k,2219) = -rxt(k,218)*y(k,203) + mat(k,1490) = -rxt(k,255)*y(k,203) + mat(k,2067) = -rxt(k,261)*y(k,203) + mat(k,445) = -rxt(k,268)*y(k,203) + mat(k,820) = -rxt(k,282)*y(k,203) + mat(k,1393) = -rxt(k,293)*y(k,203) + mat(k,719) = -rxt(k,297)*y(k,203) + mat(k,797) = -rxt(k,310)*y(k,203) + mat(k,774) = -rxt(k,318)*y(k,203) + mat(k,1136) = -rxt(k,322)*y(k,203) + mat(k,1319) = -rxt(k,334)*y(k,203) + mat(k,1361) = -rxt(k,343)*y(k,203) + mat(k,682) = -rxt(k,347)*y(k,203) + mat(k,906) = -rxt(k,357)*y(k,203) + mat(k,1266) = -rxt(k,367)*y(k,203) + mat(k,1298) = -rxt(k,372)*y(k,203) + mat(k,1203) = -rxt(k,381)*y(k,203) + mat(k,1180) = -rxt(k,392)*y(k,203) + mat(k,522) = -rxt(k,396)*y(k,203) + mat(k,488) = -rxt(k,399)*y(k,203) + mat(k,439) = -rxt(k,403)*y(k,203) + mat(k,628) = -rxt(k,406)*y(k,203) + mat(k,764) = -rxt(k,410)*y(k,203) + mat(k,725) = -rxt(k,413)*y(k,203) + mat(k,879) = -rxt(k,416)*y(k,203) + mat(k,458) = -rxt(k,419)*y(k,203) + mat(k,740) = -rxt(k,426)*y(k,203) + mat(k,757) = -rxt(k,432)*y(k,203) + mat(k,504) = -rxt(k,435)*y(k,203) + mat(k,1054) = -rxt(k,446)*y(k,203) + mat(k,1122) = -rxt(k,451)*y(k,203) + mat(k,919) = -rxt(k,456)*y(k,203) + mat(k,1013) = .570_r8*rxt(k,440)*y(k,134) + mat(k,169) = .650_r8*rxt(k,398)*y(k,217) + mat(k,1420) = mat(k,1420) + rxt(k,211)*y(k,42) + mat(k,2219) = mat(k,2219) + rxt(k,223)*y(k,217) + mat(k,290) = .350_r8*rxt(k,277)*y(k,217) + mat(k,554) = .130_r8*rxt(k,279)*y(k,134) + mat(k,264) = rxt(k,284)*y(k,217) + mat(k,1035) = .280_r8*rxt(k,308)*y(k,134) + mat(k,1490) = mat(k,1490) + rxt(k,211)*y(k,17) + rxt(k,175)*y(k,56) & + + rxt(k,256)*y(k,126) + rxt(k,257)*y(k,133) + mat(k,598) = rxt(k,240)*y(k,56) + rxt(k,241)*y(k,217) + mat(k,368) = rxt(k,243)*y(k,56) + rxt(k,244)*y(k,217) + mat(k,104) = rxt(k,290)*y(k,217) + mat(k,789) = rxt(k,263)*y(k,217) + mat(k,1437) = rxt(k,272)*y(k,216) + mat(k,2015) = mat(k,2015) + rxt(k,175)*y(k,42) + rxt(k,240)*y(k,43) & + + rxt(k,243)*y(k,46) + rxt(k,178)*y(k,79) + mat(k,1976) = mat(k,1976) + rxt(k,182)*y(k,198) + rxt(k,193)*y(k,217) + mat(k,1105) = rxt(k,275)*y(k,217) + mat(k,198) = .730_r8*rxt(k,409)*y(k,217) + mat(k,302) = .500_r8*rxt(k,477)*y(k,217) + mat(k,1100) = rxt(k,301)*y(k,217) + mat(k,982) = rxt(k,302)*y(k,217) + mat(k,605) = rxt(k,178)*y(k,56) + rxt(k,134)*y(k,133) + rxt(k,143)*y(k,217) + mat(k,182) = rxt(k,266)*y(k,217) + mat(k,932) = rxt(k,267)*y(k,217) + mat(k,1161) = rxt(k,331)*y(k,217) + mat(k,1145) = rxt(k,316)*y(k,217) + mat(k,854) = .370_r8*rxt(k,385)*y(k,134) + mat(k,588) = .300_r8*rxt(k,376)*y(k,217) + mat(k,563) = rxt(k,377)*y(k,217) + mat(k,1203) = mat(k,1203) + rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126) & + rxt(k,379)*y(k,197) + 1.200_r8*rxt(k,380)*y(k,198) - mat(k,333) = rxt(k,384)*y(k,217) - mat(k,1096) = .140_r8*rxt(k,338)*y(k,134) - mat(k,241) = .200_r8*rxt(k,340)*y(k,217) - mat(k,491) = .500_r8*rxt(k,351)*y(k,217) - mat(k,828) = .570_r8*rxt(k,443)*y(k,134) - mat(k,1174) = .280_r8*rxt(k,352)*y(k,134) - mat(k,303) = rxt(k,388)*y(k,217) - mat(k,906) = rxt(k,389)*y(k,217) - mat(k,1644) = mat(k,1644) + rxt(k,382)*y(k,101) + rxt(k,358)*y(k,189) & + mat(k,401) = rxt(k,384)*y(k,217) + mat(k,1216) = .140_r8*rxt(k,338)*y(k,134) + mat(k,314) = .200_r8*rxt(k,340)*y(k,217) + mat(k,579) = .500_r8*rxt(k,351)*y(k,217) + mat(k,963) = .570_r8*rxt(k,443)*y(k,134) + mat(k,1341) = .280_r8*rxt(k,352)*y(k,134) + mat(k,378) = rxt(k,388)*y(k,217) + mat(k,1081) = rxt(k,389)*y(k,217) + mat(k,1843) = mat(k,1843) + rxt(k,382)*y(k,101) + rxt(k,358)*y(k,189) & + rxt(k,400)*y(k,191) + rxt(k,405)*y(k,193) + rxt(k,283) & - *y(k,194) + rxt(k,311)*y(k,195) + rxt(k,261)*y(k,198) & + *y(k,194) + rxt(k,311)*y(k,195) + rxt(k,262)*y(k,198) & + .170_r8*rxt(k,411)*y(k,199) + rxt(k,329)*y(k,200) & + .250_r8*rxt(k,298)*y(k,202) + rxt(k,270)*y(k,204) & + .920_r8*rxt(k,368)*y(k,205) + .920_r8*rxt(k,374)*y(k,206) & @@ -1707,83 +1905,85 @@ subroutine nlnmat07( avec_len, mat, y, rxt ) *y(k,219) + .900_r8*rxt(k,452)*y(k,221) + .800_r8*rxt(k,457) & *y(k,222) + rxt(k,427)*y(k,223) + rxt(k,393)*y(k,225) & + rxt(k,433)*y(k,226) + rxt(k,436)*y(k,228) - mat(k,1989) = mat(k,1989) + rxt(k,255)*y(k,42) + rxt(k,383)*y(k,101) & + mat(k,1751) = mat(k,1751) + rxt(k,256)*y(k,42) + rxt(k,383)*y(k,101) & + rxt(k,369)*y(k,205) + rxt(k,375)*y(k,206) + .470_r8*rxt(k,335) & - *y(k,209) + rxt(k,161)*y(k,217) + rxt(k,394)*y(k,225) - mat(k,1875) = mat(k,1875) + rxt(k,256)*y(k,42) + rxt(k,133)*y(k,79) - mat(k,2049) = mat(k,2049) + .570_r8*rxt(k,440)*y(k,6) + .130_r8*rxt(k,279) & + *y(k,209) + rxt(k,162)*y(k,217) + rxt(k,394)*y(k,225) + mat(k,2250) = mat(k,2250) + rxt(k,257)*y(k,42) + rxt(k,134)*y(k,79) + mat(k,2128) = mat(k,2128) + .570_r8*rxt(k,440)*y(k,6) + .130_r8*rxt(k,279) & *y(k,25) + .280_r8*rxt(k,308)*y(k,29) + .370_r8*rxt(k,385) & *y(k,98) + .140_r8*rxt(k,338)*y(k,105) + .570_r8*rxt(k,443) & - *y(k,110) + .280_r8*rxt(k,352)*y(k,111) + rxt(k,145)*y(k,217) - mat(k,127) = .800_r8*rxt(k,421)*y(k,217) - mat(k,761) = rxt(k,477)*y(k,217) - mat(k,937) = .200_r8*rxt(k,461)*y(k,217) - mat(k,145) = .280_r8*rxt(k,429)*y(k,217) - mat(k,167) = .380_r8*rxt(k,431)*y(k,217) - mat(k,172) = .630_r8*rxt(k,437)*y(k,217) - mat(k,846) = mat(k,846) + rxt(k,358)*y(k,124) - mat(k,408) = mat(k,408) + rxt(k,400)*y(k,124) - mat(k,365) = mat(k,365) + rxt(k,405)*y(k,124) - mat(k,722) = mat(k,722) + rxt(k,283)*y(k,124) + 2.400_r8*rxt(k,280)*y(k,194) & + *y(k,110) + .280_r8*rxt(k,352)*y(k,111) + rxt(k,146)*y(k,217) + mat(k,178) = .800_r8*rxt(k,421)*y(k,217) + mat(k,835) = rxt(k,467)*y(k,217) + mat(k,1065) = .200_r8*rxt(k,461)*y(k,217) + mat(k,193) = .280_r8*rxt(k,429)*y(k,217) + mat(k,215) = .380_r8*rxt(k,431)*y(k,217) + mat(k,220) = .630_r8*rxt(k,437)*y(k,217) + mat(k,906) = mat(k,906) + rxt(k,358)*y(k,124) + mat(k,488) = mat(k,488) + rxt(k,400)*y(k,124) + mat(k,439) = mat(k,439) + rxt(k,405)*y(k,124) + mat(k,820) = mat(k,820) + rxt(k,283)*y(k,124) + 2.400_r8*rxt(k,280)*y(k,194) & + rxt(k,281)*y(k,198) - mat(k,694) = mat(k,694) + rxt(k,311)*y(k,124) + rxt(k,309)*y(k,198) - mat(k,1272) = mat(k,1272) + rxt(k,379)*y(k,101) + .900_r8*rxt(k,292)*y(k,198) & + mat(k,797) = mat(k,797) + rxt(k,311)*y(k,124) + rxt(k,309)*y(k,198) + mat(k,1393) = mat(k,1393) + rxt(k,379)*y(k,101) + .900_r8*rxt(k,292)*y(k,198) & + rxt(k,365)*y(k,205) + rxt(k,370)*y(k,206) + .470_r8*rxt(k,332) & *y(k,209) + rxt(k,390)*y(k,225) - mat(k,1694) = mat(k,1694) + rxt(k,181)*y(k,59) + 1.200_r8*rxt(k,380)*y(k,101) & - + rxt(k,261)*y(k,124) + rxt(k,281)*y(k,194) + rxt(k,309) & - *y(k,195) + .900_r8*rxt(k,292)*y(k,197) + 4.000_r8*rxt(k,258) & + mat(k,2067) = mat(k,2067) + rxt(k,182)*y(k,59) + 1.200_r8*rxt(k,380)*y(k,101) & + + rxt(k,262)*y(k,124) + rxt(k,281)*y(k,194) + rxt(k,309) & + *y(k,195) + .900_r8*rxt(k,292)*y(k,197) + 4.000_r8*rxt(k,259) & *y(k,198) + rxt(k,366)*y(k,205) + rxt(k,371)*y(k,206) & + .730_r8*rxt(k,333)*y(k,209) + rxt(k,342)*y(k,211) & + .500_r8*rxt(k,445)*y(k,215) + .300_r8*rxt(k,321)*y(k,220) & + rxt(k,450)*y(k,221) + rxt(k,455)*y(k,222) + .800_r8*rxt(k,391) & *y(k,225) - mat(k,656) = mat(k,656) + .170_r8*rxt(k,411)*y(k,124) + .070_r8*rxt(k,410) & + mat(k,764) = mat(k,764) + .170_r8*rxt(k,411)*y(k,124) + .070_r8*rxt(k,410) & *y(k,203) - mat(k,484) = rxt(k,329)*y(k,124) - mat(k,610) = mat(k,610) + .250_r8*rxt(k,298)*y(k,124) - mat(k,1845) = mat(k,1845) + .070_r8*rxt(k,410)*y(k,199) + .160_r8*rxt(k,413) & + mat(k,570) = rxt(k,329)*y(k,124) + mat(k,719) = mat(k,719) + .250_r8*rxt(k,298)*y(k,124) + mat(k,1950) = mat(k,1950) + .070_r8*rxt(k,410)*y(k,199) + .160_r8*rxt(k,413) & *y(k,210) + .330_r8*rxt(k,416)*y(k,212) - mat(k,371) = mat(k,371) + rxt(k,270)*y(k,124) - mat(k,1224) = mat(k,1224) + .920_r8*rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126) & + mat(k,445) = mat(k,445) + rxt(k,270)*y(k,124) + mat(k,1266) = mat(k,1266) + .920_r8*rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126) & + rxt(k,365)*y(k,197) + rxt(k,366)*y(k,198) - mat(k,1154) = mat(k,1154) + .920_r8*rxt(k,374)*y(k,124) + rxt(k,375)*y(k,126) & + mat(k,1298) = mat(k,1298) + .920_r8*rxt(k,374)*y(k,124) + rxt(k,375)*y(k,126) & + rxt(k,370)*y(k,197) + rxt(k,371)*y(k,198) - mat(k,1197) = mat(k,1197) + .470_r8*rxt(k,336)*y(k,124) + .470_r8*rxt(k,335) & + mat(k,1319) = mat(k,1319) + .470_r8*rxt(k,336)*y(k,124) + .470_r8*rxt(k,335) & *y(k,126) + .470_r8*rxt(k,332)*y(k,197) + .730_r8*rxt(k,333) & *y(k,198) - mat(k,616) = mat(k,616) + .400_r8*rxt(k,414)*y(k,124) + .160_r8*rxt(k,413) & + mat(k,725) = mat(k,725) + .400_r8*rxt(k,414)*y(k,124) + .160_r8*rxt(k,413) & *y(k,203) - mat(k,1242) = mat(k,1242) + rxt(k,342)*y(k,198) - mat(k,777) = mat(k,777) + .830_r8*rxt(k,417)*y(k,124) + .330_r8*rxt(k,416) & + mat(k,1361) = mat(k,1361) + rxt(k,342)*y(k,198) + mat(k,879) = mat(k,879) + .830_r8*rxt(k,417)*y(k,124) + .330_r8*rxt(k,416) & *y(k,203) - mat(k,1007) = mat(k,1007) + .500_r8*rxt(k,445)*y(k,198) - mat(k,1513) = mat(k,1513) + .650_r8*rxt(k,398)*y(k,7) + rxt(k,222)*y(k,19) & - + .350_r8*rxt(k,277)*y(k,24) + rxt(k,284)*y(k,26) + rxt(k,290) & - *y(k,47) + rxt(k,262)*y(k,52) + rxt(k,192)*y(k,59) + rxt(k,265) & - *y(k,62) + .730_r8*rxt(k,409)*y(k,66) + .500_r8*rxt(k,476) & - *y(k,67) + rxt(k,301)*y(k,74) + rxt(k,302)*y(k,75) + rxt(k,142) & - *y(k,79) + rxt(k,266)*y(k,86) + rxt(k,267)*y(k,87) + rxt(k,331) & - *y(k,93) + rxt(k,316)*y(k,95) + .300_r8*rxt(k,376)*y(k,99) & - + rxt(k,377)*y(k,100) + rxt(k,384)*y(k,102) + .200_r8*rxt(k,340) & - *y(k,106) + .500_r8*rxt(k,351)*y(k,109) + rxt(k,388)*y(k,115) & - + rxt(k,389)*y(k,116) + rxt(k,161)*y(k,126) + rxt(k,145) & - *y(k,134) + .800_r8*rxt(k,421)*y(k,142) + rxt(k,477)*y(k,151) & + mat(k,1054) = mat(k,1054) + .500_r8*rxt(k,445)*y(k,198) + mat(k,1530) = rxt(k,272)*y(k,54) + mat(k,1694) = mat(k,1694) + .650_r8*rxt(k,398)*y(k,7) + rxt(k,223)*y(k,19) & + + .350_r8*rxt(k,277)*y(k,24) + rxt(k,284)*y(k,26) + rxt(k,241) & + *y(k,43) + rxt(k,244)*y(k,46) + rxt(k,290)*y(k,47) + rxt(k,263) & + *y(k,52) + rxt(k,193)*y(k,59) + rxt(k,275)*y(k,62) & + + .730_r8*rxt(k,409)*y(k,66) + .500_r8*rxt(k,477)*y(k,67) & + + rxt(k,301)*y(k,74) + rxt(k,302)*y(k,75) + rxt(k,143)*y(k,79) & + + rxt(k,266)*y(k,86) + rxt(k,267)*y(k,87) + rxt(k,331)*y(k,93) & + + rxt(k,316)*y(k,95) + .300_r8*rxt(k,376)*y(k,99) + rxt(k,377) & + *y(k,100) + rxt(k,384)*y(k,102) + .200_r8*rxt(k,340)*y(k,106) & + + .500_r8*rxt(k,351)*y(k,109) + rxt(k,388)*y(k,115) + rxt(k,389) & + *y(k,116) + rxt(k,162)*y(k,126) + rxt(k,146)*y(k,134) & + + .800_r8*rxt(k,421)*y(k,142) + rxt(k,467)*y(k,151) & + .200_r8*rxt(k,461)*y(k,178) + .280_r8*rxt(k,429)*y(k,180) & + .380_r8*rxt(k,431)*y(k,182) + .630_r8*rxt(k,437)*y(k,184) - mat(k,378) = mat(k,378) + rxt(k,420)*y(k,124) - mat(k,665) = mat(k,665) + rxt(k,319)*y(k,124) - mat(k,1021) = mat(k,1021) + .300_r8*rxt(k,321)*y(k,198) - mat(k,988) = mat(k,988) + .900_r8*rxt(k,452)*y(k,124) + rxt(k,450)*y(k,198) - mat(k,968) = mat(k,968) + .800_r8*rxt(k,457)*y(k,124) + rxt(k,455)*y(k,198) - mat(k,631) = mat(k,631) + rxt(k,427)*y(k,124) - mat(k,1061) = mat(k,1061) + rxt(k,393)*y(k,124) + rxt(k,394)*y(k,126) & + mat(k,458) = mat(k,458) + rxt(k,420)*y(k,124) + mat(k,774) = mat(k,774) + rxt(k,319)*y(k,124) + mat(k,1136) = mat(k,1136) + .300_r8*rxt(k,321)*y(k,198) + mat(k,1122) = mat(k,1122) + .900_r8*rxt(k,452)*y(k,124) + rxt(k,450)*y(k,198) + mat(k,919) = mat(k,919) + .800_r8*rxt(k,457)*y(k,124) + rxt(k,455)*y(k,198) + mat(k,740) = mat(k,740) + rxt(k,427)*y(k,124) + mat(k,1180) = mat(k,1180) + rxt(k,393)*y(k,124) + rxt(k,394)*y(k,126) & + rxt(k,390)*y(k,197) + .800_r8*rxt(k,391)*y(k,198) - mat(k,648) = mat(k,648) + rxt(k,433)*y(k,124) - mat(k,416) = mat(k,416) + rxt(k,436)*y(k,124) + mat(k,757) = mat(k,757) + rxt(k,433)*y(k,124) + mat(k,504) = mat(k,504) + rxt(k,436)*y(k,124) end do - end subroutine nlnmat07 - subroutine nlnmat08( avec_len, mat, y, rxt ) + end subroutine nlnmat08 + subroutine nlnmat09( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -1801,295 +2001,331 @@ subroutine nlnmat08( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,366) = -(rxt(k,268)*y(k,203) + rxt(k,270)*y(k,124)) - mat(k,1777) = -rxt(k,268)*y(k,204) - mat(k,1581) = -rxt(k,270)*y(k,204) - mat(k,1725) = rxt(k,254)*y(k,203) - mat(k,1777) = mat(k,1777) + rxt(k,254)*y(k,42) - mat(k,1214) = -(rxt(k,365)*y(k,197) + rxt(k,366)*y(k,198) + rxt(k,367) & + mat(k,441) = -(rxt(k,268)*y(k,203) + rxt(k,270)*y(k,124)) + mat(k,1883) = -rxt(k,268)*y(k,204) + mat(k,1780) = -rxt(k,270)*y(k,204) + mat(k,1476) = rxt(k,255)*y(k,203) + mat(k,1883) = mat(k,1883) + rxt(k,255)*y(k,42) + mat(k,1256) = -(rxt(k,365)*y(k,197) + rxt(k,366)*y(k,198) + rxt(k,367) & *y(k,203) + rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126)) - mat(k,1262) = -rxt(k,365)*y(k,205) - mat(k,1681) = -rxt(k,366)*y(k,205) - mat(k,1831) = -rxt(k,367)*y(k,205) - mat(k,1630) = -rxt(k,368)*y(k,205) - mat(k,1975) = -rxt(k,369)*y(k,205) - mat(k,742) = .600_r8*rxt(k,386)*y(k,217) - mat(k,1499) = .600_r8*rxt(k,386)*y(k,98) - mat(k,1142) = -(rxt(k,370)*y(k,197) + rxt(k,371)*y(k,198) + rxt(k,372) & + mat(k,1381) = -rxt(k,365)*y(k,205) + mat(k,2053) = -rxt(k,366)*y(k,205) + mat(k,1934) = -rxt(k,367)*y(k,205) + mat(k,1828) = -rxt(k,368)*y(k,205) + mat(k,1736) = -rxt(k,369)*y(k,205) + mat(k,847) = .600_r8*rxt(k,386)*y(k,217) + mat(k,1678) = .600_r8*rxt(k,386)*y(k,98) + mat(k,1288) = -(rxt(k,370)*y(k,197) + rxt(k,371)*y(k,198) + rxt(k,372) & *y(k,203) + rxt(k,374)*y(k,124) + rxt(k,375)*y(k,126)) - mat(k,1259) = -rxt(k,370)*y(k,206) - mat(k,1678) = -rxt(k,371)*y(k,206) - mat(k,1828) = -rxt(k,372)*y(k,206) - mat(k,1627) = -rxt(k,374)*y(k,206) - mat(k,1972) = -rxt(k,375)*y(k,206) - mat(k,740) = .400_r8*rxt(k,386)*y(k,217) - mat(k,1496) = .400_r8*rxt(k,386)*y(k,98) - mat(k,57) = -(rxt(k,503)*y(k,203) + rxt(k,504)*y(k,124)) - mat(k,1754) = -rxt(k,503)*y(k,207) - mat(k,1568) = -rxt(k,504)*y(k,207) - mat(k,733) = rxt(k,506)*y(k,217) - mat(k,1374) = rxt(k,506)*y(k,98) - mat(k,63) = -(rxt(k,507)*y(k,203) + rxt(k,508)*y(k,124)) - mat(k,1755) = -rxt(k,507)*y(k,208) - mat(k,1569) = -rxt(k,508)*y(k,208) - mat(k,64) = rxt(k,509)*y(k,217) - mat(k,1375) = rxt(k,509)*y(k,104) - mat(k,1187) = -(rxt(k,332)*y(k,197) + rxt(k,333)*y(k,198) + rxt(k,334) & + mat(k,1382) = -rxt(k,370)*y(k,206) + mat(k,2054) = -rxt(k,371)*y(k,206) + mat(k,1935) = -rxt(k,372)*y(k,206) + mat(k,1829) = -rxt(k,374)*y(k,206) + mat(k,1737) = -rxt(k,375)*y(k,206) + mat(k,848) = .400_r8*rxt(k,386)*y(k,217) + mat(k,1679) = .400_r8*rxt(k,386)*y(k,98) + mat(k,66) = -(rxt(k,503)*y(k,203) + rxt(k,504)*y(k,124)) + mat(k,1860) = -rxt(k,503)*y(k,207) + mat(k,1768) = -rxt(k,504)*y(k,207) + mat(k,840) = rxt(k,506)*y(k,217) + mat(k,1548) = rxt(k,506)*y(k,98) + mat(k,72) = -(rxt(k,507)*y(k,203) + rxt(k,508)*y(k,124)) + mat(k,1861) = -rxt(k,507)*y(k,208) + mat(k,1769) = -rxt(k,508)*y(k,208) + mat(k,73) = rxt(k,509)*y(k,217) + mat(k,1549) = rxt(k,509)*y(k,104) + mat(k,1311) = -(rxt(k,332)*y(k,197) + rxt(k,333)*y(k,198) + rxt(k,334) & *y(k,203) + rxt(k,335)*y(k,126) + (rxt(k,336) + rxt(k,337) & ) * y(k,124)) - mat(k,1261) = -rxt(k,332)*y(k,209) - mat(k,1680) = -rxt(k,333)*y(k,209) - mat(k,1830) = -rxt(k,334)*y(k,209) - mat(k,1974) = -rxt(k,335)*y(k,209) - mat(k,1629) = -(rxt(k,336) + rxt(k,337)) * y(k,209) - mat(k,1090) = .500_r8*rxt(k,339)*y(k,217) - mat(k,238) = .200_r8*rxt(k,340)*y(k,217) - mat(k,1165) = rxt(k,353)*y(k,217) - mat(k,1498) = .500_r8*rxt(k,339)*y(k,105) + .200_r8*rxt(k,340)*y(k,106) & + mat(k,1383) = -rxt(k,332)*y(k,209) + mat(k,2055) = -rxt(k,333)*y(k,209) + mat(k,1936) = -rxt(k,334)*y(k,209) + mat(k,1738) = -rxt(k,335)*y(k,209) + mat(k,1830) = -(rxt(k,336) + rxt(k,337)) * y(k,209) + mat(k,1211) = .500_r8*rxt(k,339)*y(k,217) + mat(k,311) = .200_r8*rxt(k,340)*y(k,217) + mat(k,1331) = rxt(k,353)*y(k,217) + mat(k,1680) = .500_r8*rxt(k,339)*y(k,105) + .200_r8*rxt(k,340)*y(k,106) & + rxt(k,353)*y(k,111) - mat(k,611) = -(rxt(k,413)*y(k,203) + rxt(k,414)*y(k,124) + rxt(k,415) & + mat(k,721) = -(rxt(k,413)*y(k,203) + rxt(k,414)*y(k,124) + rxt(k,415) & *y(k,125)) - mat(k,1797) = -rxt(k,413)*y(k,210) - mat(k,1598) = -rxt(k,414)*y(k,210) - mat(k,1530) = -rxt(k,415)*y(k,210) - mat(k,1233) = -(rxt(k,341)*y(k,197) + rxt(k,342)*y(k,198) + rxt(k,343) & + mat(k,1903) = -rxt(k,413)*y(k,210) + mat(k,1798) = -rxt(k,414)*y(k,210) + mat(k,2172) = -rxt(k,415)*y(k,210) + mat(k,1354) = -(rxt(k,341)*y(k,197) + rxt(k,342)*y(k,198) + rxt(k,343) & *y(k,203) + 4._r8*rxt(k,344)*y(k,211) + rxt(k,345)*y(k,124) & + rxt(k,346)*y(k,126) + rxt(k,354)*y(k,125)) - mat(k,1263) = -rxt(k,341)*y(k,211) - mat(k,1682) = -rxt(k,342)*y(k,211) - mat(k,1832) = -rxt(k,343)*y(k,211) - mat(k,1631) = -rxt(k,345)*y(k,211) - mat(k,1976) = -rxt(k,346)*y(k,211) - mat(k,1541) = -rxt(k,354)*y(k,211) - mat(k,1091) = .500_r8*rxt(k,339)*y(k,217) - mat(k,239) = .500_r8*rxt(k,340)*y(k,217) - mat(k,1500) = .500_r8*rxt(k,339)*y(k,105) + .500_r8*rxt(k,340)*y(k,106) - mat(k,770) = -(rxt(k,416)*y(k,203) + rxt(k,417)*y(k,124) + rxt(k,418) & + mat(k,1385) = -rxt(k,341)*y(k,211) + mat(k,2057) = -rxt(k,342)*y(k,211) + mat(k,1938) = -rxt(k,343)*y(k,211) + mat(k,1832) = -rxt(k,345)*y(k,211) + mat(k,1740) = -rxt(k,346)*y(k,211) + mat(k,2184) = -rxt(k,354)*y(k,211) + mat(k,1212) = .500_r8*rxt(k,339)*y(k,217) + mat(k,312) = .500_r8*rxt(k,340)*y(k,217) + mat(k,1682) = .500_r8*rxt(k,339)*y(k,105) + .500_r8*rxt(k,340)*y(k,106) + mat(k,873) = -(rxt(k,416)*y(k,203) + rxt(k,417)*y(k,124) + rxt(k,418) & *y(k,125)) - mat(k,1810) = -rxt(k,416)*y(k,212) - mat(k,1608) = -rxt(k,417)*y(k,212) - mat(k,1535) = -rxt(k,418)*y(k,212) - mat(k,572) = -(rxt(k,347)*y(k,203) + rxt(k,348)*y(k,124)) - mat(k,1793) = -rxt(k,347)*y(k,213) - mat(k,1596) = -rxt(k,348)*y(k,213) - mat(k,424) = rxt(k,349)*y(k,217) - mat(k,243) = rxt(k,350)*y(k,217) - mat(k,1451) = rxt(k,349)*y(k,107) + rxt(k,350)*y(k,108) - mat(k,71) = -(rxt(k,511)*y(k,203) + rxt(k,512)*y(k,124)) - mat(k,1756) = -rxt(k,511)*y(k,214) - mat(k,1570) = -rxt(k,512)*y(k,214) - mat(k,810) = rxt(k,514)*y(k,217) - mat(k,1377) = rxt(k,514)*y(k,110) - mat(k,997) = -(rxt(k,445)*y(k,198) + rxt(k,446)*y(k,203) + rxt(k,447) & + mat(k,1915) = -rxt(k,416)*y(k,212) + mat(k,1807) = -rxt(k,417)*y(k,212) + mat(k,2177) = -rxt(k,418)*y(k,212) + mat(k,677) = -(rxt(k,347)*y(k,203) + rxt(k,348)*y(k,124)) + mat(k,1898) = -rxt(k,347)*y(k,213) + mat(k,1796) = -rxt(k,348)*y(k,213) + mat(k,507) = rxt(k,349)*y(k,217) + mat(k,316) = rxt(k,350)*y(k,217) + mat(k,1632) = rxt(k,349)*y(k,107) + rxt(k,350)*y(k,108) + mat(k,80) = -(rxt(k,511)*y(k,203) + rxt(k,512)*y(k,124)) + mat(k,1862) = -rxt(k,511)*y(k,214) + mat(k,1770) = -rxt(k,512)*y(k,214) + mat(k,940) = rxt(k,514)*y(k,217) + mat(k,1551) = rxt(k,514)*y(k,110) + mat(k,1045) = -(rxt(k,445)*y(k,198) + rxt(k,446)*y(k,203) + rxt(k,447) & *y(k,124) + rxt(k,448)*y(k,126)) - mat(k,1671) = -rxt(k,445)*y(k,215) - mat(k,1820) = -rxt(k,446)*y(k,215) - mat(k,1620) = -rxt(k,447)*y(k,215) - mat(k,1964) = -rxt(k,448)*y(k,215) - mat(k,795) = rxt(k,439)*y(k,126) - mat(k,822) = rxt(k,442)*y(k,126) - mat(k,1964) = mat(k,1964) + rxt(k,439)*y(k,6) + rxt(k,442)*y(k,110) & + mat(k,2040) = -rxt(k,445)*y(k,215) + mat(k,1922) = -rxt(k,446)*y(k,215) + mat(k,1814) = -rxt(k,447)*y(k,215) + mat(k,1721) = -rxt(k,448)*y(k,215) + mat(k,1000) = rxt(k,439)*y(k,126) + mat(k,951) = rxt(k,442)*y(k,126) + mat(k,1721) = mat(k,1721) + rxt(k,439)*y(k,6) + rxt(k,442)*y(k,110) & + .500_r8*rxt(k,459)*y(k,177) - mat(k,318) = rxt(k,449)*y(k,217) - mat(k,888) = .500_r8*rxt(k,459)*y(k,126) - mat(k,1487) = rxt(k,449)*y(k,128) - mat(k,1352) = -(rxt(k,124)*y(k,77) + rxt(k,125)*y(k,229) + rxt(k,128) & - *y(k,134) + (rxt(k,206) + rxt(k,207)) * y(k,85) + (rxt(k,229) & - + rxt(k,230)) * y(k,81) + rxt(k,235)*y(k,64) + rxt(k,236) & - *y(k,65) + rxt(k,274)*y(k,86)) - mat(k,1038) = -rxt(k,124)*y(k,216) - mat(k,2067) = -rxt(k,125)*y(k,216) - mat(k,2042) = -rxt(k,128)*y(k,216) - mat(k,1891) = -(rxt(k,206) + rxt(k,207)) * y(k,216) - mat(k,707) = -(rxt(k,229) + rxt(k,230)) * y(k,216) - mat(k,111) = -rxt(k,235)*y(k,216) - mat(k,136) = -rxt(k,236)*y(k,216) - mat(k,131) = -rxt(k,274)*y(k,216) - mat(k,1507) = -(rxt(k,141)*y(k,77) + rxt(k,142)*y(k,79) + rxt(k,143)*y(k,203) & - + rxt(k,144)*y(k,133) + rxt(k,145)*y(k,134) + (4._r8*rxt(k,146) & - + 4._r8*rxt(k,147)) * y(k,217) + rxt(k,149)*y(k,90) + rxt(k,161) & - *y(k,126) + rxt(k,162)*y(k,112) + rxt(k,170)*y(k,125) + rxt(k,171) & - *y(k,89) + rxt(k,190)*y(k,60) + (rxt(k,192) + rxt(k,193) & - ) * y(k,59) + rxt(k,195)*y(k,85) + rxt(k,198)*y(k,92) + rxt(k,222) & - *y(k,19) + rxt(k,224)*y(k,81) + rxt(k,257)*y(k,42) + rxt(k,262) & - *y(k,52) + rxt(k,263)*y(k,53) + (rxt(k,265) + rxt(k,275) & - ) * y(k,62) + rxt(k,266)*y(k,86) + rxt(k,267)*y(k,87) + rxt(k,277) & - *y(k,24) + rxt(k,284)*y(k,26) + rxt(k,285)*y(k,27) + rxt(k,287) & - *y(k,28) + rxt(k,289)*y(k,45) + rxt(k,290)*y(k,47) + rxt(k,295) & - *y(k,50) + rxt(k,296)*y(k,51) + rxt(k,301)*y(k,74) + rxt(k,302) & - *y(k,75) + rxt(k,303)*y(k,139) + rxt(k,304)*y(k,25) + rxt(k,312) & - *y(k,30) + rxt(k,313)*y(k,31) + rxt(k,315)*y(k,49) + rxt(k,316) & - *y(k,95) + rxt(k,317)*y(k,127) + rxt(k,320)*y(k,146) + rxt(k,324) & - *y(k,147) + rxt(k,325)*y(k,29) + rxt(k,326)*y(k,48) + rxt(k,328) & - *y(k,16) + rxt(k,331)*y(k,93) + rxt(k,339)*y(k,105) + rxt(k,340) & - *y(k,106) + rxt(k,349)*y(k,107) + rxt(k,350)*y(k,108) + rxt(k,351) & - *y(k,109) + rxt(k,353)*y(k,111) + rxt(k,356)*y(k,1) + rxt(k,360) & - *y(k,2) + rxt(k,361)*y(k,15) + rxt(k,362)*y(k,94) + rxt(k,363) & - *y(k,96) + rxt(k,364)*y(k,97) + rxt(k,376)*y(k,99) + rxt(k,377) & - *y(k,100) + rxt(k,384)*y(k,102) + rxt(k,386)*y(k,98) + rxt(k,387) & - *y(k,103) + rxt(k,388)*y(k,115) + rxt(k,389)*y(k,116) + rxt(k,395) & - *y(k,181) + rxt(k,398)*y(k,7) + rxt(k,401)*y(k,8) + rxt(k,402) & - *y(k,22) + rxt(k,404)*y(k,23) + rxt(k,408)*y(k,32) + rxt(k,409) & - *y(k,66) + rxt(k,421)*y(k,142) + rxt(k,424)*y(k,143) + rxt(k,428) & - *y(k,179) + rxt(k,429)*y(k,180) + rxt(k,431)*y(k,182) + rxt(k,434) & - *y(k,183) + rxt(k,437)*y(k,184) + rxt(k,438)*y(k,185) + rxt(k,441) & - *y(k,6) + rxt(k,444)*y(k,110) + rxt(k,449)*y(k,128) + rxt(k,453) & - *y(k,174) + rxt(k,454)*y(k,175) + rxt(k,458)*y(k,176) + rxt(k,460) & - *y(k,177) + rxt(k,461)*y(k,178) + (rxt(k,463) + rxt(k,476) & - ) * y(k,67) + rxt(k,465)*y(k,137) + rxt(k,470)*y(k,148) & - + rxt(k,475)*y(k,150) + rxt(k,477)*y(k,151) + rxt(k,479) & - *y(k,120)) - mat(k,1039) = -rxt(k,141)*y(k,217) - mat(k,498) = -rxt(k,142)*y(k,217) - mat(k,1839) = -rxt(k,143)*y(k,217) - mat(k,1869) = -rxt(k,144)*y(k,217) - mat(k,2043) = -rxt(k,145)*y(k,217) - mat(k,335) = -rxt(k,149)*y(k,217) - mat(k,1983) = -rxt(k,161)*y(k,217) - mat(k,294) = -rxt(k,162)*y(k,217) - mat(k,1548) = -rxt(k,170)*y(k,217) - mat(k,1294) = -rxt(k,171)*y(k,217) - mat(k,858) = -rxt(k,190)*y(k,217) - mat(k,1329) = -(rxt(k,192) + rxt(k,193)) * y(k,217) - mat(k,1892) = -rxt(k,195)*y(k,217) - mat(k,726) = -rxt(k,198)*y(k,217) - mat(k,1712) = -rxt(k,222)*y(k,217) - mat(k,708) = -rxt(k,224)*y(k,217) - mat(k,1734) = -rxt(k,257)*y(k,217) - mat(k,697) = -rxt(k,262)*y(k,217) - mat(k,324) = -rxt(k,263)*y(k,217) - mat(k,941) = -(rxt(k,265) + rxt(k,275)) * y(k,217) - mat(k,132) = -rxt(k,266)*y(k,217) - mat(k,701) = -rxt(k,267)*y(k,217) - mat(k,229) = -rxt(k,277)*y(k,217) - mat(k,200) = -rxt(k,284)*y(k,217) - mat(k,271) = -rxt(k,285)*y(k,217) - mat(k,233) = -rxt(k,287)*y(k,217) - mat(k,1028) = -rxt(k,289)*y(k,217) - mat(k,88) = -rxt(k,290)*y(k,217) - mat(k,474) = -rxt(k,295)*y(k,217) - mat(k,437) = -rxt(k,296)*y(k,217) - mat(k,910) = -rxt(k,301)*y(k,217) - mat(k,767) = -rxt(k,302)*y(k,217) - mat(k,384) = -rxt(k,303)*y(k,217) - mat(k,469) = -rxt(k,304)*y(k,217) - mat(k,349) = -rxt(k,312)*y(k,217) - mat(k,95) = -rxt(k,313)*y(k,217) - mat(k,1104) = -rxt(k,315)*y(k,217) - mat(k,946) = -rxt(k,316)*y(k,217) - mat(k,754) = -rxt(k,317)*y(k,217) - mat(k,445) = -rxt(k,320)*y(k,217) - mat(k,343) = -rxt(k,324)*y(k,217) - mat(k,875) = -rxt(k,325)*y(k,217) - mat(k,850) = -rxt(k,326)*y(k,217) - mat(k,288) = -rxt(k,328)*y(k,217) - mat(k,923) = -rxt(k,331)*y(k,217) - mat(k,1094) = -rxt(k,339)*y(k,217) - mat(k,240) = -rxt(k,340)*y(k,217) - mat(k,427) = -rxt(k,349)*y(k,217) - mat(k,246) = -rxt(k,350)*y(k,217) - mat(k,488) = -rxt(k,351)*y(k,217) - mat(k,1169) = -rxt(k,353)*y(k,217) - mat(k,567) = -rxt(k,356)*y(k,217) - mat(k,544) = -rxt(k,360)*y(k,217) - mat(k,186) = -rxt(k,361)*y(k,217) - mat(k,179) = -rxt(k,362)*y(k,217) - mat(k,275) = -rxt(k,363)*y(k,217) - mat(k,105) = -rxt(k,364)*y(k,217) - mat(k,518) = -rxt(k,376)*y(k,217) - mat(k,463) = -rxt(k,377)*y(k,217) - mat(k,331) = -rxt(k,384)*y(k,217) - mat(k,744) = -rxt(k,386)*y(k,217) - mat(k,584) = -rxt(k,387)*y(k,217) - mat(k,302) = -rxt(k,388)*y(k,217) - mat(k,901) = -rxt(k,389)*y(k,217) - mat(k,157) = -rxt(k,395)*y(k,217) - mat(k,117) = -rxt(k,398)*y(k,217) - mat(k,308) = -rxt(k,401)*y(k,217) - mat(k,192) = -rxt(k,402)*y(k,217) - mat(k,266) = -rxt(k,404)*y(k,217) - mat(k,205) = -rxt(k,408)*y(k,217) - mat(k,149) = -rxt(k,409)*y(k,217) - mat(k,126) = -rxt(k,421)*y(k,217) - mat(k,260) = -rxt(k,424)*y(k,217) - mat(k,558) = -rxt(k,428)*y(k,217) - mat(k,144) = -rxt(k,429)*y(k,217) - mat(k,166) = -rxt(k,431)*y(k,217) - mat(k,600) = -rxt(k,434)*y(k,217) - mat(k,171) = -rxt(k,437)*y(k,217) - mat(k,356) = -rxt(k,438)*y(k,217) - mat(k,799) = -rxt(k,441)*y(k,217) - mat(k,826) = -rxt(k,444)*y(k,217) - mat(k,320) = -rxt(k,449)*y(k,217) - mat(k,510) = -rxt(k,453)*y(k,217) - mat(k,525) = -rxt(k,454)*y(k,217) - mat(k,397) = -rxt(k,458)*y(k,217) - mat(k,889) = -rxt(k,460)*y(k,217) - mat(k,934) = -rxt(k,461)*y(k,217) - mat(k,213) = -(rxt(k,463) + rxt(k,476)) * y(k,217) - mat(k,282) = -rxt(k,465)*y(k,217) - mat(k,420) = -rxt(k,470)*y(k,217) - mat(k,1115) = -rxt(k,475)*y(k,217) - mat(k,760) = -rxt(k,477)*y(k,217) - mat(k,85) = -rxt(k,479)*y(k,217) - mat(k,799) = mat(k,799) + .630_r8*rxt(k,440)*y(k,134) - mat(k,229) = mat(k,229) + .650_r8*rxt(k,277)*y(k,217) - mat(k,469) = mat(k,469) + .130_r8*rxt(k,279)*y(k,134) - mat(k,271) = mat(k,271) + .500_r8*rxt(k,285)*y(k,217) - mat(k,875) = mat(k,875) + .360_r8*rxt(k,308)*y(k,134) - mat(k,1734) = mat(k,1734) + rxt(k,256)*y(k,133) - mat(k,324) = mat(k,324) + .300_r8*rxt(k,263)*y(k,217) - mat(k,1926) = rxt(k,179)*y(k,203) - mat(k,681) = rxt(k,233)*y(k,229) - mat(k,1306) = rxt(k,140)*y(k,134) + 2.000_r8*rxt(k,135)*y(k,203) - mat(k,1039) = mat(k,1039) + rxt(k,132)*y(k,133) + rxt(k,124)*y(k,216) - mat(k,498) = mat(k,498) + rxt(k,133)*y(k,133) - mat(k,708) = mat(k,708) + rxt(k,223)*y(k,133) + rxt(k,229)*y(k,216) - mat(k,1892) = mat(k,1892) + rxt(k,194)*y(k,133) + rxt(k,206)*y(k,216) - mat(k,132) = mat(k,132) + rxt(k,274)*y(k,216) - mat(k,670) = rxt(k,225)*y(k,133) - mat(k,726) = mat(k,726) + rxt(k,197)*y(k,133) - mat(k,744) = mat(k,744) + .320_r8*rxt(k,385)*y(k,134) - mat(k,584) = mat(k,584) + .600_r8*rxt(k,387)*y(k,217) - mat(k,1094) = mat(k,1094) + .240_r8*rxt(k,338)*y(k,134) - mat(k,240) = mat(k,240) + .100_r8*rxt(k,340)*y(k,217) - mat(k,826) = mat(k,826) + .630_r8*rxt(k,443)*y(k,134) - mat(k,1169) = mat(k,1169) + .360_r8*rxt(k,352)*y(k,134) - mat(k,1638) = rxt(k,163)*y(k,203) - mat(k,1983) = mat(k,1983) + rxt(k,158)*y(k,203) - mat(k,1869) = mat(k,1869) + rxt(k,256)*y(k,42) + rxt(k,132)*y(k,77) & - + rxt(k,133)*y(k,79) + rxt(k,223)*y(k,81) + rxt(k,194)*y(k,85) & - + rxt(k,225)*y(k,91) + rxt(k,197)*y(k,92) + rxt(k,138)*y(k,203) - mat(k,2043) = mat(k,2043) + .630_r8*rxt(k,440)*y(k,6) + .130_r8*rxt(k,279) & - *y(k,25) + .360_r8*rxt(k,308)*y(k,29) + rxt(k,140)*y(k,76) & + mat(k,393) = rxt(k,449)*y(k,217) + mat(k,970) = .500_r8*rxt(k,459)*y(k,126) + mat(k,1663) = rxt(k,449)*y(k,128) + mat(k,1526) = -(rxt(k,125)*y(k,77) + rxt(k,126)*y(k,229) + rxt(k,129) & + *y(k,134) + (rxt(k,167) + rxt(k,168)) * y(k,113) + rxt(k,200) & + *y(k,33) + rxt(k,201)*y(k,34) + rxt(k,202)*y(k,36) + rxt(k,203) & + *y(k,37) + rxt(k,204)*y(k,38) + rxt(k,205)*y(k,39) + rxt(k,206) & + *y(k,40) + (rxt(k,207) + rxt(k,208)) * y(k,85) + rxt(k,227) & + *y(k,35) + rxt(k,228)*y(k,55) + rxt(k,229)*y(k,78) + (rxt(k,230) & + + rxt(k,231)) * y(k,81) + rxt(k,236)*y(k,64) + rxt(k,237) & + *y(k,65) + rxt(k,250)*y(k,41) + rxt(k,251)*y(k,43) + rxt(k,252) & + *y(k,82) + rxt(k,253)*y(k,83) + rxt(k,254)*y(k,84) + (rxt(k,271) & + + rxt(k,272) + rxt(k,273)) * y(k,54) + rxt(k,274)*y(k,86)) + mat(k,1405) = -rxt(k,125)*y(k,216) + mat(k,2272) = -rxt(k,126)*y(k,216) + mat(k,2124) = -rxt(k,129)*y(k,216) + mat(k,184) = -(rxt(k,167) + rxt(k,168)) * y(k,216) + mat(k,100) = -rxt(k,200)*y(k,216) + mat(k,144) = -rxt(k,201)*y(k,216) + mat(k,115) = -rxt(k,202)*y(k,216) + mat(k,154) = -rxt(k,203)*y(k,216) + mat(k,119) = -rxt(k,204)*y(k,216) + mat(k,159) = -rxt(k,205)*y(k,216) + mat(k,123) = -rxt(k,206)*y(k,216) + mat(k,2147) = -(rxt(k,207) + rxt(k,208)) * y(k,216) + mat(k,150) = -rxt(k,227)*y(k,216) + mat(k,449) = -rxt(k,228)*y(k,216) + mat(k,108) = -rxt(k,229)*y(k,216) + mat(k,807) = -(rxt(k,230) + rxt(k,231)) * y(k,216) + mat(k,237) = -rxt(k,236)*y(k,216) + mat(k,228) = -rxt(k,237)*y(k,216) + mat(k,469) = -rxt(k,250)*y(k,216) + mat(k,596) = -rxt(k,251)*y(k,216) + mat(k,223) = -rxt(k,252)*y(k,216) + mat(k,250) = -rxt(k,253)*y(k,216) + mat(k,306) = -rxt(k,254)*y(k,216) + mat(k,1434) = -(rxt(k,271) + rxt(k,272) + rxt(k,273)) * y(k,216) + mat(k,180) = -rxt(k,274)*y(k,216) + mat(k,1691) = -(rxt(k,142)*y(k,77) + rxt(k,143)*y(k,79) + rxt(k,144)*y(k,203) & + + rxt(k,145)*y(k,133) + rxt(k,146)*y(k,134) + (4._r8*rxt(k,147) & + + 4._r8*rxt(k,148)) * y(k,217) + rxt(k,150)*y(k,90) + rxt(k,162) & + *y(k,126) + rxt(k,163)*y(k,112) + rxt(k,171)*y(k,125) + rxt(k,172) & + *y(k,89) + rxt(k,191)*y(k,60) + (rxt(k,193) + rxt(k,194) & + ) * y(k,59) + rxt(k,196)*y(k,85) + rxt(k,199)*y(k,92) + rxt(k,223) & + *y(k,19) + rxt(k,225)*y(k,81) + rxt(k,239)*y(k,41) + rxt(k,241) & + *y(k,43) + rxt(k,242)*y(k,44) + rxt(k,244)*y(k,46) + rxt(k,246) & + *y(k,55) + rxt(k,247)*y(k,82) + rxt(k,248)*y(k,83) + rxt(k,249) & + *y(k,84) + rxt(k,258)*y(k,42) + rxt(k,263)*y(k,52) + rxt(k,264) & + *y(k,53) + rxt(k,265)*y(k,54) + rxt(k,266)*y(k,86) + rxt(k,267) & + *y(k,87) + rxt(k,275)*y(k,62) + rxt(k,277)*y(k,24) + rxt(k,284) & + *y(k,26) + rxt(k,285)*y(k,27) + rxt(k,287)*y(k,28) + rxt(k,289) & + *y(k,45) + rxt(k,290)*y(k,47) + rxt(k,295)*y(k,50) + rxt(k,296) & + *y(k,51) + rxt(k,301)*y(k,74) + rxt(k,302)*y(k,75) + rxt(k,303) & + *y(k,139) + rxt(k,304)*y(k,25) + rxt(k,312)*y(k,30) + rxt(k,313) & + *y(k,31) + rxt(k,315)*y(k,49) + rxt(k,316)*y(k,95) + rxt(k,317) & + *y(k,127) + rxt(k,320)*y(k,146) + rxt(k,324)*y(k,147) + rxt(k,325) & + *y(k,29) + rxt(k,326)*y(k,48) + rxt(k,328)*y(k,16) + rxt(k,331) & + *y(k,93) + rxt(k,339)*y(k,105) + rxt(k,340)*y(k,106) + rxt(k,349) & + *y(k,107) + rxt(k,350)*y(k,108) + rxt(k,351)*y(k,109) + rxt(k,353) & + *y(k,111) + rxt(k,356)*y(k,1) + rxt(k,360)*y(k,2) + rxt(k,361) & + *y(k,15) + rxt(k,362)*y(k,94) + rxt(k,363)*y(k,96) + rxt(k,364) & + *y(k,97) + rxt(k,376)*y(k,99) + rxt(k,377)*y(k,100) + rxt(k,384) & + *y(k,102) + rxt(k,386)*y(k,98) + rxt(k,387)*y(k,103) + rxt(k,388) & + *y(k,115) + rxt(k,389)*y(k,116) + rxt(k,395)*y(k,181) + rxt(k,398) & + *y(k,7) + rxt(k,401)*y(k,8) + rxt(k,402)*y(k,22) + rxt(k,404) & + *y(k,23) + rxt(k,408)*y(k,32) + rxt(k,409)*y(k,66) + rxt(k,421) & + *y(k,142) + rxt(k,424)*y(k,143) + rxt(k,428)*y(k,179) + rxt(k,429) & + *y(k,180) + rxt(k,431)*y(k,182) + rxt(k,434)*y(k,183) + rxt(k,437) & + *y(k,184) + rxt(k,438)*y(k,185) + rxt(k,441)*y(k,6) + rxt(k,444) & + *y(k,110) + rxt(k,449)*y(k,128) + rxt(k,453)*y(k,174) + rxt(k,454) & + *y(k,175) + rxt(k,458)*y(k,176) + rxt(k,460)*y(k,177) + rxt(k,461) & + *y(k,178) + (rxt(k,463) + rxt(k,477)) * y(k,67) + rxt(k,465) & + *y(k,137) + rxt(k,467)*y(k,151) + rxt(k,471)*y(k,148) + rxt(k,476) & + *y(k,150) + rxt(k,479)*y(k,120)) + mat(k,1406) = -rxt(k,142)*y(k,217) + mat(k,604) = -rxt(k,143)*y(k,217) + mat(k,1947) = -rxt(k,144)*y(k,217) + mat(k,2247) = -rxt(k,145)*y(k,217) + mat(k,2125) = -rxt(k,146)*y(k,217) + mat(k,404) = -rxt(k,150)*y(k,217) + mat(k,1748) = -rxt(k,162)*y(k,217) + mat(k,494) = -rxt(k,163)*y(k,217) + mat(k,2192) = -rxt(k,171)*y(k,217) + mat(k,1451) = -rxt(k,172)*y(k,217) + mat(k,886) = -rxt(k,191)*y(k,217) + mat(k,1973) = -(rxt(k,193) + rxt(k,194)) * y(k,217) + mat(k,2148) = -rxt(k,196)*y(k,217) + mat(k,825) = -rxt(k,199)*y(k,217) + mat(k,2216) = -rxt(k,223)*y(k,217) + mat(k,808) = -rxt(k,225)*y(k,217) + mat(k,470) = -rxt(k,239)*y(k,217) + mat(k,597) = -rxt(k,241)*y(k,217) + mat(k,126) = -rxt(k,242)*y(k,217) + mat(k,367) = -rxt(k,244)*y(k,217) + mat(k,450) = -rxt(k,246)*y(k,217) + mat(k,224) = -rxt(k,247)*y(k,217) + mat(k,251) = -rxt(k,248)*y(k,217) + mat(k,307) = -rxt(k,249)*y(k,217) + mat(k,1487) = -rxt(k,258)*y(k,217) + mat(k,788) = -rxt(k,263)*y(k,217) + mat(k,388) = -rxt(k,264)*y(k,217) + mat(k,1435) = -rxt(k,265)*y(k,217) + mat(k,181) = -rxt(k,266)*y(k,217) + mat(k,931) = -rxt(k,267)*y(k,217) + mat(k,1104) = -rxt(k,275)*y(k,217) + mat(k,289) = -rxt(k,277)*y(k,217) + mat(k,263) = -rxt(k,284)*y(k,217) + mat(k,347) = -rxt(k,285)*y(k,217) + mat(k,293) = -rxt(k,287)*y(k,217) + mat(k,1089) = -rxt(k,289)*y(k,217) + mat(k,103) = -rxt(k,290)*y(k,217) + mat(k,686) = -rxt(k,295)*y(k,217) + mat(k,614) = -rxt(k,296)*y(k,217) + mat(k,1099) = -rxt(k,301)*y(k,217) + mat(k,981) = -rxt(k,302)*y(k,217) + mat(k,528) = -rxt(k,303)*y(k,217) + mat(k,553) = -rxt(k,304)*y(k,217) + mat(k,418) = -rxt(k,312)*y(k,217) + mat(k,111) = -rxt(k,313)*y(k,217) + mat(k,1224) = -rxt(k,315)*y(k,217) + mat(k,1144) = -rxt(k,316)*y(k,217) + mat(k,861) = -rxt(k,317)*y(k,217) + mat(k,537) = -rxt(k,320)*y(k,217) + mat(k,413) = -rxt(k,324)*y(k,217) + mat(k,1032) = -rxt(k,325)*y(k,217) + mat(k,925) = -rxt(k,326)*y(k,217) + mat(k,354) = -rxt(k,328)*y(k,217) + mat(k,1158) = -rxt(k,331)*y(k,217) + mat(k,1215) = -rxt(k,339)*y(k,217) + mat(k,313) = -rxt(k,340)*y(k,217) + mat(k,510) = -rxt(k,349)*y(k,217) + mat(k,319) = -rxt(k,350)*y(k,217) + mat(k,577) = -rxt(k,351)*y(k,217) + mat(k,1338) = -rxt(k,353)*y(k,217) + mat(k,673) = -rxt(k,356)*y(k,217) + mat(k,640) = -rxt(k,360)*y(k,217) + mat(k,240) = -rxt(k,361)*y(k,217) + mat(k,233) = -rxt(k,362)*y(k,217) + mat(k,322) = -rxt(k,363)*y(k,217) + mat(k,137) = -rxt(k,364)*y(k,217) + mat(k,587) = -rxt(k,376)*y(k,217) + mat(k,562) = -rxt(k,377)*y(k,217) + mat(k,400) = -rxt(k,384)*y(k,217) + mat(k,852) = -rxt(k,386)*y(k,217) + mat(k,695) = -rxt(k,387)*y(k,217) + mat(k,377) = -rxt(k,388)*y(k,217) + mat(k,1079) = -rxt(k,389)*y(k,217) + mat(k,205) = -rxt(k,395)*y(k,217) + mat(k,168) = -rxt(k,398)*y(k,217) + mat(k,425) = -rxt(k,401)*y(k,217) + mat(k,255) = -rxt(k,402)*y(k,217) + mat(k,342) = -rxt(k,404)*y(k,217) + mat(k,268) = -rxt(k,408)*y(k,217) + mat(k,197) = -rxt(k,409)*y(k,217) + mat(k,177) = -rxt(k,421)*y(k,217) + mat(k,336) = -rxt(k,424)*y(k,217) + mat(k,663) = -rxt(k,428)*y(k,217) + mat(k,192) = -rxt(k,429)*y(k,217) + mat(k,214) = -rxt(k,431)*y(k,217) + mat(k,710) = -rxt(k,434)*y(k,217) + mat(k,219) = -rxt(k,437)*y(k,217) + mat(k,431) = -rxt(k,438)*y(k,217) + mat(k,1010) = -rxt(k,441)*y(k,217) + mat(k,960) = -rxt(k,444)*y(k,217) + mat(k,395) = -rxt(k,449)*y(k,217) + mat(k,650) = -rxt(k,453)*y(k,217) + mat(k,620) = -rxt(k,454)*y(k,217) + mat(k,479) = -rxt(k,458)*y(k,217) + mat(k,974) = -rxt(k,460)*y(k,217) + mat(k,1064) = -rxt(k,461)*y(k,217) + mat(k,300) = -(rxt(k,463) + rxt(k,477)) * y(k,217) + mat(k,363) = -rxt(k,465)*y(k,217) + mat(k,834) = -rxt(k,467)*y(k,217) + mat(k,514) = -rxt(k,471)*y(k,217) + mat(k,1235) = -rxt(k,476)*y(k,217) + mat(k,97) = -rxt(k,479)*y(k,217) + mat(k,1010) = mat(k,1010) + .630_r8*rxt(k,440)*y(k,134) + mat(k,289) = mat(k,289) + .650_r8*rxt(k,277)*y(k,217) + mat(k,553) = mat(k,553) + .130_r8*rxt(k,279)*y(k,134) + mat(k,347) = mat(k,347) + .500_r8*rxt(k,285)*y(k,217) + mat(k,1032) = mat(k,1032) + .360_r8*rxt(k,308)*y(k,134) + mat(k,1487) = mat(k,1487) + rxt(k,257)*y(k,133) + mat(k,388) = mat(k,388) + .300_r8*rxt(k,264)*y(k,217) + mat(k,1435) = mat(k,1435) + rxt(k,271)*y(k,216) + mat(k,2012) = rxt(k,180)*y(k,203) + mat(k,869) = rxt(k,234)*y(k,229) + mat(k,1466) = rxt(k,141)*y(k,134) + 2.000_r8*rxt(k,136)*y(k,203) + mat(k,1406) = mat(k,1406) + rxt(k,133)*y(k,133) + rxt(k,125)*y(k,216) + mat(k,604) = mat(k,604) + rxt(k,134)*y(k,133) + mat(k,808) = mat(k,808) + rxt(k,224)*y(k,133) + rxt(k,230)*y(k,216) + mat(k,2148) = mat(k,2148) + rxt(k,195)*y(k,133) + rxt(k,207)*y(k,216) + mat(k,181) = mat(k,181) + rxt(k,274)*y(k,216) + mat(k,780) = rxt(k,226)*y(k,133) + mat(k,825) = mat(k,825) + rxt(k,198)*y(k,133) + mat(k,852) = mat(k,852) + .320_r8*rxt(k,385)*y(k,134) + mat(k,695) = mat(k,695) + .600_r8*rxt(k,387)*y(k,217) + mat(k,1215) = mat(k,1215) + .240_r8*rxt(k,338)*y(k,134) + mat(k,313) = mat(k,313) + .100_r8*rxt(k,340)*y(k,217) + mat(k,960) = mat(k,960) + .630_r8*rxt(k,443)*y(k,134) + mat(k,1338) = mat(k,1338) + .360_r8*rxt(k,352)*y(k,134) + mat(k,1840) = rxt(k,164)*y(k,203) + mat(k,1748) = mat(k,1748) + rxt(k,159)*y(k,203) + mat(k,2247) = mat(k,2247) + rxt(k,257)*y(k,42) + rxt(k,133)*y(k,77) & + + rxt(k,134)*y(k,79) + rxt(k,224)*y(k,81) + rxt(k,195)*y(k,85) & + + rxt(k,226)*y(k,91) + rxt(k,198)*y(k,92) + rxt(k,139)*y(k,203) + mat(k,2125) = mat(k,2125) + .630_r8*rxt(k,440)*y(k,6) + .130_r8*rxt(k,279) & + *y(k,25) + .360_r8*rxt(k,308)*y(k,29) + rxt(k,141)*y(k,76) & + .320_r8*rxt(k,385)*y(k,98) + .240_r8*rxt(k,338)*y(k,105) & + .630_r8*rxt(k,443)*y(k,110) + .360_r8*rxt(k,352)*y(k,111) & - + rxt(k,139)*y(k,203) - mat(k,445) = mat(k,445) + .500_r8*rxt(k,320)*y(k,217) - mat(k,157) = mat(k,157) + .500_r8*rxt(k,395)*y(k,217) - mat(k,431) = .400_r8*rxt(k,396)*y(k,203) - mat(k,1267) = .450_r8*rxt(k,293)*y(k,203) - mat(k,652) = .400_r8*rxt(k,410)*y(k,203) - mat(k,1839) = mat(k,1839) + rxt(k,179)*y(k,56) + 2.000_r8*rxt(k,135)*y(k,76) & - + rxt(k,163)*y(k,124) + rxt(k,158)*y(k,126) + rxt(k,138) & - *y(k,133) + rxt(k,139)*y(k,134) + .400_r8*rxt(k,396)*y(k,188) & + + rxt(k,140)*y(k,203) + mat(k,537) = mat(k,537) + .500_r8*rxt(k,320)*y(k,217) + mat(k,205) = mat(k,205) + .500_r8*rxt(k,395)*y(k,217) + mat(k,520) = .400_r8*rxt(k,396)*y(k,203) + mat(k,1390) = .450_r8*rxt(k,293)*y(k,203) + mat(k,762) = .400_r8*rxt(k,410)*y(k,203) + mat(k,1947) = mat(k,1947) + rxt(k,180)*y(k,56) + 2.000_r8*rxt(k,136)*y(k,76) & + + rxt(k,164)*y(k,124) + rxt(k,159)*y(k,126) + rxt(k,139) & + *y(k,133) + rxt(k,140)*y(k,134) + .400_r8*rxt(k,396)*y(k,188) & + .450_r8*rxt(k,293)*y(k,197) + .400_r8*rxt(k,410)*y(k,199) & + .450_r8*rxt(k,343)*y(k,211) + .400_r8*rxt(k,416)*y(k,212) & + .200_r8*rxt(k,347)*y(k,213) + .150_r8*rxt(k,322)*y(k,220) - mat(k,1237) = .450_r8*rxt(k,343)*y(k,203) - mat(k,773) = .400_r8*rxt(k,416)*y(k,203) - mat(k,575) = .200_r8*rxt(k,347)*y(k,203) - mat(k,1353) = rxt(k,124)*y(k,77) + rxt(k,229)*y(k,81) + rxt(k,206)*y(k,85) & - + rxt(k,274)*y(k,86) + 2.000_r8*rxt(k,125)*y(k,229) - mat(k,1507) = mat(k,1507) + .650_r8*rxt(k,277)*y(k,24) + .500_r8*rxt(k,285) & - *y(k,27) + .300_r8*rxt(k,263)*y(k,53) + .600_r8*rxt(k,387) & + mat(k,1358) = .450_r8*rxt(k,343)*y(k,203) + mat(k,877) = .400_r8*rxt(k,416)*y(k,203) + mat(k,680) = .200_r8*rxt(k,347)*y(k,203) + mat(k,1527) = rxt(k,271)*y(k,54) + rxt(k,125)*y(k,77) + rxt(k,230)*y(k,81) & + + rxt(k,207)*y(k,85) + rxt(k,274)*y(k,86) + 2.000_r8*rxt(k,126) & + *y(k,229) + mat(k,1691) = mat(k,1691) + .650_r8*rxt(k,277)*y(k,24) + .500_r8*rxt(k,285) & + *y(k,27) + .300_r8*rxt(k,264)*y(k,53) + .600_r8*rxt(k,387) & *y(k,103) + .100_r8*rxt(k,340)*y(k,106) + .500_r8*rxt(k,320) & *y(k,146) + .500_r8*rxt(k,395)*y(k,181) - mat(k,1016) = .150_r8*rxt(k,322)*y(k,203) - mat(k,2068) = rxt(k,233)*y(k,73) + 2.000_r8*rxt(k,125)*y(k,216) + mat(k,1134) = .150_r8*rxt(k,322)*y(k,203) + mat(k,2273) = rxt(k,234)*y(k,73) + 2.000_r8*rxt(k,126)*y(k,216) end do - end subroutine nlnmat08 - subroutine nlnmat09( avec_len, mat, y, rxt ) + end subroutine nlnmat09 + subroutine nlnmat10( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -2107,135 +2343,143 @@ subroutine nlnmat09( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,373) = -(rxt(k,419)*y(k,203) + rxt(k,420)*y(k,124)) - mat(k,1778) = -rxt(k,419)*y(k,218) - mat(k,1582) = -rxt(k,420)*y(k,218) - mat(k,147) = .200_r8*rxt(k,409)*y(k,217) - mat(k,124) = .140_r8*rxt(k,421)*y(k,217) - mat(k,258) = rxt(k,424)*y(k,217) - mat(k,1425) = .200_r8*rxt(k,409)*y(k,66) + .140_r8*rxt(k,421)*y(k,142) & + mat(k,454) = -(rxt(k,419)*y(k,203) + rxt(k,420)*y(k,124)) + mat(k,1884) = -rxt(k,419)*y(k,218) + mat(k,1781) = -rxt(k,420)*y(k,218) + mat(k,195) = .200_r8*rxt(k,409)*y(k,217) + mat(k,175) = .140_r8*rxt(k,421)*y(k,217) + mat(k,334) = rxt(k,424)*y(k,217) + mat(k,1604) = .200_r8*rxt(k,409)*y(k,66) + .140_r8*rxt(k,421)*y(k,142) & + rxt(k,424)*y(k,143) - mat(k,658) = -(rxt(k,318)*y(k,203) + rxt(k,319)*y(k,124)) - mat(k,1801) = -rxt(k,318)*y(k,219) - mat(k,1602) = -rxt(k,319)*y(k,219) - mat(k,866) = rxt(k,325)*y(k,217) - mat(k,442) = .500_r8*rxt(k,320)*y(k,217) - mat(k,1459) = rxt(k,325)*y(k,29) + .500_r8*rxt(k,320)*y(k,146) - mat(k,1013) = -(rxt(k,321)*y(k,198) + rxt(k,322)*y(k,203) + rxt(k,323) & + mat(k,768) = -(rxt(k,318)*y(k,203) + rxt(k,319)*y(k,124)) + mat(k,1907) = -rxt(k,318)*y(k,219) + mat(k,1802) = -rxt(k,319)*y(k,219) + mat(k,1020) = rxt(k,325)*y(k,217) + mat(k,533) = .500_r8*rxt(k,320)*y(k,217) + mat(k,1641) = rxt(k,325)*y(k,29) + .500_r8*rxt(k,320)*y(k,146) + mat(k,1129) = -(rxt(k,321)*y(k,198) + rxt(k,322)*y(k,203) + rxt(k,323) & *y(k,124)) - mat(k,1672) = -rxt(k,321)*y(k,220) - mat(k,1821) = -rxt(k,322)*y(k,220) - mat(k,1621) = -rxt(k,323)*y(k,220) - mat(k,796) = .060_r8*rxt(k,440)*y(k,134) - mat(k,848) = rxt(k,326)*y(k,217) - mat(k,823) = .060_r8*rxt(k,443)*y(k,134) - mat(k,2026) = .060_r8*rxt(k,440)*y(k,6) + .060_r8*rxt(k,443)*y(k,110) - mat(k,341) = rxt(k,324)*y(k,217) - mat(k,932) = .150_r8*rxt(k,461)*y(k,217) - mat(k,1488) = rxt(k,326)*y(k,48) + rxt(k,324)*y(k,147) + .150_r8*rxt(k,461) & + mat(k,2047) = -rxt(k,321)*y(k,220) + mat(k,1928) = -rxt(k,322)*y(k,220) + mat(k,1821) = -rxt(k,323)*y(k,220) + mat(k,1005) = .060_r8*rxt(k,440)*y(k,134) + mat(k,923) = rxt(k,326)*y(k,217) + mat(k,955) = .060_r8*rxt(k,443)*y(k,134) + mat(k,2107) = .060_r8*rxt(k,440)*y(k,6) + .060_r8*rxt(k,443)*y(k,110) + mat(k,410) = rxt(k,324)*y(k,217) + mat(k,1061) = .150_r8*rxt(k,461)*y(k,217) + mat(k,1670) = rxt(k,326)*y(k,48) + rxt(k,324)*y(k,147) + .150_r8*rxt(k,461) & *y(k,178) - mat(k,978) = -(rxt(k,450)*y(k,198) + rxt(k,451)*y(k,203) + rxt(k,452) & + mat(k,1115) = -(rxt(k,450)*y(k,198) + rxt(k,451)*y(k,203) + rxt(k,452) & *y(k,124)) - mat(k,1670) = -rxt(k,450)*y(k,221) - mat(k,1819) = -rxt(k,451)*y(k,221) - mat(k,1619) = -rxt(k,452)*y(k,221) - mat(k,1963) = .500_r8*rxt(k,459)*y(k,177) - mat(k,509) = rxt(k,453)*y(k,217) - mat(k,887) = .500_r8*rxt(k,459)*y(k,126) + rxt(k,460)*y(k,217) - mat(k,1486) = rxt(k,453)*y(k,174) + rxt(k,460)*y(k,177) - mat(k,956) = -(rxt(k,455)*y(k,198) + rxt(k,456)*y(k,203) + rxt(k,457) & + mat(k,2046) = -rxt(k,450)*y(k,221) + mat(k,1927) = -rxt(k,451)*y(k,221) + mat(k,1820) = -rxt(k,452)*y(k,221) + mat(k,1727) = .500_r8*rxt(k,459)*y(k,177) + mat(k,648) = rxt(k,453)*y(k,217) + mat(k,973) = .500_r8*rxt(k,459)*y(k,126) + rxt(k,460)*y(k,217) + mat(k,1669) = rxt(k,453)*y(k,174) + rxt(k,460)*y(k,177) + mat(k,912) = -(rxt(k,455)*y(k,198) + rxt(k,456)*y(k,203) + rxt(k,457) & *y(k,124)) - mat(k,1669) = -rxt(k,455)*y(k,222) - mat(k,1818) = -rxt(k,456)*y(k,222) - mat(k,1618) = -rxt(k,457)*y(k,222) - mat(k,794) = rxt(k,441)*y(k,217) - mat(k,821) = rxt(k,444)*y(k,217) - mat(k,396) = rxt(k,458)*y(k,217) - mat(k,1485) = rxt(k,441)*y(k,6) + rxt(k,444)*y(k,110) + rxt(k,458)*y(k,176) - mat(k,622) = -(rxt(k,426)*y(k,203) + rxt(k,427)*y(k,124)) - mat(k,1798) = -rxt(k,426)*y(k,223) - mat(k,1599) = -rxt(k,427)*y(k,223) - mat(k,552) = rxt(k,428)*y(k,217) - mat(k,143) = .650_r8*rxt(k,429)*y(k,217) - mat(k,1456) = rxt(k,428)*y(k,179) + .650_r8*rxt(k,429)*y(k,180) - mat(k,77) = -(rxt(k,517)*y(k,203) + rxt(k,518)*y(k,124)) - mat(k,1757) = -rxt(k,517)*y(k,224) - mat(k,1571) = -rxt(k,518)*y(k,224) - mat(k,138) = rxt(k,516)*y(k,217) - mat(k,1378) = rxt(k,516)*y(k,180) - mat(k,1052) = -(rxt(k,390)*y(k,197) + rxt(k,391)*y(k,198) + rxt(k,392) & + mat(k,2036) = -rxt(k,455)*y(k,222) + mat(k,1917) = -rxt(k,456)*y(k,222) + mat(k,1809) = -rxt(k,457)*y(k,222) + mat(k,994) = rxt(k,441)*y(k,217) + mat(k,945) = rxt(k,444)*y(k,217) + mat(k,475) = rxt(k,458)*y(k,217) + mat(k,1655) = rxt(k,441)*y(k,6) + rxt(k,444)*y(k,110) + rxt(k,458)*y(k,176) + mat(k,732) = -(rxt(k,426)*y(k,203) + rxt(k,427)*y(k,124)) + mat(k,1904) = -rxt(k,426)*y(k,223) + mat(k,1799) = -rxt(k,427)*y(k,223) + mat(k,657) = rxt(k,428)*y(k,217) + mat(k,191) = .650_r8*rxt(k,429)*y(k,217) + mat(k,1638) = rxt(k,428)*y(k,179) + .650_r8*rxt(k,429)*y(k,180) + mat(k,86) = -(rxt(k,517)*y(k,203) + rxt(k,518)*y(k,124)) + mat(k,1863) = -rxt(k,517)*y(k,224) + mat(k,1771) = -rxt(k,518)*y(k,224) + mat(k,186) = rxt(k,516)*y(k,217) + mat(k,1552) = rxt(k,516)*y(k,180) + mat(k,1173) = -(rxt(k,390)*y(k,197) + rxt(k,391)*y(k,198) + rxt(k,392) & *y(k,203) + rxt(k,393)*y(k,124) + rxt(k,394)*y(k,126)) - mat(k,1255) = -rxt(k,390)*y(k,225) - mat(k,1674) = -rxt(k,391)*y(k,225) - mat(k,1824) = -rxt(k,392)*y(k,225) - mat(k,1623) = -rxt(k,393)*y(k,225) - mat(k,1967) = -rxt(k,394)*y(k,225) - mat(k,178) = rxt(k,362)*y(k,217) - mat(k,274) = rxt(k,363)*y(k,217) - mat(k,104) = rxt(k,364)*y(k,217) - mat(k,581) = .400_r8*rxt(k,387)*y(k,217) - mat(k,156) = .500_r8*rxt(k,395)*y(k,217) - mat(k,1491) = rxt(k,362)*y(k,94) + rxt(k,363)*y(k,96) + rxt(k,364)*y(k,97) & + mat(k,1377) = -rxt(k,390)*y(k,225) + mat(k,2049) = -rxt(k,391)*y(k,225) + mat(k,1930) = -rxt(k,392)*y(k,225) + mat(k,1824) = -rxt(k,393)*y(k,225) + mat(k,1731) = -rxt(k,394)*y(k,225) + mat(k,232) = rxt(k,362)*y(k,217) + mat(k,321) = rxt(k,363)*y(k,217) + mat(k,136) = rxt(k,364)*y(k,217) + mat(k,691) = .400_r8*rxt(k,387)*y(k,217) + mat(k,204) = .500_r8*rxt(k,395)*y(k,217) + mat(k,1673) = rxt(k,362)*y(k,94) + rxt(k,363)*y(k,96) + rxt(k,364)*y(k,97) & + .400_r8*rxt(k,387)*y(k,103) + .500_r8*rxt(k,395)*y(k,181) - mat(k,638) = -(rxt(k,432)*y(k,203) + rxt(k,433)*y(k,124)) - mat(k,1799) = -rxt(k,432)*y(k,226) - mat(k,1600) = -rxt(k,433)*y(k,226) - mat(k,163) = .560_r8*rxt(k,431)*y(k,217) - mat(k,593) = rxt(k,434)*y(k,217) - mat(k,1457) = .560_r8*rxt(k,431)*y(k,182) + rxt(k,434)*y(k,183) - mat(k,83) = -(rxt(k,520)*y(k,203) + rxt(k,521)*y(k,124)) - mat(k,1758) = -rxt(k,520)*y(k,227) - mat(k,1572) = -rxt(k,521)*y(k,227) - mat(k,158) = rxt(k,519)*y(k,217) - mat(k,1379) = rxt(k,519)*y(k,182) - mat(k,410) = -(rxt(k,435)*y(k,203) + rxt(k,436)*y(k,124)) - mat(k,1783) = -rxt(k,435)*y(k,228) - mat(k,1586) = -rxt(k,436)*y(k,228) - mat(k,170) = .300_r8*rxt(k,437)*y(k,217) - mat(k,353) = rxt(k,438)*y(k,217) - mat(k,1431) = .300_r8*rxt(k,437)*y(k,184) + rxt(k,438)*y(k,185) - mat(k,2080) = -(rxt(k,125)*y(k,216) + rxt(k,233)*y(k,73) + rxt(k,478) & + mat(k,748) = -(rxt(k,432)*y(k,203) + rxt(k,433)*y(k,124)) + mat(k,1905) = -rxt(k,432)*y(k,226) + mat(k,1800) = -rxt(k,433)*y(k,226) + mat(k,211) = .560_r8*rxt(k,431)*y(k,217) + mat(k,703) = rxt(k,434)*y(k,217) + mat(k,1639) = .560_r8*rxt(k,431)*y(k,182) + rxt(k,434)*y(k,183) + mat(k,92) = -(rxt(k,520)*y(k,203) + rxt(k,521)*y(k,124)) + mat(k,1864) = -rxt(k,520)*y(k,227) + mat(k,1772) = -rxt(k,521)*y(k,227) + mat(k,206) = rxt(k,519)*y(k,217) + mat(k,1553) = rxt(k,519)*y(k,182) + mat(k,499) = -(rxt(k,435)*y(k,203) + rxt(k,436)*y(k,124)) + mat(k,1889) = -rxt(k,435)*y(k,228) + mat(k,1786) = -rxt(k,436)*y(k,228) + mat(k,218) = .300_r8*rxt(k,437)*y(k,217) + mat(k,428) = rxt(k,438)*y(k,217) + mat(k,1611) = .300_r8*rxt(k,437)*y(k,184) + rxt(k,438)*y(k,185) + mat(k,2285) = -(rxt(k,126)*y(k,216) + rxt(k,234)*y(k,73) + rxt(k,478) & *y(k,152)) - mat(k,1365) = -rxt(k,125)*y(k,229) - mat(k,684) = -rxt(k,233)*y(k,229) - mat(k,197) = -rxt(k,478)*y(k,229) - mat(k,236) = rxt(k,287)*y(k,217) - mat(k,351) = rxt(k,312)*y(k,217) - mat(k,96) = rxt(k,313)*y(k,217) - mat(k,1746) = rxt(k,257)*y(k,217) - mat(k,1032) = rxt(k,289)*y(k,217) - mat(k,852) = rxt(k,326)*y(k,217) - mat(k,1107) = rxt(k,315)*y(k,217) - mat(k,476) = rxt(k,295)*y(k,217) - mat(k,440) = rxt(k,296)*y(k,217) - mat(k,327) = rxt(k,263)*y(k,217) - mat(k,1315) = rxt(k,136)*y(k,203) - mat(k,1045) = rxt(k,141)*y(k,217) - mat(k,503) = rxt(k,142)*y(k,217) - mat(k,711) = rxt(k,224)*y(k,217) - mat(k,1904) = (rxt(k,530)+rxt(k,535))*y(k,91) + (rxt(k,523)+rxt(k,529) & - +rxt(k,534))*y(k,92) + rxt(k,195)*y(k,217) - mat(k,703) = rxt(k,267)*y(k,217) - mat(k,1301) = rxt(k,171)*y(k,217) - mat(k,339) = rxt(k,149)*y(k,217) - mat(k,675) = (rxt(k,530)+rxt(k,535))*y(k,85) - mat(k,730) = (rxt(k,523)+rxt(k,529)+rxt(k,534))*y(k,85) + rxt(k,198)*y(k,217) - mat(k,1098) = .500_r8*rxt(k,339)*y(k,217) - mat(k,86) = rxt(k,479)*y(k,217) - mat(k,448) = rxt(k,320)*y(k,217) - mat(k,345) = rxt(k,324)*y(k,217) - mat(k,1851) = rxt(k,136)*y(k,76) + rxt(k,143)*y(k,217) - mat(k,1519) = rxt(k,287)*y(k,28) + rxt(k,312)*y(k,30) + rxt(k,313)*y(k,31) & - + rxt(k,257)*y(k,42) + rxt(k,289)*y(k,45) + rxt(k,326)*y(k,48) & - + rxt(k,315)*y(k,49) + rxt(k,295)*y(k,50) + rxt(k,296)*y(k,51) & - + rxt(k,263)*y(k,53) + rxt(k,141)*y(k,77) + rxt(k,142)*y(k,79) & - + rxt(k,224)*y(k,81) + rxt(k,195)*y(k,85) + rxt(k,267)*y(k,87) & - + rxt(k,171)*y(k,89) + rxt(k,149)*y(k,90) + rxt(k,198)*y(k,92) & + mat(k,1539) = -rxt(k,126)*y(k,229) + mat(k,872) = -rxt(k,234)*y(k,229) + mat(k,260) = -rxt(k,478)*y(k,229) + mat(k,296) = rxt(k,287)*y(k,217) + mat(k,420) = rxt(k,312)*y(k,217) + mat(k,112) = rxt(k,313)*y(k,217) + mat(k,473) = rxt(k,239)*y(k,217) + mat(k,1498) = rxt(k,258)*y(k,217) + mat(k,602) = rxt(k,241)*y(k,217) + mat(k,128) = rxt(k,242)*y(k,217) + mat(k,1093) = rxt(k,289)*y(k,217) + mat(k,372) = rxt(k,244)*y(k,217) + mat(k,927) = rxt(k,326)*y(k,217) + mat(k,1228) = rxt(k,315)*y(k,217) + mat(k,688) = rxt(k,295)*y(k,217) + mat(k,616) = rxt(k,296)*y(k,217) + mat(k,390) = rxt(k,264)*y(k,217) + mat(k,1442) = rxt(k,265)*y(k,217) + mat(k,1475) = rxt(k,137)*y(k,203) + mat(k,1412) = rxt(k,142)*y(k,217) + mat(k,609) = rxt(k,143)*y(k,217) + mat(k,811) = rxt(k,225)*y(k,217) + mat(k,309) = rxt(k,249)*y(k,217) + mat(k,2160) = (rxt(k,530)+rxt(k,535))*y(k,91) + (rxt(k,523)+rxt(k,529) & + +rxt(k,534))*y(k,92) + rxt(k,196)*y(k,217) + mat(k,934) = rxt(k,267)*y(k,217) + mat(k,1459) = rxt(k,172)*y(k,217) + mat(k,408) = rxt(k,150)*y(k,217) + mat(k,785) = (rxt(k,530)+rxt(k,535))*y(k,85) + mat(k,830) = (rxt(k,523)+rxt(k,529)+rxt(k,534))*y(k,85) + rxt(k,199)*y(k,217) + mat(k,1219) = .500_r8*rxt(k,339)*y(k,217) + mat(k,98) = rxt(k,479)*y(k,217) + mat(k,539) = rxt(k,320)*y(k,217) + mat(k,414) = rxt(k,324)*y(k,217) + mat(k,1959) = rxt(k,137)*y(k,76) + rxt(k,144)*y(k,217) + mat(k,1703) = rxt(k,287)*y(k,28) + rxt(k,312)*y(k,30) + rxt(k,313)*y(k,31) & + + rxt(k,239)*y(k,41) + rxt(k,258)*y(k,42) + rxt(k,241)*y(k,43) & + + rxt(k,242)*y(k,44) + rxt(k,289)*y(k,45) + rxt(k,244)*y(k,46) & + + rxt(k,326)*y(k,48) + rxt(k,315)*y(k,49) + rxt(k,295)*y(k,50) & + + rxt(k,296)*y(k,51) + rxt(k,264)*y(k,53) + rxt(k,265)*y(k,54) & + + rxt(k,142)*y(k,77) + rxt(k,143)*y(k,79) + rxt(k,225)*y(k,81) & + + rxt(k,249)*y(k,84) + rxt(k,196)*y(k,85) + rxt(k,267)*y(k,87) & + + rxt(k,172)*y(k,89) + rxt(k,150)*y(k,90) + rxt(k,199)*y(k,92) & + .500_r8*rxt(k,339)*y(k,105) + rxt(k,479)*y(k,120) + rxt(k,320) & - *y(k,146) + rxt(k,324)*y(k,147) + rxt(k,143)*y(k,203) & - + 2.000_r8*rxt(k,146)*y(k,217) + *y(k,146) + rxt(k,324)*y(k,147) + rxt(k,144)*y(k,203) & + + 2.000_r8*rxt(k,147)*y(k,217) end do - end subroutine nlnmat09 + end subroutine nlnmat10 subroutine nlnmat_finit( avec_len, mat, lmat, dti ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none @@ -2287,832 +2531,912 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 31) = lmat(k, 31) mat(k, 32) = lmat(k, 32) mat(k, 33) = lmat(k, 33) - mat(k, 39) = mat(k, 39) + lmat(k, 39) - mat(k, 45) = mat(k, 45) + lmat(k, 45) - mat(k, 51) = mat(k, 51) + lmat(k, 51) - mat(k, 57) = mat(k, 57) + lmat(k, 57) - mat(k, 63) = mat(k, 63) + lmat(k, 63) - mat(k, 65) = mat(k, 65) + lmat(k, 65) - mat(k, 71) = mat(k, 71) + lmat(k, 71) - mat(k, 77) = mat(k, 77) + lmat(k, 77) - mat(k, 83) = mat(k, 83) + lmat(k, 83) - mat(k, 84) = mat(k, 84) + lmat(k, 84) - mat(k, 87) = mat(k, 87) + lmat(k, 87) - mat(k, 90) = lmat(k, 90) - mat(k, 91) = lmat(k, 91) - mat(k, 92) = lmat(k, 92) - mat(k, 93) = mat(k, 93) + lmat(k, 93) - mat(k, 97) = lmat(k, 97) - mat(k, 98) = lmat(k, 98) - mat(k, 99) = lmat(k, 99) - mat(k, 100) = lmat(k, 100) - mat(k, 101) = lmat(k, 101) - mat(k, 102) = lmat(k, 102) - mat(k, 103) = mat(k, 103) + lmat(k, 103) - mat(k, 106) = lmat(k, 106) - mat(k, 107) = lmat(k, 107) - mat(k, 108) = lmat(k, 108) + 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) = lmat(k, 39) + mat(k, 40) = lmat(k, 40) + mat(k, 41) = lmat(k, 41) + mat(k, 42) = lmat(k, 42) + mat(k, 48) = mat(k, 48) + lmat(k, 48) + mat(k, 54) = mat(k, 54) + lmat(k, 54) + mat(k, 60) = mat(k, 60) + lmat(k, 60) + mat(k, 66) = mat(k, 66) + lmat(k, 66) + mat(k, 72) = mat(k, 72) + lmat(k, 72) + mat(k, 74) = mat(k, 74) + lmat(k, 74) + mat(k, 80) = mat(k, 80) + lmat(k, 80) + mat(k, 86) = mat(k, 86) + lmat(k, 86) + mat(k, 92) = mat(k, 92) + lmat(k, 92) + mat(k, 93) = lmat(k, 93) + mat(k, 94) = lmat(k, 94) + mat(k, 95) = lmat(k, 95) + mat(k, 96) = mat(k, 96) + lmat(k, 96) + mat(k, 99) = mat(k, 99) + lmat(k, 99) + mat(k, 101) = mat(k, 101) + lmat(k, 101) + mat(k, 102) = mat(k, 102) + lmat(k, 102) + mat(k, 105) = mat(k, 105) + lmat(k, 105) + mat(k, 106) = mat(k, 106) + lmat(k, 106) + mat(k, 107) = mat(k, 107) + lmat(k, 107) mat(k, 109) = mat(k, 109) + lmat(k, 109) - mat(k, 110) = mat(k, 110) + lmat(k, 110) mat(k, 113) = mat(k, 113) + lmat(k, 113) - mat(k, 119) = lmat(k, 119) - mat(k, 120) = lmat(k, 120) - mat(k, 121) = lmat(k, 121) - mat(k, 122) = lmat(k, 122) - mat(k, 123) = mat(k, 123) + lmat(k, 123) - mat(k, 128) = lmat(k, 128) + mat(k, 114) = mat(k, 114) + lmat(k, 114) + mat(k, 116) = mat(k, 116) + lmat(k, 116) + mat(k, 117) = mat(k, 117) + lmat(k, 117) + mat(k, 118) = mat(k, 118) + lmat(k, 118) + mat(k, 120) = mat(k, 120) + lmat(k, 120) + mat(k, 121) = mat(k, 121) + lmat(k, 121) + mat(k, 122) = mat(k, 122) + lmat(k, 122) + mat(k, 124) = mat(k, 124) + lmat(k, 124) + mat(k, 125) = mat(k, 125) + lmat(k, 125) + mat(k, 127) = mat(k, 127) + lmat(k, 127) mat(k, 129) = lmat(k, 129) - mat(k, 130) = mat(k, 130) + lmat(k, 130) - mat(k, 134) = mat(k, 134) + lmat(k, 134) + mat(k, 130) = lmat(k, 130) + mat(k, 131) = lmat(k, 131) + mat(k, 132) = lmat(k, 132) + mat(k, 133) = lmat(k, 133) + mat(k, 134) = lmat(k, 134) mat(k, 135) = mat(k, 135) + lmat(k, 135) - mat(k, 137) = mat(k, 137) + lmat(k, 137) - mat(k, 139) = mat(k, 139) + lmat(k, 139) + mat(k, 138) = lmat(k, 138) + mat(k, 139) = lmat(k, 139) + mat(k, 140) = lmat(k, 140) + mat(k, 141) = mat(k, 141) + lmat(k, 141) + mat(k, 142) = mat(k, 142) + lmat(k, 142) + mat(k, 143) = mat(k, 143) + lmat(k, 143) + mat(k, 145) = mat(k, 145) + lmat(k, 145) mat(k, 146) = mat(k, 146) + lmat(k, 146) - mat(k, 151) = lmat(k, 151) - mat(k, 152) = lmat(k, 152) - mat(k, 153) = lmat(k, 153) - mat(k, 154) = lmat(k, 154) + mat(k, 147) = mat(k, 147) + lmat(k, 147) + mat(k, 148) = mat(k, 148) + lmat(k, 148) + mat(k, 149) = mat(k, 149) + lmat(k, 149) + mat(k, 151) = mat(k, 151) + lmat(k, 151) + mat(k, 152) = mat(k, 152) + lmat(k, 152) + mat(k, 153) = mat(k, 153) + lmat(k, 153) mat(k, 155) = 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, 158) = mat(k, 158) + lmat(k, 158) mat(k, 160) = mat(k, 160) + lmat(k, 160) - mat(k, 168) = mat(k, 168) + lmat(k, 168) + mat(k, 161) = lmat(k, 161) + mat(k, 162) = lmat(k, 162) + mat(k, 164) = mat(k, 164) + lmat(k, 164) + mat(k, 170) = lmat(k, 170) + mat(k, 171) = lmat(k, 171) + mat(k, 172) = lmat(k, 172) mat(k, 173) = lmat(k, 173) - mat(k, 174) = lmat(k, 174) - mat(k, 175) = lmat(k, 175) - mat(k, 176) = mat(k, 176) + lmat(k, 176) - mat(k, 177) = lmat(k, 177) + mat(k, 174) = mat(k, 174) + lmat(k, 174) mat(k, 179) = mat(k, 179) + lmat(k, 179) - mat(k, 180) = lmat(k, 180) - mat(k, 181) = lmat(k, 181) - mat(k, 182) = lmat(k, 182) - mat(k, 183) = lmat(k, 183) + mat(k, 183) = mat(k, 183) + lmat(k, 183) mat(k, 184) = mat(k, 184) + lmat(k, 184) - mat(k, 187) = lmat(k, 187) - mat(k, 188) = lmat(k, 188) - mat(k, 189) = lmat(k, 189) - mat(k, 190) = mat(k, 190) + lmat(k, 190) + mat(k, 187) = mat(k, 187) + lmat(k, 187) mat(k, 194) = mat(k, 194) + lmat(k, 194) - mat(k, 195) = lmat(k, 195) - mat(k, 196) = lmat(k, 196) - mat(k, 198) = mat(k, 198) + lmat(k, 198) - mat(k, 202) = mat(k, 202) + lmat(k, 202) - mat(k, 203) = lmat(k, 203) + mat(k, 199) = lmat(k, 199) + mat(k, 200) = lmat(k, 200) + mat(k, 201) = lmat(k, 201) + mat(k, 202) = lmat(k, 202) + mat(k, 203) = mat(k, 203) + lmat(k, 203) mat(k, 205) = mat(k, 205) + lmat(k, 205) - mat(k, 206) = lmat(k, 206) - mat(k, 207) = lmat(k, 207) - mat(k, 208) = lmat(k, 208) - mat(k, 209) = lmat(k, 209) - mat(k, 210) = mat(k, 210) + lmat(k, 210) - mat(k, 216) = lmat(k, 216) - mat(k, 217) = lmat(k, 217) - mat(k, 218) = lmat(k, 218) - mat(k, 219) = lmat(k, 219) - mat(k, 220) = lmat(k, 220) - mat(k, 221) = lmat(k, 221) - mat(k, 222) = lmat(k, 222) - mat(k, 223) = lmat(k, 223) - mat(k, 224) = lmat(k, 224) + mat(k, 208) = mat(k, 208) + lmat(k, 208) + mat(k, 216) = mat(k, 216) + lmat(k, 216) + mat(k, 221) = mat(k, 221) + lmat(k, 221) + mat(k, 222) = mat(k, 222) + lmat(k, 222) mat(k, 225) = mat(k, 225) + lmat(k, 225) - mat(k, 231) = mat(k, 231) + lmat(k, 231) - mat(k, 237) = mat(k, 237) + lmat(k, 237) - mat(k, 242) = mat(k, 242) + lmat(k, 242) + mat(k, 226) = mat(k, 226) + lmat(k, 226) + mat(k, 227) = mat(k, 227) + lmat(k, 227) + mat(k, 229) = mat(k, 229) + lmat(k, 229) + mat(k, 230) = mat(k, 230) + lmat(k, 230) + mat(k, 231) = lmat(k, 231) + mat(k, 233) = mat(k, 233) + lmat(k, 233) + mat(k, 234) = lmat(k, 234) + mat(k, 235) = mat(k, 235) + lmat(k, 235) + mat(k, 236) = mat(k, 236) + lmat(k, 236) + mat(k, 238) = mat(k, 238) + lmat(k, 238) + mat(k, 241) = lmat(k, 241) + mat(k, 242) = lmat(k, 242) + mat(k, 243) = lmat(k, 243) mat(k, 244) = lmat(k, 244) mat(k, 245) = lmat(k, 245) - mat(k, 246) = mat(k, 246) + lmat(k, 246) - mat(k, 247) = lmat(k, 247) - mat(k, 248) = lmat(k, 248) - mat(k, 249) = lmat(k, 249) - mat(k, 250) = lmat(k, 250) - mat(k, 251) = lmat(k, 251) + mat(k, 246) = lmat(k, 246) + mat(k, 247) = mat(k, 247) + lmat(k, 247) + mat(k, 248) = mat(k, 248) + lmat(k, 248) mat(k, 252) = mat(k, 252) + lmat(k, 252) - mat(k, 255) = mat(k, 255) + lmat(k, 255) - mat(k, 256) = lmat(k, 256) + mat(k, 253) = mat(k, 253) + lmat(k, 253) mat(k, 257) = mat(k, 257) + lmat(k, 257) + mat(k, 258) = lmat(k, 258) mat(k, 259) = lmat(k, 259) - mat(k, 260) = mat(k, 260) + lmat(k, 260) - mat(k, 261) = lmat(k, 261) - mat(k, 262) = lmat(k, 262) - mat(k, 263) = mat(k, 263) + lmat(k, 263) - mat(k, 266) = mat(k, 266) + lmat(k, 266) - mat(k, 267) = lmat(k, 267) + mat(k, 261) = mat(k, 261) + lmat(k, 261) + mat(k, 265) = mat(k, 265) + lmat(k, 265) + mat(k, 266) = lmat(k, 266) mat(k, 268) = mat(k, 268) + lmat(k, 268) - mat(k, 270) = mat(k, 270) + lmat(k, 270) - mat(k, 271) = mat(k, 271) + lmat(k, 271) + mat(k, 269) = lmat(k, 269) + mat(k, 270) = lmat(k, 270) + mat(k, 271) = lmat(k, 271) mat(k, 272) = lmat(k, 272) - mat(k, 273) = mat(k, 273) + lmat(k, 273) - mat(k, 276) = mat(k, 276) + lmat(k, 276) + mat(k, 273) = lmat(k, 273) + mat(k, 274) = lmat(k, 274) + mat(k, 275) = lmat(k, 275) + mat(k, 276) = lmat(k, 276) mat(k, 277) = lmat(k, 277) - mat(k, 279) = mat(k, 279) + lmat(k, 279) - mat(k, 284) = mat(k, 284) + lmat(k, 284) - mat(k, 292) = mat(k, 292) + lmat(k, 292) - mat(k, 296) = mat(k, 296) + lmat(k, 296) + mat(k, 278) = lmat(k, 278) + mat(k, 279) = lmat(k, 279) + mat(k, 280) = lmat(k, 280) + mat(k, 281) = lmat(k, 281) + mat(k, 282) = lmat(k, 282) + mat(k, 283) = lmat(k, 283) + mat(k, 284) = lmat(k, 284) + mat(k, 285) = mat(k, 285) + lmat(k, 285) + mat(k, 291) = mat(k, 291) + lmat(k, 291) mat(k, 297) = mat(k, 297) + lmat(k, 297) - mat(k, 298) = mat(k, 298) + lmat(k, 298) - mat(k, 301) = lmat(k, 301) + mat(k, 303) = mat(k, 303) + lmat(k, 303) mat(k, 304) = mat(k, 304) + lmat(k, 304) - mat(k, 305) = lmat(k, 305) - mat(k, 307) = lmat(k, 307) mat(k, 308) = mat(k, 308) + lmat(k, 308) - mat(k, 309) = lmat(k, 309) - mat(k, 310) = lmat(k, 310) - mat(k, 311) = lmat(k, 311) - mat(k, 312) = lmat(k, 312) - mat(k, 313) = lmat(k, 313) - mat(k, 314) = lmat(k, 314) - mat(k, 315) = lmat(k, 315) - mat(k, 316) = mat(k, 316) + lmat(k, 316) + mat(k, 310) = mat(k, 310) + lmat(k, 310) + mat(k, 315) = mat(k, 315) + lmat(k, 315) mat(k, 317) = lmat(k, 317) - mat(k, 319) = lmat(k, 319) + mat(k, 318) = lmat(k, 318) + mat(k, 319) = mat(k, 319) + lmat(k, 319) mat(k, 320) = mat(k, 320) + lmat(k, 320) - mat(k, 321) = lmat(k, 321) - mat(k, 322) = mat(k, 322) + lmat(k, 322) mat(k, 323) = lmat(k, 323) - mat(k, 324) = mat(k, 324) + lmat(k, 324) - mat(k, 326) = mat(k, 326) + lmat(k, 326) + mat(k, 324) = lmat(k, 324) + mat(k, 325) = lmat(k, 325) + mat(k, 326) = lmat(k, 326) + mat(k, 327) = lmat(k, 327) mat(k, 328) = mat(k, 328) + lmat(k, 328) - mat(k, 329) = lmat(k, 329) + mat(k, 331) = mat(k, 331) + lmat(k, 331) mat(k, 332) = lmat(k, 332) mat(k, 333) = mat(k, 333) + lmat(k, 333) - mat(k, 334) = mat(k, 334) + lmat(k, 334) - mat(k, 335) = mat(k, 335) + lmat(k, 335) + mat(k, 335) = lmat(k, 335) mat(k, 336) = mat(k, 336) + lmat(k, 336) mat(k, 337) = lmat(k, 337) mat(k, 338) = lmat(k, 338) - mat(k, 340) = mat(k, 340) + lmat(k, 340) - mat(k, 342) = lmat(k, 342) - mat(k, 343) = mat(k, 343) + lmat(k, 343) - mat(k, 344) = lmat(k, 344) + mat(k, 339) = mat(k, 339) + lmat(k, 339) + mat(k, 342) = mat(k, 342) + lmat(k, 342) + mat(k, 343) = lmat(k, 343) + mat(k, 344) = mat(k, 344) + lmat(k, 344) mat(k, 346) = mat(k, 346) + lmat(k, 346) + mat(k, 347) = mat(k, 347) + lmat(k, 347) mat(k, 348) = lmat(k, 348) mat(k, 349) = mat(k, 349) + lmat(k, 349) - mat(k, 350) = lmat(k, 350) - mat(k, 352) = mat(k, 352) + lmat(k, 352) - mat(k, 354) = lmat(k, 354) - mat(k, 355) = lmat(k, 355) - mat(k, 356) = mat(k, 356) + lmat(k, 356) - mat(k, 357) = lmat(k, 357) + mat(k, 357) = mat(k, 357) + lmat(k, 357) + mat(k, 358) = lmat(k, 358) mat(k, 360) = mat(k, 360) + lmat(k, 360) - mat(k, 366) = mat(k, 366) + lmat(k, 366) + mat(k, 365) = mat(k, 365) + lmat(k, 365) + mat(k, 369) = mat(k, 369) + lmat(k, 369) mat(k, 370) = lmat(k, 370) - mat(k, 371) = mat(k, 371) + lmat(k, 371) mat(k, 373) = mat(k, 373) + lmat(k, 373) + mat(k, 376) = lmat(k, 376) mat(k, 379) = lmat(k, 379) mat(k, 380) = lmat(k, 380) mat(k, 381) = lmat(k, 381) - mat(k, 382) = mat(k, 382) + lmat(k, 382) + mat(k, 382) = lmat(k, 382) mat(k, 383) = lmat(k, 383) - mat(k, 385) = lmat(k, 385) + mat(k, 384) = lmat(k, 384) + mat(k, 385) = mat(k, 385) + lmat(k, 385) mat(k, 386) = lmat(k, 386) + mat(k, 387) = mat(k, 387) + lmat(k, 387) mat(k, 388) = mat(k, 388) + lmat(k, 388) - mat(k, 389) = mat(k, 389) + lmat(k, 389) - mat(k, 393) = mat(k, 393) + lmat(k, 393) + mat(k, 391) = mat(k, 391) + lmat(k, 391) + mat(k, 392) = lmat(k, 392) mat(k, 394) = lmat(k, 394) - mat(k, 395) = lmat(k, 395) + mat(k, 395) = mat(k, 395) + lmat(k, 395) + mat(k, 396) = lmat(k, 396) mat(k, 397) = mat(k, 397) + lmat(k, 397) mat(k, 398) = lmat(k, 398) - mat(k, 399) = lmat(k, 399) - mat(k, 402) = mat(k, 402) + lmat(k, 402) - mat(k, 410) = mat(k, 410) + lmat(k, 410) - mat(k, 417) = mat(k, 417) + lmat(k, 417) + mat(k, 401) = mat(k, 401) + lmat(k, 401) + mat(k, 402) = lmat(k, 402) + mat(k, 403) = mat(k, 403) + lmat(k, 403) + mat(k, 404) = mat(k, 404) + lmat(k, 404) + mat(k, 405) = lmat(k, 405) + mat(k, 406) = lmat(k, 406) + mat(k, 407) = mat(k, 407) + lmat(k, 407) + mat(k, 409) = mat(k, 409) + lmat(k, 409) + mat(k, 411) = lmat(k, 411) + mat(k, 412) = lmat(k, 412) + mat(k, 413) = mat(k, 413) + lmat(k, 413) + mat(k, 415) = mat(k, 415) + lmat(k, 415) + mat(k, 417) = lmat(k, 417) mat(k, 418) = mat(k, 418) + lmat(k, 418) - mat(k, 421) = lmat(k, 421) - mat(k, 423) = mat(k, 423) + lmat(k, 423) - mat(k, 425) = lmat(k, 425) + mat(k, 419) = lmat(k, 419) + mat(k, 421) = mat(k, 421) + lmat(k, 421) + mat(k, 422) = lmat(k, 422) + mat(k, 424) = lmat(k, 424) + mat(k, 425) = mat(k, 425) + lmat(k, 425) mat(k, 426) = lmat(k, 426) - mat(k, 429) = mat(k, 429) + lmat(k, 429) + mat(k, 427) = mat(k, 427) + lmat(k, 427) + mat(k, 429) = lmat(k, 429) + mat(k, 430) = lmat(k, 430) + mat(k, 431) = mat(k, 431) + lmat(k, 431) + mat(k, 432) = lmat(k, 432) mat(k, 435) = mat(k, 435) + lmat(k, 435) - mat(k, 437) = mat(k, 437) + lmat(k, 437) - mat(k, 438) = lmat(k, 438) mat(k, 441) = mat(k, 441) + lmat(k, 441) - mat(k, 444) = lmat(k, 444) + mat(k, 443) = lmat(k, 443) mat(k, 445) = mat(k, 445) + lmat(k, 445) - mat(k, 446) = lmat(k, 446) - mat(k, 447) = lmat(k, 447) - mat(k, 449) = mat(k, 449) + lmat(k, 449) - mat(k, 450) = lmat(k, 450) - mat(k, 451) = lmat(k, 451) - mat(k, 452) = lmat(k, 452) - mat(k, 453) = lmat(k, 453) + mat(k, 447) = mat(k, 447) + lmat(k, 447) + mat(k, 448) = mat(k, 448) + lmat(k, 448) mat(k, 454) = mat(k, 454) + lmat(k, 454) - mat(k, 456) = mat(k, 456) + lmat(k, 456) - mat(k, 457) = mat(k, 457) + lmat(k, 457) + mat(k, 460) = lmat(k, 460) + mat(k, 461) = lmat(k, 461) mat(k, 462) = lmat(k, 462) - mat(k, 465) = mat(k, 465) + lmat(k, 465) - mat(k, 473) = mat(k, 473) + lmat(k, 473) - mat(k, 477) = mat(k, 477) + lmat(k, 477) - mat(k, 485) = mat(k, 485) + lmat(k, 485) - mat(k, 487) = lmat(k, 487) - mat(k, 489) = lmat(k, 489) - mat(k, 493) = lmat(k, 493) - mat(k, 494) = lmat(k, 494) - mat(k, 495) = lmat(k, 495) - mat(k, 496) = lmat(k, 496) + mat(k, 463) = mat(k, 463) + lmat(k, 463) + mat(k, 467) = mat(k, 467) + lmat(k, 467) + mat(k, 468) = mat(k, 468) + lmat(k, 468) + mat(k, 474) = mat(k, 474) + lmat(k, 474) + mat(k, 476) = lmat(k, 476) + mat(k, 477) = lmat(k, 477) + mat(k, 478) = lmat(k, 478) + mat(k, 479) = mat(k, 479) + lmat(k, 479) + mat(k, 480) = lmat(k, 480) + mat(k, 483) = mat(k, 483) + lmat(k, 483) + mat(k, 491) = mat(k, 491) + lmat(k, 491) + mat(k, 495) = mat(k, 495) + lmat(k, 495) mat(k, 497) = mat(k, 497) + lmat(k, 497) - mat(k, 498) = mat(k, 498) + lmat(k, 498) - mat(k, 504) = mat(k, 504) + lmat(k, 504) - mat(k, 505) = lmat(k, 505) - mat(k, 506) = lmat(k, 506) - mat(k, 507) = lmat(k, 507) + mat(k, 499) = mat(k, 499) + lmat(k, 499) + mat(k, 506) = mat(k, 506) + lmat(k, 506) mat(k, 508) = lmat(k, 508) - mat(k, 510) = mat(k, 510) + lmat(k, 510) - mat(k, 511) = lmat(k, 511) - mat(k, 512) = lmat(k, 512) - mat(k, 513) = mat(k, 513) + lmat(k, 513) - mat(k, 517) = lmat(k, 517) - mat(k, 522) = mat(k, 522) + lmat(k, 522) - mat(k, 523) = mat(k, 523) + lmat(k, 523) - mat(k, 524) = lmat(k, 524) - mat(k, 526) = mat(k, 526) + lmat(k, 526) - mat(k, 527) = lmat(k, 527) - mat(k, 530) = mat(k, 530) + lmat(k, 530) + mat(k, 509) = lmat(k, 509) + mat(k, 511) = mat(k, 511) + lmat(k, 511) + mat(k, 512) = mat(k, 512) + lmat(k, 512) + mat(k, 516) = lmat(k, 516) + mat(k, 518) = mat(k, 518) + lmat(k, 518) + mat(k, 524) = mat(k, 524) + lmat(k, 524) + mat(k, 525) = lmat(k, 525) + mat(k, 526) = lmat(k, 526) + mat(k, 529) = mat(k, 529) + lmat(k, 529) + mat(k, 530) = lmat(k, 530) + mat(k, 531) = lmat(k, 531) + mat(k, 532) = mat(k, 532) + lmat(k, 532) + mat(k, 534) = lmat(k, 534) mat(k, 536) = lmat(k, 536) mat(k, 537) = mat(k, 537) + lmat(k, 537) + mat(k, 538) = lmat(k, 538) + mat(k, 540) = mat(k, 540) + lmat(k, 540) mat(k, 541) = lmat(k, 541) mat(k, 542) = lmat(k, 542) + mat(k, 543) = lmat(k, 543) mat(k, 544) = mat(k, 544) + lmat(k, 544) mat(k, 545) = lmat(k, 545) - mat(k, 546) = lmat(k, 546) - mat(k, 547) = lmat(k, 547) - mat(k, 548) = lmat(k, 548) - mat(k, 549) = lmat(k, 549) - mat(k, 550) = mat(k, 550) + lmat(k, 550) - mat(k, 554) = lmat(k, 554) - mat(k, 557) = lmat(k, 557) - mat(k, 558) = mat(k, 558) + lmat(k, 558) - mat(k, 559) = lmat(k, 559) - mat(k, 560) = lmat(k, 560) - mat(k, 561) = mat(k, 561) + lmat(k, 561) + mat(k, 546) = mat(k, 546) + lmat(k, 546) + mat(k, 548) = mat(k, 548) + lmat(k, 548) + mat(k, 556) = mat(k, 556) + lmat(k, 556) + mat(k, 561) = lmat(k, 561) mat(k, 564) = mat(k, 564) + lmat(k, 564) - mat(k, 565) = mat(k, 565) + lmat(k, 565) - mat(k, 568) = mat(k, 568) + lmat(k, 568) - mat(k, 569) = mat(k, 569) + lmat(k, 569) - mat(k, 570) = lmat(k, 570) mat(k, 572) = mat(k, 572) + lmat(k, 572) - mat(k, 580) = mat(k, 580) + lmat(k, 580) - mat(k, 582) = lmat(k, 582) - mat(k, 583) = lmat(k, 583) + mat(k, 575) = lmat(k, 575) + mat(k, 580) = lmat(k, 580) + mat(k, 581) = mat(k, 581) + lmat(k, 581) mat(k, 585) = lmat(k, 585) - mat(k, 586) = lmat(k, 586) - mat(k, 587) = lmat(k, 587) - mat(k, 588) = lmat(k, 588) - mat(k, 589) = lmat(k, 589) mat(k, 590) = lmat(k, 590) - mat(k, 591) = mat(k, 591) + lmat(k, 591) - mat(k, 595) = lmat(k, 595) - mat(k, 598) = lmat(k, 598) - mat(k, 600) = mat(k, 600) + lmat(k, 600) - mat(k, 601) = lmat(k, 601) + mat(k, 591) = lmat(k, 591) + mat(k, 592) = lmat(k, 592) + mat(k, 593) = lmat(k, 593) + mat(k, 594) = mat(k, 594) + lmat(k, 594) + mat(k, 595) = mat(k, 595) + lmat(k, 595) + mat(k, 600) = lmat(k, 600) + mat(k, 603) = mat(k, 603) + lmat(k, 603) mat(k, 604) = mat(k, 604) + lmat(k, 604) + mat(k, 610) = mat(k, 610) + lmat(k, 610) mat(k, 611) = mat(k, 611) + lmat(k, 611) + mat(k, 614) = mat(k, 614) + lmat(k, 614) + mat(k, 615) = lmat(k, 615) + mat(k, 617) = mat(k, 617) + lmat(k, 617) + mat(k, 618) = mat(k, 618) + lmat(k, 618) + mat(k, 619) = lmat(k, 619) + mat(k, 621) = lmat(k, 621) mat(k, 622) = mat(k, 622) + lmat(k, 622) - mat(k, 638) = mat(k, 638) + lmat(k, 638) - mat(k, 649) = mat(k, 649) + lmat(k, 649) - mat(k, 658) = mat(k, 658) + lmat(k, 658) - mat(k, 668) = mat(k, 668) + lmat(k, 668) - mat(k, 669) = lmat(k, 669) + mat(k, 625) = mat(k, 625) + lmat(k, 625) + mat(k, 631) = lmat(k, 631) + mat(k, 632) = mat(k, 632) + lmat(k, 632) + mat(k, 636) = lmat(k, 636) + mat(k, 637) = lmat(k, 637) + mat(k, 639) = lmat(k, 639) + mat(k, 640) = mat(k, 640) + lmat(k, 640) + mat(k, 641) = lmat(k, 641) + mat(k, 642) = mat(k, 642) + lmat(k, 642) + mat(k, 643) = lmat(k, 643) + mat(k, 644) = lmat(k, 644) + mat(k, 645) = lmat(k, 645) + mat(k, 646) = lmat(k, 646) + mat(k, 647) = lmat(k, 647) + mat(k, 649) = lmat(k, 649) + mat(k, 650) = mat(k, 650) + lmat(k, 650) + mat(k, 651) = lmat(k, 651) + mat(k, 652) = lmat(k, 652) + mat(k, 653) = lmat(k, 653) + mat(k, 654) = lmat(k, 654) + mat(k, 655) = mat(k, 655) + lmat(k, 655) + mat(k, 660) = lmat(k, 660) + mat(k, 662) = lmat(k, 662) + mat(k, 663) = mat(k, 663) + lmat(k, 663) + mat(k, 664) = lmat(k, 664) + mat(k, 665) = lmat(k, 665) + mat(k, 666) = mat(k, 666) + lmat(k, 666) + mat(k, 669) = mat(k, 669) + lmat(k, 669) mat(k, 670) = mat(k, 670) + lmat(k, 670) - mat(k, 676) = mat(k, 676) + lmat(k, 676) + mat(k, 672) = mat(k, 672) + lmat(k, 672) + mat(k, 674) = lmat(k, 674) + mat(k, 675) = mat(k, 675) + lmat(k, 675) mat(k, 677) = mat(k, 677) + lmat(k, 677) - mat(k, 682) = lmat(k, 682) - mat(k, 686) = mat(k, 686) + lmat(k, 686) - mat(k, 696) = mat(k, 696) + lmat(k, 696) - mat(k, 700) = mat(k, 700) + lmat(k, 700) - mat(k, 704) = mat(k, 704) + lmat(k, 704) - mat(k, 705) = mat(k, 705) + lmat(k, 705) - mat(k, 706) = mat(k, 706) + lmat(k, 706) - mat(k, 715) = mat(k, 715) + lmat(k, 715) - mat(k, 724) = mat(k, 724) + lmat(k, 724) - mat(k, 726) = mat(k, 726) + lmat(k, 726) - mat(k, 729) = mat(k, 729) + lmat(k, 729) - mat(k, 735) = mat(k, 735) + lmat(k, 735) - mat(k, 751) = mat(k, 751) + lmat(k, 751) - mat(k, 753) = lmat(k, 753) - mat(k, 755) = mat(k, 755) + lmat(k, 755) - mat(k, 756) = lmat(k, 756) - mat(k, 758) = mat(k, 758) + lmat(k, 758) - mat(k, 759) = lmat(k, 759) - mat(k, 762) = lmat(k, 762) - mat(k, 764) = lmat(k, 764) - mat(k, 765) = mat(k, 765) + lmat(k, 765) - mat(k, 766) = mat(k, 766) + lmat(k, 766) + mat(k, 684) = mat(k, 684) + lmat(k, 684) + mat(k, 690) = mat(k, 690) + lmat(k, 690) + mat(k, 692) = lmat(k, 692) + mat(k, 693) = lmat(k, 693) + mat(k, 694) = lmat(k, 694) + mat(k, 695) = mat(k, 695) + lmat(k, 695) + mat(k, 696) = lmat(k, 696) + mat(k, 697) = lmat(k, 697) + mat(k, 698) = lmat(k, 698) + mat(k, 699) = lmat(k, 699) + mat(k, 700) = lmat(k, 700) + mat(k, 701) = mat(k, 701) + lmat(k, 701) + mat(k, 706) = lmat(k, 706) + mat(k, 708) = lmat(k, 708) + mat(k, 710) = mat(k, 710) + lmat(k, 710) + mat(k, 711) = lmat(k, 711) + mat(k, 714) = mat(k, 714) + lmat(k, 714) + mat(k, 721) = mat(k, 721) + lmat(k, 721) + mat(k, 732) = mat(k, 732) + lmat(k, 732) + mat(k, 748) = mat(k, 748) + lmat(k, 748) + mat(k, 759) = mat(k, 759) + lmat(k, 759) mat(k, 768) = mat(k, 768) + lmat(k, 768) - mat(k, 770) = mat(k, 770) + lmat(k, 770) - mat(k, 788) = mat(k, 788) + lmat(k, 788) + mat(k, 778) = mat(k, 778) + lmat(k, 778) + mat(k, 779) = lmat(k, 779) + mat(k, 780) = mat(k, 780) + lmat(k, 780) + mat(k, 786) = mat(k, 786) + lmat(k, 786) + mat(k, 791) = mat(k, 791) + lmat(k, 791) + mat(k, 801) = lmat(k, 801) + mat(k, 802) = lmat(k, 802) + mat(k, 803) = lmat(k, 803) + mat(k, 804) = mat(k, 804) + lmat(k, 804) + mat(k, 805) = mat(k, 805) + lmat(k, 805) + mat(k, 806) = mat(k, 806) + lmat(k, 806) mat(k, 815) = mat(k, 815) + lmat(k, 815) - mat(k, 837) = mat(k, 837) + lmat(k, 837) - mat(k, 847) = mat(k, 847) + lmat(k, 847) - mat(k, 849) = lmat(k, 849) - mat(k, 851) = lmat(k, 851) - mat(k, 854) = mat(k, 854) + lmat(k, 854) - mat(k, 855) = mat(k, 855) + lmat(k, 855) - mat(k, 856) = mat(k, 856) + lmat(k, 856) + mat(k, 824) = mat(k, 824) + lmat(k, 824) + mat(k, 825) = mat(k, 825) + lmat(k, 825) + mat(k, 827) = mat(k, 827) + lmat(k, 827) + mat(k, 832) = mat(k, 832) + lmat(k, 832) + mat(k, 833) = lmat(k, 833) + mat(k, 836) = lmat(k, 836) + mat(k, 841) = mat(k, 841) + lmat(k, 841) mat(k, 857) = mat(k, 857) + lmat(k, 857) mat(k, 859) = lmat(k, 859) + mat(k, 860) = lmat(k, 860) mat(k, 862) = mat(k, 862) + lmat(k, 862) - mat(k, 863) = mat(k, 863) + lmat(k, 863) - mat(k, 869) = mat(k, 869) + lmat(k, 869) + mat(k, 864) = mat(k, 864) + lmat(k, 864) + mat(k, 873) = mat(k, 873) + lmat(k, 873) + mat(k, 883) = mat(k, 883) + lmat(k, 883) mat(k, 884) = mat(k, 884) + lmat(k, 884) - mat(k, 885) = lmat(k, 885) - mat(k, 886) = lmat(k, 886) - mat(k, 890) = lmat(k, 890) - mat(k, 892) = lmat(k, 892) - mat(k, 896) = mat(k, 896) + lmat(k, 896) - mat(k, 900) = lmat(k, 900) - mat(k, 902) = lmat(k, 902) - mat(k, 906) = mat(k, 906) + lmat(k, 906) - mat(k, 908) = mat(k, 908) + lmat(k, 908) - mat(k, 909) = lmat(k, 909) - mat(k, 911) = mat(k, 911) + lmat(k, 911) + mat(k, 885) = mat(k, 885) + lmat(k, 885) + mat(k, 887) = mat(k, 887) + lmat(k, 887) + mat(k, 888) = mat(k, 888) + lmat(k, 888) + mat(k, 889) = mat(k, 889) + lmat(k, 889) + mat(k, 891) = lmat(k, 891) + mat(k, 899) = mat(k, 899) + lmat(k, 899) mat(k, 912) = mat(k, 912) + lmat(k, 912) - mat(k, 914) = lmat(k, 914) - mat(k, 915) = lmat(k, 915) - mat(k, 916) = mat(k, 916) + lmat(k, 916) - mat(k, 917) = lmat(k, 917) - mat(k, 918) = lmat(k, 918) - mat(k, 920) = lmat(k, 920) - mat(k, 921) = lmat(k, 921) - mat(k, 922) = lmat(k, 922) + mat(k, 922) = mat(k, 922) + lmat(k, 922) mat(k, 924) = lmat(k, 924) mat(k, 926) = lmat(k, 926) - mat(k, 927) = mat(k, 927) + lmat(k, 927) mat(k, 929) = mat(k, 929) + lmat(k, 929) - mat(k, 930) = mat(k, 930) + lmat(k, 930) - mat(k, 931) = mat(k, 931) + lmat(k, 931) - mat(k, 932) = mat(k, 932) + lmat(k, 932) - mat(k, 933) = mat(k, 933) + lmat(k, 933) - mat(k, 936) = mat(k, 936) + lmat(k, 936) - mat(k, 937) = mat(k, 937) + lmat(k, 937) - mat(k, 939) = mat(k, 939) + lmat(k, 939) - mat(k, 943) = mat(k, 943) + lmat(k, 943) - mat(k, 945) = lmat(k, 945) - mat(k, 947) = lmat(k, 947) mat(k, 948) = mat(k, 948) + lmat(k, 948) - mat(k, 956) = mat(k, 956) + lmat(k, 956) - mat(k, 978) = mat(k, 978) + lmat(k, 978) - mat(k, 997) = mat(k, 997) + lmat(k, 997) - mat(k,1013) = mat(k,1013) + lmat(k,1013) - mat(k,1023) = lmat(k,1023) + mat(k, 969) = mat(k, 969) + lmat(k, 969) + mat(k, 971) = lmat(k, 971) + mat(k, 972) = lmat(k, 972) + mat(k, 976) = lmat(k, 976) + mat(k, 977) = lmat(k, 977) + mat(k, 979) = mat(k, 979) + lmat(k, 979) + mat(k, 980) = mat(k, 980) + lmat(k, 980) + mat(k, 982) = mat(k, 982) + lmat(k, 982) + mat(k, 999) = mat(k, 999) + lmat(k, 999) mat(k,1024) = mat(k,1024) + lmat(k,1024) - mat(k,1029) = lmat(k,1029) - mat(k,1030) = lmat(k,1030) - mat(k,1035) = mat(k,1035) + lmat(k,1035) - mat(k,1052) = mat(k,1052) + lmat(k,1052) - mat(k,1072) = mat(k,1072) + lmat(k,1072) - mat(k,1087) = mat(k,1087) + lmat(k,1087) - mat(k,1088) = mat(k,1088) + lmat(k,1088) - mat(k,1091) = mat(k,1091) + lmat(k,1091) - mat(k,1092) = mat(k,1092) + lmat(k,1092) - mat(k,1095) = mat(k,1095) + lmat(k,1095) + mat(k,1045) = mat(k,1045) + lmat(k,1045) + mat(k,1057) = mat(k,1057) + lmat(k,1057) + mat(k,1058) = mat(k,1058) + lmat(k,1058) + mat(k,1059) = mat(k,1059) + lmat(k,1059) + mat(k,1060) = mat(k,1060) + lmat(k,1060) + mat(k,1061) = mat(k,1061) + lmat(k,1061) + mat(k,1062) = mat(k,1062) + lmat(k,1062) + mat(k,1063) = mat(k,1063) + lmat(k,1063) + mat(k,1065) = mat(k,1065) + lmat(k,1065) + mat(k,1069) = lmat(k,1069) + mat(k,1073) = mat(k,1073) + lmat(k,1073) + mat(k,1077) = lmat(k,1077) + mat(k,1081) = mat(k,1081) + lmat(k,1081) + mat(k,1083) = lmat(k,1083) + mat(k,1085) = mat(k,1085) + lmat(k,1085) + mat(k,1086) = lmat(k,1086) + mat(k,1091) = lmat(k,1091) + mat(k,1092) = lmat(k,1092) mat(k,1096) = mat(k,1096) + lmat(k,1096) - mat(k,1099) = mat(k,1099) + lmat(k,1099) + mat(k,1097) = lmat(k,1097) + mat(k,1098) = mat(k,1098) + lmat(k,1098) mat(k,1100) = mat(k,1100) + lmat(k,1100) - mat(k,1101) = mat(k,1101) + lmat(k,1101) - mat(k,1105) = lmat(k,1105) - mat(k,1109) = lmat(k,1109) - mat(k,1110) = mat(k,1110) + lmat(k,1110) - mat(k,1111) = mat(k,1111) + lmat(k,1111) - mat(k,1120) = lmat(k,1120) - mat(k,1124) = lmat(k,1124) - mat(k,1142) = mat(k,1142) + lmat(k,1142) - mat(k,1154) = mat(k,1154) + lmat(k,1154) - mat(k,1159) = lmat(k,1159) - mat(k,1160) = mat(k,1160) + lmat(k,1160) - mat(k,1164) = mat(k,1164) + lmat(k,1164) - mat(k,1166) = mat(k,1166) + lmat(k,1166) - mat(k,1172) = lmat(k,1172) - mat(k,1187) = mat(k,1187) + lmat(k,1187) + mat(k,1103) = mat(k,1103) + lmat(k,1103) + mat(k,1115) = mat(k,1115) + lmat(k,1115) + mat(k,1129) = mat(k,1129) + lmat(k,1129) + mat(k,1140) = mat(k,1140) + lmat(k,1140) + mat(k,1142) = lmat(k,1142) + mat(k,1143) = lmat(k,1143) + mat(k,1145) = mat(k,1145) + lmat(k,1145) + mat(k,1147) = lmat(k,1147) + mat(k,1148) = lmat(k,1148) + mat(k,1149) = lmat(k,1149) + mat(k,1150) = lmat(k,1150) + mat(k,1152) = lmat(k,1152) + mat(k,1153) = mat(k,1153) + lmat(k,1153) + mat(k,1155) = lmat(k,1155) + mat(k,1156) = lmat(k,1156) + mat(k,1157) = lmat(k,1157) + mat(k,1161) = mat(k,1161) + lmat(k,1161) + mat(k,1163) = lmat(k,1163) + mat(k,1173) = mat(k,1173) + lmat(k,1173) + mat(k,1193) = mat(k,1193) + lmat(k,1193) + mat(k,1208) = mat(k,1208) + lmat(k,1208) + mat(k,1209) = mat(k,1209) + lmat(k,1209) + mat(k,1212) = mat(k,1212) + lmat(k,1212) + mat(k,1213) = mat(k,1213) + lmat(k,1213) mat(k,1214) = mat(k,1214) + lmat(k,1214) - mat(k,1233) = mat(k,1233) + lmat(k,1233) - mat(k,1264) = mat(k,1264) + lmat(k,1264) - mat(k,1278) = mat(k,1278) + lmat(k,1278) - mat(k,1291) = mat(k,1291) + lmat(k,1291) - mat(k,1294) = mat(k,1294) + lmat(k,1294) - mat(k,1295) = lmat(k,1295) - mat(k,1304) = mat(k,1304) + lmat(k,1304) - mat(k,1309) = mat(k,1309) + lmat(k,1309) - mat(k,1327) = mat(k,1327) + lmat(k,1327) - mat(k,1336) = mat(k,1336) + lmat(k,1336) - mat(k,1338) = mat(k,1338) + lmat(k,1338) - mat(k,1342) = mat(k,1342) + lmat(k,1342) - mat(k,1344) = mat(k,1344) + lmat(k,1344) - mat(k,1345) = mat(k,1345) + lmat(k,1345) - mat(k,1347) = mat(k,1347) + lmat(k,1347) - mat(k,1348) = mat(k,1348) + lmat(k,1348) - mat(k,1350) = mat(k,1350) + lmat(k,1350) - mat(k,1352) = mat(k,1352) + lmat(k,1352) - mat(k,1353) = mat(k,1353) + lmat(k,1353) - mat(k,1355) = lmat(k,1355) - mat(k,1356) = lmat(k,1356) - mat(k,1358) = lmat(k,1358) - mat(k,1359) = lmat(k,1359) - mat(k,1360) = lmat(k,1360) - mat(k,1362) = mat(k,1362) + lmat(k,1362) - mat(k,1384) = lmat(k,1384) - mat(k,1389) = lmat(k,1389) - mat(k,1502) = mat(k,1502) + lmat(k,1502) - mat(k,1507) = mat(k,1507) + lmat(k,1507) - mat(k,1510) = mat(k,1510) + lmat(k,1510) - mat(k,1513) = mat(k,1513) + lmat(k,1513) - mat(k,1516) = mat(k,1516) + lmat(k,1516) - mat(k,1519) = mat(k,1519) + lmat(k,1519) - mat(k,1544) = mat(k,1544) + lmat(k,1544) - mat(k,1548) = mat(k,1548) + lmat(k,1548) - mat(k,1549) = mat(k,1549) + lmat(k,1549) - mat(k,1550) = mat(k,1550) + lmat(k,1550) - mat(k,1555) = mat(k,1555) + lmat(k,1555) - mat(k,1579) = mat(k,1579) + lmat(k,1579) - mat(k,1640) = mat(k,1640) + lmat(k,1640) - mat(k,1645) = mat(k,1645) + lmat(k,1645) + mat(k,1216) = mat(k,1216) + lmat(k,1216) + mat(k,1220) = mat(k,1220) + lmat(k,1220) + mat(k,1221) = mat(k,1221) + lmat(k,1221) + mat(k,1222) = mat(k,1222) + lmat(k,1222) + mat(k,1226) = lmat(k,1226) + mat(k,1230) = lmat(k,1230) + mat(k,1231) = mat(k,1231) + lmat(k,1231) + mat(k,1232) = mat(k,1232) + lmat(k,1232) + mat(k,1243) = lmat(k,1243) + mat(k,1256) = mat(k,1256) + lmat(k,1256) + mat(k,1272) = lmat(k,1272) + mat(k,1288) = mat(k,1288) + lmat(k,1288) + mat(k,1298) = mat(k,1298) + lmat(k,1298) + mat(k,1311) = mat(k,1311) + lmat(k,1311) + mat(k,1326) = lmat(k,1326) + mat(k,1328) = mat(k,1328) + lmat(k,1328) + mat(k,1332) = mat(k,1332) + lmat(k,1332) + mat(k,1334) = mat(k,1334) + lmat(k,1334) + mat(k,1342) = lmat(k,1342) + mat(k,1354) = mat(k,1354) + lmat(k,1354) + mat(k,1386) = mat(k,1386) + lmat(k,1386) + mat(k,1401) = mat(k,1401) + lmat(k,1401) + mat(k,1415) = mat(k,1415) + lmat(k,1415) + mat(k,1426) = lmat(k,1426) + mat(k,1428) = lmat(k,1428) + mat(k,1429) = mat(k,1429) + lmat(k,1429) + mat(k,1430) = mat(k,1430) + lmat(k,1430) + mat(k,1432) = mat(k,1432) + lmat(k,1432) + mat(k,1433) = mat(k,1433) + lmat(k,1433) + mat(k,1435) = mat(k,1435) + lmat(k,1435) + mat(k,1439) = mat(k,1439) + lmat(k,1439) + mat(k,1441) = lmat(k,1441) + mat(k,1442) = mat(k,1442) + lmat(k,1442) + mat(k,1447) = mat(k,1447) + lmat(k,1447) + mat(k,1451) = mat(k,1451) + lmat(k,1451) + mat(k,1457) = lmat(k,1457) + mat(k,1463) = mat(k,1463) + lmat(k,1463) + mat(k,1468) = mat(k,1468) + lmat(k,1468) + mat(k,1479) = mat(k,1479) + lmat(k,1479) + mat(k,1480) = lmat(k,1480) + mat(k,1484) = mat(k,1484) + lmat(k,1484) + mat(k,1485) = mat(k,1485) + lmat(k,1485) + mat(k,1526) = mat(k,1526) + lmat(k,1526) + mat(k,1538) = lmat(k,1538) mat(k,1691) = mat(k,1691) + lmat(k,1691) - mat(k,1707) = mat(k,1707) + lmat(k,1707) - mat(k,1716) = mat(k,1716) + lmat(k,1716) - mat(k,1719) = mat(k,1719) + lmat(k,1719) - mat(k,1728) = mat(k,1728) + lmat(k,1728) - mat(k,1729) = lmat(k,1729) - mat(k,1732) = mat(k,1732) + lmat(k,1732) - mat(k,1739) = mat(k,1739) + lmat(k,1739) - mat(k,1788) = mat(k,1788) + lmat(k,1788) - mat(k,1845) = mat(k,1845) + lmat(k,1845) - mat(k,1876) = mat(k,1876) + lmat(k,1876) - mat(k,1880) = mat(k,1880) + lmat(k,1880) - mat(k,1889) = mat(k,1889) + lmat(k,1889) - mat(k,1900) = mat(k,1900) + lmat(k,1900) - mat(k,1901) = mat(k,1901) + lmat(k,1901) - mat(k,1917) = mat(k,1917) + lmat(k,1917) - mat(k,1921) = lmat(k,1921) - mat(k,1929) = lmat(k,1929) - mat(k,1932) = mat(k,1932) + lmat(k,1932) - mat(k,1934) = mat(k,1934) + lmat(k,1934) - mat(k,1935) = mat(k,1935) + lmat(k,1935) - mat(k,1979) = mat(k,1979) + lmat(k,1979) + mat(k,1744) = mat(k,1744) + lmat(k,1744) + mat(k,1749) = mat(k,1749) + lmat(k,1749) + mat(k,1750) = mat(k,1750) + lmat(k,1750) + mat(k,1757) = mat(k,1757) + lmat(k,1757) + mat(k,1759) = mat(k,1759) + lmat(k,1759) + mat(k,1785) = mat(k,1785) + lmat(k,1785) + mat(k,1842) = mat(k,1842) + lmat(k,1842) + mat(k,1851) = mat(k,1851) + lmat(k,1851) + mat(k,1950) = mat(k,1950) + lmat(k,1950) + mat(k,1959) = mat(k,1959) + lmat(k,1959) + mat(k,1977) = mat(k,1977) + lmat(k,1977) + mat(k,1978) = mat(k,1978) + lmat(k,1978) mat(k,1984) = mat(k,1984) + lmat(k,1984) - mat(k,1985) = mat(k,1985) + lmat(k,1985) - mat(k,1990) = mat(k,1990) + lmat(k,1990) - mat(k,1993) = mat(k,1993) + lmat(k,1993) - mat(k,2042) = mat(k,2042) + lmat(k,2042) - mat(k,2050) = mat(k,2050) + lmat(k,2050) - mat(k,2054) = mat(k,2054) + lmat(k,2054) - mat(k,2061) = lmat(k,2061) - mat(k,2065) = lmat(k,2065) - mat(k,2067) = mat(k,2067) + lmat(k,2067) - mat(k,2068) = mat(k,2068) + lmat(k,2068) - mat(k,2075) = lmat(k,2075) - mat(k,2080) = mat(k,2080) + lmat(k,2080) - mat(k, 164) = 0._r8 - mat(k, 165) = 0._r8 - mat(k, 265) = 0._r8 - mat(k, 361) = 0._r8 - mat(k, 362) = 0._r8 - mat(k, 375) = 0._r8 - mat(k, 403) = 0._r8 - mat(k, 405) = 0._r8 - mat(k, 413) = 0._r8 - mat(k, 531) = 0._r8 - mat(k, 535) = 0._r8 - mat(k, 538) = 0._r8 - mat(k, 539) = 0._r8 - mat(k, 543) = 0._r8 - mat(k, 551) = 0._r8 - mat(k, 553) = 0._r8 - mat(k, 555) = 0._r8 - mat(k, 556) = 0._r8 - mat(k, 562) = 0._r8 - mat(k, 563) = 0._r8 - mat(k, 566) = 0._r8 - mat(k, 592) = 0._r8 - mat(k, 594) = 0._r8 - mat(k, 596) = 0._r8 - mat(k, 597) = 0._r8 - mat(k, 599) = 0._r8 - mat(k, 605) = 0._r8 - mat(k, 606) = 0._r8 - mat(k, 621) = 0._r8 - mat(k, 623) = 0._r8 - mat(k, 625) = 0._r8 + mat(k,2017) = mat(k,2017) + lmat(k,2017) + mat(k,2070) = mat(k,2070) + lmat(k,2070) + mat(k,2124) = mat(k,2124) + lmat(k,2124) + mat(k,2132) = mat(k,2132) + lmat(k,2132) + mat(k,2136) = mat(k,2136) + lmat(k,2136) + mat(k,2145) = mat(k,2145) + lmat(k,2145) + mat(k,2153) = mat(k,2153) + lmat(k,2153) + mat(k,2156) = mat(k,2156) + lmat(k,2156) + mat(k,2188) = mat(k,2188) + lmat(k,2188) + mat(k,2192) = mat(k,2192) + lmat(k,2192) + mat(k,2194) = mat(k,2194) + lmat(k,2194) + mat(k,2201) = mat(k,2201) + lmat(k,2201) + mat(k,2203) = mat(k,2203) + lmat(k,2203) + mat(k,2211) = mat(k,2211) + lmat(k,2211) + mat(k,2226) = mat(k,2226) + lmat(k,2226) + mat(k,2227) = mat(k,2227) + lmat(k,2227) + mat(k,2254) = mat(k,2254) + lmat(k,2254) + mat(k,2258) = mat(k,2258) + lmat(k,2258) + mat(k,2266) = lmat(k,2266) + mat(k,2270) = lmat(k,2270) + mat(k,2272) = mat(k,2272) + lmat(k,2272) + mat(k,2273) = mat(k,2273) + lmat(k,2273) + mat(k,2284) = lmat(k,2284) + mat(k,2285) = mat(k,2285) + lmat(k,2285) + mat(k, 212) = 0._r8 + mat(k, 213) = 0._r8 + mat(k, 249) = 0._r8 + mat(k, 305) = 0._r8 + mat(k, 341) = 0._r8 + mat(k, 436) = 0._r8 + mat(k, 437) = 0._r8 + mat(k, 456) = 0._r8 + mat(k, 484) = 0._r8 + mat(k, 486) = 0._r8 + mat(k, 493) = 0._r8 + mat(k, 502) = 0._r8 mat(k, 626) = 0._r8 - mat(k, 628) = 0._r8 - mat(k, 637) = 0._r8 - mat(k, 639) = 0._r8 - mat(k, 641) = 0._r8 - mat(k, 642) = 0._r8 - mat(k, 644) = 0._r8 - mat(k, 645) = 0._r8 + mat(k, 629) = 0._r8 + mat(k, 633) = 0._r8 + mat(k, 634) = 0._r8 + mat(k, 638) = 0._r8 + mat(k, 656) = 0._r8 + mat(k, 658) = 0._r8 mat(k, 659) = 0._r8 mat(k, 661) = 0._r8 - mat(k, 666) = 0._r8 - mat(k, 674) = 0._r8 - mat(k, 689) = 0._r8 - mat(k, 695) = 0._r8 + mat(k, 667) = 0._r8 + mat(k, 668) = 0._r8 + mat(k, 671) = 0._r8 + mat(k, 702) = 0._r8 + mat(k, 704) = 0._r8 + mat(k, 705) = 0._r8 + mat(k, 707) = 0._r8 + mat(k, 709) = 0._r8 + mat(k, 715) = 0._r8 mat(k, 717) = 0._r8 + mat(k, 731) = 0._r8 + mat(k, 733) = 0._r8 + mat(k, 734) = 0._r8 + mat(k, 736) = 0._r8 + mat(k, 738) = 0._r8 + mat(k, 747) = 0._r8 + mat(k, 749) = 0._r8 mat(k, 750) = 0._r8 - mat(k, 763) = 0._r8 - mat(k, 787) = 0._r8 - mat(k, 789) = 0._r8 - mat(k, 797) = 0._r8 - mat(k, 804) = 0._r8 - mat(k, 814) = 0._r8 - mat(k, 816) = 0._r8 - mat(k, 824) = 0._r8 - mat(k, 831) = 0._r8 - mat(k, 835) = 0._r8 - mat(k, 836) = 0._r8 - mat(k, 840) = 0._r8 - mat(k, 841) = 0._r8 - mat(k, 844) = 0._r8 - mat(k, 864) = 0._r8 - mat(k, 871) = 0._r8 - mat(k, 873) = 0._r8 - mat(k, 874) = 0._r8 - mat(k, 876) = 0._r8 - mat(k, 877) = 0._r8 - mat(k, 883) = 0._r8 - mat(k, 895) = 0._r8 + mat(k, 752) = 0._r8 + mat(k, 754) = 0._r8 + mat(k, 755) = 0._r8 + mat(k, 770) = 0._r8 + mat(k, 772) = 0._r8 + mat(k, 776) = 0._r8 + mat(k, 781) = 0._r8 + mat(k, 795) = 0._r8 + mat(k, 800) = 0._r8 + mat(k, 818) = 0._r8 + mat(k, 837) = 0._r8 + mat(k, 893) = 0._r8 mat(k, 897) = 0._r8 mat(k, 898) = 0._r8 - mat(k, 899) = 0._r8 - mat(k, 903) = 0._r8 + mat(k, 902) = 0._r8 mat(k, 904) = 0._r8 - mat(k, 905) = 0._r8 - mat(k, 919) = 0._r8 - mat(k, 925) = 0._r8 - mat(k, 928) = 0._r8 - mat(k, 935) = 0._r8 - mat(k, 938) = 0._r8 - mat(k, 954) = 0._r8 - mat(k, 955) = 0._r8 - mat(k, 957) = 0._r8 + mat(k, 907) = 0._r8 + mat(k, 915) = 0._r8 + mat(k, 917) = 0._r8 + mat(k, 930) = 0._r8 + mat(k, 933) = 0._r8 + mat(k, 944) = 0._r8 + mat(k, 950) = 0._r8 + mat(k, 953) = 0._r8 + mat(k, 956) = 0._r8 mat(k, 958) = 0._r8 - mat(k, 959) = 0._r8 - mat(k, 960) = 0._r8 - mat(k, 961) = 0._r8 mat(k, 962) = 0._r8 - mat(k, 963) = 0._r8 - mat(k, 969) = 0._r8 - mat(k, 970) = 0._r8 - mat(k, 979) = 0._r8 - mat(k, 980) = 0._r8 - mat(k, 981) = 0._r8 - mat(k, 982) = 0._r8 + mat(k, 964) = 0._r8 + mat(k, 966) = 0._r8 + mat(k, 967) = 0._r8 + mat(k, 968) = 0._r8 mat(k, 983) = 0._r8 - mat(k, 989) = 0._r8 - mat(k, 994) = 0._r8 - mat(k, 995) = 0._r8 - mat(k, 996) = 0._r8 + mat(k, 993) = 0._r8 mat(k, 998) = 0._r8 - mat(k, 999) = 0._r8 - mat(k,1000) = 0._r8 - mat(k,1001) = 0._r8 mat(k,1002) = 0._r8 - mat(k,1009) = 0._r8 - mat(k,1022) = 0._r8 + mat(k,1004) = 0._r8 + mat(k,1006) = 0._r8 + mat(k,1008) = 0._r8 + mat(k,1012) = 0._r8 + mat(k,1014) = 0._r8 + mat(k,1016) = 0._r8 + mat(k,1017) = 0._r8 + mat(k,1018) = 0._r8 mat(k,1027) = 0._r8 - mat(k,1036) = 0._r8 + mat(k,1028) = 0._r8 + mat(k,1029) = 0._r8 + mat(k,1034) = 0._r8 + mat(k,1038) = 0._r8 + mat(k,1039) = 0._r8 mat(k,1040) = 0._r8 - mat(k,1044) = 0._r8 - mat(k,1055) = 0._r8 - mat(k,1056) = 0._r8 - mat(k,1065) = 0._r8 + mat(k,1046) = 0._r8 + mat(k,1047) = 0._r8 + mat(k,1048) = 0._r8 + mat(k,1049) = 0._r8 + mat(k,1051) = 0._r8 + mat(k,1066) = 0._r8 mat(k,1067) = 0._r8 - mat(k,1069) = 0._r8 - mat(k,1070) = 0._r8 + mat(k,1068) = 0._r8 mat(k,1071) = 0._r8 - mat(k,1073) = 0._r8 mat(k,1074) = 0._r8 mat(k,1075) = 0._r8 - mat(k,1077) = 0._r8 + mat(k,1076) = 0._r8 mat(k,1078) = 0._r8 - mat(k,1079) = 0._r8 - mat(k,1093) = 0._r8 - mat(k,1103) = 0._r8 - mat(k,1119) = 0._r8 - mat(k,1123) = 0._r8 - mat(k,1127) = 0._r8 - mat(k,1130) = 0._r8 - mat(k,1132) = 0._r8 - mat(k,1134) = 0._r8 - mat(k,1135) = 0._r8 - mat(k,1137) = 0._r8 - mat(k,1138) = 0._r8 + mat(k,1080) = 0._r8 + mat(k,1082) = 0._r8 + mat(k,1084) = 0._r8 + mat(k,1101) = 0._r8 + mat(k,1106) = 0._r8 + mat(k,1116) = 0._r8 + mat(k,1117) = 0._r8 + mat(k,1118) = 0._r8 + mat(k,1120) = 0._r8 + mat(k,1125) = 0._r8 + mat(k,1126) = 0._r8 mat(k,1139) = 0._r8 - mat(k,1140) = 0._r8 - mat(k,1143) = 0._r8 - mat(k,1144) = 0._r8 - mat(k,1145) = 0._r8 - mat(k,1147) = 0._r8 - mat(k,1148) = 0._r8 - mat(k,1149) = 0._r8 - mat(k,1156) = 0._r8 - mat(k,1157) = 0._r8 - mat(k,1161) = 0._r8 - mat(k,1167) = 0._r8 - mat(k,1168) = 0._r8 - mat(k,1170) = 0._r8 - mat(k,1171) = 0._r8 - mat(k,1175) = 0._r8 + mat(k,1151) = 0._r8 + mat(k,1154) = 0._r8 + mat(k,1159) = 0._r8 + mat(k,1160) = 0._r8 + mat(k,1162) = 0._r8 + mat(k,1164) = 0._r8 + mat(k,1165) = 0._r8 mat(k,1177) = 0._r8 - mat(k,1184) = 0._r8 - mat(k,1185) = 0._r8 + mat(k,1183) = 0._r8 + mat(k,1186) = 0._r8 mat(k,1188) = 0._r8 mat(k,1190) = 0._r8 mat(k,1191) = 0._r8 mat(k,1192) = 0._r8 - mat(k,1199) = 0._r8 - mat(k,1203) = 0._r8 - mat(k,1204) = 0._r8 - mat(k,1205) = 0._r8 + mat(k,1194) = 0._r8 + mat(k,1195) = 0._r8 + mat(k,1196) = 0._r8 + mat(k,1198) = 0._r8 + mat(k,1200) = 0._r8 mat(k,1206) = 0._r8 - mat(k,1207) = 0._r8 - mat(k,1208) = 0._r8 - mat(k,1209) = 0._r8 - mat(k,1211) = 0._r8 - mat(k,1213) = 0._r8 - mat(k,1215) = 0._r8 - mat(k,1217) = 0._r8 mat(k,1218) = 0._r8 - mat(k,1219) = 0._r8 - mat(k,1226) = 0._r8 mat(k,1227) = 0._r8 - mat(k,1231) = 0._r8 - mat(k,1232) = 0._r8 - mat(k,1235) = 0._r8 - mat(k,1236) = 0._r8 - mat(k,1245) = 0._r8 - mat(k,1265) = 0._r8 - mat(k,1266) = 0._r8 - mat(k,1273) = 0._r8 + mat(k,1237) = 0._r8 + mat(k,1244) = 0._r8 + mat(k,1249) = 0._r8 + mat(k,1250) = 0._r8 + mat(k,1251) = 0._r8 + mat(k,1252) = 0._r8 + mat(k,1253) = 0._r8 + mat(k,1255) = 0._r8 + mat(k,1257) = 0._r8 + mat(k,1259) = 0._r8 + mat(k,1261) = 0._r8 + mat(k,1263) = 0._r8 + mat(k,1268) = 0._r8 + mat(k,1270) = 0._r8 + mat(k,1271) = 0._r8 mat(k,1275) = 0._r8 + mat(k,1278) = 0._r8 mat(k,1279) = 0._r8 - mat(k,1280) = 0._r8 - mat(k,1281) = 0._r8 + mat(k,1282) = 0._r8 + mat(k,1284) = 0._r8 mat(k,1285) = 0._r8 - mat(k,1287) = 0._r8 + mat(k,1286) = 0._r8 + mat(k,1289) = 0._r8 mat(k,1290) = 0._r8 - mat(k,1292) = 0._r8 + mat(k,1291) = 0._r8 mat(k,1293) = 0._r8 - mat(k,1296) = 0._r8 - mat(k,1297) = 0._r8 - mat(k,1298) = 0._r8 - mat(k,1299) = 0._r8 + mat(k,1295) = 0._r8 + mat(k,1300) = 0._r8 + mat(k,1302) = 0._r8 mat(k,1303) = 0._r8 - mat(k,1305) = 0._r8 - mat(k,1307) = 0._r8 - mat(k,1308) = 0._r8 - mat(k,1311) = 0._r8 mat(k,1312) = 0._r8 - mat(k,1313) = 0._r8 - mat(k,1325) = 0._r8 - mat(k,1326) = 0._r8 - mat(k,1328) = 0._r8 + mat(k,1314) = 0._r8 + mat(k,1316) = 0._r8 + mat(k,1322) = 0._r8 + mat(k,1323) = 0._r8 + mat(k,1329) = 0._r8 + mat(k,1333) = 0._r8 + mat(k,1335) = 0._r8 + mat(k,1336) = 0._r8 mat(k,1339) = 0._r8 mat(k,1340) = 0._r8 - mat(k,1341) = 0._r8 - mat(k,1349) = 0._r8 - mat(k,1354) = 0._r8 - mat(k,1363) = 0._r8 - mat(k,1426) = 0._r8 - mat(k,1442) = 0._r8 + mat(k,1344) = 0._r8 + mat(k,1345) = 0._r8 + mat(k,1346) = 0._r8 + mat(k,1351) = 0._r8 + mat(k,1352) = 0._r8 + mat(k,1353) = 0._r8 + mat(k,1356) = 0._r8 + mat(k,1365) = 0._r8 + mat(k,1366) = 0._r8 + mat(k,1387) = 0._r8 + mat(k,1388) = 0._r8 + mat(k,1391) = 0._r8 + mat(k,1397) = 0._r8 + mat(k,1398) = 0._r8 + mat(k,1402) = 0._r8 + mat(k,1403) = 0._r8 + mat(k,1407) = 0._r8 + mat(k,1409) = 0._r8 + mat(k,1416) = 0._r8 + mat(k,1418) = 0._r8 + mat(k,1419) = 0._r8 + mat(k,1423) = 0._r8 + mat(k,1424) = 0._r8 + mat(k,1431) = 0._r8 + mat(k,1436) = 0._r8 + mat(k,1445) = 0._r8 + mat(k,1446) = 0._r8 + mat(k,1448) = 0._r8 + mat(k,1449) = 0._r8 + mat(k,1450) = 0._r8 + mat(k,1453) = 0._r8 + mat(k,1454) = 0._r8 mat(k,1455) = 0._r8 + mat(k,1456) = 0._r8 mat(k,1458) = 0._r8 - mat(k,1460) = 0._r8 - mat(k,1471) = 0._r8 + mat(k,1461) = 0._r8 + mat(k,1462) = 0._r8 + mat(k,1464) = 0._r8 + mat(k,1465) = 0._r8 + mat(k,1467) = 0._r8 + mat(k,1469) = 0._r8 + mat(k,1470) = 0._r8 + mat(k,1472) = 0._r8 + mat(k,1473) = 0._r8 + mat(k,1478) = 0._r8 + mat(k,1482) = 0._r8 + mat(k,1486) = 0._r8 + mat(k,1489) = 0._r8 mat(k,1492) = 0._r8 - mat(k,1506) = 0._r8 - mat(k,1529) = 0._r8 - mat(k,1532) = 0._r8 - mat(k,1534) = 0._r8 - mat(k,1537) = 0._r8 - mat(k,1538) = 0._r8 - mat(k,1539) = 0._r8 - mat(k,1543) = 0._r8 - mat(k,1545) = 0._r8 - mat(k,1547) = 0._r8 - mat(k,1551) = 0._r8 - mat(k,1553) = 0._r8 - mat(k,1556) = 0._r8 - mat(k,1557) = 0._r8 - mat(k,1560) = 0._r8 - mat(k,1606) = 0._r8 - mat(k,1634) = 0._r8 - mat(k,1635) = 0._r8 + mat(k,1493) = 0._r8 + mat(k,1495) = 0._r8 + mat(k,1496) = 0._r8 + mat(k,1523) = 0._r8 + mat(k,1528) = 0._r8 + mat(k,1536) = 0._r8 + mat(k,1605) = 0._r8 + mat(k,1622) = 0._r8 mat(k,1637) = 0._r8 - mat(k,1646) = 0._r8 - mat(k,1650) = 0._r8 - mat(k,1660) = 0._r8 - mat(k,1684) = 0._r8 - mat(k,1685) = 0._r8 - mat(k,1687) = 0._r8 - mat(k,1688) = 0._r8 - mat(k,1692) = 0._r8 - mat(k,1695) = 0._r8 - mat(k,1696) = 0._r8 - mat(k,1698) = 0._r8 - mat(k,1699) = 0._r8 - mat(k,1700) = 0._r8 - mat(k,1708) = 0._r8 - mat(k,1709) = 0._r8 - mat(k,1711) = 0._r8 + mat(k,1640) = 0._r8 + mat(k,1651) = 0._r8 + mat(k,1652) = 0._r8 + mat(k,1674) = 0._r8 + mat(k,1690) = 0._r8 + mat(k,1710) = 0._r8 mat(k,1715) = 0._r8 - mat(k,1717) = 0._r8 - mat(k,1720) = 0._r8 mat(k,1722) = 0._r8 - mat(k,1723) = 0._r8 - mat(k,1724) = 0._r8 - mat(k,1726) = 0._r8 - mat(k,1733) = 0._r8 + mat(k,1728) = 0._r8 + mat(k,1730) = 0._r8 mat(k,1735) = 0._r8 - mat(k,1736) = 0._r8 - mat(k,1737) = 0._r8 - mat(k,1738) = 0._r8 + mat(k,1742) = 0._r8 + mat(k,1743) = 0._r8 mat(k,1745) = 0._r8 - mat(k,1762) = 0._r8 - mat(k,1779) = 0._r8 - mat(k,1780) = 0._r8 - mat(k,1808) = 0._r8 - mat(k,1812) = 0._r8 - mat(k,1813) = 0._r8 - mat(k,1814) = 0._r8 - mat(k,1815) = 0._r8 - mat(k,1817) = 0._r8 - mat(k,1826) = 0._r8 - mat(k,1829) = 0._r8 + mat(k,1747) = 0._r8 + mat(k,1752) = 0._r8 + mat(k,1753) = 0._r8 + mat(k,1754) = 0._r8 + mat(k,1755) = 0._r8 + mat(k,1756) = 0._r8 + mat(k,1758) = 0._r8 + mat(k,1760) = 0._r8 + mat(k,1806) = 0._r8 mat(k,1835) = 0._r8 - mat(k,1838) = 0._r8 - mat(k,1853) = 0._r8 - mat(k,1859) = 0._r8 - mat(k,1865) = 0._r8 + mat(k,1836) = 0._r8 + mat(k,1837) = 0._r8 + mat(k,1839) = 0._r8 + mat(k,1848) = 0._r8 + mat(k,1852) = 0._r8 mat(k,1868) = 0._r8 - mat(k,1872) = 0._r8 - mat(k,1881) = 0._r8 - mat(k,1887) = 0._r8 - mat(k,1893) = 0._r8 - mat(k,1894) = 0._r8 - mat(k,1895) = 0._r8 - mat(k,1896) = 0._r8 - mat(k,1897) = 0._r8 - mat(k,1898) = 0._r8 - mat(k,1902) = 0._r8 - mat(k,1903) = 0._r8 - mat(k,1910) = 0._r8 - mat(k,1911) = 0._r8 + mat(k,1885) = 0._r8 + mat(k,1886) = 0._r8 mat(k,1914) = 0._r8 - mat(k,1916) = 0._r8 mat(k,1918) = 0._r8 mat(k,1920) = 0._r8 - mat(k,1922) = 0._r8 + mat(k,1923) = 0._r8 mat(k,1925) = 0._r8 - mat(k,1927) = 0._r8 - mat(k,1928) = 0._r8 - mat(k,1930) = 0._r8 - mat(k,1933) = 0._r8 - mat(k,1938) = 0._r8 - mat(k,1945) = 0._r8 - mat(k,1952) = 0._r8 - mat(k,1958) = 0._r8 - mat(k,1959) = 0._r8 - mat(k,1962) = 0._r8 - mat(k,1965) = 0._r8 - mat(k,1971) = 0._r8 - mat(k,1978) = 0._r8 + mat(k,1929) = 0._r8 + mat(k,1932) = 0._r8 + mat(k,1937) = 0._r8 + mat(k,1942) = 0._r8 + mat(k,1943) = 0._r8 + mat(k,1946) = 0._r8 + mat(k,1969) = 0._r8 + mat(k,1970) = 0._r8 + mat(k,1972) = 0._r8 + mat(k,1974) = 0._r8 mat(k,1980) = 0._r8 - mat(k,1981) = 0._r8 - mat(k,1982) = 0._r8 - mat(k,1986) = 0._r8 - mat(k,1987) = 0._r8 - mat(k,1991) = 0._r8 - mat(k,1992) = 0._r8 - mat(k,1994) = 0._r8 + mat(k,1985) = 0._r8 mat(k,1995) = 0._r8 + mat(k,1999) = 0._r8 + mat(k,2000) = 0._r8 + mat(k,2001) = 0._r8 + mat(k,2002) = 0._r8 + mat(k,2004) = 0._r8 mat(k,2008) = 0._r8 - mat(k,2012) = 0._r8 - mat(k,2015) = 0._r8 - mat(k,2019) = 0._r8 + mat(k,2011) = 0._r8 + mat(k,2014) = 0._r8 + mat(k,2021) = 0._r8 mat(k,2022) = 0._r8 mat(k,2023) = 0._r8 mat(k,2024) = 0._r8 - mat(k,2025) = 0._r8 - mat(k,2028) = 0._r8 - mat(k,2032) = 0._r8 - mat(k,2034) = 0._r8 mat(k,2035) = 0._r8 - mat(k,2036) = 0._r8 - mat(k,2039) = 0._r8 - mat(k,2051) = 0._r8 - mat(k,2055) = 0._r8 + mat(k,2059) = 0._r8 mat(k,2060) = 0._r8 - mat(k,2062) = 0._r8 + mat(k,2061) = 0._r8 mat(k,2063) = 0._r8 mat(k,2064) = 0._r8 - mat(k,2066) = 0._r8 - mat(k,2069) = 0._r8 - mat(k,2070) = 0._r8 + mat(k,2065) = 0._r8 mat(k,2071) = 0._r8 mat(k,2072) = 0._r8 - mat(k,2073) = 0._r8 mat(k,2074) = 0._r8 + mat(k,2075) = 0._r8 mat(k,2076) = 0._r8 - mat(k,2077) = 0._r8 - mat(k,2078) = 0._r8 - mat(k,2079) = 0._r8 + mat(k,2089) = 0._r8 + mat(k,2093) = 0._r8 + mat(k,2098) = 0._r8 + mat(k,2101) = 0._r8 + mat(k,2104) = 0._r8 + mat(k,2106) = 0._r8 + mat(k,2108) = 0._r8 + mat(k,2109) = 0._r8 + mat(k,2113) = 0._r8 + mat(k,2114) = 0._r8 + mat(k,2115) = 0._r8 + mat(k,2117) = 0._r8 + mat(k,2121) = 0._r8 + mat(k,2133) = 0._r8 + mat(k,2137) = 0._r8 + mat(k,2143) = 0._r8 + mat(k,2146) = 0._r8 + mat(k,2149) = 0._r8 + mat(k,2150) = 0._r8 + mat(k,2151) = 0._r8 + mat(k,2154) = 0._r8 + mat(k,2155) = 0._r8 + mat(k,2157) = 0._r8 + mat(k,2158) = 0._r8 + mat(k,2171) = 0._r8 + mat(k,2174) = 0._r8 + mat(k,2175) = 0._r8 + mat(k,2179) = 0._r8 + mat(k,2180) = 0._r8 + mat(k,2181) = 0._r8 + mat(k,2182) = 0._r8 + mat(k,2186) = 0._r8 + mat(k,2187) = 0._r8 + mat(k,2189) = 0._r8 + mat(k,2190) = 0._r8 + mat(k,2191) = 0._r8 + mat(k,2197) = 0._r8 + mat(k,2198) = 0._r8 + mat(k,2200) = 0._r8 + mat(k,2204) = 0._r8 + mat(k,2212) = 0._r8 + mat(k,2213) = 0._r8 + mat(k,2214) = 0._r8 + mat(k,2215) = 0._r8 + mat(k,2217) = 0._r8 + mat(k,2222) = 0._r8 + mat(k,2223) = 0._r8 + mat(k,2224) = 0._r8 + mat(k,2228) = 0._r8 + mat(k,2230) = 0._r8 + mat(k,2236) = 0._r8 + mat(k,2242) = 0._r8 + mat(k,2243) = 0._r8 + mat(k,2246) = 0._r8 + mat(k,2253) = 0._r8 + mat(k,2259) = 0._r8 + mat(k,2263) = 0._r8 + mat(k,2265) = 0._r8 + mat(k,2267) = 0._r8 + mat(k,2268) = 0._r8 + mat(k,2269) = 0._r8 + mat(k,2271) = 0._r8 + mat(k,2274) = 0._r8 + mat(k,2275) = 0._r8 + mat(k,2276) = 0._r8 + mat(k,2277) = 0._r8 + mat(k,2278) = 0._r8 + mat(k,2279) = 0._r8 + mat(k,2280) = 0._r8 + mat(k,2281) = 0._r8 + mat(k,2282) = 0._r8 + mat(k,2283) = 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) @@ -3146,171 +3470,200 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 31) = mat(k, 31) - dti(k) mat(k, 32) = mat(k, 32) - dti(k) mat(k, 33) = mat(k, 33) - 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, 37) = mat(k, 37) - dti(k) + mat(k, 38) = mat(k, 38) - dti(k) mat(k, 39) = mat(k, 39) - dti(k) - mat(k, 45) = mat(k, 45) - dti(k) - mat(k, 51) = mat(k, 51) - dti(k) - mat(k, 57) = mat(k, 57) - dti(k) - mat(k, 63) = mat(k, 63) - dti(k) - mat(k, 65) = mat(k, 65) - dti(k) - mat(k, 71) = mat(k, 71) - dti(k) - mat(k, 77) = mat(k, 77) - dti(k) - mat(k, 83) = mat(k, 83) - dti(k) - mat(k, 84) = mat(k, 84) - dti(k) - mat(k, 87) = mat(k, 87) - dti(k) - mat(k, 90) = mat(k, 90) - dti(k) + mat(k, 40) = mat(k, 40) - dti(k) + mat(k, 41) = mat(k, 41) - dti(k) + mat(k, 42) = mat(k, 42) - dti(k) + mat(k, 48) = mat(k, 48) - dti(k) + mat(k, 54) = mat(k, 54) - dti(k) + mat(k, 60) = mat(k, 60) - dti(k) + mat(k, 66) = mat(k, 66) - dti(k) + mat(k, 72) = mat(k, 72) - dti(k) + mat(k, 74) = mat(k, 74) - dti(k) + mat(k, 80) = mat(k, 80) - dti(k) + mat(k, 86) = mat(k, 86) - dti(k) + mat(k, 92) = mat(k, 92) - 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, 106) = mat(k, 106) - dti(k) + mat(k, 96) = mat(k, 96) - dti(k) + mat(k, 99) = mat(k, 99) - dti(k) + mat(k, 102) = mat(k, 102) - dti(k) + mat(k, 105) = mat(k, 105) - dti(k) mat(k, 109) = mat(k, 109) - dti(k) mat(k, 113) = mat(k, 113) - dti(k) - mat(k, 119) = mat(k, 119) - dti(k) - mat(k, 123) = mat(k, 123) - dti(k) - mat(k, 128) = mat(k, 128) - dti(k) - mat(k, 130) = mat(k, 130) - dti(k) - mat(k, 134) = mat(k, 134) - dti(k) - mat(k, 139) = mat(k, 139) - dti(k) + mat(k, 117) = mat(k, 117) - dti(k) + mat(k, 121) = mat(k, 121) - dti(k) + mat(k, 125) = mat(k, 125) - dti(k) + mat(k, 129) = mat(k, 129) - dti(k) + mat(k, 132) = mat(k, 132) - dti(k) + mat(k, 135) = mat(k, 135) - dti(k) + mat(k, 138) = mat(k, 138) - dti(k) + mat(k, 141) = mat(k, 141) - dti(k) mat(k, 146) = mat(k, 146) - dti(k) mat(k, 151) = mat(k, 151) - dti(k) - mat(k, 155) = mat(k, 155) - dti(k) - mat(k, 160) = mat(k, 160) - dti(k) - mat(k, 168) = mat(k, 168) - dti(k) - mat(k, 173) = mat(k, 173) - dti(k) - mat(k, 176) = mat(k, 176) - dti(k) - mat(k, 181) = mat(k, 181) - dti(k) - mat(k, 184) = mat(k, 184) - dti(k) + mat(k, 156) = mat(k, 156) - dti(k) + mat(k, 161) = mat(k, 161) - dti(k) + mat(k, 164) = mat(k, 164) - dti(k) + mat(k, 170) = mat(k, 170) - dti(k) + mat(k, 174) = mat(k, 174) - dti(k) + mat(k, 179) = mat(k, 179) - dti(k) + mat(k, 183) = mat(k, 183) - dti(k) mat(k, 187) = mat(k, 187) - dti(k) - mat(k, 190) = mat(k, 190) - dti(k) mat(k, 194) = mat(k, 194) - dti(k) - mat(k, 198) = mat(k, 198) - dti(k) - mat(k, 202) = mat(k, 202) - dti(k) - mat(k, 206) = mat(k, 206) - dti(k) - mat(k, 210) = mat(k, 210) - dti(k) + mat(k, 199) = mat(k, 199) - dti(k) + mat(k, 203) = mat(k, 203) - dti(k) + mat(k, 208) = mat(k, 208) - dti(k) mat(k, 216) = mat(k, 216) - dti(k) - mat(k, 222) = mat(k, 222) - dti(k) - mat(k, 225) = mat(k, 225) - dti(k) - mat(k, 231) = mat(k, 231) - dti(k) - mat(k, 237) = mat(k, 237) - dti(k) - mat(k, 242) = mat(k, 242) - dti(k) - mat(k, 247) = mat(k, 247) - dti(k) - mat(k, 252) = mat(k, 252) - dti(k) + mat(k, 221) = mat(k, 221) - dti(k) + mat(k, 226) = mat(k, 226) - dti(k) + mat(k, 230) = mat(k, 230) - dti(k) + mat(k, 235) = mat(k, 235) - dti(k) + mat(k, 238) = mat(k, 238) - dti(k) + mat(k, 241) = mat(k, 241) - dti(k) + mat(k, 244) = mat(k, 244) - dti(k) + mat(k, 248) = mat(k, 248) - dti(k) + mat(k, 253) = mat(k, 253) - dti(k) mat(k, 257) = mat(k, 257) - dti(k) - mat(k, 263) = mat(k, 263) - dti(k) - mat(k, 268) = mat(k, 268) - dti(k) + mat(k, 261) = mat(k, 261) - dti(k) + mat(k, 265) = mat(k, 265) - dti(k) + mat(k, 269) = mat(k, 269) - dti(k) mat(k, 273) = mat(k, 273) - dti(k) - mat(k, 276) = mat(k, 276) - dti(k) - mat(k, 284) = mat(k, 284) - dti(k) - mat(k, 292) = mat(k, 292) - dti(k) - mat(k, 298) = mat(k, 298) - dti(k) + mat(k, 279) = mat(k, 279) - dti(k) + mat(k, 282) = mat(k, 282) - dti(k) + mat(k, 285) = mat(k, 285) - dti(k) + mat(k, 291) = mat(k, 291) - dti(k) + mat(k, 297) = mat(k, 297) - dti(k) mat(k, 304) = mat(k, 304) - dti(k) mat(k, 310) = mat(k, 310) - dti(k) - mat(k, 316) = mat(k, 316) - dti(k) - mat(k, 322) = mat(k, 322) - dti(k) + mat(k, 315) = mat(k, 315) - dti(k) + mat(k, 320) = mat(k, 320) - dti(k) + mat(k, 323) = mat(k, 323) - dti(k) mat(k, 328) = mat(k, 328) - dti(k) - mat(k, 334) = mat(k, 334) - dti(k) - mat(k, 340) = mat(k, 340) - dti(k) - mat(k, 346) = mat(k, 346) - dti(k) - mat(k, 352) = mat(k, 352) - dti(k) - mat(k, 360) = mat(k, 360) - dti(k) - mat(k, 366) = mat(k, 366) - dti(k) + mat(k, 333) = mat(k, 333) - dti(k) + mat(k, 339) = mat(k, 339) - dti(k) + mat(k, 344) = mat(k, 344) - dti(k) + mat(k, 349) = mat(k, 349) - dti(k) + mat(k, 357) = mat(k, 357) - dti(k) + mat(k, 365) = mat(k, 365) - dti(k) mat(k, 373) = mat(k, 373) - dti(k) mat(k, 379) = mat(k, 379) - dti(k) - mat(k, 382) = mat(k, 382) - dti(k) - mat(k, 389) = mat(k, 389) - dti(k) - mat(k, 393) = mat(k, 393) - dti(k) - mat(k, 402) = mat(k, 402) - dti(k) - mat(k, 410) = mat(k, 410) - dti(k) - mat(k, 417) = mat(k, 417) - dti(k) - mat(k, 423) = mat(k, 423) - dti(k) - mat(k, 429) = mat(k, 429) - dti(k) + mat(k, 385) = mat(k, 385) - dti(k) + mat(k, 391) = mat(k, 391) - dti(k) + mat(k, 397) = mat(k, 397) - dti(k) + mat(k, 403) = mat(k, 403) - dti(k) + mat(k, 409) = mat(k, 409) - dti(k) + mat(k, 415) = mat(k, 415) - dti(k) + mat(k, 421) = mat(k, 421) - dti(k) + mat(k, 427) = mat(k, 427) - dti(k) mat(k, 435) = mat(k, 435) - dti(k) mat(k, 441) = mat(k, 441) - dti(k) - mat(k, 449) = mat(k, 449) - dti(k) - mat(k, 457) = mat(k, 457) - dti(k) - mat(k, 465) = mat(k, 465) - dti(k) - mat(k, 473) = mat(k, 473) - dti(k) - mat(k, 477) = mat(k, 477) - dti(k) - mat(k, 485) = mat(k, 485) - dti(k) - mat(k, 493) = mat(k, 493) - dti(k) - mat(k, 497) = mat(k, 497) - dti(k) - mat(k, 504) = mat(k, 504) - dti(k) - mat(k, 513) = mat(k, 513) - dti(k) - mat(k, 522) = mat(k, 522) - dti(k) - mat(k, 530) = mat(k, 530) - dti(k) - mat(k, 537) = mat(k, 537) - dti(k) - mat(k, 550) = mat(k, 550) - dti(k) - mat(k, 561) = mat(k, 561) - dti(k) + mat(k, 447) = mat(k, 447) - dti(k) + mat(k, 454) = mat(k, 454) - dti(k) + mat(k, 460) = mat(k, 460) - dti(k) + mat(k, 463) = mat(k, 463) - dti(k) + mat(k, 467) = mat(k, 467) - dti(k) + mat(k, 474) = mat(k, 474) - dti(k) + mat(k, 483) = mat(k, 483) - dti(k) + mat(k, 491) = mat(k, 491) - dti(k) + mat(k, 499) = mat(k, 499) - dti(k) + mat(k, 506) = mat(k, 506) - dti(k) + mat(k, 511) = mat(k, 511) - dti(k) + mat(k, 518) = mat(k, 518) - dti(k) + mat(k, 524) = mat(k, 524) - dti(k) + mat(k, 532) = mat(k, 532) - dti(k) + mat(k, 540) = mat(k, 540) - dti(k) + mat(k, 548) = mat(k, 548) - dti(k) + mat(k, 556) = mat(k, 556) - dti(k) + mat(k, 564) = mat(k, 564) - dti(k) mat(k, 572) = mat(k, 572) - dti(k) - mat(k, 580) = mat(k, 580) - dti(k) - mat(k, 591) = mat(k, 591) - dti(k) - mat(k, 604) = mat(k, 604) - dti(k) - mat(k, 611) = mat(k, 611) - dti(k) - mat(k, 622) = mat(k, 622) - dti(k) - mat(k, 638) = mat(k, 638) - dti(k) - mat(k, 649) = mat(k, 649) - dti(k) - mat(k, 658) = mat(k, 658) - dti(k) - mat(k, 668) = mat(k, 668) - dti(k) + mat(k, 581) = mat(k, 581) - dti(k) + mat(k, 590) = mat(k, 590) - dti(k) + mat(k, 594) = mat(k, 594) - dti(k) + mat(k, 603) = mat(k, 603) - dti(k) + mat(k, 610) = mat(k, 610) - dti(k) + mat(k, 617) = mat(k, 617) - dti(k) + mat(k, 625) = mat(k, 625) - dti(k) + mat(k, 632) = mat(k, 632) - dti(k) + mat(k, 642) = mat(k, 642) - dti(k) + mat(k, 655) = mat(k, 655) - dti(k) + mat(k, 666) = mat(k, 666) - dti(k) mat(k, 677) = mat(k, 677) - dti(k) - mat(k, 686) = mat(k, 686) - dti(k) - mat(k, 696) = mat(k, 696) - dti(k) - mat(k, 700) = mat(k, 700) - dti(k) - mat(k, 704) = mat(k, 704) - dti(k) - mat(k, 715) = mat(k, 715) - dti(k) - mat(k, 724) = mat(k, 724) - dti(k) - mat(k, 735) = mat(k, 735) - dti(k) - mat(k, 751) = mat(k, 751) - dti(k) - mat(k, 758) = mat(k, 758) - dti(k) - mat(k, 765) = mat(k, 765) - dti(k) - mat(k, 770) = mat(k, 770) - dti(k) - mat(k, 788) = mat(k, 788) - dti(k) + mat(k, 684) = mat(k, 684) - dti(k) + mat(k, 690) = mat(k, 690) - dti(k) + mat(k, 701) = mat(k, 701) - dti(k) + mat(k, 714) = mat(k, 714) - dti(k) + mat(k, 721) = mat(k, 721) - dti(k) + mat(k, 732) = mat(k, 732) - dti(k) + mat(k, 748) = mat(k, 748) - dti(k) + mat(k, 759) = mat(k, 759) - dti(k) + mat(k, 768) = mat(k, 768) - dti(k) + mat(k, 778) = mat(k, 778) - dti(k) + mat(k, 786) = mat(k, 786) - dti(k) + mat(k, 791) = mat(k, 791) - dti(k) + mat(k, 801) = mat(k, 801) - dti(k) + mat(k, 804) = mat(k, 804) - dti(k) mat(k, 815) = mat(k, 815) - dti(k) - mat(k, 837) = mat(k, 837) - dti(k) - mat(k, 847) = mat(k, 847) - dti(k) - mat(k, 855) = mat(k, 855) - dti(k) - mat(k, 869) = mat(k, 869) - dti(k) + mat(k, 824) = mat(k, 824) - dti(k) + mat(k, 832) = mat(k, 832) - dti(k) + mat(k, 841) = mat(k, 841) - dti(k) + mat(k, 857) = mat(k, 857) - dti(k) + mat(k, 864) = mat(k, 864) - dti(k) + mat(k, 873) = mat(k, 873) - dti(k) mat(k, 884) = mat(k, 884) - dti(k) - mat(k, 896) = mat(k, 896) - dti(k) - mat(k, 908) = mat(k, 908) - dti(k) - mat(k, 916) = mat(k, 916) - dti(k) - mat(k, 930) = mat(k, 930) - dti(k) - mat(k, 939) = mat(k, 939) - dti(k) - mat(k, 943) = mat(k, 943) - dti(k) - mat(k, 956) = mat(k, 956) - dti(k) - mat(k, 978) = mat(k, 978) - dti(k) - mat(k, 997) = mat(k, 997) - dti(k) - mat(k,1013) = mat(k,1013) - dti(k) + mat(k, 899) = mat(k, 899) - dti(k) + mat(k, 912) = mat(k, 912) - dti(k) + mat(k, 922) = mat(k, 922) - dti(k) + mat(k, 929) = mat(k, 929) - dti(k) + mat(k, 948) = mat(k, 948) - dti(k) + mat(k, 969) = mat(k, 969) - dti(k) + mat(k, 979) = mat(k, 979) - dti(k) + mat(k, 999) = mat(k, 999) - dti(k) mat(k,1024) = mat(k,1024) - dti(k) - mat(k,1035) = mat(k,1035) - dti(k) - mat(k,1052) = mat(k,1052) - dti(k) - mat(k,1072) = mat(k,1072) - dti(k) - mat(k,1088) = mat(k,1088) - dti(k) - mat(k,1100) = mat(k,1100) - dti(k) - mat(k,1111) = mat(k,1111) - dti(k) - mat(k,1142) = mat(k,1142) - dti(k) - mat(k,1164) = mat(k,1164) - dti(k) - mat(k,1187) = mat(k,1187) - dti(k) - mat(k,1214) = mat(k,1214) - dti(k) - mat(k,1233) = mat(k,1233) - dti(k) - mat(k,1264) = mat(k,1264) - dti(k) - mat(k,1278) = mat(k,1278) - dti(k) - mat(k,1291) = mat(k,1291) - dti(k) - mat(k,1304) = mat(k,1304) - dti(k) - mat(k,1327) = mat(k,1327) - dti(k) - mat(k,1352) = mat(k,1352) - dti(k) - mat(k,1507) = mat(k,1507) - dti(k) - mat(k,1549) = mat(k,1549) - dti(k) - mat(k,1640) = mat(k,1640) - dti(k) + mat(k,1045) = mat(k,1045) - dti(k) + mat(k,1059) = mat(k,1059) - dti(k) + mat(k,1073) = mat(k,1073) - dti(k) + mat(k,1085) = mat(k,1085) - dti(k) + mat(k,1096) = mat(k,1096) - dti(k) + mat(k,1103) = mat(k,1103) - dti(k) + mat(k,1115) = mat(k,1115) - dti(k) + mat(k,1129) = mat(k,1129) - dti(k) + mat(k,1140) = mat(k,1140) - dti(k) + mat(k,1153) = mat(k,1153) - dti(k) + mat(k,1173) = mat(k,1173) - dti(k) + mat(k,1193) = mat(k,1193) - dti(k) + mat(k,1209) = mat(k,1209) - dti(k) + mat(k,1221) = mat(k,1221) - dti(k) + mat(k,1232) = mat(k,1232) - dti(k) + mat(k,1256) = mat(k,1256) - dti(k) + mat(k,1288) = mat(k,1288) - dti(k) + mat(k,1311) = mat(k,1311) - dti(k) + mat(k,1332) = mat(k,1332) - dti(k) + mat(k,1354) = mat(k,1354) - dti(k) + mat(k,1386) = mat(k,1386) - dti(k) + mat(k,1401) = mat(k,1401) - dti(k) + mat(k,1415) = mat(k,1415) - dti(k) + mat(k,1430) = mat(k,1430) - dti(k) + mat(k,1447) = mat(k,1447) - dti(k) + mat(k,1463) = mat(k,1463) - dti(k) + mat(k,1485) = mat(k,1485) - dti(k) + mat(k,1526) = mat(k,1526) - dti(k) mat(k,1691) = mat(k,1691) - dti(k) - mat(k,1716) = mat(k,1716) - dti(k) - mat(k,1739) = mat(k,1739) - dti(k) - mat(k,1845) = mat(k,1845) - dti(k) - mat(k,1876) = mat(k,1876) - dti(k) - mat(k,1900) = mat(k,1900) - dti(k) - mat(k,1935) = mat(k,1935) - dti(k) - mat(k,1993) = mat(k,1993) - dti(k) - mat(k,2054) = mat(k,2054) - dti(k) - mat(k,2080) = mat(k,2080) - dti(k) + mat(k,1749) = mat(k,1749) - dti(k) + mat(k,1842) = mat(k,1842) - dti(k) + mat(k,1950) = mat(k,1950) - dti(k) + mat(k,1977) = mat(k,1977) - dti(k) + mat(k,2017) = mat(k,2017) - dti(k) + mat(k,2070) = mat(k,2070) - dti(k) + mat(k,2132) = mat(k,2132) - dti(k) + mat(k,2156) = mat(k,2156) - dti(k) + mat(k,2201) = mat(k,2201) - dti(k) + mat(k,2226) = mat(k,2226) - dti(k) + mat(k,2258) = mat(k,2258) - dti(k) + mat(k,2285) = mat(k,2285) - dti(k) end do end subroutine nlnmat_finit subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) @@ -3334,6 +3687,7 @@ subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) call nlnmat07( avec_len, mat, y, rxt ) call nlnmat08( avec_len, mat, y, rxt ) call nlnmat09( avec_len, mat, y, rxt ) + call nlnmat10( 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_mam4_vbs/mo_prod_loss.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 index 82b7f3c606..881a4ebf4b 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_prod_loss.F90 @@ -27,78 +27,10 @@ subroutine exp_prod_loss( ofl, ofu, prod, loss, y, & ! ... loss and production for Explicit method !-------------------------------------------------------------------- do k = ofl,ofu - loss(k,1) = ( + het_rates(k,3))* y(k,3) + loss(k,1) = ( + het_rates(k,186))* y(k,186) prod(k,1) = 0._r8 - loss(k,2) = ( + het_rates(k,21))* y(k,21) + loss(k,2) = ( + het_rates(k,187))* y(k,187) prod(k,2) = 0._r8 - loss(k,3) = (rxt(k,199)* y(k,216) + rxt(k,78) + het_rates(k,33))* y(k,33) - prod(k,3) = 0._r8 - loss(k,4) = (rxt(k,200)* y(k,216) + rxt(k,79) + het_rates(k,34))* y(k,34) - prod(k,4) = 0._r8 - loss(k,5) = (rxt(k,226)* y(k,216) + rxt(k,80) + het_rates(k,35))* y(k,35) - prod(k,5) = 0._r8 - loss(k,6) = (rxt(k,201)* y(k,216) + rxt(k,81) + het_rates(k,36))* y(k,36) - prod(k,6) = 0._r8 - loss(k,7) = (rxt(k,202)* y(k,216) + rxt(k,82) + het_rates(k,37))* y(k,37) - prod(k,7) = 0._r8 - loss(k,8) = (rxt(k,203)* y(k,216) + rxt(k,83) + het_rates(k,38))* y(k,38) - prod(k,8) = 0._r8 - loss(k,9) = (rxt(k,204)* y(k,216) + rxt(k,84) + het_rates(k,39))* y(k,39) - prod(k,9) = 0._r8 - loss(k,10) = (rxt(k,205)* y(k,216) + rxt(k,85) + het_rates(k,40))* y(k,40) - prod(k,10) = 0._r8 - loss(k,11) = (rxt(k,237)* y(k,56) +rxt(k,249)* y(k,216) +rxt(k,238)* y(k,217) & - + rxt(k,86) + het_rates(k,41))* y(k,41) - prod(k,11) = 0._r8 - loss(k,12) = (rxt(k,239)* y(k,56) +rxt(k,250)* y(k,216) +rxt(k,240)* y(k,217) & - + rxt(k,87) + het_rates(k,43))* y(k,43) - prod(k,12) = 0._r8 - loss(k,13) = (rxt(k,241)* y(k,217) + rxt(k,88) + het_rates(k,44))* y(k,44) - prod(k,13) = 0._r8 - loss(k,14) = (rxt(k,242)* y(k,56) +rxt(k,243)* y(k,217) + rxt(k,89) & - + het_rates(k,46))* y(k,46) - prod(k,14) = 0._r8 - loss(k,15) = (rxt(k,175)* y(k,56) +rxt(k,231)* y(k,73) + (rxt(k,271) + & - rxt(k,272) +rxt(k,273))* y(k,216) +rxt(k,264)* y(k,217) + rxt(k,39) & - + rxt(k,40) + het_rates(k,54))* y(k,54) - prod(k,15) = 0._r8 - loss(k,16) = (rxt(k,244)* y(k,56) +rxt(k,227)* y(k,216) +rxt(k,245)* y(k,217) & - + rxt(k,90) + het_rates(k,55))* y(k,55) - prod(k,16) = 0._r8 - loss(k,17) = ( + het_rates(k,61))* y(k,61) - prod(k,17) = 0._r8 - loss(k,18) = ( + rxt(k,41) + het_rates(k,63))* y(k,63) - prod(k,18) =.440_r8*rxt(k,40)*y(k,54) - loss(k,19) = ( + rxt(k,539) + het_rates(k,71))* y(k,71) - prod(k,19) = 0._r8 - loss(k,20) = (rxt(k,228)* y(k,216) + rxt(k,98) + het_rates(k,78))* y(k,78) - prod(k,20) = 0._r8 - loss(k,21) = (rxt(k,251)* y(k,216) +rxt(k,246)* y(k,217) + rxt(k,100) & - + het_rates(k,82))* y(k,82) - prod(k,21) = 0._r8 - loss(k,22) = (rxt(k,252)* y(k,216) +rxt(k,247)* y(k,217) + rxt(k,101) & - + het_rates(k,83))* y(k,83) - prod(k,22) = 0._r8 - loss(k,23) = (rxt(k,253)* y(k,216) +rxt(k,248)* y(k,217) + rxt(k,102) & - + het_rates(k,84))* y(k,84) - prod(k,23) = 0._r8 - loss(k,24) = ((rxt(k,166) +rxt(k,167))* y(k,216) + rxt(k,12) & - + het_rates(k,113))* y(k,113) - prod(k,24) = 0._r8 - loss(k,25) = ( + rxt(k,541) + het_rates(k,122))* y(k,122) - prod(k,25) = 0._r8 - loss(k,26) = ( + rxt(k,540) + het_rates(k,123))* y(k,123) - prod(k,26) = 0._r8 - loss(k,27) = ( + het_rates(k,135))* y(k,135) - prod(k,27) = 0._r8 - loss(k,28) = ( + rxt(k,108) + het_rates(k,149))* y(k,149) - prod(k,28) = 0._r8 - loss(k,29) = ( + rxt(k,542) + het_rates(k,171))* y(k,171) - prod(k,29) = 0._r8 - loss(k,30) = ( + het_rates(k,186))* y(k,186) - prod(k,30) = 0._r8 - loss(k,31) = ( + het_rates(k,187))* y(k,187) - prod(k,31) = 0._r8 end do end subroutine exp_prod_loss subroutine imp_prod_loss( avec_len, prod, loss, y, & @@ -123,104 +55,129 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & ! ... loss and production for Implicit method !-------------------------------------------------------------------- do k = 1,avec_len - loss(k,128) = (rxt(k,356)* y(k,217) + rxt(k,19) + het_rates(k,1))* y(k,1) - prod(k,128) =rxt(k,359)*y(k,189)*y(k,124) - loss(k,126) = (rxt(k,360)* y(k,217) + rxt(k,20) + het_rates(k,2))* y(k,2) - prod(k,126) =rxt(k,357)*y(k,203)*y(k,189) - loss(k,1) = ( + het_rates(k,4))* y(k,4) + loss(k,154) = (rxt(k,356)* y(k,217) + rxt(k,19) + het_rates(k,1))* y(k,1) + prod(k,154) =rxt(k,359)*y(k,189)*y(k,124) + loss(k,151) = (rxt(k,360)* y(k,217) + rxt(k,20) + het_rates(k,2))* y(k,2) + prod(k,151) =rxt(k,357)*y(k,203)*y(k,189) + loss(k,1) = ( + het_rates(k,3))* y(k,3) prod(k,1) = 0._r8 - loss(k,2) = ( + het_rates(k,5))* y(k,5) + loss(k,2) = ( + het_rates(k,4))* y(k,4) prod(k,2) = 0._r8 - loss(k,151) = (rxt(k,439)* y(k,126) +rxt(k,440)* y(k,134) +rxt(k,441) & + loss(k,3) = ( + het_rates(k,5))* y(k,5) + prod(k,3) = 0._r8 + loss(k,185) = (rxt(k,439)* y(k,126) +rxt(k,440)* y(k,134) +rxt(k,441) & * y(k,217) + het_rates(k,6))* y(k,6) - prod(k,151) = 0._r8 - loss(k,52) = (rxt(k,398)* y(k,217) + het_rates(k,7))* y(k,7) - prod(k,52) = 0._r8 - loss(k,91) = (rxt(k,401)* y(k,217) + rxt(k,21) + het_rates(k,8))* y(k,8) - prod(k,91) =rxt(k,399)*y(k,203)*y(k,191) - loss(k,53) = ( + rxt(k,22) + het_rates(k,9))* y(k,9) - prod(k,53) =.120_r8*rxt(k,398)*y(k,217)*y(k,7) - loss(k,92) = ( + rxt(k,23) + het_rates(k,10))* y(k,10) - prod(k,92) = (.100_r8*rxt(k,440)*y(k,6) +.100_r8*rxt(k,443)*y(k,110)) & + prod(k,185) = 0._r8 + loss(k,71) = (rxt(k,398)* y(k,217) + het_rates(k,7))* y(k,7) + prod(k,71) = 0._r8 + loss(k,121) = (rxt(k,401)* y(k,217) + rxt(k,21) + het_rates(k,8))* y(k,8) + prod(k,121) =rxt(k,399)*y(k,203)*y(k,191) + loss(k,72) = ( + rxt(k,22) + het_rates(k,9))* y(k,9) + prod(k,72) =.120_r8*rxt(k,398)*y(k,217)*y(k,7) + loss(k,114) = ( + rxt(k,23) + het_rates(k,10))* y(k,10) + prod(k,114) = (.100_r8*rxt(k,440)*y(k,6) +.100_r8*rxt(k,443)*y(k,110)) & *y(k,134) - loss(k,103) = ( + rxt(k,24) + het_rates(k,11))* y(k,11) - prod(k,103) = (.500_r8*rxt(k,400)*y(k,191) +.200_r8*rxt(k,427)*y(k,223) + & + loss(k,127) = ( + rxt(k,24) + het_rates(k,11))* y(k,11) + prod(k,127) = (.500_r8*rxt(k,400)*y(k,191) +.200_r8*rxt(k,427)*y(k,223) + & .060_r8*rxt(k,433)*y(k,226))*y(k,124) +.500_r8*rxt(k,21)*y(k,8) & +rxt(k,22)*y(k,9) +.200_r8*rxt(k,70)*y(k,179) +.060_r8*rxt(k,72) & *y(k,183) - loss(k,76) = ( + rxt(k,25) + het_rates(k,12))* y(k,12) - prod(k,76) = (.200_r8*rxt(k,427)*y(k,223) +.200_r8*rxt(k,433)*y(k,226)) & + loss(k,96) = ( + rxt(k,25) + het_rates(k,12))* y(k,12) + prod(k,96) = (.200_r8*rxt(k,427)*y(k,223) +.200_r8*rxt(k,433)*y(k,226)) & *y(k,124) +.200_r8*rxt(k,70)*y(k,179) +.200_r8*rxt(k,72)*y(k,183) - loss(k,120) = ( + rxt(k,26) + het_rates(k,13))* y(k,13) - prod(k,120) = (.200_r8*rxt(k,427)*y(k,223) +.150_r8*rxt(k,433)*y(k,226)) & + loss(k,145) = ( + rxt(k,26) + het_rates(k,13))* y(k,13) + prod(k,145) = (.200_r8*rxt(k,427)*y(k,223) +.150_r8*rxt(k,433)*y(k,226)) & *y(k,124) +rxt(k,46)*y(k,94) +rxt(k,56)*y(k,116) +.200_r8*rxt(k,70) & *y(k,179) +.150_r8*rxt(k,72)*y(k,183) - loss(k,81) = ( + rxt(k,27) + het_rates(k,14))* y(k,14) - prod(k,81) =.210_r8*rxt(k,433)*y(k,226)*y(k,124) +.210_r8*rxt(k,72)*y(k,183) - loss(k,67) = (rxt(k,361)* y(k,217) + het_rates(k,15))* y(k,15) - prod(k,67) = (.050_r8*rxt(k,440)*y(k,6) +.050_r8*rxt(k,443)*y(k,110)) & + loss(k,105) = ( + rxt(k,27) + het_rates(k,14))* y(k,14) + prod(k,105) =.210_r8*rxt(k,433)*y(k,226)*y(k,124) +.210_r8*rxt(k,72)*y(k,183) + loss(k,86) = (rxt(k,361)* y(k,217) + het_rates(k,15))* y(k,15) + prod(k,86) = (.050_r8*rxt(k,440)*y(k,6) +.050_r8*rxt(k,443)*y(k,110)) & *y(k,134) - loss(k,88) = (rxt(k,327)* y(k,126) +rxt(k,328)* y(k,217) + het_rates(k,16)) & + loss(k,110) = (rxt(k,327)* y(k,126) +rxt(k,328)* y(k,217) + het_rates(k,16)) & * y(k,16) - prod(k,88) = 0._r8 - loss(k,181) = (rxt(k,210)* y(k,42) +rxt(k,212)* y(k,134) +rxt(k,211) & + prod(k,110) = 0._r8 + loss(k,209) = (rxt(k,211)* y(k,42) +rxt(k,213)* y(k,134) +rxt(k,212) & * y(k,203) + het_rates(k,17))* y(k,17) - prod(k,181) = (rxt(k,75) +2.000_r8*rxt(k,213)*y(k,19) +rxt(k,214)*y(k,59) + & - rxt(k,215)*y(k,59) +rxt(k,218)*y(k,124) +rxt(k,221)*y(k,133) + & - rxt(k,222)*y(k,217) +rxt(k,468)*y(k,150))*y(k,19) & - + (rxt(k,200)*y(k,34) +rxt(k,226)*y(k,35) + & - 3.000_r8*rxt(k,227)*y(k,55) +2.000_r8*rxt(k,228)*y(k,78) + & - 2.000_r8*rxt(k,249)*y(k,41) +rxt(k,250)*y(k,43) +rxt(k,229)*y(k,81)) & - *y(k,216) + (2.000_r8*rxt(k,238)*y(k,41) +rxt(k,240)*y(k,43) + & - 3.000_r8*rxt(k,245)*y(k,55) +rxt(k,224)*y(k,81))*y(k,217) & - + (2.000_r8*rxt(k,237)*y(k,41) +rxt(k,239)*y(k,43) + & - 3.000_r8*rxt(k,244)*y(k,55))*y(k,56) + (rxt(k,99) + & - rxt(k,223)*y(k,133))*y(k,81) +rxt(k,74)*y(k,18) +rxt(k,77)*y(k,20) & - +rxt(k,105)*y(k,91) - loss(k,68) = ( + rxt(k,74) + het_rates(k,18))* y(k,18) - prod(k,68) = (rxt(k,530)*y(k,91) +rxt(k,535)*y(k,91))*y(k,85) & - +rxt(k,216)*y(k,59)*y(k,19) - loss(k,190) = (2._r8*rxt(k,213)* y(k,19) + (rxt(k,214) +rxt(k,215) + & - rxt(k,216))* y(k,59) +rxt(k,218)* y(k,124) +rxt(k,219)* y(k,125) & - +rxt(k,221)* y(k,133) +rxt(k,468)* y(k,150) +rxt(k,217)* y(k,203) & - +rxt(k,222)* y(k,217) + rxt(k,75) + het_rates(k,19))* y(k,19) - prod(k,190) = (rxt(k,76) +rxt(k,220)*y(k,133))*y(k,20) +rxt(k,212)*y(k,134) & - *y(k,17) +rxt(k,230)*y(k,216)*y(k,81) +rxt(k,225)*y(k,133)*y(k,91) - loss(k,114) = (rxt(k,220)* y(k,133) + rxt(k,76) + rxt(k,77) + rxt(k,524) & + prod(k,209) = (rxt(k,75) +2.000_r8*rxt(k,214)*y(k,19) +rxt(k,215)*y(k,59) + & + rxt(k,216)*y(k,59) +rxt(k,219)*y(k,124) +rxt(k,222)*y(k,133) + & + rxt(k,223)*y(k,217) +rxt(k,469)*y(k,150))*y(k,19) & + + (rxt(k,201)*y(k,34) +rxt(k,227)*y(k,35) + & + 3.000_r8*rxt(k,228)*y(k,55) +2.000_r8*rxt(k,229)*y(k,78) + & + rxt(k,230)*y(k,81) +2.000_r8*rxt(k,250)*y(k,41) +rxt(k,251)*y(k,43)) & + *y(k,216) + (rxt(k,225)*y(k,81) +2.000_r8*rxt(k,239)*y(k,41) + & + rxt(k,241)*y(k,43) +3.000_r8*rxt(k,246)*y(k,55))*y(k,217) & + + (2.000_r8*rxt(k,238)*y(k,41) +rxt(k,240)*y(k,43) + & + 3.000_r8*rxt(k,245)*y(k,55))*y(k,56) + (rxt(k,99) + & + rxt(k,224)*y(k,133))*y(k,81) +rxt(k,74)*y(k,18) +rxt(k,77)*y(k,20) & + +rxt(k,79)*y(k,34) +rxt(k,80)*y(k,35) +2.000_r8*rxt(k,86)*y(k,41) & + +rxt(k,87)*y(k,43) +3.000_r8*rxt(k,90)*y(k,55) +2.000_r8*rxt(k,98) & + *y(k,78) +rxt(k,105)*y(k,91) + loss(k,87) = ( + rxt(k,74) + het_rates(k,18))* y(k,18) + prod(k,87) = (rxt(k,530)*y(k,91) +rxt(k,535)*y(k,91))*y(k,85) & + +rxt(k,217)*y(k,59)*y(k,19) + loss(k,225) = (2._r8*rxt(k,214)* y(k,19) + (rxt(k,215) +rxt(k,216) + & + rxt(k,217))* y(k,59) +rxt(k,219)* y(k,124) +rxt(k,220)* y(k,125) & + +rxt(k,222)* y(k,133) +rxt(k,469)* y(k,150) +rxt(k,218)* y(k,203) & + +rxt(k,223)* y(k,217) + rxt(k,75) + het_rates(k,19))* y(k,19) + prod(k,225) = (rxt(k,76) +rxt(k,221)*y(k,133))*y(k,20) +rxt(k,213)*y(k,134) & + *y(k,17) +rxt(k,231)*y(k,216)*y(k,81) +rxt(k,226)*y(k,133)*y(k,91) + loss(k,139) = (rxt(k,221)* y(k,133) + rxt(k,76) + rxt(k,77) + rxt(k,524) & + rxt(k,527) + rxt(k,532) + het_rates(k,20))* y(k,20) - prod(k,114) =rxt(k,219)*y(k,125)*y(k,19) - loss(k,69) = (rxt(k,402)* y(k,217) + het_rates(k,22))* y(k,22) - prod(k,69) =rxt(k,28)*y(k,23) +rxt(k,405)*y(k,193)*y(k,124) - loss(k,84) = (rxt(k,404)* y(k,217) + rxt(k,28) + het_rates(k,23))* y(k,23) - prod(k,84) =rxt(k,403)*y(k,203)*y(k,193) - loss(k,77) = (rxt(k,276)* y(k,56) +rxt(k,277)* y(k,217) + het_rates(k,24)) & + prod(k,139) =rxt(k,220)*y(k,125)*y(k,19) + loss(k,4) = ( + het_rates(k,21))* y(k,21) + prod(k,4) = 0._r8 + loss(k,90) = (rxt(k,402)* y(k,217) + het_rates(k,22))* y(k,22) + prod(k,90) =rxt(k,28)*y(k,23) +rxt(k,405)*y(k,193)*y(k,124) + loss(k,108) = (rxt(k,404)* y(k,217) + rxt(k,28) + het_rates(k,23))* y(k,23) + prod(k,108) =rxt(k,403)*y(k,203)*y(k,193) + loss(k,98) = (rxt(k,276)* y(k,56) +rxt(k,277)* y(k,217) + het_rates(k,24)) & * y(k,24) - prod(k,77) = 0._r8 - loss(k,116) = (rxt(k,278)* y(k,56) +rxt(k,279)* y(k,134) +rxt(k,304) & + prod(k,98) = 0._r8 + loss(k,140) = (rxt(k,278)* y(k,56) +rxt(k,279)* y(k,134) +rxt(k,304) & * y(k,217) + het_rates(k,25))* y(k,25) - prod(k,116) = 0._r8 - loss(k,71) = (rxt(k,284)* y(k,217) + het_rates(k,26))* y(k,26) - prod(k,71) = (.400_r8*rxt(k,280)*y(k,194) +.200_r8*rxt(k,281)*y(k,198)) & + prod(k,140) = 0._r8 + loss(k,92) = (rxt(k,284)* y(k,217) + het_rates(k,26))* y(k,26) + prod(k,92) = (.400_r8*rxt(k,280)*y(k,194) +.200_r8*rxt(k,281)*y(k,198)) & *y(k,194) - loss(k,85) = (rxt(k,285)* y(k,217) + rxt(k,29) + het_rates(k,27))* y(k,27) - prod(k,85) =rxt(k,282)*y(k,203)*y(k,194) - loss(k,78) = (rxt(k,286)* y(k,56) +rxt(k,287)* y(k,217) + het_rates(k,28)) & + loss(k,109) = (rxt(k,285)* y(k,217) + rxt(k,29) + het_rates(k,27))* y(k,27) + prod(k,109) =rxt(k,282)*y(k,203)*y(k,194) + loss(k,99) = (rxt(k,286)* y(k,56) +rxt(k,287)* y(k,217) + het_rates(k,28)) & * y(k,28) - prod(k,78) = 0._r8 - loss(k,156) = (rxt(k,307)* y(k,126) +rxt(k,308)* y(k,134) +rxt(k,325) & + prod(k,99) = 0._r8 + loss(k,186) = (rxt(k,307)* y(k,126) +rxt(k,308)* y(k,134) +rxt(k,325) & * y(k,217) + het_rates(k,29))* y(k,29) - prod(k,156) =.130_r8*rxt(k,385)*y(k,134)*y(k,98) +.700_r8*rxt(k,55)*y(k,111) - loss(k,98) = (rxt(k,312)* y(k,217) + rxt(k,30) + het_rates(k,30))* y(k,30) - prod(k,98) =rxt(k,310)*y(k,203)*y(k,195) - loss(k,46) = (rxt(k,313)* y(k,217) + het_rates(k,31))* y(k,31) - prod(k,46) = 0._r8 - loss(k,72) = (rxt(k,408)* y(k,217) + rxt(k,31) + het_rates(k,32))* y(k,32) - prod(k,72) =rxt(k,406)*y(k,203)*y(k,196) - loss(k,191) = (rxt(k,210)* y(k,17) +rxt(k,174)* y(k,56) +rxt(k,255)* y(k,126) & - +rxt(k,256)* y(k,133) +rxt(k,254)* y(k,203) +rxt(k,257)* y(k,217) & + prod(k,186) =.130_r8*rxt(k,385)*y(k,134)*y(k,98) +.700_r8*rxt(k,55)*y(k,111) + loss(k,120) = (rxt(k,312)* y(k,217) + rxt(k,30) + het_rates(k,30))* y(k,30) + prod(k,120) =rxt(k,310)*y(k,203)*y(k,195) + loss(k,57) = (rxt(k,313)* y(k,217) + het_rates(k,31))* y(k,31) + prod(k,57) = 0._r8 + loss(k,93) = (rxt(k,408)* y(k,217) + rxt(k,31) + het_rates(k,32))* y(k,32) + prod(k,93) =rxt(k,406)*y(k,203)*y(k,196) + loss(k,54) = (rxt(k,200)* y(k,216) + rxt(k,78) + het_rates(k,33))* y(k,33) + prod(k,54) = 0._r8 + loss(k,66) = (rxt(k,201)* y(k,216) + rxt(k,79) + het_rates(k,34))* y(k,34) + prod(k,66) = 0._r8 + loss(k,67) = (rxt(k,227)* y(k,216) + rxt(k,80) + het_rates(k,35))* y(k,35) + prod(k,67) = 0._r8 + loss(k,58) = (rxt(k,202)* y(k,216) + rxt(k,81) + het_rates(k,36))* y(k,36) + prod(k,58) = 0._r8 + loss(k,68) = (rxt(k,203)* y(k,216) + rxt(k,82) + het_rates(k,37))* y(k,37) + prod(k,68) = 0._r8 + loss(k,59) = (rxt(k,204)* y(k,216) + rxt(k,83) + het_rates(k,38))* y(k,38) + prod(k,59) = 0._r8 + loss(k,69) = (rxt(k,205)* y(k,216) + rxt(k,84) + het_rates(k,39))* y(k,39) + prod(k,69) = 0._r8 + loss(k,60) = (rxt(k,206)* y(k,216) + rxt(k,85) + het_rates(k,40))* y(k,40) + prod(k,60) = 0._r8 + loss(k,129) = (rxt(k,238)* y(k,56) +rxt(k,250)* y(k,216) +rxt(k,239) & + * y(k,217) + rxt(k,86) + het_rates(k,41))* y(k,41) + prod(k,129) = 0._r8 + loss(k,213) = (rxt(k,211)* y(k,17) +rxt(k,175)* y(k,56) +rxt(k,256)* y(k,126) & + +rxt(k,257)* y(k,133) +rxt(k,255)* y(k,203) +rxt(k,258)* y(k,217) & + rxt(k,32) + rxt(k,33) + het_rates(k,42))* y(k,42) - prod(k,191) = (rxt(k,181)*y(k,59) +2.000_r8*rxt(k,258)*y(k,198) + & - rxt(k,259)*y(k,198) +rxt(k,261)*y(k,124) + & + prod(k,213) = (rxt(k,182)*y(k,59) +2.000_r8*rxt(k,259)*y(k,198) + & + rxt(k,260)*y(k,198) +rxt(k,262)*y(k,124) + & .700_r8*rxt(k,281)*y(k,194) +rxt(k,292)*y(k,197) + & rxt(k,309)*y(k,195) +.800_r8*rxt(k,321)*y(k,220) + & .880_r8*rxt(k,333)*y(k,209) +2.000_r8*rxt(k,342)*y(k,211) + & @@ -233,8 +190,8 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & .250_r8*rxt(k,336)*y(k,209) +rxt(k,345)*y(k,211) + & .100_r8*rxt(k,358)*y(k,189) +.920_r8*rxt(k,368)*y(k,205) + & .250_r8*rxt(k,393)*y(k,225) +.340_r8*rxt(k,452)*y(k,221) + & - .320_r8*rxt(k,457)*y(k,222))*y(k,124) + (rxt(k,262)*y(k,52) + & - .300_r8*rxt(k,263)*y(k,53) +.500_r8*rxt(k,296)*y(k,51) + & + .320_r8*rxt(k,457)*y(k,222))*y(k,124) + (rxt(k,263)*y(k,52) + & + .300_r8*rxt(k,264)*y(k,53) +.500_r8*rxt(k,296)*y(k,51) + & .800_r8*rxt(k,301)*y(k,74) +rxt(k,303)*y(k,139) + & .500_r8*rxt(k,351)*y(k,109) +.400_r8*rxt(k,356)*y(k,1) + & .300_r8*rxt(k,376)*y(k,99) +.680_r8*rxt(k,461)*y(k,178))*y(k,217) & @@ -245,19 +202,24 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & .250_r8*rxt(k,335)*y(k,209) +rxt(k,346)*y(k,211) + & rxt(k,369)*y(k,205))*y(k,126) + (.250_r8*rxt(k,332)*y(k,209) + & rxt(k,341)*y(k,211) +rxt(k,365)*y(k,205) + & - .250_r8*rxt(k,390)*y(k,225))*y(k,197) + (rxt(k,272)*y(k,216) + & - rxt(k,273)*y(k,216))*y(k,54) + (.150_r8*rxt(k,322)*y(k,220) + & - .450_r8*rxt(k,343)*y(k,211))*y(k,203) +.100_r8*rxt(k,19)*y(k,1) & - +.100_r8*rxt(k,20)*y(k,2) +rxt(k,38)*y(k,53) +rxt(k,43)*y(k,74) & - +.330_r8*rxt(k,45)*y(k,93) +rxt(k,47)*y(k,95) +.690_r8*rxt(k,49) & - *y(k,103) +1.340_r8*rxt(k,50)*y(k,105) +rxt(k,57)*y(k,127) +rxt(k,62) & - *y(k,146) +rxt(k,63)*y(k,147) +.375_r8*rxt(k,65)*y(k,174) & - +.400_r8*rxt(k,67)*y(k,176) +.680_r8*rxt(k,69)*y(k,178) & - +2.000_r8*rxt(k,299)*y(k,201) +rxt(k,269)*y(k,204) & - +2.000_r8*rxt(k,344)*y(k,211)*y(k,211) - loss(k,168) = (rxt(k,288)* y(k,126) +rxt(k,289)* y(k,217) + rxt(k,34) & + .250_r8*rxt(k,390)*y(k,225))*y(k,197) + (.180_r8*rxt(k,39) + & + rxt(k,272)*y(k,216) +rxt(k,273)*y(k,216))*y(k,54) & + + (.150_r8*rxt(k,322)*y(k,220) +.450_r8*rxt(k,343)*y(k,211)) & + *y(k,203) +.100_r8*rxt(k,19)*y(k,1) +.100_r8*rxt(k,20)*y(k,2) & + +rxt(k,38)*y(k,53) +rxt(k,43)*y(k,74) +.330_r8*rxt(k,45)*y(k,93) & + +rxt(k,47)*y(k,95) +rxt(k,49)*y(k,103) +1.340_r8*rxt(k,50)*y(k,105) & + +rxt(k,57)*y(k,127) +rxt(k,62)*y(k,146) +rxt(k,63)*y(k,147) & + +.375_r8*rxt(k,65)*y(k,174) +.400_r8*rxt(k,67)*y(k,176) & + +.680_r8*rxt(k,69)*y(k,178) +2.000_r8*rxt(k,299)*y(k,201) & + +rxt(k,269)*y(k,204) +2.000_r8*rxt(k,344)*y(k,211)*y(k,211) + loss(k,146) = (rxt(k,240)* y(k,56) +rxt(k,251)* y(k,216) +rxt(k,241) & + * y(k,217) + rxt(k,87) + het_rates(k,43))* y(k,43) + prod(k,146) = 0._r8 + loss(k,61) = (rxt(k,242)* y(k,217) + rxt(k,88) + het_rates(k,44))* y(k,44) + prod(k,61) = 0._r8 + loss(k,190) = (rxt(k,288)* y(k,126) +rxt(k,289)* y(k,217) + rxt(k,34) & + het_rates(k,45))* y(k,45) - prod(k,168) = (rxt(k,283)*y(k,194) +.270_r8*rxt(k,311)*y(k,195) + & + prod(k,190) = (rxt(k,283)*y(k,194) +.270_r8*rxt(k,311)*y(k,195) + & rxt(k,319)*y(k,219) +rxt(k,329)*y(k,200) +rxt(k,348)*y(k,213) + & .400_r8*rxt(k,358)*y(k,189))*y(k,124) + (rxt(k,284)*y(k,26) + & .500_r8*rxt(k,285)*y(k,27) +.800_r8*rxt(k,356)*y(k,1))*y(k,217) & @@ -267,10 +229,13 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & +rxt(k,327)*y(k,126)*y(k,16) +rxt(k,29)*y(k,27) +.330_r8*rxt(k,45) & *y(k,93) +rxt(k,53)*y(k,108) +rxt(k,62)*y(k,146) & +.200_r8*rxt(k,347)*y(k,213)*y(k,203) - loss(k,44) = (rxt(k,290)* y(k,217) + het_rates(k,47))* y(k,47) - prod(k,44) = 0._r8 - loss(k,154) = (rxt(k,326)* y(k,217) + rxt(k,35) + het_rates(k,48))* y(k,48) - prod(k,154) = (.820_r8*rxt(k,311)*y(k,195) +.500_r8*rxt(k,329)*y(k,200) + & + loss(k,112) = (rxt(k,243)* y(k,56) +rxt(k,244)* y(k,217) + rxt(k,89) & + + het_rates(k,46))* y(k,46) + prod(k,112) = 0._r8 + loss(k,55) = (rxt(k,290)* y(k,217) + het_rates(k,47))* y(k,47) + prod(k,55) = 0._r8 + loss(k,180) = (rxt(k,326)* y(k,217) + rxt(k,35) + het_rates(k,48))* y(k,48) + prod(k,180) = (.820_r8*rxt(k,311)*y(k,195) +.500_r8*rxt(k,329)*y(k,200) + & .250_r8*rxt(k,358)*y(k,189) +.270_r8*rxt(k,452)*y(k,221) + & .040_r8*rxt(k,457)*y(k,222))*y(k,124) & + (.820_r8*rxt(k,309)*y(k,195) +.150_r8*rxt(k,450)*y(k,221) + & @@ -281,9 +246,9 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & +.500_r8*rxt(k,327)*y(k,126)*y(k,16) +.820_r8*rxt(k,30)*y(k,30) & +.170_r8*rxt(k,45)*y(k,93) +.300_r8*rxt(k,65)*y(k,174) & +.050_r8*rxt(k,67)*y(k,176) - loss(k,173) = (rxt(k,314)* y(k,126) +rxt(k,315)* y(k,217) + rxt(k,36) & + loss(k,200) = (rxt(k,314)* y(k,126) +rxt(k,315)* y(k,217) + rxt(k,36) & + het_rates(k,49))* y(k,49) - prod(k,173) = (.250_r8*rxt(k,336)*y(k,209) +.050_r8*rxt(k,374)*y(k,206) + & + prod(k,200) = (.250_r8*rxt(k,336)*y(k,209) +.050_r8*rxt(k,374)*y(k,206) + & .250_r8*rxt(k,393)*y(k,225) +.170_r8*rxt(k,411)*y(k,199) + & .170_r8*rxt(k,417)*y(k,212) +.400_r8*rxt(k,427)*y(k,223) + & .540_r8*rxt(k,433)*y(k,226) +.510_r8*rxt(k,436)*y(k,228))*y(k,124) & @@ -298,66 +263,79 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & *y(k,203) + (rxt(k,316)*y(k,95) +rxt(k,317)*y(k,127))*y(k,217) & +.180_r8*rxt(k,23)*y(k,10) +rxt(k,27)*y(k,14) +.400_r8*rxt(k,70) & *y(k,179) +.540_r8*rxt(k,72)*y(k,183) +.510_r8*rxt(k,73)*y(k,185) - loss(k,117) = (rxt(k,295)* y(k,217) + het_rates(k,50))* y(k,50) - prod(k,117) = (.100_r8*rxt(k,292)*y(k,198) +.150_r8*rxt(k,293)*y(k,203)) & + loss(k,156) = (rxt(k,295)* y(k,217) + het_rates(k,50))* y(k,50) + prod(k,156) = (.100_r8*rxt(k,292)*y(k,198) +.150_r8*rxt(k,293)*y(k,203)) & *y(k,197) +.120_r8*rxt(k,308)*y(k,134)*y(k,29) & +.150_r8*rxt(k,343)*y(k,211)*y(k,203) - loss(k,112) = (rxt(k,296)* y(k,217) + rxt(k,37) + het_rates(k,51))* y(k,51) - prod(k,112) = (.400_r8*rxt(k,293)*y(k,197) +.400_r8*rxt(k,343)*y(k,211)) & + loss(k,148) = (rxt(k,296)* y(k,217) + rxt(k,37) + het_rates(k,51))* y(k,51) + prod(k,148) = (.400_r8*rxt(k,293)*y(k,197) +.400_r8*rxt(k,343)*y(k,211)) & *y(k,203) - loss(k,141) = (rxt(k,262)* y(k,217) + het_rates(k,52))* y(k,52) - prod(k,141) = (rxt(k,259)*y(k,198) +.300_r8*rxt(k,281)*y(k,194) + & + loss(k,166) = (rxt(k,263)* y(k,217) + het_rates(k,52))* y(k,52) + prod(k,166) = (rxt(k,260)*y(k,198) +.300_r8*rxt(k,281)*y(k,194) + & .500_r8*rxt(k,321)*y(k,220) +.250_r8*rxt(k,333)*y(k,209) + & .250_r8*rxt(k,366)*y(k,205) +.250_r8*rxt(k,371)*y(k,206) + & .200_r8*rxt(k,380)*y(k,101) +.300_r8*rxt(k,391)*y(k,225) + & .250_r8*rxt(k,445)*y(k,215) +.250_r8*rxt(k,450)*y(k,221) + & .250_r8*rxt(k,455)*y(k,222))*y(k,198) - loss(k,94) = (rxt(k,263)* y(k,217) + rxt(k,38) + het_rates(k,53))* y(k,53) - prod(k,94) =rxt(k,260)*y(k,203)*y(k,198) - loss(k,195) = (rxt(k,286)* y(k,28) +rxt(k,237)* y(k,41) +rxt(k,174)* y(k,42) & - +rxt(k,239)* y(k,43) +rxt(k,242)* y(k,46) +rxt(k,175)* y(k,54) & - +rxt(k,244)* y(k,55) +rxt(k,187)* y(k,60) +rxt(k,176)* y(k,77) & - +rxt(k,177)* y(k,79) +rxt(k,196)* y(k,92) +rxt(k,180)* y(k,134) & - + (rxt(k,178) +rxt(k,179))* y(k,203) + het_rates(k,56))* y(k,56) - prod(k,195) = (4.000_r8*rxt(k,199)*y(k,33) +rxt(k,200)*y(k,34) + & - 2.000_r8*rxt(k,201)*y(k,36) +2.000_r8*rxt(k,202)*y(k,37) + & - 2.000_r8*rxt(k,203)*y(k,38) +rxt(k,204)*y(k,39) + & - 2.000_r8*rxt(k,205)*y(k,40) +rxt(k,251)*y(k,82) +rxt(k,252)*y(k,83) + & - rxt(k,253)*y(k,84) +rxt(k,206)*y(k,85) +rxt(k,236)*y(k,65))*y(k,216) & - + (rxt(k,93) +rxt(k,181)*y(k,198) +2.000_r8*rxt(k,182)*y(k,59) + & - rxt(k,184)*y(k,59) +rxt(k,186)*y(k,124) +rxt(k,191)*y(k,133) + & - rxt(k,192)*y(k,217) +rxt(k,215)*y(k,19) +rxt(k,469)*y(k,150))*y(k,59) & - + (3.000_r8*rxt(k,241)*y(k,44) +rxt(k,243)*y(k,46) + & - rxt(k,246)*y(k,82) +rxt(k,247)*y(k,83) +rxt(k,248)*y(k,84) + & - rxt(k,195)*y(k,85))*y(k,217) + (rxt(k,103) +rxt(k,194)*y(k,133)) & - *y(k,85) +rxt(k,74)*y(k,18) +2.000_r8*rxt(k,91)*y(k,57) & - +2.000_r8*rxt(k,92)*y(k,58) +rxt(k,94)*y(k,60) +rxt(k,97)*y(k,65) & - +rxt(k,106)*y(k,92) - loss(k,55) = ( + rxt(k,91) + het_rates(k,57))* y(k,57) - prod(k,55) = (rxt(k,523)*y(k,92) +rxt(k,528)*y(k,60) +rxt(k,529)*y(k,92) + & + loss(k,115) = (rxt(k,264)* y(k,217) + rxt(k,38) + het_rates(k,53))* y(k,53) + prod(k,115) =rxt(k,261)*y(k,203)*y(k,198) + loss(k,210) = (rxt(k,176)* y(k,56) +rxt(k,232)* y(k,73) + (rxt(k,271) + & + rxt(k,272) +rxt(k,273))* y(k,216) +rxt(k,265)* y(k,217) + rxt(k,39) & + + rxt(k,40) + het_rates(k,54))* y(k,54) + prod(k,210) =.100_r8*rxt(k,308)*y(k,134)*y(k,29) + loss(k,125) = (rxt(k,245)* y(k,56) +rxt(k,228)* y(k,216) +rxt(k,246) & + * y(k,217) + rxt(k,90) + het_rates(k,55))* y(k,55) + prod(k,125) = 0._r8 + loss(k,220) = (rxt(k,286)* y(k,28) +rxt(k,238)* y(k,41) +rxt(k,175)* y(k,42) & + +rxt(k,240)* y(k,43) +rxt(k,243)* y(k,46) +rxt(k,176)* y(k,54) & + +rxt(k,245)* y(k,55) +rxt(k,188)* y(k,60) +rxt(k,177)* y(k,77) & + +rxt(k,178)* y(k,79) +rxt(k,197)* y(k,92) +rxt(k,181)* y(k,134) & + + (rxt(k,179) +rxt(k,180))* y(k,203) + het_rates(k,56))* y(k,56) + prod(k,220) = (4.000_r8*rxt(k,200)*y(k,33) +rxt(k,201)*y(k,34) + & + 2.000_r8*rxt(k,202)*y(k,36) +2.000_r8*rxt(k,203)*y(k,37) + & + 2.000_r8*rxt(k,204)*y(k,38) +rxt(k,205)*y(k,39) + & + 2.000_r8*rxt(k,206)*y(k,40) +rxt(k,207)*y(k,85) +rxt(k,237)*y(k,65) + & + rxt(k,252)*y(k,82) +rxt(k,253)*y(k,83) +rxt(k,254)*y(k,84))*y(k,216) & + + (rxt(k,93) +rxt(k,182)*y(k,198) +2.000_r8*rxt(k,183)*y(k,59) + & + rxt(k,185)*y(k,59) +rxt(k,187)*y(k,124) +rxt(k,192)*y(k,133) + & + rxt(k,193)*y(k,217) +rxt(k,216)*y(k,19) +rxt(k,470)*y(k,150))*y(k,59) & + + (rxt(k,196)*y(k,85) +3.000_r8*rxt(k,242)*y(k,44) + & + rxt(k,244)*y(k,46) +rxt(k,247)*y(k,82) +rxt(k,248)*y(k,83) + & + rxt(k,249)*y(k,84))*y(k,217) + (rxt(k,103) +rxt(k,195)*y(k,133)) & + *y(k,85) +rxt(k,74)*y(k,18) +4.000_r8*rxt(k,78)*y(k,33) +rxt(k,79) & + *y(k,34) +2.000_r8*rxt(k,81)*y(k,36) +2.000_r8*rxt(k,82)*y(k,37) & + +2.000_r8*rxt(k,83)*y(k,38) +rxt(k,84)*y(k,39) +2.000_r8*rxt(k,85) & + *y(k,40) +3.000_r8*rxt(k,88)*y(k,44) +rxt(k,89)*y(k,46) & + +2.000_r8*rxt(k,91)*y(k,57) +2.000_r8*rxt(k,92)*y(k,58) +rxt(k,94) & + *y(k,60) +rxt(k,97)*y(k,65) +rxt(k,100)*y(k,82) +rxt(k,101)*y(k,83) & + +rxt(k,102)*y(k,84) +rxt(k,106)*y(k,92) + loss(k,70) = ( + rxt(k,91) + het_rates(k,57))* y(k,57) + prod(k,70) = (rxt(k,523)*y(k,92) +rxt(k,528)*y(k,60) +rxt(k,529)*y(k,92) + & rxt(k,533)*y(k,60) +rxt(k,534)*y(k,92) +rxt(k,538)*y(k,60))*y(k,85) & - +rxt(k,187)*y(k,60)*y(k,56) +rxt(k,183)*y(k,59)*y(k,59) - loss(k,45) = ( + rxt(k,92) + rxt(k,209) + het_rates(k,58))* y(k,58) - prod(k,45) =rxt(k,208)*y(k,59)*y(k,59) - loss(k,184) = ((rxt(k,214) +rxt(k,215) +rxt(k,216))* y(k,19) & - + 2._r8*(rxt(k,182) +rxt(k,183) +rxt(k,184) +rxt(k,208))* y(k,59) & - +rxt(k,186)* y(k,124) +rxt(k,188)* y(k,125) +rxt(k,191)* y(k,133) & - +rxt(k,469)* y(k,150) +rxt(k,181)* y(k,198) +rxt(k,185)* y(k,203) & - + (rxt(k,192) +rxt(k,193))* y(k,217) + rxt(k,93) + het_rates(k,59)) & + +rxt(k,188)*y(k,60)*y(k,56) +rxt(k,184)*y(k,59)*y(k,59) + loss(k,52) = ( + rxt(k,92) + rxt(k,210) + het_rates(k,58))* y(k,58) + prod(k,52) =rxt(k,209)*y(k,59)*y(k,59) + loss(k,219) = ((rxt(k,215) +rxt(k,216) +rxt(k,217))* y(k,19) & + + 2._r8*(rxt(k,183) +rxt(k,184) +rxt(k,185) +rxt(k,209))* y(k,59) & + +rxt(k,187)* y(k,124) +rxt(k,189)* y(k,125) +rxt(k,192)* y(k,133) & + +rxt(k,470)* y(k,150) +rxt(k,182)* y(k,198) +rxt(k,186)* y(k,203) & + + (rxt(k,193) +rxt(k,194))* y(k,217) + rxt(k,93) + het_rates(k,59)) & * y(k,59) - prod(k,184) = (rxt(k,179)*y(k,203) +rxt(k,180)*y(k,134) +rxt(k,196)*y(k,92)) & - *y(k,56) + (rxt(k,95) +rxt(k,189)*y(k,133))*y(k,60) & - + (rxt(k,197)*y(k,133) +rxt(k,198)*y(k,217))*y(k,92) + (rxt(k,107) + & - rxt(k,474)*y(k,150))*y(k,136) +2.000_r8*rxt(k,209)*y(k,58) & - +rxt(k,207)*y(k,216)*y(k,85) - loss(k,155) = (rxt(k,187)* y(k,56) + (rxt(k,528) +rxt(k,533) +rxt(k,538)) & - * y(k,85) +rxt(k,189)* y(k,133) +rxt(k,190)* y(k,217) + rxt(k,94) & + prod(k,219) = (rxt(k,180)*y(k,203) +rxt(k,181)*y(k,134) +rxt(k,197)*y(k,92)) & + *y(k,56) + (rxt(k,95) +rxt(k,190)*y(k,133))*y(k,60) & + + (rxt(k,198)*y(k,133) +rxt(k,199)*y(k,217))*y(k,92) + (rxt(k,107) + & + rxt(k,475)*y(k,150))*y(k,136) +2.000_r8*rxt(k,210)*y(k,58) & + +rxt(k,208)*y(k,216)*y(k,85) + loss(k,177) = (rxt(k,188)* y(k,56) + (rxt(k,528) +rxt(k,533) +rxt(k,538)) & + * y(k,85) +rxt(k,190)* y(k,133) +rxt(k,191)* y(k,217) + rxt(k,94) & + rxt(k,95) + rxt(k,526) + rxt(k,531) + rxt(k,537) & + het_rates(k,60))* y(k,60) - prod(k,155) =rxt(k,188)*y(k,125)*y(k,59) - loss(k,162) = ((rxt(k,265) +rxt(k,275))* y(k,217) + het_rates(k,62))* y(k,62) - prod(k,162) = (rxt(k,32) +rxt(k,33) +rxt(k,174)*y(k,56) +rxt(k,210)*y(k,17) + & - rxt(k,255)*y(k,126) +rxt(k,256)*y(k,133) +rxt(k,257)*y(k,217)) & + prod(k,177) =rxt(k,189)*y(k,125)*y(k,59) + loss(k,5) = ( + het_rates(k,61))* y(k,61) + prod(k,5) = 0._r8 + loss(k,192) = (rxt(k,275)* y(k,217) + het_rates(k,62))* y(k,62) + prod(k,192) = (rxt(k,32) +rxt(k,33) +rxt(k,175)*y(k,56) +rxt(k,211)*y(k,17) + & + rxt(k,256)*y(k,126) +rxt(k,257)*y(k,133) +rxt(k,258)*y(k,217)) & *y(k,42) + (.630_r8*rxt(k,279)*y(k,25) +.560_r8*rxt(k,308)*y(k,29) + & .650_r8*rxt(k,338)*y(k,105) +.560_r8*rxt(k,352)*y(k,111) + & .620_r8*rxt(k,385)*y(k,98) +.230_r8*rxt(k,440)*y(k,6) + & @@ -376,41 +354,64 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & rxt(k,464)*y(k,133))*y(k,137) + (.220_r8*rxt(k,332)*y(k,209) + & .250_r8*rxt(k,390)*y(k,225))*y(k,197) +1.500_r8*rxt(k,22)*y(k,9) & +.450_r8*rxt(k,23)*y(k,10) +.600_r8*rxt(k,26)*y(k,13) +rxt(k,27) & - *y(k,14) +rxt(k,34)*y(k,45) +rxt(k,242)*y(k,56)*y(k,46) +rxt(k,36) & - *y(k,49) +rxt(k,43)*y(k,74) +2.000_r8*rxt(k,44)*y(k,75) & - +.330_r8*rxt(k,45)*y(k,93) +1.340_r8*rxt(k,51)*y(k,105) & - +.700_r8*rxt(k,55)*y(k,111) +1.500_r8*rxt(k,64)*y(k,173) & - +.250_r8*rxt(k,65)*y(k,174) +rxt(k,68)*y(k,177) +1.700_r8*rxt(k,69) & + *y(k,14) +rxt(k,34)*y(k,45) +rxt(k,243)*y(k,56)*y(k,46) +rxt(k,36) & + *y(k,49) +.380_r8*rxt(k,39)*y(k,54) +rxt(k,41)*y(k,63) +rxt(k,43) & + *y(k,74) +2.000_r8*rxt(k,44)*y(k,75) +.330_r8*rxt(k,45)*y(k,93) & + +1.340_r8*rxt(k,51)*y(k,105) +.700_r8*rxt(k,55)*y(k,111) & + +1.500_r8*rxt(k,64)*y(k,173) +.250_r8*rxt(k,65)*y(k,174) +rxt(k,68) & + *y(k,177) +1.700_r8*rxt(k,69)*y(k,178) + loss(k,168) = ( + rxt(k,41) + het_rates(k,63))* y(k,63) + prod(k,168) = (rxt(k,267)*y(k,87) +rxt(k,275)*y(k,62) +rxt(k,295)*y(k,50) + & + .500_r8*rxt(k,296)*y(k,51) +.800_r8*rxt(k,301)*y(k,74) + & + rxt(k,302)*y(k,75) +.500_r8*rxt(k,351)*y(k,109) + & + 1.800_r8*rxt(k,461)*y(k,178))*y(k,217) & + + (2.000_r8*rxt(k,291)*y(k,197) +.900_r8*rxt(k,292)*y(k,198) + & + rxt(k,294)*y(k,124) +2.000_r8*rxt(k,341)*y(k,211) + & + rxt(k,365)*y(k,205) +rxt(k,390)*y(k,225))*y(k,197) & + + (.200_r8*rxt(k,308)*y(k,29) +.100_r8*rxt(k,352)*y(k,111) + & + .270_r8*rxt(k,440)*y(k,6) +.270_r8*rxt(k,443)*y(k,110))*y(k,134) & + + (rxt(k,342)*y(k,198) +.450_r8*rxt(k,343)*y(k,203) + & + 2.000_r8*rxt(k,344)*y(k,211))*y(k,211) & + + (.500_r8*rxt(k,450)*y(k,198) +.900_r8*rxt(k,452)*y(k,124)) & + *y(k,221) +rxt(k,37)*y(k,51) +.440_r8*rxt(k,39)*y(k,54) & + +.400_r8*rxt(k,60)*y(k,139) +rxt(k,65)*y(k,174) +.800_r8*rxt(k,69) & *y(k,178) - loss(k,51) = (rxt(k,235)* y(k,216) + rxt(k,96) + het_rates(k,64))* y(k,64) - prod(k,51) = (rxt(k,200)*y(k,34) +rxt(k,202)*y(k,37) + & - 2.000_r8*rxt(k,203)*y(k,38) +2.000_r8*rxt(k,204)*y(k,39) + & - rxt(k,205)*y(k,40) +rxt(k,226)*y(k,35) +2.000_r8*rxt(k,228)*y(k,78) + & - rxt(k,252)*y(k,83) +rxt(k,253)*y(k,84))*y(k,216) & - + (rxt(k,247)*y(k,83) +rxt(k,248)*y(k,84))*y(k,217) - loss(k,57) = (rxt(k,236)* y(k,216) + rxt(k,97) + het_rates(k,65))* y(k,65) - prod(k,57) = (rxt(k,201)*y(k,36) +rxt(k,202)*y(k,37) +rxt(k,251)*y(k,82)) & - *y(k,216) +rxt(k,246)*y(k,217)*y(k,82) - loss(k,59) = (rxt(k,409)* y(k,217) + het_rates(k,66))* y(k,66) - prod(k,59) =.180_r8*rxt(k,429)*y(k,217)*y(k,180) - loss(k,74) = (rxt(k,462)* y(k,126) + (rxt(k,463) +rxt(k,476))* y(k,217) & + loss(k,85) = (rxt(k,236)* y(k,216) + rxt(k,96) + het_rates(k,64))* y(k,64) + prod(k,85) = (rxt(k,201)*y(k,34) +rxt(k,203)*y(k,37) + & + 2.000_r8*rxt(k,204)*y(k,38) +2.000_r8*rxt(k,205)*y(k,39) + & + rxt(k,206)*y(k,40) +rxt(k,227)*y(k,35) +2.000_r8*rxt(k,229)*y(k,78) + & + rxt(k,253)*y(k,83) +rxt(k,254)*y(k,84))*y(k,216) + (rxt(k,101) + & + rxt(k,248)*y(k,217))*y(k,83) + (rxt(k,102) +rxt(k,249)*y(k,217)) & + *y(k,84) +rxt(k,79)*y(k,34) +rxt(k,80)*y(k,35) +rxt(k,82)*y(k,37) & + +2.000_r8*rxt(k,83)*y(k,38) +2.000_r8*rxt(k,84)*y(k,39) +rxt(k,85) & + *y(k,40) +2.000_r8*rxt(k,98)*y(k,78) + loss(k,83) = (rxt(k,237)* y(k,216) + rxt(k,97) + het_rates(k,65))* y(k,65) + prod(k,83) = (rxt(k,100) +rxt(k,247)*y(k,217) +rxt(k,252)*y(k,216))*y(k,82) & + + (rxt(k,81) +rxt(k,202)*y(k,216))*y(k,36) + (rxt(k,82) + & + rxt(k,203)*y(k,216))*y(k,37) + loss(k,77) = (rxt(k,409)* y(k,217) + het_rates(k,66))* y(k,66) + prod(k,77) =.180_r8*rxt(k,429)*y(k,217)*y(k,180) + loss(k,100) = (rxt(k,462)* y(k,126) + (rxt(k,463) +rxt(k,477))* y(k,217) & + het_rates(k,67))* y(k,67) - prod(k,74) = 0._r8 - loss(k,3) = ( + het_rates(k,68))* y(k,68) - prod(k,3) = 0._r8 - loss(k,4) = ( + het_rates(k,69))* y(k,69) - prod(k,4) = 0._r8 - loss(k,5) = ( + het_rates(k,70))* y(k,70) - prod(k,5) = 0._r8 - loss(k,47) = ( + rxt(k,42) + het_rates(k,72))* y(k,72) - prod(k,47) =rxt(k,297)*y(k,203)*y(k,202) - loss(k,139) = (rxt(k,231)* y(k,54) +rxt(k,232)* y(k,77) +rxt(k,234)* y(k,89) & - +rxt(k,233)* y(k,229) + het_rates(k,73))* y(k,73) - prod(k,139) = (rxt(k,204)*y(k,39) +rxt(k,226)*y(k,35) + & - 2.000_r8*rxt(k,235)*y(k,64) +rxt(k,236)*y(k,65))*y(k,216) & - +2.000_r8*rxt(k,96)*y(k,64) +rxt(k,97)*y(k,65) +rxt(k,104)*y(k,88) - loss(k,159) = (rxt(k,301)* y(k,217) + rxt(k,43) + het_rates(k,74))* y(k,74) - prod(k,159) = (.530_r8*rxt(k,336)*y(k,209) +.050_r8*rxt(k,374)*y(k,206) + & + prod(k,100) = 0._r8 + loss(k,6) = ( + het_rates(k,68))* y(k,68) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,69))* y(k,69) + prod(k,7) = 0._r8 + loss(k,8) = ( + het_rates(k,70))* y(k,70) + prod(k,8) = 0._r8 + loss(k,9) = ( + rxt(k,124) + het_rates(k,71))* y(k,71) + prod(k,9) = 0._r8 + loss(k,62) = ( + rxt(k,42) + het_rates(k,72))* y(k,72) + prod(k,62) =rxt(k,297)*y(k,203)*y(k,202) + loss(k,175) = (rxt(k,232)* y(k,54) +rxt(k,233)* y(k,77) +rxt(k,235)* y(k,89) & + +rxt(k,234)* y(k,229) + het_rates(k,73))* y(k,73) + prod(k,175) = (rxt(k,205)*y(k,39) +rxt(k,227)*y(k,35) + & + 2.000_r8*rxt(k,236)*y(k,64) +rxt(k,237)*y(k,65))*y(k,216) +rxt(k,80) & + *y(k,35) +rxt(k,84)*y(k,39) +2.000_r8*rxt(k,96)*y(k,64) +rxt(k,97) & + *y(k,65) +rxt(k,104)*y(k,88) + loss(k,191) = (rxt(k,301)* y(k,217) + rxt(k,43) + het_rates(k,74))* y(k,74) + prod(k,191) = (.530_r8*rxt(k,336)*y(k,209) +.050_r8*rxt(k,374)*y(k,206) + & .250_r8*rxt(k,393)*y(k,225) +.225_r8*rxt(k,452)*y(k,221))*y(k,124) & + (.530_r8*rxt(k,335)*y(k,209) +.050_r8*rxt(k,375)*y(k,206) + & .250_r8*rxt(k,394)*y(k,225))*y(k,126) & @@ -420,9 +421,9 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & + (.530_r8*rxt(k,332)*y(k,209) +.250_r8*rxt(k,390)*y(k,225)) & *y(k,197) +.330_r8*rxt(k,45)*y(k,93) +.250_r8*rxt(k,65)*y(k,174) & +rxt(k,300)*y(k,201) - loss(k,149) = (rxt(k,302)* y(k,217) + rxt(k,44) + rxt(k,480) & + loss(k,184) = (rxt(k,302)* y(k,217) + rxt(k,44) + rxt(k,480) & + het_rates(k,75))* y(k,75) - prod(k,149) = (.050_r8*rxt(k,374)*y(k,206) +.250_r8*rxt(k,393)*y(k,225) + & + prod(k,184) = (.050_r8*rxt(k,374)*y(k,206) +.250_r8*rxt(k,393)*y(k,225) + & rxt(k,400)*y(k,191) +.400_r8*rxt(k,414)*y(k,210) + & .170_r8*rxt(k,417)*y(k,212) +.700_r8*rxt(k,420)*y(k,218) + & .600_r8*rxt(k,427)*y(k,223) +.340_r8*rxt(k,433)*y(k,226) + & @@ -435,83 +436,93 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & +.050_r8*rxt(k,375)*y(k,206)*y(k,126) +.700_r8*rxt(k,61)*y(k,143) & +.600_r8*rxt(k,70)*y(k,179) +.340_r8*rxt(k,72)*y(k,183) & +.170_r8*rxt(k,73)*y(k,185) - loss(k,183) = (rxt(k,140)* y(k,134) + (rxt(k,134) +rxt(k,135) +rxt(k,136)) & - * y(k,203) + rxt(k,137) + het_rates(k,76))* y(k,76) - prod(k,183) = (rxt(k,141)*y(k,77) +rxt(k,144)*y(k,133) +rxt(k,162)*y(k,112) + & - rxt(k,257)*y(k,42) +rxt(k,275)*y(k,62) +rxt(k,465)*y(k,137) + & - rxt(k,470)*y(k,148) +rxt(k,475)*y(k,150))*y(k,217) & - + (rxt(k,124)*y(k,216) +rxt(k,132)*y(k,133) +rxt(k,176)*y(k,56) + & - rxt(k,232)*y(k,73))*y(k,77) + (rxt(k,272)*y(k,54) + & - rxt(k,207)*y(k,85) +rxt(k,230)*y(k,81))*y(k,216) + (rxt(k,2) + & - 2.000_r8*rxt(k,3))*y(k,229) +2.000_r8*rxt(k,32)*y(k,42) +rxt(k,38) & - *y(k,53) +rxt(k,99)*y(k,81) +rxt(k,103)*y(k,85) +rxt(k,104)*y(k,88) - loss(k,169) = (rxt(k,176)* y(k,56) +rxt(k,232)* y(k,73) +rxt(k,132)* y(k,133) & - +rxt(k,124)* y(k,216) +rxt(k,141)* y(k,217) + het_rates(k,77)) & + loss(k,212) = (rxt(k,141)* y(k,134) + (rxt(k,135) +rxt(k,136) +rxt(k,137)) & + * y(k,203) + rxt(k,138) + het_rates(k,76))* y(k,76) + prod(k,212) = (rxt(k,142)*y(k,77) +rxt(k,145)*y(k,133) +rxt(k,163)*y(k,112) + & + rxt(k,258)*y(k,42) +rxt(k,465)*y(k,137) +rxt(k,471)*y(k,148) + & + rxt(k,476)*y(k,150))*y(k,217) + (rxt(k,125)*y(k,216) + & + rxt(k,133)*y(k,133) +rxt(k,177)*y(k,56) +rxt(k,233)*y(k,73))*y(k,77) & + + (.330_r8*rxt(k,39) +rxt(k,40) +rxt(k,272)*y(k,216))*y(k,54) & + + (rxt(k,99) +rxt(k,231)*y(k,216))*y(k,81) + (rxt(k,103) + & + rxt(k,208)*y(k,216))*y(k,85) + (rxt(k,2) +2.000_r8*rxt(k,3))*y(k,229) & + +2.000_r8*rxt(k,33)*y(k,42) +rxt(k,38)*y(k,53) +rxt(k,104)*y(k,88) + loss(k,208) = (rxt(k,177)* y(k,56) +rxt(k,233)* y(k,73) +rxt(k,133)* y(k,133) & + +rxt(k,125)* y(k,216) +rxt(k,142)* y(k,217) + het_rates(k,77)) & * y(k,77) - prod(k,169) =rxt(k,33)*y(k,42) +rxt(k,273)*y(k,216)*y(k,54) & - +rxt(k,134)*y(k,203)*y(k,76) +rxt(k,1)*y(k,229) - loss(k,121) = (rxt(k,177)* y(k,56) +rxt(k,133)* y(k,133) +rxt(k,142) & + prod(k,208) = (1.440_r8*rxt(k,39) +rxt(k,273)*y(k,216))*y(k,54) +rxt(k,32) & + *y(k,42) +rxt(k,135)*y(k,203)*y(k,76) +rxt(k,1)*y(k,229) + loss(k,56) = (rxt(k,229)* y(k,216) + rxt(k,98) + het_rates(k,78))* y(k,78) + prod(k,56) = 0._r8 + loss(k,147) = (rxt(k,178)* y(k,56) +rxt(k,134)* y(k,133) +rxt(k,143) & * y(k,217) + rxt(k,4) + het_rates(k,79))* y(k,79) - prod(k,121) = (.500_r8*rxt(k,481) +rxt(k,148)*y(k,203))*y(k,203) & - +rxt(k,147)*y(k,217)*y(k,217) - loss(k,48) = ( + rxt(k,109) + het_rates(k,80))* y(k,80) - prod(k,48) =rxt(k,478)*y(k,229)*y(k,152) - loss(k,143) = (rxt(k,223)* y(k,133) + (rxt(k,229) +rxt(k,230))* y(k,216) & - +rxt(k,224)* y(k,217) + rxt(k,99) + het_rates(k,81))* y(k,81) - prod(k,143) = (rxt(k,210)*y(k,42) +rxt(k,211)*y(k,203))*y(k,17) - loss(k,194) = ((rxt(k,528) +rxt(k,533) +rxt(k,538))* y(k,60) + (rxt(k,530) + & + prod(k,147) =rxt(k,149)*y(k,203)*y(k,203) +rxt(k,148)*y(k,217)*y(k,217) + loss(k,63) = ( + rxt(k,109) + het_rates(k,80))* y(k,80) + prod(k,63) =rxt(k,478)*y(k,229)*y(k,152) + loss(k,169) = (rxt(k,224)* y(k,133) + (rxt(k,230) +rxt(k,231))* y(k,216) & + +rxt(k,225)* y(k,217) + rxt(k,99) + het_rates(k,81))* y(k,81) + prod(k,169) = (rxt(k,211)*y(k,42) +rxt(k,212)*y(k,203))*y(k,17) + loss(k,82) = (rxt(k,252)* y(k,216) +rxt(k,247)* y(k,217) + rxt(k,100) & + + het_rates(k,82))* y(k,82) + prod(k,82) = 0._r8 + loss(k,89) = (rxt(k,253)* y(k,216) +rxt(k,248)* y(k,217) + rxt(k,101) & + + het_rates(k,83))* y(k,83) + prod(k,89) = 0._r8 + loss(k,101) = (rxt(k,254)* y(k,216) +rxt(k,249)* y(k,217) + rxt(k,102) & + + het_rates(k,84))* y(k,84) + prod(k,101) = 0._r8 + loss(k,223) = ((rxt(k,528) +rxt(k,533) +rxt(k,538))* y(k,60) + (rxt(k,530) + & rxt(k,535))* y(k,91) + (rxt(k,523) +rxt(k,529) +rxt(k,534))* y(k,92) & - +rxt(k,194)* y(k,133) + (rxt(k,206) +rxt(k,207))* y(k,216) & - +rxt(k,195)* y(k,217) + rxt(k,103) + het_rates(k,85))* y(k,85) - prod(k,194) = (rxt(k,175)*y(k,54) +rxt(k,237)*y(k,41) +rxt(k,239)*y(k,43) + & - 2.000_r8*rxt(k,242)*y(k,46) +rxt(k,244)*y(k,55) +rxt(k,174)*y(k,42) + & - rxt(k,176)*y(k,77) +rxt(k,177)*y(k,79) +rxt(k,178)*y(k,203) + & - rxt(k,196)*y(k,92) +rxt(k,286)*y(k,28))*y(k,56) +rxt(k,193)*y(k,217) & + +rxt(k,195)* y(k,133) + (rxt(k,207) +rxt(k,208))* y(k,216) & + +rxt(k,196)* y(k,217) + rxt(k,103) + het_rates(k,85))* y(k,85) + prod(k,223) = (rxt(k,175)*y(k,42) +rxt(k,176)*y(k,54) +rxt(k,177)*y(k,77) + & + rxt(k,178)*y(k,79) +rxt(k,179)*y(k,203) +rxt(k,197)*y(k,92) + & + rxt(k,238)*y(k,41) +rxt(k,240)*y(k,43) +2.000_r8*rxt(k,243)*y(k,46) + & + rxt(k,245)*y(k,55) +rxt(k,286)*y(k,28))*y(k,56) +rxt(k,194)*y(k,217) & *y(k,59) - loss(k,56) = (rxt(k,274)* y(k,216) +rxt(k,266)* y(k,217) + het_rates(k,86)) & + loss(k,74) = (rxt(k,274)* y(k,216) +rxt(k,266)* y(k,217) + het_rates(k,86)) & * y(k,86) - prod(k,56) = 0._r8 - loss(k,142) = (rxt(k,267)* y(k,217) + het_rates(k,87))* y(k,87) - prod(k,142) = (.370_r8*rxt(k,279)*y(k,25) +.120_r8*rxt(k,308)*y(k,29) + & + prod(k,74) = 0._r8 + loss(k,181) = (rxt(k,267)* y(k,217) + het_rates(k,87))* y(k,87) + prod(k,181) = (.370_r8*rxt(k,279)*y(k,25) +.120_r8*rxt(k,308)*y(k,29) + & .330_r8*rxt(k,338)*y(k,105) +.120_r8*rxt(k,352)*y(k,111) + & .110_r8*rxt(k,385)*y(k,98) +.050_r8*rxt(k,440)*y(k,6) + & .050_r8*rxt(k,443)*y(k,110))*y(k,134) + (rxt(k,268)*y(k,203) + & rxt(k,270)*y(k,124))*y(k,204) +.350_r8*rxt(k,277)*y(k,217)*y(k,24) - loss(k,64) = ( + rxt(k,104) + het_rates(k,88))* y(k,88) - prod(k,64) = (rxt(k,231)*y(k,54) +rxt(k,232)*y(k,77) +rxt(k,233)*y(k,229) + & - rxt(k,234)*y(k,89))*y(k,73) - loss(k,182) = (rxt(k,234)* y(k,73) +rxt(k,171)* y(k,217) + rxt(k,9) & + loss(k,97) = ( + rxt(k,104) + het_rates(k,88))* y(k,88) + prod(k,97) = (rxt(k,232)*y(k,54) +rxt(k,233)*y(k,77) +rxt(k,234)*y(k,229) + & + rxt(k,235)*y(k,89))*y(k,73) + loss(k,211) = (rxt(k,235)* y(k,73) +rxt(k,172)* y(k,217) + rxt(k,9) & + het_rates(k,89))* y(k,89) - prod(k,182) = (rxt(k,526) +rxt(k,531) +rxt(k,537) +rxt(k,528)*y(k,85) + & + prod(k,211) = (rxt(k,526) +rxt(k,531) +rxt(k,537) +rxt(k,528)*y(k,85) + & rxt(k,533)*y(k,85) +rxt(k,538)*y(k,85))*y(k,60) + (rxt(k,490) + & - rxt(k,255)*y(k,42) +rxt(k,288)*y(k,45) +rxt(k,314)*y(k,49) + & + rxt(k,256)*y(k,42) +rxt(k,288)*y(k,45) +rxt(k,314)*y(k,49) + & rxt(k,462)*y(k,67))*y(k,126) + (2.000_r8*rxt(k,485) + & 2.000_r8*rxt(k,522) +2.000_r8*rxt(k,525) +2.000_r8*rxt(k,536)) & *y(k,114) + (rxt(k,524) +rxt(k,527) +rxt(k,532))*y(k,20) & - + (.500_r8*rxt(k,489) +rxt(k,170)*y(k,217))*y(k,125) +rxt(k,482) & + + (.500_r8*rxt(k,489) +rxt(k,171)*y(k,217))*y(k,125) +rxt(k,482) & *y(k,93) +rxt(k,483)*y(k,99) +rxt(k,484)*y(k,100) +rxt(k,486) & *y(k,115) +rxt(k,487)*y(k,116) +rxt(k,491)*y(k,128) +rxt(k,492) & *y(k,138) +rxt(k,493)*y(k,175) - loss(k,96) = (rxt(k,149)* y(k,217) + rxt(k,10) + rxt(k,11) + rxt(k,172) & + loss(k,118) = (rxt(k,150)* y(k,217) + rxt(k,10) + rxt(k,11) + rxt(k,173) & + het_rates(k,90))* y(k,90) - prod(k,96) =rxt(k,168)*y(k,203)*y(k,125) - loss(k,138) = ((rxt(k,530) +rxt(k,535))* y(k,85) +rxt(k,225)* y(k,133) & + prod(k,118) =rxt(k,169)*y(k,203)*y(k,125) + loss(k,165) = ((rxt(k,530) +rxt(k,535))* y(k,85) +rxt(k,226)* y(k,133) & + rxt(k,105) + het_rates(k,91))* y(k,91) - prod(k,138) = (rxt(k,524) +rxt(k,527) +rxt(k,532))*y(k,20) & - +rxt(k,217)*y(k,203)*y(k,19) - loss(k,145) = (rxt(k,196)* y(k,56) + (rxt(k,523) +rxt(k,529) +rxt(k,534)) & - * y(k,85) +rxt(k,197)* y(k,133) +rxt(k,198)* y(k,217) + rxt(k,106) & + prod(k,165) = (rxt(k,524) +rxt(k,527) +rxt(k,532))*y(k,20) & + +rxt(k,218)*y(k,203)*y(k,19) + loss(k,171) = (rxt(k,197)* y(k,56) + (rxt(k,523) +rxt(k,529) +rxt(k,534)) & + * y(k,85) +rxt(k,198)* y(k,133) +rxt(k,199)* y(k,217) + rxt(k,106) & + het_rates(k,92))* y(k,92) - prod(k,145) = (rxt(k,526) +rxt(k,531) +rxt(k,537) +rxt(k,190)*y(k,217)) & - *y(k,60) +rxt(k,185)*y(k,203)*y(k,59) - loss(k,160) = (rxt(k,331)* y(k,217) + rxt(k,45) + rxt(k,482) & + prod(k,171) = (rxt(k,526) +rxt(k,531) +rxt(k,537) +rxt(k,191)*y(k,217)) & + *y(k,60) +rxt(k,186)*y(k,203)*y(k,59) + loss(k,196) = (rxt(k,331)* y(k,217) + rxt(k,45) + rxt(k,482) & + het_rates(k,93))* y(k,93) - prod(k,160) = (rxt(k,330)*y(k,200) +rxt(k,337)*y(k,209))*y(k,124) & + prod(k,196) = (rxt(k,330)*y(k,200) +rxt(k,337)*y(k,209))*y(k,124) & + (.300_r8*rxt(k,376)*y(k,99) +.500_r8*rxt(k,377)*y(k,100))*y(k,217) - loss(k,65) = (rxt(k,362)* y(k,217) + rxt(k,46) + het_rates(k,94))* y(k,94) - prod(k,65) =rxt(k,373)*y(k,206) - loss(k,163) = (rxt(k,316)* y(k,217) + rxt(k,47) + het_rates(k,95))* y(k,95) - prod(k,163) = (.220_r8*rxt(k,332)*y(k,197) +.230_r8*rxt(k,333)*y(k,198) + & + loss(k,84) = (rxt(k,362)* y(k,217) + rxt(k,46) + het_rates(k,94))* y(k,94) + prod(k,84) =rxt(k,373)*y(k,206) + loss(k,195) = (rxt(k,316)* y(k,217) + rxt(k,47) + het_rates(k,95))* y(k,95) + prod(k,195) = (.220_r8*rxt(k,332)*y(k,197) +.230_r8*rxt(k,333)*y(k,198) + & .220_r8*rxt(k,335)*y(k,126) +.220_r8*rxt(k,336)*y(k,124))*y(k,209) & + (.500_r8*rxt(k,320)*y(k,146) +.500_r8*rxt(k,351)*y(k,109) + & .700_r8*rxt(k,376)*y(k,99) +.500_r8*rxt(k,377)*y(k,100))*y(k,217) & @@ -520,84 +531,92 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & + (.050_r8*rxt(k,374)*y(k,124) +.050_r8*rxt(k,375)*y(k,126)) & *y(k,206) +.170_r8*rxt(k,45)*y(k,93) +.200_r8*rxt(k,321)*y(k,220) & *y(k,198) - loss(k,86) = (rxt(k,363)* y(k,217) + het_rates(k,96))* y(k,96) - prod(k,86) = (rxt(k,370)*y(k,197) +.750_r8*rxt(k,371)*y(k,198) + & + loss(k,104) = (rxt(k,363)* y(k,217) + het_rates(k,96))* y(k,96) + prod(k,104) = (rxt(k,370)*y(k,197) +.750_r8*rxt(k,371)*y(k,198) + & .870_r8*rxt(k,374)*y(k,124) +.950_r8*rxt(k,375)*y(k,126))*y(k,206) - loss(k,49) = (rxt(k,364)* y(k,217) + het_rates(k,97))* y(k,97) - prod(k,49) =.600_r8*rxt(k,387)*y(k,217)*y(k,103) - loss(k,146) = (rxt(k,378)* y(k,126) +rxt(k,385)* y(k,134) +rxt(k,386) & + loss(k,64) = (rxt(k,364)* y(k,217) + het_rates(k,97))* y(k,97) + prod(k,64) =.600_r8*rxt(k,387)*y(k,217)*y(k,103) + loss(k,173) = (rxt(k,378)* y(k,126) +rxt(k,385)* y(k,134) +rxt(k,386) & * y(k,217) + het_rates(k,98))* y(k,98) - prod(k,146) = 0._r8 - loss(k,123) = (rxt(k,376)* y(k,217) + rxt(k,483) + het_rates(k,99))* y(k,99) - prod(k,123) =.080_r8*rxt(k,368)*y(k,205)*y(k,124) - loss(k,115) = (rxt(k,377)* y(k,217) + rxt(k,484) + het_rates(k,100)) & + prod(k,173) = 0._r8 + loss(k,144) = (rxt(k,376)* y(k,217) + rxt(k,483) + het_rates(k,99))* y(k,99) + prod(k,144) =.080_r8*rxt(k,368)*y(k,205)*y(k,124) + loss(k,141) = (rxt(k,377)* y(k,217) + rxt(k,484) + het_rates(k,100)) & * y(k,100) - prod(k,115) =.080_r8*rxt(k,374)*y(k,206)*y(k,124) - loss(k,171) = (rxt(k,382)* y(k,124) +rxt(k,383)* y(k,126) +rxt(k,379) & + prod(k,141) =.080_r8*rxt(k,374)*y(k,206)*y(k,124) + loss(k,198) = (rxt(k,382)* y(k,124) +rxt(k,383)* y(k,126) +rxt(k,379) & * y(k,197) +rxt(k,380)* y(k,198) +rxt(k,381)* y(k,203) & + het_rates(k,101))* y(k,101) - prod(k,171) =rxt(k,378)*y(k,126)*y(k,98) - loss(k,95) = (rxt(k,384)* y(k,217) + rxt(k,48) + het_rates(k,102))* y(k,102) - prod(k,95) =rxt(k,381)*y(k,203)*y(k,101) - loss(k,130) = (rxt(k,387)* y(k,217) + rxt(k,49) + het_rates(k,103))* y(k,103) - prod(k,130) = (rxt(k,367)*y(k,205) +rxt(k,372)*y(k,206))*y(k,203) +rxt(k,48) & + prod(k,198) =rxt(k,378)*y(k,126)*y(k,98) + loss(k,117) = (rxt(k,384)* y(k,217) + rxt(k,48) + het_rates(k,102))* y(k,102) + prod(k,117) =rxt(k,381)*y(k,203)*y(k,101) + loss(k,157) = (rxt(k,387)* y(k,217) + rxt(k,49) + het_rates(k,103))* y(k,103) + prod(k,157) = (rxt(k,367)*y(k,205) +rxt(k,372)*y(k,206))*y(k,203) +rxt(k,48) & *y(k,102) - loss(k,39) = (rxt(k,509)* y(k,217) + het_rates(k,104))* y(k,104) - prod(k,39) = 0._r8 - loss(k,172) = (rxt(k,338)* y(k,134) +rxt(k,339)* y(k,217) + rxt(k,50) & + loss(k,48) = (rxt(k,509)* y(k,217) + het_rates(k,104))* y(k,104) + prod(k,48) = 0._r8 + loss(k,199) = (rxt(k,338)* y(k,134) +rxt(k,339)* y(k,217) + rxt(k,50) & + rxt(k,51) + het_rates(k,105))* y(k,105) - prod(k,172) = (.390_r8*rxt(k,365)*y(k,197) +.310_r8*rxt(k,366)*y(k,198) + & + prod(k,199) = (.390_r8*rxt(k,365)*y(k,197) +.310_r8*rxt(k,366)*y(k,198) + & .360_r8*rxt(k,368)*y(k,124) +.400_r8*rxt(k,369)*y(k,126))*y(k,205) & - +.300_r8*rxt(k,385)*y(k,134)*y(k,98) +.288_r8*rxt(k,49)*y(k,103) - loss(k,79) = (rxt(k,340)* y(k,217) + het_rates(k,106))* y(k,106) - prod(k,79) =rxt(k,334)*y(k,209)*y(k,203) - loss(k,110) = (rxt(k,349)* y(k,217) + rxt(k,52) + het_rates(k,107))* y(k,107) - prod(k,110) =.800_r8*rxt(k,19)*y(k,1) +.800_r8*rxt(k,20)*y(k,2) & + +.300_r8*rxt(k,385)*y(k,134)*y(k,98) +.300_r8*rxt(k,49)*y(k,103) + loss(k,102) = (rxt(k,340)* y(k,217) + het_rates(k,106))* y(k,106) + prod(k,102) =rxt(k,334)*y(k,209)*y(k,203) + loss(k,134) = (rxt(k,349)* y(k,217) + rxt(k,52) + het_rates(k,107))* y(k,107) + prod(k,134) =.800_r8*rxt(k,19)*y(k,1) +.800_r8*rxt(k,20)*y(k,2) & +.800_r8*rxt(k,358)*y(k,189)*y(k,124) - loss(k,80) = (rxt(k,350)* y(k,217) + rxt(k,53) + het_rates(k,108))* y(k,108) - prod(k,80) =.800_r8*rxt(k,347)*y(k,213)*y(k,203) - loss(k,119) = (rxt(k,351)* y(k,217) + rxt(k,54) + rxt(k,355) & + loss(k,103) = (rxt(k,350)* y(k,217) + rxt(k,53) + het_rates(k,108))* y(k,108) + prod(k,103) =.800_r8*rxt(k,347)*y(k,213)*y(k,203) + loss(k,143) = (rxt(k,351)* y(k,217) + rxt(k,54) + rxt(k,355) & + het_rates(k,109))* y(k,109) - prod(k,119) =rxt(k,354)*y(k,211)*y(k,125) - loss(k,152) = (rxt(k,442)* y(k,126) +rxt(k,443)* y(k,134) +rxt(k,444) & + prod(k,143) =rxt(k,354)*y(k,211)*y(k,125) + loss(k,182) = (rxt(k,442)* y(k,126) +rxt(k,443)* y(k,134) +rxt(k,444) & * y(k,217) + het_rates(k,110))* y(k,110) - prod(k,152) = 0._r8 - loss(k,176) = (rxt(k,352)* y(k,134) +rxt(k,353)* y(k,217) + rxt(k,55) & + prod(k,182) = 0._r8 + loss(k,205) = (rxt(k,352)* y(k,134) +rxt(k,353)* y(k,217) + rxt(k,55) & + het_rates(k,111))* y(k,111) - prod(k,176) = (.610_r8*rxt(k,365)*y(k,197) +.440_r8*rxt(k,366)*y(k,198) + & + prod(k,205) = (.610_r8*rxt(k,365)*y(k,197) +.440_r8*rxt(k,366)*y(k,198) + & .560_r8*rxt(k,368)*y(k,124) +.600_r8*rxt(k,369)*y(k,126))*y(k,205) & - +.200_r8*rxt(k,385)*y(k,134)*y(k,98) +.402_r8*rxt(k,49)*y(k,103) - loss(k,89) = (rxt(k,150)* y(k,124) + (rxt(k,151) +rxt(k,152) +rxt(k,153)) & - * y(k,125) +rxt(k,162)* y(k,217) + rxt(k,154) + het_rates(k,112)) & + +.200_r8*rxt(k,385)*y(k,134)*y(k,98) +.700_r8*rxt(k,49)*y(k,103) + loss(k,132) = (rxt(k,151)* y(k,124) + (rxt(k,152) +rxt(k,153) +rxt(k,154)) & + * y(k,125) +rxt(k,163)* y(k,217) + rxt(k,155) + het_rates(k,112)) & * y(k,112) - prod(k,89) =rxt(k,15)*y(k,124) - loss(k,75) = ( + rxt(k,13) + rxt(k,14) + rxt(k,173) + rxt(k,485) + rxt(k,522) & + prod(k,132) =rxt(k,15)*y(k,124) + loss(k,75) = ((rxt(k,167) +rxt(k,168))* y(k,216) + rxt(k,12) & + + het_rates(k,113))* y(k,113) + prod(k,75) =rxt(k,152)*y(k,125)*y(k,112) + loss(k,95) = ( + rxt(k,13) + rxt(k,14) + rxt(k,174) + rxt(k,485) + rxt(k,522) & + rxt(k,525) + rxt(k,536) + het_rates(k,114))* y(k,114) - prod(k,75) =rxt(k,169)*y(k,126)*y(k,125) - loss(k,90) = (rxt(k,388)* y(k,217) + rxt(k,486) + het_rates(k,115))* y(k,115) - prod(k,90) =.200_r8*rxt(k,380)*y(k,198)*y(k,101) - loss(k,158) = (rxt(k,389)* y(k,217) + rxt(k,56) + rxt(k,487) & + prod(k,95) =rxt(k,170)*y(k,126)*y(k,125) + loss(k,113) = (rxt(k,388)* y(k,217) + rxt(k,486) + het_rates(k,115)) & + * y(k,115) + prod(k,113) =.200_r8*rxt(k,380)*y(k,198)*y(k,101) + loss(k,189) = (rxt(k,389)* y(k,217) + rxt(k,56) + rxt(k,487) & + het_rates(k,116))* y(k,116) - prod(k,158) = (rxt(k,379)*y(k,197) +.800_r8*rxt(k,380)*y(k,198) + & + prod(k,189) = (rxt(k,379)*y(k,197) +.800_r8*rxt(k,380)*y(k,198) + & rxt(k,382)*y(k,124) +rxt(k,383)*y(k,126))*y(k,101) - loss(k,6) = ( + het_rates(k,117))* y(k,117) - prod(k,6) = 0._r8 - loss(k,7) = ( + het_rates(k,118))* y(k,118) - prod(k,7) = 0._r8 - loss(k,8) = ( + het_rates(k,119))* y(k,119) - prod(k,8) = 0._r8 - loss(k,43) = (rxt(k,479)* y(k,217) + het_rates(k,120))* y(k,120) - prod(k,43) = 0._r8 - loss(k,9) = ( + rxt(k,488) + het_rates(k,121))* y(k,121) - prod(k,9) = 0._r8 - loss(k,188) = (rxt(k,218)* y(k,19) +rxt(k,186)* y(k,59) +rxt(k,382)* y(k,101) & - +rxt(k,150)* y(k,112) +rxt(k,159)* y(k,126) +rxt(k,165)* y(k,133) & - +rxt(k,164)* y(k,134) +rxt(k,397)* y(k,188) + (rxt(k,358) + & + loss(k,10) = ( + het_rates(k,117))* y(k,117) + prod(k,10) = 0._r8 + loss(k,11) = ( + het_rates(k,118))* y(k,118) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,119))* y(k,119) + prod(k,12) = 0._r8 + loss(k,53) = (rxt(k,479)* y(k,217) + het_rates(k,120))* y(k,120) + prod(k,53) = 0._r8 + loss(k,13) = ( + rxt(k,488) + het_rates(k,121))* y(k,121) + prod(k,13) = 0._r8 + loss(k,14) = ( + rxt(k,540) + het_rates(k,122))* y(k,122) + prod(k,14) = 0._r8 + loss(k,15) = ( + rxt(k,539) + het_rates(k,123))* y(k,123) + prod(k,15) = 0._r8 + loss(k,217) = (rxt(k,219)* y(k,19) +rxt(k,187)* y(k,59) +rxt(k,382)* y(k,101) & + +rxt(k,151)* y(k,112) +rxt(k,160)* y(k,126) +rxt(k,166)* y(k,133) & + +rxt(k,165)* y(k,134) +rxt(k,397)* y(k,188) + (rxt(k,358) + & rxt(k,359))* y(k,189) +rxt(k,400)* y(k,191) +rxt(k,405)* y(k,193) & +rxt(k,283)* y(k,194) +rxt(k,311)* y(k,195) +rxt(k,407)* y(k,196) & - +rxt(k,294)* y(k,197) +rxt(k,261)* y(k,198) +rxt(k,411)* y(k,199) & + +rxt(k,294)* y(k,197) +rxt(k,262)* y(k,198) +rxt(k,411)* y(k,199) & + (rxt(k,329) +rxt(k,330))* y(k,200) +rxt(k,298)* y(k,202) & - +rxt(k,163)* y(k,203) +rxt(k,270)* y(k,204) +rxt(k,368)* y(k,205) & + +rxt(k,164)* y(k,203) +rxt(k,270)* y(k,204) +rxt(k,368)* y(k,205) & +rxt(k,374)* y(k,206) + (rxt(k,336) +rxt(k,337))* y(k,209) & +rxt(k,414)* y(k,210) +rxt(k,345)* y(k,211) +rxt(k,417)* y(k,212) & +rxt(k,348)* y(k,213) +rxt(k,447)* y(k,215) +rxt(k,420)* y(k,218) & @@ -605,21 +624,21 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & +rxt(k,457)* y(k,222) +rxt(k,427)* y(k,223) +rxt(k,393)* y(k,225) & +rxt(k,433)* y(k,226) +rxt(k,436)* y(k,228) + rxt(k,15) & + het_rates(k,124))* y(k,124) - prod(k,188) = (rxt(k,16) +.500_r8*rxt(k,489) +2.000_r8*rxt(k,152)*y(k,112) + & - rxt(k,155)*y(k,133) +rxt(k,471)*y(k,150))*y(k,125) + (rxt(k,154) + & - rxt(k,162)*y(k,217))*y(k,112) +2.000_r8*rxt(k,166)*y(k,216)*y(k,113) & + prod(k,217) = (rxt(k,16) +.500_r8*rxt(k,489) +2.000_r8*rxt(k,153)*y(k,112) + & + rxt(k,156)*y(k,133) +rxt(k,472)*y(k,150))*y(k,125) + (rxt(k,155) + & + rxt(k,163)*y(k,217))*y(k,112) +2.000_r8*rxt(k,167)*y(k,216)*y(k,113) & +rxt(k,14)*y(k,114) +rxt(k,17)*y(k,126) - loss(k,187) = (rxt(k,219)* y(k,19) +rxt(k,188)* y(k,59) + (rxt(k,151) + & - rxt(k,152) +rxt(k,153))* y(k,112) +rxt(k,169)* y(k,126) & - + (rxt(k,155) +rxt(k,157))* y(k,133) +rxt(k,156)* y(k,134) & - +rxt(k,422)* y(k,141) +rxt(k,471)* y(k,150) +rxt(k,425)* y(k,188) & - +rxt(k,305)* y(k,197) +rxt(k,412)* y(k,199) +rxt(k,168)* y(k,203) & + loss(k,224) = (rxt(k,220)* y(k,19) +rxt(k,189)* y(k,59) + (rxt(k,152) + & + rxt(k,153) +rxt(k,154))* y(k,112) +rxt(k,170)* y(k,126) & + + (rxt(k,156) +rxt(k,158))* y(k,133) +rxt(k,157)* y(k,134) & + +rxt(k,422)* y(k,141) +rxt(k,472)* y(k,150) +rxt(k,425)* y(k,188) & + +rxt(k,305)* y(k,197) +rxt(k,412)* y(k,199) +rxt(k,169)* y(k,203) & +rxt(k,415)* y(k,210) +rxt(k,354)* y(k,211) +rxt(k,418)* y(k,212) & - +rxt(k,170)* y(k,217) + rxt(k,16) + rxt(k,489) + het_rates(k,125)) & + +rxt(k,171)* y(k,217) + rxt(k,16) + rxt(k,489) + het_rates(k,125)) & * y(k,125) - prod(k,187) = (2.000_r8*rxt(k,159)*y(k,126) +rxt(k,163)*y(k,203) + & - rxt(k,164)*y(k,134) +rxt(k,165)*y(k,133) +rxt(k,186)*y(k,59) + & - rxt(k,218)*y(k,19) +rxt(k,261)*y(k,198) +rxt(k,270)*y(k,204) + & + prod(k,224) = (2.000_r8*rxt(k,160)*y(k,126) +rxt(k,164)*y(k,203) + & + rxt(k,165)*y(k,134) +rxt(k,166)*y(k,133) +rxt(k,187)*y(k,59) + & + rxt(k,219)*y(k,19) +rxt(k,262)*y(k,198) +rxt(k,270)*y(k,204) + & rxt(k,283)*y(k,194) +rxt(k,294)*y(k,197) +rxt(k,298)*y(k,202) + & rxt(k,311)*y(k,195) +rxt(k,319)*y(k,219) +rxt(k,323)*y(k,220) + & rxt(k,329)*y(k,200) +rxt(k,336)*y(k,209) +rxt(k,345)*y(k,211) + & @@ -631,150 +650,156 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & rxt(k,420)*y(k,218) +rxt(k,427)*y(k,223) +rxt(k,433)*y(k,226) + & rxt(k,436)*y(k,228) +1.600_r8*rxt(k,447)*y(k,215) + & .900_r8*rxt(k,452)*y(k,221) +.800_r8*rxt(k,457)*y(k,222))*y(k,124) & - + (rxt(k,18) +rxt(k,158)*y(k,203) +rxt(k,160)*y(k,133) + & - rxt(k,161)*y(k,217) +rxt(k,327)*y(k,16) +rxt(k,335)*y(k,209) + & + + (rxt(k,18) +rxt(k,159)*y(k,203) +rxt(k,161)*y(k,133) + & + rxt(k,162)*y(k,217) +rxt(k,327)*y(k,16) +rxt(k,335)*y(k,209) + & rxt(k,346)*y(k,211) +rxt(k,369)*y(k,205) +rxt(k,375)*y(k,206) + & rxt(k,383)*y(k,101) +rxt(k,394)*y(k,225) + & - 2.000_r8*rxt(k,448)*y(k,215))*y(k,126) + (rxt(k,149)*y(k,90) + & + 2.000_r8*rxt(k,448)*y(k,215))*y(k,126) + (rxt(k,150)*y(k,90) + & rxt(k,317)*y(k,127) +rxt(k,356)*y(k,1) +.700_r8*rxt(k,376)*y(k,99) + & - rxt(k,454)*y(k,175))*y(k,217) + (rxt(k,11) +rxt(k,172))*y(k,90) & - + (rxt(k,54) +rxt(k,355))*y(k,109) + (rxt(k,13) +rxt(k,173)) & + rxt(k,454)*y(k,175))*y(k,217) + (rxt(k,11) +rxt(k,173))*y(k,90) & + + (rxt(k,54) +rxt(k,355))*y(k,109) + (rxt(k,13) +rxt(k,174)) & *y(k,114) + (.600_r8*rxt(k,60) +rxt(k,306))*y(k,139) +rxt(k,19) & *y(k,1) +rxt(k,76)*y(k,20) +rxt(k,95)*y(k,60) +rxt(k,9)*y(k,89) & +rxt(k,45)*y(k,93) +rxt(k,48)*y(k,102) +rxt(k,56)*y(k,116) & +rxt(k,57)*y(k,127) +rxt(k,58)*y(k,128) +rxt(k,59)*y(k,138) & +rxt(k,430)*y(k,140) +rxt(k,66)*y(k,175) & +.500_r8*rxt(k,445)*y(k,215)*y(k,198) - loss(k,196) = (rxt(k,439)* y(k,6) +rxt(k,327)* y(k,16) +rxt(k,307)* y(k,29) & - +rxt(k,255)* y(k,42) +rxt(k,288)* y(k,45) +rxt(k,314)* y(k,49) & + loss(k,216) = (rxt(k,439)* y(k,6) +rxt(k,327)* y(k,16) +rxt(k,307)* y(k,29) & + +rxt(k,256)* y(k,42) +rxt(k,288)* y(k,45) +rxt(k,314)* y(k,49) & +rxt(k,462)* y(k,67) +rxt(k,378)* y(k,98) +rxt(k,383)* y(k,101) & - +rxt(k,442)* y(k,110) +rxt(k,159)* y(k,124) +rxt(k,169)* y(k,125) & - +rxt(k,160)* y(k,133) +rxt(k,459)* y(k,177) +rxt(k,158)* y(k,203) & + +rxt(k,442)* y(k,110) +rxt(k,160)* y(k,124) +rxt(k,170)* y(k,125) & + +rxt(k,161)* y(k,133) +rxt(k,459)* y(k,177) +rxt(k,159)* y(k,203) & +rxt(k,369)* y(k,205) +rxt(k,375)* y(k,206) +rxt(k,335)* y(k,209) & - +rxt(k,346)* y(k,211) +rxt(k,448)* y(k,215) +rxt(k,161)* y(k,217) & + +rxt(k,346)* y(k,211) +rxt(k,448)* y(k,215) +rxt(k,162)* y(k,217) & +rxt(k,394)* y(k,225) + rxt(k,17) + rxt(k,18) + rxt(k,490) & + het_rates(k,126))* y(k,126) - prod(k,196) = (rxt(k,94) +rxt(k,187)*y(k,56) +rxt(k,189)*y(k,133) + & - rxt(k,190)*y(k,217))*y(k,60) + (rxt(k,13) +rxt(k,14) +rxt(k,173)) & - *y(k,114) + (rxt(k,171)*y(k,89) +rxt(k,303)*y(k,139) + & + prod(k,216) = (rxt(k,94) +rxt(k,188)*y(k,56) +rxt(k,190)*y(k,133) + & + rxt(k,191)*y(k,217))*y(k,60) + (rxt(k,13) +rxt(k,14) +rxt(k,174)) & + *y(k,114) + (rxt(k,172)*y(k,89) +rxt(k,303)*y(k,139) + & .500_r8*rxt(k,351)*y(k,109))*y(k,217) + (rxt(k,77) + & - rxt(k,220)*y(k,133))*y(k,20) + (rxt(k,156)*y(k,134) + & - rxt(k,157)*y(k,133))*y(k,125) +rxt(k,234)*y(k,89)*y(k,73) +rxt(k,10) & + rxt(k,221)*y(k,133))*y(k,20) + (rxt(k,157)*y(k,134) + & + rxt(k,158)*y(k,133))*y(k,125) +rxt(k,235)*y(k,89)*y(k,73) +rxt(k,10) & *y(k,90) +.400_r8*rxt(k,60)*y(k,139) - loss(k,147) = (rxt(k,317)* y(k,217) + rxt(k,57) + het_rates(k,127))* y(k,127) - prod(k,147) = (.500_r8*rxt(k,377)*y(k,100) +rxt(k,384)*y(k,102) + & + loss(k,174) = (rxt(k,317)* y(k,217) + rxt(k,57) + het_rates(k,127))* y(k,127) + prod(k,174) = (.500_r8*rxt(k,377)*y(k,100) +rxt(k,384)*y(k,102) + & rxt(k,388)*y(k,115) +rxt(k,389)*y(k,116))*y(k,217) & +rxt(k,307)*y(k,126)*y(k,29) - loss(k,93) = (rxt(k,449)* y(k,217) + rxt(k,58) + rxt(k,491) & + loss(k,116) = (rxt(k,449)* y(k,217) + rxt(k,58) + rxt(k,491) & + het_rates(k,128))* y(k,128) - prod(k,93) =rxt(k,446)*y(k,215)*y(k,203) - loss(k,10) = ( + het_rates(k,129))* y(k,129) - prod(k,10) = 0._r8 - loss(k,11) = ( + het_rates(k,130))* y(k,130) - prod(k,11) = 0._r8 - loss(k,12) = ( + het_rates(k,131))* y(k,131) - prod(k,12) = 0._r8 - loss(k,13) = ( + het_rates(k,132))* y(k,132) - prod(k,13) = 0._r8 - loss(k,193) = (rxt(k,221)* y(k,19) +rxt(k,220)* y(k,20) +rxt(k,256)* y(k,42) & - +rxt(k,191)* y(k,59) +rxt(k,189)* y(k,60) +rxt(k,132)* y(k,77) & - +rxt(k,133)* y(k,79) +rxt(k,223)* y(k,81) +rxt(k,194)* y(k,85) & - +rxt(k,225)* y(k,91) +rxt(k,197)* y(k,92) +rxt(k,165)* y(k,124) & - + (rxt(k,155) +rxt(k,157))* y(k,125) +rxt(k,160)* y(k,126) & - + 2._r8*rxt(k,130)* y(k,133) +rxt(k,129)* y(k,134) +rxt(k,464) & - * y(k,137) +rxt(k,138)* y(k,203) +rxt(k,144)* y(k,217) + rxt(k,131) & + prod(k,116) =rxt(k,446)*y(k,215)*y(k,203) + loss(k,16) = ( + het_rates(k,129))* y(k,129) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,130))* y(k,130) + prod(k,17) = 0._r8 + loss(k,18) = ( + het_rates(k,131))* y(k,131) + prod(k,18) = 0._r8 + loss(k,19) = ( + het_rates(k,132))* y(k,132) + prod(k,19) = 0._r8 + loss(k,226) = (rxt(k,222)* y(k,19) +rxt(k,221)* y(k,20) +rxt(k,257)* y(k,42) & + +rxt(k,192)* y(k,59) +rxt(k,190)* y(k,60) +rxt(k,133)* y(k,77) & + +rxt(k,134)* y(k,79) +rxt(k,224)* y(k,81) +rxt(k,195)* y(k,85) & + +rxt(k,226)* y(k,91) +rxt(k,198)* y(k,92) +rxt(k,166)* y(k,124) & + + (rxt(k,156) +rxt(k,158))* y(k,125) +rxt(k,161)* y(k,126) & + + 2._r8*rxt(k,131)* y(k,133) +rxt(k,130)* y(k,134) +rxt(k,464) & + * y(k,137) +rxt(k,139)* y(k,203) +rxt(k,145)* y(k,217) + rxt(k,132) & + het_rates(k,133))* y(k,133) - prod(k,193) = (rxt(k,154) +rxt(k,150)*y(k,124) +rxt(k,151)*y(k,125))*y(k,112) & - + (rxt(k,111) +rxt(k,472))*y(k,150) + (rxt(k,126) +rxt(k,127)) & - *y(k,216) +rxt(k,75)*y(k,19) +rxt(k,93)*y(k,59) +rxt(k,136)*y(k,203) & - *y(k,76) +rxt(k,14)*y(k,114) +rxt(k,15)*y(k,124) +rxt(k,16)*y(k,125) & - +rxt(k,18)*y(k,126) +rxt(k,8)*y(k,134) +rxt(k,107)*y(k,136) & - +rxt(k,466)*y(k,148) +rxt(k,112)*y(k,151) +rxt(k,113)*y(k,152) & - +rxt(k,146)*y(k,217)*y(k,217) +rxt(k,3)*y(k,229) - loss(k,197) = (rxt(k,440)* y(k,6) +rxt(k,212)* y(k,17) +rxt(k,279)* y(k,25) & - +rxt(k,308)* y(k,29) +rxt(k,180)* y(k,56) +rxt(k,140)* y(k,76) & + prod(k,226) = (rxt(k,155) +rxt(k,151)*y(k,124) +rxt(k,152)*y(k,125))*y(k,112) & + + (rxt(k,111) +rxt(k,473))*y(k,150) + (rxt(k,127) +rxt(k,128)) & + *y(k,216) +rxt(k,75)*y(k,19) +.180_r8*rxt(k,39)*y(k,54) +rxt(k,93) & + *y(k,59) +rxt(k,41)*y(k,63) +rxt(k,137)*y(k,203)*y(k,76) +rxt(k,14) & + *y(k,114) +rxt(k,15)*y(k,124) +rxt(k,16)*y(k,125) +rxt(k,18)*y(k,126) & + +rxt(k,8)*y(k,134) +rxt(k,107)*y(k,136) +rxt(k,466)*y(k,148) & + +rxt(k,112)*y(k,151) +rxt(k,113)*y(k,152) +rxt(k,147)*y(k,217) & + *y(k,217) +rxt(k,3)*y(k,229) + loss(k,222) = (rxt(k,440)* y(k,6) +rxt(k,213)* y(k,17) +rxt(k,279)* y(k,25) & + +rxt(k,308)* y(k,29) +rxt(k,181)* y(k,56) +rxt(k,141)* y(k,76) & +rxt(k,385)* y(k,98) +rxt(k,338)* y(k,105) +rxt(k,443)* y(k,110) & - +rxt(k,352)* y(k,111) +rxt(k,164)* y(k,124) +rxt(k,156)* y(k,125) & - +rxt(k,129)* y(k,133) +rxt(k,423)* y(k,141) +rxt(k,467)* y(k,148) & - +rxt(k,473)* y(k,150) +rxt(k,139)* y(k,203) +rxt(k,128)* y(k,216) & - +rxt(k,145)* y(k,217) + rxt(k,7) + rxt(k,8) + het_rates(k,134)) & + +rxt(k,352)* y(k,111) +rxt(k,165)* y(k,124) +rxt(k,157)* y(k,125) & + +rxt(k,130)* y(k,133) +rxt(k,423)* y(k,141) +rxt(k,468)* y(k,148) & + +rxt(k,474)* y(k,150) +rxt(k,140)* y(k,203) +rxt(k,129)* y(k,216) & + +rxt(k,146)* y(k,217) + rxt(k,7) + rxt(k,8) + het_rates(k,134)) & * y(k,134) - prod(k,197) = (.150_r8*rxt(k,293)*y(k,197) +.150_r8*rxt(k,343)*y(k,211)) & - *y(k,203) +rxt(k,131)*y(k,133) - loss(k,82) = (rxt(k,474)* y(k,150) + rxt(k,107) + het_rates(k,136))* y(k,136) - prod(k,82) = (rxt(k,184)*y(k,59) +rxt(k,214)*y(k,19))*y(k,59) - loss(k,87) = (rxt(k,464)* y(k,133) +rxt(k,465)* y(k,217) + rxt(k,110) & + prod(k,222) = (.150_r8*rxt(k,293)*y(k,197) +.150_r8*rxt(k,343)*y(k,211)) & + *y(k,203) +rxt(k,132)*y(k,133) + loss(k,20) = ( + het_rates(k,135))* y(k,135) + prod(k,20) = 0._r8 + loss(k,106) = (rxt(k,475)* y(k,150) + rxt(k,107) + het_rates(k,136)) & + * y(k,136) + prod(k,106) = (rxt(k,185)*y(k,59) +rxt(k,215)*y(k,19))*y(k,59) + loss(k,111) = (rxt(k,464)* y(k,133) +rxt(k,465)* y(k,217) + rxt(k,110) & + het_rates(k,137))* y(k,137) - prod(k,87) = 0._r8 - loss(k,66) = ( + rxt(k,59) + rxt(k,492) + het_rates(k,138))* y(k,138) - prod(k,66) =rxt(k,331)*y(k,217)*y(k,93) +.100_r8*rxt(k,452)*y(k,221)*y(k,124) - loss(k,104) = (rxt(k,303)* y(k,217) + rxt(k,60) + rxt(k,306) & + prod(k,111) = 0._r8 + loss(k,88) = ( + rxt(k,59) + rxt(k,492) + het_rates(k,138))* y(k,138) + prod(k,88) =rxt(k,331)*y(k,217)*y(k,93) +.100_r8*rxt(k,452)*y(k,221)*y(k,124) + loss(k,137) = (rxt(k,303)* y(k,217) + rxt(k,60) + rxt(k,306) & + het_rates(k,139))* y(k,139) - prod(k,104) =rxt(k,305)*y(k,197)*y(k,125) - loss(k,50) = ( + rxt(k,430) + het_rates(k,140))* y(k,140) - prod(k,50) =rxt(k,425)*y(k,188)*y(k,125) - loss(k,105) = (rxt(k,422)* y(k,125) +rxt(k,423)* y(k,134) + het_rates(k,141)) & + prod(k,137) =rxt(k,305)*y(k,197)*y(k,125) + loss(k,65) = ( + rxt(k,430) + het_rates(k,140))* y(k,140) + prod(k,65) =rxt(k,425)*y(k,188)*y(k,125) + loss(k,128) = (rxt(k,422)* y(k,125) +rxt(k,423)* y(k,134) + het_rates(k,141)) & * y(k,141) - prod(k,105) = (.070_r8*rxt(k,409)*y(k,66) +.060_r8*rxt(k,421)*y(k,142) + & + prod(k,128) = (.070_r8*rxt(k,409)*y(k,66) +.060_r8*rxt(k,421)*y(k,142) + & .070_r8*rxt(k,437)*y(k,184))*y(k,217) +rxt(k,31)*y(k,32) & +rxt(k,407)*y(k,196)*y(k,124) - loss(k,54) = (rxt(k,421)* y(k,217) + het_rates(k,142))* y(k,142) - prod(k,54) =.530_r8*rxt(k,398)*y(k,217)*y(k,7) - loss(k,83) = (rxt(k,424)* y(k,217) + rxt(k,61) + het_rates(k,143))* y(k,143) - prod(k,83) =rxt(k,419)*y(k,218)*y(k,203) - loss(k,14) = ( + het_rates(k,144))* y(k,144) - prod(k,14) = 0._r8 - loss(k,15) = ( + het_rates(k,145))* y(k,145) - prod(k,15) = 0._r8 - loss(k,113) = (rxt(k,320)* y(k,217) + rxt(k,62) + het_rates(k,146))* y(k,146) - prod(k,113) =rxt(k,318)*y(k,219)*y(k,203) - loss(k,97) = (rxt(k,324)* y(k,217) + rxt(k,63) + het_rates(k,147))* y(k,147) - prod(k,97) =.850_r8*rxt(k,322)*y(k,220)*y(k,203) - loss(k,109) = (rxt(k,467)* y(k,134) +rxt(k,470)* y(k,217) + rxt(k,466) & + loss(k,73) = (rxt(k,421)* y(k,217) + het_rates(k,142))* y(k,142) + prod(k,73) =.530_r8*rxt(k,398)*y(k,217)*y(k,7) + loss(k,107) = (rxt(k,424)* y(k,217) + rxt(k,61) + het_rates(k,143))* y(k,143) + prod(k,107) =rxt(k,419)*y(k,218)*y(k,203) + loss(k,21) = ( + het_rates(k,144))* y(k,144) + prod(k,21) = 0._r8 + loss(k,22) = ( + het_rates(k,145))* y(k,145) + prod(k,22) = 0._r8 + loss(k,138) = (rxt(k,320)* y(k,217) + rxt(k,62) + het_rates(k,146))* y(k,146) + prod(k,138) =rxt(k,318)*y(k,219)*y(k,203) + loss(k,119) = (rxt(k,324)* y(k,217) + rxt(k,63) + het_rates(k,147))* y(k,147) + prod(k,119) =.850_r8*rxt(k,322)*y(k,220)*y(k,203) + loss(k,135) = (rxt(k,468)* y(k,134) +rxt(k,471)* y(k,217) + rxt(k,466) & + het_rates(k,148))* y(k,148) - prod(k,109) =rxt(k,110)*y(k,137) +rxt(k,111)*y(k,150) - loss(k,174) = (rxt(k,468)* y(k,19) +rxt(k,469)* y(k,59) +rxt(k,471)* y(k,125) & - +rxt(k,473)* y(k,134) +rxt(k,474)* y(k,136) +rxt(k,475)* y(k,217) & - + rxt(k,111) + rxt(k,472) + het_rates(k,150))* y(k,150) - prod(k,174) = (rxt(k,466) +rxt(k,467)*y(k,134) +rxt(k,470)*y(k,217))*y(k,148) & + prod(k,135) =rxt(k,110)*y(k,137) +rxt(k,111)*y(k,150) + loss(k,23) = ( + rxt(k,108) + het_rates(k,149))* y(k,149) + prod(k,23) = 0._r8 + loss(k,201) = (rxt(k,469)* y(k,19) +rxt(k,470)* y(k,59) +rxt(k,472)* y(k,125) & + +rxt(k,474)* y(k,134) +rxt(k,475)* y(k,136) +rxt(k,476)* y(k,217) & + + rxt(k,111) + rxt(k,473) + het_rates(k,150))* y(k,150) + prod(k,201) = (rxt(k,466) +rxt(k,468)*y(k,134) +rxt(k,471)*y(k,217))*y(k,148) & +rxt(k,464)*y(k,137)*y(k,133) +rxt(k,112)*y(k,151) - loss(k,148) = (rxt(k,477)* y(k,217) + rxt(k,112) + het_rates(k,151)) & + loss(k,172) = (rxt(k,467)* y(k,217) + rxt(k,112) + het_rates(k,151)) & * y(k,151) - prod(k,148) = (rxt(k,472) +rxt(k,468)*y(k,19) +rxt(k,469)*y(k,59) + & - rxt(k,471)*y(k,125) +rxt(k,473)*y(k,134) +rxt(k,474)*y(k,136) + & - rxt(k,475)*y(k,217))*y(k,150) + (rxt(k,462)*y(k,126) + & - rxt(k,463)*y(k,217) +.500_r8*rxt(k,476)*y(k,217))*y(k,67) & + prod(k,172) = (rxt(k,473) +rxt(k,469)*y(k,19) +rxt(k,470)*y(k,59) + & + rxt(k,472)*y(k,125) +rxt(k,474)*y(k,134) +rxt(k,475)*y(k,136) + & + rxt(k,476)*y(k,217))*y(k,150) + (rxt(k,462)*y(k,126) + & + rxt(k,463)*y(k,217) +.500_r8*rxt(k,477)*y(k,217))*y(k,67) & +rxt(k,465)*y(k,217)*y(k,137) +rxt(k,113)*y(k,152) - loss(k,70) = (rxt(k,478)* y(k,229) + rxt(k,113) + het_rates(k,152))* y(k,152) - prod(k,70) =rxt(k,109)*y(k,80) +rxt(k,477)*y(k,217)*y(k,151) - loss(k,16) = ( + het_rates(k,153))* y(k,153) - prod(k,16) = 0._r8 - loss(k,17) = ( + het_rates(k,154))* y(k,154) - prod(k,17) = 0._r8 - loss(k,18) = ( + het_rates(k,155))* y(k,155) - prod(k,18) = 0._r8 - loss(k,19) = ( + rxt(k,114) + het_rates(k,156))* y(k,156) - prod(k,19) = 0._r8 - loss(k,20) = ( + rxt(k,115) + het_rates(k,157))* y(k,157) - prod(k,20) = 0._r8 - loss(k,21) = ( + rxt(k,116) + het_rates(k,158))* y(k,158) - prod(k,21) = 0._r8 - loss(k,22) = ( + rxt(k,117) + het_rates(k,159))* y(k,159) - prod(k,22) = 0._r8 - loss(k,23) = ( + rxt(k,118) + het_rates(k,160))* y(k,160) - prod(k,23) = 0._r8 - loss(k,24) = ( + rxt(k,119) + het_rates(k,161))* y(k,161) + loss(k,91) = (rxt(k,478)* y(k,229) + rxt(k,113) + het_rates(k,152))* y(k,152) + prod(k,91) =rxt(k,109)*y(k,80) +rxt(k,467)*y(k,217)*y(k,151) + loss(k,24) = ( + het_rates(k,153))* y(k,153) prod(k,24) = 0._r8 - loss(k,25) = ( + rxt(k,120) + het_rates(k,162))* y(k,162) + loss(k,25) = ( + het_rates(k,154))* y(k,154) prod(k,25) = 0._r8 - loss(k,26) = ( + rxt(k,121) + het_rates(k,163))* y(k,163) + loss(k,26) = ( + het_rates(k,155))* y(k,155) prod(k,26) = 0._r8 - loss(k,27) = ( + rxt(k,122) + het_rates(k,164))* y(k,164) + loss(k,27) = ( + rxt(k,114) + het_rates(k,156))* y(k,156) prod(k,27) = 0._r8 - loss(k,28) = ( + rxt(k,123) + het_rates(k,165))* y(k,165) + loss(k,28) = ( + rxt(k,115) + het_rates(k,157))* y(k,157) prod(k,28) = 0._r8 - loss(k,29) = ( + het_rates(k,166))* y(k,166) - prod(k,29) = (.1279005_r8*rxt(k,496)*y(k,190) + & + loss(k,29) = ( + rxt(k,116) + het_rates(k,158))* y(k,158) + prod(k,29) = 0._r8 + loss(k,30) = ( + rxt(k,117) + het_rates(k,159))* y(k,159) + prod(k,30) = 0._r8 + loss(k,31) = ( + rxt(k,118) + het_rates(k,160))* y(k,160) + prod(k,31) = 0._r8 + loss(k,32) = ( + rxt(k,119) + het_rates(k,161))* y(k,161) + prod(k,32) = 0._r8 + loss(k,33) = ( + rxt(k,120) + het_rates(k,162))* y(k,162) + prod(k,33) = 0._r8 + loss(k,34) = ( + rxt(k,121) + het_rates(k,163))* y(k,163) + prod(k,34) = 0._r8 + loss(k,35) = ( + rxt(k,122) + het_rates(k,164))* y(k,164) + prod(k,35) = 0._r8 + loss(k,36) = ( + rxt(k,123) + het_rates(k,165))* y(k,165) + prod(k,36) = 0._r8 + loss(k,37) = ( + het_rates(k,166))* y(k,166) + prod(k,37) = (.1279005_r8*rxt(k,496)*y(k,190) + & .0097005_r8*rxt(k,501)*y(k,192) +.0003005_r8*rxt(k,504)*y(k,207) + & .1056005_r8*rxt(k,508)*y(k,208) +.0245005_r8*rxt(k,512)*y(k,214) + & .0154005_r8*rxt(k,518)*y(k,224) +.0063005_r8*rxt(k,521)*y(k,227)) & @@ -785,8 +810,8 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & *y(k,203) + (.2202005_r8*rxt(k,497)*y(k,6) + & .0508005_r8*rxt(k,513)*y(k,110))*y(k,134) +rxt(k,480)*y(k,75) & +.5931005_r8*rxt(k,515)*y(k,217)*y(k,172) - loss(k,30) = ( + het_rates(k,167))* y(k,167) - prod(k,30) = (.1792005_r8*rxt(k,496)*y(k,190) + & + loss(k,38) = ( + het_rates(k,167))* y(k,167) + prod(k,38) = (.1792005_r8*rxt(k,496)*y(k,190) + & .0034005_r8*rxt(k,501)*y(k,192) +.0003005_r8*rxt(k,504)*y(k,207) + & .1026005_r8*rxt(k,508)*y(k,208) +.0082005_r8*rxt(k,512)*y(k,214) + & .0452005_r8*rxt(k,518)*y(k,224) +.0237005_r8*rxt(k,521)*y(k,227)) & @@ -797,8 +822,8 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & *y(k,203) + (.2067005_r8*rxt(k,497)*y(k,6) + & .1149005_r8*rxt(k,513)*y(k,110))*y(k,134) & +.1534005_r8*rxt(k,515)*y(k,217)*y(k,172) - loss(k,31) = ( + het_rates(k,168))* y(k,168) - prod(k,31) = (.0676005_r8*rxt(k,496)*y(k,190) + & + loss(k,39) = ( + het_rates(k,168))* y(k,168) + prod(k,39) = (.0676005_r8*rxt(k,496)*y(k,190) + & .1579005_r8*rxt(k,501)*y(k,192) +.0073005_r8*rxt(k,504)*y(k,207) + & .0521005_r8*rxt(k,508)*y(k,208) +.0772005_r8*rxt(k,512)*y(k,214) + & .0966005_r8*rxt(k,518)*y(k,224) +.0025005_r8*rxt(k,521)*y(k,227)) & @@ -809,8 +834,8 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & *y(k,203) + (.0653005_r8*rxt(k,497)*y(k,6) + & .0348005_r8*rxt(k,513)*y(k,110))*y(k,134) & +.0459005_r8*rxt(k,515)*y(k,217)*y(k,172) - loss(k,32) = ( + het_rates(k,169))* y(k,169) - prod(k,32) = (.079_r8*rxt(k,496)*y(k,190) +.0059005_r8*rxt(k,501)*y(k,192) + & + loss(k,40) = ( + het_rates(k,169))* y(k,169) + prod(k,40) = (.079_r8*rxt(k,496)*y(k,190) +.0059005_r8*rxt(k,501)*y(k,192) + & .0057005_r8*rxt(k,504)*y(k,207) +.0143005_r8*rxt(k,508)*y(k,208) + & .0332005_r8*rxt(k,512)*y(k,214) +.0073005_r8*rxt(k,518)*y(k,224) + & .011_r8*rxt(k,521)*y(k,227))*y(k,124) & @@ -823,8 +848,8 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & *y(k,126) + (.1284005_r8*rxt(k,497)*y(k,6) + & .0033005_r8*rxt(k,505)*y(k,98) +.0554005_r8*rxt(k,513)*y(k,110)) & *y(k,134) +.0085005_r8*rxt(k,515)*y(k,217)*y(k,172) - loss(k,33) = ( + het_rates(k,170))* y(k,170) - prod(k,33) = (.1254005_r8*rxt(k,496)*y(k,190) + & + loss(k,41) = ( + het_rates(k,170))* y(k,170) + prod(k,41) = (.1254005_r8*rxt(k,496)*y(k,190) + & .0536005_r8*rxt(k,501)*y(k,192) +.0623005_r8*rxt(k,504)*y(k,207) + & .0166005_r8*rxt(k,508)*y(k,208) +.130_r8*rxt(k,512)*y(k,214) + & .238_r8*rxt(k,518)*y(k,224) +.1185005_r8*rxt(k,521)*y(k,227)) & @@ -837,81 +862,83 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & *y(k,126) + (.114_r8*rxt(k,497)*y(k,6) + & .1278005_r8*rxt(k,513)*y(k,110))*y(k,134) & +.0128005_r8*rxt(k,515)*y(k,217)*y(k,172) - loss(k,34) = (rxt(k,515)* y(k,217) + het_rates(k,172))* y(k,172) - prod(k,34) = 0._r8 - loss(k,60) = ( + rxt(k,64) + het_rates(k,173))* y(k,173) - prod(k,60) = (.100_r8*rxt(k,429)*y(k,180) +.230_r8*rxt(k,431)*y(k,182)) & + loss(k,42) = ( + rxt(k,541) + het_rates(k,171))* y(k,171) + prod(k,42) = 0._r8 + loss(k,43) = (rxt(k,515)* y(k,217) + het_rates(k,172))* y(k,172) + prod(k,43) = 0._r8 + loss(k,78) = ( + rxt(k,64) + het_rates(k,173))* y(k,173) + prod(k,78) = (.100_r8*rxt(k,429)*y(k,180) +.230_r8*rxt(k,431)*y(k,182)) & *y(k,217) - loss(k,122) = (rxt(k,453)* y(k,217) + rxt(k,65) + het_rates(k,174))* y(k,174) - prod(k,122) =rxt(k,451)*y(k,221)*y(k,203) - loss(k,124) = (rxt(k,454)* y(k,217) + rxt(k,66) + rxt(k,493) & + loss(k,152) = (rxt(k,453)* y(k,217) + rxt(k,65) + het_rates(k,174))* y(k,174) + prod(k,152) =rxt(k,451)*y(k,221)*y(k,203) + loss(k,149) = (rxt(k,454)* y(k,217) + rxt(k,66) + rxt(k,493) & + het_rates(k,175))* y(k,175) - prod(k,124) = (.200_r8*rxt(k,447)*y(k,215) +.200_r8*rxt(k,457)*y(k,222)) & + prod(k,149) = (.200_r8*rxt(k,447)*y(k,215) +.200_r8*rxt(k,457)*y(k,222)) & *y(k,124) +.500_r8*rxt(k,445)*y(k,215)*y(k,198) - loss(k,106) = (rxt(k,458)* y(k,217) + rxt(k,67) + het_rates(k,176))* y(k,176) - prod(k,106) =rxt(k,456)*y(k,222)*y(k,203) - loss(k,157) = (rxt(k,459)* y(k,126) +rxt(k,460)* y(k,217) + rxt(k,68) & + loss(k,130) = (rxt(k,458)* y(k,217) + rxt(k,67) + het_rates(k,176))* y(k,176) + prod(k,130) =rxt(k,456)*y(k,222)*y(k,203) + loss(k,183) = (rxt(k,459)* y(k,126) +rxt(k,460)* y(k,217) + rxt(k,68) & + het_rates(k,177))* y(k,177) - prod(k,157) = (.500_r8*rxt(k,445)*y(k,198) +.800_r8*rxt(k,447)*y(k,124) + & + prod(k,183) = (.500_r8*rxt(k,445)*y(k,198) +.800_r8*rxt(k,447)*y(k,124) + & rxt(k,448)*y(k,126))*y(k,215) + (.330_r8*rxt(k,440)*y(k,6) + & .330_r8*rxt(k,443)*y(k,110))*y(k,134) + (rxt(k,66) + & rxt(k,454)*y(k,217))*y(k,175) + (rxt(k,455)*y(k,198) + & .800_r8*rxt(k,457)*y(k,124))*y(k,222) +rxt(k,58)*y(k,128) +rxt(k,67) & *y(k,176) - loss(k,161) = (rxt(k,461)* y(k,217) + rxt(k,69) + het_rates(k,178))* y(k,178) - prod(k,161) = (.300_r8*rxt(k,440)*y(k,6) +.300_r8*rxt(k,443)*y(k,110)) & + loss(k,188) = (rxt(k,461)* y(k,217) + rxt(k,69) + het_rates(k,178))* y(k,178) + prod(k,188) = (.300_r8*rxt(k,440)*y(k,6) +.300_r8*rxt(k,443)*y(k,110)) & *y(k,134) + (rxt(k,450)*y(k,198) +.900_r8*rxt(k,452)*y(k,124)) & *y(k,221) +rxt(k,65)*y(k,174) +rxt(k,68)*y(k,177) - loss(k,127) = (rxt(k,428)* y(k,217) + rxt(k,70) + het_rates(k,179))* y(k,179) - prod(k,127) =rxt(k,426)*y(k,223)*y(k,203) - loss(k,58) = (rxt(k,429)* y(k,217) + het_rates(k,180))* y(k,180) - prod(k,58) = 0._r8 - loss(k,61) = (rxt(k,395)* y(k,217) + rxt(k,71) + het_rates(k,181))* y(k,181) - prod(k,61) =rxt(k,392)*y(k,225)*y(k,203) - loss(k,62) = (rxt(k,431)* y(k,217) + het_rates(k,182))* y(k,182) - prod(k,62) = 0._r8 - loss(k,131) = (rxt(k,434)* y(k,217) + rxt(k,72) + het_rates(k,183))* y(k,183) - prod(k,131) =rxt(k,432)*y(k,226)*y(k,203) - loss(k,63) = (rxt(k,437)* y(k,217) + het_rates(k,184))* y(k,184) - prod(k,63) =.150_r8*rxt(k,431)*y(k,217)*y(k,182) - loss(k,99) = (rxt(k,438)* y(k,217) + rxt(k,73) + het_rates(k,185))* y(k,185) - prod(k,99) =rxt(k,435)*y(k,228)*y(k,203) - loss(k,111) = (rxt(k,397)* y(k,124) +rxt(k,425)* y(k,125) +rxt(k,396) & + loss(k,153) = (rxt(k,428)* y(k,217) + rxt(k,70) + het_rates(k,179))* y(k,179) + prod(k,153) =rxt(k,426)*y(k,223)*y(k,203) + loss(k,76) = (rxt(k,429)* y(k,217) + het_rates(k,180))* y(k,180) + prod(k,76) = 0._r8 + loss(k,79) = (rxt(k,395)* y(k,217) + rxt(k,71) + het_rates(k,181))* y(k,181) + prod(k,79) =rxt(k,392)*y(k,225)*y(k,203) + loss(k,80) = (rxt(k,431)* y(k,217) + het_rates(k,182))* y(k,182) + prod(k,80) = 0._r8 + loss(k,158) = (rxt(k,434)* y(k,217) + rxt(k,72) + het_rates(k,183))* y(k,183) + prod(k,158) =rxt(k,432)*y(k,226)*y(k,203) + loss(k,81) = (rxt(k,437)* y(k,217) + het_rates(k,184))* y(k,184) + prod(k,81) =.150_r8*rxt(k,431)*y(k,217)*y(k,182) + loss(k,122) = (rxt(k,438)* y(k,217) + rxt(k,73) + het_rates(k,185))* y(k,185) + prod(k,122) =rxt(k,435)*y(k,228)*y(k,203) + loss(k,136) = (rxt(k,397)* y(k,124) +rxt(k,425)* y(k,125) +rxt(k,396) & * y(k,203) + het_rates(k,188))* y(k,188) - prod(k,111) =rxt(k,402)*y(k,217)*y(k,22) +rxt(k,430)*y(k,140) - loss(k,153) = ((rxt(k,358) +rxt(k,359))* y(k,124) +rxt(k,357)* y(k,203) & + prod(k,136) =rxt(k,402)*y(k,217)*y(k,22) +rxt(k,430)*y(k,140) + loss(k,178) = ((rxt(k,358) +rxt(k,359))* y(k,124) +rxt(k,357)* y(k,203) & + het_rates(k,189))* y(k,189) - prod(k,153) = (rxt(k,360)*y(k,2) +rxt(k,361)*y(k,15))*y(k,217) - loss(k,35) = (rxt(k,496)* y(k,124) +rxt(k,495)* y(k,203) + het_rates(k,190)) & + prod(k,178) = (rxt(k,360)*y(k,2) +rxt(k,361)*y(k,15))*y(k,217) + loss(k,44) = (rxt(k,496)* y(k,124) +rxt(k,495)* y(k,203) + het_rates(k,190)) & * y(k,190) - prod(k,35) =rxt(k,498)*y(k,217)*y(k,6) - loss(k,107) = (rxt(k,400)* y(k,124) +rxt(k,399)* y(k,203) + het_rates(k,191)) & + prod(k,44) =rxt(k,498)*y(k,217)*y(k,6) + loss(k,131) = (rxt(k,400)* y(k,124) +rxt(k,399)* y(k,203) + het_rates(k,191)) & * y(k,191) - prod(k,107) = (.350_r8*rxt(k,398)*y(k,7) +rxt(k,401)*y(k,8))*y(k,217) - loss(k,36) = (rxt(k,501)* y(k,124) +rxt(k,500)* y(k,203) + het_rates(k,192)) & + prod(k,131) = (.350_r8*rxt(k,398)*y(k,7) +rxt(k,401)*y(k,8))*y(k,217) + loss(k,45) = (rxt(k,501)* y(k,124) +rxt(k,500)* y(k,203) + het_rates(k,192)) & * y(k,192) - prod(k,36) =rxt(k,499)*y(k,217)*y(k,7) - loss(k,100) = (rxt(k,405)* y(k,124) +rxt(k,403)* y(k,203) + het_rates(k,193)) & + prod(k,45) =rxt(k,499)*y(k,217)*y(k,7) + loss(k,123) = (rxt(k,405)* y(k,124) +rxt(k,403)* y(k,203) + het_rates(k,193)) & * y(k,193) - prod(k,100) = (rxt(k,404)*y(k,23) +.070_r8*rxt(k,429)*y(k,180) + & + prod(k,123) = (rxt(k,404)*y(k,23) +.070_r8*rxt(k,429)*y(k,180) + & .060_r8*rxt(k,431)*y(k,182))*y(k,217) - loss(k,144) = (rxt(k,283)* y(k,124) + 2._r8*rxt(k,280)* y(k,194) +rxt(k,281) & + loss(k,170) = (rxt(k,283)* y(k,124) + 2._r8*rxt(k,280)* y(k,194) +rxt(k,281) & * y(k,198) +rxt(k,282)* y(k,203) + het_rates(k,194))* y(k,194) - prod(k,144) = (rxt(k,286)*y(k,56) +rxt(k,287)*y(k,217))*y(k,28) & + prod(k,170) = (rxt(k,286)*y(k,56) +rxt(k,287)*y(k,217))*y(k,28) & +.500_r8*rxt(k,285)*y(k,217)*y(k,27) +rxt(k,52)*y(k,107) - loss(k,140) = (rxt(k,311)* y(k,124) +rxt(k,309)* y(k,198) +rxt(k,310) & + loss(k,167) = (rxt(k,311)* y(k,124) +rxt(k,309)* y(k,198) +rxt(k,310) & * y(k,203) + het_rates(k,195))* y(k,195) - prod(k,140) = (rxt(k,312)*y(k,30) +rxt(k,313)*y(k,31))*y(k,217) - loss(k,125) = (rxt(k,407)* y(k,124) +rxt(k,406)* y(k,203) + het_rates(k,196)) & + prod(k,167) = (rxt(k,312)*y(k,30) +rxt(k,313)*y(k,31))*y(k,217) + loss(k,150) = (rxt(k,407)* y(k,124) +rxt(k,406)* y(k,203) + het_rates(k,196)) & * y(k,196) - prod(k,125) = (.400_r8*rxt(k,396)*y(k,203) +rxt(k,397)*y(k,124))*y(k,188) & + prod(k,150) = (.400_r8*rxt(k,396)*y(k,203) +rxt(k,397)*y(k,124))*y(k,188) & +rxt(k,408)*y(k,217)*y(k,32) +rxt(k,423)*y(k,141)*y(k,134) - loss(k,180) = (rxt(k,379)* y(k,101) +rxt(k,294)* y(k,124) +rxt(k,305) & + loss(k,207) = (rxt(k,379)* y(k,101) +rxt(k,294)* y(k,124) +rxt(k,305) & * y(k,125) + 2._r8*rxt(k,291)* y(k,197) +rxt(k,292)* y(k,198) & +rxt(k,293)* y(k,203) +rxt(k,365)* y(k,205) +rxt(k,370)* y(k,206) & +rxt(k,332)* y(k,209) +rxt(k,390)* y(k,225) + het_rates(k,197)) & * y(k,197) - prod(k,180) = (.100_r8*rxt(k,338)*y(k,105) +.280_r8*rxt(k,352)*y(k,111) + & + prod(k,207) = (.100_r8*rxt(k,338)*y(k,105) +.280_r8*rxt(k,352)*y(k,111) + & .080_r8*rxt(k,385)*y(k,98) +.060_r8*rxt(k,440)*y(k,6) + & .060_r8*rxt(k,443)*y(k,110))*y(k,134) + (rxt(k,342)*y(k,198) + & .450_r8*rxt(k,343)*y(k,203) +2.000_r8*rxt(k,344)*y(k,211) + & @@ -929,57 +956,57 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & *y(k,95) +1.340_r8*rxt(k,50)*y(k,105) +rxt(k,52)*y(k,107) +rxt(k,53) & *y(k,108) +.300_r8*rxt(k,55)*y(k,111) +rxt(k,57)*y(k,127) +rxt(k,63) & *y(k,147) +.500_r8*rxt(k,64)*y(k,173) +.650_r8*rxt(k,69)*y(k,178) - loss(k,189) = (rxt(k,181)* y(k,59) +rxt(k,380)* y(k,101) +rxt(k,261) & + loss(k,221) = (rxt(k,182)* y(k,59) +rxt(k,380)* y(k,101) +rxt(k,262) & * y(k,124) +rxt(k,281)* y(k,194) +rxt(k,309)* y(k,195) +rxt(k,292) & - * y(k,197) + 2._r8*(rxt(k,258) +rxt(k,259))* y(k,198) +rxt(k,260) & + * y(k,197) + 2._r8*(rxt(k,259) +rxt(k,260))* y(k,198) +rxt(k,261) & * y(k,203) +rxt(k,366)* y(k,205) +rxt(k,371)* y(k,206) +rxt(k,333) & * y(k,209) +rxt(k,342)* y(k,211) +rxt(k,445)* y(k,215) +rxt(k,321) & * y(k,220) +rxt(k,450)* y(k,221) +rxt(k,455)* y(k,222) +rxt(k,391) & * y(k,225) + het_rates(k,198))* y(k,198) - prod(k,189) = (2.000_r8*rxt(k,291)*y(k,197) +.900_r8*rxt(k,292)*y(k,198) + & + prod(k,221) = (2.000_r8*rxt(k,291)*y(k,197) +.900_r8*rxt(k,292)*y(k,198) + & .450_r8*rxt(k,293)*y(k,203) +rxt(k,294)*y(k,124) + & rxt(k,332)*y(k,209) +rxt(k,341)*y(k,211) +rxt(k,365)*y(k,205) + & rxt(k,370)*y(k,206) +rxt(k,379)*y(k,101) +rxt(k,390)*y(k,225)) & - *y(k,197) + (rxt(k,175)*y(k,56) +rxt(k,231)*y(k,73) + & - rxt(k,264)*y(k,217) +rxt(k,271)*y(k,216))*y(k,54) & + *y(k,197) + (rxt(k,40) +rxt(k,176)*y(k,56) +rxt(k,232)*y(k,73) + & + rxt(k,265)*y(k,217) +rxt(k,271)*y(k,216))*y(k,54) & + (.830_r8*rxt(k,411)*y(k,199) +.170_r8*rxt(k,417)*y(k,212)) & *y(k,124) + (.280_r8*rxt(k,308)*y(k,29) +.050_r8*rxt(k,385)*y(k,98)) & *y(k,134) + (.330_r8*rxt(k,410)*y(k,199) + & - .070_r8*rxt(k,416)*y(k,212))*y(k,203) + (.700_r8*rxt(k,263)*y(k,53) + & - rxt(k,295)*y(k,50))*y(k,217) +rxt(k,34)*y(k,45) +rxt(k,35)*y(k,48) & - +rxt(k,37)*y(k,51) +.300_r8*rxt(k,55)*y(k,111) +.400_r8*rxt(k,60) & - *y(k,139) - loss(k,136) = (rxt(k,411)* y(k,124) +rxt(k,412)* y(k,125) +rxt(k,410) & + .070_r8*rxt(k,416)*y(k,212))*y(k,203) + (.700_r8*rxt(k,264)*y(k,53) + & + rxt(k,295)*y(k,50))*y(k,217) +rxt(k,87)*y(k,43) +rxt(k,34)*y(k,45) & + +rxt(k,89)*y(k,46) +rxt(k,35)*y(k,48) +rxt(k,37)*y(k,51) & + +.300_r8*rxt(k,55)*y(k,111) +.400_r8*rxt(k,60)*y(k,139) + loss(k,163) = (rxt(k,411)* y(k,124) +rxt(k,412)* y(k,125) +rxt(k,410) & * y(k,203) + het_rates(k,199))* y(k,199) - prod(k,136) =.600_r8*rxt(k,25)*y(k,12) - loss(k,118) = ((rxt(k,329) +rxt(k,330))* y(k,124) + het_rates(k,200)) & + prod(k,163) =.600_r8*rxt(k,25)*y(k,12) + loss(k,142) = ((rxt(k,329) +rxt(k,330))* y(k,124) + het_rates(k,200)) & * y(k,200) - prod(k,118) =rxt(k,328)*y(k,217)*y(k,16) - loss(k,73) = ( + rxt(k,299) + rxt(k,300) + het_rates(k,201))* y(k,201) - prod(k,73) =rxt(k,42)*y(k,72) +.750_r8*rxt(k,298)*y(k,202)*y(k,124) - loss(k,132) = (rxt(k,298)* y(k,124) +rxt(k,297)* y(k,203) + het_rates(k,202)) & + prod(k,142) =rxt(k,328)*y(k,217)*y(k,16) + loss(k,94) = ( + rxt(k,299) + rxt(k,300) + het_rates(k,201))* y(k,201) + prod(k,94) =rxt(k,42)*y(k,72) +.750_r8*rxt(k,298)*y(k,202)*y(k,124) + loss(k,159) = (rxt(k,298)* y(k,124) +rxt(k,297)* y(k,203) + het_rates(k,202)) & * y(k,202) - prod(k,132) =rxt(k,304)*y(k,217)*y(k,25) - loss(k,192) = (rxt(k,211)* y(k,17) +rxt(k,217)* y(k,19) +rxt(k,254)* y(k,42) & - + (rxt(k,178) +rxt(k,179))* y(k,56) +rxt(k,185)* y(k,59) & - + (rxt(k,134) +rxt(k,135) +rxt(k,136))* y(k,76) +rxt(k,381) & - * y(k,101) +rxt(k,163)* y(k,124) +rxt(k,168)* y(k,125) +rxt(k,158) & - * y(k,126) +rxt(k,138)* y(k,133) +rxt(k,139)* y(k,134) +rxt(k,396) & + prod(k,159) =rxt(k,304)*y(k,217)*y(k,25) + loss(k,218) = (rxt(k,212)* y(k,17) +rxt(k,218)* y(k,19) +rxt(k,255)* y(k,42) & + + (rxt(k,179) +rxt(k,180))* y(k,56) +rxt(k,186)* y(k,59) & + + (rxt(k,135) +rxt(k,136) +rxt(k,137))* y(k,76) +rxt(k,381) & + * y(k,101) +rxt(k,164)* y(k,124) +rxt(k,169)* y(k,125) +rxt(k,159) & + * y(k,126) +rxt(k,139)* y(k,133) +rxt(k,140)* y(k,134) +rxt(k,396) & * y(k,188) +rxt(k,357)* y(k,189) +rxt(k,399)* y(k,191) +rxt(k,403) & * y(k,193) +rxt(k,282)* y(k,194) +rxt(k,310)* y(k,195) +rxt(k,406) & - * y(k,196) +rxt(k,293)* y(k,197) +rxt(k,260)* y(k,198) +rxt(k,410) & - * y(k,199) +rxt(k,297)* y(k,202) + 2._r8*rxt(k,148)* y(k,203) & + * y(k,196) +rxt(k,293)* y(k,197) +rxt(k,261)* y(k,198) +rxt(k,410) & + * y(k,199) +rxt(k,297)* y(k,202) + 2._r8*rxt(k,149)* y(k,203) & +rxt(k,268)* y(k,204) +rxt(k,367)* y(k,205) +rxt(k,372)* y(k,206) & +rxt(k,334)* y(k,209) +rxt(k,413)* y(k,210) +rxt(k,343)* y(k,211) & +rxt(k,416)* y(k,212) +rxt(k,347)* y(k,213) +rxt(k,446)* y(k,215) & - +rxt(k,143)* y(k,217) +rxt(k,419)* y(k,218) +rxt(k,318)* y(k,219) & + +rxt(k,144)* y(k,217) +rxt(k,419)* y(k,218) +rxt(k,318)* y(k,219) & +rxt(k,322)* y(k,220) +rxt(k,451)* y(k,221) +rxt(k,456)* y(k,222) & +rxt(k,426)* y(k,223) +rxt(k,392)* y(k,225) +rxt(k,432)* y(k,226) & +rxt(k,435)* y(k,228) + rxt(k,481) + het_rates(k,203))* y(k,203) - prod(k,192) = (rxt(k,240)*y(k,43) +rxt(k,243)*y(k,46) +rxt(k,142)*y(k,79) + & - rxt(k,145)*y(k,134) +rxt(k,161)*y(k,126) +rxt(k,192)*y(k,59) + & - rxt(k,222)*y(k,19) +rxt(k,262)*y(k,52) +rxt(k,265)*y(k,62) + & - rxt(k,266)*y(k,86) +rxt(k,267)*y(k,87) +.350_r8*rxt(k,277)*y(k,24) + & + prod(k,218) = (rxt(k,143)*y(k,79) +rxt(k,146)*y(k,134) +rxt(k,162)*y(k,126) + & + rxt(k,193)*y(k,59) +rxt(k,223)*y(k,19) +rxt(k,241)*y(k,43) + & + rxt(k,244)*y(k,46) +rxt(k,263)*y(k,52) +rxt(k,266)*y(k,86) + & + rxt(k,267)*y(k,87) +rxt(k,275)*y(k,62) +.350_r8*rxt(k,277)*y(k,24) + & rxt(k,284)*y(k,26) +rxt(k,290)*y(k,47) +rxt(k,301)*y(k,74) + & rxt(k,302)*y(k,75) +rxt(k,316)*y(k,95) +rxt(k,331)*y(k,93) + & .200_r8*rxt(k,340)*y(k,106) +.500_r8*rxt(k,351)*y(k,109) + & @@ -988,8 +1015,8 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & .650_r8*rxt(k,398)*y(k,7) +.730_r8*rxt(k,409)*y(k,66) + & .800_r8*rxt(k,421)*y(k,142) +.280_r8*rxt(k,429)*y(k,180) + & .380_r8*rxt(k,431)*y(k,182) +.630_r8*rxt(k,437)*y(k,184) + & - .200_r8*rxt(k,461)*y(k,178) +.500_r8*rxt(k,476)*y(k,67) + & - rxt(k,477)*y(k,151))*y(k,217) + (rxt(k,261)*y(k,198) + & + .200_r8*rxt(k,461)*y(k,178) +rxt(k,467)*y(k,151) + & + .500_r8*rxt(k,477)*y(k,67))*y(k,217) + (rxt(k,262)*y(k,198) + & rxt(k,270)*y(k,204) +rxt(k,283)*y(k,194) + & .250_r8*rxt(k,298)*y(k,202) +rxt(k,311)*y(k,195) + & rxt(k,319)*y(k,219) +rxt(k,329)*y(k,200) + & @@ -1000,8 +1027,8 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & .400_r8*rxt(k,414)*y(k,210) +.830_r8*rxt(k,417)*y(k,212) + & rxt(k,420)*y(k,218) +rxt(k,427)*y(k,223) +rxt(k,433)*y(k,226) + & rxt(k,436)*y(k,228) +.900_r8*rxt(k,452)*y(k,221) + & - .800_r8*rxt(k,457)*y(k,222))*y(k,124) + (rxt(k,181)*y(k,59) + & - 2.000_r8*rxt(k,258)*y(k,198) +rxt(k,281)*y(k,194) + & + .800_r8*rxt(k,457)*y(k,222))*y(k,124) + (rxt(k,182)*y(k,59) + & + 2.000_r8*rxt(k,259)*y(k,198) +rxt(k,281)*y(k,194) + & .900_r8*rxt(k,292)*y(k,197) +rxt(k,309)*y(k,195) + & .300_r8*rxt(k,321)*y(k,220) +.730_r8*rxt(k,333)*y(k,209) + & rxt(k,342)*y(k,211) +rxt(k,366)*y(k,205) +rxt(k,371)*y(k,206) + & @@ -1011,15 +1038,15 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & .280_r8*rxt(k,308)*y(k,29) +.140_r8*rxt(k,338)*y(k,105) + & .280_r8*rxt(k,352)*y(k,111) +.370_r8*rxt(k,385)*y(k,98) + & .570_r8*rxt(k,440)*y(k,6) +.570_r8*rxt(k,443)*y(k,110))*y(k,134) & - + (rxt(k,255)*y(k,42) +.470_r8*rxt(k,335)*y(k,209) + & + + (rxt(k,256)*y(k,42) +.470_r8*rxt(k,335)*y(k,209) + & rxt(k,369)*y(k,205) +rxt(k,375)*y(k,206) +rxt(k,383)*y(k,101) + & rxt(k,394)*y(k,225))*y(k,126) + (.470_r8*rxt(k,332)*y(k,209) + & rxt(k,365)*y(k,205) +rxt(k,370)*y(k,206) +rxt(k,379)*y(k,101) + & - rxt(k,390)*y(k,225))*y(k,197) + (rxt(k,239)*y(k,43) + & - rxt(k,242)*y(k,46) +rxt(k,174)*y(k,42) +rxt(k,177)*y(k,79))*y(k,56) & + rxt(k,390)*y(k,225))*y(k,197) + (rxt(k,175)*y(k,42) + & + rxt(k,178)*y(k,79) +rxt(k,240)*y(k,43) +rxt(k,243)*y(k,46))*y(k,56) & + (.070_r8*rxt(k,410)*y(k,199) +.160_r8*rxt(k,413)*y(k,210) + & - .330_r8*rxt(k,416)*y(k,212))*y(k,203) + (rxt(k,210)*y(k,17) + & - rxt(k,256)*y(k,133))*y(k,42) + (rxt(k,11) +rxt(k,172))*y(k,90) & + .330_r8*rxt(k,416)*y(k,212))*y(k,203) + (rxt(k,211)*y(k,17) + & + rxt(k,257)*y(k,133))*y(k,42) + (rxt(k,11) +rxt(k,173))*y(k,90) & + (1.340_r8*rxt(k,50) +.660_r8*rxt(k,51))*y(k,105) + (rxt(k,299) + & rxt(k,300))*y(k,201) +rxt(k,19)*y(k,1) +.900_r8*rxt(k,20)*y(k,2) & +rxt(k,21)*y(k,8) +1.500_r8*rxt(k,22)*y(k,9) +.560_r8*rxt(k,23) & @@ -1027,7 +1054,7 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & +.600_r8*rxt(k,26)*y(k,13) +rxt(k,27)*y(k,14) +rxt(k,28)*y(k,23) & +rxt(k,29)*y(k,27) +rxt(k,30)*y(k,30) +rxt(k,34)*y(k,45) +rxt(k,36) & *y(k,49) +rxt(k,272)*y(k,216)*y(k,54) +2.000_r8*rxt(k,43)*y(k,74) & - +2.000_r8*rxt(k,44)*y(k,75) +rxt(k,137)*y(k,76) +rxt(k,133)*y(k,133) & + +2.000_r8*rxt(k,44)*y(k,75) +rxt(k,138)*y(k,76) +rxt(k,134)*y(k,133) & *y(k,79) +.670_r8*rxt(k,45)*y(k,93) +rxt(k,46)*y(k,94) +rxt(k,47) & *y(k,95) +rxt(k,48)*y(k,102) +rxt(k,49)*y(k,103) +rxt(k,56)*y(k,116) & +rxt(k,61)*y(k,143) +rxt(k,62)*y(k,146) +rxt(k,64)*y(k,173) & @@ -1036,182 +1063,184 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & +rxt(k,72)*y(k,183) +rxt(k,73)*y(k,185) & +1.200_r8*rxt(k,280)*y(k,194)*y(k,194) +rxt(k,269)*y(k,204) & +rxt(k,373)*y(k,206) - loss(k,101) = (rxt(k,270)* y(k,124) +rxt(k,268)* y(k,203) + rxt(k,269) & + loss(k,124) = (rxt(k,270)* y(k,124) +rxt(k,268)* y(k,203) + rxt(k,269) & + het_rates(k,204))* y(k,204) - prod(k,101) =rxt(k,254)*y(k,203)*y(k,42) - loss(k,178) = (rxt(k,368)* y(k,124) +rxt(k,369)* y(k,126) +rxt(k,365) & + prod(k,124) =rxt(k,255)*y(k,203)*y(k,42) + loss(k,202) = (rxt(k,368)* y(k,124) +rxt(k,369)* y(k,126) +rxt(k,365) & * y(k,197) +rxt(k,366)* y(k,198) +rxt(k,367)* y(k,203) & + het_rates(k,205))* y(k,205) - prod(k,178) =.600_r8*rxt(k,386)*y(k,217)*y(k,98) - loss(k,175) = (rxt(k,374)* y(k,124) +rxt(k,375)* y(k,126) +rxt(k,370) & + prod(k,202) =.600_r8*rxt(k,386)*y(k,217)*y(k,98) + loss(k,203) = (rxt(k,374)* y(k,124) +rxt(k,375)* y(k,126) +rxt(k,370) & * y(k,197) +rxt(k,371)* y(k,198) +rxt(k,372)* y(k,203) + rxt(k,373) & + het_rates(k,206))* y(k,206) - prod(k,175) =.400_r8*rxt(k,386)*y(k,217)*y(k,98) - loss(k,37) = (rxt(k,504)* y(k,124) +rxt(k,503)* y(k,203) + het_rates(k,207)) & + prod(k,203) =.400_r8*rxt(k,386)*y(k,217)*y(k,98) + loss(k,46) = (rxt(k,504)* y(k,124) +rxt(k,503)* y(k,203) + het_rates(k,207)) & * y(k,207) - prod(k,37) =rxt(k,506)*y(k,217)*y(k,98) - loss(k,38) = (rxt(k,508)* y(k,124) +rxt(k,507)* y(k,203) + het_rates(k,208)) & + prod(k,46) =rxt(k,506)*y(k,217)*y(k,98) + loss(k,47) = (rxt(k,508)* y(k,124) +rxt(k,507)* y(k,203) + het_rates(k,208)) & * y(k,208) - prod(k,38) =rxt(k,509)*y(k,217)*y(k,104) - loss(k,177) = ((rxt(k,336) +rxt(k,337))* y(k,124) +rxt(k,335)* y(k,126) & + prod(k,47) =rxt(k,509)*y(k,217)*y(k,104) + loss(k,204) = ((rxt(k,336) +rxt(k,337))* y(k,124) +rxt(k,335)* y(k,126) & +rxt(k,332)* y(k,197) +rxt(k,333)* y(k,198) +rxt(k,334)* y(k,203) & + het_rates(k,209))* y(k,209) - prod(k,177) = (.500_r8*rxt(k,339)*y(k,105) +.200_r8*rxt(k,340)*y(k,106) + & + prod(k,204) = (.500_r8*rxt(k,339)*y(k,105) +.200_r8*rxt(k,340)*y(k,106) + & rxt(k,353)*y(k,111))*y(k,217) - loss(k,133) = (rxt(k,414)* y(k,124) +rxt(k,415)* y(k,125) +rxt(k,413) & + loss(k,160) = (rxt(k,414)* y(k,124) +rxt(k,415)* y(k,125) +rxt(k,413) & * y(k,203) + het_rates(k,210))* y(k,210) - prod(k,133) =.600_r8*rxt(k,24)*y(k,11) - loss(k,179) = (rxt(k,345)* y(k,124) +rxt(k,354)* y(k,125) +rxt(k,346) & + prod(k,160) =.600_r8*rxt(k,24)*y(k,11) + loss(k,206) = (rxt(k,345)* y(k,124) +rxt(k,354)* y(k,125) +rxt(k,346) & * y(k,126) +rxt(k,341)* y(k,197) +rxt(k,342)* y(k,198) +rxt(k,343) & * y(k,203) + 2._r8*rxt(k,344)* y(k,211) + het_rates(k,211))* y(k,211) - prod(k,179) = (.660_r8*rxt(k,50) +.500_r8*rxt(k,339)*y(k,217))*y(k,105) & + prod(k,206) = (.660_r8*rxt(k,50) +.500_r8*rxt(k,339)*y(k,217))*y(k,105) & + (rxt(k,54) +rxt(k,355))*y(k,109) +.500_r8*rxt(k,340)*y(k,217) & *y(k,106) - loss(k,150) = (rxt(k,417)* y(k,124) +rxt(k,418)* y(k,125) +rxt(k,416) & + loss(k,176) = (rxt(k,417)* y(k,124) +rxt(k,418)* y(k,125) +rxt(k,416) & * y(k,203) + het_rates(k,212))* y(k,212) - prod(k,150) =.600_r8*rxt(k,26)*y(k,13) - loss(k,129) = (rxt(k,348)* y(k,124) +rxt(k,347)* y(k,203) + het_rates(k,213)) & + prod(k,176) =.600_r8*rxt(k,26)*y(k,13) + loss(k,155) = (rxt(k,348)* y(k,124) +rxt(k,347)* y(k,203) + het_rates(k,213)) & * y(k,213) - prod(k,129) = (rxt(k,349)*y(k,107) +rxt(k,350)*y(k,108))*y(k,217) - loss(k,40) = (rxt(k,512)* y(k,124) +rxt(k,511)* y(k,203) + het_rates(k,214)) & + prod(k,155) = (rxt(k,349)*y(k,107) +rxt(k,350)*y(k,108))*y(k,217) + loss(k,49) = (rxt(k,512)* y(k,124) +rxt(k,511)* y(k,203) + het_rates(k,214)) & * y(k,214) - prod(k,40) =rxt(k,514)*y(k,217)*y(k,110) - loss(k,166) = (rxt(k,447)* y(k,124) +rxt(k,448)* y(k,126) +rxt(k,445) & + prod(k,49) =rxt(k,514)*y(k,217)*y(k,110) + loss(k,187) = (rxt(k,447)* y(k,124) +rxt(k,448)* y(k,126) +rxt(k,445) & * y(k,198) +rxt(k,446)* y(k,203) + het_rates(k,215))* y(k,215) - prod(k,166) = (rxt(k,439)*y(k,6) +rxt(k,442)*y(k,110) + & + prod(k,187) = (rxt(k,439)*y(k,6) +rxt(k,442)*y(k,110) + & .500_r8*rxt(k,459)*y(k,177))*y(k,126) +rxt(k,449)*y(k,217)*y(k,128) - loss(k,185) = (rxt(k,199)* y(k,33) +rxt(k,200)* y(k,34) +rxt(k,226)* y(k,35) & - +rxt(k,201)* y(k,36) +rxt(k,202)* y(k,37) +rxt(k,203)* y(k,38) & - +rxt(k,204)* y(k,39) +rxt(k,205)* y(k,40) +rxt(k,249)* y(k,41) & - +rxt(k,250)* y(k,43) + (rxt(k,271) +rxt(k,272) +rxt(k,273))* y(k,54) & - +rxt(k,227)* y(k,55) +rxt(k,235)* y(k,64) +rxt(k,236)* y(k,65) & - +rxt(k,124)* y(k,77) +rxt(k,228)* y(k,78) + (rxt(k,229) +rxt(k,230)) & - * y(k,81) +rxt(k,251)* y(k,82) +rxt(k,252)* y(k,83) +rxt(k,253) & - * y(k,84) + (rxt(k,206) +rxt(k,207))* y(k,85) +rxt(k,274)* y(k,86) & - + (rxt(k,166) +rxt(k,167))* y(k,113) +rxt(k,128)* y(k,134) & - +rxt(k,125)* y(k,229) + rxt(k,126) + rxt(k,127) + het_rates(k,216)) & + loss(k,214) = (rxt(k,200)* y(k,33) +rxt(k,201)* y(k,34) +rxt(k,227)* y(k,35) & + +rxt(k,202)* y(k,36) +rxt(k,203)* y(k,37) +rxt(k,204)* y(k,38) & + +rxt(k,205)* y(k,39) +rxt(k,206)* y(k,40) +rxt(k,250)* y(k,41) & + +rxt(k,251)* y(k,43) + (rxt(k,271) +rxt(k,272) +rxt(k,273))* y(k,54) & + +rxt(k,228)* y(k,55) +rxt(k,236)* y(k,64) +rxt(k,237)* y(k,65) & + +rxt(k,125)* y(k,77) +rxt(k,229)* y(k,78) + (rxt(k,230) +rxt(k,231)) & + * y(k,81) +rxt(k,252)* y(k,82) +rxt(k,253)* y(k,83) +rxt(k,254) & + * y(k,84) + (rxt(k,207) +rxt(k,208))* y(k,85) +rxt(k,274)* y(k,86) & + + (rxt(k,167) +rxt(k,168))* y(k,113) +rxt(k,129)* y(k,134) & + +rxt(k,126)* y(k,229) + rxt(k,127) + rxt(k,128) + het_rates(k,216)) & * y(k,216) - prod(k,185) =rxt(k,7)*y(k,134) +rxt(k,1)*y(k,229) - loss(k,186) = (rxt(k,356)* y(k,1) +rxt(k,360)* y(k,2) +rxt(k,441)* y(k,6) & + prod(k,214) =rxt(k,12)*y(k,113) +rxt(k,7)*y(k,134) +rxt(k,1)*y(k,229) + loss(k,215) = (rxt(k,356)* y(k,1) +rxt(k,360)* y(k,2) +rxt(k,441)* y(k,6) & +rxt(k,398)* y(k,7) +rxt(k,401)* y(k,8) +rxt(k,361)* y(k,15) & - +rxt(k,328)* y(k,16) +rxt(k,222)* y(k,19) +rxt(k,402)* y(k,22) & + +rxt(k,328)* y(k,16) +rxt(k,223)* y(k,19) +rxt(k,402)* y(k,22) & +rxt(k,404)* y(k,23) +rxt(k,277)* y(k,24) +rxt(k,304)* y(k,25) & +rxt(k,284)* y(k,26) +rxt(k,285)* y(k,27) +rxt(k,287)* y(k,28) & +rxt(k,325)* y(k,29) +rxt(k,312)* y(k,30) +rxt(k,313)* y(k,31) & - +rxt(k,408)* y(k,32) +rxt(k,238)* y(k,41) +rxt(k,257)* y(k,42) & - +rxt(k,240)* y(k,43) +rxt(k,241)* y(k,44) +rxt(k,289)* y(k,45) & - +rxt(k,243)* y(k,46) +rxt(k,290)* y(k,47) +rxt(k,326)* y(k,48) & + +rxt(k,408)* y(k,32) +rxt(k,239)* y(k,41) +rxt(k,258)* y(k,42) & + +rxt(k,241)* y(k,43) +rxt(k,242)* y(k,44) +rxt(k,289)* y(k,45) & + +rxt(k,244)* y(k,46) +rxt(k,290)* y(k,47) +rxt(k,326)* y(k,48) & +rxt(k,315)* y(k,49) +rxt(k,295)* y(k,50) +rxt(k,296)* y(k,51) & - +rxt(k,262)* y(k,52) +rxt(k,263)* y(k,53) +rxt(k,264)* y(k,54) & - +rxt(k,245)* y(k,55) + (rxt(k,192) +rxt(k,193))* y(k,59) +rxt(k,190) & - * y(k,60) + (rxt(k,265) +rxt(k,275))* y(k,62) +rxt(k,409)* y(k,66) & - + (rxt(k,463) +rxt(k,476))* y(k,67) +rxt(k,301)* y(k,74) +rxt(k,302) & - * y(k,75) +rxt(k,141)* y(k,77) +rxt(k,142)* y(k,79) +rxt(k,224) & - * y(k,81) +rxt(k,246)* y(k,82) +rxt(k,247)* y(k,83) +rxt(k,248) & - * y(k,84) +rxt(k,195)* y(k,85) +rxt(k,266)* y(k,86) +rxt(k,267) & - * y(k,87) +rxt(k,171)* y(k,89) +rxt(k,149)* y(k,90) +rxt(k,198) & - * y(k,92) +rxt(k,331)* y(k,93) +rxt(k,362)* y(k,94) +rxt(k,316) & - * y(k,95) +rxt(k,363)* y(k,96) +rxt(k,364)* y(k,97) +rxt(k,386) & - * y(k,98) +rxt(k,376)* y(k,99) +rxt(k,377)* y(k,100) +rxt(k,384) & - * y(k,102) +rxt(k,387)* y(k,103) +rxt(k,339)* y(k,105) +rxt(k,340) & - * y(k,106) +rxt(k,349)* y(k,107) +rxt(k,350)* y(k,108) +rxt(k,351) & - * y(k,109) +rxt(k,444)* y(k,110) +rxt(k,353)* y(k,111) +rxt(k,162) & - * y(k,112) +rxt(k,388)* y(k,115) +rxt(k,389)* y(k,116) +rxt(k,479) & - * y(k,120) +rxt(k,170)* y(k,125) +rxt(k,161)* y(k,126) +rxt(k,317) & - * y(k,127) +rxt(k,449)* y(k,128) +rxt(k,144)* y(k,133) +rxt(k,145) & - * y(k,134) +rxt(k,465)* y(k,137) +rxt(k,303)* y(k,139) +rxt(k,421) & - * y(k,142) +rxt(k,424)* y(k,143) +rxt(k,320)* y(k,146) +rxt(k,324) & - * y(k,147) +rxt(k,470)* y(k,148) +rxt(k,475)* y(k,150) +rxt(k,477) & - * y(k,151) +rxt(k,453)* y(k,174) +rxt(k,454)* y(k,175) +rxt(k,458) & - * y(k,176) +rxt(k,460)* y(k,177) +rxt(k,461)* y(k,178) +rxt(k,428) & - * y(k,179) +rxt(k,429)* y(k,180) +rxt(k,395)* y(k,181) +rxt(k,431) & - * y(k,182) +rxt(k,434)* y(k,183) +rxt(k,437)* y(k,184) +rxt(k,438) & - * y(k,185) +rxt(k,143)* y(k,203) + 2._r8*(rxt(k,146) +rxt(k,147)) & - * y(k,217) + het_rates(k,217))* y(k,217) - prod(k,186) = (2.000_r8*rxt(k,135)*y(k,76) +rxt(k,138)*y(k,133) + & - rxt(k,139)*y(k,134) +rxt(k,158)*y(k,126) +rxt(k,163)*y(k,124) + & - rxt(k,179)*y(k,56) +.450_r8*rxt(k,293)*y(k,197) + & + +rxt(k,263)* y(k,52) +rxt(k,264)* y(k,53) +rxt(k,265)* y(k,54) & + +rxt(k,246)* y(k,55) + (rxt(k,193) +rxt(k,194))* y(k,59) +rxt(k,191) & + * y(k,60) +rxt(k,275)* y(k,62) +rxt(k,409)* y(k,66) + (rxt(k,463) + & + rxt(k,477))* y(k,67) +rxt(k,301)* y(k,74) +rxt(k,302)* y(k,75) & + +rxt(k,142)* y(k,77) +rxt(k,143)* y(k,79) +rxt(k,225)* y(k,81) & + +rxt(k,247)* y(k,82) +rxt(k,248)* y(k,83) +rxt(k,249)* y(k,84) & + +rxt(k,196)* y(k,85) +rxt(k,266)* y(k,86) +rxt(k,267)* y(k,87) & + +rxt(k,172)* y(k,89) +rxt(k,150)* y(k,90) +rxt(k,199)* y(k,92) & + +rxt(k,331)* y(k,93) +rxt(k,362)* y(k,94) +rxt(k,316)* y(k,95) & + +rxt(k,363)* y(k,96) +rxt(k,364)* y(k,97) +rxt(k,386)* y(k,98) & + +rxt(k,376)* y(k,99) +rxt(k,377)* y(k,100) +rxt(k,384)* y(k,102) & + +rxt(k,387)* y(k,103) +rxt(k,339)* y(k,105) +rxt(k,340)* y(k,106) & + +rxt(k,349)* y(k,107) +rxt(k,350)* y(k,108) +rxt(k,351)* y(k,109) & + +rxt(k,444)* y(k,110) +rxt(k,353)* y(k,111) +rxt(k,163)* y(k,112) & + +rxt(k,388)* y(k,115) +rxt(k,389)* y(k,116) +rxt(k,479)* y(k,120) & + +rxt(k,171)* y(k,125) +rxt(k,162)* y(k,126) +rxt(k,317)* y(k,127) & + +rxt(k,449)* y(k,128) +rxt(k,145)* y(k,133) +rxt(k,146)* y(k,134) & + +rxt(k,465)* y(k,137) +rxt(k,303)* y(k,139) +rxt(k,421)* y(k,142) & + +rxt(k,424)* y(k,143) +rxt(k,320)* y(k,146) +rxt(k,324)* y(k,147) & + +rxt(k,471)* y(k,148) +rxt(k,476)* y(k,150) +rxt(k,467)* y(k,151) & + +rxt(k,453)* y(k,174) +rxt(k,454)* y(k,175) +rxt(k,458)* y(k,176) & + +rxt(k,460)* y(k,177) +rxt(k,461)* y(k,178) +rxt(k,428)* y(k,179) & + +rxt(k,429)* y(k,180) +rxt(k,395)* y(k,181) +rxt(k,431)* y(k,182) & + +rxt(k,434)* y(k,183) +rxt(k,437)* y(k,184) +rxt(k,438)* y(k,185) & + +rxt(k,144)* y(k,203) + 2._r8*(rxt(k,147) +rxt(k,148))* y(k,217) & + + het_rates(k,217))* y(k,217) + prod(k,215) = (2.000_r8*rxt(k,136)*y(k,76) +rxt(k,139)*y(k,133) + & + rxt(k,140)*y(k,134) +rxt(k,159)*y(k,126) +rxt(k,164)*y(k,124) + & + rxt(k,180)*y(k,56) +.450_r8*rxt(k,293)*y(k,197) + & .150_r8*rxt(k,322)*y(k,220) +.450_r8*rxt(k,343)*y(k,211) + & .200_r8*rxt(k,347)*y(k,213) +.400_r8*rxt(k,396)*y(k,188) + & .400_r8*rxt(k,410)*y(k,199) +.400_r8*rxt(k,416)*y(k,212))*y(k,203) & - + (rxt(k,140)*y(k,76) +.130_r8*rxt(k,279)*y(k,25) + & + + (rxt(k,141)*y(k,76) +.130_r8*rxt(k,279)*y(k,25) + & .360_r8*rxt(k,308)*y(k,29) +.240_r8*rxt(k,338)*y(k,105) + & .360_r8*rxt(k,352)*y(k,111) +.320_r8*rxt(k,385)*y(k,98) + & .630_r8*rxt(k,440)*y(k,6) +.630_r8*rxt(k,443)*y(k,110))*y(k,134) & - + (rxt(k,132)*y(k,77) +rxt(k,133)*y(k,79) +rxt(k,194)*y(k,85) + & - rxt(k,197)*y(k,92) +rxt(k,223)*y(k,81) +rxt(k,225)*y(k,91) + & - rxt(k,256)*y(k,42))*y(k,133) + (.300_r8*rxt(k,263)*y(k,53) + & + + (rxt(k,133)*y(k,77) +rxt(k,134)*y(k,79) +rxt(k,195)*y(k,85) + & + rxt(k,198)*y(k,92) +rxt(k,224)*y(k,81) +rxt(k,226)*y(k,91) + & + rxt(k,257)*y(k,42))*y(k,133) + (.300_r8*rxt(k,264)*y(k,53) + & .650_r8*rxt(k,277)*y(k,24) +.500_r8*rxt(k,285)*y(k,27) + & .500_r8*rxt(k,320)*y(k,146) +.100_r8*rxt(k,340)*y(k,106) + & .600_r8*rxt(k,387)*y(k,103) +.500_r8*rxt(k,395)*y(k,181))*y(k,217) & - + (rxt(k,271)*y(k,54) +rxt(k,124)*y(k,77) + & - 2.000_r8*rxt(k,125)*y(k,229) +rxt(k,206)*y(k,85) + & - rxt(k,229)*y(k,81) +rxt(k,274)*y(k,86))*y(k,216) + (rxt(k,2) + & - rxt(k,233)*y(k,73))*y(k,229) +rxt(k,20)*y(k,2) +rxt(k,21)*y(k,8) & - +rxt(k,28)*y(k,23) +rxt(k,29)*y(k,27) +rxt(k,30)*y(k,30) +rxt(k,31) & - *y(k,32) +rxt(k,37)*y(k,51) +rxt(k,38)*y(k,53) +rxt(k,42)*y(k,72) & - +2.000_r8*rxt(k,4)*y(k,79) +rxt(k,9)*y(k,89) +rxt(k,10)*y(k,90) & - +rxt(k,105)*y(k,91) +rxt(k,106)*y(k,92) +rxt(k,46)*y(k,94) & - +rxt(k,53)*y(k,108) +.500_r8*rxt(k,489)*y(k,125) +rxt(k,58)*y(k,128) & - +rxt(k,61)*y(k,143) +rxt(k,62)*y(k,146) +rxt(k,63)*y(k,147) & - +rxt(k,65)*y(k,174) +rxt(k,67)*y(k,176) +rxt(k,70)*y(k,179) & - +rxt(k,71)*y(k,181) +rxt(k,72)*y(k,183) +rxt(k,73)*y(k,185) - loss(k,102) = (rxt(k,420)* y(k,124) +rxt(k,419)* y(k,203) + het_rates(k,218)) & + + (rxt(k,125)*y(k,77) +2.000_r8*rxt(k,126)*y(k,229) + & + rxt(k,207)*y(k,85) +rxt(k,230)*y(k,81) +rxt(k,271)*y(k,54) + & + rxt(k,274)*y(k,86))*y(k,216) + (rxt(k,2) +rxt(k,234)*y(k,73)) & + *y(k,229) +rxt(k,20)*y(k,2) +rxt(k,21)*y(k,8) +rxt(k,28)*y(k,23) & + +rxt(k,29)*y(k,27) +rxt(k,30)*y(k,30) +rxt(k,31)*y(k,32) +rxt(k,37) & + *y(k,51) +rxt(k,38)*y(k,53) +.330_r8*rxt(k,39)*y(k,54) +rxt(k,42) & + *y(k,72) +2.000_r8*rxt(k,4)*y(k,79) +rxt(k,9)*y(k,89) +rxt(k,10) & + *y(k,90) +rxt(k,105)*y(k,91) +rxt(k,106)*y(k,92) +rxt(k,46)*y(k,94) & + +rxt(k,49)*y(k,103) +rxt(k,53)*y(k,108) +.500_r8*rxt(k,489)*y(k,125) & + +rxt(k,58)*y(k,128) +rxt(k,61)*y(k,143) +rxt(k,62)*y(k,146) & + +rxt(k,63)*y(k,147) +rxt(k,65)*y(k,174) +rxt(k,67)*y(k,176) & + +rxt(k,70)*y(k,179) +rxt(k,71)*y(k,181) +rxt(k,72)*y(k,183) & + +rxt(k,73)*y(k,185) + loss(k,126) = (rxt(k,420)* y(k,124) +rxt(k,419)* y(k,203) + het_rates(k,218)) & * y(k,218) - prod(k,102) = (.200_r8*rxt(k,409)*y(k,66) +.140_r8*rxt(k,421)*y(k,142) + & + prod(k,126) = (.200_r8*rxt(k,409)*y(k,66) +.140_r8*rxt(k,421)*y(k,142) + & rxt(k,424)*y(k,143))*y(k,217) - loss(k,137) = (rxt(k,319)* y(k,124) +rxt(k,318)* y(k,203) + het_rates(k,219)) & + loss(k,164) = (rxt(k,319)* y(k,124) +rxt(k,318)* y(k,203) + het_rates(k,219)) & * y(k,219) - prod(k,137) = (.500_r8*rxt(k,320)*y(k,146) +rxt(k,325)*y(k,29))*y(k,217) - loss(k,167) = (rxt(k,323)* y(k,124) +rxt(k,321)* y(k,198) +rxt(k,322) & + prod(k,164) = (.500_r8*rxt(k,320)*y(k,146) +rxt(k,325)*y(k,29))*y(k,217) + loss(k,194) = (rxt(k,323)* y(k,124) +rxt(k,321)* y(k,198) +rxt(k,322) & * y(k,203) + het_rates(k,220))* y(k,220) - prod(k,167) = (rxt(k,324)*y(k,147) +rxt(k,326)*y(k,48) + & + prod(k,194) = (rxt(k,324)*y(k,147) +rxt(k,326)*y(k,48) + & .150_r8*rxt(k,461)*y(k,178))*y(k,217) + (.060_r8*rxt(k,440)*y(k,6) + & .060_r8*rxt(k,443)*y(k,110))*y(k,134) +.150_r8*rxt(k,69)*y(k,178) - loss(k,165) = (rxt(k,452)* y(k,124) +rxt(k,450)* y(k,198) +rxt(k,451) & + loss(k,193) = (rxt(k,452)* y(k,124) +rxt(k,450)* y(k,198) +rxt(k,451) & * y(k,203) + het_rates(k,221))* y(k,221) - prod(k,165) = (.500_r8*rxt(k,459)*y(k,126) +rxt(k,460)*y(k,217))*y(k,177) & + prod(k,193) = (.500_r8*rxt(k,459)*y(k,126) +rxt(k,460)*y(k,217))*y(k,177) & +rxt(k,453)*y(k,217)*y(k,174) - loss(k,164) = (rxt(k,457)* y(k,124) +rxt(k,455)* y(k,198) +rxt(k,456) & + loss(k,179) = (rxt(k,457)* y(k,124) +rxt(k,455)* y(k,198) +rxt(k,456) & * y(k,203) + het_rates(k,222))* y(k,222) - prod(k,164) = (rxt(k,441)*y(k,6) +rxt(k,444)*y(k,110) +rxt(k,458)*y(k,176)) & + prod(k,179) = (rxt(k,441)*y(k,6) +rxt(k,444)*y(k,110) +rxt(k,458)*y(k,176)) & *y(k,217) - loss(k,134) = (rxt(k,427)* y(k,124) +rxt(k,426)* y(k,203) + het_rates(k,223)) & + loss(k,161) = (rxt(k,427)* y(k,124) +rxt(k,426)* y(k,203) + het_rates(k,223)) & * y(k,223) - prod(k,134) = (rxt(k,428)*y(k,179) +.650_r8*rxt(k,429)*y(k,180))*y(k,217) - loss(k,41) = (rxt(k,518)* y(k,124) +rxt(k,517)* y(k,203) + het_rates(k,224)) & + prod(k,161) = (rxt(k,428)*y(k,179) +.650_r8*rxt(k,429)*y(k,180))*y(k,217) + loss(k,50) = (rxt(k,518)* y(k,124) +rxt(k,517)* y(k,203) + het_rates(k,224)) & * y(k,224) - prod(k,41) =rxt(k,516)*y(k,217)*y(k,180) - loss(k,170) = (rxt(k,393)* y(k,124) +rxt(k,394)* y(k,126) +rxt(k,390) & + prod(k,50) =rxt(k,516)*y(k,217)*y(k,180) + loss(k,197) = (rxt(k,393)* y(k,124) +rxt(k,394)* y(k,126) +rxt(k,390) & * y(k,197) +rxt(k,391)* y(k,198) +rxt(k,392)* y(k,203) & + het_rates(k,225))* y(k,225) - prod(k,170) = (rxt(k,362)*y(k,94) +rxt(k,363)*y(k,96) +rxt(k,364)*y(k,97) + & + prod(k,197) = (rxt(k,362)*y(k,94) +rxt(k,363)*y(k,96) +rxt(k,364)*y(k,97) + & .400_r8*rxt(k,387)*y(k,103) +.500_r8*rxt(k,395)*y(k,181))*y(k,217) - loss(k,135) = (rxt(k,433)* y(k,124) +rxt(k,432)* y(k,203) + het_rates(k,226)) & + loss(k,162) = (rxt(k,433)* y(k,124) +rxt(k,432)* y(k,203) + het_rates(k,226)) & * y(k,226) - prod(k,135) = (.560_r8*rxt(k,431)*y(k,182) +rxt(k,434)*y(k,183))*y(k,217) - loss(k,42) = (rxt(k,521)* y(k,124) +rxt(k,520)* y(k,203) + het_rates(k,227)) & + prod(k,162) = (.560_r8*rxt(k,431)*y(k,182) +rxt(k,434)*y(k,183))*y(k,217) + loss(k,51) = (rxt(k,521)* y(k,124) +rxt(k,520)* y(k,203) + het_rates(k,227)) & * y(k,227) - prod(k,42) =rxt(k,519)*y(k,217)*y(k,182) - loss(k,108) = (rxt(k,436)* y(k,124) +rxt(k,435)* y(k,203) + het_rates(k,228)) & + prod(k,51) =rxt(k,519)*y(k,217)*y(k,182) + loss(k,133) = (rxt(k,436)* y(k,124) +rxt(k,435)* y(k,203) + het_rates(k,228)) & * y(k,228) - prod(k,108) = (.300_r8*rxt(k,437)*y(k,184) +rxt(k,438)*y(k,185))*y(k,217) - loss(k,198) = (rxt(k,233)* y(k,73) +rxt(k,478)* y(k,152) +rxt(k,125) & + prod(k,133) = (.300_r8*rxt(k,437)*y(k,184) +rxt(k,438)*y(k,185))*y(k,217) + loss(k,227) = (rxt(k,234)* y(k,73) +rxt(k,478)* y(k,152) +rxt(k,126) & * y(k,216) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,229)) & * y(k,229) - prod(k,198) = (rxt(k,238)*y(k,41) +rxt(k,240)*y(k,43) +rxt(k,241)*y(k,44) + & - rxt(k,243)*y(k,46) +rxt(k,248)*y(k,84) +rxt(k,264)*y(k,54) + & - rxt(k,141)*y(k,77) +rxt(k,142)*y(k,79) +rxt(k,143)*y(k,203) + & - rxt(k,146)*y(k,217) +rxt(k,149)*y(k,90) +rxt(k,171)*y(k,89) + & - rxt(k,195)*y(k,85) +rxt(k,198)*y(k,92) +rxt(k,224)*y(k,81) + & - rxt(k,257)*y(k,42) +rxt(k,263)*y(k,53) +rxt(k,267)*y(k,87) + & + prod(k,227) = (rxt(k,142)*y(k,77) +rxt(k,143)*y(k,79) +rxt(k,144)*y(k,203) + & + rxt(k,147)*y(k,217) +rxt(k,150)*y(k,90) +rxt(k,172)*y(k,89) + & + rxt(k,196)*y(k,85) +rxt(k,199)*y(k,92) +rxt(k,225)*y(k,81) + & + rxt(k,239)*y(k,41) +rxt(k,241)*y(k,43) +rxt(k,242)*y(k,44) + & + rxt(k,244)*y(k,46) +rxt(k,249)*y(k,84) +rxt(k,258)*y(k,42) + & + rxt(k,264)*y(k,53) +rxt(k,265)*y(k,54) +rxt(k,267)*y(k,87) + & rxt(k,287)*y(k,28) +rxt(k,289)*y(k,45) +rxt(k,295)*y(k,50) + & rxt(k,296)*y(k,51) +rxt(k,312)*y(k,30) +rxt(k,313)*y(k,31) + & rxt(k,315)*y(k,49) +rxt(k,320)*y(k,146) +rxt(k,324)*y(k,147) + & rxt(k,326)*y(k,48) +.500_r8*rxt(k,339)*y(k,105) +rxt(k,479)*y(k,120)) & *y(k,217) + (rxt(k,523)*y(k,92) +rxt(k,529)*y(k,92) + & rxt(k,530)*y(k,91) +rxt(k,534)*y(k,92) +rxt(k,535)*y(k,91))*y(k,85) & - +rxt(k,136)*y(k,203)*y(k,76) +rxt(k,109)*y(k,80) + + (rxt(k,481) +rxt(k,137)*y(k,76))*y(k,203) +.050_r8*rxt(k,39) & + *y(k,54) +rxt(k,109)*y(k,80) end do end subroutine imp_prod_loss end module mo_prod_loss diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 index 439c405555..07df66bf98 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_rxt_rates_conv.F90 @@ -131,148 +131,148 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 163) ! rate_const*soa4_a2 rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 164) ! rate_const*soa5_a1 rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 165) ! rate_const*soa5_a2 - rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 216)*sol(:ncol,:, 77) ! rate_const*O1D*H2 - rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 216)*sol(:ncol,:, 229) ! rate_const*O1D*H2O - rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 216) ! rate_const*N2*O1D - rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 216) ! rate_const*O2*O1D - rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 216)*sol(:ncol,:, 134) ! rate_const*O1D*O3 - rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 133)*sol(:ncol,:, 134) ! rate_const*O*O3 - rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 133)*sol(:ncol,:, 133) ! rate_const*M*O*O - rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 133) ! rate_const*O2*M*O - rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 77)*sol(:ncol,:, 133) ! rate_const*H2*O - rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 79)*sol(:ncol,:, 133) ! rate_const*H2O2*O - rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 76)*sol(:ncol,:, 203) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 71) ! rate_const*E90 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 216)*sol(:ncol,:, 77) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 216)*sol(:ncol,:, 229) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 216) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 216) ! rate_const*O2*O1D + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 216)*sol(:ncol,:, 134) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 133)*sol(:ncol,:, 134) ! rate_const*O*O3 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 133)*sol(:ncol,:, 133) ! rate_const*M*O*O + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 133) ! rate_const*O2*M*O + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 77)*sol(:ncol,:, 133) ! rate_const*H2*O + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 79)*sol(:ncol,:, 133) ! rate_const*H2O2*O rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 76)*sol(:ncol,:, 203) ! rate_const*H*HO2 rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 76)*sol(:ncol,:, 203) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 76) ! rate_const*O2*M*H - rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 203)*sol(:ncol,:, 133) ! rate_const*HO2*O - rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 203)*sol(:ncol,:, 134) ! rate_const*HO2*O3 - rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 76)*sol(:ncol,:, 134) ! rate_const*H*O3 - rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 217)*sol(:ncol,:, 77) ! rate_const*OH*H2 - rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 217)*sol(:ncol,:, 79) ! rate_const*OH*H2O2 - rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 217)*sol(:ncol,:, 203) ! rate_const*OH*HO2 - rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 217)*sol(:ncol,:, 133) ! rate_const*OH*O - rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 217)*sol(:ncol,:, 134) ! rate_const*OH*O3 - rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 217)*sol(:ncol,:, 217) ! rate_const*OH*OH - rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 217)*sol(:ncol,:, 217) ! rate_const*M*OH*OH - rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 203)*sol(:ncol,:, 203) ! rate_const*HO2*HO2 - rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 90)*sol(:ncol,:, 217) ! rate_const*HO2NO2*OH - rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 112)*sol(:ncol,:, 124) ! rate_const*N*NO - rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 76)*sol(:ncol,:, 203) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 76) ! rate_const*O2*M*H + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 203)*sol(:ncol,:, 133) ! rate_const*HO2*O + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 203)*sol(:ncol,:, 134) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 76)*sol(:ncol,:, 134) ! rate_const*H*O3 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 217)*sol(:ncol,:, 77) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 217)*sol(:ncol,:, 79) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 217)*sol(:ncol,:, 203) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 217)*sol(:ncol,:, 133) ! rate_const*OH*O + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 217)*sol(:ncol,:, 134) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 217)*sol(:ncol,:, 217) ! rate_const*OH*OH + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 217)*sol(:ncol,:, 217) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 203)*sol(:ncol,:, 203) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 90)*sol(:ncol,:, 217) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 112)*sol(:ncol,:, 124) ! rate_const*N*NO rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 112) ! rate_const*O2*N - rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 125)*sol(:ncol,:, 133) ! rate_const*NO2*O - rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 125)*sol(:ncol,:, 134) ! rate_const*NO2*O3 - rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 125)*sol(:ncol,:, 133) ! rate_const*M*NO2*O - rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 126)*sol(:ncol,:, 203) ! rate_const*NO3*HO2 - rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 126)*sol(:ncol,:, 124) ! rate_const*NO3*NO - rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 126)*sol(:ncol,:, 133) ! rate_const*NO3*O - rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 126)*sol(:ncol,:, 217) ! rate_const*NO3*OH - rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 112)*sol(:ncol,:, 217) ! rate_const*N*OH - rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 124)*sol(:ncol,:, 203) ! rate_const*NO*HO2 - rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 124)*sol(:ncol,:, 134) ! rate_const*NO*O3 - rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 124)*sol(:ncol,:, 133) ! rate_const*M*NO*O - rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 216)*sol(:ncol,:, 113) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 112) ! rate_const*O2*N + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 125)*sol(:ncol,:, 133) ! rate_const*NO2*O + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 125)*sol(:ncol,:, 134) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 125)*sol(:ncol,:, 133) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 126)*sol(:ncol,:, 203) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 126)*sol(:ncol,:, 124) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 126)*sol(:ncol,:, 133) ! rate_const*NO3*O + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 126)*sol(:ncol,:, 217) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 112)*sol(:ncol,:, 217) ! rate_const*N*OH + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 124)*sol(:ncol,:, 203) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 124)*sol(:ncol,:, 134) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 124)*sol(:ncol,:, 133) ! rate_const*M*NO*O rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 216)*sol(:ncol,:, 113) ! rate_const*O1D*N2O - rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 125)*sol(:ncol,:, 203) ! rate_const*M*NO2*HO2 - rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 125)*sol(:ncol,:, 126) ! rate_const*M*NO2*NO3 - rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 125)*sol(:ncol,:, 217) ! rate_const*M*NO2*OH - rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 89)*sol(:ncol,:, 217) ! rate_const*HNO3*OH - rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 90) ! rate_const*M*HO2NO2 - rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 114) ! rate_const*M*N2O5 - rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 56)*sol(:ncol,:, 42) ! rate_const*CL*CH2O - rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 56)*sol(:ncol,:, 54) ! rate_const*CL*CH4 - rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 56)*sol(:ncol,:, 77) ! rate_const*CL*H2 - rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 56)*sol(:ncol,:, 79) ! rate_const*CL*H2O2 - rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 56)*sol(:ncol,:, 203) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 216)*sol(:ncol,:, 113) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 125)*sol(:ncol,:, 203) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 125)*sol(:ncol,:, 126) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 125)*sol(:ncol,:, 217) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 89)*sol(:ncol,:, 217) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 90) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 114) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 56)*sol(:ncol,:, 42) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 56)*sol(:ncol,:, 54) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 56)*sol(:ncol,:, 77) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 56)*sol(:ncol,:, 79) ! rate_const*CL*H2O2 rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 56)*sol(:ncol,:, 203) ! rate_const*CL*HO2 - rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 56)*sol(:ncol,:, 134) ! rate_const*CL*O3 - rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 59)*sol(:ncol,:, 198) ! rate_const*CLO*CH3O2 - rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 56)*sol(:ncol,:, 203) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 56)*sol(:ncol,:, 134) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 59)*sol(:ncol,:, 198) ! rate_const*CLO*CH3O2 rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 59)*sol(:ncol,:, 203) ! rate_const*CLO*HO2 - rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 59)*sol(:ncol,:, 124) ! rate_const*CLO*NO - rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 60)*sol(:ncol,:, 56) ! rate_const*CLONO2*CL - rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 59)*sol(:ncol,:, 125) ! rate_const*M*CLO*NO2 - rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 60)*sol(:ncol,:, 133) ! rate_const*CLONO2*O - rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 60)*sol(:ncol,:, 217) ! rate_const*CLONO2*OH - rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 59)*sol(:ncol,:, 133) ! rate_const*CLO*O - rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 59)*sol(:ncol,:, 217) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 59)*sol(:ncol,:, 203) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 59)*sol(:ncol,:, 124) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 60)*sol(:ncol,:, 56) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 59)*sol(:ncol,:, 125) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 60)*sol(:ncol,:, 133) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 60)*sol(:ncol,:, 217) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 59)*sol(:ncol,:, 133) ! rate_const*CLO*O rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 59)*sol(:ncol,:, 217) ! rate_const*CLO*OH - rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 85)*sol(:ncol,:, 133) ! rate_const*HCL*O - rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 85)*sol(:ncol,:, 217) ! rate_const*HCL*OH - rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 92)*sol(:ncol,:, 56) ! rate_const*HOCL*CL - rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 92)*sol(:ncol,:, 133) ! rate_const*HOCL*O - rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 92)*sol(:ncol,:, 217) ! rate_const*HOCL*OH - rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 216)*sol(:ncol,:, 33) ! rate_const*O1D*CCL4 - rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 216)*sol(:ncol,:, 34) ! rate_const*O1D*CF2CLBR - rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 216)*sol(:ncol,:, 36) ! rate_const*O1D*CFC11 - rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 216)*sol(:ncol,:, 37) ! rate_const*O1D*CFC113 - rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 216)*sol(:ncol,:, 38) ! rate_const*O1D*CFC114 - rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 216)*sol(:ncol,:, 39) ! rate_const*O1D*CFC115 - rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 216)*sol(:ncol,:, 40) ! rate_const*O1D*CFC12 - rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 216)*sol(:ncol,:, 85) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 59)*sol(:ncol,:, 217) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 85)*sol(:ncol,:, 133) ! rate_const*HCL*O + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 85)*sol(:ncol,:, 217) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 92)*sol(:ncol,:, 56) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 92)*sol(:ncol,:, 133) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 92)*sol(:ncol,:, 217) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 216)*sol(:ncol,:, 33) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 216)*sol(:ncol,:, 34) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 216)*sol(:ncol,:, 36) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 216)*sol(:ncol,:, 37) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 216)*sol(:ncol,:, 38) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 216)*sol(:ncol,:, 39) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 216)*sol(:ncol,:, 40) ! rate_const*O1D*CFC12 rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 216)*sol(:ncol,:, 85) ! rate_const*O1D*HCL - rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*M*CLO*CLO - rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 58) ! rate_const*M*CL2O2 - rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 17)*sol(:ncol,:, 42) ! rate_const*BR*CH2O - rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 17)*sol(:ncol,:, 203) ! rate_const*BR*HO2 - rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 17)*sol(:ncol,:, 134) ! rate_const*BR*O3 - rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 19)*sol(:ncol,:, 19) ! rate_const*BRO*BRO - rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 216)*sol(:ncol,:, 85) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 58) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 17)*sol(:ncol,:, 42) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 17)*sol(:ncol,:, 203) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 17)*sol(:ncol,:, 134) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 19)*sol(:ncol,:, 19) ! rate_const*BRO*BRO rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 19)*sol(:ncol,:, 203) ! rate_const*BRO*HO2 - rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 19)*sol(:ncol,:, 124) ! rate_const*BRO*NO - rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 19)*sol(:ncol,:, 125) ! rate_const*M*BRO*NO2 - rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 20)*sol(:ncol,:, 133) ! rate_const*BRONO2*O - rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 19)*sol(:ncol,:, 133) ! rate_const*BRO*O - rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 19)*sol(:ncol,:, 217) ! rate_const*BRO*OH - rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 81)*sol(:ncol,:, 133) ! rate_const*HBR*O - rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 81)*sol(:ncol,:, 217) ! rate_const*HBR*OH - rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 91)*sol(:ncol,:, 133) ! rate_const*HOBR*O - rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 216)*sol(:ncol,:, 35) ! rate_const*O1D*CF3BR - rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 216)*sol(:ncol,:, 55) ! rate_const*O1D*CHBR3 - rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 216)*sol(:ncol,:, 78) ! rate_const*O1D*H2402 - rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 216)*sol(:ncol,:, 81) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 19)*sol(:ncol,:, 203) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 19)*sol(:ncol,:, 124) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 19)*sol(:ncol,:, 125) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 20)*sol(:ncol,:, 133) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 19)*sol(:ncol,:, 133) ! rate_const*BRO*O + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 19)*sol(:ncol,:, 217) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 81)*sol(:ncol,:, 133) ! rate_const*HBR*O + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 81)*sol(:ncol,:, 217) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 91)*sol(:ncol,:, 133) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 216)*sol(:ncol,:, 35) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 216)*sol(:ncol,:, 55) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 216)*sol(:ncol,:, 78) ! rate_const*O1D*H2402 rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 216)*sol(:ncol,:, 81) ! rate_const*O1D*HBR - rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 73)*sol(:ncol,:, 54) ! rate_const*F*CH4 - rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 73)*sol(:ncol,:, 77) ! rate_const*F*H2 - rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 73)*sol(:ncol,:, 229) ! rate_const*F*H2O - rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 73)*sol(:ncol,:, 89) ! rate_const*F*HNO3 - rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 216)*sol(:ncol,:, 64) ! rate_const*O1D*COF2 - rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 216)*sol(:ncol,:, 65) ! rate_const*O1D*COFCL - rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 41)*sol(:ncol,:, 56) ! rate_const*CH2BR2*CL - rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 41)*sol(:ncol,:, 217) ! rate_const*CH2BR2*OH - rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 43)*sol(:ncol,:, 56) ! rate_const*CH3BR*CL - rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 43)*sol(:ncol,:, 217) ! rate_const*CH3BR*OH - rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 44)*sol(:ncol,:, 217) ! rate_const*CH3CCL3*OH - rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 46)*sol(:ncol,:, 56) ! rate_const*CH3CL*CL - rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 46)*sol(:ncol,:, 217) ! rate_const*CH3CL*OH - rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 55)*sol(:ncol,:, 56) ! rate_const*CHBR3*CL - rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 55)*sol(:ncol,:, 217) ! rate_const*CHBR3*OH - rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 82)*sol(:ncol,:, 217) ! rate_const*HCFC141B*OH - rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 83)*sol(:ncol,:, 217) ! rate_const*HCFC142B*OH - rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 84)*sol(:ncol,:, 217) ! rate_const*HCFC22*OH - rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 216)*sol(:ncol,:, 41) ! rate_const*O1D*CH2BR2 - rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 216)*sol(:ncol,:, 43) ! rate_const*O1D*CH3BR - rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 216)*sol(:ncol,:, 82) ! rate_const*O1D*HCFC141B - rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 216)*sol(:ncol,:, 83) ! rate_const*O1D*HCFC142B - rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 216)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC22 - rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 42)*sol(:ncol,:, 203) ! rate_const*CH2O*HO2 - rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 42)*sol(:ncol,:, 126) ! rate_const*CH2O*NO3 - rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 42)*sol(:ncol,:, 133) ! rate_const*CH2O*O - rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 42)*sol(:ncol,:, 217) ! rate_const*CH2O*OH - rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 198)*sol(:ncol,:, 198) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 216)*sol(:ncol,:, 81) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 73)*sol(:ncol,:, 54) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 73)*sol(:ncol,:, 77) ! rate_const*F*H2 + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 73)*sol(:ncol,:, 229) ! rate_const*F*H2O + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 73)*sol(:ncol,:, 89) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 216)*sol(:ncol,:, 64) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 216)*sol(:ncol,:, 65) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 41)*sol(:ncol,:, 56) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 41)*sol(:ncol,:, 217) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 43)*sol(:ncol,:, 56) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 43)*sol(:ncol,:, 217) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 44)*sol(:ncol,:, 217) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 46)*sol(:ncol,:, 56) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 46)*sol(:ncol,:, 217) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 55)*sol(:ncol,:, 56) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 55)*sol(:ncol,:, 217) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 82)*sol(:ncol,:, 217) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 83)*sol(:ncol,:, 217) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 84)*sol(:ncol,:, 217) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 216)*sol(:ncol,:, 41) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 216)*sol(:ncol,:, 43) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 216)*sol(:ncol,:, 82) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 216)*sol(:ncol,:, 83) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 216)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 42)*sol(:ncol,:, 203) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 42)*sol(:ncol,:, 126) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 42)*sol(:ncol,:, 133) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 42)*sol(:ncol,:, 217) ! rate_const*CH2O*OH rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 198)*sol(:ncol,:, 198) ! rate_const*CH3O2*CH3O2 - rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 198)*sol(:ncol,:, 203) ! rate_const*CH3O2*HO2 - rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 198)*sol(:ncol,:, 124) ! rate_const*CH3O2*NO - rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 52)*sol(:ncol,:, 217) ! rate_const*CH3OH*OH - rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 53)*sol(:ncol,:, 217) ! rate_const*CH3OOH*OH - rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 54)*sol(:ncol,:, 217) ! rate_const*CH4*OH - rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 62)*sol(:ncol,:, 217) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 198)*sol(:ncol,:, 198) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 198)*sol(:ncol,:, 203) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 198)*sol(:ncol,:, 124) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 52)*sol(:ncol,:, 217) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 53)*sol(:ncol,:, 217) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 54)*sol(:ncol,:, 217) ! rate_const*CH4*OH rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 86)*sol(:ncol,:, 217) ! rate_const*M*HCN*OH rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 87)*sol(:ncol,:, 217) ! rate_const*HCOOH*OH rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 204)*sol(:ncol,:, 203) ! rate_const*HOCH2OO*HO2 @@ -474,17 +474,17 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 137)*sol(:ncol,:, 133) ! rate_const*OCS*O rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 137)*sol(:ncol,:, 217) ! rate_const*OCS*OH rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 148) ! rate_const*O2*S - rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 148)*sol(:ncol,:, 134) ! rate_const*S*O3 - rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 150)*sol(:ncol,:, 19) ! rate_const*SO*BRO - rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 150)*sol(:ncol,:, 59) ! rate_const*SO*CLO - rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 148)*sol(:ncol,:, 217) ! rate_const*S*OH - rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 150)*sol(:ncol,:, 125) ! rate_const*SO*NO2 - rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 150) ! rate_const*O2*SO - rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 150)*sol(:ncol,:, 134) ! rate_const*SO*O3 - rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 150)*sol(:ncol,:, 136) ! rate_const*SO*OCLO - rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 150)*sol(:ncol,:, 217) ! rate_const*SO*OH - rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 67)*sol(:ncol,:, 217) ! rate_const*DMS*OH - rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 151)*sol(:ncol,:, 217) ! rate_const*SO2*OH + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 151)*sol(:ncol,:, 217) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 148)*sol(:ncol,:, 134) ! rate_const*S*O3 + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 150)*sol(:ncol,:, 19) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 150)*sol(:ncol,:, 59) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 148)*sol(:ncol,:, 217) ! rate_const*S*OH + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 150)*sol(:ncol,:, 125) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 150) ! rate_const*O2*SO + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 150)*sol(:ncol,:, 134) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 150)*sol(:ncol,:, 136) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 150)*sol(:ncol,:, 217) ! rate_const*SO*OH + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 67)*sol(:ncol,:, 217) ! rate_const*DMS*OH rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 152)*sol(:ncol,:, 229) ! rate_const*SO3*H2O rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 120)*sol(:ncol,:, 217) ! rate_const*NH3*OH rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 75) ! rate_const*GLYOXAL @@ -546,9 +546,8 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 114) ! rate_const*N2O5 rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 60) ! rate_const*CLONO2 rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 71) ! rate_const*E90 - rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 123) ! rate_const*NH_50 - rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 122) ! rate_const*NH_5 - rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 171) ! rate_const*ST80_25 + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 123) ! rate_const*NH_50 + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 122) ! rate_const*NH_5 + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 171) ! rate_const*ST80_25 end subroutine set_rates end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 index 8609dbf485..959d5cb5d3 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_setrxt.F90 @@ -37,46 +37,46 @@ subroutine setrxt( rate, temp, m, ncol ) real(r8) :: ko(ncol*pver) real(r8) :: kinf(ncol*pver) - rate(:,124) = 1.2e-10_r8 - rate(:,128) = 1.2e-10_r8 - rate(:,134) = 6.9e-12_r8 - rate(:,135) = 7.2e-11_r8 - rate(:,136) = 1.6e-12_r8 - rate(:,142) = 1.8e-12_r8 - rate(:,146) = 1.8e-12_r8 - rate(:,158) = 3.5e-12_r8 - rate(:,160) = 1e-11_r8 - rate(:,161) = 2.2e-11_r8 - rate(:,162) = 5e-11_r8 - rate(:,197) = 1.7e-13_r8 - rate(:,199) = 2.607e-10_r8 - rate(:,200) = 9.75e-11_r8 - rate(:,201) = 2.07e-10_r8 - rate(:,202) = 2.088e-10_r8 - rate(:,203) = 1.17e-10_r8 - rate(:,204) = 4.644e-11_r8 - rate(:,205) = 1.204e-10_r8 - rate(:,206) = 9.9e-11_r8 - rate(:,207) = 3.3e-12_r8 - rate(:,226) = 4.5e-11_r8 - rate(:,227) = 4.62e-10_r8 - rate(:,228) = 1.2e-10_r8 - rate(:,229) = 9e-11_r8 - rate(:,230) = 3e-11_r8 - rate(:,235) = 2.14e-11_r8 - rate(:,236) = 1.9e-10_r8 - rate(:,249) = 2.57e-10_r8 - rate(:,250) = 1.8e-10_r8 - rate(:,251) = 1.794e-10_r8 - rate(:,252) = 1.3e-10_r8 - rate(:,253) = 7.65e-11_r8 + rate(:,124) = 1.29e-07_r8 + rate(:,125) = 1.2e-10_r8 + rate(:,129) = 1.2e-10_r8 + rate(:,135) = 6.9e-12_r8 + rate(:,136) = 7.2e-11_r8 + rate(:,137) = 1.6e-12_r8 + rate(:,143) = 1.8e-12_r8 + rate(:,147) = 1.8e-12_r8 + rate(:,159) = 3.5e-12_r8 + rate(:,161) = 1.3e-11_r8 + rate(:,162) = 2.2e-11_r8 + rate(:,163) = 5e-11_r8 + rate(:,198) = 1.7e-13_r8 + rate(:,200) = 2.607e-10_r8 + rate(:,201) = 9.75e-11_r8 + rate(:,202) = 2.07e-10_r8 + rate(:,203) = 2.088e-10_r8 + rate(:,204) = 1.17e-10_r8 + rate(:,205) = 4.644e-11_r8 + rate(:,206) = 1.204e-10_r8 + rate(:,207) = 9.9e-11_r8 + rate(:,208) = 3.3e-12_r8 + rate(:,227) = 4.5e-11_r8 + rate(:,228) = 4.62e-10_r8 + rate(:,229) = 1.2e-10_r8 + rate(:,230) = 9e-11_r8 + rate(:,231) = 3e-11_r8 + rate(:,236) = 2.14e-11_r8 + rate(:,237) = 1.9e-10_r8 + rate(:,250) = 2.57e-10_r8 + rate(:,251) = 1.8e-10_r8 + rate(:,252) = 1.794e-10_r8 + rate(:,253) = 1.3e-10_r8 + rate(:,254) = 7.65e-11_r8 rate(:,267) = 4e-13_r8 rate(:,271) = 1.31e-10_r8 rate(:,272) = 3.5e-11_r8 rate(:,273) = 9e-12_r8 rate(:,280) = 6.8e-14_r8 rate(:,281) = 2e-13_r8 - rate(:,295) = 7e-13_r8 rate(:,296) = 1e-12_r8 rate(:,300) = 1e-14_r8 rate(:,301) = 1e-11_r8 @@ -123,12 +123,12 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,460) = 5.7e-11_r8 rate(:,461) = 3.4e-11_r8 rate(:,466) = 2.3e-12_r8 - rate(:,467) = 1.2e-11_r8 - rate(:,468) = 5.7e-11_r8 - rate(:,469) = 2.8e-11_r8 - rate(:,470) = 6.6e-11_r8 - rate(:,471) = 1.4e-11_r8 - rate(:,474) = 1.9e-12_r8 + rate(:,468) = 1.2e-11_r8 + rate(:,469) = 5.7e-11_r8 + rate(:,470) = 2.8e-11_r8 + rate(:,471) = 6.6e-11_r8 + rate(:,472) = 1.4e-11_r8 + rate(:,475) = 1.9e-12_r8 rate(:,488) = 6.34e-08_r8 rate(:,494) = 1.9e-11_r8 rate(:,497) = 1.2e-14_r8 @@ -136,29 +136,28 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,509) = 1.34e-11_r8 rate(:,515) = 1.34e-11_r8 rate(:,519) = 1.7e-11_r8 - rate(:,539) = 1.29e-07_r8 - rate(:,540) = 2.31e-07_r8 - rate(:,541) = 2.31e-06_r8 - rate(:,542) = 4.63e-07_r8 + rate(:,539) = 2.31e-07_r8 + rate(:,540) = 2.31e-06_r8 + rate(:,541) = 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(:,125) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) - rate(:,126) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) - rate(:,127) = 3.3e-11_r8 * exp( 55._r8 * itemp(:) ) - rate(:,129) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) - rate(:,132) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + rate(:,126) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,127) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:,128) = 3.3e-11_r8 * exp( 55._r8 * itemp(:) ) + rate(:,130) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,133) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) exp_fac(:) = exp( -2000._r8 * itemp(:) ) - rate(:,133) = 1.4e-12_r8 * exp_fac(:) + rate(:,134) = 1.4e-12_r8 * exp_fac(:) rate(:,385) = 1.05e-14_r8 * exp_fac(:) rate(:,505) = 1.05e-14_r8 * exp_fac(:) exp_fac(:) = exp( 200._r8 * itemp(:) ) - rate(:,138) = 3e-11_r8 * exp_fac(:) - rate(:,224) = 5.5e-12_r8 * exp_fac(:) - rate(:,263) = 3.8e-12_r8 * exp_fac(:) + rate(:,139) = 3e-11_r8 * exp_fac(:) + rate(:,225) = 5.5e-12_r8 * exp_fac(:) + rate(:,264) = 3.8e-12_r8 * exp_fac(:) rate(:,285) = 3.8e-12_r8 * exp_fac(:) rate(:,312) = 3.8e-12_r8 * exp_fac(:) rate(:,320) = 3.8e-12_r8 * exp_fac(:) @@ -175,14 +174,14 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,428) = 3.8e-12_r8 * exp_fac(:) rate(:,434) = 3.8e-12_r8 * exp_fac(:) rate(:,438) = 3.8e-12_r8 * exp_fac(:) - rate(:,139) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) - rate(:,140) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) - rate(:,141) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + rate(:,140) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,141) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,142) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) exp_fac(:) = exp( 250._r8 * itemp(:) ) - rate(:,143) = 4.8e-11_r8 * exp_fac(:) - rate(:,222) = 1.7e-11_r8 * exp_fac(:) + rate(:,144) = 4.8e-11_r8 * exp_fac(:) + rate(:,223) = 1.7e-11_r8 * exp_fac(:) exp_fac(:) = exp( 180._r8 * itemp(:) ) - rate(:,144) = 1.8e-11_r8 * exp_fac(:) + rate(:,145) = 1.8e-11_r8 * exp_fac(:) rate(:,298) = 4.2e-12_r8 * exp_fac(:) rate(:,311) = 4.2e-12_r8 * exp_fac(:) rate(:,319) = 4.2e-12_r8 * exp_fac(:) @@ -192,92 +191,93 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,447) = 4.2e-12_r8 * exp_fac(:) rate(:,452) = 4.2e-12_r8 * exp_fac(:) rate(:,457) = 4.2e-12_r8 * exp_fac(:) - rate(:,145) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) - rate(:,149) = 1.3e-12_r8 * exp( 380._r8 * itemp(:) ) - rate(:,150) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:,146) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,150) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) + rate(:,151) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) exp_fac(:) = exp( 220._r8 * itemp(:) ) - rate(:,151) = 2.9e-12_r8 * exp_fac(:) - rate(:,152) = 1.45e-12_r8 * exp_fac(:) + rate(:,152) = 2.9e-12_r8 * exp_fac(:) rate(:,153) = 1.45e-12_r8 * exp_fac(:) - rate(:,154) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) - rate(:,155) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:,154) = 1.45e-12_r8 * exp_fac(:) + rate(:,155) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:,156) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) exp_fac(:) = exp( -2450._r8 * itemp(:) ) - rate(:,156) = 1.2e-13_r8 * exp_fac(:) - rate(:,182) = 3e-11_r8 * exp_fac(:) - rate(:,159) = 1.5e-11_r8 * exp( 170._r8 * itemp(:) ) - exp_fac(:) = exp( 270._r8 * itemp(:) ) - rate(:,163) = 3.3e-12_r8 * exp_fac(:) - rate(:,178) = 1.4e-11_r8 * exp_fac(:) - rate(:,192) = 7.4e-12_r8 * exp_fac(:) - rate(:,294) = 8.1e-12_r8 * exp_fac(:) + rate(:,157) = 1.2e-13_r8 * exp_fac(:) + rate(:,183) = 3e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,160) = 1.7e-11_r8 * exp_fac(:) + rate(:,258) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,164) = 3.44e-12_r8 * exp_fac(:) + rate(:,216) = 2.3e-12_r8 * exp_fac(:) + rate(:,219) = 8.8e-12_r8 * exp_fac(:) exp_fac(:) = exp( -1500._r8 * itemp(:) ) - rate(:,164) = 3e-12_r8 * exp_fac(:) - rate(:,223) = 5.8e-12_r8 * exp_fac(:) + rate(:,165) = 3e-12_r8 * exp_fac(:) + rate(:,224) = 5.8e-12_r8 * exp_fac(:) exp_fac(:) = exp( 20._r8 * itemp(:) ) - rate(:,166) = 7.26e-11_r8 * exp_fac(:) - rate(:,167) = 4.64e-11_r8 * exp_fac(:) - rate(:,174) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) - rate(:,175) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) - rate(:,176) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) - rate(:,177) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) - rate(:,179) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) - rate(:,180) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) - rate(:,181) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) - rate(:,183) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) - rate(:,184) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + rate(:,167) = 7.26e-11_r8 * exp_fac(:) + rate(:,168) = 4.64e-11_r8 * exp_fac(:) + rate(:,175) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,176) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,177) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,178) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,179) = 1.4e-11_r8 * exp_fac(:) + rate(:,193) = 7.4e-12_r8 * exp_fac(:) + rate(:,294) = 8.1e-12_r8 * exp_fac(:) + rate(:,180) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,181) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,182) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,184) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,185) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) exp_fac(:) = exp( 290._r8 * itemp(:) ) - rate(:,185) = 2.6e-12_r8 * exp_fac(:) - rate(:,186) = 6.4e-12_r8 * exp_fac(:) - rate(:,216) = 4.1e-13_r8 * exp_fac(:) + rate(:,186) = 2.6e-12_r8 * exp_fac(:) + rate(:,187) = 6.4e-12_r8 * exp_fac(:) + rate(:,217) = 4.1e-13_r8 * exp_fac(:) rate(:,397) = 7.5e-12_r8 * exp_fac(:) rate(:,411) = 7.5e-12_r8 * exp_fac(:) rate(:,414) = 7.5e-12_r8 * exp_fac(:) rate(:,417) = 7.5e-12_r8 * exp_fac(:) - rate(:,187) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + rate(:,188) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) exp_fac(:) = exp( -840._r8 * itemp(:) ) - rate(:,189) = 3.6e-12_r8 * exp_fac(:) - rate(:,238) = 2e-12_r8 * exp_fac(:) - rate(:,190) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) - rate(:,191) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + rate(:,190) = 3.6e-12_r8 * exp_fac(:) + rate(:,239) = 2e-12_r8 * exp_fac(:) + rate(:,191) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,192) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) exp_fac(:) = exp( 230._r8 * itemp(:) ) - rate(:,193) = 6e-13_r8 * exp_fac(:) - rate(:,213) = 1.5e-12_r8 * exp_fac(:) - rate(:,221) = 1.9e-11_r8 * exp_fac(:) - rate(:,194) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) - rate(:,195) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) - rate(:,196) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + rate(:,194) = 6e-13_r8 * exp_fac(:) + rate(:,214) = 1.5e-12_r8 * exp_fac(:) + rate(:,222) = 1.9e-11_r8 * exp_fac(:) + rate(:,195) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,196) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,197) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) exp_fac(:) = exp( -500._r8 * itemp(:) ) - rate(:,198) = 3e-12_r8 * exp_fac(:) - rate(:,232) = 1.4e-10_r8 * exp_fac(:) + rate(:,199) = 3e-12_r8 * exp_fac(:) + rate(:,233) = 1.4e-10_r8 * exp_fac(:) exp_fac(:) = exp( -800._r8 * itemp(:) ) - rate(:,210) = 1.7e-11_r8 * exp_fac(:) - rate(:,237) = 6.3e-12_r8 * exp_fac(:) - rate(:,211) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) - rate(:,212) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) - rate(:,214) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) - exp_fac(:) = exp( 260._r8 * itemp(:) ) - rate(:,215) = 2.3e-12_r8 * exp_fac(:) - rate(:,218) = 8.8e-12_r8 * exp_fac(:) - rate(:,217) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) - rate(:,220) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) - rate(:,225) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) - rate(:,231) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) + rate(:,211) = 1.7e-11_r8 * exp_fac(:) + rate(:,238) = 6.3e-12_r8 * exp_fac(:) + rate(:,212) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,213) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,215) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + rate(:,218) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,221) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,226) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,232) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) exp_fac(:) = exp( 0._r8 * itemp(:) ) - rate(:,233) = 1.4e-11_r8 * exp_fac(:) - rate(:,235) = 2.14e-11_r8 * exp_fac(:) - rate(:,236) = 1.9e-10_r8 * exp_fac(:) - rate(:,249) = 2.57e-10_r8 * exp_fac(:) - rate(:,250) = 1.8e-10_r8 * exp_fac(:) - rate(:,251) = 1.794e-10_r8 * exp_fac(:) - rate(:,252) = 1.3e-10_r8 * exp_fac(:) - rate(:,253) = 7.65e-11_r8 * exp_fac(:) + rate(:,234) = 1.4e-11_r8 * exp_fac(:) + rate(:,236) = 2.14e-11_r8 * exp_fac(:) + rate(:,237) = 1.9e-10_r8 * exp_fac(:) + rate(:,250) = 2.57e-10_r8 * exp_fac(:) + rate(:,251) = 1.8e-10_r8 * exp_fac(:) + rate(:,252) = 1.794e-10_r8 * exp_fac(:) + rate(:,253) = 1.3e-10_r8 * exp_fac(:) + rate(:,254) = 7.65e-11_r8 * exp_fac(:) rate(:,267) = 4e-13_r8 * exp_fac(:) rate(:,271) = 1.31e-10_r8 * exp_fac(:) rate(:,272) = 3.5e-11_r8 * exp_fac(:) rate(:,273) = 9e-12_r8 * exp_fac(:) rate(:,280) = 6.8e-14_r8 * exp_fac(:) rate(:,281) = 2e-13_r8 * exp_fac(:) - rate(:,295) = 7e-13_r8 * exp_fac(:) rate(:,296) = 1e-12_r8 * exp_fac(:) rate(:,300) = 1e-14_r8 * exp_fac(:) rate(:,301) = 1e-11_r8 * exp_fac(:) @@ -324,12 +324,12 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,460) = 5.7e-11_r8 * exp_fac(:) rate(:,461) = 3.4e-11_r8 * exp_fac(:) rate(:,466) = 2.3e-12_r8 * exp_fac(:) - rate(:,467) = 1.2e-11_r8 * exp_fac(:) - rate(:,468) = 5.7e-11_r8 * exp_fac(:) - rate(:,469) = 2.8e-11_r8 * exp_fac(:) - rate(:,470) = 6.6e-11_r8 * exp_fac(:) - rate(:,471) = 1.4e-11_r8 * exp_fac(:) - rate(:,474) = 1.9e-12_r8 * exp_fac(:) + rate(:,468) = 1.2e-11_r8 * exp_fac(:) + rate(:,469) = 5.7e-11_r8 * exp_fac(:) + rate(:,470) = 2.8e-11_r8 * exp_fac(:) + rate(:,471) = 6.6e-11_r8 * exp_fac(:) + rate(:,472) = 1.4e-11_r8 * exp_fac(:) + rate(:,475) = 1.9e-12_r8 * exp_fac(:) rate(:,488) = 6.34e-08_r8 * exp_fac(:) rate(:,494) = 1.9e-11_r8 * exp_fac(:) rate(:,497) = 1.2e-14_r8 * exp_fac(:) @@ -337,44 +337,42 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,509) = 1.34e-11_r8 * exp_fac(:) rate(:,515) = 1.34e-11_r8 * exp_fac(:) rate(:,519) = 1.7e-11_r8 * exp_fac(:) - rate(:,539) = 1.29e-07_r8 * exp_fac(:) - rate(:,540) = 2.31e-07_r8 * exp_fac(:) - rate(:,541) = 2.31e-06_r8 * exp_fac(:) - rate(:,542) = 4.63e-07_r8 * exp_fac(:) + rate(:,539) = 2.31e-07_r8 * exp_fac(:) + rate(:,540) = 2.31e-06_r8 * exp_fac(:) + rate(:,541) = 4.63e-07_r8 * exp_fac(:) exp_fac(:) = exp( 400._r8 * itemp(:) ) - rate(:,234) = 6e-12_r8 * exp_fac(:) + rate(:,235) = 6e-12_r8 * exp_fac(:) rate(:,333) = 5e-13_r8 * exp_fac(:) rate(:,366) = 5e-13_r8 * exp_fac(:) rate(:,371) = 5e-13_r8 * exp_fac(:) rate(:,380) = 5e-13_r8 * exp_fac(:) rate(:,391) = 5e-13_r8 * exp_fac(:) - rate(:,239) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) - rate(:,240) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + rate(:,240) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,241) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) exp_fac(:) = exp( -1520._r8 * itemp(:) ) - rate(:,241) = 1.64e-12_r8 * exp_fac(:) + rate(:,242) = 1.64e-12_r8 * exp_fac(:) rate(:,352) = 8.5e-16_r8 * exp_fac(:) exp_fac(:) = exp( -1100._r8 * itemp(:) ) - rate(:,242) = 2.03e-11_r8 * exp_fac(:) - rate(:,473) = 3.4e-12_r8 * exp_fac(:) - rate(:,243) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) - rate(:,244) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) - rate(:,245) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + rate(:,243) = 2.03e-11_r8 * exp_fac(:) + rate(:,474) = 3.4e-12_r8 * exp_fac(:) + rate(:,244) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,245) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,246) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) exp_fac(:) = exp( -1600._r8 * itemp(:) ) - rate(:,246) = 1.25e-12_r8 * exp_fac(:) - rate(:,256) = 3.4e-11_r8 * exp_fac(:) - rate(:,247) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) - rate(:,248) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) - rate(:,254) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) - rate(:,255) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) - rate(:,257) = 5.5e-12_r8 * exp( 125._r8 * itemp(:) ) - rate(:,258) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) - rate(:,259) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) - rate(:,260) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + rate(:,247) = 1.25e-12_r8 * exp_fac(:) + rate(:,257) = 3.4e-11_r8 * exp_fac(:) + rate(:,248) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,249) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,255) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) + rate(:,256) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,259) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) + rate(:,260) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) + rate(:,261) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) exp_fac(:) = exp( 300._r8 * itemp(:) ) - rate(:,261) = 2.8e-12_r8 * exp_fac(:) + rate(:,262) = 2.8e-12_r8 * exp_fac(:) rate(:,323) = 2.9e-12_r8 * exp_fac(:) - rate(:,262) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) - rate(:,264) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + rate(:,263) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) + rate(:,265) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) exp_fac(:) = exp( 700._r8 * itemp(:) ) rate(:,268) = 7.5e-13_r8 * exp_fac(:) rate(:,282) = 7.5e-13_r8 * exp_fac(:) @@ -445,10 +443,11 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,410) = 4.3e-13_r8 * exp_fac(:) rate(:,413) = 4.3e-13_r8 * exp_fac(:) rate(:,416) = 4.3e-13_r8 * exp_fac(:) + rate(:,295) = 3.15e-14_r8 * exp( 920._r8 * itemp(:) ) rate(:,299) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) rate(:,307) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) rate(:,309) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) - rate(:,313) = 8.7e-12_r8 * exp( -615._r8 * itemp(:) ) + rate(:,313) = 9.19e-12_r8 * exp( -630._r8 * itemp(:) ) rate(:,314) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) rate(:,315) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) rate(:,329) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) @@ -498,11 +497,11 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,444) = 1.2e-11_r8 * exp_fac(:) rate(:,514) = 1.2e-11_r8 * exp_fac(:) rate(:,462) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) - rate(:,463) = 9.6e-12_r8 * exp( -234._r8 * itemp(:) ) + rate(:,463) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) rate(:,464) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) rate(:,465) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) - rate(:,472) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) - rate(:,475) = 2.7e-11_r8 * exp( 335._r8 * itemp(:) ) + rate(:,473) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,476) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) rate(:,479) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) exp_fac(:) = exp( 1300._r8 * itemp(:) ) rate(:,495) = 2.75e-13_r8 * exp_fac(:) @@ -513,52 +512,48 @@ subroutine setrxt( rate, temp, m, ncol ) n = ncol*pver - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) - call jpl( rate(:,137), m, 0.6_r8, ko, kinf, n ) + ko(:) = 5.3e-32_r8 * itemp(:)**1.8_r8 + kinf(:) = 9.5e-11_r8 * itemp(:)**(-0.4_r8) + call jpl( rate(:,138), m, 0.6_r8, ko, kinf, n ) ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 kinf(:) = 2.6e-11_r8 - call jpl( rate(:,147), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,148), 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(:,157), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,158), m, 0.6_r8, ko, kinf, n ) ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 kinf(:) = 3e-11_r8 - call jpl( rate(:,165), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,166), 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(:,168), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,169), 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(:,169), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,170), m, 0.6_r8, ko, kinf, n ) ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 kinf(:) = 2.8e-11_r8 - call jpl( rate(:,170), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,171), 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(:,188), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,189), 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(:,208), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,209), 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(:,219), m, 0.6_r8, ko, kinf, n ) - - ko(:) = 5.9e-33_r8 * itemp(:)**1._r8 - kinf(:) = 1.1e-12_r8 * itemp(:)**(-1.3_r8) - call jpl( rate(:,265), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,220), m, 0.6_r8, ko, kinf, n ) - ko(:) = 4.28e-33_r8 - kinf(:) = 9.3e-15_r8 * itemp(:)**(-4.42_r8) + ko(:) = 6.1e-33_r8 * itemp(:)**1.5_r8 + kinf(:) = 9.8e-15_r8 * itemp(:)**(-4.6_r8) call jpl( rate(:,266), m, 0.8_r8, ko, kinf, n ) ko(:) = 5.2e-30_r8 * itemp(:)**2.4_r8 @@ -577,8 +572,8 @@ subroutine setrxt( rate, temp, m, ncol ) kinf(:) = 9e-12_r8 * itemp(:)**0.85_r8 call jpl( rate(:,304), m, 0.48_r8, ko, kinf, n ) - ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 - kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + ko(:) = 7.3e-29_r8 * itemp(:)**4.1_r8 + kinf(:) = 9.5e-12_r8 * itemp(:)**1.6_r8 call jpl( rate(:,305), m, 0.6_r8, ko, kinf, n ) ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 @@ -589,6 +584,10 @@ subroutine setrxt( rate, temp, m, ncol ) kinf(:) = 3e-11_r8 call jpl( rate(:,351), 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(:,354), m, 0.6_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(:,412), m, 0.6_r8, ko, kinf, n ) @@ -605,6 +604,10 @@ subroutine setrxt( rate, temp, m, ncol ) kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 call jpl( rate(:,425), 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(:,467), m, 0.6_r8, ko, kinf, n ) + end subroutine setrxt @@ -641,33 +644,34 @@ subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) n = ncol*kbot - rate(:n,134) = 6.9e-12_r8 + rate(:n,135) = 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,126) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) - rate(:n,129) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) - rate(:n,138) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) - rate(:n,139) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) - rate(:n,140) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) - rate(:n,143) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) - rate(:n,144) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) - rate(:n,145) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) - rate(:n,150) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) - rate(:n,154) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) - rate(:n,155) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) - rate(:n,163) = 3.3e-12_r8 * exp( 270._r8 * itemp(:) ) - rate(:n,164) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) + rate(:n,127) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:n,130) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,139) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,140) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,141) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,144) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,145) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,146) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,151) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,155) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:n,156) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,164) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) + rate(:n,165) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) itemp(:) = 300._r8 * itemp(:) - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + 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,137) = wrk(:) + rate(:n,138) = wrk(:) + diff --git a/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 index a847e00730..081b2aa566 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbs/mo_sim_dat.F90 @@ -31,10 +31,10 @@ subroutine set_sim_dat is_scalar = .false. is_vector = .true. - clscnt(:) = (/ 31, 0, 0, 198, 0 /) + clscnt(:) = (/ 2, 0, 0, 227, 0 /) - cls_rxt_cnt(:,1) = (/ 37, 61, 0, 31 /) - cls_rxt_cnt(:,4) = (/ 23, 174, 340, 198 /) + cls_rxt_cnt(:,1) = (/ 9, 0, 0, 2 /) + cls_rxt_cnt(:,4) = (/ 2, 165, 374, 227 /) solsym(:229) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','bc_a1 ','bc_a4 ', & 'BCARY ','BENZENE ','BENZOOH ','BEPOMUC ','BIGALD ', & @@ -179,82 +179,86 @@ subroutine set_sim_dat fix_mass(: 3) = (/ 0.00000000_r8, 31.9988000_r8, 28.0134800_r8 /) - clsmap(: 31,1) = (/ 3, 21, 33, 34, 35, 36, 37, 38, 39, 40, & - 41, 43, 44, 46, 54, 55, 61, 63, 71, 78, & - 82, 83, 84, 113, 122, 123, 135, 149, 171, 186, & - 187 /) - clsmap(:198,4) = (/ 1, 2, 4, 5, 6, 7, 8, 9, 10, 11, & - 12, 13, 14, 15, 16, 17, 18, 19, 20, 22, & - 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, & - 42, 45, 47, 48, 49, 50, 51, 52, 53, 56, & - 57, 58, 59, 60, 62, 64, 65, 66, 67, 68, & - 69, 70, 72, 73, 74, 75, 76, 77, 79, 80, & - 81, 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, 114, & - 115, 116, 117, 118, 119, 120, 121, 124, 125, 126, & - 127, 128, 129, 130, 131, 132, 133, 134, 136, 137, & - 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, & - 148, 150, 151, 152, 153, 154, 155, 156, 157, 158, & - 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, & - 169, 170, 172, 173, 174, 175, 176, 177, 178, 179, & - 180, 181, 182, 183, 184, 185, 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 /) + clsmap(: 2,1) = (/ 186, 187 /) + clsmap(:227,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, 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, 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 /) - permute(:198,4) = (/ 128, 126, 1, 2, 151, 52, 91, 53, 92, 103, & - 76, 120, 81, 67, 88, 181, 68, 190, 114, 69, & - 84, 77, 116, 71, 85, 78, 156, 98, 46, 72, & - 191, 168, 44, 154, 173, 117, 112, 141, 94, 195, & - 55, 45, 184, 155, 162, 51, 57, 59, 74, 3, & - 4, 5, 47, 139, 159, 149, 183, 169, 121, 48, & - 143, 194, 56, 142, 64, 182, 96, 138, 145, 160, & - 65, 163, 86, 49, 146, 123, 115, 171, 95, 130, & - 39, 172, 79, 110, 80, 119, 152, 176, 89, 75, & - 90, 158, 6, 7, 8, 43, 9, 188, 187, 196, & - 147, 93, 10, 11, 12, 13, 193, 197, 82, 87, & - 66, 104, 50, 105, 54, 83, 14, 15, 113, 97, & - 109, 174, 148, 70, 16, 17, 18, 19, 20, 21, & - 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, & - 32, 33, 34, 60, 122, 124, 106, 157, 161, 127, & - 58, 61, 62, 131, 63, 99, 111, 153, 35, 107, & - 36, 100, 144, 140, 125, 180, 189, 136, 118, 73, & - 132, 192, 101, 178, 175, 37, 38, 177, 133, 179, & - 150, 129, 40, 166, 185, 186, 102, 137, 167, 165, & - 164, 134, 41, 170, 135, 42, 108, 198 /) + permute(:227,4) = (/ 154, 151, 1, 2, 3, 185, 71, 121, 72, 114, & + 127, 96, 145, 105, 86, 110, 209, 87, 225, 139, & + 4, 90, 108, 98, 140, 92, 109, 99, 186, 120, & + 57, 93, 54, 66, 67, 58, 68, 59, 69, 60, & + 129, 213, 146, 61, 190, 112, 55, 180, 200, 156, & + 148, 166, 115, 210, 125, 220, 70, 52, 219, 177, & + 5, 192, 168, 85, 83, 77, 100, 6, 7, 8, & + 9, 62, 175, 191, 184, 212, 208, 56, 147, 63, & + 169, 82, 89, 101, 223, 74, 181, 97, 211, 118, & + 165, 171, 196, 84, 195, 104, 64, 173, 144, 141, & + 198, 117, 157, 48, 199, 102, 134, 103, 143, 182, & + 205, 132, 75, 95, 113, 189, 10, 11, 12, 53, & + 13, 14, 15, 217, 224, 216, 174, 116, 16, 17, & + 18, 19, 226, 222, 20, 106, 111, 88, 137, 65, & + 128, 73, 107, 21, 22, 138, 119, 135, 23, 201, & + 172, 91, 24, 25, 26, 27, 28, 29, 30, 31, & + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, & + 42, 43, 78, 152, 149, 130, 183, 188, 153, 76, & + 79, 80, 158, 81, 122, 136, 178, 44, 131, 45, & + 123, 170, 167, 150, 207, 221, 163, 142, 94, 159, & + 218, 124, 202, 203, 46, 47, 204, 160, 206, 176, & + 155, 49, 187, 214, 215, 126, 164, 194, 193, 179, & + 161, 50, 197, 162, 51, 133, 227 /) - diag_map(:198) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + diag_map(:227) = (/ 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, 39, 45, 51, 57, 63, 65, 71, & - 77, 83, 84, 87, 90, 93, 97, 100, 103, 106, & - 109, 113, 119, 123, 128, 130, 134, 139, 146, 151, & - 155, 160, 168, 173, 176, 181, 184, 187, 190, 194, & - 198, 202, 206, 210, 216, 222, 225, 231, 237, 242, & - 247, 252, 257, 263, 268, 273, 276, 284, 292, 298, & - 304, 310, 316, 322, 328, 334, 340, 346, 352, 360, & - 366, 373, 379, 382, 389, 393, 402, 410, 417, 423, & - 429, 435, 441, 449, 457, 465, 473, 477, 485, 493, & - 497, 504, 513, 522, 530, 537, 550, 561, 572, 580, & - 591, 604, 611, 622, 638, 649, 658, 668, 677, 686, & - 696, 700, 704, 715, 724, 735, 751, 758, 765, 770, & - 788, 815, 837, 847, 855, 869, 884, 896, 908, 916, & - 930, 939, 943, 956, 978, 997,1013,1024,1035,1052, & - 1072,1088,1100,1111,1142,1164,1187,1214,1233,1264, & - 1278,1291,1304,1327,1352,1507,1549,1640,1691,1716, & - 1739,1845,1876,1900,1935,1993,2054,2080 /) + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 48, 54, 60, 66, 72, 74, 80, 86, & + 92, 93, 96, 99, 102, 105, 109, 113, 117, 121, & + 125, 129, 132, 135, 138, 141, 146, 151, 156, 161, & + 164, 170, 174, 179, 183, 187, 194, 199, 203, 208, & + 216, 221, 226, 230, 235, 238, 241, 244, 248, 253, & + 257, 261, 265, 269, 273, 279, 282, 285, 291, 297, & + 304, 310, 315, 320, 323, 328, 333, 339, 344, 349, & + 357, 365, 373, 379, 385, 391, 397, 403, 409, 415, & + 421, 427, 435, 441, 447, 454, 460, 463, 467, 474, & + 483, 491, 499, 506, 511, 518, 524, 532, 540, 548, & + 556, 564, 572, 581, 590, 594, 603, 610, 617, 625, & + 632, 642, 655, 666, 677, 684, 690, 701, 714, 721, & + 732, 748, 759, 768, 778, 786, 791, 801, 804, 815, & + 824, 832, 841, 857, 864, 873, 884, 899, 912, 922, & + 929, 948, 969, 979, 999,1024,1045,1059,1073,1085, & + 1096,1103,1115,1129,1140,1153,1173,1193,1209,1221, & + 1232,1256,1288,1311,1332,1354,1386,1401,1415,1430, & + 1447,1463,1485,1526,1691,1749,1842,1950,1977,2017, & + 2070,2132,2156,2201,2226,2258,2285 /) - extfrc_lst(: 16) = (/ 'so4_a1 ','bc_a4 ','SVOC ','bc_a1 ','CO ', & - 'NO ','NO2 ','num_a1 ','num_a2 ','num_a4 ', & - 'pom_a1 ','pom_a4 ','so4_a2 ','SO2 ','AOA_NH ', & - 'N ' /) + extfrc_lst(: 14) = (/ 'num_a1 ','num_a2 ','so4_a1 ','so4_a2 ','num_a4 ', & + 'SO2 ','NO2 ','pom_a4 ','bc_a4 ','CO ', & + 'SVOC ','AOA_NH ','NO ','N ' /) - frc_from_dataset(: 16) = (/ .true., .true., .true., .true., .true., & + frc_from_dataset(: 14) = (/ .true., .true., .true., .true., .true., & .true., .true., .true., .true., .true., & - .true., .true., .true., .true., .false., & - .false. /) + .true., .false., .false., .false. /) inv_lst(: 3) = (/ 'M ', 'O2 ', 'N2 ' /) @@ -299,11 +303,11 @@ subroutine set_sim_dat 'jbigald2 ', 'jbigald3 ', & 'jbigald4 ', 'jbzooh ', & 'jc2h5ooh ', 'jc3h7ooh ', & - 'jc6h5ooh ', 'jch2o_a ', & - 'jch2o_b ', 'jch3cho ', & + 'jc6h5ooh ', 'jch2o_b ', & + 'jch2o_a ', 'jch3cho ', & 'jacet ', 'jmgly ', & 'jch3co3h ', 'jch3ooh ', & - 'jch4_a ', 'jch4_b ', & + 'jch4_b ', 'jch4_a ', & 'jco2 ', 'jeooh ', & 'jglyald ', 'jglyoxal ', & 'jhonitr ', 'jhpald ', & @@ -345,83 +349,83 @@ subroutine set_sim_dat 'jsoa2_a2 ', 'jsoa3_a1 ', & 'jsoa3_a2 ', 'jsoa4_a1 ', & 'jsoa4_a2 ', 'jsoa5_a1 ', & - 'jsoa5_a2 ', 'O1D_H2 ', & - 'O1D_H2O ', 'O1D_N2 ', & - 'O1D_O2ab ', 'O1D_O3 ', & - '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 ' /) - rxt_tag_lst( 201: 400) = (/ '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 ', & - 'F_CH4 ', 'F_H2 ', & - 'F_H2O ', 'F_HNO3 ', & - 'O1D_COF2 ', 'O1D_COFCL ', & - 'CH2BR2_CL ', 'CH2BR2_OH ', & - 'CH3BR_CL ', 'CH3BR_OH ', & - 'CH3CCL3_OH ', 'CH3CL_CL ', & - 'CH3CL_OH ', 'CHBR3_CL ', & - 'CHBR3_OH ', 'HCFC141B_OH ', & - 'HCFC142B_OH ', 'HCFC22_OH ', & - 'O1D_CH2BR2 ', 'O1D_CH3BR ', & - 'O1D_HCFC141B ', 'O1D_HCFC142B ', & - 'O1D_HCFC22 ', 'CH2O_HO2 ', & - 'CH2O_NO3 ', 'CH2O_O ', & - 'CH2O_OH ', 'CH3O2_CH3O2a ', & - 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & - 'CH3O2_NO ', 'CH3OH_OH ', & - 'CH3OOH_OH ', 'CH4_OH ', & - 'CO_OH_M ', 'HCN_OH ', & + 'jsoa5_a2 ', 'E90_tau ', & + 'O1D_H2 ', 'O1D_H2O ', & + 'O1D_N2 ', 'O1D_O2ab ', & + 'O1D_O3 ', '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 ' /) + rxt_tag_lst( 201: 400) = (/ '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 ', 'F_CH4 ', & + 'F_H2 ', 'F_H2O ', & + 'F_HNO3 ', 'O1D_COF2 ', & + 'O1D_COFCL ', 'CH2BR2_CL ', & + 'CH2BR2_OH ', 'CH3BR_CL ', & + 'CH3BR_OH ', 'CH3CCL3_OH ', & + 'CH3CL_CL ', 'CH3CL_OH ', & + 'CHBR3_CL ', 'CHBR3_OH ', & + 'HCFC141B_OH ', 'HCFC142B_OH ', & + 'HCFC22_OH ', 'O1D_CH2BR2 ', & + 'O1D_CH3BR ', 'O1D_HCFC141B ', & + 'O1D_HCFC142B ', 'O1D_HCFC22 ', & + 'CH2O_HO2 ', 'CH2O_NO3 ', & + 'CH2O_O ', 'CH2O_OH ', & + 'CH3O2_CH3O2a ', 'CH3O2_CH3O2b ', & + 'CH3O2_HO2 ', 'CH3O2_NO ', & + 'CH3OH_OH ', 'CH3OOH_OH ', & + 'CH4_OH ', 'HCN_OH ', & 'HCOOH_OH ', 'HOCH2OO_HO2 ', & 'HOCH2OO_M ', 'HOCH2OO_NO ', & 'O1D_CH4a ', 'O1D_CH4b ', & 'O1D_CH4c ', 'O1D_HCN ', & - 'usr_CO_OH_b ', 'C2H2_CL_M ', & + 'usr_CO_OH ', 'C2H2_CL_M ', & 'C2H2_OH_M ', 'C2H4_CL_M ', & 'C2H4_O3 ', 'C2H5O2_C2H5O2 ', & 'C2H5O2_CH3O2 ', 'C2H5O2_HO2 ', & @@ -460,7 +464,7 @@ subroutine set_sim_dat 'MEKO2_HO2 ', 'MEKO2_NO ', & 'MEK_OH ', 'MEKOOH_OH ', & 'MPAN_OH_M ', 'MVK_O3 ', & - 'MVK_OH ', 'usr_MCO3_NO2 ', & + 'MVK_OH ', 'tag_MCO3_NO2 ', & 'usr_MPAN_M ', 'ALKNIT_OH ', & 'ALKO2_HO2 ', 'ALKO2_NO ', & 'ALKO2_NOb ', 'ALKOOH_OH ', & @@ -484,7 +488,7 @@ subroutine set_sim_dat 'XOOH_OH ', 'ACBZO2_HO2 ', & 'ACBZO2_NO ', 'BENZENE_OH ', & 'BENZO2_HO2 ', 'BENZO2_NO ' /) - rxt_tag_lst( 401: 542) = (/ 'BENZOOH_OH ', 'BZALD_OH ', & + rxt_tag_lst( 401: 541) = (/ 'BENZOOH_OH ', 'BZALD_OH ', & 'BZOO_HO2 ', 'BZOOH_OH ', & 'BZOO_NO ', 'C6H5O2_HO2 ', & 'C6H5O2_NO ', 'C6H5OOH_OH ', & @@ -517,12 +521,12 @@ subroutine set_sim_dat 'TERPROD2_OH ', 'DMS_NO3 ', & 'DMS_OHa ', 'OCS_O ', & 'OCS_OH ', 'S_O2 ', & - 'S_O3 ', 'SO_BRO ', & - 'SO_CLO ', 'S_OH ', & - 'SO_NO2 ', 'SO_O2 ', & - 'SO_O3 ', 'SO_OCLO ', & - 'SO_OH ', 'usr_DMS_OH ', & - 'usr_SO2_OH ', 'usr_SO3_H2O ', & + '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_GLYOXAL_aer ', & 'usr_HO2_aer ', 'usr_HONITR_aer ', & 'usr_ISOPNITA_aer ', 'usr_ISOPNITB_aer ', & @@ -553,8 +557,8 @@ subroutine set_sim_dat 'het4 ', 'het5 ', & 'het6 ', 'het7 ', & 'het8 ', 'het9 ', & - 'E90_tau ', 'NH_50_tau ', & - 'NH_5_tau ', 'ST80_25_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, & @@ -609,7 +613,7 @@ subroutine set_sim_dat 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, & 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, & 531, 532, 533, 534, 535, 536, 537, 538, 539, 540, & - 541, 542 /) + 541 /) if( allocated( pht_alias_lst ) ) then deallocate( pht_alias_lst ) end if @@ -748,10 +752,10 @@ subroutine set_sim_dat write(iulog,*) 'set_sim_dat: failed to allocate cph_rid; error = ',ios call endrun end if - cph_rid(:) = (/ 126, 129, 130, 131, 134, & - 137, 138, 139, 140, 143, & - 144, 145, 148, 150, 154, & - 155, 163, 164 /) + cph_rid(:) = (/ 127, 130, 131, 132, 135, & + 138, 139, 140, 141, 144, & + 145, 146, 149, 151, 155, & + 156, 164, 165 /) 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, & @@ -761,21 +765,21 @@ subroutine set_sim_dat write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios call endrun end if - num_rnts(:) = (/ 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, & + num_rnts(:) = (/ 1, 2, 2, 2, 2, 2, 2, 3, 3, 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, 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, 2, & - 2, 3, 3, 2, 2, 1, 2, 2, 2, 2, & + 2, 2, 3, 2, 2, 1, 2, 2, 2, 2, & 2, 2, 3, 3, 3, 2, 2, 2, 2, 2, & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, & @@ -795,14 +799,14 @@ subroutine set_sim_dat 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, 2, 3, 2, 2, 2, 2, 2, 2, & 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, & 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & 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, 1, 2, & 1, 1, 1, 1, 2, 2, 2, 1, 1, 2, & - 2, 2, 1, 1, 2, 1, 1, 1, 1 /) + 2, 2, 1, 1, 2, 1, 1, 1 /) end subroutine set_sim_dat diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mech.doc b/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mech.doc index f9df589c20..c04fd319d5 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mech.doc +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mech.doc @@ -7,253 +7,261 @@ ( 4) bc_a1 (C) ( 5) bc_a4 (C) ( 6) BCARY (C15H24) - ( 7) BENZENE (C6H6) - ( 8) BENZOOH (C6H8O5) - ( 9) BEPOMUC (C6H6O3) - ( 10) BIGALD (C5H6O2) - ( 11) BIGALD1 (C4H4O2) - ( 12) BIGALD2 (C5H6O2) - ( 13) BIGALD3 (C5H6O2) - ( 14) BIGALD4 (C6H8O2) - ( 15) BIGALK (C5H12) - ( 16) BIGENE (C4H8) - ( 17) BR (Br) - ( 18) BRCL (BrCl) - ( 19) BRO (BrO) - ( 20) BRONO2 (BrONO2) - ( 21) BRY - ( 22) BZALD (C7H6O) - ( 23) BZOOH (C7H8O2) - ( 24) C2H2 - ( 25) C2H4 - ( 26) C2H5OH - ( 27) C2H5OOH - ( 28) C2H6 - ( 29) C3H6 - ( 30) C3H7OOH - ( 31) C3H8 - ( 32) C6H5OOH (C6H5OOH) - ( 33) CCL4 (CCl4) - ( 34) CF2CLBR (CF2ClBr) - ( 35) CF3BR (CF3Br) - ( 36) CFC11 (CFCl3) - ( 37) CFC113 (CCl2FCClF2) - ( 38) CFC114 (CClF2CClF2) - ( 39) CFC115 (CClF2CF3) - ( 40) CFC12 (CF2Cl2) - ( 41) CH2BR2 (CH2Br2) - ( 42) CH2O - ( 43) CH3BR (CH3Br) - ( 44) CH3CCL3 (CH3CCl3) - ( 45) CH3CHO - ( 46) CH3CL (CH3Cl) - ( 47) CH3CN - ( 48) CH3COCH3 - ( 49) CH3COCHO - ( 50) CH3COOH - ( 51) CH3COOOH - ( 52) CH3OH - ( 53) CH3OOH - ( 54) CH4 - ( 55) CHBR3 (CHBr3) - ( 56) CL (Cl) - ( 57) CL2 (Cl2) - ( 58) CL2O2 (Cl2O2) - ( 59) CLO (ClO) - ( 60) CLONO2 (ClONO2) - ( 61) CLY - ( 62) CO - ( 63) CO2 - ( 64) COF2 - ( 65) COFCL (COFCl) - ( 66) CRESOL (C7H8O) - ( 67) DMS (CH3SCH3) - ( 68) dst_a1 (AlSiO5) - ( 69) dst_a2 (AlSiO5) - ( 70) dst_a3 (AlSiO5) - ( 71) E90 (CO) - ( 72) EOOH (HOCH2CH2OOH) - ( 73) F - ( 74) GLYALD (HOCH2CHO) - ( 75) GLYOXAL (C2H2O2) - ( 76) H - ( 77) H2 - ( 78) H2402 (CBrF2CBrF2) - ( 79) H2O2 - ( 80) H2SO4 (H2SO4) - ( 81) HBR (HBr) - ( 82) HCFC141B (CH3CCl2F) - ( 83) HCFC142B (CH3CClF2) - ( 84) HCFC22 (CHF2Cl) - ( 85) HCL (HCl) - ( 86) HCN - ( 87) HCOOH - ( 88) HF - ( 89) HNO3 - ( 90) HO2NO2 - ( 91) HOBR (HOBr) - ( 92) HOCL (HOCl) - ( 93) HONITR (C4H9NO4) - ( 94) HPALD (HOOCH2CCH3CHCHO) - ( 95) HYAC (CH3COCH2OH) - ( 96) HYDRALD (HOCH2CCH3CHCHO) - ( 97) IEPOX (C5H10O3) - ( 98) ISOP (C5H8) - ( 99) ISOPNITA (C5H9NO4) - (100) ISOPNITB (C5H9NO4) - (101) ISOPNO3 (CH2CHCCH3OOCH2ONO2) - (102) ISOPNOOH (C5H9NO5) - (103) ISOPOOH (HOCH2COOHCH3CHCH2) - (104) IVOCbb (C13H28) - (105) IVOCff (C13H28) - (106) MACR (CH2CCH3CHO) - (107) MACROOH (CH3COCHOOHCH2OH) - (108) MEK (C4H8O) - (109) MEKOOH (C4H8O3) - (110) MPAN (CH2CCH3CO3NO2) - (111) MTERP (C10H16) - (112) MVK (CH2CHCOCH3) - (113) N - (114) N2O - (115) N2O5 - (116) NC4CH2OH (C5H9NO4) - (117) NC4CHO (C5H7NO4) - (118) ncl_a1 (NaCl) - (119) ncl_a2 (NaCl) - (120) ncl_a3 (NaCl) - (121) NH3 - (122) NH4 - (123) NO - (124) NO2 - (125) NO3 - (126) NOA (CH3COCH2ONO2) - (127) NTERPOOH (C10H17NO5) - (128) num_a1 (H) - (129) num_a2 (H) - (130) num_a3 (H) - (131) num_a4 (H) - (132) O - (133) O3 - (134) O3S (O3) - (135) OCLO (OClO) - (136) OCS (OCS) - (137) ONITR (C4H7NO4) - (138) PAN (CH3CO3NO2) - (139) PBZNIT (C7H5O3NO2) - (140) PHENO (C6H5O) - (141) PHENOL (C6H5OH) - (142) PHENOOH (C6H8O6) - (143) pombb1_a1 (C) - (144) pombb1_a4 (C) - (145) pomff1_a1 (C) - (146) pomff1_a4 (C) - (147) POOH (C3H6OHOOH) - (148) ROOH (CH3COCH2OOH) - (149) S (S) - (150) SF6 - (151) SO (SO) - (152) SO2 - (153) SO3 (SO3) - (154) so4_a1 (NH4HSO4) - (155) so4_a2 (NH4HSO4) - (156) so4_a3 (NH4HSO4) - (157) soabb1_a1 (C15H38O2) - (158) soabb1_a2 (C15H38O2) - (159) soabb2_a1 (C15H38O2) - (160) soabb2_a2 (C15H38O2) - (161) soabb3_a1 (C15H38O2) - (162) soabb3_a2 (C15H38O2) - (163) soabb4_a1 (C15H38O2) - (164) soabb4_a2 (C15H38O2) - (165) soabb5_a1 (C15H38O2) - (166) soabb5_a2 (C15H38O2) - (167) soabg1_a1 (C15H38O2) - (168) soabg1_a2 (C15H38O2) - (169) soabg2_a1 (C15H38O2) - (170) soabg2_a2 (C15H38O2) - (171) soabg3_a1 (C15H38O2) - (172) soabg3_a2 (C15H38O2) - (173) soabg4_a1 (C15H38O2) - (174) soabg4_a2 (C15H38O2) - (175) soabg5_a1 (C15H38O2) - (176) soabg5_a2 (C15H38O2) - (177) soaff1_a1 (C15H38O2) - (178) soaff1_a2 (C15H38O2) - (179) soaff2_a1 (C15H38O2) - (180) soaff2_a2 (C15H38O2) - (181) soaff3_a1 (C15H38O2) - (182) soaff3_a2 (C15H38O2) - (183) soaff4_a1 (C15H38O2) - (184) soaff4_a2 (C15H38O2) - (185) soaff5_a1 (C15H38O2) - (186) soaff5_a2 (C15H38O2) - (187) SOAGbb0 (C15H38O2) - (188) SOAGbb1 (C15H38O2) - (189) SOAGbb2 (C15H38O2) - (190) SOAGbb3 (C15H38O2) - (191) SOAGbb4 (C15H38O2) - (192) SOAGbg0 (C15H38O2) - (193) SOAGbg1 (C15H38O2) - (194) SOAGbg2 (C15H38O2) - (195) SOAGbg3 (C15H38O2) - (196) SOAGbg4 (C15H38O2) - (197) SOAGff0 (C15H38O2) - (198) SOAGff1 (C15H38O2) - (199) SOAGff2 (C15H38O2) - (200) SOAGff3 (C15H38O2) - (201) SOAGff4 (C15H38O2) - (202) SVOCbb (C22H46) - (203) SVOCff (C22H46) - (204) TEPOMUC (C7H8O3) - (205) TERP2OOH (C10H16O4) - (206) TERPNIT (C10H17NO4) - (207) TERPOOH (C10H18O3) - (208) TERPROD1 (C10H16O2) - (209) TERPROD2 (C9H14O2) - (210) TOLOOH (C7H10O5) - (211) TOLUENE (C7H8) - (212) XOOH (HOCH2COOHCH3CHOHCHO) - (213) XYLENES (C8H10) - (214) XYLENOOH (C8H12O5) - (215) XYLOL (C8H10O) - (216) XYLOLOOH (C8H12O6) - (217) NHDEP (N) - (218) NDEP (N) - (219) ACBZO2 (C7H5O3) - (220) ALKO2 (C5H11O2) - (221) BENZO2 (C6H7O5) - (222) BZOO (C7H7O2) - (223) C2H5O2 - (224) C3H7O2 - (225) C6H5O2 - (226) CH3CO3 - (227) CH3O2 - (228) DICARBO2 (C5H5O4) - (229) ENEO2 (C4H9O3) - (230) EO (HOCH2CH2O) - (231) EO2 (HOCH2CH2O2) - (232) HO2 - (233) HOCH2OO - (234) ISOPAO2 (HOC5H8O2) - (235) ISOPBO2 (HOC5H8O2) - (236) MACRO2 (CH3COCHO2CH2OH) - (237) MALO2 (C4H3O4) - (238) MCO3 (CH2CCH3CO3) - (239) MDIALO2 (C4H5O4) - (240) MEKO2 (C4H7O3) - (241) NTERPO2 (C10H16NO5) - (242) O1D (O) - (243) OH - (244) PHENO2 (C6H7O6) - (245) PO2 (C3H6OHO2) - (246) RO2 (CH3COCH2O2) - (247) TERP2O2 (C10H15O4) - (248) TERPO2 (C10H17O3) - (249) TOLO2 (C7H9O5) - (250) XO2 (HOCH2COOCH3CHOHCHO) - (251) XYLENO2 (C8H11O5) - (252) XYLOLO2 (C8H11O6) - (253) H2O + ( 7) BCARYO2VBS (C15H25O3) + ( 8) BENZENE (C6H6) + ( 9) BENZO2VBS (C6H7O5) + ( 10) BENZOOH (C6H8O5) + ( 11) BEPOMUC (C6H6O3) + ( 12) BIGALD (C5H6O2) + ( 13) BIGALD1 (C4H4O2) + ( 14) BIGALD2 (C5H6O2) + ( 15) BIGALD3 (C5H6O2) + ( 16) BIGALD4 (C6H8O2) + ( 17) BIGALK (C5H12) + ( 18) BIGENE (C4H8) + ( 19) BR (Br) + ( 20) BRCL (BrCl) + ( 21) BRO (BrO) + ( 22) BRONO2 (BrONO2) + ( 23) BRY + ( 24) BZALD (C7H6O) + ( 25) BZOOH (C7H8O2) + ( 26) C2H2 + ( 27) C2H4 + ( 28) C2H5OH + ( 29) C2H5OOH + ( 30) C2H6 + ( 31) C3H6 + ( 32) C3H7OOH + ( 33) C3H8 + ( 34) C6H5OOH (C6H5OOH) + ( 35) CCL4 (CCl4) + ( 36) CF2CLBR (CF2ClBr) + ( 37) CF3BR (CF3Br) + ( 38) CFC11 (CFCl3) + ( 39) CFC113 (CCl2FCClF2) + ( 40) CFC114 (CClF2CClF2) + ( 41) CFC115 (CClF2CF3) + ( 42) CFC12 (CF2Cl2) + ( 43) CH2BR2 (CH2Br2) + ( 44) CH2O + ( 45) CH3BR (CH3Br) + ( 46) CH3CCL3 (CH3CCl3) + ( 47) CH3CHO + ( 48) CH3CL (CH3Cl) + ( 49) CH3CN + ( 50) CH3COCH3 + ( 51) CH3COCHO + ( 52) CH3COOH + ( 53) CH3COOOH + ( 54) CH3OH + ( 55) CH3OOH + ( 56) CH4 + ( 57) CHBR3 (CHBr3) + ( 58) CL (Cl) + ( 59) CL2 (Cl2) + ( 60) CL2O2 (Cl2O2) + ( 61) CLO (ClO) + ( 62) CLONO2 (ClONO2) + ( 63) CLY + ( 64) CO + ( 65) CO2 + ( 66) COF2 + ( 67) COFCL (COFCl) + ( 68) CRESOL (C7H8O) + ( 69) DMS (CH3SCH3) + ( 70) dst_a1 (AlSiO5) + ( 71) dst_a2 (AlSiO5) + ( 72) dst_a3 (AlSiO5) + ( 73) E90 (CO) + ( 74) EOOH (HOCH2CH2OOH) + ( 75) F + ( 76) GLYALD (HOCH2CHO) + ( 77) GLYOXAL (C2H2O2) + ( 78) H + ( 79) H2 + ( 80) H2402 (CBrF2CBrF2) + ( 81) H2O2 + ( 82) H2SO4 (H2SO4) + ( 83) HBR (HBr) + ( 84) HCFC141B (CH3CCl2F) + ( 85) HCFC142B (CH3CClF2) + ( 86) HCFC22 (CHF2Cl) + ( 87) HCL (HCl) + ( 88) HCN + ( 89) HCOOH + ( 90) HF + ( 91) HNO3 + ( 92) HO2NO2 + ( 93) HOBR (HOBr) + ( 94) HOCL (HOCl) + ( 95) HONITR (C4H9NO4) + ( 96) HPALD (HOOCH2CCH3CHCHO) + ( 97) HYAC (CH3COCH2OH) + ( 98) HYDRALD (HOCH2CCH3CHCHO) + ( 99) IEPOX (C5H10O3) + (100) ISOP (C5H8) + (101) ISOPNITA (C5H9NO4) + (102) ISOPNITB (C5H9NO4) + (103) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + (104) ISOPNOOH (C5H9NO5) + (105) ISOPO2VBS (C5H9O3) + (106) ISOPOOH (HOCH2COOHCH3CHCH2) + (107) IVOCbb (C13H28) + (108) IVOCbbO2VBS (C13H29O3) + (109) IVOCff (C13H28) + (110) IVOCffO2VBS (C13H29O3) + (111) MACR (CH2CCH3CHO) + (112) MACROOH (CH3COCHOOHCH2OH) + (113) MEK (C4H8O) + (114) MEKOOH (C4H8O3) + (115) MPAN (CH2CCH3CO3NO2) + (116) MTERP (C10H16) + (117) MTERPO2VBS (C10H17O3) + (118) MVK (CH2CHCOCH3) + (119) N + (120) N2O + (121) N2O5 + (122) NC4CH2OH (C5H9NO4) + (123) NC4CHO (C5H7NO4) + (124) ncl_a1 (NaCl) + (125) ncl_a2 (NaCl) + (126) ncl_a3 (NaCl) + (127) NH3 + (128) NH4 + (129) NO + (130) NO2 + (131) NO3 + (132) NOA (CH3COCH2ONO2) + (133) NTERPOOH (C10H17NO5) + (134) num_a1 (H) + (135) num_a2 (H) + (136) num_a3 (H) + (137) num_a4 (H) + (138) O + (139) O3 + (140) O3S (O3) + (141) OCLO (OClO) + (142) OCS (OCS) + (143) ONITR (C4H7NO4) + (144) PAN (CH3CO3NO2) + (145) PBZNIT (C7H5O3NO2) + (146) PHENO (C6H5O) + (147) PHENOL (C6H5OH) + (148) PHENOOH (C6H8O6) + (149) pombb1_a1 (C) + (150) pombb1_a4 (C) + (151) pomff1_a1 (C) + (152) pomff1_a4 (C) + (153) POOH (C3H6OHOOH) + (154) ROOH (CH3COCH2OOH) + (155) S (S) + (156) SF6 + (157) SO (SO) + (158) SO2 + (159) SO3 (SO3) + (160) so4_a1 (NH4HSO4) + (161) so4_a2 (NH4HSO4) + (162) so4_a3 (NH4HSO4) + (163) soabb1_a1 (C15H38O2) + (164) soabb1_a2 (C15H38O2) + (165) soabb2_a1 (C15H38O2) + (166) soabb2_a2 (C15H38O2) + (167) soabb3_a1 (C15H38O2) + (168) soabb3_a2 (C15H38O2) + (169) soabb4_a1 (C15H38O2) + (170) soabb4_a2 (C15H38O2) + (171) soabb5_a1 (C15H38O2) + (172) soabb5_a2 (C15H38O2) + (173) soabg1_a1 (C15H38O2) + (174) soabg1_a2 (C15H38O2) + (175) soabg2_a1 (C15H38O2) + (176) soabg2_a2 (C15H38O2) + (177) soabg3_a1 (C15H38O2) + (178) soabg3_a2 (C15H38O2) + (179) soabg4_a1 (C15H38O2) + (180) soabg4_a2 (C15H38O2) + (181) soabg5_a1 (C15H38O2) + (182) soabg5_a2 (C15H38O2) + (183) soaff1_a1 (C15H38O2) + (184) soaff1_a2 (C15H38O2) + (185) soaff2_a1 (C15H38O2) + (186) soaff2_a2 (C15H38O2) + (187) soaff3_a1 (C15H38O2) + (188) soaff3_a2 (C15H38O2) + (189) soaff4_a1 (C15H38O2) + (190) soaff4_a2 (C15H38O2) + (191) soaff5_a1 (C15H38O2) + (192) soaff5_a2 (C15H38O2) + (193) SOAGbb0 (C15H38O2) + (194) SOAGbb1 (C15H38O2) + (195) SOAGbb2 (C15H38O2) + (196) SOAGbb3 (C15H38O2) + (197) SOAGbb4 (C15H38O2) + (198) SOAGbg0 (C15H38O2) + (199) SOAGbg1 (C15H38O2) + (200) SOAGbg2 (C15H38O2) + (201) SOAGbg3 (C15H38O2) + (202) SOAGbg4 (C15H38O2) + (203) SOAGff0 (C15H38O2) + (204) SOAGff1 (C15H38O2) + (205) SOAGff2 (C15H38O2) + (206) SOAGff3 (C15H38O2) + (207) SOAGff4 (C15H38O2) + (208) SVOCbb (C22H46) + (209) SVOCff (C22H46) + (210) TEPOMUC (C7H8O3) + (211) TERP2OOH (C10H16O4) + (212) TERPNIT (C10H17NO4) + (213) TERPOOH (C10H18O3) + (214) TERPROD1 (C10H16O2) + (215) TERPROD2 (C9H14O2) + (216) TOLOOH (C7H10O5) + (217) TOLUENE (C7H8) + (218) TOLUO2VBS (C7H9O5) + (219) XOOH (HOCH2COOHCH3CHOHCHO) + (220) XYLENES (C8H10) + (221) XYLENOOH (C8H12O5) + (222) XYLEO2VBS (C8H11O5) + (223) XYLOL (C8H10O) + (224) XYLOLOOH (C8H12O6) + (225) NHDEP (N) + (226) NDEP (N) + (227) ACBZO2 (C7H5O3) + (228) ALKO2 (C5H11O2) + (229) BENZO2 (C6H7O5) + (230) BZOO (C7H7O2) + (231) C2H5O2 + (232) C3H7O2 + (233) C6H5O2 + (234) CH3CO3 + (235) CH3O2 + (236) DICARBO2 (C5H5O4) + (237) ENEO2 (C4H9O3) + (238) EO (HOCH2CH2O) + (239) EO2 (HOCH2CH2O2) + (240) HO2 + (241) HOCH2OO + (242) ISOPAO2 (HOC5H8O2) + (243) ISOPBO2 (HOC5H8O2) + (244) MACRO2 (CH3COCHO2CH2OH) + (245) MALO2 (C4H3O4) + (246) MCO3 (CH2CCH3CO3) + (247) MDIALO2 (C4H5O4) + (248) MEKO2 (C4H7O3) + (249) NTERPO2 (C10H16NO5) + (250) O1D (O) + (251) OH + (252) PHENO2 (C6H7O6) + (253) PO2 (C3H6OHO2) + (254) RO2 (CH3COCH2O2) + (255) TERP2O2 (C10H15O4) + (256) TERPO2 (C10H17O3) + (257) TOLO2 (C7H9O5) + (258) XO2 (HOCH2COOCH3CHOHCHO) + (259) XYLENO2 (C8H11O5) + (260) XYLOLO2 (C8H11O6) + (261) H2O Invariant species @@ -270,262 +278,270 @@ Class List ========== Explicit -------- - ( 1) AOA_NH - ( 2) BRY - ( 3) CCL4 - ( 4) CF2CLBR - ( 5) CF3BR - ( 6) CFC11 - ( 7) CFC113 - ( 8) CFC114 - ( 9) CFC115 - ( 10) CFC12 - ( 11) CH2BR2 - ( 12) CH3BR - ( 13) CH3CCL3 - ( 14) CH3CL - ( 15) CH4 - ( 16) CHBR3 - ( 17) CLY - ( 18) CO2 - ( 19) E90 - ( 20) H2402 - ( 21) HCFC141B - ( 22) HCFC142B - ( 23) HCFC22 - ( 24) N2O - ( 25) SF6 - ( 26) NHDEP - ( 27) NDEP - ( 28) O3S + ( 1) NHDEP + ( 2) NDEP Implicit -------- ( 1) ALKNIT ( 2) ALKOOH - ( 3) bc_a1 - ( 4) bc_a4 - ( 5) BCARY - ( 6) BENZENE - ( 7) BENZOOH - ( 8) BEPOMUC - ( 9) BIGALD - ( 10) BIGALD1 - ( 11) BIGALD2 - ( 12) BIGALD3 - ( 13) BIGALD4 - ( 14) BIGALK - ( 15) BIGENE - ( 16) BR - ( 17) BRCL - ( 18) BRO - ( 19) BRONO2 - ( 20) BZALD - ( 21) BZOOH - ( 22) C2H2 - ( 23) C2H4 - ( 24) C2H5OH - ( 25) C2H5OOH - ( 26) C2H6 - ( 27) C3H6 - ( 28) C3H7OOH - ( 29) C3H8 - ( 30) C6H5OOH - ( 31) CH2O - ( 32) CH3CHO - ( 33) CH3CN - ( 34) CH3COCH3 - ( 35) CH3COCHO - ( 36) CH3COOH - ( 37) CH3COOOH - ( 38) CH3OH - ( 39) CH3OOH - ( 40) CL - ( 41) CL2 - ( 42) CL2O2 - ( 43) CLO - ( 44) CLONO2 - ( 45) CO - ( 46) COF2 - ( 47) COFCL - ( 48) CRESOL - ( 49) DMS - ( 50) dst_a1 - ( 51) dst_a2 - ( 52) dst_a3 - ( 53) EOOH - ( 54) F - ( 55) GLYALD - ( 56) GLYOXAL - ( 57) H - ( 58) H2 - ( 59) H2O2 - ( 60) H2SO4 - ( 61) HBR - ( 62) HCL - ( 63) HCN - ( 64) HCOOH - ( 65) HF - ( 66) HNO3 - ( 67) HO2NO2 - ( 68) HOBR - ( 69) HOCL - ( 70) HONITR - ( 71) HPALD - ( 72) HYAC - ( 73) HYDRALD - ( 74) IEPOX - ( 75) ISOP - ( 76) ISOPNITA - ( 77) ISOPNITB - ( 78) ISOPNO3 - ( 79) ISOPNOOH - ( 80) ISOPOOH - ( 81) IVOCbb - ( 82) IVOCff - ( 83) MACR - ( 84) MACROOH - ( 85) MEK - ( 86) MEKOOH - ( 87) MPAN - ( 88) MTERP - ( 89) MVK - ( 90) N - ( 91) N2O5 - ( 92) NC4CH2OH - ( 93) NC4CHO - ( 94) ncl_a1 - ( 95) ncl_a2 - ( 96) ncl_a3 - ( 97) NH3 - ( 98) NH4 - ( 99) NO - (100) NO2 - (101) NO3 - (102) NOA - (103) NTERPOOH - (104) num_a1 - (105) num_a2 - (106) num_a3 - (107) num_a4 - (108) O - (109) O3 - (110) OCLO - (111) OCS - (112) ONITR - (113) PAN - (114) PBZNIT - (115) PHENO - (116) PHENOL - (117) PHENOOH - (118) pombb1_a1 - (119) pombb1_a4 - (120) pomff1_a1 - (121) pomff1_a4 - (122) POOH - (123) ROOH - (124) S - (125) SO - (126) SO2 - (127) SO3 - (128) so4_a1 - (129) so4_a2 - (130) so4_a3 - (131) soabb1_a1 - (132) soabb1_a2 - (133) soabb2_a1 - (134) soabb2_a2 - (135) soabb3_a1 - (136) soabb3_a2 - (137) soabb4_a1 - (138) soabb4_a2 - (139) soabb5_a1 - (140) soabb5_a2 - (141) soabg1_a1 - (142) soabg1_a2 - (143) soabg2_a1 - (144) soabg2_a2 - (145) soabg3_a1 - (146) soabg3_a2 - (147) soabg4_a1 - (148) soabg4_a2 - (149) soabg5_a1 - (150) soabg5_a2 - (151) soaff1_a1 - (152) soaff1_a2 - (153) soaff2_a1 - (154) soaff2_a2 - (155) soaff3_a1 - (156) soaff3_a2 - (157) soaff4_a1 - (158) soaff4_a2 - (159) soaff5_a1 - (160) soaff5_a2 - (161) SOAGbb0 - (162) SOAGbb1 - (163) SOAGbb2 - (164) SOAGbb3 - (165) SOAGbb4 - (166) SOAGbg0 - (167) SOAGbg1 - (168) SOAGbg2 - (169) SOAGbg3 - (170) SOAGbg4 - (171) SOAGff0 - (172) SOAGff1 - (173) SOAGff2 - (174) SOAGff3 - (175) SOAGff4 - (176) SVOCbb - (177) SVOCff - (178) TEPOMUC - (179) TERP2OOH - (180) TERPNIT - (181) TERPOOH - (182) TERPROD1 - (183) TERPROD2 - (184) TOLOOH - (185) TOLUENE - (186) XOOH - (187) XYLENES - (188) XYLENOOH - (189) XYLOL - (190) XYLOLOOH - (191) ACBZO2 - (192) ALKO2 - (193) BENZO2 - (194) BZOO - (195) C2H5O2 - (196) C3H7O2 - (197) C6H5O2 - (198) CH3CO3 - (199) CH3O2 - (200) DICARBO2 - (201) ENEO2 - (202) EO - (203) EO2 - (204) HO2 - (205) HOCH2OO - (206) ISOPAO2 - (207) ISOPBO2 - (208) MACRO2 - (209) MALO2 - (210) MCO3 - (211) MDIALO2 - (212) MEKO2 - (213) NTERPO2 - (214) O1D - (215) OH - (216) PHENO2 - (217) PO2 - (218) RO2 - (219) TERP2O2 - (220) TERPO2 - (221) TOLO2 - (222) XO2 - (223) XYLENO2 - (224) XYLOLO2 - (225) H2O + ( 3) AOA_NH + ( 4) bc_a1 + ( 5) bc_a4 + ( 6) BCARY + ( 7) BCARYO2VBS + ( 8) BENZENE + ( 9) BENZO2VBS + ( 10) BENZOOH + ( 11) BEPOMUC + ( 12) BIGALD + ( 13) BIGALD1 + ( 14) BIGALD2 + ( 15) BIGALD3 + ( 16) BIGALD4 + ( 17) BIGALK + ( 18) BIGENE + ( 19) BR + ( 20) BRCL + ( 21) BRO + ( 22) BRONO2 + ( 23) BRY + ( 24) BZALD + ( 25) BZOOH + ( 26) C2H2 + ( 27) C2H4 + ( 28) C2H5OH + ( 29) C2H5OOH + ( 30) C2H6 + ( 31) C3H6 + ( 32) C3H7OOH + ( 33) C3H8 + ( 34) C6H5OOH + ( 35) CCL4 + ( 36) CF2CLBR + ( 37) CF3BR + ( 38) CFC11 + ( 39) CFC113 + ( 40) CFC114 + ( 41) CFC115 + ( 42) CFC12 + ( 43) CH2BR2 + ( 44) CH2O + ( 45) CH3BR + ( 46) CH3CCL3 + ( 47) CH3CHO + ( 48) CH3CL + ( 49) CH3CN + ( 50) CH3COCH3 + ( 51) CH3COCHO + ( 52) CH3COOH + ( 53) CH3COOOH + ( 54) CH3OH + ( 55) CH3OOH + ( 56) CH4 + ( 57) CHBR3 + ( 58) CL + ( 59) CL2 + ( 60) CL2O2 + ( 61) CLO + ( 62) CLONO2 + ( 63) CLY + ( 64) CO + ( 65) CO2 + ( 66) COF2 + ( 67) COFCL + ( 68) CRESOL + ( 69) DMS + ( 70) dst_a1 + ( 71) dst_a2 + ( 72) dst_a3 + ( 73) E90 + ( 74) EOOH + ( 75) F + ( 76) GLYALD + ( 77) GLYOXAL + ( 78) H + ( 79) H2 + ( 80) H2402 + ( 81) H2O2 + ( 82) H2SO4 + ( 83) HBR + ( 84) HCFC141B + ( 85) HCFC142B + ( 86) HCFC22 + ( 87) HCL + ( 88) HCN + ( 89) HCOOH + ( 90) HF + ( 91) HNO3 + ( 92) HO2NO2 + ( 93) HOBR + ( 94) HOCL + ( 95) HONITR + ( 96) HPALD + ( 97) HYAC + ( 98) HYDRALD + ( 99) IEPOX + (100) ISOP + (101) ISOPNITA + (102) ISOPNITB + (103) ISOPNO3 + (104) ISOPNOOH + (105) ISOPO2VBS + (106) ISOPOOH + (107) IVOCbb + (108) IVOCbbO2VBS + (109) IVOCff + (110) IVOCffO2VBS + (111) MACR + (112) MACROOH + (113) MEK + (114) MEKOOH + (115) MPAN + (116) MTERP + (117) MTERPO2VBS + (118) MVK + (119) N + (120) N2O + (121) N2O5 + (122) NC4CH2OH + (123) NC4CHO + (124) ncl_a1 + (125) ncl_a2 + (126) ncl_a3 + (127) NH3 + (128) NH4 + (129) NO + (130) NO2 + (131) NO3 + (132) NOA + (133) NTERPOOH + (134) num_a1 + (135) num_a2 + (136) num_a3 + (137) num_a4 + (138) O + (139) O3 + (140) O3S + (141) OCLO + (142) OCS + (143) ONITR + (144) PAN + (145) PBZNIT + (146) PHENO + (147) PHENOL + (148) PHENOOH + (149) pombb1_a1 + (150) pombb1_a4 + (151) pomff1_a1 + (152) pomff1_a4 + (153) POOH + (154) ROOH + (155) S + (156) SF6 + (157) SO + (158) SO2 + (159) SO3 + (160) so4_a1 + (161) so4_a2 + (162) so4_a3 + (163) soabb1_a1 + (164) soabb1_a2 + (165) soabb2_a1 + (166) soabb2_a2 + (167) soabb3_a1 + (168) soabb3_a2 + (169) soabb4_a1 + (170) soabb4_a2 + (171) soabb5_a1 + (172) soabb5_a2 + (173) soabg1_a1 + (174) soabg1_a2 + (175) soabg2_a1 + (176) soabg2_a2 + (177) soabg3_a1 + (178) soabg3_a2 + (179) soabg4_a1 + (180) soabg4_a2 + (181) soabg5_a1 + (182) soabg5_a2 + (183) soaff1_a1 + (184) soaff1_a2 + (185) soaff2_a1 + (186) soaff2_a2 + (187) soaff3_a1 + (188) soaff3_a2 + (189) soaff4_a1 + (190) soaff4_a2 + (191) soaff5_a1 + (192) soaff5_a2 + (193) SOAGbb0 + (194) SOAGbb1 + (195) SOAGbb2 + (196) SOAGbb3 + (197) SOAGbb4 + (198) SOAGbg0 + (199) SOAGbg1 + (200) SOAGbg2 + (201) SOAGbg3 + (202) SOAGbg4 + (203) SOAGff0 + (204) SOAGff1 + (205) SOAGff2 + (206) SOAGff3 + (207) SOAGff4 + (208) SVOCbb + (209) SVOCff + (210) TEPOMUC + (211) TERP2OOH + (212) TERPNIT + (213) TERPOOH + (214) TERPROD1 + (215) TERPROD2 + (216) TOLOOH + (217) TOLUENE + (218) TOLUO2VBS + (219) XOOH + (220) XYLENES + (221) XYLENOOH + (222) XYLEO2VBS + (223) XYLOL + (224) XYLOLOOH + (225) ACBZO2 + (226) ALKO2 + (227) BENZO2 + (228) BZOO + (229) C2H5O2 + (230) C3H7O2 + (231) C6H5O2 + (232) CH3CO3 + (233) CH3O2 + (234) DICARBO2 + (235) ENEO2 + (236) EO + (237) EO2 + (238) HO2 + (239) HOCH2OO + (240) ISOPAO2 + (241) ISOPBO2 + (242) MACRO2 + (243) MALO2 + (244) MCO3 + (245) MDIALO2 + (246) MEKO2 + (247) NTERPO2 + (248) O1D + (249) OH + (250) PHENO2 + (251) PO2 + (252) RO2 + (253) TERP2O2 + (254) TERPO2 + (255) TOLO2 + (256) XO2 + (257) XYLENO2 + (258) XYLOLO2 + (259) H2O Photolysis jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) @@ -562,8 +578,8 @@ Class List jc2h5ooh ( 29) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 29) jc3h7ooh ( 30) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 30) jc6h5ooh ( 31) C6H5OOH + hv -> PHENO + OH rate = ** User defined ** ( 31) - jch2o_a ( 32) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 32) - jch2o_b ( 33) CH2O + hv -> CO + H2 rate = ** User defined ** ( 33) + jch2o_b ( 32) CH2O + hv -> CO + H2 rate = ** User defined ** ( 32) + jch2o_a ( 33) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 33) jch3cho ( 34) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 34) jacet ( 35) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 35) jmgly ( 36) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 36) @@ -582,9 +598,9 @@ Class List jhpald ( 46) HPALD + hv -> BIGALD3 + OH + HO2 rate = ** User defined ** ( 46) jhyac ( 47) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 47) jisopnooh ( 48) ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH rate = ** User defined ** ( 48) - jisopooh ( 49) ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 rate = ** User defined ** ( 49) - jmacr_a ( 50) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 50) - jmacr_b ( 51) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 51) + jisopooh ( 49) ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + CH2O + HO2 rate = ** User defined ** ( 49) + jmacr_b ( 50) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 50) + jmacr_a ( 51) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 51) jmek ( 52) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 52) jmekooh ( 53) MEKOOH + hv -> OH + CH3CO3 + CH3CHO rate = ** User defined ** ( 53) jmpan ( 54) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 54) @@ -697,8 +713,8 @@ Class List H_HO2 ( 11) H + HO2 -> H2 + O2 rate = 6.90E-12 (154) H_HO2a ( 12) H + HO2 -> 2*OH rate = 7.20E-11 (155) H_HO2b ( 13) H + HO2 -> H2O + O rate = 1.60E-12 (156) - H_O2 ( 14) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (157) - ki=7.50E-11*(300/t)**-0.20 + H_O2 ( 14) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (157) + ki=9.50E-11*(300/t)**-0.40 f=0.60 HO2_O ( 15) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (158) HO2_O3 ( 16) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (159) @@ -713,23 +729,23 @@ Class List ki=2.60E-11 f=0.60 usr_HO2_HO2 ( 25) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (168) - HO2NO2_OH ( 26) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (169) + HO2NO2_OH ( 26) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (169) N_NO ( 27) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (170) N_NO2a ( 28) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (171) N_NO2b ( 29) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (172) N_NO2c ( 30) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (173) - N_O2 ( 31) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (174) + N_O2 ( 31) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (174) NO2_O ( 32) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (175) NO2_O3 ( 33) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (176) NO2_O_M ( 34) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (177) ki=2.20E-11*(300/t)**0.70 f=0.60 NO3_HO2 ( 35) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (178) - NO3_NO ( 36) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (179) - NO3_O ( 37) NO3 + O -> NO2 + O2 rate = 1.00E-11 (180) + NO3_NO ( 36) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (179) + NO3_O ( 37) NO3 + O -> NO2 + O2 rate = 1.30E-11 (180) NO3_OH ( 38) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (181) N_OH ( 39) N + OH -> NO + H rate = 5.00E-11 (182) - NO_HO2 ( 40) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (183) + NO_HO2 ( 40) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (183) NO_O3 ( 41) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (184) NO_O_M ( 42) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (185) ki=3.00E-11 @@ -822,7 +838,7 @@ Class List CH3BR_CL (116) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (259) CH3BR_OH (117) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (260) CH3CCL3_OH (118) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (261) - CH3CL_CL (119) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (262) + CH3CL_CL (119) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1110./t) (262) CH3CL_OH (120) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (263) CHBR3_CL (121) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (264) CHBR3_OH (122) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (265) @@ -845,286 +861,286 @@ Class List CH3OH_OH (139) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (282) CH3OOH_OH (140) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (283) CH4_OH (141) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (284) - CO_OH_M (142) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.00 (285) - ki=1.10E-12*(300/t)**-1.30 - f=0.60 - HCN_OH (143) HCN + OH + M -> HO2 + M troe : ko=4.28E-33 (286) - ki=9.30E-15*(300/t)**-4.42 + HCN_OH (142) HCN + OH + M -> HO2 + M troe : ko=6.10E-33*(300/t)**1.50 (285) + ki=9.80E-15*(300/t)**-4.60 f=0.80 - HCOOH_OH (144) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (287) - HOCH2OO_HO2 (145) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (288) - HOCH2OO_M (146) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (289) - HOCH2OO_NO (147) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (290) - O1D_CH4a (148) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (291) - O1D_CH4b (149) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (292) - O1D_CH4c (150) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (293) - O1D_HCN (151) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (294) - usr_CO_OH_b (152) CO + OH -> CO2 + H rate = ** User defined ** (295) - C2H2_CL_M (153) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (296) + HCOOH_OH (143) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (286) + HOCH2OO_HO2 (144) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (287) + HOCH2OO_M (145) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (288) + HOCH2OO_NO (146) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (289) + O1D_CH4a (147) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (290) + O1D_CH4b (148) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (291) + O1D_CH4c (149) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (292) + O1D_HCN (150) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (293) + usr_CO_OH (151) CO + OH -> CO2 + HO2 rate = ** User defined ** (294) + C2H2_CL_M (152) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (295) ki=2.20E-10*(300/t)**0.70 f=0.60 - C2H2_OH_M (154) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (297) + C2H2_OH_M (153) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (296) + 0.35*CO + M ki=8.30E-13*(300/t)**-2.00 f=0.60 - C2H4_CL_M (155) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (298) + C2H4_CL_M (154) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (297) ki=3.10E-10*(300/t) f=0.60 - C2H4_O3 (156) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (299) - C2H5O2_C2H5O2 (157) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (300) - C2H5O2_CH3O2 (158) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (301) + C2H4_O3 (155) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (298) + C2H5O2_C2H5O2 (156) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (299) + C2H5O2_CH3O2 (157) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (300) + 0.2*C2H5OH - C2H5O2_HO2 (159) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (302) - C2H5O2_NO (160) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (303) - C2H5OH_OH (161) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (304) - C2H5OOH_OH (162) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (305) - C2H6_CL (163) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (306) - C2H6_OH (164) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (307) - CH3CHO_NO3 (165) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (308) - CH3CHO_OH (166) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (309) - CH3CN_OH (167) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (310) - CH3CO3_CH3CO3 (168) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (311) - CH3CO3_CH3O2 (169) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (312) + C2H5O2_HO2 (158) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (301) + C2H5O2_NO (159) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (302) + C2H5OH_OH (160) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (303) + C2H5OOH_OH (161) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (304) + C2H6_CL (162) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (305) + C2H6_OH (163) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (306) + CH3CHO_NO3 (164) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (307) + CH3CHO_OH (165) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (308) + CH3CN_OH (166) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (309) + CH3CO3_CH3CO3 (167) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (310) + CH3CO3_CH3O2 (168) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (311) + 0.1*CH3COOH - CH3CO3_HO2 (170) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (313) + CH3CO3_HO2 (169) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (312) + 0.45*CH3O2 - CH3CO3_NO (171) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (314) - CH3COOH_OH (172) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 7.00E-13 (315) - CH3COOOH_OH (173) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (316) - EO2_HO2 (174) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (317) - EO2_NO (175) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (318) - EO_M (176) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (319) - EO_O2 (177) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (320) - GLYALD_OH (178) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (321) - GLYOXAL_OH (179) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (322) - PAN_OH (180) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (323) - tag_C2H4_OH (181) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (324) + CH3CO3_NO (170) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (313) + CH3COOH_OH (171) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 3.15E-14*exp( 920./t) (314) + CH3COOOH_OH (172) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (315) + EO2_HO2 (173) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (316) + EO2_NO (174) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (317) + EO_M (175) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (318) + EO_O2 (176) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (319) + GLYALD_OH (177) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (320) + GLYOXAL_OH (178) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (321) + PAN_OH (179) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (322) + tag_C2H4_OH (180) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (323) ki=9.00E-12*(300/t)**0.85 f=0.48 - tag_CH3CO3_NO2 (182) CH3CO3 + NO2 + M -> PAN + M troe : ko=9.70E-29*(300/t)**5.60 (325) - ki=9.30E-12*(300/t)**1.50 + tag_CH3CO3_NO2 (181) CH3CO3 + NO2 + M -> PAN + M troe : ko=7.30E-29*(300/t)**4.10 (324) + ki=9.50E-12*(300/t)**1.60 f=0.60 - usr_PAN_M (183) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (326) - C3H6_NO3 (184) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (327) - C3H6_O3 (185) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (328) + usr_PAN_M (182) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (325) + C3H6_NO3 (183) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (326) + C3H6_O3 (184) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (327) + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + 0.36*OH - C3H7O2_CH3O2 (186) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (329) - C3H7O2_HO2 (187) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (330) - C3H7O2_NO (188) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (331) - C3H7OOH_OH (189) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (332) - C3H8_OH (190) C3H8 + OH -> C3H7O2 + H2O rate = 8.70E-12*exp( -615./t) (333) - CH3COCHO_NO3 (191) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (334) - CH3COCHO_OH (192) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (335) - HYAC_OH (193) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (336) - NOA_OH (194) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (337) - PO2_HO2 (195) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (338) - PO2_NO (196) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (339) - POOH_OH (197) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (340) - RO2_CH3O2 (198) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (341) + C3H7O2_CH3O2 (185) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (328) + C3H7O2_HO2 (186) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (329) + C3H7O2_NO (187) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (330) + C3H7OOH_OH (188) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (331) + C3H8_OH (189) C3H8 + OH -> C3H7O2 + H2O rate = 9.19E-12*exp( -630./t) (332) + CH3COCHO_NO3 (190) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (333) + CH3COCHO_OH (191) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (334) + HYAC_OH (192) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (335) + NOA_OH (193) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (336) + PO2_HO2 (194) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (337) + PO2_NO (195) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (338) + POOH_OH (196) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (339) + RO2_CH3O2 (197) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (340) + 0.5*CH3COCHO + 0.5*CH3OH - RO2_HO2 (199) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (342) - RO2_NO (200) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (343) - ROOH_OH (201) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (344) - tag_C3H6_OH (202) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (345) + RO2_HO2 (198) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (341) + RO2_NO (199) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (342) + ROOH_OH (200) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (343) + tag_C3H6_OH (201) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (344) ki=3.00E-11 f=0.50 - usr_CH3COCH3_OH (203) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (346) - BIGENE_NO3 (204) BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 rate = 3.50E-13 (347) - BIGENE_OH (205) BIGENE + OH -> ENEO2 rate = 5.40E-11 (348) - ENEO2_NO (206) ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 rate = 4.80E-12*exp( 120./t) (349) - ENEO2_NOb (207) ENEO2 + NO -> HONITR rate = 5.10E-14*exp( 693./t) (350) - HONITR_OH (208) HONITR + OH -> ONITR + HO2 rate = 2.00E-12 (351) - MACRO2_CH3CO3 (209) MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 rate = 1.40E-11 (352) + usr_CH3COCH3_OH (202) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (345) + BIGENE_NO3 (203) BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 rate = 3.50E-13 (346) + BIGENE_OH (204) BIGENE + OH -> ENEO2 rate = 5.40E-11 (347) + ENEO2_NO (205) ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 rate = 4.80E-12*exp( 120./t) (348) + ENEO2_NOb (206) ENEO2 + NO -> HONITR rate = 5.10E-14*exp( 693./t) (349) + HONITR_OH (207) HONITR + OH -> ONITR + HO2 rate = 2.00E-12 (350) + MACRO2_CH3CO3 (208) MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 rate = 1.40E-11 (351) + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + 0.53*CH3CO3 - MACRO2_CH3O2 (210) MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO rate = 5.00E-13*exp( 400./t) (353) + MACRO2_CH3O2 (209) MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO rate = 5.00E-13*exp( 400./t) (352) + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + 0.23*HYAC - MACRO2_HO2 (211) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (354) - MACRO2_NO3 (212) MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO rate = 2.40E-12 (355) + MACRO2_HO2 (210) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (353) + MACRO2_NO3 (211) MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO rate = 2.40E-12 (354) + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 - MACRO2_NOa (213) MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD rate = 2.70E-12*exp( 360./t) (356) + MACRO2_NOa (212) MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD rate = 2.70E-12*exp( 360./t) (355) + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO - MACRO2_NOb (214) MACRO2 + NO -> HONITR rate = 1.30E-13*exp( 360./t) (357) - MACR_O3 (215) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (358) + MACRO2_NOb (213) MACRO2 + NO -> HONITR rate = 1.30E-13*exp( 360./t) (356) + MACR_O3 (214) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (357) + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 - MACR_OH (216) MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 rate = 9.60E-12*exp( 360./t) (359) - MACROOH_OH (217) MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 rate = 2.30E-11*exp( 200./t) (360) - MCO3_CH3CO3 (218) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (361) - MCO3_CH3O2 (219) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (362) - MCO3_HO2 (220) MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH rate = 4.30E-13*exp( 1040./t) (363) + MACR_OH (215) MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 rate = 9.60E-12*exp( 360./t) (358) + MACROOH_OH (216) MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 rate = 2.30E-11*exp( 200./t) (359) + MCO3_CH3CO3 (217) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (360) + MCO3_CH3O2 (218) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (361) + MCO3_HO2 (219) MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH rate = 4.30E-13*exp( 1040./t) (362) + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 - MCO3_MCO3 (221) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (364) - MCO3_NO (222) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (365) - MCO3_NO3 (223) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (366) - MEKO2_HO2 (224) MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 rate = 7.50E-13*exp( 700./t) (367) - MEKO2_NO (225) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (368) - MEK_OH (226) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (369) - MEKOOH_OH (227) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (370) - MPAN_OH_M (228) 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 (371) + MCO3_MCO3 (220) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (363) + MCO3_NO (221) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (364) + MCO3_NO3 (222) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (365) + MEKO2_HO2 (223) MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 rate = 7.50E-13*exp( 700./t) (366) + MEKO2_NO (224) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (367) + MEK_OH (225) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (368) + MEKOOH_OH (226) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (369) + MPAN_OH_M (227) 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 (370) + M + 0.5*NDEP ki=3.00E-11 f=0.50 - MVK_O3 (229) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (372) + MVK_O3 (228) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (371) + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH - MVK_OH (230) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (373) - usr_MCO3_NO2 (231) MCO3 + NO2 + M -> MPAN + M rate = ** User defined ** (374) - usr_MPAN_M (232) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (375) - ALKNIT_OH (233) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (376) - ALKO2_HO2 (234) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (377) - ALKO2_NO (235) ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK rate = 6.70E-12 (378) + MVK_OH (229) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (372) + usr_MCO3_NO2 (230) MCO3 + NO2 + M -> MPAN + M rate = ** User defined ** (373) + usr_MPAN_M (231) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (374) + ALKNIT_OH (232) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (375) + ALKO2_HO2 (233) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (376) + ALKO2_NO (234) ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK rate = 6.70E-12 (377) + NO2 - ALKO2_NOb (236) ALKO2 + NO -> ALKNIT rate = 5.40E-14*exp( 870./t) (379) - ALKOOH_OH (237) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (380) - BIGALK_OH (238) BIGALK + OH -> ALKO2 rate = 3.50E-12 (381) - HPALD_OH (239) HPALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (382) - HYDRALD_OH (240) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (383) - IEPOX_OH (241) IEPOX + OH -> XO2 rate = 1.30E-11 (384) - ISOPAO2_CH3CO3 (242) ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 rate = 1.40E-11 (385) - ISOPAO2_CH3O2 (243) ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR rate = 5.00E-13*exp( 400./t) (386) + ALKO2_NOb (235) ALKO2 + NO -> ALKNIT rate = 5.40E-14*exp( 870./t) (378) + ALKOOH_OH (236) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (379) + BIGALK_OH (237) BIGALK + OH -> ALKO2 rate = 3.50E-12 (380) + HPALD_OH (238) HPALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (381) + HYDRALD_OH (239) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (382) + IEPOX_OH (240) IEPOX + OH -> XO2 rate = 1.30E-11 (383) + ISOPAO2_CH3CO3 (241) ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 rate = 1.40E-11 (384) + ISOPAO2_CH3O2 (242) ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR rate = 5.00E-13*exp( 400./t) (385) + 0.44*MVK - ISOPAO2_HO2 (244) ISOPAO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (387) - ISOPAO2_NO (245) ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK rate = 4.40E-12*exp( 180./t) (388) + ISOPAO2_HO2 (243) ISOPAO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (386) + ISOPAO2_NO (244) ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK rate = 4.40E-12*exp( 180./t) (387) + 0.92*CH2O + 0.92*HO2 - ISOPAO2_NO3 (246) ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 rate = 2.40E-12 (389) - ISOPBO2_CH3CO3 (247) ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 rate = 1.40E-11 (390) - ISOPBO2_CH3O2 (248) ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD rate = 5.00E-13*exp( 400./t) (391) - ISOPBO2_HO2 (249) ISOPBO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (392) - ISOPBO2_M (250) ISOPBO2 -> HPALD + HO2 rate = 1.60E+09*exp( -8300./t) (393) - ISOPBO2_NO (251) ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 rate = 4.40E-12*exp( 180./t) (394) + ISOPAO2_NO3 (245) ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 rate = 2.40E-12 (388) + ISOPBO2_CH3CO3 (246) ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 rate = 1.40E-11 (389) + ISOPBO2_CH3O2 (247) ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD rate = 5.00E-13*exp( 400./t) (390) + ISOPBO2_HO2 (248) ISOPBO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (391) + ISOPBO2_M (249) ISOPBO2 -> HPALD + HO2 rate = 1.60E+09*exp( -8300./t) (392) + ISOPBO2_NO (250) ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 rate = 4.40E-12*exp( 180./t) (393) + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC - ISOPBO2_NO3 (252) ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL rate = 2.40E-12 (395) + ISOPBO2_NO3 (251) ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL rate = 2.40E-12 (394) + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC - ISOPNITA_OH (253) ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O rate = 4.00E-11 (396) + ISOPNITA_OH (252) ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O rate = 4.00E-11 (395) + 0.3*HONITR + 0.3*HO2 - ISOPNITB_OH (254) ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR rate = 4.00E-11 (397) - ISOP_NO3 (255) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (398) - ISOPNO3_CH3CO3 (256) ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 rate = 1.40E-11 (399) - ISOPNO3_CH3O2 (257) ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH rate = 5.00E-13*exp( 400./t) (400) + ISOPNITB_OH (253) ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR rate = 4.00E-11 (396) + ISOP_NO3 (254) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (397) + ISOPNO3_CH3CO3 (255) ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 rate = 1.40E-11 (398) + ISOPNO3_CH3O2 (256) ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH rate = 5.00E-13*exp( 400./t) (399) + 0.2*NC4CH2OH - ISOPNO3_HO2 (258) ISOPNO3 + HO2 -> ISOPNOOH rate = 8.00E-13*exp( 700./t) (401) - ISOPNO3_NO (259) ISOPNO3 + NO -> NC4CHO + NO2 + HO2 rate = 2.70E-12*exp( 360./t) (402) - ISOPNO3_NO3 (260) ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 rate = 2.40E-12 (403) - ISOPNOOH_OH (261) ISOPNOOH + OH -> NOA + HO2 rate = 4.00E-11 (404) - ISOP_O3 (262) ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH rate = 1.05E-14*exp( -2000./t) (405) + ISOPNO3_HO2 (257) ISOPNO3 + HO2 -> ISOPNOOH rate = 8.00E-13*exp( 700./t) (400) + ISOPNO3_NO (258) ISOPNO3 + NO -> NC4CHO + NO2 + HO2 rate = 2.70E-12*exp( 360./t) (401) + ISOPNO3_NO3 (259) ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 rate = 2.40E-12 (402) + ISOPNOOH_OH (260) ISOPNOOH + OH -> NOA + HO2 rate = 4.00E-11 (403) + ISOP_O3 (261) ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH rate = 1.05E-14*exp( -2000./t) (404) + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + 0.05*CH3O2 - ISOP_OH (263) ISOP + OH -> 0.6*ISOPAO2 + 0.4*ISOPBO2 rate = 2.54E-11*exp( 410./t) (406) - ISOPOOH_OH (264) ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH rate = 1.52E-11*exp( 200./t) (407) - NC4CH2OH_OH (265) NC4CH2OH + OH -> GLYALD + NOA + HO2 rate = 7.00E-11 (408) - NC4CHO_OH (266) NC4CHO + OH -> GLYOXAL + NOA + HO2 rate = 1.00E-10 (409) - XO2_CH3CO3 (267) XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (410) + ISOP_OH (262) ISOP + OH -> 0.6*ISOPAO2 + 0.4*ISOPBO2 rate = 2.54E-11*exp( 410./t) (405) + ISOPOOH_OH (263) ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH rate = 1.52E-11*exp( 200./t) (406) + NC4CH2OH_OH (264) NC4CH2OH + OH -> GLYALD + NOA + HO2 rate = 7.00E-11 (407) + NC4CHO_OH (265) NC4CHO + OH -> GLYOXAL + NOA + HO2 rate = 1.00E-10 (408) + XO2_CH3CO3 (266) XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (409) + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 - XO2_CH3O2 (268) XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO rate = 5.00E-13*exp( 400./t) (411) + XO2_CH3O2 (267) XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO rate = 5.00E-13*exp( 400./t) (410) + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD - XO2_HO2 (269) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (412) - XO2_NO (270) XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL rate = 2.70E-12*exp( 360./t) (413) + XO2_HO2 (268) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (411) + XO2_NO (269) XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL rate = 2.70E-12*exp( 360./t) (412) + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD - XO2_NO3 (271) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (414) + XO2_NO3 (270) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (413) + 0.25*CH3COCHO + 0.25*GLYALD - XOOH_OH (272) XOOH + OH -> 0.5*XO2 + 0.5*OH rate = 1.52E-12*exp( 200./t) (415) - ACBZO2_HO2 (273) ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH rate = 4.30E-13*exp( 1040./t) (416) - ACBZO2_NO (274) ACBZO2 + NO -> C6H5O2 + NO2 rate = 7.50E-12*exp( 290./t) (417) - BENZENE_OH (275) BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 rate = 2.30E-12*exp( -193./t) (418) - BENZO2_HO2 (276) BENZO2 + HO2 -> BENZOOH rate = 7.50E-13*exp( 700./t) (419) - BENZO2_NO (277) BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 rate = 2.60E-12*exp( 365./t) (420) - BENZOOH_OH (278) BENZOOH + OH -> BENZO2 rate = 3.80E-12*exp( 200./t) (421) - BZALD_OH (279) BZALD + OH -> ACBZO2 rate = 5.90E-12*exp( 225./t) (422) - BZOO_HO2 (280) BZOO + HO2 -> BZOOH rate = 7.50E-13*exp( 700./t) (423) - BZOOH_OH (281) BZOOH + OH -> BZOO rate = 3.80E-12*exp( 200./t) (424) - BZOO_NO (282) BZOO + NO -> BZALD + NO2 + HO2 rate = 2.60E-12*exp( 365./t) (425) - C6H5O2_HO2 (283) C6H5O2 + HO2 -> C6H5OOH rate = 7.50E-13*exp( 700./t) (426) - C6H5O2_NO (284) C6H5O2 + NO -> PHENO + NO2 rate = 2.60E-12*exp( 365./t) (427) - C6H5OOH_OH (285) C6H5OOH + OH -> C6H5O2 rate = 3.80E-12*exp( 200./t) (428) - CRESOL_OH (286) CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO rate = 4.70E-11 (429) - DICARBO2_HO2 (287) DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO rate = 4.30E-13*exp( 1040./t) (430) + XOOH_OH (271) XOOH + OH -> 0.5*XO2 + 0.5*OH rate = 1.52E-12*exp( 200./t) (414) + ACBZO2_HO2 (272) ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH rate = 4.30E-13*exp( 1040./t) (415) + ACBZO2_NO (273) ACBZO2 + NO -> C6H5O2 + NO2 rate = 7.50E-12*exp( 290./t) (416) + BENZENE_OH (274) BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 rate = 2.30E-12*exp( -193./t) (417) + BENZO2_HO2 (275) BENZO2 + HO2 -> BENZOOH rate = 7.50E-13*exp( 700./t) (418) + BENZO2_NO (276) BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 rate = 2.60E-12*exp( 365./t) (419) + BENZOOH_OH (277) BENZOOH + OH -> BENZO2 rate = 3.80E-12*exp( 200./t) (420) + BZALD_OH (278) BZALD + OH -> ACBZO2 rate = 5.90E-12*exp( 225./t) (421) + BZOO_HO2 (279) BZOO + HO2 -> BZOOH rate = 7.50E-13*exp( 700./t) (422) + BZOOH_OH (280) BZOOH + OH -> BZOO rate = 3.80E-12*exp( 200./t) (423) + BZOO_NO (281) BZOO + NO -> BZALD + NO2 + HO2 rate = 2.60E-12*exp( 365./t) (424) + C6H5O2_HO2 (282) C6H5O2 + HO2 -> C6H5OOH rate = 7.50E-13*exp( 700./t) (425) + C6H5O2_NO (283) C6H5O2 + NO -> PHENO + NO2 rate = 2.60E-12*exp( 365./t) (426) + C6H5OOH_OH (284) C6H5OOH + OH -> C6H5O2 rate = 3.80E-12*exp( 200./t) (427) + CRESOL_OH (285) CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO rate = 4.70E-11 (428) + DICARBO2_HO2 (286) DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO rate = 4.30E-13*exp( 1040./t) (429) + 0.33*CH3O2 - DICARBO2_NO (288) DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO rate = 7.50E-12*exp( 290./t) (431) + DICARBO2_NO (287) DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO rate = 7.50E-12*exp( 290./t) (430) + 0.83*CH3O2 - DICARBO2_NO2 (289) DICARBO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (432) + DICARBO2_NO2 (288) DICARBO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (431) ki=9.30E-12*(300/t)**1.50 f=0.60 - MALO2_HO2 (290) MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO rate = 4.30E-13*exp( 1040./t) (433) - MALO2_NO (291) MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 rate = 7.50E-12*exp( 290./t) (434) - MALO2_NO2 (292) MALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (435) + MALO2_HO2 (289) MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO rate = 4.30E-13*exp( 1040./t) (432) + MALO2_NO (290) MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 rate = 7.50E-12*exp( 290./t) (433) + MALO2_NO2 (291) MALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (434) ki=9.30E-12*(300/t)**1.50 f=0.60 - MDIALO2_HO2 (293) MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO rate = 4.30E-13*exp( 1040./t) (436) + MDIALO2_HO2 (292) MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO rate = 4.30E-13*exp( 1040./t) (435) + 0.07*CH3O2 + 0.07*GLYOXAL - MDIALO2_NO (294) MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO rate = 7.50E-12*exp( 290./t) (437) + MDIALO2_NO (293) MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO rate = 7.50E-12*exp( 290./t) (436) + 0.17*CH3O2 + 0.17*GLYOXAL - MDIALO2_NO2 (295) MDIALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (438) + MDIALO2_NO2 (294) MDIALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (437) ki=9.30E-12*(300/t)**1.50 f=0.60 - PHENO2_HO2 (296) PHENO2 + HO2 -> PHENOOH rate = 7.50E-13*exp( 700./t) (439) - PHENO2_NO (297) PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 rate = 2.60E-12*exp( 365./t) (440) - PHENOL_OH (298) PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO rate = 4.70E-13*exp( 1220./t) (441) - PHENO_NO2 (299) PHENO + NO2 -> NDEP rate = 2.10E-12 (442) - PHENO_O3 (300) PHENO + O3 -> C6H5O2 rate = 2.80E-13 (443) - PHENOOH_OH (301) PHENOOH + OH -> PHENO2 rate = 3.80E-12*exp( 200./t) (444) - tag_ACBZO2_NO2 (302) ACBZO2 + NO2 + M -> PBZNIT + M troe : ko=9.70E-29*(300/t)**5.60 (445) + PHENO2_HO2 (295) PHENO2 + HO2 -> PHENOOH rate = 7.50E-13*exp( 700./t) (438) + PHENO2_NO (296) PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 rate = 2.60E-12*exp( 365./t) (439) + PHENOL_OH (297) PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO rate = 4.70E-13*exp( 1220./t) (440) + PHENO_NO2 (298) PHENO + NO2 -> NDEP rate = 2.10E-12 (441) + PHENO_O3 (299) PHENO + O3 -> C6H5O2 rate = 2.80E-13 (442) + PHENOOH_OH (300) PHENOOH + OH -> PHENO2 rate = 3.80E-12*exp( 200./t) (443) + tag_ACBZO2_NO2 (301) ACBZO2 + NO2 + M -> PBZNIT + M troe : ko=9.70E-29*(300/t)**5.60 (444) ki=9.30E-12*(300/t)**1.50 f=0.60 - TOLO2_HO2 (303) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (446) - TOLO2_NO (304) TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = 2.60E-12*exp( 365./t) (447) + TOLO2_HO2 (302) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (445) + TOLO2_NO (303) TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = 2.60E-12*exp( 365./t) (446) + 0.2*BIGALD2 + 0.2*BIGALD3 - TOLOOH_OH (305) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (448) - TOLUENE_OH (306) TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 rate = 1.70E-12*exp( 352./t) (449) + TOLOOH_OH (304) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (447) + TOLUENE_OH (305) TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 rate = 1.70E-12*exp( 352./t) (448) + 0.28*HO2 - usr_PBZNIT_M (307) PBZNIT + M -> ACBZO2 + NO2 + M rate = ** User defined ** (450) - XYLENES_OH (308) XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO rate = 1.70E-11 (451) + usr_PBZNIT_M (306) PBZNIT + M -> ACBZO2 + NO2 + M rate = ** User defined ** (449) + XYLENES_OH (307) XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO rate = 1.70E-11 (450) + 0.56*XYLENO2 + 0.38*HO2 - XYLENO2_HO2 (309) XYLENO2 + HO2 -> XYLENOOH rate = 7.50E-13*exp( 700./t) (452) - XYLENO2_NO (310) XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = 2.60E-12*exp( 365./t) (453) + XYLENO2_HO2 (308) XYLENO2 + HO2 -> XYLENOOH rate = 7.50E-13*exp( 700./t) (451) + XYLENO2_NO (309) XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = 2.60E-12*exp( 365./t) (452) + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 - XYLENOOH_OH (311) XYLENOOH + OH -> XYLENO2 rate = 3.80E-12*exp( 200./t) (454) - XYLOLO2_HO2 (312) XYLOLO2 + HO2 -> XYLOLOOH rate = 7.50E-13*exp( 700./t) (455) - XYLOLO2_NO (313) XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO rate = 2.60E-12*exp( 365./t) (456) - XYLOL_OH (314) XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO rate = 8.40E-11 (457) - XYLOLOOH_OH (315) XYLOLOOH + OH -> XYLOLO2 rate = 3.80E-12*exp( 200./t) (458) - BCARY_NO3 (316) BCARY + NO3 -> NTERPO2 rate = 1.90E-11 (459) - BCARY_O3 (317) BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 1.20E-14 (460) + XYLENOOH_OH (310) XYLENOOH + OH -> XYLENO2 rate = 3.80E-12*exp( 200./t) (453) + XYLOLO2_HO2 (311) XYLOLO2 + HO2 -> XYLOLOOH rate = 7.50E-13*exp( 700./t) (454) + XYLOLO2_NO (312) XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO rate = 2.60E-12*exp( 365./t) (455) + XYLOL_OH (313) XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO rate = 8.40E-11 (456) + XYLOLOOH_OH (314) XYLOLOOH + OH -> XYLOLO2 rate = 3.80E-12*exp( 200./t) (457) + BCARY_NO3 (315) BCARY + NO3 -> NTERPO2 rate = 1.90E-11 (458) + BCARY_O3 (316) BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 1.20E-14 (459) + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 - BCARY_OH (318) BCARY + OH -> TERPO2 rate = 2.00E-10 (461) - MTERP_NO3 (319) MTERP + NO3 -> NTERPO2 rate = 1.20E-12*exp( 490./t) (462) - MTERP_O3 (320) MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 6.30E-16*exp( -580./t) (463) + BCARY_OH (317) BCARY + OH -> TERPO2 rate = 2.00E-10 (460) + MTERP_NO3 (318) MTERP + NO3 -> NTERPO2 rate = 1.20E-12*exp( 490./t) (461) + MTERP_O3 (319) MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 6.30E-16*exp( -580./t) (462) + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 - MTERP_OH (321) MTERP + OH -> TERPO2 rate = 1.20E-11*exp( 440./t) (464) - NTERPO2_CH3O2 (322) NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 rate = 2.00E-12*exp( 500./t) (465) + MTERP_OH (320) MTERP + OH -> TERPO2 rate = 1.20E-11*exp( 440./t) (463) + NTERPO2_CH3O2 (321) NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 rate = 2.00E-12*exp( 500./t) (464) + 0.5*TERPROD1 + 0.5*NO2 - NTERPO2_HO2 (323) NTERPO2 + HO2 -> NTERPOOH rate = 7.50E-13*exp( 700./t) (466) - NTERPO2_NO (324) NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP rate = 4.20E-12*exp( 180./t) (467) - NTERPO2_NO3 (325) NTERPO2 + NO3 -> 2*NO2 + TERPROD1 rate = 2.40E-12 (468) - NTERPOOH_OH (326) NTERPOOH + OH -> NTERPO2 rate = 2.00E-11 (469) - TERP2O2_CH3O2 (327) TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (470) + NTERPO2_HO2 (322) NTERPO2 + HO2 -> NTERPOOH rate = 7.50E-13*exp( 700./t) (465) + NTERPO2_NO (323) NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP rate = 4.20E-12*exp( 180./t) (466) + NTERPO2_NO3 (324) NTERPO2 + NO3 -> 2*NO2 + TERPROD1 rate = 2.40E-12 (467) + NTERPOOH_OH (325) NTERPOOH + OH -> NTERPO2 rate = 2.00E-11 (468) + TERP2O2_CH3O2 (326) TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (469) + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + 0.15*CH3COCH3 - TERP2O2_HO2 (328) TERP2O2 + HO2 -> TERP2OOH rate = 7.50E-13*exp( 700./t) (471) - TERP2O2_NO (329) TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 rate = 4.20E-12*exp( 180./t) (472) + TERP2O2_HO2 (327) TERP2O2 + HO2 -> TERP2OOH rate = 7.50E-13*exp( 700./t) (470) + TERP2O2_NO (328) TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 rate = 4.20E-12*exp( 180./t) (471) + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + 0.225*GLYALD - TERP2OOH_OH (330) TERP2OOH + OH -> TERP2O2 rate = 2.30E-11 (473) - TERPNIT_OH (331) TERPNIT + OH -> NO2 + TERPROD1 rate = 2.00E-11 (474) - TERPO2_CH3O2 (332) TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (475) + TERP2OOH_OH (329) TERP2OOH + OH -> TERP2O2 rate = 2.30E-11 (472) + TERPNIT_OH (330) TERPNIT + OH -> NO2 + TERPROD1 rate = 2.00E-11 (473) + TERPO2_CH3O2 (331) TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (474) + 0.025*CH3COCH3 - TERPO2_HO2 (333) TERPO2 + HO2 -> TERPOOH rate = 7.50E-13*exp( 700./t) (476) - TERPO2_NO (334) TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 rate = 4.20E-12*exp( 180./t) (477) + TERPO2_HO2 (332) TERPO2 + HO2 -> TERPOOH rate = 7.50E-13*exp( 700./t) (475) + TERPO2_NO (333) TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 rate = 4.20E-12*exp( 180./t) (476) + 0.8*TERPROD1 + 0.8*HO2 - TERPOOH_OH (335) TERPOOH + OH -> TERPO2 rate = 3.30E-11 (478) - TERPROD1_NO3 (336) TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP rate = 1.00E-12 (479) - TERPROD1_OH (337) TERPROD1 + OH -> TERP2O2 rate = 5.70E-11 (480) - TERPROD2_OH (338) TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 rate = 3.40E-11 (481) + TERPOOH_OH (334) TERPOOH + OH -> TERPO2 rate = 3.30E-11 (477) + TERPROD1_NO3 (335) TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP rate = 1.00E-12 (478) + TERPROD1_OH (336) TERPROD1 + OH -> TERP2O2 rate = 5.70E-11 (479) + TERPROD2_OH (337) TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 rate = 3.40E-11 (480) + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO - DMS_NO3 (339) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (482) - DMS_OHa (340) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (483) - OCS_O (341) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (484) - OCS_OH (342) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (485) - S_O2 (343) S + O2 -> SO + O rate = 2.30E-12 (486) + DMS_NO3 (338) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (481) + DMS_OHa (339) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (482) + OCS_O (340) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (483) + OCS_OH (341) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (484) + S_O2 (342) S + O2 -> SO + O rate = 2.30E-12 (485) + SO2_OH_M (343) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (486) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 S_O3 (344) S + O3 -> SO + O2 rate = 1.20E-11 (487) SO_BRO (345) SO + BRO -> SO2 + BR rate = 5.70E-11 (488) SO_CLO (346) SO + CLO -> SO2 + CL rate = 2.80E-11 (489) @@ -1133,71 +1149,107 @@ Class List SO_O2 (349) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (492) SO_O3 (350) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (493) SO_OCLO (351) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (494) - SO_OH (352) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (495) + SO_OH (352) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (495) usr_DMS_OH (353) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (496) - usr_SO2_OH (354) SO2 + OH -> SO3 + HO2 rate = ** User defined ** (497) - usr_SO3_H2O (355) SO3 + H2O -> H2SO4 rate = ** User defined ** (498) - NH3_OH (356) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (499) - usr_GLYOXAL_aer (357) GLYOXAL -> SOAGbg0 rate = ** User defined ** (500) - usr_HO2_aer (358) HO2 -> 0.5*H2O2 rate = ** User defined ** (501) - usr_HONITR_aer (359) HONITR -> HNO3 rate = ** User defined ** (502) - usr_ISOPNITA_aer (360) ISOPNITA -> HNO3 rate = ** User defined ** (503) - usr_ISOPNITB_aer (361) ISOPNITB -> HNO3 rate = ** User defined ** (504) - usr_N2O5_aer (362) N2O5 -> 2*HNO3 rate = ** User defined ** (505) - usr_NC4CH2OH_aer (363) NC4CH2OH -> HNO3 rate = ** User defined ** (506) - usr_NC4CHO_aer (364) NC4CHO -> HNO3 rate = ** User defined ** (507) - usr_NH4_strat_ta (365) NH4 -> NHDEP rate = 6.34E-08 (508) - usr_NO2_aer (366) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (509) - usr_NO3_aer (367) NO3 -> HNO3 rate = ** User defined ** (510) - usr_NTERPOOH_aer (368) NTERPOOH -> HNO3 rate = ** User defined ** (511) - usr_ONITR_aer (369) ONITR -> HNO3 rate = ** User defined ** (512) - usr_TERPNIT_aer (370) TERPNIT -> HNO3 rate = ** User defined ** (513) - BCARY_NO3_vbs (371) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 rate = 1.90E-11 (514) + usr_SO3_H2O (354) SO3 + H2O -> H2SO4 rate = ** User defined ** (497) + NH3_OH (355) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (498) + usr_HO2_aer (356) HO2 -> 0.5*H2O2 rate = ** User defined ** (499) + usr_HONITR_aer (357) HONITR -> HNO3 rate = ** User defined ** (500) + usr_ISOPNITA_aer (358) ISOPNITA -> HNO3 rate = ** User defined ** (501) + usr_ISOPNITB_aer (359) ISOPNITB -> HNO3 rate = ** User defined ** (502) + usr_N2O5_aer (360) N2O5 -> 2*HNO3 rate = ** User defined ** (503) + usr_NC4CH2OH_aer (361) NC4CH2OH -> HNO3 rate = ** User defined ** (504) + usr_NC4CHO_aer (362) NC4CHO -> HNO3 rate = ** User defined ** (505) + usr_NH4_strat_ta (363) NH4 -> NHDEP rate = 6.34E-08 (506) + usr_NO2_aer (364) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (507) + usr_NO3_aer (365) NO3 -> HNO3 rate = ** User defined ** (508) + usr_NTERPOOH_aer (366) NTERPOOH -> HNO3 rate = ** User defined ** (509) + usr_ONITR_aer (367) ONITR -> HNO3 rate = ** User defined ** (510) + usr_TERPNIT_aer (368) TERPNIT -> HNO3 rate = ** User defined ** (511) + BCARY_NO3_vbs (369) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 rate = 1.90E-11 (512) + BCARYO2_HO2_vbs (370) BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 rate = 2.75E-13*exp( 1300./t) (513) + + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + + 0.114*SOAGbg4 + BCARYO2_NO_vbs (371) BCARYO2VBS + NO -> NO + 0.1279*SOAGbg0 + 0.1792*SOAGbg1 rate = 2.70E-12*exp( 360./t) (514) + + 0.0676*SOAGbg2 + 0.079*SOAGbg3 + + 0.1254*SOAGbg4 BCARY_O3_vbs (372) BCARY + O3 -> BCARY + O3 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 rate = 1.20E-14 (515) + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 - BCARY_OH_vbs (373) BCARY + OH -> BCARY + OH + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 rate = 2.00E-10 (516) - + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 - BENZENE_OH_vbs (374) BENZENE + OH -> BENZENE + OH + 0.0023*SOAGff0 + 0.0008*SOAGff1 rate = 2.30E-12*exp( -193./t) (517) - + 0.0843*SOAGff2 + 0.0443*SOAGff3 + 0.1621*SOAGff4 - ISOP_NO3_vbs (375) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAGbg3 + 0.025024*SOAGbg4 rate = 3.03E-12*exp( -446./t) (518) - ISOP_O3_vbs (376) ISOP + O3 -> ISOP + O3 + 0.0033*SOAGbg3 rate = 1.05E-14*exp( -2000./t) (519) - ISOP_OH_vbs (377) ISOP + OH -> ISOP + OH + 0.0031*SOAGbg0 + 0.0035*SOAGbg1 rate = 2.54E-11*exp( 410./t) (520) - + 0.0003*SOAGbg2 + 0.0271*SOAGbg3 + 0.0474*SOAGbg4 - IVOCbb_OH (378) IVOCbb + OH -> OH + 0.2381*SOAGbb0 + 0.1308*SOAGbb1 rate = 1.34E-11 (521) - + 0.0348*SOAGbb2 + 0.0076*SOAGbb3 + 0.0113*SOAGbb4 - IVOCff_OH (379) IVOCff + OH -> OH + 0.2381*SOAGff0 + 0.1308*SOAGff1 rate = 1.34E-11 (522) - + 0.0348*SOAGff2 + 0.0076*SOAGff3 + 0.0113*SOAGff4 - MTERP_NO3_vbs (380) MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 rate = 1.20E-12*exp( 490./t) (523) - MTERP_O3_vbs (381) MTERP + O3 -> MTERP + O3 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 rate = 6.30E-16*exp( -580./t) (524) - + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 - MTERP_OH_vbs (382) MTERP + OH -> MTERP + OH + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 rate = 1.20E-11*exp( 440./t) (525) + BCARY_OH_vbs (373) BCARY + OH -> BCARY + OH + BCARYO2VBS rate = 2.00E-10 (516) + BENZENE_OH_vbs (374) BENZENE + OH -> BENZENE + OH + BENZO2VBS rate = 2.30E-12*exp( -193./t) (517) + BENZO2_HO2_vbs (375) BENZO2VBS + HO2 -> HO2 + 0.0023*SOAGff0 + 0.0008*SOAGff1 rate = 7.50E-13*exp( 700./t) (518) + + 0.0843*SOAGff2 + 0.0443*SOAGff3 + + 0.1621*SOAGff4 + BENZO2_NO_vbs (376) BENZO2VBS + NO -> NO + 0.0097*SOAGff0 + 0.0034*SOAGff1 rate = 2.60E-12*exp( 365./t) (519) + + 0.1579*SOAGff2 + 0.0059*SOAGff3 + + 0.0536*SOAGff4 + ISOP_NO3_vbs (377) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAGbg3 + 0.025024*SOAGbg4 rate = 3.03E-12*exp( -446./t) (520) + ISOPO2_HO2_vbs (378) ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAGbg0 + 0.0035*SOAGbg1 rate = 2.12E-13*exp( 1300./t) (521) + + 0.0003*SOAGbg2 + 0.0271*SOAGbg3 + + 0.0474*SOAGbg4 + ISOPO2_NO_vbs (379) ISOPO2VBS + NO -> NO + 0.0003*SOAGbg0 + 0.0003*SOAGbg1 rate = 2.70E-12*exp( 350./t) (522) + + 0.0073*SOAGbg2 + 0.0057*SOAGbg3 + + 0.0623*SOAGbg4 + ISOP_O3_vbs (380) ISOP + O3 -> ISOP + O3 + 0.0033*SOAGbg3 rate = 1.05E-14*exp( -2000./t) (523) + ISOP_OH_vbs (381) ISOP + OH -> ISOP + OH + ISOPO2VBS rate = 2.54E-11*exp( 410./t) (524) + IVOCbbO2_HO2_vbs (382) IVOCbbO2VBS + HO2 -> HO2 + 0.2381*SOAGbb0 + 0.1308*SOAGbb1 rate = 7.50E-13*exp( 700./t) (525) + + 0.0348*SOAGbb2 + 0.0076*SOAGbb3 + + 0.0113*SOAGbb4 + IVOCbbO2_NO_vbs (383) IVOCbbO2VBS + NO -> NO + 0.1056*SOAGbb0 + 0.1026*SOAGbb1 rate = 2.60E-12*exp( 365./t) (526) + + 0.0521*SOAGbb2 + 0.0143*SOAGbb3 + + 0.0166*SOAGbb4 + IVOCbb_OH_vbs (384) IVOCbb + OH -> OH + IVOCbbO2VBS rate = 1.34E-11 (527) + IVOCffO2_HO2_vbs (385) IVOCffO2VBS + HO2 -> HO2 + 0.2381*SOAGff0 + 0.1308*SOAGff1 rate = 7.50E-13*exp( 700./t) (528) + + 0.0348*SOAGff2 + 0.0076*SOAGff3 + + 0.0113*SOAGff4 + IVOCffO2_NO_vbs (386) IVOCffO2VBS + NO -> NO + 0.1056*SOAGff0 + 0.1026*SOAGff1 rate = 2.60E-12*exp( 365./t) (529) + + 0.0521*SOAGff2 + 0.0143*SOAGff3 + + 0.0166*SOAGff4 + IVOCff_OH_vbs (387) IVOCff + OH -> OH + IVOCffO2VBS rate = 1.34E-11 (530) + MTERP_NO3_vbs (388) MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 rate = 1.20E-12*exp( 490./t) (531) + MTERPO2_HO2_vbs (389) MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 rate = 2.60E-13*exp( 1300./t) (532) + + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + + 0.1278*SOAGbg4 + MTERPO2_NO_vbs (390) MTERPO2VBS + NO -> NO + 0.0245*SOAGbg0 + 0.0082*SOAGbg1 rate = 2.70E-12*exp( 360./t) (533) + + 0.0772*SOAGbg2 + 0.0332*SOAGbg3 + 0.13*SOAGbg4 + MTERP_O3_vbs (391) MTERP + O3 -> MTERP + O3 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 rate = 6.30E-16*exp( -580./t) (534) + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 - SVOCbb_OH (383) SVOCbb + OH -> OH + 0.5931*SOAGbb0 + 0.1534*SOAGbb1 rate = 1.34E-11 (526) + MTERP_OH_vbs (392) MTERP + OH -> MTERP + OH + MTERPO2VBS rate = 1.20E-11*exp( 440./t) (535) + SVOCbb_OH (393) SVOCbb + OH -> OH + 0.5931*SOAGbb0 + 0.1534*SOAGbb1 rate = 1.34E-11 (536) + 0.0459*SOAGbb2 + 0.0085*SOAGbb3 + 0.0128*SOAGbb4 - SVOCff_OH (384) SVOCff + OH -> OH + 0.5931*SOAGff0 + 0.1534*SOAGff1 rate = 1.34E-11 (527) + SVOCff_OH (394) SVOCff + OH -> OH + 0.5931*SOAGff0 + 0.1534*SOAGff1 rate = 1.34E-11 (537) + 0.0459*SOAGff2 + 0.0085*SOAGff3 + 0.0128*SOAGff4 - TOLUENE_OH_vbs (385) TOLUENE + OH -> TOLUENE + OH + 0.1364*SOAGff0 + 0.0101*SOAGff1 rate = 1.70E-12*exp( 352./t) (528) - + 0.0763*SOAGff2 + 0.2157*SOAGff3 + 0.0738*SOAGff4 - XYLENES_OH_vbs (386) XYLENES + OH -> XYLENES + OH + 0.1677*SOAGff0 + 0.0174*SOAGff1 rate = 1.70E-11 (529) - + 0.086*SOAGff2 + 0.0512*SOAGff3 + 0.1598*SOAGff4 - het1 (387) N2O5 -> 2*HNO3 rate = ** User defined ** (530) - het10 (388) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (531) - het11 (389) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (532) - het12 (390) N2O5 -> 2*HNO3 rate = ** User defined ** (533) - het13 (391) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (534) - het14 (392) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (535) - het15 (393) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (536) - het16 (394) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (537) - het17 (395) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (538) - het2 (396) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (539) - het3 (397) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (540) - het4 (398) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (541) - het5 (399) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (542) - het6 (400) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (543) - het7 (401) N2O5 -> 2*HNO3 rate = ** User defined ** (544) - het8 (402) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (545) - het9 (403) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (546) - E90_tau (404) E90 -> {sink} rate = 1.29E-07 (547) + TOLUENE_OH_vbs (395) TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS rate = 1.70E-12*exp( 352./t) (538) + TOLUO2_HO2_vbs (396) TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAGff0 + 0.0101*SOAGff1 rate = 7.50E-13*exp( 700./t) (539) + + 0.0763*SOAGff2 + 0.2157*SOAGff3 + + 0.0738*SOAGff4 + TOLUO2_NO_vbs (397) TOLUO2VBS + NO -> NO + 0.0154*SOAGff0 + 0.0452*SOAGff1 rate = 2.60E-12*exp( 365./t) (540) + + 0.0966*SOAGff2 + 0.0073*SOAGff3 + 0.238*SOAGff4 + usr_GLYOXAL_aer (398) GLYOXAL -> SOAGbg0 rate = ** User defined ** (541) + XYLENES_OH_vbs (399) XYLENES + OH -> XYLENES + OH + XYLEO2VBS rate = 1.70E-11 (542) + XYLEO2_HO2_vbs (400) XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAGff0 + 0.0174*SOAGff1 rate = 7.50E-13*exp( 700./t) (543) + + 0.086*SOAGff2 + 0.0512*SOAGff3 + + 0.1598*SOAGff4 + XYLEO2_NO_vbs (401) XYLEO2VBS + NO -> NO + 0.0063*SOAGff0 + 0.0237*SOAGff1 rate = 2.60E-12*exp( 365./t) (544) + + 0.0025*SOAGff2 + 0.011*SOAGff3 + 0.1185*SOAGff4 + het1 (402) N2O5 -> 2*HNO3 rate = ** User defined ** (545) + het10 (403) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (546) + het11 (404) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (547) + het12 (405) N2O5 -> 2*HNO3 rate = ** User defined ** (548) + het13 (406) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (549) + het14 (407) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (550) + het15 (408) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (551) + het16 (409) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (552) + het17 (410) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (553) + het2 (411) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (554) + het3 (412) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (555) + het4 (413) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (556) + het5 (414) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (557) + het6 (415) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (558) + het7 (416) N2O5 -> 2*HNO3 rate = ** User defined ** (559) + het8 (417) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (560) + het9 (418) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (561) + E90_tau (419) E90 -> {sink} rate = 1.29E-07 (562) Extraneous prod/loss species ( 1) bc_a1 (dataset) @@ -1222,34 +1274,38 @@ Extraneous prod/loss species Equation Report - d(ALKNIT)/dt = r236*ALKO2*NO - - j19*ALKNIT - r233*OH*ALKNIT - d(ALKOOH)/dt = r234*ALKO2*HO2 - - j20*ALKOOH - r237*OH*ALKOOH + d(ALKNIT)/dt = r235*ALKO2*NO + - j19*ALKNIT - r232*OH*ALKNIT + d(ALKOOH)/dt = r233*ALKO2*HO2 + - j20*ALKOOH - r236*OH*ALKOOH d(AOA_NH)/dt = 0 d(bc_a1)/dt = 0 d(bc_a4)/dt = 0 - d(BCARY)/dt = - r316*NO3*BCARY - r317*O3*BCARY - r318*OH*BCARY - d(BENZENE)/dt = - r275*OH*BENZENE - d(BENZOOH)/dt = r276*BENZO2*HO2 - - j21*BENZOOH - r278*OH*BENZOOH - d(BEPOMUC)/dt = .12*r275*BENZENE*OH + d(BCARY)/dt = - r315*NO3*BCARY - r316*O3*BCARY - r317*OH*BCARY + d(BCARYO2VBS)/dt = r373*BCARY*OH + - r370*HO2*BCARYO2VBS - r371*NO*BCARYO2VBS + d(BENZENE)/dt = - r274*OH*BENZENE + d(BENZO2VBS)/dt = r374*BENZENE*OH + - r375*HO2*BENZO2VBS - r376*NO*BENZO2VBS + d(BENZOOH)/dt = r275*BENZO2*HO2 + - j21*BENZOOH - r277*OH*BENZOOH + d(BEPOMUC)/dt = .12*r274*BENZENE*OH - j22*BEPOMUC - d(BIGALD)/dt = .1*r317*BCARY*O3 + .1*r320*MTERP*O3 + d(BIGALD)/dt = .1*r316*BCARY*O3 + .1*r319*MTERP*O3 - j23*BIGALD - d(BIGALD1)/dt = .5*j21*BENZOOH + j22*BEPOMUC + .2*j70*TOLOOH + .06*j72*XYLENOOH + .5*r277*BENZO2*NO - + .2*r304*TOLO2*NO + .06*r310*XYLENO2*NO + d(BIGALD1)/dt = .5*j21*BENZOOH + j22*BEPOMUC + .2*j70*TOLOOH + .06*j72*XYLENOOH + .5*r276*BENZO2*NO + + .2*r303*TOLO2*NO + .06*r309*XYLENO2*NO - j24*BIGALD1 - d(BIGALD2)/dt = .2*j70*TOLOOH + .2*j72*XYLENOOH + .2*r304*TOLO2*NO + .2*r310*XYLENO2*NO + d(BIGALD2)/dt = .2*j70*TOLOOH + .2*j72*XYLENOOH + .2*r303*TOLO2*NO + .2*r309*XYLENO2*NO - j25*BIGALD2 - d(BIGALD3)/dt = j46*HPALD + j56*NC4CHO + .2*j70*TOLOOH + .15*j72*XYLENOOH + .2*r304*TOLO2*NO - + .15*r310*XYLENO2*NO + d(BIGALD3)/dt = j46*HPALD + j56*NC4CHO + .2*j70*TOLOOH + .15*j72*XYLENOOH + .2*r303*TOLO2*NO + + .15*r309*XYLENO2*NO - j26*BIGALD3 - d(BIGALD4)/dt = .21*j72*XYLENOOH + .21*r310*XYLENO2*NO + d(BIGALD4)/dt = .21*j72*XYLENOOH + .21*r309*XYLENO2*NO - j27*BIGALD4 - d(BIGALK)/dt = .05*r317*BCARY*O3 + .05*r320*MTERP*O3 - - r238*OH*BIGALK - d(BIGENE)/dt = - r204*NO3*BIGENE - r205*OH*BIGENE + d(BIGALK)/dt = .05*r316*BCARY*O3 + .05*r319*MTERP*O3 + - r237*OH*BIGALK + d(BIGENE)/dt = - r203*NO3*BIGENE - r204*OH*BIGENE d(BR)/dt = j74*BRCL + j75*BRO + j77*BRONO2 + j79*CF2CLBR + j80*CF3BR + 2*j86*CH2BR2 + j87*CH3BR + 3*j90*CHBR3 + 2*j98*H2402 + j99*HBR + j105*HOBR + r77*O1D*CF2CLBR + 2*r90*BRO*BRO + r91*BRO*CLO + r92*BRO*CLO + r95*BRO*NO + r98*BRO*O + r99*BRO*OH + r100*HBR*O + r101*HBR*OH @@ -1257,32 +1313,32 @@ Extraneous prod/loss species + 2*r115*CH2BR2*OH + r116*CH3BR*CL + r117*CH3BR*OH + 3*r121*CHBR3*CL + 3*r122*CHBR3*OH + 2*r126*O1D*CH2BR2 + r127*O1D*CH3BR + r345*SO*BRO - r87*CH2O*BR - r88*HO2*BR - r89*O3*BR - d(BRCL)/dt = r93*BRO*CLO + r395*HOBR*HCL + r400*HOBR*HCL + d(BRCL)/dt = r93*BRO*CLO + r410*HOBR*HCL + r415*HOBR*HCL - j74*BRCL d(BRO)/dt = j76*BRONO2 + r89*BR*O3 + r97*BRONO2*O + r102*HOBR*O + r107*O1D*HBR - j75*BRO - 2*r90*BRO*BRO - r91*CLO*BRO - r92*CLO*BRO - r93*CLO*BRO - r94*HO2*BRO - r95*NO*BRO - r96*M*NO2*BRO - r98*O*BRO - r99*OH*BRO - r345*SO*BRO d(BRONO2)/dt = r96*M*BRO*NO2 - - j76*BRONO2 - j77*BRONO2 - r389*BRONO2 - r392*BRONO2 - r397*BRONO2 - r97*O*BRONO2 + - j76*BRONO2 - j77*BRONO2 - r404*BRONO2 - r407*BRONO2 - r412*BRONO2 - r97*O*BRONO2 d(BRY)/dt = 0 - d(BZALD)/dt = j28*BZOOH + r282*BZOO*NO - - r279*OH*BZALD - d(BZOOH)/dt = r280*BZOO*HO2 - - j28*BZOOH - r281*OH*BZOOH - d(C2H2)/dt = - r153*M*CL*C2H2 - r154*M*OH*C2H2 - d(C2H4)/dt = - r155*M*CL*C2H4 - r156*O3*C2H4 - r181*M*OH*C2H4 - d(C2H5OH)/dt = .4*r157*C2H5O2*C2H5O2 + .2*r158*C2H5O2*CH3O2 - - r161*OH*C2H5OH - d(C2H5OOH)/dt = r159*C2H5O2*HO2 - - j29*C2H5OOH - r162*OH*C2H5OOH - d(C2H6)/dt = - r163*CL*C2H6 - r164*OH*C2H6 - d(C3H6)/dt = .7*j55*MVK + .13*r262*ISOP*O3 - - r184*NO3*C3H6 - r185*O3*C3H6 - r202*M*OH*C3H6 - d(C3H7OOH)/dt = r187*C3H7O2*HO2 - - j30*C3H7OOH - r189*OH*C3H7OOH - d(C3H8)/dt = - r190*OH*C3H8 - d(C6H5OOH)/dt = r283*C6H5O2*HO2 - - j31*C6H5OOH - r285*OH*C6H5OOH + d(BZALD)/dt = j28*BZOOH + r281*BZOO*NO + - r278*OH*BZALD + d(BZOOH)/dt = r279*BZOO*HO2 + - j28*BZOOH - r280*OH*BZOOH + d(C2H2)/dt = - r152*M*CL*C2H2 - r153*M*OH*C2H2 + d(C2H4)/dt = - r154*M*CL*C2H4 - r155*O3*C2H4 - r180*M*OH*C2H4 + d(C2H5OH)/dt = .4*r156*C2H5O2*C2H5O2 + .2*r157*C2H5O2*CH3O2 + - r160*OH*C2H5OH + d(C2H5OOH)/dt = r158*C2H5O2*HO2 + - j29*C2H5OOH - r161*OH*C2H5OOH + d(C2H6)/dt = - r162*CL*C2H6 - r163*OH*C2H6 + d(C3H6)/dt = .7*j55*MVK + .13*r261*ISOP*O3 + - r183*NO3*C3H6 - r184*O3*C3H6 - r201*M*OH*C3H6 + d(C3H7OOH)/dt = r186*C3H7O2*HO2 + - j30*C3H7OOH - r188*OH*C3H7OOH + d(C3H8)/dt = - r189*OH*C3H8 + d(C6H5OOH)/dt = r282*C6H5O2*HO2 + - j31*C6H5OOH - r284*OH*C6H5OOH d(CCL4)/dt = - j78*CCL4 - r76*O1D*CCL4 d(CF2CLBR)/dt = - j79*CF2CLBR - r77*O1D*CF2CLBR d(CF3BR)/dt = - j80*CF3BR - r103*O1D*CF3BR @@ -1293,60 +1349,60 @@ Extraneous prod/loss species d(CFC12)/dt = - j85*CFC12 - r82*O1D*CFC12 d(CH2BR2)/dt = - j86*CH2BR2 - r114*CL*CH2BR2 - r115*OH*CH2BR2 - r126*O1D*CH2BR2 d(CH2O)/dt = .1*j19*ALKNIT + .1*j20*ALKOOH + j38*CH3OOH + .18*j39*CH4 + j43*GLYALD + .33*j45*HONITR - + j47*HYAC + .69*j49*ISOPOOH + 1.34*j50*MACR + j57*NOA + j62*POOH + j63*ROOH - + .375*j65*TERP2OOH + .4*j67*TERPOOH + .68*j69*TERPROD2 + r146*HOCH2OO + 2*r176*EO - + r58*CLO*CH3O2 + 2*r135*CH3O2*CH3O2 + r136*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH - + .3*r140*CH3OOH*OH + r149*O1D*CH4 + r150*O1D*CH4 + r156*C2H4*O3 + .7*r158*C2H5O2*CH3O2 - + r169*CH3CO3*CH3O2 + .5*r173*CH3COOOH*OH + .5*r175*EO2*NO + .8*r178*GLYALD*OH + r180*PAN*OH - + .5*r185*C3H6*O3 + r186*C3H7O2*CH3O2 + r196*PO2*NO + .8*r198*RO2*CH3O2 + .15*r199*RO2*HO2 - + r200*RO2*NO + .5*r204*BIGENE*NO3 + .5*r206*ENEO2*NO + .25*r209*MACRO2*CH3CO3 - + .88*r210*MACRO2*CH3O2 + .25*r212*MACRO2*NO3 + .25*r213*MACRO2*NO + .12*r215*MACR*O3 - + r218*MCO3*CH3CO3 + 2*r219*MCO3*CH3O2 + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + r222*MCO3*NO - + r223*MCO3*NO3 + .5*r228*M*MPAN*OH + .6*r229*MVK*O3 + .4*r233*ALKNIT*OH + .1*r235*ALKO2*NO - + r242*ISOPAO2*CH3CO3 + 1.5*r243*ISOPAO2*CH3O2 + .92*r245*ISOPAO2*NO + r246*ISOPAO2*NO3 - + .75*r248*ISOPBO2*CH3O2 + .3*r253*ISOPNITA*OH + .8*r257*ISOPNO3*CH3O2 + .91*r262*ISOP*O3 - + .25*r267*XO2*CH3CO3 + .8*r268*XO2*CH3O2 + .25*r270*XO2*NO + .34*r317*BCARY*O3 - + .34*r320*MTERP*O3 + .75*r322*NTERPO2*CH3O2 + .93*r327*TERP2O2*CH3O2 + .34*r329*TERP2O2*NO - + .95*r332*TERPO2*CH3O2 + .32*r334*TERPO2*NO + .68*r338*TERPROD2*OH + + j47*HYAC + j49*ISOPOOH + 1.34*j51*MACR + j57*NOA + j62*POOH + j63*ROOH + .375*j65*TERP2OOH + + .4*j67*TERPOOH + .68*j69*TERPROD2 + r145*HOCH2OO + 2*r175*EO + r58*CLO*CH3O2 + + 2*r135*CH3O2*CH3O2 + r136*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + .3*r140*CH3OOH*OH + + r148*O1D*CH4 + r149*O1D*CH4 + r155*C2H4*O3 + .7*r157*C2H5O2*CH3O2 + r168*CH3CO3*CH3O2 + + .5*r172*CH3COOOH*OH + .5*r174*EO2*NO + .8*r177*GLYALD*OH + r179*PAN*OH + .5*r184*C3H6*O3 + + r185*C3H7O2*CH3O2 + r195*PO2*NO + .8*r197*RO2*CH3O2 + .15*r198*RO2*HO2 + r199*RO2*NO + + .5*r203*BIGENE*NO3 + .5*r205*ENEO2*NO + .25*r208*MACRO2*CH3CO3 + .88*r209*MACRO2*CH3O2 + + .25*r211*MACRO2*NO3 + .25*r212*MACRO2*NO + .12*r214*MACR*O3 + r217*MCO3*CH3CO3 + + 2*r218*MCO3*CH3O2 + .45*r219*MCO3*HO2 + 2*r220*MCO3*MCO3 + r221*MCO3*NO + r222*MCO3*NO3 + + .5*r227*M*MPAN*OH + .6*r228*MVK*O3 + .4*r232*ALKNIT*OH + .1*r234*ALKO2*NO + + r241*ISOPAO2*CH3CO3 + 1.5*r242*ISOPAO2*CH3O2 + .92*r244*ISOPAO2*NO + r245*ISOPAO2*NO3 + + .75*r247*ISOPBO2*CH3O2 + .3*r252*ISOPNITA*OH + .8*r256*ISOPNO3*CH3O2 + .91*r261*ISOP*O3 + + .25*r266*XO2*CH3CO3 + .8*r267*XO2*CH3O2 + .25*r269*XO2*NO + .34*r316*BCARY*O3 + + .34*r319*MTERP*O3 + .75*r321*NTERPO2*CH3O2 + .93*r326*TERP2O2*CH3O2 + .34*r328*TERP2O2*NO + + .95*r331*TERPO2*CH3O2 + .32*r333*TERPO2*NO + .68*r337*TERPROD2*OH - j32*CH2O - j33*CH2O - r51*CL*CH2O - r87*BR*CH2O - r131*HO2*CH2O - r132*NO3*CH2O - r133*O*CH2O - r134*OH*CH2O d(CH3BR)/dt = - j87*CH3BR - r116*CL*CH3BR - r117*OH*CH3BR - r127*O1D*CH3BR d(CH3CCL3)/dt = - j88*CH3CCL3 - r118*OH*CH3CCL3 d(CH3CHO)/dt = .4*j19*ALKNIT + .4*j20*ALKOOH + j29*C2H5OOH + .33*j45*HONITR + j53*MEKOOH + j62*POOH - + 1.6*r157*C2H5O2*C2H5O2 + .8*r158*C2H5O2*CH3O2 + r160*C2H5O2*NO + r161*C2H5OH*OH - + .5*r162*C2H5OOH*OH + .5*r185*C3H6*O3 + .27*r188*C3H7O2*NO + r196*PO2*NO + r204*BIGENE*NO3 - + r206*ENEO2*NO + .2*r224*MEKO2*HO2 + r225*MEKO2*NO + .1*r229*MVK*O3 + .8*r233*ALKNIT*OH - + .4*r235*ALKO2*NO - - j34*CH3CHO - r165*NO3*CH3CHO - r166*OH*CH3CHO + + 1.6*r156*C2H5O2*C2H5O2 + .8*r157*C2H5O2*CH3O2 + r159*C2H5O2*NO + r160*C2H5OH*OH + + .5*r161*C2H5OOH*OH + .5*r184*C3H6*O3 + .27*r187*C3H7O2*NO + r195*PO2*NO + r203*BIGENE*NO3 + + r205*ENEO2*NO + .2*r223*MEKO2*HO2 + r224*MEKO2*NO + .1*r228*MVK*O3 + .8*r232*ALKNIT*OH + + .4*r234*ALKO2*NO + - j34*CH3CHO - r164*NO3*CH3CHO - r165*OH*CH3CHO d(CH3CL)/dt = - j89*CH3CL - r119*CL*CH3CL - r120*OH*CH3CL - d(CH3CN)/dt = - r167*OH*CH3CN + d(CH3CN)/dt = - r166*OH*CH3CN d(CH3COCH3)/dt = .25*j19*ALKNIT + .25*j20*ALKOOH + .82*j30*C3H7OOH + .17*j45*HONITR + .3*j65*TERP2OOH - + .05*j67*TERPOOH + .5*j69*TERPROD2 + .82*r186*C3H7O2*CH3O2 + .82*r188*C3H7O2*NO - + .5*r204*BIGENE*NO3 + .5*r206*ENEO2*NO + .8*r233*ALKNIT*OH + .25*r235*ALKO2*NO - + .52*r317*BCARY*O3 + .52*r320*MTERP*O3 + .15*r327*TERP2O2*CH3O2 + .27*r329*TERP2O2*NO - + .025*r332*TERPO2*CH3O2 + .04*r334*TERPO2*NO + .5*r338*TERPROD2*OH - - j35*CH3COCH3 - r203*OH*CH3COCH3 + + .05*j67*TERPOOH + .5*j69*TERPROD2 + .82*r185*C3H7O2*CH3O2 + .82*r187*C3H7O2*NO + + .5*r203*BIGENE*NO3 + .5*r205*ENEO2*NO + .8*r232*ALKNIT*OH + .25*r234*ALKO2*NO + + .52*r316*BCARY*O3 + .52*r319*MTERP*O3 + .15*r326*TERP2O2*CH3O2 + .27*r328*TERP2O2*NO + + .025*r331*TERPO2*CH3O2 + .04*r333*TERPO2*NO + .5*r337*TERPROD2*OH + - j35*CH3COCH3 - r202*OH*CH3COCH3 d(CH3COCHO)/dt = .18*j23*BIGALD + j27*BIGALD4 + .4*j70*TOLOOH + .54*j72*XYLENOOH + .51*j73*XYLOLOOH - + r193*HYAC*OH + r194*NOA*OH + .5*r198*RO2*CH3O2 + .25*r209*MACRO2*CH3CO3 - + .24*r210*MACRO2*CH3O2 + .25*r212*MACRO2*NO3 + .25*r213*MACRO2*NO + .88*r215*MACR*O3 - + .5*r229*MVK*O3 + .05*r251*ISOPBO2*NO + .05*r252*ISOPBO2*NO3 + .25*r267*XO2*CH3CO3 - + .1*r268*XO2*CH3O2 + .25*r270*XO2*NO + .25*r271*XO2*NO3 + .07*r287*DICARBO2*HO2 - + .17*r288*DICARBO2*NO + .07*r293*MDIALO2*HO2 + .17*r294*MDIALO2*NO + .4*r304*TOLO2*NO - + .54*r310*XYLENO2*NO + .51*r313*XYLOLO2*NO - - j36*CH3COCHO - r191*NO3*CH3COCHO - r192*OH*CH3COCHO - d(CH3COOH)/dt = .1*r169*CH3CO3*CH3O2 + .15*r170*CH3CO3*HO2 + .12*r185*C3H6*O3 + .15*r220*MCO3*HO2 - - r172*OH*CH3COOH - d(CH3COOOH)/dt = .4*r170*CH3CO3*HO2 + .4*r220*MCO3*HO2 - - j37*CH3COOOH - r173*OH*CH3COOOH - d(CH3OH)/dt = r136*CH3O2*CH3O2 + .3*r158*C2H5O2*CH3O2 + .5*r198*RO2*CH3O2 + .25*r210*MACRO2*CH3O2 - + .25*r243*ISOPAO2*CH3O2 + .25*r248*ISOPBO2*CH3O2 + .2*r257*ISOPNO3*CH3O2 + .3*r268*XO2*CH3O2 - + .25*r322*NTERPO2*CH3O2 + .25*r327*TERP2O2*CH3O2 + .25*r332*TERPO2*CH3O2 + + r192*HYAC*OH + r193*NOA*OH + .5*r197*RO2*CH3O2 + .25*r208*MACRO2*CH3CO3 + + .24*r209*MACRO2*CH3O2 + .25*r211*MACRO2*NO3 + .25*r212*MACRO2*NO + .88*r214*MACR*O3 + + .5*r228*MVK*O3 + .05*r250*ISOPBO2*NO + .05*r251*ISOPBO2*NO3 + .25*r266*XO2*CH3CO3 + + .1*r267*XO2*CH3O2 + .25*r269*XO2*NO + .25*r270*XO2*NO3 + .07*r286*DICARBO2*HO2 + + .17*r287*DICARBO2*NO + .07*r292*MDIALO2*HO2 + .17*r293*MDIALO2*NO + .4*r303*TOLO2*NO + + .54*r309*XYLENO2*NO + .51*r312*XYLOLO2*NO + - j36*CH3COCHO - r190*NO3*CH3COCHO - r191*OH*CH3COCHO + d(CH3COOH)/dt = .1*r168*CH3CO3*CH3O2 + .15*r169*CH3CO3*HO2 + .12*r184*C3H6*O3 + .15*r219*MCO3*HO2 + - r171*OH*CH3COOH + d(CH3COOOH)/dt = .4*r169*CH3CO3*HO2 + .4*r219*MCO3*HO2 + - j37*CH3COOOH - r172*OH*CH3COOOH + d(CH3OH)/dt = r136*CH3O2*CH3O2 + .3*r157*C2H5O2*CH3O2 + .5*r197*RO2*CH3O2 + .25*r209*MACRO2*CH3O2 + + .25*r242*ISOPAO2*CH3O2 + .25*r247*ISOPBO2*CH3O2 + .2*r256*ISOPNO3*CH3O2 + .3*r267*XO2*CH3O2 + + .25*r321*NTERPO2*CH3O2 + .25*r326*TERP2O2*CH3O2 + .25*r331*TERPO2*CH3O2 - r139*OH*CH3OH d(CH3OOH)/dt = r137*CH3O2*HO2 - j38*CH3OOH - r140*OH*CH3OOH - d(CH4)/dt = .1*r185*C3H6*O3 - - j39*CH4 - j40*CH4 - r52*CL*CH4 - r108*F*CH4 - r141*OH*CH4 - r148*O1D*CH4 - r149*O1D*CH4 - - r150*O1D*CH4 + d(CH4)/dt = .1*r184*C3H6*O3 + - j39*CH4 - j40*CH4 - r52*CL*CH4 - r108*F*CH4 - r141*OH*CH4 - r147*O1D*CH4 - r148*O1D*CH4 + - r149*O1D*CH4 d(CHBR3)/dt = - j90*CHBR3 - r104*O1D*CHBR3 - r121*CL*CHBR3 - r122*OH*CHBR3 d(CL)/dt = j74*BRCL + 4*j78*CCL4 + j79*CF2CLBR + 2*j81*CFC11 + 2*j82*CFC113 + 2*j83*CFC114 + j84*CFC115 + 2*j85*CFC12 + 3*j88*CH3CCL3 + j89*CH3CL + 2*j91*CL2 + 2*j92*CL2O2 + j93*CLO + j95*CLONO2 @@ -1358,9 +1414,9 @@ Extraneous prod/loss species + r128*O1D*HCFC141B + r129*O1D*HCFC142B + r130*O1D*HCFC22 + r346*SO*CLO - r51*CH2O*CL - r52*CH4*CL - r53*H2*CL - r54*H2O2*CL - r55*HO2*CL - r56*HO2*CL - r57*O3*CL - r64*CLONO2*CL - r73*HOCL*CL - r114*CH2BR2*CL - r116*CH3BR*CL - r119*CH3CL*CL - r121*CHBR3*CL - - r163*C2H6*CL - d(CL2)/dt = r60*CLO*CLO + r64*CLONO2*CL + r388*HOCL*HCL + r393*CLONO2*HCL + r394*HOCL*HCL + r398*CLONO2*HCL - + r399*HOCL*HCL + r403*CLONO2*HCL + - r162*C2H6*CL + d(CL2)/dt = r60*CLO*CLO + r64*CLONO2*CL + r403*HOCL*HCL + r408*CLONO2*HCL + r409*HOCL*HCL + r413*CLONO2*HCL + + r414*HOCL*HCL + r418*CLONO2*HCL - j91*CL2 d(CL2O2)/dt = r85*M*CLO*CLO - j92*CL2O2 - r86*M*CL2O2 @@ -1370,28 +1426,28 @@ Extraneous prod/loss species - r63*NO*CLO - r65*M*NO2*CLO - r68*O*CLO - r69*OH*CLO - r70*OH*CLO - 2*r85*M*CLO*CLO - r91*BRO*CLO - r92*BRO*CLO - r93*BRO*CLO - r346*SO*CLO d(CLONO2)/dt = r65*M*CLO*NO2 - - j94*CLONO2 - j95*CLONO2 - r391*CLONO2 - r396*CLONO2 - r402*CLONO2 - r64*CL*CLONO2 - - r66*O*CLONO2 - r67*OH*CLONO2 - r393*HCL*CLONO2 - r398*HCL*CLONO2 - r403*HCL*CLONO2 + - j94*CLONO2 - j95*CLONO2 - r406*CLONO2 - r411*CLONO2 - r417*CLONO2 - r64*CL*CLONO2 + - r66*O*CLONO2 - r67*OH*CLONO2 - r408*HCL*CLONO2 - r413*HCL*CLONO2 - r418*HCL*CLONO2 d(CLY)/dt = 0 d(CO)/dt = 1.5*j22*BEPOMUC + .45*j23*BIGALD + .6*j26*BIGALD3 + j27*BIGALD4 + j32*CH2O + j33*CH2O + j34*CH3CHO + j36*CH3COCHO + .38*j39*CH4 + j41*CO2 + j43*GLYALD + 2*j44*GLYOXAL - + .33*j45*HONITR + 1.34*j51*MACR + .7*j55*MVK + 1.5*j64*TEPOMUC + .25*j65*TERP2OOH + j68*TERPROD1 + + .33*j45*HONITR + 1.34*j50*MACR + .7*j55*MVK + 1.5*j64*TEPOMUC + .25*j65*TERP2OOH + j68*TERPROD1 + 1.7*j69*TERPROD2 + j110*OCS + r51*CL*CH2O + r87*BR*CH2O + r119*CH3CL*CL + r132*CH2O*NO3 - + r133*CH2O*O + r134*CH2O*OH + .35*r154*M*C2H2*OH + .63*r156*C2H4*O3 + r179*GLYOXAL*OH - + .56*r185*C3H6*O3 + r191*CH3COCHO*NO3 + r192*CH3COCHO*OH + .22*r209*MACRO2*CH3CO3 - + .11*r210*MACRO2*CH3O2 + .22*r212*MACRO2*NO3 + .22*r213*MACRO2*NO + .65*r215*MACR*O3 - + .56*r229*MVK*O3 + .62*r262*ISOP*O3 + .25*r267*XO2*CH3CO3 + .2*r268*XO2*CH3O2 + .25*r270*XO2*NO - + .5*r271*XO2*NO3 + .07*r287*DICARBO2*HO2 + .17*r288*DICARBO2*NO + .16*r290*MALO2*HO2 - + .4*r291*MALO2*NO + .14*r293*MDIALO2*HO2 + .35*r294*MDIALO2*NO + .23*r317*BCARY*O3 - + .23*r320*MTERP*O3 + .125*r327*TERP2O2*CH3O2 + .225*r329*TERP2O2*NO + .7*r338*TERPROD2*OH - + r341*OCS*O + r342*OCS*OH - - r142*M*OH*CO - r152*OH*CO - d(CO2)/dt = j37*CH3COOOH + .44*j39*CH4 + .4*j60*PAN + j65*TERP2OOH + .8*j69*TERPROD2 + r142*M*CO*OH - + r144*HCOOH*OH + r152*CO*OH + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + r171*CH3CO3*NO - + r172*CH3COOH*OH + .5*r173*CH3COOOH*OH + .8*r178*GLYALD*OH + r179*GLYOXAL*OH + .2*r185*C3H6*O3 - + 2*r218*MCO3*CH3CO3 + r219*MCO3*CH3O2 + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + .5*r228*M*MPAN*OH - + .1*r229*MVK*O3 + r242*ISOPAO2*CH3CO3 + r267*XO2*CH3CO3 + .27*r317*BCARY*O3 + .27*r320*MTERP*O3 - + .5*r327*TERP2O2*CH3O2 + .9*r329*TERP2O2*NO + 1.8*r338*TERPROD2*OH + + r133*CH2O*O + r134*CH2O*OH + .35*r153*M*C2H2*OH + .63*r155*C2H4*O3 + r178*GLYOXAL*OH + + .56*r184*C3H6*O3 + r190*CH3COCHO*NO3 + r191*CH3COCHO*OH + .22*r208*MACRO2*CH3CO3 + + .11*r209*MACRO2*CH3O2 + .22*r211*MACRO2*NO3 + .22*r212*MACRO2*NO + .65*r214*MACR*O3 + + .56*r228*MVK*O3 + .62*r261*ISOP*O3 + .25*r266*XO2*CH3CO3 + .2*r267*XO2*CH3O2 + .25*r269*XO2*NO + + .5*r270*XO2*NO3 + .07*r286*DICARBO2*HO2 + .17*r287*DICARBO2*NO + .16*r289*MALO2*HO2 + + .4*r290*MALO2*NO + .14*r292*MDIALO2*HO2 + .35*r293*MDIALO2*NO + .23*r316*BCARY*O3 + + .23*r319*MTERP*O3 + .125*r326*TERP2O2*CH3O2 + .225*r328*TERP2O2*NO + .7*r337*TERPROD2*OH + + r340*OCS*O + r341*OCS*OH + - r151*OH*CO + d(CO2)/dt = j37*CH3COOOH + .44*j39*CH4 + .4*j60*PAN + j65*TERP2OOH + .8*j69*TERPROD2 + r143*HCOOH*OH + + r151*CO*OH + 2*r167*CH3CO3*CH3CO3 + .9*r168*CH3CO3*CH3O2 + r170*CH3CO3*NO + r171*CH3COOH*OH + + .5*r172*CH3COOOH*OH + .8*r177*GLYALD*OH + r178*GLYOXAL*OH + .2*r184*C3H6*O3 + + 2*r217*MCO3*CH3CO3 + r218*MCO3*CH3O2 + .45*r219*MCO3*HO2 + 2*r220*MCO3*MCO3 + .5*r227*M*MPAN*OH + + .1*r228*MVK*O3 + r241*ISOPAO2*CH3CO3 + r266*XO2*CH3CO3 + .27*r316*BCARY*O3 + .27*r319*MTERP*O3 + + .5*r326*TERP2O2*CH3O2 + .9*r328*TERP2O2*NO + 1.8*r337*TERPROD2*OH - j41*CO2 d(COF2)/dt = j79*CF2CLBR + j80*CF3BR + j82*CFC113 + 2*j83*CFC114 + 2*j84*CFC115 + j85*CFC12 + 2*j98*H2402 + j101*HCFC142B + j102*HCFC22 + r77*O1D*CF2CLBR + r79*O1D*CFC113 + 2*r80*O1D*CFC114 @@ -1401,42 +1457,41 @@ Extraneous prod/loss species d(COFCL)/dt = j81*CFC11 + j82*CFC113 + j100*HCFC141B + r78*O1D*CFC11 + r79*O1D*CFC113 + r123*HCFC141B*OH + r128*O1D*HCFC141B - j97*COFCL - r113*O1D*COFCL - d(CRESOL)/dt = .18*r306*TOLUENE*OH - - r286*OH*CRESOL - d(DMS)/dt = - r339*NO3*DMS - r340*OH*DMS - r353*OH*DMS + d(CRESOL)/dt = .18*r305*TOLUENE*OH + - r285*OH*CRESOL + d(DMS)/dt = - r338*NO3*DMS - r339*OH*DMS - r353*OH*DMS d(dst_a1)/dt = 0 d(dst_a2)/dt = 0 d(dst_a3)/dt = 0 - d(E90)/dt = - r404*E90 - d(EOOH)/dt = r174*EO2*HO2 + d(E90)/dt = - r419*E90 + d(EOOH)/dt = r173*EO2*HO2 - j42*EOOH d(F)/dt = j80*CF3BR + j84*CFC115 + 2*j96*COF2 + j97*COFCL + j104*HF + r81*O1D*CFC115 + r103*O1D*CF3BR + 2*r112*O1D*COF2 + r113*O1D*COFCL - r108*CH4*F - r109*H2*F - r110*H2O*F - r111*HNO3*F - d(GLYALD)/dt = .33*j45*HONITR + .25*j65*TERP2OOH + r177*O2*EO + .53*r209*MACRO2*CH3CO3 + .26*r210*MACRO2*CH3O2 - + .53*r212*MACRO2*NO3 + .53*r213*MACRO2*NO + .05*r251*ISOPBO2*NO + .05*r252*ISOPBO2*NO3 - + .7*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH + r265*NC4CH2OH*OH + .25*r267*XO2*CH3CO3 - + .1*r268*XO2*CH3O2 + .25*r270*XO2*NO + .25*r271*XO2*NO3 + .125*r327*TERP2O2*CH3O2 - + .225*r329*TERP2O2*NO - - j43*GLYALD - r178*OH*GLYALD + d(GLYALD)/dt = .33*j45*HONITR + .25*j65*TERP2OOH + r176*O2*EO + .53*r208*MACRO2*CH3CO3 + .26*r209*MACRO2*CH3O2 + + .53*r211*MACRO2*NO3 + .53*r212*MACRO2*NO + .05*r250*ISOPBO2*NO + .05*r251*ISOPBO2*NO3 + + .7*r252*ISOPNITA*OH + .5*r253*ISOPNITB*OH + r264*NC4CH2OH*OH + .25*r266*XO2*CH3CO3 + + .1*r267*XO2*CH3O2 + .25*r269*XO2*NO + .25*r270*XO2*NO3 + .125*r326*TERP2O2*CH3O2 + + .225*r328*TERP2O2*NO + - j43*GLYALD - r177*OH*GLYALD d(GLYOXAL)/dt = j21*BENZOOH + .13*j23*BIGALD + .7*j61*PHENOOH + .6*j70*TOLOOH + .34*j72*XYLENOOH - + .17*j73*XYLOLOOH + .65*r154*M*C2H2*OH + .2*r178*GLYALD*OH + .05*r251*ISOPBO2*NO - + .05*r252*ISOPBO2*NO3 + r266*NC4CHO*OH + .25*r267*XO2*CH3CO3 + .1*r268*XO2*CH3O2 - + .25*r270*XO2*NO + .25*r271*XO2*NO3 + r277*BENZO2*NO + .16*r290*MALO2*HO2 + .4*r291*MALO2*NO - + .07*r293*MDIALO2*HO2 + .17*r294*MDIALO2*NO + .7*r297*PHENO2*NO + .6*r304*TOLO2*NO - + .34*r310*XYLENO2*NO + .17*r313*XYLOLO2*NO - - j44*GLYOXAL - r357*GLYOXAL - r179*OH*GLYOXAL - d(H)/dt = j2*H2O + 2*j3*H2O + 2*j32*CH2O + j38*CH3OOH + .33*j39*CH4 + j40*CH4 + j99*HBR + j103*HCL + + .17*j73*XYLOLOOH + .65*r153*M*C2H2*OH + .2*r177*GLYALD*OH + .05*r250*ISOPBO2*NO + + .05*r251*ISOPBO2*NO3 + r265*NC4CHO*OH + .25*r266*XO2*CH3CO3 + .1*r267*XO2*CH3O2 + + .25*r269*XO2*NO + .25*r270*XO2*NO3 + r276*BENZO2*NO + .16*r289*MALO2*HO2 + .4*r290*MALO2*NO + + .07*r292*MDIALO2*HO2 + .17*r293*MDIALO2*NO + .7*r296*PHENO2*NO + .6*r303*TOLO2*NO + + .34*r309*XYLENO2*NO + .17*r312*XYLOLO2*NO + - j44*GLYOXAL - r398*GLYOXAL - r178*OH*GLYOXAL + d(H)/dt = j2*H2O + 2*j3*H2O + 2*j33*CH2O + j38*CH3OOH + .33*j39*CH4 + j40*CH4 + j99*HBR + j103*HCL + j104*HF + r1*O1D*H2 + r9*H2*O + r18*OH*H2 + r21*OH*O + r39*N*OH + r53*CL*H2 + r84*O1D*HCL - + r107*O1D*HBR + r109*F*H2 + r134*CH2O*OH + r149*O1D*CH4 + r152*CO*OH + r342*OCS*OH + r347*S*OH - + r352*SO*OH + + r107*O1D*HBR + r109*F*H2 + r134*CH2O*OH + r148*O1D*CH4 + r341*OCS*OH + r347*S*OH + r352*SO*OH - r14*O2*M*H - r11*HO2*H - r12*HO2*H - r13*HO2*H - r17*O3*H - d(H2)/dt = j1*H2O + j33*CH2O + 1.4400001*j39*CH4 + r11*H*HO2 + r150*O1D*CH4 + d(H2)/dt = j1*H2O + j32*CH2O + 1.4400001*j39*CH4 + r11*H*HO2 + r149*O1D*CH4 - r1*O1D*H2 - r9*O*H2 - r18*OH*H2 - r53*CL*H2 - r109*F*H2 d(H2402)/dt = - j98*H2402 - r105*O1D*H2402 - d(H2O2)/dt = .5*r358*HO2 + r24*M*OH*OH + r25*HO2*HO2 + d(H2O2)/dt = .5*r356*HO2 + r24*M*OH*OH + r25*HO2*HO2 - j4*H2O2 - r10*O*H2O2 - r19*OH*H2O2 - r54*CL*H2O2 - d(H2SO4)/dt = r355*SO3*H2O + d(H2SO4)/dt = r354*SO3*H2O - j109*H2SO4 d(HBR)/dt = r87*BR*CH2O + r88*BR*HO2 - j99*HBR - r100*O*HBR - r101*OH*HBR - r106*O1D*HBR - r107*O1D*HBR @@ -1444,175 +1499,183 @@ Extraneous prod/loss species d(HCFC142B)/dt = - j101*HCFC142B - r124*OH*HCFC142B - r129*O1D*HCFC142B d(HCFC22)/dt = - j102*HCFC22 - r125*OH*HCFC22 - r130*O1D*HCFC22 d(HCL)/dt = r51*CL*CH2O + r52*CL*CH4 + r53*CL*H2 + r54*CL*H2O2 + r55*CL*HO2 + r70*CLO*OH + r73*HOCL*CL - + r114*CH2BR2*CL + r116*CH3BR*CL + 2*r119*CH3CL*CL + r121*CHBR3*CL + r163*C2H6*CL - - j103*HCL - r71*O*HCL - r72*OH*HCL - r83*O1D*HCL - r84*O1D*HCL - r388*HOCL*HCL - - r393*CLONO2*HCL - r394*HOCL*HCL - r395*HOBR*HCL - r398*CLONO2*HCL - r399*HOCL*HCL - - r400*HOBR*HCL - r403*CLONO2*HCL - d(HCN)/dt = - r143*M*OH*HCN - r151*O1D*HCN - d(HCOOH)/dt = r145*HOCH2OO*HO2 + r147*HOCH2OO*NO + .35*r154*M*C2H2*OH + .37*r156*C2H4*O3 + .12*r185*C3H6*O3 - + .33*r215*MACR*O3 + .12*r229*MVK*O3 + .11*r262*ISOP*O3 + .05*r317*BCARY*O3 + .05*r320*MTERP*O3 - - r144*OH*HCOOH + + r114*CH2BR2*CL + r116*CH3BR*CL + 2*r119*CH3CL*CL + r121*CHBR3*CL + r162*C2H6*CL + - j103*HCL - r71*O*HCL - r72*OH*HCL - r83*O1D*HCL - r84*O1D*HCL - r403*HOCL*HCL + - r408*CLONO2*HCL - r409*HOCL*HCL - r410*HOBR*HCL - r413*CLONO2*HCL - r414*HOCL*HCL + - r415*HOBR*HCL - r418*CLONO2*HCL + d(HCN)/dt = - r142*M*OH*HCN - r150*O1D*HCN + d(HCOOH)/dt = r144*HOCH2OO*HO2 + r146*HOCH2OO*NO + .35*r153*M*C2H2*OH + .37*r155*C2H4*O3 + .12*r184*C3H6*O3 + + .33*r214*MACR*O3 + .12*r228*MVK*O3 + .11*r261*ISOP*O3 + .05*r316*BCARY*O3 + .05*r319*MTERP*O3 + - r143*OH*HCOOH d(HF)/dt = r108*F*CH4 + r109*F*H2 + r110*F*H2O + r111*F*HNO3 - j104*HF - d(HNO3)/dt = r359*HONITR + r360*ISOPNITA + r361*ISOPNITB + 2*r362*N2O5 + r363*NC4CH2OH + r364*NC4CHO - + .5*r366*NO2 + r367*NO3 + r368*NTERPOOH + r369*ONITR + r370*TERPNIT + 2*r387*N2O5 - + r389*BRONO2 + 2*r390*N2O5 + r391*CLONO2 + r392*BRONO2 + r396*CLONO2 + r397*BRONO2 - + 2*r401*N2O5 + r402*CLONO2 + r47*M*NO2*OH + r132*CH2O*NO3 + r165*CH3CHO*NO3 - + r191*CH3COCHO*NO3 + r339*DMS*NO3 + r393*CLONO2*HCL + r398*CLONO2*HCL + r403*CLONO2*HCL + d(HNO3)/dt = r357*HONITR + r358*ISOPNITA + r359*ISOPNITB + 2*r360*N2O5 + r361*NC4CH2OH + r362*NC4CHO + + .5*r364*NO2 + r365*NO3 + r366*NTERPOOH + r367*ONITR + r368*TERPNIT + 2*r402*N2O5 + + r404*BRONO2 + 2*r405*N2O5 + r406*CLONO2 + r407*BRONO2 + r411*CLONO2 + r412*BRONO2 + + 2*r416*N2O5 + r417*CLONO2 + r47*M*NO2*OH + r132*CH2O*NO3 + r164*CH3CHO*NO3 + + r190*CH3COCHO*NO3 + r338*DMS*NO3 + r408*CLONO2*HCL + r413*CLONO2*HCL + r418*CLONO2*HCL - j9*HNO3 - r48*OH*HNO3 - r111*F*HNO3 d(HO2NO2)/dt = r45*M*NO2*HO2 - j10*HO2NO2 - j11*HO2NO2 - r49*M*HO2NO2 - r26*OH*HO2NO2 - d(HOBR)/dt = r389*BRONO2 + r392*BRONO2 + r397*BRONO2 + r94*BRO*HO2 - - j105*HOBR - r102*O*HOBR - r395*HCL*HOBR - r400*HCL*HOBR - d(HOCL)/dt = r391*CLONO2 + r396*CLONO2 + r402*CLONO2 + r62*CLO*HO2 + r67*CLONO2*OH - - j106*HOCL - r73*CL*HOCL - r74*O*HOCL - r75*OH*HOCL - r388*HCL*HOCL - r394*HCL*HOCL - - r399*HCL*HOCL - d(HONITR)/dt = r207*ENEO2*NO + r214*MACRO2*NO + .3*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH - - j45*HONITR - r359*HONITR - r208*OH*HONITR - d(HPALD)/dt = r250*ISOPBO2 - - j46*HPALD - r239*OH*HPALD - d(HYAC)/dt = .17*j45*HONITR + .5*r197*POOH*OH + .2*r198*RO2*CH3O2 + .22*r209*MACRO2*CH3CO3 - + .23*r210*MACRO2*CH3O2 + .22*r212*MACRO2*NO3 + .22*r213*MACRO2*NO + .5*r228*M*MPAN*OH - + .05*r251*ISOPBO2*NO + .05*r252*ISOPBO2*NO3 + .7*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH - + .25*r267*XO2*CH3CO3 + .1*r268*XO2*CH3O2 + .25*r270*XO2*NO + .25*r271*XO2*NO3 - - j47*HYAC - r193*OH*HYAC - d(HYDRALD)/dt = r247*ISOPBO2*CH3CO3 + .75*r248*ISOPBO2*CH3O2 + .87*r251*ISOPBO2*NO + .95*r252*ISOPBO2*NO3 - - r240*OH*HYDRALD - d(IEPOX)/dt = .6*r264*ISOPOOH*OH - - r241*OH*IEPOX - d(ISOP)/dt = - r255*NO3*ISOP - r262*O3*ISOP - r263*OH*ISOP - d(ISOPNITA)/dt = .08*r245*ISOPAO2*NO - - r360*ISOPNITA - r253*OH*ISOPNITA - d(ISOPNITB)/dt = .08*r251*ISOPBO2*NO - - r361*ISOPNITB - r254*OH*ISOPNITB - d(ISOPNO3)/dt = r255*ISOP*NO3 - - r256*CH3CO3*ISOPNO3 - r257*CH3O2*ISOPNO3 - r258*HO2*ISOPNO3 - r259*NO*ISOPNO3 - - r260*NO3*ISOPNO3 - d(ISOPNOOH)/dt = r258*ISOPNO3*HO2 - - j48*ISOPNOOH - r261*OH*ISOPNOOH - d(ISOPOOH)/dt = j48*ISOPNOOH + r244*ISOPAO2*HO2 + r249*ISOPBO2*HO2 - - j49*ISOPOOH - r264*OH*ISOPOOH - d(IVOCbb)/dt = - r378*OH*IVOCbb - d(IVOCff)/dt = - r379*OH*IVOCff - d(MACR)/dt = .288*j49*ISOPOOH + .39*r242*ISOPAO2*CH3CO3 + .31*r243*ISOPAO2*CH3O2 + .36*r245*ISOPAO2*NO - + .4*r246*ISOPAO2*NO3 + .3*r262*ISOP*O3 - - j50*MACR - j51*MACR - r215*O3*MACR - r216*OH*MACR - d(MACROOH)/dt = r211*MACRO2*HO2 - - r217*OH*MACROOH - d(MEK)/dt = .8*j19*ALKNIT + .8*j20*ALKOOH + .8*r235*ALKO2*NO - - j52*MEK - r226*OH*MEK - d(MEKOOH)/dt = .8*r224*MEKO2*HO2 - - j53*MEKOOH - r227*OH*MEKOOH - d(MPAN)/dt = r231*M*MCO3*NO2 - - j54*MPAN - r232*M*MPAN - r228*M*OH*MPAN - d(MTERP)/dt = - r319*NO3*MTERP - r320*O3*MTERP - r321*OH*MTERP - d(MVK)/dt = .402*j49*ISOPOOH + .61*r242*ISOPAO2*CH3CO3 + .44*r243*ISOPAO2*CH3O2 + .56*r245*ISOPAO2*NO - + .6*r246*ISOPAO2*NO3 + .2*r262*ISOP*O3 - - j55*MVK - r229*O3*MVK - r230*OH*MVK + d(HOBR)/dt = r404*BRONO2 + r407*BRONO2 + r412*BRONO2 + r94*BRO*HO2 + - j105*HOBR - r102*O*HOBR - r410*HCL*HOBR - r415*HCL*HOBR + d(HOCL)/dt = r406*CLONO2 + r411*CLONO2 + r417*CLONO2 + r62*CLO*HO2 + r67*CLONO2*OH + - j106*HOCL - r73*CL*HOCL - r74*O*HOCL - r75*OH*HOCL - r403*HCL*HOCL - r409*HCL*HOCL + - r414*HCL*HOCL + d(HONITR)/dt = r206*ENEO2*NO + r213*MACRO2*NO + .3*r252*ISOPNITA*OH + .5*r253*ISOPNITB*OH + - j45*HONITR - r357*HONITR - r207*OH*HONITR + d(HPALD)/dt = r249*ISOPBO2 + - j46*HPALD - r238*OH*HPALD + d(HYAC)/dt = .17*j45*HONITR + .5*r196*POOH*OH + .2*r197*RO2*CH3O2 + .22*r208*MACRO2*CH3CO3 + + .23*r209*MACRO2*CH3O2 + .22*r211*MACRO2*NO3 + .22*r212*MACRO2*NO + .5*r227*M*MPAN*OH + + .05*r250*ISOPBO2*NO + .05*r251*ISOPBO2*NO3 + .7*r252*ISOPNITA*OH + .5*r253*ISOPNITB*OH + + .25*r266*XO2*CH3CO3 + .1*r267*XO2*CH3O2 + .25*r269*XO2*NO + .25*r270*XO2*NO3 + - j47*HYAC - r192*OH*HYAC + d(HYDRALD)/dt = r246*ISOPBO2*CH3CO3 + .75*r247*ISOPBO2*CH3O2 + .87*r250*ISOPBO2*NO + .95*r251*ISOPBO2*NO3 + - r239*OH*HYDRALD + d(IEPOX)/dt = .6*r263*ISOPOOH*OH + - r240*OH*IEPOX + d(ISOP)/dt = - r254*NO3*ISOP - r261*O3*ISOP - r262*OH*ISOP + d(ISOPNITA)/dt = .08*r244*ISOPAO2*NO + - r358*ISOPNITA - r252*OH*ISOPNITA + d(ISOPNITB)/dt = .08*r250*ISOPBO2*NO + - r359*ISOPNITB - r253*OH*ISOPNITB + d(ISOPNO3)/dt = r254*ISOP*NO3 + - r255*CH3CO3*ISOPNO3 - r256*CH3O2*ISOPNO3 - r257*HO2*ISOPNO3 - r258*NO*ISOPNO3 + - r259*NO3*ISOPNO3 + d(ISOPNOOH)/dt = r257*ISOPNO3*HO2 + - j48*ISOPNOOH - r260*OH*ISOPNOOH + d(ISOPO2VBS)/dt = r381*ISOP*OH + - r378*HO2*ISOPO2VBS - r379*NO*ISOPO2VBS + d(ISOPOOH)/dt = j48*ISOPNOOH + r243*ISOPAO2*HO2 + r248*ISOPBO2*HO2 + - j49*ISOPOOH - r263*OH*ISOPOOH + d(IVOCbb)/dt = - r384*OH*IVOCbb + d(IVOCbbO2VBS)/dt = r384*IVOCbb*OH + - r382*HO2*IVOCbbO2VBS - r383*NO*IVOCbbO2VBS + d(IVOCff)/dt = - r387*OH*IVOCff + d(IVOCffO2VBS)/dt = r387*IVOCff*OH + - r385*HO2*IVOCffO2VBS - r386*NO*IVOCffO2VBS + d(MACR)/dt = .3*j49*ISOPOOH + .39*r241*ISOPAO2*CH3CO3 + .31*r242*ISOPAO2*CH3O2 + .36*r244*ISOPAO2*NO + + .4*r245*ISOPAO2*NO3 + .3*r261*ISOP*O3 + - j50*MACR - j51*MACR - r214*O3*MACR - r215*OH*MACR + d(MACROOH)/dt = r210*MACRO2*HO2 + - r216*OH*MACROOH + d(MEK)/dt = .8*j19*ALKNIT + .8*j20*ALKOOH + .8*r234*ALKO2*NO + - j52*MEK - r225*OH*MEK + d(MEKOOH)/dt = .8*r223*MEKO2*HO2 + - j53*MEKOOH - r226*OH*MEKOOH + d(MPAN)/dt = r230*M*MCO3*NO2 + - j54*MPAN - r231*M*MPAN - r227*M*OH*MPAN + d(MTERP)/dt = - r318*NO3*MTERP - r319*O3*MTERP - r320*OH*MTERP + d(MTERPO2VBS)/dt = r392*MTERP*OH + - r389*HO2*MTERPO2VBS - r390*NO*MTERPO2VBS + d(MVK)/dt = .7*j49*ISOPOOH + .61*r241*ISOPAO2*CH3CO3 + .44*r242*ISOPAO2*CH3O2 + .56*r244*ISOPAO2*NO + + .6*r245*ISOPAO2*NO3 + .2*r261*ISOP*O3 + - j55*MVK - r228*O3*MVK - r229*OH*MVK d(N)/dt = j15*NO - r31*O2*N - r27*NO*N - r28*NO2*N - r29*NO2*N - r30*NO2*N - r39*OH*N d(N2O)/dt = r28*N*NO2 - j12*N2O - r43*O1D*N2O - r44*O1D*N2O d(N2O5)/dt = r46*M*NO2*NO3 - - j13*N2O5 - j14*N2O5 - r50*M*N2O5 - r362*N2O5 - r387*N2O5 - r390*N2O5 - r401*N2O5 - d(NC4CH2OH)/dt = .2*r257*ISOPNO3*CH3O2 - - r363*NC4CH2OH - r265*OH*NC4CH2OH - d(NC4CHO)/dt = r256*ISOPNO3*CH3CO3 + .8*r257*ISOPNO3*CH3O2 + r259*ISOPNO3*NO + r260*ISOPNO3*NO3 - - j56*NC4CHO - r364*NC4CHO - r266*OH*NC4CHO + - j13*N2O5 - j14*N2O5 - r50*M*N2O5 - r360*N2O5 - r402*N2O5 - r405*N2O5 - r416*N2O5 + d(NC4CH2OH)/dt = .2*r256*ISOPNO3*CH3O2 + - r361*NC4CH2OH - r264*OH*NC4CH2OH + d(NC4CHO)/dt = r255*ISOPNO3*CH3CO3 + .8*r256*ISOPNO3*CH3O2 + r258*ISOPNO3*NO + r259*ISOPNO3*NO3 + - j56*NC4CHO - r362*NC4CHO - r265*OH*NC4CHO d(ncl_a1)/dt = 0 d(ncl_a2)/dt = 0 d(ncl_a3)/dt = 0 - d(NH3)/dt = - r356*OH*NH3 - d(NH4)/dt = - r365*NH4 - d(NO)/dt = j13*N2O5 + j16*NO2 + j17*NO3 + r31*O2*N + .5*r366*NO2 + 2*r29*N*NO2 + r32*NO2*O + r39*N*OH + d(NH3)/dt = - r355*OH*NH3 + d(NH4)/dt = - r363*NH4 + d(NO)/dt = j13*N2O5 + j16*NO2 + j17*NO3 + r31*O2*N + .5*r364*NO2 + 2*r29*N*NO2 + r32*NO2*O + r39*N*OH + 2*r43*O1D*N2O + r348*SO*NO2 - j15*NO - r27*N*NO - r36*NO3*NO - r40*HO2*NO - r41*O3*NO - r42*M*O*NO - r63*CLO*NO - - r95*BRO*NO - r138*CH3O2*NO - r147*HOCH2OO*NO - r160*C2H5O2*NO - r171*CH3CO3*NO - r175*EO2*NO - - r188*C3H7O2*NO - r196*PO2*NO - r200*RO2*NO - r206*ENEO2*NO - r207*ENEO2*NO - r213*MACRO2*NO - - r214*MACRO2*NO - r222*MCO3*NO - r225*MEKO2*NO - r235*ALKO2*NO - r236*ALKO2*NO - r245*ISOPAO2*NO - - r251*ISOPBO2*NO - r259*ISOPNO3*NO - r270*XO2*NO - r274*ACBZO2*NO - r277*BENZO2*NO - - r282*BZOO*NO - r284*C6H5O2*NO - r288*DICARBO2*NO - r291*MALO2*NO - r294*MDIALO2*NO - - r297*PHENO2*NO - r304*TOLO2*NO - r310*XYLENO2*NO - r313*XYLOLO2*NO - r324*NTERPO2*NO - - r329*TERP2O2*NO - r334*TERPO2*NO + - r95*BRO*NO - r138*CH3O2*NO - r146*HOCH2OO*NO - r159*C2H5O2*NO - r170*CH3CO3*NO - r174*EO2*NO + - r187*C3H7O2*NO - r195*PO2*NO - r199*RO2*NO - r205*ENEO2*NO - r206*ENEO2*NO - r212*MACRO2*NO + - r213*MACRO2*NO - r221*MCO3*NO - r224*MEKO2*NO - r234*ALKO2*NO - r235*ALKO2*NO - r244*ISOPAO2*NO + - r250*ISOPBO2*NO - r258*ISOPNO3*NO - r269*XO2*NO - r273*ACBZO2*NO - r276*BENZO2*NO + - r281*BZOO*NO - r283*C6H5O2*NO - r287*DICARBO2*NO - r290*MALO2*NO - r293*MDIALO2*NO + - r296*PHENO2*NO - r303*TOLO2*NO - r309*XYLENO2*NO - r312*XYLOLO2*NO - r323*NTERPO2*NO + - r328*TERP2O2*NO - r333*TERPO2*NO d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j14*N2O5 + j18*NO3 + j19*ALKNIT + j45*HONITR + j48*ISOPNOOH + j54*MPAN + j56*NC4CHO + j57*NOA + j58*NTERPOOH + j59*ONITR + .6*j60*PAN + j66*TERPNIT + j76*BRONO2 - + j94*CLONO2 + r49*M*HO2NO2 + r50*M*N2O5 + r183*M*PAN + r232*M*MPAN + r307*M*PBZNIT + + j94*CLONO2 + r49*M*HO2NO2 + r50*M*N2O5 + r182*M*PAN + r231*M*MPAN + r306*M*PBZNIT + r26*HO2NO2*OH + r35*NO3*HO2 + 2*r36*NO3*NO + r37*NO3*O + r38*NO3*OH + r40*NO*HO2 + r41*NO*O3 - + r42*M*NO*O + r63*CLO*NO + r95*BRO*NO + r138*CH3O2*NO + r147*HOCH2OO*NO + r160*C2H5O2*NO - + r171*CH3CO3*NO + r175*EO2*NO + r188*C3H7O2*NO + r194*NOA*OH + r196*PO2*NO + r200*RO2*NO - + r204*BIGENE*NO3 + r206*ENEO2*NO + r212*MACRO2*NO3 + r213*MACRO2*NO + r222*MCO3*NO - + r223*MCO3*NO3 + r225*MEKO2*NO + r233*ALKNIT*OH + r235*ALKO2*NO + .92*r245*ISOPAO2*NO - + r246*ISOPAO2*NO3 + .92*r251*ISOPBO2*NO + r252*ISOPBO2*NO3 + .7*r253*ISOPNITA*OH - + r259*ISOPNO3*NO + r260*ISOPNO3*NO3 + r270*XO2*NO + r271*XO2*NO3 + r274*ACBZO2*NO - + r277*BENZO2*NO + r282*BZOO*NO + r284*C6H5O2*NO + r288*DICARBO2*NO + r291*MALO2*NO - + r294*MDIALO2*NO + r297*PHENO2*NO + r304*TOLO2*NO + r310*XYLENO2*NO + r313*XYLOLO2*NO - + .5*r322*NTERPO2*CH3O2 + 1.6*r324*NTERPO2*NO + 2*r325*NTERPO2*NO3 + .9*r329*TERP2O2*NO - + r331*TERPNIT*OH + .8*r334*TERPO2*NO - - j16*NO2 - r366*NO2 - r28*N*NO2 - r29*N*NO2 - r30*N*NO2 - r32*O*NO2 - r33*O3*NO2 + + r42*M*NO*O + r63*CLO*NO + r95*BRO*NO + r138*CH3O2*NO + r146*HOCH2OO*NO + r159*C2H5O2*NO + + r170*CH3CO3*NO + r174*EO2*NO + r187*C3H7O2*NO + r193*NOA*OH + r195*PO2*NO + r199*RO2*NO + + r203*BIGENE*NO3 + r205*ENEO2*NO + r211*MACRO2*NO3 + r212*MACRO2*NO + r221*MCO3*NO + + r222*MCO3*NO3 + r224*MEKO2*NO + r232*ALKNIT*OH + r234*ALKO2*NO + .92*r244*ISOPAO2*NO + + r245*ISOPAO2*NO3 + .92*r250*ISOPBO2*NO + r251*ISOPBO2*NO3 + .7*r252*ISOPNITA*OH + + r258*ISOPNO3*NO + r259*ISOPNO3*NO3 + r269*XO2*NO + r270*XO2*NO3 + r273*ACBZO2*NO + + r276*BENZO2*NO + r281*BZOO*NO + r283*C6H5O2*NO + r287*DICARBO2*NO + r290*MALO2*NO + + r293*MDIALO2*NO + r296*PHENO2*NO + r303*TOLO2*NO + r309*XYLENO2*NO + r312*XYLOLO2*NO + + .5*r321*NTERPO2*CH3O2 + 1.6*r323*NTERPO2*NO + 2*r324*NTERPO2*NO3 + .9*r328*TERP2O2*NO + + r330*TERPNIT*OH + .8*r333*TERPO2*NO + - j16*NO2 - r364*NO2 - r28*N*NO2 - r29*N*NO2 - r30*N*NO2 - r32*O*NO2 - r33*O3*NO2 - r34*M*O*NO2 - r45*M*HO2*NO2 - r46*M*NO3*NO2 - r47*M*OH*NO2 - r65*M*CLO*NO2 - r96*M*BRO*NO2 - - r182*M*CH3CO3*NO2 - r231*M*MCO3*NO2 - r289*M*DICARBO2*NO2 - r292*M*MALO2*NO2 - - r295*M*MDIALO2*NO2 - r299*PHENO*NO2 - r302*M*ACBZO2*NO2 - r348*SO*NO2 + - r181*M*CH3CO3*NO2 - r230*M*MCO3*NO2 - r288*M*DICARBO2*NO2 - r291*M*MALO2*NO2 + - r294*M*MDIALO2*NO2 - r298*PHENO*NO2 - r301*M*ACBZO2*NO2 - r348*SO*NO2 d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j60*PAN + j77*BRONO2 + j95*CLONO2 + r50*M*N2O5 + r33*NO2*O3 + r34*M*NO2*O + r48*HNO3*OH + r64*CLONO2*CL + r66*CLONO2*O + r67*CLONO2*OH - + r97*BRONO2*O + r111*F*HNO3 + r180*PAN*OH + .5*r228*M*MPAN*OH - - j17*NO3 - j18*NO3 - r367*NO3 - r35*HO2*NO3 - r36*NO*NO3 - r37*O*NO3 - r38*OH*NO3 - - r46*M*NO2*NO3 - r132*CH2O*NO3 - r165*CH3CHO*NO3 - r184*C3H6*NO3 - r191*CH3COCHO*NO3 - - r204*BIGENE*NO3 - r212*MACRO2*NO3 - r223*MCO3*NO3 - r246*ISOPAO2*NO3 - r252*ISOPBO2*NO3 - - r255*ISOP*NO3 - r260*ISOPNO3*NO3 - r271*XO2*NO3 - r316*BCARY*NO3 - r319*MTERP*NO3 - - r325*NTERPO2*NO3 - r336*TERPROD1*NO3 - r339*DMS*NO3 - d(NOA)/dt = r184*C3H6*NO3 + .5*r254*ISOPNITB*OH + r261*ISOPNOOH*OH + r265*NC4CH2OH*OH + r266*NC4CHO*OH - - j57*NOA - r194*OH*NOA - d(NTERPOOH)/dt = r323*NTERPO2*HO2 - - j58*NTERPOOH - r368*NTERPOOH - r326*OH*NTERPOOH + + r97*BRONO2*O + r111*F*HNO3 + r179*PAN*OH + .5*r227*M*MPAN*OH + - j17*NO3 - j18*NO3 - r365*NO3 - r35*HO2*NO3 - r36*NO*NO3 - r37*O*NO3 - r38*OH*NO3 + - r46*M*NO2*NO3 - r132*CH2O*NO3 - r164*CH3CHO*NO3 - r183*C3H6*NO3 - r190*CH3COCHO*NO3 + - r203*BIGENE*NO3 - r211*MACRO2*NO3 - r222*MCO3*NO3 - r245*ISOPAO2*NO3 - r251*ISOPBO2*NO3 + - r254*ISOP*NO3 - r259*ISOPNO3*NO3 - r270*XO2*NO3 - r315*BCARY*NO3 - r318*MTERP*NO3 + - r324*NTERPO2*NO3 - r335*TERPROD1*NO3 - r338*DMS*NO3 + d(NOA)/dt = r183*C3H6*NO3 + .5*r253*ISOPNITB*OH + r260*ISOPNOOH*OH + r264*NC4CH2OH*OH + r265*NC4CHO*OH + - j57*NOA - r193*OH*NOA + d(NTERPOOH)/dt = r322*NTERPO2*HO2 + - j58*NTERPOOH - r366*NTERPOOH - r325*OH*NTERPOOH d(num_a1)/dt = 0 d(num_a2)/dt = 0 d(num_a3)/dt = 0 d(num_a4)/dt = 0 d(O)/dt = j5*O2 + 2*j6*O2 + j3*H2O + j8*O3 + j13*N2O5 + j15*NO + j16*NO2 + j18*NO3 + .18*j39*CH4 + j41*CO2 + j75*BRO + j93*CLO + j107*OCLO + j111*SO + j112*SO2 + j113*SO3 + r3*N2*O1D - + r4*O2*O1D + r31*O2*N + r343*O2*S + r349*O2*SO + r13*H*HO2 + r23*OH*OH + r27*N*NO + r28*N*NO2 + + r4*O2*O1D + r31*O2*N + r342*O2*S + r349*O2*SO + r13*H*HO2 + r23*OH*OH + r27*N*NO + r28*N*NO2 - r8*O2*M*O - r6*O3*O - 2*r7*M*O*O - r9*H2*O - r10*H2O2*O - r15*HO2*O - r21*OH*O - r32*NO2*O - r34*M*NO2*O - r37*NO3*O - r42*M*NO*O - r66*CLONO2*O - r68*CLO*O - r71*HCL*O - r74*HOCL*O - - r97*BRONO2*O - r98*BRO*O - r100*HBR*O - r102*HOBR*O - r133*CH2O*O - r341*OCS*O - d(O3)/dt = r8*O2*M*O + .15*r170*CH3CO3*HO2 + .15*r220*MCO3*HO2 + - r97*BRONO2*O - r98*BRO*O - r100*HBR*O - r102*HOBR*O - r133*CH2O*O - r340*OCS*O + d(O3)/dt = r8*O2*M*O + .15*r169*CH3CO3*HO2 + .15*r219*MCO3*HO2 - j7*O3 - j8*O3 - r5*O1D*O3 - r6*O*O3 - r16*HO2*O3 - r17*H*O3 - r22*OH*O3 - r33*NO2*O3 - - r41*NO*O3 - r57*CL*O3 - r89*BR*O3 - r156*C2H4*O3 - r185*C3H6*O3 - r215*MACR*O3 - r229*MVK*O3 - - r262*ISOP*O3 - r300*PHENO*O3 - r317*BCARY*O3 - r320*MTERP*O3 - r344*S*O3 - r350*SO*O3 + - r41*NO*O3 - r57*CL*O3 - r89*BR*O3 - r155*C2H4*O3 - r184*C3H6*O3 - r214*MACR*O3 - r228*MVK*O3 + - r261*ISOP*O3 - r299*PHENO*O3 - r316*BCARY*O3 - r319*MTERP*O3 - r344*S*O3 - r350*SO*O3 d(O3S)/dt = 0 d(OCLO)/dt = r61*CLO*CLO + r91*BRO*CLO - j107*OCLO - r351*SO*OCLO - d(OCS)/dt = - j110*OCS - r341*O*OCS - r342*OH*OCS - d(ONITR)/dt = r208*HONITR*OH + .1*r329*TERP2O2*NO - - j59*ONITR - r369*ONITR - d(PAN)/dt = r182*M*CH3CO3*NO2 - - j60*PAN - r183*M*PAN - r180*OH*PAN - d(PBZNIT)/dt = r302*M*ACBZO2*NO2 - - r307*M*PBZNIT - d(PHENO)/dt = j31*C6H5OOH + r284*C6H5O2*NO + .07*r286*CRESOL*OH + .06*r298*PHENOL*OH + .07*r314*XYLOL*OH - - r299*NO2*PHENO - r300*O3*PHENO - d(PHENOL)/dt = .53*r275*BENZENE*OH - - r298*OH*PHENOL - d(PHENOOH)/dt = r296*PHENO2*HO2 - - j61*PHENOOH - r301*OH*PHENOOH + d(OCS)/dt = - j110*OCS - r340*O*OCS - r341*OH*OCS + d(ONITR)/dt = r207*HONITR*OH + .1*r328*TERP2O2*NO + - j59*ONITR - r367*ONITR + d(PAN)/dt = r181*M*CH3CO3*NO2 + - j60*PAN - r182*M*PAN - r179*OH*PAN + d(PBZNIT)/dt = r301*M*ACBZO2*NO2 + - r306*M*PBZNIT + d(PHENO)/dt = j31*C6H5OOH + r283*C6H5O2*NO + .07*r285*CRESOL*OH + .06*r297*PHENOL*OH + .07*r313*XYLOL*OH + - r298*NO2*PHENO - r299*O3*PHENO + d(PHENOL)/dt = .53*r274*BENZENE*OH + - r297*OH*PHENOL + d(PHENOOH)/dt = r295*PHENO2*HO2 + - j61*PHENOOH - r300*OH*PHENOOH d(pombb1_a1)/dt = 0 d(pombb1_a4)/dt = 0 d(pomff1_a1)/dt = 0 d(pomff1_a4)/dt = 0 - d(POOH)/dt = r195*PO2*HO2 - - j62*POOH - r197*OH*POOH - d(ROOH)/dt = .85*r199*RO2*HO2 - - j63*ROOH - r201*OH*ROOH + d(POOH)/dt = r194*PO2*HO2 + - j62*POOH - r196*OH*POOH + d(ROOH)/dt = .85*r198*RO2*HO2 + - j63*ROOH - r200*OH*ROOH d(S)/dt = j110*OCS + j111*SO - - r343*O2*S - r344*O3*S - r347*OH*S + - r342*O2*S - r344*O3*S - r347*OH*S d(SF6)/dt = - j108*SF6 - d(SO)/dt = j112*SO2 + r343*O2*S + r341*OCS*O + r344*S*O3 + r347*S*OH + d(SO)/dt = j112*SO2 + r342*O2*S + r340*OCS*O + r344*S*O3 + r347*S*OH - j111*SO - r349*O2*SO - r345*BRO*SO - r346*CLO*SO - r348*NO2*SO - r350*O3*SO - r351*OCLO*SO - r352*OH*SO - d(SO2)/dt = j113*SO3 + r349*O2*SO + r339*DMS*NO3 + r340*DMS*OH + r342*OCS*OH + r345*SO*BRO + r346*SO*CLO + d(SO2)/dt = j113*SO3 + r349*O2*SO + r338*DMS*NO3 + r339*DMS*OH + r341*OCS*OH + r345*SO*BRO + r346*SO*CLO + r348*SO*NO2 + r350*SO*O3 + r351*SO*OCLO + r352*SO*OH + .5*r353*DMS*OH - - j112*SO2 - r354*OH*SO2 - d(SO3)/dt = j109*H2SO4 + r354*SO2*OH - - j113*SO3 - r355*H2O*SO3 + - j112*SO2 - r343*M*OH*SO2 + d(SO3)/dt = j109*H2SO4 + r343*M*SO2*OH + - j113*SO3 - r354*H2O*SO3 d(so4_a1)/dt = 0 d(so4_a2)/dt = 0 d(so4_a3)/dt = 0 @@ -1646,233 +1709,247 @@ Extraneous prod/loss species d(soaff4_a2)/dt = - j141*soaff4_a2 d(soaff5_a1)/dt = - j142*soaff5_a1 d(soaff5_a2)/dt = - j143*soaff5_a2 - d(SOAGbb0)/dt = .2381*r378*IVOCbb*OH + .5931*r383*SVOCbb*OH - d(SOAGbb1)/dt = .1308*r378*IVOCbb*OH + .1534*r383*SVOCbb*OH - d(SOAGbb2)/dt = .0348*r378*IVOCbb*OH + .0459*r383*SVOCbb*OH - d(SOAGbb3)/dt = .0076*r378*IVOCbb*OH + .0085*r383*SVOCbb*OH - d(SOAGbb4)/dt = .0113*r378*IVOCbb*OH + .0128*r383*SVOCbb*OH - d(SOAGbg0)/dt = r357*GLYOXAL + .2202*r372*BCARY*O3 + .2202*r373*BCARY*OH + .0031*r377*ISOP*OH - + .0508*r381*MTERP*O3 + .0508*r382*MTERP*OH - d(SOAGbg1)/dt = .2067*r372*BCARY*O3 + .2067*r373*BCARY*OH + .0035*r377*ISOP*OH + .1149*r381*MTERP*O3 - + .1149*r382*MTERP*OH - d(SOAGbg2)/dt = .0653*r372*BCARY*O3 + .0653*r373*BCARY*OH + .0003*r377*ISOP*OH + .0348*r381*MTERP*O3 - + .0348*r382*MTERP*OH - d(SOAGbg3)/dt = .17493*r371*BCARY*NO3 + .1284*r372*BCARY*O3 + .1284*r373*BCARY*OH + .059024*r375*ISOP*NO3 - + .0033*r376*ISOP*O3 + .0271*r377*ISOP*OH + .17493*r380*MTERP*NO3 + .0554*r381*MTERP*O3 - + .0554*r382*MTERP*OH - d(SOAGbg4)/dt = .59019*r371*BCARY*NO3 + .114*r372*BCARY*O3 + .114*r373*BCARY*OH + .025024*r375*ISOP*NO3 - + .0474*r377*ISOP*OH + .59019*r380*MTERP*NO3 + .1278*r381*MTERP*O3 + .1278*r382*MTERP*OH - d(SOAGff0)/dt = .0023*r374*BENZENE*OH + .2381*r379*IVOCff*OH + .5931*r384*SVOCff*OH + .1364*r385*TOLUENE*OH - + .1677*r386*XYLENES*OH - d(SOAGff1)/dt = .0008*r374*BENZENE*OH + .1308*r379*IVOCff*OH + .1534*r384*SVOCff*OH + .0101*r385*TOLUENE*OH - + .0174*r386*XYLENES*OH - d(SOAGff2)/dt = .0843*r374*BENZENE*OH + .0348*r379*IVOCff*OH + .0459*r384*SVOCff*OH + .0763*r385*TOLUENE*OH - + .086*r386*XYLENES*OH - d(SOAGff3)/dt = .0443*r374*BENZENE*OH + .0076*r379*IVOCff*OH + .0085*r384*SVOCff*OH + .2157*r385*TOLUENE*OH - + .0512*r386*XYLENES*OH - d(SOAGff4)/dt = .1621*r374*BENZENE*OH + .0113*r379*IVOCff*OH + .0128*r384*SVOCff*OH + .0738*r385*TOLUENE*OH - + .1598*r386*XYLENES*OH - d(SVOCbb)/dt = - r383*OH*SVOCbb - d(SVOCff)/dt = - r384*OH*SVOCff - d(TEPOMUC)/dt = .1*r306*TOLUENE*OH + .23*r308*XYLENES*OH + d(SOAGbb0)/dt = .2381*r382*IVOCbbO2VBS*HO2 + .1056*r383*IVOCbbO2VBS*NO + .5931*r393*SVOCbb*OH + d(SOAGbb1)/dt = .1308*r382*IVOCbbO2VBS*HO2 + .1026*r383*IVOCbbO2VBS*NO + .1534*r393*SVOCbb*OH + d(SOAGbb2)/dt = .0348*r382*IVOCbbO2VBS*HO2 + .0521*r383*IVOCbbO2VBS*NO + .0459*r393*SVOCbb*OH + d(SOAGbb3)/dt = .0076*r382*IVOCbbO2VBS*HO2 + .0143*r383*IVOCbbO2VBS*NO + .0085*r393*SVOCbb*OH + d(SOAGbb4)/dt = .0113*r382*IVOCbbO2VBS*HO2 + .0166*r383*IVOCbbO2VBS*NO + .0128*r393*SVOCbb*OH + d(SOAGbg0)/dt = r398*GLYOXAL + .2202*r370*BCARYO2VBS*HO2 + .1279*r371*BCARYO2VBS*NO + .2202*r372*BCARY*O3 + + .0031*r378*ISOPO2VBS*HO2 + .0003*r379*ISOPO2VBS*NO + .0508*r389*MTERPO2VBS*HO2 + + .0245*r390*MTERPO2VBS*NO + .0508*r391*MTERP*O3 + d(SOAGbg1)/dt = .2067*r370*BCARYO2VBS*HO2 + .1792*r371*BCARYO2VBS*NO + .2067*r372*BCARY*O3 + + .0035*r378*ISOPO2VBS*HO2 + .0003*r379*ISOPO2VBS*NO + .1149*r389*MTERPO2VBS*HO2 + + .0082*r390*MTERPO2VBS*NO + .1149*r391*MTERP*O3 + d(SOAGbg2)/dt = .0653*r370*BCARYO2VBS*HO2 + .0676*r371*BCARYO2VBS*NO + .0653*r372*BCARY*O3 + + .0003*r378*ISOPO2VBS*HO2 + .0073*r379*ISOPO2VBS*NO + .0348*r389*MTERPO2VBS*HO2 + + .0772*r390*MTERPO2VBS*NO + .0348*r391*MTERP*O3 + d(SOAGbg3)/dt = .17493*r369*BCARY*NO3 + .1284*r370*BCARYO2VBS*HO2 + .079*r371*BCARYO2VBS*NO + + .1284*r372*BCARY*O3 + .059024*r377*ISOP*NO3 + .0271*r378*ISOPO2VBS*HO2 + + .0057*r379*ISOPO2VBS*NO + .0033*r380*ISOP*O3 + .17493*r388*MTERP*NO3 + + .0554*r389*MTERPO2VBS*HO2 + .0332*r390*MTERPO2VBS*NO + .0554*r391*MTERP*O3 + d(SOAGbg4)/dt = .59019*r369*BCARY*NO3 + .114*r370*BCARYO2VBS*HO2 + .1254*r371*BCARYO2VBS*NO + + .114*r372*BCARY*O3 + .025024*r377*ISOP*NO3 + .0474*r378*ISOPO2VBS*HO2 + + .0623*r379*ISOPO2VBS*NO + .59019*r388*MTERP*NO3 + .1278*r389*MTERPO2VBS*HO2 + + .13*r390*MTERPO2VBS*NO + .1278*r391*MTERP*O3 + d(SOAGff0)/dt = .0023*r375*BENZO2VBS*HO2 + .0097*r376*BENZO2VBS*NO + .2381*r385*IVOCffO2VBS*HO2 + + .1056*r386*IVOCffO2VBS*NO + .5931*r394*SVOCff*OH + .1364*r396*TOLUO2VBS*HO2 + + .0154*r397*TOLUO2VBS*NO + .1677*r400*XYLEO2VBS*HO2 + .0063*r401*XYLEO2VBS*NO + d(SOAGff1)/dt = .0008*r375*BENZO2VBS*HO2 + .0034*r376*BENZO2VBS*NO + .1308*r385*IVOCffO2VBS*HO2 + + .1026*r386*IVOCffO2VBS*NO + .1534*r394*SVOCff*OH + .0101*r396*TOLUO2VBS*HO2 + + .0452*r397*TOLUO2VBS*NO + .0174*r400*XYLEO2VBS*HO2 + .0237*r401*XYLEO2VBS*NO + d(SOAGff2)/dt = .0843*r375*BENZO2VBS*HO2 + .1579*r376*BENZO2VBS*NO + .0348*r385*IVOCffO2VBS*HO2 + + .0521*r386*IVOCffO2VBS*NO + .0459*r394*SVOCff*OH + .0763*r396*TOLUO2VBS*HO2 + + .0966*r397*TOLUO2VBS*NO + .086*r400*XYLEO2VBS*HO2 + .0025*r401*XYLEO2VBS*NO + d(SOAGff3)/dt = .0443*r375*BENZO2VBS*HO2 + .0059*r376*BENZO2VBS*NO + .0076*r385*IVOCffO2VBS*HO2 + + .0143*r386*IVOCffO2VBS*NO + .0085*r394*SVOCff*OH + .2157*r396*TOLUO2VBS*HO2 + + .0073*r397*TOLUO2VBS*NO + .0512*r400*XYLEO2VBS*HO2 + .011*r401*XYLEO2VBS*NO + d(SOAGff4)/dt = .1621*r375*BENZO2VBS*HO2 + .0536*r376*BENZO2VBS*NO + .0113*r385*IVOCffO2VBS*HO2 + + .0166*r386*IVOCffO2VBS*NO + .0128*r394*SVOCff*OH + .0738*r396*TOLUO2VBS*HO2 + + .238*r397*TOLUO2VBS*NO + .1598*r400*XYLEO2VBS*HO2 + .1185*r401*XYLEO2VBS*NO + d(SVOCbb)/dt = - r393*OH*SVOCbb + d(SVOCff)/dt = - r394*OH*SVOCff + d(TEPOMUC)/dt = .1*r305*TOLUENE*OH + .23*r307*XYLENES*OH - j64*TEPOMUC - d(TERP2OOH)/dt = r328*TERP2O2*HO2 - - j65*TERP2OOH - r330*OH*TERP2OOH - d(TERPNIT)/dt = .5*r322*NTERPO2*CH3O2 + .2*r324*NTERPO2*NO + .2*r334*TERPO2*NO - - j66*TERPNIT - r370*TERPNIT - r331*OH*TERPNIT - d(TERPOOH)/dt = r333*TERPO2*HO2 - - j67*TERPOOH - r335*OH*TERPOOH - d(TERPROD1)/dt = j58*NTERPOOH + j66*TERPNIT + j67*TERPOOH + .33*r317*BCARY*O3 + .33*r320*MTERP*O3 - + .5*r322*NTERPO2*CH3O2 + .8*r324*NTERPO2*NO + r325*NTERPO2*NO3 + r331*TERPNIT*OH - + r332*TERPO2*CH3O2 + .8*r334*TERPO2*NO - - j68*TERPROD1 - r336*NO3*TERPROD1 - r337*OH*TERPROD1 - d(TERPROD2)/dt = j65*TERP2OOH + j68*TERPROD1 + .3*r317*BCARY*O3 + .3*r320*MTERP*O3 + r327*TERP2O2*CH3O2 - + .9*r329*TERP2O2*NO - - j69*TERPROD2 - r338*OH*TERPROD2 - d(TOLOOH)/dt = r303*TOLO2*HO2 - - j70*TOLOOH - r305*OH*TOLOOH - d(TOLUENE)/dt = - r306*OH*TOLUENE - d(XOOH)/dt = r269*XO2*HO2 - - j71*XOOH - r272*OH*XOOH - d(XYLENES)/dt = - r308*OH*XYLENES - d(XYLENOOH)/dt = r309*XYLENO2*HO2 - - j72*XYLENOOH - r311*OH*XYLENOOH - d(XYLOL)/dt = .15*r308*XYLENES*OH - - r314*OH*XYLOL - d(XYLOLOOH)/dt = r312*XYLOLO2*HO2 - - j73*XYLOLOOH - r315*OH*XYLOLOOH - d(NHDEP)/dt = r365*NH4 + r356*NH3*OH - d(NDEP)/dt = .5*r228*M*MPAN*OH + r289*M*DICARBO2*NO2 + r292*M*MALO2*NO2 + r295*M*MDIALO2*NO2 + r299*PHENO*NO2 - + .2*r324*NTERPO2*NO + .5*r336*TERPROD1*NO3 - d(ACBZO2)/dt = r307*M*PBZNIT + r279*BZALD*OH - - r273*HO2*ACBZO2 - r274*NO*ACBZO2 - r302*M*NO2*ACBZO2 - d(ALKO2)/dt = r237*ALKOOH*OH + r238*BIGALK*OH - - r234*HO2*ALKO2 - r235*NO*ALKO2 - r236*NO*ALKO2 - d(BENZO2)/dt = .35*r275*BENZENE*OH + r278*BENZOOH*OH - - r276*HO2*BENZO2 - r277*NO*BENZO2 - d(BZOO)/dt = r281*BZOOH*OH + .07*r306*TOLUENE*OH + .06*r308*XYLENES*OH - - r280*HO2*BZOO - r282*NO*BZOO - d(C2H5O2)/dt = j52*MEK + .5*r162*C2H5OOH*OH + r163*C2H6*CL + r164*C2H6*OH - - 2*r157*C2H5O2*C2H5O2 - r158*CH3O2*C2H5O2 - r159*HO2*C2H5O2 - r160*NO*C2H5O2 - d(C3H7O2)/dt = r189*C3H7OOH*OH + r190*C3H8*OH - - r186*CH3O2*C3H7O2 - r187*HO2*C3H7O2 - r188*NO*C3H7O2 - d(C6H5O2)/dt = .4*r273*ACBZO2*HO2 + r274*ACBZO2*NO + r285*C6H5OOH*OH + r300*PHENO*O3 - - r283*HO2*C6H5O2 - r284*NO*C6H5O2 + d(TERP2OOH)/dt = r327*TERP2O2*HO2 + - j65*TERP2OOH - r329*OH*TERP2OOH + d(TERPNIT)/dt = .5*r321*NTERPO2*CH3O2 + .2*r323*NTERPO2*NO + .2*r333*TERPO2*NO + - j66*TERPNIT - r368*TERPNIT - r330*OH*TERPNIT + d(TERPOOH)/dt = r332*TERPO2*HO2 + - j67*TERPOOH - r334*OH*TERPOOH + d(TERPROD1)/dt = j58*NTERPOOH + j66*TERPNIT + j67*TERPOOH + .33*r316*BCARY*O3 + .33*r319*MTERP*O3 + + .5*r321*NTERPO2*CH3O2 + .8*r323*NTERPO2*NO + r324*NTERPO2*NO3 + r330*TERPNIT*OH + + r331*TERPO2*CH3O2 + .8*r333*TERPO2*NO + - j68*TERPROD1 - r335*NO3*TERPROD1 - r336*OH*TERPROD1 + d(TERPROD2)/dt = j65*TERP2OOH + j68*TERPROD1 + .3*r316*BCARY*O3 + .3*r319*MTERP*O3 + r326*TERP2O2*CH3O2 + + .9*r328*TERP2O2*NO + - j69*TERPROD2 - r337*OH*TERPROD2 + d(TOLOOH)/dt = r302*TOLO2*HO2 + - j70*TOLOOH - r304*OH*TOLOOH + d(TOLUENE)/dt = - r305*OH*TOLUENE + d(TOLUO2VBS)/dt = r395*TOLUENE*OH + - r396*HO2*TOLUO2VBS - r397*NO*TOLUO2VBS + d(XOOH)/dt = r268*XO2*HO2 + - j71*XOOH - r271*OH*XOOH + d(XYLENES)/dt = - r307*OH*XYLENES + d(XYLENOOH)/dt = r308*XYLENO2*HO2 + - j72*XYLENOOH - r310*OH*XYLENOOH + d(XYLEO2VBS)/dt = r399*XYLENES*OH + - r400*HO2*XYLEO2VBS - r401*NO*XYLEO2VBS + d(XYLOL)/dt = .15*r307*XYLENES*OH + - r313*OH*XYLOL + d(XYLOLOOH)/dt = r311*XYLOLO2*HO2 + - j73*XYLOLOOH - r314*OH*XYLOLOOH + d(NHDEP)/dt = r363*NH4 + r355*NH3*OH + d(NDEP)/dt = .5*r227*M*MPAN*OH + r288*M*DICARBO2*NO2 + r291*M*MALO2*NO2 + r294*M*MDIALO2*NO2 + r298*PHENO*NO2 + + .2*r323*NTERPO2*NO + .5*r335*TERPROD1*NO3 + d(ACBZO2)/dt = r306*M*PBZNIT + r278*BZALD*OH + - r272*HO2*ACBZO2 - r273*NO*ACBZO2 - r301*M*NO2*ACBZO2 + d(ALKO2)/dt = r236*ALKOOH*OH + r237*BIGALK*OH + - r233*HO2*ALKO2 - r234*NO*ALKO2 - r235*NO*ALKO2 + d(BENZO2)/dt = .35*r274*BENZENE*OH + r277*BENZOOH*OH + - r275*HO2*BENZO2 - r276*NO*BENZO2 + d(BZOO)/dt = r280*BZOOH*OH + .07*r305*TOLUENE*OH + .06*r307*XYLENES*OH + - r279*HO2*BZOO - r281*NO*BZOO + d(C2H5O2)/dt = j52*MEK + .5*r161*C2H5OOH*OH + r162*C2H6*CL + r163*C2H6*OH + - 2*r156*C2H5O2*C2H5O2 - r157*CH3O2*C2H5O2 - r158*HO2*C2H5O2 - r159*NO*C2H5O2 + d(C3H7O2)/dt = r188*C3H7OOH*OH + r189*C3H8*OH + - r185*CH3O2*C3H7O2 - r186*HO2*C3H7O2 - r187*NO*C3H7O2 + d(C6H5O2)/dt = .4*r272*ACBZO2*HO2 + r273*ACBZO2*NO + r284*C6H5OOH*OH + r299*PHENO*O3 + - r282*HO2*C6H5O2 - r283*NO*C6H5O2 d(CH3CO3)/dt = .13*j23*BIGALD + j27*BIGALD4 + j35*CH3COCH3 + j36*CH3COCHO + .33*j45*HONITR + j47*HYAC - + 1.34*j50*MACR + j52*MEK + j53*MEKOOH + .3*j55*MVK + j57*NOA + .6*j60*PAN + j63*ROOH - + .5*j64*TEPOMUC + .65*j69*TERPROD2 + r183*M*PAN + r165*CH3CHO*NO3 + r166*CH3CHO*OH - + .5*r173*CH3COOOH*OH + r191*CH3COCHO*NO3 + r192*CH3COCHO*OH + .3*r198*RO2*CH3O2 - + .15*r199*RO2*HO2 + r200*RO2*NO + .53*r209*MACRO2*CH3CO3 + .26*r210*MACRO2*CH3O2 - + .53*r212*MACRO2*NO3 + .53*r213*MACRO2*NO + .1*r215*MACR*O3 + r219*MCO3*CH3O2 - + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + r222*MCO3*NO + r223*MCO3*NO3 + .2*r224*MEKO2*HO2 - + r225*MEKO2*NO + .28*r229*MVK*O3 + .08*r262*ISOP*O3 + .06*r317*BCARY*O3 + .06*r320*MTERP*O3 - + .65*r338*TERPROD2*OH - - 2*r168*CH3CO3*CH3CO3 - r169*CH3O2*CH3CO3 - r170*HO2*CH3CO3 - r171*NO*CH3CO3 - - r182*M*NO2*CH3CO3 - r209*MACRO2*CH3CO3 - r242*ISOPAO2*CH3CO3 - r247*ISOPBO2*CH3CO3 - - r256*ISOPNO3*CH3CO3 - r267*XO2*CH3CO3 + + 1.34*j51*MACR + j52*MEK + j53*MEKOOH + .3*j55*MVK + j57*NOA + .6*j60*PAN + j63*ROOH + + .5*j64*TEPOMUC + .65*j69*TERPROD2 + r182*M*PAN + r164*CH3CHO*NO3 + r165*CH3CHO*OH + + .5*r172*CH3COOOH*OH + r190*CH3COCHO*NO3 + r191*CH3COCHO*OH + .3*r197*RO2*CH3O2 + + .15*r198*RO2*HO2 + r199*RO2*NO + .53*r208*MACRO2*CH3CO3 + .26*r209*MACRO2*CH3O2 + + .53*r211*MACRO2*NO3 + .53*r212*MACRO2*NO + .1*r214*MACR*O3 + r218*MCO3*CH3O2 + + .45*r219*MCO3*HO2 + 2*r220*MCO3*MCO3 + r221*MCO3*NO + r222*MCO3*NO3 + .2*r223*MEKO2*HO2 + + r224*MEKO2*NO + .28*r228*MVK*O3 + .08*r261*ISOP*O3 + .06*r316*BCARY*O3 + .06*r319*MTERP*O3 + + .65*r337*TERPROD2*OH + - 2*r167*CH3CO3*CH3CO3 - r168*CH3O2*CH3CO3 - r169*HO2*CH3CO3 - r170*NO*CH3CO3 + - r181*M*NO2*CH3CO3 - r208*MACRO2*CH3CO3 - r241*ISOPAO2*CH3CO3 - r246*ISOPBO2*CH3CO3 + - r255*ISOPNO3*CH3CO3 - r266*XO2*CH3CO3 d(CH3O2)/dt = j34*CH3CHO + j35*CH3COCH3 + j37*CH3COOOH + j40*CH4 + .3*j55*MVK + .4*j60*PAN + j87*CH3BR - + j89*CH3CL + r52*CL*CH4 + r108*F*CH4 + .7*r140*CH3OOH*OH + r141*CH4*OH + r148*O1D*CH4 - + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + .45*r170*CH3CO3*HO2 + r171*CH3CO3*NO - + r172*CH3COOH*OH + .28*r185*C3H6*O3 + r209*MACRO2*CH3CO3 + r218*MCO3*CH3CO3 - + r242*ISOPAO2*CH3CO3 + r247*ISOPBO2*CH3CO3 + r256*ISOPNO3*CH3CO3 + .05*r262*ISOP*O3 - + r267*XO2*CH3CO3 + .33*r287*DICARBO2*HO2 + .83*r288*DICARBO2*NO + .07*r293*MDIALO2*HO2 - + .17*r294*MDIALO2*NO + + j89*CH3CL + r52*CL*CH4 + r108*F*CH4 + .7*r140*CH3OOH*OH + r141*CH4*OH + r147*O1D*CH4 + + 2*r167*CH3CO3*CH3CO3 + .9*r168*CH3CO3*CH3O2 + .45*r169*CH3CO3*HO2 + r170*CH3CO3*NO + + r171*CH3COOH*OH + .28*r184*C3H6*O3 + r208*MACRO2*CH3CO3 + r217*MCO3*CH3CO3 + + r241*ISOPAO2*CH3CO3 + r246*ISOPBO2*CH3CO3 + r255*ISOPNO3*CH3CO3 + .05*r261*ISOP*O3 + + r266*XO2*CH3CO3 + .33*r286*DICARBO2*HO2 + .83*r287*DICARBO2*NO + .07*r292*MDIALO2*HO2 + + .17*r293*MDIALO2*NO - r58*CLO*CH3O2 - 2*r135*CH3O2*CH3O2 - 2*r136*CH3O2*CH3O2 - r137*HO2*CH3O2 - r138*NO*CH3O2 - - r158*C2H5O2*CH3O2 - r169*CH3CO3*CH3O2 - r186*C3H7O2*CH3O2 - r198*RO2*CH3O2 - - r210*MACRO2*CH3O2 - r219*MCO3*CH3O2 - r243*ISOPAO2*CH3O2 - r248*ISOPBO2*CH3O2 - - r257*ISOPNO3*CH3O2 - r268*XO2*CH3O2 - r322*NTERPO2*CH3O2 - r327*TERP2O2*CH3O2 - - r332*TERPO2*CH3O2 + - r157*C2H5O2*CH3O2 - r168*CH3CO3*CH3O2 - r185*C3H7O2*CH3O2 - r197*RO2*CH3O2 + - r209*MACRO2*CH3O2 - r218*MCO3*CH3O2 - r242*ISOPAO2*CH3O2 - r247*ISOPBO2*CH3O2 + - r256*ISOPNO3*CH3O2 - r267*XO2*CH3O2 - r321*NTERPO2*CH3O2 - r326*TERP2O2*CH3O2 + - r331*TERPO2*CH3O2 d(DICARBO2)/dt = .6*j25*BIGALD2 - - r287*HO2*DICARBO2 - r288*NO*DICARBO2 - r289*M*NO2*DICARBO2 - d(ENEO2)/dt = r205*BIGENE*OH - - r206*NO*ENEO2 - r207*NO*ENEO2 - d(EO)/dt = j42*EOOH + .75*r175*EO2*NO - - r176*EO - r177*O2*EO - d(EO2)/dt = r181*M*C2H4*OH - - r174*HO2*EO2 - r175*NO*EO2 + - r286*HO2*DICARBO2 - r287*NO*DICARBO2 - r288*M*NO2*DICARBO2 + d(ENEO2)/dt = r204*BIGENE*OH + - r205*NO*ENEO2 - r206*NO*ENEO2 + d(EO)/dt = j42*EOOH + .75*r174*EO2*NO + - r175*EO - r176*O2*EO + d(EO2)/dt = r180*M*C2H4*OH + - r173*HO2*EO2 - r174*NO*EO2 d(HO2)/dt = j11*HO2NO2 + j19*ALKNIT + .9*j20*ALKOOH + j21*BENZOOH + 1.5*j22*BEPOMUC + .56*j23*BIGALD + j24*BIGALD1 + .6*j25*BIGALD2 + .6*j26*BIGALD3 + j27*BIGALD4 + j28*BZOOH + j29*C2H5OOH + j30*C3H7OOH + j34*CH3CHO + j36*CH3COCHO + 2*j43*GLYALD + 2*j44*GLYOXAL + .67*j45*HONITR - + j46*HPALD + j47*HYAC + j48*ISOPNOOH + j49*ISOPOOH + 1.34*j50*MACR + .66*j51*MACR + j56*NC4CHO + + j46*HPALD + j47*HYAC + j48*ISOPNOOH + j49*ISOPOOH + .66*j50*MACR + 1.34*j51*MACR + j56*NC4CHO + j61*PHENOOH + j62*POOH + j64*TEPOMUC + j65*TERP2OOH + j66*TERPNIT + j67*TERPOOH + j68*TERPROD1 + 1.2*j69*TERPROD2 + j70*TOLOOH + j72*XYLENOOH + j73*XYLOLOOH + r14*O2*M*H - + r49*M*HO2NO2 + r146*HOCH2OO + r176*EO + r177*O2*EO + r250*ISOPBO2 + r10*H2O2*O + r19*OH*H2O2 + + r49*M*HO2NO2 + r145*HOCH2OO + r175*EO + r176*O2*EO + r249*ISOPBO2 + r10*H2O2*O + r19*OH*H2O2 + r22*OH*O3 + r38*NO3*OH + r51*CL*CH2O + r54*CL*H2O2 + r58*CLO*CH3O2 + r69*CLO*OH + r87*BR*CH2O + r99*BRO*OH + r116*CH3BR*CL + r117*CH3BR*OH + r119*CH3CL*CL + r120*CH3CL*OH + r132*CH2O*NO3 - + r133*CH2O*O + 2*r135*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + r142*M*CO*OH - + r143*M*HCN*OH + r144*HCOOH*OH + r147*HOCH2OO*NO + r149*O1D*CH4 + .35*r154*M*C2H2*OH - + .13*r156*C2H4*O3 + 1.2*r157*C2H5O2*C2H5O2 + r158*C2H5O2*CH3O2 + r160*C2H5O2*NO + r161*C2H5OH*OH - + r167*CH3CN*OH + .9*r169*CH3CO3*CH3O2 + .25*r175*EO2*NO + r178*GLYALD*OH + r179*GLYOXAL*OH - + .28*r185*C3H6*O3 + r186*C3H7O2*CH3O2 + r188*C3H7O2*NO + r193*HYAC*OH + r196*PO2*NO - + .3*r198*RO2*CH3O2 + r206*ENEO2*NO + r208*HONITR*OH + .47*r209*MACRO2*CH3CO3 - + .73*r210*MACRO2*CH3O2 + .47*r212*MACRO2*NO3 + .47*r213*MACRO2*NO + .14*r215*MACR*O3 - + .2*r217*MACROOH*OH + r219*MCO3*CH3O2 + .5*r228*M*MPAN*OH + .28*r229*MVK*O3 + r235*ALKO2*NO - + r242*ISOPAO2*CH3CO3 + r243*ISOPAO2*CH3O2 + .92*r245*ISOPAO2*NO + r246*ISOPAO2*NO3 - + r247*ISOPBO2*CH3CO3 + r248*ISOPBO2*CH3O2 + .92*r251*ISOPBO2*NO + r252*ISOPBO2*NO3 - + .3*r253*ISOPNITA*OH + r254*ISOPNITB*OH + r256*ISOPNO3*CH3CO3 + 1.2*r257*ISOPNO3*CH3O2 - + r259*ISOPNO3*NO + r260*ISOPNO3*NO3 + r261*ISOPNOOH*OH + .37*r262*ISOP*O3 + r265*NC4CH2OH*OH - + r266*NC4CHO*OH + r267*XO2*CH3CO3 + .8*r268*XO2*CH3O2 + r270*XO2*NO + r271*XO2*NO3 - + .65*r275*BENZENE*OH + r277*BENZO2*NO + r282*BZOO*NO + .73*r286*CRESOL*OH - + .07*r287*DICARBO2*HO2 + .17*r288*DICARBO2*NO + .16*r290*MALO2*HO2 + .4*r291*MALO2*NO - + .33*r293*MDIALO2*HO2 + .83*r294*MDIALO2*NO + r297*PHENO2*NO + .8*r298*PHENOL*OH + r304*TOLO2*NO - + .28*r306*TOLUENE*OH + .38*r308*XYLENES*OH + r310*XYLENO2*NO + r313*XYLOLO2*NO - + .63*r314*XYLOL*OH + .57*r317*BCARY*O3 + .57*r320*MTERP*O3 + .5*r322*NTERPO2*CH3O2 - + r327*TERP2O2*CH3O2 + .9*r329*TERP2O2*NO + r332*TERPO2*CH3O2 + .8*r334*TERPO2*NO - + .2*r338*TERPROD2*OH + .5*r353*DMS*OH + r354*SO2*OH - - r358*HO2 - r11*H*HO2 - r12*H*HO2 - r13*H*HO2 - r15*O*HO2 - r16*O3*HO2 - r20*OH*HO2 + + r133*CH2O*O + 2*r135*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + r142*M*HCN*OH + + r143*HCOOH*OH + r146*HOCH2OO*NO + r148*O1D*CH4 + r151*CO*OH + .35*r153*M*C2H2*OH + + .13*r155*C2H4*O3 + 1.2*r156*C2H5O2*C2H5O2 + r157*C2H5O2*CH3O2 + r159*C2H5O2*NO + r160*C2H5OH*OH + + r166*CH3CN*OH + .9*r168*CH3CO3*CH3O2 + .25*r174*EO2*NO + r177*GLYALD*OH + r178*GLYOXAL*OH + + .28*r184*C3H6*O3 + r185*C3H7O2*CH3O2 + r187*C3H7O2*NO + r192*HYAC*OH + r195*PO2*NO + + .3*r197*RO2*CH3O2 + r205*ENEO2*NO + r207*HONITR*OH + .47*r208*MACRO2*CH3CO3 + + .73*r209*MACRO2*CH3O2 + .47*r211*MACRO2*NO3 + .47*r212*MACRO2*NO + .14*r214*MACR*O3 + + .2*r216*MACROOH*OH + r218*MCO3*CH3O2 + .5*r227*M*MPAN*OH + .28*r228*MVK*O3 + r234*ALKO2*NO + + r241*ISOPAO2*CH3CO3 + r242*ISOPAO2*CH3O2 + .92*r244*ISOPAO2*NO + r245*ISOPAO2*NO3 + + r246*ISOPBO2*CH3CO3 + r247*ISOPBO2*CH3O2 + .92*r250*ISOPBO2*NO + r251*ISOPBO2*NO3 + + .3*r252*ISOPNITA*OH + r253*ISOPNITB*OH + r255*ISOPNO3*CH3CO3 + 1.2*r256*ISOPNO3*CH3O2 + + r258*ISOPNO3*NO + r259*ISOPNO3*NO3 + r260*ISOPNOOH*OH + .37*r261*ISOP*O3 + r264*NC4CH2OH*OH + + r265*NC4CHO*OH + r266*XO2*CH3CO3 + .8*r267*XO2*CH3O2 + r269*XO2*NO + r270*XO2*NO3 + + .65*r274*BENZENE*OH + r276*BENZO2*NO + r281*BZOO*NO + .73*r285*CRESOL*OH + + .07*r286*DICARBO2*HO2 + .17*r287*DICARBO2*NO + .16*r289*MALO2*HO2 + .4*r290*MALO2*NO + + .33*r292*MDIALO2*HO2 + .83*r293*MDIALO2*NO + r296*PHENO2*NO + .8*r297*PHENOL*OH + r303*TOLO2*NO + + .28*r305*TOLUENE*OH + .38*r307*XYLENES*OH + r309*XYLENO2*NO + r312*XYLOLO2*NO + + .63*r313*XYLOL*OH + .57*r316*BCARY*O3 + .57*r319*MTERP*O3 + .5*r321*NTERPO2*CH3O2 + + r326*TERP2O2*CH3O2 + .9*r328*TERP2O2*NO + r331*TERPO2*CH3O2 + .8*r333*TERPO2*NO + + .2*r337*TERPROD2*OH + r343*M*SO2*OH + .5*r353*DMS*OH + - r356*HO2 - r11*H*HO2 - r12*H*HO2 - r13*H*HO2 - r15*O*HO2 - r16*O3*HO2 - r20*OH*HO2 - 2*r25*HO2*HO2 - r35*NO3*HO2 - r40*NO*HO2 - r45*M*NO2*HO2 - r55*CL*HO2 - r56*CL*HO2 - - r62*CLO*HO2 - r88*BR*HO2 - r94*BRO*HO2 - r131*CH2O*HO2 - r137*CH3O2*HO2 - r145*HOCH2OO*HO2 - - r159*C2H5O2*HO2 - r170*CH3CO3*HO2 - r174*EO2*HO2 - r187*C3H7O2*HO2 - r195*PO2*HO2 - - r199*RO2*HO2 - r211*MACRO2*HO2 - r220*MCO3*HO2 - r224*MEKO2*HO2 - r234*ALKO2*HO2 - - r244*ISOPAO2*HO2 - r249*ISOPBO2*HO2 - r258*ISOPNO3*HO2 - r269*XO2*HO2 - r273*ACBZO2*HO2 - - r276*BENZO2*HO2 - r280*BZOO*HO2 - r283*C6H5O2*HO2 - r287*DICARBO2*HO2 - r290*MALO2*HO2 - - r293*MDIALO2*HO2 - r296*PHENO2*HO2 - r303*TOLO2*HO2 - r309*XYLENO2*HO2 - r312*XYLOLO2*HO2 - - r323*NTERPO2*HO2 - r328*TERP2O2*HO2 - r333*TERPO2*HO2 + - r62*CLO*HO2 - r88*BR*HO2 - r94*BRO*HO2 - r131*CH2O*HO2 - r137*CH3O2*HO2 - r144*HOCH2OO*HO2 + - r158*C2H5O2*HO2 - r169*CH3CO3*HO2 - r173*EO2*HO2 - r186*C3H7O2*HO2 - r194*PO2*HO2 + - r198*RO2*HO2 - r210*MACRO2*HO2 - r219*MCO3*HO2 - r223*MEKO2*HO2 - r233*ALKO2*HO2 + - r243*ISOPAO2*HO2 - r248*ISOPBO2*HO2 - r257*ISOPNO3*HO2 - r268*XO2*HO2 - r272*ACBZO2*HO2 + - r275*BENZO2*HO2 - r279*BZOO*HO2 - r282*C6H5O2*HO2 - r286*DICARBO2*HO2 - r289*MALO2*HO2 + - r292*MDIALO2*HO2 - r295*PHENO2*HO2 - r302*TOLO2*HO2 - r308*XYLENO2*HO2 - r311*XYLOLO2*HO2 + - r322*NTERPO2*HO2 - r327*TERP2O2*HO2 - r332*TERPO2*HO2 d(HOCH2OO)/dt = r131*CH2O*HO2 - - r146*HOCH2OO - r145*HO2*HOCH2OO - r147*NO*HOCH2OO - d(ISOPAO2)/dt = .6*r263*ISOP*OH - - r242*CH3CO3*ISOPAO2 - r243*CH3O2*ISOPAO2 - r244*HO2*ISOPAO2 - r245*NO*ISOPAO2 - - r246*NO3*ISOPAO2 - d(ISOPBO2)/dt = .4*r263*ISOP*OH - - r250*ISOPBO2 - r247*CH3CO3*ISOPBO2 - r248*CH3O2*ISOPBO2 - r249*HO2*ISOPBO2 - - r251*NO*ISOPBO2 - r252*NO3*ISOPBO2 - d(MACRO2)/dt = .5*r216*MACR*OH + .2*r217*MACROOH*OH + r230*MVK*OH - - r209*CH3CO3*MACRO2 - r210*CH3O2*MACRO2 - r211*HO2*MACRO2 - r212*NO3*MACRO2 - r213*NO*MACRO2 - - r214*NO*MACRO2 + - r145*HOCH2OO - r144*HO2*HOCH2OO - r146*NO*HOCH2OO + d(ISOPAO2)/dt = .6*r262*ISOP*OH + - r241*CH3CO3*ISOPAO2 - r242*CH3O2*ISOPAO2 - r243*HO2*ISOPAO2 - r244*NO*ISOPAO2 + - r245*NO3*ISOPAO2 + d(ISOPBO2)/dt = .4*r262*ISOP*OH + - r249*ISOPBO2 - r246*CH3CO3*ISOPBO2 - r247*CH3O2*ISOPBO2 - r248*HO2*ISOPBO2 + - r250*NO*ISOPBO2 - r251*NO3*ISOPBO2 + d(MACRO2)/dt = .5*r215*MACR*OH + .2*r216*MACROOH*OH + r229*MVK*OH + - r208*CH3CO3*MACRO2 - r209*CH3O2*MACRO2 - r210*HO2*MACRO2 - r211*NO3*MACRO2 - r212*NO*MACRO2 + - r213*NO*MACRO2 d(MALO2)/dt = .6*j24*BIGALD1 - - r290*HO2*MALO2 - r291*NO*MALO2 - r292*M*NO2*MALO2 - d(MCO3)/dt = .66*j50*MACR + j54*MPAN + r232*M*MPAN + .5*r216*MACR*OH + .5*r217*MACROOH*OH - - r218*CH3CO3*MCO3 - r219*CH3O2*MCO3 - r220*HO2*MCO3 - 2*r221*MCO3*MCO3 - r222*NO*MCO3 - - r223*NO3*MCO3 - r231*M*NO2*MCO3 + - r289*HO2*MALO2 - r290*NO*MALO2 - r291*M*NO2*MALO2 + d(MCO3)/dt = .66*j51*MACR + j54*MPAN + r231*M*MPAN + .5*r215*MACR*OH + .5*r216*MACROOH*OH + - r217*CH3CO3*MCO3 - r218*CH3O2*MCO3 - r219*HO2*MCO3 - 2*r220*MCO3*MCO3 - r221*NO*MCO3 + - r222*NO3*MCO3 - r230*M*NO2*MCO3 d(MDIALO2)/dt = .6*j26*BIGALD3 - - r293*HO2*MDIALO2 - r294*NO*MDIALO2 - r295*M*NO2*MDIALO2 - d(MEKO2)/dt = r226*MEK*OH + r227*MEKOOH*OH - - r224*HO2*MEKO2 - r225*NO*MEKO2 - d(NTERPO2)/dt = r316*BCARY*NO3 + r319*MTERP*NO3 + r326*NTERPOOH*OH + .5*r336*TERPROD1*NO3 - - r322*CH3O2*NTERPO2 - r323*HO2*NTERPO2 - r324*NO*NTERPO2 - r325*NO3*NTERPO2 + - r292*HO2*MDIALO2 - r293*NO*MDIALO2 - r294*M*NO2*MDIALO2 + d(MEKO2)/dt = r225*MEK*OH + r226*MEKOOH*OH + - r223*HO2*MEKO2 - r224*NO*MEKO2 + d(NTERPO2)/dt = r315*BCARY*NO3 + r318*MTERP*NO3 + r325*NTERPOOH*OH + .5*r335*TERPROD1*NO3 + - r321*CH3O2*NTERPO2 - r322*HO2*NTERPO2 - r323*NO*NTERPO2 - r324*NO3*NTERPO2 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 - r43*N2O*O1D - r44*N2O*O1D - r76*CCL4*O1D - r77*CF2CLBR*O1D - r78*CFC11*O1D - r79*CFC113*O1D - r80*CFC114*O1D - r81*CFC115*O1D - r82*CFC12*O1D - r83*HCL*O1D - r84*HCL*O1D - r103*CF3BR*O1D - r104*CHBR3*O1D - r105*H2402*O1D - r106*HBR*O1D - r107*HBR*O1D - r112*COF2*O1D - r113*COFCL*O1D - r126*CH2BR2*O1D - r127*CH3BR*O1D - r128*HCFC141B*O1D - r129*HCFC142B*O1D - r130*HCFC22*O1D - - r148*CH4*O1D - r149*CH4*O1D - r150*CH4*O1D - r151*HCN*O1D + - r147*CH4*O1D - r148*CH4*O1D - r149*CH4*O1D - r150*HCN*O1D d(OH)/dt = j2*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j20*ALKOOH + j21*BENZOOH + j28*BZOOH + j29*C2H5OOH + j30*C3H7OOH + j31*C6H5OOH + j37*CH3COOOH + j38*CH3OOH + .33*j39*CH4 + j42*EOOH + j46*HPALD - + j53*MEKOOH + j58*NTERPOOH + j61*PHENOOH + j62*POOH + j63*ROOH + j65*TERP2OOH + j67*TERPOOH - + j70*TOLOOH + j71*XOOH + j72*XYLENOOH + j73*XYLOLOOH + j105*HOBR + j106*HOCL + .5*r366*NO2 - + r1*O1D*H2 + 2*r2*O1D*H2O + r9*H2*O + r10*H2O2*O + 2*r12*H*HO2 + r15*HO2*O + r16*HO2*O3 - + r17*H*O3 + r35*NO3*HO2 + r40*NO*HO2 + r56*CL*HO2 + r71*HCL*O + r74*HOCL*O + r83*O1D*HCL - + r100*HBR*O + r102*HOBR*O + r106*O1D*HBR + r110*F*H2O + r133*CH2O*O + .3*r140*CH3OOH*OH - + r148*O1D*CH4 + r151*O1D*HCN + .65*r154*M*C2H2*OH + .13*r156*C2H4*O3 + .5*r162*C2H5OOH*OH - + .45*r170*CH3CO3*HO2 + .36*r185*C3H6*O3 + .5*r197*POOH*OH + .15*r199*RO2*HO2 + .24*r215*MACR*O3 - + .1*r217*MACROOH*OH + .45*r220*MCO3*HO2 + .2*r224*MEKO2*HO2 + .36*r229*MVK*O3 + .32*r262*ISOP*O3 - + .6*r264*ISOPOOH*OH + .5*r272*XOOH*OH + .4*r273*ACBZO2*HO2 + .4*r287*DICARBO2*HO2 - + .4*r293*MDIALO2*HO2 + .63*r317*BCARY*O3 + .63*r320*MTERP*O3 + + j49*ISOPOOH + j53*MEKOOH + j58*NTERPOOH + j61*PHENOOH + j62*POOH + j63*ROOH + j65*TERP2OOH + + j67*TERPOOH + j70*TOLOOH + j71*XOOH + j72*XYLENOOH + j73*XYLOLOOH + j105*HOBR + j106*HOCL + + .5*r364*NO2 + r1*O1D*H2 + 2*r2*O1D*H2O + r9*H2*O + r10*H2O2*O + 2*r12*H*HO2 + r15*HO2*O + + r16*HO2*O3 + r17*H*O3 + r35*NO3*HO2 + r40*NO*HO2 + r56*CL*HO2 + r71*HCL*O + r74*HOCL*O + + r83*O1D*HCL + r100*HBR*O + r102*HOBR*O + r106*O1D*HBR + r110*F*H2O + r133*CH2O*O + + .3*r140*CH3OOH*OH + r147*O1D*CH4 + r150*O1D*HCN + .65*r153*M*C2H2*OH + .13*r155*C2H4*O3 + + .5*r161*C2H5OOH*OH + .45*r169*CH3CO3*HO2 + .36*r184*C3H6*O3 + .5*r196*POOH*OH + .15*r198*RO2*HO2 + + .24*r214*MACR*O3 + .1*r216*MACROOH*OH + .45*r219*MCO3*HO2 + .2*r223*MEKO2*HO2 + .36*r228*MVK*O3 + + .32*r261*ISOP*O3 + .6*r263*ISOPOOH*OH + .5*r271*XOOH*OH + .4*r272*ACBZO2*HO2 + + .4*r286*DICARBO2*HO2 + .4*r292*MDIALO2*HO2 + .63*r316*BCARY*O3 + .63*r319*MTERP*O3 - r18*H2*OH - r19*H2O2*OH - r20*HO2*OH - r21*O*OH - r22*O3*OH - 2*r23*OH*OH - 2*r24*M*OH*OH - r26*HO2NO2*OH - r38*NO3*OH - r39*N*OH - r47*M*NO2*OH - r48*HNO3*OH - r67*CLONO2*OH - r69*CLO*OH - r70*CLO*OH - r72*HCL*OH - r75*HOCL*OH - r99*BRO*OH - r101*HBR*OH - r115*CH2BR2*OH - r117*CH3BR*OH - r118*CH3CCL3*OH - r120*CH3CL*OH - r122*CHBR3*OH - r123*HCFC141B*OH - r124*HCFC142B*OH - r125*HCFC22*OH - r134*CH2O*OH - r139*CH3OH*OH - r140*CH3OOH*OH - r141*CH4*OH - - r142*M*CO*OH - r143*M*HCN*OH - r144*HCOOH*OH - r152*CO*OH - r154*M*C2H2*OH - r161*C2H5OH*OH - - r162*C2H5OOH*OH - r164*C2H6*OH - r166*CH3CHO*OH - r167*CH3CN*OH - r172*CH3COOH*OH - - r173*CH3COOOH*OH - r178*GLYALD*OH - r179*GLYOXAL*OH - r180*PAN*OH - r181*M*C2H4*OH - - r189*C3H7OOH*OH - r190*C3H8*OH - r192*CH3COCHO*OH - r193*HYAC*OH - r194*NOA*OH - r197*POOH*OH - - r201*ROOH*OH - r202*M*C3H6*OH - r203*CH3COCH3*OH - r205*BIGENE*OH - r208*HONITR*OH - - r216*MACR*OH - r217*MACROOH*OH - r226*MEK*OH - r227*MEKOOH*OH - r228*M*MPAN*OH - r230*MVK*OH - - r233*ALKNIT*OH - r237*ALKOOH*OH - r238*BIGALK*OH - r239*HPALD*OH - r240*HYDRALD*OH - - r241*IEPOX*OH - r253*ISOPNITA*OH - r254*ISOPNITB*OH - r261*ISOPNOOH*OH - r263*ISOP*OH - - r264*ISOPOOH*OH - r265*NC4CH2OH*OH - r266*NC4CHO*OH - r272*XOOH*OH - r275*BENZENE*OH - - r278*BENZOOH*OH - r279*BZALD*OH - r281*BZOOH*OH - r285*C6H5OOH*OH - r286*CRESOL*OH - - r298*PHENOL*OH - r301*PHENOOH*OH - r305*TOLOOH*OH - r306*TOLUENE*OH - r308*XYLENES*OH - - r311*XYLENOOH*OH - r314*XYLOL*OH - r315*XYLOLOOH*OH - r318*BCARY*OH - r321*MTERP*OH - - r326*NTERPOOH*OH - r330*TERP2OOH*OH - r331*TERPNIT*OH - r335*TERPOOH*OH - r337*TERPROD1*OH - - r338*TERPROD2*OH - r340*DMS*OH - r342*OCS*OH - r347*S*OH - r352*SO*OH - r353*DMS*OH - - r354*SO2*OH - r356*NH3*OH - d(PHENO2)/dt = .2*r286*CRESOL*OH + .14*r298*PHENOL*OH + r301*PHENOOH*OH - - r296*HO2*PHENO2 - r297*NO*PHENO2 - d(PO2)/dt = .5*r197*POOH*OH + r202*M*C3H6*OH - - r195*HO2*PO2 - r196*NO*PO2 - d(RO2)/dt = .15*j69*TERPROD2 + r201*ROOH*OH + r203*CH3COCH3*OH + .06*r317*BCARY*O3 + .06*r320*MTERP*O3 - + .15*r338*TERPROD2*OH - - r198*CH3O2*RO2 - r199*HO2*RO2 - r200*NO*RO2 - d(TERP2O2)/dt = r330*TERP2OOH*OH + .5*r336*TERPROD1*NO3 + r337*TERPROD1*OH - - r327*CH3O2*TERP2O2 - r328*HO2*TERP2O2 - r329*NO*TERP2O2 - d(TERPO2)/dt = r318*BCARY*OH + r321*MTERP*OH + r335*TERPOOH*OH - - r332*CH3O2*TERPO2 - r333*HO2*TERPO2 - r334*NO*TERPO2 - d(TOLO2)/dt = r305*TOLOOH*OH + .65*r306*TOLUENE*OH - - r303*HO2*TOLO2 - r304*NO*TOLO2 - d(XO2)/dt = r239*HPALD*OH + r240*HYDRALD*OH + r241*IEPOX*OH + .4*r264*ISOPOOH*OH + .5*r272*XOOH*OH - - r267*CH3CO3*XO2 - r268*CH3O2*XO2 - r269*HO2*XO2 - r270*NO*XO2 - r271*NO3*XO2 - d(XYLENO2)/dt = .56*r308*XYLENES*OH + r311*XYLENOOH*OH - - r309*HO2*XYLENO2 - r310*NO*XYLENO2 - d(XYLOLO2)/dt = .3*r314*XYLOL*OH + r315*XYLOLOOH*OH - - r312*HO2*XYLOLO2 - r313*NO*XYLOLO2 + - r142*M*HCN*OH - r143*HCOOH*OH - r151*CO*OH - r153*M*C2H2*OH - r160*C2H5OH*OH - r161*C2H5OOH*OH + - r163*C2H6*OH - r165*CH3CHO*OH - r166*CH3CN*OH - r171*CH3COOH*OH - r172*CH3COOOH*OH + - r177*GLYALD*OH - r178*GLYOXAL*OH - r179*PAN*OH - r180*M*C2H4*OH - r188*C3H7OOH*OH + - r189*C3H8*OH - r191*CH3COCHO*OH - r192*HYAC*OH - r193*NOA*OH - r196*POOH*OH - r200*ROOH*OH + - r201*M*C3H6*OH - r202*CH3COCH3*OH - r204*BIGENE*OH - r207*HONITR*OH - r215*MACR*OH + - r216*MACROOH*OH - r225*MEK*OH - r226*MEKOOH*OH - r227*M*MPAN*OH - r229*MVK*OH - r232*ALKNIT*OH + - r236*ALKOOH*OH - r237*BIGALK*OH - r238*HPALD*OH - r239*HYDRALD*OH - r240*IEPOX*OH + - r252*ISOPNITA*OH - r253*ISOPNITB*OH - r260*ISOPNOOH*OH - r262*ISOP*OH - r263*ISOPOOH*OH + - r264*NC4CH2OH*OH - r265*NC4CHO*OH - r271*XOOH*OH - r274*BENZENE*OH - r277*BENZOOH*OH + - r278*BZALD*OH - r280*BZOOH*OH - r284*C6H5OOH*OH - r285*CRESOL*OH - r297*PHENOL*OH + - r300*PHENOOH*OH - r304*TOLOOH*OH - r305*TOLUENE*OH - r307*XYLENES*OH - r310*XYLENOOH*OH + - r313*XYLOL*OH - r314*XYLOLOOH*OH - r317*BCARY*OH - r320*MTERP*OH - r325*NTERPOOH*OH + - r329*TERP2OOH*OH - r330*TERPNIT*OH - r334*TERPOOH*OH - r336*TERPROD1*OH - r337*TERPROD2*OH + - r339*DMS*OH - r341*OCS*OH - r343*M*SO2*OH - r347*S*OH - r352*SO*OH - r353*DMS*OH - r355*NH3*OH + d(PHENO2)/dt = .2*r285*CRESOL*OH + .14*r297*PHENOL*OH + r300*PHENOOH*OH + - r295*HO2*PHENO2 - r296*NO*PHENO2 + d(PO2)/dt = .5*r196*POOH*OH + r201*M*C3H6*OH + - r194*HO2*PO2 - r195*NO*PO2 + d(RO2)/dt = .15*j69*TERPROD2 + r200*ROOH*OH + r202*CH3COCH3*OH + .06*r316*BCARY*O3 + .06*r319*MTERP*O3 + + .15*r337*TERPROD2*OH + - r197*CH3O2*RO2 - r198*HO2*RO2 - r199*NO*RO2 + d(TERP2O2)/dt = r329*TERP2OOH*OH + .5*r335*TERPROD1*NO3 + r336*TERPROD1*OH + - r326*CH3O2*TERP2O2 - r327*HO2*TERP2O2 - r328*NO*TERP2O2 + d(TERPO2)/dt = r317*BCARY*OH + r320*MTERP*OH + r334*TERPOOH*OH + - r331*CH3O2*TERPO2 - r332*HO2*TERPO2 - r333*NO*TERPO2 + d(TOLO2)/dt = r304*TOLOOH*OH + .65*r305*TOLUENE*OH + - r302*HO2*TOLO2 - r303*NO*TOLO2 + d(XO2)/dt = r238*HPALD*OH + r239*HYDRALD*OH + r240*IEPOX*OH + .4*r263*ISOPOOH*OH + .5*r271*XOOH*OH + - r266*CH3CO3*XO2 - r267*CH3O2*XO2 - r268*HO2*XO2 - r269*NO*XO2 - r270*NO3*XO2 + d(XYLENO2)/dt = .56*r307*XYLENES*OH + r310*XYLENOOH*OH + - r308*HO2*XYLENO2 - r309*NO*XYLENO2 + d(XYLOLO2)/dt = .3*r313*XYLOL*OH + r314*XYLOLOOH*OH + - r311*HO2*XYLOLO2 - r312*NO*XYLOLO2 d(H2O)/dt = .05*j39*CH4 + j109*H2SO4 + r13*H*HO2 + r18*OH*H2 + r19*OH*H2O2 + r20*OH*HO2 + r23*OH*OH + r26*HO2NO2*OH + r48*HNO3*OH + r72*HCL*OH + r75*HOCL*OH + r101*HBR*OH + r115*CH2BR2*OH + r117*CH3BR*OH + r118*CH3CCL3*OH + r120*CH3CL*OH + r125*HCFC22*OH + r134*CH2O*OH - + r140*CH3OOH*OH + r141*CH4*OH + r144*HCOOH*OH + r164*C2H6*OH + r166*CH3CHO*OH + r172*CH3COOH*OH - + r173*CH3COOOH*OH + r189*C3H7OOH*OH + r190*C3H8*OH + r192*CH3COCHO*OH + r197*POOH*OH - + r201*ROOH*OH + r203*CH3COCH3*OH + .5*r216*MACR*OH + r356*NH3*OH + r388*HOCL*HCL - + r394*HOCL*HCL + r395*HOBR*HCL + r399*HOCL*HCL + r400*HOBR*HCL - - j1*H2O - j2*H2O - j3*H2O - r2*O1D*H2O - r110*F*H2O - r355*SO3*H2O + + r140*CH3OOH*OH + r141*CH4*OH + r143*HCOOH*OH + r163*C2H6*OH + r165*CH3CHO*OH + r171*CH3COOH*OH + + r172*CH3COOOH*OH + r188*C3H7OOH*OH + r189*C3H8*OH + r191*CH3COCHO*OH + r196*POOH*OH + + r200*ROOH*OH + r202*CH3COCH3*OH + .5*r215*MACR*OH + r355*NH3*OH + r403*HOCL*HCL + + r409*HOCL*HCL + r410*HOBR*HCL + r414*HOCL*HCL + r415*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r2*O1D*H2O - r110*F*H2O - r354*SO3*H2O diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mech.in b/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mech.in index 49e34234e0..54f6cc916e 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mech.in +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mech.in @@ -1,11 +1,11 @@ * Comments -* User-given Tag Description: TS1-fullVBS for CESM2.2 -* Tag database identifier : MZ264_TS1_fullVBS_20190611 +* User-given Tag Description: TS1.2_fullVBS +* Tag database identifier : MZ323_TS1_fullVBS_20221220 * Tag created by : lke * Tag created from branch : TS1-fullVBS -* Tag created on : 2019-06-11 17:47:07.589299-06 +* Tag created on : 2022-12-20 16:49:31.65266-07 * Comments for this tag follow: -* lke : 2019-06-11 : TS1, with SOA by sector, for CESM2, correcting TERP2OOH chemical formula, and TOLUENE+OH VBS coefficient. With O3S. +* lke : 2022-12-20 : TS1 with JPL19 updates, NOx-dependent VBS-SOA, tracking SOA source type (ff,bb,bg) SPECIES @@ -16,7 +16,9 @@ bc_a1 -> C, bc_a4 -> C, BCARY -> C15H24, + BCARYO2VBS -> C15H25O3, BENZENE -> C6H6, + BENZO2VBS -> C6H7O5, BENZOOH -> C6H8O5, BEPOMUC -> C6H6O3, BIGALD -> C5H6O2, @@ -112,15 +114,19 @@ ISOPNITB -> C5H9NO4, ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ISOPNOOH -> C5H9NO5, + ISOPO2VBS -> C5H9O3, ISOPOOH -> HOCH2COOHCH3CHCH2, IVOCbb -> C13H28, + IVOCbbO2VBS -> C13H29O3, IVOCff -> C13H28, + IVOCffO2VBS -> C13H29O3, MACR -> CH2CCH3CHO, MACROOH -> CH3COCHOOHCH2OH, MEK -> C4H8O, MEKOOH -> C4H8O3, MPAN -> CH2CCH3CO3NO2, MTERP -> C10H16, + MTERPO2VBS -> C10H17O3, MVK -> CH2CHCOCH3, N, N2O, @@ -221,9 +227,11 @@ TERPROD2 -> C9H14O2, TOLOOH -> C7H10O5, TOLUENE -> C7H8, + TOLUO2VBS -> C7H9O5, XOOH -> HOCH2COOHCH3CHOHCHO, XYLENES -> C8H10, XYLENOOH -> C8H12O5, + XYLEO2VBS -> C8H11O5, XYLOL -> C8H10O, XYLOLOOH -> C8H12O6, NHDEP -> N, @@ -318,43 +326,20 @@ Solution classes Explicit - AOA_NH - BRY - CCL4 - CF2CLBR - CF3BR - CFC11 - CFC113 - CFC114 - CFC115 - CFC12 - CH2BR2 - CH3BR - CH3CCL3 - CH3CL - CH4 - CHBR3 - CLY - CO2 - E90 - H2402 - HCFC141B - HCFC142B - HCFC22 - N2O - SF6 NHDEP NDEP - O3S End Explicit Implicit ALKNIT ALKOOH + AOA_NH bc_a1 bc_a4 BCARY + BCARYO2VBS BENZENE + BENZO2VBS BENZOOH BEPOMUC BIGALD @@ -368,6 +353,7 @@ BRCL BRO BRONO2 + BRY BZALD BZOOH C2H2 @@ -379,8 +365,20 @@ C3H7OOH C3H8 C6H5OOH + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 CH2O + CH3BR + CH3CCL3 CH3CHO + CH3CL CH3CN CH3COCH3 CH3COCHO @@ -388,12 +386,16 @@ CH3COOOH CH3OH CH3OOH + CH4 + CHBR3 CL CL2 CL2O2 CLO CLONO2 + CLY CO + CO2 COF2 COFCL CRESOL @@ -401,15 +403,20 @@ dst_a1 dst_a2 dst_a3 + E90 EOOH F GLYALD GLYOXAL H H2 + H2402 H2O2 H2SO4 HBR + HCFC141B + HCFC142B + HCFC22 HCL HCN HCOOH @@ -428,17 +435,22 @@ ISOPNITB ISOPNO3 ISOPNOOH + ISOPO2VBS ISOPOOH IVOCbb + IVOCbbO2VBS IVOCff + IVOCffO2VBS MACR MACROOH MEK MEKOOH MPAN MTERP + MTERPO2VBS MVK N + N2O N2O5 NC4CH2OH NC4CHO @@ -458,6 +470,7 @@ num_a4 O O3 + O3S OCLO OCS ONITR @@ -473,6 +486,7 @@ POOH ROOH S + SF6 SO SO2 SO3 @@ -534,9 +548,11 @@ TERPROD2 TOLOOH TOLUENE + TOLUO2VBS XOOH XYLENES XYLENOOH + XYLEO2VBS XYLOL XYLOLOOH ACBZO2 @@ -621,8 +637,8 @@ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 [jc6h5ooh->,jch3ooh] C6H5OOH + hv -> PHENO + OH -[jch2o_a] CH2O + hv -> CO + 2*H [jch2o_b] CH2O + hv -> CO + H2 +[jch2o_a] CH2O + hv -> CO + 2*H [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2 [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2 [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2 @@ -638,9 +654,9 @@ [jhpald->,.006*jno2] HPALD + hv -> BIGALD3 + OH + HO2 [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O [jisopnooh->,jch3ooh] ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH -[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 +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + CH2O + HO2 [jmacr_b] MACR + hv -> 0.66*HO2 + 1.34*CO +[jmacr_a] MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO [jmpan->,jpan] MPAN + hv -> MCO3 + NO2 @@ -764,7 +780,7 @@ [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 ; 4.4e-32, 1.3, 7.5e-11, -0.2, 0.6 +[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 @@ -779,21 +795,21 @@ ********************************* *** odd-nitrogen ********************************* -[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 +[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 ; 1.5e-11, -3600 +[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.5e-11, 170 -[NO3_O] NO3 + O -> NO2 + O2 ; 1e-11 +[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.3e-12, 270 +[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 @@ -884,7 +900,7 @@ [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_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.03e-11, -1110 [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 @@ -910,8 +926,7 @@ [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 -[CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.9e-33, 1, 1.1e-12, -1.3, 0.6 -[HCN_OH] HCN + OH + M -> HO2 + M ; 4.28e-33, 0, 9.3e-15, -4.42, 0.8 +[HCN_OH] HCN + OH + M -> HO2 + M ; 6.1e-33, 1.5, 9.8e-15, -4.6, 0.8 [HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4e-13 [HOCH2OO_HO2] HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 [HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.4e+12, -7000 @@ -920,7 +935,7 @@ [O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.5e-11 [O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9e-12 [O1D_HCN] O1D + HCN -> OH ; 1.08e-10, 105 -[usr_CO_OH_b] CO + OH -> CO2 + H +[usr_CO_OH] CO + OH -> CO2 + HO2 ********************************* *** C2 ********************************* @@ -943,7 +958,7 @@ [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 ; 7e-13 +[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 @@ -953,7 +968,7 @@ [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 ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[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 @@ -964,7 +979,7 @@ [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 ; 8.7e-12, -615 +[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 @@ -1129,10 +1144,11 @@ *** Sulfur ********************************* [DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 -[DMS_OHa] DMS + OH -> SO2 ; 9.6e-12, -234 +[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 @@ -1141,15 +1157,13 @@ [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.7e-11, 335 +[SO_OH] SO + OH -> SO2 + H ; 2.6e-11, 330 [usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 -[usr_SO2_OH] SO2 + OH -> SO3 + HO2 [usr_SO3_H2O] SO3 + H2O -> H2SO4 ********************************* *** Tropospheric Aerosol ********************************* [NH3_OH] NH3 + OH -> H2O + 1*NHDEP ; 1.7e-12, -710 -[usr_GLYOXAL_aer] GLYOXAL -> SOAGbg0 [usr_HO2_aer] HO2 -> 0.5*H2O2 [usr_HONITR_aer] HONITR -> HNO3 [usr_ISOPNITA_aer] ISOPNITA -> HNO3 @@ -1167,21 +1181,38 @@ *** SOA ********************************* [BCARY_NO3_vbs] BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 ; 1.9e-11 +[BCARYO2_HO2_vbs] BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 ; 2.75e-13, 1300 +[BCARYO2_NO_vbs] BCARYO2VBS + NO -> NO + 0.1279*SOAGbg0 + 0.1792*SOAGbg1 + 0.0676*SOAGbg2 + 0.079*SOAGbg3 + 0.1254*SOAGbg4 ; 2.7e-12, 360 [BCARY_O3_vbs] BCARY + O3 -> BCARY + O3 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 ; 1.2e-14 -[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 ; 2e-10 -[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + 0.0023*SOAGff0 + 0.0008*SOAGff1 + 0.0843*SOAGff2 + 0.0443*SOAGff3 + 0.1621*SOAGff4 ; 2.3e-12, -193 +[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + BCARYO2VBS ; 2e-10 +[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + BENZO2VBS ; 2.3e-12, -193 +[BENZO2_HO2_vbs] BENZO2VBS + HO2 -> HO2 + 0.0023*SOAGff0 + 0.0008*SOAGff1 + 0.0843*SOAGff2 + 0.0443*SOAGff3 + 0.1621*SOAGff4 ; 7.5e-13, 700 +[BENZO2_NO_vbs] BENZO2VBS + NO -> NO + 0.0097*SOAGff0 + 0.0034*SOAGff1 + 0.1579*SOAGff2 + 0.0059*SOAGff3 + 0.0536*SOAGff4 ; 2.6e-12, 365 [ISOP_NO3_vbs] ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAGbg3 + 0.025024*SOAGbg4 ; 3.03e-12, -446 +[ISOPO2_HO2_vbs] ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAGbg0 + 0.0035*SOAGbg1 + 0.0003*SOAGbg2 + 0.0271*SOAGbg3 + 0.0474*SOAGbg4 ; 2.12e-13, 1300 +[ISOPO2_NO_vbs] ISOPO2VBS + NO -> NO + 0.0003*SOAGbg0 + 0.0003*SOAGbg1 + 0.0073*SOAGbg2 + 0.0057*SOAGbg3 + 0.0623*SOAGbg4 ; 2.7e-12, 350 [ISOP_O3_vbs] ISOP + O3 -> ISOP + O3 + 0.0033*SOAGbg3 ; 1.05e-14, -2000 -[ISOP_OH_vbs] ISOP + OH -> ISOP + OH + 0.0031*SOAGbg0 + 0.0035*SOAGbg1 + 0.0003*SOAGbg2 + 0.0271*SOAGbg3 + 0.0474*SOAGbg4 ; 2.54e-11, 410 -[IVOCbb_OH] IVOCbb + OH -> OH + 0.2381*SOAGbb0 + 0.1308*SOAGbb1 + 0.0348*SOAGbb2 + 0.0076*SOAGbb3 + 0.0113*SOAGbb4 ; 1.34e-11 -[IVOCff_OH] IVOCff + OH -> OH + 0.2381*SOAGff0 + 0.1308*SOAGff1 + 0.0348*SOAGff2 + 0.0076*SOAGff3 + 0.0113*SOAGff4 ; 1.34e-11 +[ISOP_OH_vbs] ISOP + OH -> ISOP + OH + ISOPO2VBS ; 2.54e-11, 410 +[IVOCbbO2_HO2_vbs] IVOCbbO2VBS + HO2 -> HO2 + 0.2381*SOAGbb0 + 0.1308*SOAGbb1 + 0.0348*SOAGbb2 + 0.0076*SOAGbb3 + 0.0113*SOAGbb4 ; 7.5e-13, 700 +[IVOCbbO2_NO_vbs] IVOCbbO2VBS + NO -> NO + 0.1056*SOAGbb0 + 0.1026*SOAGbb1 + 0.0521*SOAGbb2 + 0.0143*SOAGbb3 + 0.0166*SOAGbb4 ; 2.6e-12, 365 +[IVOCbb_OH_vbs] IVOCbb + OH -> OH + IVOCbbO2VBS ; 1.34e-11 +[IVOCffO2_HO2_vbs] IVOCffO2VBS + HO2 -> HO2 + 0.2381*SOAGff0 + 0.1308*SOAGff1 + 0.0348*SOAGff2 + 0.0076*SOAGff3 + 0.0113*SOAGff4 ; 7.5e-13, 700 +[IVOCffO2_NO_vbs] IVOCffO2VBS + NO -> NO + 0.1056*SOAGff0 + 0.1026*SOAGff1 + 0.0521*SOAGff2 + 0.0143*SOAGff3 + 0.0166*SOAGff4 ; 2.6e-12, 365 +[IVOCff_OH_vbs] IVOCff + OH -> OH + IVOCffO2VBS ; 1.34e-11 [MTERP_NO3_vbs] MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 ; 1.2e-12, 490 +[MTERPO2_HO2_vbs] MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 ; 2.6e-13, 1300 +[MTERPO2_NO_vbs] MTERPO2VBS + NO -> NO + 0.0245*SOAGbg0 + 0.0082*SOAGbg1 + 0.0772*SOAGbg2 + 0.0332*SOAGbg3 + 0.13*SOAGbg4 ; 2.7e-12, 360 [MTERP_O3_vbs] MTERP + O3 -> MTERP + O3 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 ; 6.3e-16, -580 -[MTERP_OH_vbs] MTERP + OH -> MTERP + OH + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 ; 1.2e-11, 440 +[MTERP_OH_vbs] MTERP + OH -> MTERP + OH + MTERPO2VBS ; 1.2e-11, 440 [SVOCbb_OH] SVOCbb + OH -> OH + 0.5931*SOAGbb0 + 0.1534*SOAGbb1 + 0.0459*SOAGbb2 + 0.0085*SOAGbb3 + 0.0128*SOAGbb4 ; 1.34e-11 [SVOCff_OH] SVOCff + OH -> OH + 0.5931*SOAGff0 + 0.1534*SOAGff1 + 0.0459*SOAGff2 + 0.0085*SOAGff3 + 0.0128*SOAGff4 ; 1.34e-11 -[TOLUENE_OH_vbs] TOLUENE + OH -> TOLUENE + OH + 0.1364*SOAGff0 + 0.0101*SOAGff1 + 0.0763*SOAGff2 + 0.2157*SOAGff3 + 0.0738*SOAGff4 ; 1.7e-12, 352 -[XYLENES_OH_vbs] XYLENES + OH -> XYLENES + OH + 0.1677*SOAGff0 + 0.0174*SOAGff1 + 0.086*SOAGff2 + 0.0512*SOAGff3 + 0.1598*SOAGff4 ; 1.7e-11 +[TOLUENE_OH_vbs] TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS ; 1.7e-12, 352 +[TOLUO2_HO2_vbs] TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAGff0 + 0.0101*SOAGff1 + 0.0763*SOAGff2 + 0.2157*SOAGff3 + 0.0738*SOAGff4 ; 7.5e-13, 700 +[TOLUO2_NO_vbs] TOLUO2VBS + NO -> NO + 0.0154*SOAGff0 + 0.0452*SOAGff1 + 0.0966*SOAGff2 + 0.0073*SOAGff3 + 0.238*SOAGff4 ; 2.6e-12, 365 +[usr_GLYOXAL_aer] GLYOXAL -> SOAGbg0 +[XYLENES_OH_vbs] XYLENES + OH -> XYLENES + OH + XYLEO2VBS ; 1.7e-11 +[XYLEO2_HO2_vbs] XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAGff0 + 0.0174*SOAGff1 + 0.086*SOAGff2 + 0.0512*SOAGff3 + 0.1598*SOAGff4 ; 7.5e-13, 700 +[XYLEO2_NO_vbs] XYLEO2VBS + NO -> NO + 0.0063*SOAGff0 + 0.0237*SOAGff1 + 0.0025*SOAGff2 + 0.011*SOAGff3 + 0.1185*SOAGff4 ; 2.6e-12, 365 ********************************* *** Stratospheric Aerosol ********************************* diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 index 81fd6d4a31..8d8e9ab335 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/chem_mods.F90 @@ -6,24 +6,24 @@ module chem_mods implicit none save integer, parameter :: phtcnt = 143, & ! number of photolysis reactions - rxntot = 547, & ! number of total reactions - gascnt = 404, & ! number of gas phase reactions + rxntot = 562, & ! number of total reactions + gascnt = 419, & ! number of gas phase reactions nabscol = 2, & ! number of absorbing column densities - gas_pcnst = 253, & ! number of "gas phase" species + gas_pcnst = 261, & ! number of "gas phase" species nfs = 3, & ! number of "fixed" species relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members - nzcnt = 2078, & ! number of non-zero matrix entries + nzcnt = 2356, & ! number of non-zero matrix entries extcnt = 18, & ! number of species with external forcing - clscnt1 = 28, & ! number of species in explicit class + 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 = 225, & ! number of species in implicit class + clscnt4 = 259, & ! 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 = 547, & + rxt_tag_cnt = 562, & enthalpy_cnt = 18, & nslvd = 34 integer :: clscnt(5) = 0 diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/m_rxt_id.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/m_rxt_id.F90 index fdcd138db5..dab363e8f7 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/m_rxt_id.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/m_rxt_id.F90 @@ -31,8 +31,8 @@ module m_rxt_id integer, parameter :: rid_jc2h5ooh = 29 integer, parameter :: rid_jc3h7ooh = 30 integer, parameter :: rid_jc6h5ooh = 31 - integer, parameter :: rid_jch2o_a = 32 - integer, parameter :: rid_jch2o_b = 33 + integer, parameter :: rid_jch2o_b = 32 + integer, parameter :: rid_jch2o_a = 33 integer, parameter :: rid_jch3cho = 34 integer, parameter :: rid_jacet = 35 integer, parameter :: rid_jmgly = 36 @@ -49,8 +49,8 @@ module m_rxt_id integer, parameter :: rid_jhyac = 47 integer, parameter :: rid_jisopnooh = 48 integer, parameter :: rid_jisopooh = 49 - integer, parameter :: rid_jmacr_a = 50 - integer, parameter :: rid_jmacr_b = 51 + integer, parameter :: rid_jmacr_b = 50 + integer, parameter :: rid_jmacr_a = 51 integer, parameter :: rid_jmek = 52 integer, parameter :: rid_jmekooh = 53 integer, parameter :: rid_jmpan = 54 @@ -284,208 +284,208 @@ module m_rxt_id integer, parameter :: rid_CH3OH_OH = 282 integer, parameter :: rid_CH3OOH_OH = 283 integer, parameter :: rid_CH4_OH = 284 - integer, parameter :: rid_CO_OH_M = 285 - integer, parameter :: rid_HCN_OH = 286 - integer, parameter :: rid_HCOOH_OH = 287 - integer, parameter :: rid_HOCH2OO_HO2 = 288 - integer, parameter :: rid_HOCH2OO_M = 289 - integer, parameter :: rid_HOCH2OO_NO = 290 - integer, parameter :: rid_O1D_CH4a = 291 - integer, parameter :: rid_O1D_CH4b = 292 - integer, parameter :: rid_O1D_CH4c = 293 - integer, parameter :: rid_O1D_HCN = 294 - integer, parameter :: rid_usr_CO_OH_b = 295 - integer, parameter :: rid_C2H2_CL_M = 296 - integer, parameter :: rid_C2H2_OH_M = 297 - integer, parameter :: rid_C2H4_CL_M = 298 - integer, parameter :: rid_C2H4_O3 = 299 - integer, parameter :: rid_C2H5O2_C2H5O2 = 300 - integer, parameter :: rid_C2H5O2_CH3O2 = 301 - integer, parameter :: rid_C2H5O2_HO2 = 302 - integer, parameter :: rid_C2H5O2_NO = 303 - integer, parameter :: rid_C2H5OH_OH = 304 - integer, parameter :: rid_C2H5OOH_OH = 305 - integer, parameter :: rid_C2H6_CL = 306 - integer, parameter :: rid_C2H6_OH = 307 - integer, parameter :: rid_CH3CHO_NO3 = 308 - integer, parameter :: rid_CH3CHO_OH = 309 - integer, parameter :: rid_CH3CN_OH = 310 - integer, parameter :: rid_CH3CO3_CH3CO3 = 311 - integer, parameter :: rid_CH3CO3_CH3O2 = 312 - integer, parameter :: rid_CH3CO3_HO2 = 313 - integer, parameter :: rid_CH3CO3_NO = 314 - integer, parameter :: rid_CH3COOH_OH = 315 - integer, parameter :: rid_CH3COOOH_OH = 316 - integer, parameter :: rid_EO2_HO2 = 317 - integer, parameter :: rid_EO2_NO = 318 - integer, parameter :: rid_EO_M = 319 - integer, parameter :: rid_EO_O2 = 320 - integer, parameter :: rid_GLYALD_OH = 321 - integer, parameter :: rid_GLYOXAL_OH = 322 - integer, parameter :: rid_PAN_OH = 323 - integer, parameter :: rid_tag_C2H4_OH = 324 - integer, parameter :: rid_tag_CH3CO3_NO2 = 325 - integer, parameter :: rid_usr_PAN_M = 326 - integer, parameter :: rid_C3H6_NO3 = 327 - integer, parameter :: rid_C3H6_O3 = 328 - integer, parameter :: rid_C3H7O2_CH3O2 = 329 - integer, parameter :: rid_C3H7O2_HO2 = 330 - integer, parameter :: rid_C3H7O2_NO = 331 - integer, parameter :: rid_C3H7OOH_OH = 332 - integer, parameter :: rid_C3H8_OH = 333 - integer, parameter :: rid_CH3COCHO_NO3 = 334 - integer, parameter :: rid_CH3COCHO_OH = 335 - integer, parameter :: rid_HYAC_OH = 336 - integer, parameter :: rid_NOA_OH = 337 - integer, parameter :: rid_PO2_HO2 = 338 - integer, parameter :: rid_PO2_NO = 339 - integer, parameter :: rid_POOH_OH = 340 - integer, parameter :: rid_RO2_CH3O2 = 341 - integer, parameter :: rid_RO2_HO2 = 342 - integer, parameter :: rid_RO2_NO = 343 - integer, parameter :: rid_ROOH_OH = 344 - integer, parameter :: rid_tag_C3H6_OH = 345 - integer, parameter :: rid_usr_CH3COCH3_OH = 346 - integer, parameter :: rid_BIGENE_NO3 = 347 - integer, parameter :: rid_BIGENE_OH = 348 - integer, parameter :: rid_ENEO2_NO = 349 - integer, parameter :: rid_ENEO2_NOb = 350 - integer, parameter :: rid_HONITR_OH = 351 - integer, parameter :: rid_MACRO2_CH3CO3 = 352 - integer, parameter :: rid_MACRO2_CH3O2 = 353 - integer, parameter :: rid_MACRO2_HO2 = 354 - integer, parameter :: rid_MACRO2_NO3 = 355 - integer, parameter :: rid_MACRO2_NOa = 356 - integer, parameter :: rid_MACRO2_NOb = 357 - integer, parameter :: rid_MACR_O3 = 358 - integer, parameter :: rid_MACR_OH = 359 - integer, parameter :: rid_MACROOH_OH = 360 - integer, parameter :: rid_MCO3_CH3CO3 = 361 - integer, parameter :: rid_MCO3_CH3O2 = 362 - integer, parameter :: rid_MCO3_HO2 = 363 - integer, parameter :: rid_MCO3_MCO3 = 364 - integer, parameter :: rid_MCO3_NO = 365 - integer, parameter :: rid_MCO3_NO3 = 366 - integer, parameter :: rid_MEKO2_HO2 = 367 - integer, parameter :: rid_MEKO2_NO = 368 - integer, parameter :: rid_MEK_OH = 369 - integer, parameter :: rid_MEKOOH_OH = 370 - integer, parameter :: rid_MPAN_OH_M = 371 - integer, parameter :: rid_MVK_O3 = 372 - integer, parameter :: rid_MVK_OH = 373 - integer, parameter :: rid_usr_MCO3_NO2 = 374 - integer, parameter :: rid_usr_MPAN_M = 375 - integer, parameter :: rid_ALKNIT_OH = 376 - integer, parameter :: rid_ALKO2_HO2 = 377 - integer, parameter :: rid_ALKO2_NO = 378 - integer, parameter :: rid_ALKO2_NOb = 379 - integer, parameter :: rid_ALKOOH_OH = 380 - integer, parameter :: rid_BIGALK_OH = 381 - integer, parameter :: rid_HPALD_OH = 382 - integer, parameter :: rid_HYDRALD_OH = 383 - integer, parameter :: rid_IEPOX_OH = 384 - integer, parameter :: rid_ISOPAO2_CH3CO3 = 385 - integer, parameter :: rid_ISOPAO2_CH3O2 = 386 - integer, parameter :: rid_ISOPAO2_HO2 = 387 - integer, parameter :: rid_ISOPAO2_NO = 388 - integer, parameter :: rid_ISOPAO2_NO3 = 389 - integer, parameter :: rid_ISOPBO2_CH3CO3 = 390 - integer, parameter :: rid_ISOPBO2_CH3O2 = 391 - integer, parameter :: rid_ISOPBO2_HO2 = 392 - integer, parameter :: rid_ISOPBO2_M = 393 - integer, parameter :: rid_ISOPBO2_NO = 394 - integer, parameter :: rid_ISOPBO2_NO3 = 395 - integer, parameter :: rid_ISOPNITA_OH = 396 - integer, parameter :: rid_ISOPNITB_OH = 397 - integer, parameter :: rid_ISOP_NO3 = 398 - integer, parameter :: rid_ISOPNO3_CH3CO3 = 399 - integer, parameter :: rid_ISOPNO3_CH3O2 = 400 - integer, parameter :: rid_ISOPNO3_HO2 = 401 - integer, parameter :: rid_ISOPNO3_NO = 402 - integer, parameter :: rid_ISOPNO3_NO3 = 403 - integer, parameter :: rid_ISOPNOOH_OH = 404 - integer, parameter :: rid_ISOP_O3 = 405 - integer, parameter :: rid_ISOP_OH = 406 - integer, parameter :: rid_ISOPOOH_OH = 407 - integer, parameter :: rid_NC4CH2OH_OH = 408 - integer, parameter :: rid_NC4CHO_OH = 409 - integer, parameter :: rid_XO2_CH3CO3 = 410 - integer, parameter :: rid_XO2_CH3O2 = 411 - integer, parameter :: rid_XO2_HO2 = 412 - integer, parameter :: rid_XO2_NO = 413 - integer, parameter :: rid_XO2_NO3 = 414 - integer, parameter :: rid_XOOH_OH = 415 - integer, parameter :: rid_ACBZO2_HO2 = 416 - integer, parameter :: rid_ACBZO2_NO = 417 - integer, parameter :: rid_BENZENE_OH = 418 - integer, parameter :: rid_BENZO2_HO2 = 419 - integer, parameter :: rid_BENZO2_NO = 420 - integer, parameter :: rid_BENZOOH_OH = 421 - integer, parameter :: rid_BZALD_OH = 422 - integer, parameter :: rid_BZOO_HO2 = 423 - integer, parameter :: rid_BZOOH_OH = 424 - integer, parameter :: rid_BZOO_NO = 425 - integer, parameter :: rid_C6H5O2_HO2 = 426 - integer, parameter :: rid_C6H5O2_NO = 427 - integer, parameter :: rid_C6H5OOH_OH = 428 - integer, parameter :: rid_CRESOL_OH = 429 - integer, parameter :: rid_DICARBO2_HO2 = 430 - integer, parameter :: rid_DICARBO2_NO = 431 - integer, parameter :: rid_DICARBO2_NO2 = 432 - integer, parameter :: rid_MALO2_HO2 = 433 - integer, parameter :: rid_MALO2_NO = 434 - integer, parameter :: rid_MALO2_NO2 = 435 - integer, parameter :: rid_MDIALO2_HO2 = 436 - integer, parameter :: rid_MDIALO2_NO = 437 - integer, parameter :: rid_MDIALO2_NO2 = 438 - integer, parameter :: rid_PHENO2_HO2 = 439 - integer, parameter :: rid_PHENO2_NO = 440 - integer, parameter :: rid_PHENOL_OH = 441 - integer, parameter :: rid_PHENO_NO2 = 442 - integer, parameter :: rid_PHENO_O3 = 443 - integer, parameter :: rid_PHENOOH_OH = 444 - integer, parameter :: rid_tag_ACBZO2_NO2 = 445 - integer, parameter :: rid_TOLO2_HO2 = 446 - integer, parameter :: rid_TOLO2_NO = 447 - integer, parameter :: rid_TOLOOH_OH = 448 - integer, parameter :: rid_TOLUENE_OH = 449 - integer, parameter :: rid_usr_PBZNIT_M = 450 - integer, parameter :: rid_XYLENES_OH = 451 - integer, parameter :: rid_XYLENO2_HO2 = 452 - integer, parameter :: rid_XYLENO2_NO = 453 - integer, parameter :: rid_XYLENOOH_OH = 454 - integer, parameter :: rid_XYLOLO2_HO2 = 455 - integer, parameter :: rid_XYLOLO2_NO = 456 - integer, parameter :: rid_XYLOL_OH = 457 - integer, parameter :: rid_XYLOLOOH_OH = 458 - integer, parameter :: rid_BCARY_NO3 = 459 - integer, parameter :: rid_BCARY_O3 = 460 - integer, parameter :: rid_BCARY_OH = 461 - integer, parameter :: rid_MTERP_NO3 = 462 - integer, parameter :: rid_MTERP_O3 = 463 - integer, parameter :: rid_MTERP_OH = 464 - integer, parameter :: rid_NTERPO2_CH3O2 = 465 - integer, parameter :: rid_NTERPO2_HO2 = 466 - integer, parameter :: rid_NTERPO2_NO = 467 - integer, parameter :: rid_NTERPO2_NO3 = 468 - integer, parameter :: rid_NTERPOOH_OH = 469 - integer, parameter :: rid_TERP2O2_CH3O2 = 470 - integer, parameter :: rid_TERP2O2_HO2 = 471 - integer, parameter :: rid_TERP2O2_NO = 472 - integer, parameter :: rid_TERP2OOH_OH = 473 - integer, parameter :: rid_TERPNIT_OH = 474 - integer, parameter :: rid_TERPO2_CH3O2 = 475 - integer, parameter :: rid_TERPO2_HO2 = 476 - integer, parameter :: rid_TERPO2_NO = 477 - integer, parameter :: rid_TERPOOH_OH = 478 - integer, parameter :: rid_TERPROD1_NO3 = 479 - integer, parameter :: rid_TERPROD1_OH = 480 - integer, parameter :: rid_TERPROD2_OH = 481 - integer, parameter :: rid_DMS_NO3 = 482 - integer, parameter :: rid_DMS_OHa = 483 - integer, parameter :: rid_OCS_O = 484 - integer, parameter :: rid_OCS_OH = 485 - integer, parameter :: rid_S_O2 = 486 + integer, parameter :: rid_HCN_OH = 285 + integer, parameter :: rid_HCOOH_OH = 286 + integer, parameter :: rid_HOCH2OO_HO2 = 287 + integer, parameter :: rid_HOCH2OO_M = 288 + integer, parameter :: rid_HOCH2OO_NO = 289 + integer, parameter :: rid_O1D_CH4a = 290 + integer, parameter :: rid_O1D_CH4b = 291 + integer, parameter :: rid_O1D_CH4c = 292 + integer, parameter :: rid_O1D_HCN = 293 + integer, parameter :: rid_usr_CO_OH = 294 + integer, parameter :: rid_C2H2_CL_M = 295 + integer, parameter :: rid_C2H2_OH_M = 296 + integer, parameter :: rid_C2H4_CL_M = 297 + integer, parameter :: rid_C2H4_O3 = 298 + integer, parameter :: rid_C2H5O2_C2H5O2 = 299 + integer, parameter :: rid_C2H5O2_CH3O2 = 300 + integer, parameter :: rid_C2H5O2_HO2 = 301 + integer, parameter :: rid_C2H5O2_NO = 302 + integer, parameter :: rid_C2H5OH_OH = 303 + integer, parameter :: rid_C2H5OOH_OH = 304 + integer, parameter :: rid_C2H6_CL = 305 + integer, parameter :: rid_C2H6_OH = 306 + integer, parameter :: rid_CH3CHO_NO3 = 307 + integer, parameter :: rid_CH3CHO_OH = 308 + integer, parameter :: rid_CH3CN_OH = 309 + integer, parameter :: rid_CH3CO3_CH3CO3 = 310 + integer, parameter :: rid_CH3CO3_CH3O2 = 311 + integer, parameter :: rid_CH3CO3_HO2 = 312 + integer, parameter :: rid_CH3CO3_NO = 313 + integer, parameter :: rid_CH3COOH_OH = 314 + integer, parameter :: rid_CH3COOOH_OH = 315 + integer, parameter :: rid_EO2_HO2 = 316 + integer, parameter :: rid_EO2_NO = 317 + integer, parameter :: rid_EO_M = 318 + integer, parameter :: rid_EO_O2 = 319 + integer, parameter :: rid_GLYALD_OH = 320 + integer, parameter :: rid_GLYOXAL_OH = 321 + integer, parameter :: rid_PAN_OH = 322 + integer, parameter :: rid_tag_C2H4_OH = 323 + integer, parameter :: rid_tag_CH3CO3_NO2 = 324 + integer, parameter :: rid_usr_PAN_M = 325 + integer, parameter :: rid_C3H6_NO3 = 326 + integer, parameter :: rid_C3H6_O3 = 327 + integer, parameter :: rid_C3H7O2_CH3O2 = 328 + integer, parameter :: rid_C3H7O2_HO2 = 329 + integer, parameter :: rid_C3H7O2_NO = 330 + integer, parameter :: rid_C3H7OOH_OH = 331 + integer, parameter :: rid_C3H8_OH = 332 + integer, parameter :: rid_CH3COCHO_NO3 = 333 + integer, parameter :: rid_CH3COCHO_OH = 334 + integer, parameter :: rid_HYAC_OH = 335 + integer, parameter :: rid_NOA_OH = 336 + integer, parameter :: rid_PO2_HO2 = 337 + integer, parameter :: rid_PO2_NO = 338 + integer, parameter :: rid_POOH_OH = 339 + integer, parameter :: rid_RO2_CH3O2 = 340 + integer, parameter :: rid_RO2_HO2 = 341 + integer, parameter :: rid_RO2_NO = 342 + integer, parameter :: rid_ROOH_OH = 343 + integer, parameter :: rid_tag_C3H6_OH = 344 + integer, parameter :: rid_usr_CH3COCH3_OH = 345 + integer, parameter :: rid_BIGENE_NO3 = 346 + integer, parameter :: rid_BIGENE_OH = 347 + integer, parameter :: rid_ENEO2_NO = 348 + integer, parameter :: rid_ENEO2_NOb = 349 + integer, parameter :: rid_HONITR_OH = 350 + integer, parameter :: rid_MACRO2_CH3CO3 = 351 + integer, parameter :: rid_MACRO2_CH3O2 = 352 + integer, parameter :: rid_MACRO2_HO2 = 353 + integer, parameter :: rid_MACRO2_NO3 = 354 + integer, parameter :: rid_MACRO2_NOa = 355 + integer, parameter :: rid_MACRO2_NOb = 356 + integer, parameter :: rid_MACR_O3 = 357 + integer, parameter :: rid_MACR_OH = 358 + integer, parameter :: rid_MACROOH_OH = 359 + integer, parameter :: rid_MCO3_CH3CO3 = 360 + integer, parameter :: rid_MCO3_CH3O2 = 361 + integer, parameter :: rid_MCO3_HO2 = 362 + integer, parameter :: rid_MCO3_MCO3 = 363 + integer, parameter :: rid_MCO3_NO = 364 + integer, parameter :: rid_MCO3_NO3 = 365 + integer, parameter :: rid_MEKO2_HO2 = 366 + integer, parameter :: rid_MEKO2_NO = 367 + integer, parameter :: rid_MEK_OH = 368 + integer, parameter :: rid_MEKOOH_OH = 369 + integer, parameter :: rid_MPAN_OH_M = 370 + integer, parameter :: rid_MVK_O3 = 371 + integer, parameter :: rid_MVK_OH = 372 + integer, parameter :: rid_usr_MCO3_NO2 = 373 + integer, parameter :: rid_usr_MPAN_M = 374 + integer, parameter :: rid_ALKNIT_OH = 375 + integer, parameter :: rid_ALKO2_HO2 = 376 + integer, parameter :: rid_ALKO2_NO = 377 + integer, parameter :: rid_ALKO2_NOb = 378 + integer, parameter :: rid_ALKOOH_OH = 379 + integer, parameter :: rid_BIGALK_OH = 380 + integer, parameter :: rid_HPALD_OH = 381 + integer, parameter :: rid_HYDRALD_OH = 382 + integer, parameter :: rid_IEPOX_OH = 383 + integer, parameter :: rid_ISOPAO2_CH3CO3 = 384 + integer, parameter :: rid_ISOPAO2_CH3O2 = 385 + integer, parameter :: rid_ISOPAO2_HO2 = 386 + integer, parameter :: rid_ISOPAO2_NO = 387 + integer, parameter :: rid_ISOPAO2_NO3 = 388 + integer, parameter :: rid_ISOPBO2_CH3CO3 = 389 + integer, parameter :: rid_ISOPBO2_CH3O2 = 390 + integer, parameter :: rid_ISOPBO2_HO2 = 391 + integer, parameter :: rid_ISOPBO2_M = 392 + integer, parameter :: rid_ISOPBO2_NO = 393 + integer, parameter :: rid_ISOPBO2_NO3 = 394 + integer, parameter :: rid_ISOPNITA_OH = 395 + integer, parameter :: rid_ISOPNITB_OH = 396 + integer, parameter :: rid_ISOP_NO3 = 397 + integer, parameter :: rid_ISOPNO3_CH3CO3 = 398 + integer, parameter :: rid_ISOPNO3_CH3O2 = 399 + integer, parameter :: rid_ISOPNO3_HO2 = 400 + integer, parameter :: rid_ISOPNO3_NO = 401 + integer, parameter :: rid_ISOPNO3_NO3 = 402 + integer, parameter :: rid_ISOPNOOH_OH = 403 + integer, parameter :: rid_ISOP_O3 = 404 + integer, parameter :: rid_ISOP_OH = 405 + integer, parameter :: rid_ISOPOOH_OH = 406 + integer, parameter :: rid_NC4CH2OH_OH = 407 + integer, parameter :: rid_NC4CHO_OH = 408 + integer, parameter :: rid_XO2_CH3CO3 = 409 + integer, parameter :: rid_XO2_CH3O2 = 410 + integer, parameter :: rid_XO2_HO2 = 411 + integer, parameter :: rid_XO2_NO = 412 + integer, parameter :: rid_XO2_NO3 = 413 + integer, parameter :: rid_XOOH_OH = 414 + integer, parameter :: rid_ACBZO2_HO2 = 415 + integer, parameter :: rid_ACBZO2_NO = 416 + integer, parameter :: rid_BENZENE_OH = 417 + integer, parameter :: rid_BENZO2_HO2 = 418 + integer, parameter :: rid_BENZO2_NO = 419 + integer, parameter :: rid_BENZOOH_OH = 420 + integer, parameter :: rid_BZALD_OH = 421 + integer, parameter :: rid_BZOO_HO2 = 422 + integer, parameter :: rid_BZOOH_OH = 423 + integer, parameter :: rid_BZOO_NO = 424 + integer, parameter :: rid_C6H5O2_HO2 = 425 + integer, parameter :: rid_C6H5O2_NO = 426 + integer, parameter :: rid_C6H5OOH_OH = 427 + integer, parameter :: rid_CRESOL_OH = 428 + integer, parameter :: rid_DICARBO2_HO2 = 429 + integer, parameter :: rid_DICARBO2_NO = 430 + integer, parameter :: rid_DICARBO2_NO2 = 431 + integer, parameter :: rid_MALO2_HO2 = 432 + integer, parameter :: rid_MALO2_NO = 433 + integer, parameter :: rid_MALO2_NO2 = 434 + integer, parameter :: rid_MDIALO2_HO2 = 435 + integer, parameter :: rid_MDIALO2_NO = 436 + integer, parameter :: rid_MDIALO2_NO2 = 437 + integer, parameter :: rid_PHENO2_HO2 = 438 + integer, parameter :: rid_PHENO2_NO = 439 + integer, parameter :: rid_PHENOL_OH = 440 + integer, parameter :: rid_PHENO_NO2 = 441 + integer, parameter :: rid_PHENO_O3 = 442 + integer, parameter :: rid_PHENOOH_OH = 443 + integer, parameter :: rid_tag_ACBZO2_NO2 = 444 + integer, parameter :: rid_TOLO2_HO2 = 445 + integer, parameter :: rid_TOLO2_NO = 446 + integer, parameter :: rid_TOLOOH_OH = 447 + integer, parameter :: rid_TOLUENE_OH = 448 + integer, parameter :: rid_usr_PBZNIT_M = 449 + integer, parameter :: rid_XYLENES_OH = 450 + integer, parameter :: rid_XYLENO2_HO2 = 451 + integer, parameter :: rid_XYLENO2_NO = 452 + integer, parameter :: rid_XYLENOOH_OH = 453 + integer, parameter :: rid_XYLOLO2_HO2 = 454 + integer, parameter :: rid_XYLOLO2_NO = 455 + integer, parameter :: rid_XYLOL_OH = 456 + integer, parameter :: rid_XYLOLOOH_OH = 457 + integer, parameter :: rid_BCARY_NO3 = 458 + integer, parameter :: rid_BCARY_O3 = 459 + integer, parameter :: rid_BCARY_OH = 460 + integer, parameter :: rid_MTERP_NO3 = 461 + integer, parameter :: rid_MTERP_O3 = 462 + integer, parameter :: rid_MTERP_OH = 463 + integer, parameter :: rid_NTERPO2_CH3O2 = 464 + integer, parameter :: rid_NTERPO2_HO2 = 465 + integer, parameter :: rid_NTERPO2_NO = 466 + integer, parameter :: rid_NTERPO2_NO3 = 467 + integer, parameter :: rid_NTERPOOH_OH = 468 + integer, parameter :: rid_TERP2O2_CH3O2 = 469 + integer, parameter :: rid_TERP2O2_HO2 = 470 + integer, parameter :: rid_TERP2O2_NO = 471 + integer, parameter :: rid_TERP2OOH_OH = 472 + integer, parameter :: rid_TERPNIT_OH = 473 + integer, parameter :: rid_TERPO2_CH3O2 = 474 + integer, parameter :: rid_TERPO2_HO2 = 475 + integer, parameter :: rid_TERPO2_NO = 476 + integer, parameter :: rid_TERPOOH_OH = 477 + integer, parameter :: rid_TERPROD1_NO3 = 478 + integer, parameter :: rid_TERPROD1_OH = 479 + integer, parameter :: rid_TERPROD2_OH = 480 + integer, parameter :: rid_DMS_NO3 = 481 + integer, parameter :: rid_DMS_OHa = 482 + integer, parameter :: rid_OCS_O = 483 + integer, parameter :: rid_OCS_OH = 484 + integer, parameter :: rid_S_O2 = 485 + integer, parameter :: rid_SO2_OH_M = 486 integer, parameter :: rid_S_O3 = 487 integer, parameter :: rid_SO_BRO = 488 integer, parameter :: rid_SO_CLO = 489 @@ -496,55 +496,70 @@ module m_rxt_id integer, parameter :: rid_SO_OCLO = 494 integer, parameter :: rid_SO_OH = 495 integer, parameter :: rid_usr_DMS_OH = 496 - integer, parameter :: rid_usr_SO2_OH = 497 - integer, parameter :: rid_usr_SO3_H2O = 498 - integer, parameter :: rid_NH3_OH = 499 - integer, parameter :: rid_usr_GLYOXAL_aer = 500 - integer, parameter :: rid_usr_HO2_aer = 501 - integer, parameter :: rid_usr_HONITR_aer = 502 - integer, parameter :: rid_usr_ISOPNITA_aer = 503 - integer, parameter :: rid_usr_ISOPNITB_aer = 504 - integer, parameter :: rid_usr_N2O5_aer = 505 - integer, parameter :: rid_usr_NC4CH2OH_aer = 506 - integer, parameter :: rid_usr_NC4CHO_aer = 507 - integer, parameter :: rid_usr_NH4_strat_tau = 508 - integer, parameter :: rid_usr_NO2_aer = 509 - integer, parameter :: rid_usr_NO3_aer = 510 - integer, parameter :: rid_usr_NTERPOOH_aer = 511 - integer, parameter :: rid_usr_ONITR_aer = 512 - integer, parameter :: rid_usr_TERPNIT_aer = 513 - integer, parameter :: rid_BCARY_NO3_vbs = 514 + integer, parameter :: rid_usr_SO3_H2O = 497 + integer, parameter :: rid_NH3_OH = 498 + integer, parameter :: rid_usr_HO2_aer = 499 + integer, parameter :: rid_usr_HONITR_aer = 500 + integer, parameter :: rid_usr_ISOPNITA_aer = 501 + integer, parameter :: rid_usr_ISOPNITB_aer = 502 + integer, parameter :: rid_usr_N2O5_aer = 503 + integer, parameter :: rid_usr_NC4CH2OH_aer = 504 + integer, parameter :: rid_usr_NC4CHO_aer = 505 + integer, parameter :: rid_usr_NH4_strat_tau = 506 + integer, parameter :: rid_usr_NO2_aer = 507 + integer, parameter :: rid_usr_NO3_aer = 508 + integer, parameter :: rid_usr_NTERPOOH_aer = 509 + integer, parameter :: rid_usr_ONITR_aer = 510 + integer, parameter :: rid_usr_TERPNIT_aer = 511 + integer, parameter :: rid_BCARY_NO3_vbs = 512 + integer, parameter :: rid_BCARYO2_HO2_vbs = 513 + integer, parameter :: rid_BCARYO2_NO_vbs = 514 integer, parameter :: rid_BCARY_O3_vbs = 515 integer, parameter :: rid_BCARY_OH_vbs = 516 integer, parameter :: rid_BENZENE_OH_vbs = 517 - integer, parameter :: rid_ISOP_NO3_vbs = 518 - integer, parameter :: rid_ISOP_O3_vbs = 519 - integer, parameter :: rid_ISOP_OH_vbs = 520 - integer, parameter :: rid_IVOCbb_OH = 521 - integer, parameter :: rid_IVOCff_OH = 522 - integer, parameter :: rid_MTERP_NO3_vbs = 523 - integer, parameter :: rid_MTERP_O3_vbs = 524 - integer, parameter :: rid_MTERP_OH_vbs = 525 - integer, parameter :: rid_SVOCbb_OH = 526 - integer, parameter :: rid_SVOCff_OH = 527 - integer, parameter :: rid_TOLUENE_OH_vbs = 528 - integer, parameter :: rid_XYLENES_OH_vbs = 529 - integer, parameter :: rid_het1 = 530 - integer, parameter :: rid_het10 = 531 - integer, parameter :: rid_het11 = 532 - integer, parameter :: rid_het12 = 533 - integer, parameter :: rid_het13 = 534 - integer, parameter :: rid_het14 = 535 - integer, parameter :: rid_het15 = 536 - integer, parameter :: rid_het16 = 537 - integer, parameter :: rid_het17 = 538 - integer, parameter :: rid_het2 = 539 - integer, parameter :: rid_het3 = 540 - integer, parameter :: rid_het4 = 541 - integer, parameter :: rid_het5 = 542 - integer, parameter :: rid_het6 = 543 - integer, parameter :: rid_het7 = 544 - integer, parameter :: rid_het8 = 545 - integer, parameter :: rid_het9 = 546 - integer, parameter :: rid_E90_tau = 547 + integer, parameter :: rid_BENZO2_HO2_vbs = 518 + integer, parameter :: rid_BENZO2_NO_vbs = 519 + integer, parameter :: rid_ISOP_NO3_vbs = 520 + integer, parameter :: rid_ISOPO2_HO2_vbs = 521 + integer, parameter :: rid_ISOPO2_NO_vbs = 522 + integer, parameter :: rid_ISOP_O3_vbs = 523 + integer, parameter :: rid_ISOP_OH_vbs = 524 + integer, parameter :: rid_IVOCbbO2_HO2_vbs = 525 + integer, parameter :: rid_IVOCbbO2_NO_vbs = 526 + integer, parameter :: rid_IVOCbb_OH_vbs = 527 + integer, parameter :: rid_IVOCffO2_HO2_vbs = 528 + integer, parameter :: rid_IVOCffO2_NO_vbs = 529 + integer, parameter :: rid_IVOCff_OH_vbs = 530 + integer, parameter :: rid_MTERP_NO3_vbs = 531 + integer, parameter :: rid_MTERPO2_HO2_vbs = 532 + integer, parameter :: rid_MTERPO2_NO_vbs = 533 + integer, parameter :: rid_MTERP_O3_vbs = 534 + integer, parameter :: rid_MTERP_OH_vbs = 535 + integer, parameter :: rid_SVOCbb_OH = 536 + integer, parameter :: rid_SVOCff_OH = 537 + integer, parameter :: rid_TOLUENE_OH_vbs = 538 + integer, parameter :: rid_TOLUO2_HO2_vbs = 539 + integer, parameter :: rid_TOLUO2_NO_vbs = 540 + integer, parameter :: rid_usr_GLYOXAL_aer = 541 + integer, parameter :: rid_XYLENES_OH_vbs = 542 + integer, parameter :: rid_XYLEO2_HO2_vbs = 543 + integer, parameter :: rid_XYLEO2_NO_vbs = 544 + integer, parameter :: rid_het1 = 545 + integer, parameter :: rid_het10 = 546 + integer, parameter :: rid_het11 = 547 + integer, parameter :: rid_het12 = 548 + integer, parameter :: rid_het13 = 549 + integer, parameter :: rid_het14 = 550 + integer, parameter :: rid_het15 = 551 + integer, parameter :: rid_het16 = 552 + integer, parameter :: rid_het17 = 553 + integer, parameter :: rid_het2 = 554 + integer, parameter :: rid_het3 = 555 + integer, parameter :: rid_het4 = 556 + integer, parameter :: rid_het5 = 557 + integer, parameter :: rid_het6 = 558 + integer, parameter :: rid_het7 = 559 + integer, parameter :: rid_het8 = 560 + integer, parameter :: rid_het9 = 561 + integer, parameter :: rid_E90_tau = 562 end module m_rxt_id diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/m_spc_id.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/m_spc_id.F90 index b09a5c2329..4e14829cd7 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/m_spc_id.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/m_spc_id.F90 @@ -6,251 +6,259 @@ module m_spc_id integer, parameter :: id_bc_a1 = 4 integer, parameter :: id_bc_a4 = 5 integer, parameter :: id_BCARY = 6 - integer, parameter :: id_BENZENE = 7 - integer, parameter :: id_BENZOOH = 8 - integer, parameter :: id_BEPOMUC = 9 - integer, parameter :: id_BIGALD = 10 - integer, parameter :: id_BIGALD1 = 11 - integer, parameter :: id_BIGALD2 = 12 - integer, parameter :: id_BIGALD3 = 13 - integer, parameter :: id_BIGALD4 = 14 - integer, parameter :: id_BIGALK = 15 - integer, parameter :: id_BIGENE = 16 - integer, parameter :: id_BR = 17 - integer, parameter :: id_BRCL = 18 - integer, parameter :: id_BRO = 19 - integer, parameter :: id_BRONO2 = 20 - integer, parameter :: id_BRY = 21 - integer, parameter :: id_BZALD = 22 - integer, parameter :: id_BZOOH = 23 - integer, parameter :: id_C2H2 = 24 - integer, parameter :: id_C2H4 = 25 - integer, parameter :: id_C2H5OH = 26 - integer, parameter :: id_C2H5OOH = 27 - integer, parameter :: id_C2H6 = 28 - integer, parameter :: id_C3H6 = 29 - integer, parameter :: id_C3H7OOH = 30 - integer, parameter :: id_C3H8 = 31 - integer, parameter :: id_C6H5OOH = 32 - integer, parameter :: id_CCL4 = 33 - integer, parameter :: id_CF2CLBR = 34 - integer, parameter :: id_CF3BR = 35 - integer, parameter :: id_CFC11 = 36 - integer, parameter :: id_CFC113 = 37 - integer, parameter :: id_CFC114 = 38 - integer, parameter :: id_CFC115 = 39 - integer, parameter :: id_CFC12 = 40 - integer, parameter :: id_CH2BR2 = 41 - integer, parameter :: id_CH2O = 42 - integer, parameter :: id_CH3BR = 43 - integer, parameter :: id_CH3CCL3 = 44 - integer, parameter :: id_CH3CHO = 45 - integer, parameter :: id_CH3CL = 46 - integer, parameter :: id_CH3CN = 47 - integer, parameter :: id_CH3COCH3 = 48 - integer, parameter :: id_CH3COCHO = 49 - integer, parameter :: id_CH3COOH = 50 - integer, parameter :: id_CH3COOOH = 51 - integer, parameter :: id_CH3OH = 52 - integer, parameter :: id_CH3OOH = 53 - integer, parameter :: id_CH4 = 54 - integer, parameter :: id_CHBR3 = 55 - integer, parameter :: id_CL = 56 - integer, parameter :: id_CL2 = 57 - integer, parameter :: id_CL2O2 = 58 - integer, parameter :: id_CLO = 59 - integer, parameter :: id_CLONO2 = 60 - integer, parameter :: id_CLY = 61 - integer, parameter :: id_CO = 62 - integer, parameter :: id_CO2 = 63 - integer, parameter :: id_COF2 = 64 - integer, parameter :: id_COFCL = 65 - integer, parameter :: id_CRESOL = 66 - integer, parameter :: id_DMS = 67 - integer, parameter :: id_dst_a1 = 68 - integer, parameter :: id_dst_a2 = 69 - integer, parameter :: id_dst_a3 = 70 - integer, parameter :: id_E90 = 71 - integer, parameter :: id_EOOH = 72 - integer, parameter :: id_F = 73 - integer, parameter :: id_GLYALD = 74 - integer, parameter :: id_GLYOXAL = 75 - integer, parameter :: id_H = 76 - integer, parameter :: id_H2 = 77 - integer, parameter :: id_H2402 = 78 - integer, parameter :: id_H2O2 = 79 - integer, parameter :: id_H2SO4 = 80 - integer, parameter :: id_HBR = 81 - integer, parameter :: id_HCFC141B = 82 - integer, parameter :: id_HCFC142B = 83 - integer, parameter :: id_HCFC22 = 84 - integer, parameter :: id_HCL = 85 - integer, parameter :: id_HCN = 86 - integer, parameter :: id_HCOOH = 87 - integer, parameter :: id_HF = 88 - integer, parameter :: id_HNO3 = 89 - integer, parameter :: id_HO2NO2 = 90 - integer, parameter :: id_HOBR = 91 - integer, parameter :: id_HOCL = 92 - integer, parameter :: id_HONITR = 93 - integer, parameter :: id_HPALD = 94 - integer, parameter :: id_HYAC = 95 - integer, parameter :: id_HYDRALD = 96 - integer, parameter :: id_IEPOX = 97 - integer, parameter :: id_ISOP = 98 - integer, parameter :: id_ISOPNITA = 99 - integer, parameter :: id_ISOPNITB = 100 - integer, parameter :: id_ISOPNO3 = 101 - integer, parameter :: id_ISOPNOOH = 102 - integer, parameter :: id_ISOPOOH = 103 - integer, parameter :: id_IVOCbb = 104 - integer, parameter :: id_IVOCff = 105 - integer, parameter :: id_MACR = 106 - integer, parameter :: id_MACROOH = 107 - integer, parameter :: id_MEK = 108 - integer, parameter :: id_MEKOOH = 109 - integer, parameter :: id_MPAN = 110 - integer, parameter :: id_MTERP = 111 - integer, parameter :: id_MVK = 112 - integer, parameter :: id_N = 113 - integer, parameter :: id_N2O = 114 - integer, parameter :: id_N2O5 = 115 - integer, parameter :: id_NC4CH2OH = 116 - integer, parameter :: id_NC4CHO = 117 - integer, parameter :: id_ncl_a1 = 118 - integer, parameter :: id_ncl_a2 = 119 - integer, parameter :: id_ncl_a3 = 120 - integer, parameter :: id_NH3 = 121 - integer, parameter :: id_NH4 = 122 - integer, parameter :: id_NO = 123 - integer, parameter :: id_NO2 = 124 - integer, parameter :: id_NO3 = 125 - integer, parameter :: id_NOA = 126 - integer, parameter :: id_NTERPOOH = 127 - integer, parameter :: id_num_a1 = 128 - integer, parameter :: id_num_a2 = 129 - integer, parameter :: id_num_a3 = 130 - integer, parameter :: id_num_a4 = 131 - integer, parameter :: id_O = 132 - integer, parameter :: id_O3 = 133 - integer, parameter :: id_O3S = 134 - integer, parameter :: id_OCLO = 135 - integer, parameter :: id_OCS = 136 - integer, parameter :: id_ONITR = 137 - integer, parameter :: id_PAN = 138 - integer, parameter :: id_PBZNIT = 139 - integer, parameter :: id_PHENO = 140 - integer, parameter :: id_PHENOL = 141 - integer, parameter :: id_PHENOOH = 142 - integer, parameter :: id_pombb1_a1 = 143 - integer, parameter :: id_pombb1_a4 = 144 - integer, parameter :: id_pomff1_a1 = 145 - integer, parameter :: id_pomff1_a4 = 146 - integer, parameter :: id_POOH = 147 - integer, parameter :: id_ROOH = 148 - integer, parameter :: id_S = 149 - integer, parameter :: id_SF6 = 150 - integer, parameter :: id_SO = 151 - integer, parameter :: id_SO2 = 152 - integer, parameter :: id_SO3 = 153 - integer, parameter :: id_so4_a1 = 154 - integer, parameter :: id_so4_a2 = 155 - integer, parameter :: id_so4_a3 = 156 - integer, parameter :: id_soabb1_a1 = 157 - integer, parameter :: id_soabb1_a2 = 158 - integer, parameter :: id_soabb2_a1 = 159 - integer, parameter :: id_soabb2_a2 = 160 - integer, parameter :: id_soabb3_a1 = 161 - integer, parameter :: id_soabb3_a2 = 162 - integer, parameter :: id_soabb4_a1 = 163 - integer, parameter :: id_soabb4_a2 = 164 - integer, parameter :: id_soabb5_a1 = 165 - integer, parameter :: id_soabb5_a2 = 166 - integer, parameter :: id_soabg1_a1 = 167 - integer, parameter :: id_soabg1_a2 = 168 - integer, parameter :: id_soabg2_a1 = 169 - integer, parameter :: id_soabg2_a2 = 170 - integer, parameter :: id_soabg3_a1 = 171 - integer, parameter :: id_soabg3_a2 = 172 - integer, parameter :: id_soabg4_a1 = 173 - integer, parameter :: id_soabg4_a2 = 174 - integer, parameter :: id_soabg5_a1 = 175 - integer, parameter :: id_soabg5_a2 = 176 - integer, parameter :: id_soaff1_a1 = 177 - integer, parameter :: id_soaff1_a2 = 178 - integer, parameter :: id_soaff2_a1 = 179 - integer, parameter :: id_soaff2_a2 = 180 - integer, parameter :: id_soaff3_a1 = 181 - integer, parameter :: id_soaff3_a2 = 182 - integer, parameter :: id_soaff4_a1 = 183 - integer, parameter :: id_soaff4_a2 = 184 - integer, parameter :: id_soaff5_a1 = 185 - integer, parameter :: id_soaff5_a2 = 186 - integer, parameter :: id_SOAGbb0 = 187 - integer, parameter :: id_SOAGbb1 = 188 - integer, parameter :: id_SOAGbb2 = 189 - integer, parameter :: id_SOAGbb3 = 190 - integer, parameter :: id_SOAGbb4 = 191 - integer, parameter :: id_SOAGbg0 = 192 - integer, parameter :: id_SOAGbg1 = 193 - integer, parameter :: id_SOAGbg2 = 194 - integer, parameter :: id_SOAGbg3 = 195 - integer, parameter :: id_SOAGbg4 = 196 - integer, parameter :: id_SOAGff0 = 197 - integer, parameter :: id_SOAGff1 = 198 - integer, parameter :: id_SOAGff2 = 199 - integer, parameter :: id_SOAGff3 = 200 - integer, parameter :: id_SOAGff4 = 201 - integer, parameter :: id_SVOCbb = 202 - integer, parameter :: id_SVOCff = 203 - integer, parameter :: id_TEPOMUC = 204 - integer, parameter :: id_TERP2OOH = 205 - integer, parameter :: id_TERPNIT = 206 - integer, parameter :: id_TERPOOH = 207 - integer, parameter :: id_TERPROD1 = 208 - integer, parameter :: id_TERPROD2 = 209 - integer, parameter :: id_TOLOOH = 210 - integer, parameter :: id_TOLUENE = 211 - integer, parameter :: id_XOOH = 212 - integer, parameter :: id_XYLENES = 213 - integer, parameter :: id_XYLENOOH = 214 - integer, parameter :: id_XYLOL = 215 - integer, parameter :: id_XYLOLOOH = 216 - integer, parameter :: id_NHDEP = 217 - integer, parameter :: id_NDEP = 218 - integer, parameter :: id_ACBZO2 = 219 - integer, parameter :: id_ALKO2 = 220 - integer, parameter :: id_BENZO2 = 221 - integer, parameter :: id_BZOO = 222 - integer, parameter :: id_C2H5O2 = 223 - integer, parameter :: id_C3H7O2 = 224 - integer, parameter :: id_C6H5O2 = 225 - integer, parameter :: id_CH3CO3 = 226 - integer, parameter :: id_CH3O2 = 227 - integer, parameter :: id_DICARBO2 = 228 - integer, parameter :: id_ENEO2 = 229 - integer, parameter :: id_EO = 230 - integer, parameter :: id_EO2 = 231 - integer, parameter :: id_HO2 = 232 - integer, parameter :: id_HOCH2OO = 233 - integer, parameter :: id_ISOPAO2 = 234 - integer, parameter :: id_ISOPBO2 = 235 - integer, parameter :: id_MACRO2 = 236 - integer, parameter :: id_MALO2 = 237 - integer, parameter :: id_MCO3 = 238 - integer, parameter :: id_MDIALO2 = 239 - integer, parameter :: id_MEKO2 = 240 - integer, parameter :: id_NTERPO2 = 241 - integer, parameter :: id_O1D = 242 - integer, parameter :: id_OH = 243 - integer, parameter :: id_PHENO2 = 244 - integer, parameter :: id_PO2 = 245 - integer, parameter :: id_RO2 = 246 - integer, parameter :: id_TERP2O2 = 247 - integer, parameter :: id_TERPO2 = 248 - integer, parameter :: id_TOLO2 = 249 - integer, parameter :: id_XO2 = 250 - integer, parameter :: id_XYLENO2 = 251 - integer, parameter :: id_XYLOLO2 = 252 - integer, parameter :: id_H2O = 253 + integer, parameter :: id_BCARYO2VBS = 7 + integer, parameter :: id_BENZENE = 8 + integer, parameter :: id_BENZO2VBS = 9 + integer, parameter :: id_BENZOOH = 10 + integer, parameter :: id_BEPOMUC = 11 + integer, parameter :: id_BIGALD = 12 + integer, parameter :: id_BIGALD1 = 13 + integer, parameter :: id_BIGALD2 = 14 + integer, parameter :: id_BIGALD3 = 15 + integer, parameter :: id_BIGALD4 = 16 + integer, parameter :: id_BIGALK = 17 + integer, parameter :: id_BIGENE = 18 + integer, parameter :: id_BR = 19 + integer, parameter :: id_BRCL = 20 + integer, parameter :: id_BRO = 21 + integer, parameter :: id_BRONO2 = 22 + integer, parameter :: id_BRY = 23 + integer, parameter :: id_BZALD = 24 + integer, parameter :: id_BZOOH = 25 + integer, parameter :: id_C2H2 = 26 + integer, parameter :: id_C2H4 = 27 + integer, parameter :: id_C2H5OH = 28 + integer, parameter :: id_C2H5OOH = 29 + integer, parameter :: id_C2H6 = 30 + integer, parameter :: id_C3H6 = 31 + integer, parameter :: id_C3H7OOH = 32 + integer, parameter :: id_C3H8 = 33 + integer, parameter :: id_C6H5OOH = 34 + integer, parameter :: id_CCL4 = 35 + integer, parameter :: id_CF2CLBR = 36 + integer, parameter :: id_CF3BR = 37 + integer, parameter :: id_CFC11 = 38 + integer, parameter :: id_CFC113 = 39 + integer, parameter :: id_CFC114 = 40 + integer, parameter :: id_CFC115 = 41 + integer, parameter :: id_CFC12 = 42 + integer, parameter :: id_CH2BR2 = 43 + integer, parameter :: id_CH2O = 44 + integer, parameter :: id_CH3BR = 45 + integer, parameter :: id_CH3CCL3 = 46 + integer, parameter :: id_CH3CHO = 47 + integer, parameter :: id_CH3CL = 48 + integer, parameter :: id_CH3CN = 49 + integer, parameter :: id_CH3COCH3 = 50 + integer, parameter :: id_CH3COCHO = 51 + integer, parameter :: id_CH3COOH = 52 + integer, parameter :: id_CH3COOOH = 53 + integer, parameter :: id_CH3OH = 54 + integer, parameter :: id_CH3OOH = 55 + integer, parameter :: id_CH4 = 56 + integer, parameter :: id_CHBR3 = 57 + integer, parameter :: id_CL = 58 + integer, parameter :: id_CL2 = 59 + integer, parameter :: id_CL2O2 = 60 + integer, parameter :: id_CLO = 61 + integer, parameter :: id_CLONO2 = 62 + integer, parameter :: id_CLY = 63 + integer, parameter :: id_CO = 64 + integer, parameter :: id_CO2 = 65 + integer, parameter :: id_COF2 = 66 + integer, parameter :: id_COFCL = 67 + integer, parameter :: id_CRESOL = 68 + integer, parameter :: id_DMS = 69 + integer, parameter :: id_dst_a1 = 70 + integer, parameter :: id_dst_a2 = 71 + integer, parameter :: id_dst_a3 = 72 + integer, parameter :: id_E90 = 73 + integer, parameter :: id_EOOH = 74 + integer, parameter :: id_F = 75 + integer, parameter :: id_GLYALD = 76 + integer, parameter :: id_GLYOXAL = 77 + integer, parameter :: id_H = 78 + integer, parameter :: id_H2 = 79 + integer, parameter :: id_H2402 = 80 + integer, parameter :: id_H2O2 = 81 + integer, parameter :: id_H2SO4 = 82 + integer, parameter :: id_HBR = 83 + integer, parameter :: id_HCFC141B = 84 + integer, parameter :: id_HCFC142B = 85 + integer, parameter :: id_HCFC22 = 86 + integer, parameter :: id_HCL = 87 + integer, parameter :: id_HCN = 88 + integer, parameter :: id_HCOOH = 89 + integer, parameter :: id_HF = 90 + integer, parameter :: id_HNO3 = 91 + integer, parameter :: id_HO2NO2 = 92 + integer, parameter :: id_HOBR = 93 + integer, parameter :: id_HOCL = 94 + integer, parameter :: id_HONITR = 95 + integer, parameter :: id_HPALD = 96 + integer, parameter :: id_HYAC = 97 + integer, parameter :: id_HYDRALD = 98 + integer, parameter :: id_IEPOX = 99 + integer, parameter :: id_ISOP = 100 + integer, parameter :: id_ISOPNITA = 101 + integer, parameter :: id_ISOPNITB = 102 + integer, parameter :: id_ISOPNO3 = 103 + integer, parameter :: id_ISOPNOOH = 104 + integer, parameter :: id_ISOPO2VBS = 105 + integer, parameter :: id_ISOPOOH = 106 + integer, parameter :: id_IVOCbb = 107 + integer, parameter :: id_IVOCbbO2VBS = 108 + integer, parameter :: id_IVOCff = 109 + integer, parameter :: id_IVOCffO2VBS = 110 + integer, parameter :: id_MACR = 111 + integer, parameter :: id_MACROOH = 112 + integer, parameter :: id_MEK = 113 + integer, parameter :: id_MEKOOH = 114 + integer, parameter :: id_MPAN = 115 + integer, parameter :: id_MTERP = 116 + integer, parameter :: id_MTERPO2VBS = 117 + integer, parameter :: id_MVK = 118 + integer, parameter :: id_N = 119 + integer, parameter :: id_N2O = 120 + integer, parameter :: id_N2O5 = 121 + integer, parameter :: id_NC4CH2OH = 122 + integer, parameter :: id_NC4CHO = 123 + integer, parameter :: id_ncl_a1 = 124 + integer, parameter :: id_ncl_a2 = 125 + integer, parameter :: id_ncl_a3 = 126 + integer, parameter :: id_NH3 = 127 + integer, parameter :: id_NH4 = 128 + integer, parameter :: id_NO = 129 + integer, parameter :: id_NO2 = 130 + integer, parameter :: id_NO3 = 131 + integer, parameter :: id_NOA = 132 + integer, parameter :: id_NTERPOOH = 133 + integer, parameter :: id_num_a1 = 134 + integer, parameter :: id_num_a2 = 135 + integer, parameter :: id_num_a3 = 136 + integer, parameter :: id_num_a4 = 137 + integer, parameter :: id_O = 138 + integer, parameter :: id_O3 = 139 + integer, parameter :: id_O3S = 140 + integer, parameter :: id_OCLO = 141 + integer, parameter :: id_OCS = 142 + integer, parameter :: id_ONITR = 143 + integer, parameter :: id_PAN = 144 + integer, parameter :: id_PBZNIT = 145 + integer, parameter :: id_PHENO = 146 + integer, parameter :: id_PHENOL = 147 + integer, parameter :: id_PHENOOH = 148 + integer, parameter :: id_pombb1_a1 = 149 + integer, parameter :: id_pombb1_a4 = 150 + integer, parameter :: id_pomff1_a1 = 151 + integer, parameter :: id_pomff1_a4 = 152 + integer, parameter :: id_POOH = 153 + integer, parameter :: id_ROOH = 154 + integer, parameter :: id_S = 155 + integer, parameter :: id_SF6 = 156 + integer, parameter :: id_SO = 157 + integer, parameter :: id_SO2 = 158 + integer, parameter :: id_SO3 = 159 + integer, parameter :: id_so4_a1 = 160 + integer, parameter :: id_so4_a2 = 161 + integer, parameter :: id_so4_a3 = 162 + integer, parameter :: id_soabb1_a1 = 163 + integer, parameter :: id_soabb1_a2 = 164 + integer, parameter :: id_soabb2_a1 = 165 + integer, parameter :: id_soabb2_a2 = 166 + integer, parameter :: id_soabb3_a1 = 167 + integer, parameter :: id_soabb3_a2 = 168 + integer, parameter :: id_soabb4_a1 = 169 + integer, parameter :: id_soabb4_a2 = 170 + integer, parameter :: id_soabb5_a1 = 171 + integer, parameter :: id_soabb5_a2 = 172 + integer, parameter :: id_soabg1_a1 = 173 + integer, parameter :: id_soabg1_a2 = 174 + integer, parameter :: id_soabg2_a1 = 175 + integer, parameter :: id_soabg2_a2 = 176 + integer, parameter :: id_soabg3_a1 = 177 + integer, parameter :: id_soabg3_a2 = 178 + integer, parameter :: id_soabg4_a1 = 179 + integer, parameter :: id_soabg4_a2 = 180 + integer, parameter :: id_soabg5_a1 = 181 + integer, parameter :: id_soabg5_a2 = 182 + integer, parameter :: id_soaff1_a1 = 183 + integer, parameter :: id_soaff1_a2 = 184 + integer, parameter :: id_soaff2_a1 = 185 + integer, parameter :: id_soaff2_a2 = 186 + integer, parameter :: id_soaff3_a1 = 187 + integer, parameter :: id_soaff3_a2 = 188 + integer, parameter :: id_soaff4_a1 = 189 + integer, parameter :: id_soaff4_a2 = 190 + integer, parameter :: id_soaff5_a1 = 191 + integer, parameter :: id_soaff5_a2 = 192 + integer, parameter :: id_SOAGbb0 = 193 + integer, parameter :: id_SOAGbb1 = 194 + integer, parameter :: id_SOAGbb2 = 195 + integer, parameter :: id_SOAGbb3 = 196 + integer, parameter :: id_SOAGbb4 = 197 + integer, parameter :: id_SOAGbg0 = 198 + integer, parameter :: id_SOAGbg1 = 199 + integer, parameter :: id_SOAGbg2 = 200 + integer, parameter :: id_SOAGbg3 = 201 + integer, parameter :: id_SOAGbg4 = 202 + integer, parameter :: id_SOAGff0 = 203 + integer, parameter :: id_SOAGff1 = 204 + integer, parameter :: id_SOAGff2 = 205 + integer, parameter :: id_SOAGff3 = 206 + integer, parameter :: id_SOAGff4 = 207 + integer, parameter :: id_SVOCbb = 208 + integer, parameter :: id_SVOCff = 209 + integer, parameter :: id_TEPOMUC = 210 + integer, parameter :: id_TERP2OOH = 211 + integer, parameter :: id_TERPNIT = 212 + integer, parameter :: id_TERPOOH = 213 + integer, parameter :: id_TERPROD1 = 214 + integer, parameter :: id_TERPROD2 = 215 + integer, parameter :: id_TOLOOH = 216 + integer, parameter :: id_TOLUENE = 217 + integer, parameter :: id_TOLUO2VBS = 218 + integer, parameter :: id_XOOH = 219 + integer, parameter :: id_XYLENES = 220 + integer, parameter :: id_XYLENOOH = 221 + integer, parameter :: id_XYLEO2VBS = 222 + integer, parameter :: id_XYLOL = 223 + integer, parameter :: id_XYLOLOOH = 224 + integer, parameter :: id_NHDEP = 225 + integer, parameter :: id_NDEP = 226 + integer, parameter :: id_ACBZO2 = 227 + integer, parameter :: id_ALKO2 = 228 + integer, parameter :: id_BENZO2 = 229 + integer, parameter :: id_BZOO = 230 + integer, parameter :: id_C2H5O2 = 231 + integer, parameter :: id_C3H7O2 = 232 + integer, parameter :: id_C6H5O2 = 233 + integer, parameter :: id_CH3CO3 = 234 + integer, parameter :: id_CH3O2 = 235 + integer, parameter :: id_DICARBO2 = 236 + integer, parameter :: id_ENEO2 = 237 + integer, parameter :: id_EO = 238 + integer, parameter :: id_EO2 = 239 + integer, parameter :: id_HO2 = 240 + integer, parameter :: id_HOCH2OO = 241 + integer, parameter :: id_ISOPAO2 = 242 + integer, parameter :: id_ISOPBO2 = 243 + integer, parameter :: id_MACRO2 = 244 + integer, parameter :: id_MALO2 = 245 + integer, parameter :: id_MCO3 = 246 + integer, parameter :: id_MDIALO2 = 247 + integer, parameter :: id_MEKO2 = 248 + integer, parameter :: id_NTERPO2 = 249 + integer, parameter :: id_O1D = 250 + integer, parameter :: id_OH = 251 + integer, parameter :: id_PHENO2 = 252 + integer, parameter :: id_PO2 = 253 + integer, parameter :: id_RO2 = 254 + integer, parameter :: id_TERP2O2 = 255 + integer, parameter :: id_TERPO2 = 256 + integer, parameter :: id_TOLO2 = 257 + integer, parameter :: id_XO2 = 258 + integer, parameter :: id_XYLENO2 = 259 + integer, parameter :: id_XYLOLO2 = 260 + integer, parameter :: id_H2O = 261 end module m_spc_id diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_adjrxt.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_adjrxt.F90 index 295d3d0501..c6eb47be1d 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_adjrxt.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_adjrxt.F90 @@ -13,406 +13,421 @@ subroutine adjrxt( rate, inv, m, 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(:,:,146) = rate(:,:,146) * inv(:,:, 3) - rate(:,:,147) = rate(:,:,147) * inv(:,:, 2) - rate(:,:,150) = rate(:,:,150) * inv(:,:, 1) - rate(:,:,167) = rate(:,:,167) * inv(:,:, 1) - rate(:,:,174) = rate(:,:,174) * inv(:,:, 2) - rate(:,:,177) = rate(:,:,177) * inv(:,:, 1) - rate(:,:,185) = rate(:,:,185) * inv(:,:, 1) - rate(:,:,188) = rate(:,:,188) * inv(:,:, 1) - rate(:,:,189) = rate(:,:,189) * inv(:,:, 1) - rate(:,:,190) = rate(:,:,190) * inv(:,:, 1) - rate(:,:,192) = rate(:,:,192) * inv(:,:, 1) - rate(:,:,193) = rate(:,:,193) * inv(:,:, 1) - rate(:,:,208) = rate(:,:,208) * inv(:,:, 1) - rate(:,:,228) = rate(:,:,228) * inv(:,:, 1) - rate(:,:,229) = rate(:,:,229) * inv(:,:, 1) - rate(:,:,239) = rate(:,:,239) * inv(:,:, 1) - rate(:,:,285) = rate(:,:,285) * inv(:,:, 1) - rate(:,:,286) = rate(:,:,286) * inv(:,:, 1) - rate(:,:,296) = rate(:,:,296) * inv(:,:, 1) - rate(:,:,297) = rate(:,:,297) * inv(:,:, 1) - rate(:,:,298) = rate(:,:,298) * inv(:,:, 1) - rate(:,:,320) = rate(:,:,320) * inv(:,:, 2) - rate(:,:,324) = rate(:,:,324) * inv(:,:, 1) - rate(:,:,325) = rate(:,:,325) * inv(:,:, 1) - rate(:,:,326) = rate(:,:,326) * inv(:,:, 1) - rate(:,:,345) = rate(:,:,345) * inv(:,:, 1) - rate(:,:,371) = rate(:,:,371) * inv(:,:, 1) - rate(:,:,374) = rate(:,:,374) * inv(:,:, 1) - rate(:,:,375) = rate(:,:,375) * inv(:,:, 1) - rate(:,:,432) = rate(:,:,432) * inv(:,:, 1) - rate(:,:,435) = rate(:,:,435) * inv(:,:, 1) - rate(:,:,438) = rate(:,:,438) * inv(:,:, 1) - rate(:,:,445) = rate(:,:,445) * inv(:,:, 1) - rate(:,:,450) = rate(:,:,450) * inv(:,:, 1) - rate(:,:,486) = rate(:,:,486) * inv(:,:, 2) - rate(:,:,492) = rate(:,:,492) * inv(:,:, 2) - rate(:,:,151) = rate(:,:,151) * inv(:,:, 2) * inv(:,:, 1) - rate(:,:,157) = rate(:,:,157) * inv(:,:, 2) * inv(:,:, 1) - rate(:,:,144) = rate(:,:,144) * m(:,:) - rate(:,:,145) = rate(:,:,145) * m(:,:) - rate(:,:,148) = rate(:,:,148) * m(:,:) - rate(:,:,149) = rate(:,:,149) * m(:,:) - rate(:,:,150) = rate(:,:,150) * 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(:,:,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(:,:,172) = rate(:,:,172) * m(:,:) - rate(:,:,173) = rate(:,:,173) * 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(:,:,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(:,:,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(:,:,245) = rate(:,:,245) * m(:,:) - rate(:,:,246) = rate(:,:,246) * 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(:,:,252) = rate(:,:,252) * 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(:,:,290) = rate(:,:,290) * m(:,:) - rate(:,:,291) = rate(:,:,291) * m(:,:) - rate(:,:,292) = rate(:,:,292) * 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(:,:,321) = rate(:,:,321) * m(:,:) - rate(:,:,322) = rate(:,:,322) * m(:,:) - rate(:,:,323) = rate(:,:,323) * m(:,:) - rate(:,:,324) = rate(:,:,324) * m(:,:) - rate(:,:,325) = rate(:,:,325) * m(:,:) - rate(:,:,327) = rate(:,:,327) * m(:,:) - rate(:,:,328) = rate(:,:,328) * m(:,:) - rate(:,:,329) = rate(:,:,329) * 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(:,:,336) = rate(:,:,336) * m(:,:) - rate(:,:,337) = rate(:,:,337) * m(:,:) - rate(:,:,338) = rate(:,:,338) * m(:,:) - rate(:,:,339) = rate(:,:,339) * m(:,:) - rate(:,:,340) = rate(:,:,340) * m(:,:) - rate(:,:,341) = rate(:,:,341) * m(:,:) - rate(:,:,342) = rate(:,:,342) * m(:,:) - rate(:,:,343) = rate(:,:,343) * m(:,:) - rate(:,:,344) = rate(:,:,344) * m(:,:) - rate(:,:,345) = rate(:,:,345) * m(:,:) - rate(:,:,346) = rate(:,:,346) * m(:,:) - rate(:,:,347) = rate(:,:,347) * m(:,:) - rate(:,:,348) = rate(:,:,348) * m(:,:) - rate(:,:,349) = rate(:,:,349) * m(:,:) - rate(:,:,350) = rate(:,:,350) * m(:,:) - rate(:,:,351) = rate(:,:,351) * m(:,:) - rate(:,:,352) = rate(:,:,352) * m(:,:) - rate(:,:,353) = rate(:,:,353) * m(:,:) - rate(:,:,354) = rate(:,:,354) * m(:,:) - rate(:,:,355) = rate(:,:,355) * m(:,:) - rate(:,:,356) = rate(:,:,356) * m(:,:) - rate(:,:,357) = rate(:,:,357) * m(:,:) - rate(:,:,358) = rate(:,:,358) * m(:,:) - rate(:,:,359) = rate(:,:,359) * m(:,:) - rate(:,:,360) = rate(:,:,360) * m(:,:) - rate(:,:,361) = rate(:,:,361) * m(:,:) - rate(:,:,362) = rate(:,:,362) * m(:,:) - rate(:,:,363) = rate(:,:,363) * m(:,:) - rate(:,:,364) = rate(:,:,364) * m(:,:) - rate(:,:,365) = rate(:,:,365) * m(:,:) - rate(:,:,366) = rate(:,:,366) * m(:,:) - rate(:,:,367) = rate(:,:,367) * m(:,:) - rate(:,:,368) = rate(:,:,368) * m(:,:) - rate(:,:,369) = rate(:,:,369) * m(:,:) - rate(:,:,370) = rate(:,:,370) * m(:,:) - rate(:,:,371) = rate(:,:,371) * m(:,:) - rate(:,:,372) = rate(:,:,372) * m(:,:) - rate(:,:,373) = rate(:,:,373) * m(:,:) - rate(:,:,374) = rate(:,:,374) * m(:,:) - rate(:,:,376) = rate(:,:,376) * m(:,:) - rate(:,:,377) = rate(:,:,377) * m(:,:) - rate(:,:,378) = rate(:,:,378) * m(:,:) - rate(:,:,379) = rate(:,:,379) * m(:,:) - rate(:,:,380) = rate(:,:,380) * m(:,:) - rate(:,:,381) = rate(:,:,381) * m(:,:) - rate(:,:,382) = rate(:,:,382) * m(:,:) - rate(:,:,383) = rate(:,:,383) * m(:,:) - rate(:,:,384) = rate(:,:,384) * m(:,:) - rate(:,:,385) = rate(:,:,385) * m(:,:) - rate(:,:,386) = rate(:,:,386) * m(:,:) - rate(:,:,387) = rate(:,:,387) * m(:,:) - rate(:,:,388) = rate(:,:,388) * m(:,:) - rate(:,:,389) = rate(:,:,389) * m(:,:) - rate(:,:,390) = rate(:,:,390) * m(:,:) - rate(:,:,391) = rate(:,:,391) * m(:,:) - rate(:,:,392) = rate(:,:,392) * m(:,:) - rate(:,:,394) = rate(:,:,394) * m(:,:) - rate(:,:,395) = rate(:,:,395) * m(:,:) - rate(:,:,396) = rate(:,:,396) * m(:,:) - rate(:,:,397) = rate(:,:,397) * m(:,:) - rate(:,:,398) = rate(:,:,398) * m(:,:) - rate(:,:,399) = rate(:,:,399) * m(:,:) - rate(:,:,400) = rate(:,:,400) * m(:,:) - rate(:,:,401) = rate(:,:,401) * m(:,:) - rate(:,:,402) = rate(:,:,402) * m(:,:) - rate(:,:,403) = rate(:,:,403) * m(:,:) - rate(:,:,404) = rate(:,:,404) * m(:,:) - rate(:,:,405) = rate(:,:,405) * m(:,:) - rate(:,:,406) = rate(:,:,406) * m(:,:) - rate(:,:,407) = rate(:,:,407) * m(:,:) - rate(:,:,408) = rate(:,:,408) * m(:,:) - rate(:,:,409) = rate(:,:,409) * m(:,:) - rate(:,:,410) = rate(:,:,410) * m(:,:) - rate(:,:,411) = rate(:,:,411) * m(:,:) - rate(:,:,412) = rate(:,:,412) * m(:,:) - rate(:,:,413) = rate(:,:,413) * m(:,:) - rate(:,:,414) = rate(:,:,414) * m(:,:) - rate(:,:,415) = rate(:,:,415) * m(:,:) - rate(:,:,416) = rate(:,:,416) * m(:,:) - rate(:,:,417) = rate(:,:,417) * m(:,:) - rate(:,:,418) = rate(:,:,418) * m(:,:) - rate(:,:,419) = rate(:,:,419) * m(:,:) - rate(:,:,420) = rate(:,:,420) * m(:,:) - rate(:,:,421) = rate(:,:,421) * m(:,:) - rate(:,:,422) = rate(:,:,422) * m(:,:) - rate(:,:,423) = rate(:,:,423) * m(:,:) - rate(:,:,424) = rate(:,:,424) * m(:,:) - rate(:,:,425) = rate(:,:,425) * m(:,:) - rate(:,:,426) = rate(:,:,426) * m(:,:) - rate(:,:,427) = rate(:,:,427) * m(:,:) - rate(:,:,428) = rate(:,:,428) * m(:,:) - rate(:,:,429) = rate(:,:,429) * m(:,:) - rate(:,:,430) = rate(:,:,430) * m(:,:) - rate(:,:,431) = rate(:,:,431) * m(:,:) - rate(:,:,432) = rate(:,:,432) * m(:,:) - rate(:,:,433) = rate(:,:,433) * m(:,:) - rate(:,:,434) = rate(:,:,434) * m(:,:) - rate(:,:,435) = rate(:,:,435) * m(:,:) - rate(:,:,436) = rate(:,:,436) * m(:,:) - rate(:,:,437) = rate(:,:,437) * m(:,:) - rate(:,:,438) = rate(:,:,438) * m(:,:) - rate(:,:,439) = rate(:,:,439) * m(:,:) - rate(:,:,440) = rate(:,:,440) * m(:,:) - rate(:,:,441) = rate(:,:,441) * m(:,:) - rate(:,:,442) = rate(:,:,442) * m(:,:) - rate(:,:,443) = rate(:,:,443) * m(:,:) - rate(:,:,444) = rate(:,:,444) * m(:,:) - rate(:,:,445) = rate(:,:,445) * m(:,:) - rate(:,:,446) = rate(:,:,446) * m(:,:) - rate(:,:,447) = rate(:,:,447) * m(:,:) - rate(:,:,448) = rate(:,:,448) * m(:,:) - rate(:,:,449) = rate(:,:,449) * m(:,:) - rate(:,:,451) = rate(:,:,451) * m(:,:) - rate(:,:,452) = rate(:,:,452) * m(:,:) - rate(:,:,453) = rate(:,:,453) * m(:,:) - rate(:,:,454) = rate(:,:,454) * m(:,:) - rate(:,:,455) = rate(:,:,455) * m(:,:) - rate(:,:,456) = rate(:,:,456) * m(:,:) - rate(:,:,457) = rate(:,:,457) * m(:,:) - rate(:,:,458) = rate(:,:,458) * m(:,:) - rate(:,:,459) = rate(:,:,459) * m(:,:) - rate(:,:,460) = rate(:,:,460) * m(:,:) - rate(:,:,461) = rate(:,:,461) * m(:,:) - rate(:,:,462) = rate(:,:,462) * m(:,:) - rate(:,:,463) = rate(:,:,463) * m(:,:) - rate(:,:,464) = rate(:,:,464) * m(:,:) - rate(:,:,465) = rate(:,:,465) * m(:,:) - rate(:,:,466) = rate(:,:,466) * m(:,:) - rate(:,:,467) = rate(:,:,467) * m(:,:) - rate(:,:,468) = rate(:,:,468) * m(:,:) - rate(:,:,469) = rate(:,:,469) * m(:,:) - rate(:,:,470) = rate(:,:,470) * m(:,:) - rate(:,:,471) = rate(:,:,471) * m(:,:) - rate(:,:,472) = rate(:,:,472) * m(:,:) - rate(:,:,473) = rate(:,:,473) * m(:,:) - rate(:,:,474) = rate(:,:,474) * m(:,:) - rate(:,:,475) = rate(:,:,475) * m(:,:) - rate(:,:,476) = rate(:,:,476) * m(:,:) - rate(:,:,477) = rate(:,:,477) * m(:,:) - rate(:,:,478) = rate(:,:,478) * m(:,:) - rate(:,:,479) = rate(:,:,479) * m(:,:) - rate(:,:,480) = rate(:,:,480) * m(:,:) - rate(:,:,481) = rate(:,:,481) * m(:,:) - rate(:,:,482) = rate(:,:,482) * m(:,:) - rate(:,:,483) = rate(:,:,483) * m(:,:) - rate(:,:,484) = rate(:,:,484) * m(:,:) - rate(:,:,485) = rate(:,:,485) * m(:,:) - rate(:,:,487) = rate(:,:,487) * m(:,:) - rate(:,:,488) = rate(:,:,488) * m(:,:) - rate(:,:,489) = rate(:,:,489) * m(:,:) - rate(:,:,490) = rate(:,:,490) * m(:,:) - rate(:,:,491) = rate(:,:,491) * m(:,:) - rate(:,:,493) = rate(:,:,493) * m(:,:) - rate(:,:,494) = rate(:,:,494) * m(:,:) - rate(:,:,495) = rate(:,:,495) * m(:,:) - rate(:,:,496) = rate(:,:,496) * m(:,:) - rate(:,:,497) = rate(:,:,497) * m(:,:) - rate(:,:,498) = rate(:,:,498) * m(:,:) - rate(:,:,499) = rate(:,:,499) * m(:,:) - rate(:,:,514) = rate(:,:,514) * m(:,:) - rate(:,:,515) = rate(:,:,515) * m(:,:) - rate(:,:,516) = rate(:,:,516) * m(:,:) - rate(:,:,517) = rate(:,:,517) * m(:,:) - rate(:,:,518) = rate(:,:,518) * m(:,:) - rate(:,:,519) = rate(:,:,519) * m(:,:) - rate(:,:,520) = rate(:,:,520) * m(:,:) - rate(:,:,521) = rate(:,:,521) * m(:,:) - rate(:,:,522) = rate(:,:,522) * m(:,:) - rate(:,:,523) = rate(:,:,523) * m(:,:) - rate(:,:,524) = rate(:,:,524) * m(:,:) - rate(:,:,525) = rate(:,:,525) * m(:,:) - rate(:,:,526) = rate(:,:,526) * m(:,:) - rate(:,:,527) = rate(:,:,527) * m(:,:) - rate(:,:,528) = rate(:,:,528) * m(:,:) - rate(:,:,529) = rate(:,:,529) * m(:,:) - rate(:,:,531) = rate(:,:,531) * m(:,:) - rate(:,:,536) = rate(:,:,536) * m(:,:) - rate(:,:,537) = rate(:,:,537) * m(:,:) - rate(:,:,538) = rate(:,:,538) * m(:,:) - rate(:,:,541) = rate(:,:,541) * m(:,:) - rate(:,:,542) = rate(:,:,542) * m(:,:) - rate(:,:,543) = rate(:,:,543) * m(:,:) - rate(:,:,546) = rate(:,:,546) * m(:,:) + rate(:,:, 146) = rate(:,:, 146) * inv(:,:, 3) + rate(:,:, 147) = rate(:,:, 147) * inv(:,:, 2) + rate(:,:, 150) = rate(:,:, 150) * inv(:,:, 1) + rate(:,:, 167) = rate(:,:, 167) * inv(:,:, 1) + rate(:,:, 174) = rate(:,:, 174) * inv(:,:, 2) + rate(:,:, 177) = rate(:,:, 177) * inv(:,:, 1) + rate(:,:, 185) = rate(:,:, 185) * inv(:,:, 1) + rate(:,:, 188) = rate(:,:, 188) * inv(:,:, 1) + rate(:,:, 189) = rate(:,:, 189) * inv(:,:, 1) + rate(:,:, 190) = rate(:,:, 190) * inv(:,:, 1) + rate(:,:, 192) = rate(:,:, 192) * inv(:,:, 1) + rate(:,:, 193) = rate(:,:, 193) * inv(:,:, 1) + rate(:,:, 208) = rate(:,:, 208) * inv(:,:, 1) + rate(:,:, 228) = rate(:,:, 228) * inv(:,:, 1) + rate(:,:, 229) = rate(:,:, 229) * inv(:,:, 1) + rate(:,:, 239) = rate(:,:, 239) * inv(:,:, 1) + rate(:,:, 285) = rate(:,:, 285) * inv(:,:, 1) + rate(:,:, 295) = rate(:,:, 295) * inv(:,:, 1) + rate(:,:, 296) = rate(:,:, 296) * inv(:,:, 1) + rate(:,:, 297) = rate(:,:, 297) * inv(:,:, 1) + rate(:,:, 319) = rate(:,:, 319) * inv(:,:, 2) + rate(:,:, 323) = rate(:,:, 323) * inv(:,:, 1) + rate(:,:, 324) = rate(:,:, 324) * inv(:,:, 1) + rate(:,:, 325) = rate(:,:, 325) * inv(:,:, 1) + rate(:,:, 344) = rate(:,:, 344) * inv(:,:, 1) + rate(:,:, 370) = rate(:,:, 370) * inv(:,:, 1) + rate(:,:, 373) = rate(:,:, 373) * inv(:,:, 1) + rate(:,:, 374) = rate(:,:, 374) * inv(:,:, 1) + rate(:,:, 431) = rate(:,:, 431) * inv(:,:, 1) + rate(:,:, 434) = rate(:,:, 434) * inv(:,:, 1) + rate(:,:, 437) = rate(:,:, 437) * inv(:,:, 1) + rate(:,:, 444) = rate(:,:, 444) * inv(:,:, 1) + rate(:,:, 449) = rate(:,:, 449) * inv(:,:, 1) + rate(:,:, 485) = rate(:,:, 485) * inv(:,:, 2) + rate(:,:, 486) = rate(:,:, 486) * inv(:,:, 1) + rate(:,:, 492) = rate(:,:, 492) * inv(:,:, 2) + rate(:,:, 151) = rate(:,:, 151) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 157) = rate(:,:, 157) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 144) = rate(:,:, 144) * m(:,:) + rate(:,:, 145) = rate(:,:, 145) * m(:,:) + rate(:,:, 148) = rate(:,:, 148) * m(:,:) + rate(:,:, 149) = rate(:,:, 149) * m(:,:) + rate(:,:, 150) = rate(:,:, 150) * 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(:,:, 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(:,:, 172) = rate(:,:, 172) * m(:,:) + rate(:,:, 173) = rate(:,:, 173) * 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(:,:, 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(:,:, 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * 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(:,:, 252) = rate(:,:, 252) * 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(:,:, 289) = rate(:,:, 289) * m(:,:) + rate(:,:, 290) = rate(:,:, 290) * m(:,:) + rate(:,:, 291) = rate(:,:, 291) * m(:,:) + rate(:,:, 292) = rate(:,:, 292) * 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(:,:, 320) = rate(:,:, 320) * m(:,:) + rate(:,:, 321) = rate(:,:, 321) * m(:,:) + rate(:,:, 322) = rate(:,:, 322) * m(:,:) + rate(:,:, 323) = rate(:,:, 323) * m(:,:) + rate(:,:, 324) = rate(:,:, 324) * m(:,:) + rate(:,:, 326) = rate(:,:, 326) * m(:,:) + rate(:,:, 327) = rate(:,:, 327) * m(:,:) + rate(:,:, 328) = rate(:,:, 328) * m(:,:) + rate(:,:, 329) = rate(:,:, 329) * 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(:,:, 336) = rate(:,:, 336) * m(:,:) + rate(:,:, 337) = rate(:,:, 337) * m(:,:) + rate(:,:, 338) = rate(:,:, 338) * m(:,:) + rate(:,:, 339) = rate(:,:, 339) * m(:,:) + rate(:,:, 340) = rate(:,:, 340) * m(:,:) + rate(:,:, 341) = rate(:,:, 341) * m(:,:) + rate(:,:, 342) = rate(:,:, 342) * m(:,:) + rate(:,:, 343) = rate(:,:, 343) * m(:,:) + rate(:,:, 344) = rate(:,:, 344) * m(:,:) + rate(:,:, 345) = rate(:,:, 345) * m(:,:) + rate(:,:, 346) = rate(:,:, 346) * m(:,:) + rate(:,:, 347) = rate(:,:, 347) * m(:,:) + rate(:,:, 348) = rate(:,:, 348) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 352) = rate(:,:, 352) * m(:,:) + rate(:,:, 353) = rate(:,:, 353) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 357) = rate(:,:, 357) * m(:,:) + rate(:,:, 358) = rate(:,:, 358) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + rate(:,:, 360) = rate(:,:, 360) * m(:,:) + rate(:,:, 361) = rate(:,:, 361) * m(:,:) + rate(:,:, 362) = rate(:,:, 362) * m(:,:) + rate(:,:, 363) = rate(:,:, 363) * m(:,:) + rate(:,:, 364) = rate(:,:, 364) * m(:,:) + rate(:,:, 365) = rate(:,:, 365) * m(:,:) + rate(:,:, 366) = rate(:,:, 366) * m(:,:) + rate(:,:, 367) = rate(:,:, 367) * m(:,:) + rate(:,:, 368) = rate(:,:, 368) * m(:,:) + rate(:,:, 369) = rate(:,:, 369) * m(:,:) + rate(:,:, 370) = rate(:,:, 370) * m(:,:) + rate(:,:, 371) = rate(:,:, 371) * m(:,:) + rate(:,:, 372) = rate(:,:, 372) * m(:,:) + rate(:,:, 373) = rate(:,:, 373) * m(:,:) + rate(:,:, 375) = rate(:,:, 375) * m(:,:) + rate(:,:, 376) = rate(:,:, 376) * m(:,:) + rate(:,:, 377) = rate(:,:, 377) * m(:,:) + rate(:,:, 378) = rate(:,:, 378) * m(:,:) + rate(:,:, 379) = rate(:,:, 379) * m(:,:) + rate(:,:, 380) = rate(:,:, 380) * m(:,:) + rate(:,:, 381) = rate(:,:, 381) * m(:,:) + rate(:,:, 382) = rate(:,:, 382) * m(:,:) + rate(:,:, 383) = rate(:,:, 383) * m(:,:) + rate(:,:, 384) = rate(:,:, 384) * m(:,:) + rate(:,:, 385) = rate(:,:, 385) * m(:,:) + rate(:,:, 386) = rate(:,:, 386) * m(:,:) + rate(:,:, 387) = rate(:,:, 387) * m(:,:) + rate(:,:, 388) = rate(:,:, 388) * m(:,:) + rate(:,:, 389) = rate(:,:, 389) * m(:,:) + rate(:,:, 390) = rate(:,:, 390) * m(:,:) + rate(:,:, 391) = rate(:,:, 391) * m(:,:) + rate(:,:, 393) = rate(:,:, 393) * m(:,:) + rate(:,:, 394) = rate(:,:, 394) * m(:,:) + rate(:,:, 395) = rate(:,:, 395) * m(:,:) + rate(:,:, 396) = rate(:,:, 396) * m(:,:) + rate(:,:, 397) = rate(:,:, 397) * m(:,:) + rate(:,:, 398) = rate(:,:, 398) * m(:,:) + rate(:,:, 399) = rate(:,:, 399) * m(:,:) + rate(:,:, 400) = rate(:,:, 400) * m(:,:) + rate(:,:, 401) = rate(:,:, 401) * m(:,:) + rate(:,:, 402) = rate(:,:, 402) * m(:,:) + rate(:,:, 403) = rate(:,:, 403) * m(:,:) + rate(:,:, 404) = rate(:,:, 404) * m(:,:) + rate(:,:, 405) = rate(:,:, 405) * m(:,:) + rate(:,:, 406) = rate(:,:, 406) * m(:,:) + rate(:,:, 407) = rate(:,:, 407) * m(:,:) + rate(:,:, 408) = rate(:,:, 408) * m(:,:) + rate(:,:, 409) = rate(:,:, 409) * m(:,:) + rate(:,:, 410) = rate(:,:, 410) * m(:,:) + rate(:,:, 411) = rate(:,:, 411) * m(:,:) + rate(:,:, 412) = rate(:,:, 412) * m(:,:) + rate(:,:, 413) = rate(:,:, 413) * m(:,:) + rate(:,:, 414) = rate(:,:, 414) * m(:,:) + rate(:,:, 415) = rate(:,:, 415) * m(:,:) + rate(:,:, 416) = rate(:,:, 416) * m(:,:) + rate(:,:, 417) = rate(:,:, 417) * m(:,:) + rate(:,:, 418) = rate(:,:, 418) * m(:,:) + rate(:,:, 419) = rate(:,:, 419) * m(:,:) + rate(:,:, 420) = rate(:,:, 420) * m(:,:) + rate(:,:, 421) = rate(:,:, 421) * m(:,:) + rate(:,:, 422) = rate(:,:, 422) * m(:,:) + rate(:,:, 423) = rate(:,:, 423) * m(:,:) + rate(:,:, 424) = rate(:,:, 424) * m(:,:) + rate(:,:, 425) = rate(:,:, 425) * m(:,:) + rate(:,:, 426) = rate(:,:, 426) * m(:,:) + rate(:,:, 427) = rate(:,:, 427) * m(:,:) + rate(:,:, 428) = rate(:,:, 428) * m(:,:) + rate(:,:, 429) = rate(:,:, 429) * m(:,:) + rate(:,:, 430) = rate(:,:, 430) * m(:,:) + rate(:,:, 431) = rate(:,:, 431) * m(:,:) + rate(:,:, 432) = rate(:,:, 432) * m(:,:) + rate(:,:, 433) = rate(:,:, 433) * m(:,:) + rate(:,:, 434) = rate(:,:, 434) * m(:,:) + rate(:,:, 435) = rate(:,:, 435) * m(:,:) + rate(:,:, 436) = rate(:,:, 436) * m(:,:) + rate(:,:, 437) = rate(:,:, 437) * m(:,:) + rate(:,:, 438) = rate(:,:, 438) * m(:,:) + rate(:,:, 439) = rate(:,:, 439) * m(:,:) + rate(:,:, 440) = rate(:,:, 440) * m(:,:) + rate(:,:, 441) = rate(:,:, 441) * m(:,:) + rate(:,:, 442) = rate(:,:, 442) * m(:,:) + rate(:,:, 443) = rate(:,:, 443) * m(:,:) + rate(:,:, 444) = rate(:,:, 444) * m(:,:) + rate(:,:, 445) = rate(:,:, 445) * m(:,:) + rate(:,:, 446) = rate(:,:, 446) * m(:,:) + rate(:,:, 447) = rate(:,:, 447) * m(:,:) + rate(:,:, 448) = rate(:,:, 448) * m(:,:) + rate(:,:, 450) = rate(:,:, 450) * m(:,:) + rate(:,:, 451) = rate(:,:, 451) * m(:,:) + rate(:,:, 452) = rate(:,:, 452) * m(:,:) + rate(:,:, 453) = rate(:,:, 453) * m(:,:) + rate(:,:, 454) = rate(:,:, 454) * m(:,:) + rate(:,:, 455) = rate(:,:, 455) * m(:,:) + rate(:,:, 456) = rate(:,:, 456) * m(:,:) + rate(:,:, 457) = rate(:,:, 457) * m(:,:) + rate(:,:, 458) = rate(:,:, 458) * m(:,:) + rate(:,:, 459) = rate(:,:, 459) * m(:,:) + rate(:,:, 460) = rate(:,:, 460) * m(:,:) + rate(:,:, 461) = rate(:,:, 461) * m(:,:) + rate(:,:, 462) = rate(:,:, 462) * m(:,:) + rate(:,:, 463) = rate(:,:, 463) * m(:,:) + rate(:,:, 464) = rate(:,:, 464) * m(:,:) + rate(:,:, 465) = rate(:,:, 465) * m(:,:) + rate(:,:, 466) = rate(:,:, 466) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * m(:,:) + rate(:,:, 468) = rate(:,:, 468) * m(:,:) + rate(:,:, 469) = rate(:,:, 469) * m(:,:) + rate(:,:, 470) = rate(:,:, 470) * m(:,:) + rate(:,:, 471) = rate(:,:, 471) * m(:,:) + rate(:,:, 472) = rate(:,:, 472) * m(:,:) + rate(:,:, 473) = rate(:,:, 473) * m(:,:) + rate(:,:, 474) = rate(:,:, 474) * m(:,:) + rate(:,:, 475) = rate(:,:, 475) * m(:,:) + rate(:,:, 476) = rate(:,:, 476) * m(:,:) + rate(:,:, 477) = rate(:,:, 477) * m(:,:) + rate(:,:, 478) = rate(:,:, 478) * m(:,:) + rate(:,:, 479) = rate(:,:, 479) * m(:,:) + rate(:,:, 480) = rate(:,:, 480) * m(:,:) + rate(:,:, 481) = rate(:,:, 481) * m(:,:) + rate(:,:, 482) = rate(:,:, 482) * m(:,:) + rate(:,:, 483) = rate(:,:, 483) * m(:,:) + rate(:,:, 484) = rate(:,:, 484) * m(:,:) + rate(:,:, 486) = rate(:,:, 486) * m(:,:) + rate(:,:, 487) = rate(:,:, 487) * m(:,:) + rate(:,:, 488) = rate(:,:, 488) * m(:,:) + rate(:,:, 489) = rate(:,:, 489) * m(:,:) + rate(:,:, 490) = rate(:,:, 490) * m(:,:) + rate(:,:, 491) = rate(:,:, 491) * m(:,:) + rate(:,:, 493) = rate(:,:, 493) * m(:,:) + rate(:,:, 494) = rate(:,:, 494) * m(:,:) + rate(:,:, 495) = rate(:,:, 495) * m(:,:) + rate(:,:, 496) = rate(:,:, 496) * m(:,:) + rate(:,:, 497) = rate(:,:, 497) * m(:,:) + rate(:,:, 498) = rate(:,:, 498) * m(:,:) + rate(:,:, 512) = rate(:,:, 512) * m(:,:) + rate(:,:, 513) = rate(:,:, 513) * m(:,:) + rate(:,:, 514) = rate(:,:, 514) * m(:,:) + rate(:,:, 515) = rate(:,:, 515) * m(:,:) + rate(:,:, 516) = rate(:,:, 516) * m(:,:) + rate(:,:, 517) = rate(:,:, 517) * m(:,:) + rate(:,:, 518) = rate(:,:, 518) * m(:,:) + rate(:,:, 519) = rate(:,:, 519) * m(:,:) + rate(:,:, 520) = rate(:,:, 520) * m(:,:) + rate(:,:, 521) = rate(:,:, 521) * m(:,:) + rate(:,:, 522) = rate(:,:, 522) * m(:,:) + rate(:,:, 523) = rate(:,:, 523) * m(:,:) + rate(:,:, 524) = rate(:,:, 524) * m(:,:) + rate(:,:, 525) = rate(:,:, 525) * m(:,:) + rate(:,:, 526) = rate(:,:, 526) * m(:,:) + rate(:,:, 527) = rate(:,:, 527) * m(:,:) + rate(:,:, 528) = rate(:,:, 528) * m(:,:) + rate(:,:, 529) = rate(:,:, 529) * m(:,:) + rate(:,:, 530) = rate(:,:, 530) * m(:,:) + rate(:,:, 531) = rate(:,:, 531) * m(:,:) + rate(:,:, 532) = rate(:,:, 532) * m(:,:) + rate(:,:, 533) = rate(:,:, 533) * m(:,:) + rate(:,:, 534) = rate(:,:, 534) * m(:,:) + rate(:,:, 535) = rate(:,:, 535) * m(:,:) + rate(:,:, 536) = rate(:,:, 536) * m(:,:) + rate(:,:, 537) = rate(:,:, 537) * m(:,:) + rate(:,:, 538) = rate(:,:, 538) * m(:,:) + rate(:,:, 539) = rate(:,:, 539) * m(:,:) + rate(:,:, 540) = rate(:,:, 540) * m(:,:) + rate(:,:, 542) = rate(:,:, 542) * m(:,:) + rate(:,:, 543) = rate(:,:, 543) * m(:,:) + rate(:,:, 544) = rate(:,:, 544) * m(:,:) + rate(:,:, 546) = rate(:,:, 546) * m(:,:) + rate(:,:, 551) = rate(:,:, 551) * m(:,:) + rate(:,:, 552) = rate(:,:, 552) * m(:,:) + rate(:,:, 553) = rate(:,:, 553) * m(:,:) + rate(:,:, 556) = rate(:,:, 556) * m(:,:) + rate(:,:, 557) = rate(:,:, 557) * m(:,:) + rate(:,:, 558) = rate(:,:, 558) * m(:,:) + rate(:,:, 561) = rate(:,:, 561) * m(:,:) end subroutine adjrxt end module mo_adjrxt diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_indprd.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_indprd.F90 index 92758532da..3509e32051 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_indprd.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_indprd.F90 @@ -20,199 +20,176 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) ! ... "independent" production for Explicit species !-------------------------------------------------------------------- if( class == 1 ) then - prod(:,1) = + extfrc(:,16) - prod(:,2) = 0._r8 - prod(:,3) = 0._r8 - prod(:,4) = 0._r8 - prod(:,5) = 0._r8 - prod(:,6) = 0._r8 - prod(:,7) = 0._r8 - prod(:,8) = 0._r8 - prod(:,9) = 0._r8 - prod(:,10) = 0._r8 - prod(:,11) = 0._r8 - prod(:,12) = 0._r8 - prod(:,13) = 0._r8 - prod(:,14) = 0._r8 - prod(:,15) =.100_r8*rxt(:,328)*y(:,133)*y(:,29) - prod(:,16) = 0._r8 - prod(:,17) = 0._r8 - prod(:,18) = (rxt(:,285)*y(:,62) +rxt(:,287)*y(:,87) +rxt(:,295)*y(:,62) + & - rxt(:,315)*y(:,50) +.500_r8*rxt(:,316)*y(:,51) + & - .800_r8*rxt(:,321)*y(:,74) +rxt(:,322)*y(:,75) + & - .500_r8*rxt(:,371)*y(:,110) +1.800_r8*rxt(:,481)*y(:,209))*y(:,243) & - + (2.000_r8*rxt(:,311)*y(:,226) +.900_r8*rxt(:,312)*y(:,227) + & - rxt(:,314)*y(:,123) +2.000_r8*rxt(:,361)*y(:,238) + & - rxt(:,385)*y(:,234) +rxt(:,410)*y(:,250))*y(:,226) & - + (.200_r8*rxt(:,328)*y(:,29) +.100_r8*rxt(:,372)*y(:,112) + & - .270_r8*rxt(:,460)*y(:,6) +.270_r8*rxt(:,463)*y(:,111))*y(:,133) & - + (rxt(:,362)*y(:,227) +.450_r8*rxt(:,363)*y(:,232) + & - 2.000_r8*rxt(:,364)*y(:,238))*y(:,238) & - + (.500_r8*rxt(:,470)*y(:,227) +.900_r8*rxt(:,472)*y(:,123)) & - *y(:,247) +rxt(:,37)*y(:,51) +.400_r8*rxt(:,60)*y(:,138) +rxt(:,65) & - *y(:,205) +.800_r8*rxt(:,69)*y(:,209) - prod(:,19) = 0._r8 - prod(:,20) = 0._r8 - prod(:,21) = 0._r8 - prod(:,22) = 0._r8 - prod(:,23) = 0._r8 - prod(:,24) =rxt(:,171)*y(:,124)*y(:,113) - prod(:,25) = 0._r8 - prod(:,26) =rxt(:,499)*y(:,243)*y(:,121) +rxt(:,508)*y(:,122) - prod(:,27) = (rxt(:,432)*y(:,228) +rxt(:,435)*y(:,237) +rxt(:,438)*y(:,239) + & - rxt(:,442)*y(:,140))*y(:,124) +.500_r8*rxt(:,371)*y(:,243)*y(:,110) & - +.200_r8*rxt(:,467)*y(:,241)*y(:,123) +.500_r8*rxt(:,479)*y(:,208) & - *y(:,125) - prod(:,28) = 0._r8 + prod(:,1) =rxt(:,498)*y(:,251)*y(:,127) +rxt(:,506)*y(:,128) + prod(:,2) = (rxt(:,431)*y(:,236) +rxt(:,434)*y(:,245) +rxt(:,437)*y(:,247) + & + rxt(:,441)*y(:,146))*y(:,130) +.500_r8*rxt(:,370)*y(:,251)*y(:,115) & + +.200_r8*rxt(:,466)*y(:,249)*y(:,129) +.500_r8*rxt(:,478)*y(:,214) & + *y(:,131) !-------------------------------------------------------------------- ! ... "independent" production for Implicit species !-------------------------------------------------------------------- else if( class == 4 ) then - prod(:,154) = 0._r8 - prod(:,155) = 0._r8 - prod(:,1) = + extfrc(:,1) - prod(:,2) = + extfrc(:,2) - prod(:,179) = 0._r8 + prod(:,184) = 0._r8 + prod(:,186) = 0._r8 + prod(:,1) = + extfrc(:,16) + prod(:,2) = + extfrc(:,1) + prod(:,3) = + extfrc(:,2) + prod(:,214) = 0._r8 + prod(:,69) = 0._r8 + prod(:,103) = 0._r8 prod(:,79) = 0._r8 - prod(:,122) = 0._r8 - prod(:,80) = 0._r8 - prod(:,120) = 0._r8 - prod(:,130) = 0._r8 - prod(:,101) = 0._r8 - prod(:,151) = 0._r8 - prod(:,106) = 0._r8 - prod(:,92) = 0._r8 - prod(:,114) = 0._r8 - prod(:,208) =rxt(:,79)*y(:,34) +rxt(:,80)*y(:,35) +2.000_r8*rxt(:,86)*y(:,41) & - +rxt(:,87)*y(:,43) +3.000_r8*rxt(:,90)*y(:,55) +2.000_r8*rxt(:,98) & - *y(:,78) - prod(:,93) = 0._r8 - prod(:,221) = 0._r8 prod(:,146) = 0._r8 - prod(:,94) = 0._r8 - prod(:,109) = 0._r8 - prod(:,103) = 0._r8 - prod(:,144) = 0._r8 - prod(:,98) = 0._r8 - prod(:,110) = 0._r8 prod(:,104) = 0._r8 - prod(:,184) = 0._r8 - prod(:,121) = 0._r8 - prod(:,73) = 0._r8 - prod(:,99) = 0._r8 - prod(:,216) =.180_r8*rxt(:,39)*y(:,54) - prod(:,195) = 0._r8 - prod(:,71) = 0._r8 + prod(:,156) = 0._r8 + prod(:,159) = 0._r8 + prod(:,127) = 0._r8 prod(:,181) = 0._r8 - prod(:,200) = 0._r8 - prod(:,141) = 0._r8 - prod(:,136) = 0._r8 - prod(:,167) = 0._r8 - prod(:,123) = 0._r8 - prod(:,224) =4.000_r8*rxt(:,78)*y(:,33) +rxt(:,79)*y(:,34) & - +2.000_r8*rxt(:,81)*y(:,36) +2.000_r8*rxt(:,82)*y(:,37) & - +2.000_r8*rxt(:,83)*y(:,38) +rxt(:,84)*y(:,39) +2.000_r8*rxt(:,85) & - *y(:,40) +3.000_r8*rxt(:,88)*y(:,44) +rxt(:,89)*y(:,46) +rxt(:,100) & - *y(:,82) +rxt(:,101)*y(:,83) +rxt(:,102)*y(:,84) - prod(:,82) = 0._r8 - prod(:,72) = 0._r8 - prod(:,222) = 0._r8 - prod(:,182) = 0._r8 - prod(:,189) =.380_r8*rxt(:,39)*y(:,54) +rxt(:,41)*y(:,63) + extfrc(:,3) - prod(:,76) =rxt(:,79)*y(:,34) +rxt(:,80)*y(:,35) +rxt(:,82)*y(:,37) & - +2.000_r8*rxt(:,83)*y(:,38) +2.000_r8*rxt(:,84)*y(:,39) +rxt(:,85) & - *y(:,40) +2.000_r8*rxt(:,98)*y(:,78) +rxt(:,101)*y(:,83) +rxt(:,102) & - *y(:,84) - prod(:,83) =rxt(:,81)*y(:,36) +rxt(:,82)*y(:,37) +rxt(:,100)*y(:,82) - prod(:,86) = 0._r8 - prod(:,105) = 0._r8 - prod(:,3) = 0._r8 - prod(:,4) = 0._r8 - prod(:,5) = 0._r8 - prod(:,77) = 0._r8 - prod(:,166) =rxt(:,80)*y(:,35) +rxt(:,84)*y(:,39) - prod(:,186) = 0._r8 - prod(:,177) = 0._r8 - prod(:,210) = (.330_r8*rxt(:,39) +rxt(:,40))*y(:,54) - prod(:,196) =1.440_r8*rxt(:,39)*y(:,54) - prod(:,148) = 0._r8 - prod(:,78) = 0._r8 + prod(:,135) = 0._r8 + prod(:,116) = 0._r8 + prod(:,143) = 0._r8 + prod(:,241) = 0._r8 + prod(:,118) = 0._r8 + prod(:,255) = 0._r8 prod(:,170) = 0._r8 - prod(:,212) = 0._r8 - prod(:,84) = 0._r8 - prod(:,168) = 0._r8 - prod(:,96) = 0._r8 - prod(:,209) = 0._r8 + prod(:,4) = 0._r8 + prod(:,119) = 0._r8 + prod(:,138) = 0._r8 + prod(:,129) = 0._r8 + prod(:,173) = 0._r8 prod(:,124) = 0._r8 - prod(:,165) = 0._r8 - prod(:,171) = 0._r8 - prod(:,187) = 0._r8 - prod(:,95) = 0._r8 - prod(:,190) = 0._r8 - prod(:,111) = 0._r8 - prod(:,74) = 0._r8 - prod(:,175) = 0._r8 + prod(:,139) = 0._r8 + prod(:,130) = 0._r8 + prod(:,218) = 0._r8 prod(:,147) = 0._r8 - prod(:,142) = 0._r8 + prod(:,88) = 0._r8 + prod(:,125) = 0._r8 + prod(:,85) = 0._r8 + prod(:,96) = 0._r8 + prod(:,97) = 0._r8 + prod(:,89) = 0._r8 + prod(:,98) = 0._r8 + prod(:,90) = 0._r8 + prod(:,99) = 0._r8 + prod(:,91) = 0._r8 + prod(:,162) = 0._r8 + prod(:,253) = 0._r8 + prod(:,175) = 0._r8 + prod(:,92) = 0._r8 + prod(:,222) = 0._r8 + prod(:,144) = 0._r8 + prod(:,86) = 0._r8 + prod(:,212) = 0._r8 + prod(:,232) = 0._r8 + prod(:,188) = 0._r8 + prod(:,176) = 0._r8 prod(:,198) = 0._r8 - prod(:,118) = 0._r8 - prod(:,157) = 0._r8 - prod(:,56) = 0._r8 - prod(:,67) = 0._r8 - prod(:,199) = 0._r8 - prod(:,113) = 0._r8 - prod(:,138) = 0._r8 - prod(:,112) = 0._r8 - prod(:,143) = 0._r8 - prod(:,178) = 0._r8 - prod(:,203) = 0._r8 - prod(:,125) = + extfrc(:,17) + prod(:,151) = 0._r8 + prod(:,242) = 0._r8 + prod(:,152) = 0._r8 + prod(:,257) = 0._r8 prod(:,102) = 0._r8 - prod(:,116) = 0._r8 - prod(:,185) = 0._r8 + prod(:,87) = 0._r8 + prod(:,250) = 0._r8 + prod(:,209) = 0._r8 + prod(:,5) = 0._r8 + prod(:,223) = + extfrc(:,3) + prod(:,203) = 0._r8 + prod(:,121) = 0._r8 + prod(:,115) = 0._r8 + prod(:,109) = 0._r8 + prod(:,128) = 0._r8 prod(:,6) = 0._r8 prod(:,7) = 0._r8 prod(:,8) = 0._r8 - prod(:,70) = 0._r8 prod(:,9) = 0._r8 - prod(:,211) = + extfrc(:,4) - prod(:,217) = + extfrc(:,5) - prod(:,218) = 0._r8 - prod(:,173) = 0._r8 - prod(:,119) = 0._r8 - prod(:,10) = + extfrc(:,6) - prod(:,11) = + extfrc(:,7) - prod(:,12) = 0._r8 - prod(:,13) = + extfrc(:,8) - prod(:,223) =.180_r8*rxt(:,39)*y(:,54) +rxt(:,41)*y(:,63) + (rxt(:,5) + & - 2.000_r8*rxt(:,6)) - prod(:,220) = 0._r8 - prod(:,107) = 0._r8 - prod(:,115) = 0._r8 - prod(:,91) = 0._r8 + prod(:,100) = 0._r8 + prod(:,208) = 0._r8 + prod(:,224) = 0._r8 + prod(:,213) = 0._r8 + prod(:,244) = 0._r8 + prod(:,240) = 0._r8 + prod(:,93) = 0._r8 + prod(:,178) = 0._r8 + prod(:,101) = 0._r8 + prod(:,201) = 0._r8 + prod(:,114) = 0._r8 + prod(:,120) = 0._r8 prod(:,132) = 0._r8 - prod(:,75) = 0._r8 + prod(:,251) = 0._r8 + prod(:,107) = 0._r8 + prod(:,215) = 0._r8 prod(:,131) = 0._r8 - prod(:,81) = 0._r8 - prod(:,108) = 0._r8 - prod(:,14) = 0._r8 - prod(:,15) = + extfrc(:,15) - prod(:,16) = 0._r8 - prod(:,17) = + extfrc(:,14) + prod(:,243) = 0._r8 + prod(:,150) = 0._r8 + prod(:,197) = 0._r8 + prod(:,200) = 0._r8 + prod(:,228) = 0._r8 + prod(:,122) = 0._r8 + prod(:,227) = 0._r8 prod(:,140) = 0._r8 + prod(:,94) = 0._r8 + prod(:,204) = 0._r8 + prod(:,180) = 0._r8 + prod(:,171) = 0._r8 + prod(:,230) = 0._r8 + prod(:,148) = 0._r8 + prod(:,70) = 0._r8 + prod(:,189) = 0._r8 + prod(:,63) = 0._r8 + prod(:,62) = 0._r8 + prod(:,78) = 0._r8 + prod(:,77) = 0._r8 + prod(:,231) = 0._r8 + prod(:,141) = 0._r8 + prod(:,166) = 0._r8 + prod(:,134) = 0._r8 + prod(:,177) = 0._r8 + prod(:,217) = 0._r8 + prod(:,71) = 0._r8 + prod(:,237) = 0._r8 + prod(:,160) = + extfrc(:,17) + prod(:,106) = 0._r8 + prod(:,133) = 0._r8 + prod(:,149) = 0._r8 + prod(:,219) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,84) = 0._r8 + prod(:,13) = 0._r8 + prod(:,245) = + extfrc(:,4) + prod(:,247) = + extfrc(:,5) + prod(:,254) = 0._r8 + prod(:,205) = 0._r8 + prod(:,153) = 0._r8 + prod(:,14) = + extfrc(:,6) + prod(:,15) = + extfrc(:,7) + prod(:,16) = 0._r8 + prod(:,17) = + extfrc(:,8) + prod(:,252) = (rxt(:,5) +2.000_r8*rxt(:,6)) + prod(:,258) = 0._r8 + prod(:,18) = 0._r8 + prod(:,136) = 0._r8 + prod(:,142) = 0._r8 prod(:,117) = 0._r8 + prod(:,169) = 0._r8 + prod(:,95) = 0._r8 + prod(:,161) = 0._r8 + prod(:,105) = 0._r8 prod(:,137) = 0._r8 - prod(:,201) = 0._r8 - prod(:,174) = + extfrc(:,9) - prod(:,97) = 0._r8 - prod(:,18) = + extfrc(:,10) - prod(:,19) = + extfrc(:,11) - prod(:,20) = 0._r8 + prod(:,19) = 0._r8 + prod(:,20) = + extfrc(:,15) prod(:,21) = 0._r8 - prod(:,22) = 0._r8 + prod(:,22) = + extfrc(:,14) + prod(:,172) = 0._r8 + prod(:,145) = 0._r8 + prod(:,168) = 0._r8 prod(:,23) = 0._r8 - prod(:,24) = 0._r8 - prod(:,25) = 0._r8 + prod(:,233) = 0._r8 + prod(:,206) = + extfrc(:,9) + prod(:,123) = 0._r8 + prod(:,24) = + extfrc(:,10) + prod(:,25) = + extfrc(:,11) prod(:,26) = 0._r8 prod(:,27) = 0._r8 prod(:,28) = 0._r8 @@ -243,66 +220,74 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) prod(:,53) = 0._r8 prod(:,54) = 0._r8 prod(:,55) = 0._r8 + prod(:,56) = 0._r8 prod(:,57) = 0._r8 prod(:,58) = 0._r8 prod(:,59) = 0._r8 prod(:,60) = 0._r8 prod(:,61) = 0._r8 - prod(:,62) = 0._r8 - prod(:,63) = 0._r8 prod(:,64) = 0._r8 prod(:,65) = 0._r8 prod(:,66) = 0._r8 - prod(:,68) = + extfrc(:,12) - prod(:,69) = + extfrc(:,13) - prod(:,87) = 0._r8 - prod(:,149) = 0._r8 - prod(:,152) = 0._r8 - prod(:,133) = 0._r8 + prod(:,67) = 0._r8 + prod(:,68) = 0._r8 + prod(:,72) = 0._r8 + prod(:,73) = 0._r8 + prod(:,74) = 0._r8 + prod(:,75) = 0._r8 + prod(:,76) = 0._r8 + prod(:,80) = + extfrc(:,12) + prod(:,81) = + extfrc(:,13) + prod(:,110) = 0._r8 + prod(:,185) = 0._r8 + prod(:,182) = 0._r8 + prod(:,163) = 0._r8 + prod(:,216) = 0._r8 + prod(:,221) = 0._r8 + prod(:,179) = 0._r8 + prod(:,108) = 0._r8 + prod(:,82) = 0._r8 + prod(:,111) = 0._r8 + prod(:,112) = 0._r8 + prod(:,190) = 0._r8 + prod(:,83) = 0._r8 + prod(:,113) = 0._r8 + prod(:,154) = 0._r8 + prod(:,167) = 0._r8 + prod(:,210) = 0._r8 + prod(:,164) = 0._r8 + prod(:,155) = 0._r8 + prod(:,202) = 0._r8 + prod(:,199) = 0._r8 prod(:,183) = 0._r8 - prod(:,188) = 0._r8 - prod(:,150) = 0._r8 - prod(:,85) = 0._r8 - prod(:,88) = 0._r8 - prod(:,89) = 0._r8 - prod(:,158) = 0._r8 - prod(:,90) = 0._r8 + prod(:,239) = 0._r8 + prod(:,246) = 0._r8 + prod(:,195) = 0._r8 + prod(:,174) = 0._r8 prod(:,126) = 0._r8 - prod(:,139) = 0._r8 - prod(:,180) = 0._r8 - prod(:,134) = 0._r8 - prod(:,127) = 0._r8 - prod(:,172) = 0._r8 - prod(:,169) = 0._r8 - prod(:,153) = 0._r8 + prod(:,191) = 0._r8 + prod(:,256) = 0._r8 + prod(:,157) = 0._r8 + prod(:,234) = 0._r8 + prod(:,235) = 0._r8 + prod(:,236) = 0._r8 + prod(:,192) = 0._r8 + prod(:,238) = 0._r8 prod(:,207) = 0._r8 - prod(:,219) =rxt(:,87)*y(:,43) +rxt(:,89)*y(:,46) +rxt(:,40)*y(:,54) - prod(:,163) = 0._r8 - prod(:,145) = 0._r8 - prod(:,100) = 0._r8 - prod(:,159) = 0._r8 - prod(:,213) = 0._r8 - prod(:,128) = 0._r8 - prod(:,202) = 0._r8 - prod(:,205) = 0._r8 - prod(:,204) = 0._r8 - prod(:,160) = 0._r8 - prod(:,206) = 0._r8 - prod(:,176) = 0._r8 - prod(:,156) = 0._r8 + prod(:,187) = 0._r8 + prod(:,220) = 0._r8 + prod(:,248) =rxt(:,5) + prod(:,249) = + extfrc(:,18) + prod(:,158) = 0._r8 + prod(:,196) = 0._r8 + prod(:,226) = 0._r8 + prod(:,225) = 0._r8 + prod(:,211) = 0._r8 prod(:,193) = 0._r8 - prod(:,214) =rxt(:,12)*y(:,114) +rxt(:,5) - prod(:,215) =.330_r8*rxt(:,39)*y(:,54) + extfrc(:,18) - prod(:,129) = 0._r8 - prod(:,164) = 0._r8 + prod(:,229) = 0._r8 prod(:,194) = 0._r8 - prod(:,192) = 0._r8 - prod(:,191) = 0._r8 - prod(:,161) = 0._r8 - prod(:,197) = 0._r8 - prod(:,162) = 0._r8 - prod(:,135) = 0._r8 - prod(:,225) =.050_r8*rxt(:,39)*y(:,54) + prod(:,165) = 0._r8 + prod(:,259) = 0._r8 end if end subroutine indprd end module mo_indprd diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_lin_matrix.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_lin_matrix.F90 index 15afcdec78..79f693ac15 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_lin_matrix.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_lin_matrix.F90 @@ -23,221 +23,207 @@ subroutine linmat01( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,566) = -( rxt(k,19) + het_rates(k,1) ) - mat(k,577) = -( rxt(k,20) + het_rates(k,2) ) - mat(k,1) = -( het_rates(k,4) ) - mat(k,2) = -( het_rates(k,5) ) - mat(k,831) = -( het_rates(k,6) ) - mat(k,123) = -( het_rates(k,7) ) - mat(k,346) = -( rxt(k,21) + het_rates(k,8) ) - mat(k,129) = -( rxt(k,22) + het_rates(k,9) ) - mat(k,334) = -( rxt(k,23) + het_rates(k,10) ) - mat(k,397) = -( rxt(k,24) + het_rates(k,11) ) - mat(k,347) = .500_r8*rxt(k,21) - mat(k,130) = rxt(k,22) - mat(k,537) = .200_r8*rxt(k,70) - mat(k,605) = .060_r8*rxt(k,72) - mat(k,228) = -( rxt(k,25) + het_rates(k,12) ) - mat(k,536) = .200_r8*rxt(k,70) - mat(k,603) = .200_r8*rxt(k,72) - mat(k,547) = -( rxt(k,26) + het_rates(k,13) ) - mat(k,204) = rxt(k,46) - mat(k,908) = rxt(k,56) - mat(k,539) = .200_r8*rxt(k,70) - mat(k,606) = .150_r8*rxt(k,72) - mat(k,255) = -( rxt(k,27) + het_rates(k,14) ) - mat(k,604) = .210_r8*rxt(k,72) - mat(k,194) = -( het_rates(k,15) ) - mat(k,294) = -( het_rates(k,16) ) - mat(k,1294) = -( het_rates(k,17) ) - mat(k,198) = rxt(k,74) - mat(k,1946) = rxt(k,75) - mat(k,505) = rxt(k,77) - mat(k,721) = rxt(k,99) - mat(k,685) = rxt(k,105) - mat(k,1532) = rxt(k,220)*y(k,34) + rxt(k,246)*y(k,35) & - + 3.000_r8*rxt(k,247)*y(k,55) + 2.000_r8*rxt(k,248)*y(k,78) & - + 2.000_r8*rxt(k,269)*y(k,41) + rxt(k,270)*y(k,43) - mat(k,2036) = 2.000_r8*rxt(k,257)*y(k,41) + rxt(k,259)*y(k,43) & - + 3.000_r8*rxt(k,264)*y(k,55) - mat(k,1691) = 2.000_r8*rxt(k,258)*y(k,41) + rxt(k,260)*y(k,43) & - + 3.000_r8*rxt(k,265)*y(k,55) - mat(k,197) = -( rxt(k,74) + het_rates(k,18) ) - mat(k,1959) = -( rxt(k,75) + het_rates(k,19) ) - mat(k,509) = rxt(k,76) - mat(k,503) = -( rxt(k,76) + rxt(k,77) + rxt(k,532) + rxt(k,535) + rxt(k,540) & - + het_rates(k,20) ) - mat(k,200) = -( het_rates(k,22) ) - mat(k,270) = rxt(k,28) - mat(k,271) = -( rxt(k,28) + het_rates(k,23) ) - mat(k,237) = -( het_rates(k,24) ) - mat(k,487) = -( het_rates(k,25) ) - mat(k,216) = -( het_rates(k,26) ) - mat(k,276) = -( rxt(k,29) + het_rates(k,27) ) - mat(k,243) = -( het_rates(k,28) ) - mat(k,893) = -( het_rates(k,29) ) - mat(k,1169) = .700_r8*rxt(k,55) - mat(k,340) = -( rxt(k,30) + het_rates(k,30) ) - mat(k,99) = -( het_rates(k,31) ) - mat(k,220) = -( rxt(k,31) + het_rates(k,32) ) - mat(k,1722) = -( rxt(k,32) + rxt(k,33) + het_rates(k,42) ) - mat(k,574) = .100_r8*rxt(k,19) - mat(k,586) = .100_r8*rxt(k,20) - mat(k,355) = rxt(k,38) - mat(k,928) = rxt(k,43) - mat(k,941) = .330_r8*rxt(k,45) - mat(k,964) = rxt(k,47) - mat(k,602) = .690_r8*rxt(k,49) - mat(k,1112) = 1.340_r8*rxt(k,50) - mat(k,751) = rxt(k,57) - mat(k,465) = rxt(k,62) - mat(k,320) = rxt(k,63) - mat(k,535) = .375_r8*rxt(k,65) - mat(k,417) = .400_r8*rxt(k,67) - mat(k,952) = .680_r8*rxt(k,69) - mat(k,388) = rxt(k,289) - mat(k,227) = 2.000_r8*rxt(k,319) - mat(k,1540) = rxt(k,292)*y(k,54) + rxt(k,293)*y(k,54) - mat(k,1040) = -( rxt(k,34) + het_rates(k,45) ) - mat(k,570) = .400_r8*rxt(k,19) - mat(k,582) = .400_r8*rxt(k,20) - mat(k,278) = rxt(k,29) - mat(k,936) = .330_r8*rxt(k,45) - mat(k,286) = rxt(k,53) - mat(k,462) = rxt(k,62) - mat(k,93) = -( het_rates(k,47) ) - mat(k,863) = -( rxt(k,35) + het_rates(k,48) ) - mat(k,569) = .250_r8*rxt(k,19) - mat(k,581) = .250_r8*rxt(k,20) - mat(k,342) = .820_r8*rxt(k,30) - mat(k,930) = .170_r8*rxt(k,45) - mat(k,528) = .300_r8*rxt(k,65) - mat(k,412) = .050_r8*rxt(k,67) - mat(k,945) = .500_r8*rxt(k,69) - mat(k,1116) = -( rxt(k,36) + het_rates(k,49) ) - mat(k,337) = .180_r8*rxt(k,23) - mat(k,257) = rxt(k,27) - mat(k,544) = .400_r8*rxt(k,70) - mat(k,614) = .540_r8*rxt(k,72) - mat(k,373) = .510_r8*rxt(k,73) - mat(k,467) = -( het_rates(k,50) ) - mat(k,435) = -( rxt(k,37) + het_rates(k,51) ) - mat(k,701) = -( het_rates(k,52) ) - mat(k,352) = -( rxt(k,38) + het_rates(k,53) ) - mat(k,2052) = -( rxt(k,195)*y(k,54) + rxt(k,257)*y(k,41) + rxt(k,259)*y(k,43) & - + rxt(k,262)*y(k,46) + rxt(k,264)*y(k,55) + het_rates(k,56) ) - mat(k,199) = rxt(k,74) - mat(k,139) = 2.000_r8*rxt(k,91) - mat(k,98) = 2.000_r8*rxt(k,92) - mat(k,1988) = rxt(k,93) - mat(k,879) = rxt(k,95) - mat(k,143) = rxt(k,97) - mat(k,1430) = rxt(k,103) - mat(k,734) = rxt(k,106) - mat(k,1548) = 4.000_r8*rxt(k,219)*y(k,33) + rxt(k,220)*y(k,34) & - + 2.000_r8*rxt(k,221)*y(k,36) + 2.000_r8*rxt(k,222)*y(k,37) & - + 2.000_r8*rxt(k,223)*y(k,38) + rxt(k,224)*y(k,39) & - + 2.000_r8*rxt(k,225)*y(k,40) + rxt(k,271)*y(k,82) & - + rxt(k,272)*y(k,83) + rxt(k,273)*y(k,84) - mat(k,1707) = 3.000_r8*rxt(k,261)*y(k,44) + rxt(k,263)*y(k,46) & - + rxt(k,266)*y(k,82) + rxt(k,267)*y(k,83) + rxt(k,268)*y(k,84) - mat(k,138) = -( rxt(k,91) + het_rates(k,57) ) - mat(k,96) = -( rxt(k,92) + rxt(k,229) + het_rates(k,58) ) - mat(k,1986) = -( rxt(k,93) + het_rates(k,59) ) - mat(k,877) = rxt(k,94) - mat(k,263) = rxt(k,107) - mat(k,97) = 2.000_r8*rxt(k,229) - mat(k,871) = -( rxt(k,94) + rxt(k,95) + rxt(k,534) + rxt(k,539) + rxt(k,545) & - + het_rates(k,60) ) - mat(k,955) = -( het_rates(k,62) ) - mat(k,131) = 1.500_r8*rxt(k,22) - mat(k,336) = .450_r8*rxt(k,23) - mat(k,549) = .600_r8*rxt(k,26) - mat(k,256) = rxt(k,27) - mat(k,1712) = rxt(k,32) + rxt(k,33) - mat(k,1039) = rxt(k,34) - mat(k,1115) = rxt(k,36) - mat(k,925) = rxt(k,43) - mat(k,793) = 2.000_r8*rxt(k,44) - mat(k,933) = .330_r8*rxt(k,45) - mat(k,1103) = 1.340_r8*rxt(k,51) - mat(k,1170) = .700_r8*rxt(k,55) - mat(k,166) = 1.500_r8*rxt(k,64) - mat(k,531) = .250_r8*rxt(k,65) - mat(k,883) = rxt(k,68) - mat(k,947) = 1.700_r8*rxt(k,69) - mat(k,305) = rxt(k,110) - mat(k,2032) = rxt(k,262)*y(k,46) - mat(k,109) = -( rxt(k,96) + het_rates(k,64) ) - mat(k,1526) = rxt(k,220)*y(k,34) + rxt(k,222)*y(k,37) & - + 2.000_r8*rxt(k,223)*y(k,38) + 2.000_r8*rxt(k,224)*y(k,39) & - + rxt(k,225)*y(k,40) + rxt(k,246)*y(k,35) & - + 2.000_r8*rxt(k,248)*y(k,78) + rxt(k,272)*y(k,83) & - + rxt(k,273)*y(k,84) - mat(k,1573) = rxt(k,267)*y(k,83) + rxt(k,268)*y(k,84) - mat(k,140) = -( rxt(k,97) + het_rates(k,65) ) - mat(k,1527) = rxt(k,221)*y(k,36) + rxt(k,222)*y(k,37) + rxt(k,271)*y(k,82) - mat(k,1577) = rxt(k,266)*y(k,82) - mat(k,160) = -( het_rates(k,66) ) - mat(k,249) = -( het_rates(k,67) ) - mat(k,3) = -( het_rates(k,68) ) - mat(k,4) = -( het_rates(k,69) ) - mat(k,5) = -( het_rates(k,70) ) - mat(k,112) = -( rxt(k,42) + het_rates(k,72) ) - mat(k,693) = -( rxt(k,251)*y(k,54) + het_rates(k,73) ) - mat(k,110) = 2.000_r8*rxt(k,96) - mat(k,141) = rxt(k,97) - mat(k,209) = rxt(k,104) - mat(k,1529) = rxt(k,224)*y(k,39) + rxt(k,246)*y(k,35) - mat(k,924) = -( rxt(k,43) + het_rates(k,74) ) - mat(k,931) = .330_r8*rxt(k,45) - mat(k,529) = .250_r8*rxt(k,65) - mat(k,225) = rxt(k,320) - mat(k,792) = -( rxt(k,44) + rxt(k,500) + het_rates(k,75) ) - mat(k,349) = rxt(k,21) - mat(k,335) = .130_r8*rxt(k,23) - mat(k,267) = .700_r8*rxt(k,61) - mat(k,543) = .600_r8*rxt(k,70) - mat(k,612) = .340_r8*rxt(k,72) - mat(k,372) = .170_r8*rxt(k,73) - mat(k,1320) = -( rxt(k,157) + het_rates(k,76) ) - mat(k,2063) = rxt(k,2) + 2.000_r8*rxt(k,3) - mat(k,1716) = 2.000_r8*rxt(k,32) - mat(k,353) = rxt(k,38) - mat(k,722) = rxt(k,99) - mat(k,1417) = rxt(k,103) - mat(k,210) = rxt(k,104) - mat(k,1534) = rxt(k,292)*y(k,54) - mat(k,1051) = -( het_rates(k,77) ) - mat(k,2059) = rxt(k,1) - mat(k,1713) = rxt(k,33) - mat(k,1531) = rxt(k,293)*y(k,54) - mat(k,520) = -( rxt(k,4) + het_rates(k,79) ) - mat(k,1461) = .500_r8*rxt(k,501) - mat(k,115) = -( rxt(k,109) + het_rates(k,80) ) - mat(k,720) = -( rxt(k,99) + het_rates(k,81) ) - mat(k,1418) = -( rxt(k,103) + het_rates(k,85) ) - mat(k,2040) = rxt(k,195)*y(k,54) + rxt(k,257)*y(k,41) + rxt(k,259)*y(k,43) & - + 2.000_r8*rxt(k,262)*y(k,46) + rxt(k,264)*y(k,55) - mat(k,144) = -( het_rates(k,86) ) - mat(k,705) = -( het_rates(k,87) ) - mat(k,208) = -( rxt(k,104) + het_rates(k,88) ) - mat(k,692) = rxt(k,251)*y(k,54) - mat(k,1307) = -( rxt(k,9) + het_rates(k,89) ) - mat(k,938) = rxt(k,502) - mat(k,515) = rxt(k,503) - mat(k,476) = rxt(k,504) - mat(k,232) = 2.000_r8*rxt(k,505) + 2.000_r8*rxt(k,530) + 2.000_r8*rxt(k,533) & - + 2.000_r8*rxt(k,544) - mat(k,313) = rxt(k,506) - mat(k,916) = rxt(k,507) - mat(k,1756) = .500_r8*rxt(k,509) - mat(k,1813) = rxt(k,510) - mat(k,331) = rxt(k,511) - mat(k,192) = rxt(k,512) - mat(k,553) = rxt(k,513) - mat(k,506) = rxt(k,532) + rxt(k,535) + rxt(k,540) - mat(k,872) = rxt(k,534) + rxt(k,539) + rxt(k,545) + mat(k,685) = -( rxt(k,19) + het_rates(k,1) ) + mat(k,706) = -( rxt(k,20) + het_rates(k,2) ) + mat(k,1) = -( het_rates(k,3) ) + mat(k,2) = -( het_rates(k,4) ) + mat(k,3) = -( het_rates(k,5) ) + mat(k,988) = -( het_rates(k,6) ) + mat(k,80) = -( het_rates(k,7) ) + mat(k,207) = -( het_rates(k,8) ) + mat(k,111) = -( het_rates(k,9) ) + mat(k,421) = -( rxt(k,21) + het_rates(k,10) ) + mat(k,213) = -( rxt(k,22) + het_rates(k,11) ) + mat(k,483) = -( rxt(k,23) + het_rates(k,12) ) + mat(k,502) = -( rxt(k,24) + het_rates(k,13) ) + mat(k,422) = .500_r8*rxt(k,21) + mat(k,214) = rxt(k,22) + mat(k,647) = .200_r8*rxt(k,70) + mat(k,739) = .060_r8*rxt(k,72) + mat(k,315) = -( rxt(k,25) + het_rates(k,14) ) + mat(k,646) = .200_r8*rxt(k,70) + mat(k,737) = .200_r8*rxt(k,72) + mat(k,666) = -( rxt(k,26) + het_rates(k,15) ) + mat(k,294) = rxt(k,46) + mat(k,1081) = rxt(k,56) + mat(k,649) = .200_r8*rxt(k,70) + mat(k,740) = .150_r8*rxt(k,72) + mat(k,357) = -( rxt(k,27) + het_rates(k,16) ) + mat(k,738) = .210_r8*rxt(k,72) + mat(k,273) = -( het_rates(k,17) ) + mat(k,399) = -( het_rates(k,18) ) + mat(k,1455) = -( het_rates(k,19) ) + mat(k,280) = rxt(k,74) + mat(k,2094) = rxt(k,75) + mat(k,576) = rxt(k,77) + mat(k,180) = rxt(k,79) + mat(k,186) = rxt(k,80) + mat(k,518) = 2.000_r8*rxt(k,86) + mat(k,615) = rxt(k,87) + mat(k,458) = 3.000_r8*rxt(k,90) + mat(k,170) = 2.000_r8*rxt(k,98) + mat(k,850) = rxt(k,99) + mat(k,819) = rxt(k,105) + mat(k,279) = -( rxt(k,74) + het_rates(k,20) ) + mat(k,2107) = -( rxt(k,75) + het_rates(k,21) ) + mat(k,581) = rxt(k,76) + mat(k,574) = -( rxt(k,76) + rxt(k,77) + rxt(k,547) + rxt(k,550) + rxt(k,555) & + + het_rates(k,22) ) + mat(k,4) = -( het_rates(k,23) ) + mat(k,282) = -( het_rates(k,24) ) + mat(k,372) = rxt(k,28) + mat(k,373) = -( rxt(k,28) + het_rates(k,25) ) + mat(k,324) = -( het_rates(k,26) ) + mat(k,598) = -( het_rates(k,27) ) + mat(k,303) = -( het_rates(k,28) ) + mat(k,378) = -( rxt(k,29) + het_rates(k,29) ) + mat(k,330) = -( het_rates(k,30) ) + mat(k,1064) = -( het_rates(k,31) ) + mat(k,1366) = .700_r8*rxt(k,55) + mat(k,427) = -( rxt(k,30) + het_rates(k,32) ) + mat(k,148) = -( het_rates(k,33) ) + mat(k,307) = -( rxt(k,31) + het_rates(k,34) ) + mat(k,139) = -( rxt(k,78) + het_rates(k,35) ) + mat(k,178) = -( rxt(k,79) + het_rates(k,36) ) + mat(k,183) = -( rxt(k,80) + het_rates(k,37) ) + mat(k,152) = -( rxt(k,81) + het_rates(k,38) ) + mat(k,188) = -( rxt(k,82) + het_rates(k,39) ) + mat(k,156) = -( rxt(k,83) + het_rates(k,40) ) + mat(k,193) = -( rxt(k,84) + het_rates(k,41) ) + mat(k,160) = -( rxt(k,85) + het_rates(k,42) ) + mat(k,517) = -( rxt(k,86) + het_rates(k,43) ) + mat(k,2024) = -( rxt(k,32) + rxt(k,33) + het_rates(k,44) ) + mat(k,693) = .100_r8*rxt(k,19) + mat(k,714) = .100_r8*rxt(k,20) + mat(k,455) = rxt(k,38) + mat(k,1478) = .180_r8*rxt(k,39) + mat(k,1145) = rxt(k,43) + mat(k,1202) = .330_r8*rxt(k,45) + mat(k,1184) = rxt(k,47) + mat(k,735) = rxt(k,49) + mat(k,1256) = 1.340_r8*rxt(k,51) + mat(k,895) = rxt(k,57) + mat(k,595) = rxt(k,62) + mat(k,419) = rxt(k,63) + mat(k,703) = .375_r8*rxt(k,65) + mat(k,529) = .400_r8*rxt(k,67) + mat(k,1122) = .680_r8*rxt(k,69) + mat(k,493) = rxt(k,288) + mat(k,313) = 2.000_r8*rxt(k,318) + mat(k,614) = -( rxt(k,87) + het_rates(k,45) ) + mat(k,164) = -( rxt(k,88) + het_rates(k,46) ) + mat(k,1125) = -( rxt(k,34) + het_rates(k,47) ) + mat(k,689) = .400_r8*rxt(k,19) + mat(k,711) = .400_r8*rxt(k,20) + mat(k,380) = rxt(k,29) + mat(k,1188) = .330_r8*rxt(k,45) + mat(k,354) = rxt(k,53) + mat(k,592) = rxt(k,62) + mat(k,407) = -( rxt(k,89) + het_rates(k,48) ) + mat(k,142) = -( het_rates(k,49) ) + mat(k,962) = -( rxt(k,35) + het_rates(k,50) ) + mat(k,688) = .250_r8*rxt(k,19) + mat(k,710) = .250_r8*rxt(k,20) + mat(k,429) = .820_r8*rxt(k,30) + mat(k,1187) = .170_r8*rxt(k,45) + mat(k,697) = .300_r8*rxt(k,65) + mat(k,526) = .050_r8*rxt(k,67) + mat(k,1114) = .500_r8*rxt(k,69) + mat(k,1261) = -( rxt(k,36) + het_rates(k,51) ) + mat(k,486) = .180_r8*rxt(k,23) + mat(k,359) = rxt(k,27) + mat(k,654) = .400_r8*rxt(k,70) + mat(k,748) = .540_r8*rxt(k,72) + mat(k,472) = .510_r8*rxt(k,73) + mat(k,724) = -( het_rates(k,52) ) + mat(k,623) = -( rxt(k,37) + het_rates(k,53) ) + mat(k,826) = -( het_rates(k,54) ) + mat(k,451) = -( rxt(k,38) + het_rates(k,55) ) + mat(k,1470) = -( rxt(k,39) + rxt(k,40) + het_rates(k,56) ) + mat(k,457) = -( rxt(k,90) + het_rates(k,57) ) + mat(k,2267) = -( het_rates(k,58) ) + mat(k,281) = rxt(k,74) + mat(k,141) = 4.000_r8*rxt(k,78) + mat(k,182) = rxt(k,79) + mat(k,155) = 2.000_r8*rxt(k,81) + mat(k,192) = 2.000_r8*rxt(k,82) + mat(k,159) = 2.000_r8*rxt(k,83) + mat(k,197) = rxt(k,84) + mat(k,163) = 2.000_r8*rxt(k,85) + mat(k,166) = 3.000_r8*rxt(k,88) + mat(k,413) = rxt(k,89) + mat(k,205) = 2.000_r8*rxt(k,91) + mat(k,147) = 2.000_r8*rxt(k,92) + mat(k,1951) = rxt(k,93) + mat(k,932) = rxt(k,95) + mat(k,272) = rxt(k,97) + mat(k,268) = rxt(k,100) + mat(k,289) = rxt(k,101) + mat(k,344) = rxt(k,102) + mat(k,1973) = rxt(k,103) + mat(k,847) = rxt(k,106) + mat(k,204) = -( rxt(k,91) + het_rates(k,59) ) + mat(k,145) = -( rxt(k,92) + rxt(k,229) + het_rates(k,60) ) + mat(k,1944) = -( rxt(k,93) + het_rates(k,61) ) + mat(k,928) = rxt(k,94) + mat(k,365) = rxt(k,107) + mat(k,146) = 2.000_r8*rxt(k,229) + mat(k,924) = -( rxt(k,94) + rxt(k,95) + rxt(k,549) + rxt(k,554) + rxt(k,560) & + + het_rates(k,62) ) + mat(k,5) = -( het_rates(k,63) ) + mat(k,1135) = -( het_rates(k,64) ) + mat(k,215) = 1.500_r8*rxt(k,22) + mat(k,485) = .450_r8*rxt(k,23) + mat(k,668) = .600_r8*rxt(k,26) + mat(k,358) = rxt(k,27) + mat(k,2010) = rxt(k,32) + rxt(k,33) + mat(k,1126) = rxt(k,34) + mat(k,1260) = rxt(k,36) + mat(k,1468) = .380_r8*rxt(k,39) + mat(k,869) = rxt(k,41) + mat(k,1141) = rxt(k,43) + mat(k,971) = 2.000_r8*rxt(k,44) + mat(k,1189) = .330_r8*rxt(k,45) + mat(k,1248) = 1.340_r8*rxt(k,50) + mat(k,1368) = .700_r8*rxt(k,55) + mat(k,243) = 1.500_r8*rxt(k,64) + mat(k,699) = .250_r8*rxt(k,65) + mat(k,1019) = rxt(k,68) + mat(k,1116) = 1.700_r8*rxt(k,69) + mat(k,394) = rxt(k,110) + mat(k,868) = -( rxt(k,41) + het_rates(k,65) ) + mat(k,624) = rxt(k,37) + mat(k,1466) = .440_r8*rxt(k,39) + mat(k,567) = .400_r8*rxt(k,60) + mat(k,696) = rxt(k,65) + mat(k,1113) = .800_r8*rxt(k,69) + mat(k,290) = -( rxt(k,96) + het_rates(k,66) ) + mat(k,179) = rxt(k,79) + mat(k,184) = rxt(k,80) + mat(k,190) = rxt(k,82) + mat(k,157) = 2.000_r8*rxt(k,83) + mat(k,194) = 2.000_r8*rxt(k,84) + mat(k,161) = rxt(k,85) + mat(k,169) = 2.000_r8*rxt(k,98) + mat(k,286) = rxt(k,101) + mat(k,339) = rxt(k,102) + mat(k,269) = -( rxt(k,97) + het_rates(k,67) ) + mat(k,153) = rxt(k,81) + mat(k,189) = rxt(k,82) + mat(k,265) = rxt(k,100) + mat(k,237) = -( het_rates(k,68) ) + mat(k,318) = -( het_rates(k,69) ) + mat(k,6) = -( het_rates(k,70) ) + mat(k,7) = -( het_rates(k,71) ) + mat(k,8) = -( het_rates(k,72) ) + mat(k,9) = -( rxt(k,562) + het_rates(k,73) ) + mat(k,198) = -( rxt(k,42) + het_rates(k,74) ) + mat(k,913) = -( het_rates(k,75) ) + mat(k,185) = rxt(k,80) + mat(k,195) = rxt(k,84) + mat(k,291) = 2.000_r8*rxt(k,96) + mat(k,270) = rxt(k,97) + mat(k,337) = rxt(k,104) end do end subroutine linmat01 subroutine linmat02( avec_len, mat, y, rxt, het_rates ) @@ -260,207 +246,207 @@ subroutine linmat02( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,358) = -( rxt(k,10) + rxt(k,11) + rxt(k,192) + het_rates(k,90) ) - mat(k,684) = -( rxt(k,105) + het_rates(k,91) ) - mat(k,504) = rxt(k,532) + rxt(k,535) + rxt(k,540) - mat(k,729) = -( rxt(k,106) + het_rates(k,92) ) - mat(k,870) = rxt(k,534) + rxt(k,539) + rxt(k,545) - mat(k,932) = -( rxt(k,45) + rxt(k,502) + het_rates(k,93) ) - mat(k,203) = -( rxt(k,46) + het_rates(k,94) ) - mat(k,1210) = rxt(k,393) - mat(k,959) = -( rxt(k,47) + het_rates(k,95) ) - mat(k,934) = .170_r8*rxt(k,45) - mat(k,281) = -( het_rates(k,96) ) - mat(k,103) = -( het_rates(k,97) ) - mat(k,766) = -( het_rates(k,98) ) - mat(k,511) = -( rxt(k,503) + het_rates(k,99) ) - mat(k,471) = -( rxt(k,504) + het_rates(k,100) ) - mat(k,1088) = -( het_rates(k,101) ) - mat(k,322) = -( rxt(k,48) + het_rates(k,102) ) - mat(k,596) = -( rxt(k,49) + het_rates(k,103) ) - mat(k,323) = rxt(k,48) - mat(k,61) = -( het_rates(k,104) ) - mat(k,77) = -( het_rates(k,105) ) - mat(k,1104) = -( rxt(k,50) + rxt(k,51) + het_rates(k,106) ) - mat(k,598) = .288_r8*rxt(k,49) - mat(k,289) = -( het_rates(k,107) ) - mat(k,447) = -( rxt(k,52) + het_rates(k,108) ) - mat(k,565) = .800_r8*rxt(k,19) - mat(k,576) = .800_r8*rxt(k,20) - mat(k,284) = -( rxt(k,53) + het_rates(k,109) ) - mat(k,479) = -( rxt(k,54) + rxt(k,375) + het_rates(k,110) ) - mat(k,805) = -( het_rates(k,111) ) - mat(k,1174) = -( rxt(k,55) + het_rates(k,112) ) - mat(k,599) = .402_r8*rxt(k,49) - mat(k,364) = -( rxt(k,174) + het_rates(k,113) ) - mat(k,1338) = rxt(k,15) - mat(k,231) = -( rxt(k,13) + rxt(k,14) + rxt(k,193) + rxt(k,505) + rxt(k,530) & - + rxt(k,533) + rxt(k,544) + het_rates(k,115) ) - mat(k,310) = -( rxt(k,506) + het_rates(k,116) ) - mat(k,912) = -( rxt(k,56) + rxt(k,507) + het_rates(k,117) ) - mat(k,6) = -( het_rates(k,118) ) - mat(k,7) = -( het_rates(k,119) ) - mat(k,8) = -( het_rates(k,120) ) - mat(k,90) = -( het_rates(k,121) ) - mat(k,9) = -( rxt(k,508) + het_rates(k,122) ) - mat(k,1395) = -( rxt(k,15) + het_rates(k,123) ) - mat(k,233) = rxt(k,13) - mat(k,1758) = rxt(k,16) + .500_r8*rxt(k,509) - mat(k,1815) = rxt(k,17) - mat(k,366) = rxt(k,174) - mat(k,1535) = 2.000_r8*rxt(k,186)*y(k,114) - mat(k,1764) = -( rxt(k,16) + rxt(k,509) + het_rates(k,124) ) - mat(k,1312) = rxt(k,9) - mat(k,361) = rxt(k,11) + rxt(k,192) - mat(k,234) = rxt(k,14) + rxt(k,193) - mat(k,1821) = rxt(k,18) - mat(k,575) = rxt(k,19) - mat(k,942) = rxt(k,45) - mat(k,327) = rxt(k,48) - mat(k,485) = rxt(k,54) + rxt(k,375) - mat(k,921) = rxt(k,56) - mat(k,752) = rxt(k,57) - mat(k,333) = rxt(k,58) - mat(k,193) = rxt(k,59) - mat(k,408) = .600_r8*rxt(k,60) + rxt(k,326) - mat(k,556) = rxt(k,66) - mat(k,507) = rxt(k,76) - mat(k,875) = rxt(k,94) - mat(k,108) = rxt(k,450) - mat(k,1822) = -( rxt(k,17) + rxt(k,18) + rxt(k,510) + het_rates(k,125) ) - mat(k,362) = rxt(k,10) - mat(k,235) = rxt(k,13) + rxt(k,14) + rxt(k,193) - mat(k,409) = .400_r8*rxt(k,60) - mat(k,508) = rxt(k,77) - mat(k,876) = rxt(k,95) - mat(k,747) = -( rxt(k,57) + het_rates(k,126) ) - mat(k,328) = -( rxt(k,58) + rxt(k,511) + het_rates(k,127) ) - mat(k,10) = -( het_rates(k,128) ) - mat(k,11) = -( het_rates(k,129) ) - mat(k,12) = -( het_rates(k,130) ) - mat(k,13) = -( het_rates(k,131) ) - mat(k,2017) = -( rxt(k,151) + het_rates(k,132) ) - mat(k,2076) = rxt(k,3) - mat(k,1937) = rxt(k,8) - mat(k,236) = rxt(k,13) - mat(k,1407) = rxt(k,15) - mat(k,1770) = rxt(k,16) - mat(k,1827) = rxt(k,18) - mat(k,1961) = rxt(k,75) - mat(k,1987) = rxt(k,93) - mat(k,264) = rxt(k,107) - mat(k,1137) = rxt(k,111) + rxt(k,492) - mat(k,758) = rxt(k,112) - mat(k,214) = rxt(k,113) - mat(k,1547) = rxt(k,146) + rxt(k,147) - mat(k,369) = rxt(k,174) - mat(k,446) = rxt(k,486) - mat(k,1934) = -( rxt(k,7) + rxt(k,8) + het_rates(k,133) ) - mat(k,2014) = rxt(k,151) - mat(k,260) = -( rxt(k,107) + het_rates(k,135) ) - mat(k,302) = -( rxt(k,110) + het_rates(k,136) ) - mat(k,191) = -( rxt(k,59) + rxt(k,512) + het_rates(k,137) ) - mat(k,404) = -( rxt(k,60) + rxt(k,326) + het_rates(k,138) ) - mat(k,106) = -( rxt(k,450) + het_rates(k,139) ) - mat(k,400) = -( het_rates(k,140) ) - mat(k,221) = rxt(k,31) - mat(k,133) = -( het_rates(k,141) ) - mat(k,265) = -( rxt(k,61) + het_rates(k,142) ) - mat(k,14) = -( het_rates(k,143) ) - mat(k,15) = -( het_rates(k,144) ) - mat(k,16) = -( het_rates(k,145) ) - mat(k,17) = -( het_rates(k,146) ) - mat(k,459) = -( rxt(k,62) + het_rates(k,147) ) - mat(k,316) = -( rxt(k,63) + het_rates(k,148) ) - mat(k,441) = -( rxt(k,486) + het_rates(k,149) ) - mat(k,303) = rxt(k,110) - mat(k,1125) = rxt(k,111) - mat(k,1127) = -( rxt(k,111) + rxt(k,492) + het_rates(k,151) ) - mat(k,755) = rxt(k,112) - mat(k,442) = rxt(k,486) - mat(k,754) = -( rxt(k,112) + het_rates(k,152) ) - mat(k,213) = rxt(k,113) - mat(k,1126) = rxt(k,492) - mat(k,212) = -( rxt(k,113) + het_rates(k,153) ) - mat(k,116) = rxt(k,109) - mat(k,18) = -( het_rates(k,154) ) - mat(k,19) = -( het_rates(k,155) ) - mat(k,20) = -( het_rates(k,156) ) - mat(k,21) = -( rxt(k,114) + het_rates(k,157) ) - mat(k,22) = -( rxt(k,115) + het_rates(k,158) ) - mat(k,23) = -( rxt(k,116) + het_rates(k,159) ) - mat(k,24) = -( rxt(k,117) + het_rates(k,160) ) - mat(k,25) = -( rxt(k,118) + het_rates(k,161) ) - mat(k,26) = -( rxt(k,119) + het_rates(k,162) ) - mat(k,27) = -( rxt(k,120) + het_rates(k,163) ) - mat(k,28) = -( rxt(k,121) + het_rates(k,164) ) - mat(k,29) = -( rxt(k,122) + het_rates(k,165) ) - mat(k,30) = -( rxt(k,123) + het_rates(k,166) ) - mat(k,31) = -( rxt(k,124) + het_rates(k,167) ) - mat(k,32) = -( rxt(k,125) + het_rates(k,168) ) - mat(k,33) = -( rxt(k,126) + het_rates(k,169) ) - mat(k,34) = -( rxt(k,127) + het_rates(k,170) ) - mat(k,35) = -( rxt(k,128) + het_rates(k,171) ) - mat(k,36) = -( rxt(k,129) + het_rates(k,172) ) - mat(k,37) = -( rxt(k,130) + het_rates(k,173) ) - mat(k,38) = -( rxt(k,131) + het_rates(k,174) ) - mat(k,39) = -( rxt(k,132) + het_rates(k,175) ) - mat(k,40) = -( rxt(k,133) + het_rates(k,176) ) - mat(k,41) = -( rxt(k,134) + het_rates(k,177) ) - mat(k,42) = -( rxt(k,135) + het_rates(k,178) ) - mat(k,43) = -( rxt(k,136) + het_rates(k,179) ) - mat(k,44) = -( rxt(k,137) + het_rates(k,180) ) - mat(k,45) = -( rxt(k,138) + het_rates(k,181) ) - mat(k,46) = -( rxt(k,139) + het_rates(k,182) ) - mat(k,47) = -( rxt(k,140) + het_rates(k,183) ) - mat(k,48) = -( rxt(k,141) + het_rates(k,184) ) - mat(k,49) = -( rxt(k,142) + het_rates(k,185) ) - mat(k,50) = -( rxt(k,143) + het_rates(k,186) ) - mat(k,51) = -( het_rates(k,187) ) - mat(k,52) = -( het_rates(k,188) ) - mat(k,53) = -( het_rates(k,189) ) - mat(k,54) = -( het_rates(k,190) ) - mat(k,55) = -( het_rates(k,191) ) - mat(k,62) = -( het_rates(k,192) ) - mat(k,791) = rxt(k,500) - mat(k,63) = -( het_rates(k,193) ) - mat(k,64) = -( het_rates(k,194) ) - mat(k,65) = -( het_rates(k,195) ) - mat(k,66) = -( het_rates(k,196) ) - mat(k,67) = -( het_rates(k,197) ) - mat(k,68) = -( het_rates(k,198) ) - mat(k,69) = -( het_rates(k,199) ) - mat(k,70) = -( het_rates(k,200) ) - mat(k,71) = -( het_rates(k,201) ) - mat(k,83) = -( het_rates(k,202) ) - mat(k,89) = -( het_rates(k,203) ) - mat(k,165) = -( rxt(k,64) + het_rates(k,204) ) - mat(k,527) = -( rxt(k,65) + het_rates(k,205) ) - mat(k,551) = -( rxt(k,66) + rxt(k,513) + het_rates(k,206) ) - mat(k,411) = -( rxt(k,67) + het_rates(k,207) ) - mat(k,881) = -( rxt(k,68) + het_rates(k,208) ) - mat(k,329) = rxt(k,58) - mat(k,552) = rxt(k,66) - mat(k,413) = rxt(k,67) - mat(k,946) = -( rxt(k,69) + het_rates(k,209) ) - mat(k,530) = rxt(k,65) - mat(k,882) = rxt(k,68) - mat(k,538) = -( rxt(k,70) + het_rates(k,210) ) - mat(k,153) = -( het_rates(k,211) ) - mat(k,169) = -( rxt(k,71) + het_rates(k,212) ) - mat(k,178) = -( het_rates(k,213) ) - mat(k,607) = -( rxt(k,72) + het_rates(k,214) ) - mat(k,186) = -( het_rates(k,215) ) - mat(k,370) = -( rxt(k,73) + het_rates(k,216) ) - mat(k,453) = -( het_rates(k,219) ) - mat(k,107) = rxt(k,450) - mat(k,853) = -( het_rates(k,220) ) - mat(k,420) = -( het_rates(k,221) ) - mat(k,378) = -( het_rates(k,222) ) - mat(k,739) = -( het_rates(k,223) ) - mat(k,449) = rxt(k,52) - mat(k,710) = -( het_rates(k,224) ) - mat(k,559) = -( het_rates(k,225) ) + mat(k,1142) = -( rxt(k,43) + het_rates(k,76) ) + mat(k,1190) = .330_r8*rxt(k,45) + mat(k,700) = .250_r8*rxt(k,65) + mat(k,312) = rxt(k,319) + mat(k,970) = -( rxt(k,44) + rxt(k,541) + het_rates(k,77) ) + mat(k,424) = rxt(k,21) + mat(k,484) = .130_r8*rxt(k,23) + mat(k,369) = .700_r8*rxt(k,61) + mat(k,653) = .600_r8*rxt(k,70) + mat(k,746) = .340_r8*rxt(k,72) + mat(k,471) = .170_r8*rxt(k,73) + mat(k,1503) = -( rxt(k,157) + het_rates(k,78) ) + mat(k,2341) = rxt(k,2) + 2.000_r8*rxt(k,3) + mat(k,2015) = 2.000_r8*rxt(k,33) + mat(k,452) = rxt(k,38) + mat(k,1472) = .330_r8*rxt(k,39) + rxt(k,40) + mat(k,851) = rxt(k,99) + mat(k,1961) = rxt(k,103) + mat(k,338) = rxt(k,104) + mat(k,1441) = -( het_rates(k,79) ) + mat(k,2337) = rxt(k,1) + mat(k,2011) = rxt(k,32) + mat(k,1469) = 1.440_r8*rxt(k,39) + mat(k,168) = -( rxt(k,98) + het_rates(k,80) ) + mat(k,639) = -( rxt(k,4) + het_rates(k,81) ) + mat(k,2163) = .500_r8*rxt(k,499) + mat(k,201) = -( rxt(k,109) + het_rates(k,82) ) + mat(k,849) = -( rxt(k,99) + het_rates(k,83) ) + mat(k,264) = -( rxt(k,100) + het_rates(k,84) ) + mat(k,285) = -( rxt(k,101) + het_rates(k,85) ) + mat(k,340) = -( rxt(k,102) + het_rates(k,86) ) + mat(k,1967) = -( rxt(k,103) + het_rates(k,87) ) + mat(k,225) = -( het_rates(k,88) ) + mat(k,1010) = -( het_rates(k,89) ) + mat(k,336) = -( rxt(k,104) + het_rates(k,90) ) + mat(k,1487) = -( rxt(k,9) + het_rates(k,91) ) + mat(k,1196) = rxt(k,500) + mat(k,661) = rxt(k,501) + mat(k,587) = rxt(k,502) + mat(k,347) = 2.000_r8*rxt(k,503) + 2.000_r8*rxt(k,545) + 2.000_r8*rxt(k,548) & + + 2.000_r8*rxt(k,559) + mat(k,442) = rxt(k,504) + mat(k,1089) = rxt(k,505) + mat(k,1698) = .500_r8*rxt(k,507) + mat(k,2071) = rxt(k,508) + mat(k,466) = rxt(k,509) + mat(k,277) = rxt(k,510) + mat(k,672) = rxt(k,511) + mat(k,577) = rxt(k,547) + rxt(k,550) + rxt(k,555) + mat(k,925) = rxt(k,549) + rxt(k,554) + rxt(k,560) + mat(k,445) = -( rxt(k,10) + rxt(k,11) + rxt(k,192) + het_rates(k,92) ) + mat(k,818) = -( rxt(k,105) + het_rates(k,93) ) + mat(k,575) = rxt(k,547) + rxt(k,550) + rxt(k,555) + mat(k,842) = -( rxt(k,106) + het_rates(k,94) ) + mat(k,923) = rxt(k,549) + rxt(k,554) + rxt(k,560) + mat(k,1193) = -( rxt(k,45) + rxt(k,500) + het_rates(k,95) ) + mat(k,293) = -( rxt(k,46) + het_rates(k,96) ) + mat(k,1312) = rxt(k,392) + mat(k,1180) = -( rxt(k,47) + het_rates(k,97) ) + mat(k,1192) = .170_r8*rxt(k,45) + mat(k,383) = -( het_rates(k,98) ) + mat(k,172) = -( het_rates(k,99) ) + mat(k,874) = -( het_rates(k,100) ) + mat(k,657) = -( rxt(k,501) + het_rates(k,101) ) + mat(k,582) = -( rxt(k,502) + het_rates(k,102) ) + mat(k,1233) = -( het_rates(k,103) ) + mat(k,433) = -( rxt(k,48) + het_rates(k,104) ) + mat(k,86) = -( het_rates(k,105) ) + mat(k,730) = -( rxt(k,49) + het_rates(k,106) ) + mat(k,434) = rxt(k,48) + mat(k,69) = -( het_rates(k,107) ) + mat(k,67) = -( het_rates(k,108) ) + mat(k,105) = -( het_rates(k,109) ) + mat(k,103) = -( het_rates(k,110) ) + mat(k,1249) = -( rxt(k,50) + rxt(k,51) + het_rates(k,111) ) + mat(k,732) = .300_r8*rxt(k,49) + mat(k,386) = -( het_rates(k,112) ) + mat(k,548) = -( rxt(k,52) + het_rates(k,113) ) + mat(k,684) = .800_r8*rxt(k,19) + mat(k,705) = .800_r8*rxt(k,20) + mat(k,352) = -( rxt(k,53) + het_rates(k,114) ) + mat(k,630) = -( rxt(k,54) + rxt(k,374) + het_rates(k,115) ) + mat(k,1039) = -( het_rates(k,116) ) + mat(k,92) = -( het_rates(k,117) ) + mat(k,1372) = -( rxt(k,55) + het_rates(k,118) ) + mat(k,733) = .700_r8*rxt(k,49) + mat(k,506) = -( rxt(k,174) + het_rates(k,119) ) + mat(k,1549) = rxt(k,15) + mat(k,222) = -( rxt(k,12) + het_rates(k,120) ) + mat(k,346) = -( rxt(k,13) + rxt(k,14) + rxt(k,193) + rxt(k,503) + rxt(k,545) & + + rxt(k,548) + rxt(k,559) + het_rates(k,121) ) + mat(k,439) = -( rxt(k,504) + het_rates(k,122) ) + mat(k,1085) = -( rxt(k,56) + rxt(k,505) + het_rates(k,123) ) + mat(k,10) = -( het_rates(k,124) ) + mat(k,11) = -( het_rates(k,125) ) + mat(k,12) = -( het_rates(k,126) ) + mat(k,136) = -( het_rates(k,127) ) + mat(k,13) = -( rxt(k,506) + het_rates(k,128) ) + mat(k,1604) = -( rxt(k,15) + het_rates(k,129) ) + mat(k,348) = rxt(k,13) + mat(k,1700) = rxt(k,16) + .500_r8*rxt(k,507) + mat(k,2073) = rxt(k,17) + mat(k,508) = rxt(k,174) + mat(k,1702) = -( rxt(k,16) + rxt(k,507) + het_rates(k,130) ) + mat(k,1490) = rxt(k,9) + mat(k,446) = rxt(k,11) + rxt(k,192) + mat(k,349) = rxt(k,14) + rxt(k,193) + mat(k,2075) = rxt(k,18) + mat(k,691) = rxt(k,19) + mat(k,1199) = rxt(k,45) + mat(k,436) = rxt(k,48) + mat(k,634) = rxt(k,54) + rxt(k,374) + mat(k,1092) = rxt(k,56) + mat(k,893) = rxt(k,57) + mat(k,467) = rxt(k,58) + mat(k,278) = rxt(k,59) + mat(k,570) = .600_r8*rxt(k,60) + rxt(k,325) + mat(k,673) = rxt(k,66) + mat(k,578) = rxt(k,76) + mat(k,926) = rxt(k,94) + mat(k,177) = rxt(k,449) + mat(k,2082) = -( rxt(k,17) + rxt(k,18) + rxt(k,508) + het_rates(k,131) ) + mat(k,448) = rxt(k,10) + mat(k,351) = rxt(k,13) + rxt(k,14) + rxt(k,193) + mat(k,573) = .400_r8*rxt(k,60) + mat(k,580) = rxt(k,77) + mat(k,931) = rxt(k,95) + mat(k,890) = -( rxt(k,57) + het_rates(k,132) ) + mat(k,463) = -( rxt(k,58) + rxt(k,509) + het_rates(k,133) ) + mat(k,14) = -( het_rates(k,134) ) + mat(k,15) = -( het_rates(k,135) ) + mat(k,16) = -( het_rates(k,136) ) + mat(k,17) = -( het_rates(k,137) ) + mat(k,1999) = -( rxt(k,151) + het_rates(k,138) ) + mat(k,2349) = rxt(k,3) + mat(k,2323) = rxt(k,8) + mat(k,350) = rxt(k,13) + mat(k,1611) = rxt(k,15) + mat(k,1707) = rxt(k,16) + mat(k,2080) = rxt(k,18) + mat(k,1477) = .180_r8*rxt(k,39) + mat(k,870) = rxt(k,41) + mat(k,2104) = rxt(k,75) + mat(k,1946) = rxt(k,93) + mat(k,366) = rxt(k,107) + mat(k,1279) = rxt(k,111) + rxt(k,492) + mat(k,900) = rxt(k,112) + mat(k,301) = rxt(k,113) + mat(k,1748) = rxt(k,146) + rxt(k,147) + mat(k,512) = rxt(k,174) + mat(k,564) = rxt(k,485) + mat(k,2329) = -( rxt(k,7) + rxt(k,8) + het_rates(k,139) ) + mat(k,2005) = rxt(k,151) + mat(k,18) = -( het_rates(k,140) ) + mat(k,362) = -( rxt(k,107) + het_rates(k,141) ) + mat(k,391) = -( rxt(k,110) + het_rates(k,142) ) + mat(k,276) = -( rxt(k,59) + rxt(k,510) + het_rates(k,143) ) + mat(k,566) = -( rxt(k,60) + rxt(k,325) + het_rates(k,144) ) + mat(k,175) = -( rxt(k,449) + het_rates(k,145) ) + mat(k,513) = -( het_rates(k,146) ) + mat(k,308) = rxt(k,31) + mat(k,217) = -( het_rates(k,147) ) + mat(k,367) = -( rxt(k,61) + het_rates(k,148) ) + mat(k,19) = -( het_rates(k,149) ) + mat(k,20) = -( het_rates(k,150) ) + mat(k,21) = -( het_rates(k,151) ) + mat(k,22) = -( het_rates(k,152) ) + mat(k,590) = -( rxt(k,62) + het_rates(k,153) ) + mat(k,415) = -( rxt(k,63) + het_rates(k,154) ) + mat(k,560) = -( rxt(k,485) + het_rates(k,155) ) + mat(k,392) = rxt(k,110) + mat(k,1270) = rxt(k,111) + mat(k,23) = -( rxt(k,108) + het_rates(k,156) ) + mat(k,1272) = -( rxt(k,111) + rxt(k,492) + het_rates(k,157) ) + mat(k,898) = rxt(k,112) + mat(k,561) = rxt(k,485) + mat(k,897) = -( rxt(k,112) + het_rates(k,158) ) + mat(k,300) = rxt(k,113) + mat(k,1271) = rxt(k,492) + mat(k,299) = -( rxt(k,113) + het_rates(k,159) ) + mat(k,202) = rxt(k,109) + mat(k,24) = -( het_rates(k,160) ) + mat(k,25) = -( het_rates(k,161) ) + mat(k,26) = -( het_rates(k,162) ) + mat(k,27) = -( rxt(k,114) + het_rates(k,163) ) + mat(k,28) = -( rxt(k,115) + het_rates(k,164) ) + mat(k,29) = -( rxt(k,116) + het_rates(k,165) ) + mat(k,30) = -( rxt(k,117) + het_rates(k,166) ) + mat(k,31) = -( rxt(k,118) + het_rates(k,167) ) + mat(k,32) = -( rxt(k,119) + het_rates(k,168) ) + mat(k,33) = -( rxt(k,120) + het_rates(k,169) ) + mat(k,34) = -( rxt(k,121) + het_rates(k,170) ) + mat(k,35) = -( rxt(k,122) + het_rates(k,171) ) + mat(k,36) = -( rxt(k,123) + het_rates(k,172) ) + mat(k,37) = -( rxt(k,124) + het_rates(k,173) ) + mat(k,38) = -( rxt(k,125) + het_rates(k,174) ) + mat(k,39) = -( rxt(k,126) + het_rates(k,175) ) + mat(k,40) = -( rxt(k,127) + het_rates(k,176) ) + mat(k,41) = -( rxt(k,128) + het_rates(k,177) ) + mat(k,42) = -( rxt(k,129) + het_rates(k,178) ) + mat(k,43) = -( rxt(k,130) + het_rates(k,179) ) end do end subroutine linmat02 subroutine linmat03( avec_len, mat, y, rxt, het_rates ) @@ -483,151 +469,198 @@ subroutine linmat03( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,1280) = -( het_rates(k,226) ) - mat(k,338) = .130_r8*rxt(k,23) - mat(k,258) = rxt(k,27) - mat(k,865) = rxt(k,35) - mat(k,1117) = rxt(k,36) - mat(k,937) = .330_r8*rxt(k,45) - mat(k,961) = rxt(k,47) - mat(k,1108) = 1.340_r8*rxt(k,50) - mat(k,450) = rxt(k,52) - mat(k,287) = rxt(k,53) - mat(k,1176) = .300_r8*rxt(k,55) - mat(k,749) = rxt(k,57) - mat(k,405) = .600_r8*rxt(k,60) + rxt(k,326) - mat(k,318) = rxt(k,63) - mat(k,167) = .500_r8*rxt(k,64) - mat(k,949) = .650_r8*rxt(k,69) - mat(k,1873) = -( het_rates(k,227) ) - mat(k,1047) = rxt(k,34) - mat(k,867) = rxt(k,35) - mat(k,439) = rxt(k,37) - mat(k,1185) = .300_r8*rxt(k,55) - mat(k,410) = .400_r8*rxt(k,60) - mat(k,2047) = rxt(k,195)*y(k,54) - mat(k,699) = rxt(k,251)*y(k,54) - mat(k,1702) = rxt(k,284)*y(k,54) - mat(k,1543) = rxt(k,291)*y(k,54) - mat(k,665) = -( het_rates(k,228) ) - mat(k,229) = .600_r8*rxt(k,25) - mat(k,495) = -( het_rates(k,229) ) - mat(k,224) = -( rxt(k,319) + rxt(k,320) + het_rates(k,230) ) - mat(k,113) = rxt(k,42) - mat(k,620) = -( het_rates(k,231) ) - mat(k,1513) = -( rxt(k,501) + het_rates(k,232) ) - mat(k,359) = rxt(k,11) + rxt(k,192) - mat(k,572) = rxt(k,19) - mat(k,584) = .900_r8*rxt(k,20) - mat(k,350) = rxt(k,21) - mat(k,132) = 1.500_r8*rxt(k,22) - mat(k,339) = .560_r8*rxt(k,23) - mat(k,399) = rxt(k,24) - mat(k,230) = .600_r8*rxt(k,25) - mat(k,550) = .600_r8*rxt(k,26) - mat(k,259) = rxt(k,27) - mat(k,274) = rxt(k,28) - mat(k,279) = rxt(k,29) - mat(k,343) = rxt(k,30) - mat(k,1044) = rxt(k,34) - mat(k,1120) = rxt(k,36) - mat(k,926) = 2.000_r8*rxt(k,43) - mat(k,794) = 2.000_r8*rxt(k,44) - mat(k,939) = .670_r8*rxt(k,45) - mat(k,206) = rxt(k,46) - mat(k,962) = rxt(k,47) - mat(k,325) = rxt(k,48) - mat(k,600) = rxt(k,49) - mat(k,1110) = 1.340_r8*rxt(k,50) + .660_r8*rxt(k,51) - mat(k,918) = rxt(k,56) - mat(k,268) = rxt(k,61) - mat(k,463) = rxt(k,62) - mat(k,168) = rxt(k,64) - mat(k,533) = rxt(k,65) - mat(k,554) = rxt(k,66) - mat(k,415) = rxt(k,67) - mat(k,886) = rxt(k,68) - mat(k,950) = 1.200_r8*rxt(k,69) - mat(k,545) = rxt(k,70) - mat(k,616) = rxt(k,72) - mat(k,374) = rxt(k,73) - mat(k,1322) = rxt(k,157) - mat(k,387) = rxt(k,289) - mat(k,226) = rxt(k,319) + rxt(k,320) - mat(k,1236) = rxt(k,393) - mat(k,2041) = rxt(k,259)*y(k,43) + rxt(k,262)*y(k,46) - mat(k,1696) = rxt(k,260)*y(k,43) + rxt(k,263)*y(k,46) - mat(k,1537) = rxt(k,292)*y(k,54) - mat(k,384) = -( rxt(k,289) + het_rates(k,233) ) - mat(k,1152) = -( het_rates(k,234) ) - mat(k,1230) = -( rxt(k,393) + het_rates(k,235) ) - mat(k,1197) = -( het_rates(k,236) ) - mat(k,627) = -( het_rates(k,237) ) - mat(k,398) = .600_r8*rxt(k,24) - mat(k,1249) = -( het_rates(k,238) ) - mat(k,1107) = .660_r8*rxt(k,50) - mat(k,481) = rxt(k,54) + rxt(k,375) - mat(k,782) = -( het_rates(k,239) ) - mat(k,548) = .600_r8*rxt(k,26) - mat(k,588) = -( het_rates(k,240) ) - mat(k,1013) = -( het_rates(k,241) ) - mat(k,1538) = -( rxt(k,146) + rxt(k,147) + rxt(k,186)*y(k,114) & - + rxt(k,187)*y(k,114) + rxt(k,219)*y(k,33) + rxt(k,220)*y(k,34) & - + rxt(k,221)*y(k,36) + rxt(k,222)*y(k,37) + rxt(k,223)*y(k,38) & - + rxt(k,224)*y(k,39) + rxt(k,225)*y(k,40) + rxt(k,246)*y(k,35) & - + rxt(k,247)*y(k,55) + rxt(k,248)*y(k,78) + rxt(k,269)*y(k,41) & - + rxt(k,270)*y(k,43) + rxt(k,271)*y(k,82) + rxt(k,272)*y(k,83) & - + rxt(k,273)*y(k,84) + rxt(k,291)*y(k,54) + rxt(k,292)*y(k,54) & - + rxt(k,293)*y(k,54) + het_rates(k,242) ) - mat(k,2067) = rxt(k,1) - mat(k,1928) = rxt(k,7) - mat(k,1698) = -( rxt(k,258)*y(k,41) + rxt(k,260)*y(k,43) + rxt(k,261)*y(k,44) & - + rxt(k,263)*y(k,46) + rxt(k,265)*y(k,55) + rxt(k,266)*y(k,82) & - + rxt(k,267)*y(k,83) + rxt(k,268)*y(k,84) + rxt(k,284)*y(k,54) & - + het_rates(k,243) ) - mat(k,2068) = rxt(k,2) - mat(k,523) = 2.000_r8*rxt(k,4) - mat(k,1311) = rxt(k,9) - mat(k,360) = rxt(k,10) - mat(k,585) = rxt(k,20) - mat(k,351) = rxt(k,21) - mat(k,275) = rxt(k,28) - mat(k,280) = rxt(k,29) - mat(k,344) = rxt(k,30) - mat(k,223) = rxt(k,31) - mat(k,437) = rxt(k,37) - mat(k,354) = rxt(k,38) - mat(k,114) = rxt(k,42) - mat(k,207) = rxt(k,46) - mat(k,288) = rxt(k,53) - mat(k,332) = rxt(k,58) - mat(k,269) = rxt(k,61) - mat(k,464) = rxt(k,62) - mat(k,319) = rxt(k,63) - mat(k,534) = rxt(k,65) - mat(k,416) = rxt(k,67) - mat(k,546) = rxt(k,70) - mat(k,171) = rxt(k,71) - mat(k,617) = rxt(k,72) - mat(k,375) = rxt(k,73) - mat(k,687) = rxt(k,105) - mat(k,731) = rxt(k,106) - mat(k,1762) = .500_r8*rxt(k,509) - mat(k,1539) = rxt(k,291)*y(k,54) - mat(k,391) = -( het_rates(k,244) ) - mat(k,674) = -( het_rates(k,245) ) - mat(k,1029) = -( het_rates(k,246) ) - mat(k,948) = .150_r8*rxt(k,69) - mat(k,994) = -( het_rates(k,247) ) - mat(k,972) = -( het_rates(k,248) ) - mat(k,638) = -( het_rates(k,249) ) - mat(k,1068) = -( het_rates(k,250) ) - mat(k,654) = -( het_rates(k,251) ) - mat(k,428) = -( het_rates(k,252) ) - mat(k,2078) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,253) ) - mat(k,117) = rxt(k,109) - mat(k,1708) = rxt(k,258)*y(k,41) + rxt(k,260)*y(k,43) + rxt(k,261)*y(k,44) & - + rxt(k,263)*y(k,46) + rxt(k,268)*y(k,84) + rxt(k,284)*y(k,54) + mat(k,44) = -( rxt(k,131) + het_rates(k,180) ) + mat(k,45) = -( rxt(k,132) + het_rates(k,181) ) + mat(k,46) = -( rxt(k,133) + het_rates(k,182) ) + mat(k,47) = -( rxt(k,134) + het_rates(k,183) ) + mat(k,48) = -( rxt(k,135) + het_rates(k,184) ) + mat(k,49) = -( rxt(k,136) + het_rates(k,185) ) + mat(k,50) = -( rxt(k,137) + het_rates(k,186) ) + mat(k,51) = -( rxt(k,138) + het_rates(k,187) ) + mat(k,52) = -( rxt(k,139) + het_rates(k,188) ) + mat(k,53) = -( rxt(k,140) + het_rates(k,189) ) + mat(k,54) = -( rxt(k,141) + het_rates(k,190) ) + mat(k,55) = -( rxt(k,142) + het_rates(k,191) ) + mat(k,56) = -( rxt(k,143) + het_rates(k,192) ) + mat(k,57) = -( het_rates(k,193) ) + mat(k,58) = -( het_rates(k,194) ) + mat(k,59) = -( het_rates(k,195) ) + mat(k,60) = -( het_rates(k,196) ) + mat(k,61) = -( het_rates(k,197) ) + mat(k,70) = -( het_rates(k,198) ) + mat(k,968) = rxt(k,541) + mat(k,71) = -( het_rates(k,199) ) + mat(k,72) = -( het_rates(k,200) ) + mat(k,73) = -( het_rates(k,201) ) + mat(k,74) = -( het_rates(k,202) ) + mat(k,93) = -( het_rates(k,203) ) + mat(k,94) = -( het_rates(k,204) ) + mat(k,95) = -( het_rates(k,205) ) + mat(k,96) = -( het_rates(k,206) ) + mat(k,97) = -( het_rates(k,207) ) + mat(k,117) = -( het_rates(k,208) ) + mat(k,123) = -( het_rates(k,209) ) + mat(k,242) = -( rxt(k,64) + het_rates(k,210) ) + mat(k,695) = -( rxt(k,65) + het_rates(k,211) ) + mat(k,670) = -( rxt(k,66) + rxt(k,511) + het_rates(k,212) ) + mat(k,524) = -( rxt(k,67) + het_rates(k,213) ) + mat(k,1016) = -( rxt(k,68) + het_rates(k,214) ) + mat(k,464) = rxt(k,58) + mat(k,671) = rxt(k,66) + mat(k,527) = rxt(k,67) + mat(k,1115) = -( rxt(k,69) + het_rates(k,215) ) + mat(k,698) = rxt(k,65) + mat(k,1018) = rxt(k,68) + mat(k,648) = -( rxt(k,70) + het_rates(k,216) ) + mat(k,230) = -( het_rates(k,217) ) + mat(k,129) = -( het_rates(k,218) ) + mat(k,246) = -( rxt(k,71) + het_rates(k,219) ) + mat(k,251) = -( het_rates(k,220) ) + mat(k,741) = -( rxt(k,72) + het_rates(k,221) ) + mat(k,135) = -( het_rates(k,222) ) + mat(k,259) = -( het_rates(k,223) ) + mat(k,469) = -( rxt(k,73) + het_rates(k,224) ) + mat(k,554) = -( het_rates(k,227) ) + mat(k,176) = rxt(k,449) + mat(k,939) = -( het_rates(k,228) ) + mat(k,533) = -( het_rates(k,229) ) + mat(k,477) = -( het_rates(k,230) ) + mat(k,860) = -( het_rates(k,231) ) + mat(k,550) = rxt(k,52) + mat(k,831) = -( het_rates(k,232) ) + mat(k,678) = -( het_rates(k,233) ) + mat(k,1426) = -( het_rates(k,234) ) + mat(k,487) = .130_r8*rxt(k,23) + mat(k,360) = rxt(k,27) + mat(k,964) = rxt(k,35) + mat(k,1262) = rxt(k,36) + mat(k,1195) = .330_r8*rxt(k,45) + mat(k,1182) = rxt(k,47) + mat(k,1253) = 1.340_r8*rxt(k,51) + mat(k,551) = rxt(k,52) + mat(k,355) = rxt(k,53) + mat(k,1374) = .300_r8*rxt(k,55) + mat(k,892) = rxt(k,57) + mat(k,568) = .600_r8*rxt(k,60) + rxt(k,325) + mat(k,417) = rxt(k,63) + mat(k,244) = .500_r8*rxt(k,64) + mat(k,1118) = .650_r8*rxt(k,69) + mat(k,1657) = -( het_rates(k,235) ) + mat(k,1129) = rxt(k,34) + mat(k,965) = rxt(k,35) + mat(k,626) = rxt(k,37) + mat(k,1473) = rxt(k,40) + mat(k,1378) = .300_r8*rxt(k,55) + mat(k,569) = .400_r8*rxt(k,60) + mat(k,616) = rxt(k,87) + mat(k,409) = rxt(k,89) + mat(k,799) = -( het_rates(k,236) ) + mat(k,316) = .600_r8*rxt(k,25) + mat(k,606) = -( het_rates(k,237) ) + mat(k,311) = -( rxt(k,318) + rxt(k,319) + het_rates(k,238) ) + mat(k,199) = rxt(k,42) + mat(k,754) = -( het_rates(k,239) ) + mat(k,2227) = -( rxt(k,499) + het_rates(k,240) ) + mat(k,449) = rxt(k,11) + rxt(k,192) + mat(k,694) = rxt(k,19) + mat(k,715) = .900_r8*rxt(k,20) + mat(k,426) = rxt(k,21) + mat(k,216) = 1.500_r8*rxt(k,22) + mat(k,488) = .560_r8*rxt(k,23) + mat(k,504) = rxt(k,24) + mat(k,317) = .600_r8*rxt(k,25) + mat(k,669) = .600_r8*rxt(k,26) + mat(k,361) = rxt(k,27) + mat(k,377) = rxt(k,28) + mat(k,382) = rxt(k,29) + mat(k,431) = rxt(k,30) + mat(k,1132) = rxt(k,34) + mat(k,1267) = rxt(k,36) + mat(k,1146) = 2.000_r8*rxt(k,43) + mat(k,974) = 2.000_r8*rxt(k,44) + mat(k,1204) = .670_r8*rxt(k,45) + mat(k,297) = rxt(k,46) + mat(k,1185) = rxt(k,47) + mat(k,438) = rxt(k,48) + mat(k,736) = rxt(k,49) + mat(k,1257) = .660_r8*rxt(k,50) + 1.340_r8*rxt(k,51) + mat(k,1096) = rxt(k,56) + mat(k,371) = rxt(k,61) + mat(k,596) = rxt(k,62) + mat(k,245) = rxt(k,64) + mat(k,704) = rxt(k,65) + mat(k,675) = rxt(k,66) + mat(k,530) = rxt(k,67) + mat(k,1023) = rxt(k,68) + mat(k,1123) = 1.200_r8*rxt(k,69) + mat(k,656) = rxt(k,70) + mat(k,751) = rxt(k,72) + mat(k,474) = rxt(k,73) + mat(k,1512) = rxt(k,157) + mat(k,494) = rxt(k,288) + mat(k,314) = rxt(k,318) + rxt(k,319) + mat(k,1341) = rxt(k,392) + mat(k,489) = -( rxt(k,288) + het_rates(k,241) ) + mat(k,1296) = -( het_rates(k,242) ) + mat(k,1328) = -( rxt(k,392) + het_rates(k,243) ) + mat(k,1351) = -( het_rates(k,244) ) + mat(k,761) = -( het_rates(k,245) ) + mat(k,503) = .600_r8*rxt(k,24) + mat(k,1394) = -( het_rates(k,246) ) + mat(k,1252) = .660_r8*rxt(k,51) + mat(k,633) = rxt(k,54) + rxt(k,374) + mat(k,903) = -( het_rates(k,247) ) + mat(k,667) = .600_r8*rxt(k,26) + mat(k,717) = -( het_rates(k,248) ) + mat(k,1101) = -( het_rates(k,249) ) + mat(k,1744) = -( rxt(k,146) + rxt(k,147) + het_rates(k,250) ) + mat(k,2345) = rxt(k,1) + mat(k,2319) = rxt(k,7) + mat(k,224) = rxt(k,12) + mat(k,1917) = -( het_rates(k,251) ) + mat(k,2346) = rxt(k,2) + mat(k,640) = 2.000_r8*rxt(k,4) + mat(k,1492) = rxt(k,9) + mat(k,447) = rxt(k,10) + mat(k,713) = rxt(k,20) + mat(k,425) = rxt(k,21) + mat(k,376) = rxt(k,28) + mat(k,381) = rxt(k,29) + mat(k,430) = rxt(k,30) + mat(k,310) = rxt(k,31) + mat(k,627) = rxt(k,37) + mat(k,454) = rxt(k,38) + mat(k,1475) = .330_r8*rxt(k,39) + mat(k,200) = rxt(k,42) + mat(k,296) = rxt(k,46) + mat(k,734) = rxt(k,49) + mat(k,356) = rxt(k,53) + mat(k,468) = rxt(k,58) + mat(k,370) = rxt(k,61) + mat(k,594) = rxt(k,62) + mat(k,418) = rxt(k,63) + mat(k,702) = rxt(k,65) + mat(k,528) = rxt(k,67) + mat(k,655) = rxt(k,70) + mat(k,248) = rxt(k,71) + mat(k,750) = rxt(k,72) + mat(k,473) = rxt(k,73) + mat(k,820) = rxt(k,105) + mat(k,843) = rxt(k,106) + mat(k,1704) = .500_r8*rxt(k,507) + mat(k,496) = -( het_rates(k,252) ) + mat(k,808) = -( het_rates(k,253) ) + mat(k,1169) = -( het_rates(k,254) ) + mat(k,1117) = .150_r8*rxt(k,69) + mat(k,1155) = -( het_rates(k,255) ) + mat(k,952) = -( het_rates(k,256) ) + mat(k,772) = -( het_rates(k,257) ) + mat(k,1213) = -( het_rates(k,258) ) + mat(k,788) = -( het_rates(k,259) ) + mat(k,541) = -( het_rates(k,260) ) + mat(k,2356) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,261) ) + mat(k,1482) = .050_r8*rxt(k,39) + mat(k,203) = rxt(k,109) end do end subroutine linmat03 subroutine linmat( avec_len, mat, y, rxt, het_rates ) diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_lu_factor.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_lu_factor.F90 index 60369c6070..bab8051054 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_lu_factor.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_lu_factor.F90 @@ -88,88 +88,68 @@ subroutine lu_fac02( avec_len, lu ) lu(k,53) = 1._r8 / lu(k,53) lu(k,54) = 1._r8 / lu(k,54) lu(k,55) = 1._r8 / lu(k,55) + lu(k,56) = 1._r8 / lu(k,56) + lu(k,57) = 1._r8 / lu(k,57) + lu(k,58) = 1._r8 / lu(k,58) + lu(k,59) = 1._r8 / lu(k,59) + lu(k,60) = 1._r8 / lu(k,60) lu(k,61) = 1._r8 / lu(k,61) - lu(k,62) = 1._r8 / lu(k,62) - lu(k,63) = 1._r8 / lu(k,63) - lu(k,64) = 1._r8 / lu(k,64) - lu(k,65) = 1._r8 / lu(k,65) - lu(k,66) = 1._r8 / lu(k,66) lu(k,67) = 1._r8 / lu(k,67) - lu(k,68) = 1._r8 / lu(k,68) lu(k,69) = 1._r8 / lu(k,69) lu(k,70) = 1._r8 / lu(k,70) lu(k,71) = 1._r8 / lu(k,71) - lu(k,77) = 1._r8 / lu(k,77) - lu(k,83) = 1._r8 / lu(k,83) - lu(k,89) = 1._r8 / lu(k,89) - lu(k,90) = 1._r8 / lu(k,90) - lu(k,91) = lu(k,91) * lu(k,90) - lu(k,92) = lu(k,92) * lu(k,90) - lu(k,1698) = lu(k,1698) - lu(k,91) * lu(k,1569) - lu(k,1708) = lu(k,1708) - lu(k,92) * lu(k,1569) + lu(k,72) = 1._r8 / lu(k,72) + lu(k,73) = 1._r8 / lu(k,73) + lu(k,74) = 1._r8 / lu(k,74) + lu(k,80) = 1._r8 / lu(k,80) + lu(k,86) = 1._r8 / lu(k,86) + lu(k,92) = 1._r8 / lu(k,92) 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,1696) = lu(k,1696) - lu(k,94) * lu(k,1570) - lu(k,1698) = lu(k,1698) - lu(k,95) * lu(k,1570) + lu(k,94) = 1._r8 / lu(k,94) + lu(k,95) = 1._r8 / lu(k,95) lu(k,96) = 1._r8 / lu(k,96) - lu(k,97) = lu(k,97) * lu(k,96) - lu(k,98) = lu(k,98) * lu(k,96) - lu(k,1986) = lu(k,1986) - lu(k,97) * lu(k,1964) - lu(k,1988) = lu(k,1988) - lu(k,98) * lu(k,1964) - lu(k,99) = 1._r8 / lu(k,99) - lu(k,100) = lu(k,100) * lu(k,99) - lu(k,101) = lu(k,101) * lu(k,99) - lu(k,102) = lu(k,102) * lu(k,99) - lu(k,1652) = lu(k,1652) - lu(k,100) * lu(k,1571) - lu(k,1698) = lu(k,1698) - lu(k,101) * lu(k,1571) - lu(k,1708) = lu(k,1708) - lu(k,102) * lu(k,1571) + lu(k,97) = 1._r8 / lu(k,97) 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,597) = lu(k,597) - lu(k,104) * lu(k,595) - lu(k,601) = lu(k,601) - lu(k,105) * lu(k,595) - lu(k,1680) = lu(k,1680) - lu(k,104) * lu(k,1572) - lu(k,1698) = lu(k,1698) - lu(k,105) * lu(k,1572) - lu(k,106) = 1._r8 / lu(k,106) - lu(k,107) = lu(k,107) * lu(k,106) - lu(k,108) = lu(k,108) * lu(k,106) - lu(k,453) = lu(k,453) - lu(k,107) * lu(k,452) - lu(k,458) = lu(k,458) - lu(k,108) * lu(k,452) - lu(k,1738) = lu(k,1738) - lu(k,107) * lu(k,1732) - lu(k,1764) = lu(k,1764) - lu(k,108) * lu(k,1732) - lu(k,109) = 1._r8 / lu(k,109) - lu(k,110) = lu(k,110) * lu(k,109) - lu(k,111) = lu(k,111) * lu(k,109) - lu(k,1529) = lu(k,1529) - lu(k,110) * lu(k,1526) - lu(k,1538) = lu(k,1538) - lu(k,111) * lu(k,1526) - lu(k,1649) = - lu(k,110) * lu(k,1573) - lu(k,1697) = - lu(k,111) * lu(k,1573) - lu(k,112) = 1._r8 / lu(k,112) - lu(k,113) = lu(k,113) * lu(k,112) - lu(k,114) = lu(k,114) * lu(k,112) - lu(k,619) = lu(k,619) - lu(k,113) * lu(k,618) - lu(k,624) = - lu(k,114) * lu(k,618) - lu(k,1435) = - lu(k,113) * lu(k,1432) - lu(k,1515) = lu(k,1515) - lu(k,114) * lu(k,1432) - lu(k,115) = 1._r8 / lu(k,115) - lu(k,116) = lu(k,116) * lu(k,115) - lu(k,117) = lu(k,117) * lu(k,115) - lu(k,212) = lu(k,212) - lu(k,116) * lu(k,211) - lu(k,215) = lu(k,215) - lu(k,117) * lu(k,211) - lu(k,2056) = lu(k,2056) - lu(k,116) * lu(k,2054) - lu(k,2078) = lu(k,2078) - lu(k,117) * lu(k,2054) + lu(k,105) = 1._r8 / lu(k,105) + lu(k,111) = 1._r8 / lu(k,111) + lu(k,117) = 1._r8 / lu(k,117) lu(k,123) = 1._r8 / lu(k,123) - lu(k,124) = lu(k,124) * lu(k,123) - lu(k,125) = lu(k,125) * lu(k,123) - lu(k,126) = lu(k,126) * lu(k,123) - lu(k,127) = lu(k,127) * lu(k,123) - lu(k,128) = lu(k,128) * lu(k,123) - lu(k,1575) = lu(k,1575) - lu(k,124) * lu(k,1574) - lu(k,1576) = lu(k,1576) - lu(k,125) * lu(k,1574) - lu(k,1619) = lu(k,1619) - lu(k,126) * lu(k,1574) - lu(k,1696) = lu(k,1696) - lu(k,127) * lu(k,1574) - lu(k,1698) = lu(k,1698) - lu(k,128) * lu(k,1574) + lu(k,129) = 1._r8 / lu(k,129) + lu(k,135) = 1._r8 / lu(k,135) + 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,1917) = lu(k,1917) - lu(k,137) * lu(k,1778) + lu(k,1927) = lu(k,1927) - lu(k,138) * lu(k,1778) + lu(k,139) = 1._r8 / lu(k,139) + lu(k,140) = lu(k,140) * lu(k,139) + lu(k,141) = lu(k,141) * lu(k,139) + lu(k,1744) = lu(k,1744) - lu(k,140) * lu(k,1715) + lu(k,1753) = lu(k,1753) - lu(k,141) * lu(k,1715) + 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,1917) = lu(k,1917) - lu(k,143) * lu(k,1779) + lu(k,1924) = lu(k,1924) - lu(k,144) * lu(k,1779) + lu(k,145) = 1._r8 / lu(k,145) + lu(k,146) = lu(k,146) * lu(k,145) + lu(k,147) = lu(k,147) * lu(k,145) + lu(k,1944) = lu(k,1944) - lu(k,146) * lu(k,1928) + lu(k,1951) = lu(k,1951) - lu(k,147) * lu(k,1928) + lu(k,148) = 1._r8 / lu(k,148) + lu(k,149) = lu(k,149) * lu(k,148) + lu(k,150) = lu(k,150) * lu(k,148) + lu(k,151) = lu(k,151) * lu(k,148) + lu(k,1867) = lu(k,1867) - lu(k,149) * lu(k,1780) + lu(k,1917) = lu(k,1917) - lu(k,150) * lu(k,1780) + lu(k,1927) = lu(k,1927) - lu(k,151) * lu(k,1780) + 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,1727) = lu(k,1727) - lu(k,153) * lu(k,1716) + lu(k,1744) = lu(k,1744) - lu(k,154) * lu(k,1716) + lu(k,1753) = lu(k,1753) - lu(k,155) * lu(k,1716) end do end subroutine lu_fac02 subroutine lu_fac03( avec_len, lu ) @@ -186,114 +166,105 @@ subroutine lu_fac03( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,129) = 1._r8 / lu(k,129) - lu(k,130) = lu(k,130) * lu(k,129) - lu(k,131) = lu(k,131) * lu(k,129) - lu(k,132) = lu(k,132) * lu(k,129) - lu(k,1615) = - lu(k,130) * lu(k,1575) - lu(k,1672) = lu(k,1672) - lu(k,131) * lu(k,1575) - lu(k,1696) = lu(k,1696) - lu(k,132) * lu(k,1575) - lu(k,133) = 1._r8 / lu(k,133) - lu(k,134) = lu(k,134) * lu(k,133) - lu(k,135) = lu(k,135) * lu(k,133) - lu(k,136) = lu(k,136) * lu(k,133) - lu(k,137) = lu(k,137) * lu(k,133) - lu(k,1614) = lu(k,1614) - lu(k,134) * lu(k,1576) - lu(k,1616) = lu(k,1616) - lu(k,135) * lu(k,1576) - lu(k,1696) = lu(k,1696) - lu(k,136) * lu(k,1576) - lu(k,1698) = lu(k,1698) - lu(k,137) * lu(k,1576) - lu(k,138) = 1._r8 / lu(k,138) - lu(k,139) = lu(k,139) * lu(k,138) - lu(k,734) = lu(k,734) - lu(k,139) * lu(k,728) - lu(k,879) = lu(k,879) - lu(k,139) * lu(k,869) - lu(k,1430) = lu(k,1430) - lu(k,139) * lu(k,1410) - lu(k,1988) = lu(k,1988) - lu(k,139) * lu(k,1965) - lu(k,2052) = lu(k,2052) - lu(k,139) * lu(k,2020) - lu(k,140) = 1._r8 / lu(k,140) - lu(k,141) = lu(k,141) * lu(k,140) - lu(k,142) = lu(k,142) * lu(k,140) - lu(k,143) = lu(k,143) * lu(k,140) - lu(k,1529) = lu(k,1529) - lu(k,141) * lu(k,1527) - lu(k,1538) = lu(k,1538) - lu(k,142) * lu(k,1527) - lu(k,1548) = lu(k,1548) - lu(k,143) * lu(k,1527) - lu(k,1649) = lu(k,1649) - lu(k,141) * lu(k,1577) - lu(k,1697) = lu(k,1697) - lu(k,142) * lu(k,1577) - lu(k,1707) = lu(k,1707) - lu(k,143) * lu(k,1577) - lu(k,144) = 1._r8 / lu(k,144) - lu(k,145) = lu(k,145) * lu(k,144) - lu(k,146) = lu(k,146) * lu(k,144) - lu(k,147) = lu(k,147) * lu(k,144) - lu(k,1537) = lu(k,1537) - lu(k,145) * lu(k,1528) - lu(k,1538) = lu(k,1538) - lu(k,146) * lu(k,1528) - lu(k,1539) = lu(k,1539) - lu(k,147) * lu(k,1528) - lu(k,1696) = lu(k,1696) - lu(k,145) * lu(k,1578) - lu(k,1697) = lu(k,1697) - lu(k,146) * lu(k,1578) - lu(k,1698) = lu(k,1698) - lu(k,147) * lu(k,1578) - lu(k,153) = 1._r8 / lu(k,153) - lu(k,154) = lu(k,154) * lu(k,153) - lu(k,155) = lu(k,155) * lu(k,153) - lu(k,156) = lu(k,156) * lu(k,153) - lu(k,157) = lu(k,157) * lu(k,153) - lu(k,158) = lu(k,158) * lu(k,153) - lu(k,159) = lu(k,159) * lu(k,153) - lu(k,1580) = lu(k,1580) - lu(k,154) * lu(k,1579) - lu(k,1581) = lu(k,1581) - lu(k,155) * lu(k,1579) - lu(k,1613) = lu(k,1613) - lu(k,156) * lu(k,1579) - lu(k,1645) = lu(k,1645) - lu(k,157) * lu(k,1579) - lu(k,1696) = lu(k,1696) - lu(k,158) * lu(k,1579) - lu(k,1698) = lu(k,1698) - lu(k,159) * lu(k,1579) + lu(k,156) = 1._r8 / lu(k,156) + lu(k,157) = lu(k,157) * lu(k,156) + lu(k,158) = lu(k,158) * lu(k,156) + lu(k,159) = lu(k,159) * lu(k,156) + lu(k,1729) = lu(k,1729) - lu(k,157) * lu(k,1717) + lu(k,1744) = lu(k,1744) - lu(k,158) * lu(k,1717) + lu(k,1753) = lu(k,1753) - lu(k,159) * lu(k,1717) 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,1614) = lu(k,1614) - lu(k,161) * lu(k,1580) - lu(k,1616) = lu(k,1616) - lu(k,162) * lu(k,1580) - lu(k,1696) = lu(k,1696) - lu(k,163) * lu(k,1580) - lu(k,1698) = lu(k,1698) - lu(k,164) * lu(k,1580) - lu(k,165) = 1._r8 / lu(k,165) - lu(k,166) = lu(k,166) * lu(k,165) - lu(k,167) = lu(k,167) * lu(k,165) - lu(k,168) = lu(k,168) * lu(k,165) - lu(k,182) = - lu(k,166) * lu(k,177) - lu(k,183) = - lu(k,167) * lu(k,177) - lu(k,184) = lu(k,184) - lu(k,168) * lu(k,177) - lu(k,1672) = lu(k,1672) - lu(k,166) * lu(k,1581) - lu(k,1690) = lu(k,1690) - lu(k,167) * lu(k,1581) - lu(k,1696) = lu(k,1696) - lu(k,168) * lu(k,1581) - lu(k,169) = 1._r8 / lu(k,169) - lu(k,170) = lu(k,170) * lu(k,169) - lu(k,171) = lu(k,171) * lu(k,169) - lu(k,1068) = lu(k,1068) - lu(k,170) * lu(k,1062) - lu(k,1074) = - lu(k,171) * lu(k,1062) - lu(k,1498) = lu(k,1498) - lu(k,170) * lu(k,1433) - lu(k,1515) = lu(k,1515) - lu(k,171) * lu(k,1433) - lu(k,1680) = lu(k,1680) - lu(k,170) * lu(k,1582) - lu(k,1698) = lu(k,1698) - lu(k,171) * lu(k,1582) + lu(k,1729) = lu(k,1729) - lu(k,161) * lu(k,1718) + lu(k,1744) = lu(k,1744) - lu(k,162) * lu(k,1718) + lu(k,1753) = lu(k,1753) - lu(k,163) * lu(k,1718) + lu(k,164) = 1._r8 / lu(k,164) + lu(k,165) = lu(k,165) * lu(k,164) + lu(k,166) = lu(k,166) * lu(k,164) + lu(k,167) = lu(k,167) * lu(k,164) + lu(k,1917) = lu(k,1917) - lu(k,165) * lu(k,1781) + lu(k,1925) = lu(k,1925) - lu(k,166) * lu(k,1781) + lu(k,1927) = lu(k,1927) - lu(k,167) * lu(k,1781) + 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,1729) = lu(k,1729) - lu(k,169) * lu(k,1719) + lu(k,1737) = lu(k,1737) - lu(k,170) * lu(k,1719) + lu(k,1744) = lu(k,1744) - lu(k,171) * lu(k,1719) + lu(k,172) = 1._r8 / lu(k,172) + lu(k,173) = lu(k,173) * lu(k,172) + lu(k,174) = lu(k,174) * lu(k,172) + lu(k,731) = lu(k,731) - lu(k,173) * lu(k,729) + lu(k,734) = lu(k,734) - lu(k,174) * lu(k,729) + lu(k,1897) = lu(k,1897) - lu(k,173) * lu(k,1782) + lu(k,1917) = lu(k,1917) - lu(k,174) * lu(k,1782) + lu(k,175) = 1._r8 / lu(k,175) + lu(k,176) = lu(k,176) * lu(k,175) + lu(k,177) = lu(k,177) * lu(k,175) + lu(k,554) = lu(k,554) - lu(k,176) * lu(k,553) + lu(k,557) = lu(k,557) - lu(k,177) * lu(k,553) + lu(k,1677) = lu(k,1677) - lu(k,176) * lu(k,1671) + lu(k,1702) = lu(k,1702) - lu(k,177) * lu(k,1671) lu(k,178) = 1._r8 / lu(k,178) lu(k,179) = lu(k,179) * lu(k,178) lu(k,180) = lu(k,180) * lu(k,178) lu(k,181) = lu(k,181) * lu(k,178) lu(k,182) = lu(k,182) * lu(k,178) - lu(k,183) = lu(k,183) * lu(k,178) - lu(k,184) = lu(k,184) * lu(k,178) - lu(k,185) = lu(k,185) * lu(k,178) - lu(k,1584) = lu(k,1584) - lu(k,179) * lu(k,1583) - lu(k,1613) = lu(k,1613) - lu(k,180) * lu(k,1583) - lu(k,1646) = lu(k,1646) - lu(k,181) * lu(k,1583) - lu(k,1672) = lu(k,1672) - lu(k,182) * lu(k,1583) - lu(k,1690) = lu(k,1690) - lu(k,183) * lu(k,1583) - lu(k,1696) = lu(k,1696) - lu(k,184) * lu(k,1583) - lu(k,1698) = lu(k,1698) - lu(k,185) * lu(k,1583) - lu(k,186) = 1._r8 / lu(k,186) - lu(k,187) = lu(k,187) * lu(k,186) - lu(k,188) = lu(k,188) * lu(k,186) - lu(k,189) = lu(k,189) * lu(k,186) - lu(k,190) = lu(k,190) * lu(k,186) - lu(k,1616) = lu(k,1616) - lu(k,187) * lu(k,1584) - lu(k,1620) = lu(k,1620) - lu(k,188) * lu(k,1584) - lu(k,1696) = lu(k,1696) - lu(k,189) * lu(k,1584) - lu(k,1698) = lu(k,1698) - lu(k,190) * lu(k,1584) + lu(k,1729) = lu(k,1729) - lu(k,179) * lu(k,1720) + lu(k,1737) = lu(k,1737) - lu(k,180) * lu(k,1720) + lu(k,1744) = lu(k,1744) - lu(k,181) * lu(k,1720) + lu(k,1753) = lu(k,1753) - lu(k,182) * lu(k,1720) + lu(k,183) = 1._r8 / lu(k,183) + lu(k,184) = lu(k,184) * lu(k,183) + lu(k,185) = lu(k,185) * lu(k,183) + lu(k,186) = lu(k,186) * lu(k,183) + lu(k,187) = lu(k,187) * lu(k,183) + lu(k,1729) = lu(k,1729) - lu(k,184) * lu(k,1721) + lu(k,1735) = lu(k,1735) - lu(k,185) * lu(k,1721) + lu(k,1737) = lu(k,1737) - lu(k,186) * lu(k,1721) + lu(k,1744) = lu(k,1744) - lu(k,187) * lu(k,1721) + 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,1727) = lu(k,1727) - lu(k,189) * lu(k,1722) + lu(k,1729) = lu(k,1729) - lu(k,190) * lu(k,1722) + lu(k,1744) = lu(k,1744) - lu(k,191) * lu(k,1722) + lu(k,1753) = lu(k,1753) - lu(k,192) * lu(k,1722) + lu(k,193) = 1._r8 / lu(k,193) + lu(k,194) = lu(k,194) * lu(k,193) + lu(k,195) = lu(k,195) * lu(k,193) + lu(k,196) = lu(k,196) * lu(k,193) + lu(k,197) = lu(k,197) * lu(k,193) + lu(k,1729) = lu(k,1729) - lu(k,194) * lu(k,1723) + lu(k,1735) = lu(k,1735) - lu(k,195) * lu(k,1723) + lu(k,1744) = lu(k,1744) - lu(k,196) * lu(k,1723) + lu(k,1753) = lu(k,1753) - lu(k,197) * lu(k,1723) + lu(k,198) = 1._r8 / lu(k,198) + lu(k,199) = lu(k,199) * lu(k,198) + lu(k,200) = lu(k,200) * lu(k,198) + lu(k,753) = lu(k,753) - lu(k,199) * lu(k,752) + lu(k,758) = - lu(k,200) * lu(k,752) + lu(k,2138) = - lu(k,199) * lu(k,2135) + lu(k,2220) = lu(k,2220) - lu(k,200) * lu(k,2135) + lu(k,201) = 1._r8 / lu(k,201) + lu(k,202) = lu(k,202) * lu(k,201) + lu(k,203) = lu(k,203) * lu(k,201) + lu(k,299) = lu(k,299) - lu(k,202) * lu(k,298) + lu(k,302) = lu(k,302) - lu(k,203) * lu(k,298) + lu(k,2332) = lu(k,2332) - lu(k,202) * lu(k,2331) + lu(k,2356) = lu(k,2356) - lu(k,203) * lu(k,2331) + lu(k,204) = 1._r8 / lu(k,204) + lu(k,205) = lu(k,205) * lu(k,204) + lu(k,847) = lu(k,847) - lu(k,205) * lu(k,841) + lu(k,932) = lu(k,932) - lu(k,205) * lu(k,922) + lu(k,1951) = lu(k,1951) - lu(k,205) * lu(k,1929) + lu(k,1973) = lu(k,1973) - lu(k,205) * lu(k,1954) + lu(k,2267) = lu(k,2267) - lu(k,205) * lu(k,2231) end do end subroutine lu_fac03 subroutine lu_fac04( avec_len, lu ) @@ -310,113 +281,108 @@ subroutine lu_fac04( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,191) = 1._r8 / lu(k,191) - lu(k,192) = lu(k,192) * lu(k,191) - lu(k,193) = lu(k,193) * lu(k,191) - lu(k,938) = lu(k,938) - lu(k,192) * lu(k,929) - lu(k,942) = lu(k,942) - lu(k,193) * lu(k,929) - lu(k,997) = - lu(k,192) * lu(k,987) - lu(k,1003) = lu(k,1003) - lu(k,193) * lu(k,987) - lu(k,1393) = - lu(k,192) * lu(k,1332) - lu(k,1401) = lu(k,1401) - lu(k,193) * lu(k,1332) - lu(k,1692) = lu(k,1692) - lu(k,192) * lu(k,1585) - lu(k,1700) = lu(k,1700) - lu(k,193) * lu(k,1585) - 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,806) = - lu(k,195) * lu(k,801) - lu(k,817) = lu(k,817) - lu(k,196) * lu(k,801) - lu(k,832) = - lu(k,195) * lu(k,827) - lu(k,843) = lu(k,843) - lu(k,196) * lu(k,827) - lu(k,1663) = lu(k,1663) - lu(k,195) * lu(k,1586) - lu(k,1698) = lu(k,1698) - lu(k,196) * lu(k,1586) - lu(k,1899) = - lu(k,195) * lu(k,1885) - lu(k,1929) = lu(k,1929) - lu(k,196) * lu(k,1885) - lu(k,197) = 1._r8 / lu(k,197) - lu(k,198) = lu(k,198) * lu(k,197) - lu(k,199) = lu(k,199) * lu(k,197) - lu(k,685) = lu(k,685) - lu(k,198) * lu(k,683) - lu(k,690) = - lu(k,199) * lu(k,683) - lu(k,1415) = - lu(k,198) * lu(k,1411) - lu(k,1430) = lu(k,1430) - lu(k,199) * lu(k,1411) - lu(k,1946) = lu(k,1946) - lu(k,198) * lu(k,1940) - lu(k,1962) = lu(k,1962) - lu(k,199) * lu(k,1940) - lu(k,1972) = lu(k,1972) - lu(k,198) * lu(k,1966) - lu(k,1988) = lu(k,1988) - lu(k,199) * lu(k,1966) - 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,273) = - lu(k,201) * lu(k,270) - lu(k,275) = lu(k,275) - lu(k,202) * lu(k,270) - lu(k,379) = - lu(k,201) * lu(k,376) - lu(k,382) = - lu(k,202) * lu(k,376) - lu(k,1347) = lu(k,1347) - lu(k,201) * lu(k,1333) - lu(k,1399) = lu(k,1399) - lu(k,202) * lu(k,1333) - lu(k,1624) = lu(k,1624) - lu(k,201) * lu(k,1587) - lu(k,1698) = lu(k,1698) - lu(k,202) * lu(k,1587) - lu(k,203) = 1._r8 / lu(k,203) - lu(k,204) = lu(k,204) * lu(k,203) - lu(k,205) = lu(k,205) * lu(k,203) - lu(k,206) = lu(k,206) * lu(k,203) - lu(k,207) = lu(k,207) * lu(k,203) - lu(k,1213) = - lu(k,204) * lu(k,1210) - lu(k,1225) = - lu(k,205) * lu(k,1210) - lu(k,1236) = lu(k,1236) - lu(k,206) * lu(k,1210) - lu(k,1237) = - lu(k,207) * lu(k,1210) - lu(k,1635) = - lu(k,204) * lu(k,1588) - lu(k,1680) = lu(k,1680) - lu(k,205) * lu(k,1588) - lu(k,1696) = lu(k,1696) - lu(k,206) * lu(k,1588) - lu(k,1698) = lu(k,1698) - lu(k,207) * lu(k,1588) - lu(k,208) = 1._r8 / lu(k,208) - lu(k,209) = lu(k,209) * lu(k,208) - lu(k,210) = lu(k,210) * lu(k,208) - lu(k,693) = lu(k,693) - lu(k,209) * lu(k,692) - lu(k,696) = lu(k,696) - lu(k,210) * lu(k,692) - lu(k,1050) = lu(k,1050) - lu(k,209) * lu(k,1049) - lu(k,1053) = lu(k,1053) - lu(k,210) * lu(k,1049) - lu(k,1305) = lu(k,1305) - lu(k,209) * lu(k,1304) - lu(k,1308) = - lu(k,210) * lu(k,1304) - lu(k,2057) = lu(k,2057) - lu(k,209) * lu(k,2055) - lu(k,2063) = lu(k,2063) - lu(k,210) * lu(k,2055) - lu(k,212) = 1._r8 / lu(k,212) - lu(k,213) = lu(k,213) * lu(k,212) - lu(k,214) = lu(k,214) * lu(k,212) - lu(k,215) = lu(k,215) * lu(k,212) - lu(k,754) = lu(k,754) - lu(k,213) * lu(k,753) - lu(k,758) = lu(k,758) - lu(k,214) * lu(k,753) - lu(k,759) = - lu(k,215) * lu(k,753) - lu(k,1657) = lu(k,1657) - lu(k,213) * lu(k,1589) - lu(k,1706) = lu(k,1706) - lu(k,214) * lu(k,1589) - lu(k,1708) = lu(k,1708) - lu(k,215) * lu(k,1589) - lu(k,2058) = - lu(k,213) * lu(k,2056) - lu(k,2076) = lu(k,2076) - lu(k,214) * lu(k,2056) - lu(k,2078) = lu(k,2078) - lu(k,215) * lu(k,2056) - lu(k,216) = 1._r8 / lu(k,216) - lu(k,217) = lu(k,217) * lu(k,216) - lu(k,218) = lu(k,218) * lu(k,216) - lu(k,219) = lu(k,219) * lu(k,216) - lu(k,740) = lu(k,740) - lu(k,217) * lu(k,736) - lu(k,742) = lu(k,742) - lu(k,218) * lu(k,736) - lu(k,743) = - lu(k,219) * lu(k,736) - lu(k,1678) = lu(k,1678) - lu(k,217) * lu(k,1590) - lu(k,1696) = lu(k,1696) - lu(k,218) * lu(k,1590) - lu(k,1698) = lu(k,1698) - lu(k,219) * lu(k,1590) - lu(k,1852) = lu(k,1852) - lu(k,217) * lu(k,1830) - lu(k,1867) = lu(k,1867) - lu(k,218) * lu(k,1830) - lu(k,1869) = - lu(k,219) * lu(k,1830) - 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,558) = lu(k,558) - lu(k,221) * lu(k,557) - lu(k,559) = lu(k,559) - lu(k,222) * lu(k,557) - lu(k,562) = - lu(k,223) * lu(k,557) - lu(k,1453) = - lu(k,221) * lu(k,1434) - lu(k,1465) = lu(k,1465) - lu(k,222) * lu(k,1434) - lu(k,1515) = lu(k,1515) - lu(k,223) * lu(k,1434) - lu(k,1616) = lu(k,1616) - lu(k,221) * lu(k,1591) - lu(k,1637) = lu(k,1637) - lu(k,222) * lu(k,1591) - lu(k,1698) = lu(k,1698) - lu(k,223) * lu(k,1591) + lu(k,207) = 1._r8 / lu(k,207) + lu(k,208) = lu(k,208) * lu(k,207) + lu(k,209) = lu(k,209) * lu(k,207) + lu(k,210) = lu(k,210) * lu(k,207) + lu(k,211) = lu(k,211) * lu(k,207) + lu(k,212) = lu(k,212) * lu(k,207) + lu(k,1784) = lu(k,1784) - lu(k,208) * lu(k,1783) + lu(k,1785) = lu(k,1785) - lu(k,209) * lu(k,1783) + lu(k,1834) = lu(k,1834) - lu(k,210) * lu(k,1783) + lu(k,1917) = lu(k,1917) - lu(k,211) * lu(k,1783) + lu(k,1924) = lu(k,1924) - lu(k,212) * lu(k,1783) + 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,1829) = - lu(k,214) * lu(k,1784) + lu(k,1891) = lu(k,1891) - lu(k,215) * lu(k,1784) + lu(k,1924) = lu(k,1924) - lu(k,216) * lu(k,1784) + lu(k,217) = 1._r8 / lu(k,217) + lu(k,218) = lu(k,218) * lu(k,217) + lu(k,219) = lu(k,219) * lu(k,217) + lu(k,220) = lu(k,220) * lu(k,217) + lu(k,221) = lu(k,221) * lu(k,217) + lu(k,1828) = lu(k,1828) - lu(k,218) * lu(k,1785) + lu(k,1831) = lu(k,1831) - lu(k,219) * lu(k,1785) + lu(k,1917) = lu(k,1917) - lu(k,220) * lu(k,1785) + lu(k,1924) = lu(k,1924) - lu(k,221) * lu(k,1785) + lu(k,222) = 1._r8 / lu(k,222) + lu(k,223) = lu(k,223) * lu(k,222) + lu(k,224) = lu(k,224) * lu(k,222) + lu(k,508) = lu(k,508) - lu(k,223) * lu(k,505) + lu(k,510) = - lu(k,224) * lu(k,505) + lu(k,1700) = lu(k,1700) - lu(k,223) * lu(k,1672) + lu(k,1703) = - lu(k,224) * lu(k,1672) + lu(k,1741) = lu(k,1741) - lu(k,223) * lu(k,1724) + lu(k,1744) = lu(k,1744) - lu(k,224) * lu(k,1724) + lu(k,225) = 1._r8 / lu(k,225) + lu(k,226) = lu(k,226) * lu(k,225) + lu(k,227) = lu(k,227) * lu(k,225) + lu(k,228) = lu(k,228) * lu(k,225) + lu(k,1744) = lu(k,1744) - lu(k,226) * lu(k,1725) + lu(k,1745) = lu(k,1745) - lu(k,227) * lu(k,1725) + lu(k,1752) = lu(k,1752) - lu(k,228) * lu(k,1725) + lu(k,1916) = - lu(k,226) * lu(k,1786) + lu(k,1917) = lu(k,1917) - lu(k,227) * lu(k,1786) + lu(k,1924) = lu(k,1924) - lu(k,228) * lu(k,1786) + lu(k,230) = 1._r8 / lu(k,230) + lu(k,231) = lu(k,231) * lu(k,230) + lu(k,232) = lu(k,232) * lu(k,230) + lu(k,233) = lu(k,233) * lu(k,230) + lu(k,234) = lu(k,234) * lu(k,230) + lu(k,235) = lu(k,235) * lu(k,230) + lu(k,236) = lu(k,236) * lu(k,230) + lu(k,1788) = lu(k,1788) - lu(k,231) * lu(k,1787) + lu(k,1789) = lu(k,1789) - lu(k,232) * lu(k,1787) + lu(k,1827) = lu(k,1827) - lu(k,233) * lu(k,1787) + lu(k,1862) = lu(k,1862) - lu(k,234) * lu(k,1787) + lu(k,1917) = lu(k,1917) - lu(k,235) * lu(k,1787) + lu(k,1924) = lu(k,1924) - lu(k,236) * lu(k,1787) + lu(k,237) = 1._r8 / lu(k,237) + lu(k,238) = lu(k,238) * lu(k,237) + lu(k,239) = lu(k,239) * lu(k,237) + lu(k,240) = lu(k,240) * lu(k,237) + lu(k,241) = lu(k,241) * lu(k,237) + lu(k,1828) = lu(k,1828) - lu(k,238) * lu(k,1788) + lu(k,1831) = lu(k,1831) - lu(k,239) * lu(k,1788) + lu(k,1917) = lu(k,1917) - lu(k,240) * lu(k,1788) + lu(k,1924) = lu(k,1924) - lu(k,241) * lu(k,1788) + lu(k,242) = 1._r8 / lu(k,242) + lu(k,243) = lu(k,243) * lu(k,242) + lu(k,244) = lu(k,244) * lu(k,242) + lu(k,245) = lu(k,245) * lu(k,242) + lu(k,255) = - lu(k,243) * lu(k,250) + lu(k,256) = - lu(k,244) * lu(k,250) + lu(k,258) = lu(k,258) - lu(k,245) * lu(k,250) + lu(k,1891) = lu(k,1891) - lu(k,243) * lu(k,1789) + lu(k,1907) = lu(k,1907) - lu(k,244) * lu(k,1789) + lu(k,1924) = lu(k,1924) - lu(k,245) * lu(k,1789) + lu(k,246) = 1._r8 / lu(k,246) + lu(k,247) = lu(k,247) * lu(k,246) + lu(k,248) = lu(k,248) * lu(k,246) + lu(k,1213) = lu(k,1213) - lu(k,247) * lu(k,1206) + lu(k,1219) = - lu(k,248) * lu(k,1206) + lu(k,1897) = lu(k,1897) - lu(k,247) * lu(k,1790) + lu(k,1917) = lu(k,1917) - lu(k,248) * lu(k,1790) + lu(k,2201) = lu(k,2201) - lu(k,247) * lu(k,2136) + lu(k,2220) = lu(k,2220) - lu(k,248) * lu(k,2136) + lu(k,251) = 1._r8 / lu(k,251) + lu(k,252) = lu(k,252) * lu(k,251) + lu(k,253) = lu(k,253) * lu(k,251) + lu(k,254) = lu(k,254) * lu(k,251) + lu(k,255) = lu(k,255) * lu(k,251) + lu(k,256) = lu(k,256) * lu(k,251) + lu(k,257) = lu(k,257) * lu(k,251) + lu(k,258) = lu(k,258) * lu(k,251) + lu(k,1792) = lu(k,1792) - lu(k,252) * lu(k,1791) + lu(k,1827) = lu(k,1827) - lu(k,253) * lu(k,1791) + lu(k,1863) = lu(k,1863) - lu(k,254) * lu(k,1791) + lu(k,1891) = lu(k,1891) - lu(k,255) * lu(k,1791) + lu(k,1907) = lu(k,1907) - lu(k,256) * lu(k,1791) + lu(k,1917) = lu(k,1917) - lu(k,257) * lu(k,1791) + lu(k,1924) = lu(k,1924) - lu(k,258) * lu(k,1791) end do end subroutine lu_fac04 subroutine lu_fac05( avec_len, lu ) @@ -433,130 +399,117 @@ subroutine lu_fac05( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,224) = 1._r8 / lu(k,224) - lu(k,225) = lu(k,225) * lu(k,224) - lu(k,226) = lu(k,226) * lu(k,224) - lu(k,227) = lu(k,227) * lu(k,224) - lu(k,621) = - lu(k,225) * lu(k,619) - lu(k,623) = lu(k,623) - lu(k,226) * lu(k,619) - lu(k,625) = lu(k,625) - lu(k,227) * lu(k,619) - lu(k,1372) = lu(k,1372) - lu(k,225) * lu(k,1334) - lu(k,1397) = lu(k,1397) - lu(k,226) * lu(k,1334) - lu(k,1400) = lu(k,1400) - lu(k,227) * lu(k,1334) - lu(k,1488) = - lu(k,225) * lu(k,1435) - lu(k,1513) = lu(k,1513) - lu(k,226) * lu(k,1435) - lu(k,1516) = lu(k,1516) - lu(k,227) * lu(k,1435) - lu(k,228) = 1._r8 / lu(k,228) - lu(k,229) = lu(k,229) * lu(k,228) - lu(k,230) = lu(k,230) * lu(k,228) - lu(k,542) = - lu(k,229) * lu(k,536) - lu(k,545) = lu(k,545) - lu(k,230) * lu(k,536) - lu(k,610) = - lu(k,229) * lu(k,603) - lu(k,616) = lu(k,616) - lu(k,230) * lu(k,603) - lu(k,639) = - lu(k,229) * lu(k,633) - lu(k,645) = lu(k,645) - lu(k,230) * lu(k,633) - lu(k,655) = - lu(k,229) * lu(k,648) - lu(k,662) = lu(k,662) - lu(k,230) * lu(k,648) - lu(k,1360) = lu(k,1360) - lu(k,229) * lu(k,1335) - lu(k,1397) = lu(k,1397) - lu(k,230) * lu(k,1335) - lu(k,231) = 1._r8 / lu(k,231) - lu(k,232) = lu(k,232) * lu(k,231) - lu(k,233) = lu(k,233) * lu(k,231) - lu(k,234) = lu(k,234) * lu(k,231) - lu(k,235) = lu(k,235) * lu(k,231) - lu(k,236) = lu(k,236) * lu(k,231) - lu(k,1756) = lu(k,1756) - lu(k,232) * lu(k,1733) - lu(k,1758) = lu(k,1758) - lu(k,233) * lu(k,1733) - lu(k,1764) = lu(k,1764) - lu(k,234) * lu(k,1733) - lu(k,1765) = lu(k,1765) - lu(k,235) * lu(k,1733) - lu(k,1770) = lu(k,1770) - lu(k,236) * lu(k,1733) - lu(k,1813) = lu(k,1813) - lu(k,232) * lu(k,1775) - lu(k,1815) = lu(k,1815) - lu(k,233) * lu(k,1775) - lu(k,1821) = lu(k,1821) - lu(k,234) * lu(k,1775) - lu(k,1822) = lu(k,1822) - lu(k,235) * lu(k,1775) - lu(k,1827) = lu(k,1827) - lu(k,236) * lu(k,1775) - lu(k,237) = 1._r8 / lu(k,237) - lu(k,238) = lu(k,238) * lu(k,237) - lu(k,239) = lu(k,239) * lu(k,237) - lu(k,240) = lu(k,240) * lu(k,237) - lu(k,241) = lu(k,241) * lu(k,237) - lu(k,242) = lu(k,242) * lu(k,237) - lu(k,1651) = lu(k,1651) - lu(k,238) * lu(k,1592) - lu(k,1660) = lu(k,1660) - lu(k,239) * lu(k,1592) - lu(k,1672) = lu(k,1672) - lu(k,240) * lu(k,1592) - lu(k,1696) = lu(k,1696) - lu(k,241) * lu(k,1592) - lu(k,1698) = lu(k,1698) - lu(k,242) * lu(k,1592) - lu(k,2026) = - lu(k,238) * lu(k,2021) - lu(k,2029) = - lu(k,239) * lu(k,2021) - lu(k,2032) = lu(k,2032) - lu(k,240) * lu(k,2021) - lu(k,2041) = lu(k,2041) - lu(k,241) * lu(k,2021) - lu(k,2043) = lu(k,2043) - lu(k,242) * lu(k,2021) - lu(k,243) = 1._r8 / lu(k,243) - lu(k,244) = lu(k,244) * lu(k,243) - lu(k,245) = lu(k,245) * lu(k,243) - lu(k,246) = lu(k,246) * lu(k,243) - lu(k,247) = lu(k,247) * lu(k,243) - lu(k,248) = lu(k,248) * lu(k,243) - lu(k,1655) = lu(k,1655) - lu(k,244) * lu(k,1593) - lu(k,1695) = lu(k,1695) - lu(k,245) * lu(k,1593) - lu(k,1698) = lu(k,1698) - lu(k,246) * lu(k,1593) - lu(k,1707) = lu(k,1707) - lu(k,247) * lu(k,1593) - lu(k,1708) = lu(k,1708) - lu(k,248) * lu(k,1593) - lu(k,2028) = lu(k,2028) - lu(k,244) * lu(k,2022) - lu(k,2040) = lu(k,2040) - lu(k,245) * lu(k,2022) - lu(k,2043) = lu(k,2043) - lu(k,246) * lu(k,2022) - lu(k,2052) = lu(k,2052) - lu(k,247) * lu(k,2022) - lu(k,2053) = - lu(k,248) * lu(k,2022) - lu(k,249) = 1._r8 / lu(k,249) - lu(k,250) = lu(k,250) * lu(k,249) - lu(k,251) = lu(k,251) * lu(k,249) - lu(k,252) = lu(k,252) * lu(k,249) - lu(k,253) = lu(k,253) * lu(k,249) - lu(k,254) = lu(k,254) * lu(k,249) - lu(k,1657) = lu(k,1657) - lu(k,250) * lu(k,1594) - lu(k,1692) = lu(k,1692) - lu(k,251) * lu(k,1594) - lu(k,1696) = lu(k,1696) - lu(k,252) * lu(k,1594) - lu(k,1698) = lu(k,1698) - lu(k,253) * lu(k,1594) - lu(k,1701) = lu(k,1701) - lu(k,254) * lu(k,1594) - lu(k,1781) = lu(k,1781) - lu(k,250) * lu(k,1776) - lu(k,1813) = lu(k,1813) - lu(k,251) * lu(k,1776) - lu(k,1817) = lu(k,1817) - lu(k,252) * lu(k,1776) - lu(k,1819) = lu(k,1819) - lu(k,253) * lu(k,1776) - lu(k,1822) = lu(k,1822) - lu(k,254) * lu(k,1776) - lu(k,255) = 1._r8 / lu(k,255) - lu(k,256) = lu(k,256) * lu(k,255) - lu(k,257) = lu(k,257) * lu(k,255) - lu(k,258) = lu(k,258) * lu(k,255) - lu(k,259) = lu(k,259) * lu(k,255) - lu(k,613) = - lu(k,256) * lu(k,604) - lu(k,614) = lu(k,614) - lu(k,257) * lu(k,604) - lu(k,615) = - lu(k,258) * lu(k,604) - lu(k,616) = lu(k,616) - lu(k,259) * lu(k,604) - lu(k,658) = - lu(k,256) * lu(k,649) - lu(k,659) = lu(k,659) - lu(k,257) * lu(k,649) - lu(k,660) = - lu(k,258) * lu(k,649) - lu(k,662) = lu(k,662) - lu(k,259) * lu(k,649) - lu(k,1375) = lu(k,1375) - lu(k,256) * lu(k,1336) - lu(k,1385) = lu(k,1385) - lu(k,257) * lu(k,1336) - lu(k,1391) = lu(k,1391) - lu(k,258) * lu(k,1336) - lu(k,1397) = lu(k,1397) - lu(k,259) * lu(k,1336) - 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,1126) = lu(k,1126) - lu(k,261) * lu(k,1124) - lu(k,1127) = lu(k,1127) - lu(k,262) * lu(k,1124) - lu(k,1136) = lu(k,1136) - lu(k,263) * lu(k,1124) - lu(k,1137) = lu(k,1137) - lu(k,264) * lu(k,1124) - lu(k,1944) = lu(k,1944) - lu(k,261) * lu(k,1941) - lu(k,1945) = lu(k,1945) - lu(k,262) * lu(k,1941) - lu(k,1960) = lu(k,1960) - lu(k,263) * lu(k,1941) - lu(k,1961) = lu(k,1961) - lu(k,264) * lu(k,1941) - lu(k,1969) = lu(k,1969) - lu(k,261) * lu(k,1967) - lu(k,1971) = lu(k,1971) - lu(k,262) * lu(k,1967) - lu(k,1986) = lu(k,1986) - lu(k,263) * lu(k,1967) - lu(k,1987) = lu(k,1987) - lu(k,264) * lu(k,1967) + lu(k,259) = 1._r8 / lu(k,259) + lu(k,260) = lu(k,260) * lu(k,259) + lu(k,261) = lu(k,261) * lu(k,259) + lu(k,262) = lu(k,262) * lu(k,259) + lu(k,263) = lu(k,263) * lu(k,259) + lu(k,1831) = lu(k,1831) - lu(k,260) * lu(k,1792) + lu(k,1835) = lu(k,1835) - lu(k,261) * lu(k,1792) + lu(k,1917) = lu(k,1917) - lu(k,262) * lu(k,1792) + lu(k,1924) = lu(k,1924) - lu(k,263) * lu(k,1792) + lu(k,264) = 1._r8 / lu(k,264) + lu(k,265) = lu(k,265) * lu(k,264) + lu(k,266) = lu(k,266) * lu(k,264) + lu(k,267) = lu(k,267) * lu(k,264) + lu(k,268) = lu(k,268) * lu(k,264) + lu(k,1727) = lu(k,1727) - lu(k,265) * lu(k,1726) + lu(k,1744) = lu(k,1744) - lu(k,266) * lu(k,1726) + lu(k,1745) = lu(k,1745) - lu(k,267) * lu(k,1726) + lu(k,1753) = lu(k,1753) - lu(k,268) * lu(k,1726) + lu(k,1794) = lu(k,1794) - lu(k,265) * lu(k,1793) + lu(k,1916) = lu(k,1916) - lu(k,266) * lu(k,1793) + lu(k,1917) = lu(k,1917) - lu(k,267) * lu(k,1793) + lu(k,1925) = lu(k,1925) - lu(k,268) * lu(k,1793) + lu(k,269) = 1._r8 / lu(k,269) + lu(k,270) = lu(k,270) * lu(k,269) + lu(k,271) = lu(k,271) * lu(k,269) + lu(k,272) = lu(k,272) * lu(k,269) + lu(k,1735) = lu(k,1735) - lu(k,270) * lu(k,1727) + lu(k,1744) = lu(k,1744) - lu(k,271) * lu(k,1727) + lu(k,1753) = lu(k,1753) - lu(k,272) * lu(k,1727) + lu(k,1876) = - lu(k,270) * lu(k,1794) + lu(k,1916) = lu(k,1916) - lu(k,271) * lu(k,1794) + lu(k,1925) = lu(k,1925) - lu(k,272) * lu(k,1794) + lu(k,273) = 1._r8 / lu(k,273) + lu(k,274) = lu(k,274) * lu(k,273) + lu(k,275) = lu(k,275) * lu(k,273) + lu(k,984) = - lu(k,274) * lu(k,981) + lu(k,1002) = lu(k,1002) - lu(k,275) * lu(k,981) + lu(k,1033) = - lu(k,274) * lu(k,1030) + lu(k,1052) = lu(k,1052) - lu(k,275) * lu(k,1030) + lu(k,1878) = lu(k,1878) - lu(k,274) * lu(k,1795) + lu(k,1917) = lu(k,1917) - lu(k,275) * lu(k,1795) + lu(k,2286) = - lu(k,274) * lu(k,2275) + lu(k,2320) = lu(k,2320) - lu(k,275) * lu(k,2275) + 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,1158) = - lu(k,277) * lu(k,1147) + lu(k,1161) = lu(k,1161) - lu(k,278) * lu(k,1147) + lu(k,1196) = lu(k,1196) - lu(k,277) * lu(k,1186) + lu(k,1199) = lu(k,1199) - lu(k,278) * lu(k,1186) + lu(k,1602) = - lu(k,277) * lu(k,1539) + lu(k,1606) = lu(k,1606) - lu(k,278) * lu(k,1539) + lu(k,1911) = lu(k,1911) - lu(k,277) * lu(k,1796) + lu(k,1915) = lu(k,1915) - lu(k,278) * lu(k,1796) + lu(k,279) = 1._r8 / lu(k,279) + lu(k,280) = lu(k,280) * lu(k,279) + lu(k,281) = lu(k,281) * lu(k,279) + lu(k,819) = lu(k,819) - lu(k,280) * lu(k,817) + lu(k,824) = - lu(k,281) * lu(k,817) + lu(k,1936) = lu(k,1936) - lu(k,280) * lu(k,1930) + lu(k,1951) = lu(k,1951) - lu(k,281) * lu(k,1930) + lu(k,1959) = - lu(k,280) * lu(k,1955) + lu(k,1973) = lu(k,1973) - lu(k,281) * lu(k,1955) + lu(k,2094) = lu(k,2094) - lu(k,280) * lu(k,2088) + lu(k,2109) = lu(k,2109) - lu(k,281) * lu(k,2088) + lu(k,282) = 1._r8 / lu(k,282) + lu(k,283) = lu(k,283) * lu(k,282) + lu(k,284) = lu(k,284) * lu(k,282) + lu(k,375) = - lu(k,283) * lu(k,372) + lu(k,376) = lu(k,376) - lu(k,284) * lu(k,372) + lu(k,478) = - lu(k,283) * lu(k,475) + lu(k,481) = - lu(k,284) * lu(k,475) + lu(k,1554) = lu(k,1554) - lu(k,283) * lu(k,1540) + lu(k,1608) = lu(k,1608) - lu(k,284) * lu(k,1540) + lu(k,1837) = lu(k,1837) - lu(k,283) * lu(k,1797) + lu(k,1917) = lu(k,1917) - lu(k,284) * lu(k,1797) + lu(k,285) = 1._r8 / lu(k,285) + lu(k,286) = lu(k,286) * lu(k,285) + lu(k,287) = lu(k,287) * lu(k,285) + lu(k,288) = lu(k,288) * lu(k,285) + lu(k,289) = lu(k,289) * lu(k,285) + lu(k,1729) = lu(k,1729) - lu(k,286) * lu(k,1728) + lu(k,1744) = lu(k,1744) - lu(k,287) * lu(k,1728) + lu(k,1745) = lu(k,1745) - lu(k,288) * lu(k,1728) + lu(k,1753) = lu(k,1753) - lu(k,289) * lu(k,1728) + lu(k,1799) = lu(k,1799) - lu(k,286) * lu(k,1798) + lu(k,1916) = lu(k,1916) - lu(k,287) * lu(k,1798) + lu(k,1917) = lu(k,1917) - lu(k,288) * lu(k,1798) + lu(k,1925) = lu(k,1925) - lu(k,289) * lu(k,1798) + lu(k,290) = 1._r8 / lu(k,290) + lu(k,291) = lu(k,291) * lu(k,290) + lu(k,292) = lu(k,292) * lu(k,290) + lu(k,341) = - lu(k,291) * lu(k,339) + lu(k,342) = lu(k,342) - lu(k,292) * lu(k,339) + lu(k,1735) = lu(k,1735) - lu(k,291) * lu(k,1729) + lu(k,1744) = lu(k,1744) - lu(k,292) * lu(k,1729) + lu(k,1876) = lu(k,1876) - lu(k,291) * lu(k,1799) + lu(k,1916) = lu(k,1916) - lu(k,292) * lu(k,1799) + lu(k,293) = 1._r8 / lu(k,293) + lu(k,294) = lu(k,294) * lu(k,293) + lu(k,295) = lu(k,295) * lu(k,293) + lu(k,296) = lu(k,296) * lu(k,293) + lu(k,297) = lu(k,297) * lu(k,293) + lu(k,1315) = - lu(k,294) * lu(k,1312) + lu(k,1325) = - lu(k,295) * lu(k,1312) + lu(k,1337) = - lu(k,296) * lu(k,1312) + lu(k,1341) = lu(k,1341) - lu(k,297) * lu(k,1312) + lu(k,1850) = - lu(k,294) * lu(k,1800) + lu(k,1897) = lu(k,1897) - lu(k,295) * lu(k,1800) + lu(k,1917) = lu(k,1917) - lu(k,296) * lu(k,1800) + lu(k,1924) = lu(k,1924) - lu(k,297) * lu(k,1800) end do end subroutine lu_fac05 subroutine lu_fac06( avec_len, lu ) @@ -573,171 +526,119 @@ subroutine lu_fac06( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,265) = 1._r8 / lu(k,265) - lu(k,266) = lu(k,266) * lu(k,265) - lu(k,267) = lu(k,267) * lu(k,265) - lu(k,268) = lu(k,268) * lu(k,265) - lu(k,269) = lu(k,269) * lu(k,265) - lu(k,391) = lu(k,391) - lu(k,266) * lu(k,390) - lu(k,392) = lu(k,392) - lu(k,267) * lu(k,390) - lu(k,394) = lu(k,394) - lu(k,268) * lu(k,390) - lu(k,395) = - lu(k,269) * lu(k,390) - lu(k,1451) = lu(k,1451) - lu(k,266) * lu(k,1436) - lu(k,1484) = lu(k,1484) - lu(k,267) * lu(k,1436) - lu(k,1513) = lu(k,1513) - lu(k,268) * lu(k,1436) - lu(k,1515) = lu(k,1515) - lu(k,269) * lu(k,1436) - lu(k,1614) = lu(k,1614) - lu(k,266) * lu(k,1595) - lu(k,1660) = lu(k,1660) - lu(k,267) * lu(k,1595) - lu(k,1696) = lu(k,1696) - lu(k,268) * lu(k,1595) - lu(k,1698) = lu(k,1698) - lu(k,269) * lu(k,1595) - lu(k,271) = 1._r8 / lu(k,271) - lu(k,272) = lu(k,272) * lu(k,271) - lu(k,273) = lu(k,273) * lu(k,271) - lu(k,274) = lu(k,274) * lu(k,271) - lu(k,275) = lu(k,275) * lu(k,271) - lu(k,378) = lu(k,378) - lu(k,272) * lu(k,377) - lu(k,379) = lu(k,379) - lu(k,273) * lu(k,377) - lu(k,381) = lu(k,381) - lu(k,274) * lu(k,377) - lu(k,382) = lu(k,382) - lu(k,275) * lu(k,377) - lu(k,1449) = lu(k,1449) - lu(k,272) * lu(k,1437) - lu(k,1458) = lu(k,1458) - lu(k,273) * lu(k,1437) - lu(k,1513) = lu(k,1513) - lu(k,274) * lu(k,1437) - lu(k,1515) = lu(k,1515) - lu(k,275) * lu(k,1437) - lu(k,1613) = lu(k,1613) - lu(k,272) * lu(k,1596) - lu(k,1624) = lu(k,1624) - lu(k,273) * lu(k,1596) - lu(k,1696) = lu(k,1696) - lu(k,274) * lu(k,1596) - lu(k,1698) = lu(k,1698) - lu(k,275) * lu(k,1596) - 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,739) = lu(k,739) - lu(k,277) * lu(k,737) - lu(k,740) = lu(k,740) - lu(k,278) * lu(k,737) - lu(k,742) = lu(k,742) - lu(k,279) * lu(k,737) - lu(k,743) = lu(k,743) - lu(k,280) * lu(k,737) - lu(k,1481) = lu(k,1481) - lu(k,277) * lu(k,1438) - lu(k,1496) = lu(k,1496) - lu(k,278) * lu(k,1438) - lu(k,1513) = lu(k,1513) - lu(k,279) * lu(k,1438) - lu(k,1515) = lu(k,1515) - lu(k,280) * lu(k,1438) - lu(k,1655) = lu(k,1655) - lu(k,277) * lu(k,1597) - lu(k,1678) = lu(k,1678) - lu(k,278) * lu(k,1597) - lu(k,1696) = lu(k,1696) - lu(k,279) * lu(k,1597) - lu(k,1698) = lu(k,1698) - lu(k,280) * lu(k,1597) - lu(k,281) = 1._r8 / lu(k,281) - lu(k,282) = lu(k,282) * lu(k,281) - lu(k,283) = lu(k,283) * lu(k,281) - lu(k,1225) = lu(k,1225) - lu(k,282) * lu(k,1211) - lu(k,1237) = lu(k,1237) - lu(k,283) * lu(k,1211) - lu(k,1271) = lu(k,1271) - lu(k,282) * lu(k,1262) - lu(k,1285) = lu(k,1285) - lu(k,283) * lu(k,1262) - lu(k,1382) = lu(k,1382) - lu(k,282) * lu(k,1337) - lu(k,1399) = lu(k,1399) - lu(k,283) * lu(k,1337) - lu(k,1680) = lu(k,1680) - lu(k,282) * lu(k,1598) - lu(k,1698) = lu(k,1698) - lu(k,283) * lu(k,1598) - lu(k,1801) = lu(k,1801) - lu(k,282) * lu(k,1777) - lu(k,1819) = lu(k,1819) - lu(k,283) * lu(k,1777) - lu(k,1853) = lu(k,1853) - lu(k,282) * lu(k,1831) - lu(k,1869) = lu(k,1869) - lu(k,283) * lu(k,1831) - lu(k,284) = 1._r8 / lu(k,284) - lu(k,285) = lu(k,285) * lu(k,284) - lu(k,286) = lu(k,286) * lu(k,284) - lu(k,287) = lu(k,287) * lu(k,284) - lu(k,288) = lu(k,288) * lu(k,284) - lu(k,588) = lu(k,588) - lu(k,285) * lu(k,587) - lu(k,589) = lu(k,589) - lu(k,286) * lu(k,587) - lu(k,590) = lu(k,590) - lu(k,287) * lu(k,587) - lu(k,593) = lu(k,593) - lu(k,288) * lu(k,587) - lu(k,1467) = lu(k,1467) - lu(k,285) * lu(k,1439) - lu(k,1496) = lu(k,1496) - lu(k,286) * lu(k,1439) - lu(k,1507) = lu(k,1507) - lu(k,287) * lu(k,1439) - lu(k,1515) = lu(k,1515) - lu(k,288) * lu(k,1439) - lu(k,1640) = lu(k,1640) - lu(k,285) * lu(k,1599) - lu(k,1678) = lu(k,1678) - lu(k,286) * lu(k,1599) - lu(k,1690) = lu(k,1690) - lu(k,287) * lu(k,1599) - lu(k,1698) = lu(k,1698) - lu(k,288) * lu(k,1599) - lu(k,289) = 1._r8 / lu(k,289) - lu(k,290) = lu(k,290) * lu(k,289) - lu(k,291) = lu(k,291) * lu(k,289) - lu(k,292) = lu(k,292) * lu(k,289) - lu(k,293) = lu(k,293) * lu(k,289) - lu(k,1197) = lu(k,1197) - lu(k,290) * lu(k,1188) - lu(k,1198) = - lu(k,291) * lu(k,1188) - lu(k,1203) = lu(k,1203) - lu(k,292) * lu(k,1188) - lu(k,1204) = - lu(k,293) * lu(k,1188) - lu(k,1504) = lu(k,1504) - lu(k,290) * lu(k,1440) - lu(k,1506) = lu(k,1506) - lu(k,291) * lu(k,1440) - lu(k,1513) = lu(k,1513) - lu(k,292) * lu(k,1440) - lu(k,1515) = lu(k,1515) - lu(k,293) * lu(k,1440) - lu(k,1687) = lu(k,1687) - lu(k,290) * lu(k,1600) - lu(k,1689) = lu(k,1689) - lu(k,291) * lu(k,1600) - lu(k,1696) = lu(k,1696) - lu(k,292) * lu(k,1600) - lu(k,1698) = lu(k,1698) - lu(k,293) * lu(k,1600) - lu(k,294) = 1._r8 / lu(k,294) - lu(k,295) = lu(k,295) * lu(k,294) - lu(k,296) = lu(k,296) * lu(k,294) - lu(k,297) = lu(k,297) * lu(k,294) - lu(k,298) = lu(k,298) * lu(k,294) - lu(k,299) = lu(k,299) * lu(k,294) - lu(k,300) = lu(k,300) * lu(k,294) - lu(k,301) = lu(k,301) * lu(k,294) - lu(k,1630) = lu(k,1630) - lu(k,295) * lu(k,1601) - lu(k,1664) = lu(k,1664) - lu(k,296) * lu(k,1601) - lu(k,1678) = lu(k,1678) - lu(k,297) * lu(k,1601) - lu(k,1698) = lu(k,1698) - lu(k,298) * lu(k,1601) - lu(k,1699) = lu(k,1699) - lu(k,299) * lu(k,1601) - lu(k,1700) = lu(k,1700) - lu(k,300) * lu(k,1601) - lu(k,1701) = lu(k,1701) - lu(k,301) * lu(k,1601) - lu(k,1779) = - lu(k,295) * lu(k,1778) - lu(k,1787) = lu(k,1787) - lu(k,296) * lu(k,1778) - lu(k,1800) = lu(k,1800) - lu(k,297) * lu(k,1778) - lu(k,1819) = lu(k,1819) - lu(k,298) * lu(k,1778) - lu(k,1820) = lu(k,1820) - lu(k,299) * lu(k,1778) - lu(k,1821) = lu(k,1821) - lu(k,300) * lu(k,1778) - lu(k,1822) = lu(k,1822) - lu(k,301) * lu(k,1778) - lu(k,302) = 1._r8 / lu(k,302) - lu(k,303) = lu(k,303) * lu(k,302) - lu(k,304) = lu(k,304) * lu(k,302) - lu(k,305) = lu(k,305) * lu(k,302) - lu(k,306) = lu(k,306) * lu(k,302) - lu(k,307) = lu(k,307) * lu(k,302) - lu(k,308) = lu(k,308) * lu(k,302) - lu(k,309) = lu(k,309) * lu(k,302) - lu(k,1622) = lu(k,1622) - lu(k,303) * lu(k,1602) - lu(k,1657) = lu(k,1657) - lu(k,304) * lu(k,1602) - lu(k,1672) = lu(k,1672) - lu(k,305) * lu(k,1602) - lu(k,1684) = lu(k,1684) - lu(k,306) * lu(k,1602) - lu(k,1693) = lu(k,1693) - lu(k,307) * lu(k,1602) - lu(k,1698) = lu(k,1698) - lu(k,308) * lu(k,1602) - lu(k,1706) = lu(k,1706) - lu(k,309) * lu(k,1602) - lu(k,1991) = - lu(k,303) * lu(k,1990) - lu(k,1997) = - lu(k,304) * lu(k,1990) - lu(k,1999) = lu(k,1999) - lu(k,305) * lu(k,1990) - lu(k,2001) = lu(k,2001) - lu(k,306) * lu(k,1990) - lu(k,2004) = lu(k,2004) - lu(k,307) * lu(k,1990) - lu(k,2009) = lu(k,2009) - lu(k,308) * lu(k,1990) - lu(k,2017) = lu(k,2017) - lu(k,309) * lu(k,1990) - lu(k,310) = 1._r8 / lu(k,310) - lu(k,311) = lu(k,311) * lu(k,310) - lu(k,312) = lu(k,312) * lu(k,310) - lu(k,313) = lu(k,313) * lu(k,310) - lu(k,314) = lu(k,314) * lu(k,310) - lu(k,315) = lu(k,315) * lu(k,310) - lu(k,1083) = - lu(k,311) * lu(k,1079) - lu(k,1085) = - lu(k,312) * lu(k,1079) - lu(k,1093) = - lu(k,313) * lu(k,1079) - lu(k,1096) = lu(k,1096) - lu(k,314) * lu(k,1079) - lu(k,1097) = - lu(k,315) * lu(k,1079) - lu(k,1656) = lu(k,1656) - lu(k,311) * lu(k,1603) - lu(k,1669) = lu(k,1669) - lu(k,312) * lu(k,1603) - lu(k,1692) = lu(k,1692) - lu(k,313) * lu(k,1603) - lu(k,1696) = lu(k,1696) - lu(k,314) * lu(k,1603) - lu(k,1698) = lu(k,1698) - lu(k,315) * lu(k,1603) - lu(k,1839) = - lu(k,311) * lu(k,1832) - lu(k,1844) = lu(k,1844) - lu(k,312) * lu(k,1832) - lu(k,1863) = - lu(k,313) * lu(k,1832) - lu(k,1867) = lu(k,1867) - lu(k,314) * lu(k,1832) - lu(k,1869) = lu(k,1869) - lu(k,315) * lu(k,1832) + lu(k,299) = 1._r8 / lu(k,299) + lu(k,300) = lu(k,300) * lu(k,299) + lu(k,301) = lu(k,301) * lu(k,299) + lu(k,302) = lu(k,302) * lu(k,299) + lu(k,897) = lu(k,897) - lu(k,300) * lu(k,896) + lu(k,900) = lu(k,900) - lu(k,301) * lu(k,896) + lu(k,902) = - lu(k,302) * lu(k,896) + lu(k,1874) = lu(k,1874) - lu(k,300) * lu(k,1801) + lu(k,1920) = lu(k,1920) - lu(k,301) * lu(k,1801) + lu(k,1927) = lu(k,1927) - lu(k,302) * lu(k,1801) + lu(k,2334) = - lu(k,300) * lu(k,2332) + lu(k,2349) = lu(k,2349) - lu(k,301) * lu(k,2332) + lu(k,2356) = lu(k,2356) - lu(k,302) * lu(k,2332) + lu(k,303) = 1._r8 / lu(k,303) + lu(k,304) = lu(k,304) * lu(k,303) + lu(k,305) = lu(k,305) * lu(k,303) + lu(k,306) = lu(k,306) * lu(k,303) + lu(k,861) = lu(k,861) - lu(k,304) * lu(k,857) + lu(k,865) = - lu(k,305) * lu(k,857) + lu(k,867) = lu(k,867) - lu(k,306) * lu(k,857) + lu(k,1637) = lu(k,1637) - lu(k,304) * lu(k,1619) + lu(k,1660) = - lu(k,305) * lu(k,1619) + lu(k,1667) = lu(k,1667) - lu(k,306) * lu(k,1619) + lu(k,1890) = lu(k,1890) - lu(k,304) * lu(k,1802) + lu(k,1917) = lu(k,1917) - lu(k,305) * lu(k,1802) + lu(k,1924) = lu(k,1924) - lu(k,306) * lu(k,1802) + lu(k,307) = 1._r8 / lu(k,307) + lu(k,308) = lu(k,308) * lu(k,307) + lu(k,309) = lu(k,309) * lu(k,307) + lu(k,310) = lu(k,310) * lu(k,307) + lu(k,677) = lu(k,677) - lu(k,308) * lu(k,676) + lu(k,678) = lu(k,678) - lu(k,309) * lu(k,676) + lu(k,681) = - lu(k,310) * lu(k,676) + lu(k,1831) = lu(k,1831) - lu(k,308) * lu(k,1803) + lu(k,1852) = lu(k,1852) - lu(k,309) * lu(k,1803) + lu(k,1917) = lu(k,1917) - lu(k,310) * lu(k,1803) + lu(k,2156) = - lu(k,308) * lu(k,2137) + lu(k,2166) = lu(k,2166) - lu(k,309) * lu(k,2137) + lu(k,2220) = lu(k,2220) - lu(k,310) * lu(k,2137) + lu(k,311) = 1._r8 / lu(k,311) + lu(k,312) = lu(k,312) * lu(k,311) + lu(k,313) = lu(k,313) * lu(k,311) + lu(k,314) = lu(k,314) * lu(k,311) + lu(k,755) = - lu(k,312) * lu(k,753) + lu(k,759) = lu(k,759) - lu(k,313) * lu(k,753) + lu(k,760) = lu(k,760) - lu(k,314) * lu(k,753) + lu(k,1585) = lu(k,1585) - lu(k,312) * lu(k,1541) + lu(k,1612) = lu(k,1612) - lu(k,313) * lu(k,1541) + lu(k,1615) = lu(k,1615) - lu(k,314) * lu(k,1541) + lu(k,2197) = - lu(k,312) * lu(k,2138) + lu(k,2224) = lu(k,2224) - lu(k,313) * lu(k,2138) + lu(k,2227) = lu(k,2227) - lu(k,314) * lu(k,2138) + lu(k,315) = 1._r8 / lu(k,315) + lu(k,316) = lu(k,316) * lu(k,315) + lu(k,317) = lu(k,317) * lu(k,315) + lu(k,652) = - lu(k,316) * lu(k,646) + lu(k,656) = lu(k,656) - lu(k,317) * lu(k,646) + lu(k,744) = - lu(k,316) * lu(k,737) + lu(k,751) = lu(k,751) - lu(k,317) * lu(k,737) + lu(k,773) = - lu(k,316) * lu(k,767) + lu(k,781) = lu(k,781) - lu(k,317) * lu(k,767) + lu(k,789) = - lu(k,316) * lu(k,782) + lu(k,798) = lu(k,798) - lu(k,317) * lu(k,782) + lu(k,1567) = lu(k,1567) - lu(k,316) * lu(k,1542) + lu(k,1615) = lu(k,1615) - lu(k,317) * lu(k,1542) + 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,323) = lu(k,323) * lu(k,318) + lu(k,1874) = lu(k,1874) - lu(k,319) * lu(k,1804) + lu(k,1911) = lu(k,1911) - lu(k,320) * lu(k,1804) + lu(k,1917) = lu(k,1917) - lu(k,321) * lu(k,1804) + lu(k,1922) = lu(k,1922) - lu(k,322) * lu(k,1804) + lu(k,1924) = lu(k,1924) - lu(k,323) * lu(k,1804) + lu(k,2040) = lu(k,2040) - lu(k,319) * lu(k,2033) + lu(k,2071) = lu(k,2071) - lu(k,320) * lu(k,2033) + lu(k,2077) = lu(k,2077) - lu(k,321) * lu(k,2033) + lu(k,2082) = lu(k,2082) - lu(k,322) * lu(k,2033) + lu(k,2084) = lu(k,2084) - lu(k,323) * lu(k,2033) + lu(k,324) = 1._r8 / lu(k,324) + lu(k,325) = lu(k,325) * lu(k,324) + lu(k,326) = lu(k,326) * lu(k,324) + lu(k,327) = lu(k,327) * lu(k,324) + lu(k,328) = lu(k,328) * lu(k,324) + lu(k,329) = lu(k,329) * lu(k,324) + lu(k,1881) = lu(k,1881) - lu(k,325) * lu(k,1805) + lu(k,1883) = lu(k,1883) - lu(k,326) * lu(k,1805) + lu(k,1891) = lu(k,1891) - lu(k,327) * lu(k,1805) + lu(k,1917) = lu(k,1917) - lu(k,328) * lu(k,1805) + lu(k,1924) = lu(k,1924) - lu(k,329) * lu(k,1805) + lu(k,2244) = - lu(k,325) * lu(k,2232) + lu(k,2245) = - lu(k,326) * lu(k,2232) + lu(k,2247) = lu(k,2247) - lu(k,327) * lu(k,2232) + lu(k,2259) = lu(k,2259) - lu(k,328) * lu(k,2232) + lu(k,2266) = lu(k,2266) - lu(k,329) * lu(k,2232) + lu(k,330) = 1._r8 / lu(k,330) + lu(k,331) = lu(k,331) * lu(k,330) + lu(k,332) = lu(k,332) * lu(k,330) + lu(k,333) = lu(k,333) * lu(k,330) + lu(k,334) = lu(k,334) * lu(k,330) + lu(k,335) = lu(k,335) * lu(k,330) + lu(k,1870) = lu(k,1870) - lu(k,331) * lu(k,1806) + lu(k,1917) = lu(k,1917) - lu(k,332) * lu(k,1806) + lu(k,1919) = lu(k,1919) - lu(k,333) * lu(k,1806) + lu(k,1925) = lu(k,1925) - lu(k,334) * lu(k,1806) + lu(k,1927) = lu(k,1927) - lu(k,335) * lu(k,1806) + lu(k,2242) = lu(k,2242) - lu(k,331) * lu(k,2233) + lu(k,2259) = lu(k,2259) - lu(k,332) * lu(k,2233) + lu(k,2261) = lu(k,2261) - lu(k,333) * lu(k,2233) + lu(k,2267) = lu(k,2267) - lu(k,334) * lu(k,2233) + lu(k,2269) = - lu(k,335) * lu(k,2233) end do end subroutine lu_fac06 subroutine lu_fac07( avec_len, lu ) @@ -754,132 +655,153 @@ subroutine lu_fac07( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,316) = 1._r8 / lu(k,316) - lu(k,317) = lu(k,317) * lu(k,316) - lu(k,318) = lu(k,318) * lu(k,316) - lu(k,319) = lu(k,319) * lu(k,316) - lu(k,320) = lu(k,320) * lu(k,316) - lu(k,321) = lu(k,321) * lu(k,316) - lu(k,1029) = lu(k,1029) - lu(k,317) * lu(k,1026) - lu(k,1031) = lu(k,1031) - lu(k,318) * lu(k,1026) - lu(k,1034) = lu(k,1034) - lu(k,319) * lu(k,1026) - lu(k,1035) = lu(k,1035) - lu(k,320) * lu(k,1026) - lu(k,1038) = - lu(k,321) * lu(k,1026) - lu(k,1495) = lu(k,1495) - lu(k,317) * lu(k,1441) - lu(k,1507) = lu(k,1507) - lu(k,318) * lu(k,1441) - lu(k,1515) = lu(k,1515) - lu(k,319) * lu(k,1441) - lu(k,1516) = lu(k,1516) - lu(k,320) * lu(k,1441) - lu(k,1525) = lu(k,1525) - lu(k,321) * lu(k,1441) - lu(k,1677) = lu(k,1677) - lu(k,317) * lu(k,1604) - lu(k,1690) = lu(k,1690) - lu(k,318) * lu(k,1604) - lu(k,1698) = lu(k,1698) - lu(k,319) * lu(k,1604) - lu(k,1699) = lu(k,1699) - lu(k,320) * lu(k,1604) - lu(k,1708) = lu(k,1708) - lu(k,321) * lu(k,1604) - lu(k,322) = 1._r8 / lu(k,322) - lu(k,323) = lu(k,323) * lu(k,322) - lu(k,324) = lu(k,324) * lu(k,322) - lu(k,325) = lu(k,325) * lu(k,322) - lu(k,326) = lu(k,326) * lu(k,322) - lu(k,327) = lu(k,327) * lu(k,322) - lu(k,1081) = - lu(k,323) * lu(k,1080) - lu(k,1083) = lu(k,1083) - lu(k,324) * lu(k,1080) - lu(k,1096) = lu(k,1096) - lu(k,325) * lu(k,1080) - lu(k,1097) = lu(k,1097) - lu(k,326) * lu(k,1080) - lu(k,1099) = lu(k,1099) - lu(k,327) * lu(k,1080) - lu(k,1468) = lu(k,1468) - lu(k,323) * lu(k,1442) - lu(k,1482) = - lu(k,324) * lu(k,1442) - lu(k,1513) = lu(k,1513) - lu(k,325) * lu(k,1442) - lu(k,1515) = lu(k,1515) - lu(k,326) * lu(k,1442) - lu(k,1517) = lu(k,1517) - lu(k,327) * lu(k,1442) - lu(k,1641) = lu(k,1641) - lu(k,323) * lu(k,1605) - lu(k,1656) = lu(k,1656) - lu(k,324) * lu(k,1605) - lu(k,1696) = lu(k,1696) - lu(k,325) * lu(k,1605) - lu(k,1698) = lu(k,1698) - lu(k,326) * lu(k,1605) - lu(k,1700) = lu(k,1700) - lu(k,327) * lu(k,1605) - 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,1009) = lu(k,1009) - lu(k,329) * lu(k,1006) - lu(k,1013) = lu(k,1013) - lu(k,330) * lu(k,1006) - lu(k,1016) = - lu(k,331) * lu(k,1006) - lu(k,1020) = - lu(k,332) * lu(k,1006) - lu(k,1022) = lu(k,1022) - lu(k,333) * lu(k,1006) - lu(k,1487) = - lu(k,329) * lu(k,1443) - lu(k,1494) = lu(k,1494) - lu(k,330) * lu(k,1443) - lu(k,1509) = - lu(k,331) * lu(k,1443) - lu(k,1515) = lu(k,1515) - lu(k,332) * lu(k,1443) - lu(k,1517) = lu(k,1517) - lu(k,333) * lu(k,1443) - lu(k,1666) = lu(k,1666) - lu(k,329) * lu(k,1606) - lu(k,1676) = lu(k,1676) - lu(k,330) * lu(k,1606) - lu(k,1692) = lu(k,1692) - lu(k,331) * lu(k,1606) - lu(k,1698) = lu(k,1698) - lu(k,332) * lu(k,1606) - lu(k,1700) = lu(k,1700) - lu(k,333) * lu(k,1606) - lu(k,334) = 1._r8 / lu(k,334) - lu(k,335) = lu(k,335) * lu(k,334) - lu(k,336) = lu(k,336) * lu(k,334) - lu(k,337) = lu(k,337) * lu(k,334) - lu(k,338) = lu(k,338) * lu(k,334) - lu(k,339) = lu(k,339) * lu(k,334) - lu(k,804) = - lu(k,335) * lu(k,802) - lu(k,810) = lu(k,810) - lu(k,336) * lu(k,802) - lu(k,814) = - lu(k,337) * lu(k,802) - lu(k,815) = lu(k,815) - lu(k,338) * lu(k,802) - lu(k,816) = lu(k,816) - lu(k,339) * lu(k,802) - lu(k,830) = - lu(k,335) * lu(k,828) - lu(k,836) = lu(k,836) - lu(k,336) * lu(k,828) - lu(k,840) = - lu(k,337) * lu(k,828) - lu(k,841) = lu(k,841) - lu(k,338) * lu(k,828) - lu(k,842) = lu(k,842) - lu(k,339) * lu(k,828) - lu(k,1896) = - lu(k,335) * lu(k,1886) - lu(k,1905) = lu(k,1905) - lu(k,336) * lu(k,1886) - lu(k,1914) = lu(k,1914) - lu(k,337) * lu(k,1886) - lu(k,1921) = lu(k,1921) - lu(k,338) * lu(k,1886) - lu(k,1927) = lu(k,1927) - lu(k,339) * lu(k,1886) + 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,913) = lu(k,913) - lu(k,337) * lu(k,912) + lu(k,917) = lu(k,917) - lu(k,338) * lu(k,912) + lu(k,1440) = lu(k,1440) - lu(k,337) * lu(k,1439) + lu(k,1444) = lu(k,1444) - lu(k,338) * lu(k,1439) + lu(k,1467) = lu(k,1467) - lu(k,337) * lu(k,1465) + lu(k,1472) = lu(k,1472) - lu(k,338) * lu(k,1465) + lu(k,1484) = lu(k,1484) - lu(k,337) * lu(k,1483) + lu(k,1488) = - lu(k,338) * lu(k,1483) + lu(k,2335) = lu(k,2335) - lu(k,337) * lu(k,2333) + lu(k,2341) = lu(k,2341) - lu(k,338) * lu(k,2333) lu(k,340) = 1._r8 / lu(k,340) lu(k,341) = lu(k,341) * lu(k,340) lu(k,342) = lu(k,342) * lu(k,340) lu(k,343) = lu(k,343) * lu(k,340) lu(k,344) = lu(k,344) * lu(k,340) lu(k,345) = lu(k,345) * lu(k,340) - lu(k,710) = lu(k,710) - lu(k,341) * lu(k,709) - lu(k,711) = lu(k,711) - lu(k,342) * lu(k,709) - lu(k,714) = lu(k,714) - lu(k,343) * lu(k,709) - lu(k,715) = - lu(k,344) * lu(k,709) - lu(k,719) = - lu(k,345) * lu(k,709) - lu(k,1478) = lu(k,1478) - lu(k,341) * lu(k,1444) - lu(k,1486) = - lu(k,342) * lu(k,1444) - lu(k,1513) = lu(k,1513) - lu(k,343) * lu(k,1444) - lu(k,1515) = lu(k,1515) - lu(k,344) * lu(k,1444) - lu(k,1525) = lu(k,1525) - lu(k,345) * lu(k,1444) - lu(k,1652) = lu(k,1652) - lu(k,341) * lu(k,1607) - lu(k,1664) = lu(k,1664) - lu(k,342) * lu(k,1607) - lu(k,1696) = lu(k,1696) - lu(k,343) * lu(k,1607) - lu(k,1698) = lu(k,1698) - lu(k,344) * lu(k,1607) - lu(k,1708) = lu(k,1708) - lu(k,345) * lu(k,1607) + lu(k,1735) = lu(k,1735) - lu(k,341) * lu(k,1730) + lu(k,1744) = lu(k,1744) - lu(k,342) * lu(k,1730) + lu(k,1745) = lu(k,1745) - lu(k,343) * lu(k,1730) + lu(k,1753) = lu(k,1753) - lu(k,344) * lu(k,1730) + lu(k,1755) = lu(k,1755) - lu(k,345) * lu(k,1730) + lu(k,1876) = lu(k,1876) - lu(k,341) * lu(k,1807) + lu(k,1916) = lu(k,1916) - lu(k,342) * lu(k,1807) + lu(k,1917) = lu(k,1917) - lu(k,343) * lu(k,1807) + lu(k,1925) = lu(k,1925) - lu(k,344) * lu(k,1807) + lu(k,1927) = lu(k,1927) - lu(k,345) * lu(k,1807) lu(k,346) = 1._r8 / lu(k,346) lu(k,347) = lu(k,347) * lu(k,346) lu(k,348) = lu(k,348) * lu(k,346) lu(k,349) = lu(k,349) * lu(k,346) lu(k,350) = lu(k,350) * lu(k,346) lu(k,351) = lu(k,351) * lu(k,346) - lu(k,419) = lu(k,419) - lu(k,347) * lu(k,418) - lu(k,420) = lu(k,420) - lu(k,348) * lu(k,418) - lu(k,422) = lu(k,422) - lu(k,349) * lu(k,418) - lu(k,424) = lu(k,424) - lu(k,350) * lu(k,418) - lu(k,425) = - lu(k,351) * lu(k,418) - lu(k,1452) = - lu(k,347) * lu(k,1445) - lu(k,1455) = lu(k,1455) - lu(k,348) * lu(k,1445) - lu(k,1484) = lu(k,1484) - lu(k,349) * lu(k,1445) - lu(k,1513) = lu(k,1513) - lu(k,350) * lu(k,1445) - lu(k,1515) = lu(k,1515) - lu(k,351) * lu(k,1445) - lu(k,1615) = lu(k,1615) - lu(k,347) * lu(k,1608) - lu(k,1619) = lu(k,1619) - lu(k,348) * lu(k,1608) - lu(k,1660) = lu(k,1660) - lu(k,349) * lu(k,1608) - lu(k,1696) = lu(k,1696) - lu(k,350) * lu(k,1608) - lu(k,1698) = lu(k,1698) - lu(k,351) * lu(k,1608) + lu(k,1698) = lu(k,1698) - lu(k,347) * lu(k,1673) + lu(k,1700) = lu(k,1700) - lu(k,348) * lu(k,1673) + lu(k,1702) = lu(k,1702) - lu(k,349) * lu(k,1673) + lu(k,1707) = lu(k,1707) - lu(k,350) * lu(k,1673) + lu(k,1709) = lu(k,1709) - lu(k,351) * lu(k,1673) + lu(k,2071) = lu(k,2071) - lu(k,347) * lu(k,2034) + lu(k,2073) = lu(k,2073) - lu(k,348) * lu(k,2034) + lu(k,2075) = lu(k,2075) - lu(k,349) * lu(k,2034) + lu(k,2080) = lu(k,2080) - lu(k,350) * lu(k,2034) + lu(k,2082) = lu(k,2082) - lu(k,351) * lu(k,2034) + 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,717) = lu(k,717) - lu(k,353) * lu(k,716) + lu(k,718) = lu(k,718) - lu(k,354) * lu(k,716) + lu(k,719) = lu(k,719) - lu(k,355) * lu(k,716) + lu(k,722) = lu(k,722) - lu(k,356) * lu(k,716) + lu(k,1856) = lu(k,1856) - lu(k,353) * lu(k,1808) + lu(k,1890) = lu(k,1890) - lu(k,354) * lu(k,1808) + lu(k,1907) = lu(k,1907) - lu(k,355) * lu(k,1808) + lu(k,1917) = lu(k,1917) - lu(k,356) * lu(k,1808) + lu(k,2169) = lu(k,2169) - lu(k,353) * lu(k,2139) + lu(k,2195) = lu(k,2195) - lu(k,354) * lu(k,2139) + lu(k,2210) = lu(k,2210) - lu(k,355) * lu(k,2139) + lu(k,2220) = lu(k,2220) - lu(k,356) * lu(k,2139) + lu(k,357) = 1._r8 / lu(k,357) + lu(k,358) = lu(k,358) * lu(k,357) + lu(k,359) = lu(k,359) * lu(k,357) + lu(k,360) = lu(k,360) * lu(k,357) + lu(k,361) = lu(k,361) * lu(k,357) + lu(k,747) = - lu(k,358) * lu(k,738) + lu(k,748) = lu(k,748) - lu(k,359) * lu(k,738) + lu(k,749) = - lu(k,360) * lu(k,738) + lu(k,751) = lu(k,751) - lu(k,361) * lu(k,738) + lu(k,792) = - lu(k,358) * lu(k,783) + lu(k,793) = lu(k,793) - lu(k,359) * lu(k,783) + lu(k,794) = - lu(k,360) * lu(k,783) + lu(k,798) = lu(k,798) - lu(k,361) * lu(k,783) + lu(k,1584) = lu(k,1584) - lu(k,358) * lu(k,1543) + lu(k,1593) = lu(k,1593) - lu(k,359) * lu(k,1543) + lu(k,1599) = lu(k,1599) - lu(k,360) * lu(k,1543) + lu(k,1615) = lu(k,1615) - lu(k,361) * lu(k,1543) + lu(k,362) = 1._r8 / lu(k,362) + lu(k,363) = lu(k,363) * lu(k,362) + lu(k,364) = lu(k,364) * lu(k,362) + lu(k,365) = lu(k,365) * lu(k,362) + lu(k,366) = lu(k,366) * lu(k,362) + lu(k,1271) = lu(k,1271) - lu(k,363) * lu(k,1269) + lu(k,1272) = lu(k,1272) - lu(k,364) * lu(k,1269) + lu(k,1278) = lu(k,1278) - lu(k,365) * lu(k,1269) + lu(k,1279) = lu(k,1279) - lu(k,366) * lu(k,1269) + lu(k,1933) = lu(k,1933) - lu(k,363) * lu(k,1931) + lu(k,1935) = lu(k,1935) - lu(k,364) * lu(k,1931) + lu(k,1944) = lu(k,1944) - lu(k,365) * lu(k,1931) + lu(k,1946) = lu(k,1946) - lu(k,366) * lu(k,1931) + lu(k,2092) = lu(k,2092) - lu(k,363) * lu(k,2089) + lu(k,2093) = lu(k,2093) - lu(k,364) * lu(k,2089) + lu(k,2102) = lu(k,2102) - lu(k,365) * lu(k,2089) + lu(k,2104) = lu(k,2104) - lu(k,366) * lu(k,2089) + lu(k,367) = 1._r8 / lu(k,367) + lu(k,368) = lu(k,368) * lu(k,367) + lu(k,369) = lu(k,369) * lu(k,367) + lu(k,370) = lu(k,370) * lu(k,367) + lu(k,371) = lu(k,371) * lu(k,367) + lu(k,496) = lu(k,496) - lu(k,368) * lu(k,495) + lu(k,497) = lu(k,497) - lu(k,369) * lu(k,495) + lu(k,500) = - lu(k,370) * lu(k,495) + lu(k,501) = lu(k,501) - lu(k,371) * lu(k,495) + lu(k,1828) = lu(k,1828) - lu(k,368) * lu(k,1809) + lu(k,1881) = lu(k,1881) - lu(k,369) * lu(k,1809) + lu(k,1917) = lu(k,1917) - lu(k,370) * lu(k,1809) + lu(k,1924) = lu(k,1924) - lu(k,371) * lu(k,1809) + lu(k,2154) = lu(k,2154) - lu(k,368) * lu(k,2140) + lu(k,2190) = lu(k,2190) - lu(k,369) * lu(k,2140) + lu(k,2220) = lu(k,2220) - lu(k,370) * lu(k,2140) + lu(k,2227) = lu(k,2227) - lu(k,371) * lu(k,2140) + lu(k,373) = 1._r8 / lu(k,373) + lu(k,374) = lu(k,374) * lu(k,373) + lu(k,375) = lu(k,375) * lu(k,373) + lu(k,376) = lu(k,376) * lu(k,373) + lu(k,377) = lu(k,377) * lu(k,373) + lu(k,477) = lu(k,477) - lu(k,374) * lu(k,476) + lu(k,478) = lu(k,478) - lu(k,375) * lu(k,476) + lu(k,481) = lu(k,481) - lu(k,376) * lu(k,476) + lu(k,482) = lu(k,482) - lu(k,377) * lu(k,476) + lu(k,1827) = lu(k,1827) - lu(k,374) * lu(k,1810) + lu(k,1837) = lu(k,1837) - lu(k,375) * lu(k,1810) + lu(k,1917) = lu(k,1917) - lu(k,376) * lu(k,1810) + lu(k,1924) = lu(k,1924) - lu(k,377) * lu(k,1810) + lu(k,2152) = lu(k,2152) - lu(k,374) * lu(k,2141) + lu(k,2160) = lu(k,2160) - lu(k,375) * lu(k,2141) + lu(k,2220) = lu(k,2220) - lu(k,376) * lu(k,2141) + lu(k,2227) = lu(k,2227) - lu(k,377) * lu(k,2141) + lu(k,378) = 1._r8 / lu(k,378) + lu(k,379) = lu(k,379) * lu(k,378) + lu(k,380) = lu(k,380) * lu(k,378) + lu(k,381) = lu(k,381) * lu(k,378) + lu(k,382) = lu(k,382) * lu(k,378) + lu(k,860) = lu(k,860) - lu(k,379) * lu(k,858) + lu(k,861) = lu(k,861) - lu(k,380) * lu(k,858) + lu(k,865) = lu(k,865) - lu(k,381) * lu(k,858) + lu(k,867) = lu(k,867) - lu(k,382) * lu(k,858) + lu(k,1870) = lu(k,1870) - lu(k,379) * lu(k,1811) + lu(k,1890) = lu(k,1890) - lu(k,380) * lu(k,1811) + lu(k,1917) = lu(k,1917) - lu(k,381) * lu(k,1811) + lu(k,1924) = lu(k,1924) - lu(k,382) * lu(k,1811) + lu(k,2183) = lu(k,2183) - lu(k,379) * lu(k,2142) + lu(k,2195) = lu(k,2195) - lu(k,380) * lu(k,2142) + lu(k,2220) = lu(k,2220) - lu(k,381) * lu(k,2142) + lu(k,2227) = lu(k,2227) - lu(k,382) * lu(k,2142) end do end subroutine lu_fac07 subroutine lu_fac08( avec_len, lu ) @@ -896,153 +818,146 @@ subroutine lu_fac08( avec_len, lu ) !----------------------------------------------------------------------- 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,1510) = lu(k,1510) - lu(k,353) * lu(k,1446) - lu(k,1515) = lu(k,1515) - lu(k,354) * lu(k,1446) - lu(k,1516) = lu(k,1516) - lu(k,355) * lu(k,1446) - lu(k,1519) = lu(k,1519) - lu(k,356) * lu(k,1446) - lu(k,1525) = lu(k,1525) - lu(k,357) * lu(k,1446) - lu(k,1693) = lu(k,1693) - lu(k,353) * lu(k,1609) - lu(k,1698) = lu(k,1698) - lu(k,354) * lu(k,1609) - lu(k,1699) = lu(k,1699) - lu(k,355) * lu(k,1609) - lu(k,1702) = lu(k,1702) - lu(k,356) * lu(k,1609) - lu(k,1708) = lu(k,1708) - lu(k,357) * lu(k,1609) - lu(k,1864) = - lu(k,353) * lu(k,1833) - lu(k,1869) = lu(k,1869) - lu(k,354) * lu(k,1833) - lu(k,1870) = lu(k,1870) - lu(k,355) * lu(k,1833) - lu(k,1873) = lu(k,1873) - lu(k,356) * lu(k,1833) - lu(k,1879) = - lu(k,357) * lu(k,1833) - lu(k,358) = 1._r8 / lu(k,358) - lu(k,359) = lu(k,359) * lu(k,358) - lu(k,360) = lu(k,360) * lu(k,358) - lu(k,361) = lu(k,361) * lu(k,358) - lu(k,362) = lu(k,362) * lu(k,358) - lu(k,363) = lu(k,363) * lu(k,358) - lu(k,1513) = lu(k,1513) - lu(k,359) * lu(k,1447) - lu(k,1515) = lu(k,1515) - lu(k,360) * lu(k,1447) - lu(k,1517) = lu(k,1517) - lu(k,361) * lu(k,1447) - lu(k,1518) = lu(k,1518) - lu(k,362) * lu(k,1447) - lu(k,1525) = lu(k,1525) - lu(k,363) * lu(k,1447) - lu(k,1696) = lu(k,1696) - lu(k,359) * lu(k,1610) - lu(k,1698) = lu(k,1698) - lu(k,360) * lu(k,1610) - lu(k,1700) = lu(k,1700) - lu(k,361) * lu(k,1610) - lu(k,1701) = lu(k,1701) - lu(k,362) * lu(k,1610) - lu(k,1708) = lu(k,1708) - lu(k,363) * lu(k,1610) - lu(k,1760) = lu(k,1760) - lu(k,359) * lu(k,1734) - lu(k,1762) = lu(k,1762) - lu(k,360) * lu(k,1734) - lu(k,1764) = lu(k,1764) - lu(k,361) * lu(k,1734) - lu(k,1765) = lu(k,1765) - lu(k,362) * lu(k,1734) - lu(k,1772) = - lu(k,363) * lu(k,1734) - lu(k,364) = 1._r8 / lu(k,364) - lu(k,365) = lu(k,365) * lu(k,364) - lu(k,366) = lu(k,366) * lu(k,364) - lu(k,367) = lu(k,367) * lu(k,364) - lu(k,368) = lu(k,368) * lu(k,364) - lu(k,369) = lu(k,369) * lu(k,364) - lu(k,1394) = - lu(k,365) * lu(k,1338) - lu(k,1395) = lu(k,1395) - lu(k,366) * lu(k,1338) - lu(k,1399) = lu(k,1399) - lu(k,367) * lu(k,1338) - lu(k,1401) = lu(k,1401) - lu(k,368) * lu(k,1338) - lu(k,1407) = lu(k,1407) - lu(k,369) * lu(k,1338) - lu(k,1693) = lu(k,1693) - lu(k,365) * lu(k,1611) - lu(k,1694) = lu(k,1694) - lu(k,366) * lu(k,1611) - lu(k,1698) = lu(k,1698) - lu(k,367) * lu(k,1611) - lu(k,1700) = lu(k,1700) - lu(k,368) * lu(k,1611) - lu(k,1706) = lu(k,1706) - lu(k,369) * lu(k,1611) - lu(k,1757) = - lu(k,365) * lu(k,1735) - lu(k,1758) = lu(k,1758) - lu(k,366) * lu(k,1735) - lu(k,1762) = lu(k,1762) - lu(k,367) * lu(k,1735) - lu(k,1764) = lu(k,1764) - lu(k,368) * lu(k,1735) - lu(k,1770) = lu(k,1770) - lu(k,369) * lu(k,1735) - lu(k,370) = 1._r8 / lu(k,370) - lu(k,371) = lu(k,371) * lu(k,370) - lu(k,372) = lu(k,372) * lu(k,370) - lu(k,373) = lu(k,373) * lu(k,370) - lu(k,374) = lu(k,374) * lu(k,370) - lu(k,375) = lu(k,375) * lu(k,370) - lu(k,428) = lu(k,428) - lu(k,371) * lu(k,427) - lu(k,429) = lu(k,429) - lu(k,372) * lu(k,427) - lu(k,430) = lu(k,430) - lu(k,373) * lu(k,427) - lu(k,432) = lu(k,432) - lu(k,374) * lu(k,427) - lu(k,433) = - lu(k,375) * lu(k,427) - lu(k,1456) = lu(k,1456) - lu(k,371) * lu(k,1448) - lu(k,1484) = lu(k,1484) - lu(k,372) * lu(k,1448) - lu(k,1501) = lu(k,1501) - lu(k,373) * lu(k,1448) - lu(k,1513) = lu(k,1513) - lu(k,374) * lu(k,1448) - lu(k,1515) = lu(k,1515) - lu(k,375) * lu(k,1448) - lu(k,1620) = lu(k,1620) - lu(k,371) * lu(k,1612) - lu(k,1660) = lu(k,1660) - lu(k,372) * lu(k,1612) - lu(k,1683) = lu(k,1683) - lu(k,373) * lu(k,1612) - lu(k,1696) = lu(k,1696) - lu(k,374) * lu(k,1612) - lu(k,1698) = lu(k,1698) - lu(k,375) * lu(k,1612) - lu(k,378) = 1._r8 / lu(k,378) - lu(k,379) = lu(k,379) * lu(k,378) - lu(k,380) = lu(k,380) * lu(k,378) - lu(k,381) = lu(k,381) * lu(k,378) - lu(k,382) = lu(k,382) * lu(k,378) - lu(k,383) = lu(k,383) * lu(k,378) - lu(k,1347) = lu(k,1347) - lu(k,379) * lu(k,1339) - lu(k,1395) = lu(k,1395) - lu(k,380) * lu(k,1339) - lu(k,1397) = lu(k,1397) - lu(k,381) * lu(k,1339) - lu(k,1399) = lu(k,1399) - lu(k,382) * lu(k,1339) - lu(k,1401) = lu(k,1401) - lu(k,383) * lu(k,1339) - lu(k,1458) = lu(k,1458) - lu(k,379) * lu(k,1449) - lu(k,1511) = lu(k,1511) - lu(k,380) * lu(k,1449) - lu(k,1513) = lu(k,1513) - lu(k,381) * lu(k,1449) - lu(k,1515) = lu(k,1515) - lu(k,382) * lu(k,1449) - lu(k,1517) = lu(k,1517) - lu(k,383) * lu(k,1449) - lu(k,1624) = lu(k,1624) - lu(k,379) * lu(k,1613) - lu(k,1694) = lu(k,1694) - lu(k,380) * lu(k,1613) - lu(k,1696) = lu(k,1696) - lu(k,381) * lu(k,1613) - lu(k,1698) = lu(k,1698) - lu(k,382) * lu(k,1613) - lu(k,1700) = lu(k,1700) - lu(k,383) * lu(k,1613) - lu(k,384) = 1._r8 / lu(k,384) - lu(k,385) = lu(k,385) * lu(k,384) - lu(k,386) = lu(k,386) * lu(k,384) - lu(k,387) = lu(k,387) * lu(k,384) - lu(k,388) = lu(k,388) * lu(k,384) - lu(k,389) = lu(k,389) * lu(k,384) - lu(k,1362) = lu(k,1362) - lu(k,385) * lu(k,1340) - lu(k,1395) = lu(k,1395) - lu(k,386) * lu(k,1340) - lu(k,1397) = lu(k,1397) - lu(k,387) * lu(k,1340) - lu(k,1400) = lu(k,1400) - lu(k,388) * lu(k,1340) - lu(k,1401) = lu(k,1401) - lu(k,389) * lu(k,1340) - lu(k,1477) = lu(k,1477) - lu(k,385) * lu(k,1450) - lu(k,1511) = lu(k,1511) - lu(k,386) * lu(k,1450) - lu(k,1513) = lu(k,1513) - lu(k,387) * lu(k,1450) - lu(k,1516) = lu(k,1516) - lu(k,388) * lu(k,1450) - lu(k,1517) = lu(k,1517) - lu(k,389) * lu(k,1450) - lu(k,1710) = - lu(k,385) * lu(k,1709) - lu(k,1717) = - lu(k,386) * lu(k,1709) - lu(k,1719) = lu(k,1719) - lu(k,387) * lu(k,1709) - lu(k,1722) = lu(k,1722) - lu(k,388) * lu(k,1709) - lu(k,1723) = - lu(k,389) * lu(k,1709) + lu(k,383) = 1._r8 / lu(k,383) + lu(k,384) = lu(k,384) * lu(k,383) + lu(k,385) = lu(k,385) * lu(k,383) + lu(k,1325) = lu(k,1325) - lu(k,384) * lu(k,1313) + lu(k,1337) = lu(k,1337) - lu(k,385) * lu(k,1313) + lu(k,1417) = lu(k,1417) - lu(k,384) * lu(k,1407) + lu(k,1432) = lu(k,1432) - lu(k,385) * lu(k,1407) + lu(k,1590) = lu(k,1590) - lu(k,384) * lu(k,1544) + lu(k,1608) = lu(k,1608) - lu(k,385) * lu(k,1544) + lu(k,1643) = lu(k,1643) - lu(k,384) * lu(k,1620) + lu(k,1660) = lu(k,1660) - lu(k,385) * lu(k,1620) + lu(k,1897) = lu(k,1897) - lu(k,384) * lu(k,1812) + lu(k,1917) = lu(k,1917) - lu(k,385) * lu(k,1812) + lu(k,2058) = lu(k,2058) - lu(k,384) * lu(k,2035) + lu(k,2077) = lu(k,2077) - lu(k,385) * lu(k,2035) + lu(k,386) = 1._r8 / lu(k,386) + lu(k,387) = lu(k,387) * lu(k,386) + lu(k,388) = lu(k,388) * lu(k,386) + lu(k,389) = lu(k,389) * lu(k,386) + lu(k,390) = lu(k,390) * lu(k,386) + lu(k,1351) = lu(k,1351) - lu(k,387) * lu(k,1344) + lu(k,1352) = - lu(k,388) * lu(k,1344) + lu(k,1358) = - lu(k,389) * lu(k,1344) + lu(k,1362) = lu(k,1362) - lu(k,390) * lu(k,1344) + lu(k,1904) = lu(k,1904) - lu(k,387) * lu(k,1813) + lu(k,1906) = lu(k,1906) - lu(k,388) * lu(k,1813) + lu(k,1917) = lu(k,1917) - lu(k,389) * lu(k,1813) + lu(k,1924) = lu(k,1924) - lu(k,390) * lu(k,1813) + lu(k,2207) = lu(k,2207) - lu(k,387) * lu(k,2143) + lu(k,2209) = lu(k,2209) - lu(k,388) * lu(k,2143) + lu(k,2220) = lu(k,2220) - lu(k,389) * lu(k,2143) + lu(k,2227) = lu(k,2227) - lu(k,390) * lu(k,2143) lu(k,391) = 1._r8 / lu(k,391) lu(k,392) = lu(k,392) * lu(k,391) lu(k,393) = lu(k,393) * lu(k,391) lu(k,394) = lu(k,394) * lu(k,391) lu(k,395) = lu(k,395) * lu(k,391) lu(k,396) = lu(k,396) * lu(k,391) - lu(k,1367) = lu(k,1367) - lu(k,392) * lu(k,1341) - lu(k,1395) = lu(k,1395) - lu(k,393) * lu(k,1341) - lu(k,1397) = lu(k,1397) - lu(k,394) * lu(k,1341) - lu(k,1399) = lu(k,1399) - lu(k,395) * lu(k,1341) - lu(k,1401) = lu(k,1401) - lu(k,396) * lu(k,1341) - lu(k,1484) = lu(k,1484) - lu(k,392) * lu(k,1451) - lu(k,1511) = lu(k,1511) - lu(k,393) * lu(k,1451) - lu(k,1513) = lu(k,1513) - lu(k,394) * lu(k,1451) - lu(k,1515) = lu(k,1515) - lu(k,395) * lu(k,1451) - lu(k,1517) = lu(k,1517) - lu(k,396) * lu(k,1451) - lu(k,1660) = lu(k,1660) - lu(k,392) * lu(k,1614) - lu(k,1694) = lu(k,1694) - lu(k,393) * lu(k,1614) - lu(k,1696) = lu(k,1696) - lu(k,394) * lu(k,1614) - lu(k,1698) = lu(k,1698) - lu(k,395) * lu(k,1614) - lu(k,1700) = lu(k,1700) - lu(k,396) * lu(k,1614) + lu(k,397) = lu(k,397) * lu(k,391) + lu(k,398) = lu(k,398) * lu(k,391) + lu(k,1838) = lu(k,1838) - lu(k,392) * lu(k,1814) + lu(k,1874) = lu(k,1874) - lu(k,393) * lu(k,1814) + lu(k,1891) = lu(k,1891) - lu(k,394) * lu(k,1814) + lu(k,1901) = lu(k,1901) - lu(k,395) * lu(k,1814) + lu(k,1912) = lu(k,1912) - lu(k,396) * lu(k,1814) + lu(k,1917) = lu(k,1917) - lu(k,397) * lu(k,1814) + lu(k,1920) = lu(k,1920) - lu(k,398) * lu(k,1814) + lu(k,1977) = - lu(k,392) * lu(k,1976) + lu(k,1983) = - lu(k,393) * lu(k,1976) + lu(k,1985) = lu(k,1985) - lu(k,394) * lu(k,1976) + lu(k,1986) = lu(k,1986) - lu(k,395) * lu(k,1976) + lu(k,1991) = lu(k,1991) - lu(k,396) * lu(k,1976) + lu(k,1996) = lu(k,1996) - lu(k,397) * lu(k,1976) + lu(k,1999) = lu(k,1999) - lu(k,398) * lu(k,1976) + lu(k,399) = 1._r8 / lu(k,399) + lu(k,400) = lu(k,400) * lu(k,399) + lu(k,401) = lu(k,401) * lu(k,399) + lu(k,402) = lu(k,402) * lu(k,399) + lu(k,403) = lu(k,403) * lu(k,399) + lu(k,404) = lu(k,404) * lu(k,399) + lu(k,405) = lu(k,405) * lu(k,399) + lu(k,406) = lu(k,406) * lu(k,399) + lu(k,1843) = lu(k,1843) - lu(k,400) * lu(k,1815) + lu(k,1880) = lu(k,1880) - lu(k,401) * lu(k,1815) + lu(k,1890) = lu(k,1890) - lu(k,402) * lu(k,1815) + lu(k,1915) = lu(k,1915) - lu(k,403) * lu(k,1815) + lu(k,1917) = lu(k,1917) - lu(k,404) * lu(k,1815) + lu(k,1921) = lu(k,1921) - lu(k,405) * lu(k,1815) + lu(k,1922) = lu(k,1922) - lu(k,406) * lu(k,1815) + lu(k,2037) = - lu(k,400) * lu(k,2036) + lu(k,2041) = lu(k,2041) - lu(k,401) * lu(k,2036) + lu(k,2051) = lu(k,2051) - lu(k,402) * lu(k,2036) + lu(k,2075) = lu(k,2075) - lu(k,403) * lu(k,2036) + lu(k,2077) = lu(k,2077) - lu(k,404) * lu(k,2036) + lu(k,2081) = lu(k,2081) - lu(k,405) * lu(k,2036) + lu(k,2082) = lu(k,2082) - lu(k,406) * lu(k,2036) + lu(k,407) = 1._r8 / lu(k,407) + lu(k,408) = lu(k,408) * lu(k,407) + lu(k,409) = lu(k,409) * lu(k,407) + lu(k,410) = lu(k,410) * lu(k,407) + lu(k,411) = lu(k,411) * lu(k,407) + lu(k,412) = lu(k,412) * lu(k,407) + lu(k,413) = lu(k,413) * lu(k,407) + lu(k,414) = lu(k,414) * lu(k,407) + lu(k,1891) = lu(k,1891) - lu(k,408) * lu(k,1816) + lu(k,1914) = lu(k,1914) - lu(k,409) * lu(k,1816) + lu(k,1917) = lu(k,1917) - lu(k,410) * lu(k,1816) + lu(k,1919) = lu(k,1919) - lu(k,411) * lu(k,1816) + lu(k,1924) = lu(k,1924) - lu(k,412) * lu(k,1816) + lu(k,1925) = lu(k,1925) - lu(k,413) * lu(k,1816) + lu(k,1927) = lu(k,1927) - lu(k,414) * lu(k,1816) + lu(k,2247) = lu(k,2247) - lu(k,408) * lu(k,2234) + lu(k,2256) = lu(k,2256) - lu(k,409) * lu(k,2234) + lu(k,2259) = lu(k,2259) - lu(k,410) * lu(k,2234) + lu(k,2261) = lu(k,2261) - lu(k,411) * lu(k,2234) + lu(k,2266) = lu(k,2266) - lu(k,412) * lu(k,2234) + lu(k,2267) = lu(k,2267) - lu(k,413) * lu(k,2234) + lu(k,2269) = lu(k,2269) - lu(k,414) * lu(k,2234) + lu(k,415) = 1._r8 / lu(k,415) + lu(k,416) = lu(k,416) * lu(k,415) + lu(k,417) = lu(k,417) * lu(k,415) + lu(k,418) = lu(k,418) * lu(k,415) + lu(k,419) = lu(k,419) * lu(k,415) + lu(k,420) = lu(k,420) * lu(k,415) + lu(k,1169) = lu(k,1169) - lu(k,416) * lu(k,1167) + lu(k,1172) = lu(k,1172) - lu(k,417) * lu(k,1167) + lu(k,1176) = lu(k,1176) - lu(k,418) * lu(k,1167) + lu(k,1177) = lu(k,1177) - lu(k,419) * lu(k,1167) + lu(k,1179) = - lu(k,420) * lu(k,1167) + lu(k,1894) = lu(k,1894) - lu(k,416) * lu(k,1817) + lu(k,1907) = lu(k,1907) - lu(k,417) * lu(k,1817) + lu(k,1917) = lu(k,1917) - lu(k,418) * lu(k,1817) + lu(k,1921) = lu(k,1921) - lu(k,419) * lu(k,1817) + lu(k,1927) = lu(k,1927) - lu(k,420) * lu(k,1817) + lu(k,2199) = lu(k,2199) - lu(k,416) * lu(k,2144) + lu(k,2210) = lu(k,2210) - lu(k,417) * lu(k,2144) + lu(k,2220) = lu(k,2220) - lu(k,418) * lu(k,2144) + lu(k,2224) = lu(k,2224) - lu(k,419) * lu(k,2144) + lu(k,2230) = lu(k,2230) - lu(k,420) * lu(k,2144) + lu(k,421) = 1._r8 / lu(k,421) + lu(k,422) = lu(k,422) * lu(k,421) + lu(k,423) = lu(k,423) * lu(k,421) + lu(k,424) = lu(k,424) * lu(k,421) + lu(k,425) = lu(k,425) * lu(k,421) + lu(k,426) = lu(k,426) * lu(k,421) + lu(k,532) = lu(k,532) - lu(k,422) * lu(k,531) + lu(k,533) = lu(k,533) - lu(k,423) * lu(k,531) + lu(k,535) = lu(k,535) - lu(k,424) * lu(k,531) + lu(k,538) = - lu(k,425) * lu(k,531) + lu(k,539) = lu(k,539) - lu(k,426) * lu(k,531) + lu(k,1829) = lu(k,1829) - lu(k,422) * lu(k,1818) + lu(k,1834) = lu(k,1834) - lu(k,423) * lu(k,1818) + lu(k,1881) = lu(k,1881) - lu(k,424) * lu(k,1818) + lu(k,1917) = lu(k,1917) - lu(k,425) * lu(k,1818) + lu(k,1924) = lu(k,1924) - lu(k,426) * lu(k,1818) + lu(k,2155) = - lu(k,422) * lu(k,2145) + lu(k,2158) = lu(k,2158) - lu(k,423) * lu(k,2145) + lu(k,2190) = lu(k,2190) - lu(k,424) * lu(k,2145) + lu(k,2220) = lu(k,2220) - lu(k,425) * lu(k,2145) + lu(k,2227) = lu(k,2227) - lu(k,426) * lu(k,2145) end do end subroutine lu_fac08 subroutine lu_fac09( avec_len, lu ) @@ -1059,173 +974,132 @@ subroutine lu_fac09( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,397) = 1._r8 / lu(k,397) - lu(k,398) = lu(k,398) * lu(k,397) - lu(k,399) = lu(k,399) * lu(k,397) - lu(k,421) = - lu(k,398) * lu(k,419) - lu(k,424) = lu(k,424) - lu(k,399) * lu(k,419) - lu(k,540) = - lu(k,398) * lu(k,537) - lu(k,545) = lu(k,545) - lu(k,399) * lu(k,537) - lu(k,608) = - lu(k,398) * lu(k,605) - lu(k,616) = lu(k,616) - lu(k,399) * lu(k,605) - lu(k,637) = - lu(k,398) * lu(k,634) - lu(k,645) = lu(k,645) - lu(k,399) * lu(k,634) - lu(k,653) = - lu(k,398) * lu(k,650) - lu(k,662) = lu(k,662) - lu(k,399) * lu(k,650) - lu(k,1357) = lu(k,1357) - lu(k,398) * lu(k,1342) - lu(k,1397) = lu(k,1397) - lu(k,399) * lu(k,1342) - lu(k,1471) = lu(k,1471) - lu(k,398) * lu(k,1452) - lu(k,1513) = lu(k,1513) - lu(k,399) * lu(k,1452) - lu(k,1644) = - lu(k,398) * lu(k,1615) - lu(k,1696) = lu(k,1696) - lu(k,399) * lu(k,1615) - lu(k,400) = 1._r8 / lu(k,400) - lu(k,401) = lu(k,401) * lu(k,400) - lu(k,402) = lu(k,402) * lu(k,400) - lu(k,403) = lu(k,403) * lu(k,400) - lu(k,559) = lu(k,559) - lu(k,401) * lu(k,558) - lu(k,563) = lu(k,563) - lu(k,402) * lu(k,558) - lu(k,564) = - lu(k,403) * lu(k,558) - lu(k,1353) = lu(k,1353) - lu(k,401) * lu(k,1343) - lu(k,1401) = lu(k,1401) - lu(k,402) * lu(k,1343) - lu(k,1404) = lu(k,1404) - lu(k,403) * lu(k,1343) - lu(k,1465) = lu(k,1465) - lu(k,401) * lu(k,1453) - lu(k,1517) = lu(k,1517) - lu(k,402) * lu(k,1453) - lu(k,1520) = lu(k,1520) - lu(k,403) * lu(k,1453) - lu(k,1637) = lu(k,1637) - lu(k,401) * lu(k,1616) - lu(k,1700) = lu(k,1700) - lu(k,402) * lu(k,1616) - lu(k,1703) = lu(k,1703) - lu(k,403) * lu(k,1616) - lu(k,1741) = - lu(k,401) * lu(k,1736) - lu(k,1764) = lu(k,1764) - lu(k,402) * lu(k,1736) - lu(k,1767) = lu(k,1767) - lu(k,403) * lu(k,1736) - lu(k,1891) = lu(k,1891) - lu(k,401) * lu(k,1887) - lu(k,1931) = lu(k,1931) - lu(k,402) * lu(k,1887) - lu(k,1934) = lu(k,1934) - lu(k,403) * lu(k,1887) - lu(k,404) = 1._r8 / lu(k,404) - lu(k,405) = lu(k,405) * lu(k,404) - lu(k,406) = lu(k,406) * lu(k,404) - lu(k,407) = lu(k,407) * lu(k,404) - lu(k,408) = lu(k,408) * lu(k,404) - lu(k,409) = lu(k,409) * lu(k,404) - lu(k,410) = lu(k,410) * lu(k,404) - lu(k,1280) = lu(k,1280) - lu(k,405) * lu(k,1263) - lu(k,1285) = lu(k,1285) - lu(k,406) * lu(k,1263) - lu(k,1286) = lu(k,1286) - lu(k,407) * lu(k,1263) - lu(k,1287) = lu(k,1287) - lu(k,408) * lu(k,1263) - lu(k,1288) = - lu(k,409) * lu(k,1263) - lu(k,1289) = lu(k,1289) - lu(k,410) * lu(k,1263) - lu(k,1690) = lu(k,1690) - lu(k,405) * lu(k,1617) - lu(k,1698) = lu(k,1698) - lu(k,406) * lu(k,1617) - lu(k,1699) = lu(k,1699) - lu(k,407) * lu(k,1617) - lu(k,1700) = lu(k,1700) - lu(k,408) * lu(k,1617) - lu(k,1701) = lu(k,1701) - lu(k,409) * lu(k,1617) - lu(k,1702) = lu(k,1702) - lu(k,410) * lu(k,1617) - lu(k,1754) = lu(k,1754) - lu(k,405) * lu(k,1737) - lu(k,1762) = lu(k,1762) - lu(k,406) * lu(k,1737) - lu(k,1763) = - lu(k,407) * lu(k,1737) - lu(k,1764) = lu(k,1764) - lu(k,408) * lu(k,1737) - lu(k,1765) = lu(k,1765) - lu(k,409) * lu(k,1737) - lu(k,1766) = - lu(k,410) * lu(k,1737) - lu(k,411) = 1._r8 / lu(k,411) - lu(k,412) = lu(k,412) * lu(k,411) - lu(k,413) = lu(k,413) * lu(k,411) - lu(k,414) = lu(k,414) * lu(k,411) - lu(k,415) = lu(k,415) * lu(k,411) - lu(k,416) = lu(k,416) * lu(k,411) - lu(k,417) = lu(k,417) * lu(k,411) - lu(k,968) = lu(k,968) - lu(k,412) * lu(k,965) - lu(k,969) = lu(k,969) - lu(k,413) * lu(k,965) - lu(k,972) = lu(k,972) - lu(k,414) * lu(k,965) - lu(k,980) = lu(k,980) - lu(k,415) * lu(k,965) - lu(k,981) = - lu(k,416) * lu(k,965) - lu(k,982) = lu(k,982) - lu(k,417) * lu(k,965) - lu(k,1486) = lu(k,1486) - lu(k,412) * lu(k,1454) - lu(k,1487) = lu(k,1487) - lu(k,413) * lu(k,1454) - lu(k,1492) = lu(k,1492) - lu(k,414) * lu(k,1454) - lu(k,1513) = lu(k,1513) - lu(k,415) * lu(k,1454) - lu(k,1515) = lu(k,1515) - lu(k,416) * lu(k,1454) - lu(k,1516) = lu(k,1516) - lu(k,417) * lu(k,1454) - lu(k,1664) = lu(k,1664) - lu(k,412) * lu(k,1618) - lu(k,1666) = lu(k,1666) - lu(k,413) * lu(k,1618) - lu(k,1674) = lu(k,1674) - lu(k,414) * lu(k,1618) - lu(k,1696) = lu(k,1696) - lu(k,415) * lu(k,1618) - lu(k,1698) = lu(k,1698) - lu(k,416) * lu(k,1618) - lu(k,1699) = lu(k,1699) - lu(k,417) * lu(k,1618) - lu(k,420) = 1._r8 / lu(k,420) - lu(k,421) = lu(k,421) * lu(k,420) - lu(k,422) = lu(k,422) * lu(k,420) - lu(k,423) = lu(k,423) * lu(k,420) - lu(k,424) = lu(k,424) * lu(k,420) - lu(k,425) = lu(k,425) * lu(k,420) - lu(k,426) = lu(k,426) * lu(k,420) - lu(k,1357) = lu(k,1357) - lu(k,421) * lu(k,1344) - lu(k,1367) = lu(k,1367) - lu(k,422) * lu(k,1344) - lu(k,1395) = lu(k,1395) - lu(k,423) * lu(k,1344) - lu(k,1397) = lu(k,1397) - lu(k,424) * lu(k,1344) - lu(k,1399) = lu(k,1399) - lu(k,425) * lu(k,1344) - lu(k,1401) = lu(k,1401) - lu(k,426) * lu(k,1344) - lu(k,1471) = lu(k,1471) - lu(k,421) * lu(k,1455) - lu(k,1484) = lu(k,1484) - lu(k,422) * lu(k,1455) - lu(k,1511) = lu(k,1511) - lu(k,423) * lu(k,1455) - lu(k,1513) = lu(k,1513) - lu(k,424) * lu(k,1455) - lu(k,1515) = lu(k,1515) - lu(k,425) * lu(k,1455) - lu(k,1517) = lu(k,1517) - lu(k,426) * lu(k,1455) - lu(k,1644) = lu(k,1644) - lu(k,421) * lu(k,1619) - lu(k,1660) = lu(k,1660) - lu(k,422) * lu(k,1619) - lu(k,1694) = lu(k,1694) - lu(k,423) * lu(k,1619) - lu(k,1696) = lu(k,1696) - lu(k,424) * lu(k,1619) - lu(k,1698) = lu(k,1698) - lu(k,425) * lu(k,1619) - lu(k,1700) = lu(k,1700) - lu(k,426) * lu(k,1619) - lu(k,428) = 1._r8 / lu(k,428) - lu(k,429) = lu(k,429) * lu(k,428) - lu(k,430) = lu(k,430) * lu(k,428) - lu(k,431) = lu(k,431) * lu(k,428) - lu(k,432) = lu(k,432) * lu(k,428) - lu(k,433) = lu(k,433) * lu(k,428) - lu(k,434) = lu(k,434) * lu(k,428) - lu(k,1367) = lu(k,1367) - lu(k,429) * lu(k,1345) - lu(k,1385) = lu(k,1385) - lu(k,430) * lu(k,1345) - lu(k,1395) = lu(k,1395) - lu(k,431) * lu(k,1345) - lu(k,1397) = lu(k,1397) - lu(k,432) * lu(k,1345) - lu(k,1399) = lu(k,1399) - lu(k,433) * lu(k,1345) - lu(k,1401) = lu(k,1401) - lu(k,434) * lu(k,1345) - lu(k,1484) = lu(k,1484) - lu(k,429) * lu(k,1456) - lu(k,1501) = lu(k,1501) - lu(k,430) * lu(k,1456) - lu(k,1511) = lu(k,1511) - lu(k,431) * lu(k,1456) - lu(k,1513) = lu(k,1513) - lu(k,432) * lu(k,1456) - lu(k,1515) = lu(k,1515) - lu(k,433) * lu(k,1456) - lu(k,1517) = lu(k,1517) - lu(k,434) * lu(k,1456) - lu(k,1660) = lu(k,1660) - lu(k,429) * lu(k,1620) - lu(k,1683) = lu(k,1683) - lu(k,430) * lu(k,1620) - lu(k,1694) = lu(k,1694) - lu(k,431) * lu(k,1620) - lu(k,1696) = lu(k,1696) - lu(k,432) * lu(k,1620) - lu(k,1698) = lu(k,1698) - lu(k,433) * lu(k,1620) - lu(k,1700) = lu(k,1700) - lu(k,434) * lu(k,1620) - lu(k,435) = 1._r8 / lu(k,435) - lu(k,436) = lu(k,436) * lu(k,435) - lu(k,437) = lu(k,437) * lu(k,435) - lu(k,438) = lu(k,438) * lu(k,435) - lu(k,439) = lu(k,439) * lu(k,435) - lu(k,440) = lu(k,440) * lu(k,435) - lu(k,1250) = lu(k,1250) - lu(k,436) * lu(k,1244) - lu(k,1255) = lu(k,1255) - lu(k,437) * lu(k,1244) - lu(k,1256) = lu(k,1256) - lu(k,438) * lu(k,1244) - lu(k,1259) = lu(k,1259) - lu(k,439) * lu(k,1244) - lu(k,1261) = - lu(k,440) * lu(k,1244) - lu(k,1280) = lu(k,1280) - lu(k,436) * lu(k,1264) - lu(k,1285) = lu(k,1285) - lu(k,437) * lu(k,1264) - lu(k,1286) = lu(k,1286) - lu(k,438) * lu(k,1264) - lu(k,1289) = lu(k,1289) - lu(k,439) * lu(k,1264) - lu(k,1291) = - lu(k,440) * lu(k,1264) - lu(k,1507) = lu(k,1507) - lu(k,436) * lu(k,1457) - lu(k,1515) = lu(k,1515) - lu(k,437) * lu(k,1457) - lu(k,1516) = lu(k,1516) - lu(k,438) * lu(k,1457) - lu(k,1519) = lu(k,1519) - lu(k,439) * lu(k,1457) - lu(k,1525) = lu(k,1525) - lu(k,440) * lu(k,1457) - lu(k,1690) = lu(k,1690) - lu(k,436) * lu(k,1621) - lu(k,1698) = lu(k,1698) - lu(k,437) * lu(k,1621) - lu(k,1699) = lu(k,1699) - lu(k,438) * lu(k,1621) - lu(k,1702) = lu(k,1702) - lu(k,439) * lu(k,1621) - lu(k,1708) = lu(k,1708) - lu(k,440) * lu(k,1621) + lu(k,427) = 1._r8 / lu(k,427) + lu(k,428) = lu(k,428) * lu(k,427) + lu(k,429) = lu(k,429) * lu(k,427) + lu(k,430) = lu(k,430) * lu(k,427) + lu(k,431) = lu(k,431) * lu(k,427) + lu(k,432) = lu(k,432) * lu(k,427) + lu(k,831) = lu(k,831) - lu(k,428) * lu(k,830) + lu(k,832) = lu(k,832) - lu(k,429) * lu(k,830) + lu(k,837) = - lu(k,430) * lu(k,830) + lu(k,839) = lu(k,839) - lu(k,431) * lu(k,830) + lu(k,840) = - lu(k,432) * lu(k,830) + lu(k,1867) = lu(k,1867) - lu(k,428) * lu(k,1819) + lu(k,1880) = lu(k,1880) - lu(k,429) * lu(k,1819) + lu(k,1917) = lu(k,1917) - lu(k,430) * lu(k,1819) + lu(k,1924) = lu(k,1924) - lu(k,431) * lu(k,1819) + lu(k,1927) = lu(k,1927) - lu(k,432) * lu(k,1819) + lu(k,2180) = lu(k,2180) - lu(k,428) * lu(k,2146) + lu(k,2189) = - lu(k,429) * lu(k,2146) + lu(k,2220) = lu(k,2220) - lu(k,430) * lu(k,2146) + lu(k,2227) = lu(k,2227) - lu(k,431) * lu(k,2146) + lu(k,2230) = lu(k,2230) - lu(k,432) * lu(k,2146) + lu(k,433) = 1._r8 / lu(k,433) + lu(k,434) = lu(k,434) * lu(k,433) + lu(k,435) = lu(k,435) * lu(k,433) + lu(k,436) = lu(k,436) * lu(k,433) + lu(k,437) = lu(k,437) * lu(k,433) + lu(k,438) = lu(k,438) * lu(k,433) + lu(k,1226) = - lu(k,434) * lu(k,1224) + lu(k,1228) = - lu(k,435) * lu(k,1224) + lu(k,1241) = lu(k,1241) - lu(k,436) * lu(k,1224) + lu(k,1242) = - lu(k,437) * lu(k,1224) + lu(k,1246) = lu(k,1246) - lu(k,438) * lu(k,1224) + lu(k,1858) = lu(k,1858) - lu(k,434) * lu(k,1820) + lu(k,1873) = lu(k,1873) - lu(k,435) * lu(k,1820) + lu(k,1915) = lu(k,1915) - lu(k,436) * lu(k,1820) + lu(k,1917) = lu(k,1917) - lu(k,437) * lu(k,1820) + lu(k,1924) = lu(k,1924) - lu(k,438) * lu(k,1820) + lu(k,2171) = lu(k,2171) - lu(k,434) * lu(k,2147) + lu(k,2185) = - lu(k,435) * lu(k,2147) + lu(k,2218) = lu(k,2218) - lu(k,436) * lu(k,2147) + lu(k,2220) = lu(k,2220) - lu(k,437) * lu(k,2147) + lu(k,2227) = lu(k,2227) - lu(k,438) * lu(k,2147) + lu(k,439) = 1._r8 / lu(k,439) + lu(k,440) = lu(k,440) * lu(k,439) + lu(k,441) = lu(k,441) * lu(k,439) + lu(k,442) = lu(k,442) * lu(k,439) + lu(k,443) = lu(k,443) * lu(k,439) + lu(k,444) = lu(k,444) * lu(k,439) + lu(k,1228) = lu(k,1228) - lu(k,440) * lu(k,1225) + lu(k,1231) = - lu(k,441) * lu(k,1225) + lu(k,1238) = - lu(k,442) * lu(k,1225) + lu(k,1242) = lu(k,1242) - lu(k,443) * lu(k,1225) + lu(k,1246) = lu(k,1246) - lu(k,444) * lu(k,1225) + lu(k,1629) = - lu(k,440) * lu(k,1621) + lu(k,1639) = lu(k,1639) - lu(k,441) * lu(k,1621) + lu(k,1654) = - lu(k,442) * lu(k,1621) + lu(k,1660) = lu(k,1660) - lu(k,443) * lu(k,1621) + lu(k,1667) = lu(k,1667) - lu(k,444) * lu(k,1621) + lu(k,1873) = lu(k,1873) - lu(k,440) * lu(k,1821) + lu(k,1892) = lu(k,1892) - lu(k,441) * lu(k,1821) + lu(k,1911) = lu(k,1911) - lu(k,442) * lu(k,1821) + lu(k,1917) = lu(k,1917) - lu(k,443) * lu(k,1821) + lu(k,1924) = lu(k,1924) - lu(k,444) * lu(k,1821) + lu(k,445) = 1._r8 / lu(k,445) + lu(k,446) = lu(k,446) * lu(k,445) + lu(k,447) = lu(k,447) * lu(k,445) + lu(k,448) = lu(k,448) * lu(k,445) + lu(k,449) = lu(k,449) * lu(k,445) + lu(k,450) = lu(k,450) * lu(k,445) + lu(k,1702) = lu(k,1702) - lu(k,446) * lu(k,1674) + lu(k,1704) = lu(k,1704) - lu(k,447) * lu(k,1674) + lu(k,1709) = lu(k,1709) - lu(k,448) * lu(k,1674) + lu(k,1711) = lu(k,1711) - lu(k,449) * lu(k,1674) + lu(k,1714) = - lu(k,450) * lu(k,1674) + lu(k,1915) = lu(k,1915) - lu(k,446) * lu(k,1822) + lu(k,1917) = lu(k,1917) - lu(k,447) * lu(k,1822) + lu(k,1922) = lu(k,1922) - lu(k,448) * lu(k,1822) + lu(k,1924) = lu(k,1924) - lu(k,449) * lu(k,1822) + lu(k,1927) = lu(k,1927) - lu(k,450) * lu(k,1822) + lu(k,2218) = lu(k,2218) - lu(k,446) * lu(k,2148) + lu(k,2220) = lu(k,2220) - lu(k,447) * lu(k,2148) + lu(k,2225) = lu(k,2225) - lu(k,448) * lu(k,2148) + lu(k,2227) = lu(k,2227) - lu(k,449) * lu(k,2148) + lu(k,2230) = lu(k,2230) - lu(k,450) * lu(k,2148) + lu(k,451) = 1._r8 / lu(k,451) + lu(k,452) = lu(k,452) * lu(k,451) + lu(k,453) = lu(k,453) * lu(k,451) + lu(k,454) = lu(k,454) * lu(k,451) + lu(k,455) = lu(k,455) * lu(k,451) + lu(k,456) = lu(k,456) * lu(k,451) + lu(k,1655) = - lu(k,452) * lu(k,1622) + lu(k,1657) = lu(k,1657) - lu(k,453) * lu(k,1622) + lu(k,1660) = lu(k,1660) - lu(k,454) * lu(k,1622) + lu(k,1664) = lu(k,1664) - lu(k,455) * lu(k,1622) + lu(k,1670) = - lu(k,456) * lu(k,1622) + lu(k,1912) = lu(k,1912) - lu(k,452) * lu(k,1823) + lu(k,1914) = lu(k,1914) - lu(k,453) * lu(k,1823) + lu(k,1917) = lu(k,1917) - lu(k,454) * lu(k,1823) + lu(k,1921) = lu(k,1921) - lu(k,455) * lu(k,1823) + lu(k,1927) = lu(k,1927) - lu(k,456) * lu(k,1823) + lu(k,2215) = lu(k,2215) - lu(k,452) * lu(k,2149) + lu(k,2217) = lu(k,2217) - lu(k,453) * lu(k,2149) + lu(k,2220) = lu(k,2220) - lu(k,454) * lu(k,2149) + lu(k,2224) = lu(k,2224) - lu(k,455) * lu(k,2149) + lu(k,2230) = lu(k,2230) - lu(k,456) * lu(k,2149) + lu(k,457) = 1._r8 / lu(k,457) + lu(k,458) = lu(k,458) * lu(k,457) + lu(k,459) = lu(k,459) * lu(k,457) + lu(k,460) = lu(k,460) * lu(k,457) + lu(k,461) = lu(k,461) * lu(k,457) + lu(k,462) = lu(k,462) * lu(k,457) + lu(k,1737) = lu(k,1737) - lu(k,458) * lu(k,1731) + lu(k,1744) = lu(k,1744) - lu(k,459) * lu(k,1731) + lu(k,1745) = lu(k,1745) - lu(k,460) * lu(k,1731) + lu(k,1747) = lu(k,1747) - lu(k,461) * lu(k,1731) + lu(k,1753) = lu(k,1753) - lu(k,462) * lu(k,1731) + lu(k,1909) = lu(k,1909) - lu(k,458) * lu(k,1824) + lu(k,1916) = lu(k,1916) - lu(k,459) * lu(k,1824) + lu(k,1917) = lu(k,1917) - lu(k,460) * lu(k,1824) + lu(k,1919) = lu(k,1919) - lu(k,461) * lu(k,1824) + lu(k,1925) = lu(k,1925) - lu(k,462) * lu(k,1824) + lu(k,2251) = lu(k,2251) - lu(k,458) * lu(k,2235) + lu(k,2258) = - lu(k,459) * lu(k,2235) + lu(k,2259) = lu(k,2259) - lu(k,460) * lu(k,2235) + lu(k,2261) = lu(k,2261) - lu(k,461) * lu(k,2235) + lu(k,2267) = lu(k,2267) - lu(k,462) * lu(k,2235) end do end subroutine lu_fac09 subroutine lu_fac10( avec_len, lu ) @@ -1242,166 +1116,151 @@ subroutine lu_fac10( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,441) = 1._r8 / lu(k,441) - lu(k,442) = lu(k,442) * lu(k,441) - lu(k,443) = lu(k,443) * lu(k,441) - lu(k,444) = lu(k,444) * lu(k,441) - lu(k,445) = lu(k,445) * lu(k,441) - lu(k,446) = lu(k,446) * lu(k,441) - lu(k,1127) = lu(k,1127) - lu(k,442) * lu(k,1125) - lu(k,1129) = lu(k,1129) - lu(k,443) * lu(k,1125) - lu(k,1132) = lu(k,1132) - lu(k,444) * lu(k,1125) - lu(k,1134) = lu(k,1134) - lu(k,445) * lu(k,1125) - lu(k,1137) = lu(k,1137) - lu(k,446) * lu(k,1125) - lu(k,1684) = lu(k,1684) - lu(k,442) * lu(k,1622) - lu(k,1693) = lu(k,1693) - lu(k,443) * lu(k,1622) - lu(k,1698) = lu(k,1698) - lu(k,444) * lu(k,1622) - lu(k,1703) = lu(k,1703) - lu(k,445) * lu(k,1622) - lu(k,1706) = lu(k,1706) - lu(k,446) * lu(k,1622) - lu(k,1915) = lu(k,1915) - lu(k,442) * lu(k,1888) - lu(k,1924) = lu(k,1924) - lu(k,443) * lu(k,1888) - lu(k,1929) = lu(k,1929) - lu(k,444) * lu(k,1888) - lu(k,1934) = lu(k,1934) - lu(k,445) * lu(k,1888) - lu(k,1937) = lu(k,1937) - lu(k,446) * lu(k,1888) - lu(k,2001) = lu(k,2001) - lu(k,442) * lu(k,1991) - lu(k,2004) = lu(k,2004) - lu(k,443) * lu(k,1991) - lu(k,2009) = lu(k,2009) - lu(k,444) * lu(k,1991) - lu(k,2014) = lu(k,2014) - lu(k,445) * lu(k,1991) - lu(k,2017) = lu(k,2017) - lu(k,446) * lu(k,1991) - lu(k,447) = 1._r8 / lu(k,447) - lu(k,448) = lu(k,448) * lu(k,447) - lu(k,449) = lu(k,449) * lu(k,447) - lu(k,450) = lu(k,450) * lu(k,447) - lu(k,451) = lu(k,451) * lu(k,447) - lu(k,567) = - lu(k,448) * lu(k,565) - lu(k,568) = - lu(k,449) * lu(k,565) - lu(k,571) = - lu(k,450) * lu(k,565) - lu(k,573) = lu(k,573) - lu(k,451) * lu(k,565) - lu(k,578) = - lu(k,448) * lu(k,576) - lu(k,579) = - lu(k,449) * lu(k,576) - lu(k,583) = - lu(k,450) * lu(k,576) - lu(k,585) = lu(k,585) - lu(k,451) * lu(k,576) - lu(k,851) = - lu(k,448) * lu(k,848) - lu(k,852) = - lu(k,449) * lu(k,848) - lu(k,856) = - lu(k,450) * lu(k,848) - lu(k,859) = - lu(k,451) * lu(k,848) - lu(k,1355) = lu(k,1355) - lu(k,448) * lu(k,1346) - lu(k,1364) = lu(k,1364) - lu(k,449) * lu(k,1346) - lu(k,1391) = lu(k,1391) - lu(k,450) * lu(k,1346) - lu(k,1399) = lu(k,1399) - lu(k,451) * lu(k,1346) - lu(k,1640) = lu(k,1640) - lu(k,448) * lu(k,1623) - lu(k,1655) = lu(k,1655) - lu(k,449) * lu(k,1623) - lu(k,1690) = lu(k,1690) - lu(k,450) * lu(k,1623) - lu(k,1698) = lu(k,1698) - lu(k,451) * lu(k,1623) - lu(k,453) = 1._r8 / lu(k,453) - lu(k,454) = lu(k,454) * lu(k,453) - lu(k,455) = lu(k,455) * lu(k,453) - lu(k,456) = lu(k,456) * lu(k,453) - lu(k,457) = lu(k,457) * lu(k,453) - lu(k,458) = lu(k,458) * lu(k,453) - lu(k,1353) = lu(k,1353) - lu(k,454) * lu(k,1347) - lu(k,1395) = lu(k,1395) - lu(k,455) * lu(k,1347) - lu(k,1397) = lu(k,1397) - lu(k,456) * lu(k,1347) - lu(k,1399) = lu(k,1399) - lu(k,457) * lu(k,1347) - lu(k,1401) = lu(k,1401) - lu(k,458) * lu(k,1347) - lu(k,1465) = lu(k,1465) - lu(k,454) * lu(k,1458) - lu(k,1511) = lu(k,1511) - lu(k,455) * lu(k,1458) - lu(k,1513) = lu(k,1513) - lu(k,456) * lu(k,1458) - lu(k,1515) = lu(k,1515) - lu(k,457) * lu(k,1458) - lu(k,1517) = lu(k,1517) - lu(k,458) * lu(k,1458) - lu(k,1637) = lu(k,1637) - lu(k,454) * lu(k,1624) - lu(k,1694) = lu(k,1694) - lu(k,455) * lu(k,1624) - lu(k,1696) = lu(k,1696) - lu(k,456) * lu(k,1624) - lu(k,1698) = lu(k,1698) - lu(k,457) * lu(k,1624) - lu(k,1700) = lu(k,1700) - lu(k,458) * lu(k,1624) - lu(k,1741) = lu(k,1741) - lu(k,454) * lu(k,1738) - lu(k,1758) = lu(k,1758) - lu(k,455) * lu(k,1738) - lu(k,1760) = lu(k,1760) - lu(k,456) * lu(k,1738) - lu(k,1762) = lu(k,1762) - lu(k,457) * lu(k,1738) - lu(k,1764) = lu(k,1764) - lu(k,458) * lu(k,1738) - 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,465) = lu(k,465) * lu(k,459) - lu(k,466) = lu(k,466) * lu(k,459) - lu(k,674) = lu(k,674) - lu(k,460) * lu(k,673) - lu(k,675) = - lu(k,461) * lu(k,673) - lu(k,676) = lu(k,676) - lu(k,462) * lu(k,673) - lu(k,678) = lu(k,678) - lu(k,463) * lu(k,673) - lu(k,679) = - lu(k,464) * lu(k,673) - lu(k,680) = lu(k,680) - lu(k,465) * lu(k,673) - lu(k,682) = - lu(k,466) * lu(k,673) - lu(k,1475) = lu(k,1475) - lu(k,460) * lu(k,1459) - lu(k,1491) = - lu(k,461) * lu(k,1459) - lu(k,1496) = lu(k,1496) - lu(k,462) * lu(k,1459) - lu(k,1513) = lu(k,1513) - lu(k,463) * lu(k,1459) - lu(k,1515) = lu(k,1515) - lu(k,464) * lu(k,1459) - lu(k,1516) = lu(k,1516) - lu(k,465) * lu(k,1459) - lu(k,1525) = lu(k,1525) - lu(k,466) * lu(k,1459) - lu(k,1648) = lu(k,1648) - lu(k,460) * lu(k,1625) - lu(k,1673) = lu(k,1673) - lu(k,461) * lu(k,1625) - lu(k,1678) = lu(k,1678) - lu(k,462) * lu(k,1625) - lu(k,1696) = lu(k,1696) - lu(k,463) * lu(k,1625) - lu(k,1698) = lu(k,1698) - lu(k,464) * lu(k,1625) - lu(k,1699) = lu(k,1699) - lu(k,465) * lu(k,1625) - lu(k,1708) = lu(k,1708) - lu(k,466) * lu(k,1625) - 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,901) = lu(k,901) - lu(k,468) * lu(k,889) - lu(k,905) = lu(k,905) - lu(k,469) * lu(k,889) - lu(k,907) = - lu(k,470) * lu(k,889) - lu(k,1255) = lu(k,1255) - lu(k,468) * lu(k,1245) - lu(k,1259) = lu(k,1259) - lu(k,469) * lu(k,1245) - lu(k,1261) = lu(k,1261) - lu(k,470) * lu(k,1245) - lu(k,1285) = lu(k,1285) - lu(k,468) * lu(k,1265) - lu(k,1289) = lu(k,1289) - lu(k,469) * lu(k,1265) - lu(k,1291) = lu(k,1291) - lu(k,470) * lu(k,1265) - lu(k,1515) = lu(k,1515) - lu(k,468) * lu(k,1460) - lu(k,1519) = lu(k,1519) - lu(k,469) * lu(k,1460) - lu(k,1525) = lu(k,1525) - lu(k,470) * lu(k,1460) - lu(k,1698) = lu(k,1698) - lu(k,468) * lu(k,1626) - lu(k,1702) = lu(k,1702) - lu(k,469) * lu(k,1626) - lu(k,1708) = lu(k,1708) - lu(k,470) * lu(k,1626) - lu(k,1869) = lu(k,1869) - lu(k,468) * lu(k,1834) - lu(k,1873) = lu(k,1873) - lu(k,469) * lu(k,1834) - lu(k,1879) = lu(k,1879) - lu(k,470) * lu(k,1834) - lu(k,1929) = lu(k,1929) - lu(k,468) * lu(k,1889) - lu(k,1933) = lu(k,1933) - lu(k,469) * lu(k,1889) - lu(k,1939) = - lu(k,470) * lu(k,1889) - lu(k,471) = 1._r8 / lu(k,471) - lu(k,472) = lu(k,472) * lu(k,471) - lu(k,473) = lu(k,473) * lu(k,471) - lu(k,474) = lu(k,474) * lu(k,471) - lu(k,475) = lu(k,475) * lu(k,471) - lu(k,476) = lu(k,476) * lu(k,471) - lu(k,477) = lu(k,477) * lu(k,471) - lu(k,478) = lu(k,478) * lu(k,471) - lu(k,1216) = - lu(k,472) * lu(k,1212) - lu(k,1219) = lu(k,1219) - lu(k,473) * lu(k,1212) - lu(k,1220) = - lu(k,474) * lu(k,1212) - lu(k,1222) = lu(k,1222) - lu(k,475) * lu(k,1212) - lu(k,1233) = - lu(k,476) * lu(k,1212) - lu(k,1236) = lu(k,1236) - lu(k,477) * lu(k,1212) - lu(k,1237) = lu(k,1237) - lu(k,478) * lu(k,1212) - lu(k,1365) = - lu(k,472) * lu(k,1348) - lu(k,1372) = lu(k,1372) - lu(k,473) * lu(k,1348) - lu(k,1373) = lu(k,1373) - lu(k,474) * lu(k,1348) - lu(k,1376) = lu(k,1376) - lu(k,475) * lu(k,1348) - lu(k,1393) = lu(k,1393) - lu(k,476) * lu(k,1348) - lu(k,1397) = lu(k,1397) - lu(k,477) * lu(k,1348) - lu(k,1399) = lu(k,1399) - lu(k,478) * lu(k,1348) - lu(k,1656) = lu(k,1656) - lu(k,472) * lu(k,1627) - lu(k,1669) = lu(k,1669) - lu(k,473) * lu(k,1627) - lu(k,1670) = lu(k,1670) - lu(k,474) * lu(k,1627) - lu(k,1673) = lu(k,1673) - lu(k,475) * lu(k,1627) - lu(k,1692) = lu(k,1692) - lu(k,476) * lu(k,1627) - lu(k,1696) = lu(k,1696) - lu(k,477) * lu(k,1627) - lu(k,1698) = lu(k,1698) - lu(k,478) * lu(k,1627) + lu(k,463) = 1._r8 / lu(k,463) + lu(k,464) = lu(k,464) * lu(k,463) + lu(k,465) = lu(k,465) * lu(k,463) + lu(k,466) = lu(k,466) * lu(k,463) + lu(k,467) = lu(k,467) * lu(k,463) + lu(k,468) = lu(k,468) * lu(k,463) + lu(k,1100) = lu(k,1100) - lu(k,464) * lu(k,1097) + lu(k,1101) = lu(k,1101) - lu(k,465) * lu(k,1097) + lu(k,1105) = - lu(k,466) * lu(k,1097) + lu(k,1108) = lu(k,1108) - lu(k,467) * lu(k,1097) + lu(k,1109) = - lu(k,468) * lu(k,1097) + lu(k,1884) = lu(k,1884) - lu(k,464) * lu(k,1825) + lu(k,1888) = lu(k,1888) - lu(k,465) * lu(k,1825) + lu(k,1911) = lu(k,1911) - lu(k,466) * lu(k,1825) + lu(k,1915) = lu(k,1915) - lu(k,467) * lu(k,1825) + lu(k,1917) = lu(k,1917) - lu(k,468) * lu(k,1825) + lu(k,2192) = - lu(k,464) * lu(k,2150) + lu(k,2193) = lu(k,2193) - lu(k,465) * lu(k,2150) + lu(k,2214) = - lu(k,466) * lu(k,2150) + lu(k,2218) = lu(k,2218) - lu(k,467) * lu(k,2150) + lu(k,2220) = lu(k,2220) - lu(k,468) * lu(k,2150) + lu(k,469) = 1._r8 / lu(k,469) + lu(k,470) = lu(k,470) * lu(k,469) + lu(k,471) = lu(k,471) * lu(k,469) + lu(k,472) = lu(k,472) * lu(k,469) + lu(k,473) = lu(k,473) * lu(k,469) + lu(k,474) = lu(k,474) * lu(k,469) + lu(k,541) = lu(k,541) - lu(k,470) * lu(k,540) + lu(k,542) = lu(k,542) - lu(k,471) * lu(k,540) + lu(k,543) = lu(k,543) - lu(k,472) * lu(k,540) + lu(k,546) = - lu(k,473) * lu(k,540) + lu(k,547) = lu(k,547) - lu(k,474) * lu(k,540) + lu(k,1835) = lu(k,1835) - lu(k,470) * lu(k,1826) + lu(k,1881) = lu(k,1881) - lu(k,471) * lu(k,1826) + lu(k,1900) = lu(k,1900) - lu(k,472) * lu(k,1826) + lu(k,1917) = lu(k,1917) - lu(k,473) * lu(k,1826) + lu(k,1924) = lu(k,1924) - lu(k,474) * lu(k,1826) + lu(k,2159) = lu(k,2159) - lu(k,470) * lu(k,2151) + lu(k,2190) = lu(k,2190) - lu(k,471) * lu(k,2151) + lu(k,2204) = lu(k,2204) - lu(k,472) * lu(k,2151) + lu(k,2220) = lu(k,2220) - lu(k,473) * lu(k,2151) + lu(k,2227) = lu(k,2227) - lu(k,474) * lu(k,2151) + 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,1554) = lu(k,1554) - lu(k,478) * lu(k,1545) + lu(k,1604) = lu(k,1604) - lu(k,479) * lu(k,1545) + lu(k,1606) = lu(k,1606) - lu(k,480) * lu(k,1545) + lu(k,1608) = lu(k,1608) - lu(k,481) * lu(k,1545) + lu(k,1615) = lu(k,1615) - lu(k,482) * lu(k,1545) + lu(k,1837) = lu(k,1837) - lu(k,478) * lu(k,1827) + lu(k,1913) = lu(k,1913) - lu(k,479) * lu(k,1827) + lu(k,1915) = lu(k,1915) - lu(k,480) * lu(k,1827) + lu(k,1917) = lu(k,1917) - lu(k,481) * lu(k,1827) + lu(k,1924) = lu(k,1924) - lu(k,482) * lu(k,1827) + lu(k,2160) = lu(k,2160) - lu(k,478) * lu(k,2152) + lu(k,2216) = lu(k,2216) - lu(k,479) * lu(k,2152) + lu(k,2218) = lu(k,2218) - lu(k,480) * lu(k,2152) + lu(k,2220) = lu(k,2220) - lu(k,481) * lu(k,2152) + lu(k,2227) = lu(k,2227) - lu(k,482) * lu(k,2152) + lu(k,483) = 1._r8 / lu(k,483) + lu(k,484) = lu(k,484) * lu(k,483) + lu(k,485) = lu(k,485) * lu(k,483) + lu(k,486) = lu(k,486) * lu(k,483) + lu(k,487) = lu(k,487) * lu(k,483) + lu(k,488) = lu(k,488) * lu(k,483) + lu(k,987) = - lu(k,484) * lu(k,982) + lu(k,994) = lu(k,994) - lu(k,485) * lu(k,982) + lu(k,996) = - lu(k,486) * lu(k,982) + lu(k,997) = lu(k,997) - lu(k,487) * lu(k,982) + lu(k,1006) = lu(k,1006) - lu(k,488) * lu(k,982) + lu(k,1036) = - lu(k,484) * lu(k,1031) + lu(k,1043) = lu(k,1043) - lu(k,485) * lu(k,1031) + lu(k,1046) = - lu(k,486) * lu(k,1031) + lu(k,1047) = lu(k,1047) - lu(k,487) * lu(k,1031) + lu(k,1056) = lu(k,1056) - lu(k,488) * lu(k,1031) + lu(k,2288) = - lu(k,484) * lu(k,2276) + lu(k,2297) = lu(k,2297) - lu(k,485) * lu(k,2276) + lu(k,2304) = lu(k,2304) - lu(k,486) * lu(k,2276) + lu(k,2311) = lu(k,2311) - lu(k,487) * lu(k,2276) + lu(k,2327) = lu(k,2327) - lu(k,488) * lu(k,2276) + lu(k,489) = 1._r8 / lu(k,489) + lu(k,490) = lu(k,490) * lu(k,489) + lu(k,491) = lu(k,491) * lu(k,489) + lu(k,492) = lu(k,492) * lu(k,489) + lu(k,493) = lu(k,493) * lu(k,489) + lu(k,494) = lu(k,494) * lu(k,489) + lu(k,1578) = lu(k,1578) - lu(k,490) * lu(k,1546) + lu(k,1604) = lu(k,1604) - lu(k,491) * lu(k,1546) + lu(k,1606) = lu(k,1606) - lu(k,492) * lu(k,1546) + lu(k,1612) = lu(k,1612) - lu(k,493) * lu(k,1546) + lu(k,1615) = lu(k,1615) - lu(k,494) * lu(k,1546) + lu(k,2009) = - lu(k,490) * lu(k,2007) + lu(k,2016) = - lu(k,491) * lu(k,2007) + lu(k,2018) = - lu(k,492) * lu(k,2007) + lu(k,2024) = lu(k,2024) - lu(k,493) * lu(k,2007) + lu(k,2027) = lu(k,2027) - lu(k,494) * lu(k,2007) + lu(k,2191) = lu(k,2191) - lu(k,490) * lu(k,2153) + lu(k,2216) = lu(k,2216) - lu(k,491) * lu(k,2153) + lu(k,2218) = lu(k,2218) - lu(k,492) * lu(k,2153) + lu(k,2224) = lu(k,2224) - lu(k,493) * lu(k,2153) + lu(k,2227) = lu(k,2227) - lu(k,494) * lu(k,2153) + lu(k,496) = 1._r8 / lu(k,496) + lu(k,497) = lu(k,497) * lu(k,496) + lu(k,498) = lu(k,498) * lu(k,496) + lu(k,499) = lu(k,499) * lu(k,496) + lu(k,500) = lu(k,500) * lu(k,496) + lu(k,501) = lu(k,501) * lu(k,496) + lu(k,1577) = lu(k,1577) - lu(k,497) * lu(k,1547) + lu(k,1604) = lu(k,1604) - lu(k,498) * lu(k,1547) + lu(k,1606) = lu(k,1606) - lu(k,499) * lu(k,1547) + lu(k,1608) = lu(k,1608) - lu(k,500) * lu(k,1547) + lu(k,1615) = lu(k,1615) - lu(k,501) * lu(k,1547) + lu(k,1881) = lu(k,1881) - lu(k,497) * lu(k,1828) + lu(k,1913) = lu(k,1913) - lu(k,498) * lu(k,1828) + lu(k,1915) = lu(k,1915) - lu(k,499) * lu(k,1828) + lu(k,1917) = lu(k,1917) - lu(k,500) * lu(k,1828) + lu(k,1924) = lu(k,1924) - lu(k,501) * lu(k,1828) + lu(k,2190) = lu(k,2190) - lu(k,497) * lu(k,2154) + lu(k,2216) = lu(k,2216) - lu(k,498) * lu(k,2154) + lu(k,2218) = lu(k,2218) - lu(k,499) * lu(k,2154) + lu(k,2220) = lu(k,2220) - lu(k,500) * lu(k,2154) + lu(k,2227) = lu(k,2227) - lu(k,501) * lu(k,2154) + lu(k,502) = 1._r8 / lu(k,502) + lu(k,503) = lu(k,503) * lu(k,502) + lu(k,504) = lu(k,504) * lu(k,502) + lu(k,534) = - lu(k,503) * lu(k,532) + lu(k,539) = lu(k,539) - lu(k,504) * lu(k,532) + lu(k,650) = - lu(k,503) * lu(k,647) + lu(k,656) = lu(k,656) - lu(k,504) * lu(k,647) + lu(k,742) = - lu(k,503) * lu(k,739) + lu(k,751) = lu(k,751) - lu(k,504) * lu(k,739) + lu(k,771) = - lu(k,503) * lu(k,768) + lu(k,781) = lu(k,781) - lu(k,504) * lu(k,768) + lu(k,787) = - lu(k,503) * lu(k,784) + lu(k,798) = lu(k,798) - lu(k,504) * lu(k,784) + lu(k,1564) = lu(k,1564) - lu(k,503) * lu(k,1548) + lu(k,1615) = lu(k,1615) - lu(k,504) * lu(k,1548) + lu(k,1861) = - lu(k,503) * lu(k,1829) + lu(k,1924) = lu(k,1924) - lu(k,504) * lu(k,1829) + lu(k,2174) = lu(k,2174) - lu(k,503) * lu(k,2155) + lu(k,2227) = lu(k,2227) - lu(k,504) * lu(k,2155) end do end subroutine lu_fac10 subroutine lu_fac11( avec_len, lu ) @@ -1418,155 +1277,178 @@ subroutine lu_fac11( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,479) = 1._r8 / lu(k,479) - lu(k,480) = lu(k,480) * lu(k,479) - lu(k,481) = lu(k,481) * lu(k,479) - lu(k,482) = lu(k,482) * lu(k,479) - lu(k,483) = lu(k,483) * lu(k,479) - lu(k,484) = lu(k,484) * lu(k,479) - lu(k,485) = lu(k,485) * lu(k,479) - lu(k,486) = lu(k,486) * lu(k,479) - lu(k,1247) = - lu(k,480) * lu(k,1246) - lu(k,1249) = lu(k,1249) - lu(k,481) * lu(k,1246) - lu(k,1254) = lu(k,1254) - lu(k,482) * lu(k,1246) - lu(k,1255) = lu(k,1255) - lu(k,483) * lu(k,1246) - lu(k,1256) = lu(k,1256) - lu(k,484) * lu(k,1246) - lu(k,1257) = lu(k,1257) - lu(k,485) * lu(k,1246) - lu(k,1258) = lu(k,1258) - lu(k,486) * lu(k,1246) - lu(k,1673) = lu(k,1673) - lu(k,480) * lu(k,1628) - lu(k,1689) = lu(k,1689) - lu(k,481) * lu(k,1628) - lu(k,1696) = lu(k,1696) - lu(k,482) * lu(k,1628) - lu(k,1698) = lu(k,1698) - lu(k,483) * lu(k,1628) - lu(k,1699) = lu(k,1699) - lu(k,484) * lu(k,1628) - lu(k,1700) = lu(k,1700) - lu(k,485) * lu(k,1628) - lu(k,1701) = lu(k,1701) - lu(k,486) * lu(k,1628) - lu(k,1750) = - lu(k,480) * lu(k,1739) - lu(k,1753) = lu(k,1753) - lu(k,481) * lu(k,1739) - lu(k,1760) = lu(k,1760) - lu(k,482) * lu(k,1739) - lu(k,1762) = lu(k,1762) - lu(k,483) * lu(k,1739) - lu(k,1763) = lu(k,1763) - lu(k,484) * lu(k,1739) - lu(k,1764) = lu(k,1764) - lu(k,485) * lu(k,1739) - lu(k,1765) = lu(k,1765) - lu(k,486) * lu(k,1739) - lu(k,487) = 1._r8 / lu(k,487) - lu(k,488) = lu(k,488) * lu(k,487) - lu(k,489) = lu(k,489) * lu(k,487) - lu(k,490) = lu(k,490) * lu(k,487) - lu(k,491) = lu(k,491) * lu(k,487) - lu(k,492) = lu(k,492) * lu(k,487) - lu(k,493) = lu(k,493) * lu(k,487) - lu(k,494) = lu(k,494) * lu(k,487) - lu(k,1643) = lu(k,1643) - lu(k,488) * lu(k,1629) - lu(k,1651) = lu(k,1651) - lu(k,489) * lu(k,1629) - lu(k,1672) = lu(k,1672) - lu(k,490) * lu(k,1629) - lu(k,1696) = lu(k,1696) - lu(k,491) * lu(k,1629) - lu(k,1698) = lu(k,1698) - lu(k,492) * lu(k,1629) - lu(k,1699) = lu(k,1699) - lu(k,493) * lu(k,1629) - lu(k,1703) = lu(k,1703) - lu(k,494) * lu(k,1629) - lu(k,1892) = - lu(k,488) * lu(k,1890) - lu(k,1893) = lu(k,1893) - lu(k,489) * lu(k,1890) - lu(k,1905) = lu(k,1905) - lu(k,490) * lu(k,1890) - lu(k,1927) = lu(k,1927) - lu(k,491) * lu(k,1890) - lu(k,1929) = lu(k,1929) - lu(k,492) * lu(k,1890) - lu(k,1930) = lu(k,1930) - lu(k,493) * lu(k,1890) - lu(k,1934) = lu(k,1934) - lu(k,494) * lu(k,1890) - lu(k,2025) = - lu(k,488) * lu(k,2023) - lu(k,2026) = lu(k,2026) - lu(k,489) * lu(k,2023) - lu(k,2032) = lu(k,2032) - lu(k,490) * lu(k,2023) - lu(k,2041) = lu(k,2041) - lu(k,491) * lu(k,2023) - lu(k,2043) = lu(k,2043) - lu(k,492) * lu(k,2023) - lu(k,2044) = lu(k,2044) - lu(k,493) * lu(k,2023) - lu(k,2048) = lu(k,2048) - lu(k,494) * lu(k,2023) - lu(k,495) = 1._r8 / lu(k,495) - lu(k,496) = lu(k,496) * lu(k,495) - lu(k,497) = lu(k,497) * lu(k,495) - lu(k,498) = lu(k,498) * lu(k,495) - lu(k,499) = lu(k,499) * lu(k,495) - lu(k,500) = lu(k,500) * lu(k,495) - lu(k,501) = lu(k,501) * lu(k,495) - lu(k,502) = lu(k,502) * lu(k,495) - lu(k,1369) = lu(k,1369) - lu(k,496) * lu(k,1349) - lu(k,1373) = lu(k,1373) - lu(k,497) * lu(k,1349) - lu(k,1381) = lu(k,1381) - lu(k,498) * lu(k,1349) - lu(k,1395) = lu(k,1395) - lu(k,499) * lu(k,1349) - lu(k,1397) = lu(k,1397) - lu(k,500) * lu(k,1349) - lu(k,1400) = lu(k,1400) - lu(k,501) * lu(k,1349) - lu(k,1401) = lu(k,1401) - lu(k,502) * lu(k,1349) - lu(k,1664) = lu(k,1664) - lu(k,496) * lu(k,1630) - lu(k,1670) = lu(k,1670) - lu(k,497) * lu(k,1630) - lu(k,1678) = lu(k,1678) - lu(k,498) * lu(k,1630) - lu(k,1694) = lu(k,1694) - lu(k,499) * lu(k,1630) - lu(k,1696) = lu(k,1696) - lu(k,500) * lu(k,1630) - lu(k,1699) = lu(k,1699) - lu(k,501) * lu(k,1630) - lu(k,1700) = lu(k,1700) - lu(k,502) * lu(k,1630) - lu(k,1787) = lu(k,1787) - lu(k,496) * lu(k,1779) - lu(k,1792) = - lu(k,497) * lu(k,1779) - lu(k,1800) = lu(k,1800) - lu(k,498) * lu(k,1779) - lu(k,1815) = lu(k,1815) - lu(k,499) * lu(k,1779) - lu(k,1817) = lu(k,1817) - lu(k,500) * lu(k,1779) - lu(k,1820) = lu(k,1820) - lu(k,501) * lu(k,1779) - lu(k,1821) = lu(k,1821) - lu(k,502) * lu(k,1779) - 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,509) = lu(k,509) * lu(k,503) - lu(k,510) = lu(k,510) * lu(k,503) - lu(k,1744) = - lu(k,504) * lu(k,1740) - lu(k,1755) = - lu(k,505) * lu(k,1740) - lu(k,1756) = lu(k,1756) - lu(k,506) * lu(k,1740) - lu(k,1764) = lu(k,1764) - lu(k,507) * lu(k,1740) - lu(k,1765) = lu(k,1765) - lu(k,508) * lu(k,1740) - lu(k,1768) = lu(k,1768) - lu(k,509) * lu(k,1740) - lu(k,1770) = lu(k,1770) - lu(k,510) * lu(k,1740) - lu(k,1943) = lu(k,1943) - lu(k,504) * lu(k,1942) - lu(k,1946) = lu(k,1946) - lu(k,505) * lu(k,1942) - lu(k,1947) = - lu(k,506) * lu(k,1942) - lu(k,1955) = lu(k,1955) - lu(k,507) * lu(k,1942) - lu(k,1956) = - lu(k,508) * lu(k,1942) - lu(k,1959) = lu(k,1959) - lu(k,509) * lu(k,1942) - lu(k,1961) = lu(k,1961) - lu(k,510) * lu(k,1942) - lu(k,1994) = lu(k,1994) - lu(k,504) * lu(k,1992) - lu(k,2002) = lu(k,2002) - lu(k,505) * lu(k,1992) - lu(k,2003) = - lu(k,506) * lu(k,1992) - lu(k,2011) = lu(k,2011) - lu(k,507) * lu(k,1992) - lu(k,2012) = lu(k,2012) - lu(k,508) * lu(k,1992) - lu(k,2015) = lu(k,2015) - lu(k,509) * lu(k,1992) - lu(k,2017) = lu(k,2017) - lu(k,510) * lu(k,1992) - lu(k,511) = 1._r8 / lu(k,511) - lu(k,512) = lu(k,512) * lu(k,511) - lu(k,513) = lu(k,513) * lu(k,511) - lu(k,514) = lu(k,514) * lu(k,511) - lu(k,515) = lu(k,515) * lu(k,511) - lu(k,516) = lu(k,516) * lu(k,511) - lu(k,517) = lu(k,517) * lu(k,511) - lu(k,518) = lu(k,518) * lu(k,511) - lu(k,519) = lu(k,519) * lu(k,511) - lu(k,1143) = - lu(k,512) * lu(k,1140) - lu(k,1144) = - lu(k,513) * lu(k,1140) - lu(k,1146) = - lu(k,514) * lu(k,1140) - lu(k,1157) = - lu(k,515) * lu(k,1140) - lu(k,1160) = lu(k,1160) - lu(k,516) * lu(k,1140) - lu(k,1161) = - lu(k,517) * lu(k,1140) - lu(k,1162) = lu(k,1162) - lu(k,518) * lu(k,1140) - lu(k,1163) = lu(k,1163) - lu(k,519) * lu(k,1140) - lu(k,1372) = lu(k,1372) - lu(k,512) * lu(k,1350) - lu(k,1373) = lu(k,1373) - lu(k,513) * lu(k,1350) - lu(k,1376) = lu(k,1376) - lu(k,514) * lu(k,1350) - lu(k,1393) = lu(k,1393) - lu(k,515) * lu(k,1350) - lu(k,1397) = lu(k,1397) - lu(k,516) * lu(k,1350) - lu(k,1399) = lu(k,1399) - lu(k,517) * lu(k,1350) - lu(k,1400) = lu(k,1400) - lu(k,518) * lu(k,1350) - lu(k,1401) = lu(k,1401) - lu(k,519) * lu(k,1350) - lu(k,1669) = lu(k,1669) - lu(k,512) * lu(k,1631) - lu(k,1670) = lu(k,1670) - lu(k,513) * lu(k,1631) - lu(k,1673) = lu(k,1673) - lu(k,514) * lu(k,1631) - lu(k,1692) = lu(k,1692) - lu(k,515) * lu(k,1631) - lu(k,1696) = lu(k,1696) - lu(k,516) * lu(k,1631) - lu(k,1698) = lu(k,1698) - lu(k,517) * lu(k,1631) - lu(k,1699) = lu(k,1699) - lu(k,518) * lu(k,1631) - lu(k,1700) = lu(k,1700) - lu(k,519) * lu(k,1631) + lu(k,506) = 1._r8 / lu(k,506) + lu(k,507) = lu(k,507) * lu(k,506) + lu(k,508) = lu(k,508) * lu(k,506) + lu(k,509) = lu(k,509) * lu(k,506) + lu(k,510) = lu(k,510) * lu(k,506) + lu(k,511) = lu(k,511) * lu(k,506) + lu(k,512) = lu(k,512) * lu(k,506) + lu(k,1603) = - lu(k,507) * lu(k,1549) + lu(k,1604) = lu(k,1604) - lu(k,508) * lu(k,1549) + lu(k,1606) = lu(k,1606) - lu(k,509) * lu(k,1549) + lu(k,1607) = - lu(k,510) * lu(k,1549) + lu(k,1608) = lu(k,1608) - lu(k,511) * lu(k,1549) + lu(k,1611) = lu(k,1611) - lu(k,512) * lu(k,1549) + lu(k,1699) = - lu(k,507) * lu(k,1675) + lu(k,1700) = lu(k,1700) - lu(k,508) * lu(k,1675) + lu(k,1702) = lu(k,1702) - lu(k,509) * lu(k,1675) + lu(k,1703) = lu(k,1703) - lu(k,510) * lu(k,1675) + lu(k,1704) = lu(k,1704) - lu(k,511) * lu(k,1675) + lu(k,1707) = lu(k,1707) - lu(k,512) * lu(k,1675) + lu(k,1912) = lu(k,1912) - lu(k,507) * lu(k,1830) + lu(k,1913) = lu(k,1913) - lu(k,508) * lu(k,1830) + lu(k,1915) = lu(k,1915) - lu(k,509) * lu(k,1830) + lu(k,1916) = lu(k,1916) - lu(k,510) * lu(k,1830) + lu(k,1917) = lu(k,1917) - lu(k,511) * lu(k,1830) + lu(k,1920) = lu(k,1920) - lu(k,512) * lu(k,1830) + lu(k,513) = 1._r8 / lu(k,513) + lu(k,514) = lu(k,514) * lu(k,513) + lu(k,515) = lu(k,515) * lu(k,513) + lu(k,516) = lu(k,516) * lu(k,513) + lu(k,678) = lu(k,678) - lu(k,514) * lu(k,677) + lu(k,680) = lu(k,680) - lu(k,515) * lu(k,677) + lu(k,683) = - lu(k,516) * lu(k,677) + lu(k,1560) = lu(k,1560) - lu(k,514) * lu(k,1550) + lu(k,1606) = lu(k,1606) - lu(k,515) * lu(k,1550) + lu(k,1617) = lu(k,1617) - lu(k,516) * lu(k,1550) + lu(k,1681) = - lu(k,514) * lu(k,1676) + lu(k,1702) = lu(k,1702) - lu(k,515) * lu(k,1676) + lu(k,1713) = lu(k,1713) - lu(k,516) * lu(k,1676) + lu(k,1852) = lu(k,1852) - lu(k,514) * lu(k,1831) + lu(k,1915) = lu(k,1915) - lu(k,515) * lu(k,1831) + lu(k,1926) = lu(k,1926) - lu(k,516) * lu(k,1831) + lu(k,2166) = lu(k,2166) - lu(k,514) * lu(k,2156) + lu(k,2218) = lu(k,2218) - lu(k,515) * lu(k,2156) + lu(k,2229) = lu(k,2229) - lu(k,516) * lu(k,2156) + lu(k,2280) = lu(k,2280) - lu(k,514) * lu(k,2277) + lu(k,2318) = lu(k,2318) - lu(k,515) * lu(k,2277) + lu(k,2329) = lu(k,2329) - lu(k,516) * lu(k,2277) + lu(k,517) = 1._r8 / lu(k,517) + lu(k,518) = lu(k,518) * lu(k,517) + lu(k,519) = lu(k,519) * lu(k,517) + lu(k,520) = lu(k,520) * lu(k,517) + lu(k,521) = lu(k,521) * lu(k,517) + lu(k,522) = lu(k,522) * lu(k,517) + lu(k,523) = lu(k,523) * lu(k,517) + lu(k,1737) = lu(k,1737) - lu(k,518) * lu(k,1732) + lu(k,1744) = lu(k,1744) - lu(k,519) * lu(k,1732) + lu(k,1745) = lu(k,1745) - lu(k,520) * lu(k,1732) + lu(k,1747) = lu(k,1747) - lu(k,521) * lu(k,1732) + lu(k,1753) = lu(k,1753) - lu(k,522) * lu(k,1732) + lu(k,1755) = lu(k,1755) - lu(k,523) * lu(k,1732) + lu(k,1909) = lu(k,1909) - lu(k,518) * lu(k,1832) + lu(k,1916) = lu(k,1916) - lu(k,519) * lu(k,1832) + lu(k,1917) = lu(k,1917) - lu(k,520) * lu(k,1832) + lu(k,1919) = lu(k,1919) - lu(k,521) * lu(k,1832) + lu(k,1925) = lu(k,1925) - lu(k,522) * lu(k,1832) + lu(k,1927) = lu(k,1927) - lu(k,523) * lu(k,1832) + lu(k,2251) = lu(k,2251) - lu(k,518) * lu(k,2236) + lu(k,2258) = lu(k,2258) - lu(k,519) * lu(k,2236) + lu(k,2259) = lu(k,2259) - lu(k,520) * lu(k,2236) + lu(k,2261) = lu(k,2261) - lu(k,521) * lu(k,2236) + lu(k,2267) = lu(k,2267) - lu(k,522) * lu(k,2236) + lu(k,2269) = lu(k,2269) - lu(k,523) * lu(k,2236) + lu(k,524) = 1._r8 / lu(k,524) + lu(k,525) = lu(k,525) * lu(k,524) + lu(k,526) = lu(k,526) * lu(k,524) + lu(k,527) = lu(k,527) * lu(k,524) + lu(k,528) = lu(k,528) * lu(k,524) + lu(k,529) = lu(k,529) * lu(k,524) + lu(k,530) = lu(k,530) * lu(k,524) + lu(k,952) = lu(k,952) - lu(k,525) * lu(k,949) + lu(k,953) = lu(k,953) - lu(k,526) * lu(k,949) + lu(k,954) = lu(k,954) - lu(k,527) * lu(k,949) + lu(k,959) = - lu(k,528) * lu(k,949) + lu(k,960) = lu(k,960) - lu(k,529) * lu(k,949) + lu(k,961) = lu(k,961) - lu(k,530) * lu(k,949) + lu(k,1879) = lu(k,1879) - lu(k,525) * lu(k,1833) + lu(k,1880) = lu(k,1880) - lu(k,526) * lu(k,1833) + lu(k,1884) = lu(k,1884) - lu(k,527) * lu(k,1833) + lu(k,1917) = lu(k,1917) - lu(k,528) * lu(k,1833) + lu(k,1921) = lu(k,1921) - lu(k,529) * lu(k,1833) + lu(k,1924) = lu(k,1924) - lu(k,530) * lu(k,1833) + lu(k,2188) = lu(k,2188) - lu(k,525) * lu(k,2157) + lu(k,2189) = lu(k,2189) - lu(k,526) * lu(k,2157) + lu(k,2192) = lu(k,2192) - lu(k,527) * lu(k,2157) + lu(k,2220) = lu(k,2220) - lu(k,528) * lu(k,2157) + lu(k,2224) = lu(k,2224) - lu(k,529) * lu(k,2157) + lu(k,2227) = lu(k,2227) - lu(k,530) * lu(k,2157) + lu(k,533) = 1._r8 / lu(k,533) + lu(k,534) = lu(k,534) * lu(k,533) + lu(k,535) = lu(k,535) * lu(k,533) + lu(k,536) = lu(k,536) * lu(k,533) + lu(k,537) = lu(k,537) * lu(k,533) + lu(k,538) = lu(k,538) * lu(k,533) + lu(k,539) = lu(k,539) * lu(k,533) + lu(k,1564) = lu(k,1564) - lu(k,534) * lu(k,1551) + lu(k,1577) = lu(k,1577) - lu(k,535) * lu(k,1551) + lu(k,1604) = lu(k,1604) - lu(k,536) * lu(k,1551) + lu(k,1606) = lu(k,1606) - lu(k,537) * lu(k,1551) + lu(k,1608) = lu(k,1608) - lu(k,538) * lu(k,1551) + lu(k,1615) = lu(k,1615) - lu(k,539) * lu(k,1551) + lu(k,1861) = lu(k,1861) - lu(k,534) * lu(k,1834) + lu(k,1881) = lu(k,1881) - lu(k,535) * lu(k,1834) + lu(k,1913) = lu(k,1913) - lu(k,536) * lu(k,1834) + lu(k,1915) = lu(k,1915) - lu(k,537) * lu(k,1834) + lu(k,1917) = lu(k,1917) - lu(k,538) * lu(k,1834) + lu(k,1924) = lu(k,1924) - lu(k,539) * lu(k,1834) + lu(k,2174) = lu(k,2174) - lu(k,534) * lu(k,2158) + lu(k,2190) = lu(k,2190) - lu(k,535) * lu(k,2158) + lu(k,2216) = lu(k,2216) - lu(k,536) * lu(k,2158) + lu(k,2218) = lu(k,2218) - lu(k,537) * lu(k,2158) + lu(k,2220) = lu(k,2220) - lu(k,538) * lu(k,2158) + lu(k,2227) = lu(k,2227) - lu(k,539) * lu(k,2158) + lu(k,541) = 1._r8 / lu(k,541) + lu(k,542) = lu(k,542) * lu(k,541) + lu(k,543) = lu(k,543) * lu(k,541) + lu(k,544) = lu(k,544) * lu(k,541) + lu(k,545) = lu(k,545) * lu(k,541) + lu(k,546) = lu(k,546) * lu(k,541) + lu(k,547) = lu(k,547) * lu(k,541) + lu(k,1577) = lu(k,1577) - lu(k,542) * lu(k,1552) + lu(k,1593) = lu(k,1593) - lu(k,543) * lu(k,1552) + lu(k,1604) = lu(k,1604) - lu(k,544) * lu(k,1552) + lu(k,1606) = lu(k,1606) - lu(k,545) * lu(k,1552) + lu(k,1608) = lu(k,1608) - lu(k,546) * lu(k,1552) + lu(k,1615) = lu(k,1615) - lu(k,547) * lu(k,1552) + lu(k,1881) = lu(k,1881) - lu(k,542) * lu(k,1835) + lu(k,1900) = lu(k,1900) - lu(k,543) * lu(k,1835) + lu(k,1913) = lu(k,1913) - lu(k,544) * lu(k,1835) + lu(k,1915) = lu(k,1915) - lu(k,545) * lu(k,1835) + lu(k,1917) = lu(k,1917) - lu(k,546) * lu(k,1835) + lu(k,1924) = lu(k,1924) - lu(k,547) * lu(k,1835) + lu(k,2190) = lu(k,2190) - lu(k,542) * lu(k,2159) + lu(k,2204) = lu(k,2204) - lu(k,543) * lu(k,2159) + lu(k,2216) = lu(k,2216) - lu(k,544) * lu(k,2159) + lu(k,2218) = lu(k,2218) - lu(k,545) * lu(k,2159) + lu(k,2220) = lu(k,2220) - lu(k,546) * lu(k,2159) + lu(k,2227) = lu(k,2227) - lu(k,547) * lu(k,2159) + lu(k,548) = 1._r8 / lu(k,548) + lu(k,549) = lu(k,549) * lu(k,548) + lu(k,550) = lu(k,550) * lu(k,548) + lu(k,551) = lu(k,551) * lu(k,548) + lu(k,552) = lu(k,552) * lu(k,548) + lu(k,686) = - lu(k,549) * lu(k,684) + lu(k,687) = - lu(k,550) * lu(k,684) + lu(k,690) = - lu(k,551) * lu(k,684) + lu(k,692) = lu(k,692) - lu(k,552) * lu(k,684) + lu(k,707) = - lu(k,549) * lu(k,705) + lu(k,708) = - lu(k,550) * lu(k,705) + lu(k,712) = - lu(k,551) * lu(k,705) + lu(k,713) = lu(k,713) - lu(k,552) * lu(k,705) + lu(k,937) = - lu(k,549) * lu(k,934) + lu(k,938) = - lu(k,550) * lu(k,934) + lu(k,942) = - lu(k,551) * lu(k,934) + lu(k,946) = - lu(k,552) * lu(k,934) + lu(k,1562) = lu(k,1562) - lu(k,549) * lu(k,1553) + lu(k,1570) = lu(k,1570) - lu(k,550) * lu(k,1553) + lu(k,1599) = lu(k,1599) - lu(k,551) * lu(k,1553) + lu(k,1608) = lu(k,1608) - lu(k,552) * lu(k,1553) + lu(k,1856) = lu(k,1856) - lu(k,549) * lu(k,1836) + lu(k,1870) = lu(k,1870) - lu(k,550) * lu(k,1836) + lu(k,1907) = lu(k,1907) - lu(k,551) * lu(k,1836) + lu(k,1917) = lu(k,1917) - lu(k,552) * lu(k,1836) end do end subroutine lu_fac11 subroutine lu_fac12( avec_len, lu ) @@ -1583,162 +1465,174 @@ subroutine lu_fac12( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,520) = 1._r8 / lu(k,520) - lu(k,521) = lu(k,521) * lu(k,520) - lu(k,522) = lu(k,522) * lu(k,520) - lu(k,523) = lu(k,523) * lu(k,520) - lu(k,524) = lu(k,524) * lu(k,520) - lu(k,525) = lu(k,525) * lu(k,520) - lu(k,526) = lu(k,526) * lu(k,520) - lu(k,1512) = lu(k,1512) - lu(k,521) * lu(k,1461) - lu(k,1513) = lu(k,1513) - lu(k,522) * lu(k,1461) - lu(k,1515) = lu(k,1515) - lu(k,523) * lu(k,1461) - lu(k,1523) = lu(k,1523) - lu(k,524) * lu(k,1461) - lu(k,1524) = lu(k,1524) - lu(k,525) * lu(k,1461) - lu(k,1525) = lu(k,1525) - lu(k,526) * lu(k,1461) - lu(k,1695) = lu(k,1695) - lu(k,521) * lu(k,1632) - lu(k,1696) = lu(k,1696) - lu(k,522) * lu(k,1632) - lu(k,1698) = lu(k,1698) - lu(k,523) * lu(k,1632) - lu(k,1706) = lu(k,1706) - lu(k,524) * lu(k,1632) - lu(k,1707) = lu(k,1707) - lu(k,525) * lu(k,1632) - lu(k,1708) = lu(k,1708) - lu(k,526) * lu(k,1632) - lu(k,2006) = lu(k,2006) - lu(k,521) * lu(k,1993) - lu(k,2007) = lu(k,2007) - lu(k,522) * lu(k,1993) - lu(k,2009) = lu(k,2009) - lu(k,523) * lu(k,1993) - lu(k,2017) = lu(k,2017) - lu(k,524) * lu(k,1993) - lu(k,2018) = lu(k,2018) - lu(k,525) * lu(k,1993) - lu(k,2019) = - lu(k,526) * lu(k,1993) - lu(k,2040) = lu(k,2040) - lu(k,521) * lu(k,2024) - lu(k,2041) = lu(k,2041) - lu(k,522) * lu(k,2024) - lu(k,2043) = lu(k,2043) - lu(k,523) * lu(k,2024) - lu(k,2051) = - lu(k,524) * lu(k,2024) - lu(k,2052) = lu(k,2052) - lu(k,525) * lu(k,2024) - lu(k,2053) = lu(k,2053) - lu(k,526) * lu(k,2024) - lu(k,527) = 1._r8 / lu(k,527) - lu(k,528) = lu(k,528) * lu(k,527) - lu(k,529) = lu(k,529) * lu(k,527) - lu(k,530) = lu(k,530) * lu(k,527) - lu(k,531) = lu(k,531) * lu(k,527) - lu(k,532) = lu(k,532) * lu(k,527) - lu(k,533) = lu(k,533) * lu(k,527) - lu(k,534) = lu(k,534) * lu(k,527) - lu(k,535) = lu(k,535) * lu(k,527) - lu(k,990) = lu(k,990) - lu(k,528) * lu(k,988) - lu(k,991) = lu(k,991) - lu(k,529) * lu(k,988) - lu(k,992) = lu(k,992) - lu(k,530) * lu(k,988) - lu(k,993) = lu(k,993) - lu(k,531) * lu(k,988) - lu(k,994) = lu(k,994) - lu(k,532) * lu(k,988) - lu(k,1000) = lu(k,1000) - lu(k,533) * lu(k,988) - lu(k,1001) = - lu(k,534) * lu(k,988) - lu(k,1002) = lu(k,1002) - lu(k,535) * lu(k,988) - lu(k,1486) = lu(k,1486) - lu(k,528) * lu(k,1462) - lu(k,1488) = lu(k,1488) - lu(k,529) * lu(k,1462) - lu(k,1489) = - lu(k,530) * lu(k,1462) - lu(k,1490) = lu(k,1490) - lu(k,531) * lu(k,1462) - lu(k,1493) = lu(k,1493) - lu(k,532) * lu(k,1462) - lu(k,1513) = lu(k,1513) - lu(k,533) * lu(k,1462) - lu(k,1515) = lu(k,1515) - lu(k,534) * lu(k,1462) - lu(k,1516) = lu(k,1516) - lu(k,535) * lu(k,1462) - lu(k,1664) = lu(k,1664) - lu(k,528) * lu(k,1633) - lu(k,1669) = lu(k,1669) - lu(k,529) * lu(k,1633) - lu(k,1671) = lu(k,1671) - lu(k,530) * lu(k,1633) - lu(k,1672) = lu(k,1672) - lu(k,531) * lu(k,1633) - lu(k,1675) = lu(k,1675) - lu(k,532) * lu(k,1633) - lu(k,1696) = lu(k,1696) - lu(k,533) * lu(k,1633) - lu(k,1698) = lu(k,1698) - lu(k,534) * lu(k,1633) - lu(k,1699) = lu(k,1699) - lu(k,535) * lu(k,1633) - lu(k,538) = 1._r8 / lu(k,538) - lu(k,539) = lu(k,539) * lu(k,538) - lu(k,540) = lu(k,540) * lu(k,538) - lu(k,541) = lu(k,541) * lu(k,538) - lu(k,542) = lu(k,542) * lu(k,538) - lu(k,543) = lu(k,543) * lu(k,538) - lu(k,544) = lu(k,544) * lu(k,538) - lu(k,545) = lu(k,545) * lu(k,538) - lu(k,546) = lu(k,546) * lu(k,538) - lu(k,636) = lu(k,636) - lu(k,539) * lu(k,635) - lu(k,637) = lu(k,637) - lu(k,540) * lu(k,635) - lu(k,638) = lu(k,638) - lu(k,541) * lu(k,635) - lu(k,639) = lu(k,639) - lu(k,542) * lu(k,635) - lu(k,641) = lu(k,641) - lu(k,543) * lu(k,635) - lu(k,643) = lu(k,643) - lu(k,544) * lu(k,635) - lu(k,645) = lu(k,645) - lu(k,545) * lu(k,635) - lu(k,646) = - lu(k,546) * lu(k,635) - lu(k,1464) = - lu(k,539) * lu(k,1463) - lu(k,1471) = lu(k,1471) - lu(k,540) * lu(k,1463) - lu(k,1472) = lu(k,1472) - lu(k,541) * lu(k,1463) - lu(k,1474) = lu(k,1474) - lu(k,542) * lu(k,1463) - lu(k,1484) = lu(k,1484) - lu(k,543) * lu(k,1463) - lu(k,1501) = lu(k,1501) - lu(k,544) * lu(k,1463) - lu(k,1513) = lu(k,1513) - lu(k,545) * lu(k,1463) - lu(k,1515) = lu(k,1515) - lu(k,546) * lu(k,1463) - lu(k,1635) = lu(k,1635) - lu(k,539) * lu(k,1634) - lu(k,1644) = lu(k,1644) - lu(k,540) * lu(k,1634) - lu(k,1645) = lu(k,1645) - lu(k,541) * lu(k,1634) - lu(k,1647) = - lu(k,542) * lu(k,1634) - lu(k,1660) = lu(k,1660) - lu(k,543) * lu(k,1634) - lu(k,1683) = lu(k,1683) - lu(k,544) * lu(k,1634) - lu(k,1696) = lu(k,1696) - lu(k,545) * lu(k,1634) - lu(k,1698) = lu(k,1698) - lu(k,546) * lu(k,1634) - lu(k,547) = 1._r8 / lu(k,547) - lu(k,548) = lu(k,548) * lu(k,547) - lu(k,549) = lu(k,549) * lu(k,547) - lu(k,550) = lu(k,550) * lu(k,547) - lu(k,611) = - lu(k,548) * lu(k,606) - lu(k,613) = lu(k,613) - lu(k,549) * lu(k,606) - lu(k,616) = lu(k,616) - lu(k,550) * lu(k,606) - lu(k,640) = - lu(k,548) * lu(k,636) - lu(k,642) = - lu(k,549) * lu(k,636) - lu(k,645) = lu(k,645) - lu(k,550) * lu(k,636) - lu(k,656) = - lu(k,548) * lu(k,651) - lu(k,658) = lu(k,658) - lu(k,549) * lu(k,651) - lu(k,662) = lu(k,662) - lu(k,550) * lu(k,651) - lu(k,910) = - lu(k,548) * lu(k,908) - lu(k,913) = - lu(k,549) * lu(k,908) - lu(k,918) = lu(k,918) - lu(k,550) * lu(k,908) - lu(k,1217) = - lu(k,548) * lu(k,1213) - lu(k,1221) = - lu(k,549) * lu(k,1213) - lu(k,1236) = lu(k,1236) - lu(k,550) * lu(k,1213) - lu(k,1366) = lu(k,1366) - lu(k,548) * lu(k,1351) - lu(k,1375) = lu(k,1375) - lu(k,549) * lu(k,1351) - lu(k,1397) = lu(k,1397) - lu(k,550) * lu(k,1351) - lu(k,1483) = lu(k,1483) - lu(k,548) * lu(k,1464) - lu(k,1490) = lu(k,1490) - lu(k,549) * lu(k,1464) - lu(k,1513) = lu(k,1513) - lu(k,550) * lu(k,1464) - lu(k,1659) = - lu(k,548) * lu(k,1635) - lu(k,1672) = lu(k,1672) - lu(k,549) * lu(k,1635) - lu(k,1696) = lu(k,1696) - lu(k,550) * lu(k,1635) - lu(k,551) = 1._r8 / lu(k,551) - lu(k,552) = lu(k,552) * lu(k,551) - lu(k,553) = lu(k,553) * lu(k,551) - lu(k,554) = lu(k,554) * lu(k,551) - lu(k,555) = lu(k,555) * lu(k,551) - lu(k,556) = lu(k,556) * lu(k,551) - lu(k,969) = lu(k,969) - lu(k,552) * lu(k,966) - lu(k,977) = - lu(k,553) * lu(k,966) - lu(k,980) = lu(k,980) - lu(k,554) * lu(k,966) - lu(k,981) = lu(k,981) - lu(k,555) * lu(k,966) - lu(k,983) = lu(k,983) - lu(k,556) * lu(k,966) - lu(k,1009) = lu(k,1009) - lu(k,552) * lu(k,1007) - lu(k,1016) = lu(k,1016) - lu(k,553) * lu(k,1007) - lu(k,1019) = lu(k,1019) - lu(k,554) * lu(k,1007) - lu(k,1020) = lu(k,1020) - lu(k,555) * lu(k,1007) - lu(k,1022) = lu(k,1022) - lu(k,556) * lu(k,1007) - lu(k,1370) = lu(k,1370) - lu(k,552) * lu(k,1352) - lu(k,1393) = lu(k,1393) - lu(k,553) * lu(k,1352) - lu(k,1397) = lu(k,1397) - lu(k,554) * lu(k,1352) - lu(k,1399) = lu(k,1399) - lu(k,555) * lu(k,1352) - lu(k,1401) = lu(k,1401) - lu(k,556) * lu(k,1352) - lu(k,1666) = lu(k,1666) - lu(k,552) * lu(k,1636) - lu(k,1692) = lu(k,1692) - lu(k,553) * lu(k,1636) - lu(k,1696) = lu(k,1696) - lu(k,554) * lu(k,1636) - lu(k,1698) = lu(k,1698) - lu(k,555) * lu(k,1636) - lu(k,1700) = lu(k,1700) - lu(k,556) * lu(k,1636) - lu(k,1842) = lu(k,1842) - lu(k,552) * lu(k,1835) - lu(k,1863) = lu(k,1863) - lu(k,553) * lu(k,1835) - lu(k,1867) = lu(k,1867) - lu(k,554) * lu(k,1835) - lu(k,1869) = lu(k,1869) - lu(k,555) * lu(k,1835) - lu(k,1871) = lu(k,1871) - lu(k,556) * lu(k,1835) + lu(k,554) = 1._r8 / lu(k,554) + lu(k,555) = lu(k,555) * lu(k,554) + lu(k,556) = lu(k,556) * lu(k,554) + lu(k,557) = lu(k,557) * lu(k,554) + lu(k,558) = lu(k,558) * lu(k,554) + lu(k,559) = lu(k,559) * lu(k,554) + lu(k,1560) = lu(k,1560) - lu(k,555) * lu(k,1554) + lu(k,1604) = lu(k,1604) - lu(k,556) * lu(k,1554) + lu(k,1606) = lu(k,1606) - lu(k,557) * lu(k,1554) + lu(k,1608) = lu(k,1608) - lu(k,558) * lu(k,1554) + lu(k,1615) = lu(k,1615) - lu(k,559) * lu(k,1554) + lu(k,1681) = lu(k,1681) - lu(k,555) * lu(k,1677) + lu(k,1700) = lu(k,1700) - lu(k,556) * lu(k,1677) + lu(k,1702) = lu(k,1702) - lu(k,557) * lu(k,1677) + lu(k,1704) = lu(k,1704) - lu(k,558) * lu(k,1677) + lu(k,1711) = lu(k,1711) - lu(k,559) * lu(k,1677) + lu(k,1852) = lu(k,1852) - lu(k,555) * lu(k,1837) + lu(k,1913) = lu(k,1913) - lu(k,556) * lu(k,1837) + lu(k,1915) = lu(k,1915) - lu(k,557) * lu(k,1837) + lu(k,1917) = lu(k,1917) - lu(k,558) * lu(k,1837) + lu(k,1924) = lu(k,1924) - lu(k,559) * lu(k,1837) + lu(k,2166) = lu(k,2166) - lu(k,555) * lu(k,2160) + lu(k,2216) = lu(k,2216) - lu(k,556) * lu(k,2160) + lu(k,2218) = lu(k,2218) - lu(k,557) * lu(k,2160) + lu(k,2220) = lu(k,2220) - lu(k,558) * lu(k,2160) + lu(k,2227) = lu(k,2227) - lu(k,559) * lu(k,2160) + 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,1272) = lu(k,1272) - lu(k,561) * lu(k,1270) + lu(k,1274) = lu(k,1274) - lu(k,562) * lu(k,1270) + lu(k,1277) = lu(k,1277) - lu(k,563) * lu(k,1270) + lu(k,1279) = lu(k,1279) - lu(k,564) * lu(k,1270) + lu(k,1283) = lu(k,1283) - lu(k,565) * lu(k,1270) + lu(k,1901) = lu(k,1901) - lu(k,561) * lu(k,1838) + lu(k,1912) = lu(k,1912) - lu(k,562) * lu(k,1838) + lu(k,1917) = lu(k,1917) - lu(k,563) * lu(k,1838) + lu(k,1920) = lu(k,1920) - lu(k,564) * lu(k,1838) + lu(k,1926) = lu(k,1926) - lu(k,565) * lu(k,1838) + lu(k,1986) = lu(k,1986) - lu(k,561) * lu(k,1977) + lu(k,1991) = lu(k,1991) - lu(k,562) * lu(k,1977) + lu(k,1996) = lu(k,1996) - lu(k,563) * lu(k,1977) + lu(k,1999) = lu(k,1999) - lu(k,564) * lu(k,1977) + lu(k,2005) = lu(k,2005) - lu(k,565) * lu(k,1977) + lu(k,2305) = lu(k,2305) - lu(k,561) * lu(k,2278) + lu(k,2315) = lu(k,2315) - lu(k,562) * lu(k,2278) + lu(k,2320) = lu(k,2320) - lu(k,563) * lu(k,2278) + lu(k,2323) = lu(k,2323) - lu(k,564) * lu(k,2278) + lu(k,2329) = lu(k,2329) - lu(k,565) * lu(k,2278) + lu(k,566) = 1._r8 / lu(k,566) + lu(k,567) = lu(k,567) * lu(k,566) + lu(k,568) = lu(k,568) * lu(k,566) + lu(k,569) = lu(k,569) * lu(k,566) + lu(k,570) = lu(k,570) * lu(k,566) + lu(k,571) = lu(k,571) * lu(k,566) + lu(k,572) = lu(k,572) * lu(k,566) + lu(k,573) = lu(k,573) * lu(k,566) + lu(k,1411) = lu(k,1411) - lu(k,567) * lu(k,1408) + lu(k,1426) = lu(k,1426) - lu(k,568) * lu(k,1408) + lu(k,1430) = lu(k,1430) - lu(k,569) * lu(k,1408) + lu(k,1431) = lu(k,1431) - lu(k,570) * lu(k,1408) + lu(k,1432) = lu(k,1432) - lu(k,571) * lu(k,1408) + lu(k,1434) = lu(k,1434) - lu(k,572) * lu(k,1408) + lu(k,1435) = - lu(k,573) * lu(k,1408) + lu(k,1685) = - lu(k,567) * lu(k,1678) + lu(k,1695) = lu(k,1695) - lu(k,568) * lu(k,1678) + lu(k,1701) = - lu(k,569) * lu(k,1678) + lu(k,1702) = lu(k,1702) - lu(k,570) * lu(k,1678) + lu(k,1704) = lu(k,1704) - lu(k,571) * lu(k,1678) + lu(k,1708) = - lu(k,572) * lu(k,1678) + lu(k,1709) = lu(k,1709) - lu(k,573) * lu(k,1678) + lu(k,1871) = lu(k,1871) - lu(k,567) * lu(k,1839) + lu(k,1907) = lu(k,1907) - lu(k,568) * lu(k,1839) + lu(k,1914) = lu(k,1914) - lu(k,569) * lu(k,1839) + lu(k,1915) = lu(k,1915) - lu(k,570) * lu(k,1839) + lu(k,1917) = lu(k,1917) - lu(k,571) * lu(k,1839) + lu(k,1921) = lu(k,1921) - lu(k,572) * lu(k,1839) + lu(k,1922) = lu(k,1922) - lu(k,573) * lu(k,1839) + lu(k,574) = 1._r8 / lu(k,574) + lu(k,575) = lu(k,575) * lu(k,574) + lu(k,576) = lu(k,576) * lu(k,574) + lu(k,577) = lu(k,577) * lu(k,574) + lu(k,578) = lu(k,578) * lu(k,574) + lu(k,579) = lu(k,579) * lu(k,574) + lu(k,580) = lu(k,580) * lu(k,574) + lu(k,581) = lu(k,581) * lu(k,574) + lu(k,1684) = - lu(k,575) * lu(k,1679) + lu(k,1696) = - lu(k,576) * lu(k,1679) + lu(k,1698) = lu(k,1698) - lu(k,577) * lu(k,1679) + lu(k,1702) = lu(k,1702) - lu(k,578) * lu(k,1679) + lu(k,1707) = lu(k,1707) - lu(k,579) * lu(k,1679) + lu(k,1709) = lu(k,1709) - lu(k,580) * lu(k,1679) + lu(k,1710) = lu(k,1710) - lu(k,581) * lu(k,1679) + lu(k,1980) = lu(k,1980) - lu(k,575) * lu(k,1978) + lu(k,1988) = lu(k,1988) - lu(k,576) * lu(k,1978) + lu(k,1990) = - lu(k,577) * lu(k,1978) + lu(k,1994) = lu(k,1994) - lu(k,578) * lu(k,1978) + lu(k,1999) = lu(k,1999) - lu(k,579) * lu(k,1978) + lu(k,2001) = lu(k,2001) - lu(k,580) * lu(k,1978) + lu(k,2002) = lu(k,2002) - lu(k,581) * lu(k,1978) + lu(k,2091) = lu(k,2091) - lu(k,575) * lu(k,2090) + lu(k,2094) = lu(k,2094) - lu(k,576) * lu(k,2090) + lu(k,2095) = - lu(k,577) * lu(k,2090) + lu(k,2099) = lu(k,2099) - lu(k,578) * lu(k,2090) + lu(k,2104) = lu(k,2104) - lu(k,579) * lu(k,2090) + lu(k,2106) = - lu(k,580) * lu(k,2090) + lu(k,2107) = lu(k,2107) - lu(k,581) * lu(k,2090) + lu(k,582) = 1._r8 / lu(k,582) + lu(k,583) = lu(k,583) * lu(k,582) + lu(k,584) = lu(k,584) * lu(k,582) + lu(k,585) = lu(k,585) * lu(k,582) + lu(k,586) = lu(k,586) * lu(k,582) + lu(k,587) = lu(k,587) * lu(k,582) + lu(k,588) = lu(k,588) * lu(k,582) + lu(k,589) = lu(k,589) * lu(k,582) + lu(k,1318) = - lu(k,583) * lu(k,1314) + lu(k,1322) = lu(k,1322) - lu(k,584) * lu(k,1314) + lu(k,1323) = lu(k,1323) - lu(k,585) * lu(k,1314) + lu(k,1324) = - lu(k,586) * lu(k,1314) + lu(k,1333) = - lu(k,587) * lu(k,1314) + lu(k,1337) = lu(k,1337) - lu(k,588) * lu(k,1314) + lu(k,1341) = lu(k,1341) - lu(k,589) * lu(k,1314) + lu(k,1572) = - lu(k,583) * lu(k,1555) + lu(k,1585) = lu(k,1585) - lu(k,584) * lu(k,1555) + lu(k,1588) = lu(k,1588) - lu(k,585) * lu(k,1555) + lu(k,1589) = lu(k,1589) - lu(k,586) * lu(k,1555) + lu(k,1602) = lu(k,1602) - lu(k,587) * lu(k,1555) + lu(k,1608) = lu(k,1608) - lu(k,588) * lu(k,1555) + lu(k,1615) = lu(k,1615) - lu(k,589) * lu(k,1555) + lu(k,1873) = lu(k,1873) - lu(k,583) * lu(k,1840) + lu(k,1892) = lu(k,1892) - lu(k,584) * lu(k,1840) + lu(k,1895) = lu(k,1895) - lu(k,585) * lu(k,1840) + lu(k,1896) = lu(k,1896) - lu(k,586) * lu(k,1840) + lu(k,1911) = lu(k,1911) - lu(k,587) * lu(k,1840) + lu(k,1917) = lu(k,1917) - lu(k,588) * lu(k,1840) + lu(k,1924) = lu(k,1924) - lu(k,589) * lu(k,1840) + lu(k,590) = 1._r8 / lu(k,590) + lu(k,591) = lu(k,591) * lu(k,590) + lu(k,592) = lu(k,592) * lu(k,590) + lu(k,593) = lu(k,593) * lu(k,590) + lu(k,594) = lu(k,594) * lu(k,590) + lu(k,595) = lu(k,595) * lu(k,590) + lu(k,596) = lu(k,596) * lu(k,590) + lu(k,597) = lu(k,597) * lu(k,590) + lu(k,808) = lu(k,808) - lu(k,591) * lu(k,807) + lu(k,809) = lu(k,809) - lu(k,592) * lu(k,807) + lu(k,810) = - lu(k,593) * lu(k,807) + lu(k,813) = - lu(k,594) * lu(k,807) + lu(k,814) = lu(k,814) - lu(k,595) * lu(k,807) + lu(k,815) = lu(k,815) - lu(k,596) * lu(k,807) + lu(k,816) = - lu(k,597) * lu(k,807) + lu(k,1865) = lu(k,1865) - lu(k,591) * lu(k,1841) + lu(k,1890) = lu(k,1890) - lu(k,592) * lu(k,1841) + lu(k,1895) = lu(k,1895) - lu(k,593) * lu(k,1841) + lu(k,1917) = lu(k,1917) - lu(k,594) * lu(k,1841) + lu(k,1921) = lu(k,1921) - lu(k,595) * lu(k,1841) + lu(k,1924) = lu(k,1924) - lu(k,596) * lu(k,1841) + lu(k,1927) = lu(k,1927) - lu(k,597) * lu(k,1841) + lu(k,2178) = lu(k,2178) - lu(k,591) * lu(k,2161) + lu(k,2195) = lu(k,2195) - lu(k,592) * lu(k,2161) + lu(k,2200) = - lu(k,593) * lu(k,2161) + lu(k,2220) = lu(k,2220) - lu(k,594) * lu(k,2161) + lu(k,2224) = lu(k,2224) - lu(k,595) * lu(k,2161) + lu(k,2227) = lu(k,2227) - lu(k,596) * lu(k,2161) + lu(k,2230) = lu(k,2230) - lu(k,597) * lu(k,2161) end do end subroutine lu_fac12 subroutine lu_fac13( avec_len, lu ) @@ -1755,220 +1649,192 @@ subroutine lu_fac13( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,559) = 1._r8 / lu(k,559) - lu(k,560) = lu(k,560) * lu(k,559) - lu(k,561) = lu(k,561) * lu(k,559) - lu(k,562) = lu(k,562) * lu(k,559) - lu(k,563) = lu(k,563) * lu(k,559) - lu(k,564) = lu(k,564) * lu(k,559) - lu(k,1395) = lu(k,1395) - lu(k,560) * lu(k,1353) - lu(k,1397) = lu(k,1397) - lu(k,561) * lu(k,1353) - lu(k,1399) = lu(k,1399) - lu(k,562) * lu(k,1353) - lu(k,1401) = lu(k,1401) - lu(k,563) * lu(k,1353) - lu(k,1404) = lu(k,1404) - lu(k,564) * lu(k,1353) - lu(k,1511) = lu(k,1511) - lu(k,560) * lu(k,1465) - lu(k,1513) = lu(k,1513) - lu(k,561) * lu(k,1465) - lu(k,1515) = lu(k,1515) - lu(k,562) * lu(k,1465) - lu(k,1517) = lu(k,1517) - lu(k,563) * lu(k,1465) - lu(k,1520) = lu(k,1520) - lu(k,564) * lu(k,1465) - lu(k,1694) = lu(k,1694) - lu(k,560) * lu(k,1637) - lu(k,1696) = lu(k,1696) - lu(k,561) * lu(k,1637) - lu(k,1698) = lu(k,1698) - lu(k,562) * lu(k,1637) - lu(k,1700) = lu(k,1700) - lu(k,563) * lu(k,1637) - lu(k,1703) = lu(k,1703) - lu(k,564) * lu(k,1637) - lu(k,1758) = lu(k,1758) - lu(k,560) * lu(k,1741) - lu(k,1760) = lu(k,1760) - lu(k,561) * lu(k,1741) - lu(k,1762) = lu(k,1762) - lu(k,562) * lu(k,1741) - lu(k,1764) = lu(k,1764) - lu(k,563) * lu(k,1741) - lu(k,1767) = lu(k,1767) - lu(k,564) * lu(k,1741) - lu(k,1925) = lu(k,1925) - lu(k,560) * lu(k,1891) - lu(k,1927) = lu(k,1927) - lu(k,561) * lu(k,1891) - lu(k,1929) = lu(k,1929) - lu(k,562) * lu(k,1891) - lu(k,1931) = lu(k,1931) - lu(k,563) * lu(k,1891) - lu(k,1934) = lu(k,1934) - lu(k,564) * lu(k,1891) - lu(k,566) = 1._r8 / lu(k,566) - lu(k,567) = lu(k,567) * lu(k,566) - lu(k,568) = lu(k,568) * lu(k,566) - lu(k,569) = lu(k,569) * lu(k,566) - lu(k,570) = lu(k,570) * lu(k,566) - lu(k,571) = lu(k,571) * lu(k,566) - lu(k,572) = lu(k,572) * lu(k,566) - lu(k,573) = lu(k,573) * lu(k,566) - lu(k,574) = lu(k,574) * lu(k,566) - lu(k,575) = lu(k,575) * lu(k,566) - lu(k,851) = lu(k,851) - lu(k,567) * lu(k,849) - lu(k,852) = lu(k,852) - lu(k,568) * lu(k,849) - lu(k,854) = lu(k,854) - lu(k,569) * lu(k,849) - lu(k,855) = lu(k,855) - lu(k,570) * lu(k,849) - lu(k,856) = lu(k,856) - lu(k,571) * lu(k,849) - lu(k,858) = lu(k,858) - lu(k,572) * lu(k,849) - lu(k,859) = lu(k,859) - lu(k,573) * lu(k,849) - lu(k,860) = lu(k,860) - lu(k,574) * lu(k,849) - lu(k,861) = lu(k,861) - lu(k,575) * lu(k,849) - lu(k,1355) = lu(k,1355) - lu(k,567) * lu(k,1354) - lu(k,1364) = lu(k,1364) - lu(k,568) * lu(k,1354) - lu(k,1369) = lu(k,1369) - lu(k,569) * lu(k,1354) - lu(k,1381) = lu(k,1381) - lu(k,570) * lu(k,1354) - lu(k,1391) = lu(k,1391) - lu(k,571) * lu(k,1354) - lu(k,1397) = lu(k,1397) - lu(k,572) * lu(k,1354) - lu(k,1399) = lu(k,1399) - lu(k,573) * lu(k,1354) - lu(k,1400) = lu(k,1400) - lu(k,574) * lu(k,1354) - lu(k,1401) = lu(k,1401) - lu(k,575) * lu(k,1354) - lu(k,1640) = lu(k,1640) - lu(k,567) * lu(k,1638) - lu(k,1655) = lu(k,1655) - lu(k,568) * lu(k,1638) - lu(k,1664) = lu(k,1664) - lu(k,569) * lu(k,1638) - lu(k,1678) = lu(k,1678) - lu(k,570) * lu(k,1638) - lu(k,1690) = lu(k,1690) - lu(k,571) * lu(k,1638) - lu(k,1696) = lu(k,1696) - lu(k,572) * lu(k,1638) - lu(k,1698) = lu(k,1698) - lu(k,573) * lu(k,1638) - lu(k,1699) = lu(k,1699) - lu(k,574) * lu(k,1638) - lu(k,1700) = lu(k,1700) - lu(k,575) * lu(k,1638) - lu(k,577) = 1._r8 / lu(k,577) - lu(k,578) = lu(k,578) * lu(k,577) - lu(k,579) = lu(k,579) * lu(k,577) - lu(k,580) = lu(k,580) * lu(k,577) - lu(k,581) = lu(k,581) * lu(k,577) - lu(k,582) = lu(k,582) * lu(k,577) - lu(k,583) = lu(k,583) * lu(k,577) - lu(k,584) = lu(k,584) * lu(k,577) - lu(k,585) = lu(k,585) * lu(k,577) - lu(k,586) = lu(k,586) * lu(k,577) - lu(k,851) = lu(k,851) - lu(k,578) * lu(k,850) - lu(k,852) = lu(k,852) - lu(k,579) * lu(k,850) - lu(k,853) = lu(k,853) - lu(k,580) * lu(k,850) - lu(k,854) = lu(k,854) - lu(k,581) * lu(k,850) - lu(k,855) = lu(k,855) - lu(k,582) * lu(k,850) - lu(k,856) = lu(k,856) - lu(k,583) * lu(k,850) - lu(k,858) = lu(k,858) - lu(k,584) * lu(k,850) - lu(k,859) = lu(k,859) - lu(k,585) * lu(k,850) - lu(k,860) = lu(k,860) - lu(k,586) * lu(k,850) - lu(k,1467) = lu(k,1467) - lu(k,578) * lu(k,1466) - lu(k,1481) = lu(k,1481) - lu(k,579) * lu(k,1466) - lu(k,1485) = lu(k,1485) - lu(k,580) * lu(k,1466) - lu(k,1486) = lu(k,1486) - lu(k,581) * lu(k,1466) - lu(k,1496) = lu(k,1496) - lu(k,582) * lu(k,1466) - lu(k,1507) = lu(k,1507) - lu(k,583) * lu(k,1466) - lu(k,1513) = lu(k,1513) - lu(k,584) * lu(k,1466) - lu(k,1515) = lu(k,1515) - lu(k,585) * lu(k,1466) - lu(k,1516) = lu(k,1516) - lu(k,586) * lu(k,1466) - lu(k,1640) = lu(k,1640) - lu(k,578) * lu(k,1639) - lu(k,1655) = lu(k,1655) - lu(k,579) * lu(k,1639) - lu(k,1663) = lu(k,1663) - lu(k,580) * lu(k,1639) - lu(k,1664) = lu(k,1664) - lu(k,581) * lu(k,1639) - lu(k,1678) = lu(k,1678) - lu(k,582) * lu(k,1639) - lu(k,1690) = lu(k,1690) - lu(k,583) * lu(k,1639) - lu(k,1696) = lu(k,1696) - lu(k,584) * lu(k,1639) - lu(k,1698) = lu(k,1698) - lu(k,585) * lu(k,1639) - lu(k,1699) = lu(k,1699) - lu(k,586) * lu(k,1639) - lu(k,588) = 1._r8 / lu(k,588) - lu(k,589) = lu(k,589) * lu(k,588) - lu(k,590) = lu(k,590) * lu(k,588) - lu(k,591) = lu(k,591) * lu(k,588) - lu(k,592) = lu(k,592) * lu(k,588) - lu(k,593) = lu(k,593) * lu(k,588) - lu(k,594) = lu(k,594) * lu(k,588) - lu(k,855) = lu(k,855) - lu(k,589) * lu(k,851) - lu(k,856) = lu(k,856) - lu(k,590) * lu(k,851) - lu(k,857) = lu(k,857) - lu(k,591) * lu(k,851) - lu(k,858) = lu(k,858) - lu(k,592) * lu(k,851) - lu(k,859) = lu(k,859) - lu(k,593) * lu(k,851) - lu(k,861) = lu(k,861) - lu(k,594) * lu(k,851) - lu(k,1381) = lu(k,1381) - lu(k,589) * lu(k,1355) - lu(k,1391) = lu(k,1391) - lu(k,590) * lu(k,1355) - lu(k,1395) = lu(k,1395) - lu(k,591) * lu(k,1355) - lu(k,1397) = lu(k,1397) - lu(k,592) * lu(k,1355) - lu(k,1399) = lu(k,1399) - lu(k,593) * lu(k,1355) - lu(k,1401) = lu(k,1401) - lu(k,594) * lu(k,1355) - lu(k,1496) = lu(k,1496) - lu(k,589) * lu(k,1467) - lu(k,1507) = lu(k,1507) - lu(k,590) * lu(k,1467) - lu(k,1511) = lu(k,1511) - lu(k,591) * lu(k,1467) - lu(k,1513) = lu(k,1513) - lu(k,592) * lu(k,1467) - lu(k,1515) = lu(k,1515) - lu(k,593) * lu(k,1467) - lu(k,1517) = lu(k,1517) - lu(k,594) * lu(k,1467) - lu(k,1678) = lu(k,1678) - lu(k,589) * lu(k,1640) - lu(k,1690) = lu(k,1690) - lu(k,590) * lu(k,1640) - lu(k,1694) = lu(k,1694) - lu(k,591) * lu(k,1640) - lu(k,1696) = lu(k,1696) - lu(k,592) * lu(k,1640) - lu(k,1698) = lu(k,1698) - lu(k,593) * lu(k,1640) - lu(k,1700) = lu(k,1700) - lu(k,594) * lu(k,1640) - lu(k,596) = 1._r8 / lu(k,596) - lu(k,597) = lu(k,597) * lu(k,596) - lu(k,598) = lu(k,598) * lu(k,596) - lu(k,599) = lu(k,599) * lu(k,596) - lu(k,600) = lu(k,600) * lu(k,596) - lu(k,601) = lu(k,601) * lu(k,596) - lu(k,602) = lu(k,602) * lu(k,596) - lu(k,1087) = - lu(k,597) * lu(k,1081) - lu(k,1089) = - lu(k,598) * lu(k,1081) - lu(k,1091) = - lu(k,599) * lu(k,1081) - lu(k,1096) = lu(k,1096) - lu(k,600) * lu(k,1081) - lu(k,1097) = lu(k,1097) - lu(k,601) * lu(k,1081) - lu(k,1098) = lu(k,1098) - lu(k,602) * lu(k,1081) - lu(k,1149) = - lu(k,597) * lu(k,1141) - lu(k,1150) = lu(k,1150) - lu(k,598) * lu(k,1141) - lu(k,1153) = lu(k,1153) - lu(k,599) * lu(k,1141) - lu(k,1160) = lu(k,1160) - lu(k,600) * lu(k,1141) - lu(k,1161) = lu(k,1161) - lu(k,601) * lu(k,1141) - lu(k,1162) = lu(k,1162) - lu(k,602) * lu(k,1141) - lu(k,1225) = lu(k,1225) - lu(k,597) * lu(k,1214) - lu(k,1226) = - lu(k,598) * lu(k,1214) - lu(k,1228) = - lu(k,599) * lu(k,1214) - lu(k,1236) = lu(k,1236) - lu(k,600) * lu(k,1214) - lu(k,1237) = lu(k,1237) - lu(k,601) * lu(k,1214) - lu(k,1238) = lu(k,1238) - lu(k,602) * lu(k,1214) - lu(k,1498) = lu(k,1498) - lu(k,597) * lu(k,1468) - lu(k,1500) = - lu(k,598) * lu(k,1468) - lu(k,1503) = - lu(k,599) * lu(k,1468) - lu(k,1513) = lu(k,1513) - lu(k,600) * lu(k,1468) - lu(k,1515) = lu(k,1515) - lu(k,601) * lu(k,1468) - lu(k,1516) = lu(k,1516) - lu(k,602) * lu(k,1468) - lu(k,1680) = lu(k,1680) - lu(k,597) * lu(k,1641) - lu(k,1682) = lu(k,1682) - lu(k,598) * lu(k,1641) - lu(k,1686) = lu(k,1686) - lu(k,599) * lu(k,1641) - lu(k,1696) = lu(k,1696) - lu(k,600) * lu(k,1641) - lu(k,1698) = lu(k,1698) - lu(k,601) * lu(k,1641) - lu(k,1699) = lu(k,1699) - lu(k,602) * lu(k,1641) - lu(k,607) = 1._r8 / lu(k,607) - lu(k,608) = lu(k,608) * lu(k,607) - lu(k,609) = lu(k,609) * lu(k,607) - lu(k,610) = lu(k,610) * lu(k,607) - lu(k,611) = lu(k,611) * lu(k,607) - lu(k,612) = lu(k,612) * lu(k,607) - lu(k,613) = lu(k,613) * lu(k,607) - lu(k,614) = lu(k,614) * lu(k,607) - lu(k,615) = lu(k,615) * lu(k,607) - lu(k,616) = lu(k,616) * lu(k,607) - lu(k,617) = lu(k,617) * lu(k,607) - lu(k,653) = lu(k,653) - lu(k,608) * lu(k,652) - lu(k,654) = lu(k,654) - lu(k,609) * lu(k,652) - lu(k,655) = lu(k,655) - lu(k,610) * lu(k,652) - lu(k,656) = lu(k,656) - lu(k,611) * lu(k,652) - lu(k,657) = lu(k,657) - lu(k,612) * lu(k,652) - lu(k,658) = lu(k,658) - lu(k,613) * lu(k,652) - lu(k,659) = lu(k,659) - lu(k,614) * lu(k,652) - lu(k,660) = lu(k,660) - lu(k,615) * lu(k,652) - lu(k,662) = lu(k,662) - lu(k,616) * lu(k,652) - lu(k,663) = - lu(k,617) * lu(k,652) - lu(k,1471) = lu(k,1471) - lu(k,608) * lu(k,1469) - lu(k,1473) = lu(k,1473) - lu(k,609) * lu(k,1469) - lu(k,1474) = lu(k,1474) - lu(k,610) * lu(k,1469) - lu(k,1483) = lu(k,1483) - lu(k,611) * lu(k,1469) - lu(k,1484) = lu(k,1484) - lu(k,612) * lu(k,1469) - lu(k,1490) = lu(k,1490) - lu(k,613) * lu(k,1469) - lu(k,1501) = lu(k,1501) - lu(k,614) * lu(k,1469) - lu(k,1507) = lu(k,1507) - lu(k,615) * lu(k,1469) - lu(k,1513) = lu(k,1513) - lu(k,616) * lu(k,1469) - lu(k,1515) = lu(k,1515) - lu(k,617) * lu(k,1469) - lu(k,1644) = lu(k,1644) - lu(k,608) * lu(k,1642) - lu(k,1646) = lu(k,1646) - lu(k,609) * lu(k,1642) - lu(k,1647) = lu(k,1647) - lu(k,610) * lu(k,1642) - lu(k,1659) = lu(k,1659) - lu(k,611) * lu(k,1642) - lu(k,1660) = lu(k,1660) - lu(k,612) * lu(k,1642) - lu(k,1672) = lu(k,1672) - lu(k,613) * lu(k,1642) - lu(k,1683) = lu(k,1683) - lu(k,614) * lu(k,1642) - lu(k,1690) = lu(k,1690) - lu(k,615) * lu(k,1642) - lu(k,1696) = lu(k,1696) - lu(k,616) * lu(k,1642) - lu(k,1698) = lu(k,1698) - lu(k,617) * lu(k,1642) + lu(k,598) = 1._r8 / lu(k,598) + lu(k,599) = lu(k,599) * lu(k,598) + lu(k,600) = lu(k,600) * lu(k,598) + lu(k,601) = lu(k,601) * lu(k,598) + lu(k,602) = lu(k,602) * lu(k,598) + lu(k,603) = lu(k,603) * lu(k,598) + lu(k,604) = lu(k,604) * lu(k,598) + lu(k,605) = lu(k,605) * lu(k,598) + lu(k,1860) = lu(k,1860) - lu(k,599) * lu(k,1842) + lu(k,1883) = lu(k,1883) - lu(k,600) * lu(k,1842) + lu(k,1891) = lu(k,1891) - lu(k,601) * lu(k,1842) + lu(k,1917) = lu(k,1917) - lu(k,602) * lu(k,1842) + lu(k,1921) = lu(k,1921) - lu(k,603) * lu(k,1842) + lu(k,1924) = lu(k,1924) - lu(k,604) * lu(k,1842) + lu(k,1926) = lu(k,1926) - lu(k,605) * lu(k,1842) + lu(k,2240) = - lu(k,599) * lu(k,2237) + lu(k,2245) = lu(k,2245) - lu(k,600) * lu(k,2237) + lu(k,2247) = lu(k,2247) - lu(k,601) * lu(k,2237) + lu(k,2259) = lu(k,2259) - lu(k,602) * lu(k,2237) + lu(k,2263) = lu(k,2263) - lu(k,603) * lu(k,2237) + lu(k,2266) = lu(k,2266) - lu(k,604) * lu(k,2237) + lu(k,2268) = lu(k,2268) - lu(k,605) * lu(k,2237) + lu(k,2282) = - lu(k,599) * lu(k,2279) + lu(k,2290) = lu(k,2290) - lu(k,600) * lu(k,2279) + lu(k,2297) = lu(k,2297) - lu(k,601) * lu(k,2279) + lu(k,2320) = lu(k,2320) - lu(k,602) * lu(k,2279) + lu(k,2324) = lu(k,2324) - lu(k,603) * lu(k,2279) + lu(k,2327) = lu(k,2327) - lu(k,604) * lu(k,2279) + lu(k,2329) = lu(k,2329) - lu(k,605) * lu(k,2279) + lu(k,606) = 1._r8 / lu(k,606) + lu(k,607) = lu(k,607) * lu(k,606) + lu(k,608) = lu(k,608) * lu(k,606) + lu(k,609) = lu(k,609) * lu(k,606) + lu(k,610) = lu(k,610) * lu(k,606) + lu(k,611) = lu(k,611) * lu(k,606) + lu(k,612) = lu(k,612) * lu(k,606) + lu(k,613) = lu(k,613) * lu(k,606) + lu(k,1576) = lu(k,1576) - lu(k,607) * lu(k,1556) + lu(k,1583) = lu(k,1583) - lu(k,608) * lu(k,1556) + lu(k,1589) = lu(k,1589) - lu(k,609) * lu(k,1556) + lu(k,1604) = lu(k,1604) - lu(k,610) * lu(k,1556) + lu(k,1606) = lu(k,1606) - lu(k,611) * lu(k,1556) + lu(k,1612) = lu(k,1612) - lu(k,612) * lu(k,1556) + lu(k,1615) = lu(k,1615) - lu(k,613) * lu(k,1556) + lu(k,1880) = lu(k,1880) - lu(k,607) * lu(k,1843) + lu(k,1890) = lu(k,1890) - lu(k,608) * lu(k,1843) + lu(k,1896) = lu(k,1896) - lu(k,609) * lu(k,1843) + lu(k,1913) = lu(k,1913) - lu(k,610) * lu(k,1843) + lu(k,1915) = lu(k,1915) - lu(k,611) * lu(k,1843) + lu(k,1921) = lu(k,1921) - lu(k,612) * lu(k,1843) + lu(k,1924) = lu(k,1924) - lu(k,613) * lu(k,1843) + lu(k,2041) = lu(k,2041) - lu(k,607) * lu(k,2037) + lu(k,2051) = lu(k,2051) - lu(k,608) * lu(k,2037) + lu(k,2057) = - lu(k,609) * lu(k,2037) + lu(k,2073) = lu(k,2073) - lu(k,610) * lu(k,2037) + lu(k,2075) = lu(k,2075) - lu(k,611) * lu(k,2037) + lu(k,2081) = lu(k,2081) - lu(k,612) * lu(k,2037) + lu(k,2084) = lu(k,2084) - lu(k,613) * lu(k,2037) + lu(k,614) = 1._r8 / lu(k,614) + lu(k,615) = lu(k,615) * lu(k,614) + lu(k,616) = lu(k,616) * lu(k,614) + lu(k,617) = lu(k,617) * lu(k,614) + lu(k,618) = lu(k,618) * lu(k,614) + lu(k,619) = lu(k,619) * lu(k,614) + lu(k,620) = lu(k,620) * lu(k,614) + lu(k,621) = lu(k,621) * lu(k,614) + lu(k,622) = lu(k,622) * lu(k,614) + lu(k,1737) = lu(k,1737) - lu(k,615) * lu(k,1733) + lu(k,1742) = lu(k,1742) - lu(k,616) * lu(k,1733) + lu(k,1744) = lu(k,1744) - lu(k,617) * lu(k,1733) + lu(k,1745) = lu(k,1745) - lu(k,618) * lu(k,1733) + lu(k,1747) = lu(k,1747) - lu(k,619) * lu(k,1733) + lu(k,1752) = lu(k,1752) - lu(k,620) * lu(k,1733) + lu(k,1753) = lu(k,1753) - lu(k,621) * lu(k,1733) + lu(k,1755) = lu(k,1755) - lu(k,622) * lu(k,1733) + lu(k,1909) = lu(k,1909) - lu(k,615) * lu(k,1844) + lu(k,1914) = lu(k,1914) - lu(k,616) * lu(k,1844) + lu(k,1916) = lu(k,1916) - lu(k,617) * lu(k,1844) + lu(k,1917) = lu(k,1917) - lu(k,618) * lu(k,1844) + lu(k,1919) = lu(k,1919) - lu(k,619) * lu(k,1844) + lu(k,1924) = lu(k,1924) - lu(k,620) * lu(k,1844) + lu(k,1925) = lu(k,1925) - lu(k,621) * lu(k,1844) + lu(k,1927) = lu(k,1927) - lu(k,622) * lu(k,1844) + lu(k,2251) = lu(k,2251) - lu(k,615) * lu(k,2238) + lu(k,2256) = lu(k,2256) - lu(k,616) * lu(k,2238) + lu(k,2258) = lu(k,2258) - lu(k,617) * lu(k,2238) + lu(k,2259) = lu(k,2259) - lu(k,618) * lu(k,2238) + lu(k,2261) = lu(k,2261) - lu(k,619) * lu(k,2238) + lu(k,2266) = lu(k,2266) - lu(k,620) * lu(k,2238) + lu(k,2267) = lu(k,2267) - lu(k,621) * lu(k,2238) + lu(k,2269) = lu(k,2269) - lu(k,622) * lu(k,2238) + lu(k,623) = 1._r8 / lu(k,623) + lu(k,624) = lu(k,624) * lu(k,623) + lu(k,625) = lu(k,625) * lu(k,623) + lu(k,626) = lu(k,626) * lu(k,623) + lu(k,627) = lu(k,627) * lu(k,623) + lu(k,628) = lu(k,628) * lu(k,623) + lu(k,629) = lu(k,629) * lu(k,623) + lu(k,1390) = lu(k,1390) - lu(k,624) * lu(k,1387) + lu(k,1395) = lu(k,1395) - lu(k,625) * lu(k,1387) + lu(k,1398) = lu(k,1398) - lu(k,626) * lu(k,1387) + lu(k,1400) = lu(k,1400) - lu(k,627) * lu(k,1387) + lu(k,1402) = lu(k,1402) - lu(k,628) * lu(k,1387) + lu(k,1406) = - lu(k,629) * lu(k,1387) + lu(k,1411) = lu(k,1411) - lu(k,624) * lu(k,1409) + lu(k,1426) = lu(k,1426) - lu(k,625) * lu(k,1409) + lu(k,1430) = lu(k,1430) - lu(k,626) * lu(k,1409) + lu(k,1432) = lu(k,1432) - lu(k,627) * lu(k,1409) + lu(k,1434) = lu(k,1434) - lu(k,628) * lu(k,1409) + lu(k,1438) = - lu(k,629) * lu(k,1409) + lu(k,1871) = lu(k,1871) - lu(k,624) * lu(k,1845) + lu(k,1907) = lu(k,1907) - lu(k,625) * lu(k,1845) + lu(k,1914) = lu(k,1914) - lu(k,626) * lu(k,1845) + lu(k,1917) = lu(k,1917) - lu(k,627) * lu(k,1845) + lu(k,1921) = lu(k,1921) - lu(k,628) * lu(k,1845) + lu(k,1927) = lu(k,1927) - lu(k,629) * lu(k,1845) + lu(k,2184) = lu(k,2184) - lu(k,624) * lu(k,2162) + lu(k,2210) = lu(k,2210) - lu(k,625) * lu(k,2162) + lu(k,2217) = lu(k,2217) - lu(k,626) * lu(k,2162) + lu(k,2220) = lu(k,2220) - lu(k,627) * lu(k,2162) + lu(k,2224) = lu(k,2224) - lu(k,628) * lu(k,2162) + lu(k,2230) = lu(k,2230) - lu(k,629) * lu(k,2162) + lu(k,630) = 1._r8 / lu(k,630) + lu(k,631) = lu(k,631) * lu(k,630) + lu(k,632) = lu(k,632) * lu(k,630) + lu(k,633) = lu(k,633) * lu(k,630) + lu(k,634) = lu(k,634) * lu(k,630) + lu(k,635) = lu(k,635) * lu(k,630) + lu(k,636) = lu(k,636) * lu(k,630) + lu(k,637) = lu(k,637) * lu(k,630) + lu(k,638) = lu(k,638) * lu(k,630) + lu(k,1390) = lu(k,1390) - lu(k,631) * lu(k,1388) + lu(k,1392) = - lu(k,632) * lu(k,1388) + lu(k,1394) = lu(k,1394) - lu(k,633) * lu(k,1388) + lu(k,1399) = lu(k,1399) - lu(k,634) * lu(k,1388) + lu(k,1400) = lu(k,1400) - lu(k,635) * lu(k,1388) + lu(k,1402) = lu(k,1402) - lu(k,636) * lu(k,1388) + lu(k,1403) = lu(k,1403) - lu(k,637) * lu(k,1388) + lu(k,1404) = lu(k,1404) - lu(k,638) * lu(k,1388) + lu(k,1685) = lu(k,1685) - lu(k,631) * lu(k,1680) + lu(k,1691) = - lu(k,632) * lu(k,1680) + lu(k,1694) = lu(k,1694) - lu(k,633) * lu(k,1680) + lu(k,1702) = lu(k,1702) - lu(k,634) * lu(k,1680) + lu(k,1704) = lu(k,1704) - lu(k,635) * lu(k,1680) + lu(k,1708) = lu(k,1708) - lu(k,636) * lu(k,1680) + lu(k,1709) = lu(k,1709) - lu(k,637) * lu(k,1680) + lu(k,1711) = lu(k,1711) - lu(k,638) * lu(k,1680) + lu(k,1871) = lu(k,1871) - lu(k,631) * lu(k,1846) + lu(k,1895) = lu(k,1895) - lu(k,632) * lu(k,1846) + lu(k,1906) = lu(k,1906) - lu(k,633) * lu(k,1846) + lu(k,1915) = lu(k,1915) - lu(k,634) * lu(k,1846) + lu(k,1917) = lu(k,1917) - lu(k,635) * lu(k,1846) + lu(k,1921) = lu(k,1921) - lu(k,636) * lu(k,1846) + lu(k,1922) = lu(k,1922) - lu(k,637) * lu(k,1846) + lu(k,1924) = lu(k,1924) - lu(k,638) * lu(k,1846) + lu(k,639) = 1._r8 / lu(k,639) + lu(k,640) = lu(k,640) * lu(k,639) + lu(k,641) = lu(k,641) * lu(k,639) + lu(k,642) = lu(k,642) * lu(k,639) + lu(k,643) = lu(k,643) * lu(k,639) + lu(k,644) = lu(k,644) * lu(k,639) + lu(k,645) = lu(k,645) * lu(k,639) + lu(k,1917) = lu(k,1917) - lu(k,640) * lu(k,1847) + lu(k,1919) = lu(k,1919) - lu(k,641) * lu(k,1847) + lu(k,1920) = lu(k,1920) - lu(k,642) * lu(k,1847) + lu(k,1924) = lu(k,1924) - lu(k,643) * lu(k,1847) + lu(k,1925) = lu(k,1925) - lu(k,644) * lu(k,1847) + lu(k,1927) = lu(k,1927) - lu(k,645) * lu(k,1847) + lu(k,1996) = lu(k,1996) - lu(k,640) * lu(k,1979) + lu(k,1998) = lu(k,1998) - lu(k,641) * lu(k,1979) + lu(k,1999) = lu(k,1999) - lu(k,642) * lu(k,1979) + lu(k,2003) = lu(k,2003) - lu(k,643) * lu(k,1979) + lu(k,2004) = lu(k,2004) - lu(k,644) * lu(k,1979) + lu(k,2006) = - lu(k,645) * lu(k,1979) + lu(k,2220) = lu(k,2220) - lu(k,640) * lu(k,2163) + lu(k,2222) = lu(k,2222) - lu(k,641) * lu(k,2163) + lu(k,2223) = lu(k,2223) - lu(k,642) * lu(k,2163) + lu(k,2227) = lu(k,2227) - lu(k,643) * lu(k,2163) + lu(k,2228) = lu(k,2228) - lu(k,644) * lu(k,2163) + lu(k,2230) = lu(k,2230) - lu(k,645) * lu(k,2163) + lu(k,2259) = lu(k,2259) - lu(k,640) * lu(k,2239) + lu(k,2261) = lu(k,2261) - lu(k,641) * lu(k,2239) + lu(k,2262) = - lu(k,642) * lu(k,2239) + lu(k,2266) = lu(k,2266) - lu(k,643) * lu(k,2239) + lu(k,2267) = lu(k,2267) - lu(k,644) * lu(k,2239) + lu(k,2269) = lu(k,2269) - lu(k,645) * lu(k,2239) end do end subroutine lu_fac13 subroutine lu_fac14( avec_len, lu ) @@ -1985,234 +1851,162 @@ subroutine lu_fac14( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,620) = 1._r8 / lu(k,620) - lu(k,621) = lu(k,621) * lu(k,620) - lu(k,622) = lu(k,622) * lu(k,620) - lu(k,623) = lu(k,623) * lu(k,620) - lu(k,624) = lu(k,624) * lu(k,620) - lu(k,625) = lu(k,625) * lu(k,620) - lu(k,626) = lu(k,626) * lu(k,620) - lu(k,1372) = lu(k,1372) - lu(k,621) * lu(k,1356) - lu(k,1395) = lu(k,1395) - lu(k,622) * lu(k,1356) - lu(k,1397) = lu(k,1397) - lu(k,623) * lu(k,1356) - lu(k,1399) = lu(k,1399) - lu(k,624) * lu(k,1356) - lu(k,1400) = lu(k,1400) - lu(k,625) * lu(k,1356) - lu(k,1401) = lu(k,1401) - lu(k,626) * lu(k,1356) - lu(k,1488) = lu(k,1488) - lu(k,621) * lu(k,1470) - lu(k,1511) = lu(k,1511) - lu(k,622) * lu(k,1470) - lu(k,1513) = lu(k,1513) - lu(k,623) * lu(k,1470) - lu(k,1515) = lu(k,1515) - lu(k,624) * lu(k,1470) - lu(k,1516) = lu(k,1516) - lu(k,625) * lu(k,1470) - lu(k,1517) = lu(k,1517) - lu(k,626) * lu(k,1470) - lu(k,1669) = lu(k,1669) - lu(k,621) * lu(k,1643) - lu(k,1694) = lu(k,1694) - lu(k,622) * lu(k,1643) - lu(k,1696) = lu(k,1696) - lu(k,623) * lu(k,1643) - lu(k,1698) = lu(k,1698) - lu(k,624) * lu(k,1643) - lu(k,1699) = lu(k,1699) - lu(k,625) * lu(k,1643) - lu(k,1700) = lu(k,1700) - lu(k,626) * lu(k,1643) - lu(k,1903) = - lu(k,621) * lu(k,1892) - lu(k,1925) = lu(k,1925) - lu(k,622) * lu(k,1892) - lu(k,1927) = lu(k,1927) - lu(k,623) * lu(k,1892) - lu(k,1929) = lu(k,1929) - lu(k,624) * lu(k,1892) - lu(k,1930) = lu(k,1930) - lu(k,625) * lu(k,1892) - lu(k,1931) = lu(k,1931) - lu(k,626) * lu(k,1892) - lu(k,2031) = - lu(k,621) * lu(k,2025) - lu(k,2039) = - lu(k,622) * lu(k,2025) - lu(k,2041) = lu(k,2041) - lu(k,623) * lu(k,2025) - lu(k,2043) = lu(k,2043) - lu(k,624) * lu(k,2025) - lu(k,2044) = lu(k,2044) - lu(k,625) * lu(k,2025) - lu(k,2045) = - lu(k,626) * lu(k,2025) - lu(k,627) = 1._r8 / lu(k,627) - lu(k,628) = lu(k,628) * lu(k,627) - lu(k,629) = lu(k,629) * lu(k,627) - lu(k,630) = lu(k,630) * lu(k,627) - lu(k,631) = lu(k,631) * lu(k,627) - lu(k,632) = lu(k,632) * lu(k,627) - lu(k,641) = lu(k,641) - lu(k,628) * lu(k,637) - lu(k,642) = lu(k,642) - lu(k,629) * lu(k,637) - lu(k,644) = lu(k,644) - lu(k,630) * lu(k,637) - lu(k,645) = lu(k,645) - lu(k,631) * lu(k,637) - lu(k,647) = lu(k,647) - lu(k,632) * lu(k,637) - lu(k,657) = lu(k,657) - lu(k,628) * lu(k,653) - lu(k,658) = lu(k,658) - lu(k,629) * lu(k,653) - lu(k,661) = lu(k,661) - lu(k,630) * lu(k,653) - lu(k,662) = lu(k,662) - lu(k,631) * lu(k,653) - lu(k,664) = lu(k,664) - lu(k,632) * lu(k,653) - lu(k,1367) = lu(k,1367) - lu(k,628) * lu(k,1357) - lu(k,1375) = lu(k,1375) - lu(k,629) * lu(k,1357) - lu(k,1395) = lu(k,1395) - lu(k,630) * lu(k,1357) - lu(k,1397) = lu(k,1397) - lu(k,631) * lu(k,1357) - lu(k,1401) = lu(k,1401) - lu(k,632) * lu(k,1357) - lu(k,1484) = lu(k,1484) - lu(k,628) * lu(k,1471) - lu(k,1490) = lu(k,1490) - lu(k,629) * lu(k,1471) - lu(k,1511) = lu(k,1511) - lu(k,630) * lu(k,1471) - lu(k,1513) = lu(k,1513) - lu(k,631) * lu(k,1471) - lu(k,1517) = lu(k,1517) - lu(k,632) * lu(k,1471) - lu(k,1660) = lu(k,1660) - lu(k,628) * lu(k,1644) - lu(k,1672) = lu(k,1672) - lu(k,629) * lu(k,1644) - lu(k,1694) = lu(k,1694) - lu(k,630) * lu(k,1644) - lu(k,1696) = lu(k,1696) - lu(k,631) * lu(k,1644) - lu(k,1700) = lu(k,1700) - lu(k,632) * lu(k,1644) - lu(k,1747) = - lu(k,628) * lu(k,1742) - lu(k,1749) = - lu(k,629) * lu(k,1742) - lu(k,1758) = lu(k,1758) - lu(k,630) * lu(k,1742) - lu(k,1760) = lu(k,1760) - lu(k,631) * lu(k,1742) - lu(k,1764) = lu(k,1764) - lu(k,632) * lu(k,1742) - lu(k,638) = 1._r8 / lu(k,638) - lu(k,639) = lu(k,639) * lu(k,638) - lu(k,640) = lu(k,640) * lu(k,638) - lu(k,641) = lu(k,641) * lu(k,638) - lu(k,642) = lu(k,642) * lu(k,638) - lu(k,643) = lu(k,643) * lu(k,638) - lu(k,644) = lu(k,644) * lu(k,638) - lu(k,645) = lu(k,645) * lu(k,638) - lu(k,646) = lu(k,646) * lu(k,638) - lu(k,647) = lu(k,647) * lu(k,638) - lu(k,1360) = lu(k,1360) - lu(k,639) * lu(k,1358) - lu(k,1366) = lu(k,1366) - lu(k,640) * lu(k,1358) - lu(k,1367) = lu(k,1367) - lu(k,641) * lu(k,1358) - lu(k,1375) = lu(k,1375) - lu(k,642) * lu(k,1358) - lu(k,1385) = lu(k,1385) - lu(k,643) * lu(k,1358) - lu(k,1395) = lu(k,1395) - lu(k,644) * lu(k,1358) - lu(k,1397) = lu(k,1397) - lu(k,645) * lu(k,1358) - lu(k,1399) = lu(k,1399) - lu(k,646) * lu(k,1358) - lu(k,1401) = lu(k,1401) - lu(k,647) * lu(k,1358) - lu(k,1474) = lu(k,1474) - lu(k,639) * lu(k,1472) - lu(k,1483) = lu(k,1483) - lu(k,640) * lu(k,1472) - lu(k,1484) = lu(k,1484) - lu(k,641) * lu(k,1472) - lu(k,1490) = lu(k,1490) - lu(k,642) * lu(k,1472) - lu(k,1501) = lu(k,1501) - lu(k,643) * lu(k,1472) - lu(k,1511) = lu(k,1511) - lu(k,644) * lu(k,1472) - lu(k,1513) = lu(k,1513) - lu(k,645) * lu(k,1472) - lu(k,1515) = lu(k,1515) - lu(k,646) * lu(k,1472) - lu(k,1517) = lu(k,1517) - lu(k,647) * lu(k,1472) - lu(k,1647) = lu(k,1647) - lu(k,639) * lu(k,1645) - lu(k,1659) = lu(k,1659) - lu(k,640) * lu(k,1645) - lu(k,1660) = lu(k,1660) - lu(k,641) * lu(k,1645) - lu(k,1672) = lu(k,1672) - lu(k,642) * lu(k,1645) - lu(k,1683) = lu(k,1683) - lu(k,643) * lu(k,1645) - lu(k,1694) = lu(k,1694) - lu(k,644) * lu(k,1645) - lu(k,1696) = lu(k,1696) - lu(k,645) * lu(k,1645) - lu(k,1698) = lu(k,1698) - lu(k,646) * lu(k,1645) - lu(k,1700) = lu(k,1700) - lu(k,647) * lu(k,1645) - lu(k,654) = 1._r8 / lu(k,654) - lu(k,655) = lu(k,655) * lu(k,654) - lu(k,656) = lu(k,656) * lu(k,654) - lu(k,657) = lu(k,657) * lu(k,654) - lu(k,658) = lu(k,658) * lu(k,654) - lu(k,659) = lu(k,659) * lu(k,654) - lu(k,660) = lu(k,660) * lu(k,654) - lu(k,661) = lu(k,661) * lu(k,654) - lu(k,662) = lu(k,662) * lu(k,654) - lu(k,663) = lu(k,663) * lu(k,654) - lu(k,664) = lu(k,664) * lu(k,654) - lu(k,1360) = lu(k,1360) - lu(k,655) * lu(k,1359) - lu(k,1366) = lu(k,1366) - lu(k,656) * lu(k,1359) - lu(k,1367) = lu(k,1367) - lu(k,657) * lu(k,1359) - lu(k,1375) = lu(k,1375) - lu(k,658) * lu(k,1359) - lu(k,1385) = lu(k,1385) - lu(k,659) * lu(k,1359) - lu(k,1391) = lu(k,1391) - lu(k,660) * lu(k,1359) - lu(k,1395) = lu(k,1395) - lu(k,661) * lu(k,1359) - lu(k,1397) = lu(k,1397) - lu(k,662) * lu(k,1359) - lu(k,1399) = lu(k,1399) - lu(k,663) * lu(k,1359) - lu(k,1401) = lu(k,1401) - lu(k,664) * lu(k,1359) - lu(k,1474) = lu(k,1474) - lu(k,655) * lu(k,1473) - lu(k,1483) = lu(k,1483) - lu(k,656) * lu(k,1473) - lu(k,1484) = lu(k,1484) - lu(k,657) * lu(k,1473) - lu(k,1490) = lu(k,1490) - lu(k,658) * lu(k,1473) - lu(k,1501) = lu(k,1501) - lu(k,659) * lu(k,1473) - lu(k,1507) = lu(k,1507) - lu(k,660) * lu(k,1473) - lu(k,1511) = lu(k,1511) - lu(k,661) * lu(k,1473) - lu(k,1513) = lu(k,1513) - lu(k,662) * lu(k,1473) - lu(k,1515) = lu(k,1515) - lu(k,663) * lu(k,1473) - lu(k,1517) = lu(k,1517) - lu(k,664) * lu(k,1473) - lu(k,1647) = lu(k,1647) - lu(k,655) * lu(k,1646) - lu(k,1659) = lu(k,1659) - lu(k,656) * lu(k,1646) - lu(k,1660) = lu(k,1660) - lu(k,657) * lu(k,1646) - lu(k,1672) = lu(k,1672) - lu(k,658) * lu(k,1646) - lu(k,1683) = lu(k,1683) - lu(k,659) * lu(k,1646) - lu(k,1690) = lu(k,1690) - lu(k,660) * lu(k,1646) - lu(k,1694) = lu(k,1694) - lu(k,661) * lu(k,1646) - lu(k,1696) = lu(k,1696) - lu(k,662) * lu(k,1646) - lu(k,1698) = lu(k,1698) - lu(k,663) * lu(k,1646) - lu(k,1700) = lu(k,1700) - lu(k,664) * lu(k,1646) - lu(k,665) = 1._r8 / lu(k,665) - lu(k,666) = lu(k,666) * lu(k,665) - lu(k,667) = lu(k,667) * lu(k,665) - lu(k,668) = lu(k,668) * lu(k,665) - lu(k,669) = lu(k,669) * lu(k,665) - lu(k,670) = lu(k,670) * lu(k,665) - lu(k,671) = lu(k,671) * lu(k,665) - lu(k,672) = lu(k,672) * lu(k,665) - lu(k,1375) = lu(k,1375) - lu(k,666) * lu(k,1360) - lu(k,1385) = lu(k,1385) - lu(k,667) * lu(k,1360) - lu(k,1395) = lu(k,1395) - lu(k,668) * lu(k,1360) - lu(k,1397) = lu(k,1397) - lu(k,669) * lu(k,1360) - lu(k,1399) = lu(k,1399) - lu(k,670) * lu(k,1360) - lu(k,1401) = lu(k,1401) - lu(k,671) * lu(k,1360) - lu(k,1403) = lu(k,1403) - lu(k,672) * lu(k,1360) - lu(k,1490) = lu(k,1490) - lu(k,666) * lu(k,1474) - lu(k,1501) = lu(k,1501) - lu(k,667) * lu(k,1474) - lu(k,1511) = lu(k,1511) - lu(k,668) * lu(k,1474) - lu(k,1513) = lu(k,1513) - lu(k,669) * lu(k,1474) - lu(k,1515) = lu(k,1515) - lu(k,670) * lu(k,1474) - lu(k,1517) = lu(k,1517) - lu(k,671) * lu(k,1474) - lu(k,1519) = lu(k,1519) - lu(k,672) * lu(k,1474) - lu(k,1672) = lu(k,1672) - lu(k,666) * lu(k,1647) - lu(k,1683) = lu(k,1683) - lu(k,667) * lu(k,1647) - lu(k,1694) = lu(k,1694) - lu(k,668) * lu(k,1647) - lu(k,1696) = lu(k,1696) - lu(k,669) * lu(k,1647) - lu(k,1698) = lu(k,1698) - lu(k,670) * lu(k,1647) - lu(k,1700) = lu(k,1700) - lu(k,671) * lu(k,1647) - lu(k,1702) = lu(k,1702) - lu(k,672) * lu(k,1647) - lu(k,1749) = lu(k,1749) - lu(k,666) * lu(k,1743) - lu(k,1751) = - lu(k,667) * lu(k,1743) - lu(k,1758) = lu(k,1758) - lu(k,668) * lu(k,1743) - lu(k,1760) = lu(k,1760) - lu(k,669) * lu(k,1743) - lu(k,1762) = lu(k,1762) - lu(k,670) * lu(k,1743) - lu(k,1764) = lu(k,1764) - lu(k,671) * lu(k,1743) - lu(k,1766) = lu(k,1766) - lu(k,672) * lu(k,1743) - lu(k,674) = 1._r8 / lu(k,674) - lu(k,675) = lu(k,675) * lu(k,674) - lu(k,676) = lu(k,676) * lu(k,674) - lu(k,677) = lu(k,677) * lu(k,674) - lu(k,678) = lu(k,678) * lu(k,674) - lu(k,679) = lu(k,679) * lu(k,674) - lu(k,680) = lu(k,680) * lu(k,674) - lu(k,681) = lu(k,681) * lu(k,674) - lu(k,682) = lu(k,682) * lu(k,674) - lu(k,895) = - lu(k,675) * lu(k,890) - lu(k,896) = lu(k,896) - lu(k,676) * lu(k,890) - lu(k,899) = - lu(k,677) * lu(k,890) - lu(k,900) = lu(k,900) - lu(k,678) * lu(k,890) - lu(k,901) = lu(k,901) - lu(k,679) * lu(k,890) - lu(k,902) = lu(k,902) - lu(k,680) * lu(k,890) - lu(k,903) = - lu(k,681) * lu(k,890) - lu(k,907) = lu(k,907) - lu(k,682) * lu(k,890) - lu(k,1376) = lu(k,1376) - lu(k,675) * lu(k,1361) - lu(k,1381) = lu(k,1381) - lu(k,676) * lu(k,1361) - lu(k,1395) = lu(k,1395) - lu(k,677) * lu(k,1361) - lu(k,1397) = lu(k,1397) - lu(k,678) * lu(k,1361) - lu(k,1399) = lu(k,1399) - lu(k,679) * lu(k,1361) - lu(k,1400) = lu(k,1400) - lu(k,680) * lu(k,1361) - lu(k,1401) = lu(k,1401) - lu(k,681) * lu(k,1361) - lu(k,1409) = - lu(k,682) * lu(k,1361) - lu(k,1491) = lu(k,1491) - lu(k,675) * lu(k,1475) - lu(k,1496) = lu(k,1496) - lu(k,676) * lu(k,1475) - lu(k,1511) = lu(k,1511) - lu(k,677) * lu(k,1475) - lu(k,1513) = lu(k,1513) - lu(k,678) * lu(k,1475) - lu(k,1515) = lu(k,1515) - lu(k,679) * lu(k,1475) - lu(k,1516) = lu(k,1516) - lu(k,680) * lu(k,1475) - lu(k,1517) = lu(k,1517) - lu(k,681) * lu(k,1475) - lu(k,1525) = lu(k,1525) - lu(k,682) * lu(k,1475) - lu(k,1673) = lu(k,1673) - lu(k,675) * lu(k,1648) - lu(k,1678) = lu(k,1678) - lu(k,676) * lu(k,1648) - lu(k,1694) = lu(k,1694) - lu(k,677) * lu(k,1648) - lu(k,1696) = lu(k,1696) - lu(k,678) * lu(k,1648) - lu(k,1698) = lu(k,1698) - lu(k,679) * lu(k,1648) - lu(k,1699) = lu(k,1699) - lu(k,680) * lu(k,1648) - lu(k,1700) = lu(k,1700) - lu(k,681) * lu(k,1648) - lu(k,1708) = lu(k,1708) - lu(k,682) * lu(k,1648) + lu(k,648) = 1._r8 / lu(k,648) + lu(k,649) = lu(k,649) * lu(k,648) + lu(k,650) = lu(k,650) * lu(k,648) + lu(k,651) = lu(k,651) * lu(k,648) + lu(k,652) = lu(k,652) * lu(k,648) + lu(k,653) = lu(k,653) * lu(k,648) + lu(k,654) = lu(k,654) * lu(k,648) + lu(k,655) = lu(k,655) * lu(k,648) + lu(k,656) = lu(k,656) * lu(k,648) + lu(k,770) = lu(k,770) - lu(k,649) * lu(k,769) + lu(k,771) = lu(k,771) - lu(k,650) * lu(k,769) + lu(k,772) = lu(k,772) - lu(k,651) * lu(k,769) + lu(k,773) = lu(k,773) - lu(k,652) * lu(k,769) + lu(k,775) = lu(k,775) - lu(k,653) * lu(k,769) + lu(k,777) = lu(k,777) - lu(k,654) * lu(k,769) + lu(k,780) = - lu(k,655) * lu(k,769) + lu(k,781) = lu(k,781) - lu(k,656) * lu(k,769) + lu(k,1850) = lu(k,1850) - lu(k,649) * lu(k,1848) + lu(k,1861) = lu(k,1861) - lu(k,650) * lu(k,1848) + lu(k,1862) = lu(k,1862) - lu(k,651) * lu(k,1848) + lu(k,1864) = - lu(k,652) * lu(k,1848) + lu(k,1881) = lu(k,1881) - lu(k,653) * lu(k,1848) + lu(k,1900) = lu(k,1900) - lu(k,654) * lu(k,1848) + lu(k,1917) = lu(k,1917) - lu(k,655) * lu(k,1848) + lu(k,1924) = lu(k,1924) - lu(k,656) * lu(k,1848) + lu(k,2165) = - lu(k,649) * lu(k,2164) + lu(k,2174) = lu(k,2174) - lu(k,650) * lu(k,2164) + lu(k,2175) = lu(k,2175) - lu(k,651) * lu(k,2164) + lu(k,2177) = lu(k,2177) - lu(k,652) * lu(k,2164) + lu(k,2190) = lu(k,2190) - lu(k,653) * lu(k,2164) + lu(k,2204) = lu(k,2204) - lu(k,654) * lu(k,2164) + lu(k,2220) = lu(k,2220) - lu(k,655) * lu(k,2164) + lu(k,2227) = lu(k,2227) - lu(k,656) * lu(k,2164) + lu(k,657) = 1._r8 / lu(k,657) + lu(k,658) = lu(k,658) * lu(k,657) + lu(k,659) = lu(k,659) * lu(k,657) + lu(k,660) = lu(k,660) * lu(k,657) + lu(k,661) = lu(k,661) * lu(k,657) + lu(k,662) = lu(k,662) * lu(k,657) + lu(k,663) = lu(k,663) * lu(k,657) + lu(k,664) = lu(k,664) * lu(k,657) + lu(k,665) = lu(k,665) * lu(k,657) + lu(k,1290) = - lu(k,658) * lu(k,1285) + lu(k,1291) = - lu(k,659) * lu(k,1285) + lu(k,1292) = - lu(k,660) * lu(k,1285) + lu(k,1301) = - lu(k,661) * lu(k,1285) + lu(k,1304) = lu(k,1304) - lu(k,662) * lu(k,1285) + lu(k,1305) = - lu(k,663) * lu(k,1285) + lu(k,1307) = lu(k,1307) - lu(k,664) * lu(k,1285) + lu(k,1309) = lu(k,1309) - lu(k,665) * lu(k,1285) + lu(k,1585) = lu(k,1585) - lu(k,658) * lu(k,1557) + lu(k,1588) = lu(k,1588) - lu(k,659) * lu(k,1557) + lu(k,1589) = lu(k,1589) - lu(k,660) * lu(k,1557) + lu(k,1602) = lu(k,1602) - lu(k,661) * lu(k,1557) + lu(k,1606) = lu(k,1606) - lu(k,662) * lu(k,1557) + lu(k,1608) = lu(k,1608) - lu(k,663) * lu(k,1557) + lu(k,1612) = lu(k,1612) - lu(k,664) * lu(k,1557) + lu(k,1615) = lu(k,1615) - lu(k,665) * lu(k,1557) + lu(k,1892) = lu(k,1892) - lu(k,658) * lu(k,1849) + lu(k,1895) = lu(k,1895) - lu(k,659) * lu(k,1849) + lu(k,1896) = lu(k,1896) - lu(k,660) * lu(k,1849) + lu(k,1911) = lu(k,1911) - lu(k,661) * lu(k,1849) + lu(k,1915) = lu(k,1915) - lu(k,662) * lu(k,1849) + lu(k,1917) = lu(k,1917) - lu(k,663) * lu(k,1849) + lu(k,1921) = lu(k,1921) - lu(k,664) * lu(k,1849) + lu(k,1924) = lu(k,1924) - lu(k,665) * lu(k,1849) + lu(k,666) = 1._r8 / lu(k,666) + lu(k,667) = lu(k,667) * lu(k,666) + lu(k,668) = lu(k,668) * lu(k,666) + lu(k,669) = lu(k,669) * lu(k,666) + lu(k,745) = - lu(k,667) * lu(k,740) + lu(k,747) = lu(k,747) - lu(k,668) * lu(k,740) + lu(k,751) = lu(k,751) - lu(k,669) * lu(k,740) + lu(k,774) = - lu(k,667) * lu(k,770) + lu(k,776) = - lu(k,668) * lu(k,770) + lu(k,781) = lu(k,781) - lu(k,669) * lu(k,770) + lu(k,790) = - lu(k,667) * lu(k,785) + lu(k,792) = lu(k,792) - lu(k,668) * lu(k,785) + lu(k,798) = lu(k,798) - lu(k,669) * lu(k,785) + lu(k,1083) = - lu(k,667) * lu(k,1081) + lu(k,1086) = - lu(k,668) * lu(k,1081) + lu(k,1096) = lu(k,1096) - lu(k,669) * lu(k,1081) + lu(k,1319) = - lu(k,667) * lu(k,1315) + lu(k,1321) = - lu(k,668) * lu(k,1315) + lu(k,1341) = lu(k,1341) - lu(k,669) * lu(k,1315) + lu(k,1573) = lu(k,1573) - lu(k,667) * lu(k,1558) + lu(k,1584) = lu(k,1584) - lu(k,668) * lu(k,1558) + lu(k,1615) = lu(k,1615) - lu(k,669) * lu(k,1558) + lu(k,1875) = - lu(k,667) * lu(k,1850) + lu(k,1891) = lu(k,1891) - lu(k,668) * lu(k,1850) + lu(k,1924) = lu(k,1924) - lu(k,669) * lu(k,1850) + lu(k,2186) = lu(k,2186) - lu(k,667) * lu(k,2165) + lu(k,2196) = lu(k,2196) - lu(k,668) * lu(k,2165) + lu(k,2227) = lu(k,2227) - lu(k,669) * lu(k,2165) + lu(k,670) = 1._r8 / lu(k,670) + lu(k,671) = lu(k,671) * lu(k,670) + lu(k,672) = lu(k,672) * lu(k,670) + lu(k,673) = lu(k,673) * lu(k,670) + lu(k,674) = lu(k,674) * lu(k,670) + lu(k,675) = lu(k,675) * lu(k,670) + lu(k,954) = lu(k,954) - lu(k,671) * lu(k,950) + lu(k,955) = - lu(k,672) * lu(k,950) + lu(k,958) = lu(k,958) - lu(k,673) * lu(k,950) + lu(k,959) = lu(k,959) - lu(k,674) * lu(k,950) + lu(k,961) = lu(k,961) - lu(k,675) * lu(k,950) + lu(k,1100) = lu(k,1100) - lu(k,671) * lu(k,1098) + lu(k,1105) = lu(k,1105) - lu(k,672) * lu(k,1098) + lu(k,1108) = lu(k,1108) - lu(k,673) * lu(k,1098) + lu(k,1109) = lu(k,1109) - lu(k,674) * lu(k,1098) + lu(k,1112) = lu(k,1112) - lu(k,675) * lu(k,1098) + lu(k,1579) = lu(k,1579) - lu(k,671) * lu(k,1559) + lu(k,1602) = lu(k,1602) - lu(k,672) * lu(k,1559) + lu(k,1606) = lu(k,1606) - lu(k,673) * lu(k,1559) + lu(k,1608) = lu(k,1608) - lu(k,674) * lu(k,1559) + lu(k,1615) = lu(k,1615) - lu(k,675) * lu(k,1559) + lu(k,1633) = lu(k,1633) - lu(k,671) * lu(k,1623) + lu(k,1654) = lu(k,1654) - lu(k,672) * lu(k,1623) + lu(k,1658) = lu(k,1658) - lu(k,673) * lu(k,1623) + lu(k,1660) = lu(k,1660) - lu(k,674) * lu(k,1623) + lu(k,1667) = lu(k,1667) - lu(k,675) * lu(k,1623) + lu(k,1884) = lu(k,1884) - lu(k,671) * lu(k,1851) + lu(k,1911) = lu(k,1911) - lu(k,672) * lu(k,1851) + lu(k,1915) = lu(k,1915) - lu(k,673) * lu(k,1851) + lu(k,1917) = lu(k,1917) - lu(k,674) * lu(k,1851) + lu(k,1924) = lu(k,1924) - lu(k,675) * lu(k,1851) + lu(k,678) = 1._r8 / lu(k,678) + lu(k,679) = lu(k,679) * lu(k,678) + lu(k,680) = lu(k,680) * lu(k,678) + lu(k,681) = lu(k,681) * lu(k,678) + lu(k,682) = lu(k,682) * lu(k,678) + lu(k,683) = lu(k,683) * lu(k,678) + lu(k,1604) = lu(k,1604) - lu(k,679) * lu(k,1560) + lu(k,1606) = lu(k,1606) - lu(k,680) * lu(k,1560) + lu(k,1608) = lu(k,1608) - lu(k,681) * lu(k,1560) + lu(k,1615) = lu(k,1615) - lu(k,682) * lu(k,1560) + lu(k,1617) = lu(k,1617) - lu(k,683) * lu(k,1560) + lu(k,1700) = lu(k,1700) - lu(k,679) * lu(k,1681) + lu(k,1702) = lu(k,1702) - lu(k,680) * lu(k,1681) + lu(k,1704) = lu(k,1704) - lu(k,681) * lu(k,1681) + lu(k,1711) = lu(k,1711) - lu(k,682) * lu(k,1681) + lu(k,1713) = lu(k,1713) - lu(k,683) * lu(k,1681) + lu(k,1913) = lu(k,1913) - lu(k,679) * lu(k,1852) + lu(k,1915) = lu(k,1915) - lu(k,680) * lu(k,1852) + lu(k,1917) = lu(k,1917) - lu(k,681) * lu(k,1852) + lu(k,1924) = lu(k,1924) - lu(k,682) * lu(k,1852) + lu(k,1926) = lu(k,1926) - lu(k,683) * lu(k,1852) + lu(k,2216) = lu(k,2216) - lu(k,679) * lu(k,2166) + lu(k,2218) = lu(k,2218) - lu(k,680) * lu(k,2166) + lu(k,2220) = lu(k,2220) - lu(k,681) * lu(k,2166) + lu(k,2227) = lu(k,2227) - lu(k,682) * lu(k,2166) + lu(k,2229) = lu(k,2229) - lu(k,683) * lu(k,2166) + lu(k,2316) = lu(k,2316) - lu(k,679) * lu(k,2280) + lu(k,2318) = lu(k,2318) - lu(k,680) * lu(k,2280) + lu(k,2320) = lu(k,2320) - lu(k,681) * lu(k,2280) + lu(k,2327) = lu(k,2327) - lu(k,682) * lu(k,2280) + lu(k,2329) = lu(k,2329) - lu(k,683) * lu(k,2280) end do end subroutine lu_fac14 subroutine lu_fac15( avec_len, lu ) @@ -2229,218 +2023,218 @@ subroutine lu_fac15( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,684) = 1._r8 / lu(k,684) - lu(k,685) = lu(k,685) * lu(k,684) - lu(k,686) = lu(k,686) * lu(k,684) - lu(k,687) = lu(k,687) * lu(k,684) - lu(k,688) = lu(k,688) * lu(k,684) - lu(k,689) = lu(k,689) * lu(k,684) - lu(k,690) = lu(k,690) * lu(k,684) - lu(k,691) = lu(k,691) * lu(k,684) - lu(k,1415) = lu(k,1415) - lu(k,685) * lu(k,1412) - lu(k,1418) = lu(k,1418) - lu(k,686) * lu(k,1412) - lu(k,1421) = lu(k,1421) - lu(k,687) * lu(k,1412) - lu(k,1427) = - lu(k,688) * lu(k,1412) - lu(k,1429) = lu(k,1429) - lu(k,689) * lu(k,1412) - lu(k,1430) = lu(k,1430) - lu(k,690) * lu(k,1412) - lu(k,1431) = lu(k,1431) - lu(k,691) * lu(k,1412) - lu(k,1508) = lu(k,1508) - lu(k,685) * lu(k,1476) - lu(k,1512) = lu(k,1512) - lu(k,686) * lu(k,1476) - lu(k,1515) = lu(k,1515) - lu(k,687) * lu(k,1476) - lu(k,1521) = lu(k,1521) - lu(k,688) * lu(k,1476) - lu(k,1523) = lu(k,1523) - lu(k,689) * lu(k,1476) - lu(k,1524) = lu(k,1524) - lu(k,690) * lu(k,1476) - lu(k,1525) = lu(k,1525) - lu(k,691) * lu(k,1476) - lu(k,1755) = lu(k,1755) - lu(k,685) * lu(k,1744) - lu(k,1759) = - lu(k,686) * lu(k,1744) - lu(k,1762) = lu(k,1762) - lu(k,687) * lu(k,1744) - lu(k,1768) = lu(k,1768) - lu(k,688) * lu(k,1744) - lu(k,1770) = lu(k,1770) - lu(k,689) * lu(k,1744) - lu(k,1771) = - lu(k,690) * lu(k,1744) - lu(k,1772) = lu(k,1772) - lu(k,691) * lu(k,1744) - lu(k,1946) = lu(k,1946) - lu(k,685) * lu(k,1943) - lu(k,1950) = - lu(k,686) * lu(k,1943) - lu(k,1953) = lu(k,1953) - lu(k,687) * lu(k,1943) - lu(k,1959) = lu(k,1959) - lu(k,688) * lu(k,1943) - lu(k,1961) = lu(k,1961) - lu(k,689) * lu(k,1943) - lu(k,1962) = lu(k,1962) - lu(k,690) * lu(k,1943) - lu(k,1963) = - lu(k,691) * lu(k,1943) - lu(k,2002) = lu(k,2002) - lu(k,685) * lu(k,1994) - lu(k,2006) = lu(k,2006) - lu(k,686) * lu(k,1994) - lu(k,2009) = lu(k,2009) - lu(k,687) * lu(k,1994) - lu(k,2015) = lu(k,2015) - lu(k,688) * lu(k,1994) - lu(k,2017) = lu(k,2017) - lu(k,689) * lu(k,1994) - lu(k,2018) = lu(k,2018) - lu(k,690) * lu(k,1994) - lu(k,2019) = lu(k,2019) - lu(k,691) * lu(k,1994) - lu(k,693) = 1._r8 / lu(k,693) - lu(k,694) = lu(k,694) * lu(k,693) - lu(k,695) = lu(k,695) * lu(k,693) - lu(k,696) = lu(k,696) * lu(k,693) - lu(k,697) = lu(k,697) * lu(k,693) - lu(k,698) = lu(k,698) * lu(k,693) - lu(k,699) = lu(k,699) * lu(k,693) - lu(k,700) = lu(k,700) * lu(k,693) - lu(k,1051) = lu(k,1051) - lu(k,694) * lu(k,1050) - lu(k,1052) = - lu(k,695) * lu(k,1050) - lu(k,1053) = lu(k,1053) - lu(k,696) * lu(k,1050) - lu(k,1056) = lu(k,1056) - lu(k,697) * lu(k,1050) - lu(k,1057) = - lu(k,698) * lu(k,1050) - lu(k,1058) = - lu(k,699) * lu(k,1050) - lu(k,1061) = lu(k,1061) - lu(k,700) * lu(k,1050) - lu(k,1306) = - lu(k,694) * lu(k,1305) - lu(k,1307) = lu(k,1307) - lu(k,695) * lu(k,1305) - lu(k,1308) = lu(k,1308) - lu(k,696) * lu(k,1305) - lu(k,1311) = lu(k,1311) - lu(k,697) * lu(k,1305) - lu(k,1313) = lu(k,1313) - lu(k,698) * lu(k,1305) - lu(k,1314) = - lu(k,699) * lu(k,1305) - lu(k,1317) = lu(k,1317) - lu(k,700) * lu(k,1305) - lu(k,1531) = lu(k,1531) - lu(k,694) * lu(k,1529) - lu(k,1533) = - lu(k,695) * lu(k,1529) - lu(k,1534) = lu(k,1534) - lu(k,696) * lu(k,1529) - lu(k,1539) = lu(k,1539) - lu(k,697) * lu(k,1529) - lu(k,1542) = - lu(k,698) * lu(k,1529) - lu(k,1543) = lu(k,1543) - lu(k,699) * lu(k,1529) - lu(k,1549) = lu(k,1549) - lu(k,700) * lu(k,1529) - lu(k,1679) = lu(k,1679) - lu(k,694) * lu(k,1649) - lu(k,1692) = lu(k,1692) - lu(k,695) * lu(k,1649) - lu(k,1693) = lu(k,1693) - lu(k,696) * lu(k,1649) - lu(k,1698) = lu(k,1698) - lu(k,697) * lu(k,1649) - lu(k,1701) = lu(k,1701) - lu(k,698) * lu(k,1649) - lu(k,1702) = lu(k,1702) - lu(k,699) * lu(k,1649) - lu(k,1708) = lu(k,1708) - lu(k,700) * lu(k,1649) - lu(k,2059) = lu(k,2059) - lu(k,694) * lu(k,2057) - lu(k,2062) = - lu(k,695) * lu(k,2057) - lu(k,2063) = lu(k,2063) - lu(k,696) * lu(k,2057) - lu(k,2068) = lu(k,2068) - lu(k,697) * lu(k,2057) - lu(k,2071) = - lu(k,698) * lu(k,2057) - lu(k,2072) = - lu(k,699) * lu(k,2057) - lu(k,2078) = lu(k,2078) - lu(k,700) * lu(k,2057) - lu(k,701) = 1._r8 / lu(k,701) - lu(k,702) = lu(k,702) * lu(k,701) - lu(k,703) = lu(k,703) * lu(k,701) - lu(k,704) = lu(k,704) * lu(k,701) - lu(k,742) = lu(k,742) - lu(k,702) * lu(k,738) - lu(k,743) = lu(k,743) - lu(k,703) * lu(k,738) - lu(k,744) = lu(k,744) - lu(k,704) * lu(k,738) - lu(k,980) = lu(k,980) - lu(k,702) * lu(k,967) - lu(k,981) = lu(k,981) - lu(k,703) * lu(k,967) - lu(k,982) = lu(k,982) - lu(k,704) * lu(k,967) - lu(k,1000) = lu(k,1000) - lu(k,702) * lu(k,989) - lu(k,1001) = lu(k,1001) - lu(k,703) * lu(k,989) - lu(k,1002) = lu(k,1002) - lu(k,704) * lu(k,989) - lu(k,1019) = lu(k,1019) - lu(k,702) * lu(k,1008) - lu(k,1020) = lu(k,1020) - lu(k,703) * lu(k,1008) - lu(k,1021) = lu(k,1021) - lu(k,704) * lu(k,1008) - lu(k,1033) = lu(k,1033) - lu(k,702) * lu(k,1027) - lu(k,1034) = lu(k,1034) - lu(k,703) * lu(k,1027) - lu(k,1035) = lu(k,1035) - lu(k,704) * lu(k,1027) - lu(k,1073) = lu(k,1073) - lu(k,702) * lu(k,1063) - lu(k,1074) = lu(k,1074) - lu(k,703) * lu(k,1063) - lu(k,1075) = lu(k,1075) - lu(k,704) * lu(k,1063) - lu(k,1096) = lu(k,1096) - lu(k,702) * lu(k,1082) - lu(k,1097) = lu(k,1097) - lu(k,703) * lu(k,1082) - lu(k,1098) = lu(k,1098) - lu(k,704) * lu(k,1082) - lu(k,1160) = lu(k,1160) - lu(k,702) * lu(k,1142) - lu(k,1161) = lu(k,1161) - lu(k,703) * lu(k,1142) - lu(k,1162) = lu(k,1162) - lu(k,704) * lu(k,1142) - lu(k,1203) = lu(k,1203) - lu(k,702) * lu(k,1189) - lu(k,1204) = lu(k,1204) - lu(k,703) * lu(k,1189) - lu(k,1205) = lu(k,1205) - lu(k,704) * lu(k,1189) - lu(k,1236) = lu(k,1236) - lu(k,702) * lu(k,1215) - lu(k,1237) = lu(k,1237) - lu(k,703) * lu(k,1215) - lu(k,1238) = lu(k,1238) - lu(k,704) * lu(k,1215) - lu(k,1696) = lu(k,1696) - lu(k,702) * lu(k,1650) - lu(k,1698) = lu(k,1698) - lu(k,703) * lu(k,1650) - lu(k,1699) = lu(k,1699) - lu(k,704) * lu(k,1650) - lu(k,1867) = lu(k,1867) - lu(k,702) * lu(k,1836) - lu(k,1869) = lu(k,1869) - lu(k,703) * lu(k,1836) - lu(k,1870) = lu(k,1870) - lu(k,704) * lu(k,1836) - lu(k,705) = 1._r8 / lu(k,705) - lu(k,706) = lu(k,706) * lu(k,705) - lu(k,707) = lu(k,707) * lu(k,705) - lu(k,708) = lu(k,708) * lu(k,705) - lu(k,775) = lu(k,775) - lu(k,706) * lu(k,765) - lu(k,776) = lu(k,776) - lu(k,707) * lu(k,765) - lu(k,781) = - lu(k,708) * lu(k,765) - lu(k,816) = lu(k,816) - lu(k,706) * lu(k,803) - lu(k,817) = lu(k,817) - lu(k,707) * lu(k,803) - lu(k,821) = - lu(k,708) * lu(k,803) - lu(k,842) = lu(k,842) - lu(k,706) * lu(k,829) - lu(k,843) = lu(k,843) - lu(k,707) * lu(k,829) - lu(k,847) = - lu(k,708) * lu(k,829) - lu(k,900) = lu(k,900) - lu(k,706) * lu(k,891) - lu(k,901) = lu(k,901) - lu(k,707) * lu(k,891) - lu(k,907) = lu(k,907) - lu(k,708) * lu(k,891) - lu(k,1110) = lu(k,1110) - lu(k,706) * lu(k,1102) - lu(k,1111) = lu(k,1111) - lu(k,707) * lu(k,1102) - lu(k,1114) = lu(k,1114) - lu(k,708) * lu(k,1102) - lu(k,1180) = lu(k,1180) - lu(k,706) * lu(k,1168) - lu(k,1181) = lu(k,1181) - lu(k,707) * lu(k,1168) - lu(k,1187) = - lu(k,708) * lu(k,1168) - lu(k,1397) = lu(k,1397) - lu(k,706) * lu(k,1362) - lu(k,1399) = lu(k,1399) - lu(k,707) * lu(k,1362) - lu(k,1409) = lu(k,1409) - lu(k,708) * lu(k,1362) - lu(k,1513) = lu(k,1513) - lu(k,706) * lu(k,1477) - lu(k,1515) = lu(k,1515) - lu(k,707) * lu(k,1477) - lu(k,1525) = lu(k,1525) - lu(k,708) * lu(k,1477) - lu(k,1696) = lu(k,1696) - lu(k,706) * lu(k,1651) - lu(k,1698) = lu(k,1698) - lu(k,707) * lu(k,1651) - lu(k,1708) = lu(k,1708) - lu(k,708) * lu(k,1651) - lu(k,1719) = lu(k,1719) - lu(k,706) * lu(k,1710) - lu(k,1721) = lu(k,1721) - lu(k,707) * lu(k,1710) - lu(k,1731) = lu(k,1731) - lu(k,708) * lu(k,1710) - lu(k,1927) = lu(k,1927) - lu(k,706) * lu(k,1893) - lu(k,1929) = lu(k,1929) - lu(k,707) * lu(k,1893) - lu(k,1939) = lu(k,1939) - lu(k,708) * lu(k,1893) - lu(k,2041) = lu(k,2041) - lu(k,706) * lu(k,2026) - lu(k,2043) = lu(k,2043) - lu(k,707) * lu(k,2026) - lu(k,2053) = lu(k,2053) - lu(k,708) * lu(k,2026) - lu(k,710) = 1._r8 / lu(k,710) - lu(k,711) = lu(k,711) * lu(k,710) - lu(k,712) = lu(k,712) * lu(k,710) - lu(k,713) = lu(k,713) * lu(k,710) - lu(k,714) = lu(k,714) * lu(k,710) - lu(k,715) = lu(k,715) * lu(k,710) - lu(k,716) = lu(k,716) * lu(k,710) - lu(k,717) = lu(k,717) * lu(k,710) - lu(k,718) = lu(k,718) * lu(k,710) - lu(k,719) = lu(k,719) * lu(k,710) - lu(k,1369) = lu(k,1369) - lu(k,711) * lu(k,1363) - lu(k,1381) = lu(k,1381) - lu(k,712) * lu(k,1363) - lu(k,1395) = lu(k,1395) - lu(k,713) * lu(k,1363) - lu(k,1397) = lu(k,1397) - lu(k,714) * lu(k,1363) - lu(k,1399) = lu(k,1399) - lu(k,715) * lu(k,1363) - lu(k,1400) = lu(k,1400) - lu(k,716) * lu(k,1363) - lu(k,1401) = lu(k,1401) - lu(k,717) * lu(k,1363) - lu(k,1403) = lu(k,1403) - lu(k,718) * lu(k,1363) - lu(k,1409) = lu(k,1409) - lu(k,719) * lu(k,1363) - lu(k,1486) = lu(k,1486) - lu(k,711) * lu(k,1478) - lu(k,1496) = lu(k,1496) - lu(k,712) * lu(k,1478) - lu(k,1511) = lu(k,1511) - lu(k,713) * lu(k,1478) - lu(k,1513) = lu(k,1513) - lu(k,714) * lu(k,1478) - lu(k,1515) = lu(k,1515) - lu(k,715) * lu(k,1478) - lu(k,1516) = lu(k,1516) - lu(k,716) * lu(k,1478) - lu(k,1517) = lu(k,1517) - lu(k,717) * lu(k,1478) - lu(k,1519) = lu(k,1519) - lu(k,718) * lu(k,1478) - lu(k,1525) = lu(k,1525) - lu(k,719) * lu(k,1478) - lu(k,1664) = lu(k,1664) - lu(k,711) * lu(k,1652) - lu(k,1678) = lu(k,1678) - lu(k,712) * lu(k,1652) - lu(k,1694) = lu(k,1694) - lu(k,713) * lu(k,1652) - lu(k,1696) = lu(k,1696) - lu(k,714) * lu(k,1652) - lu(k,1698) = lu(k,1698) - lu(k,715) * lu(k,1652) - lu(k,1699) = lu(k,1699) - lu(k,716) * lu(k,1652) - lu(k,1700) = lu(k,1700) - lu(k,717) * lu(k,1652) - lu(k,1702) = lu(k,1702) - lu(k,718) * lu(k,1652) - lu(k,1708) = lu(k,1708) - lu(k,719) * lu(k,1652) - lu(k,1841) = lu(k,1841) - lu(k,711) * lu(k,1837) - lu(k,1852) = lu(k,1852) - lu(k,712) * lu(k,1837) - lu(k,1865) = lu(k,1865) - lu(k,713) * lu(k,1837) - lu(k,1867) = lu(k,1867) - lu(k,714) * lu(k,1837) - lu(k,1869) = lu(k,1869) - lu(k,715) * lu(k,1837) - lu(k,1870) = lu(k,1870) - lu(k,716) * lu(k,1837) - lu(k,1871) = lu(k,1871) - lu(k,717) * lu(k,1837) - lu(k,1873) = lu(k,1873) - lu(k,718) * lu(k,1837) - lu(k,1879) = lu(k,1879) - lu(k,719) * lu(k,1837) + lu(k,685) = 1._r8 / lu(k,685) + lu(k,686) = lu(k,686) * lu(k,685) + lu(k,687) = lu(k,687) * lu(k,685) + lu(k,688) = lu(k,688) * lu(k,685) + lu(k,689) = lu(k,689) * lu(k,685) + lu(k,690) = lu(k,690) * lu(k,685) + lu(k,691) = lu(k,691) * lu(k,685) + lu(k,692) = lu(k,692) * lu(k,685) + lu(k,693) = lu(k,693) * lu(k,685) + lu(k,694) = lu(k,694) * lu(k,685) + lu(k,937) = lu(k,937) - lu(k,686) * lu(k,935) + lu(k,938) = lu(k,938) - lu(k,687) * lu(k,935) + lu(k,940) = lu(k,940) - lu(k,688) * lu(k,935) + lu(k,941) = lu(k,941) - lu(k,689) * lu(k,935) + lu(k,942) = lu(k,942) - lu(k,690) * lu(k,935) + lu(k,945) = lu(k,945) - lu(k,691) * lu(k,935) + lu(k,946) = lu(k,946) - lu(k,692) * lu(k,935) + lu(k,947) = lu(k,947) - lu(k,693) * lu(k,935) + lu(k,948) = lu(k,948) - lu(k,694) * lu(k,935) + lu(k,1562) = lu(k,1562) - lu(k,686) * lu(k,1561) + lu(k,1570) = lu(k,1570) - lu(k,687) * lu(k,1561) + lu(k,1576) = lu(k,1576) - lu(k,688) * lu(k,1561) + lu(k,1583) = lu(k,1583) - lu(k,689) * lu(k,1561) + lu(k,1599) = lu(k,1599) - lu(k,690) * lu(k,1561) + lu(k,1606) = lu(k,1606) - lu(k,691) * lu(k,1561) + lu(k,1608) = lu(k,1608) - lu(k,692) * lu(k,1561) + lu(k,1612) = lu(k,1612) - lu(k,693) * lu(k,1561) + lu(k,1615) = lu(k,1615) - lu(k,694) * lu(k,1561) + lu(k,1856) = lu(k,1856) - lu(k,686) * lu(k,1853) + lu(k,1870) = lu(k,1870) - lu(k,687) * lu(k,1853) + lu(k,1880) = lu(k,1880) - lu(k,688) * lu(k,1853) + lu(k,1890) = lu(k,1890) - lu(k,689) * lu(k,1853) + lu(k,1907) = lu(k,1907) - lu(k,690) * lu(k,1853) + lu(k,1915) = lu(k,1915) - lu(k,691) * lu(k,1853) + lu(k,1917) = lu(k,1917) - lu(k,692) * lu(k,1853) + lu(k,1921) = lu(k,1921) - lu(k,693) * lu(k,1853) + lu(k,1924) = lu(k,1924) - lu(k,694) * lu(k,1853) + 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,1150) = lu(k,1150) - lu(k,696) * lu(k,1148) + lu(k,1151) = lu(k,1151) - lu(k,697) * lu(k,1148) + lu(k,1152) = lu(k,1152) - lu(k,698) * lu(k,1148) + lu(k,1153) = lu(k,1153) - lu(k,699) * lu(k,1148) + lu(k,1154) = lu(k,1154) - lu(k,700) * lu(k,1148) + lu(k,1155) = lu(k,1155) - lu(k,701) * lu(k,1148) + lu(k,1162) = - lu(k,702) * lu(k,1148) + lu(k,1164) = lu(k,1164) - lu(k,703) * lu(k,1148) + lu(k,1165) = lu(k,1165) - lu(k,704) * lu(k,1148) + lu(k,1871) = lu(k,1871) - lu(k,696) * lu(k,1854) + lu(k,1880) = lu(k,1880) - lu(k,697) * lu(k,1854) + lu(k,1889) = lu(k,1889) - lu(k,698) * lu(k,1854) + lu(k,1891) = lu(k,1891) - lu(k,699) * lu(k,1854) + lu(k,1892) = lu(k,1892) - lu(k,700) * lu(k,1854) + lu(k,1893) = lu(k,1893) - lu(k,701) * lu(k,1854) + lu(k,1917) = lu(k,1917) - lu(k,702) * lu(k,1854) + lu(k,1921) = lu(k,1921) - lu(k,703) * lu(k,1854) + lu(k,1924) = lu(k,1924) - lu(k,704) * lu(k,1854) + lu(k,2184) = lu(k,2184) - lu(k,696) * lu(k,2167) + lu(k,2189) = lu(k,2189) - lu(k,697) * lu(k,2167) + lu(k,2194) = - lu(k,698) * lu(k,2167) + lu(k,2196) = lu(k,2196) - lu(k,699) * lu(k,2167) + lu(k,2197) = lu(k,2197) - lu(k,700) * lu(k,2167) + lu(k,2198) = lu(k,2198) - lu(k,701) * lu(k,2167) + lu(k,2220) = lu(k,2220) - lu(k,702) * lu(k,2167) + lu(k,2224) = lu(k,2224) - lu(k,703) * lu(k,2167) + lu(k,2227) = lu(k,2227) - lu(k,704) * lu(k,2167) + lu(k,706) = 1._r8 / lu(k,706) + lu(k,707) = lu(k,707) * lu(k,706) + lu(k,708) = lu(k,708) * lu(k,706) + lu(k,709) = lu(k,709) * lu(k,706) + lu(k,710) = lu(k,710) * lu(k,706) + lu(k,711) = lu(k,711) * lu(k,706) + lu(k,712) = lu(k,712) * lu(k,706) + lu(k,713) = lu(k,713) * lu(k,706) + lu(k,714) = lu(k,714) * lu(k,706) + lu(k,715) = lu(k,715) * lu(k,706) + lu(k,937) = lu(k,937) - lu(k,707) * lu(k,936) + lu(k,938) = lu(k,938) - lu(k,708) * lu(k,936) + lu(k,939) = lu(k,939) - lu(k,709) * lu(k,936) + lu(k,940) = lu(k,940) - lu(k,710) * lu(k,936) + lu(k,941) = lu(k,941) - lu(k,711) * lu(k,936) + lu(k,942) = lu(k,942) - lu(k,712) * lu(k,936) + lu(k,946) = lu(k,946) - lu(k,713) * lu(k,936) + lu(k,947) = lu(k,947) - lu(k,714) * lu(k,936) + lu(k,948) = lu(k,948) - lu(k,715) * lu(k,936) + lu(k,1856) = lu(k,1856) - lu(k,707) * lu(k,1855) + lu(k,1870) = lu(k,1870) - lu(k,708) * lu(k,1855) + lu(k,1878) = lu(k,1878) - lu(k,709) * lu(k,1855) + lu(k,1880) = lu(k,1880) - lu(k,710) * lu(k,1855) + lu(k,1890) = lu(k,1890) - lu(k,711) * lu(k,1855) + lu(k,1907) = lu(k,1907) - lu(k,712) * lu(k,1855) + lu(k,1917) = lu(k,1917) - lu(k,713) * lu(k,1855) + lu(k,1921) = lu(k,1921) - lu(k,714) * lu(k,1855) + lu(k,1924) = lu(k,1924) - lu(k,715) * lu(k,1855) + lu(k,2169) = lu(k,2169) - lu(k,707) * lu(k,2168) + lu(k,2183) = lu(k,2183) - lu(k,708) * lu(k,2168) + lu(k,2187) = lu(k,2187) - lu(k,709) * lu(k,2168) + lu(k,2189) = lu(k,2189) - lu(k,710) * lu(k,2168) + lu(k,2195) = lu(k,2195) - lu(k,711) * lu(k,2168) + lu(k,2210) = lu(k,2210) - lu(k,712) * lu(k,2168) + lu(k,2220) = lu(k,2220) - lu(k,713) * lu(k,2168) + lu(k,2224) = lu(k,2224) - lu(k,714) * lu(k,2168) + lu(k,2227) = lu(k,2227) - lu(k,715) * lu(k,2168) + lu(k,717) = 1._r8 / lu(k,717) + lu(k,718) = lu(k,718) * lu(k,717) + lu(k,719) = lu(k,719) * lu(k,717) + lu(k,720) = lu(k,720) * lu(k,717) + lu(k,721) = lu(k,721) * lu(k,717) + lu(k,722) = lu(k,722) * lu(k,717) + lu(k,723) = lu(k,723) * lu(k,717) + lu(k,941) = lu(k,941) - lu(k,718) * lu(k,937) + lu(k,942) = lu(k,942) - lu(k,719) * lu(k,937) + lu(k,943) = lu(k,943) - lu(k,720) * lu(k,937) + lu(k,945) = lu(k,945) - lu(k,721) * lu(k,937) + lu(k,946) = lu(k,946) - lu(k,722) * lu(k,937) + lu(k,948) = lu(k,948) - lu(k,723) * lu(k,937) + lu(k,1583) = lu(k,1583) - lu(k,718) * lu(k,1562) + lu(k,1599) = lu(k,1599) - lu(k,719) * lu(k,1562) + lu(k,1604) = lu(k,1604) - lu(k,720) * lu(k,1562) + lu(k,1606) = lu(k,1606) - lu(k,721) * lu(k,1562) + lu(k,1608) = lu(k,1608) - lu(k,722) * lu(k,1562) + lu(k,1615) = lu(k,1615) - lu(k,723) * lu(k,1562) + lu(k,1890) = lu(k,1890) - lu(k,718) * lu(k,1856) + lu(k,1907) = lu(k,1907) - lu(k,719) * lu(k,1856) + lu(k,1913) = lu(k,1913) - lu(k,720) * lu(k,1856) + lu(k,1915) = lu(k,1915) - lu(k,721) * lu(k,1856) + lu(k,1917) = lu(k,1917) - lu(k,722) * lu(k,1856) + lu(k,1924) = lu(k,1924) - lu(k,723) * lu(k,1856) + lu(k,2195) = lu(k,2195) - lu(k,718) * lu(k,2169) + lu(k,2210) = lu(k,2210) - lu(k,719) * lu(k,2169) + lu(k,2216) = lu(k,2216) - lu(k,720) * lu(k,2169) + lu(k,2218) = lu(k,2218) - lu(k,721) * lu(k,2169) + lu(k,2220) = lu(k,2220) - lu(k,722) * lu(k,2169) + lu(k,2227) = lu(k,2227) - lu(k,723) * lu(k,2169) + lu(k,724) = 1._r8 / lu(k,724) + lu(k,725) = lu(k,725) * lu(k,724) + lu(k,726) = lu(k,726) * lu(k,724) + lu(k,727) = lu(k,727) * lu(k,724) + lu(k,728) = lu(k,728) * lu(k,724) + lu(k,1061) = lu(k,1061) - lu(k,725) * lu(k,1059) + lu(k,1072) = lu(k,1072) - lu(k,726) * lu(k,1059) + lu(k,1074) = lu(k,1074) - lu(k,727) * lu(k,1059) + lu(k,1080) = - lu(k,728) * lu(k,1059) + lu(k,1390) = lu(k,1390) - lu(k,725) * lu(k,1389) + lu(k,1398) = lu(k,1398) - lu(k,726) * lu(k,1389) + lu(k,1400) = lu(k,1400) - lu(k,727) * lu(k,1389) + lu(k,1406) = lu(k,1406) - lu(k,728) * lu(k,1389) + lu(k,1411) = lu(k,1411) - lu(k,725) * lu(k,1410) + lu(k,1430) = lu(k,1430) - lu(k,726) * lu(k,1410) + lu(k,1432) = lu(k,1432) - lu(k,727) * lu(k,1410) + lu(k,1438) = lu(k,1438) - lu(k,728) * lu(k,1410) + lu(k,1628) = lu(k,1628) - lu(k,725) * lu(k,1624) + lu(k,1657) = lu(k,1657) - lu(k,726) * lu(k,1624) + lu(k,1660) = lu(k,1660) - lu(k,727) * lu(k,1624) + lu(k,1670) = lu(k,1670) - lu(k,728) * lu(k,1624) + lu(k,1871) = lu(k,1871) - lu(k,725) * lu(k,1857) + lu(k,1914) = lu(k,1914) - lu(k,726) * lu(k,1857) + lu(k,1917) = lu(k,1917) - lu(k,727) * lu(k,1857) + lu(k,1927) = lu(k,1927) - lu(k,728) * lu(k,1857) + lu(k,2184) = lu(k,2184) - lu(k,725) * lu(k,2170) + lu(k,2217) = lu(k,2217) - lu(k,726) * lu(k,2170) + lu(k,2220) = lu(k,2220) - lu(k,727) * lu(k,2170) + lu(k,2230) = lu(k,2230) - lu(k,728) * lu(k,2170) + lu(k,2283) = lu(k,2283) - lu(k,725) * lu(k,2281) + lu(k,2317) = lu(k,2317) - lu(k,726) * lu(k,2281) + lu(k,2320) = lu(k,2320) - lu(k,727) * lu(k,2281) + lu(k,2330) = - lu(k,728) * lu(k,2281) + lu(k,730) = 1._r8 / lu(k,730) + lu(k,731) = lu(k,731) * lu(k,730) + lu(k,732) = lu(k,732) * lu(k,730) + lu(k,733) = lu(k,733) * lu(k,730) + lu(k,734) = lu(k,734) * lu(k,730) + lu(k,735) = lu(k,735) * lu(k,730) + lu(k,736) = lu(k,736) * lu(k,730) + lu(k,1232) = - lu(k,731) * lu(k,1226) + lu(k,1234) = - lu(k,732) * lu(k,1226) + lu(k,1236) = - lu(k,733) * lu(k,1226) + lu(k,1242) = lu(k,1242) - lu(k,734) * lu(k,1226) + lu(k,1244) = lu(k,1244) - lu(k,735) * lu(k,1226) + lu(k,1246) = lu(k,1246) - lu(k,736) * lu(k,1226) + lu(k,1293) = - lu(k,731) * lu(k,1286) + lu(k,1294) = lu(k,1294) - lu(k,732) * lu(k,1286) + lu(k,1298) = lu(k,1298) - lu(k,733) * lu(k,1286) + lu(k,1305) = lu(k,1305) - lu(k,734) * lu(k,1286) + lu(k,1307) = lu(k,1307) - lu(k,735) * lu(k,1286) + lu(k,1309) = lu(k,1309) - lu(k,736) * lu(k,1286) + lu(k,1325) = lu(k,1325) - lu(k,731) * lu(k,1316) + lu(k,1326) = - lu(k,732) * lu(k,1316) + lu(k,1330) = - lu(k,733) * lu(k,1316) + lu(k,1337) = lu(k,1337) - lu(k,734) * lu(k,1316) + lu(k,1339) = lu(k,1339) - lu(k,735) * lu(k,1316) + lu(k,1341) = lu(k,1341) - lu(k,736) * lu(k,1316) + lu(k,1897) = lu(k,1897) - lu(k,731) * lu(k,1858) + lu(k,1899) = lu(k,1899) - lu(k,732) * lu(k,1858) + lu(k,1905) = lu(k,1905) - lu(k,733) * lu(k,1858) + lu(k,1917) = lu(k,1917) - lu(k,734) * lu(k,1858) + lu(k,1921) = lu(k,1921) - lu(k,735) * lu(k,1858) + lu(k,1924) = lu(k,1924) - lu(k,736) * lu(k,1858) + lu(k,2201) = lu(k,2201) - lu(k,731) * lu(k,2171) + lu(k,2203) = - lu(k,732) * lu(k,2171) + lu(k,2208) = - lu(k,733) * lu(k,2171) + lu(k,2220) = lu(k,2220) - lu(k,734) * lu(k,2171) + lu(k,2224) = lu(k,2224) - lu(k,735) * lu(k,2171) + lu(k,2227) = lu(k,2227) - lu(k,736) * lu(k,2171) end do end subroutine lu_fac15 subroutine lu_fac16( avec_len, lu ) @@ -2457,257 +2251,198 @@ subroutine lu_fac16( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,720) = 1._r8 / lu(k,720) - lu(k,721) = lu(k,721) * lu(k,720) - lu(k,722) = lu(k,722) * lu(k,720) - lu(k,723) = lu(k,723) * lu(k,720) - lu(k,724) = lu(k,724) * lu(k,720) - lu(k,725) = lu(k,725) * lu(k,720) - lu(k,726) = lu(k,726) * lu(k,720) - lu(k,727) = lu(k,727) * lu(k,720) - lu(k,1294) = lu(k,1294) - lu(k,721) * lu(k,1292) - lu(k,1295) = - lu(k,722) * lu(k,1292) - lu(k,1297) = - lu(k,723) * lu(k,1292) - lu(k,1298) = - lu(k,724) * lu(k,1292) - lu(k,1301) = lu(k,1301) - lu(k,725) * lu(k,1292) - lu(k,1302) = - lu(k,726) * lu(k,1292) - lu(k,1303) = - lu(k,727) * lu(k,1292) - lu(k,1508) = lu(k,1508) - lu(k,721) * lu(k,1479) - lu(k,1510) = lu(k,1510) - lu(k,722) * lu(k,1479) - lu(k,1514) = - lu(k,723) * lu(k,1479) - lu(k,1515) = lu(k,1515) - lu(k,724) * lu(k,1479) - lu(k,1521) = lu(k,1521) - lu(k,725) * lu(k,1479) - lu(k,1523) = lu(k,1523) - lu(k,726) * lu(k,1479) - lu(k,1525) = lu(k,1525) - lu(k,727) * lu(k,1479) - lu(k,1532) = lu(k,1532) - lu(k,721) * lu(k,1530) - lu(k,1534) = lu(k,1534) - lu(k,722) * lu(k,1530) - lu(k,1538) = lu(k,1538) - lu(k,723) * lu(k,1530) - lu(k,1539) = lu(k,1539) - lu(k,724) * lu(k,1530) - lu(k,1545) = lu(k,1545) - lu(k,725) * lu(k,1530) - lu(k,1547) = lu(k,1547) - lu(k,726) * lu(k,1530) - lu(k,1549) = lu(k,1549) - lu(k,727) * lu(k,1530) - lu(k,1691) = lu(k,1691) - lu(k,721) * lu(k,1653) - lu(k,1693) = lu(k,1693) - lu(k,722) * lu(k,1653) - lu(k,1697) = lu(k,1697) - lu(k,723) * lu(k,1653) - lu(k,1698) = lu(k,1698) - lu(k,724) * lu(k,1653) - lu(k,1704) = lu(k,1704) - lu(k,725) * lu(k,1653) - lu(k,1706) = lu(k,1706) - lu(k,726) * lu(k,1653) - lu(k,1708) = lu(k,1708) - lu(k,727) * lu(k,1653) - lu(k,1714) = lu(k,1714) - lu(k,721) * lu(k,1711) - lu(k,1716) = lu(k,1716) - lu(k,722) * lu(k,1711) - lu(k,1720) = - lu(k,723) * lu(k,1711) - lu(k,1721) = lu(k,1721) - lu(k,724) * lu(k,1711) - lu(k,1727) = - lu(k,725) * lu(k,1711) - lu(k,1729) = lu(k,1729) - lu(k,726) * lu(k,1711) - lu(k,1731) = lu(k,1731) - lu(k,727) * lu(k,1711) - lu(k,2002) = lu(k,2002) - lu(k,721) * lu(k,1995) - lu(k,2004) = lu(k,2004) - lu(k,722) * lu(k,1995) - lu(k,2008) = - lu(k,723) * lu(k,1995) - lu(k,2009) = lu(k,2009) - lu(k,724) * lu(k,1995) - lu(k,2015) = lu(k,2015) - lu(k,725) * lu(k,1995) - lu(k,2017) = lu(k,2017) - lu(k,726) * lu(k,1995) - lu(k,2019) = lu(k,2019) - lu(k,727) * lu(k,1995) - lu(k,729) = 1._r8 / lu(k,729) - lu(k,730) = lu(k,730) * lu(k,729) - lu(k,731) = lu(k,731) * lu(k,729) - lu(k,732) = lu(k,732) * lu(k,729) - lu(k,733) = lu(k,733) * lu(k,729) - lu(k,734) = lu(k,734) * lu(k,729) - lu(k,735) = lu(k,735) * lu(k,729) - lu(k,873) = lu(k,873) - lu(k,730) * lu(k,870) - lu(k,874) = lu(k,874) - lu(k,731) * lu(k,870) - lu(k,877) = lu(k,877) - lu(k,732) * lu(k,870) - lu(k,878) = lu(k,878) - lu(k,733) * lu(k,870) - lu(k,879) = lu(k,879) - lu(k,734) * lu(k,870) - lu(k,880) = - lu(k,735) * lu(k,870) - lu(k,1418) = lu(k,1418) - lu(k,730) * lu(k,1413) - lu(k,1421) = lu(k,1421) - lu(k,731) * lu(k,1413) - lu(k,1428) = lu(k,1428) - lu(k,732) * lu(k,1413) - lu(k,1429) = lu(k,1429) - lu(k,733) * lu(k,1413) - lu(k,1430) = lu(k,1430) - lu(k,734) * lu(k,1413) - lu(k,1431) = lu(k,1431) - lu(k,735) * lu(k,1413) - lu(k,1512) = lu(k,1512) - lu(k,730) * lu(k,1480) - lu(k,1515) = lu(k,1515) - lu(k,731) * lu(k,1480) - lu(k,1522) = lu(k,1522) - lu(k,732) * lu(k,1480) - lu(k,1523) = lu(k,1523) - lu(k,733) * lu(k,1480) - lu(k,1524) = lu(k,1524) - lu(k,734) * lu(k,1480) - lu(k,1525) = lu(k,1525) - lu(k,735) * lu(k,1480) - lu(k,1695) = lu(k,1695) - lu(k,730) * lu(k,1654) - lu(k,1698) = lu(k,1698) - lu(k,731) * lu(k,1654) - lu(k,1705) = lu(k,1705) - lu(k,732) * lu(k,1654) - lu(k,1706) = lu(k,1706) - lu(k,733) * lu(k,1654) - lu(k,1707) = lu(k,1707) - lu(k,734) * lu(k,1654) - lu(k,1708) = lu(k,1708) - lu(k,735) * lu(k,1654) - lu(k,1976) = lu(k,1976) - lu(k,730) * lu(k,1968) - lu(k,1979) = lu(k,1979) - lu(k,731) * lu(k,1968) - lu(k,1986) = lu(k,1986) - lu(k,732) * lu(k,1968) - lu(k,1987) = lu(k,1987) - lu(k,733) * lu(k,1968) - lu(k,1988) = lu(k,1988) - lu(k,734) * lu(k,1968) - lu(k,1989) = - lu(k,735) * lu(k,1968) - lu(k,2006) = lu(k,2006) - lu(k,730) * lu(k,1996) - lu(k,2009) = lu(k,2009) - lu(k,731) * lu(k,1996) - lu(k,2016) = lu(k,2016) - lu(k,732) * lu(k,1996) - lu(k,2017) = lu(k,2017) - lu(k,733) * lu(k,1996) - lu(k,2018) = lu(k,2018) - lu(k,734) * lu(k,1996) - lu(k,2019) = lu(k,2019) - lu(k,735) * lu(k,1996) - lu(k,2040) = lu(k,2040) - lu(k,730) * lu(k,2027) - lu(k,2043) = lu(k,2043) - lu(k,731) * lu(k,2027) - lu(k,2050) = lu(k,2050) - lu(k,732) * lu(k,2027) - lu(k,2051) = lu(k,2051) - lu(k,733) * lu(k,2027) - lu(k,2052) = lu(k,2052) - lu(k,734) * lu(k,2027) - lu(k,2053) = lu(k,2053) - lu(k,735) * lu(k,2027) - lu(k,739) = 1._r8 / lu(k,739) - lu(k,740) = lu(k,740) * lu(k,739) - lu(k,741) = lu(k,741) * lu(k,739) - lu(k,742) = lu(k,742) * lu(k,739) - lu(k,743) = lu(k,743) * lu(k,739) - lu(k,744) = lu(k,744) * lu(k,739) - lu(k,745) = lu(k,745) * lu(k,739) - lu(k,746) = lu(k,746) * lu(k,739) - lu(k,855) = lu(k,855) - lu(k,740) * lu(k,852) - lu(k,857) = lu(k,857) - lu(k,741) * lu(k,852) - lu(k,858) = lu(k,858) - lu(k,742) * lu(k,852) - lu(k,859) = lu(k,859) - lu(k,743) * lu(k,852) - lu(k,860) = lu(k,860) - lu(k,744) * lu(k,852) - lu(k,861) = lu(k,861) - lu(k,745) * lu(k,852) - lu(k,862) = - lu(k,746) * lu(k,852) - lu(k,1381) = lu(k,1381) - lu(k,740) * lu(k,1364) - lu(k,1395) = lu(k,1395) - lu(k,741) * lu(k,1364) - lu(k,1397) = lu(k,1397) - lu(k,742) * lu(k,1364) - lu(k,1399) = lu(k,1399) - lu(k,743) * lu(k,1364) - lu(k,1400) = lu(k,1400) - lu(k,744) * lu(k,1364) - lu(k,1401) = lu(k,1401) - lu(k,745) * lu(k,1364) - lu(k,1403) = lu(k,1403) - lu(k,746) * lu(k,1364) - lu(k,1496) = lu(k,1496) - lu(k,740) * lu(k,1481) - lu(k,1511) = lu(k,1511) - lu(k,741) * lu(k,1481) - lu(k,1513) = lu(k,1513) - lu(k,742) * lu(k,1481) - lu(k,1515) = lu(k,1515) - lu(k,743) * lu(k,1481) - lu(k,1516) = lu(k,1516) - lu(k,744) * lu(k,1481) - lu(k,1517) = lu(k,1517) - lu(k,745) * lu(k,1481) - lu(k,1519) = lu(k,1519) - lu(k,746) * lu(k,1481) - lu(k,1678) = lu(k,1678) - lu(k,740) * lu(k,1655) - lu(k,1694) = lu(k,1694) - lu(k,741) * lu(k,1655) - lu(k,1696) = lu(k,1696) - lu(k,742) * lu(k,1655) - lu(k,1698) = lu(k,1698) - lu(k,743) * lu(k,1655) - lu(k,1699) = lu(k,1699) - lu(k,744) * lu(k,1655) - lu(k,1700) = lu(k,1700) - lu(k,745) * lu(k,1655) - lu(k,1702) = lu(k,1702) - lu(k,746) * lu(k,1655) - lu(k,1852) = lu(k,1852) - lu(k,740) * lu(k,1838) - lu(k,1865) = lu(k,1865) - lu(k,741) * lu(k,1838) - lu(k,1867) = lu(k,1867) - lu(k,742) * lu(k,1838) - lu(k,1869) = lu(k,1869) - lu(k,743) * lu(k,1838) - lu(k,1870) = lu(k,1870) - lu(k,744) * lu(k,1838) - lu(k,1871) = lu(k,1871) - lu(k,745) * lu(k,1838) - lu(k,1873) = lu(k,1873) - lu(k,746) * lu(k,1838) - lu(k,2033) = - lu(k,740) * lu(k,2028) - lu(k,2039) = lu(k,2039) - lu(k,741) * lu(k,2028) - lu(k,2041) = lu(k,2041) - lu(k,742) * lu(k,2028) - lu(k,2043) = lu(k,2043) - lu(k,743) * lu(k,2028) - lu(k,2044) = lu(k,2044) - lu(k,744) * lu(k,2028) - lu(k,2045) = lu(k,2045) - lu(k,745) * lu(k,2028) - lu(k,2047) = lu(k,2047) - lu(k,746) * lu(k,2028) - lu(k,747) = 1._r8 / lu(k,747) - lu(k,748) = lu(k,748) * lu(k,747) - lu(k,749) = lu(k,749) * lu(k,747) - lu(k,750) = lu(k,750) * lu(k,747) - lu(k,751) = lu(k,751) * lu(k,747) - lu(k,752) = lu(k,752) * lu(k,747) - lu(k,897) = - lu(k,748) * lu(k,892) - lu(k,898) = - lu(k,749) * lu(k,892) - lu(k,901) = lu(k,901) - lu(k,750) * lu(k,892) - lu(k,902) = lu(k,902) - lu(k,751) * lu(k,892) - lu(k,903) = lu(k,903) - lu(k,752) * lu(k,892) - lu(k,914) = - lu(k,748) * lu(k,909) - lu(k,915) = - lu(k,749) * lu(k,909) - lu(k,919) = lu(k,919) - lu(k,750) * lu(k,909) - lu(k,920) = - lu(k,751) * lu(k,909) - lu(k,921) = lu(k,921) - lu(k,752) * lu(k,909) - lu(k,1090) = - lu(k,748) * lu(k,1083) - lu(k,1092) = lu(k,1092) - lu(k,749) * lu(k,1083) - lu(k,1097) = lu(k,1097) - lu(k,750) * lu(k,1083) - lu(k,1098) = lu(k,1098) - lu(k,751) * lu(k,1083) - lu(k,1099) = lu(k,1099) - lu(k,752) * lu(k,1083) - lu(k,1227) = lu(k,1227) - lu(k,748) * lu(k,1216) - lu(k,1232) = lu(k,1232) - lu(k,749) * lu(k,1216) - lu(k,1237) = lu(k,1237) - lu(k,750) * lu(k,1216) - lu(k,1238) = lu(k,1238) - lu(k,751) * lu(k,1216) - lu(k,1239) = lu(k,1239) - lu(k,752) * lu(k,1216) - lu(k,1385) = lu(k,1385) - lu(k,748) * lu(k,1365) - lu(k,1391) = lu(k,1391) - lu(k,749) * lu(k,1365) - lu(k,1399) = lu(k,1399) - lu(k,750) * lu(k,1365) - lu(k,1400) = lu(k,1400) - lu(k,751) * lu(k,1365) - lu(k,1401) = lu(k,1401) - lu(k,752) * lu(k,1365) - lu(k,1501) = lu(k,1501) - lu(k,748) * lu(k,1482) - lu(k,1507) = lu(k,1507) - lu(k,749) * lu(k,1482) - lu(k,1515) = lu(k,1515) - lu(k,750) * lu(k,1482) - lu(k,1516) = lu(k,1516) - lu(k,751) * lu(k,1482) - lu(k,1517) = lu(k,1517) - lu(k,752) * lu(k,1482) - lu(k,1683) = lu(k,1683) - lu(k,748) * lu(k,1656) - lu(k,1690) = lu(k,1690) - lu(k,749) * lu(k,1656) - lu(k,1698) = lu(k,1698) - lu(k,750) * lu(k,1656) - lu(k,1699) = lu(k,1699) - lu(k,751) * lu(k,1656) - lu(k,1700) = lu(k,1700) - lu(k,752) * lu(k,1656) - lu(k,1804) = lu(k,1804) - lu(k,748) * lu(k,1780) - lu(k,1811) = lu(k,1811) - lu(k,749) * lu(k,1780) - lu(k,1819) = lu(k,1819) - lu(k,750) * lu(k,1780) - lu(k,1820) = lu(k,1820) - lu(k,751) * lu(k,1780) - lu(k,1821) = lu(k,1821) - lu(k,752) * lu(k,1780) - lu(k,1856) = lu(k,1856) - lu(k,748) * lu(k,1839) - lu(k,1862) = lu(k,1862) - lu(k,749) * lu(k,1839) - lu(k,1869) = lu(k,1869) - lu(k,750) * lu(k,1839) - lu(k,1870) = lu(k,1870) - lu(k,751) * lu(k,1839) - lu(k,1871) = lu(k,1871) - lu(k,752) * lu(k,1839) + lu(k,741) = 1._r8 / lu(k,741) + lu(k,742) = lu(k,742) * lu(k,741) + lu(k,743) = lu(k,743) * lu(k,741) + lu(k,744) = lu(k,744) * lu(k,741) + lu(k,745) = lu(k,745) * lu(k,741) + lu(k,746) = lu(k,746) * lu(k,741) + lu(k,747) = lu(k,747) * lu(k,741) + lu(k,748) = lu(k,748) * lu(k,741) + lu(k,749) = lu(k,749) * lu(k,741) + lu(k,750) = lu(k,750) * lu(k,741) + lu(k,751) = lu(k,751) * lu(k,741) + lu(k,787) = lu(k,787) - lu(k,742) * lu(k,786) + lu(k,788) = lu(k,788) - lu(k,743) * lu(k,786) + lu(k,789) = lu(k,789) - lu(k,744) * lu(k,786) + lu(k,790) = lu(k,790) - lu(k,745) * lu(k,786) + lu(k,791) = lu(k,791) - lu(k,746) * lu(k,786) + lu(k,792) = lu(k,792) - lu(k,747) * lu(k,786) + lu(k,793) = lu(k,793) - lu(k,748) * lu(k,786) + lu(k,794) = lu(k,794) - lu(k,749) * lu(k,786) + lu(k,797) = - lu(k,750) * lu(k,786) + lu(k,798) = lu(k,798) - lu(k,751) * lu(k,786) + lu(k,1861) = lu(k,1861) - lu(k,742) * lu(k,1859) + lu(k,1863) = lu(k,1863) - lu(k,743) * lu(k,1859) + lu(k,1864) = lu(k,1864) - lu(k,744) * lu(k,1859) + lu(k,1875) = lu(k,1875) - lu(k,745) * lu(k,1859) + lu(k,1881) = lu(k,1881) - lu(k,746) * lu(k,1859) + lu(k,1891) = lu(k,1891) - lu(k,747) * lu(k,1859) + lu(k,1900) = lu(k,1900) - lu(k,748) * lu(k,1859) + lu(k,1907) = lu(k,1907) - lu(k,749) * lu(k,1859) + lu(k,1917) = lu(k,1917) - lu(k,750) * lu(k,1859) + lu(k,1924) = lu(k,1924) - lu(k,751) * lu(k,1859) + lu(k,2174) = lu(k,2174) - lu(k,742) * lu(k,2172) + lu(k,2176) = lu(k,2176) - lu(k,743) * lu(k,2172) + lu(k,2177) = lu(k,2177) - lu(k,744) * lu(k,2172) + lu(k,2186) = lu(k,2186) - lu(k,745) * lu(k,2172) + lu(k,2190) = lu(k,2190) - lu(k,746) * lu(k,2172) + lu(k,2196) = lu(k,2196) - lu(k,747) * lu(k,2172) + lu(k,2204) = lu(k,2204) - lu(k,748) * lu(k,2172) + lu(k,2210) = lu(k,2210) - lu(k,749) * lu(k,2172) + lu(k,2220) = lu(k,2220) - lu(k,750) * lu(k,2172) + lu(k,2227) = lu(k,2227) - lu(k,751) * lu(k,2172) lu(k,754) = 1._r8 / lu(k,754) lu(k,755) = lu(k,755) * lu(k,754) lu(k,756) = lu(k,756) * lu(k,754) lu(k,757) = lu(k,757) * lu(k,754) lu(k,758) = lu(k,758) * lu(k,754) lu(k,759) = lu(k,759) * lu(k,754) - lu(k,1127) = lu(k,1127) - lu(k,755) * lu(k,1126) - lu(k,1131) = - lu(k,756) * lu(k,1126) - lu(k,1132) = lu(k,1132) - lu(k,757) * lu(k,1126) - lu(k,1137) = lu(k,1137) - lu(k,758) * lu(k,1126) - lu(k,1139) = - lu(k,759) * lu(k,1126) - lu(k,1684) = lu(k,1684) - lu(k,755) * lu(k,1657) - lu(k,1696) = lu(k,1696) - lu(k,756) * lu(k,1657) - lu(k,1698) = lu(k,1698) - lu(k,757) * lu(k,1657) - lu(k,1706) = lu(k,1706) - lu(k,758) * lu(k,1657) - lu(k,1708) = lu(k,1708) - lu(k,759) * lu(k,1657) - lu(k,1752) = lu(k,1752) - lu(k,755) * lu(k,1745) - lu(k,1760) = lu(k,1760) - lu(k,756) * lu(k,1745) - lu(k,1762) = lu(k,1762) - lu(k,757) * lu(k,1745) - lu(k,1770) = lu(k,1770) - lu(k,758) * lu(k,1745) - lu(k,1772) = lu(k,1772) - lu(k,759) * lu(k,1745) - lu(k,1805) = - lu(k,755) * lu(k,1781) - lu(k,1817) = lu(k,1817) - lu(k,756) * lu(k,1781) - lu(k,1819) = lu(k,1819) - lu(k,757) * lu(k,1781) - lu(k,1827) = lu(k,1827) - lu(k,758) * lu(k,1781) - lu(k,1829) = - lu(k,759) * lu(k,1781) - lu(k,1915) = lu(k,1915) - lu(k,755) * lu(k,1894) - lu(k,1927) = lu(k,1927) - lu(k,756) * lu(k,1894) - lu(k,1929) = lu(k,1929) - lu(k,757) * lu(k,1894) - lu(k,1937) = lu(k,1937) - lu(k,758) * lu(k,1894) - lu(k,1939) = lu(k,1939) - lu(k,759) * lu(k,1894) - lu(k,1945) = lu(k,1945) - lu(k,755) * lu(k,1944) - lu(k,1951) = lu(k,1951) - lu(k,756) * lu(k,1944) - lu(k,1953) = lu(k,1953) - lu(k,757) * lu(k,1944) - lu(k,1961) = lu(k,1961) - lu(k,758) * lu(k,1944) - lu(k,1963) = lu(k,1963) - lu(k,759) * lu(k,1944) - lu(k,1971) = lu(k,1971) - lu(k,755) * lu(k,1969) - lu(k,1977) = lu(k,1977) - lu(k,756) * lu(k,1969) - lu(k,1979) = lu(k,1979) - lu(k,757) * lu(k,1969) - lu(k,1987) = lu(k,1987) - lu(k,758) * lu(k,1969) - lu(k,1989) = lu(k,1989) - lu(k,759) * lu(k,1969) - lu(k,2001) = lu(k,2001) - lu(k,755) * lu(k,1997) - lu(k,2007) = lu(k,2007) - lu(k,756) * lu(k,1997) - lu(k,2009) = lu(k,2009) - lu(k,757) * lu(k,1997) - lu(k,2017) = lu(k,2017) - lu(k,758) * lu(k,1997) - lu(k,2019) = lu(k,2019) - lu(k,759) * lu(k,1997) - lu(k,2060) = - lu(k,755) * lu(k,2058) - lu(k,2066) = - lu(k,756) * lu(k,2058) - lu(k,2068) = lu(k,2068) - lu(k,757) * lu(k,2058) - lu(k,2076) = lu(k,2076) - lu(k,758) * lu(k,2058) - lu(k,2078) = lu(k,2078) - lu(k,759) * lu(k,2058) + lu(k,760) = lu(k,760) * lu(k,754) + lu(k,1585) = lu(k,1585) - lu(k,755) * lu(k,1563) + lu(k,1604) = lu(k,1604) - lu(k,756) * lu(k,1563) + lu(k,1606) = lu(k,1606) - lu(k,757) * lu(k,1563) + lu(k,1608) = lu(k,1608) - lu(k,758) * lu(k,1563) + lu(k,1612) = lu(k,1612) - lu(k,759) * lu(k,1563) + lu(k,1615) = lu(k,1615) - lu(k,760) * lu(k,1563) + lu(k,1892) = lu(k,1892) - lu(k,755) * lu(k,1860) + lu(k,1913) = lu(k,1913) - lu(k,756) * lu(k,1860) + lu(k,1915) = lu(k,1915) - lu(k,757) * lu(k,1860) + lu(k,1917) = lu(k,1917) - lu(k,758) * lu(k,1860) + lu(k,1921) = lu(k,1921) - lu(k,759) * lu(k,1860) + lu(k,1924) = lu(k,1924) - lu(k,760) * lu(k,1860) + lu(k,2197) = lu(k,2197) - lu(k,755) * lu(k,2173) + lu(k,2216) = lu(k,2216) - lu(k,756) * lu(k,2173) + lu(k,2218) = lu(k,2218) - lu(k,757) * lu(k,2173) + lu(k,2220) = lu(k,2220) - lu(k,758) * lu(k,2173) + lu(k,2224) = lu(k,2224) - lu(k,759) * lu(k,2173) + lu(k,2227) = lu(k,2227) - lu(k,760) * lu(k,2173) + lu(k,2248) = - lu(k,755) * lu(k,2240) + lu(k,2255) = - lu(k,756) * lu(k,2240) + lu(k,2257) = - lu(k,757) * lu(k,2240) + lu(k,2259) = lu(k,2259) - lu(k,758) * lu(k,2240) + lu(k,2263) = lu(k,2263) - lu(k,759) * lu(k,2240) + lu(k,2266) = lu(k,2266) - lu(k,760) * lu(k,2240) + lu(k,2298) = - lu(k,755) * lu(k,2282) + lu(k,2316) = lu(k,2316) - lu(k,756) * lu(k,2282) + lu(k,2318) = lu(k,2318) - lu(k,757) * lu(k,2282) + lu(k,2320) = lu(k,2320) - lu(k,758) * lu(k,2282) + lu(k,2324) = lu(k,2324) - lu(k,759) * lu(k,2282) + lu(k,2327) = lu(k,2327) - lu(k,760) * lu(k,2282) + lu(k,761) = 1._r8 / lu(k,761) + lu(k,762) = lu(k,762) * lu(k,761) + lu(k,763) = lu(k,763) * lu(k,761) + lu(k,764) = lu(k,764) * lu(k,761) + lu(k,765) = lu(k,765) * lu(k,761) + lu(k,766) = lu(k,766) * lu(k,761) + lu(k,775) = lu(k,775) - lu(k,762) * lu(k,771) + lu(k,776) = lu(k,776) - lu(k,763) * lu(k,771) + lu(k,778) = lu(k,778) - lu(k,764) * lu(k,771) + lu(k,779) = lu(k,779) - lu(k,765) * lu(k,771) + lu(k,781) = lu(k,781) - lu(k,766) * lu(k,771) + lu(k,791) = lu(k,791) - lu(k,762) * lu(k,787) + lu(k,792) = lu(k,792) - lu(k,763) * lu(k,787) + lu(k,795) = lu(k,795) - lu(k,764) * lu(k,787) + lu(k,796) = lu(k,796) - lu(k,765) * lu(k,787) + lu(k,798) = lu(k,798) - lu(k,766) * lu(k,787) + lu(k,1577) = lu(k,1577) - lu(k,762) * lu(k,1564) + lu(k,1584) = lu(k,1584) - lu(k,763) * lu(k,1564) + lu(k,1604) = lu(k,1604) - lu(k,764) * lu(k,1564) + lu(k,1606) = lu(k,1606) - lu(k,765) * lu(k,1564) + lu(k,1615) = lu(k,1615) - lu(k,766) * lu(k,1564) + lu(k,1689) = - lu(k,762) * lu(k,1682) + lu(k,1690) = - lu(k,763) * lu(k,1682) + lu(k,1700) = lu(k,1700) - lu(k,764) * lu(k,1682) + lu(k,1702) = lu(k,1702) - lu(k,765) * lu(k,1682) + lu(k,1711) = lu(k,1711) - lu(k,766) * lu(k,1682) + lu(k,1881) = lu(k,1881) - lu(k,762) * lu(k,1861) + lu(k,1891) = lu(k,1891) - lu(k,763) * lu(k,1861) + lu(k,1913) = lu(k,1913) - lu(k,764) * lu(k,1861) + lu(k,1915) = lu(k,1915) - lu(k,765) * lu(k,1861) + lu(k,1924) = lu(k,1924) - lu(k,766) * lu(k,1861) + lu(k,2190) = lu(k,2190) - lu(k,762) * lu(k,2174) + lu(k,2196) = lu(k,2196) - lu(k,763) * lu(k,2174) + lu(k,2216) = lu(k,2216) - lu(k,764) * lu(k,2174) + lu(k,2218) = lu(k,2218) - lu(k,765) * lu(k,2174) + lu(k,2227) = lu(k,2227) - lu(k,766) * lu(k,2174) + lu(k,772) = 1._r8 / lu(k,772) + lu(k,773) = lu(k,773) * lu(k,772) + lu(k,774) = lu(k,774) * lu(k,772) + lu(k,775) = lu(k,775) * lu(k,772) + lu(k,776) = lu(k,776) * lu(k,772) + lu(k,777) = lu(k,777) * lu(k,772) + lu(k,778) = lu(k,778) * lu(k,772) + lu(k,779) = lu(k,779) * lu(k,772) + lu(k,780) = lu(k,780) * lu(k,772) + lu(k,781) = lu(k,781) * lu(k,772) + lu(k,1567) = lu(k,1567) - lu(k,773) * lu(k,1565) + lu(k,1573) = lu(k,1573) - lu(k,774) * lu(k,1565) + lu(k,1577) = lu(k,1577) - lu(k,775) * lu(k,1565) + lu(k,1584) = lu(k,1584) - lu(k,776) * lu(k,1565) + lu(k,1593) = lu(k,1593) - lu(k,777) * lu(k,1565) + lu(k,1604) = lu(k,1604) - lu(k,778) * lu(k,1565) + lu(k,1606) = lu(k,1606) - lu(k,779) * lu(k,1565) + lu(k,1608) = lu(k,1608) - lu(k,780) * lu(k,1565) + lu(k,1615) = lu(k,1615) - lu(k,781) * lu(k,1565) + lu(k,1864) = lu(k,1864) - lu(k,773) * lu(k,1862) + lu(k,1875) = lu(k,1875) - lu(k,774) * lu(k,1862) + lu(k,1881) = lu(k,1881) - lu(k,775) * lu(k,1862) + lu(k,1891) = lu(k,1891) - lu(k,776) * lu(k,1862) + lu(k,1900) = lu(k,1900) - lu(k,777) * lu(k,1862) + lu(k,1913) = lu(k,1913) - lu(k,778) * lu(k,1862) + lu(k,1915) = lu(k,1915) - lu(k,779) * lu(k,1862) + lu(k,1917) = lu(k,1917) - lu(k,780) * lu(k,1862) + lu(k,1924) = lu(k,1924) - lu(k,781) * lu(k,1862) + lu(k,2177) = lu(k,2177) - lu(k,773) * lu(k,2175) + lu(k,2186) = lu(k,2186) - lu(k,774) * lu(k,2175) + lu(k,2190) = lu(k,2190) - lu(k,775) * lu(k,2175) + lu(k,2196) = lu(k,2196) - lu(k,776) * lu(k,2175) + lu(k,2204) = lu(k,2204) - lu(k,777) * lu(k,2175) + lu(k,2216) = lu(k,2216) - lu(k,778) * lu(k,2175) + lu(k,2218) = lu(k,2218) - lu(k,779) * lu(k,2175) + lu(k,2220) = lu(k,2220) - lu(k,780) * lu(k,2175) + lu(k,2227) = lu(k,2227) - lu(k,781) * lu(k,2175) + lu(k,788) = 1._r8 / lu(k,788) + lu(k,789) = lu(k,789) * lu(k,788) + lu(k,790) = lu(k,790) * lu(k,788) + lu(k,791) = lu(k,791) * lu(k,788) + lu(k,792) = lu(k,792) * lu(k,788) + lu(k,793) = lu(k,793) * lu(k,788) + lu(k,794) = lu(k,794) * lu(k,788) + lu(k,795) = lu(k,795) * lu(k,788) + lu(k,796) = lu(k,796) * lu(k,788) + lu(k,797) = lu(k,797) * lu(k,788) + lu(k,798) = lu(k,798) * lu(k,788) + lu(k,1567) = lu(k,1567) - lu(k,789) * lu(k,1566) + lu(k,1573) = lu(k,1573) - lu(k,790) * lu(k,1566) + lu(k,1577) = lu(k,1577) - lu(k,791) * lu(k,1566) + lu(k,1584) = lu(k,1584) - lu(k,792) * lu(k,1566) + lu(k,1593) = lu(k,1593) - lu(k,793) * lu(k,1566) + lu(k,1599) = lu(k,1599) - lu(k,794) * lu(k,1566) + lu(k,1604) = lu(k,1604) - lu(k,795) * lu(k,1566) + lu(k,1606) = lu(k,1606) - lu(k,796) * lu(k,1566) + lu(k,1608) = lu(k,1608) - lu(k,797) * lu(k,1566) + lu(k,1615) = lu(k,1615) - lu(k,798) * lu(k,1566) + lu(k,1864) = lu(k,1864) - lu(k,789) * lu(k,1863) + lu(k,1875) = lu(k,1875) - lu(k,790) * lu(k,1863) + lu(k,1881) = lu(k,1881) - lu(k,791) * lu(k,1863) + lu(k,1891) = lu(k,1891) - lu(k,792) * lu(k,1863) + lu(k,1900) = lu(k,1900) - lu(k,793) * lu(k,1863) + lu(k,1907) = lu(k,1907) - lu(k,794) * lu(k,1863) + lu(k,1913) = lu(k,1913) - lu(k,795) * lu(k,1863) + lu(k,1915) = lu(k,1915) - lu(k,796) * lu(k,1863) + lu(k,1917) = lu(k,1917) - lu(k,797) * lu(k,1863) + lu(k,1924) = lu(k,1924) - lu(k,798) * lu(k,1863) + lu(k,2177) = lu(k,2177) - lu(k,789) * lu(k,2176) + lu(k,2186) = lu(k,2186) - lu(k,790) * lu(k,2176) + lu(k,2190) = lu(k,2190) - lu(k,791) * lu(k,2176) + lu(k,2196) = lu(k,2196) - lu(k,792) * lu(k,2176) + lu(k,2204) = lu(k,2204) - lu(k,793) * lu(k,2176) + lu(k,2210) = lu(k,2210) - lu(k,794) * lu(k,2176) + lu(k,2216) = lu(k,2216) - lu(k,795) * lu(k,2176) + lu(k,2218) = lu(k,2218) - lu(k,796) * lu(k,2176) + lu(k,2220) = lu(k,2220) - lu(k,797) * lu(k,2176) + lu(k,2227) = lu(k,2227) - lu(k,798) * lu(k,2176) end do end subroutine lu_fac16 subroutine lu_fac17( avec_len, lu ) @@ -2724,238 +2459,261 @@ subroutine lu_fac17( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,766) = 1._r8 / lu(k,766) - lu(k,767) = lu(k,767) * lu(k,766) - lu(k,768) = lu(k,768) * lu(k,766) - lu(k,769) = lu(k,769) * lu(k,766) - lu(k,770) = lu(k,770) * lu(k,766) - lu(k,771) = lu(k,771) * lu(k,766) - lu(k,772) = lu(k,772) * lu(k,766) - lu(k,773) = lu(k,773) * lu(k,766) - lu(k,774) = lu(k,774) * lu(k,766) - lu(k,775) = lu(k,775) * lu(k,766) - lu(k,776) = lu(k,776) * lu(k,766) - lu(k,777) = lu(k,777) * lu(k,766) - lu(k,778) = lu(k,778) * lu(k,766) - lu(k,779) = lu(k,779) * lu(k,766) - lu(k,780) = lu(k,780) * lu(k,766) - lu(k,781) = lu(k,781) * lu(k,766) - lu(k,1667) = lu(k,1667) - lu(k,767) * lu(k,1658) - lu(k,1672) = lu(k,1672) - lu(k,768) * lu(k,1658) - lu(k,1681) = - lu(k,769) * lu(k,1658) - lu(k,1682) = lu(k,1682) - lu(k,770) * lu(k,1658) - lu(k,1685) = lu(k,1685) - lu(k,771) * lu(k,1658) - lu(k,1686) = lu(k,1686) - lu(k,772) * lu(k,1658) - lu(k,1688) = lu(k,1688) - lu(k,773) * lu(k,1658) - lu(k,1690) = lu(k,1690) - lu(k,774) * lu(k,1658) - lu(k,1696) = lu(k,1696) - lu(k,775) * lu(k,1658) - lu(k,1698) = lu(k,1698) - lu(k,776) * lu(k,1658) - lu(k,1699) = lu(k,1699) - lu(k,777) * lu(k,1658) - lu(k,1701) = lu(k,1701) - lu(k,778) * lu(k,1658) - lu(k,1702) = lu(k,1702) - lu(k,779) * lu(k,1658) - lu(k,1703) = lu(k,1703) - lu(k,780) * lu(k,1658) - lu(k,1708) = lu(k,1708) - lu(k,781) * lu(k,1658) - lu(k,1789) = lu(k,1789) - lu(k,767) * lu(k,1782) - lu(k,1794) = lu(k,1794) - lu(k,768) * lu(k,1782) - lu(k,1802) = lu(k,1802) - lu(k,769) * lu(k,1782) - lu(k,1803) = lu(k,1803) - lu(k,770) * lu(k,1782) - lu(k,1806) = lu(k,1806) - lu(k,771) * lu(k,1782) - lu(k,1807) = lu(k,1807) - lu(k,772) * lu(k,1782) - lu(k,1809) = lu(k,1809) - lu(k,773) * lu(k,1782) - lu(k,1811) = lu(k,1811) - lu(k,774) * lu(k,1782) - lu(k,1817) = lu(k,1817) - lu(k,775) * lu(k,1782) - lu(k,1819) = lu(k,1819) - lu(k,776) * lu(k,1782) - lu(k,1820) = lu(k,1820) - lu(k,777) * lu(k,1782) - lu(k,1822) = lu(k,1822) - lu(k,778) * lu(k,1782) - lu(k,1823) = - lu(k,779) * lu(k,1782) - lu(k,1824) = - lu(k,780) * lu(k,1782) - lu(k,1829) = lu(k,1829) - lu(k,781) * lu(k,1782) - lu(k,1902) = lu(k,1902) - lu(k,767) * lu(k,1895) - lu(k,1905) = lu(k,1905) - lu(k,768) * lu(k,1895) - lu(k,1912) = - lu(k,769) * lu(k,1895) - lu(k,1913) = lu(k,1913) - lu(k,770) * lu(k,1895) - lu(k,1916) = - lu(k,771) * lu(k,1895) - lu(k,1917) = lu(k,1917) - lu(k,772) * lu(k,1895) - lu(k,1919) = - lu(k,773) * lu(k,1895) - lu(k,1921) = lu(k,1921) - lu(k,774) * lu(k,1895) - lu(k,1927) = lu(k,1927) - lu(k,775) * lu(k,1895) - lu(k,1929) = lu(k,1929) - lu(k,776) * lu(k,1895) - lu(k,1930) = lu(k,1930) - lu(k,777) * lu(k,1895) - lu(k,1932) = lu(k,1932) - lu(k,778) * lu(k,1895) - lu(k,1933) = lu(k,1933) - lu(k,779) * lu(k,1895) - lu(k,1934) = lu(k,1934) - lu(k,780) * lu(k,1895) - lu(k,1939) = lu(k,1939) - lu(k,781) * lu(k,1895) - lu(k,782) = 1._r8 / lu(k,782) - lu(k,783) = lu(k,783) * lu(k,782) - lu(k,784) = lu(k,784) * lu(k,782) - lu(k,785) = lu(k,785) * lu(k,782) - lu(k,786) = lu(k,786) * lu(k,782) - lu(k,787) = lu(k,787) * lu(k,782) - lu(k,788) = lu(k,788) * lu(k,782) - lu(k,789) = lu(k,789) * lu(k,782) - lu(k,790) = lu(k,790) * lu(k,782) - lu(k,911) = lu(k,911) - lu(k,783) * lu(k,910) - lu(k,913) = lu(k,913) - lu(k,784) * lu(k,910) - lu(k,914) = lu(k,914) - lu(k,785) * lu(k,910) - lu(k,917) = - lu(k,786) * lu(k,910) - lu(k,918) = lu(k,918) - lu(k,787) * lu(k,910) - lu(k,919) = lu(k,919) - lu(k,788) * lu(k,910) - lu(k,921) = lu(k,921) - lu(k,789) * lu(k,910) - lu(k,922) = - lu(k,790) * lu(k,910) - lu(k,1218) = lu(k,1218) - lu(k,783) * lu(k,1217) - lu(k,1221) = lu(k,1221) - lu(k,784) * lu(k,1217) - lu(k,1227) = lu(k,1227) - lu(k,785) * lu(k,1217) - lu(k,1235) = lu(k,1235) - lu(k,786) * lu(k,1217) - lu(k,1236) = lu(k,1236) - lu(k,787) * lu(k,1217) - lu(k,1237) = lu(k,1237) - lu(k,788) * lu(k,1217) - lu(k,1239) = lu(k,1239) - lu(k,789) * lu(k,1217) - lu(k,1241) = lu(k,1241) - lu(k,790) * lu(k,1217) - lu(k,1367) = lu(k,1367) - lu(k,783) * lu(k,1366) - lu(k,1375) = lu(k,1375) - lu(k,784) * lu(k,1366) - lu(k,1385) = lu(k,1385) - lu(k,785) * lu(k,1366) - lu(k,1395) = lu(k,1395) - lu(k,786) * lu(k,1366) - lu(k,1397) = lu(k,1397) - lu(k,787) * lu(k,1366) - lu(k,1399) = lu(k,1399) - lu(k,788) * lu(k,1366) - lu(k,1401) = lu(k,1401) - lu(k,789) * lu(k,1366) - lu(k,1403) = lu(k,1403) - lu(k,790) * lu(k,1366) - lu(k,1484) = lu(k,1484) - lu(k,783) * lu(k,1483) - lu(k,1490) = lu(k,1490) - lu(k,784) * lu(k,1483) - lu(k,1501) = lu(k,1501) - lu(k,785) * lu(k,1483) - lu(k,1511) = lu(k,1511) - lu(k,786) * lu(k,1483) - lu(k,1513) = lu(k,1513) - lu(k,787) * lu(k,1483) - lu(k,1515) = lu(k,1515) - lu(k,788) * lu(k,1483) - lu(k,1517) = lu(k,1517) - lu(k,789) * lu(k,1483) - lu(k,1519) = lu(k,1519) - lu(k,790) * lu(k,1483) - lu(k,1660) = lu(k,1660) - lu(k,783) * lu(k,1659) - lu(k,1672) = lu(k,1672) - lu(k,784) * lu(k,1659) - lu(k,1683) = lu(k,1683) - lu(k,785) * lu(k,1659) - lu(k,1694) = lu(k,1694) - lu(k,786) * lu(k,1659) - lu(k,1696) = lu(k,1696) - lu(k,787) * lu(k,1659) - lu(k,1698) = lu(k,1698) - lu(k,788) * lu(k,1659) - lu(k,1700) = lu(k,1700) - lu(k,789) * lu(k,1659) - lu(k,1702) = lu(k,1702) - lu(k,790) * lu(k,1659) - lu(k,1747) = lu(k,1747) - lu(k,783) * lu(k,1746) - lu(k,1749) = lu(k,1749) - lu(k,784) * lu(k,1746) - lu(k,1751) = lu(k,1751) - lu(k,785) * lu(k,1746) - lu(k,1758) = lu(k,1758) - lu(k,786) * lu(k,1746) - lu(k,1760) = lu(k,1760) - lu(k,787) * lu(k,1746) - lu(k,1762) = lu(k,1762) - lu(k,788) * lu(k,1746) - lu(k,1764) = lu(k,1764) - lu(k,789) * lu(k,1746) - lu(k,1766) = lu(k,1766) - lu(k,790) * lu(k,1746) - lu(k,792) = 1._r8 / lu(k,792) - lu(k,793) = lu(k,793) * lu(k,792) - lu(k,794) = lu(k,794) * lu(k,792) - lu(k,795) = lu(k,795) * lu(k,792) - lu(k,810) = lu(k,810) - lu(k,793) * lu(k,804) - lu(k,816) = lu(k,816) - lu(k,794) * lu(k,804) - lu(k,817) = lu(k,817) - lu(k,795) * lu(k,804) - lu(k,836) = lu(k,836) - lu(k,793) * lu(k,830) - lu(k,842) = lu(k,842) - lu(k,794) * lu(k,830) - lu(k,843) = lu(k,843) - lu(k,795) * lu(k,830) - lu(k,913) = lu(k,913) - lu(k,793) * lu(k,911) - lu(k,918) = lu(k,918) - lu(k,794) * lu(k,911) - lu(k,919) = lu(k,919) - lu(k,795) * lu(k,911) - lu(k,925) = lu(k,925) - lu(k,793) * lu(k,923) - lu(k,926) = lu(k,926) - lu(k,794) * lu(k,923) - lu(k,927) = lu(k,927) - lu(k,795) * lu(k,923) - lu(k,1066) = lu(k,1066) - lu(k,793) * lu(k,1064) - lu(k,1073) = lu(k,1073) - lu(k,794) * lu(k,1064) - lu(k,1074) = lu(k,1074) - lu(k,795) * lu(k,1064) - lu(k,1221) = lu(k,1221) - lu(k,793) * lu(k,1218) - lu(k,1236) = lu(k,1236) - lu(k,794) * lu(k,1218) - lu(k,1237) = lu(k,1237) - lu(k,795) * lu(k,1218) - lu(k,1269) = lu(k,1269) - lu(k,793) * lu(k,1266) - lu(k,1284) = lu(k,1284) - lu(k,794) * lu(k,1266) - lu(k,1285) = lu(k,1285) - lu(k,795) * lu(k,1266) - lu(k,1375) = lu(k,1375) - lu(k,793) * lu(k,1367) - lu(k,1397) = lu(k,1397) - lu(k,794) * lu(k,1367) - lu(k,1399) = lu(k,1399) - lu(k,795) * lu(k,1367) - lu(k,1490) = lu(k,1490) - lu(k,793) * lu(k,1484) - lu(k,1513) = lu(k,1513) - lu(k,794) * lu(k,1484) - lu(k,1515) = lu(k,1515) - lu(k,795) * lu(k,1484) - lu(k,1672) = lu(k,1672) - lu(k,793) * lu(k,1660) - lu(k,1696) = lu(k,1696) - lu(k,794) * lu(k,1660) - lu(k,1698) = lu(k,1698) - lu(k,795) * lu(k,1660) - lu(k,1749) = lu(k,1749) - lu(k,793) * lu(k,1747) - lu(k,1760) = lu(k,1760) - lu(k,794) * lu(k,1747) - lu(k,1762) = lu(k,1762) - lu(k,795) * lu(k,1747) - lu(k,1794) = lu(k,1794) - lu(k,793) * lu(k,1783) - lu(k,1817) = lu(k,1817) - lu(k,794) * lu(k,1783) - lu(k,1819) = lu(k,1819) - lu(k,795) * lu(k,1783) - lu(k,1846) = lu(k,1846) - lu(k,793) * lu(k,1840) - lu(k,1867) = lu(k,1867) - lu(k,794) * lu(k,1840) - lu(k,1869) = lu(k,1869) - lu(k,795) * lu(k,1840) - lu(k,1905) = lu(k,1905) - lu(k,793) * lu(k,1896) - lu(k,1927) = lu(k,1927) - lu(k,794) * lu(k,1896) - lu(k,1929) = lu(k,1929) - lu(k,795) * lu(k,1896) - lu(k,2032) = lu(k,2032) - lu(k,793) * lu(k,2029) - lu(k,2041) = lu(k,2041) - lu(k,794) * lu(k,2029) - lu(k,2043) = lu(k,2043) - lu(k,795) * lu(k,2029) - lu(k,805) = 1._r8 / lu(k,805) - lu(k,806) = lu(k,806) * lu(k,805) - lu(k,807) = lu(k,807) * lu(k,805) - lu(k,808) = lu(k,808) * lu(k,805) - lu(k,809) = lu(k,809) * lu(k,805) - lu(k,810) = lu(k,810) * lu(k,805) - lu(k,811) = lu(k,811) * lu(k,805) - lu(k,812) = lu(k,812) * lu(k,805) - lu(k,813) = lu(k,813) * lu(k,805) - lu(k,814) = lu(k,814) * lu(k,805) - lu(k,815) = lu(k,815) * lu(k,805) - lu(k,816) = lu(k,816) * lu(k,805) - lu(k,817) = lu(k,817) * lu(k,805) - lu(k,818) = lu(k,818) * lu(k,805) - lu(k,819) = lu(k,819) * lu(k,805) - lu(k,820) = lu(k,820) * lu(k,805) - lu(k,821) = lu(k,821) * lu(k,805) - lu(k,1663) = lu(k,1663) - lu(k,806) * lu(k,1661) - lu(k,1664) = lu(k,1664) - lu(k,807) * lu(k,1661) - lu(k,1666) = lu(k,1666) - lu(k,808) * lu(k,1661) - lu(k,1671) = lu(k,1671) - lu(k,809) * lu(k,1661) - lu(k,1672) = lu(k,1672) - lu(k,810) * lu(k,1661) - lu(k,1674) = lu(k,1674) - lu(k,811) * lu(k,1661) - lu(k,1676) = lu(k,1676) - lu(k,812) * lu(k,1661) - lu(k,1677) = lu(k,1677) - lu(k,813) * lu(k,1661) - lu(k,1683) = lu(k,1683) - lu(k,814) * lu(k,1661) - lu(k,1690) = lu(k,1690) - lu(k,815) * lu(k,1661) - lu(k,1696) = lu(k,1696) - lu(k,816) * lu(k,1661) - lu(k,1698) = lu(k,1698) - lu(k,817) * lu(k,1661) - lu(k,1699) = lu(k,1699) - lu(k,818) * lu(k,1661) - lu(k,1701) = lu(k,1701) - lu(k,819) * lu(k,1661) - lu(k,1703) = lu(k,1703) - lu(k,820) * lu(k,1661) - lu(k,1708) = lu(k,1708) - lu(k,821) * lu(k,1661) - lu(k,1786) = - lu(k,806) * lu(k,1784) - lu(k,1787) = lu(k,1787) - lu(k,807) * lu(k,1784) - lu(k,1788) = lu(k,1788) - lu(k,808) * lu(k,1784) - lu(k,1793) = - lu(k,809) * lu(k,1784) - lu(k,1794) = lu(k,1794) - lu(k,810) * lu(k,1784) - lu(k,1796) = - lu(k,811) * lu(k,1784) - lu(k,1798) = lu(k,1798) - lu(k,812) * lu(k,1784) - lu(k,1799) = - lu(k,813) * lu(k,1784) - lu(k,1804) = lu(k,1804) - lu(k,814) * lu(k,1784) - lu(k,1811) = lu(k,1811) - lu(k,815) * lu(k,1784) - lu(k,1817) = lu(k,1817) - lu(k,816) * lu(k,1784) - lu(k,1819) = lu(k,1819) - lu(k,817) * lu(k,1784) - lu(k,1820) = lu(k,1820) - lu(k,818) * lu(k,1784) - lu(k,1822) = lu(k,1822) - lu(k,819) * lu(k,1784) - lu(k,1824) = lu(k,1824) - lu(k,820) * lu(k,1784) - lu(k,1829) = lu(k,1829) - lu(k,821) * lu(k,1784) - lu(k,1899) = lu(k,1899) - lu(k,806) * lu(k,1897) - lu(k,1900) = lu(k,1900) - lu(k,807) * lu(k,1897) - lu(k,1901) = lu(k,1901) - lu(k,808) * lu(k,1897) - lu(k,1904) = lu(k,1904) - lu(k,809) * lu(k,1897) - lu(k,1905) = lu(k,1905) - lu(k,810) * lu(k,1897) - lu(k,1907) = - lu(k,811) * lu(k,1897) - lu(k,1909) = - lu(k,812) * lu(k,1897) - lu(k,1910) = lu(k,1910) - lu(k,813) * lu(k,1897) - lu(k,1914) = lu(k,1914) - lu(k,814) * lu(k,1897) - lu(k,1921) = lu(k,1921) - lu(k,815) * lu(k,1897) - lu(k,1927) = lu(k,1927) - lu(k,816) * lu(k,1897) - lu(k,1929) = lu(k,1929) - lu(k,817) * lu(k,1897) - lu(k,1930) = lu(k,1930) - lu(k,818) * lu(k,1897) - lu(k,1932) = lu(k,1932) - lu(k,819) * lu(k,1897) - lu(k,1934) = lu(k,1934) - lu(k,820) * lu(k,1897) - lu(k,1939) = lu(k,1939) - lu(k,821) * lu(k,1897) + lu(k,799) = 1._r8 / lu(k,799) + lu(k,800) = lu(k,800) * lu(k,799) + lu(k,801) = lu(k,801) * lu(k,799) + lu(k,802) = lu(k,802) * lu(k,799) + lu(k,803) = lu(k,803) * lu(k,799) + lu(k,804) = lu(k,804) * lu(k,799) + lu(k,805) = lu(k,805) * lu(k,799) + lu(k,806) = lu(k,806) * lu(k,799) + lu(k,1584) = lu(k,1584) - lu(k,800) * lu(k,1567) + lu(k,1593) = lu(k,1593) - lu(k,801) * lu(k,1567) + lu(k,1604) = lu(k,1604) - lu(k,802) * lu(k,1567) + lu(k,1605) = lu(k,1605) - lu(k,803) * lu(k,1567) + lu(k,1606) = lu(k,1606) - lu(k,804) * lu(k,1567) + lu(k,1608) = lu(k,1608) - lu(k,805) * lu(k,1567) + lu(k,1615) = lu(k,1615) - lu(k,806) * lu(k,1567) + lu(k,1690) = lu(k,1690) - lu(k,800) * lu(k,1683) + lu(k,1692) = - lu(k,801) * lu(k,1683) + lu(k,1700) = lu(k,1700) - lu(k,802) * lu(k,1683) + lu(k,1701) = lu(k,1701) - lu(k,803) * lu(k,1683) + lu(k,1702) = lu(k,1702) - lu(k,804) * lu(k,1683) + lu(k,1704) = lu(k,1704) - lu(k,805) * lu(k,1683) + lu(k,1711) = lu(k,1711) - lu(k,806) * lu(k,1683) + lu(k,1891) = lu(k,1891) - lu(k,800) * lu(k,1864) + lu(k,1900) = lu(k,1900) - lu(k,801) * lu(k,1864) + lu(k,1913) = lu(k,1913) - lu(k,802) * lu(k,1864) + lu(k,1914) = lu(k,1914) - lu(k,803) * lu(k,1864) + lu(k,1915) = lu(k,1915) - lu(k,804) * lu(k,1864) + lu(k,1917) = lu(k,1917) - lu(k,805) * lu(k,1864) + lu(k,1924) = lu(k,1924) - lu(k,806) * lu(k,1864) + lu(k,2196) = lu(k,2196) - lu(k,800) * lu(k,2177) + lu(k,2204) = lu(k,2204) - lu(k,801) * lu(k,2177) + lu(k,2216) = lu(k,2216) - lu(k,802) * lu(k,2177) + lu(k,2217) = lu(k,2217) - lu(k,803) * lu(k,2177) + lu(k,2218) = lu(k,2218) - lu(k,804) * lu(k,2177) + lu(k,2220) = lu(k,2220) - lu(k,805) * lu(k,2177) + lu(k,2227) = lu(k,2227) - lu(k,806) * lu(k,2177) + lu(k,808) = 1._r8 / lu(k,808) + lu(k,809) = lu(k,809) * lu(k,808) + lu(k,810) = lu(k,810) * lu(k,808) + lu(k,811) = lu(k,811) * lu(k,808) + lu(k,812) = lu(k,812) * lu(k,808) + lu(k,813) = lu(k,813) * lu(k,808) + lu(k,814) = lu(k,814) * lu(k,808) + lu(k,815) = lu(k,815) * lu(k,808) + lu(k,816) = lu(k,816) * lu(k,808) + lu(k,1065) = lu(k,1065) - lu(k,809) * lu(k,1060) + lu(k,1067) = - lu(k,810) * lu(k,1060) + lu(k,1071) = - lu(k,811) * lu(k,1060) + lu(k,1073) = - lu(k,812) * lu(k,1060) + lu(k,1074) = lu(k,1074) - lu(k,813) * lu(k,1060) + lu(k,1076) = lu(k,1076) - lu(k,814) * lu(k,1060) + lu(k,1078) = lu(k,1078) - lu(k,815) * lu(k,1060) + lu(k,1080) = lu(k,1080) - lu(k,816) * lu(k,1060) + lu(k,1583) = lu(k,1583) - lu(k,809) * lu(k,1568) + lu(k,1588) = lu(k,1588) - lu(k,810) * lu(k,1568) + lu(k,1604) = lu(k,1604) - lu(k,811) * lu(k,1568) + lu(k,1606) = lu(k,1606) - lu(k,812) * lu(k,1568) + lu(k,1608) = lu(k,1608) - lu(k,813) * lu(k,1568) + lu(k,1612) = lu(k,1612) - lu(k,814) * lu(k,1568) + lu(k,1615) = lu(k,1615) - lu(k,815) * lu(k,1568) + lu(k,1618) = - lu(k,816) * lu(k,1568) + lu(k,1890) = lu(k,1890) - lu(k,809) * lu(k,1865) + lu(k,1895) = lu(k,1895) - lu(k,810) * lu(k,1865) + lu(k,1913) = lu(k,1913) - lu(k,811) * lu(k,1865) + lu(k,1915) = lu(k,1915) - lu(k,812) * lu(k,1865) + lu(k,1917) = lu(k,1917) - lu(k,813) * lu(k,1865) + lu(k,1921) = lu(k,1921) - lu(k,814) * lu(k,1865) + lu(k,1924) = lu(k,1924) - lu(k,815) * lu(k,1865) + lu(k,1927) = lu(k,1927) - lu(k,816) * lu(k,1865) + lu(k,2195) = lu(k,2195) - lu(k,809) * lu(k,2178) + lu(k,2200) = lu(k,2200) - lu(k,810) * lu(k,2178) + lu(k,2216) = lu(k,2216) - lu(k,811) * lu(k,2178) + lu(k,2218) = lu(k,2218) - lu(k,812) * lu(k,2178) + lu(k,2220) = lu(k,2220) - lu(k,813) * lu(k,2178) + lu(k,2224) = lu(k,2224) - lu(k,814) * lu(k,2178) + lu(k,2227) = lu(k,2227) - lu(k,815) * lu(k,2178) + lu(k,2230) = lu(k,2230) - lu(k,816) * lu(k,2178) + lu(k,818) = 1._r8 / lu(k,818) + lu(k,819) = lu(k,819) * lu(k,818) + lu(k,820) = lu(k,820) * lu(k,818) + lu(k,821) = lu(k,821) * lu(k,818) + lu(k,822) = lu(k,822) * lu(k,818) + lu(k,823) = lu(k,823) * lu(k,818) + lu(k,824) = lu(k,824) * lu(k,818) + lu(k,825) = lu(k,825) * lu(k,818) + lu(k,1696) = lu(k,1696) - lu(k,819) * lu(k,1684) + lu(k,1704) = lu(k,1704) - lu(k,820) * lu(k,1684) + lu(k,1706) = - lu(k,821) * lu(k,1684) + lu(k,1707) = lu(k,1707) - lu(k,822) * lu(k,1684) + lu(k,1710) = lu(k,1710) - lu(k,823) * lu(k,1684) + lu(k,1712) = - lu(k,824) * lu(k,1684) + lu(k,1714) = lu(k,1714) - lu(k,825) * lu(k,1684) + lu(k,1959) = lu(k,1959) - lu(k,819) * lu(k,1956) + lu(k,1965) = lu(k,1965) - lu(k,820) * lu(k,1956) + lu(k,1967) = lu(k,1967) - lu(k,821) * lu(k,1956) + lu(k,1968) = lu(k,1968) - lu(k,822) * lu(k,1956) + lu(k,1971) = - lu(k,823) * lu(k,1956) + lu(k,1973) = lu(k,1973) - lu(k,824) * lu(k,1956) + lu(k,1975) = lu(k,1975) - lu(k,825) * lu(k,1956) + lu(k,1988) = lu(k,1988) - lu(k,819) * lu(k,1980) + lu(k,1996) = lu(k,1996) - lu(k,820) * lu(k,1980) + lu(k,1998) = lu(k,1998) - lu(k,821) * lu(k,1980) + lu(k,1999) = lu(k,1999) - lu(k,822) * lu(k,1980) + lu(k,2002) = lu(k,2002) - lu(k,823) * lu(k,1980) + lu(k,2004) = lu(k,2004) - lu(k,824) * lu(k,1980) + lu(k,2006) = lu(k,2006) - lu(k,825) * lu(k,1980) + lu(k,2094) = lu(k,2094) - lu(k,819) * lu(k,2091) + lu(k,2101) = lu(k,2101) - lu(k,820) * lu(k,2091) + lu(k,2103) = - lu(k,821) * lu(k,2091) + lu(k,2104) = lu(k,2104) - lu(k,822) * lu(k,2091) + lu(k,2107) = lu(k,2107) - lu(k,823) * lu(k,2091) + lu(k,2109) = lu(k,2109) - lu(k,824) * lu(k,2091) + lu(k,2111) = - lu(k,825) * lu(k,2091) + lu(k,2212) = lu(k,2212) - lu(k,819) * lu(k,2179) + lu(k,2220) = lu(k,2220) - lu(k,820) * lu(k,2179) + lu(k,2222) = lu(k,2222) - lu(k,821) * lu(k,2179) + lu(k,2223) = lu(k,2223) - lu(k,822) * lu(k,2179) + lu(k,2226) = lu(k,2226) - lu(k,823) * lu(k,2179) + lu(k,2228) = lu(k,2228) - lu(k,824) * lu(k,2179) + lu(k,2230) = lu(k,2230) - lu(k,825) * lu(k,2179) + lu(k,826) = 1._r8 / lu(k,826) + lu(k,827) = lu(k,827) * lu(k,826) + lu(k,828) = lu(k,828) * lu(k,826) + lu(k,829) = lu(k,829) * lu(k,826) + lu(k,865) = lu(k,865) - lu(k,827) * lu(k,859) + lu(k,866) = lu(k,866) - lu(k,828) * lu(k,859) + lu(k,867) = lu(k,867) - lu(k,829) * lu(k,859) + lu(k,959) = lu(k,959) - lu(k,827) * lu(k,951) + lu(k,960) = lu(k,960) - lu(k,828) * lu(k,951) + lu(k,961) = lu(k,961) - lu(k,829) * lu(k,951) + lu(k,1109) = lu(k,1109) - lu(k,827) * lu(k,1099) + lu(k,1110) = lu(k,1110) - lu(k,828) * lu(k,1099) + lu(k,1112) = lu(k,1112) - lu(k,829) * lu(k,1099) + lu(k,1162) = lu(k,1162) - lu(k,827) * lu(k,1149) + lu(k,1164) = lu(k,1164) - lu(k,828) * lu(k,1149) + lu(k,1165) = lu(k,1165) - lu(k,829) * lu(k,1149) + lu(k,1176) = lu(k,1176) - lu(k,827) * lu(k,1168) + lu(k,1177) = lu(k,1177) - lu(k,828) * lu(k,1168) + lu(k,1178) = lu(k,1178) - lu(k,829) * lu(k,1168) + lu(k,1219) = lu(k,1219) - lu(k,827) * lu(k,1207) + lu(k,1221) = lu(k,1221) - lu(k,828) * lu(k,1207) + lu(k,1223) = lu(k,1223) - lu(k,829) * lu(k,1207) + lu(k,1242) = lu(k,1242) - lu(k,827) * lu(k,1227) + lu(k,1244) = lu(k,1244) - lu(k,828) * lu(k,1227) + lu(k,1246) = lu(k,1246) - lu(k,829) * lu(k,1227) + lu(k,1305) = lu(k,1305) - lu(k,827) * lu(k,1287) + lu(k,1307) = lu(k,1307) - lu(k,828) * lu(k,1287) + lu(k,1309) = lu(k,1309) - lu(k,829) * lu(k,1287) + lu(k,1337) = lu(k,1337) - lu(k,827) * lu(k,1317) + lu(k,1339) = lu(k,1339) - lu(k,828) * lu(k,1317) + lu(k,1341) = lu(k,1341) - lu(k,829) * lu(k,1317) + lu(k,1358) = lu(k,1358) - lu(k,827) * lu(k,1345) + lu(k,1360) = lu(k,1360) - lu(k,828) * lu(k,1345) + lu(k,1362) = lu(k,1362) - lu(k,829) * lu(k,1345) + lu(k,1660) = lu(k,1660) - lu(k,827) * lu(k,1625) + lu(k,1664) = lu(k,1664) - lu(k,828) * lu(k,1625) + lu(k,1667) = lu(k,1667) - lu(k,829) * lu(k,1625) + lu(k,1917) = lu(k,1917) - lu(k,827) * lu(k,1866) + lu(k,1921) = lu(k,1921) - lu(k,828) * lu(k,1866) + lu(k,1924) = lu(k,1924) - lu(k,829) * lu(k,1866) + lu(k,831) = 1._r8 / lu(k,831) + lu(k,832) = lu(k,832) * lu(k,831) + lu(k,833) = lu(k,833) * lu(k,831) + lu(k,834) = lu(k,834) * lu(k,831) + lu(k,835) = lu(k,835) * lu(k,831) + lu(k,836) = lu(k,836) * lu(k,831) + lu(k,837) = lu(k,837) * lu(k,831) + lu(k,838) = lu(k,838) * lu(k,831) + lu(k,839) = lu(k,839) * lu(k,831) + lu(k,840) = lu(k,840) * lu(k,831) + lu(k,1576) = lu(k,1576) - lu(k,832) * lu(k,1569) + lu(k,1583) = lu(k,1583) - lu(k,833) * lu(k,1569) + lu(k,1604) = lu(k,1604) - lu(k,834) * lu(k,1569) + lu(k,1605) = lu(k,1605) - lu(k,835) * lu(k,1569) + lu(k,1606) = lu(k,1606) - lu(k,836) * lu(k,1569) + lu(k,1608) = lu(k,1608) - lu(k,837) * lu(k,1569) + lu(k,1612) = lu(k,1612) - lu(k,838) * lu(k,1569) + lu(k,1615) = lu(k,1615) - lu(k,839) * lu(k,1569) + lu(k,1618) = lu(k,1618) - lu(k,840) * lu(k,1569) + lu(k,1631) = lu(k,1631) - lu(k,832) * lu(k,1626) + lu(k,1637) = lu(k,1637) - lu(k,833) * lu(k,1626) + lu(k,1656) = lu(k,1656) - lu(k,834) * lu(k,1626) + lu(k,1657) = lu(k,1657) - lu(k,835) * lu(k,1626) + lu(k,1658) = lu(k,1658) - lu(k,836) * lu(k,1626) + lu(k,1660) = lu(k,1660) - lu(k,837) * lu(k,1626) + lu(k,1664) = lu(k,1664) - lu(k,838) * lu(k,1626) + lu(k,1667) = lu(k,1667) - lu(k,839) * lu(k,1626) + lu(k,1670) = lu(k,1670) - lu(k,840) * lu(k,1626) + lu(k,1880) = lu(k,1880) - lu(k,832) * lu(k,1867) + lu(k,1890) = lu(k,1890) - lu(k,833) * lu(k,1867) + lu(k,1913) = lu(k,1913) - lu(k,834) * lu(k,1867) + lu(k,1914) = lu(k,1914) - lu(k,835) * lu(k,1867) + lu(k,1915) = lu(k,1915) - lu(k,836) * lu(k,1867) + lu(k,1917) = lu(k,1917) - lu(k,837) * lu(k,1867) + lu(k,1921) = lu(k,1921) - lu(k,838) * lu(k,1867) + lu(k,1924) = lu(k,1924) - lu(k,839) * lu(k,1867) + lu(k,1927) = lu(k,1927) - lu(k,840) * lu(k,1867) + lu(k,2189) = lu(k,2189) - lu(k,832) * lu(k,2180) + lu(k,2195) = lu(k,2195) - lu(k,833) * lu(k,2180) + lu(k,2216) = lu(k,2216) - lu(k,834) * lu(k,2180) + lu(k,2217) = lu(k,2217) - lu(k,835) * lu(k,2180) + lu(k,2218) = lu(k,2218) - lu(k,836) * lu(k,2180) + lu(k,2220) = lu(k,2220) - lu(k,837) * lu(k,2180) + lu(k,2224) = lu(k,2224) - lu(k,838) * lu(k,2180) + lu(k,2227) = lu(k,2227) - lu(k,839) * lu(k,2180) + lu(k,2230) = lu(k,2230) - lu(k,840) * lu(k,2180) + lu(k,842) = 1._r8 / lu(k,842) + lu(k,843) = lu(k,843) * lu(k,842) + lu(k,844) = lu(k,844) * lu(k,842) + lu(k,845) = lu(k,845) * lu(k,842) + lu(k,846) = lu(k,846) * lu(k,842) + lu(k,847) = lu(k,847) * lu(k,842) + lu(k,848) = lu(k,848) * lu(k,842) + lu(k,927) = lu(k,927) - lu(k,843) * lu(k,923) + lu(k,928) = lu(k,928) - lu(k,844) * lu(k,923) + lu(k,929) = lu(k,929) - lu(k,845) * lu(k,923) + lu(k,930) = lu(k,930) - lu(k,846) * lu(k,923) + lu(k,932) = lu(k,932) - lu(k,847) * lu(k,923) + lu(k,933) = - lu(k,848) * lu(k,923) + lu(k,1917) = lu(k,1917) - lu(k,843) * lu(k,1868) + lu(k,1918) = lu(k,1918) - lu(k,844) * lu(k,1868) + lu(k,1919) = lu(k,1919) - lu(k,845) * lu(k,1868) + lu(k,1920) = lu(k,1920) - lu(k,846) * lu(k,1868) + lu(k,1925) = lu(k,1925) - lu(k,847) * lu(k,1868) + lu(k,1927) = lu(k,1927) - lu(k,848) * lu(k,1868) + lu(k,1943) = lu(k,1943) - lu(k,843) * lu(k,1932) + lu(k,1944) = lu(k,1944) - lu(k,844) * lu(k,1932) + lu(k,1945) = lu(k,1945) - lu(k,845) * lu(k,1932) + lu(k,1946) = lu(k,1946) - lu(k,846) * lu(k,1932) + lu(k,1951) = lu(k,1951) - lu(k,847) * lu(k,1932) + lu(k,1953) = - lu(k,848) * lu(k,1932) + lu(k,1965) = lu(k,1965) - lu(k,843) * lu(k,1957) + lu(k,1966) = lu(k,1966) - lu(k,844) * lu(k,1957) + lu(k,1967) = lu(k,1967) - lu(k,845) * lu(k,1957) + lu(k,1968) = lu(k,1968) - lu(k,846) * lu(k,1957) + lu(k,1973) = lu(k,1973) - lu(k,847) * lu(k,1957) + lu(k,1975) = lu(k,1975) - lu(k,848) * lu(k,1957) + lu(k,1996) = lu(k,1996) - lu(k,843) * lu(k,1981) + lu(k,1997) = lu(k,1997) - lu(k,844) * lu(k,1981) + lu(k,1998) = lu(k,1998) - lu(k,845) * lu(k,1981) + lu(k,1999) = lu(k,1999) - lu(k,846) * lu(k,1981) + lu(k,2004) = lu(k,2004) - lu(k,847) * lu(k,1981) + lu(k,2006) = lu(k,2006) - lu(k,848) * lu(k,1981) + lu(k,2220) = lu(k,2220) - lu(k,843) * lu(k,2181) + lu(k,2221) = lu(k,2221) - lu(k,844) * lu(k,2181) + lu(k,2222) = lu(k,2222) - lu(k,845) * lu(k,2181) + lu(k,2223) = lu(k,2223) - lu(k,846) * lu(k,2181) + lu(k,2228) = lu(k,2228) - lu(k,847) * lu(k,2181) + lu(k,2230) = lu(k,2230) - lu(k,848) * lu(k,2181) + lu(k,2259) = lu(k,2259) - lu(k,843) * lu(k,2241) + lu(k,2260) = lu(k,2260) - lu(k,844) * lu(k,2241) + lu(k,2261) = lu(k,2261) - lu(k,845) * lu(k,2241) + lu(k,2262) = lu(k,2262) - lu(k,846) * lu(k,2241) + lu(k,2267) = lu(k,2267) - lu(k,847) * lu(k,2241) + lu(k,2269) = lu(k,2269) - lu(k,848) * lu(k,2241) end do end subroutine lu_fac17 subroutine lu_fac18( avec_len, lu ) @@ -2972,246 +2730,212 @@ subroutine lu_fac18( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,831) = 1._r8 / lu(k,831) - lu(k,832) = lu(k,832) * lu(k,831) - lu(k,833) = lu(k,833) * lu(k,831) - lu(k,834) = lu(k,834) * lu(k,831) - lu(k,835) = lu(k,835) * lu(k,831) - lu(k,836) = lu(k,836) * lu(k,831) - lu(k,837) = lu(k,837) * lu(k,831) - lu(k,838) = lu(k,838) * lu(k,831) - lu(k,839) = lu(k,839) * lu(k,831) - lu(k,840) = lu(k,840) * lu(k,831) - lu(k,841) = lu(k,841) * lu(k,831) - lu(k,842) = lu(k,842) * lu(k,831) - lu(k,843) = lu(k,843) * lu(k,831) - lu(k,844) = lu(k,844) * lu(k,831) - lu(k,845) = lu(k,845) * lu(k,831) - lu(k,846) = lu(k,846) * lu(k,831) - lu(k,847) = lu(k,847) * lu(k,831) - lu(k,1663) = lu(k,1663) - lu(k,832) * lu(k,1662) - lu(k,1664) = lu(k,1664) - lu(k,833) * lu(k,1662) - lu(k,1666) = lu(k,1666) - lu(k,834) * lu(k,1662) - lu(k,1671) = lu(k,1671) - lu(k,835) * lu(k,1662) - lu(k,1672) = lu(k,1672) - lu(k,836) * lu(k,1662) - lu(k,1674) = lu(k,1674) - lu(k,837) * lu(k,1662) - lu(k,1676) = lu(k,1676) - lu(k,838) * lu(k,1662) - lu(k,1677) = lu(k,1677) - lu(k,839) * lu(k,1662) - lu(k,1683) = lu(k,1683) - lu(k,840) * lu(k,1662) - lu(k,1690) = lu(k,1690) - lu(k,841) * lu(k,1662) - lu(k,1696) = lu(k,1696) - lu(k,842) * lu(k,1662) - lu(k,1698) = lu(k,1698) - lu(k,843) * lu(k,1662) - lu(k,1699) = lu(k,1699) - lu(k,844) * lu(k,1662) - lu(k,1701) = lu(k,1701) - lu(k,845) * lu(k,1662) - lu(k,1703) = lu(k,1703) - lu(k,846) * lu(k,1662) - lu(k,1708) = lu(k,1708) - lu(k,847) * lu(k,1662) - lu(k,1786) = lu(k,1786) - lu(k,832) * lu(k,1785) - lu(k,1787) = lu(k,1787) - lu(k,833) * lu(k,1785) - lu(k,1788) = lu(k,1788) - lu(k,834) * lu(k,1785) - lu(k,1793) = lu(k,1793) - lu(k,835) * lu(k,1785) - lu(k,1794) = lu(k,1794) - lu(k,836) * lu(k,1785) - lu(k,1796) = lu(k,1796) - lu(k,837) * lu(k,1785) - lu(k,1798) = lu(k,1798) - lu(k,838) * lu(k,1785) - lu(k,1799) = lu(k,1799) - lu(k,839) * lu(k,1785) - lu(k,1804) = lu(k,1804) - lu(k,840) * lu(k,1785) - lu(k,1811) = lu(k,1811) - lu(k,841) * lu(k,1785) - lu(k,1817) = lu(k,1817) - lu(k,842) * lu(k,1785) - lu(k,1819) = lu(k,1819) - lu(k,843) * lu(k,1785) - lu(k,1820) = lu(k,1820) - lu(k,844) * lu(k,1785) - lu(k,1822) = lu(k,1822) - lu(k,845) * lu(k,1785) - lu(k,1824) = lu(k,1824) - lu(k,846) * lu(k,1785) - lu(k,1829) = lu(k,1829) - lu(k,847) * lu(k,1785) - lu(k,1899) = lu(k,1899) - lu(k,832) * lu(k,1898) - lu(k,1900) = lu(k,1900) - lu(k,833) * lu(k,1898) - lu(k,1901) = lu(k,1901) - lu(k,834) * lu(k,1898) - lu(k,1904) = lu(k,1904) - lu(k,835) * lu(k,1898) - lu(k,1905) = lu(k,1905) - lu(k,836) * lu(k,1898) - lu(k,1907) = lu(k,1907) - lu(k,837) * lu(k,1898) - lu(k,1909) = lu(k,1909) - lu(k,838) * lu(k,1898) - lu(k,1910) = lu(k,1910) - lu(k,839) * lu(k,1898) - lu(k,1914) = lu(k,1914) - lu(k,840) * lu(k,1898) - lu(k,1921) = lu(k,1921) - lu(k,841) * lu(k,1898) - lu(k,1927) = lu(k,1927) - lu(k,842) * lu(k,1898) - lu(k,1929) = lu(k,1929) - lu(k,843) * lu(k,1898) - lu(k,1930) = lu(k,1930) - lu(k,844) * lu(k,1898) - lu(k,1932) = lu(k,1932) - lu(k,845) * lu(k,1898) - lu(k,1934) = lu(k,1934) - lu(k,846) * lu(k,1898) - lu(k,1939) = lu(k,1939) - lu(k,847) * lu(k,1898) - lu(k,853) = 1._r8 / lu(k,853) - lu(k,854) = lu(k,854) * lu(k,853) - lu(k,855) = lu(k,855) * lu(k,853) - lu(k,856) = lu(k,856) * lu(k,853) - lu(k,857) = lu(k,857) * lu(k,853) - lu(k,858) = lu(k,858) * lu(k,853) - lu(k,859) = lu(k,859) * lu(k,853) - lu(k,860) = lu(k,860) * lu(k,853) - lu(k,861) = lu(k,861) * lu(k,853) - lu(k,862) = lu(k,862) * lu(k,853) - lu(k,1369) = lu(k,1369) - lu(k,854) * lu(k,1368) - lu(k,1381) = lu(k,1381) - lu(k,855) * lu(k,1368) - lu(k,1391) = lu(k,1391) - lu(k,856) * lu(k,1368) - lu(k,1395) = lu(k,1395) - lu(k,857) * lu(k,1368) - lu(k,1397) = lu(k,1397) - lu(k,858) * lu(k,1368) - lu(k,1399) = lu(k,1399) - lu(k,859) * lu(k,1368) - lu(k,1400) = lu(k,1400) - lu(k,860) * lu(k,1368) - lu(k,1401) = lu(k,1401) - lu(k,861) * lu(k,1368) - lu(k,1403) = lu(k,1403) - lu(k,862) * lu(k,1368) - lu(k,1486) = lu(k,1486) - lu(k,854) * lu(k,1485) - lu(k,1496) = lu(k,1496) - lu(k,855) * lu(k,1485) - lu(k,1507) = lu(k,1507) - lu(k,856) * lu(k,1485) - lu(k,1511) = lu(k,1511) - lu(k,857) * lu(k,1485) - lu(k,1513) = lu(k,1513) - lu(k,858) * lu(k,1485) - lu(k,1515) = lu(k,1515) - lu(k,859) * lu(k,1485) - lu(k,1516) = lu(k,1516) - lu(k,860) * lu(k,1485) - lu(k,1517) = lu(k,1517) - lu(k,861) * lu(k,1485) - lu(k,1519) = lu(k,1519) - lu(k,862) * lu(k,1485) - lu(k,1664) = lu(k,1664) - lu(k,854) * lu(k,1663) - lu(k,1678) = lu(k,1678) - lu(k,855) * lu(k,1663) - lu(k,1690) = lu(k,1690) - lu(k,856) * lu(k,1663) - lu(k,1694) = lu(k,1694) - lu(k,857) * lu(k,1663) - lu(k,1696) = lu(k,1696) - lu(k,858) * lu(k,1663) - lu(k,1698) = lu(k,1698) - lu(k,859) * lu(k,1663) - lu(k,1699) = lu(k,1699) - lu(k,860) * lu(k,1663) - lu(k,1700) = lu(k,1700) - lu(k,861) * lu(k,1663) - lu(k,1702) = lu(k,1702) - lu(k,862) * lu(k,1663) - lu(k,1787) = lu(k,1787) - lu(k,854) * lu(k,1786) - lu(k,1800) = lu(k,1800) - lu(k,855) * lu(k,1786) - lu(k,1811) = lu(k,1811) - lu(k,856) * lu(k,1786) - lu(k,1815) = lu(k,1815) - lu(k,857) * lu(k,1786) - lu(k,1817) = lu(k,1817) - lu(k,858) * lu(k,1786) - lu(k,1819) = lu(k,1819) - lu(k,859) * lu(k,1786) - lu(k,1820) = lu(k,1820) - lu(k,860) * lu(k,1786) - lu(k,1821) = lu(k,1821) - lu(k,861) * lu(k,1786) - lu(k,1823) = lu(k,1823) - lu(k,862) * lu(k,1786) - lu(k,1900) = lu(k,1900) - lu(k,854) * lu(k,1899) - lu(k,1911) = lu(k,1911) - lu(k,855) * lu(k,1899) - lu(k,1921) = lu(k,1921) - lu(k,856) * lu(k,1899) - lu(k,1925) = lu(k,1925) - lu(k,857) * lu(k,1899) - lu(k,1927) = lu(k,1927) - lu(k,858) * lu(k,1899) - lu(k,1929) = lu(k,1929) - lu(k,859) * lu(k,1899) - lu(k,1930) = lu(k,1930) - lu(k,860) * lu(k,1899) - lu(k,1931) = lu(k,1931) - lu(k,861) * lu(k,1899) - lu(k,1933) = lu(k,1933) - lu(k,862) * lu(k,1899) - lu(k,863) = 1._r8 / lu(k,863) - lu(k,864) = lu(k,864) * lu(k,863) - lu(k,865) = lu(k,865) * lu(k,863) - lu(k,866) = lu(k,866) * lu(k,863) - lu(k,867) = lu(k,867) * lu(k,863) - lu(k,868) = lu(k,868) * lu(k,863) - lu(k,935) = - lu(k,864) * lu(k,930) - lu(k,937) = lu(k,937) - lu(k,865) * lu(k,930) - lu(k,940) = lu(k,940) - lu(k,866) * lu(k,930) - lu(k,943) = - lu(k,867) * lu(k,930) - lu(k,944) = - lu(k,868) * lu(k,930) - lu(k,948) = lu(k,948) - lu(k,864) * lu(k,945) - lu(k,949) = lu(k,949) - lu(k,865) * lu(k,945) - lu(k,951) = lu(k,951) - lu(k,866) * lu(k,945) - lu(k,953) = - lu(k,867) * lu(k,945) - lu(k,954) = - lu(k,868) * lu(k,945) - lu(k,975) = - lu(k,864) * lu(k,968) - lu(k,976) = - lu(k,865) * lu(k,968) - lu(k,981) = lu(k,981) - lu(k,866) * lu(k,968) - lu(k,985) = lu(k,985) - lu(k,867) * lu(k,968) - lu(k,986) = - lu(k,868) * lu(k,968) - lu(k,995) = - lu(k,864) * lu(k,990) - lu(k,996) = - lu(k,865) * lu(k,990) - lu(k,1001) = lu(k,1001) - lu(k,866) * lu(k,990) - lu(k,1004) = lu(k,1004) - lu(k,867) * lu(k,990) - lu(k,1005) = - lu(k,868) * lu(k,990) - lu(k,1380) = lu(k,1380) - lu(k,864) * lu(k,1369) - lu(k,1391) = lu(k,1391) - lu(k,865) * lu(k,1369) - lu(k,1399) = lu(k,1399) - lu(k,866) * lu(k,1369) - lu(k,1403) = lu(k,1403) - lu(k,867) * lu(k,1369) - lu(k,1409) = lu(k,1409) - lu(k,868) * lu(k,1369) - lu(k,1495) = lu(k,1495) - lu(k,864) * lu(k,1486) - lu(k,1507) = lu(k,1507) - lu(k,865) * lu(k,1486) - lu(k,1515) = lu(k,1515) - lu(k,866) * lu(k,1486) - lu(k,1519) = lu(k,1519) - lu(k,867) * lu(k,1486) - lu(k,1525) = lu(k,1525) - lu(k,868) * lu(k,1486) - lu(k,1677) = lu(k,1677) - lu(k,864) * lu(k,1664) - lu(k,1690) = lu(k,1690) - lu(k,865) * lu(k,1664) - lu(k,1698) = lu(k,1698) - lu(k,866) * lu(k,1664) - lu(k,1702) = lu(k,1702) - lu(k,867) * lu(k,1664) - lu(k,1708) = lu(k,1708) - lu(k,868) * lu(k,1664) - lu(k,1799) = lu(k,1799) - lu(k,864) * lu(k,1787) - lu(k,1811) = lu(k,1811) - lu(k,865) * lu(k,1787) - lu(k,1819) = lu(k,1819) - lu(k,866) * lu(k,1787) - lu(k,1823) = lu(k,1823) - lu(k,867) * lu(k,1787) - lu(k,1829) = lu(k,1829) - lu(k,868) * lu(k,1787) - lu(k,1851) = lu(k,1851) - lu(k,864) * lu(k,1841) - lu(k,1862) = lu(k,1862) - lu(k,865) * lu(k,1841) - lu(k,1869) = lu(k,1869) - lu(k,866) * lu(k,1841) - lu(k,1873) = lu(k,1873) - lu(k,867) * lu(k,1841) - lu(k,1879) = lu(k,1879) - lu(k,868) * lu(k,1841) - lu(k,1910) = lu(k,1910) - lu(k,864) * lu(k,1900) - lu(k,1921) = lu(k,1921) - lu(k,865) * lu(k,1900) - lu(k,1929) = lu(k,1929) - lu(k,866) * lu(k,1900) - lu(k,1933) = lu(k,1933) - lu(k,867) * lu(k,1900) - lu(k,1939) = lu(k,1939) - lu(k,868) * lu(k,1900) - lu(k,871) = 1._r8 / lu(k,871) - lu(k,872) = lu(k,872) * lu(k,871) - lu(k,873) = lu(k,873) * lu(k,871) - lu(k,874) = lu(k,874) * lu(k,871) - lu(k,875) = lu(k,875) * lu(k,871) - lu(k,876) = lu(k,876) * lu(k,871) - lu(k,877) = lu(k,877) * lu(k,871) - lu(k,878) = lu(k,878) * lu(k,871) - lu(k,879) = lu(k,879) * lu(k,871) - lu(k,880) = lu(k,880) * lu(k,871) - lu(k,1416) = lu(k,1416) - lu(k,872) * lu(k,1414) - lu(k,1418) = lu(k,1418) - lu(k,873) * lu(k,1414) - lu(k,1421) = lu(k,1421) - lu(k,874) * lu(k,1414) - lu(k,1423) = - lu(k,875) * lu(k,1414) - lu(k,1424) = - lu(k,876) * lu(k,1414) - lu(k,1428) = lu(k,1428) - lu(k,877) * lu(k,1414) - lu(k,1429) = lu(k,1429) - lu(k,878) * lu(k,1414) - lu(k,1430) = lu(k,1430) - lu(k,879) * lu(k,1414) - lu(k,1431) = lu(k,1431) - lu(k,880) * lu(k,1414) - lu(k,1692) = lu(k,1692) - lu(k,872) * lu(k,1665) - lu(k,1695) = lu(k,1695) - lu(k,873) * lu(k,1665) - lu(k,1698) = lu(k,1698) - lu(k,874) * lu(k,1665) - lu(k,1700) = lu(k,1700) - lu(k,875) * lu(k,1665) - lu(k,1701) = lu(k,1701) - lu(k,876) * lu(k,1665) - lu(k,1705) = lu(k,1705) - lu(k,877) * lu(k,1665) - lu(k,1706) = lu(k,1706) - lu(k,878) * lu(k,1665) - lu(k,1707) = lu(k,1707) - lu(k,879) * lu(k,1665) - lu(k,1708) = lu(k,1708) - lu(k,880) * lu(k,1665) - lu(k,1756) = lu(k,1756) - lu(k,872) * lu(k,1748) - lu(k,1759) = lu(k,1759) - lu(k,873) * lu(k,1748) - lu(k,1762) = lu(k,1762) - lu(k,874) * lu(k,1748) - lu(k,1764) = lu(k,1764) - lu(k,875) * lu(k,1748) - lu(k,1765) = lu(k,1765) - lu(k,876) * lu(k,1748) - lu(k,1769) = lu(k,1769) - lu(k,877) * lu(k,1748) - lu(k,1770) = lu(k,1770) - lu(k,878) * lu(k,1748) - lu(k,1771) = lu(k,1771) - lu(k,879) * lu(k,1748) - lu(k,1772) = lu(k,1772) - lu(k,880) * lu(k,1748) - lu(k,1973) = - lu(k,872) * lu(k,1970) - lu(k,1976) = lu(k,1976) - lu(k,873) * lu(k,1970) - lu(k,1979) = lu(k,1979) - lu(k,874) * lu(k,1970) - lu(k,1981) = lu(k,1981) - lu(k,875) * lu(k,1970) - lu(k,1982) = - lu(k,876) * lu(k,1970) - lu(k,1986) = lu(k,1986) - lu(k,877) * lu(k,1970) - lu(k,1987) = lu(k,1987) - lu(k,878) * lu(k,1970) - lu(k,1988) = lu(k,1988) - lu(k,879) * lu(k,1970) - lu(k,1989) = lu(k,1989) - lu(k,880) * lu(k,1970) - lu(k,2003) = lu(k,2003) - lu(k,872) * lu(k,1998) - lu(k,2006) = lu(k,2006) - lu(k,873) * lu(k,1998) - lu(k,2009) = lu(k,2009) - lu(k,874) * lu(k,1998) - lu(k,2011) = lu(k,2011) - lu(k,875) * lu(k,1998) - lu(k,2012) = lu(k,2012) - lu(k,876) * lu(k,1998) - lu(k,2016) = lu(k,2016) - lu(k,877) * lu(k,1998) - lu(k,2017) = lu(k,2017) - lu(k,878) * lu(k,1998) - lu(k,2018) = lu(k,2018) - lu(k,879) * lu(k,1998) - lu(k,2019) = lu(k,2019) - lu(k,880) * lu(k,1998) - lu(k,2037) = - lu(k,872) * lu(k,2030) - lu(k,2040) = lu(k,2040) - lu(k,873) * lu(k,2030) - lu(k,2043) = lu(k,2043) - lu(k,874) * lu(k,2030) - lu(k,2045) = lu(k,2045) - lu(k,875) * lu(k,2030) - lu(k,2046) = lu(k,2046) - lu(k,876) * lu(k,2030) - lu(k,2050) = lu(k,2050) - lu(k,877) * lu(k,2030) - lu(k,2051) = lu(k,2051) - lu(k,878) * lu(k,2030) - lu(k,2052) = lu(k,2052) - lu(k,879) * lu(k,2030) - lu(k,2053) = lu(k,2053) - lu(k,880) * lu(k,2030) + lu(k,849) = 1._r8 / lu(k,849) + lu(k,850) = lu(k,850) * lu(k,849) + lu(k,851) = lu(k,851) * lu(k,849) + lu(k,852) = lu(k,852) * lu(k,849) + lu(k,853) = lu(k,853) * lu(k,849) + lu(k,854) = lu(k,854) * lu(k,849) + lu(k,855) = lu(k,855) * lu(k,849) + lu(k,856) = lu(k,856) * lu(k,849) + lu(k,1455) = lu(k,1455) - lu(k,850) * lu(k,1453) + lu(k,1456) = - lu(k,851) * lu(k,1453) + lu(k,1457) = - lu(k,852) * lu(k,1453) + lu(k,1458) = - lu(k,853) * lu(k,1453) + lu(k,1459) = - lu(k,854) * lu(k,1453) + lu(k,1461) = lu(k,1461) - lu(k,855) * lu(k,1453) + lu(k,1464) = - lu(k,856) * lu(k,1453) + lu(k,1737) = lu(k,1737) - lu(k,850) * lu(k,1734) + lu(k,1740) = lu(k,1740) - lu(k,851) * lu(k,1734) + lu(k,1744) = lu(k,1744) - lu(k,852) * lu(k,1734) + lu(k,1745) = lu(k,1745) - lu(k,853) * lu(k,1734) + lu(k,1748) = lu(k,1748) - lu(k,854) * lu(k,1734) + lu(k,1751) = lu(k,1751) - lu(k,855) * lu(k,1734) + lu(k,1755) = lu(k,1755) - lu(k,856) * lu(k,1734) + lu(k,1909) = lu(k,1909) - lu(k,850) * lu(k,1869) + lu(k,1912) = lu(k,1912) - lu(k,851) * lu(k,1869) + lu(k,1916) = lu(k,1916) - lu(k,852) * lu(k,1869) + lu(k,1917) = lu(k,1917) - lu(k,853) * lu(k,1869) + lu(k,1920) = lu(k,1920) - lu(k,854) * lu(k,1869) + lu(k,1923) = lu(k,1923) - lu(k,855) * lu(k,1869) + lu(k,1927) = lu(k,1927) - lu(k,856) * lu(k,1869) + lu(k,1988) = lu(k,1988) - lu(k,850) * lu(k,1982) + lu(k,1991) = lu(k,1991) - lu(k,851) * lu(k,1982) + lu(k,1995) = - lu(k,852) * lu(k,1982) + lu(k,1996) = lu(k,1996) - lu(k,853) * lu(k,1982) + lu(k,1999) = lu(k,1999) - lu(k,854) * lu(k,1982) + lu(k,2002) = lu(k,2002) - lu(k,855) * lu(k,1982) + lu(k,2006) = lu(k,2006) - lu(k,856) * lu(k,1982) + lu(k,2012) = lu(k,2012) - lu(k,850) * lu(k,2008) + lu(k,2015) = lu(k,2015) - lu(k,851) * lu(k,2008) + lu(k,2019) = - lu(k,852) * lu(k,2008) + lu(k,2020) = lu(k,2020) - lu(k,853) * lu(k,2008) + lu(k,2023) = lu(k,2023) - lu(k,854) * lu(k,2008) + lu(k,2026) = - lu(k,855) * lu(k,2008) + lu(k,2030) = lu(k,2030) - lu(k,856) * lu(k,2008) + lu(k,2212) = lu(k,2212) - lu(k,850) * lu(k,2182) + lu(k,2215) = lu(k,2215) - lu(k,851) * lu(k,2182) + lu(k,2219) = - lu(k,852) * lu(k,2182) + lu(k,2220) = lu(k,2220) - lu(k,853) * lu(k,2182) + lu(k,2223) = lu(k,2223) - lu(k,854) * lu(k,2182) + lu(k,2226) = lu(k,2226) - lu(k,855) * lu(k,2182) + lu(k,2230) = lu(k,2230) - lu(k,856) * lu(k,2182) + lu(k,860) = 1._r8 / lu(k,860) + lu(k,861) = lu(k,861) * lu(k,860) + lu(k,862) = lu(k,862) * lu(k,860) + lu(k,863) = lu(k,863) * lu(k,860) + lu(k,864) = lu(k,864) * lu(k,860) + lu(k,865) = lu(k,865) * lu(k,860) + lu(k,866) = lu(k,866) * lu(k,860) + lu(k,867) = lu(k,867) * lu(k,860) + lu(k,941) = lu(k,941) - lu(k,861) * lu(k,938) + lu(k,943) = lu(k,943) - lu(k,862) * lu(k,938) + lu(k,944) = - lu(k,863) * lu(k,938) + lu(k,945) = lu(k,945) - lu(k,864) * lu(k,938) + lu(k,946) = lu(k,946) - lu(k,865) * lu(k,938) + lu(k,947) = lu(k,947) - lu(k,866) * lu(k,938) + lu(k,948) = lu(k,948) - lu(k,867) * lu(k,938) + lu(k,1583) = lu(k,1583) - lu(k,861) * lu(k,1570) + lu(k,1604) = lu(k,1604) - lu(k,862) * lu(k,1570) + lu(k,1605) = lu(k,1605) - lu(k,863) * lu(k,1570) + lu(k,1606) = lu(k,1606) - lu(k,864) * lu(k,1570) + lu(k,1608) = lu(k,1608) - lu(k,865) * lu(k,1570) + lu(k,1612) = lu(k,1612) - lu(k,866) * lu(k,1570) + lu(k,1615) = lu(k,1615) - lu(k,867) * lu(k,1570) + lu(k,1637) = lu(k,1637) - lu(k,861) * lu(k,1627) + lu(k,1656) = lu(k,1656) - lu(k,862) * lu(k,1627) + lu(k,1657) = lu(k,1657) - lu(k,863) * lu(k,1627) + lu(k,1658) = lu(k,1658) - lu(k,864) * lu(k,1627) + lu(k,1660) = lu(k,1660) - lu(k,865) * lu(k,1627) + lu(k,1664) = lu(k,1664) - lu(k,866) * lu(k,1627) + lu(k,1667) = lu(k,1667) - lu(k,867) * lu(k,1627) + lu(k,1890) = lu(k,1890) - lu(k,861) * lu(k,1870) + lu(k,1913) = lu(k,1913) - lu(k,862) * lu(k,1870) + lu(k,1914) = lu(k,1914) - lu(k,863) * lu(k,1870) + lu(k,1915) = lu(k,1915) - lu(k,864) * lu(k,1870) + lu(k,1917) = lu(k,1917) - lu(k,865) * lu(k,1870) + lu(k,1921) = lu(k,1921) - lu(k,866) * lu(k,1870) + lu(k,1924) = lu(k,1924) - lu(k,867) * lu(k,1870) + lu(k,2195) = lu(k,2195) - lu(k,861) * lu(k,2183) + lu(k,2216) = lu(k,2216) - lu(k,862) * lu(k,2183) + lu(k,2217) = lu(k,2217) - lu(k,863) * lu(k,2183) + lu(k,2218) = lu(k,2218) - lu(k,864) * lu(k,2183) + lu(k,2220) = lu(k,2220) - lu(k,865) * lu(k,2183) + lu(k,2224) = lu(k,2224) - lu(k,866) * lu(k,2183) + lu(k,2227) = lu(k,2227) - lu(k,867) * lu(k,2183) + lu(k,2246) = - lu(k,861) * lu(k,2242) + lu(k,2255) = lu(k,2255) - lu(k,862) * lu(k,2242) + lu(k,2256) = lu(k,2256) - lu(k,863) * lu(k,2242) + lu(k,2257) = lu(k,2257) - lu(k,864) * lu(k,2242) + lu(k,2259) = lu(k,2259) - lu(k,865) * lu(k,2242) + lu(k,2263) = lu(k,2263) - lu(k,866) * lu(k,2242) + lu(k,2266) = lu(k,2266) - lu(k,867) * lu(k,2242) + lu(k,868) = 1._r8 / lu(k,868) + lu(k,869) = lu(k,869) * lu(k,868) + lu(k,870) = lu(k,870) * lu(k,868) + lu(k,971) = lu(k,971) - lu(k,869) * lu(k,969) + lu(k,973) = - lu(k,870) * lu(k,969) + lu(k,994) = lu(k,994) - lu(k,869) * lu(k,983) + lu(k,1003) = - lu(k,870) * lu(k,983) + lu(k,1011) = - lu(k,869) * lu(k,1009) + lu(k,1013) = - lu(k,870) * lu(k,1009) + lu(k,1043) = lu(k,1043) - lu(k,869) * lu(k,1032) + lu(k,1053) = - lu(k,870) * lu(k,1032) + lu(k,1066) = lu(k,1066) - lu(k,869) * lu(k,1061) + lu(k,1075) = - lu(k,870) * lu(k,1061) + lu(k,1116) = lu(k,1116) - lu(k,869) * lu(k,1113) + lu(k,1121) = - lu(k,870) * lu(k,1113) + lu(k,1135) = lu(k,1135) - lu(k,869) * lu(k,1134) + lu(k,1137) = - lu(k,870) * lu(k,1134) + lu(k,1141) = lu(k,1141) - lu(k,869) * lu(k,1139) + lu(k,1144) = - lu(k,870) * lu(k,1139) + lu(k,1153) = lu(k,1153) - lu(k,869) * lu(k,1150) + lu(k,1163) = - lu(k,870) * lu(k,1150) + lu(k,1210) = lu(k,1210) - lu(k,869) * lu(k,1208) + lu(k,1220) = - lu(k,870) * lu(k,1208) + lu(k,1289) = - lu(k,869) * lu(k,1288) + lu(k,1306) = - lu(k,870) * lu(k,1288) + lu(k,1368) = lu(k,1368) - lu(k,869) * lu(k,1364) + lu(k,1381) = - lu(k,870) * lu(k,1364) + lu(k,1391) = - lu(k,869) * lu(k,1390) + lu(k,1401) = - lu(k,870) * lu(k,1390) + lu(k,1414) = lu(k,1414) - lu(k,869) * lu(k,1411) + lu(k,1433) = - lu(k,870) * lu(k,1411) + lu(k,1468) = lu(k,1468) - lu(k,869) * lu(k,1466) + lu(k,1477) = lu(k,1477) - lu(k,870) * lu(k,1466) + lu(k,1584) = lu(k,1584) - lu(k,869) * lu(k,1571) + lu(k,1611) = lu(k,1611) - lu(k,870) * lu(k,1571) + lu(k,1638) = lu(k,1638) - lu(k,869) * lu(k,1628) + lu(k,1663) = - lu(k,870) * lu(k,1628) + lu(k,1690) = lu(k,1690) - lu(k,869) * lu(k,1685) + lu(k,1707) = lu(k,1707) - lu(k,870) * lu(k,1685) + lu(k,1891) = lu(k,1891) - lu(k,869) * lu(k,1871) + lu(k,1920) = lu(k,1920) - lu(k,870) * lu(k,1871) + lu(k,2196) = lu(k,2196) - lu(k,869) * lu(k,2184) + lu(k,2223) = lu(k,2223) - lu(k,870) * lu(k,2184) + lu(k,2297) = lu(k,2297) - lu(k,869) * lu(k,2283) + lu(k,2323) = lu(k,2323) - lu(k,870) * lu(k,2283) + lu(k,874) = 1._r8 / lu(k,874) + lu(k,875) = lu(k,875) * lu(k,874) + lu(k,876) = lu(k,876) * lu(k,874) + lu(k,877) = lu(k,877) * lu(k,874) + lu(k,878) = lu(k,878) * lu(k,874) + lu(k,879) = lu(k,879) * lu(k,874) + lu(k,880) = lu(k,880) * lu(k,874) + lu(k,881) = lu(k,881) * lu(k,874) + lu(k,882) = lu(k,882) * lu(k,874) + lu(k,883) = lu(k,883) * lu(k,874) + lu(k,884) = lu(k,884) * lu(k,874) + lu(k,885) = lu(k,885) * lu(k,874) + lu(k,886) = lu(k,886) * lu(k,874) + lu(k,887) = lu(k,887) * lu(k,874) + lu(k,888) = lu(k,888) * lu(k,874) + lu(k,889) = lu(k,889) * lu(k,874) + lu(k,1883) = lu(k,1883) - lu(k,875) * lu(k,1872) + lu(k,1886) = lu(k,1886) - lu(k,876) * lu(k,1872) + lu(k,1891) = lu(k,1891) - lu(k,877) * lu(k,1872) + lu(k,1898) = - lu(k,878) * lu(k,1872) + lu(k,1899) = lu(k,1899) - lu(k,879) * lu(k,1872) + lu(k,1902) = lu(k,1902) - lu(k,880) * lu(k,1872) + lu(k,1903) = lu(k,1903) - lu(k,881) * lu(k,1872) + lu(k,1905) = lu(k,1905) - lu(k,882) * lu(k,1872) + lu(k,1907) = lu(k,1907) - lu(k,883) * lu(k,1872) + lu(k,1914) = lu(k,1914) - lu(k,884) * lu(k,1872) + lu(k,1917) = lu(k,1917) - lu(k,885) * lu(k,1872) + lu(k,1921) = lu(k,1921) - lu(k,886) * lu(k,1872) + lu(k,1922) = lu(k,1922) - lu(k,887) * lu(k,1872) + lu(k,1924) = lu(k,1924) - lu(k,888) * lu(k,1872) + lu(k,1926) = lu(k,1926) - lu(k,889) * lu(k,1872) + lu(k,2044) = - lu(k,875) * lu(k,2038) + lu(k,2047) = lu(k,2047) - lu(k,876) * lu(k,2038) + lu(k,2052) = lu(k,2052) - lu(k,877) * lu(k,2038) + lu(k,2059) = lu(k,2059) - lu(k,878) * lu(k,2038) + lu(k,2060) = lu(k,2060) - lu(k,879) * lu(k,2038) + lu(k,2063) = lu(k,2063) - lu(k,880) * lu(k,2038) + lu(k,2064) = lu(k,2064) - lu(k,881) * lu(k,2038) + lu(k,2066) = lu(k,2066) - lu(k,882) * lu(k,2038) + lu(k,2068) = lu(k,2068) - lu(k,883) * lu(k,2038) + lu(k,2074) = - lu(k,884) * lu(k,2038) + lu(k,2077) = lu(k,2077) - lu(k,885) * lu(k,2038) + lu(k,2081) = lu(k,2081) - lu(k,886) * lu(k,2038) + lu(k,2082) = lu(k,2082) - lu(k,887) * lu(k,2038) + lu(k,2084) = lu(k,2084) - lu(k,888) * lu(k,2038) + lu(k,2086) = - lu(k,889) * lu(k,2038) + lu(k,2290) = lu(k,2290) - lu(k,875) * lu(k,2284) + lu(k,2293) = lu(k,2293) - lu(k,876) * lu(k,2284) + lu(k,2297) = lu(k,2297) - lu(k,877) * lu(k,2284) + lu(k,2302) = - lu(k,878) * lu(k,2284) + lu(k,2303) = lu(k,2303) - lu(k,879) * lu(k,2284) + lu(k,2306) = - lu(k,880) * lu(k,2284) + lu(k,2307) = - lu(k,881) * lu(k,2284) + lu(k,2309) = lu(k,2309) - lu(k,882) * lu(k,2284) + lu(k,2311) = lu(k,2311) - lu(k,883) * lu(k,2284) + lu(k,2317) = lu(k,2317) - lu(k,884) * lu(k,2284) + lu(k,2320) = lu(k,2320) - lu(k,885) * lu(k,2284) + lu(k,2324) = lu(k,2324) - lu(k,886) * lu(k,2284) + lu(k,2325) = lu(k,2325) - lu(k,887) * lu(k,2284) + lu(k,2327) = lu(k,2327) - lu(k,888) * lu(k,2284) + lu(k,2329) = lu(k,2329) - lu(k,889) * lu(k,2284) end do end subroutine lu_fac18 subroutine lu_fac19( avec_len, lu ) @@ -3228,212 +2952,222 @@ subroutine lu_fac19( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,881) = 1._r8 / lu(k,881) - lu(k,882) = lu(k,882) * lu(k,881) - lu(k,883) = lu(k,883) * lu(k,881) - lu(k,884) = lu(k,884) * lu(k,881) - lu(k,885) = lu(k,885) * lu(k,881) - lu(k,886) = lu(k,886) * lu(k,881) - lu(k,887) = lu(k,887) * lu(k,881) - lu(k,888) = lu(k,888) * lu(k,881) - lu(k,970) = - lu(k,882) * lu(k,969) - lu(k,971) = - lu(k,883) * lu(k,969) - lu(k,973) = - lu(k,884) * lu(k,969) - lu(k,974) = - lu(k,885) * lu(k,969) - lu(k,980) = lu(k,980) - lu(k,886) * lu(k,969) - lu(k,981) = lu(k,981) - lu(k,887) * lu(k,969) - lu(k,984) = - lu(k,888) * lu(k,969) - lu(k,1010) = - lu(k,882) * lu(k,1009) - lu(k,1011) = - lu(k,883) * lu(k,1009) - lu(k,1012) = - lu(k,884) * lu(k,1009) - lu(k,1013) = lu(k,1013) - lu(k,885) * lu(k,1009) - lu(k,1019) = lu(k,1019) - lu(k,886) * lu(k,1009) - lu(k,1020) = lu(k,1020) - lu(k,887) * lu(k,1009) - lu(k,1023) = lu(k,1023) - lu(k,888) * lu(k,1009) - lu(k,1374) = lu(k,1374) - lu(k,882) * lu(k,1370) - lu(k,1375) = lu(k,1375) - lu(k,883) * lu(k,1370) - lu(k,1378) = lu(k,1378) - lu(k,884) * lu(k,1370) - lu(k,1379) = lu(k,1379) - lu(k,885) * lu(k,1370) - lu(k,1397) = lu(k,1397) - lu(k,886) * lu(k,1370) - lu(k,1399) = lu(k,1399) - lu(k,887) * lu(k,1370) - lu(k,1402) = lu(k,1402) - lu(k,888) * lu(k,1370) - lu(k,1489) = lu(k,1489) - lu(k,882) * lu(k,1487) - lu(k,1490) = lu(k,1490) - lu(k,883) * lu(k,1487) - lu(k,1493) = lu(k,1493) - lu(k,884) * lu(k,1487) - lu(k,1494) = lu(k,1494) - lu(k,885) * lu(k,1487) - lu(k,1513) = lu(k,1513) - lu(k,886) * lu(k,1487) - lu(k,1515) = lu(k,1515) - lu(k,887) * lu(k,1487) - lu(k,1518) = lu(k,1518) - lu(k,888) * lu(k,1487) - lu(k,1671) = lu(k,1671) - lu(k,882) * lu(k,1666) - lu(k,1672) = lu(k,1672) - lu(k,883) * lu(k,1666) - lu(k,1675) = lu(k,1675) - lu(k,884) * lu(k,1666) - lu(k,1676) = lu(k,1676) - lu(k,885) * lu(k,1666) - lu(k,1696) = lu(k,1696) - lu(k,886) * lu(k,1666) - lu(k,1698) = lu(k,1698) - lu(k,887) * lu(k,1666) - lu(k,1701) = lu(k,1701) - lu(k,888) * lu(k,1666) - lu(k,1793) = lu(k,1793) - lu(k,882) * lu(k,1788) - lu(k,1794) = lu(k,1794) - lu(k,883) * lu(k,1788) - lu(k,1797) = lu(k,1797) - lu(k,884) * lu(k,1788) - lu(k,1798) = lu(k,1798) - lu(k,885) * lu(k,1788) - lu(k,1817) = lu(k,1817) - lu(k,886) * lu(k,1788) - lu(k,1819) = lu(k,1819) - lu(k,887) * lu(k,1788) - lu(k,1822) = lu(k,1822) - lu(k,888) * lu(k,1788) - lu(k,1845) = lu(k,1845) - lu(k,882) * lu(k,1842) - lu(k,1846) = lu(k,1846) - lu(k,883) * lu(k,1842) - lu(k,1849) = lu(k,1849) - lu(k,884) * lu(k,1842) - lu(k,1850) = lu(k,1850) - lu(k,885) * lu(k,1842) - lu(k,1867) = lu(k,1867) - lu(k,886) * lu(k,1842) - lu(k,1869) = lu(k,1869) - lu(k,887) * lu(k,1842) - lu(k,1872) = - lu(k,888) * lu(k,1842) - lu(k,1904) = lu(k,1904) - lu(k,882) * lu(k,1901) - lu(k,1905) = lu(k,1905) - lu(k,883) * lu(k,1901) - lu(k,1908) = - lu(k,884) * lu(k,1901) - lu(k,1909) = lu(k,1909) - lu(k,885) * lu(k,1901) - lu(k,1927) = lu(k,1927) - lu(k,886) * lu(k,1901) - lu(k,1929) = lu(k,1929) - lu(k,887) * lu(k,1901) - lu(k,1932) = lu(k,1932) - lu(k,888) * lu(k,1901) - lu(k,893) = 1._r8 / lu(k,893) - lu(k,894) = lu(k,894) * lu(k,893) - lu(k,895) = lu(k,895) * lu(k,893) - lu(k,896) = lu(k,896) * lu(k,893) - lu(k,897) = lu(k,897) * lu(k,893) - lu(k,898) = lu(k,898) * lu(k,893) - lu(k,899) = lu(k,899) * lu(k,893) - lu(k,900) = lu(k,900) * lu(k,893) - lu(k,901) = lu(k,901) * lu(k,893) - lu(k,902) = lu(k,902) * lu(k,893) - lu(k,903) = lu(k,903) * lu(k,893) - lu(k,904) = lu(k,904) * lu(k,893) - lu(k,905) = lu(k,905) * lu(k,893) - lu(k,906) = lu(k,906) * lu(k,893) - lu(k,907) = lu(k,907) * lu(k,893) - lu(k,1170) = lu(k,1170) - lu(k,894) * lu(k,1169) - lu(k,1171) = - lu(k,895) * lu(k,1169) - lu(k,1172) = lu(k,1172) - lu(k,896) * lu(k,1169) - lu(k,1173) = lu(k,1173) - lu(k,897) * lu(k,1169) - lu(k,1176) = lu(k,1176) - lu(k,898) * lu(k,1169) - lu(k,1179) = - lu(k,899) * lu(k,1169) - lu(k,1180) = lu(k,1180) - lu(k,900) * lu(k,1169) - lu(k,1181) = lu(k,1181) - lu(k,901) * lu(k,1169) - lu(k,1182) = lu(k,1182) - lu(k,902) * lu(k,1169) - lu(k,1183) = - lu(k,903) * lu(k,1169) - lu(k,1184) = - lu(k,904) * lu(k,1169) - lu(k,1185) = lu(k,1185) - lu(k,905) * lu(k,1169) - lu(k,1186) = lu(k,1186) - lu(k,906) * lu(k,1169) - lu(k,1187) = lu(k,1187) - lu(k,907) * lu(k,1169) - lu(k,1672) = lu(k,1672) - lu(k,894) * lu(k,1667) - lu(k,1673) = lu(k,1673) - lu(k,895) * lu(k,1667) - lu(k,1678) = lu(k,1678) - lu(k,896) * lu(k,1667) - lu(k,1683) = lu(k,1683) - lu(k,897) * lu(k,1667) - lu(k,1690) = lu(k,1690) - lu(k,898) * lu(k,1667) - lu(k,1694) = lu(k,1694) - lu(k,899) * lu(k,1667) - lu(k,1696) = lu(k,1696) - lu(k,900) * lu(k,1667) - lu(k,1698) = lu(k,1698) - lu(k,901) * lu(k,1667) - lu(k,1699) = lu(k,1699) - lu(k,902) * lu(k,1667) - lu(k,1700) = lu(k,1700) - lu(k,903) * lu(k,1667) - lu(k,1701) = lu(k,1701) - lu(k,904) * lu(k,1667) - lu(k,1702) = lu(k,1702) - lu(k,905) * lu(k,1667) - lu(k,1703) = lu(k,1703) - lu(k,906) * lu(k,1667) - lu(k,1708) = lu(k,1708) - lu(k,907) * lu(k,1667) - lu(k,1794) = lu(k,1794) - lu(k,894) * lu(k,1789) - lu(k,1795) = lu(k,1795) - lu(k,895) * lu(k,1789) - lu(k,1800) = lu(k,1800) - lu(k,896) * lu(k,1789) - lu(k,1804) = lu(k,1804) - lu(k,897) * lu(k,1789) - lu(k,1811) = lu(k,1811) - lu(k,898) * lu(k,1789) - lu(k,1815) = lu(k,1815) - lu(k,899) * lu(k,1789) - lu(k,1817) = lu(k,1817) - lu(k,900) * lu(k,1789) - lu(k,1819) = lu(k,1819) - lu(k,901) * lu(k,1789) - lu(k,1820) = lu(k,1820) - lu(k,902) * lu(k,1789) - lu(k,1821) = lu(k,1821) - lu(k,903) * lu(k,1789) - lu(k,1822) = lu(k,1822) - lu(k,904) * lu(k,1789) - lu(k,1823) = lu(k,1823) - lu(k,905) * lu(k,1789) - lu(k,1824) = lu(k,1824) - lu(k,906) * lu(k,1789) - lu(k,1829) = lu(k,1829) - lu(k,907) * lu(k,1789) - lu(k,1905) = lu(k,1905) - lu(k,894) * lu(k,1902) - lu(k,1906) = - lu(k,895) * lu(k,1902) - lu(k,1911) = lu(k,1911) - lu(k,896) * lu(k,1902) - lu(k,1914) = lu(k,1914) - lu(k,897) * lu(k,1902) - lu(k,1921) = lu(k,1921) - lu(k,898) * lu(k,1902) - lu(k,1925) = lu(k,1925) - lu(k,899) * lu(k,1902) - lu(k,1927) = lu(k,1927) - lu(k,900) * lu(k,1902) - lu(k,1929) = lu(k,1929) - lu(k,901) * lu(k,1902) - lu(k,1930) = lu(k,1930) - lu(k,902) * lu(k,1902) - lu(k,1931) = lu(k,1931) - lu(k,903) * lu(k,1902) - lu(k,1932) = lu(k,1932) - lu(k,904) * lu(k,1902) - lu(k,1933) = lu(k,1933) - lu(k,905) * lu(k,1902) - lu(k,1934) = lu(k,1934) - lu(k,906) * lu(k,1902) - lu(k,1939) = lu(k,1939) - lu(k,907) * lu(k,1902) - lu(k,912) = 1._r8 / lu(k,912) - lu(k,913) = lu(k,913) * lu(k,912) - lu(k,914) = lu(k,914) * lu(k,912) - lu(k,915) = lu(k,915) * lu(k,912) - lu(k,916) = lu(k,916) * lu(k,912) - lu(k,917) = lu(k,917) * lu(k,912) - lu(k,918) = lu(k,918) * lu(k,912) - lu(k,919) = lu(k,919) * lu(k,912) - lu(k,920) = lu(k,920) * lu(k,912) - lu(k,921) = lu(k,921) * lu(k,912) - lu(k,922) = lu(k,922) * lu(k,912) - lu(k,1086) = - lu(k,913) * lu(k,1084) - lu(k,1090) = lu(k,1090) - lu(k,914) * lu(k,1084) - lu(k,1092) = lu(k,1092) - lu(k,915) * lu(k,1084) - lu(k,1093) = lu(k,1093) - lu(k,916) * lu(k,1084) - lu(k,1095) = lu(k,1095) - lu(k,917) * lu(k,1084) - lu(k,1096) = lu(k,1096) - lu(k,918) * lu(k,1084) - lu(k,1097) = lu(k,1097) - lu(k,919) * lu(k,1084) - lu(k,1098) = lu(k,1098) - lu(k,920) * lu(k,1084) - lu(k,1099) = lu(k,1099) - lu(k,921) * lu(k,1084) - lu(k,1101) = lu(k,1101) - lu(k,922) * lu(k,1084) - lu(k,1269) = lu(k,1269) - lu(k,913) * lu(k,1267) - lu(k,1274) = lu(k,1274) - lu(k,914) * lu(k,1267) - lu(k,1280) = lu(k,1280) - lu(k,915) * lu(k,1267) - lu(k,1281) = - lu(k,916) * lu(k,1267) - lu(k,1283) = lu(k,1283) - lu(k,917) * lu(k,1267) - lu(k,1284) = lu(k,1284) - lu(k,918) * lu(k,1267) - lu(k,1285) = lu(k,1285) - lu(k,919) * lu(k,1267) - lu(k,1286) = lu(k,1286) - lu(k,920) * lu(k,1267) - lu(k,1287) = lu(k,1287) - lu(k,921) * lu(k,1267) - lu(k,1289) = lu(k,1289) - lu(k,922) * lu(k,1267) - lu(k,1375) = lu(k,1375) - lu(k,913) * lu(k,1371) - lu(k,1385) = lu(k,1385) - lu(k,914) * lu(k,1371) - lu(k,1391) = lu(k,1391) - lu(k,915) * lu(k,1371) - lu(k,1393) = lu(k,1393) - lu(k,916) * lu(k,1371) - lu(k,1395) = lu(k,1395) - lu(k,917) * lu(k,1371) - lu(k,1397) = lu(k,1397) - lu(k,918) * lu(k,1371) - lu(k,1399) = lu(k,1399) - lu(k,919) * lu(k,1371) - lu(k,1400) = lu(k,1400) - lu(k,920) * lu(k,1371) - lu(k,1401) = lu(k,1401) - lu(k,921) * lu(k,1371) - lu(k,1403) = lu(k,1403) - lu(k,922) * lu(k,1371) - lu(k,1672) = lu(k,1672) - lu(k,913) * lu(k,1668) - lu(k,1683) = lu(k,1683) - lu(k,914) * lu(k,1668) - lu(k,1690) = lu(k,1690) - lu(k,915) * lu(k,1668) - lu(k,1692) = lu(k,1692) - lu(k,916) * lu(k,1668) - lu(k,1694) = lu(k,1694) - lu(k,917) * lu(k,1668) - lu(k,1696) = lu(k,1696) - lu(k,918) * lu(k,1668) - lu(k,1698) = lu(k,1698) - lu(k,919) * lu(k,1668) - lu(k,1699) = lu(k,1699) - lu(k,920) * lu(k,1668) - lu(k,1700) = lu(k,1700) - lu(k,921) * lu(k,1668) - lu(k,1702) = lu(k,1702) - lu(k,922) * lu(k,1668) - lu(k,1794) = lu(k,1794) - lu(k,913) * lu(k,1790) - lu(k,1804) = lu(k,1804) - lu(k,914) * lu(k,1790) - lu(k,1811) = lu(k,1811) - lu(k,915) * lu(k,1790) - lu(k,1813) = lu(k,1813) - lu(k,916) * lu(k,1790) - lu(k,1815) = lu(k,1815) - lu(k,917) * lu(k,1790) - lu(k,1817) = lu(k,1817) - lu(k,918) * lu(k,1790) - lu(k,1819) = lu(k,1819) - lu(k,919) * lu(k,1790) - lu(k,1820) = lu(k,1820) - lu(k,920) * lu(k,1790) - lu(k,1821) = lu(k,1821) - lu(k,921) * lu(k,1790) - lu(k,1823) = lu(k,1823) - lu(k,922) * lu(k,1790) - lu(k,1846) = lu(k,1846) - lu(k,913) * lu(k,1843) - lu(k,1856) = lu(k,1856) - lu(k,914) * lu(k,1843) - lu(k,1862) = lu(k,1862) - lu(k,915) * lu(k,1843) - lu(k,1863) = lu(k,1863) - lu(k,916) * lu(k,1843) - lu(k,1865) = lu(k,1865) - lu(k,917) * lu(k,1843) - lu(k,1867) = lu(k,1867) - lu(k,918) * lu(k,1843) - lu(k,1869) = lu(k,1869) - lu(k,919) * lu(k,1843) - lu(k,1870) = lu(k,1870) - lu(k,920) * lu(k,1843) - lu(k,1871) = lu(k,1871) - lu(k,921) * lu(k,1843) - lu(k,1873) = lu(k,1873) - lu(k,922) * lu(k,1843) + lu(k,890) = 1._r8 / lu(k,890) + lu(k,891) = lu(k,891) * lu(k,890) + lu(k,892) = lu(k,892) * lu(k,890) + lu(k,893) = lu(k,893) * lu(k,890) + lu(k,894) = lu(k,894) * lu(k,890) + lu(k,895) = lu(k,895) * lu(k,890) + lu(k,1068) = - lu(k,891) * lu(k,1062) + lu(k,1069) = - lu(k,892) * lu(k,1062) + lu(k,1073) = lu(k,1073) - lu(k,893) * lu(k,1062) + lu(k,1074) = lu(k,1074) - lu(k,894) * lu(k,1062) + lu(k,1076) = lu(k,1076) - lu(k,895) * lu(k,1062) + lu(k,1087) = - lu(k,891) * lu(k,1082) + lu(k,1088) = - lu(k,892) * lu(k,1082) + lu(k,1092) = lu(k,1092) - lu(k,893) * lu(k,1082) + lu(k,1093) = lu(k,1093) - lu(k,894) * lu(k,1082) + lu(k,1095) = - lu(k,895) * lu(k,1082) + lu(k,1235) = - lu(k,891) * lu(k,1228) + lu(k,1237) = lu(k,1237) - lu(k,892) * lu(k,1228) + lu(k,1241) = lu(k,1241) - lu(k,893) * lu(k,1228) + lu(k,1242) = lu(k,1242) - lu(k,894) * lu(k,1228) + lu(k,1244) = lu(k,1244) - lu(k,895) * lu(k,1228) + lu(k,1327) = lu(k,1327) - lu(k,891) * lu(k,1318) + lu(k,1332) = lu(k,1332) - lu(k,892) * lu(k,1318) + lu(k,1336) = lu(k,1336) - lu(k,893) * lu(k,1318) + lu(k,1337) = lu(k,1337) - lu(k,894) * lu(k,1318) + lu(k,1339) = lu(k,1339) - lu(k,895) * lu(k,1318) + lu(k,1593) = lu(k,1593) - lu(k,891) * lu(k,1572) + lu(k,1599) = lu(k,1599) - lu(k,892) * lu(k,1572) + lu(k,1606) = lu(k,1606) - lu(k,893) * lu(k,1572) + lu(k,1608) = lu(k,1608) - lu(k,894) * lu(k,1572) + lu(k,1612) = lu(k,1612) - lu(k,895) * lu(k,1572) + lu(k,1646) = lu(k,1646) - lu(k,891) * lu(k,1629) + lu(k,1652) = lu(k,1652) - lu(k,892) * lu(k,1629) + lu(k,1658) = lu(k,1658) - lu(k,893) * lu(k,1629) + lu(k,1660) = lu(k,1660) - lu(k,894) * lu(k,1629) + lu(k,1664) = lu(k,1664) - lu(k,895) * lu(k,1629) + lu(k,1900) = lu(k,1900) - lu(k,891) * lu(k,1873) + lu(k,1907) = lu(k,1907) - lu(k,892) * lu(k,1873) + lu(k,1915) = lu(k,1915) - lu(k,893) * lu(k,1873) + lu(k,1917) = lu(k,1917) - lu(k,894) * lu(k,1873) + lu(k,1921) = lu(k,1921) - lu(k,895) * lu(k,1873) + lu(k,2061) = lu(k,2061) - lu(k,891) * lu(k,2039) + lu(k,2068) = lu(k,2068) - lu(k,892) * lu(k,2039) + lu(k,2075) = lu(k,2075) - lu(k,893) * lu(k,2039) + lu(k,2077) = lu(k,2077) - lu(k,894) * lu(k,2039) + lu(k,2081) = lu(k,2081) - lu(k,895) * lu(k,2039) + lu(k,2204) = lu(k,2204) - lu(k,891) * lu(k,2185) + lu(k,2210) = lu(k,2210) - lu(k,892) * lu(k,2185) + lu(k,2218) = lu(k,2218) - lu(k,893) * lu(k,2185) + lu(k,2220) = lu(k,2220) - lu(k,894) * lu(k,2185) + lu(k,2224) = lu(k,2224) - lu(k,895) * lu(k,2185) + lu(k,897) = 1._r8 / lu(k,897) + lu(k,898) = lu(k,898) * lu(k,897) + lu(k,899) = lu(k,899) * lu(k,897) + lu(k,900) = lu(k,900) * lu(k,897) + lu(k,901) = lu(k,901) * lu(k,897) + lu(k,902) = lu(k,902) * lu(k,897) + lu(k,1272) = lu(k,1272) - lu(k,898) * lu(k,1271) + lu(k,1277) = lu(k,1277) - lu(k,899) * lu(k,1271) + lu(k,1279) = lu(k,1279) - lu(k,900) * lu(k,1271) + lu(k,1281) = - lu(k,901) * lu(k,1271) + lu(k,1284) = - lu(k,902) * lu(k,1271) + lu(k,1693) = lu(k,1693) - lu(k,898) * lu(k,1686) + lu(k,1704) = lu(k,1704) - lu(k,899) * lu(k,1686) + lu(k,1707) = lu(k,1707) - lu(k,900) * lu(k,1686) + lu(k,1711) = lu(k,1711) - lu(k,901) * lu(k,1686) + lu(k,1714) = lu(k,1714) - lu(k,902) * lu(k,1686) + lu(k,1901) = lu(k,1901) - lu(k,898) * lu(k,1874) + lu(k,1917) = lu(k,1917) - lu(k,899) * lu(k,1874) + lu(k,1920) = lu(k,1920) - lu(k,900) * lu(k,1874) + lu(k,1924) = lu(k,1924) - lu(k,901) * lu(k,1874) + lu(k,1927) = lu(k,1927) - lu(k,902) * lu(k,1874) + lu(k,1935) = lu(k,1935) - lu(k,898) * lu(k,1933) + lu(k,1943) = lu(k,1943) - lu(k,899) * lu(k,1933) + lu(k,1946) = lu(k,1946) - lu(k,900) * lu(k,1933) + lu(k,1950) = lu(k,1950) - lu(k,901) * lu(k,1933) + lu(k,1953) = lu(k,1953) - lu(k,902) * lu(k,1933) + lu(k,1986) = lu(k,1986) - lu(k,898) * lu(k,1983) + lu(k,1996) = lu(k,1996) - lu(k,899) * lu(k,1983) + lu(k,1999) = lu(k,1999) - lu(k,900) * lu(k,1983) + lu(k,2003) = lu(k,2003) - lu(k,901) * lu(k,1983) + lu(k,2006) = lu(k,2006) - lu(k,902) * lu(k,1983) + lu(k,2062) = - lu(k,898) * lu(k,2040) + lu(k,2077) = lu(k,2077) - lu(k,899) * lu(k,2040) + lu(k,2080) = lu(k,2080) - lu(k,900) * lu(k,2040) + lu(k,2084) = lu(k,2084) - lu(k,901) * lu(k,2040) + lu(k,2087) = - lu(k,902) * lu(k,2040) + lu(k,2093) = lu(k,2093) - lu(k,898) * lu(k,2092) + lu(k,2101) = lu(k,2101) - lu(k,899) * lu(k,2092) + lu(k,2104) = lu(k,2104) - lu(k,900) * lu(k,2092) + lu(k,2108) = lu(k,2108) - lu(k,901) * lu(k,2092) + lu(k,2111) = lu(k,2111) - lu(k,902) * lu(k,2092) + lu(k,2305) = lu(k,2305) - lu(k,898) * lu(k,2285) + lu(k,2320) = lu(k,2320) - lu(k,899) * lu(k,2285) + lu(k,2323) = lu(k,2323) - lu(k,900) * lu(k,2285) + lu(k,2327) = lu(k,2327) - lu(k,901) * lu(k,2285) + lu(k,2330) = lu(k,2330) - lu(k,902) * lu(k,2285) + lu(k,2336) = - lu(k,898) * lu(k,2334) + lu(k,2346) = lu(k,2346) - lu(k,899) * lu(k,2334) + lu(k,2349) = lu(k,2349) - lu(k,900) * lu(k,2334) + lu(k,2353) = - lu(k,901) * lu(k,2334) + lu(k,2356) = lu(k,2356) - lu(k,902) * lu(k,2334) + lu(k,903) = 1._r8 / lu(k,903) + lu(k,904) = lu(k,904) * lu(k,903) + lu(k,905) = lu(k,905) * lu(k,903) + lu(k,906) = lu(k,906) * lu(k,903) + lu(k,907) = lu(k,907) * lu(k,903) + lu(k,908) = lu(k,908) * lu(k,903) + lu(k,909) = lu(k,909) * lu(k,903) + lu(k,910) = lu(k,910) * lu(k,903) + lu(k,911) = lu(k,911) * lu(k,903) + lu(k,1084) = lu(k,1084) - lu(k,904) * lu(k,1083) + lu(k,1086) = lu(k,1086) - lu(k,905) * lu(k,1083) + lu(k,1087) = lu(k,1087) - lu(k,906) * lu(k,1083) + lu(k,1090) = - lu(k,907) * lu(k,1083) + lu(k,1091) = - lu(k,908) * lu(k,1083) + lu(k,1092) = lu(k,1092) - lu(k,909) * lu(k,1083) + lu(k,1093) = lu(k,1093) - lu(k,910) * lu(k,1083) + lu(k,1096) = lu(k,1096) - lu(k,911) * lu(k,1083) + lu(k,1320) = lu(k,1320) - lu(k,904) * lu(k,1319) + lu(k,1321) = lu(k,1321) - lu(k,905) * lu(k,1319) + lu(k,1327) = lu(k,1327) - lu(k,906) * lu(k,1319) + lu(k,1334) = lu(k,1334) - lu(k,907) * lu(k,1319) + lu(k,1335) = lu(k,1335) - lu(k,908) * lu(k,1319) + lu(k,1336) = lu(k,1336) - lu(k,909) * lu(k,1319) + lu(k,1337) = lu(k,1337) - lu(k,910) * lu(k,1319) + lu(k,1341) = lu(k,1341) - lu(k,911) * lu(k,1319) + lu(k,1577) = lu(k,1577) - lu(k,904) * lu(k,1573) + lu(k,1584) = lu(k,1584) - lu(k,905) * lu(k,1573) + lu(k,1593) = lu(k,1593) - lu(k,906) * lu(k,1573) + lu(k,1604) = lu(k,1604) - lu(k,907) * lu(k,1573) + lu(k,1605) = lu(k,1605) - lu(k,908) * lu(k,1573) + lu(k,1606) = lu(k,1606) - lu(k,909) * lu(k,1573) + lu(k,1608) = lu(k,1608) - lu(k,910) * lu(k,1573) + lu(k,1615) = lu(k,1615) - lu(k,911) * lu(k,1573) + lu(k,1689) = lu(k,1689) - lu(k,904) * lu(k,1687) + lu(k,1690) = lu(k,1690) - lu(k,905) * lu(k,1687) + lu(k,1692) = lu(k,1692) - lu(k,906) * lu(k,1687) + lu(k,1700) = lu(k,1700) - lu(k,907) * lu(k,1687) + lu(k,1701) = lu(k,1701) - lu(k,908) * lu(k,1687) + lu(k,1702) = lu(k,1702) - lu(k,909) * lu(k,1687) + lu(k,1704) = lu(k,1704) - lu(k,910) * lu(k,1687) + lu(k,1711) = lu(k,1711) - lu(k,911) * lu(k,1687) + lu(k,1881) = lu(k,1881) - lu(k,904) * lu(k,1875) + lu(k,1891) = lu(k,1891) - lu(k,905) * lu(k,1875) + lu(k,1900) = lu(k,1900) - lu(k,906) * lu(k,1875) + lu(k,1913) = lu(k,1913) - lu(k,907) * lu(k,1875) + lu(k,1914) = lu(k,1914) - lu(k,908) * lu(k,1875) + lu(k,1915) = lu(k,1915) - lu(k,909) * lu(k,1875) + lu(k,1917) = lu(k,1917) - lu(k,910) * lu(k,1875) + lu(k,1924) = lu(k,1924) - lu(k,911) * lu(k,1875) + lu(k,2190) = lu(k,2190) - lu(k,904) * lu(k,2186) + lu(k,2196) = lu(k,2196) - lu(k,905) * lu(k,2186) + lu(k,2204) = lu(k,2204) - lu(k,906) * lu(k,2186) + lu(k,2216) = lu(k,2216) - lu(k,907) * lu(k,2186) + lu(k,2217) = lu(k,2217) - lu(k,908) * lu(k,2186) + lu(k,2218) = lu(k,2218) - lu(k,909) * lu(k,2186) + lu(k,2220) = lu(k,2220) - lu(k,910) * lu(k,2186) + lu(k,2227) = lu(k,2227) - lu(k,911) * lu(k,2186) + lu(k,913) = 1._r8 / lu(k,913) + lu(k,914) = lu(k,914) * lu(k,913) + lu(k,915) = lu(k,915) * lu(k,913) + lu(k,916) = lu(k,916) * lu(k,913) + lu(k,917) = lu(k,917) * lu(k,913) + lu(k,918) = lu(k,918) * lu(k,913) + lu(k,919) = lu(k,919) * lu(k,913) + lu(k,920) = lu(k,920) * lu(k,913) + lu(k,921) = lu(k,921) * lu(k,913) + lu(k,1441) = lu(k,1441) - lu(k,914) * lu(k,1440) + lu(k,1442) = - lu(k,915) * lu(k,1440) + lu(k,1443) = - lu(k,916) * lu(k,1440) + lu(k,1444) = lu(k,1444) - lu(k,917) * lu(k,1440) + lu(k,1445) = - lu(k,918) * lu(k,1440) + lu(k,1447) = lu(k,1447) - lu(k,919) * lu(k,1440) + lu(k,1450) = - lu(k,920) * lu(k,1440) + lu(k,1452) = lu(k,1452) - lu(k,921) * lu(k,1440) + lu(k,1469) = lu(k,1469) - lu(k,914) * lu(k,1467) + lu(k,1470) = lu(k,1470) - lu(k,915) * lu(k,1467) + lu(k,1471) = - lu(k,916) * lu(k,1467) + lu(k,1472) = lu(k,1472) - lu(k,917) * lu(k,1467) + lu(k,1473) = lu(k,1473) - lu(k,918) * lu(k,1467) + lu(k,1475) = lu(k,1475) - lu(k,919) * lu(k,1467) + lu(k,1479) = - lu(k,920) * lu(k,1467) + lu(k,1482) = lu(k,1482) - lu(k,921) * lu(k,1467) + lu(k,1485) = - lu(k,914) * lu(k,1484) + lu(k,1486) = - lu(k,915) * lu(k,1484) + lu(k,1487) = lu(k,1487) - lu(k,916) * lu(k,1484) + lu(k,1488) = lu(k,1488) - lu(k,917) * lu(k,1484) + lu(k,1489) = - lu(k,918) * lu(k,1484) + lu(k,1492) = lu(k,1492) - lu(k,919) * lu(k,1484) + lu(k,1496) = lu(k,1496) - lu(k,920) * lu(k,1484) + lu(k,1499) = lu(k,1499) - lu(k,921) * lu(k,1484) + lu(k,1736) = lu(k,1736) - lu(k,914) * lu(k,1735) + lu(k,1738) = lu(k,1738) - lu(k,915) * lu(k,1735) + lu(k,1739) = - lu(k,916) * lu(k,1735) + lu(k,1740) = lu(k,1740) - lu(k,917) * lu(k,1735) + lu(k,1742) = lu(k,1742) - lu(k,918) * lu(k,1735) + lu(k,1745) = lu(k,1745) - lu(k,919) * lu(k,1735) + lu(k,1750) = - lu(k,920) * lu(k,1735) + lu(k,1755) = lu(k,1755) - lu(k,921) * lu(k,1735) + lu(k,1908) = lu(k,1908) - lu(k,914) * lu(k,1876) + lu(k,1910) = lu(k,1910) - lu(k,915) * lu(k,1876) + lu(k,1911) = lu(k,1911) - lu(k,916) * lu(k,1876) + lu(k,1912) = lu(k,1912) - lu(k,917) * lu(k,1876) + lu(k,1914) = lu(k,1914) - lu(k,918) * lu(k,1876) + lu(k,1917) = lu(k,1917) - lu(k,919) * lu(k,1876) + lu(k,1922) = lu(k,1922) - lu(k,920) * lu(k,1876) + lu(k,1927) = lu(k,1927) - lu(k,921) * lu(k,1876) + lu(k,2337) = lu(k,2337) - lu(k,914) * lu(k,2335) + lu(k,2339) = - lu(k,915) * lu(k,2335) + lu(k,2340) = - lu(k,916) * lu(k,2335) + lu(k,2341) = lu(k,2341) - lu(k,917) * lu(k,2335) + lu(k,2343) = - lu(k,918) * lu(k,2335) + lu(k,2346) = lu(k,2346) - lu(k,919) * lu(k,2335) + lu(k,2351) = - lu(k,920) * lu(k,2335) + lu(k,2356) = lu(k,2356) - lu(k,921) * lu(k,2335) end do end subroutine lu_fac19 subroutine lu_fac20( avec_len, lu ) @@ -3455,308 +3189,254 @@ subroutine lu_fac20( avec_len, lu ) lu(k,926) = lu(k,926) * lu(k,924) lu(k,927) = lu(k,927) * lu(k,924) lu(k,928) = lu(k,928) * lu(k,924) - lu(k,933) = lu(k,933) - lu(k,925) * lu(k,931) - lu(k,939) = lu(k,939) - lu(k,926) * lu(k,931) - lu(k,940) = lu(k,940) - lu(k,927) * lu(k,931) - lu(k,941) = lu(k,941) - lu(k,928) * lu(k,931) - lu(k,993) = lu(k,993) - lu(k,925) * lu(k,991) - lu(k,1000) = lu(k,1000) - lu(k,926) * lu(k,991) - lu(k,1001) = lu(k,1001) - lu(k,927) * lu(k,991) - lu(k,1002) = lu(k,1002) - lu(k,928) * lu(k,991) - lu(k,1066) = lu(k,1066) - lu(k,925) * lu(k,1065) - lu(k,1073) = lu(k,1073) - lu(k,926) * lu(k,1065) - lu(k,1074) = lu(k,1074) - lu(k,927) * lu(k,1065) - lu(k,1075) = lu(k,1075) - lu(k,928) * lu(k,1065) - lu(k,1086) = lu(k,1086) - lu(k,925) * lu(k,1085) - lu(k,1096) = lu(k,1096) - lu(k,926) * lu(k,1085) - lu(k,1097) = lu(k,1097) - lu(k,927) * lu(k,1085) - lu(k,1098) = lu(k,1098) - lu(k,928) * lu(k,1085) - lu(k,1145) = - lu(k,925) * lu(k,1143) - lu(k,1160) = lu(k,1160) - lu(k,926) * lu(k,1143) - lu(k,1161) = lu(k,1161) - lu(k,927) * lu(k,1143) - lu(k,1162) = lu(k,1162) - lu(k,928) * lu(k,1143) - lu(k,1192) = lu(k,1192) - lu(k,925) * lu(k,1190) - lu(k,1203) = lu(k,1203) - lu(k,926) * lu(k,1190) - lu(k,1204) = lu(k,1204) - lu(k,927) * lu(k,1190) - lu(k,1205) = lu(k,1205) - lu(k,928) * lu(k,1190) - lu(k,1221) = lu(k,1221) - lu(k,925) * lu(k,1219) - lu(k,1236) = lu(k,1236) - lu(k,926) * lu(k,1219) - lu(k,1237) = lu(k,1237) - lu(k,927) * lu(k,1219) - lu(k,1238) = lu(k,1238) - lu(k,928) * lu(k,1219) - lu(k,1269) = lu(k,1269) - lu(k,925) * lu(k,1268) - lu(k,1284) = lu(k,1284) - lu(k,926) * lu(k,1268) - lu(k,1285) = lu(k,1285) - lu(k,927) * lu(k,1268) - lu(k,1286) = lu(k,1286) - lu(k,928) * lu(k,1268) - lu(k,1375) = lu(k,1375) - lu(k,925) * lu(k,1372) - lu(k,1397) = lu(k,1397) - lu(k,926) * lu(k,1372) - lu(k,1399) = lu(k,1399) - lu(k,927) * lu(k,1372) - lu(k,1400) = lu(k,1400) - lu(k,928) * lu(k,1372) - lu(k,1490) = lu(k,1490) - lu(k,925) * lu(k,1488) - lu(k,1513) = lu(k,1513) - lu(k,926) * lu(k,1488) - lu(k,1515) = lu(k,1515) - lu(k,927) * lu(k,1488) - lu(k,1516) = lu(k,1516) - lu(k,928) * lu(k,1488) - lu(k,1672) = lu(k,1672) - lu(k,925) * lu(k,1669) - lu(k,1696) = lu(k,1696) - lu(k,926) * lu(k,1669) - lu(k,1698) = lu(k,1698) - lu(k,927) * lu(k,1669) - lu(k,1699) = lu(k,1699) - lu(k,928) * lu(k,1669) - lu(k,1794) = lu(k,1794) - lu(k,925) * lu(k,1791) - lu(k,1817) = lu(k,1817) - lu(k,926) * lu(k,1791) - lu(k,1819) = lu(k,1819) - lu(k,927) * lu(k,1791) - lu(k,1820) = lu(k,1820) - lu(k,928) * lu(k,1791) - lu(k,1846) = lu(k,1846) - lu(k,925) * lu(k,1844) - lu(k,1867) = lu(k,1867) - lu(k,926) * lu(k,1844) - lu(k,1869) = lu(k,1869) - lu(k,927) * lu(k,1844) - lu(k,1870) = lu(k,1870) - lu(k,928) * lu(k,1844) - lu(k,1905) = lu(k,1905) - lu(k,925) * lu(k,1903) - lu(k,1927) = lu(k,1927) - lu(k,926) * lu(k,1903) - lu(k,1929) = lu(k,1929) - lu(k,927) * lu(k,1903) - lu(k,1930) = lu(k,1930) - lu(k,928) * lu(k,1903) - lu(k,2032) = lu(k,2032) - lu(k,925) * lu(k,2031) - lu(k,2041) = lu(k,2041) - lu(k,926) * lu(k,2031) - lu(k,2043) = lu(k,2043) - lu(k,927) * lu(k,2031) - lu(k,2044) = lu(k,2044) - lu(k,928) * lu(k,2031) - lu(k,932) = 1._r8 / lu(k,932) - lu(k,933) = lu(k,933) * lu(k,932) - lu(k,934) = lu(k,934) * lu(k,932) - lu(k,935) = lu(k,935) * lu(k,932) - lu(k,936) = lu(k,936) * lu(k,932) - lu(k,937) = lu(k,937) * lu(k,932) - lu(k,938) = lu(k,938) * lu(k,932) - lu(k,939) = lu(k,939) * lu(k,932) - lu(k,940) = lu(k,940) * lu(k,932) - lu(k,941) = lu(k,941) * lu(k,932) - lu(k,942) = lu(k,942) * lu(k,932) - lu(k,943) = lu(k,943) * lu(k,932) - lu(k,944) = lu(k,944) * lu(k,932) - lu(k,1145) = lu(k,1145) - lu(k,933) * lu(k,1144) - lu(k,1146) = lu(k,1146) - lu(k,934) * lu(k,1144) - lu(k,1147) = - lu(k,935) * lu(k,1144) - lu(k,1148) = - lu(k,936) * lu(k,1144) - lu(k,1156) = lu(k,1156) - lu(k,937) * lu(k,1144) - lu(k,1157) = lu(k,1157) - lu(k,938) * lu(k,1144) - lu(k,1160) = lu(k,1160) - lu(k,939) * lu(k,1144) - lu(k,1161) = lu(k,1161) - lu(k,940) * lu(k,1144) - lu(k,1162) = lu(k,1162) - lu(k,941) * lu(k,1144) - lu(k,1163) = lu(k,1163) - lu(k,942) * lu(k,1144) - lu(k,1165) = lu(k,1165) - lu(k,943) * lu(k,1144) - lu(k,1167) = - lu(k,944) * lu(k,1144) - lu(k,1192) = lu(k,1192) - lu(k,933) * lu(k,1191) - lu(k,1193) = lu(k,1193) - lu(k,934) * lu(k,1191) - lu(k,1194) = - lu(k,935) * lu(k,1191) - lu(k,1195) = - lu(k,936) * lu(k,1191) - lu(k,1199) = lu(k,1199) - lu(k,937) * lu(k,1191) - lu(k,1200) = - lu(k,938) * lu(k,1191) - lu(k,1203) = lu(k,1203) - lu(k,939) * lu(k,1191) - lu(k,1204) = lu(k,1204) - lu(k,940) * lu(k,1191) - lu(k,1205) = lu(k,1205) - lu(k,941) * lu(k,1191) - lu(k,1206) = lu(k,1206) - lu(k,942) * lu(k,1191) - lu(k,1208) = lu(k,1208) - lu(k,943) * lu(k,1191) - lu(k,1209) = - lu(k,944) * lu(k,1191) - lu(k,1221) = lu(k,1221) - lu(k,933) * lu(k,1220) - lu(k,1222) = lu(k,1222) - lu(k,934) * lu(k,1220) - lu(k,1223) = - lu(k,935) * lu(k,1220) - lu(k,1224) = - lu(k,936) * lu(k,1220) - lu(k,1232) = lu(k,1232) - lu(k,937) * lu(k,1220) - lu(k,1233) = lu(k,1233) - lu(k,938) * lu(k,1220) - lu(k,1236) = lu(k,1236) - lu(k,939) * lu(k,1220) - lu(k,1237) = lu(k,1237) - lu(k,940) * lu(k,1220) - lu(k,1238) = lu(k,1238) - lu(k,941) * lu(k,1220) - lu(k,1239) = lu(k,1239) - lu(k,942) * lu(k,1220) - lu(k,1241) = lu(k,1241) - lu(k,943) * lu(k,1220) - lu(k,1243) = - lu(k,944) * lu(k,1220) - lu(k,1375) = lu(k,1375) - lu(k,933) * lu(k,1373) - lu(k,1376) = lu(k,1376) - lu(k,934) * lu(k,1373) - lu(k,1380) = lu(k,1380) - lu(k,935) * lu(k,1373) - lu(k,1381) = lu(k,1381) - lu(k,936) * lu(k,1373) - lu(k,1391) = lu(k,1391) - lu(k,937) * lu(k,1373) - lu(k,1393) = lu(k,1393) - lu(k,938) * lu(k,1373) - lu(k,1397) = lu(k,1397) - lu(k,939) * lu(k,1373) - lu(k,1399) = lu(k,1399) - lu(k,940) * lu(k,1373) - lu(k,1400) = lu(k,1400) - lu(k,941) * lu(k,1373) - lu(k,1401) = lu(k,1401) - lu(k,942) * lu(k,1373) - lu(k,1403) = lu(k,1403) - lu(k,943) * lu(k,1373) - lu(k,1409) = lu(k,1409) - lu(k,944) * lu(k,1373) - lu(k,1672) = lu(k,1672) - lu(k,933) * lu(k,1670) - lu(k,1673) = lu(k,1673) - lu(k,934) * lu(k,1670) - lu(k,1677) = lu(k,1677) - lu(k,935) * lu(k,1670) - lu(k,1678) = lu(k,1678) - lu(k,936) * lu(k,1670) - lu(k,1690) = lu(k,1690) - lu(k,937) * lu(k,1670) - lu(k,1692) = lu(k,1692) - lu(k,938) * lu(k,1670) - lu(k,1696) = lu(k,1696) - lu(k,939) * lu(k,1670) - lu(k,1698) = lu(k,1698) - lu(k,940) * lu(k,1670) - lu(k,1699) = lu(k,1699) - lu(k,941) * lu(k,1670) - lu(k,1700) = lu(k,1700) - lu(k,942) * lu(k,1670) - lu(k,1702) = lu(k,1702) - lu(k,943) * lu(k,1670) - lu(k,1708) = lu(k,1708) - lu(k,944) * lu(k,1670) - lu(k,1794) = lu(k,1794) - lu(k,933) * lu(k,1792) - lu(k,1795) = lu(k,1795) - lu(k,934) * lu(k,1792) - lu(k,1799) = lu(k,1799) - lu(k,935) * lu(k,1792) - lu(k,1800) = lu(k,1800) - lu(k,936) * lu(k,1792) - lu(k,1811) = lu(k,1811) - lu(k,937) * lu(k,1792) - lu(k,1813) = lu(k,1813) - lu(k,938) * lu(k,1792) - lu(k,1817) = lu(k,1817) - lu(k,939) * lu(k,1792) - lu(k,1819) = lu(k,1819) - lu(k,940) * lu(k,1792) - lu(k,1820) = lu(k,1820) - lu(k,941) * lu(k,1792) - lu(k,1821) = lu(k,1821) - lu(k,942) * lu(k,1792) - lu(k,1823) = lu(k,1823) - lu(k,943) * lu(k,1792) - lu(k,1829) = lu(k,1829) - lu(k,944) * lu(k,1792) - lu(k,946) = 1._r8 / lu(k,946) - lu(k,947) = lu(k,947) * lu(k,946) - lu(k,948) = lu(k,948) * lu(k,946) - lu(k,949) = lu(k,949) * lu(k,946) - lu(k,950) = lu(k,950) * lu(k,946) - lu(k,951) = lu(k,951) * lu(k,946) - lu(k,952) = lu(k,952) * lu(k,946) - lu(k,953) = lu(k,953) * lu(k,946) - lu(k,954) = lu(k,954) * lu(k,946) - lu(k,971) = lu(k,971) - lu(k,947) * lu(k,970) - lu(k,975) = lu(k,975) - lu(k,948) * lu(k,970) - lu(k,976) = lu(k,976) - lu(k,949) * lu(k,970) - lu(k,980) = lu(k,980) - lu(k,950) * lu(k,970) - lu(k,981) = lu(k,981) - lu(k,951) * lu(k,970) - lu(k,982) = lu(k,982) - lu(k,952) * lu(k,970) - lu(k,985) = lu(k,985) - lu(k,953) * lu(k,970) - lu(k,986) = lu(k,986) - lu(k,954) * lu(k,970) - lu(k,993) = lu(k,993) - lu(k,947) * lu(k,992) - lu(k,995) = lu(k,995) - lu(k,948) * lu(k,992) - lu(k,996) = lu(k,996) - lu(k,949) * lu(k,992) - lu(k,1000) = lu(k,1000) - lu(k,950) * lu(k,992) - lu(k,1001) = lu(k,1001) - lu(k,951) * lu(k,992) - lu(k,1002) = lu(k,1002) - lu(k,952) * lu(k,992) - lu(k,1004) = lu(k,1004) - lu(k,953) * lu(k,992) - lu(k,1005) = lu(k,1005) - lu(k,954) * lu(k,992) - lu(k,1011) = lu(k,1011) - lu(k,947) * lu(k,1010) - lu(k,1014) = - lu(k,948) * lu(k,1010) - lu(k,1015) = - lu(k,949) * lu(k,1010) - lu(k,1019) = lu(k,1019) - lu(k,950) * lu(k,1010) - lu(k,1020) = lu(k,1020) - lu(k,951) * lu(k,1010) - lu(k,1021) = lu(k,1021) - lu(k,952) * lu(k,1010) - lu(k,1024) = lu(k,1024) - lu(k,953) * lu(k,1010) - lu(k,1025) = - lu(k,954) * lu(k,1010) - lu(k,1375) = lu(k,1375) - lu(k,947) * lu(k,1374) - lu(k,1380) = lu(k,1380) - lu(k,948) * lu(k,1374) - lu(k,1391) = lu(k,1391) - lu(k,949) * lu(k,1374) - lu(k,1397) = lu(k,1397) - lu(k,950) * lu(k,1374) - lu(k,1399) = lu(k,1399) - lu(k,951) * lu(k,1374) - lu(k,1400) = lu(k,1400) - lu(k,952) * lu(k,1374) - lu(k,1403) = lu(k,1403) - lu(k,953) * lu(k,1374) - lu(k,1409) = lu(k,1409) - lu(k,954) * lu(k,1374) - lu(k,1490) = lu(k,1490) - lu(k,947) * lu(k,1489) - lu(k,1495) = lu(k,1495) - lu(k,948) * lu(k,1489) - lu(k,1507) = lu(k,1507) - lu(k,949) * lu(k,1489) - lu(k,1513) = lu(k,1513) - lu(k,950) * lu(k,1489) - lu(k,1515) = lu(k,1515) - lu(k,951) * lu(k,1489) - lu(k,1516) = lu(k,1516) - lu(k,952) * lu(k,1489) - lu(k,1519) = lu(k,1519) - lu(k,953) * lu(k,1489) - lu(k,1525) = lu(k,1525) - lu(k,954) * lu(k,1489) - lu(k,1672) = lu(k,1672) - lu(k,947) * lu(k,1671) - lu(k,1677) = lu(k,1677) - lu(k,948) * lu(k,1671) - lu(k,1690) = lu(k,1690) - lu(k,949) * lu(k,1671) - lu(k,1696) = lu(k,1696) - lu(k,950) * lu(k,1671) - lu(k,1698) = lu(k,1698) - lu(k,951) * lu(k,1671) - lu(k,1699) = lu(k,1699) - lu(k,952) * lu(k,1671) - lu(k,1702) = lu(k,1702) - lu(k,953) * lu(k,1671) - lu(k,1708) = lu(k,1708) - lu(k,954) * lu(k,1671) - lu(k,1794) = lu(k,1794) - lu(k,947) * lu(k,1793) - lu(k,1799) = lu(k,1799) - lu(k,948) * lu(k,1793) - lu(k,1811) = lu(k,1811) - lu(k,949) * lu(k,1793) - lu(k,1817) = lu(k,1817) - lu(k,950) * lu(k,1793) - lu(k,1819) = lu(k,1819) - lu(k,951) * lu(k,1793) - lu(k,1820) = lu(k,1820) - lu(k,952) * lu(k,1793) - lu(k,1823) = lu(k,1823) - lu(k,953) * lu(k,1793) - lu(k,1829) = lu(k,1829) - lu(k,954) * lu(k,1793) - lu(k,1846) = lu(k,1846) - lu(k,947) * lu(k,1845) - lu(k,1851) = lu(k,1851) - lu(k,948) * lu(k,1845) - lu(k,1862) = lu(k,1862) - lu(k,949) * lu(k,1845) - lu(k,1867) = lu(k,1867) - lu(k,950) * lu(k,1845) - lu(k,1869) = lu(k,1869) - lu(k,951) * lu(k,1845) - lu(k,1870) = lu(k,1870) - lu(k,952) * lu(k,1845) - lu(k,1873) = lu(k,1873) - lu(k,953) * lu(k,1845) - lu(k,1879) = lu(k,1879) - lu(k,954) * lu(k,1845) - lu(k,1905) = lu(k,1905) - lu(k,947) * lu(k,1904) - lu(k,1910) = lu(k,1910) - lu(k,948) * lu(k,1904) - lu(k,1921) = lu(k,1921) - lu(k,949) * lu(k,1904) - lu(k,1927) = lu(k,1927) - lu(k,950) * lu(k,1904) - lu(k,1929) = lu(k,1929) - lu(k,951) * lu(k,1904) - lu(k,1930) = lu(k,1930) - lu(k,952) * lu(k,1904) - lu(k,1933) = lu(k,1933) - lu(k,953) * lu(k,1904) - lu(k,1939) = lu(k,1939) - lu(k,954) * lu(k,1904) - lu(k,955) = 1._r8 / lu(k,955) - lu(k,956) = lu(k,956) * lu(k,955) - lu(k,957) = lu(k,957) * lu(k,955) - lu(k,958) = lu(k,958) * lu(k,955) - lu(k,978) = - lu(k,956) * lu(k,971) - lu(k,980) = lu(k,980) - lu(k,957) * lu(k,971) - lu(k,981) = lu(k,981) - lu(k,958) * lu(k,971) - lu(k,998) = - lu(k,956) * lu(k,993) - lu(k,1000) = lu(k,1000) - lu(k,957) * lu(k,993) - lu(k,1001) = lu(k,1001) - lu(k,958) * lu(k,993) - lu(k,1017) = - lu(k,956) * lu(k,1011) - lu(k,1019) = lu(k,1019) - lu(k,957) * lu(k,1011) - lu(k,1020) = lu(k,1020) - lu(k,958) * lu(k,1011) - lu(k,1043) = - lu(k,956) * lu(k,1039) - lu(k,1044) = lu(k,1044) - lu(k,957) * lu(k,1039) - lu(k,1045) = lu(k,1045) - lu(k,958) * lu(k,1039) - lu(k,1071) = - lu(k,956) * lu(k,1066) - lu(k,1073) = lu(k,1073) - lu(k,957) * lu(k,1066) - lu(k,1074) = lu(k,1074) - lu(k,958) * lu(k,1066) - lu(k,1094) = - lu(k,956) * lu(k,1086) - lu(k,1096) = lu(k,1096) - lu(k,957) * lu(k,1086) - lu(k,1097) = lu(k,1097) - lu(k,958) * lu(k,1086) - lu(k,1109) = - lu(k,956) * lu(k,1103) - lu(k,1110) = lu(k,1110) - lu(k,957) * lu(k,1103) - lu(k,1111) = lu(k,1111) - lu(k,958) * lu(k,1103) - lu(k,1119) = - lu(k,956) * lu(k,1115) - lu(k,1120) = lu(k,1120) - lu(k,957) * lu(k,1115) - lu(k,1121) = lu(k,1121) - lu(k,958) * lu(k,1115) - lu(k,1158) = - lu(k,956) * lu(k,1145) - lu(k,1160) = lu(k,1160) - lu(k,957) * lu(k,1145) - lu(k,1161) = lu(k,1161) - lu(k,958) * lu(k,1145) - lu(k,1178) = - lu(k,956) * lu(k,1170) - lu(k,1180) = lu(k,1180) - lu(k,957) * lu(k,1170) - lu(k,1181) = lu(k,1181) - lu(k,958) * lu(k,1170) - lu(k,1201) = - lu(k,956) * lu(k,1192) - lu(k,1203) = lu(k,1203) - lu(k,957) * lu(k,1192) - lu(k,1204) = lu(k,1204) - lu(k,958) * lu(k,1192) - lu(k,1234) = - lu(k,956) * lu(k,1221) - lu(k,1236) = lu(k,1236) - lu(k,957) * lu(k,1221) - lu(k,1237) = lu(k,1237) - lu(k,958) * lu(k,1221) - lu(k,1282) = - lu(k,956) * lu(k,1269) - lu(k,1284) = lu(k,1284) - lu(k,957) * lu(k,1269) - lu(k,1285) = lu(k,1285) - lu(k,958) * lu(k,1269) - lu(k,1295) = lu(k,1295) - lu(k,956) * lu(k,1293) - lu(k,1296) = lu(k,1296) - lu(k,957) * lu(k,1293) - lu(k,1298) = lu(k,1298) - lu(k,958) * lu(k,1293) - lu(k,1394) = lu(k,1394) - lu(k,956) * lu(k,1375) - lu(k,1397) = lu(k,1397) - lu(k,957) * lu(k,1375) - lu(k,1399) = lu(k,1399) - lu(k,958) * lu(k,1375) - lu(k,1510) = lu(k,1510) - lu(k,956) * lu(k,1490) - lu(k,1513) = lu(k,1513) - lu(k,957) * lu(k,1490) - lu(k,1515) = lu(k,1515) - lu(k,958) * lu(k,1490) - lu(k,1693) = lu(k,1693) - lu(k,956) * lu(k,1672) - lu(k,1696) = lu(k,1696) - lu(k,957) * lu(k,1672) - lu(k,1698) = lu(k,1698) - lu(k,958) * lu(k,1672) - lu(k,1716) = lu(k,1716) - lu(k,956) * lu(k,1712) - lu(k,1719) = lu(k,1719) - lu(k,957) * lu(k,1712) - lu(k,1721) = lu(k,1721) - lu(k,958) * lu(k,1712) - lu(k,1757) = lu(k,1757) - lu(k,956) * lu(k,1749) - lu(k,1760) = lu(k,1760) - lu(k,957) * lu(k,1749) - lu(k,1762) = lu(k,1762) - lu(k,958) * lu(k,1749) - lu(k,1814) = - lu(k,956) * lu(k,1794) - lu(k,1817) = lu(k,1817) - lu(k,957) * lu(k,1794) - lu(k,1819) = lu(k,1819) - lu(k,958) * lu(k,1794) - lu(k,1864) = lu(k,1864) - lu(k,956) * lu(k,1846) - lu(k,1867) = lu(k,1867) - lu(k,957) * lu(k,1846) - lu(k,1869) = lu(k,1869) - lu(k,958) * lu(k,1846) - lu(k,1924) = lu(k,1924) - lu(k,956) * lu(k,1905) - lu(k,1927) = lu(k,1927) - lu(k,957) * lu(k,1905) - lu(k,1929) = lu(k,1929) - lu(k,958) * lu(k,1905) - lu(k,2004) = lu(k,2004) - lu(k,956) * lu(k,1999) - lu(k,2007) = lu(k,2007) - lu(k,957) * lu(k,1999) - lu(k,2009) = lu(k,2009) - lu(k,958) * lu(k,1999) - lu(k,2038) = lu(k,2038) - lu(k,956) * lu(k,2032) - lu(k,2041) = lu(k,2041) - lu(k,957) * lu(k,2032) - lu(k,2043) = lu(k,2043) - lu(k,958) * lu(k,2032) + lu(k,929) = lu(k,929) * lu(k,924) + lu(k,930) = lu(k,930) * lu(k,924) + lu(k,931) = lu(k,931) * lu(k,924) + lu(k,932) = lu(k,932) * lu(k,924) + lu(k,933) = lu(k,933) * lu(k,924) + lu(k,1698) = lu(k,1698) - lu(k,925) * lu(k,1688) + lu(k,1702) = lu(k,1702) - lu(k,926) * lu(k,1688) + lu(k,1704) = lu(k,1704) - lu(k,927) * lu(k,1688) + lu(k,1705) = lu(k,1705) - lu(k,928) * lu(k,1688) + lu(k,1706) = lu(k,1706) - lu(k,929) * lu(k,1688) + lu(k,1707) = lu(k,1707) - lu(k,930) * lu(k,1688) + lu(k,1709) = lu(k,1709) - lu(k,931) * lu(k,1688) + lu(k,1712) = lu(k,1712) - lu(k,932) * lu(k,1688) + lu(k,1714) = lu(k,1714) - lu(k,933) * lu(k,1688) + lu(k,1911) = lu(k,1911) - lu(k,925) * lu(k,1877) + lu(k,1915) = lu(k,1915) - lu(k,926) * lu(k,1877) + lu(k,1917) = lu(k,1917) - lu(k,927) * lu(k,1877) + lu(k,1918) = lu(k,1918) - lu(k,928) * lu(k,1877) + lu(k,1919) = lu(k,1919) - lu(k,929) * lu(k,1877) + lu(k,1920) = lu(k,1920) - lu(k,930) * lu(k,1877) + lu(k,1922) = lu(k,1922) - lu(k,931) * lu(k,1877) + lu(k,1925) = lu(k,1925) - lu(k,932) * lu(k,1877) + lu(k,1927) = lu(k,1927) - lu(k,933) * lu(k,1877) + lu(k,1937) = - lu(k,925) * lu(k,1934) + lu(k,1941) = lu(k,1941) - lu(k,926) * lu(k,1934) + lu(k,1943) = lu(k,1943) - lu(k,927) * lu(k,1934) + lu(k,1944) = lu(k,1944) - lu(k,928) * lu(k,1934) + lu(k,1945) = lu(k,1945) - lu(k,929) * lu(k,1934) + lu(k,1946) = lu(k,1946) - lu(k,930) * lu(k,1934) + lu(k,1948) = - lu(k,931) * lu(k,1934) + lu(k,1951) = lu(k,1951) - lu(k,932) * lu(k,1934) + lu(k,1953) = lu(k,1953) - lu(k,933) * lu(k,1934) + lu(k,1960) = lu(k,1960) - lu(k,925) * lu(k,1958) + lu(k,1963) = - lu(k,926) * lu(k,1958) + lu(k,1965) = lu(k,1965) - lu(k,927) * lu(k,1958) + lu(k,1966) = lu(k,1966) - lu(k,928) * lu(k,1958) + lu(k,1967) = lu(k,1967) - lu(k,929) * lu(k,1958) + lu(k,1968) = lu(k,1968) - lu(k,930) * lu(k,1958) + lu(k,1970) = - lu(k,931) * lu(k,1958) + lu(k,1973) = lu(k,1973) - lu(k,932) * lu(k,1958) + lu(k,1975) = lu(k,1975) - lu(k,933) * lu(k,1958) + lu(k,1990) = lu(k,1990) - lu(k,925) * lu(k,1984) + lu(k,1994) = lu(k,1994) - lu(k,926) * lu(k,1984) + lu(k,1996) = lu(k,1996) - lu(k,927) * lu(k,1984) + lu(k,1997) = lu(k,1997) - lu(k,928) * lu(k,1984) + lu(k,1998) = lu(k,1998) - lu(k,929) * lu(k,1984) + lu(k,1999) = lu(k,1999) - lu(k,930) * lu(k,1984) + lu(k,2001) = lu(k,2001) - lu(k,931) * lu(k,1984) + lu(k,2004) = lu(k,2004) - lu(k,932) * lu(k,1984) + lu(k,2006) = lu(k,2006) - lu(k,933) * lu(k,1984) + lu(k,2253) = - lu(k,925) * lu(k,2243) + lu(k,2257) = lu(k,2257) - lu(k,926) * lu(k,2243) + lu(k,2259) = lu(k,2259) - lu(k,927) * lu(k,2243) + lu(k,2260) = lu(k,2260) - lu(k,928) * lu(k,2243) + lu(k,2261) = lu(k,2261) - lu(k,929) * lu(k,2243) + lu(k,2262) = lu(k,2262) - lu(k,930) * lu(k,2243) + lu(k,2264) = lu(k,2264) - lu(k,931) * lu(k,2243) + lu(k,2267) = lu(k,2267) - lu(k,932) * lu(k,2243) + lu(k,2269) = lu(k,2269) - lu(k,933) * lu(k,2243) + lu(k,939) = 1._r8 / lu(k,939) + lu(k,940) = lu(k,940) * lu(k,939) + lu(k,941) = lu(k,941) * lu(k,939) + lu(k,942) = lu(k,942) * lu(k,939) + lu(k,943) = lu(k,943) * lu(k,939) + lu(k,944) = lu(k,944) * lu(k,939) + lu(k,945) = lu(k,945) * lu(k,939) + lu(k,946) = lu(k,946) * lu(k,939) + lu(k,947) = lu(k,947) * lu(k,939) + lu(k,948) = lu(k,948) * lu(k,939) + lu(k,986) = lu(k,986) - lu(k,940) * lu(k,984) + lu(k,993) = - lu(k,941) * lu(k,984) + lu(k,997) = lu(k,997) - lu(k,942) * lu(k,984) + lu(k,999) = - lu(k,943) * lu(k,984) + lu(k,1000) = - lu(k,944) * lu(k,984) + lu(k,1001) = - lu(k,945) * lu(k,984) + lu(k,1002) = lu(k,1002) - lu(k,946) * lu(k,984) + lu(k,1004) = lu(k,1004) - lu(k,947) * lu(k,984) + lu(k,1006) = lu(k,1006) - lu(k,948) * lu(k,984) + lu(k,1035) = lu(k,1035) - lu(k,940) * lu(k,1033) + lu(k,1042) = - lu(k,941) * lu(k,1033) + lu(k,1047) = lu(k,1047) - lu(k,942) * lu(k,1033) + lu(k,1049) = - lu(k,943) * lu(k,1033) + lu(k,1050) = - lu(k,944) * lu(k,1033) + lu(k,1051) = - lu(k,945) * lu(k,1033) + lu(k,1052) = lu(k,1052) - lu(k,946) * lu(k,1033) + lu(k,1054) = lu(k,1054) - lu(k,947) * lu(k,1033) + lu(k,1056) = lu(k,1056) - lu(k,948) * lu(k,1033) + lu(k,1576) = lu(k,1576) - lu(k,940) * lu(k,1574) + lu(k,1583) = lu(k,1583) - lu(k,941) * lu(k,1574) + lu(k,1599) = lu(k,1599) - lu(k,942) * lu(k,1574) + lu(k,1604) = lu(k,1604) - lu(k,943) * lu(k,1574) + lu(k,1605) = lu(k,1605) - lu(k,944) * lu(k,1574) + lu(k,1606) = lu(k,1606) - lu(k,945) * lu(k,1574) + lu(k,1608) = lu(k,1608) - lu(k,946) * lu(k,1574) + lu(k,1612) = lu(k,1612) - lu(k,947) * lu(k,1574) + lu(k,1615) = lu(k,1615) - lu(k,948) * lu(k,1574) + lu(k,1880) = lu(k,1880) - lu(k,940) * lu(k,1878) + lu(k,1890) = lu(k,1890) - lu(k,941) * lu(k,1878) + lu(k,1907) = lu(k,1907) - lu(k,942) * lu(k,1878) + lu(k,1913) = lu(k,1913) - lu(k,943) * lu(k,1878) + lu(k,1914) = lu(k,1914) - lu(k,944) * lu(k,1878) + lu(k,1915) = lu(k,1915) - lu(k,945) * lu(k,1878) + lu(k,1917) = lu(k,1917) - lu(k,946) * lu(k,1878) + lu(k,1921) = lu(k,1921) - lu(k,947) * lu(k,1878) + lu(k,1924) = lu(k,1924) - lu(k,948) * lu(k,1878) + lu(k,2189) = lu(k,2189) - lu(k,940) * lu(k,2187) + lu(k,2195) = lu(k,2195) - lu(k,941) * lu(k,2187) + lu(k,2210) = lu(k,2210) - lu(k,942) * lu(k,2187) + lu(k,2216) = lu(k,2216) - lu(k,943) * lu(k,2187) + lu(k,2217) = lu(k,2217) - lu(k,944) * lu(k,2187) + lu(k,2218) = lu(k,2218) - lu(k,945) * lu(k,2187) + lu(k,2220) = lu(k,2220) - lu(k,946) * lu(k,2187) + lu(k,2224) = lu(k,2224) - lu(k,947) * lu(k,2187) + lu(k,2227) = lu(k,2227) - lu(k,948) * lu(k,2187) + lu(k,2287) = lu(k,2287) - lu(k,940) * lu(k,2286) + lu(k,2296) = lu(k,2296) - lu(k,941) * lu(k,2286) + lu(k,2311) = lu(k,2311) - lu(k,942) * lu(k,2286) + lu(k,2316) = lu(k,2316) - lu(k,943) * lu(k,2286) + lu(k,2317) = lu(k,2317) - lu(k,944) * lu(k,2286) + lu(k,2318) = lu(k,2318) - lu(k,945) * lu(k,2286) + lu(k,2320) = lu(k,2320) - lu(k,946) * lu(k,2286) + lu(k,2324) = lu(k,2324) - lu(k,947) * lu(k,2286) + lu(k,2327) = lu(k,2327) - lu(k,948) * lu(k,2286) + lu(k,952) = 1._r8 / lu(k,952) + lu(k,953) = lu(k,953) * lu(k,952) + lu(k,954) = lu(k,954) * lu(k,952) + lu(k,955) = lu(k,955) * lu(k,952) + lu(k,956) = lu(k,956) * lu(k,952) + lu(k,957) = lu(k,957) * lu(k,952) + lu(k,958) = lu(k,958) * lu(k,952) + lu(k,959) = lu(k,959) * lu(k,952) + lu(k,960) = lu(k,960) * lu(k,952) + lu(k,961) = lu(k,961) * lu(k,952) + lu(k,986) = lu(k,986) - lu(k,953) * lu(k,985) + lu(k,990) = lu(k,990) - lu(k,954) * lu(k,985) + lu(k,998) = - lu(k,955) * lu(k,985) + lu(k,999) = lu(k,999) - lu(k,956) * lu(k,985) + lu(k,1000) = lu(k,1000) - lu(k,957) * lu(k,985) + lu(k,1001) = lu(k,1001) - lu(k,958) * lu(k,985) + lu(k,1002) = lu(k,1002) - lu(k,959) * lu(k,985) + lu(k,1004) = lu(k,1004) - lu(k,960) * lu(k,985) + lu(k,1006) = lu(k,1006) - lu(k,961) * lu(k,985) + lu(k,1035) = lu(k,1035) - lu(k,953) * lu(k,1034) + lu(k,1038) = lu(k,1038) - lu(k,954) * lu(k,1034) + lu(k,1048) = - lu(k,955) * lu(k,1034) + lu(k,1049) = lu(k,1049) - lu(k,956) * lu(k,1034) + lu(k,1050) = lu(k,1050) - lu(k,957) * lu(k,1034) + lu(k,1051) = lu(k,1051) - lu(k,958) * lu(k,1034) + lu(k,1052) = lu(k,1052) - lu(k,959) * lu(k,1034) + lu(k,1054) = lu(k,1054) - lu(k,960) * lu(k,1034) + lu(k,1056) = lu(k,1056) - lu(k,961) * lu(k,1034) + lu(k,1576) = lu(k,1576) - lu(k,953) * lu(k,1575) + lu(k,1579) = lu(k,1579) - lu(k,954) * lu(k,1575) + lu(k,1602) = lu(k,1602) - lu(k,955) * lu(k,1575) + lu(k,1604) = lu(k,1604) - lu(k,956) * lu(k,1575) + lu(k,1605) = lu(k,1605) - lu(k,957) * lu(k,1575) + lu(k,1606) = lu(k,1606) - lu(k,958) * lu(k,1575) + lu(k,1608) = lu(k,1608) - lu(k,959) * lu(k,1575) + lu(k,1612) = lu(k,1612) - lu(k,960) * lu(k,1575) + lu(k,1615) = lu(k,1615) - lu(k,961) * lu(k,1575) + lu(k,1631) = lu(k,1631) - lu(k,953) * lu(k,1630) + lu(k,1633) = lu(k,1633) - lu(k,954) * lu(k,1630) + lu(k,1654) = lu(k,1654) - lu(k,955) * lu(k,1630) + lu(k,1656) = lu(k,1656) - lu(k,956) * lu(k,1630) + lu(k,1657) = lu(k,1657) - lu(k,957) * lu(k,1630) + lu(k,1658) = lu(k,1658) - lu(k,958) * lu(k,1630) + lu(k,1660) = lu(k,1660) - lu(k,959) * lu(k,1630) + lu(k,1664) = lu(k,1664) - lu(k,960) * lu(k,1630) + lu(k,1667) = lu(k,1667) - lu(k,961) * lu(k,1630) + lu(k,1880) = lu(k,1880) - lu(k,953) * lu(k,1879) + lu(k,1884) = lu(k,1884) - lu(k,954) * lu(k,1879) + lu(k,1911) = lu(k,1911) - lu(k,955) * lu(k,1879) + lu(k,1913) = lu(k,1913) - lu(k,956) * lu(k,1879) + lu(k,1914) = lu(k,1914) - lu(k,957) * lu(k,1879) + lu(k,1915) = lu(k,1915) - lu(k,958) * lu(k,1879) + lu(k,1917) = lu(k,1917) - lu(k,959) * lu(k,1879) + lu(k,1921) = lu(k,1921) - lu(k,960) * lu(k,1879) + lu(k,1924) = lu(k,1924) - lu(k,961) * lu(k,1879) + lu(k,2189) = lu(k,2189) - lu(k,953) * lu(k,2188) + lu(k,2192) = lu(k,2192) - lu(k,954) * lu(k,2188) + lu(k,2214) = lu(k,2214) - lu(k,955) * lu(k,2188) + lu(k,2216) = lu(k,2216) - lu(k,956) * lu(k,2188) + lu(k,2217) = lu(k,2217) - lu(k,957) * lu(k,2188) + lu(k,2218) = lu(k,2218) - lu(k,958) * lu(k,2188) + lu(k,2220) = lu(k,2220) - lu(k,959) * lu(k,2188) + lu(k,2224) = lu(k,2224) - lu(k,960) * lu(k,2188) + lu(k,2227) = lu(k,2227) - lu(k,961) * lu(k,2188) + lu(k,962) = 1._r8 / lu(k,962) + lu(k,963) = lu(k,963) * lu(k,962) + lu(k,964) = lu(k,964) * lu(k,962) + lu(k,965) = lu(k,965) * lu(k,962) + lu(k,966) = lu(k,966) * lu(k,962) + lu(k,967) = lu(k,967) * lu(k,962) + lu(k,995) = lu(k,995) - lu(k,963) * lu(k,986) + lu(k,997) = lu(k,997) - lu(k,964) * lu(k,986) + lu(k,1000) = lu(k,1000) - lu(k,965) * lu(k,986) + lu(k,1002) = lu(k,1002) - lu(k,966) * lu(k,986) + lu(k,1008) = - lu(k,967) * lu(k,986) + lu(k,1045) = lu(k,1045) - lu(k,963) * lu(k,1035) + lu(k,1047) = lu(k,1047) - lu(k,964) * lu(k,1035) + lu(k,1050) = lu(k,1050) - lu(k,965) * lu(k,1035) + lu(k,1052) = lu(k,1052) - lu(k,966) * lu(k,1035) + lu(k,1058) = - lu(k,967) * lu(k,1035) + lu(k,1117) = lu(k,1117) - lu(k,963) * lu(k,1114) + lu(k,1118) = lu(k,1118) - lu(k,964) * lu(k,1114) + lu(k,1119) = - lu(k,965) * lu(k,1114) + lu(k,1120) = lu(k,1120) - lu(k,966) * lu(k,1114) + lu(k,1124) = - lu(k,967) * lu(k,1114) + lu(k,1156) = - lu(k,963) * lu(k,1151) + lu(k,1157) = - lu(k,964) * lu(k,1151) + lu(k,1160) = lu(k,1160) - lu(k,965) * lu(k,1151) + lu(k,1162) = lu(k,1162) - lu(k,966) * lu(k,1151) + lu(k,1166) = - lu(k,967) * lu(k,1151) + lu(k,1191) = - lu(k,963) * lu(k,1187) + lu(k,1195) = lu(k,1195) - lu(k,964) * lu(k,1187) + lu(k,1198) = - lu(k,965) * lu(k,1187) + lu(k,1200) = lu(k,1200) - lu(k,966) * lu(k,1187) + lu(k,1205) = - lu(k,967) * lu(k,1187) + lu(k,1587) = lu(k,1587) - lu(k,963) * lu(k,1576) + lu(k,1599) = lu(k,1599) - lu(k,964) * lu(k,1576) + lu(k,1605) = lu(k,1605) - lu(k,965) * lu(k,1576) + lu(k,1608) = lu(k,1608) - lu(k,966) * lu(k,1576) + lu(k,1618) = lu(k,1618) - lu(k,967) * lu(k,1576) + lu(k,1641) = lu(k,1641) - lu(k,963) * lu(k,1631) + lu(k,1652) = lu(k,1652) - lu(k,964) * lu(k,1631) + lu(k,1657) = lu(k,1657) - lu(k,965) * lu(k,1631) + lu(k,1660) = lu(k,1660) - lu(k,966) * lu(k,1631) + lu(k,1670) = lu(k,1670) - lu(k,967) * lu(k,1631) + lu(k,1894) = lu(k,1894) - lu(k,963) * lu(k,1880) + lu(k,1907) = lu(k,1907) - lu(k,964) * lu(k,1880) + lu(k,1914) = lu(k,1914) - lu(k,965) * lu(k,1880) + lu(k,1917) = lu(k,1917) - lu(k,966) * lu(k,1880) + lu(k,1927) = lu(k,1927) - lu(k,967) * lu(k,1880) + lu(k,2055) = - lu(k,963) * lu(k,2041) + lu(k,2068) = lu(k,2068) - lu(k,964) * lu(k,2041) + lu(k,2074) = lu(k,2074) - lu(k,965) * lu(k,2041) + lu(k,2077) = lu(k,2077) - lu(k,966) * lu(k,2041) + lu(k,2087) = lu(k,2087) - lu(k,967) * lu(k,2041) + lu(k,2199) = lu(k,2199) - lu(k,963) * lu(k,2189) + lu(k,2210) = lu(k,2210) - lu(k,964) * lu(k,2189) + lu(k,2217) = lu(k,2217) - lu(k,965) * lu(k,2189) + lu(k,2220) = lu(k,2220) - lu(k,966) * lu(k,2189) + lu(k,2230) = lu(k,2230) - lu(k,967) * lu(k,2189) + lu(k,2300) = lu(k,2300) - lu(k,963) * lu(k,2287) + lu(k,2311) = lu(k,2311) - lu(k,964) * lu(k,2287) + lu(k,2317) = lu(k,2317) - lu(k,965) * lu(k,2287) + lu(k,2320) = lu(k,2320) - lu(k,966) * lu(k,2287) + lu(k,2330) = lu(k,2330) - lu(k,967) * lu(k,2287) end do end subroutine lu_fac20 subroutine lu_fac21( avec_len, lu ) @@ -3773,451 +3453,277 @@ subroutine lu_fac21( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,959) = 1._r8 / lu(k,959) - lu(k,960) = lu(k,960) * lu(k,959) - lu(k,961) = lu(k,961) * lu(k,959) - lu(k,962) = lu(k,962) * lu(k,959) - lu(k,963) = lu(k,963) * lu(k,959) - lu(k,964) = lu(k,964) * lu(k,959) - lu(k,1030) = lu(k,1030) - lu(k,960) * lu(k,1028) - lu(k,1031) = lu(k,1031) - lu(k,961) * lu(k,1028) - lu(k,1033) = lu(k,1033) - lu(k,962) * lu(k,1028) - lu(k,1034) = lu(k,1034) - lu(k,963) * lu(k,1028) - lu(k,1035) = lu(k,1035) - lu(k,964) * lu(k,1028) - lu(k,1069) = lu(k,1069) - lu(k,960) * lu(k,1067) - lu(k,1070) = lu(k,1070) - lu(k,961) * lu(k,1067) - lu(k,1073) = lu(k,1073) - lu(k,962) * lu(k,1067) - lu(k,1074) = lu(k,1074) - lu(k,963) * lu(k,1067) - lu(k,1075) = lu(k,1075) - lu(k,964) * lu(k,1067) - lu(k,1151) = - lu(k,960) * lu(k,1146) - lu(k,1156) = lu(k,1156) - lu(k,961) * lu(k,1146) - lu(k,1160) = lu(k,1160) - lu(k,962) * lu(k,1146) - lu(k,1161) = lu(k,1161) - lu(k,963) * lu(k,1146) - lu(k,1162) = lu(k,1162) - lu(k,964) * lu(k,1146) - lu(k,1173) = lu(k,1173) - lu(k,960) * lu(k,1171) - lu(k,1176) = lu(k,1176) - lu(k,961) * lu(k,1171) - lu(k,1180) = lu(k,1180) - lu(k,962) * lu(k,1171) - lu(k,1181) = lu(k,1181) - lu(k,963) * lu(k,1171) - lu(k,1182) = lu(k,1182) - lu(k,964) * lu(k,1171) - lu(k,1196) = lu(k,1196) - lu(k,960) * lu(k,1193) - lu(k,1199) = lu(k,1199) - lu(k,961) * lu(k,1193) - lu(k,1203) = lu(k,1203) - lu(k,962) * lu(k,1193) - lu(k,1204) = lu(k,1204) - lu(k,963) * lu(k,1193) - lu(k,1205) = lu(k,1205) - lu(k,964) * lu(k,1193) - lu(k,1227) = lu(k,1227) - lu(k,960) * lu(k,1222) - lu(k,1232) = lu(k,1232) - lu(k,961) * lu(k,1222) - lu(k,1236) = lu(k,1236) - lu(k,962) * lu(k,1222) - lu(k,1237) = lu(k,1237) - lu(k,963) * lu(k,1222) - lu(k,1238) = lu(k,1238) - lu(k,964) * lu(k,1222) - lu(k,1248) = - lu(k,960) * lu(k,1247) - lu(k,1250) = lu(k,1250) - lu(k,961) * lu(k,1247) - lu(k,1254) = lu(k,1254) - lu(k,962) * lu(k,1247) - lu(k,1255) = lu(k,1255) - lu(k,963) * lu(k,1247) - lu(k,1256) = lu(k,1256) - lu(k,964) * lu(k,1247) - lu(k,1274) = lu(k,1274) - lu(k,960) * lu(k,1270) - lu(k,1280) = lu(k,1280) - lu(k,961) * lu(k,1270) - lu(k,1284) = lu(k,1284) - lu(k,962) * lu(k,1270) - lu(k,1285) = lu(k,1285) - lu(k,963) * lu(k,1270) - lu(k,1286) = lu(k,1286) - lu(k,964) * lu(k,1270) - lu(k,1385) = lu(k,1385) - lu(k,960) * lu(k,1376) - lu(k,1391) = lu(k,1391) - lu(k,961) * lu(k,1376) - lu(k,1397) = lu(k,1397) - lu(k,962) * lu(k,1376) - lu(k,1399) = lu(k,1399) - lu(k,963) * lu(k,1376) - lu(k,1400) = lu(k,1400) - lu(k,964) * lu(k,1376) - lu(k,1501) = lu(k,1501) - lu(k,960) * lu(k,1491) - lu(k,1507) = lu(k,1507) - lu(k,961) * lu(k,1491) - lu(k,1513) = lu(k,1513) - lu(k,962) * lu(k,1491) - lu(k,1515) = lu(k,1515) - lu(k,963) * lu(k,1491) - lu(k,1516) = lu(k,1516) - lu(k,964) * lu(k,1491) - lu(k,1683) = lu(k,1683) - lu(k,960) * lu(k,1673) - lu(k,1690) = lu(k,1690) - lu(k,961) * lu(k,1673) - lu(k,1696) = lu(k,1696) - lu(k,962) * lu(k,1673) - lu(k,1698) = lu(k,1698) - lu(k,963) * lu(k,1673) - lu(k,1699) = lu(k,1699) - lu(k,964) * lu(k,1673) - lu(k,1751) = lu(k,1751) - lu(k,960) * lu(k,1750) - lu(k,1754) = lu(k,1754) - lu(k,961) * lu(k,1750) - lu(k,1760) = lu(k,1760) - lu(k,962) * lu(k,1750) - lu(k,1762) = lu(k,1762) - lu(k,963) * lu(k,1750) - lu(k,1763) = lu(k,1763) - lu(k,964) * lu(k,1750) - lu(k,1804) = lu(k,1804) - lu(k,960) * lu(k,1795) - lu(k,1811) = lu(k,1811) - lu(k,961) * lu(k,1795) - lu(k,1817) = lu(k,1817) - lu(k,962) * lu(k,1795) - lu(k,1819) = lu(k,1819) - lu(k,963) * lu(k,1795) - lu(k,1820) = lu(k,1820) - lu(k,964) * lu(k,1795) - lu(k,1856) = lu(k,1856) - lu(k,960) * lu(k,1847) - lu(k,1862) = lu(k,1862) - lu(k,961) * lu(k,1847) - lu(k,1867) = lu(k,1867) - lu(k,962) * lu(k,1847) - lu(k,1869) = lu(k,1869) - lu(k,963) * lu(k,1847) - lu(k,1870) = lu(k,1870) - lu(k,964) * lu(k,1847) - lu(k,1914) = lu(k,1914) - lu(k,960) * lu(k,1906) - lu(k,1921) = lu(k,1921) - lu(k,961) * lu(k,1906) - lu(k,1927) = lu(k,1927) - lu(k,962) * lu(k,1906) - lu(k,1929) = lu(k,1929) - lu(k,963) * lu(k,1906) - lu(k,1930) = lu(k,1930) - lu(k,964) * lu(k,1906) - lu(k,972) = 1._r8 / lu(k,972) - lu(k,973) = lu(k,973) * lu(k,972) - lu(k,974) = lu(k,974) * lu(k,972) - lu(k,975) = lu(k,975) * lu(k,972) - lu(k,976) = lu(k,976) * lu(k,972) - lu(k,977) = lu(k,977) * lu(k,972) - lu(k,978) = lu(k,978) * lu(k,972) - lu(k,979) = lu(k,979) * lu(k,972) - lu(k,980) = lu(k,980) * lu(k,972) - lu(k,981) = lu(k,981) * lu(k,972) - lu(k,982) = lu(k,982) * lu(k,972) - lu(k,983) = lu(k,983) * lu(k,972) - lu(k,984) = lu(k,984) * lu(k,972) - lu(k,985) = lu(k,985) * lu(k,972) - lu(k,986) = lu(k,986) * lu(k,972) - lu(k,1378) = lu(k,1378) - lu(k,973) * lu(k,1377) - lu(k,1379) = lu(k,1379) - lu(k,974) * lu(k,1377) - lu(k,1380) = lu(k,1380) - lu(k,975) * lu(k,1377) - lu(k,1391) = lu(k,1391) - lu(k,976) * lu(k,1377) - lu(k,1393) = lu(k,1393) - lu(k,977) * lu(k,1377) - lu(k,1394) = lu(k,1394) - lu(k,978) * lu(k,1377) - lu(k,1395) = lu(k,1395) - lu(k,979) * lu(k,1377) - lu(k,1397) = lu(k,1397) - lu(k,980) * lu(k,1377) - lu(k,1399) = lu(k,1399) - lu(k,981) * lu(k,1377) - lu(k,1400) = lu(k,1400) - lu(k,982) * lu(k,1377) - lu(k,1401) = lu(k,1401) - lu(k,983) * lu(k,1377) - lu(k,1402) = lu(k,1402) - lu(k,984) * lu(k,1377) - lu(k,1403) = lu(k,1403) - lu(k,985) * lu(k,1377) - lu(k,1409) = lu(k,1409) - lu(k,986) * lu(k,1377) - lu(k,1493) = lu(k,1493) - lu(k,973) * lu(k,1492) - lu(k,1494) = lu(k,1494) - lu(k,974) * lu(k,1492) - lu(k,1495) = lu(k,1495) - lu(k,975) * lu(k,1492) - lu(k,1507) = lu(k,1507) - lu(k,976) * lu(k,1492) - lu(k,1509) = lu(k,1509) - lu(k,977) * lu(k,1492) - lu(k,1510) = lu(k,1510) - lu(k,978) * lu(k,1492) - lu(k,1511) = lu(k,1511) - lu(k,979) * lu(k,1492) - lu(k,1513) = lu(k,1513) - lu(k,980) * lu(k,1492) - lu(k,1515) = lu(k,1515) - lu(k,981) * lu(k,1492) - lu(k,1516) = lu(k,1516) - lu(k,982) * lu(k,1492) - lu(k,1517) = lu(k,1517) - lu(k,983) * lu(k,1492) - lu(k,1518) = lu(k,1518) - lu(k,984) * lu(k,1492) - lu(k,1519) = lu(k,1519) - lu(k,985) * lu(k,1492) - lu(k,1525) = lu(k,1525) - lu(k,986) * lu(k,1492) - lu(k,1675) = lu(k,1675) - lu(k,973) * lu(k,1674) - lu(k,1676) = lu(k,1676) - lu(k,974) * lu(k,1674) - lu(k,1677) = lu(k,1677) - lu(k,975) * lu(k,1674) - lu(k,1690) = lu(k,1690) - lu(k,976) * lu(k,1674) - lu(k,1692) = lu(k,1692) - lu(k,977) * lu(k,1674) - lu(k,1693) = lu(k,1693) - lu(k,978) * lu(k,1674) - lu(k,1694) = lu(k,1694) - lu(k,979) * lu(k,1674) - lu(k,1696) = lu(k,1696) - lu(k,980) * lu(k,1674) - lu(k,1698) = lu(k,1698) - lu(k,981) * lu(k,1674) - lu(k,1699) = lu(k,1699) - lu(k,982) * lu(k,1674) - lu(k,1700) = lu(k,1700) - lu(k,983) * lu(k,1674) - lu(k,1701) = lu(k,1701) - lu(k,984) * lu(k,1674) - lu(k,1702) = lu(k,1702) - lu(k,985) * lu(k,1674) - lu(k,1708) = lu(k,1708) - lu(k,986) * lu(k,1674) - lu(k,1797) = lu(k,1797) - lu(k,973) * lu(k,1796) - lu(k,1798) = lu(k,1798) - lu(k,974) * lu(k,1796) - lu(k,1799) = lu(k,1799) - lu(k,975) * lu(k,1796) - lu(k,1811) = lu(k,1811) - lu(k,976) * lu(k,1796) - lu(k,1813) = lu(k,1813) - lu(k,977) * lu(k,1796) - lu(k,1814) = lu(k,1814) - lu(k,978) * lu(k,1796) - lu(k,1815) = lu(k,1815) - lu(k,979) * lu(k,1796) - lu(k,1817) = lu(k,1817) - lu(k,980) * lu(k,1796) - lu(k,1819) = lu(k,1819) - lu(k,981) * lu(k,1796) - lu(k,1820) = lu(k,1820) - lu(k,982) * lu(k,1796) - lu(k,1821) = lu(k,1821) - lu(k,983) * lu(k,1796) - lu(k,1822) = lu(k,1822) - lu(k,984) * lu(k,1796) - lu(k,1823) = lu(k,1823) - lu(k,985) * lu(k,1796) - lu(k,1829) = lu(k,1829) - lu(k,986) * lu(k,1796) - lu(k,1849) = lu(k,1849) - lu(k,973) * lu(k,1848) - lu(k,1850) = lu(k,1850) - lu(k,974) * lu(k,1848) - lu(k,1851) = lu(k,1851) - lu(k,975) * lu(k,1848) - lu(k,1862) = lu(k,1862) - lu(k,976) * lu(k,1848) - lu(k,1863) = lu(k,1863) - lu(k,977) * lu(k,1848) - lu(k,1864) = lu(k,1864) - lu(k,978) * lu(k,1848) - lu(k,1865) = lu(k,1865) - lu(k,979) * lu(k,1848) - lu(k,1867) = lu(k,1867) - lu(k,980) * lu(k,1848) - lu(k,1869) = lu(k,1869) - lu(k,981) * lu(k,1848) - lu(k,1870) = lu(k,1870) - lu(k,982) * lu(k,1848) - lu(k,1871) = lu(k,1871) - lu(k,983) * lu(k,1848) - lu(k,1872) = lu(k,1872) - lu(k,984) * lu(k,1848) - lu(k,1873) = lu(k,1873) - lu(k,985) * lu(k,1848) - lu(k,1879) = lu(k,1879) - lu(k,986) * lu(k,1848) - lu(k,1908) = lu(k,1908) - lu(k,973) * lu(k,1907) - lu(k,1909) = lu(k,1909) - lu(k,974) * lu(k,1907) - lu(k,1910) = lu(k,1910) - lu(k,975) * lu(k,1907) - lu(k,1921) = lu(k,1921) - lu(k,976) * lu(k,1907) - lu(k,1923) = - lu(k,977) * lu(k,1907) - lu(k,1924) = lu(k,1924) - lu(k,978) * lu(k,1907) - lu(k,1925) = lu(k,1925) - lu(k,979) * lu(k,1907) - lu(k,1927) = lu(k,1927) - lu(k,980) * lu(k,1907) - lu(k,1929) = lu(k,1929) - lu(k,981) * lu(k,1907) - lu(k,1930) = lu(k,1930) - lu(k,982) * lu(k,1907) - lu(k,1931) = lu(k,1931) - lu(k,983) * lu(k,1907) - lu(k,1932) = lu(k,1932) - lu(k,984) * lu(k,1907) - lu(k,1933) = lu(k,1933) - lu(k,985) * lu(k,1907) - lu(k,1939) = lu(k,1939) - lu(k,986) * lu(k,1907) - lu(k,994) = 1._r8 / lu(k,994) - lu(k,995) = lu(k,995) * lu(k,994) - lu(k,996) = lu(k,996) * lu(k,994) - lu(k,997) = lu(k,997) * lu(k,994) - lu(k,998) = lu(k,998) * lu(k,994) - lu(k,999) = lu(k,999) * lu(k,994) - lu(k,1000) = lu(k,1000) * lu(k,994) - lu(k,1001) = lu(k,1001) * lu(k,994) - lu(k,1002) = lu(k,1002) * lu(k,994) - lu(k,1003) = lu(k,1003) * lu(k,994) - lu(k,1004) = lu(k,1004) * lu(k,994) - lu(k,1005) = lu(k,1005) * lu(k,994) - lu(k,1014) = lu(k,1014) - lu(k,995) * lu(k,1012) - lu(k,1015) = lu(k,1015) - lu(k,996) * lu(k,1012) - lu(k,1016) = lu(k,1016) - lu(k,997) * lu(k,1012) - lu(k,1017) = lu(k,1017) - lu(k,998) * lu(k,1012) - lu(k,1018) = lu(k,1018) - lu(k,999) * lu(k,1012) - lu(k,1019) = lu(k,1019) - lu(k,1000) * lu(k,1012) - lu(k,1020) = lu(k,1020) - lu(k,1001) * lu(k,1012) - lu(k,1021) = lu(k,1021) - lu(k,1002) * lu(k,1012) - lu(k,1022) = lu(k,1022) - lu(k,1003) * lu(k,1012) - lu(k,1024) = lu(k,1024) - lu(k,1004) * lu(k,1012) - lu(k,1025) = lu(k,1025) - lu(k,1005) * lu(k,1012) - lu(k,1380) = lu(k,1380) - lu(k,995) * lu(k,1378) - lu(k,1391) = lu(k,1391) - lu(k,996) * lu(k,1378) - lu(k,1393) = lu(k,1393) - lu(k,997) * lu(k,1378) - lu(k,1394) = lu(k,1394) - lu(k,998) * lu(k,1378) - lu(k,1395) = lu(k,1395) - lu(k,999) * lu(k,1378) - lu(k,1397) = lu(k,1397) - lu(k,1000) * lu(k,1378) - lu(k,1399) = lu(k,1399) - lu(k,1001) * lu(k,1378) - lu(k,1400) = lu(k,1400) - lu(k,1002) * lu(k,1378) - lu(k,1401) = lu(k,1401) - lu(k,1003) * lu(k,1378) - lu(k,1403) = lu(k,1403) - lu(k,1004) * lu(k,1378) - lu(k,1409) = lu(k,1409) - lu(k,1005) * lu(k,1378) - lu(k,1495) = lu(k,1495) - lu(k,995) * lu(k,1493) - lu(k,1507) = lu(k,1507) - lu(k,996) * lu(k,1493) - lu(k,1509) = lu(k,1509) - lu(k,997) * lu(k,1493) - lu(k,1510) = lu(k,1510) - lu(k,998) * lu(k,1493) - lu(k,1511) = lu(k,1511) - lu(k,999) * lu(k,1493) - lu(k,1513) = lu(k,1513) - lu(k,1000) * lu(k,1493) - lu(k,1515) = lu(k,1515) - lu(k,1001) * lu(k,1493) - lu(k,1516) = lu(k,1516) - lu(k,1002) * lu(k,1493) - lu(k,1517) = lu(k,1517) - lu(k,1003) * lu(k,1493) - lu(k,1519) = lu(k,1519) - lu(k,1004) * lu(k,1493) - lu(k,1525) = lu(k,1525) - lu(k,1005) * lu(k,1493) - lu(k,1677) = lu(k,1677) - lu(k,995) * lu(k,1675) - lu(k,1690) = lu(k,1690) - lu(k,996) * lu(k,1675) - lu(k,1692) = lu(k,1692) - lu(k,997) * lu(k,1675) - lu(k,1693) = lu(k,1693) - lu(k,998) * lu(k,1675) - lu(k,1694) = lu(k,1694) - lu(k,999) * lu(k,1675) - lu(k,1696) = lu(k,1696) - lu(k,1000) * lu(k,1675) - lu(k,1698) = lu(k,1698) - lu(k,1001) * lu(k,1675) - lu(k,1699) = lu(k,1699) - lu(k,1002) * lu(k,1675) - lu(k,1700) = lu(k,1700) - lu(k,1003) * lu(k,1675) - lu(k,1702) = lu(k,1702) - lu(k,1004) * lu(k,1675) - lu(k,1708) = lu(k,1708) - lu(k,1005) * lu(k,1675) - lu(k,1799) = lu(k,1799) - lu(k,995) * lu(k,1797) - lu(k,1811) = lu(k,1811) - lu(k,996) * lu(k,1797) - lu(k,1813) = lu(k,1813) - lu(k,997) * lu(k,1797) - lu(k,1814) = lu(k,1814) - lu(k,998) * lu(k,1797) - lu(k,1815) = lu(k,1815) - lu(k,999) * lu(k,1797) - lu(k,1817) = lu(k,1817) - lu(k,1000) * lu(k,1797) - lu(k,1819) = lu(k,1819) - lu(k,1001) * lu(k,1797) - lu(k,1820) = lu(k,1820) - lu(k,1002) * lu(k,1797) - lu(k,1821) = lu(k,1821) - lu(k,1003) * lu(k,1797) - lu(k,1823) = lu(k,1823) - lu(k,1004) * lu(k,1797) - lu(k,1829) = lu(k,1829) - lu(k,1005) * lu(k,1797) - lu(k,1851) = lu(k,1851) - lu(k,995) * lu(k,1849) - lu(k,1862) = lu(k,1862) - lu(k,996) * lu(k,1849) - lu(k,1863) = lu(k,1863) - lu(k,997) * lu(k,1849) - lu(k,1864) = lu(k,1864) - lu(k,998) * lu(k,1849) - lu(k,1865) = lu(k,1865) - lu(k,999) * lu(k,1849) - lu(k,1867) = lu(k,1867) - lu(k,1000) * lu(k,1849) - lu(k,1869) = lu(k,1869) - lu(k,1001) * lu(k,1849) - lu(k,1870) = lu(k,1870) - lu(k,1002) * lu(k,1849) - lu(k,1871) = lu(k,1871) - lu(k,1003) * lu(k,1849) - lu(k,1873) = lu(k,1873) - lu(k,1004) * lu(k,1849) - lu(k,1879) = lu(k,1879) - lu(k,1005) * lu(k,1849) - lu(k,1910) = lu(k,1910) - lu(k,995) * lu(k,1908) - lu(k,1921) = lu(k,1921) - lu(k,996) * lu(k,1908) - lu(k,1923) = lu(k,1923) - lu(k,997) * lu(k,1908) - lu(k,1924) = lu(k,1924) - lu(k,998) * lu(k,1908) - lu(k,1925) = lu(k,1925) - lu(k,999) * lu(k,1908) - lu(k,1927) = lu(k,1927) - lu(k,1000) * lu(k,1908) - lu(k,1929) = lu(k,1929) - lu(k,1001) * lu(k,1908) - lu(k,1930) = lu(k,1930) - lu(k,1002) * lu(k,1908) - lu(k,1931) = lu(k,1931) - lu(k,1003) * lu(k,1908) - lu(k,1933) = lu(k,1933) - lu(k,1004) * lu(k,1908) - lu(k,1939) = lu(k,1939) - lu(k,1005) * lu(k,1908) - lu(k,1013) = 1._r8 / lu(k,1013) - lu(k,1014) = lu(k,1014) * lu(k,1013) - lu(k,1015) = lu(k,1015) * lu(k,1013) - lu(k,1016) = lu(k,1016) * lu(k,1013) - lu(k,1017) = lu(k,1017) * lu(k,1013) - lu(k,1018) = lu(k,1018) * lu(k,1013) - lu(k,1019) = lu(k,1019) * lu(k,1013) - lu(k,1020) = lu(k,1020) * lu(k,1013) - lu(k,1021) = lu(k,1021) * lu(k,1013) - lu(k,1022) = lu(k,1022) * lu(k,1013) - lu(k,1023) = lu(k,1023) * lu(k,1013) - lu(k,1024) = lu(k,1024) * lu(k,1013) - lu(k,1025) = lu(k,1025) * lu(k,1013) - lu(k,1380) = lu(k,1380) - lu(k,1014) * lu(k,1379) - lu(k,1391) = lu(k,1391) - lu(k,1015) * lu(k,1379) - lu(k,1393) = lu(k,1393) - lu(k,1016) * lu(k,1379) - lu(k,1394) = lu(k,1394) - lu(k,1017) * lu(k,1379) - lu(k,1395) = lu(k,1395) - lu(k,1018) * lu(k,1379) - lu(k,1397) = lu(k,1397) - lu(k,1019) * lu(k,1379) - lu(k,1399) = lu(k,1399) - lu(k,1020) * lu(k,1379) - lu(k,1400) = lu(k,1400) - lu(k,1021) * lu(k,1379) - lu(k,1401) = lu(k,1401) - lu(k,1022) * lu(k,1379) - lu(k,1402) = lu(k,1402) - lu(k,1023) * lu(k,1379) - lu(k,1403) = lu(k,1403) - lu(k,1024) * lu(k,1379) - lu(k,1409) = lu(k,1409) - lu(k,1025) * lu(k,1379) - lu(k,1495) = lu(k,1495) - lu(k,1014) * lu(k,1494) - lu(k,1507) = lu(k,1507) - lu(k,1015) * lu(k,1494) - lu(k,1509) = lu(k,1509) - lu(k,1016) * lu(k,1494) - lu(k,1510) = lu(k,1510) - lu(k,1017) * lu(k,1494) - lu(k,1511) = lu(k,1511) - lu(k,1018) * lu(k,1494) - lu(k,1513) = lu(k,1513) - lu(k,1019) * lu(k,1494) - lu(k,1515) = lu(k,1515) - lu(k,1020) * lu(k,1494) - lu(k,1516) = lu(k,1516) - lu(k,1021) * lu(k,1494) - lu(k,1517) = lu(k,1517) - lu(k,1022) * lu(k,1494) - lu(k,1518) = lu(k,1518) - lu(k,1023) * lu(k,1494) - lu(k,1519) = lu(k,1519) - lu(k,1024) * lu(k,1494) - lu(k,1525) = lu(k,1525) - lu(k,1025) * lu(k,1494) - lu(k,1677) = lu(k,1677) - lu(k,1014) * lu(k,1676) - lu(k,1690) = lu(k,1690) - lu(k,1015) * lu(k,1676) - lu(k,1692) = lu(k,1692) - lu(k,1016) * lu(k,1676) - lu(k,1693) = lu(k,1693) - lu(k,1017) * lu(k,1676) - lu(k,1694) = lu(k,1694) - lu(k,1018) * lu(k,1676) - lu(k,1696) = lu(k,1696) - lu(k,1019) * lu(k,1676) - lu(k,1698) = lu(k,1698) - lu(k,1020) * lu(k,1676) - lu(k,1699) = lu(k,1699) - lu(k,1021) * lu(k,1676) - lu(k,1700) = lu(k,1700) - lu(k,1022) * lu(k,1676) - lu(k,1701) = lu(k,1701) - lu(k,1023) * lu(k,1676) - lu(k,1702) = lu(k,1702) - lu(k,1024) * lu(k,1676) - lu(k,1708) = lu(k,1708) - lu(k,1025) * lu(k,1676) - lu(k,1799) = lu(k,1799) - lu(k,1014) * lu(k,1798) - lu(k,1811) = lu(k,1811) - lu(k,1015) * lu(k,1798) - lu(k,1813) = lu(k,1813) - lu(k,1016) * lu(k,1798) - lu(k,1814) = lu(k,1814) - lu(k,1017) * lu(k,1798) - lu(k,1815) = lu(k,1815) - lu(k,1018) * lu(k,1798) - lu(k,1817) = lu(k,1817) - lu(k,1019) * lu(k,1798) - lu(k,1819) = lu(k,1819) - lu(k,1020) * lu(k,1798) - lu(k,1820) = lu(k,1820) - lu(k,1021) * lu(k,1798) - lu(k,1821) = lu(k,1821) - lu(k,1022) * lu(k,1798) - lu(k,1822) = lu(k,1822) - lu(k,1023) * lu(k,1798) - lu(k,1823) = lu(k,1823) - lu(k,1024) * lu(k,1798) - lu(k,1829) = lu(k,1829) - lu(k,1025) * lu(k,1798) - lu(k,1851) = lu(k,1851) - lu(k,1014) * lu(k,1850) - lu(k,1862) = lu(k,1862) - lu(k,1015) * lu(k,1850) - lu(k,1863) = lu(k,1863) - lu(k,1016) * lu(k,1850) - lu(k,1864) = lu(k,1864) - lu(k,1017) * lu(k,1850) - lu(k,1865) = lu(k,1865) - lu(k,1018) * lu(k,1850) - lu(k,1867) = lu(k,1867) - lu(k,1019) * lu(k,1850) - lu(k,1869) = lu(k,1869) - lu(k,1020) * lu(k,1850) - lu(k,1870) = lu(k,1870) - lu(k,1021) * lu(k,1850) - lu(k,1871) = lu(k,1871) - lu(k,1022) * lu(k,1850) - lu(k,1872) = lu(k,1872) - lu(k,1023) * lu(k,1850) - lu(k,1873) = lu(k,1873) - lu(k,1024) * lu(k,1850) - lu(k,1879) = lu(k,1879) - lu(k,1025) * lu(k,1850) - lu(k,1910) = lu(k,1910) - lu(k,1014) * lu(k,1909) - lu(k,1921) = lu(k,1921) - lu(k,1015) * lu(k,1909) - lu(k,1923) = lu(k,1923) - lu(k,1016) * lu(k,1909) - lu(k,1924) = lu(k,1924) - lu(k,1017) * lu(k,1909) - lu(k,1925) = lu(k,1925) - lu(k,1018) * lu(k,1909) - lu(k,1927) = lu(k,1927) - lu(k,1019) * lu(k,1909) - lu(k,1929) = lu(k,1929) - lu(k,1020) * lu(k,1909) - lu(k,1930) = lu(k,1930) - lu(k,1021) * lu(k,1909) - lu(k,1931) = lu(k,1931) - lu(k,1022) * lu(k,1909) - lu(k,1932) = lu(k,1932) - lu(k,1023) * lu(k,1909) - lu(k,1933) = lu(k,1933) - lu(k,1024) * lu(k,1909) - lu(k,1939) = lu(k,1939) - lu(k,1025) * lu(k,1909) - lu(k,1029) = 1._r8 / lu(k,1029) - lu(k,1030) = lu(k,1030) * lu(k,1029) - lu(k,1031) = lu(k,1031) * lu(k,1029) - lu(k,1032) = lu(k,1032) * lu(k,1029) - lu(k,1033) = lu(k,1033) * lu(k,1029) - lu(k,1034) = lu(k,1034) * lu(k,1029) - lu(k,1035) = lu(k,1035) * lu(k,1029) - lu(k,1036) = lu(k,1036) * lu(k,1029) - lu(k,1037) = lu(k,1037) * lu(k,1029) - lu(k,1038) = lu(k,1038) * lu(k,1029) - lu(k,1151) = lu(k,1151) - lu(k,1030) * lu(k,1147) - lu(k,1156) = lu(k,1156) - lu(k,1031) * lu(k,1147) - lu(k,1159) = lu(k,1159) - lu(k,1032) * lu(k,1147) - lu(k,1160) = lu(k,1160) - lu(k,1033) * lu(k,1147) - lu(k,1161) = lu(k,1161) - lu(k,1034) * lu(k,1147) - lu(k,1162) = lu(k,1162) - lu(k,1035) * lu(k,1147) - lu(k,1163) = lu(k,1163) - lu(k,1036) * lu(k,1147) - lu(k,1165) = lu(k,1165) - lu(k,1037) * lu(k,1147) - lu(k,1167) = lu(k,1167) - lu(k,1038) * lu(k,1147) - lu(k,1196) = lu(k,1196) - lu(k,1030) * lu(k,1194) - lu(k,1199) = lu(k,1199) - lu(k,1031) * lu(k,1194) - lu(k,1202) = lu(k,1202) - lu(k,1032) * lu(k,1194) - lu(k,1203) = lu(k,1203) - lu(k,1033) * lu(k,1194) - lu(k,1204) = lu(k,1204) - lu(k,1034) * lu(k,1194) - lu(k,1205) = lu(k,1205) - lu(k,1035) * lu(k,1194) - lu(k,1206) = lu(k,1206) - lu(k,1036) * lu(k,1194) - lu(k,1208) = lu(k,1208) - lu(k,1037) * lu(k,1194) - lu(k,1209) = lu(k,1209) - lu(k,1038) * lu(k,1194) - lu(k,1227) = lu(k,1227) - lu(k,1030) * lu(k,1223) - lu(k,1232) = lu(k,1232) - lu(k,1031) * lu(k,1223) - lu(k,1235) = lu(k,1235) - lu(k,1032) * lu(k,1223) - lu(k,1236) = lu(k,1236) - lu(k,1033) * lu(k,1223) - lu(k,1237) = lu(k,1237) - lu(k,1034) * lu(k,1223) - lu(k,1238) = lu(k,1238) - lu(k,1035) * lu(k,1223) - lu(k,1239) = lu(k,1239) - lu(k,1036) * lu(k,1223) - lu(k,1241) = lu(k,1241) - lu(k,1037) * lu(k,1223) - lu(k,1243) = lu(k,1243) - lu(k,1038) * lu(k,1223) - lu(k,1385) = lu(k,1385) - lu(k,1030) * lu(k,1380) - lu(k,1391) = lu(k,1391) - lu(k,1031) * lu(k,1380) - lu(k,1395) = lu(k,1395) - lu(k,1032) * lu(k,1380) - lu(k,1397) = lu(k,1397) - lu(k,1033) * lu(k,1380) - lu(k,1399) = lu(k,1399) - lu(k,1034) * lu(k,1380) - lu(k,1400) = lu(k,1400) - lu(k,1035) * lu(k,1380) - lu(k,1401) = lu(k,1401) - lu(k,1036) * lu(k,1380) - lu(k,1403) = lu(k,1403) - lu(k,1037) * lu(k,1380) - lu(k,1409) = lu(k,1409) - lu(k,1038) * lu(k,1380) - lu(k,1501) = lu(k,1501) - lu(k,1030) * lu(k,1495) - lu(k,1507) = lu(k,1507) - lu(k,1031) * lu(k,1495) - lu(k,1511) = lu(k,1511) - lu(k,1032) * lu(k,1495) - lu(k,1513) = lu(k,1513) - lu(k,1033) * lu(k,1495) - lu(k,1515) = lu(k,1515) - lu(k,1034) * lu(k,1495) - lu(k,1516) = lu(k,1516) - lu(k,1035) * lu(k,1495) - lu(k,1517) = lu(k,1517) - lu(k,1036) * lu(k,1495) - lu(k,1519) = lu(k,1519) - lu(k,1037) * lu(k,1495) - lu(k,1525) = lu(k,1525) - lu(k,1038) * lu(k,1495) - lu(k,1683) = lu(k,1683) - lu(k,1030) * lu(k,1677) - lu(k,1690) = lu(k,1690) - lu(k,1031) * lu(k,1677) - lu(k,1694) = lu(k,1694) - lu(k,1032) * lu(k,1677) - lu(k,1696) = lu(k,1696) - lu(k,1033) * lu(k,1677) - lu(k,1698) = lu(k,1698) - lu(k,1034) * lu(k,1677) - lu(k,1699) = lu(k,1699) - lu(k,1035) * lu(k,1677) - lu(k,1700) = lu(k,1700) - lu(k,1036) * lu(k,1677) - lu(k,1702) = lu(k,1702) - lu(k,1037) * lu(k,1677) - lu(k,1708) = lu(k,1708) - lu(k,1038) * lu(k,1677) - lu(k,1804) = lu(k,1804) - lu(k,1030) * lu(k,1799) - lu(k,1811) = lu(k,1811) - lu(k,1031) * lu(k,1799) - lu(k,1815) = lu(k,1815) - lu(k,1032) * lu(k,1799) - lu(k,1817) = lu(k,1817) - lu(k,1033) * lu(k,1799) - lu(k,1819) = lu(k,1819) - lu(k,1034) * lu(k,1799) - lu(k,1820) = lu(k,1820) - lu(k,1035) * lu(k,1799) - lu(k,1821) = lu(k,1821) - lu(k,1036) * lu(k,1799) - lu(k,1823) = lu(k,1823) - lu(k,1037) * lu(k,1799) - lu(k,1829) = lu(k,1829) - lu(k,1038) * lu(k,1799) - lu(k,1856) = lu(k,1856) - lu(k,1030) * lu(k,1851) - lu(k,1862) = lu(k,1862) - lu(k,1031) * lu(k,1851) - lu(k,1865) = lu(k,1865) - lu(k,1032) * lu(k,1851) - lu(k,1867) = lu(k,1867) - lu(k,1033) * lu(k,1851) - lu(k,1869) = lu(k,1869) - lu(k,1034) * lu(k,1851) - lu(k,1870) = lu(k,1870) - lu(k,1035) * lu(k,1851) - lu(k,1871) = lu(k,1871) - lu(k,1036) * lu(k,1851) - lu(k,1873) = lu(k,1873) - lu(k,1037) * lu(k,1851) - lu(k,1879) = lu(k,1879) - lu(k,1038) * lu(k,1851) - lu(k,1914) = lu(k,1914) - lu(k,1030) * lu(k,1910) - lu(k,1921) = lu(k,1921) - lu(k,1031) * lu(k,1910) - lu(k,1925) = lu(k,1925) - lu(k,1032) * lu(k,1910) - lu(k,1927) = lu(k,1927) - lu(k,1033) * lu(k,1910) - lu(k,1929) = lu(k,1929) - lu(k,1034) * lu(k,1910) - lu(k,1930) = lu(k,1930) - lu(k,1035) * lu(k,1910) - lu(k,1931) = lu(k,1931) - lu(k,1036) * lu(k,1910) - lu(k,1933) = lu(k,1933) - lu(k,1037) * lu(k,1910) - lu(k,1939) = lu(k,1939) - lu(k,1038) * lu(k,1910) + lu(k,970) = 1._r8 / lu(k,970) + lu(k,971) = lu(k,971) * lu(k,970) + lu(k,972) = lu(k,972) * lu(k,970) + lu(k,973) = lu(k,973) * lu(k,970) + lu(k,974) = lu(k,974) * lu(k,970) + lu(k,994) = lu(k,994) - lu(k,971) * lu(k,987) + lu(k,1002) = lu(k,1002) - lu(k,972) * lu(k,987) + lu(k,1003) = lu(k,1003) - lu(k,973) * lu(k,987) + lu(k,1006) = lu(k,1006) - lu(k,974) * lu(k,987) + lu(k,1043) = lu(k,1043) - lu(k,971) * lu(k,1036) + lu(k,1052) = lu(k,1052) - lu(k,972) * lu(k,1036) + lu(k,1053) = lu(k,1053) - lu(k,973) * lu(k,1036) + lu(k,1056) = lu(k,1056) - lu(k,974) * lu(k,1036) + lu(k,1086) = lu(k,1086) - lu(k,971) * lu(k,1084) + lu(k,1093) = lu(k,1093) - lu(k,972) * lu(k,1084) + lu(k,1094) = - lu(k,973) * lu(k,1084) + lu(k,1096) = lu(k,1096) - lu(k,974) * lu(k,1084) + lu(k,1141) = lu(k,1141) - lu(k,971) * lu(k,1140) + lu(k,1143) = lu(k,1143) - lu(k,972) * lu(k,1140) + lu(k,1144) = lu(k,1144) - lu(k,973) * lu(k,1140) + lu(k,1146) = lu(k,1146) - lu(k,974) * lu(k,1140) + lu(k,1210) = lu(k,1210) - lu(k,971) * lu(k,1209) + lu(k,1219) = lu(k,1219) - lu(k,972) * lu(k,1209) + lu(k,1220) = lu(k,1220) - lu(k,973) * lu(k,1209) + lu(k,1223) = lu(k,1223) - lu(k,974) * lu(k,1209) + lu(k,1321) = lu(k,1321) - lu(k,971) * lu(k,1320) + lu(k,1337) = lu(k,1337) - lu(k,972) * lu(k,1320) + lu(k,1338) = - lu(k,973) * lu(k,1320) + lu(k,1341) = lu(k,1341) - lu(k,974) * lu(k,1320) + lu(k,1414) = lu(k,1414) - lu(k,971) * lu(k,1412) + lu(k,1432) = lu(k,1432) - lu(k,972) * lu(k,1412) + lu(k,1433) = lu(k,1433) - lu(k,973) * lu(k,1412) + lu(k,1436) = lu(k,1436) - lu(k,974) * lu(k,1412) + lu(k,1584) = lu(k,1584) - lu(k,971) * lu(k,1577) + lu(k,1608) = lu(k,1608) - lu(k,972) * lu(k,1577) + lu(k,1611) = lu(k,1611) - lu(k,973) * lu(k,1577) + lu(k,1615) = lu(k,1615) - lu(k,974) * lu(k,1577) + lu(k,1638) = lu(k,1638) - lu(k,971) * lu(k,1632) + lu(k,1660) = lu(k,1660) - lu(k,972) * lu(k,1632) + lu(k,1663) = lu(k,1663) - lu(k,973) * lu(k,1632) + lu(k,1667) = lu(k,1667) - lu(k,974) * lu(k,1632) + lu(k,1690) = lu(k,1690) - lu(k,971) * lu(k,1689) + lu(k,1704) = lu(k,1704) - lu(k,972) * lu(k,1689) + lu(k,1707) = lu(k,1707) - lu(k,973) * lu(k,1689) + lu(k,1711) = lu(k,1711) - lu(k,974) * lu(k,1689) + lu(k,1891) = lu(k,1891) - lu(k,971) * lu(k,1881) + lu(k,1917) = lu(k,1917) - lu(k,972) * lu(k,1881) + lu(k,1920) = lu(k,1920) - lu(k,973) * lu(k,1881) + lu(k,1924) = lu(k,1924) - lu(k,974) * lu(k,1881) + lu(k,2052) = lu(k,2052) - lu(k,971) * lu(k,2042) + lu(k,2077) = lu(k,2077) - lu(k,972) * lu(k,2042) + lu(k,2080) = lu(k,2080) - lu(k,973) * lu(k,2042) + lu(k,2084) = lu(k,2084) - lu(k,974) * lu(k,2042) + lu(k,2196) = lu(k,2196) - lu(k,971) * lu(k,2190) + lu(k,2220) = lu(k,2220) - lu(k,972) * lu(k,2190) + lu(k,2223) = lu(k,2223) - lu(k,973) * lu(k,2190) + lu(k,2227) = lu(k,2227) - lu(k,974) * lu(k,2190) + lu(k,2247) = lu(k,2247) - lu(k,971) * lu(k,2244) + lu(k,2259) = lu(k,2259) - lu(k,972) * lu(k,2244) + lu(k,2262) = lu(k,2262) - lu(k,973) * lu(k,2244) + lu(k,2266) = lu(k,2266) - lu(k,974) * lu(k,2244) + lu(k,2297) = lu(k,2297) - lu(k,971) * lu(k,2288) + lu(k,2320) = lu(k,2320) - lu(k,972) * lu(k,2288) + lu(k,2323) = lu(k,2323) - lu(k,973) * lu(k,2288) + lu(k,2327) = lu(k,2327) - lu(k,974) * lu(k,2288) + lu(k,988) = 1._r8 / lu(k,988) + lu(k,989) = lu(k,989) * lu(k,988) + lu(k,990) = lu(k,990) * lu(k,988) + lu(k,991) = lu(k,991) * lu(k,988) + lu(k,992) = lu(k,992) * lu(k,988) + lu(k,993) = lu(k,993) * lu(k,988) + lu(k,994) = lu(k,994) * lu(k,988) + lu(k,995) = lu(k,995) * lu(k,988) + lu(k,996) = lu(k,996) * lu(k,988) + lu(k,997) = lu(k,997) * lu(k,988) + lu(k,998) = lu(k,998) * lu(k,988) + lu(k,999) = lu(k,999) * lu(k,988) + lu(k,1000) = lu(k,1000) * lu(k,988) + lu(k,1001) = lu(k,1001) * lu(k,988) + lu(k,1002) = lu(k,1002) * lu(k,988) + lu(k,1003) = lu(k,1003) * lu(k,988) + lu(k,1004) = lu(k,1004) * lu(k,988) + lu(k,1005) = lu(k,1005) * lu(k,988) + lu(k,1006) = lu(k,1006) * lu(k,988) + lu(k,1007) = lu(k,1007) * lu(k,988) + lu(k,1008) = lu(k,1008) * lu(k,988) + lu(k,1883) = lu(k,1883) - lu(k,989) * lu(k,1882) + lu(k,1884) = lu(k,1884) - lu(k,990) * lu(k,1882) + lu(k,1888) = lu(k,1888) - lu(k,991) * lu(k,1882) + lu(k,1889) = lu(k,1889) - lu(k,992) * lu(k,1882) + lu(k,1890) = lu(k,1890) - lu(k,993) * lu(k,1882) + lu(k,1891) = lu(k,1891) - lu(k,994) * lu(k,1882) + lu(k,1894) = lu(k,1894) - lu(k,995) * lu(k,1882) + lu(k,1900) = lu(k,1900) - lu(k,996) * lu(k,1882) + lu(k,1907) = lu(k,1907) - lu(k,997) * lu(k,1882) + lu(k,1911) = lu(k,1911) - lu(k,998) * lu(k,1882) + lu(k,1913) = lu(k,1913) - lu(k,999) * lu(k,1882) + lu(k,1914) = lu(k,1914) - lu(k,1000) * lu(k,1882) + lu(k,1915) = lu(k,1915) - lu(k,1001) * lu(k,1882) + lu(k,1917) = lu(k,1917) - lu(k,1002) * lu(k,1882) + lu(k,1920) = lu(k,1920) - lu(k,1003) * lu(k,1882) + lu(k,1921) = lu(k,1921) - lu(k,1004) * lu(k,1882) + lu(k,1922) = lu(k,1922) - lu(k,1005) * lu(k,1882) + lu(k,1924) = lu(k,1924) - lu(k,1006) * lu(k,1882) + lu(k,1926) = lu(k,1926) - lu(k,1007) * lu(k,1882) + lu(k,1927) = lu(k,1927) - lu(k,1008) * lu(k,1882) + lu(k,2044) = lu(k,2044) - lu(k,989) * lu(k,2043) + lu(k,2045) = lu(k,2045) - lu(k,990) * lu(k,2043) + lu(k,2049) = lu(k,2049) - lu(k,991) * lu(k,2043) + lu(k,2050) = - lu(k,992) * lu(k,2043) + lu(k,2051) = lu(k,2051) - lu(k,993) * lu(k,2043) + lu(k,2052) = lu(k,2052) - lu(k,994) * lu(k,2043) + lu(k,2055) = lu(k,2055) - lu(k,995) * lu(k,2043) + lu(k,2061) = lu(k,2061) - lu(k,996) * lu(k,2043) + lu(k,2068) = lu(k,2068) - lu(k,997) * lu(k,2043) + lu(k,2071) = lu(k,2071) - lu(k,998) * lu(k,2043) + lu(k,2073) = lu(k,2073) - lu(k,999) * lu(k,2043) + lu(k,2074) = lu(k,2074) - lu(k,1000) * lu(k,2043) + lu(k,2075) = lu(k,2075) - lu(k,1001) * lu(k,2043) + lu(k,2077) = lu(k,2077) - lu(k,1002) * lu(k,2043) + lu(k,2080) = lu(k,2080) - lu(k,1003) * lu(k,2043) + lu(k,2081) = lu(k,2081) - lu(k,1004) * lu(k,2043) + lu(k,2082) = lu(k,2082) - lu(k,1005) * lu(k,2043) + lu(k,2084) = lu(k,2084) - lu(k,1006) * lu(k,2043) + lu(k,2086) = lu(k,2086) - lu(k,1007) * lu(k,2043) + lu(k,2087) = lu(k,2087) - lu(k,1008) * lu(k,2043) + lu(k,2290) = lu(k,2290) - lu(k,989) * lu(k,2289) + lu(k,2291) = lu(k,2291) - lu(k,990) * lu(k,2289) + lu(k,2294) = - lu(k,991) * lu(k,2289) + lu(k,2295) = lu(k,2295) - lu(k,992) * lu(k,2289) + lu(k,2296) = lu(k,2296) - lu(k,993) * lu(k,2289) + lu(k,2297) = lu(k,2297) - lu(k,994) * lu(k,2289) + lu(k,2300) = lu(k,2300) - lu(k,995) * lu(k,2289) + lu(k,2304) = lu(k,2304) - lu(k,996) * lu(k,2289) + lu(k,2311) = lu(k,2311) - lu(k,997) * lu(k,2289) + lu(k,2314) = - lu(k,998) * lu(k,2289) + lu(k,2316) = lu(k,2316) - lu(k,999) * lu(k,2289) + lu(k,2317) = lu(k,2317) - lu(k,1000) * lu(k,2289) + lu(k,2318) = lu(k,2318) - lu(k,1001) * lu(k,2289) + lu(k,2320) = lu(k,2320) - lu(k,1002) * lu(k,2289) + lu(k,2323) = lu(k,2323) - lu(k,1003) * lu(k,2289) + lu(k,2324) = lu(k,2324) - lu(k,1004) * lu(k,2289) + lu(k,2325) = lu(k,2325) - lu(k,1005) * lu(k,2289) + lu(k,2327) = lu(k,2327) - lu(k,1006) * lu(k,2289) + lu(k,2329) = lu(k,2329) - lu(k,1007) * lu(k,2289) + lu(k,2330) = lu(k,2330) - lu(k,1008) * lu(k,2289) + lu(k,1010) = 1._r8 / lu(k,1010) + lu(k,1011) = lu(k,1011) * lu(k,1010) + lu(k,1012) = lu(k,1012) * lu(k,1010) + lu(k,1013) = lu(k,1013) * lu(k,1010) + lu(k,1014) = lu(k,1014) * lu(k,1010) + lu(k,1015) = lu(k,1015) * lu(k,1010) + lu(k,1043) = lu(k,1043) - lu(k,1011) * lu(k,1037) + lu(k,1052) = lu(k,1052) - lu(k,1012) * lu(k,1037) + lu(k,1053) = lu(k,1053) - lu(k,1013) * lu(k,1037) + lu(k,1056) = lu(k,1056) - lu(k,1014) * lu(k,1037) + lu(k,1058) = lu(k,1058) - lu(k,1015) * lu(k,1037) + lu(k,1066) = lu(k,1066) - lu(k,1011) * lu(k,1063) + lu(k,1074) = lu(k,1074) - lu(k,1012) * lu(k,1063) + lu(k,1075) = lu(k,1075) - lu(k,1013) * lu(k,1063) + lu(k,1078) = lu(k,1078) - lu(k,1014) * lu(k,1063) + lu(k,1080) = lu(k,1080) - lu(k,1015) * lu(k,1063) + lu(k,1248) = lu(k,1248) - lu(k,1011) * lu(k,1247) + lu(k,1254) = lu(k,1254) - lu(k,1012) * lu(k,1247) + lu(k,1255) = - lu(k,1013) * lu(k,1247) + lu(k,1257) = lu(k,1257) - lu(k,1014) * lu(k,1247) + lu(k,1259) = lu(k,1259) - lu(k,1015) * lu(k,1247) + lu(k,1368) = lu(k,1368) - lu(k,1011) * lu(k,1365) + lu(k,1380) = lu(k,1380) - lu(k,1012) * lu(k,1365) + lu(k,1381) = lu(k,1381) - lu(k,1013) * lu(k,1365) + lu(k,1384) = lu(k,1384) - lu(k,1014) * lu(k,1365) + lu(k,1386) = - lu(k,1015) * lu(k,1365) + lu(k,1584) = lu(k,1584) - lu(k,1011) * lu(k,1578) + lu(k,1608) = lu(k,1608) - lu(k,1012) * lu(k,1578) + lu(k,1611) = lu(k,1611) - lu(k,1013) * lu(k,1578) + lu(k,1615) = lu(k,1615) - lu(k,1014) * lu(k,1578) + lu(k,1618) = lu(k,1618) - lu(k,1015) * lu(k,1578) + lu(k,1891) = lu(k,1891) - lu(k,1011) * lu(k,1883) + lu(k,1917) = lu(k,1917) - lu(k,1012) * lu(k,1883) + lu(k,1920) = lu(k,1920) - lu(k,1013) * lu(k,1883) + lu(k,1924) = lu(k,1924) - lu(k,1014) * lu(k,1883) + lu(k,1927) = lu(k,1927) - lu(k,1015) * lu(k,1883) + lu(k,2010) = lu(k,2010) - lu(k,1011) * lu(k,2009) + lu(k,2020) = lu(k,2020) - lu(k,1012) * lu(k,2009) + lu(k,2023) = lu(k,2023) - lu(k,1013) * lu(k,2009) + lu(k,2027) = lu(k,2027) - lu(k,1014) * lu(k,2009) + lu(k,2030) = lu(k,2030) - lu(k,1015) * lu(k,2009) + lu(k,2052) = lu(k,2052) - lu(k,1011) * lu(k,2044) + lu(k,2077) = lu(k,2077) - lu(k,1012) * lu(k,2044) + lu(k,2080) = lu(k,2080) - lu(k,1013) * lu(k,2044) + lu(k,2084) = lu(k,2084) - lu(k,1014) * lu(k,2044) + lu(k,2087) = lu(k,2087) - lu(k,1015) * lu(k,2044) + lu(k,2196) = lu(k,2196) - lu(k,1011) * lu(k,2191) + lu(k,2220) = lu(k,2220) - lu(k,1012) * lu(k,2191) + lu(k,2223) = lu(k,2223) - lu(k,1013) * lu(k,2191) + lu(k,2227) = lu(k,2227) - lu(k,1014) * lu(k,2191) + lu(k,2230) = lu(k,2230) - lu(k,1015) * lu(k,2191) + lu(k,2247) = lu(k,2247) - lu(k,1011) * lu(k,2245) + lu(k,2259) = lu(k,2259) - lu(k,1012) * lu(k,2245) + lu(k,2262) = lu(k,2262) - lu(k,1013) * lu(k,2245) + lu(k,2266) = lu(k,2266) - lu(k,1014) * lu(k,2245) + lu(k,2269) = lu(k,2269) - lu(k,1015) * lu(k,2245) + lu(k,2297) = lu(k,2297) - lu(k,1011) * lu(k,2290) + lu(k,2320) = lu(k,2320) - lu(k,1012) * lu(k,2290) + lu(k,2323) = lu(k,2323) - lu(k,1013) * lu(k,2290) + lu(k,2327) = lu(k,2327) - lu(k,1014) * lu(k,2290) + lu(k,2330) = lu(k,2330) - lu(k,1015) * lu(k,2290) + lu(k,1016) = 1._r8 / lu(k,1016) + lu(k,1017) = lu(k,1017) * lu(k,1016) + lu(k,1018) = lu(k,1018) * lu(k,1016) + lu(k,1019) = lu(k,1019) * lu(k,1016) + lu(k,1020) = lu(k,1020) * lu(k,1016) + lu(k,1021) = lu(k,1021) * lu(k,1016) + lu(k,1022) = lu(k,1022) * lu(k,1016) + lu(k,1023) = lu(k,1023) * lu(k,1016) + lu(k,1040) = lu(k,1040) - lu(k,1017) * lu(k,1038) + lu(k,1041) = lu(k,1041) - lu(k,1018) * lu(k,1038) + lu(k,1043) = lu(k,1043) - lu(k,1019) * lu(k,1038) + lu(k,1044) = - lu(k,1020) * lu(k,1038) + lu(k,1052) = lu(k,1052) - lu(k,1021) * lu(k,1038) + lu(k,1055) = lu(k,1055) - lu(k,1022) * lu(k,1038) + lu(k,1056) = lu(k,1056) - lu(k,1023) * lu(k,1038) + lu(k,1101) = lu(k,1101) - lu(k,1017) * lu(k,1100) + lu(k,1102) = - lu(k,1018) * lu(k,1100) + lu(k,1103) = - lu(k,1019) * lu(k,1100) + lu(k,1104) = - lu(k,1020) * lu(k,1100) + lu(k,1109) = lu(k,1109) - lu(k,1021) * lu(k,1100) + lu(k,1111) = lu(k,1111) - lu(k,1022) * lu(k,1100) + lu(k,1112) = lu(k,1112) - lu(k,1023) * lu(k,1100) + lu(k,1581) = lu(k,1581) - lu(k,1017) * lu(k,1579) + lu(k,1582) = lu(k,1582) - lu(k,1018) * lu(k,1579) + lu(k,1584) = lu(k,1584) - lu(k,1019) * lu(k,1579) + lu(k,1586) = lu(k,1586) - lu(k,1020) * lu(k,1579) + lu(k,1608) = lu(k,1608) - lu(k,1021) * lu(k,1579) + lu(k,1613) = lu(k,1613) - lu(k,1022) * lu(k,1579) + lu(k,1615) = lu(k,1615) - lu(k,1023) * lu(k,1579) + lu(k,1635) = lu(k,1635) - lu(k,1017) * lu(k,1633) + lu(k,1636) = lu(k,1636) - lu(k,1018) * lu(k,1633) + lu(k,1638) = lu(k,1638) - lu(k,1019) * lu(k,1633) + lu(k,1640) = lu(k,1640) - lu(k,1020) * lu(k,1633) + lu(k,1660) = lu(k,1660) - lu(k,1021) * lu(k,1633) + lu(k,1665) = - lu(k,1022) * lu(k,1633) + lu(k,1667) = lu(k,1667) - lu(k,1023) * lu(k,1633) + lu(k,1888) = lu(k,1888) - lu(k,1017) * lu(k,1884) + lu(k,1889) = lu(k,1889) - lu(k,1018) * lu(k,1884) + lu(k,1891) = lu(k,1891) - lu(k,1019) * lu(k,1884) + lu(k,1893) = lu(k,1893) - lu(k,1020) * lu(k,1884) + lu(k,1917) = lu(k,1917) - lu(k,1021) * lu(k,1884) + lu(k,1922) = lu(k,1922) - lu(k,1022) * lu(k,1884) + lu(k,1924) = lu(k,1924) - lu(k,1023) * lu(k,1884) + lu(k,2049) = lu(k,2049) - lu(k,1017) * lu(k,2045) + lu(k,2050) = lu(k,2050) - lu(k,1018) * lu(k,2045) + lu(k,2052) = lu(k,2052) - lu(k,1019) * lu(k,2045) + lu(k,2054) = lu(k,2054) - lu(k,1020) * lu(k,2045) + lu(k,2077) = lu(k,2077) - lu(k,1021) * lu(k,2045) + lu(k,2082) = lu(k,2082) - lu(k,1022) * lu(k,2045) + lu(k,2084) = lu(k,2084) - lu(k,1023) * lu(k,2045) + lu(k,2193) = lu(k,2193) - lu(k,1017) * lu(k,2192) + lu(k,2194) = lu(k,2194) - lu(k,1018) * lu(k,2192) + lu(k,2196) = lu(k,2196) - lu(k,1019) * lu(k,2192) + lu(k,2198) = lu(k,2198) - lu(k,1020) * lu(k,2192) + lu(k,2220) = lu(k,2220) - lu(k,1021) * lu(k,2192) + lu(k,2225) = lu(k,2225) - lu(k,1022) * lu(k,2192) + lu(k,2227) = lu(k,2227) - lu(k,1023) * lu(k,2192) + lu(k,2294) = lu(k,2294) - lu(k,1017) * lu(k,2291) + lu(k,2295) = lu(k,2295) - lu(k,1018) * lu(k,2291) + lu(k,2297) = lu(k,2297) - lu(k,1019) * lu(k,2291) + lu(k,2299) = - lu(k,1020) * lu(k,2291) + lu(k,2320) = lu(k,2320) - lu(k,1021) * lu(k,2291) + lu(k,2325) = lu(k,2325) - lu(k,1022) * lu(k,2291) + lu(k,2327) = lu(k,2327) - lu(k,1023) * lu(k,2291) end do end subroutine lu_fac21 subroutine lu_fac22( avec_len, lu ) @@ -4234,410 +3740,242 @@ subroutine lu_fac22( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1040) = 1._r8 / lu(k,1040) - lu(k,1041) = lu(k,1041) * lu(k,1040) - lu(k,1042) = lu(k,1042) * lu(k,1040) - lu(k,1043) = lu(k,1043) * lu(k,1040) - lu(k,1044) = lu(k,1044) * lu(k,1040) - lu(k,1045) = lu(k,1045) * lu(k,1040) - lu(k,1046) = lu(k,1046) * lu(k,1040) - lu(k,1047) = lu(k,1047) * lu(k,1040) - lu(k,1048) = lu(k,1048) * lu(k,1040) - lu(k,1156) = lu(k,1156) - lu(k,1041) * lu(k,1148) - lu(k,1157) = lu(k,1157) - lu(k,1042) * lu(k,1148) - lu(k,1158) = lu(k,1158) - lu(k,1043) * lu(k,1148) - lu(k,1160) = lu(k,1160) - lu(k,1044) * lu(k,1148) - lu(k,1161) = lu(k,1161) - lu(k,1045) * lu(k,1148) - lu(k,1164) = lu(k,1164) - lu(k,1046) * lu(k,1148) - lu(k,1165) = lu(k,1165) - lu(k,1047) * lu(k,1148) - lu(k,1167) = lu(k,1167) - lu(k,1048) * lu(k,1148) - lu(k,1176) = lu(k,1176) - lu(k,1041) * lu(k,1172) - lu(k,1177) = - lu(k,1042) * lu(k,1172) - lu(k,1178) = lu(k,1178) - lu(k,1043) * lu(k,1172) - lu(k,1180) = lu(k,1180) - lu(k,1044) * lu(k,1172) - lu(k,1181) = lu(k,1181) - lu(k,1045) * lu(k,1172) - lu(k,1184) = lu(k,1184) - lu(k,1046) * lu(k,1172) - lu(k,1185) = lu(k,1185) - lu(k,1047) * lu(k,1172) - lu(k,1187) = lu(k,1187) - lu(k,1048) * lu(k,1172) - lu(k,1199) = lu(k,1199) - lu(k,1041) * lu(k,1195) - lu(k,1200) = lu(k,1200) - lu(k,1042) * lu(k,1195) - lu(k,1201) = lu(k,1201) - lu(k,1043) * lu(k,1195) - lu(k,1203) = lu(k,1203) - lu(k,1044) * lu(k,1195) - lu(k,1204) = lu(k,1204) - lu(k,1045) * lu(k,1195) - lu(k,1207) = lu(k,1207) - lu(k,1046) * lu(k,1195) - lu(k,1208) = lu(k,1208) - lu(k,1047) * lu(k,1195) - lu(k,1209) = lu(k,1209) - lu(k,1048) * lu(k,1195) - lu(k,1232) = lu(k,1232) - lu(k,1041) * lu(k,1224) - lu(k,1233) = lu(k,1233) - lu(k,1042) * lu(k,1224) - lu(k,1234) = lu(k,1234) - lu(k,1043) * lu(k,1224) - lu(k,1236) = lu(k,1236) - lu(k,1044) * lu(k,1224) - lu(k,1237) = lu(k,1237) - lu(k,1045) * lu(k,1224) - lu(k,1240) = lu(k,1240) - lu(k,1046) * lu(k,1224) - lu(k,1241) = lu(k,1241) - lu(k,1047) * lu(k,1224) - lu(k,1243) = lu(k,1243) - lu(k,1048) * lu(k,1224) - lu(k,1391) = lu(k,1391) - lu(k,1041) * lu(k,1381) - lu(k,1393) = lu(k,1393) - lu(k,1042) * lu(k,1381) - lu(k,1394) = lu(k,1394) - lu(k,1043) * lu(k,1381) - lu(k,1397) = lu(k,1397) - lu(k,1044) * lu(k,1381) - lu(k,1399) = lu(k,1399) - lu(k,1045) * lu(k,1381) - lu(k,1402) = lu(k,1402) - lu(k,1046) * lu(k,1381) - lu(k,1403) = lu(k,1403) - lu(k,1047) * lu(k,1381) - lu(k,1409) = lu(k,1409) - lu(k,1048) * lu(k,1381) - lu(k,1507) = lu(k,1507) - lu(k,1041) * lu(k,1496) - lu(k,1509) = lu(k,1509) - lu(k,1042) * lu(k,1496) - lu(k,1510) = lu(k,1510) - lu(k,1043) * lu(k,1496) - lu(k,1513) = lu(k,1513) - lu(k,1044) * lu(k,1496) - lu(k,1515) = lu(k,1515) - lu(k,1045) * lu(k,1496) - lu(k,1518) = lu(k,1518) - lu(k,1046) * lu(k,1496) - lu(k,1519) = lu(k,1519) - lu(k,1047) * lu(k,1496) - lu(k,1525) = lu(k,1525) - lu(k,1048) * lu(k,1496) - lu(k,1690) = lu(k,1690) - lu(k,1041) * lu(k,1678) - lu(k,1692) = lu(k,1692) - lu(k,1042) * lu(k,1678) - lu(k,1693) = lu(k,1693) - lu(k,1043) * lu(k,1678) - lu(k,1696) = lu(k,1696) - lu(k,1044) * lu(k,1678) - lu(k,1698) = lu(k,1698) - lu(k,1045) * lu(k,1678) - lu(k,1701) = lu(k,1701) - lu(k,1046) * lu(k,1678) - lu(k,1702) = lu(k,1702) - lu(k,1047) * lu(k,1678) - lu(k,1708) = lu(k,1708) - lu(k,1048) * lu(k,1678) - lu(k,1811) = lu(k,1811) - lu(k,1041) * lu(k,1800) - lu(k,1813) = lu(k,1813) - lu(k,1042) * lu(k,1800) - lu(k,1814) = lu(k,1814) - lu(k,1043) * lu(k,1800) - lu(k,1817) = lu(k,1817) - lu(k,1044) * lu(k,1800) - lu(k,1819) = lu(k,1819) - lu(k,1045) * lu(k,1800) - lu(k,1822) = lu(k,1822) - lu(k,1046) * lu(k,1800) - lu(k,1823) = lu(k,1823) - lu(k,1047) * lu(k,1800) - lu(k,1829) = lu(k,1829) - lu(k,1048) * lu(k,1800) - lu(k,1862) = lu(k,1862) - lu(k,1041) * lu(k,1852) - lu(k,1863) = lu(k,1863) - lu(k,1042) * lu(k,1852) - lu(k,1864) = lu(k,1864) - lu(k,1043) * lu(k,1852) - lu(k,1867) = lu(k,1867) - lu(k,1044) * lu(k,1852) - lu(k,1869) = lu(k,1869) - lu(k,1045) * lu(k,1852) - lu(k,1872) = lu(k,1872) - lu(k,1046) * lu(k,1852) - lu(k,1873) = lu(k,1873) - lu(k,1047) * lu(k,1852) - lu(k,1879) = lu(k,1879) - lu(k,1048) * lu(k,1852) - lu(k,1921) = lu(k,1921) - lu(k,1041) * lu(k,1911) - lu(k,1923) = lu(k,1923) - lu(k,1042) * lu(k,1911) - lu(k,1924) = lu(k,1924) - lu(k,1043) * lu(k,1911) - lu(k,1927) = lu(k,1927) - lu(k,1044) * lu(k,1911) - lu(k,1929) = lu(k,1929) - lu(k,1045) * lu(k,1911) - lu(k,1932) = lu(k,1932) - lu(k,1046) * lu(k,1911) - lu(k,1933) = lu(k,1933) - lu(k,1047) * lu(k,1911) - lu(k,1939) = lu(k,1939) - lu(k,1048) * lu(k,1911) - lu(k,2035) = - lu(k,1041) * lu(k,2033) - lu(k,2037) = lu(k,2037) - lu(k,1042) * lu(k,2033) - lu(k,2038) = lu(k,2038) - lu(k,1043) * lu(k,2033) - lu(k,2041) = lu(k,2041) - lu(k,1044) * lu(k,2033) - lu(k,2043) = lu(k,2043) - lu(k,1045) * lu(k,2033) - lu(k,2046) = lu(k,2046) - lu(k,1046) * lu(k,2033) - lu(k,2047) = lu(k,2047) - lu(k,1047) * lu(k,2033) - lu(k,2053) = lu(k,2053) - lu(k,1048) * lu(k,2033) - lu(k,1051) = 1._r8 / lu(k,1051) - lu(k,1052) = lu(k,1052) * lu(k,1051) - lu(k,1053) = lu(k,1053) * lu(k,1051) - lu(k,1054) = lu(k,1054) * lu(k,1051) - lu(k,1055) = lu(k,1055) * lu(k,1051) - lu(k,1056) = lu(k,1056) * lu(k,1051) - lu(k,1057) = lu(k,1057) * lu(k,1051) - lu(k,1058) = lu(k,1058) * lu(k,1051) - lu(k,1059) = lu(k,1059) * lu(k,1051) - lu(k,1060) = lu(k,1060) * lu(k,1051) - lu(k,1061) = lu(k,1061) * lu(k,1051) - lu(k,1307) = lu(k,1307) - lu(k,1052) * lu(k,1306) - lu(k,1308) = lu(k,1308) - lu(k,1053) * lu(k,1306) - lu(k,1309) = - lu(k,1054) * lu(k,1306) - lu(k,1310) = - lu(k,1055) * lu(k,1306) - lu(k,1311) = lu(k,1311) - lu(k,1056) * lu(k,1306) - lu(k,1313) = lu(k,1313) - lu(k,1057) * lu(k,1306) - lu(k,1314) = lu(k,1314) - lu(k,1058) * lu(k,1306) - lu(k,1315) = - lu(k,1059) * lu(k,1306) - lu(k,1316) = - lu(k,1060) * lu(k,1306) - lu(k,1317) = lu(k,1317) - lu(k,1061) * lu(k,1306) - lu(k,1319) = - lu(k,1052) * lu(k,1318) - lu(k,1320) = lu(k,1320) - lu(k,1053) * lu(k,1318) - lu(k,1321) = - lu(k,1054) * lu(k,1318) - lu(k,1323) = - lu(k,1055) * lu(k,1318) - lu(k,1324) = lu(k,1324) - lu(k,1056) * lu(k,1318) - lu(k,1326) = - lu(k,1057) * lu(k,1318) - lu(k,1327) = - lu(k,1058) * lu(k,1318) - lu(k,1329) = lu(k,1329) - lu(k,1059) * lu(k,1318) - lu(k,1330) = - lu(k,1060) * lu(k,1318) - lu(k,1331) = lu(k,1331) - lu(k,1061) * lu(k,1318) - lu(k,1509) = lu(k,1509) - lu(k,1052) * lu(k,1497) - lu(k,1510) = lu(k,1510) - lu(k,1053) * lu(k,1497) - lu(k,1512) = lu(k,1512) - lu(k,1054) * lu(k,1497) - lu(k,1514) = lu(k,1514) - lu(k,1055) * lu(k,1497) - lu(k,1515) = lu(k,1515) - lu(k,1056) * lu(k,1497) - lu(k,1518) = lu(k,1518) - lu(k,1057) * lu(k,1497) - lu(k,1519) = lu(k,1519) - lu(k,1058) * lu(k,1497) - lu(k,1523) = lu(k,1523) - lu(k,1059) * lu(k,1497) - lu(k,1524) = lu(k,1524) - lu(k,1060) * lu(k,1497) - lu(k,1525) = lu(k,1525) - lu(k,1061) * lu(k,1497) - lu(k,1533) = lu(k,1533) - lu(k,1052) * lu(k,1531) - lu(k,1534) = lu(k,1534) - lu(k,1053) * lu(k,1531) - lu(k,1536) = lu(k,1536) - lu(k,1054) * lu(k,1531) - lu(k,1538) = lu(k,1538) - lu(k,1055) * lu(k,1531) - lu(k,1539) = lu(k,1539) - lu(k,1056) * lu(k,1531) - lu(k,1542) = lu(k,1542) - lu(k,1057) * lu(k,1531) - lu(k,1543) = lu(k,1543) - lu(k,1058) * lu(k,1531) - lu(k,1547) = lu(k,1547) - lu(k,1059) * lu(k,1531) - lu(k,1548) = lu(k,1548) - lu(k,1060) * lu(k,1531) - lu(k,1549) = lu(k,1549) - lu(k,1061) * lu(k,1531) - lu(k,1692) = lu(k,1692) - lu(k,1052) * lu(k,1679) - lu(k,1693) = lu(k,1693) - lu(k,1053) * lu(k,1679) - lu(k,1695) = lu(k,1695) - lu(k,1054) * lu(k,1679) - lu(k,1697) = lu(k,1697) - lu(k,1055) * lu(k,1679) - lu(k,1698) = lu(k,1698) - lu(k,1056) * lu(k,1679) - lu(k,1701) = lu(k,1701) - lu(k,1057) * lu(k,1679) - lu(k,1702) = lu(k,1702) - lu(k,1058) * lu(k,1679) - lu(k,1706) = lu(k,1706) - lu(k,1059) * lu(k,1679) - lu(k,1707) = lu(k,1707) - lu(k,1060) * lu(k,1679) - lu(k,1708) = lu(k,1708) - lu(k,1061) * lu(k,1679) - lu(k,1715) = lu(k,1715) - lu(k,1052) * lu(k,1713) - lu(k,1716) = lu(k,1716) - lu(k,1053) * lu(k,1713) - lu(k,1718) = lu(k,1718) - lu(k,1054) * lu(k,1713) - lu(k,1720) = lu(k,1720) - lu(k,1055) * lu(k,1713) - lu(k,1721) = lu(k,1721) - lu(k,1056) * lu(k,1713) - lu(k,1724) = lu(k,1724) - lu(k,1057) * lu(k,1713) - lu(k,1725) = - lu(k,1058) * lu(k,1713) - lu(k,1729) = lu(k,1729) - lu(k,1059) * lu(k,1713) - lu(k,1730) = lu(k,1730) - lu(k,1060) * lu(k,1713) - lu(k,1731) = lu(k,1731) - lu(k,1061) * lu(k,1713) - lu(k,2003) = lu(k,2003) - lu(k,1052) * lu(k,2000) - lu(k,2004) = lu(k,2004) - lu(k,1053) * lu(k,2000) - lu(k,2006) = lu(k,2006) - lu(k,1054) * lu(k,2000) - lu(k,2008) = lu(k,2008) - lu(k,1055) * lu(k,2000) - lu(k,2009) = lu(k,2009) - lu(k,1056) * lu(k,2000) - lu(k,2012) = lu(k,2012) - lu(k,1057) * lu(k,2000) - lu(k,2013) = - lu(k,1058) * lu(k,2000) - lu(k,2017) = lu(k,2017) - lu(k,1059) * lu(k,2000) - lu(k,2018) = lu(k,2018) - lu(k,1060) * lu(k,2000) - lu(k,2019) = lu(k,2019) - lu(k,1061) * lu(k,2000) - lu(k,2037) = lu(k,2037) - lu(k,1052) * lu(k,2034) - lu(k,2038) = lu(k,2038) - lu(k,1053) * lu(k,2034) - lu(k,2040) = lu(k,2040) - lu(k,1054) * lu(k,2034) - lu(k,2042) = - lu(k,1055) * lu(k,2034) - lu(k,2043) = lu(k,2043) - lu(k,1056) * lu(k,2034) - lu(k,2046) = lu(k,2046) - lu(k,1057) * lu(k,2034) - lu(k,2047) = lu(k,2047) - lu(k,1058) * lu(k,2034) - lu(k,2051) = lu(k,2051) - lu(k,1059) * lu(k,2034) - lu(k,2052) = lu(k,2052) - lu(k,1060) * lu(k,2034) - lu(k,2053) = lu(k,2053) - lu(k,1061) * lu(k,2034) - lu(k,2062) = lu(k,2062) - lu(k,1052) * lu(k,2059) - lu(k,2063) = lu(k,2063) - lu(k,1053) * lu(k,2059) - lu(k,2065) = - lu(k,1054) * lu(k,2059) - lu(k,2067) = lu(k,2067) - lu(k,1055) * lu(k,2059) - lu(k,2068) = lu(k,2068) - lu(k,1056) * lu(k,2059) - lu(k,2071) = lu(k,2071) - lu(k,1057) * lu(k,2059) - lu(k,2072) = lu(k,2072) - lu(k,1058) * lu(k,2059) - lu(k,2076) = lu(k,2076) - lu(k,1059) * lu(k,2059) - lu(k,2077) = - lu(k,1060) * lu(k,2059) - lu(k,2078) = lu(k,2078) - lu(k,1061) * lu(k,2059) - lu(k,1068) = 1._r8 / lu(k,1068) - lu(k,1069) = lu(k,1069) * lu(k,1068) - lu(k,1070) = lu(k,1070) * lu(k,1068) - lu(k,1071) = lu(k,1071) * lu(k,1068) - lu(k,1072) = lu(k,1072) * lu(k,1068) - lu(k,1073) = lu(k,1073) * lu(k,1068) - lu(k,1074) = lu(k,1074) * lu(k,1068) - lu(k,1075) = lu(k,1075) * lu(k,1068) - lu(k,1076) = lu(k,1076) * lu(k,1068) - lu(k,1077) = lu(k,1077) * lu(k,1068) - lu(k,1078) = lu(k,1078) * lu(k,1068) - lu(k,1090) = lu(k,1090) - lu(k,1069) * lu(k,1087) - lu(k,1092) = lu(k,1092) - lu(k,1070) * lu(k,1087) - lu(k,1094) = lu(k,1094) - lu(k,1071) * lu(k,1087) - lu(k,1095) = lu(k,1095) - lu(k,1072) * lu(k,1087) - lu(k,1096) = lu(k,1096) - lu(k,1073) * lu(k,1087) - lu(k,1097) = lu(k,1097) - lu(k,1074) * lu(k,1087) - lu(k,1098) = lu(k,1098) - lu(k,1075) * lu(k,1087) - lu(k,1099) = lu(k,1099) - lu(k,1076) * lu(k,1087) - lu(k,1100) = lu(k,1100) - lu(k,1077) * lu(k,1087) - lu(k,1101) = lu(k,1101) - lu(k,1078) * lu(k,1087) - lu(k,1151) = lu(k,1151) - lu(k,1069) * lu(k,1149) - lu(k,1156) = lu(k,1156) - lu(k,1070) * lu(k,1149) - lu(k,1158) = lu(k,1158) - lu(k,1071) * lu(k,1149) - lu(k,1159) = lu(k,1159) - lu(k,1072) * lu(k,1149) - lu(k,1160) = lu(k,1160) - lu(k,1073) * lu(k,1149) - lu(k,1161) = lu(k,1161) - lu(k,1074) * lu(k,1149) - lu(k,1162) = lu(k,1162) - lu(k,1075) * lu(k,1149) - lu(k,1163) = lu(k,1163) - lu(k,1076) * lu(k,1149) - lu(k,1164) = lu(k,1164) - lu(k,1077) * lu(k,1149) - lu(k,1165) = lu(k,1165) - lu(k,1078) * lu(k,1149) - lu(k,1227) = lu(k,1227) - lu(k,1069) * lu(k,1225) - lu(k,1232) = lu(k,1232) - lu(k,1070) * lu(k,1225) - lu(k,1234) = lu(k,1234) - lu(k,1071) * lu(k,1225) - lu(k,1235) = lu(k,1235) - lu(k,1072) * lu(k,1225) - lu(k,1236) = lu(k,1236) - lu(k,1073) * lu(k,1225) - lu(k,1237) = lu(k,1237) - lu(k,1074) * lu(k,1225) - lu(k,1238) = lu(k,1238) - lu(k,1075) * lu(k,1225) - lu(k,1239) = lu(k,1239) - lu(k,1076) * lu(k,1225) - lu(k,1240) = lu(k,1240) - lu(k,1077) * lu(k,1225) - lu(k,1241) = lu(k,1241) - lu(k,1078) * lu(k,1225) - lu(k,1274) = lu(k,1274) - lu(k,1069) * lu(k,1271) - lu(k,1280) = lu(k,1280) - lu(k,1070) * lu(k,1271) - lu(k,1282) = lu(k,1282) - lu(k,1071) * lu(k,1271) - lu(k,1283) = lu(k,1283) - lu(k,1072) * lu(k,1271) - lu(k,1284) = lu(k,1284) - lu(k,1073) * lu(k,1271) - lu(k,1285) = lu(k,1285) - lu(k,1074) * lu(k,1271) - lu(k,1286) = lu(k,1286) - lu(k,1075) * lu(k,1271) - lu(k,1287) = lu(k,1287) - lu(k,1076) * lu(k,1271) - lu(k,1288) = lu(k,1288) - lu(k,1077) * lu(k,1271) - lu(k,1289) = lu(k,1289) - lu(k,1078) * lu(k,1271) - lu(k,1385) = lu(k,1385) - lu(k,1069) * lu(k,1382) - lu(k,1391) = lu(k,1391) - lu(k,1070) * lu(k,1382) - lu(k,1394) = lu(k,1394) - lu(k,1071) * lu(k,1382) - lu(k,1395) = lu(k,1395) - lu(k,1072) * lu(k,1382) - lu(k,1397) = lu(k,1397) - lu(k,1073) * lu(k,1382) - lu(k,1399) = lu(k,1399) - lu(k,1074) * lu(k,1382) - lu(k,1400) = lu(k,1400) - lu(k,1075) * lu(k,1382) - lu(k,1401) = lu(k,1401) - lu(k,1076) * lu(k,1382) - lu(k,1402) = lu(k,1402) - lu(k,1077) * lu(k,1382) - lu(k,1403) = lu(k,1403) - lu(k,1078) * lu(k,1382) - lu(k,1501) = lu(k,1501) - lu(k,1069) * lu(k,1498) - lu(k,1507) = lu(k,1507) - lu(k,1070) * lu(k,1498) - lu(k,1510) = lu(k,1510) - lu(k,1071) * lu(k,1498) - lu(k,1511) = lu(k,1511) - lu(k,1072) * lu(k,1498) - lu(k,1513) = lu(k,1513) - lu(k,1073) * lu(k,1498) - lu(k,1515) = lu(k,1515) - lu(k,1074) * lu(k,1498) - lu(k,1516) = lu(k,1516) - lu(k,1075) * lu(k,1498) - lu(k,1517) = lu(k,1517) - lu(k,1076) * lu(k,1498) - lu(k,1518) = lu(k,1518) - lu(k,1077) * lu(k,1498) - lu(k,1519) = lu(k,1519) - lu(k,1078) * lu(k,1498) - lu(k,1683) = lu(k,1683) - lu(k,1069) * lu(k,1680) - lu(k,1690) = lu(k,1690) - lu(k,1070) * lu(k,1680) - lu(k,1693) = lu(k,1693) - lu(k,1071) * lu(k,1680) - lu(k,1694) = lu(k,1694) - lu(k,1072) * lu(k,1680) - lu(k,1696) = lu(k,1696) - lu(k,1073) * lu(k,1680) - lu(k,1698) = lu(k,1698) - lu(k,1074) * lu(k,1680) - lu(k,1699) = lu(k,1699) - lu(k,1075) * lu(k,1680) - lu(k,1700) = lu(k,1700) - lu(k,1076) * lu(k,1680) - lu(k,1701) = lu(k,1701) - lu(k,1077) * lu(k,1680) - lu(k,1702) = lu(k,1702) - lu(k,1078) * lu(k,1680) - lu(k,1804) = lu(k,1804) - lu(k,1069) * lu(k,1801) - lu(k,1811) = lu(k,1811) - lu(k,1070) * lu(k,1801) - lu(k,1814) = lu(k,1814) - lu(k,1071) * lu(k,1801) - lu(k,1815) = lu(k,1815) - lu(k,1072) * lu(k,1801) - lu(k,1817) = lu(k,1817) - lu(k,1073) * lu(k,1801) - lu(k,1819) = lu(k,1819) - lu(k,1074) * lu(k,1801) - lu(k,1820) = lu(k,1820) - lu(k,1075) * lu(k,1801) - lu(k,1821) = lu(k,1821) - lu(k,1076) * lu(k,1801) - lu(k,1822) = lu(k,1822) - lu(k,1077) * lu(k,1801) - lu(k,1823) = lu(k,1823) - lu(k,1078) * lu(k,1801) - lu(k,1856) = lu(k,1856) - lu(k,1069) * lu(k,1853) - lu(k,1862) = lu(k,1862) - lu(k,1070) * lu(k,1853) - lu(k,1864) = lu(k,1864) - lu(k,1071) * lu(k,1853) - lu(k,1865) = lu(k,1865) - lu(k,1072) * lu(k,1853) - lu(k,1867) = lu(k,1867) - lu(k,1073) * lu(k,1853) - lu(k,1869) = lu(k,1869) - lu(k,1074) * lu(k,1853) - lu(k,1870) = lu(k,1870) - lu(k,1075) * lu(k,1853) - lu(k,1871) = lu(k,1871) - lu(k,1076) * lu(k,1853) - lu(k,1872) = lu(k,1872) - lu(k,1077) * lu(k,1853) - lu(k,1873) = lu(k,1873) - lu(k,1078) * lu(k,1853) - lu(k,1088) = 1._r8 / lu(k,1088) - lu(k,1089) = lu(k,1089) * lu(k,1088) - lu(k,1090) = lu(k,1090) * lu(k,1088) - lu(k,1091) = lu(k,1091) * lu(k,1088) - lu(k,1092) = lu(k,1092) * lu(k,1088) - lu(k,1093) = lu(k,1093) * lu(k,1088) - lu(k,1094) = lu(k,1094) * lu(k,1088) - lu(k,1095) = lu(k,1095) * lu(k,1088) - lu(k,1096) = lu(k,1096) * lu(k,1088) - lu(k,1097) = lu(k,1097) * lu(k,1088) - lu(k,1098) = lu(k,1098) * lu(k,1088) - lu(k,1099) = lu(k,1099) * lu(k,1088) - lu(k,1100) = lu(k,1100) * lu(k,1088) - lu(k,1101) = lu(k,1101) * lu(k,1088) - lu(k,1273) = lu(k,1273) - lu(k,1089) * lu(k,1272) - lu(k,1274) = lu(k,1274) - lu(k,1090) * lu(k,1272) - lu(k,1276) = lu(k,1276) - lu(k,1091) * lu(k,1272) - lu(k,1280) = lu(k,1280) - lu(k,1092) * lu(k,1272) - lu(k,1281) = lu(k,1281) - lu(k,1093) * lu(k,1272) - lu(k,1282) = lu(k,1282) - lu(k,1094) * lu(k,1272) - lu(k,1283) = lu(k,1283) - lu(k,1095) * lu(k,1272) - lu(k,1284) = lu(k,1284) - lu(k,1096) * lu(k,1272) - lu(k,1285) = lu(k,1285) - lu(k,1097) * lu(k,1272) - lu(k,1286) = lu(k,1286) - lu(k,1098) * lu(k,1272) - lu(k,1287) = lu(k,1287) - lu(k,1099) * lu(k,1272) - lu(k,1288) = lu(k,1288) - lu(k,1100) * lu(k,1272) - lu(k,1289) = lu(k,1289) - lu(k,1101) * lu(k,1272) - lu(k,1384) = lu(k,1384) - lu(k,1089) * lu(k,1383) - lu(k,1385) = lu(k,1385) - lu(k,1090) * lu(k,1383) - lu(k,1387) = lu(k,1387) - lu(k,1091) * lu(k,1383) - lu(k,1391) = lu(k,1391) - lu(k,1092) * lu(k,1383) - lu(k,1393) = lu(k,1393) - lu(k,1093) * lu(k,1383) - lu(k,1394) = lu(k,1394) - lu(k,1094) * lu(k,1383) - lu(k,1395) = lu(k,1395) - lu(k,1095) * lu(k,1383) - lu(k,1397) = lu(k,1397) - lu(k,1096) * lu(k,1383) - lu(k,1399) = lu(k,1399) - lu(k,1097) * lu(k,1383) - lu(k,1400) = lu(k,1400) - lu(k,1098) * lu(k,1383) - lu(k,1401) = lu(k,1401) - lu(k,1099) * lu(k,1383) - lu(k,1402) = lu(k,1402) - lu(k,1100) * lu(k,1383) - lu(k,1403) = lu(k,1403) - lu(k,1101) * lu(k,1383) - lu(k,1500) = lu(k,1500) - lu(k,1089) * lu(k,1499) - lu(k,1501) = lu(k,1501) - lu(k,1090) * lu(k,1499) - lu(k,1503) = lu(k,1503) - lu(k,1091) * lu(k,1499) - lu(k,1507) = lu(k,1507) - lu(k,1092) * lu(k,1499) - lu(k,1509) = lu(k,1509) - lu(k,1093) * lu(k,1499) - lu(k,1510) = lu(k,1510) - lu(k,1094) * lu(k,1499) - lu(k,1511) = lu(k,1511) - lu(k,1095) * lu(k,1499) - lu(k,1513) = lu(k,1513) - lu(k,1096) * lu(k,1499) - lu(k,1515) = lu(k,1515) - lu(k,1097) * lu(k,1499) - lu(k,1516) = lu(k,1516) - lu(k,1098) * lu(k,1499) - lu(k,1517) = lu(k,1517) - lu(k,1099) * lu(k,1499) - lu(k,1518) = lu(k,1518) - lu(k,1100) * lu(k,1499) - lu(k,1519) = lu(k,1519) - lu(k,1101) * lu(k,1499) - lu(k,1682) = lu(k,1682) - lu(k,1089) * lu(k,1681) - lu(k,1683) = lu(k,1683) - lu(k,1090) * lu(k,1681) - lu(k,1686) = lu(k,1686) - lu(k,1091) * lu(k,1681) - lu(k,1690) = lu(k,1690) - lu(k,1092) * lu(k,1681) - lu(k,1692) = lu(k,1692) - lu(k,1093) * lu(k,1681) - lu(k,1693) = lu(k,1693) - lu(k,1094) * lu(k,1681) - lu(k,1694) = lu(k,1694) - lu(k,1095) * lu(k,1681) - lu(k,1696) = lu(k,1696) - lu(k,1096) * lu(k,1681) - lu(k,1698) = lu(k,1698) - lu(k,1097) * lu(k,1681) - lu(k,1699) = lu(k,1699) - lu(k,1098) * lu(k,1681) - lu(k,1700) = lu(k,1700) - lu(k,1099) * lu(k,1681) - lu(k,1701) = lu(k,1701) - lu(k,1100) * lu(k,1681) - lu(k,1702) = lu(k,1702) - lu(k,1101) * lu(k,1681) - lu(k,1803) = lu(k,1803) - lu(k,1089) * lu(k,1802) - lu(k,1804) = lu(k,1804) - lu(k,1090) * lu(k,1802) - lu(k,1807) = lu(k,1807) - lu(k,1091) * lu(k,1802) - lu(k,1811) = lu(k,1811) - lu(k,1092) * lu(k,1802) - lu(k,1813) = lu(k,1813) - lu(k,1093) * lu(k,1802) - lu(k,1814) = lu(k,1814) - lu(k,1094) * lu(k,1802) - lu(k,1815) = lu(k,1815) - lu(k,1095) * lu(k,1802) - lu(k,1817) = lu(k,1817) - lu(k,1096) * lu(k,1802) - lu(k,1819) = lu(k,1819) - lu(k,1097) * lu(k,1802) - lu(k,1820) = lu(k,1820) - lu(k,1098) * lu(k,1802) - lu(k,1821) = lu(k,1821) - lu(k,1099) * lu(k,1802) - lu(k,1822) = lu(k,1822) - lu(k,1100) * lu(k,1802) - lu(k,1823) = lu(k,1823) - lu(k,1101) * lu(k,1802) - lu(k,1855) = lu(k,1855) - lu(k,1089) * lu(k,1854) - lu(k,1856) = lu(k,1856) - lu(k,1090) * lu(k,1854) - lu(k,1858) = lu(k,1858) - lu(k,1091) * lu(k,1854) - lu(k,1862) = lu(k,1862) - lu(k,1092) * lu(k,1854) - lu(k,1863) = lu(k,1863) - lu(k,1093) * lu(k,1854) - lu(k,1864) = lu(k,1864) - lu(k,1094) * lu(k,1854) - lu(k,1865) = lu(k,1865) - lu(k,1095) * lu(k,1854) - lu(k,1867) = lu(k,1867) - lu(k,1096) * lu(k,1854) - lu(k,1869) = lu(k,1869) - lu(k,1097) * lu(k,1854) - lu(k,1870) = lu(k,1870) - lu(k,1098) * lu(k,1854) - lu(k,1871) = lu(k,1871) - lu(k,1099) * lu(k,1854) - lu(k,1872) = lu(k,1872) - lu(k,1100) * lu(k,1854) - lu(k,1873) = lu(k,1873) - lu(k,1101) * lu(k,1854) - lu(k,1913) = lu(k,1913) - lu(k,1089) * lu(k,1912) - lu(k,1914) = lu(k,1914) - lu(k,1090) * lu(k,1912) - lu(k,1917) = lu(k,1917) - lu(k,1091) * lu(k,1912) - lu(k,1921) = lu(k,1921) - lu(k,1092) * lu(k,1912) - lu(k,1923) = lu(k,1923) - lu(k,1093) * lu(k,1912) - lu(k,1924) = lu(k,1924) - lu(k,1094) * lu(k,1912) - lu(k,1925) = lu(k,1925) - lu(k,1095) * lu(k,1912) - lu(k,1927) = lu(k,1927) - lu(k,1096) * lu(k,1912) - lu(k,1929) = lu(k,1929) - lu(k,1097) * lu(k,1912) - lu(k,1930) = lu(k,1930) - lu(k,1098) * lu(k,1912) - lu(k,1931) = lu(k,1931) - lu(k,1099) * lu(k,1912) - lu(k,1932) = lu(k,1932) - lu(k,1100) * lu(k,1912) - lu(k,1933) = lu(k,1933) - lu(k,1101) * lu(k,1912) + lu(k,1039) = 1._r8 / lu(k,1039) + lu(k,1040) = lu(k,1040) * lu(k,1039) + lu(k,1041) = lu(k,1041) * lu(k,1039) + lu(k,1042) = lu(k,1042) * lu(k,1039) + lu(k,1043) = lu(k,1043) * lu(k,1039) + lu(k,1044) = lu(k,1044) * lu(k,1039) + lu(k,1045) = lu(k,1045) * lu(k,1039) + lu(k,1046) = lu(k,1046) * lu(k,1039) + lu(k,1047) = lu(k,1047) * lu(k,1039) + lu(k,1048) = lu(k,1048) * lu(k,1039) + lu(k,1049) = lu(k,1049) * lu(k,1039) + lu(k,1050) = lu(k,1050) * lu(k,1039) + lu(k,1051) = lu(k,1051) * lu(k,1039) + lu(k,1052) = lu(k,1052) * lu(k,1039) + lu(k,1053) = lu(k,1053) * lu(k,1039) + lu(k,1054) = lu(k,1054) * lu(k,1039) + lu(k,1055) = lu(k,1055) * lu(k,1039) + lu(k,1056) = lu(k,1056) * lu(k,1039) + lu(k,1057) = lu(k,1057) * lu(k,1039) + lu(k,1058) = lu(k,1058) * lu(k,1039) + lu(k,1888) = lu(k,1888) - lu(k,1040) * lu(k,1885) + lu(k,1889) = lu(k,1889) - lu(k,1041) * lu(k,1885) + lu(k,1890) = lu(k,1890) - lu(k,1042) * lu(k,1885) + lu(k,1891) = lu(k,1891) - lu(k,1043) * lu(k,1885) + lu(k,1893) = lu(k,1893) - lu(k,1044) * lu(k,1885) + lu(k,1894) = lu(k,1894) - lu(k,1045) * lu(k,1885) + lu(k,1900) = lu(k,1900) - lu(k,1046) * lu(k,1885) + lu(k,1907) = lu(k,1907) - lu(k,1047) * lu(k,1885) + lu(k,1911) = lu(k,1911) - lu(k,1048) * lu(k,1885) + lu(k,1913) = lu(k,1913) - lu(k,1049) * lu(k,1885) + lu(k,1914) = lu(k,1914) - lu(k,1050) * lu(k,1885) + lu(k,1915) = lu(k,1915) - lu(k,1051) * lu(k,1885) + lu(k,1917) = lu(k,1917) - lu(k,1052) * lu(k,1885) + lu(k,1920) = lu(k,1920) - lu(k,1053) * lu(k,1885) + lu(k,1921) = lu(k,1921) - lu(k,1054) * lu(k,1885) + lu(k,1922) = lu(k,1922) - lu(k,1055) * lu(k,1885) + lu(k,1924) = lu(k,1924) - lu(k,1056) * lu(k,1885) + lu(k,1926) = lu(k,1926) - lu(k,1057) * lu(k,1885) + lu(k,1927) = lu(k,1927) - lu(k,1058) * lu(k,1885) + lu(k,2049) = lu(k,2049) - lu(k,1040) * lu(k,2046) + lu(k,2050) = lu(k,2050) - lu(k,1041) * lu(k,2046) + lu(k,2051) = lu(k,2051) - lu(k,1042) * lu(k,2046) + lu(k,2052) = lu(k,2052) - lu(k,1043) * lu(k,2046) + lu(k,2054) = lu(k,2054) - lu(k,1044) * lu(k,2046) + lu(k,2055) = lu(k,2055) - lu(k,1045) * lu(k,2046) + lu(k,2061) = lu(k,2061) - lu(k,1046) * lu(k,2046) + lu(k,2068) = lu(k,2068) - lu(k,1047) * lu(k,2046) + lu(k,2071) = lu(k,2071) - lu(k,1048) * lu(k,2046) + lu(k,2073) = lu(k,2073) - lu(k,1049) * lu(k,2046) + lu(k,2074) = lu(k,2074) - lu(k,1050) * lu(k,2046) + lu(k,2075) = lu(k,2075) - lu(k,1051) * lu(k,2046) + lu(k,2077) = lu(k,2077) - lu(k,1052) * lu(k,2046) + lu(k,2080) = lu(k,2080) - lu(k,1053) * lu(k,2046) + lu(k,2081) = lu(k,2081) - lu(k,1054) * lu(k,2046) + lu(k,2082) = lu(k,2082) - lu(k,1055) * lu(k,2046) + lu(k,2084) = lu(k,2084) - lu(k,1056) * lu(k,2046) + lu(k,2086) = lu(k,2086) - lu(k,1057) * lu(k,2046) + lu(k,2087) = lu(k,2087) - lu(k,1058) * lu(k,2046) + lu(k,2294) = lu(k,2294) - lu(k,1040) * lu(k,2292) + lu(k,2295) = lu(k,2295) - lu(k,1041) * lu(k,2292) + lu(k,2296) = lu(k,2296) - lu(k,1042) * lu(k,2292) + lu(k,2297) = lu(k,2297) - lu(k,1043) * lu(k,2292) + lu(k,2299) = lu(k,2299) - lu(k,1044) * lu(k,2292) + lu(k,2300) = lu(k,2300) - lu(k,1045) * lu(k,2292) + lu(k,2304) = lu(k,2304) - lu(k,1046) * lu(k,2292) + lu(k,2311) = lu(k,2311) - lu(k,1047) * lu(k,2292) + lu(k,2314) = lu(k,2314) - lu(k,1048) * lu(k,2292) + lu(k,2316) = lu(k,2316) - lu(k,1049) * lu(k,2292) + lu(k,2317) = lu(k,2317) - lu(k,1050) * lu(k,2292) + lu(k,2318) = lu(k,2318) - lu(k,1051) * lu(k,2292) + lu(k,2320) = lu(k,2320) - lu(k,1052) * lu(k,2292) + lu(k,2323) = lu(k,2323) - lu(k,1053) * lu(k,2292) + lu(k,2324) = lu(k,2324) - lu(k,1054) * lu(k,2292) + lu(k,2325) = lu(k,2325) - lu(k,1055) * lu(k,2292) + lu(k,2327) = lu(k,2327) - lu(k,1056) * lu(k,2292) + lu(k,2329) = lu(k,2329) - lu(k,1057) * lu(k,2292) + lu(k,2330) = lu(k,2330) - lu(k,1058) * lu(k,2292) + lu(k,1064) = 1._r8 / lu(k,1064) + lu(k,1065) = lu(k,1065) * lu(k,1064) + lu(k,1066) = lu(k,1066) * lu(k,1064) + lu(k,1067) = lu(k,1067) * lu(k,1064) + lu(k,1068) = lu(k,1068) * lu(k,1064) + lu(k,1069) = lu(k,1069) * lu(k,1064) + lu(k,1070) = lu(k,1070) * lu(k,1064) + lu(k,1071) = lu(k,1071) * lu(k,1064) + lu(k,1072) = lu(k,1072) * lu(k,1064) + lu(k,1073) = lu(k,1073) * lu(k,1064) + lu(k,1074) = lu(k,1074) * lu(k,1064) + lu(k,1075) = lu(k,1075) * lu(k,1064) + lu(k,1076) = lu(k,1076) * lu(k,1064) + lu(k,1077) = lu(k,1077) * lu(k,1064) + lu(k,1078) = lu(k,1078) * lu(k,1064) + lu(k,1079) = lu(k,1079) * lu(k,1064) + lu(k,1080) = lu(k,1080) * lu(k,1064) + lu(k,1367) = lu(k,1367) - lu(k,1065) * lu(k,1366) + lu(k,1368) = lu(k,1368) - lu(k,1066) * lu(k,1366) + lu(k,1369) = - lu(k,1067) * lu(k,1366) + lu(k,1370) = lu(k,1370) - lu(k,1068) * lu(k,1366) + lu(k,1374) = lu(k,1374) - lu(k,1069) * lu(k,1366) + lu(k,1375) = - lu(k,1070) * lu(k,1366) + lu(k,1377) = - lu(k,1071) * lu(k,1366) + lu(k,1378) = lu(k,1378) - lu(k,1072) * lu(k,1366) + lu(k,1379) = - lu(k,1073) * lu(k,1366) + lu(k,1380) = lu(k,1380) - lu(k,1074) * lu(k,1366) + lu(k,1381) = lu(k,1381) - lu(k,1075) * lu(k,1366) + lu(k,1382) = lu(k,1382) - lu(k,1076) * lu(k,1366) + lu(k,1383) = - lu(k,1077) * lu(k,1366) + lu(k,1384) = lu(k,1384) - lu(k,1078) * lu(k,1366) + lu(k,1385) = lu(k,1385) - lu(k,1079) * lu(k,1366) + lu(k,1386) = lu(k,1386) - lu(k,1080) * lu(k,1366) + lu(k,1890) = lu(k,1890) - lu(k,1065) * lu(k,1886) + lu(k,1891) = lu(k,1891) - lu(k,1066) * lu(k,1886) + lu(k,1895) = lu(k,1895) - lu(k,1067) * lu(k,1886) + lu(k,1900) = lu(k,1900) - lu(k,1068) * lu(k,1886) + lu(k,1907) = lu(k,1907) - lu(k,1069) * lu(k,1886) + lu(k,1910) = lu(k,1910) - lu(k,1070) * lu(k,1886) + lu(k,1913) = lu(k,1913) - lu(k,1071) * lu(k,1886) + lu(k,1914) = lu(k,1914) - lu(k,1072) * lu(k,1886) + lu(k,1915) = lu(k,1915) - lu(k,1073) * lu(k,1886) + lu(k,1917) = lu(k,1917) - lu(k,1074) * lu(k,1886) + lu(k,1920) = lu(k,1920) - lu(k,1075) * lu(k,1886) + lu(k,1921) = lu(k,1921) - lu(k,1076) * lu(k,1886) + lu(k,1922) = lu(k,1922) - lu(k,1077) * lu(k,1886) + lu(k,1924) = lu(k,1924) - lu(k,1078) * lu(k,1886) + lu(k,1926) = lu(k,1926) - lu(k,1079) * lu(k,1886) + lu(k,1927) = lu(k,1927) - lu(k,1080) * lu(k,1886) + lu(k,2051) = lu(k,2051) - lu(k,1065) * lu(k,2047) + lu(k,2052) = lu(k,2052) - lu(k,1066) * lu(k,2047) + lu(k,2056) = lu(k,2056) - lu(k,1067) * lu(k,2047) + lu(k,2061) = lu(k,2061) - lu(k,1068) * lu(k,2047) + lu(k,2068) = lu(k,2068) - lu(k,1069) * lu(k,2047) + lu(k,2070) = - lu(k,1070) * lu(k,2047) + lu(k,2073) = lu(k,2073) - lu(k,1071) * lu(k,2047) + lu(k,2074) = lu(k,2074) - lu(k,1072) * lu(k,2047) + lu(k,2075) = lu(k,2075) - lu(k,1073) * lu(k,2047) + lu(k,2077) = lu(k,2077) - lu(k,1074) * lu(k,2047) + lu(k,2080) = lu(k,2080) - lu(k,1075) * lu(k,2047) + lu(k,2081) = lu(k,2081) - lu(k,1076) * lu(k,2047) + lu(k,2082) = lu(k,2082) - lu(k,1077) * lu(k,2047) + lu(k,2084) = lu(k,2084) - lu(k,1078) * lu(k,2047) + lu(k,2086) = lu(k,2086) - lu(k,1079) * lu(k,2047) + lu(k,2087) = lu(k,2087) - lu(k,1080) * lu(k,2047) + lu(k,2296) = lu(k,2296) - lu(k,1065) * lu(k,2293) + lu(k,2297) = lu(k,2297) - lu(k,1066) * lu(k,2293) + lu(k,2301) = - lu(k,1067) * lu(k,2293) + lu(k,2304) = lu(k,2304) - lu(k,1068) * lu(k,2293) + lu(k,2311) = lu(k,2311) - lu(k,1069) * lu(k,2293) + lu(k,2313) = lu(k,2313) - lu(k,1070) * lu(k,2293) + lu(k,2316) = lu(k,2316) - lu(k,1071) * lu(k,2293) + lu(k,2317) = lu(k,2317) - lu(k,1072) * lu(k,2293) + lu(k,2318) = lu(k,2318) - lu(k,1073) * lu(k,2293) + lu(k,2320) = lu(k,2320) - lu(k,1074) * lu(k,2293) + lu(k,2323) = lu(k,2323) - lu(k,1075) * lu(k,2293) + lu(k,2324) = lu(k,2324) - lu(k,1076) * lu(k,2293) + lu(k,2325) = lu(k,2325) - lu(k,1077) * lu(k,2293) + lu(k,2327) = lu(k,2327) - lu(k,1078) * lu(k,2293) + lu(k,2329) = lu(k,2329) - lu(k,1079) * lu(k,2293) + lu(k,2330) = lu(k,2330) - lu(k,1080) * lu(k,2293) + lu(k,1085) = 1._r8 / lu(k,1085) + lu(k,1086) = lu(k,1086) * lu(k,1085) + lu(k,1087) = lu(k,1087) * lu(k,1085) + lu(k,1088) = lu(k,1088) * lu(k,1085) + lu(k,1089) = lu(k,1089) * lu(k,1085) + lu(k,1090) = lu(k,1090) * lu(k,1085) + lu(k,1091) = lu(k,1091) * lu(k,1085) + lu(k,1092) = lu(k,1092) * lu(k,1085) + lu(k,1093) = lu(k,1093) * lu(k,1085) + lu(k,1094) = lu(k,1094) * lu(k,1085) + lu(k,1095) = lu(k,1095) * lu(k,1085) + lu(k,1096) = lu(k,1096) * lu(k,1085) + lu(k,1230) = - lu(k,1086) * lu(k,1229) + lu(k,1235) = lu(k,1235) - lu(k,1087) * lu(k,1229) + lu(k,1237) = lu(k,1237) - lu(k,1088) * lu(k,1229) + lu(k,1238) = lu(k,1238) - lu(k,1089) * lu(k,1229) + lu(k,1239) = lu(k,1239) - lu(k,1090) * lu(k,1229) + lu(k,1240) = lu(k,1240) - lu(k,1091) * lu(k,1229) + lu(k,1241) = lu(k,1241) - lu(k,1092) * lu(k,1229) + lu(k,1242) = lu(k,1242) - lu(k,1093) * lu(k,1229) + lu(k,1243) = - lu(k,1094) * lu(k,1229) + lu(k,1244) = lu(k,1244) - lu(k,1095) * lu(k,1229) + lu(k,1246) = lu(k,1246) - lu(k,1096) * lu(k,1229) + lu(k,1414) = lu(k,1414) - lu(k,1086) * lu(k,1413) + lu(k,1420) = lu(k,1420) - lu(k,1087) * lu(k,1413) + lu(k,1426) = lu(k,1426) - lu(k,1088) * lu(k,1413) + lu(k,1428) = - lu(k,1089) * lu(k,1413) + lu(k,1429) = lu(k,1429) - lu(k,1090) * lu(k,1413) + lu(k,1430) = lu(k,1430) - lu(k,1091) * lu(k,1413) + lu(k,1431) = lu(k,1431) - lu(k,1092) * lu(k,1413) + lu(k,1432) = lu(k,1432) - lu(k,1093) * lu(k,1413) + lu(k,1433) = lu(k,1433) - lu(k,1094) * lu(k,1413) + lu(k,1434) = lu(k,1434) - lu(k,1095) * lu(k,1413) + lu(k,1436) = lu(k,1436) - lu(k,1096) * lu(k,1413) + lu(k,1584) = lu(k,1584) - lu(k,1086) * lu(k,1580) + lu(k,1593) = lu(k,1593) - lu(k,1087) * lu(k,1580) + lu(k,1599) = lu(k,1599) - lu(k,1088) * lu(k,1580) + lu(k,1602) = lu(k,1602) - lu(k,1089) * lu(k,1580) + lu(k,1604) = lu(k,1604) - lu(k,1090) * lu(k,1580) + lu(k,1605) = lu(k,1605) - lu(k,1091) * lu(k,1580) + lu(k,1606) = lu(k,1606) - lu(k,1092) * lu(k,1580) + lu(k,1608) = lu(k,1608) - lu(k,1093) * lu(k,1580) + lu(k,1611) = lu(k,1611) - lu(k,1094) * lu(k,1580) + lu(k,1612) = lu(k,1612) - lu(k,1095) * lu(k,1580) + lu(k,1615) = lu(k,1615) - lu(k,1096) * lu(k,1580) + lu(k,1638) = lu(k,1638) - lu(k,1086) * lu(k,1634) + lu(k,1646) = lu(k,1646) - lu(k,1087) * lu(k,1634) + lu(k,1652) = lu(k,1652) - lu(k,1088) * lu(k,1634) + lu(k,1654) = lu(k,1654) - lu(k,1089) * lu(k,1634) + lu(k,1656) = lu(k,1656) - lu(k,1090) * lu(k,1634) + lu(k,1657) = lu(k,1657) - lu(k,1091) * lu(k,1634) + lu(k,1658) = lu(k,1658) - lu(k,1092) * lu(k,1634) + lu(k,1660) = lu(k,1660) - lu(k,1093) * lu(k,1634) + lu(k,1663) = lu(k,1663) - lu(k,1094) * lu(k,1634) + lu(k,1664) = lu(k,1664) - lu(k,1095) * lu(k,1634) + lu(k,1667) = lu(k,1667) - lu(k,1096) * lu(k,1634) + lu(k,1891) = lu(k,1891) - lu(k,1086) * lu(k,1887) + lu(k,1900) = lu(k,1900) - lu(k,1087) * lu(k,1887) + lu(k,1907) = lu(k,1907) - lu(k,1088) * lu(k,1887) + lu(k,1911) = lu(k,1911) - lu(k,1089) * lu(k,1887) + lu(k,1913) = lu(k,1913) - lu(k,1090) * lu(k,1887) + lu(k,1914) = lu(k,1914) - lu(k,1091) * lu(k,1887) + lu(k,1915) = lu(k,1915) - lu(k,1092) * lu(k,1887) + lu(k,1917) = lu(k,1917) - lu(k,1093) * lu(k,1887) + lu(k,1920) = lu(k,1920) - lu(k,1094) * lu(k,1887) + lu(k,1921) = lu(k,1921) - lu(k,1095) * lu(k,1887) + lu(k,1924) = lu(k,1924) - lu(k,1096) * lu(k,1887) + lu(k,2052) = lu(k,2052) - lu(k,1086) * lu(k,2048) + lu(k,2061) = lu(k,2061) - lu(k,1087) * lu(k,2048) + lu(k,2068) = lu(k,2068) - lu(k,1088) * lu(k,2048) + lu(k,2071) = lu(k,2071) - lu(k,1089) * lu(k,2048) + lu(k,2073) = lu(k,2073) - lu(k,1090) * lu(k,2048) + lu(k,2074) = lu(k,2074) - lu(k,1091) * lu(k,2048) + lu(k,2075) = lu(k,2075) - lu(k,1092) * lu(k,2048) + lu(k,2077) = lu(k,2077) - lu(k,1093) * lu(k,2048) + lu(k,2080) = lu(k,2080) - lu(k,1094) * lu(k,2048) + lu(k,2081) = lu(k,2081) - lu(k,1095) * lu(k,2048) + lu(k,2084) = lu(k,2084) - lu(k,1096) * lu(k,2048) end do end subroutine lu_fac22 subroutine lu_fac23( avec_len, lu ) @@ -4654,315 +3992,460 @@ subroutine lu_fac23( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1104) = 1._r8 / lu(k,1104) - lu(k,1105) = lu(k,1105) * lu(k,1104) - lu(k,1106) = lu(k,1106) * lu(k,1104) - lu(k,1107) = lu(k,1107) * lu(k,1104) - lu(k,1108) = lu(k,1108) * lu(k,1104) - lu(k,1109) = lu(k,1109) * lu(k,1104) - lu(k,1110) = lu(k,1110) * lu(k,1104) - lu(k,1111) = lu(k,1111) * lu(k,1104) - lu(k,1112) = lu(k,1112) * lu(k,1104) - lu(k,1113) = lu(k,1113) * lu(k,1104) - lu(k,1114) = lu(k,1114) * lu(k,1104) - lu(k,1151) = lu(k,1151) - lu(k,1105) * lu(k,1150) - lu(k,1154) = - lu(k,1106) * lu(k,1150) - lu(k,1155) = - lu(k,1107) * lu(k,1150) - lu(k,1156) = lu(k,1156) - lu(k,1108) * lu(k,1150) - lu(k,1158) = lu(k,1158) - lu(k,1109) * lu(k,1150) - lu(k,1160) = lu(k,1160) - lu(k,1110) * lu(k,1150) - lu(k,1161) = lu(k,1161) - lu(k,1111) * lu(k,1150) - lu(k,1162) = lu(k,1162) - lu(k,1112) * lu(k,1150) - lu(k,1166) = - lu(k,1113) * lu(k,1150) - lu(k,1167) = lu(k,1167) - lu(k,1114) * lu(k,1150) - lu(k,1227) = lu(k,1227) - lu(k,1105) * lu(k,1226) - lu(k,1229) = - lu(k,1106) * lu(k,1226) - lu(k,1231) = - lu(k,1107) * lu(k,1226) - lu(k,1232) = lu(k,1232) - lu(k,1108) * lu(k,1226) - lu(k,1234) = lu(k,1234) - lu(k,1109) * lu(k,1226) - lu(k,1236) = lu(k,1236) - lu(k,1110) * lu(k,1226) - lu(k,1237) = lu(k,1237) - lu(k,1111) * lu(k,1226) - lu(k,1238) = lu(k,1238) - lu(k,1112) * lu(k,1226) - lu(k,1242) = - lu(k,1113) * lu(k,1226) - lu(k,1243) = lu(k,1243) - lu(k,1114) * lu(k,1226) - lu(k,1274) = lu(k,1274) - lu(k,1105) * lu(k,1273) - lu(k,1277) = lu(k,1277) - lu(k,1106) * lu(k,1273) - lu(k,1279) = lu(k,1279) - lu(k,1107) * lu(k,1273) - lu(k,1280) = lu(k,1280) - lu(k,1108) * lu(k,1273) - lu(k,1282) = lu(k,1282) - lu(k,1109) * lu(k,1273) - lu(k,1284) = lu(k,1284) - lu(k,1110) * lu(k,1273) - lu(k,1285) = lu(k,1285) - lu(k,1111) * lu(k,1273) - lu(k,1286) = lu(k,1286) - lu(k,1112) * lu(k,1273) - lu(k,1290) = lu(k,1290) - lu(k,1113) * lu(k,1273) - lu(k,1291) = lu(k,1291) - lu(k,1114) * lu(k,1273) - lu(k,1385) = lu(k,1385) - lu(k,1105) * lu(k,1384) - lu(k,1388) = lu(k,1388) - lu(k,1106) * lu(k,1384) - lu(k,1390) = lu(k,1390) - lu(k,1107) * lu(k,1384) - lu(k,1391) = lu(k,1391) - lu(k,1108) * lu(k,1384) - lu(k,1394) = lu(k,1394) - lu(k,1109) * lu(k,1384) - lu(k,1397) = lu(k,1397) - lu(k,1110) * lu(k,1384) - lu(k,1399) = lu(k,1399) - lu(k,1111) * lu(k,1384) - lu(k,1400) = lu(k,1400) - lu(k,1112) * lu(k,1384) - lu(k,1404) = lu(k,1404) - lu(k,1113) * lu(k,1384) - lu(k,1409) = lu(k,1409) - lu(k,1114) * lu(k,1384) - lu(k,1501) = lu(k,1501) - lu(k,1105) * lu(k,1500) - lu(k,1504) = lu(k,1504) - lu(k,1106) * lu(k,1500) - lu(k,1506) = lu(k,1506) - lu(k,1107) * lu(k,1500) - lu(k,1507) = lu(k,1507) - lu(k,1108) * lu(k,1500) - lu(k,1510) = lu(k,1510) - lu(k,1109) * lu(k,1500) - lu(k,1513) = lu(k,1513) - lu(k,1110) * lu(k,1500) - lu(k,1515) = lu(k,1515) - lu(k,1111) * lu(k,1500) - lu(k,1516) = lu(k,1516) - lu(k,1112) * lu(k,1500) - lu(k,1520) = lu(k,1520) - lu(k,1113) * lu(k,1500) - lu(k,1525) = lu(k,1525) - lu(k,1114) * lu(k,1500) - lu(k,1683) = lu(k,1683) - lu(k,1105) * lu(k,1682) - lu(k,1687) = lu(k,1687) - lu(k,1106) * lu(k,1682) - lu(k,1689) = lu(k,1689) - lu(k,1107) * lu(k,1682) - lu(k,1690) = lu(k,1690) - lu(k,1108) * lu(k,1682) - lu(k,1693) = lu(k,1693) - lu(k,1109) * lu(k,1682) - lu(k,1696) = lu(k,1696) - lu(k,1110) * lu(k,1682) - lu(k,1698) = lu(k,1698) - lu(k,1111) * lu(k,1682) - lu(k,1699) = lu(k,1699) - lu(k,1112) * lu(k,1682) - lu(k,1703) = lu(k,1703) - lu(k,1113) * lu(k,1682) - lu(k,1708) = lu(k,1708) - lu(k,1114) * lu(k,1682) - lu(k,1804) = lu(k,1804) - lu(k,1105) * lu(k,1803) - lu(k,1808) = lu(k,1808) - lu(k,1106) * lu(k,1803) - lu(k,1810) = lu(k,1810) - lu(k,1107) * lu(k,1803) - lu(k,1811) = lu(k,1811) - lu(k,1108) * lu(k,1803) - lu(k,1814) = lu(k,1814) - lu(k,1109) * lu(k,1803) - lu(k,1817) = lu(k,1817) - lu(k,1110) * lu(k,1803) - lu(k,1819) = lu(k,1819) - lu(k,1111) * lu(k,1803) - lu(k,1820) = lu(k,1820) - lu(k,1112) * lu(k,1803) - lu(k,1824) = lu(k,1824) - lu(k,1113) * lu(k,1803) - lu(k,1829) = lu(k,1829) - lu(k,1114) * lu(k,1803) - lu(k,1856) = lu(k,1856) - lu(k,1105) * lu(k,1855) - lu(k,1859) = lu(k,1859) - lu(k,1106) * lu(k,1855) - lu(k,1861) = lu(k,1861) - lu(k,1107) * lu(k,1855) - lu(k,1862) = lu(k,1862) - lu(k,1108) * lu(k,1855) - lu(k,1864) = lu(k,1864) - lu(k,1109) * lu(k,1855) - lu(k,1867) = lu(k,1867) - lu(k,1110) * lu(k,1855) - lu(k,1869) = lu(k,1869) - lu(k,1111) * lu(k,1855) - lu(k,1870) = lu(k,1870) - lu(k,1112) * lu(k,1855) - lu(k,1874) = - lu(k,1113) * lu(k,1855) - lu(k,1879) = lu(k,1879) - lu(k,1114) * lu(k,1855) - lu(k,1914) = lu(k,1914) - lu(k,1105) * lu(k,1913) - lu(k,1918) = - lu(k,1106) * lu(k,1913) - lu(k,1920) = - lu(k,1107) * lu(k,1913) - lu(k,1921) = lu(k,1921) - lu(k,1108) * lu(k,1913) - lu(k,1924) = lu(k,1924) - lu(k,1109) * lu(k,1913) - lu(k,1927) = lu(k,1927) - lu(k,1110) * lu(k,1913) - lu(k,1929) = lu(k,1929) - lu(k,1111) * lu(k,1913) - lu(k,1930) = lu(k,1930) - lu(k,1112) * lu(k,1913) - lu(k,1934) = lu(k,1934) - lu(k,1113) * lu(k,1913) - lu(k,1939) = lu(k,1939) - lu(k,1114) * lu(k,1913) - lu(k,1116) = 1._r8 / lu(k,1116) - lu(k,1117) = lu(k,1117) * lu(k,1116) - lu(k,1118) = lu(k,1118) * lu(k,1116) - lu(k,1119) = lu(k,1119) * lu(k,1116) - lu(k,1120) = lu(k,1120) * lu(k,1116) - lu(k,1121) = lu(k,1121) * lu(k,1116) - lu(k,1122) = lu(k,1122) * lu(k,1116) - lu(k,1123) = lu(k,1123) * lu(k,1116) - lu(k,1156) = lu(k,1156) - lu(k,1117) * lu(k,1151) - lu(k,1157) = lu(k,1157) - lu(k,1118) * lu(k,1151) - lu(k,1158) = lu(k,1158) - lu(k,1119) * lu(k,1151) - lu(k,1160) = lu(k,1160) - lu(k,1120) * lu(k,1151) - lu(k,1161) = lu(k,1161) - lu(k,1121) * lu(k,1151) - lu(k,1164) = lu(k,1164) - lu(k,1122) * lu(k,1151) - lu(k,1167) = lu(k,1167) - lu(k,1123) * lu(k,1151) - lu(k,1176) = lu(k,1176) - lu(k,1117) * lu(k,1173) - lu(k,1177) = lu(k,1177) - lu(k,1118) * lu(k,1173) - lu(k,1178) = lu(k,1178) - lu(k,1119) * lu(k,1173) - lu(k,1180) = lu(k,1180) - lu(k,1120) * lu(k,1173) - lu(k,1181) = lu(k,1181) - lu(k,1121) * lu(k,1173) - lu(k,1184) = lu(k,1184) - lu(k,1122) * lu(k,1173) - lu(k,1187) = lu(k,1187) - lu(k,1123) * lu(k,1173) - lu(k,1199) = lu(k,1199) - lu(k,1117) * lu(k,1196) - lu(k,1200) = lu(k,1200) - lu(k,1118) * lu(k,1196) - lu(k,1201) = lu(k,1201) - lu(k,1119) * lu(k,1196) - lu(k,1203) = lu(k,1203) - lu(k,1120) * lu(k,1196) - lu(k,1204) = lu(k,1204) - lu(k,1121) * lu(k,1196) - lu(k,1207) = lu(k,1207) - lu(k,1122) * lu(k,1196) - lu(k,1209) = lu(k,1209) - lu(k,1123) * lu(k,1196) - lu(k,1232) = lu(k,1232) - lu(k,1117) * lu(k,1227) - lu(k,1233) = lu(k,1233) - lu(k,1118) * lu(k,1227) - lu(k,1234) = lu(k,1234) - lu(k,1119) * lu(k,1227) - lu(k,1236) = lu(k,1236) - lu(k,1120) * lu(k,1227) - lu(k,1237) = lu(k,1237) - lu(k,1121) * lu(k,1227) - lu(k,1240) = lu(k,1240) - lu(k,1122) * lu(k,1227) - lu(k,1243) = lu(k,1243) - lu(k,1123) * lu(k,1227) - lu(k,1250) = lu(k,1250) - lu(k,1117) * lu(k,1248) - lu(k,1251) = - lu(k,1118) * lu(k,1248) - lu(k,1252) = - lu(k,1119) * lu(k,1248) - lu(k,1254) = lu(k,1254) - lu(k,1120) * lu(k,1248) - lu(k,1255) = lu(k,1255) - lu(k,1121) * lu(k,1248) - lu(k,1258) = lu(k,1258) - lu(k,1122) * lu(k,1248) - lu(k,1261) = lu(k,1261) - lu(k,1123) * lu(k,1248) - lu(k,1280) = lu(k,1280) - lu(k,1117) * lu(k,1274) - lu(k,1281) = lu(k,1281) - lu(k,1118) * lu(k,1274) - lu(k,1282) = lu(k,1282) - lu(k,1119) * lu(k,1274) - lu(k,1284) = lu(k,1284) - lu(k,1120) * lu(k,1274) - lu(k,1285) = lu(k,1285) - lu(k,1121) * lu(k,1274) - lu(k,1288) = lu(k,1288) - lu(k,1122) * lu(k,1274) - lu(k,1291) = lu(k,1291) - lu(k,1123) * lu(k,1274) - lu(k,1391) = lu(k,1391) - lu(k,1117) * lu(k,1385) - lu(k,1393) = lu(k,1393) - lu(k,1118) * lu(k,1385) - lu(k,1394) = lu(k,1394) - lu(k,1119) * lu(k,1385) - lu(k,1397) = lu(k,1397) - lu(k,1120) * lu(k,1385) - lu(k,1399) = lu(k,1399) - lu(k,1121) * lu(k,1385) - lu(k,1402) = lu(k,1402) - lu(k,1122) * lu(k,1385) - lu(k,1409) = lu(k,1409) - lu(k,1123) * lu(k,1385) - lu(k,1507) = lu(k,1507) - lu(k,1117) * lu(k,1501) - lu(k,1509) = lu(k,1509) - lu(k,1118) * lu(k,1501) - lu(k,1510) = lu(k,1510) - lu(k,1119) * lu(k,1501) - lu(k,1513) = lu(k,1513) - lu(k,1120) * lu(k,1501) - lu(k,1515) = lu(k,1515) - lu(k,1121) * lu(k,1501) - lu(k,1518) = lu(k,1518) - lu(k,1122) * lu(k,1501) - lu(k,1525) = lu(k,1525) - lu(k,1123) * lu(k,1501) - lu(k,1690) = lu(k,1690) - lu(k,1117) * lu(k,1683) - lu(k,1692) = lu(k,1692) - lu(k,1118) * lu(k,1683) - lu(k,1693) = lu(k,1693) - lu(k,1119) * lu(k,1683) - lu(k,1696) = lu(k,1696) - lu(k,1120) * lu(k,1683) - lu(k,1698) = lu(k,1698) - lu(k,1121) * lu(k,1683) - lu(k,1701) = lu(k,1701) - lu(k,1122) * lu(k,1683) - lu(k,1708) = lu(k,1708) - lu(k,1123) * lu(k,1683) - lu(k,1754) = lu(k,1754) - lu(k,1117) * lu(k,1751) - lu(k,1756) = lu(k,1756) - lu(k,1118) * lu(k,1751) - lu(k,1757) = lu(k,1757) - lu(k,1119) * lu(k,1751) - lu(k,1760) = lu(k,1760) - lu(k,1120) * lu(k,1751) - lu(k,1762) = lu(k,1762) - lu(k,1121) * lu(k,1751) - lu(k,1765) = lu(k,1765) - lu(k,1122) * lu(k,1751) - lu(k,1772) = lu(k,1772) - lu(k,1123) * lu(k,1751) - lu(k,1811) = lu(k,1811) - lu(k,1117) * lu(k,1804) - lu(k,1813) = lu(k,1813) - lu(k,1118) * lu(k,1804) - lu(k,1814) = lu(k,1814) - lu(k,1119) * lu(k,1804) - lu(k,1817) = lu(k,1817) - lu(k,1120) * lu(k,1804) - lu(k,1819) = lu(k,1819) - lu(k,1121) * lu(k,1804) - lu(k,1822) = lu(k,1822) - lu(k,1122) * lu(k,1804) - lu(k,1829) = lu(k,1829) - lu(k,1123) * lu(k,1804) - lu(k,1862) = lu(k,1862) - lu(k,1117) * lu(k,1856) - lu(k,1863) = lu(k,1863) - lu(k,1118) * lu(k,1856) - lu(k,1864) = lu(k,1864) - lu(k,1119) * lu(k,1856) - lu(k,1867) = lu(k,1867) - lu(k,1120) * lu(k,1856) - lu(k,1869) = lu(k,1869) - lu(k,1121) * lu(k,1856) - lu(k,1872) = lu(k,1872) - lu(k,1122) * lu(k,1856) - lu(k,1879) = lu(k,1879) - lu(k,1123) * lu(k,1856) - lu(k,1921) = lu(k,1921) - lu(k,1117) * lu(k,1914) - lu(k,1923) = lu(k,1923) - lu(k,1118) * lu(k,1914) - lu(k,1924) = lu(k,1924) - lu(k,1119) * lu(k,1914) - lu(k,1927) = lu(k,1927) - lu(k,1120) * lu(k,1914) - lu(k,1929) = lu(k,1929) - lu(k,1121) * lu(k,1914) - lu(k,1932) = lu(k,1932) - lu(k,1122) * lu(k,1914) - lu(k,1939) = lu(k,1939) - lu(k,1123) * lu(k,1914) - lu(k,1127) = 1._r8 / lu(k,1127) - lu(k,1128) = lu(k,1128) * lu(k,1127) - lu(k,1129) = lu(k,1129) * lu(k,1127) - lu(k,1130) = lu(k,1130) * lu(k,1127) - lu(k,1131) = lu(k,1131) * lu(k,1127) - lu(k,1132) = lu(k,1132) * lu(k,1127) - lu(k,1133) = lu(k,1133) * lu(k,1127) - lu(k,1134) = lu(k,1134) * lu(k,1127) - lu(k,1135) = lu(k,1135) * lu(k,1127) - lu(k,1136) = lu(k,1136) * lu(k,1127) - lu(k,1137) = lu(k,1137) * lu(k,1127) - lu(k,1138) = lu(k,1138) * lu(k,1127) - lu(k,1139) = lu(k,1139) * lu(k,1127) - lu(k,1691) = lu(k,1691) - lu(k,1128) * lu(k,1684) - lu(k,1693) = lu(k,1693) - lu(k,1129) * lu(k,1684) - lu(k,1694) = lu(k,1694) - lu(k,1130) * lu(k,1684) - lu(k,1696) = lu(k,1696) - lu(k,1131) * lu(k,1684) - lu(k,1698) = lu(k,1698) - lu(k,1132) * lu(k,1684) - lu(k,1700) = lu(k,1700) - lu(k,1133) * lu(k,1684) - lu(k,1703) = lu(k,1703) - lu(k,1134) * lu(k,1684) - lu(k,1704) = lu(k,1704) - lu(k,1135) * lu(k,1684) - lu(k,1705) = lu(k,1705) - lu(k,1136) * lu(k,1684) - lu(k,1706) = lu(k,1706) - lu(k,1137) * lu(k,1684) - lu(k,1707) = lu(k,1707) - lu(k,1138) * lu(k,1684) - lu(k,1708) = lu(k,1708) - lu(k,1139) * lu(k,1684) - lu(k,1755) = lu(k,1755) - lu(k,1128) * lu(k,1752) - lu(k,1757) = lu(k,1757) - lu(k,1129) * lu(k,1752) - lu(k,1758) = lu(k,1758) - lu(k,1130) * lu(k,1752) - lu(k,1760) = lu(k,1760) - lu(k,1131) * lu(k,1752) - lu(k,1762) = lu(k,1762) - lu(k,1132) * lu(k,1752) - lu(k,1764) = lu(k,1764) - lu(k,1133) * lu(k,1752) - lu(k,1767) = lu(k,1767) - lu(k,1134) * lu(k,1752) - lu(k,1768) = lu(k,1768) - lu(k,1135) * lu(k,1752) - lu(k,1769) = lu(k,1769) - lu(k,1136) * lu(k,1752) - lu(k,1770) = lu(k,1770) - lu(k,1137) * lu(k,1752) - lu(k,1771) = lu(k,1771) - lu(k,1138) * lu(k,1752) - lu(k,1772) = lu(k,1772) - lu(k,1139) * lu(k,1752) - lu(k,1812) = - lu(k,1128) * lu(k,1805) - lu(k,1814) = lu(k,1814) - lu(k,1129) * lu(k,1805) - lu(k,1815) = lu(k,1815) - lu(k,1130) * lu(k,1805) - lu(k,1817) = lu(k,1817) - lu(k,1131) * lu(k,1805) - lu(k,1819) = lu(k,1819) - lu(k,1132) * lu(k,1805) - lu(k,1821) = lu(k,1821) - lu(k,1133) * lu(k,1805) - lu(k,1824) = lu(k,1824) - lu(k,1134) * lu(k,1805) - lu(k,1825) = - lu(k,1135) * lu(k,1805) - lu(k,1826) = - lu(k,1136) * lu(k,1805) - lu(k,1827) = lu(k,1827) - lu(k,1137) * lu(k,1805) - lu(k,1828) = - lu(k,1138) * lu(k,1805) - lu(k,1829) = lu(k,1829) - lu(k,1139) * lu(k,1805) - lu(k,1922) = lu(k,1922) - lu(k,1128) * lu(k,1915) - lu(k,1924) = lu(k,1924) - lu(k,1129) * lu(k,1915) - lu(k,1925) = lu(k,1925) - lu(k,1130) * lu(k,1915) - lu(k,1927) = lu(k,1927) - lu(k,1131) * lu(k,1915) - lu(k,1929) = lu(k,1929) - lu(k,1132) * lu(k,1915) - lu(k,1931) = lu(k,1931) - lu(k,1133) * lu(k,1915) - lu(k,1934) = lu(k,1934) - lu(k,1134) * lu(k,1915) - lu(k,1935) = lu(k,1935) - lu(k,1135) * lu(k,1915) - lu(k,1936) = lu(k,1936) - lu(k,1136) * lu(k,1915) - lu(k,1937) = lu(k,1937) - lu(k,1137) * lu(k,1915) - lu(k,1938) = lu(k,1938) - lu(k,1138) * lu(k,1915) - lu(k,1939) = lu(k,1939) - lu(k,1139) * lu(k,1915) - lu(k,1946) = lu(k,1946) - lu(k,1128) * lu(k,1945) - lu(k,1948) = - lu(k,1129) * lu(k,1945) - lu(k,1949) = lu(k,1949) - lu(k,1130) * lu(k,1945) - lu(k,1951) = lu(k,1951) - lu(k,1131) * lu(k,1945) - lu(k,1953) = lu(k,1953) - lu(k,1132) * lu(k,1945) - lu(k,1955) = lu(k,1955) - lu(k,1133) * lu(k,1945) - lu(k,1958) = - lu(k,1134) * lu(k,1945) - lu(k,1959) = lu(k,1959) - lu(k,1135) * lu(k,1945) - lu(k,1960) = lu(k,1960) - lu(k,1136) * lu(k,1945) - lu(k,1961) = lu(k,1961) - lu(k,1137) * lu(k,1945) - lu(k,1962) = lu(k,1962) - lu(k,1138) * lu(k,1945) - lu(k,1963) = lu(k,1963) - lu(k,1139) * lu(k,1945) - lu(k,1972) = lu(k,1972) - lu(k,1128) * lu(k,1971) - lu(k,1974) = - lu(k,1129) * lu(k,1971) - lu(k,1975) = lu(k,1975) - lu(k,1130) * lu(k,1971) - lu(k,1977) = lu(k,1977) - lu(k,1131) * lu(k,1971) - lu(k,1979) = lu(k,1979) - lu(k,1132) * lu(k,1971) - lu(k,1981) = lu(k,1981) - lu(k,1133) * lu(k,1971) - lu(k,1984) = - lu(k,1134) * lu(k,1971) - lu(k,1985) = lu(k,1985) - lu(k,1135) * lu(k,1971) - lu(k,1986) = lu(k,1986) - lu(k,1136) * lu(k,1971) - lu(k,1987) = lu(k,1987) - lu(k,1137) * lu(k,1971) - lu(k,1988) = lu(k,1988) - lu(k,1138) * lu(k,1971) - lu(k,1989) = lu(k,1989) - lu(k,1139) * lu(k,1971) - lu(k,2002) = lu(k,2002) - lu(k,1128) * lu(k,2001) - lu(k,2004) = lu(k,2004) - lu(k,1129) * lu(k,2001) - lu(k,2005) = lu(k,2005) - lu(k,1130) * lu(k,2001) - lu(k,2007) = lu(k,2007) - lu(k,1131) * lu(k,2001) - lu(k,2009) = lu(k,2009) - lu(k,1132) * lu(k,2001) - lu(k,2011) = lu(k,2011) - lu(k,1133) * lu(k,2001) - lu(k,2014) = lu(k,2014) - lu(k,1134) * lu(k,2001) - lu(k,2015) = lu(k,2015) - lu(k,1135) * lu(k,2001) - lu(k,2016) = lu(k,2016) - lu(k,1136) * lu(k,2001) - lu(k,2017) = lu(k,2017) - lu(k,1137) * lu(k,2001) - lu(k,2018) = lu(k,2018) - lu(k,1138) * lu(k,2001) - lu(k,2019) = lu(k,2019) - lu(k,1139) * lu(k,2001) - lu(k,2061) = - lu(k,1128) * lu(k,2060) - lu(k,2063) = lu(k,2063) - lu(k,1129) * lu(k,2060) - lu(k,2064) = - lu(k,1130) * lu(k,2060) - lu(k,2066) = lu(k,2066) - lu(k,1131) * lu(k,2060) - lu(k,2068) = lu(k,2068) - lu(k,1132) * lu(k,2060) - lu(k,2070) = - lu(k,1133) * lu(k,2060) - lu(k,2073) = - lu(k,1134) * lu(k,2060) - lu(k,2074) = - lu(k,1135) * lu(k,2060) - lu(k,2075) = - lu(k,1136) * lu(k,2060) - lu(k,2076) = lu(k,2076) - lu(k,1137) * lu(k,2060) - lu(k,2077) = lu(k,2077) - lu(k,1138) * lu(k,2060) - lu(k,2078) = lu(k,2078) - lu(k,1139) * lu(k,2060) + lu(k,1101) = 1._r8 / lu(k,1101) + lu(k,1102) = lu(k,1102) * lu(k,1101) + lu(k,1103) = lu(k,1103) * lu(k,1101) + lu(k,1104) = lu(k,1104) * lu(k,1101) + lu(k,1105) = lu(k,1105) * lu(k,1101) + lu(k,1106) = lu(k,1106) * lu(k,1101) + lu(k,1107) = lu(k,1107) * lu(k,1101) + lu(k,1108) = lu(k,1108) * lu(k,1101) + lu(k,1109) = lu(k,1109) * lu(k,1101) + lu(k,1110) = lu(k,1110) * lu(k,1101) + lu(k,1111) = lu(k,1111) * lu(k,1101) + lu(k,1112) = lu(k,1112) * lu(k,1101) + lu(k,1582) = lu(k,1582) - lu(k,1102) * lu(k,1581) + lu(k,1584) = lu(k,1584) - lu(k,1103) * lu(k,1581) + lu(k,1586) = lu(k,1586) - lu(k,1104) * lu(k,1581) + lu(k,1602) = lu(k,1602) - lu(k,1105) * lu(k,1581) + lu(k,1604) = lu(k,1604) - lu(k,1106) * lu(k,1581) + lu(k,1605) = lu(k,1605) - lu(k,1107) * lu(k,1581) + lu(k,1606) = lu(k,1606) - lu(k,1108) * lu(k,1581) + lu(k,1608) = lu(k,1608) - lu(k,1109) * lu(k,1581) + lu(k,1612) = lu(k,1612) - lu(k,1110) * lu(k,1581) + lu(k,1613) = lu(k,1613) - lu(k,1111) * lu(k,1581) + lu(k,1615) = lu(k,1615) - lu(k,1112) * lu(k,1581) + lu(k,1636) = lu(k,1636) - lu(k,1102) * lu(k,1635) + lu(k,1638) = lu(k,1638) - lu(k,1103) * lu(k,1635) + lu(k,1640) = lu(k,1640) - lu(k,1104) * lu(k,1635) + lu(k,1654) = lu(k,1654) - lu(k,1105) * lu(k,1635) + lu(k,1656) = lu(k,1656) - lu(k,1106) * lu(k,1635) + lu(k,1657) = lu(k,1657) - lu(k,1107) * lu(k,1635) + lu(k,1658) = lu(k,1658) - lu(k,1108) * lu(k,1635) + lu(k,1660) = lu(k,1660) - lu(k,1109) * lu(k,1635) + lu(k,1664) = lu(k,1664) - lu(k,1110) * lu(k,1635) + lu(k,1665) = lu(k,1665) - lu(k,1111) * lu(k,1635) + lu(k,1667) = lu(k,1667) - lu(k,1112) * lu(k,1635) + lu(k,1889) = lu(k,1889) - lu(k,1102) * lu(k,1888) + lu(k,1891) = lu(k,1891) - lu(k,1103) * lu(k,1888) + lu(k,1893) = lu(k,1893) - lu(k,1104) * lu(k,1888) + lu(k,1911) = lu(k,1911) - lu(k,1105) * lu(k,1888) + lu(k,1913) = lu(k,1913) - lu(k,1106) * lu(k,1888) + lu(k,1914) = lu(k,1914) - lu(k,1107) * lu(k,1888) + lu(k,1915) = lu(k,1915) - lu(k,1108) * lu(k,1888) + lu(k,1917) = lu(k,1917) - lu(k,1109) * lu(k,1888) + lu(k,1921) = lu(k,1921) - lu(k,1110) * lu(k,1888) + lu(k,1922) = lu(k,1922) - lu(k,1111) * lu(k,1888) + lu(k,1924) = lu(k,1924) - lu(k,1112) * lu(k,1888) + lu(k,2050) = lu(k,2050) - lu(k,1102) * lu(k,2049) + lu(k,2052) = lu(k,2052) - lu(k,1103) * lu(k,2049) + lu(k,2054) = lu(k,2054) - lu(k,1104) * lu(k,2049) + lu(k,2071) = lu(k,2071) - lu(k,1105) * lu(k,2049) + lu(k,2073) = lu(k,2073) - lu(k,1106) * lu(k,2049) + lu(k,2074) = lu(k,2074) - lu(k,1107) * lu(k,2049) + lu(k,2075) = lu(k,2075) - lu(k,1108) * lu(k,2049) + lu(k,2077) = lu(k,2077) - lu(k,1109) * lu(k,2049) + lu(k,2081) = lu(k,2081) - lu(k,1110) * lu(k,2049) + lu(k,2082) = lu(k,2082) - lu(k,1111) * lu(k,2049) + lu(k,2084) = lu(k,2084) - lu(k,1112) * lu(k,2049) + lu(k,2194) = lu(k,2194) - lu(k,1102) * lu(k,2193) + lu(k,2196) = lu(k,2196) - lu(k,1103) * lu(k,2193) + lu(k,2198) = lu(k,2198) - lu(k,1104) * lu(k,2193) + lu(k,2214) = lu(k,2214) - lu(k,1105) * lu(k,2193) + lu(k,2216) = lu(k,2216) - lu(k,1106) * lu(k,2193) + lu(k,2217) = lu(k,2217) - lu(k,1107) * lu(k,2193) + lu(k,2218) = lu(k,2218) - lu(k,1108) * lu(k,2193) + lu(k,2220) = lu(k,2220) - lu(k,1109) * lu(k,2193) + lu(k,2224) = lu(k,2224) - lu(k,1110) * lu(k,2193) + lu(k,2225) = lu(k,2225) - lu(k,1111) * lu(k,2193) + lu(k,2227) = lu(k,2227) - lu(k,1112) * lu(k,2193) + lu(k,2295) = lu(k,2295) - lu(k,1102) * lu(k,2294) + lu(k,2297) = lu(k,2297) - lu(k,1103) * lu(k,2294) + lu(k,2299) = lu(k,2299) - lu(k,1104) * lu(k,2294) + lu(k,2314) = lu(k,2314) - lu(k,1105) * lu(k,2294) + lu(k,2316) = lu(k,2316) - lu(k,1106) * lu(k,2294) + lu(k,2317) = lu(k,2317) - lu(k,1107) * lu(k,2294) + lu(k,2318) = lu(k,2318) - lu(k,1108) * lu(k,2294) + lu(k,2320) = lu(k,2320) - lu(k,1109) * lu(k,2294) + lu(k,2324) = lu(k,2324) - lu(k,1110) * lu(k,2294) + lu(k,2325) = lu(k,2325) - lu(k,1111) * lu(k,2294) + lu(k,2327) = lu(k,2327) - lu(k,1112) * lu(k,2294) + lu(k,1115) = 1._r8 / lu(k,1115) + lu(k,1116) = lu(k,1116) * lu(k,1115) + lu(k,1117) = lu(k,1117) * lu(k,1115) + lu(k,1118) = lu(k,1118) * lu(k,1115) + lu(k,1119) = lu(k,1119) * lu(k,1115) + lu(k,1120) = lu(k,1120) * lu(k,1115) + lu(k,1121) = lu(k,1121) * lu(k,1115) + lu(k,1122) = lu(k,1122) * lu(k,1115) + lu(k,1123) = lu(k,1123) * lu(k,1115) + lu(k,1124) = lu(k,1124) * lu(k,1115) + lu(k,1153) = lu(k,1153) - lu(k,1116) * lu(k,1152) + lu(k,1156) = lu(k,1156) - lu(k,1117) * lu(k,1152) + lu(k,1157) = lu(k,1157) - lu(k,1118) * lu(k,1152) + lu(k,1160) = lu(k,1160) - lu(k,1119) * lu(k,1152) + lu(k,1162) = lu(k,1162) - lu(k,1120) * lu(k,1152) + lu(k,1163) = lu(k,1163) - lu(k,1121) * lu(k,1152) + lu(k,1164) = lu(k,1164) - lu(k,1122) * lu(k,1152) + lu(k,1165) = lu(k,1165) - lu(k,1123) * lu(k,1152) + lu(k,1166) = lu(k,1166) - lu(k,1124) * lu(k,1152) + lu(k,1584) = lu(k,1584) - lu(k,1116) * lu(k,1582) + lu(k,1587) = lu(k,1587) - lu(k,1117) * lu(k,1582) + lu(k,1599) = lu(k,1599) - lu(k,1118) * lu(k,1582) + lu(k,1605) = lu(k,1605) - lu(k,1119) * lu(k,1582) + lu(k,1608) = lu(k,1608) - lu(k,1120) * lu(k,1582) + lu(k,1611) = lu(k,1611) - lu(k,1121) * lu(k,1582) + lu(k,1612) = lu(k,1612) - lu(k,1122) * lu(k,1582) + lu(k,1615) = lu(k,1615) - lu(k,1123) * lu(k,1582) + lu(k,1618) = lu(k,1618) - lu(k,1124) * lu(k,1582) + lu(k,1638) = lu(k,1638) - lu(k,1116) * lu(k,1636) + lu(k,1641) = lu(k,1641) - lu(k,1117) * lu(k,1636) + lu(k,1652) = lu(k,1652) - lu(k,1118) * lu(k,1636) + lu(k,1657) = lu(k,1657) - lu(k,1119) * lu(k,1636) + lu(k,1660) = lu(k,1660) - lu(k,1120) * lu(k,1636) + lu(k,1663) = lu(k,1663) - lu(k,1121) * lu(k,1636) + lu(k,1664) = lu(k,1664) - lu(k,1122) * lu(k,1636) + lu(k,1667) = lu(k,1667) - lu(k,1123) * lu(k,1636) + lu(k,1670) = lu(k,1670) - lu(k,1124) * lu(k,1636) + lu(k,1891) = lu(k,1891) - lu(k,1116) * lu(k,1889) + lu(k,1894) = lu(k,1894) - lu(k,1117) * lu(k,1889) + lu(k,1907) = lu(k,1907) - lu(k,1118) * lu(k,1889) + lu(k,1914) = lu(k,1914) - lu(k,1119) * lu(k,1889) + lu(k,1917) = lu(k,1917) - lu(k,1120) * lu(k,1889) + lu(k,1920) = lu(k,1920) - lu(k,1121) * lu(k,1889) + lu(k,1921) = lu(k,1921) - lu(k,1122) * lu(k,1889) + lu(k,1924) = lu(k,1924) - lu(k,1123) * lu(k,1889) + lu(k,1927) = lu(k,1927) - lu(k,1124) * lu(k,1889) + lu(k,2052) = lu(k,2052) - lu(k,1116) * lu(k,2050) + lu(k,2055) = lu(k,2055) - lu(k,1117) * lu(k,2050) + lu(k,2068) = lu(k,2068) - lu(k,1118) * lu(k,2050) + lu(k,2074) = lu(k,2074) - lu(k,1119) * lu(k,2050) + lu(k,2077) = lu(k,2077) - lu(k,1120) * lu(k,2050) + lu(k,2080) = lu(k,2080) - lu(k,1121) * lu(k,2050) + lu(k,2081) = lu(k,2081) - lu(k,1122) * lu(k,2050) + lu(k,2084) = lu(k,2084) - lu(k,1123) * lu(k,2050) + lu(k,2087) = lu(k,2087) - lu(k,1124) * lu(k,2050) + lu(k,2196) = lu(k,2196) - lu(k,1116) * lu(k,2194) + lu(k,2199) = lu(k,2199) - lu(k,1117) * lu(k,2194) + lu(k,2210) = lu(k,2210) - lu(k,1118) * lu(k,2194) + lu(k,2217) = lu(k,2217) - lu(k,1119) * lu(k,2194) + lu(k,2220) = lu(k,2220) - lu(k,1120) * lu(k,2194) + lu(k,2223) = lu(k,2223) - lu(k,1121) * lu(k,2194) + lu(k,2224) = lu(k,2224) - lu(k,1122) * lu(k,2194) + lu(k,2227) = lu(k,2227) - lu(k,1123) * lu(k,2194) + lu(k,2230) = lu(k,2230) - lu(k,1124) * lu(k,2194) + lu(k,2297) = lu(k,2297) - lu(k,1116) * lu(k,2295) + lu(k,2300) = lu(k,2300) - lu(k,1117) * lu(k,2295) + lu(k,2311) = lu(k,2311) - lu(k,1118) * lu(k,2295) + lu(k,2317) = lu(k,2317) - lu(k,1119) * lu(k,2295) + lu(k,2320) = lu(k,2320) - lu(k,1120) * lu(k,2295) + lu(k,2323) = lu(k,2323) - lu(k,1121) * lu(k,2295) + lu(k,2324) = lu(k,2324) - lu(k,1122) * lu(k,2295) + lu(k,2327) = lu(k,2327) - lu(k,1123) * lu(k,2295) + lu(k,2330) = lu(k,2330) - lu(k,1124) * lu(k,2295) + lu(k,1125) = 1._r8 / lu(k,1125) + lu(k,1126) = lu(k,1126) * lu(k,1125) + lu(k,1127) = lu(k,1127) * lu(k,1125) + lu(k,1128) = lu(k,1128) * lu(k,1125) + lu(k,1129) = lu(k,1129) * lu(k,1125) + lu(k,1130) = lu(k,1130) * lu(k,1125) + lu(k,1131) = lu(k,1131) * lu(k,1125) + lu(k,1132) = lu(k,1132) * lu(k,1125) + lu(k,1133) = lu(k,1133) * lu(k,1125) + lu(k,1189) = lu(k,1189) - lu(k,1126) * lu(k,1188) + lu(k,1195) = lu(k,1195) - lu(k,1127) * lu(k,1188) + lu(k,1196) = lu(k,1196) - lu(k,1128) * lu(k,1188) + lu(k,1198) = lu(k,1198) - lu(k,1129) * lu(k,1188) + lu(k,1200) = lu(k,1200) - lu(k,1130) * lu(k,1188) + lu(k,1203) = - lu(k,1131) * lu(k,1188) + lu(k,1204) = lu(k,1204) - lu(k,1132) * lu(k,1188) + lu(k,1205) = lu(k,1205) - lu(k,1133) * lu(k,1188) + lu(k,1368) = lu(k,1368) - lu(k,1126) * lu(k,1367) + lu(k,1374) = lu(k,1374) - lu(k,1127) * lu(k,1367) + lu(k,1376) = - lu(k,1128) * lu(k,1367) + lu(k,1378) = lu(k,1378) - lu(k,1129) * lu(k,1367) + lu(k,1380) = lu(k,1380) - lu(k,1130) * lu(k,1367) + lu(k,1383) = lu(k,1383) - lu(k,1131) * lu(k,1367) + lu(k,1384) = lu(k,1384) - lu(k,1132) * lu(k,1367) + lu(k,1386) = lu(k,1386) - lu(k,1133) * lu(k,1367) + lu(k,1584) = lu(k,1584) - lu(k,1126) * lu(k,1583) + lu(k,1599) = lu(k,1599) - lu(k,1127) * lu(k,1583) + lu(k,1602) = lu(k,1602) - lu(k,1128) * lu(k,1583) + lu(k,1605) = lu(k,1605) - lu(k,1129) * lu(k,1583) + lu(k,1608) = lu(k,1608) - lu(k,1130) * lu(k,1583) + lu(k,1613) = lu(k,1613) - lu(k,1131) * lu(k,1583) + lu(k,1615) = lu(k,1615) - lu(k,1132) * lu(k,1583) + lu(k,1618) = lu(k,1618) - lu(k,1133) * lu(k,1583) + lu(k,1638) = lu(k,1638) - lu(k,1126) * lu(k,1637) + lu(k,1652) = lu(k,1652) - lu(k,1127) * lu(k,1637) + lu(k,1654) = lu(k,1654) - lu(k,1128) * lu(k,1637) + lu(k,1657) = lu(k,1657) - lu(k,1129) * lu(k,1637) + lu(k,1660) = lu(k,1660) - lu(k,1130) * lu(k,1637) + lu(k,1665) = lu(k,1665) - lu(k,1131) * lu(k,1637) + lu(k,1667) = lu(k,1667) - lu(k,1132) * lu(k,1637) + lu(k,1670) = lu(k,1670) - lu(k,1133) * lu(k,1637) + lu(k,1891) = lu(k,1891) - lu(k,1126) * lu(k,1890) + lu(k,1907) = lu(k,1907) - lu(k,1127) * lu(k,1890) + lu(k,1911) = lu(k,1911) - lu(k,1128) * lu(k,1890) + lu(k,1914) = lu(k,1914) - lu(k,1129) * lu(k,1890) + lu(k,1917) = lu(k,1917) - lu(k,1130) * lu(k,1890) + lu(k,1922) = lu(k,1922) - lu(k,1131) * lu(k,1890) + lu(k,1924) = lu(k,1924) - lu(k,1132) * lu(k,1890) + lu(k,1927) = lu(k,1927) - lu(k,1133) * lu(k,1890) + lu(k,2052) = lu(k,2052) - lu(k,1126) * lu(k,2051) + lu(k,2068) = lu(k,2068) - lu(k,1127) * lu(k,2051) + lu(k,2071) = lu(k,2071) - lu(k,1128) * lu(k,2051) + lu(k,2074) = lu(k,2074) - lu(k,1129) * lu(k,2051) + lu(k,2077) = lu(k,2077) - lu(k,1130) * lu(k,2051) + lu(k,2082) = lu(k,2082) - lu(k,1131) * lu(k,2051) + lu(k,2084) = lu(k,2084) - lu(k,1132) * lu(k,2051) + lu(k,2087) = lu(k,2087) - lu(k,1133) * lu(k,2051) + lu(k,2196) = lu(k,2196) - lu(k,1126) * lu(k,2195) + lu(k,2210) = lu(k,2210) - lu(k,1127) * lu(k,2195) + lu(k,2214) = lu(k,2214) - lu(k,1128) * lu(k,2195) + lu(k,2217) = lu(k,2217) - lu(k,1129) * lu(k,2195) + lu(k,2220) = lu(k,2220) - lu(k,1130) * lu(k,2195) + lu(k,2225) = lu(k,2225) - lu(k,1131) * lu(k,2195) + lu(k,2227) = lu(k,2227) - lu(k,1132) * lu(k,2195) + lu(k,2230) = lu(k,2230) - lu(k,1133) * lu(k,2195) + lu(k,2247) = lu(k,2247) - lu(k,1126) * lu(k,2246) + lu(k,2249) = - lu(k,1127) * lu(k,2246) + lu(k,2253) = lu(k,2253) - lu(k,1128) * lu(k,2246) + lu(k,2256) = lu(k,2256) - lu(k,1129) * lu(k,2246) + lu(k,2259) = lu(k,2259) - lu(k,1130) * lu(k,2246) + lu(k,2264) = lu(k,2264) - lu(k,1131) * lu(k,2246) + lu(k,2266) = lu(k,2266) - lu(k,1132) * lu(k,2246) + lu(k,2269) = lu(k,2269) - lu(k,1133) * lu(k,2246) + lu(k,2297) = lu(k,2297) - lu(k,1126) * lu(k,2296) + lu(k,2311) = lu(k,2311) - lu(k,1127) * lu(k,2296) + lu(k,2314) = lu(k,2314) - lu(k,1128) * lu(k,2296) + lu(k,2317) = lu(k,2317) - lu(k,1129) * lu(k,2296) + lu(k,2320) = lu(k,2320) - lu(k,1130) * lu(k,2296) + lu(k,2325) = lu(k,2325) - lu(k,1131) * lu(k,2296) + lu(k,2327) = lu(k,2327) - lu(k,1132) * lu(k,2296) + lu(k,2330) = lu(k,2330) - lu(k,1133) * lu(k,2296) + lu(k,1135) = 1._r8 / lu(k,1135) + lu(k,1136) = lu(k,1136) * lu(k,1135) + lu(k,1137) = lu(k,1137) * lu(k,1135) + lu(k,1138) = lu(k,1138) * lu(k,1135) + lu(k,1143) = lu(k,1143) - lu(k,1136) * lu(k,1141) + lu(k,1144) = lu(k,1144) - lu(k,1137) * lu(k,1141) + lu(k,1146) = lu(k,1146) - lu(k,1138) * lu(k,1141) + lu(k,1162) = lu(k,1162) - lu(k,1136) * lu(k,1153) + lu(k,1163) = lu(k,1163) - lu(k,1137) * lu(k,1153) + lu(k,1165) = lu(k,1165) - lu(k,1138) * lu(k,1153) + lu(k,1200) = lu(k,1200) - lu(k,1136) * lu(k,1189) + lu(k,1201) = - lu(k,1137) * lu(k,1189) + lu(k,1204) = lu(k,1204) - lu(k,1138) * lu(k,1189) + lu(k,1219) = lu(k,1219) - lu(k,1136) * lu(k,1210) + lu(k,1220) = lu(k,1220) - lu(k,1137) * lu(k,1210) + lu(k,1223) = lu(k,1223) - lu(k,1138) * lu(k,1210) + lu(k,1242) = lu(k,1242) - lu(k,1136) * lu(k,1230) + lu(k,1243) = lu(k,1243) - lu(k,1137) * lu(k,1230) + lu(k,1246) = lu(k,1246) - lu(k,1138) * lu(k,1230) + lu(k,1254) = lu(k,1254) - lu(k,1136) * lu(k,1248) + lu(k,1255) = lu(k,1255) - lu(k,1137) * lu(k,1248) + lu(k,1257) = lu(k,1257) - lu(k,1138) * lu(k,1248) + lu(k,1264) = lu(k,1264) - lu(k,1136) * lu(k,1260) + lu(k,1265) = - lu(k,1137) * lu(k,1260) + lu(k,1267) = lu(k,1267) - lu(k,1138) * lu(k,1260) + lu(k,1305) = lu(k,1305) - lu(k,1136) * lu(k,1289) + lu(k,1306) = lu(k,1306) - lu(k,1137) * lu(k,1289) + lu(k,1309) = lu(k,1309) - lu(k,1138) * lu(k,1289) + lu(k,1337) = lu(k,1337) - lu(k,1136) * lu(k,1321) + lu(k,1338) = lu(k,1338) - lu(k,1137) * lu(k,1321) + lu(k,1341) = lu(k,1341) - lu(k,1138) * lu(k,1321) + lu(k,1358) = lu(k,1358) - lu(k,1136) * lu(k,1346) + lu(k,1359) = - lu(k,1137) * lu(k,1346) + lu(k,1362) = lu(k,1362) - lu(k,1138) * lu(k,1346) + lu(k,1380) = lu(k,1380) - lu(k,1136) * lu(k,1368) + lu(k,1381) = lu(k,1381) - lu(k,1137) * lu(k,1368) + lu(k,1384) = lu(k,1384) - lu(k,1138) * lu(k,1368) + lu(k,1400) = lu(k,1400) - lu(k,1136) * lu(k,1391) + lu(k,1401) = lu(k,1401) - lu(k,1137) * lu(k,1391) + lu(k,1404) = lu(k,1404) - lu(k,1138) * lu(k,1391) + lu(k,1432) = lu(k,1432) - lu(k,1136) * lu(k,1414) + lu(k,1433) = lu(k,1433) - lu(k,1137) * lu(k,1414) + lu(k,1436) = lu(k,1436) - lu(k,1138) * lu(k,1414) + lu(k,1458) = lu(k,1458) - lu(k,1136) * lu(k,1454) + lu(k,1459) = lu(k,1459) - lu(k,1137) * lu(k,1454) + lu(k,1462) = lu(k,1462) - lu(k,1138) * lu(k,1454) + lu(k,1475) = lu(k,1475) - lu(k,1136) * lu(k,1468) + lu(k,1477) = lu(k,1477) - lu(k,1137) * lu(k,1468) + lu(k,1480) = lu(k,1480) - lu(k,1138) * lu(k,1468) + lu(k,1608) = lu(k,1608) - lu(k,1136) * lu(k,1584) + lu(k,1611) = lu(k,1611) - lu(k,1137) * lu(k,1584) + lu(k,1615) = lu(k,1615) - lu(k,1138) * lu(k,1584) + lu(k,1660) = lu(k,1660) - lu(k,1136) * lu(k,1638) + lu(k,1663) = lu(k,1663) - lu(k,1137) * lu(k,1638) + lu(k,1667) = lu(k,1667) - lu(k,1138) * lu(k,1638) + lu(k,1704) = lu(k,1704) - lu(k,1136) * lu(k,1690) + lu(k,1707) = lu(k,1707) - lu(k,1137) * lu(k,1690) + lu(k,1711) = lu(k,1711) - lu(k,1138) * lu(k,1690) + lu(k,1917) = lu(k,1917) - lu(k,1136) * lu(k,1891) + lu(k,1920) = lu(k,1920) - lu(k,1137) * lu(k,1891) + lu(k,1924) = lu(k,1924) - lu(k,1138) * lu(k,1891) + lu(k,1996) = lu(k,1996) - lu(k,1136) * lu(k,1985) + lu(k,1999) = lu(k,1999) - lu(k,1137) * lu(k,1985) + lu(k,2003) = lu(k,2003) - lu(k,1138) * lu(k,1985) + lu(k,2020) = lu(k,2020) - lu(k,1136) * lu(k,2010) + lu(k,2023) = lu(k,2023) - lu(k,1137) * lu(k,2010) + lu(k,2027) = lu(k,2027) - lu(k,1138) * lu(k,2010) + lu(k,2077) = lu(k,2077) - lu(k,1136) * lu(k,2052) + lu(k,2080) = lu(k,2080) - lu(k,1137) * lu(k,2052) + lu(k,2084) = lu(k,2084) - lu(k,1138) * lu(k,2052) + lu(k,2220) = lu(k,2220) - lu(k,1136) * lu(k,2196) + lu(k,2223) = lu(k,2223) - lu(k,1137) * lu(k,2196) + lu(k,2227) = lu(k,2227) - lu(k,1138) * lu(k,2196) + lu(k,2259) = lu(k,2259) - lu(k,1136) * lu(k,2247) + lu(k,2262) = lu(k,2262) - lu(k,1137) * lu(k,2247) + lu(k,2266) = lu(k,2266) - lu(k,1138) * lu(k,2247) + lu(k,2320) = lu(k,2320) - lu(k,1136) * lu(k,2297) + lu(k,2323) = lu(k,2323) - lu(k,1137) * lu(k,2297) + lu(k,2327) = lu(k,2327) - lu(k,1138) * lu(k,2297) + lu(k,1142) = 1._r8 / lu(k,1142) + lu(k,1143) = lu(k,1143) * lu(k,1142) + lu(k,1144) = lu(k,1144) * lu(k,1142) + lu(k,1145) = lu(k,1145) * lu(k,1142) + lu(k,1146) = lu(k,1146) * lu(k,1142) + lu(k,1162) = lu(k,1162) - lu(k,1143) * lu(k,1154) + lu(k,1163) = lu(k,1163) - lu(k,1144) * lu(k,1154) + lu(k,1164) = lu(k,1164) - lu(k,1145) * lu(k,1154) + lu(k,1165) = lu(k,1165) - lu(k,1146) * lu(k,1154) + lu(k,1200) = lu(k,1200) - lu(k,1143) * lu(k,1190) + lu(k,1201) = lu(k,1201) - lu(k,1144) * lu(k,1190) + lu(k,1202) = lu(k,1202) - lu(k,1145) * lu(k,1190) + lu(k,1204) = lu(k,1204) - lu(k,1146) * lu(k,1190) + lu(k,1219) = lu(k,1219) - lu(k,1143) * lu(k,1211) + lu(k,1220) = lu(k,1220) - lu(k,1144) * lu(k,1211) + lu(k,1221) = lu(k,1221) - lu(k,1145) * lu(k,1211) + lu(k,1223) = lu(k,1223) - lu(k,1146) * lu(k,1211) + lu(k,1242) = lu(k,1242) - lu(k,1143) * lu(k,1231) + lu(k,1243) = lu(k,1243) - lu(k,1144) * lu(k,1231) + lu(k,1244) = lu(k,1244) - lu(k,1145) * lu(k,1231) + lu(k,1246) = lu(k,1246) - lu(k,1146) * lu(k,1231) + lu(k,1305) = lu(k,1305) - lu(k,1143) * lu(k,1290) + lu(k,1306) = lu(k,1306) - lu(k,1144) * lu(k,1290) + lu(k,1307) = lu(k,1307) - lu(k,1145) * lu(k,1290) + lu(k,1309) = lu(k,1309) - lu(k,1146) * lu(k,1290) + lu(k,1337) = lu(k,1337) - lu(k,1143) * lu(k,1322) + lu(k,1338) = lu(k,1338) - lu(k,1144) * lu(k,1322) + lu(k,1339) = lu(k,1339) - lu(k,1145) * lu(k,1322) + lu(k,1341) = lu(k,1341) - lu(k,1146) * lu(k,1322) + lu(k,1358) = lu(k,1358) - lu(k,1143) * lu(k,1347) + lu(k,1359) = lu(k,1359) - lu(k,1144) * lu(k,1347) + lu(k,1360) = lu(k,1360) - lu(k,1145) * lu(k,1347) + lu(k,1362) = lu(k,1362) - lu(k,1146) * lu(k,1347) + lu(k,1432) = lu(k,1432) - lu(k,1143) * lu(k,1415) + lu(k,1433) = lu(k,1433) - lu(k,1144) * lu(k,1415) + lu(k,1434) = lu(k,1434) - lu(k,1145) * lu(k,1415) + lu(k,1436) = lu(k,1436) - lu(k,1146) * lu(k,1415) + lu(k,1608) = lu(k,1608) - lu(k,1143) * lu(k,1585) + lu(k,1611) = lu(k,1611) - lu(k,1144) * lu(k,1585) + lu(k,1612) = lu(k,1612) - lu(k,1145) * lu(k,1585) + lu(k,1615) = lu(k,1615) - lu(k,1146) * lu(k,1585) + lu(k,1660) = lu(k,1660) - lu(k,1143) * lu(k,1639) + lu(k,1663) = lu(k,1663) - lu(k,1144) * lu(k,1639) + lu(k,1664) = lu(k,1664) - lu(k,1145) * lu(k,1639) + lu(k,1667) = lu(k,1667) - lu(k,1146) * lu(k,1639) + lu(k,1917) = lu(k,1917) - lu(k,1143) * lu(k,1892) + lu(k,1920) = lu(k,1920) - lu(k,1144) * lu(k,1892) + lu(k,1921) = lu(k,1921) - lu(k,1145) * lu(k,1892) + lu(k,1924) = lu(k,1924) - lu(k,1146) * lu(k,1892) + lu(k,2077) = lu(k,2077) - lu(k,1143) * lu(k,2053) + lu(k,2080) = lu(k,2080) - lu(k,1144) * lu(k,2053) + lu(k,2081) = lu(k,2081) - lu(k,1145) * lu(k,2053) + lu(k,2084) = lu(k,2084) - lu(k,1146) * lu(k,2053) + lu(k,2220) = lu(k,2220) - lu(k,1143) * lu(k,2197) + lu(k,2223) = lu(k,2223) - lu(k,1144) * lu(k,2197) + lu(k,2224) = lu(k,2224) - lu(k,1145) * lu(k,2197) + lu(k,2227) = lu(k,2227) - lu(k,1146) * lu(k,2197) + lu(k,2259) = lu(k,2259) - lu(k,1143) * lu(k,2248) + lu(k,2262) = lu(k,2262) - lu(k,1144) * lu(k,2248) + lu(k,2263) = lu(k,2263) - lu(k,1145) * lu(k,2248) + lu(k,2266) = lu(k,2266) - lu(k,1146) * lu(k,2248) + lu(k,2320) = lu(k,2320) - lu(k,1143) * lu(k,2298) + lu(k,2323) = lu(k,2323) - lu(k,1144) * lu(k,2298) + lu(k,2324) = lu(k,2324) - lu(k,1145) * lu(k,2298) + lu(k,2327) = lu(k,2327) - lu(k,1146) * lu(k,2298) + lu(k,1155) = 1._r8 / lu(k,1155) + lu(k,1156) = lu(k,1156) * lu(k,1155) + lu(k,1157) = lu(k,1157) * lu(k,1155) + lu(k,1158) = lu(k,1158) * lu(k,1155) + lu(k,1159) = lu(k,1159) * lu(k,1155) + lu(k,1160) = lu(k,1160) * lu(k,1155) + lu(k,1161) = lu(k,1161) * lu(k,1155) + lu(k,1162) = lu(k,1162) * lu(k,1155) + lu(k,1163) = lu(k,1163) * lu(k,1155) + lu(k,1164) = lu(k,1164) * lu(k,1155) + lu(k,1165) = lu(k,1165) * lu(k,1155) + lu(k,1166) = lu(k,1166) * lu(k,1155) + lu(k,1587) = lu(k,1587) - lu(k,1156) * lu(k,1586) + lu(k,1599) = lu(k,1599) - lu(k,1157) * lu(k,1586) + lu(k,1602) = lu(k,1602) - lu(k,1158) * lu(k,1586) + lu(k,1604) = lu(k,1604) - lu(k,1159) * lu(k,1586) + lu(k,1605) = lu(k,1605) - lu(k,1160) * lu(k,1586) + lu(k,1606) = lu(k,1606) - lu(k,1161) * lu(k,1586) + lu(k,1608) = lu(k,1608) - lu(k,1162) * lu(k,1586) + lu(k,1611) = lu(k,1611) - lu(k,1163) * lu(k,1586) + lu(k,1612) = lu(k,1612) - lu(k,1164) * lu(k,1586) + lu(k,1615) = lu(k,1615) - lu(k,1165) * lu(k,1586) + lu(k,1618) = lu(k,1618) - lu(k,1166) * lu(k,1586) + lu(k,1641) = lu(k,1641) - lu(k,1156) * lu(k,1640) + lu(k,1652) = lu(k,1652) - lu(k,1157) * lu(k,1640) + lu(k,1654) = lu(k,1654) - lu(k,1158) * lu(k,1640) + lu(k,1656) = lu(k,1656) - lu(k,1159) * lu(k,1640) + lu(k,1657) = lu(k,1657) - lu(k,1160) * lu(k,1640) + lu(k,1658) = lu(k,1658) - lu(k,1161) * lu(k,1640) + lu(k,1660) = lu(k,1660) - lu(k,1162) * lu(k,1640) + lu(k,1663) = lu(k,1663) - lu(k,1163) * lu(k,1640) + lu(k,1664) = lu(k,1664) - lu(k,1164) * lu(k,1640) + lu(k,1667) = lu(k,1667) - lu(k,1165) * lu(k,1640) + lu(k,1670) = lu(k,1670) - lu(k,1166) * lu(k,1640) + lu(k,1894) = lu(k,1894) - lu(k,1156) * lu(k,1893) + lu(k,1907) = lu(k,1907) - lu(k,1157) * lu(k,1893) + lu(k,1911) = lu(k,1911) - lu(k,1158) * lu(k,1893) + lu(k,1913) = lu(k,1913) - lu(k,1159) * lu(k,1893) + lu(k,1914) = lu(k,1914) - lu(k,1160) * lu(k,1893) + lu(k,1915) = lu(k,1915) - lu(k,1161) * lu(k,1893) + lu(k,1917) = lu(k,1917) - lu(k,1162) * lu(k,1893) + lu(k,1920) = lu(k,1920) - lu(k,1163) * lu(k,1893) + lu(k,1921) = lu(k,1921) - lu(k,1164) * lu(k,1893) + lu(k,1924) = lu(k,1924) - lu(k,1165) * lu(k,1893) + lu(k,1927) = lu(k,1927) - lu(k,1166) * lu(k,1893) + lu(k,2055) = lu(k,2055) - lu(k,1156) * lu(k,2054) + lu(k,2068) = lu(k,2068) - lu(k,1157) * lu(k,2054) + lu(k,2071) = lu(k,2071) - lu(k,1158) * lu(k,2054) + lu(k,2073) = lu(k,2073) - lu(k,1159) * lu(k,2054) + lu(k,2074) = lu(k,2074) - lu(k,1160) * lu(k,2054) + lu(k,2075) = lu(k,2075) - lu(k,1161) * lu(k,2054) + lu(k,2077) = lu(k,2077) - lu(k,1162) * lu(k,2054) + lu(k,2080) = lu(k,2080) - lu(k,1163) * lu(k,2054) + lu(k,2081) = lu(k,2081) - lu(k,1164) * lu(k,2054) + lu(k,2084) = lu(k,2084) - lu(k,1165) * lu(k,2054) + lu(k,2087) = lu(k,2087) - lu(k,1166) * lu(k,2054) + lu(k,2199) = lu(k,2199) - lu(k,1156) * lu(k,2198) + lu(k,2210) = lu(k,2210) - lu(k,1157) * lu(k,2198) + lu(k,2214) = lu(k,2214) - lu(k,1158) * lu(k,2198) + lu(k,2216) = lu(k,2216) - lu(k,1159) * lu(k,2198) + lu(k,2217) = lu(k,2217) - lu(k,1160) * lu(k,2198) + lu(k,2218) = lu(k,2218) - lu(k,1161) * lu(k,2198) + lu(k,2220) = lu(k,2220) - lu(k,1162) * lu(k,2198) + lu(k,2223) = lu(k,2223) - lu(k,1163) * lu(k,2198) + lu(k,2224) = lu(k,2224) - lu(k,1164) * lu(k,2198) + lu(k,2227) = lu(k,2227) - lu(k,1165) * lu(k,2198) + lu(k,2230) = lu(k,2230) - lu(k,1166) * lu(k,2198) + lu(k,2300) = lu(k,2300) - lu(k,1156) * lu(k,2299) + lu(k,2311) = lu(k,2311) - lu(k,1157) * lu(k,2299) + lu(k,2314) = lu(k,2314) - lu(k,1158) * lu(k,2299) + lu(k,2316) = lu(k,2316) - lu(k,1159) * lu(k,2299) + lu(k,2317) = lu(k,2317) - lu(k,1160) * lu(k,2299) + lu(k,2318) = lu(k,2318) - lu(k,1161) * lu(k,2299) + lu(k,2320) = lu(k,2320) - lu(k,1162) * lu(k,2299) + lu(k,2323) = lu(k,2323) - lu(k,1163) * lu(k,2299) + lu(k,2324) = lu(k,2324) - lu(k,1164) * lu(k,2299) + lu(k,2327) = lu(k,2327) - lu(k,1165) * lu(k,2299) + lu(k,2330) = lu(k,2330) - lu(k,1166) * lu(k,2299) end do end subroutine lu_fac23 subroutine lu_fac24( avec_len, lu ) @@ -4979,459 +4462,459 @@ subroutine lu_fac24( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1152) = 1._r8 / lu(k,1152) - lu(k,1153) = lu(k,1153) * lu(k,1152) - lu(k,1154) = lu(k,1154) * lu(k,1152) - lu(k,1155) = lu(k,1155) * lu(k,1152) - lu(k,1156) = lu(k,1156) * lu(k,1152) - lu(k,1157) = lu(k,1157) * lu(k,1152) - lu(k,1158) = lu(k,1158) * lu(k,1152) - lu(k,1159) = lu(k,1159) * lu(k,1152) - lu(k,1160) = lu(k,1160) * lu(k,1152) - lu(k,1161) = lu(k,1161) * lu(k,1152) - lu(k,1162) = lu(k,1162) * lu(k,1152) - lu(k,1163) = lu(k,1163) * lu(k,1152) - lu(k,1164) = lu(k,1164) * lu(k,1152) - lu(k,1165) = lu(k,1165) * lu(k,1152) - lu(k,1166) = lu(k,1166) * lu(k,1152) - lu(k,1167) = lu(k,1167) * lu(k,1152) - lu(k,1276) = lu(k,1276) - lu(k,1153) * lu(k,1275) - lu(k,1277) = lu(k,1277) - lu(k,1154) * lu(k,1275) - lu(k,1279) = lu(k,1279) - lu(k,1155) * lu(k,1275) - lu(k,1280) = lu(k,1280) - lu(k,1156) * lu(k,1275) - lu(k,1281) = lu(k,1281) - lu(k,1157) * lu(k,1275) - lu(k,1282) = lu(k,1282) - lu(k,1158) * lu(k,1275) - lu(k,1283) = lu(k,1283) - lu(k,1159) * lu(k,1275) - lu(k,1284) = lu(k,1284) - lu(k,1160) * lu(k,1275) - lu(k,1285) = lu(k,1285) - lu(k,1161) * lu(k,1275) - lu(k,1286) = lu(k,1286) - lu(k,1162) * lu(k,1275) - lu(k,1287) = lu(k,1287) - lu(k,1163) * lu(k,1275) - lu(k,1288) = lu(k,1288) - lu(k,1164) * lu(k,1275) - lu(k,1289) = lu(k,1289) - lu(k,1165) * lu(k,1275) - lu(k,1290) = lu(k,1290) - lu(k,1166) * lu(k,1275) - lu(k,1291) = lu(k,1291) - lu(k,1167) * lu(k,1275) - lu(k,1387) = lu(k,1387) - lu(k,1153) * lu(k,1386) - lu(k,1388) = lu(k,1388) - lu(k,1154) * lu(k,1386) - lu(k,1390) = lu(k,1390) - lu(k,1155) * lu(k,1386) - lu(k,1391) = lu(k,1391) - lu(k,1156) * lu(k,1386) - lu(k,1393) = lu(k,1393) - lu(k,1157) * lu(k,1386) - lu(k,1394) = lu(k,1394) - lu(k,1158) * lu(k,1386) - lu(k,1395) = lu(k,1395) - lu(k,1159) * lu(k,1386) - lu(k,1397) = lu(k,1397) - lu(k,1160) * lu(k,1386) - lu(k,1399) = lu(k,1399) - lu(k,1161) * lu(k,1386) - lu(k,1400) = lu(k,1400) - lu(k,1162) * lu(k,1386) - lu(k,1401) = lu(k,1401) - lu(k,1163) * lu(k,1386) - lu(k,1402) = lu(k,1402) - lu(k,1164) * lu(k,1386) - lu(k,1403) = lu(k,1403) - lu(k,1165) * lu(k,1386) - lu(k,1404) = lu(k,1404) - lu(k,1166) * lu(k,1386) - lu(k,1409) = lu(k,1409) - lu(k,1167) * lu(k,1386) - lu(k,1503) = lu(k,1503) - lu(k,1153) * lu(k,1502) - lu(k,1504) = lu(k,1504) - lu(k,1154) * lu(k,1502) - lu(k,1506) = lu(k,1506) - lu(k,1155) * lu(k,1502) - lu(k,1507) = lu(k,1507) - lu(k,1156) * lu(k,1502) - lu(k,1509) = lu(k,1509) - lu(k,1157) * lu(k,1502) - lu(k,1510) = lu(k,1510) - lu(k,1158) * lu(k,1502) - lu(k,1511) = lu(k,1511) - lu(k,1159) * lu(k,1502) - lu(k,1513) = lu(k,1513) - lu(k,1160) * lu(k,1502) - lu(k,1515) = lu(k,1515) - lu(k,1161) * lu(k,1502) - lu(k,1516) = lu(k,1516) - lu(k,1162) * lu(k,1502) - lu(k,1517) = lu(k,1517) - lu(k,1163) * lu(k,1502) - lu(k,1518) = lu(k,1518) - lu(k,1164) * lu(k,1502) - lu(k,1519) = lu(k,1519) - lu(k,1165) * lu(k,1502) - lu(k,1520) = lu(k,1520) - lu(k,1166) * lu(k,1502) - lu(k,1525) = lu(k,1525) - lu(k,1167) * lu(k,1502) - lu(k,1686) = lu(k,1686) - lu(k,1153) * lu(k,1685) - lu(k,1687) = lu(k,1687) - lu(k,1154) * lu(k,1685) - lu(k,1689) = lu(k,1689) - lu(k,1155) * lu(k,1685) - lu(k,1690) = lu(k,1690) - lu(k,1156) * lu(k,1685) - lu(k,1692) = lu(k,1692) - lu(k,1157) * lu(k,1685) - lu(k,1693) = lu(k,1693) - lu(k,1158) * lu(k,1685) - lu(k,1694) = lu(k,1694) - lu(k,1159) * lu(k,1685) - lu(k,1696) = lu(k,1696) - lu(k,1160) * lu(k,1685) - lu(k,1698) = lu(k,1698) - lu(k,1161) * lu(k,1685) - lu(k,1699) = lu(k,1699) - lu(k,1162) * lu(k,1685) - lu(k,1700) = lu(k,1700) - lu(k,1163) * lu(k,1685) - lu(k,1701) = lu(k,1701) - lu(k,1164) * lu(k,1685) - lu(k,1702) = lu(k,1702) - lu(k,1165) * lu(k,1685) - lu(k,1703) = lu(k,1703) - lu(k,1166) * lu(k,1685) - lu(k,1708) = lu(k,1708) - lu(k,1167) * lu(k,1685) - lu(k,1807) = lu(k,1807) - lu(k,1153) * lu(k,1806) - lu(k,1808) = lu(k,1808) - lu(k,1154) * lu(k,1806) - lu(k,1810) = lu(k,1810) - lu(k,1155) * lu(k,1806) - lu(k,1811) = lu(k,1811) - lu(k,1156) * lu(k,1806) - lu(k,1813) = lu(k,1813) - lu(k,1157) * lu(k,1806) - lu(k,1814) = lu(k,1814) - lu(k,1158) * lu(k,1806) - lu(k,1815) = lu(k,1815) - lu(k,1159) * lu(k,1806) - lu(k,1817) = lu(k,1817) - lu(k,1160) * lu(k,1806) - lu(k,1819) = lu(k,1819) - lu(k,1161) * lu(k,1806) - lu(k,1820) = lu(k,1820) - lu(k,1162) * lu(k,1806) - lu(k,1821) = lu(k,1821) - lu(k,1163) * lu(k,1806) - lu(k,1822) = lu(k,1822) - lu(k,1164) * lu(k,1806) - lu(k,1823) = lu(k,1823) - lu(k,1165) * lu(k,1806) - lu(k,1824) = lu(k,1824) - lu(k,1166) * lu(k,1806) - lu(k,1829) = lu(k,1829) - lu(k,1167) * lu(k,1806) - lu(k,1858) = lu(k,1858) - lu(k,1153) * lu(k,1857) - lu(k,1859) = lu(k,1859) - lu(k,1154) * lu(k,1857) - lu(k,1861) = lu(k,1861) - lu(k,1155) * lu(k,1857) - lu(k,1862) = lu(k,1862) - lu(k,1156) * lu(k,1857) - lu(k,1863) = lu(k,1863) - lu(k,1157) * lu(k,1857) - lu(k,1864) = lu(k,1864) - lu(k,1158) * lu(k,1857) - lu(k,1865) = lu(k,1865) - lu(k,1159) * lu(k,1857) - lu(k,1867) = lu(k,1867) - lu(k,1160) * lu(k,1857) - lu(k,1869) = lu(k,1869) - lu(k,1161) * lu(k,1857) - lu(k,1870) = lu(k,1870) - lu(k,1162) * lu(k,1857) - lu(k,1871) = lu(k,1871) - lu(k,1163) * lu(k,1857) - lu(k,1872) = lu(k,1872) - lu(k,1164) * lu(k,1857) - lu(k,1873) = lu(k,1873) - lu(k,1165) * lu(k,1857) - lu(k,1874) = lu(k,1874) - lu(k,1166) * lu(k,1857) - lu(k,1879) = lu(k,1879) - lu(k,1167) * lu(k,1857) - lu(k,1917) = lu(k,1917) - lu(k,1153) * lu(k,1916) - lu(k,1918) = lu(k,1918) - lu(k,1154) * lu(k,1916) - lu(k,1920) = lu(k,1920) - lu(k,1155) * lu(k,1916) - lu(k,1921) = lu(k,1921) - lu(k,1156) * lu(k,1916) - lu(k,1923) = lu(k,1923) - lu(k,1157) * lu(k,1916) - lu(k,1924) = lu(k,1924) - lu(k,1158) * lu(k,1916) - lu(k,1925) = lu(k,1925) - lu(k,1159) * lu(k,1916) - lu(k,1927) = lu(k,1927) - lu(k,1160) * lu(k,1916) - lu(k,1929) = lu(k,1929) - lu(k,1161) * lu(k,1916) - lu(k,1930) = lu(k,1930) - lu(k,1162) * lu(k,1916) - lu(k,1931) = lu(k,1931) - lu(k,1163) * lu(k,1916) - lu(k,1932) = lu(k,1932) - lu(k,1164) * lu(k,1916) - lu(k,1933) = lu(k,1933) - lu(k,1165) * lu(k,1916) - lu(k,1934) = lu(k,1934) - lu(k,1166) * lu(k,1916) - lu(k,1939) = lu(k,1939) - lu(k,1167) * lu(k,1916) - lu(k,1174) = 1._r8 / lu(k,1174) - lu(k,1175) = lu(k,1175) * lu(k,1174) - lu(k,1176) = lu(k,1176) * lu(k,1174) - lu(k,1177) = lu(k,1177) * lu(k,1174) - lu(k,1178) = lu(k,1178) * lu(k,1174) - lu(k,1179) = lu(k,1179) * lu(k,1174) - lu(k,1180) = lu(k,1180) * lu(k,1174) - lu(k,1181) = lu(k,1181) * lu(k,1174) - lu(k,1182) = lu(k,1182) * lu(k,1174) - lu(k,1183) = lu(k,1183) * lu(k,1174) - lu(k,1184) = lu(k,1184) * lu(k,1174) - lu(k,1185) = lu(k,1185) * lu(k,1174) - lu(k,1186) = lu(k,1186) * lu(k,1174) - lu(k,1187) = lu(k,1187) * lu(k,1174) - lu(k,1229) = lu(k,1229) - lu(k,1175) * lu(k,1228) - lu(k,1232) = lu(k,1232) - lu(k,1176) * lu(k,1228) - lu(k,1233) = lu(k,1233) - lu(k,1177) * lu(k,1228) - lu(k,1234) = lu(k,1234) - lu(k,1178) * lu(k,1228) - lu(k,1235) = lu(k,1235) - lu(k,1179) * lu(k,1228) - lu(k,1236) = lu(k,1236) - lu(k,1180) * lu(k,1228) - lu(k,1237) = lu(k,1237) - lu(k,1181) * lu(k,1228) - lu(k,1238) = lu(k,1238) - lu(k,1182) * lu(k,1228) - lu(k,1239) = lu(k,1239) - lu(k,1183) * lu(k,1228) - lu(k,1240) = lu(k,1240) - lu(k,1184) * lu(k,1228) - lu(k,1241) = lu(k,1241) - lu(k,1185) * lu(k,1228) - lu(k,1242) = lu(k,1242) - lu(k,1186) * lu(k,1228) - lu(k,1243) = lu(k,1243) - lu(k,1187) * lu(k,1228) - lu(k,1277) = lu(k,1277) - lu(k,1175) * lu(k,1276) - lu(k,1280) = lu(k,1280) - lu(k,1176) * lu(k,1276) - lu(k,1281) = lu(k,1281) - lu(k,1177) * lu(k,1276) - lu(k,1282) = lu(k,1282) - lu(k,1178) * lu(k,1276) - lu(k,1283) = lu(k,1283) - lu(k,1179) * lu(k,1276) - lu(k,1284) = lu(k,1284) - lu(k,1180) * lu(k,1276) - lu(k,1285) = lu(k,1285) - lu(k,1181) * lu(k,1276) - lu(k,1286) = lu(k,1286) - lu(k,1182) * lu(k,1276) - lu(k,1287) = lu(k,1287) - lu(k,1183) * lu(k,1276) - lu(k,1288) = lu(k,1288) - lu(k,1184) * lu(k,1276) - lu(k,1289) = lu(k,1289) - lu(k,1185) * lu(k,1276) - lu(k,1290) = lu(k,1290) - lu(k,1186) * lu(k,1276) - lu(k,1291) = lu(k,1291) - lu(k,1187) * lu(k,1276) - lu(k,1388) = lu(k,1388) - lu(k,1175) * lu(k,1387) - lu(k,1391) = lu(k,1391) - lu(k,1176) * lu(k,1387) - lu(k,1393) = lu(k,1393) - lu(k,1177) * lu(k,1387) - lu(k,1394) = lu(k,1394) - lu(k,1178) * lu(k,1387) - lu(k,1395) = lu(k,1395) - lu(k,1179) * lu(k,1387) - lu(k,1397) = lu(k,1397) - lu(k,1180) * lu(k,1387) - lu(k,1399) = lu(k,1399) - lu(k,1181) * lu(k,1387) - lu(k,1400) = lu(k,1400) - lu(k,1182) * lu(k,1387) - lu(k,1401) = lu(k,1401) - lu(k,1183) * lu(k,1387) - lu(k,1402) = lu(k,1402) - lu(k,1184) * lu(k,1387) - lu(k,1403) = lu(k,1403) - lu(k,1185) * lu(k,1387) - lu(k,1404) = lu(k,1404) - lu(k,1186) * lu(k,1387) - lu(k,1409) = lu(k,1409) - lu(k,1187) * lu(k,1387) - lu(k,1504) = lu(k,1504) - lu(k,1175) * lu(k,1503) - lu(k,1507) = lu(k,1507) - lu(k,1176) * lu(k,1503) - lu(k,1509) = lu(k,1509) - lu(k,1177) * lu(k,1503) - lu(k,1510) = lu(k,1510) - lu(k,1178) * lu(k,1503) - lu(k,1511) = lu(k,1511) - lu(k,1179) * lu(k,1503) - lu(k,1513) = lu(k,1513) - lu(k,1180) * lu(k,1503) - lu(k,1515) = lu(k,1515) - lu(k,1181) * lu(k,1503) - lu(k,1516) = lu(k,1516) - lu(k,1182) * lu(k,1503) - lu(k,1517) = lu(k,1517) - lu(k,1183) * lu(k,1503) - lu(k,1518) = lu(k,1518) - lu(k,1184) * lu(k,1503) - lu(k,1519) = lu(k,1519) - lu(k,1185) * lu(k,1503) - lu(k,1520) = lu(k,1520) - lu(k,1186) * lu(k,1503) - lu(k,1525) = lu(k,1525) - lu(k,1187) * lu(k,1503) - lu(k,1687) = lu(k,1687) - lu(k,1175) * lu(k,1686) - lu(k,1690) = lu(k,1690) - lu(k,1176) * lu(k,1686) - lu(k,1692) = lu(k,1692) - lu(k,1177) * lu(k,1686) - lu(k,1693) = lu(k,1693) - lu(k,1178) * lu(k,1686) - lu(k,1694) = lu(k,1694) - lu(k,1179) * lu(k,1686) - lu(k,1696) = lu(k,1696) - lu(k,1180) * lu(k,1686) - lu(k,1698) = lu(k,1698) - lu(k,1181) * lu(k,1686) - lu(k,1699) = lu(k,1699) - lu(k,1182) * lu(k,1686) - lu(k,1700) = lu(k,1700) - lu(k,1183) * lu(k,1686) - lu(k,1701) = lu(k,1701) - lu(k,1184) * lu(k,1686) - lu(k,1702) = lu(k,1702) - lu(k,1185) * lu(k,1686) - lu(k,1703) = lu(k,1703) - lu(k,1186) * lu(k,1686) - lu(k,1708) = lu(k,1708) - lu(k,1187) * lu(k,1686) - lu(k,1808) = lu(k,1808) - lu(k,1175) * lu(k,1807) - lu(k,1811) = lu(k,1811) - lu(k,1176) * lu(k,1807) - lu(k,1813) = lu(k,1813) - lu(k,1177) * lu(k,1807) - lu(k,1814) = lu(k,1814) - lu(k,1178) * lu(k,1807) - lu(k,1815) = lu(k,1815) - lu(k,1179) * lu(k,1807) - lu(k,1817) = lu(k,1817) - lu(k,1180) * lu(k,1807) - lu(k,1819) = lu(k,1819) - lu(k,1181) * lu(k,1807) - lu(k,1820) = lu(k,1820) - lu(k,1182) * lu(k,1807) - lu(k,1821) = lu(k,1821) - lu(k,1183) * lu(k,1807) - lu(k,1822) = lu(k,1822) - lu(k,1184) * lu(k,1807) - lu(k,1823) = lu(k,1823) - lu(k,1185) * lu(k,1807) - lu(k,1824) = lu(k,1824) - lu(k,1186) * lu(k,1807) - lu(k,1829) = lu(k,1829) - lu(k,1187) * lu(k,1807) - lu(k,1859) = lu(k,1859) - lu(k,1175) * lu(k,1858) - lu(k,1862) = lu(k,1862) - lu(k,1176) * lu(k,1858) - lu(k,1863) = lu(k,1863) - lu(k,1177) * lu(k,1858) - lu(k,1864) = lu(k,1864) - lu(k,1178) * lu(k,1858) - lu(k,1865) = lu(k,1865) - lu(k,1179) * lu(k,1858) - lu(k,1867) = lu(k,1867) - lu(k,1180) * lu(k,1858) - lu(k,1869) = lu(k,1869) - lu(k,1181) * lu(k,1858) - lu(k,1870) = lu(k,1870) - lu(k,1182) * lu(k,1858) - lu(k,1871) = lu(k,1871) - lu(k,1183) * lu(k,1858) - lu(k,1872) = lu(k,1872) - lu(k,1184) * lu(k,1858) - lu(k,1873) = lu(k,1873) - lu(k,1185) * lu(k,1858) - lu(k,1874) = lu(k,1874) - lu(k,1186) * lu(k,1858) - lu(k,1879) = lu(k,1879) - lu(k,1187) * lu(k,1858) - lu(k,1918) = lu(k,1918) - lu(k,1175) * lu(k,1917) - lu(k,1921) = lu(k,1921) - lu(k,1176) * lu(k,1917) - lu(k,1923) = lu(k,1923) - lu(k,1177) * lu(k,1917) - lu(k,1924) = lu(k,1924) - lu(k,1178) * lu(k,1917) - lu(k,1925) = lu(k,1925) - lu(k,1179) * lu(k,1917) - lu(k,1927) = lu(k,1927) - lu(k,1180) * lu(k,1917) - lu(k,1929) = lu(k,1929) - lu(k,1181) * lu(k,1917) - lu(k,1930) = lu(k,1930) - lu(k,1182) * lu(k,1917) - lu(k,1931) = lu(k,1931) - lu(k,1183) * lu(k,1917) - lu(k,1932) = lu(k,1932) - lu(k,1184) * lu(k,1917) - lu(k,1933) = lu(k,1933) - lu(k,1185) * lu(k,1917) - lu(k,1934) = lu(k,1934) - lu(k,1186) * lu(k,1917) - lu(k,1939) = lu(k,1939) - lu(k,1187) * lu(k,1917) - lu(k,1197) = 1._r8 / lu(k,1197) - lu(k,1198) = lu(k,1198) * lu(k,1197) - lu(k,1199) = lu(k,1199) * lu(k,1197) - lu(k,1200) = lu(k,1200) * lu(k,1197) - lu(k,1201) = lu(k,1201) * lu(k,1197) - lu(k,1202) = lu(k,1202) * lu(k,1197) - lu(k,1203) = lu(k,1203) * lu(k,1197) - lu(k,1204) = lu(k,1204) * lu(k,1197) - lu(k,1205) = lu(k,1205) * lu(k,1197) - lu(k,1206) = lu(k,1206) * lu(k,1197) - lu(k,1207) = lu(k,1207) * lu(k,1197) - lu(k,1208) = lu(k,1208) * lu(k,1197) - lu(k,1209) = lu(k,1209) * lu(k,1197) - lu(k,1231) = lu(k,1231) - lu(k,1198) * lu(k,1229) - lu(k,1232) = lu(k,1232) - lu(k,1199) * lu(k,1229) - lu(k,1233) = lu(k,1233) - lu(k,1200) * lu(k,1229) - lu(k,1234) = lu(k,1234) - lu(k,1201) * lu(k,1229) - lu(k,1235) = lu(k,1235) - lu(k,1202) * lu(k,1229) - lu(k,1236) = lu(k,1236) - lu(k,1203) * lu(k,1229) - lu(k,1237) = lu(k,1237) - lu(k,1204) * lu(k,1229) - lu(k,1238) = lu(k,1238) - lu(k,1205) * lu(k,1229) - lu(k,1239) = lu(k,1239) - lu(k,1206) * lu(k,1229) - lu(k,1240) = lu(k,1240) - lu(k,1207) * lu(k,1229) - lu(k,1241) = lu(k,1241) - lu(k,1208) * lu(k,1229) - lu(k,1243) = lu(k,1243) - lu(k,1209) * lu(k,1229) - lu(k,1279) = lu(k,1279) - lu(k,1198) * lu(k,1277) - lu(k,1280) = lu(k,1280) - lu(k,1199) * lu(k,1277) - lu(k,1281) = lu(k,1281) - lu(k,1200) * lu(k,1277) - lu(k,1282) = lu(k,1282) - lu(k,1201) * lu(k,1277) - lu(k,1283) = lu(k,1283) - lu(k,1202) * lu(k,1277) - lu(k,1284) = lu(k,1284) - lu(k,1203) * lu(k,1277) - lu(k,1285) = lu(k,1285) - lu(k,1204) * lu(k,1277) - lu(k,1286) = lu(k,1286) - lu(k,1205) * lu(k,1277) - lu(k,1287) = lu(k,1287) - lu(k,1206) * lu(k,1277) - lu(k,1288) = lu(k,1288) - lu(k,1207) * lu(k,1277) - lu(k,1289) = lu(k,1289) - lu(k,1208) * lu(k,1277) - lu(k,1291) = lu(k,1291) - lu(k,1209) * lu(k,1277) - lu(k,1390) = lu(k,1390) - lu(k,1198) * lu(k,1388) - lu(k,1391) = lu(k,1391) - lu(k,1199) * lu(k,1388) - lu(k,1393) = lu(k,1393) - lu(k,1200) * lu(k,1388) - lu(k,1394) = lu(k,1394) - lu(k,1201) * lu(k,1388) - lu(k,1395) = lu(k,1395) - lu(k,1202) * lu(k,1388) - lu(k,1397) = lu(k,1397) - lu(k,1203) * lu(k,1388) - lu(k,1399) = lu(k,1399) - lu(k,1204) * lu(k,1388) - lu(k,1400) = lu(k,1400) - lu(k,1205) * lu(k,1388) - lu(k,1401) = lu(k,1401) - lu(k,1206) * lu(k,1388) - lu(k,1402) = lu(k,1402) - lu(k,1207) * lu(k,1388) - lu(k,1403) = lu(k,1403) - lu(k,1208) * lu(k,1388) - lu(k,1409) = lu(k,1409) - lu(k,1209) * lu(k,1388) - lu(k,1506) = lu(k,1506) - lu(k,1198) * lu(k,1504) - lu(k,1507) = lu(k,1507) - lu(k,1199) * lu(k,1504) - lu(k,1509) = lu(k,1509) - lu(k,1200) * lu(k,1504) - lu(k,1510) = lu(k,1510) - lu(k,1201) * lu(k,1504) - lu(k,1511) = lu(k,1511) - lu(k,1202) * lu(k,1504) - lu(k,1513) = lu(k,1513) - lu(k,1203) * lu(k,1504) - lu(k,1515) = lu(k,1515) - lu(k,1204) * lu(k,1504) - lu(k,1516) = lu(k,1516) - lu(k,1205) * lu(k,1504) - lu(k,1517) = lu(k,1517) - lu(k,1206) * lu(k,1504) - lu(k,1518) = lu(k,1518) - lu(k,1207) * lu(k,1504) - lu(k,1519) = lu(k,1519) - lu(k,1208) * lu(k,1504) - lu(k,1525) = lu(k,1525) - lu(k,1209) * lu(k,1504) - lu(k,1689) = lu(k,1689) - lu(k,1198) * lu(k,1687) - lu(k,1690) = lu(k,1690) - lu(k,1199) * lu(k,1687) - lu(k,1692) = lu(k,1692) - lu(k,1200) * lu(k,1687) - lu(k,1693) = lu(k,1693) - lu(k,1201) * lu(k,1687) - lu(k,1694) = lu(k,1694) - lu(k,1202) * lu(k,1687) - lu(k,1696) = lu(k,1696) - lu(k,1203) * lu(k,1687) - lu(k,1698) = lu(k,1698) - lu(k,1204) * lu(k,1687) - lu(k,1699) = lu(k,1699) - lu(k,1205) * lu(k,1687) - lu(k,1700) = lu(k,1700) - lu(k,1206) * lu(k,1687) - lu(k,1701) = lu(k,1701) - lu(k,1207) * lu(k,1687) - lu(k,1702) = lu(k,1702) - lu(k,1208) * lu(k,1687) - lu(k,1708) = lu(k,1708) - lu(k,1209) * lu(k,1687) - lu(k,1810) = lu(k,1810) - lu(k,1198) * lu(k,1808) - lu(k,1811) = lu(k,1811) - lu(k,1199) * lu(k,1808) - lu(k,1813) = lu(k,1813) - lu(k,1200) * lu(k,1808) - lu(k,1814) = lu(k,1814) - lu(k,1201) * lu(k,1808) - lu(k,1815) = lu(k,1815) - lu(k,1202) * lu(k,1808) - lu(k,1817) = lu(k,1817) - lu(k,1203) * lu(k,1808) - lu(k,1819) = lu(k,1819) - lu(k,1204) * lu(k,1808) - lu(k,1820) = lu(k,1820) - lu(k,1205) * lu(k,1808) - lu(k,1821) = lu(k,1821) - lu(k,1206) * lu(k,1808) - lu(k,1822) = lu(k,1822) - lu(k,1207) * lu(k,1808) - lu(k,1823) = lu(k,1823) - lu(k,1208) * lu(k,1808) - lu(k,1829) = lu(k,1829) - lu(k,1209) * lu(k,1808) - lu(k,1861) = lu(k,1861) - lu(k,1198) * lu(k,1859) - lu(k,1862) = lu(k,1862) - lu(k,1199) * lu(k,1859) - lu(k,1863) = lu(k,1863) - lu(k,1200) * lu(k,1859) - lu(k,1864) = lu(k,1864) - lu(k,1201) * lu(k,1859) - lu(k,1865) = lu(k,1865) - lu(k,1202) * lu(k,1859) - lu(k,1867) = lu(k,1867) - lu(k,1203) * lu(k,1859) - lu(k,1869) = lu(k,1869) - lu(k,1204) * lu(k,1859) - lu(k,1870) = lu(k,1870) - lu(k,1205) * lu(k,1859) - lu(k,1871) = lu(k,1871) - lu(k,1206) * lu(k,1859) - lu(k,1872) = lu(k,1872) - lu(k,1207) * lu(k,1859) - lu(k,1873) = lu(k,1873) - lu(k,1208) * lu(k,1859) - lu(k,1879) = lu(k,1879) - lu(k,1209) * lu(k,1859) - lu(k,1920) = lu(k,1920) - lu(k,1198) * lu(k,1918) - lu(k,1921) = lu(k,1921) - lu(k,1199) * lu(k,1918) - lu(k,1923) = lu(k,1923) - lu(k,1200) * lu(k,1918) - lu(k,1924) = lu(k,1924) - lu(k,1201) * lu(k,1918) - lu(k,1925) = lu(k,1925) - lu(k,1202) * lu(k,1918) - lu(k,1927) = lu(k,1927) - lu(k,1203) * lu(k,1918) - lu(k,1929) = lu(k,1929) - lu(k,1204) * lu(k,1918) - lu(k,1930) = lu(k,1930) - lu(k,1205) * lu(k,1918) - lu(k,1931) = lu(k,1931) - lu(k,1206) * lu(k,1918) - lu(k,1932) = lu(k,1932) - lu(k,1207) * lu(k,1918) - lu(k,1933) = lu(k,1933) - lu(k,1208) * lu(k,1918) - lu(k,1939) = lu(k,1939) - lu(k,1209) * lu(k,1918) - lu(k,1230) = 1._r8 / lu(k,1230) - lu(k,1231) = lu(k,1231) * lu(k,1230) - lu(k,1232) = lu(k,1232) * lu(k,1230) - lu(k,1233) = lu(k,1233) * lu(k,1230) - lu(k,1234) = lu(k,1234) * lu(k,1230) - lu(k,1235) = lu(k,1235) * lu(k,1230) - lu(k,1236) = lu(k,1236) * lu(k,1230) - lu(k,1237) = lu(k,1237) * lu(k,1230) - lu(k,1238) = lu(k,1238) * lu(k,1230) - lu(k,1239) = lu(k,1239) * lu(k,1230) - lu(k,1240) = lu(k,1240) * lu(k,1230) - lu(k,1241) = lu(k,1241) * lu(k,1230) - lu(k,1242) = lu(k,1242) * lu(k,1230) - lu(k,1243) = lu(k,1243) * lu(k,1230) - lu(k,1279) = lu(k,1279) - lu(k,1231) * lu(k,1278) - lu(k,1280) = lu(k,1280) - lu(k,1232) * lu(k,1278) - lu(k,1281) = lu(k,1281) - lu(k,1233) * lu(k,1278) - lu(k,1282) = lu(k,1282) - lu(k,1234) * lu(k,1278) - lu(k,1283) = lu(k,1283) - lu(k,1235) * lu(k,1278) - lu(k,1284) = lu(k,1284) - lu(k,1236) * lu(k,1278) - lu(k,1285) = lu(k,1285) - lu(k,1237) * lu(k,1278) - lu(k,1286) = lu(k,1286) - lu(k,1238) * lu(k,1278) - lu(k,1287) = lu(k,1287) - lu(k,1239) * lu(k,1278) - lu(k,1288) = lu(k,1288) - lu(k,1240) * lu(k,1278) - lu(k,1289) = lu(k,1289) - lu(k,1241) * lu(k,1278) - lu(k,1290) = lu(k,1290) - lu(k,1242) * lu(k,1278) - lu(k,1291) = lu(k,1291) - lu(k,1243) * lu(k,1278) - lu(k,1390) = lu(k,1390) - lu(k,1231) * lu(k,1389) - lu(k,1391) = lu(k,1391) - lu(k,1232) * lu(k,1389) - lu(k,1393) = lu(k,1393) - lu(k,1233) * lu(k,1389) - lu(k,1394) = lu(k,1394) - lu(k,1234) * lu(k,1389) - lu(k,1395) = lu(k,1395) - lu(k,1235) * lu(k,1389) - lu(k,1397) = lu(k,1397) - lu(k,1236) * lu(k,1389) - lu(k,1399) = lu(k,1399) - lu(k,1237) * lu(k,1389) - lu(k,1400) = lu(k,1400) - lu(k,1238) * lu(k,1389) - lu(k,1401) = lu(k,1401) - lu(k,1239) * lu(k,1389) - lu(k,1402) = lu(k,1402) - lu(k,1240) * lu(k,1389) - lu(k,1403) = lu(k,1403) - lu(k,1241) * lu(k,1389) - lu(k,1404) = lu(k,1404) - lu(k,1242) * lu(k,1389) - lu(k,1409) = lu(k,1409) - lu(k,1243) * lu(k,1389) - lu(k,1506) = lu(k,1506) - lu(k,1231) * lu(k,1505) - lu(k,1507) = lu(k,1507) - lu(k,1232) * lu(k,1505) - lu(k,1509) = lu(k,1509) - lu(k,1233) * lu(k,1505) - lu(k,1510) = lu(k,1510) - lu(k,1234) * lu(k,1505) - lu(k,1511) = lu(k,1511) - lu(k,1235) * lu(k,1505) - lu(k,1513) = lu(k,1513) - lu(k,1236) * lu(k,1505) - lu(k,1515) = lu(k,1515) - lu(k,1237) * lu(k,1505) - lu(k,1516) = lu(k,1516) - lu(k,1238) * lu(k,1505) - lu(k,1517) = lu(k,1517) - lu(k,1239) * lu(k,1505) - lu(k,1518) = lu(k,1518) - lu(k,1240) * lu(k,1505) - lu(k,1519) = lu(k,1519) - lu(k,1241) * lu(k,1505) - lu(k,1520) = lu(k,1520) - lu(k,1242) * lu(k,1505) - lu(k,1525) = lu(k,1525) - lu(k,1243) * lu(k,1505) - lu(k,1689) = lu(k,1689) - lu(k,1231) * lu(k,1688) - lu(k,1690) = lu(k,1690) - lu(k,1232) * lu(k,1688) - lu(k,1692) = lu(k,1692) - lu(k,1233) * lu(k,1688) - lu(k,1693) = lu(k,1693) - lu(k,1234) * lu(k,1688) - lu(k,1694) = lu(k,1694) - lu(k,1235) * lu(k,1688) - lu(k,1696) = lu(k,1696) - lu(k,1236) * lu(k,1688) - lu(k,1698) = lu(k,1698) - lu(k,1237) * lu(k,1688) - lu(k,1699) = lu(k,1699) - lu(k,1238) * lu(k,1688) - lu(k,1700) = lu(k,1700) - lu(k,1239) * lu(k,1688) - lu(k,1701) = lu(k,1701) - lu(k,1240) * lu(k,1688) - lu(k,1702) = lu(k,1702) - lu(k,1241) * lu(k,1688) - lu(k,1703) = lu(k,1703) - lu(k,1242) * lu(k,1688) - lu(k,1708) = lu(k,1708) - lu(k,1243) * lu(k,1688) - lu(k,1810) = lu(k,1810) - lu(k,1231) * lu(k,1809) - lu(k,1811) = lu(k,1811) - lu(k,1232) * lu(k,1809) - lu(k,1813) = lu(k,1813) - lu(k,1233) * lu(k,1809) - lu(k,1814) = lu(k,1814) - lu(k,1234) * lu(k,1809) - lu(k,1815) = lu(k,1815) - lu(k,1235) * lu(k,1809) - lu(k,1817) = lu(k,1817) - lu(k,1236) * lu(k,1809) - lu(k,1819) = lu(k,1819) - lu(k,1237) * lu(k,1809) - lu(k,1820) = lu(k,1820) - lu(k,1238) * lu(k,1809) - lu(k,1821) = lu(k,1821) - lu(k,1239) * lu(k,1809) - lu(k,1822) = lu(k,1822) - lu(k,1240) * lu(k,1809) - lu(k,1823) = lu(k,1823) - lu(k,1241) * lu(k,1809) - lu(k,1824) = lu(k,1824) - lu(k,1242) * lu(k,1809) - lu(k,1829) = lu(k,1829) - lu(k,1243) * lu(k,1809) - lu(k,1861) = lu(k,1861) - lu(k,1231) * lu(k,1860) - lu(k,1862) = lu(k,1862) - lu(k,1232) * lu(k,1860) - lu(k,1863) = lu(k,1863) - lu(k,1233) * lu(k,1860) - lu(k,1864) = lu(k,1864) - lu(k,1234) * lu(k,1860) - lu(k,1865) = lu(k,1865) - lu(k,1235) * lu(k,1860) - lu(k,1867) = lu(k,1867) - lu(k,1236) * lu(k,1860) - lu(k,1869) = lu(k,1869) - lu(k,1237) * lu(k,1860) - lu(k,1870) = lu(k,1870) - lu(k,1238) * lu(k,1860) - lu(k,1871) = lu(k,1871) - lu(k,1239) * lu(k,1860) - lu(k,1872) = lu(k,1872) - lu(k,1240) * lu(k,1860) - lu(k,1873) = lu(k,1873) - lu(k,1241) * lu(k,1860) - lu(k,1874) = lu(k,1874) - lu(k,1242) * lu(k,1860) - lu(k,1879) = lu(k,1879) - lu(k,1243) * lu(k,1860) - lu(k,1920) = lu(k,1920) - lu(k,1231) * lu(k,1919) - lu(k,1921) = lu(k,1921) - lu(k,1232) * lu(k,1919) - lu(k,1923) = lu(k,1923) - lu(k,1233) * lu(k,1919) - lu(k,1924) = lu(k,1924) - lu(k,1234) * lu(k,1919) - lu(k,1925) = lu(k,1925) - lu(k,1235) * lu(k,1919) - lu(k,1927) = lu(k,1927) - lu(k,1236) * lu(k,1919) - lu(k,1929) = lu(k,1929) - lu(k,1237) * lu(k,1919) - lu(k,1930) = lu(k,1930) - lu(k,1238) * lu(k,1919) - lu(k,1931) = lu(k,1931) - lu(k,1239) * lu(k,1919) - lu(k,1932) = lu(k,1932) - lu(k,1240) * lu(k,1919) - lu(k,1933) = lu(k,1933) - lu(k,1241) * lu(k,1919) - lu(k,1934) = lu(k,1934) - lu(k,1242) * lu(k,1919) - lu(k,1939) = lu(k,1939) - lu(k,1243) * lu(k,1919) + lu(k,1169) = 1._r8 / lu(k,1169) + lu(k,1170) = lu(k,1170) * lu(k,1169) + lu(k,1171) = lu(k,1171) * lu(k,1169) + lu(k,1172) = lu(k,1172) * lu(k,1169) + lu(k,1173) = lu(k,1173) * lu(k,1169) + lu(k,1174) = lu(k,1174) * lu(k,1169) + lu(k,1175) = lu(k,1175) * lu(k,1169) + lu(k,1176) = lu(k,1176) * lu(k,1169) + lu(k,1177) = lu(k,1177) * lu(k,1169) + lu(k,1178) = lu(k,1178) * lu(k,1169) + lu(k,1179) = lu(k,1179) * lu(k,1169) + lu(k,1192) = lu(k,1192) - lu(k,1170) * lu(k,1191) + lu(k,1194) = - lu(k,1171) * lu(k,1191) + lu(k,1195) = lu(k,1195) - lu(k,1172) * lu(k,1191) + lu(k,1197) = - lu(k,1173) * lu(k,1191) + lu(k,1198) = lu(k,1198) - lu(k,1174) * lu(k,1191) + lu(k,1199) = lu(k,1199) - lu(k,1175) * lu(k,1191) + lu(k,1200) = lu(k,1200) - lu(k,1176) * lu(k,1191) + lu(k,1202) = lu(k,1202) - lu(k,1177) * lu(k,1191) + lu(k,1204) = lu(k,1204) - lu(k,1178) * lu(k,1191) + lu(k,1205) = lu(k,1205) - lu(k,1179) * lu(k,1191) + lu(k,1588) = lu(k,1588) - lu(k,1170) * lu(k,1587) + lu(k,1593) = lu(k,1593) - lu(k,1171) * lu(k,1587) + lu(k,1599) = lu(k,1599) - lu(k,1172) * lu(k,1587) + lu(k,1604) = lu(k,1604) - lu(k,1173) * lu(k,1587) + lu(k,1605) = lu(k,1605) - lu(k,1174) * lu(k,1587) + lu(k,1606) = lu(k,1606) - lu(k,1175) * lu(k,1587) + lu(k,1608) = lu(k,1608) - lu(k,1176) * lu(k,1587) + lu(k,1612) = lu(k,1612) - lu(k,1177) * lu(k,1587) + lu(k,1615) = lu(k,1615) - lu(k,1178) * lu(k,1587) + lu(k,1618) = lu(k,1618) - lu(k,1179) * lu(k,1587) + lu(k,1642) = lu(k,1642) - lu(k,1170) * lu(k,1641) + lu(k,1646) = lu(k,1646) - lu(k,1171) * lu(k,1641) + lu(k,1652) = lu(k,1652) - lu(k,1172) * lu(k,1641) + lu(k,1656) = lu(k,1656) - lu(k,1173) * lu(k,1641) + lu(k,1657) = lu(k,1657) - lu(k,1174) * lu(k,1641) + lu(k,1658) = lu(k,1658) - lu(k,1175) * lu(k,1641) + lu(k,1660) = lu(k,1660) - lu(k,1176) * lu(k,1641) + lu(k,1664) = lu(k,1664) - lu(k,1177) * lu(k,1641) + lu(k,1667) = lu(k,1667) - lu(k,1178) * lu(k,1641) + lu(k,1670) = lu(k,1670) - lu(k,1179) * lu(k,1641) + lu(k,1895) = lu(k,1895) - lu(k,1170) * lu(k,1894) + lu(k,1900) = lu(k,1900) - lu(k,1171) * lu(k,1894) + lu(k,1907) = lu(k,1907) - lu(k,1172) * lu(k,1894) + lu(k,1913) = lu(k,1913) - lu(k,1173) * lu(k,1894) + lu(k,1914) = lu(k,1914) - lu(k,1174) * lu(k,1894) + lu(k,1915) = lu(k,1915) - lu(k,1175) * lu(k,1894) + lu(k,1917) = lu(k,1917) - lu(k,1176) * lu(k,1894) + lu(k,1921) = lu(k,1921) - lu(k,1177) * lu(k,1894) + lu(k,1924) = lu(k,1924) - lu(k,1178) * lu(k,1894) + lu(k,1927) = lu(k,1927) - lu(k,1179) * lu(k,1894) + lu(k,2056) = lu(k,2056) - lu(k,1170) * lu(k,2055) + lu(k,2061) = lu(k,2061) - lu(k,1171) * lu(k,2055) + lu(k,2068) = lu(k,2068) - lu(k,1172) * lu(k,2055) + lu(k,2073) = lu(k,2073) - lu(k,1173) * lu(k,2055) + lu(k,2074) = lu(k,2074) - lu(k,1174) * lu(k,2055) + lu(k,2075) = lu(k,2075) - lu(k,1175) * lu(k,2055) + lu(k,2077) = lu(k,2077) - lu(k,1176) * lu(k,2055) + lu(k,2081) = lu(k,2081) - lu(k,1177) * lu(k,2055) + lu(k,2084) = lu(k,2084) - lu(k,1178) * lu(k,2055) + lu(k,2087) = lu(k,2087) - lu(k,1179) * lu(k,2055) + lu(k,2200) = lu(k,2200) - lu(k,1170) * lu(k,2199) + lu(k,2204) = lu(k,2204) - lu(k,1171) * lu(k,2199) + lu(k,2210) = lu(k,2210) - lu(k,1172) * lu(k,2199) + lu(k,2216) = lu(k,2216) - lu(k,1173) * lu(k,2199) + lu(k,2217) = lu(k,2217) - lu(k,1174) * lu(k,2199) + lu(k,2218) = lu(k,2218) - lu(k,1175) * lu(k,2199) + lu(k,2220) = lu(k,2220) - lu(k,1176) * lu(k,2199) + lu(k,2224) = lu(k,2224) - lu(k,1177) * lu(k,2199) + lu(k,2227) = lu(k,2227) - lu(k,1178) * lu(k,2199) + lu(k,2230) = lu(k,2230) - lu(k,1179) * lu(k,2199) + lu(k,2301) = lu(k,2301) - lu(k,1170) * lu(k,2300) + lu(k,2304) = lu(k,2304) - lu(k,1171) * lu(k,2300) + lu(k,2311) = lu(k,2311) - lu(k,1172) * lu(k,2300) + lu(k,2316) = lu(k,2316) - lu(k,1173) * lu(k,2300) + lu(k,2317) = lu(k,2317) - lu(k,1174) * lu(k,2300) + lu(k,2318) = lu(k,2318) - lu(k,1175) * lu(k,2300) + lu(k,2320) = lu(k,2320) - lu(k,1176) * lu(k,2300) + lu(k,2324) = lu(k,2324) - lu(k,1177) * lu(k,2300) + lu(k,2327) = lu(k,2327) - lu(k,1178) * lu(k,2300) + lu(k,2330) = lu(k,2330) - lu(k,1179) * lu(k,2300) + lu(k,1180) = 1._r8 / lu(k,1180) + lu(k,1181) = lu(k,1181) * lu(k,1180) + lu(k,1182) = lu(k,1182) * lu(k,1180) + lu(k,1183) = lu(k,1183) * lu(k,1180) + lu(k,1184) = lu(k,1184) * lu(k,1180) + lu(k,1185) = lu(k,1185) * lu(k,1180) + lu(k,1194) = lu(k,1194) - lu(k,1181) * lu(k,1192) + lu(k,1195) = lu(k,1195) - lu(k,1182) * lu(k,1192) + lu(k,1200) = lu(k,1200) - lu(k,1183) * lu(k,1192) + lu(k,1202) = lu(k,1202) - lu(k,1184) * lu(k,1192) + lu(k,1204) = lu(k,1204) - lu(k,1185) * lu(k,1192) + lu(k,1214) = lu(k,1214) - lu(k,1181) * lu(k,1212) + lu(k,1215) = lu(k,1215) - lu(k,1182) * lu(k,1212) + lu(k,1219) = lu(k,1219) - lu(k,1183) * lu(k,1212) + lu(k,1221) = lu(k,1221) - lu(k,1184) * lu(k,1212) + lu(k,1223) = lu(k,1223) - lu(k,1185) * lu(k,1212) + lu(k,1295) = - lu(k,1181) * lu(k,1291) + lu(k,1300) = lu(k,1300) - lu(k,1182) * lu(k,1291) + lu(k,1305) = lu(k,1305) - lu(k,1183) * lu(k,1291) + lu(k,1307) = lu(k,1307) - lu(k,1184) * lu(k,1291) + lu(k,1309) = lu(k,1309) - lu(k,1185) * lu(k,1291) + lu(k,1327) = lu(k,1327) - lu(k,1181) * lu(k,1323) + lu(k,1332) = lu(k,1332) - lu(k,1182) * lu(k,1323) + lu(k,1337) = lu(k,1337) - lu(k,1183) * lu(k,1323) + lu(k,1339) = lu(k,1339) - lu(k,1184) * lu(k,1323) + lu(k,1341) = lu(k,1341) - lu(k,1185) * lu(k,1323) + lu(k,1350) = lu(k,1350) - lu(k,1181) * lu(k,1348) + lu(k,1353) = lu(k,1353) - lu(k,1182) * lu(k,1348) + lu(k,1358) = lu(k,1358) - lu(k,1183) * lu(k,1348) + lu(k,1360) = lu(k,1360) - lu(k,1184) * lu(k,1348) + lu(k,1362) = lu(k,1362) - lu(k,1185) * lu(k,1348) + lu(k,1370) = lu(k,1370) - lu(k,1181) * lu(k,1369) + lu(k,1374) = lu(k,1374) - lu(k,1182) * lu(k,1369) + lu(k,1380) = lu(k,1380) - lu(k,1183) * lu(k,1369) + lu(k,1382) = lu(k,1382) - lu(k,1184) * lu(k,1369) + lu(k,1384) = lu(k,1384) - lu(k,1185) * lu(k,1369) + lu(k,1393) = - lu(k,1181) * lu(k,1392) + lu(k,1395) = lu(k,1395) - lu(k,1182) * lu(k,1392) + lu(k,1400) = lu(k,1400) - lu(k,1183) * lu(k,1392) + lu(k,1402) = lu(k,1402) - lu(k,1184) * lu(k,1392) + lu(k,1404) = lu(k,1404) - lu(k,1185) * lu(k,1392) + lu(k,1420) = lu(k,1420) - lu(k,1181) * lu(k,1416) + lu(k,1426) = lu(k,1426) - lu(k,1182) * lu(k,1416) + lu(k,1432) = lu(k,1432) - lu(k,1183) * lu(k,1416) + lu(k,1434) = lu(k,1434) - lu(k,1184) * lu(k,1416) + lu(k,1436) = lu(k,1436) - lu(k,1185) * lu(k,1416) + lu(k,1593) = lu(k,1593) - lu(k,1181) * lu(k,1588) + lu(k,1599) = lu(k,1599) - lu(k,1182) * lu(k,1588) + lu(k,1608) = lu(k,1608) - lu(k,1183) * lu(k,1588) + lu(k,1612) = lu(k,1612) - lu(k,1184) * lu(k,1588) + lu(k,1615) = lu(k,1615) - lu(k,1185) * lu(k,1588) + lu(k,1646) = lu(k,1646) - lu(k,1181) * lu(k,1642) + lu(k,1652) = lu(k,1652) - lu(k,1182) * lu(k,1642) + lu(k,1660) = lu(k,1660) - lu(k,1183) * lu(k,1642) + lu(k,1664) = lu(k,1664) - lu(k,1184) * lu(k,1642) + lu(k,1667) = lu(k,1667) - lu(k,1185) * lu(k,1642) + lu(k,1692) = lu(k,1692) - lu(k,1181) * lu(k,1691) + lu(k,1695) = lu(k,1695) - lu(k,1182) * lu(k,1691) + lu(k,1704) = lu(k,1704) - lu(k,1183) * lu(k,1691) + lu(k,1708) = lu(k,1708) - lu(k,1184) * lu(k,1691) + lu(k,1711) = lu(k,1711) - lu(k,1185) * lu(k,1691) + lu(k,1900) = lu(k,1900) - lu(k,1181) * lu(k,1895) + lu(k,1907) = lu(k,1907) - lu(k,1182) * lu(k,1895) + lu(k,1917) = lu(k,1917) - lu(k,1183) * lu(k,1895) + lu(k,1921) = lu(k,1921) - lu(k,1184) * lu(k,1895) + lu(k,1924) = lu(k,1924) - lu(k,1185) * lu(k,1895) + lu(k,2061) = lu(k,2061) - lu(k,1181) * lu(k,2056) + lu(k,2068) = lu(k,2068) - lu(k,1182) * lu(k,2056) + lu(k,2077) = lu(k,2077) - lu(k,1183) * lu(k,2056) + lu(k,2081) = lu(k,2081) - lu(k,1184) * lu(k,2056) + lu(k,2084) = lu(k,2084) - lu(k,1185) * lu(k,2056) + lu(k,2204) = lu(k,2204) - lu(k,1181) * lu(k,2200) + lu(k,2210) = lu(k,2210) - lu(k,1182) * lu(k,2200) + lu(k,2220) = lu(k,2220) - lu(k,1183) * lu(k,2200) + lu(k,2224) = lu(k,2224) - lu(k,1184) * lu(k,2200) + lu(k,2227) = lu(k,2227) - lu(k,1185) * lu(k,2200) + lu(k,2304) = lu(k,2304) - lu(k,1181) * lu(k,2301) + lu(k,2311) = lu(k,2311) - lu(k,1182) * lu(k,2301) + lu(k,2320) = lu(k,2320) - lu(k,1183) * lu(k,2301) + lu(k,2324) = lu(k,2324) - lu(k,1184) * lu(k,2301) + lu(k,2327) = lu(k,2327) - lu(k,1185) * lu(k,2301) + lu(k,1193) = 1._r8 / lu(k,1193) + lu(k,1194) = lu(k,1194) * lu(k,1193) + lu(k,1195) = lu(k,1195) * lu(k,1193) + lu(k,1196) = lu(k,1196) * lu(k,1193) + lu(k,1197) = lu(k,1197) * lu(k,1193) + lu(k,1198) = lu(k,1198) * lu(k,1193) + lu(k,1199) = lu(k,1199) * lu(k,1193) + lu(k,1200) = lu(k,1200) * lu(k,1193) + lu(k,1201) = lu(k,1201) * lu(k,1193) + lu(k,1202) = lu(k,1202) * lu(k,1193) + lu(k,1203) = lu(k,1203) * lu(k,1193) + lu(k,1204) = lu(k,1204) * lu(k,1193) + lu(k,1205) = lu(k,1205) * lu(k,1193) + lu(k,1295) = lu(k,1295) - lu(k,1194) * lu(k,1292) + lu(k,1300) = lu(k,1300) - lu(k,1195) * lu(k,1292) + lu(k,1301) = lu(k,1301) - lu(k,1196) * lu(k,1292) + lu(k,1302) = lu(k,1302) - lu(k,1197) * lu(k,1292) + lu(k,1303) = lu(k,1303) - lu(k,1198) * lu(k,1292) + lu(k,1304) = lu(k,1304) - lu(k,1199) * lu(k,1292) + lu(k,1305) = lu(k,1305) - lu(k,1200) * lu(k,1292) + lu(k,1306) = lu(k,1306) - lu(k,1201) * lu(k,1292) + lu(k,1307) = lu(k,1307) - lu(k,1202) * lu(k,1292) + lu(k,1308) = lu(k,1308) - lu(k,1203) * lu(k,1292) + lu(k,1309) = lu(k,1309) - lu(k,1204) * lu(k,1292) + lu(k,1311) = - lu(k,1205) * lu(k,1292) + lu(k,1327) = lu(k,1327) - lu(k,1194) * lu(k,1324) + lu(k,1332) = lu(k,1332) - lu(k,1195) * lu(k,1324) + lu(k,1333) = lu(k,1333) - lu(k,1196) * lu(k,1324) + lu(k,1334) = lu(k,1334) - lu(k,1197) * lu(k,1324) + lu(k,1335) = lu(k,1335) - lu(k,1198) * lu(k,1324) + lu(k,1336) = lu(k,1336) - lu(k,1199) * lu(k,1324) + lu(k,1337) = lu(k,1337) - lu(k,1200) * lu(k,1324) + lu(k,1338) = lu(k,1338) - lu(k,1201) * lu(k,1324) + lu(k,1339) = lu(k,1339) - lu(k,1202) * lu(k,1324) + lu(k,1340) = lu(k,1340) - lu(k,1203) * lu(k,1324) + lu(k,1341) = lu(k,1341) - lu(k,1204) * lu(k,1324) + lu(k,1343) = - lu(k,1205) * lu(k,1324) + lu(k,1350) = lu(k,1350) - lu(k,1194) * lu(k,1349) + lu(k,1353) = lu(k,1353) - lu(k,1195) * lu(k,1349) + lu(k,1354) = - lu(k,1196) * lu(k,1349) + lu(k,1355) = lu(k,1355) - lu(k,1197) * lu(k,1349) + lu(k,1356) = lu(k,1356) - lu(k,1198) * lu(k,1349) + lu(k,1357) = lu(k,1357) - lu(k,1199) * lu(k,1349) + lu(k,1358) = lu(k,1358) - lu(k,1200) * lu(k,1349) + lu(k,1359) = lu(k,1359) - lu(k,1201) * lu(k,1349) + lu(k,1360) = lu(k,1360) - lu(k,1202) * lu(k,1349) + lu(k,1361) = lu(k,1361) - lu(k,1203) * lu(k,1349) + lu(k,1362) = lu(k,1362) - lu(k,1204) * lu(k,1349) + lu(k,1363) = - lu(k,1205) * lu(k,1349) + lu(k,1593) = lu(k,1593) - lu(k,1194) * lu(k,1589) + lu(k,1599) = lu(k,1599) - lu(k,1195) * lu(k,1589) + lu(k,1602) = lu(k,1602) - lu(k,1196) * lu(k,1589) + lu(k,1604) = lu(k,1604) - lu(k,1197) * lu(k,1589) + lu(k,1605) = lu(k,1605) - lu(k,1198) * lu(k,1589) + lu(k,1606) = lu(k,1606) - lu(k,1199) * lu(k,1589) + lu(k,1608) = lu(k,1608) - lu(k,1200) * lu(k,1589) + lu(k,1611) = lu(k,1611) - lu(k,1201) * lu(k,1589) + lu(k,1612) = lu(k,1612) - lu(k,1202) * lu(k,1589) + lu(k,1613) = lu(k,1613) - lu(k,1203) * lu(k,1589) + lu(k,1615) = lu(k,1615) - lu(k,1204) * lu(k,1589) + lu(k,1618) = lu(k,1618) - lu(k,1205) * lu(k,1589) + lu(k,1900) = lu(k,1900) - lu(k,1194) * lu(k,1896) + lu(k,1907) = lu(k,1907) - lu(k,1195) * lu(k,1896) + lu(k,1911) = lu(k,1911) - lu(k,1196) * lu(k,1896) + lu(k,1913) = lu(k,1913) - lu(k,1197) * lu(k,1896) + lu(k,1914) = lu(k,1914) - lu(k,1198) * lu(k,1896) + lu(k,1915) = lu(k,1915) - lu(k,1199) * lu(k,1896) + lu(k,1917) = lu(k,1917) - lu(k,1200) * lu(k,1896) + lu(k,1920) = lu(k,1920) - lu(k,1201) * lu(k,1896) + lu(k,1921) = lu(k,1921) - lu(k,1202) * lu(k,1896) + lu(k,1922) = lu(k,1922) - lu(k,1203) * lu(k,1896) + lu(k,1924) = lu(k,1924) - lu(k,1204) * lu(k,1896) + lu(k,1927) = lu(k,1927) - lu(k,1205) * lu(k,1896) + lu(k,2061) = lu(k,2061) - lu(k,1194) * lu(k,2057) + lu(k,2068) = lu(k,2068) - lu(k,1195) * lu(k,2057) + lu(k,2071) = lu(k,2071) - lu(k,1196) * lu(k,2057) + lu(k,2073) = lu(k,2073) - lu(k,1197) * lu(k,2057) + lu(k,2074) = lu(k,2074) - lu(k,1198) * lu(k,2057) + lu(k,2075) = lu(k,2075) - lu(k,1199) * lu(k,2057) + lu(k,2077) = lu(k,2077) - lu(k,1200) * lu(k,2057) + lu(k,2080) = lu(k,2080) - lu(k,1201) * lu(k,2057) + lu(k,2081) = lu(k,2081) - lu(k,1202) * lu(k,2057) + lu(k,2082) = lu(k,2082) - lu(k,1203) * lu(k,2057) + lu(k,2084) = lu(k,2084) - lu(k,1204) * lu(k,2057) + lu(k,2087) = lu(k,2087) - lu(k,1205) * lu(k,2057) + lu(k,1213) = 1._r8 / lu(k,1213) + lu(k,1214) = lu(k,1214) * lu(k,1213) + lu(k,1215) = lu(k,1215) * lu(k,1213) + lu(k,1216) = lu(k,1216) * lu(k,1213) + lu(k,1217) = lu(k,1217) * lu(k,1213) + lu(k,1218) = lu(k,1218) * lu(k,1213) + lu(k,1219) = lu(k,1219) * lu(k,1213) + lu(k,1220) = lu(k,1220) * lu(k,1213) + lu(k,1221) = lu(k,1221) * lu(k,1213) + lu(k,1222) = lu(k,1222) * lu(k,1213) + lu(k,1223) = lu(k,1223) * lu(k,1213) + lu(k,1235) = lu(k,1235) - lu(k,1214) * lu(k,1232) + lu(k,1237) = lu(k,1237) - lu(k,1215) * lu(k,1232) + lu(k,1239) = lu(k,1239) - lu(k,1216) * lu(k,1232) + lu(k,1240) = lu(k,1240) - lu(k,1217) * lu(k,1232) + lu(k,1241) = lu(k,1241) - lu(k,1218) * lu(k,1232) + lu(k,1242) = lu(k,1242) - lu(k,1219) * lu(k,1232) + lu(k,1243) = lu(k,1243) - lu(k,1220) * lu(k,1232) + lu(k,1244) = lu(k,1244) - lu(k,1221) * lu(k,1232) + lu(k,1245) = lu(k,1245) - lu(k,1222) * lu(k,1232) + lu(k,1246) = lu(k,1246) - lu(k,1223) * lu(k,1232) + lu(k,1295) = lu(k,1295) - lu(k,1214) * lu(k,1293) + lu(k,1300) = lu(k,1300) - lu(k,1215) * lu(k,1293) + lu(k,1302) = lu(k,1302) - lu(k,1216) * lu(k,1293) + lu(k,1303) = lu(k,1303) - lu(k,1217) * lu(k,1293) + lu(k,1304) = lu(k,1304) - lu(k,1218) * lu(k,1293) + lu(k,1305) = lu(k,1305) - lu(k,1219) * lu(k,1293) + lu(k,1306) = lu(k,1306) - lu(k,1220) * lu(k,1293) + lu(k,1307) = lu(k,1307) - lu(k,1221) * lu(k,1293) + lu(k,1308) = lu(k,1308) - lu(k,1222) * lu(k,1293) + lu(k,1309) = lu(k,1309) - lu(k,1223) * lu(k,1293) + lu(k,1327) = lu(k,1327) - lu(k,1214) * lu(k,1325) + lu(k,1332) = lu(k,1332) - lu(k,1215) * lu(k,1325) + lu(k,1334) = lu(k,1334) - lu(k,1216) * lu(k,1325) + lu(k,1335) = lu(k,1335) - lu(k,1217) * lu(k,1325) + lu(k,1336) = lu(k,1336) - lu(k,1218) * lu(k,1325) + lu(k,1337) = lu(k,1337) - lu(k,1219) * lu(k,1325) + lu(k,1338) = lu(k,1338) - lu(k,1220) * lu(k,1325) + lu(k,1339) = lu(k,1339) - lu(k,1221) * lu(k,1325) + lu(k,1340) = lu(k,1340) - lu(k,1222) * lu(k,1325) + lu(k,1341) = lu(k,1341) - lu(k,1223) * lu(k,1325) + lu(k,1420) = lu(k,1420) - lu(k,1214) * lu(k,1417) + lu(k,1426) = lu(k,1426) - lu(k,1215) * lu(k,1417) + lu(k,1429) = lu(k,1429) - lu(k,1216) * lu(k,1417) + lu(k,1430) = lu(k,1430) - lu(k,1217) * lu(k,1417) + lu(k,1431) = lu(k,1431) - lu(k,1218) * lu(k,1417) + lu(k,1432) = lu(k,1432) - lu(k,1219) * lu(k,1417) + lu(k,1433) = lu(k,1433) - lu(k,1220) * lu(k,1417) + lu(k,1434) = lu(k,1434) - lu(k,1221) * lu(k,1417) + lu(k,1435) = lu(k,1435) - lu(k,1222) * lu(k,1417) + lu(k,1436) = lu(k,1436) - lu(k,1223) * lu(k,1417) + lu(k,1593) = lu(k,1593) - lu(k,1214) * lu(k,1590) + lu(k,1599) = lu(k,1599) - lu(k,1215) * lu(k,1590) + lu(k,1604) = lu(k,1604) - lu(k,1216) * lu(k,1590) + lu(k,1605) = lu(k,1605) - lu(k,1217) * lu(k,1590) + lu(k,1606) = lu(k,1606) - lu(k,1218) * lu(k,1590) + lu(k,1608) = lu(k,1608) - lu(k,1219) * lu(k,1590) + lu(k,1611) = lu(k,1611) - lu(k,1220) * lu(k,1590) + lu(k,1612) = lu(k,1612) - lu(k,1221) * lu(k,1590) + lu(k,1613) = lu(k,1613) - lu(k,1222) * lu(k,1590) + lu(k,1615) = lu(k,1615) - lu(k,1223) * lu(k,1590) + lu(k,1646) = lu(k,1646) - lu(k,1214) * lu(k,1643) + lu(k,1652) = lu(k,1652) - lu(k,1215) * lu(k,1643) + lu(k,1656) = lu(k,1656) - lu(k,1216) * lu(k,1643) + lu(k,1657) = lu(k,1657) - lu(k,1217) * lu(k,1643) + lu(k,1658) = lu(k,1658) - lu(k,1218) * lu(k,1643) + lu(k,1660) = lu(k,1660) - lu(k,1219) * lu(k,1643) + lu(k,1663) = lu(k,1663) - lu(k,1220) * lu(k,1643) + lu(k,1664) = lu(k,1664) - lu(k,1221) * lu(k,1643) + lu(k,1665) = lu(k,1665) - lu(k,1222) * lu(k,1643) + lu(k,1667) = lu(k,1667) - lu(k,1223) * lu(k,1643) + lu(k,1900) = lu(k,1900) - lu(k,1214) * lu(k,1897) + lu(k,1907) = lu(k,1907) - lu(k,1215) * lu(k,1897) + lu(k,1913) = lu(k,1913) - lu(k,1216) * lu(k,1897) + lu(k,1914) = lu(k,1914) - lu(k,1217) * lu(k,1897) + lu(k,1915) = lu(k,1915) - lu(k,1218) * lu(k,1897) + lu(k,1917) = lu(k,1917) - lu(k,1219) * lu(k,1897) + lu(k,1920) = lu(k,1920) - lu(k,1220) * lu(k,1897) + lu(k,1921) = lu(k,1921) - lu(k,1221) * lu(k,1897) + lu(k,1922) = lu(k,1922) - lu(k,1222) * lu(k,1897) + lu(k,1924) = lu(k,1924) - lu(k,1223) * lu(k,1897) + lu(k,2061) = lu(k,2061) - lu(k,1214) * lu(k,2058) + lu(k,2068) = lu(k,2068) - lu(k,1215) * lu(k,2058) + lu(k,2073) = lu(k,2073) - lu(k,1216) * lu(k,2058) + lu(k,2074) = lu(k,2074) - lu(k,1217) * lu(k,2058) + lu(k,2075) = lu(k,2075) - lu(k,1218) * lu(k,2058) + lu(k,2077) = lu(k,2077) - lu(k,1219) * lu(k,2058) + lu(k,2080) = lu(k,2080) - lu(k,1220) * lu(k,2058) + lu(k,2081) = lu(k,2081) - lu(k,1221) * lu(k,2058) + lu(k,2082) = lu(k,2082) - lu(k,1222) * lu(k,2058) + lu(k,2084) = lu(k,2084) - lu(k,1223) * lu(k,2058) + lu(k,2204) = lu(k,2204) - lu(k,1214) * lu(k,2201) + lu(k,2210) = lu(k,2210) - lu(k,1215) * lu(k,2201) + lu(k,2216) = lu(k,2216) - lu(k,1216) * lu(k,2201) + lu(k,2217) = lu(k,2217) - lu(k,1217) * lu(k,2201) + lu(k,2218) = lu(k,2218) - lu(k,1218) * lu(k,2201) + lu(k,2220) = lu(k,2220) - lu(k,1219) * lu(k,2201) + lu(k,2223) = lu(k,2223) - lu(k,1220) * lu(k,2201) + lu(k,2224) = lu(k,2224) - lu(k,1221) * lu(k,2201) + lu(k,2225) = lu(k,2225) - lu(k,1222) * lu(k,2201) + lu(k,2227) = lu(k,2227) - lu(k,1223) * lu(k,2201) + lu(k,1233) = 1._r8 / lu(k,1233) + lu(k,1234) = lu(k,1234) * lu(k,1233) + lu(k,1235) = lu(k,1235) * lu(k,1233) + lu(k,1236) = lu(k,1236) * lu(k,1233) + lu(k,1237) = lu(k,1237) * lu(k,1233) + lu(k,1238) = lu(k,1238) * lu(k,1233) + lu(k,1239) = lu(k,1239) * lu(k,1233) + lu(k,1240) = lu(k,1240) * lu(k,1233) + lu(k,1241) = lu(k,1241) * lu(k,1233) + lu(k,1242) = lu(k,1242) * lu(k,1233) + lu(k,1243) = lu(k,1243) * lu(k,1233) + lu(k,1244) = lu(k,1244) * lu(k,1233) + lu(k,1245) = lu(k,1245) * lu(k,1233) + lu(k,1246) = lu(k,1246) * lu(k,1233) + lu(k,1419) = lu(k,1419) - lu(k,1234) * lu(k,1418) + lu(k,1420) = lu(k,1420) - lu(k,1235) * lu(k,1418) + lu(k,1424) = lu(k,1424) - lu(k,1236) * lu(k,1418) + lu(k,1426) = lu(k,1426) - lu(k,1237) * lu(k,1418) + lu(k,1428) = lu(k,1428) - lu(k,1238) * lu(k,1418) + lu(k,1429) = lu(k,1429) - lu(k,1239) * lu(k,1418) + lu(k,1430) = lu(k,1430) - lu(k,1240) * lu(k,1418) + lu(k,1431) = lu(k,1431) - lu(k,1241) * lu(k,1418) + lu(k,1432) = lu(k,1432) - lu(k,1242) * lu(k,1418) + lu(k,1433) = lu(k,1433) - lu(k,1243) * lu(k,1418) + lu(k,1434) = lu(k,1434) - lu(k,1244) * lu(k,1418) + lu(k,1435) = lu(k,1435) - lu(k,1245) * lu(k,1418) + lu(k,1436) = lu(k,1436) - lu(k,1246) * lu(k,1418) + lu(k,1592) = lu(k,1592) - lu(k,1234) * lu(k,1591) + lu(k,1593) = lu(k,1593) - lu(k,1235) * lu(k,1591) + lu(k,1597) = lu(k,1597) - lu(k,1236) * lu(k,1591) + lu(k,1599) = lu(k,1599) - lu(k,1237) * lu(k,1591) + lu(k,1602) = lu(k,1602) - lu(k,1238) * lu(k,1591) + lu(k,1604) = lu(k,1604) - lu(k,1239) * lu(k,1591) + lu(k,1605) = lu(k,1605) - lu(k,1240) * lu(k,1591) + lu(k,1606) = lu(k,1606) - lu(k,1241) * lu(k,1591) + lu(k,1608) = lu(k,1608) - lu(k,1242) * lu(k,1591) + lu(k,1611) = lu(k,1611) - lu(k,1243) * lu(k,1591) + lu(k,1612) = lu(k,1612) - lu(k,1244) * lu(k,1591) + lu(k,1613) = lu(k,1613) - lu(k,1245) * lu(k,1591) + lu(k,1615) = lu(k,1615) - lu(k,1246) * lu(k,1591) + lu(k,1645) = lu(k,1645) - lu(k,1234) * lu(k,1644) + lu(k,1646) = lu(k,1646) - lu(k,1235) * lu(k,1644) + lu(k,1650) = lu(k,1650) - lu(k,1236) * lu(k,1644) + lu(k,1652) = lu(k,1652) - lu(k,1237) * lu(k,1644) + lu(k,1654) = lu(k,1654) - lu(k,1238) * lu(k,1644) + lu(k,1656) = lu(k,1656) - lu(k,1239) * lu(k,1644) + lu(k,1657) = lu(k,1657) - lu(k,1240) * lu(k,1644) + lu(k,1658) = lu(k,1658) - lu(k,1241) * lu(k,1644) + lu(k,1660) = lu(k,1660) - lu(k,1242) * lu(k,1644) + lu(k,1663) = lu(k,1663) - lu(k,1243) * lu(k,1644) + lu(k,1664) = lu(k,1664) - lu(k,1244) * lu(k,1644) + lu(k,1665) = lu(k,1665) - lu(k,1245) * lu(k,1644) + lu(k,1667) = lu(k,1667) - lu(k,1246) * lu(k,1644) + lu(k,1899) = lu(k,1899) - lu(k,1234) * lu(k,1898) + lu(k,1900) = lu(k,1900) - lu(k,1235) * lu(k,1898) + lu(k,1905) = lu(k,1905) - lu(k,1236) * lu(k,1898) + lu(k,1907) = lu(k,1907) - lu(k,1237) * lu(k,1898) + lu(k,1911) = lu(k,1911) - lu(k,1238) * lu(k,1898) + lu(k,1913) = lu(k,1913) - lu(k,1239) * lu(k,1898) + lu(k,1914) = lu(k,1914) - lu(k,1240) * lu(k,1898) + lu(k,1915) = lu(k,1915) - lu(k,1241) * lu(k,1898) + lu(k,1917) = lu(k,1917) - lu(k,1242) * lu(k,1898) + lu(k,1920) = lu(k,1920) - lu(k,1243) * lu(k,1898) + lu(k,1921) = lu(k,1921) - lu(k,1244) * lu(k,1898) + lu(k,1922) = lu(k,1922) - lu(k,1245) * lu(k,1898) + lu(k,1924) = lu(k,1924) - lu(k,1246) * lu(k,1898) + lu(k,2060) = lu(k,2060) - lu(k,1234) * lu(k,2059) + lu(k,2061) = lu(k,2061) - lu(k,1235) * lu(k,2059) + lu(k,2066) = lu(k,2066) - lu(k,1236) * lu(k,2059) + lu(k,2068) = lu(k,2068) - lu(k,1237) * lu(k,2059) + lu(k,2071) = lu(k,2071) - lu(k,1238) * lu(k,2059) + lu(k,2073) = lu(k,2073) - lu(k,1239) * lu(k,2059) + lu(k,2074) = lu(k,2074) - lu(k,1240) * lu(k,2059) + lu(k,2075) = lu(k,2075) - lu(k,1241) * lu(k,2059) + lu(k,2077) = lu(k,2077) - lu(k,1242) * lu(k,2059) + lu(k,2080) = lu(k,2080) - lu(k,1243) * lu(k,2059) + lu(k,2081) = lu(k,2081) - lu(k,1244) * lu(k,2059) + lu(k,2082) = lu(k,2082) - lu(k,1245) * lu(k,2059) + lu(k,2084) = lu(k,2084) - lu(k,1246) * lu(k,2059) + lu(k,2203) = lu(k,2203) - lu(k,1234) * lu(k,2202) + lu(k,2204) = lu(k,2204) - lu(k,1235) * lu(k,2202) + lu(k,2208) = lu(k,2208) - lu(k,1236) * lu(k,2202) + lu(k,2210) = lu(k,2210) - lu(k,1237) * lu(k,2202) + lu(k,2214) = lu(k,2214) - lu(k,1238) * lu(k,2202) + lu(k,2216) = lu(k,2216) - lu(k,1239) * lu(k,2202) + lu(k,2217) = lu(k,2217) - lu(k,1240) * lu(k,2202) + lu(k,2218) = lu(k,2218) - lu(k,1241) * lu(k,2202) + lu(k,2220) = lu(k,2220) - lu(k,1242) * lu(k,2202) + lu(k,2223) = lu(k,2223) - lu(k,1243) * lu(k,2202) + lu(k,2224) = lu(k,2224) - lu(k,1244) * lu(k,2202) + lu(k,2225) = lu(k,2225) - lu(k,1245) * lu(k,2202) + lu(k,2227) = lu(k,2227) - lu(k,1246) * lu(k,2202) + lu(k,2303) = lu(k,2303) - lu(k,1234) * lu(k,2302) + lu(k,2304) = lu(k,2304) - lu(k,1235) * lu(k,2302) + lu(k,2309) = lu(k,2309) - lu(k,1236) * lu(k,2302) + lu(k,2311) = lu(k,2311) - lu(k,1237) * lu(k,2302) + lu(k,2314) = lu(k,2314) - lu(k,1238) * lu(k,2302) + lu(k,2316) = lu(k,2316) - lu(k,1239) * lu(k,2302) + lu(k,2317) = lu(k,2317) - lu(k,1240) * lu(k,2302) + lu(k,2318) = lu(k,2318) - lu(k,1241) * lu(k,2302) + lu(k,2320) = lu(k,2320) - lu(k,1242) * lu(k,2302) + lu(k,2323) = lu(k,2323) - lu(k,1243) * lu(k,2302) + lu(k,2324) = lu(k,2324) - lu(k,1244) * lu(k,2302) + lu(k,2325) = lu(k,2325) - lu(k,1245) * lu(k,2302) + lu(k,2327) = lu(k,2327) - lu(k,1246) * lu(k,2302) end do end subroutine lu_fac24 subroutine lu_fac25( avec_len, lu ) @@ -5459,511 +4942,304 @@ subroutine lu_fac25( avec_len, lu ) lu(k,1257) = lu(k,1257) * lu(k,1249) lu(k,1258) = lu(k,1258) * lu(k,1249) lu(k,1259) = lu(k,1259) * lu(k,1249) - lu(k,1260) = lu(k,1260) * lu(k,1249) - lu(k,1261) = lu(k,1261) * lu(k,1249) - lu(k,1280) = lu(k,1280) - lu(k,1250) * lu(k,1279) - lu(k,1281) = lu(k,1281) - lu(k,1251) * lu(k,1279) - lu(k,1282) = lu(k,1282) - lu(k,1252) * lu(k,1279) - lu(k,1283) = lu(k,1283) - lu(k,1253) * lu(k,1279) - lu(k,1284) = lu(k,1284) - lu(k,1254) * lu(k,1279) - lu(k,1285) = lu(k,1285) - lu(k,1255) * lu(k,1279) - lu(k,1286) = lu(k,1286) - lu(k,1256) * lu(k,1279) - lu(k,1287) = lu(k,1287) - lu(k,1257) * lu(k,1279) - lu(k,1288) = lu(k,1288) - lu(k,1258) * lu(k,1279) - lu(k,1289) = lu(k,1289) - lu(k,1259) * lu(k,1279) - lu(k,1290) = lu(k,1290) - lu(k,1260) * lu(k,1279) - lu(k,1291) = lu(k,1291) - lu(k,1261) * lu(k,1279) - lu(k,1391) = lu(k,1391) - lu(k,1250) * lu(k,1390) - lu(k,1393) = lu(k,1393) - lu(k,1251) * lu(k,1390) - lu(k,1394) = lu(k,1394) - lu(k,1252) * lu(k,1390) - lu(k,1395) = lu(k,1395) - lu(k,1253) * lu(k,1390) - lu(k,1397) = lu(k,1397) - lu(k,1254) * lu(k,1390) - lu(k,1399) = lu(k,1399) - lu(k,1255) * lu(k,1390) - lu(k,1400) = lu(k,1400) - lu(k,1256) * lu(k,1390) - lu(k,1401) = lu(k,1401) - lu(k,1257) * lu(k,1390) - lu(k,1402) = lu(k,1402) - lu(k,1258) * lu(k,1390) - lu(k,1403) = lu(k,1403) - lu(k,1259) * lu(k,1390) - lu(k,1404) = lu(k,1404) - lu(k,1260) * lu(k,1390) - lu(k,1409) = lu(k,1409) - lu(k,1261) * lu(k,1390) - lu(k,1507) = lu(k,1507) - lu(k,1250) * lu(k,1506) - lu(k,1509) = lu(k,1509) - lu(k,1251) * lu(k,1506) - lu(k,1510) = lu(k,1510) - lu(k,1252) * lu(k,1506) - lu(k,1511) = lu(k,1511) - lu(k,1253) * lu(k,1506) - lu(k,1513) = lu(k,1513) - lu(k,1254) * lu(k,1506) - lu(k,1515) = lu(k,1515) - lu(k,1255) * lu(k,1506) - lu(k,1516) = lu(k,1516) - lu(k,1256) * lu(k,1506) - lu(k,1517) = lu(k,1517) - lu(k,1257) * lu(k,1506) - lu(k,1518) = lu(k,1518) - lu(k,1258) * lu(k,1506) - lu(k,1519) = lu(k,1519) - lu(k,1259) * lu(k,1506) - lu(k,1520) = lu(k,1520) - lu(k,1260) * lu(k,1506) - lu(k,1525) = lu(k,1525) - lu(k,1261) * lu(k,1506) - lu(k,1690) = lu(k,1690) - lu(k,1250) * lu(k,1689) - lu(k,1692) = lu(k,1692) - lu(k,1251) * lu(k,1689) - lu(k,1693) = lu(k,1693) - lu(k,1252) * lu(k,1689) - lu(k,1694) = lu(k,1694) - lu(k,1253) * lu(k,1689) - lu(k,1696) = lu(k,1696) - lu(k,1254) * lu(k,1689) - lu(k,1698) = lu(k,1698) - lu(k,1255) * lu(k,1689) - lu(k,1699) = lu(k,1699) - lu(k,1256) * lu(k,1689) - lu(k,1700) = lu(k,1700) - lu(k,1257) * lu(k,1689) - lu(k,1701) = lu(k,1701) - lu(k,1258) * lu(k,1689) - lu(k,1702) = lu(k,1702) - lu(k,1259) * lu(k,1689) - lu(k,1703) = lu(k,1703) - lu(k,1260) * lu(k,1689) - lu(k,1708) = lu(k,1708) - lu(k,1261) * lu(k,1689) - lu(k,1754) = lu(k,1754) - lu(k,1250) * lu(k,1753) - lu(k,1756) = lu(k,1756) - lu(k,1251) * lu(k,1753) - lu(k,1757) = lu(k,1757) - lu(k,1252) * lu(k,1753) - lu(k,1758) = lu(k,1758) - lu(k,1253) * lu(k,1753) - lu(k,1760) = lu(k,1760) - lu(k,1254) * lu(k,1753) - lu(k,1762) = lu(k,1762) - lu(k,1255) * lu(k,1753) - lu(k,1763) = lu(k,1763) - lu(k,1256) * lu(k,1753) - lu(k,1764) = lu(k,1764) - lu(k,1257) * lu(k,1753) - lu(k,1765) = lu(k,1765) - lu(k,1258) * lu(k,1753) - lu(k,1766) = lu(k,1766) - lu(k,1259) * lu(k,1753) - lu(k,1767) = lu(k,1767) - lu(k,1260) * lu(k,1753) - lu(k,1772) = lu(k,1772) - lu(k,1261) * lu(k,1753) - lu(k,1811) = lu(k,1811) - lu(k,1250) * lu(k,1810) - lu(k,1813) = lu(k,1813) - lu(k,1251) * lu(k,1810) - lu(k,1814) = lu(k,1814) - lu(k,1252) * lu(k,1810) - lu(k,1815) = lu(k,1815) - lu(k,1253) * lu(k,1810) - lu(k,1817) = lu(k,1817) - lu(k,1254) * lu(k,1810) - lu(k,1819) = lu(k,1819) - lu(k,1255) * lu(k,1810) - lu(k,1820) = lu(k,1820) - lu(k,1256) * lu(k,1810) - lu(k,1821) = lu(k,1821) - lu(k,1257) * lu(k,1810) - lu(k,1822) = lu(k,1822) - lu(k,1258) * lu(k,1810) - lu(k,1823) = lu(k,1823) - lu(k,1259) * lu(k,1810) - lu(k,1824) = lu(k,1824) - lu(k,1260) * lu(k,1810) - lu(k,1829) = lu(k,1829) - lu(k,1261) * lu(k,1810) - lu(k,1862) = lu(k,1862) - lu(k,1250) * lu(k,1861) - lu(k,1863) = lu(k,1863) - lu(k,1251) * lu(k,1861) - lu(k,1864) = lu(k,1864) - lu(k,1252) * lu(k,1861) - lu(k,1865) = lu(k,1865) - lu(k,1253) * lu(k,1861) - lu(k,1867) = lu(k,1867) - lu(k,1254) * lu(k,1861) - lu(k,1869) = lu(k,1869) - lu(k,1255) * lu(k,1861) - lu(k,1870) = lu(k,1870) - lu(k,1256) * lu(k,1861) - lu(k,1871) = lu(k,1871) - lu(k,1257) * lu(k,1861) - lu(k,1872) = lu(k,1872) - lu(k,1258) * lu(k,1861) - lu(k,1873) = lu(k,1873) - lu(k,1259) * lu(k,1861) - lu(k,1874) = lu(k,1874) - lu(k,1260) * lu(k,1861) - lu(k,1879) = lu(k,1879) - lu(k,1261) * lu(k,1861) - lu(k,1921) = lu(k,1921) - lu(k,1250) * lu(k,1920) - lu(k,1923) = lu(k,1923) - lu(k,1251) * lu(k,1920) - lu(k,1924) = lu(k,1924) - lu(k,1252) * lu(k,1920) - lu(k,1925) = lu(k,1925) - lu(k,1253) * lu(k,1920) - lu(k,1927) = lu(k,1927) - lu(k,1254) * lu(k,1920) - lu(k,1929) = lu(k,1929) - lu(k,1255) * lu(k,1920) - lu(k,1930) = lu(k,1930) - lu(k,1256) * lu(k,1920) - lu(k,1931) = lu(k,1931) - lu(k,1257) * lu(k,1920) - lu(k,1932) = lu(k,1932) - lu(k,1258) * lu(k,1920) - lu(k,1933) = lu(k,1933) - lu(k,1259) * lu(k,1920) - lu(k,1934) = lu(k,1934) - lu(k,1260) * lu(k,1920) - lu(k,1939) = lu(k,1939) - lu(k,1261) * lu(k,1920) - lu(k,1280) = 1._r8 / lu(k,1280) - lu(k,1281) = lu(k,1281) * lu(k,1280) - lu(k,1282) = lu(k,1282) * lu(k,1280) - lu(k,1283) = lu(k,1283) * lu(k,1280) - lu(k,1284) = lu(k,1284) * lu(k,1280) - lu(k,1285) = lu(k,1285) * lu(k,1280) - lu(k,1286) = lu(k,1286) * lu(k,1280) - lu(k,1287) = lu(k,1287) * lu(k,1280) - lu(k,1288) = lu(k,1288) * lu(k,1280) - lu(k,1289) = lu(k,1289) * lu(k,1280) - lu(k,1290) = lu(k,1290) * lu(k,1280) - lu(k,1291) = lu(k,1291) * lu(k,1280) - lu(k,1393) = lu(k,1393) - lu(k,1281) * lu(k,1391) - lu(k,1394) = lu(k,1394) - lu(k,1282) * lu(k,1391) - lu(k,1395) = lu(k,1395) - lu(k,1283) * lu(k,1391) - lu(k,1397) = lu(k,1397) - lu(k,1284) * lu(k,1391) - lu(k,1399) = lu(k,1399) - lu(k,1285) * lu(k,1391) - lu(k,1400) = lu(k,1400) - lu(k,1286) * lu(k,1391) - lu(k,1401) = lu(k,1401) - lu(k,1287) * lu(k,1391) - lu(k,1402) = lu(k,1402) - lu(k,1288) * lu(k,1391) - lu(k,1403) = lu(k,1403) - lu(k,1289) * lu(k,1391) - lu(k,1404) = lu(k,1404) - lu(k,1290) * lu(k,1391) - lu(k,1409) = lu(k,1409) - lu(k,1291) * lu(k,1391) - lu(k,1509) = lu(k,1509) - lu(k,1281) * lu(k,1507) - lu(k,1510) = lu(k,1510) - lu(k,1282) * lu(k,1507) - lu(k,1511) = lu(k,1511) - lu(k,1283) * lu(k,1507) - lu(k,1513) = lu(k,1513) - lu(k,1284) * lu(k,1507) - lu(k,1515) = lu(k,1515) - lu(k,1285) * lu(k,1507) - lu(k,1516) = lu(k,1516) - lu(k,1286) * lu(k,1507) - lu(k,1517) = lu(k,1517) - lu(k,1287) * lu(k,1507) - lu(k,1518) = lu(k,1518) - lu(k,1288) * lu(k,1507) - lu(k,1519) = lu(k,1519) - lu(k,1289) * lu(k,1507) - lu(k,1520) = lu(k,1520) - lu(k,1290) * lu(k,1507) - lu(k,1525) = lu(k,1525) - lu(k,1291) * lu(k,1507) - lu(k,1692) = lu(k,1692) - lu(k,1281) * lu(k,1690) - lu(k,1693) = lu(k,1693) - lu(k,1282) * lu(k,1690) - lu(k,1694) = lu(k,1694) - lu(k,1283) * lu(k,1690) - lu(k,1696) = lu(k,1696) - lu(k,1284) * lu(k,1690) - lu(k,1698) = lu(k,1698) - lu(k,1285) * lu(k,1690) - lu(k,1699) = lu(k,1699) - lu(k,1286) * lu(k,1690) - lu(k,1700) = lu(k,1700) - lu(k,1287) * lu(k,1690) - lu(k,1701) = lu(k,1701) - lu(k,1288) * lu(k,1690) - lu(k,1702) = lu(k,1702) - lu(k,1289) * lu(k,1690) - lu(k,1703) = lu(k,1703) - lu(k,1290) * lu(k,1690) - lu(k,1708) = lu(k,1708) - lu(k,1291) * lu(k,1690) - lu(k,1756) = lu(k,1756) - lu(k,1281) * lu(k,1754) - lu(k,1757) = lu(k,1757) - lu(k,1282) * lu(k,1754) - lu(k,1758) = lu(k,1758) - lu(k,1283) * lu(k,1754) - lu(k,1760) = lu(k,1760) - lu(k,1284) * lu(k,1754) - lu(k,1762) = lu(k,1762) - lu(k,1285) * lu(k,1754) - lu(k,1763) = lu(k,1763) - lu(k,1286) * lu(k,1754) - lu(k,1764) = lu(k,1764) - lu(k,1287) * lu(k,1754) - lu(k,1765) = lu(k,1765) - lu(k,1288) * lu(k,1754) - lu(k,1766) = lu(k,1766) - lu(k,1289) * lu(k,1754) - lu(k,1767) = lu(k,1767) - lu(k,1290) * lu(k,1754) - lu(k,1772) = lu(k,1772) - lu(k,1291) * lu(k,1754) - lu(k,1813) = lu(k,1813) - lu(k,1281) * lu(k,1811) - lu(k,1814) = lu(k,1814) - lu(k,1282) * lu(k,1811) - lu(k,1815) = lu(k,1815) - lu(k,1283) * lu(k,1811) - lu(k,1817) = lu(k,1817) - lu(k,1284) * lu(k,1811) - lu(k,1819) = lu(k,1819) - lu(k,1285) * lu(k,1811) - lu(k,1820) = lu(k,1820) - lu(k,1286) * lu(k,1811) - lu(k,1821) = lu(k,1821) - lu(k,1287) * lu(k,1811) - lu(k,1822) = lu(k,1822) - lu(k,1288) * lu(k,1811) - lu(k,1823) = lu(k,1823) - lu(k,1289) * lu(k,1811) - lu(k,1824) = lu(k,1824) - lu(k,1290) * lu(k,1811) - lu(k,1829) = lu(k,1829) - lu(k,1291) * lu(k,1811) - lu(k,1863) = lu(k,1863) - lu(k,1281) * lu(k,1862) - lu(k,1864) = lu(k,1864) - lu(k,1282) * lu(k,1862) - lu(k,1865) = lu(k,1865) - lu(k,1283) * lu(k,1862) - lu(k,1867) = lu(k,1867) - lu(k,1284) * lu(k,1862) - lu(k,1869) = lu(k,1869) - lu(k,1285) * lu(k,1862) - lu(k,1870) = lu(k,1870) - lu(k,1286) * lu(k,1862) - lu(k,1871) = lu(k,1871) - lu(k,1287) * lu(k,1862) - lu(k,1872) = lu(k,1872) - lu(k,1288) * lu(k,1862) - lu(k,1873) = lu(k,1873) - lu(k,1289) * lu(k,1862) - lu(k,1874) = lu(k,1874) - lu(k,1290) * lu(k,1862) - lu(k,1879) = lu(k,1879) - lu(k,1291) * lu(k,1862) - lu(k,1923) = lu(k,1923) - lu(k,1281) * lu(k,1921) - lu(k,1924) = lu(k,1924) - lu(k,1282) * lu(k,1921) - lu(k,1925) = lu(k,1925) - lu(k,1283) * lu(k,1921) - lu(k,1927) = lu(k,1927) - lu(k,1284) * lu(k,1921) - lu(k,1929) = lu(k,1929) - lu(k,1285) * lu(k,1921) - lu(k,1930) = lu(k,1930) - lu(k,1286) * lu(k,1921) - lu(k,1931) = lu(k,1931) - lu(k,1287) * lu(k,1921) - lu(k,1932) = lu(k,1932) - lu(k,1288) * lu(k,1921) - lu(k,1933) = lu(k,1933) - lu(k,1289) * lu(k,1921) - lu(k,1934) = lu(k,1934) - lu(k,1290) * lu(k,1921) - lu(k,1939) = lu(k,1939) - lu(k,1291) * lu(k,1921) - lu(k,2037) = lu(k,2037) - lu(k,1281) * lu(k,2035) - lu(k,2038) = lu(k,2038) - lu(k,1282) * lu(k,2035) - lu(k,2039) = lu(k,2039) - lu(k,1283) * lu(k,2035) - lu(k,2041) = lu(k,2041) - lu(k,1284) * lu(k,2035) - lu(k,2043) = lu(k,2043) - lu(k,1285) * lu(k,2035) - lu(k,2044) = lu(k,2044) - lu(k,1286) * lu(k,2035) - lu(k,2045) = lu(k,2045) - lu(k,1287) * lu(k,2035) - lu(k,2046) = lu(k,2046) - lu(k,1288) * lu(k,2035) - lu(k,2047) = lu(k,2047) - lu(k,1289) * lu(k,2035) - lu(k,2048) = lu(k,2048) - lu(k,1290) * lu(k,2035) - lu(k,2053) = lu(k,2053) - lu(k,1291) * lu(k,2035) - lu(k,1294) = 1._r8 / lu(k,1294) - lu(k,1295) = lu(k,1295) * lu(k,1294) - lu(k,1296) = lu(k,1296) * lu(k,1294) - lu(k,1297) = lu(k,1297) * lu(k,1294) - lu(k,1298) = lu(k,1298) * lu(k,1294) - lu(k,1299) = lu(k,1299) * lu(k,1294) - lu(k,1300) = lu(k,1300) * lu(k,1294) - lu(k,1301) = lu(k,1301) * lu(k,1294) - lu(k,1302) = lu(k,1302) * lu(k,1294) - lu(k,1303) = lu(k,1303) * lu(k,1294) - lu(k,1394) = lu(k,1394) - lu(k,1295) * lu(k,1392) - lu(k,1397) = lu(k,1397) - lu(k,1296) * lu(k,1392) - lu(k,1398) = - lu(k,1297) * lu(k,1392) - lu(k,1399) = lu(k,1399) - lu(k,1298) * lu(k,1392) - lu(k,1400) = lu(k,1400) - lu(k,1299) * lu(k,1392) - lu(k,1404) = lu(k,1404) - lu(k,1300) * lu(k,1392) - lu(k,1405) = lu(k,1405) - lu(k,1301) * lu(k,1392) - lu(k,1407) = lu(k,1407) - lu(k,1302) * lu(k,1392) - lu(k,1409) = lu(k,1409) - lu(k,1303) * lu(k,1392) - lu(k,1417) = lu(k,1417) - lu(k,1295) * lu(k,1415) - lu(k,1419) = - lu(k,1296) * lu(k,1415) - lu(k,1420) = lu(k,1420) - lu(k,1297) * lu(k,1415) - lu(k,1421) = lu(k,1421) - lu(k,1298) * lu(k,1415) - lu(k,1422) = - lu(k,1299) * lu(k,1415) - lu(k,1426) = - lu(k,1300) * lu(k,1415) - lu(k,1427) = lu(k,1427) - lu(k,1301) * lu(k,1415) - lu(k,1429) = lu(k,1429) - lu(k,1302) * lu(k,1415) - lu(k,1431) = lu(k,1431) - lu(k,1303) * lu(k,1415) - lu(k,1510) = lu(k,1510) - lu(k,1295) * lu(k,1508) - lu(k,1513) = lu(k,1513) - lu(k,1296) * lu(k,1508) - lu(k,1514) = lu(k,1514) - lu(k,1297) * lu(k,1508) - lu(k,1515) = lu(k,1515) - lu(k,1298) * lu(k,1508) - lu(k,1516) = lu(k,1516) - lu(k,1299) * lu(k,1508) - lu(k,1520) = lu(k,1520) - lu(k,1300) * lu(k,1508) - lu(k,1521) = lu(k,1521) - lu(k,1301) * lu(k,1508) - lu(k,1523) = lu(k,1523) - lu(k,1302) * lu(k,1508) - lu(k,1525) = lu(k,1525) - lu(k,1303) * lu(k,1508) - lu(k,1534) = lu(k,1534) - lu(k,1295) * lu(k,1532) - lu(k,1537) = lu(k,1537) - lu(k,1296) * lu(k,1532) - lu(k,1538) = lu(k,1538) - lu(k,1297) * lu(k,1532) - lu(k,1539) = lu(k,1539) - lu(k,1298) * lu(k,1532) - lu(k,1540) = lu(k,1540) - lu(k,1299) * lu(k,1532) - lu(k,1544) = lu(k,1544) - lu(k,1300) * lu(k,1532) - lu(k,1545) = lu(k,1545) - lu(k,1301) * lu(k,1532) - lu(k,1547) = lu(k,1547) - lu(k,1302) * lu(k,1532) - lu(k,1549) = lu(k,1549) - lu(k,1303) * lu(k,1532) - lu(k,1693) = lu(k,1693) - lu(k,1295) * lu(k,1691) - lu(k,1696) = lu(k,1696) - lu(k,1296) * lu(k,1691) - lu(k,1697) = lu(k,1697) - lu(k,1297) * lu(k,1691) - lu(k,1698) = lu(k,1698) - lu(k,1298) * lu(k,1691) - lu(k,1699) = lu(k,1699) - lu(k,1299) * lu(k,1691) - lu(k,1703) = lu(k,1703) - lu(k,1300) * lu(k,1691) - lu(k,1704) = lu(k,1704) - lu(k,1301) * lu(k,1691) - lu(k,1706) = lu(k,1706) - lu(k,1302) * lu(k,1691) - lu(k,1708) = lu(k,1708) - lu(k,1303) * lu(k,1691) - lu(k,1716) = lu(k,1716) - lu(k,1295) * lu(k,1714) - lu(k,1719) = lu(k,1719) - lu(k,1296) * lu(k,1714) - lu(k,1720) = lu(k,1720) - lu(k,1297) * lu(k,1714) - lu(k,1721) = lu(k,1721) - lu(k,1298) * lu(k,1714) - lu(k,1722) = lu(k,1722) - lu(k,1299) * lu(k,1714) - lu(k,1726) = - lu(k,1300) * lu(k,1714) - lu(k,1727) = lu(k,1727) - lu(k,1301) * lu(k,1714) - lu(k,1729) = lu(k,1729) - lu(k,1302) * lu(k,1714) - lu(k,1731) = lu(k,1731) - lu(k,1303) * lu(k,1714) - lu(k,1757) = lu(k,1757) - lu(k,1295) * lu(k,1755) - lu(k,1760) = lu(k,1760) - lu(k,1296) * lu(k,1755) - lu(k,1761) = - lu(k,1297) * lu(k,1755) - lu(k,1762) = lu(k,1762) - lu(k,1298) * lu(k,1755) - lu(k,1763) = lu(k,1763) - lu(k,1299) * lu(k,1755) - lu(k,1767) = lu(k,1767) - lu(k,1300) * lu(k,1755) - lu(k,1768) = lu(k,1768) - lu(k,1301) * lu(k,1755) - lu(k,1770) = lu(k,1770) - lu(k,1302) * lu(k,1755) - lu(k,1772) = lu(k,1772) - lu(k,1303) * lu(k,1755) - lu(k,1814) = lu(k,1814) - lu(k,1295) * lu(k,1812) - lu(k,1817) = lu(k,1817) - lu(k,1296) * lu(k,1812) - lu(k,1818) = - lu(k,1297) * lu(k,1812) - lu(k,1819) = lu(k,1819) - lu(k,1298) * lu(k,1812) - lu(k,1820) = lu(k,1820) - lu(k,1299) * lu(k,1812) - lu(k,1824) = lu(k,1824) - lu(k,1300) * lu(k,1812) - lu(k,1825) = lu(k,1825) - lu(k,1301) * lu(k,1812) - lu(k,1827) = lu(k,1827) - lu(k,1302) * lu(k,1812) - lu(k,1829) = lu(k,1829) - lu(k,1303) * lu(k,1812) - lu(k,1924) = lu(k,1924) - lu(k,1295) * lu(k,1922) - lu(k,1927) = lu(k,1927) - lu(k,1296) * lu(k,1922) - lu(k,1928) = lu(k,1928) - lu(k,1297) * lu(k,1922) - lu(k,1929) = lu(k,1929) - lu(k,1298) * lu(k,1922) - lu(k,1930) = lu(k,1930) - lu(k,1299) * lu(k,1922) - lu(k,1934) = lu(k,1934) - lu(k,1300) * lu(k,1922) - lu(k,1935) = lu(k,1935) - lu(k,1301) * lu(k,1922) - lu(k,1937) = lu(k,1937) - lu(k,1302) * lu(k,1922) - lu(k,1939) = lu(k,1939) - lu(k,1303) * lu(k,1922) - lu(k,1948) = lu(k,1948) - lu(k,1295) * lu(k,1946) - lu(k,1951) = lu(k,1951) - lu(k,1296) * lu(k,1946) - lu(k,1952) = - lu(k,1297) * lu(k,1946) - lu(k,1953) = lu(k,1953) - lu(k,1298) * lu(k,1946) - lu(k,1954) = - lu(k,1299) * lu(k,1946) - lu(k,1958) = lu(k,1958) - lu(k,1300) * lu(k,1946) - lu(k,1959) = lu(k,1959) - lu(k,1301) * lu(k,1946) - lu(k,1961) = lu(k,1961) - lu(k,1302) * lu(k,1946) - lu(k,1963) = lu(k,1963) - lu(k,1303) * lu(k,1946) - lu(k,1974) = lu(k,1974) - lu(k,1295) * lu(k,1972) - lu(k,1977) = lu(k,1977) - lu(k,1296) * lu(k,1972) - lu(k,1978) = - lu(k,1297) * lu(k,1972) - lu(k,1979) = lu(k,1979) - lu(k,1298) * lu(k,1972) - lu(k,1980) = lu(k,1980) - lu(k,1299) * lu(k,1972) - lu(k,1984) = lu(k,1984) - lu(k,1300) * lu(k,1972) - lu(k,1985) = lu(k,1985) - lu(k,1301) * lu(k,1972) - lu(k,1987) = lu(k,1987) - lu(k,1302) * lu(k,1972) - lu(k,1989) = lu(k,1989) - lu(k,1303) * lu(k,1972) - lu(k,2004) = lu(k,2004) - lu(k,1295) * lu(k,2002) - lu(k,2007) = lu(k,2007) - lu(k,1296) * lu(k,2002) - lu(k,2008) = lu(k,2008) - lu(k,1297) * lu(k,2002) - lu(k,2009) = lu(k,2009) - lu(k,1298) * lu(k,2002) - lu(k,2010) = lu(k,2010) - lu(k,1299) * lu(k,2002) - lu(k,2014) = lu(k,2014) - lu(k,1300) * lu(k,2002) - lu(k,2015) = lu(k,2015) - lu(k,1301) * lu(k,2002) - lu(k,2017) = lu(k,2017) - lu(k,1302) * lu(k,2002) - lu(k,2019) = lu(k,2019) - lu(k,1303) * lu(k,2002) - lu(k,2038) = lu(k,2038) - lu(k,1295) * lu(k,2036) - lu(k,2041) = lu(k,2041) - lu(k,1296) * lu(k,2036) - lu(k,2042) = lu(k,2042) - lu(k,1297) * lu(k,2036) - lu(k,2043) = lu(k,2043) - lu(k,1298) * lu(k,2036) - lu(k,2044) = lu(k,2044) - lu(k,1299) * lu(k,2036) - lu(k,2048) = lu(k,2048) - lu(k,1300) * lu(k,2036) - lu(k,2049) = - lu(k,1301) * lu(k,2036) - lu(k,2051) = lu(k,2051) - lu(k,1302) * lu(k,2036) - lu(k,2053) = lu(k,2053) - lu(k,1303) * lu(k,2036) - lu(k,2063) = lu(k,2063) - lu(k,1295) * lu(k,2061) - lu(k,2066) = lu(k,2066) - lu(k,1296) * lu(k,2061) - lu(k,2067) = lu(k,2067) - lu(k,1297) * lu(k,2061) - lu(k,2068) = lu(k,2068) - lu(k,1298) * lu(k,2061) - lu(k,2069) = - lu(k,1299) * lu(k,2061) - lu(k,2073) = lu(k,2073) - lu(k,1300) * lu(k,2061) - lu(k,2074) = lu(k,2074) - lu(k,1301) * lu(k,2061) - lu(k,2076) = lu(k,2076) - lu(k,1302) * lu(k,2061) - lu(k,2078) = lu(k,2078) - lu(k,1303) * lu(k,2061) - lu(k,1307) = 1._r8 / lu(k,1307) - lu(k,1308) = lu(k,1308) * lu(k,1307) - lu(k,1309) = lu(k,1309) * lu(k,1307) - lu(k,1310) = lu(k,1310) * lu(k,1307) - lu(k,1311) = lu(k,1311) * lu(k,1307) - lu(k,1312) = lu(k,1312) * lu(k,1307) - lu(k,1313) = lu(k,1313) * lu(k,1307) - lu(k,1314) = lu(k,1314) * lu(k,1307) - lu(k,1315) = lu(k,1315) * lu(k,1307) - lu(k,1316) = lu(k,1316) * lu(k,1307) - lu(k,1317) = lu(k,1317) * lu(k,1307) - lu(k,1320) = lu(k,1320) - lu(k,1308) * lu(k,1319) - lu(k,1321) = lu(k,1321) - lu(k,1309) * lu(k,1319) - lu(k,1323) = lu(k,1323) - lu(k,1310) * lu(k,1319) - lu(k,1324) = lu(k,1324) - lu(k,1311) * lu(k,1319) - lu(k,1325) = - lu(k,1312) * lu(k,1319) - lu(k,1326) = lu(k,1326) - lu(k,1313) * lu(k,1319) - lu(k,1327) = lu(k,1327) - lu(k,1314) * lu(k,1319) - lu(k,1329) = lu(k,1329) - lu(k,1315) * lu(k,1319) - lu(k,1330) = lu(k,1330) - lu(k,1316) * lu(k,1319) - lu(k,1331) = lu(k,1331) - lu(k,1317) * lu(k,1319) - lu(k,1394) = lu(k,1394) - lu(k,1308) * lu(k,1393) - lu(k,1396) = - lu(k,1309) * lu(k,1393) - lu(k,1398) = lu(k,1398) - lu(k,1310) * lu(k,1393) - lu(k,1399) = lu(k,1399) - lu(k,1311) * lu(k,1393) - lu(k,1401) = lu(k,1401) - lu(k,1312) * lu(k,1393) - lu(k,1402) = lu(k,1402) - lu(k,1313) * lu(k,1393) - lu(k,1403) = lu(k,1403) - lu(k,1314) * lu(k,1393) - lu(k,1407) = lu(k,1407) - lu(k,1315) * lu(k,1393) - lu(k,1408) = lu(k,1408) - lu(k,1316) * lu(k,1393) - lu(k,1409) = lu(k,1409) - lu(k,1317) * lu(k,1393) - lu(k,1417) = lu(k,1417) - lu(k,1308) * lu(k,1416) - lu(k,1418) = lu(k,1418) - lu(k,1309) * lu(k,1416) - lu(k,1420) = lu(k,1420) - lu(k,1310) * lu(k,1416) - lu(k,1421) = lu(k,1421) - lu(k,1311) * lu(k,1416) - lu(k,1423) = lu(k,1423) - lu(k,1312) * lu(k,1416) - lu(k,1424) = lu(k,1424) - lu(k,1313) * lu(k,1416) - lu(k,1425) = - lu(k,1314) * lu(k,1416) - lu(k,1429) = lu(k,1429) - lu(k,1315) * lu(k,1416) - lu(k,1430) = lu(k,1430) - lu(k,1316) * lu(k,1416) - lu(k,1431) = lu(k,1431) - lu(k,1317) * lu(k,1416) - lu(k,1510) = lu(k,1510) - lu(k,1308) * lu(k,1509) - lu(k,1512) = lu(k,1512) - lu(k,1309) * lu(k,1509) - lu(k,1514) = lu(k,1514) - lu(k,1310) * lu(k,1509) - lu(k,1515) = lu(k,1515) - lu(k,1311) * lu(k,1509) - lu(k,1517) = lu(k,1517) - lu(k,1312) * lu(k,1509) - lu(k,1518) = lu(k,1518) - lu(k,1313) * lu(k,1509) - lu(k,1519) = lu(k,1519) - lu(k,1314) * lu(k,1509) - lu(k,1523) = lu(k,1523) - lu(k,1315) * lu(k,1509) - lu(k,1524) = lu(k,1524) - lu(k,1316) * lu(k,1509) - lu(k,1525) = lu(k,1525) - lu(k,1317) * lu(k,1509) - lu(k,1534) = lu(k,1534) - lu(k,1308) * lu(k,1533) - lu(k,1536) = lu(k,1536) - lu(k,1309) * lu(k,1533) - lu(k,1538) = lu(k,1538) - lu(k,1310) * lu(k,1533) - lu(k,1539) = lu(k,1539) - lu(k,1311) * lu(k,1533) - lu(k,1541) = - lu(k,1312) * lu(k,1533) - lu(k,1542) = lu(k,1542) - lu(k,1313) * lu(k,1533) - lu(k,1543) = lu(k,1543) - lu(k,1314) * lu(k,1533) - lu(k,1547) = lu(k,1547) - lu(k,1315) * lu(k,1533) - lu(k,1548) = lu(k,1548) - lu(k,1316) * lu(k,1533) - lu(k,1549) = lu(k,1549) - lu(k,1317) * lu(k,1533) - lu(k,1693) = lu(k,1693) - lu(k,1308) * lu(k,1692) - lu(k,1695) = lu(k,1695) - lu(k,1309) * lu(k,1692) - lu(k,1697) = lu(k,1697) - lu(k,1310) * lu(k,1692) - lu(k,1698) = lu(k,1698) - lu(k,1311) * lu(k,1692) - lu(k,1700) = lu(k,1700) - lu(k,1312) * lu(k,1692) - lu(k,1701) = lu(k,1701) - lu(k,1313) * lu(k,1692) - lu(k,1702) = lu(k,1702) - lu(k,1314) * lu(k,1692) - lu(k,1706) = lu(k,1706) - lu(k,1315) * lu(k,1692) - lu(k,1707) = lu(k,1707) - lu(k,1316) * lu(k,1692) - lu(k,1708) = lu(k,1708) - lu(k,1317) * lu(k,1692) - lu(k,1716) = lu(k,1716) - lu(k,1308) * lu(k,1715) - lu(k,1718) = lu(k,1718) - lu(k,1309) * lu(k,1715) - lu(k,1720) = lu(k,1720) - lu(k,1310) * lu(k,1715) - lu(k,1721) = lu(k,1721) - lu(k,1311) * lu(k,1715) - lu(k,1723) = lu(k,1723) - lu(k,1312) * lu(k,1715) - lu(k,1724) = lu(k,1724) - lu(k,1313) * lu(k,1715) - lu(k,1725) = lu(k,1725) - lu(k,1314) * lu(k,1715) - lu(k,1729) = lu(k,1729) - lu(k,1315) * lu(k,1715) - lu(k,1730) = lu(k,1730) - lu(k,1316) * lu(k,1715) - lu(k,1731) = lu(k,1731) - lu(k,1317) * lu(k,1715) - lu(k,1757) = lu(k,1757) - lu(k,1308) * lu(k,1756) - lu(k,1759) = lu(k,1759) - lu(k,1309) * lu(k,1756) - lu(k,1761) = lu(k,1761) - lu(k,1310) * lu(k,1756) - lu(k,1762) = lu(k,1762) - lu(k,1311) * lu(k,1756) - lu(k,1764) = lu(k,1764) - lu(k,1312) * lu(k,1756) - lu(k,1765) = lu(k,1765) - lu(k,1313) * lu(k,1756) - lu(k,1766) = lu(k,1766) - lu(k,1314) * lu(k,1756) - lu(k,1770) = lu(k,1770) - lu(k,1315) * lu(k,1756) - lu(k,1771) = lu(k,1771) - lu(k,1316) * lu(k,1756) - lu(k,1772) = lu(k,1772) - lu(k,1317) * lu(k,1756) - lu(k,1814) = lu(k,1814) - lu(k,1308) * lu(k,1813) - lu(k,1816) = - lu(k,1309) * lu(k,1813) - lu(k,1818) = lu(k,1818) - lu(k,1310) * lu(k,1813) - lu(k,1819) = lu(k,1819) - lu(k,1311) * lu(k,1813) - lu(k,1821) = lu(k,1821) - lu(k,1312) * lu(k,1813) - lu(k,1822) = lu(k,1822) - lu(k,1313) * lu(k,1813) - lu(k,1823) = lu(k,1823) - lu(k,1314) * lu(k,1813) - lu(k,1827) = lu(k,1827) - lu(k,1315) * lu(k,1813) - lu(k,1828) = lu(k,1828) - lu(k,1316) * lu(k,1813) - lu(k,1829) = lu(k,1829) - lu(k,1317) * lu(k,1813) - lu(k,1864) = lu(k,1864) - lu(k,1308) * lu(k,1863) - lu(k,1866) = - lu(k,1309) * lu(k,1863) - lu(k,1868) = - lu(k,1310) * lu(k,1863) - lu(k,1869) = lu(k,1869) - lu(k,1311) * lu(k,1863) - lu(k,1871) = lu(k,1871) - lu(k,1312) * lu(k,1863) - lu(k,1872) = lu(k,1872) - lu(k,1313) * lu(k,1863) - lu(k,1873) = lu(k,1873) - lu(k,1314) * lu(k,1863) - lu(k,1877) = - lu(k,1315) * lu(k,1863) - lu(k,1878) = lu(k,1878) - lu(k,1316) * lu(k,1863) - lu(k,1879) = lu(k,1879) - lu(k,1317) * lu(k,1863) - lu(k,1924) = lu(k,1924) - lu(k,1308) * lu(k,1923) - lu(k,1926) = - lu(k,1309) * lu(k,1923) - lu(k,1928) = lu(k,1928) - lu(k,1310) * lu(k,1923) - lu(k,1929) = lu(k,1929) - lu(k,1311) * lu(k,1923) - lu(k,1931) = lu(k,1931) - lu(k,1312) * lu(k,1923) - lu(k,1932) = lu(k,1932) - lu(k,1313) * lu(k,1923) - lu(k,1933) = lu(k,1933) - lu(k,1314) * lu(k,1923) - lu(k,1937) = lu(k,1937) - lu(k,1315) * lu(k,1923) - lu(k,1938) = lu(k,1938) - lu(k,1316) * lu(k,1923) - lu(k,1939) = lu(k,1939) - lu(k,1317) * lu(k,1923) - lu(k,1948) = lu(k,1948) - lu(k,1308) * lu(k,1947) - lu(k,1950) = lu(k,1950) - lu(k,1309) * lu(k,1947) - lu(k,1952) = lu(k,1952) - lu(k,1310) * lu(k,1947) - lu(k,1953) = lu(k,1953) - lu(k,1311) * lu(k,1947) - lu(k,1955) = lu(k,1955) - lu(k,1312) * lu(k,1947) - lu(k,1956) = lu(k,1956) - lu(k,1313) * lu(k,1947) - lu(k,1957) = - lu(k,1314) * lu(k,1947) - lu(k,1961) = lu(k,1961) - lu(k,1315) * lu(k,1947) - lu(k,1962) = lu(k,1962) - lu(k,1316) * lu(k,1947) - lu(k,1963) = lu(k,1963) - lu(k,1317) * lu(k,1947) - lu(k,1974) = lu(k,1974) - lu(k,1308) * lu(k,1973) - lu(k,1976) = lu(k,1976) - lu(k,1309) * lu(k,1973) - lu(k,1978) = lu(k,1978) - lu(k,1310) * lu(k,1973) - lu(k,1979) = lu(k,1979) - lu(k,1311) * lu(k,1973) - lu(k,1981) = lu(k,1981) - lu(k,1312) * lu(k,1973) - lu(k,1982) = lu(k,1982) - lu(k,1313) * lu(k,1973) - lu(k,1983) = lu(k,1983) - lu(k,1314) * lu(k,1973) - lu(k,1987) = lu(k,1987) - lu(k,1315) * lu(k,1973) - lu(k,1988) = lu(k,1988) - lu(k,1316) * lu(k,1973) - lu(k,1989) = lu(k,1989) - lu(k,1317) * lu(k,1973) - lu(k,2004) = lu(k,2004) - lu(k,1308) * lu(k,2003) - lu(k,2006) = lu(k,2006) - lu(k,1309) * lu(k,2003) - lu(k,2008) = lu(k,2008) - lu(k,1310) * lu(k,2003) - lu(k,2009) = lu(k,2009) - lu(k,1311) * lu(k,2003) - lu(k,2011) = lu(k,2011) - lu(k,1312) * lu(k,2003) - lu(k,2012) = lu(k,2012) - lu(k,1313) * lu(k,2003) - lu(k,2013) = lu(k,2013) - lu(k,1314) * lu(k,2003) - lu(k,2017) = lu(k,2017) - lu(k,1315) * lu(k,2003) - lu(k,2018) = lu(k,2018) - lu(k,1316) * lu(k,2003) - lu(k,2019) = lu(k,2019) - lu(k,1317) * lu(k,2003) - lu(k,2038) = lu(k,2038) - lu(k,1308) * lu(k,2037) - lu(k,2040) = lu(k,2040) - lu(k,1309) * lu(k,2037) - lu(k,2042) = lu(k,2042) - lu(k,1310) * lu(k,2037) - lu(k,2043) = lu(k,2043) - lu(k,1311) * lu(k,2037) - lu(k,2045) = lu(k,2045) - lu(k,1312) * lu(k,2037) - lu(k,2046) = lu(k,2046) - lu(k,1313) * lu(k,2037) - lu(k,2047) = lu(k,2047) - lu(k,1314) * lu(k,2037) - lu(k,2051) = lu(k,2051) - lu(k,1315) * lu(k,2037) - lu(k,2052) = lu(k,2052) - lu(k,1316) * lu(k,2037) - lu(k,2053) = lu(k,2053) - lu(k,1317) * lu(k,2037) - lu(k,2063) = lu(k,2063) - lu(k,1308) * lu(k,2062) - lu(k,2065) = lu(k,2065) - lu(k,1309) * lu(k,2062) - lu(k,2067) = lu(k,2067) - lu(k,1310) * lu(k,2062) - lu(k,2068) = lu(k,2068) - lu(k,1311) * lu(k,2062) - lu(k,2070) = lu(k,2070) - lu(k,1312) * lu(k,2062) - lu(k,2071) = lu(k,2071) - lu(k,1313) * lu(k,2062) - lu(k,2072) = lu(k,2072) - lu(k,1314) * lu(k,2062) - lu(k,2076) = lu(k,2076) - lu(k,1315) * lu(k,2062) - lu(k,2077) = lu(k,2077) - lu(k,1316) * lu(k,2062) - lu(k,2078) = lu(k,2078) - lu(k,1317) * lu(k,2062) + lu(k,1295) = lu(k,1295) - lu(k,1250) * lu(k,1294) + lu(k,1297) = - lu(k,1251) * lu(k,1294) + lu(k,1299) = - lu(k,1252) * lu(k,1294) + lu(k,1300) = lu(k,1300) - lu(k,1253) * lu(k,1294) + lu(k,1305) = lu(k,1305) - lu(k,1254) * lu(k,1294) + lu(k,1306) = lu(k,1306) - lu(k,1255) * lu(k,1294) + lu(k,1307) = lu(k,1307) - lu(k,1256) * lu(k,1294) + lu(k,1309) = lu(k,1309) - lu(k,1257) * lu(k,1294) + lu(k,1310) = - lu(k,1258) * lu(k,1294) + lu(k,1311) = lu(k,1311) - lu(k,1259) * lu(k,1294) + lu(k,1327) = lu(k,1327) - lu(k,1250) * lu(k,1326) + lu(k,1329) = - lu(k,1251) * lu(k,1326) + lu(k,1331) = - lu(k,1252) * lu(k,1326) + lu(k,1332) = lu(k,1332) - lu(k,1253) * lu(k,1326) + lu(k,1337) = lu(k,1337) - lu(k,1254) * lu(k,1326) + lu(k,1338) = lu(k,1338) - lu(k,1255) * lu(k,1326) + lu(k,1339) = lu(k,1339) - lu(k,1256) * lu(k,1326) + lu(k,1341) = lu(k,1341) - lu(k,1257) * lu(k,1326) + lu(k,1342) = - lu(k,1258) * lu(k,1326) + lu(k,1343) = lu(k,1343) - lu(k,1259) * lu(k,1326) + lu(k,1420) = lu(k,1420) - lu(k,1250) * lu(k,1419) + lu(k,1423) = lu(k,1423) - lu(k,1251) * lu(k,1419) + lu(k,1425) = lu(k,1425) - lu(k,1252) * lu(k,1419) + lu(k,1426) = lu(k,1426) - lu(k,1253) * lu(k,1419) + lu(k,1432) = lu(k,1432) - lu(k,1254) * lu(k,1419) + lu(k,1433) = lu(k,1433) - lu(k,1255) * lu(k,1419) + lu(k,1434) = lu(k,1434) - lu(k,1256) * lu(k,1419) + lu(k,1436) = lu(k,1436) - lu(k,1257) * lu(k,1419) + lu(k,1437) = lu(k,1437) - lu(k,1258) * lu(k,1419) + lu(k,1438) = lu(k,1438) - lu(k,1259) * lu(k,1419) + lu(k,1593) = lu(k,1593) - lu(k,1250) * lu(k,1592) + lu(k,1596) = lu(k,1596) - lu(k,1251) * lu(k,1592) + lu(k,1598) = lu(k,1598) - lu(k,1252) * lu(k,1592) + lu(k,1599) = lu(k,1599) - lu(k,1253) * lu(k,1592) + lu(k,1608) = lu(k,1608) - lu(k,1254) * lu(k,1592) + lu(k,1611) = lu(k,1611) - lu(k,1255) * lu(k,1592) + lu(k,1612) = lu(k,1612) - lu(k,1256) * lu(k,1592) + lu(k,1615) = lu(k,1615) - lu(k,1257) * lu(k,1592) + lu(k,1617) = lu(k,1617) - lu(k,1258) * lu(k,1592) + lu(k,1618) = lu(k,1618) - lu(k,1259) * lu(k,1592) + lu(k,1646) = lu(k,1646) - lu(k,1250) * lu(k,1645) + lu(k,1649) = lu(k,1649) - lu(k,1251) * lu(k,1645) + lu(k,1651) = lu(k,1651) - lu(k,1252) * lu(k,1645) + lu(k,1652) = lu(k,1652) - lu(k,1253) * lu(k,1645) + lu(k,1660) = lu(k,1660) - lu(k,1254) * lu(k,1645) + lu(k,1663) = lu(k,1663) - lu(k,1255) * lu(k,1645) + lu(k,1664) = lu(k,1664) - lu(k,1256) * lu(k,1645) + lu(k,1667) = lu(k,1667) - lu(k,1257) * lu(k,1645) + lu(k,1669) = - lu(k,1258) * lu(k,1645) + lu(k,1670) = lu(k,1670) - lu(k,1259) * lu(k,1645) + lu(k,1900) = lu(k,1900) - lu(k,1250) * lu(k,1899) + lu(k,1904) = lu(k,1904) - lu(k,1251) * lu(k,1899) + lu(k,1906) = lu(k,1906) - lu(k,1252) * lu(k,1899) + lu(k,1907) = lu(k,1907) - lu(k,1253) * lu(k,1899) + lu(k,1917) = lu(k,1917) - lu(k,1254) * lu(k,1899) + lu(k,1920) = lu(k,1920) - lu(k,1255) * lu(k,1899) + lu(k,1921) = lu(k,1921) - lu(k,1256) * lu(k,1899) + lu(k,1924) = lu(k,1924) - lu(k,1257) * lu(k,1899) + lu(k,1926) = lu(k,1926) - lu(k,1258) * lu(k,1899) + lu(k,1927) = lu(k,1927) - lu(k,1259) * lu(k,1899) + lu(k,2061) = lu(k,2061) - lu(k,1250) * lu(k,2060) + lu(k,2065) = lu(k,2065) - lu(k,1251) * lu(k,2060) + lu(k,2067) = lu(k,2067) - lu(k,1252) * lu(k,2060) + lu(k,2068) = lu(k,2068) - lu(k,1253) * lu(k,2060) + lu(k,2077) = lu(k,2077) - lu(k,1254) * lu(k,2060) + lu(k,2080) = lu(k,2080) - lu(k,1255) * lu(k,2060) + lu(k,2081) = lu(k,2081) - lu(k,1256) * lu(k,2060) + lu(k,2084) = lu(k,2084) - lu(k,1257) * lu(k,2060) + lu(k,2086) = lu(k,2086) - lu(k,1258) * lu(k,2060) + lu(k,2087) = lu(k,2087) - lu(k,1259) * lu(k,2060) + lu(k,2204) = lu(k,2204) - lu(k,1250) * lu(k,2203) + lu(k,2207) = lu(k,2207) - lu(k,1251) * lu(k,2203) + lu(k,2209) = lu(k,2209) - lu(k,1252) * lu(k,2203) + lu(k,2210) = lu(k,2210) - lu(k,1253) * lu(k,2203) + lu(k,2220) = lu(k,2220) - lu(k,1254) * lu(k,2203) + lu(k,2223) = lu(k,2223) - lu(k,1255) * lu(k,2203) + lu(k,2224) = lu(k,2224) - lu(k,1256) * lu(k,2203) + lu(k,2227) = lu(k,2227) - lu(k,1257) * lu(k,2203) + lu(k,2229) = lu(k,2229) - lu(k,1258) * lu(k,2203) + lu(k,2230) = lu(k,2230) - lu(k,1259) * lu(k,2203) + lu(k,2304) = lu(k,2304) - lu(k,1250) * lu(k,2303) + lu(k,2308) = - lu(k,1251) * lu(k,2303) + lu(k,2310) = - lu(k,1252) * lu(k,2303) + lu(k,2311) = lu(k,2311) - lu(k,1253) * lu(k,2303) + lu(k,2320) = lu(k,2320) - lu(k,1254) * lu(k,2303) + lu(k,2323) = lu(k,2323) - lu(k,1255) * lu(k,2303) + lu(k,2324) = lu(k,2324) - lu(k,1256) * lu(k,2303) + lu(k,2327) = lu(k,2327) - lu(k,1257) * lu(k,2303) + lu(k,2329) = lu(k,2329) - lu(k,1258) * lu(k,2303) + lu(k,2330) = lu(k,2330) - lu(k,1259) * lu(k,2303) + lu(k,1261) = 1._r8 / lu(k,1261) + lu(k,1262) = lu(k,1262) * lu(k,1261) + lu(k,1263) = lu(k,1263) * lu(k,1261) + lu(k,1264) = lu(k,1264) * lu(k,1261) + lu(k,1265) = lu(k,1265) * lu(k,1261) + lu(k,1266) = lu(k,1266) * lu(k,1261) + lu(k,1267) = lu(k,1267) * lu(k,1261) + lu(k,1268) = lu(k,1268) * lu(k,1261) + lu(k,1300) = lu(k,1300) - lu(k,1262) * lu(k,1295) + lu(k,1301) = lu(k,1301) - lu(k,1263) * lu(k,1295) + lu(k,1305) = lu(k,1305) - lu(k,1264) * lu(k,1295) + lu(k,1306) = lu(k,1306) - lu(k,1265) * lu(k,1295) + lu(k,1308) = lu(k,1308) - lu(k,1266) * lu(k,1295) + lu(k,1309) = lu(k,1309) - lu(k,1267) * lu(k,1295) + lu(k,1311) = lu(k,1311) - lu(k,1268) * lu(k,1295) + lu(k,1332) = lu(k,1332) - lu(k,1262) * lu(k,1327) + lu(k,1333) = lu(k,1333) - lu(k,1263) * lu(k,1327) + lu(k,1337) = lu(k,1337) - lu(k,1264) * lu(k,1327) + lu(k,1338) = lu(k,1338) - lu(k,1265) * lu(k,1327) + lu(k,1340) = lu(k,1340) - lu(k,1266) * lu(k,1327) + lu(k,1341) = lu(k,1341) - lu(k,1267) * lu(k,1327) + lu(k,1343) = lu(k,1343) - lu(k,1268) * lu(k,1327) + lu(k,1353) = lu(k,1353) - lu(k,1262) * lu(k,1350) + lu(k,1354) = lu(k,1354) - lu(k,1263) * lu(k,1350) + lu(k,1358) = lu(k,1358) - lu(k,1264) * lu(k,1350) + lu(k,1359) = lu(k,1359) - lu(k,1265) * lu(k,1350) + lu(k,1361) = lu(k,1361) - lu(k,1266) * lu(k,1350) + lu(k,1362) = lu(k,1362) - lu(k,1267) * lu(k,1350) + lu(k,1363) = lu(k,1363) - lu(k,1268) * lu(k,1350) + lu(k,1374) = lu(k,1374) - lu(k,1262) * lu(k,1370) + lu(k,1376) = lu(k,1376) - lu(k,1263) * lu(k,1370) + lu(k,1380) = lu(k,1380) - lu(k,1264) * lu(k,1370) + lu(k,1381) = lu(k,1381) - lu(k,1265) * lu(k,1370) + lu(k,1383) = lu(k,1383) - lu(k,1266) * lu(k,1370) + lu(k,1384) = lu(k,1384) - lu(k,1267) * lu(k,1370) + lu(k,1386) = lu(k,1386) - lu(k,1268) * lu(k,1370) + lu(k,1395) = lu(k,1395) - lu(k,1262) * lu(k,1393) + lu(k,1396) = - lu(k,1263) * lu(k,1393) + lu(k,1400) = lu(k,1400) - lu(k,1264) * lu(k,1393) + lu(k,1401) = lu(k,1401) - lu(k,1265) * lu(k,1393) + lu(k,1403) = lu(k,1403) - lu(k,1266) * lu(k,1393) + lu(k,1404) = lu(k,1404) - lu(k,1267) * lu(k,1393) + lu(k,1406) = lu(k,1406) - lu(k,1268) * lu(k,1393) + lu(k,1426) = lu(k,1426) - lu(k,1262) * lu(k,1420) + lu(k,1428) = lu(k,1428) - lu(k,1263) * lu(k,1420) + lu(k,1432) = lu(k,1432) - lu(k,1264) * lu(k,1420) + lu(k,1433) = lu(k,1433) - lu(k,1265) * lu(k,1420) + lu(k,1435) = lu(k,1435) - lu(k,1266) * lu(k,1420) + lu(k,1436) = lu(k,1436) - lu(k,1267) * lu(k,1420) + lu(k,1438) = lu(k,1438) - lu(k,1268) * lu(k,1420) + lu(k,1599) = lu(k,1599) - lu(k,1262) * lu(k,1593) + lu(k,1602) = lu(k,1602) - lu(k,1263) * lu(k,1593) + lu(k,1608) = lu(k,1608) - lu(k,1264) * lu(k,1593) + lu(k,1611) = lu(k,1611) - lu(k,1265) * lu(k,1593) + lu(k,1613) = lu(k,1613) - lu(k,1266) * lu(k,1593) + lu(k,1615) = lu(k,1615) - lu(k,1267) * lu(k,1593) + lu(k,1618) = lu(k,1618) - lu(k,1268) * lu(k,1593) + lu(k,1652) = lu(k,1652) - lu(k,1262) * lu(k,1646) + lu(k,1654) = lu(k,1654) - lu(k,1263) * lu(k,1646) + lu(k,1660) = lu(k,1660) - lu(k,1264) * lu(k,1646) + lu(k,1663) = lu(k,1663) - lu(k,1265) * lu(k,1646) + lu(k,1665) = lu(k,1665) - lu(k,1266) * lu(k,1646) + lu(k,1667) = lu(k,1667) - lu(k,1267) * lu(k,1646) + lu(k,1670) = lu(k,1670) - lu(k,1268) * lu(k,1646) + lu(k,1695) = lu(k,1695) - lu(k,1262) * lu(k,1692) + lu(k,1698) = lu(k,1698) - lu(k,1263) * lu(k,1692) + lu(k,1704) = lu(k,1704) - lu(k,1264) * lu(k,1692) + lu(k,1707) = lu(k,1707) - lu(k,1265) * lu(k,1692) + lu(k,1709) = lu(k,1709) - lu(k,1266) * lu(k,1692) + lu(k,1711) = lu(k,1711) - lu(k,1267) * lu(k,1692) + lu(k,1714) = lu(k,1714) - lu(k,1268) * lu(k,1692) + lu(k,1907) = lu(k,1907) - lu(k,1262) * lu(k,1900) + lu(k,1911) = lu(k,1911) - lu(k,1263) * lu(k,1900) + lu(k,1917) = lu(k,1917) - lu(k,1264) * lu(k,1900) + lu(k,1920) = lu(k,1920) - lu(k,1265) * lu(k,1900) + lu(k,1922) = lu(k,1922) - lu(k,1266) * lu(k,1900) + lu(k,1924) = lu(k,1924) - lu(k,1267) * lu(k,1900) + lu(k,1927) = lu(k,1927) - lu(k,1268) * lu(k,1900) + lu(k,2068) = lu(k,2068) - lu(k,1262) * lu(k,2061) + lu(k,2071) = lu(k,2071) - lu(k,1263) * lu(k,2061) + lu(k,2077) = lu(k,2077) - lu(k,1264) * lu(k,2061) + lu(k,2080) = lu(k,2080) - lu(k,1265) * lu(k,2061) + lu(k,2082) = lu(k,2082) - lu(k,1266) * lu(k,2061) + lu(k,2084) = lu(k,2084) - lu(k,1267) * lu(k,2061) + lu(k,2087) = lu(k,2087) - lu(k,1268) * lu(k,2061) + lu(k,2210) = lu(k,2210) - lu(k,1262) * lu(k,2204) + lu(k,2214) = lu(k,2214) - lu(k,1263) * lu(k,2204) + lu(k,2220) = lu(k,2220) - lu(k,1264) * lu(k,2204) + lu(k,2223) = lu(k,2223) - lu(k,1265) * lu(k,2204) + lu(k,2225) = lu(k,2225) - lu(k,1266) * lu(k,2204) + lu(k,2227) = lu(k,2227) - lu(k,1267) * lu(k,2204) + lu(k,2230) = lu(k,2230) - lu(k,1268) * lu(k,2204) + lu(k,2311) = lu(k,2311) - lu(k,1262) * lu(k,2304) + lu(k,2314) = lu(k,2314) - lu(k,1263) * lu(k,2304) + lu(k,2320) = lu(k,2320) - lu(k,1264) * lu(k,2304) + lu(k,2323) = lu(k,2323) - lu(k,1265) * lu(k,2304) + lu(k,2325) = lu(k,2325) - lu(k,1266) * lu(k,2304) + lu(k,2327) = lu(k,2327) - lu(k,1267) * lu(k,2304) + lu(k,2330) = lu(k,2330) - lu(k,1268) * lu(k,2304) + lu(k,1272) = 1._r8 / lu(k,1272) + lu(k,1273) = lu(k,1273) * lu(k,1272) + lu(k,1274) = lu(k,1274) * lu(k,1272) + lu(k,1275) = lu(k,1275) * lu(k,1272) + lu(k,1276) = lu(k,1276) * lu(k,1272) + lu(k,1277) = lu(k,1277) * lu(k,1272) + lu(k,1278) = lu(k,1278) * lu(k,1272) + lu(k,1279) = lu(k,1279) * lu(k,1272) + lu(k,1280) = lu(k,1280) * lu(k,1272) + lu(k,1281) = lu(k,1281) * lu(k,1272) + lu(k,1282) = lu(k,1282) * lu(k,1272) + lu(k,1283) = lu(k,1283) * lu(k,1272) + lu(k,1284) = lu(k,1284) * lu(k,1272) + lu(k,1696) = lu(k,1696) - lu(k,1273) * lu(k,1693) + lu(k,1699) = lu(k,1699) - lu(k,1274) * lu(k,1693) + lu(k,1700) = lu(k,1700) - lu(k,1275) * lu(k,1693) + lu(k,1702) = lu(k,1702) - lu(k,1276) * lu(k,1693) + lu(k,1704) = lu(k,1704) - lu(k,1277) * lu(k,1693) + lu(k,1705) = lu(k,1705) - lu(k,1278) * lu(k,1693) + lu(k,1707) = lu(k,1707) - lu(k,1279) * lu(k,1693) + lu(k,1710) = lu(k,1710) - lu(k,1280) * lu(k,1693) + lu(k,1711) = lu(k,1711) - lu(k,1281) * lu(k,1693) + lu(k,1712) = lu(k,1712) - lu(k,1282) * lu(k,1693) + lu(k,1713) = lu(k,1713) - lu(k,1283) * lu(k,1693) + lu(k,1714) = lu(k,1714) - lu(k,1284) * lu(k,1693) + lu(k,1909) = lu(k,1909) - lu(k,1273) * lu(k,1901) + lu(k,1912) = lu(k,1912) - lu(k,1274) * lu(k,1901) + lu(k,1913) = lu(k,1913) - lu(k,1275) * lu(k,1901) + lu(k,1915) = lu(k,1915) - lu(k,1276) * lu(k,1901) + lu(k,1917) = lu(k,1917) - lu(k,1277) * lu(k,1901) + lu(k,1918) = lu(k,1918) - lu(k,1278) * lu(k,1901) + lu(k,1920) = lu(k,1920) - lu(k,1279) * lu(k,1901) + lu(k,1923) = lu(k,1923) - lu(k,1280) * lu(k,1901) + lu(k,1924) = lu(k,1924) - lu(k,1281) * lu(k,1901) + lu(k,1925) = lu(k,1925) - lu(k,1282) * lu(k,1901) + lu(k,1926) = lu(k,1926) - lu(k,1283) * lu(k,1901) + lu(k,1927) = lu(k,1927) - lu(k,1284) * lu(k,1901) + lu(k,1936) = lu(k,1936) - lu(k,1273) * lu(k,1935) + lu(k,1938) = - lu(k,1274) * lu(k,1935) + lu(k,1939) = lu(k,1939) - lu(k,1275) * lu(k,1935) + lu(k,1941) = lu(k,1941) - lu(k,1276) * lu(k,1935) + lu(k,1943) = lu(k,1943) - lu(k,1277) * lu(k,1935) + lu(k,1944) = lu(k,1944) - lu(k,1278) * lu(k,1935) + lu(k,1946) = lu(k,1946) - lu(k,1279) * lu(k,1935) + lu(k,1949) = lu(k,1949) - lu(k,1280) * lu(k,1935) + lu(k,1950) = lu(k,1950) - lu(k,1281) * lu(k,1935) + lu(k,1951) = lu(k,1951) - lu(k,1282) * lu(k,1935) + lu(k,1952) = - lu(k,1283) * lu(k,1935) + lu(k,1953) = lu(k,1953) - lu(k,1284) * lu(k,1935) + lu(k,1988) = lu(k,1988) - lu(k,1273) * lu(k,1986) + lu(k,1991) = lu(k,1991) - lu(k,1274) * lu(k,1986) + lu(k,1992) = lu(k,1992) - lu(k,1275) * lu(k,1986) + lu(k,1994) = lu(k,1994) - lu(k,1276) * lu(k,1986) + lu(k,1996) = lu(k,1996) - lu(k,1277) * lu(k,1986) + lu(k,1997) = lu(k,1997) - lu(k,1278) * lu(k,1986) + lu(k,1999) = lu(k,1999) - lu(k,1279) * lu(k,1986) + lu(k,2002) = lu(k,2002) - lu(k,1280) * lu(k,1986) + lu(k,2003) = lu(k,2003) - lu(k,1281) * lu(k,1986) + lu(k,2004) = lu(k,2004) - lu(k,1282) * lu(k,1986) + lu(k,2005) = lu(k,2005) - lu(k,1283) * lu(k,1986) + lu(k,2006) = lu(k,2006) - lu(k,1284) * lu(k,1986) + lu(k,2069) = - lu(k,1273) * lu(k,2062) + lu(k,2072) = - lu(k,1274) * lu(k,2062) + lu(k,2073) = lu(k,2073) - lu(k,1275) * lu(k,2062) + lu(k,2075) = lu(k,2075) - lu(k,1276) * lu(k,2062) + lu(k,2077) = lu(k,2077) - lu(k,1277) * lu(k,2062) + lu(k,2078) = - lu(k,1278) * lu(k,2062) + lu(k,2080) = lu(k,2080) - lu(k,1279) * lu(k,2062) + lu(k,2083) = - lu(k,1280) * lu(k,2062) + lu(k,2084) = lu(k,2084) - lu(k,1281) * lu(k,2062) + lu(k,2085) = - lu(k,1282) * lu(k,2062) + lu(k,2086) = lu(k,2086) - lu(k,1283) * lu(k,2062) + lu(k,2087) = lu(k,2087) - lu(k,1284) * lu(k,2062) + lu(k,2094) = lu(k,2094) - lu(k,1273) * lu(k,2093) + lu(k,2096) = - lu(k,1274) * lu(k,2093) + lu(k,2097) = lu(k,2097) - lu(k,1275) * lu(k,2093) + lu(k,2099) = lu(k,2099) - lu(k,1276) * lu(k,2093) + lu(k,2101) = lu(k,2101) - lu(k,1277) * lu(k,2093) + lu(k,2102) = lu(k,2102) - lu(k,1278) * lu(k,2093) + lu(k,2104) = lu(k,2104) - lu(k,1279) * lu(k,2093) + lu(k,2107) = lu(k,2107) - lu(k,1280) * lu(k,2093) + lu(k,2108) = lu(k,2108) - lu(k,1281) * lu(k,2093) + lu(k,2109) = lu(k,2109) - lu(k,1282) * lu(k,2093) + lu(k,2110) = - lu(k,1283) * lu(k,2093) + lu(k,2111) = lu(k,2111) - lu(k,1284) * lu(k,2093) + lu(k,2312) = lu(k,2312) - lu(k,1273) * lu(k,2305) + lu(k,2315) = lu(k,2315) - lu(k,1274) * lu(k,2305) + lu(k,2316) = lu(k,2316) - lu(k,1275) * lu(k,2305) + lu(k,2318) = lu(k,2318) - lu(k,1276) * lu(k,2305) + lu(k,2320) = lu(k,2320) - lu(k,1277) * lu(k,2305) + lu(k,2321) = lu(k,2321) - lu(k,1278) * lu(k,2305) + lu(k,2323) = lu(k,2323) - lu(k,1279) * lu(k,2305) + lu(k,2326) = lu(k,2326) - lu(k,1280) * lu(k,2305) + lu(k,2327) = lu(k,2327) - lu(k,1281) * lu(k,2305) + lu(k,2328) = lu(k,2328) - lu(k,1282) * lu(k,2305) + lu(k,2329) = lu(k,2329) - lu(k,1283) * lu(k,2305) + lu(k,2330) = lu(k,2330) - lu(k,1284) * lu(k,2305) + lu(k,2338) = - lu(k,1273) * lu(k,2336) + lu(k,2341) = lu(k,2341) - lu(k,1274) * lu(k,2336) + lu(k,2342) = - lu(k,1275) * lu(k,2336) + lu(k,2344) = - lu(k,1276) * lu(k,2336) + lu(k,2346) = lu(k,2346) - lu(k,1277) * lu(k,2336) + lu(k,2347) = - lu(k,1278) * lu(k,2336) + lu(k,2349) = lu(k,2349) - lu(k,1279) * lu(k,2336) + lu(k,2352) = - lu(k,1280) * lu(k,2336) + lu(k,2353) = lu(k,2353) - lu(k,1281) * lu(k,2336) + lu(k,2354) = - lu(k,1282) * lu(k,2336) + lu(k,2355) = - lu(k,1283) * lu(k,2336) + lu(k,2356) = lu(k,2356) - lu(k,1284) * lu(k,2336) end do end subroutine lu_fac25 subroutine lu_fac26( avec_len, lu ) @@ -5980,720 +5256,470 @@ subroutine lu_fac26( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1320) = 1._r8 / lu(k,1320) - lu(k,1321) = lu(k,1321) * lu(k,1320) - lu(k,1322) = lu(k,1322) * lu(k,1320) - lu(k,1323) = lu(k,1323) * lu(k,1320) - lu(k,1324) = lu(k,1324) * lu(k,1320) - lu(k,1325) = lu(k,1325) * lu(k,1320) - lu(k,1326) = lu(k,1326) * lu(k,1320) - lu(k,1327) = lu(k,1327) * lu(k,1320) - lu(k,1328) = lu(k,1328) * lu(k,1320) - lu(k,1329) = lu(k,1329) * lu(k,1320) - lu(k,1330) = lu(k,1330) * lu(k,1320) - lu(k,1331) = lu(k,1331) * lu(k,1320) - lu(k,1396) = lu(k,1396) - lu(k,1321) * lu(k,1394) - lu(k,1397) = lu(k,1397) - lu(k,1322) * lu(k,1394) - lu(k,1398) = lu(k,1398) - lu(k,1323) * lu(k,1394) - lu(k,1399) = lu(k,1399) - lu(k,1324) * lu(k,1394) - lu(k,1401) = lu(k,1401) - lu(k,1325) * lu(k,1394) - lu(k,1402) = lu(k,1402) - lu(k,1326) * lu(k,1394) - lu(k,1403) = lu(k,1403) - lu(k,1327) * lu(k,1394) - lu(k,1404) = lu(k,1404) - lu(k,1328) * lu(k,1394) - lu(k,1407) = lu(k,1407) - lu(k,1329) * lu(k,1394) - lu(k,1408) = lu(k,1408) - lu(k,1330) * lu(k,1394) - lu(k,1409) = lu(k,1409) - lu(k,1331) * lu(k,1394) - lu(k,1418) = lu(k,1418) - lu(k,1321) * lu(k,1417) - lu(k,1419) = lu(k,1419) - lu(k,1322) * lu(k,1417) - lu(k,1420) = lu(k,1420) - lu(k,1323) * lu(k,1417) - lu(k,1421) = lu(k,1421) - lu(k,1324) * lu(k,1417) - lu(k,1423) = lu(k,1423) - lu(k,1325) * lu(k,1417) - lu(k,1424) = lu(k,1424) - lu(k,1326) * lu(k,1417) - lu(k,1425) = lu(k,1425) - lu(k,1327) * lu(k,1417) - lu(k,1426) = lu(k,1426) - lu(k,1328) * lu(k,1417) - lu(k,1429) = lu(k,1429) - lu(k,1329) * lu(k,1417) - lu(k,1430) = lu(k,1430) - lu(k,1330) * lu(k,1417) - lu(k,1431) = lu(k,1431) - lu(k,1331) * lu(k,1417) - lu(k,1512) = lu(k,1512) - lu(k,1321) * lu(k,1510) - lu(k,1513) = lu(k,1513) - lu(k,1322) * lu(k,1510) - lu(k,1514) = lu(k,1514) - lu(k,1323) * lu(k,1510) - lu(k,1515) = lu(k,1515) - lu(k,1324) * lu(k,1510) - lu(k,1517) = lu(k,1517) - lu(k,1325) * lu(k,1510) - lu(k,1518) = lu(k,1518) - lu(k,1326) * lu(k,1510) - lu(k,1519) = lu(k,1519) - lu(k,1327) * lu(k,1510) - lu(k,1520) = lu(k,1520) - lu(k,1328) * lu(k,1510) - lu(k,1523) = lu(k,1523) - lu(k,1329) * lu(k,1510) - lu(k,1524) = lu(k,1524) - lu(k,1330) * lu(k,1510) - lu(k,1525) = lu(k,1525) - lu(k,1331) * lu(k,1510) - lu(k,1536) = lu(k,1536) - lu(k,1321) * lu(k,1534) - lu(k,1537) = lu(k,1537) - lu(k,1322) * lu(k,1534) - lu(k,1538) = lu(k,1538) - lu(k,1323) * lu(k,1534) - lu(k,1539) = lu(k,1539) - lu(k,1324) * lu(k,1534) - lu(k,1541) = lu(k,1541) - lu(k,1325) * lu(k,1534) - lu(k,1542) = lu(k,1542) - lu(k,1326) * lu(k,1534) - lu(k,1543) = lu(k,1543) - lu(k,1327) * lu(k,1534) - lu(k,1544) = lu(k,1544) - lu(k,1328) * lu(k,1534) - lu(k,1547) = lu(k,1547) - lu(k,1329) * lu(k,1534) - lu(k,1548) = lu(k,1548) - lu(k,1330) * lu(k,1534) - lu(k,1549) = lu(k,1549) - lu(k,1331) * lu(k,1534) - lu(k,1695) = lu(k,1695) - lu(k,1321) * lu(k,1693) - lu(k,1696) = lu(k,1696) - lu(k,1322) * lu(k,1693) - lu(k,1697) = lu(k,1697) - lu(k,1323) * lu(k,1693) - lu(k,1698) = lu(k,1698) - lu(k,1324) * lu(k,1693) - lu(k,1700) = lu(k,1700) - lu(k,1325) * lu(k,1693) - lu(k,1701) = lu(k,1701) - lu(k,1326) * lu(k,1693) - lu(k,1702) = lu(k,1702) - lu(k,1327) * lu(k,1693) - lu(k,1703) = lu(k,1703) - lu(k,1328) * lu(k,1693) - lu(k,1706) = lu(k,1706) - lu(k,1329) * lu(k,1693) - lu(k,1707) = lu(k,1707) - lu(k,1330) * lu(k,1693) - lu(k,1708) = lu(k,1708) - lu(k,1331) * lu(k,1693) - lu(k,1718) = lu(k,1718) - lu(k,1321) * lu(k,1716) - lu(k,1719) = lu(k,1719) - lu(k,1322) * lu(k,1716) - lu(k,1720) = lu(k,1720) - lu(k,1323) * lu(k,1716) - lu(k,1721) = lu(k,1721) - lu(k,1324) * lu(k,1716) - lu(k,1723) = lu(k,1723) - lu(k,1325) * lu(k,1716) - lu(k,1724) = lu(k,1724) - lu(k,1326) * lu(k,1716) - lu(k,1725) = lu(k,1725) - lu(k,1327) * lu(k,1716) - lu(k,1726) = lu(k,1726) - lu(k,1328) * lu(k,1716) - lu(k,1729) = lu(k,1729) - lu(k,1329) * lu(k,1716) - lu(k,1730) = lu(k,1730) - lu(k,1330) * lu(k,1716) - lu(k,1731) = lu(k,1731) - lu(k,1331) * lu(k,1716) - lu(k,1759) = lu(k,1759) - lu(k,1321) * lu(k,1757) - lu(k,1760) = lu(k,1760) - lu(k,1322) * lu(k,1757) - lu(k,1761) = lu(k,1761) - lu(k,1323) * lu(k,1757) - lu(k,1762) = lu(k,1762) - lu(k,1324) * lu(k,1757) - lu(k,1764) = lu(k,1764) - lu(k,1325) * lu(k,1757) - lu(k,1765) = lu(k,1765) - lu(k,1326) * lu(k,1757) - lu(k,1766) = lu(k,1766) - lu(k,1327) * lu(k,1757) - lu(k,1767) = lu(k,1767) - lu(k,1328) * lu(k,1757) - lu(k,1770) = lu(k,1770) - lu(k,1329) * lu(k,1757) - lu(k,1771) = lu(k,1771) - lu(k,1330) * lu(k,1757) - lu(k,1772) = lu(k,1772) - lu(k,1331) * lu(k,1757) - lu(k,1816) = lu(k,1816) - lu(k,1321) * lu(k,1814) - lu(k,1817) = lu(k,1817) - lu(k,1322) * lu(k,1814) - lu(k,1818) = lu(k,1818) - lu(k,1323) * lu(k,1814) - lu(k,1819) = lu(k,1819) - lu(k,1324) * lu(k,1814) - lu(k,1821) = lu(k,1821) - lu(k,1325) * lu(k,1814) - lu(k,1822) = lu(k,1822) - lu(k,1326) * lu(k,1814) - lu(k,1823) = lu(k,1823) - lu(k,1327) * lu(k,1814) - lu(k,1824) = lu(k,1824) - lu(k,1328) * lu(k,1814) - lu(k,1827) = lu(k,1827) - lu(k,1329) * lu(k,1814) - lu(k,1828) = lu(k,1828) - lu(k,1330) * lu(k,1814) - lu(k,1829) = lu(k,1829) - lu(k,1331) * lu(k,1814) - lu(k,1866) = lu(k,1866) - lu(k,1321) * lu(k,1864) - lu(k,1867) = lu(k,1867) - lu(k,1322) * lu(k,1864) - lu(k,1868) = lu(k,1868) - lu(k,1323) * lu(k,1864) - lu(k,1869) = lu(k,1869) - lu(k,1324) * lu(k,1864) - lu(k,1871) = lu(k,1871) - lu(k,1325) * lu(k,1864) - lu(k,1872) = lu(k,1872) - lu(k,1326) * lu(k,1864) - lu(k,1873) = lu(k,1873) - lu(k,1327) * lu(k,1864) - lu(k,1874) = lu(k,1874) - lu(k,1328) * lu(k,1864) - lu(k,1877) = lu(k,1877) - lu(k,1329) * lu(k,1864) - lu(k,1878) = lu(k,1878) - lu(k,1330) * lu(k,1864) - lu(k,1879) = lu(k,1879) - lu(k,1331) * lu(k,1864) - lu(k,1926) = lu(k,1926) - lu(k,1321) * lu(k,1924) - lu(k,1927) = lu(k,1927) - lu(k,1322) * lu(k,1924) - lu(k,1928) = lu(k,1928) - lu(k,1323) * lu(k,1924) - lu(k,1929) = lu(k,1929) - lu(k,1324) * lu(k,1924) - lu(k,1931) = lu(k,1931) - lu(k,1325) * lu(k,1924) - lu(k,1932) = lu(k,1932) - lu(k,1326) * lu(k,1924) - lu(k,1933) = lu(k,1933) - lu(k,1327) * lu(k,1924) - lu(k,1934) = lu(k,1934) - lu(k,1328) * lu(k,1924) - lu(k,1937) = lu(k,1937) - lu(k,1329) * lu(k,1924) - lu(k,1938) = lu(k,1938) - lu(k,1330) * lu(k,1924) - lu(k,1939) = lu(k,1939) - lu(k,1331) * lu(k,1924) - lu(k,1950) = lu(k,1950) - lu(k,1321) * lu(k,1948) - lu(k,1951) = lu(k,1951) - lu(k,1322) * lu(k,1948) - lu(k,1952) = lu(k,1952) - lu(k,1323) * lu(k,1948) - lu(k,1953) = lu(k,1953) - lu(k,1324) * lu(k,1948) - lu(k,1955) = lu(k,1955) - lu(k,1325) * lu(k,1948) - lu(k,1956) = lu(k,1956) - lu(k,1326) * lu(k,1948) - lu(k,1957) = lu(k,1957) - lu(k,1327) * lu(k,1948) - lu(k,1958) = lu(k,1958) - lu(k,1328) * lu(k,1948) - lu(k,1961) = lu(k,1961) - lu(k,1329) * lu(k,1948) - lu(k,1962) = lu(k,1962) - lu(k,1330) * lu(k,1948) - lu(k,1963) = lu(k,1963) - lu(k,1331) * lu(k,1948) - lu(k,1976) = lu(k,1976) - lu(k,1321) * lu(k,1974) - lu(k,1977) = lu(k,1977) - lu(k,1322) * lu(k,1974) - lu(k,1978) = lu(k,1978) - lu(k,1323) * lu(k,1974) - lu(k,1979) = lu(k,1979) - lu(k,1324) * lu(k,1974) - lu(k,1981) = lu(k,1981) - lu(k,1325) * lu(k,1974) - lu(k,1982) = lu(k,1982) - lu(k,1326) * lu(k,1974) - lu(k,1983) = lu(k,1983) - lu(k,1327) * lu(k,1974) - lu(k,1984) = lu(k,1984) - lu(k,1328) * lu(k,1974) - lu(k,1987) = lu(k,1987) - lu(k,1329) * lu(k,1974) - lu(k,1988) = lu(k,1988) - lu(k,1330) * lu(k,1974) - lu(k,1989) = lu(k,1989) - lu(k,1331) * lu(k,1974) - lu(k,2006) = lu(k,2006) - lu(k,1321) * lu(k,2004) - lu(k,2007) = lu(k,2007) - lu(k,1322) * lu(k,2004) - lu(k,2008) = lu(k,2008) - lu(k,1323) * lu(k,2004) - lu(k,2009) = lu(k,2009) - lu(k,1324) * lu(k,2004) - lu(k,2011) = lu(k,2011) - lu(k,1325) * lu(k,2004) - lu(k,2012) = lu(k,2012) - lu(k,1326) * lu(k,2004) - lu(k,2013) = lu(k,2013) - lu(k,1327) * lu(k,2004) - lu(k,2014) = lu(k,2014) - lu(k,1328) * lu(k,2004) - lu(k,2017) = lu(k,2017) - lu(k,1329) * lu(k,2004) - lu(k,2018) = lu(k,2018) - lu(k,1330) * lu(k,2004) - lu(k,2019) = lu(k,2019) - lu(k,1331) * lu(k,2004) - lu(k,2040) = lu(k,2040) - lu(k,1321) * lu(k,2038) - lu(k,2041) = lu(k,2041) - lu(k,1322) * lu(k,2038) - lu(k,2042) = lu(k,2042) - lu(k,1323) * lu(k,2038) - lu(k,2043) = lu(k,2043) - lu(k,1324) * lu(k,2038) - lu(k,2045) = lu(k,2045) - lu(k,1325) * lu(k,2038) - lu(k,2046) = lu(k,2046) - lu(k,1326) * lu(k,2038) - lu(k,2047) = lu(k,2047) - lu(k,1327) * lu(k,2038) - lu(k,2048) = lu(k,2048) - lu(k,1328) * lu(k,2038) - lu(k,2051) = lu(k,2051) - lu(k,1329) * lu(k,2038) - lu(k,2052) = lu(k,2052) - lu(k,1330) * lu(k,2038) - lu(k,2053) = lu(k,2053) - lu(k,1331) * lu(k,2038) - lu(k,2065) = lu(k,2065) - lu(k,1321) * lu(k,2063) - lu(k,2066) = lu(k,2066) - lu(k,1322) * lu(k,2063) - lu(k,2067) = lu(k,2067) - lu(k,1323) * lu(k,2063) - lu(k,2068) = lu(k,2068) - lu(k,1324) * lu(k,2063) - lu(k,2070) = lu(k,2070) - lu(k,1325) * lu(k,2063) - lu(k,2071) = lu(k,2071) - lu(k,1326) * lu(k,2063) - lu(k,2072) = lu(k,2072) - lu(k,1327) * lu(k,2063) - lu(k,2073) = lu(k,2073) - lu(k,1328) * lu(k,2063) - lu(k,2076) = lu(k,2076) - lu(k,1329) * lu(k,2063) - lu(k,2077) = lu(k,2077) - lu(k,1330) * lu(k,2063) - lu(k,2078) = lu(k,2078) - lu(k,1331) * lu(k,2063) - lu(k,1395) = 1._r8 / lu(k,1395) - lu(k,1396) = lu(k,1396) * lu(k,1395) - lu(k,1397) = lu(k,1397) * lu(k,1395) - lu(k,1398) = lu(k,1398) * lu(k,1395) - lu(k,1399) = lu(k,1399) * lu(k,1395) - lu(k,1400) = lu(k,1400) * lu(k,1395) - lu(k,1401) = lu(k,1401) * lu(k,1395) - lu(k,1402) = lu(k,1402) * lu(k,1395) - lu(k,1403) = lu(k,1403) * lu(k,1395) - lu(k,1404) = lu(k,1404) * lu(k,1395) - lu(k,1405) = lu(k,1405) * lu(k,1395) - lu(k,1406) = lu(k,1406) * lu(k,1395) - lu(k,1407) = lu(k,1407) * lu(k,1395) - lu(k,1408) = lu(k,1408) * lu(k,1395) - lu(k,1409) = lu(k,1409) * lu(k,1395) - lu(k,1512) = lu(k,1512) - lu(k,1396) * lu(k,1511) - lu(k,1513) = lu(k,1513) - lu(k,1397) * lu(k,1511) - lu(k,1514) = lu(k,1514) - lu(k,1398) * lu(k,1511) - lu(k,1515) = lu(k,1515) - lu(k,1399) * lu(k,1511) - lu(k,1516) = lu(k,1516) - lu(k,1400) * lu(k,1511) - lu(k,1517) = lu(k,1517) - lu(k,1401) * lu(k,1511) - lu(k,1518) = lu(k,1518) - lu(k,1402) * lu(k,1511) - lu(k,1519) = lu(k,1519) - lu(k,1403) * lu(k,1511) - lu(k,1520) = lu(k,1520) - lu(k,1404) * lu(k,1511) - lu(k,1521) = lu(k,1521) - lu(k,1405) * lu(k,1511) - lu(k,1522) = lu(k,1522) - lu(k,1406) * lu(k,1511) - lu(k,1523) = lu(k,1523) - lu(k,1407) * lu(k,1511) - lu(k,1524) = lu(k,1524) - lu(k,1408) * lu(k,1511) - lu(k,1525) = lu(k,1525) - lu(k,1409) * lu(k,1511) - lu(k,1536) = lu(k,1536) - lu(k,1396) * lu(k,1535) - lu(k,1537) = lu(k,1537) - lu(k,1397) * lu(k,1535) - lu(k,1538) = lu(k,1538) - lu(k,1398) * lu(k,1535) - lu(k,1539) = lu(k,1539) - lu(k,1399) * lu(k,1535) - lu(k,1540) = lu(k,1540) - lu(k,1400) * lu(k,1535) - lu(k,1541) = lu(k,1541) - lu(k,1401) * lu(k,1535) - lu(k,1542) = lu(k,1542) - lu(k,1402) * lu(k,1535) - lu(k,1543) = lu(k,1543) - lu(k,1403) * lu(k,1535) - lu(k,1544) = lu(k,1544) - lu(k,1404) * lu(k,1535) - lu(k,1545) = lu(k,1545) - lu(k,1405) * lu(k,1535) - lu(k,1546) = lu(k,1546) - lu(k,1406) * lu(k,1535) - lu(k,1547) = lu(k,1547) - lu(k,1407) * lu(k,1535) - lu(k,1548) = lu(k,1548) - lu(k,1408) * lu(k,1535) - lu(k,1549) = lu(k,1549) - lu(k,1409) * lu(k,1535) - lu(k,1695) = lu(k,1695) - lu(k,1396) * lu(k,1694) - lu(k,1696) = lu(k,1696) - lu(k,1397) * lu(k,1694) - lu(k,1697) = lu(k,1697) - lu(k,1398) * lu(k,1694) - lu(k,1698) = lu(k,1698) - lu(k,1399) * lu(k,1694) - lu(k,1699) = lu(k,1699) - lu(k,1400) * lu(k,1694) - lu(k,1700) = lu(k,1700) - lu(k,1401) * lu(k,1694) - lu(k,1701) = lu(k,1701) - lu(k,1402) * lu(k,1694) - lu(k,1702) = lu(k,1702) - lu(k,1403) * lu(k,1694) - lu(k,1703) = lu(k,1703) - lu(k,1404) * lu(k,1694) - lu(k,1704) = lu(k,1704) - lu(k,1405) * lu(k,1694) - lu(k,1705) = lu(k,1705) - lu(k,1406) * lu(k,1694) - lu(k,1706) = lu(k,1706) - lu(k,1407) * lu(k,1694) - lu(k,1707) = lu(k,1707) - lu(k,1408) * lu(k,1694) - lu(k,1708) = lu(k,1708) - lu(k,1409) * lu(k,1694) - lu(k,1718) = lu(k,1718) - lu(k,1396) * lu(k,1717) - lu(k,1719) = lu(k,1719) - lu(k,1397) * lu(k,1717) - lu(k,1720) = lu(k,1720) - lu(k,1398) * lu(k,1717) - lu(k,1721) = lu(k,1721) - lu(k,1399) * lu(k,1717) - lu(k,1722) = lu(k,1722) - lu(k,1400) * lu(k,1717) - lu(k,1723) = lu(k,1723) - lu(k,1401) * lu(k,1717) - lu(k,1724) = lu(k,1724) - lu(k,1402) * lu(k,1717) - lu(k,1725) = lu(k,1725) - lu(k,1403) * lu(k,1717) - lu(k,1726) = lu(k,1726) - lu(k,1404) * lu(k,1717) - lu(k,1727) = lu(k,1727) - lu(k,1405) * lu(k,1717) - lu(k,1728) = - lu(k,1406) * lu(k,1717) - lu(k,1729) = lu(k,1729) - lu(k,1407) * lu(k,1717) - lu(k,1730) = lu(k,1730) - lu(k,1408) * lu(k,1717) - lu(k,1731) = lu(k,1731) - lu(k,1409) * lu(k,1717) - lu(k,1759) = lu(k,1759) - lu(k,1396) * lu(k,1758) - lu(k,1760) = lu(k,1760) - lu(k,1397) * lu(k,1758) - lu(k,1761) = lu(k,1761) - lu(k,1398) * lu(k,1758) - lu(k,1762) = lu(k,1762) - lu(k,1399) * lu(k,1758) - lu(k,1763) = lu(k,1763) - lu(k,1400) * lu(k,1758) - lu(k,1764) = lu(k,1764) - lu(k,1401) * lu(k,1758) - lu(k,1765) = lu(k,1765) - lu(k,1402) * lu(k,1758) - lu(k,1766) = lu(k,1766) - lu(k,1403) * lu(k,1758) - lu(k,1767) = lu(k,1767) - lu(k,1404) * lu(k,1758) - lu(k,1768) = lu(k,1768) - lu(k,1405) * lu(k,1758) - lu(k,1769) = lu(k,1769) - lu(k,1406) * lu(k,1758) - lu(k,1770) = lu(k,1770) - lu(k,1407) * lu(k,1758) - lu(k,1771) = lu(k,1771) - lu(k,1408) * lu(k,1758) - lu(k,1772) = lu(k,1772) - lu(k,1409) * lu(k,1758) - lu(k,1816) = lu(k,1816) - lu(k,1396) * lu(k,1815) - lu(k,1817) = lu(k,1817) - lu(k,1397) * lu(k,1815) - lu(k,1818) = lu(k,1818) - lu(k,1398) * lu(k,1815) - lu(k,1819) = lu(k,1819) - lu(k,1399) * lu(k,1815) - lu(k,1820) = lu(k,1820) - lu(k,1400) * lu(k,1815) - lu(k,1821) = lu(k,1821) - lu(k,1401) * lu(k,1815) - lu(k,1822) = lu(k,1822) - lu(k,1402) * lu(k,1815) - lu(k,1823) = lu(k,1823) - lu(k,1403) * lu(k,1815) - lu(k,1824) = lu(k,1824) - lu(k,1404) * lu(k,1815) - lu(k,1825) = lu(k,1825) - lu(k,1405) * lu(k,1815) - lu(k,1826) = lu(k,1826) - lu(k,1406) * lu(k,1815) - lu(k,1827) = lu(k,1827) - lu(k,1407) * lu(k,1815) - lu(k,1828) = lu(k,1828) - lu(k,1408) * lu(k,1815) - lu(k,1829) = lu(k,1829) - lu(k,1409) * lu(k,1815) - lu(k,1866) = lu(k,1866) - lu(k,1396) * lu(k,1865) - lu(k,1867) = lu(k,1867) - lu(k,1397) * lu(k,1865) - lu(k,1868) = lu(k,1868) - lu(k,1398) * lu(k,1865) - lu(k,1869) = lu(k,1869) - lu(k,1399) * lu(k,1865) - lu(k,1870) = lu(k,1870) - lu(k,1400) * lu(k,1865) - lu(k,1871) = lu(k,1871) - lu(k,1401) * lu(k,1865) - lu(k,1872) = lu(k,1872) - lu(k,1402) * lu(k,1865) - lu(k,1873) = lu(k,1873) - lu(k,1403) * lu(k,1865) - lu(k,1874) = lu(k,1874) - lu(k,1404) * lu(k,1865) - lu(k,1875) = - lu(k,1405) * lu(k,1865) - lu(k,1876) = lu(k,1876) - lu(k,1406) * lu(k,1865) - lu(k,1877) = lu(k,1877) - lu(k,1407) * lu(k,1865) - lu(k,1878) = lu(k,1878) - lu(k,1408) * lu(k,1865) - lu(k,1879) = lu(k,1879) - lu(k,1409) * lu(k,1865) - lu(k,1926) = lu(k,1926) - lu(k,1396) * lu(k,1925) - lu(k,1927) = lu(k,1927) - lu(k,1397) * lu(k,1925) - lu(k,1928) = lu(k,1928) - lu(k,1398) * lu(k,1925) - lu(k,1929) = lu(k,1929) - lu(k,1399) * lu(k,1925) - lu(k,1930) = lu(k,1930) - lu(k,1400) * lu(k,1925) - lu(k,1931) = lu(k,1931) - lu(k,1401) * lu(k,1925) - lu(k,1932) = lu(k,1932) - lu(k,1402) * lu(k,1925) - lu(k,1933) = lu(k,1933) - lu(k,1403) * lu(k,1925) - lu(k,1934) = lu(k,1934) - lu(k,1404) * lu(k,1925) - lu(k,1935) = lu(k,1935) - lu(k,1405) * lu(k,1925) - lu(k,1936) = lu(k,1936) - lu(k,1406) * lu(k,1925) - lu(k,1937) = lu(k,1937) - lu(k,1407) * lu(k,1925) - lu(k,1938) = lu(k,1938) - lu(k,1408) * lu(k,1925) - lu(k,1939) = lu(k,1939) - lu(k,1409) * lu(k,1925) - lu(k,1950) = lu(k,1950) - lu(k,1396) * lu(k,1949) - lu(k,1951) = lu(k,1951) - lu(k,1397) * lu(k,1949) - lu(k,1952) = lu(k,1952) - lu(k,1398) * lu(k,1949) - lu(k,1953) = lu(k,1953) - lu(k,1399) * lu(k,1949) - lu(k,1954) = lu(k,1954) - lu(k,1400) * lu(k,1949) - lu(k,1955) = lu(k,1955) - lu(k,1401) * lu(k,1949) - lu(k,1956) = lu(k,1956) - lu(k,1402) * lu(k,1949) - lu(k,1957) = lu(k,1957) - lu(k,1403) * lu(k,1949) - lu(k,1958) = lu(k,1958) - lu(k,1404) * lu(k,1949) - lu(k,1959) = lu(k,1959) - lu(k,1405) * lu(k,1949) - lu(k,1960) = lu(k,1960) - lu(k,1406) * lu(k,1949) - lu(k,1961) = lu(k,1961) - lu(k,1407) * lu(k,1949) - lu(k,1962) = lu(k,1962) - lu(k,1408) * lu(k,1949) - lu(k,1963) = lu(k,1963) - lu(k,1409) * lu(k,1949) - lu(k,1976) = lu(k,1976) - lu(k,1396) * lu(k,1975) - lu(k,1977) = lu(k,1977) - lu(k,1397) * lu(k,1975) - lu(k,1978) = lu(k,1978) - lu(k,1398) * lu(k,1975) - lu(k,1979) = lu(k,1979) - lu(k,1399) * lu(k,1975) - lu(k,1980) = lu(k,1980) - lu(k,1400) * lu(k,1975) - lu(k,1981) = lu(k,1981) - lu(k,1401) * lu(k,1975) - lu(k,1982) = lu(k,1982) - lu(k,1402) * lu(k,1975) - lu(k,1983) = lu(k,1983) - lu(k,1403) * lu(k,1975) - lu(k,1984) = lu(k,1984) - lu(k,1404) * lu(k,1975) - lu(k,1985) = lu(k,1985) - lu(k,1405) * lu(k,1975) - lu(k,1986) = lu(k,1986) - lu(k,1406) * lu(k,1975) - lu(k,1987) = lu(k,1987) - lu(k,1407) * lu(k,1975) - lu(k,1988) = lu(k,1988) - lu(k,1408) * lu(k,1975) - lu(k,1989) = lu(k,1989) - lu(k,1409) * lu(k,1975) - lu(k,2006) = lu(k,2006) - lu(k,1396) * lu(k,2005) - lu(k,2007) = lu(k,2007) - lu(k,1397) * lu(k,2005) - lu(k,2008) = lu(k,2008) - lu(k,1398) * lu(k,2005) - lu(k,2009) = lu(k,2009) - lu(k,1399) * lu(k,2005) - lu(k,2010) = lu(k,2010) - lu(k,1400) * lu(k,2005) - lu(k,2011) = lu(k,2011) - lu(k,1401) * lu(k,2005) - lu(k,2012) = lu(k,2012) - lu(k,1402) * lu(k,2005) - lu(k,2013) = lu(k,2013) - lu(k,1403) * lu(k,2005) - lu(k,2014) = lu(k,2014) - lu(k,1404) * lu(k,2005) - lu(k,2015) = lu(k,2015) - lu(k,1405) * lu(k,2005) - lu(k,2016) = lu(k,2016) - lu(k,1406) * lu(k,2005) - lu(k,2017) = lu(k,2017) - lu(k,1407) * lu(k,2005) - lu(k,2018) = lu(k,2018) - lu(k,1408) * lu(k,2005) - lu(k,2019) = lu(k,2019) - lu(k,1409) * lu(k,2005) - lu(k,2040) = lu(k,2040) - lu(k,1396) * lu(k,2039) - lu(k,2041) = lu(k,2041) - lu(k,1397) * lu(k,2039) - lu(k,2042) = lu(k,2042) - lu(k,1398) * lu(k,2039) - lu(k,2043) = lu(k,2043) - lu(k,1399) * lu(k,2039) - lu(k,2044) = lu(k,2044) - lu(k,1400) * lu(k,2039) - lu(k,2045) = lu(k,2045) - lu(k,1401) * lu(k,2039) - lu(k,2046) = lu(k,2046) - lu(k,1402) * lu(k,2039) - lu(k,2047) = lu(k,2047) - lu(k,1403) * lu(k,2039) - lu(k,2048) = lu(k,2048) - lu(k,1404) * lu(k,2039) - lu(k,2049) = lu(k,2049) - lu(k,1405) * lu(k,2039) - lu(k,2050) = lu(k,2050) - lu(k,1406) * lu(k,2039) - lu(k,2051) = lu(k,2051) - lu(k,1407) * lu(k,2039) - lu(k,2052) = lu(k,2052) - lu(k,1408) * lu(k,2039) - lu(k,2053) = lu(k,2053) - lu(k,1409) * lu(k,2039) - lu(k,2065) = lu(k,2065) - lu(k,1396) * lu(k,2064) - lu(k,2066) = lu(k,2066) - lu(k,1397) * lu(k,2064) - lu(k,2067) = lu(k,2067) - lu(k,1398) * lu(k,2064) - lu(k,2068) = lu(k,2068) - lu(k,1399) * lu(k,2064) - lu(k,2069) = lu(k,2069) - lu(k,1400) * lu(k,2064) - lu(k,2070) = lu(k,2070) - lu(k,1401) * lu(k,2064) - lu(k,2071) = lu(k,2071) - lu(k,1402) * lu(k,2064) - lu(k,2072) = lu(k,2072) - lu(k,1403) * lu(k,2064) - lu(k,2073) = lu(k,2073) - lu(k,1404) * lu(k,2064) - lu(k,2074) = lu(k,2074) - lu(k,1405) * lu(k,2064) - lu(k,2075) = lu(k,2075) - lu(k,1406) * lu(k,2064) - lu(k,2076) = lu(k,2076) - lu(k,1407) * lu(k,2064) - lu(k,2077) = lu(k,2077) - lu(k,1408) * lu(k,2064) - lu(k,2078) = lu(k,2078) - lu(k,1409) * lu(k,2064) - lu(k,1418) = 1._r8 / lu(k,1418) - lu(k,1419) = lu(k,1419) * lu(k,1418) - lu(k,1420) = lu(k,1420) * lu(k,1418) - lu(k,1421) = lu(k,1421) * lu(k,1418) - lu(k,1422) = lu(k,1422) * lu(k,1418) - lu(k,1423) = lu(k,1423) * lu(k,1418) - lu(k,1424) = lu(k,1424) * lu(k,1418) - lu(k,1425) = lu(k,1425) * lu(k,1418) - lu(k,1426) = lu(k,1426) * lu(k,1418) - lu(k,1427) = lu(k,1427) * lu(k,1418) - lu(k,1428) = lu(k,1428) * lu(k,1418) - lu(k,1429) = lu(k,1429) * lu(k,1418) - lu(k,1430) = lu(k,1430) * lu(k,1418) - lu(k,1431) = lu(k,1431) * lu(k,1418) - lu(k,1513) = lu(k,1513) - lu(k,1419) * lu(k,1512) - lu(k,1514) = lu(k,1514) - lu(k,1420) * lu(k,1512) - lu(k,1515) = lu(k,1515) - lu(k,1421) * lu(k,1512) - lu(k,1516) = lu(k,1516) - lu(k,1422) * lu(k,1512) - lu(k,1517) = lu(k,1517) - lu(k,1423) * lu(k,1512) - lu(k,1518) = lu(k,1518) - lu(k,1424) * lu(k,1512) - lu(k,1519) = lu(k,1519) - lu(k,1425) * lu(k,1512) - lu(k,1520) = lu(k,1520) - lu(k,1426) * lu(k,1512) - lu(k,1521) = lu(k,1521) - lu(k,1427) * lu(k,1512) - lu(k,1522) = lu(k,1522) - lu(k,1428) * lu(k,1512) - lu(k,1523) = lu(k,1523) - lu(k,1429) * lu(k,1512) - lu(k,1524) = lu(k,1524) - lu(k,1430) * lu(k,1512) - lu(k,1525) = lu(k,1525) - lu(k,1431) * lu(k,1512) - lu(k,1537) = lu(k,1537) - lu(k,1419) * lu(k,1536) - lu(k,1538) = lu(k,1538) - lu(k,1420) * lu(k,1536) - lu(k,1539) = lu(k,1539) - lu(k,1421) * lu(k,1536) - lu(k,1540) = lu(k,1540) - lu(k,1422) * lu(k,1536) - lu(k,1541) = lu(k,1541) - lu(k,1423) * lu(k,1536) - lu(k,1542) = lu(k,1542) - lu(k,1424) * lu(k,1536) - lu(k,1543) = lu(k,1543) - lu(k,1425) * lu(k,1536) - lu(k,1544) = lu(k,1544) - lu(k,1426) * lu(k,1536) - lu(k,1545) = lu(k,1545) - lu(k,1427) * lu(k,1536) - lu(k,1546) = lu(k,1546) - lu(k,1428) * lu(k,1536) - lu(k,1547) = lu(k,1547) - lu(k,1429) * lu(k,1536) - lu(k,1548) = lu(k,1548) - lu(k,1430) * lu(k,1536) - lu(k,1549) = lu(k,1549) - lu(k,1431) * lu(k,1536) - lu(k,1696) = lu(k,1696) - lu(k,1419) * lu(k,1695) - lu(k,1697) = lu(k,1697) - lu(k,1420) * lu(k,1695) - lu(k,1698) = lu(k,1698) - lu(k,1421) * lu(k,1695) - lu(k,1699) = lu(k,1699) - lu(k,1422) * lu(k,1695) - lu(k,1700) = lu(k,1700) - lu(k,1423) * lu(k,1695) - lu(k,1701) = lu(k,1701) - lu(k,1424) * lu(k,1695) - lu(k,1702) = lu(k,1702) - lu(k,1425) * lu(k,1695) - lu(k,1703) = lu(k,1703) - lu(k,1426) * lu(k,1695) - lu(k,1704) = lu(k,1704) - lu(k,1427) * lu(k,1695) - lu(k,1705) = lu(k,1705) - lu(k,1428) * lu(k,1695) - lu(k,1706) = lu(k,1706) - lu(k,1429) * lu(k,1695) - lu(k,1707) = lu(k,1707) - lu(k,1430) * lu(k,1695) - lu(k,1708) = lu(k,1708) - lu(k,1431) * lu(k,1695) - lu(k,1719) = lu(k,1719) - lu(k,1419) * lu(k,1718) - lu(k,1720) = lu(k,1720) - lu(k,1420) * lu(k,1718) - lu(k,1721) = lu(k,1721) - lu(k,1421) * lu(k,1718) - lu(k,1722) = lu(k,1722) - lu(k,1422) * lu(k,1718) - lu(k,1723) = lu(k,1723) - lu(k,1423) * lu(k,1718) - lu(k,1724) = lu(k,1724) - lu(k,1424) * lu(k,1718) - lu(k,1725) = lu(k,1725) - lu(k,1425) * lu(k,1718) - lu(k,1726) = lu(k,1726) - lu(k,1426) * lu(k,1718) - lu(k,1727) = lu(k,1727) - lu(k,1427) * lu(k,1718) - lu(k,1728) = lu(k,1728) - lu(k,1428) * lu(k,1718) - lu(k,1729) = lu(k,1729) - lu(k,1429) * lu(k,1718) - lu(k,1730) = lu(k,1730) - lu(k,1430) * lu(k,1718) - lu(k,1731) = lu(k,1731) - lu(k,1431) * lu(k,1718) - lu(k,1760) = lu(k,1760) - lu(k,1419) * lu(k,1759) - lu(k,1761) = lu(k,1761) - lu(k,1420) * lu(k,1759) - lu(k,1762) = lu(k,1762) - lu(k,1421) * lu(k,1759) - lu(k,1763) = lu(k,1763) - lu(k,1422) * lu(k,1759) - lu(k,1764) = lu(k,1764) - lu(k,1423) * lu(k,1759) - lu(k,1765) = lu(k,1765) - lu(k,1424) * lu(k,1759) - lu(k,1766) = lu(k,1766) - lu(k,1425) * lu(k,1759) - lu(k,1767) = lu(k,1767) - lu(k,1426) * lu(k,1759) - lu(k,1768) = lu(k,1768) - lu(k,1427) * lu(k,1759) - lu(k,1769) = lu(k,1769) - lu(k,1428) * lu(k,1759) - lu(k,1770) = lu(k,1770) - lu(k,1429) * lu(k,1759) - lu(k,1771) = lu(k,1771) - lu(k,1430) * lu(k,1759) - lu(k,1772) = lu(k,1772) - lu(k,1431) * lu(k,1759) - lu(k,1817) = lu(k,1817) - lu(k,1419) * lu(k,1816) - lu(k,1818) = lu(k,1818) - lu(k,1420) * lu(k,1816) - lu(k,1819) = lu(k,1819) - lu(k,1421) * lu(k,1816) - lu(k,1820) = lu(k,1820) - lu(k,1422) * lu(k,1816) - lu(k,1821) = lu(k,1821) - lu(k,1423) * lu(k,1816) - lu(k,1822) = lu(k,1822) - lu(k,1424) * lu(k,1816) - lu(k,1823) = lu(k,1823) - lu(k,1425) * lu(k,1816) - lu(k,1824) = lu(k,1824) - lu(k,1426) * lu(k,1816) - lu(k,1825) = lu(k,1825) - lu(k,1427) * lu(k,1816) - lu(k,1826) = lu(k,1826) - lu(k,1428) * lu(k,1816) - lu(k,1827) = lu(k,1827) - lu(k,1429) * lu(k,1816) - lu(k,1828) = lu(k,1828) - lu(k,1430) * lu(k,1816) - lu(k,1829) = lu(k,1829) - lu(k,1431) * lu(k,1816) - lu(k,1867) = lu(k,1867) - lu(k,1419) * lu(k,1866) - lu(k,1868) = lu(k,1868) - lu(k,1420) * lu(k,1866) - lu(k,1869) = lu(k,1869) - lu(k,1421) * lu(k,1866) - lu(k,1870) = lu(k,1870) - lu(k,1422) * lu(k,1866) - lu(k,1871) = lu(k,1871) - lu(k,1423) * lu(k,1866) - lu(k,1872) = lu(k,1872) - lu(k,1424) * lu(k,1866) - lu(k,1873) = lu(k,1873) - lu(k,1425) * lu(k,1866) - lu(k,1874) = lu(k,1874) - lu(k,1426) * lu(k,1866) - lu(k,1875) = lu(k,1875) - lu(k,1427) * lu(k,1866) - lu(k,1876) = lu(k,1876) - lu(k,1428) * lu(k,1866) - lu(k,1877) = lu(k,1877) - lu(k,1429) * lu(k,1866) - lu(k,1878) = lu(k,1878) - lu(k,1430) * lu(k,1866) - lu(k,1879) = lu(k,1879) - lu(k,1431) * lu(k,1866) - lu(k,1927) = lu(k,1927) - lu(k,1419) * lu(k,1926) - lu(k,1928) = lu(k,1928) - lu(k,1420) * lu(k,1926) - lu(k,1929) = lu(k,1929) - lu(k,1421) * lu(k,1926) - lu(k,1930) = lu(k,1930) - lu(k,1422) * lu(k,1926) - lu(k,1931) = lu(k,1931) - lu(k,1423) * lu(k,1926) - lu(k,1932) = lu(k,1932) - lu(k,1424) * lu(k,1926) - lu(k,1933) = lu(k,1933) - lu(k,1425) * lu(k,1926) - lu(k,1934) = lu(k,1934) - lu(k,1426) * lu(k,1926) - lu(k,1935) = lu(k,1935) - lu(k,1427) * lu(k,1926) - lu(k,1936) = lu(k,1936) - lu(k,1428) * lu(k,1926) - lu(k,1937) = lu(k,1937) - lu(k,1429) * lu(k,1926) - lu(k,1938) = lu(k,1938) - lu(k,1430) * lu(k,1926) - lu(k,1939) = lu(k,1939) - lu(k,1431) * lu(k,1926) - lu(k,1951) = lu(k,1951) - lu(k,1419) * lu(k,1950) - lu(k,1952) = lu(k,1952) - lu(k,1420) * lu(k,1950) - lu(k,1953) = lu(k,1953) - lu(k,1421) * lu(k,1950) - lu(k,1954) = lu(k,1954) - lu(k,1422) * lu(k,1950) - lu(k,1955) = lu(k,1955) - lu(k,1423) * lu(k,1950) - lu(k,1956) = lu(k,1956) - lu(k,1424) * lu(k,1950) - lu(k,1957) = lu(k,1957) - lu(k,1425) * lu(k,1950) - lu(k,1958) = lu(k,1958) - lu(k,1426) * lu(k,1950) - lu(k,1959) = lu(k,1959) - lu(k,1427) * lu(k,1950) - lu(k,1960) = lu(k,1960) - lu(k,1428) * lu(k,1950) - lu(k,1961) = lu(k,1961) - lu(k,1429) * lu(k,1950) - lu(k,1962) = lu(k,1962) - lu(k,1430) * lu(k,1950) - lu(k,1963) = lu(k,1963) - lu(k,1431) * lu(k,1950) - lu(k,1977) = lu(k,1977) - lu(k,1419) * lu(k,1976) - lu(k,1978) = lu(k,1978) - lu(k,1420) * lu(k,1976) - lu(k,1979) = lu(k,1979) - lu(k,1421) * lu(k,1976) - lu(k,1980) = lu(k,1980) - lu(k,1422) * lu(k,1976) - lu(k,1981) = lu(k,1981) - lu(k,1423) * lu(k,1976) - lu(k,1982) = lu(k,1982) - lu(k,1424) * lu(k,1976) - lu(k,1983) = lu(k,1983) - lu(k,1425) * lu(k,1976) - lu(k,1984) = lu(k,1984) - lu(k,1426) * lu(k,1976) - lu(k,1985) = lu(k,1985) - lu(k,1427) * lu(k,1976) - lu(k,1986) = lu(k,1986) - lu(k,1428) * lu(k,1976) - lu(k,1987) = lu(k,1987) - lu(k,1429) * lu(k,1976) - lu(k,1988) = lu(k,1988) - lu(k,1430) * lu(k,1976) - lu(k,1989) = lu(k,1989) - lu(k,1431) * lu(k,1976) - lu(k,2007) = lu(k,2007) - lu(k,1419) * lu(k,2006) - lu(k,2008) = lu(k,2008) - lu(k,1420) * lu(k,2006) - lu(k,2009) = lu(k,2009) - lu(k,1421) * lu(k,2006) - lu(k,2010) = lu(k,2010) - lu(k,1422) * lu(k,2006) - lu(k,2011) = lu(k,2011) - lu(k,1423) * lu(k,2006) - lu(k,2012) = lu(k,2012) - lu(k,1424) * lu(k,2006) - lu(k,2013) = lu(k,2013) - lu(k,1425) * lu(k,2006) - lu(k,2014) = lu(k,2014) - lu(k,1426) * lu(k,2006) - lu(k,2015) = lu(k,2015) - lu(k,1427) * lu(k,2006) - lu(k,2016) = lu(k,2016) - lu(k,1428) * lu(k,2006) - lu(k,2017) = lu(k,2017) - lu(k,1429) * lu(k,2006) - lu(k,2018) = lu(k,2018) - lu(k,1430) * lu(k,2006) - lu(k,2019) = lu(k,2019) - lu(k,1431) * lu(k,2006) - lu(k,2041) = lu(k,2041) - lu(k,1419) * lu(k,2040) - lu(k,2042) = lu(k,2042) - lu(k,1420) * lu(k,2040) - lu(k,2043) = lu(k,2043) - lu(k,1421) * lu(k,2040) - lu(k,2044) = lu(k,2044) - lu(k,1422) * lu(k,2040) - lu(k,2045) = lu(k,2045) - lu(k,1423) * lu(k,2040) - lu(k,2046) = lu(k,2046) - lu(k,1424) * lu(k,2040) - lu(k,2047) = lu(k,2047) - lu(k,1425) * lu(k,2040) - lu(k,2048) = lu(k,2048) - lu(k,1426) * lu(k,2040) - lu(k,2049) = lu(k,2049) - lu(k,1427) * lu(k,2040) - lu(k,2050) = lu(k,2050) - lu(k,1428) * lu(k,2040) - lu(k,2051) = lu(k,2051) - lu(k,1429) * lu(k,2040) - lu(k,2052) = lu(k,2052) - lu(k,1430) * lu(k,2040) - lu(k,2053) = lu(k,2053) - lu(k,1431) * lu(k,2040) - lu(k,2066) = lu(k,2066) - lu(k,1419) * lu(k,2065) - lu(k,2067) = lu(k,2067) - lu(k,1420) * lu(k,2065) - lu(k,2068) = lu(k,2068) - lu(k,1421) * lu(k,2065) - lu(k,2069) = lu(k,2069) - lu(k,1422) * lu(k,2065) - lu(k,2070) = lu(k,2070) - lu(k,1423) * lu(k,2065) - lu(k,2071) = lu(k,2071) - lu(k,1424) * lu(k,2065) - lu(k,2072) = lu(k,2072) - lu(k,1425) * lu(k,2065) - lu(k,2073) = lu(k,2073) - lu(k,1426) * lu(k,2065) - lu(k,2074) = lu(k,2074) - lu(k,1427) * lu(k,2065) - lu(k,2075) = lu(k,2075) - lu(k,1428) * lu(k,2065) - lu(k,2076) = lu(k,2076) - lu(k,1429) * lu(k,2065) - lu(k,2077) = lu(k,2077) - lu(k,1430) * lu(k,2065) - lu(k,2078) = lu(k,2078) - lu(k,1431) * lu(k,2065) - lu(k,1513) = 1._r8 / lu(k,1513) - lu(k,1514) = lu(k,1514) * lu(k,1513) - lu(k,1515) = lu(k,1515) * lu(k,1513) - lu(k,1516) = lu(k,1516) * lu(k,1513) - lu(k,1517) = lu(k,1517) * lu(k,1513) - lu(k,1518) = lu(k,1518) * lu(k,1513) - lu(k,1519) = lu(k,1519) * lu(k,1513) - lu(k,1520) = lu(k,1520) * lu(k,1513) - lu(k,1521) = lu(k,1521) * lu(k,1513) - lu(k,1522) = lu(k,1522) * lu(k,1513) - lu(k,1523) = lu(k,1523) * lu(k,1513) - lu(k,1524) = lu(k,1524) * lu(k,1513) - lu(k,1525) = lu(k,1525) * lu(k,1513) - lu(k,1538) = lu(k,1538) - lu(k,1514) * lu(k,1537) - lu(k,1539) = lu(k,1539) - lu(k,1515) * lu(k,1537) - lu(k,1540) = lu(k,1540) - lu(k,1516) * lu(k,1537) - lu(k,1541) = lu(k,1541) - lu(k,1517) * lu(k,1537) - lu(k,1542) = lu(k,1542) - lu(k,1518) * lu(k,1537) - lu(k,1543) = lu(k,1543) - lu(k,1519) * lu(k,1537) - lu(k,1544) = lu(k,1544) - lu(k,1520) * lu(k,1537) - lu(k,1545) = lu(k,1545) - lu(k,1521) * lu(k,1537) - lu(k,1546) = lu(k,1546) - lu(k,1522) * lu(k,1537) - lu(k,1547) = lu(k,1547) - lu(k,1523) * lu(k,1537) - lu(k,1548) = lu(k,1548) - lu(k,1524) * lu(k,1537) - lu(k,1549) = lu(k,1549) - lu(k,1525) * lu(k,1537) - lu(k,1697) = lu(k,1697) - lu(k,1514) * lu(k,1696) - lu(k,1698) = lu(k,1698) - lu(k,1515) * lu(k,1696) - lu(k,1699) = lu(k,1699) - lu(k,1516) * lu(k,1696) - lu(k,1700) = lu(k,1700) - lu(k,1517) * lu(k,1696) - lu(k,1701) = lu(k,1701) - lu(k,1518) * lu(k,1696) - lu(k,1702) = lu(k,1702) - lu(k,1519) * lu(k,1696) - lu(k,1703) = lu(k,1703) - lu(k,1520) * lu(k,1696) - lu(k,1704) = lu(k,1704) - lu(k,1521) * lu(k,1696) - lu(k,1705) = lu(k,1705) - lu(k,1522) * lu(k,1696) - lu(k,1706) = lu(k,1706) - lu(k,1523) * lu(k,1696) - lu(k,1707) = lu(k,1707) - lu(k,1524) * lu(k,1696) - lu(k,1708) = lu(k,1708) - lu(k,1525) * lu(k,1696) - lu(k,1720) = lu(k,1720) - lu(k,1514) * lu(k,1719) - lu(k,1721) = lu(k,1721) - lu(k,1515) * lu(k,1719) - lu(k,1722) = lu(k,1722) - lu(k,1516) * lu(k,1719) - lu(k,1723) = lu(k,1723) - lu(k,1517) * lu(k,1719) - lu(k,1724) = lu(k,1724) - lu(k,1518) * lu(k,1719) - lu(k,1725) = lu(k,1725) - lu(k,1519) * lu(k,1719) - lu(k,1726) = lu(k,1726) - lu(k,1520) * lu(k,1719) - lu(k,1727) = lu(k,1727) - lu(k,1521) * lu(k,1719) - lu(k,1728) = lu(k,1728) - lu(k,1522) * lu(k,1719) - lu(k,1729) = lu(k,1729) - lu(k,1523) * lu(k,1719) - lu(k,1730) = lu(k,1730) - lu(k,1524) * lu(k,1719) - lu(k,1731) = lu(k,1731) - lu(k,1525) * lu(k,1719) - lu(k,1761) = lu(k,1761) - lu(k,1514) * lu(k,1760) - lu(k,1762) = lu(k,1762) - lu(k,1515) * lu(k,1760) - lu(k,1763) = lu(k,1763) - lu(k,1516) * lu(k,1760) - lu(k,1764) = lu(k,1764) - lu(k,1517) * lu(k,1760) - lu(k,1765) = lu(k,1765) - lu(k,1518) * lu(k,1760) - lu(k,1766) = lu(k,1766) - lu(k,1519) * lu(k,1760) - lu(k,1767) = lu(k,1767) - lu(k,1520) * lu(k,1760) - lu(k,1768) = lu(k,1768) - lu(k,1521) * lu(k,1760) - lu(k,1769) = lu(k,1769) - lu(k,1522) * lu(k,1760) - lu(k,1770) = lu(k,1770) - lu(k,1523) * lu(k,1760) - lu(k,1771) = lu(k,1771) - lu(k,1524) * lu(k,1760) - lu(k,1772) = lu(k,1772) - lu(k,1525) * lu(k,1760) - lu(k,1818) = lu(k,1818) - lu(k,1514) * lu(k,1817) - lu(k,1819) = lu(k,1819) - lu(k,1515) * lu(k,1817) - lu(k,1820) = lu(k,1820) - lu(k,1516) * lu(k,1817) - lu(k,1821) = lu(k,1821) - lu(k,1517) * lu(k,1817) - lu(k,1822) = lu(k,1822) - lu(k,1518) * lu(k,1817) - lu(k,1823) = lu(k,1823) - lu(k,1519) * lu(k,1817) - lu(k,1824) = lu(k,1824) - lu(k,1520) * lu(k,1817) - lu(k,1825) = lu(k,1825) - lu(k,1521) * lu(k,1817) - lu(k,1826) = lu(k,1826) - lu(k,1522) * lu(k,1817) - lu(k,1827) = lu(k,1827) - lu(k,1523) * lu(k,1817) - lu(k,1828) = lu(k,1828) - lu(k,1524) * lu(k,1817) - lu(k,1829) = lu(k,1829) - lu(k,1525) * lu(k,1817) - lu(k,1868) = lu(k,1868) - lu(k,1514) * lu(k,1867) - lu(k,1869) = lu(k,1869) - lu(k,1515) * lu(k,1867) - lu(k,1870) = lu(k,1870) - lu(k,1516) * lu(k,1867) - lu(k,1871) = lu(k,1871) - lu(k,1517) * lu(k,1867) - lu(k,1872) = lu(k,1872) - lu(k,1518) * lu(k,1867) - lu(k,1873) = lu(k,1873) - lu(k,1519) * lu(k,1867) - lu(k,1874) = lu(k,1874) - lu(k,1520) * lu(k,1867) - lu(k,1875) = lu(k,1875) - lu(k,1521) * lu(k,1867) - lu(k,1876) = lu(k,1876) - lu(k,1522) * lu(k,1867) - lu(k,1877) = lu(k,1877) - lu(k,1523) * lu(k,1867) - lu(k,1878) = lu(k,1878) - lu(k,1524) * lu(k,1867) - lu(k,1879) = lu(k,1879) - lu(k,1525) * lu(k,1867) - lu(k,1928) = lu(k,1928) - lu(k,1514) * lu(k,1927) - lu(k,1929) = lu(k,1929) - lu(k,1515) * lu(k,1927) - lu(k,1930) = lu(k,1930) - lu(k,1516) * lu(k,1927) - lu(k,1931) = lu(k,1931) - lu(k,1517) * lu(k,1927) - lu(k,1932) = lu(k,1932) - lu(k,1518) * lu(k,1927) - lu(k,1933) = lu(k,1933) - lu(k,1519) * lu(k,1927) - lu(k,1934) = lu(k,1934) - lu(k,1520) * lu(k,1927) - lu(k,1935) = lu(k,1935) - lu(k,1521) * lu(k,1927) - lu(k,1936) = lu(k,1936) - lu(k,1522) * lu(k,1927) - lu(k,1937) = lu(k,1937) - lu(k,1523) * lu(k,1927) - lu(k,1938) = lu(k,1938) - lu(k,1524) * lu(k,1927) - lu(k,1939) = lu(k,1939) - lu(k,1525) * lu(k,1927) - lu(k,1952) = lu(k,1952) - lu(k,1514) * lu(k,1951) - lu(k,1953) = lu(k,1953) - lu(k,1515) * lu(k,1951) - lu(k,1954) = lu(k,1954) - lu(k,1516) * lu(k,1951) - lu(k,1955) = lu(k,1955) - lu(k,1517) * lu(k,1951) - lu(k,1956) = lu(k,1956) - lu(k,1518) * lu(k,1951) - lu(k,1957) = lu(k,1957) - lu(k,1519) * lu(k,1951) - lu(k,1958) = lu(k,1958) - lu(k,1520) * lu(k,1951) - lu(k,1959) = lu(k,1959) - lu(k,1521) * lu(k,1951) - lu(k,1960) = lu(k,1960) - lu(k,1522) * lu(k,1951) - lu(k,1961) = lu(k,1961) - lu(k,1523) * lu(k,1951) - lu(k,1962) = lu(k,1962) - lu(k,1524) * lu(k,1951) - lu(k,1963) = lu(k,1963) - lu(k,1525) * lu(k,1951) - lu(k,1978) = lu(k,1978) - lu(k,1514) * lu(k,1977) - lu(k,1979) = lu(k,1979) - lu(k,1515) * lu(k,1977) - lu(k,1980) = lu(k,1980) - lu(k,1516) * lu(k,1977) - lu(k,1981) = lu(k,1981) - lu(k,1517) * lu(k,1977) - lu(k,1982) = lu(k,1982) - lu(k,1518) * lu(k,1977) - lu(k,1983) = lu(k,1983) - lu(k,1519) * lu(k,1977) - lu(k,1984) = lu(k,1984) - lu(k,1520) * lu(k,1977) - lu(k,1985) = lu(k,1985) - lu(k,1521) * lu(k,1977) - lu(k,1986) = lu(k,1986) - lu(k,1522) * lu(k,1977) - lu(k,1987) = lu(k,1987) - lu(k,1523) * lu(k,1977) - lu(k,1988) = lu(k,1988) - lu(k,1524) * lu(k,1977) - lu(k,1989) = lu(k,1989) - lu(k,1525) * lu(k,1977) - lu(k,2008) = lu(k,2008) - lu(k,1514) * lu(k,2007) - lu(k,2009) = lu(k,2009) - lu(k,1515) * lu(k,2007) - lu(k,2010) = lu(k,2010) - lu(k,1516) * lu(k,2007) - lu(k,2011) = lu(k,2011) - lu(k,1517) * lu(k,2007) - lu(k,2012) = lu(k,2012) - lu(k,1518) * lu(k,2007) - lu(k,2013) = lu(k,2013) - lu(k,1519) * lu(k,2007) - lu(k,2014) = lu(k,2014) - lu(k,1520) * lu(k,2007) - lu(k,2015) = lu(k,2015) - lu(k,1521) * lu(k,2007) - lu(k,2016) = lu(k,2016) - lu(k,1522) * lu(k,2007) - lu(k,2017) = lu(k,2017) - lu(k,1523) * lu(k,2007) - lu(k,2018) = lu(k,2018) - lu(k,1524) * lu(k,2007) - lu(k,2019) = lu(k,2019) - lu(k,1525) * lu(k,2007) - lu(k,2042) = lu(k,2042) - lu(k,1514) * lu(k,2041) - lu(k,2043) = lu(k,2043) - lu(k,1515) * lu(k,2041) - lu(k,2044) = lu(k,2044) - lu(k,1516) * lu(k,2041) - lu(k,2045) = lu(k,2045) - lu(k,1517) * lu(k,2041) - lu(k,2046) = lu(k,2046) - lu(k,1518) * lu(k,2041) - lu(k,2047) = lu(k,2047) - lu(k,1519) * lu(k,2041) - lu(k,2048) = lu(k,2048) - lu(k,1520) * lu(k,2041) - lu(k,2049) = lu(k,2049) - lu(k,1521) * lu(k,2041) - lu(k,2050) = lu(k,2050) - lu(k,1522) * lu(k,2041) - lu(k,2051) = lu(k,2051) - lu(k,1523) * lu(k,2041) - lu(k,2052) = lu(k,2052) - lu(k,1524) * lu(k,2041) - lu(k,2053) = lu(k,2053) - lu(k,1525) * lu(k,2041) - lu(k,2067) = lu(k,2067) - lu(k,1514) * lu(k,2066) - lu(k,2068) = lu(k,2068) - lu(k,1515) * lu(k,2066) - lu(k,2069) = lu(k,2069) - lu(k,1516) * lu(k,2066) - lu(k,2070) = lu(k,2070) - lu(k,1517) * lu(k,2066) - lu(k,2071) = lu(k,2071) - lu(k,1518) * lu(k,2066) - lu(k,2072) = lu(k,2072) - lu(k,1519) * lu(k,2066) - lu(k,2073) = lu(k,2073) - lu(k,1520) * lu(k,2066) - lu(k,2074) = lu(k,2074) - lu(k,1521) * lu(k,2066) - lu(k,2075) = lu(k,2075) - lu(k,1522) * lu(k,2066) - lu(k,2076) = lu(k,2076) - lu(k,1523) * lu(k,2066) - lu(k,2077) = lu(k,2077) - lu(k,1524) * lu(k,2066) - lu(k,2078) = lu(k,2078) - lu(k,1525) * lu(k,2066) + lu(k,1296) = 1._r8 / lu(k,1296) + lu(k,1297) = lu(k,1297) * lu(k,1296) + lu(k,1298) = lu(k,1298) * lu(k,1296) + lu(k,1299) = lu(k,1299) * lu(k,1296) + lu(k,1300) = lu(k,1300) * lu(k,1296) + lu(k,1301) = lu(k,1301) * lu(k,1296) + lu(k,1302) = lu(k,1302) * lu(k,1296) + lu(k,1303) = lu(k,1303) * lu(k,1296) + lu(k,1304) = lu(k,1304) * lu(k,1296) + lu(k,1305) = lu(k,1305) * lu(k,1296) + lu(k,1306) = lu(k,1306) * lu(k,1296) + lu(k,1307) = lu(k,1307) * lu(k,1296) + lu(k,1308) = lu(k,1308) * lu(k,1296) + lu(k,1309) = lu(k,1309) * lu(k,1296) + lu(k,1310) = lu(k,1310) * lu(k,1296) + lu(k,1311) = lu(k,1311) * lu(k,1296) + lu(k,1423) = lu(k,1423) - lu(k,1297) * lu(k,1421) + lu(k,1424) = lu(k,1424) - lu(k,1298) * lu(k,1421) + lu(k,1425) = lu(k,1425) - lu(k,1299) * lu(k,1421) + lu(k,1426) = lu(k,1426) - lu(k,1300) * lu(k,1421) + lu(k,1428) = lu(k,1428) - lu(k,1301) * lu(k,1421) + lu(k,1429) = lu(k,1429) - lu(k,1302) * lu(k,1421) + lu(k,1430) = lu(k,1430) - lu(k,1303) * lu(k,1421) + lu(k,1431) = lu(k,1431) - lu(k,1304) * lu(k,1421) + lu(k,1432) = lu(k,1432) - lu(k,1305) * lu(k,1421) + lu(k,1433) = lu(k,1433) - lu(k,1306) * lu(k,1421) + lu(k,1434) = lu(k,1434) - lu(k,1307) * lu(k,1421) + lu(k,1435) = lu(k,1435) - lu(k,1308) * lu(k,1421) + lu(k,1436) = lu(k,1436) - lu(k,1309) * lu(k,1421) + lu(k,1437) = lu(k,1437) - lu(k,1310) * lu(k,1421) + lu(k,1438) = lu(k,1438) - lu(k,1311) * lu(k,1421) + lu(k,1596) = lu(k,1596) - lu(k,1297) * lu(k,1594) + lu(k,1597) = lu(k,1597) - lu(k,1298) * lu(k,1594) + lu(k,1598) = lu(k,1598) - lu(k,1299) * lu(k,1594) + lu(k,1599) = lu(k,1599) - lu(k,1300) * lu(k,1594) + lu(k,1602) = lu(k,1602) - lu(k,1301) * lu(k,1594) + lu(k,1604) = lu(k,1604) - lu(k,1302) * lu(k,1594) + lu(k,1605) = lu(k,1605) - lu(k,1303) * lu(k,1594) + lu(k,1606) = lu(k,1606) - lu(k,1304) * lu(k,1594) + lu(k,1608) = lu(k,1608) - lu(k,1305) * lu(k,1594) + lu(k,1611) = lu(k,1611) - lu(k,1306) * lu(k,1594) + lu(k,1612) = lu(k,1612) - lu(k,1307) * lu(k,1594) + lu(k,1613) = lu(k,1613) - lu(k,1308) * lu(k,1594) + lu(k,1615) = lu(k,1615) - lu(k,1309) * lu(k,1594) + lu(k,1617) = lu(k,1617) - lu(k,1310) * lu(k,1594) + lu(k,1618) = lu(k,1618) - lu(k,1311) * lu(k,1594) + lu(k,1649) = lu(k,1649) - lu(k,1297) * lu(k,1647) + lu(k,1650) = lu(k,1650) - lu(k,1298) * lu(k,1647) + lu(k,1651) = lu(k,1651) - lu(k,1299) * lu(k,1647) + lu(k,1652) = lu(k,1652) - lu(k,1300) * lu(k,1647) + lu(k,1654) = lu(k,1654) - lu(k,1301) * lu(k,1647) + lu(k,1656) = lu(k,1656) - lu(k,1302) * lu(k,1647) + lu(k,1657) = lu(k,1657) - lu(k,1303) * lu(k,1647) + lu(k,1658) = lu(k,1658) - lu(k,1304) * lu(k,1647) + lu(k,1660) = lu(k,1660) - lu(k,1305) * lu(k,1647) + lu(k,1663) = lu(k,1663) - lu(k,1306) * lu(k,1647) + lu(k,1664) = lu(k,1664) - lu(k,1307) * lu(k,1647) + lu(k,1665) = lu(k,1665) - lu(k,1308) * lu(k,1647) + lu(k,1667) = lu(k,1667) - lu(k,1309) * lu(k,1647) + lu(k,1669) = lu(k,1669) - lu(k,1310) * lu(k,1647) + lu(k,1670) = lu(k,1670) - lu(k,1311) * lu(k,1647) + lu(k,1904) = lu(k,1904) - lu(k,1297) * lu(k,1902) + lu(k,1905) = lu(k,1905) - lu(k,1298) * lu(k,1902) + lu(k,1906) = lu(k,1906) - lu(k,1299) * lu(k,1902) + lu(k,1907) = lu(k,1907) - lu(k,1300) * lu(k,1902) + lu(k,1911) = lu(k,1911) - lu(k,1301) * lu(k,1902) + lu(k,1913) = lu(k,1913) - lu(k,1302) * lu(k,1902) + lu(k,1914) = lu(k,1914) - lu(k,1303) * lu(k,1902) + lu(k,1915) = lu(k,1915) - lu(k,1304) * lu(k,1902) + lu(k,1917) = lu(k,1917) - lu(k,1305) * lu(k,1902) + lu(k,1920) = lu(k,1920) - lu(k,1306) * lu(k,1902) + lu(k,1921) = lu(k,1921) - lu(k,1307) * lu(k,1902) + lu(k,1922) = lu(k,1922) - lu(k,1308) * lu(k,1902) + lu(k,1924) = lu(k,1924) - lu(k,1309) * lu(k,1902) + lu(k,1926) = lu(k,1926) - lu(k,1310) * lu(k,1902) + lu(k,1927) = lu(k,1927) - lu(k,1311) * lu(k,1902) + lu(k,2065) = lu(k,2065) - lu(k,1297) * lu(k,2063) + lu(k,2066) = lu(k,2066) - lu(k,1298) * lu(k,2063) + lu(k,2067) = lu(k,2067) - lu(k,1299) * lu(k,2063) + lu(k,2068) = lu(k,2068) - lu(k,1300) * lu(k,2063) + lu(k,2071) = lu(k,2071) - lu(k,1301) * lu(k,2063) + lu(k,2073) = lu(k,2073) - lu(k,1302) * lu(k,2063) + lu(k,2074) = lu(k,2074) - lu(k,1303) * lu(k,2063) + lu(k,2075) = lu(k,2075) - lu(k,1304) * lu(k,2063) + lu(k,2077) = lu(k,2077) - lu(k,1305) * lu(k,2063) + lu(k,2080) = lu(k,2080) - lu(k,1306) * lu(k,2063) + lu(k,2081) = lu(k,2081) - lu(k,1307) * lu(k,2063) + lu(k,2082) = lu(k,2082) - lu(k,1308) * lu(k,2063) + lu(k,2084) = lu(k,2084) - lu(k,1309) * lu(k,2063) + lu(k,2086) = lu(k,2086) - lu(k,1310) * lu(k,2063) + lu(k,2087) = lu(k,2087) - lu(k,1311) * lu(k,2063) + lu(k,2207) = lu(k,2207) - lu(k,1297) * lu(k,2205) + lu(k,2208) = lu(k,2208) - lu(k,1298) * lu(k,2205) + lu(k,2209) = lu(k,2209) - lu(k,1299) * lu(k,2205) + lu(k,2210) = lu(k,2210) - lu(k,1300) * lu(k,2205) + lu(k,2214) = lu(k,2214) - lu(k,1301) * lu(k,2205) + lu(k,2216) = lu(k,2216) - lu(k,1302) * lu(k,2205) + lu(k,2217) = lu(k,2217) - lu(k,1303) * lu(k,2205) + lu(k,2218) = lu(k,2218) - lu(k,1304) * lu(k,2205) + lu(k,2220) = lu(k,2220) - lu(k,1305) * lu(k,2205) + lu(k,2223) = lu(k,2223) - lu(k,1306) * lu(k,2205) + lu(k,2224) = lu(k,2224) - lu(k,1307) * lu(k,2205) + lu(k,2225) = lu(k,2225) - lu(k,1308) * lu(k,2205) + lu(k,2227) = lu(k,2227) - lu(k,1309) * lu(k,2205) + lu(k,2229) = lu(k,2229) - lu(k,1310) * lu(k,2205) + lu(k,2230) = lu(k,2230) - lu(k,1311) * lu(k,2205) + lu(k,2308) = lu(k,2308) - lu(k,1297) * lu(k,2306) + lu(k,2309) = lu(k,2309) - lu(k,1298) * lu(k,2306) + lu(k,2310) = lu(k,2310) - lu(k,1299) * lu(k,2306) + lu(k,2311) = lu(k,2311) - lu(k,1300) * lu(k,2306) + lu(k,2314) = lu(k,2314) - lu(k,1301) * lu(k,2306) + lu(k,2316) = lu(k,2316) - lu(k,1302) * lu(k,2306) + lu(k,2317) = lu(k,2317) - lu(k,1303) * lu(k,2306) + lu(k,2318) = lu(k,2318) - lu(k,1304) * lu(k,2306) + lu(k,2320) = lu(k,2320) - lu(k,1305) * lu(k,2306) + lu(k,2323) = lu(k,2323) - lu(k,1306) * lu(k,2306) + lu(k,2324) = lu(k,2324) - lu(k,1307) * lu(k,2306) + lu(k,2325) = lu(k,2325) - lu(k,1308) * lu(k,2306) + lu(k,2327) = lu(k,2327) - lu(k,1309) * lu(k,2306) + lu(k,2329) = lu(k,2329) - lu(k,1310) * lu(k,2306) + lu(k,2330) = lu(k,2330) - lu(k,1311) * lu(k,2306) + lu(k,1328) = 1._r8 / lu(k,1328) + lu(k,1329) = lu(k,1329) * lu(k,1328) + lu(k,1330) = lu(k,1330) * lu(k,1328) + lu(k,1331) = lu(k,1331) * lu(k,1328) + lu(k,1332) = lu(k,1332) * lu(k,1328) + lu(k,1333) = lu(k,1333) * lu(k,1328) + lu(k,1334) = lu(k,1334) * lu(k,1328) + lu(k,1335) = lu(k,1335) * lu(k,1328) + lu(k,1336) = lu(k,1336) * lu(k,1328) + lu(k,1337) = lu(k,1337) * lu(k,1328) + lu(k,1338) = lu(k,1338) * lu(k,1328) + lu(k,1339) = lu(k,1339) * lu(k,1328) + lu(k,1340) = lu(k,1340) * lu(k,1328) + lu(k,1341) = lu(k,1341) * lu(k,1328) + lu(k,1342) = lu(k,1342) * lu(k,1328) + lu(k,1343) = lu(k,1343) * lu(k,1328) + lu(k,1423) = lu(k,1423) - lu(k,1329) * lu(k,1422) + lu(k,1424) = lu(k,1424) - lu(k,1330) * lu(k,1422) + lu(k,1425) = lu(k,1425) - lu(k,1331) * lu(k,1422) + lu(k,1426) = lu(k,1426) - lu(k,1332) * lu(k,1422) + lu(k,1428) = lu(k,1428) - lu(k,1333) * lu(k,1422) + lu(k,1429) = lu(k,1429) - lu(k,1334) * lu(k,1422) + lu(k,1430) = lu(k,1430) - lu(k,1335) * lu(k,1422) + lu(k,1431) = lu(k,1431) - lu(k,1336) * lu(k,1422) + lu(k,1432) = lu(k,1432) - lu(k,1337) * lu(k,1422) + lu(k,1433) = lu(k,1433) - lu(k,1338) * lu(k,1422) + lu(k,1434) = lu(k,1434) - lu(k,1339) * lu(k,1422) + lu(k,1435) = lu(k,1435) - lu(k,1340) * lu(k,1422) + lu(k,1436) = lu(k,1436) - lu(k,1341) * lu(k,1422) + lu(k,1437) = lu(k,1437) - lu(k,1342) * lu(k,1422) + lu(k,1438) = lu(k,1438) - lu(k,1343) * lu(k,1422) + lu(k,1596) = lu(k,1596) - lu(k,1329) * lu(k,1595) + lu(k,1597) = lu(k,1597) - lu(k,1330) * lu(k,1595) + lu(k,1598) = lu(k,1598) - lu(k,1331) * lu(k,1595) + lu(k,1599) = lu(k,1599) - lu(k,1332) * lu(k,1595) + lu(k,1602) = lu(k,1602) - lu(k,1333) * lu(k,1595) + lu(k,1604) = lu(k,1604) - lu(k,1334) * lu(k,1595) + lu(k,1605) = lu(k,1605) - lu(k,1335) * lu(k,1595) + lu(k,1606) = lu(k,1606) - lu(k,1336) * lu(k,1595) + lu(k,1608) = lu(k,1608) - lu(k,1337) * lu(k,1595) + lu(k,1611) = lu(k,1611) - lu(k,1338) * lu(k,1595) + lu(k,1612) = lu(k,1612) - lu(k,1339) * lu(k,1595) + lu(k,1613) = lu(k,1613) - lu(k,1340) * lu(k,1595) + lu(k,1615) = lu(k,1615) - lu(k,1341) * lu(k,1595) + lu(k,1617) = lu(k,1617) - lu(k,1342) * lu(k,1595) + lu(k,1618) = lu(k,1618) - lu(k,1343) * lu(k,1595) + lu(k,1649) = lu(k,1649) - lu(k,1329) * lu(k,1648) + lu(k,1650) = lu(k,1650) - lu(k,1330) * lu(k,1648) + lu(k,1651) = lu(k,1651) - lu(k,1331) * lu(k,1648) + lu(k,1652) = lu(k,1652) - lu(k,1332) * lu(k,1648) + lu(k,1654) = lu(k,1654) - lu(k,1333) * lu(k,1648) + lu(k,1656) = lu(k,1656) - lu(k,1334) * lu(k,1648) + lu(k,1657) = lu(k,1657) - lu(k,1335) * lu(k,1648) + lu(k,1658) = lu(k,1658) - lu(k,1336) * lu(k,1648) + lu(k,1660) = lu(k,1660) - lu(k,1337) * lu(k,1648) + lu(k,1663) = lu(k,1663) - lu(k,1338) * lu(k,1648) + lu(k,1664) = lu(k,1664) - lu(k,1339) * lu(k,1648) + lu(k,1665) = lu(k,1665) - lu(k,1340) * lu(k,1648) + lu(k,1667) = lu(k,1667) - lu(k,1341) * lu(k,1648) + lu(k,1669) = lu(k,1669) - lu(k,1342) * lu(k,1648) + lu(k,1670) = lu(k,1670) - lu(k,1343) * lu(k,1648) + lu(k,1904) = lu(k,1904) - lu(k,1329) * lu(k,1903) + lu(k,1905) = lu(k,1905) - lu(k,1330) * lu(k,1903) + lu(k,1906) = lu(k,1906) - lu(k,1331) * lu(k,1903) + lu(k,1907) = lu(k,1907) - lu(k,1332) * lu(k,1903) + lu(k,1911) = lu(k,1911) - lu(k,1333) * lu(k,1903) + lu(k,1913) = lu(k,1913) - lu(k,1334) * lu(k,1903) + lu(k,1914) = lu(k,1914) - lu(k,1335) * lu(k,1903) + lu(k,1915) = lu(k,1915) - lu(k,1336) * lu(k,1903) + lu(k,1917) = lu(k,1917) - lu(k,1337) * lu(k,1903) + lu(k,1920) = lu(k,1920) - lu(k,1338) * lu(k,1903) + lu(k,1921) = lu(k,1921) - lu(k,1339) * lu(k,1903) + lu(k,1922) = lu(k,1922) - lu(k,1340) * lu(k,1903) + lu(k,1924) = lu(k,1924) - lu(k,1341) * lu(k,1903) + lu(k,1926) = lu(k,1926) - lu(k,1342) * lu(k,1903) + lu(k,1927) = lu(k,1927) - lu(k,1343) * lu(k,1903) + lu(k,2065) = lu(k,2065) - lu(k,1329) * lu(k,2064) + lu(k,2066) = lu(k,2066) - lu(k,1330) * lu(k,2064) + lu(k,2067) = lu(k,2067) - lu(k,1331) * lu(k,2064) + lu(k,2068) = lu(k,2068) - lu(k,1332) * lu(k,2064) + lu(k,2071) = lu(k,2071) - lu(k,1333) * lu(k,2064) + lu(k,2073) = lu(k,2073) - lu(k,1334) * lu(k,2064) + lu(k,2074) = lu(k,2074) - lu(k,1335) * lu(k,2064) + lu(k,2075) = lu(k,2075) - lu(k,1336) * lu(k,2064) + lu(k,2077) = lu(k,2077) - lu(k,1337) * lu(k,2064) + lu(k,2080) = lu(k,2080) - lu(k,1338) * lu(k,2064) + lu(k,2081) = lu(k,2081) - lu(k,1339) * lu(k,2064) + lu(k,2082) = lu(k,2082) - lu(k,1340) * lu(k,2064) + lu(k,2084) = lu(k,2084) - lu(k,1341) * lu(k,2064) + lu(k,2086) = lu(k,2086) - lu(k,1342) * lu(k,2064) + lu(k,2087) = lu(k,2087) - lu(k,1343) * lu(k,2064) + lu(k,2207) = lu(k,2207) - lu(k,1329) * lu(k,2206) + lu(k,2208) = lu(k,2208) - lu(k,1330) * lu(k,2206) + lu(k,2209) = lu(k,2209) - lu(k,1331) * lu(k,2206) + lu(k,2210) = lu(k,2210) - lu(k,1332) * lu(k,2206) + lu(k,2214) = lu(k,2214) - lu(k,1333) * lu(k,2206) + lu(k,2216) = lu(k,2216) - lu(k,1334) * lu(k,2206) + lu(k,2217) = lu(k,2217) - lu(k,1335) * lu(k,2206) + lu(k,2218) = lu(k,2218) - lu(k,1336) * lu(k,2206) + lu(k,2220) = lu(k,2220) - lu(k,1337) * lu(k,2206) + lu(k,2223) = lu(k,2223) - lu(k,1338) * lu(k,2206) + lu(k,2224) = lu(k,2224) - lu(k,1339) * lu(k,2206) + lu(k,2225) = lu(k,2225) - lu(k,1340) * lu(k,2206) + lu(k,2227) = lu(k,2227) - lu(k,1341) * lu(k,2206) + lu(k,2229) = lu(k,2229) - lu(k,1342) * lu(k,2206) + lu(k,2230) = lu(k,2230) - lu(k,1343) * lu(k,2206) + lu(k,2308) = lu(k,2308) - lu(k,1329) * lu(k,2307) + lu(k,2309) = lu(k,2309) - lu(k,1330) * lu(k,2307) + lu(k,2310) = lu(k,2310) - lu(k,1331) * lu(k,2307) + lu(k,2311) = lu(k,2311) - lu(k,1332) * lu(k,2307) + lu(k,2314) = lu(k,2314) - lu(k,1333) * lu(k,2307) + lu(k,2316) = lu(k,2316) - lu(k,1334) * lu(k,2307) + lu(k,2317) = lu(k,2317) - lu(k,1335) * lu(k,2307) + lu(k,2318) = lu(k,2318) - lu(k,1336) * lu(k,2307) + lu(k,2320) = lu(k,2320) - lu(k,1337) * lu(k,2307) + lu(k,2323) = lu(k,2323) - lu(k,1338) * lu(k,2307) + lu(k,2324) = lu(k,2324) - lu(k,1339) * lu(k,2307) + lu(k,2325) = lu(k,2325) - lu(k,1340) * lu(k,2307) + lu(k,2327) = lu(k,2327) - lu(k,1341) * lu(k,2307) + lu(k,2329) = lu(k,2329) - lu(k,1342) * lu(k,2307) + lu(k,2330) = lu(k,2330) - lu(k,1343) * lu(k,2307) + lu(k,1351) = 1._r8 / lu(k,1351) + lu(k,1352) = lu(k,1352) * lu(k,1351) + lu(k,1353) = lu(k,1353) * lu(k,1351) + lu(k,1354) = lu(k,1354) * lu(k,1351) + lu(k,1355) = lu(k,1355) * lu(k,1351) + lu(k,1356) = lu(k,1356) * lu(k,1351) + lu(k,1357) = lu(k,1357) * lu(k,1351) + lu(k,1358) = lu(k,1358) * lu(k,1351) + lu(k,1359) = lu(k,1359) * lu(k,1351) + lu(k,1360) = lu(k,1360) * lu(k,1351) + lu(k,1361) = lu(k,1361) * lu(k,1351) + lu(k,1362) = lu(k,1362) * lu(k,1351) + lu(k,1363) = lu(k,1363) * lu(k,1351) + lu(k,1373) = - lu(k,1352) * lu(k,1371) + lu(k,1374) = lu(k,1374) - lu(k,1353) * lu(k,1371) + lu(k,1376) = lu(k,1376) - lu(k,1354) * lu(k,1371) + lu(k,1377) = lu(k,1377) - lu(k,1355) * lu(k,1371) + lu(k,1378) = lu(k,1378) - lu(k,1356) * lu(k,1371) + lu(k,1379) = lu(k,1379) - lu(k,1357) * lu(k,1371) + lu(k,1380) = lu(k,1380) - lu(k,1358) * lu(k,1371) + lu(k,1381) = lu(k,1381) - lu(k,1359) * lu(k,1371) + lu(k,1382) = lu(k,1382) - lu(k,1360) * lu(k,1371) + lu(k,1383) = lu(k,1383) - lu(k,1361) * lu(k,1371) + lu(k,1384) = lu(k,1384) - lu(k,1362) * lu(k,1371) + lu(k,1386) = lu(k,1386) - lu(k,1363) * lu(k,1371) + lu(k,1425) = lu(k,1425) - lu(k,1352) * lu(k,1423) + lu(k,1426) = lu(k,1426) - lu(k,1353) * lu(k,1423) + lu(k,1428) = lu(k,1428) - lu(k,1354) * lu(k,1423) + lu(k,1429) = lu(k,1429) - lu(k,1355) * lu(k,1423) + lu(k,1430) = lu(k,1430) - lu(k,1356) * lu(k,1423) + lu(k,1431) = lu(k,1431) - lu(k,1357) * lu(k,1423) + lu(k,1432) = lu(k,1432) - lu(k,1358) * lu(k,1423) + lu(k,1433) = lu(k,1433) - lu(k,1359) * lu(k,1423) + lu(k,1434) = lu(k,1434) - lu(k,1360) * lu(k,1423) + lu(k,1435) = lu(k,1435) - lu(k,1361) * lu(k,1423) + lu(k,1436) = lu(k,1436) - lu(k,1362) * lu(k,1423) + lu(k,1438) = lu(k,1438) - lu(k,1363) * lu(k,1423) + lu(k,1598) = lu(k,1598) - lu(k,1352) * lu(k,1596) + lu(k,1599) = lu(k,1599) - lu(k,1353) * lu(k,1596) + lu(k,1602) = lu(k,1602) - lu(k,1354) * lu(k,1596) + lu(k,1604) = lu(k,1604) - lu(k,1355) * lu(k,1596) + lu(k,1605) = lu(k,1605) - lu(k,1356) * lu(k,1596) + lu(k,1606) = lu(k,1606) - lu(k,1357) * lu(k,1596) + lu(k,1608) = lu(k,1608) - lu(k,1358) * lu(k,1596) + lu(k,1611) = lu(k,1611) - lu(k,1359) * lu(k,1596) + lu(k,1612) = lu(k,1612) - lu(k,1360) * lu(k,1596) + lu(k,1613) = lu(k,1613) - lu(k,1361) * lu(k,1596) + lu(k,1615) = lu(k,1615) - lu(k,1362) * lu(k,1596) + lu(k,1618) = lu(k,1618) - lu(k,1363) * lu(k,1596) + lu(k,1651) = lu(k,1651) - lu(k,1352) * lu(k,1649) + lu(k,1652) = lu(k,1652) - lu(k,1353) * lu(k,1649) + lu(k,1654) = lu(k,1654) - lu(k,1354) * lu(k,1649) + lu(k,1656) = lu(k,1656) - lu(k,1355) * lu(k,1649) + lu(k,1657) = lu(k,1657) - lu(k,1356) * lu(k,1649) + lu(k,1658) = lu(k,1658) - lu(k,1357) * lu(k,1649) + lu(k,1660) = lu(k,1660) - lu(k,1358) * lu(k,1649) + lu(k,1663) = lu(k,1663) - lu(k,1359) * lu(k,1649) + lu(k,1664) = lu(k,1664) - lu(k,1360) * lu(k,1649) + lu(k,1665) = lu(k,1665) - lu(k,1361) * lu(k,1649) + lu(k,1667) = lu(k,1667) - lu(k,1362) * lu(k,1649) + lu(k,1670) = lu(k,1670) - lu(k,1363) * lu(k,1649) + lu(k,1906) = lu(k,1906) - lu(k,1352) * lu(k,1904) + lu(k,1907) = lu(k,1907) - lu(k,1353) * lu(k,1904) + lu(k,1911) = lu(k,1911) - lu(k,1354) * lu(k,1904) + lu(k,1913) = lu(k,1913) - lu(k,1355) * lu(k,1904) + lu(k,1914) = lu(k,1914) - lu(k,1356) * lu(k,1904) + lu(k,1915) = lu(k,1915) - lu(k,1357) * lu(k,1904) + lu(k,1917) = lu(k,1917) - lu(k,1358) * lu(k,1904) + lu(k,1920) = lu(k,1920) - lu(k,1359) * lu(k,1904) + lu(k,1921) = lu(k,1921) - lu(k,1360) * lu(k,1904) + lu(k,1922) = lu(k,1922) - lu(k,1361) * lu(k,1904) + lu(k,1924) = lu(k,1924) - lu(k,1362) * lu(k,1904) + lu(k,1927) = lu(k,1927) - lu(k,1363) * lu(k,1904) + lu(k,2067) = lu(k,2067) - lu(k,1352) * lu(k,2065) + lu(k,2068) = lu(k,2068) - lu(k,1353) * lu(k,2065) + lu(k,2071) = lu(k,2071) - lu(k,1354) * lu(k,2065) + lu(k,2073) = lu(k,2073) - lu(k,1355) * lu(k,2065) + lu(k,2074) = lu(k,2074) - lu(k,1356) * lu(k,2065) + lu(k,2075) = lu(k,2075) - lu(k,1357) * lu(k,2065) + lu(k,2077) = lu(k,2077) - lu(k,1358) * lu(k,2065) + lu(k,2080) = lu(k,2080) - lu(k,1359) * lu(k,2065) + lu(k,2081) = lu(k,2081) - lu(k,1360) * lu(k,2065) + lu(k,2082) = lu(k,2082) - lu(k,1361) * lu(k,2065) + lu(k,2084) = lu(k,2084) - lu(k,1362) * lu(k,2065) + lu(k,2087) = lu(k,2087) - lu(k,1363) * lu(k,2065) + lu(k,2209) = lu(k,2209) - lu(k,1352) * lu(k,2207) + lu(k,2210) = lu(k,2210) - lu(k,1353) * lu(k,2207) + lu(k,2214) = lu(k,2214) - lu(k,1354) * lu(k,2207) + lu(k,2216) = lu(k,2216) - lu(k,1355) * lu(k,2207) + lu(k,2217) = lu(k,2217) - lu(k,1356) * lu(k,2207) + lu(k,2218) = lu(k,2218) - lu(k,1357) * lu(k,2207) + lu(k,2220) = lu(k,2220) - lu(k,1358) * lu(k,2207) + lu(k,2223) = lu(k,2223) - lu(k,1359) * lu(k,2207) + lu(k,2224) = lu(k,2224) - lu(k,1360) * lu(k,2207) + lu(k,2225) = lu(k,2225) - lu(k,1361) * lu(k,2207) + lu(k,2227) = lu(k,2227) - lu(k,1362) * lu(k,2207) + lu(k,2230) = lu(k,2230) - lu(k,1363) * lu(k,2207) + lu(k,2310) = lu(k,2310) - lu(k,1352) * lu(k,2308) + lu(k,2311) = lu(k,2311) - lu(k,1353) * lu(k,2308) + lu(k,2314) = lu(k,2314) - lu(k,1354) * lu(k,2308) + lu(k,2316) = lu(k,2316) - lu(k,1355) * lu(k,2308) + lu(k,2317) = lu(k,2317) - lu(k,1356) * lu(k,2308) + lu(k,2318) = lu(k,2318) - lu(k,1357) * lu(k,2308) + lu(k,2320) = lu(k,2320) - lu(k,1358) * lu(k,2308) + lu(k,2323) = lu(k,2323) - lu(k,1359) * lu(k,2308) + lu(k,2324) = lu(k,2324) - lu(k,1360) * lu(k,2308) + lu(k,2325) = lu(k,2325) - lu(k,1361) * lu(k,2308) + lu(k,2327) = lu(k,2327) - lu(k,1362) * lu(k,2308) + lu(k,2330) = lu(k,2330) - lu(k,1363) * lu(k,2308) + lu(k,1372) = 1._r8 / lu(k,1372) + lu(k,1373) = lu(k,1373) * lu(k,1372) + lu(k,1374) = lu(k,1374) * lu(k,1372) + lu(k,1375) = lu(k,1375) * lu(k,1372) + lu(k,1376) = lu(k,1376) * lu(k,1372) + lu(k,1377) = lu(k,1377) * lu(k,1372) + lu(k,1378) = lu(k,1378) * lu(k,1372) + lu(k,1379) = lu(k,1379) * lu(k,1372) + lu(k,1380) = lu(k,1380) * lu(k,1372) + lu(k,1381) = lu(k,1381) * lu(k,1372) + lu(k,1382) = lu(k,1382) * lu(k,1372) + lu(k,1383) = lu(k,1383) * lu(k,1372) + lu(k,1384) = lu(k,1384) * lu(k,1372) + lu(k,1385) = lu(k,1385) * lu(k,1372) + lu(k,1386) = lu(k,1386) * lu(k,1372) + lu(k,1425) = lu(k,1425) - lu(k,1373) * lu(k,1424) + lu(k,1426) = lu(k,1426) - lu(k,1374) * lu(k,1424) + lu(k,1427) = - lu(k,1375) * lu(k,1424) + lu(k,1428) = lu(k,1428) - lu(k,1376) * lu(k,1424) + lu(k,1429) = lu(k,1429) - lu(k,1377) * lu(k,1424) + lu(k,1430) = lu(k,1430) - lu(k,1378) * lu(k,1424) + lu(k,1431) = lu(k,1431) - lu(k,1379) * lu(k,1424) + lu(k,1432) = lu(k,1432) - lu(k,1380) * lu(k,1424) + lu(k,1433) = lu(k,1433) - lu(k,1381) * lu(k,1424) + lu(k,1434) = lu(k,1434) - lu(k,1382) * lu(k,1424) + lu(k,1435) = lu(k,1435) - lu(k,1383) * lu(k,1424) + lu(k,1436) = lu(k,1436) - lu(k,1384) * lu(k,1424) + lu(k,1437) = lu(k,1437) - lu(k,1385) * lu(k,1424) + lu(k,1438) = lu(k,1438) - lu(k,1386) * lu(k,1424) + lu(k,1598) = lu(k,1598) - lu(k,1373) * lu(k,1597) + lu(k,1599) = lu(k,1599) - lu(k,1374) * lu(k,1597) + lu(k,1601) = - lu(k,1375) * lu(k,1597) + lu(k,1602) = lu(k,1602) - lu(k,1376) * lu(k,1597) + lu(k,1604) = lu(k,1604) - lu(k,1377) * lu(k,1597) + lu(k,1605) = lu(k,1605) - lu(k,1378) * lu(k,1597) + lu(k,1606) = lu(k,1606) - lu(k,1379) * lu(k,1597) + lu(k,1608) = lu(k,1608) - lu(k,1380) * lu(k,1597) + lu(k,1611) = lu(k,1611) - lu(k,1381) * lu(k,1597) + lu(k,1612) = lu(k,1612) - lu(k,1382) * lu(k,1597) + lu(k,1613) = lu(k,1613) - lu(k,1383) * lu(k,1597) + lu(k,1615) = lu(k,1615) - lu(k,1384) * lu(k,1597) + lu(k,1617) = lu(k,1617) - lu(k,1385) * lu(k,1597) + lu(k,1618) = lu(k,1618) - lu(k,1386) * lu(k,1597) + lu(k,1651) = lu(k,1651) - lu(k,1373) * lu(k,1650) + lu(k,1652) = lu(k,1652) - lu(k,1374) * lu(k,1650) + lu(k,1653) = - lu(k,1375) * lu(k,1650) + lu(k,1654) = lu(k,1654) - lu(k,1376) * lu(k,1650) + lu(k,1656) = lu(k,1656) - lu(k,1377) * lu(k,1650) + lu(k,1657) = lu(k,1657) - lu(k,1378) * lu(k,1650) + lu(k,1658) = lu(k,1658) - lu(k,1379) * lu(k,1650) + lu(k,1660) = lu(k,1660) - lu(k,1380) * lu(k,1650) + lu(k,1663) = lu(k,1663) - lu(k,1381) * lu(k,1650) + lu(k,1664) = lu(k,1664) - lu(k,1382) * lu(k,1650) + lu(k,1665) = lu(k,1665) - lu(k,1383) * lu(k,1650) + lu(k,1667) = lu(k,1667) - lu(k,1384) * lu(k,1650) + lu(k,1669) = lu(k,1669) - lu(k,1385) * lu(k,1650) + lu(k,1670) = lu(k,1670) - lu(k,1386) * lu(k,1650) + lu(k,1906) = lu(k,1906) - lu(k,1373) * lu(k,1905) + lu(k,1907) = lu(k,1907) - lu(k,1374) * lu(k,1905) + lu(k,1910) = lu(k,1910) - lu(k,1375) * lu(k,1905) + lu(k,1911) = lu(k,1911) - lu(k,1376) * lu(k,1905) + lu(k,1913) = lu(k,1913) - lu(k,1377) * lu(k,1905) + lu(k,1914) = lu(k,1914) - lu(k,1378) * lu(k,1905) + lu(k,1915) = lu(k,1915) - lu(k,1379) * lu(k,1905) + lu(k,1917) = lu(k,1917) - lu(k,1380) * lu(k,1905) + lu(k,1920) = lu(k,1920) - lu(k,1381) * lu(k,1905) + lu(k,1921) = lu(k,1921) - lu(k,1382) * lu(k,1905) + lu(k,1922) = lu(k,1922) - lu(k,1383) * lu(k,1905) + lu(k,1924) = lu(k,1924) - lu(k,1384) * lu(k,1905) + lu(k,1926) = lu(k,1926) - lu(k,1385) * lu(k,1905) + lu(k,1927) = lu(k,1927) - lu(k,1386) * lu(k,1905) + lu(k,2067) = lu(k,2067) - lu(k,1373) * lu(k,2066) + lu(k,2068) = lu(k,2068) - lu(k,1374) * lu(k,2066) + lu(k,2070) = lu(k,2070) - lu(k,1375) * lu(k,2066) + lu(k,2071) = lu(k,2071) - lu(k,1376) * lu(k,2066) + lu(k,2073) = lu(k,2073) - lu(k,1377) * lu(k,2066) + lu(k,2074) = lu(k,2074) - lu(k,1378) * lu(k,2066) + lu(k,2075) = lu(k,2075) - lu(k,1379) * lu(k,2066) + lu(k,2077) = lu(k,2077) - lu(k,1380) * lu(k,2066) + lu(k,2080) = lu(k,2080) - lu(k,1381) * lu(k,2066) + lu(k,2081) = lu(k,2081) - lu(k,1382) * lu(k,2066) + lu(k,2082) = lu(k,2082) - lu(k,1383) * lu(k,2066) + lu(k,2084) = lu(k,2084) - lu(k,1384) * lu(k,2066) + lu(k,2086) = lu(k,2086) - lu(k,1385) * lu(k,2066) + lu(k,2087) = lu(k,2087) - lu(k,1386) * lu(k,2066) + lu(k,2209) = lu(k,2209) - lu(k,1373) * lu(k,2208) + lu(k,2210) = lu(k,2210) - lu(k,1374) * lu(k,2208) + lu(k,2213) = - lu(k,1375) * lu(k,2208) + lu(k,2214) = lu(k,2214) - lu(k,1376) * lu(k,2208) + lu(k,2216) = lu(k,2216) - lu(k,1377) * lu(k,2208) + lu(k,2217) = lu(k,2217) - lu(k,1378) * lu(k,2208) + lu(k,2218) = lu(k,2218) - lu(k,1379) * lu(k,2208) + lu(k,2220) = lu(k,2220) - lu(k,1380) * lu(k,2208) + lu(k,2223) = lu(k,2223) - lu(k,1381) * lu(k,2208) + lu(k,2224) = lu(k,2224) - lu(k,1382) * lu(k,2208) + lu(k,2225) = lu(k,2225) - lu(k,1383) * lu(k,2208) + lu(k,2227) = lu(k,2227) - lu(k,1384) * lu(k,2208) + lu(k,2229) = lu(k,2229) - lu(k,1385) * lu(k,2208) + lu(k,2230) = lu(k,2230) - lu(k,1386) * lu(k,2208) + lu(k,2310) = lu(k,2310) - lu(k,1373) * lu(k,2309) + lu(k,2311) = lu(k,2311) - lu(k,1374) * lu(k,2309) + lu(k,2313) = lu(k,2313) - lu(k,1375) * lu(k,2309) + lu(k,2314) = lu(k,2314) - lu(k,1376) * lu(k,2309) + lu(k,2316) = lu(k,2316) - lu(k,1377) * lu(k,2309) + lu(k,2317) = lu(k,2317) - lu(k,1378) * lu(k,2309) + lu(k,2318) = lu(k,2318) - lu(k,1379) * lu(k,2309) + lu(k,2320) = lu(k,2320) - lu(k,1380) * lu(k,2309) + lu(k,2323) = lu(k,2323) - lu(k,1381) * lu(k,2309) + lu(k,2324) = lu(k,2324) - lu(k,1382) * lu(k,2309) + lu(k,2325) = lu(k,2325) - lu(k,1383) * lu(k,2309) + lu(k,2327) = lu(k,2327) - lu(k,1384) * lu(k,2309) + lu(k,2329) = lu(k,2329) - lu(k,1385) * lu(k,2309) + lu(k,2330) = lu(k,2330) - lu(k,1386) * lu(k,2309) end do end subroutine lu_fac26 subroutine lu_fac27( avec_len, lu ) @@ -6710,514 +5736,346 @@ subroutine lu_fac27( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1538) = 1._r8 / lu(k,1538) - lu(k,1539) = lu(k,1539) * lu(k,1538) - lu(k,1540) = lu(k,1540) * lu(k,1538) - lu(k,1541) = lu(k,1541) * lu(k,1538) - lu(k,1542) = lu(k,1542) * lu(k,1538) - lu(k,1543) = lu(k,1543) * lu(k,1538) - lu(k,1544) = lu(k,1544) * lu(k,1538) - lu(k,1545) = lu(k,1545) * lu(k,1538) - lu(k,1546) = lu(k,1546) * lu(k,1538) - lu(k,1547) = lu(k,1547) * lu(k,1538) - lu(k,1548) = lu(k,1548) * lu(k,1538) - lu(k,1549) = lu(k,1549) * lu(k,1538) - lu(k,1698) = lu(k,1698) - lu(k,1539) * lu(k,1697) - lu(k,1699) = lu(k,1699) - lu(k,1540) * lu(k,1697) - lu(k,1700) = lu(k,1700) - lu(k,1541) * lu(k,1697) - lu(k,1701) = lu(k,1701) - lu(k,1542) * lu(k,1697) - lu(k,1702) = lu(k,1702) - lu(k,1543) * lu(k,1697) - lu(k,1703) = lu(k,1703) - lu(k,1544) * lu(k,1697) - lu(k,1704) = lu(k,1704) - lu(k,1545) * lu(k,1697) - lu(k,1705) = lu(k,1705) - lu(k,1546) * lu(k,1697) - lu(k,1706) = lu(k,1706) - lu(k,1547) * lu(k,1697) - lu(k,1707) = lu(k,1707) - lu(k,1548) * lu(k,1697) - lu(k,1708) = lu(k,1708) - lu(k,1549) * lu(k,1697) - lu(k,1721) = lu(k,1721) - lu(k,1539) * lu(k,1720) - lu(k,1722) = lu(k,1722) - lu(k,1540) * lu(k,1720) - lu(k,1723) = lu(k,1723) - lu(k,1541) * lu(k,1720) - lu(k,1724) = lu(k,1724) - lu(k,1542) * lu(k,1720) - lu(k,1725) = lu(k,1725) - lu(k,1543) * lu(k,1720) - lu(k,1726) = lu(k,1726) - lu(k,1544) * lu(k,1720) - lu(k,1727) = lu(k,1727) - lu(k,1545) * lu(k,1720) - lu(k,1728) = lu(k,1728) - lu(k,1546) * lu(k,1720) - lu(k,1729) = lu(k,1729) - lu(k,1547) * lu(k,1720) - lu(k,1730) = lu(k,1730) - lu(k,1548) * lu(k,1720) - lu(k,1731) = lu(k,1731) - lu(k,1549) * lu(k,1720) - lu(k,1762) = lu(k,1762) - lu(k,1539) * lu(k,1761) - lu(k,1763) = lu(k,1763) - lu(k,1540) * lu(k,1761) - lu(k,1764) = lu(k,1764) - lu(k,1541) * lu(k,1761) - lu(k,1765) = lu(k,1765) - lu(k,1542) * lu(k,1761) - lu(k,1766) = lu(k,1766) - lu(k,1543) * lu(k,1761) - lu(k,1767) = lu(k,1767) - lu(k,1544) * lu(k,1761) - lu(k,1768) = lu(k,1768) - lu(k,1545) * lu(k,1761) - lu(k,1769) = lu(k,1769) - lu(k,1546) * lu(k,1761) - lu(k,1770) = lu(k,1770) - lu(k,1547) * lu(k,1761) - lu(k,1771) = lu(k,1771) - lu(k,1548) * lu(k,1761) - lu(k,1772) = lu(k,1772) - lu(k,1549) * lu(k,1761) - lu(k,1819) = lu(k,1819) - lu(k,1539) * lu(k,1818) - lu(k,1820) = lu(k,1820) - lu(k,1540) * lu(k,1818) - lu(k,1821) = lu(k,1821) - lu(k,1541) * lu(k,1818) - lu(k,1822) = lu(k,1822) - lu(k,1542) * lu(k,1818) - lu(k,1823) = lu(k,1823) - lu(k,1543) * lu(k,1818) - lu(k,1824) = lu(k,1824) - lu(k,1544) * lu(k,1818) - lu(k,1825) = lu(k,1825) - lu(k,1545) * lu(k,1818) - lu(k,1826) = lu(k,1826) - lu(k,1546) * lu(k,1818) - lu(k,1827) = lu(k,1827) - lu(k,1547) * lu(k,1818) - lu(k,1828) = lu(k,1828) - lu(k,1548) * lu(k,1818) - lu(k,1829) = lu(k,1829) - lu(k,1549) * lu(k,1818) - lu(k,1869) = lu(k,1869) - lu(k,1539) * lu(k,1868) - lu(k,1870) = lu(k,1870) - lu(k,1540) * lu(k,1868) - lu(k,1871) = lu(k,1871) - lu(k,1541) * lu(k,1868) - lu(k,1872) = lu(k,1872) - lu(k,1542) * lu(k,1868) - lu(k,1873) = lu(k,1873) - lu(k,1543) * lu(k,1868) - lu(k,1874) = lu(k,1874) - lu(k,1544) * lu(k,1868) - lu(k,1875) = lu(k,1875) - lu(k,1545) * lu(k,1868) - lu(k,1876) = lu(k,1876) - lu(k,1546) * lu(k,1868) - lu(k,1877) = lu(k,1877) - lu(k,1547) * lu(k,1868) - lu(k,1878) = lu(k,1878) - lu(k,1548) * lu(k,1868) - lu(k,1879) = lu(k,1879) - lu(k,1549) * lu(k,1868) - lu(k,1929) = lu(k,1929) - lu(k,1539) * lu(k,1928) - lu(k,1930) = lu(k,1930) - lu(k,1540) * lu(k,1928) - lu(k,1931) = lu(k,1931) - lu(k,1541) * lu(k,1928) - lu(k,1932) = lu(k,1932) - lu(k,1542) * lu(k,1928) - lu(k,1933) = lu(k,1933) - lu(k,1543) * lu(k,1928) - lu(k,1934) = lu(k,1934) - lu(k,1544) * lu(k,1928) - lu(k,1935) = lu(k,1935) - lu(k,1545) * lu(k,1928) - lu(k,1936) = lu(k,1936) - lu(k,1546) * lu(k,1928) - lu(k,1937) = lu(k,1937) - lu(k,1547) * lu(k,1928) - lu(k,1938) = lu(k,1938) - lu(k,1548) * lu(k,1928) - lu(k,1939) = lu(k,1939) - lu(k,1549) * lu(k,1928) - lu(k,1953) = lu(k,1953) - lu(k,1539) * lu(k,1952) - lu(k,1954) = lu(k,1954) - lu(k,1540) * lu(k,1952) - lu(k,1955) = lu(k,1955) - lu(k,1541) * lu(k,1952) - lu(k,1956) = lu(k,1956) - lu(k,1542) * lu(k,1952) - lu(k,1957) = lu(k,1957) - lu(k,1543) * lu(k,1952) - lu(k,1958) = lu(k,1958) - lu(k,1544) * lu(k,1952) - lu(k,1959) = lu(k,1959) - lu(k,1545) * lu(k,1952) - lu(k,1960) = lu(k,1960) - lu(k,1546) * lu(k,1952) - lu(k,1961) = lu(k,1961) - lu(k,1547) * lu(k,1952) - lu(k,1962) = lu(k,1962) - lu(k,1548) * lu(k,1952) - lu(k,1963) = lu(k,1963) - lu(k,1549) * lu(k,1952) - lu(k,1979) = lu(k,1979) - lu(k,1539) * lu(k,1978) - lu(k,1980) = lu(k,1980) - lu(k,1540) * lu(k,1978) - lu(k,1981) = lu(k,1981) - lu(k,1541) * lu(k,1978) - lu(k,1982) = lu(k,1982) - lu(k,1542) * lu(k,1978) - lu(k,1983) = lu(k,1983) - lu(k,1543) * lu(k,1978) - lu(k,1984) = lu(k,1984) - lu(k,1544) * lu(k,1978) - lu(k,1985) = lu(k,1985) - lu(k,1545) * lu(k,1978) - lu(k,1986) = lu(k,1986) - lu(k,1546) * lu(k,1978) - lu(k,1987) = lu(k,1987) - lu(k,1547) * lu(k,1978) - lu(k,1988) = lu(k,1988) - lu(k,1548) * lu(k,1978) - lu(k,1989) = lu(k,1989) - lu(k,1549) * lu(k,1978) - lu(k,2009) = lu(k,2009) - lu(k,1539) * lu(k,2008) - lu(k,2010) = lu(k,2010) - lu(k,1540) * lu(k,2008) - lu(k,2011) = lu(k,2011) - lu(k,1541) * lu(k,2008) - lu(k,2012) = lu(k,2012) - lu(k,1542) * lu(k,2008) - lu(k,2013) = lu(k,2013) - lu(k,1543) * lu(k,2008) - lu(k,2014) = lu(k,2014) - lu(k,1544) * lu(k,2008) - lu(k,2015) = lu(k,2015) - lu(k,1545) * lu(k,2008) - lu(k,2016) = lu(k,2016) - lu(k,1546) * lu(k,2008) - lu(k,2017) = lu(k,2017) - lu(k,1547) * lu(k,2008) - lu(k,2018) = lu(k,2018) - lu(k,1548) * lu(k,2008) - lu(k,2019) = lu(k,2019) - lu(k,1549) * lu(k,2008) - lu(k,2043) = lu(k,2043) - lu(k,1539) * lu(k,2042) - lu(k,2044) = lu(k,2044) - lu(k,1540) * lu(k,2042) - lu(k,2045) = lu(k,2045) - lu(k,1541) * lu(k,2042) - lu(k,2046) = lu(k,2046) - lu(k,1542) * lu(k,2042) - lu(k,2047) = lu(k,2047) - lu(k,1543) * lu(k,2042) - lu(k,2048) = lu(k,2048) - lu(k,1544) * lu(k,2042) - lu(k,2049) = lu(k,2049) - lu(k,1545) * lu(k,2042) - lu(k,2050) = lu(k,2050) - lu(k,1546) * lu(k,2042) - lu(k,2051) = lu(k,2051) - lu(k,1547) * lu(k,2042) - lu(k,2052) = lu(k,2052) - lu(k,1548) * lu(k,2042) - lu(k,2053) = lu(k,2053) - lu(k,1549) * lu(k,2042) - lu(k,2068) = lu(k,2068) - lu(k,1539) * lu(k,2067) - lu(k,2069) = lu(k,2069) - lu(k,1540) * lu(k,2067) - lu(k,2070) = lu(k,2070) - lu(k,1541) * lu(k,2067) - lu(k,2071) = lu(k,2071) - lu(k,1542) * lu(k,2067) - lu(k,2072) = lu(k,2072) - lu(k,1543) * lu(k,2067) - lu(k,2073) = lu(k,2073) - lu(k,1544) * lu(k,2067) - lu(k,2074) = lu(k,2074) - lu(k,1545) * lu(k,2067) - lu(k,2075) = lu(k,2075) - lu(k,1546) * lu(k,2067) - lu(k,2076) = lu(k,2076) - lu(k,1547) * lu(k,2067) - lu(k,2077) = lu(k,2077) - lu(k,1548) * lu(k,2067) - lu(k,2078) = lu(k,2078) - lu(k,1549) * lu(k,2067) - lu(k,1698) = 1._r8 / lu(k,1698) - lu(k,1699) = lu(k,1699) * lu(k,1698) - lu(k,1700) = lu(k,1700) * lu(k,1698) - lu(k,1701) = lu(k,1701) * lu(k,1698) - lu(k,1702) = lu(k,1702) * lu(k,1698) - lu(k,1703) = lu(k,1703) * lu(k,1698) - lu(k,1704) = lu(k,1704) * lu(k,1698) - lu(k,1705) = lu(k,1705) * lu(k,1698) - lu(k,1706) = lu(k,1706) * lu(k,1698) - lu(k,1707) = lu(k,1707) * lu(k,1698) - lu(k,1708) = lu(k,1708) * lu(k,1698) - lu(k,1722) = lu(k,1722) - lu(k,1699) * lu(k,1721) - lu(k,1723) = lu(k,1723) - lu(k,1700) * lu(k,1721) - lu(k,1724) = lu(k,1724) - lu(k,1701) * lu(k,1721) - lu(k,1725) = lu(k,1725) - lu(k,1702) * lu(k,1721) - lu(k,1726) = lu(k,1726) - lu(k,1703) * lu(k,1721) - lu(k,1727) = lu(k,1727) - lu(k,1704) * lu(k,1721) - lu(k,1728) = lu(k,1728) - lu(k,1705) * lu(k,1721) - lu(k,1729) = lu(k,1729) - lu(k,1706) * lu(k,1721) - lu(k,1730) = lu(k,1730) - lu(k,1707) * lu(k,1721) - lu(k,1731) = lu(k,1731) - lu(k,1708) * lu(k,1721) - lu(k,1763) = lu(k,1763) - lu(k,1699) * lu(k,1762) - lu(k,1764) = lu(k,1764) - lu(k,1700) * lu(k,1762) - lu(k,1765) = lu(k,1765) - lu(k,1701) * lu(k,1762) - lu(k,1766) = lu(k,1766) - lu(k,1702) * lu(k,1762) - lu(k,1767) = lu(k,1767) - lu(k,1703) * lu(k,1762) - lu(k,1768) = lu(k,1768) - lu(k,1704) * lu(k,1762) - lu(k,1769) = lu(k,1769) - lu(k,1705) * lu(k,1762) - lu(k,1770) = lu(k,1770) - lu(k,1706) * lu(k,1762) - lu(k,1771) = lu(k,1771) - lu(k,1707) * lu(k,1762) - lu(k,1772) = lu(k,1772) - lu(k,1708) * lu(k,1762) - lu(k,1820) = lu(k,1820) - lu(k,1699) * lu(k,1819) - lu(k,1821) = lu(k,1821) - lu(k,1700) * lu(k,1819) - lu(k,1822) = lu(k,1822) - lu(k,1701) * lu(k,1819) - lu(k,1823) = lu(k,1823) - lu(k,1702) * lu(k,1819) - lu(k,1824) = lu(k,1824) - lu(k,1703) * lu(k,1819) - lu(k,1825) = lu(k,1825) - lu(k,1704) * lu(k,1819) - lu(k,1826) = lu(k,1826) - lu(k,1705) * lu(k,1819) - lu(k,1827) = lu(k,1827) - lu(k,1706) * lu(k,1819) - lu(k,1828) = lu(k,1828) - lu(k,1707) * lu(k,1819) - lu(k,1829) = lu(k,1829) - lu(k,1708) * lu(k,1819) - lu(k,1870) = lu(k,1870) - lu(k,1699) * lu(k,1869) - lu(k,1871) = lu(k,1871) - lu(k,1700) * lu(k,1869) - lu(k,1872) = lu(k,1872) - lu(k,1701) * lu(k,1869) - lu(k,1873) = lu(k,1873) - lu(k,1702) * lu(k,1869) - lu(k,1874) = lu(k,1874) - lu(k,1703) * lu(k,1869) - lu(k,1875) = lu(k,1875) - lu(k,1704) * lu(k,1869) - lu(k,1876) = lu(k,1876) - lu(k,1705) * lu(k,1869) - lu(k,1877) = lu(k,1877) - lu(k,1706) * lu(k,1869) - lu(k,1878) = lu(k,1878) - lu(k,1707) * lu(k,1869) - lu(k,1879) = lu(k,1879) - lu(k,1708) * lu(k,1869) - lu(k,1930) = lu(k,1930) - lu(k,1699) * lu(k,1929) - lu(k,1931) = lu(k,1931) - lu(k,1700) * lu(k,1929) - lu(k,1932) = lu(k,1932) - lu(k,1701) * lu(k,1929) - lu(k,1933) = lu(k,1933) - lu(k,1702) * lu(k,1929) - lu(k,1934) = lu(k,1934) - lu(k,1703) * lu(k,1929) - lu(k,1935) = lu(k,1935) - lu(k,1704) * lu(k,1929) - lu(k,1936) = lu(k,1936) - lu(k,1705) * lu(k,1929) - lu(k,1937) = lu(k,1937) - lu(k,1706) * lu(k,1929) - lu(k,1938) = lu(k,1938) - lu(k,1707) * lu(k,1929) - lu(k,1939) = lu(k,1939) - lu(k,1708) * lu(k,1929) - lu(k,1954) = lu(k,1954) - lu(k,1699) * lu(k,1953) - lu(k,1955) = lu(k,1955) - lu(k,1700) * lu(k,1953) - lu(k,1956) = lu(k,1956) - lu(k,1701) * lu(k,1953) - lu(k,1957) = lu(k,1957) - lu(k,1702) * lu(k,1953) - lu(k,1958) = lu(k,1958) - lu(k,1703) * lu(k,1953) - lu(k,1959) = lu(k,1959) - lu(k,1704) * lu(k,1953) - lu(k,1960) = lu(k,1960) - lu(k,1705) * lu(k,1953) - lu(k,1961) = lu(k,1961) - lu(k,1706) * lu(k,1953) - lu(k,1962) = lu(k,1962) - lu(k,1707) * lu(k,1953) - lu(k,1963) = lu(k,1963) - lu(k,1708) * lu(k,1953) - lu(k,1980) = lu(k,1980) - lu(k,1699) * lu(k,1979) - lu(k,1981) = lu(k,1981) - lu(k,1700) * lu(k,1979) - lu(k,1982) = lu(k,1982) - lu(k,1701) * lu(k,1979) - lu(k,1983) = lu(k,1983) - lu(k,1702) * lu(k,1979) - lu(k,1984) = lu(k,1984) - lu(k,1703) * lu(k,1979) - lu(k,1985) = lu(k,1985) - lu(k,1704) * lu(k,1979) - lu(k,1986) = lu(k,1986) - lu(k,1705) * lu(k,1979) - lu(k,1987) = lu(k,1987) - lu(k,1706) * lu(k,1979) - lu(k,1988) = lu(k,1988) - lu(k,1707) * lu(k,1979) - lu(k,1989) = lu(k,1989) - lu(k,1708) * lu(k,1979) - lu(k,2010) = lu(k,2010) - lu(k,1699) * lu(k,2009) - lu(k,2011) = lu(k,2011) - lu(k,1700) * lu(k,2009) - lu(k,2012) = lu(k,2012) - lu(k,1701) * lu(k,2009) - lu(k,2013) = lu(k,2013) - lu(k,1702) * lu(k,2009) - lu(k,2014) = lu(k,2014) - lu(k,1703) * lu(k,2009) - lu(k,2015) = lu(k,2015) - lu(k,1704) * lu(k,2009) - lu(k,2016) = lu(k,2016) - lu(k,1705) * lu(k,2009) - lu(k,2017) = lu(k,2017) - lu(k,1706) * lu(k,2009) - lu(k,2018) = lu(k,2018) - lu(k,1707) * lu(k,2009) - lu(k,2019) = lu(k,2019) - lu(k,1708) * lu(k,2009) - lu(k,2044) = lu(k,2044) - lu(k,1699) * lu(k,2043) - lu(k,2045) = lu(k,2045) - lu(k,1700) * lu(k,2043) - lu(k,2046) = lu(k,2046) - lu(k,1701) * lu(k,2043) - lu(k,2047) = lu(k,2047) - lu(k,1702) * lu(k,2043) - lu(k,2048) = lu(k,2048) - lu(k,1703) * lu(k,2043) - lu(k,2049) = lu(k,2049) - lu(k,1704) * lu(k,2043) - lu(k,2050) = lu(k,2050) - lu(k,1705) * lu(k,2043) - lu(k,2051) = lu(k,2051) - lu(k,1706) * lu(k,2043) - lu(k,2052) = lu(k,2052) - lu(k,1707) * lu(k,2043) - lu(k,2053) = lu(k,2053) - lu(k,1708) * lu(k,2043) - lu(k,2069) = lu(k,2069) - lu(k,1699) * lu(k,2068) - lu(k,2070) = lu(k,2070) - lu(k,1700) * lu(k,2068) - lu(k,2071) = lu(k,2071) - lu(k,1701) * lu(k,2068) - lu(k,2072) = lu(k,2072) - lu(k,1702) * lu(k,2068) - lu(k,2073) = lu(k,2073) - lu(k,1703) * lu(k,2068) - lu(k,2074) = lu(k,2074) - lu(k,1704) * lu(k,2068) - lu(k,2075) = lu(k,2075) - lu(k,1705) * lu(k,2068) - lu(k,2076) = lu(k,2076) - lu(k,1706) * lu(k,2068) - lu(k,2077) = lu(k,2077) - lu(k,1707) * lu(k,2068) - lu(k,2078) = lu(k,2078) - lu(k,1708) * lu(k,2068) - lu(k,1722) = 1._r8 / lu(k,1722) - lu(k,1723) = lu(k,1723) * lu(k,1722) - lu(k,1724) = lu(k,1724) * lu(k,1722) - lu(k,1725) = lu(k,1725) * lu(k,1722) - lu(k,1726) = lu(k,1726) * lu(k,1722) - lu(k,1727) = lu(k,1727) * lu(k,1722) - lu(k,1728) = lu(k,1728) * lu(k,1722) - lu(k,1729) = lu(k,1729) * lu(k,1722) - lu(k,1730) = lu(k,1730) * lu(k,1722) - lu(k,1731) = lu(k,1731) * lu(k,1722) - lu(k,1764) = lu(k,1764) - lu(k,1723) * lu(k,1763) - lu(k,1765) = lu(k,1765) - lu(k,1724) * lu(k,1763) - lu(k,1766) = lu(k,1766) - lu(k,1725) * lu(k,1763) - lu(k,1767) = lu(k,1767) - lu(k,1726) * lu(k,1763) - lu(k,1768) = lu(k,1768) - lu(k,1727) * lu(k,1763) - lu(k,1769) = lu(k,1769) - lu(k,1728) * lu(k,1763) - lu(k,1770) = lu(k,1770) - lu(k,1729) * lu(k,1763) - lu(k,1771) = lu(k,1771) - lu(k,1730) * lu(k,1763) - lu(k,1772) = lu(k,1772) - lu(k,1731) * lu(k,1763) - lu(k,1821) = lu(k,1821) - lu(k,1723) * lu(k,1820) - lu(k,1822) = lu(k,1822) - lu(k,1724) * lu(k,1820) - lu(k,1823) = lu(k,1823) - lu(k,1725) * lu(k,1820) - lu(k,1824) = lu(k,1824) - lu(k,1726) * lu(k,1820) - lu(k,1825) = lu(k,1825) - lu(k,1727) * lu(k,1820) - lu(k,1826) = lu(k,1826) - lu(k,1728) * lu(k,1820) - lu(k,1827) = lu(k,1827) - lu(k,1729) * lu(k,1820) - lu(k,1828) = lu(k,1828) - lu(k,1730) * lu(k,1820) - lu(k,1829) = lu(k,1829) - lu(k,1731) * lu(k,1820) - lu(k,1871) = lu(k,1871) - lu(k,1723) * lu(k,1870) - lu(k,1872) = lu(k,1872) - lu(k,1724) * lu(k,1870) - lu(k,1873) = lu(k,1873) - lu(k,1725) * lu(k,1870) - lu(k,1874) = lu(k,1874) - lu(k,1726) * lu(k,1870) - lu(k,1875) = lu(k,1875) - lu(k,1727) * lu(k,1870) - lu(k,1876) = lu(k,1876) - lu(k,1728) * lu(k,1870) - lu(k,1877) = lu(k,1877) - lu(k,1729) * lu(k,1870) - lu(k,1878) = lu(k,1878) - lu(k,1730) * lu(k,1870) - lu(k,1879) = lu(k,1879) - lu(k,1731) * lu(k,1870) - lu(k,1931) = lu(k,1931) - lu(k,1723) * lu(k,1930) - lu(k,1932) = lu(k,1932) - lu(k,1724) * lu(k,1930) - lu(k,1933) = lu(k,1933) - lu(k,1725) * lu(k,1930) - lu(k,1934) = lu(k,1934) - lu(k,1726) * lu(k,1930) - lu(k,1935) = lu(k,1935) - lu(k,1727) * lu(k,1930) - lu(k,1936) = lu(k,1936) - lu(k,1728) * lu(k,1930) - lu(k,1937) = lu(k,1937) - lu(k,1729) * lu(k,1930) - lu(k,1938) = lu(k,1938) - lu(k,1730) * lu(k,1930) - lu(k,1939) = lu(k,1939) - lu(k,1731) * lu(k,1930) - lu(k,1955) = lu(k,1955) - lu(k,1723) * lu(k,1954) - lu(k,1956) = lu(k,1956) - lu(k,1724) * lu(k,1954) - lu(k,1957) = lu(k,1957) - lu(k,1725) * lu(k,1954) - lu(k,1958) = lu(k,1958) - lu(k,1726) * lu(k,1954) - lu(k,1959) = lu(k,1959) - lu(k,1727) * lu(k,1954) - lu(k,1960) = lu(k,1960) - lu(k,1728) * lu(k,1954) - lu(k,1961) = lu(k,1961) - lu(k,1729) * lu(k,1954) - lu(k,1962) = lu(k,1962) - lu(k,1730) * lu(k,1954) - lu(k,1963) = lu(k,1963) - lu(k,1731) * lu(k,1954) - lu(k,1981) = lu(k,1981) - lu(k,1723) * lu(k,1980) - lu(k,1982) = lu(k,1982) - lu(k,1724) * lu(k,1980) - lu(k,1983) = lu(k,1983) - lu(k,1725) * lu(k,1980) - lu(k,1984) = lu(k,1984) - lu(k,1726) * lu(k,1980) - lu(k,1985) = lu(k,1985) - lu(k,1727) * lu(k,1980) - lu(k,1986) = lu(k,1986) - lu(k,1728) * lu(k,1980) - lu(k,1987) = lu(k,1987) - lu(k,1729) * lu(k,1980) - lu(k,1988) = lu(k,1988) - lu(k,1730) * lu(k,1980) - lu(k,1989) = lu(k,1989) - lu(k,1731) * lu(k,1980) - lu(k,2011) = lu(k,2011) - lu(k,1723) * lu(k,2010) - lu(k,2012) = lu(k,2012) - lu(k,1724) * lu(k,2010) - lu(k,2013) = lu(k,2013) - lu(k,1725) * lu(k,2010) - lu(k,2014) = lu(k,2014) - lu(k,1726) * lu(k,2010) - lu(k,2015) = lu(k,2015) - lu(k,1727) * lu(k,2010) - lu(k,2016) = lu(k,2016) - lu(k,1728) * lu(k,2010) - lu(k,2017) = lu(k,2017) - lu(k,1729) * lu(k,2010) - lu(k,2018) = lu(k,2018) - lu(k,1730) * lu(k,2010) - lu(k,2019) = lu(k,2019) - lu(k,1731) * lu(k,2010) - lu(k,2045) = lu(k,2045) - lu(k,1723) * lu(k,2044) - lu(k,2046) = lu(k,2046) - lu(k,1724) * lu(k,2044) - lu(k,2047) = lu(k,2047) - lu(k,1725) * lu(k,2044) - lu(k,2048) = lu(k,2048) - lu(k,1726) * lu(k,2044) - lu(k,2049) = lu(k,2049) - lu(k,1727) * lu(k,2044) - lu(k,2050) = lu(k,2050) - lu(k,1728) * lu(k,2044) - lu(k,2051) = lu(k,2051) - lu(k,1729) * lu(k,2044) - lu(k,2052) = lu(k,2052) - lu(k,1730) * lu(k,2044) - lu(k,2053) = lu(k,2053) - lu(k,1731) * lu(k,2044) - lu(k,2070) = lu(k,2070) - lu(k,1723) * lu(k,2069) - lu(k,2071) = lu(k,2071) - lu(k,1724) * lu(k,2069) - lu(k,2072) = lu(k,2072) - lu(k,1725) * lu(k,2069) - lu(k,2073) = lu(k,2073) - lu(k,1726) * lu(k,2069) - lu(k,2074) = lu(k,2074) - lu(k,1727) * lu(k,2069) - lu(k,2075) = lu(k,2075) - lu(k,1728) * lu(k,2069) - lu(k,2076) = lu(k,2076) - lu(k,1729) * lu(k,2069) - lu(k,2077) = lu(k,2077) - lu(k,1730) * lu(k,2069) - lu(k,2078) = lu(k,2078) - lu(k,1731) * lu(k,2069) - lu(k,1764) = 1._r8 / lu(k,1764) - lu(k,1765) = lu(k,1765) * lu(k,1764) - lu(k,1766) = lu(k,1766) * lu(k,1764) - lu(k,1767) = lu(k,1767) * lu(k,1764) - lu(k,1768) = lu(k,1768) * lu(k,1764) - lu(k,1769) = lu(k,1769) * lu(k,1764) - lu(k,1770) = lu(k,1770) * lu(k,1764) - lu(k,1771) = lu(k,1771) * lu(k,1764) - lu(k,1772) = lu(k,1772) * lu(k,1764) - lu(k,1822) = lu(k,1822) - lu(k,1765) * lu(k,1821) - lu(k,1823) = lu(k,1823) - lu(k,1766) * lu(k,1821) - lu(k,1824) = lu(k,1824) - lu(k,1767) * lu(k,1821) - lu(k,1825) = lu(k,1825) - lu(k,1768) * lu(k,1821) - lu(k,1826) = lu(k,1826) - lu(k,1769) * lu(k,1821) - lu(k,1827) = lu(k,1827) - lu(k,1770) * lu(k,1821) - lu(k,1828) = lu(k,1828) - lu(k,1771) * lu(k,1821) - lu(k,1829) = lu(k,1829) - lu(k,1772) * lu(k,1821) - lu(k,1872) = lu(k,1872) - lu(k,1765) * lu(k,1871) - lu(k,1873) = lu(k,1873) - lu(k,1766) * lu(k,1871) - lu(k,1874) = lu(k,1874) - lu(k,1767) * lu(k,1871) - lu(k,1875) = lu(k,1875) - lu(k,1768) * lu(k,1871) - lu(k,1876) = lu(k,1876) - lu(k,1769) * lu(k,1871) - lu(k,1877) = lu(k,1877) - lu(k,1770) * lu(k,1871) - lu(k,1878) = lu(k,1878) - lu(k,1771) * lu(k,1871) - lu(k,1879) = lu(k,1879) - lu(k,1772) * lu(k,1871) - lu(k,1932) = lu(k,1932) - lu(k,1765) * lu(k,1931) - lu(k,1933) = lu(k,1933) - lu(k,1766) * lu(k,1931) - lu(k,1934) = lu(k,1934) - lu(k,1767) * lu(k,1931) - lu(k,1935) = lu(k,1935) - lu(k,1768) * lu(k,1931) - lu(k,1936) = lu(k,1936) - lu(k,1769) * lu(k,1931) - lu(k,1937) = lu(k,1937) - lu(k,1770) * lu(k,1931) - lu(k,1938) = lu(k,1938) - lu(k,1771) * lu(k,1931) - lu(k,1939) = lu(k,1939) - lu(k,1772) * lu(k,1931) - lu(k,1956) = lu(k,1956) - lu(k,1765) * lu(k,1955) - lu(k,1957) = lu(k,1957) - lu(k,1766) * lu(k,1955) - lu(k,1958) = lu(k,1958) - lu(k,1767) * lu(k,1955) - lu(k,1959) = lu(k,1959) - lu(k,1768) * lu(k,1955) - lu(k,1960) = lu(k,1960) - lu(k,1769) * lu(k,1955) - lu(k,1961) = lu(k,1961) - lu(k,1770) * lu(k,1955) - lu(k,1962) = lu(k,1962) - lu(k,1771) * lu(k,1955) - lu(k,1963) = lu(k,1963) - lu(k,1772) * lu(k,1955) - lu(k,1982) = lu(k,1982) - lu(k,1765) * lu(k,1981) - lu(k,1983) = lu(k,1983) - lu(k,1766) * lu(k,1981) - lu(k,1984) = lu(k,1984) - lu(k,1767) * lu(k,1981) - lu(k,1985) = lu(k,1985) - lu(k,1768) * lu(k,1981) - lu(k,1986) = lu(k,1986) - lu(k,1769) * lu(k,1981) - lu(k,1987) = lu(k,1987) - lu(k,1770) * lu(k,1981) - lu(k,1988) = lu(k,1988) - lu(k,1771) * lu(k,1981) - lu(k,1989) = lu(k,1989) - lu(k,1772) * lu(k,1981) - lu(k,2012) = lu(k,2012) - lu(k,1765) * lu(k,2011) - lu(k,2013) = lu(k,2013) - lu(k,1766) * lu(k,2011) - lu(k,2014) = lu(k,2014) - lu(k,1767) * lu(k,2011) - lu(k,2015) = lu(k,2015) - lu(k,1768) * lu(k,2011) - lu(k,2016) = lu(k,2016) - lu(k,1769) * lu(k,2011) - lu(k,2017) = lu(k,2017) - lu(k,1770) * lu(k,2011) - lu(k,2018) = lu(k,2018) - lu(k,1771) * lu(k,2011) - lu(k,2019) = lu(k,2019) - lu(k,1772) * lu(k,2011) - lu(k,2046) = lu(k,2046) - lu(k,1765) * lu(k,2045) - lu(k,2047) = lu(k,2047) - lu(k,1766) * lu(k,2045) - lu(k,2048) = lu(k,2048) - lu(k,1767) * lu(k,2045) - lu(k,2049) = lu(k,2049) - lu(k,1768) * lu(k,2045) - lu(k,2050) = lu(k,2050) - lu(k,1769) * lu(k,2045) - lu(k,2051) = lu(k,2051) - lu(k,1770) * lu(k,2045) - lu(k,2052) = lu(k,2052) - lu(k,1771) * lu(k,2045) - lu(k,2053) = lu(k,2053) - lu(k,1772) * lu(k,2045) - lu(k,2071) = lu(k,2071) - lu(k,1765) * lu(k,2070) - lu(k,2072) = lu(k,2072) - lu(k,1766) * lu(k,2070) - lu(k,2073) = lu(k,2073) - lu(k,1767) * lu(k,2070) - lu(k,2074) = lu(k,2074) - lu(k,1768) * lu(k,2070) - lu(k,2075) = lu(k,2075) - lu(k,1769) * lu(k,2070) - lu(k,2076) = lu(k,2076) - lu(k,1770) * lu(k,2070) - lu(k,2077) = lu(k,2077) - lu(k,1771) * lu(k,2070) - lu(k,2078) = lu(k,2078) - lu(k,1772) * lu(k,2070) - lu(k,1822) = 1._r8 / lu(k,1822) - lu(k,1823) = lu(k,1823) * lu(k,1822) - lu(k,1824) = lu(k,1824) * lu(k,1822) - lu(k,1825) = lu(k,1825) * lu(k,1822) - lu(k,1826) = lu(k,1826) * lu(k,1822) - lu(k,1827) = lu(k,1827) * lu(k,1822) - lu(k,1828) = lu(k,1828) * lu(k,1822) - lu(k,1829) = lu(k,1829) * lu(k,1822) - lu(k,1873) = lu(k,1873) - lu(k,1823) * lu(k,1872) - lu(k,1874) = lu(k,1874) - lu(k,1824) * lu(k,1872) - lu(k,1875) = lu(k,1875) - lu(k,1825) * lu(k,1872) - lu(k,1876) = lu(k,1876) - lu(k,1826) * lu(k,1872) - lu(k,1877) = lu(k,1877) - lu(k,1827) * lu(k,1872) - lu(k,1878) = lu(k,1878) - lu(k,1828) * lu(k,1872) - lu(k,1879) = lu(k,1879) - lu(k,1829) * lu(k,1872) - lu(k,1933) = lu(k,1933) - lu(k,1823) * lu(k,1932) - lu(k,1934) = lu(k,1934) - lu(k,1824) * lu(k,1932) - lu(k,1935) = lu(k,1935) - lu(k,1825) * lu(k,1932) - lu(k,1936) = lu(k,1936) - lu(k,1826) * lu(k,1932) - lu(k,1937) = lu(k,1937) - lu(k,1827) * lu(k,1932) - lu(k,1938) = lu(k,1938) - lu(k,1828) * lu(k,1932) - lu(k,1939) = lu(k,1939) - lu(k,1829) * lu(k,1932) - lu(k,1957) = lu(k,1957) - lu(k,1823) * lu(k,1956) - lu(k,1958) = lu(k,1958) - lu(k,1824) * lu(k,1956) - lu(k,1959) = lu(k,1959) - lu(k,1825) * lu(k,1956) - lu(k,1960) = lu(k,1960) - lu(k,1826) * lu(k,1956) - lu(k,1961) = lu(k,1961) - lu(k,1827) * lu(k,1956) - lu(k,1962) = lu(k,1962) - lu(k,1828) * lu(k,1956) - lu(k,1963) = lu(k,1963) - lu(k,1829) * lu(k,1956) - lu(k,1983) = lu(k,1983) - lu(k,1823) * lu(k,1982) - lu(k,1984) = lu(k,1984) - lu(k,1824) * lu(k,1982) - lu(k,1985) = lu(k,1985) - lu(k,1825) * lu(k,1982) - lu(k,1986) = lu(k,1986) - lu(k,1826) * lu(k,1982) - lu(k,1987) = lu(k,1987) - lu(k,1827) * lu(k,1982) - lu(k,1988) = lu(k,1988) - lu(k,1828) * lu(k,1982) - lu(k,1989) = lu(k,1989) - lu(k,1829) * lu(k,1982) - lu(k,2013) = lu(k,2013) - lu(k,1823) * lu(k,2012) - lu(k,2014) = lu(k,2014) - lu(k,1824) * lu(k,2012) - lu(k,2015) = lu(k,2015) - lu(k,1825) * lu(k,2012) - lu(k,2016) = lu(k,2016) - lu(k,1826) * lu(k,2012) - lu(k,2017) = lu(k,2017) - lu(k,1827) * lu(k,2012) - lu(k,2018) = lu(k,2018) - lu(k,1828) * lu(k,2012) - lu(k,2019) = lu(k,2019) - lu(k,1829) * lu(k,2012) - lu(k,2047) = lu(k,2047) - lu(k,1823) * lu(k,2046) - lu(k,2048) = lu(k,2048) - lu(k,1824) * lu(k,2046) - lu(k,2049) = lu(k,2049) - lu(k,1825) * lu(k,2046) - lu(k,2050) = lu(k,2050) - lu(k,1826) * lu(k,2046) - lu(k,2051) = lu(k,2051) - lu(k,1827) * lu(k,2046) - lu(k,2052) = lu(k,2052) - lu(k,1828) * lu(k,2046) - lu(k,2053) = lu(k,2053) - lu(k,1829) * lu(k,2046) - lu(k,2072) = lu(k,2072) - lu(k,1823) * lu(k,2071) - lu(k,2073) = lu(k,2073) - lu(k,1824) * lu(k,2071) - lu(k,2074) = lu(k,2074) - lu(k,1825) * lu(k,2071) - lu(k,2075) = lu(k,2075) - lu(k,1826) * lu(k,2071) - lu(k,2076) = lu(k,2076) - lu(k,1827) * lu(k,2071) - lu(k,2077) = lu(k,2077) - lu(k,1828) * lu(k,2071) - lu(k,2078) = lu(k,2078) - lu(k,1829) * lu(k,2071) - lu(k,1873) = 1._r8 / lu(k,1873) - lu(k,1874) = lu(k,1874) * lu(k,1873) - lu(k,1875) = lu(k,1875) * lu(k,1873) - lu(k,1876) = lu(k,1876) * lu(k,1873) - lu(k,1877) = lu(k,1877) * lu(k,1873) - lu(k,1878) = lu(k,1878) * lu(k,1873) - lu(k,1879) = lu(k,1879) * lu(k,1873) - lu(k,1934) = lu(k,1934) - lu(k,1874) * lu(k,1933) - lu(k,1935) = lu(k,1935) - lu(k,1875) * lu(k,1933) - lu(k,1936) = lu(k,1936) - lu(k,1876) * lu(k,1933) - lu(k,1937) = lu(k,1937) - lu(k,1877) * lu(k,1933) - lu(k,1938) = lu(k,1938) - lu(k,1878) * lu(k,1933) - lu(k,1939) = lu(k,1939) - lu(k,1879) * lu(k,1933) - lu(k,1958) = lu(k,1958) - lu(k,1874) * lu(k,1957) - lu(k,1959) = lu(k,1959) - lu(k,1875) * lu(k,1957) - lu(k,1960) = lu(k,1960) - lu(k,1876) * lu(k,1957) - lu(k,1961) = lu(k,1961) - lu(k,1877) * lu(k,1957) - lu(k,1962) = lu(k,1962) - lu(k,1878) * lu(k,1957) - lu(k,1963) = lu(k,1963) - lu(k,1879) * lu(k,1957) - lu(k,1984) = lu(k,1984) - lu(k,1874) * lu(k,1983) - lu(k,1985) = lu(k,1985) - lu(k,1875) * lu(k,1983) - lu(k,1986) = lu(k,1986) - lu(k,1876) * lu(k,1983) - lu(k,1987) = lu(k,1987) - lu(k,1877) * lu(k,1983) - lu(k,1988) = lu(k,1988) - lu(k,1878) * lu(k,1983) - lu(k,1989) = lu(k,1989) - lu(k,1879) * lu(k,1983) - lu(k,2014) = lu(k,2014) - lu(k,1874) * lu(k,2013) - lu(k,2015) = lu(k,2015) - lu(k,1875) * lu(k,2013) - lu(k,2016) = lu(k,2016) - lu(k,1876) * lu(k,2013) - lu(k,2017) = lu(k,2017) - lu(k,1877) * lu(k,2013) - lu(k,2018) = lu(k,2018) - lu(k,1878) * lu(k,2013) - lu(k,2019) = lu(k,2019) - lu(k,1879) * lu(k,2013) - lu(k,2048) = lu(k,2048) - lu(k,1874) * lu(k,2047) - lu(k,2049) = lu(k,2049) - lu(k,1875) * lu(k,2047) - lu(k,2050) = lu(k,2050) - lu(k,1876) * lu(k,2047) - lu(k,2051) = lu(k,2051) - lu(k,1877) * lu(k,2047) - lu(k,2052) = lu(k,2052) - lu(k,1878) * lu(k,2047) - lu(k,2053) = lu(k,2053) - lu(k,1879) * lu(k,2047) - lu(k,2073) = lu(k,2073) - lu(k,1874) * lu(k,2072) - lu(k,2074) = lu(k,2074) - lu(k,1875) * lu(k,2072) - lu(k,2075) = lu(k,2075) - lu(k,1876) * lu(k,2072) - lu(k,2076) = lu(k,2076) - lu(k,1877) * lu(k,2072) - lu(k,2077) = lu(k,2077) - lu(k,1878) * lu(k,2072) - lu(k,2078) = lu(k,2078) - lu(k,1879) * lu(k,2072) + lu(k,1394) = 1._r8 / lu(k,1394) + lu(k,1395) = lu(k,1395) * lu(k,1394) + lu(k,1396) = lu(k,1396) * lu(k,1394) + lu(k,1397) = lu(k,1397) * lu(k,1394) + lu(k,1398) = lu(k,1398) * lu(k,1394) + lu(k,1399) = lu(k,1399) * lu(k,1394) + lu(k,1400) = lu(k,1400) * lu(k,1394) + lu(k,1401) = lu(k,1401) * lu(k,1394) + lu(k,1402) = lu(k,1402) * lu(k,1394) + lu(k,1403) = lu(k,1403) * lu(k,1394) + lu(k,1404) = lu(k,1404) * lu(k,1394) + lu(k,1405) = lu(k,1405) * lu(k,1394) + lu(k,1406) = lu(k,1406) * lu(k,1394) + lu(k,1426) = lu(k,1426) - lu(k,1395) * lu(k,1425) + lu(k,1428) = lu(k,1428) - lu(k,1396) * lu(k,1425) + lu(k,1429) = lu(k,1429) - lu(k,1397) * lu(k,1425) + lu(k,1430) = lu(k,1430) - lu(k,1398) * lu(k,1425) + lu(k,1431) = lu(k,1431) - lu(k,1399) * lu(k,1425) + lu(k,1432) = lu(k,1432) - lu(k,1400) * lu(k,1425) + lu(k,1433) = lu(k,1433) - lu(k,1401) * lu(k,1425) + lu(k,1434) = lu(k,1434) - lu(k,1402) * lu(k,1425) + lu(k,1435) = lu(k,1435) - lu(k,1403) * lu(k,1425) + lu(k,1436) = lu(k,1436) - lu(k,1404) * lu(k,1425) + lu(k,1437) = lu(k,1437) - lu(k,1405) * lu(k,1425) + lu(k,1438) = lu(k,1438) - lu(k,1406) * lu(k,1425) + lu(k,1599) = lu(k,1599) - lu(k,1395) * lu(k,1598) + lu(k,1602) = lu(k,1602) - lu(k,1396) * lu(k,1598) + lu(k,1604) = lu(k,1604) - lu(k,1397) * lu(k,1598) + lu(k,1605) = lu(k,1605) - lu(k,1398) * lu(k,1598) + lu(k,1606) = lu(k,1606) - lu(k,1399) * lu(k,1598) + lu(k,1608) = lu(k,1608) - lu(k,1400) * lu(k,1598) + lu(k,1611) = lu(k,1611) - lu(k,1401) * lu(k,1598) + lu(k,1612) = lu(k,1612) - lu(k,1402) * lu(k,1598) + lu(k,1613) = lu(k,1613) - lu(k,1403) * lu(k,1598) + lu(k,1615) = lu(k,1615) - lu(k,1404) * lu(k,1598) + lu(k,1617) = lu(k,1617) - lu(k,1405) * lu(k,1598) + lu(k,1618) = lu(k,1618) - lu(k,1406) * lu(k,1598) + lu(k,1652) = lu(k,1652) - lu(k,1395) * lu(k,1651) + lu(k,1654) = lu(k,1654) - lu(k,1396) * lu(k,1651) + lu(k,1656) = lu(k,1656) - lu(k,1397) * lu(k,1651) + lu(k,1657) = lu(k,1657) - lu(k,1398) * lu(k,1651) + lu(k,1658) = lu(k,1658) - lu(k,1399) * lu(k,1651) + lu(k,1660) = lu(k,1660) - lu(k,1400) * lu(k,1651) + lu(k,1663) = lu(k,1663) - lu(k,1401) * lu(k,1651) + lu(k,1664) = lu(k,1664) - lu(k,1402) * lu(k,1651) + lu(k,1665) = lu(k,1665) - lu(k,1403) * lu(k,1651) + lu(k,1667) = lu(k,1667) - lu(k,1404) * lu(k,1651) + lu(k,1669) = lu(k,1669) - lu(k,1405) * lu(k,1651) + lu(k,1670) = lu(k,1670) - lu(k,1406) * lu(k,1651) + lu(k,1695) = lu(k,1695) - lu(k,1395) * lu(k,1694) + lu(k,1698) = lu(k,1698) - lu(k,1396) * lu(k,1694) + lu(k,1700) = lu(k,1700) - lu(k,1397) * lu(k,1694) + lu(k,1701) = lu(k,1701) - lu(k,1398) * lu(k,1694) + lu(k,1702) = lu(k,1702) - lu(k,1399) * lu(k,1694) + lu(k,1704) = lu(k,1704) - lu(k,1400) * lu(k,1694) + lu(k,1707) = lu(k,1707) - lu(k,1401) * lu(k,1694) + lu(k,1708) = lu(k,1708) - lu(k,1402) * lu(k,1694) + lu(k,1709) = lu(k,1709) - lu(k,1403) * lu(k,1694) + lu(k,1711) = lu(k,1711) - lu(k,1404) * lu(k,1694) + lu(k,1713) = lu(k,1713) - lu(k,1405) * lu(k,1694) + lu(k,1714) = lu(k,1714) - lu(k,1406) * lu(k,1694) + lu(k,1907) = lu(k,1907) - lu(k,1395) * lu(k,1906) + lu(k,1911) = lu(k,1911) - lu(k,1396) * lu(k,1906) + lu(k,1913) = lu(k,1913) - lu(k,1397) * lu(k,1906) + lu(k,1914) = lu(k,1914) - lu(k,1398) * lu(k,1906) + lu(k,1915) = lu(k,1915) - lu(k,1399) * lu(k,1906) + lu(k,1917) = lu(k,1917) - lu(k,1400) * lu(k,1906) + lu(k,1920) = lu(k,1920) - lu(k,1401) * lu(k,1906) + lu(k,1921) = lu(k,1921) - lu(k,1402) * lu(k,1906) + lu(k,1922) = lu(k,1922) - lu(k,1403) * lu(k,1906) + lu(k,1924) = lu(k,1924) - lu(k,1404) * lu(k,1906) + lu(k,1926) = lu(k,1926) - lu(k,1405) * lu(k,1906) + lu(k,1927) = lu(k,1927) - lu(k,1406) * lu(k,1906) + lu(k,2068) = lu(k,2068) - lu(k,1395) * lu(k,2067) + lu(k,2071) = lu(k,2071) - lu(k,1396) * lu(k,2067) + lu(k,2073) = lu(k,2073) - lu(k,1397) * lu(k,2067) + lu(k,2074) = lu(k,2074) - lu(k,1398) * lu(k,2067) + lu(k,2075) = lu(k,2075) - lu(k,1399) * lu(k,2067) + lu(k,2077) = lu(k,2077) - lu(k,1400) * lu(k,2067) + lu(k,2080) = lu(k,2080) - lu(k,1401) * lu(k,2067) + lu(k,2081) = lu(k,2081) - lu(k,1402) * lu(k,2067) + lu(k,2082) = lu(k,2082) - lu(k,1403) * lu(k,2067) + lu(k,2084) = lu(k,2084) - lu(k,1404) * lu(k,2067) + lu(k,2086) = lu(k,2086) - lu(k,1405) * lu(k,2067) + lu(k,2087) = lu(k,2087) - lu(k,1406) * lu(k,2067) + lu(k,2210) = lu(k,2210) - lu(k,1395) * lu(k,2209) + lu(k,2214) = lu(k,2214) - lu(k,1396) * lu(k,2209) + lu(k,2216) = lu(k,2216) - lu(k,1397) * lu(k,2209) + lu(k,2217) = lu(k,2217) - lu(k,1398) * lu(k,2209) + lu(k,2218) = lu(k,2218) - lu(k,1399) * lu(k,2209) + lu(k,2220) = lu(k,2220) - lu(k,1400) * lu(k,2209) + lu(k,2223) = lu(k,2223) - lu(k,1401) * lu(k,2209) + lu(k,2224) = lu(k,2224) - lu(k,1402) * lu(k,2209) + lu(k,2225) = lu(k,2225) - lu(k,1403) * lu(k,2209) + lu(k,2227) = lu(k,2227) - lu(k,1404) * lu(k,2209) + lu(k,2229) = lu(k,2229) - lu(k,1405) * lu(k,2209) + lu(k,2230) = lu(k,2230) - lu(k,1406) * lu(k,2209) + lu(k,2311) = lu(k,2311) - lu(k,1395) * lu(k,2310) + lu(k,2314) = lu(k,2314) - lu(k,1396) * lu(k,2310) + lu(k,2316) = lu(k,2316) - lu(k,1397) * lu(k,2310) + lu(k,2317) = lu(k,2317) - lu(k,1398) * lu(k,2310) + lu(k,2318) = lu(k,2318) - lu(k,1399) * lu(k,2310) + lu(k,2320) = lu(k,2320) - lu(k,1400) * lu(k,2310) + lu(k,2323) = lu(k,2323) - lu(k,1401) * lu(k,2310) + lu(k,2324) = lu(k,2324) - lu(k,1402) * lu(k,2310) + lu(k,2325) = lu(k,2325) - lu(k,1403) * lu(k,2310) + lu(k,2327) = lu(k,2327) - lu(k,1404) * lu(k,2310) + lu(k,2329) = lu(k,2329) - lu(k,1405) * lu(k,2310) + lu(k,2330) = lu(k,2330) - lu(k,1406) * lu(k,2310) + lu(k,1426) = 1._r8 / lu(k,1426) + lu(k,1427) = lu(k,1427) * lu(k,1426) + lu(k,1428) = lu(k,1428) * lu(k,1426) + lu(k,1429) = lu(k,1429) * lu(k,1426) + lu(k,1430) = lu(k,1430) * lu(k,1426) + lu(k,1431) = lu(k,1431) * lu(k,1426) + lu(k,1432) = lu(k,1432) * lu(k,1426) + lu(k,1433) = lu(k,1433) * lu(k,1426) + lu(k,1434) = lu(k,1434) * lu(k,1426) + lu(k,1435) = lu(k,1435) * lu(k,1426) + lu(k,1436) = lu(k,1436) * lu(k,1426) + lu(k,1437) = lu(k,1437) * lu(k,1426) + lu(k,1438) = lu(k,1438) * lu(k,1426) + lu(k,1601) = lu(k,1601) - lu(k,1427) * lu(k,1599) + lu(k,1602) = lu(k,1602) - lu(k,1428) * lu(k,1599) + lu(k,1604) = lu(k,1604) - lu(k,1429) * lu(k,1599) + lu(k,1605) = lu(k,1605) - lu(k,1430) * lu(k,1599) + lu(k,1606) = lu(k,1606) - lu(k,1431) * lu(k,1599) + lu(k,1608) = lu(k,1608) - lu(k,1432) * lu(k,1599) + lu(k,1611) = lu(k,1611) - lu(k,1433) * lu(k,1599) + lu(k,1612) = lu(k,1612) - lu(k,1434) * lu(k,1599) + lu(k,1613) = lu(k,1613) - lu(k,1435) * lu(k,1599) + lu(k,1615) = lu(k,1615) - lu(k,1436) * lu(k,1599) + lu(k,1617) = lu(k,1617) - lu(k,1437) * lu(k,1599) + lu(k,1618) = lu(k,1618) - lu(k,1438) * lu(k,1599) + lu(k,1653) = lu(k,1653) - lu(k,1427) * lu(k,1652) + lu(k,1654) = lu(k,1654) - lu(k,1428) * lu(k,1652) + lu(k,1656) = lu(k,1656) - lu(k,1429) * lu(k,1652) + lu(k,1657) = lu(k,1657) - lu(k,1430) * lu(k,1652) + lu(k,1658) = lu(k,1658) - lu(k,1431) * lu(k,1652) + lu(k,1660) = lu(k,1660) - lu(k,1432) * lu(k,1652) + lu(k,1663) = lu(k,1663) - lu(k,1433) * lu(k,1652) + lu(k,1664) = lu(k,1664) - lu(k,1434) * lu(k,1652) + lu(k,1665) = lu(k,1665) - lu(k,1435) * lu(k,1652) + lu(k,1667) = lu(k,1667) - lu(k,1436) * lu(k,1652) + lu(k,1669) = lu(k,1669) - lu(k,1437) * lu(k,1652) + lu(k,1670) = lu(k,1670) - lu(k,1438) * lu(k,1652) + lu(k,1697) = - lu(k,1427) * lu(k,1695) + lu(k,1698) = lu(k,1698) - lu(k,1428) * lu(k,1695) + lu(k,1700) = lu(k,1700) - lu(k,1429) * lu(k,1695) + lu(k,1701) = lu(k,1701) - lu(k,1430) * lu(k,1695) + lu(k,1702) = lu(k,1702) - lu(k,1431) * lu(k,1695) + lu(k,1704) = lu(k,1704) - lu(k,1432) * lu(k,1695) + lu(k,1707) = lu(k,1707) - lu(k,1433) * lu(k,1695) + lu(k,1708) = lu(k,1708) - lu(k,1434) * lu(k,1695) + lu(k,1709) = lu(k,1709) - lu(k,1435) * lu(k,1695) + lu(k,1711) = lu(k,1711) - lu(k,1436) * lu(k,1695) + lu(k,1713) = lu(k,1713) - lu(k,1437) * lu(k,1695) + lu(k,1714) = lu(k,1714) - lu(k,1438) * lu(k,1695) + lu(k,1910) = lu(k,1910) - lu(k,1427) * lu(k,1907) + lu(k,1911) = lu(k,1911) - lu(k,1428) * lu(k,1907) + lu(k,1913) = lu(k,1913) - lu(k,1429) * lu(k,1907) + lu(k,1914) = lu(k,1914) - lu(k,1430) * lu(k,1907) + lu(k,1915) = lu(k,1915) - lu(k,1431) * lu(k,1907) + lu(k,1917) = lu(k,1917) - lu(k,1432) * lu(k,1907) + lu(k,1920) = lu(k,1920) - lu(k,1433) * lu(k,1907) + lu(k,1921) = lu(k,1921) - lu(k,1434) * lu(k,1907) + lu(k,1922) = lu(k,1922) - lu(k,1435) * lu(k,1907) + lu(k,1924) = lu(k,1924) - lu(k,1436) * lu(k,1907) + lu(k,1926) = lu(k,1926) - lu(k,1437) * lu(k,1907) + lu(k,1927) = lu(k,1927) - lu(k,1438) * lu(k,1907) + lu(k,2070) = lu(k,2070) - lu(k,1427) * lu(k,2068) + lu(k,2071) = lu(k,2071) - lu(k,1428) * lu(k,2068) + lu(k,2073) = lu(k,2073) - lu(k,1429) * lu(k,2068) + lu(k,2074) = lu(k,2074) - lu(k,1430) * lu(k,2068) + lu(k,2075) = lu(k,2075) - lu(k,1431) * lu(k,2068) + lu(k,2077) = lu(k,2077) - lu(k,1432) * lu(k,2068) + lu(k,2080) = lu(k,2080) - lu(k,1433) * lu(k,2068) + lu(k,2081) = lu(k,2081) - lu(k,1434) * lu(k,2068) + lu(k,2082) = lu(k,2082) - lu(k,1435) * lu(k,2068) + lu(k,2084) = lu(k,2084) - lu(k,1436) * lu(k,2068) + lu(k,2086) = lu(k,2086) - lu(k,1437) * lu(k,2068) + lu(k,2087) = lu(k,2087) - lu(k,1438) * lu(k,2068) + lu(k,2213) = lu(k,2213) - lu(k,1427) * lu(k,2210) + lu(k,2214) = lu(k,2214) - lu(k,1428) * lu(k,2210) + lu(k,2216) = lu(k,2216) - lu(k,1429) * lu(k,2210) + lu(k,2217) = lu(k,2217) - lu(k,1430) * lu(k,2210) + lu(k,2218) = lu(k,2218) - lu(k,1431) * lu(k,2210) + lu(k,2220) = lu(k,2220) - lu(k,1432) * lu(k,2210) + lu(k,2223) = lu(k,2223) - lu(k,1433) * lu(k,2210) + lu(k,2224) = lu(k,2224) - lu(k,1434) * lu(k,2210) + lu(k,2225) = lu(k,2225) - lu(k,1435) * lu(k,2210) + lu(k,2227) = lu(k,2227) - lu(k,1436) * lu(k,2210) + lu(k,2229) = lu(k,2229) - lu(k,1437) * lu(k,2210) + lu(k,2230) = lu(k,2230) - lu(k,1438) * lu(k,2210) + lu(k,2252) = lu(k,2252) - lu(k,1427) * lu(k,2249) + lu(k,2253) = lu(k,2253) - lu(k,1428) * lu(k,2249) + lu(k,2255) = lu(k,2255) - lu(k,1429) * lu(k,2249) + lu(k,2256) = lu(k,2256) - lu(k,1430) * lu(k,2249) + lu(k,2257) = lu(k,2257) - lu(k,1431) * lu(k,2249) + lu(k,2259) = lu(k,2259) - lu(k,1432) * lu(k,2249) + lu(k,2262) = lu(k,2262) - lu(k,1433) * lu(k,2249) + lu(k,2263) = lu(k,2263) - lu(k,1434) * lu(k,2249) + lu(k,2264) = lu(k,2264) - lu(k,1435) * lu(k,2249) + lu(k,2266) = lu(k,2266) - lu(k,1436) * lu(k,2249) + lu(k,2268) = lu(k,2268) - lu(k,1437) * lu(k,2249) + lu(k,2269) = lu(k,2269) - lu(k,1438) * lu(k,2249) + lu(k,2313) = lu(k,2313) - lu(k,1427) * lu(k,2311) + lu(k,2314) = lu(k,2314) - lu(k,1428) * lu(k,2311) + lu(k,2316) = lu(k,2316) - lu(k,1429) * lu(k,2311) + lu(k,2317) = lu(k,2317) - lu(k,1430) * lu(k,2311) + lu(k,2318) = lu(k,2318) - lu(k,1431) * lu(k,2311) + lu(k,2320) = lu(k,2320) - lu(k,1432) * lu(k,2311) + lu(k,2323) = lu(k,2323) - lu(k,1433) * lu(k,2311) + lu(k,2324) = lu(k,2324) - lu(k,1434) * lu(k,2311) + lu(k,2325) = lu(k,2325) - lu(k,1435) * lu(k,2311) + lu(k,2327) = lu(k,2327) - lu(k,1436) * lu(k,2311) + lu(k,2329) = lu(k,2329) - lu(k,1437) * lu(k,2311) + lu(k,2330) = lu(k,2330) - lu(k,1438) * lu(k,2311) + lu(k,1441) = 1._r8 / lu(k,1441) + lu(k,1442) = lu(k,1442) * lu(k,1441) + lu(k,1443) = lu(k,1443) * lu(k,1441) + lu(k,1444) = lu(k,1444) * lu(k,1441) + lu(k,1445) = lu(k,1445) * lu(k,1441) + lu(k,1446) = lu(k,1446) * lu(k,1441) + lu(k,1447) = lu(k,1447) * lu(k,1441) + lu(k,1448) = lu(k,1448) * lu(k,1441) + lu(k,1449) = lu(k,1449) * lu(k,1441) + lu(k,1450) = lu(k,1450) * lu(k,1441) + lu(k,1451) = lu(k,1451) * lu(k,1441) + lu(k,1452) = lu(k,1452) * lu(k,1441) + lu(k,1470) = lu(k,1470) - lu(k,1442) * lu(k,1469) + lu(k,1471) = lu(k,1471) - lu(k,1443) * lu(k,1469) + lu(k,1472) = lu(k,1472) - lu(k,1444) * lu(k,1469) + lu(k,1473) = lu(k,1473) - lu(k,1445) * lu(k,1469) + lu(k,1474) = lu(k,1474) - lu(k,1446) * lu(k,1469) + lu(k,1475) = lu(k,1475) - lu(k,1447) * lu(k,1469) + lu(k,1476) = lu(k,1476) - lu(k,1448) * lu(k,1469) + lu(k,1477) = lu(k,1477) - lu(k,1449) * lu(k,1469) + lu(k,1479) = lu(k,1479) - lu(k,1450) * lu(k,1469) + lu(k,1481) = lu(k,1481) - lu(k,1451) * lu(k,1469) + lu(k,1482) = lu(k,1482) - lu(k,1452) * lu(k,1469) + lu(k,1486) = lu(k,1486) - lu(k,1442) * lu(k,1485) + lu(k,1487) = lu(k,1487) - lu(k,1443) * lu(k,1485) + lu(k,1488) = lu(k,1488) - lu(k,1444) * lu(k,1485) + lu(k,1489) = lu(k,1489) - lu(k,1445) * lu(k,1485) + lu(k,1491) = - lu(k,1446) * lu(k,1485) + lu(k,1492) = lu(k,1492) - lu(k,1447) * lu(k,1485) + lu(k,1493) = - lu(k,1448) * lu(k,1485) + lu(k,1494) = - lu(k,1449) * lu(k,1485) + lu(k,1496) = lu(k,1496) - lu(k,1450) * lu(k,1485) + lu(k,1498) = - lu(k,1451) * lu(k,1485) + lu(k,1499) = lu(k,1499) - lu(k,1452) * lu(k,1485) + lu(k,1501) = - lu(k,1442) * lu(k,1500) + lu(k,1502) = - lu(k,1443) * lu(k,1500) + lu(k,1503) = lu(k,1503) - lu(k,1444) * lu(k,1500) + lu(k,1504) = - lu(k,1445) * lu(k,1500) + lu(k,1506) = - lu(k,1446) * lu(k,1500) + lu(k,1507) = lu(k,1507) - lu(k,1447) * lu(k,1500) + lu(k,1508) = - lu(k,1448) * lu(k,1500) + lu(k,1509) = lu(k,1509) - lu(k,1449) * lu(k,1500) + lu(k,1511) = - lu(k,1450) * lu(k,1500) + lu(k,1513) = - lu(k,1451) * lu(k,1500) + lu(k,1515) = lu(k,1515) - lu(k,1452) * lu(k,1500) + lu(k,1738) = lu(k,1738) - lu(k,1442) * lu(k,1736) + lu(k,1739) = lu(k,1739) - lu(k,1443) * lu(k,1736) + lu(k,1740) = lu(k,1740) - lu(k,1444) * lu(k,1736) + lu(k,1742) = lu(k,1742) - lu(k,1445) * lu(k,1736) + lu(k,1744) = lu(k,1744) - lu(k,1446) * lu(k,1736) + lu(k,1745) = lu(k,1745) - lu(k,1447) * lu(k,1736) + lu(k,1747) = lu(k,1747) - lu(k,1448) * lu(k,1736) + lu(k,1748) = lu(k,1748) - lu(k,1449) * lu(k,1736) + lu(k,1750) = lu(k,1750) - lu(k,1450) * lu(k,1736) + lu(k,1753) = lu(k,1753) - lu(k,1451) * lu(k,1736) + lu(k,1755) = lu(k,1755) - lu(k,1452) * lu(k,1736) + lu(k,1910) = lu(k,1910) - lu(k,1442) * lu(k,1908) + lu(k,1911) = lu(k,1911) - lu(k,1443) * lu(k,1908) + lu(k,1912) = lu(k,1912) - lu(k,1444) * lu(k,1908) + lu(k,1914) = lu(k,1914) - lu(k,1445) * lu(k,1908) + lu(k,1916) = lu(k,1916) - lu(k,1446) * lu(k,1908) + lu(k,1917) = lu(k,1917) - lu(k,1447) * lu(k,1908) + lu(k,1919) = lu(k,1919) - lu(k,1448) * lu(k,1908) + lu(k,1920) = lu(k,1920) - lu(k,1449) * lu(k,1908) + lu(k,1922) = lu(k,1922) - lu(k,1450) * lu(k,1908) + lu(k,1925) = lu(k,1925) - lu(k,1451) * lu(k,1908) + lu(k,1927) = lu(k,1927) - lu(k,1452) * lu(k,1908) + lu(k,1989) = - lu(k,1442) * lu(k,1987) + lu(k,1990) = lu(k,1990) - lu(k,1443) * lu(k,1987) + lu(k,1991) = lu(k,1991) - lu(k,1444) * lu(k,1987) + lu(k,1993) = - lu(k,1445) * lu(k,1987) + lu(k,1995) = lu(k,1995) - lu(k,1446) * lu(k,1987) + lu(k,1996) = lu(k,1996) - lu(k,1447) * lu(k,1987) + lu(k,1998) = lu(k,1998) - lu(k,1448) * lu(k,1987) + lu(k,1999) = lu(k,1999) - lu(k,1449) * lu(k,1987) + lu(k,2001) = lu(k,2001) - lu(k,1450) * lu(k,1987) + lu(k,2004) = lu(k,2004) - lu(k,1451) * lu(k,1987) + lu(k,2006) = lu(k,2006) - lu(k,1452) * lu(k,1987) + lu(k,2013) = - lu(k,1442) * lu(k,2011) + lu(k,2014) = lu(k,2014) - lu(k,1443) * lu(k,2011) + lu(k,2015) = lu(k,2015) - lu(k,1444) * lu(k,2011) + lu(k,2017) = - lu(k,1445) * lu(k,2011) + lu(k,2019) = lu(k,2019) - lu(k,1446) * lu(k,2011) + lu(k,2020) = lu(k,2020) - lu(k,1447) * lu(k,2011) + lu(k,2022) = lu(k,2022) - lu(k,1448) * lu(k,2011) + lu(k,2023) = lu(k,2023) - lu(k,1449) * lu(k,2011) + lu(k,2025) = lu(k,2025) - lu(k,1450) * lu(k,2011) + lu(k,2028) = lu(k,2028) - lu(k,1451) * lu(k,2011) + lu(k,2030) = lu(k,2030) - lu(k,1452) * lu(k,2011) + lu(k,2213) = lu(k,2213) - lu(k,1442) * lu(k,2211) + lu(k,2214) = lu(k,2214) - lu(k,1443) * lu(k,2211) + lu(k,2215) = lu(k,2215) - lu(k,1444) * lu(k,2211) + lu(k,2217) = lu(k,2217) - lu(k,1445) * lu(k,2211) + lu(k,2219) = lu(k,2219) - lu(k,1446) * lu(k,2211) + lu(k,2220) = lu(k,2220) - lu(k,1447) * lu(k,2211) + lu(k,2222) = lu(k,2222) - lu(k,1448) * lu(k,2211) + lu(k,2223) = lu(k,2223) - lu(k,1449) * lu(k,2211) + lu(k,2225) = lu(k,2225) - lu(k,1450) * lu(k,2211) + lu(k,2228) = lu(k,2228) - lu(k,1451) * lu(k,2211) + lu(k,2230) = lu(k,2230) - lu(k,1452) * lu(k,2211) + lu(k,2252) = lu(k,2252) - lu(k,1442) * lu(k,2250) + lu(k,2253) = lu(k,2253) - lu(k,1443) * lu(k,2250) + lu(k,2254) = lu(k,2254) - lu(k,1444) * lu(k,2250) + lu(k,2256) = lu(k,2256) - lu(k,1445) * lu(k,2250) + lu(k,2258) = lu(k,2258) - lu(k,1446) * lu(k,2250) + lu(k,2259) = lu(k,2259) - lu(k,1447) * lu(k,2250) + lu(k,2261) = lu(k,2261) - lu(k,1448) * lu(k,2250) + lu(k,2262) = lu(k,2262) - lu(k,1449) * lu(k,2250) + lu(k,2264) = lu(k,2264) - lu(k,1450) * lu(k,2250) + lu(k,2267) = lu(k,2267) - lu(k,1451) * lu(k,2250) + lu(k,2269) = lu(k,2269) - lu(k,1452) * lu(k,2250) + lu(k,2339) = lu(k,2339) - lu(k,1442) * lu(k,2337) + lu(k,2340) = lu(k,2340) - lu(k,1443) * lu(k,2337) + lu(k,2341) = lu(k,2341) - lu(k,1444) * lu(k,2337) + lu(k,2343) = lu(k,2343) - lu(k,1445) * lu(k,2337) + lu(k,2345) = lu(k,2345) - lu(k,1446) * lu(k,2337) + lu(k,2346) = lu(k,2346) - lu(k,1447) * lu(k,2337) + lu(k,2348) = - lu(k,1448) * lu(k,2337) + lu(k,2349) = lu(k,2349) - lu(k,1449) * lu(k,2337) + lu(k,2351) = lu(k,2351) - lu(k,1450) * lu(k,2337) + lu(k,2354) = lu(k,2354) - lu(k,1451) * lu(k,2337) + lu(k,2356) = lu(k,2356) - lu(k,1452) * lu(k,2337) end do end subroutine lu_fac27 subroutine lu_fac28( avec_len, lu ) @@ -7234,84 +6092,1892 @@ subroutine lu_fac28( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1934) = 1._r8 / lu(k,1934) - lu(k,1935) = lu(k,1935) * lu(k,1934) - lu(k,1936) = lu(k,1936) * lu(k,1934) - lu(k,1937) = lu(k,1937) * lu(k,1934) - lu(k,1938) = lu(k,1938) * lu(k,1934) - lu(k,1939) = lu(k,1939) * lu(k,1934) - lu(k,1959) = lu(k,1959) - lu(k,1935) * lu(k,1958) - lu(k,1960) = lu(k,1960) - lu(k,1936) * lu(k,1958) - lu(k,1961) = lu(k,1961) - lu(k,1937) * lu(k,1958) - lu(k,1962) = lu(k,1962) - lu(k,1938) * lu(k,1958) - lu(k,1963) = lu(k,1963) - lu(k,1939) * lu(k,1958) - lu(k,1985) = lu(k,1985) - lu(k,1935) * lu(k,1984) - lu(k,1986) = lu(k,1986) - lu(k,1936) * lu(k,1984) - lu(k,1987) = lu(k,1987) - lu(k,1937) * lu(k,1984) - lu(k,1988) = lu(k,1988) - lu(k,1938) * lu(k,1984) - lu(k,1989) = lu(k,1989) - lu(k,1939) * lu(k,1984) - lu(k,2015) = lu(k,2015) - lu(k,1935) * lu(k,2014) - lu(k,2016) = lu(k,2016) - lu(k,1936) * lu(k,2014) - lu(k,2017) = lu(k,2017) - lu(k,1937) * lu(k,2014) - lu(k,2018) = lu(k,2018) - lu(k,1938) * lu(k,2014) - lu(k,2019) = lu(k,2019) - lu(k,1939) * lu(k,2014) - lu(k,2049) = lu(k,2049) - lu(k,1935) * lu(k,2048) - lu(k,2050) = lu(k,2050) - lu(k,1936) * lu(k,2048) - lu(k,2051) = lu(k,2051) - lu(k,1937) * lu(k,2048) - lu(k,2052) = lu(k,2052) - lu(k,1938) * lu(k,2048) - lu(k,2053) = lu(k,2053) - lu(k,1939) * lu(k,2048) - lu(k,2074) = lu(k,2074) - lu(k,1935) * lu(k,2073) - lu(k,2075) = lu(k,2075) - lu(k,1936) * lu(k,2073) - lu(k,2076) = lu(k,2076) - lu(k,1937) * lu(k,2073) - lu(k,2077) = lu(k,2077) - lu(k,1938) * lu(k,2073) - lu(k,2078) = lu(k,2078) - lu(k,1939) * lu(k,2073) - lu(k,1959) = 1._r8 / lu(k,1959) - lu(k,1960) = lu(k,1960) * lu(k,1959) - lu(k,1961) = lu(k,1961) * lu(k,1959) - lu(k,1962) = lu(k,1962) * lu(k,1959) - lu(k,1963) = lu(k,1963) * lu(k,1959) - lu(k,1986) = lu(k,1986) - lu(k,1960) * lu(k,1985) - lu(k,1987) = lu(k,1987) - lu(k,1961) * lu(k,1985) - lu(k,1988) = lu(k,1988) - lu(k,1962) * lu(k,1985) - lu(k,1989) = lu(k,1989) - lu(k,1963) * lu(k,1985) - lu(k,2016) = lu(k,2016) - lu(k,1960) * lu(k,2015) - lu(k,2017) = lu(k,2017) - lu(k,1961) * lu(k,2015) - lu(k,2018) = lu(k,2018) - lu(k,1962) * lu(k,2015) - lu(k,2019) = lu(k,2019) - lu(k,1963) * lu(k,2015) - lu(k,2050) = lu(k,2050) - lu(k,1960) * lu(k,2049) - lu(k,2051) = lu(k,2051) - lu(k,1961) * lu(k,2049) - lu(k,2052) = lu(k,2052) - lu(k,1962) * lu(k,2049) - lu(k,2053) = lu(k,2053) - lu(k,1963) * lu(k,2049) - lu(k,2075) = lu(k,2075) - lu(k,1960) * lu(k,2074) - lu(k,2076) = lu(k,2076) - lu(k,1961) * lu(k,2074) - lu(k,2077) = lu(k,2077) - lu(k,1962) * lu(k,2074) - lu(k,2078) = lu(k,2078) - lu(k,1963) * lu(k,2074) - lu(k,1986) = 1._r8 / lu(k,1986) - lu(k,1987) = lu(k,1987) * lu(k,1986) - lu(k,1988) = lu(k,1988) * lu(k,1986) - lu(k,1989) = lu(k,1989) * lu(k,1986) - lu(k,2017) = lu(k,2017) - lu(k,1987) * lu(k,2016) - lu(k,2018) = lu(k,2018) - lu(k,1988) * lu(k,2016) - lu(k,2019) = lu(k,2019) - lu(k,1989) * lu(k,2016) - lu(k,2051) = lu(k,2051) - lu(k,1987) * lu(k,2050) - lu(k,2052) = lu(k,2052) - lu(k,1988) * lu(k,2050) - lu(k,2053) = lu(k,2053) - lu(k,1989) * lu(k,2050) - lu(k,2076) = lu(k,2076) - lu(k,1987) * lu(k,2075) - lu(k,2077) = lu(k,2077) - lu(k,1988) * lu(k,2075) - lu(k,2078) = lu(k,2078) - lu(k,1989) * lu(k,2075) - lu(k,2017) = 1._r8 / lu(k,2017) - lu(k,2018) = lu(k,2018) * lu(k,2017) - lu(k,2019) = lu(k,2019) * lu(k,2017) - lu(k,2052) = lu(k,2052) - lu(k,2018) * lu(k,2051) - lu(k,2053) = lu(k,2053) - lu(k,2019) * lu(k,2051) - lu(k,2077) = lu(k,2077) - lu(k,2018) * lu(k,2076) - lu(k,2078) = lu(k,2078) - lu(k,2019) * lu(k,2076) - lu(k,2052) = 1._r8 / lu(k,2052) - lu(k,2053) = lu(k,2053) * lu(k,2052) - lu(k,2078) = lu(k,2078) - lu(k,2053) * lu(k,2077) - lu(k,2078) = 1._r8 / lu(k,2078) + lu(k,1455) = 1._r8 / lu(k,1455) + lu(k,1456) = lu(k,1456) * lu(k,1455) + lu(k,1457) = lu(k,1457) * lu(k,1455) + lu(k,1458) = lu(k,1458) * lu(k,1455) + lu(k,1459) = lu(k,1459) * lu(k,1455) + lu(k,1460) = lu(k,1460) * lu(k,1455) + lu(k,1461) = lu(k,1461) * lu(k,1455) + lu(k,1462) = lu(k,1462) * lu(k,1455) + lu(k,1463) = lu(k,1463) * lu(k,1455) + lu(k,1464) = lu(k,1464) * lu(k,1455) + lu(k,1603) = lu(k,1603) - lu(k,1456) * lu(k,1600) + lu(k,1607) = lu(k,1607) - lu(k,1457) * lu(k,1600) + lu(k,1608) = lu(k,1608) - lu(k,1458) * lu(k,1600) + lu(k,1611) = lu(k,1611) - lu(k,1459) * lu(k,1600) + lu(k,1612) = lu(k,1612) - lu(k,1460) * lu(k,1600) + lu(k,1614) = lu(k,1614) - lu(k,1461) * lu(k,1600) + lu(k,1615) = lu(k,1615) - lu(k,1462) * lu(k,1600) + lu(k,1617) = lu(k,1617) - lu(k,1463) * lu(k,1600) + lu(k,1618) = lu(k,1618) - lu(k,1464) * lu(k,1600) + lu(k,1699) = lu(k,1699) - lu(k,1456) * lu(k,1696) + lu(k,1703) = lu(k,1703) - lu(k,1457) * lu(k,1696) + lu(k,1704) = lu(k,1704) - lu(k,1458) * lu(k,1696) + lu(k,1707) = lu(k,1707) - lu(k,1459) * lu(k,1696) + lu(k,1708) = lu(k,1708) - lu(k,1460) * lu(k,1696) + lu(k,1710) = lu(k,1710) - lu(k,1461) * lu(k,1696) + lu(k,1711) = lu(k,1711) - lu(k,1462) * lu(k,1696) + lu(k,1713) = lu(k,1713) - lu(k,1463) * lu(k,1696) + lu(k,1714) = lu(k,1714) - lu(k,1464) * lu(k,1696) + lu(k,1740) = lu(k,1740) - lu(k,1456) * lu(k,1737) + lu(k,1744) = lu(k,1744) - lu(k,1457) * lu(k,1737) + lu(k,1745) = lu(k,1745) - lu(k,1458) * lu(k,1737) + lu(k,1748) = lu(k,1748) - lu(k,1459) * lu(k,1737) + lu(k,1749) = lu(k,1749) - lu(k,1460) * lu(k,1737) + lu(k,1751) = lu(k,1751) - lu(k,1461) * lu(k,1737) + lu(k,1752) = lu(k,1752) - lu(k,1462) * lu(k,1737) + lu(k,1754) = lu(k,1754) - lu(k,1463) * lu(k,1737) + lu(k,1755) = lu(k,1755) - lu(k,1464) * lu(k,1737) + lu(k,1912) = lu(k,1912) - lu(k,1456) * lu(k,1909) + lu(k,1916) = lu(k,1916) - lu(k,1457) * lu(k,1909) + lu(k,1917) = lu(k,1917) - lu(k,1458) * lu(k,1909) + lu(k,1920) = lu(k,1920) - lu(k,1459) * lu(k,1909) + lu(k,1921) = lu(k,1921) - lu(k,1460) * lu(k,1909) + lu(k,1923) = lu(k,1923) - lu(k,1461) * lu(k,1909) + lu(k,1924) = lu(k,1924) - lu(k,1462) * lu(k,1909) + lu(k,1926) = lu(k,1926) - lu(k,1463) * lu(k,1909) + lu(k,1927) = lu(k,1927) - lu(k,1464) * lu(k,1909) + lu(k,1938) = lu(k,1938) - lu(k,1456) * lu(k,1936) + lu(k,1942) = - lu(k,1457) * lu(k,1936) + lu(k,1943) = lu(k,1943) - lu(k,1458) * lu(k,1936) + lu(k,1946) = lu(k,1946) - lu(k,1459) * lu(k,1936) + lu(k,1947) = lu(k,1947) - lu(k,1460) * lu(k,1936) + lu(k,1949) = lu(k,1949) - lu(k,1461) * lu(k,1936) + lu(k,1950) = lu(k,1950) - lu(k,1462) * lu(k,1936) + lu(k,1952) = lu(k,1952) - lu(k,1463) * lu(k,1936) + lu(k,1953) = lu(k,1953) - lu(k,1464) * lu(k,1936) + lu(k,1961) = lu(k,1961) - lu(k,1456) * lu(k,1959) + lu(k,1964) = lu(k,1964) - lu(k,1457) * lu(k,1959) + lu(k,1965) = lu(k,1965) - lu(k,1458) * lu(k,1959) + lu(k,1968) = lu(k,1968) - lu(k,1459) * lu(k,1959) + lu(k,1969) = - lu(k,1460) * lu(k,1959) + lu(k,1971) = lu(k,1971) - lu(k,1461) * lu(k,1959) + lu(k,1972) = - lu(k,1462) * lu(k,1959) + lu(k,1974) = - lu(k,1463) * lu(k,1959) + lu(k,1975) = lu(k,1975) - lu(k,1464) * lu(k,1959) + lu(k,1991) = lu(k,1991) - lu(k,1456) * lu(k,1988) + lu(k,1995) = lu(k,1995) - lu(k,1457) * lu(k,1988) + lu(k,1996) = lu(k,1996) - lu(k,1458) * lu(k,1988) + lu(k,1999) = lu(k,1999) - lu(k,1459) * lu(k,1988) + lu(k,2000) = lu(k,2000) - lu(k,1460) * lu(k,1988) + lu(k,2002) = lu(k,2002) - lu(k,1461) * lu(k,1988) + lu(k,2003) = lu(k,2003) - lu(k,1462) * lu(k,1988) + lu(k,2005) = lu(k,2005) - lu(k,1463) * lu(k,1988) + lu(k,2006) = lu(k,2006) - lu(k,1464) * lu(k,1988) + lu(k,2015) = lu(k,2015) - lu(k,1456) * lu(k,2012) + lu(k,2019) = lu(k,2019) - lu(k,1457) * lu(k,2012) + lu(k,2020) = lu(k,2020) - lu(k,1458) * lu(k,2012) + lu(k,2023) = lu(k,2023) - lu(k,1459) * lu(k,2012) + lu(k,2024) = lu(k,2024) - lu(k,1460) * lu(k,2012) + lu(k,2026) = lu(k,2026) - lu(k,1461) * lu(k,2012) + lu(k,2027) = lu(k,2027) - lu(k,1462) * lu(k,2012) + lu(k,2029) = - lu(k,1463) * lu(k,2012) + lu(k,2030) = lu(k,2030) - lu(k,1464) * lu(k,2012) + lu(k,2072) = lu(k,2072) - lu(k,1456) * lu(k,2069) + lu(k,2076) = - lu(k,1457) * lu(k,2069) + lu(k,2077) = lu(k,2077) - lu(k,1458) * lu(k,2069) + lu(k,2080) = lu(k,2080) - lu(k,1459) * lu(k,2069) + lu(k,2081) = lu(k,2081) - lu(k,1460) * lu(k,2069) + lu(k,2083) = lu(k,2083) - lu(k,1461) * lu(k,2069) + lu(k,2084) = lu(k,2084) - lu(k,1462) * lu(k,2069) + lu(k,2086) = lu(k,2086) - lu(k,1463) * lu(k,2069) + lu(k,2087) = lu(k,2087) - lu(k,1464) * lu(k,2069) + lu(k,2096) = lu(k,2096) - lu(k,1456) * lu(k,2094) + lu(k,2100) = - lu(k,1457) * lu(k,2094) + lu(k,2101) = lu(k,2101) - lu(k,1458) * lu(k,2094) + lu(k,2104) = lu(k,2104) - lu(k,1459) * lu(k,2094) + lu(k,2105) = - lu(k,1460) * lu(k,2094) + lu(k,2107) = lu(k,2107) - lu(k,1461) * lu(k,2094) + lu(k,2108) = lu(k,2108) - lu(k,1462) * lu(k,2094) + lu(k,2110) = lu(k,2110) - lu(k,1463) * lu(k,2094) + lu(k,2111) = lu(k,2111) - lu(k,1464) * lu(k,2094) + lu(k,2215) = lu(k,2215) - lu(k,1456) * lu(k,2212) + lu(k,2219) = lu(k,2219) - lu(k,1457) * lu(k,2212) + lu(k,2220) = lu(k,2220) - lu(k,1458) * lu(k,2212) + lu(k,2223) = lu(k,2223) - lu(k,1459) * lu(k,2212) + lu(k,2224) = lu(k,2224) - lu(k,1460) * lu(k,2212) + lu(k,2226) = lu(k,2226) - lu(k,1461) * lu(k,2212) + lu(k,2227) = lu(k,2227) - lu(k,1462) * lu(k,2212) + lu(k,2229) = lu(k,2229) - lu(k,1463) * lu(k,2212) + lu(k,2230) = lu(k,2230) - lu(k,1464) * lu(k,2212) + lu(k,2254) = lu(k,2254) - lu(k,1456) * lu(k,2251) + lu(k,2258) = lu(k,2258) - lu(k,1457) * lu(k,2251) + lu(k,2259) = lu(k,2259) - lu(k,1458) * lu(k,2251) + lu(k,2262) = lu(k,2262) - lu(k,1459) * lu(k,2251) + lu(k,2263) = lu(k,2263) - lu(k,1460) * lu(k,2251) + lu(k,2265) = - lu(k,1461) * lu(k,2251) + lu(k,2266) = lu(k,2266) - lu(k,1462) * lu(k,2251) + lu(k,2268) = lu(k,2268) - lu(k,1463) * lu(k,2251) + lu(k,2269) = lu(k,2269) - lu(k,1464) * lu(k,2251) + lu(k,2315) = lu(k,2315) - lu(k,1456) * lu(k,2312) + lu(k,2319) = lu(k,2319) - lu(k,1457) * lu(k,2312) + lu(k,2320) = lu(k,2320) - lu(k,1458) * lu(k,2312) + lu(k,2323) = lu(k,2323) - lu(k,1459) * lu(k,2312) + lu(k,2324) = lu(k,2324) - lu(k,1460) * lu(k,2312) + lu(k,2326) = lu(k,2326) - lu(k,1461) * lu(k,2312) + lu(k,2327) = lu(k,2327) - lu(k,1462) * lu(k,2312) + lu(k,2329) = lu(k,2329) - lu(k,1463) * lu(k,2312) + lu(k,2330) = lu(k,2330) - lu(k,1464) * lu(k,2312) + lu(k,2341) = lu(k,2341) - lu(k,1456) * lu(k,2338) + lu(k,2345) = lu(k,2345) - lu(k,1457) * lu(k,2338) + lu(k,2346) = lu(k,2346) - lu(k,1458) * lu(k,2338) + lu(k,2349) = lu(k,2349) - lu(k,1459) * lu(k,2338) + lu(k,2350) = - lu(k,1460) * lu(k,2338) + lu(k,2352) = lu(k,2352) - lu(k,1461) * lu(k,2338) + lu(k,2353) = lu(k,2353) - lu(k,1462) * lu(k,2338) + lu(k,2355) = lu(k,2355) - lu(k,1463) * lu(k,2338) + lu(k,2356) = lu(k,2356) - lu(k,1464) * lu(k,2338) + lu(k,1470) = 1._r8 / lu(k,1470) + lu(k,1471) = lu(k,1471) * lu(k,1470) + lu(k,1472) = lu(k,1472) * lu(k,1470) + lu(k,1473) = lu(k,1473) * lu(k,1470) + lu(k,1474) = lu(k,1474) * lu(k,1470) + lu(k,1475) = lu(k,1475) * lu(k,1470) + lu(k,1476) = lu(k,1476) * lu(k,1470) + lu(k,1477) = lu(k,1477) * lu(k,1470) + lu(k,1478) = lu(k,1478) * lu(k,1470) + lu(k,1479) = lu(k,1479) * lu(k,1470) + lu(k,1480) = lu(k,1480) * lu(k,1470) + lu(k,1481) = lu(k,1481) * lu(k,1470) + lu(k,1482) = lu(k,1482) * lu(k,1470) + lu(k,1487) = lu(k,1487) - lu(k,1471) * lu(k,1486) + lu(k,1488) = lu(k,1488) - lu(k,1472) * lu(k,1486) + lu(k,1489) = lu(k,1489) - lu(k,1473) * lu(k,1486) + lu(k,1491) = lu(k,1491) - lu(k,1474) * lu(k,1486) + lu(k,1492) = lu(k,1492) - lu(k,1475) * lu(k,1486) + lu(k,1493) = lu(k,1493) - lu(k,1476) * lu(k,1486) + lu(k,1494) = lu(k,1494) - lu(k,1477) * lu(k,1486) + lu(k,1495) = - lu(k,1478) * lu(k,1486) + lu(k,1496) = lu(k,1496) - lu(k,1479) * lu(k,1486) + lu(k,1497) = - lu(k,1480) * lu(k,1486) + lu(k,1498) = lu(k,1498) - lu(k,1481) * lu(k,1486) + lu(k,1499) = lu(k,1499) - lu(k,1482) * lu(k,1486) + lu(k,1502) = lu(k,1502) - lu(k,1471) * lu(k,1501) + lu(k,1503) = lu(k,1503) - lu(k,1472) * lu(k,1501) + lu(k,1504) = lu(k,1504) - lu(k,1473) * lu(k,1501) + lu(k,1506) = lu(k,1506) - lu(k,1474) * lu(k,1501) + lu(k,1507) = lu(k,1507) - lu(k,1475) * lu(k,1501) + lu(k,1508) = lu(k,1508) - lu(k,1476) * lu(k,1501) + lu(k,1509) = lu(k,1509) - lu(k,1477) * lu(k,1501) + lu(k,1510) = - lu(k,1478) * lu(k,1501) + lu(k,1511) = lu(k,1511) - lu(k,1479) * lu(k,1501) + lu(k,1512) = lu(k,1512) - lu(k,1480) * lu(k,1501) + lu(k,1513) = lu(k,1513) - lu(k,1481) * lu(k,1501) + lu(k,1515) = lu(k,1515) - lu(k,1482) * lu(k,1501) + lu(k,1602) = lu(k,1602) - lu(k,1471) * lu(k,1601) + lu(k,1603) = lu(k,1603) - lu(k,1472) * lu(k,1601) + lu(k,1605) = lu(k,1605) - lu(k,1473) * lu(k,1601) + lu(k,1607) = lu(k,1607) - lu(k,1474) * lu(k,1601) + lu(k,1608) = lu(k,1608) - lu(k,1475) * lu(k,1601) + lu(k,1610) = - lu(k,1476) * lu(k,1601) + lu(k,1611) = lu(k,1611) - lu(k,1477) * lu(k,1601) + lu(k,1612) = lu(k,1612) - lu(k,1478) * lu(k,1601) + lu(k,1613) = lu(k,1613) - lu(k,1479) * lu(k,1601) + lu(k,1615) = lu(k,1615) - lu(k,1480) * lu(k,1601) + lu(k,1616) = lu(k,1616) - lu(k,1481) * lu(k,1601) + lu(k,1618) = lu(k,1618) - lu(k,1482) * lu(k,1601) + lu(k,1654) = lu(k,1654) - lu(k,1471) * lu(k,1653) + lu(k,1655) = lu(k,1655) - lu(k,1472) * lu(k,1653) + lu(k,1657) = lu(k,1657) - lu(k,1473) * lu(k,1653) + lu(k,1659) = - lu(k,1474) * lu(k,1653) + lu(k,1660) = lu(k,1660) - lu(k,1475) * lu(k,1653) + lu(k,1662) = - lu(k,1476) * lu(k,1653) + lu(k,1663) = lu(k,1663) - lu(k,1477) * lu(k,1653) + lu(k,1664) = lu(k,1664) - lu(k,1478) * lu(k,1653) + lu(k,1665) = lu(k,1665) - lu(k,1479) * lu(k,1653) + lu(k,1667) = lu(k,1667) - lu(k,1480) * lu(k,1653) + lu(k,1668) = lu(k,1668) - lu(k,1481) * lu(k,1653) + lu(k,1670) = lu(k,1670) - lu(k,1482) * lu(k,1653) + lu(k,1698) = lu(k,1698) - lu(k,1471) * lu(k,1697) + lu(k,1699) = lu(k,1699) - lu(k,1472) * lu(k,1697) + lu(k,1701) = lu(k,1701) - lu(k,1473) * lu(k,1697) + lu(k,1703) = lu(k,1703) - lu(k,1474) * lu(k,1697) + lu(k,1704) = lu(k,1704) - lu(k,1475) * lu(k,1697) + lu(k,1706) = lu(k,1706) - lu(k,1476) * lu(k,1697) + lu(k,1707) = lu(k,1707) - lu(k,1477) * lu(k,1697) + lu(k,1708) = lu(k,1708) - lu(k,1478) * lu(k,1697) + lu(k,1709) = lu(k,1709) - lu(k,1479) * lu(k,1697) + lu(k,1711) = lu(k,1711) - lu(k,1480) * lu(k,1697) + lu(k,1712) = lu(k,1712) - lu(k,1481) * lu(k,1697) + lu(k,1714) = lu(k,1714) - lu(k,1482) * lu(k,1697) + lu(k,1739) = lu(k,1739) - lu(k,1471) * lu(k,1738) + lu(k,1740) = lu(k,1740) - lu(k,1472) * lu(k,1738) + lu(k,1742) = lu(k,1742) - lu(k,1473) * lu(k,1738) + lu(k,1744) = lu(k,1744) - lu(k,1474) * lu(k,1738) + lu(k,1745) = lu(k,1745) - lu(k,1475) * lu(k,1738) + lu(k,1747) = lu(k,1747) - lu(k,1476) * lu(k,1738) + lu(k,1748) = lu(k,1748) - lu(k,1477) * lu(k,1738) + lu(k,1749) = lu(k,1749) - lu(k,1478) * lu(k,1738) + lu(k,1750) = lu(k,1750) - lu(k,1479) * lu(k,1738) + lu(k,1752) = lu(k,1752) - lu(k,1480) * lu(k,1738) + lu(k,1753) = lu(k,1753) - lu(k,1481) * lu(k,1738) + lu(k,1755) = lu(k,1755) - lu(k,1482) * lu(k,1738) + lu(k,1911) = lu(k,1911) - lu(k,1471) * lu(k,1910) + lu(k,1912) = lu(k,1912) - lu(k,1472) * lu(k,1910) + lu(k,1914) = lu(k,1914) - lu(k,1473) * lu(k,1910) + lu(k,1916) = lu(k,1916) - lu(k,1474) * lu(k,1910) + lu(k,1917) = lu(k,1917) - lu(k,1475) * lu(k,1910) + lu(k,1919) = lu(k,1919) - lu(k,1476) * lu(k,1910) + lu(k,1920) = lu(k,1920) - lu(k,1477) * lu(k,1910) + lu(k,1921) = lu(k,1921) - lu(k,1478) * lu(k,1910) + lu(k,1922) = lu(k,1922) - lu(k,1479) * lu(k,1910) + lu(k,1924) = lu(k,1924) - lu(k,1480) * lu(k,1910) + lu(k,1925) = lu(k,1925) - lu(k,1481) * lu(k,1910) + lu(k,1927) = lu(k,1927) - lu(k,1482) * lu(k,1910) + lu(k,1990) = lu(k,1990) - lu(k,1471) * lu(k,1989) + lu(k,1991) = lu(k,1991) - lu(k,1472) * lu(k,1989) + lu(k,1993) = lu(k,1993) - lu(k,1473) * lu(k,1989) + lu(k,1995) = lu(k,1995) - lu(k,1474) * lu(k,1989) + lu(k,1996) = lu(k,1996) - lu(k,1475) * lu(k,1989) + lu(k,1998) = lu(k,1998) - lu(k,1476) * lu(k,1989) + lu(k,1999) = lu(k,1999) - lu(k,1477) * lu(k,1989) + lu(k,2000) = lu(k,2000) - lu(k,1478) * lu(k,1989) + lu(k,2001) = lu(k,2001) - lu(k,1479) * lu(k,1989) + lu(k,2003) = lu(k,2003) - lu(k,1480) * lu(k,1989) + lu(k,2004) = lu(k,2004) - lu(k,1481) * lu(k,1989) + lu(k,2006) = lu(k,2006) - lu(k,1482) * lu(k,1989) + lu(k,2014) = lu(k,2014) - lu(k,1471) * lu(k,2013) + lu(k,2015) = lu(k,2015) - lu(k,1472) * lu(k,2013) + lu(k,2017) = lu(k,2017) - lu(k,1473) * lu(k,2013) + lu(k,2019) = lu(k,2019) - lu(k,1474) * lu(k,2013) + lu(k,2020) = lu(k,2020) - lu(k,1475) * lu(k,2013) + lu(k,2022) = lu(k,2022) - lu(k,1476) * lu(k,2013) + lu(k,2023) = lu(k,2023) - lu(k,1477) * lu(k,2013) + lu(k,2024) = lu(k,2024) - lu(k,1478) * lu(k,2013) + lu(k,2025) = lu(k,2025) - lu(k,1479) * lu(k,2013) + lu(k,2027) = lu(k,2027) - lu(k,1480) * lu(k,2013) + lu(k,2028) = lu(k,2028) - lu(k,1481) * lu(k,2013) + lu(k,2030) = lu(k,2030) - lu(k,1482) * lu(k,2013) + lu(k,2071) = lu(k,2071) - lu(k,1471) * lu(k,2070) + lu(k,2072) = lu(k,2072) - lu(k,1472) * lu(k,2070) + lu(k,2074) = lu(k,2074) - lu(k,1473) * lu(k,2070) + lu(k,2076) = lu(k,2076) - lu(k,1474) * lu(k,2070) + lu(k,2077) = lu(k,2077) - lu(k,1475) * lu(k,2070) + lu(k,2079) = - lu(k,1476) * lu(k,2070) + lu(k,2080) = lu(k,2080) - lu(k,1477) * lu(k,2070) + lu(k,2081) = lu(k,2081) - lu(k,1478) * lu(k,2070) + lu(k,2082) = lu(k,2082) - lu(k,1479) * lu(k,2070) + lu(k,2084) = lu(k,2084) - lu(k,1480) * lu(k,2070) + lu(k,2085) = lu(k,2085) - lu(k,1481) * lu(k,2070) + lu(k,2087) = lu(k,2087) - lu(k,1482) * lu(k,2070) + lu(k,2214) = lu(k,2214) - lu(k,1471) * lu(k,2213) + lu(k,2215) = lu(k,2215) - lu(k,1472) * lu(k,2213) + lu(k,2217) = lu(k,2217) - lu(k,1473) * lu(k,2213) + lu(k,2219) = lu(k,2219) - lu(k,1474) * lu(k,2213) + lu(k,2220) = lu(k,2220) - lu(k,1475) * lu(k,2213) + lu(k,2222) = lu(k,2222) - lu(k,1476) * lu(k,2213) + lu(k,2223) = lu(k,2223) - lu(k,1477) * lu(k,2213) + lu(k,2224) = lu(k,2224) - lu(k,1478) * lu(k,2213) + lu(k,2225) = lu(k,2225) - lu(k,1479) * lu(k,2213) + lu(k,2227) = lu(k,2227) - lu(k,1480) * lu(k,2213) + lu(k,2228) = lu(k,2228) - lu(k,1481) * lu(k,2213) + lu(k,2230) = lu(k,2230) - lu(k,1482) * lu(k,2213) + lu(k,2253) = lu(k,2253) - lu(k,1471) * lu(k,2252) + lu(k,2254) = lu(k,2254) - lu(k,1472) * lu(k,2252) + lu(k,2256) = lu(k,2256) - lu(k,1473) * lu(k,2252) + lu(k,2258) = lu(k,2258) - lu(k,1474) * lu(k,2252) + lu(k,2259) = lu(k,2259) - lu(k,1475) * lu(k,2252) + lu(k,2261) = lu(k,2261) - lu(k,1476) * lu(k,2252) + lu(k,2262) = lu(k,2262) - lu(k,1477) * lu(k,2252) + lu(k,2263) = lu(k,2263) - lu(k,1478) * lu(k,2252) + lu(k,2264) = lu(k,2264) - lu(k,1479) * lu(k,2252) + lu(k,2266) = lu(k,2266) - lu(k,1480) * lu(k,2252) + lu(k,2267) = lu(k,2267) - lu(k,1481) * lu(k,2252) + lu(k,2269) = lu(k,2269) - lu(k,1482) * lu(k,2252) + lu(k,2314) = lu(k,2314) - lu(k,1471) * lu(k,2313) + lu(k,2315) = lu(k,2315) - lu(k,1472) * lu(k,2313) + lu(k,2317) = lu(k,2317) - lu(k,1473) * lu(k,2313) + lu(k,2319) = lu(k,2319) - lu(k,1474) * lu(k,2313) + lu(k,2320) = lu(k,2320) - lu(k,1475) * lu(k,2313) + lu(k,2322) = - lu(k,1476) * lu(k,2313) + lu(k,2323) = lu(k,2323) - lu(k,1477) * lu(k,2313) + lu(k,2324) = lu(k,2324) - lu(k,1478) * lu(k,2313) + lu(k,2325) = lu(k,2325) - lu(k,1479) * lu(k,2313) + lu(k,2327) = lu(k,2327) - lu(k,1480) * lu(k,2313) + lu(k,2328) = lu(k,2328) - lu(k,1481) * lu(k,2313) + lu(k,2330) = lu(k,2330) - lu(k,1482) * lu(k,2313) + lu(k,2340) = lu(k,2340) - lu(k,1471) * lu(k,2339) + lu(k,2341) = lu(k,2341) - lu(k,1472) * lu(k,2339) + lu(k,2343) = lu(k,2343) - lu(k,1473) * lu(k,2339) + lu(k,2345) = lu(k,2345) - lu(k,1474) * lu(k,2339) + lu(k,2346) = lu(k,2346) - lu(k,1475) * lu(k,2339) + lu(k,2348) = lu(k,2348) - lu(k,1476) * lu(k,2339) + lu(k,2349) = lu(k,2349) - lu(k,1477) * lu(k,2339) + lu(k,2350) = lu(k,2350) - lu(k,1478) * lu(k,2339) + lu(k,2351) = lu(k,2351) - lu(k,1479) * lu(k,2339) + lu(k,2353) = lu(k,2353) - lu(k,1480) * lu(k,2339) + lu(k,2354) = lu(k,2354) - lu(k,1481) * lu(k,2339) + lu(k,2356) = lu(k,2356) - lu(k,1482) * lu(k,2339) + lu(k,1487) = 1._r8 / lu(k,1487) + lu(k,1488) = lu(k,1488) * lu(k,1487) + lu(k,1489) = lu(k,1489) * lu(k,1487) + lu(k,1490) = lu(k,1490) * lu(k,1487) + lu(k,1491) = lu(k,1491) * lu(k,1487) + lu(k,1492) = lu(k,1492) * lu(k,1487) + lu(k,1493) = lu(k,1493) * lu(k,1487) + lu(k,1494) = lu(k,1494) * lu(k,1487) + lu(k,1495) = lu(k,1495) * lu(k,1487) + lu(k,1496) = lu(k,1496) * lu(k,1487) + lu(k,1497) = lu(k,1497) * lu(k,1487) + lu(k,1498) = lu(k,1498) * lu(k,1487) + lu(k,1499) = lu(k,1499) * lu(k,1487) + lu(k,1503) = lu(k,1503) - lu(k,1488) * lu(k,1502) + lu(k,1504) = lu(k,1504) - lu(k,1489) * lu(k,1502) + lu(k,1505) = - lu(k,1490) * lu(k,1502) + lu(k,1506) = lu(k,1506) - lu(k,1491) * lu(k,1502) + lu(k,1507) = lu(k,1507) - lu(k,1492) * lu(k,1502) + lu(k,1508) = lu(k,1508) - lu(k,1493) * lu(k,1502) + lu(k,1509) = lu(k,1509) - lu(k,1494) * lu(k,1502) + lu(k,1510) = lu(k,1510) - lu(k,1495) * lu(k,1502) + lu(k,1511) = lu(k,1511) - lu(k,1496) * lu(k,1502) + lu(k,1512) = lu(k,1512) - lu(k,1497) * lu(k,1502) + lu(k,1513) = lu(k,1513) - lu(k,1498) * lu(k,1502) + lu(k,1515) = lu(k,1515) - lu(k,1499) * lu(k,1502) + lu(k,1603) = lu(k,1603) - lu(k,1488) * lu(k,1602) + lu(k,1605) = lu(k,1605) - lu(k,1489) * lu(k,1602) + lu(k,1606) = lu(k,1606) - lu(k,1490) * lu(k,1602) + lu(k,1607) = lu(k,1607) - lu(k,1491) * lu(k,1602) + lu(k,1608) = lu(k,1608) - lu(k,1492) * lu(k,1602) + lu(k,1610) = lu(k,1610) - lu(k,1493) * lu(k,1602) + lu(k,1611) = lu(k,1611) - lu(k,1494) * lu(k,1602) + lu(k,1612) = lu(k,1612) - lu(k,1495) * lu(k,1602) + lu(k,1613) = lu(k,1613) - lu(k,1496) * lu(k,1602) + lu(k,1615) = lu(k,1615) - lu(k,1497) * lu(k,1602) + lu(k,1616) = lu(k,1616) - lu(k,1498) * lu(k,1602) + lu(k,1618) = lu(k,1618) - lu(k,1499) * lu(k,1602) + lu(k,1655) = lu(k,1655) - lu(k,1488) * lu(k,1654) + lu(k,1657) = lu(k,1657) - lu(k,1489) * lu(k,1654) + lu(k,1658) = lu(k,1658) - lu(k,1490) * lu(k,1654) + lu(k,1659) = lu(k,1659) - lu(k,1491) * lu(k,1654) + lu(k,1660) = lu(k,1660) - lu(k,1492) * lu(k,1654) + lu(k,1662) = lu(k,1662) - lu(k,1493) * lu(k,1654) + lu(k,1663) = lu(k,1663) - lu(k,1494) * lu(k,1654) + lu(k,1664) = lu(k,1664) - lu(k,1495) * lu(k,1654) + lu(k,1665) = lu(k,1665) - lu(k,1496) * lu(k,1654) + lu(k,1667) = lu(k,1667) - lu(k,1497) * lu(k,1654) + lu(k,1668) = lu(k,1668) - lu(k,1498) * lu(k,1654) + lu(k,1670) = lu(k,1670) - lu(k,1499) * lu(k,1654) + lu(k,1699) = lu(k,1699) - lu(k,1488) * lu(k,1698) + lu(k,1701) = lu(k,1701) - lu(k,1489) * lu(k,1698) + lu(k,1702) = lu(k,1702) - lu(k,1490) * lu(k,1698) + lu(k,1703) = lu(k,1703) - lu(k,1491) * lu(k,1698) + lu(k,1704) = lu(k,1704) - lu(k,1492) * lu(k,1698) + lu(k,1706) = lu(k,1706) - lu(k,1493) * lu(k,1698) + lu(k,1707) = lu(k,1707) - lu(k,1494) * lu(k,1698) + lu(k,1708) = lu(k,1708) - lu(k,1495) * lu(k,1698) + lu(k,1709) = lu(k,1709) - lu(k,1496) * lu(k,1698) + lu(k,1711) = lu(k,1711) - lu(k,1497) * lu(k,1698) + lu(k,1712) = lu(k,1712) - lu(k,1498) * lu(k,1698) + lu(k,1714) = lu(k,1714) - lu(k,1499) * lu(k,1698) + lu(k,1740) = lu(k,1740) - lu(k,1488) * lu(k,1739) + lu(k,1742) = lu(k,1742) - lu(k,1489) * lu(k,1739) + lu(k,1743) = - lu(k,1490) * lu(k,1739) + lu(k,1744) = lu(k,1744) - lu(k,1491) * lu(k,1739) + lu(k,1745) = lu(k,1745) - lu(k,1492) * lu(k,1739) + lu(k,1747) = lu(k,1747) - lu(k,1493) * lu(k,1739) + lu(k,1748) = lu(k,1748) - lu(k,1494) * lu(k,1739) + lu(k,1749) = lu(k,1749) - lu(k,1495) * lu(k,1739) + lu(k,1750) = lu(k,1750) - lu(k,1496) * lu(k,1739) + lu(k,1752) = lu(k,1752) - lu(k,1497) * lu(k,1739) + lu(k,1753) = lu(k,1753) - lu(k,1498) * lu(k,1739) + lu(k,1755) = lu(k,1755) - lu(k,1499) * lu(k,1739) + lu(k,1912) = lu(k,1912) - lu(k,1488) * lu(k,1911) + lu(k,1914) = lu(k,1914) - lu(k,1489) * lu(k,1911) + lu(k,1915) = lu(k,1915) - lu(k,1490) * lu(k,1911) + lu(k,1916) = lu(k,1916) - lu(k,1491) * lu(k,1911) + lu(k,1917) = lu(k,1917) - lu(k,1492) * lu(k,1911) + lu(k,1919) = lu(k,1919) - lu(k,1493) * lu(k,1911) + lu(k,1920) = lu(k,1920) - lu(k,1494) * lu(k,1911) + lu(k,1921) = lu(k,1921) - lu(k,1495) * lu(k,1911) + lu(k,1922) = lu(k,1922) - lu(k,1496) * lu(k,1911) + lu(k,1924) = lu(k,1924) - lu(k,1497) * lu(k,1911) + lu(k,1925) = lu(k,1925) - lu(k,1498) * lu(k,1911) + lu(k,1927) = lu(k,1927) - lu(k,1499) * lu(k,1911) + lu(k,1938) = lu(k,1938) - lu(k,1488) * lu(k,1937) + lu(k,1940) = lu(k,1940) - lu(k,1489) * lu(k,1937) + lu(k,1941) = lu(k,1941) - lu(k,1490) * lu(k,1937) + lu(k,1942) = lu(k,1942) - lu(k,1491) * lu(k,1937) + lu(k,1943) = lu(k,1943) - lu(k,1492) * lu(k,1937) + lu(k,1945) = lu(k,1945) - lu(k,1493) * lu(k,1937) + lu(k,1946) = lu(k,1946) - lu(k,1494) * lu(k,1937) + lu(k,1947) = lu(k,1947) - lu(k,1495) * lu(k,1937) + lu(k,1948) = lu(k,1948) - lu(k,1496) * lu(k,1937) + lu(k,1950) = lu(k,1950) - lu(k,1497) * lu(k,1937) + lu(k,1951) = lu(k,1951) - lu(k,1498) * lu(k,1937) + lu(k,1953) = lu(k,1953) - lu(k,1499) * lu(k,1937) + lu(k,1961) = lu(k,1961) - lu(k,1488) * lu(k,1960) + lu(k,1962) = - lu(k,1489) * lu(k,1960) + lu(k,1963) = lu(k,1963) - lu(k,1490) * lu(k,1960) + lu(k,1964) = lu(k,1964) - lu(k,1491) * lu(k,1960) + lu(k,1965) = lu(k,1965) - lu(k,1492) * lu(k,1960) + lu(k,1967) = lu(k,1967) - lu(k,1493) * lu(k,1960) + lu(k,1968) = lu(k,1968) - lu(k,1494) * lu(k,1960) + lu(k,1969) = lu(k,1969) - lu(k,1495) * lu(k,1960) + lu(k,1970) = lu(k,1970) - lu(k,1496) * lu(k,1960) + lu(k,1972) = lu(k,1972) - lu(k,1497) * lu(k,1960) + lu(k,1973) = lu(k,1973) - lu(k,1498) * lu(k,1960) + lu(k,1975) = lu(k,1975) - lu(k,1499) * lu(k,1960) + lu(k,1991) = lu(k,1991) - lu(k,1488) * lu(k,1990) + lu(k,1993) = lu(k,1993) - lu(k,1489) * lu(k,1990) + lu(k,1994) = lu(k,1994) - lu(k,1490) * lu(k,1990) + lu(k,1995) = lu(k,1995) - lu(k,1491) * lu(k,1990) + lu(k,1996) = lu(k,1996) - lu(k,1492) * lu(k,1990) + lu(k,1998) = lu(k,1998) - lu(k,1493) * lu(k,1990) + lu(k,1999) = lu(k,1999) - lu(k,1494) * lu(k,1990) + lu(k,2000) = lu(k,2000) - lu(k,1495) * lu(k,1990) + lu(k,2001) = lu(k,2001) - lu(k,1496) * lu(k,1990) + lu(k,2003) = lu(k,2003) - lu(k,1497) * lu(k,1990) + lu(k,2004) = lu(k,2004) - lu(k,1498) * lu(k,1990) + lu(k,2006) = lu(k,2006) - lu(k,1499) * lu(k,1990) + lu(k,2015) = lu(k,2015) - lu(k,1488) * lu(k,2014) + lu(k,2017) = lu(k,2017) - lu(k,1489) * lu(k,2014) + lu(k,2018) = lu(k,2018) - lu(k,1490) * lu(k,2014) + lu(k,2019) = lu(k,2019) - lu(k,1491) * lu(k,2014) + lu(k,2020) = lu(k,2020) - lu(k,1492) * lu(k,2014) + lu(k,2022) = lu(k,2022) - lu(k,1493) * lu(k,2014) + lu(k,2023) = lu(k,2023) - lu(k,1494) * lu(k,2014) + lu(k,2024) = lu(k,2024) - lu(k,1495) * lu(k,2014) + lu(k,2025) = lu(k,2025) - lu(k,1496) * lu(k,2014) + lu(k,2027) = lu(k,2027) - lu(k,1497) * lu(k,2014) + lu(k,2028) = lu(k,2028) - lu(k,1498) * lu(k,2014) + lu(k,2030) = lu(k,2030) - lu(k,1499) * lu(k,2014) + lu(k,2072) = lu(k,2072) - lu(k,1488) * lu(k,2071) + lu(k,2074) = lu(k,2074) - lu(k,1489) * lu(k,2071) + lu(k,2075) = lu(k,2075) - lu(k,1490) * lu(k,2071) + lu(k,2076) = lu(k,2076) - lu(k,1491) * lu(k,2071) + lu(k,2077) = lu(k,2077) - lu(k,1492) * lu(k,2071) + lu(k,2079) = lu(k,2079) - lu(k,1493) * lu(k,2071) + lu(k,2080) = lu(k,2080) - lu(k,1494) * lu(k,2071) + lu(k,2081) = lu(k,2081) - lu(k,1495) * lu(k,2071) + lu(k,2082) = lu(k,2082) - lu(k,1496) * lu(k,2071) + lu(k,2084) = lu(k,2084) - lu(k,1497) * lu(k,2071) + lu(k,2085) = lu(k,2085) - lu(k,1498) * lu(k,2071) + lu(k,2087) = lu(k,2087) - lu(k,1499) * lu(k,2071) + lu(k,2096) = lu(k,2096) - lu(k,1488) * lu(k,2095) + lu(k,2098) = - lu(k,1489) * lu(k,2095) + lu(k,2099) = lu(k,2099) - lu(k,1490) * lu(k,2095) + lu(k,2100) = lu(k,2100) - lu(k,1491) * lu(k,2095) + lu(k,2101) = lu(k,2101) - lu(k,1492) * lu(k,2095) + lu(k,2103) = lu(k,2103) - lu(k,1493) * lu(k,2095) + lu(k,2104) = lu(k,2104) - lu(k,1494) * lu(k,2095) + lu(k,2105) = lu(k,2105) - lu(k,1495) * lu(k,2095) + lu(k,2106) = lu(k,2106) - lu(k,1496) * lu(k,2095) + lu(k,2108) = lu(k,2108) - lu(k,1497) * lu(k,2095) + lu(k,2109) = lu(k,2109) - lu(k,1498) * lu(k,2095) + lu(k,2111) = lu(k,2111) - lu(k,1499) * lu(k,2095) + lu(k,2215) = lu(k,2215) - lu(k,1488) * lu(k,2214) + lu(k,2217) = lu(k,2217) - lu(k,1489) * lu(k,2214) + lu(k,2218) = lu(k,2218) - lu(k,1490) * lu(k,2214) + lu(k,2219) = lu(k,2219) - lu(k,1491) * lu(k,2214) + lu(k,2220) = lu(k,2220) - lu(k,1492) * lu(k,2214) + lu(k,2222) = lu(k,2222) - lu(k,1493) * lu(k,2214) + lu(k,2223) = lu(k,2223) - lu(k,1494) * lu(k,2214) + lu(k,2224) = lu(k,2224) - lu(k,1495) * lu(k,2214) + lu(k,2225) = lu(k,2225) - lu(k,1496) * lu(k,2214) + lu(k,2227) = lu(k,2227) - lu(k,1497) * lu(k,2214) + lu(k,2228) = lu(k,2228) - lu(k,1498) * lu(k,2214) + lu(k,2230) = lu(k,2230) - lu(k,1499) * lu(k,2214) + lu(k,2254) = lu(k,2254) - lu(k,1488) * lu(k,2253) + lu(k,2256) = lu(k,2256) - lu(k,1489) * lu(k,2253) + lu(k,2257) = lu(k,2257) - lu(k,1490) * lu(k,2253) + lu(k,2258) = lu(k,2258) - lu(k,1491) * lu(k,2253) + lu(k,2259) = lu(k,2259) - lu(k,1492) * lu(k,2253) + lu(k,2261) = lu(k,2261) - lu(k,1493) * lu(k,2253) + lu(k,2262) = lu(k,2262) - lu(k,1494) * lu(k,2253) + lu(k,2263) = lu(k,2263) - lu(k,1495) * lu(k,2253) + lu(k,2264) = lu(k,2264) - lu(k,1496) * lu(k,2253) + lu(k,2266) = lu(k,2266) - lu(k,1497) * lu(k,2253) + lu(k,2267) = lu(k,2267) - lu(k,1498) * lu(k,2253) + lu(k,2269) = lu(k,2269) - lu(k,1499) * lu(k,2253) + lu(k,2315) = lu(k,2315) - lu(k,1488) * lu(k,2314) + lu(k,2317) = lu(k,2317) - lu(k,1489) * lu(k,2314) + lu(k,2318) = lu(k,2318) - lu(k,1490) * lu(k,2314) + lu(k,2319) = lu(k,2319) - lu(k,1491) * lu(k,2314) + lu(k,2320) = lu(k,2320) - lu(k,1492) * lu(k,2314) + lu(k,2322) = lu(k,2322) - lu(k,1493) * lu(k,2314) + lu(k,2323) = lu(k,2323) - lu(k,1494) * lu(k,2314) + lu(k,2324) = lu(k,2324) - lu(k,1495) * lu(k,2314) + lu(k,2325) = lu(k,2325) - lu(k,1496) * lu(k,2314) + lu(k,2327) = lu(k,2327) - lu(k,1497) * lu(k,2314) + lu(k,2328) = lu(k,2328) - lu(k,1498) * lu(k,2314) + lu(k,2330) = lu(k,2330) - lu(k,1499) * lu(k,2314) + lu(k,2341) = lu(k,2341) - lu(k,1488) * lu(k,2340) + lu(k,2343) = lu(k,2343) - lu(k,1489) * lu(k,2340) + lu(k,2344) = lu(k,2344) - lu(k,1490) * lu(k,2340) + lu(k,2345) = lu(k,2345) - lu(k,1491) * lu(k,2340) + lu(k,2346) = lu(k,2346) - lu(k,1492) * lu(k,2340) + lu(k,2348) = lu(k,2348) - lu(k,1493) * lu(k,2340) + lu(k,2349) = lu(k,2349) - lu(k,1494) * lu(k,2340) + lu(k,2350) = lu(k,2350) - lu(k,1495) * lu(k,2340) + lu(k,2351) = lu(k,2351) - lu(k,1496) * lu(k,2340) + lu(k,2353) = lu(k,2353) - lu(k,1497) * lu(k,2340) + lu(k,2354) = lu(k,2354) - lu(k,1498) * lu(k,2340) + lu(k,2356) = lu(k,2356) - lu(k,1499) * lu(k,2340) end do end subroutine lu_fac28 + subroutine lu_fac29( 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,1503) = 1._r8 / lu(k,1503) + lu(k,1504) = lu(k,1504) * lu(k,1503) + lu(k,1505) = lu(k,1505) * lu(k,1503) + lu(k,1506) = lu(k,1506) * lu(k,1503) + lu(k,1507) = lu(k,1507) * lu(k,1503) + lu(k,1508) = lu(k,1508) * lu(k,1503) + lu(k,1509) = lu(k,1509) * lu(k,1503) + lu(k,1510) = lu(k,1510) * lu(k,1503) + lu(k,1511) = lu(k,1511) * lu(k,1503) + lu(k,1512) = lu(k,1512) * lu(k,1503) + lu(k,1513) = lu(k,1513) * lu(k,1503) + lu(k,1514) = lu(k,1514) * lu(k,1503) + lu(k,1515) = lu(k,1515) * lu(k,1503) + lu(k,1605) = lu(k,1605) - lu(k,1504) * lu(k,1603) + lu(k,1606) = lu(k,1606) - lu(k,1505) * lu(k,1603) + lu(k,1607) = lu(k,1607) - lu(k,1506) * lu(k,1603) + lu(k,1608) = lu(k,1608) - lu(k,1507) * lu(k,1603) + lu(k,1610) = lu(k,1610) - lu(k,1508) * lu(k,1603) + lu(k,1611) = lu(k,1611) - lu(k,1509) * lu(k,1603) + lu(k,1612) = lu(k,1612) - lu(k,1510) * lu(k,1603) + lu(k,1613) = lu(k,1613) - lu(k,1511) * lu(k,1603) + lu(k,1615) = lu(k,1615) - lu(k,1512) * lu(k,1603) + lu(k,1616) = lu(k,1616) - lu(k,1513) * lu(k,1603) + lu(k,1617) = lu(k,1617) - lu(k,1514) * lu(k,1603) + lu(k,1618) = lu(k,1618) - lu(k,1515) * lu(k,1603) + lu(k,1657) = lu(k,1657) - lu(k,1504) * lu(k,1655) + lu(k,1658) = lu(k,1658) - lu(k,1505) * lu(k,1655) + lu(k,1659) = lu(k,1659) - lu(k,1506) * lu(k,1655) + lu(k,1660) = lu(k,1660) - lu(k,1507) * lu(k,1655) + lu(k,1662) = lu(k,1662) - lu(k,1508) * lu(k,1655) + lu(k,1663) = lu(k,1663) - lu(k,1509) * lu(k,1655) + lu(k,1664) = lu(k,1664) - lu(k,1510) * lu(k,1655) + lu(k,1665) = lu(k,1665) - lu(k,1511) * lu(k,1655) + lu(k,1667) = lu(k,1667) - lu(k,1512) * lu(k,1655) + lu(k,1668) = lu(k,1668) - lu(k,1513) * lu(k,1655) + lu(k,1669) = lu(k,1669) - lu(k,1514) * lu(k,1655) + lu(k,1670) = lu(k,1670) - lu(k,1515) * lu(k,1655) + lu(k,1701) = lu(k,1701) - lu(k,1504) * lu(k,1699) + lu(k,1702) = lu(k,1702) - lu(k,1505) * lu(k,1699) + lu(k,1703) = lu(k,1703) - lu(k,1506) * lu(k,1699) + lu(k,1704) = lu(k,1704) - lu(k,1507) * lu(k,1699) + lu(k,1706) = lu(k,1706) - lu(k,1508) * lu(k,1699) + lu(k,1707) = lu(k,1707) - lu(k,1509) * lu(k,1699) + lu(k,1708) = lu(k,1708) - lu(k,1510) * lu(k,1699) + lu(k,1709) = lu(k,1709) - lu(k,1511) * lu(k,1699) + lu(k,1711) = lu(k,1711) - lu(k,1512) * lu(k,1699) + lu(k,1712) = lu(k,1712) - lu(k,1513) * lu(k,1699) + lu(k,1713) = lu(k,1713) - lu(k,1514) * lu(k,1699) + lu(k,1714) = lu(k,1714) - lu(k,1515) * lu(k,1699) + lu(k,1742) = lu(k,1742) - lu(k,1504) * lu(k,1740) + lu(k,1743) = lu(k,1743) - lu(k,1505) * lu(k,1740) + lu(k,1744) = lu(k,1744) - lu(k,1506) * lu(k,1740) + lu(k,1745) = lu(k,1745) - lu(k,1507) * lu(k,1740) + lu(k,1747) = lu(k,1747) - lu(k,1508) * lu(k,1740) + lu(k,1748) = lu(k,1748) - lu(k,1509) * lu(k,1740) + lu(k,1749) = lu(k,1749) - lu(k,1510) * lu(k,1740) + lu(k,1750) = lu(k,1750) - lu(k,1511) * lu(k,1740) + lu(k,1752) = lu(k,1752) - lu(k,1512) * lu(k,1740) + lu(k,1753) = lu(k,1753) - lu(k,1513) * lu(k,1740) + lu(k,1754) = lu(k,1754) - lu(k,1514) * lu(k,1740) + lu(k,1755) = lu(k,1755) - lu(k,1515) * lu(k,1740) + lu(k,1914) = lu(k,1914) - lu(k,1504) * lu(k,1912) + lu(k,1915) = lu(k,1915) - lu(k,1505) * lu(k,1912) + lu(k,1916) = lu(k,1916) - lu(k,1506) * lu(k,1912) + lu(k,1917) = lu(k,1917) - lu(k,1507) * lu(k,1912) + lu(k,1919) = lu(k,1919) - lu(k,1508) * lu(k,1912) + lu(k,1920) = lu(k,1920) - lu(k,1509) * lu(k,1912) + lu(k,1921) = lu(k,1921) - lu(k,1510) * lu(k,1912) + lu(k,1922) = lu(k,1922) - lu(k,1511) * lu(k,1912) + lu(k,1924) = lu(k,1924) - lu(k,1512) * lu(k,1912) + lu(k,1925) = lu(k,1925) - lu(k,1513) * lu(k,1912) + lu(k,1926) = lu(k,1926) - lu(k,1514) * lu(k,1912) + lu(k,1927) = lu(k,1927) - lu(k,1515) * lu(k,1912) + lu(k,1940) = lu(k,1940) - lu(k,1504) * lu(k,1938) + lu(k,1941) = lu(k,1941) - lu(k,1505) * lu(k,1938) + lu(k,1942) = lu(k,1942) - lu(k,1506) * lu(k,1938) + lu(k,1943) = lu(k,1943) - lu(k,1507) * lu(k,1938) + lu(k,1945) = lu(k,1945) - lu(k,1508) * lu(k,1938) + lu(k,1946) = lu(k,1946) - lu(k,1509) * lu(k,1938) + lu(k,1947) = lu(k,1947) - lu(k,1510) * lu(k,1938) + lu(k,1948) = lu(k,1948) - lu(k,1511) * lu(k,1938) + lu(k,1950) = lu(k,1950) - lu(k,1512) * lu(k,1938) + lu(k,1951) = lu(k,1951) - lu(k,1513) * lu(k,1938) + lu(k,1952) = lu(k,1952) - lu(k,1514) * lu(k,1938) + lu(k,1953) = lu(k,1953) - lu(k,1515) * lu(k,1938) + lu(k,1962) = lu(k,1962) - lu(k,1504) * lu(k,1961) + lu(k,1963) = lu(k,1963) - lu(k,1505) * lu(k,1961) + lu(k,1964) = lu(k,1964) - lu(k,1506) * lu(k,1961) + lu(k,1965) = lu(k,1965) - lu(k,1507) * lu(k,1961) + lu(k,1967) = lu(k,1967) - lu(k,1508) * lu(k,1961) + lu(k,1968) = lu(k,1968) - lu(k,1509) * lu(k,1961) + lu(k,1969) = lu(k,1969) - lu(k,1510) * lu(k,1961) + lu(k,1970) = lu(k,1970) - lu(k,1511) * lu(k,1961) + lu(k,1972) = lu(k,1972) - lu(k,1512) * lu(k,1961) + lu(k,1973) = lu(k,1973) - lu(k,1513) * lu(k,1961) + lu(k,1974) = lu(k,1974) - lu(k,1514) * lu(k,1961) + lu(k,1975) = lu(k,1975) - lu(k,1515) * lu(k,1961) + lu(k,1993) = lu(k,1993) - lu(k,1504) * lu(k,1991) + lu(k,1994) = lu(k,1994) - lu(k,1505) * lu(k,1991) + lu(k,1995) = lu(k,1995) - lu(k,1506) * lu(k,1991) + lu(k,1996) = lu(k,1996) - lu(k,1507) * lu(k,1991) + lu(k,1998) = lu(k,1998) - lu(k,1508) * lu(k,1991) + lu(k,1999) = lu(k,1999) - lu(k,1509) * lu(k,1991) + lu(k,2000) = lu(k,2000) - lu(k,1510) * lu(k,1991) + lu(k,2001) = lu(k,2001) - lu(k,1511) * lu(k,1991) + lu(k,2003) = lu(k,2003) - lu(k,1512) * lu(k,1991) + lu(k,2004) = lu(k,2004) - lu(k,1513) * lu(k,1991) + lu(k,2005) = lu(k,2005) - lu(k,1514) * lu(k,1991) + lu(k,2006) = lu(k,2006) - lu(k,1515) * lu(k,1991) + lu(k,2017) = lu(k,2017) - lu(k,1504) * lu(k,2015) + lu(k,2018) = lu(k,2018) - lu(k,1505) * lu(k,2015) + lu(k,2019) = lu(k,2019) - lu(k,1506) * lu(k,2015) + lu(k,2020) = lu(k,2020) - lu(k,1507) * lu(k,2015) + lu(k,2022) = lu(k,2022) - lu(k,1508) * lu(k,2015) + lu(k,2023) = lu(k,2023) - lu(k,1509) * lu(k,2015) + lu(k,2024) = lu(k,2024) - lu(k,1510) * lu(k,2015) + lu(k,2025) = lu(k,2025) - lu(k,1511) * lu(k,2015) + lu(k,2027) = lu(k,2027) - lu(k,1512) * lu(k,2015) + lu(k,2028) = lu(k,2028) - lu(k,1513) * lu(k,2015) + lu(k,2029) = lu(k,2029) - lu(k,1514) * lu(k,2015) + lu(k,2030) = lu(k,2030) - lu(k,1515) * lu(k,2015) + lu(k,2074) = lu(k,2074) - lu(k,1504) * lu(k,2072) + lu(k,2075) = lu(k,2075) - lu(k,1505) * lu(k,2072) + lu(k,2076) = lu(k,2076) - lu(k,1506) * lu(k,2072) + lu(k,2077) = lu(k,2077) - lu(k,1507) * lu(k,2072) + lu(k,2079) = lu(k,2079) - lu(k,1508) * lu(k,2072) + lu(k,2080) = lu(k,2080) - lu(k,1509) * lu(k,2072) + lu(k,2081) = lu(k,2081) - lu(k,1510) * lu(k,2072) + lu(k,2082) = lu(k,2082) - lu(k,1511) * lu(k,2072) + lu(k,2084) = lu(k,2084) - lu(k,1512) * lu(k,2072) + lu(k,2085) = lu(k,2085) - lu(k,1513) * lu(k,2072) + lu(k,2086) = lu(k,2086) - lu(k,1514) * lu(k,2072) + lu(k,2087) = lu(k,2087) - lu(k,1515) * lu(k,2072) + lu(k,2098) = lu(k,2098) - lu(k,1504) * lu(k,2096) + lu(k,2099) = lu(k,2099) - lu(k,1505) * lu(k,2096) + lu(k,2100) = lu(k,2100) - lu(k,1506) * lu(k,2096) + lu(k,2101) = lu(k,2101) - lu(k,1507) * lu(k,2096) + lu(k,2103) = lu(k,2103) - lu(k,1508) * lu(k,2096) + lu(k,2104) = lu(k,2104) - lu(k,1509) * lu(k,2096) + lu(k,2105) = lu(k,2105) - lu(k,1510) * lu(k,2096) + lu(k,2106) = lu(k,2106) - lu(k,1511) * lu(k,2096) + lu(k,2108) = lu(k,2108) - lu(k,1512) * lu(k,2096) + lu(k,2109) = lu(k,2109) - lu(k,1513) * lu(k,2096) + lu(k,2110) = lu(k,2110) - lu(k,1514) * lu(k,2096) + lu(k,2111) = lu(k,2111) - lu(k,1515) * lu(k,2096) + lu(k,2217) = lu(k,2217) - lu(k,1504) * lu(k,2215) + lu(k,2218) = lu(k,2218) - lu(k,1505) * lu(k,2215) + lu(k,2219) = lu(k,2219) - lu(k,1506) * lu(k,2215) + lu(k,2220) = lu(k,2220) - lu(k,1507) * lu(k,2215) + lu(k,2222) = lu(k,2222) - lu(k,1508) * lu(k,2215) + lu(k,2223) = lu(k,2223) - lu(k,1509) * lu(k,2215) + lu(k,2224) = lu(k,2224) - lu(k,1510) * lu(k,2215) + lu(k,2225) = lu(k,2225) - lu(k,1511) * lu(k,2215) + lu(k,2227) = lu(k,2227) - lu(k,1512) * lu(k,2215) + lu(k,2228) = lu(k,2228) - lu(k,1513) * lu(k,2215) + lu(k,2229) = lu(k,2229) - lu(k,1514) * lu(k,2215) + lu(k,2230) = lu(k,2230) - lu(k,1515) * lu(k,2215) + lu(k,2256) = lu(k,2256) - lu(k,1504) * lu(k,2254) + lu(k,2257) = lu(k,2257) - lu(k,1505) * lu(k,2254) + lu(k,2258) = lu(k,2258) - lu(k,1506) * lu(k,2254) + lu(k,2259) = lu(k,2259) - lu(k,1507) * lu(k,2254) + lu(k,2261) = lu(k,2261) - lu(k,1508) * lu(k,2254) + lu(k,2262) = lu(k,2262) - lu(k,1509) * lu(k,2254) + lu(k,2263) = lu(k,2263) - lu(k,1510) * lu(k,2254) + lu(k,2264) = lu(k,2264) - lu(k,1511) * lu(k,2254) + lu(k,2266) = lu(k,2266) - lu(k,1512) * lu(k,2254) + lu(k,2267) = lu(k,2267) - lu(k,1513) * lu(k,2254) + lu(k,2268) = lu(k,2268) - lu(k,1514) * lu(k,2254) + lu(k,2269) = lu(k,2269) - lu(k,1515) * lu(k,2254) + lu(k,2317) = lu(k,2317) - lu(k,1504) * lu(k,2315) + lu(k,2318) = lu(k,2318) - lu(k,1505) * lu(k,2315) + lu(k,2319) = lu(k,2319) - lu(k,1506) * lu(k,2315) + lu(k,2320) = lu(k,2320) - lu(k,1507) * lu(k,2315) + lu(k,2322) = lu(k,2322) - lu(k,1508) * lu(k,2315) + lu(k,2323) = lu(k,2323) - lu(k,1509) * lu(k,2315) + lu(k,2324) = lu(k,2324) - lu(k,1510) * lu(k,2315) + lu(k,2325) = lu(k,2325) - lu(k,1511) * lu(k,2315) + lu(k,2327) = lu(k,2327) - lu(k,1512) * lu(k,2315) + lu(k,2328) = lu(k,2328) - lu(k,1513) * lu(k,2315) + lu(k,2329) = lu(k,2329) - lu(k,1514) * lu(k,2315) + lu(k,2330) = lu(k,2330) - lu(k,1515) * lu(k,2315) + lu(k,2343) = lu(k,2343) - lu(k,1504) * lu(k,2341) + lu(k,2344) = lu(k,2344) - lu(k,1505) * lu(k,2341) + lu(k,2345) = lu(k,2345) - lu(k,1506) * lu(k,2341) + lu(k,2346) = lu(k,2346) - lu(k,1507) * lu(k,2341) + lu(k,2348) = lu(k,2348) - lu(k,1508) * lu(k,2341) + lu(k,2349) = lu(k,2349) - lu(k,1509) * lu(k,2341) + lu(k,2350) = lu(k,2350) - lu(k,1510) * lu(k,2341) + lu(k,2351) = lu(k,2351) - lu(k,1511) * lu(k,2341) + lu(k,2353) = lu(k,2353) - lu(k,1512) * lu(k,2341) + lu(k,2354) = lu(k,2354) - lu(k,1513) * lu(k,2341) + lu(k,2355) = lu(k,2355) - lu(k,1514) * lu(k,2341) + lu(k,2356) = lu(k,2356) - lu(k,1515) * lu(k,2341) + lu(k,1604) = 1._r8 / lu(k,1604) + lu(k,1605) = lu(k,1605) * lu(k,1604) + lu(k,1606) = lu(k,1606) * lu(k,1604) + lu(k,1607) = lu(k,1607) * lu(k,1604) + lu(k,1608) = lu(k,1608) * lu(k,1604) + lu(k,1609) = lu(k,1609) * lu(k,1604) + lu(k,1610) = lu(k,1610) * lu(k,1604) + lu(k,1611) = lu(k,1611) * lu(k,1604) + lu(k,1612) = lu(k,1612) * lu(k,1604) + lu(k,1613) = lu(k,1613) * lu(k,1604) + lu(k,1614) = lu(k,1614) * lu(k,1604) + lu(k,1615) = lu(k,1615) * lu(k,1604) + lu(k,1616) = lu(k,1616) * lu(k,1604) + lu(k,1617) = lu(k,1617) * lu(k,1604) + lu(k,1618) = lu(k,1618) * lu(k,1604) + lu(k,1657) = lu(k,1657) - lu(k,1605) * lu(k,1656) + lu(k,1658) = lu(k,1658) - lu(k,1606) * lu(k,1656) + lu(k,1659) = lu(k,1659) - lu(k,1607) * lu(k,1656) + lu(k,1660) = lu(k,1660) - lu(k,1608) * lu(k,1656) + lu(k,1661) = lu(k,1661) - lu(k,1609) * lu(k,1656) + lu(k,1662) = lu(k,1662) - lu(k,1610) * lu(k,1656) + lu(k,1663) = lu(k,1663) - lu(k,1611) * lu(k,1656) + lu(k,1664) = lu(k,1664) - lu(k,1612) * lu(k,1656) + lu(k,1665) = lu(k,1665) - lu(k,1613) * lu(k,1656) + lu(k,1666) = - lu(k,1614) * lu(k,1656) + lu(k,1667) = lu(k,1667) - lu(k,1615) * lu(k,1656) + lu(k,1668) = lu(k,1668) - lu(k,1616) * lu(k,1656) + lu(k,1669) = lu(k,1669) - lu(k,1617) * lu(k,1656) + lu(k,1670) = lu(k,1670) - lu(k,1618) * lu(k,1656) + lu(k,1701) = lu(k,1701) - lu(k,1605) * lu(k,1700) + lu(k,1702) = lu(k,1702) - lu(k,1606) * lu(k,1700) + lu(k,1703) = lu(k,1703) - lu(k,1607) * lu(k,1700) + lu(k,1704) = lu(k,1704) - lu(k,1608) * lu(k,1700) + lu(k,1705) = lu(k,1705) - lu(k,1609) * lu(k,1700) + lu(k,1706) = lu(k,1706) - lu(k,1610) * lu(k,1700) + lu(k,1707) = lu(k,1707) - lu(k,1611) * lu(k,1700) + lu(k,1708) = lu(k,1708) - lu(k,1612) * lu(k,1700) + lu(k,1709) = lu(k,1709) - lu(k,1613) * lu(k,1700) + lu(k,1710) = lu(k,1710) - lu(k,1614) * lu(k,1700) + lu(k,1711) = lu(k,1711) - lu(k,1615) * lu(k,1700) + lu(k,1712) = lu(k,1712) - lu(k,1616) * lu(k,1700) + lu(k,1713) = lu(k,1713) - lu(k,1617) * lu(k,1700) + lu(k,1714) = lu(k,1714) - lu(k,1618) * lu(k,1700) + lu(k,1742) = lu(k,1742) - lu(k,1605) * lu(k,1741) + lu(k,1743) = lu(k,1743) - lu(k,1606) * lu(k,1741) + lu(k,1744) = lu(k,1744) - lu(k,1607) * lu(k,1741) + lu(k,1745) = lu(k,1745) - lu(k,1608) * lu(k,1741) + lu(k,1746) = lu(k,1746) - lu(k,1609) * lu(k,1741) + lu(k,1747) = lu(k,1747) - lu(k,1610) * lu(k,1741) + lu(k,1748) = lu(k,1748) - lu(k,1611) * lu(k,1741) + lu(k,1749) = lu(k,1749) - lu(k,1612) * lu(k,1741) + lu(k,1750) = lu(k,1750) - lu(k,1613) * lu(k,1741) + lu(k,1751) = lu(k,1751) - lu(k,1614) * lu(k,1741) + lu(k,1752) = lu(k,1752) - lu(k,1615) * lu(k,1741) + lu(k,1753) = lu(k,1753) - lu(k,1616) * lu(k,1741) + lu(k,1754) = lu(k,1754) - lu(k,1617) * lu(k,1741) + lu(k,1755) = lu(k,1755) - lu(k,1618) * lu(k,1741) + lu(k,1914) = lu(k,1914) - lu(k,1605) * lu(k,1913) + lu(k,1915) = lu(k,1915) - lu(k,1606) * lu(k,1913) + lu(k,1916) = lu(k,1916) - lu(k,1607) * lu(k,1913) + lu(k,1917) = lu(k,1917) - lu(k,1608) * lu(k,1913) + lu(k,1918) = lu(k,1918) - lu(k,1609) * lu(k,1913) + lu(k,1919) = lu(k,1919) - lu(k,1610) * lu(k,1913) + lu(k,1920) = lu(k,1920) - lu(k,1611) * lu(k,1913) + lu(k,1921) = lu(k,1921) - lu(k,1612) * lu(k,1913) + lu(k,1922) = lu(k,1922) - lu(k,1613) * lu(k,1913) + lu(k,1923) = lu(k,1923) - lu(k,1614) * lu(k,1913) + lu(k,1924) = lu(k,1924) - lu(k,1615) * lu(k,1913) + lu(k,1925) = lu(k,1925) - lu(k,1616) * lu(k,1913) + lu(k,1926) = lu(k,1926) - lu(k,1617) * lu(k,1913) + lu(k,1927) = lu(k,1927) - lu(k,1618) * lu(k,1913) + lu(k,1940) = lu(k,1940) - lu(k,1605) * lu(k,1939) + lu(k,1941) = lu(k,1941) - lu(k,1606) * lu(k,1939) + lu(k,1942) = lu(k,1942) - lu(k,1607) * lu(k,1939) + lu(k,1943) = lu(k,1943) - lu(k,1608) * lu(k,1939) + lu(k,1944) = lu(k,1944) - lu(k,1609) * lu(k,1939) + lu(k,1945) = lu(k,1945) - lu(k,1610) * lu(k,1939) + lu(k,1946) = lu(k,1946) - lu(k,1611) * lu(k,1939) + lu(k,1947) = lu(k,1947) - lu(k,1612) * lu(k,1939) + lu(k,1948) = lu(k,1948) - lu(k,1613) * lu(k,1939) + lu(k,1949) = lu(k,1949) - lu(k,1614) * lu(k,1939) + lu(k,1950) = lu(k,1950) - lu(k,1615) * lu(k,1939) + lu(k,1951) = lu(k,1951) - lu(k,1616) * lu(k,1939) + lu(k,1952) = lu(k,1952) - lu(k,1617) * lu(k,1939) + lu(k,1953) = lu(k,1953) - lu(k,1618) * lu(k,1939) + lu(k,1993) = lu(k,1993) - lu(k,1605) * lu(k,1992) + lu(k,1994) = lu(k,1994) - lu(k,1606) * lu(k,1992) + lu(k,1995) = lu(k,1995) - lu(k,1607) * lu(k,1992) + lu(k,1996) = lu(k,1996) - lu(k,1608) * lu(k,1992) + lu(k,1997) = lu(k,1997) - lu(k,1609) * lu(k,1992) + lu(k,1998) = lu(k,1998) - lu(k,1610) * lu(k,1992) + lu(k,1999) = lu(k,1999) - lu(k,1611) * lu(k,1992) + lu(k,2000) = lu(k,2000) - lu(k,1612) * lu(k,1992) + lu(k,2001) = lu(k,2001) - lu(k,1613) * lu(k,1992) + lu(k,2002) = lu(k,2002) - lu(k,1614) * lu(k,1992) + lu(k,2003) = lu(k,2003) - lu(k,1615) * lu(k,1992) + lu(k,2004) = lu(k,2004) - lu(k,1616) * lu(k,1992) + lu(k,2005) = lu(k,2005) - lu(k,1617) * lu(k,1992) + lu(k,2006) = lu(k,2006) - lu(k,1618) * lu(k,1992) + lu(k,2017) = lu(k,2017) - lu(k,1605) * lu(k,2016) + lu(k,2018) = lu(k,2018) - lu(k,1606) * lu(k,2016) + lu(k,2019) = lu(k,2019) - lu(k,1607) * lu(k,2016) + lu(k,2020) = lu(k,2020) - lu(k,1608) * lu(k,2016) + lu(k,2021) = - lu(k,1609) * lu(k,2016) + lu(k,2022) = lu(k,2022) - lu(k,1610) * lu(k,2016) + lu(k,2023) = lu(k,2023) - lu(k,1611) * lu(k,2016) + lu(k,2024) = lu(k,2024) - lu(k,1612) * lu(k,2016) + lu(k,2025) = lu(k,2025) - lu(k,1613) * lu(k,2016) + lu(k,2026) = lu(k,2026) - lu(k,1614) * lu(k,2016) + lu(k,2027) = lu(k,2027) - lu(k,1615) * lu(k,2016) + lu(k,2028) = lu(k,2028) - lu(k,1616) * lu(k,2016) + lu(k,2029) = lu(k,2029) - lu(k,1617) * lu(k,2016) + lu(k,2030) = lu(k,2030) - lu(k,1618) * lu(k,2016) + lu(k,2074) = lu(k,2074) - lu(k,1605) * lu(k,2073) + lu(k,2075) = lu(k,2075) - lu(k,1606) * lu(k,2073) + lu(k,2076) = lu(k,2076) - lu(k,1607) * lu(k,2073) + lu(k,2077) = lu(k,2077) - lu(k,1608) * lu(k,2073) + lu(k,2078) = lu(k,2078) - lu(k,1609) * lu(k,2073) + lu(k,2079) = lu(k,2079) - lu(k,1610) * lu(k,2073) + lu(k,2080) = lu(k,2080) - lu(k,1611) * lu(k,2073) + lu(k,2081) = lu(k,2081) - lu(k,1612) * lu(k,2073) + lu(k,2082) = lu(k,2082) - lu(k,1613) * lu(k,2073) + lu(k,2083) = lu(k,2083) - lu(k,1614) * lu(k,2073) + lu(k,2084) = lu(k,2084) - lu(k,1615) * lu(k,2073) + lu(k,2085) = lu(k,2085) - lu(k,1616) * lu(k,2073) + lu(k,2086) = lu(k,2086) - lu(k,1617) * lu(k,2073) + lu(k,2087) = lu(k,2087) - lu(k,1618) * lu(k,2073) + lu(k,2098) = lu(k,2098) - lu(k,1605) * lu(k,2097) + lu(k,2099) = lu(k,2099) - lu(k,1606) * lu(k,2097) + lu(k,2100) = lu(k,2100) - lu(k,1607) * lu(k,2097) + lu(k,2101) = lu(k,2101) - lu(k,1608) * lu(k,2097) + lu(k,2102) = lu(k,2102) - lu(k,1609) * lu(k,2097) + lu(k,2103) = lu(k,2103) - lu(k,1610) * lu(k,2097) + lu(k,2104) = lu(k,2104) - lu(k,1611) * lu(k,2097) + lu(k,2105) = lu(k,2105) - lu(k,1612) * lu(k,2097) + lu(k,2106) = lu(k,2106) - lu(k,1613) * lu(k,2097) + lu(k,2107) = lu(k,2107) - lu(k,1614) * lu(k,2097) + lu(k,2108) = lu(k,2108) - lu(k,1615) * lu(k,2097) + lu(k,2109) = lu(k,2109) - lu(k,1616) * lu(k,2097) + lu(k,2110) = lu(k,2110) - lu(k,1617) * lu(k,2097) + lu(k,2111) = lu(k,2111) - lu(k,1618) * lu(k,2097) + lu(k,2217) = lu(k,2217) - lu(k,1605) * lu(k,2216) + lu(k,2218) = lu(k,2218) - lu(k,1606) * lu(k,2216) + lu(k,2219) = lu(k,2219) - lu(k,1607) * lu(k,2216) + lu(k,2220) = lu(k,2220) - lu(k,1608) * lu(k,2216) + lu(k,2221) = lu(k,2221) - lu(k,1609) * lu(k,2216) + lu(k,2222) = lu(k,2222) - lu(k,1610) * lu(k,2216) + lu(k,2223) = lu(k,2223) - lu(k,1611) * lu(k,2216) + lu(k,2224) = lu(k,2224) - lu(k,1612) * lu(k,2216) + lu(k,2225) = lu(k,2225) - lu(k,1613) * lu(k,2216) + lu(k,2226) = lu(k,2226) - lu(k,1614) * lu(k,2216) + lu(k,2227) = lu(k,2227) - lu(k,1615) * lu(k,2216) + lu(k,2228) = lu(k,2228) - lu(k,1616) * lu(k,2216) + lu(k,2229) = lu(k,2229) - lu(k,1617) * lu(k,2216) + lu(k,2230) = lu(k,2230) - lu(k,1618) * lu(k,2216) + lu(k,2256) = lu(k,2256) - lu(k,1605) * lu(k,2255) + lu(k,2257) = lu(k,2257) - lu(k,1606) * lu(k,2255) + lu(k,2258) = lu(k,2258) - lu(k,1607) * lu(k,2255) + lu(k,2259) = lu(k,2259) - lu(k,1608) * lu(k,2255) + lu(k,2260) = lu(k,2260) - lu(k,1609) * lu(k,2255) + lu(k,2261) = lu(k,2261) - lu(k,1610) * lu(k,2255) + lu(k,2262) = lu(k,2262) - lu(k,1611) * lu(k,2255) + lu(k,2263) = lu(k,2263) - lu(k,1612) * lu(k,2255) + lu(k,2264) = lu(k,2264) - lu(k,1613) * lu(k,2255) + lu(k,2265) = lu(k,2265) - lu(k,1614) * lu(k,2255) + lu(k,2266) = lu(k,2266) - lu(k,1615) * lu(k,2255) + lu(k,2267) = lu(k,2267) - lu(k,1616) * lu(k,2255) + lu(k,2268) = lu(k,2268) - lu(k,1617) * lu(k,2255) + lu(k,2269) = lu(k,2269) - lu(k,1618) * lu(k,2255) + lu(k,2317) = lu(k,2317) - lu(k,1605) * lu(k,2316) + lu(k,2318) = lu(k,2318) - lu(k,1606) * lu(k,2316) + lu(k,2319) = lu(k,2319) - lu(k,1607) * lu(k,2316) + lu(k,2320) = lu(k,2320) - lu(k,1608) * lu(k,2316) + lu(k,2321) = lu(k,2321) - lu(k,1609) * lu(k,2316) + lu(k,2322) = lu(k,2322) - lu(k,1610) * lu(k,2316) + lu(k,2323) = lu(k,2323) - lu(k,1611) * lu(k,2316) + lu(k,2324) = lu(k,2324) - lu(k,1612) * lu(k,2316) + lu(k,2325) = lu(k,2325) - lu(k,1613) * lu(k,2316) + lu(k,2326) = lu(k,2326) - lu(k,1614) * lu(k,2316) + lu(k,2327) = lu(k,2327) - lu(k,1615) * lu(k,2316) + lu(k,2328) = lu(k,2328) - lu(k,1616) * lu(k,2316) + lu(k,2329) = lu(k,2329) - lu(k,1617) * lu(k,2316) + lu(k,2330) = lu(k,2330) - lu(k,1618) * lu(k,2316) + lu(k,2343) = lu(k,2343) - lu(k,1605) * lu(k,2342) + lu(k,2344) = lu(k,2344) - lu(k,1606) * lu(k,2342) + lu(k,2345) = lu(k,2345) - lu(k,1607) * lu(k,2342) + lu(k,2346) = lu(k,2346) - lu(k,1608) * lu(k,2342) + lu(k,2347) = lu(k,2347) - lu(k,1609) * lu(k,2342) + lu(k,2348) = lu(k,2348) - lu(k,1610) * lu(k,2342) + lu(k,2349) = lu(k,2349) - lu(k,1611) * lu(k,2342) + lu(k,2350) = lu(k,2350) - lu(k,1612) * lu(k,2342) + lu(k,2351) = lu(k,2351) - lu(k,1613) * lu(k,2342) + lu(k,2352) = lu(k,2352) - lu(k,1614) * lu(k,2342) + lu(k,2353) = lu(k,2353) - lu(k,1615) * lu(k,2342) + lu(k,2354) = lu(k,2354) - lu(k,1616) * lu(k,2342) + lu(k,2355) = lu(k,2355) - lu(k,1617) * lu(k,2342) + lu(k,2356) = lu(k,2356) - lu(k,1618) * lu(k,2342) + lu(k,1657) = 1._r8 / lu(k,1657) + lu(k,1658) = lu(k,1658) * lu(k,1657) + lu(k,1659) = lu(k,1659) * lu(k,1657) + lu(k,1660) = lu(k,1660) * lu(k,1657) + lu(k,1661) = lu(k,1661) * lu(k,1657) + lu(k,1662) = lu(k,1662) * lu(k,1657) + lu(k,1663) = lu(k,1663) * lu(k,1657) + lu(k,1664) = lu(k,1664) * lu(k,1657) + lu(k,1665) = lu(k,1665) * lu(k,1657) + lu(k,1666) = lu(k,1666) * lu(k,1657) + lu(k,1667) = lu(k,1667) * lu(k,1657) + lu(k,1668) = lu(k,1668) * lu(k,1657) + lu(k,1669) = lu(k,1669) * lu(k,1657) + lu(k,1670) = lu(k,1670) * lu(k,1657) + lu(k,1702) = lu(k,1702) - lu(k,1658) * lu(k,1701) + lu(k,1703) = lu(k,1703) - lu(k,1659) * lu(k,1701) + lu(k,1704) = lu(k,1704) - lu(k,1660) * lu(k,1701) + lu(k,1705) = lu(k,1705) - lu(k,1661) * lu(k,1701) + lu(k,1706) = lu(k,1706) - lu(k,1662) * lu(k,1701) + lu(k,1707) = lu(k,1707) - lu(k,1663) * lu(k,1701) + lu(k,1708) = lu(k,1708) - lu(k,1664) * lu(k,1701) + lu(k,1709) = lu(k,1709) - lu(k,1665) * lu(k,1701) + lu(k,1710) = lu(k,1710) - lu(k,1666) * lu(k,1701) + lu(k,1711) = lu(k,1711) - lu(k,1667) * lu(k,1701) + lu(k,1712) = lu(k,1712) - lu(k,1668) * lu(k,1701) + lu(k,1713) = lu(k,1713) - lu(k,1669) * lu(k,1701) + lu(k,1714) = lu(k,1714) - lu(k,1670) * lu(k,1701) + lu(k,1743) = lu(k,1743) - lu(k,1658) * lu(k,1742) + lu(k,1744) = lu(k,1744) - lu(k,1659) * lu(k,1742) + lu(k,1745) = lu(k,1745) - lu(k,1660) * lu(k,1742) + lu(k,1746) = lu(k,1746) - lu(k,1661) * lu(k,1742) + lu(k,1747) = lu(k,1747) - lu(k,1662) * lu(k,1742) + lu(k,1748) = lu(k,1748) - lu(k,1663) * lu(k,1742) + lu(k,1749) = lu(k,1749) - lu(k,1664) * lu(k,1742) + lu(k,1750) = lu(k,1750) - lu(k,1665) * lu(k,1742) + lu(k,1751) = lu(k,1751) - lu(k,1666) * lu(k,1742) + lu(k,1752) = lu(k,1752) - lu(k,1667) * lu(k,1742) + lu(k,1753) = lu(k,1753) - lu(k,1668) * lu(k,1742) + lu(k,1754) = lu(k,1754) - lu(k,1669) * lu(k,1742) + lu(k,1755) = lu(k,1755) - lu(k,1670) * lu(k,1742) + lu(k,1915) = lu(k,1915) - lu(k,1658) * lu(k,1914) + lu(k,1916) = lu(k,1916) - lu(k,1659) * lu(k,1914) + lu(k,1917) = lu(k,1917) - lu(k,1660) * lu(k,1914) + lu(k,1918) = lu(k,1918) - lu(k,1661) * lu(k,1914) + lu(k,1919) = lu(k,1919) - lu(k,1662) * lu(k,1914) + lu(k,1920) = lu(k,1920) - lu(k,1663) * lu(k,1914) + lu(k,1921) = lu(k,1921) - lu(k,1664) * lu(k,1914) + lu(k,1922) = lu(k,1922) - lu(k,1665) * lu(k,1914) + lu(k,1923) = lu(k,1923) - lu(k,1666) * lu(k,1914) + lu(k,1924) = lu(k,1924) - lu(k,1667) * lu(k,1914) + lu(k,1925) = lu(k,1925) - lu(k,1668) * lu(k,1914) + lu(k,1926) = lu(k,1926) - lu(k,1669) * lu(k,1914) + lu(k,1927) = lu(k,1927) - lu(k,1670) * lu(k,1914) + lu(k,1941) = lu(k,1941) - lu(k,1658) * lu(k,1940) + lu(k,1942) = lu(k,1942) - lu(k,1659) * lu(k,1940) + lu(k,1943) = lu(k,1943) - lu(k,1660) * lu(k,1940) + lu(k,1944) = lu(k,1944) - lu(k,1661) * lu(k,1940) + lu(k,1945) = lu(k,1945) - lu(k,1662) * lu(k,1940) + lu(k,1946) = lu(k,1946) - lu(k,1663) * lu(k,1940) + lu(k,1947) = lu(k,1947) - lu(k,1664) * lu(k,1940) + lu(k,1948) = lu(k,1948) - lu(k,1665) * lu(k,1940) + lu(k,1949) = lu(k,1949) - lu(k,1666) * lu(k,1940) + lu(k,1950) = lu(k,1950) - lu(k,1667) * lu(k,1940) + lu(k,1951) = lu(k,1951) - lu(k,1668) * lu(k,1940) + lu(k,1952) = lu(k,1952) - lu(k,1669) * lu(k,1940) + lu(k,1953) = lu(k,1953) - lu(k,1670) * lu(k,1940) + lu(k,1963) = lu(k,1963) - lu(k,1658) * lu(k,1962) + lu(k,1964) = lu(k,1964) - lu(k,1659) * lu(k,1962) + lu(k,1965) = lu(k,1965) - lu(k,1660) * lu(k,1962) + lu(k,1966) = lu(k,1966) - lu(k,1661) * lu(k,1962) + lu(k,1967) = lu(k,1967) - lu(k,1662) * lu(k,1962) + lu(k,1968) = lu(k,1968) - lu(k,1663) * lu(k,1962) + lu(k,1969) = lu(k,1969) - lu(k,1664) * lu(k,1962) + lu(k,1970) = lu(k,1970) - lu(k,1665) * lu(k,1962) + lu(k,1971) = lu(k,1971) - lu(k,1666) * lu(k,1962) + lu(k,1972) = lu(k,1972) - lu(k,1667) * lu(k,1962) + lu(k,1973) = lu(k,1973) - lu(k,1668) * lu(k,1962) + lu(k,1974) = lu(k,1974) - lu(k,1669) * lu(k,1962) + lu(k,1975) = lu(k,1975) - lu(k,1670) * lu(k,1962) + lu(k,1994) = lu(k,1994) - lu(k,1658) * lu(k,1993) + lu(k,1995) = lu(k,1995) - lu(k,1659) * lu(k,1993) + lu(k,1996) = lu(k,1996) - lu(k,1660) * lu(k,1993) + lu(k,1997) = lu(k,1997) - lu(k,1661) * lu(k,1993) + lu(k,1998) = lu(k,1998) - lu(k,1662) * lu(k,1993) + lu(k,1999) = lu(k,1999) - lu(k,1663) * lu(k,1993) + lu(k,2000) = lu(k,2000) - lu(k,1664) * lu(k,1993) + lu(k,2001) = lu(k,2001) - lu(k,1665) * lu(k,1993) + lu(k,2002) = lu(k,2002) - lu(k,1666) * lu(k,1993) + lu(k,2003) = lu(k,2003) - lu(k,1667) * lu(k,1993) + lu(k,2004) = lu(k,2004) - lu(k,1668) * lu(k,1993) + lu(k,2005) = lu(k,2005) - lu(k,1669) * lu(k,1993) + lu(k,2006) = lu(k,2006) - lu(k,1670) * lu(k,1993) + lu(k,2018) = lu(k,2018) - lu(k,1658) * lu(k,2017) + lu(k,2019) = lu(k,2019) - lu(k,1659) * lu(k,2017) + lu(k,2020) = lu(k,2020) - lu(k,1660) * lu(k,2017) + lu(k,2021) = lu(k,2021) - lu(k,1661) * lu(k,2017) + lu(k,2022) = lu(k,2022) - lu(k,1662) * lu(k,2017) + lu(k,2023) = lu(k,2023) - lu(k,1663) * lu(k,2017) + lu(k,2024) = lu(k,2024) - lu(k,1664) * lu(k,2017) + lu(k,2025) = lu(k,2025) - lu(k,1665) * lu(k,2017) + lu(k,2026) = lu(k,2026) - lu(k,1666) * lu(k,2017) + lu(k,2027) = lu(k,2027) - lu(k,1667) * lu(k,2017) + lu(k,2028) = lu(k,2028) - lu(k,1668) * lu(k,2017) + lu(k,2029) = lu(k,2029) - lu(k,1669) * lu(k,2017) + lu(k,2030) = lu(k,2030) - lu(k,1670) * lu(k,2017) + lu(k,2075) = lu(k,2075) - lu(k,1658) * lu(k,2074) + lu(k,2076) = lu(k,2076) - lu(k,1659) * lu(k,2074) + lu(k,2077) = lu(k,2077) - lu(k,1660) * lu(k,2074) + lu(k,2078) = lu(k,2078) - lu(k,1661) * lu(k,2074) + lu(k,2079) = lu(k,2079) - lu(k,1662) * lu(k,2074) + lu(k,2080) = lu(k,2080) - lu(k,1663) * lu(k,2074) + lu(k,2081) = lu(k,2081) - lu(k,1664) * lu(k,2074) + lu(k,2082) = lu(k,2082) - lu(k,1665) * lu(k,2074) + lu(k,2083) = lu(k,2083) - lu(k,1666) * lu(k,2074) + lu(k,2084) = lu(k,2084) - lu(k,1667) * lu(k,2074) + lu(k,2085) = lu(k,2085) - lu(k,1668) * lu(k,2074) + lu(k,2086) = lu(k,2086) - lu(k,1669) * lu(k,2074) + lu(k,2087) = lu(k,2087) - lu(k,1670) * lu(k,2074) + lu(k,2099) = lu(k,2099) - lu(k,1658) * lu(k,2098) + lu(k,2100) = lu(k,2100) - lu(k,1659) * lu(k,2098) + lu(k,2101) = lu(k,2101) - lu(k,1660) * lu(k,2098) + lu(k,2102) = lu(k,2102) - lu(k,1661) * lu(k,2098) + lu(k,2103) = lu(k,2103) - lu(k,1662) * lu(k,2098) + lu(k,2104) = lu(k,2104) - lu(k,1663) * lu(k,2098) + lu(k,2105) = lu(k,2105) - lu(k,1664) * lu(k,2098) + lu(k,2106) = lu(k,2106) - lu(k,1665) * lu(k,2098) + lu(k,2107) = lu(k,2107) - lu(k,1666) * lu(k,2098) + lu(k,2108) = lu(k,2108) - lu(k,1667) * lu(k,2098) + lu(k,2109) = lu(k,2109) - lu(k,1668) * lu(k,2098) + lu(k,2110) = lu(k,2110) - lu(k,1669) * lu(k,2098) + lu(k,2111) = lu(k,2111) - lu(k,1670) * lu(k,2098) + lu(k,2218) = lu(k,2218) - lu(k,1658) * lu(k,2217) + lu(k,2219) = lu(k,2219) - lu(k,1659) * lu(k,2217) + lu(k,2220) = lu(k,2220) - lu(k,1660) * lu(k,2217) + lu(k,2221) = lu(k,2221) - lu(k,1661) * lu(k,2217) + lu(k,2222) = lu(k,2222) - lu(k,1662) * lu(k,2217) + lu(k,2223) = lu(k,2223) - lu(k,1663) * lu(k,2217) + lu(k,2224) = lu(k,2224) - lu(k,1664) * lu(k,2217) + lu(k,2225) = lu(k,2225) - lu(k,1665) * lu(k,2217) + lu(k,2226) = lu(k,2226) - lu(k,1666) * lu(k,2217) + lu(k,2227) = lu(k,2227) - lu(k,1667) * lu(k,2217) + lu(k,2228) = lu(k,2228) - lu(k,1668) * lu(k,2217) + lu(k,2229) = lu(k,2229) - lu(k,1669) * lu(k,2217) + lu(k,2230) = lu(k,2230) - lu(k,1670) * lu(k,2217) + lu(k,2257) = lu(k,2257) - lu(k,1658) * lu(k,2256) + lu(k,2258) = lu(k,2258) - lu(k,1659) * lu(k,2256) + lu(k,2259) = lu(k,2259) - lu(k,1660) * lu(k,2256) + lu(k,2260) = lu(k,2260) - lu(k,1661) * lu(k,2256) + lu(k,2261) = lu(k,2261) - lu(k,1662) * lu(k,2256) + lu(k,2262) = lu(k,2262) - lu(k,1663) * lu(k,2256) + lu(k,2263) = lu(k,2263) - lu(k,1664) * lu(k,2256) + lu(k,2264) = lu(k,2264) - lu(k,1665) * lu(k,2256) + lu(k,2265) = lu(k,2265) - lu(k,1666) * lu(k,2256) + lu(k,2266) = lu(k,2266) - lu(k,1667) * lu(k,2256) + lu(k,2267) = lu(k,2267) - lu(k,1668) * lu(k,2256) + lu(k,2268) = lu(k,2268) - lu(k,1669) * lu(k,2256) + lu(k,2269) = lu(k,2269) - lu(k,1670) * lu(k,2256) + lu(k,2318) = lu(k,2318) - lu(k,1658) * lu(k,2317) + lu(k,2319) = lu(k,2319) - lu(k,1659) * lu(k,2317) + lu(k,2320) = lu(k,2320) - lu(k,1660) * lu(k,2317) + lu(k,2321) = lu(k,2321) - lu(k,1661) * lu(k,2317) + lu(k,2322) = lu(k,2322) - lu(k,1662) * lu(k,2317) + lu(k,2323) = lu(k,2323) - lu(k,1663) * lu(k,2317) + lu(k,2324) = lu(k,2324) - lu(k,1664) * lu(k,2317) + lu(k,2325) = lu(k,2325) - lu(k,1665) * lu(k,2317) + lu(k,2326) = lu(k,2326) - lu(k,1666) * lu(k,2317) + lu(k,2327) = lu(k,2327) - lu(k,1667) * lu(k,2317) + lu(k,2328) = lu(k,2328) - lu(k,1668) * lu(k,2317) + lu(k,2329) = lu(k,2329) - lu(k,1669) * lu(k,2317) + lu(k,2330) = lu(k,2330) - lu(k,1670) * lu(k,2317) + lu(k,2344) = lu(k,2344) - lu(k,1658) * lu(k,2343) + lu(k,2345) = lu(k,2345) - lu(k,1659) * lu(k,2343) + lu(k,2346) = lu(k,2346) - lu(k,1660) * lu(k,2343) + lu(k,2347) = lu(k,2347) - lu(k,1661) * lu(k,2343) + lu(k,2348) = lu(k,2348) - lu(k,1662) * lu(k,2343) + lu(k,2349) = lu(k,2349) - lu(k,1663) * lu(k,2343) + lu(k,2350) = lu(k,2350) - lu(k,1664) * lu(k,2343) + lu(k,2351) = lu(k,2351) - lu(k,1665) * lu(k,2343) + lu(k,2352) = lu(k,2352) - lu(k,1666) * lu(k,2343) + lu(k,2353) = lu(k,2353) - lu(k,1667) * lu(k,2343) + lu(k,2354) = lu(k,2354) - lu(k,1668) * lu(k,2343) + lu(k,2355) = lu(k,2355) - lu(k,1669) * lu(k,2343) + lu(k,2356) = lu(k,2356) - lu(k,1670) * lu(k,2343) + lu(k,1702) = 1._r8 / lu(k,1702) + lu(k,1703) = lu(k,1703) * lu(k,1702) + lu(k,1704) = lu(k,1704) * lu(k,1702) + lu(k,1705) = lu(k,1705) * lu(k,1702) + lu(k,1706) = lu(k,1706) * lu(k,1702) + lu(k,1707) = lu(k,1707) * lu(k,1702) + lu(k,1708) = lu(k,1708) * lu(k,1702) + lu(k,1709) = lu(k,1709) * lu(k,1702) + lu(k,1710) = lu(k,1710) * lu(k,1702) + lu(k,1711) = lu(k,1711) * lu(k,1702) + lu(k,1712) = lu(k,1712) * lu(k,1702) + lu(k,1713) = lu(k,1713) * lu(k,1702) + lu(k,1714) = lu(k,1714) * lu(k,1702) + lu(k,1744) = lu(k,1744) - lu(k,1703) * lu(k,1743) + lu(k,1745) = lu(k,1745) - lu(k,1704) * lu(k,1743) + lu(k,1746) = lu(k,1746) - lu(k,1705) * lu(k,1743) + lu(k,1747) = lu(k,1747) - lu(k,1706) * lu(k,1743) + lu(k,1748) = lu(k,1748) - lu(k,1707) * lu(k,1743) + lu(k,1749) = lu(k,1749) - lu(k,1708) * lu(k,1743) + lu(k,1750) = lu(k,1750) - lu(k,1709) * lu(k,1743) + lu(k,1751) = lu(k,1751) - lu(k,1710) * lu(k,1743) + lu(k,1752) = lu(k,1752) - lu(k,1711) * lu(k,1743) + lu(k,1753) = lu(k,1753) - lu(k,1712) * lu(k,1743) + lu(k,1754) = lu(k,1754) - lu(k,1713) * lu(k,1743) + lu(k,1755) = lu(k,1755) - lu(k,1714) * lu(k,1743) + lu(k,1916) = lu(k,1916) - lu(k,1703) * lu(k,1915) + lu(k,1917) = lu(k,1917) - lu(k,1704) * lu(k,1915) + lu(k,1918) = lu(k,1918) - lu(k,1705) * lu(k,1915) + lu(k,1919) = lu(k,1919) - lu(k,1706) * lu(k,1915) + lu(k,1920) = lu(k,1920) - lu(k,1707) * lu(k,1915) + lu(k,1921) = lu(k,1921) - lu(k,1708) * lu(k,1915) + lu(k,1922) = lu(k,1922) - lu(k,1709) * lu(k,1915) + lu(k,1923) = lu(k,1923) - lu(k,1710) * lu(k,1915) + lu(k,1924) = lu(k,1924) - lu(k,1711) * lu(k,1915) + lu(k,1925) = lu(k,1925) - lu(k,1712) * lu(k,1915) + lu(k,1926) = lu(k,1926) - lu(k,1713) * lu(k,1915) + lu(k,1927) = lu(k,1927) - lu(k,1714) * lu(k,1915) + lu(k,1942) = lu(k,1942) - lu(k,1703) * lu(k,1941) + lu(k,1943) = lu(k,1943) - lu(k,1704) * lu(k,1941) + lu(k,1944) = lu(k,1944) - lu(k,1705) * lu(k,1941) + lu(k,1945) = lu(k,1945) - lu(k,1706) * lu(k,1941) + lu(k,1946) = lu(k,1946) - lu(k,1707) * lu(k,1941) + lu(k,1947) = lu(k,1947) - lu(k,1708) * lu(k,1941) + lu(k,1948) = lu(k,1948) - lu(k,1709) * lu(k,1941) + lu(k,1949) = lu(k,1949) - lu(k,1710) * lu(k,1941) + lu(k,1950) = lu(k,1950) - lu(k,1711) * lu(k,1941) + lu(k,1951) = lu(k,1951) - lu(k,1712) * lu(k,1941) + lu(k,1952) = lu(k,1952) - lu(k,1713) * lu(k,1941) + lu(k,1953) = lu(k,1953) - lu(k,1714) * lu(k,1941) + lu(k,1964) = lu(k,1964) - lu(k,1703) * lu(k,1963) + lu(k,1965) = lu(k,1965) - lu(k,1704) * lu(k,1963) + lu(k,1966) = lu(k,1966) - lu(k,1705) * lu(k,1963) + lu(k,1967) = lu(k,1967) - lu(k,1706) * lu(k,1963) + lu(k,1968) = lu(k,1968) - lu(k,1707) * lu(k,1963) + lu(k,1969) = lu(k,1969) - lu(k,1708) * lu(k,1963) + lu(k,1970) = lu(k,1970) - lu(k,1709) * lu(k,1963) + lu(k,1971) = lu(k,1971) - lu(k,1710) * lu(k,1963) + lu(k,1972) = lu(k,1972) - lu(k,1711) * lu(k,1963) + lu(k,1973) = lu(k,1973) - lu(k,1712) * lu(k,1963) + lu(k,1974) = lu(k,1974) - lu(k,1713) * lu(k,1963) + lu(k,1975) = lu(k,1975) - lu(k,1714) * lu(k,1963) + lu(k,1995) = lu(k,1995) - lu(k,1703) * lu(k,1994) + lu(k,1996) = lu(k,1996) - lu(k,1704) * lu(k,1994) + lu(k,1997) = lu(k,1997) - lu(k,1705) * lu(k,1994) + lu(k,1998) = lu(k,1998) - lu(k,1706) * lu(k,1994) + lu(k,1999) = lu(k,1999) - lu(k,1707) * lu(k,1994) + lu(k,2000) = lu(k,2000) - lu(k,1708) * lu(k,1994) + lu(k,2001) = lu(k,2001) - lu(k,1709) * lu(k,1994) + lu(k,2002) = lu(k,2002) - lu(k,1710) * lu(k,1994) + lu(k,2003) = lu(k,2003) - lu(k,1711) * lu(k,1994) + lu(k,2004) = lu(k,2004) - lu(k,1712) * lu(k,1994) + lu(k,2005) = lu(k,2005) - lu(k,1713) * lu(k,1994) + lu(k,2006) = lu(k,2006) - lu(k,1714) * lu(k,1994) + lu(k,2019) = lu(k,2019) - lu(k,1703) * lu(k,2018) + lu(k,2020) = lu(k,2020) - lu(k,1704) * lu(k,2018) + lu(k,2021) = lu(k,2021) - lu(k,1705) * lu(k,2018) + lu(k,2022) = lu(k,2022) - lu(k,1706) * lu(k,2018) + lu(k,2023) = lu(k,2023) - lu(k,1707) * lu(k,2018) + lu(k,2024) = lu(k,2024) - lu(k,1708) * lu(k,2018) + lu(k,2025) = lu(k,2025) - lu(k,1709) * lu(k,2018) + lu(k,2026) = lu(k,2026) - lu(k,1710) * lu(k,2018) + lu(k,2027) = lu(k,2027) - lu(k,1711) * lu(k,2018) + lu(k,2028) = lu(k,2028) - lu(k,1712) * lu(k,2018) + lu(k,2029) = lu(k,2029) - lu(k,1713) * lu(k,2018) + lu(k,2030) = lu(k,2030) - lu(k,1714) * lu(k,2018) + lu(k,2076) = lu(k,2076) - lu(k,1703) * lu(k,2075) + lu(k,2077) = lu(k,2077) - lu(k,1704) * lu(k,2075) + lu(k,2078) = lu(k,2078) - lu(k,1705) * lu(k,2075) + lu(k,2079) = lu(k,2079) - lu(k,1706) * lu(k,2075) + lu(k,2080) = lu(k,2080) - lu(k,1707) * lu(k,2075) + lu(k,2081) = lu(k,2081) - lu(k,1708) * lu(k,2075) + lu(k,2082) = lu(k,2082) - lu(k,1709) * lu(k,2075) + lu(k,2083) = lu(k,2083) - lu(k,1710) * lu(k,2075) + lu(k,2084) = lu(k,2084) - lu(k,1711) * lu(k,2075) + lu(k,2085) = lu(k,2085) - lu(k,1712) * lu(k,2075) + lu(k,2086) = lu(k,2086) - lu(k,1713) * lu(k,2075) + lu(k,2087) = lu(k,2087) - lu(k,1714) * lu(k,2075) + lu(k,2100) = lu(k,2100) - lu(k,1703) * lu(k,2099) + lu(k,2101) = lu(k,2101) - lu(k,1704) * lu(k,2099) + lu(k,2102) = lu(k,2102) - lu(k,1705) * lu(k,2099) + lu(k,2103) = lu(k,2103) - lu(k,1706) * lu(k,2099) + lu(k,2104) = lu(k,2104) - lu(k,1707) * lu(k,2099) + lu(k,2105) = lu(k,2105) - lu(k,1708) * lu(k,2099) + lu(k,2106) = lu(k,2106) - lu(k,1709) * lu(k,2099) + lu(k,2107) = lu(k,2107) - lu(k,1710) * lu(k,2099) + lu(k,2108) = lu(k,2108) - lu(k,1711) * lu(k,2099) + lu(k,2109) = lu(k,2109) - lu(k,1712) * lu(k,2099) + lu(k,2110) = lu(k,2110) - lu(k,1713) * lu(k,2099) + lu(k,2111) = lu(k,2111) - lu(k,1714) * lu(k,2099) + lu(k,2219) = lu(k,2219) - lu(k,1703) * lu(k,2218) + lu(k,2220) = lu(k,2220) - lu(k,1704) * lu(k,2218) + lu(k,2221) = lu(k,2221) - lu(k,1705) * lu(k,2218) + lu(k,2222) = lu(k,2222) - lu(k,1706) * lu(k,2218) + lu(k,2223) = lu(k,2223) - lu(k,1707) * lu(k,2218) + lu(k,2224) = lu(k,2224) - lu(k,1708) * lu(k,2218) + lu(k,2225) = lu(k,2225) - lu(k,1709) * lu(k,2218) + lu(k,2226) = lu(k,2226) - lu(k,1710) * lu(k,2218) + lu(k,2227) = lu(k,2227) - lu(k,1711) * lu(k,2218) + lu(k,2228) = lu(k,2228) - lu(k,1712) * lu(k,2218) + lu(k,2229) = lu(k,2229) - lu(k,1713) * lu(k,2218) + lu(k,2230) = lu(k,2230) - lu(k,1714) * lu(k,2218) + lu(k,2258) = lu(k,2258) - lu(k,1703) * lu(k,2257) + lu(k,2259) = lu(k,2259) - lu(k,1704) * lu(k,2257) + lu(k,2260) = lu(k,2260) - lu(k,1705) * lu(k,2257) + lu(k,2261) = lu(k,2261) - lu(k,1706) * lu(k,2257) + lu(k,2262) = lu(k,2262) - lu(k,1707) * lu(k,2257) + lu(k,2263) = lu(k,2263) - lu(k,1708) * lu(k,2257) + lu(k,2264) = lu(k,2264) - lu(k,1709) * lu(k,2257) + lu(k,2265) = lu(k,2265) - lu(k,1710) * lu(k,2257) + lu(k,2266) = lu(k,2266) - lu(k,1711) * lu(k,2257) + lu(k,2267) = lu(k,2267) - lu(k,1712) * lu(k,2257) + lu(k,2268) = lu(k,2268) - lu(k,1713) * lu(k,2257) + lu(k,2269) = lu(k,2269) - lu(k,1714) * lu(k,2257) + lu(k,2319) = lu(k,2319) - lu(k,1703) * lu(k,2318) + lu(k,2320) = lu(k,2320) - lu(k,1704) * lu(k,2318) + lu(k,2321) = lu(k,2321) - lu(k,1705) * lu(k,2318) + lu(k,2322) = lu(k,2322) - lu(k,1706) * lu(k,2318) + lu(k,2323) = lu(k,2323) - lu(k,1707) * lu(k,2318) + lu(k,2324) = lu(k,2324) - lu(k,1708) * lu(k,2318) + lu(k,2325) = lu(k,2325) - lu(k,1709) * lu(k,2318) + lu(k,2326) = lu(k,2326) - lu(k,1710) * lu(k,2318) + lu(k,2327) = lu(k,2327) - lu(k,1711) * lu(k,2318) + lu(k,2328) = lu(k,2328) - lu(k,1712) * lu(k,2318) + lu(k,2329) = lu(k,2329) - lu(k,1713) * lu(k,2318) + lu(k,2330) = lu(k,2330) - lu(k,1714) * lu(k,2318) + lu(k,2345) = lu(k,2345) - lu(k,1703) * lu(k,2344) + lu(k,2346) = lu(k,2346) - lu(k,1704) * lu(k,2344) + lu(k,2347) = lu(k,2347) - lu(k,1705) * lu(k,2344) + lu(k,2348) = lu(k,2348) - lu(k,1706) * lu(k,2344) + lu(k,2349) = lu(k,2349) - lu(k,1707) * lu(k,2344) + lu(k,2350) = lu(k,2350) - lu(k,1708) * lu(k,2344) + lu(k,2351) = lu(k,2351) - lu(k,1709) * lu(k,2344) + lu(k,2352) = lu(k,2352) - lu(k,1710) * lu(k,2344) + lu(k,2353) = lu(k,2353) - lu(k,1711) * lu(k,2344) + lu(k,2354) = lu(k,2354) - lu(k,1712) * lu(k,2344) + lu(k,2355) = lu(k,2355) - lu(k,1713) * lu(k,2344) + lu(k,2356) = lu(k,2356) - lu(k,1714) * lu(k,2344) + end do + end subroutine lu_fac29 + subroutine lu_fac30( 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,1744) = 1._r8 / lu(k,1744) + lu(k,1745) = lu(k,1745) * lu(k,1744) + lu(k,1746) = lu(k,1746) * lu(k,1744) + lu(k,1747) = lu(k,1747) * lu(k,1744) + lu(k,1748) = lu(k,1748) * lu(k,1744) + lu(k,1749) = lu(k,1749) * lu(k,1744) + lu(k,1750) = lu(k,1750) * lu(k,1744) + lu(k,1751) = lu(k,1751) * lu(k,1744) + lu(k,1752) = lu(k,1752) * lu(k,1744) + lu(k,1753) = lu(k,1753) * lu(k,1744) + lu(k,1754) = lu(k,1754) * lu(k,1744) + lu(k,1755) = lu(k,1755) * lu(k,1744) + lu(k,1917) = lu(k,1917) - lu(k,1745) * lu(k,1916) + lu(k,1918) = lu(k,1918) - lu(k,1746) * lu(k,1916) + lu(k,1919) = lu(k,1919) - lu(k,1747) * lu(k,1916) + lu(k,1920) = lu(k,1920) - lu(k,1748) * lu(k,1916) + lu(k,1921) = lu(k,1921) - lu(k,1749) * lu(k,1916) + lu(k,1922) = lu(k,1922) - lu(k,1750) * lu(k,1916) + lu(k,1923) = lu(k,1923) - lu(k,1751) * lu(k,1916) + lu(k,1924) = lu(k,1924) - lu(k,1752) * lu(k,1916) + lu(k,1925) = lu(k,1925) - lu(k,1753) * lu(k,1916) + lu(k,1926) = lu(k,1926) - lu(k,1754) * lu(k,1916) + lu(k,1927) = lu(k,1927) - lu(k,1755) * lu(k,1916) + lu(k,1943) = lu(k,1943) - lu(k,1745) * lu(k,1942) + lu(k,1944) = lu(k,1944) - lu(k,1746) * lu(k,1942) + lu(k,1945) = lu(k,1945) - lu(k,1747) * lu(k,1942) + lu(k,1946) = lu(k,1946) - lu(k,1748) * lu(k,1942) + lu(k,1947) = lu(k,1947) - lu(k,1749) * lu(k,1942) + lu(k,1948) = lu(k,1948) - lu(k,1750) * lu(k,1942) + lu(k,1949) = lu(k,1949) - lu(k,1751) * lu(k,1942) + lu(k,1950) = lu(k,1950) - lu(k,1752) * lu(k,1942) + lu(k,1951) = lu(k,1951) - lu(k,1753) * lu(k,1942) + lu(k,1952) = lu(k,1952) - lu(k,1754) * lu(k,1942) + lu(k,1953) = lu(k,1953) - lu(k,1755) * lu(k,1942) + lu(k,1965) = lu(k,1965) - lu(k,1745) * lu(k,1964) + lu(k,1966) = lu(k,1966) - lu(k,1746) * lu(k,1964) + lu(k,1967) = lu(k,1967) - lu(k,1747) * lu(k,1964) + lu(k,1968) = lu(k,1968) - lu(k,1748) * lu(k,1964) + lu(k,1969) = lu(k,1969) - lu(k,1749) * lu(k,1964) + lu(k,1970) = lu(k,1970) - lu(k,1750) * lu(k,1964) + lu(k,1971) = lu(k,1971) - lu(k,1751) * lu(k,1964) + lu(k,1972) = lu(k,1972) - lu(k,1752) * lu(k,1964) + lu(k,1973) = lu(k,1973) - lu(k,1753) * lu(k,1964) + lu(k,1974) = lu(k,1974) - lu(k,1754) * lu(k,1964) + lu(k,1975) = lu(k,1975) - lu(k,1755) * lu(k,1964) + lu(k,1996) = lu(k,1996) - lu(k,1745) * lu(k,1995) + lu(k,1997) = lu(k,1997) - lu(k,1746) * lu(k,1995) + lu(k,1998) = lu(k,1998) - lu(k,1747) * lu(k,1995) + lu(k,1999) = lu(k,1999) - lu(k,1748) * lu(k,1995) + lu(k,2000) = lu(k,2000) - lu(k,1749) * lu(k,1995) + lu(k,2001) = lu(k,2001) - lu(k,1750) * lu(k,1995) + lu(k,2002) = lu(k,2002) - lu(k,1751) * lu(k,1995) + lu(k,2003) = lu(k,2003) - lu(k,1752) * lu(k,1995) + lu(k,2004) = lu(k,2004) - lu(k,1753) * lu(k,1995) + lu(k,2005) = lu(k,2005) - lu(k,1754) * lu(k,1995) + lu(k,2006) = lu(k,2006) - lu(k,1755) * lu(k,1995) + lu(k,2020) = lu(k,2020) - lu(k,1745) * lu(k,2019) + lu(k,2021) = lu(k,2021) - lu(k,1746) * lu(k,2019) + lu(k,2022) = lu(k,2022) - lu(k,1747) * lu(k,2019) + lu(k,2023) = lu(k,2023) - lu(k,1748) * lu(k,2019) + lu(k,2024) = lu(k,2024) - lu(k,1749) * lu(k,2019) + lu(k,2025) = lu(k,2025) - lu(k,1750) * lu(k,2019) + lu(k,2026) = lu(k,2026) - lu(k,1751) * lu(k,2019) + lu(k,2027) = lu(k,2027) - lu(k,1752) * lu(k,2019) + lu(k,2028) = lu(k,2028) - lu(k,1753) * lu(k,2019) + lu(k,2029) = lu(k,2029) - lu(k,1754) * lu(k,2019) + lu(k,2030) = lu(k,2030) - lu(k,1755) * lu(k,2019) + lu(k,2077) = lu(k,2077) - lu(k,1745) * lu(k,2076) + lu(k,2078) = lu(k,2078) - lu(k,1746) * lu(k,2076) + lu(k,2079) = lu(k,2079) - lu(k,1747) * lu(k,2076) + lu(k,2080) = lu(k,2080) - lu(k,1748) * lu(k,2076) + lu(k,2081) = lu(k,2081) - lu(k,1749) * lu(k,2076) + lu(k,2082) = lu(k,2082) - lu(k,1750) * lu(k,2076) + lu(k,2083) = lu(k,2083) - lu(k,1751) * lu(k,2076) + lu(k,2084) = lu(k,2084) - lu(k,1752) * lu(k,2076) + lu(k,2085) = lu(k,2085) - lu(k,1753) * lu(k,2076) + lu(k,2086) = lu(k,2086) - lu(k,1754) * lu(k,2076) + lu(k,2087) = lu(k,2087) - lu(k,1755) * lu(k,2076) + lu(k,2101) = lu(k,2101) - lu(k,1745) * lu(k,2100) + lu(k,2102) = lu(k,2102) - lu(k,1746) * lu(k,2100) + lu(k,2103) = lu(k,2103) - lu(k,1747) * lu(k,2100) + lu(k,2104) = lu(k,2104) - lu(k,1748) * lu(k,2100) + lu(k,2105) = lu(k,2105) - lu(k,1749) * lu(k,2100) + lu(k,2106) = lu(k,2106) - lu(k,1750) * lu(k,2100) + lu(k,2107) = lu(k,2107) - lu(k,1751) * lu(k,2100) + lu(k,2108) = lu(k,2108) - lu(k,1752) * lu(k,2100) + lu(k,2109) = lu(k,2109) - lu(k,1753) * lu(k,2100) + lu(k,2110) = lu(k,2110) - lu(k,1754) * lu(k,2100) + lu(k,2111) = lu(k,2111) - lu(k,1755) * lu(k,2100) + lu(k,2220) = lu(k,2220) - lu(k,1745) * lu(k,2219) + lu(k,2221) = lu(k,2221) - lu(k,1746) * lu(k,2219) + lu(k,2222) = lu(k,2222) - lu(k,1747) * lu(k,2219) + lu(k,2223) = lu(k,2223) - lu(k,1748) * lu(k,2219) + lu(k,2224) = lu(k,2224) - lu(k,1749) * lu(k,2219) + lu(k,2225) = lu(k,2225) - lu(k,1750) * lu(k,2219) + lu(k,2226) = lu(k,2226) - lu(k,1751) * lu(k,2219) + lu(k,2227) = lu(k,2227) - lu(k,1752) * lu(k,2219) + lu(k,2228) = lu(k,2228) - lu(k,1753) * lu(k,2219) + lu(k,2229) = lu(k,2229) - lu(k,1754) * lu(k,2219) + lu(k,2230) = lu(k,2230) - lu(k,1755) * lu(k,2219) + lu(k,2259) = lu(k,2259) - lu(k,1745) * lu(k,2258) + lu(k,2260) = lu(k,2260) - lu(k,1746) * lu(k,2258) + lu(k,2261) = lu(k,2261) - lu(k,1747) * lu(k,2258) + lu(k,2262) = lu(k,2262) - lu(k,1748) * lu(k,2258) + lu(k,2263) = lu(k,2263) - lu(k,1749) * lu(k,2258) + lu(k,2264) = lu(k,2264) - lu(k,1750) * lu(k,2258) + lu(k,2265) = lu(k,2265) - lu(k,1751) * lu(k,2258) + lu(k,2266) = lu(k,2266) - lu(k,1752) * lu(k,2258) + lu(k,2267) = lu(k,2267) - lu(k,1753) * lu(k,2258) + lu(k,2268) = lu(k,2268) - lu(k,1754) * lu(k,2258) + lu(k,2269) = lu(k,2269) - lu(k,1755) * lu(k,2258) + lu(k,2320) = lu(k,2320) - lu(k,1745) * lu(k,2319) + lu(k,2321) = lu(k,2321) - lu(k,1746) * lu(k,2319) + lu(k,2322) = lu(k,2322) - lu(k,1747) * lu(k,2319) + lu(k,2323) = lu(k,2323) - lu(k,1748) * lu(k,2319) + lu(k,2324) = lu(k,2324) - lu(k,1749) * lu(k,2319) + lu(k,2325) = lu(k,2325) - lu(k,1750) * lu(k,2319) + lu(k,2326) = lu(k,2326) - lu(k,1751) * lu(k,2319) + lu(k,2327) = lu(k,2327) - lu(k,1752) * lu(k,2319) + lu(k,2328) = lu(k,2328) - lu(k,1753) * lu(k,2319) + lu(k,2329) = lu(k,2329) - lu(k,1754) * lu(k,2319) + lu(k,2330) = lu(k,2330) - lu(k,1755) * lu(k,2319) + lu(k,2346) = lu(k,2346) - lu(k,1745) * lu(k,2345) + lu(k,2347) = lu(k,2347) - lu(k,1746) * lu(k,2345) + lu(k,2348) = lu(k,2348) - lu(k,1747) * lu(k,2345) + lu(k,2349) = lu(k,2349) - lu(k,1748) * lu(k,2345) + lu(k,2350) = lu(k,2350) - lu(k,1749) * lu(k,2345) + lu(k,2351) = lu(k,2351) - lu(k,1750) * lu(k,2345) + lu(k,2352) = lu(k,2352) - lu(k,1751) * lu(k,2345) + lu(k,2353) = lu(k,2353) - lu(k,1752) * lu(k,2345) + lu(k,2354) = lu(k,2354) - lu(k,1753) * lu(k,2345) + lu(k,2355) = lu(k,2355) - lu(k,1754) * lu(k,2345) + lu(k,2356) = lu(k,2356) - lu(k,1755) * lu(k,2345) + lu(k,1917) = 1._r8 / lu(k,1917) + lu(k,1918) = lu(k,1918) * lu(k,1917) + lu(k,1919) = lu(k,1919) * lu(k,1917) + lu(k,1920) = lu(k,1920) * lu(k,1917) + lu(k,1921) = lu(k,1921) * lu(k,1917) + lu(k,1922) = lu(k,1922) * lu(k,1917) + lu(k,1923) = lu(k,1923) * lu(k,1917) + lu(k,1924) = lu(k,1924) * lu(k,1917) + lu(k,1925) = lu(k,1925) * lu(k,1917) + lu(k,1926) = lu(k,1926) * lu(k,1917) + lu(k,1927) = lu(k,1927) * lu(k,1917) + lu(k,1944) = lu(k,1944) - lu(k,1918) * lu(k,1943) + lu(k,1945) = lu(k,1945) - lu(k,1919) * lu(k,1943) + lu(k,1946) = lu(k,1946) - lu(k,1920) * lu(k,1943) + lu(k,1947) = lu(k,1947) - lu(k,1921) * lu(k,1943) + lu(k,1948) = lu(k,1948) - lu(k,1922) * lu(k,1943) + lu(k,1949) = lu(k,1949) - lu(k,1923) * lu(k,1943) + lu(k,1950) = lu(k,1950) - lu(k,1924) * lu(k,1943) + lu(k,1951) = lu(k,1951) - lu(k,1925) * lu(k,1943) + lu(k,1952) = lu(k,1952) - lu(k,1926) * lu(k,1943) + lu(k,1953) = lu(k,1953) - lu(k,1927) * lu(k,1943) + lu(k,1966) = lu(k,1966) - lu(k,1918) * lu(k,1965) + lu(k,1967) = lu(k,1967) - lu(k,1919) * lu(k,1965) + lu(k,1968) = lu(k,1968) - lu(k,1920) * lu(k,1965) + lu(k,1969) = lu(k,1969) - lu(k,1921) * lu(k,1965) + lu(k,1970) = lu(k,1970) - lu(k,1922) * lu(k,1965) + lu(k,1971) = lu(k,1971) - lu(k,1923) * lu(k,1965) + lu(k,1972) = lu(k,1972) - lu(k,1924) * lu(k,1965) + lu(k,1973) = lu(k,1973) - lu(k,1925) * lu(k,1965) + lu(k,1974) = lu(k,1974) - lu(k,1926) * lu(k,1965) + lu(k,1975) = lu(k,1975) - lu(k,1927) * lu(k,1965) + lu(k,1997) = lu(k,1997) - lu(k,1918) * lu(k,1996) + lu(k,1998) = lu(k,1998) - lu(k,1919) * lu(k,1996) + lu(k,1999) = lu(k,1999) - lu(k,1920) * lu(k,1996) + lu(k,2000) = lu(k,2000) - lu(k,1921) * lu(k,1996) + lu(k,2001) = lu(k,2001) - lu(k,1922) * lu(k,1996) + lu(k,2002) = lu(k,2002) - lu(k,1923) * lu(k,1996) + lu(k,2003) = lu(k,2003) - lu(k,1924) * lu(k,1996) + lu(k,2004) = lu(k,2004) - lu(k,1925) * lu(k,1996) + lu(k,2005) = lu(k,2005) - lu(k,1926) * lu(k,1996) + lu(k,2006) = lu(k,2006) - lu(k,1927) * lu(k,1996) + lu(k,2021) = lu(k,2021) - lu(k,1918) * lu(k,2020) + lu(k,2022) = lu(k,2022) - lu(k,1919) * lu(k,2020) + lu(k,2023) = lu(k,2023) - lu(k,1920) * lu(k,2020) + lu(k,2024) = lu(k,2024) - lu(k,1921) * lu(k,2020) + lu(k,2025) = lu(k,2025) - lu(k,1922) * lu(k,2020) + lu(k,2026) = lu(k,2026) - lu(k,1923) * lu(k,2020) + lu(k,2027) = lu(k,2027) - lu(k,1924) * lu(k,2020) + lu(k,2028) = lu(k,2028) - lu(k,1925) * lu(k,2020) + lu(k,2029) = lu(k,2029) - lu(k,1926) * lu(k,2020) + lu(k,2030) = lu(k,2030) - lu(k,1927) * lu(k,2020) + lu(k,2078) = lu(k,2078) - lu(k,1918) * lu(k,2077) + lu(k,2079) = lu(k,2079) - lu(k,1919) * lu(k,2077) + lu(k,2080) = lu(k,2080) - lu(k,1920) * lu(k,2077) + lu(k,2081) = lu(k,2081) - lu(k,1921) * lu(k,2077) + lu(k,2082) = lu(k,2082) - lu(k,1922) * lu(k,2077) + lu(k,2083) = lu(k,2083) - lu(k,1923) * lu(k,2077) + lu(k,2084) = lu(k,2084) - lu(k,1924) * lu(k,2077) + lu(k,2085) = lu(k,2085) - lu(k,1925) * lu(k,2077) + lu(k,2086) = lu(k,2086) - lu(k,1926) * lu(k,2077) + lu(k,2087) = lu(k,2087) - lu(k,1927) * lu(k,2077) + lu(k,2102) = lu(k,2102) - lu(k,1918) * lu(k,2101) + lu(k,2103) = lu(k,2103) - lu(k,1919) * lu(k,2101) + lu(k,2104) = lu(k,2104) - lu(k,1920) * lu(k,2101) + lu(k,2105) = lu(k,2105) - lu(k,1921) * lu(k,2101) + lu(k,2106) = lu(k,2106) - lu(k,1922) * lu(k,2101) + lu(k,2107) = lu(k,2107) - lu(k,1923) * lu(k,2101) + lu(k,2108) = lu(k,2108) - lu(k,1924) * lu(k,2101) + lu(k,2109) = lu(k,2109) - lu(k,1925) * lu(k,2101) + lu(k,2110) = lu(k,2110) - lu(k,1926) * lu(k,2101) + lu(k,2111) = lu(k,2111) - lu(k,1927) * lu(k,2101) + lu(k,2221) = lu(k,2221) - lu(k,1918) * lu(k,2220) + lu(k,2222) = lu(k,2222) - lu(k,1919) * lu(k,2220) + lu(k,2223) = lu(k,2223) - lu(k,1920) * lu(k,2220) + lu(k,2224) = lu(k,2224) - lu(k,1921) * lu(k,2220) + lu(k,2225) = lu(k,2225) - lu(k,1922) * lu(k,2220) + lu(k,2226) = lu(k,2226) - lu(k,1923) * lu(k,2220) + lu(k,2227) = lu(k,2227) - lu(k,1924) * lu(k,2220) + lu(k,2228) = lu(k,2228) - lu(k,1925) * lu(k,2220) + lu(k,2229) = lu(k,2229) - lu(k,1926) * lu(k,2220) + lu(k,2230) = lu(k,2230) - lu(k,1927) * lu(k,2220) + lu(k,2260) = lu(k,2260) - lu(k,1918) * lu(k,2259) + lu(k,2261) = lu(k,2261) - lu(k,1919) * lu(k,2259) + lu(k,2262) = lu(k,2262) - lu(k,1920) * lu(k,2259) + lu(k,2263) = lu(k,2263) - lu(k,1921) * lu(k,2259) + lu(k,2264) = lu(k,2264) - lu(k,1922) * lu(k,2259) + lu(k,2265) = lu(k,2265) - lu(k,1923) * lu(k,2259) + lu(k,2266) = lu(k,2266) - lu(k,1924) * lu(k,2259) + lu(k,2267) = lu(k,2267) - lu(k,1925) * lu(k,2259) + lu(k,2268) = lu(k,2268) - lu(k,1926) * lu(k,2259) + lu(k,2269) = lu(k,2269) - lu(k,1927) * lu(k,2259) + lu(k,2321) = lu(k,2321) - lu(k,1918) * lu(k,2320) + lu(k,2322) = lu(k,2322) - lu(k,1919) * lu(k,2320) + lu(k,2323) = lu(k,2323) - lu(k,1920) * lu(k,2320) + lu(k,2324) = lu(k,2324) - lu(k,1921) * lu(k,2320) + lu(k,2325) = lu(k,2325) - lu(k,1922) * lu(k,2320) + lu(k,2326) = lu(k,2326) - lu(k,1923) * lu(k,2320) + lu(k,2327) = lu(k,2327) - lu(k,1924) * lu(k,2320) + lu(k,2328) = lu(k,2328) - lu(k,1925) * lu(k,2320) + lu(k,2329) = lu(k,2329) - lu(k,1926) * lu(k,2320) + lu(k,2330) = lu(k,2330) - lu(k,1927) * lu(k,2320) + lu(k,2347) = lu(k,2347) - lu(k,1918) * lu(k,2346) + lu(k,2348) = lu(k,2348) - lu(k,1919) * lu(k,2346) + lu(k,2349) = lu(k,2349) - lu(k,1920) * lu(k,2346) + lu(k,2350) = lu(k,2350) - lu(k,1921) * lu(k,2346) + lu(k,2351) = lu(k,2351) - lu(k,1922) * lu(k,2346) + lu(k,2352) = lu(k,2352) - lu(k,1923) * lu(k,2346) + lu(k,2353) = lu(k,2353) - lu(k,1924) * lu(k,2346) + lu(k,2354) = lu(k,2354) - lu(k,1925) * lu(k,2346) + lu(k,2355) = lu(k,2355) - lu(k,1926) * lu(k,2346) + lu(k,2356) = lu(k,2356) - lu(k,1927) * lu(k,2346) + lu(k,1944) = 1._r8 / lu(k,1944) + lu(k,1945) = lu(k,1945) * lu(k,1944) + lu(k,1946) = lu(k,1946) * lu(k,1944) + lu(k,1947) = lu(k,1947) * lu(k,1944) + lu(k,1948) = lu(k,1948) * lu(k,1944) + lu(k,1949) = lu(k,1949) * lu(k,1944) + lu(k,1950) = lu(k,1950) * lu(k,1944) + lu(k,1951) = lu(k,1951) * lu(k,1944) + lu(k,1952) = lu(k,1952) * lu(k,1944) + lu(k,1953) = lu(k,1953) * lu(k,1944) + lu(k,1967) = lu(k,1967) - lu(k,1945) * lu(k,1966) + lu(k,1968) = lu(k,1968) - lu(k,1946) * lu(k,1966) + lu(k,1969) = lu(k,1969) - lu(k,1947) * lu(k,1966) + lu(k,1970) = lu(k,1970) - lu(k,1948) * lu(k,1966) + lu(k,1971) = lu(k,1971) - lu(k,1949) * lu(k,1966) + lu(k,1972) = lu(k,1972) - lu(k,1950) * lu(k,1966) + lu(k,1973) = lu(k,1973) - lu(k,1951) * lu(k,1966) + lu(k,1974) = lu(k,1974) - lu(k,1952) * lu(k,1966) + lu(k,1975) = lu(k,1975) - lu(k,1953) * lu(k,1966) + lu(k,1998) = lu(k,1998) - lu(k,1945) * lu(k,1997) + lu(k,1999) = lu(k,1999) - lu(k,1946) * lu(k,1997) + lu(k,2000) = lu(k,2000) - lu(k,1947) * lu(k,1997) + lu(k,2001) = lu(k,2001) - lu(k,1948) * lu(k,1997) + lu(k,2002) = lu(k,2002) - lu(k,1949) * lu(k,1997) + lu(k,2003) = lu(k,2003) - lu(k,1950) * lu(k,1997) + lu(k,2004) = lu(k,2004) - lu(k,1951) * lu(k,1997) + lu(k,2005) = lu(k,2005) - lu(k,1952) * lu(k,1997) + lu(k,2006) = lu(k,2006) - lu(k,1953) * lu(k,1997) + lu(k,2022) = lu(k,2022) - lu(k,1945) * lu(k,2021) + lu(k,2023) = lu(k,2023) - lu(k,1946) * lu(k,2021) + lu(k,2024) = lu(k,2024) - lu(k,1947) * lu(k,2021) + lu(k,2025) = lu(k,2025) - lu(k,1948) * lu(k,2021) + lu(k,2026) = lu(k,2026) - lu(k,1949) * lu(k,2021) + lu(k,2027) = lu(k,2027) - lu(k,1950) * lu(k,2021) + lu(k,2028) = lu(k,2028) - lu(k,1951) * lu(k,2021) + lu(k,2029) = lu(k,2029) - lu(k,1952) * lu(k,2021) + lu(k,2030) = lu(k,2030) - lu(k,1953) * lu(k,2021) + lu(k,2079) = lu(k,2079) - lu(k,1945) * lu(k,2078) + lu(k,2080) = lu(k,2080) - lu(k,1946) * lu(k,2078) + lu(k,2081) = lu(k,2081) - lu(k,1947) * lu(k,2078) + lu(k,2082) = lu(k,2082) - lu(k,1948) * lu(k,2078) + lu(k,2083) = lu(k,2083) - lu(k,1949) * lu(k,2078) + lu(k,2084) = lu(k,2084) - lu(k,1950) * lu(k,2078) + lu(k,2085) = lu(k,2085) - lu(k,1951) * lu(k,2078) + lu(k,2086) = lu(k,2086) - lu(k,1952) * lu(k,2078) + lu(k,2087) = lu(k,2087) - lu(k,1953) * lu(k,2078) + lu(k,2103) = lu(k,2103) - lu(k,1945) * lu(k,2102) + lu(k,2104) = lu(k,2104) - lu(k,1946) * lu(k,2102) + lu(k,2105) = lu(k,2105) - lu(k,1947) * lu(k,2102) + lu(k,2106) = lu(k,2106) - lu(k,1948) * lu(k,2102) + lu(k,2107) = lu(k,2107) - lu(k,1949) * lu(k,2102) + lu(k,2108) = lu(k,2108) - lu(k,1950) * lu(k,2102) + lu(k,2109) = lu(k,2109) - lu(k,1951) * lu(k,2102) + lu(k,2110) = lu(k,2110) - lu(k,1952) * lu(k,2102) + lu(k,2111) = lu(k,2111) - lu(k,1953) * lu(k,2102) + lu(k,2222) = lu(k,2222) - lu(k,1945) * lu(k,2221) + lu(k,2223) = lu(k,2223) - lu(k,1946) * lu(k,2221) + lu(k,2224) = lu(k,2224) - lu(k,1947) * lu(k,2221) + lu(k,2225) = lu(k,2225) - lu(k,1948) * lu(k,2221) + lu(k,2226) = lu(k,2226) - lu(k,1949) * lu(k,2221) + lu(k,2227) = lu(k,2227) - lu(k,1950) * lu(k,2221) + lu(k,2228) = lu(k,2228) - lu(k,1951) * lu(k,2221) + lu(k,2229) = lu(k,2229) - lu(k,1952) * lu(k,2221) + lu(k,2230) = lu(k,2230) - lu(k,1953) * lu(k,2221) + lu(k,2261) = lu(k,2261) - lu(k,1945) * lu(k,2260) + lu(k,2262) = lu(k,2262) - lu(k,1946) * lu(k,2260) + lu(k,2263) = lu(k,2263) - lu(k,1947) * lu(k,2260) + lu(k,2264) = lu(k,2264) - lu(k,1948) * lu(k,2260) + lu(k,2265) = lu(k,2265) - lu(k,1949) * lu(k,2260) + lu(k,2266) = lu(k,2266) - lu(k,1950) * lu(k,2260) + lu(k,2267) = lu(k,2267) - lu(k,1951) * lu(k,2260) + lu(k,2268) = lu(k,2268) - lu(k,1952) * lu(k,2260) + lu(k,2269) = lu(k,2269) - lu(k,1953) * lu(k,2260) + lu(k,2322) = lu(k,2322) - lu(k,1945) * lu(k,2321) + lu(k,2323) = lu(k,2323) - lu(k,1946) * lu(k,2321) + lu(k,2324) = lu(k,2324) - lu(k,1947) * lu(k,2321) + lu(k,2325) = lu(k,2325) - lu(k,1948) * lu(k,2321) + lu(k,2326) = lu(k,2326) - lu(k,1949) * lu(k,2321) + lu(k,2327) = lu(k,2327) - lu(k,1950) * lu(k,2321) + lu(k,2328) = lu(k,2328) - lu(k,1951) * lu(k,2321) + lu(k,2329) = lu(k,2329) - lu(k,1952) * lu(k,2321) + lu(k,2330) = lu(k,2330) - lu(k,1953) * lu(k,2321) + lu(k,2348) = lu(k,2348) - lu(k,1945) * lu(k,2347) + lu(k,2349) = lu(k,2349) - lu(k,1946) * lu(k,2347) + lu(k,2350) = lu(k,2350) - lu(k,1947) * lu(k,2347) + lu(k,2351) = lu(k,2351) - lu(k,1948) * lu(k,2347) + lu(k,2352) = lu(k,2352) - lu(k,1949) * lu(k,2347) + lu(k,2353) = lu(k,2353) - lu(k,1950) * lu(k,2347) + lu(k,2354) = lu(k,2354) - lu(k,1951) * lu(k,2347) + lu(k,2355) = lu(k,2355) - lu(k,1952) * lu(k,2347) + lu(k,2356) = lu(k,2356) - lu(k,1953) * lu(k,2347) + lu(k,1967) = 1._r8 / lu(k,1967) + lu(k,1968) = lu(k,1968) * lu(k,1967) + lu(k,1969) = lu(k,1969) * lu(k,1967) + lu(k,1970) = lu(k,1970) * lu(k,1967) + lu(k,1971) = lu(k,1971) * lu(k,1967) + lu(k,1972) = lu(k,1972) * lu(k,1967) + lu(k,1973) = lu(k,1973) * lu(k,1967) + lu(k,1974) = lu(k,1974) * lu(k,1967) + lu(k,1975) = lu(k,1975) * lu(k,1967) + lu(k,1999) = lu(k,1999) - lu(k,1968) * lu(k,1998) + lu(k,2000) = lu(k,2000) - lu(k,1969) * lu(k,1998) + lu(k,2001) = lu(k,2001) - lu(k,1970) * lu(k,1998) + lu(k,2002) = lu(k,2002) - lu(k,1971) * lu(k,1998) + lu(k,2003) = lu(k,2003) - lu(k,1972) * lu(k,1998) + lu(k,2004) = lu(k,2004) - lu(k,1973) * lu(k,1998) + lu(k,2005) = lu(k,2005) - lu(k,1974) * lu(k,1998) + lu(k,2006) = lu(k,2006) - lu(k,1975) * lu(k,1998) + lu(k,2023) = lu(k,2023) - lu(k,1968) * lu(k,2022) + lu(k,2024) = lu(k,2024) - lu(k,1969) * lu(k,2022) + lu(k,2025) = lu(k,2025) - lu(k,1970) * lu(k,2022) + lu(k,2026) = lu(k,2026) - lu(k,1971) * lu(k,2022) + lu(k,2027) = lu(k,2027) - lu(k,1972) * lu(k,2022) + lu(k,2028) = lu(k,2028) - lu(k,1973) * lu(k,2022) + lu(k,2029) = lu(k,2029) - lu(k,1974) * lu(k,2022) + lu(k,2030) = lu(k,2030) - lu(k,1975) * lu(k,2022) + lu(k,2080) = lu(k,2080) - lu(k,1968) * lu(k,2079) + lu(k,2081) = lu(k,2081) - lu(k,1969) * lu(k,2079) + lu(k,2082) = lu(k,2082) - lu(k,1970) * lu(k,2079) + lu(k,2083) = lu(k,2083) - lu(k,1971) * lu(k,2079) + lu(k,2084) = lu(k,2084) - lu(k,1972) * lu(k,2079) + lu(k,2085) = lu(k,2085) - lu(k,1973) * lu(k,2079) + lu(k,2086) = lu(k,2086) - lu(k,1974) * lu(k,2079) + lu(k,2087) = lu(k,2087) - lu(k,1975) * lu(k,2079) + lu(k,2104) = lu(k,2104) - lu(k,1968) * lu(k,2103) + lu(k,2105) = lu(k,2105) - lu(k,1969) * lu(k,2103) + lu(k,2106) = lu(k,2106) - lu(k,1970) * lu(k,2103) + lu(k,2107) = lu(k,2107) - lu(k,1971) * lu(k,2103) + lu(k,2108) = lu(k,2108) - lu(k,1972) * lu(k,2103) + lu(k,2109) = lu(k,2109) - lu(k,1973) * lu(k,2103) + lu(k,2110) = lu(k,2110) - lu(k,1974) * lu(k,2103) + lu(k,2111) = lu(k,2111) - lu(k,1975) * lu(k,2103) + lu(k,2223) = lu(k,2223) - lu(k,1968) * lu(k,2222) + lu(k,2224) = lu(k,2224) - lu(k,1969) * lu(k,2222) + lu(k,2225) = lu(k,2225) - lu(k,1970) * lu(k,2222) + lu(k,2226) = lu(k,2226) - lu(k,1971) * lu(k,2222) + lu(k,2227) = lu(k,2227) - lu(k,1972) * lu(k,2222) + lu(k,2228) = lu(k,2228) - lu(k,1973) * lu(k,2222) + lu(k,2229) = lu(k,2229) - lu(k,1974) * lu(k,2222) + lu(k,2230) = lu(k,2230) - lu(k,1975) * lu(k,2222) + lu(k,2262) = lu(k,2262) - lu(k,1968) * lu(k,2261) + lu(k,2263) = lu(k,2263) - lu(k,1969) * lu(k,2261) + lu(k,2264) = lu(k,2264) - lu(k,1970) * lu(k,2261) + lu(k,2265) = lu(k,2265) - lu(k,1971) * lu(k,2261) + lu(k,2266) = lu(k,2266) - lu(k,1972) * lu(k,2261) + lu(k,2267) = lu(k,2267) - lu(k,1973) * lu(k,2261) + lu(k,2268) = lu(k,2268) - lu(k,1974) * lu(k,2261) + lu(k,2269) = lu(k,2269) - lu(k,1975) * lu(k,2261) + lu(k,2323) = lu(k,2323) - lu(k,1968) * lu(k,2322) + lu(k,2324) = lu(k,2324) - lu(k,1969) * lu(k,2322) + lu(k,2325) = lu(k,2325) - lu(k,1970) * lu(k,2322) + lu(k,2326) = lu(k,2326) - lu(k,1971) * lu(k,2322) + lu(k,2327) = lu(k,2327) - lu(k,1972) * lu(k,2322) + lu(k,2328) = lu(k,2328) - lu(k,1973) * lu(k,2322) + lu(k,2329) = lu(k,2329) - lu(k,1974) * lu(k,2322) + lu(k,2330) = lu(k,2330) - lu(k,1975) * lu(k,2322) + lu(k,2349) = lu(k,2349) - lu(k,1968) * lu(k,2348) + lu(k,2350) = lu(k,2350) - lu(k,1969) * lu(k,2348) + lu(k,2351) = lu(k,2351) - lu(k,1970) * lu(k,2348) + lu(k,2352) = lu(k,2352) - lu(k,1971) * lu(k,2348) + lu(k,2353) = lu(k,2353) - lu(k,1972) * lu(k,2348) + lu(k,2354) = lu(k,2354) - lu(k,1973) * lu(k,2348) + lu(k,2355) = lu(k,2355) - lu(k,1974) * lu(k,2348) + lu(k,2356) = lu(k,2356) - lu(k,1975) * lu(k,2348) + lu(k,1999) = 1._r8 / lu(k,1999) + lu(k,2000) = lu(k,2000) * lu(k,1999) + lu(k,2001) = lu(k,2001) * lu(k,1999) + lu(k,2002) = lu(k,2002) * lu(k,1999) + lu(k,2003) = lu(k,2003) * lu(k,1999) + lu(k,2004) = lu(k,2004) * lu(k,1999) + lu(k,2005) = lu(k,2005) * lu(k,1999) + lu(k,2006) = lu(k,2006) * lu(k,1999) + lu(k,2024) = lu(k,2024) - lu(k,2000) * lu(k,2023) + lu(k,2025) = lu(k,2025) - lu(k,2001) * lu(k,2023) + lu(k,2026) = lu(k,2026) - lu(k,2002) * lu(k,2023) + lu(k,2027) = lu(k,2027) - lu(k,2003) * lu(k,2023) + lu(k,2028) = lu(k,2028) - lu(k,2004) * lu(k,2023) + lu(k,2029) = lu(k,2029) - lu(k,2005) * lu(k,2023) + lu(k,2030) = lu(k,2030) - lu(k,2006) * lu(k,2023) + lu(k,2081) = lu(k,2081) - lu(k,2000) * lu(k,2080) + lu(k,2082) = lu(k,2082) - lu(k,2001) * lu(k,2080) + lu(k,2083) = lu(k,2083) - lu(k,2002) * lu(k,2080) + lu(k,2084) = lu(k,2084) - lu(k,2003) * lu(k,2080) + lu(k,2085) = lu(k,2085) - lu(k,2004) * lu(k,2080) + lu(k,2086) = lu(k,2086) - lu(k,2005) * lu(k,2080) + lu(k,2087) = lu(k,2087) - lu(k,2006) * lu(k,2080) + lu(k,2105) = lu(k,2105) - lu(k,2000) * lu(k,2104) + lu(k,2106) = lu(k,2106) - lu(k,2001) * lu(k,2104) + lu(k,2107) = lu(k,2107) - lu(k,2002) * lu(k,2104) + lu(k,2108) = lu(k,2108) - lu(k,2003) * lu(k,2104) + lu(k,2109) = lu(k,2109) - lu(k,2004) * lu(k,2104) + lu(k,2110) = lu(k,2110) - lu(k,2005) * lu(k,2104) + lu(k,2111) = lu(k,2111) - lu(k,2006) * lu(k,2104) + lu(k,2224) = lu(k,2224) - lu(k,2000) * lu(k,2223) + lu(k,2225) = lu(k,2225) - lu(k,2001) * lu(k,2223) + lu(k,2226) = lu(k,2226) - lu(k,2002) * lu(k,2223) + lu(k,2227) = lu(k,2227) - lu(k,2003) * lu(k,2223) + lu(k,2228) = lu(k,2228) - lu(k,2004) * lu(k,2223) + lu(k,2229) = lu(k,2229) - lu(k,2005) * lu(k,2223) + lu(k,2230) = lu(k,2230) - lu(k,2006) * lu(k,2223) + lu(k,2263) = lu(k,2263) - lu(k,2000) * lu(k,2262) + lu(k,2264) = lu(k,2264) - lu(k,2001) * lu(k,2262) + lu(k,2265) = lu(k,2265) - lu(k,2002) * lu(k,2262) + lu(k,2266) = lu(k,2266) - lu(k,2003) * lu(k,2262) + lu(k,2267) = lu(k,2267) - lu(k,2004) * lu(k,2262) + lu(k,2268) = lu(k,2268) - lu(k,2005) * lu(k,2262) + lu(k,2269) = lu(k,2269) - lu(k,2006) * lu(k,2262) + lu(k,2324) = lu(k,2324) - lu(k,2000) * lu(k,2323) + lu(k,2325) = lu(k,2325) - lu(k,2001) * lu(k,2323) + lu(k,2326) = lu(k,2326) - lu(k,2002) * lu(k,2323) + lu(k,2327) = lu(k,2327) - lu(k,2003) * lu(k,2323) + lu(k,2328) = lu(k,2328) - lu(k,2004) * lu(k,2323) + lu(k,2329) = lu(k,2329) - lu(k,2005) * lu(k,2323) + lu(k,2330) = lu(k,2330) - lu(k,2006) * lu(k,2323) + lu(k,2350) = lu(k,2350) - lu(k,2000) * lu(k,2349) + lu(k,2351) = lu(k,2351) - lu(k,2001) * lu(k,2349) + lu(k,2352) = lu(k,2352) - lu(k,2002) * lu(k,2349) + lu(k,2353) = lu(k,2353) - lu(k,2003) * lu(k,2349) + lu(k,2354) = lu(k,2354) - lu(k,2004) * lu(k,2349) + lu(k,2355) = lu(k,2355) - lu(k,2005) * lu(k,2349) + lu(k,2356) = lu(k,2356) - lu(k,2006) * lu(k,2349) + lu(k,2024) = 1._r8 / lu(k,2024) + lu(k,2025) = lu(k,2025) * lu(k,2024) + lu(k,2026) = lu(k,2026) * lu(k,2024) + lu(k,2027) = lu(k,2027) * lu(k,2024) + lu(k,2028) = lu(k,2028) * lu(k,2024) + lu(k,2029) = lu(k,2029) * lu(k,2024) + lu(k,2030) = lu(k,2030) * lu(k,2024) + lu(k,2082) = lu(k,2082) - lu(k,2025) * lu(k,2081) + lu(k,2083) = lu(k,2083) - lu(k,2026) * lu(k,2081) + lu(k,2084) = lu(k,2084) - lu(k,2027) * lu(k,2081) + lu(k,2085) = lu(k,2085) - lu(k,2028) * lu(k,2081) + lu(k,2086) = lu(k,2086) - lu(k,2029) * lu(k,2081) + lu(k,2087) = lu(k,2087) - lu(k,2030) * lu(k,2081) + lu(k,2106) = lu(k,2106) - lu(k,2025) * lu(k,2105) + lu(k,2107) = lu(k,2107) - lu(k,2026) * lu(k,2105) + lu(k,2108) = lu(k,2108) - lu(k,2027) * lu(k,2105) + lu(k,2109) = lu(k,2109) - lu(k,2028) * lu(k,2105) + lu(k,2110) = lu(k,2110) - lu(k,2029) * lu(k,2105) + lu(k,2111) = lu(k,2111) - lu(k,2030) * lu(k,2105) + lu(k,2225) = lu(k,2225) - lu(k,2025) * lu(k,2224) + lu(k,2226) = lu(k,2226) - lu(k,2026) * lu(k,2224) + lu(k,2227) = lu(k,2227) - lu(k,2027) * lu(k,2224) + lu(k,2228) = lu(k,2228) - lu(k,2028) * lu(k,2224) + lu(k,2229) = lu(k,2229) - lu(k,2029) * lu(k,2224) + lu(k,2230) = lu(k,2230) - lu(k,2030) * lu(k,2224) + lu(k,2264) = lu(k,2264) - lu(k,2025) * lu(k,2263) + lu(k,2265) = lu(k,2265) - lu(k,2026) * lu(k,2263) + lu(k,2266) = lu(k,2266) - lu(k,2027) * lu(k,2263) + lu(k,2267) = lu(k,2267) - lu(k,2028) * lu(k,2263) + lu(k,2268) = lu(k,2268) - lu(k,2029) * lu(k,2263) + lu(k,2269) = lu(k,2269) - lu(k,2030) * lu(k,2263) + lu(k,2325) = lu(k,2325) - lu(k,2025) * lu(k,2324) + lu(k,2326) = lu(k,2326) - lu(k,2026) * lu(k,2324) + lu(k,2327) = lu(k,2327) - lu(k,2027) * lu(k,2324) + lu(k,2328) = lu(k,2328) - lu(k,2028) * lu(k,2324) + lu(k,2329) = lu(k,2329) - lu(k,2029) * lu(k,2324) + lu(k,2330) = lu(k,2330) - lu(k,2030) * lu(k,2324) + lu(k,2351) = lu(k,2351) - lu(k,2025) * lu(k,2350) + lu(k,2352) = lu(k,2352) - lu(k,2026) * lu(k,2350) + lu(k,2353) = lu(k,2353) - lu(k,2027) * lu(k,2350) + lu(k,2354) = lu(k,2354) - lu(k,2028) * lu(k,2350) + lu(k,2355) = lu(k,2355) - lu(k,2029) * lu(k,2350) + lu(k,2356) = lu(k,2356) - lu(k,2030) * lu(k,2350) + end do + end subroutine lu_fac30 + subroutine lu_fac31( 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,2082) = 1._r8 / lu(k,2082) + lu(k,2083) = lu(k,2083) * lu(k,2082) + lu(k,2084) = lu(k,2084) * lu(k,2082) + lu(k,2085) = lu(k,2085) * lu(k,2082) + lu(k,2086) = lu(k,2086) * lu(k,2082) + lu(k,2087) = lu(k,2087) * lu(k,2082) + lu(k,2107) = lu(k,2107) - lu(k,2083) * lu(k,2106) + lu(k,2108) = lu(k,2108) - lu(k,2084) * lu(k,2106) + lu(k,2109) = lu(k,2109) - lu(k,2085) * lu(k,2106) + lu(k,2110) = lu(k,2110) - lu(k,2086) * lu(k,2106) + lu(k,2111) = lu(k,2111) - lu(k,2087) * lu(k,2106) + lu(k,2226) = lu(k,2226) - lu(k,2083) * lu(k,2225) + lu(k,2227) = lu(k,2227) - lu(k,2084) * lu(k,2225) + lu(k,2228) = lu(k,2228) - lu(k,2085) * lu(k,2225) + lu(k,2229) = lu(k,2229) - lu(k,2086) * lu(k,2225) + lu(k,2230) = lu(k,2230) - lu(k,2087) * lu(k,2225) + lu(k,2265) = lu(k,2265) - lu(k,2083) * lu(k,2264) + lu(k,2266) = lu(k,2266) - lu(k,2084) * lu(k,2264) + lu(k,2267) = lu(k,2267) - lu(k,2085) * lu(k,2264) + lu(k,2268) = lu(k,2268) - lu(k,2086) * lu(k,2264) + lu(k,2269) = lu(k,2269) - lu(k,2087) * lu(k,2264) + lu(k,2326) = lu(k,2326) - lu(k,2083) * lu(k,2325) + lu(k,2327) = lu(k,2327) - lu(k,2084) * lu(k,2325) + lu(k,2328) = lu(k,2328) - lu(k,2085) * lu(k,2325) + lu(k,2329) = lu(k,2329) - lu(k,2086) * lu(k,2325) + lu(k,2330) = lu(k,2330) - lu(k,2087) * lu(k,2325) + lu(k,2352) = lu(k,2352) - lu(k,2083) * lu(k,2351) + lu(k,2353) = lu(k,2353) - lu(k,2084) * lu(k,2351) + lu(k,2354) = lu(k,2354) - lu(k,2085) * lu(k,2351) + lu(k,2355) = lu(k,2355) - lu(k,2086) * lu(k,2351) + lu(k,2356) = lu(k,2356) - lu(k,2087) * lu(k,2351) + lu(k,2107) = 1._r8 / lu(k,2107) + lu(k,2108) = lu(k,2108) * lu(k,2107) + lu(k,2109) = lu(k,2109) * lu(k,2107) + lu(k,2110) = lu(k,2110) * lu(k,2107) + lu(k,2111) = lu(k,2111) * lu(k,2107) + lu(k,2227) = lu(k,2227) - lu(k,2108) * lu(k,2226) + lu(k,2228) = lu(k,2228) - lu(k,2109) * lu(k,2226) + lu(k,2229) = lu(k,2229) - lu(k,2110) * lu(k,2226) + lu(k,2230) = lu(k,2230) - lu(k,2111) * lu(k,2226) + lu(k,2266) = lu(k,2266) - lu(k,2108) * lu(k,2265) + lu(k,2267) = lu(k,2267) - lu(k,2109) * lu(k,2265) + lu(k,2268) = lu(k,2268) - lu(k,2110) * lu(k,2265) + lu(k,2269) = lu(k,2269) - lu(k,2111) * lu(k,2265) + lu(k,2327) = lu(k,2327) - lu(k,2108) * lu(k,2326) + lu(k,2328) = lu(k,2328) - lu(k,2109) * lu(k,2326) + lu(k,2329) = lu(k,2329) - lu(k,2110) * lu(k,2326) + lu(k,2330) = lu(k,2330) - lu(k,2111) * lu(k,2326) + lu(k,2353) = lu(k,2353) - lu(k,2108) * lu(k,2352) + lu(k,2354) = lu(k,2354) - lu(k,2109) * lu(k,2352) + lu(k,2355) = lu(k,2355) - lu(k,2110) * lu(k,2352) + lu(k,2356) = lu(k,2356) - lu(k,2111) * lu(k,2352) + lu(k,2227) = 1._r8 / lu(k,2227) + lu(k,2228) = lu(k,2228) * lu(k,2227) + lu(k,2229) = lu(k,2229) * lu(k,2227) + lu(k,2230) = lu(k,2230) * lu(k,2227) + lu(k,2267) = lu(k,2267) - lu(k,2228) * lu(k,2266) + lu(k,2268) = lu(k,2268) - lu(k,2229) * lu(k,2266) + lu(k,2269) = lu(k,2269) - lu(k,2230) * lu(k,2266) + lu(k,2328) = lu(k,2328) - lu(k,2228) * lu(k,2327) + lu(k,2329) = lu(k,2329) - lu(k,2229) * lu(k,2327) + lu(k,2330) = lu(k,2330) - lu(k,2230) * lu(k,2327) + lu(k,2354) = lu(k,2354) - lu(k,2228) * lu(k,2353) + lu(k,2355) = lu(k,2355) - lu(k,2229) * lu(k,2353) + lu(k,2356) = lu(k,2356) - lu(k,2230) * lu(k,2353) + lu(k,2267) = 1._r8 / lu(k,2267) + lu(k,2268) = lu(k,2268) * lu(k,2267) + lu(k,2269) = lu(k,2269) * lu(k,2267) + lu(k,2329) = lu(k,2329) - lu(k,2268) * lu(k,2328) + lu(k,2330) = lu(k,2330) - lu(k,2269) * lu(k,2328) + lu(k,2355) = lu(k,2355) - lu(k,2268) * lu(k,2354) + lu(k,2356) = lu(k,2356) - lu(k,2269) * lu(k,2354) + lu(k,2329) = 1._r8 / lu(k,2329) + lu(k,2330) = lu(k,2330) * lu(k,2329) + lu(k,2356) = lu(k,2356) - lu(k,2330) * lu(k,2355) + lu(k,2356) = 1._r8 / lu(k,2356) + end do + end subroutine lu_fac31 subroutine lu_fac( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 @@ -7349,5 +8015,8 @@ subroutine lu_fac( avec_len, lu ) call lu_fac26( avec_len, lu ) call lu_fac27( avec_len, lu ) call lu_fac28( avec_len, lu ) + call lu_fac29( avec_len, lu ) + call lu_fac30( avec_len, lu ) + call lu_fac31( avec_len, lu ) end subroutine lu_fac end module mo_lu_factor diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_lu_solve.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_lu_solve.F90 index 387740342a..ac4e148634 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_lu_solve.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_lu_solve.F90 @@ -21,207 +21,210 @@ subroutine lu_slv01( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,215) = b(k,215) - lu(k,91) * b(k,70) - b(k,225) = b(k,225) - lu(k,92) * b(k,70) - b(k,213) = b(k,213) - lu(k,94) * b(k,71) - b(k,215) = b(k,215) - lu(k,95) * b(k,71) - b(k,222) = b(k,222) - lu(k,97) * b(k,72) - b(k,224) = b(k,224) - lu(k,98) * b(k,72) - b(k,169) = b(k,169) - lu(k,100) * b(k,73) - b(k,215) = b(k,215) - lu(k,101) * b(k,73) - b(k,225) = b(k,225) - lu(k,102) * b(k,73) - b(k,197) = b(k,197) - lu(k,104) * b(k,74) - b(k,215) = b(k,215) - lu(k,105) * b(k,74) - b(k,139) = b(k,139) - lu(k,107) * b(k,75) - b(k,217) = b(k,217) - lu(k,108) * b(k,75) - b(k,166) = b(k,166) - lu(k,110) * b(k,76) - b(k,214) = b(k,214) - lu(k,111) * b(k,76) - b(k,100) = b(k,100) - lu(k,113) * b(k,77) - b(k,215) = b(k,215) - lu(k,114) * b(k,77) - b(k,97) = b(k,97) - lu(k,116) * b(k,78) - b(k,225) = b(k,225) - lu(k,117) * b(k,78) - b(k,80) = b(k,80) - lu(k,124) * b(k,79) - b(k,81) = b(k,81) - lu(k,125) * b(k,79) - b(k,134) = b(k,134) - lu(k,126) * b(k,79) - b(k,213) = b(k,213) - lu(k,127) * b(k,79) - b(k,215) = b(k,215) - lu(k,128) * b(k,79) - b(k,130) = b(k,130) - lu(k,130) * b(k,80) - b(k,189) = b(k,189) - lu(k,131) * b(k,80) - b(k,213) = b(k,213) - lu(k,132) * b(k,80) - b(k,129) = b(k,129) - lu(k,134) * b(k,81) - b(k,131) = b(k,131) - lu(k,135) * b(k,81) - b(k,213) = b(k,213) - lu(k,136) * b(k,81) - b(k,215) = b(k,215) - lu(k,137) * b(k,81) - b(k,224) = b(k,224) - lu(k,139) * b(k,82) - b(k,166) = b(k,166) - lu(k,141) * b(k,83) - b(k,214) = b(k,214) - lu(k,142) * b(k,83) - b(k,224) = b(k,224) - lu(k,143) * b(k,83) - b(k,213) = b(k,213) - lu(k,145) * b(k,84) - b(k,214) = b(k,214) - lu(k,146) * b(k,84) - b(k,215) = b(k,215) - lu(k,147) * b(k,84) - b(k,86) = b(k,86) - lu(k,154) * b(k,85) - b(k,87) = b(k,87) - lu(k,155) * b(k,85) - b(k,127) = b(k,127) - lu(k,156) * b(k,85) - b(k,161) = b(k,161) - lu(k,157) * b(k,85) - b(k,213) = b(k,213) - lu(k,158) * b(k,85) - b(k,215) = b(k,215) - lu(k,159) * b(k,85) - b(k,129) = b(k,129) - lu(k,161) * b(k,86) - b(k,131) = b(k,131) - lu(k,162) * b(k,86) - b(k,213) = b(k,213) - lu(k,163) * b(k,86) - b(k,215) = b(k,215) - lu(k,164) * b(k,86) - b(k,189) = b(k,189) - lu(k,166) * b(k,87) - b(k,207) = b(k,207) - lu(k,167) * b(k,87) - b(k,213) = b(k,213) - lu(k,168) * b(k,87) - b(k,197) = b(k,197) - lu(k,170) * b(k,88) - b(k,215) = b(k,215) - lu(k,171) * b(k,88) - b(k,90) = b(k,90) - lu(k,179) * b(k,89) - b(k,127) = b(k,127) - lu(k,180) * b(k,89) - b(k,162) = b(k,162) - lu(k,181) * b(k,89) - b(k,189) = b(k,189) - lu(k,182) * b(k,89) - b(k,207) = b(k,207) - lu(k,183) * b(k,89) - b(k,213) = b(k,213) - lu(k,184) * b(k,89) - b(k,215) = b(k,215) - lu(k,185) * b(k,89) - b(k,131) = b(k,131) - lu(k,187) * b(k,90) - b(k,135) = b(k,135) - lu(k,188) * b(k,90) - b(k,213) = b(k,213) - lu(k,189) * b(k,90) - b(k,215) = b(k,215) - lu(k,190) * b(k,90) - b(k,209) = b(k,209) - lu(k,192) * b(k,91) - b(k,217) = b(k,217) - lu(k,193) * b(k,91) - b(k,180) = b(k,180) - lu(k,195) * b(k,92) - b(k,215) = b(k,215) - lu(k,196) * b(k,92) - b(k,208) = b(k,208) - lu(k,198) * b(k,93) - b(k,224) = b(k,224) - lu(k,199) * b(k,93) - b(k,139) = b(k,139) - lu(k,201) * b(k,94) - b(k,215) = b(k,215) - lu(k,202) * b(k,94) - b(k,151) = b(k,151) - lu(k,204) * b(k,95) - b(k,197) = b(k,197) - lu(k,205) * b(k,95) - b(k,213) = b(k,213) - lu(k,206) * b(k,95) - b(k,215) = b(k,215) - lu(k,207) * b(k,95) - b(k,166) = b(k,166) - lu(k,209) * b(k,96) - b(k,210) = b(k,210) - lu(k,210) * b(k,96) - b(k,174) = b(k,174) - lu(k,213) * b(k,97) - b(k,223) = b(k,223) - lu(k,214) * b(k,97) - b(k,225) = b(k,225) - lu(k,215) * b(k,97) - b(k,195) = b(k,195) - lu(k,217) * b(k,98) - b(k,213) = b(k,213) - lu(k,218) * b(k,98) - b(k,215) = b(k,215) - lu(k,219) * b(k,98) - b(k,131) = b(k,131) - lu(k,221) * b(k,99) - b(k,153) = b(k,153) - lu(k,222) * b(k,99) - b(k,215) = b(k,215) - lu(k,223) * b(k,99) - b(k,186) = b(k,186) - lu(k,225) * b(k,100) - b(k,213) = b(k,213) - lu(k,226) * b(k,100) - b(k,216) = b(k,216) - lu(k,227) * b(k,100) - b(k,163) = b(k,163) - lu(k,229) * b(k,101) - b(k,213) = b(k,213) - lu(k,230) * b(k,101) - b(k,209) = b(k,209) - lu(k,232) * b(k,102) - b(k,211) = b(k,211) - lu(k,233) * b(k,102) - b(k,217) = b(k,217) - lu(k,234) * b(k,102) - b(k,218) = b(k,218) - lu(k,235) * b(k,102) - b(k,223) = b(k,223) - lu(k,236) * b(k,102) - b(k,168) = b(k,168) - lu(k,238) * b(k,103) - b(k,177) = b(k,177) - lu(k,239) * b(k,103) - b(k,189) = b(k,189) - lu(k,240) * b(k,103) - b(k,213) = b(k,213) - lu(k,241) * b(k,103) - b(k,215) = b(k,215) - lu(k,242) * b(k,103) - b(k,172) = b(k,172) - lu(k,244) * b(k,104) - b(k,212) = b(k,212) - lu(k,245) * b(k,104) - b(k,215) = b(k,215) - lu(k,246) * b(k,104) - b(k,224) = b(k,224) - lu(k,247) * b(k,104) - b(k,225) = b(k,225) - lu(k,248) * b(k,104) - b(k,174) = b(k,174) - lu(k,250) * b(k,105) - b(k,209) = b(k,209) - lu(k,251) * b(k,105) - b(k,213) = b(k,213) - lu(k,252) * b(k,105) - b(k,215) = b(k,215) - lu(k,253) * b(k,105) - b(k,218) = b(k,218) - lu(k,254) * b(k,105) - b(k,189) = b(k,189) - lu(k,256) * b(k,106) - b(k,200) = b(k,200) - lu(k,257) * b(k,106) - b(k,207) = b(k,207) - lu(k,258) * b(k,106) - b(k,213) = b(k,213) - lu(k,259) * b(k,106) - b(k,174) = b(k,174) - lu(k,261) * b(k,107) - b(k,201) = b(k,201) - lu(k,262) * b(k,107) - b(k,222) = b(k,222) - lu(k,263) * b(k,107) - b(k,223) = b(k,223) - lu(k,264) * b(k,107) - b(k,129) = b(k,129) - lu(k,266) * b(k,108) - b(k,177) = b(k,177) - lu(k,267) * b(k,108) - b(k,213) = b(k,213) - lu(k,268) * b(k,108) - b(k,215) = b(k,215) - lu(k,269) * b(k,108) - b(k,127) = b(k,127) - lu(k,272) * b(k,109) - b(k,139) = b(k,139) - lu(k,273) * b(k,109) - b(k,213) = b(k,213) - lu(k,274) * b(k,109) - b(k,215) = b(k,215) - lu(k,275) * b(k,109) - b(k,172) = b(k,172) - lu(k,277) * b(k,110) - b(k,195) = b(k,195) - lu(k,278) * b(k,110) - b(k,213) = b(k,213) - lu(k,279) * b(k,110) - b(k,215) = b(k,215) - lu(k,280) * b(k,110) - b(k,197) = b(k,197) - lu(k,282) * b(k,111) - b(k,215) = b(k,215) - lu(k,283) * b(k,111) - b(k,156) = b(k,156) - lu(k,285) * b(k,112) - b(k,195) = b(k,195) - lu(k,286) * b(k,112) - b(k,207) = b(k,207) - lu(k,287) * b(k,112) - b(k,215) = b(k,215) - lu(k,288) * b(k,112) - b(k,204) = b(k,204) - lu(k,290) * b(k,113) - b(k,206) = b(k,206) - lu(k,291) * b(k,113) - b(k,213) = b(k,213) - lu(k,292) * b(k,113) - b(k,215) = b(k,215) - lu(k,293) * b(k,113) - b(k,145) = b(k,145) - lu(k,295) * b(k,114) - b(k,181) = b(k,181) - lu(k,296) * b(k,114) - b(k,195) = b(k,195) - lu(k,297) * b(k,114) - b(k,215) = b(k,215) - lu(k,298) * b(k,114) - b(k,216) = b(k,216) - lu(k,299) * b(k,114) - b(k,217) = b(k,217) - lu(k,300) * b(k,114) - b(k,218) = b(k,218) - lu(k,301) * b(k,114) - b(k,137) = b(k,137) - lu(k,303) * b(k,115) - b(k,174) = b(k,174) - lu(k,304) * b(k,115) - b(k,189) = b(k,189) - lu(k,305) * b(k,115) - b(k,201) = b(k,201) - lu(k,306) * b(k,115) - b(k,210) = b(k,210) - lu(k,307) * b(k,115) - b(k,215) = b(k,215) - lu(k,308) * b(k,115) - b(k,223) = b(k,223) - lu(k,309) * b(k,115) - b(k,173) = b(k,173) - lu(k,311) * b(k,116) - b(k,186) = b(k,186) - lu(k,312) * b(k,116) - b(k,209) = b(k,209) - lu(k,313) * b(k,116) - b(k,213) = b(k,213) - lu(k,314) * b(k,116) - b(k,215) = b(k,215) - lu(k,315) * b(k,116) - b(k,194) = b(k,194) - lu(k,317) * b(k,117) - b(k,207) = b(k,207) - lu(k,318) * b(k,117) - b(k,215) = b(k,215) - lu(k,319) * b(k,117) - b(k,216) = b(k,216) - lu(k,320) * b(k,117) - b(k,225) = b(k,225) - lu(k,321) * b(k,117) - b(k,157) = b(k,157) - lu(k,323) * b(k,118) - b(k,173) = b(k,173) - lu(k,324) * b(k,118) - b(k,213) = b(k,213) - lu(k,325) * b(k,118) - b(k,215) = b(k,215) - lu(k,326) * b(k,118) - b(k,217) = b(k,217) - lu(k,327) * b(k,118) - b(k,183) = b(k,183) - lu(k,329) * b(k,119) - b(k,193) = b(k,193) - lu(k,330) * b(k,119) - b(k,209) = b(k,209) - lu(k,331) * b(k,119) - b(k,215) = b(k,215) - lu(k,332) * b(k,119) - b(k,217) = b(k,217) - lu(k,333) * b(k,119) - b(k,177) = b(k,177) - lu(k,335) * b(k,120) - b(k,189) = b(k,189) - lu(k,336) * b(k,120) - b(k,200) = b(k,200) - lu(k,337) * b(k,120) - b(k,207) = b(k,207) - lu(k,338) * b(k,120) - b(k,213) = b(k,213) - lu(k,339) * b(k,120) - b(k,169) = b(k,169) - lu(k,341) * b(k,121) - b(k,181) = b(k,181) - lu(k,342) * b(k,121) - b(k,213) = b(k,213) - lu(k,343) * b(k,121) - b(k,215) = b(k,215) - lu(k,344) * b(k,121) - b(k,225) = b(k,225) - lu(k,345) * b(k,121) - b(k,130) = b(k,130) - lu(k,347) * b(k,122) - b(k,134) = b(k,134) - lu(k,348) * b(k,122) - b(k,177) = b(k,177) - lu(k,349) * b(k,122) - b(k,213) = b(k,213) - lu(k,350) * b(k,122) - b(k,215) = b(k,215) - lu(k,351) * b(k,122) - b(k,210) = b(k,210) - lu(k,353) * b(k,123) - b(k,215) = b(k,215) - lu(k,354) * b(k,123) - b(k,216) = b(k,216) - lu(k,355) * b(k,123) - b(k,219) = b(k,219) - lu(k,356) * b(k,123) - b(k,225) = b(k,225) - lu(k,357) * b(k,123) - b(k,213) = b(k,213) - lu(k,359) * b(k,124) - b(k,215) = b(k,215) - lu(k,360) * b(k,124) - b(k,217) = b(k,217) - lu(k,361) * b(k,124) - b(k,218) = b(k,218) - lu(k,362) * b(k,124) - b(k,225) = b(k,225) - lu(k,363) * b(k,124) + b(k,249) = b(k,249) - lu(k,137) * b(k,84) + b(k,259) = b(k,259) - lu(k,138) * b(k,84) + b(k,248) = b(k,248) - lu(k,140) * b(k,85) + b(k,257) = b(k,257) - lu(k,141) * b(k,85) + b(k,249) = b(k,249) - lu(k,143) * b(k,86) + b(k,256) = b(k,256) - lu(k,144) * b(k,86) + b(k,250) = b(k,250) - lu(k,146) * b(k,87) + b(k,257) = b(k,257) - lu(k,147) * b(k,87) + b(k,199) = b(k,199) - lu(k,149) * b(k,88) + b(k,249) = b(k,249) - lu(k,150) * b(k,88) + b(k,259) = b(k,259) - lu(k,151) * b(k,88) + b(k,115) = b(k,115) - lu(k,153) * b(k,89) + b(k,248) = b(k,248) - lu(k,154) * b(k,89) + b(k,257) = b(k,257) - lu(k,155) * b(k,89) + b(k,121) = b(k,121) - lu(k,157) * b(k,90) + b(k,248) = b(k,248) - lu(k,158) * b(k,90) + b(k,257) = b(k,257) - lu(k,159) * b(k,90) + b(k,121) = b(k,121) - lu(k,161) * b(k,91) + b(k,248) = b(k,248) - lu(k,162) * b(k,91) + b(k,257) = b(k,257) - lu(k,163) * b(k,91) + b(k,249) = b(k,249) - lu(k,165) * b(k,92) + b(k,257) = b(k,257) - lu(k,166) * b(k,92) + b(k,259) = b(k,259) - lu(k,167) * b(k,92) + b(k,121) = b(k,121) - lu(k,169) * b(k,93) + b(k,241) = b(k,241) - lu(k,170) * b(k,93) + b(k,248) = b(k,248) - lu(k,171) * b(k,93) + b(k,229) = b(k,229) - lu(k,173) * b(k,94) + b(k,249) = b(k,249) - lu(k,174) * b(k,94) + b(k,167) = b(k,167) - lu(k,176) * b(k,95) + b(k,247) = b(k,247) - lu(k,177) * b(k,95) + b(k,121) = b(k,121) - lu(k,179) * b(k,96) + b(k,241) = b(k,241) - lu(k,180) * b(k,96) + b(k,248) = b(k,248) - lu(k,181) * b(k,96) + b(k,257) = b(k,257) - lu(k,182) * b(k,96) + b(k,121) = b(k,121) - lu(k,184) * b(k,97) + b(k,208) = b(k,208) - lu(k,185) * b(k,97) + b(k,241) = b(k,241) - lu(k,186) * b(k,97) + b(k,248) = b(k,248) - lu(k,187) * b(k,97) + b(k,115) = b(k,115) - lu(k,189) * b(k,98) + b(k,121) = b(k,121) - lu(k,190) * b(k,98) + b(k,248) = b(k,248) - lu(k,191) * b(k,98) + b(k,257) = b(k,257) - lu(k,192) * b(k,98) + b(k,121) = b(k,121) - lu(k,194) * b(k,99) + b(k,208) = b(k,208) - lu(k,195) * b(k,99) + b(k,248) = b(k,248) - lu(k,196) * b(k,99) + b(k,257) = b(k,257) - lu(k,197) * b(k,99) + b(k,126) = b(k,126) - lu(k,199) * b(k,100) + b(k,249) = b(k,249) - lu(k,200) * b(k,100) + b(k,123) = b(k,123) - lu(k,202) * b(k,101) + b(k,259) = b(k,259) - lu(k,203) * b(k,101) + b(k,257) = b(k,257) - lu(k,205) * b(k,102) + b(k,104) = b(k,104) - lu(k,208) * b(k,103) + b(k,105) = b(k,105) - lu(k,209) * b(k,103) + b(k,164) = b(k,164) - lu(k,210) * b(k,103) + b(k,249) = b(k,249) - lu(k,211) * b(k,103) + b(k,256) = b(k,256) - lu(k,212) * b(k,103) + b(k,159) = b(k,159) - lu(k,214) * b(k,104) + b(k,223) = b(k,223) - lu(k,215) * b(k,104) + b(k,256) = b(k,256) - lu(k,216) * b(k,104) + b(k,158) = b(k,158) - lu(k,218) * b(k,105) + b(k,161) = b(k,161) - lu(k,219) * b(k,105) + b(k,249) = b(k,249) - lu(k,220) * b(k,105) + b(k,256) = b(k,256) - lu(k,221) * b(k,105) + b(k,245) = b(k,245) - lu(k,223) * b(k,106) + b(k,248) = b(k,248) - lu(k,224) * b(k,106) + b(k,248) = b(k,248) - lu(k,226) * b(k,107) + b(k,249) = b(k,249) - lu(k,227) * b(k,107) + b(k,256) = b(k,256) - lu(k,228) * b(k,107) + b(k,109) = b(k,109) - lu(k,231) * b(k,108) + b(k,110) = b(k,110) - lu(k,232) * b(k,108) + b(k,155) = b(k,155) - lu(k,233) * b(k,108) + b(k,193) = b(k,193) - lu(k,234) * b(k,108) + b(k,249) = b(k,249) - lu(k,235) * b(k,108) + b(k,256) = b(k,256) - lu(k,236) * b(k,108) + b(k,158) = b(k,158) - lu(k,238) * b(k,109) + b(k,161) = b(k,161) - lu(k,239) * b(k,109) + b(k,249) = b(k,249) - lu(k,240) * b(k,109) + b(k,256) = b(k,256) - lu(k,241) * b(k,109) + b(k,223) = b(k,223) - lu(k,243) * b(k,110) + b(k,239) = b(k,239) - lu(k,244) * b(k,110) + b(k,256) = b(k,256) - lu(k,245) * b(k,110) + b(k,229) = b(k,229) - lu(k,247) * b(k,111) + b(k,249) = b(k,249) - lu(k,248) * b(k,111) + b(k,113) = b(k,113) - lu(k,252) * b(k,112) + b(k,155) = b(k,155) - lu(k,253) * b(k,112) + b(k,194) = b(k,194) - lu(k,254) * b(k,112) + b(k,223) = b(k,223) - lu(k,255) * b(k,112) + b(k,239) = b(k,239) - lu(k,256) * b(k,112) + b(k,249) = b(k,249) - lu(k,257) * b(k,112) + b(k,256) = b(k,256) - lu(k,258) * b(k,112) + b(k,161) = b(k,161) - lu(k,260) * b(k,113) + b(k,165) = b(k,165) - lu(k,261) * b(k,113) + b(k,249) = b(k,249) - lu(k,262) * b(k,113) + b(k,256) = b(k,256) - lu(k,263) * b(k,113) + b(k,115) = b(k,115) - lu(k,265) * b(k,114) + b(k,248) = b(k,248) - lu(k,266) * b(k,114) + b(k,249) = b(k,249) - lu(k,267) * b(k,114) + b(k,257) = b(k,257) - lu(k,268) * b(k,114) + b(k,208) = b(k,208) - lu(k,270) * b(k,115) + b(k,248) = b(k,248) - lu(k,271) * b(k,115) + b(k,257) = b(k,257) - lu(k,272) * b(k,115) + b(k,210) = b(k,210) - lu(k,274) * b(k,116) + b(k,249) = b(k,249) - lu(k,275) * b(k,116) + b(k,243) = b(k,243) - lu(k,277) * b(k,117) + b(k,247) = b(k,247) - lu(k,278) * b(k,117) + b(k,241) = b(k,241) - lu(k,280) * b(k,118) + b(k,257) = b(k,257) - lu(k,281) * b(k,118) + b(k,167) = b(k,167) - lu(k,283) * b(k,119) + b(k,249) = b(k,249) - lu(k,284) * b(k,119) + b(k,121) = b(k,121) - lu(k,286) * b(k,120) + b(k,248) = b(k,248) - lu(k,287) * b(k,120) + b(k,249) = b(k,249) - lu(k,288) * b(k,120) + b(k,257) = b(k,257) - lu(k,289) * b(k,120) + b(k,208) = b(k,208) - lu(k,291) * b(k,121) + b(k,248) = b(k,248) - lu(k,292) * b(k,121) + b(k,181) = b(k,181) - lu(k,294) * b(k,122) + b(k,229) = b(k,229) - lu(k,295) * b(k,122) + b(k,249) = b(k,249) - lu(k,296) * b(k,122) + b(k,256) = b(k,256) - lu(k,297) * b(k,122) + b(k,206) = b(k,206) - lu(k,300) * b(k,123) + b(k,252) = b(k,252) - lu(k,301) * b(k,123) + b(k,259) = b(k,259) - lu(k,302) * b(k,123) + b(k,222) = b(k,222) - lu(k,304) * b(k,124) + b(k,249) = b(k,249) - lu(k,305) * b(k,124) + b(k,256) = b(k,256) - lu(k,306) * b(k,124) + b(k,161) = b(k,161) - lu(k,308) * b(k,125) + b(k,183) = b(k,183) - lu(k,309) * b(k,125) + b(k,249) = b(k,249) - lu(k,310) * b(k,125) + b(k,224) = b(k,224) - lu(k,312) * b(k,126) + b(k,253) = b(k,253) - lu(k,313) * b(k,126) + b(k,256) = b(k,256) - lu(k,314) * b(k,126) + b(k,195) = b(k,195) - lu(k,316) * b(k,127) + b(k,256) = b(k,256) - lu(k,317) * b(k,127) + b(k,206) = b(k,206) - lu(k,319) * b(k,128) + b(k,243) = b(k,243) - lu(k,320) * b(k,128) + b(k,249) = b(k,249) - lu(k,321) * b(k,128) + b(k,254) = b(k,254) - lu(k,322) * b(k,128) + b(k,256) = b(k,256) - lu(k,323) * b(k,128) + b(k,213) = b(k,213) - lu(k,325) * b(k,129) + b(k,215) = b(k,215) - lu(k,326) * b(k,129) + b(k,223) = b(k,223) - lu(k,327) * b(k,129) + b(k,249) = b(k,249) - lu(k,328) * b(k,129) + b(k,256) = b(k,256) - lu(k,329) * b(k,129) + b(k,202) = b(k,202) - lu(k,331) * b(k,130) + b(k,249) = b(k,249) - lu(k,332) * b(k,130) + b(k,251) = b(k,251) - lu(k,333) * b(k,130) + b(k,257) = b(k,257) - lu(k,334) * b(k,130) + b(k,259) = b(k,259) - lu(k,335) * b(k,130) + b(k,208) = b(k,208) - lu(k,337) * b(k,131) + b(k,244) = b(k,244) - lu(k,338) * b(k,131) + b(k,208) = b(k,208) - lu(k,341) * b(k,132) + b(k,248) = b(k,248) - lu(k,342) * b(k,132) + b(k,249) = b(k,249) - lu(k,343) * b(k,132) + b(k,257) = b(k,257) - lu(k,344) * b(k,132) + b(k,259) = b(k,259) - lu(k,345) * b(k,132) + b(k,243) = b(k,243) - lu(k,347) * b(k,133) + b(k,245) = b(k,245) - lu(k,348) * b(k,133) + b(k,247) = b(k,247) - lu(k,349) * b(k,133) + b(k,252) = b(k,252) - lu(k,350) * b(k,133) + b(k,254) = b(k,254) - lu(k,351) * b(k,133) + b(k,187) = b(k,187) - lu(k,353) * b(k,134) + b(k,222) = b(k,222) - lu(k,354) * b(k,134) + b(k,239) = b(k,239) - lu(k,355) * b(k,134) + b(k,249) = b(k,249) - lu(k,356) * b(k,134) + b(k,223) = b(k,223) - lu(k,358) * b(k,135) + b(k,232) = b(k,232) - lu(k,359) * b(k,135) + b(k,239) = b(k,239) - lu(k,360) * b(k,135) + b(k,256) = b(k,256) - lu(k,361) * b(k,135) + b(k,206) = b(k,206) - lu(k,363) * b(k,136) + b(k,233) = b(k,233) - lu(k,364) * b(k,136) + b(k,250) = b(k,250) - lu(k,365) * b(k,136) + b(k,252) = b(k,252) - lu(k,366) * b(k,136) + b(k,158) = b(k,158) - lu(k,368) * b(k,137) + b(k,213) = b(k,213) - lu(k,369) * b(k,137) + b(k,249) = b(k,249) - lu(k,370) * b(k,137) + b(k,256) = b(k,256) - lu(k,371) * b(k,137) + b(k,155) = b(k,155) - lu(k,374) * b(k,138) + b(k,167) = b(k,167) - lu(k,375) * b(k,138) + b(k,249) = b(k,249) - lu(k,376) * b(k,138) + b(k,256) = b(k,256) - lu(k,377) * b(k,138) + b(k,202) = b(k,202) - lu(k,379) * b(k,139) + b(k,222) = b(k,222) - lu(k,380) * b(k,139) + b(k,249) = b(k,249) - lu(k,381) * b(k,139) + b(k,256) = b(k,256) - lu(k,382) * b(k,139) + b(k,229) = b(k,229) - lu(k,384) * b(k,140) + b(k,249) = b(k,249) - lu(k,385) * b(k,140) + b(k,236) = b(k,236) - lu(k,387) * b(k,141) + b(k,238) = b(k,238) - lu(k,388) * b(k,141) + b(k,249) = b(k,249) - lu(k,389) * b(k,141) + b(k,256) = b(k,256) - lu(k,390) * b(k,141) + b(k,168) = b(k,168) - lu(k,392) * b(k,142) + b(k,206) = b(k,206) - lu(k,393) * b(k,142) + b(k,223) = b(k,223) - lu(k,394) * b(k,142) + b(k,233) = b(k,233) - lu(k,395) * b(k,142) + b(k,244) = b(k,244) - lu(k,396) * b(k,142) + b(k,249) = b(k,249) - lu(k,397) * b(k,142) + b(k,252) = b(k,252) - lu(k,398) * b(k,142) + b(k,174) = b(k,174) - lu(k,400) * b(k,143) + b(k,212) = b(k,212) - lu(k,401) * b(k,143) + b(k,222) = b(k,222) - lu(k,402) * b(k,143) + b(k,247) = b(k,247) - lu(k,403) * b(k,143) + b(k,249) = b(k,249) - lu(k,404) * b(k,143) + b(k,253) = b(k,253) - lu(k,405) * b(k,143) + b(k,254) = b(k,254) - lu(k,406) * b(k,143) end do end subroutine lu_slv01 subroutine lu_slv02( avec_len, lu, b ) @@ -242,207 +245,210 @@ subroutine lu_slv02( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,210) = b(k,210) - lu(k,365) * b(k,125) - b(k,211) = b(k,211) - lu(k,366) * b(k,125) - b(k,215) = b(k,215) - lu(k,367) * b(k,125) - b(k,217) = b(k,217) - lu(k,368) * b(k,125) - b(k,223) = b(k,223) - lu(k,369) * b(k,125) - b(k,135) = b(k,135) - lu(k,371) * b(k,126) - b(k,177) = b(k,177) - lu(k,372) * b(k,126) - b(k,200) = b(k,200) - lu(k,373) * b(k,126) - b(k,213) = b(k,213) - lu(k,374) * b(k,126) - b(k,215) = b(k,215) - lu(k,375) * b(k,126) - b(k,139) = b(k,139) - lu(k,379) * b(k,127) - b(k,211) = b(k,211) - lu(k,380) * b(k,127) - b(k,213) = b(k,213) - lu(k,381) * b(k,127) - b(k,215) = b(k,215) - lu(k,382) * b(k,127) - b(k,217) = b(k,217) - lu(k,383) * b(k,127) - b(k,168) = b(k,168) - lu(k,385) * b(k,128) - b(k,211) = b(k,211) - lu(k,386) * b(k,128) - b(k,213) = b(k,213) - lu(k,387) * b(k,128) - b(k,216) = b(k,216) - lu(k,388) * b(k,128) - b(k,217) = b(k,217) - lu(k,389) * b(k,128) - b(k,177) = b(k,177) - lu(k,392) * b(k,129) - b(k,211) = b(k,211) - lu(k,393) * b(k,129) - b(k,213) = b(k,213) - lu(k,394) * b(k,129) - b(k,215) = b(k,215) - lu(k,395) * b(k,129) - b(k,217) = b(k,217) - lu(k,396) * b(k,129) - b(k,160) = b(k,160) - lu(k,398) * b(k,130) - b(k,213) = b(k,213) - lu(k,399) * b(k,130) - b(k,153) = b(k,153) - lu(k,401) * b(k,131) - b(k,217) = b(k,217) - lu(k,402) * b(k,131) - b(k,220) = b(k,220) - lu(k,403) * b(k,131) - b(k,207) = b(k,207) - lu(k,405) * b(k,132) - b(k,215) = b(k,215) - lu(k,406) * b(k,132) - b(k,216) = b(k,216) - lu(k,407) * b(k,132) - b(k,217) = b(k,217) - lu(k,408) * b(k,132) - b(k,218) = b(k,218) - lu(k,409) * b(k,132) - b(k,219) = b(k,219) - lu(k,410) * b(k,132) - b(k,181) = b(k,181) - lu(k,412) * b(k,133) - b(k,183) = b(k,183) - lu(k,413) * b(k,133) - b(k,191) = b(k,191) - lu(k,414) * b(k,133) - b(k,213) = b(k,213) - lu(k,415) * b(k,133) - b(k,215) = b(k,215) - lu(k,416) * b(k,133) - b(k,216) = b(k,216) - lu(k,417) * b(k,133) - b(k,160) = b(k,160) - lu(k,421) * b(k,134) - b(k,177) = b(k,177) - lu(k,422) * b(k,134) - b(k,211) = b(k,211) - lu(k,423) * b(k,134) - b(k,213) = b(k,213) - lu(k,424) * b(k,134) - b(k,215) = b(k,215) - lu(k,425) * b(k,134) - b(k,217) = b(k,217) - lu(k,426) * b(k,134) - b(k,177) = b(k,177) - lu(k,429) * b(k,135) - b(k,200) = b(k,200) - lu(k,430) * b(k,135) - b(k,211) = b(k,211) - lu(k,431) * b(k,135) - b(k,213) = b(k,213) - lu(k,432) * b(k,135) - b(k,215) = b(k,215) - lu(k,433) * b(k,135) - b(k,217) = b(k,217) - lu(k,434) * b(k,135) - b(k,207) = b(k,207) - lu(k,436) * b(k,136) - b(k,215) = b(k,215) - lu(k,437) * b(k,136) - b(k,216) = b(k,216) - lu(k,438) * b(k,136) - b(k,219) = b(k,219) - lu(k,439) * b(k,136) - b(k,225) = b(k,225) - lu(k,440) * b(k,136) - b(k,201) = b(k,201) - lu(k,442) * b(k,137) - b(k,210) = b(k,210) - lu(k,443) * b(k,137) - b(k,215) = b(k,215) - lu(k,444) * b(k,137) - b(k,220) = b(k,220) - lu(k,445) * b(k,137) - b(k,223) = b(k,223) - lu(k,446) * b(k,137) - b(k,156) = b(k,156) - lu(k,448) * b(k,138) - b(k,172) = b(k,172) - lu(k,449) * b(k,138) - b(k,207) = b(k,207) - lu(k,450) * b(k,138) - b(k,215) = b(k,215) - lu(k,451) * b(k,138) - b(k,153) = b(k,153) - lu(k,454) * b(k,139) - b(k,211) = b(k,211) - lu(k,455) * b(k,139) - b(k,213) = b(k,213) - lu(k,456) * b(k,139) - b(k,215) = b(k,215) - lu(k,457) * b(k,139) - b(k,217) = b(k,217) - lu(k,458) * b(k,139) - b(k,164) = b(k,164) - lu(k,460) * b(k,140) - b(k,190) = b(k,190) - lu(k,461) * b(k,140) - b(k,195) = b(k,195) - lu(k,462) * b(k,140) - b(k,213) = b(k,213) - lu(k,463) * b(k,140) - b(k,215) = b(k,215) - lu(k,464) * b(k,140) - b(k,216) = b(k,216) - lu(k,465) * b(k,140) - b(k,225) = b(k,225) - lu(k,466) * b(k,140) - b(k,215) = b(k,215) - lu(k,468) * b(k,141) - b(k,219) = b(k,219) - lu(k,469) * b(k,141) - b(k,225) = b(k,225) - lu(k,470) * b(k,141) - b(k,173) = b(k,173) - lu(k,472) * b(k,142) - b(k,186) = b(k,186) - lu(k,473) * b(k,142) - b(k,187) = b(k,187) - lu(k,474) * b(k,142) - b(k,190) = b(k,190) - lu(k,475) * b(k,142) - b(k,209) = b(k,209) - lu(k,476) * b(k,142) - b(k,213) = b(k,213) - lu(k,477) * b(k,142) - b(k,215) = b(k,215) - lu(k,478) * b(k,142) - b(k,190) = b(k,190) - lu(k,480) * b(k,143) - b(k,206) = b(k,206) - lu(k,481) * b(k,143) - b(k,213) = b(k,213) - lu(k,482) * b(k,143) - b(k,215) = b(k,215) - lu(k,483) * b(k,143) - b(k,216) = b(k,216) - lu(k,484) * b(k,143) - b(k,217) = b(k,217) - lu(k,485) * b(k,143) - b(k,218) = b(k,218) - lu(k,486) * b(k,143) - b(k,159) = b(k,159) - lu(k,488) * b(k,144) - b(k,168) = b(k,168) - lu(k,489) * b(k,144) - b(k,189) = b(k,189) - lu(k,490) * b(k,144) - b(k,213) = b(k,213) - lu(k,491) * b(k,144) - b(k,215) = b(k,215) - lu(k,492) * b(k,144) - b(k,216) = b(k,216) - lu(k,493) * b(k,144) - b(k,220) = b(k,220) - lu(k,494) * b(k,144) - b(k,181) = b(k,181) - lu(k,496) * b(k,145) - b(k,187) = b(k,187) - lu(k,497) * b(k,145) - b(k,195) = b(k,195) - lu(k,498) * b(k,145) - b(k,211) = b(k,211) - lu(k,499) * b(k,145) - b(k,213) = b(k,213) - lu(k,500) * b(k,145) - b(k,216) = b(k,216) - lu(k,501) * b(k,145) - b(k,217) = b(k,217) - lu(k,502) * b(k,145) - b(k,165) = b(k,165) - lu(k,504) * b(k,146) - b(k,208) = b(k,208) - lu(k,505) * b(k,146) - b(k,209) = b(k,209) - lu(k,506) * b(k,146) - b(k,217) = b(k,217) - lu(k,507) * b(k,146) - b(k,218) = b(k,218) - lu(k,508) * b(k,146) - b(k,221) = b(k,221) - lu(k,509) * b(k,146) - b(k,223) = b(k,223) - lu(k,510) * b(k,146) - b(k,186) = b(k,186) - lu(k,512) * b(k,147) - b(k,187) = b(k,187) - lu(k,513) * b(k,147) - b(k,190) = b(k,190) - lu(k,514) * b(k,147) - b(k,209) = b(k,209) - lu(k,515) * b(k,147) - b(k,213) = b(k,213) - lu(k,516) * b(k,147) - b(k,215) = b(k,215) - lu(k,517) * b(k,147) - b(k,216) = b(k,216) - lu(k,518) * b(k,147) - b(k,217) = b(k,217) - lu(k,519) * b(k,147) - b(k,212) = b(k,212) - lu(k,521) * b(k,148) - b(k,213) = b(k,213) - lu(k,522) * b(k,148) - b(k,215) = b(k,215) - lu(k,523) * b(k,148) - b(k,223) = b(k,223) - lu(k,524) * b(k,148) - b(k,224) = b(k,224) - lu(k,525) * b(k,148) - b(k,225) = b(k,225) - lu(k,526) * b(k,148) - b(k,181) = b(k,181) - lu(k,528) * b(k,149) - b(k,186) = b(k,186) - lu(k,529) * b(k,149) - b(k,188) = b(k,188) - lu(k,530) * b(k,149) - b(k,189) = b(k,189) - lu(k,531) * b(k,149) - b(k,192) = b(k,192) - lu(k,532) * b(k,149) - b(k,213) = b(k,213) - lu(k,533) * b(k,149) - b(k,215) = b(k,215) - lu(k,534) * b(k,149) - b(k,216) = b(k,216) - lu(k,535) * b(k,149) - b(k,151) = b(k,151) - lu(k,539) * b(k,150) - b(k,160) = b(k,160) - lu(k,540) * b(k,150) - b(k,161) = b(k,161) - lu(k,541) * b(k,150) - b(k,163) = b(k,163) - lu(k,542) * b(k,150) - b(k,177) = b(k,177) - lu(k,543) * b(k,150) - b(k,200) = b(k,200) - lu(k,544) * b(k,150) - b(k,213) = b(k,213) - lu(k,545) * b(k,150) - b(k,215) = b(k,215) - lu(k,546) * b(k,150) - b(k,176) = b(k,176) - lu(k,548) * b(k,151) - b(k,189) = b(k,189) - lu(k,549) * b(k,151) - b(k,213) = b(k,213) - lu(k,550) * b(k,151) - b(k,183) = b(k,183) - lu(k,552) * b(k,152) - b(k,209) = b(k,209) - lu(k,553) * b(k,152) - b(k,213) = b(k,213) - lu(k,554) * b(k,152) - b(k,215) = b(k,215) - lu(k,555) * b(k,152) - b(k,217) = b(k,217) - lu(k,556) * b(k,152) - b(k,211) = b(k,211) - lu(k,560) * b(k,153) - b(k,213) = b(k,213) - lu(k,561) * b(k,153) - b(k,215) = b(k,215) - lu(k,562) * b(k,153) - b(k,217) = b(k,217) - lu(k,563) * b(k,153) - b(k,220) = b(k,220) - lu(k,564) * b(k,153) - b(k,156) = b(k,156) - lu(k,567) * b(k,154) - b(k,172) = b(k,172) - lu(k,568) * b(k,154) - b(k,181) = b(k,181) - lu(k,569) * b(k,154) - b(k,195) = b(k,195) - lu(k,570) * b(k,154) - b(k,207) = b(k,207) - lu(k,571) * b(k,154) - b(k,213) = b(k,213) - lu(k,572) * b(k,154) - b(k,215) = b(k,215) - lu(k,573) * b(k,154) - b(k,216) = b(k,216) - lu(k,574) * b(k,154) - b(k,217) = b(k,217) - lu(k,575) * b(k,154) - b(k,156) = b(k,156) - lu(k,578) * b(k,155) - b(k,172) = b(k,172) - lu(k,579) * b(k,155) - b(k,180) = b(k,180) - lu(k,580) * b(k,155) - b(k,181) = b(k,181) - lu(k,581) * b(k,155) - b(k,195) = b(k,195) - lu(k,582) * b(k,155) - b(k,207) = b(k,207) - lu(k,583) * b(k,155) - b(k,213) = b(k,213) - lu(k,584) * b(k,155) - b(k,215) = b(k,215) - lu(k,585) * b(k,155) - b(k,216) = b(k,216) - lu(k,586) * b(k,155) - b(k,195) = b(k,195) - lu(k,589) * b(k,156) - b(k,207) = b(k,207) - lu(k,590) * b(k,156) - b(k,211) = b(k,211) - lu(k,591) * b(k,156) - b(k,213) = b(k,213) - lu(k,592) * b(k,156) - b(k,215) = b(k,215) - lu(k,593) * b(k,156) - b(k,217) = b(k,217) - lu(k,594) * b(k,156) - b(k,197) = b(k,197) - lu(k,597) * b(k,157) - b(k,199) = b(k,199) - lu(k,598) * b(k,157) - b(k,203) = b(k,203) - lu(k,599) * b(k,157) - b(k,213) = b(k,213) - lu(k,600) * b(k,157) - b(k,215) = b(k,215) - lu(k,601) * b(k,157) - b(k,216) = b(k,216) - lu(k,602) * b(k,157) - b(k,160) = b(k,160) - lu(k,608) * b(k,158) - b(k,162) = b(k,162) - lu(k,609) * b(k,158) - b(k,163) = b(k,163) - lu(k,610) * b(k,158) - b(k,176) = b(k,176) - lu(k,611) * b(k,158) - b(k,177) = b(k,177) - lu(k,612) * b(k,158) - b(k,189) = b(k,189) - lu(k,613) * b(k,158) - b(k,200) = b(k,200) - lu(k,614) * b(k,158) - b(k,207) = b(k,207) - lu(k,615) * b(k,158) - b(k,213) = b(k,213) - lu(k,616) * b(k,158) - b(k,215) = b(k,215) - lu(k,617) * b(k,158) + b(k,223) = b(k,223) - lu(k,408) * b(k,144) + b(k,246) = b(k,246) - lu(k,409) * b(k,144) + b(k,249) = b(k,249) - lu(k,410) * b(k,144) + b(k,251) = b(k,251) - lu(k,411) * b(k,144) + b(k,256) = b(k,256) - lu(k,412) * b(k,144) + b(k,257) = b(k,257) - lu(k,413) * b(k,144) + b(k,259) = b(k,259) - lu(k,414) * b(k,144) + b(k,226) = b(k,226) - lu(k,416) * b(k,145) + b(k,239) = b(k,239) - lu(k,417) * b(k,145) + b(k,249) = b(k,249) - lu(k,418) * b(k,145) + b(k,253) = b(k,253) - lu(k,419) * b(k,145) + b(k,259) = b(k,259) - lu(k,420) * b(k,145) + b(k,159) = b(k,159) - lu(k,422) * b(k,146) + b(k,164) = b(k,164) - lu(k,423) * b(k,146) + b(k,213) = b(k,213) - lu(k,424) * b(k,146) + b(k,249) = b(k,249) - lu(k,425) * b(k,146) + b(k,256) = b(k,256) - lu(k,426) * b(k,146) + b(k,199) = b(k,199) - lu(k,428) * b(k,147) + b(k,212) = b(k,212) - lu(k,429) * b(k,147) + b(k,249) = b(k,249) - lu(k,430) * b(k,147) + b(k,256) = b(k,256) - lu(k,431) * b(k,147) + b(k,259) = b(k,259) - lu(k,432) * b(k,147) + b(k,189) = b(k,189) - lu(k,434) * b(k,148) + b(k,205) = b(k,205) - lu(k,435) * b(k,148) + b(k,247) = b(k,247) - lu(k,436) * b(k,148) + b(k,249) = b(k,249) - lu(k,437) * b(k,148) + b(k,256) = b(k,256) - lu(k,438) * b(k,148) + b(k,205) = b(k,205) - lu(k,440) * b(k,149) + b(k,224) = b(k,224) - lu(k,441) * b(k,149) + b(k,243) = b(k,243) - lu(k,442) * b(k,149) + b(k,249) = b(k,249) - lu(k,443) * b(k,149) + b(k,256) = b(k,256) - lu(k,444) * b(k,149) + b(k,247) = b(k,247) - lu(k,446) * b(k,150) + b(k,249) = b(k,249) - lu(k,447) * b(k,150) + b(k,254) = b(k,254) - lu(k,448) * b(k,150) + b(k,256) = b(k,256) - lu(k,449) * b(k,150) + b(k,259) = b(k,259) - lu(k,450) * b(k,150) + b(k,244) = b(k,244) - lu(k,452) * b(k,151) + b(k,246) = b(k,246) - lu(k,453) * b(k,151) + b(k,249) = b(k,249) - lu(k,454) * b(k,151) + b(k,253) = b(k,253) - lu(k,455) * b(k,151) + b(k,259) = b(k,259) - lu(k,456) * b(k,151) + b(k,241) = b(k,241) - lu(k,458) * b(k,152) + b(k,248) = b(k,248) - lu(k,459) * b(k,152) + b(k,249) = b(k,249) - lu(k,460) * b(k,152) + b(k,251) = b(k,251) - lu(k,461) * b(k,152) + b(k,257) = b(k,257) - lu(k,462) * b(k,152) + b(k,216) = b(k,216) - lu(k,464) * b(k,153) + b(k,220) = b(k,220) - lu(k,465) * b(k,153) + b(k,243) = b(k,243) - lu(k,466) * b(k,153) + b(k,247) = b(k,247) - lu(k,467) * b(k,153) + b(k,249) = b(k,249) - lu(k,468) * b(k,153) + b(k,165) = b(k,165) - lu(k,470) * b(k,154) + b(k,213) = b(k,213) - lu(k,471) * b(k,154) + b(k,232) = b(k,232) - lu(k,472) * b(k,154) + b(k,249) = b(k,249) - lu(k,473) * b(k,154) + b(k,256) = b(k,256) - lu(k,474) * b(k,154) + b(k,167) = b(k,167) - lu(k,478) * b(k,155) + b(k,245) = b(k,245) - lu(k,479) * b(k,155) + b(k,247) = b(k,247) - lu(k,480) * b(k,155) + b(k,249) = b(k,249) - lu(k,481) * b(k,155) + b(k,256) = b(k,256) - lu(k,482) * b(k,155) + b(k,213) = b(k,213) - lu(k,484) * b(k,156) + b(k,223) = b(k,223) - lu(k,485) * b(k,156) + b(k,232) = b(k,232) - lu(k,486) * b(k,156) + b(k,239) = b(k,239) - lu(k,487) * b(k,156) + b(k,256) = b(k,256) - lu(k,488) * b(k,156) + b(k,215) = b(k,215) - lu(k,490) * b(k,157) + b(k,245) = b(k,245) - lu(k,491) * b(k,157) + b(k,247) = b(k,247) - lu(k,492) * b(k,157) + b(k,253) = b(k,253) - lu(k,493) * b(k,157) + b(k,256) = b(k,256) - lu(k,494) * b(k,157) + b(k,213) = b(k,213) - lu(k,497) * b(k,158) + b(k,245) = b(k,245) - lu(k,498) * b(k,158) + b(k,247) = b(k,247) - lu(k,499) * b(k,158) + b(k,249) = b(k,249) - lu(k,500) * b(k,158) + b(k,256) = b(k,256) - lu(k,501) * b(k,158) + b(k,192) = b(k,192) - lu(k,503) * b(k,159) + b(k,256) = b(k,256) - lu(k,504) * b(k,159) + b(k,244) = b(k,244) - lu(k,507) * b(k,160) + b(k,245) = b(k,245) - lu(k,508) * b(k,160) + b(k,247) = b(k,247) - lu(k,509) * b(k,160) + b(k,248) = b(k,248) - lu(k,510) * b(k,160) + b(k,249) = b(k,249) - lu(k,511) * b(k,160) + b(k,252) = b(k,252) - lu(k,512) * b(k,160) + b(k,183) = b(k,183) - lu(k,514) * b(k,161) + b(k,247) = b(k,247) - lu(k,515) * b(k,161) + b(k,258) = b(k,258) - lu(k,516) * b(k,161) + b(k,241) = b(k,241) - lu(k,518) * b(k,162) + b(k,248) = b(k,248) - lu(k,519) * b(k,162) + b(k,249) = b(k,249) - lu(k,520) * b(k,162) + b(k,251) = b(k,251) - lu(k,521) * b(k,162) + b(k,257) = b(k,257) - lu(k,522) * b(k,162) + b(k,259) = b(k,259) - lu(k,523) * b(k,162) + b(k,211) = b(k,211) - lu(k,525) * b(k,163) + b(k,212) = b(k,212) - lu(k,526) * b(k,163) + b(k,216) = b(k,216) - lu(k,527) * b(k,163) + b(k,249) = b(k,249) - lu(k,528) * b(k,163) + b(k,253) = b(k,253) - lu(k,529) * b(k,163) + b(k,256) = b(k,256) - lu(k,530) * b(k,163) + b(k,192) = b(k,192) - lu(k,534) * b(k,164) + b(k,213) = b(k,213) - lu(k,535) * b(k,164) + b(k,245) = b(k,245) - lu(k,536) * b(k,164) + b(k,247) = b(k,247) - lu(k,537) * b(k,164) + b(k,249) = b(k,249) - lu(k,538) * b(k,164) + b(k,256) = b(k,256) - lu(k,539) * b(k,164) + b(k,213) = b(k,213) - lu(k,542) * b(k,165) + b(k,232) = b(k,232) - lu(k,543) * b(k,165) + b(k,245) = b(k,245) - lu(k,544) * b(k,165) + b(k,247) = b(k,247) - lu(k,545) * b(k,165) + b(k,249) = b(k,249) - lu(k,546) * b(k,165) + b(k,256) = b(k,256) - lu(k,547) * b(k,165) + b(k,187) = b(k,187) - lu(k,549) * b(k,166) + b(k,202) = b(k,202) - lu(k,550) * b(k,166) + b(k,239) = b(k,239) - lu(k,551) * b(k,166) + b(k,249) = b(k,249) - lu(k,552) * b(k,166) + b(k,183) = b(k,183) - lu(k,555) * b(k,167) + b(k,245) = b(k,245) - lu(k,556) * b(k,167) + b(k,247) = b(k,247) - lu(k,557) * b(k,167) + b(k,249) = b(k,249) - lu(k,558) * b(k,167) + b(k,256) = b(k,256) - lu(k,559) * b(k,167) + b(k,233) = b(k,233) - lu(k,561) * b(k,168) + b(k,244) = b(k,244) - lu(k,562) * b(k,168) + b(k,249) = b(k,249) - lu(k,563) * b(k,168) + b(k,252) = b(k,252) - lu(k,564) * b(k,168) + b(k,258) = b(k,258) - lu(k,565) * b(k,168) + b(k,203) = b(k,203) - lu(k,567) * b(k,169) + b(k,239) = b(k,239) - lu(k,568) * b(k,169) + b(k,246) = b(k,246) - lu(k,569) * b(k,169) + b(k,247) = b(k,247) - lu(k,570) * b(k,169) + b(k,249) = b(k,249) - lu(k,571) * b(k,169) + b(k,253) = b(k,253) - lu(k,572) * b(k,169) + b(k,254) = b(k,254) - lu(k,573) * b(k,169) + b(k,197) = b(k,197) - lu(k,575) * b(k,170) + b(k,241) = b(k,241) - lu(k,576) * b(k,170) + b(k,243) = b(k,243) - lu(k,577) * b(k,170) + b(k,247) = b(k,247) - lu(k,578) * b(k,170) + b(k,252) = b(k,252) - lu(k,579) * b(k,170) + b(k,254) = b(k,254) - lu(k,580) * b(k,170) + b(k,255) = b(k,255) - lu(k,581) * b(k,170) + b(k,205) = b(k,205) - lu(k,583) * b(k,171) + b(k,224) = b(k,224) - lu(k,584) * b(k,171) + b(k,227) = b(k,227) - lu(k,585) * b(k,171) + b(k,228) = b(k,228) - lu(k,586) * b(k,171) + b(k,243) = b(k,243) - lu(k,587) * b(k,171) + b(k,249) = b(k,249) - lu(k,588) * b(k,171) + b(k,256) = b(k,256) - lu(k,589) * b(k,171) + b(k,196) = b(k,196) - lu(k,591) * b(k,172) + b(k,222) = b(k,222) - lu(k,592) * b(k,172) + b(k,227) = b(k,227) - lu(k,593) * b(k,172) + b(k,249) = b(k,249) - lu(k,594) * b(k,172) + b(k,253) = b(k,253) - lu(k,595) * b(k,172) + b(k,256) = b(k,256) - lu(k,596) * b(k,172) + b(k,259) = b(k,259) - lu(k,597) * b(k,172) + b(k,191) = b(k,191) - lu(k,599) * b(k,173) + b(k,215) = b(k,215) - lu(k,600) * b(k,173) + b(k,223) = b(k,223) - lu(k,601) * b(k,173) + b(k,249) = b(k,249) - lu(k,602) * b(k,173) + b(k,253) = b(k,253) - lu(k,603) * b(k,173) + b(k,256) = b(k,256) - lu(k,604) * b(k,173) + b(k,258) = b(k,258) - lu(k,605) * b(k,173) + b(k,212) = b(k,212) - lu(k,607) * b(k,174) + b(k,222) = b(k,222) - lu(k,608) * b(k,174) + b(k,228) = b(k,228) - lu(k,609) * b(k,174) + b(k,245) = b(k,245) - lu(k,610) * b(k,174) + b(k,247) = b(k,247) - lu(k,611) * b(k,174) + b(k,253) = b(k,253) - lu(k,612) * b(k,174) + b(k,256) = b(k,256) - lu(k,613) * b(k,174) + b(k,241) = b(k,241) - lu(k,615) * b(k,175) + b(k,246) = b(k,246) - lu(k,616) * b(k,175) + b(k,248) = b(k,248) - lu(k,617) * b(k,175) + b(k,249) = b(k,249) - lu(k,618) * b(k,175) + b(k,251) = b(k,251) - lu(k,619) * b(k,175) + b(k,256) = b(k,256) - lu(k,620) * b(k,175) + b(k,257) = b(k,257) - lu(k,621) * b(k,175) + b(k,259) = b(k,259) - lu(k,622) * b(k,175) + b(k,203) = b(k,203) - lu(k,624) * b(k,176) + b(k,239) = b(k,239) - lu(k,625) * b(k,176) + b(k,246) = b(k,246) - lu(k,626) * b(k,176) + b(k,249) = b(k,249) - lu(k,627) * b(k,176) + b(k,253) = b(k,253) - lu(k,628) * b(k,176) + b(k,259) = b(k,259) - lu(k,629) * b(k,176) + b(k,203) = b(k,203) - lu(k,631) * b(k,177) + b(k,227) = b(k,227) - lu(k,632) * b(k,177) + b(k,238) = b(k,238) - lu(k,633) * b(k,177) + b(k,247) = b(k,247) - lu(k,634) * b(k,177) + b(k,249) = b(k,249) - lu(k,635) * b(k,177) + b(k,253) = b(k,253) - lu(k,636) * b(k,177) + b(k,254) = b(k,254) - lu(k,637) * b(k,177) + b(k,256) = b(k,256) - lu(k,638) * b(k,177) + b(k,249) = b(k,249) - lu(k,640) * b(k,178) + b(k,251) = b(k,251) - lu(k,641) * b(k,178) + b(k,252) = b(k,252) - lu(k,642) * b(k,178) + b(k,256) = b(k,256) - lu(k,643) * b(k,178) + b(k,257) = b(k,257) - lu(k,644) * b(k,178) + b(k,259) = b(k,259) - lu(k,645) * b(k,178) + b(k,181) = b(k,181) - lu(k,649) * b(k,179) + b(k,192) = b(k,192) - lu(k,650) * b(k,179) + b(k,193) = b(k,193) - lu(k,651) * b(k,179) + b(k,195) = b(k,195) - lu(k,652) * b(k,179) + b(k,213) = b(k,213) - lu(k,653) * b(k,179) + b(k,232) = b(k,232) - lu(k,654) * b(k,179) + b(k,249) = b(k,249) - lu(k,655) * b(k,179) + b(k,256) = b(k,256) - lu(k,656) * b(k,179) end do end subroutine lu_slv02 subroutine lu_slv03( avec_len, lu, b ) @@ -463,212 +469,207 @@ subroutine lu_slv03( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,186) = b(k,186) - lu(k,621) * b(k,159) - b(k,211) = b(k,211) - lu(k,622) * b(k,159) - b(k,213) = b(k,213) - lu(k,623) * b(k,159) - b(k,215) = b(k,215) - lu(k,624) * b(k,159) - b(k,216) = b(k,216) - lu(k,625) * b(k,159) - b(k,217) = b(k,217) - lu(k,626) * b(k,159) - b(k,177) = b(k,177) - lu(k,628) * b(k,160) - b(k,189) = b(k,189) - lu(k,629) * b(k,160) - b(k,211) = b(k,211) - lu(k,630) * b(k,160) - b(k,213) = b(k,213) - lu(k,631) * b(k,160) - b(k,217) = b(k,217) - lu(k,632) * b(k,160) - b(k,163) = b(k,163) - lu(k,639) * b(k,161) - b(k,176) = b(k,176) - lu(k,640) * b(k,161) - b(k,177) = b(k,177) - lu(k,641) * b(k,161) - b(k,189) = b(k,189) - lu(k,642) * b(k,161) - b(k,200) = b(k,200) - lu(k,643) * b(k,161) - b(k,211) = b(k,211) - lu(k,644) * b(k,161) - b(k,213) = b(k,213) - lu(k,645) * b(k,161) - b(k,215) = b(k,215) - lu(k,646) * b(k,161) - b(k,217) = b(k,217) - lu(k,647) * b(k,161) - b(k,163) = b(k,163) - lu(k,655) * b(k,162) - b(k,176) = b(k,176) - lu(k,656) * b(k,162) - b(k,177) = b(k,177) - lu(k,657) * b(k,162) - b(k,189) = b(k,189) - lu(k,658) * b(k,162) - b(k,200) = b(k,200) - lu(k,659) * b(k,162) - b(k,207) = b(k,207) - lu(k,660) * b(k,162) - b(k,211) = b(k,211) - lu(k,661) * b(k,162) - b(k,213) = b(k,213) - lu(k,662) * b(k,162) - b(k,215) = b(k,215) - lu(k,663) * b(k,162) - b(k,217) = b(k,217) - lu(k,664) * b(k,162) - b(k,189) = b(k,189) - lu(k,666) * b(k,163) - b(k,200) = b(k,200) - lu(k,667) * b(k,163) - b(k,211) = b(k,211) - lu(k,668) * b(k,163) - b(k,213) = b(k,213) - lu(k,669) * b(k,163) - b(k,215) = b(k,215) - lu(k,670) * b(k,163) - b(k,217) = b(k,217) - lu(k,671) * b(k,163) - b(k,219) = b(k,219) - lu(k,672) * b(k,163) - b(k,190) = b(k,190) - lu(k,675) * b(k,164) - b(k,195) = b(k,195) - lu(k,676) * b(k,164) - b(k,211) = b(k,211) - lu(k,677) * b(k,164) - b(k,213) = b(k,213) - lu(k,678) * b(k,164) - b(k,215) = b(k,215) - lu(k,679) * b(k,164) - b(k,216) = b(k,216) - lu(k,680) * b(k,164) - b(k,217) = b(k,217) - lu(k,681) * b(k,164) - b(k,225) = b(k,225) - lu(k,682) * b(k,164) - b(k,208) = b(k,208) - lu(k,685) * b(k,165) - b(k,212) = b(k,212) - lu(k,686) * b(k,165) - b(k,215) = b(k,215) - lu(k,687) * b(k,165) - b(k,221) = b(k,221) - lu(k,688) * b(k,165) - b(k,223) = b(k,223) - lu(k,689) * b(k,165) - b(k,224) = b(k,224) - lu(k,690) * b(k,165) - b(k,225) = b(k,225) - lu(k,691) * b(k,165) - b(k,196) = b(k,196) - lu(k,694) * b(k,166) - b(k,209) = b(k,209) - lu(k,695) * b(k,166) - b(k,210) = b(k,210) - lu(k,696) * b(k,166) - b(k,215) = b(k,215) - lu(k,697) * b(k,166) - b(k,218) = b(k,218) - lu(k,698) * b(k,166) - b(k,219) = b(k,219) - lu(k,699) * b(k,166) - b(k,225) = b(k,225) - lu(k,700) * b(k,166) - b(k,213) = b(k,213) - lu(k,702) * b(k,167) - b(k,215) = b(k,215) - lu(k,703) * b(k,167) - b(k,216) = b(k,216) - lu(k,704) * b(k,167) - b(k,213) = b(k,213) - lu(k,706) * b(k,168) - b(k,215) = b(k,215) - lu(k,707) * b(k,168) - b(k,225) = b(k,225) - lu(k,708) * b(k,168) - b(k,181) = b(k,181) - lu(k,711) * b(k,169) - b(k,195) = b(k,195) - lu(k,712) * b(k,169) - b(k,211) = b(k,211) - lu(k,713) * b(k,169) - b(k,213) = b(k,213) - lu(k,714) * b(k,169) - b(k,215) = b(k,215) - lu(k,715) * b(k,169) - b(k,216) = b(k,216) - lu(k,716) * b(k,169) - b(k,217) = b(k,217) - lu(k,717) * b(k,169) - b(k,219) = b(k,219) - lu(k,718) * b(k,169) - b(k,225) = b(k,225) - lu(k,719) * b(k,169) - b(k,208) = b(k,208) - lu(k,721) * b(k,170) - b(k,210) = b(k,210) - lu(k,722) * b(k,170) - b(k,214) = b(k,214) - lu(k,723) * b(k,170) - b(k,215) = b(k,215) - lu(k,724) * b(k,170) - b(k,221) = b(k,221) - lu(k,725) * b(k,170) - b(k,223) = b(k,223) - lu(k,726) * b(k,170) - b(k,225) = b(k,225) - lu(k,727) * b(k,170) - b(k,212) = b(k,212) - lu(k,730) * b(k,171) - b(k,215) = b(k,215) - lu(k,731) * b(k,171) - b(k,222) = b(k,222) - lu(k,732) * b(k,171) - b(k,223) = b(k,223) - lu(k,733) * b(k,171) - b(k,224) = b(k,224) - lu(k,734) * b(k,171) - b(k,225) = b(k,225) - lu(k,735) * b(k,171) - b(k,195) = b(k,195) - lu(k,740) * b(k,172) - b(k,211) = b(k,211) - lu(k,741) * b(k,172) - b(k,213) = b(k,213) - lu(k,742) * b(k,172) - b(k,215) = b(k,215) - lu(k,743) * b(k,172) - b(k,216) = b(k,216) - lu(k,744) * b(k,172) - b(k,217) = b(k,217) - lu(k,745) * b(k,172) - b(k,219) = b(k,219) - lu(k,746) * b(k,172) - b(k,200) = b(k,200) - lu(k,748) * b(k,173) - b(k,207) = b(k,207) - lu(k,749) * b(k,173) - b(k,215) = b(k,215) - lu(k,750) * b(k,173) - b(k,216) = b(k,216) - lu(k,751) * b(k,173) - b(k,217) = b(k,217) - lu(k,752) * b(k,173) - b(k,201) = b(k,201) - lu(k,755) * b(k,174) - b(k,213) = b(k,213) - lu(k,756) * b(k,174) - b(k,215) = b(k,215) - lu(k,757) * b(k,174) - b(k,223) = b(k,223) - lu(k,758) * b(k,174) - b(k,225) = b(k,225) - lu(k,759) * b(k,174) - b(k,184) = b(k,184) - lu(k,767) * b(k,175) - b(k,189) = b(k,189) - lu(k,768) * b(k,175) - b(k,198) = b(k,198) - lu(k,769) * b(k,175) - b(k,199) = b(k,199) - lu(k,770) * b(k,175) - b(k,202) = b(k,202) - lu(k,771) * b(k,175) - b(k,203) = b(k,203) - lu(k,772) * b(k,175) - b(k,205) = b(k,205) - lu(k,773) * b(k,175) - b(k,207) = b(k,207) - lu(k,774) * b(k,175) - b(k,213) = b(k,213) - lu(k,775) * b(k,175) - b(k,215) = b(k,215) - lu(k,776) * b(k,175) - b(k,216) = b(k,216) - lu(k,777) * b(k,175) - b(k,218) = b(k,218) - lu(k,778) * b(k,175) - b(k,219) = b(k,219) - lu(k,779) * b(k,175) - b(k,220) = b(k,220) - lu(k,780) * b(k,175) - b(k,225) = b(k,225) - lu(k,781) * b(k,175) - b(k,177) = b(k,177) - lu(k,783) * b(k,176) - b(k,189) = b(k,189) - lu(k,784) * b(k,176) - b(k,200) = b(k,200) - lu(k,785) * b(k,176) - b(k,211) = b(k,211) - lu(k,786) * b(k,176) - b(k,213) = b(k,213) - lu(k,787) * b(k,176) - b(k,215) = b(k,215) - lu(k,788) * b(k,176) - b(k,217) = b(k,217) - lu(k,789) * b(k,176) - b(k,219) = b(k,219) - lu(k,790) * b(k,176) - b(k,189) = b(k,189) - lu(k,793) * b(k,177) - b(k,213) = b(k,213) - lu(k,794) * b(k,177) - b(k,215) = b(k,215) - lu(k,795) * b(k,177) - b(k,180) = b(k,180) - lu(k,806) * b(k,178) - b(k,181) = b(k,181) - lu(k,807) * b(k,178) - b(k,183) = b(k,183) - lu(k,808) * b(k,178) - b(k,188) = b(k,188) - lu(k,809) * b(k,178) - b(k,189) = b(k,189) - lu(k,810) * b(k,178) - b(k,191) = b(k,191) - lu(k,811) * b(k,178) - b(k,193) = b(k,193) - lu(k,812) * b(k,178) - b(k,194) = b(k,194) - lu(k,813) * b(k,178) - b(k,200) = b(k,200) - lu(k,814) * b(k,178) - b(k,207) = b(k,207) - lu(k,815) * b(k,178) - b(k,213) = b(k,213) - lu(k,816) * b(k,178) - b(k,215) = b(k,215) - lu(k,817) * b(k,178) - b(k,216) = b(k,216) - lu(k,818) * b(k,178) - b(k,218) = b(k,218) - lu(k,819) * b(k,178) - b(k,220) = b(k,220) - lu(k,820) * b(k,178) - b(k,225) = b(k,225) - lu(k,821) * b(k,178) - b(k,180) = b(k,180) - lu(k,832) * b(k,179) - b(k,181) = b(k,181) - lu(k,833) * b(k,179) - b(k,183) = b(k,183) - lu(k,834) * b(k,179) - b(k,188) = b(k,188) - lu(k,835) * b(k,179) - b(k,189) = b(k,189) - lu(k,836) * b(k,179) - b(k,191) = b(k,191) - lu(k,837) * b(k,179) - b(k,193) = b(k,193) - lu(k,838) * b(k,179) - b(k,194) = b(k,194) - lu(k,839) * b(k,179) - b(k,200) = b(k,200) - lu(k,840) * b(k,179) - b(k,207) = b(k,207) - lu(k,841) * b(k,179) - b(k,213) = b(k,213) - lu(k,842) * b(k,179) - b(k,215) = b(k,215) - lu(k,843) * b(k,179) - b(k,216) = b(k,216) - lu(k,844) * b(k,179) - b(k,218) = b(k,218) - lu(k,845) * b(k,179) - b(k,220) = b(k,220) - lu(k,846) * b(k,179) - b(k,225) = b(k,225) - lu(k,847) * b(k,179) - b(k,181) = b(k,181) - lu(k,854) * b(k,180) - b(k,195) = b(k,195) - lu(k,855) * b(k,180) - b(k,207) = b(k,207) - lu(k,856) * b(k,180) - b(k,211) = b(k,211) - lu(k,857) * b(k,180) - b(k,213) = b(k,213) - lu(k,858) * b(k,180) - b(k,215) = b(k,215) - lu(k,859) * b(k,180) - b(k,216) = b(k,216) - lu(k,860) * b(k,180) - b(k,217) = b(k,217) - lu(k,861) * b(k,180) - b(k,219) = b(k,219) - lu(k,862) * b(k,180) - b(k,194) = b(k,194) - lu(k,864) * b(k,181) - b(k,207) = b(k,207) - lu(k,865) * b(k,181) - b(k,215) = b(k,215) - lu(k,866) * b(k,181) - b(k,219) = b(k,219) - lu(k,867) * b(k,181) - b(k,225) = b(k,225) - lu(k,868) * b(k,181) - b(k,209) = b(k,209) - lu(k,872) * b(k,182) - b(k,212) = b(k,212) - lu(k,873) * b(k,182) - b(k,215) = b(k,215) - lu(k,874) * b(k,182) - b(k,217) = b(k,217) - lu(k,875) * b(k,182) - b(k,218) = b(k,218) - lu(k,876) * b(k,182) - b(k,222) = b(k,222) - lu(k,877) * b(k,182) - b(k,223) = b(k,223) - lu(k,878) * b(k,182) - b(k,224) = b(k,224) - lu(k,879) * b(k,182) - b(k,225) = b(k,225) - lu(k,880) * b(k,182) - b(k,188) = b(k,188) - lu(k,882) * b(k,183) - b(k,189) = b(k,189) - lu(k,883) * b(k,183) - b(k,192) = b(k,192) - lu(k,884) * b(k,183) - b(k,193) = b(k,193) - lu(k,885) * b(k,183) - b(k,213) = b(k,213) - lu(k,886) * b(k,183) - b(k,215) = b(k,215) - lu(k,887) * b(k,183) - b(k,218) = b(k,218) - lu(k,888) * b(k,183) - b(k,189) = b(k,189) - lu(k,894) * b(k,184) - b(k,190) = b(k,190) - lu(k,895) * b(k,184) - b(k,195) = b(k,195) - lu(k,896) * b(k,184) - b(k,200) = b(k,200) - lu(k,897) * b(k,184) - b(k,207) = b(k,207) - lu(k,898) * b(k,184) - b(k,211) = b(k,211) - lu(k,899) * b(k,184) - b(k,213) = b(k,213) - lu(k,900) * b(k,184) - b(k,215) = b(k,215) - lu(k,901) * b(k,184) - b(k,216) = b(k,216) - lu(k,902) * b(k,184) - b(k,217) = b(k,217) - lu(k,903) * b(k,184) - b(k,218) = b(k,218) - lu(k,904) * b(k,184) - b(k,219) = b(k,219) - lu(k,905) * b(k,184) - b(k,220) = b(k,220) - lu(k,906) * b(k,184) - b(k,225) = b(k,225) - lu(k,907) * b(k,184) + b(k,224) = b(k,224) - lu(k,658) * b(k,180) + b(k,227) = b(k,227) - lu(k,659) * b(k,180) + b(k,228) = b(k,228) - lu(k,660) * b(k,180) + b(k,243) = b(k,243) - lu(k,661) * b(k,180) + b(k,247) = b(k,247) - lu(k,662) * b(k,180) + b(k,249) = b(k,249) - lu(k,663) * b(k,180) + b(k,253) = b(k,253) - lu(k,664) * b(k,180) + b(k,256) = b(k,256) - lu(k,665) * b(k,180) + b(k,207) = b(k,207) - lu(k,667) * b(k,181) + b(k,223) = b(k,223) - lu(k,668) * b(k,181) + b(k,256) = b(k,256) - lu(k,669) * b(k,181) + b(k,216) = b(k,216) - lu(k,671) * b(k,182) + b(k,243) = b(k,243) - lu(k,672) * b(k,182) + b(k,247) = b(k,247) - lu(k,673) * b(k,182) + b(k,249) = b(k,249) - lu(k,674) * b(k,182) + b(k,256) = b(k,256) - lu(k,675) * b(k,182) + b(k,245) = b(k,245) - lu(k,679) * b(k,183) + b(k,247) = b(k,247) - lu(k,680) * b(k,183) + b(k,249) = b(k,249) - lu(k,681) * b(k,183) + b(k,256) = b(k,256) - lu(k,682) * b(k,183) + b(k,258) = b(k,258) - lu(k,683) * b(k,183) + b(k,187) = b(k,187) - lu(k,686) * b(k,184) + b(k,202) = b(k,202) - lu(k,687) * b(k,184) + b(k,212) = b(k,212) - lu(k,688) * b(k,184) + b(k,222) = b(k,222) - lu(k,689) * b(k,184) + b(k,239) = b(k,239) - lu(k,690) * b(k,184) + b(k,247) = b(k,247) - lu(k,691) * b(k,184) + b(k,249) = b(k,249) - lu(k,692) * b(k,184) + b(k,253) = b(k,253) - lu(k,693) * b(k,184) + b(k,256) = b(k,256) - lu(k,694) * b(k,184) + b(k,203) = b(k,203) - lu(k,696) * b(k,185) + b(k,212) = b(k,212) - lu(k,697) * b(k,185) + b(k,221) = b(k,221) - lu(k,698) * b(k,185) + b(k,223) = b(k,223) - lu(k,699) * b(k,185) + b(k,224) = b(k,224) - lu(k,700) * b(k,185) + b(k,225) = b(k,225) - lu(k,701) * b(k,185) + b(k,249) = b(k,249) - lu(k,702) * b(k,185) + b(k,253) = b(k,253) - lu(k,703) * b(k,185) + b(k,256) = b(k,256) - lu(k,704) * b(k,185) + b(k,187) = b(k,187) - lu(k,707) * b(k,186) + b(k,202) = b(k,202) - lu(k,708) * b(k,186) + b(k,210) = b(k,210) - lu(k,709) * b(k,186) + b(k,212) = b(k,212) - lu(k,710) * b(k,186) + b(k,222) = b(k,222) - lu(k,711) * b(k,186) + b(k,239) = b(k,239) - lu(k,712) * b(k,186) + b(k,249) = b(k,249) - lu(k,713) * b(k,186) + b(k,253) = b(k,253) - lu(k,714) * b(k,186) + b(k,256) = b(k,256) - lu(k,715) * b(k,186) + b(k,222) = b(k,222) - lu(k,718) * b(k,187) + b(k,239) = b(k,239) - lu(k,719) * b(k,187) + b(k,245) = b(k,245) - lu(k,720) * b(k,187) + b(k,247) = b(k,247) - lu(k,721) * b(k,187) + b(k,249) = b(k,249) - lu(k,722) * b(k,187) + b(k,256) = b(k,256) - lu(k,723) * b(k,187) + b(k,203) = b(k,203) - lu(k,725) * b(k,188) + b(k,246) = b(k,246) - lu(k,726) * b(k,188) + b(k,249) = b(k,249) - lu(k,727) * b(k,188) + b(k,259) = b(k,259) - lu(k,728) * b(k,188) + b(k,229) = b(k,229) - lu(k,731) * b(k,189) + b(k,231) = b(k,231) - lu(k,732) * b(k,189) + b(k,237) = b(k,237) - lu(k,733) * b(k,189) + b(k,249) = b(k,249) - lu(k,734) * b(k,189) + b(k,253) = b(k,253) - lu(k,735) * b(k,189) + b(k,256) = b(k,256) - lu(k,736) * b(k,189) + b(k,192) = b(k,192) - lu(k,742) * b(k,190) + b(k,194) = b(k,194) - lu(k,743) * b(k,190) + b(k,195) = b(k,195) - lu(k,744) * b(k,190) + b(k,207) = b(k,207) - lu(k,745) * b(k,190) + b(k,213) = b(k,213) - lu(k,746) * b(k,190) + b(k,223) = b(k,223) - lu(k,747) * b(k,190) + b(k,232) = b(k,232) - lu(k,748) * b(k,190) + b(k,239) = b(k,239) - lu(k,749) * b(k,190) + b(k,249) = b(k,249) - lu(k,750) * b(k,190) + b(k,256) = b(k,256) - lu(k,751) * b(k,190) + b(k,224) = b(k,224) - lu(k,755) * b(k,191) + b(k,245) = b(k,245) - lu(k,756) * b(k,191) + b(k,247) = b(k,247) - lu(k,757) * b(k,191) + b(k,249) = b(k,249) - lu(k,758) * b(k,191) + b(k,253) = b(k,253) - lu(k,759) * b(k,191) + b(k,256) = b(k,256) - lu(k,760) * b(k,191) + b(k,213) = b(k,213) - lu(k,762) * b(k,192) + b(k,223) = b(k,223) - lu(k,763) * b(k,192) + b(k,245) = b(k,245) - lu(k,764) * b(k,192) + b(k,247) = b(k,247) - lu(k,765) * b(k,192) + b(k,256) = b(k,256) - lu(k,766) * b(k,192) + b(k,195) = b(k,195) - lu(k,773) * b(k,193) + b(k,207) = b(k,207) - lu(k,774) * b(k,193) + b(k,213) = b(k,213) - lu(k,775) * b(k,193) + b(k,223) = b(k,223) - lu(k,776) * b(k,193) + b(k,232) = b(k,232) - lu(k,777) * b(k,193) + b(k,245) = b(k,245) - lu(k,778) * b(k,193) + b(k,247) = b(k,247) - lu(k,779) * b(k,193) + b(k,249) = b(k,249) - lu(k,780) * b(k,193) + b(k,256) = b(k,256) - lu(k,781) * b(k,193) + b(k,195) = b(k,195) - lu(k,789) * b(k,194) + b(k,207) = b(k,207) - lu(k,790) * b(k,194) + b(k,213) = b(k,213) - lu(k,791) * b(k,194) + b(k,223) = b(k,223) - lu(k,792) * b(k,194) + b(k,232) = b(k,232) - lu(k,793) * b(k,194) + b(k,239) = b(k,239) - lu(k,794) * b(k,194) + b(k,245) = b(k,245) - lu(k,795) * b(k,194) + b(k,247) = b(k,247) - lu(k,796) * b(k,194) + b(k,249) = b(k,249) - lu(k,797) * b(k,194) + b(k,256) = b(k,256) - lu(k,798) * b(k,194) + b(k,223) = b(k,223) - lu(k,800) * b(k,195) + b(k,232) = b(k,232) - lu(k,801) * b(k,195) + b(k,245) = b(k,245) - lu(k,802) * b(k,195) + b(k,246) = b(k,246) - lu(k,803) * b(k,195) + b(k,247) = b(k,247) - lu(k,804) * b(k,195) + b(k,249) = b(k,249) - lu(k,805) * b(k,195) + b(k,256) = b(k,256) - lu(k,806) * b(k,195) + b(k,222) = b(k,222) - lu(k,809) * b(k,196) + b(k,227) = b(k,227) - lu(k,810) * b(k,196) + b(k,245) = b(k,245) - lu(k,811) * b(k,196) + b(k,247) = b(k,247) - lu(k,812) * b(k,196) + b(k,249) = b(k,249) - lu(k,813) * b(k,196) + b(k,253) = b(k,253) - lu(k,814) * b(k,196) + b(k,256) = b(k,256) - lu(k,815) * b(k,196) + b(k,259) = b(k,259) - lu(k,816) * b(k,196) + b(k,241) = b(k,241) - lu(k,819) * b(k,197) + b(k,249) = b(k,249) - lu(k,820) * b(k,197) + b(k,251) = b(k,251) - lu(k,821) * b(k,197) + b(k,252) = b(k,252) - lu(k,822) * b(k,197) + b(k,255) = b(k,255) - lu(k,823) * b(k,197) + b(k,257) = b(k,257) - lu(k,824) * b(k,197) + b(k,259) = b(k,259) - lu(k,825) * b(k,197) + b(k,249) = b(k,249) - lu(k,827) * b(k,198) + b(k,253) = b(k,253) - lu(k,828) * b(k,198) + b(k,256) = b(k,256) - lu(k,829) * b(k,198) + b(k,212) = b(k,212) - lu(k,832) * b(k,199) + b(k,222) = b(k,222) - lu(k,833) * b(k,199) + b(k,245) = b(k,245) - lu(k,834) * b(k,199) + b(k,246) = b(k,246) - lu(k,835) * b(k,199) + b(k,247) = b(k,247) - lu(k,836) * b(k,199) + b(k,249) = b(k,249) - lu(k,837) * b(k,199) + b(k,253) = b(k,253) - lu(k,838) * b(k,199) + b(k,256) = b(k,256) - lu(k,839) * b(k,199) + b(k,259) = b(k,259) - lu(k,840) * b(k,199) + b(k,249) = b(k,249) - lu(k,843) * b(k,200) + b(k,250) = b(k,250) - lu(k,844) * b(k,200) + b(k,251) = b(k,251) - lu(k,845) * b(k,200) + b(k,252) = b(k,252) - lu(k,846) * b(k,200) + b(k,257) = b(k,257) - lu(k,847) * b(k,200) + b(k,259) = b(k,259) - lu(k,848) * b(k,200) + b(k,241) = b(k,241) - lu(k,850) * b(k,201) + b(k,244) = b(k,244) - lu(k,851) * b(k,201) + b(k,248) = b(k,248) - lu(k,852) * b(k,201) + b(k,249) = b(k,249) - lu(k,853) * b(k,201) + b(k,252) = b(k,252) - lu(k,854) * b(k,201) + b(k,255) = b(k,255) - lu(k,855) * b(k,201) + b(k,259) = b(k,259) - lu(k,856) * b(k,201) + b(k,222) = b(k,222) - lu(k,861) * b(k,202) + b(k,245) = b(k,245) - lu(k,862) * b(k,202) + b(k,246) = b(k,246) - lu(k,863) * b(k,202) + b(k,247) = b(k,247) - lu(k,864) * b(k,202) + b(k,249) = b(k,249) - lu(k,865) * b(k,202) + b(k,253) = b(k,253) - lu(k,866) * b(k,202) + b(k,256) = b(k,256) - lu(k,867) * b(k,202) + b(k,223) = b(k,223) - lu(k,869) * b(k,203) + b(k,252) = b(k,252) - lu(k,870) * b(k,203) + b(k,215) = b(k,215) - lu(k,875) * b(k,204) + b(k,218) = b(k,218) - lu(k,876) * b(k,204) + b(k,223) = b(k,223) - lu(k,877) * b(k,204) + b(k,230) = b(k,230) - lu(k,878) * b(k,204) + b(k,231) = b(k,231) - lu(k,879) * b(k,204) + b(k,234) = b(k,234) - lu(k,880) * b(k,204) + b(k,235) = b(k,235) - lu(k,881) * b(k,204) + b(k,237) = b(k,237) - lu(k,882) * b(k,204) + b(k,239) = b(k,239) - lu(k,883) * b(k,204) + b(k,246) = b(k,246) - lu(k,884) * b(k,204) + b(k,249) = b(k,249) - lu(k,885) * b(k,204) + b(k,253) = b(k,253) - lu(k,886) * b(k,204) + b(k,254) = b(k,254) - lu(k,887) * b(k,204) + b(k,256) = b(k,256) - lu(k,888) * b(k,204) + b(k,258) = b(k,258) - lu(k,889) * b(k,204) + b(k,232) = b(k,232) - lu(k,891) * b(k,205) + b(k,239) = b(k,239) - lu(k,892) * b(k,205) + b(k,247) = b(k,247) - lu(k,893) * b(k,205) + b(k,249) = b(k,249) - lu(k,894) * b(k,205) + b(k,253) = b(k,253) - lu(k,895) * b(k,205) + b(k,233) = b(k,233) - lu(k,898) * b(k,206) + b(k,249) = b(k,249) - lu(k,899) * b(k,206) + b(k,252) = b(k,252) - lu(k,900) * b(k,206) + b(k,256) = b(k,256) - lu(k,901) * b(k,206) + b(k,259) = b(k,259) - lu(k,902) * b(k,206) + b(k,213) = b(k,213) - lu(k,904) * b(k,207) + b(k,223) = b(k,223) - lu(k,905) * b(k,207) + b(k,232) = b(k,232) - lu(k,906) * b(k,207) + b(k,245) = b(k,245) - lu(k,907) * b(k,207) + b(k,246) = b(k,246) - lu(k,908) * b(k,207) + b(k,247) = b(k,247) - lu(k,909) * b(k,207) + b(k,249) = b(k,249) - lu(k,910) * b(k,207) + b(k,256) = b(k,256) - lu(k,911) * b(k,207) + b(k,240) = b(k,240) - lu(k,914) * b(k,208) + b(k,242) = b(k,242) - lu(k,915) * b(k,208) + b(k,243) = b(k,243) - lu(k,916) * b(k,208) + b(k,244) = b(k,244) - lu(k,917) * b(k,208) + b(k,246) = b(k,246) - lu(k,918) * b(k,208) + b(k,249) = b(k,249) - lu(k,919) * b(k,208) + b(k,254) = b(k,254) - lu(k,920) * b(k,208) + b(k,259) = b(k,259) - lu(k,921) * b(k,208) end do end subroutine lu_slv03 subroutine lu_slv04( avec_len, lu, b ) @@ -689,217 +690,216 @@ subroutine lu_slv04( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,189) = b(k,189) - lu(k,913) * b(k,185) - b(k,200) = b(k,200) - lu(k,914) * b(k,185) - b(k,207) = b(k,207) - lu(k,915) * b(k,185) - b(k,209) = b(k,209) - lu(k,916) * b(k,185) - b(k,211) = b(k,211) - lu(k,917) * b(k,185) - b(k,213) = b(k,213) - lu(k,918) * b(k,185) - b(k,215) = b(k,215) - lu(k,919) * b(k,185) - b(k,216) = b(k,216) - lu(k,920) * b(k,185) - b(k,217) = b(k,217) - lu(k,921) * b(k,185) - b(k,219) = b(k,219) - lu(k,922) * b(k,185) - b(k,189) = b(k,189) - lu(k,925) * b(k,186) - b(k,213) = b(k,213) - lu(k,926) * b(k,186) - b(k,215) = b(k,215) - lu(k,927) * b(k,186) - b(k,216) = b(k,216) - lu(k,928) * b(k,186) - b(k,189) = b(k,189) - lu(k,933) * b(k,187) - b(k,190) = b(k,190) - lu(k,934) * b(k,187) - b(k,194) = b(k,194) - lu(k,935) * b(k,187) - b(k,195) = b(k,195) - lu(k,936) * b(k,187) - b(k,207) = b(k,207) - lu(k,937) * b(k,187) - b(k,209) = b(k,209) - lu(k,938) * b(k,187) - b(k,213) = b(k,213) - lu(k,939) * b(k,187) - b(k,215) = b(k,215) - lu(k,940) * b(k,187) - b(k,216) = b(k,216) - lu(k,941) * b(k,187) - b(k,217) = b(k,217) - lu(k,942) * b(k,187) - b(k,219) = b(k,219) - lu(k,943) * b(k,187) - b(k,225) = b(k,225) - lu(k,944) * b(k,187) - b(k,189) = b(k,189) - lu(k,947) * b(k,188) - b(k,194) = b(k,194) - lu(k,948) * b(k,188) - b(k,207) = b(k,207) - lu(k,949) * b(k,188) - b(k,213) = b(k,213) - lu(k,950) * b(k,188) - b(k,215) = b(k,215) - lu(k,951) * b(k,188) - b(k,216) = b(k,216) - lu(k,952) * b(k,188) - b(k,219) = b(k,219) - lu(k,953) * b(k,188) - b(k,225) = b(k,225) - lu(k,954) * b(k,188) - b(k,210) = b(k,210) - lu(k,956) * b(k,189) - b(k,213) = b(k,213) - lu(k,957) * b(k,189) - b(k,215) = b(k,215) - lu(k,958) * b(k,189) - b(k,200) = b(k,200) - lu(k,960) * b(k,190) - b(k,207) = b(k,207) - lu(k,961) * b(k,190) - b(k,213) = b(k,213) - lu(k,962) * b(k,190) - b(k,215) = b(k,215) - lu(k,963) * b(k,190) - b(k,216) = b(k,216) - lu(k,964) * b(k,190) - b(k,192) = b(k,192) - lu(k,973) * b(k,191) - b(k,193) = b(k,193) - lu(k,974) * b(k,191) - b(k,194) = b(k,194) - lu(k,975) * b(k,191) - b(k,207) = b(k,207) - lu(k,976) * b(k,191) - b(k,209) = b(k,209) - lu(k,977) * b(k,191) - b(k,210) = b(k,210) - lu(k,978) * b(k,191) - b(k,211) = b(k,211) - lu(k,979) * b(k,191) - b(k,213) = b(k,213) - lu(k,980) * b(k,191) - b(k,215) = b(k,215) - lu(k,981) * b(k,191) - b(k,216) = b(k,216) - lu(k,982) * b(k,191) - b(k,217) = b(k,217) - lu(k,983) * b(k,191) - b(k,218) = b(k,218) - lu(k,984) * b(k,191) - b(k,219) = b(k,219) - lu(k,985) * b(k,191) - b(k,225) = b(k,225) - lu(k,986) * b(k,191) - b(k,194) = b(k,194) - lu(k,995) * b(k,192) - b(k,207) = b(k,207) - lu(k,996) * b(k,192) - b(k,209) = b(k,209) - lu(k,997) * b(k,192) - b(k,210) = b(k,210) - lu(k,998) * b(k,192) - b(k,211) = b(k,211) - lu(k,999) * b(k,192) - b(k,213) = b(k,213) - lu(k,1000) * b(k,192) - b(k,215) = b(k,215) - lu(k,1001) * b(k,192) - b(k,216) = b(k,216) - lu(k,1002) * b(k,192) - b(k,217) = b(k,217) - lu(k,1003) * b(k,192) - b(k,219) = b(k,219) - lu(k,1004) * b(k,192) - b(k,225) = b(k,225) - lu(k,1005) * b(k,192) - b(k,194) = b(k,194) - lu(k,1014) * b(k,193) - b(k,207) = b(k,207) - lu(k,1015) * b(k,193) - b(k,209) = b(k,209) - lu(k,1016) * b(k,193) - b(k,210) = b(k,210) - lu(k,1017) * b(k,193) - b(k,211) = b(k,211) - lu(k,1018) * b(k,193) - b(k,213) = b(k,213) - lu(k,1019) * b(k,193) - b(k,215) = b(k,215) - lu(k,1020) * b(k,193) - b(k,216) = b(k,216) - lu(k,1021) * b(k,193) - b(k,217) = b(k,217) - lu(k,1022) * b(k,193) - b(k,218) = b(k,218) - lu(k,1023) * b(k,193) - b(k,219) = b(k,219) - lu(k,1024) * b(k,193) - b(k,225) = b(k,225) - lu(k,1025) * b(k,193) - b(k,200) = b(k,200) - lu(k,1030) * b(k,194) - b(k,207) = b(k,207) - lu(k,1031) * b(k,194) - b(k,211) = b(k,211) - lu(k,1032) * b(k,194) - b(k,213) = b(k,213) - lu(k,1033) * b(k,194) - b(k,215) = b(k,215) - lu(k,1034) * b(k,194) - b(k,216) = b(k,216) - lu(k,1035) * b(k,194) - b(k,217) = b(k,217) - lu(k,1036) * b(k,194) - b(k,219) = b(k,219) - lu(k,1037) * b(k,194) - b(k,225) = b(k,225) - lu(k,1038) * b(k,194) - b(k,207) = b(k,207) - lu(k,1041) * b(k,195) - b(k,209) = b(k,209) - lu(k,1042) * b(k,195) - b(k,210) = b(k,210) - lu(k,1043) * b(k,195) - b(k,213) = b(k,213) - lu(k,1044) * b(k,195) - b(k,215) = b(k,215) - lu(k,1045) * b(k,195) - b(k,218) = b(k,218) - lu(k,1046) * b(k,195) - b(k,219) = b(k,219) - lu(k,1047) * b(k,195) - b(k,225) = b(k,225) - lu(k,1048) * b(k,195) - b(k,209) = b(k,209) - lu(k,1052) * b(k,196) - b(k,210) = b(k,210) - lu(k,1053) * b(k,196) - b(k,212) = b(k,212) - lu(k,1054) * b(k,196) - b(k,214) = b(k,214) - lu(k,1055) * b(k,196) - b(k,215) = b(k,215) - lu(k,1056) * b(k,196) - b(k,218) = b(k,218) - lu(k,1057) * b(k,196) - b(k,219) = b(k,219) - lu(k,1058) * b(k,196) - b(k,223) = b(k,223) - lu(k,1059) * b(k,196) - b(k,224) = b(k,224) - lu(k,1060) * b(k,196) - b(k,225) = b(k,225) - lu(k,1061) * b(k,196) - b(k,200) = b(k,200) - lu(k,1069) * b(k,197) - b(k,207) = b(k,207) - lu(k,1070) * b(k,197) - b(k,210) = b(k,210) - lu(k,1071) * b(k,197) - b(k,211) = b(k,211) - lu(k,1072) * b(k,197) - b(k,213) = b(k,213) - lu(k,1073) * b(k,197) - b(k,215) = b(k,215) - lu(k,1074) * b(k,197) - b(k,216) = b(k,216) - lu(k,1075) * b(k,197) - b(k,217) = b(k,217) - lu(k,1076) * b(k,197) - b(k,218) = b(k,218) - lu(k,1077) * b(k,197) - b(k,219) = b(k,219) - lu(k,1078) * b(k,197) - b(k,199) = b(k,199) - lu(k,1089) * b(k,198) - b(k,200) = b(k,200) - lu(k,1090) * b(k,198) - b(k,203) = b(k,203) - lu(k,1091) * b(k,198) - b(k,207) = b(k,207) - lu(k,1092) * b(k,198) - b(k,209) = b(k,209) - lu(k,1093) * b(k,198) - b(k,210) = b(k,210) - lu(k,1094) * b(k,198) - b(k,211) = b(k,211) - lu(k,1095) * b(k,198) - b(k,213) = b(k,213) - lu(k,1096) * b(k,198) - b(k,215) = b(k,215) - lu(k,1097) * b(k,198) - b(k,216) = b(k,216) - lu(k,1098) * b(k,198) - b(k,217) = b(k,217) - lu(k,1099) * b(k,198) - b(k,218) = b(k,218) - lu(k,1100) * b(k,198) - b(k,219) = b(k,219) - lu(k,1101) * b(k,198) - b(k,200) = b(k,200) - lu(k,1105) * b(k,199) - b(k,204) = b(k,204) - lu(k,1106) * b(k,199) - b(k,206) = b(k,206) - lu(k,1107) * b(k,199) - b(k,207) = b(k,207) - lu(k,1108) * b(k,199) - b(k,210) = b(k,210) - lu(k,1109) * b(k,199) - b(k,213) = b(k,213) - lu(k,1110) * b(k,199) - b(k,215) = b(k,215) - lu(k,1111) * b(k,199) - b(k,216) = b(k,216) - lu(k,1112) * b(k,199) - b(k,220) = b(k,220) - lu(k,1113) * b(k,199) - b(k,225) = b(k,225) - lu(k,1114) * b(k,199) - b(k,207) = b(k,207) - lu(k,1117) * b(k,200) - b(k,209) = b(k,209) - lu(k,1118) * b(k,200) - b(k,210) = b(k,210) - lu(k,1119) * b(k,200) - b(k,213) = b(k,213) - lu(k,1120) * b(k,200) - b(k,215) = b(k,215) - lu(k,1121) * b(k,200) - b(k,218) = b(k,218) - lu(k,1122) * b(k,200) - b(k,225) = b(k,225) - lu(k,1123) * b(k,200) - b(k,208) = b(k,208) - lu(k,1128) * b(k,201) - b(k,210) = b(k,210) - lu(k,1129) * b(k,201) - b(k,211) = b(k,211) - lu(k,1130) * b(k,201) - b(k,213) = b(k,213) - lu(k,1131) * b(k,201) - b(k,215) = b(k,215) - lu(k,1132) * b(k,201) - b(k,217) = b(k,217) - lu(k,1133) * b(k,201) - b(k,220) = b(k,220) - lu(k,1134) * b(k,201) - b(k,221) = b(k,221) - lu(k,1135) * b(k,201) - b(k,222) = b(k,222) - lu(k,1136) * b(k,201) - b(k,223) = b(k,223) - lu(k,1137) * b(k,201) - b(k,224) = b(k,224) - lu(k,1138) * b(k,201) - b(k,225) = b(k,225) - lu(k,1139) * b(k,201) - b(k,203) = b(k,203) - lu(k,1153) * b(k,202) - b(k,204) = b(k,204) - lu(k,1154) * b(k,202) - b(k,206) = b(k,206) - lu(k,1155) * b(k,202) - b(k,207) = b(k,207) - lu(k,1156) * b(k,202) - b(k,209) = b(k,209) - lu(k,1157) * b(k,202) - b(k,210) = b(k,210) - lu(k,1158) * b(k,202) - b(k,211) = b(k,211) - lu(k,1159) * b(k,202) - b(k,213) = b(k,213) - lu(k,1160) * b(k,202) - b(k,215) = b(k,215) - lu(k,1161) * b(k,202) - b(k,216) = b(k,216) - lu(k,1162) * b(k,202) - b(k,217) = b(k,217) - lu(k,1163) * b(k,202) - b(k,218) = b(k,218) - lu(k,1164) * b(k,202) - b(k,219) = b(k,219) - lu(k,1165) * b(k,202) - b(k,220) = b(k,220) - lu(k,1166) * b(k,202) - b(k,225) = b(k,225) - lu(k,1167) * b(k,202) - b(k,204) = b(k,204) - lu(k,1175) * b(k,203) - b(k,207) = b(k,207) - lu(k,1176) * b(k,203) - b(k,209) = b(k,209) - lu(k,1177) * b(k,203) - b(k,210) = b(k,210) - lu(k,1178) * b(k,203) - b(k,211) = b(k,211) - lu(k,1179) * b(k,203) - b(k,213) = b(k,213) - lu(k,1180) * b(k,203) - b(k,215) = b(k,215) - lu(k,1181) * b(k,203) - b(k,216) = b(k,216) - lu(k,1182) * b(k,203) - b(k,217) = b(k,217) - lu(k,1183) * b(k,203) - b(k,218) = b(k,218) - lu(k,1184) * b(k,203) - b(k,219) = b(k,219) - lu(k,1185) * b(k,203) - b(k,220) = b(k,220) - lu(k,1186) * b(k,203) - b(k,225) = b(k,225) - lu(k,1187) * b(k,203) - b(k,206) = b(k,206) - lu(k,1198) * b(k,204) - b(k,207) = b(k,207) - lu(k,1199) * b(k,204) - b(k,209) = b(k,209) - lu(k,1200) * b(k,204) - b(k,210) = b(k,210) - lu(k,1201) * b(k,204) - b(k,211) = b(k,211) - lu(k,1202) * b(k,204) - b(k,213) = b(k,213) - lu(k,1203) * b(k,204) - b(k,215) = b(k,215) - lu(k,1204) * b(k,204) - b(k,216) = b(k,216) - lu(k,1205) * b(k,204) - b(k,217) = b(k,217) - lu(k,1206) * b(k,204) - b(k,218) = b(k,218) - lu(k,1207) * b(k,204) - b(k,219) = b(k,219) - lu(k,1208) * b(k,204) - b(k,225) = b(k,225) - lu(k,1209) * b(k,204) - b(k,206) = b(k,206) - lu(k,1231) * b(k,205) - b(k,207) = b(k,207) - lu(k,1232) * b(k,205) - b(k,209) = b(k,209) - lu(k,1233) * b(k,205) - b(k,210) = b(k,210) - lu(k,1234) * b(k,205) - b(k,211) = b(k,211) - lu(k,1235) * b(k,205) - b(k,213) = b(k,213) - lu(k,1236) * b(k,205) - b(k,215) = b(k,215) - lu(k,1237) * b(k,205) - b(k,216) = b(k,216) - lu(k,1238) * b(k,205) - b(k,217) = b(k,217) - lu(k,1239) * b(k,205) - b(k,218) = b(k,218) - lu(k,1240) * b(k,205) - b(k,219) = b(k,219) - lu(k,1241) * b(k,205) - b(k,220) = b(k,220) - lu(k,1242) * b(k,205) - b(k,225) = b(k,225) - lu(k,1243) * b(k,205) + b(k,243) = b(k,243) - lu(k,925) * b(k,209) + b(k,247) = b(k,247) - lu(k,926) * b(k,209) + b(k,249) = b(k,249) - lu(k,927) * b(k,209) + b(k,250) = b(k,250) - lu(k,928) * b(k,209) + b(k,251) = b(k,251) - lu(k,929) * b(k,209) + b(k,252) = b(k,252) - lu(k,930) * b(k,209) + b(k,254) = b(k,254) - lu(k,931) * b(k,209) + b(k,257) = b(k,257) - lu(k,932) * b(k,209) + b(k,259) = b(k,259) - lu(k,933) * b(k,209) + b(k,212) = b(k,212) - lu(k,940) * b(k,210) + b(k,222) = b(k,222) - lu(k,941) * b(k,210) + b(k,239) = b(k,239) - lu(k,942) * b(k,210) + b(k,245) = b(k,245) - lu(k,943) * b(k,210) + b(k,246) = b(k,246) - lu(k,944) * b(k,210) + b(k,247) = b(k,247) - lu(k,945) * b(k,210) + b(k,249) = b(k,249) - lu(k,946) * b(k,210) + b(k,253) = b(k,253) - lu(k,947) * b(k,210) + b(k,256) = b(k,256) - lu(k,948) * b(k,210) + b(k,212) = b(k,212) - lu(k,953) * b(k,211) + b(k,216) = b(k,216) - lu(k,954) * b(k,211) + b(k,243) = b(k,243) - lu(k,955) * b(k,211) + b(k,245) = b(k,245) - lu(k,956) * b(k,211) + b(k,246) = b(k,246) - lu(k,957) * b(k,211) + b(k,247) = b(k,247) - lu(k,958) * b(k,211) + b(k,249) = b(k,249) - lu(k,959) * b(k,211) + b(k,253) = b(k,253) - lu(k,960) * b(k,211) + b(k,256) = b(k,256) - lu(k,961) * b(k,211) + b(k,226) = b(k,226) - lu(k,963) * b(k,212) + b(k,239) = b(k,239) - lu(k,964) * b(k,212) + b(k,246) = b(k,246) - lu(k,965) * b(k,212) + b(k,249) = b(k,249) - lu(k,966) * b(k,212) + b(k,259) = b(k,259) - lu(k,967) * b(k,212) + b(k,223) = b(k,223) - lu(k,971) * b(k,213) + b(k,249) = b(k,249) - lu(k,972) * b(k,213) + b(k,252) = b(k,252) - lu(k,973) * b(k,213) + b(k,256) = b(k,256) - lu(k,974) * b(k,213) + b(k,215) = b(k,215) - lu(k,989) * b(k,214) + b(k,216) = b(k,216) - lu(k,990) * b(k,214) + b(k,220) = b(k,220) - lu(k,991) * b(k,214) + b(k,221) = b(k,221) - lu(k,992) * b(k,214) + b(k,222) = b(k,222) - lu(k,993) * b(k,214) + b(k,223) = b(k,223) - lu(k,994) * b(k,214) + b(k,226) = b(k,226) - lu(k,995) * b(k,214) + b(k,232) = b(k,232) - lu(k,996) * b(k,214) + b(k,239) = b(k,239) - lu(k,997) * b(k,214) + b(k,243) = b(k,243) - lu(k,998) * b(k,214) + b(k,245) = b(k,245) - lu(k,999) * b(k,214) + b(k,246) = b(k,246) - lu(k,1000) * b(k,214) + b(k,247) = b(k,247) - lu(k,1001) * b(k,214) + b(k,249) = b(k,249) - lu(k,1002) * b(k,214) + b(k,252) = b(k,252) - lu(k,1003) * b(k,214) + b(k,253) = b(k,253) - lu(k,1004) * b(k,214) + b(k,254) = b(k,254) - lu(k,1005) * b(k,214) + b(k,256) = b(k,256) - lu(k,1006) * b(k,214) + b(k,258) = b(k,258) - lu(k,1007) * b(k,214) + b(k,259) = b(k,259) - lu(k,1008) * b(k,214) + b(k,223) = b(k,223) - lu(k,1011) * b(k,215) + b(k,249) = b(k,249) - lu(k,1012) * b(k,215) + b(k,252) = b(k,252) - lu(k,1013) * b(k,215) + b(k,256) = b(k,256) - lu(k,1014) * b(k,215) + b(k,259) = b(k,259) - lu(k,1015) * b(k,215) + b(k,220) = b(k,220) - lu(k,1017) * b(k,216) + b(k,221) = b(k,221) - lu(k,1018) * b(k,216) + b(k,223) = b(k,223) - lu(k,1019) * b(k,216) + b(k,225) = b(k,225) - lu(k,1020) * b(k,216) + b(k,249) = b(k,249) - lu(k,1021) * b(k,216) + b(k,254) = b(k,254) - lu(k,1022) * b(k,216) + b(k,256) = b(k,256) - lu(k,1023) * b(k,216) + b(k,220) = b(k,220) - lu(k,1040) * b(k,217) + b(k,221) = b(k,221) - lu(k,1041) * b(k,217) + b(k,222) = b(k,222) - lu(k,1042) * b(k,217) + b(k,223) = b(k,223) - lu(k,1043) * b(k,217) + b(k,225) = b(k,225) - lu(k,1044) * b(k,217) + b(k,226) = b(k,226) - lu(k,1045) * b(k,217) + b(k,232) = b(k,232) - lu(k,1046) * b(k,217) + b(k,239) = b(k,239) - lu(k,1047) * b(k,217) + b(k,243) = b(k,243) - lu(k,1048) * b(k,217) + b(k,245) = b(k,245) - lu(k,1049) * b(k,217) + b(k,246) = b(k,246) - lu(k,1050) * b(k,217) + b(k,247) = b(k,247) - lu(k,1051) * b(k,217) + b(k,249) = b(k,249) - lu(k,1052) * b(k,217) + b(k,252) = b(k,252) - lu(k,1053) * b(k,217) + b(k,253) = b(k,253) - lu(k,1054) * b(k,217) + b(k,254) = b(k,254) - lu(k,1055) * b(k,217) + b(k,256) = b(k,256) - lu(k,1056) * b(k,217) + b(k,258) = b(k,258) - lu(k,1057) * b(k,217) + b(k,259) = b(k,259) - lu(k,1058) * b(k,217) + b(k,222) = b(k,222) - lu(k,1065) * b(k,218) + b(k,223) = b(k,223) - lu(k,1066) * b(k,218) + b(k,227) = b(k,227) - lu(k,1067) * b(k,218) + b(k,232) = b(k,232) - lu(k,1068) * b(k,218) + b(k,239) = b(k,239) - lu(k,1069) * b(k,218) + b(k,242) = b(k,242) - lu(k,1070) * b(k,218) + b(k,245) = b(k,245) - lu(k,1071) * b(k,218) + b(k,246) = b(k,246) - lu(k,1072) * b(k,218) + b(k,247) = b(k,247) - lu(k,1073) * b(k,218) + b(k,249) = b(k,249) - lu(k,1074) * b(k,218) + b(k,252) = b(k,252) - lu(k,1075) * b(k,218) + b(k,253) = b(k,253) - lu(k,1076) * b(k,218) + b(k,254) = b(k,254) - lu(k,1077) * b(k,218) + b(k,256) = b(k,256) - lu(k,1078) * b(k,218) + b(k,258) = b(k,258) - lu(k,1079) * b(k,218) + b(k,259) = b(k,259) - lu(k,1080) * b(k,218) + b(k,223) = b(k,223) - lu(k,1086) * b(k,219) + b(k,232) = b(k,232) - lu(k,1087) * b(k,219) + b(k,239) = b(k,239) - lu(k,1088) * b(k,219) + b(k,243) = b(k,243) - lu(k,1089) * b(k,219) + b(k,245) = b(k,245) - lu(k,1090) * b(k,219) + b(k,246) = b(k,246) - lu(k,1091) * b(k,219) + b(k,247) = b(k,247) - lu(k,1092) * b(k,219) + b(k,249) = b(k,249) - lu(k,1093) * b(k,219) + b(k,252) = b(k,252) - lu(k,1094) * b(k,219) + b(k,253) = b(k,253) - lu(k,1095) * b(k,219) + b(k,256) = b(k,256) - lu(k,1096) * b(k,219) + b(k,221) = b(k,221) - lu(k,1102) * b(k,220) + b(k,223) = b(k,223) - lu(k,1103) * b(k,220) + b(k,225) = b(k,225) - lu(k,1104) * b(k,220) + b(k,243) = b(k,243) - lu(k,1105) * b(k,220) + b(k,245) = b(k,245) - lu(k,1106) * b(k,220) + b(k,246) = b(k,246) - lu(k,1107) * b(k,220) + b(k,247) = b(k,247) - lu(k,1108) * b(k,220) + b(k,249) = b(k,249) - lu(k,1109) * b(k,220) + b(k,253) = b(k,253) - lu(k,1110) * b(k,220) + b(k,254) = b(k,254) - lu(k,1111) * b(k,220) + b(k,256) = b(k,256) - lu(k,1112) * b(k,220) + b(k,223) = b(k,223) - lu(k,1116) * b(k,221) + b(k,226) = b(k,226) - lu(k,1117) * b(k,221) + b(k,239) = b(k,239) - lu(k,1118) * b(k,221) + b(k,246) = b(k,246) - lu(k,1119) * b(k,221) + b(k,249) = b(k,249) - lu(k,1120) * b(k,221) + b(k,252) = b(k,252) - lu(k,1121) * b(k,221) + b(k,253) = b(k,253) - lu(k,1122) * b(k,221) + b(k,256) = b(k,256) - lu(k,1123) * b(k,221) + b(k,259) = b(k,259) - lu(k,1124) * b(k,221) + b(k,223) = b(k,223) - lu(k,1126) * b(k,222) + b(k,239) = b(k,239) - lu(k,1127) * b(k,222) + b(k,243) = b(k,243) - lu(k,1128) * b(k,222) + b(k,246) = b(k,246) - lu(k,1129) * b(k,222) + b(k,249) = b(k,249) - lu(k,1130) * b(k,222) + b(k,254) = b(k,254) - lu(k,1131) * b(k,222) + b(k,256) = b(k,256) - lu(k,1132) * b(k,222) + b(k,259) = b(k,259) - lu(k,1133) * b(k,222) + b(k,249) = b(k,249) - lu(k,1136) * b(k,223) + b(k,252) = b(k,252) - lu(k,1137) * b(k,223) + b(k,256) = b(k,256) - lu(k,1138) * b(k,223) + b(k,249) = b(k,249) - lu(k,1143) * b(k,224) + b(k,252) = b(k,252) - lu(k,1144) * b(k,224) + b(k,253) = b(k,253) - lu(k,1145) * b(k,224) + b(k,256) = b(k,256) - lu(k,1146) * b(k,224) + b(k,226) = b(k,226) - lu(k,1156) * b(k,225) + b(k,239) = b(k,239) - lu(k,1157) * b(k,225) + b(k,243) = b(k,243) - lu(k,1158) * b(k,225) + b(k,245) = b(k,245) - lu(k,1159) * b(k,225) + b(k,246) = b(k,246) - lu(k,1160) * b(k,225) + b(k,247) = b(k,247) - lu(k,1161) * b(k,225) + b(k,249) = b(k,249) - lu(k,1162) * b(k,225) + b(k,252) = b(k,252) - lu(k,1163) * b(k,225) + b(k,253) = b(k,253) - lu(k,1164) * b(k,225) + b(k,256) = b(k,256) - lu(k,1165) * b(k,225) + b(k,259) = b(k,259) - lu(k,1166) * b(k,225) + b(k,227) = b(k,227) - lu(k,1170) * b(k,226) + b(k,232) = b(k,232) - lu(k,1171) * b(k,226) + b(k,239) = b(k,239) - lu(k,1172) * b(k,226) + b(k,245) = b(k,245) - lu(k,1173) * b(k,226) + b(k,246) = b(k,246) - lu(k,1174) * b(k,226) + b(k,247) = b(k,247) - lu(k,1175) * b(k,226) + b(k,249) = b(k,249) - lu(k,1176) * b(k,226) + b(k,253) = b(k,253) - lu(k,1177) * b(k,226) + b(k,256) = b(k,256) - lu(k,1178) * b(k,226) + b(k,259) = b(k,259) - lu(k,1179) * b(k,226) + b(k,232) = b(k,232) - lu(k,1181) * b(k,227) + b(k,239) = b(k,239) - lu(k,1182) * b(k,227) + b(k,249) = b(k,249) - lu(k,1183) * b(k,227) + b(k,253) = b(k,253) - lu(k,1184) * b(k,227) + b(k,256) = b(k,256) - lu(k,1185) * b(k,227) + b(k,232) = b(k,232) - lu(k,1194) * b(k,228) + b(k,239) = b(k,239) - lu(k,1195) * b(k,228) + b(k,243) = b(k,243) - lu(k,1196) * b(k,228) + b(k,245) = b(k,245) - lu(k,1197) * b(k,228) + b(k,246) = b(k,246) - lu(k,1198) * b(k,228) + b(k,247) = b(k,247) - lu(k,1199) * b(k,228) + b(k,249) = b(k,249) - lu(k,1200) * b(k,228) + b(k,252) = b(k,252) - lu(k,1201) * b(k,228) + b(k,253) = b(k,253) - lu(k,1202) * b(k,228) + b(k,254) = b(k,254) - lu(k,1203) * b(k,228) + b(k,256) = b(k,256) - lu(k,1204) * b(k,228) + b(k,259) = b(k,259) - lu(k,1205) * b(k,228) + b(k,232) = b(k,232) - lu(k,1214) * b(k,229) + b(k,239) = b(k,239) - lu(k,1215) * b(k,229) + b(k,245) = b(k,245) - lu(k,1216) * b(k,229) + b(k,246) = b(k,246) - lu(k,1217) * b(k,229) + b(k,247) = b(k,247) - lu(k,1218) * b(k,229) + b(k,249) = b(k,249) - lu(k,1219) * b(k,229) + b(k,252) = b(k,252) - lu(k,1220) * b(k,229) + b(k,253) = b(k,253) - lu(k,1221) * b(k,229) + b(k,254) = b(k,254) - lu(k,1222) * b(k,229) + b(k,256) = b(k,256) - lu(k,1223) * b(k,229) + b(k,231) = b(k,231) - lu(k,1234) * b(k,230) + b(k,232) = b(k,232) - lu(k,1235) * b(k,230) + b(k,237) = b(k,237) - lu(k,1236) * b(k,230) + b(k,239) = b(k,239) - lu(k,1237) * b(k,230) + b(k,243) = b(k,243) - lu(k,1238) * b(k,230) + b(k,245) = b(k,245) - lu(k,1239) * b(k,230) + b(k,246) = b(k,246) - lu(k,1240) * b(k,230) + b(k,247) = b(k,247) - lu(k,1241) * b(k,230) + b(k,249) = b(k,249) - lu(k,1242) * b(k,230) + b(k,252) = b(k,252) - lu(k,1243) * b(k,230) + b(k,253) = b(k,253) - lu(k,1244) * b(k,230) + b(k,254) = b(k,254) - lu(k,1245) * b(k,230) + b(k,256) = b(k,256) - lu(k,1246) * b(k,230) end do end subroutine lu_slv04 subroutine lu_slv05( avec_len, lu, b ) @@ -920,164 +920,210 @@ subroutine lu_slv05( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,207) = b(k,207) - lu(k,1250) * b(k,206) - b(k,209) = b(k,209) - lu(k,1251) * b(k,206) - b(k,210) = b(k,210) - lu(k,1252) * b(k,206) - b(k,211) = b(k,211) - lu(k,1253) * b(k,206) - b(k,213) = b(k,213) - lu(k,1254) * b(k,206) - b(k,215) = b(k,215) - lu(k,1255) * b(k,206) - b(k,216) = b(k,216) - lu(k,1256) * b(k,206) - b(k,217) = b(k,217) - lu(k,1257) * b(k,206) - b(k,218) = b(k,218) - lu(k,1258) * b(k,206) - b(k,219) = b(k,219) - lu(k,1259) * b(k,206) - b(k,220) = b(k,220) - lu(k,1260) * b(k,206) - b(k,225) = b(k,225) - lu(k,1261) * b(k,206) - b(k,209) = b(k,209) - lu(k,1281) * b(k,207) - b(k,210) = b(k,210) - lu(k,1282) * b(k,207) - b(k,211) = b(k,211) - lu(k,1283) * b(k,207) - b(k,213) = b(k,213) - lu(k,1284) * b(k,207) - b(k,215) = b(k,215) - lu(k,1285) * b(k,207) - b(k,216) = b(k,216) - lu(k,1286) * b(k,207) - b(k,217) = b(k,217) - lu(k,1287) * b(k,207) - b(k,218) = b(k,218) - lu(k,1288) * b(k,207) - b(k,219) = b(k,219) - lu(k,1289) * b(k,207) - b(k,220) = b(k,220) - lu(k,1290) * b(k,207) - b(k,225) = b(k,225) - lu(k,1291) * b(k,207) - b(k,210) = b(k,210) - lu(k,1295) * b(k,208) - b(k,213) = b(k,213) - lu(k,1296) * b(k,208) - b(k,214) = b(k,214) - lu(k,1297) * b(k,208) - b(k,215) = b(k,215) - lu(k,1298) * b(k,208) - b(k,216) = b(k,216) - lu(k,1299) * b(k,208) - b(k,220) = b(k,220) - lu(k,1300) * b(k,208) - b(k,221) = b(k,221) - lu(k,1301) * b(k,208) - b(k,223) = b(k,223) - lu(k,1302) * b(k,208) - b(k,225) = b(k,225) - lu(k,1303) * b(k,208) - b(k,210) = b(k,210) - lu(k,1308) * b(k,209) - b(k,212) = b(k,212) - lu(k,1309) * b(k,209) - b(k,214) = b(k,214) - lu(k,1310) * b(k,209) - b(k,215) = b(k,215) - lu(k,1311) * b(k,209) - b(k,217) = b(k,217) - lu(k,1312) * b(k,209) - b(k,218) = b(k,218) - lu(k,1313) * b(k,209) - b(k,219) = b(k,219) - lu(k,1314) * b(k,209) - b(k,223) = b(k,223) - lu(k,1315) * b(k,209) - b(k,224) = b(k,224) - lu(k,1316) * b(k,209) - b(k,225) = b(k,225) - lu(k,1317) * b(k,209) - b(k,212) = b(k,212) - lu(k,1321) * b(k,210) - b(k,213) = b(k,213) - lu(k,1322) * b(k,210) - b(k,214) = b(k,214) - lu(k,1323) * b(k,210) - b(k,215) = b(k,215) - lu(k,1324) * b(k,210) - b(k,217) = b(k,217) - lu(k,1325) * b(k,210) - b(k,218) = b(k,218) - lu(k,1326) * b(k,210) - b(k,219) = b(k,219) - lu(k,1327) * b(k,210) - b(k,220) = b(k,220) - lu(k,1328) * b(k,210) - b(k,223) = b(k,223) - lu(k,1329) * b(k,210) - b(k,224) = b(k,224) - lu(k,1330) * b(k,210) - b(k,225) = b(k,225) - lu(k,1331) * b(k,210) - b(k,212) = b(k,212) - lu(k,1396) * b(k,211) - b(k,213) = b(k,213) - lu(k,1397) * b(k,211) - b(k,214) = b(k,214) - lu(k,1398) * b(k,211) - b(k,215) = b(k,215) - lu(k,1399) * b(k,211) - b(k,216) = b(k,216) - lu(k,1400) * b(k,211) - b(k,217) = b(k,217) - lu(k,1401) * b(k,211) - b(k,218) = b(k,218) - lu(k,1402) * b(k,211) - b(k,219) = b(k,219) - lu(k,1403) * b(k,211) - b(k,220) = b(k,220) - lu(k,1404) * b(k,211) - b(k,221) = b(k,221) - lu(k,1405) * b(k,211) - b(k,222) = b(k,222) - lu(k,1406) * b(k,211) - b(k,223) = b(k,223) - lu(k,1407) * b(k,211) - b(k,224) = b(k,224) - lu(k,1408) * b(k,211) - b(k,225) = b(k,225) - lu(k,1409) * b(k,211) - b(k,213) = b(k,213) - lu(k,1419) * b(k,212) - b(k,214) = b(k,214) - lu(k,1420) * b(k,212) - b(k,215) = b(k,215) - lu(k,1421) * b(k,212) - b(k,216) = b(k,216) - lu(k,1422) * b(k,212) - b(k,217) = b(k,217) - lu(k,1423) * b(k,212) - b(k,218) = b(k,218) - lu(k,1424) * b(k,212) - b(k,219) = b(k,219) - lu(k,1425) * b(k,212) - b(k,220) = b(k,220) - lu(k,1426) * b(k,212) - b(k,221) = b(k,221) - lu(k,1427) * b(k,212) - b(k,222) = b(k,222) - lu(k,1428) * b(k,212) - b(k,223) = b(k,223) - lu(k,1429) * b(k,212) - b(k,224) = b(k,224) - lu(k,1430) * b(k,212) - b(k,225) = b(k,225) - lu(k,1431) * b(k,212) - b(k,214) = b(k,214) - lu(k,1514) * b(k,213) - b(k,215) = b(k,215) - lu(k,1515) * b(k,213) - b(k,216) = b(k,216) - lu(k,1516) * b(k,213) - b(k,217) = b(k,217) - lu(k,1517) * b(k,213) - b(k,218) = b(k,218) - lu(k,1518) * b(k,213) - b(k,219) = b(k,219) - lu(k,1519) * b(k,213) - b(k,220) = b(k,220) - lu(k,1520) * b(k,213) - b(k,221) = b(k,221) - lu(k,1521) * b(k,213) - b(k,222) = b(k,222) - lu(k,1522) * b(k,213) - b(k,223) = b(k,223) - lu(k,1523) * b(k,213) - b(k,224) = b(k,224) - lu(k,1524) * b(k,213) - b(k,225) = b(k,225) - lu(k,1525) * b(k,213) - b(k,215) = b(k,215) - lu(k,1539) * b(k,214) - b(k,216) = b(k,216) - lu(k,1540) * b(k,214) - b(k,217) = b(k,217) - lu(k,1541) * b(k,214) - b(k,218) = b(k,218) - lu(k,1542) * b(k,214) - b(k,219) = b(k,219) - lu(k,1543) * b(k,214) - b(k,220) = b(k,220) - lu(k,1544) * b(k,214) - b(k,221) = b(k,221) - lu(k,1545) * b(k,214) - b(k,222) = b(k,222) - lu(k,1546) * b(k,214) - b(k,223) = b(k,223) - lu(k,1547) * b(k,214) - b(k,224) = b(k,224) - lu(k,1548) * b(k,214) - b(k,225) = b(k,225) - lu(k,1549) * b(k,214) - b(k,216) = b(k,216) - lu(k,1699) * b(k,215) - b(k,217) = b(k,217) - lu(k,1700) * b(k,215) - b(k,218) = b(k,218) - lu(k,1701) * b(k,215) - b(k,219) = b(k,219) - lu(k,1702) * b(k,215) - b(k,220) = b(k,220) - lu(k,1703) * b(k,215) - b(k,221) = b(k,221) - lu(k,1704) * b(k,215) - b(k,222) = b(k,222) - lu(k,1705) * b(k,215) - b(k,223) = b(k,223) - lu(k,1706) * b(k,215) - b(k,224) = b(k,224) - lu(k,1707) * b(k,215) - b(k,225) = b(k,225) - lu(k,1708) * b(k,215) - b(k,217) = b(k,217) - lu(k,1723) * b(k,216) - b(k,218) = b(k,218) - lu(k,1724) * b(k,216) - b(k,219) = b(k,219) - lu(k,1725) * b(k,216) - b(k,220) = b(k,220) - lu(k,1726) * b(k,216) - b(k,221) = b(k,221) - lu(k,1727) * b(k,216) - b(k,222) = b(k,222) - lu(k,1728) * b(k,216) - b(k,223) = b(k,223) - lu(k,1729) * b(k,216) - b(k,224) = b(k,224) - lu(k,1730) * b(k,216) - b(k,225) = b(k,225) - lu(k,1731) * b(k,216) - b(k,218) = b(k,218) - lu(k,1765) * b(k,217) - b(k,219) = b(k,219) - lu(k,1766) * b(k,217) - b(k,220) = b(k,220) - lu(k,1767) * b(k,217) - b(k,221) = b(k,221) - lu(k,1768) * b(k,217) - b(k,222) = b(k,222) - lu(k,1769) * b(k,217) - b(k,223) = b(k,223) - lu(k,1770) * b(k,217) - b(k,224) = b(k,224) - lu(k,1771) * b(k,217) - b(k,225) = b(k,225) - lu(k,1772) * b(k,217) - b(k,219) = b(k,219) - lu(k,1823) * b(k,218) - b(k,220) = b(k,220) - lu(k,1824) * b(k,218) - b(k,221) = b(k,221) - lu(k,1825) * b(k,218) - b(k,222) = b(k,222) - lu(k,1826) * b(k,218) - b(k,223) = b(k,223) - lu(k,1827) * b(k,218) - b(k,224) = b(k,224) - lu(k,1828) * b(k,218) - b(k,225) = b(k,225) - lu(k,1829) * b(k,218) - b(k,220) = b(k,220) - lu(k,1874) * b(k,219) - b(k,221) = b(k,221) - lu(k,1875) * b(k,219) - b(k,222) = b(k,222) - lu(k,1876) * b(k,219) - b(k,223) = b(k,223) - lu(k,1877) * b(k,219) - b(k,224) = b(k,224) - lu(k,1878) * b(k,219) - b(k,225) = b(k,225) - lu(k,1879) * b(k,219) - b(k,221) = b(k,221) - lu(k,1935) * b(k,220) - b(k,222) = b(k,222) - lu(k,1936) * b(k,220) - b(k,223) = b(k,223) - lu(k,1937) * b(k,220) - b(k,224) = b(k,224) - lu(k,1938) * b(k,220) - b(k,225) = b(k,225) - lu(k,1939) * b(k,220) - b(k,222) = b(k,222) - lu(k,1960) * b(k,221) - b(k,223) = b(k,223) - lu(k,1961) * b(k,221) - b(k,224) = b(k,224) - lu(k,1962) * b(k,221) - b(k,225) = b(k,225) - lu(k,1963) * b(k,221) - b(k,223) = b(k,223) - lu(k,1987) * b(k,222) - b(k,224) = b(k,224) - lu(k,1988) * b(k,222) - b(k,225) = b(k,225) - lu(k,1989) * b(k,222) - b(k,224) = b(k,224) - lu(k,2018) * b(k,223) - b(k,225) = b(k,225) - lu(k,2019) * b(k,223) - b(k,225) = b(k,225) - lu(k,2053) * b(k,224) + b(k,232) = b(k,232) - lu(k,1250) * b(k,231) + b(k,236) = b(k,236) - lu(k,1251) * b(k,231) + b(k,238) = b(k,238) - lu(k,1252) * b(k,231) + b(k,239) = b(k,239) - lu(k,1253) * b(k,231) + b(k,249) = b(k,249) - lu(k,1254) * b(k,231) + b(k,252) = b(k,252) - lu(k,1255) * b(k,231) + b(k,253) = b(k,253) - lu(k,1256) * b(k,231) + b(k,256) = b(k,256) - lu(k,1257) * b(k,231) + b(k,258) = b(k,258) - lu(k,1258) * b(k,231) + b(k,259) = b(k,259) - lu(k,1259) * b(k,231) + b(k,239) = b(k,239) - lu(k,1262) * b(k,232) + b(k,243) = b(k,243) - lu(k,1263) * b(k,232) + b(k,249) = b(k,249) - lu(k,1264) * b(k,232) + b(k,252) = b(k,252) - lu(k,1265) * b(k,232) + b(k,254) = b(k,254) - lu(k,1266) * b(k,232) + b(k,256) = b(k,256) - lu(k,1267) * b(k,232) + b(k,259) = b(k,259) - lu(k,1268) * b(k,232) + b(k,241) = b(k,241) - lu(k,1273) * b(k,233) + b(k,244) = b(k,244) - lu(k,1274) * b(k,233) + b(k,245) = b(k,245) - lu(k,1275) * b(k,233) + b(k,247) = b(k,247) - lu(k,1276) * b(k,233) + b(k,249) = b(k,249) - lu(k,1277) * b(k,233) + b(k,250) = b(k,250) - lu(k,1278) * b(k,233) + b(k,252) = b(k,252) - lu(k,1279) * b(k,233) + b(k,255) = b(k,255) - lu(k,1280) * b(k,233) + b(k,256) = b(k,256) - lu(k,1281) * b(k,233) + b(k,257) = b(k,257) - lu(k,1282) * b(k,233) + b(k,258) = b(k,258) - lu(k,1283) * b(k,233) + b(k,259) = b(k,259) - lu(k,1284) * b(k,233) + b(k,236) = b(k,236) - lu(k,1297) * b(k,234) + b(k,237) = b(k,237) - lu(k,1298) * b(k,234) + b(k,238) = b(k,238) - lu(k,1299) * b(k,234) + b(k,239) = b(k,239) - lu(k,1300) * b(k,234) + b(k,243) = b(k,243) - lu(k,1301) * b(k,234) + b(k,245) = b(k,245) - lu(k,1302) * b(k,234) + b(k,246) = b(k,246) - lu(k,1303) * b(k,234) + b(k,247) = b(k,247) - lu(k,1304) * b(k,234) + b(k,249) = b(k,249) - lu(k,1305) * b(k,234) + b(k,252) = b(k,252) - lu(k,1306) * b(k,234) + b(k,253) = b(k,253) - lu(k,1307) * b(k,234) + b(k,254) = b(k,254) - lu(k,1308) * b(k,234) + b(k,256) = b(k,256) - lu(k,1309) * b(k,234) + b(k,258) = b(k,258) - lu(k,1310) * b(k,234) + b(k,259) = b(k,259) - lu(k,1311) * b(k,234) + b(k,236) = b(k,236) - lu(k,1329) * b(k,235) + b(k,237) = b(k,237) - lu(k,1330) * b(k,235) + b(k,238) = b(k,238) - lu(k,1331) * b(k,235) + b(k,239) = b(k,239) - lu(k,1332) * b(k,235) + b(k,243) = b(k,243) - lu(k,1333) * b(k,235) + b(k,245) = b(k,245) - lu(k,1334) * b(k,235) + b(k,246) = b(k,246) - lu(k,1335) * b(k,235) + b(k,247) = b(k,247) - lu(k,1336) * b(k,235) + b(k,249) = b(k,249) - lu(k,1337) * b(k,235) + b(k,252) = b(k,252) - lu(k,1338) * b(k,235) + b(k,253) = b(k,253) - lu(k,1339) * b(k,235) + b(k,254) = b(k,254) - lu(k,1340) * b(k,235) + b(k,256) = b(k,256) - lu(k,1341) * b(k,235) + b(k,258) = b(k,258) - lu(k,1342) * b(k,235) + b(k,259) = b(k,259) - lu(k,1343) * b(k,235) + b(k,238) = b(k,238) - lu(k,1352) * b(k,236) + b(k,239) = b(k,239) - lu(k,1353) * b(k,236) + b(k,243) = b(k,243) - lu(k,1354) * b(k,236) + b(k,245) = b(k,245) - lu(k,1355) * b(k,236) + b(k,246) = b(k,246) - lu(k,1356) * b(k,236) + b(k,247) = b(k,247) - lu(k,1357) * b(k,236) + b(k,249) = b(k,249) - lu(k,1358) * b(k,236) + b(k,252) = b(k,252) - lu(k,1359) * b(k,236) + b(k,253) = b(k,253) - lu(k,1360) * b(k,236) + b(k,254) = b(k,254) - lu(k,1361) * b(k,236) + b(k,256) = b(k,256) - lu(k,1362) * b(k,236) + b(k,259) = b(k,259) - lu(k,1363) * b(k,236) + b(k,238) = b(k,238) - lu(k,1373) * b(k,237) + b(k,239) = b(k,239) - lu(k,1374) * b(k,237) + b(k,242) = b(k,242) - lu(k,1375) * b(k,237) + b(k,243) = b(k,243) - lu(k,1376) * b(k,237) + b(k,245) = b(k,245) - lu(k,1377) * b(k,237) + b(k,246) = b(k,246) - lu(k,1378) * b(k,237) + b(k,247) = b(k,247) - lu(k,1379) * b(k,237) + b(k,249) = b(k,249) - lu(k,1380) * b(k,237) + b(k,252) = b(k,252) - lu(k,1381) * b(k,237) + b(k,253) = b(k,253) - lu(k,1382) * b(k,237) + b(k,254) = b(k,254) - lu(k,1383) * b(k,237) + b(k,256) = b(k,256) - lu(k,1384) * b(k,237) + b(k,258) = b(k,258) - lu(k,1385) * b(k,237) + b(k,259) = b(k,259) - lu(k,1386) * b(k,237) + b(k,239) = b(k,239) - lu(k,1395) * b(k,238) + b(k,243) = b(k,243) - lu(k,1396) * b(k,238) + b(k,245) = b(k,245) - lu(k,1397) * b(k,238) + b(k,246) = b(k,246) - lu(k,1398) * b(k,238) + b(k,247) = b(k,247) - lu(k,1399) * b(k,238) + b(k,249) = b(k,249) - lu(k,1400) * b(k,238) + b(k,252) = b(k,252) - lu(k,1401) * b(k,238) + b(k,253) = b(k,253) - lu(k,1402) * b(k,238) + b(k,254) = b(k,254) - lu(k,1403) * b(k,238) + b(k,256) = b(k,256) - lu(k,1404) * b(k,238) + b(k,258) = b(k,258) - lu(k,1405) * b(k,238) + b(k,259) = b(k,259) - lu(k,1406) * b(k,238) + b(k,242) = b(k,242) - lu(k,1427) * b(k,239) + b(k,243) = b(k,243) - lu(k,1428) * b(k,239) + b(k,245) = b(k,245) - lu(k,1429) * b(k,239) + b(k,246) = b(k,246) - lu(k,1430) * b(k,239) + b(k,247) = b(k,247) - lu(k,1431) * b(k,239) + b(k,249) = b(k,249) - lu(k,1432) * b(k,239) + b(k,252) = b(k,252) - lu(k,1433) * b(k,239) + b(k,253) = b(k,253) - lu(k,1434) * b(k,239) + b(k,254) = b(k,254) - lu(k,1435) * b(k,239) + b(k,256) = b(k,256) - lu(k,1436) * b(k,239) + b(k,258) = b(k,258) - lu(k,1437) * b(k,239) + b(k,259) = b(k,259) - lu(k,1438) * b(k,239) + b(k,242) = b(k,242) - lu(k,1442) * b(k,240) + b(k,243) = b(k,243) - lu(k,1443) * b(k,240) + b(k,244) = b(k,244) - lu(k,1444) * b(k,240) + b(k,246) = b(k,246) - lu(k,1445) * b(k,240) + b(k,248) = b(k,248) - lu(k,1446) * b(k,240) + b(k,249) = b(k,249) - lu(k,1447) * b(k,240) + b(k,251) = b(k,251) - lu(k,1448) * b(k,240) + b(k,252) = b(k,252) - lu(k,1449) * b(k,240) + b(k,254) = b(k,254) - lu(k,1450) * b(k,240) + b(k,257) = b(k,257) - lu(k,1451) * b(k,240) + b(k,259) = b(k,259) - lu(k,1452) * b(k,240) + b(k,244) = b(k,244) - lu(k,1456) * b(k,241) + b(k,248) = b(k,248) - lu(k,1457) * b(k,241) + b(k,249) = b(k,249) - lu(k,1458) * b(k,241) + b(k,252) = b(k,252) - lu(k,1459) * b(k,241) + b(k,253) = b(k,253) - lu(k,1460) * b(k,241) + b(k,255) = b(k,255) - lu(k,1461) * b(k,241) + b(k,256) = b(k,256) - lu(k,1462) * b(k,241) + b(k,258) = b(k,258) - lu(k,1463) * b(k,241) + b(k,259) = b(k,259) - lu(k,1464) * b(k,241) + b(k,243) = b(k,243) - lu(k,1471) * b(k,242) + b(k,244) = b(k,244) - lu(k,1472) * b(k,242) + b(k,246) = b(k,246) - lu(k,1473) * b(k,242) + b(k,248) = b(k,248) - lu(k,1474) * b(k,242) + b(k,249) = b(k,249) - lu(k,1475) * b(k,242) + b(k,251) = b(k,251) - lu(k,1476) * b(k,242) + b(k,252) = b(k,252) - lu(k,1477) * b(k,242) + b(k,253) = b(k,253) - lu(k,1478) * b(k,242) + b(k,254) = b(k,254) - lu(k,1479) * b(k,242) + b(k,256) = b(k,256) - lu(k,1480) * b(k,242) + b(k,257) = b(k,257) - lu(k,1481) * b(k,242) + b(k,259) = b(k,259) - lu(k,1482) * b(k,242) + b(k,244) = b(k,244) - lu(k,1488) * b(k,243) + b(k,246) = b(k,246) - lu(k,1489) * b(k,243) + b(k,247) = b(k,247) - lu(k,1490) * b(k,243) + b(k,248) = b(k,248) - lu(k,1491) * b(k,243) + b(k,249) = b(k,249) - lu(k,1492) * b(k,243) + b(k,251) = b(k,251) - lu(k,1493) * b(k,243) + b(k,252) = b(k,252) - lu(k,1494) * b(k,243) + b(k,253) = b(k,253) - lu(k,1495) * b(k,243) + b(k,254) = b(k,254) - lu(k,1496) * b(k,243) + b(k,256) = b(k,256) - lu(k,1497) * b(k,243) + b(k,257) = b(k,257) - lu(k,1498) * b(k,243) + b(k,259) = b(k,259) - lu(k,1499) * b(k,243) + b(k,246) = b(k,246) - lu(k,1504) * b(k,244) + b(k,247) = b(k,247) - lu(k,1505) * b(k,244) + b(k,248) = b(k,248) - lu(k,1506) * b(k,244) + b(k,249) = b(k,249) - lu(k,1507) * b(k,244) + b(k,251) = b(k,251) - lu(k,1508) * b(k,244) + b(k,252) = b(k,252) - lu(k,1509) * b(k,244) + b(k,253) = b(k,253) - lu(k,1510) * b(k,244) + b(k,254) = b(k,254) - lu(k,1511) * b(k,244) + b(k,256) = b(k,256) - lu(k,1512) * b(k,244) + b(k,257) = b(k,257) - lu(k,1513) * b(k,244) + b(k,258) = b(k,258) - lu(k,1514) * b(k,244) + b(k,259) = b(k,259) - lu(k,1515) * b(k,244) + b(k,246) = b(k,246) - lu(k,1605) * b(k,245) + b(k,247) = b(k,247) - lu(k,1606) * b(k,245) + b(k,248) = b(k,248) - lu(k,1607) * b(k,245) + b(k,249) = b(k,249) - lu(k,1608) * b(k,245) + b(k,250) = b(k,250) - lu(k,1609) * b(k,245) + b(k,251) = b(k,251) - lu(k,1610) * b(k,245) + b(k,252) = b(k,252) - lu(k,1611) * b(k,245) + b(k,253) = b(k,253) - lu(k,1612) * b(k,245) + b(k,254) = b(k,254) - lu(k,1613) * b(k,245) + b(k,255) = b(k,255) - lu(k,1614) * b(k,245) + b(k,256) = b(k,256) - lu(k,1615) * b(k,245) + b(k,257) = b(k,257) - lu(k,1616) * b(k,245) + b(k,258) = b(k,258) - lu(k,1617) * b(k,245) + b(k,259) = b(k,259) - lu(k,1618) * b(k,245) + b(k,247) = b(k,247) - lu(k,1658) * b(k,246) + b(k,248) = b(k,248) - lu(k,1659) * b(k,246) + b(k,249) = b(k,249) - lu(k,1660) * b(k,246) + b(k,250) = b(k,250) - lu(k,1661) * b(k,246) + b(k,251) = b(k,251) - lu(k,1662) * b(k,246) + b(k,252) = b(k,252) - lu(k,1663) * b(k,246) + b(k,253) = b(k,253) - lu(k,1664) * b(k,246) + b(k,254) = b(k,254) - lu(k,1665) * b(k,246) + b(k,255) = b(k,255) - lu(k,1666) * b(k,246) + b(k,256) = b(k,256) - lu(k,1667) * b(k,246) + b(k,257) = b(k,257) - lu(k,1668) * b(k,246) + b(k,258) = b(k,258) - lu(k,1669) * b(k,246) + b(k,259) = b(k,259) - lu(k,1670) * b(k,246) + b(k,248) = b(k,248) - lu(k,1703) * b(k,247) + b(k,249) = b(k,249) - lu(k,1704) * b(k,247) + b(k,250) = b(k,250) - lu(k,1705) * b(k,247) + b(k,251) = b(k,251) - lu(k,1706) * b(k,247) + b(k,252) = b(k,252) - lu(k,1707) * b(k,247) + b(k,253) = b(k,253) - lu(k,1708) * b(k,247) + b(k,254) = b(k,254) - lu(k,1709) * b(k,247) + b(k,255) = b(k,255) - lu(k,1710) * b(k,247) + b(k,256) = b(k,256) - lu(k,1711) * b(k,247) + b(k,257) = b(k,257) - lu(k,1712) * b(k,247) + b(k,258) = b(k,258) - lu(k,1713) * b(k,247) + b(k,259) = b(k,259) - lu(k,1714) * b(k,247) end do end subroutine lu_slv05 subroutine lu_slv06( avec_len, lu, b ) @@ -1098,237 +1144,72 @@ subroutine lu_slv06( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len -!----------------------------------------------------------------------- -! ... Solve U * x = y -!----------------------------------------------------------------------- - b(k,225) = b(k,225) * lu(k,2078) - b(k,224) = b(k,224) - lu(k,2077) * b(k,225) - b(k,223) = b(k,223) - lu(k,2076) * b(k,225) - b(k,222) = b(k,222) - lu(k,2075) * b(k,225) - b(k,221) = b(k,221) - lu(k,2074) * b(k,225) - b(k,220) = b(k,220) - lu(k,2073) * b(k,225) - b(k,219) = b(k,219) - lu(k,2072) * b(k,225) - b(k,218) = b(k,218) - lu(k,2071) * b(k,225) - b(k,217) = b(k,217) - lu(k,2070) * b(k,225) - b(k,216) = b(k,216) - lu(k,2069) * b(k,225) - b(k,215) = b(k,215) - lu(k,2068) * b(k,225) - b(k,214) = b(k,214) - lu(k,2067) * b(k,225) - b(k,213) = b(k,213) - lu(k,2066) * b(k,225) - b(k,212) = b(k,212) - lu(k,2065) * b(k,225) - b(k,211) = b(k,211) - lu(k,2064) * b(k,225) - b(k,210) = b(k,210) - lu(k,2063) * b(k,225) - b(k,209) = b(k,209) - lu(k,2062) * b(k,225) - b(k,208) = b(k,208) - lu(k,2061) * b(k,225) - b(k,201) = b(k,201) - lu(k,2060) * b(k,225) - b(k,196) = b(k,196) - lu(k,2059) * b(k,225) - b(k,174) = b(k,174) - lu(k,2058) * b(k,225) - b(k,166) = b(k,166) - lu(k,2057) * b(k,225) - b(k,97) = b(k,97) - lu(k,2056) * b(k,225) - b(k,96) = b(k,96) - lu(k,2055) * b(k,225) - b(k,78) = b(k,78) - lu(k,2054) * b(k,225) - b(k,224) = b(k,224) * lu(k,2052) - b(k,223) = b(k,223) - lu(k,2051) * b(k,224) - b(k,222) = b(k,222) - lu(k,2050) * b(k,224) - b(k,221) = b(k,221) - lu(k,2049) * b(k,224) - b(k,220) = b(k,220) - lu(k,2048) * b(k,224) - b(k,219) = b(k,219) - lu(k,2047) * b(k,224) - b(k,218) = b(k,218) - lu(k,2046) * b(k,224) - b(k,217) = b(k,217) - lu(k,2045) * b(k,224) - b(k,216) = b(k,216) - lu(k,2044) * b(k,224) - b(k,215) = b(k,215) - lu(k,2043) * b(k,224) - b(k,214) = b(k,214) - lu(k,2042) * b(k,224) - b(k,213) = b(k,213) - lu(k,2041) * b(k,224) - b(k,212) = b(k,212) - lu(k,2040) * b(k,224) - b(k,211) = b(k,211) - lu(k,2039) * b(k,224) - b(k,210) = b(k,210) - lu(k,2038) * b(k,224) - b(k,209) = b(k,209) - lu(k,2037) * b(k,224) - b(k,208) = b(k,208) - lu(k,2036) * b(k,224) - b(k,207) = b(k,207) - lu(k,2035) * b(k,224) - b(k,196) = b(k,196) - lu(k,2034) * b(k,224) - b(k,195) = b(k,195) - lu(k,2033) * b(k,224) - b(k,189) = b(k,189) - lu(k,2032) * b(k,224) - b(k,186) = b(k,186) - lu(k,2031) * b(k,224) - b(k,182) = b(k,182) - lu(k,2030) * b(k,224) - b(k,177) = b(k,177) - lu(k,2029) * b(k,224) - b(k,172) = b(k,172) - lu(k,2028) * b(k,224) - b(k,171) = b(k,171) - lu(k,2027) * b(k,224) - b(k,168) = b(k,168) - lu(k,2026) * b(k,224) - b(k,159) = b(k,159) - lu(k,2025) * b(k,224) - b(k,148) = b(k,148) - lu(k,2024) * b(k,224) - b(k,144) = b(k,144) - lu(k,2023) * b(k,224) - b(k,104) = b(k,104) - lu(k,2022) * b(k,224) - b(k,103) = b(k,103) - lu(k,2021) * b(k,224) - b(k,82) = b(k,82) - lu(k,2020) * b(k,224) - b(k,223) = b(k,223) * lu(k,2017) - b(k,222) = b(k,222) - lu(k,2016) * b(k,223) - b(k,221) = b(k,221) - lu(k,2015) * b(k,223) - b(k,220) = b(k,220) - lu(k,2014) * b(k,223) - b(k,219) = b(k,219) - lu(k,2013) * b(k,223) - b(k,218) = b(k,218) - lu(k,2012) * b(k,223) - b(k,217) = b(k,217) - lu(k,2011) * b(k,223) - b(k,216) = b(k,216) - lu(k,2010) * b(k,223) - b(k,215) = b(k,215) - lu(k,2009) * b(k,223) - b(k,214) = b(k,214) - lu(k,2008) * b(k,223) - b(k,213) = b(k,213) - lu(k,2007) * b(k,223) - b(k,212) = b(k,212) - lu(k,2006) * b(k,223) - b(k,211) = b(k,211) - lu(k,2005) * b(k,223) - b(k,210) = b(k,210) - lu(k,2004) * b(k,223) - b(k,209) = b(k,209) - lu(k,2003) * b(k,223) - b(k,208) = b(k,208) - lu(k,2002) * b(k,223) - b(k,201) = b(k,201) - lu(k,2001) * b(k,223) - b(k,196) = b(k,196) - lu(k,2000) * b(k,223) - b(k,189) = b(k,189) - lu(k,1999) * b(k,223) - b(k,182) = b(k,182) - lu(k,1998) * b(k,223) - b(k,174) = b(k,174) - lu(k,1997) * b(k,223) - b(k,171) = b(k,171) - lu(k,1996) * b(k,223) - b(k,170) = b(k,170) - lu(k,1995) * b(k,223) - b(k,165) = b(k,165) - lu(k,1994) * b(k,223) - b(k,148) = b(k,148) - lu(k,1993) * b(k,223) - b(k,146) = b(k,146) - lu(k,1992) * b(k,223) - b(k,137) = b(k,137) - lu(k,1991) * b(k,223) - b(k,115) = b(k,115) - lu(k,1990) * b(k,223) - b(k,222) = b(k,222) * lu(k,1986) - b(k,221) = b(k,221) - lu(k,1985) * b(k,222) - b(k,220) = b(k,220) - lu(k,1984) * b(k,222) - b(k,219) = b(k,219) - lu(k,1983) * b(k,222) - b(k,218) = b(k,218) - lu(k,1982) * b(k,222) - b(k,217) = b(k,217) - lu(k,1981) * b(k,222) - b(k,216) = b(k,216) - lu(k,1980) * b(k,222) - b(k,215) = b(k,215) - lu(k,1979) * b(k,222) - b(k,214) = b(k,214) - lu(k,1978) * b(k,222) - b(k,213) = b(k,213) - lu(k,1977) * b(k,222) - b(k,212) = b(k,212) - lu(k,1976) * b(k,222) - b(k,211) = b(k,211) - lu(k,1975) * b(k,222) - b(k,210) = b(k,210) - lu(k,1974) * b(k,222) - b(k,209) = b(k,209) - lu(k,1973) * b(k,222) - b(k,208) = b(k,208) - lu(k,1972) * b(k,222) - b(k,201) = b(k,201) - lu(k,1971) * b(k,222) - b(k,182) = b(k,182) - lu(k,1970) * b(k,222) - b(k,174) = b(k,174) - lu(k,1969) * b(k,222) - b(k,171) = b(k,171) - lu(k,1968) * b(k,222) - b(k,107) = b(k,107) - lu(k,1967) * b(k,222) - b(k,93) = b(k,93) - lu(k,1966) * b(k,222) - b(k,82) = b(k,82) - lu(k,1965) * b(k,222) - b(k,72) = b(k,72) - lu(k,1964) * b(k,222) - b(k,221) = b(k,221) * lu(k,1959) - b(k,220) = b(k,220) - lu(k,1958) * b(k,221) - b(k,219) = b(k,219) - lu(k,1957) * b(k,221) - b(k,218) = b(k,218) - lu(k,1956) * b(k,221) - b(k,217) = b(k,217) - lu(k,1955) * b(k,221) - b(k,216) = b(k,216) - lu(k,1954) * b(k,221) - b(k,215) = b(k,215) - lu(k,1953) * b(k,221) - b(k,214) = b(k,214) - lu(k,1952) * b(k,221) - b(k,213) = b(k,213) - lu(k,1951) * b(k,221) - b(k,212) = b(k,212) - lu(k,1950) * b(k,221) - b(k,211) = b(k,211) - lu(k,1949) * b(k,221) - b(k,210) = b(k,210) - lu(k,1948) * b(k,221) - b(k,209) = b(k,209) - lu(k,1947) * b(k,221) - b(k,208) = b(k,208) - lu(k,1946) * b(k,221) - b(k,201) = b(k,201) - lu(k,1945) * b(k,221) - b(k,174) = b(k,174) - lu(k,1944) * b(k,221) - b(k,165) = b(k,165) - lu(k,1943) * b(k,221) - b(k,146) = b(k,146) - lu(k,1942) * b(k,221) - b(k,107) = b(k,107) - lu(k,1941) * b(k,221) - b(k,93) = b(k,93) - lu(k,1940) * b(k,221) - b(k,220) = b(k,220) * lu(k,1934) - b(k,219) = b(k,219) - lu(k,1933) * b(k,220) - b(k,218) = b(k,218) - lu(k,1932) * b(k,220) - b(k,217) = b(k,217) - lu(k,1931) * b(k,220) - b(k,216) = b(k,216) - lu(k,1930) * b(k,220) - b(k,215) = b(k,215) - lu(k,1929) * b(k,220) - b(k,214) = b(k,214) - lu(k,1928) * b(k,220) - b(k,213) = b(k,213) - lu(k,1927) * b(k,220) - b(k,212) = b(k,212) - lu(k,1926) * b(k,220) - b(k,211) = b(k,211) - lu(k,1925) * b(k,220) - b(k,210) = b(k,210) - lu(k,1924) * b(k,220) - b(k,209) = b(k,209) - lu(k,1923) * b(k,220) - b(k,208) = b(k,208) - lu(k,1922) * b(k,220) - b(k,207) = b(k,207) - lu(k,1921) * b(k,220) - b(k,206) = b(k,206) - lu(k,1920) * b(k,220) - b(k,205) = b(k,205) - lu(k,1919) * b(k,220) - b(k,204) = b(k,204) - lu(k,1918) * b(k,220) - b(k,203) = b(k,203) - lu(k,1917) * b(k,220) - b(k,202) = b(k,202) - lu(k,1916) * b(k,220) - b(k,201) = b(k,201) - lu(k,1915) * b(k,220) - b(k,200) = b(k,200) - lu(k,1914) * b(k,220) - b(k,199) = b(k,199) - lu(k,1913) * b(k,220) - b(k,198) = b(k,198) - lu(k,1912) * b(k,220) - b(k,195) = b(k,195) - lu(k,1911) * b(k,220) - b(k,194) = b(k,194) - lu(k,1910) * b(k,220) - b(k,193) = b(k,193) - lu(k,1909) * b(k,220) - b(k,192) = b(k,192) - lu(k,1908) * b(k,220) - b(k,191) = b(k,191) - lu(k,1907) * b(k,220) - b(k,190) = b(k,190) - lu(k,1906) * b(k,220) - b(k,189) = b(k,189) - lu(k,1905) * b(k,220) - b(k,188) = b(k,188) - lu(k,1904) * b(k,220) - b(k,186) = b(k,186) - lu(k,1903) * b(k,220) - b(k,184) = b(k,184) - lu(k,1902) * b(k,220) - b(k,183) = b(k,183) - lu(k,1901) * b(k,220) - b(k,181) = b(k,181) - lu(k,1900) * b(k,220) - b(k,180) = b(k,180) - lu(k,1899) * b(k,220) - b(k,179) = b(k,179) - lu(k,1898) * b(k,220) - b(k,178) = b(k,178) - lu(k,1897) * b(k,220) - b(k,177) = b(k,177) - lu(k,1896) * b(k,220) - b(k,175) = b(k,175) - lu(k,1895) * b(k,220) - b(k,174) = b(k,174) - lu(k,1894) * b(k,220) - b(k,168) = b(k,168) - lu(k,1893) * b(k,220) - b(k,159) = b(k,159) - lu(k,1892) * b(k,220) - b(k,153) = b(k,153) - lu(k,1891) * b(k,220) - b(k,144) = b(k,144) - lu(k,1890) * b(k,220) - b(k,141) = b(k,141) - lu(k,1889) * b(k,220) - b(k,137) = b(k,137) - lu(k,1888) * b(k,220) - b(k,131) = b(k,131) - lu(k,1887) * b(k,220) - b(k,120) = b(k,120) - lu(k,1886) * b(k,220) - b(k,92) = b(k,92) - lu(k,1885) * b(k,220) - b(k,61) = b(k,61) - lu(k,1884) * b(k,220) - b(k,60) = b(k,60) - lu(k,1883) * b(k,220) - b(k,59) = b(k,59) - lu(k,1882) * b(k,220) - b(k,58) = b(k,58) - lu(k,1881) * b(k,220) - b(k,57) = b(k,57) - lu(k,1880) * b(k,220) - b(k,219) = b(k,219) * lu(k,1873) - b(k,218) = b(k,218) - lu(k,1872) * b(k,219) - b(k,217) = b(k,217) - lu(k,1871) * b(k,219) - b(k,216) = b(k,216) - lu(k,1870) * b(k,219) - b(k,215) = b(k,215) - lu(k,1869) * b(k,219) - b(k,214) = b(k,214) - lu(k,1868) * b(k,219) - b(k,213) = b(k,213) - lu(k,1867) * b(k,219) - b(k,212) = b(k,212) - lu(k,1866) * b(k,219) - b(k,211) = b(k,211) - lu(k,1865) * b(k,219) - b(k,210) = b(k,210) - lu(k,1864) * b(k,219) - b(k,209) = b(k,209) - lu(k,1863) * b(k,219) - b(k,207) = b(k,207) - lu(k,1862) * b(k,219) - b(k,206) = b(k,206) - lu(k,1861) * b(k,219) - b(k,205) = b(k,205) - lu(k,1860) * b(k,219) - b(k,204) = b(k,204) - lu(k,1859) * b(k,219) - b(k,203) = b(k,203) - lu(k,1858) * b(k,219) - b(k,202) = b(k,202) - lu(k,1857) * b(k,219) - b(k,200) = b(k,200) - lu(k,1856) * b(k,219) - b(k,199) = b(k,199) - lu(k,1855) * b(k,219) - b(k,198) = b(k,198) - lu(k,1854) * b(k,219) - b(k,197) = b(k,197) - lu(k,1853) * b(k,219) - b(k,195) = b(k,195) - lu(k,1852) * b(k,219) - b(k,194) = b(k,194) - lu(k,1851) * b(k,219) - b(k,193) = b(k,193) - lu(k,1850) * b(k,219) - b(k,192) = b(k,192) - lu(k,1849) * b(k,219) - b(k,191) = b(k,191) - lu(k,1848) * b(k,219) - b(k,190) = b(k,190) - lu(k,1847) * b(k,219) - b(k,189) = b(k,189) - lu(k,1846) * b(k,219) - b(k,188) = b(k,188) - lu(k,1845) * b(k,219) - b(k,186) = b(k,186) - lu(k,1844) * b(k,219) - b(k,185) = b(k,185) - lu(k,1843) * b(k,219) - b(k,183) = b(k,183) - lu(k,1842) * b(k,219) - b(k,181) = b(k,181) - lu(k,1841) * b(k,219) - b(k,177) = b(k,177) - lu(k,1840) * b(k,219) - b(k,173) = b(k,173) - lu(k,1839) * b(k,219) - b(k,172) = b(k,172) - lu(k,1838) * b(k,219) - b(k,169) = b(k,169) - lu(k,1837) * b(k,219) - b(k,167) = b(k,167) - lu(k,1836) * b(k,219) - b(k,152) = b(k,152) - lu(k,1835) * b(k,219) - b(k,141) = b(k,141) - lu(k,1834) * b(k,219) - b(k,123) = b(k,123) - lu(k,1833) * b(k,219) - b(k,116) = b(k,116) - lu(k,1832) * b(k,219) - b(k,111) = b(k,111) - lu(k,1831) * b(k,219) - b(k,98) = b(k,98) - lu(k,1830) * b(k,219) + b(k,249) = b(k,249) - lu(k,1745) * b(k,248) + b(k,250) = b(k,250) - lu(k,1746) * b(k,248) + b(k,251) = b(k,251) - lu(k,1747) * b(k,248) + b(k,252) = b(k,252) - lu(k,1748) * b(k,248) + b(k,253) = b(k,253) - lu(k,1749) * b(k,248) + b(k,254) = b(k,254) - lu(k,1750) * b(k,248) + b(k,255) = b(k,255) - lu(k,1751) * b(k,248) + b(k,256) = b(k,256) - lu(k,1752) * b(k,248) + b(k,257) = b(k,257) - lu(k,1753) * b(k,248) + b(k,258) = b(k,258) - lu(k,1754) * b(k,248) + b(k,259) = b(k,259) - lu(k,1755) * b(k,248) + b(k,250) = b(k,250) - lu(k,1918) * b(k,249) + b(k,251) = b(k,251) - lu(k,1919) * b(k,249) + b(k,252) = b(k,252) - lu(k,1920) * b(k,249) + b(k,253) = b(k,253) - lu(k,1921) * b(k,249) + b(k,254) = b(k,254) - lu(k,1922) * b(k,249) + b(k,255) = b(k,255) - lu(k,1923) * b(k,249) + b(k,256) = b(k,256) - lu(k,1924) * b(k,249) + b(k,257) = b(k,257) - lu(k,1925) * b(k,249) + b(k,258) = b(k,258) - lu(k,1926) * b(k,249) + b(k,259) = b(k,259) - lu(k,1927) * b(k,249) + b(k,251) = b(k,251) - lu(k,1945) * b(k,250) + b(k,252) = b(k,252) - lu(k,1946) * b(k,250) + b(k,253) = b(k,253) - lu(k,1947) * b(k,250) + b(k,254) = b(k,254) - lu(k,1948) * b(k,250) + b(k,255) = b(k,255) - lu(k,1949) * b(k,250) + b(k,256) = b(k,256) - lu(k,1950) * b(k,250) + b(k,257) = b(k,257) - lu(k,1951) * b(k,250) + b(k,258) = b(k,258) - lu(k,1952) * b(k,250) + b(k,259) = b(k,259) - lu(k,1953) * b(k,250) + b(k,252) = b(k,252) - lu(k,1968) * b(k,251) + b(k,253) = b(k,253) - lu(k,1969) * b(k,251) + b(k,254) = b(k,254) - lu(k,1970) * b(k,251) + b(k,255) = b(k,255) - lu(k,1971) * b(k,251) + b(k,256) = b(k,256) - lu(k,1972) * b(k,251) + b(k,257) = b(k,257) - lu(k,1973) * b(k,251) + b(k,258) = b(k,258) - lu(k,1974) * b(k,251) + b(k,259) = b(k,259) - lu(k,1975) * b(k,251) + b(k,253) = b(k,253) - lu(k,2000) * b(k,252) + b(k,254) = b(k,254) - lu(k,2001) * b(k,252) + b(k,255) = b(k,255) - lu(k,2002) * b(k,252) + b(k,256) = b(k,256) - lu(k,2003) * b(k,252) + b(k,257) = b(k,257) - lu(k,2004) * b(k,252) + b(k,258) = b(k,258) - lu(k,2005) * b(k,252) + b(k,259) = b(k,259) - lu(k,2006) * b(k,252) + b(k,254) = b(k,254) - lu(k,2025) * b(k,253) + b(k,255) = b(k,255) - lu(k,2026) * b(k,253) + b(k,256) = b(k,256) - lu(k,2027) * b(k,253) + b(k,257) = b(k,257) - lu(k,2028) * b(k,253) + b(k,258) = b(k,258) - lu(k,2029) * b(k,253) + b(k,259) = b(k,259) - lu(k,2030) * b(k,253) + b(k,255) = b(k,255) - lu(k,2083) * b(k,254) + b(k,256) = b(k,256) - lu(k,2084) * b(k,254) + b(k,257) = b(k,257) - lu(k,2085) * b(k,254) + b(k,258) = b(k,258) - lu(k,2086) * b(k,254) + b(k,259) = b(k,259) - lu(k,2087) * b(k,254) + b(k,256) = b(k,256) - lu(k,2108) * b(k,255) + b(k,257) = b(k,257) - lu(k,2109) * b(k,255) + b(k,258) = b(k,258) - lu(k,2110) * b(k,255) + b(k,259) = b(k,259) - lu(k,2111) * b(k,255) + b(k,257) = b(k,257) - lu(k,2228) * b(k,256) + b(k,258) = b(k,258) - lu(k,2229) * b(k,256) + b(k,259) = b(k,259) - lu(k,2230) * b(k,256) + b(k,258) = b(k,258) - lu(k,2268) * b(k,257) + b(k,259) = b(k,259) - lu(k,2269) * b(k,257) + b(k,259) = b(k,259) - lu(k,2330) * b(k,258) end do end subroutine lu_slv06 subroutine lu_slv07( avec_len, lu, b ) @@ -1349,252 +1230,248 @@ subroutine lu_slv07( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,218) = b(k,218) * lu(k,1822) - b(k,217) = b(k,217) - lu(k,1821) * b(k,218) - b(k,216) = b(k,216) - lu(k,1820) * b(k,218) - b(k,215) = b(k,215) - lu(k,1819) * b(k,218) - b(k,214) = b(k,214) - lu(k,1818) * b(k,218) - b(k,213) = b(k,213) - lu(k,1817) * b(k,218) - b(k,212) = b(k,212) - lu(k,1816) * b(k,218) - b(k,211) = b(k,211) - lu(k,1815) * b(k,218) - b(k,210) = b(k,210) - lu(k,1814) * b(k,218) - b(k,209) = b(k,209) - lu(k,1813) * b(k,218) - b(k,208) = b(k,208) - lu(k,1812) * b(k,218) - b(k,207) = b(k,207) - lu(k,1811) * b(k,218) - b(k,206) = b(k,206) - lu(k,1810) * b(k,218) - b(k,205) = b(k,205) - lu(k,1809) * b(k,218) - b(k,204) = b(k,204) - lu(k,1808) * b(k,218) - b(k,203) = b(k,203) - lu(k,1807) * b(k,218) - b(k,202) = b(k,202) - lu(k,1806) * b(k,218) - b(k,201) = b(k,201) - lu(k,1805) * b(k,218) - b(k,200) = b(k,200) - lu(k,1804) * b(k,218) - b(k,199) = b(k,199) - lu(k,1803) * b(k,218) - b(k,198) = b(k,198) - lu(k,1802) * b(k,218) - b(k,197) = b(k,197) - lu(k,1801) * b(k,218) - b(k,195) = b(k,195) - lu(k,1800) * b(k,218) - b(k,194) = b(k,194) - lu(k,1799) * b(k,218) - b(k,193) = b(k,193) - lu(k,1798) * b(k,218) - b(k,192) = b(k,192) - lu(k,1797) * b(k,218) - b(k,191) = b(k,191) - lu(k,1796) * b(k,218) - b(k,190) = b(k,190) - lu(k,1795) * b(k,218) - b(k,189) = b(k,189) - lu(k,1794) * b(k,218) - b(k,188) = b(k,188) - lu(k,1793) * b(k,218) - b(k,187) = b(k,187) - lu(k,1792) * b(k,218) - b(k,186) = b(k,186) - lu(k,1791) * b(k,218) - b(k,185) = b(k,185) - lu(k,1790) * b(k,218) - b(k,184) = b(k,184) - lu(k,1789) * b(k,218) - b(k,183) = b(k,183) - lu(k,1788) * b(k,218) - b(k,181) = b(k,181) - lu(k,1787) * b(k,218) - b(k,180) = b(k,180) - lu(k,1786) * b(k,218) - b(k,179) = b(k,179) - lu(k,1785) * b(k,218) - b(k,178) = b(k,178) - lu(k,1784) * b(k,218) - b(k,177) = b(k,177) - lu(k,1783) * b(k,218) - b(k,175) = b(k,175) - lu(k,1782) * b(k,218) - b(k,174) = b(k,174) - lu(k,1781) * b(k,218) - b(k,173) = b(k,173) - lu(k,1780) * b(k,218) - b(k,145) = b(k,145) - lu(k,1779) * b(k,218) - b(k,114) = b(k,114) - lu(k,1778) * b(k,218) - b(k,111) = b(k,111) - lu(k,1777) * b(k,218) - b(k,105) = b(k,105) - lu(k,1776) * b(k,218) - b(k,102) = b(k,102) - lu(k,1775) * b(k,218) - b(k,61) = b(k,61) - lu(k,1774) * b(k,218) - b(k,60) = b(k,60) - lu(k,1773) * b(k,218) - b(k,217) = b(k,217) * lu(k,1764) - b(k,216) = b(k,216) - lu(k,1763) * b(k,217) - b(k,215) = b(k,215) - lu(k,1762) * b(k,217) - b(k,214) = b(k,214) - lu(k,1761) * b(k,217) - b(k,213) = b(k,213) - lu(k,1760) * b(k,217) - b(k,212) = b(k,212) - lu(k,1759) * b(k,217) - b(k,211) = b(k,211) - lu(k,1758) * b(k,217) - b(k,210) = b(k,210) - lu(k,1757) * b(k,217) - b(k,209) = b(k,209) - lu(k,1756) * b(k,217) - b(k,208) = b(k,208) - lu(k,1755) * b(k,217) - b(k,207) = b(k,207) - lu(k,1754) * b(k,217) - b(k,206) = b(k,206) - lu(k,1753) * b(k,217) - b(k,201) = b(k,201) - lu(k,1752) * b(k,217) - b(k,200) = b(k,200) - lu(k,1751) * b(k,217) - b(k,190) = b(k,190) - lu(k,1750) * b(k,217) - b(k,189) = b(k,189) - lu(k,1749) * b(k,217) - b(k,182) = b(k,182) - lu(k,1748) * b(k,217) - b(k,177) = b(k,177) - lu(k,1747) * b(k,217) - b(k,176) = b(k,176) - lu(k,1746) * b(k,217) - b(k,174) = b(k,174) - lu(k,1745) * b(k,217) - b(k,165) = b(k,165) - lu(k,1744) * b(k,217) - b(k,163) = b(k,163) - lu(k,1743) * b(k,217) - b(k,160) = b(k,160) - lu(k,1742) * b(k,217) - b(k,153) = b(k,153) - lu(k,1741) * b(k,217) - b(k,146) = b(k,146) - lu(k,1740) * b(k,217) - b(k,143) = b(k,143) - lu(k,1739) * b(k,217) - b(k,139) = b(k,139) - lu(k,1738) * b(k,217) - b(k,132) = b(k,132) - lu(k,1737) * b(k,217) - b(k,131) = b(k,131) - lu(k,1736) * b(k,217) - b(k,125) = b(k,125) - lu(k,1735) * b(k,217) - b(k,124) = b(k,124) - lu(k,1734) * b(k,217) - b(k,102) = b(k,102) - lu(k,1733) * b(k,217) - b(k,75) = b(k,75) - lu(k,1732) * b(k,217) - b(k,216) = b(k,216) * lu(k,1722) - b(k,215) = b(k,215) - lu(k,1721) * b(k,216) - b(k,214) = b(k,214) - lu(k,1720) * b(k,216) - b(k,213) = b(k,213) - lu(k,1719) * b(k,216) - b(k,212) = b(k,212) - lu(k,1718) * b(k,216) - b(k,211) = b(k,211) - lu(k,1717) * b(k,216) - b(k,210) = b(k,210) - lu(k,1716) * b(k,216) - b(k,209) = b(k,209) - lu(k,1715) * b(k,216) - b(k,208) = b(k,208) - lu(k,1714) * b(k,216) - b(k,196) = b(k,196) - lu(k,1713) * b(k,216) - b(k,189) = b(k,189) - lu(k,1712) * b(k,216) - b(k,170) = b(k,170) - lu(k,1711) * b(k,216) - b(k,168) = b(k,168) - lu(k,1710) * b(k,216) - b(k,128) = b(k,128) - lu(k,1709) * b(k,216) - b(k,215) = b(k,215) * lu(k,1698) - b(k,214) = b(k,214) - lu(k,1697) * b(k,215) - b(k,213) = b(k,213) - lu(k,1696) * b(k,215) - b(k,212) = b(k,212) - lu(k,1695) * b(k,215) - b(k,211) = b(k,211) - lu(k,1694) * b(k,215) - b(k,210) = b(k,210) - lu(k,1693) * b(k,215) - b(k,209) = b(k,209) - lu(k,1692) * b(k,215) - b(k,208) = b(k,208) - lu(k,1691) * b(k,215) - b(k,207) = b(k,207) - lu(k,1690) * b(k,215) - b(k,206) = b(k,206) - lu(k,1689) * b(k,215) - b(k,205) = b(k,205) - lu(k,1688) * b(k,215) - b(k,204) = b(k,204) - lu(k,1687) * b(k,215) - b(k,203) = b(k,203) - lu(k,1686) * b(k,215) - b(k,202) = b(k,202) - lu(k,1685) * b(k,215) - b(k,201) = b(k,201) - lu(k,1684) * b(k,215) - b(k,200) = b(k,200) - lu(k,1683) * b(k,215) - b(k,199) = b(k,199) - lu(k,1682) * b(k,215) - b(k,198) = b(k,198) - lu(k,1681) * b(k,215) - b(k,197) = b(k,197) - lu(k,1680) * b(k,215) - b(k,196) = b(k,196) - lu(k,1679) * b(k,215) - b(k,195) = b(k,195) - lu(k,1678) * b(k,215) - b(k,194) = b(k,194) - lu(k,1677) * b(k,215) - b(k,193) = b(k,193) - lu(k,1676) * b(k,215) - b(k,192) = b(k,192) - lu(k,1675) * b(k,215) - b(k,191) = b(k,191) - lu(k,1674) * b(k,215) - b(k,190) = b(k,190) - lu(k,1673) * b(k,215) - b(k,189) = b(k,189) - lu(k,1672) * b(k,215) - b(k,188) = b(k,188) - lu(k,1671) * b(k,215) - b(k,187) = b(k,187) - lu(k,1670) * b(k,215) - b(k,186) = b(k,186) - lu(k,1669) * b(k,215) - b(k,185) = b(k,185) - lu(k,1668) * b(k,215) - b(k,184) = b(k,184) - lu(k,1667) * b(k,215) - b(k,183) = b(k,183) - lu(k,1666) * b(k,215) - b(k,182) = b(k,182) - lu(k,1665) * b(k,215) - b(k,181) = b(k,181) - lu(k,1664) * b(k,215) - b(k,180) = b(k,180) - lu(k,1663) * b(k,215) - b(k,179) = b(k,179) - lu(k,1662) * b(k,215) - b(k,178) = b(k,178) - lu(k,1661) * b(k,215) - b(k,177) = b(k,177) - lu(k,1660) * b(k,215) - b(k,176) = b(k,176) - lu(k,1659) * b(k,215) - b(k,175) = b(k,175) - lu(k,1658) * b(k,215) - b(k,174) = b(k,174) - lu(k,1657) * b(k,215) - b(k,173) = b(k,173) - lu(k,1656) * b(k,215) - b(k,172) = b(k,172) - lu(k,1655) * b(k,215) - b(k,171) = b(k,171) - lu(k,1654) * b(k,215) - b(k,170) = b(k,170) - lu(k,1653) * b(k,215) - b(k,169) = b(k,169) - lu(k,1652) * b(k,215) - b(k,168) = b(k,168) - lu(k,1651) * b(k,215) - b(k,167) = b(k,167) - lu(k,1650) * b(k,215) - b(k,166) = b(k,166) - lu(k,1649) * b(k,215) - b(k,164) = b(k,164) - lu(k,1648) * b(k,215) - b(k,163) = b(k,163) - lu(k,1647) * b(k,215) - b(k,162) = b(k,162) - lu(k,1646) * b(k,215) - b(k,161) = b(k,161) - lu(k,1645) * b(k,215) - b(k,160) = b(k,160) - lu(k,1644) * b(k,215) - b(k,159) = b(k,159) - lu(k,1643) * b(k,215) - b(k,158) = b(k,158) - lu(k,1642) * b(k,215) - b(k,157) = b(k,157) - lu(k,1641) * b(k,215) - b(k,156) = b(k,156) - lu(k,1640) * b(k,215) - b(k,155) = b(k,155) - lu(k,1639) * b(k,215) - b(k,154) = b(k,154) - lu(k,1638) * b(k,215) - b(k,153) = b(k,153) - lu(k,1637) * b(k,215) - b(k,152) = b(k,152) - lu(k,1636) * b(k,215) - b(k,151) = b(k,151) - lu(k,1635) * b(k,215) - b(k,150) = b(k,150) - lu(k,1634) * b(k,215) - b(k,149) = b(k,149) - lu(k,1633) * b(k,215) - b(k,148) = b(k,148) - lu(k,1632) * b(k,215) - b(k,147) = b(k,147) - lu(k,1631) * b(k,215) - b(k,145) = b(k,145) - lu(k,1630) * b(k,215) - b(k,144) = b(k,144) - lu(k,1629) * b(k,215) - b(k,143) = b(k,143) - lu(k,1628) * b(k,215) - b(k,142) = b(k,142) - lu(k,1627) * b(k,215) - b(k,141) = b(k,141) - lu(k,1626) * b(k,215) - b(k,140) = b(k,140) - lu(k,1625) * b(k,215) - b(k,139) = b(k,139) - lu(k,1624) * b(k,215) - b(k,138) = b(k,138) - lu(k,1623) * b(k,215) - b(k,137) = b(k,137) - lu(k,1622) * b(k,215) - b(k,136) = b(k,136) - lu(k,1621) * b(k,215) - b(k,135) = b(k,135) - lu(k,1620) * b(k,215) - b(k,134) = b(k,134) - lu(k,1619) * b(k,215) - b(k,133) = b(k,133) - lu(k,1618) * b(k,215) - b(k,132) = b(k,132) - lu(k,1617) * b(k,215) - b(k,131) = b(k,131) - lu(k,1616) * b(k,215) - b(k,130) = b(k,130) - lu(k,1615) * b(k,215) - b(k,129) = b(k,129) - lu(k,1614) * b(k,215) - b(k,127) = b(k,127) - lu(k,1613) * b(k,215) - b(k,126) = b(k,126) - lu(k,1612) * b(k,215) - b(k,125) = b(k,125) - lu(k,1611) * b(k,215) - b(k,124) = b(k,124) - lu(k,1610) * b(k,215) - b(k,123) = b(k,123) - lu(k,1609) * b(k,215) - b(k,122) = b(k,122) - lu(k,1608) * b(k,215) - b(k,121) = b(k,121) - lu(k,1607) * b(k,215) - b(k,119) = b(k,119) - lu(k,1606) * b(k,215) - b(k,118) = b(k,118) - lu(k,1605) * b(k,215) - b(k,117) = b(k,117) - lu(k,1604) * b(k,215) - b(k,116) = b(k,116) - lu(k,1603) * b(k,215) - b(k,115) = b(k,115) - lu(k,1602) * b(k,215) - b(k,114) = b(k,114) - lu(k,1601) * b(k,215) - b(k,113) = b(k,113) - lu(k,1600) * b(k,215) - b(k,112) = b(k,112) - lu(k,1599) * b(k,215) - b(k,111) = b(k,111) - lu(k,1598) * b(k,215) - b(k,110) = b(k,110) - lu(k,1597) * b(k,215) - b(k,109) = b(k,109) - lu(k,1596) * b(k,215) - b(k,108) = b(k,108) - lu(k,1595) * b(k,215) - b(k,105) = b(k,105) - lu(k,1594) * b(k,215) - b(k,104) = b(k,104) - lu(k,1593) * b(k,215) - b(k,103) = b(k,103) - lu(k,1592) * b(k,215) - b(k,99) = b(k,99) - lu(k,1591) * b(k,215) - b(k,98) = b(k,98) - lu(k,1590) * b(k,215) - b(k,97) = b(k,97) - lu(k,1589) * b(k,215) - b(k,95) = b(k,95) - lu(k,1588) * b(k,215) - b(k,94) = b(k,94) - lu(k,1587) * b(k,215) - b(k,92) = b(k,92) - lu(k,1586) * b(k,215) - b(k,91) = b(k,91) - lu(k,1585) * b(k,215) - b(k,90) = b(k,90) - lu(k,1584) * b(k,215) - b(k,89) = b(k,89) - lu(k,1583) * b(k,215) - b(k,88) = b(k,88) - lu(k,1582) * b(k,215) - b(k,87) = b(k,87) - lu(k,1581) * b(k,215) - b(k,86) = b(k,86) - lu(k,1580) * b(k,215) - b(k,85) = b(k,85) - lu(k,1579) * b(k,215) - b(k,84) = b(k,84) - lu(k,1578) * b(k,215) - b(k,83) = b(k,83) - lu(k,1577) * b(k,215) - b(k,81) = b(k,81) - lu(k,1576) * b(k,215) - b(k,80) = b(k,80) - lu(k,1575) * b(k,215) - b(k,79) = b(k,79) - lu(k,1574) * b(k,215) - b(k,76) = b(k,76) - lu(k,1573) * b(k,215) - b(k,74) = b(k,74) - lu(k,1572) * b(k,215) - b(k,73) = b(k,73) - lu(k,1571) * b(k,215) - b(k,71) = b(k,71) - lu(k,1570) * b(k,215) - b(k,70) = b(k,70) - lu(k,1569) * b(k,215) - b(k,69) = b(k,69) - lu(k,1568) * b(k,215) - b(k,68) = b(k,68) - lu(k,1567) * b(k,215) - b(k,67) = b(k,67) - lu(k,1566) * b(k,215) - b(k,66) = b(k,66) - lu(k,1565) * b(k,215) - b(k,65) = b(k,65) - lu(k,1564) * b(k,215) - b(k,64) = b(k,64) - lu(k,1563) * b(k,215) - b(k,63) = b(k,63) - lu(k,1562) * b(k,215) - b(k,62) = b(k,62) - lu(k,1561) * b(k,215) - b(k,61) = b(k,61) - lu(k,1560) * b(k,215) - b(k,60) = b(k,60) - lu(k,1559) * b(k,215) - b(k,59) = b(k,59) - lu(k,1558) * b(k,215) - b(k,58) = b(k,58) - lu(k,1557) * b(k,215) - b(k,57) = b(k,57) - lu(k,1556) * b(k,215) - b(k,56) = b(k,56) - lu(k,1555) * b(k,215) - b(k,55) = b(k,55) - lu(k,1554) * b(k,215) - b(k,54) = b(k,54) - lu(k,1553) * b(k,215) - b(k,53) = b(k,53) - lu(k,1552) * b(k,215) - b(k,52) = b(k,52) - lu(k,1551) * b(k,215) - b(k,51) = b(k,51) - lu(k,1550) * b(k,215) +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,259) = b(k,259) * lu(k,2356) + b(k,258) = b(k,258) - lu(k,2355) * b(k,259) + b(k,257) = b(k,257) - lu(k,2354) * b(k,259) + b(k,256) = b(k,256) - lu(k,2353) * b(k,259) + b(k,255) = b(k,255) - lu(k,2352) * b(k,259) + b(k,254) = b(k,254) - lu(k,2351) * b(k,259) + b(k,253) = b(k,253) - lu(k,2350) * b(k,259) + b(k,252) = b(k,252) - lu(k,2349) * b(k,259) + b(k,251) = b(k,251) - lu(k,2348) * b(k,259) + b(k,250) = b(k,250) - lu(k,2347) * b(k,259) + b(k,249) = b(k,249) - lu(k,2346) * b(k,259) + b(k,248) = b(k,248) - lu(k,2345) * b(k,259) + b(k,247) = b(k,247) - lu(k,2344) * b(k,259) + b(k,246) = b(k,246) - lu(k,2343) * b(k,259) + b(k,245) = b(k,245) - lu(k,2342) * b(k,259) + b(k,244) = b(k,244) - lu(k,2341) * b(k,259) + b(k,243) = b(k,243) - lu(k,2340) * b(k,259) + b(k,242) = b(k,242) - lu(k,2339) * b(k,259) + b(k,241) = b(k,241) - lu(k,2338) * b(k,259) + b(k,240) = b(k,240) - lu(k,2337) * b(k,259) + b(k,233) = b(k,233) - lu(k,2336) * b(k,259) + b(k,208) = b(k,208) - lu(k,2335) * b(k,259) + b(k,206) = b(k,206) - lu(k,2334) * b(k,259) + b(k,131) = b(k,131) - lu(k,2333) * b(k,259) + b(k,123) = b(k,123) - lu(k,2332) * b(k,259) + b(k,101) = b(k,101) - lu(k,2331) * b(k,259) + b(k,258) = b(k,258) * lu(k,2329) + b(k,257) = b(k,257) - lu(k,2328) * b(k,258) + b(k,256) = b(k,256) - lu(k,2327) * b(k,258) + b(k,255) = b(k,255) - lu(k,2326) * b(k,258) + b(k,254) = b(k,254) - lu(k,2325) * b(k,258) + b(k,253) = b(k,253) - lu(k,2324) * b(k,258) + b(k,252) = b(k,252) - lu(k,2323) * b(k,258) + b(k,251) = b(k,251) - lu(k,2322) * b(k,258) + b(k,250) = b(k,250) - lu(k,2321) * b(k,258) + b(k,249) = b(k,249) - lu(k,2320) * b(k,258) + b(k,248) = b(k,248) - lu(k,2319) * b(k,258) + b(k,247) = b(k,247) - lu(k,2318) * b(k,258) + b(k,246) = b(k,246) - lu(k,2317) * b(k,258) + b(k,245) = b(k,245) - lu(k,2316) * b(k,258) + b(k,244) = b(k,244) - lu(k,2315) * b(k,258) + b(k,243) = b(k,243) - lu(k,2314) * b(k,258) + b(k,242) = b(k,242) - lu(k,2313) * b(k,258) + b(k,241) = b(k,241) - lu(k,2312) * b(k,258) + b(k,239) = b(k,239) - lu(k,2311) * b(k,258) + b(k,238) = b(k,238) - lu(k,2310) * b(k,258) + b(k,237) = b(k,237) - lu(k,2309) * b(k,258) + b(k,236) = b(k,236) - lu(k,2308) * b(k,258) + b(k,235) = b(k,235) - lu(k,2307) * b(k,258) + b(k,234) = b(k,234) - lu(k,2306) * b(k,258) + b(k,233) = b(k,233) - lu(k,2305) * b(k,258) + b(k,232) = b(k,232) - lu(k,2304) * b(k,258) + b(k,231) = b(k,231) - lu(k,2303) * b(k,258) + b(k,230) = b(k,230) - lu(k,2302) * b(k,258) + b(k,227) = b(k,227) - lu(k,2301) * b(k,258) + b(k,226) = b(k,226) - lu(k,2300) * b(k,258) + b(k,225) = b(k,225) - lu(k,2299) * b(k,258) + b(k,224) = b(k,224) - lu(k,2298) * b(k,258) + b(k,223) = b(k,223) - lu(k,2297) * b(k,258) + b(k,222) = b(k,222) - lu(k,2296) * b(k,258) + b(k,221) = b(k,221) - lu(k,2295) * b(k,258) + b(k,220) = b(k,220) - lu(k,2294) * b(k,258) + b(k,218) = b(k,218) - lu(k,2293) * b(k,258) + b(k,217) = b(k,217) - lu(k,2292) * b(k,258) + b(k,216) = b(k,216) - lu(k,2291) * b(k,258) + b(k,215) = b(k,215) - lu(k,2290) * b(k,258) + b(k,214) = b(k,214) - lu(k,2289) * b(k,258) + b(k,213) = b(k,213) - lu(k,2288) * b(k,258) + b(k,212) = b(k,212) - lu(k,2287) * b(k,258) + b(k,210) = b(k,210) - lu(k,2286) * b(k,258) + b(k,206) = b(k,206) - lu(k,2285) * b(k,258) + b(k,204) = b(k,204) - lu(k,2284) * b(k,258) + b(k,203) = b(k,203) - lu(k,2283) * b(k,258) + b(k,191) = b(k,191) - lu(k,2282) * b(k,258) + b(k,188) = b(k,188) - lu(k,2281) * b(k,258) + b(k,183) = b(k,183) - lu(k,2280) * b(k,258) + b(k,173) = b(k,173) - lu(k,2279) * b(k,258) + b(k,168) = b(k,168) - lu(k,2278) * b(k,258) + b(k,161) = b(k,161) - lu(k,2277) * b(k,258) + b(k,156) = b(k,156) - lu(k,2276) * b(k,258) + b(k,116) = b(k,116) - lu(k,2275) * b(k,258) + b(k,68) = b(k,68) - lu(k,2274) * b(k,258) + b(k,67) = b(k,67) - lu(k,2273) * b(k,258) + b(k,66) = b(k,66) - lu(k,2272) * b(k,258) + b(k,65) = b(k,65) - lu(k,2271) * b(k,258) + b(k,64) = b(k,64) - lu(k,2270) * b(k,258) + b(k,257) = b(k,257) * lu(k,2267) + b(k,256) = b(k,256) - lu(k,2266) * b(k,257) + b(k,255) = b(k,255) - lu(k,2265) * b(k,257) + b(k,254) = b(k,254) - lu(k,2264) * b(k,257) + b(k,253) = b(k,253) - lu(k,2263) * b(k,257) + b(k,252) = b(k,252) - lu(k,2262) * b(k,257) + b(k,251) = b(k,251) - lu(k,2261) * b(k,257) + b(k,250) = b(k,250) - lu(k,2260) * b(k,257) + b(k,249) = b(k,249) - lu(k,2259) * b(k,257) + b(k,248) = b(k,248) - lu(k,2258) * b(k,257) + b(k,247) = b(k,247) - lu(k,2257) * b(k,257) + b(k,246) = b(k,246) - lu(k,2256) * b(k,257) + b(k,245) = b(k,245) - lu(k,2255) * b(k,257) + b(k,244) = b(k,244) - lu(k,2254) * b(k,257) + b(k,243) = b(k,243) - lu(k,2253) * b(k,257) + b(k,242) = b(k,242) - lu(k,2252) * b(k,257) + b(k,241) = b(k,241) - lu(k,2251) * b(k,257) + b(k,240) = b(k,240) - lu(k,2250) * b(k,257) + b(k,239) = b(k,239) - lu(k,2249) * b(k,257) + b(k,224) = b(k,224) - lu(k,2248) * b(k,257) + b(k,223) = b(k,223) - lu(k,2247) * b(k,257) + b(k,222) = b(k,222) - lu(k,2246) * b(k,257) + b(k,215) = b(k,215) - lu(k,2245) * b(k,257) + b(k,213) = b(k,213) - lu(k,2244) * b(k,257) + b(k,209) = b(k,209) - lu(k,2243) * b(k,257) + b(k,202) = b(k,202) - lu(k,2242) * b(k,257) + b(k,200) = b(k,200) - lu(k,2241) * b(k,257) + b(k,191) = b(k,191) - lu(k,2240) * b(k,257) + b(k,178) = b(k,178) - lu(k,2239) * b(k,257) + b(k,175) = b(k,175) - lu(k,2238) * b(k,257) + b(k,173) = b(k,173) - lu(k,2237) * b(k,257) + b(k,162) = b(k,162) - lu(k,2236) * b(k,257) + b(k,152) = b(k,152) - lu(k,2235) * b(k,257) + b(k,144) = b(k,144) - lu(k,2234) * b(k,257) + b(k,130) = b(k,130) - lu(k,2233) * b(k,257) + b(k,129) = b(k,129) - lu(k,2232) * b(k,257) + b(k,102) = b(k,102) - lu(k,2231) * b(k,257) + b(k,256) = b(k,256) * lu(k,2227) + b(k,255) = b(k,255) - lu(k,2226) * b(k,256) + b(k,254) = b(k,254) - lu(k,2225) * b(k,256) + b(k,253) = b(k,253) - lu(k,2224) * b(k,256) + b(k,252) = b(k,252) - lu(k,2223) * b(k,256) + b(k,251) = b(k,251) - lu(k,2222) * b(k,256) + b(k,250) = b(k,250) - lu(k,2221) * b(k,256) + b(k,249) = b(k,249) - lu(k,2220) * b(k,256) + b(k,248) = b(k,248) - lu(k,2219) * b(k,256) + b(k,247) = b(k,247) - lu(k,2218) * b(k,256) + b(k,246) = b(k,246) - lu(k,2217) * b(k,256) + b(k,245) = b(k,245) - lu(k,2216) * b(k,256) + b(k,244) = b(k,244) - lu(k,2215) * b(k,256) + b(k,243) = b(k,243) - lu(k,2214) * b(k,256) + b(k,242) = b(k,242) - lu(k,2213) * b(k,256) + b(k,241) = b(k,241) - lu(k,2212) * b(k,256) + b(k,240) = b(k,240) - lu(k,2211) * b(k,256) + b(k,239) = b(k,239) - lu(k,2210) * b(k,256) + b(k,238) = b(k,238) - lu(k,2209) * b(k,256) + b(k,237) = b(k,237) - lu(k,2208) * b(k,256) + b(k,236) = b(k,236) - lu(k,2207) * b(k,256) + b(k,235) = b(k,235) - lu(k,2206) * b(k,256) + b(k,234) = b(k,234) - lu(k,2205) * b(k,256) + b(k,232) = b(k,232) - lu(k,2204) * b(k,256) + b(k,231) = b(k,231) - lu(k,2203) * b(k,256) + b(k,230) = b(k,230) - lu(k,2202) * b(k,256) + b(k,229) = b(k,229) - lu(k,2201) * b(k,256) + b(k,227) = b(k,227) - lu(k,2200) * b(k,256) + b(k,226) = b(k,226) - lu(k,2199) * b(k,256) + b(k,225) = b(k,225) - lu(k,2198) * b(k,256) + b(k,224) = b(k,224) - lu(k,2197) * b(k,256) + b(k,223) = b(k,223) - lu(k,2196) * b(k,256) + b(k,222) = b(k,222) - lu(k,2195) * b(k,256) + b(k,221) = b(k,221) - lu(k,2194) * b(k,256) + b(k,220) = b(k,220) - lu(k,2193) * b(k,256) + b(k,216) = b(k,216) - lu(k,2192) * b(k,256) + b(k,215) = b(k,215) - lu(k,2191) * b(k,256) + b(k,213) = b(k,213) - lu(k,2190) * b(k,256) + b(k,212) = b(k,212) - lu(k,2189) * b(k,256) + b(k,211) = b(k,211) - lu(k,2188) * b(k,256) + b(k,210) = b(k,210) - lu(k,2187) * b(k,256) + b(k,207) = b(k,207) - lu(k,2186) * b(k,256) + b(k,205) = b(k,205) - lu(k,2185) * b(k,256) + b(k,203) = b(k,203) - lu(k,2184) * b(k,256) + b(k,202) = b(k,202) - lu(k,2183) * b(k,256) + b(k,201) = b(k,201) - lu(k,2182) * b(k,256) + b(k,200) = b(k,200) - lu(k,2181) * b(k,256) + b(k,199) = b(k,199) - lu(k,2180) * b(k,256) + b(k,197) = b(k,197) - lu(k,2179) * b(k,256) + b(k,196) = b(k,196) - lu(k,2178) * b(k,256) + b(k,195) = b(k,195) - lu(k,2177) * b(k,256) + b(k,194) = b(k,194) - lu(k,2176) * b(k,256) + b(k,193) = b(k,193) - lu(k,2175) * b(k,256) + b(k,192) = b(k,192) - lu(k,2174) * b(k,256) + b(k,191) = b(k,191) - lu(k,2173) * b(k,256) + b(k,190) = b(k,190) - lu(k,2172) * b(k,256) + b(k,189) = b(k,189) - lu(k,2171) * b(k,256) + b(k,188) = b(k,188) - lu(k,2170) * b(k,256) + b(k,187) = b(k,187) - lu(k,2169) * b(k,256) + b(k,186) = b(k,186) - lu(k,2168) * b(k,256) + b(k,185) = b(k,185) - lu(k,2167) * b(k,256) + b(k,183) = b(k,183) - lu(k,2166) * b(k,256) + b(k,181) = b(k,181) - lu(k,2165) * b(k,256) + b(k,179) = b(k,179) - lu(k,2164) * b(k,256) + b(k,178) = b(k,178) - lu(k,2163) * b(k,256) + b(k,176) = b(k,176) - lu(k,2162) * b(k,256) + b(k,172) = b(k,172) - lu(k,2161) * b(k,256) + b(k,167) = b(k,167) - lu(k,2160) * b(k,256) + b(k,165) = b(k,165) - lu(k,2159) * b(k,256) + b(k,164) = b(k,164) - lu(k,2158) * b(k,256) + b(k,163) = b(k,163) - lu(k,2157) * b(k,256) + b(k,161) = b(k,161) - lu(k,2156) * b(k,256) + b(k,159) = b(k,159) - lu(k,2155) * b(k,256) + b(k,158) = b(k,158) - lu(k,2154) * b(k,256) + b(k,157) = b(k,157) - lu(k,2153) * b(k,256) + b(k,155) = b(k,155) - lu(k,2152) * b(k,256) + b(k,154) = b(k,154) - lu(k,2151) * b(k,256) + b(k,153) = b(k,153) - lu(k,2150) * b(k,256) + b(k,151) = b(k,151) - lu(k,2149) * b(k,256) + b(k,150) = b(k,150) - lu(k,2148) * b(k,256) + b(k,148) = b(k,148) - lu(k,2147) * b(k,256) + b(k,147) = b(k,147) - lu(k,2146) * b(k,256) + b(k,146) = b(k,146) - lu(k,2145) * b(k,256) + b(k,145) = b(k,145) - lu(k,2144) * b(k,256) + b(k,141) = b(k,141) - lu(k,2143) * b(k,256) + b(k,139) = b(k,139) - lu(k,2142) * b(k,256) + b(k,138) = b(k,138) - lu(k,2141) * b(k,256) + b(k,137) = b(k,137) - lu(k,2140) * b(k,256) + b(k,134) = b(k,134) - lu(k,2139) * b(k,256) + b(k,126) = b(k,126) - lu(k,2138) * b(k,256) + b(k,125) = b(k,125) - lu(k,2137) * b(k,256) + b(k,111) = b(k,111) - lu(k,2136) * b(k,256) + b(k,100) = b(k,100) - lu(k,2135) * b(k,256) + b(k,83) = b(k,83) - lu(k,2134) * b(k,256) + b(k,82) = b(k,82) - lu(k,2133) * b(k,256) + b(k,79) = b(k,79) - lu(k,2132) * b(k,256) + b(k,77) = b(k,77) - lu(k,2131) * b(k,256) + b(k,76) = b(k,76) - lu(k,2130) * b(k,256) + b(k,75) = b(k,75) - lu(k,2129) * b(k,256) + b(k,74) = b(k,74) - lu(k,2128) * b(k,256) + b(k,73) = b(k,73) - lu(k,2127) * b(k,256) + b(k,72) = b(k,72) - lu(k,2126) * b(k,256) + b(k,71) = b(k,71) - lu(k,2125) * b(k,256) + b(k,70) = b(k,70) - lu(k,2124) * b(k,256) + b(k,69) = b(k,69) - lu(k,2123) * b(k,256) + b(k,68) = b(k,68) - lu(k,2122) * b(k,256) + b(k,67) = b(k,67) - lu(k,2121) * b(k,256) + b(k,66) = b(k,66) - lu(k,2120) * b(k,256) + b(k,65) = b(k,65) - lu(k,2119) * b(k,256) + b(k,64) = b(k,64) - lu(k,2118) * b(k,256) + b(k,62) = b(k,62) - lu(k,2117) * b(k,256) + b(k,61) = b(k,61) - lu(k,2116) * b(k,256) + b(k,60) = b(k,60) - lu(k,2115) * b(k,256) + b(k,59) = b(k,59) - lu(k,2114) * b(k,256) + b(k,58) = b(k,58) - lu(k,2113) * b(k,256) + b(k,57) = b(k,57) - lu(k,2112) * b(k,256) end do end subroutine lu_slv07 subroutine lu_slv08( avec_len, lu, b ) @@ -1615,209 +1492,313 @@ subroutine lu_slv08( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,214) = b(k,214) * lu(k,1538) - b(k,213) = b(k,213) - lu(k,1537) * b(k,214) - b(k,212) = b(k,212) - lu(k,1536) * b(k,214) - b(k,211) = b(k,211) - lu(k,1535) * b(k,214) - b(k,210) = b(k,210) - lu(k,1534) * b(k,214) - b(k,209) = b(k,209) - lu(k,1533) * b(k,214) - b(k,208) = b(k,208) - lu(k,1532) * b(k,214) - b(k,196) = b(k,196) - lu(k,1531) * b(k,214) - b(k,170) = b(k,170) - lu(k,1530) * b(k,214) - b(k,166) = b(k,166) - lu(k,1529) * b(k,214) - b(k,84) = b(k,84) - lu(k,1528) * b(k,214) - b(k,83) = b(k,83) - lu(k,1527) * b(k,214) - b(k,76) = b(k,76) - lu(k,1526) * b(k,214) - b(k,213) = b(k,213) * lu(k,1513) - b(k,212) = b(k,212) - lu(k,1512) * b(k,213) - b(k,211) = b(k,211) - lu(k,1511) * b(k,213) - b(k,210) = b(k,210) - lu(k,1510) * b(k,213) - b(k,209) = b(k,209) - lu(k,1509) * b(k,213) - b(k,208) = b(k,208) - lu(k,1508) * b(k,213) - b(k,207) = b(k,207) - lu(k,1507) * b(k,213) - b(k,206) = b(k,206) - lu(k,1506) * b(k,213) - b(k,205) = b(k,205) - lu(k,1505) * b(k,213) - b(k,204) = b(k,204) - lu(k,1504) * b(k,213) - b(k,203) = b(k,203) - lu(k,1503) * b(k,213) - b(k,202) = b(k,202) - lu(k,1502) * b(k,213) - b(k,200) = b(k,200) - lu(k,1501) * b(k,213) - b(k,199) = b(k,199) - lu(k,1500) * b(k,213) - b(k,198) = b(k,198) - lu(k,1499) * b(k,213) - b(k,197) = b(k,197) - lu(k,1498) * b(k,213) - b(k,196) = b(k,196) - lu(k,1497) * b(k,213) - b(k,195) = b(k,195) - lu(k,1496) * b(k,213) - b(k,194) = b(k,194) - lu(k,1495) * b(k,213) - b(k,193) = b(k,193) - lu(k,1494) * b(k,213) - b(k,192) = b(k,192) - lu(k,1493) * b(k,213) - b(k,191) = b(k,191) - lu(k,1492) * b(k,213) - b(k,190) = b(k,190) - lu(k,1491) * b(k,213) - b(k,189) = b(k,189) - lu(k,1490) * b(k,213) - b(k,188) = b(k,188) - lu(k,1489) * b(k,213) - b(k,186) = b(k,186) - lu(k,1488) * b(k,213) - b(k,183) = b(k,183) - lu(k,1487) * b(k,213) - b(k,181) = b(k,181) - lu(k,1486) * b(k,213) - b(k,180) = b(k,180) - lu(k,1485) * b(k,213) - b(k,177) = b(k,177) - lu(k,1484) * b(k,213) - b(k,176) = b(k,176) - lu(k,1483) * b(k,213) - b(k,173) = b(k,173) - lu(k,1482) * b(k,213) - b(k,172) = b(k,172) - lu(k,1481) * b(k,213) - b(k,171) = b(k,171) - lu(k,1480) * b(k,213) - b(k,170) = b(k,170) - lu(k,1479) * b(k,213) - b(k,169) = b(k,169) - lu(k,1478) * b(k,213) - b(k,168) = b(k,168) - lu(k,1477) * b(k,213) - b(k,165) = b(k,165) - lu(k,1476) * b(k,213) - b(k,164) = b(k,164) - lu(k,1475) * b(k,213) - b(k,163) = b(k,163) - lu(k,1474) * b(k,213) - b(k,162) = b(k,162) - lu(k,1473) * b(k,213) - b(k,161) = b(k,161) - lu(k,1472) * b(k,213) - b(k,160) = b(k,160) - lu(k,1471) * b(k,213) - b(k,159) = b(k,159) - lu(k,1470) * b(k,213) - b(k,158) = b(k,158) - lu(k,1469) * b(k,213) - b(k,157) = b(k,157) - lu(k,1468) * b(k,213) - b(k,156) = b(k,156) - lu(k,1467) * b(k,213) - b(k,155) = b(k,155) - lu(k,1466) * b(k,213) - b(k,153) = b(k,153) - lu(k,1465) * b(k,213) - b(k,151) = b(k,151) - lu(k,1464) * b(k,213) - b(k,150) = b(k,150) - lu(k,1463) * b(k,213) - b(k,149) = b(k,149) - lu(k,1462) * b(k,213) - b(k,148) = b(k,148) - lu(k,1461) * b(k,213) - b(k,141) = b(k,141) - lu(k,1460) * b(k,213) - b(k,140) = b(k,140) - lu(k,1459) * b(k,213) - b(k,139) = b(k,139) - lu(k,1458) * b(k,213) - b(k,136) = b(k,136) - lu(k,1457) * b(k,213) - b(k,135) = b(k,135) - lu(k,1456) * b(k,213) - b(k,134) = b(k,134) - lu(k,1455) * b(k,213) - b(k,133) = b(k,133) - lu(k,1454) * b(k,213) - b(k,131) = b(k,131) - lu(k,1453) * b(k,213) - b(k,130) = b(k,130) - lu(k,1452) * b(k,213) - b(k,129) = b(k,129) - lu(k,1451) * b(k,213) - b(k,128) = b(k,128) - lu(k,1450) * b(k,213) - b(k,127) = b(k,127) - lu(k,1449) * b(k,213) - b(k,126) = b(k,126) - lu(k,1448) * b(k,213) - b(k,124) = b(k,124) - lu(k,1447) * b(k,213) - b(k,123) = b(k,123) - lu(k,1446) * b(k,213) - b(k,122) = b(k,122) - lu(k,1445) * b(k,213) - b(k,121) = b(k,121) - lu(k,1444) * b(k,213) - b(k,119) = b(k,119) - lu(k,1443) * b(k,213) - b(k,118) = b(k,118) - lu(k,1442) * b(k,213) - b(k,117) = b(k,117) - lu(k,1441) * b(k,213) - b(k,113) = b(k,113) - lu(k,1440) * b(k,213) - b(k,112) = b(k,112) - lu(k,1439) * b(k,213) - b(k,110) = b(k,110) - lu(k,1438) * b(k,213) - b(k,109) = b(k,109) - lu(k,1437) * b(k,213) - b(k,108) = b(k,108) - lu(k,1436) * b(k,213) - b(k,100) = b(k,100) - lu(k,1435) * b(k,213) - b(k,99) = b(k,99) - lu(k,1434) * b(k,213) - b(k,88) = b(k,88) - lu(k,1433) * b(k,213) - b(k,77) = b(k,77) - lu(k,1432) * b(k,213) - b(k,212) = b(k,212) * lu(k,1418) - b(k,210) = b(k,210) - lu(k,1417) * b(k,212) - b(k,209) = b(k,209) - lu(k,1416) * b(k,212) - b(k,208) = b(k,208) - lu(k,1415) * b(k,212) - b(k,182) = b(k,182) - lu(k,1414) * b(k,212) - b(k,171) = b(k,171) - lu(k,1413) * b(k,212) - b(k,165) = b(k,165) - lu(k,1412) * b(k,212) - b(k,93) = b(k,93) - lu(k,1411) * b(k,212) - b(k,82) = b(k,82) - lu(k,1410) * b(k,212) - b(k,211) = b(k,211) * lu(k,1395) - b(k,210) = b(k,210) - lu(k,1394) * b(k,211) - b(k,209) = b(k,209) - lu(k,1393) * b(k,211) - b(k,208) = b(k,208) - lu(k,1392) * b(k,211) - b(k,207) = b(k,207) - lu(k,1391) * b(k,211) - b(k,206) = b(k,206) - lu(k,1390) * b(k,211) - b(k,205) = b(k,205) - lu(k,1389) * b(k,211) - b(k,204) = b(k,204) - lu(k,1388) * b(k,211) - b(k,203) = b(k,203) - lu(k,1387) * b(k,211) - b(k,202) = b(k,202) - lu(k,1386) * b(k,211) - b(k,200) = b(k,200) - lu(k,1385) * b(k,211) - b(k,199) = b(k,199) - lu(k,1384) * b(k,211) - b(k,198) = b(k,198) - lu(k,1383) * b(k,211) - b(k,197) = b(k,197) - lu(k,1382) * b(k,211) - b(k,195) = b(k,195) - lu(k,1381) * b(k,211) - b(k,194) = b(k,194) - lu(k,1380) * b(k,211) - b(k,193) = b(k,193) - lu(k,1379) * b(k,211) - b(k,192) = b(k,192) - lu(k,1378) * b(k,211) - b(k,191) = b(k,191) - lu(k,1377) * b(k,211) - b(k,190) = b(k,190) - lu(k,1376) * b(k,211) - b(k,189) = b(k,189) - lu(k,1375) * b(k,211) - b(k,188) = b(k,188) - lu(k,1374) * b(k,211) - b(k,187) = b(k,187) - lu(k,1373) * b(k,211) - b(k,186) = b(k,186) - lu(k,1372) * b(k,211) - b(k,185) = b(k,185) - lu(k,1371) * b(k,211) - b(k,183) = b(k,183) - lu(k,1370) * b(k,211) - b(k,181) = b(k,181) - lu(k,1369) * b(k,211) - b(k,180) = b(k,180) - lu(k,1368) * b(k,211) - b(k,177) = b(k,177) - lu(k,1367) * b(k,211) - b(k,176) = b(k,176) - lu(k,1366) * b(k,211) - b(k,173) = b(k,173) - lu(k,1365) * b(k,211) - b(k,172) = b(k,172) - lu(k,1364) * b(k,211) - b(k,169) = b(k,169) - lu(k,1363) * b(k,211) - b(k,168) = b(k,168) - lu(k,1362) * b(k,211) - b(k,164) = b(k,164) - lu(k,1361) * b(k,211) - b(k,163) = b(k,163) - lu(k,1360) * b(k,211) - b(k,162) = b(k,162) - lu(k,1359) * b(k,211) - b(k,161) = b(k,161) - lu(k,1358) * b(k,211) - b(k,160) = b(k,160) - lu(k,1357) * b(k,211) - b(k,159) = b(k,159) - lu(k,1356) * b(k,211) - b(k,156) = b(k,156) - lu(k,1355) * b(k,211) - b(k,154) = b(k,154) - lu(k,1354) * b(k,211) - b(k,153) = b(k,153) - lu(k,1353) * b(k,211) - b(k,152) = b(k,152) - lu(k,1352) * b(k,211) - b(k,151) = b(k,151) - lu(k,1351) * b(k,211) - b(k,147) = b(k,147) - lu(k,1350) * b(k,211) - b(k,145) = b(k,145) - lu(k,1349) * b(k,211) - b(k,142) = b(k,142) - lu(k,1348) * b(k,211) - b(k,139) = b(k,139) - lu(k,1347) * b(k,211) - b(k,138) = b(k,138) - lu(k,1346) * b(k,211) - b(k,135) = b(k,135) - lu(k,1345) * b(k,211) - b(k,134) = b(k,134) - lu(k,1344) * b(k,211) - b(k,131) = b(k,131) - lu(k,1343) * b(k,211) - b(k,130) = b(k,130) - lu(k,1342) * b(k,211) - b(k,129) = b(k,129) - lu(k,1341) * b(k,211) - b(k,128) = b(k,128) - lu(k,1340) * b(k,211) - b(k,127) = b(k,127) - lu(k,1339) * b(k,211) - b(k,125) = b(k,125) - lu(k,1338) * b(k,211) - b(k,111) = b(k,111) - lu(k,1337) * b(k,211) - b(k,106) = b(k,106) - lu(k,1336) * b(k,211) - b(k,101) = b(k,101) - lu(k,1335) * b(k,211) - b(k,100) = b(k,100) - lu(k,1334) * b(k,211) - b(k,94) = b(k,94) - lu(k,1333) * b(k,211) - b(k,91) = b(k,91) - lu(k,1332) * b(k,211) - b(k,210) = b(k,210) * lu(k,1320) - b(k,209) = b(k,209) - lu(k,1319) * b(k,210) - b(k,196) = b(k,196) - lu(k,1318) * b(k,210) - b(k,209) = b(k,209) * lu(k,1307) - b(k,196) = b(k,196) - lu(k,1306) * b(k,209) - b(k,166) = b(k,166) - lu(k,1305) * b(k,209) - b(k,96) = b(k,96) - lu(k,1304) * b(k,209) - b(k,208) = b(k,208) * lu(k,1294) - b(k,189) = b(k,189) - lu(k,1293) * b(k,208) - b(k,170) = b(k,170) - lu(k,1292) * b(k,208) - b(k,207) = b(k,207) * lu(k,1280) - b(k,206) = b(k,206) - lu(k,1279) * b(k,207) - b(k,205) = b(k,205) - lu(k,1278) * b(k,207) - b(k,204) = b(k,204) - lu(k,1277) * b(k,207) - b(k,203) = b(k,203) - lu(k,1276) * b(k,207) - b(k,202) = b(k,202) - lu(k,1275) * b(k,207) - b(k,200) = b(k,200) - lu(k,1274) * b(k,207) - b(k,199) = b(k,199) - lu(k,1273) * b(k,207) - b(k,198) = b(k,198) - lu(k,1272) * b(k,207) - b(k,197) = b(k,197) - lu(k,1271) * b(k,207) - b(k,190) = b(k,190) - lu(k,1270) * b(k,207) - b(k,189) = b(k,189) - lu(k,1269) * b(k,207) - b(k,186) = b(k,186) - lu(k,1268) * b(k,207) - b(k,185) = b(k,185) - lu(k,1267) * b(k,207) - b(k,177) = b(k,177) - lu(k,1266) * b(k,207) - b(k,141) = b(k,141) - lu(k,1265) * b(k,207) - b(k,136) = b(k,136) - lu(k,1264) * b(k,207) - b(k,132) = b(k,132) - lu(k,1263) * b(k,207) - b(k,111) = b(k,111) - lu(k,1262) * b(k,207) - b(k,206) = b(k,206) * lu(k,1249) - b(k,200) = b(k,200) - lu(k,1248) * b(k,206) - b(k,190) = b(k,190) - lu(k,1247) * b(k,206) - b(k,143) = b(k,143) - lu(k,1246) * b(k,206) - b(k,141) = b(k,141) - lu(k,1245) * b(k,206) - b(k,136) = b(k,136) - lu(k,1244) * b(k,206) + b(k,255) = b(k,255) * lu(k,2107) + b(k,254) = b(k,254) - lu(k,2106) * b(k,255) + b(k,253) = b(k,253) - lu(k,2105) * b(k,255) + b(k,252) = b(k,252) - lu(k,2104) * b(k,255) + b(k,251) = b(k,251) - lu(k,2103) * b(k,255) + b(k,250) = b(k,250) - lu(k,2102) * b(k,255) + b(k,249) = b(k,249) - lu(k,2101) * b(k,255) + b(k,248) = b(k,248) - lu(k,2100) * b(k,255) + b(k,247) = b(k,247) - lu(k,2099) * b(k,255) + b(k,246) = b(k,246) - lu(k,2098) * b(k,255) + b(k,245) = b(k,245) - lu(k,2097) * b(k,255) + b(k,244) = b(k,244) - lu(k,2096) * b(k,255) + b(k,243) = b(k,243) - lu(k,2095) * b(k,255) + b(k,241) = b(k,241) - lu(k,2094) * b(k,255) + b(k,233) = b(k,233) - lu(k,2093) * b(k,255) + b(k,206) = b(k,206) - lu(k,2092) * b(k,255) + b(k,197) = b(k,197) - lu(k,2091) * b(k,255) + b(k,170) = b(k,170) - lu(k,2090) * b(k,255) + b(k,136) = b(k,136) - lu(k,2089) * b(k,255) + b(k,118) = b(k,118) - lu(k,2088) * b(k,255) + b(k,254) = b(k,254) * lu(k,2082) + b(k,253) = b(k,253) - lu(k,2081) * b(k,254) + b(k,252) = b(k,252) - lu(k,2080) * b(k,254) + b(k,251) = b(k,251) - lu(k,2079) * b(k,254) + b(k,250) = b(k,250) - lu(k,2078) * b(k,254) + b(k,249) = b(k,249) - lu(k,2077) * b(k,254) + b(k,248) = b(k,248) - lu(k,2076) * b(k,254) + b(k,247) = b(k,247) - lu(k,2075) * b(k,254) + b(k,246) = b(k,246) - lu(k,2074) * b(k,254) + b(k,245) = b(k,245) - lu(k,2073) * b(k,254) + b(k,244) = b(k,244) - lu(k,2072) * b(k,254) + b(k,243) = b(k,243) - lu(k,2071) * b(k,254) + b(k,242) = b(k,242) - lu(k,2070) * b(k,254) + b(k,241) = b(k,241) - lu(k,2069) * b(k,254) + b(k,239) = b(k,239) - lu(k,2068) * b(k,254) + b(k,238) = b(k,238) - lu(k,2067) * b(k,254) + b(k,237) = b(k,237) - lu(k,2066) * b(k,254) + b(k,236) = b(k,236) - lu(k,2065) * b(k,254) + b(k,235) = b(k,235) - lu(k,2064) * b(k,254) + b(k,234) = b(k,234) - lu(k,2063) * b(k,254) + b(k,233) = b(k,233) - lu(k,2062) * b(k,254) + b(k,232) = b(k,232) - lu(k,2061) * b(k,254) + b(k,231) = b(k,231) - lu(k,2060) * b(k,254) + b(k,230) = b(k,230) - lu(k,2059) * b(k,254) + b(k,229) = b(k,229) - lu(k,2058) * b(k,254) + b(k,228) = b(k,228) - lu(k,2057) * b(k,254) + b(k,227) = b(k,227) - lu(k,2056) * b(k,254) + b(k,226) = b(k,226) - lu(k,2055) * b(k,254) + b(k,225) = b(k,225) - lu(k,2054) * b(k,254) + b(k,224) = b(k,224) - lu(k,2053) * b(k,254) + b(k,223) = b(k,223) - lu(k,2052) * b(k,254) + b(k,222) = b(k,222) - lu(k,2051) * b(k,254) + b(k,221) = b(k,221) - lu(k,2050) * b(k,254) + b(k,220) = b(k,220) - lu(k,2049) * b(k,254) + b(k,219) = b(k,219) - lu(k,2048) * b(k,254) + b(k,218) = b(k,218) - lu(k,2047) * b(k,254) + b(k,217) = b(k,217) - lu(k,2046) * b(k,254) + b(k,216) = b(k,216) - lu(k,2045) * b(k,254) + b(k,215) = b(k,215) - lu(k,2044) * b(k,254) + b(k,214) = b(k,214) - lu(k,2043) * b(k,254) + b(k,213) = b(k,213) - lu(k,2042) * b(k,254) + b(k,212) = b(k,212) - lu(k,2041) * b(k,254) + b(k,206) = b(k,206) - lu(k,2040) * b(k,254) + b(k,205) = b(k,205) - lu(k,2039) * b(k,254) + b(k,204) = b(k,204) - lu(k,2038) * b(k,254) + b(k,174) = b(k,174) - lu(k,2037) * b(k,254) + b(k,143) = b(k,143) - lu(k,2036) * b(k,254) + b(k,140) = b(k,140) - lu(k,2035) * b(k,254) + b(k,133) = b(k,133) - lu(k,2034) * b(k,254) + b(k,128) = b(k,128) - lu(k,2033) * b(k,254) + b(k,68) = b(k,68) - lu(k,2032) * b(k,254) + b(k,67) = b(k,67) - lu(k,2031) * b(k,254) + b(k,253) = b(k,253) * lu(k,2024) + b(k,252) = b(k,252) - lu(k,2023) * b(k,253) + b(k,251) = b(k,251) - lu(k,2022) * b(k,253) + b(k,250) = b(k,250) - lu(k,2021) * b(k,253) + b(k,249) = b(k,249) - lu(k,2020) * b(k,253) + b(k,248) = b(k,248) - lu(k,2019) * b(k,253) + b(k,247) = b(k,247) - lu(k,2018) * b(k,253) + b(k,246) = b(k,246) - lu(k,2017) * b(k,253) + b(k,245) = b(k,245) - lu(k,2016) * b(k,253) + b(k,244) = b(k,244) - lu(k,2015) * b(k,253) + b(k,243) = b(k,243) - lu(k,2014) * b(k,253) + b(k,242) = b(k,242) - lu(k,2013) * b(k,253) + b(k,241) = b(k,241) - lu(k,2012) * b(k,253) + b(k,240) = b(k,240) - lu(k,2011) * b(k,253) + b(k,223) = b(k,223) - lu(k,2010) * b(k,253) + b(k,215) = b(k,215) - lu(k,2009) * b(k,253) + b(k,201) = b(k,201) - lu(k,2008) * b(k,253) + b(k,157) = b(k,157) - lu(k,2007) * b(k,253) + b(k,252) = b(k,252) * lu(k,1999) + b(k,251) = b(k,251) - lu(k,1998) * b(k,252) + b(k,250) = b(k,250) - lu(k,1997) * b(k,252) + b(k,249) = b(k,249) - lu(k,1996) * b(k,252) + b(k,248) = b(k,248) - lu(k,1995) * b(k,252) + b(k,247) = b(k,247) - lu(k,1994) * b(k,252) + b(k,246) = b(k,246) - lu(k,1993) * b(k,252) + b(k,245) = b(k,245) - lu(k,1992) * b(k,252) + b(k,244) = b(k,244) - lu(k,1991) * b(k,252) + b(k,243) = b(k,243) - lu(k,1990) * b(k,252) + b(k,242) = b(k,242) - lu(k,1989) * b(k,252) + b(k,241) = b(k,241) - lu(k,1988) * b(k,252) + b(k,240) = b(k,240) - lu(k,1987) * b(k,252) + b(k,233) = b(k,233) - lu(k,1986) * b(k,252) + b(k,223) = b(k,223) - lu(k,1985) * b(k,252) + b(k,209) = b(k,209) - lu(k,1984) * b(k,252) + b(k,206) = b(k,206) - lu(k,1983) * b(k,252) + b(k,201) = b(k,201) - lu(k,1982) * b(k,252) + b(k,200) = b(k,200) - lu(k,1981) * b(k,252) + b(k,197) = b(k,197) - lu(k,1980) * b(k,252) + b(k,178) = b(k,178) - lu(k,1979) * b(k,252) + b(k,170) = b(k,170) - lu(k,1978) * b(k,252) + b(k,168) = b(k,168) - lu(k,1977) * b(k,252) + b(k,142) = b(k,142) - lu(k,1976) * b(k,252) + b(k,251) = b(k,251) * lu(k,1967) + b(k,250) = b(k,250) - lu(k,1966) * b(k,251) + b(k,249) = b(k,249) - lu(k,1965) * b(k,251) + b(k,248) = b(k,248) - lu(k,1964) * b(k,251) + b(k,247) = b(k,247) - lu(k,1963) * b(k,251) + b(k,246) = b(k,246) - lu(k,1962) * b(k,251) + b(k,244) = b(k,244) - lu(k,1961) * b(k,251) + b(k,243) = b(k,243) - lu(k,1960) * b(k,251) + b(k,241) = b(k,241) - lu(k,1959) * b(k,251) + b(k,209) = b(k,209) - lu(k,1958) * b(k,251) + b(k,200) = b(k,200) - lu(k,1957) * b(k,251) + b(k,197) = b(k,197) - lu(k,1956) * b(k,251) + b(k,118) = b(k,118) - lu(k,1955) * b(k,251) + b(k,102) = b(k,102) - lu(k,1954) * b(k,251) + b(k,250) = b(k,250) * lu(k,1944) + b(k,249) = b(k,249) - lu(k,1943) * b(k,250) + b(k,248) = b(k,248) - lu(k,1942) * b(k,250) + b(k,247) = b(k,247) - lu(k,1941) * b(k,250) + b(k,246) = b(k,246) - lu(k,1940) * b(k,250) + b(k,245) = b(k,245) - lu(k,1939) * b(k,250) + b(k,244) = b(k,244) - lu(k,1938) * b(k,250) + b(k,243) = b(k,243) - lu(k,1937) * b(k,250) + b(k,241) = b(k,241) - lu(k,1936) * b(k,250) + b(k,233) = b(k,233) - lu(k,1935) * b(k,250) + b(k,209) = b(k,209) - lu(k,1934) * b(k,250) + b(k,206) = b(k,206) - lu(k,1933) * b(k,250) + b(k,200) = b(k,200) - lu(k,1932) * b(k,250) + b(k,136) = b(k,136) - lu(k,1931) * b(k,250) + b(k,118) = b(k,118) - lu(k,1930) * b(k,250) + b(k,102) = b(k,102) - lu(k,1929) * b(k,250) + b(k,87) = b(k,87) - lu(k,1928) * b(k,250) + b(k,249) = b(k,249) * lu(k,1917) + b(k,248) = b(k,248) - lu(k,1916) * b(k,249) + b(k,247) = b(k,247) - lu(k,1915) * b(k,249) + b(k,246) = b(k,246) - lu(k,1914) * b(k,249) + b(k,245) = b(k,245) - lu(k,1913) * b(k,249) + b(k,244) = b(k,244) - lu(k,1912) * b(k,249) + b(k,243) = b(k,243) - lu(k,1911) * b(k,249) + b(k,242) = b(k,242) - lu(k,1910) * b(k,249) + b(k,241) = b(k,241) - lu(k,1909) * b(k,249) + b(k,240) = b(k,240) - lu(k,1908) * b(k,249) + b(k,239) = b(k,239) - lu(k,1907) * b(k,249) + b(k,238) = b(k,238) - lu(k,1906) * b(k,249) + b(k,237) = b(k,237) - lu(k,1905) * b(k,249) + b(k,236) = b(k,236) - lu(k,1904) * b(k,249) + b(k,235) = b(k,235) - lu(k,1903) * b(k,249) + b(k,234) = b(k,234) - lu(k,1902) * b(k,249) + b(k,233) = b(k,233) - lu(k,1901) * b(k,249) + b(k,232) = b(k,232) - lu(k,1900) * b(k,249) + b(k,231) = b(k,231) - lu(k,1899) * b(k,249) + b(k,230) = b(k,230) - lu(k,1898) * b(k,249) + b(k,229) = b(k,229) - lu(k,1897) * b(k,249) + b(k,228) = b(k,228) - lu(k,1896) * b(k,249) + b(k,227) = b(k,227) - lu(k,1895) * b(k,249) + b(k,226) = b(k,226) - lu(k,1894) * b(k,249) + b(k,225) = b(k,225) - lu(k,1893) * b(k,249) + b(k,224) = b(k,224) - lu(k,1892) * b(k,249) + b(k,223) = b(k,223) - lu(k,1891) * b(k,249) + b(k,222) = b(k,222) - lu(k,1890) * b(k,249) + b(k,221) = b(k,221) - lu(k,1889) * b(k,249) + b(k,220) = b(k,220) - lu(k,1888) * b(k,249) + b(k,219) = b(k,219) - lu(k,1887) * b(k,249) + b(k,218) = b(k,218) - lu(k,1886) * b(k,249) + b(k,217) = b(k,217) - lu(k,1885) * b(k,249) + b(k,216) = b(k,216) - lu(k,1884) * b(k,249) + b(k,215) = b(k,215) - lu(k,1883) * b(k,249) + b(k,214) = b(k,214) - lu(k,1882) * b(k,249) + b(k,213) = b(k,213) - lu(k,1881) * b(k,249) + b(k,212) = b(k,212) - lu(k,1880) * b(k,249) + b(k,211) = b(k,211) - lu(k,1879) * b(k,249) + b(k,210) = b(k,210) - lu(k,1878) * b(k,249) + b(k,209) = b(k,209) - lu(k,1877) * b(k,249) + b(k,208) = b(k,208) - lu(k,1876) * b(k,249) + b(k,207) = b(k,207) - lu(k,1875) * b(k,249) + b(k,206) = b(k,206) - lu(k,1874) * b(k,249) + b(k,205) = b(k,205) - lu(k,1873) * b(k,249) + b(k,204) = b(k,204) - lu(k,1872) * b(k,249) + b(k,203) = b(k,203) - lu(k,1871) * b(k,249) + b(k,202) = b(k,202) - lu(k,1870) * b(k,249) + b(k,201) = b(k,201) - lu(k,1869) * b(k,249) + b(k,200) = b(k,200) - lu(k,1868) * b(k,249) + b(k,199) = b(k,199) - lu(k,1867) * b(k,249) + b(k,198) = b(k,198) - lu(k,1866) * b(k,249) + b(k,196) = b(k,196) - lu(k,1865) * b(k,249) + b(k,195) = b(k,195) - lu(k,1864) * b(k,249) + b(k,194) = b(k,194) - lu(k,1863) * b(k,249) + b(k,193) = b(k,193) - lu(k,1862) * b(k,249) + b(k,192) = b(k,192) - lu(k,1861) * b(k,249) + b(k,191) = b(k,191) - lu(k,1860) * b(k,249) + b(k,190) = b(k,190) - lu(k,1859) * b(k,249) + b(k,189) = b(k,189) - lu(k,1858) * b(k,249) + b(k,188) = b(k,188) - lu(k,1857) * b(k,249) + b(k,187) = b(k,187) - lu(k,1856) * b(k,249) + b(k,186) = b(k,186) - lu(k,1855) * b(k,249) + b(k,185) = b(k,185) - lu(k,1854) * b(k,249) + b(k,184) = b(k,184) - lu(k,1853) * b(k,249) + b(k,183) = b(k,183) - lu(k,1852) * b(k,249) + b(k,182) = b(k,182) - lu(k,1851) * b(k,249) + b(k,181) = b(k,181) - lu(k,1850) * b(k,249) + b(k,180) = b(k,180) - lu(k,1849) * b(k,249) + b(k,179) = b(k,179) - lu(k,1848) * b(k,249) + b(k,178) = b(k,178) - lu(k,1847) * b(k,249) + b(k,177) = b(k,177) - lu(k,1846) * b(k,249) + b(k,176) = b(k,176) - lu(k,1845) * b(k,249) + b(k,175) = b(k,175) - lu(k,1844) * b(k,249) + b(k,174) = b(k,174) - lu(k,1843) * b(k,249) + b(k,173) = b(k,173) - lu(k,1842) * b(k,249) + b(k,172) = b(k,172) - lu(k,1841) * b(k,249) + b(k,171) = b(k,171) - lu(k,1840) * b(k,249) + b(k,169) = b(k,169) - lu(k,1839) * b(k,249) + b(k,168) = b(k,168) - lu(k,1838) * b(k,249) + b(k,167) = b(k,167) - lu(k,1837) * b(k,249) + b(k,166) = b(k,166) - lu(k,1836) * b(k,249) + b(k,165) = b(k,165) - lu(k,1835) * b(k,249) + b(k,164) = b(k,164) - lu(k,1834) * b(k,249) + b(k,163) = b(k,163) - lu(k,1833) * b(k,249) + b(k,162) = b(k,162) - lu(k,1832) * b(k,249) + b(k,161) = b(k,161) - lu(k,1831) * b(k,249) + b(k,160) = b(k,160) - lu(k,1830) * b(k,249) + b(k,159) = b(k,159) - lu(k,1829) * b(k,249) + b(k,158) = b(k,158) - lu(k,1828) * b(k,249) + b(k,155) = b(k,155) - lu(k,1827) * b(k,249) + b(k,154) = b(k,154) - lu(k,1826) * b(k,249) + b(k,153) = b(k,153) - lu(k,1825) * b(k,249) + b(k,152) = b(k,152) - lu(k,1824) * b(k,249) + b(k,151) = b(k,151) - lu(k,1823) * b(k,249) + b(k,150) = b(k,150) - lu(k,1822) * b(k,249) + b(k,149) = b(k,149) - lu(k,1821) * b(k,249) + b(k,148) = b(k,148) - lu(k,1820) * b(k,249) + b(k,147) = b(k,147) - lu(k,1819) * b(k,249) + b(k,146) = b(k,146) - lu(k,1818) * b(k,249) + b(k,145) = b(k,145) - lu(k,1817) * b(k,249) + b(k,144) = b(k,144) - lu(k,1816) * b(k,249) + b(k,143) = b(k,143) - lu(k,1815) * b(k,249) + b(k,142) = b(k,142) - lu(k,1814) * b(k,249) + b(k,141) = b(k,141) - lu(k,1813) * b(k,249) + b(k,140) = b(k,140) - lu(k,1812) * b(k,249) + b(k,139) = b(k,139) - lu(k,1811) * b(k,249) + b(k,138) = b(k,138) - lu(k,1810) * b(k,249) + b(k,137) = b(k,137) - lu(k,1809) * b(k,249) + b(k,134) = b(k,134) - lu(k,1808) * b(k,249) + b(k,132) = b(k,132) - lu(k,1807) * b(k,249) + b(k,130) = b(k,130) - lu(k,1806) * b(k,249) + b(k,129) = b(k,129) - lu(k,1805) * b(k,249) + b(k,128) = b(k,128) - lu(k,1804) * b(k,249) + b(k,125) = b(k,125) - lu(k,1803) * b(k,249) + b(k,124) = b(k,124) - lu(k,1802) * b(k,249) + b(k,123) = b(k,123) - lu(k,1801) * b(k,249) + b(k,122) = b(k,122) - lu(k,1800) * b(k,249) + b(k,121) = b(k,121) - lu(k,1799) * b(k,249) + b(k,120) = b(k,120) - lu(k,1798) * b(k,249) + b(k,119) = b(k,119) - lu(k,1797) * b(k,249) + b(k,117) = b(k,117) - lu(k,1796) * b(k,249) + b(k,116) = b(k,116) - lu(k,1795) * b(k,249) + b(k,115) = b(k,115) - lu(k,1794) * b(k,249) + b(k,114) = b(k,114) - lu(k,1793) * b(k,249) + b(k,113) = b(k,113) - lu(k,1792) * b(k,249) + b(k,112) = b(k,112) - lu(k,1791) * b(k,249) + b(k,111) = b(k,111) - lu(k,1790) * b(k,249) + b(k,110) = b(k,110) - lu(k,1789) * b(k,249) + b(k,109) = b(k,109) - lu(k,1788) * b(k,249) + b(k,108) = b(k,108) - lu(k,1787) * b(k,249) + b(k,107) = b(k,107) - lu(k,1786) * b(k,249) + b(k,105) = b(k,105) - lu(k,1785) * b(k,249) + b(k,104) = b(k,104) - lu(k,1784) * b(k,249) + b(k,103) = b(k,103) - lu(k,1783) * b(k,249) + b(k,94) = b(k,94) - lu(k,1782) * b(k,249) + b(k,92) = b(k,92) - lu(k,1781) * b(k,249) + b(k,88) = b(k,88) - lu(k,1780) * b(k,249) + b(k,86) = b(k,86) - lu(k,1779) * b(k,249) + b(k,84) = b(k,84) - lu(k,1778) * b(k,249) + b(k,83) = b(k,83) - lu(k,1777) * b(k,249) + b(k,82) = b(k,82) - lu(k,1776) * b(k,249) + b(k,81) = b(k,81) - lu(k,1775) * b(k,249) + b(k,80) = b(k,80) - lu(k,1774) * b(k,249) + b(k,79) = b(k,79) - lu(k,1773) * b(k,249) + b(k,78) = b(k,78) - lu(k,1772) * b(k,249) + b(k,77) = b(k,77) - lu(k,1771) * b(k,249) + b(k,76) = b(k,76) - lu(k,1770) * b(k,249) + b(k,75) = b(k,75) - lu(k,1769) * b(k,249) + b(k,74) = b(k,74) - lu(k,1768) * b(k,249) + b(k,73) = b(k,73) - lu(k,1767) * b(k,249) + b(k,72) = b(k,72) - lu(k,1766) * b(k,249) + b(k,71) = b(k,71) - lu(k,1765) * b(k,249) + b(k,70) = b(k,70) - lu(k,1764) * b(k,249) + b(k,69) = b(k,69) - lu(k,1763) * b(k,249) + b(k,63) = b(k,63) - lu(k,1762) * b(k,249) + b(k,62) = b(k,62) - lu(k,1761) * b(k,249) + b(k,61) = b(k,61) - lu(k,1760) * b(k,249) + b(k,60) = b(k,60) - lu(k,1759) * b(k,249) + b(k,59) = b(k,59) - lu(k,1758) * b(k,249) + b(k,58) = b(k,58) - lu(k,1757) * b(k,249) + b(k,57) = b(k,57) - lu(k,1756) * b(k,249) end do end subroutine lu_slv08 subroutine lu_slv09( avec_len, lu, b ) @@ -1838,211 +1819,211 @@ subroutine lu_slv09( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,205) = b(k,205) * lu(k,1230) - b(k,204) = b(k,204) - lu(k,1229) * b(k,205) - b(k,203) = b(k,203) - lu(k,1228) * b(k,205) - b(k,200) = b(k,200) - lu(k,1227) * b(k,205) - b(k,199) = b(k,199) - lu(k,1226) * b(k,205) - b(k,197) = b(k,197) - lu(k,1225) * b(k,205) - b(k,195) = b(k,195) - lu(k,1224) * b(k,205) - b(k,194) = b(k,194) - lu(k,1223) * b(k,205) - b(k,190) = b(k,190) - lu(k,1222) * b(k,205) - b(k,189) = b(k,189) - lu(k,1221) * b(k,205) - b(k,187) = b(k,187) - lu(k,1220) * b(k,205) - b(k,186) = b(k,186) - lu(k,1219) * b(k,205) - b(k,177) = b(k,177) - lu(k,1218) * b(k,205) - b(k,176) = b(k,176) - lu(k,1217) * b(k,205) - b(k,173) = b(k,173) - lu(k,1216) * b(k,205) - b(k,167) = b(k,167) - lu(k,1215) * b(k,205) - b(k,157) = b(k,157) - lu(k,1214) * b(k,205) - b(k,151) = b(k,151) - lu(k,1213) * b(k,205) - b(k,142) = b(k,142) - lu(k,1212) * b(k,205) - b(k,111) = b(k,111) - lu(k,1211) * b(k,205) - b(k,95) = b(k,95) - lu(k,1210) * b(k,205) - b(k,204) = b(k,204) * lu(k,1197) - b(k,200) = b(k,200) - lu(k,1196) * b(k,204) - b(k,195) = b(k,195) - lu(k,1195) * b(k,204) - b(k,194) = b(k,194) - lu(k,1194) * b(k,204) - b(k,190) = b(k,190) - lu(k,1193) * b(k,204) - b(k,189) = b(k,189) - lu(k,1192) * b(k,204) - b(k,187) = b(k,187) - lu(k,1191) * b(k,204) - b(k,186) = b(k,186) - lu(k,1190) * b(k,204) - b(k,167) = b(k,167) - lu(k,1189) * b(k,204) - b(k,113) = b(k,113) - lu(k,1188) * b(k,204) - b(k,203) = b(k,203) * lu(k,1174) - b(k,200) = b(k,200) - lu(k,1173) * b(k,203) - b(k,195) = b(k,195) - lu(k,1172) * b(k,203) - b(k,190) = b(k,190) - lu(k,1171) * b(k,203) - b(k,189) = b(k,189) - lu(k,1170) * b(k,203) - b(k,184) = b(k,184) - lu(k,1169) * b(k,203) - b(k,168) = b(k,168) - lu(k,1168) * b(k,203) - b(k,202) = b(k,202) * lu(k,1152) - b(k,200) = b(k,200) - lu(k,1151) * b(k,202) - b(k,199) = b(k,199) - lu(k,1150) * b(k,202) - b(k,197) = b(k,197) - lu(k,1149) * b(k,202) - b(k,195) = b(k,195) - lu(k,1148) * b(k,202) - b(k,194) = b(k,194) - lu(k,1147) * b(k,202) - b(k,190) = b(k,190) - lu(k,1146) * b(k,202) - b(k,189) = b(k,189) - lu(k,1145) * b(k,202) - b(k,187) = b(k,187) - lu(k,1144) * b(k,202) - b(k,186) = b(k,186) - lu(k,1143) * b(k,202) - b(k,167) = b(k,167) - lu(k,1142) * b(k,202) - b(k,157) = b(k,157) - lu(k,1141) * b(k,202) - b(k,147) = b(k,147) - lu(k,1140) * b(k,202) - b(k,201) = b(k,201) * lu(k,1127) - b(k,174) = b(k,174) - lu(k,1126) * b(k,201) - b(k,137) = b(k,137) - lu(k,1125) * b(k,201) - b(k,107) = b(k,107) - lu(k,1124) * b(k,201) - b(k,200) = b(k,200) * lu(k,1116) - b(k,189) = b(k,189) - lu(k,1115) * b(k,200) - b(k,199) = b(k,199) * lu(k,1104) - b(k,189) = b(k,189) - lu(k,1103) * b(k,199) - b(k,168) = b(k,168) - lu(k,1102) * b(k,199) - b(k,198) = b(k,198) * lu(k,1088) - b(k,197) = b(k,197) - lu(k,1087) * b(k,198) - b(k,189) = b(k,189) - lu(k,1086) * b(k,198) - b(k,186) = b(k,186) - lu(k,1085) * b(k,198) - b(k,185) = b(k,185) - lu(k,1084) * b(k,198) - b(k,173) = b(k,173) - lu(k,1083) * b(k,198) - b(k,167) = b(k,167) - lu(k,1082) * b(k,198) - b(k,157) = b(k,157) - lu(k,1081) * b(k,198) - b(k,118) = b(k,118) - lu(k,1080) * b(k,198) - b(k,116) = b(k,116) - lu(k,1079) * b(k,198) - b(k,197) = b(k,197) * lu(k,1068) - b(k,190) = b(k,190) - lu(k,1067) * b(k,197) - b(k,189) = b(k,189) - lu(k,1066) * b(k,197) - b(k,186) = b(k,186) - lu(k,1065) * b(k,197) - b(k,177) = b(k,177) - lu(k,1064) * b(k,197) - b(k,167) = b(k,167) - lu(k,1063) * b(k,197) - b(k,88) = b(k,88) - lu(k,1062) * b(k,197) - b(k,196) = b(k,196) * lu(k,1051) - b(k,166) = b(k,166) - lu(k,1050) * b(k,196) - b(k,96) = b(k,96) - lu(k,1049) * b(k,196) - b(k,195) = b(k,195) * lu(k,1040) - b(k,189) = b(k,189) - lu(k,1039) * b(k,195) - b(k,194) = b(k,194) * lu(k,1029) - b(k,190) = b(k,190) - lu(k,1028) * b(k,194) - b(k,167) = b(k,167) - lu(k,1027) * b(k,194) - b(k,117) = b(k,117) - lu(k,1026) * b(k,194) - b(k,193) = b(k,193) * lu(k,1013) - b(k,192) = b(k,192) - lu(k,1012) * b(k,193) - b(k,189) = b(k,189) - lu(k,1011) * b(k,193) - b(k,188) = b(k,188) - lu(k,1010) * b(k,193) - b(k,183) = b(k,183) - lu(k,1009) * b(k,193) - b(k,167) = b(k,167) - lu(k,1008) * b(k,193) - b(k,152) = b(k,152) - lu(k,1007) * b(k,193) - b(k,119) = b(k,119) - lu(k,1006) * b(k,193) - b(k,192) = b(k,192) * lu(k,994) - b(k,189) = b(k,189) - lu(k,993) * b(k,192) - b(k,188) = b(k,188) - lu(k,992) * b(k,192) - b(k,186) = b(k,186) - lu(k,991) * b(k,192) - b(k,181) = b(k,181) - lu(k,990) * b(k,192) - b(k,167) = b(k,167) - lu(k,989) * b(k,192) - b(k,149) = b(k,149) - lu(k,988) * b(k,192) - b(k,91) = b(k,91) - lu(k,987) * b(k,192) - b(k,191) = b(k,191) * lu(k,972) - b(k,189) = b(k,189) - lu(k,971) * b(k,191) - b(k,188) = b(k,188) - lu(k,970) * b(k,191) - b(k,183) = b(k,183) - lu(k,969) * b(k,191) - b(k,181) = b(k,181) - lu(k,968) * b(k,191) - b(k,167) = b(k,167) - lu(k,967) * b(k,191) - b(k,152) = b(k,152) - lu(k,966) * b(k,191) - b(k,133) = b(k,133) - lu(k,965) * b(k,191) - b(k,190) = b(k,190) * lu(k,959) - b(k,189) = b(k,189) * lu(k,955) - b(k,188) = b(k,188) * lu(k,946) - b(k,181) = b(k,181) - lu(k,945) * b(k,188) - b(k,187) = b(k,187) * lu(k,932) - b(k,186) = b(k,186) - lu(k,931) * b(k,187) - b(k,181) = b(k,181) - lu(k,930) * b(k,187) - b(k,91) = b(k,91) - lu(k,929) * b(k,187) - b(k,186) = b(k,186) * lu(k,924) - b(k,177) = b(k,177) - lu(k,923) * b(k,186) - b(k,185) = b(k,185) * lu(k,912) - b(k,177) = b(k,177) - lu(k,911) * b(k,185) - b(k,176) = b(k,176) - lu(k,910) * b(k,185) - b(k,173) = b(k,173) - lu(k,909) * b(k,185) - b(k,151) = b(k,151) - lu(k,908) * b(k,185) - b(k,184) = b(k,184) * lu(k,893) - b(k,173) = b(k,173) - lu(k,892) * b(k,184) - b(k,168) = b(k,168) - lu(k,891) * b(k,184) - b(k,164) = b(k,164) - lu(k,890) * b(k,184) - b(k,141) = b(k,141) - lu(k,889) * b(k,184) - b(k,183) = b(k,183) * lu(k,881) - b(k,182) = b(k,182) * lu(k,871) - b(k,171) = b(k,171) - lu(k,870) * b(k,182) - b(k,82) = b(k,82) - lu(k,869) * b(k,182) - b(k,181) = b(k,181) * lu(k,863) - b(k,180) = b(k,180) * lu(k,853) - b(k,172) = b(k,172) - lu(k,852) * b(k,180) - b(k,156) = b(k,156) - lu(k,851) * b(k,180) - b(k,155) = b(k,155) - lu(k,850) * b(k,180) - b(k,154) = b(k,154) - lu(k,849) * b(k,180) - b(k,138) = b(k,138) - lu(k,848) * b(k,180) - b(k,179) = b(k,179) * lu(k,831) - b(k,177) = b(k,177) - lu(k,830) * b(k,179) - b(k,168) = b(k,168) - lu(k,829) * b(k,179) - b(k,120) = b(k,120) - lu(k,828) * b(k,179) - b(k,92) = b(k,92) - lu(k,827) * b(k,179) - b(k,61) = b(k,61) - lu(k,826) * b(k,179) - b(k,60) = b(k,60) - lu(k,825) * b(k,179) - b(k,59) = b(k,59) - lu(k,824) * b(k,179) - b(k,58) = b(k,58) - lu(k,823) * b(k,179) - b(k,57) = b(k,57) - lu(k,822) * b(k,179) - b(k,178) = b(k,178) * lu(k,805) - b(k,177) = b(k,177) - lu(k,804) * b(k,178) - b(k,168) = b(k,168) - lu(k,803) * b(k,178) - b(k,120) = b(k,120) - lu(k,802) * b(k,178) - b(k,92) = b(k,92) - lu(k,801) * b(k,178) - b(k,61) = b(k,61) - lu(k,800) * b(k,178) - b(k,60) = b(k,60) - lu(k,799) * b(k,178) - b(k,59) = b(k,59) - lu(k,798) * b(k,178) - b(k,58) = b(k,58) - lu(k,797) * b(k,178) - b(k,57) = b(k,57) - lu(k,796) * b(k,178) - b(k,177) = b(k,177) * lu(k,792) - b(k,57) = b(k,57) - lu(k,791) * b(k,177) - b(k,176) = b(k,176) * lu(k,782) - b(k,175) = b(k,175) * lu(k,766) - b(k,168) = b(k,168) - lu(k,765) * b(k,175) - b(k,61) = b(k,61) - lu(k,764) * b(k,175) - b(k,60) = b(k,60) - lu(k,763) * b(k,175) - b(k,59) = b(k,59) - lu(k,762) * b(k,175) - b(k,58) = b(k,58) - lu(k,761) * b(k,175) - b(k,57) = b(k,57) - lu(k,760) * b(k,175) - b(k,174) = b(k,174) * lu(k,754) - b(k,97) = b(k,97) - lu(k,753) * b(k,174) - b(k,173) = b(k,173) * lu(k,747) - b(k,172) = b(k,172) * lu(k,739) - b(k,167) = b(k,167) - lu(k,738) * b(k,172) - b(k,110) = b(k,110) - lu(k,737) * b(k,172) - b(k,98) = b(k,98) - lu(k,736) * b(k,172) - b(k,171) = b(k,171) * lu(k,729) - b(k,82) = b(k,82) - lu(k,728) * b(k,171) - b(k,170) = b(k,170) * lu(k,720) - b(k,169) = b(k,169) * lu(k,710) - b(k,121) = b(k,121) - lu(k,709) * b(k,169) - b(k,168) = b(k,168) * lu(k,705) - b(k,167) = b(k,167) * lu(k,701) - b(k,166) = b(k,166) * lu(k,693) - b(k,96) = b(k,96) - lu(k,692) * b(k,166) - b(k,165) = b(k,165) * lu(k,684) - b(k,93) = b(k,93) - lu(k,683) * b(k,165) - b(k,164) = b(k,164) * lu(k,674) - b(k,140) = b(k,140) - lu(k,673) * b(k,164) - b(k,163) = b(k,163) * lu(k,665) - b(k,162) = b(k,162) * lu(k,654) - b(k,160) = b(k,160) - lu(k,653) * b(k,162) - b(k,158) = b(k,158) - lu(k,652) * b(k,162) - b(k,151) = b(k,151) - lu(k,651) * b(k,162) - b(k,130) = b(k,130) - lu(k,650) * b(k,162) - b(k,106) = b(k,106) - lu(k,649) * b(k,162) - b(k,101) = b(k,101) - lu(k,648) * b(k,162) - b(k,161) = b(k,161) * lu(k,638) - b(k,160) = b(k,160) - lu(k,637) * b(k,161) - b(k,151) = b(k,151) - lu(k,636) * b(k,161) - b(k,150) = b(k,150) - lu(k,635) * b(k,161) - b(k,130) = b(k,130) - lu(k,634) * b(k,161) - b(k,101) = b(k,101) - lu(k,633) * b(k,161) + b(k,248) = b(k,248) * lu(k,1744) + b(k,247) = b(k,247) - lu(k,1743) * b(k,248) + b(k,246) = b(k,246) - lu(k,1742) * b(k,248) + b(k,245) = b(k,245) - lu(k,1741) * b(k,248) + b(k,244) = b(k,244) - lu(k,1740) * b(k,248) + b(k,243) = b(k,243) - lu(k,1739) * b(k,248) + b(k,242) = b(k,242) - lu(k,1738) * b(k,248) + b(k,241) = b(k,241) - lu(k,1737) * b(k,248) + b(k,240) = b(k,240) - lu(k,1736) * b(k,248) + b(k,208) = b(k,208) - lu(k,1735) * b(k,248) + b(k,201) = b(k,201) - lu(k,1734) * b(k,248) + b(k,175) = b(k,175) - lu(k,1733) * b(k,248) + b(k,162) = b(k,162) - lu(k,1732) * b(k,248) + b(k,152) = b(k,152) - lu(k,1731) * b(k,248) + b(k,132) = b(k,132) - lu(k,1730) * b(k,248) + b(k,121) = b(k,121) - lu(k,1729) * b(k,248) + b(k,120) = b(k,120) - lu(k,1728) * b(k,248) + b(k,115) = b(k,115) - lu(k,1727) * b(k,248) + b(k,114) = b(k,114) - lu(k,1726) * b(k,248) + b(k,107) = b(k,107) - lu(k,1725) * b(k,248) + b(k,106) = b(k,106) - lu(k,1724) * b(k,248) + b(k,99) = b(k,99) - lu(k,1723) * b(k,248) + b(k,98) = b(k,98) - lu(k,1722) * b(k,248) + b(k,97) = b(k,97) - lu(k,1721) * b(k,248) + b(k,96) = b(k,96) - lu(k,1720) * b(k,248) + b(k,93) = b(k,93) - lu(k,1719) * b(k,248) + b(k,91) = b(k,91) - lu(k,1718) * b(k,248) + b(k,90) = b(k,90) - lu(k,1717) * b(k,248) + b(k,89) = b(k,89) - lu(k,1716) * b(k,248) + b(k,85) = b(k,85) - lu(k,1715) * b(k,248) + b(k,247) = b(k,247) * lu(k,1702) + b(k,246) = b(k,246) - lu(k,1701) * b(k,247) + b(k,245) = b(k,245) - lu(k,1700) * b(k,247) + b(k,244) = b(k,244) - lu(k,1699) * b(k,247) + b(k,243) = b(k,243) - lu(k,1698) * b(k,247) + b(k,242) = b(k,242) - lu(k,1697) * b(k,247) + b(k,241) = b(k,241) - lu(k,1696) * b(k,247) + b(k,239) = b(k,239) - lu(k,1695) * b(k,247) + b(k,238) = b(k,238) - lu(k,1694) * b(k,247) + b(k,233) = b(k,233) - lu(k,1693) * b(k,247) + b(k,232) = b(k,232) - lu(k,1692) * b(k,247) + b(k,227) = b(k,227) - lu(k,1691) * b(k,247) + b(k,223) = b(k,223) - lu(k,1690) * b(k,247) + b(k,213) = b(k,213) - lu(k,1689) * b(k,247) + b(k,209) = b(k,209) - lu(k,1688) * b(k,247) + b(k,207) = b(k,207) - lu(k,1687) * b(k,247) + b(k,206) = b(k,206) - lu(k,1686) * b(k,247) + b(k,203) = b(k,203) - lu(k,1685) * b(k,247) + b(k,197) = b(k,197) - lu(k,1684) * b(k,247) + b(k,195) = b(k,195) - lu(k,1683) * b(k,247) + b(k,192) = b(k,192) - lu(k,1682) * b(k,247) + b(k,183) = b(k,183) - lu(k,1681) * b(k,247) + b(k,177) = b(k,177) - lu(k,1680) * b(k,247) + b(k,170) = b(k,170) - lu(k,1679) * b(k,247) + b(k,169) = b(k,169) - lu(k,1678) * b(k,247) + b(k,167) = b(k,167) - lu(k,1677) * b(k,247) + b(k,161) = b(k,161) - lu(k,1676) * b(k,247) + b(k,160) = b(k,160) - lu(k,1675) * b(k,247) + b(k,150) = b(k,150) - lu(k,1674) * b(k,247) + b(k,133) = b(k,133) - lu(k,1673) * b(k,247) + b(k,106) = b(k,106) - lu(k,1672) * b(k,247) + b(k,95) = b(k,95) - lu(k,1671) * b(k,247) + b(k,246) = b(k,246) * lu(k,1657) + b(k,245) = b(k,245) - lu(k,1656) * b(k,246) + b(k,244) = b(k,244) - lu(k,1655) * b(k,246) + b(k,243) = b(k,243) - lu(k,1654) * b(k,246) + b(k,242) = b(k,242) - lu(k,1653) * b(k,246) + b(k,239) = b(k,239) - lu(k,1652) * b(k,246) + b(k,238) = b(k,238) - lu(k,1651) * b(k,246) + b(k,237) = b(k,237) - lu(k,1650) * b(k,246) + b(k,236) = b(k,236) - lu(k,1649) * b(k,246) + b(k,235) = b(k,235) - lu(k,1648) * b(k,246) + b(k,234) = b(k,234) - lu(k,1647) * b(k,246) + b(k,232) = b(k,232) - lu(k,1646) * b(k,246) + b(k,231) = b(k,231) - lu(k,1645) * b(k,246) + b(k,230) = b(k,230) - lu(k,1644) * b(k,246) + b(k,229) = b(k,229) - lu(k,1643) * b(k,246) + b(k,227) = b(k,227) - lu(k,1642) * b(k,246) + b(k,226) = b(k,226) - lu(k,1641) * b(k,246) + b(k,225) = b(k,225) - lu(k,1640) * b(k,246) + b(k,224) = b(k,224) - lu(k,1639) * b(k,246) + b(k,223) = b(k,223) - lu(k,1638) * b(k,246) + b(k,222) = b(k,222) - lu(k,1637) * b(k,246) + b(k,221) = b(k,221) - lu(k,1636) * b(k,246) + b(k,220) = b(k,220) - lu(k,1635) * b(k,246) + b(k,219) = b(k,219) - lu(k,1634) * b(k,246) + b(k,216) = b(k,216) - lu(k,1633) * b(k,246) + b(k,213) = b(k,213) - lu(k,1632) * b(k,246) + b(k,212) = b(k,212) - lu(k,1631) * b(k,246) + b(k,211) = b(k,211) - lu(k,1630) * b(k,246) + b(k,205) = b(k,205) - lu(k,1629) * b(k,246) + b(k,203) = b(k,203) - lu(k,1628) * b(k,246) + b(k,202) = b(k,202) - lu(k,1627) * b(k,246) + b(k,199) = b(k,199) - lu(k,1626) * b(k,246) + b(k,198) = b(k,198) - lu(k,1625) * b(k,246) + b(k,188) = b(k,188) - lu(k,1624) * b(k,246) + b(k,182) = b(k,182) - lu(k,1623) * b(k,246) + b(k,151) = b(k,151) - lu(k,1622) * b(k,246) + b(k,149) = b(k,149) - lu(k,1621) * b(k,246) + b(k,140) = b(k,140) - lu(k,1620) * b(k,246) + b(k,124) = b(k,124) - lu(k,1619) * b(k,246) + b(k,245) = b(k,245) * lu(k,1604) + b(k,244) = b(k,244) - lu(k,1603) * b(k,245) + b(k,243) = b(k,243) - lu(k,1602) * b(k,245) + b(k,242) = b(k,242) - lu(k,1601) * b(k,245) + b(k,241) = b(k,241) - lu(k,1600) * b(k,245) + b(k,239) = b(k,239) - lu(k,1599) * b(k,245) + b(k,238) = b(k,238) - lu(k,1598) * b(k,245) + b(k,237) = b(k,237) - lu(k,1597) * b(k,245) + b(k,236) = b(k,236) - lu(k,1596) * b(k,245) + b(k,235) = b(k,235) - lu(k,1595) * b(k,245) + b(k,234) = b(k,234) - lu(k,1594) * b(k,245) + b(k,232) = b(k,232) - lu(k,1593) * b(k,245) + b(k,231) = b(k,231) - lu(k,1592) * b(k,245) + b(k,230) = b(k,230) - lu(k,1591) * b(k,245) + b(k,229) = b(k,229) - lu(k,1590) * b(k,245) + b(k,228) = b(k,228) - lu(k,1589) * b(k,245) + b(k,227) = b(k,227) - lu(k,1588) * b(k,245) + b(k,226) = b(k,226) - lu(k,1587) * b(k,245) + b(k,225) = b(k,225) - lu(k,1586) * b(k,245) + b(k,224) = b(k,224) - lu(k,1585) * b(k,245) + b(k,223) = b(k,223) - lu(k,1584) * b(k,245) + b(k,222) = b(k,222) - lu(k,1583) * b(k,245) + b(k,221) = b(k,221) - lu(k,1582) * b(k,245) + b(k,220) = b(k,220) - lu(k,1581) * b(k,245) + b(k,219) = b(k,219) - lu(k,1580) * b(k,245) + b(k,216) = b(k,216) - lu(k,1579) * b(k,245) + b(k,215) = b(k,215) - lu(k,1578) * b(k,245) + b(k,213) = b(k,213) - lu(k,1577) * b(k,245) + b(k,212) = b(k,212) - lu(k,1576) * b(k,245) + b(k,211) = b(k,211) - lu(k,1575) * b(k,245) + b(k,210) = b(k,210) - lu(k,1574) * b(k,245) + b(k,207) = b(k,207) - lu(k,1573) * b(k,245) + b(k,205) = b(k,205) - lu(k,1572) * b(k,245) + b(k,203) = b(k,203) - lu(k,1571) * b(k,245) + b(k,202) = b(k,202) - lu(k,1570) * b(k,245) + b(k,199) = b(k,199) - lu(k,1569) * b(k,245) + b(k,196) = b(k,196) - lu(k,1568) * b(k,245) + b(k,195) = b(k,195) - lu(k,1567) * b(k,245) + b(k,194) = b(k,194) - lu(k,1566) * b(k,245) + b(k,193) = b(k,193) - lu(k,1565) * b(k,245) + b(k,192) = b(k,192) - lu(k,1564) * b(k,245) + b(k,191) = b(k,191) - lu(k,1563) * b(k,245) + b(k,187) = b(k,187) - lu(k,1562) * b(k,245) + b(k,184) = b(k,184) - lu(k,1561) * b(k,245) + b(k,183) = b(k,183) - lu(k,1560) * b(k,245) + b(k,182) = b(k,182) - lu(k,1559) * b(k,245) + b(k,181) = b(k,181) - lu(k,1558) * b(k,245) + b(k,180) = b(k,180) - lu(k,1557) * b(k,245) + b(k,174) = b(k,174) - lu(k,1556) * b(k,245) + b(k,171) = b(k,171) - lu(k,1555) * b(k,245) + b(k,167) = b(k,167) - lu(k,1554) * b(k,245) + b(k,166) = b(k,166) - lu(k,1553) * b(k,245) + b(k,165) = b(k,165) - lu(k,1552) * b(k,245) + b(k,164) = b(k,164) - lu(k,1551) * b(k,245) + b(k,161) = b(k,161) - lu(k,1550) * b(k,245) + b(k,160) = b(k,160) - lu(k,1549) * b(k,245) + b(k,159) = b(k,159) - lu(k,1548) * b(k,245) + b(k,158) = b(k,158) - lu(k,1547) * b(k,245) + b(k,157) = b(k,157) - lu(k,1546) * b(k,245) + b(k,155) = b(k,155) - lu(k,1545) * b(k,245) + b(k,140) = b(k,140) - lu(k,1544) * b(k,245) + b(k,135) = b(k,135) - lu(k,1543) * b(k,245) + b(k,127) = b(k,127) - lu(k,1542) * b(k,245) + b(k,126) = b(k,126) - lu(k,1541) * b(k,245) + b(k,119) = b(k,119) - lu(k,1540) * b(k,245) + b(k,117) = b(k,117) - lu(k,1539) * b(k,245) + b(k,83) = b(k,83) - lu(k,1538) * b(k,245) + b(k,82) = b(k,82) - lu(k,1537) * b(k,245) + b(k,79) = b(k,79) - lu(k,1536) * b(k,245) + b(k,77) = b(k,77) - lu(k,1535) * b(k,245) + b(k,76) = b(k,76) - lu(k,1534) * b(k,245) + b(k,75) = b(k,75) - lu(k,1533) * b(k,245) + b(k,74) = b(k,74) - lu(k,1532) * b(k,245) + b(k,73) = b(k,73) - lu(k,1531) * b(k,245) + b(k,72) = b(k,72) - lu(k,1530) * b(k,245) + b(k,71) = b(k,71) - lu(k,1529) * b(k,245) + b(k,70) = b(k,70) - lu(k,1528) * b(k,245) + b(k,69) = b(k,69) - lu(k,1527) * b(k,245) + b(k,68) = b(k,68) - lu(k,1526) * b(k,245) + b(k,67) = b(k,67) - lu(k,1525) * b(k,245) + b(k,66) = b(k,66) - lu(k,1524) * b(k,245) + b(k,65) = b(k,65) - lu(k,1523) * b(k,245) + b(k,64) = b(k,64) - lu(k,1522) * b(k,245) + b(k,62) = b(k,62) - lu(k,1521) * b(k,245) + b(k,61) = b(k,61) - lu(k,1520) * b(k,245) + b(k,60) = b(k,60) - lu(k,1519) * b(k,245) + b(k,59) = b(k,59) - lu(k,1518) * b(k,245) + b(k,58) = b(k,58) - lu(k,1517) * b(k,245) + b(k,57) = b(k,57) - lu(k,1516) * b(k,245) + b(k,244) = b(k,244) * lu(k,1503) + b(k,243) = b(k,243) - lu(k,1502) * b(k,244) + b(k,242) = b(k,242) - lu(k,1501) * b(k,244) + b(k,240) = b(k,240) - lu(k,1500) * b(k,244) + b(k,243) = b(k,243) * lu(k,1487) + b(k,242) = b(k,242) - lu(k,1486) * b(k,243) + b(k,240) = b(k,240) - lu(k,1485) * b(k,243) + b(k,208) = b(k,208) - lu(k,1484) * b(k,243) + b(k,131) = b(k,131) - lu(k,1483) * b(k,243) + b(k,242) = b(k,242) * lu(k,1470) + b(k,240) = b(k,240) - lu(k,1469) * b(k,242) + b(k,223) = b(k,223) - lu(k,1468) * b(k,242) + b(k,208) = b(k,208) - lu(k,1467) * b(k,242) + b(k,203) = b(k,203) - lu(k,1466) * b(k,242) + b(k,131) = b(k,131) - lu(k,1465) * b(k,242) end do end subroutine lu_slv09 subroutine lu_slv10( avec_len, lu, b ) @@ -2063,170 +2044,507 @@ subroutine lu_slv10( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,160) = b(k,160) * lu(k,627) - b(k,159) = b(k,159) * lu(k,620) - b(k,100) = b(k,100) - lu(k,619) * b(k,159) - b(k,77) = b(k,77) - lu(k,618) * b(k,159) - b(k,158) = b(k,158) * lu(k,607) - b(k,151) = b(k,151) - lu(k,606) * b(k,158) - b(k,130) = b(k,130) - lu(k,605) * b(k,158) - b(k,106) = b(k,106) - lu(k,604) * b(k,158) - b(k,101) = b(k,101) - lu(k,603) * b(k,158) - b(k,157) = b(k,157) * lu(k,596) - b(k,74) = b(k,74) - lu(k,595) * b(k,157) - b(k,156) = b(k,156) * lu(k,588) - b(k,112) = b(k,112) - lu(k,587) * b(k,156) - b(k,155) = b(k,155) * lu(k,577) - b(k,138) = b(k,138) - lu(k,576) * b(k,155) - b(k,154) = b(k,154) * lu(k,566) - b(k,138) = b(k,138) - lu(k,565) * b(k,154) - b(k,153) = b(k,153) * lu(k,559) - b(k,131) = b(k,131) - lu(k,558) * b(k,153) - b(k,99) = b(k,99) - lu(k,557) * b(k,153) - b(k,152) = b(k,152) * lu(k,551) - b(k,151) = b(k,151) * lu(k,547) - b(k,150) = b(k,150) * lu(k,538) - b(k,130) = b(k,130) - lu(k,537) * b(k,150) - b(k,101) = b(k,101) - lu(k,536) * b(k,150) - b(k,149) = b(k,149) * lu(k,527) - b(k,148) = b(k,148) * lu(k,520) - b(k,147) = b(k,147) * lu(k,511) - b(k,146) = b(k,146) * lu(k,503) - b(k,145) = b(k,145) * lu(k,495) - b(k,144) = b(k,144) * lu(k,487) - b(k,143) = b(k,143) * lu(k,479) - b(k,142) = b(k,142) * lu(k,471) - b(k,141) = b(k,141) * lu(k,467) - b(k,140) = b(k,140) * lu(k,459) - b(k,139) = b(k,139) * lu(k,453) - b(k,75) = b(k,75) - lu(k,452) * b(k,139) - b(k,138) = b(k,138) * lu(k,447) - b(k,137) = b(k,137) * lu(k,441) - b(k,136) = b(k,136) * lu(k,435) - b(k,135) = b(k,135) * lu(k,428) - b(k,126) = b(k,126) - lu(k,427) * b(k,135) - b(k,134) = b(k,134) * lu(k,420) - b(k,130) = b(k,130) - lu(k,419) * b(k,134) - b(k,122) = b(k,122) - lu(k,418) * b(k,134) - b(k,133) = b(k,133) * lu(k,411) - b(k,132) = b(k,132) * lu(k,404) - b(k,131) = b(k,131) * lu(k,400) - b(k,130) = b(k,130) * lu(k,397) - b(k,129) = b(k,129) * lu(k,391) - b(k,108) = b(k,108) - lu(k,390) * b(k,129) - b(k,128) = b(k,128) * lu(k,384) - b(k,127) = b(k,127) * lu(k,378) - b(k,109) = b(k,109) - lu(k,377) * b(k,127) - b(k,94) = b(k,94) - lu(k,376) * b(k,127) - b(k,126) = b(k,126) * lu(k,370) - b(k,125) = b(k,125) * lu(k,364) - b(k,124) = b(k,124) * lu(k,358) - b(k,123) = b(k,123) * lu(k,352) - b(k,122) = b(k,122) * lu(k,346) - b(k,121) = b(k,121) * lu(k,340) - b(k,120) = b(k,120) * lu(k,334) - b(k,119) = b(k,119) * lu(k,328) - b(k,118) = b(k,118) * lu(k,322) - b(k,117) = b(k,117) * lu(k,316) - b(k,116) = b(k,116) * lu(k,310) - b(k,115) = b(k,115) * lu(k,302) - b(k,114) = b(k,114) * lu(k,294) - b(k,113) = b(k,113) * lu(k,289) - b(k,112) = b(k,112) * lu(k,284) - b(k,111) = b(k,111) * lu(k,281) - b(k,110) = b(k,110) * lu(k,276) - b(k,109) = b(k,109) * lu(k,271) - b(k,94) = b(k,94) - lu(k,270) * b(k,109) - b(k,108) = b(k,108) * lu(k,265) - b(k,107) = b(k,107) * lu(k,260) - b(k,106) = b(k,106) * lu(k,255) - b(k,105) = b(k,105) * lu(k,249) - b(k,104) = b(k,104) * lu(k,243) - b(k,103) = b(k,103) * lu(k,237) - b(k,102) = b(k,102) * lu(k,231) - b(k,101) = b(k,101) * lu(k,228) - b(k,100) = b(k,100) * lu(k,224) - b(k,99) = b(k,99) * lu(k,220) - b(k,98) = b(k,98) * lu(k,216) - b(k,97) = b(k,97) * lu(k,212) - b(k,78) = b(k,78) - lu(k,211) * b(k,97) - b(k,96) = b(k,96) * lu(k,208) - b(k,95) = b(k,95) * lu(k,203) - b(k,94) = b(k,94) * lu(k,200) - b(k,93) = b(k,93) * lu(k,197) - b(k,92) = b(k,92) * lu(k,194) - b(k,91) = b(k,91) * lu(k,191) - b(k,90) = b(k,90) * lu(k,186) - b(k,89) = b(k,89) * lu(k,178) - b(k,87) = b(k,87) - lu(k,177) * b(k,89) - b(k,66) = b(k,66) - lu(k,176) * b(k,89) - b(k,65) = b(k,65) - lu(k,175) * b(k,89) - b(k,64) = b(k,64) - lu(k,174) * b(k,89) - b(k,63) = b(k,63) - lu(k,173) * b(k,89) - b(k,62) = b(k,62) - lu(k,172) * b(k,89) - b(k,88) = b(k,88) * lu(k,169) - b(k,87) = b(k,87) * lu(k,165) - b(k,86) = b(k,86) * lu(k,160) - b(k,85) = b(k,85) * lu(k,153) - b(k,66) = b(k,66) - lu(k,152) * b(k,85) - b(k,65) = b(k,65) - lu(k,151) * b(k,85) - b(k,64) = b(k,64) - lu(k,150) * b(k,85) - b(k,63) = b(k,63) - lu(k,149) * b(k,85) - b(k,62) = b(k,62) - lu(k,148) * b(k,85) - b(k,84) = b(k,84) * lu(k,144) - b(k,83) = b(k,83) * lu(k,140) - b(k,82) = b(k,82) * lu(k,138) - b(k,81) = b(k,81) * lu(k,133) - b(k,80) = b(k,80) * lu(k,129) - b(k,79) = b(k,79) * lu(k,123) - b(k,66) = b(k,66) - lu(k,122) * b(k,79) - b(k,65) = b(k,65) - lu(k,121) * b(k,79) - b(k,64) = b(k,64) - lu(k,120) * b(k,79) - b(k,63) = b(k,63) - lu(k,119) * b(k,79) - b(k,62) = b(k,62) - lu(k,118) * b(k,79) - b(k,78) = b(k,78) * lu(k,115) - b(k,77) = b(k,77) * lu(k,112) - b(k,76) = b(k,76) * lu(k,109) - b(k,75) = b(k,75) * lu(k,106) - b(k,74) = b(k,74) * lu(k,103) - b(k,73) = b(k,73) * lu(k,99) - b(k,72) = b(k,72) * lu(k,96) - b(k,71) = b(k,71) * lu(k,93) - b(k,70) = b(k,70) * lu(k,90) - b(k,69) = b(k,69) * lu(k,89) - b(k,66) = b(k,66) - lu(k,88) * b(k,69) - b(k,65) = b(k,65) - lu(k,87) * b(k,69) - b(k,64) = b(k,64) - lu(k,86) * b(k,69) - b(k,63) = b(k,63) - lu(k,85) * b(k,69) - b(k,62) = b(k,62) - lu(k,84) * b(k,69) - b(k,68) = b(k,68) * lu(k,83) - b(k,55) = b(k,55) - lu(k,82) * b(k,68) - b(k,54) = b(k,54) - lu(k,81) * b(k,68) - b(k,53) = b(k,53) - lu(k,80) * b(k,68) - b(k,52) = b(k,52) - lu(k,79) * b(k,68) - b(k,51) = b(k,51) - lu(k,78) * b(k,68) - b(k,67) = b(k,67) * lu(k,77) - b(k,66) = b(k,66) - lu(k,76) * b(k,67) - b(k,65) = b(k,65) - lu(k,75) * b(k,67) - b(k,64) = b(k,64) - lu(k,74) * b(k,67) - b(k,63) = b(k,63) - lu(k,73) * b(k,67) - b(k,62) = b(k,62) - lu(k,72) * b(k,67) - b(k,66) = b(k,66) * lu(k,71) - b(k,65) = b(k,65) * lu(k,70) - b(k,64) = b(k,64) * lu(k,69) - b(k,63) = b(k,63) * lu(k,68) + b(k,241) = b(k,241) * lu(k,1455) + b(k,223) = b(k,223) - lu(k,1454) * b(k,241) + b(k,201) = b(k,201) - lu(k,1453) * b(k,241) + b(k,240) = b(k,240) * lu(k,1441) + b(k,208) = b(k,208) - lu(k,1440) * b(k,240) + b(k,131) = b(k,131) - lu(k,1439) * b(k,240) + b(k,239) = b(k,239) * lu(k,1426) + b(k,238) = b(k,238) - lu(k,1425) * b(k,239) + b(k,237) = b(k,237) - lu(k,1424) * b(k,239) + b(k,236) = b(k,236) - lu(k,1423) * b(k,239) + b(k,235) = b(k,235) - lu(k,1422) * b(k,239) + b(k,234) = b(k,234) - lu(k,1421) * b(k,239) + b(k,232) = b(k,232) - lu(k,1420) * b(k,239) + b(k,231) = b(k,231) - lu(k,1419) * b(k,239) + b(k,230) = b(k,230) - lu(k,1418) * b(k,239) + b(k,229) = b(k,229) - lu(k,1417) * b(k,239) + b(k,227) = b(k,227) - lu(k,1416) * b(k,239) + b(k,224) = b(k,224) - lu(k,1415) * b(k,239) + b(k,223) = b(k,223) - lu(k,1414) * b(k,239) + b(k,219) = b(k,219) - lu(k,1413) * b(k,239) + b(k,213) = b(k,213) - lu(k,1412) * b(k,239) + b(k,203) = b(k,203) - lu(k,1411) * b(k,239) + b(k,188) = b(k,188) - lu(k,1410) * b(k,239) + b(k,176) = b(k,176) - lu(k,1409) * b(k,239) + b(k,169) = b(k,169) - lu(k,1408) * b(k,239) + b(k,140) = b(k,140) - lu(k,1407) * b(k,239) + b(k,238) = b(k,238) * lu(k,1394) + b(k,232) = b(k,232) - lu(k,1393) * b(k,238) + b(k,227) = b(k,227) - lu(k,1392) * b(k,238) + b(k,223) = b(k,223) - lu(k,1391) * b(k,238) + b(k,203) = b(k,203) - lu(k,1390) * b(k,238) + b(k,188) = b(k,188) - lu(k,1389) * b(k,238) + b(k,177) = b(k,177) - lu(k,1388) * b(k,238) + b(k,176) = b(k,176) - lu(k,1387) * b(k,238) + b(k,237) = b(k,237) * lu(k,1372) + b(k,236) = b(k,236) - lu(k,1371) * b(k,237) + b(k,232) = b(k,232) - lu(k,1370) * b(k,237) + b(k,227) = b(k,227) - lu(k,1369) * b(k,237) + b(k,223) = b(k,223) - lu(k,1368) * b(k,237) + b(k,222) = b(k,222) - lu(k,1367) * b(k,237) + b(k,218) = b(k,218) - lu(k,1366) * b(k,237) + b(k,215) = b(k,215) - lu(k,1365) * b(k,237) + b(k,203) = b(k,203) - lu(k,1364) * b(k,237) + b(k,236) = b(k,236) * lu(k,1351) + b(k,232) = b(k,232) - lu(k,1350) * b(k,236) + b(k,228) = b(k,228) - lu(k,1349) * b(k,236) + b(k,227) = b(k,227) - lu(k,1348) * b(k,236) + b(k,224) = b(k,224) - lu(k,1347) * b(k,236) + b(k,223) = b(k,223) - lu(k,1346) * b(k,236) + b(k,198) = b(k,198) - lu(k,1345) * b(k,236) + b(k,141) = b(k,141) - lu(k,1344) * b(k,236) + b(k,235) = b(k,235) * lu(k,1328) + b(k,232) = b(k,232) - lu(k,1327) * b(k,235) + b(k,231) = b(k,231) - lu(k,1326) * b(k,235) + b(k,229) = b(k,229) - lu(k,1325) * b(k,235) + b(k,228) = b(k,228) - lu(k,1324) * b(k,235) + b(k,227) = b(k,227) - lu(k,1323) * b(k,235) + b(k,224) = b(k,224) - lu(k,1322) * b(k,235) + b(k,223) = b(k,223) - lu(k,1321) * b(k,235) + b(k,213) = b(k,213) - lu(k,1320) * b(k,235) + b(k,207) = b(k,207) - lu(k,1319) * b(k,235) + b(k,205) = b(k,205) - lu(k,1318) * b(k,235) + b(k,198) = b(k,198) - lu(k,1317) * b(k,235) + b(k,189) = b(k,189) - lu(k,1316) * b(k,235) + b(k,181) = b(k,181) - lu(k,1315) * b(k,235) + b(k,171) = b(k,171) - lu(k,1314) * b(k,235) + b(k,140) = b(k,140) - lu(k,1313) * b(k,235) + b(k,122) = b(k,122) - lu(k,1312) * b(k,235) + b(k,234) = b(k,234) * lu(k,1296) + b(k,232) = b(k,232) - lu(k,1295) * b(k,234) + b(k,231) = b(k,231) - lu(k,1294) * b(k,234) + b(k,229) = b(k,229) - lu(k,1293) * b(k,234) + b(k,228) = b(k,228) - lu(k,1292) * b(k,234) + b(k,227) = b(k,227) - lu(k,1291) * b(k,234) + b(k,224) = b(k,224) - lu(k,1290) * b(k,234) + b(k,223) = b(k,223) - lu(k,1289) * b(k,234) + b(k,203) = b(k,203) - lu(k,1288) * b(k,234) + b(k,198) = b(k,198) - lu(k,1287) * b(k,234) + b(k,189) = b(k,189) - lu(k,1286) * b(k,234) + b(k,180) = b(k,180) - lu(k,1285) * b(k,234) + b(k,233) = b(k,233) * lu(k,1272) + b(k,206) = b(k,206) - lu(k,1271) * b(k,233) + b(k,168) = b(k,168) - lu(k,1270) * b(k,233) + b(k,136) = b(k,136) - lu(k,1269) * b(k,233) + b(k,232) = b(k,232) * lu(k,1261) + b(k,223) = b(k,223) - lu(k,1260) * b(k,232) + b(k,231) = b(k,231) * lu(k,1249) + b(k,223) = b(k,223) - lu(k,1248) * b(k,231) + b(k,215) = b(k,215) - lu(k,1247) * b(k,231) + b(k,230) = b(k,230) * lu(k,1233) + b(k,229) = b(k,229) - lu(k,1232) * b(k,230) + b(k,224) = b(k,224) - lu(k,1231) * b(k,230) + b(k,223) = b(k,223) - lu(k,1230) * b(k,230) + b(k,219) = b(k,219) - lu(k,1229) * b(k,230) + b(k,205) = b(k,205) - lu(k,1228) * b(k,230) + b(k,198) = b(k,198) - lu(k,1227) * b(k,230) + b(k,189) = b(k,189) - lu(k,1226) * b(k,230) + b(k,149) = b(k,149) - lu(k,1225) * b(k,230) + b(k,148) = b(k,148) - lu(k,1224) * b(k,230) + b(k,229) = b(k,229) * lu(k,1213) + b(k,227) = b(k,227) - lu(k,1212) * b(k,229) + b(k,224) = b(k,224) - lu(k,1211) * b(k,229) + b(k,223) = b(k,223) - lu(k,1210) * b(k,229) + b(k,213) = b(k,213) - lu(k,1209) * b(k,229) + b(k,203) = b(k,203) - lu(k,1208) * b(k,229) + b(k,198) = b(k,198) - lu(k,1207) * b(k,229) + b(k,111) = b(k,111) - lu(k,1206) * b(k,229) + b(k,228) = b(k,228) * lu(k,1193) + b(k,227) = b(k,227) - lu(k,1192) * b(k,228) + b(k,226) = b(k,226) - lu(k,1191) * b(k,228) + b(k,224) = b(k,224) - lu(k,1190) * b(k,228) + b(k,223) = b(k,223) - lu(k,1189) * b(k,228) + b(k,222) = b(k,222) - lu(k,1188) * b(k,228) + b(k,212) = b(k,212) - lu(k,1187) * b(k,228) + b(k,117) = b(k,117) - lu(k,1186) * b(k,228) + b(k,227) = b(k,227) * lu(k,1180) + b(k,226) = b(k,226) * lu(k,1169) + b(k,198) = b(k,198) - lu(k,1168) * b(k,226) + b(k,145) = b(k,145) - lu(k,1167) * b(k,226) + b(k,225) = b(k,225) * lu(k,1155) + b(k,224) = b(k,224) - lu(k,1154) * b(k,225) + b(k,223) = b(k,223) - lu(k,1153) * b(k,225) + b(k,221) = b(k,221) - lu(k,1152) * b(k,225) + b(k,212) = b(k,212) - lu(k,1151) * b(k,225) + b(k,203) = b(k,203) - lu(k,1150) * b(k,225) + b(k,198) = b(k,198) - lu(k,1149) * b(k,225) + b(k,185) = b(k,185) - lu(k,1148) * b(k,225) + b(k,117) = b(k,117) - lu(k,1147) * b(k,225) + b(k,224) = b(k,224) * lu(k,1142) + b(k,223) = b(k,223) - lu(k,1141) * b(k,224) + b(k,213) = b(k,213) - lu(k,1140) * b(k,224) + b(k,203) = b(k,203) - lu(k,1139) * b(k,224) + b(k,223) = b(k,223) * lu(k,1135) + b(k,203) = b(k,203) - lu(k,1134) * b(k,223) + b(k,222) = b(k,222) * lu(k,1125) + b(k,221) = b(k,221) * lu(k,1115) + b(k,212) = b(k,212) - lu(k,1114) * b(k,221) + b(k,203) = b(k,203) - lu(k,1113) * b(k,221) + b(k,220) = b(k,220) * lu(k,1101) + b(k,216) = b(k,216) - lu(k,1100) * b(k,220) + b(k,198) = b(k,198) - lu(k,1099) * b(k,220) + b(k,182) = b(k,182) - lu(k,1098) * b(k,220) + b(k,153) = b(k,153) - lu(k,1097) * b(k,220) + b(k,219) = b(k,219) * lu(k,1085) + b(k,213) = b(k,213) - lu(k,1084) * b(k,219) + b(k,207) = b(k,207) - lu(k,1083) * b(k,219) + b(k,205) = b(k,205) - lu(k,1082) * b(k,219) + b(k,181) = b(k,181) - lu(k,1081) * b(k,219) + b(k,218) = b(k,218) * lu(k,1064) + b(k,215) = b(k,215) - lu(k,1063) * b(k,218) + b(k,205) = b(k,205) - lu(k,1062) * b(k,218) + b(k,203) = b(k,203) - lu(k,1061) * b(k,218) + b(k,196) = b(k,196) - lu(k,1060) * b(k,218) + b(k,188) = b(k,188) - lu(k,1059) * b(k,218) + b(k,217) = b(k,217) * lu(k,1039) + b(k,216) = b(k,216) - lu(k,1038) * b(k,217) + b(k,215) = b(k,215) - lu(k,1037) * b(k,217) + b(k,213) = b(k,213) - lu(k,1036) * b(k,217) + b(k,212) = b(k,212) - lu(k,1035) * b(k,217) + b(k,211) = b(k,211) - lu(k,1034) * b(k,217) + b(k,210) = b(k,210) - lu(k,1033) * b(k,217) + b(k,203) = b(k,203) - lu(k,1032) * b(k,217) + b(k,156) = b(k,156) - lu(k,1031) * b(k,217) + b(k,116) = b(k,116) - lu(k,1030) * b(k,217) + b(k,71) = b(k,71) - lu(k,1029) * b(k,217) + b(k,68) = b(k,68) - lu(k,1028) * b(k,217) + b(k,67) = b(k,67) - lu(k,1027) * b(k,217) + b(k,66) = b(k,66) - lu(k,1026) * b(k,217) + b(k,65) = b(k,65) - lu(k,1025) * b(k,217) + b(k,64) = b(k,64) - lu(k,1024) * b(k,217) + b(k,216) = b(k,216) * lu(k,1016) + b(k,215) = b(k,215) * lu(k,1010) + b(k,203) = b(k,203) - lu(k,1009) * b(k,215) + b(k,214) = b(k,214) * lu(k,988) + b(k,213) = b(k,213) - lu(k,987) * b(k,214) + b(k,212) = b(k,212) - lu(k,986) * b(k,214) + b(k,211) = b(k,211) - lu(k,985) * b(k,214) + b(k,210) = b(k,210) - lu(k,984) * b(k,214) + b(k,203) = b(k,203) - lu(k,983) * b(k,214) + b(k,156) = b(k,156) - lu(k,982) * b(k,214) + b(k,116) = b(k,116) - lu(k,981) * b(k,214) + b(k,69) = b(k,69) - lu(k,980) * b(k,214) + b(k,68) = b(k,68) - lu(k,979) * b(k,214) + b(k,67) = b(k,67) - lu(k,978) * b(k,214) + b(k,66) = b(k,66) - lu(k,977) * b(k,214) + b(k,65) = b(k,65) - lu(k,976) * b(k,214) + b(k,64) = b(k,64) - lu(k,975) * b(k,214) + b(k,213) = b(k,213) * lu(k,970) + b(k,203) = b(k,203) - lu(k,969) * b(k,213) + b(k,64) = b(k,64) - lu(k,968) * b(k,213) + b(k,212) = b(k,212) * lu(k,962) + b(k,211) = b(k,211) * lu(k,952) + b(k,198) = b(k,198) - lu(k,951) * b(k,211) + b(k,182) = b(k,182) - lu(k,950) * b(k,211) + b(k,163) = b(k,163) - lu(k,949) * b(k,211) + b(k,210) = b(k,210) * lu(k,939) + b(k,202) = b(k,202) - lu(k,938) * b(k,210) + b(k,187) = b(k,187) - lu(k,937) * b(k,210) + b(k,186) = b(k,186) - lu(k,936) * b(k,210) + b(k,184) = b(k,184) - lu(k,935) * b(k,210) + b(k,166) = b(k,166) - lu(k,934) * b(k,210) + end do + end subroutine lu_slv10 + subroutine lu_slv11( 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,209) = b(k,209) * lu(k,924) + b(k,200) = b(k,200) - lu(k,923) * b(k,209) + b(k,102) = b(k,102) - lu(k,922) * b(k,209) + b(k,208) = b(k,208) * lu(k,913) + b(k,131) = b(k,131) - lu(k,912) * b(k,208) + b(k,207) = b(k,207) * lu(k,903) + b(k,206) = b(k,206) * lu(k,897) + b(k,123) = b(k,123) - lu(k,896) * b(k,206) + b(k,205) = b(k,205) * lu(k,890) + b(k,204) = b(k,204) * lu(k,874) + b(k,70) = b(k,70) - lu(k,873) * b(k,204) + b(k,68) = b(k,68) - lu(k,872) * b(k,204) + b(k,67) = b(k,67) - lu(k,871) * b(k,204) + b(k,203) = b(k,203) * lu(k,868) + b(k,202) = b(k,202) * lu(k,860) + b(k,198) = b(k,198) - lu(k,859) * b(k,202) + b(k,139) = b(k,139) - lu(k,858) * b(k,202) + b(k,124) = b(k,124) - lu(k,857) * b(k,202) + b(k,201) = b(k,201) * lu(k,849) + b(k,200) = b(k,200) * lu(k,842) + b(k,102) = b(k,102) - lu(k,841) * b(k,200) + b(k,199) = b(k,199) * lu(k,831) + b(k,147) = b(k,147) - lu(k,830) * b(k,199) + b(k,198) = b(k,198) * lu(k,826) + b(k,197) = b(k,197) * lu(k,818) + b(k,118) = b(k,118) - lu(k,817) * b(k,197) + b(k,196) = b(k,196) * lu(k,808) + b(k,172) = b(k,172) - lu(k,807) * b(k,196) + b(k,195) = b(k,195) * lu(k,799) + b(k,194) = b(k,194) * lu(k,788) + b(k,192) = b(k,192) - lu(k,787) * b(k,194) + b(k,190) = b(k,190) - lu(k,786) * b(k,194) + b(k,181) = b(k,181) - lu(k,785) * b(k,194) + b(k,159) = b(k,159) - lu(k,784) * b(k,194) + b(k,135) = b(k,135) - lu(k,783) * b(k,194) + b(k,127) = b(k,127) - lu(k,782) * b(k,194) + b(k,193) = b(k,193) * lu(k,772) + b(k,192) = b(k,192) - lu(k,771) * b(k,193) + b(k,181) = b(k,181) - lu(k,770) * b(k,193) + b(k,179) = b(k,179) - lu(k,769) * b(k,193) + b(k,159) = b(k,159) - lu(k,768) * b(k,193) + b(k,127) = b(k,127) - lu(k,767) * b(k,193) + b(k,192) = b(k,192) * lu(k,761) + b(k,191) = b(k,191) * lu(k,754) + b(k,126) = b(k,126) - lu(k,753) * b(k,191) + b(k,100) = b(k,100) - lu(k,752) * b(k,191) + b(k,190) = b(k,190) * lu(k,741) + b(k,181) = b(k,181) - lu(k,740) * b(k,190) + b(k,159) = b(k,159) - lu(k,739) * b(k,190) + b(k,135) = b(k,135) - lu(k,738) * b(k,190) + b(k,127) = b(k,127) - lu(k,737) * b(k,190) + b(k,189) = b(k,189) * lu(k,730) + b(k,94) = b(k,94) - lu(k,729) * b(k,189) + b(k,188) = b(k,188) * lu(k,724) + b(k,187) = b(k,187) * lu(k,717) + b(k,134) = b(k,134) - lu(k,716) * b(k,187) + b(k,186) = b(k,186) * lu(k,706) + b(k,166) = b(k,166) - lu(k,705) * b(k,186) + b(k,185) = b(k,185) * lu(k,695) + b(k,184) = b(k,184) * lu(k,685) + b(k,166) = b(k,166) - lu(k,684) * b(k,184) + b(k,183) = b(k,183) * lu(k,678) + b(k,161) = b(k,161) - lu(k,677) * b(k,183) + b(k,125) = b(k,125) - lu(k,676) * b(k,183) + b(k,182) = b(k,182) * lu(k,670) + b(k,181) = b(k,181) * lu(k,666) + b(k,180) = b(k,180) * lu(k,657) + b(k,179) = b(k,179) * lu(k,648) + b(k,159) = b(k,159) - lu(k,647) * b(k,179) + b(k,127) = b(k,127) - lu(k,646) * b(k,179) + b(k,178) = b(k,178) * lu(k,639) + b(k,177) = b(k,177) * lu(k,630) + b(k,176) = b(k,176) * lu(k,623) + b(k,175) = b(k,175) * lu(k,614) + b(k,174) = b(k,174) * lu(k,606) + b(k,173) = b(k,173) * lu(k,598) + b(k,172) = b(k,172) * lu(k,590) + b(k,171) = b(k,171) * lu(k,582) + b(k,170) = b(k,170) * lu(k,574) + b(k,169) = b(k,169) * lu(k,566) + b(k,168) = b(k,168) * lu(k,560) + b(k,167) = b(k,167) * lu(k,554) + b(k,95) = b(k,95) - lu(k,553) * b(k,167) + b(k,166) = b(k,166) * lu(k,548) + b(k,165) = b(k,165) * lu(k,541) + b(k,154) = b(k,154) - lu(k,540) * b(k,165) + b(k,164) = b(k,164) * lu(k,533) + b(k,159) = b(k,159) - lu(k,532) * b(k,164) + b(k,146) = b(k,146) - lu(k,531) * b(k,164) + b(k,163) = b(k,163) * lu(k,524) + b(k,162) = b(k,162) * lu(k,517) + b(k,161) = b(k,161) * lu(k,513) + b(k,160) = b(k,160) * lu(k,506) + b(k,106) = b(k,106) - lu(k,505) * b(k,160) + b(k,159) = b(k,159) * lu(k,502) + b(k,158) = b(k,158) * lu(k,496) + b(k,137) = b(k,137) - lu(k,495) * b(k,158) + b(k,157) = b(k,157) * lu(k,489) + b(k,156) = b(k,156) * lu(k,483) + b(k,155) = b(k,155) * lu(k,477) + b(k,138) = b(k,138) - lu(k,476) * b(k,155) + b(k,119) = b(k,119) - lu(k,475) * b(k,155) + b(k,154) = b(k,154) * lu(k,469) + b(k,153) = b(k,153) * lu(k,463) + b(k,152) = b(k,152) * lu(k,457) + b(k,151) = b(k,151) * lu(k,451) + b(k,150) = b(k,150) * lu(k,445) + b(k,149) = b(k,149) * lu(k,439) + b(k,148) = b(k,148) * lu(k,433) + b(k,147) = b(k,147) * lu(k,427) + b(k,146) = b(k,146) * lu(k,421) + b(k,145) = b(k,145) * lu(k,415) + b(k,144) = b(k,144) * lu(k,407) + b(k,143) = b(k,143) * lu(k,399) + b(k,142) = b(k,142) * lu(k,391) + b(k,141) = b(k,141) * lu(k,386) + b(k,140) = b(k,140) * lu(k,383) + b(k,139) = b(k,139) * lu(k,378) + b(k,138) = b(k,138) * lu(k,373) + b(k,119) = b(k,119) - lu(k,372) * b(k,138) + b(k,137) = b(k,137) * lu(k,367) + b(k,136) = b(k,136) * lu(k,362) + b(k,135) = b(k,135) * lu(k,357) + b(k,134) = b(k,134) * lu(k,352) + b(k,133) = b(k,133) * lu(k,346) + b(k,132) = b(k,132) * lu(k,340) + b(k,121) = b(k,121) - lu(k,339) * b(k,132) + b(k,131) = b(k,131) * lu(k,336) + b(k,130) = b(k,130) * lu(k,330) + b(k,129) = b(k,129) * lu(k,324) + b(k,128) = b(k,128) * lu(k,318) + b(k,127) = b(k,127) * lu(k,315) + b(k,126) = b(k,126) * lu(k,311) + b(k,125) = b(k,125) * lu(k,307) + b(k,124) = b(k,124) * lu(k,303) + b(k,123) = b(k,123) * lu(k,299) + b(k,101) = b(k,101) - lu(k,298) * b(k,123) + b(k,122) = b(k,122) * lu(k,293) + b(k,121) = b(k,121) * lu(k,290) + b(k,120) = b(k,120) * lu(k,285) + b(k,119) = b(k,119) * lu(k,282) + b(k,118) = b(k,118) * lu(k,279) + b(k,117) = b(k,117) * lu(k,276) + b(k,116) = b(k,116) * lu(k,273) + b(k,115) = b(k,115) * lu(k,269) + b(k,114) = b(k,114) * lu(k,264) + b(k,113) = b(k,113) * lu(k,259) + b(k,112) = b(k,112) * lu(k,251) + b(k,110) = b(k,110) - lu(k,250) * b(k,112) + b(k,83) = b(k,83) - lu(k,249) * b(k,112) + b(k,111) = b(k,111) * lu(k,246) + b(k,110) = b(k,110) * lu(k,242) + b(k,109) = b(k,109) * lu(k,237) + b(k,108) = b(k,108) * lu(k,230) + b(k,82) = b(k,82) - lu(k,229) * b(k,108) + b(k,107) = b(k,107) * lu(k,225) + b(k,106) = b(k,106) * lu(k,222) + b(k,105) = b(k,105) * lu(k,217) + b(k,104) = b(k,104) * lu(k,213) + b(k,103) = b(k,103) * lu(k,207) + b(k,79) = b(k,79) - lu(k,206) * b(k,103) + b(k,102) = b(k,102) * lu(k,204) + b(k,101) = b(k,101) * lu(k,201) + b(k,100) = b(k,100) * lu(k,198) + b(k,99) = b(k,99) * lu(k,193) + b(k,98) = b(k,98) * lu(k,188) + b(k,97) = b(k,97) * lu(k,183) + b(k,96) = b(k,96) * lu(k,178) + b(k,95) = b(k,95) * lu(k,175) + b(k,94) = b(k,94) * lu(k,172) + b(k,93) = b(k,93) * lu(k,168) + b(k,92) = b(k,92) * lu(k,164) + b(k,91) = b(k,91) * lu(k,160) + b(k,90) = b(k,90) * lu(k,156) + b(k,89) = b(k,89) * lu(k,152) + b(k,88) = b(k,88) * lu(k,148) + b(k,87) = b(k,87) * lu(k,145) + b(k,86) = b(k,86) * lu(k,142) + b(k,85) = b(k,85) * lu(k,139) + b(k,84) = b(k,84) * lu(k,136) + b(k,83) = b(k,83) * lu(k,135) + b(k,76) = b(k,76) - lu(k,134) * b(k,83) + b(k,75) = b(k,75) - lu(k,133) * b(k,83) + b(k,74) = b(k,74) - lu(k,132) * b(k,83) + b(k,73) = b(k,73) - lu(k,131) * b(k,83) + b(k,72) = b(k,72) - lu(k,130) * b(k,83) + b(k,82) = b(k,82) * lu(k,129) + b(k,76) = b(k,76) - lu(k,128) * b(k,82) + b(k,75) = b(k,75) - lu(k,127) * b(k,82) + b(k,74) = b(k,74) - lu(k,126) * b(k,82) + b(k,73) = b(k,73) - lu(k,125) * b(k,82) + b(k,72) = b(k,72) - lu(k,124) * b(k,82) + b(k,81) = b(k,81) * lu(k,123) + b(k,76) = b(k,76) - lu(k,122) * b(k,81) + b(k,75) = b(k,75) - lu(k,121) * b(k,81) + b(k,74) = b(k,74) - lu(k,120) * b(k,81) + b(k,73) = b(k,73) - lu(k,119) * b(k,81) + b(k,72) = b(k,72) - lu(k,118) * b(k,81) + b(k,80) = b(k,80) * lu(k,117) + b(k,61) = b(k,61) - lu(k,116) * b(k,80) + b(k,60) = b(k,60) - lu(k,115) * b(k,80) + b(k,59) = b(k,59) - lu(k,114) * b(k,80) + b(k,58) = b(k,58) - lu(k,113) * b(k,80) + b(k,57) = b(k,57) - lu(k,112) * b(k,80) + end do + end subroutine lu_slv11 + subroutine lu_slv12( 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,79) = b(k,79) * lu(k,111) + b(k,76) = b(k,76) - lu(k,110) * b(k,79) + b(k,75) = b(k,75) - lu(k,109) * b(k,79) + b(k,74) = b(k,74) - lu(k,108) * b(k,79) + b(k,73) = b(k,73) - lu(k,107) * b(k,79) + b(k,72) = b(k,72) - lu(k,106) * b(k,79) + b(k,78) = b(k,78) * lu(k,105) + b(k,77) = b(k,77) - lu(k,104) * b(k,78) + b(k,77) = b(k,77) * lu(k,103) + b(k,76) = b(k,76) - lu(k,102) * b(k,77) + b(k,75) = b(k,75) - lu(k,101) * b(k,77) + b(k,74) = b(k,74) - lu(k,100) * b(k,77) + b(k,73) = b(k,73) - lu(k,99) * b(k,77) + b(k,72) = b(k,72) - lu(k,98) * b(k,77) + b(k,76) = b(k,76) * lu(k,97) + b(k,75) = b(k,75) * lu(k,96) + b(k,74) = b(k,74) * lu(k,95) + b(k,73) = b(k,73) * lu(k,94) + b(k,72) = b(k,72) * lu(k,93) + b(k,71) = b(k,71) * lu(k,92) + b(k,68) = b(k,68) - lu(k,91) * b(k,71) + b(k,67) = b(k,67) - lu(k,90) * b(k,71) + b(k,66) = b(k,66) - lu(k,89) * b(k,71) + b(k,65) = b(k,65) - lu(k,88) * b(k,71) + b(k,64) = b(k,64) - lu(k,87) * b(k,71) + b(k,70) = b(k,70) * lu(k,86) + b(k,68) = b(k,68) - lu(k,85) * b(k,70) + b(k,67) = b(k,67) - lu(k,84) * b(k,70) + b(k,66) = b(k,66) - lu(k,83) * b(k,70) + b(k,65) = b(k,65) - lu(k,82) * b(k,70) + b(k,64) = b(k,64) - lu(k,81) * b(k,70) + b(k,69) = b(k,69) * lu(k,80) + b(k,68) = b(k,68) - lu(k,79) * b(k,69) + b(k,67) = b(k,67) - lu(k,78) * b(k,69) + b(k,66) = b(k,66) - lu(k,77) * b(k,69) + b(k,65) = b(k,65) - lu(k,76) * b(k,69) + b(k,64) = b(k,64) - lu(k,75) * b(k,69) + b(k,68) = b(k,68) * lu(k,74) + b(k,67) = b(k,67) * lu(k,73) + b(k,66) = b(k,66) * lu(k,72) + b(k,65) = b(k,65) * lu(k,71) + b(k,64) = b(k,64) * lu(k,70) + b(k,63) = b(k,63) * lu(k,69) + b(k,62) = b(k,62) - lu(k,68) * b(k,63) b(k,62) = b(k,62) * lu(k,67) - b(k,61) = b(k,61) * lu(k,66) - b(k,60) = b(k,60) * lu(k,65) - b(k,59) = b(k,59) * lu(k,64) - b(k,58) = b(k,58) * lu(k,63) - b(k,57) = b(k,57) * lu(k,62) - b(k,56) = b(k,56) * lu(k,61) - b(k,55) = b(k,55) - lu(k,60) * b(k,56) - b(k,54) = b(k,54) - lu(k,59) * b(k,56) - b(k,53) = b(k,53) - lu(k,58) * b(k,56) - b(k,52) = b(k,52) - lu(k,57) * b(k,56) - b(k,51) = b(k,51) - lu(k,56) * b(k,56) + b(k,61) = b(k,61) - lu(k,66) * b(k,62) + b(k,60) = b(k,60) - lu(k,65) * b(k,62) + b(k,59) = b(k,59) - lu(k,64) * b(k,62) + b(k,58) = b(k,58) - lu(k,63) * b(k,62) + b(k,57) = b(k,57) - lu(k,62) * b(k,62) + b(k,61) = b(k,61) * lu(k,61) + b(k,60) = b(k,60) * lu(k,60) + b(k,59) = b(k,59) * lu(k,59) + b(k,58) = b(k,58) * lu(k,58) + b(k,57) = b(k,57) * lu(k,57) + b(k,56) = b(k,56) * lu(k,56) b(k,55) = b(k,55) * lu(k,55) b(k,54) = b(k,54) * lu(k,54) b(k,53) = b(k,53) * lu(k,53) @@ -2264,26 +2582,6 @@ subroutine lu_slv10( avec_len, lu, b ) b(k,21) = b(k,21) * lu(k,21) b(k,20) = b(k,20) * lu(k,20) b(k,19) = b(k,19) * lu(k,19) - end do - end subroutine lu_slv10 - subroutine lu_slv11( 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,18) = b(k,18) * lu(k,18) b(k,17) = b(k,17) * lu(k,17) b(k,16) = b(k,16) * lu(k,16) @@ -2303,7 +2601,7 @@ subroutine lu_slv11( avec_len, lu, b ) b(k,2) = b(k,2) * lu(k,2) b(k,1) = b(k,1) * lu(k,1) end do - end subroutine lu_slv11 + end subroutine lu_slv12 subroutine lu_slv( avec_len, lu, b ) use shr_kind_mod, only : r8 => shr_kind_r8 use chem_mods, only : clscnt4, nzcnt @@ -2325,5 +2623,6 @@ subroutine lu_slv( avec_len, lu, b ) call lu_slv09( avec_len, lu, b ) call lu_slv10( avec_len, lu, b ) call lu_slv11( avec_len, lu, b ) + call lu_slv12( avec_len, lu, b ) end subroutine lu_slv end module mo_lu_solve diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_nln_matrix.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_nln_matrix.F90 index 682f29631b..26955a1193 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_nln_matrix.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_nln_matrix.F90 @@ -22,213 +22,258 @@ subroutine nlnmat01( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,566) = -(rxt(k,376)*y(k,243)) - mat(k,1638) = -rxt(k,376)*y(k,1) - mat(k,1354) = rxt(k,379)*y(k,220) - mat(k,849) = rxt(k,379)*y(k,123) - mat(k,577) = -(rxt(k,380)*y(k,243)) - mat(k,1639) = -rxt(k,380)*y(k,2) - mat(k,850) = rxt(k,377)*y(k,232) - mat(k,1466) = rxt(k,377)*y(k,220) - mat(k,831) = -(rxt(k,459)*y(k,125) + rxt(k,460)*y(k,133) + rxt(k,461) & - *y(k,243)) - mat(k,1785) = -rxt(k,459)*y(k,6) - mat(k,1898) = -rxt(k,460)*y(k,6) - mat(k,1662) = -rxt(k,461)*y(k,6) - mat(k,123) = -(rxt(k,418)*y(k,243)) - mat(k,1574) = -rxt(k,418)*y(k,7) - mat(k,346) = -(rxt(k,421)*y(k,243)) - mat(k,1608) = -rxt(k,421)*y(k,8) - mat(k,418) = rxt(k,419)*y(k,232) - mat(k,1445) = rxt(k,419)*y(k,221) - mat(k,124) = .120_r8*rxt(k,418)*y(k,243) - mat(k,1575) = .120_r8*rxt(k,418)*y(k,7) - mat(k,828) = .100_r8*rxt(k,460)*y(k,133) - mat(k,802) = .100_r8*rxt(k,463)*y(k,133) - mat(k,1886) = .100_r8*rxt(k,460)*y(k,6) + .100_r8*rxt(k,463)*y(k,111) - mat(k,1342) = .500_r8*rxt(k,420)*y(k,221) + .200_r8*rxt(k,447)*y(k,249) & - + .060_r8*rxt(k,453)*y(k,251) - mat(k,419) = .500_r8*rxt(k,420)*y(k,123) - mat(k,634) = .200_r8*rxt(k,447)*y(k,123) - mat(k,650) = .060_r8*rxt(k,453)*y(k,123) - mat(k,1335) = .200_r8*rxt(k,447)*y(k,249) + .200_r8*rxt(k,453)*y(k,251) - mat(k,633) = .200_r8*rxt(k,447)*y(k,123) - mat(k,648) = .200_r8*rxt(k,453)*y(k,123) - mat(k,1351) = .200_r8*rxt(k,447)*y(k,249) + .150_r8*rxt(k,453)*y(k,251) - mat(k,636) = .200_r8*rxt(k,447)*y(k,123) - mat(k,651) = .150_r8*rxt(k,453)*y(k,123) - mat(k,1336) = .210_r8*rxt(k,453)*y(k,251) - mat(k,649) = .210_r8*rxt(k,453)*y(k,123) - mat(k,194) = -(rxt(k,381)*y(k,243)) - mat(k,1586) = -rxt(k,381)*y(k,15) - mat(k,827) = .050_r8*rxt(k,460)*y(k,133) - mat(k,801) = .050_r8*rxt(k,463)*y(k,133) - mat(k,1885) = .050_r8*rxt(k,460)*y(k,6) + .050_r8*rxt(k,463)*y(k,111) - mat(k,294) = -(rxt(k,347)*y(k,125) + rxt(k,348)*y(k,243)) - mat(k,1778) = -rxt(k,347)*y(k,16) - mat(k,1601) = -rxt(k,348)*y(k,16) - mat(k,1294) = -(rxt(k,230)*y(k,42) + rxt(k,231)*y(k,232) + rxt(k,232) & - *y(k,133)) - mat(k,1714) = -rxt(k,230)*y(k,17) - mat(k,1508) = -rxt(k,231)*y(k,17) - mat(k,1922) = -rxt(k,232)*y(k,17) - mat(k,1946) = 4.000_r8*rxt(k,233)*y(k,19) + (rxt(k,234)+rxt(k,235))*y(k,59) & - + rxt(k,238)*y(k,123) + rxt(k,241)*y(k,132) + rxt(k,488) & - *y(k,151) + rxt(k,242)*y(k,243) - mat(k,1972) = (rxt(k,234)+rxt(k,235))*y(k,19) - mat(k,721) = rxt(k,243)*y(k,132) + rxt(k,249)*y(k,242) + rxt(k,244)*y(k,243) - mat(k,1392) = rxt(k,238)*y(k,19) - mat(k,2002) = rxt(k,241)*y(k,19) + rxt(k,243)*y(k,81) - mat(k,1128) = rxt(k,488)*y(k,19) - mat(k,1532) = rxt(k,249)*y(k,81) - mat(k,1691) = rxt(k,242)*y(k,19) + rxt(k,244)*y(k,81) - mat(k,1940) = rxt(k,236)*y(k,59) - mat(k,1966) = rxt(k,236)*y(k,19) - mat(k,1411) = (rxt(k,538)+rxt(k,543))*y(k,91) - mat(k,683) = (rxt(k,538)+rxt(k,543))*y(k,85) - mat(k,1959) = -(4._r8*rxt(k,233)*y(k,19) + (rxt(k,234) + rxt(k,235) + rxt(k,236) & - ) * y(k,59) + rxt(k,237)*y(k,232) + rxt(k,238)*y(k,123) & - + rxt(k,239)*y(k,124) + rxt(k,241)*y(k,132) + rxt(k,242) & - *y(k,243) + rxt(k,488)*y(k,151)) - mat(k,1985) = -(rxt(k,234) + rxt(k,235) + rxt(k,236)) * y(k,19) - mat(k,1521) = -rxt(k,237)*y(k,19) - mat(k,1405) = -rxt(k,238)*y(k,19) - mat(k,1768) = -rxt(k,239)*y(k,19) - mat(k,2015) = -rxt(k,241)*y(k,19) - mat(k,1704) = -rxt(k,242)*y(k,19) - mat(k,1135) = -rxt(k,488)*y(k,19) - mat(k,1301) = rxt(k,232)*y(k,133) - mat(k,509) = rxt(k,240)*y(k,132) - mat(k,725) = rxt(k,250)*y(k,242) - mat(k,688) = rxt(k,245)*y(k,132) - mat(k,2015) = mat(k,2015) + rxt(k,240)*y(k,20) + rxt(k,245)*y(k,91) - mat(k,1935) = rxt(k,232)*y(k,17) - mat(k,1545) = rxt(k,250)*y(k,81) - mat(k,503) = -(rxt(k,240)*y(k,132)) - mat(k,1992) = -rxt(k,240)*y(k,20) - mat(k,1942) = rxt(k,239)*y(k,124) - mat(k,1740) = rxt(k,239)*y(k,19) - mat(k,200) = -(rxt(k,422)*y(k,243)) - mat(k,1587) = -rxt(k,422)*y(k,22) - mat(k,1333) = rxt(k,425)*y(k,222) - mat(k,376) = rxt(k,425)*y(k,123) - mat(k,271) = -(rxt(k,424)*y(k,243)) - mat(k,1596) = -rxt(k,424)*y(k,23) - mat(k,377) = rxt(k,423)*y(k,232) - mat(k,1437) = rxt(k,423)*y(k,222) - mat(k,237) = -(rxt(k,296)*y(k,56) + rxt(k,297)*y(k,243)) - mat(k,2021) = -rxt(k,296)*y(k,24) - mat(k,1592) = -rxt(k,297)*y(k,24) - mat(k,487) = -(rxt(k,298)*y(k,56) + rxt(k,299)*y(k,133) + rxt(k,324)*y(k,243)) - mat(k,2023) = -rxt(k,298)*y(k,25) - mat(k,1890) = -rxt(k,299)*y(k,25) - mat(k,1629) = -rxt(k,324)*y(k,25) - mat(k,216) = -(rxt(k,304)*y(k,243)) - mat(k,1590) = -rxt(k,304)*y(k,26) - mat(k,736) = .800_r8*rxt(k,300)*y(k,223) + .200_r8*rxt(k,301)*y(k,227) - mat(k,1830) = .200_r8*rxt(k,301)*y(k,223) - mat(k,276) = -(rxt(k,305)*y(k,243)) - mat(k,1597) = -rxt(k,305)*y(k,27) - mat(k,737) = rxt(k,302)*y(k,232) - mat(k,1438) = rxt(k,302)*y(k,223) - mat(k,243) = -(rxt(k,306)*y(k,56) + rxt(k,307)*y(k,243)) - mat(k,2022) = -rxt(k,306)*y(k,28) - mat(k,1593) = -rxt(k,307)*y(k,28) - mat(k,893) = -(rxt(k,327)*y(k,125) + rxt(k,328)*y(k,133) + rxt(k,345) & - *y(k,243)) - mat(k,1789) = -rxt(k,327)*y(k,29) - mat(k,1902) = -rxt(k,328)*y(k,29) - mat(k,1667) = -rxt(k,345)*y(k,29) - mat(k,767) = .130_r8*rxt(k,405)*y(k,133) - mat(k,1902) = mat(k,1902) + .130_r8*rxt(k,405)*y(k,98) - mat(k,340) = -(rxt(k,332)*y(k,243)) - mat(k,1607) = -rxt(k,332)*y(k,30) - mat(k,709) = rxt(k,330)*y(k,232) - mat(k,1444) = rxt(k,330)*y(k,224) - mat(k,99) = -(rxt(k,333)*y(k,243)) - mat(k,1571) = -rxt(k,333)*y(k,31) - mat(k,220) = -(rxt(k,428)*y(k,243)) - mat(k,1591) = -rxt(k,428)*y(k,32) - mat(k,557) = rxt(k,426)*y(k,232) - mat(k,1434) = rxt(k,426)*y(k,225) - mat(k,1722) = -(rxt(k,194)*y(k,56) + rxt(k,230)*y(k,17) + rxt(k,274)*y(k,232) & - + rxt(k,275)*y(k,125) + rxt(k,276)*y(k,132) + rxt(k,277) & - *y(k,243)) - mat(k,2044) = -rxt(k,194)*y(k,42) - mat(k,1299) = -rxt(k,230)*y(k,42) - mat(k,1516) = -rxt(k,274)*y(k,42) - mat(k,1820) = -rxt(k,275)*y(k,42) - mat(k,2010) = -rxt(k,276)*y(k,42) - mat(k,1699) = -rxt(k,277)*y(k,42) - mat(k,574) = .400_r8*rxt(k,376)*y(k,243) - mat(k,844) = .340_r8*rxt(k,460)*y(k,133) - mat(k,299) = .500_r8*rxt(k,347)*y(k,125) - mat(k,493) = rxt(k,299)*y(k,133) - mat(k,902) = .500_r8*rxt(k,328)*y(k,133) - mat(k,438) = .500_r8*rxt(k,316)*y(k,243) - mat(k,704) = rxt(k,282)*y(k,243) - mat(k,355) = .300_r8*rxt(k,283)*y(k,243) - mat(k,1980) = rxt(k,201)*y(k,227) - mat(k,928) = .800_r8*rxt(k,321)*y(k,243) - mat(k,777) = .910_r8*rxt(k,405)*y(k,133) - mat(k,518) = .300_r8*rxt(k,396)*y(k,243) - mat(k,1098) = .800_r8*rxt(k,400)*y(k,227) - mat(k,1112) = .120_r8*rxt(k,358)*y(k,133) - mat(k,484) = .500_r8*rxt(k,371)*y(k,243) - mat(k,818) = .340_r8*rxt(k,463)*y(k,133) - mat(k,1182) = .600_r8*rxt(k,372)*y(k,133) - mat(k,1400) = .100_r8*rxt(k,378)*y(k,220) + rxt(k,281)*y(k,227) & - + .500_r8*rxt(k,349)*y(k,229) + .500_r8*rxt(k,318)*y(k,231) & - + .920_r8*rxt(k,388)*y(k,234) + .250_r8*rxt(k,356)*y(k,236) & - + rxt(k,365)*y(k,238) + rxt(k,339)*y(k,245) + rxt(k,343) & - *y(k,246) + .340_r8*rxt(k,472)*y(k,247) + .320_r8*rxt(k,477) & - *y(k,248) + .250_r8*rxt(k,413)*y(k,250) - mat(k,1820) = mat(k,1820) + .500_r8*rxt(k,347)*y(k,16) + rxt(k,389)*y(k,234) & - + .250_r8*rxt(k,355)*y(k,236) + rxt(k,366)*y(k,238) - mat(k,1930) = .340_r8*rxt(k,460)*y(k,6) + rxt(k,299)*y(k,25) & - + .500_r8*rxt(k,328)*y(k,29) + .910_r8*rxt(k,405)*y(k,98) & - + .120_r8*rxt(k,358)*y(k,106) + .340_r8*rxt(k,463)*y(k,111) & - + .600_r8*rxt(k,372)*y(k,112) - mat(k,407) = rxt(k,323)*y(k,243) - mat(k,952) = .680_r8*rxt(k,481)*y(k,243) - mat(k,860) = .100_r8*rxt(k,378)*y(k,123) - mat(k,744) = .700_r8*rxt(k,301)*y(k,227) - mat(k,716) = rxt(k,329)*y(k,227) - mat(k,1286) = rxt(k,312)*y(k,227) + rxt(k,385)*y(k,234) + .250_r8*rxt(k,352) & - *y(k,236) + rxt(k,361)*y(k,238) + .250_r8*rxt(k,410)*y(k,250) - mat(k,1870) = rxt(k,201)*y(k,59) + .800_r8*rxt(k,400)*y(k,101) + rxt(k,281) & - *y(k,123) + .700_r8*rxt(k,301)*y(k,223) + rxt(k,329)*y(k,224) & - + rxt(k,312)*y(k,226) + (4.000_r8*rxt(k,278)+2.000_r8*rxt(k,279)) & - *y(k,227) + 1.500_r8*rxt(k,386)*y(k,234) + .750_r8*rxt(k,391) & - *y(k,235) + .880_r8*rxt(k,353)*y(k,236) + 2.000_r8*rxt(k,362) & - *y(k,238) + .750_r8*rxt(k,465)*y(k,241) + .800_r8*rxt(k,341) & - *y(k,246) + .930_r8*rxt(k,470)*y(k,247) + .950_r8*rxt(k,475) & - *y(k,248) + .800_r8*rxt(k,411)*y(k,250) - mat(k,501) = .500_r8*rxt(k,349)*y(k,123) - mat(k,625) = .500_r8*rxt(k,318)*y(k,123) - mat(k,1516) = mat(k,1516) + .450_r8*rxt(k,363)*y(k,238) + .150_r8*rxt(k,342) & - *y(k,246) - mat(k,1162) = .920_r8*rxt(k,388)*y(k,123) + rxt(k,389)*y(k,125) + rxt(k,385) & - *y(k,226) + 1.500_r8*rxt(k,386)*y(k,227) - mat(k,1238) = .750_r8*rxt(k,391)*y(k,227) - mat(k,1205) = .250_r8*rxt(k,356)*y(k,123) + .250_r8*rxt(k,355)*y(k,125) & - + .250_r8*rxt(k,352)*y(k,226) + .880_r8*rxt(k,353)*y(k,227) - mat(k,1256) = rxt(k,365)*y(k,123) + rxt(k,366)*y(k,125) + rxt(k,361)*y(k,226) & - + 2.000_r8*rxt(k,362)*y(k,227) + .450_r8*rxt(k,363)*y(k,232) & - + 4.000_r8*rxt(k,364)*y(k,238) - mat(k,1021) = .750_r8*rxt(k,465)*y(k,227) - mat(k,1699) = mat(k,1699) + .400_r8*rxt(k,376)*y(k,1) + .500_r8*rxt(k,316) & - *y(k,51) + rxt(k,282)*y(k,52) + .300_r8*rxt(k,283)*y(k,53) & - + .800_r8*rxt(k,321)*y(k,74) + .300_r8*rxt(k,396)*y(k,99) & - + .500_r8*rxt(k,371)*y(k,110) + rxt(k,323)*y(k,138) & - + .680_r8*rxt(k,481)*y(k,209) - mat(k,680) = rxt(k,339)*y(k,123) - mat(k,1035) = rxt(k,343)*y(k,123) + .800_r8*rxt(k,341)*y(k,227) & - + .150_r8*rxt(k,342)*y(k,232) - mat(k,1002) = .340_r8*rxt(k,472)*y(k,123) + .930_r8*rxt(k,470)*y(k,227) - mat(k,982) = .320_r8*rxt(k,477)*y(k,123) + .950_r8*rxt(k,475)*y(k,227) - mat(k,1075) = .250_r8*rxt(k,413)*y(k,123) + .250_r8*rxt(k,410)*y(k,226) & - + .800_r8*rxt(k,411)*y(k,227) + mat(k,685) = -(rxt(k,375)*y(k,251)) + mat(k,1853) = -rxt(k,375)*y(k,1) + mat(k,1561) = rxt(k,378)*y(k,228) + mat(k,935) = rxt(k,378)*y(k,129) + mat(k,706) = -(rxt(k,379)*y(k,251)) + mat(k,1855) = -rxt(k,379)*y(k,2) + mat(k,936) = rxt(k,376)*y(k,240) + mat(k,2168) = rxt(k,376)*y(k,228) + mat(k,988) = -(rxt(k,458)*y(k,131) + rxt(k,459)*y(k,139) + rxt(k,460) & + *y(k,251)) + mat(k,2043) = -rxt(k,458)*y(k,6) + mat(k,2289) = -rxt(k,459)*y(k,6) + mat(k,1882) = -rxt(k,460)*y(k,6) + mat(k,80) = -(rxt(k,513)*y(k,240) + rxt(k,514)*y(k,129)) + mat(k,2123) = -rxt(k,513)*y(k,7) + mat(k,1527) = -rxt(k,514)*y(k,7) + mat(k,980) = rxt(k,516)*y(k,251) + mat(k,1763) = rxt(k,516)*y(k,6) + mat(k,207) = -(rxt(k,417)*y(k,251)) + mat(k,1783) = -rxt(k,417)*y(k,8) + mat(k,111) = -(rxt(k,518)*y(k,240) + rxt(k,519)*y(k,129)) + mat(k,2132) = -rxt(k,518)*y(k,9) + mat(k,1536) = -rxt(k,519)*y(k,9) + mat(k,206) = rxt(k,517)*y(k,251) + mat(k,1773) = rxt(k,517)*y(k,8) + mat(k,421) = -(rxt(k,420)*y(k,251)) + mat(k,1818) = -rxt(k,420)*y(k,10) + mat(k,531) = rxt(k,418)*y(k,240) + mat(k,2145) = rxt(k,418)*y(k,229) + mat(k,208) = .120_r8*rxt(k,417)*y(k,251) + mat(k,1784) = .120_r8*rxt(k,417)*y(k,8) + mat(k,982) = .100_r8*rxt(k,459)*y(k,139) + mat(k,1031) = .100_r8*rxt(k,462)*y(k,139) + mat(k,2276) = .100_r8*rxt(k,459)*y(k,6) + .100_r8*rxt(k,462)*y(k,116) + mat(k,1548) = .500_r8*rxt(k,419)*y(k,229) + .200_r8*rxt(k,446)*y(k,257) & + + .060_r8*rxt(k,452)*y(k,259) + mat(k,532) = .500_r8*rxt(k,419)*y(k,129) + mat(k,768) = .200_r8*rxt(k,446)*y(k,129) + mat(k,784) = .060_r8*rxt(k,452)*y(k,129) + mat(k,1542) = .200_r8*rxt(k,446)*y(k,257) + .200_r8*rxt(k,452)*y(k,259) + mat(k,767) = .200_r8*rxt(k,446)*y(k,129) + mat(k,782) = .200_r8*rxt(k,452)*y(k,129) + mat(k,1558) = .200_r8*rxt(k,446)*y(k,257) + .150_r8*rxt(k,452)*y(k,259) + mat(k,770) = .200_r8*rxt(k,446)*y(k,129) + mat(k,785) = .150_r8*rxt(k,452)*y(k,129) + mat(k,1543) = .210_r8*rxt(k,452)*y(k,259) + mat(k,783) = .210_r8*rxt(k,452)*y(k,129) + mat(k,273) = -(rxt(k,380)*y(k,251)) + mat(k,1795) = -rxt(k,380)*y(k,17) + mat(k,981) = .050_r8*rxt(k,459)*y(k,139) + mat(k,1030) = .050_r8*rxt(k,462)*y(k,139) + mat(k,2275) = .050_r8*rxt(k,459)*y(k,6) + .050_r8*rxt(k,462)*y(k,116) + mat(k,399) = -(rxt(k,346)*y(k,131) + rxt(k,347)*y(k,251)) + mat(k,2036) = -rxt(k,346)*y(k,18) + mat(k,1815) = -rxt(k,347)*y(k,18) + mat(k,1455) = -(rxt(k,230)*y(k,44) + rxt(k,231)*y(k,240) + rxt(k,232) & + *y(k,139)) + mat(k,2012) = -rxt(k,230)*y(k,19) + mat(k,2212) = -rxt(k,231)*y(k,19) + mat(k,2312) = -rxt(k,232)*y(k,19) + mat(k,2094) = 4.000_r8*rxt(k,233)*y(k,21) + (rxt(k,234)+rxt(k,235))*y(k,61) & + + rxt(k,238)*y(k,129) + rxt(k,241)*y(k,138) + rxt(k,488) & + *y(k,157) + rxt(k,242)*y(k,251) + mat(k,180) = rxt(k,220)*y(k,250) + mat(k,186) = rxt(k,246)*y(k,250) + mat(k,518) = 2.000_r8*rxt(k,257)*y(k,58) + 2.000_r8*rxt(k,269)*y(k,250) & + + 2.000_r8*rxt(k,258)*y(k,251) + mat(k,615) = rxt(k,259)*y(k,58) + rxt(k,270)*y(k,250) + rxt(k,260)*y(k,251) + mat(k,458) = 3.000_r8*rxt(k,264)*y(k,58) + 3.000_r8*rxt(k,247)*y(k,250) & + + 3.000_r8*rxt(k,265)*y(k,251) + mat(k,2251) = 2.000_r8*rxt(k,257)*y(k,43) + rxt(k,259)*y(k,45) & + + 3.000_r8*rxt(k,264)*y(k,57) + mat(k,1936) = (rxt(k,234)+rxt(k,235))*y(k,21) + mat(k,170) = 2.000_r8*rxt(k,248)*y(k,250) + mat(k,850) = rxt(k,243)*y(k,138) + rxt(k,249)*y(k,250) + rxt(k,244)*y(k,251) + mat(k,1600) = rxt(k,238)*y(k,21) + mat(k,1988) = rxt(k,241)*y(k,21) + rxt(k,243)*y(k,83) + mat(k,1273) = rxt(k,488)*y(k,21) + mat(k,1737) = rxt(k,220)*y(k,36) + rxt(k,246)*y(k,37) + 2.000_r8*rxt(k,269) & + *y(k,43) + rxt(k,270)*y(k,45) + 3.000_r8*rxt(k,247)*y(k,57) & + + 2.000_r8*rxt(k,248)*y(k,80) + rxt(k,249)*y(k,83) + mat(k,1909) = rxt(k,242)*y(k,21) + 2.000_r8*rxt(k,258)*y(k,43) + rxt(k,260) & + *y(k,45) + 3.000_r8*rxt(k,265)*y(k,57) + rxt(k,244)*y(k,83) + mat(k,2088) = rxt(k,236)*y(k,61) + mat(k,1930) = rxt(k,236)*y(k,21) + mat(k,1955) = (rxt(k,553)+rxt(k,558))*y(k,93) + mat(k,817) = (rxt(k,553)+rxt(k,558))*y(k,87) + mat(k,2107) = -(4._r8*rxt(k,233)*y(k,21) + (rxt(k,234) + rxt(k,235) + rxt(k,236) & + ) * y(k,61) + rxt(k,237)*y(k,240) + rxt(k,238)*y(k,129) & + + rxt(k,239)*y(k,130) + rxt(k,241)*y(k,138) + rxt(k,242) & + *y(k,251) + rxt(k,488)*y(k,157)) + mat(k,1949) = -(rxt(k,234) + rxt(k,235) + rxt(k,236)) * y(k,21) + mat(k,2226) = -rxt(k,237)*y(k,21) + mat(k,1614) = -rxt(k,238)*y(k,21) + mat(k,1710) = -rxt(k,239)*y(k,21) + mat(k,2002) = -rxt(k,241)*y(k,21) + mat(k,1923) = -rxt(k,242)*y(k,21) + mat(k,1280) = -rxt(k,488)*y(k,21) + mat(k,1461) = rxt(k,232)*y(k,139) + mat(k,581) = rxt(k,240)*y(k,138) + mat(k,855) = rxt(k,250)*y(k,250) + mat(k,823) = rxt(k,245)*y(k,138) + mat(k,2002) = mat(k,2002) + rxt(k,240)*y(k,22) + rxt(k,245)*y(k,93) + mat(k,2326) = rxt(k,232)*y(k,19) + mat(k,1751) = rxt(k,250)*y(k,83) + mat(k,574) = -(rxt(k,240)*y(k,138)) + mat(k,1978) = -rxt(k,240)*y(k,22) + mat(k,2090) = rxt(k,239)*y(k,130) + mat(k,1679) = rxt(k,239)*y(k,21) + mat(k,282) = -(rxt(k,421)*y(k,251)) + mat(k,1797) = -rxt(k,421)*y(k,24) + mat(k,1540) = rxt(k,424)*y(k,230) + mat(k,475) = rxt(k,424)*y(k,129) + mat(k,373) = -(rxt(k,423)*y(k,251)) + mat(k,1810) = -rxt(k,423)*y(k,25) + mat(k,476) = rxt(k,422)*y(k,240) + mat(k,2141) = rxt(k,422)*y(k,230) + mat(k,324) = -(rxt(k,295)*y(k,58) + rxt(k,296)*y(k,251)) + mat(k,2232) = -rxt(k,295)*y(k,26) + mat(k,1805) = -rxt(k,296)*y(k,26) + mat(k,598) = -(rxt(k,297)*y(k,58) + rxt(k,298)*y(k,139) + rxt(k,323)*y(k,251)) + mat(k,2237) = -rxt(k,297)*y(k,27) + mat(k,2279) = -rxt(k,298)*y(k,27) + mat(k,1842) = -rxt(k,323)*y(k,27) + mat(k,303) = -(rxt(k,303)*y(k,251)) + mat(k,1802) = -rxt(k,303)*y(k,28) + mat(k,857) = .800_r8*rxt(k,299)*y(k,231) + .200_r8*rxt(k,300)*y(k,235) + mat(k,1619) = .200_r8*rxt(k,300)*y(k,231) + mat(k,378) = -(rxt(k,304)*y(k,251)) + mat(k,1811) = -rxt(k,304)*y(k,29) + mat(k,858) = rxt(k,301)*y(k,240) + mat(k,2142) = rxt(k,301)*y(k,231) + mat(k,330) = -(rxt(k,305)*y(k,58) + rxt(k,306)*y(k,251)) + mat(k,2233) = -rxt(k,305)*y(k,30) + mat(k,1806) = -rxt(k,306)*y(k,30) + mat(k,1064) = -(rxt(k,326)*y(k,131) + rxt(k,327)*y(k,139) + rxt(k,344) & + *y(k,251)) + mat(k,2047) = -rxt(k,326)*y(k,31) + mat(k,2293) = -rxt(k,327)*y(k,31) + mat(k,1886) = -rxt(k,344)*y(k,31) + mat(k,876) = .130_r8*rxt(k,404)*y(k,139) + mat(k,2293) = mat(k,2293) + .130_r8*rxt(k,404)*y(k,100) + mat(k,427) = -(rxt(k,331)*y(k,251)) + mat(k,1819) = -rxt(k,331)*y(k,32) + mat(k,830) = rxt(k,329)*y(k,240) + mat(k,2146) = rxt(k,329)*y(k,232) + mat(k,148) = -(rxt(k,332)*y(k,251)) + mat(k,1780) = -rxt(k,332)*y(k,33) + mat(k,307) = -(rxt(k,427)*y(k,251)) + mat(k,1803) = -rxt(k,427)*y(k,34) + mat(k,676) = rxt(k,425)*y(k,240) + mat(k,2137) = rxt(k,425)*y(k,233) + mat(k,139) = -(rxt(k,219)*y(k,250)) + mat(k,1715) = -rxt(k,219)*y(k,35) + mat(k,178) = -(rxt(k,220)*y(k,250)) + mat(k,1720) = -rxt(k,220)*y(k,36) + mat(k,183) = -(rxt(k,246)*y(k,250)) + mat(k,1721) = -rxt(k,246)*y(k,37) + mat(k,152) = -(rxt(k,221)*y(k,250)) + mat(k,1716) = -rxt(k,221)*y(k,38) + mat(k,188) = -(rxt(k,222)*y(k,250)) + mat(k,1722) = -rxt(k,222)*y(k,39) + mat(k,156) = -(rxt(k,223)*y(k,250)) + mat(k,1717) = -rxt(k,223)*y(k,40) + mat(k,193) = -(rxt(k,224)*y(k,250)) + mat(k,1723) = -rxt(k,224)*y(k,41) + mat(k,160) = -(rxt(k,225)*y(k,250)) + mat(k,1718) = -rxt(k,225)*y(k,42) + mat(k,517) = -(rxt(k,257)*y(k,58) + rxt(k,258)*y(k,251) + rxt(k,269)*y(k,250)) + mat(k,2236) = -rxt(k,257)*y(k,43) + mat(k,1832) = -rxt(k,258)*y(k,43) + mat(k,1732) = -rxt(k,269)*y(k,43) + mat(k,2024) = -(rxt(k,194)*y(k,58) + rxt(k,230)*y(k,19) + rxt(k,274)*y(k,240) & + + rxt(k,275)*y(k,131) + rxt(k,276)*y(k,138) + rxt(k,277) & + *y(k,251)) + mat(k,2263) = -rxt(k,194)*y(k,44) + mat(k,1460) = -rxt(k,230)*y(k,44) + mat(k,2224) = -rxt(k,274)*y(k,44) + mat(k,2081) = -rxt(k,275)*y(k,44) + mat(k,2000) = -rxt(k,276)*y(k,44) + mat(k,1921) = -rxt(k,277)*y(k,44) + mat(k,693) = .400_r8*rxt(k,375)*y(k,251) + mat(k,1004) = .340_r8*rxt(k,459)*y(k,139) + mat(k,405) = .500_r8*rxt(k,346)*y(k,131) + mat(k,603) = rxt(k,298)*y(k,139) + mat(k,1076) = .500_r8*rxt(k,327)*y(k,139) + mat(k,628) = .500_r8*rxt(k,315)*y(k,251) + mat(k,828) = rxt(k,282)*y(k,251) + mat(k,455) = .300_r8*rxt(k,283)*y(k,251) + mat(k,1478) = (rxt(k,291)+rxt(k,292))*y(k,250) + mat(k,1947) = rxt(k,201)*y(k,235) + mat(k,1145) = .800_r8*rxt(k,320)*y(k,251) + mat(k,886) = .910_r8*rxt(k,404)*y(k,139) + mat(k,664) = .300_r8*rxt(k,395)*y(k,251) + mat(k,1244) = .800_r8*rxt(k,399)*y(k,235) + mat(k,1256) = .120_r8*rxt(k,357)*y(k,139) + mat(k,636) = .500_r8*rxt(k,370)*y(k,251) + mat(k,1054) = .340_r8*rxt(k,462)*y(k,139) + mat(k,1382) = .600_r8*rxt(k,371)*y(k,139) + mat(k,1612) = .100_r8*rxt(k,377)*y(k,228) + rxt(k,281)*y(k,235) & + + .500_r8*rxt(k,348)*y(k,237) + .500_r8*rxt(k,317)*y(k,239) & + + .920_r8*rxt(k,387)*y(k,242) + .250_r8*rxt(k,355)*y(k,244) & + + rxt(k,364)*y(k,246) + rxt(k,338)*y(k,253) + rxt(k,342) & + *y(k,254) + .340_r8*rxt(k,471)*y(k,255) + .320_r8*rxt(k,476) & + *y(k,256) + .250_r8*rxt(k,412)*y(k,258) + mat(k,2081) = mat(k,2081) + .500_r8*rxt(k,346)*y(k,18) + rxt(k,388)*y(k,242) & + + .250_r8*rxt(k,354)*y(k,244) + rxt(k,365)*y(k,246) + mat(k,2324) = .340_r8*rxt(k,459)*y(k,6) + rxt(k,298)*y(k,27) & + + .500_r8*rxt(k,327)*y(k,31) + .910_r8*rxt(k,404)*y(k,100) & + + .120_r8*rxt(k,357)*y(k,111) + .340_r8*rxt(k,462)*y(k,116) & + + .600_r8*rxt(k,371)*y(k,118) + mat(k,572) = rxt(k,322)*y(k,251) + mat(k,1122) = .680_r8*rxt(k,480)*y(k,251) + mat(k,947) = .100_r8*rxt(k,377)*y(k,129) + mat(k,866) = .700_r8*rxt(k,300)*y(k,235) + mat(k,838) = rxt(k,328)*y(k,235) + mat(k,1434) = rxt(k,311)*y(k,235) + rxt(k,384)*y(k,242) + .250_r8*rxt(k,351) & + *y(k,244) + rxt(k,360)*y(k,246) + .250_r8*rxt(k,409)*y(k,258) + mat(k,1664) = rxt(k,201)*y(k,61) + .800_r8*rxt(k,399)*y(k,103) + rxt(k,281) & + *y(k,129) + .700_r8*rxt(k,300)*y(k,231) + rxt(k,328)*y(k,232) & + + rxt(k,311)*y(k,234) + (4.000_r8*rxt(k,278)+2.000_r8*rxt(k,279)) & + *y(k,235) + 1.500_r8*rxt(k,385)*y(k,242) + .750_r8*rxt(k,390) & + *y(k,243) + .880_r8*rxt(k,352)*y(k,244) + 2.000_r8*rxt(k,361) & + *y(k,246) + .750_r8*rxt(k,464)*y(k,249) + .800_r8*rxt(k,340) & + *y(k,254) + .930_r8*rxt(k,469)*y(k,255) + .950_r8*rxt(k,474) & + *y(k,256) + .800_r8*rxt(k,410)*y(k,258) + mat(k,612) = .500_r8*rxt(k,348)*y(k,129) + mat(k,759) = .500_r8*rxt(k,317)*y(k,129) + mat(k,2224) = mat(k,2224) + .450_r8*rxt(k,362)*y(k,246) + .150_r8*rxt(k,341) & + *y(k,254) + mat(k,1307) = .920_r8*rxt(k,387)*y(k,129) + rxt(k,388)*y(k,131) + rxt(k,384) & + *y(k,234) + 1.500_r8*rxt(k,385)*y(k,235) + mat(k,1339) = .750_r8*rxt(k,390)*y(k,235) + mat(k,1360) = .250_r8*rxt(k,355)*y(k,129) + .250_r8*rxt(k,354)*y(k,131) & + + .250_r8*rxt(k,351)*y(k,234) + .880_r8*rxt(k,352)*y(k,235) + mat(k,1402) = rxt(k,364)*y(k,129) + rxt(k,365)*y(k,131) + rxt(k,360)*y(k,234) & + + 2.000_r8*rxt(k,361)*y(k,235) + .450_r8*rxt(k,362)*y(k,240) & + + 4.000_r8*rxt(k,363)*y(k,246) + mat(k,1110) = .750_r8*rxt(k,464)*y(k,235) + mat(k,1749) = (rxt(k,291)+rxt(k,292))*y(k,56) + mat(k,1921) = mat(k,1921) + .400_r8*rxt(k,375)*y(k,1) + .500_r8*rxt(k,315) & + *y(k,53) + rxt(k,282)*y(k,54) + .300_r8*rxt(k,283)*y(k,55) & + + .800_r8*rxt(k,320)*y(k,76) + .300_r8*rxt(k,395)*y(k,101) & + + .500_r8*rxt(k,370)*y(k,115) + rxt(k,322)*y(k,144) & + + .680_r8*rxt(k,480)*y(k,215) + mat(k,814) = rxt(k,338)*y(k,129) + mat(k,1177) = rxt(k,342)*y(k,129) + .800_r8*rxt(k,340)*y(k,235) & + + .150_r8*rxt(k,341)*y(k,240) + mat(k,1164) = .340_r8*rxt(k,471)*y(k,129) + .930_r8*rxt(k,469)*y(k,235) + mat(k,960) = .320_r8*rxt(k,476)*y(k,129) + .950_r8*rxt(k,474)*y(k,235) + mat(k,1221) = .250_r8*rxt(k,412)*y(k,129) + .250_r8*rxt(k,409)*y(k,234) & + + .800_r8*rxt(k,410)*y(k,235) end do end subroutine nlnmat01 subroutine nlnmat02( avec_len, mat, y, rxt ) @@ -249,226 +294,221 @@ subroutine nlnmat02( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,1040) = -(rxt(k,308)*y(k,125) + rxt(k,309)*y(k,243)) - mat(k,1800) = -rxt(k,308)*y(k,45) - mat(k,1678) = -rxt(k,309)*y(k,45) - mat(k,570) = .800_r8*rxt(k,376)*y(k,243) - mat(k,297) = rxt(k,347)*y(k,125) - mat(k,217) = rxt(k,304)*y(k,243) - mat(k,278) = .500_r8*rxt(k,305)*y(k,243) - mat(k,896) = .500_r8*rxt(k,328)*y(k,133) - mat(k,1172) = .100_r8*rxt(k,372)*y(k,133) - mat(k,1381) = .400_r8*rxt(k,378)*y(k,220) + rxt(k,303)*y(k,223) & - + .270_r8*rxt(k,331)*y(k,224) + rxt(k,349)*y(k,229) + rxt(k,368) & - *y(k,240) + rxt(k,339)*y(k,245) - mat(k,1800) = mat(k,1800) + rxt(k,347)*y(k,16) - mat(k,1911) = .500_r8*rxt(k,328)*y(k,29) + .100_r8*rxt(k,372)*y(k,112) - mat(k,855) = .400_r8*rxt(k,378)*y(k,123) - mat(k,740) = rxt(k,303)*y(k,123) + 3.200_r8*rxt(k,300)*y(k,223) & - + .800_r8*rxt(k,301)*y(k,227) - mat(k,712) = .270_r8*rxt(k,331)*y(k,123) - mat(k,1852) = .800_r8*rxt(k,301)*y(k,223) - mat(k,498) = rxt(k,349)*y(k,123) - mat(k,1496) = .200_r8*rxt(k,367)*y(k,240) - mat(k,589) = rxt(k,368)*y(k,123) + .200_r8*rxt(k,367)*y(k,232) - mat(k,1678) = mat(k,1678) + .800_r8*rxt(k,376)*y(k,1) + rxt(k,304)*y(k,26) & - + .500_r8*rxt(k,305)*y(k,27) - mat(k,676) = rxt(k,339)*y(k,123) - mat(k,93) = -(rxt(k,310)*y(k,243)) - mat(k,1570) = -rxt(k,310)*y(k,47) - mat(k,863) = -(rxt(k,346)*y(k,243)) - mat(k,1664) = -rxt(k,346)*y(k,48) - mat(k,569) = .800_r8*rxt(k,376)*y(k,243) - mat(k,833) = .520_r8*rxt(k,460)*y(k,133) - mat(k,296) = .500_r8*rxt(k,347)*y(k,125) - mat(k,807) = .520_r8*rxt(k,463)*y(k,133) - mat(k,1369) = .250_r8*rxt(k,378)*y(k,220) + .820_r8*rxt(k,331)*y(k,224) & - + .500_r8*rxt(k,349)*y(k,229) + .270_r8*rxt(k,472)*y(k,247) & - + .040_r8*rxt(k,477)*y(k,248) - mat(k,1787) = .500_r8*rxt(k,347)*y(k,16) - mat(k,1900) = .520_r8*rxt(k,460)*y(k,6) + .520_r8*rxt(k,463)*y(k,111) - mat(k,945) = .500_r8*rxt(k,481)*y(k,243) - mat(k,854) = .250_r8*rxt(k,378)*y(k,123) - mat(k,711) = .820_r8*rxt(k,331)*y(k,123) + .820_r8*rxt(k,329)*y(k,227) - mat(k,1841) = .820_r8*rxt(k,329)*y(k,224) + .150_r8*rxt(k,470)*y(k,247) & - + .025_r8*rxt(k,475)*y(k,248) - mat(k,496) = .500_r8*rxt(k,349)*y(k,123) - mat(k,1664) = mat(k,1664) + .800_r8*rxt(k,376)*y(k,1) + .500_r8*rxt(k,481) & - *y(k,209) - mat(k,990) = .270_r8*rxt(k,472)*y(k,123) + .150_r8*rxt(k,470)*y(k,227) - mat(k,968) = .040_r8*rxt(k,477)*y(k,123) + .025_r8*rxt(k,475)*y(k,227) - mat(k,1116) = -(rxt(k,334)*y(k,125) + rxt(k,335)*y(k,243)) - mat(k,1804) = -rxt(k,334)*y(k,49) - mat(k,1683) = -rxt(k,335)*y(k,49) - mat(k,960) = rxt(k,336)*y(k,243) - mat(k,1105) = .880_r8*rxt(k,358)*y(k,133) - mat(k,1173) = .500_r8*rxt(k,372)*y(k,133) - mat(k,1385) = .170_r8*rxt(k,431)*y(k,228) + .050_r8*rxt(k,394)*y(k,235) & - + .250_r8*rxt(k,356)*y(k,236) + .170_r8*rxt(k,437)*y(k,239) & - + .400_r8*rxt(k,447)*y(k,249) + .250_r8*rxt(k,413)*y(k,250) & - + .540_r8*rxt(k,453)*y(k,251) + .510_r8*rxt(k,456)*y(k,252) - mat(k,1804) = mat(k,1804) + .050_r8*rxt(k,395)*y(k,235) + .250_r8*rxt(k,355) & - *y(k,236) + .250_r8*rxt(k,414)*y(k,250) - mat(k,748) = rxt(k,337)*y(k,243) - mat(k,1914) = .880_r8*rxt(k,358)*y(k,106) + .500_r8*rxt(k,372)*y(k,112) - mat(k,1274) = .250_r8*rxt(k,352)*y(k,236) + .250_r8*rxt(k,410)*y(k,250) - mat(k,1856) = .240_r8*rxt(k,353)*y(k,236) + .500_r8*rxt(k,341)*y(k,246) & - + .100_r8*rxt(k,411)*y(k,250) - mat(k,667) = .170_r8*rxt(k,431)*y(k,123) + .070_r8*rxt(k,430)*y(k,232) - mat(k,1501) = .070_r8*rxt(k,430)*y(k,228) + .070_r8*rxt(k,436)*y(k,239) - mat(k,1227) = .050_r8*rxt(k,394)*y(k,123) + .050_r8*rxt(k,395)*y(k,125) - mat(k,1196) = .250_r8*rxt(k,356)*y(k,123) + .250_r8*rxt(k,355)*y(k,125) & - + .250_r8*rxt(k,352)*y(k,226) + .240_r8*rxt(k,353)*y(k,227) - mat(k,785) = .170_r8*rxt(k,437)*y(k,123) + .070_r8*rxt(k,436)*y(k,232) - mat(k,1683) = mat(k,1683) + rxt(k,336)*y(k,95) + rxt(k,337)*y(k,126) - mat(k,1030) = .500_r8*rxt(k,341)*y(k,227) - mat(k,643) = .400_r8*rxt(k,447)*y(k,123) - mat(k,1069) = .250_r8*rxt(k,413)*y(k,123) + .250_r8*rxt(k,414)*y(k,125) & - + .250_r8*rxt(k,410)*y(k,226) + .100_r8*rxt(k,411)*y(k,227) - mat(k,659) = .540_r8*rxt(k,453)*y(k,123) - mat(k,430) = .510_r8*rxt(k,456)*y(k,123) - mat(k,467) = -(rxt(k,315)*y(k,243)) - mat(k,1626) = -rxt(k,315)*y(k,50) - mat(k,889) = .120_r8*rxt(k,328)*y(k,133) - mat(k,1889) = .120_r8*rxt(k,328)*y(k,29) - mat(k,1265) = .100_r8*rxt(k,312)*y(k,227) + .150_r8*rxt(k,313)*y(k,232) - mat(k,1834) = .100_r8*rxt(k,312)*y(k,226) - mat(k,1460) = .150_r8*rxt(k,313)*y(k,226) + .150_r8*rxt(k,363)*y(k,238) - mat(k,1245) = .150_r8*rxt(k,363)*y(k,232) - mat(k,435) = -(rxt(k,316)*y(k,243)) - mat(k,1621) = -rxt(k,316)*y(k,51) - mat(k,1264) = .400_r8*rxt(k,313)*y(k,232) - mat(k,1457) = .400_r8*rxt(k,313)*y(k,226) + .400_r8*rxt(k,363)*y(k,238) - mat(k,1244) = .400_r8*rxt(k,363)*y(k,232) - mat(k,701) = -(rxt(k,282)*y(k,243)) - mat(k,1650) = -rxt(k,282)*y(k,52) - mat(k,1082) = .200_r8*rxt(k,400)*y(k,227) - mat(k,738) = .300_r8*rxt(k,301)*y(k,227) - mat(k,1836) = .200_r8*rxt(k,400)*y(k,101) + .300_r8*rxt(k,301)*y(k,223) & - + 2.000_r8*rxt(k,279)*y(k,227) + .250_r8*rxt(k,386)*y(k,234) & - + .250_r8*rxt(k,391)*y(k,235) + .250_r8*rxt(k,353)*y(k,236) & - + .250_r8*rxt(k,465)*y(k,241) + .500_r8*rxt(k,341)*y(k,246) & - + .250_r8*rxt(k,470)*y(k,247) + .250_r8*rxt(k,475)*y(k,248) & - + .300_r8*rxt(k,411)*y(k,250) - mat(k,1142) = .250_r8*rxt(k,386)*y(k,227) - mat(k,1215) = .250_r8*rxt(k,391)*y(k,227) - mat(k,1189) = .250_r8*rxt(k,353)*y(k,227) - mat(k,1008) = .250_r8*rxt(k,465)*y(k,227) - mat(k,1027) = .500_r8*rxt(k,341)*y(k,227) - mat(k,989) = .250_r8*rxt(k,470)*y(k,227) - mat(k,967) = .250_r8*rxt(k,475)*y(k,227) - mat(k,1063) = .300_r8*rxt(k,411)*y(k,227) - mat(k,352) = -(rxt(k,283)*y(k,243)) - mat(k,1609) = -rxt(k,283)*y(k,53) - mat(k,1833) = rxt(k,280)*y(k,232) - mat(k,1446) = rxt(k,280)*y(k,227) - mat(k,2052) = -(rxt(k,194)*y(k,42) + rxt(k,196)*y(k,77) + rxt(k,197)*y(k,79) & - + (rxt(k,198) + rxt(k,199)) * y(k,232) + rxt(k,200)*y(k,133) & - + rxt(k,207)*y(k,60) + rxt(k,216)*y(k,92) + rxt(k,306)*y(k,28)) - mat(k,1730) = -rxt(k,194)*y(k,56) - mat(k,1060) = -rxt(k,196)*y(k,56) - mat(k,525) = -rxt(k,197)*y(k,56) - mat(k,1524) = -(rxt(k,198) + rxt(k,199)) * y(k,56) - mat(k,1938) = -rxt(k,200)*y(k,56) - mat(k,879) = -rxt(k,207)*y(k,56) - mat(k,734) = -rxt(k,216)*y(k,56) - mat(k,247) = -rxt(k,306)*y(k,56) - mat(k,1962) = rxt(k,235)*y(k,59) - mat(k,1988) = rxt(k,235)*y(k,19) + (4.000_r8*rxt(k,202)+2.000_r8*rxt(k,204)) & - *y(k,59) + rxt(k,206)*y(k,123) + rxt(k,211)*y(k,132) & - + rxt(k,489)*y(k,151) + rxt(k,201)*y(k,227) + rxt(k,212) & - *y(k,243) - mat(k,143) = rxt(k,256)*y(k,242) - mat(k,1430) = rxt(k,214)*y(k,132) + rxt(k,226)*y(k,242) + rxt(k,215)*y(k,243) - mat(k,1408) = rxt(k,206)*y(k,59) - mat(k,2018) = rxt(k,211)*y(k,59) + rxt(k,214)*y(k,85) - mat(k,1138) = rxt(k,489)*y(k,59) - mat(k,1878) = rxt(k,201)*y(k,59) - mat(k,1548) = rxt(k,256)*y(k,65) + rxt(k,226)*y(k,85) - mat(k,1707) = rxt(k,212)*y(k,59) + rxt(k,215)*y(k,85) - mat(k,2020) = rxt(k,207)*y(k,60) - mat(k,1965) = 2.000_r8*rxt(k,203)*y(k,59) - mat(k,869) = rxt(k,207)*y(k,56) + (rxt(k,536)+rxt(k,541)+rxt(k,546))*y(k,85) - mat(k,1410) = (rxt(k,536)+rxt(k,541)+rxt(k,546))*y(k,60) + (rxt(k,531) & - +rxt(k,537)+rxt(k,542))*y(k,92) - mat(k,728) = (rxt(k,531)+rxt(k,537)+rxt(k,542))*y(k,85) - mat(k,1964) = 2.000_r8*rxt(k,228)*y(k,59) - mat(k,1986) = -(rxt(k,201)*y(k,227) + (4._r8*rxt(k,202) + 4._r8*rxt(k,203) & - + 4._r8*rxt(k,204) + 4._r8*rxt(k,228)) * y(k,59) + rxt(k,205) & - *y(k,232) + rxt(k,206)*y(k,123) + rxt(k,208)*y(k,124) + rxt(k,211) & - *y(k,132) + (rxt(k,212) + rxt(k,213)) * y(k,243) + (rxt(k,234) & - + rxt(k,235) + rxt(k,236)) * y(k,19) + rxt(k,489)*y(k,151)) - mat(k,1876) = -rxt(k,201)*y(k,59) - mat(k,1522) = -rxt(k,205)*y(k,59) - mat(k,1406) = -rxt(k,206)*y(k,59) - mat(k,1769) = -rxt(k,208)*y(k,59) - mat(k,2016) = -rxt(k,211)*y(k,59) - mat(k,1705) = -(rxt(k,212) + rxt(k,213)) * y(k,59) - mat(k,1960) = -(rxt(k,234) + rxt(k,235) + rxt(k,236)) * y(k,59) - mat(k,1136) = -rxt(k,489)*y(k,59) - mat(k,2050) = rxt(k,216)*y(k,92) + rxt(k,200)*y(k,133) + rxt(k,199)*y(k,232) - mat(k,877) = rxt(k,209)*y(k,132) - mat(k,1428) = rxt(k,227)*y(k,242) - mat(k,732) = rxt(k,216)*y(k,56) + rxt(k,217)*y(k,132) + rxt(k,218)*y(k,243) - mat(k,2016) = mat(k,2016) + rxt(k,209)*y(k,60) + rxt(k,217)*y(k,92) - mat(k,1936) = rxt(k,200)*y(k,56) - mat(k,263) = rxt(k,494)*y(k,151) - mat(k,1136) = mat(k,1136) + rxt(k,494)*y(k,135) - mat(k,1522) = mat(k,1522) + rxt(k,199)*y(k,56) - mat(k,1546) = rxt(k,227)*y(k,85) - mat(k,1705) = mat(k,1705) + rxt(k,218)*y(k,92) - mat(k,871) = -(rxt(k,207)*y(k,56) + rxt(k,209)*y(k,132) + rxt(k,210)*y(k,243) & - + (rxt(k,536) + rxt(k,541) + rxt(k,546)) * y(k,85)) - mat(k,2030) = -rxt(k,207)*y(k,60) - mat(k,1998) = -rxt(k,209)*y(k,60) - mat(k,1665) = -rxt(k,210)*y(k,60) - mat(k,1414) = -(rxt(k,536) + rxt(k,541) + rxt(k,546)) * y(k,60) - mat(k,1970) = rxt(k,208)*y(k,124) - mat(k,1748) = rxt(k,208)*y(k,59) - mat(k,955) = -((rxt(k,285) + rxt(k,295)) * y(k,243)) - mat(k,1672) = -(rxt(k,285) + rxt(k,295)) * y(k,62) - mat(k,836) = .230_r8*rxt(k,460)*y(k,133) - mat(k,1293) = rxt(k,230)*y(k,42) - mat(k,240) = .350_r8*rxt(k,297)*y(k,243) - mat(k,490) = .630_r8*rxt(k,299)*y(k,133) - mat(k,894) = .560_r8*rxt(k,328)*y(k,133) - mat(k,1712) = rxt(k,230)*y(k,17) + rxt(k,194)*y(k,56) + rxt(k,275)*y(k,125) & - + rxt(k,276)*y(k,132) + rxt(k,277)*y(k,243) - mat(k,1115) = rxt(k,334)*y(k,125) + rxt(k,335)*y(k,243) - mat(k,2032) = rxt(k,194)*y(k,42) - mat(k,793) = rxt(k,322)*y(k,243) - mat(k,768) = .620_r8*rxt(k,405)*y(k,133) - mat(k,1103) = .650_r8*rxt(k,358)*y(k,133) - mat(k,810) = .230_r8*rxt(k,463)*y(k,133) - mat(k,1170) = .560_r8*rxt(k,372)*y(k,133) - mat(k,1375) = .170_r8*rxt(k,431)*y(k,228) + .220_r8*rxt(k,356)*y(k,236) & - + .400_r8*rxt(k,434)*y(k,237) + .350_r8*rxt(k,437)*y(k,239) & - + .225_r8*rxt(k,472)*y(k,247) + .250_r8*rxt(k,413)*y(k,250) - mat(k,1794) = rxt(k,275)*y(k,42) + rxt(k,334)*y(k,49) + .220_r8*rxt(k,355) & - *y(k,236) + .500_r8*rxt(k,414)*y(k,250) - mat(k,1999) = rxt(k,276)*y(k,42) + rxt(k,484)*y(k,136) - mat(k,1905) = .230_r8*rxt(k,460)*y(k,6) + .630_r8*rxt(k,299)*y(k,25) & - + .560_r8*rxt(k,328)*y(k,29) + .620_r8*rxt(k,405)*y(k,98) & - + .650_r8*rxt(k,358)*y(k,106) + .230_r8*rxt(k,463)*y(k,111) & - + .560_r8*rxt(k,372)*y(k,112) - mat(k,305) = rxt(k,484)*y(k,132) + rxt(k,485)*y(k,243) - mat(k,947) = .700_r8*rxt(k,481)*y(k,243) - mat(k,1269) = .220_r8*rxt(k,352)*y(k,236) + .250_r8*rxt(k,410)*y(k,250) - mat(k,1846) = .110_r8*rxt(k,353)*y(k,236) + .125_r8*rxt(k,470)*y(k,247) & - + .200_r8*rxt(k,411)*y(k,250) - mat(k,666) = .170_r8*rxt(k,431)*y(k,123) + .070_r8*rxt(k,430)*y(k,232) - mat(k,1490) = .070_r8*rxt(k,430)*y(k,228) + .160_r8*rxt(k,433)*y(k,237) & - + .140_r8*rxt(k,436)*y(k,239) - mat(k,1192) = .220_r8*rxt(k,356)*y(k,123) + .220_r8*rxt(k,355)*y(k,125) & - + .220_r8*rxt(k,352)*y(k,226) + .110_r8*rxt(k,353)*y(k,227) - mat(k,629) = .400_r8*rxt(k,434)*y(k,123) + .160_r8*rxt(k,433)*y(k,232) - mat(k,784) = .350_r8*rxt(k,437)*y(k,123) + .140_r8*rxt(k,436)*y(k,232) - mat(k,1672) = mat(k,1672) + .350_r8*rxt(k,297)*y(k,24) + rxt(k,277)*y(k,42) & - + rxt(k,335)*y(k,49) + rxt(k,322)*y(k,75) + rxt(k,485)*y(k,136) & - + .700_r8*rxt(k,481)*y(k,209) - mat(k,993) = .225_r8*rxt(k,472)*y(k,123) + .125_r8*rxt(k,470)*y(k,227) - mat(k,1066) = .250_r8*rxt(k,413)*y(k,123) + .500_r8*rxt(k,414)*y(k,125) & - + .250_r8*rxt(k,410)*y(k,226) + .200_r8*rxt(k,411)*y(k,227) + mat(k,614) = -(rxt(k,259)*y(k,58) + rxt(k,260)*y(k,251) + rxt(k,270)*y(k,250)) + mat(k,2238) = -rxt(k,259)*y(k,45) + mat(k,1844) = -rxt(k,260)*y(k,45) + mat(k,1733) = -rxt(k,270)*y(k,45) + mat(k,164) = -(rxt(k,261)*y(k,251)) + mat(k,1781) = -rxt(k,261)*y(k,46) + mat(k,1125) = -(rxt(k,307)*y(k,131) + rxt(k,308)*y(k,251)) + mat(k,2051) = -rxt(k,307)*y(k,47) + mat(k,1890) = -rxt(k,308)*y(k,47) + mat(k,689) = .800_r8*rxt(k,375)*y(k,251) + mat(k,402) = rxt(k,346)*y(k,131) + mat(k,304) = rxt(k,303)*y(k,251) + mat(k,380) = .500_r8*rxt(k,304)*y(k,251) + mat(k,1065) = .500_r8*rxt(k,327)*y(k,139) + mat(k,1367) = .100_r8*rxt(k,371)*y(k,139) + mat(k,1583) = .400_r8*rxt(k,377)*y(k,228) + rxt(k,302)*y(k,231) & + + .270_r8*rxt(k,330)*y(k,232) + rxt(k,348)*y(k,237) + rxt(k,367) & + *y(k,248) + rxt(k,338)*y(k,253) + mat(k,2051) = mat(k,2051) + rxt(k,346)*y(k,18) + mat(k,2296) = .500_r8*rxt(k,327)*y(k,31) + .100_r8*rxt(k,371)*y(k,118) + mat(k,941) = .400_r8*rxt(k,377)*y(k,129) + mat(k,861) = rxt(k,302)*y(k,129) + 3.200_r8*rxt(k,299)*y(k,231) & + + .800_r8*rxt(k,300)*y(k,235) + mat(k,833) = .270_r8*rxt(k,330)*y(k,129) + mat(k,1637) = .800_r8*rxt(k,300)*y(k,231) + mat(k,608) = rxt(k,348)*y(k,129) + mat(k,2195) = .200_r8*rxt(k,366)*y(k,248) + mat(k,718) = rxt(k,367)*y(k,129) + .200_r8*rxt(k,366)*y(k,240) + mat(k,1890) = mat(k,1890) + .800_r8*rxt(k,375)*y(k,1) + rxt(k,303)*y(k,28) & + + .500_r8*rxt(k,304)*y(k,29) + mat(k,809) = rxt(k,338)*y(k,129) + mat(k,407) = -(rxt(k,262)*y(k,58) + rxt(k,263)*y(k,251)) + mat(k,2234) = -rxt(k,262)*y(k,48) + mat(k,1816) = -rxt(k,263)*y(k,48) + mat(k,142) = -(rxt(k,309)*y(k,251)) + mat(k,1779) = -rxt(k,309)*y(k,49) + mat(k,962) = -(rxt(k,345)*y(k,251)) + mat(k,1880) = -rxt(k,345)*y(k,50) + mat(k,688) = .800_r8*rxt(k,375)*y(k,251) + mat(k,986) = .520_r8*rxt(k,459)*y(k,139) + mat(k,401) = .500_r8*rxt(k,346)*y(k,131) + mat(k,1035) = .520_r8*rxt(k,462)*y(k,139) + mat(k,1576) = .250_r8*rxt(k,377)*y(k,228) + .820_r8*rxt(k,330)*y(k,232) & + + .500_r8*rxt(k,348)*y(k,237) + .270_r8*rxt(k,471)*y(k,255) & + + .040_r8*rxt(k,476)*y(k,256) + mat(k,2041) = .500_r8*rxt(k,346)*y(k,18) + mat(k,2287) = .520_r8*rxt(k,459)*y(k,6) + .520_r8*rxt(k,462)*y(k,116) + mat(k,1114) = .500_r8*rxt(k,480)*y(k,251) + mat(k,940) = .250_r8*rxt(k,377)*y(k,129) + mat(k,832) = .820_r8*rxt(k,330)*y(k,129) + .820_r8*rxt(k,328)*y(k,235) + mat(k,1631) = .820_r8*rxt(k,328)*y(k,232) + .150_r8*rxt(k,469)*y(k,255) & + + .025_r8*rxt(k,474)*y(k,256) + mat(k,607) = .500_r8*rxt(k,348)*y(k,129) + mat(k,1880) = mat(k,1880) + .800_r8*rxt(k,375)*y(k,1) + .500_r8*rxt(k,480) & + *y(k,215) + mat(k,1151) = .270_r8*rxt(k,471)*y(k,129) + .150_r8*rxt(k,469)*y(k,235) + mat(k,953) = .040_r8*rxt(k,476)*y(k,129) + .025_r8*rxt(k,474)*y(k,235) + mat(k,1261) = -(rxt(k,333)*y(k,131) + rxt(k,334)*y(k,251)) + mat(k,2061) = -rxt(k,333)*y(k,51) + mat(k,1900) = -rxt(k,334)*y(k,51) + mat(k,1181) = rxt(k,335)*y(k,251) + mat(k,1250) = .880_r8*rxt(k,357)*y(k,139) + mat(k,1370) = .500_r8*rxt(k,371)*y(k,139) + mat(k,1593) = .170_r8*rxt(k,430)*y(k,236) + .050_r8*rxt(k,393)*y(k,243) & + + .250_r8*rxt(k,355)*y(k,244) + .170_r8*rxt(k,436)*y(k,247) & + + .400_r8*rxt(k,446)*y(k,257) + .250_r8*rxt(k,412)*y(k,258) & + + .540_r8*rxt(k,452)*y(k,259) + .510_r8*rxt(k,455)*y(k,260) + mat(k,2061) = mat(k,2061) + .050_r8*rxt(k,394)*y(k,243) + .250_r8*rxt(k,354) & + *y(k,244) + .250_r8*rxt(k,413)*y(k,258) + mat(k,891) = rxt(k,336)*y(k,251) + mat(k,2304) = .880_r8*rxt(k,357)*y(k,111) + .500_r8*rxt(k,371)*y(k,118) + mat(k,1420) = .250_r8*rxt(k,351)*y(k,244) + .250_r8*rxt(k,409)*y(k,258) + mat(k,1646) = .240_r8*rxt(k,352)*y(k,244) + .500_r8*rxt(k,340)*y(k,254) & + + .100_r8*rxt(k,410)*y(k,258) + mat(k,801) = .170_r8*rxt(k,430)*y(k,129) + .070_r8*rxt(k,429)*y(k,240) + mat(k,2204) = .070_r8*rxt(k,429)*y(k,236) + .070_r8*rxt(k,435)*y(k,247) + mat(k,1327) = .050_r8*rxt(k,393)*y(k,129) + .050_r8*rxt(k,394)*y(k,131) + mat(k,1350) = .250_r8*rxt(k,355)*y(k,129) + .250_r8*rxt(k,354)*y(k,131) & + + .250_r8*rxt(k,351)*y(k,234) + .240_r8*rxt(k,352)*y(k,235) + mat(k,906) = .170_r8*rxt(k,436)*y(k,129) + .070_r8*rxt(k,435)*y(k,240) + mat(k,1900) = mat(k,1900) + rxt(k,335)*y(k,97) + rxt(k,336)*y(k,132) + mat(k,1171) = .500_r8*rxt(k,340)*y(k,235) + mat(k,777) = .400_r8*rxt(k,446)*y(k,129) + mat(k,1214) = .250_r8*rxt(k,412)*y(k,129) + .250_r8*rxt(k,413)*y(k,131) & + + .250_r8*rxt(k,409)*y(k,234) + .100_r8*rxt(k,410)*y(k,235) + mat(k,793) = .540_r8*rxt(k,452)*y(k,129) + mat(k,543) = .510_r8*rxt(k,455)*y(k,129) + mat(k,724) = -(rxt(k,314)*y(k,251)) + mat(k,1857) = -rxt(k,314)*y(k,52) + mat(k,1059) = .120_r8*rxt(k,327)*y(k,139) + mat(k,2281) = .120_r8*rxt(k,327)*y(k,31) + mat(k,1410) = .100_r8*rxt(k,311)*y(k,235) + .150_r8*rxt(k,312)*y(k,240) + mat(k,1624) = .100_r8*rxt(k,311)*y(k,234) + mat(k,2170) = .150_r8*rxt(k,312)*y(k,234) + .150_r8*rxt(k,362)*y(k,246) + mat(k,1389) = .150_r8*rxt(k,362)*y(k,240) + mat(k,623) = -(rxt(k,315)*y(k,251)) + mat(k,1845) = -rxt(k,315)*y(k,53) + mat(k,1409) = .400_r8*rxt(k,312)*y(k,240) + mat(k,2162) = .400_r8*rxt(k,312)*y(k,234) + .400_r8*rxt(k,362)*y(k,246) + mat(k,1387) = .400_r8*rxt(k,362)*y(k,240) + mat(k,826) = -(rxt(k,282)*y(k,251)) + mat(k,1866) = -rxt(k,282)*y(k,54) + mat(k,1227) = .200_r8*rxt(k,399)*y(k,235) + mat(k,859) = .300_r8*rxt(k,300)*y(k,235) + mat(k,1625) = .200_r8*rxt(k,399)*y(k,103) + .300_r8*rxt(k,300)*y(k,231) & + + 2.000_r8*rxt(k,279)*y(k,235) + .250_r8*rxt(k,385)*y(k,242) & + + .250_r8*rxt(k,390)*y(k,243) + .250_r8*rxt(k,352)*y(k,244) & + + .250_r8*rxt(k,464)*y(k,249) + .500_r8*rxt(k,340)*y(k,254) & + + .250_r8*rxt(k,469)*y(k,255) + .250_r8*rxt(k,474)*y(k,256) & + + .300_r8*rxt(k,410)*y(k,258) + mat(k,1287) = .250_r8*rxt(k,385)*y(k,235) + mat(k,1317) = .250_r8*rxt(k,390)*y(k,235) + mat(k,1345) = .250_r8*rxt(k,352)*y(k,235) + mat(k,1099) = .250_r8*rxt(k,464)*y(k,235) + mat(k,1168) = .500_r8*rxt(k,340)*y(k,235) + mat(k,1149) = .250_r8*rxt(k,469)*y(k,235) + mat(k,951) = .250_r8*rxt(k,474)*y(k,235) + mat(k,1207) = .300_r8*rxt(k,410)*y(k,235) + mat(k,451) = -(rxt(k,283)*y(k,251)) + mat(k,1823) = -rxt(k,283)*y(k,55) + mat(k,1622) = rxt(k,280)*y(k,240) + mat(k,2149) = rxt(k,280)*y(k,235) + mat(k,1470) = -(rxt(k,195)*y(k,58) + rxt(k,251)*y(k,75) + rxt(k,284)*y(k,251) & + + (rxt(k,290) + rxt(k,291) + rxt(k,292)) * y(k,250)) + mat(k,2252) = -rxt(k,195)*y(k,56) + mat(k,915) = -rxt(k,251)*y(k,56) + mat(k,1910) = -rxt(k,284)*y(k,56) + mat(k,1738) = -(rxt(k,290) + rxt(k,291) + rxt(k,292)) * y(k,56) + mat(k,1070) = .100_r8*rxt(k,327)*y(k,139) + mat(k,2313) = .100_r8*rxt(k,327)*y(k,31) + mat(k,457) = -(rxt(k,247)*y(k,250) + rxt(k,264)*y(k,58) + rxt(k,265)*y(k,251)) + mat(k,1731) = -rxt(k,247)*y(k,57) + mat(k,2235) = -rxt(k,264)*y(k,57) + mat(k,1824) = -rxt(k,265)*y(k,57) + mat(k,2267) = -(rxt(k,194)*y(k,44) + rxt(k,195)*y(k,56) + rxt(k,196)*y(k,79) & + + rxt(k,197)*y(k,81) + (rxt(k,198) + rxt(k,199)) * y(k,240) & + + rxt(k,200)*y(k,139) + rxt(k,207)*y(k,62) + rxt(k,216)*y(k,94) & + + rxt(k,257)*y(k,43) + rxt(k,259)*y(k,45) + rxt(k,262)*y(k,48) & + + rxt(k,264)*y(k,57) + rxt(k,305)*y(k,30)) + mat(k,2028) = -rxt(k,194)*y(k,58) + mat(k,1481) = -rxt(k,195)*y(k,58) + mat(k,1451) = -rxt(k,196)*y(k,58) + mat(k,644) = -rxt(k,197)*y(k,58) + mat(k,2228) = -(rxt(k,198) + rxt(k,199)) * y(k,58) + mat(k,2328) = -rxt(k,200)*y(k,58) + mat(k,932) = -rxt(k,207)*y(k,58) + mat(k,847) = -rxt(k,216)*y(k,58) + mat(k,522) = -rxt(k,257)*y(k,58) + mat(k,621) = -rxt(k,259)*y(k,58) + mat(k,413) = -rxt(k,262)*y(k,58) + mat(k,462) = -rxt(k,264)*y(k,58) + mat(k,334) = -rxt(k,305)*y(k,58) + mat(k,2109) = rxt(k,235)*y(k,61) + mat(k,141) = 4.000_r8*rxt(k,219)*y(k,250) + mat(k,182) = rxt(k,220)*y(k,250) + mat(k,155) = 2.000_r8*rxt(k,221)*y(k,250) + mat(k,192) = 2.000_r8*rxt(k,222)*y(k,250) + mat(k,159) = 2.000_r8*rxt(k,223)*y(k,250) + mat(k,197) = rxt(k,224)*y(k,250) + mat(k,163) = 2.000_r8*rxt(k,225)*y(k,250) + mat(k,166) = 3.000_r8*rxt(k,261)*y(k,251) + mat(k,413) = mat(k,413) + rxt(k,263)*y(k,251) + mat(k,1951) = rxt(k,235)*y(k,21) + (4.000_r8*rxt(k,202)+2.000_r8*rxt(k,204)) & + *y(k,61) + rxt(k,206)*y(k,129) + rxt(k,211)*y(k,138) & + + rxt(k,489)*y(k,157) + rxt(k,201)*y(k,235) + rxt(k,212) & + *y(k,251) + mat(k,272) = rxt(k,256)*y(k,250) + mat(k,268) = rxt(k,271)*y(k,250) + rxt(k,266)*y(k,251) + mat(k,289) = rxt(k,272)*y(k,250) + rxt(k,267)*y(k,251) + mat(k,344) = rxt(k,273)*y(k,250) + rxt(k,268)*y(k,251) + mat(k,1973) = rxt(k,214)*y(k,138) + rxt(k,226)*y(k,250) + rxt(k,215)*y(k,251) + mat(k,1616) = rxt(k,206)*y(k,61) + mat(k,2004) = rxt(k,211)*y(k,61) + rxt(k,214)*y(k,87) + mat(k,1282) = rxt(k,489)*y(k,61) + mat(k,1668) = rxt(k,201)*y(k,61) + mat(k,1753) = 4.000_r8*rxt(k,219)*y(k,35) + rxt(k,220)*y(k,36) & + + 2.000_r8*rxt(k,221)*y(k,38) + 2.000_r8*rxt(k,222)*y(k,39) & + + 2.000_r8*rxt(k,223)*y(k,40) + rxt(k,224)*y(k,41) & + + 2.000_r8*rxt(k,225)*y(k,42) + rxt(k,256)*y(k,67) + rxt(k,271) & + *y(k,84) + rxt(k,272)*y(k,85) + rxt(k,273)*y(k,86) + rxt(k,226) & + *y(k,87) + mat(k,1925) = 3.000_r8*rxt(k,261)*y(k,46) + rxt(k,263)*y(k,48) + rxt(k,212) & + *y(k,61) + rxt(k,266)*y(k,84) + rxt(k,267)*y(k,85) + rxt(k,268) & + *y(k,86) + rxt(k,215)*y(k,87) + mat(k,2231) = rxt(k,207)*y(k,62) + mat(k,1929) = 2.000_r8*rxt(k,203)*y(k,61) + mat(k,922) = rxt(k,207)*y(k,58) + (rxt(k,551)+rxt(k,556)+rxt(k,561))*y(k,87) + mat(k,1954) = (rxt(k,551)+rxt(k,556)+rxt(k,561))*y(k,62) + (rxt(k,546) & + +rxt(k,552)+rxt(k,557))*y(k,94) + mat(k,841) = (rxt(k,546)+rxt(k,552)+rxt(k,557))*y(k,87) + mat(k,1928) = 2.000_r8*rxt(k,228)*y(k,61) + mat(k,1944) = -(rxt(k,201)*y(k,235) + (4._r8*rxt(k,202) + 4._r8*rxt(k,203) & + + 4._r8*rxt(k,204) + 4._r8*rxt(k,228)) * y(k,61) + rxt(k,205) & + *y(k,240) + rxt(k,206)*y(k,129) + rxt(k,208)*y(k,130) + rxt(k,211) & + *y(k,138) + (rxt(k,212) + rxt(k,213)) * y(k,251) + (rxt(k,234) & + + rxt(k,235) + rxt(k,236)) * y(k,21) + rxt(k,489)*y(k,157)) + mat(k,1661) = -rxt(k,201)*y(k,61) + mat(k,2221) = -rxt(k,205)*y(k,61) + mat(k,1609) = -rxt(k,206)*y(k,61) + mat(k,1705) = -rxt(k,208)*y(k,61) + mat(k,1997) = -rxt(k,211)*y(k,61) + mat(k,1918) = -(rxt(k,212) + rxt(k,213)) * y(k,61) + mat(k,2102) = -(rxt(k,234) + rxt(k,235) + rxt(k,236)) * y(k,61) + mat(k,1278) = -rxt(k,489)*y(k,61) + mat(k,2260) = rxt(k,216)*y(k,94) + rxt(k,200)*y(k,139) + rxt(k,199)*y(k,240) + mat(k,928) = rxt(k,209)*y(k,138) + mat(k,1966) = rxt(k,227)*y(k,250) + mat(k,844) = rxt(k,216)*y(k,58) + rxt(k,217)*y(k,138) + rxt(k,218)*y(k,251) + mat(k,1997) = mat(k,1997) + rxt(k,209)*y(k,62) + rxt(k,217)*y(k,94) + mat(k,2321) = rxt(k,200)*y(k,58) + mat(k,365) = rxt(k,494)*y(k,157) + mat(k,1278) = mat(k,1278) + rxt(k,494)*y(k,141) + mat(k,2221) = mat(k,2221) + rxt(k,199)*y(k,58) + mat(k,1746) = rxt(k,227)*y(k,87) + mat(k,1918) = mat(k,1918) + rxt(k,218)*y(k,94) end do end subroutine nlnmat02 subroutine nlnmat03( avec_len, mat, y, rxt ) @@ -489,228 +529,214 @@ subroutine nlnmat03( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,109) = -(rxt(k,255)*y(k,242)) - mat(k,1526) = -rxt(k,255)*y(k,64) - mat(k,140) = -(rxt(k,256)*y(k,242)) - mat(k,1527) = -rxt(k,256)*y(k,65) - mat(k,160) = -(rxt(k,429)*y(k,243)) - mat(k,1580) = -rxt(k,429)*y(k,66) - mat(k,154) = .180_r8*rxt(k,449)*y(k,243) - mat(k,1580) = mat(k,1580) + .180_r8*rxt(k,449)*y(k,211) - mat(k,249) = -(rxt(k,482)*y(k,125) + (rxt(k,483) + rxt(k,496)) * y(k,243)) - mat(k,1776) = -rxt(k,482)*y(k,67) - mat(k,1594) = -(rxt(k,483) + rxt(k,496)) * y(k,67) - mat(k,618) = rxt(k,317)*y(k,232) - mat(k,1432) = rxt(k,317)*y(k,231) - mat(k,693) = -(rxt(k,252)*y(k,77) + rxt(k,253)*y(k,253) + rxt(k,254)*y(k,89)) - mat(k,1050) = -rxt(k,252)*y(k,73) - mat(k,2057) = -rxt(k,253)*y(k,73) - mat(k,1305) = -rxt(k,254)*y(k,73) - mat(k,110) = 2.000_r8*rxt(k,255)*y(k,242) - mat(k,141) = rxt(k,256)*y(k,242) - mat(k,1529) = 2.000_r8*rxt(k,255)*y(k,64) + rxt(k,256)*y(k,65) - mat(k,924) = -(rxt(k,321)*y(k,243)) - mat(k,1669) = -rxt(k,321)*y(k,74) - mat(k,512) = .700_r8*rxt(k,396)*y(k,243) - mat(k,473) = .500_r8*rxt(k,397)*y(k,243) - mat(k,312) = rxt(k,408)*y(k,243) - mat(k,1372) = .050_r8*rxt(k,394)*y(k,235) + .530_r8*rxt(k,356)*y(k,236) & - + .225_r8*rxt(k,472)*y(k,247) + .250_r8*rxt(k,413)*y(k,250) - mat(k,1791) = .050_r8*rxt(k,395)*y(k,235) + .530_r8*rxt(k,355)*y(k,236) & - + .250_r8*rxt(k,414)*y(k,250) - mat(k,1268) = .530_r8*rxt(k,352)*y(k,236) + .250_r8*rxt(k,410)*y(k,250) - mat(k,1844) = .260_r8*rxt(k,353)*y(k,236) + .125_r8*rxt(k,470)*y(k,247) & - + .100_r8*rxt(k,411)*y(k,250) - mat(k,1219) = .050_r8*rxt(k,394)*y(k,123) + .050_r8*rxt(k,395)*y(k,125) - mat(k,1190) = .530_r8*rxt(k,356)*y(k,123) + .530_r8*rxt(k,355)*y(k,125) & - + .530_r8*rxt(k,352)*y(k,226) + .260_r8*rxt(k,353)*y(k,227) - mat(k,1669) = mat(k,1669) + .700_r8*rxt(k,396)*y(k,99) + .500_r8*rxt(k,397) & - *y(k,100) + rxt(k,408)*y(k,116) - mat(k,991) = .225_r8*rxt(k,472)*y(k,123) + .125_r8*rxt(k,470)*y(k,227) - mat(k,1065) = .250_r8*rxt(k,413)*y(k,123) + .250_r8*rxt(k,414)*y(k,125) & - + .250_r8*rxt(k,410)*y(k,226) + .100_r8*rxt(k,411)*y(k,227) - mat(k,792) = -(rxt(k,322)*y(k,243)) - mat(k,1660) = -rxt(k,322)*y(k,75) - mat(k,239) = .650_r8*rxt(k,297)*y(k,243) - mat(k,923) = .200_r8*rxt(k,321)*y(k,243) - mat(k,911) = rxt(k,409)*y(k,243) - mat(k,1367) = rxt(k,420)*y(k,221) + .050_r8*rxt(k,394)*y(k,235) & - + .400_r8*rxt(k,434)*y(k,237) + .170_r8*rxt(k,437)*y(k,239) & - + .700_r8*rxt(k,440)*y(k,244) + .600_r8*rxt(k,447)*y(k,249) & - + .250_r8*rxt(k,413)*y(k,250) + .340_r8*rxt(k,453)*y(k,251) & - + .170_r8*rxt(k,456)*y(k,252) - mat(k,1783) = .050_r8*rxt(k,395)*y(k,235) + .250_r8*rxt(k,414)*y(k,250) - mat(k,422) = rxt(k,420)*y(k,123) - mat(k,1266) = .250_r8*rxt(k,410)*y(k,250) - mat(k,1840) = .100_r8*rxt(k,411)*y(k,250) - mat(k,1484) = .160_r8*rxt(k,433)*y(k,237) + .070_r8*rxt(k,436)*y(k,239) - mat(k,1218) = .050_r8*rxt(k,394)*y(k,123) + .050_r8*rxt(k,395)*y(k,125) - mat(k,628) = .400_r8*rxt(k,434)*y(k,123) + .160_r8*rxt(k,433)*y(k,232) - mat(k,783) = .170_r8*rxt(k,437)*y(k,123) + .070_r8*rxt(k,436)*y(k,232) - mat(k,1660) = mat(k,1660) + .650_r8*rxt(k,297)*y(k,24) + .200_r8*rxt(k,321) & - *y(k,74) + rxt(k,409)*y(k,117) - mat(k,392) = .700_r8*rxt(k,440)*y(k,123) - mat(k,641) = .600_r8*rxt(k,447)*y(k,123) - mat(k,1064) = .250_r8*rxt(k,413)*y(k,123) + .250_r8*rxt(k,414)*y(k,125) & - + .250_r8*rxt(k,410)*y(k,226) + .100_r8*rxt(k,411)*y(k,227) - mat(k,657) = .340_r8*rxt(k,453)*y(k,123) - mat(k,429) = .170_r8*rxt(k,456)*y(k,123) - mat(k,1320) = -((rxt(k,154) + rxt(k,155) + rxt(k,156)) * y(k,232) + rxt(k,160) & - *y(k,133)) - mat(k,1510) = -(rxt(k,154) + rxt(k,155) + rxt(k,156)) * y(k,76) - mat(k,1924) = -rxt(k,160)*y(k,76) - mat(k,1716) = rxt(k,277)*y(k,243) - mat(k,2038) = rxt(k,196)*y(k,77) - mat(k,956) = rxt(k,295)*y(k,243) - mat(k,696) = rxt(k,252)*y(k,77) - mat(k,1053) = rxt(k,196)*y(k,56) + rxt(k,252)*y(k,73) + rxt(k,152)*y(k,132) & - + rxt(k,144)*y(k,242) + rxt(k,161)*y(k,243) - mat(k,722) = rxt(k,250)*y(k,242) - mat(k,1417) = rxt(k,227)*y(k,242) - mat(k,365) = rxt(k,182)*y(k,243) - mat(k,2004) = rxt(k,152)*y(k,77) + rxt(k,164)*y(k,243) - mat(k,307) = rxt(k,485)*y(k,243) - mat(k,443) = rxt(k,490)*y(k,243) - mat(k,1129) = rxt(k,495)*y(k,243) - mat(k,1534) = rxt(k,144)*y(k,77) + rxt(k,250)*y(k,81) + rxt(k,227)*y(k,85) - mat(k,1693) = rxt(k,277)*y(k,42) + rxt(k,295)*y(k,62) + rxt(k,161)*y(k,77) & - + rxt(k,182)*y(k,113) + rxt(k,164)*y(k,132) + rxt(k,485) & - *y(k,136) + rxt(k,490)*y(k,149) + rxt(k,495)*y(k,151) - mat(k,1051) = -(rxt(k,144)*y(k,242) + rxt(k,152)*y(k,132) + rxt(k,161) & - *y(k,243) + rxt(k,196)*y(k,56) + rxt(k,252)*y(k,73)) - mat(k,1531) = -rxt(k,144)*y(k,77) - mat(k,2000) = -rxt(k,152)*y(k,77) - mat(k,1679) = -rxt(k,161)*y(k,77) - mat(k,2034) = -rxt(k,196)*y(k,77) - mat(k,694) = -rxt(k,252)*y(k,77) - mat(k,1318) = rxt(k,154)*y(k,232) - mat(k,1497) = rxt(k,154)*y(k,76) - mat(k,520) = -(rxt(k,153)*y(k,132) + rxt(k,162)*y(k,243) + rxt(k,197)*y(k,56)) - mat(k,1993) = -rxt(k,153)*y(k,79) - mat(k,1632) = -rxt(k,162)*y(k,79) - mat(k,2024) = -rxt(k,197)*y(k,79) - mat(k,1461) = 2.000_r8*rxt(k,168)*y(k,232) - mat(k,1632) = mat(k,1632) + 2.000_r8*rxt(k,167)*y(k,243) - mat(k,211) = rxt(k,498)*y(k,253) - mat(k,2054) = rxt(k,498)*y(k,153) - mat(k,720) = -(rxt(k,243)*y(k,132) + rxt(k,244)*y(k,243) + (rxt(k,249) & - + rxt(k,250)) * y(k,242)) - mat(k,1995) = -rxt(k,243)*y(k,81) - mat(k,1653) = -rxt(k,244)*y(k,81) - mat(k,1530) = -(rxt(k,249) + rxt(k,250)) * y(k,81) - mat(k,1292) = rxt(k,230)*y(k,42) + rxt(k,231)*y(k,232) - mat(k,1711) = rxt(k,230)*y(k,17) - mat(k,1479) = rxt(k,231)*y(k,17) - mat(k,1418) = -(rxt(k,214)*y(k,132) + rxt(k,215)*y(k,243) + (rxt(k,226) & - + rxt(k,227)) * y(k,242) + (rxt(k,531) + rxt(k,537) + rxt(k,542) & - ) * y(k,92) + (rxt(k,536) + rxt(k,541) + rxt(k,546)) * y(k,60) & - + (rxt(k,538) + rxt(k,543)) * y(k,91)) - mat(k,2006) = -rxt(k,214)*y(k,85) - mat(k,1695) = -rxt(k,215)*y(k,85) - mat(k,1536) = -(rxt(k,226) + rxt(k,227)) * y(k,85) - mat(k,730) = -(rxt(k,531) + rxt(k,537) + rxt(k,542)) * y(k,85) - mat(k,873) = -(rxt(k,536) + rxt(k,541) + rxt(k,546)) * y(k,85) - mat(k,686) = -(rxt(k,538) + rxt(k,543)) * y(k,85) - mat(k,245) = rxt(k,306)*y(k,56) - mat(k,1718) = rxt(k,194)*y(k,56) - mat(k,2040) = rxt(k,306)*y(k,28) + rxt(k,194)*y(k,42) + rxt(k,196)*y(k,77) & - + rxt(k,197)*y(k,79) + rxt(k,216)*y(k,92) + rxt(k,198)*y(k,232) - mat(k,1976) = rxt(k,213)*y(k,243) - mat(k,1054) = rxt(k,196)*y(k,56) - mat(k,521) = rxt(k,197)*y(k,56) - mat(k,730) = mat(k,730) + rxt(k,216)*y(k,56) - mat(k,1512) = rxt(k,198)*y(k,56) - mat(k,1695) = mat(k,1695) + rxt(k,213)*y(k,59) - mat(k,144) = -(rxt(k,286)*y(k,243) + rxt(k,294)*y(k,242)) - mat(k,1578) = -rxt(k,286)*y(k,86) - mat(k,1528) = -rxt(k,294)*y(k,86) - mat(k,705) = -(rxt(k,287)*y(k,243)) - mat(k,1651) = -rxt(k,287)*y(k,87) - mat(k,829) = .050_r8*rxt(k,460)*y(k,133) - mat(k,238) = .350_r8*rxt(k,297)*y(k,243) - mat(k,489) = .370_r8*rxt(k,299)*y(k,133) - mat(k,891) = .120_r8*rxt(k,328)*y(k,133) - mat(k,765) = .110_r8*rxt(k,405)*y(k,133) - mat(k,1102) = .330_r8*rxt(k,358)*y(k,133) - mat(k,803) = .050_r8*rxt(k,463)*y(k,133) - mat(k,1168) = .120_r8*rxt(k,372)*y(k,133) - mat(k,1362) = rxt(k,290)*y(k,233) - mat(k,1893) = .050_r8*rxt(k,460)*y(k,6) + .370_r8*rxt(k,299)*y(k,25) & - + .120_r8*rxt(k,328)*y(k,29) + .110_r8*rxt(k,405)*y(k,98) & - + .330_r8*rxt(k,358)*y(k,106) + .050_r8*rxt(k,463)*y(k,111) & - + .120_r8*rxt(k,372)*y(k,112) - mat(k,1477) = rxt(k,288)*y(k,233) - mat(k,385) = rxt(k,290)*y(k,123) + rxt(k,288)*y(k,232) - mat(k,1651) = mat(k,1651) + .350_r8*rxt(k,297)*y(k,24) - mat(k,692) = rxt(k,252)*y(k,77) + rxt(k,254)*y(k,89) + rxt(k,253)*y(k,253) - mat(k,1049) = rxt(k,252)*y(k,73) - mat(k,1304) = rxt(k,254)*y(k,73) - mat(k,2055) = rxt(k,253)*y(k,73) - mat(k,1307) = -(rxt(k,191)*y(k,243) + rxt(k,254)*y(k,73)) - mat(k,1692) = -rxt(k,191)*y(k,89) - mat(k,695) = -rxt(k,254)*y(k,89) - mat(k,1715) = rxt(k,275)*y(k,125) - mat(k,1042) = rxt(k,308)*y(k,125) - mat(k,1118) = rxt(k,334)*y(k,125) - mat(k,872) = (rxt(k,536)+rxt(k,541)+rxt(k,546))*y(k,85) - mat(k,251) = rxt(k,482)*y(k,125) - mat(k,1416) = (rxt(k,536)+rxt(k,541)+rxt(k,546))*y(k,60) - mat(k,1756) = rxt(k,190)*y(k,243) - mat(k,1813) = rxt(k,275)*y(k,42) + rxt(k,308)*y(k,45) + rxt(k,334)*y(k,49) & - + rxt(k,482)*y(k,67) - mat(k,1692) = mat(k,1692) + rxt(k,190)*y(k,124) - mat(k,358) = -(rxt(k,169)*y(k,243)) - mat(k,1610) = -rxt(k,169)*y(k,90) - mat(k,1734) = rxt(k,188)*y(k,232) - mat(k,1447) = rxt(k,188)*y(k,124) - mat(k,684) = -(rxt(k,245)*y(k,132) + (rxt(k,538) + rxt(k,543)) * y(k,85)) - mat(k,1994) = -rxt(k,245)*y(k,91) - mat(k,1412) = -(rxt(k,538) + rxt(k,543)) * y(k,91) - mat(k,1943) = rxt(k,237)*y(k,232) - mat(k,1476) = rxt(k,237)*y(k,19) - mat(k,729) = -(rxt(k,216)*y(k,56) + rxt(k,217)*y(k,132) + rxt(k,218)*y(k,243) & - + (rxt(k,531) + rxt(k,537) + rxt(k,542)) * y(k,85)) - mat(k,2027) = -rxt(k,216)*y(k,92) - mat(k,1996) = -rxt(k,217)*y(k,92) - mat(k,1654) = -rxt(k,218)*y(k,92) - mat(k,1413) = -(rxt(k,531) + rxt(k,537) + rxt(k,542)) * y(k,92) - mat(k,1968) = rxt(k,205)*y(k,232) - mat(k,870) = rxt(k,210)*y(k,243) - mat(k,1480) = rxt(k,205)*y(k,59) - mat(k,1654) = mat(k,1654) + rxt(k,210)*y(k,60) - mat(k,932) = -(rxt(k,351)*y(k,243)) - mat(k,1670) = -rxt(k,351)*y(k,93) - mat(k,513) = .300_r8*rxt(k,396)*y(k,243) - mat(k,474) = .500_r8*rxt(k,397)*y(k,243) - mat(k,1373) = rxt(k,350)*y(k,229) + rxt(k,357)*y(k,236) - mat(k,497) = rxt(k,350)*y(k,123) - mat(k,1191) = rxt(k,357)*y(k,123) - mat(k,1670) = mat(k,1670) + .300_r8*rxt(k,396)*y(k,99) + .500_r8*rxt(k,397) & - *y(k,100) - mat(k,203) = -(rxt(k,382)*y(k,243)) - mat(k,1588) = -rxt(k,382)*y(k,94) - mat(k,959) = -(rxt(k,336)*y(k,243)) - mat(k,1673) = -rxt(k,336)*y(k,95) - mat(k,514) = .700_r8*rxt(k,396)*y(k,243) - mat(k,475) = .500_r8*rxt(k,397)*y(k,243) - mat(k,480) = .500_r8*rxt(k,371)*y(k,243) - mat(k,1376) = .050_r8*rxt(k,394)*y(k,235) + .220_r8*rxt(k,356)*y(k,236) & - + .250_r8*rxt(k,413)*y(k,250) - mat(k,1795) = .050_r8*rxt(k,395)*y(k,235) + .220_r8*rxt(k,355)*y(k,236) & - + .250_r8*rxt(k,414)*y(k,250) - mat(k,461) = .500_r8*rxt(k,340)*y(k,243) - mat(k,1270) = .220_r8*rxt(k,352)*y(k,236) + .250_r8*rxt(k,410)*y(k,250) - mat(k,1847) = .230_r8*rxt(k,353)*y(k,236) + .200_r8*rxt(k,341)*y(k,246) & - + .100_r8*rxt(k,411)*y(k,250) - mat(k,1222) = .050_r8*rxt(k,394)*y(k,123) + .050_r8*rxt(k,395)*y(k,125) - mat(k,1193) = .220_r8*rxt(k,356)*y(k,123) + .220_r8*rxt(k,355)*y(k,125) & - + .220_r8*rxt(k,352)*y(k,226) + .230_r8*rxt(k,353)*y(k,227) - mat(k,1673) = mat(k,1673) + .700_r8*rxt(k,396)*y(k,99) + .500_r8*rxt(k,397) & - *y(k,100) + .500_r8*rxt(k,371)*y(k,110) + .500_r8*rxt(k,340) & - *y(k,147) - mat(k,1028) = .200_r8*rxt(k,341)*y(k,227) - mat(k,1067) = .250_r8*rxt(k,413)*y(k,123) + .250_r8*rxt(k,414)*y(k,125) & - + .250_r8*rxt(k,410)*y(k,226) + .100_r8*rxt(k,411)*y(k,227) + mat(k,924) = -(rxt(k,207)*y(k,58) + rxt(k,209)*y(k,138) + rxt(k,210)*y(k,251) & + + (rxt(k,551) + rxt(k,556) + rxt(k,561)) * y(k,87)) + mat(k,2243) = -rxt(k,207)*y(k,62) + mat(k,1984) = -rxt(k,209)*y(k,62) + mat(k,1877) = -rxt(k,210)*y(k,62) + mat(k,1958) = -(rxt(k,551) + rxt(k,556) + rxt(k,561)) * y(k,62) + mat(k,1934) = rxt(k,208)*y(k,130) + mat(k,1688) = rxt(k,208)*y(k,61) + mat(k,1135) = -(rxt(k,294)*y(k,251)) + mat(k,1891) = -rxt(k,294)*y(k,64) + mat(k,994) = .230_r8*rxt(k,459)*y(k,139) + mat(k,1454) = rxt(k,230)*y(k,44) + mat(k,327) = .350_r8*rxt(k,296)*y(k,251) + mat(k,601) = .630_r8*rxt(k,298)*y(k,139) + mat(k,1066) = .560_r8*rxt(k,327)*y(k,139) + mat(k,2010) = rxt(k,230)*y(k,19) + rxt(k,194)*y(k,58) + rxt(k,275)*y(k,131) & + + rxt(k,276)*y(k,138) + rxt(k,277)*y(k,251) + mat(k,408) = rxt(k,262)*y(k,58) + mat(k,1260) = rxt(k,333)*y(k,131) + rxt(k,334)*y(k,251) + mat(k,2247) = rxt(k,194)*y(k,44) + rxt(k,262)*y(k,48) + mat(k,971) = rxt(k,321)*y(k,251) + mat(k,877) = .620_r8*rxt(k,404)*y(k,139) + mat(k,1248) = .650_r8*rxt(k,357)*y(k,139) + mat(k,1043) = .230_r8*rxt(k,462)*y(k,139) + mat(k,1368) = .560_r8*rxt(k,371)*y(k,139) + mat(k,1584) = .170_r8*rxt(k,430)*y(k,236) + .220_r8*rxt(k,355)*y(k,244) & + + .400_r8*rxt(k,433)*y(k,245) + .350_r8*rxt(k,436)*y(k,247) & + + .225_r8*rxt(k,471)*y(k,255) + .250_r8*rxt(k,412)*y(k,258) + mat(k,2052) = rxt(k,275)*y(k,44) + rxt(k,333)*y(k,51) + .220_r8*rxt(k,354) & + *y(k,244) + .500_r8*rxt(k,413)*y(k,258) + mat(k,1985) = rxt(k,276)*y(k,44) + rxt(k,483)*y(k,142) + mat(k,2297) = .230_r8*rxt(k,459)*y(k,6) + .630_r8*rxt(k,298)*y(k,27) & + + .560_r8*rxt(k,327)*y(k,31) + .620_r8*rxt(k,404)*y(k,100) & + + .650_r8*rxt(k,357)*y(k,111) + .230_r8*rxt(k,462)*y(k,116) & + + .560_r8*rxt(k,371)*y(k,118) + mat(k,394) = rxt(k,483)*y(k,138) + rxt(k,484)*y(k,251) + mat(k,1116) = .700_r8*rxt(k,480)*y(k,251) + mat(k,1414) = .220_r8*rxt(k,351)*y(k,244) + .250_r8*rxt(k,409)*y(k,258) + mat(k,1638) = .110_r8*rxt(k,352)*y(k,244) + .125_r8*rxt(k,469)*y(k,255) & + + .200_r8*rxt(k,410)*y(k,258) + mat(k,800) = .170_r8*rxt(k,430)*y(k,129) + .070_r8*rxt(k,429)*y(k,240) + mat(k,2196) = .070_r8*rxt(k,429)*y(k,236) + .160_r8*rxt(k,432)*y(k,245) & + + .140_r8*rxt(k,435)*y(k,247) + mat(k,1346) = .220_r8*rxt(k,355)*y(k,129) + .220_r8*rxt(k,354)*y(k,131) & + + .220_r8*rxt(k,351)*y(k,234) + .110_r8*rxt(k,352)*y(k,235) + mat(k,763) = .400_r8*rxt(k,433)*y(k,129) + .160_r8*rxt(k,432)*y(k,240) + mat(k,905) = .350_r8*rxt(k,436)*y(k,129) + .140_r8*rxt(k,435)*y(k,240) + mat(k,1891) = mat(k,1891) + .350_r8*rxt(k,296)*y(k,26) + rxt(k,277)*y(k,44) & + + rxt(k,334)*y(k,51) + rxt(k,321)*y(k,77) + rxt(k,484)*y(k,142) & + + .700_r8*rxt(k,480)*y(k,215) + mat(k,1153) = .225_r8*rxt(k,471)*y(k,129) + .125_r8*rxt(k,469)*y(k,235) + mat(k,1210) = .250_r8*rxt(k,412)*y(k,129) + .500_r8*rxt(k,413)*y(k,131) & + + .250_r8*rxt(k,409)*y(k,234) + .200_r8*rxt(k,410)*y(k,235) + mat(k,983) = .270_r8*rxt(k,459)*y(k,139) + mat(k,1061) = .200_r8*rxt(k,327)*y(k,139) + mat(k,725) = rxt(k,314)*y(k,251) + mat(k,624) = .500_r8*rxt(k,315)*y(k,251) + mat(k,1134) = rxt(k,294)*y(k,251) + mat(k,1139) = .800_r8*rxt(k,320)*y(k,251) + mat(k,969) = rxt(k,321)*y(k,251) + mat(k,1009) = rxt(k,286)*y(k,251) + mat(k,631) = .500_r8*rxt(k,370)*y(k,251) + mat(k,1032) = .270_r8*rxt(k,462)*y(k,139) + mat(k,1364) = .100_r8*rxt(k,371)*y(k,139) + mat(k,1571) = rxt(k,313)*y(k,234) + .900_r8*rxt(k,471)*y(k,255) + mat(k,2283) = .270_r8*rxt(k,459)*y(k,6) + .200_r8*rxt(k,327)*y(k,31) & + + .270_r8*rxt(k,462)*y(k,116) + .100_r8*rxt(k,371)*y(k,118) + mat(k,1113) = 1.800_r8*rxt(k,480)*y(k,251) + mat(k,1411) = rxt(k,313)*y(k,129) + 4.000_r8*rxt(k,310)*y(k,234) & + + .900_r8*rxt(k,311)*y(k,235) + rxt(k,384)*y(k,242) & + + 2.000_r8*rxt(k,360)*y(k,246) + rxt(k,409)*y(k,258) + mat(k,1628) = .900_r8*rxt(k,311)*y(k,234) + rxt(k,361)*y(k,246) & + + .500_r8*rxt(k,469)*y(k,255) + mat(k,2184) = .450_r8*rxt(k,362)*y(k,246) + mat(k,1288) = rxt(k,384)*y(k,234) + mat(k,1390) = 2.000_r8*rxt(k,360)*y(k,234) + rxt(k,361)*y(k,235) & + + .450_r8*rxt(k,362)*y(k,240) + 4.000_r8*rxt(k,363)*y(k,246) + mat(k,1871) = rxt(k,314)*y(k,52) + .500_r8*rxt(k,315)*y(k,53) + rxt(k,294) & + *y(k,64) + .800_r8*rxt(k,320)*y(k,76) + rxt(k,321)*y(k,77) & + + rxt(k,286)*y(k,89) + .500_r8*rxt(k,370)*y(k,115) & + + 1.800_r8*rxt(k,480)*y(k,215) + mat(k,1150) = .900_r8*rxt(k,471)*y(k,129) + .500_r8*rxt(k,469)*y(k,235) + mat(k,1208) = rxt(k,409)*y(k,234) + mat(k,290) = -(rxt(k,255)*y(k,250)) + mat(k,1729) = -rxt(k,255)*y(k,66) + mat(k,179) = rxt(k,220)*y(k,250) + mat(k,184) = rxt(k,246)*y(k,250) + mat(k,190) = rxt(k,222)*y(k,250) + mat(k,157) = 2.000_r8*rxt(k,223)*y(k,250) + mat(k,194) = 2.000_r8*rxt(k,224)*y(k,250) + mat(k,161) = rxt(k,225)*y(k,250) + mat(k,169) = 2.000_r8*rxt(k,248)*y(k,250) + mat(k,286) = rxt(k,272)*y(k,250) + rxt(k,267)*y(k,251) + mat(k,339) = rxt(k,273)*y(k,250) + rxt(k,268)*y(k,251) + mat(k,1729) = mat(k,1729) + rxt(k,220)*y(k,36) + rxt(k,246)*y(k,37) & + + rxt(k,222)*y(k,39) + 2.000_r8*rxt(k,223)*y(k,40) & + + 2.000_r8*rxt(k,224)*y(k,41) + rxt(k,225)*y(k,42) & + + 2.000_r8*rxt(k,248)*y(k,80) + rxt(k,272)*y(k,85) + rxt(k,273) & + *y(k,86) + mat(k,1799) = rxt(k,267)*y(k,85) + rxt(k,268)*y(k,86) + mat(k,269) = -(rxt(k,256)*y(k,250)) + mat(k,1727) = -rxt(k,256)*y(k,67) + mat(k,153) = rxt(k,221)*y(k,250) + mat(k,189) = rxt(k,222)*y(k,250) + mat(k,265) = rxt(k,271)*y(k,250) + rxt(k,266)*y(k,251) + mat(k,1727) = mat(k,1727) + rxt(k,221)*y(k,38) + rxt(k,222)*y(k,39) & + + rxt(k,271)*y(k,84) + mat(k,1794) = rxt(k,266)*y(k,84) + mat(k,237) = -(rxt(k,428)*y(k,251)) + mat(k,1788) = -rxt(k,428)*y(k,68) + mat(k,231) = .180_r8*rxt(k,448)*y(k,251) + mat(k,1788) = mat(k,1788) + .180_r8*rxt(k,448)*y(k,217) + mat(k,318) = -(rxt(k,481)*y(k,131) + (rxt(k,482) + rxt(k,496)) * y(k,251)) + mat(k,2033) = -rxt(k,481)*y(k,69) + mat(k,1804) = -(rxt(k,482) + rxt(k,496)) * y(k,69) + mat(k,752) = rxt(k,316)*y(k,240) + mat(k,2135) = rxt(k,316)*y(k,239) + mat(k,913) = -(rxt(k,251)*y(k,56) + rxt(k,252)*y(k,79) + rxt(k,253)*y(k,261) & + + rxt(k,254)*y(k,91)) + mat(k,1467) = -rxt(k,251)*y(k,75) + mat(k,1440) = -rxt(k,252)*y(k,75) + mat(k,2335) = -rxt(k,253)*y(k,75) + mat(k,1484) = -rxt(k,254)*y(k,75) + mat(k,185) = rxt(k,246)*y(k,250) + mat(k,195) = rxt(k,224)*y(k,250) + mat(k,291) = 2.000_r8*rxt(k,255)*y(k,250) + mat(k,270) = rxt(k,256)*y(k,250) + mat(k,1735) = rxt(k,246)*y(k,37) + rxt(k,224)*y(k,41) + 2.000_r8*rxt(k,255) & + *y(k,66) + rxt(k,256)*y(k,67) + mat(k,1142) = -(rxt(k,320)*y(k,251)) + mat(k,1892) = -rxt(k,320)*y(k,76) + mat(k,658) = .700_r8*rxt(k,395)*y(k,251) + mat(k,584) = .500_r8*rxt(k,396)*y(k,251) + mat(k,441) = rxt(k,407)*y(k,251) + mat(k,1585) = .050_r8*rxt(k,393)*y(k,243) + .530_r8*rxt(k,355)*y(k,244) & + + .225_r8*rxt(k,471)*y(k,255) + .250_r8*rxt(k,412)*y(k,258) + mat(k,2053) = .050_r8*rxt(k,394)*y(k,243) + .530_r8*rxt(k,354)*y(k,244) & + + .250_r8*rxt(k,413)*y(k,258) + mat(k,1415) = .530_r8*rxt(k,351)*y(k,244) + .250_r8*rxt(k,409)*y(k,258) + mat(k,1639) = .260_r8*rxt(k,352)*y(k,244) + .125_r8*rxt(k,469)*y(k,255) & + + .100_r8*rxt(k,410)*y(k,258) + mat(k,1322) = .050_r8*rxt(k,393)*y(k,129) + .050_r8*rxt(k,394)*y(k,131) + mat(k,1347) = .530_r8*rxt(k,355)*y(k,129) + .530_r8*rxt(k,354)*y(k,131) & + + .530_r8*rxt(k,351)*y(k,234) + .260_r8*rxt(k,352)*y(k,235) + mat(k,1892) = mat(k,1892) + .700_r8*rxt(k,395)*y(k,101) + .500_r8*rxt(k,396) & + *y(k,102) + rxt(k,407)*y(k,122) + mat(k,1154) = .225_r8*rxt(k,471)*y(k,129) + .125_r8*rxt(k,469)*y(k,235) + mat(k,1211) = .250_r8*rxt(k,412)*y(k,129) + .250_r8*rxt(k,413)*y(k,131) & + + .250_r8*rxt(k,409)*y(k,234) + .100_r8*rxt(k,410)*y(k,235) + mat(k,970) = -(rxt(k,321)*y(k,251)) + mat(k,1881) = -rxt(k,321)*y(k,77) + mat(k,325) = .650_r8*rxt(k,296)*y(k,251) + mat(k,1140) = .200_r8*rxt(k,320)*y(k,251) + mat(k,1084) = rxt(k,408)*y(k,251) + mat(k,1577) = rxt(k,419)*y(k,229) + .050_r8*rxt(k,393)*y(k,243) & + + .400_r8*rxt(k,433)*y(k,245) + .170_r8*rxt(k,436)*y(k,247) & + + .700_r8*rxt(k,439)*y(k,252) + .600_r8*rxt(k,446)*y(k,257) & + + .250_r8*rxt(k,412)*y(k,258) + .340_r8*rxt(k,452)*y(k,259) & + + .170_r8*rxt(k,455)*y(k,260) + mat(k,2042) = .050_r8*rxt(k,394)*y(k,243) + .250_r8*rxt(k,413)*y(k,258) + mat(k,535) = rxt(k,419)*y(k,129) + mat(k,1412) = .250_r8*rxt(k,409)*y(k,258) + mat(k,1632) = .100_r8*rxt(k,410)*y(k,258) + mat(k,2190) = .160_r8*rxt(k,432)*y(k,245) + .070_r8*rxt(k,435)*y(k,247) + mat(k,1320) = .050_r8*rxt(k,393)*y(k,129) + .050_r8*rxt(k,394)*y(k,131) + mat(k,762) = .400_r8*rxt(k,433)*y(k,129) + .160_r8*rxt(k,432)*y(k,240) + mat(k,904) = .170_r8*rxt(k,436)*y(k,129) + .070_r8*rxt(k,435)*y(k,240) + mat(k,1881) = mat(k,1881) + .650_r8*rxt(k,296)*y(k,26) + .200_r8*rxt(k,320) & + *y(k,76) + rxt(k,408)*y(k,123) + mat(k,497) = .700_r8*rxt(k,439)*y(k,129) + mat(k,775) = .600_r8*rxt(k,446)*y(k,129) + mat(k,1209) = .250_r8*rxt(k,412)*y(k,129) + .250_r8*rxt(k,413)*y(k,131) & + + .250_r8*rxt(k,409)*y(k,234) + .100_r8*rxt(k,410)*y(k,235) + mat(k,791) = .340_r8*rxt(k,452)*y(k,129) + mat(k,542) = .170_r8*rxt(k,455)*y(k,129) + mat(k,1503) = -((rxt(k,154) + rxt(k,155) + rxt(k,156)) * y(k,240) + rxt(k,160) & + *y(k,139)) + mat(k,2215) = -(rxt(k,154) + rxt(k,155) + rxt(k,156)) * y(k,78) + mat(k,2315) = -rxt(k,160)*y(k,78) + mat(k,2015) = rxt(k,277)*y(k,251) + mat(k,1472) = rxt(k,291)*y(k,250) + mat(k,2254) = rxt(k,196)*y(k,79) + mat(k,917) = rxt(k,252)*y(k,79) + mat(k,1444) = rxt(k,196)*y(k,58) + rxt(k,252)*y(k,75) + rxt(k,152)*y(k,138) & + + rxt(k,144)*y(k,250) + rxt(k,161)*y(k,251) + mat(k,851) = rxt(k,250)*y(k,250) + mat(k,1961) = rxt(k,227)*y(k,250) + mat(k,507) = rxt(k,182)*y(k,251) + mat(k,1991) = rxt(k,152)*y(k,79) + rxt(k,164)*y(k,251) + mat(k,396) = rxt(k,484)*y(k,251) + mat(k,562) = rxt(k,490)*y(k,251) + mat(k,1274) = rxt(k,495)*y(k,251) + mat(k,1740) = rxt(k,291)*y(k,56) + rxt(k,144)*y(k,79) + rxt(k,250)*y(k,83) & + + rxt(k,227)*y(k,87) + mat(k,1912) = rxt(k,277)*y(k,44) + rxt(k,161)*y(k,79) + rxt(k,182)*y(k,119) & + + rxt(k,164)*y(k,138) + rxt(k,484)*y(k,142) + rxt(k,490) & + *y(k,155) + rxt(k,495)*y(k,157) + mat(k,1441) = -(rxt(k,144)*y(k,250) + rxt(k,152)*y(k,138) + rxt(k,161) & + *y(k,251) + rxt(k,196)*y(k,58) + rxt(k,252)*y(k,75)) + mat(k,1736) = -rxt(k,144)*y(k,79) + mat(k,1987) = -rxt(k,152)*y(k,79) + mat(k,1908) = -rxt(k,161)*y(k,79) + mat(k,2250) = -rxt(k,196)*y(k,79) + mat(k,914) = -rxt(k,252)*y(k,79) + mat(k,1469) = rxt(k,292)*y(k,250) + mat(k,1500) = rxt(k,154)*y(k,240) + mat(k,2211) = rxt(k,154)*y(k,78) + mat(k,1736) = mat(k,1736) + rxt(k,292)*y(k,56) end do end subroutine nlnmat03 subroutine nlnmat04( avec_len, mat, y, rxt ) @@ -731,266 +757,207 @@ subroutine nlnmat04( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,281) = -(rxt(k,383)*y(k,243)) - mat(k,1598) = -rxt(k,383)*y(k,96) - mat(k,1337) = .870_r8*rxt(k,394)*y(k,235) - mat(k,1777) = .950_r8*rxt(k,395)*y(k,235) - mat(k,1262) = rxt(k,390)*y(k,235) - mat(k,1831) = .750_r8*rxt(k,391)*y(k,235) - mat(k,1211) = .870_r8*rxt(k,394)*y(k,123) + .950_r8*rxt(k,395)*y(k,125) & - + rxt(k,390)*y(k,226) + .750_r8*rxt(k,391)*y(k,227) - mat(k,103) = -(rxt(k,384)*y(k,243)) - mat(k,1572) = -rxt(k,384)*y(k,97) - mat(k,595) = .600_r8*rxt(k,407)*y(k,243) - mat(k,1572) = mat(k,1572) + .600_r8*rxt(k,407)*y(k,103) - mat(k,766) = -(rxt(k,398)*y(k,125) + rxt(k,405)*y(k,133) + rxt(k,406) & - *y(k,243)) - mat(k,1782) = -rxt(k,398)*y(k,98) - mat(k,1895) = -rxt(k,405)*y(k,98) - mat(k,1658) = -rxt(k,406)*y(k,98) - mat(k,511) = -(rxt(k,396)*y(k,243)) - mat(k,1631) = -rxt(k,396)*y(k,99) - mat(k,1350) = .080_r8*rxt(k,388)*y(k,234) - mat(k,1140) = .080_r8*rxt(k,388)*y(k,123) - mat(k,471) = -(rxt(k,397)*y(k,243)) - mat(k,1627) = -rxt(k,397)*y(k,100) - mat(k,1348) = .080_r8*rxt(k,394)*y(k,235) - mat(k,1212) = .080_r8*rxt(k,394)*y(k,123) - mat(k,1088) = -(rxt(k,399)*y(k,226) + rxt(k,400)*y(k,227) + rxt(k,401) & - *y(k,232) + rxt(k,402)*y(k,123) + rxt(k,403)*y(k,125)) - mat(k,1272) = -rxt(k,399)*y(k,101) - mat(k,1854) = -rxt(k,400)*y(k,101) - mat(k,1499) = -rxt(k,401)*y(k,101) - mat(k,1383) = -rxt(k,402)*y(k,101) - mat(k,1802) = -rxt(k,403)*y(k,101) - mat(k,769) = rxt(k,398)*y(k,125) - mat(k,1802) = mat(k,1802) + rxt(k,398)*y(k,98) - mat(k,322) = -(rxt(k,404)*y(k,243)) - mat(k,1605) = -rxt(k,404)*y(k,102) - mat(k,1080) = rxt(k,401)*y(k,232) - mat(k,1442) = rxt(k,401)*y(k,101) - mat(k,596) = -(rxt(k,407)*y(k,243)) - mat(k,1641) = -rxt(k,407)*y(k,103) - mat(k,1468) = rxt(k,387)*y(k,234) + rxt(k,392)*y(k,235) - mat(k,1141) = rxt(k,387)*y(k,232) - mat(k,1214) = rxt(k,392)*y(k,232) - mat(k,61) = -(rxt(k,521)*y(k,243)) - mat(k,1555) = -rxt(k,521)*y(k,104) - mat(k,77) = -(rxt(k,522)*y(k,243)) - mat(k,1566) = -rxt(k,522)*y(k,105) - mat(k,1104) = -(rxt(k,358)*y(k,133) + rxt(k,359)*y(k,243)) - mat(k,1913) = -rxt(k,358)*y(k,106) - mat(k,1682) = -rxt(k,359)*y(k,106) - mat(k,770) = .300_r8*rxt(k,405)*y(k,133) - mat(k,1384) = .360_r8*rxt(k,388)*y(k,234) - mat(k,1803) = .400_r8*rxt(k,389)*y(k,234) - mat(k,1913) = mat(k,1913) + .300_r8*rxt(k,405)*y(k,98) - mat(k,1273) = .390_r8*rxt(k,385)*y(k,234) - mat(k,1855) = .310_r8*rxt(k,386)*y(k,234) - mat(k,1150) = .360_r8*rxt(k,388)*y(k,123) + .400_r8*rxt(k,389)*y(k,125) & - + .390_r8*rxt(k,385)*y(k,226) + .310_r8*rxt(k,386)*y(k,227) - mat(k,289) = -(rxt(k,360)*y(k,243)) - mat(k,1600) = -rxt(k,360)*y(k,107) - mat(k,1440) = rxt(k,354)*y(k,236) - mat(k,1188) = rxt(k,354)*y(k,232) - mat(k,447) = -(rxt(k,369)*y(k,243)) - mat(k,1623) = -rxt(k,369)*y(k,108) - mat(k,1346) = .800_r8*rxt(k,378)*y(k,220) - mat(k,848) = .800_r8*rxt(k,378)*y(k,123) - mat(k,284) = -(rxt(k,370)*y(k,243)) - mat(k,1599) = -rxt(k,370)*y(k,109) - mat(k,1439) = .800_r8*rxt(k,367)*y(k,240) - mat(k,587) = .800_r8*rxt(k,367)*y(k,232) - mat(k,479) = -(rxt(k,371)*y(k,243)) - mat(k,1628) = -rxt(k,371)*y(k,110) - mat(k,1739) = rxt(k,374)*y(k,238) - mat(k,1246) = rxt(k,374)*y(k,124) - mat(k,805) = -(rxt(k,462)*y(k,125) + rxt(k,463)*y(k,133) + rxt(k,464) & - *y(k,243)) - mat(k,1784) = -rxt(k,462)*y(k,111) - mat(k,1897) = -rxt(k,463)*y(k,111) - mat(k,1661) = -rxt(k,464)*y(k,111) - mat(k,1174) = -(rxt(k,372)*y(k,133) + rxt(k,373)*y(k,243)) - mat(k,1917) = -rxt(k,372)*y(k,112) - mat(k,1686) = -rxt(k,373)*y(k,112) - mat(k,772) = .200_r8*rxt(k,405)*y(k,133) - mat(k,1387) = .560_r8*rxt(k,388)*y(k,234) - mat(k,1807) = .600_r8*rxt(k,389)*y(k,234) - mat(k,1917) = mat(k,1917) + .200_r8*rxt(k,405)*y(k,98) - mat(k,1276) = .610_r8*rxt(k,385)*y(k,234) - mat(k,1858) = .440_r8*rxt(k,386)*y(k,234) - mat(k,1153) = .560_r8*rxt(k,388)*y(k,123) + .600_r8*rxt(k,389)*y(k,125) & - + .610_r8*rxt(k,385)*y(k,226) + .440_r8*rxt(k,386)*y(k,227) - mat(k,364) = -(rxt(k,170)*y(k,123) + (rxt(k,171) + rxt(k,172) + rxt(k,173) & - ) * y(k,124) + rxt(k,182)*y(k,243)) - mat(k,1338) = -rxt(k,170)*y(k,113) - mat(k,1735) = -(rxt(k,171) + rxt(k,172) + rxt(k,173)) * y(k,113) - mat(k,1611) = -rxt(k,182)*y(k,113) - mat(k,1733) = rxt(k,189)*y(k,125) - mat(k,1775) = rxt(k,189)*y(k,124) - mat(k,310) = -(rxt(k,408)*y(k,243)) - mat(k,1603) = -rxt(k,408)*y(k,116) - mat(k,1079) = .200_r8*rxt(k,400)*y(k,227) - mat(k,1832) = .200_r8*rxt(k,400)*y(k,101) - mat(k,912) = -(rxt(k,409)*y(k,243)) - mat(k,1668) = -rxt(k,409)*y(k,117) - mat(k,1084) = rxt(k,402)*y(k,123) + rxt(k,403)*y(k,125) + rxt(k,399)*y(k,226) & - + .800_r8*rxt(k,400)*y(k,227) - mat(k,1371) = rxt(k,402)*y(k,101) - mat(k,1790) = rxt(k,403)*y(k,101) - mat(k,1267) = rxt(k,399)*y(k,101) - mat(k,1843) = .800_r8*rxt(k,400)*y(k,101) - mat(k,90) = -(rxt(k,499)*y(k,243)) - mat(k,1569) = -rxt(k,499)*y(k,121) - mat(k,1395) = -(rxt(k,170)*y(k,113) + rxt(k,179)*y(k,125) + rxt(k,183) & - *y(k,232) + rxt(k,184)*y(k,133) + rxt(k,185)*y(k,132) + rxt(k,206) & - *y(k,59) + rxt(k,238)*y(k,19) + rxt(k,281)*y(k,227) + rxt(k,290) & - *y(k,233) + rxt(k,303)*y(k,223) + rxt(k,314)*y(k,226) + rxt(k,318) & - *y(k,231) + rxt(k,331)*y(k,224) + rxt(k,339)*y(k,245) + rxt(k,343) & - *y(k,246) + (rxt(k,349) + rxt(k,350)) * y(k,229) + (rxt(k,356) & - + rxt(k,357)) * y(k,236) + rxt(k,365)*y(k,238) + rxt(k,368) & - *y(k,240) + (rxt(k,378) + rxt(k,379)) * y(k,220) + rxt(k,388) & - *y(k,234) + rxt(k,394)*y(k,235) + rxt(k,402)*y(k,101) + rxt(k,413) & - *y(k,250) + rxt(k,417)*y(k,219) + rxt(k,420)*y(k,221) + rxt(k,425) & - *y(k,222) + rxt(k,427)*y(k,225) + rxt(k,431)*y(k,228) + rxt(k,434) & - *y(k,237) + rxt(k,437)*y(k,239) + rxt(k,440)*y(k,244) + rxt(k,447) & - *y(k,249) + rxt(k,453)*y(k,251) + rxt(k,456)*y(k,252) + rxt(k,467) & - *y(k,241) + rxt(k,472)*y(k,247) + rxt(k,477)*y(k,248)) - mat(k,366) = -rxt(k,170)*y(k,123) - mat(k,1815) = -rxt(k,179)*y(k,123) - mat(k,1511) = -rxt(k,183)*y(k,123) - mat(k,1925) = -rxt(k,184)*y(k,123) - mat(k,2005) = -rxt(k,185)*y(k,123) - mat(k,1975) = -rxt(k,206)*y(k,123) - mat(k,1949) = -rxt(k,238)*y(k,123) - mat(k,1865) = -rxt(k,281)*y(k,123) - mat(k,386) = -rxt(k,290)*y(k,123) - mat(k,741) = -rxt(k,303)*y(k,123) - mat(k,1283) = -rxt(k,314)*y(k,123) - mat(k,622) = -rxt(k,318)*y(k,123) - mat(k,713) = -rxt(k,331)*y(k,123) - mat(k,677) = -rxt(k,339)*y(k,123) - mat(k,1032) = -rxt(k,343)*y(k,123) - mat(k,499) = -(rxt(k,349) + rxt(k,350)) * y(k,123) - mat(k,1202) = -(rxt(k,356) + rxt(k,357)) * y(k,123) - mat(k,1253) = -rxt(k,365)*y(k,123) - mat(k,591) = -rxt(k,368)*y(k,123) - mat(k,857) = -(rxt(k,378) + rxt(k,379)) * y(k,123) - mat(k,1159) = -rxt(k,388)*y(k,123) - mat(k,1235) = -rxt(k,394)*y(k,123) - mat(k,1095) = -rxt(k,402)*y(k,123) - mat(k,1072) = -rxt(k,413)*y(k,123) - mat(k,455) = -rxt(k,417)*y(k,123) - mat(k,423) = -rxt(k,420)*y(k,123) - mat(k,380) = -rxt(k,425)*y(k,123) - mat(k,560) = -rxt(k,427)*y(k,123) - mat(k,668) = -rxt(k,431)*y(k,123) - mat(k,630) = -rxt(k,434)*y(k,123) - mat(k,786) = -rxt(k,437)*y(k,123) - mat(k,393) = -rxt(k,440)*y(k,123) - mat(k,644) = -rxt(k,447)*y(k,123) - mat(k,661) = -rxt(k,453)*y(k,123) - mat(k,431) = -rxt(k,456)*y(k,123) - mat(k,1018) = -rxt(k,467)*y(k,123) - mat(k,999) = -rxt(k,472)*y(k,123) - mat(k,979) = -rxt(k,477)*y(k,123) - mat(k,366) = mat(k,366) + 2.000_r8*rxt(k,172)*y(k,124) + rxt(k,182)*y(k,243) - mat(k,1758) = 2.000_r8*rxt(k,172)*y(k,113) + rxt(k,175)*y(k,132) + rxt(k,491) & - *y(k,151) - mat(k,2005) = mat(k,2005) + rxt(k,175)*y(k,124) - mat(k,1130) = rxt(k,491)*y(k,124) - mat(k,1694) = rxt(k,182)*y(k,113) - mat(k,1764) = -((rxt(k,171) + rxt(k,172) + rxt(k,173)) * y(k,113) + (rxt(k,175) & - + rxt(k,177)) * y(k,132) + rxt(k,176)*y(k,133) + rxt(k,188) & - *y(k,232) + rxt(k,189)*y(k,125) + rxt(k,190)*y(k,243) + rxt(k,208) & - *y(k,59) + rxt(k,239)*y(k,19) + rxt(k,325)*y(k,226) + rxt(k,374) & - *y(k,238) + rxt(k,432)*y(k,228) + rxt(k,435)*y(k,237) + rxt(k,438) & - *y(k,239) + rxt(k,442)*y(k,140) + rxt(k,445)*y(k,219) + rxt(k,491) & - *y(k,151)) - mat(k,368) = -(rxt(k,171) + rxt(k,172) + rxt(k,173)) * y(k,124) - mat(k,2011) = -(rxt(k,175) + rxt(k,177)) * y(k,124) - mat(k,1931) = -rxt(k,176)*y(k,124) - mat(k,1517) = -rxt(k,188)*y(k,124) - mat(k,1821) = -rxt(k,189)*y(k,124) - mat(k,1700) = -rxt(k,190)*y(k,124) - mat(k,1981) = -rxt(k,208)*y(k,124) - mat(k,1955) = -rxt(k,239)*y(k,124) - mat(k,1287) = -rxt(k,325)*y(k,124) - mat(k,1257) = -rxt(k,374)*y(k,124) - mat(k,671) = -rxt(k,432)*y(k,124) - mat(k,632) = -rxt(k,435)*y(k,124) - mat(k,789) = -rxt(k,438)*y(k,124) - mat(k,402) = -rxt(k,442)*y(k,124) - mat(k,458) = -rxt(k,445)*y(k,124) - mat(k,1133) = -rxt(k,491)*y(k,124) - mat(k,575) = rxt(k,376)*y(k,243) - mat(k,300) = rxt(k,347)*y(k,125) - mat(k,1955) = mat(k,1955) + rxt(k,238)*y(k,123) - mat(k,1981) = mat(k,1981) + rxt(k,206)*y(k,123) - mat(k,361) = rxt(k,169)*y(k,243) - mat(k,519) = .700_r8*rxt(k,396)*y(k,243) - mat(k,1099) = rxt(k,402)*y(k,123) + rxt(k,403)*y(k,125) - mat(k,1401) = rxt(k,238)*y(k,19) + rxt(k,206)*y(k,59) + rxt(k,402)*y(k,101) & - + 2.000_r8*rxt(k,179)*y(k,125) + rxt(k,185)*y(k,132) & - + rxt(k,184)*y(k,133) + rxt(k,417)*y(k,219) + rxt(k,378) & - *y(k,220) + rxt(k,420)*y(k,221) + rxt(k,425)*y(k,222) & - + rxt(k,303)*y(k,223) + rxt(k,331)*y(k,224) + rxt(k,427) & - *y(k,225) + rxt(k,314)*y(k,226) + rxt(k,281)*y(k,227) & - + rxt(k,431)*y(k,228) + rxt(k,349)*y(k,229) + rxt(k,318) & - *y(k,231) + rxt(k,183)*y(k,232) + rxt(k,290)*y(k,233) & - + .920_r8*rxt(k,388)*y(k,234) + .920_r8*rxt(k,394)*y(k,235) & - + rxt(k,356)*y(k,236) + rxt(k,434)*y(k,237) + rxt(k,365) & - *y(k,238) + rxt(k,437)*y(k,239) + rxt(k,368)*y(k,240) & - + 1.600_r8*rxt(k,467)*y(k,241) + rxt(k,440)*y(k,244) & - + rxt(k,339)*y(k,245) + rxt(k,343)*y(k,246) + .900_r8*rxt(k,472) & - *y(k,247) + .800_r8*rxt(k,477)*y(k,248) + rxt(k,447)*y(k,249) & - + rxt(k,413)*y(k,250) + rxt(k,453)*y(k,251) + rxt(k,456) & - *y(k,252) - mat(k,1821) = mat(k,1821) + rxt(k,347)*y(k,16) + rxt(k,403)*y(k,101) & - + 2.000_r8*rxt(k,179)*y(k,123) + rxt(k,180)*y(k,132) & - + rxt(k,178)*y(k,232) + rxt(k,389)*y(k,234) + rxt(k,395) & - *y(k,235) + rxt(k,355)*y(k,236) + rxt(k,366)*y(k,238) & - + 2.000_r8*rxt(k,468)*y(k,241) + rxt(k,181)*y(k,243) & - + rxt(k,414)*y(k,250) - mat(k,752) = rxt(k,337)*y(k,243) - mat(k,2011) = mat(k,2011) + rxt(k,185)*y(k,123) + rxt(k,180)*y(k,125) - mat(k,1931) = mat(k,1931) + rxt(k,184)*y(k,123) - mat(k,556) = rxt(k,474)*y(k,243) - mat(k,458) = mat(k,458) + rxt(k,417)*y(k,123) - mat(k,861) = rxt(k,378)*y(k,123) - mat(k,426) = rxt(k,420)*y(k,123) - mat(k,383) = rxt(k,425)*y(k,123) - mat(k,745) = rxt(k,303)*y(k,123) - mat(k,717) = rxt(k,331)*y(k,123) - mat(k,563) = rxt(k,427)*y(k,123) - mat(k,1287) = mat(k,1287) + rxt(k,314)*y(k,123) - mat(k,1871) = rxt(k,281)*y(k,123) + .500_r8*rxt(k,465)*y(k,241) - mat(k,671) = mat(k,671) + rxt(k,431)*y(k,123) - mat(k,502) = rxt(k,349)*y(k,123) - mat(k,626) = rxt(k,318)*y(k,123) - mat(k,1517) = mat(k,1517) + rxt(k,183)*y(k,123) + rxt(k,178)*y(k,125) - mat(k,389) = rxt(k,290)*y(k,123) - mat(k,1163) = .920_r8*rxt(k,388)*y(k,123) + rxt(k,389)*y(k,125) - mat(k,1239) = .920_r8*rxt(k,394)*y(k,123) + rxt(k,395)*y(k,125) - mat(k,1206) = rxt(k,356)*y(k,123) + rxt(k,355)*y(k,125) - mat(k,632) = mat(k,632) + rxt(k,434)*y(k,123) - mat(k,1257) = mat(k,1257) + rxt(k,365)*y(k,123) + rxt(k,366)*y(k,125) - mat(k,789) = mat(k,789) + rxt(k,437)*y(k,123) - mat(k,594) = rxt(k,368)*y(k,123) - mat(k,1022) = 1.600_r8*rxt(k,467)*y(k,123) + 2.000_r8*rxt(k,468)*y(k,125) & - + .500_r8*rxt(k,465)*y(k,227) - mat(k,1700) = mat(k,1700) + rxt(k,376)*y(k,1) + rxt(k,169)*y(k,90) & - + .700_r8*rxt(k,396)*y(k,99) + rxt(k,181)*y(k,125) + rxt(k,337) & - *y(k,126) + rxt(k,474)*y(k,206) - mat(k,396) = rxt(k,440)*y(k,123) - mat(k,681) = rxt(k,339)*y(k,123) - mat(k,1036) = rxt(k,343)*y(k,123) - mat(k,1003) = .900_r8*rxt(k,472)*y(k,123) - mat(k,983) = .800_r8*rxt(k,477)*y(k,123) - mat(k,647) = rxt(k,447)*y(k,123) - mat(k,1076) = rxt(k,413)*y(k,123) + rxt(k,414)*y(k,125) - mat(k,664) = rxt(k,453)*y(k,123) - mat(k,434) = rxt(k,456)*y(k,123) + mat(k,168) = -(rxt(k,248)*y(k,250)) + mat(k,1719) = -rxt(k,248)*y(k,80) + mat(k,639) = -(rxt(k,153)*y(k,138) + rxt(k,162)*y(k,251) + rxt(k,197)*y(k,58)) + mat(k,1979) = -rxt(k,153)*y(k,81) + mat(k,1847) = -rxt(k,162)*y(k,81) + mat(k,2239) = -rxt(k,197)*y(k,81) + mat(k,2163) = 2.000_r8*rxt(k,168)*y(k,240) + mat(k,1847) = mat(k,1847) + 2.000_r8*rxt(k,167)*y(k,251) + mat(k,298) = rxt(k,497)*y(k,261) + mat(k,2331) = rxt(k,497)*y(k,159) + mat(k,849) = -(rxt(k,243)*y(k,138) + rxt(k,244)*y(k,251) + (rxt(k,249) & + + rxt(k,250)) * y(k,250)) + mat(k,1982) = -rxt(k,243)*y(k,83) + mat(k,1869) = -rxt(k,244)*y(k,83) + mat(k,1734) = -(rxt(k,249) + rxt(k,250)) * y(k,83) + mat(k,1453) = rxt(k,230)*y(k,44) + rxt(k,231)*y(k,240) + mat(k,2008) = rxt(k,230)*y(k,19) + mat(k,2182) = rxt(k,231)*y(k,19) + mat(k,264) = -(rxt(k,266)*y(k,251) + rxt(k,271)*y(k,250)) + mat(k,1793) = -rxt(k,266)*y(k,84) + mat(k,1726) = -rxt(k,271)*y(k,84) + mat(k,285) = -(rxt(k,267)*y(k,251) + rxt(k,272)*y(k,250)) + mat(k,1798) = -rxt(k,267)*y(k,85) + mat(k,1728) = -rxt(k,272)*y(k,85) + mat(k,340) = -(rxt(k,268)*y(k,251) + rxt(k,273)*y(k,250)) + mat(k,1807) = -rxt(k,268)*y(k,86) + mat(k,1730) = -rxt(k,273)*y(k,86) + mat(k,1967) = -(rxt(k,214)*y(k,138) + rxt(k,215)*y(k,251) + (rxt(k,226) & + + rxt(k,227)) * y(k,250) + (rxt(k,546) + rxt(k,552) + rxt(k,557) & + ) * y(k,94) + (rxt(k,551) + rxt(k,556) + rxt(k,561)) * y(k,62) & + + (rxt(k,553) + rxt(k,558)) * y(k,93)) + mat(k,1998) = -rxt(k,214)*y(k,87) + mat(k,1919) = -rxt(k,215)*y(k,87) + mat(k,1747) = -(rxt(k,226) + rxt(k,227)) * y(k,87) + mat(k,845) = -(rxt(k,546) + rxt(k,552) + rxt(k,557)) * y(k,87) + mat(k,929) = -(rxt(k,551) + rxt(k,556) + rxt(k,561)) * y(k,87) + mat(k,821) = -(rxt(k,553) + rxt(k,558)) * y(k,87) + mat(k,333) = rxt(k,305)*y(k,58) + mat(k,521) = rxt(k,257)*y(k,58) + mat(k,2022) = rxt(k,194)*y(k,58) + mat(k,619) = rxt(k,259)*y(k,58) + mat(k,411) = 2.000_r8*rxt(k,262)*y(k,58) + mat(k,1476) = rxt(k,195)*y(k,58) + mat(k,461) = rxt(k,264)*y(k,58) + mat(k,2261) = rxt(k,305)*y(k,30) + rxt(k,257)*y(k,43) + rxt(k,194)*y(k,44) & + + rxt(k,259)*y(k,45) + 2.000_r8*rxt(k,262)*y(k,48) + rxt(k,195) & + *y(k,56) + rxt(k,264)*y(k,57) + rxt(k,196)*y(k,79) + rxt(k,197) & + *y(k,81) + rxt(k,216)*y(k,94) + rxt(k,198)*y(k,240) + mat(k,1945) = rxt(k,213)*y(k,251) + mat(k,1448) = rxt(k,196)*y(k,58) + mat(k,641) = rxt(k,197)*y(k,58) + mat(k,845) = mat(k,845) + rxt(k,216)*y(k,58) + mat(k,2222) = rxt(k,198)*y(k,58) + mat(k,1919) = mat(k,1919) + rxt(k,213)*y(k,61) + mat(k,225) = -(rxt(k,285)*y(k,251) + rxt(k,293)*y(k,250)) + mat(k,1786) = -rxt(k,285)*y(k,88) + mat(k,1725) = -rxt(k,293)*y(k,88) + mat(k,1010) = -(rxt(k,286)*y(k,251)) + mat(k,1883) = -rxt(k,286)*y(k,89) + mat(k,989) = .050_r8*rxt(k,459)*y(k,139) + mat(k,326) = .350_r8*rxt(k,296)*y(k,251) + mat(k,600) = .370_r8*rxt(k,298)*y(k,139) + mat(k,1063) = .120_r8*rxt(k,327)*y(k,139) + mat(k,875) = .110_r8*rxt(k,404)*y(k,139) + mat(k,1247) = .330_r8*rxt(k,357)*y(k,139) + mat(k,1037) = .050_r8*rxt(k,462)*y(k,139) + mat(k,1365) = .120_r8*rxt(k,371)*y(k,139) + mat(k,1578) = rxt(k,289)*y(k,241) + mat(k,2290) = .050_r8*rxt(k,459)*y(k,6) + .370_r8*rxt(k,298)*y(k,27) & + + .120_r8*rxt(k,327)*y(k,31) + .110_r8*rxt(k,404)*y(k,100) & + + .330_r8*rxt(k,357)*y(k,111) + .050_r8*rxt(k,462)*y(k,116) & + + .120_r8*rxt(k,371)*y(k,118) + mat(k,2191) = rxt(k,287)*y(k,241) + mat(k,490) = rxt(k,289)*y(k,129) + rxt(k,287)*y(k,240) + mat(k,1883) = mat(k,1883) + .350_r8*rxt(k,296)*y(k,26) + mat(k,1465) = rxt(k,251)*y(k,75) + mat(k,912) = rxt(k,251)*y(k,56) + rxt(k,252)*y(k,79) + rxt(k,254)*y(k,91) & + + rxt(k,253)*y(k,261) + mat(k,1439) = rxt(k,252)*y(k,75) + mat(k,1483) = rxt(k,254)*y(k,75) + mat(k,2333) = rxt(k,253)*y(k,75) + mat(k,1487) = -(rxt(k,191)*y(k,251) + rxt(k,254)*y(k,75)) + mat(k,1911) = -rxt(k,191)*y(k,91) + mat(k,916) = -rxt(k,254)*y(k,91) + mat(k,2014) = rxt(k,275)*y(k,131) + mat(k,1128) = rxt(k,307)*y(k,131) + mat(k,1263) = rxt(k,333)*y(k,131) + mat(k,925) = (rxt(k,551)+rxt(k,556)+rxt(k,561))*y(k,87) + mat(k,320) = rxt(k,481)*y(k,131) + mat(k,1960) = (rxt(k,551)+rxt(k,556)+rxt(k,561))*y(k,62) + mat(k,1698) = rxt(k,190)*y(k,251) + mat(k,2071) = rxt(k,275)*y(k,44) + rxt(k,307)*y(k,47) + rxt(k,333)*y(k,51) & + + rxt(k,481)*y(k,69) + mat(k,1911) = mat(k,1911) + rxt(k,190)*y(k,130) + mat(k,445) = -(rxt(k,169)*y(k,251)) + mat(k,1822) = -rxt(k,169)*y(k,92) + mat(k,1674) = rxt(k,188)*y(k,240) + mat(k,2148) = rxt(k,188)*y(k,130) + mat(k,818) = -(rxt(k,245)*y(k,138) + (rxt(k,553) + rxt(k,558)) * y(k,87)) + mat(k,1980) = -rxt(k,245)*y(k,93) + mat(k,1956) = -(rxt(k,553) + rxt(k,558)) * y(k,93) + mat(k,2091) = rxt(k,237)*y(k,240) + mat(k,2179) = rxt(k,237)*y(k,21) + mat(k,842) = -(rxt(k,216)*y(k,58) + rxt(k,217)*y(k,138) + rxt(k,218)*y(k,251) & + + (rxt(k,546) + rxt(k,552) + rxt(k,557)) * y(k,87)) + mat(k,2241) = -rxt(k,216)*y(k,94) + mat(k,1981) = -rxt(k,217)*y(k,94) + mat(k,1868) = -rxt(k,218)*y(k,94) + mat(k,1957) = -(rxt(k,546) + rxt(k,552) + rxt(k,557)) * y(k,94) + mat(k,1932) = rxt(k,205)*y(k,240) + mat(k,923) = rxt(k,210)*y(k,251) + mat(k,2181) = rxt(k,205)*y(k,61) + mat(k,1868) = mat(k,1868) + rxt(k,210)*y(k,62) + mat(k,1193) = -(rxt(k,350)*y(k,251)) + mat(k,1896) = -rxt(k,350)*y(k,95) + mat(k,660) = .300_r8*rxt(k,395)*y(k,251) + mat(k,586) = .500_r8*rxt(k,396)*y(k,251) + mat(k,1589) = rxt(k,349)*y(k,237) + rxt(k,356)*y(k,244) + mat(k,609) = rxt(k,349)*y(k,129) + mat(k,1349) = rxt(k,356)*y(k,129) + mat(k,1896) = mat(k,1896) + .300_r8*rxt(k,395)*y(k,101) + .500_r8*rxt(k,396) & + *y(k,102) + mat(k,293) = -(rxt(k,381)*y(k,251)) + mat(k,1800) = -rxt(k,381)*y(k,96) + mat(k,1180) = -(rxt(k,335)*y(k,251)) + mat(k,1895) = -rxt(k,335)*y(k,97) + mat(k,659) = .700_r8*rxt(k,395)*y(k,251) + mat(k,585) = .500_r8*rxt(k,396)*y(k,251) + mat(k,632) = .500_r8*rxt(k,370)*y(k,251) + mat(k,1588) = .050_r8*rxt(k,393)*y(k,243) + .220_r8*rxt(k,355)*y(k,244) & + + .250_r8*rxt(k,412)*y(k,258) + mat(k,2056) = .050_r8*rxt(k,394)*y(k,243) + .220_r8*rxt(k,354)*y(k,244) & + + .250_r8*rxt(k,413)*y(k,258) + mat(k,593) = .500_r8*rxt(k,339)*y(k,251) + mat(k,1416) = .220_r8*rxt(k,351)*y(k,244) + .250_r8*rxt(k,409)*y(k,258) + mat(k,1642) = .230_r8*rxt(k,352)*y(k,244) + .200_r8*rxt(k,340)*y(k,254) & + + .100_r8*rxt(k,410)*y(k,258) + mat(k,1323) = .050_r8*rxt(k,393)*y(k,129) + .050_r8*rxt(k,394)*y(k,131) + mat(k,1348) = .220_r8*rxt(k,355)*y(k,129) + .220_r8*rxt(k,354)*y(k,131) & + + .220_r8*rxt(k,351)*y(k,234) + .230_r8*rxt(k,352)*y(k,235) + mat(k,1895) = mat(k,1895) + .700_r8*rxt(k,395)*y(k,101) + .500_r8*rxt(k,396) & + *y(k,102) + .500_r8*rxt(k,370)*y(k,115) + .500_r8*rxt(k,339) & + *y(k,153) + mat(k,1170) = .200_r8*rxt(k,340)*y(k,235) + mat(k,1212) = .250_r8*rxt(k,412)*y(k,129) + .250_r8*rxt(k,413)*y(k,131) & + + .250_r8*rxt(k,409)*y(k,234) + .100_r8*rxt(k,410)*y(k,235) + mat(k,383) = -(rxt(k,382)*y(k,251)) + mat(k,1812) = -rxt(k,382)*y(k,98) + mat(k,1544) = .870_r8*rxt(k,393)*y(k,243) + mat(k,2035) = .950_r8*rxt(k,394)*y(k,243) + mat(k,1407) = rxt(k,389)*y(k,243) + mat(k,1620) = .750_r8*rxt(k,390)*y(k,243) + mat(k,1313) = .870_r8*rxt(k,393)*y(k,129) + .950_r8*rxt(k,394)*y(k,131) & + + rxt(k,389)*y(k,234) + .750_r8*rxt(k,390)*y(k,235) + mat(k,172) = -(rxt(k,383)*y(k,251)) + mat(k,1782) = -rxt(k,383)*y(k,99) + mat(k,729) = .600_r8*rxt(k,406)*y(k,251) + mat(k,1782) = mat(k,1782) + .600_r8*rxt(k,406)*y(k,106) + mat(k,874) = -(rxt(k,397)*y(k,131) + rxt(k,404)*y(k,139) + rxt(k,405) & + *y(k,251)) + mat(k,2038) = -rxt(k,397)*y(k,100) + mat(k,2284) = -rxt(k,404)*y(k,100) + mat(k,1872) = -rxt(k,405)*y(k,100) + mat(k,657) = -(rxt(k,395)*y(k,251)) + mat(k,1849) = -rxt(k,395)*y(k,101) + mat(k,1557) = .080_r8*rxt(k,387)*y(k,242) + mat(k,1285) = .080_r8*rxt(k,387)*y(k,129) + mat(k,582) = -(rxt(k,396)*y(k,251)) + mat(k,1840) = -rxt(k,396)*y(k,102) + mat(k,1555) = .080_r8*rxt(k,393)*y(k,243) + mat(k,1314) = .080_r8*rxt(k,393)*y(k,129) + mat(k,1233) = -(rxt(k,398)*y(k,234) + rxt(k,399)*y(k,235) + rxt(k,400) & + *y(k,240) + rxt(k,401)*y(k,129) + rxt(k,402)*y(k,131)) + mat(k,1418) = -rxt(k,398)*y(k,103) + mat(k,1644) = -rxt(k,399)*y(k,103) + mat(k,2202) = -rxt(k,400)*y(k,103) + mat(k,1591) = -rxt(k,401)*y(k,103) + mat(k,2059) = -rxt(k,402)*y(k,103) + mat(k,878) = rxt(k,397)*y(k,131) + mat(k,2059) = mat(k,2059) + rxt(k,397)*y(k,100) + mat(k,433) = -(rxt(k,403)*y(k,251)) + mat(k,1820) = -rxt(k,403)*y(k,104) + mat(k,1224) = rxt(k,400)*y(k,240) + mat(k,2147) = rxt(k,400)*y(k,103) + mat(k,86) = -(rxt(k,521)*y(k,240) + rxt(k,522)*y(k,129)) + mat(k,2124) = -rxt(k,521)*y(k,105) + mat(k,1528) = -rxt(k,522)*y(k,105) + mat(k,873) = rxt(k,524)*y(k,251) + mat(k,1764) = rxt(k,524)*y(k,100) + mat(k,730) = -(rxt(k,406)*y(k,251)) + mat(k,1858) = -rxt(k,406)*y(k,106) + mat(k,2171) = rxt(k,386)*y(k,242) + rxt(k,391)*y(k,243) + mat(k,1286) = rxt(k,386)*y(k,240) + mat(k,1316) = rxt(k,391)*y(k,240) + mat(k,69) = -(rxt(k,527)*y(k,251)) + mat(k,1762) = -rxt(k,527)*y(k,107) + mat(k,67) = -(rxt(k,525)*y(k,240) + rxt(k,526)*y(k,129)) + mat(k,2117) = -rxt(k,525)*y(k,108) + mat(k,1521) = -rxt(k,526)*y(k,108) + mat(k,68) = rxt(k,527)*y(k,251) + mat(k,1761) = rxt(k,527)*y(k,107) end do end subroutine nlnmat04 subroutine nlnmat05( avec_len, mat, y, rxt ) @@ -1011,207 +978,237 @@ subroutine nlnmat05( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,1822) = -(rxt(k,178)*y(k,232) + rxt(k,179)*y(k,123) + rxt(k,180) & - *y(k,132) + rxt(k,181)*y(k,243) + rxt(k,189)*y(k,124) + rxt(k,275) & - *y(k,42) + rxt(k,308)*y(k,45) + rxt(k,327)*y(k,29) + rxt(k,334) & - *y(k,49) + rxt(k,347)*y(k,16) + rxt(k,355)*y(k,236) + rxt(k,366) & - *y(k,238) + rxt(k,389)*y(k,234) + rxt(k,395)*y(k,235) + rxt(k,398) & - *y(k,98) + rxt(k,403)*y(k,101) + rxt(k,414)*y(k,250) + rxt(k,459) & - *y(k,6) + rxt(k,462)*y(k,111) + rxt(k,468)*y(k,241) + rxt(k,479) & - *y(k,208) + rxt(k,482)*y(k,67)) - mat(k,1518) = -rxt(k,178)*y(k,125) - mat(k,1402) = -rxt(k,179)*y(k,125) - mat(k,2012) = -rxt(k,180)*y(k,125) - mat(k,1701) = -rxt(k,181)*y(k,125) - mat(k,1765) = -rxt(k,189)*y(k,125) - mat(k,1724) = -rxt(k,275)*y(k,125) - mat(k,1046) = -rxt(k,308)*y(k,125) - mat(k,904) = -rxt(k,327)*y(k,125) - mat(k,1122) = -rxt(k,334)*y(k,125) - mat(k,301) = -rxt(k,347)*y(k,125) - mat(k,1207) = -rxt(k,355)*y(k,125) - mat(k,1258) = -rxt(k,366)*y(k,125) - mat(k,1164) = -rxt(k,389)*y(k,125) - mat(k,1240) = -rxt(k,395)*y(k,125) - mat(k,778) = -rxt(k,398)*y(k,125) - mat(k,1100) = -rxt(k,403)*y(k,125) - mat(k,1077) = -rxt(k,414)*y(k,125) - mat(k,845) = -rxt(k,459)*y(k,125) - mat(k,819) = -rxt(k,462)*y(k,125) - mat(k,1023) = -rxt(k,468)*y(k,125) - mat(k,888) = -rxt(k,479)*y(k,125) - mat(k,254) = -rxt(k,482)*y(k,125) - mat(k,508) = rxt(k,240)*y(k,132) - mat(k,2046) = rxt(k,207)*y(k,60) - mat(k,876) = rxt(k,207)*y(k,56) + rxt(k,209)*y(k,132) + rxt(k,210)*y(k,243) - mat(k,698) = rxt(k,254)*y(k,89) - mat(k,1313) = rxt(k,254)*y(k,73) + rxt(k,191)*y(k,243) - mat(k,486) = .500_r8*rxt(k,371)*y(k,243) - mat(k,1765) = mat(k,1765) + rxt(k,177)*y(k,132) + rxt(k,176)*y(k,133) - mat(k,2012) = mat(k,2012) + rxt(k,240)*y(k,20) + rxt(k,209)*y(k,60) & - + rxt(k,177)*y(k,124) - mat(k,1932) = rxt(k,176)*y(k,124) - mat(k,409) = rxt(k,323)*y(k,243) - mat(k,1701) = mat(k,1701) + rxt(k,210)*y(k,60) + rxt(k,191)*y(k,89) & - + .500_r8*rxt(k,371)*y(k,110) + rxt(k,323)*y(k,138) - mat(k,747) = -(rxt(k,337)*y(k,243)) - mat(k,1656) = -rxt(k,337)*y(k,126) - mat(k,892) = rxt(k,327)*y(k,125) - mat(k,472) = .500_r8*rxt(k,397)*y(k,243) - mat(k,324) = rxt(k,404)*y(k,243) - mat(k,311) = rxt(k,408)*y(k,243) - mat(k,909) = rxt(k,409)*y(k,243) - mat(k,1780) = rxt(k,327)*y(k,29) - mat(k,1656) = mat(k,1656) + .500_r8*rxt(k,397)*y(k,100) + rxt(k,404)*y(k,102) & - + rxt(k,408)*y(k,116) + rxt(k,409)*y(k,117) - mat(k,328) = -(rxt(k,469)*y(k,243)) - mat(k,1606) = -rxt(k,469)*y(k,127) - mat(k,1443) = rxt(k,466)*y(k,241) - mat(k,1006) = rxt(k,466)*y(k,232) - mat(k,2017) = -(rxt(k,149)*y(k,133) + 4._r8*rxt(k,150)*y(k,132) + rxt(k,152) & - *y(k,77) + rxt(k,153)*y(k,79) + rxt(k,158)*y(k,232) + rxt(k,164) & - *y(k,243) + (rxt(k,175) + rxt(k,177)) * y(k,124) + rxt(k,180) & - *y(k,125) + rxt(k,185)*y(k,123) + rxt(k,209)*y(k,60) + rxt(k,211) & - *y(k,59) + rxt(k,214)*y(k,85) + rxt(k,217)*y(k,92) + rxt(k,240) & - *y(k,20) + rxt(k,241)*y(k,19) + rxt(k,243)*y(k,81) + rxt(k,245) & - *y(k,91) + rxt(k,276)*y(k,42) + rxt(k,484)*y(k,136)) - mat(k,1937) = -rxt(k,149)*y(k,132) - mat(k,1059) = -rxt(k,152)*y(k,132) - mat(k,524) = -rxt(k,153)*y(k,132) - mat(k,1523) = -rxt(k,158)*y(k,132) - mat(k,1706) = -rxt(k,164)*y(k,132) - mat(k,1770) = -(rxt(k,175) + rxt(k,177)) * y(k,132) - mat(k,1827) = -rxt(k,180)*y(k,132) - mat(k,1407) = -rxt(k,185)*y(k,132) - mat(k,878) = -rxt(k,209)*y(k,132) - mat(k,1987) = -rxt(k,211)*y(k,132) - mat(k,1429) = -rxt(k,214)*y(k,132) - mat(k,733) = -rxt(k,217)*y(k,132) - mat(k,510) = -rxt(k,240)*y(k,132) - mat(k,1961) = -rxt(k,241)*y(k,132) - mat(k,726) = -rxt(k,243)*y(k,132) - mat(k,689) = -rxt(k,245)*y(k,132) - mat(k,1729) = -rxt(k,276)*y(k,132) - mat(k,309) = -rxt(k,484)*y(k,132) - mat(k,1329) = rxt(k,156)*y(k,232) - mat(k,369) = rxt(k,170)*y(k,123) + rxt(k,171)*y(k,124) - mat(k,1407) = mat(k,1407) + rxt(k,170)*y(k,113) - mat(k,1770) = mat(k,1770) + rxt(k,171)*y(k,113) - mat(k,1523) = mat(k,1523) + rxt(k,156)*y(k,76) - mat(k,1706) = mat(k,1706) + 2.000_r8*rxt(k,166)*y(k,243) - mat(k,1934) = -(rxt(k,148)*y(k,242) + rxt(k,149)*y(k,132) + rxt(k,159) & - *y(k,232) + rxt(k,160)*y(k,76) + rxt(k,165)*y(k,243) + rxt(k,176) & - *y(k,124) + rxt(k,184)*y(k,123) + rxt(k,200)*y(k,56) + rxt(k,232) & - *y(k,17) + rxt(k,299)*y(k,25) + rxt(k,328)*y(k,29) + rxt(k,358) & - *y(k,106) + rxt(k,372)*y(k,112) + rxt(k,405)*y(k,98) + rxt(k,443) & - *y(k,140) + rxt(k,460)*y(k,6) + rxt(k,463)*y(k,111) + rxt(k,487) & - *y(k,149) + rxt(k,493)*y(k,151)) - mat(k,1544) = -rxt(k,148)*y(k,133) - mat(k,2014) = -rxt(k,149)*y(k,133) - mat(k,1520) = -rxt(k,159)*y(k,133) - mat(k,1328) = -rxt(k,160)*y(k,133) - mat(k,1703) = -rxt(k,165)*y(k,133) - mat(k,1767) = -rxt(k,176)*y(k,133) - mat(k,1404) = -rxt(k,184)*y(k,133) - mat(k,2048) = -rxt(k,200)*y(k,133) - mat(k,1300) = -rxt(k,232)*y(k,133) - mat(k,494) = -rxt(k,299)*y(k,133) - mat(k,906) = -rxt(k,328)*y(k,133) - mat(k,1113) = -rxt(k,358)*y(k,133) - mat(k,1186) = -rxt(k,372)*y(k,133) - mat(k,780) = -rxt(k,405)*y(k,133) - mat(k,403) = -rxt(k,443)*y(k,133) - mat(k,846) = -rxt(k,460)*y(k,133) - mat(k,820) = -rxt(k,463)*y(k,133) - mat(k,445) = -rxt(k,487)*y(k,133) - mat(k,1134) = -rxt(k,493)*y(k,133) - mat(k,1290) = .150_r8*rxt(k,313)*y(k,232) - mat(k,1520) = mat(k,1520) + .150_r8*rxt(k,313)*y(k,226) + .150_r8*rxt(k,363) & - *y(k,238) - mat(k,1260) = .150_r8*rxt(k,363)*y(k,232) - mat(k,260) = -(rxt(k,494)*y(k,151)) - mat(k,1124) = -rxt(k,494)*y(k,135) - mat(k,1941) = rxt(k,234)*y(k,59) - mat(k,1967) = rxt(k,234)*y(k,19) + 2.000_r8*rxt(k,204)*y(k,59) - mat(k,302) = -(rxt(k,484)*y(k,132) + rxt(k,485)*y(k,243)) - mat(k,1990) = -rxt(k,484)*y(k,136) - mat(k,1602) = -rxt(k,485)*y(k,136) - mat(k,929) = rxt(k,351)*y(k,243) - mat(k,1332) = .100_r8*rxt(k,472)*y(k,247) - mat(k,1585) = rxt(k,351)*y(k,93) - mat(k,987) = .100_r8*rxt(k,472)*y(k,123) - mat(k,404) = -(rxt(k,323)*y(k,243)) - mat(k,1617) = -rxt(k,323)*y(k,138) - mat(k,1737) = rxt(k,325)*y(k,226) - mat(k,1263) = rxt(k,325)*y(k,124) - mat(k,1732) = rxt(k,445)*y(k,219) - mat(k,452) = rxt(k,445)*y(k,124) - mat(k,400) = -(rxt(k,442)*y(k,124) + rxt(k,443)*y(k,133)) - mat(k,1736) = -rxt(k,442)*y(k,140) - mat(k,1887) = -rxt(k,443)*y(k,140) - mat(k,162) = .070_r8*rxt(k,429)*y(k,243) - mat(k,1343) = rxt(k,427)*y(k,225) - mat(k,135) = .060_r8*rxt(k,441)*y(k,243) - mat(k,187) = .070_r8*rxt(k,457)*y(k,243) - mat(k,558) = rxt(k,427)*y(k,123) - mat(k,1616) = .070_r8*rxt(k,429)*y(k,66) + .060_r8*rxt(k,441)*y(k,141) & - + .070_r8*rxt(k,457)*y(k,215) - mat(k,133) = -(rxt(k,441)*y(k,243)) - mat(k,1576) = -rxt(k,441)*y(k,141) - mat(k,125) = .530_r8*rxt(k,418)*y(k,243) - mat(k,1576) = mat(k,1576) + .530_r8*rxt(k,418)*y(k,7) - mat(k,265) = -(rxt(k,444)*y(k,243)) - mat(k,1595) = -rxt(k,444)*y(k,142) - mat(k,1436) = rxt(k,439)*y(k,244) - mat(k,390) = rxt(k,439)*y(k,232) - mat(k,459) = -(rxt(k,340)*y(k,243)) - mat(k,1625) = -rxt(k,340)*y(k,147) - mat(k,1459) = rxt(k,338)*y(k,245) - mat(k,673) = rxt(k,338)*y(k,232) - mat(k,316) = -(rxt(k,344)*y(k,243)) - mat(k,1604) = -rxt(k,344)*y(k,148) - mat(k,1441) = .850_r8*rxt(k,342)*y(k,246) - mat(k,1026) = .850_r8*rxt(k,342)*y(k,232) - mat(k,441) = -(rxt(k,487)*y(k,133) + rxt(k,490)*y(k,243)) - mat(k,1888) = -rxt(k,487)*y(k,149) - mat(k,1622) = -rxt(k,490)*y(k,149) - mat(k,1127) = -(rxt(k,488)*y(k,19) + rxt(k,489)*y(k,59) + rxt(k,491)*y(k,124) & - + rxt(k,493)*y(k,133) + rxt(k,494)*y(k,135) + rxt(k,495) & - *y(k,243)) - mat(k,1945) = -rxt(k,488)*y(k,151) - mat(k,1971) = -rxt(k,489)*y(k,151) - mat(k,1752) = -rxt(k,491)*y(k,151) - mat(k,1915) = -rxt(k,493)*y(k,151) - mat(k,262) = -rxt(k,494)*y(k,151) - mat(k,1684) = -rxt(k,495)*y(k,151) - mat(k,2001) = rxt(k,484)*y(k,136) - mat(k,1915) = mat(k,1915) + rxt(k,487)*y(k,149) - mat(k,306) = rxt(k,484)*y(k,132) - mat(k,442) = rxt(k,487)*y(k,133) + rxt(k,490)*y(k,243) - mat(k,1684) = mat(k,1684) + rxt(k,490)*y(k,149) - mat(k,754) = -(rxt(k,497)*y(k,243)) - mat(k,1657) = -rxt(k,497)*y(k,152) - mat(k,1944) = rxt(k,488)*y(k,151) - mat(k,1969) = rxt(k,489)*y(k,151) - mat(k,250) = rxt(k,482)*y(k,125) + (rxt(k,483)+.500_r8*rxt(k,496))*y(k,243) - mat(k,1745) = rxt(k,491)*y(k,151) - mat(k,1781) = rxt(k,482)*y(k,67) - mat(k,1894) = rxt(k,493)*y(k,151) - mat(k,261) = rxt(k,494)*y(k,151) - mat(k,304) = rxt(k,485)*y(k,243) - mat(k,1126) = rxt(k,488)*y(k,19) + rxt(k,489)*y(k,59) + rxt(k,491)*y(k,124) & - + rxt(k,493)*y(k,133) + rxt(k,494)*y(k,135) + rxt(k,495) & - *y(k,243) - mat(k,1657) = mat(k,1657) + (rxt(k,483)+.500_r8*rxt(k,496))*y(k,67) & - + rxt(k,485)*y(k,136) + rxt(k,495)*y(k,151) - mat(k,212) = -(rxt(k,498)*y(k,253)) - mat(k,2056) = -rxt(k,498)*y(k,153) - mat(k,753) = rxt(k,497)*y(k,243) - mat(k,1589) = rxt(k,497)*y(k,152) - mat(k,56) = .2381005_r8*rxt(k,521)*y(k,243) - mat(k,78) = .5931005_r8*rxt(k,526)*y(k,243) - mat(k,1550) = .2381005_r8*rxt(k,521)*y(k,104) + .5931005_r8*rxt(k,526) & - *y(k,202) + mat(k,105) = -(rxt(k,530)*y(k,251)) + mat(k,1772) = -rxt(k,530)*y(k,109) + mat(k,103) = -(rxt(k,528)*y(k,240) + rxt(k,529)*y(k,129)) + mat(k,2131) = -rxt(k,528)*y(k,110) + mat(k,1535) = -rxt(k,529)*y(k,110) + mat(k,104) = rxt(k,530)*y(k,251) + mat(k,1771) = rxt(k,530)*y(k,109) + mat(k,1249) = -(rxt(k,357)*y(k,139) + rxt(k,358)*y(k,251)) + mat(k,2303) = -rxt(k,357)*y(k,111) + mat(k,1899) = -rxt(k,358)*y(k,111) + mat(k,879) = .300_r8*rxt(k,404)*y(k,139) + mat(k,1592) = .360_r8*rxt(k,387)*y(k,242) + mat(k,2060) = .400_r8*rxt(k,388)*y(k,242) + mat(k,2303) = mat(k,2303) + .300_r8*rxt(k,404)*y(k,100) + mat(k,1419) = .390_r8*rxt(k,384)*y(k,242) + mat(k,1645) = .310_r8*rxt(k,385)*y(k,242) + mat(k,1294) = .360_r8*rxt(k,387)*y(k,129) + .400_r8*rxt(k,388)*y(k,131) & + + .390_r8*rxt(k,384)*y(k,234) + .310_r8*rxt(k,385)*y(k,235) + mat(k,386) = -(rxt(k,359)*y(k,251)) + mat(k,1813) = -rxt(k,359)*y(k,112) + mat(k,2143) = rxt(k,353)*y(k,244) + mat(k,1344) = rxt(k,353)*y(k,240) + mat(k,548) = -(rxt(k,368)*y(k,251)) + mat(k,1836) = -rxt(k,368)*y(k,113) + mat(k,1553) = .800_r8*rxt(k,377)*y(k,228) + mat(k,934) = .800_r8*rxt(k,377)*y(k,129) + mat(k,352) = -(rxt(k,369)*y(k,251)) + mat(k,1808) = -rxt(k,369)*y(k,114) + mat(k,2139) = .800_r8*rxt(k,366)*y(k,248) + mat(k,716) = .800_r8*rxt(k,366)*y(k,240) + mat(k,630) = -(rxt(k,370)*y(k,251)) + mat(k,1846) = -rxt(k,370)*y(k,115) + mat(k,1680) = rxt(k,373)*y(k,246) + mat(k,1388) = rxt(k,373)*y(k,130) + mat(k,1039) = -(rxt(k,461)*y(k,131) + rxt(k,462)*y(k,139) + rxt(k,463) & + *y(k,251)) + mat(k,2046) = -rxt(k,461)*y(k,116) + mat(k,2292) = -rxt(k,462)*y(k,116) + mat(k,1885) = -rxt(k,463)*y(k,116) + mat(k,92) = -(rxt(k,532)*y(k,240) + rxt(k,533)*y(k,129)) + mat(k,2125) = -rxt(k,532)*y(k,117) + mat(k,1529) = -rxt(k,533)*y(k,117) + mat(k,1029) = rxt(k,535)*y(k,251) + mat(k,1765) = rxt(k,535)*y(k,116) + mat(k,1372) = -(rxt(k,371)*y(k,139) + rxt(k,372)*y(k,251)) + mat(k,2309) = -rxt(k,371)*y(k,118) + mat(k,1905) = -rxt(k,372)*y(k,118) + mat(k,882) = .200_r8*rxt(k,404)*y(k,139) + mat(k,1597) = .560_r8*rxt(k,387)*y(k,242) + mat(k,2066) = .600_r8*rxt(k,388)*y(k,242) + mat(k,2309) = mat(k,2309) + .200_r8*rxt(k,404)*y(k,100) + mat(k,1424) = .610_r8*rxt(k,384)*y(k,242) + mat(k,1650) = .440_r8*rxt(k,385)*y(k,242) + mat(k,1298) = .560_r8*rxt(k,387)*y(k,129) + .600_r8*rxt(k,388)*y(k,131) & + + .610_r8*rxt(k,384)*y(k,234) + .440_r8*rxt(k,385)*y(k,235) + mat(k,506) = -(rxt(k,170)*y(k,129) + (rxt(k,171) + rxt(k,172) + rxt(k,173) & + ) * y(k,130) + rxt(k,182)*y(k,251)) + mat(k,1549) = -rxt(k,170)*y(k,119) + mat(k,1675) = -(rxt(k,171) + rxt(k,172) + rxt(k,173)) * y(k,119) + mat(k,1830) = -rxt(k,182)*y(k,119) + mat(k,222) = -((rxt(k,186) + rxt(k,187)) * y(k,250)) + mat(k,1724) = -(rxt(k,186) + rxt(k,187)) * y(k,120) + mat(k,505) = rxt(k,171)*y(k,130) + mat(k,1672) = rxt(k,171)*y(k,119) + mat(k,1673) = rxt(k,189)*y(k,131) + mat(k,2034) = rxt(k,189)*y(k,130) + mat(k,439) = -(rxt(k,407)*y(k,251)) + mat(k,1821) = -rxt(k,407)*y(k,122) + mat(k,1225) = .200_r8*rxt(k,399)*y(k,235) + mat(k,1621) = .200_r8*rxt(k,399)*y(k,103) + mat(k,1085) = -(rxt(k,408)*y(k,251)) + mat(k,1887) = -rxt(k,408)*y(k,123) + mat(k,1229) = rxt(k,401)*y(k,129) + rxt(k,402)*y(k,131) + rxt(k,398)*y(k,234) & + + .800_r8*rxt(k,399)*y(k,235) + mat(k,1580) = rxt(k,401)*y(k,103) + mat(k,2048) = rxt(k,402)*y(k,103) + mat(k,1413) = rxt(k,398)*y(k,103) + mat(k,1634) = .800_r8*rxt(k,399)*y(k,103) + mat(k,136) = -(rxt(k,498)*y(k,251)) + mat(k,1778) = -rxt(k,498)*y(k,127) + mat(k,1604) = -(rxt(k,170)*y(k,119) + rxt(k,179)*y(k,131) + rxt(k,183) & + *y(k,240) + rxt(k,184)*y(k,139) + rxt(k,185)*y(k,138) + rxt(k,206) & + *y(k,61) + rxt(k,238)*y(k,21) + rxt(k,281)*y(k,235) + rxt(k,289) & + *y(k,241) + rxt(k,302)*y(k,231) + rxt(k,313)*y(k,234) + rxt(k,317) & + *y(k,239) + rxt(k,330)*y(k,232) + rxt(k,338)*y(k,253) + rxt(k,342) & + *y(k,254) + (rxt(k,348) + rxt(k,349)) * y(k,237) + (rxt(k,355) & + + rxt(k,356)) * y(k,244) + rxt(k,364)*y(k,246) + rxt(k,367) & + *y(k,248) + (rxt(k,377) + rxt(k,378)) * y(k,228) + rxt(k,387) & + *y(k,242) + rxt(k,393)*y(k,243) + rxt(k,401)*y(k,103) + rxt(k,412) & + *y(k,258) + rxt(k,416)*y(k,227) + rxt(k,419)*y(k,229) + rxt(k,424) & + *y(k,230) + rxt(k,426)*y(k,233) + rxt(k,430)*y(k,236) + rxt(k,433) & + *y(k,245) + rxt(k,436)*y(k,247) + rxt(k,439)*y(k,252) + rxt(k,446) & + *y(k,257) + rxt(k,452)*y(k,259) + rxt(k,455)*y(k,260) + rxt(k,466) & + *y(k,249) + rxt(k,471)*y(k,255) + rxt(k,476)*y(k,256)) + mat(k,508) = -rxt(k,170)*y(k,129) + mat(k,2073) = -rxt(k,179)*y(k,129) + mat(k,2216) = -rxt(k,183)*y(k,129) + mat(k,2316) = -rxt(k,184)*y(k,129) + mat(k,1992) = -rxt(k,185)*y(k,129) + mat(k,1939) = -rxt(k,206)*y(k,129) + mat(k,2097) = -rxt(k,238)*y(k,129) + mat(k,1656) = -rxt(k,281)*y(k,129) + mat(k,491) = -rxt(k,289)*y(k,129) + mat(k,862) = -rxt(k,302)*y(k,129) + mat(k,1429) = -rxt(k,313)*y(k,129) + mat(k,756) = -rxt(k,317)*y(k,129) + mat(k,834) = -rxt(k,330)*y(k,129) + mat(k,811) = -rxt(k,338)*y(k,129) + mat(k,1173) = -rxt(k,342)*y(k,129) + mat(k,610) = -(rxt(k,348) + rxt(k,349)) * y(k,129) + mat(k,1355) = -(rxt(k,355) + rxt(k,356)) * y(k,129) + mat(k,1397) = -rxt(k,364)*y(k,129) + mat(k,720) = -rxt(k,367)*y(k,129) + mat(k,943) = -(rxt(k,377) + rxt(k,378)) * y(k,129) + mat(k,1302) = -rxt(k,387)*y(k,129) + mat(k,1334) = -rxt(k,393)*y(k,129) + mat(k,1239) = -rxt(k,401)*y(k,129) + mat(k,1216) = -rxt(k,412)*y(k,129) + mat(k,556) = -rxt(k,416)*y(k,129) + mat(k,536) = -rxt(k,419)*y(k,129) + mat(k,479) = -rxt(k,424)*y(k,129) + mat(k,679) = -rxt(k,426)*y(k,129) + mat(k,802) = -rxt(k,430)*y(k,129) + mat(k,764) = -rxt(k,433)*y(k,129) + mat(k,907) = -rxt(k,436)*y(k,129) + mat(k,498) = -rxt(k,439)*y(k,129) + mat(k,778) = -rxt(k,446)*y(k,129) + mat(k,795) = -rxt(k,452)*y(k,129) + mat(k,544) = -rxt(k,455)*y(k,129) + mat(k,1106) = -rxt(k,466)*y(k,129) + mat(k,1159) = -rxt(k,471)*y(k,129) + mat(k,956) = -rxt(k,476)*y(k,129) + mat(k,508) = mat(k,508) + 2.000_r8*rxt(k,172)*y(k,130) + rxt(k,182)*y(k,251) + mat(k,223) = 2.000_r8*rxt(k,186)*y(k,250) + mat(k,1700) = 2.000_r8*rxt(k,172)*y(k,119) + rxt(k,175)*y(k,138) + rxt(k,491) & + *y(k,157) + mat(k,1992) = mat(k,1992) + rxt(k,175)*y(k,130) + mat(k,1275) = rxt(k,491)*y(k,130) + mat(k,1741) = 2.000_r8*rxt(k,186)*y(k,120) + mat(k,1913) = rxt(k,182)*y(k,119) + mat(k,1702) = -((rxt(k,171) + rxt(k,172) + rxt(k,173)) * y(k,119) + (rxt(k,175) & + + rxt(k,177)) * y(k,138) + rxt(k,176)*y(k,139) + rxt(k,188) & + *y(k,240) + rxt(k,189)*y(k,131) + rxt(k,190)*y(k,251) + rxt(k,208) & + *y(k,61) + rxt(k,239)*y(k,21) + rxt(k,324)*y(k,234) + rxt(k,373) & + *y(k,246) + rxt(k,431)*y(k,236) + rxt(k,434)*y(k,245) + rxt(k,437) & + *y(k,247) + rxt(k,441)*y(k,146) + rxt(k,444)*y(k,227) + rxt(k,491) & + *y(k,157)) + mat(k,509) = -(rxt(k,171) + rxt(k,172) + rxt(k,173)) * y(k,130) + mat(k,1994) = -(rxt(k,175) + rxt(k,177)) * y(k,130) + mat(k,2318) = -rxt(k,176)*y(k,130) + mat(k,2218) = -rxt(k,188)*y(k,130) + mat(k,2075) = -rxt(k,189)*y(k,130) + mat(k,1915) = -rxt(k,190)*y(k,130) + mat(k,1941) = -rxt(k,208)*y(k,130) + mat(k,2099) = -rxt(k,239)*y(k,130) + mat(k,1431) = -rxt(k,324)*y(k,130) + mat(k,1399) = -rxt(k,373)*y(k,130) + mat(k,804) = -rxt(k,431)*y(k,130) + mat(k,765) = -rxt(k,434)*y(k,130) + mat(k,909) = -rxt(k,437)*y(k,130) + mat(k,515) = -rxt(k,441)*y(k,130) + mat(k,557) = -rxt(k,444)*y(k,130) + mat(k,1276) = -rxt(k,491)*y(k,130) + mat(k,691) = rxt(k,375)*y(k,251) + mat(k,403) = rxt(k,346)*y(k,131) + mat(k,2099) = mat(k,2099) + rxt(k,238)*y(k,129) + mat(k,1941) = mat(k,1941) + rxt(k,206)*y(k,129) + mat(k,446) = rxt(k,169)*y(k,251) + mat(k,662) = .700_r8*rxt(k,395)*y(k,251) + mat(k,1241) = rxt(k,401)*y(k,129) + rxt(k,402)*y(k,131) + mat(k,1606) = rxt(k,238)*y(k,21) + rxt(k,206)*y(k,61) + rxt(k,401)*y(k,103) & + + 2.000_r8*rxt(k,179)*y(k,131) + rxt(k,185)*y(k,138) & + + rxt(k,184)*y(k,139) + rxt(k,416)*y(k,227) + rxt(k,377) & + *y(k,228) + rxt(k,419)*y(k,229) + rxt(k,424)*y(k,230) & + + rxt(k,302)*y(k,231) + rxt(k,330)*y(k,232) + rxt(k,426) & + *y(k,233) + rxt(k,313)*y(k,234) + rxt(k,281)*y(k,235) & + + rxt(k,430)*y(k,236) + rxt(k,348)*y(k,237) + rxt(k,317) & + *y(k,239) + rxt(k,183)*y(k,240) + rxt(k,289)*y(k,241) & + + .920_r8*rxt(k,387)*y(k,242) + .920_r8*rxt(k,393)*y(k,243) & + + rxt(k,355)*y(k,244) + rxt(k,433)*y(k,245) + rxt(k,364) & + *y(k,246) + rxt(k,436)*y(k,247) + rxt(k,367)*y(k,248) & + + 1.600_r8*rxt(k,466)*y(k,249) + rxt(k,439)*y(k,252) & + + rxt(k,338)*y(k,253) + rxt(k,342)*y(k,254) + .900_r8*rxt(k,471) & + *y(k,255) + .800_r8*rxt(k,476)*y(k,256) + rxt(k,446)*y(k,257) & + + rxt(k,412)*y(k,258) + rxt(k,452)*y(k,259) + rxt(k,455) & + *y(k,260) + mat(k,2075) = mat(k,2075) + rxt(k,346)*y(k,18) + rxt(k,402)*y(k,103) & + + 2.000_r8*rxt(k,179)*y(k,129) + rxt(k,180)*y(k,138) & + + rxt(k,178)*y(k,240) + rxt(k,388)*y(k,242) + rxt(k,394) & + *y(k,243) + rxt(k,354)*y(k,244) + rxt(k,365)*y(k,246) & + + 2.000_r8*rxt(k,467)*y(k,249) + rxt(k,181)*y(k,251) & + + rxt(k,413)*y(k,258) + mat(k,893) = rxt(k,336)*y(k,251) + mat(k,1994) = mat(k,1994) + rxt(k,185)*y(k,129) + rxt(k,180)*y(k,131) + mat(k,2318) = mat(k,2318) + rxt(k,184)*y(k,129) + mat(k,673) = rxt(k,473)*y(k,251) + mat(k,557) = mat(k,557) + rxt(k,416)*y(k,129) + mat(k,945) = rxt(k,377)*y(k,129) + mat(k,537) = rxt(k,419)*y(k,129) + mat(k,480) = rxt(k,424)*y(k,129) + mat(k,864) = rxt(k,302)*y(k,129) + mat(k,836) = rxt(k,330)*y(k,129) + mat(k,680) = rxt(k,426)*y(k,129) + mat(k,1431) = mat(k,1431) + rxt(k,313)*y(k,129) + mat(k,1658) = rxt(k,281)*y(k,129) + .500_r8*rxt(k,464)*y(k,249) + mat(k,804) = mat(k,804) + rxt(k,430)*y(k,129) + mat(k,611) = rxt(k,348)*y(k,129) + mat(k,757) = rxt(k,317)*y(k,129) + mat(k,2218) = mat(k,2218) + rxt(k,183)*y(k,129) + rxt(k,178)*y(k,131) + mat(k,492) = rxt(k,289)*y(k,129) + mat(k,1304) = .920_r8*rxt(k,387)*y(k,129) + rxt(k,388)*y(k,131) + mat(k,1336) = .920_r8*rxt(k,393)*y(k,129) + rxt(k,394)*y(k,131) + mat(k,1357) = rxt(k,355)*y(k,129) + rxt(k,354)*y(k,131) + mat(k,765) = mat(k,765) + rxt(k,433)*y(k,129) + mat(k,1399) = mat(k,1399) + rxt(k,364)*y(k,129) + rxt(k,365)*y(k,131) + mat(k,909) = mat(k,909) + rxt(k,436)*y(k,129) + mat(k,721) = rxt(k,367)*y(k,129) + mat(k,1108) = 1.600_r8*rxt(k,466)*y(k,129) + 2.000_r8*rxt(k,467)*y(k,131) & + + .500_r8*rxt(k,464)*y(k,235) + mat(k,1915) = mat(k,1915) + rxt(k,375)*y(k,1) + rxt(k,169)*y(k,92) & + + .700_r8*rxt(k,395)*y(k,101) + rxt(k,181)*y(k,131) + rxt(k,336) & + *y(k,132) + rxt(k,473)*y(k,212) + mat(k,499) = rxt(k,439)*y(k,129) + mat(k,812) = rxt(k,338)*y(k,129) + mat(k,1175) = rxt(k,342)*y(k,129) + mat(k,1161) = .900_r8*rxt(k,471)*y(k,129) + mat(k,958) = .800_r8*rxt(k,476)*y(k,129) + mat(k,779) = rxt(k,446)*y(k,129) + mat(k,1218) = rxt(k,412)*y(k,129) + rxt(k,413)*y(k,131) + mat(k,796) = rxt(k,452)*y(k,129) + mat(k,545) = rxt(k,455)*y(k,129) end do end subroutine nlnmat05 subroutine nlnmat06( avec_len, mat, y, rxt ) @@ -1232,212 +1229,208 @@ subroutine nlnmat06( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,57) = .1308005_r8*rxt(k,521)*y(k,243) - mat(k,79) = .1534005_r8*rxt(k,526)*y(k,243) - mat(k,1551) = .1308005_r8*rxt(k,521)*y(k,104) + .1534005_r8*rxt(k,526) & - *y(k,202) - mat(k,58) = .0348005_r8*rxt(k,521)*y(k,243) - mat(k,80) = .0459005_r8*rxt(k,526)*y(k,243) - mat(k,1552) = .0348005_r8*rxt(k,521)*y(k,104) + .0459005_r8*rxt(k,526) & - *y(k,202) - mat(k,59) = .0076005_r8*rxt(k,521)*y(k,243) - mat(k,81) = .0085005_r8*rxt(k,526)*y(k,243) - mat(k,1553) = .0076005_r8*rxt(k,521)*y(k,104) + .0085005_r8*rxt(k,526) & - *y(k,202) - mat(k,60) = .0113005_r8*rxt(k,521)*y(k,243) - mat(k,82) = .0128005_r8*rxt(k,526)*y(k,243) - mat(k,1554) = .0113005_r8*rxt(k,521)*y(k,104) + .0128005_r8*rxt(k,526) & - *y(k,202) - mat(k,822) = .2202005_r8*rxt(k,515)*y(k,133) + .2202005_r8*rxt(k,516) & - *y(k,243) - mat(k,760) = .0031005_r8*rxt(k,520)*y(k,243) - mat(k,796) = .0508005_r8*rxt(k,524)*y(k,133) + .0508005_r8*rxt(k,525) & - *y(k,243) - mat(k,1880) = .2202005_r8*rxt(k,515)*y(k,6) + .0508005_r8*rxt(k,524)*y(k,111) - mat(k,1556) = .2202005_r8*rxt(k,516)*y(k,6) + .0031005_r8*rxt(k,520)*y(k,98) & - + .0508005_r8*rxt(k,525)*y(k,111) - mat(k,823) = .2067005_r8*rxt(k,515)*y(k,133) + .2067005_r8*rxt(k,516) & - *y(k,243) - mat(k,761) = .0035005_r8*rxt(k,520)*y(k,243) - mat(k,797) = .1149005_r8*rxt(k,524)*y(k,133) + .1149005_r8*rxt(k,525) & - *y(k,243) - mat(k,1881) = .2067005_r8*rxt(k,515)*y(k,6) + .1149005_r8*rxt(k,524)*y(k,111) - mat(k,1557) = .2067005_r8*rxt(k,516)*y(k,6) + .0035005_r8*rxt(k,520)*y(k,98) & - + .1149005_r8*rxt(k,525)*y(k,111) - mat(k,824) = .0653005_r8*rxt(k,515)*y(k,133) + .0653005_r8*rxt(k,516) & - *y(k,243) - mat(k,762) = .0003005_r8*rxt(k,520)*y(k,243) - mat(k,798) = .0348005_r8*rxt(k,524)*y(k,133) + .0348005_r8*rxt(k,525) & - *y(k,243) - mat(k,1882) = .0653005_r8*rxt(k,515)*y(k,6) + .0348005_r8*rxt(k,524)*y(k,111) - mat(k,1558) = .0653005_r8*rxt(k,516)*y(k,6) + .0003005_r8*rxt(k,520)*y(k,98) & - + .0348005_r8*rxt(k,525)*y(k,111) - mat(k,825) = .1749305_r8*rxt(k,514)*y(k,125) + .1284005_r8*rxt(k,515) & - *y(k,133) + .1284005_r8*rxt(k,516)*y(k,243) - mat(k,763) = .0590245_r8*rxt(k,518)*y(k,125) + .0033005_r8*rxt(k,519) & - *y(k,133) + .0271005_r8*rxt(k,520)*y(k,243) - mat(k,799) = .1749305_r8*rxt(k,523)*y(k,125) + .0554005_r8*rxt(k,524) & - *y(k,133) + .0554005_r8*rxt(k,525)*y(k,243) - mat(k,1773) = .1749305_r8*rxt(k,514)*y(k,6) + .0590245_r8*rxt(k,518)*y(k,98) & - + .1749305_r8*rxt(k,523)*y(k,111) - mat(k,1883) = .1284005_r8*rxt(k,515)*y(k,6) + .0033005_r8*rxt(k,519)*y(k,98) & - + .0554005_r8*rxt(k,524)*y(k,111) - mat(k,1559) = .1284005_r8*rxt(k,516)*y(k,6) + .0271005_r8*rxt(k,520)*y(k,98) & - + .0554005_r8*rxt(k,525)*y(k,111) - mat(k,826) = .5901905_r8*rxt(k,514)*y(k,125) + .114_r8*rxt(k,515)*y(k,133) & - + .114_r8*rxt(k,516)*y(k,243) - mat(k,764) = .0250245_r8*rxt(k,518)*y(k,125) + .0474005_r8*rxt(k,520) & - *y(k,243) - mat(k,800) = .5901905_r8*rxt(k,523)*y(k,125) + .1278005_r8*rxt(k,524) & - *y(k,133) + .1278005_r8*rxt(k,525)*y(k,243) - mat(k,1774) = .5901905_r8*rxt(k,514)*y(k,6) + .0250245_r8*rxt(k,518)*y(k,98) & - + .5901905_r8*rxt(k,523)*y(k,111) - mat(k,1884) = .114_r8*rxt(k,515)*y(k,6) + .1278005_r8*rxt(k,524)*y(k,111) - mat(k,1560) = .114_r8*rxt(k,516)*y(k,6) + .0474005_r8*rxt(k,520)*y(k,98) & - + .1278005_r8*rxt(k,525)*y(k,111) - mat(k,118) = .0023005_r8*rxt(k,517)*y(k,243) - mat(k,72) = .2381005_r8*rxt(k,522)*y(k,243) - mat(k,84) = .5931005_r8*rxt(k,527)*y(k,243) - mat(k,148) = .1364005_r8*rxt(k,528)*y(k,243) - mat(k,172) = .1677005_r8*rxt(k,529)*y(k,243) - mat(k,1561) = .0023005_r8*rxt(k,517)*y(k,7) + .2381005_r8*rxt(k,522)*y(k,105) & - + .5931005_r8*rxt(k,527)*y(k,203) + .1364005_r8*rxt(k,528) & - *y(k,211) + .1677005_r8*rxt(k,529)*y(k,213) - mat(k,119) = .0008005_r8*rxt(k,517)*y(k,243) - mat(k,73) = .1308005_r8*rxt(k,522)*y(k,243) - mat(k,85) = .1534005_r8*rxt(k,527)*y(k,243) - mat(k,149) = .0101005_r8*rxt(k,528)*y(k,243) - mat(k,173) = .0174005_r8*rxt(k,529)*y(k,243) - mat(k,1562) = .0008005_r8*rxt(k,517)*y(k,7) + .1308005_r8*rxt(k,522)*y(k,105) & - + .1534005_r8*rxt(k,527)*y(k,203) + .0101005_r8*rxt(k,528) & - *y(k,211) + .0174005_r8*rxt(k,529)*y(k,213) - mat(k,120) = .0843005_r8*rxt(k,517)*y(k,243) - mat(k,74) = .0348005_r8*rxt(k,522)*y(k,243) - mat(k,86) = .0459005_r8*rxt(k,527)*y(k,243) - mat(k,150) = .0763005_r8*rxt(k,528)*y(k,243) - mat(k,174) = .086_r8*rxt(k,529)*y(k,243) - mat(k,1563) = .0843005_r8*rxt(k,517)*y(k,7) + .0348005_r8*rxt(k,522)*y(k,105) & - + .0459005_r8*rxt(k,527)*y(k,203) + .0763005_r8*rxt(k,528) & - *y(k,211) + .086_r8*rxt(k,529)*y(k,213) - mat(k,121) = .0443005_r8*rxt(k,517)*y(k,243) - mat(k,75) = .0076005_r8*rxt(k,522)*y(k,243) - mat(k,87) = .0085005_r8*rxt(k,527)*y(k,243) - mat(k,151) = .2157005_r8*rxt(k,528)*y(k,243) - mat(k,175) = .0512005_r8*rxt(k,529)*y(k,243) - mat(k,1564) = .0443005_r8*rxt(k,517)*y(k,7) + .0076005_r8*rxt(k,522)*y(k,105) & - + .0085005_r8*rxt(k,527)*y(k,203) + .2157005_r8*rxt(k,528) & - *y(k,211) + .0512005_r8*rxt(k,529)*y(k,213) - mat(k,122) = .1621005_r8*rxt(k,517)*y(k,243) - mat(k,76) = .0113005_r8*rxt(k,522)*y(k,243) - mat(k,88) = .0128005_r8*rxt(k,527)*y(k,243) - mat(k,152) = .0738005_r8*rxt(k,528)*y(k,243) - mat(k,176) = .1598005_r8*rxt(k,529)*y(k,243) - mat(k,1565) = .1621005_r8*rxt(k,517)*y(k,7) + .0113005_r8*rxt(k,522)*y(k,105) & - + .0128005_r8*rxt(k,527)*y(k,203) + .0738005_r8*rxt(k,528) & - *y(k,211) + .1598005_r8*rxt(k,529)*y(k,213) - mat(k,83) = -(rxt(k,526)*y(k,243)) - mat(k,1567) = -rxt(k,526)*y(k,202) - mat(k,89) = -(rxt(k,527)*y(k,243)) - mat(k,1568) = -rxt(k,527)*y(k,203) - mat(k,155) = .100_r8*rxt(k,449)*y(k,243) - mat(k,177) = .230_r8*rxt(k,451)*y(k,243) - mat(k,1581) = .100_r8*rxt(k,449)*y(k,211) + .230_r8*rxt(k,451)*y(k,213) - mat(k,527) = -(rxt(k,473)*y(k,243)) - mat(k,1633) = -rxt(k,473)*y(k,205) - mat(k,1462) = rxt(k,471)*y(k,247) - mat(k,988) = rxt(k,471)*y(k,232) - mat(k,551) = -(rxt(k,474)*y(k,243)) - mat(k,1636) = -rxt(k,474)*y(k,206) - mat(k,1352) = .200_r8*rxt(k,467)*y(k,241) + .200_r8*rxt(k,477)*y(k,248) - mat(k,1835) = .500_r8*rxt(k,465)*y(k,241) - mat(k,1007) = .200_r8*rxt(k,467)*y(k,123) + .500_r8*rxt(k,465)*y(k,227) - mat(k,966) = .200_r8*rxt(k,477)*y(k,123) - mat(k,411) = -(rxt(k,478)*y(k,243)) - mat(k,1618) = -rxt(k,478)*y(k,207) - mat(k,1454) = rxt(k,476)*y(k,248) - mat(k,965) = rxt(k,476)*y(k,232) - mat(k,881) = -(rxt(k,479)*y(k,125) + rxt(k,480)*y(k,243)) - mat(k,1788) = -rxt(k,479)*y(k,208) - mat(k,1666) = -rxt(k,480)*y(k,208) - mat(k,834) = .330_r8*rxt(k,460)*y(k,133) - mat(k,808) = .330_r8*rxt(k,463)*y(k,133) - mat(k,1370) = .800_r8*rxt(k,467)*y(k,241) + .800_r8*rxt(k,477)*y(k,248) - mat(k,1788) = mat(k,1788) + rxt(k,468)*y(k,241) - mat(k,1901) = .330_r8*rxt(k,460)*y(k,6) + .330_r8*rxt(k,463)*y(k,111) - mat(k,552) = rxt(k,474)*y(k,243) - mat(k,1842) = .500_r8*rxt(k,465)*y(k,241) + rxt(k,475)*y(k,248) - mat(k,1009) = .800_r8*rxt(k,467)*y(k,123) + rxt(k,468)*y(k,125) & - + .500_r8*rxt(k,465)*y(k,227) - mat(k,1666) = mat(k,1666) + rxt(k,474)*y(k,206) - mat(k,969) = .800_r8*rxt(k,477)*y(k,123) + rxt(k,475)*y(k,227) - mat(k,946) = -(rxt(k,481)*y(k,243)) - mat(k,1671) = -rxt(k,481)*y(k,209) - mat(k,835) = .300_r8*rxt(k,460)*y(k,133) - mat(k,809) = .300_r8*rxt(k,463)*y(k,133) - mat(k,1374) = .900_r8*rxt(k,472)*y(k,247) - mat(k,1904) = .300_r8*rxt(k,460)*y(k,6) + .300_r8*rxt(k,463)*y(k,111) - mat(k,1845) = rxt(k,470)*y(k,247) - mat(k,992) = .900_r8*rxt(k,472)*y(k,123) + rxt(k,470)*y(k,227) - mat(k,538) = -(rxt(k,448)*y(k,243)) - mat(k,1634) = -rxt(k,448)*y(k,210) - mat(k,1463) = rxt(k,446)*y(k,249) - mat(k,635) = rxt(k,446)*y(k,232) - mat(k,153) = -(rxt(k,449)*y(k,243)) - mat(k,1579) = -rxt(k,449)*y(k,211) - mat(k,169) = -(rxt(k,415)*y(k,243)) - mat(k,1582) = -rxt(k,415)*y(k,212) - mat(k,1433) = rxt(k,412)*y(k,250) - mat(k,1062) = rxt(k,412)*y(k,232) - mat(k,178) = -(rxt(k,451)*y(k,243)) - mat(k,1583) = -rxt(k,451)*y(k,213) - mat(k,607) = -(rxt(k,454)*y(k,243)) - mat(k,1642) = -rxt(k,454)*y(k,214) - mat(k,1469) = rxt(k,452)*y(k,251) - mat(k,652) = rxt(k,452)*y(k,232) - mat(k,186) = -(rxt(k,457)*y(k,243)) - mat(k,1584) = -rxt(k,457)*y(k,215) - mat(k,179) = .150_r8*rxt(k,451)*y(k,243) - mat(k,1584) = mat(k,1584) + .150_r8*rxt(k,451)*y(k,213) - mat(k,370) = -(rxt(k,458)*y(k,243)) - mat(k,1612) = -rxt(k,458)*y(k,216) - mat(k,1448) = rxt(k,455)*y(k,252) - mat(k,427) = rxt(k,455)*y(k,232) - mat(k,453) = -(rxt(k,416)*y(k,232) + rxt(k,417)*y(k,123) + rxt(k,445) & - *y(k,124)) - mat(k,1458) = -rxt(k,416)*y(k,219) - mat(k,1347) = -rxt(k,417)*y(k,219) - mat(k,1738) = -rxt(k,445)*y(k,219) - mat(k,201) = rxt(k,422)*y(k,243) - mat(k,1624) = rxt(k,422)*y(k,22) - mat(k,853) = -(rxt(k,377)*y(k,232) + (rxt(k,378) + rxt(k,379)) * y(k,123)) - mat(k,1485) = -rxt(k,377)*y(k,220) - mat(k,1368) = -(rxt(k,378) + rxt(k,379)) * y(k,220) - mat(k,580) = rxt(k,380)*y(k,243) - mat(k,195) = rxt(k,381)*y(k,243) - mat(k,1663) = rxt(k,380)*y(k,2) + rxt(k,381)*y(k,15) - mat(k,420) = -(rxt(k,419)*y(k,232) + rxt(k,420)*y(k,123)) - mat(k,1455) = -rxt(k,419)*y(k,221) - mat(k,1344) = -rxt(k,420)*y(k,221) - mat(k,126) = .350_r8*rxt(k,418)*y(k,243) - mat(k,348) = rxt(k,421)*y(k,243) - mat(k,1619) = .350_r8*rxt(k,418)*y(k,7) + rxt(k,421)*y(k,8) - mat(k,378) = -(rxt(k,423)*y(k,232) + rxt(k,425)*y(k,123)) - mat(k,1449) = -rxt(k,423)*y(k,222) - mat(k,1339) = -rxt(k,425)*y(k,222) - mat(k,272) = rxt(k,424)*y(k,243) - mat(k,156) = .070_r8*rxt(k,449)*y(k,243) - mat(k,180) = .060_r8*rxt(k,451)*y(k,243) - mat(k,1613) = rxt(k,424)*y(k,23) + .070_r8*rxt(k,449)*y(k,211) & - + .060_r8*rxt(k,451)*y(k,213) - mat(k,739) = -(4._r8*rxt(k,300)*y(k,223) + rxt(k,301)*y(k,227) + rxt(k,302) & - *y(k,232) + rxt(k,303)*y(k,123)) - mat(k,1838) = -rxt(k,301)*y(k,223) - mat(k,1481) = -rxt(k,302)*y(k,223) - mat(k,1364) = -rxt(k,303)*y(k,223) - mat(k,277) = .500_r8*rxt(k,305)*y(k,243) - mat(k,244) = rxt(k,306)*y(k,56) + rxt(k,307)*y(k,243) - mat(k,2028) = rxt(k,306)*y(k,28) - mat(k,1655) = .500_r8*rxt(k,305)*y(k,27) + rxt(k,307)*y(k,28) + mat(k,2082) = -(rxt(k,178)*y(k,240) + rxt(k,179)*y(k,129) + rxt(k,180) & + *y(k,138) + rxt(k,181)*y(k,251) + rxt(k,189)*y(k,130) + rxt(k,275) & + *y(k,44) + rxt(k,307)*y(k,47) + rxt(k,326)*y(k,31) + rxt(k,333) & + *y(k,51) + rxt(k,346)*y(k,18) + rxt(k,354)*y(k,244) + rxt(k,365) & + *y(k,246) + rxt(k,388)*y(k,242) + rxt(k,394)*y(k,243) + rxt(k,397) & + *y(k,100) + rxt(k,402)*y(k,103) + rxt(k,413)*y(k,258) + rxt(k,458) & + *y(k,6) + rxt(k,461)*y(k,116) + rxt(k,467)*y(k,249) + rxt(k,478) & + *y(k,214) + rxt(k,481)*y(k,69)) + mat(k,2225) = -rxt(k,178)*y(k,131) + mat(k,1613) = -rxt(k,179)*y(k,131) + mat(k,2001) = -rxt(k,180)*y(k,131) + mat(k,1922) = -rxt(k,181)*y(k,131) + mat(k,1709) = -rxt(k,189)*y(k,131) + mat(k,2025) = -rxt(k,275)*y(k,131) + mat(k,1131) = -rxt(k,307)*y(k,131) + mat(k,1077) = -rxt(k,326)*y(k,131) + mat(k,1266) = -rxt(k,333)*y(k,131) + mat(k,406) = -rxt(k,346)*y(k,131) + mat(k,1361) = -rxt(k,354)*y(k,131) + mat(k,1403) = -rxt(k,365)*y(k,131) + mat(k,1308) = -rxt(k,388)*y(k,131) + mat(k,1340) = -rxt(k,394)*y(k,131) + mat(k,887) = -rxt(k,397)*y(k,131) + mat(k,1245) = -rxt(k,402)*y(k,131) + mat(k,1222) = -rxt(k,413)*y(k,131) + mat(k,1005) = -rxt(k,458)*y(k,131) + mat(k,1055) = -rxt(k,461)*y(k,131) + mat(k,1111) = -rxt(k,467)*y(k,131) + mat(k,1022) = -rxt(k,478)*y(k,131) + mat(k,322) = -rxt(k,481)*y(k,131) + mat(k,580) = rxt(k,240)*y(k,138) + mat(k,2264) = rxt(k,207)*y(k,62) + mat(k,931) = rxt(k,207)*y(k,58) + rxt(k,209)*y(k,138) + rxt(k,210)*y(k,251) + mat(k,920) = rxt(k,254)*y(k,91) + mat(k,1496) = rxt(k,254)*y(k,75) + rxt(k,191)*y(k,251) + mat(k,637) = .500_r8*rxt(k,370)*y(k,251) + mat(k,1709) = mat(k,1709) + rxt(k,177)*y(k,138) + rxt(k,176)*y(k,139) + mat(k,2001) = mat(k,2001) + rxt(k,240)*y(k,22) + rxt(k,209)*y(k,62) & + + rxt(k,177)*y(k,130) + mat(k,2325) = rxt(k,176)*y(k,130) + mat(k,573) = rxt(k,322)*y(k,251) + mat(k,1922) = mat(k,1922) + rxt(k,210)*y(k,62) + rxt(k,191)*y(k,91) & + + .500_r8*rxt(k,370)*y(k,115) + rxt(k,322)*y(k,144) + mat(k,890) = -(rxt(k,336)*y(k,251)) + mat(k,1873) = -rxt(k,336)*y(k,132) + mat(k,1062) = rxt(k,326)*y(k,131) + mat(k,583) = .500_r8*rxt(k,396)*y(k,251) + mat(k,435) = rxt(k,403)*y(k,251) + mat(k,440) = rxt(k,407)*y(k,251) + mat(k,1082) = rxt(k,408)*y(k,251) + mat(k,2039) = rxt(k,326)*y(k,31) + mat(k,1873) = mat(k,1873) + .500_r8*rxt(k,396)*y(k,102) + rxt(k,403)*y(k,104) & + + rxt(k,407)*y(k,122) + rxt(k,408)*y(k,123) + mat(k,463) = -(rxt(k,468)*y(k,251)) + mat(k,1825) = -rxt(k,468)*y(k,133) + mat(k,2150) = rxt(k,465)*y(k,249) + mat(k,1097) = rxt(k,465)*y(k,240) + mat(k,1999) = -(rxt(k,149)*y(k,139) + 4._r8*rxt(k,150)*y(k,138) + rxt(k,152) & + *y(k,79) + rxt(k,153)*y(k,81) + rxt(k,158)*y(k,240) + rxt(k,164) & + *y(k,251) + (rxt(k,175) + rxt(k,177)) * y(k,130) + rxt(k,180) & + *y(k,131) + rxt(k,185)*y(k,129) + rxt(k,209)*y(k,62) + rxt(k,211) & + *y(k,61) + rxt(k,214)*y(k,87) + rxt(k,217)*y(k,94) + rxt(k,240) & + *y(k,22) + rxt(k,241)*y(k,21) + rxt(k,243)*y(k,83) + rxt(k,245) & + *y(k,93) + rxt(k,276)*y(k,44) + rxt(k,483)*y(k,142)) + mat(k,2323) = -rxt(k,149)*y(k,138) + mat(k,1449) = -rxt(k,152)*y(k,138) + mat(k,642) = -rxt(k,153)*y(k,138) + mat(k,2223) = -rxt(k,158)*y(k,138) + mat(k,1920) = -rxt(k,164)*y(k,138) + mat(k,1707) = -(rxt(k,175) + rxt(k,177)) * y(k,138) + mat(k,2080) = -rxt(k,180)*y(k,138) + mat(k,1611) = -rxt(k,185)*y(k,138) + mat(k,930) = -rxt(k,209)*y(k,138) + mat(k,1946) = -rxt(k,211)*y(k,138) + mat(k,1968) = -rxt(k,214)*y(k,138) + mat(k,846) = -rxt(k,217)*y(k,138) + mat(k,579) = -rxt(k,240)*y(k,138) + mat(k,2104) = -rxt(k,241)*y(k,138) + mat(k,854) = -rxt(k,243)*y(k,138) + mat(k,822) = -rxt(k,245)*y(k,138) + mat(k,2023) = -rxt(k,276)*y(k,138) + mat(k,398) = -rxt(k,483)*y(k,138) + mat(k,1509) = rxt(k,156)*y(k,240) + mat(k,512) = rxt(k,170)*y(k,129) + rxt(k,171)*y(k,130) + mat(k,1611) = mat(k,1611) + rxt(k,170)*y(k,119) + mat(k,1707) = mat(k,1707) + rxt(k,171)*y(k,119) + mat(k,2223) = mat(k,2223) + rxt(k,156)*y(k,78) + mat(k,1920) = mat(k,1920) + 2.000_r8*rxt(k,166)*y(k,251) + mat(k,2329) = -(rxt(k,148)*y(k,250) + rxt(k,149)*y(k,138) + rxt(k,159) & + *y(k,240) + rxt(k,160)*y(k,78) + rxt(k,165)*y(k,251) + rxt(k,176) & + *y(k,130) + rxt(k,184)*y(k,129) + rxt(k,200)*y(k,58) + rxt(k,232) & + *y(k,19) + rxt(k,298)*y(k,27) + rxt(k,327)*y(k,31) + rxt(k,357) & + *y(k,111) + rxt(k,371)*y(k,118) + rxt(k,404)*y(k,100) + rxt(k,442) & + *y(k,146) + rxt(k,459)*y(k,6) + rxt(k,462)*y(k,116) + rxt(k,487) & + *y(k,155) + rxt(k,493)*y(k,157)) + mat(k,1754) = -rxt(k,148)*y(k,139) + mat(k,2005) = -rxt(k,149)*y(k,139) + mat(k,2229) = -rxt(k,159)*y(k,139) + mat(k,1514) = -rxt(k,160)*y(k,139) + mat(k,1926) = -rxt(k,165)*y(k,139) + mat(k,1713) = -rxt(k,176)*y(k,139) + mat(k,1617) = -rxt(k,184)*y(k,139) + mat(k,2268) = -rxt(k,200)*y(k,139) + mat(k,1463) = -rxt(k,232)*y(k,139) + mat(k,605) = -rxt(k,298)*y(k,139) + mat(k,1079) = -rxt(k,327)*y(k,139) + mat(k,1258) = -rxt(k,357)*y(k,139) + mat(k,1385) = -rxt(k,371)*y(k,139) + mat(k,889) = -rxt(k,404)*y(k,139) + mat(k,516) = -rxt(k,442)*y(k,139) + mat(k,1007) = -rxt(k,459)*y(k,139) + mat(k,1057) = -rxt(k,462)*y(k,139) + mat(k,565) = -rxt(k,487)*y(k,139) + mat(k,1283) = -rxt(k,493)*y(k,139) + mat(k,1437) = .150_r8*rxt(k,312)*y(k,240) + mat(k,2229) = mat(k,2229) + .150_r8*rxt(k,312)*y(k,234) + .150_r8*rxt(k,362) & + *y(k,246) + mat(k,1405) = .150_r8*rxt(k,362)*y(k,240) + mat(k,362) = -(rxt(k,494)*y(k,157)) + mat(k,1269) = -rxt(k,494)*y(k,141) + mat(k,2089) = rxt(k,234)*y(k,61) + mat(k,1931) = rxt(k,234)*y(k,21) + 2.000_r8*rxt(k,204)*y(k,61) + mat(k,391) = -(rxt(k,483)*y(k,138) + rxt(k,484)*y(k,251)) + mat(k,1976) = -rxt(k,483)*y(k,142) + mat(k,1814) = -rxt(k,484)*y(k,142) + mat(k,1186) = rxt(k,350)*y(k,251) + mat(k,1539) = .100_r8*rxt(k,471)*y(k,255) + mat(k,1796) = rxt(k,350)*y(k,95) + mat(k,1147) = .100_r8*rxt(k,471)*y(k,129) + mat(k,566) = -(rxt(k,322)*y(k,251)) + mat(k,1839) = -rxt(k,322)*y(k,144) + mat(k,1678) = rxt(k,324)*y(k,234) + mat(k,1408) = rxt(k,324)*y(k,130) + mat(k,1671) = rxt(k,444)*y(k,227) + mat(k,553) = rxt(k,444)*y(k,130) + mat(k,513) = -(rxt(k,441)*y(k,130) + rxt(k,442)*y(k,139)) + mat(k,1676) = -rxt(k,441)*y(k,146) + mat(k,2277) = -rxt(k,442)*y(k,146) + mat(k,239) = .070_r8*rxt(k,428)*y(k,251) + mat(k,1550) = rxt(k,426)*y(k,233) + mat(k,219) = .060_r8*rxt(k,440)*y(k,251) + mat(k,260) = .070_r8*rxt(k,456)*y(k,251) + mat(k,677) = rxt(k,426)*y(k,129) + mat(k,1831) = .070_r8*rxt(k,428)*y(k,68) + .060_r8*rxt(k,440)*y(k,147) & + + .070_r8*rxt(k,456)*y(k,223) + mat(k,217) = -(rxt(k,440)*y(k,251)) + mat(k,1785) = -rxt(k,440)*y(k,147) + mat(k,209) = .530_r8*rxt(k,417)*y(k,251) + mat(k,1785) = mat(k,1785) + .530_r8*rxt(k,417)*y(k,8) + mat(k,367) = -(rxt(k,443)*y(k,251)) + mat(k,1809) = -rxt(k,443)*y(k,148) + mat(k,2140) = rxt(k,438)*y(k,252) + mat(k,495) = rxt(k,438)*y(k,240) + mat(k,590) = -(rxt(k,339)*y(k,251)) + mat(k,1841) = -rxt(k,339)*y(k,153) + mat(k,2161) = rxt(k,337)*y(k,253) + mat(k,807) = rxt(k,337)*y(k,240) + mat(k,415) = -(rxt(k,343)*y(k,251)) + mat(k,1817) = -rxt(k,343)*y(k,154) + mat(k,2144) = .850_r8*rxt(k,341)*y(k,254) + mat(k,1167) = .850_r8*rxt(k,341)*y(k,240) + mat(k,560) = -(rxt(k,487)*y(k,139) + rxt(k,490)*y(k,251)) + mat(k,2278) = -rxt(k,487)*y(k,155) + mat(k,1838) = -rxt(k,490)*y(k,155) + mat(k,1272) = -(rxt(k,488)*y(k,21) + rxt(k,489)*y(k,61) + rxt(k,491)*y(k,130) & + + rxt(k,493)*y(k,139) + rxt(k,494)*y(k,141) + rxt(k,495) & + *y(k,251)) + mat(k,2093) = -rxt(k,488)*y(k,157) + mat(k,1935) = -rxt(k,489)*y(k,157) + mat(k,1693) = -rxt(k,491)*y(k,157) + mat(k,2305) = -rxt(k,493)*y(k,157) + mat(k,364) = -rxt(k,494)*y(k,157) + mat(k,1901) = -rxt(k,495)*y(k,157) + mat(k,1986) = rxt(k,483)*y(k,142) + mat(k,2305) = mat(k,2305) + rxt(k,487)*y(k,155) + mat(k,395) = rxt(k,483)*y(k,138) + mat(k,561) = rxt(k,487)*y(k,139) + rxt(k,490)*y(k,251) + mat(k,1901) = mat(k,1901) + rxt(k,490)*y(k,155) + mat(k,897) = -(rxt(k,486)*y(k,251)) + mat(k,1874) = -rxt(k,486)*y(k,158) + mat(k,2092) = rxt(k,488)*y(k,157) + mat(k,1933) = rxt(k,489)*y(k,157) + mat(k,319) = rxt(k,481)*y(k,131) + (rxt(k,482)+.500_r8*rxt(k,496))*y(k,251) + mat(k,1686) = rxt(k,491)*y(k,157) + mat(k,2040) = rxt(k,481)*y(k,69) + mat(k,2285) = rxt(k,493)*y(k,157) + mat(k,363) = rxt(k,494)*y(k,157) + mat(k,393) = rxt(k,484)*y(k,251) + mat(k,1271) = rxt(k,488)*y(k,21) + rxt(k,489)*y(k,61) + rxt(k,491)*y(k,130) & + + rxt(k,493)*y(k,139) + rxt(k,494)*y(k,141) + rxt(k,495) & + *y(k,251) + mat(k,1874) = mat(k,1874) + (rxt(k,482)+.500_r8*rxt(k,496))*y(k,69) & + + rxt(k,484)*y(k,142) + rxt(k,495)*y(k,157) + mat(k,299) = -(rxt(k,497)*y(k,261)) + mat(k,2332) = -rxt(k,497)*y(k,159) + mat(k,896) = rxt(k,486)*y(k,251) + mat(k,1801) = rxt(k,486)*y(k,158) + mat(k,62) = .1056005_r8*rxt(k,526)*y(k,129) + .2381005_r8*rxt(k,525)*y(k,240) + mat(k,1516) = .1056005_r8*rxt(k,526)*y(k,108) + mat(k,112) = .5931005_r8*rxt(k,536)*y(k,251) + mat(k,2112) = .2381005_r8*rxt(k,525)*y(k,108) + mat(k,1756) = .5931005_r8*rxt(k,536)*y(k,208) end do end subroutine nlnmat06 subroutine nlnmat07( avec_len, mat, y, rxt ) @@ -1458,311 +1451,213 @@ subroutine nlnmat07( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,710) = -(rxt(k,329)*y(k,227) + rxt(k,330)*y(k,232) + rxt(k,331) & - *y(k,123)) - mat(k,1837) = -rxt(k,329)*y(k,224) - mat(k,1478) = -rxt(k,330)*y(k,224) - mat(k,1363) = -rxt(k,331)*y(k,224) - mat(k,341) = rxt(k,332)*y(k,243) - mat(k,100) = rxt(k,333)*y(k,243) - mat(k,1652) = rxt(k,332)*y(k,30) + rxt(k,333)*y(k,31) - mat(k,559) = -(rxt(k,426)*y(k,232) + rxt(k,427)*y(k,123)) - mat(k,1465) = -rxt(k,426)*y(k,225) - mat(k,1353) = -rxt(k,427)*y(k,225) - mat(k,222) = rxt(k,428)*y(k,243) - mat(k,1353) = mat(k,1353) + rxt(k,417)*y(k,219) - mat(k,1891) = rxt(k,443)*y(k,140) - mat(k,401) = rxt(k,443)*y(k,133) - mat(k,454) = rxt(k,417)*y(k,123) + .400_r8*rxt(k,416)*y(k,232) - mat(k,1465) = mat(k,1465) + .400_r8*rxt(k,416)*y(k,219) - mat(k,1637) = rxt(k,428)*y(k,32) - mat(k,1280) = -(4._r8*rxt(k,311)*y(k,226) + rxt(k,312)*y(k,227) + rxt(k,313) & - *y(k,232) + rxt(k,314)*y(k,123) + rxt(k,325)*y(k,124) + rxt(k,352) & - *y(k,236) + rxt(k,385)*y(k,234) + rxt(k,390)*y(k,235) + rxt(k,399) & - *y(k,101) + rxt(k,410)*y(k,250)) - mat(k,1862) = -rxt(k,312)*y(k,226) - mat(k,1507) = -rxt(k,313)*y(k,226) - mat(k,1391) = -rxt(k,314)*y(k,226) - mat(k,1754) = -rxt(k,325)*y(k,226) - mat(k,1199) = -rxt(k,352)*y(k,226) - mat(k,1156) = -rxt(k,385)*y(k,226) - mat(k,1232) = -rxt(k,390)*y(k,226) - mat(k,1092) = -rxt(k,399)*y(k,226) - mat(k,1070) = -rxt(k,410)*y(k,226) - mat(k,841) = .060_r8*rxt(k,460)*y(k,133) - mat(k,1041) = rxt(k,308)*y(k,125) + rxt(k,309)*y(k,243) - mat(k,1117) = rxt(k,334)*y(k,125) + rxt(k,335)*y(k,243) - mat(k,436) = .500_r8*rxt(k,316)*y(k,243) - mat(k,774) = .080_r8*rxt(k,405)*y(k,133) - mat(k,1108) = .100_r8*rxt(k,358)*y(k,133) - mat(k,815) = .060_r8*rxt(k,463)*y(k,133) - mat(k,1176) = .280_r8*rxt(k,372)*y(k,133) - mat(k,1391) = mat(k,1391) + .530_r8*rxt(k,356)*y(k,236) + rxt(k,365)*y(k,238) & - + rxt(k,368)*y(k,240) + rxt(k,343)*y(k,246) - mat(k,1811) = rxt(k,308)*y(k,45) + rxt(k,334)*y(k,49) + .530_r8*rxt(k,355) & - *y(k,236) + rxt(k,366)*y(k,238) - mat(k,1921) = .060_r8*rxt(k,460)*y(k,6) + .080_r8*rxt(k,405)*y(k,98) & - + .100_r8*rxt(k,358)*y(k,106) + .060_r8*rxt(k,463)*y(k,111) & - + .280_r8*rxt(k,372)*y(k,112) - mat(k,949) = .650_r8*rxt(k,481)*y(k,243) - mat(k,1280) = mat(k,1280) + .530_r8*rxt(k,352)*y(k,236) - mat(k,1862) = mat(k,1862) + .260_r8*rxt(k,353)*y(k,236) + rxt(k,362)*y(k,238) & - + .300_r8*rxt(k,341)*y(k,246) - mat(k,1507) = mat(k,1507) + .450_r8*rxt(k,363)*y(k,238) + .200_r8*rxt(k,367) & - *y(k,240) + .150_r8*rxt(k,342)*y(k,246) - mat(k,1199) = mat(k,1199) + .530_r8*rxt(k,356)*y(k,123) + .530_r8*rxt(k,355) & - *y(k,125) + .530_r8*rxt(k,352)*y(k,226) + .260_r8*rxt(k,353) & - *y(k,227) - mat(k,1250) = rxt(k,365)*y(k,123) + rxt(k,366)*y(k,125) + rxt(k,362)*y(k,227) & - + .450_r8*rxt(k,363)*y(k,232) + 4.000_r8*rxt(k,364)*y(k,238) - mat(k,590) = rxt(k,368)*y(k,123) + .200_r8*rxt(k,367)*y(k,232) - mat(k,1690) = rxt(k,309)*y(k,45) + rxt(k,335)*y(k,49) + .500_r8*rxt(k,316) & - *y(k,51) + .650_r8*rxt(k,481)*y(k,209) - mat(k,1031) = rxt(k,343)*y(k,123) + .300_r8*rxt(k,341)*y(k,227) & - + .150_r8*rxt(k,342)*y(k,232) - mat(k,1873) = -(rxt(k,201)*y(k,59) + (4._r8*rxt(k,278) + 4._r8*rxt(k,279) & - ) * y(k,227) + rxt(k,280)*y(k,232) + rxt(k,281)*y(k,123) & - + rxt(k,301)*y(k,223) + rxt(k,312)*y(k,226) + rxt(k,329) & - *y(k,224) + rxt(k,341)*y(k,246) + rxt(k,353)*y(k,236) + rxt(k,362) & - *y(k,238) + rxt(k,386)*y(k,234) + rxt(k,391)*y(k,235) + rxt(k,400) & - *y(k,101) + rxt(k,411)*y(k,250) + rxt(k,465)*y(k,241) + rxt(k,470) & - *y(k,247) + rxt(k,475)*y(k,248)) - mat(k,1983) = -rxt(k,201)*y(k,227) - mat(k,1519) = -rxt(k,280)*y(k,227) - mat(k,1403) = -rxt(k,281)*y(k,227) - mat(k,746) = -rxt(k,301)*y(k,227) - mat(k,1289) = -rxt(k,312)*y(k,227) - mat(k,718) = -rxt(k,329)*y(k,227) - mat(k,1037) = -rxt(k,341)*y(k,227) - mat(k,1208) = -rxt(k,353)*y(k,227) - mat(k,1259) = -rxt(k,362)*y(k,227) - mat(k,1165) = -rxt(k,386)*y(k,227) - mat(k,1241) = -rxt(k,391)*y(k,227) - mat(k,1101) = -rxt(k,400)*y(k,227) - mat(k,1078) = -rxt(k,411)*y(k,227) - mat(k,1024) = -rxt(k,465)*y(k,227) - mat(k,1004) = -rxt(k,470)*y(k,227) - mat(k,985) = -rxt(k,475)*y(k,227) - mat(k,905) = .280_r8*rxt(k,328)*y(k,133) - mat(k,469) = rxt(k,315)*y(k,243) - mat(k,356) = .700_r8*rxt(k,283)*y(k,243) - mat(k,779) = .050_r8*rxt(k,405)*y(k,133) - mat(k,1101) = mat(k,1101) + rxt(k,399)*y(k,226) - mat(k,1403) = mat(k,1403) + rxt(k,314)*y(k,226) + .830_r8*rxt(k,431)*y(k,228) & - + .170_r8*rxt(k,437)*y(k,239) - mat(k,1933) = .280_r8*rxt(k,328)*y(k,29) + .050_r8*rxt(k,405)*y(k,98) - mat(k,1289) = mat(k,1289) + rxt(k,399)*y(k,101) + rxt(k,314)*y(k,123) & - + 4.000_r8*rxt(k,311)*y(k,226) + .900_r8*rxt(k,312)*y(k,227) & - + .450_r8*rxt(k,313)*y(k,232) + rxt(k,385)*y(k,234) + rxt(k,390) & - *y(k,235) + rxt(k,352)*y(k,236) + rxt(k,361)*y(k,238) & - + rxt(k,410)*y(k,250) - mat(k,1873) = mat(k,1873) + .900_r8*rxt(k,312)*y(k,226) - mat(k,672) = .830_r8*rxt(k,431)*y(k,123) + .330_r8*rxt(k,430)*y(k,232) - mat(k,1519) = mat(k,1519) + .450_r8*rxt(k,313)*y(k,226) + .330_r8*rxt(k,430) & - *y(k,228) + .070_r8*rxt(k,436)*y(k,239) - mat(k,1165) = mat(k,1165) + rxt(k,385)*y(k,226) - mat(k,1241) = mat(k,1241) + rxt(k,390)*y(k,226) - mat(k,1208) = mat(k,1208) + rxt(k,352)*y(k,226) - mat(k,1259) = mat(k,1259) + rxt(k,361)*y(k,226) - mat(k,790) = .170_r8*rxt(k,437)*y(k,123) + .070_r8*rxt(k,436)*y(k,232) - mat(k,1702) = rxt(k,315)*y(k,50) + .700_r8*rxt(k,283)*y(k,53) - mat(k,1078) = mat(k,1078) + rxt(k,410)*y(k,226) - mat(k,665) = -(rxt(k,430)*y(k,232) + rxt(k,431)*y(k,123) + rxt(k,432) & - *y(k,124)) - mat(k,1474) = -rxt(k,430)*y(k,228) - mat(k,1360) = -rxt(k,431)*y(k,228) - mat(k,1743) = -rxt(k,432)*y(k,228) - mat(k,495) = -((rxt(k,349) + rxt(k,350)) * y(k,123)) - mat(k,1349) = -(rxt(k,349) + rxt(k,350)) * y(k,229) - mat(k,295) = rxt(k,348)*y(k,243) - mat(k,1630) = rxt(k,348)*y(k,16) - mat(k,1334) = .750_r8*rxt(k,318)*y(k,231) - mat(k,619) = .750_r8*rxt(k,318)*y(k,123) - mat(k,620) = -(rxt(k,317)*y(k,232) + rxt(k,318)*y(k,123)) - mat(k,1470) = -rxt(k,317)*y(k,231) - mat(k,1356) = -rxt(k,318)*y(k,231) - mat(k,488) = rxt(k,324)*y(k,243) - mat(k,1643) = rxt(k,324)*y(k,25) - mat(k,1513) = -((rxt(k,154) + rxt(k,155) + rxt(k,156)) * y(k,76) + rxt(k,158) & - *y(k,132) + rxt(k,159)*y(k,133) + rxt(k,163)*y(k,243) & - + 4._r8*rxt(k,168)*y(k,232) + rxt(k,178)*y(k,125) + rxt(k,183) & - *y(k,123) + rxt(k,188)*y(k,124) + (rxt(k,198) + rxt(k,199) & - ) * y(k,56) + rxt(k,205)*y(k,59) + rxt(k,231)*y(k,17) + rxt(k,237) & - *y(k,19) + rxt(k,274)*y(k,42) + rxt(k,280)*y(k,227) + rxt(k,288) & - *y(k,233) + rxt(k,302)*y(k,223) + rxt(k,313)*y(k,226) + rxt(k,317) & - *y(k,231) + rxt(k,330)*y(k,224) + rxt(k,338)*y(k,245) + rxt(k,342) & - *y(k,246) + rxt(k,354)*y(k,236) + rxt(k,363)*y(k,238) + rxt(k,367) & - *y(k,240) + rxt(k,377)*y(k,220) + rxt(k,387)*y(k,234) + rxt(k,392) & - *y(k,235) + rxt(k,401)*y(k,101) + rxt(k,412)*y(k,250) + rxt(k,416) & - *y(k,219) + rxt(k,419)*y(k,221) + rxt(k,423)*y(k,222) + rxt(k,426) & - *y(k,225) + rxt(k,430)*y(k,228) + rxt(k,433)*y(k,237) + rxt(k,436) & - *y(k,239) + rxt(k,439)*y(k,244) + rxt(k,446)*y(k,249) + rxt(k,452) & - *y(k,251) + rxt(k,455)*y(k,252) + rxt(k,466)*y(k,241) + rxt(k,471) & - *y(k,247) + rxt(k,476)*y(k,248)) - mat(k,1322) = -(rxt(k,154) + rxt(k,155) + rxt(k,156)) * y(k,232) - mat(k,2007) = -rxt(k,158)*y(k,232) - mat(k,1927) = -rxt(k,159)*y(k,232) - mat(k,1696) = -rxt(k,163)*y(k,232) - mat(k,1817) = -rxt(k,178)*y(k,232) - mat(k,1397) = -rxt(k,183)*y(k,232) - mat(k,1760) = -rxt(k,188)*y(k,232) - mat(k,2041) = -(rxt(k,198) + rxt(k,199)) * y(k,232) - mat(k,1977) = -rxt(k,205)*y(k,232) - mat(k,1296) = -rxt(k,231)*y(k,232) - mat(k,1951) = -rxt(k,237)*y(k,232) - mat(k,1719) = -rxt(k,274)*y(k,232) - mat(k,1867) = -rxt(k,280)*y(k,232) - mat(k,387) = -rxt(k,288)*y(k,232) - mat(k,742) = -rxt(k,302)*y(k,232) - mat(k,1284) = -rxt(k,313)*y(k,232) - mat(k,623) = -rxt(k,317)*y(k,232) - mat(k,714) = -rxt(k,330)*y(k,232) - mat(k,678) = -rxt(k,338)*y(k,232) - mat(k,1033) = -rxt(k,342)*y(k,232) - mat(k,1203) = -rxt(k,354)*y(k,232) - mat(k,1254) = -rxt(k,363)*y(k,232) - mat(k,592) = -rxt(k,367)*y(k,232) - mat(k,858) = -rxt(k,377)*y(k,232) - mat(k,1160) = -rxt(k,387)*y(k,232) - mat(k,1236) = -rxt(k,392)*y(k,232) - mat(k,1096) = -rxt(k,401)*y(k,232) - mat(k,1073) = -rxt(k,412)*y(k,232) - mat(k,456) = -rxt(k,416)*y(k,232) - mat(k,424) = -rxt(k,419)*y(k,232) - mat(k,381) = -rxt(k,423)*y(k,232) - mat(k,561) = -rxt(k,426)*y(k,232) - mat(k,669) = -rxt(k,430)*y(k,232) - mat(k,631) = -rxt(k,433)*y(k,232) - mat(k,787) = -rxt(k,436)*y(k,232) - mat(k,394) = -rxt(k,439)*y(k,232) - mat(k,645) = -rxt(k,446)*y(k,232) - mat(k,662) = -rxt(k,452)*y(k,232) - mat(k,432) = -rxt(k,455)*y(k,232) - mat(k,1019) = -rxt(k,466)*y(k,232) - mat(k,1000) = -rxt(k,471)*y(k,232) - mat(k,980) = -rxt(k,476)*y(k,232) - mat(k,842) = .570_r8*rxt(k,460)*y(k,133) - mat(k,127) = .650_r8*rxt(k,418)*y(k,243) - mat(k,1296) = mat(k,1296) + rxt(k,230)*y(k,42) - mat(k,1951) = mat(k,1951) + rxt(k,242)*y(k,243) - mat(k,241) = .350_r8*rxt(k,297)*y(k,243) - mat(k,491) = .130_r8*rxt(k,299)*y(k,133) - mat(k,218) = rxt(k,304)*y(k,243) - mat(k,900) = .280_r8*rxt(k,328)*y(k,133) - mat(k,1719) = mat(k,1719) + rxt(k,230)*y(k,17) + rxt(k,194)*y(k,56) & - + rxt(k,275)*y(k,125) + rxt(k,276)*y(k,132) - mat(k,94) = rxt(k,310)*y(k,243) - mat(k,702) = rxt(k,282)*y(k,243) - mat(k,2041) = mat(k,2041) + rxt(k,194)*y(k,42) + rxt(k,197)*y(k,79) - mat(k,1977) = mat(k,1977) + rxt(k,201)*y(k,227) + rxt(k,212)*y(k,243) - mat(k,957) = rxt(k,285)*y(k,243) - mat(k,163) = .730_r8*rxt(k,429)*y(k,243) - mat(k,252) = .500_r8*rxt(k,496)*y(k,243) - mat(k,926) = rxt(k,321)*y(k,243) - mat(k,794) = rxt(k,322)*y(k,243) - mat(k,522) = rxt(k,197)*y(k,56) + rxt(k,153)*y(k,132) + rxt(k,162)*y(k,243) - mat(k,145) = rxt(k,286)*y(k,243) - mat(k,706) = rxt(k,287)*y(k,243) - mat(k,939) = rxt(k,351)*y(k,243) - mat(k,962) = rxt(k,336)*y(k,243) - mat(k,775) = .370_r8*rxt(k,405)*y(k,133) - mat(k,516) = .300_r8*rxt(k,396)*y(k,243) - mat(k,477) = rxt(k,397)*y(k,243) - mat(k,1096) = mat(k,1096) + rxt(k,402)*y(k,123) + rxt(k,403)*y(k,125) & - + rxt(k,399)*y(k,226) + 1.200_r8*rxt(k,400)*y(k,227) - mat(k,325) = rxt(k,404)*y(k,243) - mat(k,1110) = .140_r8*rxt(k,358)*y(k,133) - mat(k,292) = .200_r8*rxt(k,360)*y(k,243) - mat(k,482) = .500_r8*rxt(k,371)*y(k,243) - mat(k,816) = .570_r8*rxt(k,463)*y(k,133) - mat(k,1180) = .280_r8*rxt(k,372)*y(k,133) - mat(k,314) = rxt(k,408)*y(k,243) - mat(k,918) = rxt(k,409)*y(k,243) - mat(k,1397) = mat(k,1397) + rxt(k,402)*y(k,101) + rxt(k,378)*y(k,220) & - + rxt(k,420)*y(k,221) + rxt(k,425)*y(k,222) + rxt(k,303) & - *y(k,223) + rxt(k,331)*y(k,224) + rxt(k,281)*y(k,227) & - + .170_r8*rxt(k,431)*y(k,228) + rxt(k,349)*y(k,229) & - + .250_r8*rxt(k,318)*y(k,231) + rxt(k,290)*y(k,233) & - + .920_r8*rxt(k,388)*y(k,234) + .920_r8*rxt(k,394)*y(k,235) & - + .470_r8*rxt(k,356)*y(k,236) + .400_r8*rxt(k,434)*y(k,237) & - + .830_r8*rxt(k,437)*y(k,239) + rxt(k,440)*y(k,244) + rxt(k,339) & - *y(k,245) + .900_r8*rxt(k,472)*y(k,247) + .800_r8*rxt(k,477) & - *y(k,248) + rxt(k,447)*y(k,249) + rxt(k,413)*y(k,250) & - + rxt(k,453)*y(k,251) + rxt(k,456)*y(k,252) - mat(k,1817) = mat(k,1817) + rxt(k,275)*y(k,42) + rxt(k,403)*y(k,101) & - + rxt(k,389)*y(k,234) + rxt(k,395)*y(k,235) + .470_r8*rxt(k,355) & - *y(k,236) + rxt(k,181)*y(k,243) + rxt(k,414)*y(k,250) - mat(k,2007) = mat(k,2007) + rxt(k,276)*y(k,42) + rxt(k,153)*y(k,79) - mat(k,1927) = mat(k,1927) + .570_r8*rxt(k,460)*y(k,6) + .130_r8*rxt(k,299) & - *y(k,25) + .280_r8*rxt(k,328)*y(k,29) + .370_r8*rxt(k,405) & - *y(k,98) + .140_r8*rxt(k,358)*y(k,106) + .570_r8*rxt(k,463) & - *y(k,111) + .280_r8*rxt(k,372)*y(k,112) + rxt(k,165)*y(k,243) - mat(k,136) = .800_r8*rxt(k,441)*y(k,243) - mat(k,756) = rxt(k,497)*y(k,243) - mat(k,950) = .200_r8*rxt(k,481)*y(k,243) - mat(k,158) = .280_r8*rxt(k,449)*y(k,243) - mat(k,184) = .380_r8*rxt(k,451)*y(k,243) - mat(k,189) = .630_r8*rxt(k,457)*y(k,243) - mat(k,858) = mat(k,858) + rxt(k,378)*y(k,123) - mat(k,424) = mat(k,424) + rxt(k,420)*y(k,123) - mat(k,381) = mat(k,381) + rxt(k,425)*y(k,123) - mat(k,742) = mat(k,742) + rxt(k,303)*y(k,123) + 2.400_r8*rxt(k,300)*y(k,223) & - + rxt(k,301)*y(k,227) - mat(k,714) = mat(k,714) + rxt(k,331)*y(k,123) + rxt(k,329)*y(k,227) - mat(k,1284) = mat(k,1284) + rxt(k,399)*y(k,101) + .900_r8*rxt(k,312)*y(k,227) & - + rxt(k,385)*y(k,234) + rxt(k,390)*y(k,235) + .470_r8*rxt(k,352) & - *y(k,236) + rxt(k,410)*y(k,250) - mat(k,1867) = mat(k,1867) + rxt(k,201)*y(k,59) + 1.200_r8*rxt(k,400)*y(k,101) & - + rxt(k,281)*y(k,123) + rxt(k,301)*y(k,223) + rxt(k,329) & - *y(k,224) + .900_r8*rxt(k,312)*y(k,226) + 4.000_r8*rxt(k,278) & - *y(k,227) + rxt(k,386)*y(k,234) + rxt(k,391)*y(k,235) & - + .730_r8*rxt(k,353)*y(k,236) + rxt(k,362)*y(k,238) & - + .500_r8*rxt(k,465)*y(k,241) + .300_r8*rxt(k,341)*y(k,246) & - + rxt(k,470)*y(k,247) + rxt(k,475)*y(k,248) + .800_r8*rxt(k,411) & - *y(k,250) - mat(k,669) = mat(k,669) + .170_r8*rxt(k,431)*y(k,123) + .070_r8*rxt(k,430) & - *y(k,232) - mat(k,500) = rxt(k,349)*y(k,123) - mat(k,623) = mat(k,623) + .250_r8*rxt(k,318)*y(k,123) - mat(k,1513) = mat(k,1513) + .070_r8*rxt(k,430)*y(k,228) + .160_r8*rxt(k,433) & - *y(k,237) + .330_r8*rxt(k,436)*y(k,239) - mat(k,387) = mat(k,387) + rxt(k,290)*y(k,123) - mat(k,1160) = mat(k,1160) + .920_r8*rxt(k,388)*y(k,123) + rxt(k,389)*y(k,125) & - + rxt(k,385)*y(k,226) + rxt(k,386)*y(k,227) - mat(k,1236) = mat(k,1236) + .920_r8*rxt(k,394)*y(k,123) + rxt(k,395)*y(k,125) & - + rxt(k,390)*y(k,226) + rxt(k,391)*y(k,227) - mat(k,1203) = mat(k,1203) + .470_r8*rxt(k,356)*y(k,123) + .470_r8*rxt(k,355) & - *y(k,125) + .470_r8*rxt(k,352)*y(k,226) + .730_r8*rxt(k,353) & - *y(k,227) - mat(k,631) = mat(k,631) + .400_r8*rxt(k,434)*y(k,123) + .160_r8*rxt(k,433) & - *y(k,232) - mat(k,1254) = mat(k,1254) + rxt(k,362)*y(k,227) - mat(k,787) = mat(k,787) + .830_r8*rxt(k,437)*y(k,123) + .330_r8*rxt(k,436) & - *y(k,232) - mat(k,1019) = mat(k,1019) + .500_r8*rxt(k,465)*y(k,227) - mat(k,1696) = mat(k,1696) + .650_r8*rxt(k,418)*y(k,7) + rxt(k,242)*y(k,19) & - + .350_r8*rxt(k,297)*y(k,24) + rxt(k,304)*y(k,26) + rxt(k,310) & - *y(k,47) + rxt(k,282)*y(k,52) + rxt(k,212)*y(k,59) + rxt(k,285) & - *y(k,62) + .730_r8*rxt(k,429)*y(k,66) + .500_r8*rxt(k,496) & - *y(k,67) + rxt(k,321)*y(k,74) + rxt(k,322)*y(k,75) + rxt(k,162) & - *y(k,79) + rxt(k,286)*y(k,86) + rxt(k,287)*y(k,87) + rxt(k,351) & - *y(k,93) + rxt(k,336)*y(k,95) + .300_r8*rxt(k,396)*y(k,99) & - + rxt(k,397)*y(k,100) + rxt(k,404)*y(k,102) + .200_r8*rxt(k,360) & - *y(k,107) + .500_r8*rxt(k,371)*y(k,110) + rxt(k,408)*y(k,116) & - + rxt(k,409)*y(k,117) + rxt(k,181)*y(k,125) + rxt(k,165) & - *y(k,133) + .800_r8*rxt(k,441)*y(k,141) + rxt(k,497)*y(k,152) & - + .200_r8*rxt(k,481)*y(k,209) + .280_r8*rxt(k,449)*y(k,211) & - + .380_r8*rxt(k,451)*y(k,213) + .630_r8*rxt(k,457)*y(k,215) - mat(k,394) = mat(k,394) + rxt(k,440)*y(k,123) - mat(k,678) = mat(k,678) + rxt(k,339)*y(k,123) - mat(k,1033) = mat(k,1033) + .300_r8*rxt(k,341)*y(k,227) - mat(k,1000) = mat(k,1000) + .900_r8*rxt(k,472)*y(k,123) + rxt(k,470)*y(k,227) - mat(k,980) = mat(k,980) + .800_r8*rxt(k,477)*y(k,123) + rxt(k,475)*y(k,227) - mat(k,645) = mat(k,645) + rxt(k,447)*y(k,123) - mat(k,1073) = mat(k,1073) + rxt(k,413)*y(k,123) + rxt(k,414)*y(k,125) & - + rxt(k,410)*y(k,226) + .800_r8*rxt(k,411)*y(k,227) - mat(k,662) = mat(k,662) + rxt(k,453)*y(k,123) - mat(k,432) = mat(k,432) + rxt(k,456)*y(k,123) + mat(k,63) = .1026005_r8*rxt(k,526)*y(k,129) + .1308005_r8*rxt(k,525)*y(k,240) + mat(k,1517) = .1026005_r8*rxt(k,526)*y(k,108) + mat(k,113) = .1534005_r8*rxt(k,536)*y(k,251) + mat(k,2113) = .1308005_r8*rxt(k,525)*y(k,108) + mat(k,1757) = .1534005_r8*rxt(k,536)*y(k,208) + mat(k,64) = .0521005_r8*rxt(k,526)*y(k,129) + .0348005_r8*rxt(k,525)*y(k,240) + mat(k,1518) = .0521005_r8*rxt(k,526)*y(k,108) + mat(k,114) = .0459005_r8*rxt(k,536)*y(k,251) + mat(k,2114) = .0348005_r8*rxt(k,525)*y(k,108) + mat(k,1758) = .0459005_r8*rxt(k,536)*y(k,208) + mat(k,65) = .0143005_r8*rxt(k,526)*y(k,129) + .0076005_r8*rxt(k,525)*y(k,240) + mat(k,1519) = .0143005_r8*rxt(k,526)*y(k,108) + mat(k,115) = .0085005_r8*rxt(k,536)*y(k,251) + mat(k,2115) = .0076005_r8*rxt(k,525)*y(k,108) + mat(k,1759) = .0085005_r8*rxt(k,536)*y(k,208) + mat(k,66) = .0166005_r8*rxt(k,526)*y(k,129) + .0113005_r8*rxt(k,525)*y(k,240) + mat(k,1520) = .0166005_r8*rxt(k,526)*y(k,108) + mat(k,116) = .0128005_r8*rxt(k,536)*y(k,251) + mat(k,2116) = .0113005_r8*rxt(k,525)*y(k,108) + mat(k,1760) = .0128005_r8*rxt(k,536)*y(k,208) + mat(k,975) = .2202005_r8*rxt(k,515)*y(k,139) + mat(k,75) = .1279005_r8*rxt(k,514)*y(k,129) + .2202005_r8*rxt(k,513)*y(k,240) + mat(k,81) = .0003005_r8*rxt(k,522)*y(k,129) + .0031005_r8*rxt(k,521)*y(k,240) + mat(k,1024) = .0508005_r8*rxt(k,534)*y(k,139) + mat(k,87) = .0245005_r8*rxt(k,533)*y(k,129) + .0508005_r8*rxt(k,532)*y(k,240) + mat(k,1522) = .1279005_r8*rxt(k,514)*y(k,7) + .0003005_r8*rxt(k,522)*y(k,105) & + + .0245005_r8*rxt(k,533)*y(k,117) + mat(k,2270) = .2202005_r8*rxt(k,515)*y(k,6) + .0508005_r8*rxt(k,534)*y(k,116) + mat(k,2118) = .2202005_r8*rxt(k,513)*y(k,7) + .0031005_r8*rxt(k,521)*y(k,105) & + + .0508005_r8*rxt(k,532)*y(k,117) + mat(k,976) = .2067005_r8*rxt(k,515)*y(k,139) + mat(k,76) = .1792005_r8*rxt(k,514)*y(k,129) + .2067005_r8*rxt(k,513)*y(k,240) + mat(k,82) = .0003005_r8*rxt(k,522)*y(k,129) + .0035005_r8*rxt(k,521)*y(k,240) + mat(k,1025) = .1149005_r8*rxt(k,534)*y(k,139) + mat(k,88) = .0082005_r8*rxt(k,533)*y(k,129) + .1149005_r8*rxt(k,532)*y(k,240) + mat(k,1523) = .1792005_r8*rxt(k,514)*y(k,7) + .0003005_r8*rxt(k,522)*y(k,105) & + + .0082005_r8*rxt(k,533)*y(k,117) + mat(k,2271) = .2067005_r8*rxt(k,515)*y(k,6) + .1149005_r8*rxt(k,534)*y(k,116) + mat(k,2119) = .2067005_r8*rxt(k,513)*y(k,7) + .0035005_r8*rxt(k,521)*y(k,105) & + + .1149005_r8*rxt(k,532)*y(k,117) + mat(k,977) = .0653005_r8*rxt(k,515)*y(k,139) + mat(k,77) = .0676005_r8*rxt(k,514)*y(k,129) + .0653005_r8*rxt(k,513)*y(k,240) + mat(k,83) = .0073005_r8*rxt(k,522)*y(k,129) + .0003005_r8*rxt(k,521)*y(k,240) + mat(k,1026) = .0348005_r8*rxt(k,534)*y(k,139) + mat(k,89) = .0772005_r8*rxt(k,533)*y(k,129) + .0348005_r8*rxt(k,532)*y(k,240) + mat(k,1524) = .0676005_r8*rxt(k,514)*y(k,7) + .0073005_r8*rxt(k,522)*y(k,105) & + + .0772005_r8*rxt(k,533)*y(k,117) + mat(k,2272) = .0653005_r8*rxt(k,515)*y(k,6) + .0348005_r8*rxt(k,534)*y(k,116) + mat(k,2120) = .0653005_r8*rxt(k,513)*y(k,7) + .0003005_r8*rxt(k,521)*y(k,105) & + + .0348005_r8*rxt(k,532)*y(k,117) + mat(k,978) = .1749305_r8*rxt(k,512)*y(k,131) + .1284005_r8*rxt(k,515) & + *y(k,139) + mat(k,78) = .079_r8*rxt(k,514)*y(k,129) + .1284005_r8*rxt(k,513)*y(k,240) + mat(k,871) = .0590245_r8*rxt(k,520)*y(k,131) + .0033005_r8*rxt(k,523) & + *y(k,139) + mat(k,84) = .0057005_r8*rxt(k,522)*y(k,129) + .0271005_r8*rxt(k,521)*y(k,240) + mat(k,1027) = .1749305_r8*rxt(k,531)*y(k,131) + .0554005_r8*rxt(k,534) & + *y(k,139) + mat(k,90) = .0332005_r8*rxt(k,533)*y(k,129) + .0554005_r8*rxt(k,532)*y(k,240) + mat(k,1525) = .079_r8*rxt(k,514)*y(k,7) + .0057005_r8*rxt(k,522)*y(k,105) & + + .0332005_r8*rxt(k,533)*y(k,117) + mat(k,2031) = .1749305_r8*rxt(k,512)*y(k,6) + .0590245_r8*rxt(k,520)*y(k,100) & + + .1749305_r8*rxt(k,531)*y(k,116) + mat(k,2273) = .1284005_r8*rxt(k,515)*y(k,6) + .0033005_r8*rxt(k,523)*y(k,100) & + + .0554005_r8*rxt(k,534)*y(k,116) + mat(k,2121) = .1284005_r8*rxt(k,513)*y(k,7) + .0271005_r8*rxt(k,521)*y(k,105) & + + .0554005_r8*rxt(k,532)*y(k,117) + mat(k,979) = .5901905_r8*rxt(k,512)*y(k,131) + .114_r8*rxt(k,515)*y(k,139) + mat(k,79) = .1254005_r8*rxt(k,514)*y(k,129) + .114_r8*rxt(k,513)*y(k,240) + mat(k,872) = .0250245_r8*rxt(k,520)*y(k,131) + mat(k,85) = .0623005_r8*rxt(k,522)*y(k,129) + .0474005_r8*rxt(k,521)*y(k,240) + mat(k,1028) = .5901905_r8*rxt(k,531)*y(k,131) + .1278005_r8*rxt(k,534) & + *y(k,139) + mat(k,91) = .130_r8*rxt(k,533)*y(k,129) + .1278005_r8*rxt(k,532)*y(k,240) + mat(k,1526) = .1254005_r8*rxt(k,514)*y(k,7) + .0623005_r8*rxt(k,522)*y(k,105) & + + .130_r8*rxt(k,533)*y(k,117) + mat(k,2032) = .5901905_r8*rxt(k,512)*y(k,6) + .0250245_r8*rxt(k,520)*y(k,100) & + + .5901905_r8*rxt(k,531)*y(k,116) + mat(k,2274) = .114_r8*rxt(k,515)*y(k,6) + .1278005_r8*rxt(k,534)*y(k,116) + mat(k,2122) = .114_r8*rxt(k,513)*y(k,7) + .0474005_r8*rxt(k,521)*y(k,105) & + + .1278005_r8*rxt(k,532)*y(k,117) + mat(k,106) = .0097005_r8*rxt(k,519)*y(k,129) + .0023005_r8*rxt(k,518) & + *y(k,240) + mat(k,98) = .1056005_r8*rxt(k,529)*y(k,129) + .2381005_r8*rxt(k,528)*y(k,240) + mat(k,1530) = .0097005_r8*rxt(k,519)*y(k,9) + .1056005_r8*rxt(k,529)*y(k,110) & + + .0154005_r8*rxt(k,540)*y(k,218) + .0063005_r8*rxt(k,544) & + *y(k,222) + mat(k,118) = .5931005_r8*rxt(k,537)*y(k,251) + mat(k,124) = .0154005_r8*rxt(k,540)*y(k,129) + .1364005_r8*rxt(k,539) & + *y(k,240) + mat(k,130) = .0063005_r8*rxt(k,544)*y(k,129) + .1677005_r8*rxt(k,543) & + *y(k,240) + mat(k,2126) = .0023005_r8*rxt(k,518)*y(k,9) + .2381005_r8*rxt(k,528)*y(k,110) & + + .1364005_r8*rxt(k,539)*y(k,218) + .1677005_r8*rxt(k,543) & + *y(k,222) + mat(k,1766) = .5931005_r8*rxt(k,537)*y(k,209) + mat(k,107) = .0034005_r8*rxt(k,519)*y(k,129) + .0008005_r8*rxt(k,518) & + *y(k,240) + mat(k,99) = .1026005_r8*rxt(k,529)*y(k,129) + .1308005_r8*rxt(k,528)*y(k,240) + mat(k,1531) = .0034005_r8*rxt(k,519)*y(k,9) + .1026005_r8*rxt(k,529)*y(k,110) & + + .0452005_r8*rxt(k,540)*y(k,218) + .0237005_r8*rxt(k,544) & + *y(k,222) + mat(k,119) = .1534005_r8*rxt(k,537)*y(k,251) + mat(k,125) = .0452005_r8*rxt(k,540)*y(k,129) + .0101005_r8*rxt(k,539) & + *y(k,240) + mat(k,131) = .0237005_r8*rxt(k,544)*y(k,129) + .0174005_r8*rxt(k,543) & + *y(k,240) + mat(k,2127) = .0008005_r8*rxt(k,518)*y(k,9) + .1308005_r8*rxt(k,528)*y(k,110) & + + .0101005_r8*rxt(k,539)*y(k,218) + .0174005_r8*rxt(k,543) & + *y(k,222) + mat(k,1767) = .1534005_r8*rxt(k,537)*y(k,209) + mat(k,108) = .1579005_r8*rxt(k,519)*y(k,129) + .0843005_r8*rxt(k,518) & + *y(k,240) + mat(k,100) = .0521005_r8*rxt(k,529)*y(k,129) + .0348005_r8*rxt(k,528) & + *y(k,240) + mat(k,1532) = .1579005_r8*rxt(k,519)*y(k,9) + .0521005_r8*rxt(k,529)*y(k,110) & + + .0966005_r8*rxt(k,540)*y(k,218) + .0025005_r8*rxt(k,544) & + *y(k,222) + mat(k,120) = .0459005_r8*rxt(k,537)*y(k,251) + mat(k,126) = .0966005_r8*rxt(k,540)*y(k,129) + .0763005_r8*rxt(k,539) & + *y(k,240) + mat(k,132) = .0025005_r8*rxt(k,544)*y(k,129) + .086_r8*rxt(k,543)*y(k,240) + mat(k,2128) = .0843005_r8*rxt(k,518)*y(k,9) + .0348005_r8*rxt(k,528)*y(k,110) & + + .0763005_r8*rxt(k,539)*y(k,218) + .086_r8*rxt(k,543)*y(k,222) + mat(k,1768) = .0459005_r8*rxt(k,537)*y(k,209) + mat(k,109) = .0059005_r8*rxt(k,519)*y(k,129) + .0443005_r8*rxt(k,518) & + *y(k,240) + mat(k,101) = .0143005_r8*rxt(k,529)*y(k,129) + .0076005_r8*rxt(k,528) & + *y(k,240) + mat(k,1533) = .0059005_r8*rxt(k,519)*y(k,9) + .0143005_r8*rxt(k,529)*y(k,110) & + + .0073005_r8*rxt(k,540)*y(k,218) + .011_r8*rxt(k,544)*y(k,222) + mat(k,121) = .0085005_r8*rxt(k,537)*y(k,251) + mat(k,127) = .0073005_r8*rxt(k,540)*y(k,129) + .2157005_r8*rxt(k,539) & + *y(k,240) + mat(k,133) = .011_r8*rxt(k,544)*y(k,129) + .0512005_r8*rxt(k,543)*y(k,240) + mat(k,2129) = .0443005_r8*rxt(k,518)*y(k,9) + .0076005_r8*rxt(k,528)*y(k,110) & + + .2157005_r8*rxt(k,539)*y(k,218) + .0512005_r8*rxt(k,543) & + *y(k,222) + mat(k,1769) = .0085005_r8*rxt(k,537)*y(k,209) + mat(k,110) = .0536005_r8*rxt(k,519)*y(k,129) + .1621005_r8*rxt(k,518) & + *y(k,240) + mat(k,102) = .0166005_r8*rxt(k,529)*y(k,129) + .0113005_r8*rxt(k,528) & + *y(k,240) + mat(k,1534) = .0536005_r8*rxt(k,519)*y(k,9) + .0166005_r8*rxt(k,529)*y(k,110) & + + .238_r8*rxt(k,540)*y(k,218) + .1185005_r8*rxt(k,544)*y(k,222) + mat(k,122) = .0128005_r8*rxt(k,537)*y(k,251) + mat(k,128) = .238_r8*rxt(k,540)*y(k,129) + .0738005_r8*rxt(k,539)*y(k,240) + mat(k,134) = .1185005_r8*rxt(k,544)*y(k,129) + .1598005_r8*rxt(k,543) & + *y(k,240) + mat(k,2130) = .1621005_r8*rxt(k,518)*y(k,9) + .0113005_r8*rxt(k,528)*y(k,110) & + + .0738005_r8*rxt(k,539)*y(k,218) + .1598005_r8*rxt(k,543) & + *y(k,222) + mat(k,1770) = .0128005_r8*rxt(k,537)*y(k,209) + mat(k,117) = -(rxt(k,536)*y(k,251)) + mat(k,1774) = -rxt(k,536)*y(k,208) + mat(k,123) = -(rxt(k,537)*y(k,251)) + mat(k,1775) = -rxt(k,537)*y(k,209) + mat(k,232) = .100_r8*rxt(k,448)*y(k,251) + mat(k,250) = .230_r8*rxt(k,450)*y(k,251) + mat(k,1789) = .100_r8*rxt(k,448)*y(k,217) + .230_r8*rxt(k,450)*y(k,220) + mat(k,695) = -(rxt(k,472)*y(k,251)) + mat(k,1854) = -rxt(k,472)*y(k,211) + mat(k,2167) = rxt(k,470)*y(k,255) + mat(k,1148) = rxt(k,470)*y(k,240) + mat(k,670) = -(rxt(k,473)*y(k,251)) + mat(k,1851) = -rxt(k,473)*y(k,212) + mat(k,1559) = .200_r8*rxt(k,466)*y(k,249) + .200_r8*rxt(k,476)*y(k,256) + mat(k,1623) = .500_r8*rxt(k,464)*y(k,249) + mat(k,1098) = .200_r8*rxt(k,466)*y(k,129) + .500_r8*rxt(k,464)*y(k,235) + mat(k,950) = .200_r8*rxt(k,476)*y(k,129) + mat(k,524) = -(rxt(k,477)*y(k,251)) + mat(k,1833) = -rxt(k,477)*y(k,213) + mat(k,2157) = rxt(k,475)*y(k,256) + mat(k,949) = rxt(k,475)*y(k,240) + mat(k,1016) = -(rxt(k,478)*y(k,131) + rxt(k,479)*y(k,251)) + mat(k,2045) = -rxt(k,478)*y(k,214) + mat(k,1884) = -rxt(k,479)*y(k,214) + mat(k,990) = .330_r8*rxt(k,459)*y(k,139) + mat(k,1038) = .330_r8*rxt(k,462)*y(k,139) + mat(k,1579) = .800_r8*rxt(k,466)*y(k,249) + .800_r8*rxt(k,476)*y(k,256) + mat(k,2045) = mat(k,2045) + rxt(k,467)*y(k,249) + mat(k,2291) = .330_r8*rxt(k,459)*y(k,6) + .330_r8*rxt(k,462)*y(k,116) + mat(k,671) = rxt(k,473)*y(k,251) + mat(k,1633) = .500_r8*rxt(k,464)*y(k,249) + rxt(k,474)*y(k,256) + mat(k,1100) = .800_r8*rxt(k,466)*y(k,129) + rxt(k,467)*y(k,131) & + + .500_r8*rxt(k,464)*y(k,235) + mat(k,1884) = mat(k,1884) + rxt(k,473)*y(k,212) + mat(k,954) = .800_r8*rxt(k,476)*y(k,129) + rxt(k,474)*y(k,235) + mat(k,1115) = -(rxt(k,480)*y(k,251)) + mat(k,1889) = -rxt(k,480)*y(k,215) + mat(k,992) = .300_r8*rxt(k,459)*y(k,139) + mat(k,1041) = .300_r8*rxt(k,462)*y(k,139) + mat(k,1582) = .900_r8*rxt(k,471)*y(k,255) + mat(k,2295) = .300_r8*rxt(k,459)*y(k,6) + .300_r8*rxt(k,462)*y(k,116) + mat(k,1636) = rxt(k,469)*y(k,255) + mat(k,1152) = .900_r8*rxt(k,471)*y(k,129) + rxt(k,469)*y(k,235) + mat(k,648) = -(rxt(k,447)*y(k,251)) + mat(k,1848) = -rxt(k,447)*y(k,216) + mat(k,2164) = rxt(k,445)*y(k,257) + mat(k,769) = rxt(k,445)*y(k,240) + mat(k,230) = -(rxt(k,448)*y(k,251)) + mat(k,1787) = -rxt(k,448)*y(k,217) + mat(k,129) = -(rxt(k,539)*y(k,240) + rxt(k,540)*y(k,129)) + mat(k,2133) = -rxt(k,539)*y(k,218) + mat(k,1537) = -rxt(k,540)*y(k,218) + mat(k,229) = rxt(k,538)*y(k,251) + mat(k,1776) = rxt(k,538)*y(k,217) end do end subroutine nlnmat07 subroutine nlnmat08( avec_len, mat, y, rxt ) @@ -1783,277 +1678,382 @@ subroutine nlnmat08( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,384) = -(rxt(k,288)*y(k,232) + rxt(k,290)*y(k,123)) - mat(k,1450) = -rxt(k,288)*y(k,233) - mat(k,1340) = -rxt(k,290)*y(k,233) - mat(k,1709) = rxt(k,274)*y(k,232) - mat(k,1450) = mat(k,1450) + rxt(k,274)*y(k,42) - mat(k,1152) = -(rxt(k,385)*y(k,226) + rxt(k,386)*y(k,227) + rxt(k,387) & - *y(k,232) + rxt(k,388)*y(k,123) + rxt(k,389)*y(k,125)) - mat(k,1275) = -rxt(k,385)*y(k,234) - mat(k,1857) = -rxt(k,386)*y(k,234) - mat(k,1502) = -rxt(k,387)*y(k,234) - mat(k,1386) = -rxt(k,388)*y(k,234) - mat(k,1806) = -rxt(k,389)*y(k,234) - mat(k,771) = .600_r8*rxt(k,406)*y(k,243) - mat(k,1685) = .600_r8*rxt(k,406)*y(k,98) - mat(k,1230) = -(rxt(k,390)*y(k,226) + rxt(k,391)*y(k,227) + rxt(k,392) & - *y(k,232) + rxt(k,394)*y(k,123) + rxt(k,395)*y(k,125)) - mat(k,1278) = -rxt(k,390)*y(k,235) - mat(k,1860) = -rxt(k,391)*y(k,235) - mat(k,1505) = -rxt(k,392)*y(k,235) - mat(k,1389) = -rxt(k,394)*y(k,235) - mat(k,1809) = -rxt(k,395)*y(k,235) - mat(k,773) = .400_r8*rxt(k,406)*y(k,243) - mat(k,1688) = .400_r8*rxt(k,406)*y(k,98) - mat(k,1197) = -(rxt(k,352)*y(k,226) + rxt(k,353)*y(k,227) + rxt(k,354) & - *y(k,232) + rxt(k,355)*y(k,125) + (rxt(k,356) + rxt(k,357) & - ) * y(k,123)) - mat(k,1277) = -rxt(k,352)*y(k,236) - mat(k,1859) = -rxt(k,353)*y(k,236) - mat(k,1504) = -rxt(k,354)*y(k,236) - mat(k,1808) = -rxt(k,355)*y(k,236) - mat(k,1388) = -(rxt(k,356) + rxt(k,357)) * y(k,236) - mat(k,1106) = .500_r8*rxt(k,359)*y(k,243) - mat(k,290) = .200_r8*rxt(k,360)*y(k,243) - mat(k,1175) = rxt(k,373)*y(k,243) - mat(k,1687) = .500_r8*rxt(k,359)*y(k,106) + .200_r8*rxt(k,360)*y(k,107) & - + rxt(k,373)*y(k,112) - mat(k,627) = -(rxt(k,433)*y(k,232) + rxt(k,434)*y(k,123) + rxt(k,435) & - *y(k,124)) - mat(k,1471) = -rxt(k,433)*y(k,237) - mat(k,1357) = -rxt(k,434)*y(k,237) - mat(k,1742) = -rxt(k,435)*y(k,237) - mat(k,1249) = -(rxt(k,361)*y(k,226) + rxt(k,362)*y(k,227) + rxt(k,363) & - *y(k,232) + 4._r8*rxt(k,364)*y(k,238) + rxt(k,365)*y(k,123) & - + rxt(k,366)*y(k,125) + rxt(k,374)*y(k,124)) - mat(k,1279) = -rxt(k,361)*y(k,238) - mat(k,1861) = -rxt(k,362)*y(k,238) - mat(k,1506) = -rxt(k,363)*y(k,238) - mat(k,1390) = -rxt(k,365)*y(k,238) - mat(k,1810) = -rxt(k,366)*y(k,238) - mat(k,1753) = -rxt(k,374)*y(k,238) - mat(k,1107) = .500_r8*rxt(k,359)*y(k,243) - mat(k,291) = .500_r8*rxt(k,360)*y(k,243) - mat(k,1689) = .500_r8*rxt(k,359)*y(k,106) + .500_r8*rxt(k,360)*y(k,107) - mat(k,782) = -(rxt(k,436)*y(k,232) + rxt(k,437)*y(k,123) + rxt(k,438) & - *y(k,124)) - mat(k,1483) = -rxt(k,436)*y(k,239) - mat(k,1366) = -rxt(k,437)*y(k,239) - mat(k,1746) = -rxt(k,438)*y(k,239) - mat(k,588) = -(rxt(k,367)*y(k,232) + rxt(k,368)*y(k,123)) - mat(k,1467) = -rxt(k,367)*y(k,240) - mat(k,1355) = -rxt(k,368)*y(k,240) - mat(k,448) = rxt(k,369)*y(k,243) - mat(k,285) = rxt(k,370)*y(k,243) - mat(k,1640) = rxt(k,369)*y(k,108) + rxt(k,370)*y(k,109) - mat(k,1013) = -(rxt(k,465)*y(k,227) + rxt(k,466)*y(k,232) + rxt(k,467) & - *y(k,123) + rxt(k,468)*y(k,125)) - mat(k,1850) = -rxt(k,465)*y(k,241) - mat(k,1494) = -rxt(k,466)*y(k,241) - mat(k,1379) = -rxt(k,467)*y(k,241) - mat(k,1798) = -rxt(k,468)*y(k,241) - mat(k,838) = rxt(k,459)*y(k,125) - mat(k,812) = rxt(k,462)*y(k,125) - mat(k,1798) = mat(k,1798) + rxt(k,459)*y(k,6) + rxt(k,462)*y(k,111) & - + .500_r8*rxt(k,479)*y(k,208) - mat(k,330) = rxt(k,469)*y(k,243) - mat(k,885) = .500_r8*rxt(k,479)*y(k,125) - mat(k,1676) = rxt(k,469)*y(k,127) - mat(k,1538) = -(rxt(k,144)*y(k,77) + rxt(k,145)*y(k,253) + rxt(k,148) & - *y(k,133) + (rxt(k,226) + rxt(k,227)) * y(k,85) + (rxt(k,249) & - + rxt(k,250)) * y(k,81) + rxt(k,255)*y(k,64) + rxt(k,256) & - *y(k,65) + rxt(k,294)*y(k,86)) - mat(k,1055) = -rxt(k,144)*y(k,242) - mat(k,2067) = -rxt(k,145)*y(k,242) - mat(k,1928) = -rxt(k,148)*y(k,242) - mat(k,1420) = -(rxt(k,226) + rxt(k,227)) * y(k,242) - mat(k,723) = -(rxt(k,249) + rxt(k,250)) * y(k,242) - mat(k,111) = -rxt(k,255)*y(k,242) - mat(k,142) = -rxt(k,256)*y(k,242) - mat(k,146) = -rxt(k,294)*y(k,242) - mat(k,1698) = -(rxt(k,161)*y(k,77) + rxt(k,162)*y(k,79) + rxt(k,163)*y(k,232) & - + rxt(k,164)*y(k,132) + rxt(k,165)*y(k,133) + (4._r8*rxt(k,166) & - + 4._r8*rxt(k,167)) * y(k,243) + rxt(k,169)*y(k,90) + rxt(k,181) & - *y(k,125) + rxt(k,182)*y(k,113) + rxt(k,190)*y(k,124) + rxt(k,191) & - *y(k,89) + rxt(k,210)*y(k,60) + (rxt(k,212) + rxt(k,213) & - ) * y(k,59) + rxt(k,215)*y(k,85) + rxt(k,218)*y(k,92) + rxt(k,242) & - *y(k,19) + rxt(k,244)*y(k,81) + rxt(k,277)*y(k,42) + rxt(k,282) & - *y(k,52) + rxt(k,283)*y(k,53) + (rxt(k,285) + rxt(k,295) & - ) * y(k,62) + rxt(k,286)*y(k,86) + rxt(k,287)*y(k,87) + rxt(k,297) & - *y(k,24) + rxt(k,304)*y(k,26) + rxt(k,305)*y(k,27) + rxt(k,307) & - *y(k,28) + rxt(k,309)*y(k,45) + rxt(k,310)*y(k,47) + rxt(k,315) & - *y(k,50) + rxt(k,316)*y(k,51) + rxt(k,321)*y(k,74) + rxt(k,322) & - *y(k,75) + rxt(k,323)*y(k,138) + rxt(k,324)*y(k,25) + rxt(k,332) & - *y(k,30) + rxt(k,333)*y(k,31) + rxt(k,335)*y(k,49) + rxt(k,336) & - *y(k,95) + rxt(k,337)*y(k,126) + rxt(k,340)*y(k,147) + rxt(k,344) & - *y(k,148) + rxt(k,345)*y(k,29) + rxt(k,346)*y(k,48) + rxt(k,348) & - *y(k,16) + rxt(k,351)*y(k,93) + rxt(k,359)*y(k,106) + rxt(k,360) & - *y(k,107) + rxt(k,369)*y(k,108) + rxt(k,370)*y(k,109) + rxt(k,371) & - *y(k,110) + rxt(k,373)*y(k,112) + rxt(k,376)*y(k,1) + rxt(k,380) & - *y(k,2) + rxt(k,381)*y(k,15) + rxt(k,382)*y(k,94) + rxt(k,383) & - *y(k,96) + rxt(k,384)*y(k,97) + rxt(k,396)*y(k,99) + rxt(k,397) & - *y(k,100) + rxt(k,404)*y(k,102) + rxt(k,406)*y(k,98) + rxt(k,407) & - *y(k,103) + rxt(k,408)*y(k,116) + rxt(k,409)*y(k,117) + rxt(k,415) & - *y(k,212) + rxt(k,418)*y(k,7) + rxt(k,421)*y(k,8) + rxt(k,422) & - *y(k,22) + rxt(k,424)*y(k,23) + rxt(k,428)*y(k,32) + rxt(k,429) & - *y(k,66) + rxt(k,441)*y(k,141) + rxt(k,444)*y(k,142) + rxt(k,448) & - *y(k,210) + rxt(k,449)*y(k,211) + rxt(k,451)*y(k,213) + rxt(k,454) & - *y(k,214) + rxt(k,457)*y(k,215) + rxt(k,458)*y(k,216) + rxt(k,461) & - *y(k,6) + rxt(k,464)*y(k,111) + rxt(k,469)*y(k,127) + rxt(k,473) & - *y(k,205) + rxt(k,474)*y(k,206) + rxt(k,478)*y(k,207) + rxt(k,480) & - *y(k,208) + rxt(k,481)*y(k,209) + (rxt(k,483) + rxt(k,496) & - ) * y(k,67) + rxt(k,485)*y(k,136) + rxt(k,490)*y(k,149) & - + rxt(k,495)*y(k,151) + rxt(k,497)*y(k,152) + rxt(k,499) & - *y(k,121)) - mat(k,1056) = -rxt(k,161)*y(k,243) - mat(k,523) = -rxt(k,162)*y(k,243) - mat(k,1515) = -rxt(k,163)*y(k,243) - mat(k,2009) = -rxt(k,164)*y(k,243) - mat(k,1929) = -rxt(k,165)*y(k,243) - mat(k,360) = -rxt(k,169)*y(k,243) - mat(k,1819) = -rxt(k,181)*y(k,243) - mat(k,367) = -rxt(k,182)*y(k,243) - mat(k,1762) = -rxt(k,190)*y(k,243) - mat(k,1311) = -rxt(k,191)*y(k,243) - mat(k,874) = -rxt(k,210)*y(k,243) - mat(k,1979) = -(rxt(k,212) + rxt(k,213)) * y(k,243) - mat(k,1421) = -rxt(k,215)*y(k,243) - mat(k,731) = -rxt(k,218)*y(k,243) - mat(k,1953) = -rxt(k,242)*y(k,243) - mat(k,724) = -rxt(k,244)*y(k,243) - mat(k,1721) = -rxt(k,277)*y(k,243) - mat(k,703) = -rxt(k,282)*y(k,243) - mat(k,354) = -rxt(k,283)*y(k,243) - mat(k,958) = -(rxt(k,285) + rxt(k,295)) * y(k,243) - mat(k,147) = -rxt(k,286)*y(k,243) - mat(k,707) = -rxt(k,287)*y(k,243) - mat(k,242) = -rxt(k,297)*y(k,243) - mat(k,219) = -rxt(k,304)*y(k,243) - mat(k,280) = -rxt(k,305)*y(k,243) - mat(k,246) = -rxt(k,307)*y(k,243) - mat(k,1045) = -rxt(k,309)*y(k,243) - mat(k,95) = -rxt(k,310)*y(k,243) - mat(k,468) = -rxt(k,315)*y(k,243) - mat(k,437) = -rxt(k,316)*y(k,243) - mat(k,927) = -rxt(k,321)*y(k,243) - mat(k,795) = -rxt(k,322)*y(k,243) - mat(k,406) = -rxt(k,323)*y(k,243) - mat(k,492) = -rxt(k,324)*y(k,243) - mat(k,344) = -rxt(k,332)*y(k,243) - mat(k,101) = -rxt(k,333)*y(k,243) - mat(k,1121) = -rxt(k,335)*y(k,243) - mat(k,963) = -rxt(k,336)*y(k,243) - mat(k,750) = -rxt(k,337)*y(k,243) - mat(k,464) = -rxt(k,340)*y(k,243) - mat(k,319) = -rxt(k,344)*y(k,243) - mat(k,901) = -rxt(k,345)*y(k,243) - mat(k,866) = -rxt(k,346)*y(k,243) - mat(k,298) = -rxt(k,348)*y(k,243) - mat(k,940) = -rxt(k,351)*y(k,243) - mat(k,1111) = -rxt(k,359)*y(k,243) - mat(k,293) = -rxt(k,360)*y(k,243) - mat(k,451) = -rxt(k,369)*y(k,243) - mat(k,288) = -rxt(k,370)*y(k,243) - mat(k,483) = -rxt(k,371)*y(k,243) - mat(k,1181) = -rxt(k,373)*y(k,243) - mat(k,573) = -rxt(k,376)*y(k,243) - mat(k,585) = -rxt(k,380)*y(k,243) - mat(k,196) = -rxt(k,381)*y(k,243) - mat(k,207) = -rxt(k,382)*y(k,243) - mat(k,283) = -rxt(k,383)*y(k,243) - mat(k,105) = -rxt(k,384)*y(k,243) - mat(k,517) = -rxt(k,396)*y(k,243) - mat(k,478) = -rxt(k,397)*y(k,243) - mat(k,326) = -rxt(k,404)*y(k,243) - mat(k,776) = -rxt(k,406)*y(k,243) - mat(k,601) = -rxt(k,407)*y(k,243) - mat(k,315) = -rxt(k,408)*y(k,243) - mat(k,919) = -rxt(k,409)*y(k,243) - mat(k,171) = -rxt(k,415)*y(k,243) - mat(k,128) = -rxt(k,418)*y(k,243) - mat(k,351) = -rxt(k,421)*y(k,243) - mat(k,202) = -rxt(k,422)*y(k,243) - mat(k,275) = -rxt(k,424)*y(k,243) - mat(k,223) = -rxt(k,428)*y(k,243) - mat(k,164) = -rxt(k,429)*y(k,243) - mat(k,137) = -rxt(k,441)*y(k,243) - mat(k,269) = -rxt(k,444)*y(k,243) - mat(k,546) = -rxt(k,448)*y(k,243) - mat(k,159) = -rxt(k,449)*y(k,243) - mat(k,185) = -rxt(k,451)*y(k,243) - mat(k,617) = -rxt(k,454)*y(k,243) - mat(k,190) = -rxt(k,457)*y(k,243) - mat(k,375) = -rxt(k,458)*y(k,243) - mat(k,843) = -rxt(k,461)*y(k,243) - mat(k,817) = -rxt(k,464)*y(k,243) - mat(k,332) = -rxt(k,469)*y(k,243) - mat(k,534) = -rxt(k,473)*y(k,243) - mat(k,555) = -rxt(k,474)*y(k,243) - mat(k,416) = -rxt(k,478)*y(k,243) - mat(k,887) = -rxt(k,480)*y(k,243) - mat(k,951) = -rxt(k,481)*y(k,243) - mat(k,253) = -(rxt(k,483) + rxt(k,496)) * y(k,243) - mat(k,308) = -rxt(k,485)*y(k,243) - mat(k,444) = -rxt(k,490)*y(k,243) - mat(k,1132) = -rxt(k,495)*y(k,243) - mat(k,757) = -rxt(k,497)*y(k,243) - mat(k,91) = -rxt(k,499)*y(k,243) - mat(k,843) = mat(k,843) + .630_r8*rxt(k,460)*y(k,133) - mat(k,242) = mat(k,242) + .650_r8*rxt(k,297)*y(k,243) - mat(k,492) = mat(k,492) + .130_r8*rxt(k,299)*y(k,133) - mat(k,280) = mat(k,280) + .500_r8*rxt(k,305)*y(k,243) - mat(k,901) = mat(k,901) + .360_r8*rxt(k,328)*y(k,133) - mat(k,1721) = mat(k,1721) + rxt(k,276)*y(k,132) - mat(k,354) = mat(k,354) + .300_r8*rxt(k,283)*y(k,243) - mat(k,2043) = rxt(k,199)*y(k,232) - mat(k,697) = rxt(k,253)*y(k,253) - mat(k,1324) = rxt(k,160)*y(k,133) + 2.000_r8*rxt(k,155)*y(k,232) - mat(k,1056) = mat(k,1056) + rxt(k,152)*y(k,132) + rxt(k,144)*y(k,242) - mat(k,523) = mat(k,523) + rxt(k,153)*y(k,132) - mat(k,724) = mat(k,724) + rxt(k,243)*y(k,132) + rxt(k,249)*y(k,242) - mat(k,1421) = mat(k,1421) + rxt(k,214)*y(k,132) + rxt(k,226)*y(k,242) - mat(k,147) = mat(k,147) + rxt(k,294)*y(k,242) - mat(k,687) = rxt(k,245)*y(k,132) - mat(k,731) = mat(k,731) + rxt(k,217)*y(k,132) - mat(k,776) = mat(k,776) + .320_r8*rxt(k,405)*y(k,133) - mat(k,601) = mat(k,601) + .600_r8*rxt(k,407)*y(k,243) - mat(k,1111) = mat(k,1111) + .240_r8*rxt(k,358)*y(k,133) - mat(k,293) = mat(k,293) + .100_r8*rxt(k,360)*y(k,243) - mat(k,817) = mat(k,817) + .630_r8*rxt(k,463)*y(k,133) - mat(k,1181) = mat(k,1181) + .360_r8*rxt(k,372)*y(k,133) - mat(k,1399) = rxt(k,183)*y(k,232) - mat(k,1819) = mat(k,1819) + rxt(k,178)*y(k,232) - mat(k,2009) = mat(k,2009) + rxt(k,276)*y(k,42) + rxt(k,152)*y(k,77) & - + rxt(k,153)*y(k,79) + rxt(k,243)*y(k,81) + rxt(k,214)*y(k,85) & - + rxt(k,245)*y(k,91) + rxt(k,217)*y(k,92) + rxt(k,158)*y(k,232) - mat(k,1929) = mat(k,1929) + .630_r8*rxt(k,460)*y(k,6) + .130_r8*rxt(k,299) & - *y(k,25) + .360_r8*rxt(k,328)*y(k,29) + rxt(k,160)*y(k,76) & - + .320_r8*rxt(k,405)*y(k,98) + .240_r8*rxt(k,358)*y(k,106) & - + .630_r8*rxt(k,463)*y(k,111) + .360_r8*rxt(k,372)*y(k,112) & - + rxt(k,159)*y(k,232) - mat(k,464) = mat(k,464) + .500_r8*rxt(k,340)*y(k,243) - mat(k,171) = mat(k,171) + .500_r8*rxt(k,415)*y(k,243) - mat(k,457) = .400_r8*rxt(k,416)*y(k,232) - mat(k,1285) = .450_r8*rxt(k,313)*y(k,232) - mat(k,670) = .400_r8*rxt(k,430)*y(k,232) - mat(k,1515) = mat(k,1515) + rxt(k,199)*y(k,56) + 2.000_r8*rxt(k,155)*y(k,76) & - + rxt(k,183)*y(k,123) + rxt(k,178)*y(k,125) + rxt(k,158) & - *y(k,132) + rxt(k,159)*y(k,133) + .400_r8*rxt(k,416)*y(k,219) & - + .450_r8*rxt(k,313)*y(k,226) + .400_r8*rxt(k,430)*y(k,228) & - + .450_r8*rxt(k,363)*y(k,238) + .400_r8*rxt(k,436)*y(k,239) & - + .200_r8*rxt(k,367)*y(k,240) + .150_r8*rxt(k,342)*y(k,246) - mat(k,1255) = .450_r8*rxt(k,363)*y(k,232) - mat(k,788) = .400_r8*rxt(k,436)*y(k,232) - mat(k,593) = .200_r8*rxt(k,367)*y(k,232) - mat(k,1539) = rxt(k,144)*y(k,77) + rxt(k,249)*y(k,81) + rxt(k,226)*y(k,85) & - + rxt(k,294)*y(k,86) + 2.000_r8*rxt(k,145)*y(k,253) - mat(k,1698) = mat(k,1698) + .650_r8*rxt(k,297)*y(k,24) + .500_r8*rxt(k,305) & - *y(k,27) + .300_r8*rxt(k,283)*y(k,53) + .600_r8*rxt(k,407) & - *y(k,103) + .100_r8*rxt(k,360)*y(k,107) + .500_r8*rxt(k,340) & - *y(k,147) + .500_r8*rxt(k,415)*y(k,212) - mat(k,1034) = .150_r8*rxt(k,342)*y(k,232) - mat(k,2068) = rxt(k,253)*y(k,73) + 2.000_r8*rxt(k,145)*y(k,242) + mat(k,246) = -(rxt(k,414)*y(k,251)) + mat(k,1790) = -rxt(k,414)*y(k,219) + mat(k,2136) = rxt(k,411)*y(k,258) + mat(k,1206) = rxt(k,411)*y(k,240) + mat(k,251) = -(rxt(k,450)*y(k,251)) + mat(k,1791) = -rxt(k,450)*y(k,220) + mat(k,741) = -(rxt(k,453)*y(k,251)) + mat(k,1859) = -rxt(k,453)*y(k,221) + mat(k,2172) = rxt(k,451)*y(k,259) + mat(k,786) = rxt(k,451)*y(k,240) + mat(k,135) = -(rxt(k,543)*y(k,240) + rxt(k,544)*y(k,129)) + mat(k,2134) = -rxt(k,543)*y(k,222) + mat(k,1538) = -rxt(k,544)*y(k,222) + mat(k,249) = rxt(k,542)*y(k,251) + mat(k,1777) = rxt(k,542)*y(k,220) + mat(k,259) = -(rxt(k,456)*y(k,251)) + mat(k,1792) = -rxt(k,456)*y(k,223) + mat(k,252) = .150_r8*rxt(k,450)*y(k,251) + mat(k,1792) = mat(k,1792) + .150_r8*rxt(k,450)*y(k,220) + mat(k,469) = -(rxt(k,457)*y(k,251)) + mat(k,1826) = -rxt(k,457)*y(k,224) + mat(k,2151) = rxt(k,454)*y(k,260) + mat(k,540) = rxt(k,454)*y(k,240) + mat(k,554) = -(rxt(k,415)*y(k,240) + rxt(k,416)*y(k,129) + rxt(k,444) & + *y(k,130)) + mat(k,2160) = -rxt(k,415)*y(k,227) + mat(k,1554) = -rxt(k,416)*y(k,227) + mat(k,1677) = -rxt(k,444)*y(k,227) + mat(k,283) = rxt(k,421)*y(k,251) + mat(k,1837) = rxt(k,421)*y(k,24) + mat(k,939) = -(rxt(k,376)*y(k,240) + (rxt(k,377) + rxt(k,378)) * y(k,129)) + mat(k,2187) = -rxt(k,376)*y(k,228) + mat(k,1574) = -(rxt(k,377) + rxt(k,378)) * y(k,228) + mat(k,709) = rxt(k,379)*y(k,251) + mat(k,274) = rxt(k,380)*y(k,251) + mat(k,1878) = rxt(k,379)*y(k,2) + rxt(k,380)*y(k,17) + mat(k,533) = -(rxt(k,418)*y(k,240) + rxt(k,419)*y(k,129)) + mat(k,2158) = -rxt(k,418)*y(k,229) + mat(k,1551) = -rxt(k,419)*y(k,229) + mat(k,210) = .350_r8*rxt(k,417)*y(k,251) + mat(k,423) = rxt(k,420)*y(k,251) + mat(k,1834) = .350_r8*rxt(k,417)*y(k,8) + rxt(k,420)*y(k,10) + mat(k,477) = -(rxt(k,422)*y(k,240) + rxt(k,424)*y(k,129)) + mat(k,2152) = -rxt(k,422)*y(k,230) + mat(k,1545) = -rxt(k,424)*y(k,230) + mat(k,374) = rxt(k,423)*y(k,251) + mat(k,233) = .070_r8*rxt(k,448)*y(k,251) + mat(k,253) = .060_r8*rxt(k,450)*y(k,251) + mat(k,1827) = rxt(k,423)*y(k,25) + .070_r8*rxt(k,448)*y(k,217) & + + .060_r8*rxt(k,450)*y(k,220) + mat(k,860) = -(4._r8*rxt(k,299)*y(k,231) + rxt(k,300)*y(k,235) + rxt(k,301) & + *y(k,240) + rxt(k,302)*y(k,129)) + mat(k,1627) = -rxt(k,300)*y(k,231) + mat(k,2183) = -rxt(k,301)*y(k,231) + mat(k,1570) = -rxt(k,302)*y(k,231) + mat(k,379) = .500_r8*rxt(k,304)*y(k,251) + mat(k,331) = rxt(k,305)*y(k,58) + rxt(k,306)*y(k,251) + mat(k,2242) = rxt(k,305)*y(k,30) + mat(k,1870) = .500_r8*rxt(k,304)*y(k,29) + rxt(k,306)*y(k,30) + mat(k,831) = -(rxt(k,328)*y(k,235) + rxt(k,329)*y(k,240) + rxt(k,330) & + *y(k,129)) + mat(k,1626) = -rxt(k,328)*y(k,232) + mat(k,2180) = -rxt(k,329)*y(k,232) + mat(k,1569) = -rxt(k,330)*y(k,232) + mat(k,428) = rxt(k,331)*y(k,251) + mat(k,149) = rxt(k,332)*y(k,251) + mat(k,1867) = rxt(k,331)*y(k,32) + rxt(k,332)*y(k,33) + mat(k,678) = -(rxt(k,425)*y(k,240) + rxt(k,426)*y(k,129)) + mat(k,2166) = -rxt(k,425)*y(k,233) + mat(k,1560) = -rxt(k,426)*y(k,233) + mat(k,309) = rxt(k,427)*y(k,251) + mat(k,1560) = mat(k,1560) + rxt(k,416)*y(k,227) + mat(k,2280) = rxt(k,442)*y(k,146) + mat(k,514) = rxt(k,442)*y(k,139) + mat(k,555) = rxt(k,416)*y(k,129) + .400_r8*rxt(k,415)*y(k,240) + mat(k,2166) = mat(k,2166) + .400_r8*rxt(k,415)*y(k,227) + mat(k,1852) = rxt(k,427)*y(k,34) + mat(k,1426) = -(4._r8*rxt(k,310)*y(k,234) + rxt(k,311)*y(k,235) + rxt(k,312) & + *y(k,240) + rxt(k,313)*y(k,129) + rxt(k,324)*y(k,130) + rxt(k,351) & + *y(k,244) + rxt(k,384)*y(k,242) + rxt(k,389)*y(k,243) + rxt(k,398) & + *y(k,103) + rxt(k,409)*y(k,258)) + mat(k,1652) = -rxt(k,311)*y(k,234) + mat(k,2210) = -rxt(k,312)*y(k,234) + mat(k,1599) = -rxt(k,313)*y(k,234) + mat(k,1695) = -rxt(k,324)*y(k,234) + mat(k,1353) = -rxt(k,351)*y(k,234) + mat(k,1300) = -rxt(k,384)*y(k,234) + mat(k,1332) = -rxt(k,389)*y(k,234) + mat(k,1237) = -rxt(k,398)*y(k,234) + mat(k,1215) = -rxt(k,409)*y(k,234) + mat(k,997) = .060_r8*rxt(k,459)*y(k,139) + mat(k,1127) = rxt(k,307)*y(k,131) + rxt(k,308)*y(k,251) + mat(k,1262) = rxt(k,333)*y(k,131) + rxt(k,334)*y(k,251) + mat(k,625) = .500_r8*rxt(k,315)*y(k,251) + mat(k,883) = .080_r8*rxt(k,404)*y(k,139) + mat(k,1253) = .100_r8*rxt(k,357)*y(k,139) + mat(k,1047) = .060_r8*rxt(k,462)*y(k,139) + mat(k,1374) = .280_r8*rxt(k,371)*y(k,139) + mat(k,1599) = mat(k,1599) + .530_r8*rxt(k,355)*y(k,244) + rxt(k,364)*y(k,246) & + + rxt(k,367)*y(k,248) + rxt(k,342)*y(k,254) + mat(k,2068) = rxt(k,307)*y(k,47) + rxt(k,333)*y(k,51) + .530_r8*rxt(k,354) & + *y(k,244) + rxt(k,365)*y(k,246) + mat(k,2311) = .060_r8*rxt(k,459)*y(k,6) + .080_r8*rxt(k,404)*y(k,100) & + + .100_r8*rxt(k,357)*y(k,111) + .060_r8*rxt(k,462)*y(k,116) & + + .280_r8*rxt(k,371)*y(k,118) + mat(k,1118) = .650_r8*rxt(k,480)*y(k,251) + mat(k,1426) = mat(k,1426) + .530_r8*rxt(k,351)*y(k,244) + mat(k,1652) = mat(k,1652) + .260_r8*rxt(k,352)*y(k,244) + rxt(k,361)*y(k,246) & + + .300_r8*rxt(k,340)*y(k,254) + mat(k,2210) = mat(k,2210) + .450_r8*rxt(k,362)*y(k,246) + .200_r8*rxt(k,366) & + *y(k,248) + .150_r8*rxt(k,341)*y(k,254) + mat(k,1353) = mat(k,1353) + .530_r8*rxt(k,355)*y(k,129) + .530_r8*rxt(k,354) & + *y(k,131) + .530_r8*rxt(k,351)*y(k,234) + .260_r8*rxt(k,352) & + *y(k,235) + mat(k,1395) = rxt(k,364)*y(k,129) + rxt(k,365)*y(k,131) + rxt(k,361)*y(k,235) & + + .450_r8*rxt(k,362)*y(k,240) + 4.000_r8*rxt(k,363)*y(k,246) + mat(k,719) = rxt(k,367)*y(k,129) + .200_r8*rxt(k,366)*y(k,240) + mat(k,1907) = rxt(k,308)*y(k,47) + rxt(k,334)*y(k,51) + .500_r8*rxt(k,315) & + *y(k,53) + .650_r8*rxt(k,480)*y(k,215) + mat(k,1172) = rxt(k,342)*y(k,129) + .300_r8*rxt(k,340)*y(k,235) & + + .150_r8*rxt(k,341)*y(k,240) + mat(k,1657) = -(rxt(k,201)*y(k,61) + (4._r8*rxt(k,278) + 4._r8*rxt(k,279) & + ) * y(k,235) + rxt(k,280)*y(k,240) + rxt(k,281)*y(k,129) & + + rxt(k,300)*y(k,231) + rxt(k,311)*y(k,234) + rxt(k,328) & + *y(k,232) + rxt(k,340)*y(k,254) + rxt(k,352)*y(k,244) + rxt(k,361) & + *y(k,246) + rxt(k,385)*y(k,242) + rxt(k,390)*y(k,243) + rxt(k,399) & + *y(k,103) + rxt(k,410)*y(k,258) + rxt(k,464)*y(k,249) + rxt(k,469) & + *y(k,255) + rxt(k,474)*y(k,256)) + mat(k,1940) = -rxt(k,201)*y(k,235) + mat(k,2217) = -rxt(k,280)*y(k,235) + mat(k,1605) = -rxt(k,281)*y(k,235) + mat(k,863) = -rxt(k,300)*y(k,235) + mat(k,1430) = -rxt(k,311)*y(k,235) + mat(k,835) = -rxt(k,328)*y(k,235) + mat(k,1174) = -rxt(k,340)*y(k,235) + mat(k,1356) = -rxt(k,352)*y(k,235) + mat(k,1398) = -rxt(k,361)*y(k,235) + mat(k,1303) = -rxt(k,385)*y(k,235) + mat(k,1335) = -rxt(k,390)*y(k,235) + mat(k,1240) = -rxt(k,399)*y(k,235) + mat(k,1217) = -rxt(k,410)*y(k,235) + mat(k,1107) = -rxt(k,464)*y(k,235) + mat(k,1160) = -rxt(k,469)*y(k,235) + mat(k,957) = -rxt(k,474)*y(k,235) + mat(k,1072) = .280_r8*rxt(k,327)*y(k,139) + mat(k,726) = rxt(k,314)*y(k,251) + mat(k,453) = .700_r8*rxt(k,283)*y(k,251) + mat(k,1473) = rxt(k,195)*y(k,58) + rxt(k,251)*y(k,75) + rxt(k,290)*y(k,250) & + + rxt(k,284)*y(k,251) + mat(k,2256) = rxt(k,195)*y(k,56) + mat(k,918) = rxt(k,251)*y(k,56) + mat(k,884) = .050_r8*rxt(k,404)*y(k,139) + mat(k,1240) = mat(k,1240) + rxt(k,398)*y(k,234) + mat(k,1605) = mat(k,1605) + rxt(k,313)*y(k,234) + .830_r8*rxt(k,430)*y(k,236) & + + .170_r8*rxt(k,436)*y(k,247) + mat(k,2317) = .280_r8*rxt(k,327)*y(k,31) + .050_r8*rxt(k,404)*y(k,100) + mat(k,1430) = mat(k,1430) + rxt(k,398)*y(k,103) + rxt(k,313)*y(k,129) & + + 4.000_r8*rxt(k,310)*y(k,234) + .900_r8*rxt(k,311)*y(k,235) & + + .450_r8*rxt(k,312)*y(k,240) + rxt(k,384)*y(k,242) + rxt(k,389) & + *y(k,243) + rxt(k,351)*y(k,244) + rxt(k,360)*y(k,246) & + + rxt(k,409)*y(k,258) + mat(k,1657) = mat(k,1657) + .900_r8*rxt(k,311)*y(k,234) + mat(k,803) = .830_r8*rxt(k,430)*y(k,129) + .330_r8*rxt(k,429)*y(k,240) + mat(k,2217) = mat(k,2217) + .450_r8*rxt(k,312)*y(k,234) + .330_r8*rxt(k,429) & + *y(k,236) + .070_r8*rxt(k,435)*y(k,247) + mat(k,1303) = mat(k,1303) + rxt(k,384)*y(k,234) + mat(k,1335) = mat(k,1335) + rxt(k,389)*y(k,234) + mat(k,1356) = mat(k,1356) + rxt(k,351)*y(k,234) + mat(k,1398) = mat(k,1398) + rxt(k,360)*y(k,234) + mat(k,908) = .170_r8*rxt(k,436)*y(k,129) + .070_r8*rxt(k,435)*y(k,240) + mat(k,1742) = rxt(k,290)*y(k,56) + mat(k,1914) = rxt(k,314)*y(k,52) + .700_r8*rxt(k,283)*y(k,55) + rxt(k,284) & + *y(k,56) + mat(k,1217) = mat(k,1217) + rxt(k,409)*y(k,234) + mat(k,799) = -(rxt(k,429)*y(k,240) + rxt(k,430)*y(k,129) + rxt(k,431) & + *y(k,130)) + mat(k,2177) = -rxt(k,429)*y(k,236) + mat(k,1567) = -rxt(k,430)*y(k,236) + mat(k,1683) = -rxt(k,431)*y(k,236) + mat(k,606) = -((rxt(k,348) + rxt(k,349)) * y(k,129)) + mat(k,1556) = -(rxt(k,348) + rxt(k,349)) * y(k,237) + mat(k,400) = rxt(k,347)*y(k,251) + mat(k,1843) = rxt(k,347)*y(k,18) + mat(k,1541) = .750_r8*rxt(k,317)*y(k,239) + mat(k,753) = .750_r8*rxt(k,317)*y(k,129) + mat(k,754) = -(rxt(k,316)*y(k,240) + rxt(k,317)*y(k,129)) + mat(k,2173) = -rxt(k,316)*y(k,239) + mat(k,1563) = -rxt(k,317)*y(k,239) + mat(k,599) = rxt(k,323)*y(k,251) + mat(k,1860) = rxt(k,323)*y(k,27) + mat(k,2227) = -((rxt(k,154) + rxt(k,155) + rxt(k,156)) * y(k,78) + rxt(k,158) & + *y(k,138) + rxt(k,159)*y(k,139) + rxt(k,163)*y(k,251) & + + 4._r8*rxt(k,168)*y(k,240) + rxt(k,178)*y(k,131) + rxt(k,183) & + *y(k,129) + rxt(k,188)*y(k,130) + (rxt(k,198) + rxt(k,199) & + ) * y(k,58) + rxt(k,205)*y(k,61) + rxt(k,231)*y(k,19) + rxt(k,237) & + *y(k,21) + rxt(k,274)*y(k,44) + rxt(k,280)*y(k,235) + rxt(k,287) & + *y(k,241) + rxt(k,301)*y(k,231) + rxt(k,312)*y(k,234) + rxt(k,316) & + *y(k,239) + rxt(k,329)*y(k,232) + rxt(k,337)*y(k,253) + rxt(k,341) & + *y(k,254) + rxt(k,353)*y(k,244) + rxt(k,362)*y(k,246) + rxt(k,366) & + *y(k,248) + rxt(k,376)*y(k,228) + rxt(k,386)*y(k,242) + rxt(k,391) & + *y(k,243) + rxt(k,400)*y(k,103) + rxt(k,411)*y(k,258) + rxt(k,415) & + *y(k,227) + rxt(k,418)*y(k,229) + rxt(k,422)*y(k,230) + rxt(k,425) & + *y(k,233) + rxt(k,429)*y(k,236) + rxt(k,432)*y(k,245) + rxt(k,435) & + *y(k,247) + rxt(k,438)*y(k,252) + rxt(k,445)*y(k,257) + rxt(k,451) & + *y(k,259) + rxt(k,454)*y(k,260) + rxt(k,465)*y(k,249) + rxt(k,470) & + *y(k,255) + rxt(k,475)*y(k,256)) + mat(k,1512) = -(rxt(k,154) + rxt(k,155) + rxt(k,156)) * y(k,240) + mat(k,2003) = -rxt(k,158)*y(k,240) + mat(k,2327) = -rxt(k,159)*y(k,240) + mat(k,1924) = -rxt(k,163)*y(k,240) + mat(k,2084) = -rxt(k,178)*y(k,240) + mat(k,1615) = -rxt(k,183)*y(k,240) + mat(k,1711) = -rxt(k,188)*y(k,240) + mat(k,2266) = -(rxt(k,198) + rxt(k,199)) * y(k,240) + mat(k,1950) = -rxt(k,205)*y(k,240) + mat(k,1462) = -rxt(k,231)*y(k,240) + mat(k,2108) = -rxt(k,237)*y(k,240) + mat(k,2027) = -rxt(k,274)*y(k,240) + mat(k,1667) = -rxt(k,280)*y(k,240) + mat(k,494) = -rxt(k,287)*y(k,240) + mat(k,867) = -rxt(k,301)*y(k,240) + mat(k,1436) = -rxt(k,312)*y(k,240) + mat(k,760) = -rxt(k,316)*y(k,240) + mat(k,839) = -rxt(k,329)*y(k,240) + mat(k,815) = -rxt(k,337)*y(k,240) + mat(k,1178) = -rxt(k,341)*y(k,240) + mat(k,1362) = -rxt(k,353)*y(k,240) + mat(k,1404) = -rxt(k,362)*y(k,240) + mat(k,723) = -rxt(k,366)*y(k,240) + mat(k,948) = -rxt(k,376)*y(k,240) + mat(k,1309) = -rxt(k,386)*y(k,240) + mat(k,1341) = -rxt(k,391)*y(k,240) + mat(k,1246) = -rxt(k,400)*y(k,240) + mat(k,1223) = -rxt(k,411)*y(k,240) + mat(k,559) = -rxt(k,415)*y(k,240) + mat(k,539) = -rxt(k,418)*y(k,240) + mat(k,482) = -rxt(k,422)*y(k,240) + mat(k,682) = -rxt(k,425)*y(k,240) + mat(k,806) = -rxt(k,429)*y(k,240) + mat(k,766) = -rxt(k,432)*y(k,240) + mat(k,911) = -rxt(k,435)*y(k,240) + mat(k,501) = -rxt(k,438)*y(k,240) + mat(k,781) = -rxt(k,445)*y(k,240) + mat(k,798) = -rxt(k,451)*y(k,240) + mat(k,547) = -rxt(k,454)*y(k,240) + mat(k,1112) = -rxt(k,465)*y(k,240) + mat(k,1165) = -rxt(k,470)*y(k,240) + mat(k,961) = -rxt(k,475)*y(k,240) + mat(k,1006) = .570_r8*rxt(k,459)*y(k,139) + mat(k,212) = .650_r8*rxt(k,417)*y(k,251) + mat(k,1462) = mat(k,1462) + rxt(k,230)*y(k,44) + mat(k,2108) = mat(k,2108) + rxt(k,242)*y(k,251) + mat(k,329) = .350_r8*rxt(k,296)*y(k,251) + mat(k,604) = .130_r8*rxt(k,298)*y(k,139) + mat(k,306) = rxt(k,303)*y(k,251) + mat(k,1078) = .280_r8*rxt(k,327)*y(k,139) + mat(k,2027) = mat(k,2027) + rxt(k,230)*y(k,19) + rxt(k,194)*y(k,58) & + + rxt(k,275)*y(k,131) + rxt(k,276)*y(k,138) + mat(k,620) = rxt(k,259)*y(k,58) + rxt(k,260)*y(k,251) + mat(k,412) = rxt(k,262)*y(k,58) + rxt(k,263)*y(k,251) + mat(k,144) = rxt(k,309)*y(k,251) + mat(k,829) = rxt(k,282)*y(k,251) + mat(k,1480) = rxt(k,291)*y(k,250) + mat(k,2266) = mat(k,2266) + rxt(k,194)*y(k,44) + rxt(k,259)*y(k,45) & + + rxt(k,262)*y(k,48) + rxt(k,197)*y(k,81) + mat(k,1950) = mat(k,1950) + rxt(k,201)*y(k,235) + rxt(k,212)*y(k,251) + mat(k,1138) = rxt(k,294)*y(k,251) + mat(k,241) = .730_r8*rxt(k,428)*y(k,251) + mat(k,323) = .500_r8*rxt(k,496)*y(k,251) + mat(k,1146) = rxt(k,320)*y(k,251) + mat(k,974) = rxt(k,321)*y(k,251) + mat(k,643) = rxt(k,197)*y(k,58) + rxt(k,153)*y(k,138) + rxt(k,162)*y(k,251) + mat(k,228) = rxt(k,285)*y(k,251) + mat(k,1014) = rxt(k,286)*y(k,251) + mat(k,1204) = rxt(k,350)*y(k,251) + mat(k,1185) = rxt(k,335)*y(k,251) + mat(k,888) = .370_r8*rxt(k,404)*y(k,139) + mat(k,665) = .300_r8*rxt(k,395)*y(k,251) + mat(k,589) = rxt(k,396)*y(k,251) + mat(k,1246) = mat(k,1246) + rxt(k,401)*y(k,129) + rxt(k,402)*y(k,131) & + + rxt(k,398)*y(k,234) + 1.200_r8*rxt(k,399)*y(k,235) + mat(k,438) = rxt(k,403)*y(k,251) + mat(k,1257) = .140_r8*rxt(k,357)*y(k,139) + mat(k,390) = .200_r8*rxt(k,359)*y(k,251) + mat(k,638) = .500_r8*rxt(k,370)*y(k,251) + mat(k,1056) = .570_r8*rxt(k,462)*y(k,139) + mat(k,1384) = .280_r8*rxt(k,371)*y(k,139) + mat(k,444) = rxt(k,407)*y(k,251) + mat(k,1096) = rxt(k,408)*y(k,251) + mat(k,1615) = mat(k,1615) + rxt(k,401)*y(k,103) + rxt(k,377)*y(k,228) & + + rxt(k,419)*y(k,229) + rxt(k,424)*y(k,230) + rxt(k,302) & + *y(k,231) + rxt(k,330)*y(k,232) + rxt(k,281)*y(k,235) & + + .170_r8*rxt(k,430)*y(k,236) + rxt(k,348)*y(k,237) & + + .250_r8*rxt(k,317)*y(k,239) + rxt(k,289)*y(k,241) & + + .920_r8*rxt(k,387)*y(k,242) + .920_r8*rxt(k,393)*y(k,243) & + + .470_r8*rxt(k,355)*y(k,244) + .400_r8*rxt(k,433)*y(k,245) & + + .830_r8*rxt(k,436)*y(k,247) + rxt(k,439)*y(k,252) + rxt(k,338) & + *y(k,253) + .900_r8*rxt(k,471)*y(k,255) + .800_r8*rxt(k,476) & + *y(k,256) + rxt(k,446)*y(k,257) + rxt(k,412)*y(k,258) & + + rxt(k,452)*y(k,259) + rxt(k,455)*y(k,260) + mat(k,2084) = mat(k,2084) + rxt(k,275)*y(k,44) + rxt(k,402)*y(k,103) & + + rxt(k,388)*y(k,242) + rxt(k,394)*y(k,243) + .470_r8*rxt(k,354) & + *y(k,244) + rxt(k,181)*y(k,251) + rxt(k,413)*y(k,258) + mat(k,2003) = mat(k,2003) + rxt(k,276)*y(k,44) + rxt(k,153)*y(k,81) + mat(k,2327) = mat(k,2327) + .570_r8*rxt(k,459)*y(k,6) + .130_r8*rxt(k,298) & + *y(k,27) + .280_r8*rxt(k,327)*y(k,31) + .370_r8*rxt(k,404) & + *y(k,100) + .140_r8*rxt(k,357)*y(k,111) + .570_r8*rxt(k,462) & + *y(k,116) + .280_r8*rxt(k,371)*y(k,118) + rxt(k,165)*y(k,251) + mat(k,221) = .800_r8*rxt(k,440)*y(k,251) + mat(k,901) = rxt(k,486)*y(k,251) + mat(k,1123) = .200_r8*rxt(k,480)*y(k,251) + mat(k,236) = .280_r8*rxt(k,448)*y(k,251) + mat(k,258) = .380_r8*rxt(k,450)*y(k,251) + mat(k,263) = .630_r8*rxt(k,456)*y(k,251) + mat(k,948) = mat(k,948) + rxt(k,377)*y(k,129) + mat(k,539) = mat(k,539) + rxt(k,419)*y(k,129) + mat(k,482) = mat(k,482) + rxt(k,424)*y(k,129) + mat(k,867) = mat(k,867) + rxt(k,302)*y(k,129) + 2.400_r8*rxt(k,299)*y(k,231) & + + rxt(k,300)*y(k,235) + mat(k,839) = mat(k,839) + rxt(k,330)*y(k,129) + rxt(k,328)*y(k,235) + mat(k,1436) = mat(k,1436) + rxt(k,398)*y(k,103) + .900_r8*rxt(k,311)*y(k,235) & + + rxt(k,384)*y(k,242) + rxt(k,389)*y(k,243) + .470_r8*rxt(k,351) & + *y(k,244) + rxt(k,409)*y(k,258) + mat(k,1667) = mat(k,1667) + rxt(k,201)*y(k,61) + 1.200_r8*rxt(k,399)*y(k,103) & + + rxt(k,281)*y(k,129) + rxt(k,300)*y(k,231) + rxt(k,328) & + *y(k,232) + .900_r8*rxt(k,311)*y(k,234) + 4.000_r8*rxt(k,278) & + *y(k,235) + rxt(k,385)*y(k,242) + rxt(k,390)*y(k,243) & + + .730_r8*rxt(k,352)*y(k,244) + rxt(k,361)*y(k,246) & + + .500_r8*rxt(k,464)*y(k,249) + .300_r8*rxt(k,340)*y(k,254) & + + rxt(k,469)*y(k,255) + rxt(k,474)*y(k,256) + .800_r8*rxt(k,410) & + *y(k,258) + mat(k,806) = mat(k,806) + .170_r8*rxt(k,430)*y(k,129) + .070_r8*rxt(k,429) & + *y(k,240) + mat(k,613) = rxt(k,348)*y(k,129) + mat(k,760) = mat(k,760) + .250_r8*rxt(k,317)*y(k,129) + mat(k,2227) = mat(k,2227) + .070_r8*rxt(k,429)*y(k,236) + .160_r8*rxt(k,432) & + *y(k,245) + .330_r8*rxt(k,435)*y(k,247) + mat(k,494) = mat(k,494) + rxt(k,289)*y(k,129) + mat(k,1309) = mat(k,1309) + .920_r8*rxt(k,387)*y(k,129) + rxt(k,388)*y(k,131) & + + rxt(k,384)*y(k,234) + rxt(k,385)*y(k,235) + mat(k,1341) = mat(k,1341) + .920_r8*rxt(k,393)*y(k,129) + rxt(k,394)*y(k,131) & + + rxt(k,389)*y(k,234) + rxt(k,390)*y(k,235) + mat(k,1362) = mat(k,1362) + .470_r8*rxt(k,355)*y(k,129) + .470_r8*rxt(k,354) & + *y(k,131) + .470_r8*rxt(k,351)*y(k,234) + .730_r8*rxt(k,352) & + *y(k,235) + mat(k,766) = mat(k,766) + .400_r8*rxt(k,433)*y(k,129) + .160_r8*rxt(k,432) & + *y(k,240) + mat(k,1404) = mat(k,1404) + rxt(k,361)*y(k,235) + mat(k,911) = mat(k,911) + .830_r8*rxt(k,436)*y(k,129) + .330_r8*rxt(k,435) & + *y(k,240) + mat(k,1112) = mat(k,1112) + .500_r8*rxt(k,464)*y(k,235) + mat(k,1752) = rxt(k,291)*y(k,56) + mat(k,1924) = mat(k,1924) + .650_r8*rxt(k,417)*y(k,8) + rxt(k,242)*y(k,21) & + + .350_r8*rxt(k,296)*y(k,26) + rxt(k,303)*y(k,28) + rxt(k,260) & + *y(k,45) + rxt(k,263)*y(k,48) + rxt(k,309)*y(k,49) + rxt(k,282) & + *y(k,54) + rxt(k,212)*y(k,61) + rxt(k,294)*y(k,64) & + + .730_r8*rxt(k,428)*y(k,68) + .500_r8*rxt(k,496)*y(k,69) & + + rxt(k,320)*y(k,76) + rxt(k,321)*y(k,77) + rxt(k,162)*y(k,81) & + + rxt(k,285)*y(k,88) + rxt(k,286)*y(k,89) + rxt(k,350)*y(k,95) & + + rxt(k,335)*y(k,97) + .300_r8*rxt(k,395)*y(k,101) + rxt(k,396) & + *y(k,102) + rxt(k,403)*y(k,104) + .200_r8*rxt(k,359)*y(k,112) & + + .500_r8*rxt(k,370)*y(k,115) + rxt(k,407)*y(k,122) + rxt(k,408) & + *y(k,123) + rxt(k,181)*y(k,131) + rxt(k,165)*y(k,139) & + + .800_r8*rxt(k,440)*y(k,147) + rxt(k,486)*y(k,158) & + + .200_r8*rxt(k,480)*y(k,215) + .280_r8*rxt(k,448)*y(k,217) & + + .380_r8*rxt(k,450)*y(k,220) + .630_r8*rxt(k,456)*y(k,223) + mat(k,501) = mat(k,501) + rxt(k,439)*y(k,129) + mat(k,815) = mat(k,815) + rxt(k,338)*y(k,129) + mat(k,1178) = mat(k,1178) + .300_r8*rxt(k,340)*y(k,235) + mat(k,1165) = mat(k,1165) + .900_r8*rxt(k,471)*y(k,129) + rxt(k,469)*y(k,235) + mat(k,961) = mat(k,961) + .800_r8*rxt(k,476)*y(k,129) + rxt(k,474)*y(k,235) + mat(k,781) = mat(k,781) + rxt(k,446)*y(k,129) + mat(k,1223) = mat(k,1223) + rxt(k,412)*y(k,129) + rxt(k,413)*y(k,131) & + + rxt(k,409)*y(k,234) + .800_r8*rxt(k,410)*y(k,235) + mat(k,798) = mat(k,798) + rxt(k,452)*y(k,129) + mat(k,547) = mat(k,547) + rxt(k,455)*y(k,129) end do end subroutine nlnmat08 subroutine nlnmat09( avec_len, mat, y, rxt ) @@ -2074,125 +2074,460 @@ subroutine nlnmat09( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,391) = -(rxt(k,439)*y(k,232) + rxt(k,440)*y(k,123)) - mat(k,1451) = -rxt(k,439)*y(k,244) - mat(k,1341) = -rxt(k,440)*y(k,244) - mat(k,161) = .200_r8*rxt(k,429)*y(k,243) - mat(k,134) = .140_r8*rxt(k,441)*y(k,243) - mat(k,266) = rxt(k,444)*y(k,243) - mat(k,1614) = .200_r8*rxt(k,429)*y(k,66) + .140_r8*rxt(k,441)*y(k,141) & - + rxt(k,444)*y(k,142) - mat(k,674) = -(rxt(k,338)*y(k,232) + rxt(k,339)*y(k,123)) - mat(k,1475) = -rxt(k,338)*y(k,245) - mat(k,1361) = -rxt(k,339)*y(k,245) - mat(k,890) = rxt(k,345)*y(k,243) - mat(k,460) = .500_r8*rxt(k,340)*y(k,243) - mat(k,1648) = rxt(k,345)*y(k,29) + .500_r8*rxt(k,340)*y(k,147) - mat(k,1029) = -(rxt(k,341)*y(k,227) + rxt(k,342)*y(k,232) + rxt(k,343) & - *y(k,123)) - mat(k,1851) = -rxt(k,341)*y(k,246) - mat(k,1495) = -rxt(k,342)*y(k,246) - mat(k,1380) = -rxt(k,343)*y(k,246) - mat(k,839) = .060_r8*rxt(k,460)*y(k,133) - mat(k,864) = rxt(k,346)*y(k,243) - mat(k,813) = .060_r8*rxt(k,463)*y(k,133) - mat(k,1910) = .060_r8*rxt(k,460)*y(k,6) + .060_r8*rxt(k,463)*y(k,111) - mat(k,317) = rxt(k,344)*y(k,243) - mat(k,948) = .150_r8*rxt(k,481)*y(k,243) - mat(k,1677) = rxt(k,346)*y(k,48) + rxt(k,344)*y(k,148) + .150_r8*rxt(k,481) & - *y(k,209) - mat(k,994) = -(rxt(k,470)*y(k,227) + rxt(k,471)*y(k,232) + rxt(k,472) & - *y(k,123)) - mat(k,1849) = -rxt(k,470)*y(k,247) - mat(k,1493) = -rxt(k,471)*y(k,247) - mat(k,1378) = -rxt(k,472)*y(k,247) - mat(k,1797) = .500_r8*rxt(k,479)*y(k,208) - mat(k,532) = rxt(k,473)*y(k,243) - mat(k,884) = .500_r8*rxt(k,479)*y(k,125) + rxt(k,480)*y(k,243) - mat(k,1675) = rxt(k,473)*y(k,205) + rxt(k,480)*y(k,208) - mat(k,972) = -(rxt(k,475)*y(k,227) + rxt(k,476)*y(k,232) + rxt(k,477) & - *y(k,123)) - mat(k,1848) = -rxt(k,475)*y(k,248) - mat(k,1492) = -rxt(k,476)*y(k,248) - mat(k,1377) = -rxt(k,477)*y(k,248) - mat(k,837) = rxt(k,461)*y(k,243) - mat(k,811) = rxt(k,464)*y(k,243) - mat(k,414) = rxt(k,478)*y(k,243) - mat(k,1674) = rxt(k,461)*y(k,6) + rxt(k,464)*y(k,111) + rxt(k,478)*y(k,207) - mat(k,638) = -(rxt(k,446)*y(k,232) + rxt(k,447)*y(k,123)) - mat(k,1472) = -rxt(k,446)*y(k,249) - mat(k,1358) = -rxt(k,447)*y(k,249) - mat(k,541) = rxt(k,448)*y(k,243) - mat(k,157) = .650_r8*rxt(k,449)*y(k,243) - mat(k,1645) = rxt(k,448)*y(k,210) + .650_r8*rxt(k,449)*y(k,211) - mat(k,1068) = -(rxt(k,410)*y(k,226) + rxt(k,411)*y(k,227) + rxt(k,412) & - *y(k,232) + rxt(k,413)*y(k,123) + rxt(k,414)*y(k,125)) - mat(k,1271) = -rxt(k,410)*y(k,250) - mat(k,1853) = -rxt(k,411)*y(k,250) - mat(k,1498) = -rxt(k,412)*y(k,250) - mat(k,1382) = -rxt(k,413)*y(k,250) - mat(k,1801) = -rxt(k,414)*y(k,250) - mat(k,205) = rxt(k,382)*y(k,243) - mat(k,282) = rxt(k,383)*y(k,243) - mat(k,104) = rxt(k,384)*y(k,243) - mat(k,597) = .400_r8*rxt(k,407)*y(k,243) - mat(k,170) = .500_r8*rxt(k,415)*y(k,243) - mat(k,1680) = rxt(k,382)*y(k,94) + rxt(k,383)*y(k,96) + rxt(k,384)*y(k,97) & - + .400_r8*rxt(k,407)*y(k,103) + .500_r8*rxt(k,415)*y(k,212) - mat(k,654) = -(rxt(k,452)*y(k,232) + rxt(k,453)*y(k,123)) - mat(k,1473) = -rxt(k,452)*y(k,251) - mat(k,1359) = -rxt(k,453)*y(k,251) - mat(k,181) = .560_r8*rxt(k,451)*y(k,243) - mat(k,609) = rxt(k,454)*y(k,243) - mat(k,1646) = .560_r8*rxt(k,451)*y(k,213) + rxt(k,454)*y(k,214) - mat(k,428) = -(rxt(k,455)*y(k,232) + rxt(k,456)*y(k,123)) - mat(k,1456) = -rxt(k,455)*y(k,252) - mat(k,1345) = -rxt(k,456)*y(k,252) - mat(k,188) = .300_r8*rxt(k,457)*y(k,243) - mat(k,371) = rxt(k,458)*y(k,243) - mat(k,1620) = .300_r8*rxt(k,457)*y(k,215) + rxt(k,458)*y(k,216) - mat(k,2078) = -(rxt(k,145)*y(k,242) + rxt(k,253)*y(k,73) + rxt(k,498) & - *y(k,153)) - mat(k,1549) = -rxt(k,145)*y(k,253) - mat(k,700) = -rxt(k,253)*y(k,253) - mat(k,215) = -rxt(k,498)*y(k,253) - mat(k,248) = rxt(k,307)*y(k,243) - mat(k,345) = rxt(k,332)*y(k,243) - mat(k,102) = rxt(k,333)*y(k,243) - mat(k,1731) = rxt(k,277)*y(k,243) - mat(k,1048) = rxt(k,309)*y(k,243) - mat(k,868) = rxt(k,346)*y(k,243) - mat(k,1123) = rxt(k,335)*y(k,243) - mat(k,470) = rxt(k,315)*y(k,243) - mat(k,440) = rxt(k,316)*y(k,243) - mat(k,357) = rxt(k,283)*y(k,243) - mat(k,1331) = rxt(k,156)*y(k,232) - mat(k,1061) = rxt(k,161)*y(k,243) - mat(k,526) = rxt(k,162)*y(k,243) - mat(k,727) = rxt(k,244)*y(k,243) - mat(k,1431) = (rxt(k,538)+rxt(k,543))*y(k,91) + (rxt(k,531)+rxt(k,537) & - +rxt(k,542))*y(k,92) + rxt(k,215)*y(k,243) - mat(k,708) = rxt(k,287)*y(k,243) - mat(k,1317) = rxt(k,191)*y(k,243) - mat(k,363) = rxt(k,169)*y(k,243) - mat(k,691) = (rxt(k,538)+rxt(k,543))*y(k,85) - mat(k,735) = (rxt(k,531)+rxt(k,537)+rxt(k,542))*y(k,85) + rxt(k,218)*y(k,243) - mat(k,1114) = .500_r8*rxt(k,359)*y(k,243) - mat(k,92) = rxt(k,499)*y(k,243) - mat(k,466) = rxt(k,340)*y(k,243) - mat(k,321) = rxt(k,344)*y(k,243) - mat(k,1525) = rxt(k,156)*y(k,76) + rxt(k,163)*y(k,243) - mat(k,1708) = rxt(k,307)*y(k,28) + rxt(k,332)*y(k,30) + rxt(k,333)*y(k,31) & - + rxt(k,277)*y(k,42) + rxt(k,309)*y(k,45) + rxt(k,346)*y(k,48) & - + rxt(k,335)*y(k,49) + rxt(k,315)*y(k,50) + rxt(k,316)*y(k,51) & - + rxt(k,283)*y(k,53) + rxt(k,161)*y(k,77) + rxt(k,162)*y(k,79) & - + rxt(k,244)*y(k,81) + rxt(k,215)*y(k,85) + rxt(k,287)*y(k,87) & - + rxt(k,191)*y(k,89) + rxt(k,169)*y(k,90) + rxt(k,218)*y(k,92) & - + .500_r8*rxt(k,359)*y(k,106) + rxt(k,499)*y(k,121) + rxt(k,340) & - *y(k,147) + rxt(k,344)*y(k,148) + rxt(k,163)*y(k,232) & - + 2.000_r8*rxt(k,166)*y(k,243) + mat(k,489) = -(rxt(k,287)*y(k,240) + rxt(k,289)*y(k,129)) + mat(k,2153) = -rxt(k,287)*y(k,241) + mat(k,1546) = -rxt(k,289)*y(k,241) + mat(k,2007) = rxt(k,274)*y(k,240) + mat(k,2153) = mat(k,2153) + rxt(k,274)*y(k,44) + mat(k,1296) = -(rxt(k,384)*y(k,234) + rxt(k,385)*y(k,235) + rxt(k,386) & + *y(k,240) + rxt(k,387)*y(k,129) + rxt(k,388)*y(k,131)) + mat(k,1421) = -rxt(k,384)*y(k,242) + mat(k,1647) = -rxt(k,385)*y(k,242) + mat(k,2205) = -rxt(k,386)*y(k,242) + mat(k,1594) = -rxt(k,387)*y(k,242) + mat(k,2063) = -rxt(k,388)*y(k,242) + mat(k,880) = .600_r8*rxt(k,405)*y(k,251) + mat(k,1902) = .600_r8*rxt(k,405)*y(k,100) + mat(k,1328) = -(rxt(k,389)*y(k,234) + rxt(k,390)*y(k,235) + rxt(k,391) & + *y(k,240) + rxt(k,393)*y(k,129) + rxt(k,394)*y(k,131)) + mat(k,1422) = -rxt(k,389)*y(k,243) + mat(k,1648) = -rxt(k,390)*y(k,243) + mat(k,2206) = -rxt(k,391)*y(k,243) + mat(k,1595) = -rxt(k,393)*y(k,243) + mat(k,2064) = -rxt(k,394)*y(k,243) + mat(k,881) = .400_r8*rxt(k,405)*y(k,251) + mat(k,1903) = .400_r8*rxt(k,405)*y(k,100) + mat(k,1351) = -(rxt(k,351)*y(k,234) + rxt(k,352)*y(k,235) + rxt(k,353) & + *y(k,240) + rxt(k,354)*y(k,131) + (rxt(k,355) + rxt(k,356) & + ) * y(k,129)) + mat(k,1423) = -rxt(k,351)*y(k,244) + mat(k,1649) = -rxt(k,352)*y(k,244) + mat(k,2207) = -rxt(k,353)*y(k,244) + mat(k,2065) = -rxt(k,354)*y(k,244) + mat(k,1596) = -(rxt(k,355) + rxt(k,356)) * y(k,244) + mat(k,1251) = .500_r8*rxt(k,358)*y(k,251) + mat(k,387) = .200_r8*rxt(k,359)*y(k,251) + mat(k,1371) = rxt(k,372)*y(k,251) + mat(k,1904) = .500_r8*rxt(k,358)*y(k,111) + .200_r8*rxt(k,359)*y(k,112) & + + rxt(k,372)*y(k,118) + mat(k,761) = -(rxt(k,432)*y(k,240) + rxt(k,433)*y(k,129) + rxt(k,434) & + *y(k,130)) + mat(k,2174) = -rxt(k,432)*y(k,245) + mat(k,1564) = -rxt(k,433)*y(k,245) + mat(k,1682) = -rxt(k,434)*y(k,245) + mat(k,1394) = -(rxt(k,360)*y(k,234) + rxt(k,361)*y(k,235) + rxt(k,362) & + *y(k,240) + 4._r8*rxt(k,363)*y(k,246) + rxt(k,364)*y(k,129) & + + rxt(k,365)*y(k,131) + rxt(k,373)*y(k,130)) + mat(k,1425) = -rxt(k,360)*y(k,246) + mat(k,1651) = -rxt(k,361)*y(k,246) + mat(k,2209) = -rxt(k,362)*y(k,246) + mat(k,1598) = -rxt(k,364)*y(k,246) + mat(k,2067) = -rxt(k,365)*y(k,246) + mat(k,1694) = -rxt(k,373)*y(k,246) + mat(k,1252) = .500_r8*rxt(k,358)*y(k,251) + mat(k,388) = .500_r8*rxt(k,359)*y(k,251) + mat(k,1906) = .500_r8*rxt(k,358)*y(k,111) + .500_r8*rxt(k,359)*y(k,112) + mat(k,903) = -(rxt(k,435)*y(k,240) + rxt(k,436)*y(k,129) + rxt(k,437) & + *y(k,130)) + mat(k,2186) = -rxt(k,435)*y(k,247) + mat(k,1573) = -rxt(k,436)*y(k,247) + mat(k,1687) = -rxt(k,437)*y(k,247) + mat(k,717) = -(rxt(k,366)*y(k,240) + rxt(k,367)*y(k,129)) + mat(k,2169) = -rxt(k,366)*y(k,248) + mat(k,1562) = -rxt(k,367)*y(k,248) + mat(k,549) = rxt(k,368)*y(k,251) + mat(k,353) = rxt(k,369)*y(k,251) + mat(k,1856) = rxt(k,368)*y(k,113) + rxt(k,369)*y(k,114) + mat(k,1101) = -(rxt(k,464)*y(k,235) + rxt(k,465)*y(k,240) + rxt(k,466) & + *y(k,129) + rxt(k,467)*y(k,131)) + mat(k,1635) = -rxt(k,464)*y(k,249) + mat(k,2193) = -rxt(k,465)*y(k,249) + mat(k,1581) = -rxt(k,466)*y(k,249) + mat(k,2049) = -rxt(k,467)*y(k,249) + mat(k,991) = rxt(k,458)*y(k,131) + mat(k,1040) = rxt(k,461)*y(k,131) + mat(k,2049) = mat(k,2049) + rxt(k,458)*y(k,6) + rxt(k,461)*y(k,116) & + + .500_r8*rxt(k,478)*y(k,214) + mat(k,465) = rxt(k,468)*y(k,251) + mat(k,1017) = .500_r8*rxt(k,478)*y(k,131) + mat(k,1888) = rxt(k,468)*y(k,133) + mat(k,1744) = -(rxt(k,144)*y(k,79) + rxt(k,145)*y(k,261) + rxt(k,148) & + *y(k,139) + (rxt(k,186) + rxt(k,187)) * y(k,120) + rxt(k,219) & + *y(k,35) + rxt(k,220)*y(k,36) + rxt(k,221)*y(k,38) + rxt(k,222) & + *y(k,39) + rxt(k,223)*y(k,40) + rxt(k,224)*y(k,41) + rxt(k,225) & + *y(k,42) + (rxt(k,226) + rxt(k,227)) * y(k,87) + rxt(k,246) & + *y(k,37) + rxt(k,247)*y(k,57) + rxt(k,248)*y(k,80) + (rxt(k,249) & + + rxt(k,250)) * y(k,83) + rxt(k,255)*y(k,66) + rxt(k,256) & + *y(k,67) + rxt(k,269)*y(k,43) + rxt(k,270)*y(k,45) + rxt(k,271) & + *y(k,84) + rxt(k,272)*y(k,85) + rxt(k,273)*y(k,86) + (rxt(k,290) & + + rxt(k,291) + rxt(k,292)) * y(k,56) + rxt(k,293)*y(k,88)) + mat(k,1446) = -rxt(k,144)*y(k,250) + mat(k,2345) = -rxt(k,145)*y(k,250) + mat(k,2319) = -rxt(k,148)*y(k,250) + mat(k,224) = -(rxt(k,186) + rxt(k,187)) * y(k,250) + mat(k,140) = -rxt(k,219)*y(k,250) + mat(k,181) = -rxt(k,220)*y(k,250) + mat(k,154) = -rxt(k,221)*y(k,250) + mat(k,191) = -rxt(k,222)*y(k,250) + mat(k,158) = -rxt(k,223)*y(k,250) + mat(k,196) = -rxt(k,224)*y(k,250) + mat(k,162) = -rxt(k,225)*y(k,250) + mat(k,1964) = -(rxt(k,226) + rxt(k,227)) * y(k,250) + mat(k,187) = -rxt(k,246)*y(k,250) + mat(k,459) = -rxt(k,247)*y(k,250) + mat(k,171) = -rxt(k,248)*y(k,250) + mat(k,852) = -(rxt(k,249) + rxt(k,250)) * y(k,250) + mat(k,292) = -rxt(k,255)*y(k,250) + mat(k,271) = -rxt(k,256)*y(k,250) + mat(k,519) = -rxt(k,269)*y(k,250) + mat(k,617) = -rxt(k,270)*y(k,250) + mat(k,266) = -rxt(k,271)*y(k,250) + mat(k,287) = -rxt(k,272)*y(k,250) + mat(k,342) = -rxt(k,273)*y(k,250) + mat(k,1474) = -(rxt(k,290) + rxt(k,291) + rxt(k,292)) * y(k,250) + mat(k,226) = -rxt(k,293)*y(k,250) + mat(k,1917) = -(rxt(k,161)*y(k,79) + rxt(k,162)*y(k,81) + rxt(k,163)*y(k,240) & + + rxt(k,164)*y(k,138) + rxt(k,165)*y(k,139) + (4._r8*rxt(k,166) & + + 4._r8*rxt(k,167)) * y(k,251) + rxt(k,169)*y(k,92) + rxt(k,181) & + *y(k,131) + rxt(k,182)*y(k,119) + rxt(k,190)*y(k,130) + rxt(k,191) & + *y(k,91) + rxt(k,210)*y(k,62) + (rxt(k,212) + rxt(k,213) & + ) * y(k,61) + rxt(k,215)*y(k,87) + rxt(k,218)*y(k,94) + rxt(k,242) & + *y(k,21) + rxt(k,244)*y(k,83) + rxt(k,258)*y(k,43) + rxt(k,260) & + *y(k,45) + rxt(k,261)*y(k,46) + rxt(k,263)*y(k,48) + rxt(k,265) & + *y(k,57) + rxt(k,266)*y(k,84) + rxt(k,267)*y(k,85) + rxt(k,268) & + *y(k,86) + rxt(k,277)*y(k,44) + rxt(k,282)*y(k,54) + rxt(k,283) & + *y(k,55) + rxt(k,284)*y(k,56) + rxt(k,285)*y(k,88) + rxt(k,286) & + *y(k,89) + rxt(k,294)*y(k,64) + rxt(k,296)*y(k,26) + rxt(k,303) & + *y(k,28) + rxt(k,304)*y(k,29) + rxt(k,306)*y(k,30) + rxt(k,308) & + *y(k,47) + rxt(k,309)*y(k,49) + rxt(k,314)*y(k,52) + rxt(k,315) & + *y(k,53) + rxt(k,320)*y(k,76) + rxt(k,321)*y(k,77) + rxt(k,322) & + *y(k,144) + rxt(k,323)*y(k,27) + rxt(k,331)*y(k,32) + rxt(k,332) & + *y(k,33) + rxt(k,334)*y(k,51) + rxt(k,335)*y(k,97) + rxt(k,336) & + *y(k,132) + rxt(k,339)*y(k,153) + rxt(k,343)*y(k,154) + rxt(k,344) & + *y(k,31) + rxt(k,345)*y(k,50) + rxt(k,347)*y(k,18) + rxt(k,350) & + *y(k,95) + rxt(k,358)*y(k,111) + rxt(k,359)*y(k,112) + rxt(k,368) & + *y(k,113) + rxt(k,369)*y(k,114) + rxt(k,370)*y(k,115) + rxt(k,372) & + *y(k,118) + rxt(k,375)*y(k,1) + rxt(k,379)*y(k,2) + rxt(k,380) & + *y(k,17) + rxt(k,381)*y(k,96) + rxt(k,382)*y(k,98) + rxt(k,383) & + *y(k,99) + rxt(k,395)*y(k,101) + rxt(k,396)*y(k,102) + rxt(k,403) & + *y(k,104) + rxt(k,405)*y(k,100) + rxt(k,406)*y(k,106) + rxt(k,407) & + *y(k,122) + rxt(k,408)*y(k,123) + rxt(k,414)*y(k,219) + rxt(k,417) & + *y(k,8) + rxt(k,420)*y(k,10) + rxt(k,421)*y(k,24) + rxt(k,423) & + *y(k,25) + rxt(k,427)*y(k,34) + rxt(k,428)*y(k,68) + rxt(k,440) & + *y(k,147) + rxt(k,443)*y(k,148) + rxt(k,447)*y(k,216) + rxt(k,448) & + *y(k,217) + rxt(k,450)*y(k,220) + rxt(k,453)*y(k,221) + rxt(k,456) & + *y(k,223) + rxt(k,457)*y(k,224) + rxt(k,460)*y(k,6) + rxt(k,463) & + *y(k,116) + rxt(k,468)*y(k,133) + rxt(k,472)*y(k,211) + rxt(k,473) & + *y(k,212) + rxt(k,477)*y(k,213) + rxt(k,479)*y(k,214) + rxt(k,480) & + *y(k,215) + (rxt(k,482) + rxt(k,496)) * y(k,69) + rxt(k,484) & + *y(k,142) + rxt(k,486)*y(k,158) + rxt(k,490)*y(k,155) + rxt(k,495) & + *y(k,157) + rxt(k,498)*y(k,127)) + mat(k,1447) = -rxt(k,161)*y(k,251) + mat(k,640) = -rxt(k,162)*y(k,251) + mat(k,2220) = -rxt(k,163)*y(k,251) + mat(k,1996) = -rxt(k,164)*y(k,251) + mat(k,2320) = -rxt(k,165)*y(k,251) + mat(k,447) = -rxt(k,169)*y(k,251) + mat(k,2077) = -rxt(k,181)*y(k,251) + mat(k,511) = -rxt(k,182)*y(k,251) + mat(k,1704) = -rxt(k,190)*y(k,251) + mat(k,1492) = -rxt(k,191)*y(k,251) + mat(k,927) = -rxt(k,210)*y(k,251) + mat(k,1943) = -(rxt(k,212) + rxt(k,213)) * y(k,251) + mat(k,1965) = -rxt(k,215)*y(k,251) + mat(k,843) = -rxt(k,218)*y(k,251) + mat(k,2101) = -rxt(k,242)*y(k,251) + mat(k,853) = -rxt(k,244)*y(k,251) + mat(k,520) = -rxt(k,258)*y(k,251) + mat(k,618) = -rxt(k,260)*y(k,251) + mat(k,165) = -rxt(k,261)*y(k,251) + mat(k,410) = -rxt(k,263)*y(k,251) + mat(k,460) = -rxt(k,265)*y(k,251) + mat(k,267) = -rxt(k,266)*y(k,251) + mat(k,288) = -rxt(k,267)*y(k,251) + mat(k,343) = -rxt(k,268)*y(k,251) + mat(k,2020) = -rxt(k,277)*y(k,251) + mat(k,827) = -rxt(k,282)*y(k,251) + mat(k,454) = -rxt(k,283)*y(k,251) + mat(k,1475) = -rxt(k,284)*y(k,251) + mat(k,227) = -rxt(k,285)*y(k,251) + mat(k,1012) = -rxt(k,286)*y(k,251) + mat(k,1136) = -rxt(k,294)*y(k,251) + mat(k,328) = -rxt(k,296)*y(k,251) + mat(k,305) = -rxt(k,303)*y(k,251) + mat(k,381) = -rxt(k,304)*y(k,251) + mat(k,332) = -rxt(k,306)*y(k,251) + mat(k,1130) = -rxt(k,308)*y(k,251) + mat(k,143) = -rxt(k,309)*y(k,251) + mat(k,727) = -rxt(k,314)*y(k,251) + mat(k,627) = -rxt(k,315)*y(k,251) + mat(k,1143) = -rxt(k,320)*y(k,251) + mat(k,972) = -rxt(k,321)*y(k,251) + mat(k,571) = -rxt(k,322)*y(k,251) + mat(k,602) = -rxt(k,323)*y(k,251) + mat(k,430) = -rxt(k,331)*y(k,251) + mat(k,150) = -rxt(k,332)*y(k,251) + mat(k,1264) = -rxt(k,334)*y(k,251) + mat(k,1183) = -rxt(k,335)*y(k,251) + mat(k,894) = -rxt(k,336)*y(k,251) + mat(k,594) = -rxt(k,339)*y(k,251) + mat(k,418) = -rxt(k,343)*y(k,251) + mat(k,1074) = -rxt(k,344)*y(k,251) + mat(k,966) = -rxt(k,345)*y(k,251) + mat(k,404) = -rxt(k,347)*y(k,251) + mat(k,1200) = -rxt(k,350)*y(k,251) + mat(k,1254) = -rxt(k,358)*y(k,251) + mat(k,389) = -rxt(k,359)*y(k,251) + mat(k,552) = -rxt(k,368)*y(k,251) + mat(k,356) = -rxt(k,369)*y(k,251) + mat(k,635) = -rxt(k,370)*y(k,251) + mat(k,1380) = -rxt(k,372)*y(k,251) + mat(k,692) = -rxt(k,375)*y(k,251) + mat(k,713) = -rxt(k,379)*y(k,251) + mat(k,275) = -rxt(k,380)*y(k,251) + mat(k,296) = -rxt(k,381)*y(k,251) + mat(k,385) = -rxt(k,382)*y(k,251) + mat(k,174) = -rxt(k,383)*y(k,251) + mat(k,663) = -rxt(k,395)*y(k,251) + mat(k,588) = -rxt(k,396)*y(k,251) + mat(k,437) = -rxt(k,403)*y(k,251) + mat(k,885) = -rxt(k,405)*y(k,251) + mat(k,734) = -rxt(k,406)*y(k,251) + mat(k,443) = -rxt(k,407)*y(k,251) + mat(k,1093) = -rxt(k,408)*y(k,251) + mat(k,248) = -rxt(k,414)*y(k,251) + mat(k,211) = -rxt(k,417)*y(k,251) + mat(k,425) = -rxt(k,420)*y(k,251) + mat(k,284) = -rxt(k,421)*y(k,251) + mat(k,376) = -rxt(k,423)*y(k,251) + mat(k,310) = -rxt(k,427)*y(k,251) + mat(k,240) = -rxt(k,428)*y(k,251) + mat(k,220) = -rxt(k,440)*y(k,251) + mat(k,370) = -rxt(k,443)*y(k,251) + mat(k,655) = -rxt(k,447)*y(k,251) + mat(k,235) = -rxt(k,448)*y(k,251) + mat(k,257) = -rxt(k,450)*y(k,251) + mat(k,750) = -rxt(k,453)*y(k,251) + mat(k,262) = -rxt(k,456)*y(k,251) + mat(k,473) = -rxt(k,457)*y(k,251) + mat(k,1002) = -rxt(k,460)*y(k,251) + mat(k,1052) = -rxt(k,463)*y(k,251) + mat(k,468) = -rxt(k,468)*y(k,251) + mat(k,702) = -rxt(k,472)*y(k,251) + mat(k,674) = -rxt(k,473)*y(k,251) + mat(k,528) = -rxt(k,477)*y(k,251) + mat(k,1021) = -rxt(k,479)*y(k,251) + mat(k,1120) = -rxt(k,480)*y(k,251) + mat(k,321) = -(rxt(k,482) + rxt(k,496)) * y(k,251) + mat(k,397) = -rxt(k,484)*y(k,251) + mat(k,899) = -rxt(k,486)*y(k,251) + mat(k,563) = -rxt(k,490)*y(k,251) + mat(k,1277) = -rxt(k,495)*y(k,251) + mat(k,137) = -rxt(k,498)*y(k,251) + mat(k,1002) = mat(k,1002) + .630_r8*rxt(k,459)*y(k,139) + mat(k,328) = mat(k,328) + .650_r8*rxt(k,296)*y(k,251) + mat(k,602) = mat(k,602) + .130_r8*rxt(k,298)*y(k,139) + mat(k,381) = mat(k,381) + .500_r8*rxt(k,304)*y(k,251) + mat(k,1074) = mat(k,1074) + .360_r8*rxt(k,327)*y(k,139) + mat(k,2020) = mat(k,2020) + rxt(k,276)*y(k,138) + mat(k,454) = mat(k,454) + .300_r8*rxt(k,283)*y(k,251) + mat(k,1475) = mat(k,1475) + rxt(k,290)*y(k,250) + mat(k,2259) = rxt(k,199)*y(k,240) + mat(k,919) = rxt(k,253)*y(k,261) + mat(k,1507) = rxt(k,160)*y(k,139) + 2.000_r8*rxt(k,155)*y(k,240) + mat(k,1447) = mat(k,1447) + rxt(k,152)*y(k,138) + rxt(k,144)*y(k,250) + mat(k,640) = mat(k,640) + rxt(k,153)*y(k,138) + mat(k,853) = mat(k,853) + rxt(k,243)*y(k,138) + rxt(k,249)*y(k,250) + mat(k,1965) = mat(k,1965) + rxt(k,214)*y(k,138) + rxt(k,226)*y(k,250) + mat(k,227) = mat(k,227) + rxt(k,293)*y(k,250) + mat(k,820) = rxt(k,245)*y(k,138) + mat(k,843) = mat(k,843) + rxt(k,217)*y(k,138) + mat(k,885) = mat(k,885) + .320_r8*rxt(k,404)*y(k,139) + mat(k,734) = mat(k,734) + .600_r8*rxt(k,406)*y(k,251) + mat(k,1254) = mat(k,1254) + .240_r8*rxt(k,357)*y(k,139) + mat(k,389) = mat(k,389) + .100_r8*rxt(k,359)*y(k,251) + mat(k,1052) = mat(k,1052) + .630_r8*rxt(k,462)*y(k,139) + mat(k,1380) = mat(k,1380) + .360_r8*rxt(k,371)*y(k,139) + mat(k,1608) = rxt(k,183)*y(k,240) + mat(k,2077) = mat(k,2077) + rxt(k,178)*y(k,240) + mat(k,1996) = mat(k,1996) + rxt(k,276)*y(k,44) + rxt(k,152)*y(k,79) & + + rxt(k,153)*y(k,81) + rxt(k,243)*y(k,83) + rxt(k,214)*y(k,87) & + + rxt(k,245)*y(k,93) + rxt(k,217)*y(k,94) + rxt(k,158)*y(k,240) + mat(k,2320) = mat(k,2320) + .630_r8*rxt(k,459)*y(k,6) + .130_r8*rxt(k,298) & + *y(k,27) + .360_r8*rxt(k,327)*y(k,31) + rxt(k,160)*y(k,78) & + + .320_r8*rxt(k,404)*y(k,100) + .240_r8*rxt(k,357)*y(k,111) & + + .630_r8*rxt(k,462)*y(k,116) + .360_r8*rxt(k,371)*y(k,118) & + + rxt(k,159)*y(k,240) + mat(k,594) = mat(k,594) + .500_r8*rxt(k,339)*y(k,251) + mat(k,248) = mat(k,248) + .500_r8*rxt(k,414)*y(k,251) + mat(k,558) = .400_r8*rxt(k,415)*y(k,240) + mat(k,1432) = .450_r8*rxt(k,312)*y(k,240) + mat(k,805) = .400_r8*rxt(k,429)*y(k,240) + mat(k,2220) = mat(k,2220) + rxt(k,199)*y(k,58) + 2.000_r8*rxt(k,155)*y(k,78) & + + rxt(k,183)*y(k,129) + rxt(k,178)*y(k,131) + rxt(k,158) & + *y(k,138) + rxt(k,159)*y(k,139) + .400_r8*rxt(k,415)*y(k,227) & + + .450_r8*rxt(k,312)*y(k,234) + .400_r8*rxt(k,429)*y(k,236) & + + .450_r8*rxt(k,362)*y(k,246) + .400_r8*rxt(k,435)*y(k,247) & + + .200_r8*rxt(k,366)*y(k,248) + .150_r8*rxt(k,341)*y(k,254) + mat(k,1400) = .450_r8*rxt(k,362)*y(k,240) + mat(k,910) = .400_r8*rxt(k,435)*y(k,240) + mat(k,722) = .200_r8*rxt(k,366)*y(k,240) + mat(k,1745) = rxt(k,290)*y(k,56) + rxt(k,144)*y(k,79) + rxt(k,249)*y(k,83) & + + rxt(k,226)*y(k,87) + rxt(k,293)*y(k,88) + 2.000_r8*rxt(k,145) & + *y(k,261) + mat(k,1917) = mat(k,1917) + .650_r8*rxt(k,296)*y(k,26) + .500_r8*rxt(k,304) & + *y(k,29) + .300_r8*rxt(k,283)*y(k,55) + .600_r8*rxt(k,406) & + *y(k,106) + .100_r8*rxt(k,359)*y(k,112) + .500_r8*rxt(k,339) & + *y(k,153) + .500_r8*rxt(k,414)*y(k,219) + mat(k,1176) = .150_r8*rxt(k,341)*y(k,240) + mat(k,2346) = rxt(k,253)*y(k,75) + 2.000_r8*rxt(k,145)*y(k,250) end do end subroutine nlnmat09 + subroutine nlnmat10( 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,496) = -(rxt(k,438)*y(k,240) + rxt(k,439)*y(k,129)) + mat(k,2154) = -rxt(k,438)*y(k,252) + mat(k,1547) = -rxt(k,439)*y(k,252) + mat(k,238) = .200_r8*rxt(k,428)*y(k,251) + mat(k,218) = .140_r8*rxt(k,440)*y(k,251) + mat(k,368) = rxt(k,443)*y(k,251) + mat(k,1828) = .200_r8*rxt(k,428)*y(k,68) + .140_r8*rxt(k,440)*y(k,147) & + + rxt(k,443)*y(k,148) + mat(k,808) = -(rxt(k,337)*y(k,240) + rxt(k,338)*y(k,129)) + mat(k,2178) = -rxt(k,337)*y(k,253) + mat(k,1568) = -rxt(k,338)*y(k,253) + mat(k,1060) = rxt(k,344)*y(k,251) + mat(k,591) = .500_r8*rxt(k,339)*y(k,251) + mat(k,1865) = rxt(k,344)*y(k,31) + .500_r8*rxt(k,339)*y(k,153) + mat(k,1169) = -(rxt(k,340)*y(k,235) + rxt(k,341)*y(k,240) + rxt(k,342) & + *y(k,129)) + mat(k,1641) = -rxt(k,340)*y(k,254) + mat(k,2199) = -rxt(k,341)*y(k,254) + mat(k,1587) = -rxt(k,342)*y(k,254) + mat(k,995) = .060_r8*rxt(k,459)*y(k,139) + mat(k,963) = rxt(k,345)*y(k,251) + mat(k,1045) = .060_r8*rxt(k,462)*y(k,139) + mat(k,2300) = .060_r8*rxt(k,459)*y(k,6) + .060_r8*rxt(k,462)*y(k,116) + mat(k,416) = rxt(k,343)*y(k,251) + mat(k,1117) = .150_r8*rxt(k,480)*y(k,251) + mat(k,1894) = rxt(k,345)*y(k,50) + rxt(k,343)*y(k,154) + .150_r8*rxt(k,480) & + *y(k,215) + mat(k,1155) = -(rxt(k,469)*y(k,235) + rxt(k,470)*y(k,240) + rxt(k,471) & + *y(k,129)) + mat(k,1640) = -rxt(k,469)*y(k,255) + mat(k,2198) = -rxt(k,470)*y(k,255) + mat(k,1586) = -rxt(k,471)*y(k,255) + mat(k,2054) = .500_r8*rxt(k,478)*y(k,214) + mat(k,701) = rxt(k,472)*y(k,251) + mat(k,1020) = .500_r8*rxt(k,478)*y(k,131) + rxt(k,479)*y(k,251) + mat(k,1893) = rxt(k,472)*y(k,211) + rxt(k,479)*y(k,214) + mat(k,952) = -(rxt(k,474)*y(k,235) + rxt(k,475)*y(k,240) + rxt(k,476) & + *y(k,129)) + mat(k,1630) = -rxt(k,474)*y(k,256) + mat(k,2188) = -rxt(k,475)*y(k,256) + mat(k,1575) = -rxt(k,476)*y(k,256) + mat(k,985) = rxt(k,460)*y(k,251) + mat(k,1034) = rxt(k,463)*y(k,251) + mat(k,525) = rxt(k,477)*y(k,251) + mat(k,1879) = rxt(k,460)*y(k,6) + rxt(k,463)*y(k,116) + rxt(k,477)*y(k,213) + mat(k,772) = -(rxt(k,445)*y(k,240) + rxt(k,446)*y(k,129)) + mat(k,2175) = -rxt(k,445)*y(k,257) + mat(k,1565) = -rxt(k,446)*y(k,257) + mat(k,651) = rxt(k,447)*y(k,251) + mat(k,234) = .650_r8*rxt(k,448)*y(k,251) + mat(k,1862) = rxt(k,447)*y(k,216) + .650_r8*rxt(k,448)*y(k,217) + mat(k,1213) = -(rxt(k,409)*y(k,234) + rxt(k,410)*y(k,235) + rxt(k,411) & + *y(k,240) + rxt(k,412)*y(k,129) + rxt(k,413)*y(k,131)) + mat(k,1417) = -rxt(k,409)*y(k,258) + mat(k,1643) = -rxt(k,410)*y(k,258) + mat(k,2201) = -rxt(k,411)*y(k,258) + mat(k,1590) = -rxt(k,412)*y(k,258) + mat(k,2058) = -rxt(k,413)*y(k,258) + mat(k,295) = rxt(k,381)*y(k,251) + mat(k,384) = rxt(k,382)*y(k,251) + mat(k,173) = rxt(k,383)*y(k,251) + mat(k,731) = .400_r8*rxt(k,406)*y(k,251) + mat(k,247) = .500_r8*rxt(k,414)*y(k,251) + mat(k,1897) = rxt(k,381)*y(k,96) + rxt(k,382)*y(k,98) + rxt(k,383)*y(k,99) & + + .400_r8*rxt(k,406)*y(k,106) + .500_r8*rxt(k,414)*y(k,219) + mat(k,788) = -(rxt(k,451)*y(k,240) + rxt(k,452)*y(k,129)) + mat(k,2176) = -rxt(k,451)*y(k,259) + mat(k,1566) = -rxt(k,452)*y(k,259) + mat(k,254) = .560_r8*rxt(k,450)*y(k,251) + mat(k,743) = rxt(k,453)*y(k,251) + mat(k,1863) = .560_r8*rxt(k,450)*y(k,220) + rxt(k,453)*y(k,221) + mat(k,541) = -(rxt(k,454)*y(k,240) + rxt(k,455)*y(k,129)) + mat(k,2159) = -rxt(k,454)*y(k,260) + mat(k,1552) = -rxt(k,455)*y(k,260) + mat(k,261) = .300_r8*rxt(k,456)*y(k,251) + mat(k,470) = rxt(k,457)*y(k,251) + mat(k,1835) = .300_r8*rxt(k,456)*y(k,223) + rxt(k,457)*y(k,224) + mat(k,2356) = -(rxt(k,145)*y(k,250) + rxt(k,253)*y(k,75) + rxt(k,497) & + *y(k,159)) + mat(k,1755) = -rxt(k,145)*y(k,261) + mat(k,921) = -rxt(k,253)*y(k,261) + mat(k,302) = -rxt(k,497)*y(k,261) + mat(k,335) = rxt(k,306)*y(k,251) + mat(k,432) = rxt(k,331)*y(k,251) + mat(k,151) = rxt(k,332)*y(k,251) + mat(k,523) = rxt(k,258)*y(k,251) + mat(k,2030) = rxt(k,277)*y(k,251) + mat(k,622) = rxt(k,260)*y(k,251) + mat(k,167) = rxt(k,261)*y(k,251) + mat(k,1133) = rxt(k,308)*y(k,251) + mat(k,414) = rxt(k,263)*y(k,251) + mat(k,967) = rxt(k,345)*y(k,251) + mat(k,1268) = rxt(k,334)*y(k,251) + mat(k,728) = rxt(k,314)*y(k,251) + mat(k,629) = rxt(k,315)*y(k,251) + mat(k,456) = rxt(k,283)*y(k,251) + mat(k,1482) = rxt(k,284)*y(k,251) + mat(k,1515) = rxt(k,156)*y(k,240) + mat(k,1452) = rxt(k,161)*y(k,251) + mat(k,645) = rxt(k,162)*y(k,251) + mat(k,856) = rxt(k,244)*y(k,251) + mat(k,345) = rxt(k,268)*y(k,251) + mat(k,1975) = (rxt(k,553)+rxt(k,558))*y(k,93) + (rxt(k,546)+rxt(k,552) & + +rxt(k,557))*y(k,94) + rxt(k,215)*y(k,251) + mat(k,1015) = rxt(k,286)*y(k,251) + mat(k,1499) = rxt(k,191)*y(k,251) + mat(k,450) = rxt(k,169)*y(k,251) + mat(k,825) = (rxt(k,553)+rxt(k,558))*y(k,87) + mat(k,848) = (rxt(k,546)+rxt(k,552)+rxt(k,557))*y(k,87) + rxt(k,218)*y(k,251) + mat(k,1259) = .500_r8*rxt(k,358)*y(k,251) + mat(k,138) = rxt(k,498)*y(k,251) + mat(k,597) = rxt(k,339)*y(k,251) + mat(k,420) = rxt(k,343)*y(k,251) + mat(k,2230) = rxt(k,156)*y(k,78) + rxt(k,163)*y(k,251) + mat(k,1927) = rxt(k,306)*y(k,30) + rxt(k,331)*y(k,32) + rxt(k,332)*y(k,33) & + + rxt(k,258)*y(k,43) + rxt(k,277)*y(k,44) + rxt(k,260)*y(k,45) & + + rxt(k,261)*y(k,46) + rxt(k,308)*y(k,47) + rxt(k,263)*y(k,48) & + + rxt(k,345)*y(k,50) + rxt(k,334)*y(k,51) + rxt(k,314)*y(k,52) & + + rxt(k,315)*y(k,53) + rxt(k,283)*y(k,55) + rxt(k,284)*y(k,56) & + + rxt(k,161)*y(k,79) + rxt(k,162)*y(k,81) + rxt(k,244)*y(k,83) & + + rxt(k,268)*y(k,86) + rxt(k,215)*y(k,87) + rxt(k,286)*y(k,89) & + + rxt(k,191)*y(k,91) + rxt(k,169)*y(k,92) + rxt(k,218)*y(k,94) & + + .500_r8*rxt(k,358)*y(k,111) + rxt(k,498)*y(k,127) + rxt(k,339) & + *y(k,153) + rxt(k,343)*y(k,154) + rxt(k,163)*y(k,240) & + + 2.000_r8*rxt(k,166)*y(k,251) + end do + end subroutine nlnmat10 subroutine nlnmat_finit( avec_len, mat, lmat, dti ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none @@ -2266,836 +2601,920 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 53) = lmat(k, 53) mat(k, 54) = lmat(k, 54) mat(k, 55) = lmat(k, 55) - mat(k, 61) = mat(k, 61) + lmat(k, 61) - mat(k, 62) = lmat(k, 62) - mat(k, 63) = lmat(k, 63) - mat(k, 64) = lmat(k, 64) - mat(k, 65) = lmat(k, 65) - mat(k, 66) = lmat(k, 66) - mat(k, 67) = lmat(k, 67) - mat(k, 68) = lmat(k, 68) - mat(k, 69) = lmat(k, 69) + mat(k, 56) = lmat(k, 56) + mat(k, 57) = lmat(k, 57) + mat(k, 58) = lmat(k, 58) + mat(k, 59) = lmat(k, 59) + mat(k, 60) = lmat(k, 60) + mat(k, 61) = lmat(k, 61) + mat(k, 67) = mat(k, 67) + lmat(k, 67) + mat(k, 69) = mat(k, 69) + lmat(k, 69) mat(k, 70) = lmat(k, 70) mat(k, 71) = lmat(k, 71) - mat(k, 77) = mat(k, 77) + lmat(k, 77) - mat(k, 83) = mat(k, 83) + lmat(k, 83) - 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, 72) = lmat(k, 72) + mat(k, 73) = lmat(k, 73) + mat(k, 74) = lmat(k, 74) + mat(k, 80) = mat(k, 80) + lmat(k, 80) + mat(k, 86) = mat(k, 86) + lmat(k, 86) + mat(k, 92) = mat(k, 92) + lmat(k, 92) + mat(k, 93) = lmat(k, 93) + mat(k, 94) = lmat(k, 94) + mat(k, 95) = lmat(k, 95) mat(k, 96) = lmat(k, 96) mat(k, 97) = lmat(k, 97) - mat(k, 98) = lmat(k, 98) - mat(k, 99) = mat(k, 99) + lmat(k, 99) mat(k, 103) = mat(k, 103) + lmat(k, 103) - mat(k, 106) = lmat(k, 106) - mat(k, 107) = lmat(k, 107) - mat(k, 108) = lmat(k, 108) - mat(k, 109) = mat(k, 109) + lmat(k, 109) - mat(k, 110) = mat(k, 110) + lmat(k, 110) - mat(k, 112) = lmat(k, 112) - mat(k, 113) = lmat(k, 113) - mat(k, 114) = lmat(k, 114) - mat(k, 115) = lmat(k, 115) - mat(k, 116) = lmat(k, 116) - mat(k, 117) = lmat(k, 117) + mat(k, 105) = mat(k, 105) + lmat(k, 105) + mat(k, 111) = mat(k, 111) + lmat(k, 111) + mat(k, 117) = mat(k, 117) + lmat(k, 117) mat(k, 123) = mat(k, 123) + lmat(k, 123) - mat(k, 129) = lmat(k, 129) - mat(k, 130) = lmat(k, 130) - mat(k, 131) = lmat(k, 131) - mat(k, 132) = lmat(k, 132) - mat(k, 133) = mat(k, 133) + lmat(k, 133) - mat(k, 138) = lmat(k, 138) - mat(k, 139) = lmat(k, 139) - mat(k, 140) = mat(k, 140) + lmat(k, 140) + mat(k, 129) = mat(k, 129) + lmat(k, 129) + mat(k, 135) = mat(k, 135) + lmat(k, 135) + mat(k, 136) = mat(k, 136) + lmat(k, 136) + mat(k, 139) = mat(k, 139) + lmat(k, 139) mat(k, 141) = mat(k, 141) + lmat(k, 141) - mat(k, 143) = mat(k, 143) + lmat(k, 143) - mat(k, 144) = mat(k, 144) + lmat(k, 144) + mat(k, 142) = mat(k, 142) + lmat(k, 142) + mat(k, 145) = lmat(k, 145) + mat(k, 146) = lmat(k, 146) + mat(k, 147) = lmat(k, 147) + mat(k, 148) = mat(k, 148) + lmat(k, 148) + mat(k, 152) = mat(k, 152) + lmat(k, 152) mat(k, 153) = mat(k, 153) + lmat(k, 153) + mat(k, 155) = 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, 159) = mat(k, 159) + lmat(k, 159) mat(k, 160) = mat(k, 160) + lmat(k, 160) - mat(k, 165) = lmat(k, 165) - mat(k, 166) = lmat(k, 166) - mat(k, 167) = lmat(k, 167) - mat(k, 168) = lmat(k, 168) + mat(k, 161) = mat(k, 161) + lmat(k, 161) + mat(k, 163) = mat(k, 163) + lmat(k, 163) + mat(k, 164) = mat(k, 164) + lmat(k, 164) + mat(k, 166) = mat(k, 166) + lmat(k, 166) + mat(k, 168) = mat(k, 168) + lmat(k, 168) mat(k, 169) = mat(k, 169) + lmat(k, 169) - mat(k, 171) = mat(k, 171) + lmat(k, 171) + mat(k, 170) = mat(k, 170) + lmat(k, 170) + mat(k, 172) = mat(k, 172) + lmat(k, 172) + mat(k, 175) = lmat(k, 175) + 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) = 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, 184) = mat(k, 184) + lmat(k, 184) + mat(k, 185) = mat(k, 185) + lmat(k, 185) mat(k, 186) = mat(k, 186) + lmat(k, 186) - mat(k, 191) = lmat(k, 191) - mat(k, 192) = lmat(k, 192) - mat(k, 193) = lmat(k, 193) + mat(k, 188) = mat(k, 188) + lmat(k, 188) + mat(k, 189) = mat(k, 189) + lmat(k, 189) + mat(k, 190) = mat(k, 190) + lmat(k, 190) + mat(k, 192) = mat(k, 192) + lmat(k, 192) + mat(k, 193) = mat(k, 193) + lmat(k, 193) mat(k, 194) = mat(k, 194) + lmat(k, 194) - mat(k, 197) = lmat(k, 197) + mat(k, 195) = mat(k, 195) + lmat(k, 195) + mat(k, 197) = mat(k, 197) + lmat(k, 197) mat(k, 198) = lmat(k, 198) mat(k, 199) = lmat(k, 199) - mat(k, 200) = mat(k, 200) + lmat(k, 200) - mat(k, 203) = mat(k, 203) + lmat(k, 203) + mat(k, 200) = lmat(k, 200) + mat(k, 201) = lmat(k, 201) + mat(k, 202) = lmat(k, 202) + mat(k, 203) = lmat(k, 203) mat(k, 204) = lmat(k, 204) - mat(k, 206) = lmat(k, 206) + mat(k, 205) = lmat(k, 205) mat(k, 207) = mat(k, 207) + lmat(k, 207) - mat(k, 208) = lmat(k, 208) - mat(k, 209) = lmat(k, 209) - mat(k, 210) = lmat(k, 210) - mat(k, 212) = mat(k, 212) + lmat(k, 212) mat(k, 213) = lmat(k, 213) mat(k, 214) = lmat(k, 214) - mat(k, 216) = mat(k, 216) + lmat(k, 216) - mat(k, 220) = mat(k, 220) + lmat(k, 220) - mat(k, 221) = lmat(k, 221) - mat(k, 223) = mat(k, 223) + lmat(k, 223) - mat(k, 224) = lmat(k, 224) - mat(k, 225) = lmat(k, 225) - mat(k, 226) = lmat(k, 226) - mat(k, 227) = lmat(k, 227) - mat(k, 228) = lmat(k, 228) - mat(k, 229) = lmat(k, 229) - mat(k, 230) = lmat(k, 230) - mat(k, 231) = lmat(k, 231) - mat(k, 232) = lmat(k, 232) - mat(k, 233) = lmat(k, 233) - mat(k, 234) = lmat(k, 234) - mat(k, 235) = lmat(k, 235) - mat(k, 236) = lmat(k, 236) + mat(k, 215) = lmat(k, 215) + mat(k, 216) = lmat(k, 216) + mat(k, 217) = mat(k, 217) + lmat(k, 217) + mat(k, 222) = mat(k, 222) + lmat(k, 222) + mat(k, 224) = mat(k, 224) + lmat(k, 224) + mat(k, 225) = mat(k, 225) + lmat(k, 225) + mat(k, 230) = mat(k, 230) + lmat(k, 230) mat(k, 237) = mat(k, 237) + lmat(k, 237) - mat(k, 243) = mat(k, 243) + lmat(k, 243) - mat(k, 249) = mat(k, 249) + lmat(k, 249) - mat(k, 255) = lmat(k, 255) - mat(k, 256) = lmat(k, 256) - mat(k, 257) = lmat(k, 257) - mat(k, 258) = lmat(k, 258) - mat(k, 259) = lmat(k, 259) - mat(k, 260) = mat(k, 260) + lmat(k, 260) - mat(k, 263) = mat(k, 263) + lmat(k, 263) - mat(k, 264) = lmat(k, 264) + mat(k, 242) = lmat(k, 242) + mat(k, 243) = lmat(k, 243) + mat(k, 244) = lmat(k, 244) + mat(k, 245) = lmat(k, 245) + mat(k, 246) = mat(k, 246) + lmat(k, 246) + mat(k, 248) = mat(k, 248) + lmat(k, 248) + mat(k, 251) = mat(k, 251) + lmat(k, 251) + mat(k, 259) = mat(k, 259) + lmat(k, 259) + mat(k, 264) = mat(k, 264) + lmat(k, 264) mat(k, 265) = mat(k, 265) + lmat(k, 265) - mat(k, 267) = lmat(k, 267) - mat(k, 268) = lmat(k, 268) + mat(k, 268) = mat(k, 268) + lmat(k, 268) mat(k, 269) = mat(k, 269) + lmat(k, 269) - mat(k, 270) = lmat(k, 270) - mat(k, 271) = mat(k, 271) + lmat(k, 271) - 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, 278) = mat(k, 278) + lmat(k, 278) + mat(k, 270) = mat(k, 270) + lmat(k, 270) + mat(k, 272) = mat(k, 272) + lmat(k, 272) + mat(k, 273) = mat(k, 273) + lmat(k, 273) + mat(k, 276) = lmat(k, 276) + mat(k, 277) = lmat(k, 277) + mat(k, 278) = lmat(k, 278) mat(k, 279) = lmat(k, 279) - mat(k, 280) = mat(k, 280) + lmat(k, 280) - mat(k, 281) = mat(k, 281) + lmat(k, 281) - mat(k, 284) = mat(k, 284) + lmat(k, 284) - mat(k, 286) = lmat(k, 286) - mat(k, 287) = lmat(k, 287) - mat(k, 288) = mat(k, 288) + lmat(k, 288) + mat(k, 280) = lmat(k, 280) + mat(k, 281) = lmat(k, 281) + mat(k, 282) = mat(k, 282) + lmat(k, 282) + mat(k, 285) = mat(k, 285) + lmat(k, 285) + mat(k, 286) = mat(k, 286) + lmat(k, 286) mat(k, 289) = mat(k, 289) + lmat(k, 289) - mat(k, 294) = mat(k, 294) + lmat(k, 294) - mat(k, 302) = mat(k, 302) + lmat(k, 302) - mat(k, 303) = lmat(k, 303) - mat(k, 305) = mat(k, 305) + lmat(k, 305) + mat(k, 290) = mat(k, 290) + lmat(k, 290) + mat(k, 291) = mat(k, 291) + lmat(k, 291) + mat(k, 293) = mat(k, 293) + lmat(k, 293) + mat(k, 294) = lmat(k, 294) + mat(k, 296) = mat(k, 296) + lmat(k, 296) + mat(k, 297) = lmat(k, 297) + mat(k, 299) = mat(k, 299) + lmat(k, 299) + mat(k, 300) = lmat(k, 300) + mat(k, 301) = lmat(k, 301) + mat(k, 303) = mat(k, 303) + lmat(k, 303) + mat(k, 307) = mat(k, 307) + lmat(k, 307) + mat(k, 308) = lmat(k, 308) mat(k, 310) = mat(k, 310) + lmat(k, 310) + mat(k, 311) = lmat(k, 311) + mat(k, 312) = lmat(k, 312) mat(k, 313) = lmat(k, 313) - mat(k, 316) = mat(k, 316) + lmat(k, 316) - mat(k, 318) = lmat(k, 318) - mat(k, 319) = mat(k, 319) + lmat(k, 319) - mat(k, 320) = lmat(k, 320) - mat(k, 322) = mat(k, 322) + lmat(k, 322) - mat(k, 323) = lmat(k, 323) - mat(k, 325) = mat(k, 325) + lmat(k, 325) - mat(k, 327) = lmat(k, 327) - mat(k, 328) = mat(k, 328) + lmat(k, 328) - mat(k, 329) = lmat(k, 329) - mat(k, 331) = lmat(k, 331) - mat(k, 332) = mat(k, 332) + lmat(k, 332) - mat(k, 333) = lmat(k, 333) - mat(k, 334) = lmat(k, 334) - mat(k, 335) = lmat(k, 335) + mat(k, 314) = lmat(k, 314) + mat(k, 315) = lmat(k, 315) + mat(k, 316) = lmat(k, 316) + mat(k, 317) = lmat(k, 317) + mat(k, 318) = mat(k, 318) + lmat(k, 318) + mat(k, 324) = mat(k, 324) + lmat(k, 324) + mat(k, 330) = mat(k, 330) + lmat(k, 330) mat(k, 336) = lmat(k, 336) mat(k, 337) = lmat(k, 337) mat(k, 338) = lmat(k, 338) - mat(k, 339) = lmat(k, 339) + mat(k, 339) = mat(k, 339) + lmat(k, 339) mat(k, 340) = mat(k, 340) + lmat(k, 340) - mat(k, 342) = lmat(k, 342) - mat(k, 343) = lmat(k, 343) mat(k, 344) = mat(k, 344) + lmat(k, 344) - mat(k, 346) = mat(k, 346) + lmat(k, 346) + mat(k, 346) = lmat(k, 346) mat(k, 347) = lmat(k, 347) + mat(k, 348) = lmat(k, 348) mat(k, 349) = lmat(k, 349) mat(k, 350) = lmat(k, 350) - mat(k, 351) = mat(k, 351) + lmat(k, 351) + mat(k, 351) = lmat(k, 351) mat(k, 352) = mat(k, 352) + lmat(k, 352) - mat(k, 353) = lmat(k, 353) - mat(k, 354) = mat(k, 354) + lmat(k, 354) - mat(k, 355) = mat(k, 355) + lmat(k, 355) - mat(k, 358) = mat(k, 358) + lmat(k, 358) + mat(k, 354) = lmat(k, 354) + mat(k, 355) = lmat(k, 355) + mat(k, 356) = mat(k, 356) + lmat(k, 356) + mat(k, 357) = lmat(k, 357) + mat(k, 358) = lmat(k, 358) mat(k, 359) = lmat(k, 359) - mat(k, 360) = mat(k, 360) + lmat(k, 360) - mat(k, 361) = mat(k, 361) + lmat(k, 361) - mat(k, 362) = lmat(k, 362) - mat(k, 364) = mat(k, 364) + lmat(k, 364) - mat(k, 366) = mat(k, 366) + lmat(k, 366) - mat(k, 369) = mat(k, 369) + lmat(k, 369) + mat(k, 360) = lmat(k, 360) + mat(k, 361) = lmat(k, 361) + mat(k, 362) = mat(k, 362) + lmat(k, 362) + mat(k, 365) = mat(k, 365) + lmat(k, 365) + mat(k, 366) = lmat(k, 366) + mat(k, 367) = mat(k, 367) + lmat(k, 367) + mat(k, 369) = lmat(k, 369) mat(k, 370) = mat(k, 370) + lmat(k, 370) + mat(k, 371) = lmat(k, 371) mat(k, 372) = lmat(k, 372) - mat(k, 373) = lmat(k, 373) - mat(k, 374) = lmat(k, 374) - mat(k, 375) = mat(k, 375) + lmat(k, 375) + mat(k, 373) = mat(k, 373) + lmat(k, 373) + mat(k, 376) = mat(k, 376) + lmat(k, 376) + mat(k, 377) = lmat(k, 377) mat(k, 378) = mat(k, 378) + lmat(k, 378) - mat(k, 384) = mat(k, 384) + lmat(k, 384) - mat(k, 387) = mat(k, 387) + lmat(k, 387) - mat(k, 388) = lmat(k, 388) + mat(k, 380) = mat(k, 380) + lmat(k, 380) + mat(k, 381) = mat(k, 381) + lmat(k, 381) + mat(k, 382) = lmat(k, 382) + mat(k, 383) = mat(k, 383) + lmat(k, 383) + mat(k, 386) = mat(k, 386) + lmat(k, 386) mat(k, 391) = mat(k, 391) + lmat(k, 391) - mat(k, 397) = lmat(k, 397) - mat(k, 398) = lmat(k, 398) - mat(k, 399) = lmat(k, 399) - mat(k, 400) = mat(k, 400) + lmat(k, 400) - mat(k, 404) = mat(k, 404) + lmat(k, 404) - mat(k, 405) = lmat(k, 405) - mat(k, 408) = lmat(k, 408) - mat(k, 409) = mat(k, 409) + lmat(k, 409) - mat(k, 410) = lmat(k, 410) - mat(k, 411) = mat(k, 411) + lmat(k, 411) - mat(k, 412) = lmat(k, 412) - mat(k, 413) = lmat(k, 413) - mat(k, 415) = lmat(k, 415) - mat(k, 416) = mat(k, 416) + lmat(k, 416) + mat(k, 392) = lmat(k, 392) + mat(k, 394) = mat(k, 394) + lmat(k, 394) + mat(k, 399) = mat(k, 399) + lmat(k, 399) + mat(k, 407) = mat(k, 407) + lmat(k, 407) + mat(k, 409) = lmat(k, 409) + mat(k, 413) = mat(k, 413) + lmat(k, 413) + mat(k, 415) = mat(k, 415) + lmat(k, 415) mat(k, 417) = lmat(k, 417) - mat(k, 420) = mat(k, 420) + lmat(k, 420) - mat(k, 428) = mat(k, 428) + lmat(k, 428) - mat(k, 435) = mat(k, 435) + lmat(k, 435) - mat(k, 437) = mat(k, 437) + lmat(k, 437) - mat(k, 439) = lmat(k, 439) - mat(k, 441) = mat(k, 441) + lmat(k, 441) - mat(k, 442) = mat(k, 442) + lmat(k, 442) - mat(k, 446) = lmat(k, 446) + mat(k, 418) = mat(k, 418) + lmat(k, 418) + mat(k, 419) = lmat(k, 419) + mat(k, 421) = mat(k, 421) + lmat(k, 421) + mat(k, 422) = lmat(k, 422) + mat(k, 424) = lmat(k, 424) + mat(k, 425) = mat(k, 425) + lmat(k, 425) + mat(k, 426) = lmat(k, 426) + mat(k, 427) = mat(k, 427) + lmat(k, 427) + mat(k, 429) = lmat(k, 429) + mat(k, 430) = mat(k, 430) + lmat(k, 430) + mat(k, 431) = lmat(k, 431) + mat(k, 433) = mat(k, 433) + lmat(k, 433) + mat(k, 434) = lmat(k, 434) + mat(k, 436) = lmat(k, 436) + mat(k, 438) = mat(k, 438) + lmat(k, 438) + mat(k, 439) = mat(k, 439) + lmat(k, 439) + mat(k, 442) = lmat(k, 442) + mat(k, 445) = mat(k, 445) + lmat(k, 445) + mat(k, 446) = mat(k, 446) + lmat(k, 446) mat(k, 447) = mat(k, 447) + lmat(k, 447) + mat(k, 448) = lmat(k, 448) mat(k, 449) = lmat(k, 449) - mat(k, 450) = lmat(k, 450) - mat(k, 453) = mat(k, 453) + lmat(k, 453) - mat(k, 459) = mat(k, 459) + lmat(k, 459) - mat(k, 462) = lmat(k, 462) - mat(k, 463) = lmat(k, 463) - mat(k, 464) = mat(k, 464) + lmat(k, 464) - mat(k, 465) = lmat(k, 465) - mat(k, 467) = mat(k, 467) + lmat(k, 467) - mat(k, 471) = mat(k, 471) + lmat(k, 471) - mat(k, 476) = lmat(k, 476) - mat(k, 479) = mat(k, 479) + lmat(k, 479) - mat(k, 481) = lmat(k, 481) + mat(k, 451) = mat(k, 451) + lmat(k, 451) + 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, 457) = mat(k, 457) + lmat(k, 457) + mat(k, 458) = mat(k, 458) + lmat(k, 458) + mat(k, 463) = mat(k, 463) + lmat(k, 463) + mat(k, 464) = lmat(k, 464) + mat(k, 466) = lmat(k, 466) + mat(k, 467) = lmat(k, 467) + mat(k, 468) = mat(k, 468) + lmat(k, 468) + mat(k, 469) = mat(k, 469) + lmat(k, 469) + mat(k, 471) = lmat(k, 471) + mat(k, 472) = lmat(k, 472) + mat(k, 473) = mat(k, 473) + lmat(k, 473) + mat(k, 474) = lmat(k, 474) + mat(k, 477) = mat(k, 477) + lmat(k, 477) + mat(k, 483) = lmat(k, 483) + mat(k, 484) = lmat(k, 484) mat(k, 485) = lmat(k, 485) - mat(k, 487) = mat(k, 487) + lmat(k, 487) - mat(k, 495) = mat(k, 495) + lmat(k, 495) - mat(k, 503) = mat(k, 503) + lmat(k, 503) + mat(k, 486) = lmat(k, 486) + mat(k, 487) = lmat(k, 487) + mat(k, 488) = lmat(k, 488) + mat(k, 489) = mat(k, 489) + lmat(k, 489) + mat(k, 493) = lmat(k, 493) + mat(k, 494) = mat(k, 494) + lmat(k, 494) + mat(k, 496) = mat(k, 496) + lmat(k, 496) + mat(k, 502) = lmat(k, 502) + mat(k, 503) = lmat(k, 503) mat(k, 504) = lmat(k, 504) - mat(k, 505) = lmat(k, 505) - mat(k, 506) = lmat(k, 506) - mat(k, 507) = lmat(k, 507) + mat(k, 506) = mat(k, 506) + lmat(k, 506) mat(k, 508) = mat(k, 508) + lmat(k, 508) - mat(k, 509) = mat(k, 509) + lmat(k, 509) - mat(k, 511) = mat(k, 511) + lmat(k, 511) - mat(k, 515) = lmat(k, 515) - mat(k, 520) = mat(k, 520) + lmat(k, 520) - mat(k, 523) = mat(k, 523) + lmat(k, 523) - mat(k, 527) = mat(k, 527) + lmat(k, 527) - mat(k, 528) = lmat(k, 528) + mat(k, 512) = mat(k, 512) + lmat(k, 512) + mat(k, 513) = mat(k, 513) + lmat(k, 513) + mat(k, 517) = mat(k, 517) + lmat(k, 517) + mat(k, 518) = mat(k, 518) + lmat(k, 518) + mat(k, 524) = mat(k, 524) + lmat(k, 524) + mat(k, 526) = lmat(k, 526) + mat(k, 527) = lmat(k, 527) + mat(k, 528) = mat(k, 528) + lmat(k, 528) mat(k, 529) = lmat(k, 529) mat(k, 530) = lmat(k, 530) - mat(k, 531) = lmat(k, 531) - mat(k, 533) = lmat(k, 533) - mat(k, 534) = mat(k, 534) + lmat(k, 534) - mat(k, 535) = lmat(k, 535) - mat(k, 536) = lmat(k, 536) - mat(k, 537) = lmat(k, 537) - mat(k, 538) = mat(k, 538) + lmat(k, 538) - mat(k, 539) = lmat(k, 539) - mat(k, 543) = lmat(k, 543) - mat(k, 544) = lmat(k, 544) - mat(k, 545) = lmat(k, 545) - mat(k, 546) = mat(k, 546) + lmat(k, 546) - mat(k, 547) = lmat(k, 547) - mat(k, 548) = lmat(k, 548) - mat(k, 549) = lmat(k, 549) + mat(k, 533) = mat(k, 533) + lmat(k, 533) + mat(k, 541) = mat(k, 541) + lmat(k, 541) + mat(k, 548) = mat(k, 548) + lmat(k, 548) mat(k, 550) = lmat(k, 550) - mat(k, 551) = mat(k, 551) + lmat(k, 551) - mat(k, 552) = mat(k, 552) + lmat(k, 552) - mat(k, 553) = lmat(k, 553) - mat(k, 554) = lmat(k, 554) - mat(k, 556) = mat(k, 556) + lmat(k, 556) - mat(k, 559) = mat(k, 559) + lmat(k, 559) - mat(k, 565) = lmat(k, 565) + mat(k, 551) = lmat(k, 551) + mat(k, 554) = mat(k, 554) + lmat(k, 554) + mat(k, 560) = mat(k, 560) + lmat(k, 560) + mat(k, 561) = mat(k, 561) + lmat(k, 561) + mat(k, 564) = lmat(k, 564) mat(k, 566) = mat(k, 566) + lmat(k, 566) - mat(k, 569) = mat(k, 569) + lmat(k, 569) - mat(k, 570) = mat(k, 570) + lmat(k, 570) - mat(k, 572) = lmat(k, 572) + mat(k, 567) = lmat(k, 567) + mat(k, 568) = lmat(k, 568) + mat(k, 569) = lmat(k, 569) + mat(k, 570) = lmat(k, 570) + mat(k, 573) = mat(k, 573) + lmat(k, 573) mat(k, 574) = mat(k, 574) + lmat(k, 574) - mat(k, 575) = mat(k, 575) + lmat(k, 575) + mat(k, 575) = lmat(k, 575) mat(k, 576) = lmat(k, 576) - mat(k, 577) = mat(k, 577) + lmat(k, 577) - mat(k, 581) = lmat(k, 581) - mat(k, 582) = lmat(k, 582) - mat(k, 584) = lmat(k, 584) - mat(k, 585) = mat(k, 585) + lmat(k, 585) - mat(k, 586) = lmat(k, 586) - mat(k, 588) = mat(k, 588) + lmat(k, 588) - mat(k, 596) = mat(k, 596) + lmat(k, 596) - mat(k, 598) = lmat(k, 598) - mat(k, 599) = lmat(k, 599) - mat(k, 600) = lmat(k, 600) - mat(k, 602) = lmat(k, 602) - mat(k, 603) = lmat(k, 603) - mat(k, 604) = lmat(k, 604) - mat(k, 605) = lmat(k, 605) - mat(k, 606) = lmat(k, 606) - mat(k, 607) = mat(k, 607) + lmat(k, 607) - mat(k, 612) = lmat(k, 612) - mat(k, 614) = lmat(k, 614) + mat(k, 577) = lmat(k, 577) + mat(k, 578) = lmat(k, 578) + mat(k, 580) = mat(k, 580) + lmat(k, 580) + mat(k, 581) = mat(k, 581) + lmat(k, 581) + mat(k, 582) = mat(k, 582) + lmat(k, 582) + mat(k, 587) = lmat(k, 587) + mat(k, 590) = mat(k, 590) + lmat(k, 590) + mat(k, 592) = lmat(k, 592) + mat(k, 594) = mat(k, 594) + lmat(k, 594) + mat(k, 595) = lmat(k, 595) + mat(k, 596) = lmat(k, 596) + mat(k, 598) = mat(k, 598) + lmat(k, 598) + mat(k, 606) = mat(k, 606) + lmat(k, 606) + mat(k, 614) = mat(k, 614) + lmat(k, 614) + mat(k, 615) = mat(k, 615) + lmat(k, 615) mat(k, 616) = lmat(k, 616) - mat(k, 617) = mat(k, 617) + lmat(k, 617) - mat(k, 620) = mat(k, 620) + lmat(k, 620) + mat(k, 623) = mat(k, 623) + lmat(k, 623) + mat(k, 624) = mat(k, 624) + lmat(k, 624) + mat(k, 626) = lmat(k, 626) mat(k, 627) = mat(k, 627) + lmat(k, 627) - mat(k, 638) = mat(k, 638) + lmat(k, 638) - mat(k, 654) = mat(k, 654) + lmat(k, 654) - mat(k, 665) = mat(k, 665) + lmat(k, 665) - mat(k, 674) = mat(k, 674) + lmat(k, 674) - mat(k, 684) = mat(k, 684) + lmat(k, 684) - mat(k, 685) = lmat(k, 685) - mat(k, 687) = mat(k, 687) + lmat(k, 687) - mat(k, 692) = mat(k, 692) + lmat(k, 692) + mat(k, 630) = mat(k, 630) + lmat(k, 630) + mat(k, 633) = lmat(k, 633) + mat(k, 634) = lmat(k, 634) + mat(k, 639) = mat(k, 639) + lmat(k, 639) + mat(k, 640) = mat(k, 640) + lmat(k, 640) + mat(k, 646) = lmat(k, 646) + mat(k, 647) = lmat(k, 647) + mat(k, 648) = mat(k, 648) + lmat(k, 648) + mat(k, 649) = lmat(k, 649) + mat(k, 653) = lmat(k, 653) + mat(k, 654) = lmat(k, 654) + mat(k, 655) = mat(k, 655) + lmat(k, 655) + mat(k, 656) = lmat(k, 656) + mat(k, 657) = mat(k, 657) + lmat(k, 657) + mat(k, 661) = lmat(k, 661) + mat(k, 666) = lmat(k, 666) + mat(k, 667) = lmat(k, 667) + mat(k, 668) = lmat(k, 668) + mat(k, 669) = lmat(k, 669) + mat(k, 670) = mat(k, 670) + lmat(k, 670) + mat(k, 671) = mat(k, 671) + lmat(k, 671) + mat(k, 672) = lmat(k, 672) + mat(k, 673) = mat(k, 673) + lmat(k, 673) + mat(k, 675) = lmat(k, 675) + mat(k, 678) = mat(k, 678) + lmat(k, 678) + mat(k, 684) = lmat(k, 684) + mat(k, 685) = mat(k, 685) + lmat(k, 685) + mat(k, 688) = mat(k, 688) + lmat(k, 688) + mat(k, 689) = mat(k, 689) + lmat(k, 689) + mat(k, 691) = mat(k, 691) + lmat(k, 691) mat(k, 693) = mat(k, 693) + lmat(k, 693) + mat(k, 694) = lmat(k, 694) + mat(k, 695) = mat(k, 695) + lmat(k, 695) + mat(k, 696) = lmat(k, 696) + mat(k, 697) = lmat(k, 697) + mat(k, 698) = lmat(k, 698) mat(k, 699) = lmat(k, 699) - mat(k, 701) = mat(k, 701) + lmat(k, 701) - mat(k, 705) = mat(k, 705) + lmat(k, 705) - mat(k, 710) = mat(k, 710) + lmat(k, 710) - mat(k, 720) = mat(k, 720) + lmat(k, 720) - mat(k, 721) = mat(k, 721) + lmat(k, 721) - mat(k, 722) = mat(k, 722) + lmat(k, 722) - mat(k, 729) = mat(k, 729) + lmat(k, 729) - mat(k, 731) = mat(k, 731) + lmat(k, 731) + mat(k, 700) = lmat(k, 700) + mat(k, 702) = mat(k, 702) + lmat(k, 702) + mat(k, 703) = lmat(k, 703) + mat(k, 704) = lmat(k, 704) + mat(k, 705) = lmat(k, 705) + mat(k, 706) = mat(k, 706) + lmat(k, 706) + mat(k, 710) = lmat(k, 710) + mat(k, 711) = lmat(k, 711) + mat(k, 713) = mat(k, 713) + lmat(k, 713) + mat(k, 714) = lmat(k, 714) + mat(k, 715) = lmat(k, 715) + mat(k, 717) = mat(k, 717) + lmat(k, 717) + mat(k, 724) = mat(k, 724) + lmat(k, 724) + mat(k, 730) = mat(k, 730) + lmat(k, 730) + mat(k, 732) = lmat(k, 732) + mat(k, 733) = lmat(k, 733) mat(k, 734) = mat(k, 734) + lmat(k, 734) - mat(k, 739) = mat(k, 739) + lmat(k, 739) - mat(k, 747) = mat(k, 747) + lmat(k, 747) - mat(k, 749) = lmat(k, 749) + mat(k, 735) = lmat(k, 735) + mat(k, 736) = lmat(k, 736) + mat(k, 737) = lmat(k, 737) + mat(k, 738) = lmat(k, 738) + mat(k, 739) = lmat(k, 739) + mat(k, 740) = lmat(k, 740) + mat(k, 741) = mat(k, 741) + lmat(k, 741) + mat(k, 746) = lmat(k, 746) + mat(k, 748) = lmat(k, 748) + mat(k, 750) = mat(k, 750) + lmat(k, 750) mat(k, 751) = lmat(k, 751) - mat(k, 752) = mat(k, 752) + lmat(k, 752) mat(k, 754) = mat(k, 754) + lmat(k, 754) - mat(k, 755) = lmat(k, 755) - mat(k, 758) = lmat(k, 758) - mat(k, 766) = mat(k, 766) + lmat(k, 766) - mat(k, 782) = mat(k, 782) + lmat(k, 782) - mat(k, 791) = lmat(k, 791) - mat(k, 792) = mat(k, 792) + lmat(k, 792) - mat(k, 793) = mat(k, 793) + lmat(k, 793) - mat(k, 794) = mat(k, 794) + lmat(k, 794) - mat(k, 805) = mat(k, 805) + lmat(k, 805) + mat(k, 761) = mat(k, 761) + lmat(k, 761) + mat(k, 772) = mat(k, 772) + lmat(k, 772) + mat(k, 788) = mat(k, 788) + lmat(k, 788) + mat(k, 799) = mat(k, 799) + lmat(k, 799) + mat(k, 808) = mat(k, 808) + lmat(k, 808) + mat(k, 818) = mat(k, 818) + lmat(k, 818) + mat(k, 819) = lmat(k, 819) + mat(k, 820) = mat(k, 820) + lmat(k, 820) + mat(k, 826) = mat(k, 826) + lmat(k, 826) mat(k, 831) = mat(k, 831) + lmat(k, 831) - mat(k, 853) = mat(k, 853) + lmat(k, 853) - mat(k, 863) = mat(k, 863) + lmat(k, 863) - mat(k, 865) = lmat(k, 865) - mat(k, 867) = lmat(k, 867) - mat(k, 870) = mat(k, 870) + lmat(k, 870) - mat(k, 871) = mat(k, 871) + lmat(k, 871) - mat(k, 872) = mat(k, 872) + lmat(k, 872) - mat(k, 875) = lmat(k, 875) - mat(k, 876) = mat(k, 876) + lmat(k, 876) - mat(k, 877) = mat(k, 877) + lmat(k, 877) - mat(k, 879) = mat(k, 879) + lmat(k, 879) - mat(k, 881) = mat(k, 881) + lmat(k, 881) - mat(k, 882) = lmat(k, 882) - mat(k, 883) = lmat(k, 883) - mat(k, 886) = lmat(k, 886) + mat(k, 842) = mat(k, 842) + lmat(k, 842) + mat(k, 843) = mat(k, 843) + lmat(k, 843) + mat(k, 847) = mat(k, 847) + lmat(k, 847) + mat(k, 849) = mat(k, 849) + lmat(k, 849) + mat(k, 850) = mat(k, 850) + lmat(k, 850) + mat(k, 851) = mat(k, 851) + lmat(k, 851) + mat(k, 860) = mat(k, 860) + lmat(k, 860) + mat(k, 868) = lmat(k, 868) + mat(k, 869) = lmat(k, 869) + mat(k, 870) = lmat(k, 870) + mat(k, 874) = mat(k, 874) + lmat(k, 874) + mat(k, 890) = mat(k, 890) + lmat(k, 890) + mat(k, 892) = lmat(k, 892) mat(k, 893) = mat(k, 893) + lmat(k, 893) - mat(k, 908) = lmat(k, 908) - mat(k, 912) = mat(k, 912) + lmat(k, 912) - mat(k, 916) = lmat(k, 916) - mat(k, 918) = mat(k, 918) + lmat(k, 918) - mat(k, 921) = lmat(k, 921) + mat(k, 895) = lmat(k, 895) + mat(k, 897) = mat(k, 897) + lmat(k, 897) + mat(k, 898) = lmat(k, 898) + mat(k, 900) = lmat(k, 900) + mat(k, 903) = mat(k, 903) + lmat(k, 903) + mat(k, 913) = mat(k, 913) + lmat(k, 913) + mat(k, 923) = mat(k, 923) + lmat(k, 923) mat(k, 924) = mat(k, 924) + lmat(k, 924) - mat(k, 925) = lmat(k, 925) - mat(k, 926) = mat(k, 926) + lmat(k, 926) + mat(k, 925) = mat(k, 925) + lmat(k, 925) + mat(k, 926) = lmat(k, 926) mat(k, 928) = mat(k, 928) + lmat(k, 928) - mat(k, 930) = lmat(k, 930) - mat(k, 931) = lmat(k, 931) + mat(k, 931) = mat(k, 931) + lmat(k, 931) mat(k, 932) = mat(k, 932) + lmat(k, 932) - mat(k, 933) = lmat(k, 933) - mat(k, 934) = lmat(k, 934) - mat(k, 936) = lmat(k, 936) - mat(k, 937) = lmat(k, 937) - mat(k, 938) = lmat(k, 938) mat(k, 939) = mat(k, 939) + lmat(k, 939) - mat(k, 941) = lmat(k, 941) - mat(k, 942) = lmat(k, 942) - mat(k, 945) = mat(k, 945) + lmat(k, 945) - mat(k, 946) = mat(k, 946) + lmat(k, 946) - mat(k, 947) = mat(k, 947) + lmat(k, 947) - mat(k, 948) = mat(k, 948) + lmat(k, 948) - mat(k, 949) = mat(k, 949) + lmat(k, 949) - mat(k, 950) = mat(k, 950) + lmat(k, 950) mat(k, 952) = mat(k, 952) + lmat(k, 952) - mat(k, 955) = mat(k, 955) + lmat(k, 955) - mat(k, 959) = mat(k, 959) + lmat(k, 959) - mat(k, 961) = lmat(k, 961) mat(k, 962) = mat(k, 962) + lmat(k, 962) mat(k, 964) = lmat(k, 964) - mat(k, 972) = mat(k, 972) + lmat(k, 972) - mat(k, 994) = mat(k, 994) + lmat(k, 994) - mat(k,1013) = mat(k,1013) + lmat(k,1013) - mat(k,1029) = mat(k,1029) + lmat(k,1029) - mat(k,1039) = lmat(k,1039) - mat(k,1040) = mat(k,1040) + lmat(k,1040) - mat(k,1044) = lmat(k,1044) - mat(k,1047) = lmat(k,1047) - mat(k,1051) = mat(k,1051) + lmat(k,1051) - mat(k,1068) = mat(k,1068) + lmat(k,1068) - mat(k,1088) = mat(k,1088) + lmat(k,1088) - mat(k,1103) = mat(k,1103) + lmat(k,1103) - mat(k,1104) = mat(k,1104) + lmat(k,1104) - mat(k,1107) = mat(k,1107) + lmat(k,1107) - mat(k,1108) = mat(k,1108) + lmat(k,1108) - mat(k,1110) = mat(k,1110) + lmat(k,1110) - mat(k,1112) = mat(k,1112) + lmat(k,1112) + mat(k, 965) = lmat(k, 965) + mat(k, 968) = lmat(k, 968) + mat(k, 970) = mat(k, 970) + lmat(k, 970) + mat(k, 971) = mat(k, 971) + lmat(k, 971) + mat(k, 974) = mat(k, 974) + lmat(k, 974) + mat(k, 988) = mat(k, 988) + lmat(k, 988) + mat(k,1010) = mat(k,1010) + lmat(k,1010) + mat(k,1016) = mat(k,1016) + lmat(k,1016) + mat(k,1018) = lmat(k,1018) + mat(k,1019) = lmat(k,1019) + mat(k,1023) = lmat(k,1023) + mat(k,1039) = mat(k,1039) + lmat(k,1039) + mat(k,1064) = mat(k,1064) + lmat(k,1064) + mat(k,1081) = lmat(k,1081) + mat(k,1085) = mat(k,1085) + lmat(k,1085) + mat(k,1089) = lmat(k,1089) + mat(k,1092) = lmat(k,1092) + mat(k,1096) = mat(k,1096) + lmat(k,1096) + mat(k,1101) = mat(k,1101) + lmat(k,1101) + mat(k,1113) = mat(k,1113) + lmat(k,1113) + mat(k,1114) = mat(k,1114) + lmat(k,1114) mat(k,1115) = mat(k,1115) + lmat(k,1115) mat(k,1116) = mat(k,1116) + lmat(k,1116) mat(k,1117) = mat(k,1117) + lmat(k,1117) - mat(k,1120) = lmat(k,1120) - mat(k,1125) = lmat(k,1125) - mat(k,1126) = mat(k,1126) + lmat(k,1126) - mat(k,1127) = mat(k,1127) + lmat(k,1127) - mat(k,1137) = lmat(k,1137) - mat(k,1152) = mat(k,1152) + lmat(k,1152) - mat(k,1169) = lmat(k,1169) - mat(k,1170) = mat(k,1170) + lmat(k,1170) - mat(k,1174) = mat(k,1174) + lmat(k,1174) - mat(k,1176) = mat(k,1176) + lmat(k,1176) - mat(k,1185) = lmat(k,1185) - mat(k,1197) = mat(k,1197) + lmat(k,1197) - mat(k,1210) = lmat(k,1210) - mat(k,1230) = mat(k,1230) + lmat(k,1230) - mat(k,1236) = mat(k,1236) + lmat(k,1236) + mat(k,1118) = mat(k,1118) + lmat(k,1118) + mat(k,1122) = mat(k,1122) + lmat(k,1122) + mat(k,1123) = mat(k,1123) + lmat(k,1123) + mat(k,1125) = mat(k,1125) + lmat(k,1125) + mat(k,1126) = lmat(k,1126) + mat(k,1129) = lmat(k,1129) + mat(k,1132) = lmat(k,1132) + mat(k,1135) = mat(k,1135) + lmat(k,1135) + mat(k,1141) = lmat(k,1141) + mat(k,1142) = mat(k,1142) + lmat(k,1142) + mat(k,1145) = mat(k,1145) + lmat(k,1145) + mat(k,1146) = mat(k,1146) + lmat(k,1146) + mat(k,1155) = mat(k,1155) + lmat(k,1155) + mat(k,1169) = mat(k,1169) + lmat(k,1169) + mat(k,1180) = mat(k,1180) + lmat(k,1180) + mat(k,1182) = lmat(k,1182) + mat(k,1184) = lmat(k,1184) + mat(k,1185) = mat(k,1185) + lmat(k,1185) + mat(k,1187) = lmat(k,1187) + mat(k,1188) = lmat(k,1188) + mat(k,1189) = lmat(k,1189) + mat(k,1190) = lmat(k,1190) + mat(k,1192) = lmat(k,1192) + mat(k,1193) = mat(k,1193) + lmat(k,1193) + mat(k,1195) = lmat(k,1195) + mat(k,1196) = lmat(k,1196) + mat(k,1199) = lmat(k,1199) + mat(k,1202) = lmat(k,1202) + mat(k,1204) = mat(k,1204) + lmat(k,1204) + mat(k,1213) = mat(k,1213) + lmat(k,1213) + mat(k,1233) = mat(k,1233) + lmat(k,1233) + mat(k,1248) = mat(k,1248) + lmat(k,1248) mat(k,1249) = mat(k,1249) + lmat(k,1249) - mat(k,1280) = mat(k,1280) + lmat(k,1280) - mat(k,1294) = mat(k,1294) + lmat(k,1294) - mat(k,1307) = mat(k,1307) + lmat(k,1307) - mat(k,1311) = mat(k,1311) + lmat(k,1311) + mat(k,1252) = mat(k,1252) + lmat(k,1252) + mat(k,1253) = mat(k,1253) + lmat(k,1253) + mat(k,1256) = mat(k,1256) + lmat(k,1256) + mat(k,1257) = mat(k,1257) + lmat(k,1257) + mat(k,1260) = mat(k,1260) + lmat(k,1260) + mat(k,1261) = mat(k,1261) + lmat(k,1261) + mat(k,1262) = mat(k,1262) + lmat(k,1262) + mat(k,1267) = lmat(k,1267) + mat(k,1270) = lmat(k,1270) + mat(k,1271) = mat(k,1271) + lmat(k,1271) + mat(k,1272) = mat(k,1272) + lmat(k,1272) + mat(k,1279) = lmat(k,1279) + mat(k,1296) = mat(k,1296) + lmat(k,1296) mat(k,1312) = lmat(k,1312) - mat(k,1320) = mat(k,1320) + lmat(k,1320) - mat(k,1322) = mat(k,1322) + lmat(k,1322) - mat(k,1338) = mat(k,1338) + lmat(k,1338) - mat(k,1395) = mat(k,1395) + lmat(k,1395) - mat(k,1407) = mat(k,1407) + lmat(k,1407) - mat(k,1417) = mat(k,1417) + lmat(k,1417) - mat(k,1418) = mat(k,1418) + lmat(k,1418) - mat(k,1430) = mat(k,1430) + lmat(k,1430) - mat(k,1461) = mat(k,1461) + lmat(k,1461) - mat(k,1513) = mat(k,1513) + lmat(k,1513) - mat(k,1526) = mat(k,1526) + lmat(k,1526) - mat(k,1527) = mat(k,1527) + lmat(k,1527) - mat(k,1529) = mat(k,1529) + lmat(k,1529) - mat(k,1531) = mat(k,1531) + lmat(k,1531) - mat(k,1532) = mat(k,1532) + lmat(k,1532) - mat(k,1534) = mat(k,1534) + lmat(k,1534) - mat(k,1535) = lmat(k,1535) - mat(k,1537) = lmat(k,1537) - mat(k,1538) = mat(k,1538) + lmat(k,1538) - mat(k,1539) = mat(k,1539) + lmat(k,1539) - mat(k,1540) = lmat(k,1540) - mat(k,1543) = lmat(k,1543) - mat(k,1547) = lmat(k,1547) - mat(k,1548) = mat(k,1548) + lmat(k,1548) - mat(k,1573) = lmat(k,1573) - mat(k,1577) = lmat(k,1577) - mat(k,1691) = mat(k,1691) + lmat(k,1691) - mat(k,1696) = mat(k,1696) + lmat(k,1696) + mat(k,1328) = mat(k,1328) + lmat(k,1328) + mat(k,1341) = mat(k,1341) + lmat(k,1341) + mat(k,1351) = mat(k,1351) + lmat(k,1351) + mat(k,1366) = lmat(k,1366) + mat(k,1368) = mat(k,1368) + lmat(k,1368) + mat(k,1372) = mat(k,1372) + lmat(k,1372) + mat(k,1374) = mat(k,1374) + lmat(k,1374) + mat(k,1378) = lmat(k,1378) + mat(k,1394) = mat(k,1394) + lmat(k,1394) + mat(k,1426) = mat(k,1426) + lmat(k,1426) + mat(k,1441) = mat(k,1441) + lmat(k,1441) + mat(k,1455) = mat(k,1455) + lmat(k,1455) + mat(k,1466) = lmat(k,1466) + mat(k,1468) = lmat(k,1468) + mat(k,1469) = mat(k,1469) + lmat(k,1469) + mat(k,1470) = mat(k,1470) + lmat(k,1470) + mat(k,1472) = mat(k,1472) + lmat(k,1472) + mat(k,1473) = mat(k,1473) + lmat(k,1473) + mat(k,1475) = mat(k,1475) + lmat(k,1475) + mat(k,1477) = lmat(k,1477) + mat(k,1478) = mat(k,1478) + lmat(k,1478) + mat(k,1482) = mat(k,1482) + lmat(k,1482) + mat(k,1487) = mat(k,1487) + lmat(k,1487) + mat(k,1490) = lmat(k,1490) + mat(k,1492) = mat(k,1492) + lmat(k,1492) + mat(k,1503) = mat(k,1503) + lmat(k,1503) + mat(k,1512) = mat(k,1512) + lmat(k,1512) + mat(k,1549) = mat(k,1549) + lmat(k,1549) + mat(k,1604) = mat(k,1604) + lmat(k,1604) + mat(k,1611) = mat(k,1611) + lmat(k,1611) + mat(k,1657) = mat(k,1657) + lmat(k,1657) mat(k,1698) = mat(k,1698) + lmat(k,1698) + mat(k,1700) = mat(k,1700) + lmat(k,1700) mat(k,1702) = mat(k,1702) + lmat(k,1702) + mat(k,1704) = mat(k,1704) + lmat(k,1704) mat(k,1707) = mat(k,1707) + lmat(k,1707) - mat(k,1708) = mat(k,1708) + lmat(k,1708) - mat(k,1712) = mat(k,1712) + lmat(k,1712) - mat(k,1713) = lmat(k,1713) - mat(k,1716) = mat(k,1716) + lmat(k,1716) - mat(k,1722) = mat(k,1722) + lmat(k,1722) - mat(k,1756) = mat(k,1756) + lmat(k,1756) - mat(k,1758) = mat(k,1758) + lmat(k,1758) - mat(k,1762) = mat(k,1762) + lmat(k,1762) - mat(k,1764) = mat(k,1764) + lmat(k,1764) - mat(k,1770) = mat(k,1770) + lmat(k,1770) - mat(k,1813) = mat(k,1813) + lmat(k,1813) - mat(k,1815) = mat(k,1815) + lmat(k,1815) - mat(k,1821) = mat(k,1821) + lmat(k,1821) - mat(k,1822) = mat(k,1822) + lmat(k,1822) - mat(k,1827) = mat(k,1827) + lmat(k,1827) - mat(k,1873) = mat(k,1873) + lmat(k,1873) - mat(k,1928) = mat(k,1928) + lmat(k,1928) - mat(k,1934) = mat(k,1934) + lmat(k,1934) - mat(k,1937) = mat(k,1937) + lmat(k,1937) + mat(k,1744) = mat(k,1744) + lmat(k,1744) + mat(k,1748) = lmat(k,1748) + mat(k,1917) = mat(k,1917) + lmat(k,1917) + mat(k,1944) = mat(k,1944) + lmat(k,1944) mat(k,1946) = mat(k,1946) + lmat(k,1946) - mat(k,1959) = mat(k,1959) + lmat(k,1959) + mat(k,1951) = mat(k,1951) + lmat(k,1951) mat(k,1961) = mat(k,1961) + lmat(k,1961) - mat(k,1986) = mat(k,1986) + lmat(k,1986) - mat(k,1987) = mat(k,1987) + lmat(k,1987) - mat(k,1988) = mat(k,1988) + lmat(k,1988) - mat(k,2014) = mat(k,2014) + lmat(k,2014) - mat(k,2017) = mat(k,2017) + lmat(k,2017) - mat(k,2032) = mat(k,2032) + lmat(k,2032) - mat(k,2036) = lmat(k,2036) - mat(k,2040) = mat(k,2040) + lmat(k,2040) - mat(k,2041) = mat(k,2041) + lmat(k,2041) - mat(k,2047) = lmat(k,2047) - mat(k,2052) = mat(k,2052) + lmat(k,2052) - mat(k,2059) = lmat(k,2059) - mat(k,2063) = lmat(k,2063) - mat(k,2067) = mat(k,2067) + lmat(k,2067) - mat(k,2068) = mat(k,2068) + lmat(k,2068) - mat(k,2076) = lmat(k,2076) - mat(k,2078) = mat(k,2078) + lmat(k,2078) - mat(k, 182) = 0._r8 - mat(k, 183) = 0._r8 - mat(k, 273) = 0._r8 - mat(k, 379) = 0._r8 - mat(k, 382) = 0._r8 - mat(k, 395) = 0._r8 - mat(k, 421) = 0._r8 - mat(k, 425) = 0._r8 - mat(k, 433) = 0._r8 - mat(k, 540) = 0._r8 - mat(k, 542) = 0._r8 - mat(k, 562) = 0._r8 - mat(k, 564) = 0._r8 - mat(k, 567) = 0._r8 - mat(k, 568) = 0._r8 - mat(k, 571) = 0._r8 - mat(k, 578) = 0._r8 - mat(k, 579) = 0._r8 - mat(k, 583) = 0._r8 - mat(k, 608) = 0._r8 - mat(k, 610) = 0._r8 - mat(k, 611) = 0._r8 - mat(k, 613) = 0._r8 - mat(k, 615) = 0._r8 - mat(k, 621) = 0._r8 - mat(k, 624) = 0._r8 - mat(k, 637) = 0._r8 - mat(k, 639) = 0._r8 - mat(k, 640) = 0._r8 - mat(k, 642) = 0._r8 - mat(k, 646) = 0._r8 - mat(k, 653) = 0._r8 - mat(k, 655) = 0._r8 - mat(k, 656) = 0._r8 - mat(k, 658) = 0._r8 - mat(k, 660) = 0._r8 - mat(k, 663) = 0._r8 - mat(k, 675) = 0._r8 - mat(k, 679) = 0._r8 - mat(k, 682) = 0._r8 + mat(k,1967) = mat(k,1967) + lmat(k,1967) + mat(k,1973) = mat(k,1973) + lmat(k,1973) + mat(k,1999) = mat(k,1999) + lmat(k,1999) + mat(k,2005) = mat(k,2005) + lmat(k,2005) + mat(k,2010) = mat(k,2010) + lmat(k,2010) + mat(k,2011) = lmat(k,2011) + mat(k,2015) = mat(k,2015) + lmat(k,2015) + mat(k,2024) = mat(k,2024) + lmat(k,2024) + mat(k,2071) = mat(k,2071) + lmat(k,2071) + mat(k,2073) = mat(k,2073) + lmat(k,2073) + mat(k,2075) = mat(k,2075) + lmat(k,2075) + mat(k,2080) = mat(k,2080) + lmat(k,2080) + mat(k,2082) = mat(k,2082) + lmat(k,2082) + mat(k,2094) = mat(k,2094) + lmat(k,2094) + mat(k,2104) = mat(k,2104) + lmat(k,2104) + mat(k,2107) = mat(k,2107) + lmat(k,2107) + mat(k,2163) = mat(k,2163) + lmat(k,2163) + mat(k,2227) = mat(k,2227) + lmat(k,2227) + mat(k,2267) = mat(k,2267) + lmat(k,2267) + mat(k,2319) = mat(k,2319) + lmat(k,2319) + mat(k,2323) = mat(k,2323) + lmat(k,2323) + mat(k,2329) = mat(k,2329) + lmat(k,2329) + mat(k,2337) = lmat(k,2337) + mat(k,2341) = lmat(k,2341) + mat(k,2345) = mat(k,2345) + lmat(k,2345) + mat(k,2346) = mat(k,2346) + lmat(k,2346) + mat(k,2349) = lmat(k,2349) + mat(k,2356) = mat(k,2356) + lmat(k,2356) + mat(k, 255) = 0._r8 + mat(k, 256) = 0._r8 + mat(k, 341) = 0._r8 + mat(k, 375) = 0._r8 + mat(k, 478) = 0._r8 + mat(k, 481) = 0._r8 + mat(k, 500) = 0._r8 + mat(k, 510) = 0._r8 + mat(k, 534) = 0._r8 + mat(k, 538) = 0._r8 + mat(k, 546) = 0._r8 + mat(k, 650) = 0._r8 + mat(k, 652) = 0._r8 + mat(k, 681) = 0._r8 + mat(k, 683) = 0._r8 + mat(k, 686) = 0._r8 + mat(k, 687) = 0._r8 mat(k, 690) = 0._r8 - mat(k, 715) = 0._r8 - mat(k, 719) = 0._r8 - mat(k, 743) = 0._r8 - mat(k, 759) = 0._r8 - mat(k, 781) = 0._r8 - mat(k, 804) = 0._r8 - mat(k, 806) = 0._r8 - mat(k, 814) = 0._r8 - mat(k, 821) = 0._r8 - mat(k, 830) = 0._r8 - mat(k, 832) = 0._r8 + mat(k, 707) = 0._r8 + mat(k, 708) = 0._r8 + mat(k, 712) = 0._r8 + mat(k, 742) = 0._r8 + mat(k, 744) = 0._r8 + mat(k, 745) = 0._r8 + mat(k, 747) = 0._r8 + mat(k, 749) = 0._r8 + mat(k, 755) = 0._r8 + mat(k, 758) = 0._r8 + mat(k, 771) = 0._r8 + mat(k, 773) = 0._r8 + mat(k, 774) = 0._r8 + mat(k, 776) = 0._r8 + mat(k, 780) = 0._r8 + mat(k, 787) = 0._r8 + mat(k, 789) = 0._r8 + mat(k, 790) = 0._r8 + mat(k, 792) = 0._r8 + mat(k, 794) = 0._r8 + mat(k, 797) = 0._r8 + mat(k, 810) = 0._r8 + mat(k, 813) = 0._r8 + mat(k, 816) = 0._r8 + mat(k, 824) = 0._r8 + mat(k, 837) = 0._r8 mat(k, 840) = 0._r8 - mat(k, 847) = 0._r8 - mat(k, 851) = 0._r8 - mat(k, 852) = 0._r8 - mat(k, 856) = 0._r8 - mat(k, 859) = 0._r8 - mat(k, 862) = 0._r8 - mat(k, 880) = 0._r8 - mat(k, 895) = 0._r8 - mat(k, 897) = 0._r8 - mat(k, 898) = 0._r8 - mat(k, 899) = 0._r8 - mat(k, 903) = 0._r8 - mat(k, 907) = 0._r8 - mat(k, 910) = 0._r8 - mat(k, 913) = 0._r8 - mat(k, 914) = 0._r8 - mat(k, 915) = 0._r8 - mat(k, 917) = 0._r8 - mat(k, 920) = 0._r8 - mat(k, 922) = 0._r8 - mat(k, 935) = 0._r8 - mat(k, 943) = 0._r8 + mat(k, 865) = 0._r8 + mat(k, 902) = 0._r8 + mat(k, 933) = 0._r8 + mat(k, 937) = 0._r8 + mat(k, 938) = 0._r8 + mat(k, 942) = 0._r8 mat(k, 944) = 0._r8 - mat(k, 953) = 0._r8 - mat(k, 954) = 0._r8 - mat(k, 970) = 0._r8 - mat(k, 971) = 0._r8 + mat(k, 946) = 0._r8 + mat(k, 955) = 0._r8 + mat(k, 959) = 0._r8 mat(k, 973) = 0._r8 - mat(k, 974) = 0._r8 - mat(k, 975) = 0._r8 - mat(k, 976) = 0._r8 - mat(k, 977) = 0._r8 - mat(k, 978) = 0._r8 - mat(k, 981) = 0._r8 mat(k, 984) = 0._r8 - mat(k, 986) = 0._r8 - mat(k, 995) = 0._r8 + mat(k, 987) = 0._r8 + mat(k, 993) = 0._r8 mat(k, 996) = 0._r8 - mat(k, 997) = 0._r8 mat(k, 998) = 0._r8 + mat(k, 999) = 0._r8 + mat(k,1000) = 0._r8 mat(k,1001) = 0._r8 - mat(k,1005) = 0._r8 - mat(k,1010) = 0._r8 + mat(k,1003) = 0._r8 + mat(k,1008) = 0._r8 mat(k,1011) = 0._r8 - mat(k,1012) = 0._r8 - mat(k,1014) = 0._r8 - mat(k,1015) = 0._r8 - mat(k,1016) = 0._r8 - mat(k,1017) = 0._r8 - mat(k,1020) = 0._r8 - mat(k,1025) = 0._r8 - mat(k,1038) = 0._r8 - mat(k,1043) = 0._r8 - mat(k,1052) = 0._r8 - mat(k,1057) = 0._r8 + mat(k,1013) = 0._r8 + mat(k,1033) = 0._r8 + mat(k,1036) = 0._r8 + mat(k,1042) = 0._r8 + mat(k,1044) = 0._r8 + mat(k,1046) = 0._r8 + mat(k,1048) = 0._r8 + mat(k,1049) = 0._r8 + mat(k,1050) = 0._r8 + mat(k,1051) = 0._r8 + mat(k,1053) = 0._r8 mat(k,1058) = 0._r8 + mat(k,1067) = 0._r8 + mat(k,1068) = 0._r8 + mat(k,1069) = 0._r8 mat(k,1071) = 0._r8 - mat(k,1074) = 0._r8 - mat(k,1081) = 0._r8 + mat(k,1073) = 0._r8 + mat(k,1075) = 0._r8 + mat(k,1080) = 0._r8 mat(k,1083) = 0._r8 - mat(k,1085) = 0._r8 mat(k,1086) = 0._r8 mat(k,1087) = 0._r8 - mat(k,1089) = 0._r8 + mat(k,1088) = 0._r8 mat(k,1090) = 0._r8 mat(k,1091) = 0._r8 - mat(k,1093) = 0._r8 mat(k,1094) = 0._r8 - mat(k,1097) = 0._r8 + mat(k,1095) = 0._r8 + mat(k,1102) = 0._r8 + mat(k,1103) = 0._r8 + mat(k,1104) = 0._r8 + mat(k,1105) = 0._r8 mat(k,1109) = 0._r8 mat(k,1119) = 0._r8 - mat(k,1131) = 0._r8 - mat(k,1139) = 0._r8 - mat(k,1143) = 0._r8 + mat(k,1121) = 0._r8 + mat(k,1124) = 0._r8 + mat(k,1137) = 0._r8 mat(k,1144) = 0._r8 - mat(k,1145) = 0._r8 - mat(k,1146) = 0._r8 - mat(k,1147) = 0._r8 - mat(k,1148) = 0._r8 - mat(k,1149) = 0._r8 - mat(k,1151) = 0._r8 - mat(k,1154) = 0._r8 - mat(k,1155) = 0._r8 + mat(k,1156) = 0._r8 mat(k,1157) = 0._r8 mat(k,1158) = 0._r8 - mat(k,1161) = 0._r8 + mat(k,1162) = 0._r8 + mat(k,1163) = 0._r8 mat(k,1166) = 0._r8 - mat(k,1167) = 0._r8 - mat(k,1171) = 0._r8 - mat(k,1177) = 0._r8 - mat(k,1178) = 0._r8 mat(k,1179) = 0._r8 - mat(k,1183) = 0._r8 - mat(k,1184) = 0._r8 - mat(k,1187) = 0._r8 + mat(k,1191) = 0._r8 mat(k,1194) = 0._r8 - mat(k,1195) = 0._r8 + mat(k,1197) = 0._r8 mat(k,1198) = 0._r8 - mat(k,1200) = 0._r8 mat(k,1201) = 0._r8 - mat(k,1204) = 0._r8 - mat(k,1209) = 0._r8 - mat(k,1213) = 0._r8 - mat(k,1216) = 0._r8 - mat(k,1217) = 0._r8 + mat(k,1203) = 0._r8 + mat(k,1205) = 0._r8 + mat(k,1219) = 0._r8 mat(k,1220) = 0._r8 - mat(k,1221) = 0._r8 - mat(k,1223) = 0._r8 - mat(k,1224) = 0._r8 - mat(k,1225) = 0._r8 mat(k,1226) = 0._r8 mat(k,1228) = 0._r8 - mat(k,1229) = 0._r8 + mat(k,1230) = 0._r8 mat(k,1231) = 0._r8 - mat(k,1233) = 0._r8 + mat(k,1232) = 0._r8 mat(k,1234) = 0._r8 - mat(k,1237) = 0._r8 + mat(k,1235) = 0._r8 + mat(k,1236) = 0._r8 + mat(k,1238) = 0._r8 mat(k,1242) = 0._r8 mat(k,1243) = 0._r8 - mat(k,1247) = 0._r8 - mat(k,1248) = 0._r8 - mat(k,1251) = 0._r8 - mat(k,1252) = 0._r8 - mat(k,1261) = 0._r8 + mat(k,1255) = 0._r8 + mat(k,1265) = 0._r8 mat(k,1281) = 0._r8 - mat(k,1282) = 0._r8 - mat(k,1288) = 0._r8 + mat(k,1284) = 0._r8 + mat(k,1289) = 0._r8 + mat(k,1290) = 0._r8 mat(k,1291) = 0._r8 + mat(k,1292) = 0._r8 + mat(k,1293) = 0._r8 mat(k,1295) = 0._r8 mat(k,1297) = 0._r8 - mat(k,1298) = 0._r8 - mat(k,1302) = 0._r8 - mat(k,1303) = 0._r8 + mat(k,1299) = 0._r8 + mat(k,1301) = 0._r8 + mat(k,1305) = 0._r8 mat(k,1306) = 0._r8 - mat(k,1308) = 0._r8 - mat(k,1309) = 0._r8 mat(k,1310) = 0._r8 - mat(k,1314) = 0._r8 + mat(k,1311) = 0._r8 mat(k,1315) = 0._r8 - mat(k,1316) = 0._r8 + mat(k,1318) = 0._r8 mat(k,1319) = 0._r8 mat(k,1321) = 0._r8 - mat(k,1323) = 0._r8 + mat(k,1324) = 0._r8 mat(k,1325) = 0._r8 mat(k,1326) = 0._r8 - mat(k,1327) = 0._r8 + mat(k,1329) = 0._r8 mat(k,1330) = 0._r8 - mat(k,1365) = 0._r8 + mat(k,1331) = 0._r8 + mat(k,1333) = 0._r8 + mat(k,1337) = 0._r8 + mat(k,1338) = 0._r8 + mat(k,1342) = 0._r8 + mat(k,1343) = 0._r8 + mat(k,1352) = 0._r8 + mat(k,1354) = 0._r8 + mat(k,1358) = 0._r8 + mat(k,1359) = 0._r8 + mat(k,1363) = 0._r8 + mat(k,1369) = 0._r8 + mat(k,1373) = 0._r8 + mat(k,1375) = 0._r8 + mat(k,1376) = 0._r8 + mat(k,1377) = 0._r8 + mat(k,1379) = 0._r8 + mat(k,1381) = 0._r8 + mat(k,1383) = 0._r8 + mat(k,1386) = 0._r8 + mat(k,1391) = 0._r8 + mat(k,1392) = 0._r8 mat(k,1393) = 0._r8 - mat(k,1394) = 0._r8 mat(k,1396) = 0._r8 - mat(k,1398) = 0._r8 - mat(k,1409) = 0._r8 - mat(k,1415) = 0._r8 - mat(k,1419) = 0._r8 - mat(k,1422) = 0._r8 - mat(k,1423) = 0._r8 - mat(k,1424) = 0._r8 - mat(k,1425) = 0._r8 - mat(k,1426) = 0._r8 + mat(k,1401) = 0._r8 + mat(k,1406) = 0._r8 mat(k,1427) = 0._r8 + mat(k,1428) = 0._r8 + mat(k,1433) = 0._r8 mat(k,1435) = 0._r8 - mat(k,1452) = 0._r8 - mat(k,1453) = 0._r8 + mat(k,1438) = 0._r8 + mat(k,1442) = 0._r8 + mat(k,1443) = 0._r8 + mat(k,1445) = 0._r8 + mat(k,1450) = 0._r8 + mat(k,1456) = 0._r8 + mat(k,1457) = 0._r8 + mat(k,1458) = 0._r8 + mat(k,1459) = 0._r8 mat(k,1464) = 0._r8 - mat(k,1482) = 0._r8 + mat(k,1471) = 0._r8 + mat(k,1479) = 0._r8 + mat(k,1485) = 0._r8 mat(k,1486) = 0._r8 - mat(k,1487) = 0._r8 mat(k,1488) = 0._r8 mat(k,1489) = 0._r8 mat(k,1491) = 0._r8 - mat(k,1500) = 0._r8 - mat(k,1503) = 0._r8 - mat(k,1509) = 0._r8 - mat(k,1514) = 0._r8 - mat(k,1533) = 0._r8 - mat(k,1541) = 0._r8 - mat(k,1542) = 0._r8 - mat(k,1615) = 0._r8 - mat(k,1635) = 0._r8 - mat(k,1644) = 0._r8 - mat(k,1647) = 0._r8 - mat(k,1649) = 0._r8 + mat(k,1493) = 0._r8 + mat(k,1494) = 0._r8 + mat(k,1495) = 0._r8 + mat(k,1497) = 0._r8 + mat(k,1498) = 0._r8 + mat(k,1501) = 0._r8 + mat(k,1502) = 0._r8 + mat(k,1504) = 0._r8 + mat(k,1505) = 0._r8 + mat(k,1506) = 0._r8 + mat(k,1508) = 0._r8 + mat(k,1510) = 0._r8 + mat(k,1511) = 0._r8 + mat(k,1513) = 0._r8 + mat(k,1572) = 0._r8 + mat(k,1601) = 0._r8 + mat(k,1602) = 0._r8 + mat(k,1603) = 0._r8 + mat(k,1607) = 0._r8 + mat(k,1610) = 0._r8 + mat(k,1618) = 0._r8 + mat(k,1629) = 0._r8 + mat(k,1653) = 0._r8 + mat(k,1654) = 0._r8 + mat(k,1655) = 0._r8 mat(k,1659) = 0._r8 + mat(k,1660) = 0._r8 + mat(k,1662) = 0._r8 + mat(k,1663) = 0._r8 + mat(k,1665) = 0._r8 + mat(k,1666) = 0._r8 + mat(k,1669) = 0._r8 + mat(k,1670) = 0._r8 mat(k,1681) = 0._r8 + mat(k,1684) = 0._r8 + mat(k,1685) = 0._r8 + mat(k,1689) = 0._r8 + mat(k,1690) = 0._r8 + mat(k,1691) = 0._r8 + mat(k,1692) = 0._r8 + mat(k,1696) = 0._r8 mat(k,1697) = 0._r8 - mat(k,1710) = 0._r8 - mat(k,1717) = 0._r8 - mat(k,1720) = 0._r8 - mat(k,1723) = 0._r8 - mat(k,1725) = 0._r8 - mat(k,1726) = 0._r8 - mat(k,1727) = 0._r8 - mat(k,1728) = 0._r8 - mat(k,1741) = 0._r8 - mat(k,1744) = 0._r8 - mat(k,1747) = 0._r8 - mat(k,1749) = 0._r8 + mat(k,1699) = 0._r8 + mat(k,1701) = 0._r8 + mat(k,1703) = 0._r8 + mat(k,1706) = 0._r8 + mat(k,1708) = 0._r8 + mat(k,1712) = 0._r8 + mat(k,1714) = 0._r8 + mat(k,1739) = 0._r8 + mat(k,1743) = 0._r8 mat(k,1750) = 0._r8 - mat(k,1751) = 0._r8 - mat(k,1755) = 0._r8 - mat(k,1757) = 0._r8 - mat(k,1759) = 0._r8 - mat(k,1761) = 0._r8 - mat(k,1763) = 0._r8 - mat(k,1766) = 0._r8 - mat(k,1771) = 0._r8 - mat(k,1772) = 0._r8 - mat(k,1779) = 0._r8 - mat(k,1786) = 0._r8 - mat(k,1792) = 0._r8 - mat(k,1793) = 0._r8 - mat(k,1796) = 0._r8 - mat(k,1799) = 0._r8 - mat(k,1805) = 0._r8 - mat(k,1812) = 0._r8 - mat(k,1814) = 0._r8 - mat(k,1816) = 0._r8 - mat(k,1818) = 0._r8 - mat(k,1823) = 0._r8 - mat(k,1824) = 0._r8 - mat(k,1825) = 0._r8 - mat(k,1826) = 0._r8 - mat(k,1828) = 0._r8 mat(k,1829) = 0._r8 - mat(k,1839) = 0._r8 - mat(k,1863) = 0._r8 + mat(k,1850) = 0._r8 + mat(k,1861) = 0._r8 mat(k,1864) = 0._r8 - mat(k,1866) = 0._r8 - mat(k,1868) = 0._r8 - mat(k,1869) = 0._r8 - mat(k,1872) = 0._r8 - mat(k,1874) = 0._r8 mat(k,1875) = 0._r8 - mat(k,1877) = 0._r8 - mat(k,1879) = 0._r8 - mat(k,1892) = 0._r8 - mat(k,1896) = 0._r8 - mat(k,1899) = 0._r8 - mat(k,1903) = 0._r8 - mat(k,1906) = 0._r8 - mat(k,1907) = 0._r8 - mat(k,1908) = 0._r8 - mat(k,1909) = 0._r8 - mat(k,1912) = 0._r8 + mat(k,1876) = 0._r8 + mat(k,1898) = 0._r8 mat(k,1916) = 0._r8 - mat(k,1918) = 0._r8 - mat(k,1919) = 0._r8 - mat(k,1920) = 0._r8 - mat(k,1923) = 0._r8 - mat(k,1926) = 0._r8 - mat(k,1939) = 0._r8 - mat(k,1947) = 0._r8 + mat(k,1937) = 0._r8 + mat(k,1938) = 0._r8 + mat(k,1942) = 0._r8 mat(k,1948) = 0._r8 - mat(k,1950) = 0._r8 mat(k,1952) = 0._r8 - mat(k,1954) = 0._r8 - mat(k,1956) = 0._r8 - mat(k,1957) = 0._r8 - mat(k,1958) = 0._r8 + mat(k,1953) = 0._r8 + mat(k,1959) = 0._r8 + mat(k,1962) = 0._r8 mat(k,1963) = 0._r8 - mat(k,1973) = 0._r8 + mat(k,1969) = 0._r8 + mat(k,1970) = 0._r8 + mat(k,1971) = 0._r8 + mat(k,1972) = 0._r8 mat(k,1974) = 0._r8 - mat(k,1978) = 0._r8 - mat(k,1982) = 0._r8 - mat(k,1984) = 0._r8 + mat(k,1977) = 0._r8 + mat(k,1983) = 0._r8 mat(k,1989) = 0._r8 - mat(k,1991) = 0._r8 - mat(k,1997) = 0._r8 - mat(k,2003) = 0._r8 - mat(k,2008) = 0._r8 + mat(k,1990) = 0._r8 + mat(k,1993) = 0._r8 + mat(k,1995) = 0._r8 + mat(k,2006) = 0._r8 + mat(k,2009) = 0._r8 mat(k,2013) = 0._r8 + mat(k,2016) = 0._r8 + mat(k,2017) = 0._r8 + mat(k,2018) = 0._r8 mat(k,2019) = 0._r8 - mat(k,2025) = 0._r8 + mat(k,2021) = 0._r8 mat(k,2026) = 0._r8 mat(k,2029) = 0._r8 - mat(k,2031) = 0._r8 - mat(k,2033) = 0._r8 - mat(k,2035) = 0._r8 mat(k,2037) = 0._r8 - mat(k,2039) = 0._r8 - mat(k,2042) = 0._r8 - mat(k,2045) = 0._r8 - mat(k,2049) = 0._r8 - mat(k,2051) = 0._r8 - mat(k,2053) = 0._r8 - mat(k,2058) = 0._r8 - mat(k,2060) = 0._r8 - mat(k,2061) = 0._r8 + mat(k,2044) = 0._r8 + mat(k,2050) = 0._r8 + mat(k,2055) = 0._r8 + mat(k,2057) = 0._r8 mat(k,2062) = 0._r8 - mat(k,2064) = 0._r8 - mat(k,2065) = 0._r8 - mat(k,2066) = 0._r8 mat(k,2069) = 0._r8 mat(k,2070) = 0._r8 - mat(k,2071) = 0._r8 mat(k,2072) = 0._r8 - mat(k,2073) = 0._r8 mat(k,2074) = 0._r8 - mat(k,2075) = 0._r8 - mat(k,2077) = 0._r8 + mat(k,2076) = 0._r8 + mat(k,2078) = 0._r8 + mat(k,2079) = 0._r8 + mat(k,2083) = 0._r8 + mat(k,2085) = 0._r8 + mat(k,2086) = 0._r8 + mat(k,2087) = 0._r8 + mat(k,2095) = 0._r8 + mat(k,2096) = 0._r8 + mat(k,2098) = 0._r8 + mat(k,2100) = 0._r8 + mat(k,2103) = 0._r8 + mat(k,2105) = 0._r8 + mat(k,2106) = 0._r8 + mat(k,2110) = 0._r8 + mat(k,2111) = 0._r8 + mat(k,2138) = 0._r8 + mat(k,2155) = 0._r8 + mat(k,2156) = 0._r8 + mat(k,2165) = 0._r8 + mat(k,2185) = 0._r8 + mat(k,2189) = 0._r8 + mat(k,2192) = 0._r8 + mat(k,2194) = 0._r8 + mat(k,2197) = 0._r8 + mat(k,2200) = 0._r8 + mat(k,2203) = 0._r8 + mat(k,2208) = 0._r8 + mat(k,2213) = 0._r8 + mat(k,2214) = 0._r8 + mat(k,2219) = 0._r8 + mat(k,2240) = 0._r8 + mat(k,2244) = 0._r8 + mat(k,2245) = 0._r8 + mat(k,2246) = 0._r8 + mat(k,2248) = 0._r8 + mat(k,2249) = 0._r8 + mat(k,2253) = 0._r8 + mat(k,2255) = 0._r8 + mat(k,2257) = 0._r8 + mat(k,2258) = 0._r8 + mat(k,2262) = 0._r8 + mat(k,2265) = 0._r8 + mat(k,2269) = 0._r8 + mat(k,2282) = 0._r8 + mat(k,2286) = 0._r8 + mat(k,2288) = 0._r8 + mat(k,2294) = 0._r8 + mat(k,2298) = 0._r8 + mat(k,2299) = 0._r8 + mat(k,2301) = 0._r8 + mat(k,2302) = 0._r8 + mat(k,2306) = 0._r8 + mat(k,2307) = 0._r8 + mat(k,2308) = 0._r8 + mat(k,2310) = 0._r8 + mat(k,2314) = 0._r8 + mat(k,2322) = 0._r8 + mat(k,2330) = 0._r8 + mat(k,2334) = 0._r8 + mat(k,2336) = 0._r8 + mat(k,2338) = 0._r8 + mat(k,2339) = 0._r8 + mat(k,2340) = 0._r8 + mat(k,2342) = 0._r8 + mat(k,2343) = 0._r8 + mat(k,2344) = 0._r8 + mat(k,2347) = 0._r8 + mat(k,2348) = 0._r8 + mat(k,2350) = 0._r8 + mat(k,2351) = 0._r8 + mat(k,2352) = 0._r8 + mat(k,2353) = 0._r8 + mat(k,2354) = 0._r8 + mat(k,2355) = 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) @@ -3151,176 +3570,210 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 53) = mat(k, 53) - dti(k) mat(k, 54) = mat(k, 54) - dti(k) mat(k, 55) = mat(k, 55) - dti(k) + mat(k, 56) = mat(k, 56) - dti(k) + mat(k, 57) = mat(k, 57) - dti(k) + mat(k, 58) = mat(k, 58) - dti(k) + mat(k, 59) = mat(k, 59) - dti(k) + mat(k, 60) = mat(k, 60) - dti(k) mat(k, 61) = mat(k, 61) - dti(k) - mat(k, 62) = mat(k, 62) - dti(k) - mat(k, 63) = mat(k, 63) - dti(k) - mat(k, 64) = mat(k, 64) - dti(k) - mat(k, 65) = mat(k, 65) - dti(k) - mat(k, 66) = mat(k, 66) - dti(k) mat(k, 67) = mat(k, 67) - dti(k) - mat(k, 68) = mat(k, 68) - dti(k) mat(k, 69) = mat(k, 69) - dti(k) mat(k, 70) = mat(k, 70) - dti(k) mat(k, 71) = mat(k, 71) - dti(k) - mat(k, 77) = mat(k, 77) - dti(k) - mat(k, 83) = mat(k, 83) - dti(k) - mat(k, 89) = mat(k, 89) - dti(k) - mat(k, 90) = mat(k, 90) - dti(k) + mat(k, 72) = mat(k, 72) - dti(k) + mat(k, 73) = mat(k, 73) - dti(k) + mat(k, 74) = mat(k, 74) - dti(k) + mat(k, 80) = mat(k, 80) - dti(k) + mat(k, 86) = mat(k, 86) - dti(k) + mat(k, 92) = mat(k, 92) - dti(k) mat(k, 93) = mat(k, 93) - dti(k) + mat(k, 94) = mat(k, 94) - dti(k) + mat(k, 95) = mat(k, 95) - dti(k) mat(k, 96) = mat(k, 96) - dti(k) - mat(k, 99) = mat(k, 99) - dti(k) + mat(k, 97) = mat(k, 97) - dti(k) mat(k, 103) = mat(k, 103) - dti(k) - mat(k, 106) = mat(k, 106) - dti(k) - mat(k, 109) = mat(k, 109) - dti(k) - mat(k, 112) = mat(k, 112) - dti(k) - mat(k, 115) = mat(k, 115) - dti(k) + mat(k, 105) = mat(k, 105) - dti(k) + mat(k, 111) = mat(k, 111) - dti(k) + mat(k, 117) = mat(k, 117) - dti(k) mat(k, 123) = mat(k, 123) - dti(k) mat(k, 129) = mat(k, 129) - dti(k) - mat(k, 133) = mat(k, 133) - dti(k) - mat(k, 138) = mat(k, 138) - dti(k) - mat(k, 140) = mat(k, 140) - dti(k) - mat(k, 144) = mat(k, 144) - dti(k) - mat(k, 153) = mat(k, 153) - dti(k) + mat(k, 135) = mat(k, 135) - dti(k) + mat(k, 136) = mat(k, 136) - dti(k) + mat(k, 139) = mat(k, 139) - dti(k) + mat(k, 142) = mat(k, 142) - dti(k) + mat(k, 145) = mat(k, 145) - dti(k) + mat(k, 148) = mat(k, 148) - dti(k) + mat(k, 152) = mat(k, 152) - dti(k) + mat(k, 156) = mat(k, 156) - dti(k) mat(k, 160) = mat(k, 160) - dti(k) - mat(k, 165) = mat(k, 165) - dti(k) - mat(k, 169) = mat(k, 169) - dti(k) + mat(k, 164) = mat(k, 164) - dti(k) + mat(k, 168) = mat(k, 168) - dti(k) + mat(k, 172) = mat(k, 172) - dti(k) + mat(k, 175) = mat(k, 175) - dti(k) mat(k, 178) = mat(k, 178) - dti(k) - mat(k, 186) = mat(k, 186) - dti(k) - mat(k, 191) = mat(k, 191) - dti(k) - mat(k, 194) = mat(k, 194) - dti(k) - mat(k, 197) = mat(k, 197) - dti(k) - mat(k, 200) = mat(k, 200) - dti(k) - mat(k, 203) = mat(k, 203) - dti(k) - mat(k, 208) = mat(k, 208) - dti(k) - mat(k, 212) = mat(k, 212) - dti(k) - mat(k, 216) = mat(k, 216) - dti(k) - mat(k, 220) = mat(k, 220) - dti(k) - mat(k, 224) = mat(k, 224) - dti(k) - mat(k, 228) = mat(k, 228) - dti(k) - mat(k, 231) = mat(k, 231) - dti(k) + mat(k, 183) = mat(k, 183) - dti(k) + mat(k, 188) = mat(k, 188) - dti(k) + mat(k, 193) = mat(k, 193) - dti(k) + mat(k, 198) = mat(k, 198) - dti(k) + mat(k, 201) = mat(k, 201) - dti(k) + mat(k, 204) = mat(k, 204) - dti(k) + mat(k, 207) = mat(k, 207) - dti(k) + mat(k, 213) = mat(k, 213) - dti(k) + mat(k, 217) = mat(k, 217) - dti(k) + mat(k, 222) = mat(k, 222) - dti(k) + mat(k, 225) = mat(k, 225) - dti(k) + mat(k, 230) = mat(k, 230) - dti(k) mat(k, 237) = mat(k, 237) - dti(k) - mat(k, 243) = mat(k, 243) - dti(k) - mat(k, 249) = mat(k, 249) - dti(k) - mat(k, 255) = mat(k, 255) - dti(k) - mat(k, 260) = mat(k, 260) - dti(k) - mat(k, 265) = mat(k, 265) - dti(k) - mat(k, 271) = mat(k, 271) - dti(k) + mat(k, 242) = mat(k, 242) - dti(k) + mat(k, 246) = mat(k, 246) - dti(k) + mat(k, 251) = mat(k, 251) - dti(k) + mat(k, 259) = mat(k, 259) - dti(k) + mat(k, 264) = mat(k, 264) - dti(k) + mat(k, 269) = mat(k, 269) - dti(k) + mat(k, 273) = mat(k, 273) - dti(k) mat(k, 276) = mat(k, 276) - dti(k) - mat(k, 281) = mat(k, 281) - dti(k) - mat(k, 284) = mat(k, 284) - dti(k) - mat(k, 289) = mat(k, 289) - dti(k) - mat(k, 294) = mat(k, 294) - dti(k) - mat(k, 302) = mat(k, 302) - dti(k) - mat(k, 310) = mat(k, 310) - dti(k) - mat(k, 316) = mat(k, 316) - dti(k) - mat(k, 322) = mat(k, 322) - dti(k) - mat(k, 328) = mat(k, 328) - dti(k) - mat(k, 334) = mat(k, 334) - dti(k) + mat(k, 279) = mat(k, 279) - dti(k) + mat(k, 282) = mat(k, 282) - dti(k) + mat(k, 285) = mat(k, 285) - dti(k) + mat(k, 290) = mat(k, 290) - dti(k) + mat(k, 293) = mat(k, 293) - dti(k) + mat(k, 299) = mat(k, 299) - dti(k) + mat(k, 303) = mat(k, 303) - dti(k) + mat(k, 307) = mat(k, 307) - dti(k) + mat(k, 311) = mat(k, 311) - dti(k) + mat(k, 315) = mat(k, 315) - dti(k) + mat(k, 318) = mat(k, 318) - dti(k) + mat(k, 324) = mat(k, 324) - dti(k) + mat(k, 330) = mat(k, 330) - dti(k) + mat(k, 336) = mat(k, 336) - dti(k) mat(k, 340) = mat(k, 340) - dti(k) mat(k, 346) = mat(k, 346) - dti(k) mat(k, 352) = mat(k, 352) - dti(k) - mat(k, 358) = mat(k, 358) - dti(k) - mat(k, 364) = mat(k, 364) - dti(k) - mat(k, 370) = mat(k, 370) - dti(k) + mat(k, 357) = mat(k, 357) - dti(k) + mat(k, 362) = mat(k, 362) - dti(k) + mat(k, 367) = mat(k, 367) - dti(k) + mat(k, 373) = mat(k, 373) - dti(k) mat(k, 378) = mat(k, 378) - dti(k) - mat(k, 384) = mat(k, 384) - dti(k) + mat(k, 383) = mat(k, 383) - dti(k) + mat(k, 386) = mat(k, 386) - dti(k) mat(k, 391) = mat(k, 391) - dti(k) - mat(k, 397) = mat(k, 397) - dti(k) - mat(k, 400) = mat(k, 400) - dti(k) - mat(k, 404) = mat(k, 404) - dti(k) - mat(k, 411) = mat(k, 411) - dti(k) - mat(k, 420) = mat(k, 420) - dti(k) - mat(k, 428) = mat(k, 428) - dti(k) - mat(k, 435) = mat(k, 435) - dti(k) - mat(k, 441) = mat(k, 441) - dti(k) - mat(k, 447) = mat(k, 447) - dti(k) - mat(k, 453) = mat(k, 453) - dti(k) - mat(k, 459) = mat(k, 459) - dti(k) - mat(k, 467) = mat(k, 467) - dti(k) - mat(k, 471) = mat(k, 471) - dti(k) - mat(k, 479) = mat(k, 479) - dti(k) - mat(k, 487) = mat(k, 487) - dti(k) - mat(k, 495) = mat(k, 495) - dti(k) - mat(k, 503) = mat(k, 503) - dti(k) - mat(k, 511) = mat(k, 511) - dti(k) - mat(k, 520) = mat(k, 520) - dti(k) - mat(k, 527) = mat(k, 527) - dti(k) - mat(k, 538) = mat(k, 538) - dti(k) - mat(k, 547) = mat(k, 547) - dti(k) - mat(k, 551) = mat(k, 551) - dti(k) - mat(k, 559) = mat(k, 559) - dti(k) + mat(k, 399) = mat(k, 399) - dti(k) + mat(k, 407) = mat(k, 407) - dti(k) + mat(k, 415) = mat(k, 415) - dti(k) + mat(k, 421) = mat(k, 421) - dti(k) + mat(k, 427) = mat(k, 427) - dti(k) + mat(k, 433) = mat(k, 433) - dti(k) + mat(k, 439) = mat(k, 439) - dti(k) + mat(k, 445) = mat(k, 445) - dti(k) + mat(k, 451) = mat(k, 451) - dti(k) + mat(k, 457) = mat(k, 457) - dti(k) + mat(k, 463) = mat(k, 463) - dti(k) + mat(k, 469) = mat(k, 469) - dti(k) + mat(k, 477) = mat(k, 477) - dti(k) + mat(k, 483) = mat(k, 483) - dti(k) + mat(k, 489) = mat(k, 489) - dti(k) + mat(k, 496) = mat(k, 496) - dti(k) + mat(k, 502) = mat(k, 502) - dti(k) + mat(k, 506) = mat(k, 506) - dti(k) + mat(k, 513) = mat(k, 513) - dti(k) + mat(k, 517) = mat(k, 517) - dti(k) + mat(k, 524) = mat(k, 524) - dti(k) + mat(k, 533) = mat(k, 533) - dti(k) + mat(k, 541) = mat(k, 541) - dti(k) + mat(k, 548) = mat(k, 548) - dti(k) + mat(k, 554) = mat(k, 554) - dti(k) + mat(k, 560) = mat(k, 560) - dti(k) mat(k, 566) = mat(k, 566) - dti(k) - mat(k, 577) = mat(k, 577) - dti(k) - mat(k, 588) = mat(k, 588) - dti(k) - mat(k, 596) = mat(k, 596) - dti(k) - mat(k, 607) = mat(k, 607) - dti(k) - mat(k, 620) = mat(k, 620) - dti(k) - mat(k, 627) = mat(k, 627) - dti(k) - mat(k, 638) = mat(k, 638) - dti(k) - mat(k, 654) = mat(k, 654) - dti(k) - mat(k, 665) = mat(k, 665) - dti(k) - mat(k, 674) = mat(k, 674) - dti(k) - mat(k, 684) = mat(k, 684) - dti(k) - mat(k, 693) = mat(k, 693) - dti(k) - mat(k, 701) = mat(k, 701) - dti(k) - mat(k, 705) = mat(k, 705) - dti(k) - mat(k, 710) = mat(k, 710) - dti(k) - mat(k, 720) = mat(k, 720) - dti(k) - mat(k, 729) = mat(k, 729) - dti(k) - mat(k, 739) = mat(k, 739) - dti(k) - mat(k, 747) = mat(k, 747) - dti(k) + mat(k, 574) = mat(k, 574) - dti(k) + mat(k, 582) = mat(k, 582) - dti(k) + mat(k, 590) = mat(k, 590) - dti(k) + mat(k, 598) = mat(k, 598) - dti(k) + mat(k, 606) = mat(k, 606) - dti(k) + mat(k, 614) = mat(k, 614) - dti(k) + mat(k, 623) = mat(k, 623) - dti(k) + mat(k, 630) = mat(k, 630) - dti(k) + mat(k, 639) = mat(k, 639) - dti(k) + mat(k, 648) = mat(k, 648) - dti(k) + mat(k, 657) = mat(k, 657) - dti(k) + mat(k, 666) = mat(k, 666) - dti(k) + mat(k, 670) = mat(k, 670) - dti(k) + mat(k, 678) = mat(k, 678) - dti(k) + mat(k, 685) = mat(k, 685) - dti(k) + mat(k, 695) = mat(k, 695) - dti(k) + mat(k, 706) = mat(k, 706) - dti(k) + mat(k, 717) = mat(k, 717) - dti(k) + mat(k, 724) = mat(k, 724) - dti(k) + mat(k, 730) = mat(k, 730) - dti(k) + mat(k, 741) = mat(k, 741) - dti(k) mat(k, 754) = mat(k, 754) - dti(k) - mat(k, 766) = mat(k, 766) - dti(k) - mat(k, 782) = mat(k, 782) - dti(k) - mat(k, 792) = mat(k, 792) - dti(k) - mat(k, 805) = mat(k, 805) - dti(k) + mat(k, 761) = mat(k, 761) - dti(k) + mat(k, 772) = mat(k, 772) - dti(k) + mat(k, 788) = mat(k, 788) - dti(k) + mat(k, 799) = mat(k, 799) - dti(k) + mat(k, 808) = mat(k, 808) - dti(k) + mat(k, 818) = mat(k, 818) - dti(k) + mat(k, 826) = mat(k, 826) - dti(k) mat(k, 831) = mat(k, 831) - dti(k) - mat(k, 853) = mat(k, 853) - dti(k) - mat(k, 863) = mat(k, 863) - dti(k) - mat(k, 871) = mat(k, 871) - dti(k) - mat(k, 881) = mat(k, 881) - dti(k) - mat(k, 893) = mat(k, 893) - dti(k) - mat(k, 912) = mat(k, 912) - dti(k) + mat(k, 842) = mat(k, 842) - dti(k) + mat(k, 849) = mat(k, 849) - dti(k) + mat(k, 860) = mat(k, 860) - dti(k) + mat(k, 868) = mat(k, 868) - dti(k) + mat(k, 874) = mat(k, 874) - dti(k) + mat(k, 890) = mat(k, 890) - dti(k) + mat(k, 897) = mat(k, 897) - dti(k) + mat(k, 903) = mat(k, 903) - dti(k) + mat(k, 913) = mat(k, 913) - dti(k) mat(k, 924) = mat(k, 924) - dti(k) - mat(k, 932) = mat(k, 932) - dti(k) - mat(k, 946) = mat(k, 946) - dti(k) - mat(k, 955) = mat(k, 955) - dti(k) - mat(k, 959) = mat(k, 959) - dti(k) - mat(k, 972) = mat(k, 972) - dti(k) - mat(k, 994) = mat(k, 994) - dti(k) - mat(k,1013) = mat(k,1013) - dti(k) - mat(k,1029) = mat(k,1029) - dti(k) - mat(k,1040) = mat(k,1040) - dti(k) - mat(k,1051) = mat(k,1051) - dti(k) - mat(k,1068) = mat(k,1068) - dti(k) - mat(k,1088) = mat(k,1088) - dti(k) - mat(k,1104) = mat(k,1104) - dti(k) - mat(k,1116) = mat(k,1116) - dti(k) - mat(k,1127) = mat(k,1127) - dti(k) - mat(k,1152) = mat(k,1152) - dti(k) - mat(k,1174) = mat(k,1174) - dti(k) - mat(k,1197) = mat(k,1197) - dti(k) - mat(k,1230) = mat(k,1230) - dti(k) + mat(k, 939) = mat(k, 939) - dti(k) + mat(k, 952) = mat(k, 952) - dti(k) + mat(k, 962) = mat(k, 962) - dti(k) + mat(k, 970) = mat(k, 970) - dti(k) + mat(k, 988) = mat(k, 988) - dti(k) + mat(k,1010) = mat(k,1010) - dti(k) + mat(k,1016) = mat(k,1016) - dti(k) + mat(k,1039) = mat(k,1039) - dti(k) + mat(k,1064) = mat(k,1064) - dti(k) + mat(k,1085) = mat(k,1085) - dti(k) + mat(k,1101) = mat(k,1101) - dti(k) + mat(k,1115) = mat(k,1115) - dti(k) + mat(k,1125) = mat(k,1125) - dti(k) + mat(k,1135) = mat(k,1135) - dti(k) + mat(k,1142) = mat(k,1142) - dti(k) + mat(k,1155) = mat(k,1155) - dti(k) + mat(k,1169) = mat(k,1169) - dti(k) + mat(k,1180) = mat(k,1180) - dti(k) + mat(k,1193) = mat(k,1193) - dti(k) + mat(k,1213) = mat(k,1213) - dti(k) + mat(k,1233) = mat(k,1233) - dti(k) mat(k,1249) = mat(k,1249) - dti(k) - mat(k,1280) = mat(k,1280) - dti(k) - mat(k,1294) = mat(k,1294) - dti(k) - mat(k,1307) = mat(k,1307) - dti(k) - mat(k,1320) = mat(k,1320) - dti(k) - mat(k,1395) = mat(k,1395) - dti(k) - mat(k,1418) = mat(k,1418) - dti(k) - mat(k,1513) = mat(k,1513) - dti(k) - mat(k,1538) = mat(k,1538) - dti(k) - mat(k,1698) = mat(k,1698) - dti(k) - mat(k,1722) = mat(k,1722) - dti(k) - mat(k,1764) = mat(k,1764) - dti(k) - mat(k,1822) = mat(k,1822) - dti(k) - mat(k,1873) = mat(k,1873) - dti(k) - mat(k,1934) = mat(k,1934) - dti(k) - mat(k,1959) = mat(k,1959) - dti(k) - mat(k,1986) = mat(k,1986) - dti(k) - mat(k,2017) = mat(k,2017) - dti(k) - mat(k,2052) = mat(k,2052) - dti(k) - mat(k,2078) = mat(k,2078) - dti(k) + mat(k,1261) = mat(k,1261) - dti(k) + mat(k,1272) = mat(k,1272) - dti(k) + mat(k,1296) = mat(k,1296) - dti(k) + mat(k,1328) = mat(k,1328) - dti(k) + mat(k,1351) = mat(k,1351) - dti(k) + mat(k,1372) = mat(k,1372) - dti(k) + mat(k,1394) = mat(k,1394) - dti(k) + mat(k,1426) = mat(k,1426) - dti(k) + mat(k,1441) = mat(k,1441) - dti(k) + mat(k,1455) = mat(k,1455) - dti(k) + mat(k,1470) = mat(k,1470) - dti(k) + mat(k,1487) = mat(k,1487) - dti(k) + mat(k,1503) = mat(k,1503) - dti(k) + mat(k,1604) = mat(k,1604) - dti(k) + mat(k,1657) = mat(k,1657) - dti(k) + mat(k,1702) = mat(k,1702) - dti(k) + mat(k,1744) = mat(k,1744) - dti(k) + mat(k,1917) = mat(k,1917) - dti(k) + mat(k,1944) = mat(k,1944) - dti(k) + mat(k,1967) = mat(k,1967) - dti(k) + mat(k,1999) = mat(k,1999) - dti(k) + mat(k,2024) = mat(k,2024) - dti(k) + mat(k,2082) = mat(k,2082) - dti(k) + mat(k,2107) = mat(k,2107) - dti(k) + mat(k,2227) = mat(k,2227) - dti(k) + mat(k,2267) = mat(k,2267) - dti(k) + mat(k,2329) = mat(k,2329) - dti(k) + mat(k,2356) = mat(k,2356) - dti(k) end do end subroutine nlnmat_finit subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) @@ -3344,6 +3797,7 @@ subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) call nlnmat07( avec_len, mat, y, rxt ) call nlnmat08( avec_len, mat, y, rxt ) call nlnmat09( avec_len, mat, y, rxt ) + call nlnmat10( 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_mam4_vbsext/mo_prod_loss.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_prod_loss.F90 index e64e8dc517..dd245fe36a 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_prod_loss.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_prod_loss.F90 @@ -27,72 +27,10 @@ subroutine exp_prod_loss( ofl, ofu, prod, loss, y, & ! ... loss and production for Explicit method !-------------------------------------------------------------------- do k = ofl,ofu - loss(k,1) = ( + het_rates(k,3))* y(k,3) + loss(k,1) = ( + het_rates(k,225))* y(k,225) prod(k,1) = 0._r8 - loss(k,2) = ( + het_rates(k,21))* y(k,21) + loss(k,2) = ( + het_rates(k,226))* y(k,226) prod(k,2) = 0._r8 - loss(k,3) = (rxt(k,219)* y(k,242) + rxt(k,78) + het_rates(k,33))* y(k,33) - prod(k,3) = 0._r8 - loss(k,4) = (rxt(k,220)* y(k,242) + rxt(k,79) + het_rates(k,34))* y(k,34) - prod(k,4) = 0._r8 - loss(k,5) = (rxt(k,246)* y(k,242) + rxt(k,80) + het_rates(k,35))* y(k,35) - prod(k,5) = 0._r8 - loss(k,6) = (rxt(k,221)* y(k,242) + rxt(k,81) + het_rates(k,36))* y(k,36) - prod(k,6) = 0._r8 - loss(k,7) = (rxt(k,222)* y(k,242) + rxt(k,82) + het_rates(k,37))* y(k,37) - prod(k,7) = 0._r8 - loss(k,8) = (rxt(k,223)* y(k,242) + rxt(k,83) + het_rates(k,38))* y(k,38) - prod(k,8) = 0._r8 - loss(k,9) = (rxt(k,224)* y(k,242) + rxt(k,84) + het_rates(k,39))* y(k,39) - prod(k,9) = 0._r8 - loss(k,10) = (rxt(k,225)* y(k,242) + rxt(k,85) + het_rates(k,40))* y(k,40) - prod(k,10) = 0._r8 - loss(k,11) = (rxt(k,257)* y(k,56) +rxt(k,269)* y(k,242) +rxt(k,258)* y(k,243) & - + rxt(k,86) + het_rates(k,41))* y(k,41) - prod(k,11) = 0._r8 - loss(k,12) = (rxt(k,259)* y(k,56) +rxt(k,270)* y(k,242) +rxt(k,260)* y(k,243) & - + rxt(k,87) + het_rates(k,43))* y(k,43) - prod(k,12) = 0._r8 - loss(k,13) = (rxt(k,261)* y(k,243) + rxt(k,88) + het_rates(k,44))* y(k,44) - prod(k,13) = 0._r8 - loss(k,14) = (rxt(k,262)* y(k,56) +rxt(k,263)* y(k,243) + rxt(k,89) & - + het_rates(k,46))* y(k,46) - prod(k,14) = 0._r8 - loss(k,15) = (rxt(k,195)* y(k,56) +rxt(k,251)* y(k,73) + (rxt(k,291) + & - rxt(k,292) +rxt(k,293))* y(k,242) +rxt(k,284)* y(k,243) + rxt(k,39) & - + rxt(k,40) + het_rates(k,54))* y(k,54) - prod(k,15) = 0._r8 - loss(k,16) = (rxt(k,264)* y(k,56) +rxt(k,247)* y(k,242) +rxt(k,265)* y(k,243) & - + rxt(k,90) + het_rates(k,55))* y(k,55) - prod(k,16) = 0._r8 - loss(k,17) = ( + het_rates(k,61))* y(k,61) - prod(k,17) = 0._r8 - loss(k,18) = ( + rxt(k,41) + het_rates(k,63))* y(k,63) - prod(k,18) =.440_r8*rxt(k,39)*y(k,54) - loss(k,19) = ( + rxt(k,547) + het_rates(k,71))* y(k,71) - prod(k,19) = 0._r8 - loss(k,20) = (rxt(k,248)* y(k,242) + rxt(k,98) + het_rates(k,78))* y(k,78) - prod(k,20) = 0._r8 - loss(k,21) = (rxt(k,271)* y(k,242) +rxt(k,266)* y(k,243) + rxt(k,100) & - + het_rates(k,82))* y(k,82) - prod(k,21) = 0._r8 - loss(k,22) = (rxt(k,272)* y(k,242) +rxt(k,267)* y(k,243) + rxt(k,101) & - + het_rates(k,83))* y(k,83) - prod(k,22) = 0._r8 - loss(k,23) = (rxt(k,273)* y(k,242) +rxt(k,268)* y(k,243) + rxt(k,102) & - + het_rates(k,84))* y(k,84) - prod(k,23) = 0._r8 - loss(k,24) = ((rxt(k,186) +rxt(k,187))* y(k,242) + rxt(k,12) & - + het_rates(k,114))* y(k,114) - prod(k,24) = 0._r8 - loss(k,25) = ( + rxt(k,108) + het_rates(k,150))* y(k,150) - prod(k,25) = 0._r8 - loss(k,26) = ( + het_rates(k,217))* y(k,217) - prod(k,26) = 0._r8 - loss(k,27) = ( + het_rates(k,218))* y(k,218) - prod(k,27) = 0._r8 - loss(k,28) = ( + het_rates(k,134))* y(k,134) - prod(k,28) = 0._r8 end do end subroutine exp_prod_loss subroutine imp_prod_loss( avec_len, prod, loss, y, & @@ -117,1130 +55,1272 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & ! ... loss and production for Implicit method !-------------------------------------------------------------------- do k = 1,avec_len - loss(k,154) = (rxt(k,376)* y(k,243) + rxt(k,19) + het_rates(k,1))* y(k,1) - prod(k,154) =rxt(k,379)*y(k,220)*y(k,123) - loss(k,155) = (rxt(k,380)* y(k,243) + rxt(k,20) + het_rates(k,2))* y(k,2) - prod(k,155) =rxt(k,377)*y(k,232)*y(k,220) - loss(k,1) = ( + het_rates(k,4))* y(k,4) + loss(k,184) = (rxt(k,375)* y(k,251) + rxt(k,19) + het_rates(k,1))* y(k,1) + prod(k,184) =rxt(k,378)*y(k,228)*y(k,129) + loss(k,186) = (rxt(k,379)* y(k,251) + rxt(k,20) + het_rates(k,2))* y(k,2) + prod(k,186) =rxt(k,376)*y(k,240)*y(k,228) + loss(k,1) = ( + het_rates(k,3))* y(k,3) prod(k,1) = 0._r8 - loss(k,2) = ( + het_rates(k,5))* y(k,5) + loss(k,2) = ( + het_rates(k,4))* y(k,4) prod(k,2) = 0._r8 - loss(k,179) = (rxt(k,459)* y(k,125) +rxt(k,460)* y(k,133) +rxt(k,461) & - * y(k,243) + het_rates(k,6))* y(k,6) - prod(k,179) = 0._r8 - loss(k,79) = (rxt(k,418)* y(k,243) + het_rates(k,7))* y(k,7) - prod(k,79) = 0._r8 - loss(k,122) = (rxt(k,421)* y(k,243) + rxt(k,21) + het_rates(k,8))* y(k,8) - prod(k,122) =rxt(k,419)*y(k,232)*y(k,221) - loss(k,80) = ( + rxt(k,22) + het_rates(k,9))* y(k,9) - prod(k,80) =.120_r8*rxt(k,418)*y(k,243)*y(k,7) - loss(k,120) = ( + rxt(k,23) + het_rates(k,10))* y(k,10) - prod(k,120) = (.100_r8*rxt(k,460)*y(k,6) +.100_r8*rxt(k,463)*y(k,111)) & - *y(k,133) - loss(k,130) = ( + rxt(k,24) + het_rates(k,11))* y(k,11) - prod(k,130) = (.500_r8*rxt(k,420)*y(k,221) +.200_r8*rxt(k,447)*y(k,249) + & - .060_r8*rxt(k,453)*y(k,251))*y(k,123) +.500_r8*rxt(k,21)*y(k,8) & - +rxt(k,22)*y(k,9) +.200_r8*rxt(k,70)*y(k,210) +.060_r8*rxt(k,72) & - *y(k,214) - loss(k,101) = ( + rxt(k,25) + het_rates(k,12))* y(k,12) - prod(k,101) = (.200_r8*rxt(k,447)*y(k,249) +.200_r8*rxt(k,453)*y(k,251)) & - *y(k,123) +.200_r8*rxt(k,70)*y(k,210) +.200_r8*rxt(k,72)*y(k,214) - loss(k,151) = ( + rxt(k,26) + het_rates(k,13))* y(k,13) - prod(k,151) = (.200_r8*rxt(k,447)*y(k,249) +.150_r8*rxt(k,453)*y(k,251)) & - *y(k,123) +rxt(k,46)*y(k,94) +rxt(k,56)*y(k,117) +.200_r8*rxt(k,70) & - *y(k,210) +.150_r8*rxt(k,72)*y(k,214) - loss(k,106) = ( + rxt(k,27) + het_rates(k,14))* y(k,14) - prod(k,106) =.210_r8*rxt(k,453)*y(k,251)*y(k,123) +.210_r8*rxt(k,72)*y(k,214) - loss(k,92) = (rxt(k,381)* y(k,243) + het_rates(k,15))* y(k,15) - prod(k,92) = (.050_r8*rxt(k,460)*y(k,6) +.050_r8*rxt(k,463)*y(k,111)) & - *y(k,133) - loss(k,114) = (rxt(k,347)* y(k,125) +rxt(k,348)* y(k,243) + het_rates(k,16)) & - * y(k,16) - prod(k,114) = 0._r8 - loss(k,208) = (rxt(k,230)* y(k,42) +rxt(k,232)* y(k,133) +rxt(k,231) & - * y(k,232) + het_rates(k,17))* y(k,17) - prod(k,208) = (rxt(k,75) +2.000_r8*rxt(k,233)*y(k,19) +rxt(k,234)*y(k,59) + & - rxt(k,235)*y(k,59) +rxt(k,238)*y(k,123) +rxt(k,241)*y(k,132) + & - rxt(k,242)*y(k,243) +rxt(k,488)*y(k,151))*y(k,19) & - + (rxt(k,220)*y(k,34) +rxt(k,246)*y(k,35) + & - 3.000_r8*rxt(k,247)*y(k,55) +2.000_r8*rxt(k,248)*y(k,78) + & - 2.000_r8*rxt(k,269)*y(k,41) +rxt(k,270)*y(k,43) +rxt(k,249)*y(k,81)) & - *y(k,242) + (2.000_r8*rxt(k,258)*y(k,41) +rxt(k,260)*y(k,43) + & - 3.000_r8*rxt(k,265)*y(k,55) +rxt(k,244)*y(k,81))*y(k,243) & - + (2.000_r8*rxt(k,257)*y(k,41) +rxt(k,259)*y(k,43) + & - 3.000_r8*rxt(k,264)*y(k,55))*y(k,56) + (rxt(k,99) + & - rxt(k,243)*y(k,132))*y(k,81) +rxt(k,74)*y(k,18) +rxt(k,77)*y(k,20) & - +rxt(k,105)*y(k,91) - loss(k,93) = ( + rxt(k,74) + het_rates(k,18))* y(k,18) - prod(k,93) = (rxt(k,538)*y(k,91) +rxt(k,543)*y(k,91))*y(k,85) & - +rxt(k,236)*y(k,59)*y(k,19) - loss(k,221) = (2._r8*rxt(k,233)* y(k,19) + (rxt(k,234) +rxt(k,235) + & - rxt(k,236))* y(k,59) +rxt(k,238)* y(k,123) +rxt(k,239)* y(k,124) & - +rxt(k,241)* y(k,132) +rxt(k,488)* y(k,151) +rxt(k,237)* y(k,232) & - +rxt(k,242)* y(k,243) + rxt(k,75) + het_rates(k,19))* y(k,19) - prod(k,221) = (rxt(k,76) +rxt(k,240)*y(k,132))*y(k,20) +rxt(k,232)*y(k,133) & - *y(k,17) +rxt(k,250)*y(k,242)*y(k,81) +rxt(k,245)*y(k,132)*y(k,91) - loss(k,146) = (rxt(k,240)* y(k,132) + rxt(k,76) + rxt(k,77) + rxt(k,532) & - + rxt(k,535) + rxt(k,540) + het_rates(k,20))* y(k,20) - prod(k,146) =rxt(k,239)*y(k,124)*y(k,19) - loss(k,94) = (rxt(k,422)* y(k,243) + het_rates(k,22))* y(k,22) - prod(k,94) =rxt(k,28)*y(k,23) +rxt(k,425)*y(k,222)*y(k,123) - loss(k,109) = (rxt(k,424)* y(k,243) + rxt(k,28) + het_rates(k,23))* y(k,23) - prod(k,109) =rxt(k,423)*y(k,232)*y(k,222) - loss(k,103) = (rxt(k,296)* y(k,56) +rxt(k,297)* y(k,243) + het_rates(k,24)) & - * y(k,24) - prod(k,103) = 0._r8 - loss(k,144) = (rxt(k,298)* y(k,56) +rxt(k,299)* y(k,133) +rxt(k,324) & - * y(k,243) + het_rates(k,25))* y(k,25) - prod(k,144) = 0._r8 - loss(k,98) = (rxt(k,304)* y(k,243) + het_rates(k,26))* y(k,26) - prod(k,98) = (.400_r8*rxt(k,300)*y(k,223) +.200_r8*rxt(k,301)*y(k,227)) & - *y(k,223) - loss(k,110) = (rxt(k,305)* y(k,243) + rxt(k,29) + het_rates(k,27))* y(k,27) - prod(k,110) =rxt(k,302)*y(k,232)*y(k,223) - loss(k,104) = (rxt(k,306)* y(k,56) +rxt(k,307)* y(k,243) + het_rates(k,28)) & - * y(k,28) - prod(k,104) = 0._r8 - loss(k,184) = (rxt(k,327)* y(k,125) +rxt(k,328)* y(k,133) +rxt(k,345) & - * y(k,243) + het_rates(k,29))* y(k,29) - prod(k,184) =.130_r8*rxt(k,405)*y(k,133)*y(k,98) +.700_r8*rxt(k,55)*y(k,112) - loss(k,121) = (rxt(k,332)* y(k,243) + rxt(k,30) + het_rates(k,30))* y(k,30) - prod(k,121) =rxt(k,330)*y(k,232)*y(k,224) - loss(k,73) = (rxt(k,333)* y(k,243) + het_rates(k,31))* y(k,31) - prod(k,73) = 0._r8 - loss(k,99) = (rxt(k,428)* y(k,243) + rxt(k,31) + het_rates(k,32))* y(k,32) - prod(k,99) =rxt(k,426)*y(k,232)*y(k,225) - loss(k,216) = (rxt(k,230)* y(k,17) +rxt(k,194)* y(k,56) +rxt(k,275)* y(k,125) & - +rxt(k,276)* y(k,132) +rxt(k,274)* y(k,232) +rxt(k,277)* y(k,243) & - + rxt(k,32) + rxt(k,33) + het_rates(k,42))* y(k,42) - prod(k,216) = (rxt(k,201)*y(k,59) +2.000_r8*rxt(k,278)*y(k,227) + & - rxt(k,279)*y(k,227) +rxt(k,281)*y(k,123) + & - .700_r8*rxt(k,301)*y(k,223) +rxt(k,312)*y(k,226) + & - rxt(k,329)*y(k,224) +.800_r8*rxt(k,341)*y(k,246) + & - .880_r8*rxt(k,353)*y(k,236) +2.000_r8*rxt(k,362)*y(k,238) + & - 1.500_r8*rxt(k,386)*y(k,234) +.750_r8*rxt(k,391)*y(k,235) + & - .800_r8*rxt(k,400)*y(k,101) +.800_r8*rxt(k,411)*y(k,250) + & - .750_r8*rxt(k,465)*y(k,241) +.930_r8*rxt(k,470)*y(k,247) + & - .950_r8*rxt(k,475)*y(k,248))*y(k,227) & - + (.500_r8*rxt(k,318)*y(k,231) +rxt(k,339)*y(k,245) + & - rxt(k,343)*y(k,246) +.500_r8*rxt(k,349)*y(k,229) + & - .250_r8*rxt(k,356)*y(k,236) +rxt(k,365)*y(k,238) + & - .100_r8*rxt(k,378)*y(k,220) +.920_r8*rxt(k,388)*y(k,234) + & - .250_r8*rxt(k,413)*y(k,250) +.340_r8*rxt(k,472)*y(k,247) + & - .320_r8*rxt(k,477)*y(k,248))*y(k,123) + (rxt(k,282)*y(k,52) + & - .300_r8*rxt(k,283)*y(k,53) +.500_r8*rxt(k,316)*y(k,51) + & - .800_r8*rxt(k,321)*y(k,74) +rxt(k,323)*y(k,138) + & - .500_r8*rxt(k,371)*y(k,110) +.400_r8*rxt(k,376)*y(k,1) + & - .300_r8*rxt(k,396)*y(k,99) +.680_r8*rxt(k,481)*y(k,209))*y(k,243) & - + (rxt(k,299)*y(k,25) +.500_r8*rxt(k,328)*y(k,29) + & - .120_r8*rxt(k,358)*y(k,106) +.600_r8*rxt(k,372)*y(k,112) + & - .910_r8*rxt(k,405)*y(k,98) +.340_r8*rxt(k,460)*y(k,6) + & - .340_r8*rxt(k,463)*y(k,111))*y(k,133) + (.500_r8*rxt(k,347)*y(k,16) + & - .250_r8*rxt(k,355)*y(k,236) +rxt(k,366)*y(k,238) + & - rxt(k,389)*y(k,234))*y(k,125) + (.250_r8*rxt(k,352)*y(k,236) + & - rxt(k,361)*y(k,238) +rxt(k,385)*y(k,234) + & - .250_r8*rxt(k,410)*y(k,250))*y(k,226) + (rxt(k,292)*y(k,242) + & - rxt(k,293)*y(k,242))*y(k,54) + (.150_r8*rxt(k,342)*y(k,246) + & - .450_r8*rxt(k,363)*y(k,238))*y(k,232) +.100_r8*rxt(k,19)*y(k,1) & - +.100_r8*rxt(k,20)*y(k,2) +rxt(k,38)*y(k,53) +rxt(k,43)*y(k,74) & - +.330_r8*rxt(k,45)*y(k,93) +rxt(k,47)*y(k,95) +.690_r8*rxt(k,49) & - *y(k,103) +1.340_r8*rxt(k,50)*y(k,106) +rxt(k,57)*y(k,126) +rxt(k,62) & - *y(k,147) +rxt(k,63)*y(k,148) +.375_r8*rxt(k,65)*y(k,205) & - +.400_r8*rxt(k,67)*y(k,207) +.680_r8*rxt(k,69)*y(k,209) & - +2.000_r8*rxt(k,319)*y(k,230) +rxt(k,289)*y(k,233) & - +2.000_r8*rxt(k,364)*y(k,238)*y(k,238) - loss(k,195) = (rxt(k,308)* y(k,125) +rxt(k,309)* y(k,243) + rxt(k,34) & - + het_rates(k,45))* y(k,45) - prod(k,195) = (rxt(k,303)*y(k,223) +.270_r8*rxt(k,331)*y(k,224) + & - rxt(k,339)*y(k,245) +rxt(k,349)*y(k,229) +rxt(k,368)*y(k,240) + & - .400_r8*rxt(k,378)*y(k,220))*y(k,123) + (rxt(k,304)*y(k,26) + & - .500_r8*rxt(k,305)*y(k,27) +.800_r8*rxt(k,376)*y(k,1))*y(k,243) & - + (.500_r8*rxt(k,328)*y(k,29) +.100_r8*rxt(k,372)*y(k,112))*y(k,133) & - + (1.600_r8*rxt(k,300)*y(k,223) +.800_r8*rxt(k,301)*y(k,227)) & - *y(k,223) +.400_r8*rxt(k,19)*y(k,1) +.400_r8*rxt(k,20)*y(k,2) & - +rxt(k,347)*y(k,125)*y(k,16) +rxt(k,29)*y(k,27) +.330_r8*rxt(k,45) & - *y(k,93) +rxt(k,53)*y(k,109) +rxt(k,62)*y(k,147) & - +.200_r8*rxt(k,367)*y(k,240)*y(k,232) - loss(k,71) = (rxt(k,310)* y(k,243) + het_rates(k,47))* y(k,47) - prod(k,71) = 0._r8 - loss(k,181) = (rxt(k,346)* y(k,243) + rxt(k,35) + het_rates(k,48))* y(k,48) - prod(k,181) = (.820_r8*rxt(k,331)*y(k,224) +.500_r8*rxt(k,349)*y(k,229) + & - .250_r8*rxt(k,378)*y(k,220) +.270_r8*rxt(k,472)*y(k,247) + & - .040_r8*rxt(k,477)*y(k,248))*y(k,123) & - + (.820_r8*rxt(k,329)*y(k,224) +.150_r8*rxt(k,470)*y(k,247) + & - .025_r8*rxt(k,475)*y(k,248))*y(k,227) + (.250_r8*rxt(k,19) + & - .800_r8*rxt(k,376)*y(k,243))*y(k,1) + (.520_r8*rxt(k,460)*y(k,6) + & - .520_r8*rxt(k,463)*y(k,111))*y(k,133) + (.500_r8*rxt(k,69) + & - .500_r8*rxt(k,481)*y(k,243))*y(k,209) +.250_r8*rxt(k,20)*y(k,2) & - +.500_r8*rxt(k,347)*y(k,125)*y(k,16) +.820_r8*rxt(k,30)*y(k,30) & - +.170_r8*rxt(k,45)*y(k,93) +.300_r8*rxt(k,65)*y(k,205) & - +.050_r8*rxt(k,67)*y(k,207) - loss(k,200) = (rxt(k,334)* y(k,125) +rxt(k,335)* y(k,243) + rxt(k,36) & - + het_rates(k,49))* y(k,49) - prod(k,200) = (.250_r8*rxt(k,356)*y(k,236) +.050_r8*rxt(k,394)*y(k,235) + & - .250_r8*rxt(k,413)*y(k,250) +.170_r8*rxt(k,431)*y(k,228) + & - .170_r8*rxt(k,437)*y(k,239) +.400_r8*rxt(k,447)*y(k,249) + & - .540_r8*rxt(k,453)*y(k,251) +.510_r8*rxt(k,456)*y(k,252))*y(k,123) & - + (.250_r8*rxt(k,355)*y(k,236) +.050_r8*rxt(k,395)*y(k,235) + & - .250_r8*rxt(k,414)*y(k,250))*y(k,125) & - + (.500_r8*rxt(k,341)*y(k,246) +.240_r8*rxt(k,353)*y(k,236) + & - .100_r8*rxt(k,411)*y(k,250))*y(k,227) & - + (.880_r8*rxt(k,358)*y(k,106) +.500_r8*rxt(k,372)*y(k,112)) & - *y(k,133) + (.250_r8*rxt(k,352)*y(k,236) + & - .250_r8*rxt(k,410)*y(k,250))*y(k,226) & - + (.070_r8*rxt(k,430)*y(k,228) +.070_r8*rxt(k,436)*y(k,239)) & - *y(k,232) + (rxt(k,336)*y(k,95) +rxt(k,337)*y(k,126))*y(k,243) & - +.180_r8*rxt(k,23)*y(k,10) +rxt(k,27)*y(k,14) +.400_r8*rxt(k,70) & - *y(k,210) +.540_r8*rxt(k,72)*y(k,214) +.510_r8*rxt(k,73)*y(k,216) - loss(k,141) = (rxt(k,315)* y(k,243) + het_rates(k,50))* y(k,50) - prod(k,141) = (.100_r8*rxt(k,312)*y(k,227) +.150_r8*rxt(k,313)*y(k,232)) & - *y(k,226) +.120_r8*rxt(k,328)*y(k,133)*y(k,29) & - +.150_r8*rxt(k,363)*y(k,238)*y(k,232) - loss(k,136) = (rxt(k,316)* y(k,243) + rxt(k,37) + het_rates(k,51))* y(k,51) - prod(k,136) = (.400_r8*rxt(k,313)*y(k,226) +.400_r8*rxt(k,363)*y(k,238)) & - *y(k,232) - loss(k,167) = (rxt(k,282)* y(k,243) + het_rates(k,52))* y(k,52) - prod(k,167) = (rxt(k,279)*y(k,227) +.300_r8*rxt(k,301)*y(k,223) + & - .500_r8*rxt(k,341)*y(k,246) +.250_r8*rxt(k,353)*y(k,236) + & - .250_r8*rxt(k,386)*y(k,234) +.250_r8*rxt(k,391)*y(k,235) + & - .200_r8*rxt(k,400)*y(k,101) +.300_r8*rxt(k,411)*y(k,250) + & - .250_r8*rxt(k,465)*y(k,241) +.250_r8*rxt(k,470)*y(k,247) + & - .250_r8*rxt(k,475)*y(k,248))*y(k,227) - loss(k,123) = (rxt(k,283)* y(k,243) + rxt(k,38) + het_rates(k,53))* y(k,53) - prod(k,123) =rxt(k,280)*y(k,232)*y(k,227) - loss(k,224) = (rxt(k,306)* y(k,28) +rxt(k,257)* y(k,41) +rxt(k,194)* y(k,42) & - +rxt(k,259)* y(k,43) +rxt(k,262)* y(k,46) +rxt(k,195)* y(k,54) & - +rxt(k,264)* y(k,55) +rxt(k,207)* y(k,60) +rxt(k,196)* y(k,77) & - +rxt(k,197)* y(k,79) +rxt(k,216)* y(k,92) +rxt(k,200)* y(k,133) & - + (rxt(k,198) +rxt(k,199))* y(k,232) + het_rates(k,56))* y(k,56) - prod(k,224) = (4.000_r8*rxt(k,219)*y(k,33) +rxt(k,220)*y(k,34) + & - 2.000_r8*rxt(k,221)*y(k,36) +2.000_r8*rxt(k,222)*y(k,37) + & - 2.000_r8*rxt(k,223)*y(k,38) +rxt(k,224)*y(k,39) + & - 2.000_r8*rxt(k,225)*y(k,40) +rxt(k,271)*y(k,82) +rxt(k,272)*y(k,83) + & - rxt(k,273)*y(k,84) +rxt(k,226)*y(k,85) +rxt(k,256)*y(k,65))*y(k,242) & - + (rxt(k,93) +rxt(k,201)*y(k,227) +2.000_r8*rxt(k,202)*y(k,59) + & - rxt(k,204)*y(k,59) +rxt(k,206)*y(k,123) +rxt(k,211)*y(k,132) + & - rxt(k,212)*y(k,243) +rxt(k,235)*y(k,19) +rxt(k,489)*y(k,151))*y(k,59) & - + (3.000_r8*rxt(k,261)*y(k,44) +rxt(k,263)*y(k,46) + & - rxt(k,266)*y(k,82) +rxt(k,267)*y(k,83) +rxt(k,268)*y(k,84) + & - rxt(k,215)*y(k,85))*y(k,243) + (rxt(k,103) +rxt(k,214)*y(k,132)) & - *y(k,85) +rxt(k,74)*y(k,18) +2.000_r8*rxt(k,91)*y(k,57) & - +2.000_r8*rxt(k,92)*y(k,58) +rxt(k,95)*y(k,60) +rxt(k,97)*y(k,65) & - +rxt(k,106)*y(k,92) - loss(k,82) = ( + rxt(k,91) + het_rates(k,57))* y(k,57) - prod(k,82) = (rxt(k,531)*y(k,92) +rxt(k,536)*y(k,60) +rxt(k,537)*y(k,92) + & - rxt(k,541)*y(k,60) +rxt(k,542)*y(k,92) +rxt(k,546)*y(k,60))*y(k,85) & - +rxt(k,207)*y(k,60)*y(k,56) +rxt(k,203)*y(k,59)*y(k,59) - loss(k,72) = ( + rxt(k,92) + rxt(k,229) + het_rates(k,58))* y(k,58) - prod(k,72) =rxt(k,228)*y(k,59)*y(k,59) - loss(k,222) = ((rxt(k,234) +rxt(k,235) +rxt(k,236))* y(k,19) & - + 2._r8*(rxt(k,202) +rxt(k,203) +rxt(k,204) +rxt(k,228))* y(k,59) & - +rxt(k,206)* y(k,123) +rxt(k,208)* y(k,124) +rxt(k,211)* y(k,132) & - +rxt(k,489)* y(k,151) +rxt(k,201)* y(k,227) +rxt(k,205)* y(k,232) & - + (rxt(k,212) +rxt(k,213))* y(k,243) + rxt(k,93) + het_rates(k,59)) & - * y(k,59) - prod(k,222) = (rxt(k,199)*y(k,232) +rxt(k,200)*y(k,133) +rxt(k,216)*y(k,92)) & - *y(k,56) + (rxt(k,94) +rxt(k,209)*y(k,132))*y(k,60) & - + (rxt(k,217)*y(k,132) +rxt(k,218)*y(k,243))*y(k,92) + (rxt(k,107) + & - rxt(k,494)*y(k,151))*y(k,135) +2.000_r8*rxt(k,229)*y(k,58) & - +rxt(k,227)*y(k,242)*y(k,85) - loss(k,182) = (rxt(k,207)* y(k,56) + (rxt(k,536) +rxt(k,541) +rxt(k,546)) & - * y(k,85) +rxt(k,209)* y(k,132) +rxt(k,210)* y(k,243) + rxt(k,94) & - + rxt(k,95) + rxt(k,534) + rxt(k,539) + rxt(k,545) & - + het_rates(k,60))* y(k,60) - prod(k,182) =rxt(k,208)*y(k,124)*y(k,59) - loss(k,189) = ((rxt(k,285) +rxt(k,295))* y(k,243) + het_rates(k,62))* y(k,62) - prod(k,189) = (rxt(k,32) +rxt(k,33) +rxt(k,194)*y(k,56) +rxt(k,230)*y(k,17) + & - rxt(k,275)*y(k,125) +rxt(k,276)*y(k,132) +rxt(k,277)*y(k,243)) & - *y(k,42) + (.630_r8*rxt(k,299)*y(k,25) +.560_r8*rxt(k,328)*y(k,29) + & - .650_r8*rxt(k,358)*y(k,106) +.560_r8*rxt(k,372)*y(k,112) + & - .620_r8*rxt(k,405)*y(k,98) +.230_r8*rxt(k,460)*y(k,6) + & - .230_r8*rxt(k,463)*y(k,111))*y(k,133) & - + (.220_r8*rxt(k,356)*y(k,236) +.250_r8*rxt(k,413)*y(k,250) + & - .170_r8*rxt(k,431)*y(k,228) +.400_r8*rxt(k,434)*y(k,237) + & - .350_r8*rxt(k,437)*y(k,239) +.225_r8*rxt(k,472)*y(k,247))*y(k,123) & - + (.350_r8*rxt(k,297)*y(k,24) +rxt(k,322)*y(k,75) + & - rxt(k,335)*y(k,49) +.700_r8*rxt(k,481)*y(k,209) +rxt(k,485)*y(k,136)) & - *y(k,243) + (rxt(k,334)*y(k,49) +.220_r8*rxt(k,355)*y(k,236) + & - .500_r8*rxt(k,414)*y(k,250))*y(k,125) & - + (.110_r8*rxt(k,353)*y(k,236) +.200_r8*rxt(k,411)*y(k,250) + & - .125_r8*rxt(k,470)*y(k,247))*y(k,227) & - + (.070_r8*rxt(k,430)*y(k,228) +.160_r8*rxt(k,433)*y(k,237) + & - .140_r8*rxt(k,436)*y(k,239))*y(k,232) + (rxt(k,110) + & - rxt(k,484)*y(k,132))*y(k,136) + (.220_r8*rxt(k,352)*y(k,236) + & - .250_r8*rxt(k,410)*y(k,250))*y(k,226) +1.500_r8*rxt(k,22)*y(k,9) & - +.450_r8*rxt(k,23)*y(k,10) +.600_r8*rxt(k,26)*y(k,13) +rxt(k,27) & - *y(k,14) +rxt(k,34)*y(k,45) +rxt(k,262)*y(k,56)*y(k,46) +rxt(k,36) & - *y(k,49) +rxt(k,43)*y(k,74) +2.000_r8*rxt(k,44)*y(k,75) & - +.330_r8*rxt(k,45)*y(k,93) +1.340_r8*rxt(k,51)*y(k,106) & - +.700_r8*rxt(k,55)*y(k,112) +1.500_r8*rxt(k,64)*y(k,204) & - +.250_r8*rxt(k,65)*y(k,205) +rxt(k,68)*y(k,208) +1.700_r8*rxt(k,69) & - *y(k,209) - loss(k,76) = (rxt(k,255)* y(k,242) + rxt(k,96) + het_rates(k,64))* y(k,64) - prod(k,76) = (rxt(k,220)*y(k,34) +rxt(k,222)*y(k,37) + & - 2.000_r8*rxt(k,223)*y(k,38) +2.000_r8*rxt(k,224)*y(k,39) + & - rxt(k,225)*y(k,40) +rxt(k,246)*y(k,35) +2.000_r8*rxt(k,248)*y(k,78) + & - rxt(k,272)*y(k,83) +rxt(k,273)*y(k,84))*y(k,242) & - + (rxt(k,267)*y(k,83) +rxt(k,268)*y(k,84))*y(k,243) - loss(k,83) = (rxt(k,256)* y(k,242) + rxt(k,97) + het_rates(k,65))* y(k,65) - prod(k,83) = (rxt(k,221)*y(k,36) +rxt(k,222)*y(k,37) +rxt(k,271)*y(k,82)) & - *y(k,242) +rxt(k,266)*y(k,243)*y(k,82) - loss(k,86) = (rxt(k,429)* y(k,243) + het_rates(k,66))* y(k,66) - prod(k,86) =.180_r8*rxt(k,449)*y(k,243)*y(k,211) - loss(k,105) = (rxt(k,482)* y(k,125) + (rxt(k,483) +rxt(k,496))* y(k,243) & - + het_rates(k,67))* y(k,67) - prod(k,105) = 0._r8 - loss(k,3) = ( + het_rates(k,68))* y(k,68) + loss(k,3) = ( + het_rates(k,5))* y(k,5) prod(k,3) = 0._r8 - loss(k,4) = ( + het_rates(k,69))* y(k,69) + loss(k,214) = (rxt(k,458)* y(k,131) +rxt(k,459)* y(k,139) +rxt(k,460) & + * y(k,251) + het_rates(k,6))* y(k,6) + prod(k,214) = 0._r8 + loss(k,69) = (rxt(k,514)* y(k,129) +rxt(k,513)* y(k,240) + het_rates(k,7)) & + * y(k,7) + prod(k,69) =rxt(k,516)*y(k,251)*y(k,6) + loss(k,103) = (rxt(k,417)* y(k,251) + het_rates(k,8))* y(k,8) + prod(k,103) = 0._r8 + loss(k,79) = (rxt(k,519)* y(k,129) +rxt(k,518)* y(k,240) + het_rates(k,9)) & + * y(k,9) + prod(k,79) =rxt(k,517)*y(k,251)*y(k,8) + loss(k,146) = (rxt(k,420)* y(k,251) + rxt(k,21) + het_rates(k,10))* y(k,10) + prod(k,146) =rxt(k,418)*y(k,240)*y(k,229) + loss(k,104) = ( + rxt(k,22) + het_rates(k,11))* y(k,11) + prod(k,104) =.120_r8*rxt(k,417)*y(k,251)*y(k,8) + loss(k,156) = ( + rxt(k,23) + het_rates(k,12))* y(k,12) + prod(k,156) = (.100_r8*rxt(k,459)*y(k,6) +.100_r8*rxt(k,462)*y(k,116)) & + *y(k,139) + loss(k,159) = ( + rxt(k,24) + het_rates(k,13))* y(k,13) + prod(k,159) = (.500_r8*rxt(k,419)*y(k,229) +.200_r8*rxt(k,446)*y(k,257) + & + .060_r8*rxt(k,452)*y(k,259))*y(k,129) +.500_r8*rxt(k,21)*y(k,10) & + +rxt(k,22)*y(k,11) +.200_r8*rxt(k,70)*y(k,216) +.060_r8*rxt(k,72) & + *y(k,221) + loss(k,127) = ( + rxt(k,25) + het_rates(k,14))* y(k,14) + prod(k,127) = (.200_r8*rxt(k,446)*y(k,257) +.200_r8*rxt(k,452)*y(k,259)) & + *y(k,129) +.200_r8*rxt(k,70)*y(k,216) +.200_r8*rxt(k,72)*y(k,221) + loss(k,181) = ( + rxt(k,26) + het_rates(k,15))* y(k,15) + prod(k,181) = (.200_r8*rxt(k,446)*y(k,257) +.150_r8*rxt(k,452)*y(k,259)) & + *y(k,129) +rxt(k,46)*y(k,96) +rxt(k,56)*y(k,123) +.200_r8*rxt(k,70) & + *y(k,216) +.150_r8*rxt(k,72)*y(k,221) + loss(k,135) = ( + rxt(k,27) + het_rates(k,16))* y(k,16) + prod(k,135) =.210_r8*rxt(k,452)*y(k,259)*y(k,129) +.210_r8*rxt(k,72)*y(k,221) + loss(k,116) = (rxt(k,380)* y(k,251) + het_rates(k,17))* y(k,17) + prod(k,116) = (.050_r8*rxt(k,459)*y(k,6) +.050_r8*rxt(k,462)*y(k,116)) & + *y(k,139) + loss(k,143) = (rxt(k,346)* y(k,131) +rxt(k,347)* y(k,251) + het_rates(k,18)) & + * y(k,18) + prod(k,143) = 0._r8 + loss(k,241) = (rxt(k,230)* y(k,44) +rxt(k,232)* y(k,139) +rxt(k,231) & + * y(k,240) + het_rates(k,19))* y(k,19) + prod(k,241) = (rxt(k,75) +2.000_r8*rxt(k,233)*y(k,21) +rxt(k,234)*y(k,61) + & + rxt(k,235)*y(k,61) +rxt(k,238)*y(k,129) +rxt(k,241)*y(k,138) + & + rxt(k,242)*y(k,251) +rxt(k,488)*y(k,157))*y(k,21) & + + (rxt(k,220)*y(k,36) +rxt(k,246)*y(k,37) + & + 3.000_r8*rxt(k,247)*y(k,57) +2.000_r8*rxt(k,248)*y(k,80) + & + rxt(k,249)*y(k,83) +2.000_r8*rxt(k,269)*y(k,43) +rxt(k,270)*y(k,45)) & + *y(k,250) + (rxt(k,244)*y(k,83) +2.000_r8*rxt(k,258)*y(k,43) + & + rxt(k,260)*y(k,45) +3.000_r8*rxt(k,265)*y(k,57))*y(k,251) & + + (2.000_r8*rxt(k,257)*y(k,43) +rxt(k,259)*y(k,45) + & + 3.000_r8*rxt(k,264)*y(k,57))*y(k,58) + (rxt(k,99) + & + rxt(k,243)*y(k,138))*y(k,83) +rxt(k,74)*y(k,20) +rxt(k,77)*y(k,22) & + +rxt(k,79)*y(k,36) +rxt(k,80)*y(k,37) +2.000_r8*rxt(k,86)*y(k,43) & + +rxt(k,87)*y(k,45) +3.000_r8*rxt(k,90)*y(k,57) +2.000_r8*rxt(k,98) & + *y(k,80) +rxt(k,105)*y(k,93) + loss(k,118) = ( + rxt(k,74) + het_rates(k,20))* y(k,20) + prod(k,118) = (rxt(k,553)*y(k,93) +rxt(k,558)*y(k,93))*y(k,87) & + +rxt(k,236)*y(k,61)*y(k,21) + loss(k,255) = (2._r8*rxt(k,233)* y(k,21) + (rxt(k,234) +rxt(k,235) + & + rxt(k,236))* y(k,61) +rxt(k,238)* y(k,129) +rxt(k,239)* y(k,130) & + +rxt(k,241)* y(k,138) +rxt(k,488)* y(k,157) +rxt(k,237)* y(k,240) & + +rxt(k,242)* y(k,251) + rxt(k,75) + het_rates(k,21))* y(k,21) + prod(k,255) = (rxt(k,76) +rxt(k,240)*y(k,138))*y(k,22) +rxt(k,232)*y(k,139) & + *y(k,19) +rxt(k,250)*y(k,250)*y(k,83) +rxt(k,245)*y(k,138)*y(k,93) + loss(k,170) = (rxt(k,240)* y(k,138) + rxt(k,76) + rxt(k,77) + rxt(k,547) & + + rxt(k,550) + rxt(k,555) + het_rates(k,22))* y(k,22) + prod(k,170) =rxt(k,239)*y(k,130)*y(k,21) + loss(k,4) = ( + het_rates(k,23))* y(k,23) prod(k,4) = 0._r8 - loss(k,5) = ( + het_rates(k,70))* y(k,70) - prod(k,5) = 0._r8 - loss(k,77) = ( + rxt(k,42) + het_rates(k,72))* y(k,72) - prod(k,77) =rxt(k,317)*y(k,232)*y(k,231) - loss(k,166) = (rxt(k,251)* y(k,54) +rxt(k,252)* y(k,77) +rxt(k,254)* y(k,89) & - +rxt(k,253)* y(k,253) + het_rates(k,73))* y(k,73) - prod(k,166) = (rxt(k,224)*y(k,39) +rxt(k,246)*y(k,35) + & - 2.000_r8*rxt(k,255)*y(k,64) +rxt(k,256)*y(k,65))*y(k,242) & - +2.000_r8*rxt(k,96)*y(k,64) +rxt(k,97)*y(k,65) +rxt(k,104)*y(k,88) - loss(k,186) = (rxt(k,321)* y(k,243) + rxt(k,43) + het_rates(k,74))* y(k,74) - prod(k,186) = (.530_r8*rxt(k,356)*y(k,236) +.050_r8*rxt(k,394)*y(k,235) + & - .250_r8*rxt(k,413)*y(k,250) +.225_r8*rxt(k,472)*y(k,247))*y(k,123) & - + (.530_r8*rxt(k,355)*y(k,236) +.050_r8*rxt(k,395)*y(k,235) + & - .250_r8*rxt(k,414)*y(k,250))*y(k,125) & - + (.260_r8*rxt(k,353)*y(k,236) +.100_r8*rxt(k,411)*y(k,250) + & - .125_r8*rxt(k,470)*y(k,247))*y(k,227) + (.700_r8*rxt(k,396)*y(k,99) + & - .500_r8*rxt(k,397)*y(k,100) +rxt(k,408)*y(k,116))*y(k,243) & - + (.530_r8*rxt(k,352)*y(k,236) +.250_r8*rxt(k,410)*y(k,250)) & - *y(k,226) +.330_r8*rxt(k,45)*y(k,93) +.250_r8*rxt(k,65)*y(k,205) & - +rxt(k,320)*y(k,230) - loss(k,177) = (rxt(k,322)* y(k,243) + rxt(k,44) + rxt(k,500) & - + het_rates(k,75))* y(k,75) - prod(k,177) = (.050_r8*rxt(k,394)*y(k,235) +.250_r8*rxt(k,413)*y(k,250) + & - rxt(k,420)*y(k,221) +.400_r8*rxt(k,434)*y(k,237) + & - .170_r8*rxt(k,437)*y(k,239) +.700_r8*rxt(k,440)*y(k,244) + & - .600_r8*rxt(k,447)*y(k,249) +.340_r8*rxt(k,453)*y(k,251) + & - .170_r8*rxt(k,456)*y(k,252))*y(k,123) + (.650_r8*rxt(k,297)*y(k,24) + & - .200_r8*rxt(k,321)*y(k,74) +rxt(k,409)*y(k,117))*y(k,243) & - + (.250_r8*rxt(k,410)*y(k,226) +.100_r8*rxt(k,411)*y(k,227) + & - .250_r8*rxt(k,414)*y(k,125))*y(k,250) & - + (.160_r8*rxt(k,433)*y(k,237) +.070_r8*rxt(k,436)*y(k,239)) & - *y(k,232) +rxt(k,21)*y(k,8) +.130_r8*rxt(k,23)*y(k,10) & - +.050_r8*rxt(k,395)*y(k,235)*y(k,125) +.700_r8*rxt(k,61)*y(k,142) & - +.600_r8*rxt(k,70)*y(k,210) +.340_r8*rxt(k,72)*y(k,214) & - +.170_r8*rxt(k,73)*y(k,216) - loss(k,210) = (rxt(k,160)* y(k,133) + (rxt(k,154) +rxt(k,155) +rxt(k,156)) & - * y(k,232) + rxt(k,157) + het_rates(k,76))* y(k,76) - prod(k,210) = (rxt(k,161)*y(k,77) +rxt(k,164)*y(k,132) +rxt(k,182)*y(k,113) + & - rxt(k,277)*y(k,42) +rxt(k,295)*y(k,62) +rxt(k,485)*y(k,136) + & - rxt(k,490)*y(k,149) +rxt(k,495)*y(k,151))*y(k,243) & - + (rxt(k,144)*y(k,242) +rxt(k,152)*y(k,132) +rxt(k,196)*y(k,56) + & - rxt(k,252)*y(k,73))*y(k,77) + (rxt(k,292)*y(k,54) + & - rxt(k,227)*y(k,85) +rxt(k,250)*y(k,81))*y(k,242) + (rxt(k,2) + & - 2.000_r8*rxt(k,3))*y(k,253) +2.000_r8*rxt(k,32)*y(k,42) +rxt(k,38) & - *y(k,53) +rxt(k,99)*y(k,81) +rxt(k,103)*y(k,85) +rxt(k,104)*y(k,88) - loss(k,196) = (rxt(k,196)* y(k,56) +rxt(k,252)* y(k,73) +rxt(k,152)* y(k,132) & - +rxt(k,144)* y(k,242) +rxt(k,161)* y(k,243) + het_rates(k,77)) & - * y(k,77) - prod(k,196) =rxt(k,33)*y(k,42) +rxt(k,293)*y(k,242)*y(k,54) & - +rxt(k,154)*y(k,232)*y(k,76) +rxt(k,1)*y(k,253) - loss(k,148) = (rxt(k,197)* y(k,56) +rxt(k,153)* y(k,132) +rxt(k,162) & - * y(k,243) + rxt(k,4) + het_rates(k,79))* y(k,79) - prod(k,148) = (.500_r8*rxt(k,501) +rxt(k,168)*y(k,232))*y(k,232) & - +rxt(k,167)*y(k,243)*y(k,243) - loss(k,78) = ( + rxt(k,109) + het_rates(k,80))* y(k,80) - prod(k,78) =rxt(k,498)*y(k,253)*y(k,153) - loss(k,170) = (rxt(k,243)* y(k,132) + (rxt(k,249) +rxt(k,250))* y(k,242) & - +rxt(k,244)* y(k,243) + rxt(k,99) + het_rates(k,81))* y(k,81) - prod(k,170) = (rxt(k,230)*y(k,42) +rxt(k,231)*y(k,232))*y(k,17) - loss(k,212) = ((rxt(k,536) +rxt(k,541) +rxt(k,546))* y(k,60) + (rxt(k,538) + & - rxt(k,543))* y(k,91) + (rxt(k,531) +rxt(k,537) +rxt(k,542))* y(k,92) & - +rxt(k,214)* y(k,132) + (rxt(k,226) +rxt(k,227))* y(k,242) & - +rxt(k,215)* y(k,243) + rxt(k,103) + het_rates(k,85))* y(k,85) - prod(k,212) = (rxt(k,195)*y(k,54) +rxt(k,257)*y(k,41) +rxt(k,259)*y(k,43) + & - 2.000_r8*rxt(k,262)*y(k,46) +rxt(k,264)*y(k,55) +rxt(k,194)*y(k,42) + & - rxt(k,196)*y(k,77) +rxt(k,197)*y(k,79) +rxt(k,198)*y(k,232) + & - rxt(k,216)*y(k,92) +rxt(k,306)*y(k,28))*y(k,56) +rxt(k,213)*y(k,243) & - *y(k,59) - loss(k,84) = (rxt(k,294)* y(k,242) +rxt(k,286)* y(k,243) + het_rates(k,86)) & - * y(k,86) - prod(k,84) = 0._r8 - loss(k,168) = (rxt(k,287)* y(k,243) + het_rates(k,87))* y(k,87) - prod(k,168) = (.370_r8*rxt(k,299)*y(k,25) +.120_r8*rxt(k,328)*y(k,29) + & - .330_r8*rxt(k,358)*y(k,106) +.120_r8*rxt(k,372)*y(k,112) + & - .110_r8*rxt(k,405)*y(k,98) +.050_r8*rxt(k,460)*y(k,6) + & - .050_r8*rxt(k,463)*y(k,111))*y(k,133) + (rxt(k,288)*y(k,232) + & - rxt(k,290)*y(k,123))*y(k,233) +.350_r8*rxt(k,297)*y(k,243)*y(k,24) - loss(k,96) = ( + rxt(k,104) + het_rates(k,88))* y(k,88) - prod(k,96) = (rxt(k,251)*y(k,54) +rxt(k,252)*y(k,77) +rxt(k,253)*y(k,253) + & - rxt(k,254)*y(k,89))*y(k,73) - loss(k,209) = (rxt(k,254)* y(k,73) +rxt(k,191)* y(k,243) + rxt(k,9) & - + het_rates(k,89))* y(k,89) - prod(k,209) = (rxt(k,534) +rxt(k,539) +rxt(k,545) +rxt(k,536)*y(k,85) + & - rxt(k,541)*y(k,85) +rxt(k,546)*y(k,85))*y(k,60) + (rxt(k,510) + & - rxt(k,275)*y(k,42) +rxt(k,308)*y(k,45) +rxt(k,334)*y(k,49) + & - rxt(k,482)*y(k,67))*y(k,125) + (2.000_r8*rxt(k,505) + & - 2.000_r8*rxt(k,530) +2.000_r8*rxt(k,533) +2.000_r8*rxt(k,544)) & - *y(k,115) + (rxt(k,532) +rxt(k,535) +rxt(k,540))*y(k,20) & - + (.500_r8*rxt(k,509) +rxt(k,190)*y(k,243))*y(k,124) +rxt(k,502) & - *y(k,93) +rxt(k,503)*y(k,99) +rxt(k,504)*y(k,100) +rxt(k,506) & - *y(k,116) +rxt(k,507)*y(k,117) +rxt(k,511)*y(k,127) +rxt(k,512) & - *y(k,137) +rxt(k,513)*y(k,206) - loss(k,124) = (rxt(k,169)* y(k,243) + rxt(k,10) + rxt(k,11) + rxt(k,192) & - + het_rates(k,90))* y(k,90) - prod(k,124) =rxt(k,188)*y(k,232)*y(k,124) - loss(k,165) = ((rxt(k,538) +rxt(k,543))* y(k,85) +rxt(k,245)* y(k,132) & - + rxt(k,105) + het_rates(k,91))* y(k,91) - prod(k,165) = (rxt(k,532) +rxt(k,535) +rxt(k,540))*y(k,20) & - +rxt(k,237)*y(k,232)*y(k,19) - loss(k,171) = (rxt(k,216)* y(k,56) + (rxt(k,531) +rxt(k,537) +rxt(k,542)) & - * y(k,85) +rxt(k,217)* y(k,132) +rxt(k,218)* y(k,243) + rxt(k,106) & - + het_rates(k,92))* y(k,92) - prod(k,171) = (rxt(k,534) +rxt(k,539) +rxt(k,545) +rxt(k,210)*y(k,243)) & - *y(k,60) +rxt(k,205)*y(k,232)*y(k,59) - loss(k,187) = (rxt(k,351)* y(k,243) + rxt(k,45) + rxt(k,502) & - + het_rates(k,93))* y(k,93) - prod(k,187) = (rxt(k,350)*y(k,229) +rxt(k,357)*y(k,236))*y(k,123) & - + (.300_r8*rxt(k,396)*y(k,99) +.500_r8*rxt(k,397)*y(k,100))*y(k,243) - loss(k,95) = (rxt(k,382)* y(k,243) + rxt(k,46) + het_rates(k,94))* y(k,94) - prod(k,95) =rxt(k,393)*y(k,235) - loss(k,190) = (rxt(k,336)* y(k,243) + rxt(k,47) + het_rates(k,95))* y(k,95) - prod(k,190) = (.220_r8*rxt(k,352)*y(k,226) +.230_r8*rxt(k,353)*y(k,227) + & - .220_r8*rxt(k,355)*y(k,125) +.220_r8*rxt(k,356)*y(k,123))*y(k,236) & - + (.500_r8*rxt(k,340)*y(k,147) +.500_r8*rxt(k,371)*y(k,110) + & - .700_r8*rxt(k,396)*y(k,99) +.500_r8*rxt(k,397)*y(k,100))*y(k,243) & - + (.250_r8*rxt(k,410)*y(k,226) +.100_r8*rxt(k,411)*y(k,227) + & - .250_r8*rxt(k,413)*y(k,123) +.250_r8*rxt(k,414)*y(k,125))*y(k,250) & - + (.050_r8*rxt(k,394)*y(k,123) +.050_r8*rxt(k,395)*y(k,125)) & - *y(k,235) +.170_r8*rxt(k,45)*y(k,93) +.200_r8*rxt(k,341)*y(k,246) & - *y(k,227) - loss(k,111) = (rxt(k,383)* y(k,243) + het_rates(k,96))* y(k,96) - prod(k,111) = (rxt(k,390)*y(k,226) +.750_r8*rxt(k,391)*y(k,227) + & - .870_r8*rxt(k,394)*y(k,123) +.950_r8*rxt(k,395)*y(k,125))*y(k,235) - loss(k,74) = (rxt(k,384)* y(k,243) + het_rates(k,97))* y(k,97) - prod(k,74) =.600_r8*rxt(k,407)*y(k,243)*y(k,103) - loss(k,175) = (rxt(k,398)* y(k,125) +rxt(k,405)* y(k,133) +rxt(k,406) & - * y(k,243) + het_rates(k,98))* y(k,98) + loss(k,119) = (rxt(k,421)* y(k,251) + het_rates(k,24))* y(k,24) + prod(k,119) =rxt(k,28)*y(k,25) +rxt(k,424)*y(k,230)*y(k,129) + loss(k,138) = (rxt(k,423)* y(k,251) + rxt(k,28) + het_rates(k,25))* y(k,25) + prod(k,138) =rxt(k,422)*y(k,240)*y(k,230) + loss(k,129) = (rxt(k,295)* y(k,58) +rxt(k,296)* y(k,251) + het_rates(k,26)) & + * y(k,26) + prod(k,129) = 0._r8 + loss(k,173) = (rxt(k,297)* y(k,58) +rxt(k,298)* y(k,139) +rxt(k,323) & + * y(k,251) + het_rates(k,27))* y(k,27) + prod(k,173) = 0._r8 + loss(k,124) = (rxt(k,303)* y(k,251) + het_rates(k,28))* y(k,28) + prod(k,124) = (.400_r8*rxt(k,299)*y(k,231) +.200_r8*rxt(k,300)*y(k,235)) & + *y(k,231) + loss(k,139) = (rxt(k,304)* y(k,251) + rxt(k,29) + het_rates(k,29))* y(k,29) + prod(k,139) =rxt(k,301)*y(k,240)*y(k,231) + loss(k,130) = (rxt(k,305)* y(k,58) +rxt(k,306)* y(k,251) + het_rates(k,30)) & + * y(k,30) + prod(k,130) = 0._r8 + loss(k,218) = (rxt(k,326)* y(k,131) +rxt(k,327)* y(k,139) +rxt(k,344) & + * y(k,251) + het_rates(k,31))* y(k,31) + prod(k,218) =.130_r8*rxt(k,404)*y(k,139)*y(k,100) +.700_r8*rxt(k,55)*y(k,118) + loss(k,147) = (rxt(k,331)* y(k,251) + rxt(k,30) + het_rates(k,32))* y(k,32) + prod(k,147) =rxt(k,329)*y(k,240)*y(k,232) + loss(k,88) = (rxt(k,332)* y(k,251) + het_rates(k,33))* y(k,33) + prod(k,88) = 0._r8 + loss(k,125) = (rxt(k,427)* y(k,251) + rxt(k,31) + het_rates(k,34))* y(k,34) + prod(k,125) =rxt(k,425)*y(k,240)*y(k,233) + loss(k,85) = (rxt(k,219)* y(k,250) + rxt(k,78) + het_rates(k,35))* y(k,35) + prod(k,85) = 0._r8 + loss(k,96) = (rxt(k,220)* y(k,250) + rxt(k,79) + het_rates(k,36))* y(k,36) + prod(k,96) = 0._r8 + loss(k,97) = (rxt(k,246)* y(k,250) + rxt(k,80) + het_rates(k,37))* y(k,37) + prod(k,97) = 0._r8 + loss(k,89) = (rxt(k,221)* y(k,250) + rxt(k,81) + het_rates(k,38))* y(k,38) + prod(k,89) = 0._r8 + loss(k,98) = (rxt(k,222)* y(k,250) + rxt(k,82) + het_rates(k,39))* y(k,39) + prod(k,98) = 0._r8 + loss(k,90) = (rxt(k,223)* y(k,250) + rxt(k,83) + het_rates(k,40))* y(k,40) + prod(k,90) = 0._r8 + loss(k,99) = (rxt(k,224)* y(k,250) + rxt(k,84) + het_rates(k,41))* y(k,41) + prod(k,99) = 0._r8 + loss(k,91) = (rxt(k,225)* y(k,250) + rxt(k,85) + het_rates(k,42))* y(k,42) + prod(k,91) = 0._r8 + loss(k,162) = (rxt(k,257)* y(k,58) +rxt(k,269)* y(k,250) +rxt(k,258) & + * y(k,251) + rxt(k,86) + het_rates(k,43))* y(k,43) + prod(k,162) = 0._r8 + loss(k,253) = (rxt(k,230)* y(k,19) +rxt(k,194)* y(k,58) +rxt(k,275)* y(k,131) & + +rxt(k,276)* y(k,138) +rxt(k,274)* y(k,240) +rxt(k,277)* y(k,251) & + + rxt(k,32) + rxt(k,33) + het_rates(k,44))* y(k,44) + prod(k,253) = (rxt(k,201)*y(k,61) +2.000_r8*rxt(k,278)*y(k,235) + & + rxt(k,279)*y(k,235) +rxt(k,281)*y(k,129) + & + .700_r8*rxt(k,300)*y(k,231) +rxt(k,311)*y(k,234) + & + rxt(k,328)*y(k,232) +.800_r8*rxt(k,340)*y(k,254) + & + .880_r8*rxt(k,352)*y(k,244) +2.000_r8*rxt(k,361)*y(k,246) + & + 1.500_r8*rxt(k,385)*y(k,242) +.750_r8*rxt(k,390)*y(k,243) + & + .800_r8*rxt(k,399)*y(k,103) +.800_r8*rxt(k,410)*y(k,258) + & + .750_r8*rxt(k,464)*y(k,249) +.930_r8*rxt(k,469)*y(k,255) + & + .950_r8*rxt(k,474)*y(k,256))*y(k,235) & + + (.500_r8*rxt(k,317)*y(k,239) +rxt(k,338)*y(k,253) + & + rxt(k,342)*y(k,254) +.500_r8*rxt(k,348)*y(k,237) + & + .250_r8*rxt(k,355)*y(k,244) +rxt(k,364)*y(k,246) + & + .100_r8*rxt(k,377)*y(k,228) +.920_r8*rxt(k,387)*y(k,242) + & + .250_r8*rxt(k,412)*y(k,258) +.340_r8*rxt(k,471)*y(k,255) + & + .320_r8*rxt(k,476)*y(k,256))*y(k,129) + (rxt(k,282)*y(k,54) + & + .300_r8*rxt(k,283)*y(k,55) +.500_r8*rxt(k,315)*y(k,53) + & + .800_r8*rxt(k,320)*y(k,76) +rxt(k,322)*y(k,144) + & + .500_r8*rxt(k,370)*y(k,115) +.400_r8*rxt(k,375)*y(k,1) + & + .300_r8*rxt(k,395)*y(k,101) +.680_r8*rxt(k,480)*y(k,215))*y(k,251) & + + (rxt(k,298)*y(k,27) +.500_r8*rxt(k,327)*y(k,31) + & + .120_r8*rxt(k,357)*y(k,111) +.600_r8*rxt(k,371)*y(k,118) + & + .910_r8*rxt(k,404)*y(k,100) +.340_r8*rxt(k,459)*y(k,6) + & + .340_r8*rxt(k,462)*y(k,116))*y(k,139) + (.500_r8*rxt(k,346)*y(k,18) + & + .250_r8*rxt(k,354)*y(k,244) +rxt(k,365)*y(k,246) + & + rxt(k,388)*y(k,242))*y(k,131) + (.250_r8*rxt(k,351)*y(k,244) + & + rxt(k,360)*y(k,246) +rxt(k,384)*y(k,242) + & + .250_r8*rxt(k,409)*y(k,258))*y(k,234) + (.180_r8*rxt(k,39) + & + rxt(k,291)*y(k,250) +rxt(k,292)*y(k,250))*y(k,56) & + + (.150_r8*rxt(k,341)*y(k,254) +.450_r8*rxt(k,362)*y(k,246)) & + *y(k,240) +.100_r8*rxt(k,19)*y(k,1) +.100_r8*rxt(k,20)*y(k,2) & + +rxt(k,38)*y(k,55) +rxt(k,43)*y(k,76) +.330_r8*rxt(k,45)*y(k,95) & + +rxt(k,47)*y(k,97) +rxt(k,49)*y(k,106) +1.340_r8*rxt(k,51)*y(k,111) & + +rxt(k,57)*y(k,132) +rxt(k,62)*y(k,153) +rxt(k,63)*y(k,154) & + +.375_r8*rxt(k,65)*y(k,211) +.400_r8*rxt(k,67)*y(k,213) & + +.680_r8*rxt(k,69)*y(k,215) +2.000_r8*rxt(k,318)*y(k,238) & + +rxt(k,288)*y(k,241) +2.000_r8*rxt(k,363)*y(k,246)*y(k,246) + loss(k,175) = (rxt(k,259)* y(k,58) +rxt(k,270)* y(k,250) +rxt(k,260) & + * y(k,251) + rxt(k,87) + het_rates(k,45))* y(k,45) prod(k,175) = 0._r8 - loss(k,147) = (rxt(k,396)* y(k,243) + rxt(k,503) + het_rates(k,99))* y(k,99) - prod(k,147) =.080_r8*rxt(k,388)*y(k,234)*y(k,123) - loss(k,142) = (rxt(k,397)* y(k,243) + rxt(k,504) + het_rates(k,100)) & - * y(k,100) - prod(k,142) =.080_r8*rxt(k,394)*y(k,235)*y(k,123) - loss(k,198) = (rxt(k,402)* y(k,123) +rxt(k,403)* y(k,125) +rxt(k,399) & - * y(k,226) +rxt(k,400)* y(k,227) +rxt(k,401)* y(k,232) & - + het_rates(k,101))* y(k,101) - prod(k,198) =rxt(k,398)*y(k,125)*y(k,98) - loss(k,118) = (rxt(k,404)* y(k,243) + rxt(k,48) + het_rates(k,102))* y(k,102) - prod(k,118) =rxt(k,401)*y(k,232)*y(k,101) - loss(k,157) = (rxt(k,407)* y(k,243) + rxt(k,49) + het_rates(k,103))* y(k,103) - prod(k,157) = (rxt(k,387)*y(k,234) +rxt(k,392)*y(k,235))*y(k,232) +rxt(k,48) & - *y(k,102) - loss(k,56) = (rxt(k,521)* y(k,243) + het_rates(k,104))* y(k,104) - prod(k,56) = 0._r8 - loss(k,67) = (rxt(k,522)* y(k,243) + het_rates(k,105))* y(k,105) - prod(k,67) = 0._r8 - loss(k,199) = (rxt(k,358)* y(k,133) +rxt(k,359)* y(k,243) + rxt(k,50) & - + rxt(k,51) + het_rates(k,106))* y(k,106) - prod(k,199) = (.390_r8*rxt(k,385)*y(k,226) +.310_r8*rxt(k,386)*y(k,227) + & - .360_r8*rxt(k,388)*y(k,123) +.400_r8*rxt(k,389)*y(k,125))*y(k,234) & - +.300_r8*rxt(k,405)*y(k,133)*y(k,98) +.288_r8*rxt(k,49)*y(k,103) - loss(k,113) = (rxt(k,360)* y(k,243) + het_rates(k,107))* y(k,107) - prod(k,113) =rxt(k,354)*y(k,236)*y(k,232) - loss(k,138) = (rxt(k,369)* y(k,243) + rxt(k,52) + het_rates(k,108))* y(k,108) - prod(k,138) =.800_r8*rxt(k,19)*y(k,1) +.800_r8*rxt(k,20)*y(k,2) & - +.800_r8*rxt(k,378)*y(k,220)*y(k,123) - loss(k,112) = (rxt(k,370)* y(k,243) + rxt(k,53) + het_rates(k,109))* y(k,109) - prod(k,112) =.800_r8*rxt(k,367)*y(k,240)*y(k,232) - loss(k,143) = (rxt(k,371)* y(k,243) + rxt(k,54) + rxt(k,375) & - + het_rates(k,110))* y(k,110) - prod(k,143) =rxt(k,374)*y(k,238)*y(k,124) - loss(k,178) = (rxt(k,462)* y(k,125) +rxt(k,463)* y(k,133) +rxt(k,464) & - * y(k,243) + het_rates(k,111))* y(k,111) - prod(k,178) = 0._r8 - loss(k,203) = (rxt(k,372)* y(k,133) +rxt(k,373)* y(k,243) + rxt(k,55) & - + het_rates(k,112))* y(k,112) - prod(k,203) = (.610_r8*rxt(k,385)*y(k,226) +.440_r8*rxt(k,386)*y(k,227) + & - .560_r8*rxt(k,388)*y(k,123) +.600_r8*rxt(k,389)*y(k,125))*y(k,234) & - +.200_r8*rxt(k,405)*y(k,133)*y(k,98) +.402_r8*rxt(k,49)*y(k,103) - loss(k,125) = (rxt(k,170)* y(k,123) + (rxt(k,171) +rxt(k,172) +rxt(k,173)) & - * y(k,124) +rxt(k,182)* y(k,243) + rxt(k,174) + het_rates(k,113)) & - * y(k,113) - prod(k,125) =rxt(k,15)*y(k,123) - loss(k,102) = ( + rxt(k,13) + rxt(k,14) + rxt(k,193) + rxt(k,505) & - + rxt(k,530) + rxt(k,533) + rxt(k,544) + het_rates(k,115))* y(k,115) - prod(k,102) =rxt(k,189)*y(k,125)*y(k,124) - loss(k,116) = (rxt(k,408)* y(k,243) + rxt(k,506) + het_rates(k,116)) & - * y(k,116) - prod(k,116) =.200_r8*rxt(k,400)*y(k,227)*y(k,101) - loss(k,185) = (rxt(k,409)* y(k,243) + rxt(k,56) + rxt(k,507) & - + het_rates(k,117))* y(k,117) - prod(k,185) = (rxt(k,399)*y(k,226) +.800_r8*rxt(k,400)*y(k,227) + & - rxt(k,402)*y(k,123) +rxt(k,403)*y(k,125))*y(k,101) - loss(k,6) = ( + het_rates(k,118))* y(k,118) + loss(k,92) = (rxt(k,261)* y(k,251) + rxt(k,88) + het_rates(k,46))* y(k,46) + prod(k,92) = 0._r8 + loss(k,222) = (rxt(k,307)* y(k,131) +rxt(k,308)* y(k,251) + rxt(k,34) & + + het_rates(k,47))* y(k,47) + prod(k,222) = (rxt(k,302)*y(k,231) +.270_r8*rxt(k,330)*y(k,232) + & + rxt(k,338)*y(k,253) +rxt(k,348)*y(k,237) +rxt(k,367)*y(k,248) + & + .400_r8*rxt(k,377)*y(k,228))*y(k,129) + (rxt(k,303)*y(k,28) + & + .500_r8*rxt(k,304)*y(k,29) +.800_r8*rxt(k,375)*y(k,1))*y(k,251) & + + (.500_r8*rxt(k,327)*y(k,31) +.100_r8*rxt(k,371)*y(k,118))*y(k,139) & + + (1.600_r8*rxt(k,299)*y(k,231) +.800_r8*rxt(k,300)*y(k,235)) & + *y(k,231) +.400_r8*rxt(k,19)*y(k,1) +.400_r8*rxt(k,20)*y(k,2) & + +rxt(k,346)*y(k,131)*y(k,18) +rxt(k,29)*y(k,29) +.330_r8*rxt(k,45) & + *y(k,95) +rxt(k,53)*y(k,114) +rxt(k,62)*y(k,153) & + +.200_r8*rxt(k,366)*y(k,248)*y(k,240) + loss(k,144) = (rxt(k,262)* y(k,58) +rxt(k,263)* y(k,251) + rxt(k,89) & + + het_rates(k,48))* y(k,48) + prod(k,144) = 0._r8 + loss(k,86) = (rxt(k,309)* y(k,251) + het_rates(k,49))* y(k,49) + prod(k,86) = 0._r8 + loss(k,212) = (rxt(k,345)* y(k,251) + rxt(k,35) + het_rates(k,50))* y(k,50) + prod(k,212) = (.820_r8*rxt(k,330)*y(k,232) +.500_r8*rxt(k,348)*y(k,237) + & + .250_r8*rxt(k,377)*y(k,228) +.270_r8*rxt(k,471)*y(k,255) + & + .040_r8*rxt(k,476)*y(k,256))*y(k,129) & + + (.820_r8*rxt(k,328)*y(k,232) +.150_r8*rxt(k,469)*y(k,255) + & + .025_r8*rxt(k,474)*y(k,256))*y(k,235) + (.250_r8*rxt(k,19) + & + .800_r8*rxt(k,375)*y(k,251))*y(k,1) + (.520_r8*rxt(k,459)*y(k,6) + & + .520_r8*rxt(k,462)*y(k,116))*y(k,139) + (.500_r8*rxt(k,69) + & + .500_r8*rxt(k,480)*y(k,251))*y(k,215) +.250_r8*rxt(k,20)*y(k,2) & + +.500_r8*rxt(k,346)*y(k,131)*y(k,18) +.820_r8*rxt(k,30)*y(k,32) & + +.170_r8*rxt(k,45)*y(k,95) +.300_r8*rxt(k,65)*y(k,211) & + +.050_r8*rxt(k,67)*y(k,213) + loss(k,232) = (rxt(k,333)* y(k,131) +rxt(k,334)* y(k,251) + rxt(k,36) & + + het_rates(k,51))* y(k,51) + prod(k,232) = (.250_r8*rxt(k,355)*y(k,244) +.050_r8*rxt(k,393)*y(k,243) + & + .250_r8*rxt(k,412)*y(k,258) +.170_r8*rxt(k,430)*y(k,236) + & + .170_r8*rxt(k,436)*y(k,247) +.400_r8*rxt(k,446)*y(k,257) + & + .540_r8*rxt(k,452)*y(k,259) +.510_r8*rxt(k,455)*y(k,260))*y(k,129) & + + (.250_r8*rxt(k,354)*y(k,244) +.050_r8*rxt(k,394)*y(k,243) + & + .250_r8*rxt(k,413)*y(k,258))*y(k,131) & + + (.500_r8*rxt(k,340)*y(k,254) +.240_r8*rxt(k,352)*y(k,244) + & + .100_r8*rxt(k,410)*y(k,258))*y(k,235) & + + (.880_r8*rxt(k,357)*y(k,111) +.500_r8*rxt(k,371)*y(k,118)) & + *y(k,139) + (.250_r8*rxt(k,351)*y(k,244) + & + .250_r8*rxt(k,409)*y(k,258))*y(k,234) & + + (.070_r8*rxt(k,429)*y(k,236) +.070_r8*rxt(k,435)*y(k,247)) & + *y(k,240) + (rxt(k,335)*y(k,97) +rxt(k,336)*y(k,132))*y(k,251) & + +.180_r8*rxt(k,23)*y(k,12) +rxt(k,27)*y(k,16) +.400_r8*rxt(k,70) & + *y(k,216) +.540_r8*rxt(k,72)*y(k,221) +.510_r8*rxt(k,73)*y(k,224) + loss(k,188) = (rxt(k,314)* y(k,251) + het_rates(k,52))* y(k,52) + prod(k,188) = (.100_r8*rxt(k,311)*y(k,235) +.150_r8*rxt(k,312)*y(k,240)) & + *y(k,234) +.120_r8*rxt(k,327)*y(k,139)*y(k,31) & + +.150_r8*rxt(k,362)*y(k,246)*y(k,240) + loss(k,176) = (rxt(k,315)* y(k,251) + rxt(k,37) + het_rates(k,53))* y(k,53) + prod(k,176) = (.400_r8*rxt(k,312)*y(k,234) +.400_r8*rxt(k,362)*y(k,246)) & + *y(k,240) + loss(k,198) = (rxt(k,282)* y(k,251) + het_rates(k,54))* y(k,54) + prod(k,198) = (rxt(k,279)*y(k,235) +.300_r8*rxt(k,300)*y(k,231) + & + .500_r8*rxt(k,340)*y(k,254) +.250_r8*rxt(k,352)*y(k,244) + & + .250_r8*rxt(k,385)*y(k,242) +.250_r8*rxt(k,390)*y(k,243) + & + .200_r8*rxt(k,399)*y(k,103) +.300_r8*rxt(k,410)*y(k,258) + & + .250_r8*rxt(k,464)*y(k,249) +.250_r8*rxt(k,469)*y(k,255) + & + .250_r8*rxt(k,474)*y(k,256))*y(k,235) + loss(k,151) = (rxt(k,283)* y(k,251) + rxt(k,38) + het_rates(k,55))* y(k,55) + prod(k,151) =rxt(k,280)*y(k,240)*y(k,235) + loss(k,242) = (rxt(k,195)* y(k,58) +rxt(k,251)* y(k,75) + (rxt(k,290) + & + rxt(k,291) +rxt(k,292))* y(k,250) +rxt(k,284)* y(k,251) + rxt(k,39) & + + rxt(k,40) + het_rates(k,56))* y(k,56) + prod(k,242) =.100_r8*rxt(k,327)*y(k,139)*y(k,31) + loss(k,152) = (rxt(k,264)* y(k,58) +rxt(k,247)* y(k,250) +rxt(k,265) & + * y(k,251) + rxt(k,90) + het_rates(k,57))* y(k,57) + prod(k,152) = 0._r8 + loss(k,257) = (rxt(k,305)* y(k,30) +rxt(k,257)* y(k,43) +rxt(k,194)* y(k,44) & + +rxt(k,259)* y(k,45) +rxt(k,262)* y(k,48) +rxt(k,195)* y(k,56) & + +rxt(k,264)* y(k,57) +rxt(k,207)* y(k,62) +rxt(k,196)* y(k,79) & + +rxt(k,197)* y(k,81) +rxt(k,216)* y(k,94) +rxt(k,200)* y(k,139) & + + (rxt(k,198) +rxt(k,199))* y(k,240) + het_rates(k,58))* y(k,58) + prod(k,257) = (4.000_r8*rxt(k,219)*y(k,35) +rxt(k,220)*y(k,36) + & + 2.000_r8*rxt(k,221)*y(k,38) +2.000_r8*rxt(k,222)*y(k,39) + & + 2.000_r8*rxt(k,223)*y(k,40) +rxt(k,224)*y(k,41) + & + 2.000_r8*rxt(k,225)*y(k,42) +rxt(k,226)*y(k,87) +rxt(k,256)*y(k,67) + & + rxt(k,271)*y(k,84) +rxt(k,272)*y(k,85) +rxt(k,273)*y(k,86))*y(k,250) & + + (rxt(k,93) +rxt(k,201)*y(k,235) +2.000_r8*rxt(k,202)*y(k,61) + & + rxt(k,204)*y(k,61) +rxt(k,206)*y(k,129) +rxt(k,211)*y(k,138) + & + rxt(k,212)*y(k,251) +rxt(k,235)*y(k,21) +rxt(k,489)*y(k,157))*y(k,61) & + + (rxt(k,215)*y(k,87) +3.000_r8*rxt(k,261)*y(k,46) + & + rxt(k,263)*y(k,48) +rxt(k,266)*y(k,84) +rxt(k,267)*y(k,85) + & + rxt(k,268)*y(k,86))*y(k,251) + (rxt(k,103) +rxt(k,214)*y(k,138)) & + *y(k,87) +rxt(k,74)*y(k,20) +4.000_r8*rxt(k,78)*y(k,35) +rxt(k,79) & + *y(k,36) +2.000_r8*rxt(k,81)*y(k,38) +2.000_r8*rxt(k,82)*y(k,39) & + +2.000_r8*rxt(k,83)*y(k,40) +rxt(k,84)*y(k,41) +2.000_r8*rxt(k,85) & + *y(k,42) +3.000_r8*rxt(k,88)*y(k,46) +rxt(k,89)*y(k,48) & + +2.000_r8*rxt(k,91)*y(k,59) +2.000_r8*rxt(k,92)*y(k,60) +rxt(k,95) & + *y(k,62) +rxt(k,97)*y(k,67) +rxt(k,100)*y(k,84) +rxt(k,101)*y(k,85) & + +rxt(k,102)*y(k,86) +rxt(k,106)*y(k,94) + loss(k,102) = ( + rxt(k,91) + het_rates(k,59))* y(k,59) + prod(k,102) = (rxt(k,546)*y(k,94) +rxt(k,551)*y(k,62) +rxt(k,552)*y(k,94) + & + rxt(k,556)*y(k,62) +rxt(k,557)*y(k,94) +rxt(k,561)*y(k,62))*y(k,87) & + +rxt(k,207)*y(k,62)*y(k,58) +rxt(k,203)*y(k,61)*y(k,61) + loss(k,87) = ( + rxt(k,92) + rxt(k,229) + het_rates(k,60))* y(k,60) + prod(k,87) =rxt(k,228)*y(k,61)*y(k,61) + loss(k,250) = ((rxt(k,234) +rxt(k,235) +rxt(k,236))* y(k,21) & + + 2._r8*(rxt(k,202) +rxt(k,203) +rxt(k,204) +rxt(k,228))* y(k,61) & + +rxt(k,206)* y(k,129) +rxt(k,208)* y(k,130) +rxt(k,211)* y(k,138) & + +rxt(k,489)* y(k,157) +rxt(k,201)* y(k,235) +rxt(k,205)* y(k,240) & + + (rxt(k,212) +rxt(k,213))* y(k,251) + rxt(k,93) + het_rates(k,61)) & + * y(k,61) + prod(k,250) = (rxt(k,199)*y(k,240) +rxt(k,200)*y(k,139) +rxt(k,216)*y(k,94)) & + *y(k,58) + (rxt(k,94) +rxt(k,209)*y(k,138))*y(k,62) & + + (rxt(k,217)*y(k,138) +rxt(k,218)*y(k,251))*y(k,94) + (rxt(k,107) + & + rxt(k,494)*y(k,157))*y(k,141) +2.000_r8*rxt(k,229)*y(k,60) & + +rxt(k,227)*y(k,250)*y(k,87) + loss(k,209) = (rxt(k,207)* y(k,58) + (rxt(k,551) +rxt(k,556) +rxt(k,561)) & + * y(k,87) +rxt(k,209)* y(k,138) +rxt(k,210)* y(k,251) + rxt(k,94) & + + rxt(k,95) + rxt(k,549) + rxt(k,554) + rxt(k,560) & + + het_rates(k,62))* y(k,62) + prod(k,209) =rxt(k,208)*y(k,130)*y(k,61) + loss(k,5) = ( + het_rates(k,63))* y(k,63) + prod(k,5) = 0._r8 + loss(k,223) = (rxt(k,294)* y(k,251) + het_rates(k,64))* y(k,64) + prod(k,223) = (rxt(k,32) +rxt(k,33) +rxt(k,194)*y(k,58) +rxt(k,230)*y(k,19) + & + rxt(k,275)*y(k,131) +rxt(k,276)*y(k,138) +rxt(k,277)*y(k,251)) & + *y(k,44) + (.630_r8*rxt(k,298)*y(k,27) +.560_r8*rxt(k,327)*y(k,31) + & + .650_r8*rxt(k,357)*y(k,111) +.560_r8*rxt(k,371)*y(k,118) + & + .620_r8*rxt(k,404)*y(k,100) +.230_r8*rxt(k,459)*y(k,6) + & + .230_r8*rxt(k,462)*y(k,116))*y(k,139) & + + (.220_r8*rxt(k,355)*y(k,244) +.250_r8*rxt(k,412)*y(k,258) + & + .170_r8*rxt(k,430)*y(k,236) +.400_r8*rxt(k,433)*y(k,245) + & + .350_r8*rxt(k,436)*y(k,247) +.225_r8*rxt(k,471)*y(k,255))*y(k,129) & + + (.350_r8*rxt(k,296)*y(k,26) +rxt(k,321)*y(k,77) + & + rxt(k,334)*y(k,51) +.700_r8*rxt(k,480)*y(k,215) +rxt(k,484)*y(k,142)) & + *y(k,251) + (rxt(k,333)*y(k,51) +.220_r8*rxt(k,354)*y(k,244) + & + .500_r8*rxt(k,413)*y(k,258))*y(k,131) & + + (.110_r8*rxt(k,352)*y(k,244) +.200_r8*rxt(k,410)*y(k,258) + & + .125_r8*rxt(k,469)*y(k,255))*y(k,235) & + + (.070_r8*rxt(k,429)*y(k,236) +.160_r8*rxt(k,432)*y(k,245) + & + .140_r8*rxt(k,435)*y(k,247))*y(k,240) + (rxt(k,110) + & + rxt(k,483)*y(k,138))*y(k,142) + (.220_r8*rxt(k,351)*y(k,244) + & + .250_r8*rxt(k,409)*y(k,258))*y(k,234) +1.500_r8*rxt(k,22)*y(k,11) & + +.450_r8*rxt(k,23)*y(k,12) +.600_r8*rxt(k,26)*y(k,15) +rxt(k,27) & + *y(k,16) +rxt(k,34)*y(k,47) +rxt(k,262)*y(k,58)*y(k,48) +rxt(k,36) & + *y(k,51) +.380_r8*rxt(k,39)*y(k,56) +rxt(k,41)*y(k,65) +rxt(k,43) & + *y(k,76) +2.000_r8*rxt(k,44)*y(k,77) +.330_r8*rxt(k,45)*y(k,95) & + +1.340_r8*rxt(k,50)*y(k,111) +.700_r8*rxt(k,55)*y(k,118) & + +1.500_r8*rxt(k,64)*y(k,210) +.250_r8*rxt(k,65)*y(k,211) +rxt(k,68) & + *y(k,214) +1.700_r8*rxt(k,69)*y(k,215) + loss(k,203) = ( + rxt(k,41) + het_rates(k,65))* y(k,65) + prod(k,203) = (rxt(k,286)*y(k,89) +rxt(k,294)*y(k,64) +rxt(k,314)*y(k,52) + & + .500_r8*rxt(k,315)*y(k,53) +.800_r8*rxt(k,320)*y(k,76) + & + rxt(k,321)*y(k,77) +.500_r8*rxt(k,370)*y(k,115) + & + 1.800_r8*rxt(k,480)*y(k,215))*y(k,251) & + + (2.000_r8*rxt(k,310)*y(k,234) +.900_r8*rxt(k,311)*y(k,235) + & + rxt(k,313)*y(k,129) +2.000_r8*rxt(k,360)*y(k,246) + & + rxt(k,384)*y(k,242) +rxt(k,409)*y(k,258))*y(k,234) & + + (.200_r8*rxt(k,327)*y(k,31) +.100_r8*rxt(k,371)*y(k,118) + & + .270_r8*rxt(k,459)*y(k,6) +.270_r8*rxt(k,462)*y(k,116))*y(k,139) & + + (rxt(k,361)*y(k,235) +.450_r8*rxt(k,362)*y(k,240) + & + 2.000_r8*rxt(k,363)*y(k,246))*y(k,246) & + + (.500_r8*rxt(k,469)*y(k,235) +.900_r8*rxt(k,471)*y(k,129)) & + *y(k,255) +rxt(k,37)*y(k,53) +.440_r8*rxt(k,39)*y(k,56) & + +.400_r8*rxt(k,60)*y(k,144) +rxt(k,65)*y(k,211) +.800_r8*rxt(k,69) & + *y(k,215) + loss(k,121) = (rxt(k,255)* y(k,250) + rxt(k,96) + het_rates(k,66))* y(k,66) + prod(k,121) = (rxt(k,220)*y(k,36) +rxt(k,222)*y(k,39) + & + 2.000_r8*rxt(k,223)*y(k,40) +2.000_r8*rxt(k,224)*y(k,41) + & + rxt(k,225)*y(k,42) +rxt(k,246)*y(k,37) +2.000_r8*rxt(k,248)*y(k,80) + & + rxt(k,272)*y(k,85) +rxt(k,273)*y(k,86))*y(k,250) + (rxt(k,101) + & + rxt(k,267)*y(k,251))*y(k,85) + (rxt(k,102) +rxt(k,268)*y(k,251)) & + *y(k,86) +rxt(k,79)*y(k,36) +rxt(k,80)*y(k,37) +rxt(k,82)*y(k,39) & + +2.000_r8*rxt(k,83)*y(k,40) +2.000_r8*rxt(k,84)*y(k,41) +rxt(k,85) & + *y(k,42) +2.000_r8*rxt(k,98)*y(k,80) + loss(k,115) = (rxt(k,256)* y(k,250) + rxt(k,97) + het_rates(k,67))* y(k,67) + prod(k,115) = (rxt(k,100) +rxt(k,266)*y(k,251) +rxt(k,271)*y(k,250))*y(k,84) & + + (rxt(k,81) +rxt(k,221)*y(k,250))*y(k,38) + (rxt(k,82) + & + rxt(k,222)*y(k,250))*y(k,39) + loss(k,109) = (rxt(k,428)* y(k,251) + het_rates(k,68))* y(k,68) + prod(k,109) =.180_r8*rxt(k,448)*y(k,251)*y(k,217) + loss(k,128) = (rxt(k,481)* y(k,131) + (rxt(k,482) +rxt(k,496))* y(k,251) & + + het_rates(k,69))* y(k,69) + prod(k,128) = 0._r8 + loss(k,6) = ( + het_rates(k,70))* y(k,70) prod(k,6) = 0._r8 - loss(k,7) = ( + het_rates(k,119))* y(k,119) + loss(k,7) = ( + het_rates(k,71))* y(k,71) prod(k,7) = 0._r8 - loss(k,8) = ( + het_rates(k,120))* y(k,120) + loss(k,8) = ( + het_rates(k,72))* y(k,72) prod(k,8) = 0._r8 - loss(k,70) = (rxt(k,499)* y(k,243) + het_rates(k,121))* y(k,121) - prod(k,70) = 0._r8 - loss(k,9) = ( + rxt(k,508) + het_rates(k,122))* y(k,122) + loss(k,9) = ( + rxt(k,562) + het_rates(k,73))* y(k,73) prod(k,9) = 0._r8 - loss(k,211) = (rxt(k,238)* y(k,19) +rxt(k,206)* y(k,59) +rxt(k,402)* y(k,101) & - +rxt(k,170)* y(k,113) +rxt(k,179)* y(k,125) +rxt(k,185)* y(k,132) & - +rxt(k,184)* y(k,133) +rxt(k,417)* y(k,219) + (rxt(k,378) + & - rxt(k,379))* y(k,220) +rxt(k,420)* y(k,221) +rxt(k,425)* y(k,222) & - +rxt(k,303)* y(k,223) +rxt(k,331)* y(k,224) +rxt(k,427)* y(k,225) & - +rxt(k,314)* y(k,226) +rxt(k,281)* y(k,227) +rxt(k,431)* y(k,228) & - + (rxt(k,349) +rxt(k,350))* y(k,229) +rxt(k,318)* y(k,231) & - +rxt(k,183)* y(k,232) +rxt(k,290)* y(k,233) +rxt(k,388)* y(k,234) & - +rxt(k,394)* y(k,235) + (rxt(k,356) +rxt(k,357))* y(k,236) & - +rxt(k,434)* y(k,237) +rxt(k,365)* y(k,238) +rxt(k,437)* y(k,239) & - +rxt(k,368)* y(k,240) +rxt(k,467)* y(k,241) +rxt(k,440)* y(k,244) & - +rxt(k,339)* y(k,245) +rxt(k,343)* y(k,246) +rxt(k,472)* y(k,247) & - +rxt(k,477)* y(k,248) +rxt(k,447)* y(k,249) +rxt(k,413)* y(k,250) & - +rxt(k,453)* y(k,251) +rxt(k,456)* y(k,252) + rxt(k,15) & + loss(k,100) = ( + rxt(k,42) + het_rates(k,74))* y(k,74) + prod(k,100) =rxt(k,316)*y(k,240)*y(k,239) + loss(k,208) = (rxt(k,251)* y(k,56) +rxt(k,252)* y(k,79) +rxt(k,254)* y(k,91) & + +rxt(k,253)* y(k,261) + het_rates(k,75))* y(k,75) + prod(k,208) = (rxt(k,224)*y(k,41) +rxt(k,246)*y(k,37) + & + 2.000_r8*rxt(k,255)*y(k,66) +rxt(k,256)*y(k,67))*y(k,250) +rxt(k,80) & + *y(k,37) +rxt(k,84)*y(k,41) +2.000_r8*rxt(k,96)*y(k,66) +rxt(k,97) & + *y(k,67) +rxt(k,104)*y(k,90) + loss(k,224) = (rxt(k,320)* y(k,251) + rxt(k,43) + het_rates(k,76))* y(k,76) + prod(k,224) = (.530_r8*rxt(k,355)*y(k,244) +.050_r8*rxt(k,393)*y(k,243) + & + .250_r8*rxt(k,412)*y(k,258) +.225_r8*rxt(k,471)*y(k,255))*y(k,129) & + + (.530_r8*rxt(k,354)*y(k,244) +.050_r8*rxt(k,394)*y(k,243) + & + .250_r8*rxt(k,413)*y(k,258))*y(k,131) & + + (.260_r8*rxt(k,352)*y(k,244) +.100_r8*rxt(k,410)*y(k,258) + & + .125_r8*rxt(k,469)*y(k,255))*y(k,235) & + + (.700_r8*rxt(k,395)*y(k,101) +.500_r8*rxt(k,396)*y(k,102) + & + rxt(k,407)*y(k,122))*y(k,251) + (.530_r8*rxt(k,351)*y(k,244) + & + .250_r8*rxt(k,409)*y(k,258))*y(k,234) +.330_r8*rxt(k,45)*y(k,95) & + +.250_r8*rxt(k,65)*y(k,211) +rxt(k,319)*y(k,238) + loss(k,213) = (rxt(k,321)* y(k,251) + rxt(k,44) + rxt(k,541) & + + het_rates(k,77))* y(k,77) + prod(k,213) = (.050_r8*rxt(k,393)*y(k,243) +.250_r8*rxt(k,412)*y(k,258) + & + rxt(k,419)*y(k,229) +.400_r8*rxt(k,433)*y(k,245) + & + .170_r8*rxt(k,436)*y(k,247) +.700_r8*rxt(k,439)*y(k,252) + & + .600_r8*rxt(k,446)*y(k,257) +.340_r8*rxt(k,452)*y(k,259) + & + .170_r8*rxt(k,455)*y(k,260))*y(k,129) + (.650_r8*rxt(k,296)*y(k,26) + & + .200_r8*rxt(k,320)*y(k,76) +rxt(k,408)*y(k,123))*y(k,251) & + + (.250_r8*rxt(k,409)*y(k,234) +.100_r8*rxt(k,410)*y(k,235) + & + .250_r8*rxt(k,413)*y(k,131))*y(k,258) & + + (.160_r8*rxt(k,432)*y(k,245) +.070_r8*rxt(k,435)*y(k,247)) & + *y(k,240) +rxt(k,21)*y(k,10) +.130_r8*rxt(k,23)*y(k,12) & + +.050_r8*rxt(k,394)*y(k,243)*y(k,131) +.700_r8*rxt(k,61)*y(k,148) & + +.600_r8*rxt(k,70)*y(k,216) +.340_r8*rxt(k,72)*y(k,221) & + +.170_r8*rxt(k,73)*y(k,224) + loss(k,244) = (rxt(k,160)* y(k,139) + (rxt(k,154) +rxt(k,155) +rxt(k,156)) & + * y(k,240) + rxt(k,157) + het_rates(k,78))* y(k,78) + prod(k,244) = (rxt(k,161)*y(k,79) +rxt(k,164)*y(k,138) +rxt(k,182)*y(k,119) + & + rxt(k,277)*y(k,44) +rxt(k,484)*y(k,142) +rxt(k,490)*y(k,155) + & + rxt(k,495)*y(k,157))*y(k,251) + (rxt(k,144)*y(k,250) + & + rxt(k,152)*y(k,138) +rxt(k,196)*y(k,58) +rxt(k,252)*y(k,75))*y(k,79) & + + (.330_r8*rxt(k,39) +rxt(k,40) +rxt(k,291)*y(k,250))*y(k,56) & + + (rxt(k,99) +rxt(k,250)*y(k,250))*y(k,83) + (rxt(k,103) + & + rxt(k,227)*y(k,250))*y(k,87) + (rxt(k,2) +2.000_r8*rxt(k,3))*y(k,261) & + +2.000_r8*rxt(k,33)*y(k,44) +rxt(k,38)*y(k,55) +rxt(k,104)*y(k,90) + loss(k,240) = (rxt(k,196)* y(k,58) +rxt(k,252)* y(k,75) +rxt(k,152)* y(k,138) & + +rxt(k,144)* y(k,250) +rxt(k,161)* y(k,251) + het_rates(k,79)) & + * y(k,79) + prod(k,240) = (1.440_r8*rxt(k,39) +rxt(k,292)*y(k,250))*y(k,56) +rxt(k,32) & + *y(k,44) +rxt(k,154)*y(k,240)*y(k,78) +rxt(k,1)*y(k,261) + loss(k,93) = (rxt(k,248)* y(k,250) + rxt(k,98) + het_rates(k,80))* y(k,80) + prod(k,93) = 0._r8 + loss(k,178) = (rxt(k,197)* y(k,58) +rxt(k,153)* y(k,138) +rxt(k,162) & + * y(k,251) + rxt(k,4) + het_rates(k,81))* y(k,81) + prod(k,178) = (.500_r8*rxt(k,499) +rxt(k,168)*y(k,240))*y(k,240) & + +rxt(k,167)*y(k,251)*y(k,251) + loss(k,101) = ( + rxt(k,109) + het_rates(k,82))* y(k,82) + prod(k,101) =rxt(k,497)*y(k,261)*y(k,159) + loss(k,201) = (rxt(k,243)* y(k,138) + (rxt(k,249) +rxt(k,250))* y(k,250) & + +rxt(k,244)* y(k,251) + rxt(k,99) + het_rates(k,83))* y(k,83) + prod(k,201) = (rxt(k,230)*y(k,44) +rxt(k,231)*y(k,240))*y(k,19) + loss(k,114) = (rxt(k,271)* y(k,250) +rxt(k,266)* y(k,251) + rxt(k,100) & + + het_rates(k,84))* y(k,84) + prod(k,114) = 0._r8 + loss(k,120) = (rxt(k,272)* y(k,250) +rxt(k,267)* y(k,251) + rxt(k,101) & + + het_rates(k,85))* y(k,85) + prod(k,120) = 0._r8 + loss(k,132) = (rxt(k,273)* y(k,250) +rxt(k,268)* y(k,251) + rxt(k,102) & + + het_rates(k,86))* y(k,86) + prod(k,132) = 0._r8 + loss(k,251) = ((rxt(k,551) +rxt(k,556) +rxt(k,561))* y(k,62) + (rxt(k,553) + & + rxt(k,558))* y(k,93) + (rxt(k,546) +rxt(k,552) +rxt(k,557))* y(k,94) & + +rxt(k,214)* y(k,138) + (rxt(k,226) +rxt(k,227))* y(k,250) & + +rxt(k,215)* y(k,251) + rxt(k,103) + het_rates(k,87))* y(k,87) + prod(k,251) = (rxt(k,194)*y(k,44) +rxt(k,195)*y(k,56) +rxt(k,196)*y(k,79) + & + rxt(k,197)*y(k,81) +rxt(k,198)*y(k,240) +rxt(k,216)*y(k,94) + & + rxt(k,257)*y(k,43) +rxt(k,259)*y(k,45) +2.000_r8*rxt(k,262)*y(k,48) + & + rxt(k,264)*y(k,57) +rxt(k,305)*y(k,30))*y(k,58) +rxt(k,213)*y(k,251) & + *y(k,61) + loss(k,107) = (rxt(k,293)* y(k,250) +rxt(k,285)* y(k,251) + het_rates(k,88)) & + * y(k,88) + prod(k,107) = 0._r8 + loss(k,215) = (rxt(k,286)* y(k,251) + het_rates(k,89))* y(k,89) + prod(k,215) = (.370_r8*rxt(k,298)*y(k,27) +.120_r8*rxt(k,327)*y(k,31) + & + .330_r8*rxt(k,357)*y(k,111) +.120_r8*rxt(k,371)*y(k,118) + & + .110_r8*rxt(k,404)*y(k,100) +.050_r8*rxt(k,459)*y(k,6) + & + .050_r8*rxt(k,462)*y(k,116))*y(k,139) + (rxt(k,287)*y(k,240) + & + rxt(k,289)*y(k,129))*y(k,241) +.350_r8*rxt(k,296)*y(k,251)*y(k,26) + loss(k,131) = ( + rxt(k,104) + het_rates(k,90))* y(k,90) + prod(k,131) = (rxt(k,251)*y(k,56) +rxt(k,252)*y(k,79) +rxt(k,253)*y(k,261) + & + rxt(k,254)*y(k,91))*y(k,75) + loss(k,243) = (rxt(k,254)* y(k,75) +rxt(k,191)* y(k,251) + rxt(k,9) & + + het_rates(k,91))* y(k,91) + prod(k,243) = (rxt(k,549) +rxt(k,554) +rxt(k,560) +rxt(k,551)*y(k,87) + & + rxt(k,556)*y(k,87) +rxt(k,561)*y(k,87))*y(k,62) + (rxt(k,508) + & + rxt(k,275)*y(k,44) +rxt(k,307)*y(k,47) +rxt(k,333)*y(k,51) + & + rxt(k,481)*y(k,69))*y(k,131) + (2.000_r8*rxt(k,503) + & + 2.000_r8*rxt(k,545) +2.000_r8*rxt(k,548) +2.000_r8*rxt(k,559)) & + *y(k,121) + (rxt(k,547) +rxt(k,550) +rxt(k,555))*y(k,22) & + + (.500_r8*rxt(k,507) +rxt(k,190)*y(k,251))*y(k,130) +rxt(k,500) & + *y(k,95) +rxt(k,501)*y(k,101) +rxt(k,502)*y(k,102) +rxt(k,504) & + *y(k,122) +rxt(k,505)*y(k,123) +rxt(k,509)*y(k,133) +rxt(k,510) & + *y(k,143) +rxt(k,511)*y(k,212) + loss(k,150) = (rxt(k,169)* y(k,251) + rxt(k,10) + rxt(k,11) + rxt(k,192) & + + het_rates(k,92))* y(k,92) + prod(k,150) =rxt(k,188)*y(k,240)*y(k,130) + loss(k,197) = ((rxt(k,553) +rxt(k,558))* y(k,87) +rxt(k,245)* y(k,138) & + + rxt(k,105) + het_rates(k,93))* y(k,93) + prod(k,197) = (rxt(k,547) +rxt(k,550) +rxt(k,555))*y(k,22) & + +rxt(k,237)*y(k,240)*y(k,21) + loss(k,200) = (rxt(k,216)* y(k,58) + (rxt(k,546) +rxt(k,552) +rxt(k,557)) & + * y(k,87) +rxt(k,217)* y(k,138) +rxt(k,218)* y(k,251) + rxt(k,106) & + + het_rates(k,94))* y(k,94) + prod(k,200) = (rxt(k,549) +rxt(k,554) +rxt(k,560) +rxt(k,210)*y(k,251)) & + *y(k,62) +rxt(k,205)*y(k,240)*y(k,61) + loss(k,228) = (rxt(k,350)* y(k,251) + rxt(k,45) + rxt(k,500) & + + het_rates(k,95))* y(k,95) + prod(k,228) = (rxt(k,349)*y(k,237) +rxt(k,356)*y(k,244))*y(k,129) & + + (.300_r8*rxt(k,395)*y(k,101) +.500_r8*rxt(k,396)*y(k,102)) & + *y(k,251) + loss(k,122) = (rxt(k,381)* y(k,251) + rxt(k,46) + het_rates(k,96))* y(k,96) + prod(k,122) =rxt(k,392)*y(k,243) + loss(k,227) = (rxt(k,335)* y(k,251) + rxt(k,47) + het_rates(k,97))* y(k,97) + prod(k,227) = (.220_r8*rxt(k,351)*y(k,234) +.230_r8*rxt(k,352)*y(k,235) + & + .220_r8*rxt(k,354)*y(k,131) +.220_r8*rxt(k,355)*y(k,129))*y(k,244) & + + (.500_r8*rxt(k,339)*y(k,153) +.500_r8*rxt(k,370)*y(k,115) + & + .700_r8*rxt(k,395)*y(k,101) +.500_r8*rxt(k,396)*y(k,102))*y(k,251) & + + (.250_r8*rxt(k,409)*y(k,234) +.100_r8*rxt(k,410)*y(k,235) + & + .250_r8*rxt(k,412)*y(k,129) +.250_r8*rxt(k,413)*y(k,131))*y(k,258) & + + (.050_r8*rxt(k,393)*y(k,129) +.050_r8*rxt(k,394)*y(k,131)) & + *y(k,243) +.170_r8*rxt(k,45)*y(k,95) +.200_r8*rxt(k,340)*y(k,254) & + *y(k,235) + loss(k,140) = (rxt(k,382)* y(k,251) + het_rates(k,98))* y(k,98) + prod(k,140) = (rxt(k,389)*y(k,234) +.750_r8*rxt(k,390)*y(k,235) + & + .870_r8*rxt(k,393)*y(k,129) +.950_r8*rxt(k,394)*y(k,131))*y(k,243) + loss(k,94) = (rxt(k,383)* y(k,251) + het_rates(k,99))* y(k,99) + prod(k,94) =.600_r8*rxt(k,406)*y(k,251)*y(k,106) + loss(k,204) = (rxt(k,397)* y(k,131) +rxt(k,404)* y(k,139) +rxt(k,405) & + * y(k,251) + het_rates(k,100))* y(k,100) + prod(k,204) = 0._r8 + loss(k,180) = (rxt(k,395)* y(k,251) + rxt(k,501) + het_rates(k,101)) & + * y(k,101) + prod(k,180) =.080_r8*rxt(k,387)*y(k,242)*y(k,129) + loss(k,171) = (rxt(k,396)* y(k,251) + rxt(k,502) + het_rates(k,102)) & + * y(k,102) + prod(k,171) =.080_r8*rxt(k,393)*y(k,243)*y(k,129) + loss(k,230) = (rxt(k,401)* y(k,129) +rxt(k,402)* y(k,131) +rxt(k,398) & + * y(k,234) +rxt(k,399)* y(k,235) +rxt(k,400)* y(k,240) & + + het_rates(k,103))* y(k,103) + prod(k,230) =rxt(k,397)*y(k,131)*y(k,100) + loss(k,148) = (rxt(k,403)* y(k,251) + rxt(k,48) + het_rates(k,104))* y(k,104) + prod(k,148) =rxt(k,400)*y(k,240)*y(k,103) + loss(k,70) = (rxt(k,522)* y(k,129) +rxt(k,521)* y(k,240) + het_rates(k,105)) & + * y(k,105) + prod(k,70) =rxt(k,524)*y(k,251)*y(k,100) + loss(k,189) = (rxt(k,406)* y(k,251) + rxt(k,49) + het_rates(k,106))* y(k,106) + prod(k,189) = (rxt(k,386)*y(k,242) +rxt(k,391)*y(k,243))*y(k,240) +rxt(k,48) & + *y(k,104) + loss(k,63) = (rxt(k,527)* y(k,251) + het_rates(k,107))* y(k,107) + prod(k,63) = 0._r8 + loss(k,62) = (rxt(k,526)* y(k,129) +rxt(k,525)* y(k,240) + het_rates(k,108)) & + * y(k,108) + prod(k,62) =rxt(k,527)*y(k,251)*y(k,107) + loss(k,78) = (rxt(k,530)* y(k,251) + het_rates(k,109))* y(k,109) + prod(k,78) = 0._r8 + loss(k,77) = (rxt(k,529)* y(k,129) +rxt(k,528)* y(k,240) + het_rates(k,110)) & + * y(k,110) + prod(k,77) =rxt(k,530)*y(k,251)*y(k,109) + loss(k,231) = (rxt(k,357)* y(k,139) +rxt(k,358)* y(k,251) + rxt(k,50) & + + rxt(k,51) + het_rates(k,111))* y(k,111) + prod(k,231) = (.390_r8*rxt(k,384)*y(k,234) +.310_r8*rxt(k,385)*y(k,235) + & + .360_r8*rxt(k,387)*y(k,129) +.400_r8*rxt(k,388)*y(k,131))*y(k,242) & + +.300_r8*rxt(k,404)*y(k,139)*y(k,100) +.300_r8*rxt(k,49)*y(k,106) + loss(k,141) = (rxt(k,359)* y(k,251) + het_rates(k,112))* y(k,112) + prod(k,141) =rxt(k,353)*y(k,244)*y(k,240) + loss(k,166) = (rxt(k,368)* y(k,251) + rxt(k,52) + het_rates(k,113))* y(k,113) + prod(k,166) =.800_r8*rxt(k,19)*y(k,1) +.800_r8*rxt(k,20)*y(k,2) & + +.800_r8*rxt(k,377)*y(k,228)*y(k,129) + loss(k,134) = (rxt(k,369)* y(k,251) + rxt(k,53) + het_rates(k,114))* y(k,114) + prod(k,134) =.800_r8*rxt(k,366)*y(k,248)*y(k,240) + loss(k,177) = (rxt(k,370)* y(k,251) + rxt(k,54) + rxt(k,374) & + + het_rates(k,115))* y(k,115) + prod(k,177) =rxt(k,373)*y(k,246)*y(k,130) + loss(k,217) = (rxt(k,461)* y(k,131) +rxt(k,462)* y(k,139) +rxt(k,463) & + * y(k,251) + het_rates(k,116))* y(k,116) + prod(k,217) = 0._r8 + loss(k,71) = (rxt(k,533)* y(k,129) +rxt(k,532)* y(k,240) + het_rates(k,117)) & + * y(k,117) + prod(k,71) =rxt(k,535)*y(k,251)*y(k,116) + loss(k,237) = (rxt(k,371)* y(k,139) +rxt(k,372)* y(k,251) + rxt(k,55) & + + het_rates(k,118))* y(k,118) + prod(k,237) = (.610_r8*rxt(k,384)*y(k,234) +.440_r8*rxt(k,385)*y(k,235) + & + .560_r8*rxt(k,387)*y(k,129) +.600_r8*rxt(k,388)*y(k,131))*y(k,242) & + +.200_r8*rxt(k,404)*y(k,139)*y(k,100) +.700_r8*rxt(k,49)*y(k,106) + loss(k,160) = (rxt(k,170)* y(k,129) + (rxt(k,171) +rxt(k,172) +rxt(k,173)) & + * y(k,130) +rxt(k,182)* y(k,251) + rxt(k,174) + het_rates(k,119)) & + * y(k,119) + prod(k,160) =rxt(k,15)*y(k,129) + loss(k,106) = ((rxt(k,186) +rxt(k,187))* y(k,250) + rxt(k,12) & + + het_rates(k,120))* y(k,120) + prod(k,106) =rxt(k,171)*y(k,130)*y(k,119) + loss(k,133) = ( + rxt(k,13) + rxt(k,14) + rxt(k,193) + rxt(k,503) & + + rxt(k,545) + rxt(k,548) + rxt(k,559) + het_rates(k,121))* y(k,121) + prod(k,133) =rxt(k,189)*y(k,131)*y(k,130) + loss(k,149) = (rxt(k,407)* y(k,251) + rxt(k,504) + het_rates(k,122)) & + * y(k,122) + prod(k,149) =.200_r8*rxt(k,399)*y(k,235)*y(k,103) + loss(k,219) = (rxt(k,408)* y(k,251) + rxt(k,56) + rxt(k,505) & + het_rates(k,123))* y(k,123) - prod(k,211) = (rxt(k,16) +.500_r8*rxt(k,509) +2.000_r8*rxt(k,172)*y(k,113) + & - rxt(k,175)*y(k,132) +rxt(k,491)*y(k,151))*y(k,124) + (rxt(k,174) + & - rxt(k,182)*y(k,243))*y(k,113) +2.000_r8*rxt(k,186)*y(k,242)*y(k,114) & - +rxt(k,13)*y(k,115) +rxt(k,17)*y(k,125) - loss(k,217) = (rxt(k,239)* y(k,19) +rxt(k,208)* y(k,59) + (rxt(k,171) + & - rxt(k,172) +rxt(k,173))* y(k,113) +rxt(k,189)* y(k,125) & - + (rxt(k,175) +rxt(k,177))* y(k,132) +rxt(k,176)* y(k,133) & - +rxt(k,442)* y(k,140) +rxt(k,491)* y(k,151) +rxt(k,445)* y(k,219) & - +rxt(k,325)* y(k,226) +rxt(k,432)* y(k,228) +rxt(k,188)* y(k,232) & - +rxt(k,435)* y(k,237) +rxt(k,374)* y(k,238) +rxt(k,438)* y(k,239) & - +rxt(k,190)* y(k,243) + rxt(k,16) + rxt(k,509) + het_rates(k,124)) & - * y(k,124) - prod(k,217) = (2.000_r8*rxt(k,179)*y(k,125) +rxt(k,183)*y(k,232) + & - rxt(k,184)*y(k,133) +rxt(k,185)*y(k,132) +rxt(k,206)*y(k,59) + & - rxt(k,238)*y(k,19) +rxt(k,281)*y(k,227) +rxt(k,290)*y(k,233) + & - rxt(k,303)*y(k,223) +rxt(k,314)*y(k,226) +rxt(k,318)*y(k,231) + & - rxt(k,331)*y(k,224) +rxt(k,339)*y(k,245) +rxt(k,343)*y(k,246) + & - rxt(k,349)*y(k,229) +rxt(k,356)*y(k,236) +rxt(k,365)*y(k,238) + & - rxt(k,368)*y(k,240) +rxt(k,378)*y(k,220) + & - .920_r8*rxt(k,388)*y(k,234) +.920_r8*rxt(k,394)*y(k,235) + & - rxt(k,402)*y(k,101) +rxt(k,413)*y(k,250) +rxt(k,417)*y(k,219) + & - rxt(k,420)*y(k,221) +rxt(k,425)*y(k,222) +rxt(k,427)*y(k,225) + & - rxt(k,431)*y(k,228) +rxt(k,434)*y(k,237) +rxt(k,437)*y(k,239) + & - rxt(k,440)*y(k,244) +rxt(k,447)*y(k,249) +rxt(k,453)*y(k,251) + & - rxt(k,456)*y(k,252) +1.600_r8*rxt(k,467)*y(k,241) + & - .900_r8*rxt(k,472)*y(k,247) +.800_r8*rxt(k,477)*y(k,248))*y(k,123) & - + (rxt(k,18) +rxt(k,178)*y(k,232) +rxt(k,180)*y(k,132) + & - rxt(k,181)*y(k,243) +rxt(k,347)*y(k,16) +rxt(k,355)*y(k,236) + & - rxt(k,366)*y(k,238) +rxt(k,389)*y(k,234) +rxt(k,395)*y(k,235) + & - rxt(k,403)*y(k,101) +rxt(k,414)*y(k,250) + & - 2.000_r8*rxt(k,468)*y(k,241))*y(k,125) + (rxt(k,169)*y(k,90) + & - rxt(k,337)*y(k,126) +rxt(k,376)*y(k,1) +.700_r8*rxt(k,396)*y(k,99) + & - rxt(k,474)*y(k,206))*y(k,243) + (rxt(k,11) +rxt(k,192))*y(k,90) & - + (rxt(k,54) +rxt(k,375))*y(k,110) + (rxt(k,14) +rxt(k,193)) & - *y(k,115) + (.600_r8*rxt(k,60) +rxt(k,326))*y(k,138) +rxt(k,19) & - *y(k,1) +rxt(k,76)*y(k,20) +rxt(k,94)*y(k,60) +rxt(k,9)*y(k,89) & - +rxt(k,45)*y(k,93) +rxt(k,48)*y(k,102) +rxt(k,56)*y(k,117) & - +rxt(k,57)*y(k,126) +rxt(k,58)*y(k,127) +rxt(k,59)*y(k,137) & - +rxt(k,450)*y(k,139) +rxt(k,66)*y(k,206) & - +.500_r8*rxt(k,465)*y(k,241)*y(k,227) - loss(k,218) = (rxt(k,459)* y(k,6) +rxt(k,347)* y(k,16) +rxt(k,327)* y(k,29) & - +rxt(k,275)* y(k,42) +rxt(k,308)* y(k,45) +rxt(k,334)* y(k,49) & - +rxt(k,482)* y(k,67) +rxt(k,398)* y(k,98) +rxt(k,403)* y(k,101) & - +rxt(k,462)* y(k,111) +rxt(k,179)* y(k,123) +rxt(k,189)* y(k,124) & - +rxt(k,180)* y(k,132) +rxt(k,479)* y(k,208) +rxt(k,178)* y(k,232) & - +rxt(k,389)* y(k,234) +rxt(k,395)* y(k,235) +rxt(k,355)* y(k,236) & - +rxt(k,366)* y(k,238) +rxt(k,468)* y(k,241) +rxt(k,181)* y(k,243) & - +rxt(k,414)* y(k,250) + rxt(k,17) + rxt(k,18) + rxt(k,510) & - + het_rates(k,125))* y(k,125) - prod(k,218) = (rxt(k,95) +rxt(k,207)*y(k,56) +rxt(k,209)*y(k,132) + & - rxt(k,210)*y(k,243))*y(k,60) + (rxt(k,13) +rxt(k,14) +rxt(k,193)) & - *y(k,115) + (rxt(k,191)*y(k,89) +rxt(k,323)*y(k,138) + & - .500_r8*rxt(k,371)*y(k,110))*y(k,243) + (rxt(k,77) + & - rxt(k,240)*y(k,132))*y(k,20) + (rxt(k,176)*y(k,133) + & - rxt(k,177)*y(k,132))*y(k,124) +rxt(k,254)*y(k,89)*y(k,73) +rxt(k,10) & - *y(k,90) +.400_r8*rxt(k,60)*y(k,138) - loss(k,173) = (rxt(k,337)* y(k,243) + rxt(k,57) + het_rates(k,126))* y(k,126) - prod(k,173) = (.500_r8*rxt(k,397)*y(k,100) +rxt(k,404)*y(k,102) + & - rxt(k,408)*y(k,116) +rxt(k,409)*y(k,117))*y(k,243) & - +rxt(k,327)*y(k,125)*y(k,29) - loss(k,119) = (rxt(k,469)* y(k,243) + rxt(k,58) + rxt(k,511) & - + het_rates(k,127))* y(k,127) - prod(k,119) =rxt(k,466)*y(k,241)*y(k,232) - loss(k,10) = ( + het_rates(k,128))* y(k,128) + prod(k,219) = (rxt(k,398)*y(k,234) +.800_r8*rxt(k,399)*y(k,235) + & + rxt(k,401)*y(k,129) +rxt(k,402)*y(k,131))*y(k,103) + loss(k,10) = ( + het_rates(k,124))* y(k,124) prod(k,10) = 0._r8 - loss(k,11) = ( + het_rates(k,129))* y(k,129) + loss(k,11) = ( + het_rates(k,125))* y(k,125) prod(k,11) = 0._r8 - loss(k,12) = ( + het_rates(k,130))* y(k,130) + loss(k,12) = ( + het_rates(k,126))* y(k,126) prod(k,12) = 0._r8 - loss(k,13) = ( + het_rates(k,131))* y(k,131) + loss(k,84) = (rxt(k,498)* y(k,251) + het_rates(k,127))* y(k,127) + prod(k,84) = 0._r8 + loss(k,13) = ( + rxt(k,506) + het_rates(k,128))* y(k,128) prod(k,13) = 0._r8 - loss(k,223) = (rxt(k,241)* y(k,19) +rxt(k,240)* y(k,20) +rxt(k,276)* y(k,42) & - +rxt(k,211)* y(k,59) +rxt(k,209)* y(k,60) +rxt(k,152)* y(k,77) & - +rxt(k,153)* y(k,79) +rxt(k,243)* y(k,81) +rxt(k,214)* y(k,85) & - +rxt(k,245)* y(k,91) +rxt(k,217)* y(k,92) +rxt(k,185)* y(k,123) & - + (rxt(k,175) +rxt(k,177))* y(k,124) +rxt(k,180)* y(k,125) & - + 2._r8*rxt(k,150)* y(k,132) +rxt(k,149)* y(k,133) +rxt(k,484) & - * y(k,136) +rxt(k,158)* y(k,232) +rxt(k,164)* y(k,243) + rxt(k,151) & - + het_rates(k,132))* y(k,132) - prod(k,223) = (rxt(k,174) +rxt(k,170)*y(k,123) +rxt(k,171)*y(k,124))*y(k,113) & - + (rxt(k,111) +rxt(k,492))*y(k,151) + (rxt(k,146) +rxt(k,147)) & - *y(k,242) +rxt(k,75)*y(k,19) +rxt(k,93)*y(k,59) +rxt(k,156)*y(k,232) & - *y(k,76) +rxt(k,13)*y(k,115) +rxt(k,15)*y(k,123) +rxt(k,16)*y(k,124) & - +rxt(k,18)*y(k,125) +rxt(k,8)*y(k,133) +rxt(k,107)*y(k,135) & - +rxt(k,486)*y(k,149) +rxt(k,112)*y(k,152) +rxt(k,113)*y(k,153) & - +rxt(k,166)*y(k,243)*y(k,243) +rxt(k,3)*y(k,253) - loss(k,220) = (rxt(k,460)* y(k,6) +rxt(k,232)* y(k,17) +rxt(k,299)* y(k,25) & - +rxt(k,328)* y(k,29) +rxt(k,200)* y(k,56) +rxt(k,160)* y(k,76) & - +rxt(k,405)* y(k,98) +rxt(k,358)* y(k,106) +rxt(k,463)* y(k,111) & - +rxt(k,372)* y(k,112) +rxt(k,184)* y(k,123) +rxt(k,176)* y(k,124) & - +rxt(k,149)* y(k,132) +rxt(k,443)* y(k,140) +rxt(k,487)* y(k,149) & - +rxt(k,493)* y(k,151) +rxt(k,159)* y(k,232) +rxt(k,148)* y(k,242) & - +rxt(k,165)* y(k,243) + rxt(k,7) + rxt(k,8) + het_rates(k,133)) & - * y(k,133) - prod(k,220) = (.150_r8*rxt(k,313)*y(k,226) +.150_r8*rxt(k,363)*y(k,238)) & - *y(k,232) +rxt(k,151)*y(k,132) - loss(k,107) = (rxt(k,494)* y(k,151) + rxt(k,107) + het_rates(k,135)) & - * y(k,135) - prod(k,107) = (rxt(k,204)*y(k,59) +rxt(k,234)*y(k,19))*y(k,59) - loss(k,115) = (rxt(k,484)* y(k,132) +rxt(k,485)* y(k,243) + rxt(k,110) & - + het_rates(k,136))* y(k,136) - prod(k,115) = 0._r8 - loss(k,91) = ( + rxt(k,59) + rxt(k,512) + het_rates(k,137))* y(k,137) - prod(k,91) =rxt(k,351)*y(k,243)*y(k,93) +.100_r8*rxt(k,472)*y(k,247)*y(k,123) - loss(k,132) = (rxt(k,323)* y(k,243) + rxt(k,60) + rxt(k,326) & - + het_rates(k,138))* y(k,138) - prod(k,132) =rxt(k,325)*y(k,226)*y(k,124) - loss(k,75) = ( + rxt(k,450) + het_rates(k,139))* y(k,139) - prod(k,75) =rxt(k,445)*y(k,219)*y(k,124) - loss(k,131) = (rxt(k,442)* y(k,124) +rxt(k,443)* y(k,133) + het_rates(k,140)) & - * y(k,140) - prod(k,131) = (.070_r8*rxt(k,429)*y(k,66) +.060_r8*rxt(k,441)*y(k,141) + & - .070_r8*rxt(k,457)*y(k,215))*y(k,243) +rxt(k,31)*y(k,32) & - +rxt(k,427)*y(k,225)*y(k,123) - loss(k,81) = (rxt(k,441)* y(k,243) + het_rates(k,141))* y(k,141) - prod(k,81) =.530_r8*rxt(k,418)*y(k,243)*y(k,7) - loss(k,108) = (rxt(k,444)* y(k,243) + rxt(k,61) + het_rates(k,142))* y(k,142) - prod(k,108) =rxt(k,439)*y(k,244)*y(k,232) - loss(k,14) = ( + het_rates(k,143))* y(k,143) + loss(k,245) = (rxt(k,238)* y(k,21) +rxt(k,206)* y(k,61) +rxt(k,401)* y(k,103) & + +rxt(k,170)* y(k,119) +rxt(k,179)* y(k,131) +rxt(k,185)* y(k,138) & + +rxt(k,184)* y(k,139) +rxt(k,416)* y(k,227) + (rxt(k,377) + & + rxt(k,378))* y(k,228) +rxt(k,419)* y(k,229) +rxt(k,424)* y(k,230) & + +rxt(k,302)* y(k,231) +rxt(k,330)* y(k,232) +rxt(k,426)* y(k,233) & + +rxt(k,313)* y(k,234) +rxt(k,281)* y(k,235) +rxt(k,430)* y(k,236) & + + (rxt(k,348) +rxt(k,349))* y(k,237) +rxt(k,317)* y(k,239) & + +rxt(k,183)* y(k,240) +rxt(k,289)* y(k,241) +rxt(k,387)* y(k,242) & + +rxt(k,393)* y(k,243) + (rxt(k,355) +rxt(k,356))* y(k,244) & + +rxt(k,433)* y(k,245) +rxt(k,364)* y(k,246) +rxt(k,436)* y(k,247) & + +rxt(k,367)* y(k,248) +rxt(k,466)* y(k,249) +rxt(k,439)* y(k,252) & + +rxt(k,338)* y(k,253) +rxt(k,342)* y(k,254) +rxt(k,471)* y(k,255) & + +rxt(k,476)* y(k,256) +rxt(k,446)* y(k,257) +rxt(k,412)* y(k,258) & + +rxt(k,452)* y(k,259) +rxt(k,455)* y(k,260) + rxt(k,15) & + + het_rates(k,129))* y(k,129) + prod(k,245) = (rxt(k,16) +.500_r8*rxt(k,507) +2.000_r8*rxt(k,172)*y(k,119) + & + rxt(k,175)*y(k,138) +rxt(k,491)*y(k,157))*y(k,130) + (rxt(k,174) + & + rxt(k,182)*y(k,251))*y(k,119) +2.000_r8*rxt(k,186)*y(k,250)*y(k,120) & + +rxt(k,13)*y(k,121) +rxt(k,17)*y(k,131) + loss(k,247) = (rxt(k,239)* y(k,21) +rxt(k,208)* y(k,61) + (rxt(k,171) + & + rxt(k,172) +rxt(k,173))* y(k,119) +rxt(k,189)* y(k,131) & + + (rxt(k,175) +rxt(k,177))* y(k,138) +rxt(k,176)* y(k,139) & + +rxt(k,441)* y(k,146) +rxt(k,491)* y(k,157) +rxt(k,444)* y(k,227) & + +rxt(k,324)* y(k,234) +rxt(k,431)* y(k,236) +rxt(k,188)* y(k,240) & + +rxt(k,434)* y(k,245) +rxt(k,373)* y(k,246) +rxt(k,437)* y(k,247) & + +rxt(k,190)* y(k,251) + rxt(k,16) + rxt(k,507) + het_rates(k,130)) & + * y(k,130) + prod(k,247) = (2.000_r8*rxt(k,179)*y(k,131) +rxt(k,183)*y(k,240) + & + rxt(k,184)*y(k,139) +rxt(k,185)*y(k,138) +rxt(k,206)*y(k,61) + & + rxt(k,238)*y(k,21) +rxt(k,281)*y(k,235) +rxt(k,289)*y(k,241) + & + rxt(k,302)*y(k,231) +rxt(k,313)*y(k,234) +rxt(k,317)*y(k,239) + & + rxt(k,330)*y(k,232) +rxt(k,338)*y(k,253) +rxt(k,342)*y(k,254) + & + rxt(k,348)*y(k,237) +rxt(k,355)*y(k,244) +rxt(k,364)*y(k,246) + & + rxt(k,367)*y(k,248) +rxt(k,377)*y(k,228) + & + .920_r8*rxt(k,387)*y(k,242) +.920_r8*rxt(k,393)*y(k,243) + & + rxt(k,401)*y(k,103) +rxt(k,412)*y(k,258) +rxt(k,416)*y(k,227) + & + rxt(k,419)*y(k,229) +rxt(k,424)*y(k,230) +rxt(k,426)*y(k,233) + & + rxt(k,430)*y(k,236) +rxt(k,433)*y(k,245) +rxt(k,436)*y(k,247) + & + rxt(k,439)*y(k,252) +rxt(k,446)*y(k,257) +rxt(k,452)*y(k,259) + & + rxt(k,455)*y(k,260) +1.600_r8*rxt(k,466)*y(k,249) + & + .900_r8*rxt(k,471)*y(k,255) +.800_r8*rxt(k,476)*y(k,256))*y(k,129) & + + (rxt(k,18) +rxt(k,178)*y(k,240) +rxt(k,180)*y(k,138) + & + rxt(k,181)*y(k,251) +rxt(k,346)*y(k,18) +rxt(k,354)*y(k,244) + & + rxt(k,365)*y(k,246) +rxt(k,388)*y(k,242) +rxt(k,394)*y(k,243) + & + rxt(k,402)*y(k,103) +rxt(k,413)*y(k,258) + & + 2.000_r8*rxt(k,467)*y(k,249))*y(k,131) + (rxt(k,169)*y(k,92) + & + rxt(k,336)*y(k,132) +rxt(k,375)*y(k,1) +.700_r8*rxt(k,395)*y(k,101) + & + rxt(k,473)*y(k,212))*y(k,251) + (rxt(k,11) +rxt(k,192))*y(k,92) & + + (rxt(k,54) +rxt(k,374))*y(k,115) + (rxt(k,14) +rxt(k,193)) & + *y(k,121) + (.600_r8*rxt(k,60) +rxt(k,325))*y(k,144) +rxt(k,19) & + *y(k,1) +rxt(k,76)*y(k,22) +rxt(k,94)*y(k,62) +rxt(k,9)*y(k,91) & + +rxt(k,45)*y(k,95) +rxt(k,48)*y(k,104) +rxt(k,56)*y(k,123) & + +rxt(k,57)*y(k,132) +rxt(k,58)*y(k,133) +rxt(k,59)*y(k,143) & + +rxt(k,449)*y(k,145) +rxt(k,66)*y(k,212) & + +.500_r8*rxt(k,464)*y(k,249)*y(k,235) + loss(k,254) = (rxt(k,458)* y(k,6) +rxt(k,346)* y(k,18) +rxt(k,326)* y(k,31) & + +rxt(k,275)* y(k,44) +rxt(k,307)* y(k,47) +rxt(k,333)* y(k,51) & + +rxt(k,481)* y(k,69) +rxt(k,397)* y(k,100) +rxt(k,402)* y(k,103) & + +rxt(k,461)* y(k,116) +rxt(k,179)* y(k,129) +rxt(k,189)* y(k,130) & + +rxt(k,180)* y(k,138) +rxt(k,478)* y(k,214) +rxt(k,178)* y(k,240) & + +rxt(k,388)* y(k,242) +rxt(k,394)* y(k,243) +rxt(k,354)* y(k,244) & + +rxt(k,365)* y(k,246) +rxt(k,467)* y(k,249) +rxt(k,181)* y(k,251) & + +rxt(k,413)* y(k,258) + rxt(k,17) + rxt(k,18) + rxt(k,508) & + + het_rates(k,131))* y(k,131) + prod(k,254) = (rxt(k,95) +rxt(k,207)*y(k,58) +rxt(k,209)*y(k,138) + & + rxt(k,210)*y(k,251))*y(k,62) + (rxt(k,13) +rxt(k,14) +rxt(k,193)) & + *y(k,121) + (rxt(k,191)*y(k,91) +rxt(k,322)*y(k,144) + & + .500_r8*rxt(k,370)*y(k,115))*y(k,251) + (rxt(k,77) + & + rxt(k,240)*y(k,138))*y(k,22) + (rxt(k,176)*y(k,139) + & + rxt(k,177)*y(k,138))*y(k,130) +rxt(k,254)*y(k,91)*y(k,75) +rxt(k,10) & + *y(k,92) +.400_r8*rxt(k,60)*y(k,144) + loss(k,205) = (rxt(k,336)* y(k,251) + rxt(k,57) + het_rates(k,132))* y(k,132) + prod(k,205) = (.500_r8*rxt(k,396)*y(k,102) +rxt(k,403)*y(k,104) + & + rxt(k,407)*y(k,122) +rxt(k,408)*y(k,123))*y(k,251) & + +rxt(k,326)*y(k,131)*y(k,31) + loss(k,153) = (rxt(k,468)* y(k,251) + rxt(k,58) + rxt(k,509) & + + het_rates(k,133))* y(k,133) + prod(k,153) =rxt(k,465)*y(k,249)*y(k,240) + loss(k,14) = ( + het_rates(k,134))* y(k,134) prod(k,14) = 0._r8 - loss(k,15) = ( + het_rates(k,144))* y(k,144) + loss(k,15) = ( + het_rates(k,135))* y(k,135) prod(k,15) = 0._r8 - loss(k,16) = ( + het_rates(k,145))* y(k,145) + loss(k,16) = ( + het_rates(k,136))* y(k,136) prod(k,16) = 0._r8 - loss(k,17) = ( + het_rates(k,146))* y(k,146) + loss(k,17) = ( + het_rates(k,137))* y(k,137) prod(k,17) = 0._r8 - loss(k,140) = (rxt(k,340)* y(k,243) + rxt(k,62) + het_rates(k,147))* y(k,147) - prod(k,140) =rxt(k,338)*y(k,245)*y(k,232) - loss(k,117) = (rxt(k,344)* y(k,243) + rxt(k,63) + het_rates(k,148))* y(k,148) - prod(k,117) =.850_r8*rxt(k,342)*y(k,246)*y(k,232) - loss(k,137) = (rxt(k,487)* y(k,133) +rxt(k,490)* y(k,243) + rxt(k,486) & - + het_rates(k,149))* y(k,149) - prod(k,137) =rxt(k,110)*y(k,136) +rxt(k,111)*y(k,151) - loss(k,201) = (rxt(k,488)* y(k,19) +rxt(k,489)* y(k,59) +rxt(k,491)* y(k,124) & - +rxt(k,493)* y(k,133) +rxt(k,494)* y(k,135) +rxt(k,495)* y(k,243) & - + rxt(k,111) + rxt(k,492) + het_rates(k,151))* y(k,151) - prod(k,201) = (rxt(k,486) +rxt(k,487)*y(k,133) +rxt(k,490)*y(k,243))*y(k,149) & - +rxt(k,484)*y(k,136)*y(k,132) +rxt(k,112)*y(k,152) - loss(k,174) = (rxt(k,497)* y(k,243) + rxt(k,112) + het_rates(k,152)) & - * y(k,152) - prod(k,174) = (rxt(k,492) +rxt(k,488)*y(k,19) +rxt(k,489)*y(k,59) + & - rxt(k,491)*y(k,124) +rxt(k,493)*y(k,133) +rxt(k,494)*y(k,135) + & - rxt(k,495)*y(k,243))*y(k,151) + (rxt(k,482)*y(k,125) + & - rxt(k,483)*y(k,243) +.500_r8*rxt(k,496)*y(k,243))*y(k,67) & - +rxt(k,485)*y(k,243)*y(k,136) +rxt(k,113)*y(k,153) - loss(k,97) = (rxt(k,498)* y(k,253) + rxt(k,113) + het_rates(k,153))* y(k,153) - prod(k,97) =rxt(k,109)*y(k,80) +rxt(k,497)*y(k,243)*y(k,152) - loss(k,18) = ( + het_rates(k,154))* y(k,154) + loss(k,252) = (rxt(k,241)* y(k,21) +rxt(k,240)* y(k,22) +rxt(k,276)* y(k,44) & + +rxt(k,211)* y(k,61) +rxt(k,209)* y(k,62) +rxt(k,152)* y(k,79) & + +rxt(k,153)* y(k,81) +rxt(k,243)* y(k,83) +rxt(k,214)* y(k,87) & + +rxt(k,245)* y(k,93) +rxt(k,217)* y(k,94) +rxt(k,185)* y(k,129) & + + (rxt(k,175) +rxt(k,177))* y(k,130) +rxt(k,180)* y(k,131) & + + 2._r8*rxt(k,150)* y(k,138) +rxt(k,149)* y(k,139) +rxt(k,483) & + * y(k,142) +rxt(k,158)* y(k,240) +rxt(k,164)* y(k,251) + rxt(k,151) & + + het_rates(k,138))* y(k,138) + prod(k,252) = (rxt(k,174) +rxt(k,170)*y(k,129) +rxt(k,171)*y(k,130))*y(k,119) & + + (rxt(k,111) +rxt(k,492))*y(k,157) + (rxt(k,146) +rxt(k,147)) & + *y(k,250) +rxt(k,75)*y(k,21) +.180_r8*rxt(k,39)*y(k,56) +rxt(k,93) & + *y(k,61) +rxt(k,41)*y(k,65) +rxt(k,156)*y(k,240)*y(k,78) +rxt(k,13) & + *y(k,121) +rxt(k,15)*y(k,129) +rxt(k,16)*y(k,130) +rxt(k,18)*y(k,131) & + +rxt(k,8)*y(k,139) +rxt(k,107)*y(k,141) +rxt(k,485)*y(k,155) & + +rxt(k,112)*y(k,158) +rxt(k,113)*y(k,159) +rxt(k,166)*y(k,251) & + *y(k,251) +rxt(k,3)*y(k,261) + loss(k,258) = (rxt(k,459)* y(k,6) +rxt(k,232)* y(k,19) +rxt(k,298)* y(k,27) & + +rxt(k,327)* y(k,31) +rxt(k,200)* y(k,58) +rxt(k,160)* y(k,78) & + +rxt(k,404)* y(k,100) +rxt(k,357)* y(k,111) +rxt(k,462)* y(k,116) & + +rxt(k,371)* y(k,118) +rxt(k,184)* y(k,129) +rxt(k,176)* y(k,130) & + +rxt(k,149)* y(k,138) +rxt(k,442)* y(k,146) +rxt(k,487)* y(k,155) & + +rxt(k,493)* y(k,157) +rxt(k,159)* y(k,240) +rxt(k,148)* y(k,250) & + +rxt(k,165)* y(k,251) + rxt(k,7) + rxt(k,8) + het_rates(k,139)) & + * y(k,139) + prod(k,258) = (.150_r8*rxt(k,312)*y(k,234) +.150_r8*rxt(k,362)*y(k,246)) & + *y(k,240) +rxt(k,151)*y(k,138) + loss(k,18) = ( + het_rates(k,140))* y(k,140) prod(k,18) = 0._r8 - loss(k,19) = ( + het_rates(k,155))* y(k,155) + loss(k,136) = (rxt(k,494)* y(k,157) + rxt(k,107) + het_rates(k,141)) & + * y(k,141) + prod(k,136) = (rxt(k,204)*y(k,61) +rxt(k,234)*y(k,21))*y(k,61) + loss(k,142) = (rxt(k,483)* y(k,138) +rxt(k,484)* y(k,251) + rxt(k,110) & + + het_rates(k,142))* y(k,142) + prod(k,142) = 0._r8 + loss(k,117) = ( + rxt(k,59) + rxt(k,510) + het_rates(k,143))* y(k,143) + prod(k,117) =rxt(k,350)*y(k,251)*y(k,95) +.100_r8*rxt(k,471)*y(k,255) & + *y(k,129) + loss(k,169) = (rxt(k,322)* y(k,251) + rxt(k,60) + rxt(k,325) & + + het_rates(k,144))* y(k,144) + prod(k,169) =rxt(k,324)*y(k,234)*y(k,130) + loss(k,95) = ( + rxt(k,449) + het_rates(k,145))* y(k,145) + prod(k,95) =rxt(k,444)*y(k,227)*y(k,130) + loss(k,161) = (rxt(k,441)* y(k,130) +rxt(k,442)* y(k,139) + het_rates(k,146)) & + * y(k,146) + prod(k,161) = (.070_r8*rxt(k,428)*y(k,68) +.060_r8*rxt(k,440)*y(k,147) + & + .070_r8*rxt(k,456)*y(k,223))*y(k,251) +rxt(k,31)*y(k,34) & + +rxt(k,426)*y(k,233)*y(k,129) + loss(k,105) = (rxt(k,440)* y(k,251) + het_rates(k,147))* y(k,147) + prod(k,105) =.530_r8*rxt(k,417)*y(k,251)*y(k,8) + loss(k,137) = (rxt(k,443)* y(k,251) + rxt(k,61) + het_rates(k,148))* y(k,148) + prod(k,137) =rxt(k,438)*y(k,252)*y(k,240) + loss(k,19) = ( + het_rates(k,149))* y(k,149) prod(k,19) = 0._r8 - loss(k,20) = ( + het_rates(k,156))* y(k,156) + loss(k,20) = ( + het_rates(k,150))* y(k,150) prod(k,20) = 0._r8 - loss(k,21) = ( + rxt(k,114) + het_rates(k,157))* y(k,157) + loss(k,21) = ( + het_rates(k,151))* y(k,151) prod(k,21) = 0._r8 - loss(k,22) = ( + rxt(k,115) + het_rates(k,158))* y(k,158) + loss(k,22) = ( + het_rates(k,152))* y(k,152) prod(k,22) = 0._r8 - loss(k,23) = ( + rxt(k,116) + het_rates(k,159))* y(k,159) + loss(k,172) = (rxt(k,339)* y(k,251) + rxt(k,62) + het_rates(k,153))* y(k,153) + prod(k,172) =rxt(k,337)*y(k,253)*y(k,240) + loss(k,145) = (rxt(k,343)* y(k,251) + rxt(k,63) + het_rates(k,154))* y(k,154) + prod(k,145) =.850_r8*rxt(k,341)*y(k,254)*y(k,240) + loss(k,168) = (rxt(k,487)* y(k,139) +rxt(k,490)* y(k,251) + rxt(k,485) & + + het_rates(k,155))* y(k,155) + prod(k,168) =rxt(k,110)*y(k,142) +rxt(k,111)*y(k,157) + loss(k,23) = ( + rxt(k,108) + het_rates(k,156))* y(k,156) prod(k,23) = 0._r8 - loss(k,24) = ( + rxt(k,117) + het_rates(k,160))* y(k,160) + loss(k,233) = (rxt(k,488)* y(k,21) +rxt(k,489)* y(k,61) +rxt(k,491)* y(k,130) & + +rxt(k,493)* y(k,139) +rxt(k,494)* y(k,141) +rxt(k,495)* y(k,251) & + + rxt(k,111) + rxt(k,492) + het_rates(k,157))* y(k,157) + prod(k,233) = (rxt(k,485) +rxt(k,487)*y(k,139) +rxt(k,490)*y(k,251))*y(k,155) & + +rxt(k,483)*y(k,142)*y(k,138) +rxt(k,112)*y(k,158) + loss(k,206) = (rxt(k,486)* y(k,251) + rxt(k,112) + het_rates(k,158)) & + * y(k,158) + prod(k,206) = (rxt(k,492) +rxt(k,488)*y(k,21) +rxt(k,489)*y(k,61) + & + rxt(k,491)*y(k,130) +rxt(k,493)*y(k,139) +rxt(k,494)*y(k,141) + & + rxt(k,495)*y(k,251))*y(k,157) + (rxt(k,481)*y(k,131) + & + rxt(k,482)*y(k,251) +.500_r8*rxt(k,496)*y(k,251))*y(k,69) & + +rxt(k,484)*y(k,251)*y(k,142) +rxt(k,113)*y(k,159) + loss(k,123) = (rxt(k,497)* y(k,261) + rxt(k,113) + het_rates(k,159)) & + * y(k,159) + prod(k,123) =rxt(k,109)*y(k,82) +rxt(k,486)*y(k,251)*y(k,158) + loss(k,24) = ( + het_rates(k,160))* y(k,160) prod(k,24) = 0._r8 - loss(k,25) = ( + rxt(k,118) + het_rates(k,161))* y(k,161) + loss(k,25) = ( + het_rates(k,161))* y(k,161) prod(k,25) = 0._r8 - loss(k,26) = ( + rxt(k,119) + het_rates(k,162))* y(k,162) + loss(k,26) = ( + het_rates(k,162))* y(k,162) prod(k,26) = 0._r8 - loss(k,27) = ( + rxt(k,120) + het_rates(k,163))* y(k,163) + loss(k,27) = ( + rxt(k,114) + het_rates(k,163))* y(k,163) prod(k,27) = 0._r8 - loss(k,28) = ( + rxt(k,121) + het_rates(k,164))* y(k,164) + loss(k,28) = ( + rxt(k,115) + het_rates(k,164))* y(k,164) prod(k,28) = 0._r8 - loss(k,29) = ( + rxt(k,122) + het_rates(k,165))* y(k,165) + loss(k,29) = ( + rxt(k,116) + het_rates(k,165))* y(k,165) prod(k,29) = 0._r8 - loss(k,30) = ( + rxt(k,123) + het_rates(k,166))* y(k,166) + loss(k,30) = ( + rxt(k,117) + het_rates(k,166))* y(k,166) prod(k,30) = 0._r8 - loss(k,31) = ( + rxt(k,124) + het_rates(k,167))* y(k,167) + loss(k,31) = ( + rxt(k,118) + het_rates(k,167))* y(k,167) prod(k,31) = 0._r8 - loss(k,32) = ( + rxt(k,125) + het_rates(k,168))* y(k,168) + loss(k,32) = ( + rxt(k,119) + het_rates(k,168))* y(k,168) prod(k,32) = 0._r8 - loss(k,33) = ( + rxt(k,126) + het_rates(k,169))* y(k,169) + loss(k,33) = ( + rxt(k,120) + het_rates(k,169))* y(k,169) prod(k,33) = 0._r8 - loss(k,34) = ( + rxt(k,127) + het_rates(k,170))* y(k,170) + loss(k,34) = ( + rxt(k,121) + het_rates(k,170))* y(k,170) prod(k,34) = 0._r8 - loss(k,35) = ( + rxt(k,128) + het_rates(k,171))* y(k,171) + loss(k,35) = ( + rxt(k,122) + het_rates(k,171))* y(k,171) prod(k,35) = 0._r8 - loss(k,36) = ( + rxt(k,129) + het_rates(k,172))* y(k,172) + loss(k,36) = ( + rxt(k,123) + het_rates(k,172))* y(k,172) prod(k,36) = 0._r8 - loss(k,37) = ( + rxt(k,130) + het_rates(k,173))* y(k,173) + loss(k,37) = ( + rxt(k,124) + het_rates(k,173))* y(k,173) prod(k,37) = 0._r8 - loss(k,38) = ( + rxt(k,131) + het_rates(k,174))* y(k,174) + loss(k,38) = ( + rxt(k,125) + het_rates(k,174))* y(k,174) prod(k,38) = 0._r8 - loss(k,39) = ( + rxt(k,132) + het_rates(k,175))* y(k,175) + loss(k,39) = ( + rxt(k,126) + het_rates(k,175))* y(k,175) prod(k,39) = 0._r8 - loss(k,40) = ( + rxt(k,133) + het_rates(k,176))* y(k,176) + loss(k,40) = ( + rxt(k,127) + het_rates(k,176))* y(k,176) prod(k,40) = 0._r8 - loss(k,41) = ( + rxt(k,134) + het_rates(k,177))* y(k,177) + loss(k,41) = ( + rxt(k,128) + het_rates(k,177))* y(k,177) prod(k,41) = 0._r8 - loss(k,42) = ( + rxt(k,135) + het_rates(k,178))* y(k,178) + loss(k,42) = ( + rxt(k,129) + het_rates(k,178))* y(k,178) prod(k,42) = 0._r8 - loss(k,43) = ( + rxt(k,136) + het_rates(k,179))* y(k,179) + loss(k,43) = ( + rxt(k,130) + het_rates(k,179))* y(k,179) prod(k,43) = 0._r8 - loss(k,44) = ( + rxt(k,137) + het_rates(k,180))* y(k,180) + loss(k,44) = ( + rxt(k,131) + het_rates(k,180))* y(k,180) prod(k,44) = 0._r8 - loss(k,45) = ( + rxt(k,138) + het_rates(k,181))* y(k,181) + loss(k,45) = ( + rxt(k,132) + het_rates(k,181))* y(k,181) prod(k,45) = 0._r8 - loss(k,46) = ( + rxt(k,139) + het_rates(k,182))* y(k,182) + loss(k,46) = ( + rxt(k,133) + het_rates(k,182))* y(k,182) prod(k,46) = 0._r8 - loss(k,47) = ( + rxt(k,140) + het_rates(k,183))* y(k,183) + loss(k,47) = ( + rxt(k,134) + het_rates(k,183))* y(k,183) prod(k,47) = 0._r8 - loss(k,48) = ( + rxt(k,141) + het_rates(k,184))* y(k,184) + loss(k,48) = ( + rxt(k,135) + het_rates(k,184))* y(k,184) prod(k,48) = 0._r8 - loss(k,49) = ( + rxt(k,142) + het_rates(k,185))* y(k,185) + loss(k,49) = ( + rxt(k,136) + het_rates(k,185))* y(k,185) prod(k,49) = 0._r8 - loss(k,50) = ( + rxt(k,143) + het_rates(k,186))* y(k,186) + loss(k,50) = ( + rxt(k,137) + het_rates(k,186))* y(k,186) prod(k,50) = 0._r8 - loss(k,51) = ( + het_rates(k,187))* y(k,187) - prod(k,51) = (.2381005_r8*rxt(k,521)*y(k,104) + & - .5931005_r8*rxt(k,526)*y(k,202))*y(k,243) - loss(k,52) = ( + het_rates(k,188))* y(k,188) - prod(k,52) = (.1308005_r8*rxt(k,521)*y(k,104) + & - .1534005_r8*rxt(k,526)*y(k,202))*y(k,243) - loss(k,53) = ( + het_rates(k,189))* y(k,189) - prod(k,53) = (.0348005_r8*rxt(k,521)*y(k,104) + & - .0459005_r8*rxt(k,526)*y(k,202))*y(k,243) - loss(k,54) = ( + het_rates(k,190))* y(k,190) - prod(k,54) = (.0076005_r8*rxt(k,521)*y(k,104) + & - .0085005_r8*rxt(k,526)*y(k,202))*y(k,243) - loss(k,55) = ( + het_rates(k,191))* y(k,191) - prod(k,55) = (.0113005_r8*rxt(k,521)*y(k,104) + & - .0128005_r8*rxt(k,526)*y(k,202))*y(k,243) - loss(k,57) = ( + het_rates(k,192))* y(k,192) - prod(k,57) = (.2202005_r8*rxt(k,516)*y(k,6) +.0031005_r8*rxt(k,520)*y(k,98) + & - .0508005_r8*rxt(k,525)*y(k,111))*y(k,243) & - + (.2202005_r8*rxt(k,515)*y(k,6) +.0508005_r8*rxt(k,524)*y(k,111)) & - *y(k,133) +rxt(k,500)*y(k,75) - loss(k,58) = ( + het_rates(k,193))* y(k,193) - prod(k,58) = (.2067005_r8*rxt(k,516)*y(k,6) +.0035005_r8*rxt(k,520)*y(k,98) + & - .1149005_r8*rxt(k,525)*y(k,111))*y(k,243) & - + (.2067005_r8*rxt(k,515)*y(k,6) +.1149005_r8*rxt(k,524)*y(k,111)) & - *y(k,133) - loss(k,59) = ( + het_rates(k,194))* y(k,194) - prod(k,59) = (.0653005_r8*rxt(k,516)*y(k,6) +.0003005_r8*rxt(k,520)*y(k,98) + & - .0348005_r8*rxt(k,525)*y(k,111))*y(k,243) & - + (.0653005_r8*rxt(k,515)*y(k,6) +.0348005_r8*rxt(k,524)*y(k,111)) & - *y(k,133) - loss(k,60) = ( + het_rates(k,195))* y(k,195) - prod(k,60) = (.1749305_r8*rxt(k,514)*y(k,125) + & - .1284005_r8*rxt(k,515)*y(k,133) +.1284005_r8*rxt(k,516)*y(k,243)) & - *y(k,6) + (.0590245_r8*rxt(k,518)*y(k,125) + & - .0033005_r8*rxt(k,519)*y(k,133) +.0271005_r8*rxt(k,520)*y(k,243)) & - *y(k,98) + (.1749305_r8*rxt(k,523)*y(k,125) + & - .0554005_r8*rxt(k,524)*y(k,133) +.0554005_r8*rxt(k,525)*y(k,243)) & - *y(k,111) - loss(k,61) = ( + het_rates(k,196))* y(k,196) - prod(k,61) = (.5901905_r8*rxt(k,514)*y(k,125) +.114_r8*rxt(k,515)*y(k,133) + & - .114_r8*rxt(k,516)*y(k,243))*y(k,6) & - + (.5901905_r8*rxt(k,523)*y(k,125) + & - .1278005_r8*rxt(k,524)*y(k,133) +.1278005_r8*rxt(k,525)*y(k,243)) & - *y(k,111) + (.0250245_r8*rxt(k,518)*y(k,125) + & - .0474005_r8*rxt(k,520)*y(k,243))*y(k,98) - loss(k,62) = ( + het_rates(k,197))* y(k,197) - prod(k,62) = (.0023005_r8*rxt(k,517)*y(k,7) + & - .2381005_r8*rxt(k,522)*y(k,105) +.5931005_r8*rxt(k,527)*y(k,203) + & - .1364005_r8*rxt(k,528)*y(k,211) +.1677005_r8*rxt(k,529)*y(k,213)) & - *y(k,243) - loss(k,63) = ( + het_rates(k,198))* y(k,198) - prod(k,63) = (.0008005_r8*rxt(k,517)*y(k,7) + & - .1308005_r8*rxt(k,522)*y(k,105) +.1534005_r8*rxt(k,527)*y(k,203) + & - .0101005_r8*rxt(k,528)*y(k,211) +.0174005_r8*rxt(k,529)*y(k,213)) & - *y(k,243) - loss(k,64) = ( + het_rates(k,199))* y(k,199) - prod(k,64) = (.0843005_r8*rxt(k,517)*y(k,7) + & - .0348005_r8*rxt(k,522)*y(k,105) +.0459005_r8*rxt(k,527)*y(k,203) + & - .0763005_r8*rxt(k,528)*y(k,211) +.086_r8*rxt(k,529)*y(k,213)) & - *y(k,243) - loss(k,65) = ( + het_rates(k,200))* y(k,200) - prod(k,65) = (.0443005_r8*rxt(k,517)*y(k,7) + & - .0076005_r8*rxt(k,522)*y(k,105) +.0085005_r8*rxt(k,527)*y(k,203) + & - .2157005_r8*rxt(k,528)*y(k,211) +.0512005_r8*rxt(k,529)*y(k,213)) & - *y(k,243) - loss(k,66) = ( + het_rates(k,201))* y(k,201) - prod(k,66) = (.1621005_r8*rxt(k,517)*y(k,7) + & - .0113005_r8*rxt(k,522)*y(k,105) +.0128005_r8*rxt(k,527)*y(k,203) + & - .0738005_r8*rxt(k,528)*y(k,211) +.1598005_r8*rxt(k,529)*y(k,213)) & - *y(k,243) - loss(k,68) = (rxt(k,526)* y(k,243) + het_rates(k,202))* y(k,202) - prod(k,68) = 0._r8 - loss(k,69) = (rxt(k,527)* y(k,243) + het_rates(k,203))* y(k,203) - prod(k,69) = 0._r8 - loss(k,87) = ( + rxt(k,64) + het_rates(k,204))* y(k,204) - prod(k,87) = (.100_r8*rxt(k,449)*y(k,211) +.230_r8*rxt(k,451)*y(k,213)) & - *y(k,243) - loss(k,149) = (rxt(k,473)* y(k,243) + rxt(k,65) + het_rates(k,205))* y(k,205) - prod(k,149) =rxt(k,471)*y(k,247)*y(k,232) - loss(k,152) = (rxt(k,474)* y(k,243) + rxt(k,66) + rxt(k,513) & - + het_rates(k,206))* y(k,206) - prod(k,152) = (.200_r8*rxt(k,467)*y(k,241) +.200_r8*rxt(k,477)*y(k,248)) & - *y(k,123) +.500_r8*rxt(k,465)*y(k,241)*y(k,227) - loss(k,133) = (rxt(k,478)* y(k,243) + rxt(k,67) + het_rates(k,207))* y(k,207) - prod(k,133) =rxt(k,476)*y(k,248)*y(k,232) - loss(k,183) = (rxt(k,479)* y(k,125) +rxt(k,480)* y(k,243) + rxt(k,68) & - + het_rates(k,208))* y(k,208) - prod(k,183) = (.500_r8*rxt(k,465)*y(k,227) +.800_r8*rxt(k,467)*y(k,123) + & - rxt(k,468)*y(k,125))*y(k,241) + (.330_r8*rxt(k,460)*y(k,6) + & - .330_r8*rxt(k,463)*y(k,111))*y(k,133) + (rxt(k,66) + & - rxt(k,474)*y(k,243))*y(k,206) + (rxt(k,475)*y(k,227) + & - .800_r8*rxt(k,477)*y(k,123))*y(k,248) +rxt(k,58)*y(k,127) +rxt(k,67) & - *y(k,207) - loss(k,188) = (rxt(k,481)* y(k,243) + rxt(k,69) + het_rates(k,209))* y(k,209) - prod(k,188) = (.300_r8*rxt(k,460)*y(k,6) +.300_r8*rxt(k,463)*y(k,111)) & - *y(k,133) + (rxt(k,470)*y(k,227) +.900_r8*rxt(k,472)*y(k,123)) & - *y(k,247) +rxt(k,65)*y(k,205) +rxt(k,68)*y(k,208) - loss(k,150) = (rxt(k,448)* y(k,243) + rxt(k,70) + het_rates(k,210))* y(k,210) - prod(k,150) =rxt(k,446)*y(k,249)*y(k,232) - loss(k,85) = (rxt(k,449)* y(k,243) + het_rates(k,211))* y(k,211) - prod(k,85) = 0._r8 - loss(k,88) = (rxt(k,415)* y(k,243) + rxt(k,71) + het_rates(k,212))* y(k,212) - prod(k,88) =rxt(k,412)*y(k,250)*y(k,232) - loss(k,89) = (rxt(k,451)* y(k,243) + het_rates(k,213))* y(k,213) - prod(k,89) = 0._r8 - loss(k,158) = (rxt(k,454)* y(k,243) + rxt(k,72) + het_rates(k,214))* y(k,214) - prod(k,158) =rxt(k,452)*y(k,251)*y(k,232) - loss(k,90) = (rxt(k,457)* y(k,243) + het_rates(k,215))* y(k,215) - prod(k,90) =.150_r8*rxt(k,451)*y(k,243)*y(k,213) - loss(k,126) = (rxt(k,458)* y(k,243) + rxt(k,73) + het_rates(k,216))* y(k,216) - prod(k,126) =rxt(k,455)*y(k,252)*y(k,232) - loss(k,139) = (rxt(k,417)* y(k,123) +rxt(k,445)* y(k,124) +rxt(k,416) & - * y(k,232) + het_rates(k,219))* y(k,219) - prod(k,139) =rxt(k,422)*y(k,243)*y(k,22) +rxt(k,450)*y(k,139) - loss(k,180) = ((rxt(k,378) +rxt(k,379))* y(k,123) +rxt(k,377)* y(k,232) & - + het_rates(k,220))* y(k,220) - prod(k,180) = (rxt(k,380)*y(k,2) +rxt(k,381)*y(k,15))*y(k,243) - loss(k,134) = (rxt(k,420)* y(k,123) +rxt(k,419)* y(k,232) + het_rates(k,221)) & - * y(k,221) - prod(k,134) = (.350_r8*rxt(k,418)*y(k,7) +rxt(k,421)*y(k,8))*y(k,243) - loss(k,127) = (rxt(k,425)* y(k,123) +rxt(k,423)* y(k,232) + het_rates(k,222)) & + loss(k,51) = ( + rxt(k,138) + het_rates(k,187))* y(k,187) + prod(k,51) = 0._r8 + loss(k,52) = ( + rxt(k,139) + het_rates(k,188))* y(k,188) + prod(k,52) = 0._r8 + loss(k,53) = ( + rxt(k,140) + het_rates(k,189))* y(k,189) + prod(k,53) = 0._r8 + loss(k,54) = ( + rxt(k,141) + het_rates(k,190))* y(k,190) + prod(k,54) = 0._r8 + loss(k,55) = ( + rxt(k,142) + het_rates(k,191))* y(k,191) + prod(k,55) = 0._r8 + loss(k,56) = ( + rxt(k,143) + het_rates(k,192))* y(k,192) + prod(k,56) = 0._r8 + loss(k,57) = ( + het_rates(k,193))* y(k,193) + prod(k,57) = (.2381005_r8*rxt(k,525)*y(k,240) + & + .1056005_r8*rxt(k,526)*y(k,129))*y(k,108) & + +.5931005_r8*rxt(k,536)*y(k,251)*y(k,208) + loss(k,58) = ( + het_rates(k,194))* y(k,194) + prod(k,58) = (.1308005_r8*rxt(k,525)*y(k,240) + & + .1026005_r8*rxt(k,526)*y(k,129))*y(k,108) & + +.1534005_r8*rxt(k,536)*y(k,251)*y(k,208) + loss(k,59) = ( + het_rates(k,195))* y(k,195) + prod(k,59) = (.0348005_r8*rxt(k,525)*y(k,240) + & + .0521005_r8*rxt(k,526)*y(k,129))*y(k,108) & + +.0459005_r8*rxt(k,536)*y(k,251)*y(k,208) + loss(k,60) = ( + het_rates(k,196))* y(k,196) + prod(k,60) = (.0076005_r8*rxt(k,525)*y(k,240) + & + .0143005_r8*rxt(k,526)*y(k,129))*y(k,108) & + +.0085005_r8*rxt(k,536)*y(k,251)*y(k,208) + loss(k,61) = ( + het_rates(k,197))* y(k,197) + prod(k,61) = (.0113005_r8*rxt(k,525)*y(k,240) + & + .0166005_r8*rxt(k,526)*y(k,129))*y(k,108) & + +.0128005_r8*rxt(k,536)*y(k,251)*y(k,208) + loss(k,64) = ( + het_rates(k,198))* y(k,198) + prod(k,64) = (.1279005_r8*rxt(k,514)*y(k,7) + & + .0003005_r8*rxt(k,522)*y(k,105) +.0245005_r8*rxt(k,533)*y(k,117)) & + *y(k,129) + (.2202005_r8*rxt(k,513)*y(k,7) + & + .0031005_r8*rxt(k,521)*y(k,105) +.0508005_r8*rxt(k,532)*y(k,117)) & + *y(k,240) + (.2202005_r8*rxt(k,515)*y(k,6) + & + .0508005_r8*rxt(k,534)*y(k,116))*y(k,139) +rxt(k,541)*y(k,77) + loss(k,65) = ( + het_rates(k,199))* y(k,199) + prod(k,65) = (.1792005_r8*rxt(k,514)*y(k,7) + & + .0003005_r8*rxt(k,522)*y(k,105) +.0082005_r8*rxt(k,533)*y(k,117)) & + *y(k,129) + (.2067005_r8*rxt(k,513)*y(k,7) + & + .0035005_r8*rxt(k,521)*y(k,105) +.1149005_r8*rxt(k,532)*y(k,117)) & + *y(k,240) + (.2067005_r8*rxt(k,515)*y(k,6) + & + .1149005_r8*rxt(k,534)*y(k,116))*y(k,139) + loss(k,66) = ( + het_rates(k,200))* y(k,200) + prod(k,66) = (.0676005_r8*rxt(k,514)*y(k,7) + & + .0073005_r8*rxt(k,522)*y(k,105) +.0772005_r8*rxt(k,533)*y(k,117)) & + *y(k,129) + (.0653005_r8*rxt(k,513)*y(k,7) + & + .0003005_r8*rxt(k,521)*y(k,105) +.0348005_r8*rxt(k,532)*y(k,117)) & + *y(k,240) + (.0653005_r8*rxt(k,515)*y(k,6) + & + .0348005_r8*rxt(k,534)*y(k,116))*y(k,139) + loss(k,67) = ( + het_rates(k,201))* y(k,201) + prod(k,67) = (.079_r8*rxt(k,514)*y(k,7) +.0057005_r8*rxt(k,522)*y(k,105) + & + .0332005_r8*rxt(k,533)*y(k,117))*y(k,129) & + + (.1749305_r8*rxt(k,512)*y(k,6) +.0590245_r8*rxt(k,520)*y(k,100) + & + .1749305_r8*rxt(k,531)*y(k,116))*y(k,131) & + + (.1284005_r8*rxt(k,515)*y(k,6) +.0033005_r8*rxt(k,523)*y(k,100) + & + .0554005_r8*rxt(k,534)*y(k,116))*y(k,139) & + + (.1284005_r8*rxt(k,513)*y(k,7) +.0271005_r8*rxt(k,521)*y(k,105) + & + .0554005_r8*rxt(k,532)*y(k,117))*y(k,240) + loss(k,68) = ( + het_rates(k,202))* y(k,202) + prod(k,68) = (.1254005_r8*rxt(k,514)*y(k,7) + & + .0623005_r8*rxt(k,522)*y(k,105) +.130_r8*rxt(k,533)*y(k,117)) & + *y(k,129) + (.5901905_r8*rxt(k,512)*y(k,6) + & + .0250245_r8*rxt(k,520)*y(k,100) +.5901905_r8*rxt(k,531)*y(k,116)) & + *y(k,131) + (.114_r8*rxt(k,513)*y(k,7) + & + .0474005_r8*rxt(k,521)*y(k,105) +.1278005_r8*rxt(k,532)*y(k,117)) & + *y(k,240) + (.114_r8*rxt(k,515)*y(k,6) + & + .1278005_r8*rxt(k,534)*y(k,116))*y(k,139) + loss(k,72) = ( + het_rates(k,203))* y(k,203) + prod(k,72) = (.0097005_r8*rxt(k,519)*y(k,9) + & + .1056005_r8*rxt(k,529)*y(k,110) +.0154005_r8*rxt(k,540)*y(k,218) + & + .0063005_r8*rxt(k,544)*y(k,222))*y(k,129) & + + (.0023005_r8*rxt(k,518)*y(k,9) +.2381005_r8*rxt(k,528)*y(k,110) + & + .1364005_r8*rxt(k,539)*y(k,218) +.1677005_r8*rxt(k,543)*y(k,222)) & + *y(k,240) +.5931005_r8*rxt(k,537)*y(k,251)*y(k,209) + loss(k,73) = ( + het_rates(k,204))* y(k,204) + prod(k,73) = (.0034005_r8*rxt(k,519)*y(k,9) + & + .1026005_r8*rxt(k,529)*y(k,110) +.0452005_r8*rxt(k,540)*y(k,218) + & + .0237005_r8*rxt(k,544)*y(k,222))*y(k,129) & + + (.0008005_r8*rxt(k,518)*y(k,9) +.1308005_r8*rxt(k,528)*y(k,110) + & + .0101005_r8*rxt(k,539)*y(k,218) +.0174005_r8*rxt(k,543)*y(k,222)) & + *y(k,240) +.1534005_r8*rxt(k,537)*y(k,251)*y(k,209) + loss(k,74) = ( + het_rates(k,205))* y(k,205) + prod(k,74) = (.1579005_r8*rxt(k,519)*y(k,9) + & + .0521005_r8*rxt(k,529)*y(k,110) +.0966005_r8*rxt(k,540)*y(k,218) + & + .0025005_r8*rxt(k,544)*y(k,222))*y(k,129) & + + (.0843005_r8*rxt(k,518)*y(k,9) +.0348005_r8*rxt(k,528)*y(k,110) + & + .0763005_r8*rxt(k,539)*y(k,218) +.086_r8*rxt(k,543)*y(k,222)) & + *y(k,240) +.0459005_r8*rxt(k,537)*y(k,251)*y(k,209) + loss(k,75) = ( + het_rates(k,206))* y(k,206) + prod(k,75) = (.0059005_r8*rxt(k,519)*y(k,9) + & + .0143005_r8*rxt(k,529)*y(k,110) +.0073005_r8*rxt(k,540)*y(k,218) + & + .011_r8*rxt(k,544)*y(k,222))*y(k,129) & + + (.0443005_r8*rxt(k,518)*y(k,9) +.0076005_r8*rxt(k,528)*y(k,110) + & + .2157005_r8*rxt(k,539)*y(k,218) +.0512005_r8*rxt(k,543)*y(k,222)) & + *y(k,240) +.0085005_r8*rxt(k,537)*y(k,251)*y(k,209) + loss(k,76) = ( + het_rates(k,207))* y(k,207) + prod(k,76) = (.0536005_r8*rxt(k,519)*y(k,9) + & + .0166005_r8*rxt(k,529)*y(k,110) +.238_r8*rxt(k,540)*y(k,218) + & + .1185005_r8*rxt(k,544)*y(k,222))*y(k,129) & + + (.1621005_r8*rxt(k,518)*y(k,9) +.0113005_r8*rxt(k,528)*y(k,110) + & + .0738005_r8*rxt(k,539)*y(k,218) +.1598005_r8*rxt(k,543)*y(k,222)) & + *y(k,240) +.0128005_r8*rxt(k,537)*y(k,251)*y(k,209) + loss(k,80) = (rxt(k,536)* y(k,251) + het_rates(k,208))* y(k,208) + prod(k,80) = 0._r8 + loss(k,81) = (rxt(k,537)* y(k,251) + het_rates(k,209))* y(k,209) + prod(k,81) = 0._r8 + loss(k,110) = ( + rxt(k,64) + het_rates(k,210))* y(k,210) + prod(k,110) = (.100_r8*rxt(k,448)*y(k,217) +.230_r8*rxt(k,450)*y(k,220)) & + *y(k,251) + loss(k,185) = (rxt(k,472)* y(k,251) + rxt(k,65) + het_rates(k,211))* y(k,211) + prod(k,185) =rxt(k,470)*y(k,255)*y(k,240) + loss(k,182) = (rxt(k,473)* y(k,251) + rxt(k,66) + rxt(k,511) & + + het_rates(k,212))* y(k,212) + prod(k,182) = (.200_r8*rxt(k,466)*y(k,249) +.200_r8*rxt(k,476)*y(k,256)) & + *y(k,129) +.500_r8*rxt(k,464)*y(k,249)*y(k,235) + loss(k,163) = (rxt(k,477)* y(k,251) + rxt(k,67) + het_rates(k,213))* y(k,213) + prod(k,163) =rxt(k,475)*y(k,256)*y(k,240) + loss(k,216) = (rxt(k,478)* y(k,131) +rxt(k,479)* y(k,251) + rxt(k,68) & + + het_rates(k,214))* y(k,214) + prod(k,216) = (.500_r8*rxt(k,464)*y(k,235) +.800_r8*rxt(k,466)*y(k,129) + & + rxt(k,467)*y(k,131))*y(k,249) + (.330_r8*rxt(k,459)*y(k,6) + & + .330_r8*rxt(k,462)*y(k,116))*y(k,139) + (rxt(k,66) + & + rxt(k,473)*y(k,251))*y(k,212) + (rxt(k,474)*y(k,235) + & + .800_r8*rxt(k,476)*y(k,129))*y(k,256) +rxt(k,58)*y(k,133) +rxt(k,67) & + *y(k,213) + loss(k,221) = (rxt(k,480)* y(k,251) + rxt(k,69) + het_rates(k,215))* y(k,215) + prod(k,221) = (.300_r8*rxt(k,459)*y(k,6) +.300_r8*rxt(k,462)*y(k,116)) & + *y(k,139) + (rxt(k,469)*y(k,235) +.900_r8*rxt(k,471)*y(k,129)) & + *y(k,255) +rxt(k,65)*y(k,211) +rxt(k,68)*y(k,214) + loss(k,179) = (rxt(k,447)* y(k,251) + rxt(k,70) + het_rates(k,216))* y(k,216) + prod(k,179) =rxt(k,445)*y(k,257)*y(k,240) + loss(k,108) = (rxt(k,448)* y(k,251) + het_rates(k,217))* y(k,217) + prod(k,108) = 0._r8 + loss(k,82) = (rxt(k,540)* y(k,129) +rxt(k,539)* y(k,240) + het_rates(k,218)) & + * y(k,218) + prod(k,82) =rxt(k,538)*y(k,251)*y(k,217) + loss(k,111) = (rxt(k,414)* y(k,251) + rxt(k,71) + het_rates(k,219))* y(k,219) + prod(k,111) =rxt(k,411)*y(k,258)*y(k,240) + loss(k,112) = (rxt(k,450)* y(k,251) + het_rates(k,220))* y(k,220) + prod(k,112) = 0._r8 + loss(k,190) = (rxt(k,453)* y(k,251) + rxt(k,72) + het_rates(k,221))* y(k,221) + prod(k,190) =rxt(k,451)*y(k,259)*y(k,240) + loss(k,83) = (rxt(k,544)* y(k,129) +rxt(k,543)* y(k,240) + het_rates(k,222)) & * y(k,222) - prod(k,127) = (rxt(k,424)*y(k,23) +.070_r8*rxt(k,449)*y(k,211) + & - .060_r8*rxt(k,451)*y(k,213))*y(k,243) - loss(k,172) = (rxt(k,303)* y(k,123) + 2._r8*rxt(k,300)* y(k,223) +rxt(k,301) & - * y(k,227) +rxt(k,302)* y(k,232) + het_rates(k,223))* y(k,223) - prod(k,172) = (rxt(k,306)*y(k,56) +rxt(k,307)*y(k,243))*y(k,28) & - +.500_r8*rxt(k,305)*y(k,243)*y(k,27) +rxt(k,52)*y(k,108) - loss(k,169) = (rxt(k,331)* y(k,123) +rxt(k,329)* y(k,227) +rxt(k,330) & - * y(k,232) + het_rates(k,224))* y(k,224) - prod(k,169) = (rxt(k,332)*y(k,30) +rxt(k,333)*y(k,31))*y(k,243) - loss(k,153) = (rxt(k,427)* y(k,123) +rxt(k,426)* y(k,232) + het_rates(k,225)) & - * y(k,225) - prod(k,153) = (.400_r8*rxt(k,416)*y(k,232) +rxt(k,417)*y(k,123))*y(k,219) & - +rxt(k,428)*y(k,243)*y(k,32) +rxt(k,443)*y(k,140)*y(k,133) - loss(k,207) = (rxt(k,399)* y(k,101) +rxt(k,314)* y(k,123) +rxt(k,325) & - * y(k,124) + 2._r8*rxt(k,311)* y(k,226) +rxt(k,312)* y(k,227) & - +rxt(k,313)* y(k,232) +rxt(k,385)* y(k,234) +rxt(k,390)* y(k,235) & - +rxt(k,352)* y(k,236) +rxt(k,410)* y(k,250) + het_rates(k,226)) & - * y(k,226) - prod(k,207) = (.100_r8*rxt(k,358)*y(k,106) +.280_r8*rxt(k,372)*y(k,112) + & - .080_r8*rxt(k,405)*y(k,98) +.060_r8*rxt(k,460)*y(k,6) + & - .060_r8*rxt(k,463)*y(k,111))*y(k,133) + (rxt(k,362)*y(k,227) + & - .450_r8*rxt(k,363)*y(k,232) +2.000_r8*rxt(k,364)*y(k,238) + & - rxt(k,365)*y(k,123) +rxt(k,366)*y(k,125))*y(k,238) & - + (.530_r8*rxt(k,352)*y(k,226) +.260_r8*rxt(k,353)*y(k,227) + & - .530_r8*rxt(k,355)*y(k,125) +.530_r8*rxt(k,356)*y(k,123))*y(k,236) & - + (rxt(k,309)*y(k,45) +.500_r8*rxt(k,316)*y(k,51) + & - rxt(k,335)*y(k,49) +.650_r8*rxt(k,481)*y(k,209))*y(k,243) & - + (.300_r8*rxt(k,341)*y(k,227) +.150_r8*rxt(k,342)*y(k,232) + & - rxt(k,343)*y(k,123))*y(k,246) + (rxt(k,36) +rxt(k,334)*y(k,125)) & - *y(k,49) + (.600_r8*rxt(k,60) +rxt(k,326))*y(k,138) & - + (.200_r8*rxt(k,367)*y(k,232) +rxt(k,368)*y(k,123))*y(k,240) & - +.130_r8*rxt(k,23)*y(k,10) +rxt(k,27)*y(k,14) +rxt(k,308)*y(k,125) & - *y(k,45) +rxt(k,35)*y(k,48) +.330_r8*rxt(k,45)*y(k,93) +rxt(k,47) & - *y(k,95) +1.340_r8*rxt(k,50)*y(k,106) +rxt(k,52)*y(k,108) +rxt(k,53) & - *y(k,109) +.300_r8*rxt(k,55)*y(k,112) +rxt(k,57)*y(k,126) +rxt(k,63) & - *y(k,148) +.500_r8*rxt(k,64)*y(k,204) +.650_r8*rxt(k,69)*y(k,209) - loss(k,219) = (rxt(k,201)* y(k,59) +rxt(k,400)* y(k,101) +rxt(k,281) & - * y(k,123) +rxt(k,301)* y(k,223) +rxt(k,329)* y(k,224) +rxt(k,312) & - * y(k,226) + 2._r8*(rxt(k,278) +rxt(k,279))* y(k,227) +rxt(k,280) & - * y(k,232) +rxt(k,386)* y(k,234) +rxt(k,391)* y(k,235) +rxt(k,353) & - * y(k,236) +rxt(k,362)* y(k,238) +rxt(k,465)* y(k,241) +rxt(k,341) & - * y(k,246) +rxt(k,470)* y(k,247) +rxt(k,475)* y(k,248) +rxt(k,411) & - * y(k,250) + het_rates(k,227))* y(k,227) - prod(k,219) = (2.000_r8*rxt(k,311)*y(k,226) +.900_r8*rxt(k,312)*y(k,227) + & - .450_r8*rxt(k,313)*y(k,232) +rxt(k,314)*y(k,123) + & - rxt(k,352)*y(k,236) +rxt(k,361)*y(k,238) +rxt(k,385)*y(k,234) + & - rxt(k,390)*y(k,235) +rxt(k,399)*y(k,101) +rxt(k,410)*y(k,250)) & - *y(k,226) + (rxt(k,195)*y(k,56) +rxt(k,251)*y(k,73) + & - rxt(k,284)*y(k,243) +rxt(k,291)*y(k,242))*y(k,54) & - + (.830_r8*rxt(k,431)*y(k,228) +.170_r8*rxt(k,437)*y(k,239)) & - *y(k,123) + (.280_r8*rxt(k,328)*y(k,29) +.050_r8*rxt(k,405)*y(k,98)) & - *y(k,133) + (.330_r8*rxt(k,430)*y(k,228) + & - .070_r8*rxt(k,436)*y(k,239))*y(k,232) + (.700_r8*rxt(k,283)*y(k,53) + & - rxt(k,315)*y(k,50))*y(k,243) +rxt(k,34)*y(k,45) +rxt(k,35)*y(k,48) & - +rxt(k,37)*y(k,51) +.300_r8*rxt(k,55)*y(k,112) +.400_r8*rxt(k,60) & - *y(k,138) - loss(k,163) = (rxt(k,431)* y(k,123) +rxt(k,432)* y(k,124) +rxt(k,430) & - * y(k,232) + het_rates(k,228))* y(k,228) - prod(k,163) =.600_r8*rxt(k,25)*y(k,12) - loss(k,145) = ((rxt(k,349) +rxt(k,350))* y(k,123) + het_rates(k,229)) & + prod(k,83) =rxt(k,542)*y(k,251)*y(k,220) + loss(k,113) = (rxt(k,456)* y(k,251) + het_rates(k,223))* y(k,223) + prod(k,113) =.150_r8*rxt(k,450)*y(k,251)*y(k,220) + loss(k,154) = (rxt(k,457)* y(k,251) + rxt(k,73) + het_rates(k,224))* y(k,224) + prod(k,154) =rxt(k,454)*y(k,260)*y(k,240) + loss(k,167) = (rxt(k,416)* y(k,129) +rxt(k,444)* y(k,130) +rxt(k,415) & + * y(k,240) + het_rates(k,227))* y(k,227) + prod(k,167) =rxt(k,421)*y(k,251)*y(k,24) +rxt(k,449)*y(k,145) + loss(k,210) = ((rxt(k,377) +rxt(k,378))* y(k,129) +rxt(k,376)* y(k,240) & + + het_rates(k,228))* y(k,228) + prod(k,210) = (rxt(k,379)*y(k,2) +rxt(k,380)*y(k,17))*y(k,251) + loss(k,164) = (rxt(k,419)* y(k,129) +rxt(k,418)* y(k,240) + het_rates(k,229)) & * y(k,229) - prod(k,145) =rxt(k,348)*y(k,243)*y(k,16) - loss(k,100) = ( + rxt(k,319) + rxt(k,320) + het_rates(k,230))* y(k,230) - prod(k,100) =rxt(k,42)*y(k,72) +.750_r8*rxt(k,318)*y(k,231)*y(k,123) - loss(k,159) = (rxt(k,318)* y(k,123) +rxt(k,317)* y(k,232) + het_rates(k,231)) & - * y(k,231) - prod(k,159) =rxt(k,324)*y(k,243)*y(k,25) - loss(k,213) = (rxt(k,231)* y(k,17) +rxt(k,237)* y(k,19) +rxt(k,274)* y(k,42) & - + (rxt(k,198) +rxt(k,199))* y(k,56) +rxt(k,205)* y(k,59) & - + (rxt(k,154) +rxt(k,155) +rxt(k,156))* y(k,76) +rxt(k,401) & - * y(k,101) +rxt(k,183)* y(k,123) +rxt(k,188)* y(k,124) +rxt(k,178) & - * y(k,125) +rxt(k,158)* y(k,132) +rxt(k,159)* y(k,133) +rxt(k,416) & - * y(k,219) +rxt(k,377)* y(k,220) +rxt(k,419)* y(k,221) +rxt(k,423) & - * y(k,222) +rxt(k,302)* y(k,223) +rxt(k,330)* y(k,224) +rxt(k,426) & - * y(k,225) +rxt(k,313)* y(k,226) +rxt(k,280)* y(k,227) +rxt(k,430) & - * y(k,228) +rxt(k,317)* y(k,231) + 2._r8*rxt(k,168)* y(k,232) & - +rxt(k,288)* y(k,233) +rxt(k,387)* y(k,234) +rxt(k,392)* y(k,235) & - +rxt(k,354)* y(k,236) +rxt(k,433)* y(k,237) +rxt(k,363)* y(k,238) & - +rxt(k,436)* y(k,239) +rxt(k,367)* y(k,240) +rxt(k,466)* y(k,241) & - +rxt(k,163)* y(k,243) +rxt(k,439)* y(k,244) +rxt(k,338)* y(k,245) & - +rxt(k,342)* y(k,246) +rxt(k,471)* y(k,247) +rxt(k,476)* y(k,248) & - +rxt(k,446)* y(k,249) +rxt(k,412)* y(k,250) +rxt(k,452)* y(k,251) & - +rxt(k,455)* y(k,252) + rxt(k,501) + het_rates(k,232))* y(k,232) - prod(k,213) = (rxt(k,260)*y(k,43) +rxt(k,263)*y(k,46) +rxt(k,162)*y(k,79) + & - rxt(k,165)*y(k,133) +rxt(k,181)*y(k,125) +rxt(k,212)*y(k,59) + & - rxt(k,242)*y(k,19) +rxt(k,282)*y(k,52) +rxt(k,285)*y(k,62) + & - rxt(k,286)*y(k,86) +rxt(k,287)*y(k,87) +.350_r8*rxt(k,297)*y(k,24) + & - rxt(k,304)*y(k,26) +rxt(k,310)*y(k,47) +rxt(k,321)*y(k,74) + & - rxt(k,322)*y(k,75) +rxt(k,336)*y(k,95) +rxt(k,351)*y(k,93) + & - .200_r8*rxt(k,360)*y(k,107) +.500_r8*rxt(k,371)*y(k,110) + & - .300_r8*rxt(k,396)*y(k,99) +rxt(k,397)*y(k,100) + & - rxt(k,404)*y(k,102) +rxt(k,408)*y(k,116) +rxt(k,409)*y(k,117) + & - .650_r8*rxt(k,418)*y(k,7) +.730_r8*rxt(k,429)*y(k,66) + & - .800_r8*rxt(k,441)*y(k,141) +.280_r8*rxt(k,449)*y(k,211) + & - .380_r8*rxt(k,451)*y(k,213) +.630_r8*rxt(k,457)*y(k,215) + & - .200_r8*rxt(k,481)*y(k,209) +.500_r8*rxt(k,496)*y(k,67) + & - rxt(k,497)*y(k,152))*y(k,243) + (rxt(k,281)*y(k,227) + & - rxt(k,290)*y(k,233) +rxt(k,303)*y(k,223) + & - .250_r8*rxt(k,318)*y(k,231) +rxt(k,331)*y(k,224) + & - rxt(k,339)*y(k,245) +rxt(k,349)*y(k,229) + & - .470_r8*rxt(k,356)*y(k,236) +rxt(k,378)*y(k,220) + & - .920_r8*rxt(k,388)*y(k,234) +.920_r8*rxt(k,394)*y(k,235) + & - rxt(k,402)*y(k,101) +rxt(k,413)*y(k,250) +rxt(k,420)*y(k,221) + & - rxt(k,425)*y(k,222) +.170_r8*rxt(k,431)*y(k,228) + & - .400_r8*rxt(k,434)*y(k,237) +.830_r8*rxt(k,437)*y(k,239) + & - rxt(k,440)*y(k,244) +rxt(k,447)*y(k,249) +rxt(k,453)*y(k,251) + & - rxt(k,456)*y(k,252) +.900_r8*rxt(k,472)*y(k,247) + & - .800_r8*rxt(k,477)*y(k,248))*y(k,123) + (rxt(k,201)*y(k,59) + & - 2.000_r8*rxt(k,278)*y(k,227) +rxt(k,301)*y(k,223) + & - .900_r8*rxt(k,312)*y(k,226) +rxt(k,329)*y(k,224) + & - .300_r8*rxt(k,341)*y(k,246) +.730_r8*rxt(k,353)*y(k,236) + & - rxt(k,362)*y(k,238) +rxt(k,386)*y(k,234) +rxt(k,391)*y(k,235) + & - 1.200_r8*rxt(k,400)*y(k,101) +.800_r8*rxt(k,411)*y(k,250) + & - .500_r8*rxt(k,465)*y(k,241) +rxt(k,470)*y(k,247) + & - rxt(k,475)*y(k,248))*y(k,227) + (.130_r8*rxt(k,299)*y(k,25) + & - .280_r8*rxt(k,328)*y(k,29) +.140_r8*rxt(k,358)*y(k,106) + & - .280_r8*rxt(k,372)*y(k,112) +.370_r8*rxt(k,405)*y(k,98) + & - .570_r8*rxt(k,460)*y(k,6) +.570_r8*rxt(k,463)*y(k,111))*y(k,133) & - + (rxt(k,275)*y(k,42) +.470_r8*rxt(k,355)*y(k,236) + & - rxt(k,389)*y(k,234) +rxt(k,395)*y(k,235) +rxt(k,403)*y(k,101) + & - rxt(k,414)*y(k,250))*y(k,125) + (.470_r8*rxt(k,352)*y(k,236) + & - rxt(k,385)*y(k,234) +rxt(k,390)*y(k,235) +rxt(k,399)*y(k,101) + & - rxt(k,410)*y(k,250))*y(k,226) + (rxt(k,259)*y(k,43) + & - rxt(k,262)*y(k,46) +rxt(k,194)*y(k,42) +rxt(k,197)*y(k,79))*y(k,56) & - + (.070_r8*rxt(k,430)*y(k,228) +.160_r8*rxt(k,433)*y(k,237) + & - .330_r8*rxt(k,436)*y(k,239))*y(k,232) + (rxt(k,230)*y(k,17) + & - rxt(k,276)*y(k,132))*y(k,42) + (rxt(k,11) +rxt(k,192))*y(k,90) & - + (1.340_r8*rxt(k,50) +.660_r8*rxt(k,51))*y(k,106) + (rxt(k,319) + & - rxt(k,320))*y(k,230) +rxt(k,19)*y(k,1) +.900_r8*rxt(k,20)*y(k,2) & - +rxt(k,21)*y(k,8) +1.500_r8*rxt(k,22)*y(k,9) +.560_r8*rxt(k,23) & - *y(k,10) +rxt(k,24)*y(k,11) +.600_r8*rxt(k,25)*y(k,12) & - +.600_r8*rxt(k,26)*y(k,13) +rxt(k,27)*y(k,14) +rxt(k,28)*y(k,23) & - +rxt(k,29)*y(k,27) +rxt(k,30)*y(k,30) +rxt(k,34)*y(k,45) +rxt(k,36) & - *y(k,49) +rxt(k,292)*y(k,242)*y(k,54) +2.000_r8*rxt(k,43)*y(k,74) & - +2.000_r8*rxt(k,44)*y(k,75) +rxt(k,157)*y(k,76) +rxt(k,153)*y(k,132) & - *y(k,79) +.670_r8*rxt(k,45)*y(k,93) +rxt(k,46)*y(k,94) +rxt(k,47) & - *y(k,95) +rxt(k,48)*y(k,102) +rxt(k,49)*y(k,103) +rxt(k,56)*y(k,117) & - +rxt(k,61)*y(k,142) +rxt(k,62)*y(k,147) +rxt(k,64)*y(k,204) & - +rxt(k,65)*y(k,205) +rxt(k,66)*y(k,206) +rxt(k,67)*y(k,207) & - +rxt(k,68)*y(k,208) +1.200_r8*rxt(k,69)*y(k,209) +rxt(k,70)*y(k,210) & - +rxt(k,72)*y(k,214) +rxt(k,73)*y(k,216) & - +1.200_r8*rxt(k,300)*y(k,223)*y(k,223) +rxt(k,289)*y(k,233) & - +rxt(k,393)*y(k,235) - loss(k,128) = (rxt(k,290)* y(k,123) +rxt(k,288)* y(k,232) + rxt(k,289) & - + het_rates(k,233))* y(k,233) - prod(k,128) =rxt(k,274)*y(k,232)*y(k,42) - loss(k,202) = (rxt(k,388)* y(k,123) +rxt(k,389)* y(k,125) +rxt(k,385) & - * y(k,226) +rxt(k,386)* y(k,227) +rxt(k,387)* y(k,232) & - + het_rates(k,234))* y(k,234) - prod(k,202) =.600_r8*rxt(k,406)*y(k,243)*y(k,98) - loss(k,205) = (rxt(k,394)* y(k,123) +rxt(k,395)* y(k,125) +rxt(k,390) & - * y(k,226) +rxt(k,391)* y(k,227) +rxt(k,392)* y(k,232) + rxt(k,393) & - + het_rates(k,235))* y(k,235) - prod(k,205) =.400_r8*rxt(k,406)*y(k,243)*y(k,98) - loss(k,204) = ((rxt(k,356) +rxt(k,357))* y(k,123) +rxt(k,355)* y(k,125) & - +rxt(k,352)* y(k,226) +rxt(k,353)* y(k,227) +rxt(k,354)* y(k,232) & - + het_rates(k,236))* y(k,236) - prod(k,204) = (.500_r8*rxt(k,359)*y(k,106) +.200_r8*rxt(k,360)*y(k,107) + & - rxt(k,373)*y(k,112))*y(k,243) - loss(k,160) = (rxt(k,434)* y(k,123) +rxt(k,435)* y(k,124) +rxt(k,433) & - * y(k,232) + het_rates(k,237))* y(k,237) - prod(k,160) =.600_r8*rxt(k,24)*y(k,11) - loss(k,206) = (rxt(k,365)* y(k,123) +rxt(k,374)* y(k,124) +rxt(k,366) & - * y(k,125) +rxt(k,361)* y(k,226) +rxt(k,362)* y(k,227) +rxt(k,363) & - * y(k,232) + 2._r8*rxt(k,364)* y(k,238) + het_rates(k,238))* y(k,238) - prod(k,206) = (.660_r8*rxt(k,50) +.500_r8*rxt(k,359)*y(k,243))*y(k,106) & - + (rxt(k,54) +rxt(k,375))*y(k,110) +.500_r8*rxt(k,360)*y(k,243) & - *y(k,107) - loss(k,176) = (rxt(k,437)* y(k,123) +rxt(k,438)* y(k,124) +rxt(k,436) & - * y(k,232) + het_rates(k,239))* y(k,239) - prod(k,176) =.600_r8*rxt(k,26)*y(k,13) - loss(k,156) = (rxt(k,368)* y(k,123) +rxt(k,367)* y(k,232) + het_rates(k,240)) & - * y(k,240) - prod(k,156) = (rxt(k,369)*y(k,108) +rxt(k,370)*y(k,109))*y(k,243) - loss(k,193) = (rxt(k,467)* y(k,123) +rxt(k,468)* y(k,125) +rxt(k,465) & - * y(k,227) +rxt(k,466)* y(k,232) + het_rates(k,241))* y(k,241) - prod(k,193) = (rxt(k,459)*y(k,6) +rxt(k,462)*y(k,111) + & - .500_r8*rxt(k,479)*y(k,208))*y(k,125) +rxt(k,469)*y(k,243)*y(k,127) - loss(k,214) = (rxt(k,219)* y(k,33) +rxt(k,220)* y(k,34) +rxt(k,246)* y(k,35) & - +rxt(k,221)* y(k,36) +rxt(k,222)* y(k,37) +rxt(k,223)* y(k,38) & - +rxt(k,224)* y(k,39) +rxt(k,225)* y(k,40) +rxt(k,269)* y(k,41) & - +rxt(k,270)* y(k,43) + (rxt(k,291) +rxt(k,292) +rxt(k,293))* y(k,54) & - +rxt(k,247)* y(k,55) +rxt(k,255)* y(k,64) +rxt(k,256)* y(k,65) & - +rxt(k,144)* y(k,77) +rxt(k,248)* y(k,78) + (rxt(k,249) +rxt(k,250)) & - * y(k,81) +rxt(k,271)* y(k,82) +rxt(k,272)* y(k,83) +rxt(k,273) & - * y(k,84) + (rxt(k,226) +rxt(k,227))* y(k,85) +rxt(k,294)* y(k,86) & - + (rxt(k,186) +rxt(k,187))* y(k,114) +rxt(k,148)* y(k,133) & - +rxt(k,145)* y(k,253) + rxt(k,146) + rxt(k,147) + het_rates(k,242)) & - * y(k,242) - prod(k,214) =rxt(k,7)*y(k,133) +rxt(k,1)*y(k,253) - loss(k,215) = (rxt(k,376)* y(k,1) +rxt(k,380)* y(k,2) +rxt(k,461)* y(k,6) & - +rxt(k,418)* y(k,7) +rxt(k,421)* y(k,8) +rxt(k,381)* y(k,15) & - +rxt(k,348)* y(k,16) +rxt(k,242)* y(k,19) +rxt(k,422)* y(k,22) & - +rxt(k,424)* y(k,23) +rxt(k,297)* y(k,24) +rxt(k,324)* y(k,25) & - +rxt(k,304)* y(k,26) +rxt(k,305)* y(k,27) +rxt(k,307)* y(k,28) & - +rxt(k,345)* y(k,29) +rxt(k,332)* y(k,30) +rxt(k,333)* y(k,31) & - +rxt(k,428)* y(k,32) +rxt(k,258)* y(k,41) +rxt(k,277)* y(k,42) & - +rxt(k,260)* y(k,43) +rxt(k,261)* y(k,44) +rxt(k,309)* y(k,45) & - +rxt(k,263)* y(k,46) +rxt(k,310)* y(k,47) +rxt(k,346)* y(k,48) & - +rxt(k,335)* y(k,49) +rxt(k,315)* y(k,50) +rxt(k,316)* y(k,51) & - +rxt(k,282)* y(k,52) +rxt(k,283)* y(k,53) +rxt(k,284)* y(k,54) & - +rxt(k,265)* y(k,55) + (rxt(k,212) +rxt(k,213))* y(k,59) +rxt(k,210) & - * y(k,60) + (rxt(k,285) +rxt(k,295))* y(k,62) +rxt(k,429)* y(k,66) & - + (rxt(k,483) +rxt(k,496))* y(k,67) +rxt(k,321)* y(k,74) +rxt(k,322) & - * y(k,75) +rxt(k,161)* y(k,77) +rxt(k,162)* y(k,79) +rxt(k,244) & - * y(k,81) +rxt(k,266)* y(k,82) +rxt(k,267)* y(k,83) +rxt(k,268) & - * y(k,84) +rxt(k,215)* y(k,85) +rxt(k,286)* y(k,86) +rxt(k,287) & - * y(k,87) +rxt(k,191)* y(k,89) +rxt(k,169)* y(k,90) +rxt(k,218) & - * y(k,92) +rxt(k,351)* y(k,93) +rxt(k,382)* y(k,94) +rxt(k,336) & - * y(k,95) +rxt(k,383)* y(k,96) +rxt(k,384)* y(k,97) +rxt(k,406) & - * y(k,98) +rxt(k,396)* y(k,99) +rxt(k,397)* y(k,100) +rxt(k,404) & - * y(k,102) +rxt(k,407)* y(k,103) +rxt(k,359)* y(k,106) +rxt(k,360) & - * y(k,107) +rxt(k,369)* y(k,108) +rxt(k,370)* y(k,109) +rxt(k,371) & - * y(k,110) +rxt(k,464)* y(k,111) +rxt(k,373)* y(k,112) +rxt(k,182) & - * y(k,113) +rxt(k,408)* y(k,116) +rxt(k,409)* y(k,117) +rxt(k,499) & - * y(k,121) +rxt(k,190)* y(k,124) +rxt(k,181)* y(k,125) +rxt(k,337) & - * y(k,126) +rxt(k,469)* y(k,127) +rxt(k,164)* y(k,132) +rxt(k,165) & - * y(k,133) +rxt(k,485)* y(k,136) +rxt(k,323)* y(k,138) +rxt(k,441) & - * y(k,141) +rxt(k,444)* y(k,142) +rxt(k,340)* y(k,147) +rxt(k,344) & - * y(k,148) +rxt(k,490)* y(k,149) +rxt(k,495)* y(k,151) +rxt(k,497) & - * y(k,152) +rxt(k,473)* y(k,205) +rxt(k,474)* y(k,206) +rxt(k,478) & - * y(k,207) +rxt(k,480)* y(k,208) +rxt(k,481)* y(k,209) +rxt(k,448) & - * y(k,210) +rxt(k,449)* y(k,211) +rxt(k,415)* y(k,212) +rxt(k,451) & - * y(k,213) +rxt(k,454)* y(k,214) +rxt(k,457)* y(k,215) +rxt(k,458) & - * y(k,216) +rxt(k,163)* y(k,232) + 2._r8*(rxt(k,166) +rxt(k,167)) & - * y(k,243) + het_rates(k,243))* y(k,243) - prod(k,215) = (2.000_r8*rxt(k,155)*y(k,76) +rxt(k,158)*y(k,132) + & - rxt(k,159)*y(k,133) +rxt(k,178)*y(k,125) +rxt(k,183)*y(k,123) + & - rxt(k,199)*y(k,56) +.450_r8*rxt(k,313)*y(k,226) + & - .150_r8*rxt(k,342)*y(k,246) +.450_r8*rxt(k,363)*y(k,238) + & - .200_r8*rxt(k,367)*y(k,240) +.400_r8*rxt(k,416)*y(k,219) + & - .400_r8*rxt(k,430)*y(k,228) +.400_r8*rxt(k,436)*y(k,239))*y(k,232) & - + (rxt(k,160)*y(k,76) +.130_r8*rxt(k,299)*y(k,25) + & - .360_r8*rxt(k,328)*y(k,29) +.240_r8*rxt(k,358)*y(k,106) + & - .360_r8*rxt(k,372)*y(k,112) +.320_r8*rxt(k,405)*y(k,98) + & - .630_r8*rxt(k,460)*y(k,6) +.630_r8*rxt(k,463)*y(k,111))*y(k,133) & - + (rxt(k,152)*y(k,77) +rxt(k,153)*y(k,79) +rxt(k,214)*y(k,85) + & - rxt(k,217)*y(k,92) +rxt(k,243)*y(k,81) +rxt(k,245)*y(k,91) + & - rxt(k,276)*y(k,42))*y(k,132) + (.300_r8*rxt(k,283)*y(k,53) + & - .650_r8*rxt(k,297)*y(k,24) +.500_r8*rxt(k,305)*y(k,27) + & - .500_r8*rxt(k,340)*y(k,147) +.100_r8*rxt(k,360)*y(k,107) + & - .600_r8*rxt(k,407)*y(k,103) +.500_r8*rxt(k,415)*y(k,212))*y(k,243) & - + (rxt(k,291)*y(k,54) +rxt(k,144)*y(k,77) + & - 2.000_r8*rxt(k,145)*y(k,253) +rxt(k,226)*y(k,85) + & - rxt(k,249)*y(k,81) +rxt(k,294)*y(k,86))*y(k,242) + (rxt(k,2) + & - rxt(k,253)*y(k,73))*y(k,253) +rxt(k,20)*y(k,2) +rxt(k,21)*y(k,8) & - +rxt(k,28)*y(k,23) +rxt(k,29)*y(k,27) +rxt(k,30)*y(k,30) +rxt(k,31) & - *y(k,32) +rxt(k,37)*y(k,51) +rxt(k,38)*y(k,53) +rxt(k,42)*y(k,72) & - +2.000_r8*rxt(k,4)*y(k,79) +rxt(k,9)*y(k,89) +rxt(k,10)*y(k,90) & - +rxt(k,105)*y(k,91) +rxt(k,106)*y(k,92) +rxt(k,46)*y(k,94) & - +rxt(k,53)*y(k,109) +.500_r8*rxt(k,509)*y(k,124) +rxt(k,58)*y(k,127) & - +rxt(k,61)*y(k,142) +rxt(k,62)*y(k,147) +rxt(k,63)*y(k,148) & - +rxt(k,65)*y(k,205) +rxt(k,67)*y(k,207) +rxt(k,70)*y(k,210) & - +rxt(k,71)*y(k,212) +rxt(k,72)*y(k,214) +rxt(k,73)*y(k,216) - loss(k,129) = (rxt(k,440)* y(k,123) +rxt(k,439)* y(k,232) + het_rates(k,244)) & - * y(k,244) - prod(k,129) = (.200_r8*rxt(k,429)*y(k,66) +.140_r8*rxt(k,441)*y(k,141) + & - rxt(k,444)*y(k,142))*y(k,243) - loss(k,164) = (rxt(k,339)* y(k,123) +rxt(k,338)* y(k,232) + het_rates(k,245)) & - * y(k,245) - prod(k,164) = (.500_r8*rxt(k,340)*y(k,147) +rxt(k,345)*y(k,29))*y(k,243) - loss(k,194) = (rxt(k,343)* y(k,123) +rxt(k,341)* y(k,227) +rxt(k,342) & - * y(k,232) + het_rates(k,246))* y(k,246) - prod(k,194) = (rxt(k,344)*y(k,148) +rxt(k,346)*y(k,48) + & - .150_r8*rxt(k,481)*y(k,209))*y(k,243) + (.060_r8*rxt(k,460)*y(k,6) + & - .060_r8*rxt(k,463)*y(k,111))*y(k,133) +.150_r8*rxt(k,69)*y(k,209) - loss(k,192) = (rxt(k,472)* y(k,123) +rxt(k,470)* y(k,227) +rxt(k,471) & - * y(k,232) + het_rates(k,247))* y(k,247) - prod(k,192) = (.500_r8*rxt(k,479)*y(k,125) +rxt(k,480)*y(k,243))*y(k,208) & - +rxt(k,473)*y(k,243)*y(k,205) - loss(k,191) = (rxt(k,477)* y(k,123) +rxt(k,475)* y(k,227) +rxt(k,476) & - * y(k,232) + het_rates(k,248))* y(k,248) - prod(k,191) = (rxt(k,461)*y(k,6) +rxt(k,464)*y(k,111) +rxt(k,478)*y(k,207)) & - *y(k,243) - loss(k,161) = (rxt(k,447)* y(k,123) +rxt(k,446)* y(k,232) + het_rates(k,249)) & - * y(k,249) - prod(k,161) = (rxt(k,448)*y(k,210) +.650_r8*rxt(k,449)*y(k,211))*y(k,243) - loss(k,197) = (rxt(k,413)* y(k,123) +rxt(k,414)* y(k,125) +rxt(k,410) & - * y(k,226) +rxt(k,411)* y(k,227) +rxt(k,412)* y(k,232) & - + het_rates(k,250))* y(k,250) - prod(k,197) = (rxt(k,382)*y(k,94) +rxt(k,383)*y(k,96) +rxt(k,384)*y(k,97) + & - .400_r8*rxt(k,407)*y(k,103) +.500_r8*rxt(k,415)*y(k,212))*y(k,243) - loss(k,162) = (rxt(k,453)* y(k,123) +rxt(k,452)* y(k,232) + het_rates(k,251)) & - * y(k,251) - prod(k,162) = (.560_r8*rxt(k,451)*y(k,213) +rxt(k,454)*y(k,214))*y(k,243) - loss(k,135) = (rxt(k,456)* y(k,123) +rxt(k,455)* y(k,232) + het_rates(k,252)) & + prod(k,164) = (.350_r8*rxt(k,417)*y(k,8) +rxt(k,420)*y(k,10))*y(k,251) + loss(k,155) = (rxt(k,424)* y(k,129) +rxt(k,422)* y(k,240) + het_rates(k,230)) & + * y(k,230) + prod(k,155) = (rxt(k,423)*y(k,25) +.070_r8*rxt(k,448)*y(k,217) + & + .060_r8*rxt(k,450)*y(k,220))*y(k,251) + loss(k,202) = (rxt(k,302)* y(k,129) + 2._r8*rxt(k,299)* y(k,231) +rxt(k,300) & + * y(k,235) +rxt(k,301)* y(k,240) + het_rates(k,231))* y(k,231) + prod(k,202) = (rxt(k,305)*y(k,58) +rxt(k,306)*y(k,251))*y(k,30) & + +.500_r8*rxt(k,304)*y(k,251)*y(k,29) +rxt(k,52)*y(k,113) + loss(k,199) = (rxt(k,330)* y(k,129) +rxt(k,328)* y(k,235) +rxt(k,329) & + * y(k,240) + het_rates(k,232))* y(k,232) + prod(k,199) = (rxt(k,331)*y(k,32) +rxt(k,332)*y(k,33))*y(k,251) + loss(k,183) = (rxt(k,426)* y(k,129) +rxt(k,425)* y(k,240) + het_rates(k,233)) & + * y(k,233) + prod(k,183) = (.400_r8*rxt(k,415)*y(k,240) +rxt(k,416)*y(k,129))*y(k,227) & + +rxt(k,427)*y(k,251)*y(k,34) +rxt(k,442)*y(k,146)*y(k,139) + loss(k,239) = (rxt(k,398)* y(k,103) +rxt(k,313)* y(k,129) +rxt(k,324) & + * y(k,130) + 2._r8*rxt(k,310)* y(k,234) +rxt(k,311)* y(k,235) & + +rxt(k,312)* y(k,240) +rxt(k,384)* y(k,242) +rxt(k,389)* y(k,243) & + +rxt(k,351)* y(k,244) +rxt(k,409)* y(k,258) + het_rates(k,234)) & + * y(k,234) + prod(k,239) = (.100_r8*rxt(k,357)*y(k,111) +.280_r8*rxt(k,371)*y(k,118) + & + .080_r8*rxt(k,404)*y(k,100) +.060_r8*rxt(k,459)*y(k,6) + & + .060_r8*rxt(k,462)*y(k,116))*y(k,139) + (rxt(k,361)*y(k,235) + & + .450_r8*rxt(k,362)*y(k,240) +2.000_r8*rxt(k,363)*y(k,246) + & + rxt(k,364)*y(k,129) +rxt(k,365)*y(k,131))*y(k,246) & + + (.530_r8*rxt(k,351)*y(k,234) +.260_r8*rxt(k,352)*y(k,235) + & + .530_r8*rxt(k,354)*y(k,131) +.530_r8*rxt(k,355)*y(k,129))*y(k,244) & + + (rxt(k,308)*y(k,47) +.500_r8*rxt(k,315)*y(k,53) + & + rxt(k,334)*y(k,51) +.650_r8*rxt(k,480)*y(k,215))*y(k,251) & + + (.300_r8*rxt(k,340)*y(k,235) +.150_r8*rxt(k,341)*y(k,240) + & + rxt(k,342)*y(k,129))*y(k,254) + (rxt(k,36) +rxt(k,333)*y(k,131)) & + *y(k,51) + (.600_r8*rxt(k,60) +rxt(k,325))*y(k,144) & + + (.200_r8*rxt(k,366)*y(k,240) +rxt(k,367)*y(k,129))*y(k,248) & + +.130_r8*rxt(k,23)*y(k,12) +rxt(k,27)*y(k,16) +rxt(k,307)*y(k,131) & + *y(k,47) +rxt(k,35)*y(k,50) +.330_r8*rxt(k,45)*y(k,95) +rxt(k,47) & + *y(k,97) +1.340_r8*rxt(k,51)*y(k,111) +rxt(k,52)*y(k,113) +rxt(k,53) & + *y(k,114) +.300_r8*rxt(k,55)*y(k,118) +rxt(k,57)*y(k,132) +rxt(k,63) & + *y(k,154) +.500_r8*rxt(k,64)*y(k,210) +.650_r8*rxt(k,69)*y(k,215) + loss(k,246) = (rxt(k,201)* y(k,61) +rxt(k,399)* y(k,103) +rxt(k,281) & + * y(k,129) +rxt(k,300)* y(k,231) +rxt(k,328)* y(k,232) +rxt(k,311) & + * y(k,234) + 2._r8*(rxt(k,278) +rxt(k,279))* y(k,235) +rxt(k,280) & + * y(k,240) +rxt(k,385)* y(k,242) +rxt(k,390)* y(k,243) +rxt(k,352) & + * y(k,244) +rxt(k,361)* y(k,246) +rxt(k,464)* y(k,249) +rxt(k,340) & + * y(k,254) +rxt(k,469)* y(k,255) +rxt(k,474)* y(k,256) +rxt(k,410) & + * y(k,258) + het_rates(k,235))* y(k,235) + prod(k,246) = (2.000_r8*rxt(k,310)*y(k,234) +.900_r8*rxt(k,311)*y(k,235) + & + .450_r8*rxt(k,312)*y(k,240) +rxt(k,313)*y(k,129) + & + rxt(k,351)*y(k,244) +rxt(k,360)*y(k,246) +rxt(k,384)*y(k,242) + & + rxt(k,389)*y(k,243) +rxt(k,398)*y(k,103) +rxt(k,409)*y(k,258)) & + *y(k,234) + (rxt(k,40) +rxt(k,195)*y(k,58) +rxt(k,251)*y(k,75) + & + rxt(k,284)*y(k,251) +rxt(k,290)*y(k,250))*y(k,56) & + + (.830_r8*rxt(k,430)*y(k,236) +.170_r8*rxt(k,436)*y(k,247)) & + *y(k,129) + (.280_r8*rxt(k,327)*y(k,31) +.050_r8*rxt(k,404)*y(k,100)) & + *y(k,139) + (.330_r8*rxt(k,429)*y(k,236) + & + .070_r8*rxt(k,435)*y(k,247))*y(k,240) + (.700_r8*rxt(k,283)*y(k,55) + & + rxt(k,314)*y(k,52))*y(k,251) +rxt(k,87)*y(k,45) +rxt(k,34)*y(k,47) & + +rxt(k,89)*y(k,48) +rxt(k,35)*y(k,50) +rxt(k,37)*y(k,53) & + +.300_r8*rxt(k,55)*y(k,118) +.400_r8*rxt(k,60)*y(k,144) + loss(k,195) = (rxt(k,430)* y(k,129) +rxt(k,431)* y(k,130) +rxt(k,429) & + * y(k,240) + het_rates(k,236))* y(k,236) + prod(k,195) =.600_r8*rxt(k,25)*y(k,14) + loss(k,174) = ((rxt(k,348) +rxt(k,349))* y(k,129) + het_rates(k,237)) & + * y(k,237) + prod(k,174) =rxt(k,347)*y(k,251)*y(k,18) + loss(k,126) = ( + rxt(k,318) + rxt(k,319) + het_rates(k,238))* y(k,238) + prod(k,126) =rxt(k,42)*y(k,74) +.750_r8*rxt(k,317)*y(k,239)*y(k,129) + loss(k,191) = (rxt(k,317)* y(k,129) +rxt(k,316)* y(k,240) + het_rates(k,239)) & + * y(k,239) + prod(k,191) =rxt(k,323)*y(k,251)*y(k,27) + loss(k,256) = (rxt(k,231)* y(k,19) +rxt(k,237)* y(k,21) +rxt(k,274)* y(k,44) & + + (rxt(k,198) +rxt(k,199))* y(k,58) +rxt(k,205)* y(k,61) & + + (rxt(k,154) +rxt(k,155) +rxt(k,156))* y(k,78) +rxt(k,400) & + * y(k,103) +rxt(k,183)* y(k,129) +rxt(k,188)* y(k,130) +rxt(k,178) & + * y(k,131) +rxt(k,158)* y(k,138) +rxt(k,159)* y(k,139) +rxt(k,415) & + * y(k,227) +rxt(k,376)* y(k,228) +rxt(k,418)* y(k,229) +rxt(k,422) & + * y(k,230) +rxt(k,301)* y(k,231) +rxt(k,329)* y(k,232) +rxt(k,425) & + * y(k,233) +rxt(k,312)* y(k,234) +rxt(k,280)* y(k,235) +rxt(k,429) & + * y(k,236) +rxt(k,316)* y(k,239) + 2._r8*rxt(k,168)* y(k,240) & + +rxt(k,287)* y(k,241) +rxt(k,386)* y(k,242) +rxt(k,391)* y(k,243) & + +rxt(k,353)* y(k,244) +rxt(k,432)* y(k,245) +rxt(k,362)* y(k,246) & + +rxt(k,435)* y(k,247) +rxt(k,366)* y(k,248) +rxt(k,465)* y(k,249) & + +rxt(k,163)* y(k,251) +rxt(k,438)* y(k,252) +rxt(k,337)* y(k,253) & + +rxt(k,341)* y(k,254) +rxt(k,470)* y(k,255) +rxt(k,475)* y(k,256) & + +rxt(k,445)* y(k,257) +rxt(k,411)* y(k,258) +rxt(k,451)* y(k,259) & + +rxt(k,454)* y(k,260) + rxt(k,499) + het_rates(k,240))* y(k,240) + prod(k,256) = (rxt(k,162)*y(k,81) +rxt(k,165)*y(k,139) +rxt(k,181)*y(k,131) + & + rxt(k,212)*y(k,61) +rxt(k,242)*y(k,21) +rxt(k,260)*y(k,45) + & + rxt(k,263)*y(k,48) +rxt(k,282)*y(k,54) +rxt(k,285)*y(k,88) + & + rxt(k,286)*y(k,89) +rxt(k,294)*y(k,64) +.350_r8*rxt(k,296)*y(k,26) + & + rxt(k,303)*y(k,28) +rxt(k,309)*y(k,49) +rxt(k,320)*y(k,76) + & + rxt(k,321)*y(k,77) +rxt(k,335)*y(k,97) +rxt(k,350)*y(k,95) + & + .200_r8*rxt(k,359)*y(k,112) +.500_r8*rxt(k,370)*y(k,115) + & + .300_r8*rxt(k,395)*y(k,101) +rxt(k,396)*y(k,102) + & + rxt(k,403)*y(k,104) +rxt(k,407)*y(k,122) +rxt(k,408)*y(k,123) + & + .650_r8*rxt(k,417)*y(k,8) +.730_r8*rxt(k,428)*y(k,68) + & + .800_r8*rxt(k,440)*y(k,147) +.280_r8*rxt(k,448)*y(k,217) + & + .380_r8*rxt(k,450)*y(k,220) +.630_r8*rxt(k,456)*y(k,223) + & + .200_r8*rxt(k,480)*y(k,215) +rxt(k,486)*y(k,158) + & + .500_r8*rxt(k,496)*y(k,69))*y(k,251) + (rxt(k,281)*y(k,235) + & + rxt(k,289)*y(k,241) +rxt(k,302)*y(k,231) + & + .250_r8*rxt(k,317)*y(k,239) +rxt(k,330)*y(k,232) + & + rxt(k,338)*y(k,253) +rxt(k,348)*y(k,237) + & + .470_r8*rxt(k,355)*y(k,244) +rxt(k,377)*y(k,228) + & + .920_r8*rxt(k,387)*y(k,242) +.920_r8*rxt(k,393)*y(k,243) + & + rxt(k,401)*y(k,103) +rxt(k,412)*y(k,258) +rxt(k,419)*y(k,229) + & + rxt(k,424)*y(k,230) +.170_r8*rxt(k,430)*y(k,236) + & + .400_r8*rxt(k,433)*y(k,245) +.830_r8*rxt(k,436)*y(k,247) + & + rxt(k,439)*y(k,252) +rxt(k,446)*y(k,257) +rxt(k,452)*y(k,259) + & + rxt(k,455)*y(k,260) +.900_r8*rxt(k,471)*y(k,255) + & + .800_r8*rxt(k,476)*y(k,256))*y(k,129) + (rxt(k,201)*y(k,61) + & + 2.000_r8*rxt(k,278)*y(k,235) +rxt(k,300)*y(k,231) + & + .900_r8*rxt(k,311)*y(k,234) +rxt(k,328)*y(k,232) + & + .300_r8*rxt(k,340)*y(k,254) +.730_r8*rxt(k,352)*y(k,244) + & + rxt(k,361)*y(k,246) +rxt(k,385)*y(k,242) +rxt(k,390)*y(k,243) + & + 1.200_r8*rxt(k,399)*y(k,103) +.800_r8*rxt(k,410)*y(k,258) + & + .500_r8*rxt(k,464)*y(k,249) +rxt(k,469)*y(k,255) + & + rxt(k,474)*y(k,256))*y(k,235) + (.130_r8*rxt(k,298)*y(k,27) + & + .280_r8*rxt(k,327)*y(k,31) +.140_r8*rxt(k,357)*y(k,111) + & + .280_r8*rxt(k,371)*y(k,118) +.370_r8*rxt(k,404)*y(k,100) + & + .570_r8*rxt(k,459)*y(k,6) +.570_r8*rxt(k,462)*y(k,116))*y(k,139) & + + (rxt(k,275)*y(k,44) +.470_r8*rxt(k,354)*y(k,244) + & + rxt(k,388)*y(k,242) +rxt(k,394)*y(k,243) +rxt(k,402)*y(k,103) + & + rxt(k,413)*y(k,258))*y(k,131) + (.470_r8*rxt(k,351)*y(k,244) + & + rxt(k,384)*y(k,242) +rxt(k,389)*y(k,243) +rxt(k,398)*y(k,103) + & + rxt(k,409)*y(k,258))*y(k,234) + (rxt(k,194)*y(k,44) + & + rxt(k,197)*y(k,81) +rxt(k,259)*y(k,45) +rxt(k,262)*y(k,48))*y(k,58) & + + (.070_r8*rxt(k,429)*y(k,236) +.160_r8*rxt(k,432)*y(k,245) + & + .330_r8*rxt(k,435)*y(k,247))*y(k,240) + (rxt(k,230)*y(k,19) + & + rxt(k,276)*y(k,138))*y(k,44) + (rxt(k,11) +rxt(k,192))*y(k,92) & + + (.660_r8*rxt(k,50) +1.340_r8*rxt(k,51))*y(k,111) + (rxt(k,318) + & + rxt(k,319))*y(k,238) +rxt(k,19)*y(k,1) +.900_r8*rxt(k,20)*y(k,2) & + +rxt(k,21)*y(k,10) +1.500_r8*rxt(k,22)*y(k,11) +.560_r8*rxt(k,23) & + *y(k,12) +rxt(k,24)*y(k,13) +.600_r8*rxt(k,25)*y(k,14) & + +.600_r8*rxt(k,26)*y(k,15) +rxt(k,27)*y(k,16) +rxt(k,28)*y(k,25) & + +rxt(k,29)*y(k,29) +rxt(k,30)*y(k,32) +rxt(k,34)*y(k,47) +rxt(k,36) & + *y(k,51) +rxt(k,291)*y(k,250)*y(k,56) +2.000_r8*rxt(k,43)*y(k,76) & + +2.000_r8*rxt(k,44)*y(k,77) +rxt(k,157)*y(k,78) +rxt(k,153)*y(k,138) & + *y(k,81) +.670_r8*rxt(k,45)*y(k,95) +rxt(k,46)*y(k,96) +rxt(k,47) & + *y(k,97) +rxt(k,48)*y(k,104) +rxt(k,49)*y(k,106) +rxt(k,56)*y(k,123) & + +rxt(k,61)*y(k,148) +rxt(k,62)*y(k,153) +rxt(k,64)*y(k,210) & + +rxt(k,65)*y(k,211) +rxt(k,66)*y(k,212) +rxt(k,67)*y(k,213) & + +rxt(k,68)*y(k,214) +1.200_r8*rxt(k,69)*y(k,215) +rxt(k,70)*y(k,216) & + +rxt(k,72)*y(k,221) +rxt(k,73)*y(k,224) & + +1.200_r8*rxt(k,299)*y(k,231)*y(k,231) +rxt(k,288)*y(k,241) & + +rxt(k,392)*y(k,243) + loss(k,157) = (rxt(k,289)* y(k,129) +rxt(k,287)* y(k,240) + rxt(k,288) & + + het_rates(k,241))* y(k,241) + prod(k,157) =rxt(k,274)*y(k,240)*y(k,44) + loss(k,234) = (rxt(k,387)* y(k,129) +rxt(k,388)* y(k,131) +rxt(k,384) & + * y(k,234) +rxt(k,385)* y(k,235) +rxt(k,386)* y(k,240) & + + het_rates(k,242))* y(k,242) + prod(k,234) =.600_r8*rxt(k,405)*y(k,251)*y(k,100) + loss(k,235) = (rxt(k,393)* y(k,129) +rxt(k,394)* y(k,131) +rxt(k,389) & + * y(k,234) +rxt(k,390)* y(k,235) +rxt(k,391)* y(k,240) + rxt(k,392) & + + het_rates(k,243))* y(k,243) + prod(k,235) =.400_r8*rxt(k,405)*y(k,251)*y(k,100) + loss(k,236) = ((rxt(k,355) +rxt(k,356))* y(k,129) +rxt(k,354)* y(k,131) & + +rxt(k,351)* y(k,234) +rxt(k,352)* y(k,235) +rxt(k,353)* y(k,240) & + + het_rates(k,244))* y(k,244) + prod(k,236) = (.500_r8*rxt(k,358)*y(k,111) +.200_r8*rxt(k,359)*y(k,112) + & + rxt(k,372)*y(k,118))*y(k,251) + loss(k,192) = (rxt(k,433)* y(k,129) +rxt(k,434)* y(k,130) +rxt(k,432) & + * y(k,240) + het_rates(k,245))* y(k,245) + prod(k,192) =.600_r8*rxt(k,24)*y(k,13) + loss(k,238) = (rxt(k,364)* y(k,129) +rxt(k,373)* y(k,130) +rxt(k,365) & + * y(k,131) +rxt(k,360)* y(k,234) +rxt(k,361)* y(k,235) +rxt(k,362) & + * y(k,240) + 2._r8*rxt(k,363)* y(k,246) + het_rates(k,246))* y(k,246) + prod(k,238) = (.660_r8*rxt(k,51) +.500_r8*rxt(k,358)*y(k,251))*y(k,111) & + + (rxt(k,54) +rxt(k,374))*y(k,115) +.500_r8*rxt(k,359)*y(k,251) & + *y(k,112) + loss(k,207) = (rxt(k,436)* y(k,129) +rxt(k,437)* y(k,130) +rxt(k,435) & + * y(k,240) + het_rates(k,247))* y(k,247) + prod(k,207) =.600_r8*rxt(k,26)*y(k,15) + loss(k,187) = (rxt(k,367)* y(k,129) +rxt(k,366)* y(k,240) + het_rates(k,248)) & + * y(k,248) + prod(k,187) = (rxt(k,368)*y(k,113) +rxt(k,369)*y(k,114))*y(k,251) + loss(k,220) = (rxt(k,466)* y(k,129) +rxt(k,467)* y(k,131) +rxt(k,464) & + * y(k,235) +rxt(k,465)* y(k,240) + het_rates(k,249))* y(k,249) + prod(k,220) = (rxt(k,458)*y(k,6) +rxt(k,461)*y(k,116) + & + .500_r8*rxt(k,478)*y(k,214))*y(k,131) +rxt(k,468)*y(k,251)*y(k,133) + loss(k,248) = (rxt(k,219)* y(k,35) +rxt(k,220)* y(k,36) +rxt(k,246)* y(k,37) & + +rxt(k,221)* y(k,38) +rxt(k,222)* y(k,39) +rxt(k,223)* y(k,40) & + +rxt(k,224)* y(k,41) +rxt(k,225)* y(k,42) +rxt(k,269)* y(k,43) & + +rxt(k,270)* y(k,45) + (rxt(k,290) +rxt(k,291) +rxt(k,292))* y(k,56) & + +rxt(k,247)* y(k,57) +rxt(k,255)* y(k,66) +rxt(k,256)* y(k,67) & + +rxt(k,144)* y(k,79) +rxt(k,248)* y(k,80) + (rxt(k,249) +rxt(k,250)) & + * y(k,83) +rxt(k,271)* y(k,84) +rxt(k,272)* y(k,85) +rxt(k,273) & + * y(k,86) + (rxt(k,226) +rxt(k,227))* y(k,87) +rxt(k,293)* y(k,88) & + + (rxt(k,186) +rxt(k,187))* y(k,120) +rxt(k,148)* y(k,139) & + +rxt(k,145)* y(k,261) + rxt(k,146) + rxt(k,147) + het_rates(k,250)) & + * y(k,250) + prod(k,248) =rxt(k,12)*y(k,120) +rxt(k,7)*y(k,139) +rxt(k,1)*y(k,261) + loss(k,249) = (rxt(k,375)* y(k,1) +rxt(k,379)* y(k,2) +rxt(k,460)* y(k,6) & + +rxt(k,417)* y(k,8) +rxt(k,420)* y(k,10) +rxt(k,380)* y(k,17) & + +rxt(k,347)* y(k,18) +rxt(k,242)* y(k,21) +rxt(k,421)* y(k,24) & + +rxt(k,423)* y(k,25) +rxt(k,296)* y(k,26) +rxt(k,323)* y(k,27) & + +rxt(k,303)* y(k,28) +rxt(k,304)* y(k,29) +rxt(k,306)* y(k,30) & + +rxt(k,344)* y(k,31) +rxt(k,331)* y(k,32) +rxt(k,332)* y(k,33) & + +rxt(k,427)* y(k,34) +rxt(k,258)* y(k,43) +rxt(k,277)* y(k,44) & + +rxt(k,260)* y(k,45) +rxt(k,261)* y(k,46) +rxt(k,308)* y(k,47) & + +rxt(k,263)* y(k,48) +rxt(k,309)* y(k,49) +rxt(k,345)* y(k,50) & + +rxt(k,334)* y(k,51) +rxt(k,314)* y(k,52) +rxt(k,315)* y(k,53) & + +rxt(k,282)* y(k,54) +rxt(k,283)* y(k,55) +rxt(k,284)* y(k,56) & + +rxt(k,265)* y(k,57) + (rxt(k,212) +rxt(k,213))* y(k,61) +rxt(k,210) & + * y(k,62) +rxt(k,294)* y(k,64) +rxt(k,428)* y(k,68) + (rxt(k,482) + & + rxt(k,496))* y(k,69) +rxt(k,320)* y(k,76) +rxt(k,321)* y(k,77) & + +rxt(k,161)* y(k,79) +rxt(k,162)* y(k,81) +rxt(k,244)* y(k,83) & + +rxt(k,266)* y(k,84) +rxt(k,267)* y(k,85) +rxt(k,268)* y(k,86) & + +rxt(k,215)* y(k,87) +rxt(k,285)* y(k,88) +rxt(k,286)* y(k,89) & + +rxt(k,191)* y(k,91) +rxt(k,169)* y(k,92) +rxt(k,218)* y(k,94) & + +rxt(k,350)* y(k,95) +rxt(k,381)* y(k,96) +rxt(k,335)* y(k,97) & + +rxt(k,382)* y(k,98) +rxt(k,383)* y(k,99) +rxt(k,405)* y(k,100) & + +rxt(k,395)* y(k,101) +rxt(k,396)* y(k,102) +rxt(k,403)* y(k,104) & + +rxt(k,406)* y(k,106) +rxt(k,358)* y(k,111) +rxt(k,359)* y(k,112) & + +rxt(k,368)* y(k,113) +rxt(k,369)* y(k,114) +rxt(k,370)* y(k,115) & + +rxt(k,463)* y(k,116) +rxt(k,372)* y(k,118) +rxt(k,182)* y(k,119) & + +rxt(k,407)* y(k,122) +rxt(k,408)* y(k,123) +rxt(k,498)* y(k,127) & + +rxt(k,190)* y(k,130) +rxt(k,181)* y(k,131) +rxt(k,336)* y(k,132) & + +rxt(k,468)* y(k,133) +rxt(k,164)* y(k,138) +rxt(k,165)* y(k,139) & + +rxt(k,484)* y(k,142) +rxt(k,322)* y(k,144) +rxt(k,440)* y(k,147) & + +rxt(k,443)* y(k,148) +rxt(k,339)* y(k,153) +rxt(k,343)* y(k,154) & + +rxt(k,490)* y(k,155) +rxt(k,495)* y(k,157) +rxt(k,486)* y(k,158) & + +rxt(k,472)* y(k,211) +rxt(k,473)* y(k,212) +rxt(k,477)* y(k,213) & + +rxt(k,479)* y(k,214) +rxt(k,480)* y(k,215) +rxt(k,447)* y(k,216) & + +rxt(k,448)* y(k,217) +rxt(k,414)* y(k,219) +rxt(k,450)* y(k,220) & + +rxt(k,453)* y(k,221) +rxt(k,456)* y(k,223) +rxt(k,457)* y(k,224) & + +rxt(k,163)* y(k,240) + 2._r8*(rxt(k,166) +rxt(k,167))* y(k,251) & + + het_rates(k,251))* y(k,251) + prod(k,249) = (2.000_r8*rxt(k,155)*y(k,78) +rxt(k,158)*y(k,138) + & + rxt(k,159)*y(k,139) +rxt(k,178)*y(k,131) +rxt(k,183)*y(k,129) + & + rxt(k,199)*y(k,58) +.450_r8*rxt(k,312)*y(k,234) + & + .150_r8*rxt(k,341)*y(k,254) +.450_r8*rxt(k,362)*y(k,246) + & + .200_r8*rxt(k,366)*y(k,248) +.400_r8*rxt(k,415)*y(k,227) + & + .400_r8*rxt(k,429)*y(k,236) +.400_r8*rxt(k,435)*y(k,247))*y(k,240) & + + (rxt(k,160)*y(k,78) +.130_r8*rxt(k,298)*y(k,27) + & + .360_r8*rxt(k,327)*y(k,31) +.240_r8*rxt(k,357)*y(k,111) + & + .360_r8*rxt(k,371)*y(k,118) +.320_r8*rxt(k,404)*y(k,100) + & + .630_r8*rxt(k,459)*y(k,6) +.630_r8*rxt(k,462)*y(k,116))*y(k,139) & + + (rxt(k,152)*y(k,79) +rxt(k,153)*y(k,81) +rxt(k,214)*y(k,87) + & + rxt(k,217)*y(k,94) +rxt(k,243)*y(k,83) +rxt(k,245)*y(k,93) + & + rxt(k,276)*y(k,44))*y(k,138) + (.300_r8*rxt(k,283)*y(k,55) + & + .650_r8*rxt(k,296)*y(k,26) +.500_r8*rxt(k,304)*y(k,29) + & + .500_r8*rxt(k,339)*y(k,153) +.100_r8*rxt(k,359)*y(k,112) + & + .600_r8*rxt(k,406)*y(k,106) +.500_r8*rxt(k,414)*y(k,219))*y(k,251) & + + (rxt(k,144)*y(k,79) +2.000_r8*rxt(k,145)*y(k,261) + & + rxt(k,226)*y(k,87) +rxt(k,249)*y(k,83) +rxt(k,290)*y(k,56) + & + rxt(k,293)*y(k,88))*y(k,250) + (rxt(k,2) +rxt(k,253)*y(k,75)) & + *y(k,261) +rxt(k,20)*y(k,2) +rxt(k,21)*y(k,10) +rxt(k,28)*y(k,25) & + +rxt(k,29)*y(k,29) +rxt(k,30)*y(k,32) +rxt(k,31)*y(k,34) +rxt(k,37) & + *y(k,53) +rxt(k,38)*y(k,55) +.330_r8*rxt(k,39)*y(k,56) +rxt(k,42) & + *y(k,74) +2.000_r8*rxt(k,4)*y(k,81) +rxt(k,9)*y(k,91) +rxt(k,10) & + *y(k,92) +rxt(k,105)*y(k,93) +rxt(k,106)*y(k,94) +rxt(k,46)*y(k,96) & + +rxt(k,49)*y(k,106) +rxt(k,53)*y(k,114) +.500_r8*rxt(k,507)*y(k,130) & + +rxt(k,58)*y(k,133) +rxt(k,61)*y(k,148) +rxt(k,62)*y(k,153) & + +rxt(k,63)*y(k,154) +rxt(k,65)*y(k,211) +rxt(k,67)*y(k,213) & + +rxt(k,70)*y(k,216) +rxt(k,71)*y(k,219) +rxt(k,72)*y(k,221) & + +rxt(k,73)*y(k,224) + loss(k,158) = (rxt(k,439)* y(k,129) +rxt(k,438)* y(k,240) + het_rates(k,252)) & * y(k,252) - prod(k,135) = (.300_r8*rxt(k,457)*y(k,215) +rxt(k,458)*y(k,216))*y(k,243) - loss(k,225) = (rxt(k,253)* y(k,73) +rxt(k,498)* y(k,153) +rxt(k,145) & - * y(k,242) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,253)) & + prod(k,158) = (.200_r8*rxt(k,428)*y(k,68) +.140_r8*rxt(k,440)*y(k,147) + & + rxt(k,443)*y(k,148))*y(k,251) + loss(k,196) = (rxt(k,338)* y(k,129) +rxt(k,337)* y(k,240) + het_rates(k,253)) & * y(k,253) - prod(k,225) = (rxt(k,258)*y(k,41) +rxt(k,260)*y(k,43) +rxt(k,261)*y(k,44) + & - rxt(k,263)*y(k,46) +rxt(k,268)*y(k,84) +rxt(k,284)*y(k,54) + & - rxt(k,161)*y(k,77) +rxt(k,162)*y(k,79) +rxt(k,163)*y(k,232) + & - rxt(k,166)*y(k,243) +rxt(k,169)*y(k,90) +rxt(k,191)*y(k,89) + & - rxt(k,215)*y(k,85) +rxt(k,218)*y(k,92) +rxt(k,244)*y(k,81) + & - rxt(k,277)*y(k,42) +rxt(k,283)*y(k,53) +rxt(k,287)*y(k,87) + & - rxt(k,307)*y(k,28) +rxt(k,309)*y(k,45) +rxt(k,315)*y(k,50) + & - rxt(k,316)*y(k,51) +rxt(k,332)*y(k,30) +rxt(k,333)*y(k,31) + & - rxt(k,335)*y(k,49) +rxt(k,340)*y(k,147) +rxt(k,344)*y(k,148) + & - rxt(k,346)*y(k,48) +.500_r8*rxt(k,359)*y(k,106) +rxt(k,499)*y(k,121)) & - *y(k,243) + (rxt(k,531)*y(k,92) +rxt(k,537)*y(k,92) + & - rxt(k,538)*y(k,91) +rxt(k,542)*y(k,92) +rxt(k,543)*y(k,91))*y(k,85) & - +rxt(k,156)*y(k,232)*y(k,76) +rxt(k,109)*y(k,80) + prod(k,196) = (.500_r8*rxt(k,339)*y(k,153) +rxt(k,344)*y(k,31))*y(k,251) + loss(k,226) = (rxt(k,342)* y(k,129) +rxt(k,340)* y(k,235) +rxt(k,341) & + * y(k,240) + het_rates(k,254))* y(k,254) + prod(k,226) = (rxt(k,343)*y(k,154) +rxt(k,345)*y(k,50) + & + .150_r8*rxt(k,480)*y(k,215))*y(k,251) + (.060_r8*rxt(k,459)*y(k,6) + & + .060_r8*rxt(k,462)*y(k,116))*y(k,139) +.150_r8*rxt(k,69)*y(k,215) + loss(k,225) = (rxt(k,471)* y(k,129) +rxt(k,469)* y(k,235) +rxt(k,470) & + * y(k,240) + het_rates(k,255))* y(k,255) + prod(k,225) = (.500_r8*rxt(k,478)*y(k,131) +rxt(k,479)*y(k,251))*y(k,214) & + +rxt(k,472)*y(k,251)*y(k,211) + loss(k,211) = (rxt(k,476)* y(k,129) +rxt(k,474)* y(k,235) +rxt(k,475) & + * y(k,240) + het_rates(k,256))* y(k,256) + prod(k,211) = (rxt(k,460)*y(k,6) +rxt(k,463)*y(k,116) +rxt(k,477)*y(k,213)) & + *y(k,251) + loss(k,193) = (rxt(k,446)* y(k,129) +rxt(k,445)* y(k,240) + het_rates(k,257)) & + * y(k,257) + prod(k,193) = (rxt(k,447)*y(k,216) +.650_r8*rxt(k,448)*y(k,217))*y(k,251) + loss(k,229) = (rxt(k,412)* y(k,129) +rxt(k,413)* y(k,131) +rxt(k,409) & + * y(k,234) +rxt(k,410)* y(k,235) +rxt(k,411)* y(k,240) & + + het_rates(k,258))* y(k,258) + prod(k,229) = (rxt(k,381)*y(k,96) +rxt(k,382)*y(k,98) +rxt(k,383)*y(k,99) + & + .400_r8*rxt(k,406)*y(k,106) +.500_r8*rxt(k,414)*y(k,219))*y(k,251) + loss(k,194) = (rxt(k,452)* y(k,129) +rxt(k,451)* y(k,240) + het_rates(k,259)) & + * y(k,259) + prod(k,194) = (.560_r8*rxt(k,450)*y(k,220) +rxt(k,453)*y(k,221))*y(k,251) + loss(k,165) = (rxt(k,455)* y(k,129) +rxt(k,454)* y(k,240) + het_rates(k,260)) & + * y(k,260) + prod(k,165) = (.300_r8*rxt(k,456)*y(k,223) +rxt(k,457)*y(k,224))*y(k,251) + loss(k,259) = (rxt(k,253)* y(k,75) +rxt(k,497)* y(k,159) +rxt(k,145) & + * y(k,250) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,261)) & + * y(k,261) + prod(k,259) = (rxt(k,161)*y(k,79) +rxt(k,162)*y(k,81) +rxt(k,163)*y(k,240) + & + rxt(k,166)*y(k,251) +rxt(k,169)*y(k,92) +rxt(k,191)*y(k,91) + & + rxt(k,215)*y(k,87) +rxt(k,218)*y(k,94) +rxt(k,244)*y(k,83) + & + rxt(k,258)*y(k,43) +rxt(k,260)*y(k,45) +rxt(k,261)*y(k,46) + & + rxt(k,263)*y(k,48) +rxt(k,268)*y(k,86) +rxt(k,277)*y(k,44) + & + rxt(k,283)*y(k,55) +rxt(k,284)*y(k,56) +rxt(k,286)*y(k,89) + & + rxt(k,306)*y(k,30) +rxt(k,308)*y(k,47) +rxt(k,314)*y(k,52) + & + rxt(k,315)*y(k,53) +rxt(k,331)*y(k,32) +rxt(k,332)*y(k,33) + & + rxt(k,334)*y(k,51) +rxt(k,339)*y(k,153) +rxt(k,343)*y(k,154) + & + rxt(k,345)*y(k,50) +.500_r8*rxt(k,358)*y(k,111) +rxt(k,498)*y(k,127)) & + *y(k,251) + (rxt(k,546)*y(k,94) +rxt(k,552)*y(k,94) + & + rxt(k,553)*y(k,93) +rxt(k,557)*y(k,94) +rxt(k,558)*y(k,93))*y(k,87) & + +.050_r8*rxt(k,39)*y(k,56) +rxt(k,156)*y(k,240)*y(k,78) +rxt(k,109) & + *y(k,82) end do end subroutine imp_prod_loss end module mo_prod_loss diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_rxt_rates_conv.F90 index 34e48f826e..34d3fbf509 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_rxt_rates_conv.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_rxt_rates_conv.F90 @@ -8,552 +8,567 @@ 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,:, 253) ! rate_const*H2O - rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 253) ! rate_const*H2O - rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 253) ! rate_const*H2O - rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 79) ! rate_const*H2O2 + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 261) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 261) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 261) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 81) ! rate_const*H2O2 ! rate_const*O2 ! rate_const*O2 - rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 133) ! rate_const*O3 - rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 133) ! rate_const*O3 - rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 89) ! rate_const*HNO3 - rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 90) ! rate_const*HO2NO2 - rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 90) ! rate_const*HO2NO2 - rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 114) ! rate_const*N2O - rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 115) ! rate_const*N2O5 - rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 115) ! rate_const*N2O5 - rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 123) ! rate_const*NO - rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 124) ! rate_const*NO2 - rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 125) ! rate_const*NO3 - rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 125) ! rate_const*NO3 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 139) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 139) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 91) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 92) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 92) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 120) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 129) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 130) ! rate_const*NO2 + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 131) ! rate_const*NO3 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 131) ! rate_const*NO3 rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 1) ! rate_const*ALKNIT rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 2) ! rate_const*ALKOOH - rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 8) ! rate_const*BENZOOH - rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 9) ! rate_const*BEPOMUC - rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 10) ! rate_const*BIGALD - rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 11) ! rate_const*BIGALD1 - rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 12) ! rate_const*BIGALD2 - rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 13) ! rate_const*BIGALD3 - rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 14) ! rate_const*BIGALD4 - rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 23) ! rate_const*BZOOH - rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 27) ! rate_const*C2H5OOH - rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*C3H7OOH - rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 32) ! rate_const*C6H5OOH - rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 42) ! rate_const*CH2O - rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 42) ! rate_const*CH2O - rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 45) ! rate_const*CH3CHO - rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 48) ! rate_const*CH3COCH3 - rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 49) ! rate_const*CH3COCHO - rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 51) ! rate_const*CH3COOOH - rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 53) ! rate_const*CH3OOH - rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 54) ! rate_const*CH4 - rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 54) ! rate_const*CH4 - rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 63) ! rate_const*CO2 - rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 72) ! rate_const*EOOH - rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 74) ! rate_const*GLYALD - rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 75) ! rate_const*GLYOXAL - rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 93) ! rate_const*HONITR - rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 94) ! rate_const*HPALD - rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 95) ! rate_const*HYAC - rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 102) ! rate_const*ISOPNOOH - rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 103) ! rate_const*ISOPOOH - rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 106) ! rate_const*MACR - rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 106) ! rate_const*MACR - rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 108) ! rate_const*MEK - rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 109) ! rate_const*MEKOOH - rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 110) ! rate_const*MPAN - rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 112) ! rate_const*MVK - rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 117) ! rate_const*NC4CHO - rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 126) ! rate_const*NOA - rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 127) ! rate_const*NTERPOOH - rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 137) ! rate_const*ONITR - rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 138) ! rate_const*PAN - rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 142) ! rate_const*PHENOOH - rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 147) ! rate_const*POOH - rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 148) ! rate_const*ROOH - rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 204) ! rate_const*TEPOMUC - rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 205) ! rate_const*TERP2OOH - rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 206) ! rate_const*TERPNIT - rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 207) ! rate_const*TERPOOH - rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 208) ! rate_const*TERPROD1 - rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 209) ! rate_const*TERPROD2 - rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 210) ! rate_const*TOLOOH - rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 212) ! rate_const*XOOH - rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 214) ! rate_const*XYLENOOH - rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 216) ! rate_const*XYLOLOOH - rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 18) ! rate_const*BRCL - rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 19) ! rate_const*BRO - rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 20) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 20) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 33) ! rate_const*CCL4 - rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 34) ! rate_const*CF2CLBR - rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 35) ! rate_const*CF3BR - rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 36) ! rate_const*CFC11 - rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 37) ! rate_const*CFC113 - rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 38) ! rate_const*CFC114 - rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 39) ! rate_const*CFC115 - rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 40) ! rate_const*CFC12 - rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 41) ! rate_const*CH2BR2 - rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 43) ! rate_const*CH3BR - rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 44) ! rate_const*CH3CCL3 - rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 46) ! rate_const*CH3CL - rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 55) ! rate_const*CHBR3 - rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 57) ! rate_const*CL2 - rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 58) ! rate_const*CL2O2 - rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 59) ! rate_const*CLO - rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 60) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 60) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 64) ! rate_const*COF2 - rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 65) ! rate_const*COFCL - rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 78) ! rate_const*H2402 - rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 81) ! rate_const*HBR - rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 82) ! rate_const*HCFC141B - rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 83) ! rate_const*HCFC142B - rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 84) ! rate_const*HCFC22 - rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 85) ! rate_const*HCL - rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 88) ! rate_const*HF - rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 91) ! rate_const*HOBR - rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 92) ! rate_const*HOCL - rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 135) ! rate_const*OCLO - rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 150) ! rate_const*SF6 - rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 80) ! rate_const*H2SO4 - rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 136) ! rate_const*OCS - rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 151) ! rate_const*SO - rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 152) ! rate_const*SO2 - rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 153) ! rate_const*SO3 - rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 157) ! rate_const*soabb1_a1 - rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 158) ! rate_const*soabb1_a2 - rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 159) ! rate_const*soabb2_a1 - rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 160) ! rate_const*soabb2_a2 - rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 161) ! rate_const*soabb3_a1 - rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 162) ! rate_const*soabb3_a2 - rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 163) ! rate_const*soabb4_a1 - rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 164) ! rate_const*soabb4_a2 - rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 165) ! rate_const*soabb5_a1 - rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 166) ! rate_const*soabb5_a2 - rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 167) ! rate_const*soabg1_a1 - rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 168) ! rate_const*soabg1_a2 - rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 169) ! rate_const*soabg2_a1 - rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 170) ! rate_const*soabg2_a2 - rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 171) ! rate_const*soabg3_a1 - rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 172) ! rate_const*soabg3_a2 - rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 173) ! rate_const*soabg4_a1 - rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 174) ! rate_const*soabg4_a2 - rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 175) ! rate_const*soabg5_a1 - rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 176) ! rate_const*soabg5_a2 - rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 177) ! rate_const*soaff1_a1 - rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 178) ! rate_const*soaff1_a2 - rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 179) ! rate_const*soaff2_a1 - rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 180) ! rate_const*soaff2_a2 - rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 181) ! rate_const*soaff3_a1 - rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 182) ! rate_const*soaff3_a2 - rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 183) ! rate_const*soaff4_a1 - rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 184) ! rate_const*soaff4_a2 - rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 185) ! rate_const*soaff5_a1 - rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 186) ! rate_const*soaff5_a2 - rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 242)*sol(:ncol,:, 77) ! rate_const*O1D*H2 - rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 242)*sol(:ncol,:, 253) ! rate_const*O1D*H2O - rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 242) ! rate_const*N2*O1D - rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 242) ! rate_const*O2*O1D - rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 242)*sol(:ncol,:, 133) ! rate_const*O1D*O3 - rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 132)*sol(:ncol,:, 133) ! rate_const*O*O3 - rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 132)*sol(:ncol,:, 132) ! rate_const*M*O*O - rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 132) ! rate_const*O2*M*O - rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 77)*sol(:ncol,:, 132) ! rate_const*H2*O - rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 79)*sol(:ncol,:, 132) ! rate_const*H2O2*O - rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 76)*sol(:ncol,:, 232) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 76)*sol(:ncol,:, 232) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 76)*sol(:ncol,:, 232) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 76) ! rate_const*O2*M*H - rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 232)*sol(:ncol,:, 132) ! rate_const*HO2*O - rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 232)*sol(:ncol,:, 133) ! rate_const*HO2*O3 - rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 76)*sol(:ncol,:, 133) ! rate_const*H*O3 - rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 243)*sol(:ncol,:, 77) ! rate_const*OH*H2 - rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 243)*sol(:ncol,:, 79) ! rate_const*OH*H2O2 - rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 243)*sol(:ncol,:, 232) ! rate_const*OH*HO2 - rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 243)*sol(:ncol,:, 132) ! rate_const*OH*O - rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 243)*sol(:ncol,:, 133) ! rate_const*OH*O3 - rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 243)*sol(:ncol,:, 243) ! rate_const*OH*OH - rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 243)*sol(:ncol,:, 243) ! rate_const*M*OH*OH - rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 232)*sol(:ncol,:, 232) ! rate_const*HO2*HO2 - rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 90)*sol(:ncol,:, 243) ! rate_const*HO2NO2*OH - rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 113)*sol(:ncol,:, 123) ! rate_const*N*NO - rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 113)*sol(:ncol,:, 124) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 113)*sol(:ncol,:, 124) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 113)*sol(:ncol,:, 124) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 113) ! rate_const*O2*N - rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 124)*sol(:ncol,:, 132) ! rate_const*NO2*O - rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 124)*sol(:ncol,:, 133) ! rate_const*NO2*O3 - rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 124)*sol(:ncol,:, 132) ! rate_const*M*NO2*O - rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 125)*sol(:ncol,:, 232) ! rate_const*NO3*HO2 - rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 125)*sol(:ncol,:, 123) ! rate_const*NO3*NO - rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 125)*sol(:ncol,:, 132) ! rate_const*NO3*O - rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 125)*sol(:ncol,:, 243) ! rate_const*NO3*OH - rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 113)*sol(:ncol,:, 243) ! rate_const*N*OH - rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 123)*sol(:ncol,:, 232) ! rate_const*NO*HO2 - rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 123)*sol(:ncol,:, 133) ! rate_const*NO*O3 - rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 123)*sol(:ncol,:, 132) ! rate_const*M*NO*O - rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 242)*sol(:ncol,:, 114) ! rate_const*O1D*N2O - rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 242)*sol(:ncol,:, 114) ! rate_const*O1D*N2O - rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 124)*sol(:ncol,:, 232) ! rate_const*M*NO2*HO2 - rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 124)*sol(:ncol,:, 125) ! rate_const*M*NO2*NO3 - rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 124)*sol(:ncol,:, 243) ! rate_const*M*NO2*OH - rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 89)*sol(:ncol,:, 243) ! rate_const*HNO3*OH - rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 90) ! rate_const*M*HO2NO2 - rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 115) ! rate_const*M*N2O5 - rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 56)*sol(:ncol,:, 42) ! rate_const*CL*CH2O - rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 56)*sol(:ncol,:, 54) ! rate_const*CL*CH4 - rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 56)*sol(:ncol,:, 77) ! rate_const*CL*H2 - rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 56)*sol(:ncol,:, 79) ! rate_const*CL*H2O2 - rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 56)*sol(:ncol,:, 232) ! rate_const*CL*HO2 - rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 56)*sol(:ncol,:, 232) ! rate_const*CL*HO2 - rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 56)*sol(:ncol,:, 133) ! rate_const*CL*O3 - rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 59)*sol(:ncol,:, 227) ! rate_const*CLO*CH3O2 - rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 59)*sol(:ncol,:, 232) ! rate_const*CLO*HO2 - rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 59)*sol(:ncol,:, 123) ! rate_const*CLO*NO - rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 60)*sol(:ncol,:, 56) ! rate_const*CLONO2*CL - rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 59)*sol(:ncol,:, 124) ! rate_const*M*CLO*NO2 - rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 60)*sol(:ncol,:, 132) ! rate_const*CLONO2*O - rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 60)*sol(:ncol,:, 243) ! rate_const*CLONO2*OH - rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 59)*sol(:ncol,:, 132) ! rate_const*CLO*O - rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 59)*sol(:ncol,:, 243) ! rate_const*CLO*OH - rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 59)*sol(:ncol,:, 243) ! rate_const*CLO*OH - rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 85)*sol(:ncol,:, 132) ! rate_const*HCL*O - rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 85)*sol(:ncol,:, 243) ! rate_const*HCL*OH - rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 92)*sol(:ncol,:, 56) ! rate_const*HOCL*CL - rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 92)*sol(:ncol,:, 132) ! rate_const*HOCL*O - rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 92)*sol(:ncol,:, 243) ! rate_const*HOCL*OH - rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 242)*sol(:ncol,:, 33) ! rate_const*O1D*CCL4 - rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 242)*sol(:ncol,:, 34) ! rate_const*O1D*CF2CLBR - rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 242)*sol(:ncol,:, 36) ! rate_const*O1D*CFC11 - rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 242)*sol(:ncol,:, 37) ! rate_const*O1D*CFC113 - rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 242)*sol(:ncol,:, 38) ! rate_const*O1D*CFC114 - rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 242)*sol(:ncol,:, 39) ! rate_const*O1D*CFC115 - rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 242)*sol(:ncol,:, 40) ! rate_const*O1D*CFC12 - rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 242)*sol(:ncol,:, 85) ! rate_const*O1D*HCL - rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 242)*sol(:ncol,:, 85) ! rate_const*O1D*HCL - rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*M*CLO*CLO - rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 58) ! rate_const*M*CL2O2 - rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 17)*sol(:ncol,:, 42) ! rate_const*BR*CH2O - rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 17)*sol(:ncol,:, 232) ! rate_const*BR*HO2 - rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 17)*sol(:ncol,:, 133) ! rate_const*BR*O3 - rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 19)*sol(:ncol,:, 19) ! rate_const*BRO*BRO - rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 19)*sol(:ncol,:, 232) ! rate_const*BRO*HO2 - rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 19)*sol(:ncol,:, 123) ! rate_const*BRO*NO - rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 19)*sol(:ncol,:, 124) ! rate_const*M*BRO*NO2 - rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 20)*sol(:ncol,:, 132) ! rate_const*BRONO2*O - rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 19)*sol(:ncol,:, 132) ! rate_const*BRO*O - rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 19)*sol(:ncol,:, 243) ! rate_const*BRO*OH - rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 81)*sol(:ncol,:, 132) ! rate_const*HBR*O - rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 81)*sol(:ncol,:, 243) ! rate_const*HBR*OH - rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 91)*sol(:ncol,:, 132) ! rate_const*HOBR*O - rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 242)*sol(:ncol,:, 35) ! rate_const*O1D*CF3BR - rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 242)*sol(:ncol,:, 55) ! rate_const*O1D*CHBR3 - rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 242)*sol(:ncol,:, 78) ! rate_const*O1D*H2402 - rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 242)*sol(:ncol,:, 81) ! rate_const*O1D*HBR - rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 242)*sol(:ncol,:, 81) ! rate_const*O1D*HBR - rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 73)*sol(:ncol,:, 54) ! rate_const*F*CH4 - rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 73)*sol(:ncol,:, 77) ! rate_const*F*H2 - rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 73)*sol(:ncol,:, 253) ! rate_const*F*H2O - rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 73)*sol(:ncol,:, 89) ! rate_const*F*HNO3 - rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 242)*sol(:ncol,:, 64) ! rate_const*O1D*COF2 - rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 242)*sol(:ncol,:, 65) ! rate_const*O1D*COFCL - rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 41)*sol(:ncol,:, 56) ! rate_const*CH2BR2*CL - rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 41)*sol(:ncol,:, 243) ! rate_const*CH2BR2*OH - rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 43)*sol(:ncol,:, 56) ! rate_const*CH3BR*CL - rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 43)*sol(:ncol,:, 243) ! rate_const*CH3BR*OH - rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 44)*sol(:ncol,:, 243) ! rate_const*CH3CCL3*OH - rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 46)*sol(:ncol,:, 56) ! rate_const*CH3CL*CL - rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 46)*sol(:ncol,:, 243) ! rate_const*CH3CL*OH - rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 55)*sol(:ncol,:, 56) ! rate_const*CHBR3*CL - rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 55)*sol(:ncol,:, 243) ! rate_const*CHBR3*OH - rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 82)*sol(:ncol,:, 243) ! rate_const*HCFC141B*OH - rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 83)*sol(:ncol,:, 243) ! rate_const*HCFC142B*OH - rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 84)*sol(:ncol,:, 243) ! rate_const*HCFC22*OH - rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 242)*sol(:ncol,:, 41) ! rate_const*O1D*CH2BR2 - rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 242)*sol(:ncol,:, 43) ! rate_const*O1D*CH3BR - rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 242)*sol(:ncol,:, 82) ! rate_const*O1D*HCFC141B - rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 242)*sol(:ncol,:, 83) ! rate_const*O1D*HCFC142B - rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 242)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC22 - rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 42)*sol(:ncol,:, 232) ! rate_const*CH2O*HO2 - rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 42)*sol(:ncol,:, 125) ! rate_const*CH2O*NO3 - rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 42)*sol(:ncol,:, 132) ! rate_const*CH2O*O - rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 42)*sol(:ncol,:, 243) ! rate_const*CH2O*OH - rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 227)*sol(:ncol,:, 227) ! rate_const*CH3O2*CH3O2 - rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 227)*sol(:ncol,:, 227) ! rate_const*CH3O2*CH3O2 - rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 227)*sol(:ncol,:, 232) ! rate_const*CH3O2*HO2 - rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 227)*sol(:ncol,:, 123) ! rate_const*CH3O2*NO - rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 52)*sol(:ncol,:, 243) ! rate_const*CH3OH*OH - rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 53)*sol(:ncol,:, 243) ! rate_const*CH3OOH*OH - rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 54)*sol(:ncol,:, 243) ! rate_const*CH4*OH - rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 62)*sol(:ncol,:, 243) ! rate_const*M*CO*OH - rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 86)*sol(:ncol,:, 243) ! rate_const*M*HCN*OH - rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 87)*sol(:ncol,:, 243) ! rate_const*HCOOH*OH - rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 233)*sol(:ncol,:, 232) ! rate_const*HOCH2OO*HO2 - rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 233) ! rate_const*HOCH2OO - rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 233)*sol(:ncol,:, 123) ! rate_const*HOCH2OO*NO - rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 242)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 242)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 242)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 242)*sol(:ncol,:, 86) ! rate_const*O1D*HCN - rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 62)*sol(:ncol,:, 243) ! rate_const*CO*OH - rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 24)*sol(:ncol,:, 56) ! rate_const*M*C2H2*CL - rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 24)*sol(:ncol,:, 243) ! rate_const*M*C2H2*OH - rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 25)*sol(:ncol,:, 56) ! rate_const*M*C2H4*CL - rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 25)*sol(:ncol,:, 133) ! rate_const*C2H4*O3 - rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 223)*sol(:ncol,:, 223) ! rate_const*C2H5O2*C2H5O2 - rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 223)*sol(:ncol,:, 227) ! rate_const*C2H5O2*CH3O2 - rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 223)*sol(:ncol,:, 232) ! rate_const*C2H5O2*HO2 - rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 223)*sol(:ncol,:, 123) ! rate_const*C2H5O2*NO - rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 26)*sol(:ncol,:, 243) ! rate_const*C2H5OH*OH - rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 27)*sol(:ncol,:, 243) ! rate_const*C2H5OOH*OH - rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 28)*sol(:ncol,:, 56) ! rate_const*C2H6*CL - rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 28)*sol(:ncol,:, 243) ! rate_const*C2H6*OH - rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 45)*sol(:ncol,:, 125) ! rate_const*CH3CHO*NO3 - rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 45)*sol(:ncol,:, 243) ! rate_const*CH3CHO*OH - rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 47)*sol(:ncol,:, 243) ! rate_const*CH3CN*OH - rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 226)*sol(:ncol,:, 226) ! rate_const*CH3CO3*CH3CO3 - rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 226)*sol(:ncol,:, 227) ! rate_const*CH3CO3*CH3O2 - rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 226)*sol(:ncol,:, 232) ! rate_const*CH3CO3*HO2 - rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 226)*sol(:ncol,:, 123) ! rate_const*CH3CO3*NO - rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 50)*sol(:ncol,:, 243) ! rate_const*CH3COOH*OH - rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 51)*sol(:ncol,:, 243) ! rate_const*CH3COOOH*OH - rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 231)*sol(:ncol,:, 232) ! rate_const*EO2*HO2 - rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 231)*sol(:ncol,:, 123) ! rate_const*EO2*NO - rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 230) ! rate_const*EO - rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 230) ! rate_const*O2*EO - rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 74)*sol(:ncol,:, 243) ! rate_const*GLYALD*OH - rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 75)*sol(:ncol,:, 243) ! rate_const*GLYOXAL*OH - rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 138)*sol(:ncol,:, 243) ! rate_const*PAN*OH - rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 25)*sol(:ncol,:, 243) ! rate_const*M*C2H4*OH - rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 226)*sol(:ncol,:, 124) ! rate_const*M*CH3CO3*NO2 - rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 138) ! rate_const*M*PAN - rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 29)*sol(:ncol,:, 125) ! rate_const*C3H6*NO3 - rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 29)*sol(:ncol,:, 133) ! rate_const*C3H6*O3 - rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 224)*sol(:ncol,:, 227) ! rate_const*C3H7O2*CH3O2 - rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 224)*sol(:ncol,:, 232) ! rate_const*C3H7O2*HO2 - rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 224)*sol(:ncol,:, 123) ! rate_const*C3H7O2*NO - rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 30)*sol(:ncol,:, 243) ! rate_const*C3H7OOH*OH - rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 31)*sol(:ncol,:, 243) ! rate_const*C3H8*OH - rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 49)*sol(:ncol,:, 125) ! rate_const*CH3COCHO*NO3 - rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 49)*sol(:ncol,:, 243) ! rate_const*CH3COCHO*OH - rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 95)*sol(:ncol,:, 243) ! rate_const*HYAC*OH - rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 126)*sol(:ncol,:, 243) ! rate_const*NOA*OH - rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 245)*sol(:ncol,:, 232) ! rate_const*PO2*HO2 - rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 245)*sol(:ncol,:, 123) ! rate_const*PO2*NO - rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 147)*sol(:ncol,:, 243) ! rate_const*POOH*OH - rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 246)*sol(:ncol,:, 227) ! rate_const*RO2*CH3O2 - rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 246)*sol(:ncol,:, 232) ! rate_const*RO2*HO2 - rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 246)*sol(:ncol,:, 123) ! rate_const*RO2*NO - rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 148)*sol(:ncol,:, 243) ! rate_const*ROOH*OH - rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 29)*sol(:ncol,:, 243) ! rate_const*M*C3H6*OH - rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 48)*sol(:ncol,:, 243) ! rate_const*CH3COCH3*OH - rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 16)*sol(:ncol,:, 125) ! rate_const*BIGENE*NO3 - rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 16)*sol(:ncol,:, 243) ! rate_const*BIGENE*OH - rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 229)*sol(:ncol,:, 123) ! rate_const*ENEO2*NO - rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 229)*sol(:ncol,:, 123) ! rate_const*ENEO2*NO - rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 93)*sol(:ncol,:, 243) ! rate_const*HONITR*OH - rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 236)*sol(:ncol,:, 226) ! rate_const*MACRO2*CH3CO3 - rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 236)*sol(:ncol,:, 227) ! rate_const*MACRO2*CH3O2 - rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 236)*sol(:ncol,:, 232) ! rate_const*MACRO2*HO2 - rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 236)*sol(:ncol,:, 125) ! rate_const*MACRO2*NO3 - rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 236)*sol(:ncol,:, 123) ! rate_const*MACRO2*NO - rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 236)*sol(:ncol,:, 123) ! rate_const*MACRO2*NO - rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 106)*sol(:ncol,:, 133) ! rate_const*MACR*O3 - rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 106)*sol(:ncol,:, 243) ! rate_const*MACR*OH - rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 107)*sol(:ncol,:, 243) ! rate_const*MACROOH*OH - rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 238)*sol(:ncol,:, 226) ! rate_const*MCO3*CH3CO3 - rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 238)*sol(:ncol,:, 227) ! rate_const*MCO3*CH3O2 - rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 238)*sol(:ncol,:, 232) ! rate_const*MCO3*HO2 - rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 238)*sol(:ncol,:, 238) ! rate_const*MCO3*MCO3 - rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 238)*sol(:ncol,:, 123) ! rate_const*MCO3*NO - rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 238)*sol(:ncol,:, 125) ! rate_const*MCO3*NO3 - rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 240)*sol(:ncol,:, 232) ! rate_const*MEKO2*HO2 - rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 240)*sol(:ncol,:, 123) ! rate_const*MEKO2*NO - rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 108)*sol(:ncol,:, 243) ! rate_const*MEK*OH - rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 109)*sol(:ncol,:, 243) ! rate_const*MEKOOH*OH - rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 110)*sol(:ncol,:, 243) ! rate_const*M*MPAN*OH - rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 112)*sol(:ncol,:, 133) ! rate_const*MVK*O3 - rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 112)*sol(:ncol,:, 243) ! rate_const*MVK*OH - rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 238)*sol(:ncol,:, 124) ! rate_const*M*MCO3*NO2 - rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 110) ! rate_const*M*MPAN - rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 1)*sol(:ncol,:, 243) ! rate_const*ALKNIT*OH - rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 220)*sol(:ncol,:, 232) ! rate_const*ALKO2*HO2 - rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 220)*sol(:ncol,:, 123) ! rate_const*ALKO2*NO - rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 220)*sol(:ncol,:, 123) ! rate_const*ALKO2*NO - rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 2)*sol(:ncol,:, 243) ! rate_const*ALKOOH*OH - rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 15)*sol(:ncol,:, 243) ! rate_const*BIGALK*OH - rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 94)*sol(:ncol,:, 243) ! rate_const*HPALD*OH - rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 96)*sol(:ncol,:, 243) ! rate_const*HYDRALD*OH - rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 97)*sol(:ncol,:, 243) ! rate_const*IEPOX*OH - rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 234)*sol(:ncol,:, 226) ! rate_const*ISOPAO2*CH3CO3 - rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 234)*sol(:ncol,:, 227) ! rate_const*ISOPAO2*CH3O2 - rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 234)*sol(:ncol,:, 232) ! rate_const*ISOPAO2*HO2 - rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 234)*sol(:ncol,:, 123) ! rate_const*ISOPAO2*NO - rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 234)*sol(:ncol,:, 125) ! rate_const*ISOPAO2*NO3 - rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 235)*sol(:ncol,:, 226) ! rate_const*ISOPBO2*CH3CO3 - rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 235)*sol(:ncol,:, 227) ! rate_const*ISOPBO2*CH3O2 - rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 235)*sol(:ncol,:, 232) ! rate_const*ISOPBO2*HO2 - rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 235) ! rate_const*ISOPBO2 - rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 235)*sol(:ncol,:, 123) ! rate_const*ISOPBO2*NO - rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 235)*sol(:ncol,:, 125) ! rate_const*ISOPBO2*NO3 - rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 99)*sol(:ncol,:, 243) ! rate_const*ISOPNITA*OH - rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 100)*sol(:ncol,:, 243) ! rate_const*ISOPNITB*OH - rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 98)*sol(:ncol,:, 125) ! rate_const*ISOP*NO3 - rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 101)*sol(:ncol,:, 226) ! rate_const*ISOPNO3*CH3CO3 - rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 101)*sol(:ncol,:, 227) ! rate_const*ISOPNO3*CH3O2 - rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 101)*sol(:ncol,:, 232) ! rate_const*ISOPNO3*HO2 - rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 101)*sol(:ncol,:, 123) ! rate_const*ISOPNO3*NO - rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 101)*sol(:ncol,:, 125) ! rate_const*ISOPNO3*NO3 - rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 102)*sol(:ncol,:, 243) ! rate_const*ISOPNOOH*OH - rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 98)*sol(:ncol,:, 133) ! rate_const*ISOP*O3 - rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 98)*sol(:ncol,:, 243) ! rate_const*ISOP*OH - rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 103)*sol(:ncol,:, 243) ! rate_const*ISOPOOH*OH - rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 116)*sol(:ncol,:, 243) ! rate_const*NC4CH2OH*OH - rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 117)*sol(:ncol,:, 243) ! rate_const*NC4CHO*OH - rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 250)*sol(:ncol,:, 226) ! rate_const*XO2*CH3CO3 - rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 250)*sol(:ncol,:, 227) ! rate_const*XO2*CH3O2 - rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 250)*sol(:ncol,:, 232) ! rate_const*XO2*HO2 - rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 250)*sol(:ncol,:, 123) ! rate_const*XO2*NO - rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 250)*sol(:ncol,:, 125) ! rate_const*XO2*NO3 - rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 212)*sol(:ncol,:, 243) ! rate_const*XOOH*OH - rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 219)*sol(:ncol,:, 232) ! rate_const*ACBZO2*HO2 - rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 219)*sol(:ncol,:, 123) ! rate_const*ACBZO2*NO - rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 7)*sol(:ncol,:, 243) ! rate_const*BENZENE*OH - rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 221)*sol(:ncol,:, 232) ! rate_const*BENZO2*HO2 - rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 221)*sol(:ncol,:, 123) ! rate_const*BENZO2*NO - rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 8)*sol(:ncol,:, 243) ! rate_const*BENZOOH*OH - rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 22)*sol(:ncol,:, 243) ! rate_const*BZALD*OH - rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 222)*sol(:ncol,:, 232) ! rate_const*BZOO*HO2 - rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 23)*sol(:ncol,:, 243) ! rate_const*BZOOH*OH - rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 222)*sol(:ncol,:, 123) ! rate_const*BZOO*NO - rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 225)*sol(:ncol,:, 232) ! rate_const*C6H5O2*HO2 - rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 225)*sol(:ncol,:, 123) ! rate_const*C6H5O2*NO - rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 32)*sol(:ncol,:, 243) ! rate_const*C6H5OOH*OH - rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 66)*sol(:ncol,:, 243) ! rate_const*CRESOL*OH - rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 228)*sol(:ncol,:, 232) ! rate_const*DICARBO2*HO2 - rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 228)*sol(:ncol,:, 123) ! rate_const*DICARBO2*NO - rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 228)*sol(:ncol,:, 124) ! rate_const*M*DICARBO2*NO2 - rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 237)*sol(:ncol,:, 232) ! rate_const*MALO2*HO2 - rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 237)*sol(:ncol,:, 123) ! rate_const*MALO2*NO - rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 237)*sol(:ncol,:, 124) ! rate_const*M*MALO2*NO2 - rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 239)*sol(:ncol,:, 232) ! rate_const*MDIALO2*HO2 - rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 239)*sol(:ncol,:, 123) ! rate_const*MDIALO2*NO - rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 239)*sol(:ncol,:, 124) ! rate_const*M*MDIALO2*NO2 - rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 244)*sol(:ncol,:, 232) ! rate_const*PHENO2*HO2 - rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 244)*sol(:ncol,:, 123) ! rate_const*PHENO2*NO - rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 141)*sol(:ncol,:, 243) ! rate_const*PHENOL*OH - rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 140)*sol(:ncol,:, 124) ! rate_const*PHENO*NO2 - rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 140)*sol(:ncol,:, 133) ! rate_const*PHENO*O3 - rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 142)*sol(:ncol,:, 243) ! rate_const*PHENOOH*OH - rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 219)*sol(:ncol,:, 124) ! rate_const*M*ACBZO2*NO2 - rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 249)*sol(:ncol,:, 232) ! rate_const*TOLO2*HO2 - rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 249)*sol(:ncol,:, 123) ! rate_const*TOLO2*NO - rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 210)*sol(:ncol,:, 243) ! rate_const*TOLOOH*OH - rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 211)*sol(:ncol,:, 243) ! rate_const*TOLUENE*OH - rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 139) ! rate_const*M*PBZNIT - rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 213)*sol(:ncol,:, 243) ! rate_const*XYLENES*OH - rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 251)*sol(:ncol,:, 232) ! rate_const*XYLENO2*HO2 - rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 251)*sol(:ncol,:, 123) ! rate_const*XYLENO2*NO - rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 214)*sol(:ncol,:, 243) ! rate_const*XYLENOOH*OH - rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 252)*sol(:ncol,:, 232) ! rate_const*XYLOLO2*HO2 - rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 252)*sol(:ncol,:, 123) ! rate_const*XYLOLO2*NO - rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 215)*sol(:ncol,:, 243) ! rate_const*XYLOL*OH - rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 216)*sol(:ncol,:, 243) ! rate_const*XYLOLOOH*OH - rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 6)*sol(:ncol,:, 125) ! rate_const*BCARY*NO3 - rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 6)*sol(:ncol,:, 133) ! rate_const*BCARY*O3 - rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 6)*sol(:ncol,:, 243) ! rate_const*BCARY*OH - rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 111)*sol(:ncol,:, 125) ! rate_const*MTERP*NO3 - rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 111)*sol(:ncol,:, 133) ! rate_const*MTERP*O3 - rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 111)*sol(:ncol,:, 243) ! rate_const*MTERP*OH - rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 241)*sol(:ncol,:, 227) ! rate_const*NTERPO2*CH3O2 - rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 241)*sol(:ncol,:, 232) ! rate_const*NTERPO2*HO2 - rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 241)*sol(:ncol,:, 123) ! rate_const*NTERPO2*NO - rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 241)*sol(:ncol,:, 125) ! rate_const*NTERPO2*NO3 - rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 127)*sol(:ncol,:, 243) ! rate_const*NTERPOOH*OH - rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 247)*sol(:ncol,:, 227) ! rate_const*TERP2O2*CH3O2 - rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 247)*sol(:ncol,:, 232) ! rate_const*TERP2O2*HO2 - rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 247)*sol(:ncol,:, 123) ! rate_const*TERP2O2*NO - rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 205)*sol(:ncol,:, 243) ! rate_const*TERP2OOH*OH - rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 206)*sol(:ncol,:, 243) ! rate_const*TERPNIT*OH - rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 248)*sol(:ncol,:, 227) ! rate_const*TERPO2*CH3O2 - rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 248)*sol(:ncol,:, 232) ! rate_const*TERPO2*HO2 - rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 248)*sol(:ncol,:, 123) ! rate_const*TERPO2*NO - rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 207)*sol(:ncol,:, 243) ! rate_const*TERPOOH*OH - rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 208)*sol(:ncol,:, 125) ! rate_const*TERPROD1*NO3 - rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 208)*sol(:ncol,:, 243) ! rate_const*TERPROD1*OH - rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 209)*sol(:ncol,:, 243) ! rate_const*TERPROD2*OH - rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 67)*sol(:ncol,:, 125) ! rate_const*DMS*NO3 - rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 67)*sol(:ncol,:, 243) ! rate_const*DMS*OH - rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 136)*sol(:ncol,:, 132) ! rate_const*OCS*O - rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 136)*sol(:ncol,:, 243) ! rate_const*OCS*OH - rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 149) ! rate_const*O2*S - rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 149)*sol(:ncol,:, 133) ! rate_const*S*O3 - rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 151)*sol(:ncol,:, 19) ! rate_const*SO*BRO - rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 151)*sol(:ncol,:, 59) ! rate_const*SO*CLO - rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 149)*sol(:ncol,:, 243) ! rate_const*S*OH - rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 151)*sol(:ncol,:, 124) ! rate_const*SO*NO2 - rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 151) ! rate_const*O2*SO - rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 151)*sol(:ncol,:, 133) ! rate_const*SO*O3 - rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 151)*sol(:ncol,:, 135) ! rate_const*SO*OCLO - rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 151)*sol(:ncol,:, 243) ! rate_const*SO*OH - rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 67)*sol(:ncol,:, 243) ! rate_const*DMS*OH - rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 152)*sol(:ncol,:, 243) ! rate_const*SO2*OH - rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 153)*sol(:ncol,:, 253) ! rate_const*SO3*H2O - rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 121)*sol(:ncol,:, 243) ! rate_const*NH3*OH - rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 75) ! rate_const*GLYOXAL - rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 232) ! rate_const*HO2 - rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 93) ! rate_const*HONITR - rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 99) ! rate_const*ISOPNITA - rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 100) ! rate_const*ISOPNITB - rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 115) ! rate_const*N2O5 - rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 116) ! rate_const*NC4CH2OH - rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 117) ! rate_const*NC4CHO - rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 122) ! rate_const*NH4 - rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 124) ! rate_const*NO2 - rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 125) ! rate_const*NO3 - rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 127) ! rate_const*NTERPOOH - rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 137) ! rate_const*ONITR - rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 206) ! rate_const*TERPNIT - rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 6)*sol(:ncol,:, 125) ! rate_const*BCARY*NO3 - rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 6)*sol(:ncol,:, 133) ! rate_const*BCARY*O3 - rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 6)*sol(:ncol,:, 243) ! rate_const*BCARY*OH - rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 7)*sol(:ncol,:, 243) ! rate_const*BENZENE*OH - rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 98)*sol(:ncol,:, 125) ! rate_const*ISOP*NO3 - rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 98)*sol(:ncol,:, 133) ! rate_const*ISOP*O3 - rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 98)*sol(:ncol,:, 243) ! rate_const*ISOP*OH - rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 104)*sol(:ncol,:, 243) ! rate_const*IVOCbb*OH - rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 105)*sol(:ncol,:, 243) ! rate_const*IVOCff*OH - rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 111)*sol(:ncol,:, 125) ! rate_const*MTERP*NO3 - rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 111)*sol(:ncol,:, 133) ! rate_const*MTERP*O3 - rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 111)*sol(:ncol,:, 243) ! rate_const*MTERP*OH - rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 202)*sol(:ncol,:, 243) ! rate_const*SVOCbb*OH - rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 203)*sol(:ncol,:, 243) ! rate_const*SVOCff*OH - rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 211)*sol(:ncol,:, 243) ! rate_const*TOLUENE*OH - rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 213)*sol(:ncol,:, 243) ! rate_const*XYLENES*OH - rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 115) ! rate_const*N2O5 - rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 20) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 115) ! rate_const*N2O5 - rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 60) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 20) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 91)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL - rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 60) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 20) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 91)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL - rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 115) ! rate_const*N2O5 - rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 60) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 71) ! rate_const*E90 + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 10) ! rate_const*BENZOOH + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 11) ! rate_const*BEPOMUC + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 12) ! rate_const*BIGALD + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 13) ! rate_const*BIGALD1 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 14) ! rate_const*BIGALD2 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 15) ! rate_const*BIGALD3 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 16) ! rate_const*BIGALD4 + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 25) ! rate_const*BZOOH + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 29) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 32) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 34) ! rate_const*C6H5OOH + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 44) ! rate_const*CH2O + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 44) ! rate_const*CH2O + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 47) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 50) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 51) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 53) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 55) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 56) ! rate_const*CH4 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 56) ! rate_const*CH4 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 65) ! rate_const*CO2 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 74) ! rate_const*EOOH + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 76) ! rate_const*GLYALD + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 77) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 95) ! rate_const*HONITR + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 96) ! rate_const*HPALD + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 97) ! rate_const*HYAC + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 104) ! rate_const*ISOPNOOH + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 106) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 111) ! rate_const*MACR + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 111) ! rate_const*MACR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 113) ! rate_const*MEK + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 114) ! rate_const*MEKOOH + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 115) ! rate_const*MPAN + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 118) ! rate_const*MVK + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 123) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 132) ! rate_const*NOA + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 133) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 143) ! rate_const*ONITR + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 144) ! rate_const*PAN + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 148) ! rate_const*PHENOOH + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 153) ! rate_const*POOH + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 154) ! rate_const*ROOH + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 210) ! rate_const*TEPOMUC + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 211) ! rate_const*TERP2OOH + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 212) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 213) ! rate_const*TERPOOH + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 214) ! rate_const*TERPROD1 + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 215) ! rate_const*TERPROD2 + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 216) ! rate_const*TOLOOH + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 219) ! rate_const*XOOH + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 221) ! rate_const*XYLENOOH + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 224) ! rate_const*XYLOLOOH + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 20) ! rate_const*BRCL + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 21) ! rate_const*BRO + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 35) ! rate_const*CCL4 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 36) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 37) ! rate_const*CF3BR + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 38) ! rate_const*CFC11 + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 39) ! rate_const*CFC113 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 40) ! rate_const*CFC114 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 41) ! rate_const*CFC115 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 42) ! rate_const*CFC12 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 43) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 45) ! rate_const*CH3BR + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 46) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 48) ! rate_const*CH3CL + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 57) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 59) ! rate_const*CL2 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 60) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 61) ! rate_const*CLO + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 66) ! rate_const*COF2 + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 67) ! rate_const*COFCL + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 80) ! rate_const*H2402 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 83) ! rate_const*HBR + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 84) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 85) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 86) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 87) ! rate_const*HCL + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 90) ! rate_const*HF + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 93) ! rate_const*HOBR + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 94) ! rate_const*HOCL + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 141) ! rate_const*OCLO + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 156) ! rate_const*SF6 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 82) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 142) ! rate_const*OCS + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 157) ! rate_const*SO + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 158) ! rate_const*SO2 + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 159) ! rate_const*SO3 + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 163) ! rate_const*soabb1_a1 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 164) ! rate_const*soabb1_a2 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 165) ! rate_const*soabb2_a1 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 166) ! rate_const*soabb2_a2 + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 167) ! rate_const*soabb3_a1 + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 168) ! rate_const*soabb3_a2 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 169) ! rate_const*soabb4_a1 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 170) ! rate_const*soabb4_a2 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 171) ! rate_const*soabb5_a1 + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 172) ! rate_const*soabb5_a2 + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 173) ! rate_const*soabg1_a1 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 174) ! rate_const*soabg1_a2 + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 175) ! rate_const*soabg2_a1 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 176) ! rate_const*soabg2_a2 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 177) ! rate_const*soabg3_a1 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 178) ! rate_const*soabg3_a2 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 179) ! rate_const*soabg4_a1 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 180) ! rate_const*soabg4_a2 + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 181) ! rate_const*soabg5_a1 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 182) ! rate_const*soabg5_a2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 183) ! rate_const*soaff1_a1 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 184) ! rate_const*soaff1_a2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 185) ! rate_const*soaff2_a1 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 186) ! rate_const*soaff2_a2 + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 187) ! rate_const*soaff3_a1 + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 188) ! rate_const*soaff3_a2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 189) ! rate_const*soaff4_a1 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 190) ! rate_const*soaff4_a2 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 191) ! rate_const*soaff5_a1 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 192) ! rate_const*soaff5_a2 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 250)*sol(:ncol,:, 79) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 250)*sol(:ncol,:, 261) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 250) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 250) ! rate_const*O2*O1D + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 250)*sol(:ncol,:, 139) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 138)*sol(:ncol,:, 139) ! rate_const*O*O3 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 138)*sol(:ncol,:, 138) ! rate_const*M*O*O + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 138) ! rate_const*O2*M*O + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 79)*sol(:ncol,:, 138) ! rate_const*H2*O + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 81)*sol(:ncol,:, 138) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 78)*sol(:ncol,:, 240) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 78)*sol(:ncol,:, 240) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 78)*sol(:ncol,:, 240) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 78) ! rate_const*O2*M*H + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 240)*sol(:ncol,:, 138) ! rate_const*HO2*O + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 240)*sol(:ncol,:, 139) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 78)*sol(:ncol,:, 139) ! rate_const*H*O3 + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 251)*sol(:ncol,:, 79) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 251)*sol(:ncol,:, 81) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 251)*sol(:ncol,:, 240) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 251)*sol(:ncol,:, 138) ! rate_const*OH*O + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 251)*sol(:ncol,:, 139) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 251)*sol(:ncol,:, 251) ! rate_const*OH*OH + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 251)*sol(:ncol,:, 251) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 240)*sol(:ncol,:, 240) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 92)*sol(:ncol,:, 251) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 119)*sol(:ncol,:, 129) ! rate_const*N*NO + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 119)*sol(:ncol,:, 130) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 119)*sol(:ncol,:, 130) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 119)*sol(:ncol,:, 130) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 119) ! rate_const*O2*N + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 130)*sol(:ncol,:, 138) ! rate_const*NO2*O + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 130)*sol(:ncol,:, 139) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 130)*sol(:ncol,:, 138) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 131)*sol(:ncol,:, 240) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 131)*sol(:ncol,:, 129) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 131)*sol(:ncol,:, 138) ! rate_const*NO3*O + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 131)*sol(:ncol,:, 251) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 119)*sol(:ncol,:, 251) ! rate_const*N*OH + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 129)*sol(:ncol,:, 240) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 129)*sol(:ncol,:, 139) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 129)*sol(:ncol,:, 138) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 250)*sol(:ncol,:, 120) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 250)*sol(:ncol,:, 120) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 130)*sol(:ncol,:, 240) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 130)*sol(:ncol,:, 131) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 130)*sol(:ncol,:, 251) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 91)*sol(:ncol,:, 251) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 92) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 121) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 58)*sol(:ncol,:, 44) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 58)*sol(:ncol,:, 56) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 58)*sol(:ncol,:, 79) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 58)*sol(:ncol,:, 81) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 58)*sol(:ncol,:, 240) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 58)*sol(:ncol,:, 240) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 58)*sol(:ncol,:, 139) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 61)*sol(:ncol,:, 235) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 61)*sol(:ncol,:, 240) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 61)*sol(:ncol,:, 129) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 62)*sol(:ncol,:, 58) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 61)*sol(:ncol,:, 130) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 62)*sol(:ncol,:, 138) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 62)*sol(:ncol,:, 251) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 61)*sol(:ncol,:, 138) ! rate_const*CLO*O + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 61)*sol(:ncol,:, 251) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 61)*sol(:ncol,:, 251) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 87)*sol(:ncol,:, 138) ! rate_const*HCL*O + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 87)*sol(:ncol,:, 251) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 94)*sol(:ncol,:, 58) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 94)*sol(:ncol,:, 138) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 94)*sol(:ncol,:, 251) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 250)*sol(:ncol,:, 35) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 250)*sol(:ncol,:, 36) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 250)*sol(:ncol,:, 38) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 250)*sol(:ncol,:, 39) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 250)*sol(:ncol,:, 40) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 250)*sol(:ncol,:, 41) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 250)*sol(:ncol,:, 42) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 250)*sol(:ncol,:, 87) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 250)*sol(:ncol,:, 87) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 60) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 19)*sol(:ncol,:, 44) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 19)*sol(:ncol,:, 240) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 19)*sol(:ncol,:, 139) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 21)*sol(:ncol,:, 21) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 21)*sol(:ncol,:, 240) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 21)*sol(:ncol,:, 129) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 21)*sol(:ncol,:, 130) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 22)*sol(:ncol,:, 138) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 21)*sol(:ncol,:, 138) ! rate_const*BRO*O + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 21)*sol(:ncol,:, 251) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 83)*sol(:ncol,:, 138) ! rate_const*HBR*O + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 83)*sol(:ncol,:, 251) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 93)*sol(:ncol,:, 138) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 250)*sol(:ncol,:, 37) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 250)*sol(:ncol,:, 57) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 250)*sol(:ncol,:, 80) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 250)*sol(:ncol,:, 83) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 250)*sol(:ncol,:, 83) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 75)*sol(:ncol,:, 56) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 75)*sol(:ncol,:, 79) ! rate_const*F*H2 + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 75)*sol(:ncol,:, 261) ! rate_const*F*H2O + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 75)*sol(:ncol,:, 91) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 250)*sol(:ncol,:, 66) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 250)*sol(:ncol,:, 67) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 43)*sol(:ncol,:, 58) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 43)*sol(:ncol,:, 251) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 45)*sol(:ncol,:, 58) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 45)*sol(:ncol,:, 251) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 46)*sol(:ncol,:, 251) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 48)*sol(:ncol,:, 58) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 48)*sol(:ncol,:, 251) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 57)*sol(:ncol,:, 58) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 57)*sol(:ncol,:, 251) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 84)*sol(:ncol,:, 251) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 85)*sol(:ncol,:, 251) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 86)*sol(:ncol,:, 251) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 250)*sol(:ncol,:, 43) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 250)*sol(:ncol,:, 45) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 250)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 250)*sol(:ncol,:, 85) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 250)*sol(:ncol,:, 86) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 44)*sol(:ncol,:, 240) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 44)*sol(:ncol,:, 131) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 44)*sol(:ncol,:, 138) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 44)*sol(:ncol,:, 251) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 235)*sol(:ncol,:, 235) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 235)*sol(:ncol,:, 235) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 235)*sol(:ncol,:, 240) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 235)*sol(:ncol,:, 129) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 54)*sol(:ncol,:, 251) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 55)*sol(:ncol,:, 251) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 56)*sol(:ncol,:, 251) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 88)*sol(:ncol,:, 251) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 89)*sol(:ncol,:, 251) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 241)*sol(:ncol,:, 240) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 241) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 241)*sol(:ncol,:, 129) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 250)*sol(:ncol,:, 56) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 250)*sol(:ncol,:, 56) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 250)*sol(:ncol,:, 56) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 250)*sol(:ncol,:, 88) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 64)*sol(:ncol,:, 251) ! rate_const*CO*OH + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 26)*sol(:ncol,:, 58) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 26)*sol(:ncol,:, 251) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 27)*sol(:ncol,:, 58) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 27)*sol(:ncol,:, 139) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 231)*sol(:ncol,:, 231) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 231)*sol(:ncol,:, 235) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 231)*sol(:ncol,:, 240) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 231)*sol(:ncol,:, 129) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 28)*sol(:ncol,:, 251) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 29)*sol(:ncol,:, 251) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 30)*sol(:ncol,:, 58) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 30)*sol(:ncol,:, 251) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 47)*sol(:ncol,:, 131) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 47)*sol(:ncol,:, 251) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 49)*sol(:ncol,:, 251) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 234)*sol(:ncol,:, 234) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 234)*sol(:ncol,:, 235) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 234)*sol(:ncol,:, 240) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 234)*sol(:ncol,:, 129) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 52)*sol(:ncol,:, 251) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 53)*sol(:ncol,:, 251) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 239)*sol(:ncol,:, 240) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 239)*sol(:ncol,:, 129) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 238) ! rate_const*EO + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 238) ! rate_const*O2*EO + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 76)*sol(:ncol,:, 251) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 77)*sol(:ncol,:, 251) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 144)*sol(:ncol,:, 251) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 27)*sol(:ncol,:, 251) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 234)*sol(:ncol,:, 130) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 144) ! rate_const*M*PAN + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 31)*sol(:ncol,:, 131) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 31)*sol(:ncol,:, 139) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 232)*sol(:ncol,:, 235) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 232)*sol(:ncol,:, 240) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 232)*sol(:ncol,:, 129) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 32)*sol(:ncol,:, 251) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 33)*sol(:ncol,:, 251) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 51)*sol(:ncol,:, 131) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 51)*sol(:ncol,:, 251) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 97)*sol(:ncol,:, 251) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 132)*sol(:ncol,:, 251) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 253)*sol(:ncol,:, 240) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 253)*sol(:ncol,:, 129) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 153)*sol(:ncol,:, 251) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 254)*sol(:ncol,:, 235) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 254)*sol(:ncol,:, 240) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 254)*sol(:ncol,:, 129) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 154)*sol(:ncol,:, 251) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 31)*sol(:ncol,:, 251) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 50)*sol(:ncol,:, 251) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 18)*sol(:ncol,:, 131) ! rate_const*BIGENE*NO3 + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 18)*sol(:ncol,:, 251) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 237)*sol(:ncol,:, 129) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 237)*sol(:ncol,:, 129) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 95)*sol(:ncol,:, 251) ! rate_const*HONITR*OH + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 244)*sol(:ncol,:, 234) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 244)*sol(:ncol,:, 235) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 244)*sol(:ncol,:, 240) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 244)*sol(:ncol,:, 131) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 244)*sol(:ncol,:, 129) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 244)*sol(:ncol,:, 129) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 111)*sol(:ncol,:, 139) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 111)*sol(:ncol,:, 251) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 112)*sol(:ncol,:, 251) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 246)*sol(:ncol,:, 234) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 246)*sol(:ncol,:, 235) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 246)*sol(:ncol,:, 240) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 246)*sol(:ncol,:, 246) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 246)*sol(:ncol,:, 129) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 246)*sol(:ncol,:, 131) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 248)*sol(:ncol,:, 240) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 248)*sol(:ncol,:, 129) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 113)*sol(:ncol,:, 251) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 114)*sol(:ncol,:, 251) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 115)*sol(:ncol,:, 251) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 118)*sol(:ncol,:, 139) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 118)*sol(:ncol,:, 251) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 246)*sol(:ncol,:, 130) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 115) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 1)*sol(:ncol,:, 251) ! rate_const*ALKNIT*OH + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 228)*sol(:ncol,:, 240) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 228)*sol(:ncol,:, 129) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 228)*sol(:ncol,:, 129) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 2)*sol(:ncol,:, 251) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 17)*sol(:ncol,:, 251) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 96)*sol(:ncol,:, 251) ! rate_const*HPALD*OH + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 98)*sol(:ncol,:, 251) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 99)*sol(:ncol,:, 251) ! rate_const*IEPOX*OH + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 242)*sol(:ncol,:, 234) ! rate_const*ISOPAO2*CH3CO3 + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 242)*sol(:ncol,:, 235) ! rate_const*ISOPAO2*CH3O2 + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 242)*sol(:ncol,:, 240) ! rate_const*ISOPAO2*HO2 + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 242)*sol(:ncol,:, 129) ! rate_const*ISOPAO2*NO + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 242)*sol(:ncol,:, 131) ! rate_const*ISOPAO2*NO3 + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 243)*sol(:ncol,:, 234) ! rate_const*ISOPBO2*CH3CO3 + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 243)*sol(:ncol,:, 235) ! rate_const*ISOPBO2*CH3O2 + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 243)*sol(:ncol,:, 240) ! rate_const*ISOPBO2*HO2 + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 243) ! rate_const*ISOPBO2 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 243)*sol(:ncol,:, 129) ! rate_const*ISOPBO2*NO + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 243)*sol(:ncol,:, 131) ! rate_const*ISOPBO2*NO3 + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 101)*sol(:ncol,:, 251) ! rate_const*ISOPNITA*OH + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 102)*sol(:ncol,:, 251) ! rate_const*ISOPNITB*OH + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 100)*sol(:ncol,:, 131) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 103)*sol(:ncol,:, 234) ! rate_const*ISOPNO3*CH3CO3 + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 103)*sol(:ncol,:, 235) ! rate_const*ISOPNO3*CH3O2 + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 103)*sol(:ncol,:, 240) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 103)*sol(:ncol,:, 129) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 103)*sol(:ncol,:, 131) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 104)*sol(:ncol,:, 251) ! rate_const*ISOPNOOH*OH + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 100)*sol(:ncol,:, 139) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 100)*sol(:ncol,:, 251) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 106)*sol(:ncol,:, 251) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 122)*sol(:ncol,:, 251) ! rate_const*NC4CH2OH*OH + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 123)*sol(:ncol,:, 251) ! rate_const*NC4CHO*OH + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 258)*sol(:ncol,:, 234) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 258)*sol(:ncol,:, 235) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 258)*sol(:ncol,:, 240) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 258)*sol(:ncol,:, 129) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 258)*sol(:ncol,:, 131) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 219)*sol(:ncol,:, 251) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 227)*sol(:ncol,:, 240) ! rate_const*ACBZO2*HO2 + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 227)*sol(:ncol,:, 129) ! rate_const*ACBZO2*NO + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 8)*sol(:ncol,:, 251) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 229)*sol(:ncol,:, 240) ! rate_const*BENZO2*HO2 + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 229)*sol(:ncol,:, 129) ! rate_const*BENZO2*NO + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 10)*sol(:ncol,:, 251) ! rate_const*BENZOOH*OH + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 24)*sol(:ncol,:, 251) ! rate_const*BZALD*OH + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 230)*sol(:ncol,:, 240) ! rate_const*BZOO*HO2 + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 25)*sol(:ncol,:, 251) ! rate_const*BZOOH*OH + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 230)*sol(:ncol,:, 129) ! rate_const*BZOO*NO + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 233)*sol(:ncol,:, 240) ! rate_const*C6H5O2*HO2 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 233)*sol(:ncol,:, 129) ! rate_const*C6H5O2*NO + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 34)*sol(:ncol,:, 251) ! rate_const*C6H5OOH*OH + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 68)*sol(:ncol,:, 251) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 236)*sol(:ncol,:, 240) ! rate_const*DICARBO2*HO2 + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 236)*sol(:ncol,:, 129) ! rate_const*DICARBO2*NO + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 236)*sol(:ncol,:, 130) ! rate_const*M*DICARBO2*NO2 + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 245)*sol(:ncol,:, 240) ! rate_const*MALO2*HO2 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 245)*sol(:ncol,:, 129) ! rate_const*MALO2*NO + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 245)*sol(:ncol,:, 130) ! rate_const*M*MALO2*NO2 + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 247)*sol(:ncol,:, 240) ! rate_const*MDIALO2*HO2 + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 247)*sol(:ncol,:, 129) ! rate_const*MDIALO2*NO + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 247)*sol(:ncol,:, 130) ! rate_const*M*MDIALO2*NO2 + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 252)*sol(:ncol,:, 240) ! rate_const*PHENO2*HO2 + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 252)*sol(:ncol,:, 129) ! rate_const*PHENO2*NO + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 147)*sol(:ncol,:, 251) ! rate_const*PHENOL*OH + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 146)*sol(:ncol,:, 130) ! rate_const*PHENO*NO2 + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 146)*sol(:ncol,:, 139) ! rate_const*PHENO*O3 + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 148)*sol(:ncol,:, 251) ! rate_const*PHENOOH*OH + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 227)*sol(:ncol,:, 130) ! rate_const*M*ACBZO2*NO2 + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 257)*sol(:ncol,:, 240) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 257)*sol(:ncol,:, 129) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 216)*sol(:ncol,:, 251) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 217)*sol(:ncol,:, 251) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 145) ! rate_const*M*PBZNIT + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 220)*sol(:ncol,:, 251) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 259)*sol(:ncol,:, 240) ! rate_const*XYLENO2*HO2 + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 259)*sol(:ncol,:, 129) ! rate_const*XYLENO2*NO + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 221)*sol(:ncol,:, 251) ! rate_const*XYLENOOH*OH + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 260)*sol(:ncol,:, 240) ! rate_const*XYLOLO2*HO2 + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 260)*sol(:ncol,:, 129) ! rate_const*XYLOLO2*NO + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 223)*sol(:ncol,:, 251) ! rate_const*XYLOL*OH + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 224)*sol(:ncol,:, 251) ! rate_const*XYLOLOOH*OH + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 6)*sol(:ncol,:, 131) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 6)*sol(:ncol,:, 139) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 6)*sol(:ncol,:, 251) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 116)*sol(:ncol,:, 131) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 116)*sol(:ncol,:, 139) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 116)*sol(:ncol,:, 251) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 249)*sol(:ncol,:, 235) ! rate_const*NTERPO2*CH3O2 + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 249)*sol(:ncol,:, 240) ! rate_const*NTERPO2*HO2 + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 249)*sol(:ncol,:, 129) ! rate_const*NTERPO2*NO + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 249)*sol(:ncol,:, 131) ! rate_const*NTERPO2*NO3 + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 133)*sol(:ncol,:, 251) ! rate_const*NTERPOOH*OH + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 255)*sol(:ncol,:, 235) ! rate_const*TERP2O2*CH3O2 + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 255)*sol(:ncol,:, 240) ! rate_const*TERP2O2*HO2 + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 255)*sol(:ncol,:, 129) ! rate_const*TERP2O2*NO + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 211)*sol(:ncol,:, 251) ! rate_const*TERP2OOH*OH + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 212)*sol(:ncol,:, 251) ! rate_const*TERPNIT*OH + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 256)*sol(:ncol,:, 235) ! rate_const*TERPO2*CH3O2 + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 256)*sol(:ncol,:, 240) ! rate_const*TERPO2*HO2 + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 256)*sol(:ncol,:, 129) ! rate_const*TERPO2*NO + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 213)*sol(:ncol,:, 251) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 214)*sol(:ncol,:, 131) ! rate_const*TERPROD1*NO3 + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 214)*sol(:ncol,:, 251) ! rate_const*TERPROD1*OH + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 215)*sol(:ncol,:, 251) ! rate_const*TERPROD2*OH + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 69)*sol(:ncol,:, 131) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 69)*sol(:ncol,:, 251) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 142)*sol(:ncol,:, 138) ! rate_const*OCS*O + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 142)*sol(:ncol,:, 251) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 155) ! rate_const*O2*S + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 158)*sol(:ncol,:, 251) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 155)*sol(:ncol,:, 139) ! rate_const*S*O3 + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 157)*sol(:ncol,:, 21) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 157)*sol(:ncol,:, 61) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 155)*sol(:ncol,:, 251) ! rate_const*S*OH + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 157)*sol(:ncol,:, 130) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 157) ! rate_const*O2*SO + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 157)*sol(:ncol,:, 139) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 157)*sol(:ncol,:, 141) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 157)*sol(:ncol,:, 251) ! rate_const*SO*OH + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 69)*sol(:ncol,:, 251) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 159)*sol(:ncol,:, 261) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 127)*sol(:ncol,:, 251) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 240) ! rate_const*HO2 + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 95) ! rate_const*HONITR + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 101) ! rate_const*ISOPNITA + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 102) ! rate_const*ISOPNITB + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 122) ! rate_const*NC4CH2OH + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 123) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 128) ! rate_const*NH4 + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 130) ! rate_const*NO2 + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 131) ! rate_const*NO3 + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 133) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 143) ! rate_const*ONITR + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 212) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 6)*sol(:ncol,:, 131) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 7)*sol(:ncol,:, 240) ! rate_const*BCARYO2VBS*HO2 + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 7)*sol(:ncol,:, 129) ! rate_const*BCARYO2VBS*NO + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 6)*sol(:ncol,:, 139) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 6)*sol(:ncol,:, 251) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 8)*sol(:ncol,:, 251) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 9)*sol(:ncol,:, 240) ! rate_const*BENZO2VBS*HO2 + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 9)*sol(:ncol,:, 129) ! rate_const*BENZO2VBS*NO + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 100)*sol(:ncol,:, 131) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 105)*sol(:ncol,:, 240) ! rate_const*ISOPO2VBS*HO2 + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 105)*sol(:ncol,:, 129) ! rate_const*ISOPO2VBS*NO + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 100)*sol(:ncol,:, 139) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 100)*sol(:ncol,:, 251) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 108)*sol(:ncol,:, 240) ! rate_const*IVOCbbO2VBS*HO2 + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 108)*sol(:ncol,:, 129) ! rate_const*IVOCbbO2VBS*NO + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 107)*sol(:ncol,:, 251) ! rate_const*IVOCbb*OH + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 110)*sol(:ncol,:, 240) ! rate_const*IVOCffO2VBS*HO2 + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 110)*sol(:ncol,:, 129) ! rate_const*IVOCffO2VBS*NO + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 109)*sol(:ncol,:, 251) ! rate_const*IVOCff*OH + rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 116)*sol(:ncol,:, 131) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 117)*sol(:ncol,:, 240) ! rate_const*MTERPO2VBS*HO2 + rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 117)*sol(:ncol,:, 129) ! rate_const*MTERPO2VBS*NO + rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 116)*sol(:ncol,:, 139) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 116)*sol(:ncol,:, 251) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 208)*sol(:ncol,:, 251) ! rate_const*SVOCbb*OH + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 209)*sol(:ncol,:, 251) ! rate_const*SVOCff*OH + rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 217)*sol(:ncol,:, 251) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 218)*sol(:ncol,:, 240) ! rate_const*TOLUO2VBS*HO2 + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 218)*sol(:ncol,:, 129) ! rate_const*TOLUO2VBS*NO + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 77) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 220)*sol(:ncol,:, 251) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 222)*sol(:ncol,:, 240) ! rate_const*XYLEO2VBS*HO2 + rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 222)*sol(:ncol,:, 129) ! rate_const*XYLEO2VBS*NO + rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 94)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 62)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 94)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 93)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 62)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 94)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 93)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 62)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 73) ! rate_const*E90 end subroutine set_rates end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_setrxt.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_setrxt.F90 index d995e6490d..4133ccd686 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_setrxt.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_setrxt.F90 @@ -45,7 +45,7 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,162) = 1.8e-12_r8 rate(:,166) = 1.8e-12_r8 rate(:,178) = 3.5e-12_r8 - rate(:,180) = 1e-11_r8 + rate(:,180) = 1.3e-11_r8 rate(:,181) = 2.2e-11_r8 rate(:,182) = 5e-11_r8 rate(:,217) = 1.7e-13_r8 @@ -70,75 +70,74 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,271) = 1.794e-10_r8 rate(:,272) = 1.3e-10_r8 rate(:,273) = 7.65e-11_r8 - rate(:,287) = 4e-13_r8 - rate(:,291) = 1.31e-10_r8 - rate(:,292) = 3.5e-11_r8 - rate(:,293) = 9e-12_r8 - rate(:,300) = 6.8e-14_r8 - rate(:,301) = 2e-13_r8 - rate(:,315) = 7e-13_r8 - rate(:,316) = 1e-12_r8 - rate(:,320) = 1e-14_r8 - rate(:,321) = 1e-11_r8 - rate(:,322) = 1.15e-11_r8 - rate(:,323) = 4e-14_r8 - rate(:,336) = 3e-12_r8 - rate(:,337) = 6.7e-13_r8 - rate(:,347) = 3.5e-13_r8 - rate(:,348) = 5.4e-11_r8 - rate(:,351) = 2e-12_r8 - rate(:,352) = 1.4e-11_r8 - rate(:,355) = 2.4e-12_r8 - rate(:,366) = 5e-12_r8 - rate(:,376) = 1.6e-12_r8 - rate(:,378) = 6.7e-12_r8 - rate(:,381) = 3.5e-12_r8 - rate(:,384) = 1.3e-11_r8 - rate(:,385) = 1.4e-11_r8 - rate(:,389) = 2.4e-12_r8 - rate(:,390) = 1.4e-11_r8 - rate(:,395) = 2.4e-12_r8 + rate(:,286) = 4e-13_r8 + rate(:,290) = 1.31e-10_r8 + rate(:,291) = 3.5e-11_r8 + rate(:,292) = 9e-12_r8 + rate(:,299) = 6.8e-14_r8 + rate(:,300) = 2e-13_r8 + rate(:,315) = 1e-12_r8 + rate(:,319) = 1e-14_r8 + rate(:,320) = 1e-11_r8 + rate(:,321) = 1.15e-11_r8 + rate(:,322) = 4e-14_r8 + rate(:,335) = 3e-12_r8 + rate(:,336) = 6.7e-13_r8 + rate(:,346) = 3.5e-13_r8 + rate(:,347) = 5.4e-11_r8 + rate(:,350) = 2e-12_r8 + rate(:,351) = 1.4e-11_r8 + rate(:,354) = 2.4e-12_r8 + rate(:,365) = 5e-12_r8 + rate(:,375) = 1.6e-12_r8 + rate(:,377) = 6.7e-12_r8 + rate(:,380) = 3.5e-12_r8 + rate(:,383) = 1.3e-11_r8 + rate(:,384) = 1.4e-11_r8 + rate(:,388) = 2.4e-12_r8 + rate(:,389) = 1.4e-11_r8 + rate(:,394) = 2.4e-12_r8 + rate(:,395) = 4e-11_r8 rate(:,396) = 4e-11_r8 - rate(:,397) = 4e-11_r8 - rate(:,399) = 1.4e-11_r8 - rate(:,403) = 2.4e-12_r8 - rate(:,404) = 4e-11_r8 - rate(:,408) = 7e-11_r8 - rate(:,409) = 1e-10_r8 - rate(:,414) = 2.4e-12_r8 - rate(:,429) = 4.7e-11_r8 - rate(:,442) = 2.1e-12_r8 - rate(:,443) = 2.8e-13_r8 - rate(:,451) = 1.7e-11_r8 - rate(:,457) = 8.4e-11_r8 - rate(:,459) = 1.9e-11_r8 - rate(:,460) = 1.2e-14_r8 - rate(:,461) = 2e-10_r8 - rate(:,468) = 2.4e-12_r8 - rate(:,469) = 2e-11_r8 - rate(:,473) = 2.3e-11_r8 - rate(:,474) = 2e-11_r8 - rate(:,478) = 3.3e-11_r8 - rate(:,479) = 1e-12_r8 - rate(:,480) = 5.7e-11_r8 - rate(:,481) = 3.4e-11_r8 - rate(:,486) = 2.3e-12_r8 + rate(:,398) = 1.4e-11_r8 + rate(:,402) = 2.4e-12_r8 + rate(:,403) = 4e-11_r8 + rate(:,407) = 7e-11_r8 + rate(:,408) = 1e-10_r8 + rate(:,413) = 2.4e-12_r8 + rate(:,428) = 4.7e-11_r8 + rate(:,441) = 2.1e-12_r8 + rate(:,442) = 2.8e-13_r8 + rate(:,450) = 1.7e-11_r8 + rate(:,456) = 8.4e-11_r8 + rate(:,458) = 1.9e-11_r8 + rate(:,459) = 1.2e-14_r8 + rate(:,460) = 2e-10_r8 + rate(:,467) = 2.4e-12_r8 + rate(:,468) = 2e-11_r8 + rate(:,472) = 2.3e-11_r8 + rate(:,473) = 2e-11_r8 + rate(:,477) = 3.3e-11_r8 + rate(:,478) = 1e-12_r8 + rate(:,479) = 5.7e-11_r8 + rate(:,480) = 3.4e-11_r8 + rate(:,485) = 2.3e-12_r8 rate(:,487) = 1.2e-11_r8 rate(:,488) = 5.7e-11_r8 rate(:,489) = 2.8e-11_r8 rate(:,490) = 6.6e-11_r8 rate(:,491) = 1.4e-11_r8 rate(:,494) = 1.9e-12_r8 - rate(:,508) = 6.34e-08_r8 - rate(:,514) = 1.9e-11_r8 + rate(:,506) = 6.34e-08_r8 + rate(:,512) = 1.9e-11_r8 rate(:,515) = 1.2e-14_r8 rate(:,516) = 2e-10_r8 - rate(:,521) = 1.34e-11_r8 - rate(:,522) = 1.34e-11_r8 - rate(:,526) = 1.34e-11_r8 rate(:,527) = 1.34e-11_r8 - rate(:,529) = 1.7e-11_r8 - rate(:,547) = 1.29e-07_r8 + rate(:,530) = 1.34e-11_r8 + rate(:,536) = 1.34e-11_r8 + rate(:,537) = 1.34e-11_r8 + rate(:,542) = 1.7e-11_r8 + rate(:,562) = 1.29e-07_r8 do n = 1,pver offset = (n-1)*ncol @@ -152,28 +151,28 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,152) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) exp_fac(:) = exp( -2000._r8 * itemp(:) ) rate(:,153) = 1.4e-12_r8 * exp_fac(:) - rate(:,405) = 1.05e-14_r8 * exp_fac(:) - rate(:,519) = 1.05e-14_r8 * exp_fac(:) + rate(:,404) = 1.05e-14_r8 * exp_fac(:) + rate(:,523) = 1.05e-14_r8 * exp_fac(:) exp_fac(:) = exp( 200._r8 * itemp(:) ) rate(:,158) = 3e-11_r8 * exp_fac(:) rate(:,244) = 5.5e-12_r8 * exp_fac(:) rate(:,283) = 3.8e-12_r8 * exp_fac(:) - rate(:,305) = 3.8e-12_r8 * exp_fac(:) - rate(:,332) = 3.8e-12_r8 * exp_fac(:) - rate(:,340) = 3.8e-12_r8 * exp_fac(:) - rate(:,344) = 3.8e-12_r8 * exp_fac(:) - rate(:,360) = 2.3e-11_r8 * exp_fac(:) - rate(:,370) = 3.8e-12_r8 * exp_fac(:) - rate(:,380) = 3.8e-12_r8 * exp_fac(:) - rate(:,407) = 1.52e-11_r8 * exp_fac(:) - rate(:,415) = 1.52e-12_r8 * exp_fac(:) - rate(:,421) = 3.8e-12_r8 * exp_fac(:) - rate(:,424) = 3.8e-12_r8 * exp_fac(:) - rate(:,428) = 3.8e-12_r8 * exp_fac(:) - rate(:,444) = 3.8e-12_r8 * exp_fac(:) - rate(:,448) = 3.8e-12_r8 * exp_fac(:) - rate(:,454) = 3.8e-12_r8 * exp_fac(:) - rate(:,458) = 3.8e-12_r8 * exp_fac(:) + rate(:,304) = 3.8e-12_r8 * exp_fac(:) + rate(:,331) = 3.8e-12_r8 * exp_fac(:) + rate(:,339) = 3.8e-12_r8 * exp_fac(:) + rate(:,343) = 3.8e-12_r8 * exp_fac(:) + rate(:,359) = 2.3e-11_r8 * exp_fac(:) + rate(:,369) = 3.8e-12_r8 * exp_fac(:) + rate(:,379) = 3.8e-12_r8 * exp_fac(:) + rate(:,406) = 1.52e-11_r8 * exp_fac(:) + rate(:,414) = 1.52e-12_r8 * exp_fac(:) + rate(:,420) = 3.8e-12_r8 * exp_fac(:) + rate(:,423) = 3.8e-12_r8 * exp_fac(:) + rate(:,427) = 3.8e-12_r8 * exp_fac(:) + rate(:,443) = 3.8e-12_r8 * exp_fac(:) + rate(:,447) = 3.8e-12_r8 * exp_fac(:) + rate(:,453) = 3.8e-12_r8 * exp_fac(:) + rate(:,457) = 3.8e-12_r8 * exp_fac(:) rate(:,159) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) rate(:,160) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) rate(:,161) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) @@ -182,33 +181,34 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,242) = 1.7e-11_r8 * exp_fac(:) exp_fac(:) = exp( 180._r8 * itemp(:) ) rate(:,164) = 1.8e-11_r8 * exp_fac(:) - rate(:,318) = 4.2e-12_r8 * exp_fac(:) - rate(:,331) = 4.2e-12_r8 * exp_fac(:) - rate(:,339) = 4.2e-12_r8 * exp_fac(:) - rate(:,368) = 4.2e-12_r8 * exp_fac(:) - rate(:,388) = 4.4e-12_r8 * exp_fac(:) - rate(:,394) = 4.4e-12_r8 * exp_fac(:) - rate(:,467) = 4.2e-12_r8 * exp_fac(:) - rate(:,472) = 4.2e-12_r8 * exp_fac(:) - rate(:,477) = 4.2e-12_r8 * exp_fac(:) + rate(:,317) = 4.2e-12_r8 * exp_fac(:) + rate(:,330) = 4.2e-12_r8 * exp_fac(:) + rate(:,338) = 4.2e-12_r8 * exp_fac(:) + rate(:,367) = 4.2e-12_r8 * exp_fac(:) + rate(:,387) = 4.4e-12_r8 * exp_fac(:) + rate(:,393) = 4.4e-12_r8 * exp_fac(:) + rate(:,466) = 4.2e-12_r8 * exp_fac(:) + rate(:,471) = 4.2e-12_r8 * exp_fac(:) + rate(:,476) = 4.2e-12_r8 * exp_fac(:) rate(:,165) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) - rate(:,169) = 1.3e-12_r8 * exp( 380._r8 * itemp(:) ) + rate(:,169) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) rate(:,170) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) exp_fac(:) = exp( 220._r8 * itemp(:) ) rate(:,171) = 2.9e-12_r8 * exp_fac(:) rate(:,172) = 1.45e-12_r8 * exp_fac(:) rate(:,173) = 1.45e-12_r8 * exp_fac(:) - rate(:,174) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:,174) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) rate(:,175) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) exp_fac(:) = exp( -2450._r8 * itemp(:) ) rate(:,176) = 1.2e-13_r8 * exp_fac(:) rate(:,202) = 3e-11_r8 * exp_fac(:) - rate(:,179) = 1.5e-11_r8 * exp( 170._r8 * itemp(:) ) - exp_fac(:) = exp( 270._r8 * itemp(:) ) - rate(:,183) = 3.3e-12_r8 * exp_fac(:) - rate(:,198) = 1.4e-11_r8 * exp_fac(:) - rate(:,212) = 7.4e-12_r8 * exp_fac(:) - rate(:,314) = 8.1e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,179) = 1.7e-11_r8 * exp_fac(:) + rate(:,277) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,183) = 3.44e-12_r8 * exp_fac(:) + rate(:,235) = 2.3e-12_r8 * exp_fac(:) + rate(:,238) = 8.8e-12_r8 * exp_fac(:) exp_fac(:) = exp( -1500._r8 * itemp(:) ) rate(:,184) = 3e-12_r8 * exp_fac(:) rate(:,243) = 5.8e-12_r8 * exp_fac(:) @@ -219,6 +219,10 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,195) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) rate(:,196) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) rate(:,197) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,198) = 1.4e-11_r8 * exp_fac(:) + rate(:,212) = 7.4e-12_r8 * exp_fac(:) + rate(:,313) = 8.1e-12_r8 * exp_fac(:) rate(:,199) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) rate(:,200) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) rate(:,201) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) @@ -228,10 +232,10 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,205) = 2.6e-12_r8 * exp_fac(:) rate(:,206) = 6.4e-12_r8 * exp_fac(:) rate(:,236) = 4.1e-13_r8 * exp_fac(:) - rate(:,417) = 7.5e-12_r8 * exp_fac(:) - rate(:,431) = 7.5e-12_r8 * exp_fac(:) - rate(:,434) = 7.5e-12_r8 * exp_fac(:) - rate(:,437) = 7.5e-12_r8 * exp_fac(:) + rate(:,416) = 7.5e-12_r8 * exp_fac(:) + rate(:,430) = 7.5e-12_r8 * exp_fac(:) + rate(:,433) = 7.5e-12_r8 * exp_fac(:) + rate(:,436) = 7.5e-12_r8 * exp_fac(:) rate(:,207) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) exp_fac(:) = exp( -840._r8 * itemp(:) ) rate(:,209) = 3.6e-12_r8 * exp_fac(:) @@ -254,9 +258,6 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,231) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) rate(:,232) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) rate(:,234) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) - exp_fac(:) = exp( 260._r8 * itemp(:) ) - rate(:,235) = 2.3e-12_r8 * exp_fac(:) - rate(:,238) = 8.8e-12_r8 * exp_fac(:) rate(:,237) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) rate(:,240) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) rate(:,245) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) @@ -270,90 +271,87 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,271) = 1.794e-10_r8 * exp_fac(:) rate(:,272) = 1.3e-10_r8 * exp_fac(:) rate(:,273) = 7.65e-11_r8 * exp_fac(:) - rate(:,287) = 4e-13_r8 * exp_fac(:) - rate(:,291) = 1.31e-10_r8 * exp_fac(:) - rate(:,292) = 3.5e-11_r8 * exp_fac(:) - rate(:,293) = 9e-12_r8 * exp_fac(:) - rate(:,300) = 6.8e-14_r8 * exp_fac(:) - rate(:,301) = 2e-13_r8 * exp_fac(:) - rate(:,315) = 7e-13_r8 * exp_fac(:) - rate(:,316) = 1e-12_r8 * exp_fac(:) - rate(:,320) = 1e-14_r8 * exp_fac(:) - rate(:,321) = 1e-11_r8 * exp_fac(:) - rate(:,322) = 1.15e-11_r8 * exp_fac(:) - rate(:,323) = 4e-14_r8 * exp_fac(:) - rate(:,336) = 3e-12_r8 * exp_fac(:) - rate(:,337) = 6.7e-13_r8 * exp_fac(:) - rate(:,347) = 3.5e-13_r8 * exp_fac(:) - rate(:,348) = 5.4e-11_r8 * exp_fac(:) - rate(:,351) = 2e-12_r8 * exp_fac(:) - rate(:,352) = 1.4e-11_r8 * exp_fac(:) - rate(:,355) = 2.4e-12_r8 * exp_fac(:) - rate(:,366) = 5e-12_r8 * exp_fac(:) - rate(:,376) = 1.6e-12_r8 * exp_fac(:) - rate(:,378) = 6.7e-12_r8 * exp_fac(:) - rate(:,381) = 3.5e-12_r8 * exp_fac(:) - rate(:,384) = 1.3e-11_r8 * exp_fac(:) - rate(:,385) = 1.4e-11_r8 * exp_fac(:) - rate(:,389) = 2.4e-12_r8 * exp_fac(:) - rate(:,390) = 1.4e-11_r8 * exp_fac(:) - rate(:,395) = 2.4e-12_r8 * exp_fac(:) + rate(:,286) = 4e-13_r8 * exp_fac(:) + rate(:,290) = 1.31e-10_r8 * exp_fac(:) + rate(:,291) = 3.5e-11_r8 * exp_fac(:) + rate(:,292) = 9e-12_r8 * exp_fac(:) + rate(:,299) = 6.8e-14_r8 * exp_fac(:) + rate(:,300) = 2e-13_r8 * exp_fac(:) + rate(:,315) = 1e-12_r8 * exp_fac(:) + rate(:,319) = 1e-14_r8 * exp_fac(:) + rate(:,320) = 1e-11_r8 * exp_fac(:) + rate(:,321) = 1.15e-11_r8 * exp_fac(:) + rate(:,322) = 4e-14_r8 * exp_fac(:) + rate(:,335) = 3e-12_r8 * exp_fac(:) + rate(:,336) = 6.7e-13_r8 * exp_fac(:) + rate(:,346) = 3.5e-13_r8 * exp_fac(:) + rate(:,347) = 5.4e-11_r8 * exp_fac(:) + rate(:,350) = 2e-12_r8 * exp_fac(:) + rate(:,351) = 1.4e-11_r8 * exp_fac(:) + rate(:,354) = 2.4e-12_r8 * exp_fac(:) + rate(:,365) = 5e-12_r8 * exp_fac(:) + rate(:,375) = 1.6e-12_r8 * exp_fac(:) + rate(:,377) = 6.7e-12_r8 * exp_fac(:) + rate(:,380) = 3.5e-12_r8 * exp_fac(:) + rate(:,383) = 1.3e-11_r8 * exp_fac(:) + rate(:,384) = 1.4e-11_r8 * exp_fac(:) + rate(:,388) = 2.4e-12_r8 * exp_fac(:) + rate(:,389) = 1.4e-11_r8 * exp_fac(:) + rate(:,394) = 2.4e-12_r8 * exp_fac(:) + rate(:,395) = 4e-11_r8 * exp_fac(:) rate(:,396) = 4e-11_r8 * exp_fac(:) - rate(:,397) = 4e-11_r8 * exp_fac(:) - rate(:,399) = 1.4e-11_r8 * exp_fac(:) - rate(:,403) = 2.4e-12_r8 * exp_fac(:) - rate(:,404) = 4e-11_r8 * exp_fac(:) - rate(:,408) = 7e-11_r8 * exp_fac(:) - rate(:,409) = 1e-10_r8 * exp_fac(:) - rate(:,414) = 2.4e-12_r8 * exp_fac(:) - rate(:,429) = 4.7e-11_r8 * exp_fac(:) - rate(:,442) = 2.1e-12_r8 * exp_fac(:) - rate(:,443) = 2.8e-13_r8 * exp_fac(:) - rate(:,451) = 1.7e-11_r8 * exp_fac(:) - rate(:,457) = 8.4e-11_r8 * exp_fac(:) - rate(:,459) = 1.9e-11_r8 * exp_fac(:) - rate(:,460) = 1.2e-14_r8 * exp_fac(:) - rate(:,461) = 2e-10_r8 * exp_fac(:) - rate(:,468) = 2.4e-12_r8 * exp_fac(:) - rate(:,469) = 2e-11_r8 * exp_fac(:) - rate(:,473) = 2.3e-11_r8 * exp_fac(:) - rate(:,474) = 2e-11_r8 * exp_fac(:) - rate(:,478) = 3.3e-11_r8 * exp_fac(:) - rate(:,479) = 1e-12_r8 * exp_fac(:) - rate(:,480) = 5.7e-11_r8 * exp_fac(:) - rate(:,481) = 3.4e-11_r8 * exp_fac(:) - rate(:,486) = 2.3e-12_r8 * exp_fac(:) + rate(:,398) = 1.4e-11_r8 * exp_fac(:) + rate(:,402) = 2.4e-12_r8 * exp_fac(:) + rate(:,403) = 4e-11_r8 * exp_fac(:) + rate(:,407) = 7e-11_r8 * exp_fac(:) + rate(:,408) = 1e-10_r8 * exp_fac(:) + rate(:,413) = 2.4e-12_r8 * exp_fac(:) + rate(:,428) = 4.7e-11_r8 * exp_fac(:) + rate(:,441) = 2.1e-12_r8 * exp_fac(:) + rate(:,442) = 2.8e-13_r8 * exp_fac(:) + rate(:,450) = 1.7e-11_r8 * exp_fac(:) + rate(:,456) = 8.4e-11_r8 * exp_fac(:) + rate(:,458) = 1.9e-11_r8 * exp_fac(:) + rate(:,459) = 1.2e-14_r8 * exp_fac(:) + rate(:,460) = 2e-10_r8 * exp_fac(:) + rate(:,467) = 2.4e-12_r8 * exp_fac(:) + rate(:,468) = 2e-11_r8 * exp_fac(:) + rate(:,472) = 2.3e-11_r8 * exp_fac(:) + rate(:,473) = 2e-11_r8 * exp_fac(:) + rate(:,477) = 3.3e-11_r8 * exp_fac(:) + rate(:,478) = 1e-12_r8 * exp_fac(:) + rate(:,479) = 5.7e-11_r8 * exp_fac(:) + rate(:,480) = 3.4e-11_r8 * exp_fac(:) + rate(:,485) = 2.3e-12_r8 * exp_fac(:) rate(:,487) = 1.2e-11_r8 * exp_fac(:) rate(:,488) = 5.7e-11_r8 * exp_fac(:) rate(:,489) = 2.8e-11_r8 * exp_fac(:) rate(:,490) = 6.6e-11_r8 * exp_fac(:) rate(:,491) = 1.4e-11_r8 * exp_fac(:) rate(:,494) = 1.9e-12_r8 * exp_fac(:) - rate(:,508) = 6.34e-08_r8 * exp_fac(:) - rate(:,514) = 1.9e-11_r8 * exp_fac(:) + rate(:,506) = 6.34e-08_r8 * exp_fac(:) + rate(:,512) = 1.9e-11_r8 * exp_fac(:) rate(:,515) = 1.2e-14_r8 * exp_fac(:) rate(:,516) = 2e-10_r8 * exp_fac(:) - rate(:,521) = 1.34e-11_r8 * exp_fac(:) - rate(:,522) = 1.34e-11_r8 * exp_fac(:) - rate(:,526) = 1.34e-11_r8 * exp_fac(:) rate(:,527) = 1.34e-11_r8 * exp_fac(:) - rate(:,529) = 1.7e-11_r8 * exp_fac(:) - rate(:,547) = 1.29e-07_r8 * exp_fac(:) + rate(:,530) = 1.34e-11_r8 * exp_fac(:) + rate(:,536) = 1.34e-11_r8 * exp_fac(:) + rate(:,537) = 1.34e-11_r8 * exp_fac(:) + rate(:,542) = 1.7e-11_r8 * exp_fac(:) + rate(:,562) = 1.29e-07_r8 * exp_fac(:) exp_fac(:) = exp( 400._r8 * itemp(:) ) rate(:,254) = 6e-12_r8 * exp_fac(:) - rate(:,353) = 5e-13_r8 * exp_fac(:) - rate(:,386) = 5e-13_r8 * exp_fac(:) - rate(:,391) = 5e-13_r8 * exp_fac(:) - rate(:,400) = 5e-13_r8 * exp_fac(:) - rate(:,411) = 5e-13_r8 * exp_fac(:) + rate(:,352) = 5e-13_r8 * exp_fac(:) + rate(:,385) = 5e-13_r8 * exp_fac(:) + rate(:,390) = 5e-13_r8 * exp_fac(:) + rate(:,399) = 5e-13_r8 * exp_fac(:) + rate(:,410) = 5e-13_r8 * exp_fac(:) rate(:,259) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) rate(:,260) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) exp_fac(:) = exp( -1520._r8 * itemp(:) ) rate(:,261) = 1.64e-12_r8 * exp_fac(:) - rate(:,372) = 8.5e-16_r8 * exp_fac(:) - exp_fac(:) = exp( -1100._r8 * itemp(:) ) - rate(:,262) = 2.03e-11_r8 * exp_fac(:) - rate(:,493) = 3.4e-12_r8 * exp_fac(:) + rate(:,371) = 8.5e-16_r8 * exp_fac(:) + rate(:,262) = 2.03e-11_r8 * exp( -1110._r8 * itemp(:) ) rate(:,263) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) rate(:,264) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) rate(:,265) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) @@ -364,139 +362,158 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,268) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) rate(:,274) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) rate(:,275) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) - rate(:,277) = 5.5e-12_r8 * exp( 125._r8 * itemp(:) ) rate(:,278) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) rate(:,279) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) rate(:,280) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) exp_fac(:) = exp( 300._r8 * itemp(:) ) rate(:,281) = 2.8e-12_r8 * exp_fac(:) - rate(:,343) = 2.9e-12_r8 * exp_fac(:) + rate(:,342) = 2.9e-12_r8 * exp_fac(:) rate(:,282) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) rate(:,284) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) exp_fac(:) = exp( 700._r8 * itemp(:) ) - rate(:,288) = 7.5e-13_r8 * exp_fac(:) - rate(:,302) = 7.5e-13_r8 * exp_fac(:) - rate(:,317) = 7.5e-13_r8 * exp_fac(:) - rate(:,330) = 7.5e-13_r8 * exp_fac(:) - rate(:,338) = 7.5e-13_r8 * exp_fac(:) - rate(:,342) = 8.6e-13_r8 * exp_fac(:) - rate(:,354) = 8e-13_r8 * exp_fac(:) - rate(:,367) = 7.5e-13_r8 * exp_fac(:) - rate(:,377) = 7.5e-13_r8 * exp_fac(:) - rate(:,387) = 8e-13_r8 * exp_fac(:) - rate(:,392) = 8e-13_r8 * exp_fac(:) - rate(:,401) = 8e-13_r8 * exp_fac(:) - rate(:,412) = 8e-13_r8 * exp_fac(:) - rate(:,419) = 7.5e-13_r8 * exp_fac(:) - rate(:,423) = 7.5e-13_r8 * exp_fac(:) - rate(:,426) = 7.5e-13_r8 * exp_fac(:) - rate(:,439) = 7.5e-13_r8 * exp_fac(:) - rate(:,446) = 7.5e-13_r8 * exp_fac(:) - rate(:,452) = 7.5e-13_r8 * exp_fac(:) - rate(:,455) = 7.5e-13_r8 * exp_fac(:) - rate(:,466) = 7.5e-13_r8 * exp_fac(:) - rate(:,471) = 7.5e-13_r8 * exp_fac(:) - rate(:,476) = 7.5e-13_r8 * exp_fac(:) - rate(:,289) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) - rate(:,290) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) - rate(:,294) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) - rate(:,299) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + rate(:,287) = 7.5e-13_r8 * exp_fac(:) + rate(:,301) = 7.5e-13_r8 * exp_fac(:) + rate(:,316) = 7.5e-13_r8 * exp_fac(:) + rate(:,329) = 7.5e-13_r8 * exp_fac(:) + rate(:,337) = 7.5e-13_r8 * exp_fac(:) + rate(:,341) = 8.6e-13_r8 * exp_fac(:) + rate(:,353) = 8e-13_r8 * exp_fac(:) + rate(:,366) = 7.5e-13_r8 * exp_fac(:) + rate(:,376) = 7.5e-13_r8 * exp_fac(:) + rate(:,386) = 8e-13_r8 * exp_fac(:) + rate(:,391) = 8e-13_r8 * exp_fac(:) + rate(:,400) = 8e-13_r8 * exp_fac(:) + rate(:,411) = 8e-13_r8 * exp_fac(:) + rate(:,418) = 7.5e-13_r8 * exp_fac(:) + rate(:,422) = 7.5e-13_r8 * exp_fac(:) + rate(:,425) = 7.5e-13_r8 * exp_fac(:) + rate(:,438) = 7.5e-13_r8 * exp_fac(:) + rate(:,445) = 7.5e-13_r8 * exp_fac(:) + rate(:,451) = 7.5e-13_r8 * exp_fac(:) + rate(:,454) = 7.5e-13_r8 * exp_fac(:) + rate(:,465) = 7.5e-13_r8 * exp_fac(:) + rate(:,470) = 7.5e-13_r8 * exp_fac(:) + rate(:,475) = 7.5e-13_r8 * exp_fac(:) + rate(:,518) = 7.5e-13_r8 * exp_fac(:) + rate(:,525) = 7.5e-13_r8 * exp_fac(:) + rate(:,528) = 7.5e-13_r8 * exp_fac(:) + rate(:,539) = 7.5e-13_r8 * exp_fac(:) + rate(:,543) = 7.5e-13_r8 * exp_fac(:) + rate(:,288) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) + rate(:,289) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) + rate(:,293) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) + rate(:,298) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) exp_fac(:) = exp( 365._r8 * itemp(:) ) - rate(:,303) = 2.6e-12_r8 * exp_fac(:) - rate(:,420) = 2.6e-12_r8 * exp_fac(:) - rate(:,425) = 2.6e-12_r8 * exp_fac(:) - rate(:,427) = 2.6e-12_r8 * exp_fac(:) - rate(:,440) = 2.6e-12_r8 * exp_fac(:) - rate(:,447) = 2.6e-12_r8 * exp_fac(:) - rate(:,453) = 2.6e-12_r8 * exp_fac(:) - rate(:,456) = 2.6e-12_r8 * exp_fac(:) - rate(:,304) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) - rate(:,306) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) - rate(:,307) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + rate(:,302) = 2.6e-12_r8 * exp_fac(:) + rate(:,419) = 2.6e-12_r8 * exp_fac(:) + rate(:,424) = 2.6e-12_r8 * exp_fac(:) + rate(:,426) = 2.6e-12_r8 * exp_fac(:) + rate(:,439) = 2.6e-12_r8 * exp_fac(:) + rate(:,446) = 2.6e-12_r8 * exp_fac(:) + rate(:,452) = 2.6e-12_r8 * exp_fac(:) + rate(:,455) = 2.6e-12_r8 * exp_fac(:) + rate(:,519) = 2.6e-12_r8 * exp_fac(:) + rate(:,526) = 2.6e-12_r8 * exp_fac(:) + rate(:,529) = 2.6e-12_r8 * exp_fac(:) + rate(:,540) = 2.6e-12_r8 * exp_fac(:) + rate(:,544) = 2.6e-12_r8 * exp_fac(:) + rate(:,303) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,305) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,306) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) exp_fac(:) = exp( -1900._r8 * itemp(:) ) - rate(:,308) = 1.4e-12_r8 * exp_fac(:) - rate(:,328) = 6.5e-15_r8 * exp_fac(:) - rate(:,309) = 4.63e-12_r8 * exp( 350._r8 * itemp(:) ) - rate(:,310) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) + rate(:,307) = 1.4e-12_r8 * exp_fac(:) + rate(:,327) = 6.5e-15_r8 * exp_fac(:) + exp_fac(:) = exp( 350._r8 * itemp(:) ) + rate(:,308) = 4.63e-12_r8 * exp_fac(:) + rate(:,522) = 2.7e-12_r8 * exp_fac(:) + rate(:,309) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) exp_fac(:) = exp( 500._r8 * itemp(:) ) - rate(:,311) = 2.9e-12_r8 * exp_fac(:) - rate(:,312) = 2e-12_r8 * exp_fac(:) - rate(:,341) = 7.1e-13_r8 * exp_fac(:) - rate(:,362) = 2e-12_r8 * exp_fac(:) - rate(:,465) = 2e-12_r8 * exp_fac(:) - rate(:,470) = 2e-12_r8 * exp_fac(:) - rate(:,475) = 2e-12_r8 * exp_fac(:) + rate(:,310) = 2.9e-12_r8 * exp_fac(:) + rate(:,311) = 2e-12_r8 * exp_fac(:) + rate(:,340) = 7.1e-13_r8 * exp_fac(:) + rate(:,361) = 2e-12_r8 * exp_fac(:) + rate(:,464) = 2e-12_r8 * exp_fac(:) + rate(:,469) = 2e-12_r8 * exp_fac(:) + rate(:,474) = 2e-12_r8 * exp_fac(:) exp_fac(:) = exp( 1040._r8 * itemp(:) ) - rate(:,313) = 4.3e-13_r8 * exp_fac(:) - rate(:,363) = 4.3e-13_r8 * exp_fac(:) - rate(:,416) = 4.3e-13_r8 * exp_fac(:) - rate(:,430) = 4.3e-13_r8 * exp_fac(:) - rate(:,433) = 4.3e-13_r8 * exp_fac(:) - rate(:,436) = 4.3e-13_r8 * exp_fac(:) - rate(:,319) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) - rate(:,327) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) - rate(:,329) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) - rate(:,333) = 8.7e-12_r8 * exp( -615._r8 * itemp(:) ) - rate(:,334) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) - rate(:,335) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) - rate(:,349) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) - rate(:,350) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) + rate(:,312) = 4.3e-13_r8 * exp_fac(:) + rate(:,362) = 4.3e-13_r8 * exp_fac(:) + rate(:,415) = 4.3e-13_r8 * exp_fac(:) + rate(:,429) = 4.3e-13_r8 * exp_fac(:) + rate(:,432) = 4.3e-13_r8 * exp_fac(:) + rate(:,435) = 4.3e-13_r8 * exp_fac(:) + rate(:,314) = 3.15e-14_r8 * exp( 920._r8 * itemp(:) ) + rate(:,318) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,326) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,328) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,332) = 9.19e-12_r8 * exp( -630._r8 * itemp(:) ) + rate(:,333) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) + rate(:,334) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + rate(:,348) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) + rate(:,349) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) exp_fac(:) = exp( 360._r8 * itemp(:) ) - rate(:,356) = 2.7e-12_r8 * exp_fac(:) - rate(:,357) = 1.3e-13_r8 * exp_fac(:) - rate(:,359) = 9.6e-12_r8 * exp_fac(:) - rate(:,365) = 5.3e-12_r8 * exp_fac(:) - rate(:,402) = 2.7e-12_r8 * exp_fac(:) - rate(:,413) = 2.7e-12_r8 * exp_fac(:) - rate(:,358) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) + rate(:,355) = 2.7e-12_r8 * exp_fac(:) + rate(:,356) = 1.3e-13_r8 * exp_fac(:) + rate(:,358) = 9.6e-12_r8 * exp_fac(:) + rate(:,364) = 5.3e-12_r8 * exp_fac(:) + rate(:,401) = 2.7e-12_r8 * exp_fac(:) + rate(:,412) = 2.7e-12_r8 * exp_fac(:) + rate(:,514) = 2.7e-12_r8 * exp_fac(:) + rate(:,533) = 2.7e-12_r8 * exp_fac(:) + rate(:,357) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) exp_fac(:) = exp( 530._r8 * itemp(:) ) - rate(:,361) = 4.6e-12_r8 * exp_fac(:) - rate(:,364) = 2.3e-12_r8 * exp_fac(:) - rate(:,369) = 2.3e-12_r8 * exp( -170._r8 * itemp(:) ) - rate(:,373) = 4.13e-12_r8 * exp( 452._r8 * itemp(:) ) - rate(:,379) = 5.4e-14_r8 * exp( 870._r8 * itemp(:) ) + rate(:,360) = 4.6e-12_r8 * exp_fac(:) + rate(:,363) = 2.3e-12_r8 * exp_fac(:) + rate(:,368) = 2.3e-12_r8 * exp( -170._r8 * itemp(:) ) + rate(:,372) = 4.13e-12_r8 * exp( 452._r8 * itemp(:) ) + rate(:,378) = 5.4e-14_r8 * exp( 870._r8 * itemp(:) ) exp_fac(:) = exp( 175._r8 * itemp(:) ) + rate(:,381) = 1.86e-11_r8 * exp_fac(:) rate(:,382) = 1.86e-11_r8 * exp_fac(:) - rate(:,383) = 1.86e-11_r8 * exp_fac(:) - rate(:,393) = 1.6e+09_r8 * exp( -8300._r8 * itemp(:) ) + rate(:,392) = 1.6e+09_r8 * exp( -8300._r8 * itemp(:) ) exp_fac(:) = exp( -446._r8 * itemp(:) ) - rate(:,398) = 3.03e-12_r8 * exp_fac(:) - rate(:,518) = 3.03e-12_r8 * exp_fac(:) + rate(:,397) = 3.03e-12_r8 * exp_fac(:) + rate(:,520) = 3.03e-12_r8 * exp_fac(:) exp_fac(:) = exp( 410._r8 * itemp(:) ) - rate(:,406) = 2.54e-11_r8 * exp_fac(:) - rate(:,520) = 2.54e-11_r8 * exp_fac(:) - rate(:,410) = 1.3e-12_r8 * exp( 640._r8 * itemp(:) ) + rate(:,405) = 2.54e-11_r8 * exp_fac(:) + rate(:,524) = 2.54e-11_r8 * exp_fac(:) + rate(:,409) = 1.3e-12_r8 * exp( 640._r8 * itemp(:) ) exp_fac(:) = exp( -193._r8 * itemp(:) ) - rate(:,418) = 2.3e-12_r8 * exp_fac(:) + rate(:,417) = 2.3e-12_r8 * exp_fac(:) rate(:,517) = 2.3e-12_r8 * exp_fac(:) - rate(:,422) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) - rate(:,441) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) + rate(:,421) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) + rate(:,440) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) exp_fac(:) = exp( 352._r8 * itemp(:) ) - rate(:,449) = 1.7e-12_r8 * exp_fac(:) - rate(:,528) = 1.7e-12_r8 * exp_fac(:) + rate(:,448) = 1.7e-12_r8 * exp_fac(:) + rate(:,538) = 1.7e-12_r8 * exp_fac(:) exp_fac(:) = exp( 490._r8 * itemp(:) ) - rate(:,462) = 1.2e-12_r8 * exp_fac(:) - rate(:,523) = 1.2e-12_r8 * exp_fac(:) + rate(:,461) = 1.2e-12_r8 * exp_fac(:) + rate(:,531) = 1.2e-12_r8 * exp_fac(:) exp_fac(:) = exp( -580._r8 * itemp(:) ) - rate(:,463) = 6.3e-16_r8 * exp_fac(:) - rate(:,524) = 6.3e-16_r8 * exp_fac(:) + rate(:,462) = 6.3e-16_r8 * exp_fac(:) + rate(:,534) = 6.3e-16_r8 * exp_fac(:) exp_fac(:) = exp( 440._r8 * itemp(:) ) - rate(:,464) = 1.2e-11_r8 * exp_fac(:) - rate(:,525) = 1.2e-11_r8 * exp_fac(:) - rate(:,482) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) - rate(:,483) = 9.6e-12_r8 * exp( -234._r8 * itemp(:) ) - rate(:,484) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) - rate(:,485) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,463) = 1.2e-11_r8 * exp_fac(:) + rate(:,535) = 1.2e-11_r8 * exp_fac(:) + rate(:,481) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,482) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,483) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,484) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) rate(:,492) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) - rate(:,495) = 2.7e-11_r8 * exp( 335._r8 * itemp(:) ) - rate(:,499) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + rate(:,493) = 3.4e-12_r8 * exp( -1100._r8 * itemp(:) ) + rate(:,495) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) + rate(:,498) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + exp_fac(:) = exp( 1300._r8 * itemp(:) ) + rate(:,513) = 2.75e-13_r8 * exp_fac(:) + rate(:,521) = 2.12e-13_r8 * exp_fac(:) + rate(:,532) = 2.6e-13_r8 * exp_fac(:) itemp(:) = 300._r8 * itemp(:) n = ncol*pver - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + ko(:) = 5.3e-32_r8 * itemp(:)**1.8_r8 + kinf(:) = 9.5e-11_r8 * itemp(:)**(-0.4_r8) call jpl( rate(:,157), m, 0.6_r8, ko, kinf, n ) ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 @@ -535,57 +552,57 @@ subroutine setrxt( rate, temp, m, ncol ) kinf(:) = 6.9e-12_r8 * itemp(:)**2.9_r8 call jpl( rate(:,239), m, 0.6_r8, ko, kinf, n ) - ko(:) = 5.9e-33_r8 * itemp(:)**1._r8 - kinf(:) = 1.1e-12_r8 * itemp(:)**(-1.3_r8) - call jpl( rate(:,285), m, 0.6_r8, ko, kinf, n ) - - ko(:) = 4.28e-33_r8 - kinf(:) = 9.3e-15_r8 * itemp(:)**(-4.42_r8) - call jpl( rate(:,286), m, 0.8_r8, ko, kinf, n ) + ko(:) = 6.1e-33_r8 * itemp(:)**1.5_r8 + kinf(:) = 9.8e-15_r8 * itemp(:)**(-4.6_r8) + call jpl( rate(:,285), m, 0.8_r8, ko, kinf, n ) ko(:) = 5.2e-30_r8 * itemp(:)**2.4_r8 kinf(:) = 2.2e-10_r8 * itemp(:)**0.7_r8 - call jpl( rate(:,296), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,295), m, 0.6_r8, ko, kinf, n ) ko(:) = 5.5e-30_r8 kinf(:) = 8.3e-13_r8 * itemp(:)**(-2._r8) - call jpl( rate(:,297), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,296), 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(:,298), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,297), 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(:,324), m, 0.48_r8, ko, kinf, n ) + call jpl( rate(:,323), m, 0.48_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(:,325), m, 0.6_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(:,324), m, 0.6_r8, ko, kinf, n ) ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 kinf(:) = 3e-11_r8 - call jpl( rate(:,345), m, 0.5_r8, ko, kinf, n ) + call jpl( rate(:,344), m, 0.5_r8, ko, kinf, n ) ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 kinf(:) = 3e-11_r8 - call jpl( rate(:,371), m, 0.5_r8, ko, kinf, n ) + call jpl( rate(:,370), 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(:,432), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,431), m, 0.6_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(:,435), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,434), m, 0.6_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(:,438), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,437), m, 0.6_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(:,445), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,444), 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(:,486), m, 0.6_r8, ko, kinf, n ) end subroutine setrxt @@ -639,15 +656,15 @@ subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) rate(:n,164) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) rate(:n,165) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) rate(:n,170) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) - rate(:n,174) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:n,174) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) rate(:n,175) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) - rate(:n,183) = 3.3e-12_r8 * exp( 270._r8 * itemp(:) ) + rate(:n,183) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) rate(:n,184) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) itemp(:) = 300._r8 * itemp(:) - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + 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,157) = wrk(:) diff --git a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 index 4afb77bfb4..1071b26597 100644 --- a/src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 +++ b/src/chemistry/pp_trop_strat_mam4_vbsext/mo_sim_dat.F90 @@ -31,95 +31,98 @@ subroutine set_sim_dat is_scalar = .false. is_vector = .true. - clscnt(:) = (/ 28, 0, 0, 225, 0 /) + clscnt(:) = (/ 2, 0, 0, 259, 0 /) - cls_rxt_cnt(:,1) = (/ 37, 58, 0, 28 /) - cls_rxt_cnt(:,4) = (/ 23, 194, 328, 225 /) + cls_rxt_cnt(:,1) = (/ 9, 0, 0, 2 /) + cls_rxt_cnt(:,4) = (/ 2, 182, 378, 259 /) - solsym(:253) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','bc_a1 ','bc_a4 ', & - 'BCARY ','BENZENE ','BENZOOH ','BEPOMUC ','BIGALD ', & - 'BIGALD1 ','BIGALD2 ','BIGALD3 ','BIGALD4 ','BIGALK ', & - 'BIGENE ','BR ','BRCL ','BRO ','BRONO2 ', & - 'BRY ','BZALD ','BZOOH ','C2H2 ','C2H4 ', & - 'C2H5OH ','C2H5OOH ','C2H6 ','C3H6 ','C3H7OOH ', & - 'C3H8 ','C6H5OOH ','CCL4 ','CF2CLBR ','CF3BR ', & - 'CFC11 ','CFC113 ','CFC114 ','CFC115 ','CFC12 ', & - 'CH2BR2 ','CH2O ','CH3BR ','CH3CCL3 ','CH3CHO ', & - 'CH3CL ','CH3CN ','CH3COCH3 ','CH3COCHO ','CH3COOH ', & - 'CH3COOOH ','CH3OH ','CH3OOH ','CH4 ','CHBR3 ', & - 'CL ','CL2 ','CL2O2 ','CLO ','CLONO2 ', & - 'CLY ','CO ','CO2 ','COF2 ','COFCL ', & - 'CRESOL ','DMS ','dst_a1 ','dst_a2 ','dst_a3 ', & - 'E90 ','EOOH ','F ','GLYALD ','GLYOXAL ', & - 'H ','H2 ','H2402 ','H2O2 ','H2SO4 ', & - 'HBR ','HCFC141B ','HCFC142B ','HCFC22 ','HCL ', & - 'HCN ','HCOOH ','HF ','HNO3 ','HO2NO2 ', & - 'HOBR ','HOCL ','HONITR ','HPALD ','HYAC ', & - 'HYDRALD ','IEPOX ','ISOP ','ISOPNITA ','ISOPNITB ', & - 'ISOPNO3 ','ISOPNOOH ','ISOPOOH ','IVOCbb ','IVOCff ', & + solsym(:261) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','bc_a1 ','bc_a4 ', & + 'BCARY ','BCARYO2VBS ','BENZENE ','BENZO2VBS ','BENZOOH ', & + 'BEPOMUC ','BIGALD ','BIGALD1 ','BIGALD2 ','BIGALD3 ', & + 'BIGALD4 ','BIGALK ','BIGENE ','BR ','BRCL ', & + 'BRO ','BRONO2 ','BRY ','BZALD ','BZOOH ', & + 'C2H2 ','C2H4 ','C2H5OH ','C2H5OOH ','C2H6 ', & + 'C3H6 ','C3H7OOH ','C3H8 ','C6H5OOH ','CCL4 ', & + 'CF2CLBR ','CF3BR ','CFC11 ','CFC113 ','CFC114 ', & + 'CFC115 ','CFC12 ','CH2BR2 ','CH2O ','CH3BR ', & + 'CH3CCL3 ','CH3CHO ','CH3CL ','CH3CN ','CH3COCH3 ', & + 'CH3COCHO ','CH3COOH ','CH3COOOH ','CH3OH ','CH3OOH ', & + 'CH4 ','CHBR3 ','CL ','CL2 ','CL2O2 ', & + 'CLO ','CLONO2 ','CLY ','CO ','CO2 ', & + 'COF2 ','COFCL ','CRESOL ','DMS ','dst_a1 ', & + 'dst_a2 ','dst_a3 ','E90 ','EOOH ','F ', & + 'GLYALD ','GLYOXAL ','H ','H2 ','H2402 ', & + 'H2O2 ','H2SO4 ','HBR ','HCFC141B ','HCFC142B ', & + 'HCFC22 ','HCL ','HCN ','HCOOH ','HF ', & + 'HNO3 ','HO2NO2 ','HOBR ','HOCL ','HONITR ', & + 'HPALD ','HYAC ','HYDRALD ','IEPOX ','ISOP ', & + 'ISOPNITA ','ISOPNITB ','ISOPNO3 ','ISOPNOOH ','ISOPO2VBS ', & + 'ISOPOOH ','IVOCbb ','IVOCbbO2VBS ','IVOCff ','IVOCffO2VBS ', & 'MACR ','MACROOH ','MEK ','MEKOOH ','MPAN ', & - 'MTERP ','MVK ','N ','N2O ','N2O5 ', & - 'NC4CH2OH ','NC4CHO ','ncl_a1 ','ncl_a2 ','ncl_a3 ', & - 'NH3 ','NH4 ','NO ','NO2 ','NO3 ', & - 'NOA ','NTERPOOH ','num_a1 ','num_a2 ','num_a3 ', & - 'num_a4 ','O ','O3 ','O3S ','OCLO ', & - 'OCS ','ONITR ','PAN ','PBZNIT ','PHENO ', & - 'PHENOL ','PHENOOH ','pombb1_a1 ','pombb1_a4 ','pomff1_a1 ', & - 'pomff1_a4 ','POOH ','ROOH ','S ','SF6 ', & - 'SO ','SO2 ','SO3 ','so4_a1 ','so4_a2 ', & - 'so4_a3 ','soabb1_a1 ','soabb1_a2 ','soabb2_a1 ','soabb2_a2 ', & - 'soabb3_a1 ','soabb3_a2 ','soabb4_a1 ','soabb4_a2 ','soabb5_a1 ', & - 'soabb5_a2 ','soabg1_a1 ','soabg1_a2 ','soabg2_a1 ','soabg2_a2 ', & - 'soabg3_a1 ','soabg3_a2 ','soabg4_a1 ','soabg4_a2 ','soabg5_a1 ', & - 'soabg5_a2 ','soaff1_a1 ','soaff1_a2 ','soaff2_a1 ','soaff2_a2 ', & - 'soaff3_a1 ','soaff3_a2 ','soaff4_a1 ','soaff4_a2 ','soaff5_a1 ', & - 'soaff5_a2 ','SOAGbb0 ','SOAGbb1 ','SOAGbb2 ','SOAGbb3 ', & - 'SOAGbb4 ','SOAGbg0 ','SOAGbg1 ','SOAGbg2 ','SOAGbg3 ', & - 'SOAGbg4 ','SOAGff0 ','SOAGff1 ','SOAGff2 ','SOAGff3 ', & - 'SOAGff4 ','SVOCbb ','SVOCff ','TEPOMUC ','TERP2OOH ', & - 'TERPNIT ','TERPOOH ','TERPROD1 ','TERPROD2 ','TOLOOH ', & - 'TOLUENE ','XOOH ','XYLENES ','XYLENOOH ','XYLOL ', & - 'XYLOLOOH ','NHDEP ','NDEP ','ACBZO2 ','ALKO2 ', & - 'BENZO2 ','BZOO ','C2H5O2 ','C3H7O2 ','C6H5O2 ', & - 'CH3CO3 ','CH3O2 ','DICARBO2 ','ENEO2 ','EO ', & - 'EO2 ','HO2 ','HOCH2OO ','ISOPAO2 ','ISOPBO2 ', & - 'MACRO2 ','MALO2 ','MCO3 ','MDIALO2 ','MEKO2 ', & - 'NTERPO2 ','O1D ','OH ','PHENO2 ','PO2 ', & - 'RO2 ','TERP2O2 ','TERPO2 ','TOLO2 ','XO2 ', & - 'XYLENO2 ','XYLOLO2 ','H2O ' /) + 'MTERP ','MTERPO2VBS ','MVK ','N ','N2O ', & + 'N2O5 ','NC4CH2OH ','NC4CHO ','ncl_a1 ','ncl_a2 ', & + 'ncl_a3 ','NH3 ','NH4 ','NO ','NO2 ', & + 'NO3 ','NOA ','NTERPOOH ','num_a1 ','num_a2 ', & + 'num_a3 ','num_a4 ','O ','O3 ','O3S ', & + 'OCLO ','OCS ','ONITR ','PAN ','PBZNIT ', & + 'PHENO ','PHENOL ','PHENOOH ','pombb1_a1 ','pombb1_a4 ', & + 'pomff1_a1 ','pomff1_a4 ','POOH ','ROOH ','S ', & + 'SF6 ','SO ','SO2 ','SO3 ','so4_a1 ', & + 'so4_a2 ','so4_a3 ','soabb1_a1 ','soabb1_a2 ','soabb2_a1 ', & + 'soabb2_a2 ','soabb3_a1 ','soabb3_a2 ','soabb4_a1 ','soabb4_a2 ', & + 'soabb5_a1 ','soabb5_a2 ','soabg1_a1 ','soabg1_a2 ','soabg2_a1 ', & + 'soabg2_a2 ','soabg3_a1 ','soabg3_a2 ','soabg4_a1 ','soabg4_a2 ', & + 'soabg5_a1 ','soabg5_a2 ','soaff1_a1 ','soaff1_a2 ','soaff2_a1 ', & + 'soaff2_a2 ','soaff3_a1 ','soaff3_a2 ','soaff4_a1 ','soaff4_a2 ', & + 'soaff5_a1 ','soaff5_a2 ','SOAGbb0 ','SOAGbb1 ','SOAGbb2 ', & + 'SOAGbb3 ','SOAGbb4 ','SOAGbg0 ','SOAGbg1 ','SOAGbg2 ', & + 'SOAGbg3 ','SOAGbg4 ','SOAGff0 ','SOAGff1 ','SOAGff2 ', & + 'SOAGff3 ','SOAGff4 ','SVOCbb ','SVOCff ','TEPOMUC ', & + 'TERP2OOH ','TERPNIT ','TERPOOH ','TERPROD1 ','TERPROD2 ', & + 'TOLOOH ','TOLUENE ','TOLUO2VBS ','XOOH ','XYLENES ', & + 'XYLENOOH ','XYLEO2VBS ','XYLOL ','XYLOLOOH ','NHDEP ', & + 'NDEP ','ACBZO2 ','ALKO2 ','BENZO2 ','BZOO ', & + 'C2H5O2 ','C3H7O2 ','C6H5O2 ','CH3CO3 ','CH3O2 ', & + 'DICARBO2 ','ENEO2 ','EO ','EO2 ','HO2 ', & + 'HOCH2OO ','ISOPAO2 ','ISOPBO2 ','MACRO2 ','MALO2 ', & + 'MCO3 ','MDIALO2 ','MEKO2 ','NTERPO2 ','O1D ', & + 'OH ','PHENO2 ','PO2 ','RO2 ','TERP2O2 ', & + 'TERPO2 ','TOLO2 ','XO2 ','XYLENO2 ','XYLOLO2 ', & + 'H2O ' /) - adv_mass(:253) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 12.011000_r8, 12.011000_r8, & - 204.342600_r8, 78.110400_r8, 160.122200_r8, 126.108600_r8, 98.098200_r8, & - 84.072400_r8, 98.098200_r8, 98.098200_r8, 112.124000_r8, 72.143800_r8, & - 56.103200_r8, 79.904000_r8, 115.356700_r8, 95.903400_r8, 141.908940_r8, & - 99.716850_r8, 106.120800_r8, 124.135000_r8, 26.036800_r8, 28.051600_r8, & - 46.065800_r8, 62.065200_r8, 30.066400_r8, 42.077400_r8, 76.091000_r8, & - 44.092200_r8, 110.109200_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, 41.050940_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, 66.007206_r8, 82.461503_r8, & - 108.135600_r8, 62.132400_r8, 135.064039_r8, 135.064039_r8, 135.064039_r8, & - 28.010400_r8, 78.064600_r8, 18.998403_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, & - 27.025140_r8, 46.024600_r8, 20.005803_r8, 63.012340_r8, 79.011740_r8, & - 96.910800_r8, 52.459500_r8, 135.114940_r8, 116.112400_r8, 74.076200_r8, & - 100.113000_r8, 118.127200_r8, 68.114200_r8, 147.125940_r8, 147.125940_r8, & - 162.117940_r8, 163.125340_r8, 118.127200_r8, 184.350200_r8, 184.350200_r8, & + adv_mass(:261) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 12.011000_r8, 12.011000_r8, & + 204.342600_r8, 253.348200_r8, 78.110400_r8, 159.114800_r8, 160.122200_r8, & + 126.108600_r8, 98.098200_r8, 84.072400_r8, 98.098200_r8, 98.098200_r8, & + 112.124000_r8, 72.143800_r8, 56.103200_r8, 79.904000_r8, 115.356700_r8, & + 95.903400_r8, 141.908940_r8, 99.716850_r8, 106.120800_r8, 124.135000_r8, & + 26.036800_r8, 28.051600_r8, 46.065800_r8, 62.065200_r8, 30.066400_r8, & + 42.077400_r8, 76.091000_r8, 44.092200_r8, 110.109200_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, 41.050940_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, & + 66.007206_r8, 82.461503_r8, 108.135600_r8, 62.132400_r8, 135.064039_r8, & + 135.064039_r8, 135.064039_r8, 28.010400_r8, 78.064600_r8, 18.998403_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, 27.025140_r8, 46.024600_r8, 20.005803_r8, & + 63.012340_r8, 79.011740_r8, 96.910800_r8, 52.459500_r8, 135.114940_r8, & + 116.112400_r8, 74.076200_r8, 100.113000_r8, 118.127200_r8, 68.114200_r8, & + 147.125940_r8, 147.125940_r8, 162.117940_r8, 163.125340_r8, 117.119800_r8, & + 118.127200_r8, 184.350200_r8, 233.355800_r8, 184.350200_r8, 233.355800_r8, & 70.087800_r8, 120.100800_r8, 72.102600_r8, 104.101400_r8, 147.084740_r8, & - 136.228400_r8, 70.087800_r8, 14.006740_r8, 44.012880_r8, 108.010480_r8, & - 147.125940_r8, 145.111140_r8, 58.442468_r8, 58.442468_r8, 58.442468_r8, & - 17.028940_r8, 18.036340_r8, 30.006140_r8, 46.005540_r8, 62.004940_r8, & - 119.074340_r8, 231.239540_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, 183.117740_r8, 93.102400_r8, & - 94.109800_r8, 176.121600_r8, 12.011000_r8, 12.011000_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, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 136.228400_r8, 185.234000_r8, 70.087800_r8, 14.006740_r8, 44.012880_r8, & + 108.010480_r8, 147.125940_r8, 145.111140_r8, 58.442468_r8, 58.442468_r8, & + 58.442468_r8, 17.028940_r8, 18.036340_r8, 30.006140_r8, 46.005540_r8, & + 62.004940_r8, 119.074340_r8, 231.239540_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, 183.117740_r8, & + 93.102400_r8, 94.109800_r8, 176.121600_r8, 12.011000_r8, 12.011000_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, 250.445000_r8, 250.445000_r8, 250.445000_r8, & 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & @@ -128,50 +131,52 @@ subroutine set_sim_dat 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & - 250.445000_r8, 310.582400_r8, 310.582400_r8, 140.134400_r8, 200.226000_r8, & - 215.240140_r8, 186.241400_r8, 168.227200_r8, 154.201400_r8, 174.148000_r8, & - 92.136200_r8, 150.126000_r8, 106.162000_r8, 188.173800_r8, 122.161400_r8, & - 204.173200_r8, 14.006740_r8, 14.006740_r8, 137.112200_r8, 103.135200_r8, & - 159.114800_r8, 123.127600_r8, 61.057800_r8, 75.083600_r8, 109.101800_r8, & - 75.042400_r8, 47.032000_r8, 129.089600_r8, 105.108800_r8, 61.057800_r8, & - 77.057200_r8, 33.006200_r8, 63.031400_r8, 117.119800_r8, 117.119800_r8, & - 119.093400_r8, 115.063800_r8, 101.079200_r8, 117.078600_r8, 103.094000_r8, & - 230.232140_r8, 15.999400_r8, 17.006800_r8, 175.114200_r8, 91.083000_r8, & - 89.068200_r8, 199.218600_r8, 185.234000_r8, 173.140600_r8, 149.118600_r8, & - 187.166400_r8, 203.165800_r8, 18.014200_r8 /) + 250.445000_r8, 250.445000_r8, 310.582400_r8, 310.582400_r8, 140.134400_r8, & + 200.226000_r8, 215.240140_r8, 186.241400_r8, 168.227200_r8, 154.201400_r8, & + 174.148000_r8, 92.136200_r8, 173.140600_r8, 150.126000_r8, 106.162000_r8, & + 188.173800_r8, 187.166400_r8, 122.161400_r8, 204.173200_r8, 14.006740_r8, & + 14.006740_r8, 137.112200_r8, 103.135200_r8, 159.114800_r8, 123.127600_r8, & + 61.057800_r8, 75.083600_r8, 109.101800_r8, 75.042400_r8, 47.032000_r8, & + 129.089600_r8, 105.108800_r8, 61.057800_r8, 77.057200_r8, 33.006200_r8, & + 63.031400_r8, 117.119800_r8, 117.119800_r8, 119.093400_r8, 115.063800_r8, & + 101.079200_r8, 117.078600_r8, 103.094000_r8, 230.232140_r8, 15.999400_r8, & + 17.006800_r8, 175.114200_r8, 91.083000_r8, 89.068200_r8, 199.218600_r8, & + 185.234000_r8, 173.140600_r8, 149.118600_r8, 187.166400_r8, 203.165800_r8, & + 18.014200_r8 /) - crb_mass(:253) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & - 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, 60.055000_r8, & - 48.044000_r8, 60.055000_r8, 60.055000_r8, 72.066000_r8, 60.055000_r8, & - 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & - 0.000000_r8, 84.077000_r8, 84.077000_r8, 24.022000_r8, 24.022000_r8, & - 24.022000_r8, 24.022000_r8, 24.022000_r8, 36.033000_r8, 36.033000_r8, & - 36.033000_r8, 72.066000_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, & + crb_mass(:261) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 180.165000_r8, 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, & + 72.066000_r8, 60.055000_r8, 48.044000_r8, 60.055000_r8, 60.055000_r8, & + 72.066000_r8, 60.055000_r8, 48.044000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 84.077000_r8, 84.077000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 36.033000_r8, 36.033000_r8, 36.033000_r8, 72.066000_r8, 12.011000_r8, & 12.011000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, 24.022000_r8, & - 12.011000_r8, 24.022000_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, 12.011000_r8, 12.011000_r8, & - 84.077000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & - 12.011000_r8, 24.022000_r8, 0.000000_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, & + 24.022000_r8, 24.022000_r8, 12.011000_r8, 24.022000_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, 48.044000_r8, 60.055000_r8, 36.033000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 84.077000_r8, 24.022000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_r8, 24.022000_r8, 0.000000_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, 12.011000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 48.044000_r8, & + 60.055000_r8, 36.033000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & - 60.055000_r8, 60.055000_r8, 60.055000_r8, 156.143000_r8, 156.143000_r8, & + 60.055000_r8, 156.143000_r8, 156.143000_r8, 156.143000_r8, 156.143000_r8, & 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & - 120.110000_r8, 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & - 60.055000_r8, 60.055000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 120.110000_r8, 120.110000_r8, 48.044000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 60.055000_r8, 60.055000_r8, 0.000000_r8, 0.000000_r8, & 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & - 36.033000_r8, 120.110000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 36.033000_r8, 120.110000_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, 84.077000_r8, 72.066000_r8, & - 72.066000_r8, 72.066000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & - 12.011000_r8, 36.033000_r8, 36.033000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 48.044000_r8, 24.022000_r8, 84.077000_r8, & + 72.066000_r8, 72.066000_r8, 72.066000_r8, 12.011000_r8, 12.011000_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, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 0.000000_r8, 0.000000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & @@ -180,94 +185,102 @@ subroutine set_sim_dat 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & - 180.165000_r8, 264.242000_r8, 264.242000_r8, 84.077000_r8, 120.110000_r8, & - 120.110000_r8, 120.110000_r8, 120.110000_r8, 108.099000_r8, 84.077000_r8, & - 84.077000_r8, 60.055000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, & - 96.088000_r8, 0.000000_r8, 0.000000_r8, 84.077000_r8, 60.055000_r8, & - 72.066000_r8, 84.077000_r8, 24.022000_r8, 36.033000_r8, 72.066000_r8, & - 24.022000_r8, 12.011000_r8, 60.055000_r8, 48.044000_r8, 24.022000_r8, & - 24.022000_r8, 0.000000_r8, 12.011000_r8, 60.055000_r8, 60.055000_r8, & - 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & - 120.110000_r8, 0.000000_r8, 0.000000_r8, 72.066000_r8, 36.033000_r8, & - 36.033000_r8, 120.110000_r8, 120.110000_r8, 84.077000_r8, 60.055000_r8, & - 96.088000_r8, 96.088000_r8, 0.000000_r8 /) + 180.165000_r8, 180.165000_r8, 264.242000_r8, 264.242000_r8, 84.077000_r8, & + 120.110000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, 108.099000_r8, & + 84.077000_r8, 84.077000_r8, 84.077000_r8, 60.055000_r8, 96.088000_r8, & + 96.088000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, 0.000000_r8, & + 0.000000_r8, 84.077000_r8, 60.055000_r8, 72.066000_r8, 84.077000_r8, & + 24.022000_r8, 36.033000_r8, 72.066000_r8, 24.022000_r8, 12.011000_r8, & + 60.055000_r8, 48.044000_r8, 24.022000_r8, 24.022000_r8, 0.000000_r8, & + 12.011000_r8, 60.055000_r8, 60.055000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 120.110000_r8, 0.000000_r8, & + 0.000000_r8, 72.066000_r8, 36.033000_r8, 36.033000_r8, 120.110000_r8, & + 120.110000_r8, 84.077000_r8, 60.055000_r8, 96.088000_r8, 96.088000_r8, & + 0.000000_r8 /) fix_mass(: 3) = (/ 0.00000000_r8, 31.9988000_r8, 28.0134800_r8 /) - clsmap(: 28,1) = (/ 3, 21, 33, 34, 35, 36, 37, 38, 39, 40, & - 41, 43, 44, 46, 54, 55, 61, 63, 71, 78, & - 82, 83, 84, 114, 150, 217, 218, 134 /) - clsmap(:225,4) = (/ 1, 2, 4, 5, 6, 7, 8, 9, 10, 11, & - 12, 13, 14, 15, 16, 17, 18, 19, 20, 22, & - 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, & - 42, 45, 47, 48, 49, 50, 51, 52, 53, 56, & - 57, 58, 59, 60, 62, 64, 65, 66, 67, 68, & - 69, 70, 72, 73, 74, 75, 76, 77, 79, 80, & - 81, 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, & - 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, & - 125, 126, 127, 128, 129, 130, 131, 132, 133, 135, & - 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, & - 146, 147, 148, 149, 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, & - 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 /) + clsmap(: 2,1) = (/ 225, 226 /) + clsmap(:259,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, 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, 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 /) - permute(:225,4) = (/ 154, 155, 1, 2, 179, 79, 122, 80, 120, 130, & - 101, 151, 106, 92, 114, 208, 93, 221, 146, 94, & - 109, 103, 144, 98, 110, 104, 184, 121, 73, 99, & - 216, 195, 71, 181, 200, 141, 136, 167, 123, 224, & - 82, 72, 222, 182, 189, 76, 83, 86, 105, 3, & - 4, 5, 77, 166, 186, 177, 210, 196, 148, 78, & - 170, 212, 84, 168, 96, 209, 124, 165, 171, 187, & - 95, 190, 111, 74, 175, 147, 142, 198, 118, 157, & - 56, 67, 199, 113, 138, 112, 143, 178, 203, 125, & - 102, 116, 185, 6, 7, 8, 70, 9, 211, 217, & - 218, 173, 119, 10, 11, 12, 13, 223, 220, 107, & - 115, 91, 132, 75, 131, 81, 108, 14, 15, 16, & - 17, 140, 117, 137, 201, 174, 97, 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, 57, 58, 59, 60, 61, & - 62, 63, 64, 65, 66, 68, 69, 87, 149, 152, & - 133, 183, 188, 150, 85, 88, 89, 158, 90, 126, & - 139, 180, 134, 127, 172, 169, 153, 207, 219, 163, & - 145, 100, 159, 213, 128, 202, 205, 204, 160, 206, & - 176, 156, 193, 214, 215, 129, 164, 194, 192, 191, & - 161, 197, 162, 135, 225 /) + permute(:259,4) = (/ 184, 186, 1, 2, 3, 214, 69, 103, 79, 146, & + 104, 156, 159, 127, 181, 135, 116, 143, 241, 118, & + 255, 170, 4, 119, 138, 129, 173, 124, 139, 130, & + 218, 147, 88, 125, 85, 96, 97, 89, 98, 90, & + 99, 91, 162, 253, 175, 92, 222, 144, 86, 212, & + 232, 188, 176, 198, 151, 242, 152, 257, 102, 87, & + 250, 209, 5, 223, 203, 121, 115, 109, 128, 6, & + 7, 8, 9, 100, 208, 224, 213, 244, 240, 93, & + 178, 101, 201, 114, 120, 132, 251, 107, 215, 131, & + 243, 150, 197, 200, 228, 122, 227, 140, 94, 204, & + 180, 171, 230, 148, 70, 189, 63, 62, 78, 77, & + 231, 141, 166, 134, 177, 217, 71, 237, 160, 106, & + 133, 149, 219, 10, 11, 12, 84, 13, 245, 247, & + 254, 205, 153, 14, 15, 16, 17, 252, 258, 18, & + 136, 142, 117, 169, 95, 161, 105, 137, 19, 20, & + 21, 22, 172, 145, 168, 23, 233, 206, 123, 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, 64, 65, 66, & + 67, 68, 72, 73, 74, 75, 76, 80, 81, 110, & + 185, 182, 163, 216, 221, 179, 108, 82, 111, 112, & + 190, 83, 113, 154, 167, 210, 164, 155, 202, 199, & + 183, 239, 246, 195, 174, 126, 191, 256, 157, 234, & + 235, 236, 192, 238, 207, 187, 220, 248, 249, 158, & + 196, 226, 225, 211, 193, 229, 194, 165, 259 /) - diag_map(:225) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + diag_map(:259) = (/ 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, 61, 62, 63, 64, 65, & - 66, 67, 68, 69, 70, 71, 77, 83, 89, 90, & - 93, 96, 99, 103, 106, 109, 112, 115, 123, 129, & - 133, 138, 140, 144, 153, 160, 165, 169, 178, 186, & - 191, 194, 197, 200, 203, 208, 212, 216, 220, 224, & - 228, 231, 237, 243, 249, 255, 260, 265, 271, 276, & - 281, 284, 289, 294, 302, 310, 316, 322, 328, 334, & - 340, 346, 352, 358, 364, 370, 378, 384, 391, 397, & - 400, 404, 411, 420, 428, 435, 441, 447, 453, 459, & - 467, 471, 479, 487, 495, 503, 511, 520, 527, 538, & - 547, 551, 559, 566, 577, 588, 596, 607, 620, 627, & - 638, 654, 665, 674, 684, 693, 701, 705, 710, 720, & - 729, 739, 747, 754, 766, 782, 792, 805, 831, 853, & - 863, 871, 881, 893, 912, 924, 932, 946, 955, 959, & - 972, 994,1013,1029,1040,1051,1068,1088,1104,1116, & - 1127,1152,1174,1197,1230,1249,1280,1294,1307,1320, & - 1395,1418,1513,1538,1698,1722,1764,1822,1873,1934, & - 1959,1986,2017,2052,2078 /) + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 67, 69, 70, 71, 72, 73, 74, 80, 86, & + 92, 93, 94, 95, 96, 97, 103, 105, 111, 117, & + 123, 129, 135, 136, 139, 142, 145, 148, 152, 156, & + 160, 164, 168, 172, 175, 178, 183, 188, 193, 198, & + 201, 204, 207, 213, 217, 222, 225, 230, 237, 242, & + 246, 251, 259, 264, 269, 273, 276, 279, 282, 285, & + 290, 293, 299, 303, 307, 311, 315, 318, 324, 330, & + 336, 340, 346, 352, 357, 362, 367, 373, 378, 383, & + 386, 391, 399, 407, 415, 421, 427, 433, 439, 445, & + 451, 457, 463, 469, 477, 483, 489, 496, 502, 506, & + 513, 517, 524, 533, 541, 548, 554, 560, 566, 574, & + 582, 590, 598, 606, 614, 623, 630, 639, 648, 657, & + 666, 670, 678, 685, 695, 706, 717, 724, 730, 741, & + 754, 761, 772, 788, 799, 808, 818, 826, 831, 842, & + 849, 860, 868, 874, 890, 897, 903, 913, 924, 939, & + 952, 962, 970, 988,1010,1016,1039,1064,1085,1101, & + 1115,1125,1135,1142,1155,1169,1180,1193,1213,1233, & + 1249,1261,1272,1296,1328,1351,1372,1394,1426,1441, & + 1455,1470,1487,1503,1604,1657,1702,1744,1917,1944, & + 1967,1999,2024,2082,2107,2227,2267,2329,2356 /) extfrc_lst(: 18) = (/ 'bc_a1 ','bc_a4 ','CO ','NO ','NO2 ', & 'num_a1 ','num_a2 ','num_a4 ','SO2 ','so4_a1 ', & @@ -320,8 +333,8 @@ subroutine set_sim_dat 'jbigald2 ', 'jbigald3 ', & 'jbigald4 ', 'jbzooh ', & 'jc2h5ooh ', 'jc3h7ooh ', & - 'jc6h5ooh ', 'jch2o_a ', & - 'jch2o_b ', 'jch3cho ', & + 'jc6h5ooh ', 'jch2o_b ', & + 'jch2o_a ', 'jch3cho ', & 'jacet ', 'jmgly ', & 'jch3co3h ', 'jch3ooh ', & 'jch4_b ', 'jch4_a ', & @@ -329,8 +342,8 @@ subroutine set_sim_dat 'jglyald ', 'jglyoxal ', & 'jhonitr ', 'jhpald ', & 'jhyac ', 'jisopnooh ', & - 'jisopooh ', 'jmacr_a ', & - 'jmacr_b ', 'jmek ', & + 'jisopooh ', 'jmacr_b ', & + 'jmacr_a ', 'jmek ', & 'jmekooh ', 'jmpan ', & 'jmvk ', 'jnc4cho ', & 'jnoa ', 'jnterpooh ', & @@ -447,114 +460,113 @@ subroutine set_sim_dat 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & 'CH3O2_NO ', 'CH3OH_OH ', & 'CH3OOH_OH ', 'CH4_OH ', & - 'CO_OH_M ', 'HCN_OH ', & - 'HCOOH_OH ', 'HOCH2OO_HO2 ', & - 'HOCH2OO_M ', 'HOCH2OO_NO ', & - 'O1D_CH4a ', 'O1D_CH4b ', & - 'O1D_CH4c ', 'O1D_HCN ', & - 'usr_CO_OH_b ', 'C2H2_CL_M ', & - 'C2H2_OH_M ', '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 ', 'CH3CN_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 ', & - 'BIGENE_NO3 ', 'BIGENE_OH ', & - 'ENEO2_NO ', 'ENEO2_NOb ', & - 'HONITR_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 ', & - 'MEKO2_HO2 ', 'MEKO2_NO ', & - 'MEK_OH ', 'MEKOOH_OH ', & - 'MPAN_OH_M ', 'MVK_O3 ', & - 'MVK_OH ', 'usr_MCO3_NO2 ', & - 'usr_MPAN_M ', 'ALKNIT_OH ', & - 'ALKO2_HO2 ', 'ALKO2_NO ', & - 'ALKO2_NOb ', 'ALKOOH_OH ', & - 'BIGALK_OH ', 'HPALD_OH ', & - 'HYDRALD_OH ', 'IEPOX_OH ', & - 'ISOPAO2_CH3CO3 ', 'ISOPAO2_CH3O2 ', & - 'ISOPAO2_HO2 ', 'ISOPAO2_NO ', & - 'ISOPAO2_NO3 ', 'ISOPBO2_CH3CO3 ', & - 'ISOPBO2_CH3O2 ', 'ISOPBO2_HO2 ', & - 'ISOPBO2_M ', 'ISOPBO2_NO ', & - 'ISOPBO2_NO3 ', 'ISOPNITA_OH ', & - 'ISOPNITB_OH ', 'ISOP_NO3 ', & - 'ISOPNO3_CH3CO3 ', 'ISOPNO3_CH3O2 ' /) - rxt_tag_lst( 401: 547) = (/ 'ISOPNO3_HO2 ', 'ISOPNO3_NO ', & - 'ISOPNO3_NO3 ', 'ISOPNOOH_OH ', & - 'ISOP_O3 ', 'ISOP_OH ', & - 'ISOPOOH_OH ', 'NC4CH2OH_OH ', & - 'NC4CHO_OH ', 'XO2_CH3CO3 ', & - 'XO2_CH3O2 ', 'XO2_HO2 ', & - 'XO2_NO ', 'XO2_NO3 ', & - 'XOOH_OH ', 'ACBZO2_HO2 ', & - 'ACBZO2_NO ', 'BENZENE_OH ', & - 'BENZO2_HO2 ', 'BENZO2_NO ', & - 'BENZOOH_OH ', 'BZALD_OH ', & - 'BZOO_HO2 ', 'BZOOH_OH ', & - 'BZOO_NO ', 'C6H5O2_HO2 ', & - 'C6H5O2_NO ', 'C6H5OOH_OH ', & - 'CRESOL_OH ', 'DICARBO2_HO2 ', & - 'DICARBO2_NO ', 'DICARBO2_NO2 ', & - 'MALO2_HO2 ', 'MALO2_NO ', & - 'MALO2_NO2 ', 'MDIALO2_HO2 ', & - 'MDIALO2_NO ', 'MDIALO2_NO2 ', & - 'PHENO2_HO2 ', 'PHENO2_NO ', & - 'PHENOL_OH ', 'PHENO_NO2 ', & - 'PHENO_O3 ', 'PHENOOH_OH ', & - 'tag_ACBZO2_NO2 ', 'TOLO2_HO2 ', & - 'TOLO2_NO ', 'TOLOOH_OH ', & - 'TOLUENE_OH ', 'usr_PBZNIT_M ', & - 'XYLENES_OH ', 'XYLENO2_HO2 ', & - 'XYLENO2_NO ', 'XYLENOOH_OH ', & - 'XYLOLO2_HO2 ', 'XYLOLO2_NO ', & - 'XYLOL_OH ', 'XYLOLOOH_OH ', & - 'BCARY_NO3 ', 'BCARY_O3 ', & - 'BCARY_OH ', 'MTERP_NO3 ', & - 'MTERP_O3 ', 'MTERP_OH ', & - 'NTERPO2_CH3O2 ', 'NTERPO2_HO2 ', & - 'NTERPO2_NO ', 'NTERPO2_NO3 ', & - 'NTERPOOH_OH ', 'TERP2O2_CH3O2 ', & - 'TERP2O2_HO2 ', 'TERP2O2_NO ', & - 'TERP2OOH_OH ', 'TERPNIT_OH ', & - 'TERPO2_CH3O2 ', 'TERPO2_HO2 ', & - 'TERPO2_NO ', 'TERPOOH_OH ', & - 'TERPROD1_NO3 ', 'TERPROD1_OH ', & - 'TERPROD2_OH ', 'DMS_NO3 ', & - 'DMS_OHa ', 'OCS_O ', & - 'OCS_OH ', 'S_O2 ', & + 'HCN_OH ', 'HCOOH_OH ', & + 'HOCH2OO_HO2 ', 'HOCH2OO_M ', & + 'HOCH2OO_NO ', 'O1D_CH4a ', & + 'O1D_CH4b ', 'O1D_CH4c ', & + 'O1D_HCN ', 'usr_CO_OH ', & + 'C2H2_CL_M ', 'C2H2_OH_M ', & + '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 ', & + 'CH3CN_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 ', 'BIGENE_NO3 ', & + 'BIGENE_OH ', 'ENEO2_NO ', & + 'ENEO2_NOb ', 'HONITR_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 ', 'MEKO2_HO2 ', & + 'MEKO2_NO ', 'MEK_OH ', & + 'MEKOOH_OH ', 'MPAN_OH_M ', & + 'MVK_O3 ', 'MVK_OH ', & + 'usr_MCO3_NO2 ', 'usr_MPAN_M ', & + 'ALKNIT_OH ', 'ALKO2_HO2 ', & + 'ALKO2_NO ', 'ALKO2_NOb ', & + 'ALKOOH_OH ', 'BIGALK_OH ', & + 'HPALD_OH ', 'HYDRALD_OH ', & + 'IEPOX_OH ', 'ISOPAO2_CH3CO3 ', & + 'ISOPAO2_CH3O2 ', 'ISOPAO2_HO2 ', & + 'ISOPAO2_NO ', 'ISOPAO2_NO3 ', & + 'ISOPBO2_CH3CO3 ', 'ISOPBO2_CH3O2 ', & + 'ISOPBO2_HO2 ', 'ISOPBO2_M ', & + 'ISOPBO2_NO ', 'ISOPBO2_NO3 ', & + 'ISOPNITA_OH ', 'ISOPNITB_OH ', & + 'ISOP_NO3 ', 'ISOPNO3_CH3CO3 ', & + 'ISOPNO3_CH3O2 ', 'ISOPNO3_HO2 ' /) + rxt_tag_lst( 401: 562) = (/ 'ISOPNO3_NO ', 'ISOPNO3_NO3 ', & + 'ISOPNOOH_OH ', 'ISOP_O3 ', & + 'ISOP_OH ', 'ISOPOOH_OH ', & + 'NC4CH2OH_OH ', 'NC4CHO_OH ', & + 'XO2_CH3CO3 ', 'XO2_CH3O2 ', & + 'XO2_HO2 ', 'XO2_NO ', & + 'XO2_NO3 ', 'XOOH_OH ', & + 'ACBZO2_HO2 ', 'ACBZO2_NO ', & + 'BENZENE_OH ', 'BENZO2_HO2 ', & + 'BENZO2_NO ', 'BENZOOH_OH ', & + 'BZALD_OH ', 'BZOO_HO2 ', & + 'BZOOH_OH ', 'BZOO_NO ', & + 'C6H5O2_HO2 ', 'C6H5O2_NO ', & + 'C6H5OOH_OH ', 'CRESOL_OH ', & + 'DICARBO2_HO2 ', 'DICARBO2_NO ', & + 'DICARBO2_NO2 ', 'MALO2_HO2 ', & + 'MALO2_NO ', 'MALO2_NO2 ', & + 'MDIALO2_HO2 ', 'MDIALO2_NO ', & + 'MDIALO2_NO2 ', 'PHENO2_HO2 ', & + 'PHENO2_NO ', 'PHENOL_OH ', & + 'PHENO_NO2 ', 'PHENO_O3 ', & + 'PHENOOH_OH ', 'tag_ACBZO2_NO2 ', & + 'TOLO2_HO2 ', 'TOLO2_NO ', & + 'TOLOOH_OH ', 'TOLUENE_OH ', & + 'usr_PBZNIT_M ', 'XYLENES_OH ', & + 'XYLENO2_HO2 ', 'XYLENO2_NO ', & + 'XYLENOOH_OH ', 'XYLOLO2_HO2 ', & + 'XYLOLO2_NO ', 'XYLOL_OH ', & + 'XYLOLOOH_OH ', 'BCARY_NO3 ', & + 'BCARY_O3 ', 'BCARY_OH ', & + 'MTERP_NO3 ', 'MTERP_O3 ', & + 'MTERP_OH ', 'NTERPO2_CH3O2 ', & + 'NTERPO2_HO2 ', 'NTERPO2_NO ', & + 'NTERPO2_NO3 ', 'NTERPOOH_OH ', & + 'TERP2O2_CH3O2 ', 'TERP2O2_HO2 ', & + 'TERP2O2_NO ', 'TERP2OOH_OH ', & + 'TERPNIT_OH ', 'TERPO2_CH3O2 ', & + 'TERPO2_HO2 ', 'TERPO2_NO ', & + 'TERPOOH_OH ', 'TERPROD1_NO3 ', & + 'TERPROD1_OH ', 'TERPROD2_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_SO2_OH ', 'usr_SO3_H2O ', & - 'NH3_OH ', 'usr_GLYOXAL_aer ', & + 'usr_SO3_H2O ', 'NH3_OH ', & 'usr_HO2_aer ', 'usr_HONITR_aer ', & 'usr_ISOPNITA_aer ', 'usr_ISOPNITB_aer ', & 'usr_N2O5_aer ', 'usr_NC4CH2OH_aer ', & @@ -562,23 +574,31 @@ subroutine set_sim_dat 'usr_NO2_aer ', 'usr_NO3_aer ', & 'usr_NTERPOOH_aer ', 'usr_ONITR_aer ', & 'usr_TERPNIT_aer ', 'BCARY_NO3_vbs ', & + 'BCARYO2_HO2_vbs ', 'BCARYO2_NO_vbs ', & 'BCARY_O3_vbs ', 'BCARY_OH_vbs ', & - 'BENZENE_OH_vbs ', 'ISOP_NO3_vbs ', & + 'BENZENE_OH_vbs ', 'BENZO2_HO2_vbs ', & + 'BENZO2_NO_vbs ', 'ISOP_NO3_vbs ', & + 'ISOPO2_HO2_vbs ', 'ISOPO2_NO_vbs ', & 'ISOP_O3_vbs ', 'ISOP_OH_vbs ', & - 'IVOCbb_OH ', 'IVOCff_OH ', & - 'MTERP_NO3_vbs ', 'MTERP_O3_vbs ', & + 'IVOCbbO2_HO2_vbs ', 'IVOCbbO2_NO_vbs ', & + 'IVOCbb_OH_vbs ', 'IVOCffO2_HO2_vbs ', & + 'IVOCffO2_NO_vbs ', 'IVOCff_OH_vbs ', & + 'MTERP_NO3_vbs ', 'MTERPO2_HO2_vbs ', & + 'MTERPO2_NO_vbs ', 'MTERP_O3_vbs ', & 'MTERP_OH_vbs ', 'SVOCbb_OH ', & 'SVOCff_OH ', 'TOLUENE_OH_vbs ', & - 'XYLENES_OH_vbs ', 'het1 ', & - 'het10 ', 'het11 ', & - 'het12 ', 'het13 ', & - 'het14 ', 'het15 ', & - 'het16 ', 'het17 ', & - 'het2 ', 'het3 ', & - 'het4 ', 'het5 ', & - 'het6 ', 'het7 ', & - 'het8 ', 'het9 ', & - 'E90_tau ' /) + 'TOLUO2_HO2_vbs ', 'TOLUO2_NO_vbs ', & + 'usr_GLYOXAL_aer ', 'XYLENES_OH_vbs ', & + 'XYLEO2_HO2_vbs ', 'XYLEO2_NO_vbs ', & + 'het1 ', 'het10 ', & + 'het11 ', 'het12 ', & + 'het13 ', 'het14 ', & + 'het15 ', 'het16 ', & + 'het17 ', 'het2 ', & + 'het3 ', 'het4 ', & + 'het5 ', 'het6 ', & + 'het7 ', 'het8 ', & + 'het9 ', 'E90_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, & @@ -633,7 +653,9 @@ subroutine set_sim_dat 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, & 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, & 531, 532, 533, 534, 535, 536, 537, 538, 539, 540, & - 541, 542, 543, 544, 545, 546, 547 /) + 541, 542, 543, 544, 545, 546, 547, 548, 549, 550, & + 551, 552, 553, 554, 555, 556, 557, 558, 559, 560, & + 561, 562 /) if( allocated( pht_alias_lst ) ) then deallocate( pht_alias_lst ) end if @@ -817,33 +839,34 @@ subroutine set_sim_dat 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, 3, 2, 2, 1, 2, 2, 2, 2, & - 2, 2, 3, 3, 3, 2, 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, 3, 2, 2, 1, 2, 2, 2, 2, 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, 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, & - 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, 1, & 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, 1, 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, 3, 2, 2, 3, 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, 3, 2, 2, & + 3, 2, 2, 3, 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, 3, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & - 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, & - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & - 2, 2, 2, 2, 2, 2, 1, 2, 1, 1, & - 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, & - 1, 1, 2, 1 /) + 2, 2, 2, 2, 2, 2, 2, 1, 2, 2, & + 2, 1, 2, 1, 1, 1, 1, 2, 2, 2, & + 1, 1, 2, 2, 2, 1, 1, 2, 1 /) end subroutine set_sim_dat diff --git a/src/chemistry/pp_trop_strat_mam5_ts2/chem_mech.doc b/src/chemistry/pp_trop_strat_mam5_ts2/chem_mech.doc new file mode 100644 index 0000000000..a314cb9991 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/chem_mech.doc @@ -0,0 +1,3203 @@ + + + Solution species + ( 1) ALKNIT (C5H11ONO2) + ( 2) ALKOOH (C5H12O2) + ( 3) AOA_NH (CO) + ( 4) APIN (C10H16) + ( 5) bc_a1 (C) + ( 6) bc_a4 (C) + ( 7) BCARY (C15H24) + ( 8) BENZENE (C6H6) + ( 9) BENZOOH (C6H8O5) + ( 10) BEPOMUC (C6H6O3) + ( 11) BIGALD1 (C4H4O2) + ( 12) BIGALD2 (C5H6O2) + ( 13) BIGALD3 (C5H6O2) + ( 14) BIGALD4 (C6H8O2) + ( 15) BIGALK (C5H12) + ( 16) BIGENE (C4H8) + ( 17) BPIN (C10H16) + ( 18) BR (Br) + ( 19) BRCL (BrCl) + ( 20) BRO (BrO) + ( 21) BRONO2 (BrONO2) + ( 22) BRY + ( 23) BZALD (C7H6O) + ( 24) BZOOH (C7H8O2) + ( 25) C2H2 + ( 26) C2H4 + ( 27) C2H5OH + ( 28) C2H5OOH + ( 29) C2H6 + ( 30) C3H6 + ( 31) C3H7OOH + ( 32) C3H8 + ( 33) C6H5OOH (C6H5OOH) + ( 34) CCL4 (CCl4) + ( 35) CF2CLBR (CF2ClBr) + ( 36) CF3BR (CF3Br) + ( 37) CFC11 (CFCl3) + ( 38) CFC113 (CCl2FCClF2) + ( 39) CFC114 (CClF2CClF2) + ( 40) CFC115 (CClF2CF3) + ( 41) CFC12 (CF2Cl2) + ( 42) CH2BR2 (CH2Br2) + ( 43) CH2O + ( 44) CH3BR (CH3Br) + ( 45) CH3CCL3 (CH3CCl3) + ( 46) CH3CHO + ( 47) CH3CL (CH3Cl) + ( 48) CH3CN + ( 49) CH3COCH3 + ( 50) CH3COCHO + ( 51) CH3COOH + ( 52) CH3COOOH + ( 53) CH3OH + ( 54) CH3OOH + ( 55) CH4 + ( 56) CHBR3 (CHBr3) + ( 57) CL (Cl) + ( 58) CL2 (Cl2) + ( 59) CL2O2 (Cl2O2) + ( 60) CLO (ClO) + ( 61) CLONO2 (ClONO2) + ( 62) CLY + ( 63) CO + ( 64) CO2 + ( 65) COF2 + ( 66) COFCL (COFCl) + ( 67) CRESOL (C7H8O) + ( 68) DHPMPAL (C4H8O5) + ( 69) DMS (CH3SCH3) + ( 70) dst_a1 (AlSiO5) + ( 71) dst_a2 (AlSiO5) + ( 72) dst_a3 (AlSiO5) + ( 73) E90 (CO) + ( 74) EOOH (HOCH2CH2OOH) + ( 75) F + ( 76) GLYALD (HOCH2CHO) + ( 77) GLYOXAL (C2H2O2) + ( 78) H + ( 79) H2 + ( 80) H2402 (CBrF2CBrF2) + ( 81) H2O2 + ( 82) H2SO4 (H2SO4) + ( 83) HBR (HBr) + ( 84) HCFC141B (CH3CCl2F) + ( 85) HCFC142B (CH3CClF2) + ( 86) HCFC22 (CHF2Cl) + ( 87) HCL (HCl) + ( 88) HCN + ( 89) HCOCH2OOH (C2H4O3) + ( 90) HCOOH + ( 91) HF + ( 92) HMHP (CH4O3) + ( 93) HNO3 + ( 94) HO2NO2 + ( 95) HOBR (HOBr) + ( 96) HOCL (HOCl) + ( 97) HONITR (C4H9NO4) + ( 98) HPALD1 (C5H8O3) + ( 99) HPALD4 (C5H8O3) + (100) HPALDB1C (C5H8O3) + (101) HPALDB4C (C5H8O3) + (102) HYAC (CH3COCH2OH) + (103) HYDRALD (HOCH2CCH3CHCHO) + (104) HYPERACET (C3H6O3) + (105) ICHE (C5H8O3) + (106) IEPOX (C5H10O3) + (107) INHEB (C5H9NO5) + (108) INHED (C5H9NO5) + (109) ISOP (C5H8) + (110) ISOPFDN (C5H10N2O8) + (111) ISOPFDNC (C5H8N2O8) + (112) ISOPFNC (C5H9NO7) + (113) ISOPFNP (C5H11NO7) + (114) ISOPHFP (C5H10O5) + (115) ISOPN1D (C5H9NO4) + (116) ISOPN2B (C5H9NO4) + (117) ISOPN3B (C5H9NO4) + (118) ISOPN4D (C5H9NO4) + (119) ISOPNBNO3 (C5H9NO4) + (120) ISOPNOOHB (C5H9NO5) + (121) ISOPNOOHD (C5H9NO5) + (122) ISOPOH (C5O2H10) + (123) ISOPOOH (HOCH2COOHCH3CHCH2) + (124) IVOC (C13H28) + (125) LIMON (C10H16) + (126) MACR (CH2CCH3CHO) + (127) MACRN (C4H7NO5) + (128) MACROOH (CH3COCHOOHCH2OH) + (129) MEK (C4H8O) + (130) MEKOOH (C4H8O3) + (131) MPAN (CH2CCH3CO3NO2) + (132) MVK (CH2CHCOCH3) + (133) MVKN (C4H7NO5) + (134) MVKOOH (C4H8O4) + (135) MYRC (C10H16) + (136) N + (137) N2O + (138) N2O5 + (139) NC4CHO (C5H7NO4) + (140) ncl_a1 (NaCl) + (141) ncl_a2 (NaCl) + (142) ncl_a3 (NaCl) + (143) NH3 + (144) NH4 + (145) NH_5 (CO) + (146) NH_50 (CO) + (147) NO + (148) NO2 + (149) NO3 + (150) NO3CH2CHO (C2H3O4N) + (151) NOA (CH3COCH2ONO2) + (152) num_a1 (H) + (153) num_a2 (H) + (154) num_a3 (H) + (155) num_a4 (H) + (156) num_a5 (H) + (157) O + (158) O3 + (159) O3S (O3) + (160) OCLO (OClO) + (161) OCS (OCS) + (162) ONITR (C4H7NO4) + (163) PAN (CH3CO3NO2) + (164) PBZNIT (C7H5O3NO2) + (165) PHENO (C6H5O) + (166) PHENOL (C6H5OH) + (167) PHENOOH (C6H8O6) + (168) pom_a1 (C) + (169) pom_a4 (C) + (170) POOH (C3H6OHOOH) + (171) ROOH (CH3COCH2OOH) + (172) S (S) + (173) SF6 + (174) SO (SO) + (175) SO2 + (176) SO3 (SO3) + (177) so4_a1 (NH4HSO4) + (178) so4_a2 (NH4HSO4) + (179) so4_a3 (NH4HSO4) + (180) so4_a5 (NH4HSO4) + (181) soa1_a1 (C15H38O2) + (182) soa1_a2 (C15H38O2) + (183) soa2_a1 (C15H38O2) + (184) soa2_a2 (C15H38O2) + (185) soa3_a1 (C15H38O2) + (186) soa3_a2 (C15H38O2) + (187) soa4_a1 (C15H38O2) + (188) soa4_a2 (C15H38O2) + (189) soa5_a1 (C15H38O2) + (190) soa5_a2 (C15H38O2) + (191) SOAG0 (C15H38O2) + (192) SOAG1 (C15H38O2) + (193) SOAG2 (C15H38O2) + (194) SOAG3 (C15H38O2) + (195) SOAG4 (C15H38O2) + (196) SQTN (C15H25NO4) + (197) ST80_25 (CO) + (198) SVOC (C22H46) + (199) TEPOMUC (C7H8O3) + (200) TERP1OOH (C10H18O3) + (201) TERP2AOOH (C10H18O3) + (202) TERPA (C10H16O2) + (203) TERPA2 (C9H14O2) + (204) TERPA2PAN (C9H13NO6) + (205) TERPA3 (C9H14O3) + (206) TERPA3PAN (C9H13NO7) + (207) TERPACID (C10H16O4) + (208) TERPACID2 (C9H14O4) + (209) TERPACID3 (C9H14O5) + (210) TERPAPAN (C10H15NO6) + (211) TERPDHDP (C10H20O6) + (212) TERPF1 (C10H16O2) + (213) TERPF2 (C7H10O) + (214) TERPFDN (C10H18N2O8) + (215) TERPHFN (C10H19NO7) + (216) TERPK (C9H14O) + (217) TERPNPS (C10H17NO5) + (218) TERPNPS1 (C10H17NO5) + (219) TERPNPT (C10H17NO5) + (220) TERPNPT1 (C10H17NO5) + (221) TERPNS (C10H17NO4) + (222) TERPNS1 (C10H17NO4) + (223) TERPNT (C10H17NO4) + (224) TERPNT1 (C10H17NO4) + (225) TERPOOH (C10H18O3) + (226) TERPOOHL (C10H18O5) + (227) TOLOOH (C7H10O5) + (228) TOLUENE (C7H8) + (229) XYLENES (C8H10) + (230) XYLENOOH (C8H12O5) + (231) XYLOL (C8H10O) + (232) XYLOLOOH (C8H12O6) + (233) NHDEP (N) + (234) NDEP (N) + (235) ACBZO2 (C7H5O3) + (236) ALKO2 (C5H11O2) + (237) APINNO3 (C10H16NO5) + (238) APINO2 (C10H17O3) + (239) APINO2VBS (C10H17O3) + (240) BCARYNO3 (C15H24NO5) + (241) BCARYO2 (C15H25O3) + (242) BCARYO2VBS (C15H25O3) + (243) BENZO2 (C6H7O5) + (244) BENZO2VBS (C6H7O5) + (245) BPINNO3 (C10H16NO5) + (246) BPINO2 (C10H17O3) + (247) BPINO2VBS (C10H17O3) + (248) BZOO (C7H7O2) + (249) C2H5O2 + (250) C3H7O2 + (251) C6H5O2 + (252) CH3CO3 + (253) CH3O2 + (254) DICARBO2 (C5H5O4) + (255) ENEO2 (C4H9O3) + (256) EO (HOCH2CH2O) + (257) EO2 (HOCH2CH2O2) + (258) HO2 + (259) HOCH2OO + (260) IEPOXOO (C5H9O5) + (261) ISOPB1O2 (C5H9O3) + (262) ISOPB4O2 (C5H9O3) + (263) ISOPC1C (C5H9O) + (264) ISOPC1T (C5H9O) + (265) ISOPC4C (C5H9O) + (266) ISOPC4T (C5H9O) + (267) ISOPED1O2 (C5H9O3) + (268) ISOPED4O2 (C5H9O3) + (269) ISOPN1DO2 (C5H10NO7) + (270) ISOPN2BO2 (C5H10NO7) + (271) ISOPN3BO2 (C5H10NO7) + (272) ISOPN4DO2 (C5H10NO7) + (273) ISOPNBNO3O2 (C5H10NO7) + (274) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + (275) ISOPNOOHBO2 (C5H10NO8) + (276) ISOPNOOHDO2 (C5H10NO8) + (277) ISOPO2VBS (C5H9O3) + (278) ISOPZD1O2 (C5H9O3) + (279) ISOPZD4O2 (C5H9O3) + (280) IVOCO2VBS (C13H29O3) + (281) LIMONNO3 (C10H16NO5) + (282) LIMONO2 (C10H17O3) + (283) LIMONO2VBS (C10H17O3) + (284) MACRO2 (CH3COCHO2CH2OH) + (285) MALO2 (C4H3O4) + (286) MCO3 (CH2CCH3CO3) + (287) MDIALO2 (C4H5O4) + (288) MEKO2 (C4H7O3) + (289) MVKO2 (C4O4H7) + (290) MYRCNO3 (C10H16NO5) + (291) MYRCO2 (C10H17O3) + (292) MYRCO2VBS (C10H17O3) + (293) NC4CHOO2 (C5H8NO7) + (294) O1D (O) + (295) OH + (296) PHENO2 (C6H7O6) + (297) PO2 (C3H6OHO2) + (298) RO2 (CH3COCH2O2) + (299) TERP1OOHO2 (C10H19O6) + (300) TERP2OOHO2 (C10H19O6) + (301) TERPA1O2 (C9H15O3) + (302) TERPA2CO3 (C9H13O4) + (303) TERPA2O2 (C9H15O4) + (304) TERPA3CO3 (C9H13O5) + (305) TERPA3O2 (C9H15O5) + (306) TERPA4O2 (C6H9O5) + (307) TERPACO3 (C10H15O4) + (308) TERPF1O2 (C10H17O5) + (309) TERPF2O2 (C7H11O4) + (310) TERPNPS1O2 (C10H18NO8) + (311) TERPNPT1O2 (C10H18NO8) + (312) TERPNS1O2 (C10H18NO7) + (313) TERPNT1O2 (C10H18NO7) + (314) TOLO2 (C7H9O5) + (315) TOLUO2VBS (C7H9O5) + (316) XYLENO2 (C8H11O5) + (317) XYLEO2VBS (C8H11O5) + (318) XYLOLO2 (C8H11O6) + (319) 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) ALKNIT + ( 2) ALKOOH + ( 3) AOA_NH + ( 4) APIN + ( 5) bc_a1 + ( 6) bc_a4 + ( 7) BCARY + ( 8) BENZENE + ( 9) BENZOOH + ( 10) BEPOMUC + ( 11) BIGALD1 + ( 12) BIGALD2 + ( 13) BIGALD3 + ( 14) BIGALD4 + ( 15) BIGALK + ( 16) BIGENE + ( 17) BPIN + ( 18) BR + ( 19) BRCL + ( 20) BRO + ( 21) BRONO2 + ( 22) BRY + ( 23) BZALD + ( 24) BZOOH + ( 25) C2H2 + ( 26) C2H4 + ( 27) C2H5OH + ( 28) C2H5OOH + ( 29) C2H6 + ( 30) C3H6 + ( 31) C3H7OOH + ( 32) C3H8 + ( 33) C6H5OOH + ( 34) CCL4 + ( 35) CF2CLBR + ( 36) CF3BR + ( 37) CFC11 + ( 38) CFC113 + ( 39) CFC114 + ( 40) CFC115 + ( 41) CFC12 + ( 42) CH2BR2 + ( 43) CH2O + ( 44) CH3BR + ( 45) CH3CCL3 + ( 46) CH3CHO + ( 47) CH3CL + ( 48) CH3CN + ( 49) CH3COCH3 + ( 50) CH3COCHO + ( 51) CH3COOH + ( 52) CH3COOOH + ( 53) CH3OH + ( 54) CH3OOH + ( 55) CH4 + ( 56) CHBR3 + ( 57) CL + ( 58) CL2 + ( 59) CL2O2 + ( 60) CLO + ( 61) CLONO2 + ( 62) CLY + ( 63) CO + ( 64) CO2 + ( 65) COF2 + ( 66) COFCL + ( 67) CRESOL + ( 68) DHPMPAL + ( 69) DMS + ( 70) dst_a1 + ( 71) dst_a2 + ( 72) dst_a3 + ( 73) E90 + ( 74) EOOH + ( 75) F + ( 76) GLYALD + ( 77) GLYOXAL + ( 78) H + ( 79) H2 + ( 80) H2402 + ( 81) H2O2 + ( 82) H2SO4 + ( 83) HBR + ( 84) HCFC141B + ( 85) HCFC142B + ( 86) HCFC22 + ( 87) HCL + ( 88) HCN + ( 89) HCOCH2OOH + ( 90) HCOOH + ( 91) HF + ( 92) HMHP + ( 93) HNO3 + ( 94) HO2NO2 + ( 95) HOBR + ( 96) HOCL + ( 97) HONITR + ( 98) HPALD1 + ( 99) HPALD4 + (100) HPALDB1C + (101) HPALDB4C + (102) HYAC + (103) HYDRALD + (104) HYPERACET + (105) ICHE + (106) IEPOX + (107) INHEB + (108) INHED + (109) ISOP + (110) ISOPFDN + (111) ISOPFDNC + (112) ISOPFNC + (113) ISOPFNP + (114) ISOPHFP + (115) ISOPN1D + (116) ISOPN2B + (117) ISOPN3B + (118) ISOPN4D + (119) ISOPNBNO3 + (120) ISOPNOOHB + (121) ISOPNOOHD + (122) ISOPOH + (123) ISOPOOH + (124) IVOC + (125) LIMON + (126) MACR + (127) MACRN + (128) MACROOH + (129) MEK + (130) MEKOOH + (131) MPAN + (132) MVK + (133) MVKN + (134) MVKOOH + (135) MYRC + (136) N + (137) N2O + (138) N2O5 + (139) NC4CHO + (140) ncl_a1 + (141) ncl_a2 + (142) ncl_a3 + (143) NH3 + (144) NH4 + (145) NH_5 + (146) NH_50 + (147) NO + (148) NO2 + (149) NO3 + (150) NO3CH2CHO + (151) NOA + (152) num_a1 + (153) num_a2 + (154) num_a3 + (155) num_a4 + (156) num_a5 + (157) O + (158) O3 + (159) O3S + (160) OCLO + (161) OCS + (162) ONITR + (163) PAN + (164) PBZNIT + (165) PHENO + (166) PHENOL + (167) PHENOOH + (168) pom_a1 + (169) pom_a4 + (170) POOH + (171) ROOH + (172) S + (173) SF6 + (174) SO + (175) SO2 + (176) SO3 + (177) so4_a1 + (178) so4_a2 + (179) so4_a3 + (180) so4_a5 + (181) soa1_a1 + (182) soa1_a2 + (183) soa2_a1 + (184) soa2_a2 + (185) soa3_a1 + (186) soa3_a2 + (187) soa4_a1 + (188) soa4_a2 + (189) soa5_a1 + (190) soa5_a2 + (191) SOAG0 + (192) SOAG1 + (193) SOAG2 + (194) SOAG3 + (195) SOAG4 + (196) SQTN + (197) ST80_25 + (198) SVOC + (199) TEPOMUC + (200) TERP1OOH + (201) TERP2AOOH + (202) TERPA + (203) TERPA2 + (204) TERPA2PAN + (205) TERPA3 + (206) TERPA3PAN + (207) TERPACID + (208) TERPACID2 + (209) TERPACID3 + (210) TERPAPAN + (211) TERPDHDP + (212) TERPF1 + (213) TERPF2 + (214) TERPFDN + (215) TERPHFN + (216) TERPK + (217) TERPNPS + (218) TERPNPS1 + (219) TERPNPT + (220) TERPNPT1 + (221) TERPNS + (222) TERPNS1 + (223) TERPNT + (224) TERPNT1 + (225) TERPOOH + (226) TERPOOHL + (227) TOLOOH + (228) TOLUENE + (229) XYLENES + (230) XYLENOOH + (231) XYLOL + (232) XYLOLOOH + (233) ACBZO2 + (234) ALKO2 + (235) APINNO3 + (236) APINO2 + (237) APINO2VBS + (238) BCARYNO3 + (239) BCARYO2 + (240) BCARYO2VBS + (241) BENZO2 + (242) BENZO2VBS + (243) BPINNO3 + (244) BPINO2 + (245) BPINO2VBS + (246) BZOO + (247) C2H5O2 + (248) C3H7O2 + (249) C6H5O2 + (250) CH3CO3 + (251) CH3O2 + (252) DICARBO2 + (253) ENEO2 + (254) EO + (255) EO2 + (256) HO2 + (257) HOCH2OO + (258) IEPOXOO + (259) ISOPB1O2 + (260) ISOPB4O2 + (261) ISOPC1C + (262) ISOPC1T + (263) ISOPC4C + (264) ISOPC4T + (265) ISOPED1O2 + (266) ISOPED4O2 + (267) ISOPN1DO2 + (268) ISOPN2BO2 + (269) ISOPN3BO2 + (270) ISOPN4DO2 + (271) ISOPNBNO3O2 + (272) ISOPNO3 + (273) ISOPNOOHBO2 + (274) ISOPNOOHDO2 + (275) ISOPO2VBS + (276) ISOPZD1O2 + (277) ISOPZD4O2 + (278) IVOCO2VBS + (279) LIMONNO3 + (280) LIMONO2 + (281) LIMONO2VBS + (282) MACRO2 + (283) MALO2 + (284) MCO3 + (285) MDIALO2 + (286) MEKO2 + (287) MVKO2 + (288) MYRCNO3 + (289) MYRCO2 + (290) MYRCO2VBS + (291) NC4CHOO2 + (292) O1D + (293) OH + (294) PHENO2 + (295) PO2 + (296) RO2 + (297) TERP1OOHO2 + (298) TERP2OOHO2 + (299) TERPA1O2 + (300) TERPA2CO3 + (301) TERPA2O2 + (302) TERPA3CO3 + (303) TERPA3O2 + (304) TERPA4O2 + (305) TERPACO3 + (306) TERPF1O2 + (307) TERPF2O2 + (308) TERPNPS1O2 + (309) TERPNPT1O2 + (310) TERPNS1O2 + (311) TERPNT1O2 + (312) TOLO2 + (313) TOLUO2VBS + (314) XYLENO2 + (315) XYLEO2VBS + (316) XYLOLO2 + (317) 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) + jalknit ( 19) ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 rate = ** User defined ** ( 19) + + 0.8*MEK + jalkooh ( 20) ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 rate = ** User defined ** ( 20) + + 0.8*MEK + OH + jbenzooh ( 21) BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 rate = ** User defined ** ( 21) + jbepomuc ( 22) BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO rate = ** User defined ** ( 22) + jbigald1 ( 23) BIGALD1 + hv -> 0.6*MALO2 + HO2 rate = ** User defined ** ( 23) + jbigald2 ( 24) BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 rate = ** User defined ** ( 24) + jbigald3 ( 25) BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 rate = ** User defined ** ( 25) + jbigald4 ( 26) BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 rate = ** User defined ** ( 26) + jbzooh ( 27) BZOOH + hv -> BZALD + OH + HO2 rate = ** User defined ** ( 27) + jc2h5ooh ( 28) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 28) + jc3h7ooh ( 29) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 29) + jc6h5ooh ( 30) C6H5OOH + hv -> PHENO + OH rate = ** User defined ** ( 30) + jch2o_a ( 31) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 31) + jch2o_b ( 32) CH2O + hv -> CO + H2 rate = ** User defined ** ( 32) + jch3cho ( 33) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 33) + jacet ( 34) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 34) + jmgly ( 35) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 35) + jch3co3h ( 36) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 36) + jch3ooh ( 37) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 37) + jch4_a ( 38) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 38) + jch4_b ( 39) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 39) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jco2 ( 40) CO2 + hv -> CO + O rate = ** User defined ** ( 40) + jdhpmpal ( 41) DHPMPAL + hv -> 0.5*CH3COCHO + 1.5*OH + 0.5*CH2O + 0.5*HYPERACET rate = ** User defined ** ( 41) + + 0.5*HO2 + 0.5*CO + jeooh ( 42) EOOH + hv -> EO + OH rate = ** User defined ** ( 42) + jglyald ( 43) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 43) + jglyoxal ( 44) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 44) + jhcoch2ooh ( 45) HCOCH2OOH + hv -> CH2O + HO2 + CO + OH rate = ** User defined ** ( 45) + jhmhp ( 46) HMHP + hv -> 2*OH + CH2O rate = ** User defined ** ( 46) + jhonitr ( 47) HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO rate = ** User defined ** ( 47) + + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + + 0.17*CH3COCH3 + jhpald1 ( 48) HPALD1 + hv -> 0.62*HO2 + 1.32*CO + 0.68*CH3COCHO + 0.17*CO2 rate = ** User defined ** ( 48) + + 0.04*CH3O2 + 0.05*CH3CO3 + 1.11*OH + 0.23*MVKO2 + + 0.41*HCOOH + jhpald4 ( 49) HPALD4 + hv -> 0.56*HO2 + 1.74*CO + 0.67*CH3COCHO + 0.28*CO2 rate = ** User defined ** ( 49) + + 0.07*CH3O2 + 0.07*CH3CO3 + 1.18*OH + 0.19*MACRO2 + jhpaldb1c ( 50) HPALDB1C + hv -> OH + MVK + CO + HO2 rate = ** User defined ** ( 50) + jhpaldb4c ( 51) HPALDB4C + hv -> OH + HO2 + CO + MACR rate = ** User defined ** ( 51) + jhyac ( 52) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 52) + jhydrald_b ( 53) HYDRALD + hv -> 1.5*HO2 + 1.5*CO + 0.5*HYAC + 0.5*CH3CO3 rate = ** User defined ** ( 53) + + 0.5*GLYALD + jhydrald_a ( 54) HYDRALD + hv -> 3*OH + HO2 + CO + CO2 + CH3COCHO rate = ** User defined ** ( 54) + jhyperacet_c ( 55) HYPERACET + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 55) + jhyperacet_p ( 56) HYPERACET + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 56) + jinheb ( 57) INHEB + hv -> NO2 + ICHE + HO2 rate = ** User defined ** ( 57) + jinhed ( 58) INHED + hv -> NO2 + ICHE + HO2 rate = ** User defined ** ( 58) + jisopfdn ( 59) ISOPFDN + hv -> HYAC + 2*NO2 + GLYALD rate = ** User defined ** ( 59) + jisopfdnc ( 60) ISOPFDNC + hv -> 2*NO2 + 0.5*CH3COCHO + 0.5*GLYALD + 0.5*HYAC rate = ** User defined ** ( 60) + + 0.5*GLYOXAL + jisopfnc ( 61) ISOPFNC + hv -> OH + NO2 + 0.5*GLYALD + 0.5*CH3COCHO + 0.5*HYAC rate = ** User defined ** ( 61) + + 0.5*GLYOXAL + jisopfnp ( 62) ISOPFNP + hv -> OH + NO2 + GLYALD + HYAC rate = ** User defined ** ( 62) + jisophfp ( 63) ISOPHFP + hv -> OH + HO2 + 0.72*CH3COCHO + 0.72*GLYALD rate = ** User defined ** ( 63) + + 0.28*GLYOXAL + 0.28*HYAC + jisopn1d ( 64) ISOPN1D + hv -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MACROOH rate = ** User defined ** ( 64) + + 0.55*CO + 0.55*OH + jisopn2b ( 65) ISOPN2B + hv -> NO2 + MVK + CH2O + HO2 rate = ** User defined ** ( 65) + jisopn3b ( 66) ISOPN3B + hv -> NO2 + MACR + CH2O + HO2 rate = ** User defined ** ( 66) + jisopn4d ( 67) ISOPN4D + hv -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MVKOOH rate = ** User defined ** ( 67) + + 0.55*CO + 0.55*OH + jisopnbno3 ( 68) ISOPNBNO3 + hv -> NO2 + HO2 + CH2O + 0.5*MVK + 0.5*MACR rate = ** User defined ** ( 68) + jisopnoohb ( 69) ISOPNOOHB + hv -> OH + CH2O + NO2 + 0.88*MVK + 0.12*MACR rate = ** User defined ** ( 69) + jisopnoohd ( 70) ISOPNOOHD + hv -> OH + HO2 + NC4CHO rate = ** User defined ** ( 70) + jisopooh ( 71) ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + CH2O + HO2 rate = ** User defined ** ( 71) + jmacr_b ( 72) MACR + hv -> HO2 + CO + CH2O + 0.35*CH3CO3 + 0.65*CH3O2 + 0.65*CO rate = ** User defined ** ( 72) + jmacr_a ( 73) MACR + hv -> HO2 + MCO3 rate = ** User defined ** ( 73) + jmacrn ( 74) MACRN + hv -> 0.75*CO + 0.75*NO2 + 0.5*HYAC + 1.25*HO2 rate = ** User defined ** ( 74) + + 0.25*CH3COCHO + 0.25*CH2O + 0.25*NOA + jmacrooh ( 75) MACROOH + hv -> OH + HO2 + 0.86*HYAC + 0.86*CO + 0.14*CH2O rate = ** User defined ** ( 75) + + 0.14*CH3COCHO + jmek ( 76) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 76) + jmekooh ( 77) MEKOOH + hv -> OH + CH3CO3 + CH3CHO rate = ** User defined ** ( 77) + jmpan ( 78) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 78) + jmvk ( 79) MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 rate = ** User defined ** ( 79) + jmvkn ( 80) MVKN + hv -> 0.75*NO2 + 0.25*NO3CH2CHO + 0.75*CH3CO3 + 0.5*GLYALD rate = ** User defined ** ( 80) + + 0.5*HO2 + 0.25*CH2O + 0.25*CH3COCHO + jmvkooh ( 81) MVKOOH + hv -> OH + 0.56*GLYALD + 0.56*CH3CO3 + 0.44*CH2O rate = ** User defined ** ( 81) + + 0.44*HO2 + 0.44*CH3COCHO + jnc4cho ( 82) NC4CHO + hv -> NO2 + HO2 + HYDRALD rate = ** User defined ** ( 82) + jno3ch2cho ( 83) NO3CH2CHO + hv -> NO2 + CH2O + CO + HO2 rate = ** User defined ** ( 83) + jnoa ( 84) NOA + hv -> NO2 + CH2O + CH3CO3 rate = ** User defined ** ( 84) + jonitr ( 85) ONITR + hv -> NO2 rate = ** User defined ** ( 85) + jpan ( 86) PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 rate = ** User defined ** ( 86) + jphenooh ( 87) PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL rate = ** User defined ** ( 87) + jpooh ( 88) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 88) + jrooh ( 89) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 89) + jtepomuc ( 90) TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO rate = ** User defined ** ( 90) + jterp1ooh ( 91) TERP1OOH + hv -> OH + TERPF1 + HO2 rate = ** User defined ** ( 91) + jterp2aooh ( 92) TERP2AOOH + hv -> OH + TERPF2 + HO2 rate = ** User defined ** ( 92) + jterpa ( 93) TERPA + hv -> CO + HO2 + TERPA1O2 rate = ** User defined ** ( 93) + jterpa2 ( 94) TERPA2 + hv -> CO + HO2 + TERPA2O2 rate = ** User defined ** ( 94) + jterpa2pan ( 95) TERPA2PAN + hv -> TERPA2CO3 + NO2 rate = ** User defined ** ( 95) + jterpa3 ( 96) TERPA3 + hv -> CO + HO2 + TERPA4O2 rate = ** User defined ** ( 96) + jterpa3pan ( 97) TERPA3PAN + hv -> TERPA3CO3 + NO2 rate = ** User defined ** ( 97) + jterpacid ( 98) TERPACID + hv -> OH + CO2 + TERPA1O2 rate = ** User defined ** ( 98) + jterpacid2 ( 99) TERPACID2 + hv -> OH + CO2 + TERPA2O2 rate = ** User defined ** ( 99) + jterpacid3 (100) TERPACID3 + hv -> OH + CO2 + TERPA4O2 rate = ** User defined ** (100) + jterpapan (101) TERPAPAN + hv -> TERPACO3 + NO2 rate = ** User defined ** (101) + jterpdhdp (102) TERPDHDP + hv -> TERPOOH + OH + HO2 rate = ** User defined ** (102) + jterpfdn (103) TERPFDN + hv -> TERPNS + HO2 + NO2 rate = ** User defined ** (103) + jterphfn (104) TERPHFN + hv -> TERPNS + OH + HO2 rate = ** User defined ** (104) + jterpnps (105) TERPNPS + hv -> OH + 0.5*TERPNS + 0.5*HO2 + 0.5*TERPA + 0.5*NO2 rate = ** User defined ** (105) + jterpnps1 (106) TERPNPS1 + hv -> OH + 0.54*TERPNS1 + 0.54*HO2 + 0.46*TERPF1 rate = ** User defined ** (106) + + 0.46*NO2 + jterpnpt (107) TERPNPT + hv -> TERPA + NO2 + OH rate = ** User defined ** (107) + jterpnpt1 (108) TERPNPT1 + hv -> OH + 0.54*TERPNT1 + 0.54*HO2 + 0.46*TERPF1 rate = ** User defined ** (108) + + 0.46*NO2 + jterpns (109) TERPNS + hv -> NO2 + HO2 + TERPA rate = ** User defined ** (109) + jterpns1 (110) TERPNS1 + hv -> NO2 + HO2 + TERPF1 rate = ** User defined ** (110) + jterpnt (111) TERPNT + hv -> NO2 + HO2 + TERPA rate = ** User defined ** (111) + jterpnt1 (112) TERPNT1 + hv -> NO2 + HO2 + TERPF1 rate = ** User defined ** (112) + jterpooh (113) TERPOOH + hv -> OH + TERPA + HO2 rate = ** User defined ** (113) + jterpoohl (114) TERPOOHL + hv -> OH + TERPA3 + HO2 rate = ** User defined ** (114) + jtolooh (115) TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = ** User defined ** (115) + + 0.2*BIGALD2 + 0.2*BIGALD3 + jxylenooh (116) XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = ** User defined ** (116) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + jxylolooh (117) XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 rate = ** User defined ** (117) + jbrcl (118) BRCL + hv -> BR + CL rate = ** User defined ** (118) + jbro (119) BRO + hv -> BR + O rate = ** User defined ** (119) + jbrono2_b (120) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** (120) + jbrono2_a (121) BRONO2 + hv -> BR + NO3 rate = ** User defined ** (121) + jccl4 (122) CCL4 + hv -> 4*CL rate = ** User defined ** (122) + jcf2clbr (123) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** (123) + jcf3br (124) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** (124) + jcfcl3 (125) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** (125) + jcfc113 (126) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** (126) + jcfc114 (127) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** (127) + jcfc115 (128) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** (128) + jcf2cl2 (129) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** (129) + jch2br2 (130) CH2BR2 + hv -> 2*BR rate = ** User defined ** (130) + jch3br (131) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** (131) + jch3ccl3 (132) CH3CCL3 + hv -> 3*CL rate = ** User defined ** (132) + jch3cl (133) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** (133) + jchbr3 (134) CHBR3 + hv -> 3*BR rate = ** User defined ** (134) + jcl2 (135) CL2 + hv -> 2*CL rate = ** User defined ** (135) + jcl2o2 (136) CL2O2 + hv -> 2*CL rate = ** User defined ** (136) + jclo (137) CLO + hv -> CL + O rate = ** User defined ** (137) + jclono2_a (138) CLONO2 + hv -> CL + NO3 rate = ** User defined ** (138) + jclono2_b (139) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** (139) + jcof2 (140) COF2 + hv -> 2*F rate = ** User defined ** (140) + jcofcl (141) COFCL + hv -> F + CL rate = ** User defined ** (141) + jh2402 (142) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** (142) + jhbr (143) HBR + hv -> BR + H rate = ** User defined ** (143) + jhcfc141b (144) HCFC141B + hv -> CL + COFCL rate = ** User defined ** (144) + jhcfc142b (145) HCFC142B + hv -> CL + COF2 rate = ** User defined ** (145) + jhcfc22 (146) HCFC22 + hv -> CL + COF2 rate = ** User defined ** (146) + jhcl (147) HCL + hv -> H + CL rate = ** User defined ** (147) + jhf (148) HF + hv -> H + F rate = ** User defined ** (148) + jhobr (149) HOBR + hv -> BR + OH rate = ** User defined ** (149) + jhocl (150) HOCL + hv -> OH + CL rate = ** User defined ** (150) + joclo (151) OCLO + hv -> O + CLO rate = ** User defined ** (151) + jsf6 (152) SF6 + hv -> {sink} rate = ** User defined ** (152) + jh2so4 (153) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** (153) + jocs (154) OCS + hv -> S + CO rate = ** User defined ** (154) + jso (155) SO + hv -> S + O rate = ** User defined ** (155) + jso2 (156) SO2 + hv -> SO + O rate = ** User defined ** (156) + jso3 (157) SO3 + hv -> SO2 + O rate = ** User defined ** (157) + jsoa1_a1 (158) soa1_a1 + hv -> (No products) rate = ** User defined ** (158) + jsoa1_a2 (159) soa1_a2 + hv -> (No products) rate = ** User defined ** (159) + jsoa2_a1 (160) soa2_a1 + hv -> (No products) rate = ** User defined ** (160) + jsoa2_a2 (161) soa2_a2 + hv -> (No products) rate = ** User defined ** (161) + jsoa3_a1 (162) soa3_a1 + hv -> (No products) rate = ** User defined ** (162) + jsoa3_a2 (163) soa3_a2 + hv -> (No products) rate = ** User defined ** (163) + jsoa4_a1 (164) soa4_a1 + hv -> (No products) rate = ** User defined ** (164) + jsoa4_a2 (165) soa4_a2 + hv -> (No products) rate = ** User defined ** (165) + jsoa5_a1 (166) soa5_a1 + hv -> (No products) rate = ** User defined ** (166) + jsoa5_a2 (167) soa5_a2 + hv -> (No products) rate = ** User defined ** (167) + + Reactions + O1D_H2 ( 1) O1D + H2 -> H + OH rate = 1.20E-10 (168) + O1D_H2O ( 2) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (169) + O1D_N2 ( 3) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (170) + O1D_O2ab ( 4) O1D + O2 -> O + O2 rate = 3.30E-11*exp( 55./t) (171) + O1D_O3 ( 5) O1D + O3 -> O2 + O2 rate = 1.20E-10 (172) + O_O3 ( 6) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (173) + usr_O_O ( 7) O + O + M -> O2 + M rate = ** User defined ** (174) + usr_O_O2 ( 8) O + O2 + M -> O3 + M rate = ** User defined ** (175) + H2_O ( 9) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (176) + H2O2_O ( 10) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (177) + H_HO2 ( 11) H + HO2 -> H2 + O2 rate = 6.90E-12 (178) + H_HO2a ( 12) H + HO2 -> 2*OH rate = 7.20E-11 (179) + H_HO2b ( 13) H + HO2 -> H2O + O rate = 1.60E-12 (180) + H_O2 ( 14) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (181) + ki=9.50E-11*(300/t)**-0.40 + f=0.60 + HO2_O ( 15) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (182) + HO2_O3 ( 16) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (183) + H_O3 ( 17) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (184) + OH_H2 ( 18) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (185) + OH_H2O2 ( 19) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (186) + OH_HO2 ( 20) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (187) + OH_O ( 21) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (188) + OH_O3 ( 22) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (189) + OH_OH ( 23) OH + OH -> H2O + O rate = 1.80E-12 (190) + OH_OH_M ( 24) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (191) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 ( 25) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (192) + HO2NO2_OH ( 26) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (193) + N_NO ( 27) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (194) + N_NO2a ( 28) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (195) + N_NO2b ( 29) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (196) + N_NO2c ( 30) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (197) + N_O2 ( 31) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (198) + NO2_O ( 32) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (199) + NO2_O3 ( 33) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (200) + NO2_O_M ( 34) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (201) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 ( 35) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (202) + NO3_NO ( 36) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (203) + NO3_O ( 37) NO3 + O -> NO2 + O2 rate = 1.30E-11 (204) + NO3_OH ( 38) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (205) + N_OH ( 39) N + OH -> NO + H rate = 5.00E-11 (206) + NO_HO2 ( 40) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (207) + NO_O3 ( 41) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (208) + NO_O_M ( 42) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (209) + ki=3.00E-11 + f=0.60 + O1D_N2Oa ( 43) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (210) + O1D_N2Ob ( 44) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (211) + tag_NO2_HO2 ( 45) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (212) + ki=4.00E-12*(300/t)**0.30 + f=0.60 + tag_NO2_NO3 ( 46) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (213) + ki=1.60E-12*(300/t)**-0.10 + f=0.60 + tag_NO2_OH ( 47) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (214) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 48) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (215) + usr_HO2NO2_M ( 49) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (216) + usr_N2O5_M ( 50) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (217) + CL_CH2O ( 51) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (218) + CL_CH4 ( 52) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (219) + CL_H2 ( 53) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (220) + CL_H2O2 ( 54) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (221) + CL_HO2a ( 55) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (222) + CL_HO2b ( 56) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (223) + CL_O3 ( 57) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (224) + CLO_CH3O2 ( 58) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (225) + CLO_CLOa ( 59) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (226) + CLO_CLOb ( 60) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (227) + CLO_CLOc ( 61) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (228) + CLO_HO2 ( 62) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (229) + CLO_NO ( 63) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (230) + CLONO2_CL ( 64) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (231) + CLO_NO2_M ( 65) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (232) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLONO2_O ( 66) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (233) + CLONO2_OH ( 67) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (234) + CLO_O ( 68) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (235) + CLO_OHa ( 69) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (236) + CLO_OHb ( 70) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (237) + HCL_O ( 71) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (238) + HCL_OH ( 72) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (239) + HOCL_CL ( 73) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (240) + HOCL_O ( 74) HOCL + O -> CLO + OH rate = 1.70E-13 (241) + HOCL_OH ( 75) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (242) + O1D_CCL4 ( 76) O1D + CCL4 -> 4*CL rate = 2.61E-10 (243) + O1D_CF2CLBR ( 77) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (244) + O1D_CFC11 ( 78) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (245) + O1D_CFC113 ( 79) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (246) + O1D_CFC114 ( 80) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (247) + O1D_CFC115 ( 81) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (248) + O1D_CFC12 ( 82) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (249) + O1D_HCLa ( 83) O1D + HCL -> CL + OH rate = 9.90E-11 (250) + O1D_HCLb ( 84) O1D + HCL -> CLO + H rate = 3.30E-12 (251) + tag_CLO_CLO_M ( 85) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (252) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M ( 86) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (253) + BR_CH2O ( 87) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (254) + BR_HO2 ( 88) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (255) + BR_O3 ( 89) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (256) + BRO_BRO ( 90) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (257) + BRO_CLOa ( 91) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (258) + BRO_CLOb ( 92) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (259) + BRO_CLOc ( 93) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (260) + BRO_HO2 ( 94) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (261) + BRO_NO ( 95) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (262) + BRO_NO2_M ( 96) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (263) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRONO2_O ( 97) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (264) + BRO_O ( 98) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (265) + BRO_OH ( 99) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (266) + HBR_O (100) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (267) + HBR_OH (101) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (268) + HOBR_O (102) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (269) + O1D_CF3BR (103) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (270) + O1D_CHBR3 (104) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (271) + O1D_H2402 (105) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (272) + O1D_HBRa (106) O1D + HBR -> BR + OH rate = 9.00E-11 (273) + O1D_HBRb (107) O1D + HBR -> BRO + H rate = 3.00E-11 (274) + F_CH4 (108) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (275) + F_H2 (109) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (276) + F_H2O (110) F + H2O -> HF + OH rate = 1.40E-11 (277) + F_HNO3 (111) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (278) + O1D_COF2 (112) O1D + COF2 -> 2*F rate = 2.14E-11 (279) + O1D_COFCL (113) O1D + COFCL -> F + CL rate = 1.90E-10 (280) + CH2BR2_CL (114) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (281) + CH2BR2_OH (115) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (282) + CH3BR_CL (116) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (283) + CH3BR_OH (117) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (284) + CH3CCL3_OH (118) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (285) + CH3CL_CL (119) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (286) + CH3CL_OH (120) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (287) + CHBR3_CL (121) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (288) + CHBR3_OH (122) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (289) + HCFC141B_OH (123) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (290) + HCFC142B_OH (124) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (291) + HCFC22_OH (125) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (292) + O1D_CH2BR2 (126) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (293) + O1D_CH3BR (127) O1D + CH3BR -> BR rate = 1.80E-10 (294) + O1D_HCFC141B (128) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (295) + O1D_HCFC142B (129) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (296) + O1D_HCFC22 (130) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (297) + CH2O_HO2 (131) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) (298) + CH2O_NO3 (132) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (299) + CH2O_O (133) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (300) + CH2O_OH (134) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (301) + CH3O2_CH3O2a (135) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (302) + CH3O2_CH3O2b (136) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (303) + CH3O2_HO2 (137) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (304) + CH3O2_NO (138) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (305) + CH3OH_OH (139) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (306) + CH3OOH_OH (140) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (307) + CH4_OH (141) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (308) + HCN_OH (142) HCN + OH + M -> HO2 + M troe : ko=6.10E-33*(300/t)**1.50 (309) + ki=9.80E-15*(300/t)**-4.60 + f=0.80 + HCOOH_OH (143) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (310) + HMHP_OH (144) HMHP + OH -> 0.5*CH2O + 0.5*HO2 + 0.5*HCOOH + 0.5*OH + H2O rate = 1.30E-12*exp( 500./t) (311) + HOCH2OO_HO2 (145) HOCH2OO + HO2 -> 0.5*HMHP + 0.5*HCOOH + 0.3*H2O + 0.2*HO2 + 0.2*OH rate = 5.60E-15*exp( 2300./t) (312) + HOCH2OO_M (146) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (313) + HOCH2OO_NO (147) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (314) + O1D_CH4a (148) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (315) + O1D_CH4b (149) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (316) + O1D_CH4c (150) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (317) + O1D_HCN (151) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (318) + usr_CO_OH (152) CO + OH -> CO2 + HO2 rate = ** User defined ** (319) + C2H2_CL_M (153) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (320) + ki=2.20E-10*(300/t)**0.70 + f=0.60 + C2H2_OH_M (154) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (321) + + 0.35*CO + M ki=8.30E-13*(300/t)**-2.00 + f=0.60 + C2H4_CL_M (155) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (322) + ki=3.10E-10*(300/t) + f=0.60 + C2H4_O3 (156) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (323) + C2H5O2_C2H5O2 (157) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (324) + C2H5O2_CH3O2 (158) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (325) + + 0.2*C2H5OH + C2H5O2_HO2 (159) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (326) + C2H5O2_NO (160) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (327) + C2H5OH_OH (161) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (328) + C2H5OOH_OH (162) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (329) + C2H6_CL (163) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (330) + C2H6_OH (164) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (331) + CH3CHO_NO3 (165) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (332) + CH3CHO_OH (166) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (333) + CH3CN_OH (167) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (334) + CH3CO3_CH3CO3 (168) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (335) + CH3CO3_CH3O2 (169) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (336) + + 0.1*CH3COOH + CH3CO3_HO2 (170) CH3CO3 + HO2 -> 0.36*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.49*OH rate = 4.30E-13*exp( 1040./t) (337) + + 0.49*CH3O2 + 0.49*CO2 + CH3CO3_NO (171) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (338) + CH3COOH_OH (172) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 3.15E-14*exp( 920./t) (339) + CH3COOOH_OH (173) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (340) + EO2_HO2 (174) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (341) + EO2_NO (175) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (342) + EO_M (176) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (343) + EO_O2 (177) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (344) + GLYALD_OH (178) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (345) + GLYOXAL_OH (179) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (346) + HCOCH2OOH_OH (180) HCOCH2OOH + OH -> 0.89*GLYOXAL + 0.89*OH + 0.11*CH2O + 0.11*HO2 rate = 3.30E-11 (347) + + 0.11*CO + NO3CH2CHO_OH (181) NO3CH2CHO + OH -> CO2 + CH2O + NO2 rate = 3.40E-12 (348) + PAN_OH (182) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (349) + tag_C2H4_OH (183) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (350) + ki=9.00E-12*(300/t)**0.85 + f=0.48 + tag_CH3CO3_NO2 (184) CH3CO3 + NO2 + M -> PAN + M troe : ko=7.30E-29*(300/t)**4.10 (351) + ki=9.50E-12*(300/t)**1.60 + f=0.60 + usr_PAN_M (185) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (352) + C3H6_NO3 (186) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (353) + C3H6_O3 (187) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (354) + + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + + 0.36*OH + C3H7O2_CH3O2 (188) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (355) + C3H7O2_HO2 (189) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (356) + C3H7O2_NO (190) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (357) + C3H7OOH_OH (191) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (358) + C3H8_OH (192) C3H8 + OH -> C3H7O2 + H2O rate = 9.19E-12*exp( -630./t) (359) + CH3COCHO_NO3 (193) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (360) + CH3COCHO_OH (194) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (361) + HYAC_OH (195) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (362) + HYPERACET_OH (196) HYPERACET + OH -> 0.3*CH3CO3 + 0.3*CH2O + 0.7*CH3COCHO + 0.7*OH rate = 1.20E-11 (363) + NOA_OH (197) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (364) + PO2_HO2 (198) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (365) + PO2_NO (199) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (366) + POOH_OH (200) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (367) + RO2_CH3O2 (201) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (368) + + 0.5*CH3COCHO + 0.5*CH3OH + RO2_HO2 (202) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (369) + RO2_NO (203) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (370) + ROOH_OH (204) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (371) + tag_C3H6_OH (205) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (372) + ki=3.00E-11 + f=0.50 + usr_CH3COCH3_OH (206) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (373) + BIGENE_NO3 (207) BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 rate = 3.50E-13 (374) + BIGENE_OH (208) BIGENE + OH -> ENEO2 rate = 5.40E-11 (375) + DHPMPAL_OH (209) DHPMPAL + OH -> HYPERACET + CO + OH rate = 3.77E-11 (376) + ENEO2_NO (210) ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 rate = 4.80E-12*exp( 120./t) (377) + ENEO2_NOb (211) ENEO2 + NO -> HONITR rate = 5.10E-14*exp( 693./t) (378) + HONITR_OH (212) HONITR + OH -> ONITR + HO2 rate = 2.00E-12 (379) + MACRN_OH (213) MACRN + OH -> CO + 0.5*HO2 + 0.5*NOA + 0.5*NO2 + 0.5*HYAC rate = 1.29E-11 (380) + MACRO2_CH3CO3 (214) MACRO2 + CH3CO3 -> HO2 + 0.86*HYAC + 0.86*CO + 0.14*CH2O rate = 2.00E-12*exp( 500./t) (381) + + 0.14*CH3COCHO + CO2 + CH3O2 + MACRO2_CH3O2 (215) MACRO2 + CH3O2 -> 0.9*HYAC + 0.9*CO + 1.5*HO2 + 0.1*CH3COCH3 rate = 4.50E-14 (382) + + 1.1*CH2O + MACRO2_HO2 (216) MACRO2 + HO2 -> 0.41*MACROOH + 0.59*OH + 0.59*HO2 + 0.51*HYAC rate = 2.11E-13*exp( 1300./t) (383) + + 0.51*CO + 0.08*CH3COCHO + 0.08*CH2O + MACRO2_isom (217) MACRO2 -> HYAC + CO + OH rate = 2.90E+07*exp( -5297./t) (384) + MACR_O3 (218) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (385) + + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 + MACR_OH (219) MACR + OH -> 0.55*MACRO2 + 0.45*H2O + 0.45*MCO3 rate = 9.60E-12*exp( 360./t) (386) + MACROOH_OH (220) MACROOH + OH -> HYAC + CO + OH rate = 3.77E-11 (387) + MCO3_CH3CO3 (221) MCO3 + CH3CO3 -> 2*CO2 + 0.35*CH3CO3 + CH2O + 1.65*CH3O2 + 0.65*CO rate = 2.90E-12*exp( 500./t) (388) + MCO3_CH3O2 (222) MCO3 + CH3O2 -> CO2 + 0.35*CH3CO3 + 2*CH2O + 0.65*CH3O2 + 0.65*CO rate = 2.00E-12*exp( 500./t) (389) + + HO2 + MCO3_HO2 (223) MCO3 + HO2 -> 0.49*CH2O + 0.49*OH + 0.49*CO2 + 0.17*CH3CO3 rate = 4.30E-13*exp( 1040./t) (390) + + 0.32*CH3O2 + 0.32*CO + 0.15*O3 + 0.15*CH3COOH + + 0.36*CH3COOOH + MCO3_MCO3 (224) MCO3 + MCO3 -> 2*CO2 + 0.7*CH3CO3 + 2*CH2O + 1.3*CH3O2 + 1.3*CO rate = 2.90E-12*exp( 500./t) (391) + MCO3_NO (225) MCO3 + NO -> NO2 + CO2 + 0.35*CH3CO3 + CH2O + 0.65*CH3O2 + 0.65*CO rate = 8.10E-12*exp( 270./t) (392) + MCO3_NO3 (226) MCO3 + NO3 -> NO2 + CO2 + 0.35*CH3CO3 + CH2O + 0.65*CH3O2 + 0.65*CO rate = 4.00E-12 (393) + MEKO2_HO2 (227) MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 rate = 7.50E-13*exp( 700./t) (394) + MEKO2_NO (228) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (395) + MEK_OH (229) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (396) + MEKOOH_OH (230) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (397) + MPAN_OH_M (231) MPAN + OH + M -> 0.25*HYAC + NO3 + 0.25*CO + M troe : ko=8.00E-27*(300/t)**3.50 (398) + ki=3.00E-11 + f=0.50 + MVKN_OH (232) MVKN + OH -> HO2 + 0.5*ONITR + 0.5*CO + 0.5*NOA rate = 1.78E-12 (399) + MVKO2_CH3CO3 (233) MVKO2 + CH3CO3 -> CH3O2 + CO2 + 0.75*GLYALD + 0.75*CH3CO3 rate = 2.00E-12*exp( 500./t) (400) + + 0.25*CH2O + 0.25*HO2 + 0.25*CH3COCHO + MVKO2_CH3O2 (234) MVKO2 + CH3O2 -> 0.25*CH3OH + CO + 0.87*CH2O + 0.62*HO2 rate = 6.10E-13 (401) + + 0.38*GLYALD + 0.88*CH3CO3 + 0.12*CH3COCHO + MVKO2_HO2 (235) MVKO2 + HO2 -> 0.46*MVKOOH + 0.54*OH + 0.36*GLYALD + 0.49*CH3CO3 rate = 2.11E-13*exp( 1300./t) (402) + + 0.26*CO + 0.18*HO2 + 0.05*CH3COCHO + 0.05*CH2O + MVK_O3 (236) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (403) + + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH + MVK_OH (237) MVK + OH -> MVKO2 rate = 2.70E-12*exp( 580./t) (404) + MVKOOH_OH (238) MVKOOH + OH -> 1.56*CO + 0.44*HO2 + 0.44*CH3COCHO + 0.56*CH3CO3 rate = 4.80E-11 (405) + tag_MCO3_NO2 (239) MCO3 + NO2 + M -> MPAN + M troe : ko=9.70E-29*(300/t)**5.60 (406) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + usr_MPAN_M (240) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (407) + ALKNIT_OH (241) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (408) + ALKO2_HO2 (242) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (409) + ALKO2_NO (243) ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK rate = 6.70E-12 (410) + + NO2 + ALKO2_NOb (244) ALKO2 + NO -> ALKNIT rate = 5.40E-14*exp( 870./t) (411) + ALKOOH_OH (245) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (412) + BIGALK_OH (246) BIGALK + OH -> ALKO2 rate = 3.50E-12 (413) + HPALD1_OH (247) HPALD1 + OH -> 0.51*HO2 + 1.06*CO + 0.38*CH3COCHO + 0.54*CO2 rate = 1.17E-11*exp( 450./t) (414) + + 0.06*CH3O2 + 0.06*CH3CO3 + 0.08*ICHE + + 0.07*DHPMPAL + 0.43*OH + 0.35*MVK + HPALD4_OH (248) HPALD4 + OH -> 0.41*HO2 + 0.76*CO + 0.03*CH3COCHO + 0.54*CO2 rate = 1.17E-11*exp( 450./t) (415) + + 0.06*CH3O2 + 0.06*CH3CO3 + 0.15*HYPERACET + + 0.18*ICHE + 0.17*DHPMPAL + 0.35*MACR + 0.53*OH + HPALDB1C_OH (249) HPALDB1C + OH -> 0.58*ICHE + OH + 0.42*CO + 0.23*MVK + 0.19*MVKOOH rate = 2.20E-11*exp( 390./t) (416) + HPALDB4C_OH (250) HPALDB4C + OH -> 0.77*ICHE + OH + 0.23*CO + 0.14*MACR rate = 3.50E-11*exp( 390./t) (417) + + 0.09*MACROOH + HYDRALD_OH (251) HYDRALD + OH -> 1.08*OH + CO + 0.36*CO2 + 0.46*CH3COCHO rate = 6.42E-11 (418) + + 0.32*IEPOXOO + 0.22*HYAC + 0.32*HO2 + ICHE_OH (252) ICHE + OH -> OH + 1.5*CO + 0.5*HYAC + 0.5*CH3COCHO + 0.5*CH2O rate = 9.85E-12*exp( 410./t) (419) + IEPOX_OH (253) IEPOX + OH -> 0.19*ICHE + 0.19*HO2 + 0.81*IEPOXOO rate = 4.43E-11*exp( -400./t) (420) + IEPOXOO_HO2 (254) IEPOXOO + HO2 -> 0.35*ISOPHFP + 0.65*OH + 0.65*HO2 + 0.26*CO rate = 2.38E-13*exp( 1300./t) (421) + + 0.37*GLYALD + 0.46*CH3COCHO + 0.15*GLYOXAL + + 0.19*HYAC + INHEB_OH (255) INHEB + OH -> 0.2*INHEB + 0.4*NC4CHOO2 + 0.4*CH3COCHO + 0.4*HCOOH rate = 4.43E-11*exp( -400./t) (422) + + 0.4*CH2O + 0.4*NO2 + INHED_OH (256) INHED + OH -> 0.35*NOA + 0.35*CO + 0.4*HO2 + 0.59*CH2O rate = 3.22E-11*exp( -400./t) (423) + + 0.35*NC4CHOO2 + 0.06*INHED + 0.19*HYAC + 0.19*CO2 + + 0.19*NO2 + 0.05*MVKN + ISOPB1O2_CH3CO3 (257) ISOPB1O2 + CH3CO3 -> MVK + CH2O + HO2 + CO2 + CH3O2 rate = 2.00E-12*exp( 500./t) (424) + ISOPB1O2_CH3O2 (258) ISOPB1O2 + CH3O2 -> 1.75*CH2O + 0.25*ISOPOH + 0.75*MVK + 1.5*HO2 rate = 1.60E-13 (425) + ISOPB1O2_HO2 (259) ISOPB1O2 + HO2 -> 0.06*MVK + 0.06*CH2O + 0.06*OH + 0.06*HO2 rate = 2.12E-13*exp( 1300./t) (426) + + 0.94*ISOPOOH + ISOPB1O2_I (260) ISOPB1O2 -> MVK + CH2O + OH rate = 1.04E+11*exp( -9746./t) (427) + ISOPB1O2_M_C (261) ISOPB1O2 -> ISOPC1C + O2 rate = 2.24E+15*exp( -10865./t) (428) + ISOPB1O2_M_T (262) ISOPB1O2 -> ISOPC1T + O2 rate = 2.22E+15*exp( -10355./t) (429) + ISOPB4O2_CH3CO3 (263) ISOPB4O2 + CH3CO3 -> MACR + CH2O + HO2 + CO2 + CH3O2 rate = 2.00E-12*exp( 500./t) (430) + ISOPB4O2_CH3O2 (264) ISOPB4O2 + CH3O2 -> 0.25*CH3OH + 0.25*HYDRALD + 0.25*ISOPOH rate = 1.40E-12 (431) + + 1.25*CH2O + HO2 + 0.5*MACR + ISOPB4O2_HO2 (265) ISOPB4O2 + HO2 -> 0.06*MACR + 0.06*CH2O + 0.06*OH + 0.06*HO2 rate = 2.12E-13*exp( 1300./t) (432) + + 0.94*ISOPOOH + ISOPB4O2_I (266) ISOPB4O2 -> MACR + CH2O + OH rate = 1.88E+11*exp( -9752./t) (433) + ISOPB4O2_M_C (267) ISOPB4O2 -> ISOPC4C + O2 rate = 2.49E+15*exp( -11112./t) (434) + ISOPB4O2_M_T (268) ISOPB4O2 -> ISOPC4T + O2 rate = 2.49E+15*exp( -10890./t) (435) + ISOPC1C_O2_B (269) O2 + ISOPC1C -> ISOPB1O2 rate = 7.50E-13 (436) + ISOPC1C_O2_D (270) ISOPC1C + O2 -> ISOPZD1O2 rate = 1.40E-13 (437) + ISOPC1T_O2_B (271) ISOPC1T + O2 -> ISOPB1O2 rate = 7.50E-13 (438) + ISOPC1T_O2_D (272) ISOPC1T + O2 -> ISOPED1O2 rate = 3.60E-13 (439) + ISOPC4C_O2_B (273) ISOPC4C + O2 -> ISOPB4O2 rate = 6.50E-13 (440) + ISOPC4C_O2_D (274) ISOPC4C + O2 -> ISOPZD4O2 rate = 2.10E-13 (441) + ISOPC4T_O2_B (275) ISOPC4T + O2 -> ISOPB4O2 rate = 6.50E-13 (442) + ISOPC4T_O2_D (276) ISOPC4T + O2 -> ISOPED4O2 rate = 4.90E-13 (443) + ISOPED1O2_CH3CO3 (277) ISOPED1O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH rate = 2.00E-12*exp( 500./t) (444) + + 0.55*MVKOOH + CO2 + CH3O2 + ISOPED1O2_CH3O2 (278) ISOPED1O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O rate = 1.20E-12 (445) + + 0.72*HO2 + 0.28*CO + 0.28*OH + 0.28*MVKOOH + + 0.47*HYDRALD + ISOPED1O2_HO2 (279) ISOPED1O2 + HO2 -> ISOPOOH rate = 2.12E-13*exp( 1300./t) (446) + ISOPED1O2_M_C (280) ISOPED1O2 -> ISOPC1T + O2 rate = 1.83E+14*exp( -8930./t) (447) + ISOPED4O2_CH3CO3 (281) ISOPED4O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH rate = 2.00E-12*exp( 500./t) (448) + + 0.55*MACROOH + CO2 + CH3O2 + ISOPED4O2_CH3O2 (282) ISOPED4O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O rate = 9.80E-13 (449) + + 0.72*HO2 + 0.28*CO + 0.28*OH + 0.28*MACROOH + + 0.47*HYDRALD + ISOPED4O2_HO2 (283) ISOPED4O2 + HO2 -> ISOPOOH rate = 2.12E-13*exp( 1300./t) (450) + ISOPED4O2_M (284) ISOPED4O2 -> ISOPC4T + O2 rate = 2.08E+14*exp( -9400./t) (451) + ISOPFDNC_OH (285) ISOPFDNC + OH -> CO + NO2 + 0.5*MACRN + 0.5*MVKN rate = 1.85E-11 (452) + ISOPFDN_OH (286) ISOPFDN + OH -> ISOPFDNC + HO2 rate = 1.63E-12 (453) + ISOPFNC_OH (287) ISOPFNC + OH -> CO + 0.5*NO2 + 0.5*OH + 0.25*MACRN + 0.25*MVKN rate = 2.50E-11 (454) + + 0.25*MACROOH + 0.25*MVKOOH + ISOPFNP_OH (288) ISOPFNP + OH -> ISOPFNC + HO2 rate = 1.10E-11 (455) + ISOPHFP_OH (289) ISOPHFP + OH -> 2*CO + OH + 0.72*CH3COCHO + 0.28*HYAC rate = 3.30E-11 (456) + ISOPN1DO2_HO2 (290) ISOPN1DO2 + HO2 -> 0.42*ISOPFNP + 0.58*OH + 0.58*HO2 + 0.55*NOA rate = 2.60E-13*exp( 1300./t) (457) + + 0.55*GLYALD + 0.03*MACRN + 0.03*CH2O + ISOPN1DO2_I (291) ISOPN1DO2 -> ISOPFNP + HO2 rate = 1.26E+13*exp( -10000./t) (458) + ISOPN1D_O3 (292) ISOPN1D + O3 -> 0.66*H2O2 + 0.83*GLYALD + 0.83*NOA + 0.34*OH rate = 2.80E-17 (459) + + 0.17*NO2 + 0.17*CH3COCHO + 0.17*GLYOXAL + + 0.17*HO2 + ISOPN1D_OH (293) ISOPN1D + OH -> 0.08*IEPOX + 0.08*NO2 + 0.04*NC4CHO + 0.04*HO2 rate = 8.00E-11 (460) + + 0.06*MACRN + 0.06*OH + 0.06*CO + 0.82*ISOPN1DO2 + ISOPN2BO2_HO2 (294) ISOPN2BO2 + HO2 -> 0.48*ISOPFNP + 0.52*OH + 0.06*MACRN + 0.06*CH2O rate = 2.60E-13*exp( 1300./t) (461) + + 0.06*HO2 + 0.46*HYAC + 0.46*NO2 + 0.46*GLYALD + ISOPN2BO2_I (295) ISOPN2BO2 -> ISOPFNC + HO2 rate = 1.88E+13*exp( -10000./t) (462) + ISOPN2B_OH (296) ISOPN2B + OH -> 0.15*IEPOX + 0.15*NO2 + 0.85*ISOPN2BO2 rate = 3.00E-11 (463) + ISOPN3BO2_HO2 (297) ISOPN3BO2 + HO2 -> 0.4*ISOPFNP + 0.6*OH + 0.6*MVKN + 0.6*CH2O rate = 2.60E-13*exp( 1300./t) (464) + + 0.6*HO2 + ISOPN3BO2_I (298) ISOPN3BO2 -> ISOPFNC + HO2 rate = 1.88E+13*exp( -10000./t) (465) + ISOPN3B_OH (299) ISOPN3B + OH -> 0.13*IEPOX + 0.13*NO2 + 0.87*ISOPN3BO2 rate = 4.20E-11 (466) + ISOPN4DO2_HO2 (300) ISOPN4DO2 + HO2 -> 0.5*ISOPFNP + 0.5*OH + 0.5*HO2 + 0.06*MVKN rate = 2.60E-13*exp( 1300./t) (467) + + 0.06*CH2O + 0.44*HYAC + 0.44*NO3CH2CHO + ISOPN4DO2_I (301) ISOPN4DO2 -> ISOPFNP + HO2 rate = 5.09E+12*exp( -10000./t) (468) + ISOPN4D_O3 (302) ISOPN4D + O3 -> 0.66*H2O2 + 0.83*NO3CH2CHO + 0.83*HYAC + 0.34*OH rate = 2.80E-17 (469) + + 0.17*NO2 + 0.17*GLYOXAL + 0.17*CH3COCHO + + 0.17*HO2 + ISOPN4D_OH (303) ISOPN4D + OH -> 0.04*IEPOX + 0.04*NO2 + 0.03*NC4CHO + 0.03*HO2 rate = 1.10E-10 (470) + + 0.04*MVKN + 0.04*CO + 0.04*OH + 0.89*ISOPN4DO2 + ISOPNBNO3O2_HO2 (304) ISOPNBNO3O2 + HO2 -> 0.6*ISOPFNP + 0.4*OH + 0.4*HO2 + 0.06*MACRN rate = 2.60E-13*exp( 1300./t) (471) + + 0.04*MVKN + 0.1*CH2O + 0.15*NOA + + 0.15*GLYALD + 0.15*HYAC + 0.15*NO3CH2CHO + ISOPNBNO3_OH (305) ISOPNBNO3 + OH -> 0.03*INHED + 0.03*OH + 0.05*NC4CHO + 0.05*HO2 rate = 3.90E-11 (472) + + 0.92*ISOPNBNO3O2 + ISOP_NO3 (306) ISOP + NO3 -> ISOPNO3 rate = 2.95E-12*exp( -450./t) (473) + ISOPNO3_CH3CO3 (307) ISOPNO3 + CH3CO3 -> CH3O2 + CO2 + 0.46*NO2 + 0.46*CH2O rate = 2.00E-12*exp( 500./t) (474) + + 0.54*NC4CHO + 0.54*HO2 + 0.42*MVK + 0.04*MACR + ISOPNO3_CH3O2 (308) ISOPNO3 + CH3O2 -> 0.07*ISOPNBNO3 + 0.71*CH2O + 0.05*MVK + 0.07*NO2 rate = 1.30E-12 (475) + + 0.4*HO2 + 0.02*MACR + 0.53*NC4CHO + 0.36*CH3OH + + 0.28*ISOPN1D + 0.05*ISOPN4D + ISOPNO3_HO2 (309) ISOPNO3 + HO2 -> 0.23*ISOPNOOHB + 0.53*ISOPNOOHD + 0.22*MVK rate = 2.47E-13*exp( 1300./t) (476) + + 0.02*MACR + 0.24*CH2O + 0.24*OH + 0.24*NO2 + ISOPNO3_ISOPNO3 (310) ISOPNO3 + ISOPNO3 -> 1.07*NC4CHO + 0.4*HO2 + 0.16*MACR + 0.16*CH2O rate = 5.00E-12 (477) + + 0.16*NO2 + 0.53*ISOPN1D + 0.09*ISOPN4D + + 0.15*ISOPNBNO3 + ISOPNO3_NO3 (311) ISOPNO3 + NO3 -> 1.46*NO2 + 0.46*CH2O + 0.54*NC4CHO + 0.54*HO2 rate = 2.30E-12 (478) + + 0.42*MVK + 0.04*MACR + ISOPNOOHBO2_HO2 (312) ISOPNOOHBO2 + HO2 -> 0.49*ISOPFNP + 0.85*OH + 0.17*CH2O + 0.17*HO2 rate = 2.64E-13*exp( 1300./t) (479) + + 0.15*MACRN + 0.02*MVKN + 0.28*NOA + + 0.28*GLYALD + 0.06*HYAC + 0.06*NO3CH2CHO + ISOPNOOHBO2_I (313) ISOPNOOHBO2 -> OH + ISOPFNP rate = 8.72E+12*exp( -10000./t) (480) + ISOPNOOHB_OH (314) ISOPNOOHB + OH -> 0.17*ISOPNO3 + 0.02*NC4CHO + 0.4*INHEB + 0.42*OH rate = 3.90E-11 (481) + + 0.41*ISOPNOOHBO2 + ISOPNOOHDO2_HO2 (315) ISOPNOOHDO2 + HO2 -> 0.17*ISOPFNP + 0.86*OH + 0.03*CH2O rate = 2.64E-13*exp( 1300./t) (482) + + 0.02*MACRN + 0.01*MVKN + 0.68*NOA + + 0.68*HCOCH2OOH + 0.12*HYPERACET + + 0.12*NO3CH2CHO + 0.8*HO2 + ISOPNOOHDO2_I (316) ISOPNOOHDO2 -> OH + ISOPFNP rate = 6.55E+12*exp( -10000./t) (483) + ISOPNOOHD_O3 (317) ISOPNOOHD + O3 -> 0.66*H2O2 + 0.7*HCOCH2OOH + 0.13*HYPERACET rate = 2.80E-17 (484) + + 0.7*NOA + 0.13*NO3CH2CHO + 0.51*OH + 0.17*NO2 + + 0.17*CH3COCHO + 0.17*GLYOXAL + ISOPNOOHD_OH (318) ISOPNOOHD + OH -> 0.07*ISOPNO3 + 0.09*NC4CHO + 0.29*OH + 0.2*INHED rate = 9.20E-11 (485) + + 0.07*IEPOX + 0.07*NO2 + 0.57*ISOPNOOHDO2 + ISOP_O3 (319) ISOP + O3 -> 0.25*OH + 0.41*MACR + 0.17*MVK + 0.33*HMHP + 0.03*H2O2 rate = 1.03E-14*exp( -1995./t) (486) + + 0.22*HCOOH + 1.01*CH2O + 0.42*CO2 + 0.42*HO2 + + 0.21*CH3O2 + 0.07*CH3CO3 + 0.35*CO + ISOP_OH (320) ISOP + OH -> 0.315*ISOPC1T + 0.315*ISOPC1C + 0.111*ISOPC4T rate = 2.70E-11*exp( 390./t) (487) + + 0.259*ISOPC4C + ISOPOH_OH (321) ISOPOH + OH -> HYAC + GLYALD + HO2 rate = 3.85E-11 (488) + ISOPOOH_OH_abs (322) ISOPOOH + OH -> 0.53*ISOPB1O2 + 0.16*ISOPB4O2 + 0.13*HYDRALD rate = 5.53E-12*exp( 200./t) (489) + + 0.13*OH + 0.09*HPALDB1C + 0.09*HPALDB4C + + 0.18*HO2 + ISOPOOH_OH_add (323) ISOPOOH + OH -> 0.85*IEPOX + 0.92*OH + 0.07*GLYALD + 0.07*HYAC rate = 2.08E-11*exp( 390./t) (490) + + 0.08*ISOPHFP + ISOPZD1O2_CH3CO3 (324) ISOPZD1O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH rate = 2.00E-12*exp( 500./t) (491) + + 0.55*MVKOOH + CO2 + CH3O2 + ISOPZD1O2_CH3O2 (325) ISOPZD1O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O rate = 1.20E-12 (492) + + 0.72*HO2 + 0.28*CO + 0.28*OH + 0.28*MVKOOH + + 0.47*HYDRALD + ISOPZD1O2_HO2 (326) ISOPZD1O2 + HO2 -> ISOPOOH rate = 2.12E-13*exp( 1300./t) (493) + ISOPZD1O2_M (327) ISOPZD1O2 -> ISOPC1C + O2 rate = 1.79E+14*exp( -8830./t) (494) + ISOPZD4O2_CH3CO3 (328) ISOPZD4O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH rate = 2.00E-12*exp( 500./t) (495) + + 0.55*MACROOH + CO2 + CH3O2 + ISOPZD4O2_CH3O2 (329) ISOPZD4O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O rate = 9.80E-13 (496) + + 0.72*HO2 + 0.28*CO + 0.28*OH + 0.28*MACROOH + + 0.47*HYDRALD + ISOPZD4O2_HO2 (330) ISOPZD4O2 + HO2 -> ISOPOOH rate = 2.12E-13*exp( 1300./t) (497) + ISOPZD4O2_M_C (331) ISOPZD4O2 -> ISOPC4C + O2 rate = 1.75E+14*exp( -9054./t) (498) + NC4CHOO2_HO2 (332) NC4CHOO2 + HO2 -> 0.2*ISOPFNP + 0.8*OH + 0.8*HO2 + 0.1*NOA rate = 2.60E-13*exp( 1300./t) (499) + + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*NO3CH2CHO + + 0.29*MACRN + 0.31*MVKN + 0.6*CO + NC4CHOO2_isom (333) NC4CHOO2 -> 0.51*MACRN + 0.49*MVKN + CO + OH rate = 1.00E+07*exp( -5000./t) (500) + NC4CHO_O3 (334) NC4CHO + O3 -> 0.66*H2O2 + 0.66*GLYOXAL + 0.34*CH3COCHO + 0.61*NOA rate = 4.40E-18 (501) + + 0.22*NO3CH2CHO + 0.34*OH + 0.17*NO2 + 0.3*CO + + 0.13*HO2 + 0.04*CH3CO3 + NC4CHO_OH (335) NC4CHO + OH -> 0.45*CO2 + 0.1*CH3CO3 + 0.1*NO3CH2CHO + 0.35*NOA rate = 3.60E-11 (502) + + 0.04*NO2 + 0.04*ICHE + 0.24*MACRN + 0.04*MVKN + + 0.63*CO + 0.63*HO2 + 0.23*NC4CHOO2 + usr_IEPOXOO_NOa (336) IEPOXOO + NO -> NO2 + HO2 + 0.57*GLYALD + 0.71*CH3COCHO + 0.4*CO rate = ** User defined ** (503) + + 0.23*GLYOXAL + 0.29*HYAC + usr_IEPOXOO_NOn (337) IEPOXOO + NO -> ISOPFNC rate = ** User defined ** (504) + usr_ISOPB1O2_NOa (338) ISOPB1O2 + NO -> NO2 + MVK + CH2O + HO2 rate = ** User defined ** (505) + usr_ISOPB1O2_NOn (339) ISOPB1O2 + NO -> ISOPN2B rate = ** User defined ** (506) + usr_ISOPB4O2_NOa (340) ISOPB4O2 + NO -> NO2 + MACR + CH2O + HO2 rate = ** User defined ** (507) + usr_ISOPB4O2_NOn (341) ISOPB4O2 + NO -> ISOPN3B rate = ** User defined ** (508) + usr_ISOPED1O2_NO (342) ISOPED1O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MVKOOH rate = ** User defined ** (509) + + 0.55*CO + 0.55*OH + usr_ISOPED1O2_NO (343) ISOPED1O2 + NO -> ISOPN4D rate = ** User defined ** (510) + usr_ISOPED4O2_NO (344) ISOPED4O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MACROOH rate = ** User defined ** (511) + + 0.55*CO + 0.55*OH + usr_ISOPED4O2_NO (345) ISOPED4O2 + NO -> ISOPN1D rate = ** User defined ** (512) + usr_ISOPN1DO2_NO (346) ISOPN1DO2 + NO -> NO2 + HO2 + 0.94*NOA + 0.94*GLYALD + 0.06*MACRN rate = ** User defined ** (513) + + 0.06*CH2O + usr_ISOPN1DO2_NO (347) ISOPN1DO2 + NO -> ISOPFDN rate = ** User defined ** (514) + usr_ISOPN2BO2_NO (348) ISOPN2BO2 + NO -> 1.73*NO2 + 0.27*MACRN + 0.27*CH2O + 0.27*HO2 rate = ** User defined ** (515) + + 0.73*HYAC + 0.73*GLYALD + usr_ISOPN2BO2_NO (349) ISOPN2BO2 + NO -> ISOPFDN rate = ** User defined ** (516) + usr_ISOPN3BO2_NO (350) ISOPN3BO2 + NO -> NO2 + MVKN + CH2O + HO2 rate = ** User defined ** (517) + usr_ISOPN3BO2_NO (351) ISOPN3BO2 + NO -> ISOPFDN rate = ** User defined ** (518) + usr_ISOPN4DO2_NO (352) ISOPN4DO2 + NO -> NO2 + HO2 + 0.13*MVKN + 0.13*CH2O + 0.87*HYAC rate = ** User defined ** (519) + + 0.87*NO3CH2CHO + usr_ISOPN4DO2_NO (353) ISOPN4DO2 + NO -> ISOPFDN rate = ** User defined ** (520) + usr_ISOPNBNO3O2_ (354) ISOPNBNO3O2 + NO -> NO2 + HO2 + 0.21*MACRN + 0.12*MVKN + 0.33*CH2O rate = ** User defined ** (521) + + 0.34*NOA + 0.34*GLYALD + 0.33*HYAC + + 0.33*NO3CH2CHO + usr_ISOPNBNO3O2_ (355) ISOPNBNO3O2 + NO -> ISOPFDN rate = ** User defined ** (522) + usr_ISOPNO3_NOa (356) ISOPNO3 + NO -> 1.46*NO2 + 0.46*CH2O + 0.54*NC4CHO + 0.54*HO2 rate = ** User defined ** (523) + + 0.42*MVK + 0.04*MACR + usr_ISOPNO3_NOn (357) ISOPNO3 + NO -> ISOPFDN rate = ** User defined ** (524) + usr_ISOPNOOHBO2_ (358) ISOPNOOHBO2 + NO -> NO2 + 0.53*CH2O + 0.53*HO2 + 0.49*MACRN rate = ** User defined ** (525) + + 0.04*MVKN + 0.4*NOA + 0.4*GLYALD + 0.07*HYAC + + 0.07*NO3CH2CHO + 0.47*OH + usr_ISOPNOOHBO2_ (359) ISOPNOOHBO2 + NO -> ISOPFDN rate = ** User defined ** (526) + usr_ISOPNOOHDO2_ (360) ISOPNOOHDO2 + NO -> NO2 + 0.04*CH2O + 0.04*OH + 0.02*MACRN rate = ** User defined ** (527) + + 0.02*MVKN + 0.81*NOA + 0.81*HCOCH2OOH + + 0.15*HYPERACET + 0.15*NO3CH2CHO + 0.96*HO2 + usr_ISOPNOOHDO2_ (361) ISOPNOOHDO2 + NO -> ISOPFDN rate = ** User defined ** (528) + usr_ISOPZD1O2 (362) ISOPZD1O2 -> 0.15*HPALDB1C + 0.25*HPALD1 + 0.4*HO2 + 0.6*OH rate = ** User defined ** (529) + + 0.6*DHPMPAL + 0.6*CO + usr_ISOPZD1O2_NO (363) ISOPZD1O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MVKOOH rate = ** User defined ** (530) + + 0.55*CO + 0.55*OH + usr_ISOPZD1O2_NO (364) ISOPZD1O2 + NO -> ISOPN4D rate = ** User defined ** (531) + usr_ISOPZD4O2 (365) ISOPZD4O2 -> 0.15*HPALDB4C + 0.25*HPALD4 + 0.4*HO2 + 0.6*OH rate = ** User defined ** (532) + + 0.6*DHPMPAL + 0.6*CO + usr_ISOPZD4O2_NO (366) ISOPZD4O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MACROOH rate = ** User defined ** (533) + + 0.55*CO + 0.55*OH + usr_ISOPZD4O2_NO (367) ISOPZD4O2 + NO -> ISOPN1D rate = ** User defined ** (534) + usr_MACRO2_NOa (368) MACRO2 + NO -> NO2 + HO2 + 0.86*HYAC + 0.86*CO + 0.14*CH2O rate = ** User defined ** (535) + + 0.14*CH3COCHO + usr_MACRO2_NOn (369) MACRO2 + NO -> MACRN rate = ** User defined ** (536) + usr_MVKO2_NOa (370) MVKO2 + NO -> NO2 + 0.24*HO2 + 0.24*CH2O + 0.76*CH3CO3 rate = ** User defined ** (537) + + 0.76*GLYALD + 0.24*CH3COCHO + usr_MVKO2_NOn (371) MVKO2 + NO -> MVKN rate = ** User defined ** (538) + usr_NC4CHOO2_NOa (372) NC4CHOO2 + NO -> NO2 + HO2 + 0.13*NOA + 0.13*GLYOXAL rate = ** User defined ** (539) + + 0.12*CH3COCHO + 0.12*NO3CH2CHO + 0.39*MACRN + + 0.36*MVKN + 0.75*CO + usr_NC4CHOO2_NOn (373) NC4CHOO2 + NO -> ISOPFDNC rate = ** User defined ** (540) + ACBZO2_HO2 (374) ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH rate = 4.30E-13*exp( 1040./t) (541) + ACBZO2_NO (375) ACBZO2 + NO -> C6H5O2 + NO2 rate = 7.50E-12*exp( 290./t) (542) + BENZENE_OH (376) BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 rate = 2.30E-12*exp( -193./t) (543) + BENZO2_HO2 (377) BENZO2 + HO2 -> BENZOOH rate = 7.50E-13*exp( 700./t) (544) + BENZO2_NO (378) BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 rate = 2.60E-12*exp( 365./t) (545) + BENZOOH_OH (379) BENZOOH + OH -> BENZO2 rate = 3.80E-12*exp( 200./t) (546) + BZALD_OH (380) BZALD + OH -> ACBZO2 rate = 5.90E-12*exp( 225./t) (547) + BZOO_HO2 (381) BZOO + HO2 -> BZOOH rate = 7.50E-13*exp( 700./t) (548) + BZOOH_OH (382) BZOOH + OH -> BZOO rate = 3.80E-12*exp( 200./t) (549) + BZOO_NO (383) BZOO + NO -> BZALD + NO2 + HO2 rate = 2.60E-12*exp( 365./t) (550) + C6H5O2_HO2 (384) C6H5O2 + HO2 -> C6H5OOH rate = 7.50E-13*exp( 700./t) (551) + C6H5O2_NO (385) C6H5O2 + NO -> PHENO + NO2 rate = 2.60E-12*exp( 365./t) (552) + C6H5OOH_OH (386) C6H5OOH + OH -> C6H5O2 rate = 3.80E-12*exp( 200./t) (553) + CRESOL_OH (387) CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO rate = 4.70E-11 (554) + DICARBO2_HO2 (388) DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO rate = 4.30E-13*exp( 1040./t) (555) + + 0.33*CH3O2 + DICARBO2_NO (389) DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO rate = 7.50E-12*exp( 290./t) (556) + + 0.83*CH3O2 + DICARBO2_NO2 (390) DICARBO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (557) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MALO2_HO2 (391) MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO rate = 4.30E-13*exp( 1040./t) (558) + MALO2_NO (392) MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 rate = 7.50E-12*exp( 290./t) (559) + MALO2_NO2 (393) MALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (560) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MDIALO2_HO2 (394) MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO rate = 4.30E-13*exp( 1040./t) (561) + + 0.07*CH3O2 + 0.07*GLYOXAL + MDIALO2_NO (395) MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO rate = 7.50E-12*exp( 290./t) (562) + + 0.17*CH3O2 + 0.17*GLYOXAL + MDIALO2_NO2 (396) MDIALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (563) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + PHENO2_HO2 (397) PHENO2 + HO2 -> PHENOOH rate = 7.50E-13*exp( 700./t) (564) + PHENO2_NO (398) PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 rate = 2.60E-12*exp( 365./t) (565) + PHENOL_OH (399) PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO rate = 4.70E-13*exp( 1220./t) (566) + PHENO_NO2 (400) PHENO + NO2 -> NDEP rate = 2.10E-12 (567) + PHENO_O3 (401) PHENO + O3 -> C6H5O2 rate = 2.80E-13 (568) + PHENOOH_OH (402) PHENOOH + OH -> PHENO2 rate = 3.80E-12*exp( 200./t) (569) + tag_ACBZO2_NO2 (403) ACBZO2 + NO2 + M -> PBZNIT + M troe : ko=9.70E-29*(300/t)**5.60 (570) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + TOLO2_HO2 (404) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (571) + TOLO2_NO (405) TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = 2.60E-12*exp( 365./t) (572) + + 0.2*BIGALD2 + 0.2*BIGALD3 + TOLOOH_OH (406) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (573) + TOLUENE_OH (407) TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 rate = 1.70E-12*exp( 352./t) (574) + + 0.28*HO2 + usr_PBZNIT_M (408) PBZNIT + M -> ACBZO2 + NO2 + M rate = ** User defined ** (575) + XYLENES_OH (409) XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO rate = 1.70E-11 (576) + + 0.56*XYLENO2 + 0.38*HO2 + XYLENO2_HO2 (410) XYLENO2 + HO2 -> XYLENOOH rate = 7.50E-13*exp( 700./t) (577) + XYLENO2_NO (411) XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = 2.60E-12*exp( 365./t) (578) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + XYLENOOH_OH (412) XYLENOOH + OH -> XYLENO2 rate = 3.80E-12*exp( 200./t) (579) + XYLOLO2_HO2 (413) XYLOLO2 + HO2 -> XYLOLOOH rate = 7.50E-13*exp( 700./t) (580) + XYLOLO2_NO (414) XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO rate = 2.60E-12*exp( 365./t) (581) + XYLOL_OH (415) XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO rate = 8.40E-11 (582) + XYLOLOOH_OH (416) XYLOLOOH + OH -> XYLOLO2 rate = 3.80E-12*exp( 200./t) (583) + APIN_NO3 (417) APIN + NO3 -> APINNO3 rate = 1.20E-12*exp( 490./t) (584) + APINNO3_APINNO3 (418) APINNO3 + APINNO3 -> 0.27*TERPNT + 0.09*TERPNS + 1.64*NO2 rate = 5.30E-13 (585) + + 1.64*TERPA + APINNO3_CH3CO3 (419) APINNO3 + CH3CO3 -> NO2 + TERPA + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (586) + APINNO3_CH3O2 (420) APINNO3 + CH3O2 -> 0.09*TERPNT + 0.09*TERPNS + 0.95*CH2O rate = 2.00E-12 (587) + + 0.05*CH3OH + 0.82*HO2 + 0.82*NO2 + 0.82*TERPA + APINNO3_HO2 (421) APINNO3 + HO2 -> 0.3*TERPNPT + 0.7*TERPA + 0.7*NO2 + 0.7*OH rate = 2.71E-13*exp( 1300./t) (588) + APINNO3_NO (422) APINNO3 + NO -> 1.86*NO2 + 0.07*TERPFDN + 0.93*TERPA rate = 2.70E-12*exp( 360./t) (589) + APINNO3_NO3 (423) APINNO3 + NO3 -> 2*NO2 + TERPA rate = 2.30E-12 (590) + APINNO3_TERPA2CO (424) APINNO3 + TERPA2CO3 -> NO2 + TERPA + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (591) + APINNO3_TERPA3CO (425) APINNO3 + TERPA3CO3 -> NO2 + TERPA + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (592) + APINNO3_TERPACO3 (426) APINNO3 + TERPACO3 -> NO2 + TERPA + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (593) + APINO2_CH3CO3 (427) APINO2 + CH3CO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH rate = 2.00E-12*exp( 500./t) (594) + + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + HO2 + + CH3O2 + CO2 + APINO2_CH3O2 (428) APINO2 + CH3O2 -> 0.83*CH2O + 0.14*TERPF1 + 0.42*TERPA + 0.2*TERPA3 rate = 2.00E-12 (595) + + 0.13*TERP1OOH + 0.17*CH3OH + 0.11*TERPK + + 0.06*CH3COCH3 + 1.16*HO2 + APINO2_HO2 (429) APINO2 + HO2 -> 0.06*CH3COCH3 + 0.06*TERPF1 + 0.08*CH2O rate = 2.60E-13*exp( 1300./t) (596) + + 0.25*TERP1OOH + 0.48*HO2 + 0.4*TERPOOH + + 0.29*TERPA + 0.35*OH + APINO2_NO (430) APINO2 + NO -> 0.01*TERPHFN + 0.02*TERPNS1 + 0.1*TERPNS rate = 2.70E-12*exp( 360./t) (597) + + 0.05*TERPNT + 0.05*TERPNT1 + 0.77*NO2 + 0.77*HO2 + + 0.3*TERPA + 0.27*TERPA3 + 0.09*CH3COCH3 + + 0.09*TERPF1 + 0.21*CH2O + 0.11*TERP1OOH + APINO2_NO3 (431) APINO2 + NO3 -> NO2 + HO2 + 0.39*TERPA + 0.35*TERPA3 rate = 2.30E-12 (598) + + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + + 0.14*TERP1OOH + APINO2_TERPA2CO3 (432) APINO2 + TERPA2CO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH rate = 2.00E-12*exp( 500./t) (599) + + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + + HO2 + TERPA2O2 + CO2 + APINO2_TERPA3CO3 (433) APINO2 + TERPA3CO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH rate = 2.00E-12*exp( 500./t) (600) + + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + + HO2 + TERPA4O2 + CO2 + APINO2_TERPACO3 (434) APINO2 + TERPACO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH rate = 2.00E-12*exp( 500./t) (601) + + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + + HO2 + TERPA1O2 + CO2 + APIN_O3 (435) APIN + O3 -> 0.77*OH + 0.33*TERPA2O2 + 0.22*H2O2 + 0.22*TERPA rate = 8.05E-16*exp( -640./t) (602) + + 0.01*TERPACID + 0.17*TERPA2 + 0.17*HO2 + 0.17*CO + + 0.27*CH2O + 0.27*TERPA2CO3 + APIN_OH (436) APIN + OH -> APINO2 rate = 1.34E-11*exp( 410./t) (603) + BCARY_NO3 (437) BCARY + NO3 -> BCARYNO3 rate = 1.90E-11 (604) + BCARYNO3_BCARYNO (438) BCARYNO3 + BCARYNO3 -> 0.36*SQTN + 1.64*NO2 + 1.64*TERPF2 rate = 5.30E-13 (605) + BCARYNO3_CH3CO3 (439) BCARYNO3 + CH3CO3 -> CH3O2 + CO2 + NO2 + TERPF2 rate = 2.00E-12*exp( 500./t) (606) + BCARYNO3_CH3O2 (440) BCARYNO3 + CH3O2 -> 0.18*SQTN + 0.95*CH2O + 0.82*TERPF2 + 0.82*NO2 rate = 2.00E-12 (607) + + 0.82*HO2 + 0.05*CH3OH + BCARYNO3_HO2 (441) BCARYNO3 + HO2 -> 0.5*SQTN + 0.5*OH + 0.5*NO2 + 0.5*TERPF2 rate = 2.78E-13*exp( 1300./t) (608) + BCARYNO3_NO (442) BCARYNO3 + NO -> 0.07*SQTN + 1.86*NO2 + 0.93*TERPF2 rate = 2.70E-12*exp( 360./t) (609) + BCARYNO3_NO3 (443) BCARYNO3 + NO3 -> 2*NO2 + TERPF2 rate = 2.30E-12 (610) + BCARYNO3_TERPA2C (444) BCARYNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + NO2 + TERPF2 rate = 2.00E-12*exp( 500./t) (611) + BCARYNO3_TERPA3C (445) BCARYNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + NO2 + TERPF2 rate = 2.00E-12*exp( 500./t) (612) + BCARYNO3_TERPACO (446) BCARYNO3 + TERPACO3 -> TERPA1O2 + CO2 + NO2 + TERPF2 rate = 2.00E-12*exp( 500./t) (613) + BCARYO2_CH3CO3 (447) BCARYO2 + CH3CO3 -> TERPF2 + HO2 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (614) + BCARYO2_CH3O2 (448) BCARYO2 + CH3O2 -> 0.25*CH3OH + TERPF2 + 0.75*CH2O + HO2 rate = 2.00E-12 (615) + BCARYO2_HO2 (449) BCARYO2 + HO2 -> 0.9*TERP2AOOH + 0.1*OH + 0.1*HO2 + 0.1*TERPF2 rate = 2.75E-13*exp( 1300./t) (616) + BCARYO2_NO (450) BCARYO2 + NO -> 0.3*SQTN + 0.7*NO2 + 0.7*HO2 + 0.7*TERPF2 rate = 2.70E-12*exp( 360./t) (617) + BCARYO2_NO3 (451) BCARYO2 + NO3 -> NO2 + HO2 + TERPF2 rate = 2.30E-12 (618) + BCARYO2_TERPA2CO (452) BCARYO2 + TERPA2CO3 -> TERPF2 + HO2 + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (619) + BCARYO2_TERPA3CO (453) BCARYO2 + TERPA3CO3 -> TERPF2 + HO2 + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (620) + BCARYO2_TERPACO3 (454) BCARYO2 + TERPACO3 -> TERPF2 + HO2 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (621) + BCARY_O3 (455) BCARY + O3 -> 0.13*TERPACID + 0.17*H2O2 + 0.08*OH + 0.08*HO2 rate = 1.20E-14 (622) + + 0.08*CH2O + 0.87*TERPF2 + BCARY_OH (456) BCARY + OH -> BCARYO2 rate = 2.00E-10 (623) + BPIN_NO3 (457) BPIN + NO3 -> BPINNO3 rate = 2.50E-12 (624) + BPINNO3_BPINNO3 (458) BPINNO3 + BPINNO3 -> 0.94*NO2 + 0.92*TERPNS + 0.9*TERPA3 rate = 5.30E-13 (625) + + 0.04*TERPK + 0.04*CH2O + 0.14*TERPNT + + 0.94*HO2 + BPINNO3_CH3CO3 (459) BPINNO3 + CH3CO3 -> CH3O2 + CO2 + 0.5*NO2 + 0.45*TERPNS rate = 2.00E-12*exp( 500./t) (626) + + 0.48*TERPA3 + 0.02*TERPK + 0.02*CH2O + + 0.05*TERPNT + 0.5*HO2 + BPINNO3_CH3O2 (460) BPINNO3 + CH3O2 -> 0.56*TERPNS + 0.08*TERPNT + 0.02*TERPK rate = 2.00E-12 (627) + + 0.34*TERPA3 + 0.36*NO2 + 1.1*HO2 + 0.99*CH2O + + 0.03*CH3OH + BPINNO3_HO2 (461) BPINNO3 + HO2 -> 0.47*OH + 0.45*TERPNPS + 0.22*TERPA3 + 0.02*TERPK rate = 2.71E-13*exp( 1300./t) (628) + + 0.08*TERPNPT + 0.24*NO2 + 0.02*CH2O + + 0.23*TERPNS + BPINNO3_NO (462) BPINNO3 + NO -> 0.07*TERPFDN + 1.39*NO2 + 0.42*TERPNS + 0.44*TERPA3 rate = 2.70E-12*exp( 360./t) (629) + + 0.02*TERPK + 0.02*CH2O + 0.05*TERPNT + 0.47*HO2 + BPINNO3_NO3 (463) BPINNO3 + NO3 -> 1.5*NO2 + 0.45*TERPNS + 0.48*TERPA3 + 0.02*TERPK rate = 2.30E-12 (630) + + 0.02*CH2O + 0.05*TERPNT + 0.5*HO2 + BPINNO3_TERPA2CO (464) BPINNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + 0.5*NO2 + 0.45*TERPNS rate = 2.00E-12*exp( 500./t) (631) + + 0.48*TERPA3 + 0.02*TERPK + 0.02*CH2O + + 0.05*TERPNT + 0.5*HO2 + BPINNO3_TERPA3CO (465) BPINNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + 0.5*NO2 + 0.45*TERPNS rate = 2.00E-12*exp( 500./t) (632) + + 0.48*TERPA3 + 0.02*TERPK + 0.02*CH2O + + 0.05*TERPNT + 0.5*HO2 + BPINNO3_TERPACO3 (466) BPINNO3 + TERPACO3 -> TERPA1O2 + CO2 + 0.5*NO2 + 0.45*TERPNS rate = 2.00E-12*exp( 500./t) (633) + + 0.48*TERPA3 + 0.02*TERPK + 0.02*CH2O + + 0.05*TERPNT + 0.5*HO2 + BPINO2_CH3CO3 (467) BPINO2 + CH3CO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 rate = 2.00E-12*exp( 500./t) (634) + + 0.11*CH3COCH3 + 0.65*CH2O + HO2 + CH3O2 + CO2 + BPINO2_CH3O2 (468) BPINO2 + CH3O2 -> 1.4*CH2O + 0.37*TERPF1 + 0.32*TERPK + 1.5*HO2 rate = 2.00E-12 (635) + + 0.08*CH3COCH3 + 0.31*TERPA3 + BPINO2_HO2 (469) BPINO2 + HO2 -> 0.68*TERP1OOH + 0.03*OH + 0.03*TERPK + 0.03*CH2O rate = 2.60E-13*exp( 1300./t) (636) + + 0.03*HO2 + 0.29*TERPOOH + BPINO2_NO (470) BPINO2 + NO -> 0.08*CH3COCH3 + 0.49*CH2O + 0.2*TERPF1 + 0.24*TERPK rate = 2.70E-12*exp( 360./t) (637) + + 0.04*TERPNS1 + 0.02*TERPNS + 0.06*TERPNT + + 0.13*TERPNT1 + 0.31*TERPA3 + 0.75*HO2 + 0.75*NO2 + BPINO2_NO3 (471) BPINO2 + NO3 -> 0.11*CH3COCH3 + 0.65*CH2O + 0.27*TERPF1 rate = 2.30E-12 (638) + + 0.32*TERPK + 0.41*TERPA3 + HO2 + NO2 + BPINO2_TERPA2CO3 (472) BPINO2 + TERPA2CO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 rate = 2.00E-12*exp( 500./t) (639) + + 0.11*CH3COCH3 + 0.65*CH2O + HO2 + TERPA2O2 + + CO2 + BPINO2_TERPA3CO3 (473) BPINO2 + TERPA3CO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 rate = 2.00E-12*exp( 500./t) (640) + + 0.11*CH3COCH3 + 0.65*CH2O + HO2 + TERPA4O2 + + CO2 + BPINO2_TERPACO3 (474) BPINO2 + TERPACO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 rate = 2.00E-12*exp( 500./t) (641) + + 0.11*CH3COCH3 + 0.65*CH2O + HO2 + TERPA1O2 + + CO2 + BPIN_O3 (475) BPIN + O3 -> 0.51*TERPK + 0.3*OH + 0.3*TERPA2CO3 + 0.32*H2O2 rate = 1.35E-15*exp( -1270./t) (642) + + 0.19*BIGALK + 0.19*CO2 + 0.81*CH2O + 0.11*HMHP + + 0.08*HCOOH + BPIN_OH (476) BPIN + OH -> BPINO2 rate = 1.62E-11*exp( 460./t) (643) + LIMON_NO3 (477) LIMON + NO3 -> LIMONNO3 rate = 1.20E-11 (644) + LIMONNO3_CH3CO3 (478) LIMONNO3 + CH3CO3 -> CH3O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 rate = 2.00E-12*exp( 500./t) (645) + + 0.19*TERPNT1 + 0.35*TERPNS1 + 0.54*HO2 + LIMONNO3_CH3O2 (479) LIMONNO3 + CH3O2 -> 0.27*TERPNT1 + 0.91*CH2O + 0.09*CH3OH rate = 2.00E-12 (646) + + 1.01*HO2 + 0.31*TERPF1 + 0.31*NO2 + + 0.42*TERPNS1 + LIMONNO3_HO2 (480) LIMONNO3 + HO2 -> 0.18*TERPNPT1 + 0.32*TERPNPS1 + 0.5*OH rate = 2.71E-13*exp( 1300./t) (647) + + 0.23*TERPF1 + 0.23*NO2 + 0.18*TERPNS1 + + 0.09*TERPNT1 + 0.27*HO2 + LIMONNO3_LIMONNO (481) LIMONNO3 + LIMONNO3 -> 0.42*TERPNT1 + 0.99*HO2 + 0.86*TERPF1 rate = 5.30E-13 (648) + + 0.86*NO2 + 0.72*TERPNS1 + LIMONNO3_NO (482) LIMONNO3 + NO -> 0.07*TERPFDN + 1.36*NO2 + 0.43*TERPF1 rate = 2.70E-12*exp( 360./t) (649) + + 0.17*TERPNT1 + 0.33*TERPNS1 + 0.5*HO2 + LIMONNO3_NO3 (483) LIMONNO3 + NO3 -> 1.46*NO2 + 0.46*TERPF1 + 0.19*TERPNT1 rate = 2.30E-12 (650) + + 0.35*TERPNS1 + 0.54*HO2 + LIMONNO3_TERPA2C (484) LIMONNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 rate = 2.00E-12*exp( 500./t) (651) + + 0.19*TERPNT1 + 0.35*TERPNS1 + 0.54*HO2 + LIMONNO3_TERPA3C (485) LIMONNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 rate = 2.00E-12*exp( 500./t) (652) + + 0.19*TERPNT1 + 0.35*TERPNS1 + 0.54*HO2 + LIMONNO3_TERPACO (486) LIMONNO3 + TERPACO3 -> TERPA1O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 rate = 2.00E-12*exp( 500./t) (653) + + 0.19*TERPNT1 + 0.35*TERPNS1 + 0.54*HO2 + LIMONO2_CH3CO3 (487) LIMONO2 + CH3CO3 -> TERPF1 + 0.56*CH2O + HO2 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (654) + LIMONO2_CH3O2 (488) LIMONO2 + CH3O2 -> 0.25*CH3OH + TERPF1 + 1.03*CH2O + HO2 rate = 2.00E-12 (655) + LIMONO2_HO2 (489) LIMONO2 + HO2 -> 0.9*TERP1OOH + 0.1*TERPF1 + 0.1*OH + 0.1*HO2 rate = 2.60E-13*exp( 1300./t) (656) + + 0.06*CH2O + LIMONO2_NO (490) LIMONO2 + NO -> 0.17*TERPNT1 + 0.06*TERPNS1 + 0.77*NO2 rate = 2.70E-12*exp( 360./t) (657) + + 0.77*TERPF1 + 0.77*HO2 + 0.43*CH2O + LIMONO2_NO3 (491) LIMONO2 + NO3 -> NO2 + TERPF1 + HO2 + 0.56*CH2O rate = 2.30E-12 (658) + LIMONO2_TERPA2CO (492) LIMONO2 + TERPA2CO3 -> TERPF1 + 0.56*CH2O + HO2 + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (659) + LIMONO2_TERPA3CO (493) LIMONO2 + TERPA3CO3 -> TERPF1 + 0.56*CH2O + HO2 + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (660) + LIMONO2_TERPACO3 (494) LIMONO2 + TERPACO3 -> TERPF1 + 0.56*CH2O + HO2 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (661) + LIMON_O3 (495) LIMON + O3 -> 0.66*OH + 0.66*TERPF1 + 0.33*CH3CO3 + 0.33*CH2O rate = 2.80E-15*exp( -770./t) (662) + + 0.33*TERPA3CO3 + 0.33*H2O2 + 0.01*TERPACID + LIMON_OH (496) LIMON + OH -> LIMONO2 rate = 3.41E-11*exp( 470./t) (663) + MYRC_NO3 (497) MYRC + NO3 -> MYRCNO3 rate = 1.10E-11 (664) + MYRCNO3_CH3CO3 (498) MYRCNO3 + CH3CO3 -> CH3O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 rate = 2.00E-12*exp( 500./t) (665) + + 0.04*CH2O + 0.05*TERPNS1 + 0.05*HO2 + + 0.91*CH3COCH3 + MYRCNO3_CH3O2 (499) MYRCNO3 + CH3O2 -> 0.14*TERPNS1 + 0.98*CH2O + 0.77*TERPF2 rate = 2.00E-12 (666) + + 0.77*NO2 + 0.87*HO2 + 0.74*CH3COCH3 + + 0.09*TERPNT1 + 0.05*CH3OH + MYRCNO3_HO2 (500) MYRCNO3 + HO2 -> 0.48*OH + 0.48*TERPF2 + 0.02*CH2O + 0.48*NO2 rate = 2.71E-13*exp( 1300./t) (667) + + 0.46*CH3COCH3 + 0.36*TERPNPS1 + 0.16*TERPNPT1 + MYRCNO3_MYRCNO3 (501) MYRCNO3 + MYRCNO3 -> 0.19*TERPNS1 + 0.27*TERPNT1 + 1.54*NO2 rate = 5.30E-13 (668) + + 1.54*TERPF2 + 1.48*CH3COCH3 + 0.06*CH2O + MYRCNO3_NO (502) MYRCNO3 + NO -> 0.07*TERPFDN + 1.82*NO2 + 0.89*TERPF2 + 0.04*CH2O rate = 2.70E-12*exp( 360./t) (669) + + 0.04*TERPNS1 + 0.04*HO2 + 0.85*CH3COCH3 + MYRCNO3_NO3 (503) MYRCNO3 + NO3 -> 1.95*NO2 + 0.95*TERPF2 + 0.04*CH2O + 0.05*TERPNS1 rate = 2.30E-12 (670) + + 0.05*HO2 + 0.91*CH3COCH3 + MYRCNO3_TERPA2CO (504) MYRCNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 rate = 2.00E-12*exp( 500./t) (671) + + 0.04*CH2O + 0.05*TERPNS1 + 0.05*HO2 + + 0.91*CH3COCH3 + MYRCNO3_TERPA3CO (505) MYRCNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 rate = 2.00E-12*exp( 500./t) (672) + + 0.04*CH2O + 0.05*TERPNS1 + 0.05*HO2 + + 0.91*CH3COCH3 + MYRCNO3_TERPACO3 (506) MYRCNO3 + TERPACO3 -> TERPA1O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 rate = 2.00E-12*exp( 500./t) (673) + + 0.04*CH2O + 0.05*TERPNS1 + 0.05*HO2 + + 0.91*CH3COCH3 + MYRCO2_CH3CO3 (507) MYRCO2 + CH3CO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O + CH3O2 rate = 2.00E-12*exp( 500./t) (674) + + CO2 + MYRCO2_CH3O2 (508) MYRCO2 + CH3O2 -> 0.25*CH3OH + TERPF2 + 0.75*CH2O + HO2 rate = 2.00E-12 (675) + MYRCO2_HO2 (509) MYRCO2 + HO2 -> 0.9*TERP2AOOH + 0.1*TERPF2 + 0.1*OH + 0.1*HO2 rate = 2.60E-13*exp( 1300./t) (676) + + 0.05*CH3COCH3 + 0.04*CH2O + MYRCO2_NO (510) MYRCO2 + NO -> 0.1*TERPNS1 + 0.19*TERPNT1 + 0.71*NO2 + 0.71*TERPF2 rate = 2.70E-12*exp( 360./t) (677) + + 0.33*CH3COCH3 + 0.3*CH2O + 0.71*HO2 + MYRCO2_NO3 (511) MYRCO2 + NO3 -> NO2 + TERPF2 + 0.46*CH3COCH3 + 0.42*CH2O + HO2 rate = 2.30E-12 (678) + MYRCO2_TERPA2CO3 (512) MYRCO2 + TERPA2CO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O rate = 2.00E-12*exp( 500./t) (679) + + TERPA2O2 + CO2 + MYRCO2_TERPA3CO3 (513) MYRCO2 + TERPA3CO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O rate = 2.00E-12*exp( 500./t) (680) + + TERPA4O2 + CO2 + MYRCO2_TERPACO3 (514) MYRCO2 + TERPACO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O rate = 2.00E-12*exp( 500./t) (681) + + TERPA1O2 + CO2 + MYRC_O3 (515) MYRC + O3 -> TERPF2 + 0.63*OH + 0.63*HO2 + 0.25*CH3COCH3 rate = 2.65E-15*exp( -520./t) (682) + + 0.39*CH2O + 0.18*HYAC + MYRC_OH (516) MYRC + OH -> MYRCO2 rate = 2.10E-10 (683) + tag_TERPA2CO3_NO (517) TERPA2CO3 + NO2 + M -> TERPA2PAN + M troe : ko=9.70E-29*(300/t)**5.60 (684) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + tag_TERPA3CO3_NO (518) TERPA3CO3 + NO2 + M -> TERPA3PAN + M troe : ko=9.70E-29*(300/t)**5.60 (685) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + tag_TERPACO3_NO2 (519) TERPACO3 + NO2 + M -> TERPAPAN + M troe : ko=9.70E-29*(300/t)**5.60 (686) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + TERP1OOHO2_HO2 (520) TERP1OOHO2 + HO2 -> 0.82*TERPDHDP + 0.18*TERPOOHL + 0.18*OH rate = 2.71E-13*exp( 1300./t) (687) + + 0.18*HO2 + 0.08*CH2O + TERP1OOHO2_NO (521) TERP1OOHO2 + NO -> 0.3*TERPHFN + 0.7*NO2 + 0.7*TERPOOHL + 0.31*CH2O rate = 2.70E-12*exp( 360./t) (688) + + 0.7*HO2 + TERP1OOH_OH (522) TERP1OOH + OH -> TERP1OOHO2 rate = 8.90E-11 (689) + TERP2AOOH_OH (523) TERP2AOOH + OH -> TERP2OOHO2 rate = 8.90E-11 (690) + TERP2OOHO2_HO2 (524) TERP2OOHO2 + HO2 -> 0.82*TERPDHDP + 0.18*TERP1OOH + 0.18*OH rate = 2.71E-13*exp( 1300./t) (691) + + 0.18*HO2 + TERP2OOHO2_NO (525) TERP2OOHO2 + NO -> 0.3*TERPHFN + 0.7*NO2 + 0.7*TERP1OOH + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (692) + TERPA1O2_CH3CO3 (526) TERPA1O2 + CH3CO3 -> TERPA2O2 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (693) + TERPA1O2_CH3O2 (527) TERPA1O2 + CH3O2 -> 0.25*CH3OH + 0.75*CH2O + 0.5*HO2 + 0.5*TERPA2 rate = 2.00E-12 (694) + + 0.5*TERPA2O2 + TERPA1O2_HO2 (528) TERPA1O2 + HO2 -> TERPOOH rate = 2.54E-13*exp( 1300./t) (695) + TERPA1O2_NO (529) TERPA1O2 + NO -> 0.3*TERPNS + 0.7*NO2 + 0.7*TERPA2O2 rate = 2.70E-12*exp( 360./t) (696) + TERPA1O2_NO3 (530) TERPA1O2 + NO3 -> NO2 + TERPA2O2 rate = 2.30E-12 (697) + TERPA1O2_TERPA2C (531) TERPA1O2 + TERPA2CO3 -> 2*TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (698) + TERPA1O2_TERPA3C (532) TERPA1O2 + TERPA3CO3 -> TERPA2O2 + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (699) + TERPA1O2_TERPACO (533) TERPA1O2 + TERPACO3 -> TERPA2O2 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (700) + TERPA2CO3_CH3CO3 (534) TERPA2CO3 + CH3CO3 -> 2*CO2 + TERPA2O2 + CH3O2 rate = 2.90E-12*exp( 500./t) (701) + TERPA2CO3_CH3O2 (535) TERPA2CO3 + CH3O2 -> CO2 + TERPA2O2 + CH2O + HO2 rate = 2.00E-12*exp( 500./t) (702) + TERPA2CO3_HO2 (536) TERPA2CO3 + HO2 -> 0.15*O3 + 0.51*TERPACID2 + 0.49*OH + 0.49*CO2 rate = 4.30E-13*exp( 1040./t) (703) + + 0.49*TERPA2O2 + TERPA2CO3_NO (537) TERPA2CO3 + NO -> NO2 + CO2 + TERPA2O2 rate = 8.10E-12*exp( 270./t) (704) + TERPA2CO3_NO3 (538) TERPA2CO3 + NO3 -> NO2 + CO2 + TERPA2O2 rate = 4.00E-12 (705) + TERPA2CO3_TERPA2 (539) TERPA2CO3 + TERPA2CO3 -> 2*CO2 + 2*TERPA2O2 rate = 2.90E-12*exp( 500./t) (706) + TERPA2CO3_TERPAC (540) TERPA2CO3 + TERPACO3 -> 2*CO2 + TERPA2O2 + TERPA1O2 rate = 2.90E-12*exp( 500./t) (707) + TERPA2_NO3 (541) TERPA2 + NO3 -> HNO3 + TERPA2CO3 rate = 2.00E-14 (708) + TERPA2O2_CH3CO3 (542) TERPA2O2 + CH3CO3 -> TERPA3O2 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (709) + TERPA2O2_CH3O2 (543) TERPA2O2 + CH3O2 -> TERPA3O2 + CH2O + HO2 rate = 2.00E-12 (710) + TERPA2O2_HO2 (544) TERPA2O2 + HO2 -> 0.62*TERPOOH + 0.38*TERPA3O2 + 0.38*OH rate = 2.62E-13*exp( 1300./t) (711) + TERPA2O2_NO (545) TERPA2O2 + NO -> 0.17*TERPNT + 0.83*NO2 + 0.83*TERPA3O2 rate = 2.70E-12*exp( 360./t) (712) + TERPA2O2_NO3 (546) TERPA2O2 + NO3 -> NO2 + TERPA3O2 rate = 2.30E-12 (713) + TERPA2O2_TERPA2C (547) TERPA2O2 + TERPA2CO3 -> TERPA3O2 + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (714) + TERPA2O2_TERPA3C (548) TERPA2O2 + TERPA3CO3 -> TERPA3O2 + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (715) + TERPA2O2_TERPACO (549) TERPA2O2 + TERPACO3 -> TERPA3O2 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (716) + TERPA2_OH (550) TERPA2 + OH -> TERPA2CO3 rate = 5.20E-12*exp( 600./t) (717) + TERPA2PAN_OH (551) TERPA2PAN + OH -> CH3COCH3 + 2*CO2 + 2*CH2O + NO2 + 2*CO + HO2 rate = 2.52E-11 (718) + TERPA3CO3_CH3CO3 (552) TERPA3CO3 + CH3CO3 -> 2*CO2 + TERPA4O2 + CH3O2 rate = 2.90E-12*exp( 500./t) (719) + TERPA3CO3_CH3O2 (553) TERPA3CO3 + CH3O2 -> CO2 + TERPA4O2 + CH2O + HO2 rate = 2.00E-12*exp( 500./t) (720) + TERPA3CO3_HO2 (554) TERPA3CO3 + HO2 -> 0.15*O3 + 0.51*TERPACID3 + 0.49*OH + 0.49*CO2 rate = 4.30E-13*exp( 1040./t) (721) + + 0.49*TERPA4O2 + TERPA3CO3_NO (555) TERPA3CO3 + NO -> NO2 + CO2 + TERPA4O2 rate = 8.10E-12*exp( 270./t) (722) + TERPA3CO3_NO3 (556) TERPA3CO3 + NO3 -> NO2 + CO2 + TERPA4O2 rate = 4.00E-12 (723) + TERPA3CO3_TERPA2 (557) TERPA3CO3 + TERPA2CO3 -> 2*CO2 + TERPA4O2 + TERPA2O2 rate = 2.90E-12*exp( 500./t) (724) + TERPA3CO3_TERPA3 (558) TERPA3CO3 + TERPA3CO3 -> 2*CO2 + 2*TERPA4O2 rate = 2.90E-12*exp( 500./t) (725) + TERPA3CO3_TERPAC (559) TERPA3CO3 + TERPACO3 -> 2*CO2 + TERPA4O2 + TERPA1O2 rate = 2.90E-12*exp( 500./t) (726) + TERPA3_NO3 (560) TERPA3 + NO3 -> HNO3 + TERPA3CO3 rate = 2.00E-14 (727) + TERPA3O2_CH3CO3 (561) TERPA3O2 + CH3CO3 -> TERPA4O2 + CH3COCH3 + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (728) + TERPA3O2_CH3O2 (562) TERPA3O2 + CH3O2 -> TERPA4O2 + CH3COCH3 + CH2O + HO2 rate = 2.00E-12 (729) + TERPA3O2_HO2 (563) TERPA3O2 + HO2 -> 0.85*TERPOOHL + 0.15*TERPA4O2 + 0.15*OH rate = 2.66E-13*exp( 1300./t) (730) + + 0.15*CH3COCH3 + TERPA3O2_NO (564) TERPA3O2 + NO -> 0.3*TERPNT + 0.7*NO2 + 0.7*TERPA4O2 + 0.7*CH3COCH3 rate = 2.70E-12*exp( 360./t) (731) + TERPA3O2_NO3 (565) TERPA3O2 + NO3 -> NO2 + TERPA4O2 + CH3COCH3 rate = 2.30E-12 (732) + TERPA3O2_TERPA2C (566) TERPA3O2 + TERPA2CO3 -> TERPA4O2 + CH3COCH3 + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (733) + TERPA3O2_TERPA3C (567) TERPA3O2 + TERPA3CO3 -> 2*TERPA4O2 + CH3COCH3 + CO2 rate = 2.00E-12*exp( 500./t) (734) + TERPA3O2_TERPACO (568) TERPA3O2 + TERPACO3 -> TERPA4O2 + CH3COCH3 + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (735) + TERPA3_OH (569) TERPA3 + OH -> 0.75*TERPA3CO3 + 0.25*TERPA4O2 rate = 5.20E-12*exp( 600./t) (736) + TERPA3PAN_OH (570) TERPA3PAN + OH -> CO + NO2 + 3*CO2 + 2*CH3CO3 + CH2O + HO2 rate = 1.92E-11 (737) + TERPA4O2_CH3CO3 (571) TERPA4O2 + CH3CO3 -> CH3CO3 + HO2 + 2*CH2O + CO + CH3O2 + CO2 rate = 2.00E-12*exp( 500./t) (738) + TERPA4O2_CH3O2 (572) TERPA4O2 + CH3O2 -> CH3CO3 + 2*HO2 + 3*CH2O + CO rate = 2.00E-12 (739) + TERPA4O2_HO2 (573) TERPA4O2 + HO2 -> 0.47*TERPOOHL + 0.53*CH3CO3 + 0.53*HO2 rate = 2.51E-13*exp( 1300./t) (740) + + 1.06*CH2O + 0.53*CO + 0.53*OH + TERPA4O2_NO (574) TERPA4O2 + NO -> 0.09*TERPNS + 0.91*NO2 + 0.91*CH3CO3 + 0.91*HO2 rate = 2.70E-12*exp( 360./t) (741) + + 1.82*CH2O + 0.91*CO + TERPA4O2_NO3 (575) TERPA4O2 + NO3 -> NO2 + CH3CO3 + HO2 + 2*CH2O + CO rate = 2.30E-12 (742) + TERPA4O2_TERPA2C (576) TERPA4O2 + TERPA2CO3 -> CH3CO3 + HO2 + 2*CH2O + CO + TERPA2O2 + CO2 rate = 2.00E-12*exp( 500./t) (743) + TERPA4O2_TERPA3C (577) TERPA4O2 + TERPA3CO3 -> CH3CO3 + HO2 + 2*CH2O + CO + TERPA4O2 + CO2 rate = 2.00E-12*exp( 500./t) (744) + TERPA4O2_TERPACO (578) TERPA4O2 + TERPACO3 -> CH3CO3 + HO2 + 2*CH2O + CO + TERPA1O2 + CO2 rate = 2.00E-12*exp( 500./t) (745) + TERPACID2_OH (579) TERPACID2 + OH -> 0.71*TERPA2CO3 + 0.29*CO2 + 0.29*TERPA2O2 rate = 8.80E-12 (746) + TERPACID3_OH (580) TERPACID3 + OH -> 0.71*TERPA3CO3 + 0.29*CO2 + 0.29*TERPA4O2 rate = 8.80E-12 (747) + TERPACID_OH (581) TERPACID + OH -> 0.71*TERPACO3 + 0.29*CO2 + 0.29*TERPA1O2 rate = 8.80E-12 (748) + TERPACO3_CH3CO3 (582) TERPACO3 + CH3CO3 -> 2*CO2 + TERPA1O2 + CH3O2 rate = 2.90E-12*exp( 500./t) (749) + TERPACO3_CH3O2 (583) TERPACO3 + CH3O2 -> CO2 + TERPA1O2 + CH2O + HO2 rate = 2.00E-12*exp( 500./t) (750) + TERPACO3_HO2 (584) TERPACO3 + HO2 -> 0.15*O3 + 0.51*TERPACID + 0.49*OH + 0.49*CO2 rate = 4.30E-13*exp( 1040./t) (751) + + 0.49*TERPA1O2 + TERPACO3_NO (585) TERPACO3 + NO -> NO2 + CO2 + TERPA1O2 rate = 8.10E-12*exp( 270./t) (752) + TERPACO3_NO3 (586) TERPACO3 + NO3 -> NO2 + CO2 + TERPA1O2 rate = 4.00E-12 (753) + TERPACO3_TERPACO (587) TERPACO3 + TERPACO3 -> 2*CO2 + 2*TERPA1O2 rate = 2.90E-12*exp( 500./t) (754) + TERPA_NO3 (588) TERPA + NO3 -> HNO3 + TERPACO3 rate = 2.00E-14 (755) + TERPA_OH (589) TERPA + OH -> 0.77*TERPACO3 + 0.23*TERPA2O2 rate = 5.20E-12*exp( 600./t) (756) + TERPAPAN_OH (590) TERPAPAN + OH -> TERPA2 + NO2 + CO rate = 3.66E-12 (757) + TERPDHDP_OH (591) TERPDHDP + OH -> TERPOOH + OH rate = 2.80E-11 (758) + TERPF1_NO3 (592) TERPF1 + NO3 -> NO2 + 0.44*CH2O + TERPA3 rate = 2.60E-13 (759) + TERPF1O2_HO2 (593) TERPF1O2 + HO2 -> 0.9*TERPOOHL + 0.1*OH + 0.1*HO2 + 0.1*TERPA3 rate = 2.68E-13*exp( 1300./t) (760) + + 0.04*CH2O + TERPF1O2_NO (594) TERPF1O2 + NO -> 0.3*TERPHFN + 0.7*NO2 + 0.7*HO2 + 0.7*TERPA3 rate = 2.70E-12*exp( 360./t) (761) + + 0.31*CH2O + TERPF1_O3 (595) TERPF1 + O3 -> 0.09*OH + TERPA3 + 0.62*CH2O + 0.23*HMHP + 0.02*H2O2 rate = 8.30E-18 (762) + + 0.15*HCOOH + TERPF1_OH (596) TERPF1 + OH -> 0.83*TERPF1O2 + 0.17*TERPA3CO3 rate = 1.10E-10 (763) + TERPF2_NO3 (597) TERPF2 + NO3 -> 0.5*TERPNS1 + 0.5*HO2 + 0.5*TERPF1 + 0.5*CH2O rate = 2.95E-12*exp( -450./t) (764) + + 0.5*NO2 + TERPF2O2_HO2 (598) TERPF2O2 + HO2 -> 0.9*TERP1OOH + 0.1*OH + 0.1*HO2 + 0.1*TERPF1 rate = 2.47E-13*exp( 1300./t) (765) + TERPF2O2_NO (599) TERPF2O2 + NO -> 0.18*TERPNT1 + 0.12*TERPNS1 + 0.7*NO2 + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (766) + + 0.7*TERPF1 + TERPF2_O3 (600) TERPF2 + O3 -> TERPF1 + 0.34*CH2O + 0.4*HMHP + 0.04*H2O2 rate = 1.10E-16 (767) + + 0.26*HCOOH + TERPF2_OH (601) TERPF2 + OH -> TERPF2O2 rate = 2.70E-11*exp( 390./t) (768) + TERPFDN_OH (602) TERPFDN + OH -> NO2 + TERPNS rate = 3.64E-12 (769) + TERPHFN_OH (603) TERPHFN + OH -> TERPNS + OH rate = 2.80E-11 (770) + TERPK_OH (604) TERPK + OH -> 0.14*TERPA2CO3 + 0.86*TERPA1O2 rate = 1.70E-11 (771) + TERPNPS1O2_HO2 (605) TERPNPS1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNPS + 0.1*HO2 rate = 2.76E-13*exp( 1300./t) (772) + TERPNPS1O2_NO (606) TERPNPS1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNPS + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (773) + TERPNPS1_OH (607) TERPNPS1 + OH -> TERPNPS1O2 rate = 1.10E-10 (774) + TERPNPS_OH (608) TERPNPS + OH -> H2O + BPINNO3 rate = 9.58E-12 (775) + TERPNPT1O2_HO2 (609) TERPNPT1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNPT + 0.1*HO2 rate = 2.76E-13*exp( 1300./t) (776) + TERPNPT1O2_NO (610) TERPNPT1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNPT + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (777) + TERPNPT1_OH (611) TERPNPT1 + OH -> TERPNPT1O2 rate = 1.10E-10 (778) + TERPNPT_OH (612) TERPNPT + OH -> TERPNT + H2O + OH rate = 1.23E-11 (779) + TERPNS1O2_HO2 (613) TERPNS1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNS + 0.1*HO2 rate = 2.75E-13*exp( 1300./t) (780) + TERPNS1O2_NO (614) TERPNS1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNS + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (781) + TERPNS1_OH (615) TERPNS1 + OH -> TERPNS1O2 rate = 1.10E-10 (782) + TERPNS_OH (616) TERPNS + OH -> TERPA + NO2 rate = 3.64E-12 (783) + TERPNT1O2_HO2 (617) TERPNT1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNT + 0.1*HO2 rate = 2.75E-13*exp( 1300./t) (784) + TERPNT1O2_NO (618) TERPNT1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNT + 0.7*HO2 rate = 2.70E-12*exp( 360./t) (785) + TERPNT1_OH (619) TERPNT1 + OH -> TERPNT1O2 rate = 1.10E-10 (786) + TERPNT_OH (620) TERPNT + OH -> TERPA + NO2 rate = 5.50E-12 (787) + TERPOOHL_OH (621) TERPOOHL + OH -> TERPA3 + OH rate = 4.65E-11 (788) + TERPOOH_OH (622) TERPOOH + OH -> TERPA + OH rate = 2.80E-11 (789) + usr_TERPA2PAN_M (623) TERPA2PAN + M -> M + TERPA2CO3 + NO2 rate = ** User defined ** (790) + usr_TERPA3PAN_M (624) TERPA3PAN + M -> TERPA3CO3 + NO2 + M rate = ** User defined ** (791) + usr_TERPAPAN_M (625) TERPAPAN + M -> TERPACO3 + NO2 + M rate = ** User defined ** (792) + DMS_NO3 (626) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (793) + DMS_OHa (627) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (794) + OCS_O (628) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (795) + OCS_OH (629) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (796) + S_O2 (630) S + O2 -> SO + O rate = 2.30E-12 (797) + SO2_OH_M (631) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (798) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + S_O3 (632) S + O3 -> SO + O2 rate = 1.20E-11 (799) + SO_BRO (633) SO + BRO -> SO2 + BR rate = 5.70E-11 (800) + SO_CLO (634) SO + CLO -> SO2 + CL rate = 2.80E-11 (801) + S_OH (635) S + OH -> SO + H rate = 6.60E-11 (802) + SO_NO2 (636) SO + NO2 -> SO2 + NO rate = 1.40E-11 (803) + SO_O2 (637) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (804) + SO_O3 (638) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (805) + SO_OCLO (639) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (806) + SO_OH (640) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (807) + usr_DMS_OH (641) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (808) + usr_SO3_H2O (642) SO3 + H2O -> H2SO4 rate = ** User defined ** (809) + NH3_OH (643) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (810) + usr_GLYOXAL_aer (644) GLYOXAL -> SOAG0 rate = ** User defined ** (811) + usr_HO2_aer (645) HO2 -> H2O rate = ** User defined ** (812) + usr_HONITR_aer (646) HONITR -> HNO3 rate = ** User defined ** (813) + usr_ICHE_aer (647) ICHE -> (No products) rate = ** User defined ** (814) + usr_IEPOX_aer (648) IEPOX -> (No products) rate = ** User defined ** (815) + usr_INHEB_aer (649) INHEB -> HNO3 rate = ** User defined ** (816) + usr_INHED_aer (650) INHED -> HNO3 rate = ** User defined ** (817) + usr_INOOHD_aer (651) ISOPNOOHD -> HNO3 rate = ** User defined ** (818) + usr_ISOPFDN_aer (652) ISOPFDN -> HNO3 rate = ** User defined ** (819) + usr_ISOPFDNC_aer (653) ISOPFDNC -> HNO3 rate = ** User defined ** (820) + usr_ISOPFNC_aer (654) ISOPFNC -> (No products) rate = ** User defined ** (821) + usr_ISOPFNP_aer (655) ISOPFNP -> (No products) rate = ** User defined ** (822) + usr_ISOPHFP_aer (656) ISOPHFP -> (No products) rate = ** User defined ** (823) + usr_ISOPN1D_aer (657) ISOPN1D -> HNO3 rate = ** User defined ** (824) + usr_ISOPN2B_aer (658) ISOPN2B -> HNO3 rate = ** User defined ** (825) + usr_ISOPN4D_aer (659) ISOPN4D -> HNO3 rate = ** User defined ** (826) + usr_N2O5_aer (660) N2O5 -> 2*HNO3 rate = ** User defined ** (827) + usr_NC4CHO_aer (661) NC4CHO -> HNO3 rate = ** User defined ** (828) + usr_NH4_strat_ta (662) NH4 -> NHDEP rate = 6.34E-08 (829) + usr_NO2_aer (663) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (830) + usr_NO3_aer (664) NO3 -> HNO3 rate = ** User defined ** (831) + usr_ONITR_aer (665) ONITR -> HNO3 rate = ** User defined ** (832) + usr_SQTN_aer (666) SQTN -> (No products) rate = ** User defined ** (833) + usr_TERPDHDP_aer (667) TERPDHDP -> (No products) rate = ** User defined ** (834) + usr_TERPFDN_aer (668) TERPFDN -> HNO3 rate = ** User defined ** (835) + usr_TERPHFN_aer (669) TERPHFN -> (No products) rate = ** User defined ** (836) + usr_TERPNPT1_aer (670) TERPNPT1 -> HNO3 rate = ** User defined ** (837) + usr_TERPNPT_aer (671) TERPNPT -> HNO3 rate = ** User defined ** (838) + usr_TERPNT1_aer (672) TERPNT1 -> HNO3 rate = ** User defined ** (839) + usr_TERPNT_aer (673) TERPNT -> HNO3 rate = ** User defined ** (840) + APIN_NO3_vbs (674) APIN + NO3 -> APIN + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.20E-12*exp( 490./t) (841) + APINO2_HO2_vbs (675) APINO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 2.60E-13*exp( 1300./t) (842) + + 0.0554*SOAG3 + 0.1278*SOAG4 + APINO2_NO_vbs (676) APINO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (843) + + 0.0332*SOAG3 + 0.13*SOAG4 + APIN_O3_vbs (677) APIN + O3 -> APIN + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 8.05E-16*exp( -640./t) (844) + + 0.0554*SOAG3 + 0.1278*SOAG4 + APIN_OH_vbs (678) APIN + OH -> APIN + OH + APINO2VBS rate = 1.34E-11*exp( 410./t) (845) + BCARY_NO3_vbs (679) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.90E-11 (846) + BCARYO2_HO2_vbs (680) BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 2.75E-13*exp( 1300./t) (847) + + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 + BCARYO2_NO_vbs (681) BCARYO2VBS + NO -> NO + 0.1279*SOAG0 + 0.1792*SOAG1 + 0.0676*SOAG2 rate = 2.70E-12*exp( 360./t) (848) + + 0.079*SOAG3 + 0.1254*SOAG4 + BCARY_O3_vbs (682) BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 1.20E-14 (849) + + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 + BCARY_OH_vbs (683) BCARY + OH -> BCARY + OH + BCARYO2VBS rate = 2.00E-10 (850) + BENZENE_OH_vbs (684) BENZENE + OH -> BENZENE + OH + BENZO2VBS rate = 2.30E-12*exp( -193./t) (851) + BENZO2_HO2_vbs (685) BENZO2VBS + HO2 -> HO2 + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 rate = 7.50E-13*exp( 700./t) (852) + + 0.0443*SOAG3 + 0.1621*SOAG4 + BENZO2_NO_vbs (686) BENZO2VBS + NO -> NO + 0.0097*SOAG0 + 0.0034*SOAG1 + 0.1579*SOAG2 rate = 2.60E-12*exp( 365./t) (853) + + 0.0059*SOAG3 + 0.0536*SOAG4 + BPIN_NO3_vbs (687) BPIN + NO3 -> BPIN + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 2.50E-12 (854) + BPINO2_HO2_vbs (688) BPINO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 2.60E-13*exp( 1300./t) (855) + + 0.0554*SOAG3 + 0.1278*SOAG4 + BPINO2_NO_vbs (689) BPINO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (856) + + 0.0332*SOAG3 + 0.13*SOAG4 + BPIN_O3_vbs (690) BPIN + O3 -> BPIN + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 1.35E-15*exp( -1270./t) (857) + + 0.0554*SOAG3 + 0.1278*SOAG4 + BPIN_OH_vbs (691) BPIN + OH -> BPIN + OH + BPINO2VBS rate = 1.62E-11*exp( 460./t) (858) + ISOP_NO3_vbs (692) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 rate = 2.95E-12*exp( -450./t) (859) + ISOPO2_HO2_vbs (693) ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 rate = 2.12E-13*exp( 1300./t) (860) + + 0.0271*SOAG3 + 0.0474*SOAG4 + ISOPO2_NO_vbs (694) ISOPO2VBS + NO -> NO + 0.0003*SOAG0 + 0.0003*SOAG1 + 0.0073*SOAG2 rate = 2.70E-12*exp( 360./t) (861) + + 0.0057*SOAG3 + 0.0623*SOAG4 + ISOP_O3_vbs (695) ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 rate = 1.03E-14*exp( -1995./t) (862) + ISOP_OH_vbs (696) ISOP + OH -> ISOP + OH + ISOPO2VBS rate = 2.70E-11*exp( 390./t) (863) + IVOCO2_HO2_vbs (697) IVOCO2VBS + HO2 -> HO2 + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 rate = 7.50E-13*exp( 700./t) (864) + + 0.0076*SOAG3 + 0.0113*SOAG4 + IVOCO2_NO_vbs (698) IVOCO2VBS + NO -> NO + 0.1056*SOAG0 + 0.1026*SOAG1 + 0.0521*SOAG2 rate = 2.60E-12*exp( 365./t) (865) + + 0.0143*SOAG3 + 0.0166*SOAG4 + IVOC_OH_vbs (699) IVOC + OH -> OH + IVOCO2VBS rate = 1.34E-11 (866) + LIMON_NO3_vbs (700) LIMON + NO3 -> LIMON + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.20E-11 (867) + LIMONO2_HO2_vbs (701) LIMONO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 2.60E-13*exp( 1300./t) (868) + + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 + LIMONO2_NO_vbs (702) LIMONO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (869) + + 0.0332*SOAG3 + 0.13*SOAG4 + LIMON_O3_vbs (703) LIMON + O3 -> LIMON + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 2.80E-15*exp( -770./t) (870) + + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 + LIMON_OH_vbs (704) LIMON + OH -> LIMON + OH + LIMONO2VBS rate = 3.41E-11*exp( 470./t) (871) + MYRC_NO3_vbs (705) MYRC + NO3 -> MYRC + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.10E-11 (872) + MYRCO2_HO2_vbs (706) MYRCO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 2.60E-13*exp( 1300./t) (873) + + 0.0554*SOAG3 + 0.1278*SOAG4 + MYRCO2_NO_vbs (707) MYRCO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (874) + + 0.0332*SOAG3 + 0.13*SOAG4 + MYRC_O3_vbs (708) MYRC + O3 -> MYRC + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 rate = 2.65E-15*exp( -520./t) (875) + + 0.0554*SOAG3 + 0.1278*SOAG4 + MYRC_OH_vbs (709) MYRC + OH -> MYRC + OH + MYRCO2VBS rate = 2.10E-10 (876) + SVOC_OH (710) SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 rate = 1.34E-11 (877) + + 0.0085*SOAG3 + 0.0128*SOAG4 + TOLUENE_OH_vbs (711) TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS rate = 1.70E-12*exp( 352./t) (878) + TOLUO2_HO2_vbs (712) TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 rate = 7.50E-13*exp( 700./t) (879) + + 0.2157*SOAG3 + 0.0738*SOAG4 + TOLUO2_NO_vbs (713) TOLUO2VBS + NO -> NO + 0.0154*SOAG0 + 0.0452*SOAG1 + 0.0966*SOAG2 rate = 2.60E-12*exp( 365./t) (880) + + 0.0073*SOAG3 + 0.238*SOAG4 + XYLENES_OH_vbs (714) XYLENES + OH -> XYLENES + OH + XYLEO2VBS rate = 1.70E-11 (881) + XYLEO2_HO2_vbs (715) XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 rate = 7.50E-13*exp( 700./t) (882) + + 0.0512*SOAG3 + 0.1598*SOAG4 + XYLEO2_NO_vbs (716) XYLEO2VBS + NO -> NO + 0.0063*SOAG0 + 0.0237*SOAG1 + 0.0025*SOAG2 rate = 2.60E-12*exp( 365./t) (883) + + 0.011*SOAG3 + 0.1185*SOAG4 + het1 (717) N2O5 -> 2*HNO3 rate = ** User defined ** (884) + het10 (718) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (885) + het11 (719) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (886) + het12 (720) N2O5 -> 2*HNO3 rate = ** User defined ** (887) + het13 (721) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (888) + het14 (722) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (889) + het15 (723) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (890) + het16 (724) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (891) + het17 (725) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (892) + het2 (726) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (893) + het3 (727) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (894) + het4 (728) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (895) + het5 (729) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (896) + het6 (730) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (897) + het7 (731) N2O5 -> 2*HNO3 rate = ** User defined ** (898) + het8 (732) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (899) + het9 (733) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (900) + E90_tau (734) E90 -> {sink} rate = 1.29E-07 (901) + NH_50_tau (735) NH_50 -> (No products) rate = 2.31E-07 (902) + NH_5_tau (736) NH_5 -> (No products) rate = 2.31E-06 (903) + ST80_25_tau (737) ST80_25 -> (No products) rate = 4.63E-07 (904) + +Extraneous prod/loss species + ( 1) num_a4 (dataset) + ( 2) pom_a4 (dataset) + ( 3) bc_a4 (dataset) + ( 4) SVOC (dataset) + ( 5) SO2 (dataset) + ( 6) NO2 (dataset) + ( 7) so4_a1 (dataset) + ( 8) so4_a2 (dataset) + ( 9) so4_a5 (dataset) + (10) CO (dataset) + (11) num_a1 (dataset) + (12) num_a2 (dataset) + (13) num_a5 (dataset) + (14) NO + (15) N + (16) OH + + + Equation Report + + d(ALKNIT)/dt = r244*ALKO2*NO + - j19*ALKNIT - r241*OH*ALKNIT + d(ALKOOH)/dt = r242*ALKO2*HO2 + - j20*ALKOOH - r245*OH*ALKOOH + d(AOA_NH)/dt = 0 + d(APIN)/dt = - r417*NO3*APIN - r435*O3*APIN - r436*OH*APIN + d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(BCARY)/dt = - r437*NO3*BCARY - r455*O3*BCARY - r456*OH*BCARY + d(BENZENE)/dt = - r376*OH*BENZENE + d(BENZOOH)/dt = r377*BENZO2*HO2 + - j21*BENZOOH - r379*OH*BENZOOH + d(BEPOMUC)/dt = .12*r376*BENZENE*OH + - j22*BEPOMUC + d(BIGALD1)/dt = .5*j21*BENZOOH + j22*BEPOMUC + .2*j115*TOLOOH + .06*j116*XYLENOOH + .5*r378*BENZO2*NO + + .2*r405*TOLO2*NO + .06*r411*XYLENO2*NO + - j23*BIGALD1 + d(BIGALD2)/dt = .2*j115*TOLOOH + .2*j116*XYLENOOH + .2*r405*TOLO2*NO + .2*r411*XYLENO2*NO + - j24*BIGALD2 + d(BIGALD3)/dt = .2*j115*TOLOOH + .15*j116*XYLENOOH + .2*r405*TOLO2*NO + .15*r411*XYLENO2*NO + - j25*BIGALD3 + d(BIGALD4)/dt = .21*j116*XYLENOOH + .21*r411*XYLENO2*NO + - j26*BIGALD4 + d(BIGALK)/dt = .19*r475*BPIN*O3 + - r246*OH*BIGALK + d(BIGENE)/dt = - r207*NO3*BIGENE - r208*OH*BIGENE + d(BPIN)/dt = - r457*NO3*BPIN - r475*O3*BPIN - r476*OH*BPIN + d(BR)/dt = j118*BRCL + j119*BRO + j121*BRONO2 + j123*CF2CLBR + j124*CF3BR + 2*j130*CH2BR2 + j131*CH3BR + + 3*j134*CHBR3 + 2*j142*H2402 + j143*HBR + j149*HOBR + r77*O1D*CF2CLBR + 2*r90*BRO*BRO + + r91*BRO*CLO + r92*BRO*CLO + r95*BRO*NO + r98*BRO*O + r99*BRO*OH + r100*HBR*O + r101*HBR*OH + + r103*O1D*CF3BR + 3*r104*O1D*CHBR3 + 2*r105*O1D*H2402 + r106*O1D*HBR + 2*r114*CH2BR2*CL + + 2*r115*CH2BR2*OH + r116*CH3BR*CL + r117*CH3BR*OH + 3*r121*CHBR3*CL + 3*r122*CHBR3*OH + + 2*r126*O1D*CH2BR2 + r127*O1D*CH3BR + r633*SO*BRO + - r87*CH2O*BR - r88*HO2*BR - r89*O3*BR + d(BRCL)/dt = r93*BRO*CLO + r725*HOBR*HCL + r730*HOBR*HCL + - j118*BRCL + d(BRO)/dt = j120*BRONO2 + r89*BR*O3 + r97*BRONO2*O + r102*HOBR*O + r107*O1D*HBR + - j119*BRO - 2*r90*BRO*BRO - r91*CLO*BRO - r92*CLO*BRO - r93*CLO*BRO - r94*HO2*BRO - r95*NO*BRO + - r96*M*NO2*BRO - r98*O*BRO - r99*OH*BRO - r633*SO*BRO + d(BRONO2)/dt = r96*M*BRO*NO2 + - j120*BRONO2 - j121*BRONO2 - r719*BRONO2 - r722*BRONO2 - r727*BRONO2 - r97*O*BRONO2 + d(BRY)/dt = 0 + d(BZALD)/dt = j27*BZOOH + r383*BZOO*NO + - r380*OH*BZALD + d(BZOOH)/dt = r381*BZOO*HO2 + - j27*BZOOH - r382*OH*BZOOH + d(C2H2)/dt = - r153*M*CL*C2H2 - r154*M*OH*C2H2 + d(C2H4)/dt = - r155*M*CL*C2H4 - r156*O3*C2H4 - r183*M*OH*C2H4 + d(C2H5OH)/dt = .4*r157*C2H5O2*C2H5O2 + .2*r158*C2H5O2*CH3O2 + - r161*OH*C2H5OH + d(C2H5OOH)/dt = r159*C2H5O2*HO2 + - j28*C2H5OOH - r162*OH*C2H5OOH + d(C2H6)/dt = - r163*CL*C2H6 - r164*OH*C2H6 + d(C3H6)/dt = .7*j79*MVK + - r186*NO3*C3H6 - r187*O3*C3H6 - r205*M*OH*C3H6 + d(C3H7OOH)/dt = r189*C3H7O2*HO2 + - j29*C3H7OOH - r191*OH*C3H7OOH + d(C3H8)/dt = - r192*OH*C3H8 + d(C6H5OOH)/dt = r384*C6H5O2*HO2 + - j30*C6H5OOH - r386*OH*C6H5OOH + d(CCL4)/dt = - j122*CCL4 - r76*O1D*CCL4 + d(CF2CLBR)/dt = - j123*CF2CLBR - r77*O1D*CF2CLBR + d(CF3BR)/dt = - j124*CF3BR - r103*O1D*CF3BR + d(CFC11)/dt = - j125*CFC11 - r78*O1D*CFC11 + d(CFC113)/dt = - j126*CFC113 - r79*O1D*CFC113 + d(CFC114)/dt = - j127*CFC114 - r80*O1D*CFC114 + d(CFC115)/dt = - j128*CFC115 - r81*O1D*CFC115 + d(CFC12)/dt = - j129*CFC12 - r82*O1D*CFC12 + d(CH2BR2)/dt = - j130*CH2BR2 - r114*CL*CH2BR2 - r115*OH*CH2BR2 - r126*O1D*CH2BR2 + d(CH2O)/dt = .1*j19*ALKNIT + .1*j20*ALKOOH + j37*CH3OOH + .18*j39*CH4 + .5*j41*DHPMPAL + j43*GLYALD + + j45*HCOCH2OOH + j46*HMHP + .33*j47*HONITR + j52*HYAC + j55*HYPERACET + j56*HYPERACET + + j65*ISOPN2B + j66*ISOPN3B + j68*ISOPNBNO3 + j69*ISOPNOOHB + j71*ISOPOOH + j72*MACR + + .25*j74*MACRN + .14*j75*MACROOH + .25*j80*MVKN + .44*j81*MVKOOH + j83*NO3CH2CHO + j84*NOA + + j88*POOH + j89*ROOH + r146*HOCH2OO + 2*r176*EO + r260*ISOPB1O2 + r266*ISOPB4O2 + + r58*CLO*CH3O2 + 2*r135*CH3O2*CH3O2 + r136*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + + .3*r140*CH3OOH*OH + .5*r144*HMHP*OH + r149*O1D*CH4 + r150*O1D*CH4 + r156*C2H4*O3 + + .7*r158*C2H5O2*CH3O2 + r169*CH3CO3*CH3O2 + .5*r173*CH3COOOH*OH + .5*r175*EO2*NO + + .8*r178*GLYALD*OH + .11*r180*HCOCH2OOH*OH + r181*NO3CH2CHO*OH + r182*PAN*OH + .5*r187*C3H6*O3 + + r188*C3H7O2*CH3O2 + .3*r196*HYPERACET*OH + r199*PO2*NO + .8*r201*RO2*CH3O2 + .15*r202*RO2*HO2 + + r203*RO2*NO + .5*r207*BIGENE*NO3 + .5*r210*ENEO2*NO + .14*r214*MACRO2*CH3CO3 + + 1.1*r215*MACRO2*CH3O2 + .08*r216*MACRO2*HO2 + .12*r218*MACR*O3 + r221*MCO3*CH3CO3 + + 2*r222*MCO3*CH3O2 + .49*r223*MCO3*HO2 + 2*r224*MCO3*MCO3 + r225*MCO3*NO + r226*MCO3*NO3 + + .25*r233*MVKO2*CH3CO3 + .87*r234*MVKO2*CH3O2 + .05*r235*MVKO2*HO2 + .6*r236*MVK*O3 + + .4*r241*ALKNIT*OH + .1*r243*ALKO2*NO + .5*r252*ICHE*OH + .4*r255*INHEB*OH + .59*r256*INHED*OH + + r257*ISOPB1O2*CH3CO3 + 1.75*r258*ISOPB1O2*CH3O2 + .06*r259*ISOPB1O2*HO2 + r263*ISOPB4O2*CH3CO3 + + 1.25*r264*ISOPB4O2*CH3O2 + .06*r265*ISOPB4O2*HO2 + .75*r278*ISOPED1O2*CH3O2 + + .75*r282*ISOPED4O2*CH3O2 + .03*r290*ISOPN1DO2*HO2 + .06*r294*ISOPN2BO2*HO2 + + .6*r297*ISOPN3BO2*HO2 + .06*r300*ISOPN4DO2*HO2 + .1*r304*ISOPNBNO3O2*HO2 + + .46*r307*ISOPNO3*CH3CO3 + .71*r308*ISOPNO3*CH3O2 + .24*r309*ISOPNO3*HO2 + + .16*r310*ISOPNO3*ISOPNO3 + .46*r311*ISOPNO3*NO3 + .17*r312*ISOPNOOHBO2*HO2 + + .03*r315*ISOPNOOHDO2*HO2 + 1.01*r319*ISOP*O3 + .75*r325*ISOPZD1O2*CH3O2 + + .75*r329*ISOPZD4O2*CH3O2 + r338*ISOPB1O2*NO + r340*ISOPB4O2*NO + .06*r346*ISOPN1DO2*NO + + .27*r348*ISOPN2BO2*NO + r350*ISOPN3BO2*NO + .13*r352*ISOPN4DO2*NO + .33*r354*ISOPNBNO3O2*NO + + .46*r356*ISOPNO3*NO + .53*r358*ISOPNOOHBO2*NO + .04*r360*ISOPNOOHDO2*NO + .14*r368*MACRO2*NO + + .24*r370*MVKO2*NO + .95*r420*APINNO3*CH3O2 + .27*r427*APINO2*CH3CO3 + .83*r428*APINO2*CH3O2 + + .08*r429*APINO2*HO2 + .21*r430*APINO2*NO + .27*r431*APINO2*NO3 + .27*r432*APINO2*TERPA2CO3 + + .27*r433*APINO2*TERPA3CO3 + .27*r434*APINO2*TERPACO3 + .27*r435*APIN*O3 + + .95*r440*BCARYNO3*CH3O2 + .75*r448*BCARYO2*CH3O2 + .08*r455*BCARY*O3 + .04*r458*BPINNO3*BPINNO3 + + .02*r459*BPINNO3*CH3CO3 + .99*r460*BPINNO3*CH3O2 + .02*r461*BPINNO3*HO2 + .02*r462*BPINNO3*NO + + .02*r463*BPINNO3*NO3 + .02*r464*BPINNO3*TERPA2CO3 + .02*r465*BPINNO3*TERPA3CO3 + + .02*r466*BPINNO3*TERPACO3 + .65*r467*BPINO2*CH3CO3 + 1.4*r468*BPINO2*CH3O2 + + .03*r469*BPINO2*HO2 + .49*r470*BPINO2*NO + .65*r471*BPINO2*NO3 + .65*r472*BPINO2*TERPA2CO3 + + .65*r473*BPINO2*TERPA3CO3 + .65*r474*BPINO2*TERPACO3 + .81*r475*BPIN*O3 + + .91*r479*LIMONNO3*CH3O2 + .56*r487*LIMONO2*CH3CO3 + 1.03*r488*LIMONO2*CH3O2 + + .06*r489*LIMONO2*HO2 + .43*r490*LIMONO2*NO + .56*r491*LIMONO2*NO3 + .56*r492*LIMONO2*TERPA2CO3 + + .56*r493*LIMONO2*TERPA3CO3 + .56*r494*LIMONO2*TERPACO3 + .33*r495*LIMON*O3 + + .04*r498*MYRCNO3*CH3CO3 + .98*r499*MYRCNO3*CH3O2 + .02*r500*MYRCNO3*HO2 + + .06*r501*MYRCNO3*MYRCNO3 + .04*r502*MYRCNO3*NO + .04*r503*MYRCNO3*NO3 + + .04*r504*MYRCNO3*TERPA2CO3 + .04*r505*MYRCNO3*TERPA3CO3 + .04*r506*MYRCNO3*TERPACO3 + + .42*r507*MYRCO2*CH3CO3 + .75*r508*MYRCO2*CH3O2 + .04*r509*MYRCO2*HO2 + .3*r510*MYRCO2*NO + + .42*r511*MYRCO2*NO3 + .42*r512*MYRCO2*TERPA2CO3 + .42*r513*MYRCO2*TERPA3CO3 + + .42*r514*MYRCO2*TERPACO3 + .39*r515*MYRC*O3 + .08*r520*TERP1OOHO2*HO2 + .31*r521*TERP1OOHO2*NO + + .75*r527*TERPA1O2*CH3O2 + r535*TERPA2CO3*CH3O2 + r543*TERPA2O2*CH3O2 + 2*r551*TERPA2PAN*OH + + r553*TERPA3CO3*CH3O2 + r562*TERPA3O2*CH3O2 + r570*TERPA3PAN*OH + 2*r571*TERPA4O2*CH3CO3 + + 3*r572*TERPA4O2*CH3O2 + 1.0599999*r573*TERPA4O2*HO2 + 1.8200001*r574*TERPA4O2*NO + + 2*r575*TERPA4O2*NO3 + 2*r576*TERPA4O2*TERPA2CO3 + 2*r577*TERPA4O2*TERPA3CO3 + + 2*r578*TERPA4O2*TERPACO3 + r583*TERPACO3*CH3O2 + .44*r592*TERPF1*NO3 + .04*r593*TERPF1O2*HO2 + + .31*r594*TERPF1O2*NO + .62*r595*TERPF1*O3 + .5*r597*TERPF2*NO3 + .34*r600*TERPF2*O3 + - j31*CH2O - j32*CH2O - r51*CL*CH2O - r87*BR*CH2O - r131*HO2*CH2O - r132*NO3*CH2O + - r133*O*CH2O - r134*OH*CH2O + d(CH3BR)/dt = - j131*CH3BR - r116*CL*CH3BR - r117*OH*CH3BR - r127*O1D*CH3BR + d(CH3CCL3)/dt = - j132*CH3CCL3 - r118*OH*CH3CCL3 + d(CH3CHO)/dt = .4*j19*ALKNIT + .4*j20*ALKOOH + j28*C2H5OOH + .33*j47*HONITR + j77*MEKOOH + j88*POOH + + 1.6*r157*C2H5O2*C2H5O2 + .8*r158*C2H5O2*CH3O2 + r160*C2H5O2*NO + r161*C2H5OH*OH + + .5*r162*C2H5OOH*OH + .5*r187*C3H6*O3 + .27*r190*C3H7O2*NO + r199*PO2*NO + r207*BIGENE*NO3 + + r210*ENEO2*NO + .2*r227*MEKO2*HO2 + r228*MEKO2*NO + .1*r236*MVK*O3 + .8*r241*ALKNIT*OH + + .4*r243*ALKO2*NO + - j33*CH3CHO - r165*NO3*CH3CHO - r166*OH*CH3CHO + d(CH3CL)/dt = - j133*CH3CL - r119*CL*CH3CL - r120*OH*CH3CL + d(CH3CN)/dt = - r167*OH*CH3CN + d(CH3COCH3)/dt = .25*j19*ALKNIT + .25*j20*ALKOOH + .82*j29*C3H7OOH + .17*j47*HONITR + .82*r188*C3H7O2*CH3O2 + + .82*r190*C3H7O2*NO + .5*r207*BIGENE*NO3 + .5*r210*ENEO2*NO + .1*r215*MACRO2*CH3O2 + + .8*r241*ALKNIT*OH + .25*r243*ALKO2*NO + .12*r427*APINO2*CH3CO3 + .06*r428*APINO2*CH3O2 + + .06*r429*APINO2*HO2 + .09*r430*APINO2*NO + .12*r431*APINO2*NO3 + .12*r432*APINO2*TERPA2CO3 + + .12*r433*APINO2*TERPA3CO3 + .12*r434*APINO2*TERPACO3 + .11*r467*BPINO2*CH3CO3 + + .08*r468*BPINO2*CH3O2 + .08*r470*BPINO2*NO + .11*r471*BPINO2*NO3 + + .11*r472*BPINO2*TERPA2CO3 + .11*r473*BPINO2*TERPA3CO3 + .11*r474*BPINO2*TERPACO3 + + .91*r498*MYRCNO3*CH3CO3 + .74*r499*MYRCNO3*CH3O2 + .46*r500*MYRCNO3*HO2 + + 1.48*r501*MYRCNO3*MYRCNO3 + .85*r502*MYRCNO3*NO + .91*r503*MYRCNO3*NO3 + + .91*r504*MYRCNO3*TERPA2CO3 + .91*r505*MYRCNO3*TERPA3CO3 + .91*r506*MYRCNO3*TERPACO3 + + .46*r507*MYRCO2*CH3CO3 + .05*r509*MYRCO2*HO2 + .33*r510*MYRCO2*NO + .46*r511*MYRCO2*NO3 + + .46*r512*MYRCO2*TERPA2CO3 + .46*r513*MYRCO2*TERPA3CO3 + .46*r514*MYRCO2*TERPACO3 + + .25*r515*MYRC*O3 + r551*TERPA2PAN*OH + r561*TERPA3O2*CH3CO3 + r562*TERPA3O2*CH3O2 + + .15*r563*TERPA3O2*HO2 + .7*r564*TERPA3O2*NO + r565*TERPA3O2*NO3 + r566*TERPA3O2*TERPA2CO3 + + r567*TERPA3O2*TERPA3CO3 + r568*TERPA3O2*TERPACO3 + - j34*CH3COCH3 - r206*OH*CH3COCH3 + d(CH3COCHO)/dt = j26*BIGALD4 + .5*j41*DHPMPAL + .68*j48*HPALD1 + .67*j49*HPALD4 + j54*HYDRALD + + .5*j60*ISOPFDNC + .5*j61*ISOPFNC + .72*j63*ISOPHFP + .25*j74*MACRN + .14*j75*MACROOH + + .25*j80*MVKN + .44*j81*MVKOOH + .4*j115*TOLOOH + .54*j116*XYLENOOH + .51*j117*XYLOLOOH + + r195*HYAC*OH + .7*r196*HYPERACET*OH + r197*NOA*OH + .5*r201*RO2*CH3O2 + + .14*r214*MACRO2*CH3CO3 + .08*r216*MACRO2*HO2 + .88*r218*MACR*O3 + .25*r233*MVKO2*CH3CO3 + + .12*r234*MVKO2*CH3O2 + .05*r235*MVKO2*HO2 + .5*r236*MVK*O3 + .44*r238*MVKOOH*OH + + .38*r247*HPALD1*OH + .03*r248*HPALD4*OH + .46*r251*HYDRALD*OH + .5*r252*ICHE*OH + + .46*r254*IEPOXOO*HO2 + .4*r255*INHEB*OH + .72*r289*ISOPHFP*OH + .17*r292*ISOPN1D*O3 + + .17*r302*ISOPN4D*O3 + .17*r317*ISOPNOOHD*O3 + .1*r332*NC4CHOO2*HO2 + .34*r334*NC4CHO*O3 + + .71*r336*IEPOXOO*NO + .14*r368*MACRO2*NO + .24*r370*MVKO2*NO + .12*r372*NC4CHOO2*NO + + .07*r388*DICARBO2*HO2 + .17*r389*DICARBO2*NO + .07*r394*MDIALO2*HO2 + .17*r395*MDIALO2*NO + + .4*r405*TOLO2*NO + .54*r411*XYLENO2*NO + .51*r414*XYLOLO2*NO + - j35*CH3COCHO - r193*NO3*CH3COCHO - r194*OH*CH3COCHO + d(CH3COOH)/dt = .1*r169*CH3CO3*CH3O2 + .15*r170*CH3CO3*HO2 + .12*r187*C3H6*O3 + .15*r223*MCO3*HO2 + - r172*OH*CH3COOH + d(CH3COOOH)/dt = .36*r170*CH3CO3*HO2 + .36*r223*MCO3*HO2 + - j36*CH3COOOH - r173*OH*CH3COOOH + d(CH3OH)/dt = r136*CH3O2*CH3O2 + .3*r158*C2H5O2*CH3O2 + .5*r201*RO2*CH3O2 + .25*r234*MVKO2*CH3O2 + + .25*r264*ISOPB4O2*CH3O2 + .25*r278*ISOPED1O2*CH3O2 + .25*r282*ISOPED4O2*CH3O2 + + .36*r308*ISOPNO3*CH3O2 + .25*r325*ISOPZD1O2*CH3O2 + .25*r329*ISOPZD4O2*CH3O2 + + .05*r420*APINNO3*CH3O2 + .17*r428*APINO2*CH3O2 + .05*r440*BCARYNO3*CH3O2 + + .25*r448*BCARYO2*CH3O2 + .03*r460*BPINNO3*CH3O2 + .09*r479*LIMONNO3*CH3O2 + + .25*r488*LIMONO2*CH3O2 + .05*r499*MYRCNO3*CH3O2 + .25*r508*MYRCO2*CH3O2 + + .25*r527*TERPA1O2*CH3O2 + - r139*OH*CH3OH + d(CH3OOH)/dt = r137*CH3O2*HO2 + - j37*CH3OOH - r140*OH*CH3OOH + d(CH4)/dt = .1*r187*C3H6*O3 + - j38*CH4 - j39*CH4 - r52*CL*CH4 - r108*F*CH4 - r141*OH*CH4 - r148*O1D*CH4 - r149*O1D*CH4 + - r150*O1D*CH4 + d(CHBR3)/dt = - j134*CHBR3 - r104*O1D*CHBR3 - r121*CL*CHBR3 - r122*OH*CHBR3 + d(CL)/dt = j118*BRCL + 4*j122*CCL4 + j123*CF2CLBR + 2*j125*CFC11 + 2*j126*CFC113 + 2*j127*CFC114 + + j128*CFC115 + 2*j129*CFC12 + 3*j132*CH3CCL3 + j133*CH3CL + 2*j135*CL2 + 2*j136*CL2O2 + + j137*CLO + j138*CLONO2 + j141*COFCL + j144*HCFC141B + j145*HCFC142B + j146*HCFC22 + j147*HCL + + j150*HOCL + r58*CLO*CH3O2 + 2*r59*CLO*CLO + r61*CLO*CLO + r63*CLO*NO + r68*CLO*O + r69*CLO*OH + + r71*HCL*O + r72*HCL*OH + 4*r76*O1D*CCL4 + r77*O1D*CF2CLBR + 2*r78*O1D*CFC11 + 2*r79*O1D*CFC113 + + 2*r80*O1D*CFC114 + r81*O1D*CFC115 + 2*r82*O1D*CFC12 + r83*O1D*HCL + r92*BRO*CLO + + r113*O1D*COFCL + 3*r118*CH3CCL3*OH + r120*CH3CL*OH + r123*HCFC141B*OH + r124*HCFC142B*OH + + r125*HCFC22*OH + r128*O1D*HCFC141B + r129*O1D*HCFC142B + r130*O1D*HCFC22 + r634*SO*CLO + - r51*CH2O*CL - r52*CH4*CL - r53*H2*CL - r54*H2O2*CL - r55*HO2*CL - r56*HO2*CL - r57*O3*CL + - r64*CLONO2*CL - r73*HOCL*CL - r114*CH2BR2*CL - r116*CH3BR*CL - r119*CH3CL*CL - r121*CHBR3*CL + - r163*C2H6*CL + d(CL2)/dt = r60*CLO*CLO + r64*CLONO2*CL + r718*HOCL*HCL + r723*CLONO2*HCL + r724*HOCL*HCL + r728*CLONO2*HCL + + r729*HOCL*HCL + r733*CLONO2*HCL + - j135*CL2 + d(CL2O2)/dt = r85*M*CLO*CLO + - j136*CL2O2 - r86*M*CL2O2 + d(CLO)/dt = j139*CLONO2 + j151*OCLO + r86*M*CL2O2 + r86*M*CL2O2 + r56*CL*HO2 + r57*CL*O3 + r66*CLONO2*O + + r73*HOCL*CL + r74*HOCL*O + r75*HOCL*OH + r84*O1D*HCL + r639*SO*OCLO + - j137*CLO - r58*CH3O2*CLO - 2*r59*CLO*CLO - 2*r60*CLO*CLO - 2*r61*CLO*CLO - r62*HO2*CLO + - r63*NO*CLO - r65*M*NO2*CLO - r68*O*CLO - r69*OH*CLO - r70*OH*CLO - 2*r85*M*CLO*CLO + - r91*BRO*CLO - r92*BRO*CLO - r93*BRO*CLO - r634*SO*CLO + d(CLONO2)/dt = r65*M*CLO*NO2 + - j138*CLONO2 - j139*CLONO2 - r721*CLONO2 - r726*CLONO2 - r732*CLONO2 - r64*CL*CLONO2 + - r66*O*CLONO2 - r67*OH*CLONO2 - r723*HCL*CLONO2 - r728*HCL*CLONO2 - r733*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = 1.5*j22*BEPOMUC + .6*j25*BIGALD3 + j26*BIGALD4 + j31*CH2O + j32*CH2O + j33*CH3CHO + j35*CH3COCHO + + .38*j39*CH4 + j40*CO2 + .5*j41*DHPMPAL + j43*GLYALD + 2*j44*GLYOXAL + j45*HCOCH2OOH + + .33*j47*HONITR + 1.3200001*j48*HPALD1 + 1.74*j49*HPALD4 + j50*HPALDB1C + j51*HPALDB4C + + 1.5*j53*HYDRALD + j54*HYDRALD + .55*j64*ISOPN1D + .55*j67*ISOPN4D + j72*MACR + .65*j72*MACR + + .75*j74*MACRN + .86*j75*MACROOH + .7*j79*MVK + j83*NO3CH2CHO + 1.5*j90*TEPOMUC + j93*TERPA + + j94*TERPA2 + j96*TERPA3 + j154*OCS + r217*MACRO2 + r333*NC4CHOO2 + .6*r362*ISOPZD1O2 + + .6*r365*ISOPZD4O2 + r51*CL*CH2O + r87*BR*CH2O + r119*CH3CL*CL + r132*CH2O*NO3 + r133*CH2O*O + + r134*CH2O*OH + .35*r154*M*C2H2*OH + .63*r156*C2H4*O3 + r179*GLYOXAL*OH + .11*r180*HCOCH2OOH*OH + + .56*r187*C3H6*O3 + r193*CH3COCHO*NO3 + r194*CH3COCHO*OH + r209*DHPMPAL*OH + r213*MACRN*OH + + .86*r214*MACRO2*CH3CO3 + .9*r215*MACRO2*CH3O2 + .51*r216*MACRO2*HO2 + .65*r218*MACR*O3 + + r220*MACROOH*OH + .65*r221*MCO3*CH3CO3 + .65*r222*MCO3*CH3O2 + .32*r223*MCO3*HO2 + + 1.3*r224*MCO3*MCO3 + .65*r225*MCO3*NO + .65*r226*MCO3*NO3 + .25*r231*M*MPAN*OH + .5*r232*MVKN*OH + + r234*MVKO2*CH3O2 + .26*r235*MVKO2*HO2 + .56*r236*MVK*O3 + 1.5599999*r238*MVKOOH*OH + + 1.0599999*r247*HPALD1*OH + .76*r248*HPALD4*OH + .42*r249*HPALDB1C*OH + .23*r250*HPALDB4C*OH + + r251*HYDRALD*OH + 1.5*r252*ICHE*OH + .26*r254*IEPOXOO*HO2 + .35*r256*INHED*OH + + .55*r277*ISOPED1O2*CH3CO3 + .28*r278*ISOPED1O2*CH3O2 + .55*r281*ISOPED4O2*CH3CO3 + + .28*r282*ISOPED4O2*CH3O2 + r285*ISOPFDNC*OH + r287*ISOPFNC*OH + 2*r289*ISOPHFP*OH + + .06*r293*ISOPN1D*OH + .04*r303*ISOPN4D*OH + .35*r319*ISOP*O3 + .55*r324*ISOPZD1O2*CH3CO3 + + .28*r325*ISOPZD1O2*CH3O2 + .55*r328*ISOPZD4O2*CH3CO3 + .28*r329*ISOPZD4O2*CH3O2 + + .6*r332*NC4CHOO2*HO2 + .3*r334*NC4CHO*O3 + .63*r335*NC4CHO*OH + .4*r336*IEPOXOO*NO + + .55*r342*ISOPED1O2*NO + .55*r344*ISOPED4O2*NO + .55*r363*ISOPZD1O2*NO + .55*r366*ISOPZD4O2*NO + + .86*r368*MACRO2*NO + .75*r372*NC4CHOO2*NO + .07*r388*DICARBO2*HO2 + .17*r389*DICARBO2*NO + + .16*r391*MALO2*HO2 + .4*r392*MALO2*NO + .14*r394*MDIALO2*HO2 + .35*r395*MDIALO2*NO + + .17*r435*APIN*O3 + 2*r551*TERPA2PAN*OH + r570*TERPA3PAN*OH + r571*TERPA4O2*CH3CO3 + + r572*TERPA4O2*CH3O2 + .53*r573*TERPA4O2*HO2 + .91*r574*TERPA4O2*NO + r575*TERPA4O2*NO3 + + r576*TERPA4O2*TERPA2CO3 + r577*TERPA4O2*TERPA3CO3 + r578*TERPA4O2*TERPACO3 + r590*TERPAPAN*OH + + r628*OCS*O + r629*OCS*OH + - r152*OH*CO + d(CO2)/dt = j36*CH3COOOH + .44*j39*CH4 + .17*j48*HPALD1 + .28*j49*HPALD4 + j54*HYDRALD + .4*j86*PAN + + j98*TERPACID + j99*TERPACID2 + j100*TERPACID3 + r143*HCOOH*OH + r152*CO*OH + + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + .49*r170*CH3CO3*HO2 + r171*CH3CO3*NO + + r172*CH3COOH*OH + .5*r173*CH3COOOH*OH + .8*r178*GLYALD*OH + r179*GLYOXAL*OH + r181*NO3CH2CHO*OH + + .2*r187*C3H6*O3 + r214*MACRO2*CH3CO3 + 2*r221*MCO3*CH3CO3 + r222*MCO3*CH3O2 + .49*r223*MCO3*HO2 + + 2*r224*MCO3*MCO3 + r225*MCO3*NO + r226*MCO3*NO3 + r233*MVKO2*CH3CO3 + .1*r236*MVK*O3 + + .54*r247*HPALD1*OH + .54*r248*HPALD4*OH + .36*r251*HYDRALD*OH + .19*r256*INHED*OH + + r257*ISOPB1O2*CH3CO3 + r263*ISOPB4O2*CH3CO3 + r277*ISOPED1O2*CH3CO3 + r281*ISOPED4O2*CH3CO3 + + r307*ISOPNO3*CH3CO3 + .42*r319*ISOP*O3 + r324*ISOPZD1O2*CH3CO3 + r328*ISOPZD4O2*CH3CO3 + + .45*r335*NC4CHO*OH + r419*APINNO3*CH3CO3 + r424*APINNO3*TERPA2CO3 + r425*APINNO3*TERPA3CO3 + + r426*APINNO3*TERPACO3 + r427*APINO2*CH3CO3 + r432*APINO2*TERPA2CO3 + r433*APINO2*TERPA3CO3 + + r434*APINO2*TERPACO3 + r439*BCARYNO3*CH3CO3 + r444*BCARYNO3*TERPA2CO3 + r445*BCARYNO3*TERPA3CO3 + + r446*BCARYNO3*TERPACO3 + r447*BCARYO2*CH3CO3 + r452*BCARYO2*TERPA2CO3 + r453*BCARYO2*TERPA3CO3 + + r454*BCARYO2*TERPACO3 + r459*BPINNO3*CH3CO3 + r464*BPINNO3*TERPA2CO3 + r465*BPINNO3*TERPA3CO3 + + r466*BPINNO3*TERPACO3 + r467*BPINO2*CH3CO3 + r472*BPINO2*TERPA2CO3 + r473*BPINO2*TERPA3CO3 + + r474*BPINO2*TERPACO3 + .19*r475*BPIN*O3 + r478*LIMONNO3*CH3CO3 + r484*LIMONNO3*TERPA2CO3 + + r485*LIMONNO3*TERPA3CO3 + r486*LIMONNO3*TERPACO3 + r487*LIMONO2*CH3CO3 + r492*LIMONO2*TERPA2CO3 + + r493*LIMONO2*TERPA3CO3 + r494*LIMONO2*TERPACO3 + r498*MYRCNO3*CH3CO3 + r504*MYRCNO3*TERPA2CO3 + + r505*MYRCNO3*TERPA3CO3 + r506*MYRCNO3*TERPACO3 + r507*MYRCO2*CH3CO3 + r512*MYRCO2*TERPA2CO3 + + r513*MYRCO2*TERPA3CO3 + r514*MYRCO2*TERPACO3 + r526*TERPA1O2*CH3CO3 + r531*TERPA1O2*TERPA2CO3 + + r532*TERPA1O2*TERPA3CO3 + r533*TERPA1O2*TERPACO3 + 2*r534*TERPA2CO3*CH3CO3 + + r535*TERPA2CO3*CH3O2 + .49*r536*TERPA2CO3*HO2 + r537*TERPA2CO3*NO + r538*TERPA2CO3*NO3 + + 2*r539*TERPA2CO3*TERPA2CO3 + 2*r540*TERPA2CO3*TERPACO3 + r542*TERPA2O2*CH3CO3 + + r547*TERPA2O2*TERPA2CO3 + r548*TERPA2O2*TERPA3CO3 + r549*TERPA2O2*TERPACO3 + 2*r551*TERPA2PAN*OH + + 2*r552*TERPA3CO3*CH3CO3 + r553*TERPA3CO3*CH3O2 + .49*r554*TERPA3CO3*HO2 + r555*TERPA3CO3*NO + + r556*TERPA3CO3*NO3 + 2*r557*TERPA3CO3*TERPA2CO3 + 2*r558*TERPA3CO3*TERPA3CO3 + + 2*r559*TERPA3CO3*TERPACO3 + r561*TERPA3O2*CH3CO3 + r566*TERPA3O2*TERPA2CO3 + + r567*TERPA3O2*TERPA3CO3 + r568*TERPA3O2*TERPACO3 + 3*r570*TERPA3PAN*OH + r571*TERPA4O2*CH3CO3 + + r576*TERPA4O2*TERPA2CO3 + r577*TERPA4O2*TERPA3CO3 + r578*TERPA4O2*TERPACO3 + + .29*r579*TERPACID2*OH + .29*r580*TERPACID3*OH + .29*r581*TERPACID*OH + 2*r582*TERPACO3*CH3CO3 + + r583*TERPACO3*CH3O2 + .49*r584*TERPACO3*HO2 + r585*TERPACO3*NO + r586*TERPACO3*NO3 + + 2*r587*TERPACO3*TERPACO3 + - j40*CO2 + d(COF2)/dt = j123*CF2CLBR + j124*CF3BR + j126*CFC113 + 2*j127*CFC114 + 2*j128*CFC115 + j129*CFC12 + + 2*j142*H2402 + j145*HCFC142B + j146*HCFC22 + r77*O1D*CF2CLBR + r79*O1D*CFC113 + + 2*r80*O1D*CFC114 + 2*r81*O1D*CFC115 + r82*O1D*CFC12 + r103*O1D*CF3BR + 2*r105*O1D*H2402 + + r124*HCFC142B*OH + r125*HCFC22*OH + r129*O1D*HCFC142B + r130*O1D*HCFC22 + - j140*COF2 - r112*O1D*COF2 + d(COFCL)/dt = j125*CFC11 + j126*CFC113 + j144*HCFC141B + r78*O1D*CFC11 + r79*O1D*CFC113 + r123*HCFC141B*OH + + r128*O1D*HCFC141B + - j141*COFCL - r113*O1D*COFCL + d(CRESOL)/dt = .18*r407*TOLUENE*OH + - r387*OH*CRESOL + d(DHPMPAL)/dt = .6*r362*ISOPZD1O2 + .6*r365*ISOPZD4O2 + .07*r247*HPALD1*OH + .17*r248*HPALD4*OH + - j41*DHPMPAL - r209*OH*DHPMPAL + d(DMS)/dt = - r626*NO3*DMS - r627*OH*DMS - r641*OH*DMS + d(dst_a1)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(E90)/dt = - r734*E90 + d(EOOH)/dt = r174*EO2*HO2 + - j42*EOOH + d(F)/dt = j124*CF3BR + j128*CFC115 + 2*j140*COF2 + j141*COFCL + j148*HF + r81*O1D*CFC115 + r103*O1D*CF3BR + + 2*r112*O1D*COF2 + r113*O1D*COFCL + - r108*CH4*F - r109*H2*F - r110*H2O*F - r111*HNO3*F + d(GLYALD)/dt = .33*j47*HONITR + .5*j53*HYDRALD + j59*ISOPFDN + .5*j60*ISOPFDNC + .5*j61*ISOPFNC + j62*ISOPFNP + + .72*j63*ISOPHFP + .5*j80*MVKN + .56*j81*MVKOOH + r177*O2*EO + .75*r233*MVKO2*CH3CO3 + + .38*r234*MVKO2*CH3O2 + .36*r235*MVKO2*HO2 + .37*r254*IEPOXOO*HO2 + .55*r290*ISOPN1DO2*HO2 + + .83*r292*ISOPN1D*O3 + .46*r294*ISOPN2BO2*HO2 + .15*r304*ISOPNBNO3O2*HO2 + + .28*r312*ISOPNOOHBO2*HO2 + r321*ISOPOH*OH + .07*r323*ISOPOOH*OH + .57*r336*IEPOXOO*NO + + .94*r346*ISOPN1DO2*NO + .73*r348*ISOPN2BO2*NO + .34*r354*ISOPNBNO3O2*NO + + .4*r358*ISOPNOOHBO2*NO + .76*r370*MVKO2*NO + - j43*GLYALD - r178*OH*GLYALD + d(GLYOXAL)/dt = j21*BENZOOH + .5*j60*ISOPFDNC + .5*j61*ISOPFNC + .28*j63*ISOPHFP + .7*j87*PHENOOH + + .6*j115*TOLOOH + .34*j116*XYLENOOH + .17*j117*XYLOLOOH + .65*r154*M*C2H2*OH + + .2*r178*GLYALD*OH + .89*r180*HCOCH2OOH*OH + .15*r254*IEPOXOO*HO2 + .17*r292*ISOPN1D*O3 + + .17*r302*ISOPN4D*O3 + .17*r317*ISOPNOOHD*O3 + .1*r332*NC4CHOO2*HO2 + .66*r334*NC4CHO*O3 + + .23*r336*IEPOXOO*NO + .13*r372*NC4CHOO2*NO + r378*BENZO2*NO + .16*r391*MALO2*HO2 + + .4*r392*MALO2*NO + .07*r394*MDIALO2*HO2 + .17*r395*MDIALO2*NO + .7*r398*PHENO2*NO + + .6*r405*TOLO2*NO + .34*r411*XYLENO2*NO + .17*r414*XYLOLO2*NO + - j44*GLYOXAL - r644*GLYOXAL - r179*OH*GLYOXAL + d(H)/dt = j2*H2O + 2*j3*H2O + 2*j31*CH2O + j37*CH3OOH + j38*CH4 + .33*j39*CH4 + j143*HBR + j147*HCL + + j148*HF + r1*O1D*H2 + r9*H2*O + r18*OH*H2 + r21*OH*O + r39*N*OH + r53*CL*H2 + r84*O1D*HCL + + r107*O1D*HBR + r109*F*H2 + r134*CH2O*OH + r149*O1D*CH4 + r629*OCS*OH + r635*S*OH + r640*SO*OH + - r14*O2*M*H - r11*HO2*H - r12*HO2*H - r13*HO2*H - r17*O3*H + d(H2)/dt = j1*H2O + j32*CH2O + 1.4400001*j39*CH4 + r11*H*HO2 + r150*O1D*CH4 + - r1*O1D*H2 - r9*O*H2 - r18*OH*H2 - r53*CL*H2 - r109*F*H2 + d(H2402)/dt = - j142*H2402 - r105*O1D*H2402 + d(H2O2)/dt = r24*M*OH*OH + r25*HO2*HO2 + .66*r292*ISOPN1D*O3 + .66*r302*ISOPN4D*O3 + .66*r317*ISOPNOOHD*O3 + + .03*r319*ISOP*O3 + .66*r334*NC4CHO*O3 + .22*r435*APIN*O3 + .17*r455*BCARY*O3 + + .32*r475*BPIN*O3 + .33*r495*LIMON*O3 + .02*r595*TERPF1*O3 + .04*r600*TERPF2*O3 + - j4*H2O2 - r10*O*H2O2 - r19*OH*H2O2 - r54*CL*H2O2 + d(H2SO4)/dt = r642*SO3*H2O + - j153*H2SO4 + d(HBR)/dt = r87*BR*CH2O + r88*BR*HO2 + - j143*HBR - r100*O*HBR - r101*OH*HBR - r106*O1D*HBR - r107*O1D*HBR + d(HCFC141B)/dt = - j144*HCFC141B - r123*OH*HCFC141B - r128*O1D*HCFC141B + d(HCFC142B)/dt = - j145*HCFC142B - r124*OH*HCFC142B - r129*O1D*HCFC142B + d(HCFC22)/dt = - j146*HCFC22 - r125*OH*HCFC22 - r130*O1D*HCFC22 + d(HCL)/dt = r51*CL*CH2O + r52*CL*CH4 + r53*CL*H2 + r54*CL*H2O2 + r55*CL*HO2 + r70*CLO*OH + r73*HOCL*CL + + r114*CH2BR2*CL + r116*CH3BR*CL + 2*r119*CH3CL*CL + r121*CHBR3*CL + r163*C2H6*CL + - j147*HCL - r71*O*HCL - r72*OH*HCL - r83*O1D*HCL - r84*O1D*HCL - r718*HOCL*HCL + - r723*CLONO2*HCL - r724*HOCL*HCL - r725*HOBR*HCL - r728*CLONO2*HCL - r729*HOCL*HCL + - r730*HOBR*HCL - r733*CLONO2*HCL + d(HCN)/dt = - r142*M*OH*HCN - r151*O1D*HCN + d(HCOCH2OOH)/dt = .68*r315*ISOPNOOHDO2*HO2 + .7*r317*ISOPNOOHD*O3 + .81*r360*ISOPNOOHDO2*NO + - j45*HCOCH2OOH - r180*OH*HCOCH2OOH + d(HCOOH)/dt = .41*j48*HPALD1 + .5*r144*HMHP*OH + .5*r145*HOCH2OO*HO2 + r147*HOCH2OO*NO + .35*r154*M*C2H2*OH + + .37*r156*C2H4*O3 + .12*r187*C3H6*O3 + .33*r218*MACR*O3 + .12*r236*MVK*O3 + .4*r255*INHEB*OH + + .22*r319*ISOP*O3 + .08*r475*BPIN*O3 + .15*r595*TERPF1*O3 + .26*r600*TERPF2*O3 + - r143*OH*HCOOH + d(HF)/dt = r108*F*CH4 + r109*F*H2 + r110*F*H2O + r111*F*HNO3 + - j148*HF + d(HMHP)/dt = .5*r145*HOCH2OO*HO2 + .33*r319*ISOP*O3 + .11*r475*BPIN*O3 + .23*r595*TERPF1*O3 + + .4*r600*TERPF2*O3 + - j46*HMHP - r144*OH*HMHP + d(HNO3)/dt = r646*HONITR + r649*INHEB + r650*INHED + r651*ISOPNOOHD + r652*ISOPFDN + r653*ISOPFDNC + + r657*ISOPN1D + r658*ISOPN2B + r659*ISOPN4D + 2*r660*N2O5 + r661*NC4CHO + .5*r663*NO2 + + r664*NO3 + r665*ONITR + r668*TERPFDN + r670*TERPNPT1 + r671*TERPNPT + r672*TERPNT1 + + r673*TERPNT + 2*r717*N2O5 + r719*BRONO2 + 2*r720*N2O5 + r721*CLONO2 + r722*BRONO2 + + r726*CLONO2 + r727*BRONO2 + 2*r731*N2O5 + r732*CLONO2 + r47*M*NO2*OH + r132*CH2O*NO3 + + r165*CH3CHO*NO3 + r193*CH3COCHO*NO3 + r541*TERPA2*NO3 + r560*TERPA3*NO3 + r588*TERPA*NO3 + + r626*DMS*NO3 + r723*CLONO2*HCL + r728*CLONO2*HCL + r733*CLONO2*HCL + - j9*HNO3 - r48*OH*HNO3 - r111*F*HNO3 + d(HO2NO2)/dt = r45*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r49*M*HO2NO2 - r26*OH*HO2NO2 + d(HOBR)/dt = r719*BRONO2 + r722*BRONO2 + r727*BRONO2 + r94*BRO*HO2 + - j149*HOBR - r102*O*HOBR - r725*HCL*HOBR - r730*HCL*HOBR + d(HOCL)/dt = r721*CLONO2 + r726*CLONO2 + r732*CLONO2 + r62*CLO*HO2 + r67*CLONO2*OH + - j150*HOCL - r73*CL*HOCL - r74*O*HOCL - r75*OH*HOCL - r718*HCL*HOCL - r724*HCL*HOCL + - r729*HCL*HOCL + d(HONITR)/dt = r211*ENEO2*NO + - j47*HONITR - r646*HONITR - r212*OH*HONITR + d(HPALD1)/dt = .25*r362*ISOPZD1O2 + - j48*HPALD1 - r247*OH*HPALD1 + d(HPALD4)/dt = .25*r365*ISOPZD4O2 + - j49*HPALD4 - r248*OH*HPALD4 + d(HPALDB1C)/dt = .15*r362*ISOPZD1O2 + .09*r322*ISOPOOH*OH + - j50*HPALDB1C - r249*OH*HPALDB1C + d(HPALDB4C)/dt = .15*r365*ISOPZD4O2 + .09*r322*ISOPOOH*OH + - j51*HPALDB4C - r250*OH*HPALDB4C + d(HYAC)/dt = .17*j47*HONITR + .5*j53*HYDRALD + j59*ISOPFDN + .5*j60*ISOPFDNC + .5*j61*ISOPFNC + j62*ISOPFNP + + .28*j63*ISOPHFP + .5*j74*MACRN + .86*j75*MACROOH + r217*MACRO2 + .5*r200*POOH*OH + + .2*r201*RO2*CH3O2 + .5*r213*MACRN*OH + .86*r214*MACRO2*CH3CO3 + .9*r215*MACRO2*CH3O2 + + .51*r216*MACRO2*HO2 + r220*MACROOH*OH + .25*r231*M*MPAN*OH + .22*r251*HYDRALD*OH + + .5*r252*ICHE*OH + .19*r254*IEPOXOO*HO2 + .19*r256*INHED*OH + .28*r289*ISOPHFP*OH + + .46*r294*ISOPN2BO2*HO2 + .44*r300*ISOPN4DO2*HO2 + .83*r302*ISOPN4D*O3 + + .15*r304*ISOPNBNO3O2*HO2 + .06*r312*ISOPNOOHBO2*HO2 + r321*ISOPOH*OH + .07*r323*ISOPOOH*OH + + .29*r336*IEPOXOO*NO + .73*r348*ISOPN2BO2*NO + .87*r352*ISOPN4DO2*NO + .33*r354*ISOPNBNO3O2*NO + + .07*r358*ISOPNOOHBO2*NO + .86*r368*MACRO2*NO + .18*r515*MYRC*O3 + - j52*HYAC - r195*OH*HYAC + d(HYDRALD)/dt = .45*j64*ISOPN1D + .45*j67*ISOPN4D + j82*NC4CHO + .25*r264*ISOPB4O2*CH3O2 + + .45*r277*ISOPED1O2*CH3CO3 + .47*r278*ISOPED1O2*CH3O2 + .45*r281*ISOPED4O2*CH3CO3 + + .47*r282*ISOPED4O2*CH3O2 + .13*r322*ISOPOOH*OH + .45*r324*ISOPZD1O2*CH3CO3 + + .47*r325*ISOPZD1O2*CH3O2 + .45*r328*ISOPZD4O2*CH3CO3 + .47*r329*ISOPZD4O2*CH3O2 + + .45*r342*ISOPED1O2*NO + .45*r344*ISOPED4O2*NO + .45*r363*ISOPZD1O2*NO + + .45*r366*ISOPZD4O2*NO + - j53*HYDRALD - j54*HYDRALD - r251*OH*HYDRALD + d(HYPERACET)/dt = .5*j41*DHPMPAL + r209*DHPMPAL*OH + .15*r248*HPALD4*OH + .12*r315*ISOPNOOHDO2*HO2 + + .13*r317*ISOPNOOHD*O3 + .15*r360*ISOPNOOHDO2*NO + - j55*HYPERACET - j56*HYPERACET - r196*OH*HYPERACET + d(ICHE)/dt = j57*INHEB + j58*INHED + .08*r247*HPALD1*OH + .18*r248*HPALD4*OH + .58*r249*HPALDB1C*OH + + .77*r250*HPALDB4C*OH + .19*r253*IEPOX*OH + .04*r335*NC4CHO*OH + - r647*ICHE - r252*OH*ICHE + d(IEPOX)/dt = .08*r293*ISOPN1D*OH + .15*r296*ISOPN2B*OH + .13*r299*ISOPN3B*OH + .04*r303*ISOPN4D*OH + + .07*r318*ISOPNOOHD*OH + .85*r323*ISOPOOH*OH + - r648*IEPOX - r253*OH*IEPOX + d(INHEB)/dt = .2*r255*INHEB*OH + .4*r314*ISOPNOOHB*OH + - j57*INHEB - r649*INHEB - r255*OH*INHEB + d(INHED)/dt = .06*r256*INHED*OH + .03*r305*ISOPNBNO3*OH + .2*r318*ISOPNOOHD*OH + - j58*INHED - r650*INHED - r256*OH*INHED + d(ISOP)/dt = - r306*NO3*ISOP - r319*O3*ISOP - r320*OH*ISOP + d(ISOPFDN)/dt = r347*ISOPN1DO2*NO + r349*ISOPN2BO2*NO + r351*ISOPN3BO2*NO + r353*ISOPN4DO2*NO + + r355*ISOPNBNO3O2*NO + r357*ISOPNO3*NO + r359*ISOPNOOHBO2*NO + r361*ISOPNOOHDO2*NO + - j59*ISOPFDN - r652*ISOPFDN - r286*OH*ISOPFDN + d(ISOPFDNC)/dt = r286*ISOPFDN*OH + r373*NC4CHOO2*NO + - j60*ISOPFDNC - r653*ISOPFDNC - r285*OH*ISOPFDNC + d(ISOPFNC)/dt = r295*ISOPN2BO2 + r298*ISOPN3BO2 + r288*ISOPFNP*OH + r337*IEPOXOO*NO + - j61*ISOPFNC - r654*ISOPFNC - r287*OH*ISOPFNC + d(ISOPFNP)/dt = r291*ISOPN1DO2 + r301*ISOPN4DO2 + r313*ISOPNOOHBO2 + r316*ISOPNOOHDO2 + .42*r290*ISOPN1DO2*HO2 + + .48*r294*ISOPN2BO2*HO2 + .4*r297*ISOPN3BO2*HO2 + .5*r300*ISOPN4DO2*HO2 + + .6*r304*ISOPNBNO3O2*HO2 + .49*r312*ISOPNOOHBO2*HO2 + .17*r315*ISOPNOOHDO2*HO2 + + .2*r332*NC4CHOO2*HO2 + - j62*ISOPFNP - r655*ISOPFNP - r288*OH*ISOPFNP + d(ISOPHFP)/dt = .35*r254*IEPOXOO*HO2 + .08*r323*ISOPOOH*OH + - j63*ISOPHFP - r656*ISOPHFP - r289*OH*ISOPHFP + d(ISOPN1D)/dt = .28*r308*ISOPNO3*CH3O2 + .53*r310*ISOPNO3*ISOPNO3 + r345*ISOPED4O2*NO + r367*ISOPZD4O2*NO + - j64*ISOPN1D - r657*ISOPN1D - r292*O3*ISOPN1D - r293*OH*ISOPN1D + d(ISOPN2B)/dt = r339*ISOPB1O2*NO + - j65*ISOPN2B - r658*ISOPN2B - r296*OH*ISOPN2B + d(ISOPN3B)/dt = r341*ISOPB4O2*NO + - j66*ISOPN3B - r299*OH*ISOPN3B + d(ISOPN4D)/dt = .05*r308*ISOPNO3*CH3O2 + .09*r310*ISOPNO3*ISOPNO3 + r343*ISOPED1O2*NO + r364*ISOPZD1O2*NO + - j67*ISOPN4D - r659*ISOPN4D - r302*O3*ISOPN4D - r303*OH*ISOPN4D + d(ISOPNBNO3)/dt = .07*r308*ISOPNO3*CH3O2 + .15*r310*ISOPNO3*ISOPNO3 + - j68*ISOPNBNO3 - r305*OH*ISOPNBNO3 + d(ISOPNOOHB)/dt = .23*r309*ISOPNO3*HO2 + - j69*ISOPNOOHB - r314*OH*ISOPNOOHB + d(ISOPNOOHD)/dt = .53*r309*ISOPNO3*HO2 + - j70*ISOPNOOHD - r651*ISOPNOOHD - r317*O3*ISOPNOOHD - r318*OH*ISOPNOOHD + d(ISOPOH)/dt = .25*r258*ISOPB1O2*CH3O2 + .25*r264*ISOPB4O2*CH3O2 + .25*r278*ISOPED1O2*CH3O2 + + .25*r282*ISOPED4O2*CH3O2 + .25*r325*ISOPZD1O2*CH3O2 + .25*r329*ISOPZD4O2*CH3O2 + - r321*OH*ISOPOH + d(ISOPOOH)/dt = .94*r259*ISOPB1O2*HO2 + .94*r265*ISOPB4O2*HO2 + r279*ISOPED1O2*HO2 + r283*ISOPED4O2*HO2 + + r326*ISOPZD1O2*HO2 + r330*ISOPZD4O2*HO2 + - j71*ISOPOOH - r322*OH*ISOPOOH - r323*OH*ISOPOOH + d(IVOC)/dt = - r699*OH*IVOC + d(LIMON)/dt = - r477*NO3*LIMON - r495*O3*LIMON - r496*OH*LIMON + d(MACR)/dt = j51*HPALDB4C + j66*ISOPN3B + .5*j68*ISOPNBNO3 + .12*j69*ISOPNOOHB + .3*j71*ISOPOOH + + r266*ISOPB4O2 + .35*r248*HPALD4*OH + .14*r250*HPALDB4C*OH + r263*ISOPB4O2*CH3CO3 + + .5*r264*ISOPB4O2*CH3O2 + .06*r265*ISOPB4O2*HO2 + .04*r307*ISOPNO3*CH3CO3 + + .02*r308*ISOPNO3*CH3O2 + .02*r309*ISOPNO3*HO2 + .16*r310*ISOPNO3*ISOPNO3 + .04*r311*ISOPNO3*NO3 + + .41*r319*ISOP*O3 + r340*ISOPB4O2*NO + .04*r356*ISOPNO3*NO + - j72*MACR - j73*MACR - r218*O3*MACR - r219*OH*MACR + d(MACRN)/dt = .51*r333*NC4CHOO2 + .5*r285*ISOPFDNC*OH + .25*r287*ISOPFNC*OH + .03*r290*ISOPN1DO2*HO2 + + .06*r293*ISOPN1D*OH + .06*r294*ISOPN2BO2*HO2 + .06*r304*ISOPNBNO3O2*HO2 + + .15*r312*ISOPNOOHBO2*HO2 + .02*r315*ISOPNOOHDO2*HO2 + .29*r332*NC4CHOO2*HO2 + + .24*r335*NC4CHO*OH + .06*r346*ISOPN1DO2*NO + .27*r348*ISOPN2BO2*NO + .21*r354*ISOPNBNO3O2*NO + + .49*r358*ISOPNOOHBO2*NO + .02*r360*ISOPNOOHDO2*NO + r369*MACRO2*NO + .39*r372*NC4CHOO2*NO + - j74*MACRN - r213*OH*MACRN + d(MACROOH)/dt = .55*j64*ISOPN1D + .41*r216*MACRO2*HO2 + .09*r250*HPALDB4C*OH + .55*r281*ISOPED4O2*CH3CO3 + + .28*r282*ISOPED4O2*CH3O2 + .25*r287*ISOPFNC*OH + .55*r328*ISOPZD4O2*CH3CO3 + + .28*r329*ISOPZD4O2*CH3O2 + .55*r344*ISOPED4O2*NO + .55*r366*ISOPZD4O2*NO + - j75*MACROOH - r220*OH*MACROOH + d(MEK)/dt = .8*j19*ALKNIT + .8*j20*ALKOOH + .8*r243*ALKO2*NO + - j76*MEK - r229*OH*MEK + d(MEKOOH)/dt = .8*r227*MEKO2*HO2 + - j77*MEKOOH - r230*OH*MEKOOH + d(MPAN)/dt = r239*M*MCO3*NO2 + - j78*MPAN - r240*M*MPAN - r231*M*OH*MPAN + d(MVK)/dt = j50*HPALDB1C + j65*ISOPN2B + .5*j68*ISOPNBNO3 + .88*j69*ISOPNOOHB + .7*j71*ISOPOOH + + r260*ISOPB1O2 + .35*r247*HPALD1*OH + .23*r249*HPALDB1C*OH + r257*ISOPB1O2*CH3CO3 + + .75*r258*ISOPB1O2*CH3O2 + .06*r259*ISOPB1O2*HO2 + .42*r307*ISOPNO3*CH3CO3 + + .05*r308*ISOPNO3*CH3O2 + .22*r309*ISOPNO3*HO2 + .42*r311*ISOPNO3*NO3 + .17*r319*ISOP*O3 + + r338*ISOPB1O2*NO + .42*r356*ISOPNO3*NO + - j79*MVK - r236*O3*MVK - r237*OH*MVK + d(MVKN)/dt = .49*r333*NC4CHOO2 + .05*r256*INHED*OH + .5*r285*ISOPFDNC*OH + .25*r287*ISOPFNC*OH + + .6*r297*ISOPN3BO2*HO2 + .06*r300*ISOPN4DO2*HO2 + .04*r303*ISOPN4D*OH + .04*r304*ISOPNBNO3O2*HO2 + + .02*r312*ISOPNOOHBO2*HO2 + .01*r315*ISOPNOOHDO2*HO2 + .31*r332*NC4CHOO2*HO2 + + .04*r335*NC4CHO*OH + r350*ISOPN3BO2*NO + .13*r352*ISOPN4DO2*NO + .12*r354*ISOPNBNO3O2*NO + + .04*r358*ISOPNOOHBO2*NO + .02*r360*ISOPNOOHDO2*NO + r371*MVKO2*NO + .36*r372*NC4CHOO2*NO + - j80*MVKN - r232*OH*MVKN + d(MVKOOH)/dt = .55*j67*ISOPN4D + .46*r235*MVKO2*HO2 + .19*r249*HPALDB1C*OH + .55*r277*ISOPED1O2*CH3CO3 + + .28*r278*ISOPED1O2*CH3O2 + .25*r287*ISOPFNC*OH + .55*r324*ISOPZD1O2*CH3CO3 + + .28*r325*ISOPZD1O2*CH3O2 + .55*r342*ISOPED1O2*NO + .55*r363*ISOPZD1O2*NO + - j81*MVKOOH - r238*OH*MVKOOH + d(MYRC)/dt = - r497*NO3*MYRC - r515*O3*MYRC - r516*OH*MYRC + d(N)/dt = j15*NO + - r31*O2*N - r27*NO*N - r28*NO2*N - r29*NO2*N - r30*NO2*N - r39*OH*N + d(N2O)/dt = r28*N*NO2 + - j12*N2O - r43*O1D*N2O - r44*O1D*N2O + d(N2O5)/dt = r46*M*NO2*NO3 + - j13*N2O5 - j14*N2O5 - r50*M*N2O5 - r660*N2O5 - r717*N2O5 - r720*N2O5 - r731*N2O5 + d(NC4CHO)/dt = j70*ISOPNOOHD + .04*r293*ISOPN1D*OH + .03*r303*ISOPN4D*OH + .05*r305*ISOPNBNO3*OH + + .54*r307*ISOPNO3*CH3CO3 + .53*r308*ISOPNO3*CH3O2 + 1.0700001*r310*ISOPNO3*ISOPNO3 + + .54*r311*ISOPNO3*NO3 + .02*r314*ISOPNOOHB*OH + .09*r318*ISOPNOOHD*OH + .54*r356*ISOPNO3*NO + - j82*NC4CHO - r661*NC4CHO - r334*O3*NC4CHO - r335*OH*NC4CHO + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 + d(ncl_a3)/dt = 0 + d(NH3)/dt = - r643*OH*NH3 + d(NH4)/dt = - r662*NH4 + d(NH_5)/dt = - r736*NH_5 + d(NH_50)/dt = - r735*NH_50 + d(NO)/dt = j14*N2O5 + j16*NO2 + j17*NO3 + r31*O2*N + .5*r663*NO2 + 2*r29*N*NO2 + r32*NO2*O + r39*N*OH + + 2*r43*O1D*N2O + r636*SO*NO2 + - j15*NO - r27*N*NO - r36*NO3*NO - r40*HO2*NO - r41*O3*NO - r42*M*O*NO - r63*CLO*NO + - r95*BRO*NO - r138*CH3O2*NO - r147*HOCH2OO*NO - r160*C2H5O2*NO - r171*CH3CO3*NO - r175*EO2*NO + - r190*C3H7O2*NO - r199*PO2*NO - r203*RO2*NO - r210*ENEO2*NO - r211*ENEO2*NO - r225*MCO3*NO + - r228*MEKO2*NO - r243*ALKO2*NO - r244*ALKO2*NO - r336*IEPOXOO*NO - r337*IEPOXOO*NO + - r338*ISOPB1O2*NO - r339*ISOPB1O2*NO - r340*ISOPB4O2*NO - r341*ISOPB4O2*NO - r342*ISOPED1O2*NO + - r343*ISOPED1O2*NO - r344*ISOPED4O2*NO - r345*ISOPED4O2*NO - r346*ISOPN1DO2*NO + - r347*ISOPN1DO2*NO - r348*ISOPN2BO2*NO - r349*ISOPN2BO2*NO - r350*ISOPN3BO2*NO + - r351*ISOPN3BO2*NO - r352*ISOPN4DO2*NO - r353*ISOPN4DO2*NO - r354*ISOPNBNO3O2*NO + - r355*ISOPNBNO3O2*NO - r356*ISOPNO3*NO - r357*ISOPNO3*NO - r358*ISOPNOOHBO2*NO + - r359*ISOPNOOHBO2*NO - r360*ISOPNOOHDO2*NO - r361*ISOPNOOHDO2*NO - r363*ISOPZD1O2*NO + - r364*ISOPZD1O2*NO - r366*ISOPZD4O2*NO - r367*ISOPZD4O2*NO - r368*MACRO2*NO - r369*MACRO2*NO + - r370*MVKO2*NO - r371*MVKO2*NO - r372*NC4CHOO2*NO - r373*NC4CHOO2*NO - r375*ACBZO2*NO + - r378*BENZO2*NO - r383*BZOO*NO - r385*C6H5O2*NO - r389*DICARBO2*NO - r392*MALO2*NO + - r395*MDIALO2*NO - r398*PHENO2*NO - r405*TOLO2*NO - r411*XYLENO2*NO - r414*XYLOLO2*NO + - r422*APINNO3*NO - r430*APINO2*NO - r442*BCARYNO3*NO - r450*BCARYO2*NO - r462*BPINNO3*NO + - r470*BPINO2*NO - r482*LIMONNO3*NO - r490*LIMONO2*NO - r502*MYRCNO3*NO - r510*MYRCO2*NO + - r521*TERP1OOHO2*NO - r525*TERP2OOHO2*NO - r529*TERPA1O2*NO - r537*TERPA2CO3*NO + - r545*TERPA2O2*NO - r555*TERPA3CO3*NO - r564*TERPA3O2*NO - r574*TERPA4O2*NO - r585*TERPACO3*NO + - r594*TERPF1O2*NO - r599*TERPF2O2*NO - r606*TERPNPS1O2*NO - r610*TERPNPT1O2*NO + - r614*TERPNS1O2*NO - r618*TERPNT1O2*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j19*ALKNIT + j47*HONITR + j57*INHEB + j58*INHED + + 2*j59*ISOPFDN + 2*j60*ISOPFDNC + j61*ISOPFNC + j62*ISOPFNP + j64*ISOPN1D + j65*ISOPN2B + + j66*ISOPN3B + j67*ISOPN4D + j68*ISOPNBNO3 + j69*ISOPNOOHB + .75*j74*MACRN + j78*MPAN + + .75*j80*MVKN + j82*NC4CHO + j83*NO3CH2CHO + j84*NOA + j85*ONITR + .6*j86*PAN + j95*TERPA2PAN + + j97*TERPA3PAN + j101*TERPAPAN + j103*TERPFDN + .5*j105*TERPNPS + .46*j106*TERPNPS1 + + j107*TERPNPT + .46*j108*TERPNPT1 + j109*TERPNS + j110*TERPNS1 + j111*TERPNT + j112*TERPNT1 + + j120*BRONO2 + j139*CLONO2 + r49*M*HO2NO2 + r50*M*N2O5 + r185*M*PAN + r240*M*MPAN + + r408*M*PBZNIT + r623*M*TERPA2PAN + r624*M*TERPA3PAN + r625*M*TERPAPAN + r26*HO2NO2*OH + + r35*NO3*HO2 + 2*r36*NO3*NO + r37*NO3*O + r38*NO3*OH + r40*NO*HO2 + r41*NO*O3 + r42*M*NO*O + + r63*CLO*NO + r95*BRO*NO + r138*CH3O2*NO + r147*HOCH2OO*NO + r160*C2H5O2*NO + r171*CH3CO3*NO + + r175*EO2*NO + r181*NO3CH2CHO*OH + r190*C3H7O2*NO + r197*NOA*OH + r199*PO2*NO + r203*RO2*NO + + r207*BIGENE*NO3 + r210*ENEO2*NO + .5*r213*MACRN*OH + r225*MCO3*NO + r226*MCO3*NO3 + + r228*MEKO2*NO + r241*ALKNIT*OH + r243*ALKO2*NO + .4*r255*INHEB*OH + .19*r256*INHED*OH + + r285*ISOPFDNC*OH + .5*r287*ISOPFNC*OH + .17*r292*ISOPN1D*O3 + .08*r293*ISOPN1D*OH + + .46*r294*ISOPN2BO2*HO2 + .15*r296*ISOPN2B*OH + .13*r299*ISOPN3B*OH + .17*r302*ISOPN4D*O3 + + .04*r303*ISOPN4D*OH + .46*r307*ISOPNO3*CH3CO3 + .07*r308*ISOPNO3*CH3O2 + .24*r309*ISOPNO3*HO2 + + .16*r310*ISOPNO3*ISOPNO3 + 1.46*r311*ISOPNO3*NO3 + .17*r317*ISOPNOOHD*O3 + .07*r318*ISOPNOOHD*OH + + .17*r334*NC4CHO*O3 + .04*r335*NC4CHO*OH + r336*IEPOXOO*NO + r338*ISOPB1O2*NO + r340*ISOPB4O2*NO + + r342*ISOPED1O2*NO + r344*ISOPED4O2*NO + r346*ISOPN1DO2*NO + 1.73*r348*ISOPN2BO2*NO + + r350*ISOPN3BO2*NO + r352*ISOPN4DO2*NO + r354*ISOPNBNO3O2*NO + 1.46*r356*ISOPNO3*NO + + r358*ISOPNOOHBO2*NO + r360*ISOPNOOHDO2*NO + r363*ISOPZD1O2*NO + r366*ISOPZD4O2*NO + + r368*MACRO2*NO + r370*MVKO2*NO + r372*NC4CHOO2*NO + r375*ACBZO2*NO + r378*BENZO2*NO + + r383*BZOO*NO + r385*C6H5O2*NO + r389*DICARBO2*NO + r392*MALO2*NO + r395*MDIALO2*NO + + r398*PHENO2*NO + r405*TOLO2*NO + r411*XYLENO2*NO + r414*XYLOLO2*NO + 1.64*r418*APINNO3*APINNO3 + + r419*APINNO3*CH3CO3 + .82*r420*APINNO3*CH3O2 + .7*r421*APINNO3*HO2 + 1.86*r422*APINNO3*NO + + 2*r423*APINNO3*NO3 + r424*APINNO3*TERPA2CO3 + r425*APINNO3*TERPA3CO3 + r426*APINNO3*TERPACO3 + + .77*r430*APINO2*NO + r431*APINO2*NO3 + 1.64*r438*BCARYNO3*BCARYNO3 + r439*BCARYNO3*CH3CO3 + + .82*r440*BCARYNO3*CH3O2 + .5*r441*BCARYNO3*HO2 + 1.86*r442*BCARYNO3*NO + 2*r443*BCARYNO3*NO3 + + r444*BCARYNO3*TERPA2CO3 + r445*BCARYNO3*TERPA3CO3 + r446*BCARYNO3*TERPACO3 + .7*r450*BCARYO2*NO + + r451*BCARYO2*NO3 + .94*r458*BPINNO3*BPINNO3 + .5*r459*BPINNO3*CH3CO3 + .36*r460*BPINNO3*CH3O2 + + .24*r461*BPINNO3*HO2 + 1.39*r462*BPINNO3*NO + 1.5*r463*BPINNO3*NO3 + .5*r464*BPINNO3*TERPA2CO3 + + .5*r465*BPINNO3*TERPA3CO3 + .5*r466*BPINNO3*TERPACO3 + .75*r470*BPINO2*NO + r471*BPINO2*NO3 + + .46*r478*LIMONNO3*CH3CO3 + .31*r479*LIMONNO3*CH3O2 + .23*r480*LIMONNO3*HO2 + + .86*r481*LIMONNO3*LIMONNO3 + 1.36*r482*LIMONNO3*NO + 1.46*r483*LIMONNO3*NO3 + + .46*r484*LIMONNO3*TERPA2CO3 + .46*r485*LIMONNO3*TERPA3CO3 + .46*r486*LIMONNO3*TERPACO3 + + .77*r490*LIMONO2*NO + r491*LIMONO2*NO3 + .95*r498*MYRCNO3*CH3CO3 + .77*r499*MYRCNO3*CH3O2 + + .48*r500*MYRCNO3*HO2 + 1.54*r501*MYRCNO3*MYRCNO3 + 1.8200001*r502*MYRCNO3*NO + + 1.95*r503*MYRCNO3*NO3 + .95*r504*MYRCNO3*TERPA2CO3 + .95*r505*MYRCNO3*TERPA3CO3 + + .95*r506*MYRCNO3*TERPACO3 + .71*r510*MYRCO2*NO + r511*MYRCO2*NO3 + .7*r521*TERP1OOHO2*NO + + .7*r525*TERP2OOHO2*NO + .7*r529*TERPA1O2*NO + r530*TERPA1O2*NO3 + r537*TERPA2CO3*NO + + r538*TERPA2CO3*NO3 + .83*r545*TERPA2O2*NO + r546*TERPA2O2*NO3 + r551*TERPA2PAN*OH + + r555*TERPA3CO3*NO + r556*TERPA3CO3*NO3 + .7*r564*TERPA3O2*NO + r565*TERPA3O2*NO3 + + r570*TERPA3PAN*OH + .91*r574*TERPA4O2*NO + r575*TERPA4O2*NO3 + r585*TERPACO3*NO + + r586*TERPACO3*NO3 + r590*TERPAPAN*OH + r592*TERPF1*NO3 + .7*r594*TERPF1O2*NO + + .5*r597*TERPF2*NO3 + .7*r599*TERPF2O2*NO + r602*TERPFDN*OH + .7*r606*TERPNPS1O2*NO + + .7*r610*TERPNPT1O2*NO + .7*r614*TERPNS1O2*NO + r616*TERPNS*OH + .7*r618*TERPNT1O2*NO + + r620*TERPNT*OH + - j16*NO2 - r663*NO2 - r28*N*NO2 - r29*N*NO2 - r30*N*NO2 - r32*O*NO2 - r33*O3*NO2 + - r34*M*O*NO2 - r45*M*HO2*NO2 - r46*M*NO3*NO2 - r47*M*OH*NO2 - r65*M*CLO*NO2 - r96*M*BRO*NO2 + - r184*M*CH3CO3*NO2 - r239*M*MCO3*NO2 - r390*M*DICARBO2*NO2 - r393*M*MALO2*NO2 + - r396*M*MDIALO2*NO2 - r400*PHENO*NO2 - r403*M*ACBZO2*NO2 - r517*M*TERPA2CO3*NO2 + - r518*M*TERPA3CO3*NO2 - r519*M*TERPACO3*NO2 - r636*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j86*PAN + j121*BRONO2 + j138*CLONO2 + r50*M*N2O5 + + r33*NO2*O3 + r34*M*NO2*O + r48*HNO3*OH + r64*CLONO2*CL + r66*CLONO2*O + r67*CLONO2*OH + + r97*BRONO2*O + r111*F*HNO3 + r182*PAN*OH + r231*M*MPAN*OH + - j17*NO3 - j18*NO3 - r664*NO3 - r35*HO2*NO3 - r36*NO*NO3 - r37*O*NO3 - r38*OH*NO3 + - r46*M*NO2*NO3 - r132*CH2O*NO3 - r165*CH3CHO*NO3 - r186*C3H6*NO3 - r193*CH3COCHO*NO3 + - r207*BIGENE*NO3 - r226*MCO3*NO3 - r306*ISOP*NO3 - r311*ISOPNO3*NO3 - r417*APIN*NO3 + - r423*APINNO3*NO3 - r431*APINO2*NO3 - r437*BCARY*NO3 - r443*BCARYNO3*NO3 - r451*BCARYO2*NO3 + - r457*BPIN*NO3 - r463*BPINNO3*NO3 - r471*BPINO2*NO3 - r477*LIMON*NO3 - r483*LIMONNO3*NO3 + - r491*LIMONO2*NO3 - r497*MYRC*NO3 - r503*MYRCNO3*NO3 - r511*MYRCO2*NO3 - r530*TERPA1O2*NO3 + - r538*TERPA2CO3*NO3 - r541*TERPA2*NO3 - r546*TERPA2O2*NO3 - r556*TERPA3CO3*NO3 - r560*TERPA3*NO3 + - r565*TERPA3O2*NO3 - r575*TERPA4O2*NO3 - r586*TERPACO3*NO3 - r588*TERPA*NO3 - r592*TERPF1*NO3 + - r597*TERPF2*NO3 - r626*DMS*NO3 + d(NO3CH2CHO)/dt = .25*j80*MVKN + .44*r300*ISOPN4DO2*HO2 + .83*r302*ISOPN4D*O3 + .15*r304*ISOPNBNO3O2*HO2 + + .06*r312*ISOPNOOHBO2*HO2 + .12*r315*ISOPNOOHDO2*HO2 + .13*r317*ISOPNOOHD*O3 + + .1*r332*NC4CHOO2*HO2 + .22*r334*NC4CHO*O3 + .1*r335*NC4CHO*OH + .87*r352*ISOPN4DO2*NO + + .33*r354*ISOPNBNO3O2*NO + .07*r358*ISOPNOOHBO2*NO + .15*r360*ISOPNOOHDO2*NO + + .12*r372*NC4CHOO2*NO + - j83*NO3CH2CHO - r181*OH*NO3CH2CHO + d(NOA)/dt = .25*j74*MACRN + r186*C3H6*NO3 + .5*r213*MACRN*OH + .5*r232*MVKN*OH + .35*r256*INHED*OH + + .55*r290*ISOPN1DO2*HO2 + .83*r292*ISOPN1D*O3 + .15*r304*ISOPNBNO3O2*HO2 + + .28*r312*ISOPNOOHBO2*HO2 + .68*r315*ISOPNOOHDO2*HO2 + .7*r317*ISOPNOOHD*O3 + + .1*r332*NC4CHOO2*HO2 + .61*r334*NC4CHO*O3 + .35*r335*NC4CHO*OH + .94*r346*ISOPN1DO2*NO + + .34*r354*ISOPNBNO3O2*NO + .4*r358*ISOPNOOHBO2*NO + .81*r360*ISOPNOOHDO2*NO + + .13*r372*NC4CHOO2*NO + - j84*NOA - r197*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*j39*CH4 + + j40*CO2 + j119*BRO + j137*CLO + j151*OCLO + j155*SO + j156*SO2 + j157*SO3 + r3*N2*O1D + + r4*O2*O1D + r31*O2*N + r630*O2*S + r637*O2*SO + r13*H*HO2 + r23*OH*OH + r27*N*NO + r28*N*NO2 + - r8*O2*M*O - r6*O3*O - 2*r7*M*O*O - r9*H2*O - r10*H2O2*O - r15*HO2*O - r21*OH*O - r32*NO2*O + - r34*M*NO2*O - r37*NO3*O - r42*M*NO*O - r66*CLONO2*O - r68*CLO*O - r71*HCL*O - r74*HOCL*O + - r97*BRONO2*O - r98*BRO*O - r100*HBR*O - r102*HOBR*O - r133*CH2O*O - r628*OCS*O + d(O3)/dt = r8*O2*M*O + .15*r170*CH3CO3*HO2 + .15*r223*MCO3*HO2 + .15*r536*TERPA2CO3*HO2 + + .15*r554*TERPA3CO3*HO2 + .15*r584*TERPACO3*HO2 + - j7*O3 - j8*O3 - r5*O1D*O3 - r6*O*O3 - r16*HO2*O3 - r17*H*O3 - r22*OH*O3 - r33*NO2*O3 + - r41*NO*O3 - r57*CL*O3 - r89*BR*O3 - r156*C2H4*O3 - r187*C3H6*O3 - r218*MACR*O3 - r236*MVK*O3 + - r292*ISOPN1D*O3 - r302*ISOPN4D*O3 - r317*ISOPNOOHD*O3 - r319*ISOP*O3 - r334*NC4CHO*O3 + - r401*PHENO*O3 - r435*APIN*O3 - r455*BCARY*O3 - r475*BPIN*O3 - r495*LIMON*O3 - r515*MYRC*O3 + - r595*TERPF1*O3 - r600*TERPF2*O3 - r632*S*O3 - r638*SO*O3 + d(O3S)/dt = 0 + d(OCLO)/dt = r61*CLO*CLO + r91*BRO*CLO + - j151*OCLO - r639*SO*OCLO + d(OCS)/dt = - j154*OCS - r628*O*OCS - r629*OH*OCS + d(ONITR)/dt = r212*HONITR*OH + .5*r232*MVKN*OH + - j85*ONITR - r665*ONITR + d(PAN)/dt = r184*M*CH3CO3*NO2 + - j86*PAN - r185*M*PAN - r182*OH*PAN + d(PBZNIT)/dt = r403*M*ACBZO2*NO2 + - r408*M*PBZNIT + d(PHENO)/dt = j30*C6H5OOH + r385*C6H5O2*NO + .07*r387*CRESOL*OH + .06*r399*PHENOL*OH + .07*r415*XYLOL*OH + - r400*NO2*PHENO - r401*O3*PHENO + d(PHENOL)/dt = .53*r376*BENZENE*OH + - r399*OH*PHENOL + d(PHENOOH)/dt = r397*PHENO2*HO2 + - j87*PHENOOH - r402*OH*PHENOOH + d(pom_a1)/dt = 0 + d(pom_a4)/dt = 0 + d(POOH)/dt = r198*PO2*HO2 + - j88*POOH - r200*OH*POOH + d(ROOH)/dt = .85*r202*RO2*HO2 + - j89*ROOH - r204*OH*ROOH + d(S)/dt = j154*OCS + j155*SO + - r630*O2*S - r632*O3*S - r635*OH*S + d(SF6)/dt = - j152*SF6 + d(SO)/dt = j156*SO2 + r630*O2*S + r628*OCS*O + r632*S*O3 + r635*S*OH + - j155*SO - r637*O2*SO - r633*BRO*SO - r634*CLO*SO - r636*NO2*SO - r638*O3*SO - r639*OCLO*SO + - r640*OH*SO + d(SO2)/dt = j157*SO3 + r637*O2*SO + r626*DMS*NO3 + r627*DMS*OH + r629*OCS*OH + r633*SO*BRO + r634*SO*CLO + + r636*SO*NO2 + r638*SO*O3 + r639*SO*OCLO + r640*SO*OH + .5*r641*DMS*OH + - j156*SO2 - r631*M*OH*SO2 + d(SO3)/dt = j153*H2SO4 + r631*M*SO2*OH + - j157*SO3 - r642*H2O*SO3 + d(so4_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(so4_a3)/dt = 0 + d(so4_a5)/dt = 0 + d(soa1_a1)/dt = - j158*soa1_a1 + d(soa1_a2)/dt = - j159*soa1_a2 + d(soa2_a1)/dt = - j160*soa2_a1 + d(soa2_a2)/dt = - j161*soa2_a2 + d(soa3_a1)/dt = - j162*soa3_a1 + d(soa3_a2)/dt = - j163*soa3_a2 + d(soa4_a1)/dt = - j164*soa4_a1 + d(soa4_a2)/dt = - j165*soa4_a2 + d(soa5_a1)/dt = - j166*soa5_a1 + d(soa5_a2)/dt = - j167*soa5_a2 + d(SOAG0)/dt = r644*GLYOXAL + .0508*r675*APINO2VBS*HO2 + .0245*r676*APINO2VBS*NO + .0508*r677*APIN*O3 + + .2202*r680*BCARYO2VBS*HO2 + .1279*r681*BCARYO2VBS*NO + .2202*r682*BCARY*O3 + + .0023*r685*BENZO2VBS*HO2 + .0097*r686*BENZO2VBS*NO + .0508*r688*BPINO2VBS*HO2 + + .0245*r689*BPINO2VBS*NO + .0508*r690*BPIN*O3 + .0031*r693*ISOPO2VBS*HO2 + + .0003*r694*ISOPO2VBS*NO + .2381*r697*IVOCO2VBS*HO2 + .1056*r698*IVOCO2VBS*NO + + .0508*r701*LIMONO2VBS*HO2 + .0245*r702*LIMONO2VBS*NO + .0508*r703*LIMON*O3 + + .0508*r706*MYRCO2VBS*HO2 + .0245*r707*MYRCO2VBS*NO + .0508*r708*MYRC*O3 + .5931*r710*SVOC*OH + + .1364*r712*TOLUO2VBS*HO2 + .0154*r713*TOLUO2VBS*NO + .1677*r715*XYLEO2VBS*HO2 + + .0063*r716*XYLEO2VBS*NO + d(SOAG1)/dt = .1149*r675*APINO2VBS*HO2 + .0082*r676*APINO2VBS*NO + .1149*r677*APIN*O3 + + .2067*r680*BCARYO2VBS*HO2 + .1792*r681*BCARYO2VBS*NO + .2067*r682*BCARY*O3 + + .0008*r685*BENZO2VBS*HO2 + .0034*r686*BENZO2VBS*NO + .1149*r688*BPINO2VBS*HO2 + + .0082*r689*BPINO2VBS*NO + .1149*r690*BPIN*O3 + .0035*r693*ISOPO2VBS*HO2 + + .0003*r694*ISOPO2VBS*NO + .1308*r697*IVOCO2VBS*HO2 + .1026*r698*IVOCO2VBS*NO + + .1149*r701*LIMONO2VBS*HO2 + .0082*r702*LIMONO2VBS*NO + .1149*r703*LIMON*O3 + + .1149*r706*MYRCO2VBS*HO2 + .0082*r707*MYRCO2VBS*NO + .1149*r708*MYRC*O3 + .1534*r710*SVOC*OH + + .0101*r712*TOLUO2VBS*HO2 + .0452*r713*TOLUO2VBS*NO + .0174*r715*XYLEO2VBS*HO2 + + .0237*r716*XYLEO2VBS*NO + d(SOAG2)/dt = .0348*r675*APINO2VBS*HO2 + .0772*r676*APINO2VBS*NO + .0348*r677*APIN*O3 + + .0653*r680*BCARYO2VBS*HO2 + .0676*r681*BCARYO2VBS*NO + .0653*r682*BCARY*O3 + + .0843*r685*BENZO2VBS*HO2 + .1579*r686*BENZO2VBS*NO + .0348*r688*BPINO2VBS*HO2 + + .0772*r689*BPINO2VBS*NO + .0348*r690*BPIN*O3 + .0003*r693*ISOPO2VBS*HO2 + + .0073*r694*ISOPO2VBS*NO + .0348*r697*IVOCO2VBS*HO2 + .0521*r698*IVOCO2VBS*NO + + .0348*r701*LIMONO2VBS*HO2 + .0772*r702*LIMONO2VBS*NO + .0348*r703*LIMON*O3 + + .0348*r706*MYRCO2VBS*HO2 + .0772*r707*MYRCO2VBS*NO + .0348*r708*MYRC*O3 + .0459*r710*SVOC*OH + + .0763*r712*TOLUO2VBS*HO2 + .0966*r713*TOLUO2VBS*NO + .086*r715*XYLEO2VBS*HO2 + + .0025*r716*XYLEO2VBS*NO + d(SOAG3)/dt = .17493*r674*APIN*NO3 + .0554*r675*APINO2VBS*HO2 + .0332*r676*APINO2VBS*NO + .0554*r677*APIN*O3 + + .17493*r679*BCARY*NO3 + .1284*r680*BCARYO2VBS*HO2 + .079*r681*BCARYO2VBS*NO + + .1284*r682*BCARY*O3 + .0443*r685*BENZO2VBS*HO2 + .0059*r686*BENZO2VBS*NO + + .17493*r687*BPIN*NO3 + .0554*r688*BPINO2VBS*HO2 + .0332*r689*BPINO2VBS*NO + .0554*r690*BPIN*O3 + + .059024*r692*ISOP*NO3 + .0271*r693*ISOPO2VBS*HO2 + .0057*r694*ISOPO2VBS*NO + + .0033*r695*ISOP*O3 + .0076*r697*IVOCO2VBS*HO2 + .0143*r698*IVOCO2VBS*NO + + .17493*r700*LIMON*NO3 + .0554*r701*LIMONO2VBS*HO2 + .0332*r702*LIMONO2VBS*NO + + .0554*r703*LIMON*O3 + .17493*r705*MYRC*NO3 + .0554*r706*MYRCO2VBS*HO2 + + .0332*r707*MYRCO2VBS*NO + .0554*r708*MYRC*O3 + .0085*r710*SVOC*OH + .2157*r712*TOLUO2VBS*HO2 + + .0073*r713*TOLUO2VBS*NO + .0512*r715*XYLEO2VBS*HO2 + .011*r716*XYLEO2VBS*NO + d(SOAG4)/dt = .59019*r674*APIN*NO3 + .1278*r675*APINO2VBS*HO2 + .13*r676*APINO2VBS*NO + .1278*r677*APIN*O3 + + .59019*r679*BCARY*NO3 + .114*r680*BCARYO2VBS*HO2 + .1254*r681*BCARYO2VBS*NO + + .114*r682*BCARY*O3 + .1621*r685*BENZO2VBS*HO2 + .0536*r686*BENZO2VBS*NO + .59019*r687*BPIN*NO3 + + .1278*r688*BPINO2VBS*HO2 + .13*r689*BPINO2VBS*NO + .1278*r690*BPIN*O3 + .025024*r692*ISOP*NO3 + + .0474*r693*ISOPO2VBS*HO2 + .0623*r694*ISOPO2VBS*NO + .0113*r697*IVOCO2VBS*HO2 + + .0166*r698*IVOCO2VBS*NO + .59019*r700*LIMON*NO3 + .1278*r701*LIMONO2VBS*HO2 + + .13*r702*LIMONO2VBS*NO + .1278*r703*LIMON*O3 + .59019*r705*MYRC*NO3 + .1278*r706*MYRCO2VBS*HO2 + + .13*r707*MYRCO2VBS*NO + .1278*r708*MYRC*O3 + .0128*r710*SVOC*OH + .0738*r712*TOLUO2VBS*HO2 + + .238*r713*TOLUO2VBS*NO + .1598*r715*XYLEO2VBS*HO2 + .1185*r716*XYLEO2VBS*NO + d(SQTN)/dt = .36*r438*BCARYNO3*BCARYNO3 + .18*r440*BCARYNO3*CH3O2 + .5*r441*BCARYNO3*HO2 + .07*r442*BCARYNO3*NO + + .3*r450*BCARYO2*NO + - r666*SQTN + d(ST80_25)/dt = - r737*ST80_25 + d(SVOC)/dt = - r710*OH*SVOC + d(TEPOMUC)/dt = .1*r407*TOLUENE*OH + .23*r409*XYLENES*OH + - j90*TEPOMUC + d(TERP1OOH)/dt = .14*r427*APINO2*CH3CO3 + .13*r428*APINO2*CH3O2 + .25*r429*APINO2*HO2 + .11*r430*APINO2*NO + + .14*r431*APINO2*NO3 + .14*r432*APINO2*TERPA2CO3 + .14*r433*APINO2*TERPA3CO3 + + .14*r434*APINO2*TERPACO3 + .68*r469*BPINO2*HO2 + .9*r489*LIMONO2*HO2 + + .18*r524*TERP2OOHO2*HO2 + .7*r525*TERP2OOHO2*NO + .9*r598*TERPF2O2*HO2 + - j91*TERP1OOH - r522*OH*TERP1OOH + d(TERP2AOOH)/dt = .9*r449*BCARYO2*HO2 + .9*r509*MYRCO2*HO2 + - j92*TERP2AOOH - r523*OH*TERP2AOOH + d(TERPA)/dt = .5*j105*TERPNPS + j107*TERPNPT + j109*TERPNS + j111*TERPNT + j113*TERPOOH + + 1.64*r418*APINNO3*APINNO3 + r419*APINNO3*CH3CO3 + .82*r420*APINNO3*CH3O2 + .7*r421*APINNO3*HO2 + + .93*r422*APINNO3*NO + r423*APINNO3*NO3 + r424*APINNO3*TERPA2CO3 + r425*APINNO3*TERPA3CO3 + + r426*APINNO3*TERPACO3 + .39*r427*APINO2*CH3CO3 + .42*r428*APINO2*CH3O2 + .29*r429*APINO2*HO2 + + .3*r430*APINO2*NO + .39*r431*APINO2*NO3 + .39*r432*APINO2*TERPA2CO3 + + .39*r433*APINO2*TERPA3CO3 + .39*r434*APINO2*TERPACO3 + .22*r435*APIN*O3 + r616*TERPNS*OH + + r620*TERPNT*OH + r622*TERPOOH*OH + - j93*TERPA - r588*NO3*TERPA - r589*OH*TERPA + d(TERPA2)/dt = .17*r435*APIN*O3 + .5*r527*TERPA1O2*CH3O2 + r590*TERPAPAN*OH + - j94*TERPA2 - r541*NO3*TERPA2 - r550*OH*TERPA2 + d(TERPA2PAN)/dt = r517*M*TERPA2CO3*NO2 + - j95*TERPA2PAN - r623*M*TERPA2PAN - r551*OH*TERPA2PAN + d(TERPA3)/dt = j114*TERPOOHL + .35*r427*APINO2*CH3CO3 + .2*r428*APINO2*CH3O2 + .27*r430*APINO2*NO + + .35*r431*APINO2*NO3 + .35*r432*APINO2*TERPA2CO3 + .35*r433*APINO2*TERPA3CO3 + + .35*r434*APINO2*TERPACO3 + .9*r458*BPINNO3*BPINNO3 + .48*r459*BPINNO3*CH3CO3 + + .34*r460*BPINNO3*CH3O2 + .22*r461*BPINNO3*HO2 + .44*r462*BPINNO3*NO + .48*r463*BPINNO3*NO3 + + .48*r464*BPINNO3*TERPA2CO3 + .48*r465*BPINNO3*TERPA3CO3 + .48*r466*BPINNO3*TERPACO3 + + .41*r467*BPINO2*CH3CO3 + .31*r468*BPINO2*CH3O2 + .31*r470*BPINO2*NO + .41*r471*BPINO2*NO3 + + .41*r472*BPINO2*TERPA2CO3 + .41*r473*BPINO2*TERPA3CO3 + .41*r474*BPINO2*TERPACO3 + + r592*TERPF1*NO3 + .1*r593*TERPF1O2*HO2 + .7*r594*TERPF1O2*NO + r595*TERPF1*O3 + + r621*TERPOOHL*OH + - j96*TERPA3 - r560*NO3*TERPA3 - r569*OH*TERPA3 + d(TERPA3PAN)/dt = r518*M*TERPA3CO3*NO2 + - j97*TERPA3PAN - r624*M*TERPA3PAN - r570*OH*TERPA3PAN + d(TERPACID)/dt = .01*r435*APIN*O3 + .13*r455*BCARY*O3 + .01*r495*LIMON*O3 + .51*r584*TERPACO3*HO2 + - j98*TERPACID - r581*OH*TERPACID + d(TERPACID2)/dt = .51*r536*TERPA2CO3*HO2 + - j99*TERPACID2 - r579*OH*TERPACID2 + d(TERPACID3)/dt = .51*r554*TERPA3CO3*HO2 + - j100*TERPACID3 - r580*OH*TERPACID3 + d(TERPAPAN)/dt = r519*M*TERPACO3*NO2 + - j101*TERPAPAN - r625*M*TERPAPAN - r590*OH*TERPAPAN + d(TERPDHDP)/dt = .82*r520*TERP1OOHO2*HO2 + .82*r524*TERP2OOHO2*HO2 + - j102*TERPDHDP - r667*TERPDHDP - r591*OH*TERPDHDP + d(TERPF1)/dt = j91*TERP1OOH + .46*j106*TERPNPS1 + .46*j108*TERPNPT1 + j110*TERPNS1 + j112*TERPNT1 + + .12*r427*APINO2*CH3CO3 + .14*r428*APINO2*CH3O2 + .06*r429*APINO2*HO2 + .09*r430*APINO2*NO + + .12*r431*APINO2*NO3 + .12*r432*APINO2*TERPA2CO3 + .12*r433*APINO2*TERPA3CO3 + + .12*r434*APINO2*TERPACO3 + .27*r467*BPINO2*CH3CO3 + .37*r468*BPINO2*CH3O2 + .2*r470*BPINO2*NO + + .27*r471*BPINO2*NO3 + .27*r472*BPINO2*TERPA2CO3 + .27*r473*BPINO2*TERPA3CO3 + + .27*r474*BPINO2*TERPACO3 + .46*r478*LIMONNO3*CH3CO3 + .31*r479*LIMONNO3*CH3O2 + + .23*r480*LIMONNO3*HO2 + .86*r481*LIMONNO3*LIMONNO3 + .43*r482*LIMONNO3*NO + + .46*r483*LIMONNO3*NO3 + .46*r484*LIMONNO3*TERPA2CO3 + .46*r485*LIMONNO3*TERPA3CO3 + + .46*r486*LIMONNO3*TERPACO3 + r487*LIMONO2*CH3CO3 + r488*LIMONO2*CH3O2 + .1*r489*LIMONO2*HO2 + + .77*r490*LIMONO2*NO + r491*LIMONO2*NO3 + r492*LIMONO2*TERPA2CO3 + r493*LIMONO2*TERPA3CO3 + + r494*LIMONO2*TERPACO3 + .66*r495*LIMON*O3 + .5*r597*TERPF2*NO3 + .1*r598*TERPF2O2*HO2 + + .7*r599*TERPF2O2*NO + r600*TERPF2*O3 + - r592*NO3*TERPF1 - r595*O3*TERPF1 - r596*OH*TERPF1 + d(TERPF2)/dt = j92*TERP2AOOH + 1.64*r438*BCARYNO3*BCARYNO3 + r439*BCARYNO3*CH3CO3 + .82*r440*BCARYNO3*CH3O2 + + .5*r441*BCARYNO3*HO2 + .93*r442*BCARYNO3*NO + r443*BCARYNO3*NO3 + r444*BCARYNO3*TERPA2CO3 + + r445*BCARYNO3*TERPA3CO3 + r446*BCARYNO3*TERPACO3 + r447*BCARYO2*CH3CO3 + r448*BCARYO2*CH3O2 + + .1*r449*BCARYO2*HO2 + .7*r450*BCARYO2*NO + r451*BCARYO2*NO3 + r452*BCARYO2*TERPA2CO3 + + r453*BCARYO2*TERPA3CO3 + r454*BCARYO2*TERPACO3 + .87*r455*BCARY*O3 + .95*r498*MYRCNO3*CH3CO3 + + .77*r499*MYRCNO3*CH3O2 + .48*r500*MYRCNO3*HO2 + 1.54*r501*MYRCNO3*MYRCNO3 + + .89*r502*MYRCNO3*NO + .95*r503*MYRCNO3*NO3 + .95*r504*MYRCNO3*TERPA2CO3 + + .95*r505*MYRCNO3*TERPA3CO3 + .95*r506*MYRCNO3*TERPACO3 + r507*MYRCO2*CH3CO3 + + r508*MYRCO2*CH3O2 + .1*r509*MYRCO2*HO2 + .71*r510*MYRCO2*NO + r511*MYRCO2*NO3 + + r512*MYRCO2*TERPA2CO3 + r513*MYRCO2*TERPA3CO3 + r514*MYRCO2*TERPACO3 + r515*MYRC*O3 + - r597*NO3*TERPF2 - r600*O3*TERPF2 - r601*OH*TERPF2 + d(TERPFDN)/dt = .07*r422*APINNO3*NO + .07*r462*BPINNO3*NO + .07*r482*LIMONNO3*NO + .07*r502*MYRCNO3*NO + + .3*r606*TERPNPS1O2*NO + .3*r610*TERPNPT1O2*NO + .3*r614*TERPNS1O2*NO + .3*r618*TERPNT1O2*NO + - j103*TERPFDN - r668*TERPFDN - r602*OH*TERPFDN + d(TERPHFN)/dt = .01*r430*APINO2*NO + .3*r521*TERP1OOHO2*NO + .3*r525*TERP2OOHO2*NO + .3*r594*TERPF1O2*NO + + .9*r605*TERPNPS1O2*HO2 + .9*r609*TERPNPT1O2*HO2 + .9*r613*TERPNS1O2*HO2 + + .9*r617*TERPNT1O2*HO2 + - j104*TERPHFN - r669*TERPHFN - r603*OH*TERPHFN + d(TERPK)/dt = .11*r428*APINO2*CH3O2 + .04*r458*BPINNO3*BPINNO3 + .02*r459*BPINNO3*CH3CO3 + + .02*r460*BPINNO3*CH3O2 + .02*r461*BPINNO3*HO2 + .02*r462*BPINNO3*NO + .02*r463*BPINNO3*NO3 + + .02*r464*BPINNO3*TERPA2CO3 + .02*r465*BPINNO3*TERPA3CO3 + .02*r466*BPINNO3*TERPACO3 + + .32*r467*BPINO2*CH3CO3 + .32*r468*BPINO2*CH3O2 + .03*r469*BPINO2*HO2 + .24*r470*BPINO2*NO + + .32*r471*BPINO2*NO3 + .32*r472*BPINO2*TERPA2CO3 + .32*r473*BPINO2*TERPA3CO3 + + .32*r474*BPINO2*TERPACO3 + .51*r475*BPIN*O3 + - r604*OH*TERPK + d(TERPNPS)/dt = .45*r461*BPINNO3*HO2 + .1*r605*TERPNPS1O2*HO2 + .7*r606*TERPNPS1O2*NO + - j105*TERPNPS - r608*OH*TERPNPS + d(TERPNPS1)/dt = .32*r480*LIMONNO3*HO2 + .36*r500*MYRCNO3*HO2 + - j106*TERPNPS1 - r607*OH*TERPNPS1 + d(TERPNPT)/dt = .3*r421*APINNO3*HO2 + .08*r461*BPINNO3*HO2 + .1*r609*TERPNPT1O2*HO2 + .7*r610*TERPNPT1O2*NO + - j107*TERPNPT - r671*TERPNPT - r612*OH*TERPNPT + d(TERPNPT1)/dt = .18*r480*LIMONNO3*HO2 + .16*r500*MYRCNO3*HO2 + - j108*TERPNPT1 - r670*TERPNPT1 - r611*OH*TERPNPT1 + d(TERPNS)/dt = j103*TERPFDN + j104*TERPHFN + .5*j105*TERPNPS + .09*r418*APINNO3*APINNO3 + + .09*r420*APINNO3*CH3O2 + .1*r430*APINO2*NO + .92*r458*BPINNO3*BPINNO3 + + .45*r459*BPINNO3*CH3CO3 + .56*r460*BPINNO3*CH3O2 + .23*r461*BPINNO3*HO2 + .42*r462*BPINNO3*NO + + .45*r463*BPINNO3*NO3 + .45*r464*BPINNO3*TERPA2CO3 + .45*r465*BPINNO3*TERPA3CO3 + + .45*r466*BPINNO3*TERPACO3 + .02*r470*BPINO2*NO + .3*r529*TERPA1O2*NO + .09*r574*TERPA4O2*NO + + r602*TERPFDN*OH + r603*TERPHFN*OH + .1*r613*TERPNS1O2*HO2 + .7*r614*TERPNS1O2*NO + - j109*TERPNS - r616*OH*TERPNS + d(TERPNS1)/dt = .54*j106*TERPNPS1 + .02*r430*APINO2*NO + .04*r470*BPINO2*NO + .35*r478*LIMONNO3*CH3CO3 + + .42*r479*LIMONNO3*CH3O2 + .18*r480*LIMONNO3*HO2 + .72*r481*LIMONNO3*LIMONNO3 + + .33*r482*LIMONNO3*NO + .35*r483*LIMONNO3*NO3 + .35*r484*LIMONNO3*TERPA2CO3 + + .35*r485*LIMONNO3*TERPA3CO3 + .35*r486*LIMONNO3*TERPACO3 + .06*r490*LIMONO2*NO + + .05*r498*MYRCNO3*CH3CO3 + .14*r499*MYRCNO3*CH3O2 + .19*r501*MYRCNO3*MYRCNO3 + + .04*r502*MYRCNO3*NO + .05*r503*MYRCNO3*NO3 + .05*r504*MYRCNO3*TERPA2CO3 + + .05*r505*MYRCNO3*TERPA3CO3 + .05*r506*MYRCNO3*TERPACO3 + .1*r510*MYRCO2*NO + + .5*r597*TERPF2*NO3 + .12*r599*TERPF2O2*NO + - j110*TERPNS1 - r615*OH*TERPNS1 + d(TERPNT)/dt = .27*r418*APINNO3*APINNO3 + .09*r420*APINNO3*CH3O2 + .05*r430*APINO2*NO + + .14*r458*BPINNO3*BPINNO3 + .05*r459*BPINNO3*CH3CO3 + .08*r460*BPINNO3*CH3O2 + + .05*r462*BPINNO3*NO + .05*r463*BPINNO3*NO3 + .05*r464*BPINNO3*TERPA2CO3 + + .05*r465*BPINNO3*TERPA3CO3 + .05*r466*BPINNO3*TERPACO3 + .06*r470*BPINO2*NO + + .17*r545*TERPA2O2*NO + .3*r564*TERPA3O2*NO + r612*TERPNPT*OH + .1*r617*TERPNT1O2*HO2 + + .7*r618*TERPNT1O2*NO + - j111*TERPNT - r673*TERPNT - r620*OH*TERPNT + d(TERPNT1)/dt = .54*j108*TERPNPT1 + .05*r430*APINO2*NO + .13*r470*BPINO2*NO + .19*r478*LIMONNO3*CH3CO3 + + .27*r479*LIMONNO3*CH3O2 + .09*r480*LIMONNO3*HO2 + .42*r481*LIMONNO3*LIMONNO3 + + .17*r482*LIMONNO3*NO + .19*r483*LIMONNO3*NO3 + .19*r484*LIMONNO3*TERPA2CO3 + + .19*r485*LIMONNO3*TERPA3CO3 + .19*r486*LIMONNO3*TERPACO3 + .17*r490*LIMONO2*NO + + .09*r499*MYRCNO3*CH3O2 + .27*r501*MYRCNO3*MYRCNO3 + .19*r510*MYRCO2*NO + + .18*r599*TERPF2O2*NO + - j112*TERPNT1 - r672*TERPNT1 - r619*OH*TERPNT1 + d(TERPOOH)/dt = j102*TERPDHDP + .4*r429*APINO2*HO2 + .29*r469*BPINO2*HO2 + r528*TERPA1O2*HO2 + + .62*r544*TERPA2O2*HO2 + r591*TERPDHDP*OH + - j113*TERPOOH - r622*OH*TERPOOH + d(TERPOOHL)/dt = .18*r520*TERP1OOHO2*HO2 + .7*r521*TERP1OOHO2*NO + .85*r563*TERPA3O2*HO2 + + .47*r573*TERPA4O2*HO2 + .9*r593*TERPF1O2*HO2 + - j114*TERPOOHL - r621*OH*TERPOOHL + d(TOLOOH)/dt = r404*TOLO2*HO2 + - j115*TOLOOH - r406*OH*TOLOOH + d(TOLUENE)/dt = - r407*OH*TOLUENE + d(XYLENES)/dt = - r409*OH*XYLENES + d(XYLENOOH)/dt = r410*XYLENO2*HO2 + - j116*XYLENOOH - r412*OH*XYLENOOH + d(XYLOL)/dt = .15*r409*XYLENES*OH + - r415*OH*XYLOL + d(XYLOLOOH)/dt = r413*XYLOLO2*HO2 + - j117*XYLOLOOH - r416*OH*XYLOLOOH + d(NHDEP)/dt = r662*NH4 + r643*NH3*OH + d(NDEP)/dt = r390*M*DICARBO2*NO2 + r393*M*MALO2*NO2 + r396*M*MDIALO2*NO2 + r400*PHENO*NO2 + d(ACBZO2)/dt = r408*M*PBZNIT + r380*BZALD*OH + - r374*HO2*ACBZO2 - r375*NO*ACBZO2 - r403*M*NO2*ACBZO2 + d(ALKO2)/dt = r245*ALKOOH*OH + r246*BIGALK*OH + - r242*HO2*ALKO2 - r243*NO*ALKO2 - r244*NO*ALKO2 + d(APINNO3)/dt = r417*APIN*NO3 + - 2*r418*APINNO3*APINNO3 - r419*CH3CO3*APINNO3 - r420*CH3O2*APINNO3 - r421*HO2*APINNO3 + - r422*NO*APINNO3 - r423*NO3*APINNO3 - r424*TERPA2CO3*APINNO3 - r425*TERPA3CO3*APINNO3 + - r426*TERPACO3*APINNO3 + d(APINO2)/dt = r436*APIN*OH + - r427*CH3CO3*APINO2 - r428*CH3O2*APINO2 - r429*HO2*APINO2 - r430*NO*APINO2 - r431*NO3*APINO2 + - r432*TERPA2CO3*APINO2 - r433*TERPA3CO3*APINO2 - r434*TERPACO3*APINO2 + d(APINO2VBS)/dt = r678*APIN*OH + - r675*HO2*APINO2VBS - r676*NO*APINO2VBS + d(BCARYNO3)/dt = r437*BCARY*NO3 + - 2*r438*BCARYNO3*BCARYNO3 - r439*CH3CO3*BCARYNO3 - r440*CH3O2*BCARYNO3 - r441*HO2*BCARYNO3 + - r442*NO*BCARYNO3 - r443*NO3*BCARYNO3 - r444*TERPA2CO3*BCARYNO3 - r445*TERPA3CO3*BCARYNO3 + - r446*TERPACO3*BCARYNO3 + d(BCARYO2)/dt = r456*BCARY*OH + - r447*CH3CO3*BCARYO2 - r448*CH3O2*BCARYO2 - r449*HO2*BCARYO2 - r450*NO*BCARYO2 + - r451*NO3*BCARYO2 - r452*TERPA2CO3*BCARYO2 - r453*TERPA3CO3*BCARYO2 - r454*TERPACO3*BCARYO2 + d(BCARYO2VBS)/dt = r683*BCARY*OH + - r680*HO2*BCARYO2VBS - r681*NO*BCARYO2VBS + d(BENZO2)/dt = .35*r376*BENZENE*OH + r379*BENZOOH*OH + - r377*HO2*BENZO2 - r378*NO*BENZO2 + d(BENZO2VBS)/dt = r684*BENZENE*OH + - r685*HO2*BENZO2VBS - r686*NO*BENZO2VBS + d(BPINNO3)/dt = r457*BPIN*NO3 + r608*TERPNPS*OH + - 2*r458*BPINNO3*BPINNO3 - r459*CH3CO3*BPINNO3 - r460*CH3O2*BPINNO3 - r461*HO2*BPINNO3 + - r462*NO*BPINNO3 - r463*NO3*BPINNO3 - r464*TERPA2CO3*BPINNO3 - r465*TERPA3CO3*BPINNO3 + - r466*TERPACO3*BPINNO3 + d(BPINO2)/dt = r476*BPIN*OH + - r467*CH3CO3*BPINO2 - r468*CH3O2*BPINO2 - r469*HO2*BPINO2 - r470*NO*BPINO2 - r471*NO3*BPINO2 + - r472*TERPA2CO3*BPINO2 - r473*TERPA3CO3*BPINO2 - r474*TERPACO3*BPINO2 + d(BPINO2VBS)/dt = r691*BPIN*OH + - r688*HO2*BPINO2VBS - r689*NO*BPINO2VBS + d(BZOO)/dt = r382*BZOOH*OH + .07*r407*TOLUENE*OH + .06*r409*XYLENES*OH + - r381*HO2*BZOO - r383*NO*BZOO + d(C2H5O2)/dt = j76*MEK + .5*r162*C2H5OOH*OH + r163*C2H6*CL + r164*C2H6*OH + - 2*r157*C2H5O2*C2H5O2 - r158*CH3O2*C2H5O2 - r159*HO2*C2H5O2 - r160*NO*C2H5O2 + d(C3H7O2)/dt = r191*C3H7OOH*OH + r192*C3H8*OH + - r188*CH3O2*C3H7O2 - r189*HO2*C3H7O2 - r190*NO*C3H7O2 + d(C6H5O2)/dt = .4*r374*ACBZO2*HO2 + r375*ACBZO2*NO + r386*C6H5OOH*OH + r401*PHENO*O3 + - r384*HO2*C6H5O2 - r385*NO*C6H5O2 + d(CH3CO3)/dt = j26*BIGALD4 + j34*CH3COCH3 + j35*CH3COCHO + .33*j47*HONITR + .05*j48*HPALD1 + .07*j49*HPALD4 + + j52*HYAC + .5*j53*HYDRALD + j55*HYPERACET + j56*HYPERACET + .35*j72*MACR + j76*MEK + + j77*MEKOOH + .3*j79*MVK + .75*j80*MVKN + .56*j81*MVKOOH + j84*NOA + .6*j86*PAN + j89*ROOH + + .5*j90*TEPOMUC + r185*M*PAN + r165*CH3CHO*NO3 + r166*CH3CHO*OH + .5*r173*CH3COOOH*OH + + r193*CH3COCHO*NO3 + r194*CH3COCHO*OH + .3*r196*HYPERACET*OH + .3*r201*RO2*CH3O2 + + .15*r202*RO2*HO2 + r203*RO2*NO + .1*r218*MACR*O3 + .35*r221*MCO3*CH3CO3 + + .35*r222*MCO3*CH3O2 + .17*r223*MCO3*HO2 + .7*r224*MCO3*MCO3 + .35*r225*MCO3*NO + + .35*r226*MCO3*NO3 + .2*r227*MEKO2*HO2 + r228*MEKO2*NO + .75*r233*MVKO2*CH3CO3 + + .88*r234*MVKO2*CH3O2 + .49*r235*MVKO2*HO2 + .28*r236*MVK*O3 + .56*r238*MVKOOH*OH + + .06*r247*HPALD1*OH + .06*r248*HPALD4*OH + .07*r319*ISOP*O3 + .04*r334*NC4CHO*O3 + + .1*r335*NC4CHO*OH + .76*r370*MVKO2*NO + .33*r495*LIMON*O3 + 2*r570*TERPA3PAN*OH + + r572*TERPA4O2*CH3O2 + .53*r573*TERPA4O2*HO2 + .91*r574*TERPA4O2*NO + r575*TERPA4O2*NO3 + + r576*TERPA4O2*TERPA2CO3 + r577*TERPA4O2*TERPA3CO3 + r578*TERPA4O2*TERPACO3 + - 2*r168*CH3CO3*CH3CO3 - r169*CH3O2*CH3CO3 - r170*HO2*CH3CO3 - r171*NO*CH3CO3 + - r184*M*NO2*CH3CO3 - r214*MACRO2*CH3CO3 - r221*MCO3*CH3CO3 - r233*MVKO2*CH3CO3 + - r257*ISOPB1O2*CH3CO3 - r263*ISOPB4O2*CH3CO3 - r277*ISOPED1O2*CH3CO3 - r281*ISOPED4O2*CH3CO3 + - r307*ISOPNO3*CH3CO3 - r324*ISOPZD1O2*CH3CO3 - r328*ISOPZD4O2*CH3CO3 - r419*APINNO3*CH3CO3 + - r427*APINO2*CH3CO3 - r439*BCARYNO3*CH3CO3 - r447*BCARYO2*CH3CO3 - r459*BPINNO3*CH3CO3 + - r467*BPINO2*CH3CO3 - r478*LIMONNO3*CH3CO3 - r487*LIMONO2*CH3CO3 - r498*MYRCNO3*CH3CO3 + - r507*MYRCO2*CH3CO3 - r526*TERPA1O2*CH3CO3 - r534*TERPA2CO3*CH3CO3 - r542*TERPA2O2*CH3CO3 + - r552*TERPA3CO3*CH3CO3 - r561*TERPA3O2*CH3CO3 - r582*TERPACO3*CH3CO3 + d(CH3O2)/dt = j33*CH3CHO + j34*CH3COCH3 + j36*CH3COOOH + j38*CH4 + .04*j48*HPALD1 + .07*j49*HPALD4 + + .65*j72*MACR + .3*j79*MVK + .4*j86*PAN + j131*CH3BR + j133*CH3CL + r52*CL*CH4 + r108*F*CH4 + + .7*r140*CH3OOH*OH + r141*CH4*OH + r148*O1D*CH4 + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + + .49*r170*CH3CO3*HO2 + r171*CH3CO3*NO + r172*CH3COOH*OH + .28*r187*C3H6*O3 + + r214*MACRO2*CH3CO3 + 1.65*r221*MCO3*CH3CO3 + .65*r222*MCO3*CH3O2 + .32*r223*MCO3*HO2 + + 1.3*r224*MCO3*MCO3 + .65*r225*MCO3*NO + .65*r226*MCO3*NO3 + r233*MVKO2*CH3CO3 + + .06*r247*HPALD1*OH + .06*r248*HPALD4*OH + r257*ISOPB1O2*CH3CO3 + r263*ISOPB4O2*CH3CO3 + + r277*ISOPED1O2*CH3CO3 + r281*ISOPED4O2*CH3CO3 + r307*ISOPNO3*CH3CO3 + .21*r319*ISOP*O3 + + r324*ISOPZD1O2*CH3CO3 + r328*ISOPZD4O2*CH3CO3 + .33*r388*DICARBO2*HO2 + .83*r389*DICARBO2*NO + + .07*r394*MDIALO2*HO2 + .17*r395*MDIALO2*NO + r419*APINNO3*CH3CO3 + r427*APINO2*CH3CO3 + + r439*BCARYNO3*CH3CO3 + r447*BCARYO2*CH3CO3 + r459*BPINNO3*CH3CO3 + r467*BPINO2*CH3CO3 + + r478*LIMONNO3*CH3CO3 + r487*LIMONO2*CH3CO3 + r498*MYRCNO3*CH3CO3 + r507*MYRCO2*CH3CO3 + + r526*TERPA1O2*CH3CO3 + r534*TERPA2CO3*CH3CO3 + r542*TERPA2O2*CH3CO3 + r552*TERPA3CO3*CH3CO3 + + r561*TERPA3O2*CH3CO3 + r571*TERPA4O2*CH3CO3 + r582*TERPACO3*CH3CO3 + - r58*CLO*CH3O2 - 2*r135*CH3O2*CH3O2 - 2*r136*CH3O2*CH3O2 - r137*HO2*CH3O2 - r138*NO*CH3O2 + - r158*C2H5O2*CH3O2 - r169*CH3CO3*CH3O2 - r188*C3H7O2*CH3O2 - r201*RO2*CH3O2 + - r215*MACRO2*CH3O2 - r222*MCO3*CH3O2 - r234*MVKO2*CH3O2 - r258*ISOPB1O2*CH3O2 + - r264*ISOPB4O2*CH3O2 - r278*ISOPED1O2*CH3O2 - r282*ISOPED4O2*CH3O2 - r308*ISOPNO3*CH3O2 + - r325*ISOPZD1O2*CH3O2 - r329*ISOPZD4O2*CH3O2 - r420*APINNO3*CH3O2 - r428*APINO2*CH3O2 + - r440*BCARYNO3*CH3O2 - r448*BCARYO2*CH3O2 - r460*BPINNO3*CH3O2 - r468*BPINO2*CH3O2 + - r479*LIMONNO3*CH3O2 - r488*LIMONO2*CH3O2 - r499*MYRCNO3*CH3O2 - r508*MYRCO2*CH3O2 + - r527*TERPA1O2*CH3O2 - r535*TERPA2CO3*CH3O2 - r543*TERPA2O2*CH3O2 - r553*TERPA3CO3*CH3O2 + - r562*TERPA3O2*CH3O2 - r572*TERPA4O2*CH3O2 - r583*TERPACO3*CH3O2 + d(DICARBO2)/dt = .6*j24*BIGALD2 + - r388*HO2*DICARBO2 - r389*NO*DICARBO2 - r390*M*NO2*DICARBO2 + d(ENEO2)/dt = r208*BIGENE*OH + - r210*NO*ENEO2 - r211*NO*ENEO2 + d(EO)/dt = j42*EOOH + .75*r175*EO2*NO + - r176*EO - r177*O2*EO + d(EO2)/dt = r183*M*C2H4*OH + - r174*HO2*EO2 - r175*NO*EO2 + d(HO2)/dt = j11*HO2NO2 + j19*ALKNIT + .9*j20*ALKOOH + j21*BENZOOH + 1.5*j22*BEPOMUC + j23*BIGALD1 + + .6*j24*BIGALD2 + .6*j25*BIGALD3 + j26*BIGALD4 + j27*BZOOH + j28*C2H5OOH + j29*C3H7OOH + + j33*CH3CHO + j35*CH3COCHO + .5*j41*DHPMPAL + 2*j43*GLYALD + 2*j44*GLYOXAL + j45*HCOCH2OOH + + .67*j47*HONITR + .62*j48*HPALD1 + .56*j49*HPALD4 + j50*HPALDB1C + j51*HPALDB4C + j52*HYAC + + 1.5*j53*HYDRALD + j54*HYDRALD + j57*INHEB + j58*INHED + j63*ISOPHFP + .45*j64*ISOPN1D + + j65*ISOPN2B + j66*ISOPN3B + .45*j67*ISOPN4D + j68*ISOPNBNO3 + j70*ISOPNOOHD + j71*ISOPOOH + + j72*MACR + j73*MACR + 1.25*j74*MACRN + j75*MACROOH + .5*j80*MVKN + .44*j81*MVKOOH + + j82*NC4CHO + j83*NO3CH2CHO + j87*PHENOOH + j88*POOH + j90*TEPOMUC + j91*TERP1OOH + + j92*TERP2AOOH + j93*TERPA + j94*TERPA2 + j96*TERPA3 + j102*TERPDHDP + j103*TERPFDN + + j104*TERPHFN + .5*j105*TERPNPS + .54*j106*TERPNPS1 + .54*j108*TERPNPT1 + j109*TERPNS + + j110*TERPNS1 + j111*TERPNT + j112*TERPNT1 + j113*TERPOOH + j114*TERPOOHL + j115*TOLOOH + + j116*XYLENOOH + j117*XYLOLOOH + r14*O2*M*H + r49*M*HO2NO2 + r146*HOCH2OO + r176*EO + + r177*O2*EO + r291*ISOPN1DO2 + r295*ISOPN2BO2 + r298*ISOPN3BO2 + r301*ISOPN4DO2 + + .4*r362*ISOPZD1O2 + .4*r365*ISOPZD4O2 + r10*H2O2*O + r19*OH*H2O2 + r22*OH*O3 + r38*NO3*OH + + r51*CL*CH2O + r54*CL*H2O2 + r58*CLO*CH3O2 + r69*CLO*OH + r87*BR*CH2O + r99*BRO*OH + + r116*CH3BR*CL + r117*CH3BR*OH + r119*CH3CL*CL + r120*CH3CL*OH + r132*CH2O*NO3 + r133*CH2O*O + + 2*r135*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + r142*M*HCN*OH + r143*HCOOH*OH + + .5*r144*HMHP*OH + .2*r145*HOCH2OO*HO2 + r147*HOCH2OO*NO + r149*O1D*CH4 + r152*CO*OH + + .35*r154*M*C2H2*OH + .13*r156*C2H4*O3 + 1.2*r157*C2H5O2*C2H5O2 + r158*C2H5O2*CH3O2 + + r160*C2H5O2*NO + r161*C2H5OH*OH + r167*CH3CN*OH + .9*r169*CH3CO3*CH3O2 + .25*r175*EO2*NO + + r178*GLYALD*OH + r179*GLYOXAL*OH + .11*r180*HCOCH2OOH*OH + .28*r187*C3H6*O3 + r188*C3H7O2*CH3O2 + + r190*C3H7O2*NO + r195*HYAC*OH + r199*PO2*NO + .3*r201*RO2*CH3O2 + r210*ENEO2*NO + + r212*HONITR*OH + .5*r213*MACRN*OH + r214*MACRO2*CH3CO3 + 1.5*r215*MACRO2*CH3O2 + + .59*r216*MACRO2*HO2 + .14*r218*MACR*O3 + r222*MCO3*CH3O2 + r232*MVKN*OH + .25*r233*MVKO2*CH3CO3 + + .62*r234*MVKO2*CH3O2 + .18*r235*MVKO2*HO2 + .28*r236*MVK*O3 + .44*r238*MVKOOH*OH + + r243*ALKO2*NO + .51*r247*HPALD1*OH + .41*r248*HPALD4*OH + .32*r251*HYDRALD*OH + + .19*r253*IEPOX*OH + .65*r254*IEPOXOO*HO2 + .4*r256*INHED*OH + r257*ISOPB1O2*CH3CO3 + + 1.5*r258*ISOPB1O2*CH3O2 + .06*r259*ISOPB1O2*HO2 + r263*ISOPB4O2*CH3CO3 + r264*ISOPB4O2*CH3O2 + + .06*r265*ISOPB4O2*HO2 + .45*r277*ISOPED1O2*CH3CO3 + .72*r278*ISOPED1O2*CH3O2 + + .45*r281*ISOPED4O2*CH3CO3 + .72*r282*ISOPED4O2*CH3O2 + r286*ISOPFDN*OH + r288*ISOPFNP*OH + + .58*r290*ISOPN1DO2*HO2 + .17*r292*ISOPN1D*O3 + .04*r293*ISOPN1D*OH + .06*r294*ISOPN2BO2*HO2 + + .6*r297*ISOPN3BO2*HO2 + .5*r300*ISOPN4DO2*HO2 + .17*r302*ISOPN4D*O3 + .03*r303*ISOPN4D*OH + + .4*r304*ISOPNBNO3O2*HO2 + .05*r305*ISOPNBNO3*OH + .54*r307*ISOPNO3*CH3CO3 + + .4*r308*ISOPNO3*CH3O2 + .4*r310*ISOPNO3*ISOPNO3 + .54*r311*ISOPNO3*NO3 + + .17*r312*ISOPNOOHBO2*HO2 + .8*r315*ISOPNOOHDO2*HO2 + .42*r319*ISOP*O3 + r321*ISOPOH*OH + + .18*r322*ISOPOOH*OH + .45*r324*ISOPZD1O2*CH3CO3 + .72*r325*ISOPZD1O2*CH3O2 + + .45*r328*ISOPZD4O2*CH3CO3 + .72*r329*ISOPZD4O2*CH3O2 + .8*r332*NC4CHOO2*HO2 + .13*r334*NC4CHO*O3 + + .63*r335*NC4CHO*OH + r336*IEPOXOO*NO + r338*ISOPB1O2*NO + r340*ISOPB4O2*NO + + .45*r342*ISOPED1O2*NO + .45*r344*ISOPED4O2*NO + r346*ISOPN1DO2*NO + .27*r348*ISOPN2BO2*NO + + r350*ISOPN3BO2*NO + r352*ISOPN4DO2*NO + r354*ISOPNBNO3O2*NO + .54*r356*ISOPNO3*NO + + .53*r358*ISOPNOOHBO2*NO + .96*r360*ISOPNOOHDO2*NO + .45*r363*ISOPZD1O2*NO + + .45*r366*ISOPZD4O2*NO + r368*MACRO2*NO + .24*r370*MVKO2*NO + r372*NC4CHOO2*NO + + .65*r376*BENZENE*OH + r378*BENZO2*NO + r383*BZOO*NO + .73*r387*CRESOL*OH + + .07*r388*DICARBO2*HO2 + .17*r389*DICARBO2*NO + .16*r391*MALO2*HO2 + .4*r392*MALO2*NO + + .33*r394*MDIALO2*HO2 + .83*r395*MDIALO2*NO + r398*PHENO2*NO + .8*r399*PHENOL*OH + r405*TOLO2*NO + + .28*r407*TOLUENE*OH + .38*r409*XYLENES*OH + r411*XYLENO2*NO + r414*XYLOLO2*NO + + .63*r415*XYLOL*OH + .82*r420*APINNO3*CH3O2 + r427*APINO2*CH3CO3 + 1.16*r428*APINO2*CH3O2 + + .48*r429*APINO2*HO2 + .77*r430*APINO2*NO + r431*APINO2*NO3 + r432*APINO2*TERPA2CO3 + + r433*APINO2*TERPA3CO3 + r434*APINO2*TERPACO3 + .17*r435*APIN*O3 + .82*r440*BCARYNO3*CH3O2 + + r447*BCARYO2*CH3CO3 + r448*BCARYO2*CH3O2 + .1*r449*BCARYO2*HO2 + .7*r450*BCARYO2*NO + + r451*BCARYO2*NO3 + r452*BCARYO2*TERPA2CO3 + r453*BCARYO2*TERPA3CO3 + r454*BCARYO2*TERPACO3 + + .08*r455*BCARY*O3 + .94*r458*BPINNO3*BPINNO3 + .5*r459*BPINNO3*CH3CO3 + 1.1*r460*BPINNO3*CH3O2 + + .47*r462*BPINNO3*NO + .5*r463*BPINNO3*NO3 + .5*r464*BPINNO3*TERPA2CO3 + + .5*r465*BPINNO3*TERPA3CO3 + .5*r466*BPINNO3*TERPACO3 + r467*BPINO2*CH3CO3 + + 1.5*r468*BPINO2*CH3O2 + .03*r469*BPINO2*HO2 + .75*r470*BPINO2*NO + r471*BPINO2*NO3 + + r472*BPINO2*TERPA2CO3 + r473*BPINO2*TERPA3CO3 + r474*BPINO2*TERPACO3 + .54*r478*LIMONNO3*CH3CO3 + + 1.01*r479*LIMONNO3*CH3O2 + .27*r480*LIMONNO3*HO2 + .99*r481*LIMONNO3*LIMONNO3 + + .5*r482*LIMONNO3*NO + .54*r483*LIMONNO3*NO3 + .54*r484*LIMONNO3*TERPA2CO3 + + .54*r485*LIMONNO3*TERPA3CO3 + .54*r486*LIMONNO3*TERPACO3 + r487*LIMONO2*CH3CO3 + + r488*LIMONO2*CH3O2 + .1*r489*LIMONO2*HO2 + .77*r490*LIMONO2*NO + r491*LIMONO2*NO3 + + r492*LIMONO2*TERPA2CO3 + r493*LIMONO2*TERPA3CO3 + r494*LIMONO2*TERPACO3 + + .05*r498*MYRCNO3*CH3CO3 + .87*r499*MYRCNO3*CH3O2 + .04*r502*MYRCNO3*NO + .05*r503*MYRCNO3*NO3 + + .05*r504*MYRCNO3*TERPA2CO3 + .05*r505*MYRCNO3*TERPA3CO3 + .05*r506*MYRCNO3*TERPACO3 + + r507*MYRCO2*CH3CO3 + r508*MYRCO2*CH3O2 + .1*r509*MYRCO2*HO2 + .71*r510*MYRCO2*NO + + r511*MYRCO2*NO3 + r512*MYRCO2*TERPA2CO3 + r513*MYRCO2*TERPA3CO3 + r514*MYRCO2*TERPACO3 + + .63*r515*MYRC*O3 + .18*r520*TERP1OOHO2*HO2 + .7*r521*TERP1OOHO2*NO + .18*r524*TERP2OOHO2*HO2 + + .7*r525*TERP2OOHO2*NO + .5*r527*TERPA1O2*CH3O2 + r535*TERPA2CO3*CH3O2 + r543*TERPA2O2*CH3O2 + + r551*TERPA2PAN*OH + r553*TERPA3CO3*CH3O2 + r562*TERPA3O2*CH3O2 + r570*TERPA3PAN*OH + + r571*TERPA4O2*CH3CO3 + 2*r572*TERPA4O2*CH3O2 + .53*r573*TERPA4O2*HO2 + .91*r574*TERPA4O2*NO + + r575*TERPA4O2*NO3 + r576*TERPA4O2*TERPA2CO3 + r577*TERPA4O2*TERPA3CO3 + r578*TERPA4O2*TERPACO3 + + r583*TERPACO3*CH3O2 + .1*r593*TERPF1O2*HO2 + .7*r594*TERPF1O2*NO + .5*r597*TERPF2*NO3 + + .1*r598*TERPF2O2*HO2 + .7*r599*TERPF2O2*NO + .1*r605*TERPNPS1O2*HO2 + .7*r606*TERPNPS1O2*NO + + .1*r609*TERPNPT1O2*HO2 + .7*r610*TERPNPT1O2*NO + .1*r613*TERPNS1O2*HO2 + .7*r614*TERPNS1O2*NO + + .1*r617*TERPNT1O2*HO2 + .7*r618*TERPNT1O2*NO + r631*M*SO2*OH + .5*r641*DMS*OH + - r645*HO2 - r11*H*HO2 - r12*H*HO2 - r13*H*HO2 - r15*O*HO2 - r16*O3*HO2 - r20*OH*HO2 + - 2*r25*HO2*HO2 - r35*NO3*HO2 - r40*NO*HO2 - r45*M*NO2*HO2 - r55*CL*HO2 - r56*CL*HO2 + - r62*CLO*HO2 - r88*BR*HO2 - r94*BRO*HO2 - r131*CH2O*HO2 - r137*CH3O2*HO2 - r145*HOCH2OO*HO2 + - r159*C2H5O2*HO2 - r170*CH3CO3*HO2 - r174*EO2*HO2 - r189*C3H7O2*HO2 - r198*PO2*HO2 + - r202*RO2*HO2 - r216*MACRO2*HO2 - r223*MCO3*HO2 - r227*MEKO2*HO2 - r235*MVKO2*HO2 + - r242*ALKO2*HO2 - r254*IEPOXOO*HO2 - r259*ISOPB1O2*HO2 - r265*ISOPB4O2*HO2 - r279*ISOPED1O2*HO2 + - r283*ISOPED4O2*HO2 - r290*ISOPN1DO2*HO2 - r294*ISOPN2BO2*HO2 - r297*ISOPN3BO2*HO2 + - r300*ISOPN4DO2*HO2 - r304*ISOPNBNO3O2*HO2 - r309*ISOPNO3*HO2 - r312*ISOPNOOHBO2*HO2 + - r315*ISOPNOOHDO2*HO2 - r326*ISOPZD1O2*HO2 - r330*ISOPZD4O2*HO2 - r332*NC4CHOO2*HO2 + - r374*ACBZO2*HO2 - r377*BENZO2*HO2 - r381*BZOO*HO2 - r384*C6H5O2*HO2 - r388*DICARBO2*HO2 + - r391*MALO2*HO2 - r394*MDIALO2*HO2 - r397*PHENO2*HO2 - r404*TOLO2*HO2 - r410*XYLENO2*HO2 + - r413*XYLOLO2*HO2 - r421*APINNO3*HO2 - r429*APINO2*HO2 - r441*BCARYNO3*HO2 - r449*BCARYO2*HO2 + - r461*BPINNO3*HO2 - r469*BPINO2*HO2 - r480*LIMONNO3*HO2 - r489*LIMONO2*HO2 - r500*MYRCNO3*HO2 + - r509*MYRCO2*HO2 - r520*TERP1OOHO2*HO2 - r524*TERP2OOHO2*HO2 - r528*TERPA1O2*HO2 + - r536*TERPA2CO3*HO2 - r544*TERPA2O2*HO2 - r554*TERPA3CO3*HO2 - r563*TERPA3O2*HO2 + - r573*TERPA4O2*HO2 - r584*TERPACO3*HO2 - r593*TERPF1O2*HO2 - r598*TERPF2O2*HO2 + - r605*TERPNPS1O2*HO2 - r609*TERPNPT1O2*HO2 - r613*TERPNS1O2*HO2 - r617*TERPNT1O2*HO2 + d(HOCH2OO)/dt = r131*CH2O*HO2 + - r146*HOCH2OO - r145*HO2*HOCH2OO - r147*NO*HOCH2OO + d(IEPOXOO)/dt = .32*r251*HYDRALD*OH + .81*r253*IEPOX*OH + - r254*HO2*IEPOXOO - r336*NO*IEPOXOO - r337*NO*IEPOXOO + d(ISOPB1O2)/dt = r269*O2*ISOPC1C + r271*O2*ISOPC1T + .53*r322*ISOPOOH*OH + - r260*ISOPB1O2 - r261*ISOPB1O2 - r262*ISOPB1O2 - r257*CH3CO3*ISOPB1O2 - r258*CH3O2*ISOPB1O2 + - r259*HO2*ISOPB1O2 - r338*NO*ISOPB1O2 - r339*NO*ISOPB1O2 + d(ISOPB4O2)/dt = r273*O2*ISOPC4C + r275*O2*ISOPC4T + .16*r322*ISOPOOH*OH + - r266*ISOPB4O2 - r267*ISOPB4O2 - r268*ISOPB4O2 - r263*CH3CO3*ISOPB4O2 - r264*CH3O2*ISOPB4O2 + - r265*HO2*ISOPB4O2 - r340*NO*ISOPB4O2 - r341*NO*ISOPB4O2 + d(ISOPC1C)/dt = r261*ISOPB1O2 + r327*ISOPZD1O2 + .315*r320*ISOP*OH + - r269*O2*ISOPC1C - r270*O2*ISOPC1C + d(ISOPC1T)/dt = r262*ISOPB1O2 + r280*ISOPED1O2 + .315*r320*ISOP*OH + - r271*O2*ISOPC1T - r272*O2*ISOPC1T + d(ISOPC4C)/dt = r267*ISOPB4O2 + r331*ISOPZD4O2 + .259*r320*ISOP*OH + - r273*O2*ISOPC4C - r274*O2*ISOPC4C + d(ISOPC4T)/dt = r268*ISOPB4O2 + r284*ISOPED4O2 + .111*r320*ISOP*OH + - r275*O2*ISOPC4T - r276*O2*ISOPC4T + d(ISOPED1O2)/dt = r272*O2*ISOPC1T + - r280*ISOPED1O2 - r277*CH3CO3*ISOPED1O2 - r278*CH3O2*ISOPED1O2 - r279*HO2*ISOPED1O2 + - r342*NO*ISOPED1O2 - r343*NO*ISOPED1O2 + d(ISOPED4O2)/dt = r276*O2*ISOPC4T + - r284*ISOPED4O2 - r281*CH3CO3*ISOPED4O2 - r282*CH3O2*ISOPED4O2 - r283*HO2*ISOPED4O2 + - r344*NO*ISOPED4O2 - r345*NO*ISOPED4O2 + d(ISOPN1DO2)/dt = .82*r293*ISOPN1D*OH + - r291*ISOPN1DO2 - r290*HO2*ISOPN1DO2 - r346*NO*ISOPN1DO2 - r347*NO*ISOPN1DO2 + d(ISOPN2BO2)/dt = .85*r296*ISOPN2B*OH + - r295*ISOPN2BO2 - r294*HO2*ISOPN2BO2 - r348*NO*ISOPN2BO2 - r349*NO*ISOPN2BO2 + d(ISOPN3BO2)/dt = .87*r299*ISOPN3B*OH + - r298*ISOPN3BO2 - r297*HO2*ISOPN3BO2 - r350*NO*ISOPN3BO2 - r351*NO*ISOPN3BO2 + d(ISOPN4DO2)/dt = .89*r303*ISOPN4D*OH + - r301*ISOPN4DO2 - r300*HO2*ISOPN4DO2 - r352*NO*ISOPN4DO2 - r353*NO*ISOPN4DO2 + d(ISOPNBNO3O2)/dt = .92*r305*ISOPNBNO3*OH + - r304*HO2*ISOPNBNO3O2 - r354*NO*ISOPNBNO3O2 - r355*NO*ISOPNBNO3O2 + d(ISOPNO3)/dt = r306*ISOP*NO3 + .17*r314*ISOPNOOHB*OH + .07*r318*ISOPNOOHD*OH + - r307*CH3CO3*ISOPNO3 - r308*CH3O2*ISOPNO3 - r309*HO2*ISOPNO3 - 2*r310*ISOPNO3*ISOPNO3 + - r311*NO3*ISOPNO3 - r356*NO*ISOPNO3 - r357*NO*ISOPNO3 + d(ISOPNOOHBO2)/dt = .41*r314*ISOPNOOHB*OH + - r313*ISOPNOOHBO2 - r312*HO2*ISOPNOOHBO2 - r358*NO*ISOPNOOHBO2 - r359*NO*ISOPNOOHBO2 + d(ISOPNOOHDO2)/dt = .57*r318*ISOPNOOHD*OH + - r316*ISOPNOOHDO2 - r315*HO2*ISOPNOOHDO2 - r360*NO*ISOPNOOHDO2 - r361*NO*ISOPNOOHDO2 + d(ISOPO2VBS)/dt = r696*ISOP*OH + - r693*HO2*ISOPO2VBS - r694*NO*ISOPO2VBS + d(ISOPZD1O2)/dt = r270*O2*ISOPC1C + - r327*ISOPZD1O2 - r362*ISOPZD1O2 - r324*CH3CO3*ISOPZD1O2 - r325*CH3O2*ISOPZD1O2 + - r326*HO2*ISOPZD1O2 - r363*NO*ISOPZD1O2 - r364*NO*ISOPZD1O2 + d(ISOPZD4O2)/dt = r274*O2*ISOPC4C + - r331*ISOPZD4O2 - r365*ISOPZD4O2 - r328*CH3CO3*ISOPZD4O2 - r329*CH3O2*ISOPZD4O2 + - r330*HO2*ISOPZD4O2 - r366*NO*ISOPZD4O2 - r367*NO*ISOPZD4O2 + d(IVOCO2VBS)/dt = r699*IVOC*OH + - r697*HO2*IVOCO2VBS - r698*NO*IVOCO2VBS + d(LIMONNO3)/dt = r477*LIMON*NO3 + - r478*CH3CO3*LIMONNO3 - r479*CH3O2*LIMONNO3 - r480*HO2*LIMONNO3 - 2*r481*LIMONNO3*LIMONNO3 + - r482*NO*LIMONNO3 - r483*NO3*LIMONNO3 - r484*TERPA2CO3*LIMONNO3 - r485*TERPA3CO3*LIMONNO3 + - r486*TERPACO3*LIMONNO3 + d(LIMONO2)/dt = r496*LIMON*OH + - r487*CH3CO3*LIMONO2 - r488*CH3O2*LIMONO2 - r489*HO2*LIMONO2 - r490*NO*LIMONO2 + - r491*NO3*LIMONO2 - r492*TERPA2CO3*LIMONO2 - r493*TERPA3CO3*LIMONO2 - r494*TERPACO3*LIMONO2 + d(LIMONO2VBS)/dt = r704*LIMON*OH + - r701*HO2*LIMONO2VBS - r702*NO*LIMONO2VBS + d(MACRO2)/dt = .19*j49*HPALD4 + .55*r219*MACR*OH + - r217*MACRO2 - r214*CH3CO3*MACRO2 - r215*CH3O2*MACRO2 - r216*HO2*MACRO2 - r368*NO*MACRO2 + - r369*NO*MACRO2 + d(MALO2)/dt = .6*j23*BIGALD1 + - r391*HO2*MALO2 - r392*NO*MALO2 - r393*M*NO2*MALO2 + d(MCO3)/dt = j73*MACR + j78*MPAN + r240*M*MPAN + .45*r219*MACR*OH + - r221*CH3CO3*MCO3 - r222*CH3O2*MCO3 - r223*HO2*MCO3 - 2*r224*MCO3*MCO3 - r225*NO*MCO3 + - r226*NO3*MCO3 - r239*M*NO2*MCO3 + d(MDIALO2)/dt = .6*j25*BIGALD3 + - r394*HO2*MDIALO2 - r395*NO*MDIALO2 - r396*M*NO2*MDIALO2 + d(MEKO2)/dt = r229*MEK*OH + r230*MEKOOH*OH + - r227*HO2*MEKO2 - r228*NO*MEKO2 + d(MVKO2)/dt = .23*j48*HPALD1 + r237*MVK*OH + - r233*CH3CO3*MVKO2 - r234*CH3O2*MVKO2 - r235*HO2*MVKO2 - r370*NO*MVKO2 - r371*NO*MVKO2 + d(MYRCNO3)/dt = r497*MYRC*NO3 + - r498*CH3CO3*MYRCNO3 - r499*CH3O2*MYRCNO3 - r500*HO2*MYRCNO3 - 2*r501*MYRCNO3*MYRCNO3 + - r502*NO*MYRCNO3 - r503*NO3*MYRCNO3 - r504*TERPA2CO3*MYRCNO3 - r505*TERPA3CO3*MYRCNO3 + - r506*TERPACO3*MYRCNO3 + d(MYRCO2)/dt = r516*MYRC*OH + - r507*CH3CO3*MYRCO2 - r508*CH3O2*MYRCO2 - r509*HO2*MYRCO2 - r510*NO*MYRCO2 - r511*NO3*MYRCO2 + - r512*TERPA2CO3*MYRCO2 - r513*TERPA3CO3*MYRCO2 - r514*TERPACO3*MYRCO2 + d(MYRCO2VBS)/dt = r709*MYRC*OH + - r706*HO2*MYRCO2VBS - r707*NO*MYRCO2VBS + d(NC4CHOO2)/dt = .4*r255*INHEB*OH + .35*r256*INHED*OH + .23*r335*NC4CHO*OH + - r333*NC4CHOO2 - r332*HO2*NC4CHOO2 - r372*NO*NC4CHOO2 - r373*NO*NC4CHOO2 + 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 - r43*N2O*O1D - r44*N2O*O1D + - r76*CCL4*O1D - r77*CF2CLBR*O1D - r78*CFC11*O1D - r79*CFC113*O1D - r80*CFC114*O1D + - r81*CFC115*O1D - r82*CFC12*O1D - r83*HCL*O1D - r84*HCL*O1D - r103*CF3BR*O1D - r104*CHBR3*O1D + - r105*H2402*O1D - r106*HBR*O1D - r107*HBR*O1D - r112*COF2*O1D - r113*COFCL*O1D + - r126*CH2BR2*O1D - r127*CH3BR*O1D - r128*HCFC141B*O1D - r129*HCFC142B*O1D - r130*HCFC22*O1D + - r148*CH4*O1D - r149*CH4*O1D - r150*CH4*O1D - r151*HCN*O1D + d(OH)/dt = j2*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j20*ALKOOH + j21*BENZOOH + j27*BZOOH + j28*C2H5OOH + + j29*C3H7OOH + j30*C6H5OOH + j36*CH3COOOH + j37*CH3OOH + .33*j39*CH4 + 1.5*j41*DHPMPAL + + j42*EOOH + j45*HCOCH2OOH + 2*j46*HMHP + 1.11*j48*HPALD1 + 1.1799999*j49*HPALD4 + j50*HPALDB1C + + j51*HPALDB4C + 3*j54*HYDRALD + j55*HYPERACET + j56*HYPERACET + j61*ISOPFNC + j62*ISOPFNP + + j63*ISOPHFP + .55*j64*ISOPN1D + .55*j67*ISOPN4D + j69*ISOPNOOHB + j70*ISOPNOOHD + j71*ISOPOOH + + j75*MACROOH + j77*MEKOOH + j81*MVKOOH + j87*PHENOOH + j88*POOH + j89*ROOH + j91*TERP1OOH + + j92*TERP2AOOH + j98*TERPACID + j99*TERPACID2 + j100*TERPACID3 + j102*TERPDHDP + j104*TERPHFN + + j105*TERPNPS + j106*TERPNPS1 + j107*TERPNPT + j108*TERPNPT1 + j113*TERPOOH + j114*TERPOOHL + + j115*TOLOOH + j116*XYLENOOH + j117*XYLOLOOH + j149*HOBR + j150*HOCL + r217*MACRO2 + + r260*ISOPB1O2 + r266*ISOPB4O2 + r313*ISOPNOOHBO2 + r316*ISOPNOOHDO2 + r333*NC4CHOO2 + + .6*r362*ISOPZD1O2 + .6*r365*ISOPZD4O2 + .5*r663*NO2 + r1*O1D*H2 + 2*r2*O1D*H2O + r9*H2*O + + r10*H2O2*O + 2*r12*H*HO2 + r15*HO2*O + r16*HO2*O3 + r17*H*O3 + r35*NO3*HO2 + r40*NO*HO2 + + r56*CL*HO2 + r71*HCL*O + r74*HOCL*O + r83*O1D*HCL + r100*HBR*O + r102*HOBR*O + r106*O1D*HBR + + r110*F*H2O + r133*CH2O*O + .3*r140*CH3OOH*OH + .5*r144*HMHP*OH + .2*r145*HOCH2OO*HO2 + + r148*O1D*CH4 + r151*O1D*HCN + .65*r154*M*C2H2*OH + .13*r156*C2H4*O3 + .5*r162*C2H5OOH*OH + + .49*r170*CH3CO3*HO2 + .89*r180*HCOCH2OOH*OH + .36*r187*C3H6*O3 + .7*r196*HYPERACET*OH + + .5*r200*POOH*OH + .15*r202*RO2*HO2 + .59*r216*MACRO2*HO2 + .24*r218*MACR*O3 + .49*r223*MCO3*HO2 + + .2*r227*MEKO2*HO2 + .54*r235*MVKO2*HO2 + .36*r236*MVK*O3 + .43*r247*HPALD1*OH + + .53*r248*HPALD4*OH + 1.08*r251*HYDRALD*OH + .65*r254*IEPOXOO*HO2 + .06*r259*ISOPB1O2*HO2 + + .06*r265*ISOPB4O2*HO2 + .55*r277*ISOPED1O2*CH3CO3 + .28*r278*ISOPED1O2*CH3O2 + + .55*r281*ISOPED4O2*CH3CO3 + .28*r282*ISOPED4O2*CH3O2 + .5*r287*ISOPFNC*OH + + .58*r290*ISOPN1DO2*HO2 + .34*r292*ISOPN1D*O3 + .06*r293*ISOPN1D*OH + .52*r294*ISOPN2BO2*HO2 + + .6*r297*ISOPN3BO2*HO2 + .5*r300*ISOPN4DO2*HO2 + .34*r302*ISOPN4D*O3 + .04*r303*ISOPN4D*OH + + .4*r304*ISOPNBNO3O2*HO2 + .03*r305*ISOPNBNO3*OH + .24*r309*ISOPNO3*HO2 + .85*r312*ISOPNOOHBO2*HO2 + + .42*r314*ISOPNOOHB*OH + .86*r315*ISOPNOOHDO2*HO2 + .51*r317*ISOPNOOHD*O3 + .29*r318*ISOPNOOHD*OH + + .25*r319*ISOP*O3 + .13*r322*ISOPOOH*OH + .92*r323*ISOPOOH*OH + .55*r324*ISOPZD1O2*CH3CO3 + + .28*r325*ISOPZD1O2*CH3O2 + .55*r328*ISOPZD4O2*CH3CO3 + .28*r329*ISOPZD4O2*CH3O2 + + .8*r332*NC4CHOO2*HO2 + .34*r334*NC4CHO*O3 + .55*r342*ISOPED1O2*NO + .55*r344*ISOPED4O2*NO + + .47*r358*ISOPNOOHBO2*NO + .04*r360*ISOPNOOHDO2*NO + .55*r363*ISOPZD1O2*NO + .55*r366*ISOPZD4O2*NO + + .4*r374*ACBZO2*HO2 + .4*r388*DICARBO2*HO2 + .4*r394*MDIALO2*HO2 + .7*r421*APINNO3*HO2 + + .35*r429*APINO2*HO2 + .77*r435*APIN*O3 + .5*r441*BCARYNO3*HO2 + .1*r449*BCARYO2*HO2 + + .08*r455*BCARY*O3 + .47*r461*BPINNO3*HO2 + .03*r469*BPINO2*HO2 + .3*r475*BPIN*O3 + + .5*r480*LIMONNO3*HO2 + .1*r489*LIMONO2*HO2 + .66*r495*LIMON*O3 + .48*r500*MYRCNO3*HO2 + + .1*r509*MYRCO2*HO2 + .63*r515*MYRC*O3 + .18*r520*TERP1OOHO2*HO2 + .18*r524*TERP2OOHO2*HO2 + + .49*r536*TERPA2CO3*HO2 + .38*r544*TERPA2O2*HO2 + .49*r554*TERPA3CO3*HO2 + .15*r563*TERPA3O2*HO2 + + .53*r573*TERPA4O2*HO2 + .49*r584*TERPACO3*HO2 + .1*r593*TERPF1O2*HO2 + .09*r595*TERPF1*O3 + + .1*r598*TERPF2O2*HO2 + .1*r605*TERPNPS1O2*HO2 + .1*r609*TERPNPT1O2*HO2 + .1*r613*TERPNS1O2*HO2 + + .1*r617*TERPNT1O2*HO2 + - r18*H2*OH - r19*H2O2*OH - r20*HO2*OH - r21*O*OH - r22*O3*OH - 2*r23*OH*OH - 2*r24*M*OH*OH + - r26*HO2NO2*OH - r38*NO3*OH - r39*N*OH - r47*M*NO2*OH - r48*HNO3*OH - r67*CLONO2*OH + - r69*CLO*OH - r70*CLO*OH - r72*HCL*OH - r75*HOCL*OH - r99*BRO*OH - r101*HBR*OH - r115*CH2BR2*OH + - r117*CH3BR*OH - r118*CH3CCL3*OH - r120*CH3CL*OH - r122*CHBR3*OH - r123*HCFC141B*OH + - r124*HCFC142B*OH - r125*HCFC22*OH - r134*CH2O*OH - r139*CH3OH*OH - r140*CH3OOH*OH - r141*CH4*OH + - r142*M*HCN*OH - r143*HCOOH*OH - r144*HMHP*OH - r152*CO*OH - r154*M*C2H2*OH - r161*C2H5OH*OH + - r162*C2H5OOH*OH - r164*C2H6*OH - r166*CH3CHO*OH - r167*CH3CN*OH - r172*CH3COOH*OH + - r173*CH3COOOH*OH - r178*GLYALD*OH - r179*GLYOXAL*OH - r180*HCOCH2OOH*OH - r181*NO3CH2CHO*OH + - r182*PAN*OH - r183*M*C2H4*OH - r191*C3H7OOH*OH - r192*C3H8*OH - r194*CH3COCHO*OH - r195*HYAC*OH + - r196*HYPERACET*OH - r197*NOA*OH - r200*POOH*OH - r204*ROOH*OH - r205*M*C3H6*OH + - r206*CH3COCH3*OH - r208*BIGENE*OH - r212*HONITR*OH - r213*MACRN*OH - r219*MACR*OH - r229*MEK*OH + - r230*MEKOOH*OH - r231*M*MPAN*OH - r232*MVKN*OH - r237*MVK*OH - r238*MVKOOH*OH - r241*ALKNIT*OH + - r245*ALKOOH*OH - r246*BIGALK*OH - r247*HPALD1*OH - r248*HPALD4*OH - r251*HYDRALD*OH + - r253*IEPOX*OH - r255*INHEB*OH - r256*INHED*OH - r285*ISOPFDNC*OH - r286*ISOPFDN*OH + - r287*ISOPFNC*OH - r288*ISOPFNP*OH - r293*ISOPN1D*OH - r296*ISOPN2B*OH - r299*ISOPN3B*OH + - r303*ISOPN4D*OH - r305*ISOPNBNO3*OH - r314*ISOPNOOHB*OH - r318*ISOPNOOHD*OH - r320*ISOP*OH + - r321*ISOPOH*OH - r322*ISOPOOH*OH - r323*ISOPOOH*OH - r335*NC4CHO*OH - r376*BENZENE*OH + - r379*BENZOOH*OH - r380*BZALD*OH - r382*BZOOH*OH - r386*C6H5OOH*OH - r387*CRESOL*OH + - r399*PHENOL*OH - r402*PHENOOH*OH - r406*TOLOOH*OH - r407*TOLUENE*OH - r409*XYLENES*OH + - r412*XYLENOOH*OH - r415*XYLOL*OH - r416*XYLOLOOH*OH - r436*APIN*OH - r456*BCARY*OH + - r476*BPIN*OH - r496*LIMON*OH - r516*MYRC*OH - r522*TERP1OOH*OH - r523*TERP2AOOH*OH + - r550*TERPA2*OH - r551*TERPA2PAN*OH - r569*TERPA3*OH - r570*TERPA3PAN*OH - r579*TERPACID2*OH + - r580*TERPACID3*OH - r581*TERPACID*OH - r589*TERPA*OH - r590*TERPAPAN*OH - r596*TERPF1*OH + - r601*TERPF2*OH - r602*TERPFDN*OH - r604*TERPK*OH - r607*TERPNPS1*OH - r608*TERPNPS*OH + - r611*TERPNPT1*OH - r615*TERPNS1*OH - r616*TERPNS*OH - r619*TERPNT1*OH - r620*TERPNT*OH + - r627*DMS*OH - r629*OCS*OH - r631*M*SO2*OH - r635*S*OH - r640*SO*OH - r641*DMS*OH - r643*NH3*OH + d(PHENO2)/dt = .2*r387*CRESOL*OH + .14*r399*PHENOL*OH + r402*PHENOOH*OH + - r397*HO2*PHENO2 - r398*NO*PHENO2 + d(PO2)/dt = .5*r200*POOH*OH + r205*M*C3H6*OH + - r198*HO2*PO2 - r199*NO*PO2 + d(RO2)/dt = r204*ROOH*OH + r206*CH3COCH3*OH + - r201*CH3O2*RO2 - r202*HO2*RO2 - r203*NO*RO2 + d(TERP1OOHO2)/dt = r522*TERP1OOH*OH + - r520*HO2*TERP1OOHO2 - r521*NO*TERP1OOHO2 + d(TERP2OOHO2)/dt = r523*TERP2AOOH*OH + - r524*HO2*TERP2OOHO2 - r525*NO*TERP2OOHO2 + d(TERPA1O2)/dt = j93*TERPA + j98*TERPACID + r426*APINNO3*TERPACO3 + r434*APINO2*TERPACO3 + + r446*BCARYNO3*TERPACO3 + r454*BCARYO2*TERPACO3 + r466*BPINNO3*TERPACO3 + + r474*BPINO2*TERPACO3 + r486*LIMONNO3*TERPACO3 + r494*LIMONO2*TERPACO3 + + r506*MYRCNO3*TERPACO3 + r514*MYRCO2*TERPACO3 + r540*TERPA2CO3*TERPACO3 + + r549*TERPA2O2*TERPACO3 + r559*TERPA3CO3*TERPACO3 + r568*TERPA3O2*TERPACO3 + + r578*TERPA4O2*TERPACO3 + .29*r581*TERPACID*OH + r582*TERPACO3*CH3CO3 + r583*TERPACO3*CH3O2 + + .49*r584*TERPACO3*HO2 + r585*TERPACO3*NO + r586*TERPACO3*NO3 + 2*r587*TERPACO3*TERPACO3 + + .86*r604*TERPK*OH + - r526*CH3CO3*TERPA1O2 - r527*CH3O2*TERPA1O2 - r528*HO2*TERPA1O2 - r529*NO*TERPA1O2 + - r530*NO3*TERPA1O2 - r531*TERPA2CO3*TERPA1O2 - r532*TERPA3CO3*TERPA1O2 + d(TERPA2CO3)/dt = j95*TERPA2PAN + r623*M*TERPA2PAN + .27*r435*APIN*O3 + .3*r475*BPIN*O3 + r541*TERPA2*NO3 + + r550*TERPA2*OH + .71*r579*TERPACID2*OH + .14*r604*TERPK*OH + - r424*APINNO3*TERPA2CO3 - r432*APINO2*TERPA2CO3 - r444*BCARYNO3*TERPA2CO3 + - r452*BCARYO2*TERPA2CO3 - r464*BPINNO3*TERPA2CO3 - r472*BPINO2*TERPA2CO3 + - r484*LIMONNO3*TERPA2CO3 - r492*LIMONO2*TERPA2CO3 - r504*MYRCNO3*TERPA2CO3 + - r512*MYRCO2*TERPA2CO3 - r517*M*NO2*TERPA2CO3 - r531*TERPA1O2*TERPA2CO3 + - r534*CH3CO3*TERPA2CO3 - r535*CH3O2*TERPA2CO3 - r536*HO2*TERPA2CO3 - r537*NO*TERPA2CO3 + - r538*NO3*TERPA2CO3 - 2*r539*TERPA2CO3*TERPA2CO3 - r540*TERPACO3*TERPA2CO3 + - r547*TERPA2O2*TERPA2CO3 - r557*TERPA3CO3*TERPA2CO3 - r566*TERPA3O2*TERPA2CO3 + - r576*TERPA4O2*TERPA2CO3 + d(TERPA2O2)/dt = j94*TERPA2 + j99*TERPACID2 + r424*APINNO3*TERPA2CO3 + r432*APINO2*TERPA2CO3 + + .33*r435*APIN*O3 + r444*BCARYNO3*TERPA2CO3 + r452*BCARYO2*TERPA2CO3 + + r464*BPINNO3*TERPA2CO3 + r472*BPINO2*TERPA2CO3 + r484*LIMONNO3*TERPA2CO3 + + r492*LIMONO2*TERPA2CO3 + r504*MYRCNO3*TERPA2CO3 + r512*MYRCO2*TERPA2CO3 + + r526*TERPA1O2*CH3CO3 + .5*r527*TERPA1O2*CH3O2 + .7*r529*TERPA1O2*NO + r530*TERPA1O2*NO3 + + 2*r531*TERPA1O2*TERPA2CO3 + r532*TERPA1O2*TERPA3CO3 + r533*TERPA1O2*TERPACO3 + + r534*TERPA2CO3*CH3CO3 + r535*TERPA2CO3*CH3O2 + .49*r536*TERPA2CO3*HO2 + r537*TERPA2CO3*NO + + r538*TERPA2CO3*NO3 + 2*r539*TERPA2CO3*TERPA2CO3 + r540*TERPA2CO3*TERPACO3 + + r557*TERPA3CO3*TERPA2CO3 + r566*TERPA3O2*TERPA2CO3 + r576*TERPA4O2*TERPA2CO3 + + .29*r579*TERPACID2*OH + .23*r589*TERPA*OH + - r542*CH3CO3*TERPA2O2 - r543*CH3O2*TERPA2O2 - r544*HO2*TERPA2O2 - r545*NO*TERPA2O2 + - r546*NO3*TERPA2O2 - r548*TERPA3CO3*TERPA2O2 - r549*TERPACO3*TERPA2O2 + d(TERPA3CO3)/dt = j97*TERPA3PAN + r624*M*TERPA3PAN + .33*r495*LIMON*O3 + r560*TERPA3*NO3 + .75*r569*TERPA3*OH + + .71*r580*TERPACID3*OH + .17*r596*TERPF1*OH + - r425*APINNO3*TERPA3CO3 - r433*APINO2*TERPA3CO3 - r445*BCARYNO3*TERPA3CO3 + - r453*BCARYO2*TERPA3CO3 - r465*BPINNO3*TERPA3CO3 - r473*BPINO2*TERPA3CO3 + - r485*LIMONNO3*TERPA3CO3 - r493*LIMONO2*TERPA3CO3 - r505*MYRCNO3*TERPA3CO3 + - r513*MYRCO2*TERPA3CO3 - r518*M*NO2*TERPA3CO3 - r532*TERPA1O2*TERPA3CO3 + - r548*TERPA2O2*TERPA3CO3 - r552*CH3CO3*TERPA3CO3 - r553*CH3O2*TERPA3CO3 + - r554*HO2*TERPA3CO3 - r555*NO*TERPA3CO3 - r556*NO3*TERPA3CO3 - r557*TERPA2CO3*TERPA3CO3 + - 2*r558*TERPA3CO3*TERPA3CO3 - r559*TERPACO3*TERPA3CO3 - r567*TERPA3O2*TERPA3CO3 + - r577*TERPA4O2*TERPA3CO3 + d(TERPA3O2)/dt = r542*TERPA2O2*CH3CO3 + r543*TERPA2O2*CH3O2 + .38*r544*TERPA2O2*HO2 + .83*r545*TERPA2O2*NO + + r546*TERPA2O2*NO3 + r547*TERPA2O2*TERPA2CO3 + r548*TERPA2O2*TERPA3CO3 + + r549*TERPA2O2*TERPACO3 + - r561*CH3CO3*TERPA3O2 - r562*CH3O2*TERPA3O2 - r563*HO2*TERPA3O2 - r564*NO*TERPA3O2 + - r565*NO3*TERPA3O2 - r566*TERPA2CO3*TERPA3O2 - r567*TERPA3CO3*TERPA3O2 + - r568*TERPACO3*TERPA3O2 + d(TERPA4O2)/dt = j96*TERPA3 + j100*TERPACID3 + r425*APINNO3*TERPA3CO3 + r433*APINO2*TERPA3CO3 + + r445*BCARYNO3*TERPA3CO3 + r453*BCARYO2*TERPA3CO3 + r465*BPINNO3*TERPA3CO3 + + r473*BPINO2*TERPA3CO3 + r485*LIMONNO3*TERPA3CO3 + r493*LIMONO2*TERPA3CO3 + + r505*MYRCNO3*TERPA3CO3 + r513*MYRCO2*TERPA3CO3 + r532*TERPA1O2*TERPA3CO3 + + r548*TERPA2O2*TERPA3CO3 + r552*TERPA3CO3*CH3CO3 + r553*TERPA3CO3*CH3O2 + + .49*r554*TERPA3CO3*HO2 + r555*TERPA3CO3*NO + r556*TERPA3CO3*NO3 + r557*TERPA3CO3*TERPA2CO3 + + 2*r558*TERPA3CO3*TERPA3CO3 + r559*TERPA3CO3*TERPACO3 + r561*TERPA3O2*CH3CO3 + + r562*TERPA3O2*CH3O2 + .15*r563*TERPA3O2*HO2 + .7*r564*TERPA3O2*NO + r565*TERPA3O2*NO3 + + r566*TERPA3O2*TERPA2CO3 + 2*r567*TERPA3O2*TERPA3CO3 + r568*TERPA3O2*TERPACO3 + + .25*r569*TERPA3*OH + .29*r580*TERPACID3*OH + - r571*CH3CO3*TERPA4O2 - r572*CH3O2*TERPA4O2 - r573*HO2*TERPA4O2 - r574*NO*TERPA4O2 + - r575*NO3*TERPA4O2 - r576*TERPA2CO3*TERPA4O2 - r578*TERPACO3*TERPA4O2 + d(TERPACO3)/dt = j101*TERPAPAN + r625*M*TERPAPAN + .71*r581*TERPACID*OH + r588*TERPA*NO3 + .77*r589*TERPA*OH + - r426*APINNO3*TERPACO3 - r434*APINO2*TERPACO3 - r446*BCARYNO3*TERPACO3 + - r454*BCARYO2*TERPACO3 - r466*BPINNO3*TERPACO3 - r474*BPINO2*TERPACO3 + - r486*LIMONNO3*TERPACO3 - r494*LIMONO2*TERPACO3 - r506*MYRCNO3*TERPACO3 + - r514*MYRCO2*TERPACO3 - r519*M*NO2*TERPACO3 - r533*TERPA1O2*TERPACO3 + - r540*TERPA2CO3*TERPACO3 - r549*TERPA2O2*TERPACO3 - r559*TERPA3CO3*TERPACO3 + - r568*TERPA3O2*TERPACO3 - r578*TERPA4O2*TERPACO3 - r582*CH3CO3*TERPACO3 + - r583*CH3O2*TERPACO3 - r584*HO2*TERPACO3 - r585*NO*TERPACO3 - r586*NO3*TERPACO3 + - 2*r587*TERPACO3*TERPACO3 + d(TERPF1O2)/dt = .83*r596*TERPF1*OH + - r593*HO2*TERPF1O2 - r594*NO*TERPF1O2 + d(TERPF2O2)/dt = r601*TERPF2*OH + - r598*HO2*TERPF2O2 - r599*NO*TERPF2O2 + d(TERPNPS1O2)/dt = r607*TERPNPS1*OH + - r605*HO2*TERPNPS1O2 - r606*NO*TERPNPS1O2 + d(TERPNPT1O2)/dt = r611*TERPNPT1*OH + - r609*HO2*TERPNPT1O2 - r610*NO*TERPNPT1O2 + d(TERPNS1O2)/dt = r615*TERPNS1*OH + - r613*HO2*TERPNS1O2 - r614*NO*TERPNS1O2 + d(TERPNT1O2)/dt = r619*TERPNT1*OH + - r617*HO2*TERPNT1O2 - r618*NO*TERPNT1O2 + d(TOLO2)/dt = r406*TOLOOH*OH + .65*r407*TOLUENE*OH + - r404*HO2*TOLO2 - r405*NO*TOLO2 + d(TOLUO2VBS)/dt = r711*TOLUENE*OH + - r712*HO2*TOLUO2VBS - r713*NO*TOLUO2VBS + d(XYLENO2)/dt = .56*r409*XYLENES*OH + r412*XYLENOOH*OH + - r410*HO2*XYLENO2 - r411*NO*XYLENO2 + d(XYLEO2VBS)/dt = r714*XYLENES*OH + - r715*HO2*XYLEO2VBS - r716*NO*XYLEO2VBS + d(XYLOLO2)/dt = .3*r415*XYLOL*OH + r416*XYLOLOOH*OH + - r413*HO2*XYLOLO2 - r414*NO*XYLOLO2 + d(H2O)/dt = .05*j39*CH4 + j153*H2SO4 + r645*HO2 + r13*H*HO2 + r18*OH*H2 + r19*OH*H2O2 + r20*OH*HO2 + + r23*OH*OH + r26*HO2NO2*OH + r48*HNO3*OH + r72*HCL*OH + r75*HOCL*OH + r101*HBR*OH + + r115*CH2BR2*OH + r117*CH3BR*OH + r118*CH3CCL3*OH + r120*CH3CL*OH + r125*HCFC22*OH + + r134*CH2O*OH + r140*CH3OOH*OH + r141*CH4*OH + r143*HCOOH*OH + r144*HMHP*OH + + .3*r145*HOCH2OO*HO2 + r164*C2H6*OH + r166*CH3CHO*OH + r172*CH3COOH*OH + r173*CH3COOOH*OH + + r191*C3H7OOH*OH + r192*C3H8*OH + r194*CH3COCHO*OH + r200*POOH*OH + r204*ROOH*OH + + r206*CH3COCH3*OH + .45*r219*MACR*OH + r608*TERPNPS*OH + r612*TERPNPT*OH + r643*NH3*OH + + r718*HOCL*HCL + r724*HOCL*HCL + r725*HOBR*HCL + r729*HOCL*HCL + r730*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r2*O1D*H2O - r110*F*H2O - r642*SO3*H2O diff --git a/src/chemistry/pp_trop_strat_mam5_ts2/chem_mech.in b/src/chemistry/pp_trop_strat_mam5_ts2/chem_mech.in new file mode 100644 index 0000000000..7d682f5e33 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/chem_mech.in @@ -0,0 +1,1783 @@ +* Comments +* User-given Tag Description: TS2.2_simpleVBS +* Tag database identifier : MZ321_TS2.2_20221220 +* Tag created by : lke +* Tag created from branch : TS2.2 +* Tag created on : 2022-12-20 14:27:44.984975-07 +* Comments for this tag follow: +* lke : 2022-12-20 : TS2 updated to JPL19 + + SPECIES + + Solution + ALKNIT -> C5H11ONO2, + ALKOOH -> C5H12O2, + AOA_NH -> CO, + APIN -> C10H16, + bc_a1 -> C, + bc_a4 -> C, + BCARY -> C15H24, + BENZENE -> C6H6, + BENZOOH -> C6H8O5, + BEPOMUC -> C6H6O3, + BIGALD1 -> C4H4O2, + BIGALD2 -> C5H6O2, + BIGALD3 -> C5H6O2, + BIGALD4 -> C6H8O2, + BIGALK -> C5H12, + BIGENE -> C4H8, + BPIN -> C10H16, + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + BZALD -> C7H6O, + BZOOH -> C7H8O2, + C2H2, + C2H4, + C2H5OH, + C2H5OOH, + C2H6, + C3H6, + C3H7OOH, + C3H8, + C6H5OOH -> C6H5OOH, + 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, + CH3CN, + CH3COCH3, + CH3COCHO, + CH3COOH, + CH3COOOH, + CH3OH, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + COF2, + COFCL -> COFCl, + CRESOL -> C7H8O, + DHPMPAL -> C4H8O5, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + E90 -> CO, + EOOH -> HOCH2CH2OOH, + F, + GLYALD -> HOCH2CHO, + GLYOXAL -> C2H2O2, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HCN, + HCOCH2OOH -> C2H4O3, + HCOOH, + HF, + HMHP -> CH4O3, + HNO3, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + HONITR -> C4H9NO4, + HPALD1 -> C5H8O3, + HPALD4 -> C5H8O3, + HPALDB1C -> C5H8O3, + HPALDB4C -> C5H8O3, + HYAC -> CH3COCH2OH, + HYDRALD -> HOCH2CCH3CHCHO, + HYPERACET -> C3H6O3, + ICHE -> C5H8O3, + IEPOX -> C5H10O3, + INHEB -> C5H9NO5, + INHED -> C5H9NO5, + ISOP -> C5H8, + ISOPFDN -> C5H10N2O8, + ISOPFDNC -> C5H8N2O8, + ISOPFNC -> C5H9NO7, + ISOPFNP -> C5H11NO7, + ISOPHFP -> C5H10O5, + ISOPN1D -> C5H9NO4, + ISOPN2B -> C5H9NO4, + ISOPN3B -> C5H9NO4, + ISOPN4D -> C5H9NO4, + ISOPNBNO3 -> C5H9NO4, + ISOPNOOHB -> C5H9NO5, + ISOPNOOHD -> C5H9NO5, + ISOPOH -> C5O2H10, + ISOPOOH -> HOCH2COOHCH3CHCH2, + IVOC -> C13H28, + LIMON -> C10H16, + MACR -> CH2CCH3CHO, + MACRN -> C4H7NO5, + MACROOH -> CH3COCHOOHCH2OH, + MEK -> C4H8O, + MEKOOH -> C4H8O3, + MPAN -> CH2CCH3CO3NO2, + MVK -> CH2CHCOCH3, + MVKN -> C4H7NO5, + MVKOOH -> C4H8O4, + MYRC -> C10H16, + N, + N2O, + N2O5, + NC4CHO -> C5H7NO4, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + NH3, + NH4, + NH_5 -> CO, + NH_50 -> CO, + NO, + NO2, + NO3, + NO3CH2CHO -> C2H3O4N, + 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, + PBZNIT -> C7H5O3NO2, + PHENO -> C6H5O, + PHENOL -> C6H5OH, + PHENOOH -> C6H8O6, + 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, + soa1_a1 -> C15H38O2, + soa1_a2 -> C15H38O2, + soa2_a1 -> C15H38O2, + soa2_a2 -> C15H38O2, + soa3_a1 -> C15H38O2, + soa3_a2 -> C15H38O2, + soa4_a1 -> C15H38O2, + soa4_a2 -> C15H38O2, + soa5_a1 -> C15H38O2, + soa5_a2 -> C15H38O2, + SOAG0 -> C15H38O2, + SOAG1 -> C15H38O2, + SOAG2 -> C15H38O2, + SOAG3 -> C15H38O2, + SOAG4 -> C15H38O2, + SQTN -> C15H25NO4, + ST80_25 -> CO, + SVOC -> C22H46, + TEPOMUC -> C7H8O3, + TERP1OOH -> C10H18O3, + TERP2AOOH -> C10H18O3, + TERPA -> C10H16O2, + TERPA2 -> C9H14O2, + TERPA2PAN -> C9H13NO6, + TERPA3 -> C9H14O3, + TERPA3PAN -> C9H13NO7, + TERPACID -> C10H16O4, + TERPACID2 -> C9H14O4, + TERPACID3 -> C9H14O5, + TERPAPAN -> C10H15NO6, + TERPDHDP -> C10H20O6, + TERPF1 -> C10H16O2, + TERPF2 -> C7H10O, + TERPFDN -> C10H18N2O8, + TERPHFN -> C10H19NO7, + TERPK -> C9H14O, + TERPNPS -> C10H17NO5, + TERPNPS1 -> C10H17NO5, + TERPNPT -> C10H17NO5, + TERPNPT1 -> C10H17NO5, + TERPNS -> C10H17NO4, + TERPNS1 -> C10H17NO4, + TERPNT -> C10H17NO4, + TERPNT1 -> C10H17NO4, + TERPOOH -> C10H18O3, + TERPOOHL -> C10H18O5, + TOLOOH -> C7H10O5, + TOLUENE -> C7H8, + XYLENES -> C8H10, + XYLENOOH -> C8H12O5, + XYLOL -> C8H10O, + XYLOLOOH -> C8H12O6, + NHDEP -> N, + NDEP -> N, + ACBZO2 -> C7H5O3, + ALKO2 -> C5H11O2, + APINNO3 -> C10H16NO5, + APINO2 -> C10H17O3, + APINO2VBS -> C10H17O3, + BCARYNO3 -> C15H24NO5, + BCARYO2 -> C15H25O3, + BCARYO2VBS -> C15H25O3, + BENZO2 -> C6H7O5, + BENZO2VBS -> C6H7O5, + BPINNO3 -> C10H16NO5, + BPINO2 -> C10H17O3, + BPINO2VBS -> C10H17O3, + BZOO -> C7H7O2, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2 -> C5H5O4, + ENEO2 -> C4H9O3, + EO -> HOCH2CH2O, + EO2 -> HOCH2CH2O2, + HO2, + HOCH2OO, + IEPOXOO -> C5H9O5, + ISOPB1O2 -> C5H9O3, + ISOPB4O2 -> C5H9O3, + ISOPC1C -> C5H9O, + ISOPC1T -> C5H9O, + ISOPC4C -> C5H9O, + ISOPC4T -> C5H9O, + ISOPED1O2 -> C5H9O3, + ISOPED4O2 -> C5H9O3, + ISOPN1DO2 -> C5H10NO7, + ISOPN2BO2 -> C5H10NO7, + ISOPN3BO2 -> C5H10NO7, + ISOPN4DO2 -> C5H10NO7, + ISOPNBNO3O2 -> C5H10NO7, + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, + ISOPNOOHBO2 -> C5H10NO8, + ISOPNOOHDO2 -> C5H10NO8, + ISOPO2VBS -> C5H9O3, + ISOPZD1O2 -> C5H9O3, + ISOPZD4O2 -> C5H9O3, + IVOCO2VBS -> C13H29O3, + LIMONNO3 -> C10H16NO5, + LIMONO2 -> C10H17O3, + LIMONO2VBS -> C10H17O3, + MACRO2 -> CH3COCHO2CH2OH, + MALO2 -> C4H3O4, + MCO3 -> CH2CCH3CO3, + MDIALO2 -> C4H5O4, + MEKO2 -> C4H7O3, + MVKO2 -> C4O4H7, + MYRCNO3 -> C10H16NO5, + MYRCO2 -> C10H17O3, + MYRCO2VBS -> C10H17O3, + NC4CHOO2 -> C5H8NO7, + O1D -> O, + OH, + PHENO2 -> C6H7O6, + PO2 -> C3H6OHO2, + RO2 -> CH3COCH2O2, + TERP1OOHO2 -> C10H19O6, + TERP2OOHO2 -> C10H19O6, + TERPA1O2 -> C9H15O3, + TERPA2CO3 -> C9H13O4, + TERPA2O2 -> C9H15O4, + TERPA3CO3 -> C9H13O5, + TERPA3O2 -> C9H15O5, + TERPA4O2 -> C6H9O5, + TERPACO3 -> C10H15O4, + TERPF1O2 -> C10H17O5, + TERPF2O2 -> C7H11O4, + TERPNPS1O2 -> C10H18NO8, + TERPNPT1O2 -> C10H18NO8, + TERPNS1O2 -> C10H18NO7, + TERPNT1O2 -> C10H18NO7, + TOLO2 -> C7H9O5, + TOLUO2VBS -> C7H9O5, + XYLENO2 -> C8H11O5, + XYLEO2VBS -> C8H11O5, + XYLOLO2 -> C8H11O6, + H2O + + End Solution + + + Fixed + M, O2, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + ACBZO2, + ALKO2, + APINNO3, + APINO2, + APINO2VBS, + BCARYNO3, + BCARYO2, + BCARYO2VBS, + BENZO2, + BENZO2VBS, + BPINNO3, + BPINO2, + BPINO2VBS, + BZOO, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2, + ENEO2, + EO, + EO2, + HO2, + HOCH2OO, + IEPOXOO, + ISOPB1O2, + ISOPB4O2, + ISOPC1C, + ISOPC1T, + ISOPC4C, + ISOPC4T, + ISOPED1O2, + ISOPED4O2, + ISOPN1DO2, + ISOPN2BO2, + ISOPN3BO2, + ISOPN4DO2, + ISOPNBNO3O2, + ISOPNO3, + ISOPNOOHBO2, + ISOPNOOHDO2, + ISOPO2VBS, + ISOPZD1O2, + ISOPZD4O2, + IVOCO2VBS, + LIMONNO3, + LIMONO2, + LIMONO2VBS, + MACRO2, + MALO2, + MCO3, + MDIALO2, + MEKO2, + MVKO2, + MYRCNO3, + MYRCO2, + MYRCO2VBS, + NC4CHOO2, + O1D, + OH, + PHENO2, + PO2, + RO2, + TERP1OOHO2, + TERP2OOHO2, + TERPA1O2, + TERPA2CO3, + TERPA2O2, + TERPA3CO3, + TERPA3O2, + TERPA4O2, + TERPACO3, + TERPF1O2, + TERPF2O2, + TERPNPS1O2, + TERPNPT1O2, + TERPNS1O2, + TERPNT1O2, + TOLO2, + TOLUO2VBS, + XYLENO2, + XYLEO2VBS, + XYLOLO2 + End Not-Transported + + END Species + + + Solution classes + Explicit + NHDEP + NDEP + End Explicit + + Implicit + ALKNIT + ALKOOH + AOA_NH + APIN + bc_a1 + bc_a4 + BCARY + BENZENE + BENZOOH + BEPOMUC + BIGALD1 + BIGALD2 + BIGALD3 + BIGALD4 + BIGALK + BIGENE + BPIN + BR + BRCL + BRO + BRONO2 + BRY + BZALD + BZOOH + C2H2 + C2H4 + C2H5OH + C2H5OOH + C2H6 + C3H6 + C3H7OOH + C3H8 + C6H5OOH + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH2O + CH3BR + CH3CCL3 + CH3CHO + CH3CL + CH3CN + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CH4 + CHBR3 + CL + CL2 + CL2O2 + CLO + CLONO2 + CLY + CO + CO2 + COF2 + COFCL + CRESOL + DHPMPAL + DMS + dst_a1 + dst_a2 + dst_a3 + E90 + EOOH + F + GLYALD + GLYOXAL + H + H2 + H2402 + H2O2 + H2SO4 + HBR + HCFC141B + HCFC142B + HCFC22 + HCL + HCN + HCOCH2OOH + HCOOH + HF + HMHP + HNO3 + HO2NO2 + HOBR + HOCL + HONITR + HPALD1 + HPALD4 + HPALDB1C + HPALDB4C + HYAC + HYDRALD + HYPERACET + ICHE + IEPOX + INHEB + INHED + ISOP + ISOPFDN + ISOPFDNC + ISOPFNC + ISOPFNP + ISOPHFP + ISOPN1D + ISOPN2B + ISOPN3B + ISOPN4D + ISOPNBNO3 + ISOPNOOHB + ISOPNOOHD + ISOPOH + ISOPOOH + IVOC + LIMON + MACR + MACRN + MACROOH + MEK + MEKOOH + MPAN + MVK + MVKN + MVKOOH + MYRC + N + N2O + N2O5 + NC4CHO + ncl_a1 + ncl_a2 + ncl_a3 + NH3 + NH4 + NH_5 + NH_50 + NO + NO2 + NO3 + NO3CH2CHO + NOA + num_a1 + num_a2 + num_a3 + num_a4 + num_a5 + O + O3 + O3S + OCLO + OCS + ONITR + PAN + PBZNIT + PHENO + PHENOL + PHENOOH + pom_a1 + pom_a4 + POOH + ROOH + S + SF6 + SO + SO2 + SO3 + so4_a1 + so4_a2 + so4_a3 + so4_a5 + soa1_a1 + soa1_a2 + soa2_a1 + soa2_a2 + soa3_a1 + soa3_a2 + soa4_a1 + soa4_a2 + soa5_a1 + soa5_a2 + SOAG0 + SOAG1 + SOAG2 + SOAG3 + SOAG4 + SQTN + ST80_25 + SVOC + TEPOMUC + TERP1OOH + TERP2AOOH + TERPA + TERPA2 + TERPA2PAN + TERPA3 + TERPA3PAN + TERPACID + TERPACID2 + TERPACID3 + TERPAPAN + TERPDHDP + TERPF1 + TERPF2 + TERPFDN + TERPHFN + TERPK + TERPNPS + TERPNPS1 + TERPNPT + TERPNPT1 + TERPNS + TERPNS1 + TERPNT + TERPNT1 + TERPOOH + TERPOOHL + TOLOOH + TOLUENE + XYLENES + XYLENOOH + XYLOL + XYLOLOOH + ACBZO2 + ALKO2 + APINNO3 + APINO2 + APINO2VBS + BCARYNO3 + BCARYO2 + BCARYO2VBS + BENZO2 + BENZO2VBS + BPINNO3 + BPINO2 + BPINO2VBS + BZOO + C2H5O2 + C3H7O2 + C6H5O2 + CH3CO3 + CH3O2 + DICARBO2 + ENEO2 + EO + EO2 + HO2 + HOCH2OO + IEPOXOO + ISOPB1O2 + ISOPB4O2 + ISOPC1C + ISOPC1T + ISOPC4C + ISOPC4T + ISOPED1O2 + ISOPED4O2 + ISOPN1DO2 + ISOPN2BO2 + ISOPN3BO2 + ISOPN4DO2 + ISOPNBNO3O2 + ISOPNO3 + ISOPNOOHBO2 + ISOPNOOHDO2 + ISOPO2VBS + ISOPZD1O2 + ISOPZD4O2 + IVOCO2VBS + LIMONNO3 + LIMONO2 + LIMONO2VBS + MACRO2 + MALO2 + MCO3 + MDIALO2 + MEKO2 + MVKO2 + MYRCNO3 + MYRCO2 + MYRCO2VBS + NC4CHOO2 + O1D + OH + PHENO2 + PO2 + RO2 + TERP1OOHO2 + TERP2OOHO2 + TERPA1O2 + TERPA2CO3 + TERPA2O2 + TERPA3CO3 + TERPA3O2 + TERPA4O2 + TERPACO3 + TERPF1O2 + TERPF2O2 + TERPNPS1O2 + TERPNPT1O2 + TERPNS1O2 + TERPNT1O2 + TOLO2 + TOLUO2VBS + XYLENO2 + XYLEO2VBS + XYLOLO2 + 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 +********************************* +[jalknit->,jch3ooh] ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK +[jalkooh->,jch3ooh] ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 + 0.8*MEK + OH +[jbenzooh->,jch3ooh] BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 +[jbepomuc->,.10*jno2] BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO +[jbigald1->,.14*jno2] BIGALD1 + hv -> 0.6*MALO2 + HO2 +[jbigald2->,.20*jno2] BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 +[jbigald3->,.20*jno2] BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 +[jbigald4->,.006*jno2] BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 +[jbzooh->,jch3ooh] BZOOH + hv -> BZALD + OH + HO2 +[jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH +[jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 +[jc6h5ooh->,jch3ooh] C6H5OOH + hv -> PHENO + OH +[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_a] CH4 + hv -> H + CH3O2 +[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 +[jco2] CO2 + hv -> CO + O +[jdhpmpal->,4.62*jch3ooh] DHPMPAL + hv -> 0.5*CH3COCHO + 1.5*OH + 0.5*CH2O + 0.5*HYPERACET + 0.5*HO2 + 0.5*CO +[jeooh->,jch3ooh] EOOH + hv -> EO + OH +[jglyald] GLYALD + hv -> 2*HO2 + CO + CH2O +[jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2 +[jhcoch2ooh->,jch3ooh] HCOCH2OOH + hv -> CH2O + HO2 + CO + OH +[jhmhp->,0.75*jch3ooh] HMHP + hv -> 2*OH + CH2O +[jhonitr->,jch2o_a] HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + 0.17*CH3COCH3 +[jhpald1->,110.0*jmacr_a] HPALD1 + hv -> 0.62*HO2 + 1.32*CO + 0.68*CH3COCHO + 0.17*CO2 + 0.04*CH3O2 + 0.05*CH3CO3 + 1.11*OH + 0.23*MVKO2 + 0.41*HCOOH +[jhpald4->,110.0*jmacr_a] HPALD4 + hv -> 0.56*HO2 + 1.74*CO + 0.67*CH3COCHO + 0.28*CO2 + 0.07*CH3O2 + 0.07*CH3CO3 + 1.18*OH + 0.19*MACRO2 +[jhpaldb1c->,4.62*jch3ooh] HPALDB1C + hv -> OH + MVK + CO + HO2 +[jhpaldb4c->,4.62*jch3ooh] HPALDB4C + hv -> OH + HO2 + CO + MACR +[jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O +[jhydrald_b->,jmacr_b] HYDRALD + hv -> 1.5*HO2 + 1.5*CO + 0.5*HYAC + 0.5*CH3CO3 + 0.5*GLYALD +[jhydrald_a->,jmacr_a] HYDRALD + hv -> 3*OH + HO2 + CO + CO2 + CH3COCHO +[jhyperacet_c->,jacet] HYPERACET + hv -> CH3CO3 + CH2O + OH +[jhyperacet_p->,jch3ooh] HYPERACET + hv -> CH3CO3 + CH2O + OH +[jinheb->,jch3ooh] INHEB + hv -> NO2 + ICHE + HO2 +[jinhed->,jch3ooh] INHED + hv -> NO2 + ICHE + HO2 +[jisopfdn->,jch3ooh] ISOPFDN + hv -> HYAC + 2*NO2 + GLYALD +[jisopfdnc->,10.0*jch2o_a] ISOPFDNC + hv -> 2*NO2 + 0.5*CH3COCHO + 0.5*GLYALD + 0.5*HYAC + 0.5*GLYOXAL +[jisopfnc->,10.0*jch2o_a] ISOPFNC + hv -> OH + NO2 + 0.5*GLYALD + 0.5*CH3COCHO + 0.5*HYAC + 0.5*GLYOXAL +[jisopfnp->,jch3ooh] ISOPFNP + hv -> OH + NO2 + GLYALD + HYAC +[jisophfp->,jch3ooh] ISOPHFP + hv -> OH + HO2 + 0.72*CH3COCHO + 0.72*GLYALD + 0.28*GLYOXAL + 0.28*HYAC +[jisopn1d->,jch3ooh] ISOPN1D + hv -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MACROOH + 0.55*CO + 0.55*OH +[jisopn2b->,jch3ooh] ISOPN2B + hv -> NO2 + MVK + CH2O + HO2 +[jisopn3b->,jch3ooh] ISOPN3B + hv -> NO2 + MACR + CH2O + HO2 +[jisopn4d->,jch3ooh] ISOPN4D + hv -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MVKOOH + 0.55*CO + 0.55*OH +[jisopnbno3->,jch3ooh] ISOPNBNO3 + hv -> NO2 + HO2 + CH2O + 0.5*MVK + 0.5*MACR +[jisopnoohb->,jch3ooh] ISOPNOOHB + hv -> OH + CH2O + NO2 + 0.88*MVK + 0.12*MACR +[jisopnoohd->,jch3ooh] ISOPNOOHD + hv -> OH + HO2 + NC4CHO +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + CH2O + HO2 +[jmacr_b] MACR + hv -> HO2 + CO + CH2O + 0.35*CH3CO3 + 0.65*CH3O2 + 0.65*CO +[jmacr_a] MACR + hv -> HO2 + MCO3 +[jmacrn->,5.8*jch2o_a] MACRN + hv -> 0.75*CO + 0.75*NO2 + 0.5*HYAC + 1.25*HO2 + 0.25*CH3COCHO + 0.25*CH2O + 0.25*NOA +[jmacrooh->,jch3ooh] MACROOH + hv -> OH + HO2 + 0.86*HYAC + 0.86*CO + 0.14*CH2O + 0.14*CH3COCHO +[jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 +[jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO +[jmpan->,jpan] MPAN + hv -> MCO3 + NO2 +[jmvk] MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 +[jmvkn->,1.26*jch2o_a] MVKN + hv -> 0.75*NO2 + 0.25*NO3CH2CHO + 0.75*CH3CO3 + 0.5*GLYALD + 0.5*HO2 + 0.25*CH2O + 0.25*CH3COCHO +[jmvkooh->,jch3ooh] MVKOOH + hv -> OH + 0.56*GLYALD + 0.56*CH3CO3 + 0.44*CH2O + 0.44*HO2 + 0.44*CH3COCHO +[jnc4cho->,9.2*jch2o_a] NC4CHO + hv -> NO2 + HO2 + HYDRALD +[jno3ch2cho->,4.3*jch2o_a] NO3CH2CHO + hv -> NO2 + CH2O + CO + HO2 +[jnoa->,jch2o_a] NOA + hv -> NO2 + CH2O + CH3CO3 +[jonitr->,jch3cho] ONITR + hv -> NO2 +[jpan] PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 +[jphenooh->,jch3ooh] PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL +[jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH +[jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH +[jtepomuc->,.10*jno2] TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO +[jterp1ooh->,jch3ooh] TERP1OOH + hv -> OH + TERPF1 + HO2 +[jterp2aooh->,jch3ooh] TERP2AOOH + hv -> OH + TERPF2 + HO2 +[jterpa->,jch3cho] TERPA + hv -> CO + HO2 + TERPA1O2 +[jterpa2->,jch3cho] TERPA2 + hv -> CO + HO2 + TERPA2O2 +[jterpa2pan->,jpan] TERPA2PAN + hv -> TERPA2CO3 + NO2 +[jterpa3->,jch3cho] TERPA3 + hv -> CO + HO2 + TERPA4O2 +[jterpa3pan->,jpan] TERPA3PAN + hv -> TERPA3CO3 + NO2 +[jterpacid->,0.71*jch3ooh] TERPACID + hv -> OH + CO2 + TERPA1O2 +[jterpacid2->,0.71*jch3ooh] TERPACID2 + hv -> OH + CO2 + TERPA2O2 +[jterpacid3->,0.71*jch3ooh] TERPACID3 + hv -> OH + CO2 + TERPA4O2 +[jterpapan->,jpan] TERPAPAN + hv -> TERPACO3 + NO2 +[jterpdhdp->,2.0*jch3ooh] TERPDHDP + hv -> TERPOOH + OH + HO2 +[jterpfdn->,jch3ooh] TERPFDN + hv -> TERPNS + HO2 + NO2 +[jterphfn->,jch3ooh] TERPHFN + hv -> TERPNS + OH + HO2 +[jterpnps->,jch3ooh] TERPNPS + hv -> OH + 0.5*TERPNS + 0.5*HO2 + 0.5*TERPA + 0.5*NO2 +[jterpnps1->,jch3ooh] TERPNPS1 + hv -> OH + 0.54*TERPNS1 + 0.54*HO2 + 0.46*TERPF1 + 0.46*NO2 +[jterpnpt->,jch3ooh] TERPNPT + hv -> TERPA + NO2 + OH +[jterpnpt1->,jch3ooh] TERPNPT1 + hv -> OH + 0.54*TERPNT1 + 0.54*HO2 + 0.46*TERPF1 + 0.46*NO2 +[jterpns->,jch3ooh] TERPNS + hv -> NO2 + HO2 + TERPA +[jterpns1->,jch3ooh] TERPNS1 + hv -> NO2 + HO2 + TERPF1 +[jterpnt->,jch3ooh] TERPNT + hv -> NO2 + HO2 + TERPA +[jterpnt1->,jch3ooh] TERPNT1 + hv -> NO2 + HO2 + TERPF1 +[jterpooh->,jch3ooh] TERPOOH + hv -> OH + TERPA + HO2 +[jterpoohl->,jch3ooh] TERPOOHL + hv -> OH + TERPA3 + HO2 +[jtolooh->,jch3ooh] TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 +[jxylenooh->,jch3ooh] XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 +[jxylolooh->,jch3ooh] XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 +********************************* +*** 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 -> 2*CL + COFCL +[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 +[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_a] CLONO2 + hv -> CL + NO3 +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jcof2] COF2 + hv -> 2*F +[jcofcl] COFCL + hv -> F + CL +[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 +********************************* +[jsoa1_a1->,.0004*jno2] soa1_a1 + hv -> +[jsoa1_a2->,.0004*jno2] soa1_a2 + hv -> +[jsoa2_a1->,.0004*jno2] soa2_a1 + hv -> +[jsoa2_a2->,.0004*jno2] soa2_a2 + hv -> +[jsoa3_a1->,.0004*jno2] soa3_a1 + hv -> +[jsoa3_a2->,.0004*jno2] soa3_a2 + hv -> +[jsoa4_a1->,.0004*jno2] soa4_a1 + hv -> +[jsoa4_a2->,.0004*jno2] soa4_a2 + hv -> +[jsoa5_a1->,.0004*jno2] soa5_a1 + hv -> +[jsoa5_a2->,.0004*jno2] soa5_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 +[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 -> 2*CL + COFCL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 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 +********************************* +*** odd-fluorine +********************************* +[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 +[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 +[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 +[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 +[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 +[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 +********************************* +*** 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 + COFCL ; 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 + COFCL ; 1.794e-10 +[O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.3e-10 +[O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.65e-11 +********************************* +*** C1 +********************************* +[CH2O_HO2] CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625 +[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 +[HCN_OH] HCN + OH + M -> HO2 + M ; 6.1e-33, 1.5, 9.8e-15, -4.6, 0.8 +[HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4e-13 +[HMHP_OH] HMHP + OH -> 0.5*CH2O + 0.5*HO2 + 0.5*HCOOH + 0.5*OH + H2O ; 1.3e-12, 500 +[HOCH2OO_HO2] HOCH2OO + HO2 -> 0.5*HMHP + 0.5*HCOOH + 0.3*H2O + 0.2*HO2 + 0.2*OH ; 5.6e-15, 2300 +[HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.4e+12, -7000 +[HOCH2OO_NO] HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265 +[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 +[O1D_HCN] O1D + HCN -> OH ; 1.08e-10, 105 +[usr_CO_OH] CO + OH -> CO2 + HO2 +********************************* +*** C2 +********************************* +[C2H2_CL_M] C2H2 + CL + M -> CL + M ; 5.2e-30, 2.4, 2.2e-10, 0.7, 0.6 +[C2H2_OH_M] C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 + 0.35*CO + M ; 5.5e-30, 0, 8.3e-13, -2, 0.6 +[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 +[CH3CN_OH] CH3CN + OH -> HO2 ; 7.8e-13, -1050 +[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.36*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.49*OH + 0.49*CH3O2 + 0.49*CO2 ; 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 +[HCOCH2OOH_OH] HCOCH2OOH + OH -> 0.89*GLYOXAL + 0.89*OH + 0.11*CH2O + 0.11*HO2 + 0.11*CO ; 3.3e-11 +[NO3CH2CHO_OH] NO3CH2CHO + OH -> CO2 + CH2O + NO2 ; 3.4e-12 +[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 +[HYPERACET_OH] HYPERACET + OH -> 0.3*CH3CO3 + 0.3*CH2O + 0.7*CH3COCHO + 0.7*OH ; 1.2e-11 +[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 +********************************* +[BIGENE_NO3] BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 ; 3.5e-13 +[BIGENE_OH] BIGENE + OH -> ENEO2 ; 5.4e-11 +[DHPMPAL_OH] DHPMPAL + OH -> HYPERACET + CO + OH ; 3.77e-11 +[ENEO2_NO] ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 ; 4.8e-12, 120 +[ENEO2_NOb] ENEO2 + NO -> HONITR ; 5.1e-14, 693 +[HONITR_OH] HONITR + OH -> ONITR + HO2 ; 2e-12 +[MACRN_OH] MACRN + OH -> CO + 0.5*HO2 + 0.5*NOA + 0.5*NO2 + 0.5*HYAC ; 1.29e-11 +[MACRO2_CH3CO3] MACRO2 + CH3CO3 -> HO2 + 0.86*HYAC + 0.86*CO + 0.14*CH2O + 0.14*CH3COCHO + CO2 + CH3O2 ; 2e-12, 500 +[MACRO2_CH3O2] MACRO2 + CH3O2 -> 0.9*HYAC + 0.9*CO + 1.5*HO2 + 0.1*CH3COCH3 + 1.1*CH2O ; 4.5e-14 +[MACRO2_HO2] MACRO2 + HO2 -> 0.41*MACROOH + 0.59*OH + 0.59*HO2 + 0.51*HYAC + 0.51*CO + 0.08*CH3COCHO + 0.08*CH2O ; 2.11e-13, 1300 +[MACRO2_isom] MACRO2 -> HYAC + CO + OH ; 2.9e+07, -5297 +[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.55*MACRO2 + 0.45*H2O + 0.45*MCO3 ; 9.6e-12, 360 +[MACROOH_OH] MACROOH + OH -> HYAC + CO + OH ; 3.77e-11 +[MCO3_CH3CO3] MCO3 + CH3CO3 -> 2*CO2 + 0.35*CH3CO3 + CH2O + 1.65*CH3O2 + 0.65*CO ; 2.9e-12, 500 +[MCO3_CH3O2] MCO3 + CH3O2 -> CO2 + 0.35*CH3CO3 + 2*CH2O + 0.65*CH3O2 + 0.65*CO + HO2 ; 2e-12, 500 +[MCO3_HO2] MCO3 + HO2 -> 0.49*CH2O + 0.49*OH + 0.49*CO2 + 0.17*CH3CO3 + 0.32*CH3O2 + 0.32*CO + 0.15*O3 + 0.15*CH3COOH + 0.36*CH3COOOH ; 4.3e-13, 1040 +[MCO3_MCO3] MCO3 + MCO3 -> 2*CO2 + 0.7*CH3CO3 + 2*CH2O + 1.3*CH3O2 + 1.3*CO ; 2.9e-12, 500 +[MCO3_NO] MCO3 + NO -> NO2 + CO2 + 0.35*CH3CO3 + CH2O + 0.65*CH3O2 + 0.65*CO ; 8.1e-12, 270 +[MCO3_NO3] MCO3 + NO3 -> NO2 + CO2 + 0.35*CH3CO3 + CH2O + 0.65*CH3O2 + 0.65*CO ; 4e-12 +[MEKO2_HO2] MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 ; 7.5e-13, 700 +[MEKO2_NO] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180 +[MEK_OH] MEK + OH -> MEKO2 ; 2.3e-12, -170 +[MEKOOH_OH] MEKOOH + OH -> MEKO2 ; 3.8e-12, 200 +[MPAN_OH_M] MPAN + OH + M -> 0.25*HYAC + NO3 + 0.25*CO + M ; 8e-27, 3.5, 3e-11, 0, 0.5 +[MVKN_OH] MVKN + OH -> HO2 + 0.5*ONITR + 0.5*CO + 0.5*NOA ; 1.78e-12 +[MVKO2_CH3CO3] MVKO2 + CH3CO3 -> CH3O2 + CO2 + 0.75*GLYALD + 0.75*CH3CO3 + 0.25*CH2O + 0.25*HO2 + 0.25*CH3COCHO ; 2e-12, 500 +[MVKO2_CH3O2] MVKO2 + CH3O2 -> 0.25*CH3OH + 1*CO + 0.87*CH2O + 0.62*HO2 + 0.38*GLYALD + 0.88*CH3CO3 + 0.12*CH3COCHO ; 6.1e-13 +[MVKO2_HO2] MVKO2 + HO2 -> 0.46*MVKOOH + 0.54*OH + 0.36*GLYALD + 0.49*CH3CO3 + 0.26*CO + 0.18*HO2 + 0.05*CH3COCHO + 0.05*CH2O ; 2.11e-13, 1300 +[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 -> MVKO2 ; 2.7e-12, 580 +[MVKOOH_OH] MVKOOH + OH -> 1.56*CO + 0.44*HO2 + 0.44*CH3COCHO + 0.56*CH3CO3 ; 4.8e-11 +[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 +********************************* +[ALKNIT_OH] ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 ; 1.6e-12 +[ALKO2_HO2] ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700 +[ALKO2_NO] ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK + NO2 ; 6.7e-12 +[ALKO2_NOb] ALKO2 + NO -> ALKNIT ; 5.4e-14, 870 +[ALKOOH_OH] ALKOOH + OH -> ALKO2 ; 3.8e-12, 200 +[BIGALK_OH] BIGALK + OH -> ALKO2 ; 3.5e-12 +[HPALD1_OH] HPALD1 + OH -> 0.51*HO2 + 1.06*CO + 0.38*CH3COCHO + 0.54*CO2 + 0.06*CH3O2 + 0.06*CH3CO3 + 0.08*ICHE + 0.07*DHPMPAL + 0.43*OH + 0.35*MVK ; 1.17e-11, 450 +[HPALD4_OH] HPALD4 + OH -> 0.41*HO2 + 0.76*CO + 0.03*CH3COCHO + 0.54*CO2 + 0.06*CH3O2 + 0.06*CH3CO3 + 0.15*HYPERACET + 0.18*ICHE + 0.17*DHPMPAL + 0.35*MACR + 0.53*OH ; 1.17e-11, 450 +[HPALDB1C_OH] HPALDB1C + OH -> 0.58*ICHE + OH + 0.42*CO + 0.23*MVK + 0.19*MVKOOH ; 2.2e-11, 390 +[HPALDB4C_OH] HPALDB4C + OH -> 0.77*ICHE + OH + 0.23*CO + 0.14*MACR + 0.09*MACROOH ; 3.5e-11, 390 +[HYDRALD_OH] HYDRALD + OH -> 1.08*OH + CO + 0.36*CO2 + 0.46*CH3COCHO + 0.32*IEPOXOO + 0.22*HYAC + 0.32*HO2 ; 6.42e-11 +[ICHE_OH] ICHE + OH -> OH + 1.5*CO + 0.5*HYAC + 0.5*CH3COCHO + 0.5*CH2O ; 9.85e-12, 410 +[IEPOX_OH] IEPOX + OH -> 0.19*ICHE + 0.19*HO2 + 0.81*IEPOXOO ; 4.43e-11, -400 +[IEPOXOO_HO2] IEPOXOO + HO2 -> 0.35*ISOPHFP + 0.65*OH + 0.65*HO2 + 0.26*CO + 0.37*GLYALD + 0.46*CH3COCHO + 0.15*GLYOXAL + 0.19*HYAC ; 2.38e-13, 1300 +[INHEB_OH] INHEB + OH -> 0.2*INHEB + 0.4*NC4CHOO2 + 0.4*CH3COCHO + 0.4*HCOOH + 0.4*CH2O + 0.4*NO2 ; 4.43e-11, -400 +[INHED_OH] INHED + OH -> 0.35*NOA + 0.35*CO + 0.4*HO2 + 0.59*CH2O + 0.35*NC4CHOO2 + 0.06*INHED + 0.19*HYAC + 0.19*CO2 + 0.19*NO2 + 0.05*MVKN ; 3.22e-11, -400 +[ISOPB1O2_CH3CO3] ISOPB1O2 + CH3CO3 -> MVK + CH2O + HO2 + CO2 + CH3O2 ; 2e-12, 500 +[ISOPB1O2_CH3O2] ISOPB1O2 + CH3O2 -> 1.75*CH2O + 0.25*ISOPOH + 0.75*MVK + 1.5*HO2 ; 1.6e-13 +[ISOPB1O2_HO2] ISOPB1O2 + HO2 -> 0.06*MVK + 0.06*CH2O + 0.06*OH + 0.06*HO2 + 0.94*ISOPOOH ; 2.12e-13, 1300 +[ISOPB1O2_I] ISOPB1O2 -> MVK + CH2O + OH ; 1.04e+11, -9746 +[ISOPB1O2_M_C] ISOPB1O2 -> ISOPC1C + O2 ; 2.24e+15, -10865 +[ISOPB1O2_M_T] ISOPB1O2 -> ISOPC1T + O2 ; 2.22e+15, -10355 +[ISOPB4O2_CH3CO3] ISOPB4O2 + CH3CO3 -> MACR + CH2O + HO2 + CO2 + CH3O2 ; 2e-12, 500 +[ISOPB4O2_CH3O2] ISOPB4O2 + CH3O2 -> 0.25*CH3OH + 0.25*HYDRALD + 0.25*ISOPOH + 1.25*CH2O + HO2 + 0.5*MACR ; 1.4e-12 +[ISOPB4O2_HO2] ISOPB4O2 + HO2 -> 0.06*MACR + 0.06*CH2O + 0.06*OH + 0.06*HO2 + 0.94*ISOPOOH ; 2.12e-13, 1300 +[ISOPB4O2_I] ISOPB4O2 -> MACR + CH2O + OH ; 1.88e+11, -9752 +[ISOPB4O2_M_C] ISOPB4O2 -> ISOPC4C + O2 ; 2.49e+15, -11112 +[ISOPB4O2_M_T] ISOPB4O2 -> ISOPC4T + O2 ; 2.49e+15, -10890 +[ISOPC1C_O2_B] O2 + ISOPC1C -> ISOPB1O2 ; 7.5e-13 +[ISOPC1C_O2_D] ISOPC1C + O2 -> ISOPZD1O2 ; 1.4e-13 +[ISOPC1T_O2_B] ISOPC1T + O2 -> ISOPB1O2 ; 7.5e-13 +[ISOPC1T_O2_D] ISOPC1T + O2 -> ISOPED1O2 ; 3.6e-13 +[ISOPC4C_O2_B] ISOPC4C + O2 -> ISOPB4O2 ; 6.5e-13 +[ISOPC4C_O2_D] ISOPC4C + O2 -> ISOPZD4O2 ; 2.1e-13 +[ISOPC4T_O2_B] ISOPC4T + O2 -> ISOPB4O2 ; 6.5e-13 +[ISOPC4T_O2_D] ISOPC4T + O2 -> ISOPED4O2 ; 4.9e-13 +[ISOPED1O2_CH3CO3] ISOPED1O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH + 0.55*MVKOOH + CO2 + CH3O2 ; 2e-12, 500 +[ISOPED1O2_CH3O2] ISOPED1O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O + 0.72*HO2 + 0.28*CO + 0.28*OH + 0.28*MVKOOH + 0.47*HYDRALD ; 1.2e-12 +[ISOPED1O2_HO2] ISOPED1O2 + HO2 -> ISOPOOH ; 2.12e-13, 1300 +[ISOPED1O2_M_C] ISOPED1O2 -> ISOPC1T + O2 ; 1.83e+14, -8930 +[ISOPED4O2_CH3CO3] ISOPED4O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH + 0.55*MACROOH + CO2 + CH3O2 ; 2e-12, 500 +[ISOPED4O2_CH3O2] ISOPED4O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O + 0.72*HO2 + 0.28*CO + 0.28*OH + 0.28*MACROOH + 0.47*HYDRALD ; 9.8e-13 +[ISOPED4O2_HO2] ISOPED4O2 + HO2 -> ISOPOOH ; 2.12e-13, 1300 +[ISOPED4O2_M] ISOPED4O2 -> ISOPC4T + O2 ; 2.08e+14, -9400 +[ISOPFDNC_OH] ISOPFDNC + OH -> CO + NO2 + 0.5*MACRN + 0.5*MVKN ; 1.85e-11 +[ISOPFDN_OH] ISOPFDN + OH -> ISOPFDNC + HO2 ; 1.63e-12 +[ISOPFNC_OH] ISOPFNC + OH -> CO + 0.5*NO2 + 0.5*OH + 0.25*MACRN + 0.25*MVKN + 0.25*MACROOH + 0.25*MVKOOH ; 2.5e-11 +[ISOPFNP_OH] ISOPFNP + OH -> ISOPFNC + HO2 ; 1.1e-11 +[ISOPHFP_OH] ISOPHFP + OH -> 2*CO + OH + 0.72*CH3COCHO + 0.28*HYAC ; 3.3e-11 +[ISOPN1DO2_HO2] ISOPN1DO2 + HO2 -> 0.42*ISOPFNP + 0.58*OH + 0.58*HO2 + 0.55*NOA + 0.55*GLYALD + 0.03*MACRN + 0.03*CH2O ; 2.6e-13, 1300 +[ISOPN1DO2_I] ISOPN1DO2 -> ISOPFNP + HO2 ; 1.256e+13, -10000 +[ISOPN1D_O3] ISOPN1D + O3 -> 0.66*H2O2 + 0.83*GLYALD + 0.83*NOA + 0.34*OH + 0.17*NO2 + 0.17*CH3COCHO + 0.17*GLYOXAL + 0.17*HO2 ; 2.8e-17 +[ISOPN1D_OH] ISOPN1D + OH -> 0.08*IEPOX + 0.08*NO2 + 0.04*NC4CHO + 0.04*HO2 + 0.06*MACRN + 0.06*OH + 0.06*CO + 0.82*ISOPN1DO2 ; 8e-11 +[ISOPN2BO2_HO2] ISOPN2BO2 + HO2 -> 0.48*ISOPFNP + 0.52*OH + 0.06*MACRN + 0.06*CH2O + 0.06*HO2 + 0.46*HYAC + 0.46*NO2 + 0.46*GLYALD ; 2.6e-13, 1300 +[ISOPN2BO2_I] ISOPN2BO2 -> ISOPFNC + HO2 ; 1.875e+13, -10000 +[ISOPN2B_OH] ISOPN2B + OH -> 0.15*IEPOX + 0.15*NO2 + 0.85*ISOPN2BO2 ; 3e-11 +[ISOPN3BO2_HO2] ISOPN3BO2 + HO2 -> 0.4*ISOPFNP + 0.6*OH + 0.6*MVKN + 0.6*CH2O + 0.6*HO2 ; 2.6e-13, 1300 +[ISOPN3BO2_I] ISOPN3BO2 -> ISOPFNC + HO2 ; 1.875e+13, -10000 +[ISOPN3B_OH] ISOPN3B + OH -> 0.13*IEPOX + 0.13*NO2 + 0.87*ISOPN3BO2 ; 4.2e-11 +[ISOPN4DO2_HO2] ISOPN4DO2 + HO2 -> 0.5*ISOPFNP + 0.5*OH + 0.5*HO2 + 0.06*MVKN + 0.06*CH2O + 0.44*HYAC + 0.44*NO3CH2CHO ; 2.6e-13, 1300 +[ISOPN4DO2_I] ISOPN4DO2 -> ISOPFNP + HO2 ; 5.092e+12, -10000 +[ISOPN4D_O3] ISOPN4D + O3 -> 0.66*H2O2 + 0.83*NO3CH2CHO + 0.83*HYAC + 0.34*OH + 0.17*NO2 + 0.17*GLYOXAL + 0.17*CH3COCHO + 0.17*HO2 ; 2.8e-17 +[ISOPN4D_OH] ISOPN4D + OH -> 0.04*IEPOX + 0.04*NO2 + 0.03*NC4CHO + 0.03*HO2 + 0.04*MVKN + 0.04*CO + 0.04*OH + 0.89*ISOPN4DO2 ; 1.1e-10 +[ISOPNBNO3O2_HO2] ISOPNBNO3O2 + HO2 -> 0.6*ISOPFNP + 0.4*OH + 0.4*HO2 + 0.06*MACRN + 0.04*MVKN + 0.1*CH2O + 0.15*NOA + 0.15*GLYALD + 0.15*HYAC + 0.15*NO3CH2CHO ; 2.6e-13, 1300 +[ISOPNBNO3_OH] ISOPNBNO3 + OH -> 0.03*INHED + 0.03*OH + 0.05*NC4CHO + 0.05*HO2 + 0.92*ISOPNBNO3O2 ; 3.9e-11 +[ISOP_NO3] ISOP + NO3 -> ISOPNO3 ; 2.95e-12, -450 +[ISOPNO3_CH3CO3] ISOPNO3 + CH3CO3 -> CH3O2 + CO2 + 0.46*NO2 + 0.46*CH2O + 0.54*NC4CHO + 0.54*HO2 + 0.42*MVK + 0.04*MACR ; 2e-12, 500 +[ISOPNO3_CH3O2] ISOPNO3 + CH3O2 -> 0.07*ISOPNBNO3 + 0.71*CH2O + 0.05*MVK + 0.07*NO2 + 0.4*HO2 + 0.02*MACR + 0.53*NC4CHO + 0.36*CH3OH + 0.28*ISOPN1D + 0.05*ISOPN4D ; 1.3e-12 +[ISOPNO3_HO2] ISOPNO3 + HO2 -> 0.23*ISOPNOOHB + 0.53*ISOPNOOHD + 0.22*MVK + 0.02*MACR + 0.24*CH2O + 0.24*OH + 0.24*NO2 ; 2.47e-13, 1300 +[ISOPNO3_ISOPNO3] ISOPNO3 + ISOPNO3 -> 1.07*NC4CHO + 0.4*HO2 + 0.16*MACR + 0.16*CH2O + 0.16*NO2 + 0.53*ISOPN1D + 0.09*ISOPN4D + 0.15*ISOPNBNO3 ; 5e-12 +[ISOPNO3_NO3] ISOPNO3 + NO3 -> 1.46*NO2 + 0.46*CH2O + 0.54*NC4CHO + 0.54*HO2 + 0.42*MVK + 0.04*MACR ; 2.3e-12 +[ISOPNOOHBO2_HO2] ISOPNOOHBO2 + HO2 -> 0.49*ISOPFNP + 0.85*OH + 0.17*CH2O + 0.17*HO2 + 0.15*MACRN + 0.02*MVKN + 0.28*NOA + 0.28*GLYALD + 0.06*HYAC + 0.06*NO3CH2CHO ; 2.64e-13, 1300 +[ISOPNOOHBO2_I] ISOPNOOHBO2 -> OH + ISOPFNP ; 8.72e+12, -10000 +[ISOPNOOHB_OH] ISOPNOOHB + OH -> 0.17*ISOPNO3 + 0.02*NC4CHO + 0.4*INHEB + 0.42*OH + 0.41*ISOPNOOHBO2 ; 3.9e-11 +[ISOPNOOHDO2_HO2] ISOPNOOHDO2 + HO2 -> 0.17*ISOPFNP + 0.86*OH + 0.03*CH2O + 0.02*MACRN + 0.01*MVKN + 0.68*NOA + 0.68*HCOCH2OOH + 0.12*HYPERACET + 0.12*NO3CH2CHO + 0.8*HO2 ; 2.64e-13, 1300 +[ISOPNOOHDO2_I] ISOPNOOHDO2 -> OH + ISOPFNP ; 6.55e+12, -10000 +[ISOPNOOHD_O3] ISOPNOOHD + O3 -> 0.66*H2O2 + 0.7*HCOCH2OOH + 0.13*HYPERACET + 0.7*NOA + 0.13*NO3CH2CHO + 0.51*OH + 0.17*NO2 + 0.17*CH3COCHO + 0.17*GLYOXAL ; 2.8e-17 +[ISOPNOOHD_OH] ISOPNOOHD + OH -> 0.07*ISOPNO3 + 0.09*NC4CHO + 0.29*OH + 0.2*INHED + 0.07*IEPOX + 0.07*NO2 + 0.57*ISOPNOOHDO2 ; 9.2e-11 +[ISOP_O3] ISOP + O3 -> 0.25*OH + 0.41*MACR + 0.17*MVK + 0.33*HMHP + 0.03*H2O2 + 0.22*HCOOH + 1.01*CH2O + 0.42*CO2 + 0.42*HO2 + 0.21*CH3O2 + 0.07*CH3CO3 + 0.35*CO ; 1.03e-14, -1995 +[ISOP_OH] ISOP + OH -> 0.315*ISOPC1T + 0.315*ISOPC1C + 0.111*ISOPC4T + 0.259*ISOPC4C ; 2.7e-11, 390 +[ISOPOH_OH] ISOPOH + OH -> HYAC + GLYALD + HO2 ; 3.85e-11 +[ISOPOOH_OH_abs] ISOPOOH + OH -> 0.53*ISOPB1O2 + 0.16*ISOPB4O2 + 0.13*HYDRALD + 0.13*OH + 0.09*HPALDB1C + 0.09*HPALDB4C + 0.18*HO2 ; 5.53e-12, 200 +[ISOPOOH_OH_add] ISOPOOH + OH -> 0.85*IEPOX + 0.92*OH + 0.07*GLYALD + 0.07*HYAC + 0.08*ISOPHFP ; 2.08e-11, 390 +[ISOPZD1O2_CH3CO3] ISOPZD1O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH + 0.55*MVKOOH + CO2 + CH3O2 ; 2e-12, 500 +[ISOPZD1O2_CH3O2] ISOPZD1O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O + 0.72*HO2 + 0.28*CO + 0.28*OH + 0.28*MVKOOH + 0.47*HYDRALD ; 1.2e-12 +[ISOPZD1O2_HO2] ISOPZD1O2 + HO2 -> ISOPOOH ; 2.12e-13, 1300 +[ISOPZD1O2_M] ISOPZD1O2 -> ISOPC1C + O2 ; 1.79e+14, -8830 +[ISOPZD4O2_CH3CO3] ISOPZD4O2 + CH3CO3 -> 0.45*HO2 + 0.45*HYDRALD + 0.55*CO + 0.55*OH + 0.55*MACROOH + CO2 + CH3O2 ; 2e-12, 500 +[ISOPZD4O2_CH3O2] ISOPZD4O2 + CH3O2 -> 0.25*CH3OH + 0.25*ISOPOH + 0.75*CH2O + 0.72*HO2 + 0.28*CO + 0.28*OH + 0.28*MACROOH + 0.47*HYDRALD ; 9.8e-13 +[ISOPZD4O2_HO2] ISOPZD4O2 + HO2 -> ISOPOOH ; 2.12e-13, 1300 +[ISOPZD4O2_M_C] ISOPZD4O2 -> ISOPC4C + O2 ; 1.75e+14, -9054 +[NC4CHOO2_HO2] NC4CHOO2 + HO2 -> 0.2*ISOPFNP + 0.8*OH + 0.8*HO2 + 0.1*NOA + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*NO3CH2CHO + 0.29*MACRN + 0.31*MVKN + 0.6*CO ; 2.6e-13, 1300 +[NC4CHOO2_isom] NC4CHOO2 -> 0.51*MACRN + 0.49*MVKN + CO + OH ; 1e+07, -5000 +[NC4CHO_O3] NC4CHO + O3 -> 0.66*H2O2 + 0.66*GLYOXAL + 0.34*CH3COCHO + 0.61*NOA + 0.22*NO3CH2CHO + 0.34*OH + 0.17*NO2 + 0.3*CO + 0.13*HO2 + 0.04*CH3CO3 ; 4.4e-18 +[NC4CHO_OH] NC4CHO + OH -> 0.45*CO2 + 0.1*CH3CO3 + 0.1*NO3CH2CHO + 0.35*NOA + 0.04*NO2 + 0.04*ICHE + 0.24*MACRN + 0.04*MVKN + 0.63*CO + 0.63*HO2 + 0.23*NC4CHOO2 ; 3.6e-11 +[usr_IEPOXOO_NOa] IEPOXOO + NO -> NO2 + HO2 + 0.57*GLYALD + 0.71*CH3COCHO + 0.4*CO + 0.23*GLYOXAL + 0.29*HYAC +[usr_IEPOXOO_NOn] IEPOXOO + NO -> ISOPFNC +[usr_ISOPB1O2_NOa] ISOPB1O2 + NO -> NO2 + MVK + CH2O + HO2 +[usr_ISOPB1O2_NOn] ISOPB1O2 + NO -> ISOPN2B +[usr_ISOPB4O2_NOa] ISOPB4O2 + NO -> NO2 + MACR + CH2O + HO2 +[usr_ISOPB4O2_NOn] ISOPB4O2 + NO -> ISOPN3B +[usr_ISOPED1O2_NOa] ISOPED1O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MVKOOH + 0.55*CO + 0.55*OH +[usr_ISOPED1O2_NOn] ISOPED1O2 + NO -> ISOPN4D +[usr_ISOPED4O2_NOa] ISOPED4O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MACROOH + 0.55*CO + 0.55*OH +[usr_ISOPED4O2_NOn] ISOPED4O2 + NO -> ISOPN1D +[usr_ISOPN1DO2_NOa] ISOPN1DO2 + NO -> NO2 + HO2 + 0.94*NOA + 0.94*GLYALD + 0.06*MACRN + 0.06*CH2O +[usr_ISOPN1DO2_NOn] ISOPN1DO2 + NO -> ISOPFDN +[usr_ISOPN2BO2_NOa] ISOPN2BO2 + NO -> 1.73*NO2 + 0.27*MACRN + 0.27*CH2O + 0.27*HO2 + 0.73*HYAC + 0.73*GLYALD +[usr_ISOPN2BO2_NOn] ISOPN2BO2 + NO -> ISOPFDN +[usr_ISOPN3BO2_NOa] ISOPN3BO2 + NO -> NO2 + MVKN + CH2O + HO2 +[usr_ISOPN3BO2_NOn] ISOPN3BO2 + NO -> ISOPFDN +[usr_ISOPN4DO2_NOa] ISOPN4DO2 + NO -> NO2 + HO2 + 0.13*MVKN + 0.13*CH2O + 0.87*HYAC + 0.87*NO3CH2CHO +[usr_ISOPN4DO2_NOn] ISOPN4DO2 + NO -> ISOPFDN +[usr_ISOPNBNO3O2_NOa] ISOPNBNO3O2 + NO -> NO2 + HO2 + 0.21*MACRN + 0.12*MVKN + 0.33*CH2O + 0.34*NOA + 0.34*GLYALD + 0.33*HYAC + 0.33*NO3CH2CHO +[usr_ISOPNBNO3O2_NOn] ISOPNBNO3O2 + NO -> ISOPFDN +[usr_ISOPNO3_NOa] ISOPNO3 + NO -> 1.46*NO2 + 0.46*CH2O + 0.54*NC4CHO + 0.54*HO2 + 0.42*MVK + 0.04*MACR +[usr_ISOPNO3_NOn] ISOPNO3 + NO -> ISOPFDN +[usr_ISOPNOOHBO2_NOa] ISOPNOOHBO2 + NO -> NO2 + 0.53*CH2O + 0.53*HO2 + 0.49*MACRN + 0.04*MVKN + 0.4*NOA + 0.4*GLYALD + 0.07*HYAC + 0.07*NO3CH2CHO + 0.47*OH +[usr_ISOPNOOHBO2_NOn] ISOPNOOHBO2 + NO -> ISOPFDN +[usr_ISOPNOOHDO2_NOa] ISOPNOOHDO2 + NO -> NO2 + 0.04*CH2O + 0.04*OH + 0.02*MACRN + 0.02*MVKN + 0.81*NOA + 0.81*HCOCH2OOH + 0.15*HYPERACET + 0.15*NO3CH2CHO + 0.96*HO2 +[usr_ISOPNOOHDO2_NOn] ISOPNOOHDO2 + NO -> ISOPFDN +[usr_ISOPZD1O2] ISOPZD1O2 -> 0.15*HPALDB1C + 0.25*HPALD1 + 0.4*HO2 + 0.6*OH + 0.6*DHPMPAL + 0.6*CO +[usr_ISOPZD1O2_NOa] ISOPZD1O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MVKOOH + 0.55*CO + 0.55*OH +[usr_ISOPZD1O2_NOn] ISOPZD1O2 + NO -> ISOPN4D +[usr_ISOPZD4O2] ISOPZD4O2 -> 0.15*HPALDB4C + 0.25*HPALD4 + 0.4*HO2 + 0.6*OH + 0.6*DHPMPAL + 0.6*CO +[usr_ISOPZD4O2_NOa] ISOPZD4O2 + NO -> NO2 + 0.45*HYDRALD + 0.45*HO2 + 0.55*MACROOH + 0.55*CO + 0.55*OH +[usr_ISOPZD4O2_NOn] ISOPZD4O2 + NO -> ISOPN1D +[usr_MACRO2_NOa] MACRO2 + NO -> NO2 + HO2 + 0.86*HYAC + 0.86*CO + 0.14*CH2O + 0.14*CH3COCHO +[usr_MACRO2_NOn] MACRO2 + NO -> MACRN +[usr_MVKO2_NOa] MVKO2 + NO -> NO2 + 0.24*HO2 + 0.24*CH2O + 0.76*CH3CO3 + 0.76*GLYALD + 0.24*CH3COCHO +[usr_MVKO2_NOn] MVKO2 + NO -> MVKN +[usr_NC4CHOO2_NOa] NC4CHOO2 + NO -> NO2 + HO2 + 0.13*NOA + 0.13*GLYOXAL + 0.12*CH3COCHO + 0.12*NO3CH2CHO + 0.39*MACRN + 0.36*MVKN + 0.75*CO +[usr_NC4CHOO2_NOn] NC4CHOO2 + NO -> ISOPFDNC +********************************* +*** C7 +********************************* +[ACBZO2_HO2] ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH ; 4.3e-13, 1040 +[ACBZO2_NO] ACBZO2 + NO -> C6H5O2 + NO2 ; 7.5e-12, 290 +[BENZENE_OH] BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 ; 2.3e-12, -193 +[BENZO2_HO2] BENZO2 + HO2 -> BENZOOH ; 7.5e-13, 700 +[BENZO2_NO] BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 ; 2.6e-12, 365 +[BENZOOH_OH] BENZOOH + OH -> BENZO2 ; 3.8e-12, 200 +[BZALD_OH] BZALD + OH -> ACBZO2 ; 5.9e-12, 225 +[BZOO_HO2] BZOO + HO2 -> BZOOH ; 7.5e-13, 700 +[BZOOH_OH] BZOOH + OH -> BZOO ; 3.8e-12, 200 +[BZOO_NO] BZOO + NO -> BZALD + NO2 + HO2 ; 2.6e-12, 365 +[C6H5O2_HO2] C6H5O2 + HO2 -> C6H5OOH ; 7.5e-13, 700 +[C6H5O2_NO] C6H5O2 + NO -> PHENO + NO2 ; 2.6e-12, 365 +[C6H5OOH_OH] C6H5OOH + OH -> C6H5O2 ; 3.8e-12, 200 +[CRESOL_OH] CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO ; 4.7e-11 +[DICARBO2_HO2] DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO + 0.33*CH3O2 ; 4.3e-13, 1040 +[DICARBO2_NO] DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO + 0.83*CH3O2 ; 7.5e-12, 290 +[DICARBO2_NO2] DICARBO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MALO2_HO2] MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO ; 4.3e-13, 1040 +[MALO2_NO] MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 ; 7.5e-12, 290 +[MALO2_NO2] MALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MDIALO2_HO2] MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO + 0.07*CH3O2 + 0.07*GLYOXAL ; 4.3e-13, 1040 +[MDIALO2_NO] MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO + 0.17*CH3O2 + 0.17*GLYOXAL ; 7.5e-12, 290 +[MDIALO2_NO2] MDIALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[PHENO2_HO2] PHENO2 + HO2 -> PHENOOH ; 7.5e-13, 700 +[PHENO2_NO] PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 ; 2.6e-12, 365 +[PHENOL_OH] PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO ; 4.7e-13, 1220 +[PHENO_NO2] PHENO + NO2 -> 1*NDEP ; 2.1e-12 +[PHENO_O3] PHENO + O3 -> C6H5O2 ; 2.8e-13 +[PHENOOH_OH] PHENOOH + OH -> PHENO2 ; 3.8e-12, 200 +[tag_ACBZO2_NO2] ACBZO2 + NO2 + M -> PBZNIT + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[TOLO2_HO2] TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700 +[TOLO2_NO] TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 ; 2.6e-12, 365 +[TOLOOH_OH] TOLOOH + OH -> TOLO2 ; 3.8e-12, 200 +[TOLUENE_OH] TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 + 0.28*HO2 ; 1.7e-12, 352 +[usr_PBZNIT_M] PBZNIT + M -> ACBZO2 + NO2 + M +[XYLENES_OH] XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO + 0.56*XYLENO2 + 0.38*HO2 ; 1.7e-11 +[XYLENO2_HO2] XYLENO2 + HO2 -> XYLENOOH ; 7.5e-13, 700 +[XYLENO2_NO] XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 ; 2.6e-12, 365 +[XYLENOOH_OH] XYLENOOH + OH -> XYLENO2 ; 3.8e-12, 200 +[XYLOLO2_HO2] XYLOLO2 + HO2 -> XYLOLOOH ; 7.5e-13, 700 +[XYLOLO2_NO] XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO ; 2.6e-12, 365 +[XYLOL_OH] XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO ; 8.4e-11 +[XYLOLOOH_OH] XYLOLOOH + OH -> XYLOLO2 ; 3.8e-12, 200 +********************************* +*** C10 +********************************* +[APIN_NO3] APIN + NO3 -> APINNO3 ; 1.2e-12, 490 +[APINNO3_APINNO3] APINNO3 + APINNO3 -> 0.27*TERPNT + 0.09*TERPNS + 1.64*NO2 + 1.64*TERPA ; 5.3e-13 +[APINNO3_CH3CO3] APINNO3 + CH3CO3 -> NO2 + TERPA + CH3O2 + CO2 ; 2e-12, 500 +[APINNO3_CH3O2] APINNO3 + CH3O2 -> 0.09*TERPNT + 0.09*TERPNS + 0.95*CH2O + 0.05*CH3OH + 0.82*HO2 + 0.82*NO2 + 0.82*TERPA ; 2e-12 +[APINNO3_HO2] APINNO3 + HO2 -> 0.3*TERPNPT + 0.7*TERPA + 0.7*NO2 + 0.7*OH ; 2.71e-13, 1300 +[APINNO3_NO] APINNO3 + NO -> 1.86*NO2 + 0.07*TERPFDN + 0.93*TERPA ; 2.7e-12, 360 +[APINNO3_NO3] APINNO3 + NO3 -> 2*NO2 + TERPA ; 2.3e-12 +[APINNO3_TERPA2CO3] APINNO3 + TERPA2CO3 -> NO2 + TERPA + TERPA2O2 + CO2 ; 2e-12, 500 +[APINNO3_TERPA3CO3] APINNO3 + TERPA3CO3 -> NO2 + TERPA + TERPA4O2 + CO2 ; 2e-12, 500 +[APINNO3_TERPACO3] APINNO3 + TERPACO3 -> NO2 + TERPA + TERPA1O2 + CO2 ; 2e-12, 500 +[APINO2_CH3CO3] APINO2 + CH3CO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + HO2 + CH3O2 + CO2 ; 2e-12, 500 +[APINO2_CH3O2] APINO2 + CH3O2 -> 0.83*CH2O + 0.14*TERPF1 + 0.42*TERPA + 0.2*TERPA3 + 0.13*TERP1OOH + 0.17*CH3OH + 0.11*TERPK + 0.06*CH3COCH3 + 1.16*HO2 ; 2e-12 +[APINO2_HO2] APINO2 + HO2 -> 0.06*CH3COCH3 + 0.06*TERPF1 + 0.08*CH2O + 0.25*TERP1OOH + 0.48*HO2 + 0.4*TERPOOH + 0.29*TERPA + 0.35*OH ; 2.6e-13, 1300 +[APINO2_NO] APINO2 + NO -> 0.01*TERPHFN + 0.02*TERPNS1 + 0.1*TERPNS + 0.05*TERPNT + 0.05*TERPNT1 + 0.77*NO2 + 0.77*HO2 + 0.3*TERPA + 0.27*TERPA3 + 0.09*CH3COCH3 + 0.09*TERPF1 + 0.21*CH2O + 0.11*TERP1OOH ; 2.7e-12, 360 +[APINO2_NO3] APINO2 + NO3 -> NO2 + HO2 + 0.39*TERPA + 0.35*TERPA3 + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + 0.14*TERP1OOH ; 2.3e-12 +[APINO2_TERPA2CO3] APINO2 + TERPA2CO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + HO2 + TERPA2O2 + CO2 ; 2e-12, 500 +[APINO2_TERPA3CO3] APINO2 + TERPA3CO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + HO2 + TERPA4O2 + CO2 ; 2e-12, 500 +[APINO2_TERPACO3] APINO2 + TERPACO3 -> 0.39*TERPA + 0.35*TERPA3 + 0.14*TERP1OOH + 0.12*CH3COCH3 + 0.12*TERPF1 + 0.27*CH2O + HO2 + TERPA1O2 + CO2 ; 2e-12, 500 +[APIN_O3] APIN + O3 -> 0.77*OH + 0.33*TERPA2O2 + 0.22*H2O2 + 0.22*TERPA + 0.01*TERPACID + 0.17*TERPA2 + 0.17*HO2 + 0.17*CO + 0.27*CH2O + 0.27*TERPA2CO3 ; 8.05e-16, -640 +[APIN_OH] APIN + OH -> APINO2 ; 1.34e-11, 410 +[BCARY_NO3] BCARY + NO3 -> BCARYNO3 ; 1.9e-11 +[BCARYNO3_BCARYNO3] BCARYNO3 + BCARYNO3 -> 0.36*SQTN + 1.64*NO2 + 1.64*TERPF2 ; 5.3e-13 +[BCARYNO3_CH3CO3] BCARYNO3 + CH3CO3 -> CH3O2 + CO2 + NO2 + TERPF2 ; 2e-12, 500 +[BCARYNO3_CH3O2] BCARYNO3 + CH3O2 -> 0.18*SQTN + 0.95*CH2O + 0.82*TERPF2 + 0.82*NO2 + 0.82*HO2 + 0.05*CH3OH ; 2e-12 +[BCARYNO3_HO2] BCARYNO3 + HO2 -> 0.5*SQTN + 0.5*OH + 0.5*NO2 + 0.5*TERPF2 ; 2.78e-13, 1300 +[BCARYNO3_NO] BCARYNO3 + NO -> 0.07*SQTN + 1.86*NO2 + 0.93*TERPF2 ; 2.7e-12, 360 +[BCARYNO3_NO3] BCARYNO3 + NO3 -> 2*NO2 + TERPF2 ; 2.3e-12 +[BCARYNO3_TERPA2CO3] BCARYNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + NO2 + TERPF2 ; 2e-12, 500 +[BCARYNO3_TERPA3CO3] BCARYNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + NO2 + TERPF2 ; 2e-12, 500 +[BCARYNO3_TERPACO3] BCARYNO3 + TERPACO3 -> TERPA1O2 + CO2 + NO2 + TERPF2 ; 2e-12, 500 +[BCARYO2_CH3CO3] BCARYO2 + CH3CO3 -> TERPF2 + HO2 + CH3O2 + CO2 ; 2e-12, 500 +[BCARYO2_CH3O2] BCARYO2 + CH3O2 -> 0.25*CH3OH + TERPF2 + 0.75*CH2O + HO2 ; 2e-12 +[BCARYO2_HO2] BCARYO2 + HO2 -> 0.9*TERP2AOOH + 0.1*OH + 0.1*HO2 + 0.1*TERPF2 ; 2.75e-13, 1300 +[BCARYO2_NO] BCARYO2 + NO -> 0.3*SQTN + 0.7*NO2 + 0.7*HO2 + 0.7*TERPF2 ; 2.7e-12, 360 +[BCARYO2_NO3] BCARYO2 + NO3 -> NO2 + HO2 + TERPF2 ; 2.3e-12 +[BCARYO2_TERPA2CO3] BCARYO2 + TERPA2CO3 -> TERPF2 + HO2 + TERPA2O2 + CO2 ; 2e-12, 500 +[BCARYO2_TERPA3CO3] BCARYO2 + TERPA3CO3 -> TERPF2 + HO2 + TERPA4O2 + CO2 ; 2e-12, 500 +[BCARYO2_TERPACO3] BCARYO2 + TERPACO3 -> TERPF2 + HO2 + TERPA1O2 + CO2 ; 2e-12, 500 +[BCARY_O3] BCARY + O3 -> 0.13*TERPACID + 0.17*H2O2 + 0.08*OH + 0.08*HO2 + 0.08*CH2O + 0.87*TERPF2 ; 1.2e-14 +[BCARY_OH] BCARY + OH -> BCARYO2 ; 2e-10 +[BPIN_NO3] BPIN + NO3 -> BPINNO3 ; 2.5e-12 +[BPINNO3_BPINNO3] BPINNO3 + BPINNO3 -> 0.94*NO2 + 0.92*TERPNS + 0.9*TERPA3 + 0.04*TERPK + 0.04*CH2O + 0.14*TERPNT + 0.94*HO2 ; 5.3e-13 +[BPINNO3_CH3CO3] BPINNO3 + CH3CO3 -> CH3O2 + CO2 + 0.5*NO2 + 0.45*TERPNS + 0.48*TERPA3 + 0.02*TERPK + 0.02*CH2O + 0.05*TERPNT + 0.5*HO2 ; 2e-12, 500 +[BPINNO3_CH3O2] BPINNO3 + CH3O2 -> 0.56*TERPNS + 0.08*TERPNT + 0.02*TERPK + 0.34*TERPA3 + 0.36*NO2 + 1.1*HO2 + 0.99*CH2O + 0.03*CH3OH ; 2e-12 +[BPINNO3_HO2] BPINNO3 + HO2 -> 0.47*OH + 0.45*TERPNPS + 0.22*TERPA3 + 0.02*TERPK + 0.08*TERPNPT + 0.24*NO2 + 0.02*CH2O + 0.23*TERPNS ; 2.71e-13, 1300 +[BPINNO3_NO] BPINNO3 + NO -> 0.07*TERPFDN + 1.39*NO2 + 0.42*TERPNS + 0.44*TERPA3 + 0.02*TERPK + 0.02*CH2O + 0.05*TERPNT + 0.47*HO2 ; 2.7e-12, 360 +[BPINNO3_NO3] BPINNO3 + NO3 -> 1.5*NO2 + 0.45*TERPNS + 0.48*TERPA3 + 0.02*TERPK + 0.02*CH2O + 0.05*TERPNT + 0.5*HO2 ; 2.3e-12 +[BPINNO3_TERPA2CO3] BPINNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + 0.5*NO2 + 0.45*TERPNS + 0.48*TERPA3 + 0.02*TERPK + 0.02*CH2O + 0.05*TERPNT + 0.5*HO2 ; 2e-12, 500 +[BPINNO3_TERPA3CO3] BPINNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + 0.5*NO2 + 0.45*TERPNS + 0.48*TERPA3 + 0.02*TERPK + 0.02*CH2O + 0.05*TERPNT + 0.5*HO2 ; 2e-12, 500 +[BPINNO3_TERPACO3] BPINNO3 + TERPACO3 -> TERPA1O2 + CO2 + 0.5*NO2 + 0.45*TERPNS + 0.48*TERPA3 + 0.02*TERPK + 0.02*CH2O + 0.05*TERPNT + 0.5*HO2 ; 2e-12, 500 +[BPINO2_CH3CO3] BPINO2 + CH3CO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 + 0.11*CH3COCH3 + 0.65*CH2O + HO2 + CH3O2 + CO2 ; 2e-12, 500 +[BPINO2_CH3O2] BPINO2 + CH3O2 -> 1.4*CH2O + 0.37*TERPF1 + 0.32*TERPK + 1.5*HO2 + 0.08*CH3COCH3 + 0.31*TERPA3 ; 2e-12 +[BPINO2_HO2] BPINO2 + HO2 -> 0.68*TERP1OOH + 0.03*OH + 0.03*TERPK + 0.03*CH2O + 0.03*HO2 + 0.29*TERPOOH ; 2.6e-13, 1300 +[BPINO2_NO] BPINO2 + NO -> 0.08*CH3COCH3 + 0.49*CH2O + 0.2*TERPF1 + 0.24*TERPK + 0.04*TERPNS1 + 0.02*TERPNS + 0.06*TERPNT + 0.13*TERPNT1 + 0.31*TERPA3 + 0.75*HO2 + 0.75*NO2 ; 2.7e-12, 360 +[BPINO2_NO3] BPINO2 + NO3 -> 0.11*CH3COCH3 + 0.65*CH2O + 0.27*TERPF1 + 0.32*TERPK + 0.41*TERPA3 + HO2 + NO2 ; 2.3e-12 +[BPINO2_TERPA2CO3] BPINO2 + TERPA2CO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 + 0.11*CH3COCH3 + 0.65*CH2O + HO2 + TERPA2O2 + CO2 ; 2e-12, 500 +[BPINO2_TERPA3CO3] BPINO2 + TERPA3CO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 + 0.11*CH3COCH3 + 0.65*CH2O + HO2 + TERPA4O2 + CO2 ; 2e-12, 500 +[BPINO2_TERPACO3] BPINO2 + TERPACO3 -> 0.32*TERPK + 0.27*TERPF1 + 0.41*TERPA3 + 0.11*CH3COCH3 + 0.65*CH2O + HO2 + TERPA1O2 + CO2 ; 2e-12, 500 +[BPIN_O3] BPIN + O3 -> 0.51*TERPK + 0.3*OH + 0.3*TERPA2CO3 + 0.32*H2O2 + 0.19*BIGALK + 0.19*CO2 + 0.81*CH2O + 0.11*HMHP + 0.08*HCOOH ; 1.35e-15, -1270 +[BPIN_OH] BPIN + OH -> BPINO2 ; 1.62e-11, 460 +[LIMON_NO3] LIMON + NO3 -> LIMONNO3 ; 1.2e-11 +[LIMONNO3_CH3CO3] LIMONNO3 + CH3CO3 -> CH3O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 + 0.19*TERPNT1 + 0.35*TERPNS1 + 0.54*HO2 ; 2e-12, 500 +[LIMONNO3_CH3O2] LIMONNO3 + CH3O2 -> 0.27*TERPNT1 + 0.91*CH2O + 0.09*CH3OH + 1.01*HO2 + 0.31*TERPF1 + 0.31*NO2 + 0.42*TERPNS1 ; 2e-12 +[LIMONNO3_HO2] LIMONNO3 + HO2 -> 0.18*TERPNPT1 + 0.32*TERPNPS1 + 0.5*OH + 0.23*TERPF1 + 0.23*NO2 + 0.18*TERPNS1 + 0.09*TERPNT1 + 0.27*HO2 ; 2.71e-13, 1300 +[LIMONNO3_LIMONNO3] LIMONNO3 + LIMONNO3 -> 0.42*TERPNT1 + 0.99*HO2 + 0.86*TERPF1 + 0.86*NO2 + 0.72*TERPNS1 ; 5.3e-13 +[LIMONNO3_NO] LIMONNO3 + NO -> 0.07*TERPFDN + 1.36*NO2 + 0.43*TERPF1 + 0.17*TERPNT1 + 0.33*TERPNS1 + 0.5*HO2 ; 2.7e-12, 360 +[LIMONNO3_NO3] LIMONNO3 + NO3 -> 1.46*NO2 + 0.46*TERPF1 + 0.19*TERPNT1 + 0.35*TERPNS1 + 0.54*HO2 ; 2.3e-12 +[LIMONNO3_TERPA2CO3] LIMONNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 + 0.19*TERPNT1 + 0.35*TERPNS1 + 0.54*HO2 ; 2e-12, 500 +[LIMONNO3_TERPA3CO3] LIMONNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 + 0.19*TERPNT1 + 0.35*TERPNS1 + 0.54*HO2 ; 2e-12, 500 +[LIMONNO3_TERPACO3] LIMONNO3 + TERPACO3 -> TERPA1O2 + CO2 + 0.46*NO2 + 0.46*TERPF1 + 0.19*TERPNT1 + 0.35*TERPNS1 + 0.54*HO2 ; 2e-12, 500 +[LIMONO2_CH3CO3] LIMONO2 + CH3CO3 -> TERPF1 + 0.56*CH2O + HO2 + CH3O2 + CO2 ; 2e-12, 500 +[LIMONO2_CH3O2] LIMONO2 + CH3O2 -> 0.25*CH3OH + TERPF1 + 1.03*CH2O + HO2 ; 2e-12 +[LIMONO2_HO2] LIMONO2 + HO2 -> 0.9*TERP1OOH + 0.1*TERPF1 + 0.1*OH + 0.1*HO2 + 0.06*CH2O ; 2.6e-13, 1300 +[LIMONO2_NO] LIMONO2 + NO -> 0.17*TERPNT1 + 0.06*TERPNS1 + 0.77*NO2 + 0.77*TERPF1 + 0.77*HO2 + 0.43*CH2O ; 2.7e-12, 360 +[LIMONO2_NO3] LIMONO2 + NO3 -> NO2 + TERPF1 + HO2 + 0.56*CH2O ; 2.3e-12 +[LIMONO2_TERPA2CO3] LIMONO2 + TERPA2CO3 -> TERPF1 + 0.56*CH2O + HO2 + TERPA2O2 + CO2 ; 2e-12, 500 +[LIMONO2_TERPA3CO3] LIMONO2 + TERPA3CO3 -> TERPF1 + 0.56*CH2O + HO2 + TERPA4O2 + CO2 ; 2e-12, 500 +[LIMONO2_TERPACO3] LIMONO2 + TERPACO3 -> TERPF1 + 0.56*CH2O + HO2 + TERPA1O2 + CO2 ; 2e-12, 500 +[LIMON_O3] LIMON + O3 -> 0.66*OH + 0.66*TERPF1 + 0.33*CH3CO3 + 0.33*CH2O + 0.33*TERPA3CO3 + 0.33*H2O2 + 0.01*TERPACID ; 2.8e-15, -770 +[LIMON_OH] LIMON + OH -> LIMONO2 ; 3.41e-11, 470 +[MYRC_NO3] MYRC + NO3 -> MYRCNO3 ; 1.1e-11 +[MYRCNO3_CH3CO3] MYRCNO3 + CH3CO3 -> CH3O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 + 0.04*CH2O + 0.05*TERPNS1 + 0.05*HO2 + 0.91*CH3COCH3 ; 2e-12, 500 +[MYRCNO3_CH3O2] MYRCNO3 + CH3O2 -> 0.14*TERPNS1 + 0.98*CH2O + 0.77*TERPF2 + 0.77*NO2 + 0.87*HO2 + 0.74*CH3COCH3 + 0.09*TERPNT1 + 0.05*CH3OH ; 2e-12 +[MYRCNO3_HO2] MYRCNO3 + HO2 -> 0.48*OH + 0.48*TERPF2 + 0.02*CH2O + 0.48*NO2 + 0.46*CH3COCH3 + 0.36*TERPNPS1 + 0.16*TERPNPT1 ; 2.71e-13, 1300 +[MYRCNO3_MYRCNO3] MYRCNO3 + MYRCNO3 -> 0.19*TERPNS1 + 0.27*TERPNT1 + 1.54*NO2 + 1.54*TERPF2 + 1.48*CH3COCH3 + 0.06*CH2O ; 5.3e-13 +[MYRCNO3_NO] MYRCNO3 + NO -> 0.07*TERPFDN + 1.82*NO2 + 0.89*TERPF2 + 0.04*CH2O + 0.04*TERPNS1 + 0.04*HO2 + 0.85*CH3COCH3 ; 2.7e-12, 360 +[MYRCNO3_NO3] MYRCNO3 + NO3 -> 1.95*NO2 + 0.95*TERPF2 + 0.04*CH2O + 0.05*TERPNS1 + 0.05*HO2 + 0.91*CH3COCH3 ; 2.3e-12 +[MYRCNO3_TERPA2CO3] MYRCNO3 + TERPA2CO3 -> TERPA2O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 + 0.04*CH2O + 0.05*TERPNS1 + 0.05*HO2 + 0.91*CH3COCH3 ; 2e-12, 500 +[MYRCNO3_TERPA3CO3] MYRCNO3 + TERPA3CO3 -> TERPA4O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 + 0.04*CH2O + 0.05*TERPNS1 + 0.05*HO2 + 0.91*CH3COCH3 ; 2e-12, 500 +[MYRCNO3_TERPACO3] MYRCNO3 + TERPACO3 -> TERPA1O2 + CO2 + 0.95*NO2 + 0.95*TERPF2 + 0.04*CH2O + 0.05*TERPNS1 + 0.05*HO2 + 0.91*CH3COCH3 ; 2e-12, 500 +[MYRCO2_CH3CO3] MYRCO2 + CH3CO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O + CH3O2 + CO2 ; 2e-12, 500 +[MYRCO2_CH3O2] MYRCO2 + CH3O2 -> 0.25*CH3OH + TERPF2 + 0.75*CH2O + HO2 ; 2e-12 +[MYRCO2_HO2] MYRCO2 + HO2 -> 0.9*TERP2AOOH + 0.1*TERPF2 + 0.1*OH + 0.1*HO2 + 0.05*CH3COCH3 + 0.04*CH2O ; 2.6e-13, 1300 +[MYRCO2_NO] MYRCO2 + NO -> 0.1*TERPNS1 + 0.19*TERPNT1 + 0.71*NO2 + 0.71*TERPF2 + 0.33*CH3COCH3 + 0.3*CH2O + 0.71*HO2 ; 2.7e-12, 360 +[MYRCO2_NO3] MYRCO2 + NO3 -> NO2 + TERPF2 + 0.46*CH3COCH3 + 0.42*CH2O + HO2 ; 2.3e-12 +[MYRCO2_TERPA2CO3] MYRCO2 + TERPA2CO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O + TERPA2O2 + CO2 ; 2e-12, 500 +[MYRCO2_TERPA3CO3] MYRCO2 + TERPA3CO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O + TERPA4O2 + CO2 ; 2e-12, 500 +[MYRCO2_TERPACO3] MYRCO2 + TERPACO3 -> TERPF2 + HO2 + 0.46*CH3COCH3 + 0.42*CH2O + TERPA1O2 + CO2 ; 2e-12, 500 +[MYRC_O3] MYRC + O3 -> TERPF2 + 0.63*OH + 0.63*HO2 + 0.25*CH3COCH3 + 0.39*CH2O + 0.18*HYAC ; 2.65e-15, -520 +[MYRC_OH] MYRC + OH -> MYRCO2 ; 2.1e-10 +[tag_TERPA2CO3_NO2] TERPA2CO3 + NO2 + M -> TERPA2PAN + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[tag_TERPA3CO3_NO2] TERPA3CO3 + NO2 + M -> TERPA3PAN + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[tag_TERPACO3_NO2] TERPACO3 + NO2 + M -> TERPAPAN + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[TERP1OOHO2_HO2] TERP1OOHO2 + HO2 -> 0.82*TERPDHDP + 0.18*TERPOOHL + 0.18*OH + 0.18*HO2 + 0.08*CH2O ; 2.71e-13, 1300 +[TERP1OOHO2_NO] TERP1OOHO2 + NO -> 0.3*TERPHFN + 0.7*NO2 + 0.7*TERPOOHL + 0.31*CH2O + 0.7*HO2 ; 2.7e-12, 360 +[TERP1OOH_OH] TERP1OOH + OH -> TERP1OOHO2 ; 8.9e-11 +[TERP2AOOH_OH] TERP2AOOH + OH -> TERP2OOHO2 ; 8.9e-11 +[TERP2OOHO2_HO2] TERP2OOHO2 + HO2 -> 0.82*TERPDHDP + 0.18*TERP1OOH + 0.18*OH + 0.18*HO2 ; 2.71e-13, 1300 +[TERP2OOHO2_NO] TERP2OOHO2 + NO -> 0.3*TERPHFN + 0.7*NO2 + 0.7*TERP1OOH + 0.7*HO2 ; 2.7e-12, 360 +[TERPA1O2_CH3CO3] TERPA1O2 + CH3CO3 -> TERPA2O2 + CH3O2 + CO2 ; 2e-12, 500 +[TERPA1O2_CH3O2] TERPA1O2 + CH3O2 -> 0.25*CH3OH + 0.75*CH2O + 0.5*HO2 + 0.5*TERPA2 + 0.5*TERPA2O2 ; 2e-12 +[TERPA1O2_HO2] TERPA1O2 + HO2 -> TERPOOH ; 2.54e-13, 1300 +[TERPA1O2_NO] TERPA1O2 + NO -> 0.3*TERPNS + 0.7*NO2 + 0.7*TERPA2O2 ; 2.7e-12, 360 +[TERPA1O2_NO3] TERPA1O2 + NO3 -> NO2 + TERPA2O2 ; 2.3e-12 +[TERPA1O2_TERPA2CO3] TERPA1O2 + TERPA2CO3 -> 2*TERPA2O2 + CO2 ; 2e-12, 500 +[TERPA1O2_TERPA3CO3] TERPA1O2 + TERPA3CO3 -> TERPA2O2 + TERPA4O2 + CO2 ; 2e-12, 500 +[TERPA1O2_TERPACO3] TERPA1O2 + TERPACO3 -> TERPA2O2 + TERPA1O2 + CO2 ; 2e-12, 500 +[TERPA2CO3_CH3CO3] TERPA2CO3 + CH3CO3 -> 2*CO2 + TERPA2O2 + CH3O2 ; 2.9e-12, 500 +[TERPA2CO3_CH3O2] TERPA2CO3 + CH3O2 -> CO2 + TERPA2O2 + CH2O + HO2 ; 2e-12, 500 +[TERPA2CO3_HO2] TERPA2CO3 + HO2 -> 0.15*O3 + 0.51*TERPACID2 + 0.49*OH + 0.49*CO2 + 0.49*TERPA2O2 ; 4.3e-13, 1040 +[TERPA2CO3_NO] TERPA2CO3 + NO -> NO2 + CO2 + TERPA2O2 ; 8.1e-12, 270 +[TERPA2CO3_NO3] TERPA2CO3 + NO3 -> NO2 + CO2 + TERPA2O2 ; 4e-12 +[TERPA2CO3_TERPA2CO3] TERPA2CO3 + TERPA2CO3 -> 2*CO2 + 2*TERPA2O2 ; 2.9e-12, 500 +[TERPA2CO3_TERPACO3] TERPA2CO3 + TERPACO3 -> 2*CO2 + TERPA2O2 + TERPA1O2 ; 2.9e-12, 500 +[TERPA2_NO3] TERPA2 + NO3 -> HNO3 + TERPA2CO3 ; 2e-14 +[TERPA2O2_CH3CO3] TERPA2O2 + CH3CO3 -> TERPA3O2 + CH3O2 + CO2 ; 2e-12, 500 +[TERPA2O2_CH3O2] TERPA2O2 + CH3O2 -> TERPA3O2 + CH2O + HO2 ; 2e-12 +[TERPA2O2_HO2] TERPA2O2 + HO2 -> 0.62*TERPOOH + 0.38*TERPA3O2 + 0.38*OH ; 2.62e-13, 1300 +[TERPA2O2_NO] TERPA2O2 + NO -> 0.17*TERPNT + 0.83*NO2 + 0.83*TERPA3O2 ; 2.7e-12, 360 +[TERPA2O2_NO3] TERPA2O2 + NO3 -> NO2 + TERPA3O2 ; 2.3e-12 +[TERPA2O2_TERPA2CO3] TERPA2O2 + TERPA2CO3 -> TERPA3O2 + TERPA2O2 + CO2 ; 2e-12, 500 +[TERPA2O2_TERPA3CO3] TERPA2O2 + TERPA3CO3 -> TERPA3O2 + TERPA4O2 + CO2 ; 2e-12, 500 +[TERPA2O2_TERPACO3] TERPA2O2 + TERPACO3 -> TERPA3O2 + TERPA1O2 + CO2 ; 2e-12, 500 +[TERPA2_OH] TERPA2 + OH -> TERPA2CO3 ; 5.2e-12, 600 +[TERPA2PAN_OH] TERPA2PAN + OH -> CH3COCH3 + 2*CO2 + 2*CH2O + NO2 + 2*CO + HO2 ; 2.52e-11 +[TERPA3CO3_CH3CO3] TERPA3CO3 + CH3CO3 -> 2*CO2 + TERPA4O2 + CH3O2 ; 2.9e-12, 500 +[TERPA3CO3_CH3O2] TERPA3CO3 + CH3O2 -> CO2 + TERPA4O2 + CH2O + HO2 ; 2e-12, 500 +[TERPA3CO3_HO2] TERPA3CO3 + HO2 -> 0.15*O3 + 0.51*TERPACID3 + 0.49*OH + 0.49*CO2 + 0.49*TERPA4O2 ; 4.3e-13, 1040 +[TERPA3CO3_NO] TERPA3CO3 + NO -> NO2 + CO2 + TERPA4O2 ; 8.1e-12, 270 +[TERPA3CO3_NO3] TERPA3CO3 + NO3 -> NO2 + CO2 + TERPA4O2 ; 4e-12 +[TERPA3CO3_TERPA2CO3] TERPA3CO3 + TERPA2CO3 -> 2*CO2 + TERPA4O2 + TERPA2O2 ; 2.9e-12, 500 +[TERPA3CO3_TERPA3CO3] TERPA3CO3 + TERPA3CO3 -> 2*CO2 + 2*TERPA4O2 ; 2.9e-12, 500 +[TERPA3CO3_TERPACO3] TERPA3CO3 + TERPACO3 -> 2*CO2 + TERPA4O2 + TERPA1O2 ; 2.9e-12, 500 +[TERPA3_NO3] TERPA3 + NO3 -> HNO3 + TERPA3CO3 ; 2e-14 +[TERPA3O2_CH3CO3] TERPA3O2 + CH3CO3 -> TERPA4O2 + CH3COCH3 + CH3O2 + CO2 ; 2e-12, 500 +[TERPA3O2_CH3O2] TERPA3O2 + CH3O2 -> TERPA4O2 + CH3COCH3 + CH2O + HO2 ; 2e-12 +[TERPA3O2_HO2] TERPA3O2 + HO2 -> 0.85*TERPOOHL + 0.15*TERPA4O2 + 0.15*OH + 0.15*CH3COCH3 ; 2.66e-13, 1300 +[TERPA3O2_NO] TERPA3O2 + NO -> 0.3*TERPNT + 0.7*NO2 + 0.7*TERPA4O2 + 0.7*CH3COCH3 ; 2.7e-12, 360 +[TERPA3O2_NO3] TERPA3O2 + NO3 -> NO2 + TERPA4O2 + CH3COCH3 ; 2.3e-12 +[TERPA3O2_TERPA2CO3] TERPA3O2 + TERPA2CO3 -> TERPA4O2 + CH3COCH3 + TERPA2O2 + CO2 ; 2e-12, 500 +[TERPA3O2_TERPA3CO3] TERPA3O2 + TERPA3CO3 -> 2*TERPA4O2 + CH3COCH3 + CO2 ; 2e-12, 500 +[TERPA3O2_TERPACO3] TERPA3O2 + TERPACO3 -> TERPA4O2 + CH3COCH3 + TERPA1O2 + CO2 ; 2e-12, 500 +[TERPA3_OH] TERPA3 + OH -> 0.75*TERPA3CO3 + 0.25*TERPA4O2 ; 5.2e-12, 600 +[TERPA3PAN_OH] TERPA3PAN + OH -> CO + NO2 + 3*CO2 + 2*CH3CO3 + CH2O + HO2 ; 1.92e-11 +[TERPA4O2_CH3CO3] TERPA4O2 + CH3CO3 -> CH3CO3 + HO2 + 2*CH2O + CO + CH3O2 + CO2 ; 2e-12, 500 +[TERPA4O2_CH3O2] TERPA4O2 + CH3O2 -> CH3CO3 + 2*HO2 + 3*CH2O + CO ; 2e-12 +[TERPA4O2_HO2] TERPA4O2 + HO2 -> 0.47*TERPOOHL + 0.53*CH3CO3 + 0.53*HO2 + 1.06*CH2O + 0.53*CO + 0.53*OH ; 2.51e-13, 1300 +[TERPA4O2_NO] TERPA4O2 + NO -> 0.09*TERPNS + 0.91*NO2 + 0.91*CH3CO3 + 0.91*HO2 + 1.82*CH2O + 0.91*CO ; 2.7e-12, 360 +[TERPA4O2_NO3] TERPA4O2 + NO3 -> NO2 + CH3CO3 + HO2 + 2*CH2O + CO ; 2.3e-12 +[TERPA4O2_TERPA2CO3] TERPA4O2 + TERPA2CO3 -> CH3CO3 + HO2 + 2*CH2O + CO + TERPA2O2 + CO2 ; 2e-12, 500 +[TERPA4O2_TERPA3CO3] TERPA4O2 + TERPA3CO3 -> CH3CO3 + HO2 + 2*CH2O + CO + TERPA4O2 + CO2 ; 2e-12, 500 +[TERPA4O2_TERPACO3] TERPA4O2 + TERPACO3 -> CH3CO3 + HO2 + 2*CH2O + CO + TERPA1O2 + CO2 ; 2e-12, 500 +[TERPACID2_OH] TERPACID2 + OH -> 0.71*TERPA2CO3 + 0.29*CO2 + 0.29*TERPA2O2 ; 8.8e-12 +[TERPACID3_OH] TERPACID3 + OH -> 0.71*TERPA3CO3 + 0.29*CO2 + 0.29*TERPA4O2 ; 8.8e-12 +[TERPACID_OH] TERPACID + OH -> 0.71*TERPACO3 + 0.29*CO2 + 0.29*TERPA1O2 ; 8.8e-12 +[TERPACO3_CH3CO3] TERPACO3 + CH3CO3 -> 2*CO2 + TERPA1O2 + CH3O2 ; 2.9e-12, 500 +[TERPACO3_CH3O2] TERPACO3 + CH3O2 -> CO2 + TERPA1O2 + CH2O + HO2 ; 2e-12, 500 +[TERPACO3_HO2] TERPACO3 + HO2 -> 0.15*O3 + 0.51*TERPACID + 0.49*OH + 0.49*CO2 + 0.49*TERPA1O2 ; 4.3e-13, 1040 +[TERPACO3_NO] TERPACO3 + NO -> NO2 + CO2 + TERPA1O2 ; 8.1e-12, 270 +[TERPACO3_NO3] TERPACO3 + NO3 -> NO2 + CO2 + TERPA1O2 ; 4e-12 +[TERPACO3_TERPACO3] TERPACO3 + TERPACO3 -> 2*CO2 + 2*TERPA1O2 ; 2.9e-12, 500 +[TERPA_NO3] TERPA + NO3 -> HNO3 + TERPACO3 ; 2e-14 +[TERPA_OH] TERPA + OH -> 0.77*TERPACO3 + 0.23*TERPA2O2 ; 5.2e-12, 600 +[TERPAPAN_OH] TERPAPAN + OH -> TERPA2 + NO2 + CO ; 3.66e-12 +[TERPDHDP_OH] TERPDHDP + OH -> TERPOOH + OH ; 2.8e-11 +[TERPF1_NO3] TERPF1 + NO3 -> NO2 + 0.44*CH2O + TERPA3 ; 2.6e-13 +[TERPF1O2_HO2] TERPF1O2 + HO2 -> 0.9*TERPOOHL + 0.1*OH + 0.1*HO2 + 0.1*TERPA3 + 0.04*CH2O ; 2.68e-13, 1300 +[TERPF1O2_NO] TERPF1O2 + NO -> 0.3*TERPHFN + 0.7*NO2 + 0.7*HO2 + 0.7*TERPA3 + 0.31*CH2O ; 2.7e-12, 360 +[TERPF1_O3] TERPF1 + O3 -> 0.09*OH + TERPA3 + 0.62*CH2O + 0.23*HMHP + 0.02*H2O2 + 0.15*HCOOH ; 8.3e-18 +[TERPF1_OH] TERPF1 + OH -> 0.83*TERPF1O2 + 0.17*TERPA3CO3 ; 1.1e-10 +[TERPF2_NO3] TERPF2 + NO3 -> 0.5*TERPNS1 + 0.5*HO2 + 0.5*TERPF1 + 0.5*CH2O + 0.5*NO2 ; 2.95e-12, -450 +[TERPF2O2_HO2] TERPF2O2 + HO2 -> 0.9*TERP1OOH + 0.1*OH + 0.1*HO2 + 0.1*TERPF1 ; 2.47e-13, 1300 +[TERPF2O2_NO] TERPF2O2 + NO -> 0.18*TERPNT1 + 0.12*TERPNS1 + 0.7*NO2 + 0.7*HO2 + 0.7*TERPF1 ; 2.7e-12, 360 +[TERPF2_O3] TERPF2 + O3 -> TERPF1 + 0.34*CH2O + 0.4*HMHP + 0.04*H2O2 + 0.26*HCOOH ; 1.1e-16 +[TERPF2_OH] TERPF2 + OH -> TERPF2O2 ; 2.7e-11, 390 +[TERPFDN_OH] TERPFDN + OH -> NO2 + TERPNS ; 3.64e-12 +[TERPHFN_OH] TERPHFN + OH -> TERPNS + OH ; 2.8e-11 +[TERPK_OH] TERPK + OH -> 0.14*TERPA2CO3 + 0.86*TERPA1O2 ; 1.7e-11 +[TERPNPS1O2_HO2] TERPNPS1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNPS + 0.1*HO2 ; 2.76e-13, 1300 +[TERPNPS1O2_NO] TERPNPS1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNPS + 0.7*HO2 ; 2.7e-12, 360 +[TERPNPS1_OH] TERPNPS1 + OH -> TERPNPS1O2 ; 1.1e-10 +[TERPNPS_OH] TERPNPS + OH -> H2O + BPINNO3 ; 9.58e-12 +[TERPNPT1O2_HO2] TERPNPT1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNPT + 0.1*HO2 ; 2.76e-13, 1300 +[TERPNPT1O2_NO] TERPNPT1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNPT + 0.7*HO2 ; 2.7e-12, 360 +[TERPNPT1_OH] TERPNPT1 + OH -> TERPNPT1O2 ; 1.1e-10 +[TERPNPT_OH] TERPNPT + OH -> TERPNT + H2O + OH ; 1.23e-11 +[TERPNS1O2_HO2] TERPNS1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNS + 0.1*HO2 ; 2.75e-13, 1300 +[TERPNS1O2_NO] TERPNS1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNS + 0.7*HO2 ; 2.7e-12, 360 +[TERPNS1_OH] TERPNS1 + OH -> TERPNS1O2 ; 1.1e-10 +[TERPNS_OH] TERPNS + OH -> TERPA + NO2 ; 3.64e-12 +[TERPNT1O2_HO2] TERPNT1O2 + HO2 -> 0.9*TERPHFN + 0.1*OH + 0.1*TERPNT + 0.1*HO2 ; 2.75e-13, 1300 +[TERPNT1O2_NO] TERPNT1O2 + NO -> 0.3*TERPFDN + 0.7*NO2 + 0.7*TERPNT + 0.7*HO2 ; 2.7e-12, 360 +[TERPNT1_OH] TERPNT1 + OH -> TERPNT1O2 ; 1.1e-10 +[TERPNT_OH] TERPNT + OH -> TERPA + NO2 ; 5.5e-12 +[TERPOOHL_OH] TERPOOHL + OH -> TERPA3 + OH ; 4.65e-11 +[TERPOOH_OH] TERPOOH + OH -> TERPA + OH ; 2.8e-11 +[usr_TERPA2PAN_M] TERPA2PAN + M -> M + TERPA2CO3 + NO2 +[usr_TERPA3PAN_M] TERPA3PAN + M -> TERPA3CO3 + NO2 + M +[usr_TERPAPAN_M] TERPAPAN + M -> TERPACO3 + NO2 + M +********************************* +*** 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_GLYOXAL_aer] GLYOXAL -> SOAG0 +[usr_HO2_aer] HO2 -> H2O +[usr_HONITR_aer] HONITR -> HNO3 +[usr_ICHE_aer] ICHE -> +[usr_IEPOX_aer] IEPOX -> +[usr_INHEB_aer] INHEB -> HNO3 +[usr_INHED_aer] INHED -> HNO3 +[usr_INOOHD_aer] ISOPNOOHD -> HNO3 +[usr_ISOPFDN_aer] ISOPFDN -> HNO3 +[usr_ISOPFDNC_aer] ISOPFDNC -> HNO3 +[usr_ISOPFNC_aer] ISOPFNC -> +[usr_ISOPFNP_aer] ISOPFNP -> +[usr_ISOPHFP_aer] ISOPHFP -> +[usr_ISOPN1D_aer] ISOPN1D -> HNO3 +[usr_ISOPN2B_aer] ISOPN2B -> HNO3 +[usr_ISOPN4D_aer] ISOPN4D -> HNO3 +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NC4CHO_aer] NC4CHO -> 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 +[usr_SQTN_aer] SQTN -> +[usr_TERPDHDP_aer] TERPDHDP -> +[usr_TERPFDN_aer] TERPFDN -> HNO3 +[usr_TERPHFN_aer] TERPHFN -> +[usr_TERPNPT1_aer] TERPNPT1 -> HNO3 +[usr_TERPNPT_aer] TERPNPT -> HNO3 +[usr_TERPNT1_aer] TERPNT1 -> HNO3 +[usr_TERPNT_aer] TERPNT -> HNO3 +********************************* +*** SOA +********************************* +[APIN_NO3_vbs] APIN + NO3 -> APIN + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.2e-12, 490 +[APINO2_HO2_vbs] APINO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 2.6e-13, 1300 +[APINO2_NO_vbs] APINO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 + 0.0332*SOAG3 + 0.13*SOAG4 ; 2.7e-12, 360 +[APIN_O3_vbs] APIN + O3 -> APIN + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 8.05e-16, -640 +[APIN_OH_vbs] APIN + OH -> APIN + OH + APINO2VBS ; 1.34e-11, 410 +[BCARY_NO3_vbs] BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.9e-11 +[BCARYO2_HO2_vbs] BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 2.75e-13, 1300 +[BCARYO2_NO_vbs] BCARYO2VBS + NO -> NO + 0.1279*SOAG0 + 0.1792*SOAG1 + 0.0676*SOAG2 + 0.079*SOAG3 + 0.1254*SOAG4 ; 2.7e-12, 360 +[BCARY_O3_vbs] BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 1.2e-14 +[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + BCARYO2VBS ; 2e-10 +[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + BENZO2VBS ; 2.3e-12, -193 +[BENZO2_HO2_vbs] BENZO2VBS + HO2 -> HO2 + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 + 0.0443*SOAG3 + 0.1621*SOAG4 ; 7.5e-13, 700 +[BENZO2_NO_vbs] BENZO2VBS + NO -> NO + 0.0097*SOAG0 + 0.0034*SOAG1 + 0.1579*SOAG2 + 0.0059*SOAG3 + 0.0536*SOAG4 ; 2.6e-12, 365 +[BPIN_NO3_vbs] BPIN + NO3 -> BPIN + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 2.5e-12 +[BPINO2_HO2_vbs] BPINO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 2.6e-13, 1300 +[BPINO2_NO_vbs] BPINO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 + 0.0332*SOAG3 + 0.13*SOAG4 ; 2.7e-12, 360 +[BPIN_O3_vbs] BPIN + O3 -> BPIN + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 1.35e-15, -1270 +[BPIN_OH_vbs] BPIN + OH -> BPIN + OH + BPINO2VBS ; 1.62e-11, 460 +[ISOP_NO3_vbs] ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 ; 2.95e-12, -450 +[ISOPO2_HO2_vbs] ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 + 0.0271*SOAG3 + 0.0474*SOAG4 ; 2.12e-13, 1300 +[ISOPO2_NO_vbs] ISOPO2VBS + NO -> NO + 0.0003*SOAG0 + 0.0003*SOAG1 + 0.0073*SOAG2 + 0.0057*SOAG3 + 0.0623*SOAG4 ; 2.7e-12, 360 +[ISOP_O3_vbs] ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 ; 1.03e-14, -1995 +[ISOP_OH_vbs] ISOP + OH -> ISOP + OH + ISOPO2VBS ; 2.7e-11, 390 +[IVOCO2_HO2_vbs] IVOCO2VBS + HO2 -> HO2 + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 + 0.0076*SOAG3 + 0.0113*SOAG4 ; 7.5e-13, 700 +[IVOCO2_NO_vbs] IVOCO2VBS + NO -> NO + 0.1056*SOAG0 + 0.1026*SOAG1 + 0.0521*SOAG2 + 0.0143*SOAG3 + 0.0166*SOAG4 ; 2.6e-12, 365 +[IVOC_OH_vbs] IVOC + OH -> OH + IVOCO2VBS ; 1.34e-11 +[LIMON_NO3_vbs] LIMON + NO3 -> LIMON + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.2e-11 +[LIMONO2_HO2_vbs] LIMONO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 2.6e-13, 1300 +[LIMONO2_NO_vbs] LIMONO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 + 0.0332*SOAG3 + 0.13*SOAG4 ; 2.7e-12, 360 +[LIMON_O3_vbs] LIMON + O3 -> LIMON + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 2.8e-15, -770 +[LIMON_OH_vbs] LIMON + OH -> LIMON + OH + LIMONO2VBS ; 3.41e-11, 470 +[MYRC_NO3_vbs] MYRC + NO3 -> MYRC + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.1e-11 +[MYRCO2_HO2_vbs] MYRCO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 2.6e-13, 1300 +[MYRCO2_NO_vbs] MYRCO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 + 0.0332*SOAG3 + 0.13*SOAG4 ; 2.7e-12, 360 +[MYRC_O3_vbs] MYRC + O3 -> MYRC + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 2.65e-15, -520 +[MYRC_OH_vbs] MYRC + OH -> MYRC + OH + MYRCO2VBS ; 2.1e-10 +[SVOC_OH] SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 + 0.0085*SOAG3 + 0.0128*SOAG4 ; 1.34e-11 +[TOLUENE_OH_vbs] TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS ; 1.7e-12, 352 +[TOLUO2_HO2_vbs] TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 + 0.2157*SOAG3 + 0.0738*SOAG4 ; 7.5e-13, 700 +[TOLUO2_NO_vbs] TOLUO2VBS + NO -> NO + 0.0154*SOAG0 + 0.0452*SOAG1 + 0.0966*SOAG2 + 0.0073*SOAG3 + 0.238*SOAG4 ; 2.6e-12, 365 +[XYLENES_OH_vbs] XYLENES + OH -> XYLENES + OH + XYLEO2VBS ; 1.7e-11 +[XYLEO2_HO2_vbs] XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 + 0.0512*SOAG3 + 0.1598*SOAG4 ; 7.5e-13, 700 +[XYLEO2_NO_vbs] XYLEO2VBS + NO -> NO + 0.0063*SOAG0 + 0.0237*SOAG1 + 0.0025*SOAG2 + 0.011*SOAG3 + 0.1185*SOAG4 ; 2.6e-12, 365 +********************************* +*** 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 + num_a4 <- dataset + pom_a4 <- dataset + bc_a4 <- dataset + SVOC <- dataset + SO2 <- dataset + NO2 <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + so4_a5 <- dataset + CO <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a5 <- dataset + NO + N + OH + 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_ts2/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/chem_mods.F90 new file mode 100644 index 0000000000..f432041ea9 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/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 = 167, & ! number of photolysis reactions + rxntot = 904, & ! number of total reactions + gascnt = 737, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 319, & ! number of "gas phase" species + nfs = 3, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 4128, & ! number of non-zero matrix entries + extcnt = 16, & ! 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 = 317, & ! 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 = 904, & + enthalpy_cnt = 18, & + nslvd = 84 + 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_ts2/m_rxt_id.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/m_rxt_id.F90 new file mode 100644 index 0000000000..68e6a8b1d2 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/m_rxt_id.F90 @@ -0,0 +1,907 @@ + 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_jalknit = 19 + integer, parameter :: rid_jalkooh = 20 + integer, parameter :: rid_jbenzooh = 21 + integer, parameter :: rid_jbepomuc = 22 + integer, parameter :: rid_jbigald1 = 23 + integer, parameter :: rid_jbigald2 = 24 + integer, parameter :: rid_jbigald3 = 25 + integer, parameter :: rid_jbigald4 = 26 + integer, parameter :: rid_jbzooh = 27 + integer, parameter :: rid_jc2h5ooh = 28 + integer, parameter :: rid_jc3h7ooh = 29 + integer, parameter :: rid_jc6h5ooh = 30 + integer, parameter :: rid_jch2o_a = 31 + integer, parameter :: rid_jch2o_b = 32 + integer, parameter :: rid_jch3cho = 33 + integer, parameter :: rid_jacet = 34 + integer, parameter :: rid_jmgly = 35 + integer, parameter :: rid_jch3co3h = 36 + integer, parameter :: rid_jch3ooh = 37 + integer, parameter :: rid_jch4_a = 38 + integer, parameter :: rid_jch4_b = 39 + integer, parameter :: rid_jco2 = 40 + integer, parameter :: rid_jdhpmpal = 41 + integer, parameter :: rid_jeooh = 42 + integer, parameter :: rid_jglyald = 43 + integer, parameter :: rid_jglyoxal = 44 + integer, parameter :: rid_jhcoch2ooh = 45 + integer, parameter :: rid_jhmhp = 46 + integer, parameter :: rid_jhonitr = 47 + integer, parameter :: rid_jhpald1 = 48 + integer, parameter :: rid_jhpald4 = 49 + integer, parameter :: rid_jhpaldb1c = 50 + integer, parameter :: rid_jhpaldb4c = 51 + integer, parameter :: rid_jhyac = 52 + integer, parameter :: rid_jhydrald_b = 53 + integer, parameter :: rid_jhydrald_a = 54 + integer, parameter :: rid_jhyperacet_c = 55 + integer, parameter :: rid_jhyperacet_p = 56 + integer, parameter :: rid_jinheb = 57 + integer, parameter :: rid_jinhed = 58 + integer, parameter :: rid_jisopfdn = 59 + integer, parameter :: rid_jisopfdnc = 60 + integer, parameter :: rid_jisopfnc = 61 + integer, parameter :: rid_jisopfnp = 62 + integer, parameter :: rid_jisophfp = 63 + integer, parameter :: rid_jisopn1d = 64 + integer, parameter :: rid_jisopn2b = 65 + integer, parameter :: rid_jisopn3b = 66 + integer, parameter :: rid_jisopn4d = 67 + integer, parameter :: rid_jisopnbno3 = 68 + integer, parameter :: rid_jisopnoohb = 69 + integer, parameter :: rid_jisopnoohd = 70 + integer, parameter :: rid_jisopooh = 71 + integer, parameter :: rid_jmacr_b = 72 + integer, parameter :: rid_jmacr_a = 73 + integer, parameter :: rid_jmacrn = 74 + integer, parameter :: rid_jmacrooh = 75 + integer, parameter :: rid_jmek = 76 + integer, parameter :: rid_jmekooh = 77 + integer, parameter :: rid_jmpan = 78 + integer, parameter :: rid_jmvk = 79 + integer, parameter :: rid_jmvkn = 80 + integer, parameter :: rid_jmvkooh = 81 + integer, parameter :: rid_jnc4cho = 82 + integer, parameter :: rid_jno3ch2cho = 83 + integer, parameter :: rid_jnoa = 84 + integer, parameter :: rid_jonitr = 85 + integer, parameter :: rid_jpan = 86 + integer, parameter :: rid_jphenooh = 87 + integer, parameter :: rid_jpooh = 88 + integer, parameter :: rid_jrooh = 89 + integer, parameter :: rid_jtepomuc = 90 + integer, parameter :: rid_jterp1ooh = 91 + integer, parameter :: rid_jterp2aooh = 92 + integer, parameter :: rid_jterpa = 93 + integer, parameter :: rid_jterpa2 = 94 + integer, parameter :: rid_jterpa2pan = 95 + integer, parameter :: rid_jterpa3 = 96 + integer, parameter :: rid_jterpa3pan = 97 + integer, parameter :: rid_jterpacid = 98 + integer, parameter :: rid_jterpacid2 = 99 + integer, parameter :: rid_jterpacid3 = 100 + integer, parameter :: rid_jterpapan = 101 + integer, parameter :: rid_jterpdhdp = 102 + integer, parameter :: rid_jterpfdn = 103 + integer, parameter :: rid_jterphfn = 104 + integer, parameter :: rid_jterpnps = 105 + integer, parameter :: rid_jterpnps1 = 106 + integer, parameter :: rid_jterpnpt = 107 + integer, parameter :: rid_jterpnpt1 = 108 + integer, parameter :: rid_jterpns = 109 + integer, parameter :: rid_jterpns1 = 110 + integer, parameter :: rid_jterpnt = 111 + integer, parameter :: rid_jterpnt1 = 112 + integer, parameter :: rid_jterpooh = 113 + integer, parameter :: rid_jterpoohl = 114 + integer, parameter :: rid_jtolooh = 115 + integer, parameter :: rid_jxylenooh = 116 + integer, parameter :: rid_jxylolooh = 117 + integer, parameter :: rid_jbrcl = 118 + integer, parameter :: rid_jbro = 119 + integer, parameter :: rid_jbrono2_b = 120 + integer, parameter :: rid_jbrono2_a = 121 + integer, parameter :: rid_jccl4 = 122 + integer, parameter :: rid_jcf2clbr = 123 + integer, parameter :: rid_jcf3br = 124 + integer, parameter :: rid_jcfcl3 = 125 + integer, parameter :: rid_jcfc113 = 126 + integer, parameter :: rid_jcfc114 = 127 + integer, parameter :: rid_jcfc115 = 128 + integer, parameter :: rid_jcf2cl2 = 129 + integer, parameter :: rid_jch2br2 = 130 + integer, parameter :: rid_jch3br = 131 + integer, parameter :: rid_jch3ccl3 = 132 + integer, parameter :: rid_jch3cl = 133 + integer, parameter :: rid_jchbr3 = 134 + integer, parameter :: rid_jcl2 = 135 + integer, parameter :: rid_jcl2o2 = 136 + integer, parameter :: rid_jclo = 137 + integer, parameter :: rid_jclono2_a = 138 + integer, parameter :: rid_jclono2_b = 139 + integer, parameter :: rid_jcof2 = 140 + integer, parameter :: rid_jcofcl = 141 + integer, parameter :: rid_jh2402 = 142 + integer, parameter :: rid_jhbr = 143 + integer, parameter :: rid_jhcfc141b = 144 + integer, parameter :: rid_jhcfc142b = 145 + integer, parameter :: rid_jhcfc22 = 146 + integer, parameter :: rid_jhcl = 147 + integer, parameter :: rid_jhf = 148 + integer, parameter :: rid_jhobr = 149 + integer, parameter :: rid_jhocl = 150 + integer, parameter :: rid_joclo = 151 + integer, parameter :: rid_jsf6 = 152 + integer, parameter :: rid_jh2so4 = 153 + integer, parameter :: rid_jocs = 154 + integer, parameter :: rid_jso = 155 + integer, parameter :: rid_jso2 = 156 + integer, parameter :: rid_jso3 = 157 + integer, parameter :: rid_jsoa1_a1 = 158 + integer, parameter :: rid_jsoa1_a2 = 159 + integer, parameter :: rid_jsoa2_a1 = 160 + integer, parameter :: rid_jsoa2_a2 = 161 + integer, parameter :: rid_jsoa3_a1 = 162 + integer, parameter :: rid_jsoa3_a2 = 163 + integer, parameter :: rid_jsoa4_a1 = 164 + integer, parameter :: rid_jsoa4_a2 = 165 + integer, parameter :: rid_jsoa5_a1 = 166 + integer, parameter :: rid_jsoa5_a2 = 167 + integer, parameter :: rid_O1D_H2 = 168 + integer, parameter :: rid_O1D_H2O = 169 + integer, parameter :: rid_O1D_N2 = 170 + integer, parameter :: rid_O1D_O2ab = 171 + integer, parameter :: rid_O1D_O3 = 172 + integer, parameter :: rid_O_O3 = 173 + integer, parameter :: rid_usr_O_O = 174 + integer, parameter :: rid_usr_O_O2 = 175 + integer, parameter :: rid_H2_O = 176 + integer, parameter :: rid_H2O2_O = 177 + integer, parameter :: rid_H_HO2 = 178 + integer, parameter :: rid_H_HO2a = 179 + integer, parameter :: rid_H_HO2b = 180 + integer, parameter :: rid_H_O2 = 181 + integer, parameter :: rid_HO2_O = 182 + integer, parameter :: rid_HO2_O3 = 183 + integer, parameter :: rid_H_O3 = 184 + integer, parameter :: rid_OH_H2 = 185 + integer, parameter :: rid_OH_H2O2 = 186 + integer, parameter :: rid_OH_HO2 = 187 + integer, parameter :: rid_OH_O = 188 + integer, parameter :: rid_OH_O3 = 189 + integer, parameter :: rid_OH_OH = 190 + integer, parameter :: rid_OH_OH_M = 191 + integer, parameter :: rid_usr_HO2_HO2 = 192 + integer, parameter :: rid_HO2NO2_OH = 193 + integer, parameter :: rid_N_NO = 194 + integer, parameter :: rid_N_NO2a = 195 + integer, parameter :: rid_N_NO2b = 196 + integer, parameter :: rid_N_NO2c = 197 + integer, parameter :: rid_N_O2 = 198 + integer, parameter :: rid_NO2_O = 199 + integer, parameter :: rid_NO2_O3 = 200 + integer, parameter :: rid_NO2_O_M = 201 + integer, parameter :: rid_NO3_HO2 = 202 + integer, parameter :: rid_NO3_NO = 203 + integer, parameter :: rid_NO3_O = 204 + integer, parameter :: rid_NO3_OH = 205 + integer, parameter :: rid_N_OH = 206 + integer, parameter :: rid_NO_HO2 = 207 + integer, parameter :: rid_NO_O3 = 208 + integer, parameter :: rid_NO_O_M = 209 + integer, parameter :: rid_O1D_N2Oa = 210 + integer, parameter :: rid_O1D_N2Ob = 211 + integer, parameter :: rid_tag_NO2_HO2 = 212 + integer, parameter :: rid_tag_NO2_NO3 = 213 + integer, parameter :: rid_tag_NO2_OH = 214 + integer, parameter :: rid_usr_HNO3_OH = 215 + integer, parameter :: rid_usr_HO2NO2_M = 216 + integer, parameter :: rid_usr_N2O5_M = 217 + integer, parameter :: rid_CL_CH2O = 218 + integer, parameter :: rid_CL_CH4 = 219 + integer, parameter :: rid_CL_H2 = 220 + integer, parameter :: rid_CL_H2O2 = 221 + integer, parameter :: rid_CL_HO2a = 222 + integer, parameter :: rid_CL_HO2b = 223 + integer, parameter :: rid_CL_O3 = 224 + integer, parameter :: rid_CLO_CH3O2 = 225 + integer, parameter :: rid_CLO_CLOa = 226 + integer, parameter :: rid_CLO_CLOb = 227 + integer, parameter :: rid_CLO_CLOc = 228 + integer, parameter :: rid_CLO_HO2 = 229 + integer, parameter :: rid_CLO_NO = 230 + integer, parameter :: rid_CLONO2_CL = 231 + integer, parameter :: rid_CLO_NO2_M = 232 + integer, parameter :: rid_CLONO2_O = 233 + integer, parameter :: rid_CLONO2_OH = 234 + integer, parameter :: rid_CLO_O = 235 + integer, parameter :: rid_CLO_OHa = 236 + integer, parameter :: rid_CLO_OHb = 237 + integer, parameter :: rid_HCL_O = 238 + integer, parameter :: rid_HCL_OH = 239 + integer, parameter :: rid_HOCL_CL = 240 + integer, parameter :: rid_HOCL_O = 241 + integer, parameter :: rid_HOCL_OH = 242 + integer, parameter :: rid_O1D_CCL4 = 243 + integer, parameter :: rid_O1D_CF2CLBR = 244 + integer, parameter :: rid_O1D_CFC11 = 245 + integer, parameter :: rid_O1D_CFC113 = 246 + integer, parameter :: rid_O1D_CFC114 = 247 + integer, parameter :: rid_O1D_CFC115 = 248 + integer, parameter :: rid_O1D_CFC12 = 249 + integer, parameter :: rid_O1D_HCLa = 250 + integer, parameter :: rid_O1D_HCLb = 251 + integer, parameter :: rid_tag_CLO_CLO_M = 252 + integer, parameter :: rid_usr_CL2O2_M = 253 + integer, parameter :: rid_BR_CH2O = 254 + integer, parameter :: rid_BR_HO2 = 255 + integer, parameter :: rid_BR_O3 = 256 + integer, parameter :: rid_BRO_BRO = 257 + integer, parameter :: rid_BRO_CLOa = 258 + integer, parameter :: rid_BRO_CLOb = 259 + integer, parameter :: rid_BRO_CLOc = 260 + integer, parameter :: rid_BRO_HO2 = 261 + integer, parameter :: rid_BRO_NO = 262 + integer, parameter :: rid_BRO_NO2_M = 263 + integer, parameter :: rid_BRONO2_O = 264 + integer, parameter :: rid_BRO_O = 265 + integer, parameter :: rid_BRO_OH = 266 + integer, parameter :: rid_HBR_O = 267 + integer, parameter :: rid_HBR_OH = 268 + integer, parameter :: rid_HOBR_O = 269 + integer, parameter :: rid_O1D_CF3BR = 270 + integer, parameter :: rid_O1D_CHBR3 = 271 + integer, parameter :: rid_O1D_H2402 = 272 + integer, parameter :: rid_O1D_HBRa = 273 + integer, parameter :: rid_O1D_HBRb = 274 + integer, parameter :: rid_F_CH4 = 275 + integer, parameter :: rid_F_H2 = 276 + integer, parameter :: rid_F_H2O = 277 + integer, parameter :: rid_F_HNO3 = 278 + integer, parameter :: rid_O1D_COF2 = 279 + integer, parameter :: rid_O1D_COFCL = 280 + integer, parameter :: rid_CH2BR2_CL = 281 + integer, parameter :: rid_CH2BR2_OH = 282 + integer, parameter :: rid_CH3BR_CL = 283 + integer, parameter :: rid_CH3BR_OH = 284 + integer, parameter :: rid_CH3CCL3_OH = 285 + integer, parameter :: rid_CH3CL_CL = 286 + integer, parameter :: rid_CH3CL_OH = 287 + integer, parameter :: rid_CHBR3_CL = 288 + integer, parameter :: rid_CHBR3_OH = 289 + integer, parameter :: rid_HCFC141B_OH = 290 + integer, parameter :: rid_HCFC142B_OH = 291 + integer, parameter :: rid_HCFC22_OH = 292 + integer, parameter :: rid_O1D_CH2BR2 = 293 + integer, parameter :: rid_O1D_CH3BR = 294 + integer, parameter :: rid_O1D_HCFC141B = 295 + integer, parameter :: rid_O1D_HCFC142B = 296 + integer, parameter :: rid_O1D_HCFC22 = 297 + integer, parameter :: rid_CH2O_HO2 = 298 + integer, parameter :: rid_CH2O_NO3 = 299 + integer, parameter :: rid_CH2O_O = 300 + integer, parameter :: rid_CH2O_OH = 301 + integer, parameter :: rid_CH3O2_CH3O2a = 302 + integer, parameter :: rid_CH3O2_CH3O2b = 303 + integer, parameter :: rid_CH3O2_HO2 = 304 + integer, parameter :: rid_CH3O2_NO = 305 + integer, parameter :: rid_CH3OH_OH = 306 + integer, parameter :: rid_CH3OOH_OH = 307 + integer, parameter :: rid_CH4_OH = 308 + integer, parameter :: rid_HCN_OH = 309 + integer, parameter :: rid_HCOOH_OH = 310 + integer, parameter :: rid_HMHP_OH = 311 + integer, parameter :: rid_HOCH2OO_HO2 = 312 + integer, parameter :: rid_HOCH2OO_M = 313 + integer, parameter :: rid_HOCH2OO_NO = 314 + integer, parameter :: rid_O1D_CH4a = 315 + integer, parameter :: rid_O1D_CH4b = 316 + integer, parameter :: rid_O1D_CH4c = 317 + integer, parameter :: rid_O1D_HCN = 318 + integer, parameter :: rid_usr_CO_OH = 319 + integer, parameter :: rid_C2H2_CL_M = 320 + integer, parameter :: rid_C2H2_OH_M = 321 + integer, parameter :: rid_C2H4_CL_M = 322 + integer, parameter :: rid_C2H4_O3 = 323 + integer, parameter :: rid_C2H5O2_C2H5O2 = 324 + integer, parameter :: rid_C2H5O2_CH3O2 = 325 + integer, parameter :: rid_C2H5O2_HO2 = 326 + integer, parameter :: rid_C2H5O2_NO = 327 + integer, parameter :: rid_C2H5OH_OH = 328 + integer, parameter :: rid_C2H5OOH_OH = 329 + integer, parameter :: rid_C2H6_CL = 330 + integer, parameter :: rid_C2H6_OH = 331 + integer, parameter :: rid_CH3CHO_NO3 = 332 + integer, parameter :: rid_CH3CHO_OH = 333 + integer, parameter :: rid_CH3CN_OH = 334 + integer, parameter :: rid_CH3CO3_CH3CO3 = 335 + integer, parameter :: rid_CH3CO3_CH3O2 = 336 + integer, parameter :: rid_CH3CO3_HO2 = 337 + integer, parameter :: rid_CH3CO3_NO = 338 + integer, parameter :: rid_CH3COOH_OH = 339 + integer, parameter :: rid_CH3COOOH_OH = 340 + integer, parameter :: rid_EO2_HO2 = 341 + integer, parameter :: rid_EO2_NO = 342 + integer, parameter :: rid_EO_M = 343 + integer, parameter :: rid_EO_O2 = 344 + integer, parameter :: rid_GLYALD_OH = 345 + integer, parameter :: rid_GLYOXAL_OH = 346 + integer, parameter :: rid_HCOCH2OOH_OH = 347 + integer, parameter :: rid_NO3CH2CHO_OH = 348 + integer, parameter :: rid_PAN_OH = 349 + integer, parameter :: rid_tag_C2H4_OH = 350 + integer, parameter :: rid_tag_CH3CO3_NO2 = 351 + integer, parameter :: rid_usr_PAN_M = 352 + integer, parameter :: rid_C3H6_NO3 = 353 + integer, parameter :: rid_C3H6_O3 = 354 + integer, parameter :: rid_C3H7O2_CH3O2 = 355 + integer, parameter :: rid_C3H7O2_HO2 = 356 + integer, parameter :: rid_C3H7O2_NO = 357 + integer, parameter :: rid_C3H7OOH_OH = 358 + integer, parameter :: rid_C3H8_OH = 359 + integer, parameter :: rid_CH3COCHO_NO3 = 360 + integer, parameter :: rid_CH3COCHO_OH = 361 + integer, parameter :: rid_HYAC_OH = 362 + integer, parameter :: rid_HYPERACET_OH = 363 + integer, parameter :: rid_NOA_OH = 364 + integer, parameter :: rid_PO2_HO2 = 365 + integer, parameter :: rid_PO2_NO = 366 + integer, parameter :: rid_POOH_OH = 367 + integer, parameter :: rid_RO2_CH3O2 = 368 + integer, parameter :: rid_RO2_HO2 = 369 + integer, parameter :: rid_RO2_NO = 370 + integer, parameter :: rid_ROOH_OH = 371 + integer, parameter :: rid_tag_C3H6_OH = 372 + integer, parameter :: rid_usr_CH3COCH3_OH = 373 + integer, parameter :: rid_BIGENE_NO3 = 374 + integer, parameter :: rid_BIGENE_OH = 375 + integer, parameter :: rid_DHPMPAL_OH = 376 + integer, parameter :: rid_ENEO2_NO = 377 + integer, parameter :: rid_ENEO2_NOb = 378 + integer, parameter :: rid_HONITR_OH = 379 + integer, parameter :: rid_MACRN_OH = 380 + integer, parameter :: rid_MACRO2_CH3CO3 = 381 + integer, parameter :: rid_MACRO2_CH3O2 = 382 + integer, parameter :: rid_MACRO2_HO2 = 383 + integer, parameter :: rid_MACRO2_isom = 384 + integer, parameter :: rid_MACR_O3 = 385 + integer, parameter :: rid_MACR_OH = 386 + integer, parameter :: rid_MACROOH_OH = 387 + integer, parameter :: rid_MCO3_CH3CO3 = 388 + integer, parameter :: rid_MCO3_CH3O2 = 389 + integer, parameter :: rid_MCO3_HO2 = 390 + integer, parameter :: rid_MCO3_MCO3 = 391 + integer, parameter :: rid_MCO3_NO = 392 + integer, parameter :: rid_MCO3_NO3 = 393 + integer, parameter :: rid_MEKO2_HO2 = 394 + integer, parameter :: rid_MEKO2_NO = 395 + integer, parameter :: rid_MEK_OH = 396 + integer, parameter :: rid_MEKOOH_OH = 397 + integer, parameter :: rid_MPAN_OH_M = 398 + integer, parameter :: rid_MVKN_OH = 399 + integer, parameter :: rid_MVKO2_CH3CO3 = 400 + integer, parameter :: rid_MVKO2_CH3O2 = 401 + integer, parameter :: rid_MVKO2_HO2 = 402 + integer, parameter :: rid_MVK_O3 = 403 + integer, parameter :: rid_MVK_OH = 404 + integer, parameter :: rid_MVKOOH_OH = 405 + integer, parameter :: rid_tag_MCO3_NO2 = 406 + integer, parameter :: rid_usr_MPAN_M = 407 + integer, parameter :: rid_ALKNIT_OH = 408 + integer, parameter :: rid_ALKO2_HO2 = 409 + integer, parameter :: rid_ALKO2_NO = 410 + integer, parameter :: rid_ALKO2_NOb = 411 + integer, parameter :: rid_ALKOOH_OH = 412 + integer, parameter :: rid_BIGALK_OH = 413 + integer, parameter :: rid_HPALD1_OH = 414 + integer, parameter :: rid_HPALD4_OH = 415 + integer, parameter :: rid_HPALDB1C_OH = 416 + integer, parameter :: rid_HPALDB4C_OH = 417 + integer, parameter :: rid_HYDRALD_OH = 418 + integer, parameter :: rid_ICHE_OH = 419 + integer, parameter :: rid_IEPOX_OH = 420 + integer, parameter :: rid_IEPOXOO_HO2 = 421 + integer, parameter :: rid_INHEB_OH = 422 + integer, parameter :: rid_INHED_OH = 423 + integer, parameter :: rid_ISOPB1O2_CH3CO3 = 424 + integer, parameter :: rid_ISOPB1O2_CH3O2 = 425 + integer, parameter :: rid_ISOPB1O2_HO2 = 426 + integer, parameter :: rid_ISOPB1O2_I = 427 + integer, parameter :: rid_ISOPB1O2_M_C = 428 + integer, parameter :: rid_ISOPB1O2_M_T = 429 + integer, parameter :: rid_ISOPB4O2_CH3CO3 = 430 + integer, parameter :: rid_ISOPB4O2_CH3O2 = 431 + integer, parameter :: rid_ISOPB4O2_HO2 = 432 + integer, parameter :: rid_ISOPB4O2_I = 433 + integer, parameter :: rid_ISOPB4O2_M_C = 434 + integer, parameter :: rid_ISOPB4O2_M_T = 435 + integer, parameter :: rid_ISOPC1C_O2_B = 436 + integer, parameter :: rid_ISOPC1C_O2_D = 437 + integer, parameter :: rid_ISOPC1T_O2_B = 438 + integer, parameter :: rid_ISOPC1T_O2_D = 439 + integer, parameter :: rid_ISOPC4C_O2_B = 440 + integer, parameter :: rid_ISOPC4C_O2_D = 441 + integer, parameter :: rid_ISOPC4T_O2_B = 442 + integer, parameter :: rid_ISOPC4T_O2_D = 443 + integer, parameter :: rid_ISOPED1O2_CH3CO3 = 444 + integer, parameter :: rid_ISOPED1O2_CH3O2 = 445 + integer, parameter :: rid_ISOPED1O2_HO2 = 446 + integer, parameter :: rid_ISOPED1O2_M_C = 447 + integer, parameter :: rid_ISOPED4O2_CH3CO3 = 448 + integer, parameter :: rid_ISOPED4O2_CH3O2 = 449 + integer, parameter :: rid_ISOPED4O2_HO2 = 450 + integer, parameter :: rid_ISOPED4O2_M = 451 + integer, parameter :: rid_ISOPFDNC_OH = 452 + integer, parameter :: rid_ISOPFDN_OH = 453 + integer, parameter :: rid_ISOPFNC_OH = 454 + integer, parameter :: rid_ISOPFNP_OH = 455 + integer, parameter :: rid_ISOPHFP_OH = 456 + integer, parameter :: rid_ISOPN1DO2_HO2 = 457 + integer, parameter :: rid_ISOPN1DO2_I = 458 + integer, parameter :: rid_ISOPN1D_O3 = 459 + integer, parameter :: rid_ISOPN1D_OH = 460 + integer, parameter :: rid_ISOPN2BO2_HO2 = 461 + integer, parameter :: rid_ISOPN2BO2_I = 462 + integer, parameter :: rid_ISOPN2B_OH = 463 + integer, parameter :: rid_ISOPN3BO2_HO2 = 464 + integer, parameter :: rid_ISOPN3BO2_I = 465 + integer, parameter :: rid_ISOPN3B_OH = 466 + integer, parameter :: rid_ISOPN4DO2_HO2 = 467 + integer, parameter :: rid_ISOPN4DO2_I = 468 + integer, parameter :: rid_ISOPN4D_O3 = 469 + integer, parameter :: rid_ISOPN4D_OH = 470 + integer, parameter :: rid_ISOPNBNO3O2_HO2 = 471 + integer, parameter :: rid_ISOPNBNO3_OH = 472 + integer, parameter :: rid_ISOP_NO3 = 473 + integer, parameter :: rid_ISOPNO3_CH3CO3 = 474 + integer, parameter :: rid_ISOPNO3_CH3O2 = 475 + integer, parameter :: rid_ISOPNO3_HO2 = 476 + integer, parameter :: rid_ISOPNO3_ISOPNO3 = 477 + integer, parameter :: rid_ISOPNO3_NO3 = 478 + integer, parameter :: rid_ISOPNOOHBO2_HO2 = 479 + integer, parameter :: rid_ISOPNOOHBO2_I = 480 + integer, parameter :: rid_ISOPNOOHB_OH = 481 + integer, parameter :: rid_ISOPNOOHDO2_HO2 = 482 + integer, parameter :: rid_ISOPNOOHDO2_I = 483 + integer, parameter :: rid_ISOPNOOHD_O3 = 484 + integer, parameter :: rid_ISOPNOOHD_OH = 485 + integer, parameter :: rid_ISOP_O3 = 486 + integer, parameter :: rid_ISOP_OH = 487 + integer, parameter :: rid_ISOPOH_OH = 488 + integer, parameter :: rid_ISOPOOH_OH_abs = 489 + integer, parameter :: rid_ISOPOOH_OH_add = 490 + integer, parameter :: rid_ISOPZD1O2_CH3CO3 = 491 + integer, parameter :: rid_ISOPZD1O2_CH3O2 = 492 + integer, parameter :: rid_ISOPZD1O2_HO2 = 493 + integer, parameter :: rid_ISOPZD1O2_M = 494 + integer, parameter :: rid_ISOPZD4O2_CH3CO3 = 495 + integer, parameter :: rid_ISOPZD4O2_CH3O2 = 496 + integer, parameter :: rid_ISOPZD4O2_HO2 = 497 + integer, parameter :: rid_ISOPZD4O2_M_C = 498 + integer, parameter :: rid_NC4CHOO2_HO2 = 499 + integer, parameter :: rid_NC4CHOO2_isom = 500 + integer, parameter :: rid_NC4CHO_O3 = 501 + integer, parameter :: rid_NC4CHO_OH = 502 + integer, parameter :: rid_usr_IEPOXOO_NOa = 503 + integer, parameter :: rid_usr_IEPOXOO_NOn = 504 + integer, parameter :: rid_usr_ISOPB1O2_NOa = 505 + integer, parameter :: rid_usr_ISOPB1O2_NOn = 506 + integer, parameter :: rid_usr_ISOPB4O2_NOa = 507 + integer, parameter :: rid_usr_ISOPB4O2_NOn = 508 + integer, parameter :: rid_usr_ISOPED1O2_NOa = 509 + integer, parameter :: rid_usr_ISOPED1O2_NOn = 510 + integer, parameter :: rid_usr_ISOPED4O2_NOa = 511 + integer, parameter :: rid_usr_ISOPED4O2_NOn = 512 + integer, parameter :: rid_usr_ISOPN1DO2_NOa = 513 + integer, parameter :: rid_usr_ISOPN1DO2_NOn = 514 + integer, parameter :: rid_usr_ISOPN2BO2_NOa = 515 + integer, parameter :: rid_usr_ISOPN2BO2_NOn = 516 + integer, parameter :: rid_usr_ISOPN3BO2_NOa = 517 + integer, parameter :: rid_usr_ISOPN3BO2_NOn = 518 + integer, parameter :: rid_usr_ISOPN4DO2_NOa = 519 + integer, parameter :: rid_usr_ISOPN4DO2_NOn = 520 + integer, parameter :: rid_usr_ISOPNBNO3O2_NOa = 521 + integer, parameter :: rid_usr_ISOPNBNO3O2_NOn = 522 + integer, parameter :: rid_usr_ISOPNO3_NOa = 523 + integer, parameter :: rid_usr_ISOPNO3_NOn = 524 + integer, parameter :: rid_usr_ISOPNOOHBO2_NOa = 525 + integer, parameter :: rid_usr_ISOPNOOHBO2_NOn = 526 + integer, parameter :: rid_usr_ISOPNOOHDO2_NOa = 527 + integer, parameter :: rid_usr_ISOPNOOHDO2_NOn = 528 + integer, parameter :: rid_usr_ISOPZD1O2 = 529 + integer, parameter :: rid_usr_ISOPZD1O2_NOa = 530 + integer, parameter :: rid_usr_ISOPZD1O2_NOn = 531 + integer, parameter :: rid_usr_ISOPZD4O2 = 532 + integer, parameter :: rid_usr_ISOPZD4O2_NOa = 533 + integer, parameter :: rid_usr_ISOPZD4O2_NOn = 534 + integer, parameter :: rid_usr_MACRO2_NOa = 535 + integer, parameter :: rid_usr_MACRO2_NOn = 536 + integer, parameter :: rid_usr_MVKO2_NOa = 537 + integer, parameter :: rid_usr_MVKO2_NOn = 538 + integer, parameter :: rid_usr_NC4CHOO2_NOa = 539 + integer, parameter :: rid_usr_NC4CHOO2_NOn = 540 + integer, parameter :: rid_ACBZO2_HO2 = 541 + integer, parameter :: rid_ACBZO2_NO = 542 + integer, parameter :: rid_BENZENE_OH = 543 + integer, parameter :: rid_BENZO2_HO2 = 544 + integer, parameter :: rid_BENZO2_NO = 545 + integer, parameter :: rid_BENZOOH_OH = 546 + integer, parameter :: rid_BZALD_OH = 547 + integer, parameter :: rid_BZOO_HO2 = 548 + integer, parameter :: rid_BZOOH_OH = 549 + integer, parameter :: rid_BZOO_NO = 550 + integer, parameter :: rid_C6H5O2_HO2 = 551 + integer, parameter :: rid_C6H5O2_NO = 552 + integer, parameter :: rid_C6H5OOH_OH = 553 + integer, parameter :: rid_CRESOL_OH = 554 + integer, parameter :: rid_DICARBO2_HO2 = 555 + integer, parameter :: rid_DICARBO2_NO = 556 + integer, parameter :: rid_DICARBO2_NO2 = 557 + integer, parameter :: rid_MALO2_HO2 = 558 + integer, parameter :: rid_MALO2_NO = 559 + integer, parameter :: rid_MALO2_NO2 = 560 + integer, parameter :: rid_MDIALO2_HO2 = 561 + integer, parameter :: rid_MDIALO2_NO = 562 + integer, parameter :: rid_MDIALO2_NO2 = 563 + integer, parameter :: rid_PHENO2_HO2 = 564 + integer, parameter :: rid_PHENO2_NO = 565 + integer, parameter :: rid_PHENOL_OH = 566 + integer, parameter :: rid_PHENO_NO2 = 567 + integer, parameter :: rid_PHENO_O3 = 568 + integer, parameter :: rid_PHENOOH_OH = 569 + integer, parameter :: rid_tag_ACBZO2_NO2 = 570 + integer, parameter :: rid_TOLO2_HO2 = 571 + integer, parameter :: rid_TOLO2_NO = 572 + integer, parameter :: rid_TOLOOH_OH = 573 + integer, parameter :: rid_TOLUENE_OH = 574 + integer, parameter :: rid_usr_PBZNIT_M = 575 + integer, parameter :: rid_XYLENES_OH = 576 + integer, parameter :: rid_XYLENO2_HO2 = 577 + integer, parameter :: rid_XYLENO2_NO = 578 + integer, parameter :: rid_XYLENOOH_OH = 579 + integer, parameter :: rid_XYLOLO2_HO2 = 580 + integer, parameter :: rid_XYLOLO2_NO = 581 + integer, parameter :: rid_XYLOL_OH = 582 + integer, parameter :: rid_XYLOLOOH_OH = 583 + integer, parameter :: rid_APIN_NO3 = 584 + integer, parameter :: rid_APINNO3_APINNO3 = 585 + integer, parameter :: rid_APINNO3_CH3CO3 = 586 + integer, parameter :: rid_APINNO3_CH3O2 = 587 + integer, parameter :: rid_APINNO3_HO2 = 588 + integer, parameter :: rid_APINNO3_NO = 589 + integer, parameter :: rid_APINNO3_NO3 = 590 + integer, parameter :: rid_APINNO3_TERPA2CO3 = 591 + integer, parameter :: rid_APINNO3_TERPA3CO3 = 592 + integer, parameter :: rid_APINNO3_TERPACO3 = 593 + integer, parameter :: rid_APINO2_CH3CO3 = 594 + integer, parameter :: rid_APINO2_CH3O2 = 595 + integer, parameter :: rid_APINO2_HO2 = 596 + integer, parameter :: rid_APINO2_NO = 597 + integer, parameter :: rid_APINO2_NO3 = 598 + integer, parameter :: rid_APINO2_TERPA2CO3 = 599 + integer, parameter :: rid_APINO2_TERPA3CO3 = 600 + integer, parameter :: rid_APINO2_TERPACO3 = 601 + integer, parameter :: rid_APIN_O3 = 602 + integer, parameter :: rid_APIN_OH = 603 + integer, parameter :: rid_BCARY_NO3 = 604 + integer, parameter :: rid_BCARYNO3_BCARYNO3 = 605 + integer, parameter :: rid_BCARYNO3_CH3CO3 = 606 + integer, parameter :: rid_BCARYNO3_CH3O2 = 607 + integer, parameter :: rid_BCARYNO3_HO2 = 608 + integer, parameter :: rid_BCARYNO3_NO = 609 + integer, parameter :: rid_BCARYNO3_NO3 = 610 + integer, parameter :: rid_BCARYNO3_TERPA2CO3 = 611 + integer, parameter :: rid_BCARYNO3_TERPA3CO3 = 612 + integer, parameter :: rid_BCARYNO3_TERPACO3 = 613 + integer, parameter :: rid_BCARYO2_CH3CO3 = 614 + integer, parameter :: rid_BCARYO2_CH3O2 = 615 + integer, parameter :: rid_BCARYO2_HO2 = 616 + integer, parameter :: rid_BCARYO2_NO = 617 + integer, parameter :: rid_BCARYO2_NO3 = 618 + integer, parameter :: rid_BCARYO2_TERPA2CO3 = 619 + integer, parameter :: rid_BCARYO2_TERPA3CO3 = 620 + integer, parameter :: rid_BCARYO2_TERPACO3 = 621 + integer, parameter :: rid_BCARY_O3 = 622 + integer, parameter :: rid_BCARY_OH = 623 + integer, parameter :: rid_BPIN_NO3 = 624 + integer, parameter :: rid_BPINNO3_BPINNO3 = 625 + integer, parameter :: rid_BPINNO3_CH3CO3 = 626 + integer, parameter :: rid_BPINNO3_CH3O2 = 627 + integer, parameter :: rid_BPINNO3_HO2 = 628 + integer, parameter :: rid_BPINNO3_NO = 629 + integer, parameter :: rid_BPINNO3_NO3 = 630 + integer, parameter :: rid_BPINNO3_TERPA2CO3 = 631 + integer, parameter :: rid_BPINNO3_TERPA3CO3 = 632 + integer, parameter :: rid_BPINNO3_TERPACO3 = 633 + integer, parameter :: rid_BPINO2_CH3CO3 = 634 + integer, parameter :: rid_BPINO2_CH3O2 = 635 + integer, parameter :: rid_BPINO2_HO2 = 636 + integer, parameter :: rid_BPINO2_NO = 637 + integer, parameter :: rid_BPINO2_NO3 = 638 + integer, parameter :: rid_BPINO2_TERPA2CO3 = 639 + integer, parameter :: rid_BPINO2_TERPA3CO3 = 640 + integer, parameter :: rid_BPINO2_TERPACO3 = 641 + integer, parameter :: rid_BPIN_O3 = 642 + integer, parameter :: rid_BPIN_OH = 643 + integer, parameter :: rid_LIMON_NO3 = 644 + integer, parameter :: rid_LIMONNO3_CH3CO3 = 645 + integer, parameter :: rid_LIMONNO3_CH3O2 = 646 + integer, parameter :: rid_LIMONNO3_HO2 = 647 + integer, parameter :: rid_LIMONNO3_LIMONNO3 = 648 + integer, parameter :: rid_LIMONNO3_NO = 649 + integer, parameter :: rid_LIMONNO3_NO3 = 650 + integer, parameter :: rid_LIMONNO3_TERPA2CO3 = 651 + integer, parameter :: rid_LIMONNO3_TERPA3CO3 = 652 + integer, parameter :: rid_LIMONNO3_TERPACO3 = 653 + integer, parameter :: rid_LIMONO2_CH3CO3 = 654 + integer, parameter :: rid_LIMONO2_CH3O2 = 655 + integer, parameter :: rid_LIMONO2_HO2 = 656 + integer, parameter :: rid_LIMONO2_NO = 657 + integer, parameter :: rid_LIMONO2_NO3 = 658 + integer, parameter :: rid_LIMONO2_TERPA2CO3 = 659 + integer, parameter :: rid_LIMONO2_TERPA3CO3 = 660 + integer, parameter :: rid_LIMONO2_TERPACO3 = 661 + integer, parameter :: rid_LIMON_O3 = 662 + integer, parameter :: rid_LIMON_OH = 663 + integer, parameter :: rid_MYRC_NO3 = 664 + integer, parameter :: rid_MYRCNO3_CH3CO3 = 665 + integer, parameter :: rid_MYRCNO3_CH3O2 = 666 + integer, parameter :: rid_MYRCNO3_HO2 = 667 + integer, parameter :: rid_MYRCNO3_MYRCNO3 = 668 + integer, parameter :: rid_MYRCNO3_NO = 669 + integer, parameter :: rid_MYRCNO3_NO3 = 670 + integer, parameter :: rid_MYRCNO3_TERPA2CO3 = 671 + integer, parameter :: rid_MYRCNO3_TERPA3CO3 = 672 + integer, parameter :: rid_MYRCNO3_TERPACO3 = 673 + integer, parameter :: rid_MYRCO2_CH3CO3 = 674 + integer, parameter :: rid_MYRCO2_CH3O2 = 675 + integer, parameter :: rid_MYRCO2_HO2 = 676 + integer, parameter :: rid_MYRCO2_NO = 677 + integer, parameter :: rid_MYRCO2_NO3 = 678 + integer, parameter :: rid_MYRCO2_TERPA2CO3 = 679 + integer, parameter :: rid_MYRCO2_TERPA3CO3 = 680 + integer, parameter :: rid_MYRCO2_TERPACO3 = 681 + integer, parameter :: rid_MYRC_O3 = 682 + integer, parameter :: rid_MYRC_OH = 683 + integer, parameter :: rid_tag_TERPA2CO3_NO2 = 684 + integer, parameter :: rid_tag_TERPA3CO3_NO2 = 685 + integer, parameter :: rid_tag_TERPACO3_NO2 = 686 + integer, parameter :: rid_TERP1OOHO2_HO2 = 687 + integer, parameter :: rid_TERP1OOHO2_NO = 688 + integer, parameter :: rid_TERP1OOH_OH = 689 + integer, parameter :: rid_TERP2AOOH_OH = 690 + integer, parameter :: rid_TERP2OOHO2_HO2 = 691 + integer, parameter :: rid_TERP2OOHO2_NO = 692 + integer, parameter :: rid_TERPA1O2_CH3CO3 = 693 + integer, parameter :: rid_TERPA1O2_CH3O2 = 694 + integer, parameter :: rid_TERPA1O2_HO2 = 695 + integer, parameter :: rid_TERPA1O2_NO = 696 + integer, parameter :: rid_TERPA1O2_NO3 = 697 + integer, parameter :: rid_TERPA1O2_TERPA2CO3 = 698 + integer, parameter :: rid_TERPA1O2_TERPA3CO3 = 699 + integer, parameter :: rid_TERPA1O2_TERPACO3 = 700 + integer, parameter :: rid_TERPA2CO3_CH3CO3 = 701 + integer, parameter :: rid_TERPA2CO3_CH3O2 = 702 + integer, parameter :: rid_TERPA2CO3_HO2 = 703 + integer, parameter :: rid_TERPA2CO3_NO = 704 + integer, parameter :: rid_TERPA2CO3_NO3 = 705 + integer, parameter :: rid_TERPA2CO3_TERPA2CO3 = 706 + integer, parameter :: rid_TERPA2CO3_TERPACO3 = 707 + integer, parameter :: rid_TERPA2_NO3 = 708 + integer, parameter :: rid_TERPA2O2_CH3CO3 = 709 + integer, parameter :: rid_TERPA2O2_CH3O2 = 710 + integer, parameter :: rid_TERPA2O2_HO2 = 711 + integer, parameter :: rid_TERPA2O2_NO = 712 + integer, parameter :: rid_TERPA2O2_NO3 = 713 + integer, parameter :: rid_TERPA2O2_TERPA2CO3 = 714 + integer, parameter :: rid_TERPA2O2_TERPA3CO3 = 715 + integer, parameter :: rid_TERPA2O2_TERPACO3 = 716 + integer, parameter :: rid_TERPA2_OH = 717 + integer, parameter :: rid_TERPA2PAN_OH = 718 + integer, parameter :: rid_TERPA3CO3_CH3CO3 = 719 + integer, parameter :: rid_TERPA3CO3_CH3O2 = 720 + integer, parameter :: rid_TERPA3CO3_HO2 = 721 + integer, parameter :: rid_TERPA3CO3_NO = 722 + integer, parameter :: rid_TERPA3CO3_NO3 = 723 + integer, parameter :: rid_TERPA3CO3_TERPA2CO3 = 724 + integer, parameter :: rid_TERPA3CO3_TERPA3CO3 = 725 + integer, parameter :: rid_TERPA3CO3_TERPACO3 = 726 + integer, parameter :: rid_TERPA3_NO3 = 727 + integer, parameter :: rid_TERPA3O2_CH3CO3 = 728 + integer, parameter :: rid_TERPA3O2_CH3O2 = 729 + integer, parameter :: rid_TERPA3O2_HO2 = 730 + integer, parameter :: rid_TERPA3O2_NO = 731 + integer, parameter :: rid_TERPA3O2_NO3 = 732 + integer, parameter :: rid_TERPA3O2_TERPA2CO3 = 733 + integer, parameter :: rid_TERPA3O2_TERPA3CO3 = 734 + integer, parameter :: rid_TERPA3O2_TERPACO3 = 735 + integer, parameter :: rid_TERPA3_OH = 736 + integer, parameter :: rid_TERPA3PAN_OH = 737 + integer, parameter :: rid_TERPA4O2_CH3CO3 = 738 + integer, parameter :: rid_TERPA4O2_CH3O2 = 739 + integer, parameter :: rid_TERPA4O2_HO2 = 740 + integer, parameter :: rid_TERPA4O2_NO = 741 + integer, parameter :: rid_TERPA4O2_NO3 = 742 + integer, parameter :: rid_TERPA4O2_TERPA2CO3 = 743 + integer, parameter :: rid_TERPA4O2_TERPA3CO3 = 744 + integer, parameter :: rid_TERPA4O2_TERPACO3 = 745 + integer, parameter :: rid_TERPACID2_OH = 746 + integer, parameter :: rid_TERPACID3_OH = 747 + integer, parameter :: rid_TERPACID_OH = 748 + integer, parameter :: rid_TERPACO3_CH3CO3 = 749 + integer, parameter :: rid_TERPACO3_CH3O2 = 750 + integer, parameter :: rid_TERPACO3_HO2 = 751 + integer, parameter :: rid_TERPACO3_NO = 752 + integer, parameter :: rid_TERPACO3_NO3 = 753 + integer, parameter :: rid_TERPACO3_TERPACO3 = 754 + integer, parameter :: rid_TERPA_NO3 = 755 + integer, parameter :: rid_TERPA_OH = 756 + integer, parameter :: rid_TERPAPAN_OH = 757 + integer, parameter :: rid_TERPDHDP_OH = 758 + integer, parameter :: rid_TERPF1_NO3 = 759 + integer, parameter :: rid_TERPF1O2_HO2 = 760 + integer, parameter :: rid_TERPF1O2_NO = 761 + integer, parameter :: rid_TERPF1_O3 = 762 + integer, parameter :: rid_TERPF1_OH = 763 + integer, parameter :: rid_TERPF2_NO3 = 764 + integer, parameter :: rid_TERPF2O2_HO2 = 765 + integer, parameter :: rid_TERPF2O2_NO = 766 + integer, parameter :: rid_TERPF2_O3 = 767 + integer, parameter :: rid_TERPF2_OH = 768 + integer, parameter :: rid_TERPFDN_OH = 769 + integer, parameter :: rid_TERPHFN_OH = 770 + integer, parameter :: rid_TERPK_OH = 771 + integer, parameter :: rid_TERPNPS1O2_HO2 = 772 + integer, parameter :: rid_TERPNPS1O2_NO = 773 + integer, parameter :: rid_TERPNPS1_OH = 774 + integer, parameter :: rid_TERPNPS_OH = 775 + integer, parameter :: rid_TERPNPT1O2_HO2 = 776 + integer, parameter :: rid_TERPNPT1O2_NO = 777 + integer, parameter :: rid_TERPNPT1_OH = 778 + integer, parameter :: rid_TERPNPT_OH = 779 + integer, parameter :: rid_TERPNS1O2_HO2 = 780 + integer, parameter :: rid_TERPNS1O2_NO = 781 + integer, parameter :: rid_TERPNS1_OH = 782 + integer, parameter :: rid_TERPNS_OH = 783 + integer, parameter :: rid_TERPNT1O2_HO2 = 784 + integer, parameter :: rid_TERPNT1O2_NO = 785 + integer, parameter :: rid_TERPNT1_OH = 786 + integer, parameter :: rid_TERPNT_OH = 787 + integer, parameter :: rid_TERPOOHL_OH = 788 + integer, parameter :: rid_TERPOOH_OH = 789 + integer, parameter :: rid_usr_TERPA2PAN_M = 790 + integer, parameter :: rid_usr_TERPA3PAN_M = 791 + integer, parameter :: rid_usr_TERPAPAN_M = 792 + integer, parameter :: rid_DMS_NO3 = 793 + integer, parameter :: rid_DMS_OHa = 794 + integer, parameter :: rid_OCS_O = 795 + integer, parameter :: rid_OCS_OH = 796 + integer, parameter :: rid_S_O2 = 797 + integer, parameter :: rid_SO2_OH_M = 798 + integer, parameter :: rid_S_O3 = 799 + integer, parameter :: rid_SO_BRO = 800 + integer, parameter :: rid_SO_CLO = 801 + integer, parameter :: rid_S_OH = 802 + integer, parameter :: rid_SO_NO2 = 803 + integer, parameter :: rid_SO_O2 = 804 + integer, parameter :: rid_SO_O3 = 805 + integer, parameter :: rid_SO_OCLO = 806 + integer, parameter :: rid_SO_OH = 807 + integer, parameter :: rid_usr_DMS_OH = 808 + integer, parameter :: rid_usr_SO3_H2O = 809 + integer, parameter :: rid_NH3_OH = 810 + integer, parameter :: rid_usr_GLYOXAL_aer = 811 + integer, parameter :: rid_usr_HO2_aer = 812 + integer, parameter :: rid_usr_HONITR_aer = 813 + integer, parameter :: rid_usr_ICHE_aer = 814 + integer, parameter :: rid_usr_IEPOX_aer = 815 + integer, parameter :: rid_usr_INHEB_aer = 816 + integer, parameter :: rid_usr_INHED_aer = 817 + integer, parameter :: rid_usr_INOOHD_aer = 818 + integer, parameter :: rid_usr_ISOPFDN_aer = 819 + integer, parameter :: rid_usr_ISOPFDNC_aer = 820 + integer, parameter :: rid_usr_ISOPFNC_aer = 821 + integer, parameter :: rid_usr_ISOPFNP_aer = 822 + integer, parameter :: rid_usr_ISOPHFP_aer = 823 + integer, parameter :: rid_usr_ISOPN1D_aer = 824 + integer, parameter :: rid_usr_ISOPN2B_aer = 825 + integer, parameter :: rid_usr_ISOPN4D_aer = 826 + integer, parameter :: rid_usr_N2O5_aer = 827 + integer, parameter :: rid_usr_NC4CHO_aer = 828 + integer, parameter :: rid_usr_NH4_strat_tau = 829 + integer, parameter :: rid_usr_NO2_aer = 830 + integer, parameter :: rid_usr_NO3_aer = 831 + integer, parameter :: rid_usr_ONITR_aer = 832 + integer, parameter :: rid_usr_SQTN_aer = 833 + integer, parameter :: rid_usr_TERPDHDP_aer = 834 + integer, parameter :: rid_usr_TERPFDN_aer = 835 + integer, parameter :: rid_usr_TERPHFN_aer = 836 + integer, parameter :: rid_usr_TERPNPT1_aer = 837 + integer, parameter :: rid_usr_TERPNPT_aer = 838 + integer, parameter :: rid_usr_TERPNT1_aer = 839 + integer, parameter :: rid_usr_TERPNT_aer = 840 + integer, parameter :: rid_APIN_NO3_vbs = 841 + integer, parameter :: rid_APINO2_HO2_vbs = 842 + integer, parameter :: rid_APINO2_NO_vbs = 843 + integer, parameter :: rid_APIN_O3_vbs = 844 + integer, parameter :: rid_APIN_OH_vbs = 845 + integer, parameter :: rid_BCARY_NO3_vbs = 846 + integer, parameter :: rid_BCARYO2_HO2_vbs = 847 + integer, parameter :: rid_BCARYO2_NO_vbs = 848 + integer, parameter :: rid_BCARY_O3_vbs = 849 + integer, parameter :: rid_BCARY_OH_vbs = 850 + integer, parameter :: rid_BENZENE_OH_vbs = 851 + integer, parameter :: rid_BENZO2_HO2_vbs = 852 + integer, parameter :: rid_BENZO2_NO_vbs = 853 + integer, parameter :: rid_BPIN_NO3_vbs = 854 + integer, parameter :: rid_BPINO2_HO2_vbs = 855 + integer, parameter :: rid_BPINO2_NO_vbs = 856 + integer, parameter :: rid_BPIN_O3_vbs = 857 + integer, parameter :: rid_BPIN_OH_vbs = 858 + integer, parameter :: rid_ISOP_NO3_vbs = 859 + integer, parameter :: rid_ISOPO2_HO2_vbs = 860 + integer, parameter :: rid_ISOPO2_NO_vbs = 861 + integer, parameter :: rid_ISOP_O3_vbs = 862 + integer, parameter :: rid_ISOP_OH_vbs = 863 + integer, parameter :: rid_IVOCO2_HO2_vbs = 864 + integer, parameter :: rid_IVOCO2_NO_vbs = 865 + integer, parameter :: rid_IVOC_OH_vbs = 866 + integer, parameter :: rid_LIMON_NO3_vbs = 867 + integer, parameter :: rid_LIMONO2_HO2_vbs = 868 + integer, parameter :: rid_LIMONO2_NO_vbs = 869 + integer, parameter :: rid_LIMON_O3_vbs = 870 + integer, parameter :: rid_LIMON_OH_vbs = 871 + integer, parameter :: rid_MYRC_NO3_vbs = 872 + integer, parameter :: rid_MYRCO2_HO2_vbs = 873 + integer, parameter :: rid_MYRCO2_NO_vbs = 874 + integer, parameter :: rid_MYRC_O3_vbs = 875 + integer, parameter :: rid_MYRC_OH_vbs = 876 + integer, parameter :: rid_SVOC_OH = 877 + integer, parameter :: rid_TOLUENE_OH_vbs = 878 + integer, parameter :: rid_TOLUO2_HO2_vbs = 879 + integer, parameter :: rid_TOLUO2_NO_vbs = 880 + integer, parameter :: rid_XYLENES_OH_vbs = 881 + integer, parameter :: rid_XYLEO2_HO2_vbs = 882 + integer, parameter :: rid_XYLEO2_NO_vbs = 883 + integer, parameter :: rid_het1 = 884 + integer, parameter :: rid_het10 = 885 + integer, parameter :: rid_het11 = 886 + integer, parameter :: rid_het12 = 887 + integer, parameter :: rid_het13 = 888 + integer, parameter :: rid_het14 = 889 + integer, parameter :: rid_het15 = 890 + integer, parameter :: rid_het16 = 891 + integer, parameter :: rid_het17 = 892 + integer, parameter :: rid_het2 = 893 + integer, parameter :: rid_het3 = 894 + integer, parameter :: rid_het4 = 895 + integer, parameter :: rid_het5 = 896 + integer, parameter :: rid_het6 = 897 + integer, parameter :: rid_het7 = 898 + integer, parameter :: rid_het8 = 899 + integer, parameter :: rid_het9 = 900 + integer, parameter :: rid_E90_tau = 901 + integer, parameter :: rid_NH_50_tau = 902 + integer, parameter :: rid_NH_5_tau = 903 + integer, parameter :: rid_ST80_25_tau = 904 + end module m_rxt_id diff --git a/src/chemistry/pp_trop_strat_mam5_ts2/m_spc_id.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/m_spc_id.F90 new file mode 100644 index 0000000000..f972481748 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/m_spc_id.F90 @@ -0,0 +1,322 @@ + module m_spc_id + implicit none + integer, parameter :: id_ALKNIT = 1 + integer, parameter :: id_ALKOOH = 2 + integer, parameter :: id_AOA_NH = 3 + integer, parameter :: id_APIN = 4 + integer, parameter :: id_bc_a1 = 5 + integer, parameter :: id_bc_a4 = 6 + integer, parameter :: id_BCARY = 7 + integer, parameter :: id_BENZENE = 8 + integer, parameter :: id_BENZOOH = 9 + integer, parameter :: id_BEPOMUC = 10 + integer, parameter :: id_BIGALD1 = 11 + integer, parameter :: id_BIGALD2 = 12 + integer, parameter :: id_BIGALD3 = 13 + integer, parameter :: id_BIGALD4 = 14 + integer, parameter :: id_BIGALK = 15 + integer, parameter :: id_BIGENE = 16 + integer, parameter :: id_BPIN = 17 + integer, parameter :: id_BR = 18 + integer, parameter :: id_BRCL = 19 + integer, parameter :: id_BRO = 20 + integer, parameter :: id_BRONO2 = 21 + integer, parameter :: id_BRY = 22 + integer, parameter :: id_BZALD = 23 + integer, parameter :: id_BZOOH = 24 + integer, parameter :: id_C2H2 = 25 + integer, parameter :: id_C2H4 = 26 + integer, parameter :: id_C2H5OH = 27 + integer, parameter :: id_C2H5OOH = 28 + integer, parameter :: id_C2H6 = 29 + integer, parameter :: id_C3H6 = 30 + integer, parameter :: id_C3H7OOH = 31 + integer, parameter :: id_C3H8 = 32 + integer, parameter :: id_C6H5OOH = 33 + integer, parameter :: id_CCL4 = 34 + integer, parameter :: id_CF2CLBR = 35 + integer, parameter :: id_CF3BR = 36 + integer, parameter :: id_CFC11 = 37 + integer, parameter :: id_CFC113 = 38 + integer, parameter :: id_CFC114 = 39 + integer, parameter :: id_CFC115 = 40 + integer, parameter :: id_CFC12 = 41 + integer, parameter :: id_CH2BR2 = 42 + integer, parameter :: id_CH2O = 43 + integer, parameter :: id_CH3BR = 44 + integer, parameter :: id_CH3CCL3 = 45 + integer, parameter :: id_CH3CHO = 46 + integer, parameter :: id_CH3CL = 47 + integer, parameter :: id_CH3CN = 48 + integer, parameter :: id_CH3COCH3 = 49 + integer, parameter :: id_CH3COCHO = 50 + integer, parameter :: id_CH3COOH = 51 + integer, parameter :: id_CH3COOOH = 52 + integer, parameter :: id_CH3OH = 53 + integer, parameter :: id_CH3OOH = 54 + integer, parameter :: id_CH4 = 55 + integer, parameter :: id_CHBR3 = 56 + integer, parameter :: id_CL = 57 + integer, parameter :: id_CL2 = 58 + integer, parameter :: id_CL2O2 = 59 + integer, parameter :: id_CLO = 60 + integer, parameter :: id_CLONO2 = 61 + integer, parameter :: id_CLY = 62 + integer, parameter :: id_CO = 63 + integer, parameter :: id_CO2 = 64 + integer, parameter :: id_COF2 = 65 + integer, parameter :: id_COFCL = 66 + integer, parameter :: id_CRESOL = 67 + integer, parameter :: id_DHPMPAL = 68 + integer, parameter :: id_DMS = 69 + integer, parameter :: id_dst_a1 = 70 + integer, parameter :: id_dst_a2 = 71 + integer, parameter :: id_dst_a3 = 72 + integer, parameter :: id_E90 = 73 + integer, parameter :: id_EOOH = 74 + integer, parameter :: id_F = 75 + integer, parameter :: id_GLYALD = 76 + integer, parameter :: id_GLYOXAL = 77 + integer, parameter :: id_H = 78 + integer, parameter :: id_H2 = 79 + integer, parameter :: id_H2402 = 80 + integer, parameter :: id_H2O2 = 81 + integer, parameter :: id_H2SO4 = 82 + integer, parameter :: id_HBR = 83 + integer, parameter :: id_HCFC141B = 84 + integer, parameter :: id_HCFC142B = 85 + integer, parameter :: id_HCFC22 = 86 + integer, parameter :: id_HCL = 87 + integer, parameter :: id_HCN = 88 + integer, parameter :: id_HCOCH2OOH = 89 + integer, parameter :: id_HCOOH = 90 + integer, parameter :: id_HF = 91 + integer, parameter :: id_HMHP = 92 + integer, parameter :: id_HNO3 = 93 + integer, parameter :: id_HO2NO2 = 94 + integer, parameter :: id_HOBR = 95 + integer, parameter :: id_HOCL = 96 + integer, parameter :: id_HONITR = 97 + integer, parameter :: id_HPALD1 = 98 + integer, parameter :: id_HPALD4 = 99 + integer, parameter :: id_HPALDB1C = 100 + integer, parameter :: id_HPALDB4C = 101 + integer, parameter :: id_HYAC = 102 + integer, parameter :: id_HYDRALD = 103 + integer, parameter :: id_HYPERACET = 104 + integer, parameter :: id_ICHE = 105 + integer, parameter :: id_IEPOX = 106 + integer, parameter :: id_INHEB = 107 + integer, parameter :: id_INHED = 108 + integer, parameter :: id_ISOP = 109 + integer, parameter :: id_ISOPFDN = 110 + integer, parameter :: id_ISOPFDNC = 111 + integer, parameter :: id_ISOPFNC = 112 + integer, parameter :: id_ISOPFNP = 113 + integer, parameter :: id_ISOPHFP = 114 + integer, parameter :: id_ISOPN1D = 115 + integer, parameter :: id_ISOPN2B = 116 + integer, parameter :: id_ISOPN3B = 117 + integer, parameter :: id_ISOPN4D = 118 + integer, parameter :: id_ISOPNBNO3 = 119 + integer, parameter :: id_ISOPNOOHB = 120 + integer, parameter :: id_ISOPNOOHD = 121 + integer, parameter :: id_ISOPOH = 122 + integer, parameter :: id_ISOPOOH = 123 + integer, parameter :: id_IVOC = 124 + integer, parameter :: id_LIMON = 125 + integer, parameter :: id_MACR = 126 + integer, parameter :: id_MACRN = 127 + integer, parameter :: id_MACROOH = 128 + integer, parameter :: id_MEK = 129 + integer, parameter :: id_MEKOOH = 130 + integer, parameter :: id_MPAN = 131 + integer, parameter :: id_MVK = 132 + integer, parameter :: id_MVKN = 133 + integer, parameter :: id_MVKOOH = 134 + integer, parameter :: id_MYRC = 135 + integer, parameter :: id_N = 136 + integer, parameter :: id_N2O = 137 + integer, parameter :: id_N2O5 = 138 + integer, parameter :: id_NC4CHO = 139 + integer, parameter :: id_ncl_a1 = 140 + integer, parameter :: id_ncl_a2 = 141 + integer, parameter :: id_ncl_a3 = 142 + integer, parameter :: id_NH3 = 143 + integer, parameter :: id_NH4 = 144 + integer, parameter :: id_NH_5 = 145 + integer, parameter :: id_NH_50 = 146 + integer, parameter :: id_NO = 147 + integer, parameter :: id_NO2 = 148 + integer, parameter :: id_NO3 = 149 + integer, parameter :: id_NO3CH2CHO = 150 + integer, parameter :: id_NOA = 151 + integer, parameter :: id_num_a1 = 152 + integer, parameter :: id_num_a2 = 153 + integer, parameter :: id_num_a3 = 154 + integer, parameter :: id_num_a4 = 155 + integer, parameter :: id_num_a5 = 156 + integer, parameter :: id_O = 157 + integer, parameter :: id_O3 = 158 + integer, parameter :: id_O3S = 159 + integer, parameter :: id_OCLO = 160 + integer, parameter :: id_OCS = 161 + integer, parameter :: id_ONITR = 162 + integer, parameter :: id_PAN = 163 + integer, parameter :: id_PBZNIT = 164 + integer, parameter :: id_PHENO = 165 + integer, parameter :: id_PHENOL = 166 + integer, parameter :: id_PHENOOH = 167 + integer, parameter :: id_pom_a1 = 168 + integer, parameter :: id_pom_a4 = 169 + integer, parameter :: id_POOH = 170 + integer, parameter :: id_ROOH = 171 + integer, parameter :: id_S = 172 + integer, parameter :: id_SF6 = 173 + integer, parameter :: id_SO = 174 + integer, parameter :: id_SO2 = 175 + integer, parameter :: id_SO3 = 176 + integer, parameter :: id_so4_a1 = 177 + integer, parameter :: id_so4_a2 = 178 + integer, parameter :: id_so4_a3 = 179 + integer, parameter :: id_so4_a5 = 180 + integer, parameter :: id_soa1_a1 = 181 + integer, parameter :: id_soa1_a2 = 182 + integer, parameter :: id_soa2_a1 = 183 + integer, parameter :: id_soa2_a2 = 184 + integer, parameter :: id_soa3_a1 = 185 + integer, parameter :: id_soa3_a2 = 186 + integer, parameter :: id_soa4_a1 = 187 + integer, parameter :: id_soa4_a2 = 188 + integer, parameter :: id_soa5_a1 = 189 + integer, parameter :: id_soa5_a2 = 190 + integer, parameter :: id_SOAG0 = 191 + integer, parameter :: id_SOAG1 = 192 + integer, parameter :: id_SOAG2 = 193 + integer, parameter :: id_SOAG3 = 194 + integer, parameter :: id_SOAG4 = 195 + integer, parameter :: id_SQTN = 196 + integer, parameter :: id_ST80_25 = 197 + integer, parameter :: id_SVOC = 198 + integer, parameter :: id_TEPOMUC = 199 + integer, parameter :: id_TERP1OOH = 200 + integer, parameter :: id_TERP2AOOH = 201 + integer, parameter :: id_TERPA = 202 + integer, parameter :: id_TERPA2 = 203 + integer, parameter :: id_TERPA2PAN = 204 + integer, parameter :: id_TERPA3 = 205 + integer, parameter :: id_TERPA3PAN = 206 + integer, parameter :: id_TERPACID = 207 + integer, parameter :: id_TERPACID2 = 208 + integer, parameter :: id_TERPACID3 = 209 + integer, parameter :: id_TERPAPAN = 210 + integer, parameter :: id_TERPDHDP = 211 + integer, parameter :: id_TERPF1 = 212 + integer, parameter :: id_TERPF2 = 213 + integer, parameter :: id_TERPFDN = 214 + integer, parameter :: id_TERPHFN = 215 + integer, parameter :: id_TERPK = 216 + integer, parameter :: id_TERPNPS = 217 + integer, parameter :: id_TERPNPS1 = 218 + integer, parameter :: id_TERPNPT = 219 + integer, parameter :: id_TERPNPT1 = 220 + integer, parameter :: id_TERPNS = 221 + integer, parameter :: id_TERPNS1 = 222 + integer, parameter :: id_TERPNT = 223 + integer, parameter :: id_TERPNT1 = 224 + integer, parameter :: id_TERPOOH = 225 + integer, parameter :: id_TERPOOHL = 226 + integer, parameter :: id_TOLOOH = 227 + integer, parameter :: id_TOLUENE = 228 + integer, parameter :: id_XYLENES = 229 + integer, parameter :: id_XYLENOOH = 230 + integer, parameter :: id_XYLOL = 231 + integer, parameter :: id_XYLOLOOH = 232 + integer, parameter :: id_NHDEP = 233 + integer, parameter :: id_NDEP = 234 + integer, parameter :: id_ACBZO2 = 235 + integer, parameter :: id_ALKO2 = 236 + integer, parameter :: id_APINNO3 = 237 + integer, parameter :: id_APINO2 = 238 + integer, parameter :: id_APINO2VBS = 239 + integer, parameter :: id_BCARYNO3 = 240 + integer, parameter :: id_BCARYO2 = 241 + integer, parameter :: id_BCARYO2VBS = 242 + integer, parameter :: id_BENZO2 = 243 + integer, parameter :: id_BENZO2VBS = 244 + integer, parameter :: id_BPINNO3 = 245 + integer, parameter :: id_BPINO2 = 246 + integer, parameter :: id_BPINO2VBS = 247 + integer, parameter :: id_BZOO = 248 + integer, parameter :: id_C2H5O2 = 249 + integer, parameter :: id_C3H7O2 = 250 + integer, parameter :: id_C6H5O2 = 251 + integer, parameter :: id_CH3CO3 = 252 + integer, parameter :: id_CH3O2 = 253 + integer, parameter :: id_DICARBO2 = 254 + integer, parameter :: id_ENEO2 = 255 + integer, parameter :: id_EO = 256 + integer, parameter :: id_EO2 = 257 + integer, parameter :: id_HO2 = 258 + integer, parameter :: id_HOCH2OO = 259 + integer, parameter :: id_IEPOXOO = 260 + integer, parameter :: id_ISOPB1O2 = 261 + integer, parameter :: id_ISOPB4O2 = 262 + integer, parameter :: id_ISOPC1C = 263 + integer, parameter :: id_ISOPC1T = 264 + integer, parameter :: id_ISOPC4C = 265 + integer, parameter :: id_ISOPC4T = 266 + integer, parameter :: id_ISOPED1O2 = 267 + integer, parameter :: id_ISOPED4O2 = 268 + integer, parameter :: id_ISOPN1DO2 = 269 + integer, parameter :: id_ISOPN2BO2 = 270 + integer, parameter :: id_ISOPN3BO2 = 271 + integer, parameter :: id_ISOPN4DO2 = 272 + integer, parameter :: id_ISOPNBNO3O2 = 273 + integer, parameter :: id_ISOPNO3 = 274 + integer, parameter :: id_ISOPNOOHBO2 = 275 + integer, parameter :: id_ISOPNOOHDO2 = 276 + integer, parameter :: id_ISOPO2VBS = 277 + integer, parameter :: id_ISOPZD1O2 = 278 + integer, parameter :: id_ISOPZD4O2 = 279 + integer, parameter :: id_IVOCO2VBS = 280 + integer, parameter :: id_LIMONNO3 = 281 + integer, parameter :: id_LIMONO2 = 282 + integer, parameter :: id_LIMONO2VBS = 283 + integer, parameter :: id_MACRO2 = 284 + integer, parameter :: id_MALO2 = 285 + integer, parameter :: id_MCO3 = 286 + integer, parameter :: id_MDIALO2 = 287 + integer, parameter :: id_MEKO2 = 288 + integer, parameter :: id_MVKO2 = 289 + integer, parameter :: id_MYRCNO3 = 290 + integer, parameter :: id_MYRCO2 = 291 + integer, parameter :: id_MYRCO2VBS = 292 + integer, parameter :: id_NC4CHOO2 = 293 + integer, parameter :: id_O1D = 294 + integer, parameter :: id_OH = 295 + integer, parameter :: id_PHENO2 = 296 + integer, parameter :: id_PO2 = 297 + integer, parameter :: id_RO2 = 298 + integer, parameter :: id_TERP1OOHO2 = 299 + integer, parameter :: id_TERP2OOHO2 = 300 + integer, parameter :: id_TERPA1O2 = 301 + integer, parameter :: id_TERPA2CO3 = 302 + integer, parameter :: id_TERPA2O2 = 303 + integer, parameter :: id_TERPA3CO3 = 304 + integer, parameter :: id_TERPA3O2 = 305 + integer, parameter :: id_TERPA4O2 = 306 + integer, parameter :: id_TERPACO3 = 307 + integer, parameter :: id_TERPF1O2 = 308 + integer, parameter :: id_TERPF2O2 = 309 + integer, parameter :: id_TERPNPS1O2 = 310 + integer, parameter :: id_TERPNPT1O2 = 311 + integer, parameter :: id_TERPNS1O2 = 312 + integer, parameter :: id_TERPNT1O2 = 313 + integer, parameter :: id_TOLO2 = 314 + integer, parameter :: id_TOLUO2VBS = 315 + integer, parameter :: id_XYLENO2 = 316 + integer, parameter :: id_XYLEO2VBS = 317 + integer, parameter :: id_XYLOLO2 = 318 + integer, parameter :: id_H2O = 319 + end module m_spc_id diff --git a/src/chemistry/pp_trop_strat_mam5_ts2/mo_adjrxt.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/mo_adjrxt.F90 new file mode 100644 index 0000000000..76faad3d2d --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/mo_adjrxt.F90 @@ -0,0 +1,716 @@ + 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(:,:, 170) = rate(:,:, 170) * inv(:,:, 3) + rate(:,:, 171) = rate(:,:, 171) * inv(:,:, 2) + rate(:,:, 174) = rate(:,:, 174) * inv(:,:, 1) + rate(:,:, 191) = rate(:,:, 191) * inv(:,:, 1) + rate(:,:, 198) = rate(:,:, 198) * inv(:,:, 2) + rate(:,:, 201) = rate(:,:, 201) * inv(:,:, 1) + rate(:,:, 209) = rate(:,:, 209) * inv(:,:, 1) + rate(:,:, 212) = rate(:,:, 212) * inv(:,:, 1) + rate(:,:, 213) = rate(:,:, 213) * inv(:,:, 1) + rate(:,:, 214) = rate(:,:, 214) * inv(:,:, 1) + rate(:,:, 216) = rate(:,:, 216) * inv(:,:, 1) + rate(:,:, 217) = rate(:,:, 217) * inv(:,:, 1) + rate(:,:, 232) = rate(:,:, 232) * inv(:,:, 1) + rate(:,:, 252) = rate(:,:, 252) * inv(:,:, 1) + rate(:,:, 253) = rate(:,:, 253) * inv(:,:, 1) + rate(:,:, 263) = rate(:,:, 263) * inv(:,:, 1) + rate(:,:, 309) = rate(:,:, 309) * inv(:,:, 1) + rate(:,:, 320) = rate(:,:, 320) * inv(:,:, 1) + rate(:,:, 321) = rate(:,:, 321) * inv(:,:, 1) + rate(:,:, 322) = rate(:,:, 322) * inv(:,:, 1) + rate(:,:, 344) = rate(:,:, 344) * inv(:,:, 2) + rate(:,:, 350) = rate(:,:, 350) * inv(:,:, 1) + rate(:,:, 351) = rate(:,:, 351) * inv(:,:, 1) + rate(:,:, 352) = rate(:,:, 352) * inv(:,:, 1) + rate(:,:, 372) = rate(:,:, 372) * inv(:,:, 1) + rate(:,:, 398) = rate(:,:, 398) * inv(:,:, 1) + rate(:,:, 406) = rate(:,:, 406) * inv(:,:, 1) + rate(:,:, 407) = rate(:,:, 407) * inv(:,:, 1) + rate(:,:, 436) = rate(:,:, 436) * inv(:,:, 2) + rate(:,:, 437) = rate(:,:, 437) * inv(:,:, 2) + rate(:,:, 438) = rate(:,:, 438) * inv(:,:, 2) + rate(:,:, 439) = rate(:,:, 439) * inv(:,:, 2) + rate(:,:, 440) = rate(:,:, 440) * inv(:,:, 2) + rate(:,:, 441) = rate(:,:, 441) * inv(:,:, 2) + rate(:,:, 442) = rate(:,:, 442) * inv(:,:, 2) + rate(:,:, 443) = rate(:,:, 443) * inv(:,:, 2) + rate(:,:, 557) = rate(:,:, 557) * inv(:,:, 1) + rate(:,:, 560) = rate(:,:, 560) * inv(:,:, 1) + rate(:,:, 563) = rate(:,:, 563) * inv(:,:, 1) + rate(:,:, 570) = rate(:,:, 570) * inv(:,:, 1) + rate(:,:, 575) = rate(:,:, 575) * inv(:,:, 1) + rate(:,:, 684) = rate(:,:, 684) * inv(:,:, 1) + rate(:,:, 685) = rate(:,:, 685) * inv(:,:, 1) + rate(:,:, 686) = rate(:,:, 686) * inv(:,:, 1) + rate(:,:, 790) = rate(:,:, 790) * inv(:,:, 1) + rate(:,:, 791) = rate(:,:, 791) * inv(:,:, 1) + rate(:,:, 792) = rate(:,:, 792) * inv(:,:, 1) + rate(:,:, 797) = rate(:,:, 797) * inv(:,:, 2) + rate(:,:, 798) = rate(:,:, 798) * inv(:,:, 1) + rate(:,:, 804) = rate(:,:, 804) * inv(:,:, 2) + rate(:,:, 175) = rate(:,:, 175) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 181) = rate(:,:, 181) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 168) = rate(:,:, 168) * m(:,:) + rate(:,:, 169) = rate(:,:, 169) * m(:,:) + rate(:,:, 172) = rate(:,:, 172) * m(:,:) + rate(:,:, 173) = rate(:,:, 173) * m(:,:) + rate(:,:, 174) = rate(:,:, 174) * 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(:,:, 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(:,:, 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(:,:, 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * 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(:,:, 252) = rate(:,:, 252) * 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(:,:, 292) = rate(:,:, 292) * 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(:,:, 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(:,:, 322) = rate(:,:, 322) * 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(:,:, 329) = rate(:,:, 329) * 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(:,:, 336) = rate(:,:, 336) * m(:,:) + rate(:,:, 337) = rate(:,:, 337) * m(:,:) + rate(:,:, 338) = rate(:,:, 338) * m(:,:) + rate(:,:, 339) = rate(:,:, 339) * m(:,:) + rate(:,:, 340) = rate(:,:, 340) * m(:,:) + rate(:,:, 341) = rate(:,:, 341) * m(:,:) + rate(:,:, 342) = rate(:,:, 342) * m(:,:) + rate(:,:, 345) = rate(:,:, 345) * m(:,:) + rate(:,:, 346) = rate(:,:, 346) * m(:,:) + rate(:,:, 347) = rate(:,:, 347) * m(:,:) + rate(:,:, 348) = rate(:,:, 348) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 353) = rate(:,:, 353) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 357) = rate(:,:, 357) * m(:,:) + rate(:,:, 358) = rate(:,:, 358) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + rate(:,:, 360) = rate(:,:, 360) * m(:,:) + rate(:,:, 361) = rate(:,:, 361) * m(:,:) + rate(:,:, 362) = rate(:,:, 362) * m(:,:) + rate(:,:, 363) = rate(:,:, 363) * m(:,:) + rate(:,:, 364) = rate(:,:, 364) * m(:,:) + rate(:,:, 365) = rate(:,:, 365) * m(:,:) + rate(:,:, 366) = rate(:,:, 366) * m(:,:) + rate(:,:, 367) = rate(:,:, 367) * m(:,:) + rate(:,:, 368) = rate(:,:, 368) * m(:,:) + rate(:,:, 369) = rate(:,:, 369) * m(:,:) + rate(:,:, 370) = rate(:,:, 370) * m(:,:) + rate(:,:, 371) = rate(:,:, 371) * m(:,:) + rate(:,:, 372) = rate(:,:, 372) * m(:,:) + rate(:,:, 373) = rate(:,:, 373) * m(:,:) + rate(:,:, 374) = rate(:,:, 374) * m(:,:) + rate(:,:, 375) = rate(:,:, 375) * m(:,:) + rate(:,:, 376) = rate(:,:, 376) * m(:,:) + rate(:,:, 377) = rate(:,:, 377) * m(:,:) + rate(:,:, 378) = rate(:,:, 378) * m(:,:) + rate(:,:, 379) = rate(:,:, 379) * m(:,:) + rate(:,:, 380) = rate(:,:, 380) * m(:,:) + rate(:,:, 381) = rate(:,:, 381) * m(:,:) + rate(:,:, 382) = rate(:,:, 382) * m(:,:) + rate(:,:, 383) = rate(:,:, 383) * m(:,:) + rate(:,:, 385) = rate(:,:, 385) * m(:,:) + rate(:,:, 386) = rate(:,:, 386) * m(:,:) + rate(:,:, 387) = rate(:,:, 387) * m(:,:) + rate(:,:, 388) = rate(:,:, 388) * m(:,:) + rate(:,:, 389) = rate(:,:, 389) * m(:,:) + rate(:,:, 390) = rate(:,:, 390) * m(:,:) + rate(:,:, 391) = rate(:,:, 391) * m(:,:) + rate(:,:, 392) = rate(:,:, 392) * m(:,:) + rate(:,:, 393) = rate(:,:, 393) * m(:,:) + rate(:,:, 394) = rate(:,:, 394) * m(:,:) + rate(:,:, 395) = rate(:,:, 395) * m(:,:) + rate(:,:, 396) = rate(:,:, 396) * m(:,:) + rate(:,:, 397) = rate(:,:, 397) * m(:,:) + rate(:,:, 398) = rate(:,:, 398) * m(:,:) + rate(:,:, 399) = rate(:,:, 399) * m(:,:) + rate(:,:, 400) = rate(:,:, 400) * m(:,:) + rate(:,:, 401) = rate(:,:, 401) * m(:,:) + rate(:,:, 402) = rate(:,:, 402) * m(:,:) + rate(:,:, 403) = rate(:,:, 403) * m(:,:) + rate(:,:, 404) = rate(:,:, 404) * m(:,:) + rate(:,:, 405) = rate(:,:, 405) * m(:,:) + rate(:,:, 406) = rate(:,:, 406) * m(:,:) + rate(:,:, 408) = rate(:,:, 408) * m(:,:) + rate(:,:, 409) = rate(:,:, 409) * m(:,:) + rate(:,:, 410) = rate(:,:, 410) * m(:,:) + rate(:,:, 411) = rate(:,:, 411) * m(:,:) + rate(:,:, 412) = rate(:,:, 412) * m(:,:) + rate(:,:, 413) = rate(:,:, 413) * m(:,:) + rate(:,:, 414) = rate(:,:, 414) * m(:,:) + rate(:,:, 415) = rate(:,:, 415) * m(:,:) + rate(:,:, 416) = rate(:,:, 416) * m(:,:) + rate(:,:, 417) = rate(:,:, 417) * m(:,:) + rate(:,:, 418) = rate(:,:, 418) * m(:,:) + rate(:,:, 419) = rate(:,:, 419) * m(:,:) + rate(:,:, 420) = rate(:,:, 420) * m(:,:) + rate(:,:, 421) = rate(:,:, 421) * m(:,:) + rate(:,:, 422) = rate(:,:, 422) * m(:,:) + rate(:,:, 423) = rate(:,:, 423) * m(:,:) + rate(:,:, 424) = rate(:,:, 424) * m(:,:) + rate(:,:, 425) = rate(:,:, 425) * m(:,:) + rate(:,:, 426) = rate(:,:, 426) * m(:,:) + rate(:,:, 430) = rate(:,:, 430) * m(:,:) + rate(:,:, 431) = rate(:,:, 431) * m(:,:) + rate(:,:, 432) = rate(:,:, 432) * m(:,:) + rate(:,:, 444) = rate(:,:, 444) * m(:,:) + rate(:,:, 445) = rate(:,:, 445) * m(:,:) + rate(:,:, 446) = rate(:,:, 446) * m(:,:) + rate(:,:, 448) = rate(:,:, 448) * m(:,:) + rate(:,:, 449) = rate(:,:, 449) * m(:,:) + rate(:,:, 450) = rate(:,:, 450) * m(:,:) + rate(:,:, 452) = rate(:,:, 452) * m(:,:) + rate(:,:, 453) = rate(:,:, 453) * m(:,:) + rate(:,:, 454) = rate(:,:, 454) * m(:,:) + rate(:,:, 455) = rate(:,:, 455) * m(:,:) + rate(:,:, 456) = rate(:,:, 456) * m(:,:) + rate(:,:, 457) = rate(:,:, 457) * m(:,:) + rate(:,:, 459) = rate(:,:, 459) * m(:,:) + rate(:,:, 460) = rate(:,:, 460) * m(:,:) + rate(:,:, 461) = rate(:,:, 461) * m(:,:) + rate(:,:, 463) = rate(:,:, 463) * m(:,:) + rate(:,:, 464) = rate(:,:, 464) * m(:,:) + rate(:,:, 466) = rate(:,:, 466) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * m(:,:) + rate(:,:, 469) = rate(:,:, 469) * m(:,:) + rate(:,:, 470) = rate(:,:, 470) * m(:,:) + rate(:,:, 471) = rate(:,:, 471) * m(:,:) + rate(:,:, 472) = rate(:,:, 472) * m(:,:) + rate(:,:, 473) = rate(:,:, 473) * m(:,:) + rate(:,:, 474) = rate(:,:, 474) * m(:,:) + rate(:,:, 475) = rate(:,:, 475) * m(:,:) + rate(:,:, 476) = rate(:,:, 476) * m(:,:) + rate(:,:, 477) = rate(:,:, 477) * m(:,:) + rate(:,:, 478) = rate(:,:, 478) * m(:,:) + rate(:,:, 479) = rate(:,:, 479) * m(:,:) + rate(:,:, 481) = rate(:,:, 481) * m(:,:) + rate(:,:, 482) = rate(:,:, 482) * m(:,:) + rate(:,:, 484) = rate(:,:, 484) * m(:,:) + rate(:,:, 485) = rate(:,:, 485) * m(:,:) + rate(:,:, 486) = rate(:,:, 486) * m(:,:) + rate(:,:, 487) = rate(:,:, 487) * m(:,:) + rate(:,:, 488) = rate(:,:, 488) * m(:,:) + rate(:,:, 489) = rate(:,:, 489) * m(:,:) + rate(:,:, 490) = rate(:,:, 490) * m(:,:) + rate(:,:, 491) = rate(:,:, 491) * m(:,:) + rate(:,:, 492) = rate(:,:, 492) * m(:,:) + rate(:,:, 493) = rate(:,:, 493) * m(:,:) + rate(:,:, 495) = rate(:,:, 495) * m(:,:) + rate(:,:, 496) = rate(:,:, 496) * m(:,:) + rate(:,:, 497) = rate(:,:, 497) * m(:,:) + rate(:,:, 499) = rate(:,:, 499) * m(:,:) + rate(:,:, 501) = rate(:,:, 501) * m(:,:) + rate(:,:, 502) = rate(:,:, 502) * m(:,:) + rate(:,:, 503) = rate(:,:, 503) * m(:,:) + rate(:,:, 504) = rate(:,:, 504) * m(:,:) + rate(:,:, 505) = rate(:,:, 505) * m(:,:) + rate(:,:, 506) = rate(:,:, 506) * m(:,:) + rate(:,:, 507) = rate(:,:, 507) * m(:,:) + rate(:,:, 508) = rate(:,:, 508) * m(:,:) + rate(:,:, 509) = rate(:,:, 509) * m(:,:) + rate(:,:, 510) = rate(:,:, 510) * m(:,:) + rate(:,:, 511) = rate(:,:, 511) * m(:,:) + rate(:,:, 512) = rate(:,:, 512) * m(:,:) + rate(:,:, 513) = rate(:,:, 513) * m(:,:) + rate(:,:, 514) = rate(:,:, 514) * m(:,:) + rate(:,:, 515) = rate(:,:, 515) * m(:,:) + rate(:,:, 516) = rate(:,:, 516) * m(:,:) + rate(:,:, 517) = rate(:,:, 517) * m(:,:) + rate(:,:, 518) = rate(:,:, 518) * m(:,:) + rate(:,:, 519) = rate(:,:, 519) * m(:,:) + rate(:,:, 520) = rate(:,:, 520) * m(:,:) + rate(:,:, 521) = rate(:,:, 521) * m(:,:) + rate(:,:, 522) = rate(:,:, 522) * m(:,:) + rate(:,:, 523) = rate(:,:, 523) * m(:,:) + rate(:,:, 524) = rate(:,:, 524) * m(:,:) + rate(:,:, 525) = rate(:,:, 525) * m(:,:) + rate(:,:, 526) = rate(:,:, 526) * m(:,:) + rate(:,:, 527) = rate(:,:, 527) * m(:,:) + rate(:,:, 528) = rate(:,:, 528) * m(:,:) + rate(:,:, 530) = rate(:,:, 530) * m(:,:) + rate(:,:, 531) = rate(:,:, 531) * m(:,:) + rate(:,:, 533) = rate(:,:, 533) * m(:,:) + rate(:,:, 534) = rate(:,:, 534) * m(:,:) + rate(:,:, 535) = rate(:,:, 535) * m(:,:) + rate(:,:, 536) = rate(:,:, 536) * m(:,:) + rate(:,:, 537) = rate(:,:, 537) * m(:,:) + rate(:,:, 538) = rate(:,:, 538) * m(:,:) + rate(:,:, 539) = rate(:,:, 539) * m(:,:) + rate(:,:, 540) = rate(:,:, 540) * m(:,:) + rate(:,:, 541) = rate(:,:, 541) * m(:,:) + rate(:,:, 542) = rate(:,:, 542) * m(:,:) + rate(:,:, 543) = rate(:,:, 543) * m(:,:) + rate(:,:, 544) = rate(:,:, 544) * m(:,:) + rate(:,:, 545) = rate(:,:, 545) * m(:,:) + rate(:,:, 546) = rate(:,:, 546) * m(:,:) + rate(:,:, 547) = rate(:,:, 547) * m(:,:) + rate(:,:, 548) = rate(:,:, 548) * m(:,:) + rate(:,:, 549) = rate(:,:, 549) * m(:,:) + rate(:,:, 550) = rate(:,:, 550) * m(:,:) + rate(:,:, 551) = rate(:,:, 551) * m(:,:) + rate(:,:, 552) = rate(:,:, 552) * m(:,:) + rate(:,:, 553) = rate(:,:, 553) * m(:,:) + rate(:,:, 554) = rate(:,:, 554) * m(:,:) + rate(:,:, 555) = rate(:,:, 555) * m(:,:) + rate(:,:, 556) = rate(:,:, 556) * m(:,:) + rate(:,:, 557) = rate(:,:, 557) * m(:,:) + rate(:,:, 558) = rate(:,:, 558) * m(:,:) + rate(:,:, 559) = rate(:,:, 559) * m(:,:) + rate(:,:, 560) = rate(:,:, 560) * m(:,:) + rate(:,:, 561) = rate(:,:, 561) * m(:,:) + rate(:,:, 562) = rate(:,:, 562) * m(:,:) + rate(:,:, 563) = rate(:,:, 563) * m(:,:) + rate(:,:, 564) = rate(:,:, 564) * m(:,:) + rate(:,:, 565) = rate(:,:, 565) * m(:,:) + rate(:,:, 566) = rate(:,:, 566) * m(:,:) + rate(:,:, 567) = rate(:,:, 567) * m(:,:) + rate(:,:, 568) = rate(:,:, 568) * m(:,:) + rate(:,:, 569) = rate(:,:, 569) * m(:,:) + rate(:,:, 570) = rate(:,:, 570) * m(:,:) + rate(:,:, 571) = rate(:,:, 571) * m(:,:) + rate(:,:, 572) = rate(:,:, 572) * m(:,:) + rate(:,:, 573) = rate(:,:, 573) * m(:,:) + rate(:,:, 574) = rate(:,:, 574) * m(:,:) + rate(:,:, 576) = rate(:,:, 576) * m(:,:) + rate(:,:, 577) = rate(:,:, 577) * m(:,:) + rate(:,:, 578) = rate(:,:, 578) * m(:,:) + rate(:,:, 579) = rate(:,:, 579) * m(:,:) + rate(:,:, 580) = rate(:,:, 580) * m(:,:) + rate(:,:, 581) = rate(:,:, 581) * m(:,:) + rate(:,:, 582) = rate(:,:, 582) * m(:,:) + rate(:,:, 583) = rate(:,:, 583) * m(:,:) + rate(:,:, 584) = rate(:,:, 584) * m(:,:) + rate(:,:, 585) = rate(:,:, 585) * m(:,:) + rate(:,:, 586) = rate(:,:, 586) * m(:,:) + rate(:,:, 587) = rate(:,:, 587) * m(:,:) + rate(:,:, 588) = rate(:,:, 588) * m(:,:) + rate(:,:, 589) = rate(:,:, 589) * m(:,:) + rate(:,:, 590) = rate(:,:, 590) * m(:,:) + rate(:,:, 591) = rate(:,:, 591) * m(:,:) + rate(:,:, 592) = rate(:,:, 592) * m(:,:) + rate(:,:, 593) = rate(:,:, 593) * m(:,:) + rate(:,:, 594) = rate(:,:, 594) * m(:,:) + rate(:,:, 595) = rate(:,:, 595) * m(:,:) + rate(:,:, 596) = rate(:,:, 596) * m(:,:) + rate(:,:, 597) = rate(:,:, 597) * m(:,:) + rate(:,:, 598) = rate(:,:, 598) * m(:,:) + rate(:,:, 599) = rate(:,:, 599) * m(:,:) + rate(:,:, 600) = rate(:,:, 600) * m(:,:) + rate(:,:, 601) = rate(:,:, 601) * m(:,:) + rate(:,:, 602) = rate(:,:, 602) * m(:,:) + rate(:,:, 603) = rate(:,:, 603) * m(:,:) + rate(:,:, 604) = rate(:,:, 604) * m(:,:) + rate(:,:, 605) = rate(:,:, 605) * m(:,:) + rate(:,:, 606) = rate(:,:, 606) * m(:,:) + rate(:,:, 607) = rate(:,:, 607) * m(:,:) + rate(:,:, 608) = rate(:,:, 608) * m(:,:) + rate(:,:, 609) = rate(:,:, 609) * m(:,:) + rate(:,:, 610) = rate(:,:, 610) * m(:,:) + rate(:,:, 611) = rate(:,:, 611) * m(:,:) + rate(:,:, 612) = rate(:,:, 612) * m(:,:) + rate(:,:, 613) = rate(:,:, 613) * m(:,:) + rate(:,:, 614) = rate(:,:, 614) * m(:,:) + rate(:,:, 615) = rate(:,:, 615) * m(:,:) + rate(:,:, 616) = rate(:,:, 616) * m(:,:) + rate(:,:, 617) = rate(:,:, 617) * m(:,:) + rate(:,:, 618) = rate(:,:, 618) * m(:,:) + rate(:,:, 619) = rate(:,:, 619) * m(:,:) + rate(:,:, 620) = rate(:,:, 620) * m(:,:) + rate(:,:, 621) = rate(:,:, 621) * m(:,:) + rate(:,:, 622) = rate(:,:, 622) * m(:,:) + rate(:,:, 623) = rate(:,:, 623) * m(:,:) + rate(:,:, 624) = rate(:,:, 624) * m(:,:) + rate(:,:, 625) = rate(:,:, 625) * m(:,:) + rate(:,:, 626) = rate(:,:, 626) * m(:,:) + rate(:,:, 627) = rate(:,:, 627) * m(:,:) + rate(:,:, 628) = rate(:,:, 628) * m(:,:) + rate(:,:, 629) = rate(:,:, 629) * m(:,:) + rate(:,:, 630) = rate(:,:, 630) * m(:,:) + rate(:,:, 631) = rate(:,:, 631) * m(:,:) + rate(:,:, 632) = rate(:,:, 632) * m(:,:) + rate(:,:, 633) = rate(:,:, 633) * m(:,:) + rate(:,:, 634) = rate(:,:, 634) * m(:,:) + rate(:,:, 635) = rate(:,:, 635) * m(:,:) + rate(:,:, 636) = rate(:,:, 636) * m(:,:) + rate(:,:, 637) = rate(:,:, 637) * m(:,:) + rate(:,:, 638) = rate(:,:, 638) * m(:,:) + rate(:,:, 639) = rate(:,:, 639) * m(:,:) + rate(:,:, 640) = rate(:,:, 640) * m(:,:) + rate(:,:, 641) = rate(:,:, 641) * m(:,:) + rate(:,:, 642) = rate(:,:, 642) * m(:,:) + rate(:,:, 643) = rate(:,:, 643) * m(:,:) + rate(:,:, 644) = rate(:,:, 644) * m(:,:) + rate(:,:, 645) = rate(:,:, 645) * m(:,:) + rate(:,:, 646) = rate(:,:, 646) * m(:,:) + rate(:,:, 647) = rate(:,:, 647) * m(:,:) + rate(:,:, 648) = rate(:,:, 648) * m(:,:) + rate(:,:, 649) = rate(:,:, 649) * m(:,:) + rate(:,:, 650) = rate(:,:, 650) * m(:,:) + rate(:,:, 651) = rate(:,:, 651) * m(:,:) + rate(:,:, 652) = rate(:,:, 652) * m(:,:) + rate(:,:, 653) = rate(:,:, 653) * m(:,:) + rate(:,:, 654) = rate(:,:, 654) * m(:,:) + rate(:,:, 655) = rate(:,:, 655) * m(:,:) + rate(:,:, 656) = rate(:,:, 656) * m(:,:) + rate(:,:, 657) = rate(:,:, 657) * m(:,:) + rate(:,:, 658) = rate(:,:, 658) * m(:,:) + rate(:,:, 659) = rate(:,:, 659) * m(:,:) + rate(:,:, 660) = rate(:,:, 660) * m(:,:) + rate(:,:, 661) = rate(:,:, 661) * m(:,:) + rate(:,:, 662) = rate(:,:, 662) * m(:,:) + rate(:,:, 663) = rate(:,:, 663) * m(:,:) + rate(:,:, 664) = rate(:,:, 664) * m(:,:) + rate(:,:, 665) = rate(:,:, 665) * m(:,:) + rate(:,:, 666) = rate(:,:, 666) * m(:,:) + rate(:,:, 667) = rate(:,:, 667) * m(:,:) + rate(:,:, 668) = rate(:,:, 668) * m(:,:) + rate(:,:, 669) = rate(:,:, 669) * m(:,:) + rate(:,:, 670) = rate(:,:, 670) * m(:,:) + rate(:,:, 671) = rate(:,:, 671) * m(:,:) + rate(:,:, 672) = rate(:,:, 672) * m(:,:) + rate(:,:, 673) = rate(:,:, 673) * m(:,:) + rate(:,:, 674) = rate(:,:, 674) * m(:,:) + rate(:,:, 675) = rate(:,:, 675) * m(:,:) + rate(:,:, 676) = rate(:,:, 676) * m(:,:) + rate(:,:, 677) = rate(:,:, 677) * m(:,:) + rate(:,:, 678) = rate(:,:, 678) * m(:,:) + rate(:,:, 679) = rate(:,:, 679) * m(:,:) + rate(:,:, 680) = rate(:,:, 680) * m(:,:) + rate(:,:, 681) = rate(:,:, 681) * m(:,:) + rate(:,:, 682) = rate(:,:, 682) * m(:,:) + rate(:,:, 683) = rate(:,:, 683) * m(:,:) + rate(:,:, 684) = rate(:,:, 684) * m(:,:) + rate(:,:, 685) = rate(:,:, 685) * m(:,:) + rate(:,:, 686) = rate(:,:, 686) * m(:,:) + rate(:,:, 687) = rate(:,:, 687) * m(:,:) + rate(:,:, 688) = rate(:,:, 688) * m(:,:) + rate(:,:, 689) = rate(:,:, 689) * m(:,:) + rate(:,:, 690) = rate(:,:, 690) * m(:,:) + rate(:,:, 691) = rate(:,:, 691) * m(:,:) + rate(:,:, 692) = rate(:,:, 692) * m(:,:) + rate(:,:, 693) = rate(:,:, 693) * m(:,:) + rate(:,:, 694) = rate(:,:, 694) * m(:,:) + rate(:,:, 695) = rate(:,:, 695) * m(:,:) + rate(:,:, 696) = rate(:,:, 696) * m(:,:) + rate(:,:, 697) = rate(:,:, 697) * m(:,:) + rate(:,:, 698) = rate(:,:, 698) * m(:,:) + rate(:,:, 699) = rate(:,:, 699) * m(:,:) + rate(:,:, 700) = rate(:,:, 700) * m(:,:) + rate(:,:, 701) = rate(:,:, 701) * m(:,:) + rate(:,:, 702) = rate(:,:, 702) * m(:,:) + rate(:,:, 703) = rate(:,:, 703) * m(:,:) + rate(:,:, 704) = rate(:,:, 704) * m(:,:) + rate(:,:, 705) = rate(:,:, 705) * m(:,:) + rate(:,:, 706) = rate(:,:, 706) * m(:,:) + rate(:,:, 707) = rate(:,:, 707) * m(:,:) + rate(:,:, 708) = rate(:,:, 708) * m(:,:) + rate(:,:, 709) = rate(:,:, 709) * m(:,:) + rate(:,:, 710) = rate(:,:, 710) * m(:,:) + rate(:,:, 711) = rate(:,:, 711) * m(:,:) + rate(:,:, 712) = rate(:,:, 712) * m(:,:) + rate(:,:, 713) = rate(:,:, 713) * m(:,:) + rate(:,:, 714) = rate(:,:, 714) * m(:,:) + rate(:,:, 715) = rate(:,:, 715) * m(:,:) + rate(:,:, 716) = rate(:,:, 716) * m(:,:) + rate(:,:, 717) = rate(:,:, 717) * m(:,:) + rate(:,:, 718) = rate(:,:, 718) * m(:,:) + rate(:,:, 719) = rate(:,:, 719) * m(:,:) + rate(:,:, 720) = rate(:,:, 720) * m(:,:) + rate(:,:, 721) = rate(:,:, 721) * m(:,:) + rate(:,:, 722) = rate(:,:, 722) * m(:,:) + rate(:,:, 723) = rate(:,:, 723) * m(:,:) + rate(:,:, 724) = rate(:,:, 724) * m(:,:) + rate(:,:, 725) = rate(:,:, 725) * m(:,:) + rate(:,:, 726) = rate(:,:, 726) * m(:,:) + rate(:,:, 727) = rate(:,:, 727) * m(:,:) + rate(:,:, 728) = rate(:,:, 728) * m(:,:) + rate(:,:, 729) = rate(:,:, 729) * m(:,:) + rate(:,:, 730) = rate(:,:, 730) * m(:,:) + rate(:,:, 731) = rate(:,:, 731) * m(:,:) + rate(:,:, 732) = rate(:,:, 732) * m(:,:) + rate(:,:, 733) = rate(:,:, 733) * m(:,:) + rate(:,:, 734) = rate(:,:, 734) * m(:,:) + rate(:,:, 735) = rate(:,:, 735) * m(:,:) + rate(:,:, 736) = rate(:,:, 736) * m(:,:) + rate(:,:, 737) = rate(:,:, 737) * m(:,:) + rate(:,:, 738) = rate(:,:, 738) * m(:,:) + rate(:,:, 739) = rate(:,:, 739) * m(:,:) + rate(:,:, 740) = rate(:,:, 740) * m(:,:) + rate(:,:, 741) = rate(:,:, 741) * m(:,:) + rate(:,:, 742) = rate(:,:, 742) * m(:,:) + rate(:,:, 743) = rate(:,:, 743) * m(:,:) + rate(:,:, 744) = rate(:,:, 744) * m(:,:) + rate(:,:, 745) = rate(:,:, 745) * m(:,:) + rate(:,:, 746) = rate(:,:, 746) * m(:,:) + rate(:,:, 747) = rate(:,:, 747) * m(:,:) + rate(:,:, 748) = rate(:,:, 748) * m(:,:) + rate(:,:, 749) = rate(:,:, 749) * m(:,:) + rate(:,:, 750) = rate(:,:, 750) * m(:,:) + rate(:,:, 751) = rate(:,:, 751) * m(:,:) + rate(:,:, 752) = rate(:,:, 752) * m(:,:) + rate(:,:, 753) = rate(:,:, 753) * m(:,:) + rate(:,:, 754) = rate(:,:, 754) * m(:,:) + rate(:,:, 755) = rate(:,:, 755) * m(:,:) + rate(:,:, 756) = rate(:,:, 756) * m(:,:) + rate(:,:, 757) = rate(:,:, 757) * m(:,:) + rate(:,:, 758) = rate(:,:, 758) * m(:,:) + rate(:,:, 759) = rate(:,:, 759) * m(:,:) + rate(:,:, 760) = rate(:,:, 760) * m(:,:) + rate(:,:, 761) = rate(:,:, 761) * m(:,:) + rate(:,:, 762) = rate(:,:, 762) * m(:,:) + rate(:,:, 763) = rate(:,:, 763) * m(:,:) + rate(:,:, 764) = rate(:,:, 764) * m(:,:) + rate(:,:, 765) = rate(:,:, 765) * m(:,:) + rate(:,:, 766) = rate(:,:, 766) * m(:,:) + rate(:,:, 767) = rate(:,:, 767) * m(:,:) + rate(:,:, 768) = rate(:,:, 768) * m(:,:) + rate(:,:, 769) = rate(:,:, 769) * m(:,:) + rate(:,:, 770) = rate(:,:, 770) * m(:,:) + rate(:,:, 771) = rate(:,:, 771) * m(:,:) + rate(:,:, 772) = rate(:,:, 772) * m(:,:) + rate(:,:, 773) = rate(:,:, 773) * m(:,:) + rate(:,:, 774) = rate(:,:, 774) * m(:,:) + rate(:,:, 775) = rate(:,:, 775) * m(:,:) + rate(:,:, 776) = rate(:,:, 776) * m(:,:) + rate(:,:, 777) = rate(:,:, 777) * m(:,:) + rate(:,:, 778) = rate(:,:, 778) * m(:,:) + rate(:,:, 779) = rate(:,:, 779) * m(:,:) + rate(:,:, 780) = rate(:,:, 780) * m(:,:) + rate(:,:, 781) = rate(:,:, 781) * m(:,:) + rate(:,:, 782) = rate(:,:, 782) * m(:,:) + rate(:,:, 783) = rate(:,:, 783) * m(:,:) + rate(:,:, 784) = rate(:,:, 784) * m(:,:) + rate(:,:, 785) = rate(:,:, 785) * m(:,:) + rate(:,:, 786) = rate(:,:, 786) * m(:,:) + rate(:,:, 787) = rate(:,:, 787) * m(:,:) + rate(:,:, 788) = rate(:,:, 788) * m(:,:) + rate(:,:, 789) = rate(:,:, 789) * m(:,:) + rate(:,:, 793) = rate(:,:, 793) * m(:,:) + rate(:,:, 794) = rate(:,:, 794) * m(:,:) + rate(:,:, 795) = rate(:,:, 795) * m(:,:) + rate(:,:, 796) = rate(:,:, 796) * m(:,:) + rate(:,:, 798) = rate(:,:, 798) * m(:,:) + rate(:,:, 799) = rate(:,:, 799) * m(:,:) + rate(:,:, 800) = rate(:,:, 800) * m(:,:) + rate(:,:, 801) = rate(:,:, 801) * m(:,:) + rate(:,:, 802) = rate(:,:, 802) * m(:,:) + rate(:,:, 803) = rate(:,:, 803) * m(:,:) + rate(:,:, 805) = rate(:,:, 805) * m(:,:) + rate(:,:, 806) = rate(:,:, 806) * m(:,:) + rate(:,:, 807) = rate(:,:, 807) * m(:,:) + rate(:,:, 808) = rate(:,:, 808) * m(:,:) + rate(:,:, 809) = rate(:,:, 809) * m(:,:) + rate(:,:, 810) = rate(:,:, 810) * m(:,:) + rate(:,:, 841) = rate(:,:, 841) * m(:,:) + rate(:,:, 842) = rate(:,:, 842) * m(:,:) + rate(:,:, 843) = rate(:,:, 843) * m(:,:) + rate(:,:, 844) = rate(:,:, 844) * m(:,:) + rate(:,:, 845) = rate(:,:, 845) * m(:,:) + rate(:,:, 846) = rate(:,:, 846) * m(:,:) + rate(:,:, 847) = rate(:,:, 847) * m(:,:) + rate(:,:, 848) = rate(:,:, 848) * m(:,:) + rate(:,:, 849) = rate(:,:, 849) * m(:,:) + rate(:,:, 850) = rate(:,:, 850) * m(:,:) + rate(:,:, 851) = rate(:,:, 851) * m(:,:) + rate(:,:, 852) = rate(:,:, 852) * m(:,:) + rate(:,:, 853) = rate(:,:, 853) * m(:,:) + rate(:,:, 854) = rate(:,:, 854) * m(:,:) + rate(:,:, 855) = rate(:,:, 855) * m(:,:) + rate(:,:, 856) = rate(:,:, 856) * m(:,:) + rate(:,:, 857) = rate(:,:, 857) * m(:,:) + rate(:,:, 858) = rate(:,:, 858) * m(:,:) + rate(:,:, 859) = rate(:,:, 859) * m(:,:) + rate(:,:, 860) = rate(:,:, 860) * m(:,:) + rate(:,:, 861) = rate(:,:, 861) * m(:,:) + rate(:,:, 862) = rate(:,:, 862) * m(:,:) + rate(:,:, 863) = rate(:,:, 863) * m(:,:) + rate(:,:, 864) = rate(:,:, 864) * m(:,:) + rate(:,:, 865) = rate(:,:, 865) * m(:,:) + rate(:,:, 866) = rate(:,:, 866) * m(:,:) + rate(:,:, 867) = rate(:,:, 867) * m(:,:) + rate(:,:, 868) = rate(:,:, 868) * m(:,:) + rate(:,:, 869) = rate(:,:, 869) * m(:,:) + rate(:,:, 870) = rate(:,:, 870) * m(:,:) + rate(:,:, 871) = rate(:,:, 871) * m(:,:) + rate(:,:, 872) = rate(:,:, 872) * m(:,:) + rate(:,:, 873) = rate(:,:, 873) * m(:,:) + rate(:,:, 874) = rate(:,:, 874) * m(:,:) + rate(:,:, 875) = rate(:,:, 875) * m(:,:) + rate(:,:, 876) = rate(:,:, 876) * m(:,:) + rate(:,:, 877) = rate(:,:, 877) * m(:,:) + rate(:,:, 878) = rate(:,:, 878) * m(:,:) + rate(:,:, 879) = rate(:,:, 879) * m(:,:) + rate(:,:, 880) = rate(:,:, 880) * m(:,:) + rate(:,:, 881) = rate(:,:, 881) * m(:,:) + rate(:,:, 882) = rate(:,:, 882) * m(:,:) + rate(:,:, 883) = rate(:,:, 883) * m(:,:) + rate(:,:, 885) = rate(:,:, 885) * m(:,:) + rate(:,:, 890) = rate(:,:, 890) * m(:,:) + rate(:,:, 891) = rate(:,:, 891) * m(:,:) + rate(:,:, 892) = rate(:,:, 892) * m(:,:) + rate(:,:, 895) = rate(:,:, 895) * m(:,:) + rate(:,:, 896) = rate(:,:, 896) * m(:,:) + rate(:,:, 897) = rate(:,:, 897) * m(:,:) + rate(:,:, 900) = rate(:,:, 900) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_trop_strat_mam5_ts2/mo_exp_sol.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/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_ts2/mo_imp_sol.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/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_ts2/mo_indprd.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/mo_indprd.F90 new file mode 100644 index 0000000000..f48db61343 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/mo_indprd.F90 @@ -0,0 +1,349 @@ + 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(:,810)*y(:,295)*y(:,143) +rxt(:,829)*y(:,144) + prod(:,2) = (rxt(:,557)*y(:,254) +rxt(:,560)*y(:,285) +rxt(:,563)*y(:,287) + & + rxt(:,567)*y(:,165))*y(:,148) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,168) = 0._r8 + prod(:,165) = 0._r8 + prod(:,1) = 0._r8 + prod(:,219) = 0._r8 + prod(:,2) = 0._r8 + prod(:,3) = + extfrc(:,3) + prod(:,199) = 0._r8 + prod(:,76) = 0._r8 + prod(:,124) = 0._r8 + prod(:,77) = 0._r8 + prod(:,132) = 0._r8 + prod(:,103) = 0._r8 + prod(:,121) = 0._r8 + prod(:,110) = 0._r8 + prod(:,81) = 0._r8 + prod(:,118) = 0._r8 + prod(:,202) = 0._r8 + prod(:,276) = 0._r8 + prod(:,88) = 0._r8 + prod(:,309) = 0._r8 + prod(:,146) = 0._r8 + prod(:,4) = 0._r8 + prod(:,89) = 0._r8 + prod(:,113) = 0._r8 + prod(:,105) = 0._r8 + prod(:,149) = 0._r8 + prod(:,99) = 0._r8 + prod(:,114) = 0._r8 + prod(:,106) = 0._r8 + prod(:,228) = 0._r8 + prod(:,123) = 0._r8 + prod(:,63) = 0._r8 + prod(:,100) = 0._r8 + prod(:,60) = 0._r8 + prod(:,71) = 0._r8 + prod(:,72) = 0._r8 + prod(:,64) = 0._r8 + prod(:,73) = 0._r8 + prod(:,65) = 0._r8 + prod(:,74) = 0._r8 + prod(:,66) = 0._r8 + prod(:,137) = 0._r8 + prod(:,306) = 0._r8 + prod(:,156) = 0._r8 + prod(:,67) = 0._r8 + prod(:,230) = 0._r8 + prod(:,120) = 0._r8 + prod(:,61) = 0._r8 + prod(:,280) = 0._r8 + prod(:,266) = 0._r8 + prod(:,173) = 0._r8 + prod(:,163) = 0._r8 + prod(:,238) = 0._r8 + prod(:,129) = 0._r8 + prod(:,279) = 0._r8 + prod(:,131) = 0._r8 + prod(:,315) = 0._r8 + prod(:,75) = 0._r8 + prod(:,58) = 0._r8 + prod(:,310) = 0._r8 + prod(:,223) = 0._r8 + prod(:,5) = 0._r8 + prod(:,271) = + extfrc(:,10) + prod(:,247) = 0._r8 + prod(:,90) = 0._r8 + prod(:,92) = 0._r8 + prod(:,84) = 0._r8 + prod(:,155) = 0._r8 + prod(:,104) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,9) = 0._r8 + prod(:,68) = 0._r8 + prod(:,217) = 0._r8 + prod(:,254) = 0._r8 + prod(:,235) = 0._r8 + prod(:,301) = 0._r8 + prod(:,251) = 0._r8 + prod(:,62) = 0._r8 + prod(:,237) = 0._r8 + prod(:,69) = 0._r8 + prod(:,208) = 0._r8 + prod(:,91) = 0._r8 + prod(:,93) = 0._r8 + prod(:,108) = 0._r8 + prod(:,304) = 0._r8 + prod(:,79) = 0._r8 + prod(:,182) = 0._r8 + prod(:,227) = 0._r8 + prod(:,107) = 0._r8 + prod(:,213) = 0._r8 + prod(:,302) = 0._r8 + prod(:,128) = 0._r8 + prod(:,195) = 0._r8 + prod(:,209) = 0._r8 + prod(:,193) = 0._r8 + prod(:,153) = 0._r8 + prod(:,154) = 0._r8 + prod(:,136) = 0._r8 + prod(:,140) = 0._r8 + prod(:,258) = 0._r8 + prod(:,263) = 0._r8 + prod(:,187) = 0._r8 + prod(:,185) = 0._r8 + prod(:,241) = 0._r8 + prod(:,138) = 0._r8 + prod(:,218) = 0._r8 + prod(:,229) = 0._r8 + prod(:,250) = 0._r8 + prod(:,204) = 0._r8 + prod(:,260) = 0._r8 + prod(:,234) = 0._r8 + prod(:,170) = 0._r8 + prod(:,272) = 0._r8 + prod(:,159) = 0._r8 + prod(:,150) = 0._r8 + prod(:,273) = 0._r8 + prod(:,166) = 0._r8 + prod(:,212) = 0._r8 + prod(:,245) = 0._r8 + prod(:,186) = 0._r8 + prod(:,264) = 0._r8 + prod(:,53) = 0._r8 + prod(:,201) = 0._r8 + prod(:,269) = 0._r8 + prod(:,259) = 0._r8 + prod(:,233) = 0._r8 + prod(:,145) = 0._r8 + prod(:,109) = 0._r8 + prod(:,141) = 0._r8 + prod(:,270) = 0._r8 + prod(:,265) = 0._r8 + prod(:,239) = 0._r8 + prod(:,177) = 0._r8 + prod(:,134) = + extfrc(:,15) + prod(:,80) = 0._r8 + prod(:,102) = 0._r8 + prod(:,274) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,59) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) = 0._r8 + prod(:,303) = + extfrc(:,14) + prod(:,312) = + extfrc(:,6) + prod(:,311) = 0._r8 + prod(:,232) = 0._r8 + prod(:,236) = 0._r8 + prod(:,16) = + extfrc(:,11) + prod(:,17) = + extfrc(:,12) + prod(:,18) = 0._r8 + prod(:,19) = + extfrc(:,1) + prod(:,20) = + extfrc(:,13) + prod(:,305) = (rxt(:,5) +2.000_r8*rxt(:,6)) + prod(:,313) = 0._r8 + prod(:,21) = 0._r8 + prod(:,111) = 0._r8 + prod(:,119) = 0._r8 + prod(:,82) = 0._r8 + prod(:,147) = 0._r8 + prod(:,70) = 0._r8 + prod(:,135) = 0._r8 + prod(:,78) = 0._r8 + prod(:,112) = 0._r8 + prod(:,22) = 0._r8 + prod(:,23) = + extfrc(:,2) + prod(:,148) = 0._r8 + prod(:,122) = 0._r8 + prod(:,143) = 0._r8 + prod(:,24) = 0._r8 + prod(:,246) = 0._r8 + prod(:,216) = + extfrc(:,5) + prod(:,98) = 0._r8 + prod(:,25) = + extfrc(:,7) + prod(:,26) = + extfrc(:,8) + prod(:,27) = 0._r8 + prod(:,28) = + extfrc(:,9) + prod(:,29) = 0._r8 + prod(:,30) = 0._r8 + prod(:,31) = 0._r8 + prod(:,32) = 0._r8 + prod(:,33) = 0._r8 + prod(:,34) = 0._r8 + prod(:,35) = 0._r8 + prod(:,36) = 0._r8 + prod(:,37) = 0._r8 + prod(:,38) = 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(:,45) = 0._r8 + prod(:,46) = + extfrc(:,4) + prod(:,85) = 0._r8 + prod(:,282) = 0._r8 + prod(:,133) = 0._r8 + prod(:,284) = 0._r8 + prod(:,220) = 0._r8 + prod(:,157) = 0._r8 + prod(:,255) = 0._r8 + prod(:,158) = 0._r8 + prod(:,171) = 0._r8 + prod(:,115) = 0._r8 + prod(:,116) = 0._r8 + prod(:,125) = 0._r8 + prod(:,117) = 0._r8 + prod(:,293) = 0._r8 + prod(:,292) = 0._r8 + prod(:,215) = 0._r8 + prod(:,192) = 0._r8 + prod(:,203) = 0._r8 + prod(:,194) = 0._r8 + prod(:,160) = 0._r8 + prod(:,207) = 0._r8 + prod(:,172) = 0._r8 + prod(:,244) = 0._r8 + prod(:,252) = 0._r8 + prod(:,242) = 0._r8 + prod(:,253) = 0._r8 + prod(:,161) = 0._r8 + prod(:,151) = 0._r8 + prod(:,167) = 0._r8 + prod(:,83) = 0._r8 + prod(:,86) = 0._r8 + prod(:,178) = 0._r8 + prod(:,87) = 0._r8 + prod(:,126) = 0._r8 + prod(:,144) = 0._r8 + prod(:,211) = 0._r8 + prod(:,281) = 0._r8 + prod(:,287) = 0._r8 + prod(:,47) = 0._r8 + prod(:,277) = 0._r8 + prod(:,286) = 0._r8 + prod(:,48) = 0._r8 + prod(:,139) = 0._r8 + prod(:,49) = 0._r8 + prod(:,290) = 0._r8 + prod(:,285) = 0._r8 + prod(:,50) = 0._r8 + prod(:,127) = 0._r8 + prod(:,225) = 0._r8 + prod(:,198) = 0._r8 + prod(:,164) = 0._r8 + prod(:,300) = 0._r8 + prod(:,308) = 0._r8 + prod(:,184) = 0._r8 + prod(:,152) = 0._r8 + prod(:,101) = 0._r8 + prod(:,179) = 0._r8 + prod(:,307) = 0._r8 + prod(:,162) = 0._r8 + prod(:,221) = 0._r8 + prod(:,267) = 0._r8 + prod(:,268) = 0._r8 + prod(:,94) = 0._r8 + prod(:,95) = 0._r8 + prod(:,96) = 0._r8 + prod(:,97) = 0._r8 + prod(:,256) = 0._r8 + prod(:,257) = 0._r8 + prod(:,205) = 0._r8 + prod(:,210) = 0._r8 + prod(:,200) = 0._r8 + prod(:,206) = 0._r8 + prod(:,231) = 0._r8 + prod(:,275) = 0._r8 + prod(:,222) = 0._r8 + prod(:,226) = 0._r8 + prod(:,51) = 0._r8 + prod(:,262) = 0._r8 + prod(:,261) = 0._r8 + prod(:,52) = 0._r8 + prod(:,289) = 0._r8 + prod(:,283) = 0._r8 + prod(:,54) = 0._r8 + prod(:,243) = 0._r8 + prod(:,180) = 0._r8 + prod(:,248) = 0._r8 + prod(:,188) = 0._r8 + prod(:,169) = 0._r8 + prod(:,240) = 0._r8 + prod(:,291) = 0._r8 + prod(:,288) = 0._r8 + prod(:,55) = 0._r8 + prod(:,249) = 0._r8 + prod(:,314) =rxt(:,5) + prod(:,316) = + extfrc(:,16) + prod(:,130) = 0._r8 + prod(:,189) = 0._r8 + prod(:,224) = 0._r8 + prod(:,190) = 0._r8 + prod(:,196) = 0._r8 + prod(:,294) = 0._r8 + prod(:,297) = 0._r8 + prod(:,296) = 0._r8 + prod(:,298) = 0._r8 + prod(:,278) = 0._r8 + prod(:,295) = 0._r8 + prod(:,299) = 0._r8 + prod(:,174) = 0._r8 + prod(:,191) = 0._r8 + prod(:,214) = 0._r8 + prod(:,197) = 0._r8 + prod(:,175) = 0._r8 + prod(:,176) = 0._r8 + prod(:,181) = 0._r8 + prod(:,56) = 0._r8 + prod(:,183) = 0._r8 + prod(:,57) = 0._r8 + prod(:,142) = 0._r8 + prod(:,317) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_trop_strat_mam5_ts2/mo_lin_matrix.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/mo_lin_matrix.F90 new file mode 100644 index 0000000000..ab498d3cf3 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/mo_lin_matrix.F90 @@ -0,0 +1,1024 @@ + 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,752) = -( rxt(k,19) + het_rates(k,1) ) + mat(k,718) = -( rxt(k,20) + het_rates(k,2) ) + mat(k,1) = -( het_rates(k,3) ) + mat(k,1272) = -( het_rates(k,4) ) + mat(k,2) = -( het_rates(k,5) ) + mat(k,3) = -( het_rates(k,6) ) + mat(k,1041) = -( het_rates(k,7) ) + mat(k,182) = -( het_rates(k,8) ) + mat(k,417) = -( rxt(k,21) + het_rates(k,9) ) + mat(k,188) = -( rxt(k,22) + het_rates(k,10) ) + mat(k,468) = -( rxt(k,23) + het_rates(k,11) ) + mat(k,418) = .500_r8*rxt(k,21) + mat(k,189) = rxt(k,22) + mat(k,740) = .200_r8*rxt(k,115) + mat(k,841) = .060_r8*rxt(k,116) + mat(k,301) = -( rxt(k,24) + het_rates(k,12) ) + mat(k,738) = .200_r8*rxt(k,115) + mat(k,838) = .200_r8*rxt(k,116) + mat(k,401) = -( rxt(k,25) + het_rates(k,13) ) + mat(k,739) = .200_r8*rxt(k,115) + mat(k,840) = .150_r8*rxt(k,116) + mat(k,337) = -( rxt(k,26) + het_rates(k,14) ) + mat(k,839) = .210_r8*rxt(k,116) + mat(k,204) = -( het_rates(k,15) ) + mat(k,377) = -( het_rates(k,16) ) + mat(k,1092) = -( het_rates(k,17) ) + mat(k,2199) = -( het_rates(k,18) ) + mat(k,243) = rxt(k,118) + mat(k,3479) = rxt(k,119) + mat(k,563) = rxt(k,121) + mat(k,161) = rxt(k,123) + mat(k,167) = rxt(k,124) + mat(k,496) = 2.000_r8*rxt(k,130) + mat(k,647) = rxt(k,131) + mat(k,463) = 3.000_r8*rxt(k,134) + mat(k,128) = 2.000_r8*rxt(k,142) + mat(k,1151) = rxt(k,143) + mat(k,996) = rxt(k,149) + mat(k,242) = -( rxt(k,118) + het_rates(k,19) ) + mat(k,3488) = -( rxt(k,119) + het_rates(k,20) ) + mat(k,566) = rxt(k,120) + mat(k,561) = -( rxt(k,120) + rxt(k,121) + rxt(k,886) + rxt(k,889) + rxt(k,894) & + + het_rates(k,21) ) + mat(k,4) = -( het_rates(k,22) ) + mat(k,245) = -( het_rates(k,23) ) + mat(k,352) = rxt(k,27) + mat(k,353) = -( rxt(k,27) + het_rates(k,24) ) + mat(k,310) = -( het_rates(k,25) ) + mat(k,585) = -( het_rates(k,26) ) + mat(k,283) = -( het_rates(k,27) ) + mat(k,358) = -( rxt(k,28) + het_rates(k,28) ) + mat(k,316) = -( het_rates(k,29) ) + mat(k,1385) = -( het_rates(k,30) ) + mat(k,2032) = .700_r8*rxt(k,79) + mat(k,411) = -( rxt(k,29) + het_rates(k,31) ) + mat(k,130) = -( het_rates(k,32) ) + mat(k,287) = -( rxt(k,30) + het_rates(k,33) ) + mat(k,120) = -( rxt(k,122) + het_rates(k,34) ) + mat(k,159) = -( rxt(k,123) + het_rates(k,35) ) + mat(k,164) = -( rxt(k,124) + het_rates(k,36) ) + mat(k,134) = -( rxt(k,125) + het_rates(k,37) ) + mat(k,169) = -( rxt(k,126) + het_rates(k,38) ) + mat(k,138) = -( rxt(k,127) + het_rates(k,39) ) + mat(k,174) = -( rxt(k,128) + het_rates(k,40) ) + mat(k,142) = -( rxt(k,129) + het_rates(k,41) ) + mat(k,495) = -( rxt(k,130) + het_rates(k,42) ) + mat(k,3188) = -( rxt(k,31) + rxt(k,32) + het_rates(k,43) ) + mat(k,758) = .100_r8*rxt(k,19) + mat(k,725) = .100_r8*rxt(k,20) + mat(k,451) = rxt(k,37) + mat(k,2264) = .180_r8*rxt(k,39) + mat(k,643) = .500_r8*rxt(k,41) + mat(k,1715) = rxt(k,43) + mat(k,886) = rxt(k,45) + mat(k,1212) = rxt(k,46) + mat(k,982) = .330_r8*rxt(k,47) + mat(k,1773) = rxt(k,52) + mat(k,927) = rxt(k,55) + rxt(k,56) + mat(k,678) = rxt(k,65) + mat(k,597) = rxt(k,66) + mat(k,734) = rxt(k,68) + mat(k,1206) = rxt(k,69) + mat(k,1907) = rxt(k,71) + mat(k,2023) = rxt(k,72) + mat(k,1782) = .250_r8*rxt(k,74) + mat(k,1465) = .140_r8*rxt(k,75) + mat(k,1922) = .250_r8*rxt(k,80) + mat(k,1503) = .440_r8*rxt(k,81) + mat(k,1457) = rxt(k,83) + mat(k,1484) = rxt(k,84) + mat(k,581) = rxt(k,88) + mat(k,408) = rxt(k,89) + mat(k,697) = rxt(k,313) + mat(k,293) = 2.000_r8*rxt(k,343) + mat(k,1963) = rxt(k,427) + mat(k,2002) = rxt(k,433) + mat(k,646) = -( rxt(k,131) + het_rates(k,44) ) + mat(k,146) = -( rxt(k,132) + het_rates(k,45) ) + mat(k,1431) = -( rxt(k,33) + het_rates(k,46) ) + mat(k,755) = .400_r8*rxt(k,19) + mat(k,722) = .400_r8*rxt(k,20) + mat(k,360) = rxt(k,28) + mat(k,975) = .330_r8*rxt(k,47) + mat(k,334) = rxt(k,77) + mat(k,579) = rxt(k,88) + mat(k,393) = -( rxt(k,133) + het_rates(k,47) ) + mat(k,123) = -( het_rates(k,48) ) + mat(k,2277) = -( rxt(k,34) + het_rates(k,49) ) + mat(k,756) = .250_r8*rxt(k,19) + mat(k,723) = .250_r8*rxt(k,20) + mat(k,413) = .820_r8*rxt(k,29) + mat(k,979) = .170_r8*rxt(k,47) + mat(k,1926) = -( rxt(k,35) + het_rates(k,50) ) + mat(k,338) = rxt(k,26) + mat(k,641) = .500_r8*rxt(k,41) + mat(k,619) = .680_r8*rxt(k,48) + mat(k,632) = .670_r8*rxt(k,49) + mat(k,1874) = rxt(k,54) + mat(k,1116) = .500_r8*rxt(k,60) + mat(k,1795) = .500_r8*rxt(k,61) + mat(k,774) = .720_r8*rxt(k,63) + mat(k,1779) = .250_r8*rxt(k,74) + mat(k,1463) = .140_r8*rxt(k,75) + mat(k,1917) = .250_r8*rxt(k,80) + mat(k,1500) = .440_r8*rxt(k,81) + mat(k,747) = .400_r8*rxt(k,115) + mat(k,848) = .540_r8*rxt(k,116) + mat(k,432) = .510_r8*rxt(k,117) + mat(k,791) = -( het_rates(k,51) ) + mat(k,702) = -( rxt(k,36) + het_rates(k,52) ) + mat(k,1494) = -( het_rates(k,53) ) + mat(k,449) = -( rxt(k,37) + het_rates(k,54) ) + mat(k,2259) = -( rxt(k,38) + rxt(k,39) + het_rates(k,55) ) + mat(k,462) = -( rxt(k,134) + het_rates(k,56) ) + mat(k,3850) = -( het_rates(k,57) ) + mat(k,244) = rxt(k,118) + mat(k,122) = 4.000_r8*rxt(k,122) + mat(k,163) = rxt(k,123) + mat(k,137) = 2.000_r8*rxt(k,125) + mat(k,173) = 2.000_r8*rxt(k,126) + mat(k,141) = 2.000_r8*rxt(k,127) + mat(k,178) = rxt(k,128) + mat(k,145) = 2.000_r8*rxt(k,129) + mat(k,147) = 3.000_r8*rxt(k,132) + mat(k,398) = rxt(k,133) + mat(k,180) = 2.000_r8*rxt(k,135) + mat(k,116) = 2.000_r8*rxt(k,136) + mat(k,3520) = rxt(k,137) + mat(k,1332) = rxt(k,138) + mat(k,259) = rxt(k,141) + mat(k,254) = rxt(k,144) + mat(k,264) = rxt(k,145) + mat(k,329) = rxt(k,146) + mat(k,3140) = rxt(k,147) + mat(k,1163) = rxt(k,150) + mat(k,179) = -( rxt(k,135) + het_rates(k,58) ) + mat(k,114) = -( rxt(k,136) + rxt(k,253) + het_rates(k,59) ) + mat(k,3515) = -( rxt(k,137) + het_rates(k,60) ) + mat(k,1329) = rxt(k,139) + mat(k,346) = rxt(k,151) + mat(k,115) = 2.000_r8*rxt(k,253) + mat(k,1325) = -( rxt(k,138) + rxt(k,139) + rxt(k,888) + rxt(k,893) + rxt(k,899) & + + het_rates(k,61) ) + mat(k,5) = -( het_rates(k,62) ) + mat(k,2057) = -( het_rates(k,63) ) + mat(k,190) = 1.500_r8*rxt(k,22) + mat(k,403) = .600_r8*rxt(k,25) + mat(k,339) = rxt(k,26) + mat(k,3180) = rxt(k,31) + rxt(k,32) + mat(k,1432) = rxt(k,33) + mat(k,1927) = rxt(k,35) + mat(k,2258) = .380_r8*rxt(k,39) + mat(k,1614) = rxt(k,40) + mat(k,642) = .500_r8*rxt(k,41) + mat(k,1713) = rxt(k,43) + mat(k,1478) = 2.000_r8*rxt(k,44) + mat(k,885) = rxt(k,45) + mat(k,978) = .330_r8*rxt(k,47) + mat(k,621) = 1.320_r8*rxt(k,48) + mat(k,634) = 1.740_r8*rxt(k,49) + mat(k,492) = rxt(k,50) + mat(k,525) = rxt(k,51) + mat(k,1875) = 1.500_r8*rxt(k,53) + rxt(k,54) + mat(k,2077) = .550_r8*rxt(k,64) + mat(k,2109) = .550_r8*rxt(k,67) + mat(k,2017) = 1.650_r8*rxt(k,72) + mat(k,1780) = .750_r8*rxt(k,74) + mat(k,1464) = .860_r8*rxt(k,75) + mat(k,2042) = .700_r8*rxt(k,79) + mat(k,1456) = rxt(k,83) + mat(k,224) = 1.500_r8*rxt(k,90) + mat(k,2358) = rxt(k,93) + mat(k,1290) = rxt(k,94) + mat(k,1719) = rxt(k,96) + mat(k,389) = rxt(k,154) + mat(k,1548) = rxt(k,384) + mat(k,1647) = rxt(k,500) + mat(k,1855) = .600_r8*rxt(k,529) + mat(k,1823) = .600_r8*rxt(k,532) + mat(k,1613) = -( rxt(k,40) + het_rates(k,64) ) + mat(k,703) = rxt(k,36) + mat(k,2256) = .440_r8*rxt(k,39) + mat(k,618) = .170_r8*rxt(k,48) + mat(k,631) = .280_r8*rxt(k,49) + mat(k,1868) = rxt(k,54) + mat(k,570) = .400_r8*rxt(k,86) + mat(k,779) = rxt(k,98) + mat(k,364) = rxt(k,99) + mat(k,369) = rxt(k,100) + 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,248) = -( rxt(k,140) + het_rates(k,65) ) + mat(k,160) = rxt(k,123) + mat(k,165) = rxt(k,124) + mat(k,170) = rxt(k,126) + mat(k,139) = 2.000_r8*rxt(k,127) + mat(k,175) = 2.000_r8*rxt(k,128) + mat(k,143) = rxt(k,129) + mat(k,127) = 2.000_r8*rxt(k,142) + mat(k,260) = rxt(k,145) + mat(k,325) = rxt(k,146) + mat(k,256) = -( rxt(k,141) + het_rates(k,66) ) + mat(k,135) = rxt(k,125) + mat(k,171) = rxt(k,126) + mat(k,252) = rxt(k,144) + mat(k,218) = -( het_rates(k,67) ) + mat(k,639) = -( rxt(k,41) + het_rates(k,68) ) + mat(k,1837) = .600_r8*rxt(k,529) + mat(k,1806) = .600_r8*rxt(k,532) + mat(k,304) = -( het_rates(k,69) ) + mat(k,6) = -( het_rates(k,70) ) + mat(k,7) = -( het_rates(k,71) ) + mat(k,8) = -( het_rates(k,72) ) + mat(k,9) = -( rxt(k,901) + het_rates(k,73) ) + mat(k,150) = -( rxt(k,42) + het_rates(k,74) ) + mat(k,1242) = -( het_rates(k,75) ) + mat(k,166) = rxt(k,124) + mat(k,176) = rxt(k,128) + mat(k,249) = 2.000_r8*rxt(k,140) + mat(k,257) = rxt(k,141) + mat(k,323) = rxt(k,148) + mat(k,1712) = -( rxt(k,43) + het_rates(k,76) ) + mat(k,976) = .330_r8*rxt(k,47) + mat(k,1869) = .500_r8*rxt(k,53) + mat(k,1660) = rxt(k,59) + mat(k,1112) = .500_r8*rxt(k,60) + mat(k,1790) = .500_r8*rxt(k,61) + mat(k,1469) = rxt(k,62) + mat(k,772) = .720_r8*rxt(k,63) + mat(k,1915) = .500_r8*rxt(k,80) + mat(k,1499) = .560_r8*rxt(k,81) + mat(k,292) = rxt(k,344) + mat(k,1476) = -( rxt(k,44) + rxt(k,811) + het_rates(k,77) ) + mat(k,420) = rxt(k,21) + mat(k,1111) = .500_r8*rxt(k,60) + mat(k,1787) = .500_r8*rxt(k,61) + mat(k,771) = .280_r8*rxt(k,63) + mat(k,349) = .700_r8*rxt(k,87) + mat(k,746) = .600_r8*rxt(k,115) + mat(k,847) = .340_r8*rxt(k,116) + mat(k,431) = .170_r8*rxt(k,117) + mat(k,2931) = -( rxt(k,181) + het_rates(k,78) ) + mat(k,4112) = rxt(k,2) + 2.000_r8*rxt(k,3) + mat(k,3183) = 2.000_r8*rxt(k,31) + mat(k,450) = rxt(k,37) + mat(k,2260) = rxt(k,38) + .330_r8*rxt(k,39) + mat(k,1152) = rxt(k,143) + mat(k,3127) = rxt(k,147) + mat(k,324) = rxt(k,148) + mat(k,1673) = -( het_rates(k,79) ) + mat(k,4109) = rxt(k,1) + mat(k,3179) = rxt(k,32) + mat(k,2257) = 1.440_r8*rxt(k,39) + mat(k,126) = -( rxt(k,142) + het_rates(k,80) ) + mat(k,1487) = -( rxt(k,4) + het_rates(k,81) ) + mat(k,153) = -( rxt(k,153) + het_rates(k,82) ) + mat(k,1150) = -( rxt(k,143) + het_rates(k,83) ) + mat(k,251) = -( rxt(k,144) + het_rates(k,84) ) + mat(k,261) = -( rxt(k,145) + het_rates(k,85) ) + mat(k,326) = -( rxt(k,146) + het_rates(k,86) ) + mat(k,3129) = -( rxt(k,147) + het_rates(k,87) ) + mat(k,197) = -( het_rates(k,88) ) + mat(k,883) = -( rxt(k,45) + het_rates(k,89) ) + mat(k,1377) = -( het_rates(k,90) ) + mat(k,616) = .410_r8*rxt(k,48) + mat(k,322) = -( rxt(k,148) + het_rates(k,91) ) + mat(k,1210) = -( rxt(k,46) + het_rates(k,92) ) + mat(k,2949) = -( rxt(k,9) + het_rates(k,93) ) + mat(k,981) = rxt(k,813) + mat(k,507) = rxt(k,816) + mat(k,1260) = rxt(k,817) + mat(k,1586) = rxt(k,818) + mat(k,1666) = rxt(k,819) + mat(k,1118) = rxt(k,820) + mat(k,2081) = rxt(k,824) + mat(k,677) = rxt(k,825) + mat(k,2113) = rxt(k,826) + mat(k,296) = 2.000_r8*rxt(k,827) + 2.000_r8*rxt(k,884) + 2.000_r8*rxt(k,887) & + + 2.000_r8*rxt(k,898) + mat(k,2142) = rxt(k,828) + mat(k,3653) = .500_r8*rxt(k,830) + mat(k,3601) = rxt(k,831) + mat(k,208) = rxt(k,832) + mat(k,1230) = rxt(k,835) + mat(k,787) = rxt(k,837) + mat(k,1146) = rxt(k,838) + mat(k,1705) = rxt(k,839) + mat(k,1538) = rxt(k,840) + mat(k,564) = rxt(k,886) + rxt(k,889) + rxt(k,894) + mat(k,1326) = rxt(k,888) + rxt(k,893) + rxt(k,899) + mat(k,443) = -( rxt(k,10) + rxt(k,11) + rxt(k,216) + het_rates(k,94) ) + mat(k,995) = -( rxt(k,149) + het_rates(k,95) ) + mat(k,562) = rxt(k,886) + rxt(k,889) + rxt(k,894) + mat(k,1159) = -( rxt(k,150) + het_rates(k,96) ) + mat(k,1324) = rxt(k,888) + rxt(k,893) + rxt(k,899) + mat(k,974) = -( rxt(k,47) + rxt(k,813) + het_rates(k,97) ) + mat(k,613) = -( rxt(k,48) + het_rates(k,98) ) + mat(k,1836) = .250_r8*rxt(k,529) + mat(k,626) = -( rxt(k,49) + het_rates(k,99) ) + mat(k,1805) = .250_r8*rxt(k,532) + mat(k,488) = -( rxt(k,50) + het_rates(k,100) ) + mat(k,1835) = .150_r8*rxt(k,529) + mat(k,521) = -( rxt(k,51) + het_rates(k,101) ) + mat(k,1804) = .150_r8*rxt(k,532) + mat(k,1770) = -( rxt(k,52) + het_rates(k,102) ) + mat(k,977) = .170_r8*rxt(k,47) + mat(k,1870) = .500_r8*rxt(k,53) + mat(k,1661) = rxt(k,59) + mat(k,1113) = .500_r8*rxt(k,60) + mat(k,1791) = .500_r8*rxt(k,61) + mat(k,1470) = rxt(k,62) + mat(k,773) = .280_r8*rxt(k,63) + mat(k,1777) = .500_r8*rxt(k,74) + mat(k,1462) = .860_r8*rxt(k,75) + mat(k,1545) = rxt(k,384) + mat(k,1872) = -( rxt(k,53) + rxt(k,54) + het_rates(k,103) ) + mat(k,2074) = .450_r8*rxt(k,64) + mat(k,2106) = .450_r8*rxt(k,67) + mat(k,2136) = rxt(k,82) + mat(k,924) = -( rxt(k,55) + rxt(k,56) + het_rates(k,104) ) + mat(k,640) = .500_r8*rxt(k,41) + mat(k,914) = -( rxt(k,814) + het_rates(k,105) ) + mat(k,503) = rxt(k,57) + mat(k,1251) = rxt(k,58) + mat(k,1524) = -( rxt(k,815) + het_rates(k,106) ) + mat(k,502) = -( rxt(k,57) + rxt(k,816) + het_rates(k,107) ) + mat(k,1252) = -( rxt(k,58) + rxt(k,817) + het_rates(k,108) ) + mat(k,1410) = -( het_rates(k,109) ) + mat(k,1659) = -( rxt(k,59) + rxt(k,819) + het_rates(k,110) ) + mat(k,1110) = -( rxt(k,60) + rxt(k,820) + het_rates(k,111) ) + mat(k,1793) = -( rxt(k,61) + rxt(k,821) + het_rates(k,112) ) + mat(k,1172) = rxt(k,462) + mat(k,1057) = rxt(k,465) + mat(k,1468) = -( rxt(k,62) + rxt(k,822) + het_rates(k,113) ) + mat(k,1122) = rxt(k,458) + mat(k,1134) = rxt(k,468) + mat(k,1311) = rxt(k,480) + mat(k,1363) = rxt(k,483) + mat(k,770) = -( rxt(k,63) + rxt(k,823) + het_rates(k,114) ) + mat(k,2078) = -( rxt(k,64) + rxt(k,824) + het_rates(k,115) ) + mat(k,673) = -( rxt(k,65) + rxt(k,825) + het_rates(k,116) ) + mat(k,593) = -( rxt(k,66) + het_rates(k,117) ) + mat(k,2110) = -( rxt(k,67) + rxt(k,826) + het_rates(k,118) ) + mat(k,728) = -( rxt(k,68) + het_rates(k,119) ) + mat(k,1194) = -( rxt(k,69) + het_rates(k,120) ) + mat(k,1572) = -( rxt(k,70) + rxt(k,818) + het_rates(k,121) ) + mat(k,919) = -( het_rates(k,122) ) + mat(k,1896) = -( rxt(k,71) + het_rates(k,123) ) + mat(k,89) = -( het_rates(k,124) ) + mat(k,1071) = -( het_rates(k,125) ) + mat(k,2016) = -( rxt(k,72) + rxt(k,73) + het_rates(k,126) ) + mat(k,524) = rxt(k,51) + mat(k,596) = rxt(k,66) + mat(k,731) = .500_r8*rxt(k,68) + mat(k,1200) = .120_r8*rxt(k,69) + mat(k,1901) = .300_r8*rxt(k,71) + mat(k,1992) = rxt(k,433) + mat(k,1778) = -( rxt(k,74) + het_rates(k,127) ) + mat(k,1643) = .510_r8*rxt(k,500) + mat(k,1461) = -( rxt(k,75) + het_rates(k,128) ) + mat(k,2062) = .550_r8*rxt(k,64) + mat(k,556) = -( rxt(k,76) + het_rates(k,129) ) + mat(k,751) = .800_r8*rxt(k,19) + mat(k,717) = .800_r8*rxt(k,20) + mat(k,332) = -( rxt(k,77) + het_rates(k,130) ) + mat(k,528) = -( rxt(k,78) + rxt(k,407) + het_rates(k,131) ) + mat(k,2041) = -( rxt(k,79) + het_rates(k,132) ) + mat(k,491) = rxt(k,50) + mat(k,676) = rxt(k,65) + mat(k,732) = .500_r8*rxt(k,68) + mat(k,1201) = .880_r8*rxt(k,69) + mat(k,1902) = .700_r8*rxt(k,71) + mat(k,1956) = rxt(k,427) + mat(k,1916) = -( rxt(k,80) + het_rates(k,133) ) + mat(k,1645) = .490_r8*rxt(k,500) + mat(k,1498) = -( rxt(k,81) + het_rates(k,134) ) + mat(k,2098) = .550_r8*rxt(k,67) + mat(k,827) = -( het_rates(k,135) ) + mat(k,477) = -( rxt(k,198) + het_rates(k,136) ) + mat(k,2986) = rxt(k,15) + mat(k,201) = -( rxt(k,12) + het_rates(k,137) ) + mat(k,295) = -( rxt(k,13) + rxt(k,14) + rxt(k,217) + rxt(k,827) + rxt(k,884) & + + rxt(k,887) + rxt(k,898) + het_rates(k,138) ) + mat(k,2140) = -( rxt(k,82) + rxt(k,828) + het_rates(k,139) ) + mat(k,1583) = rxt(k,70) + mat(k,10) = -( het_rates(k,140) ) + mat(k,11) = -( het_rates(k,141) ) + mat(k,12) = -( het_rates(k,142) ) + mat(k,117) = -( het_rates(k,143) ) + mat(k,13) = -( rxt(k,829) + het_rates(k,144) ) + mat(k,14) = -( rxt(k,903) + het_rates(k,145) ) + mat(k,15) = -( rxt(k,902) + het_rates(k,146) ) + end do + end subroutine linmat02 + subroutine linmat03( 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,3106) = -( rxt(k,15) + het_rates(k,147) ) + mat(k,297) = rxt(k,14) + mat(k,3654) = rxt(k,16) + .500_r8*rxt(k,830) + mat(k,3602) = rxt(k,17) + mat(k,479) = rxt(k,198) + mat(k,3663) = -( rxt(k,16) + rxt(k,830) + het_rates(k,148) ) + mat(k,2956) = rxt(k,9) + mat(k,446) = rxt(k,11) + rxt(k,216) + mat(k,300) = rxt(k,13) + rxt(k,217) + mat(k,3611) = rxt(k,18) + mat(k,760) = rxt(k,19) + mat(k,984) = rxt(k,47) + mat(k,510) = rxt(k,57) + mat(k,1263) = rxt(k,58) + mat(k,1669) = 2.000_r8*rxt(k,59) + mat(k,1119) = 2.000_r8*rxt(k,60) + mat(k,1801) = rxt(k,61) + mat(k,1473) = rxt(k,62) + mat(k,2088) = rxt(k,64) + mat(k,680) = rxt(k,65) + mat(k,599) = rxt(k,66) + mat(k,2120) = rxt(k,67) + mat(k,736) = rxt(k,68) + mat(k,1208) = rxt(k,69) + mat(k,1784) = .750_r8*rxt(k,74) + mat(k,533) = rxt(k,78) + rxt(k,407) + mat(k,1924) = .750_r8*rxt(k,80) + mat(k,2149) = rxt(k,82) + mat(k,1459) = rxt(k,83) + mat(k,1485) = rxt(k,84) + mat(k,209) = rxt(k,85) + mat(k,575) = .600_r8*rxt(k,86) + rxt(k,352) + mat(k,662) = rxt(k,95) + rxt(k,790) + mat(k,671) = rxt(k,97) + rxt(k,791) + mat(k,427) = rxt(k,101) + rxt(k,792) + mat(k,1232) = rxt(k,103) + mat(k,991) = .500_r8*rxt(k,105) + mat(k,687) = .460_r8*rxt(k,106) + mat(k,1147) = rxt(k,107) + mat(k,789) = .460_r8*rxt(k,108) + mat(k,1560) = rxt(k,109) + mat(k,1695) = rxt(k,110) + mat(k,1540) = rxt(k,111) + mat(k,1708) = rxt(k,112) + mat(k,568) = rxt(k,120) + mat(k,1331) = rxt(k,139) + mat(k,158) = rxt(k,575) + mat(k,3610) = -( rxt(k,17) + rxt(k,18) + rxt(k,831) + het_rates(k,149) ) + mat(k,445) = rxt(k,10) + mat(k,299) = rxt(k,13) + rxt(k,14) + rxt(k,217) + mat(k,574) = .400_r8*rxt(k,86) + mat(k,567) = rxt(k,121) + mat(k,1330) = rxt(k,138) + mat(k,1454) = -( rxt(k,83) + het_rates(k,150) ) + mat(k,1912) = .250_r8*rxt(k,80) + mat(k,1481) = -( rxt(k,84) + het_rates(k,151) ) + mat(k,1776) = .250_r8*rxt(k,74) + mat(k,16) = -( het_rates(k,152) ) + mat(k,17) = -( het_rates(k,153) ) + mat(k,18) = -( het_rates(k,154) ) + mat(k,19) = -( het_rates(k,155) ) + mat(k,20) = -( het_rates(k,156) ) + mat(k,3161) = -( rxt(k,175) + het_rates(k,157) ) + mat(k,4116) = rxt(k,3) + mat(k,3758) = rxt(k,8) + mat(k,298) = rxt(k,14) + mat(k,3108) = rxt(k,15) + mat(k,3656) = rxt(k,16) + mat(k,3604) = rxt(k,18) + mat(k,2263) = .180_r8*rxt(k,39) + mat(k,1615) = rxt(k,40) + mat(k,3484) = rxt(k,119) + mat(k,3510) = rxt(k,137) + mat(k,345) = rxt(k,151) + mat(k,1604) = rxt(k,155) + rxt(k,804) + mat(k,1237) = rxt(k,156) + mat(k,281) = rxt(k,157) + mat(k,3799) = rxt(k,170) + rxt(k,171) + mat(k,480) = rxt(k,198) + mat(k,546) = rxt(k,797) + mat(k,3766) = -( rxt(k,7) + rxt(k,8) + het_rates(k,158) ) + mat(k,3169) = rxt(k,175) + mat(k,21) = -( het_rates(k,159) ) + mat(k,342) = -( rxt(k,151) + het_rates(k,160) ) + mat(k,385) = -( rxt(k,154) + het_rates(k,161) ) + mat(k,207) = -( rxt(k,85) + rxt(k,832) + het_rates(k,162) ) + mat(k,569) = -( rxt(k,86) + rxt(k,352) + het_rates(k,163) ) + mat(k,156) = -( rxt(k,575) + het_rates(k,164) ) + mat(k,484) = -( het_rates(k,165) ) + mat(k,288) = rxt(k,30) + mat(k,192) = -( het_rates(k,166) ) + mat(k,347) = -( rxt(k,87) + het_rates(k,167) ) + mat(k,22) = -( het_rates(k,168) ) + mat(k,23) = -( het_rates(k,169) ) + mat(k,577) = -( rxt(k,88) + het_rates(k,170) ) + mat(k,405) = -( rxt(k,89) + het_rates(k,171) ) + mat(k,543) = -( rxt(k,797) + het_rates(k,172) ) + mat(k,386) = rxt(k,154) + mat(k,1598) = rxt(k,155) + mat(k,24) = -( rxt(k,152) + het_rates(k,173) ) + mat(k,1600) = -( rxt(k,155) + rxt(k,804) + het_rates(k,174) ) + mat(k,1236) = rxt(k,156) + mat(k,544) = rxt(k,797) + mat(k,1235) = -( rxt(k,156) + het_rates(k,175) ) + mat(k,280) = rxt(k,157) + mat(k,1599) = rxt(k,804) + mat(k,279) = -( rxt(k,157) + het_rates(k,176) ) + mat(k,154) = rxt(k,153) + mat(k,25) = -( het_rates(k,177) ) + mat(k,26) = -( het_rates(k,178) ) + mat(k,27) = -( het_rates(k,179) ) + mat(k,28) = -( het_rates(k,180) ) + mat(k,29) = -( rxt(k,158) + het_rates(k,181) ) + mat(k,30) = -( rxt(k,159) + het_rates(k,182) ) + mat(k,31) = -( rxt(k,160) + het_rates(k,183) ) + mat(k,32) = -( rxt(k,161) + het_rates(k,184) ) + mat(k,33) = -( rxt(k,162) + het_rates(k,185) ) + mat(k,34) = -( rxt(k,163) + het_rates(k,186) ) + mat(k,35) = -( rxt(k,164) + het_rates(k,187) ) + mat(k,36) = -( rxt(k,165) + het_rates(k,188) ) + mat(k,37) = -( rxt(k,166) + het_rates(k,189) ) + mat(k,38) = -( rxt(k,167) + het_rates(k,190) ) + mat(k,39) = -( het_rates(k,191) ) + mat(k,1475) = rxt(k,811) + mat(k,40) = -( het_rates(k,192) ) + mat(k,41) = -( het_rates(k,193) ) + mat(k,42) = -( het_rates(k,194) ) + mat(k,43) = -( het_rates(k,195) ) + mat(k,44) = -( rxt(k,833) + het_rates(k,196) ) + mat(k,45) = -( rxt(k,904) + het_rates(k,197) ) + mat(k,51) = -( het_rates(k,198) ) + mat(k,223) = -( rxt(k,90) + het_rates(k,199) ) + mat(k,2320) = -( rxt(k,91) + het_rates(k,200) ) + mat(k,471) = -( rxt(k,92) + het_rates(k,201) ) + mat(k,2359) = -( rxt(k,93) + het_rates(k,202) ) + mat(k,988) = .500_r8*rxt(k,105) + mat(k,1145) = rxt(k,107) + mat(k,1558) = rxt(k,109) + mat(k,1537) = rxt(k,111) + mat(k,690) = rxt(k,113) + mat(k,1289) = -( rxt(k,94) + het_rates(k,203) ) + mat(k,655) = -( rxt(k,95) + rxt(k,790) + het_rates(k,204) ) + mat(k,1718) = -( rxt(k,96) + het_rates(k,205) ) + mat(k,602) = rxt(k,114) + mat(k,664) = -( rxt(k,97) + rxt(k,791) + het_rates(k,206) ) + mat(k,778) = -( rxt(k,98) + het_rates(k,207) ) + mat(k,363) = -( rxt(k,99) + het_rates(k,208) ) + mat(k,368) = -( rxt(k,100) + het_rates(k,209) ) + mat(k,423) = -( rxt(k,101) + rxt(k,792) + het_rates(k,210) ) + mat(k,373) = -( rxt(k,102) + rxt(k,834) + het_rates(k,211) ) + mat(k,2629) = -( het_rates(k,212) ) + mat(k,2322) = rxt(k,91) + mat(k,685) = .460_r8*rxt(k,106) + mat(k,786) = .460_r8*rxt(k,108) + mat(k,1691) = rxt(k,110) + mat(k,1704) = rxt(k,112) + mat(k,2600) = -( het_rates(k,213) ) + mat(k,473) = rxt(k,92) + mat(k,1228) = -( rxt(k,103) + rxt(k,835) + het_rates(k,214) ) + mat(k,969) = -( rxt(k,104) + rxt(k,836) + het_rates(k,215) ) + mat(k,1106) = -( het_rates(k,216) ) + mat(k,986) = -( rxt(k,105) + het_rates(k,217) ) + mat(k,682) = -( rxt(k,106) + het_rates(k,218) ) + mat(k,1143) = -( rxt(k,107) + rxt(k,838) + het_rates(k,219) ) + mat(k,783) = -( rxt(k,108) + rxt(k,837) + het_rates(k,220) ) + mat(k,1557) = -( rxt(k,109) + het_rates(k,221) ) + mat(k,1229) = rxt(k,103) + mat(k,970) = rxt(k,104) + mat(k,987) = .500_r8*rxt(k,105) + mat(k,1689) = -( rxt(k,110) + het_rates(k,222) ) + mat(k,684) = .540_r8*rxt(k,106) + mat(k,1536) = -( rxt(k,111) + rxt(k,840) + het_rates(k,223) ) + mat(k,1702) = -( rxt(k,112) + rxt(k,839) + het_rates(k,224) ) + mat(k,785) = .540_r8*rxt(k,108) + mat(k,689) = -( rxt(k,113) + het_rates(k,225) ) + mat(k,374) = rxt(k,102) + mat(k,601) = -( rxt(k,114) + het_rates(k,226) ) + mat(k,741) = -( rxt(k,115) + het_rates(k,227) ) + mat(k,211) = -( het_rates(k,228) ) + mat(k,229) = -( het_rates(k,229) ) + mat(k,842) = -( rxt(k,116) + het_rates(k,230) ) + mat(k,237) = -( het_rates(k,231) ) + mat(k,429) = -( rxt(k,117) + het_rates(k,232) ) + mat(k,550) = -( het_rates(k,235) ) + mat(k,157) = rxt(k,575) + mat(k,1182) = -( het_rates(k,236) ) + mat(k,2296) = -( het_rates(k,237) ) + mat(k,2441) = -( het_rates(k,238) ) + mat(k,57) = -( het_rates(k,239) ) + mat(k,2213) = -( het_rates(k,240) ) + mat(k,2408) = -( het_rates(k,241) ) + mat(k,63) = -( het_rates(k,242) ) + mat(k,514) = -( het_rates(k,243) ) + mat(k,69) = -( het_rates(k,244) ) + mat(k,2536) = -( het_rates(k,245) ) + mat(k,2380) = -( het_rates(k,246) ) + mat(k,75) = -( het_rates(k,247) ) + mat(k,437) = -( het_rates(k,248) ) + mat(k,1350) = -( het_rates(k,249) ) + mat(k,558) = rxt(k,76) + mat(k,1024) = -( het_rates(k,250) ) + end do + end subroutine linmat03 + subroutine linmat04( 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,711) = -( het_rates(k,251) ) + mat(k,2913) = -( het_rates(k,252) ) + mat(k,340) = rxt(k,26) + mat(k,2278) = rxt(k,34) + mat(k,1928) = rxt(k,35) + mat(k,980) = .330_r8*rxt(k,47) + mat(k,622) = .050_r8*rxt(k,48) + mat(k,635) = .070_r8*rxt(k,49) + mat(k,1772) = rxt(k,52) + mat(k,1876) = .500_r8*rxt(k,53) + mat(k,926) = rxt(k,55) + rxt(k,56) + mat(k,2019) = .350_r8*rxt(k,72) + mat(k,559) = rxt(k,76) + mat(k,335) = rxt(k,77) + mat(k,2044) = .300_r8*rxt(k,79) + mat(k,1919) = .750_r8*rxt(k,80) + mat(k,1502) = .560_r8*rxt(k,81) + mat(k,1483) = rxt(k,84) + mat(k,571) = .600_r8*rxt(k,86) + rxt(k,352) + mat(k,407) = rxt(k,89) + mat(k,225) = .500_r8*rxt(k,90) + mat(k,3463) = -( het_rates(k,253) ) + mat(k,1436) = rxt(k,33) + mat(k,2284) = rxt(k,34) + mat(k,706) = rxt(k,36) + mat(k,2266) = rxt(k,38) + mat(k,624) = .040_r8*rxt(k,48) + mat(k,637) = .070_r8*rxt(k,49) + mat(k,2025) = .650_r8*rxt(k,72) + mat(k,2050) = .300_r8*rxt(k,79) + mat(k,573) = .400_r8*rxt(k,86) + mat(k,650) = rxt(k,131) + mat(k,397) = rxt(k,133) + mat(k,906) = -( het_rates(k,254) ) + mat(k,302) = .600_r8*rxt(k,24) + mat(k,605) = -( het_rates(k,255) ) + mat(k,291) = -( rxt(k,343) + rxt(k,344) + het_rates(k,256) ) + mat(k,151) = rxt(k,42) + mat(k,855) = -( het_rates(k,257) ) + mat(k,3369) = -( rxt(k,812) + het_rates(k,258) ) + mat(k,444) = rxt(k,11) + rxt(k,216) + mat(k,759) = rxt(k,19) + mat(k,726) = .900_r8*rxt(k,20) + mat(k,421) = rxt(k,21) + mat(k,191) = 1.500_r8*rxt(k,22) + mat(k,470) = rxt(k,23) + mat(k,303) = .600_r8*rxt(k,24) + mat(k,404) = .600_r8*rxt(k,25) + mat(k,341) = rxt(k,26) + mat(k,356) = rxt(k,27) + mat(k,361) = rxt(k,28) + mat(k,414) = rxt(k,29) + mat(k,1435) = rxt(k,33) + mat(k,1930) = rxt(k,35) + mat(k,644) = .500_r8*rxt(k,41) + mat(k,1716) = 2.000_r8*rxt(k,43) + mat(k,1479) = 2.000_r8*rxt(k,44) + mat(k,887) = rxt(k,45) + mat(k,983) = .670_r8*rxt(k,47) + mat(k,623) = .620_r8*rxt(k,48) + mat(k,636) = .560_r8*rxt(k,49) + mat(k,493) = rxt(k,50) + mat(k,526) = rxt(k,51) + mat(k,1774) = rxt(k,52) + mat(k,1880) = 1.500_r8*rxt(k,53) + rxt(k,54) + mat(k,509) = rxt(k,57) + mat(k,1262) = rxt(k,58) + mat(k,776) = rxt(k,63) + mat(k,2086) = .450_r8*rxt(k,64) + mat(k,679) = rxt(k,65) + mat(k,598) = rxt(k,66) + mat(k,2118) = .450_r8*rxt(k,67) + mat(k,735) = rxt(k,68) + mat(k,1591) = rxt(k,70) + mat(k,1908) = rxt(k,71) + mat(k,2024) = rxt(k,72) + rxt(k,73) + mat(k,1783) = 1.250_r8*rxt(k,74) + mat(k,1466) = rxt(k,75) + mat(k,1923) = .500_r8*rxt(k,80) + mat(k,1504) = .440_r8*rxt(k,81) + mat(k,2147) = rxt(k,82) + mat(k,1458) = rxt(k,83) + mat(k,350) = rxt(k,87) + mat(k,582) = rxt(k,88) + mat(k,226) = rxt(k,90) + mat(k,2329) = rxt(k,91) + mat(k,474) = rxt(k,92) + mat(k,2365) = rxt(k,93) + mat(k,1294) = rxt(k,94) + mat(k,1723) = rxt(k,96) + mat(k,375) = rxt(k,102) + mat(k,1231) = rxt(k,103) + mat(k,971) = rxt(k,104) + mat(k,990) = .500_r8*rxt(k,105) + mat(k,686) = .540_r8*rxt(k,106) + mat(k,788) = .540_r8*rxt(k,108) + mat(k,1559) = rxt(k,109) + mat(k,1694) = rxt(k,110) + mat(k,1539) = rxt(k,111) + mat(k,1707) = rxt(k,112) + mat(k,691) = rxt(k,113) + mat(k,603) = rxt(k,114) + mat(k,749) = rxt(k,115) + mat(k,851) = rxt(k,116) + mat(k,433) = rxt(k,117) + mat(k,2936) = rxt(k,181) + mat(k,698) = rxt(k,313) + mat(k,294) = rxt(k,343) + rxt(k,344) + mat(k,1129) = rxt(k,458) + mat(k,1175) = rxt(k,462) + mat(k,1061) = rxt(k,465) + mat(k,1140) = rxt(k,468) + mat(k,1861) = .400_r8*rxt(k,529) + mat(k,1830) = .400_r8*rxt(k,532) + mat(k,693) = -( rxt(k,313) + het_rates(k,259) ) + mat(k,1298) = -( het_rates(k,260) ) + mat(k,1953) = -( rxt(k,427) + rxt(k,428) + rxt(k,429) + het_rates(k,261) ) + mat(k,268) = rxt(k,436) + mat(k,271) = rxt(k,438) + mat(k,1991) = -( rxt(k,433) + rxt(k,434) + rxt(k,435) + het_rates(k,262) ) + mat(k,274) = rxt(k,440) + mat(k,277) = rxt(k,442) + mat(k,266) = -( rxt(k,436) + rxt(k,437) + het_rates(k,263) ) + mat(k,1934) = rxt(k,428) + mat(k,1834) = rxt(k,494) + mat(k,269) = -( rxt(k,438) + rxt(k,439) + het_rates(k,264) ) + mat(k,1935) = rxt(k,429) + mat(k,1726) = rxt(k,447) + mat(k,272) = -( rxt(k,440) + rxt(k,441) + het_rates(k,265) ) + mat(k,1970) = rxt(k,434) + mat(k,1803) = rxt(k,498) + mat(k,275) = -( rxt(k,442) + rxt(k,443) + het_rates(k,266) ) + mat(k,1971) = rxt(k,435) + mat(k,1748) = rxt(k,451) + mat(k,1732) = -( rxt(k,447) + het_rates(k,267) ) + mat(k,270) = rxt(k,439) + mat(k,1754) = -( rxt(k,451) + het_rates(k,268) ) + mat(k,276) = rxt(k,443) + mat(k,1121) = -( rxt(k,458) + het_rates(k,269) ) + mat(k,1166) = -( rxt(k,462) + het_rates(k,270) ) + mat(k,1054) = -( rxt(k,465) + het_rates(k,271) ) + mat(k,1132) = -( rxt(k,468) + het_rates(k,272) ) + mat(k,1440) = -( het_rates(k,273) ) + mat(k,2180) = -( het_rates(k,274) ) + mat(k,1309) = -( rxt(k,480) + het_rates(k,275) ) + mat(k,1361) = -( rxt(k,483) + het_rates(k,276) ) + mat(k,81) = -( het_rates(k,277) ) + mat(k,1848) = -( rxt(k,494) + rxt(k,529) + het_rates(k,278) ) + mat(k,267) = rxt(k,437) + mat(k,1817) = -( rxt(k,498) + rxt(k,532) + het_rates(k,279) ) + mat(k,273) = rxt(k,441) + mat(k,87) = -( het_rates(k,280) ) + mat(k,2505) = -( het_rates(k,281) ) + mat(k,2339) = -( het_rates(k,282) ) + mat(k,95) = -( het_rates(k,283) ) + mat(k,1543) = -( rxt(k,384) + het_rates(k,284) ) + mat(k,630) = .190_r8*rxt(k,49) + mat(k,862) = -( het_rates(k,285) ) + mat(k,469) = .600_r8*rxt(k,23) + mat(k,1620) = -( het_rates(k,286) ) + mat(k,2012) = rxt(k,73) + mat(k,529) = rxt(k,78) + rxt(k,407) + mat(k,929) = -( het_rates(k,287) ) + mat(k,402) = .600_r8*rxt(k,25) + mat(k,763) = -( het_rates(k,288) ) + mat(k,1508) = -( het_rates(k,289) ) + mat(k,617) = .230_r8*rxt(k,48) + mat(k,2570) = -( het_rates(k,290) ) + mat(k,2471) = -( het_rates(k,291) ) + mat(k,101) = -( het_rates(k,292) ) + mat(k,1640) = -( rxt(k,500) + het_rates(k,293) ) + mat(k,3808) = -( rxt(k,170) + rxt(k,171) + het_rates(k,294) ) + mat(k,4125) = rxt(k,1) + mat(k,3767) = rxt(k,7) + mat(k,203) = rxt(k,12) + mat(k,4101) = -( het_rates(k,295) ) + mat(k,4127) = rxt(k,2) + mat(k,1492) = 2.000_r8*rxt(k,4) + mat(k,2960) = rxt(k,9) + mat(k,447) = rxt(k,10) + mat(k,727) = rxt(k,20) + mat(k,422) = rxt(k,21) + mat(k,357) = rxt(k,27) + mat(k,362) = rxt(k,28) + mat(k,415) = rxt(k,29) + mat(k,290) = rxt(k,30) + mat(k,707) = rxt(k,36) + mat(k,453) = rxt(k,37) + mat(k,2270) = .330_r8*rxt(k,39) + mat(k,645) = 1.500_r8*rxt(k,41) + mat(k,152) = rxt(k,42) + mat(k,888) = rxt(k,45) + mat(k,1214) = 2.000_r8*rxt(k,46) + mat(k,625) = 1.110_r8*rxt(k,48) + mat(k,638) = 1.180_r8*rxt(k,49) + mat(k,494) = rxt(k,50) + mat(k,527) = rxt(k,51) + mat(k,1882) = 3.000_r8*rxt(k,54) + mat(k,928) = rxt(k,55) + rxt(k,56) + mat(k,1802) = rxt(k,61) + mat(k,1474) = rxt(k,62) + mat(k,777) = rxt(k,63) + mat(k,2091) = .550_r8*rxt(k,64) + mat(k,2123) = .550_r8*rxt(k,67) + mat(k,1209) = rxt(k,69) + mat(k,1595) = rxt(k,70) + mat(k,1910) = rxt(k,71) + mat(k,1467) = rxt(k,75) + mat(k,336) = rxt(k,77) + mat(k,1505) = rxt(k,81) + mat(k,351) = rxt(k,87) + mat(k,583) = rxt(k,88) + mat(k,409) = rxt(k,89) + mat(k,2332) = rxt(k,91) + mat(k,475) = rxt(k,92) + mat(k,782) = rxt(k,98) + mat(k,367) = rxt(k,99) + mat(k,372) = rxt(k,100) + mat(k,376) = rxt(k,102) + mat(k,972) = rxt(k,104) + mat(k,992) = rxt(k,105) + mat(k,688) = rxt(k,106) + mat(k,1148) = rxt(k,107) + mat(k,790) = rxt(k,108) + mat(k,692) = rxt(k,113) + mat(k,604) = rxt(k,114) + mat(k,750) = rxt(k,115) + mat(k,852) = rxt(k,116) + mat(k,434) = rxt(k,117) + mat(k,1001) = rxt(k,149) + mat(k,1164) = rxt(k,150) + mat(k,1556) = rxt(k,384) + mat(k,1968) = rxt(k,427) + mat(k,2007) = rxt(k,433) + mat(k,1322) = rxt(k,480) + mat(k,1376) = rxt(k,483) + mat(k,1655) = rxt(k,500) + mat(k,1864) = .600_r8*rxt(k,529) + mat(k,1833) = .600_r8*rxt(k,532) + mat(k,3667) = .500_r8*rxt(k,830) + end do + end subroutine linmat04 + subroutine linmat05( 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,456) = -( het_rates(k,296) ) + mat(k,939) = -( het_rates(k,297) ) + mat(k,1336) = -( het_rates(k,298) ) + mat(k,951) = -( het_rates(k,299) ) + mat(k,1006) = -( het_rates(k,300) ) + mat(k,2654) = -( het_rates(k,301) ) + mat(k,2360) = rxt(k,93) + mat(k,780) = rxt(k,98) + mat(k,2745) = -( het_rates(k,302) ) + mat(k,659) = rxt(k,95) + rxt(k,790) + mat(k,2701) = -( het_rates(k,303) ) + mat(k,1291) = rxt(k,94) + mat(k,365) = rxt(k,99) + mat(k,2792) = -( het_rates(k,304) ) + mat(k,667) = rxt(k,97) + rxt(k,791) + mat(k,2235) = -( het_rates(k,305) ) + mat(k,2677) = -( het_rates(k,306) ) + mat(k,1720) = rxt(k,96) + mat(k,370) = rxt(k,100) + mat(k,2840) = -( het_rates(k,307) ) + mat(k,426) = rxt(k,101) + rxt(k,792) + mat(k,797) = -( het_rates(k,308) ) + mat(k,960) = -( het_rates(k,309) ) + mat(k,1218) = -( het_rates(k,310) ) + mat(k,1015) = -( het_rates(k,311) ) + mat(k,805) = -( het_rates(k,312) ) + mat(k,813) = -( het_rates(k,313) ) + mat(k,873) = -( het_rates(k,314) ) + mat(k,107) = -( het_rates(k,315) ) + mat(k,895) = -( het_rates(k,316) ) + mat(k,113) = -( het_rates(k,317) ) + mat(k,536) = -( het_rates(k,318) ) + mat(k,4128) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,319) ) + mat(k,2271) = .050_r8*rxt(k,39) + mat(k,155) = rxt(k,153) + mat(k,3379) = rxt(k,812) + end do + end subroutine linmat05 + 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 ) + call linmat03( avec_len, mat, y, rxt, het_rates ) + call linmat04( avec_len, mat, y, rxt, het_rates ) + call linmat05( avec_len, mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_strat_mam5_ts2/mo_lu_factor.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/mo_lu_factor.F90 new file mode 100644 index 0000000000..a0538a0ca3 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/mo_lu_factor.F90 @@ -0,0 +1,17290 @@ + 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) = 1._r8 / lu(k,10) + 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) = 1._r8 / lu(k,33) + 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) = 1._r8 / lu(k,37) + lu(k,38) = 1._r8 / lu(k,38) + lu(k,39) = 1._r8 / lu(k,39) + lu(k,40) = 1._r8 / lu(k,40) + lu(k,41) = 1._r8 / lu(k,41) + lu(k,42) = 1._r8 / lu(k,42) + lu(k,43) = 1._r8 / lu(k,43) + lu(k,44) = 1._r8 / lu(k,44) + lu(k,45) = 1._r8 / lu(k,45) + lu(k,51) = 1._r8 / lu(k,51) + lu(k,57) = 1._r8 / lu(k,57) + lu(k,63) = 1._r8 / lu(k,63) + lu(k,69) = 1._r8 / lu(k,69) + lu(k,75) = 1._r8 / lu(k,75) + lu(k,81) = 1._r8 / lu(k,81) + 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,87) = 1._r8 / lu(k,87) + lu(k,89) = 1._r8 / lu(k,89) + lu(k,95) = 1._r8 / lu(k,95) + lu(k,101) = 1._r8 / lu(k,101) + lu(k,107) = 1._r8 / lu(k,107) + lu(k,113) = 1._r8 / lu(k,113) + lu(k,114) = 1._r8 / lu(k,114) + lu(k,115) = lu(k,115) * lu(k,114) + lu(k,116) = lu(k,116) * lu(k,114) + lu(k,3515) = lu(k,3515) - lu(k,115) * lu(k,3497) + lu(k,3520) = lu(k,3520) - lu(k,116) * lu(k,3497) + lu(k,117) = 1._r8 / lu(k,117) + lu(k,118) = lu(k,118) * lu(k,117) + lu(k,119) = lu(k,119) * lu(k,117) + lu(k,4101) = lu(k,4101) - lu(k,118) * lu(k,3870) + lu(k,4102) = lu(k,4102) - lu(k,119) * lu(k,3870) + 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,3808) = lu(k,3808) - lu(k,121) * lu(k,3771) + lu(k,3809) = lu(k,3809) - lu(k,122) * lu(k,3771) + lu(k,123) = 1._r8 / lu(k,123) + lu(k,124) = lu(k,124) * lu(k,123) + lu(k,125) = lu(k,125) * lu(k,123) + lu(k,4092) = lu(k,4092) - lu(k,124) * lu(k,3871) + lu(k,4101) = lu(k,4101) - lu(k,125) * lu(k,3871) + lu(k,126) = 1._r8 / lu(k,126) + lu(k,127) = lu(k,127) * lu(k,126) + lu(k,128) = lu(k,128) * lu(k,126) + lu(k,129) = lu(k,129) * lu(k,126) + lu(k,3782) = lu(k,3782) - lu(k,127) * lu(k,3772) + lu(k,3793) = lu(k,3793) - lu(k,128) * lu(k,3772) + lu(k,3808) = lu(k,3808) - lu(k,129) * lu(k,3772) + 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,3984) = lu(k,3984) - lu(k,131) * lu(k,3872) + lu(k,4101) = lu(k,4101) - lu(k,132) * lu(k,3872) + lu(k,4102) = lu(k,4102) - lu(k,133) * lu(k,3872) + lu(k,134) = 1._r8 / lu(k,134) + lu(k,135) = lu(k,135) * lu(k,134) + lu(k,136) = lu(k,136) * lu(k,134) + lu(k,137) = lu(k,137) * lu(k,134) + lu(k,3784) = lu(k,3784) - lu(k,135) * lu(k,3773) + lu(k,3808) = lu(k,3808) - lu(k,136) * lu(k,3773) + lu(k,3809) = lu(k,3809) - lu(k,137) * lu(k,3773) + lu(k,138) = 1._r8 / lu(k,138) + lu(k,139) = lu(k,139) * lu(k,138) + lu(k,140) = lu(k,140) * lu(k,138) + lu(k,141) = lu(k,141) * lu(k,138) + lu(k,3782) = lu(k,3782) - lu(k,139) * lu(k,3774) + lu(k,3808) = lu(k,3808) - lu(k,140) * lu(k,3774) + lu(k,3809) = lu(k,3809) - lu(k,141) * lu(k,3774) + 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,3782) = lu(k,3782) - lu(k,143) * lu(k,3775) + lu(k,3808) = lu(k,3808) - lu(k,144) * lu(k,3775) + lu(k,3809) = lu(k,3809) - lu(k,145) * lu(k,3775) + lu(k,146) = 1._r8 / lu(k,146) + lu(k,147) = lu(k,147) * lu(k,146) + lu(k,148) = lu(k,148) * lu(k,146) + lu(k,149) = lu(k,149) * lu(k,146) + lu(k,4100) = lu(k,4100) - lu(k,147) * lu(k,3873) + lu(k,4101) = lu(k,4101) - lu(k,148) * lu(k,3873) + lu(k,4102) = lu(k,4102) - lu(k,149) * lu(k,3873) + lu(k,150) = 1._r8 / lu(k,150) + lu(k,151) = lu(k,151) * lu(k,150) + lu(k,152) = lu(k,152) * lu(k,150) + lu(k,854) = lu(k,854) - lu(k,151) * lu(k,853) + lu(k,861) = - lu(k,152) * lu(k,853) + lu(k,3218) = - lu(k,151) * lu(k,3216) + lu(k,3378) = lu(k,3378) - lu(k,152) * lu(k,3216) + lu(k,153) = 1._r8 / lu(k,153) + lu(k,154) = lu(k,154) * lu(k,153) + lu(k,155) = lu(k,155) * lu(k,153) + lu(k,279) = lu(k,279) - lu(k,154) * lu(k,278) + lu(k,282) = lu(k,282) - lu(k,155) * lu(k,278) + lu(k,4104) = lu(k,4104) - lu(k,154) * lu(k,4103) + lu(k,4128) = lu(k,4128) - lu(k,155) * lu(k,4103) + lu(k,156) = 1._r8 / lu(k,156) + lu(k,157) = lu(k,157) * lu(k,156) + lu(k,158) = lu(k,158) * lu(k,156) + lu(k,550) = lu(k,550) - lu(k,157) * lu(k,549) + lu(k,554) = lu(k,554) - lu(k,158) * lu(k,549) + lu(k,3625) = lu(k,3625) - lu(k,157) * lu(k,3617) + lu(k,3663) = lu(k,3663) - lu(k,158) * lu(k,3617) + 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,159) = 1._r8 / lu(k,159) + lu(k,160) = lu(k,160) * lu(k,159) + lu(k,161) = lu(k,161) * lu(k,159) + lu(k,162) = lu(k,162) * lu(k,159) + lu(k,163) = lu(k,163) * lu(k,159) + lu(k,3782) = lu(k,3782) - lu(k,160) * lu(k,3776) + lu(k,3793) = lu(k,3793) - lu(k,161) * lu(k,3776) + lu(k,3808) = lu(k,3808) - lu(k,162) * lu(k,3776) + lu(k,3809) = lu(k,3809) - lu(k,163) * lu(k,3776) + lu(k,164) = 1._r8 / lu(k,164) + lu(k,165) = lu(k,165) * lu(k,164) + lu(k,166) = lu(k,166) * lu(k,164) + lu(k,167) = lu(k,167) * lu(k,164) + lu(k,168) = lu(k,168) * lu(k,164) + lu(k,3782) = lu(k,3782) - lu(k,165) * lu(k,3777) + lu(k,3791) = lu(k,3791) - lu(k,166) * lu(k,3777) + lu(k,3793) = lu(k,3793) - lu(k,167) * lu(k,3777) + lu(k,3808) = lu(k,3808) - lu(k,168) * lu(k,3777) + lu(k,169) = 1._r8 / lu(k,169) + lu(k,170) = lu(k,170) * lu(k,169) + lu(k,171) = lu(k,171) * lu(k,169) + lu(k,172) = lu(k,172) * lu(k,169) + lu(k,173) = lu(k,173) * lu(k,169) + lu(k,3782) = lu(k,3782) - lu(k,170) * lu(k,3778) + lu(k,3784) = lu(k,3784) - lu(k,171) * lu(k,3778) + lu(k,3808) = lu(k,3808) - lu(k,172) * lu(k,3778) + lu(k,3809) = lu(k,3809) - lu(k,173) * lu(k,3778) + lu(k,174) = 1._r8 / lu(k,174) + lu(k,175) = lu(k,175) * lu(k,174) + lu(k,176) = lu(k,176) * lu(k,174) + lu(k,177) = lu(k,177) * lu(k,174) + lu(k,178) = lu(k,178) * lu(k,174) + lu(k,3782) = lu(k,3782) - lu(k,175) * lu(k,3779) + lu(k,3791) = lu(k,3791) - lu(k,176) * lu(k,3779) + lu(k,3808) = lu(k,3808) - lu(k,177) * lu(k,3779) + lu(k,3809) = lu(k,3809) - lu(k,178) * lu(k,3779) + lu(k,179) = 1._r8 / lu(k,179) + lu(k,180) = lu(k,180) * lu(k,179) + lu(k,1163) = lu(k,1163) - lu(k,180) * lu(k,1158) + lu(k,1332) = lu(k,1332) - lu(k,180) * lu(k,1323) + lu(k,3140) = lu(k,3140) - lu(k,180) * lu(k,3121) + lu(k,3520) = lu(k,3520) - lu(k,180) * lu(k,3498) + lu(k,3850) = lu(k,3850) - lu(k,180) * lu(k,3812) + 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,3875) = lu(k,3875) - lu(k,183) * lu(k,3874) + lu(k,3876) = lu(k,3876) - lu(k,184) * lu(k,3874) + lu(k,3928) = lu(k,3928) - lu(k,185) * lu(k,3874) + lu(k,4092) = lu(k,4092) - lu(k,186) * lu(k,3874) + lu(k,4101) = lu(k,4101) - lu(k,187) * lu(k,3874) + 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,3921) = - lu(k,189) * lu(k,3875) + lu(k,4057) = lu(k,4057) - lu(k,190) * lu(k,3875) + lu(k,4092) = lu(k,4092) - lu(k,191) * lu(k,3875) + lu(k,192) = 1._r8 / lu(k,192) + lu(k,193) = lu(k,193) * lu(k,192) + lu(k,194) = lu(k,194) * lu(k,192) + lu(k,195) = lu(k,195) * lu(k,192) + lu(k,196) = lu(k,196) * lu(k,192) + lu(k,3919) = lu(k,3919) - lu(k,193) * lu(k,3876) + lu(k,3924) = lu(k,3924) - lu(k,194) * lu(k,3876) + lu(k,4092) = lu(k,4092) - lu(k,195) * lu(k,3876) + lu(k,4101) = lu(k,4101) - lu(k,196) * lu(k,3876) + lu(k,197) = 1._r8 / lu(k,197) + lu(k,198) = lu(k,198) * lu(k,197) + lu(k,199) = lu(k,199) * lu(k,197) + lu(k,200) = lu(k,200) * lu(k,197) + lu(k,3801) = lu(k,3801) - lu(k,198) * lu(k,3780) + lu(k,3808) = lu(k,3808) - lu(k,199) * lu(k,3780) + lu(k,3810) = lu(k,3810) - lu(k,200) * lu(k,3780) + lu(k,4092) = lu(k,4092) - lu(k,198) * lu(k,3877) + lu(k,4099) = - lu(k,199) * lu(k,3877) + lu(k,4101) = lu(k,4101) - lu(k,200) * lu(k,3877) + lu(k,201) = 1._r8 / lu(k,201) + lu(k,202) = lu(k,202) * lu(k,201) + lu(k,203) = lu(k,203) * lu(k,201) + lu(k,479) = lu(k,479) - lu(k,202) * lu(k,476) + lu(k,482) = - lu(k,203) * lu(k,476) + lu(k,3654) = lu(k,3654) - lu(k,202) * lu(k,3618) + lu(k,3665) = - lu(k,203) * lu(k,3618) + lu(k,3797) = lu(k,3797) - lu(k,202) * lu(k,3781) + lu(k,3808) = lu(k,3808) - lu(k,203) * lu(k,3781) + lu(k,204) = 1._r8 / lu(k,204) + lu(k,205) = lu(k,205) * lu(k,204) + lu(k,206) = lu(k,206) * lu(k,204) + lu(k,1094) = - lu(k,205) * lu(k,1091) + lu(k,1105) = lu(k,1105) - lu(k,206) * lu(k,1091) + lu(k,3689) = - lu(k,205) * lu(k,3674) + lu(k,3769) = lu(k,3769) - lu(k,206) * lu(k,3674) + lu(k,3997) = lu(k,3997) - lu(k,205) * lu(k,3878) + lu(k,4101) = lu(k,4101) - lu(k,206) * lu(k,3878) + 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,207) = 1._r8 / lu(k,207) + lu(k,208) = lu(k,208) * lu(k,207) + lu(k,209) = lu(k,209) * lu(k,207) + lu(k,981) = lu(k,981) - lu(k,208) * lu(k,973) + lu(k,984) = lu(k,984) - lu(k,209) * lu(k,973) + lu(k,1920) = - lu(k,208) * lu(k,1911) + lu(k,1924) = lu(k,1924) - lu(k,209) * lu(k,1911) + lu(k,4087) = lu(k,4087) - lu(k,208) * lu(k,3879) + lu(k,4097) = lu(k,4097) - lu(k,209) * lu(k,3879) + lu(k,211) = 1._r8 / lu(k,211) + lu(k,212) = lu(k,212) * lu(k,211) + lu(k,213) = lu(k,213) * lu(k,211) + lu(k,214) = lu(k,214) * lu(k,211) + lu(k,215) = lu(k,215) * lu(k,211) + lu(k,216) = lu(k,216) * lu(k,211) + lu(k,217) = lu(k,217) * lu(k,211) + lu(k,3881) = lu(k,3881) - lu(k,212) * lu(k,3880) + lu(k,3882) = lu(k,3882) - lu(k,213) * lu(k,3880) + lu(k,3916) = lu(k,3916) - lu(k,214) * lu(k,3880) + lu(k,3968) = lu(k,3968) - lu(k,215) * lu(k,3880) + lu(k,4092) = lu(k,4092) - lu(k,216) * lu(k,3880) + lu(k,4101) = lu(k,4101) - lu(k,217) * lu(k,3880) + lu(k,218) = 1._r8 / lu(k,218) + lu(k,219) = lu(k,219) * lu(k,218) + lu(k,220) = lu(k,220) * lu(k,218) + lu(k,221) = lu(k,221) * lu(k,218) + lu(k,222) = lu(k,222) * lu(k,218) + lu(k,3919) = lu(k,3919) - lu(k,219) * lu(k,3881) + lu(k,3924) = lu(k,3924) - lu(k,220) * lu(k,3881) + lu(k,4092) = lu(k,4092) - lu(k,221) * lu(k,3881) + lu(k,4101) = lu(k,4101) - lu(k,222) * lu(k,3881) + lu(k,223) = 1._r8 / lu(k,223) + lu(k,224) = lu(k,224) * lu(k,223) + lu(k,225) = lu(k,225) * lu(k,223) + lu(k,226) = lu(k,226) * lu(k,223) + lu(k,233) = - lu(k,224) * lu(k,228) + lu(k,234) = - lu(k,225) * lu(k,228) + lu(k,235) = lu(k,235) - lu(k,226) * lu(k,228) + lu(k,4057) = lu(k,4057) - lu(k,224) * lu(k,3882) + lu(k,4085) = lu(k,4085) - lu(k,225) * lu(k,3882) + lu(k,4092) = lu(k,4092) - lu(k,226) * lu(k,3882) + lu(k,229) = 1._r8 / lu(k,229) + lu(k,230) = lu(k,230) * lu(k,229) + lu(k,231) = lu(k,231) * lu(k,229) + lu(k,232) = lu(k,232) * lu(k,229) + lu(k,233) = lu(k,233) * lu(k,229) + lu(k,234) = lu(k,234) * lu(k,229) + lu(k,235) = lu(k,235) * lu(k,229) + lu(k,236) = lu(k,236) * lu(k,229) + lu(k,3884) = lu(k,3884) - lu(k,230) * lu(k,3883) + lu(k,3916) = lu(k,3916) - lu(k,231) * lu(k,3883) + lu(k,3970) = lu(k,3970) - lu(k,232) * lu(k,3883) + lu(k,4057) = lu(k,4057) - lu(k,233) * lu(k,3883) + lu(k,4085) = lu(k,4085) - lu(k,234) * lu(k,3883) + lu(k,4092) = lu(k,4092) - lu(k,235) * lu(k,3883) + lu(k,4101) = lu(k,4101) - lu(k,236) * lu(k,3883) + lu(k,237) = 1._r8 / lu(k,237) + lu(k,238) = lu(k,238) * lu(k,237) + lu(k,239) = lu(k,239) * lu(k,237) + lu(k,240) = lu(k,240) * lu(k,237) + lu(k,241) = lu(k,241) * lu(k,237) + lu(k,3924) = lu(k,3924) - lu(k,238) * lu(k,3884) + lu(k,3931) = lu(k,3931) - lu(k,239) * lu(k,3884) + lu(k,4092) = lu(k,4092) - lu(k,240) * lu(k,3884) + lu(k,4101) = lu(k,4101) - lu(k,241) * lu(k,3884) + lu(k,242) = 1._r8 / lu(k,242) + lu(k,243) = lu(k,243) * lu(k,242) + lu(k,244) = lu(k,244) * lu(k,242) + lu(k,996) = lu(k,996) - lu(k,243) * lu(k,994) + lu(k,1000) = - lu(k,244) * lu(k,994) + lu(k,3126) = - lu(k,243) * lu(k,3122) + lu(k,3140) = lu(k,3140) - lu(k,244) * lu(k,3122) + lu(k,3479) = lu(k,3479) - lu(k,243) * lu(k,3473) + lu(k,3494) = lu(k,3494) - lu(k,244) * lu(k,3473) + lu(k,3505) = lu(k,3505) - lu(k,243) * lu(k,3499) + lu(k,3520) = lu(k,3520) - lu(k,244) * lu(k,3499) + lu(k,245) = 1._r8 / lu(k,245) + lu(k,246) = lu(k,246) * lu(k,245) + lu(k,247) = lu(k,247) * lu(k,245) + lu(k,355) = - lu(k,246) * lu(k,352) + lu(k,357) = lu(k,357) - lu(k,247) * lu(k,352) + lu(k,438) = - lu(k,246) * lu(k,435) + lu(k,442) = - lu(k,247) * lu(k,435) + lu(k,2990) = lu(k,2990) - lu(k,246) * lu(k,2978) + lu(k,3119) = lu(k,3119) - lu(k,247) * lu(k,2978) + lu(k,3933) = lu(k,3933) - lu(k,246) * lu(k,3885) + lu(k,4101) = lu(k,4101) - lu(k,247) * lu(k,3885) + 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,262) = - lu(k,249) * lu(k,260) + lu(k,263) = lu(k,263) - lu(k,250) * lu(k,260) + lu(k,327) = - lu(k,249) * lu(k,325) + lu(k,328) = lu(k,328) - lu(k,250) * lu(k,325) + lu(k,3791) = lu(k,3791) - lu(k,249) * lu(k,3782) + lu(k,3808) = lu(k,3808) - lu(k,250) * lu(k,3782) + lu(k,4003) = - lu(k,249) * lu(k,3886) + lu(k,4099) = lu(k,4099) - lu(k,250) * lu(k,3886) + 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,251) = 1._r8 / lu(k,251) + lu(k,252) = lu(k,252) * lu(k,251) + lu(k,253) = lu(k,253) * lu(k,251) + lu(k,254) = lu(k,254) * lu(k,251) + lu(k,255) = lu(k,255) * lu(k,251) + lu(k,3784) = lu(k,3784) - lu(k,252) * lu(k,3783) + lu(k,3808) = lu(k,3808) - lu(k,253) * lu(k,3783) + lu(k,3809) = lu(k,3809) - lu(k,254) * lu(k,3783) + lu(k,3810) = lu(k,3810) - lu(k,255) * lu(k,3783) + lu(k,3888) = lu(k,3888) - lu(k,252) * lu(k,3887) + lu(k,4099) = lu(k,4099) - lu(k,253) * lu(k,3887) + lu(k,4100) = lu(k,4100) - lu(k,254) * lu(k,3887) + lu(k,4101) = lu(k,4101) - lu(k,255) * lu(k,3887) + lu(k,256) = 1._r8 / lu(k,256) + lu(k,257) = lu(k,257) * lu(k,256) + lu(k,258) = lu(k,258) * lu(k,256) + lu(k,259) = lu(k,259) * lu(k,256) + lu(k,3791) = lu(k,3791) - lu(k,257) * lu(k,3784) + lu(k,3808) = lu(k,3808) - lu(k,258) * lu(k,3784) + lu(k,3809) = lu(k,3809) - lu(k,259) * lu(k,3784) + lu(k,4003) = lu(k,4003) - lu(k,257) * lu(k,3888) + lu(k,4099) = lu(k,4099) - lu(k,258) * lu(k,3888) + lu(k,4100) = lu(k,4100) - lu(k,259) * lu(k,3888) + lu(k,261) = 1._r8 / lu(k,261) + lu(k,262) = lu(k,262) * lu(k,261) + lu(k,263) = lu(k,263) * lu(k,261) + lu(k,264) = lu(k,264) * lu(k,261) + lu(k,265) = lu(k,265) * lu(k,261) + lu(k,3791) = lu(k,3791) - lu(k,262) * lu(k,3785) + lu(k,3808) = lu(k,3808) - lu(k,263) * lu(k,3785) + lu(k,3809) = lu(k,3809) - lu(k,264) * lu(k,3785) + lu(k,3810) = lu(k,3810) - lu(k,265) * lu(k,3785) + lu(k,4003) = lu(k,4003) - lu(k,262) * lu(k,3889) + lu(k,4099) = lu(k,4099) - lu(k,263) * lu(k,3889) + lu(k,4100) = lu(k,4100) - lu(k,264) * lu(k,3889) + lu(k,4101) = lu(k,4101) - lu(k,265) * lu(k,3889) + lu(k,266) = 1._r8 / lu(k,266) + lu(k,267) = lu(k,267) * lu(k,266) + lu(k,268) = lu(k,268) * lu(k,266) + lu(k,1416) = - lu(k,267) * lu(k,1404) + lu(k,1417) = - lu(k,268) * lu(k,1404) + lu(k,1848) = lu(k,1848) - lu(k,267) * lu(k,1834) + lu(k,1853) = - lu(k,268) * lu(k,1834) + lu(k,1948) = - lu(k,267) * lu(k,1934) + lu(k,1953) = lu(k,1953) - lu(k,268) * lu(k,1934) + lu(k,4048) = - lu(k,267) * lu(k,3890) + lu(k,4053) = lu(k,4053) - lu(k,268) * lu(k,3890) + lu(k,269) = 1._r8 / lu(k,269) + lu(k,270) = lu(k,270) * lu(k,269) + lu(k,271) = lu(k,271) * lu(k,269) + lu(k,1413) = - lu(k,270) * lu(k,1405) + lu(k,1417) = lu(k,1417) - lu(k,271) * lu(k,1405) + lu(k,1732) = lu(k,1732) - lu(k,270) * lu(k,1726) + lu(k,1737) = - lu(k,271) * lu(k,1726) + lu(k,1944) = - lu(k,270) * lu(k,1935) + lu(k,1953) = lu(k,1953) - lu(k,271) * lu(k,1935) + lu(k,4042) = - lu(k,270) * lu(k,3891) + lu(k,4053) = lu(k,4053) - lu(k,271) * lu(k,3891) + lu(k,272) = 1._r8 / lu(k,272) + lu(k,273) = lu(k,273) * lu(k,272) + lu(k,274) = lu(k,274) * lu(k,272) + lu(k,1415) = - lu(k,273) * lu(k,1406) + lu(k,1418) = - lu(k,274) * lu(k,1406) + lu(k,1817) = lu(k,1817) - lu(k,273) * lu(k,1803) + lu(k,1821) = - lu(k,274) * lu(k,1803) + lu(k,1985) = - lu(k,273) * lu(k,1970) + lu(k,1991) = lu(k,1991) - lu(k,274) * lu(k,1970) + lu(k,4047) = - lu(k,273) * lu(k,3892) + lu(k,4054) = lu(k,4054) - lu(k,274) * lu(k,3892) + lu(k,275) = 1._r8 / lu(k,275) + lu(k,276) = lu(k,276) * lu(k,275) + lu(k,277) = lu(k,277) * lu(k,275) + lu(k,1414) = - lu(k,276) * lu(k,1407) + lu(k,1418) = lu(k,1418) - lu(k,277) * lu(k,1407) + lu(k,1754) = lu(k,1754) - lu(k,276) * lu(k,1748) + lu(k,1759) = - lu(k,277) * lu(k,1748) + lu(k,1981) = - lu(k,276) * lu(k,1971) + lu(k,1991) = lu(k,1991) - lu(k,277) * lu(k,1971) + lu(k,4043) = - lu(k,276) * lu(k,3893) + lu(k,4054) = lu(k,4054) - lu(k,277) * lu(k,3893) + lu(k,279) = 1._r8 / lu(k,279) + lu(k,280) = lu(k,280) * lu(k,279) + lu(k,281) = lu(k,281) * lu(k,279) + lu(k,282) = lu(k,282) * lu(k,279) + lu(k,1235) = lu(k,1235) - lu(k,280) * lu(k,1234) + lu(k,1237) = lu(k,1237) - lu(k,281) * lu(k,1234) + lu(k,1240) = - lu(k,282) * lu(k,1234) + lu(k,4002) = lu(k,4002) - lu(k,280) * lu(k,3894) + lu(k,4090) = lu(k,4090) - lu(k,281) * lu(k,3894) + lu(k,4102) = lu(k,4102) - lu(k,282) * lu(k,3894) + lu(k,4106) = - lu(k,280) * lu(k,4104) + lu(k,4116) = lu(k,4116) - lu(k,281) * lu(k,4104) + lu(k,4128) = lu(k,4128) - lu(k,282) * lu(k,4104) + 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,1351) = lu(k,1351) - lu(k,284) * lu(k,1348) + lu(k,1355) = lu(k,1355) - lu(k,285) * lu(k,1348) + lu(k,1358) = - lu(k,286) * lu(k,1348) + lu(k,3392) = lu(k,3392) - lu(k,284) * lu(k,3381) + lu(k,3462) = lu(k,3462) - lu(k,285) * lu(k,3381) + lu(k,3471) = lu(k,3471) - lu(k,286) * lu(k,3381) + lu(k,4016) = lu(k,4016) - lu(k,284) * lu(k,3895) + lu(k,4092) = lu(k,4092) - lu(k,285) * lu(k,3895) + lu(k,4101) = lu(k,4101) - lu(k,286) * lu(k,3895) + 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,287) = 1._r8 / lu(k,287) + lu(k,288) = lu(k,288) * lu(k,287) + lu(k,289) = lu(k,289) * lu(k,287) + lu(k,290) = lu(k,290) * lu(k,287) + lu(k,710) = lu(k,710) - lu(k,288) * lu(k,709) + lu(k,711) = lu(k,711) - lu(k,289) * lu(k,709) + lu(k,716) = - lu(k,290) * lu(k,709) + lu(k,3236) = - lu(k,288) * lu(k,3217) + lu(k,3246) = lu(k,3246) - lu(k,289) * lu(k,3217) + lu(k,3378) = lu(k,3378) - lu(k,290) * lu(k,3217) + lu(k,3924) = lu(k,3924) - lu(k,288) * lu(k,3896) + lu(k,3951) = lu(k,3951) - lu(k,289) * lu(k,3896) + lu(k,4101) = lu(k,4101) - lu(k,290) * lu(k,3896) + lu(k,291) = 1._r8 / lu(k,291) + lu(k,292) = lu(k,292) * lu(k,291) + lu(k,293) = lu(k,293) * lu(k,291) + lu(k,294) = lu(k,294) * lu(k,291) + lu(k,856) = - lu(k,292) * lu(k,854) + lu(k,858) = lu(k,858) - lu(k,293) * lu(k,854) + lu(k,859) = lu(k,859) - lu(k,294) * lu(k,854) + lu(k,3057) = lu(k,3057) - lu(k,292) * lu(k,2979) + lu(k,3109) = lu(k,3109) - lu(k,293) * lu(k,2979) + lu(k,3110) = lu(k,3110) - lu(k,294) * lu(k,2979) + lu(k,3316) = lu(k,3316) - lu(k,292) * lu(k,3218) + lu(k,3368) = lu(k,3368) - lu(k,293) * lu(k,3218) + lu(k,3369) = lu(k,3369) - lu(k,294) * lu(k,3218) + lu(k,295) = 1._r8 / lu(k,295) + lu(k,296) = lu(k,296) * lu(k,295) + lu(k,297) = lu(k,297) * lu(k,295) + lu(k,298) = lu(k,298) * lu(k,295) + lu(k,299) = lu(k,299) * lu(k,295) + lu(k,300) = lu(k,300) * lu(k,295) + lu(k,3601) = lu(k,3601) - lu(k,296) * lu(k,3525) + lu(k,3602) = lu(k,3602) - lu(k,297) * lu(k,3525) + lu(k,3604) = lu(k,3604) - lu(k,298) * lu(k,3525) + lu(k,3610) = lu(k,3610) - lu(k,299) * lu(k,3525) + lu(k,3611) = lu(k,3611) - lu(k,300) * lu(k,3525) + lu(k,3653) = lu(k,3653) - lu(k,296) * lu(k,3619) + lu(k,3654) = lu(k,3654) - lu(k,297) * lu(k,3619) + lu(k,3656) = lu(k,3656) - lu(k,298) * lu(k,3619) + lu(k,3662) = lu(k,3662) - lu(k,299) * lu(k,3619) + lu(k,3663) = lu(k,3663) - lu(k,300) * lu(k,3619) + 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,744) = - lu(k,302) * lu(k,738) + lu(k,749) = lu(k,749) - lu(k,303) * lu(k,738) + lu(k,845) = - lu(k,302) * lu(k,838) + lu(k,851) = lu(k,851) - lu(k,303) * lu(k,838) + lu(k,874) = - lu(k,302) * lu(k,868) + lu(k,880) = lu(k,880) - lu(k,303) * lu(k,868) + lu(k,896) = - lu(k,302) * lu(k,889) + lu(k,903) = lu(k,903) - lu(k,303) * lu(k,889) + lu(k,3008) = lu(k,3008) - lu(k,302) * lu(k,2980) + lu(k,3110) = lu(k,3110) - lu(k,303) * lu(k,2980) + lu(k,304) = 1._r8 / lu(k,304) + lu(k,305) = lu(k,305) * lu(k,304) + lu(k,306) = lu(k,306) * lu(k,304) + lu(k,307) = lu(k,307) * lu(k,304) + lu(k,308) = lu(k,308) * lu(k,304) + lu(k,309) = lu(k,309) * lu(k,304) + lu(k,3537) = lu(k,3537) - lu(k,305) * lu(k,3526) + lu(k,3601) = lu(k,3601) - lu(k,306) * lu(k,3526) + lu(k,3606) = lu(k,3606) - lu(k,307) * lu(k,3526) + lu(k,3610) = lu(k,3610) - lu(k,308) * lu(k,3526) + lu(k,3615) = lu(k,3615) - lu(k,309) * lu(k,3526) + lu(k,4002) = lu(k,4002) - lu(k,305) * lu(k,3897) + lu(k,4087) = lu(k,4087) - lu(k,306) * lu(k,3897) + lu(k,4092) = lu(k,4092) - lu(k,307) * lu(k,3897) + lu(k,4096) = lu(k,4096) - lu(k,308) * lu(k,3897) + lu(k,4101) = lu(k,4101) - lu(k,309) * lu(k,3897) + lu(k,310) = 1._r8 / lu(k,310) + lu(k,311) = lu(k,311) * lu(k,310) + lu(k,312) = lu(k,312) * lu(k,310) + lu(k,313) = lu(k,313) * lu(k,310) + lu(k,314) = lu(k,314) * lu(k,310) + lu(k,315) = lu(k,315) * lu(k,310) + lu(k,3824) = - lu(k,311) * lu(k,3813) + lu(k,3826) = - lu(k,312) * lu(k,3813) + lu(k,3832) = lu(k,3832) - lu(k,313) * lu(k,3813) + lu(k,3842) = lu(k,3842) - lu(k,314) * lu(k,3813) + lu(k,3851) = lu(k,3851) - lu(k,315) * lu(k,3813) + lu(k,4013) = lu(k,4013) - lu(k,311) * lu(k,3898) + lu(k,4021) = lu(k,4021) - lu(k,312) * lu(k,3898) + lu(k,4057) = lu(k,4057) - lu(k,313) * lu(k,3898) + lu(k,4092) = lu(k,4092) - lu(k,314) * lu(k,3898) + lu(k,4101) = lu(k,4101) - lu(k,315) * lu(k,3898) + lu(k,316) = 1._r8 / lu(k,316) + lu(k,317) = lu(k,317) * lu(k,316) + lu(k,318) = lu(k,318) * lu(k,316) + lu(k,319) = lu(k,319) * lu(k,316) + lu(k,320) = lu(k,320) * lu(k,316) + lu(k,321) = lu(k,321) * lu(k,316) + lu(k,3823) = lu(k,3823) - lu(k,317) * lu(k,3814) + lu(k,3839) = lu(k,3839) - lu(k,318) * lu(k,3814) + lu(k,3850) = lu(k,3850) - lu(k,319) * lu(k,3814) + lu(k,3851) = lu(k,3851) - lu(k,320) * lu(k,3814) + lu(k,3852) = - lu(k,321) * lu(k,3814) + lu(k,4011) = lu(k,4011) - lu(k,317) * lu(k,3899) + lu(k,4089) = lu(k,4089) - lu(k,318) * lu(k,3899) + lu(k,4100) = lu(k,4100) - lu(k,319) * lu(k,3899) + lu(k,4101) = lu(k,4101) - lu(k,320) * lu(k,3899) + lu(k,4102) = lu(k,4102) - lu(k,321) * lu(k,3899) + lu(k,322) = 1._r8 / lu(k,322) + lu(k,323) = lu(k,323) * lu(k,322) + lu(k,324) = lu(k,324) * lu(k,322) + lu(k,1242) = lu(k,1242) - lu(k,323) * lu(k,1241) + lu(k,1245) = lu(k,1245) - lu(k,324) * lu(k,1241) + lu(k,1672) = lu(k,1672) - lu(k,323) * lu(k,1671) + lu(k,1675) = lu(k,1675) - lu(k,324) * lu(k,1671) + lu(k,2255) = lu(k,2255) - lu(k,323) * lu(k,2254) + lu(k,2260) = lu(k,2260) - lu(k,324) * lu(k,2254) + lu(k,2945) = lu(k,2945) - lu(k,323) * lu(k,2944) + lu(k,2948) = - lu(k,324) * lu(k,2944) + lu(k,4107) = lu(k,4107) - lu(k,323) * lu(k,4105) + lu(k,4112) = lu(k,4112) - lu(k,324) * lu(k,4105) + lu(k,326) = 1._r8 / lu(k,326) + lu(k,327) = lu(k,327) * lu(k,326) + lu(k,328) = lu(k,328) * lu(k,326) + lu(k,329) = lu(k,329) * lu(k,326) + lu(k,330) = lu(k,330) * lu(k,326) + lu(k,331) = lu(k,331) * lu(k,326) + lu(k,3791) = lu(k,3791) - lu(k,327) * lu(k,3786) + lu(k,3808) = lu(k,3808) - lu(k,328) * lu(k,3786) + lu(k,3809) = lu(k,3809) - lu(k,329) * lu(k,3786) + lu(k,3810) = lu(k,3810) - lu(k,330) * lu(k,3786) + lu(k,3811) = lu(k,3811) - lu(k,331) * lu(k,3786) + lu(k,4003) = lu(k,4003) - lu(k,327) * lu(k,3900) + lu(k,4099) = lu(k,4099) - lu(k,328) * lu(k,3900) + lu(k,4100) = lu(k,4100) - lu(k,329) * lu(k,3900) + lu(k,4101) = lu(k,4101) - lu(k,330) * lu(k,3900) + lu(k,4102) = lu(k,4102) - lu(k,331) * lu(k,3900) + 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,332) = 1._r8 / lu(k,332) + lu(k,333) = lu(k,333) * lu(k,332) + lu(k,334) = lu(k,334) * lu(k,332) + lu(k,335) = lu(k,335) * lu(k,332) + lu(k,336) = lu(k,336) * lu(k,332) + lu(k,763) = lu(k,763) - lu(k,333) * lu(k,762) + lu(k,764) = lu(k,764) - lu(k,334) * lu(k,762) + lu(k,765) = lu(k,765) - lu(k,335) * lu(k,762) + lu(k,769) = lu(k,769) - lu(k,336) * lu(k,762) + lu(k,3249) = lu(k,3249) - lu(k,333) * lu(k,3219) + lu(k,3294) = lu(k,3294) - lu(k,334) * lu(k,3219) + lu(k,3362) = lu(k,3362) - lu(k,335) * lu(k,3219) + lu(k,3378) = lu(k,3378) - lu(k,336) * lu(k,3219) + lu(k,3956) = lu(k,3956) - lu(k,333) * lu(k,3901) + lu(k,4016) = lu(k,4016) - lu(k,334) * lu(k,3901) + lu(k,4085) = lu(k,4085) - lu(k,335) * lu(k,3901) + lu(k,4101) = lu(k,4101) - lu(k,336) * lu(k,3901) + lu(k,337) = 1._r8 / lu(k,337) + lu(k,338) = lu(k,338) * lu(k,337) + lu(k,339) = lu(k,339) * lu(k,337) + lu(k,340) = lu(k,340) * lu(k,337) + lu(k,341) = lu(k,341) * lu(k,337) + lu(k,848) = lu(k,848) - lu(k,338) * lu(k,839) + lu(k,849) = - lu(k,339) * lu(k,839) + lu(k,850) = - lu(k,340) * lu(k,839) + lu(k,851) = lu(k,851) - lu(k,341) * lu(k,839) + lu(k,899) = lu(k,899) - lu(k,338) * lu(k,890) + lu(k,900) = - lu(k,339) * lu(k,890) + lu(k,901) = - lu(k,340) * lu(k,890) + lu(k,903) = lu(k,903) - lu(k,341) * lu(k,890) + lu(k,3069) = lu(k,3069) - lu(k,338) * lu(k,2981) + lu(k,3074) = lu(k,3074) - lu(k,339) * lu(k,2981) + lu(k,3103) = lu(k,3103) - lu(k,340) * lu(k,2981) + lu(k,3110) = lu(k,3110) - lu(k,341) * lu(k,2981) + 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,1599) = lu(k,1599) - lu(k,343) * lu(k,1597) + lu(k,1600) = lu(k,1600) - lu(k,344) * lu(k,1597) + lu(k,1604) = lu(k,1604) - lu(k,345) * lu(k,1597) + lu(k,1607) = lu(k,1607) - lu(k,346) * lu(k,1597) + lu(k,3477) = lu(k,3477) - lu(k,343) * lu(k,3474) + lu(k,3478) = lu(k,3478) - lu(k,344) * lu(k,3474) + lu(k,3484) = lu(k,3484) - lu(k,345) * lu(k,3474) + lu(k,3489) = lu(k,3489) - lu(k,346) * lu(k,3474) + lu(k,3502) = lu(k,3502) - lu(k,343) * lu(k,3500) + lu(k,3504) = lu(k,3504) - lu(k,344) * lu(k,3500) + lu(k,3510) = lu(k,3510) - lu(k,345) * lu(k,3500) + lu(k,3515) = lu(k,3515) - lu(k,346) * lu(k,3500) + lu(k,347) = 1._r8 / lu(k,347) + lu(k,348) = lu(k,348) * lu(k,347) + lu(k,349) = lu(k,349) * lu(k,347) + lu(k,350) = lu(k,350) * lu(k,347) + lu(k,351) = lu(k,351) * lu(k,347) + lu(k,456) = lu(k,456) - lu(k,348) * lu(k,455) + lu(k,457) = lu(k,457) - lu(k,349) * lu(k,455) + lu(k,459) = lu(k,459) - lu(k,350) * lu(k,455) + lu(k,461) = - lu(k,351) * lu(k,455) + lu(k,3233) = lu(k,3233) - lu(k,348) * lu(k,3220) + lu(k,3299) = lu(k,3299) - lu(k,349) * lu(k,3220) + lu(k,3369) = lu(k,3369) - lu(k,350) * lu(k,3220) + lu(k,3378) = lu(k,3378) - lu(k,351) * lu(k,3220) + lu(k,3919) = lu(k,3919) - lu(k,348) * lu(k,3902) + lu(k,4021) = lu(k,4021) - lu(k,349) * lu(k,3902) + lu(k,4092) = lu(k,4092) - lu(k,350) * lu(k,3902) + lu(k,4101) = lu(k,4101) - lu(k,351) * lu(k,3902) + lu(k,353) = 1._r8 / lu(k,353) + lu(k,354) = lu(k,354) * lu(k,353) + lu(k,355) = lu(k,355) * lu(k,353) + lu(k,356) = lu(k,356) * lu(k,353) + lu(k,357) = lu(k,357) * lu(k,353) + lu(k,437) = lu(k,437) - lu(k,354) * lu(k,436) + lu(k,438) = lu(k,438) - lu(k,355) * lu(k,436) + lu(k,440) = lu(k,440) - lu(k,356) * lu(k,436) + lu(k,442) = lu(k,442) - lu(k,357) * lu(k,436) + lu(k,3230) = lu(k,3230) - lu(k,354) * lu(k,3221) + lu(k,3239) = lu(k,3239) - lu(k,355) * lu(k,3221) + lu(k,3369) = lu(k,3369) - lu(k,356) * lu(k,3221) + lu(k,3378) = lu(k,3378) - lu(k,357) * lu(k,3221) + lu(k,3916) = lu(k,3916) - lu(k,354) * lu(k,3903) + lu(k,3933) = lu(k,3933) - lu(k,355) * lu(k,3903) + lu(k,4092) = lu(k,4092) - lu(k,356) * lu(k,3903) + lu(k,4101) = lu(k,4101) - lu(k,357) * lu(k,3903) + lu(k,358) = 1._r8 / lu(k,358) + lu(k,359) = lu(k,359) * lu(k,358) + lu(k,360) = lu(k,360) * lu(k,358) + lu(k,361) = lu(k,361) * lu(k,358) + lu(k,362) = lu(k,362) * lu(k,358) + lu(k,1350) = lu(k,1350) - lu(k,359) * lu(k,1349) + lu(k,1351) = lu(k,1351) - lu(k,360) * lu(k,1349) + lu(k,1355) = lu(k,1355) - lu(k,361) * lu(k,1349) + lu(k,1358) = lu(k,1358) - lu(k,362) * lu(k,1349) + lu(k,3291) = lu(k,3291) - lu(k,359) * lu(k,3222) + lu(k,3294) = lu(k,3294) - lu(k,360) * lu(k,3222) + lu(k,3369) = lu(k,3369) - lu(k,361) * lu(k,3222) + lu(k,3378) = lu(k,3378) - lu(k,362) * lu(k,3222) + lu(k,4011) = lu(k,4011) - lu(k,359) * lu(k,3904) + lu(k,4016) = lu(k,4016) - lu(k,360) * lu(k,3904) + lu(k,4092) = lu(k,4092) - lu(k,361) * lu(k,3904) + lu(k,4101) = lu(k,4101) - lu(k,362) * lu(k,3904) + lu(k,363) = 1._r8 / lu(k,363) + lu(k,364) = lu(k,364) * lu(k,363) + lu(k,365) = lu(k,365) * lu(k,363) + lu(k,366) = lu(k,366) * lu(k,363) + lu(k,367) = lu(k,367) * lu(k,363) + lu(k,2721) = lu(k,2721) - lu(k,364) * lu(k,2716) + lu(k,2744) = lu(k,2744) - lu(k,365) * lu(k,2716) + lu(k,2745) = lu(k,2745) - lu(k,366) * lu(k,2716) + lu(k,2760) = lu(k,2760) - lu(k,367) * lu(k,2716) + lu(k,3309) = lu(k,3309) - lu(k,364) * lu(k,3223) + lu(k,3358) = lu(k,3358) - lu(k,365) * lu(k,3223) + lu(k,3359) = lu(k,3359) - lu(k,366) * lu(k,3223) + lu(k,3378) = lu(k,3378) - lu(k,367) * lu(k,3223) + lu(k,4033) = lu(k,4033) - lu(k,364) * lu(k,3905) + lu(k,4081) = lu(k,4081) - lu(k,365) * lu(k,3905) + lu(k,4082) = lu(k,4082) - lu(k,366) * lu(k,3905) + lu(k,4101) = lu(k,4101) - lu(k,367) * lu(k,3905) + lu(k,368) = 1._r8 / lu(k,368) + lu(k,369) = lu(k,369) * lu(k,368) + lu(k,370) = lu(k,370) * lu(k,368) + lu(k,371) = lu(k,371) * lu(k,368) + lu(k,372) = lu(k,372) * lu(k,368) + lu(k,2767) = lu(k,2767) - lu(k,369) * lu(k,2762) + lu(k,2789) = lu(k,2789) - lu(k,370) * lu(k,2762) + lu(k,2792) = lu(k,2792) - lu(k,371) * lu(k,2762) + lu(k,2806) = lu(k,2806) - lu(k,372) * lu(k,2762) + lu(k,3309) = lu(k,3309) - lu(k,369) * lu(k,3224) + lu(k,3357) = lu(k,3357) - lu(k,370) * lu(k,3224) + lu(k,3360) = lu(k,3360) - lu(k,371) * lu(k,3224) + lu(k,3378) = lu(k,3378) - lu(k,372) * lu(k,3224) + lu(k,4033) = lu(k,4033) - lu(k,369) * lu(k,3906) + lu(k,4080) = lu(k,4080) - lu(k,370) * lu(k,3906) + lu(k,4083) = lu(k,4083) - lu(k,371) * lu(k,3906) + lu(k,4101) = lu(k,4101) - lu(k,372) * lu(k,3906) + lu(k,373) = 1._r8 / lu(k,373) + lu(k,374) = lu(k,374) * lu(k,373) + lu(k,375) = lu(k,375) * lu(k,373) + lu(k,376) = lu(k,376) * lu(k,373) + lu(k,950) = - lu(k,374) * lu(k,948) + lu(k,957) = lu(k,957) - lu(k,375) * lu(k,948) + lu(k,959) = lu(k,959) - lu(k,376) * lu(k,948) + lu(k,1004) = - lu(k,374) * lu(k,1003) + lu(k,1011) = lu(k,1011) - lu(k,375) * lu(k,1003) + lu(k,1013) = lu(k,1013) - lu(k,376) * lu(k,1003) + lu(k,3243) = lu(k,3243) - lu(k,374) * lu(k,3225) + lu(k,3369) = lu(k,3369) - lu(k,375) * lu(k,3225) + lu(k,3378) = lu(k,3378) - lu(k,376) * lu(k,3225) + lu(k,3949) = lu(k,3949) - lu(k,374) * lu(k,3907) + lu(k,4092) = lu(k,4092) - lu(k,375) * lu(k,3907) + lu(k,4101) = lu(k,4101) - lu(k,376) * lu(k,3907) + 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,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,3528) = - lu(k,378) * lu(k,3527) + lu(k,3544) = lu(k,3544) - lu(k,379) * lu(k,3527) + lu(k,3579) = lu(k,3579) - lu(k,380) * lu(k,3527) + lu(k,3605) = lu(k,3605) - lu(k,381) * lu(k,3527) + lu(k,3610) = lu(k,3610) - lu(k,382) * lu(k,3527) + lu(k,3611) = lu(k,3611) - lu(k,383) * lu(k,3527) + lu(k,3615) = lu(k,3615) - lu(k,384) * lu(k,3527) + lu(k,3940) = lu(k,3940) - lu(k,378) * lu(k,3908) + lu(k,4016) = lu(k,4016) - lu(k,379) * lu(k,3908) + lu(k,4065) = lu(k,4065) - lu(k,380) * lu(k,3908) + lu(k,4091) = lu(k,4091) - lu(k,381) * lu(k,3908) + lu(k,4096) = lu(k,4096) - lu(k,382) * lu(k,3908) + lu(k,4097) = lu(k,4097) - lu(k,383) * lu(k,3908) + lu(k,4101) = lu(k,4101) - lu(k,384) * lu(k,3908) + lu(k,385) = 1._r8 / lu(k,385) + lu(k,386) = lu(k,386) * lu(k,385) + lu(k,387) = lu(k,387) * lu(k,385) + lu(k,388) = lu(k,388) * lu(k,385) + lu(k,389) = lu(k,389) * lu(k,385) + lu(k,390) = lu(k,390) * lu(k,385) + lu(k,391) = lu(k,391) * lu(k,385) + lu(k,392) = lu(k,392) * lu(k,385) + lu(k,3144) = - lu(k,386) * lu(k,3143) + lu(k,3149) = - lu(k,387) * lu(k,3143) + lu(k,3152) = lu(k,3152) - lu(k,388) * lu(k,3143) + lu(k,3154) = lu(k,3154) - lu(k,389) * lu(k,3143) + lu(k,3157) = lu(k,3157) - lu(k,390) * lu(k,3143) + lu(k,3161) = lu(k,3161) - lu(k,391) * lu(k,3143) + lu(k,3172) = lu(k,3172) - lu(k,392) * lu(k,3143) + lu(k,3932) = lu(k,3932) - lu(k,386) * lu(k,3909) + lu(k,4002) = lu(k,4002) - lu(k,387) * lu(k,3909) + lu(k,4032) = lu(k,4032) - lu(k,388) * lu(k,3909) + lu(k,4057) = lu(k,4057) - lu(k,389) * lu(k,3909) + lu(k,4086) = lu(k,4086) - lu(k,390) * lu(k,3909) + lu(k,4090) = lu(k,4090) - lu(k,391) * lu(k,3909) + lu(k,4101) = lu(k,4101) - lu(k,392) * lu(k,3909) + lu(k,393) = 1._r8 / lu(k,393) + lu(k,394) = lu(k,394) * lu(k,393) + lu(k,395) = lu(k,395) * lu(k,393) + lu(k,396) = lu(k,396) * lu(k,393) + lu(k,397) = lu(k,397) * lu(k,393) + lu(k,398) = lu(k,398) * lu(k,393) + lu(k,399) = lu(k,399) * lu(k,393) + lu(k,400) = lu(k,400) * lu(k,393) + lu(k,3832) = lu(k,3832) - lu(k,394) * lu(k,3815) + lu(k,3839) = lu(k,3839) - lu(k,395) * lu(k,3815) + lu(k,3842) = lu(k,3842) - lu(k,396) * lu(k,3815) + lu(k,3843) = lu(k,3843) - lu(k,397) * lu(k,3815) + lu(k,3850) = lu(k,3850) - lu(k,398) * lu(k,3815) + lu(k,3851) = lu(k,3851) - lu(k,399) * lu(k,3815) + lu(k,3852) = lu(k,3852) - lu(k,400) * lu(k,3815) + lu(k,4057) = lu(k,4057) - lu(k,394) * lu(k,3910) + lu(k,4089) = lu(k,4089) - lu(k,395) * lu(k,3910) + lu(k,4092) = lu(k,4092) - lu(k,396) * lu(k,3910) + lu(k,4093) = lu(k,4093) - lu(k,397) * lu(k,3910) + lu(k,4100) = lu(k,4100) - lu(k,398) * lu(k,3910) + lu(k,4101) = lu(k,4101) - lu(k,399) * lu(k,3910) + lu(k,4102) = lu(k,4102) - lu(k,400) * lu(k,3910) + 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,745) = - lu(k,402) * lu(k,739) + lu(k,748) = - lu(k,403) * lu(k,739) + lu(k,749) = lu(k,749) - lu(k,404) * lu(k,739) + lu(k,846) = - lu(k,402) * lu(k,840) + lu(k,849) = lu(k,849) - lu(k,403) * lu(k,840) + lu(k,851) = lu(k,851) - lu(k,404) * lu(k,840) + lu(k,875) = - lu(k,402) * lu(k,869) + lu(k,878) = - lu(k,403) * lu(k,869) + lu(k,880) = lu(k,880) - lu(k,404) * lu(k,869) + lu(k,897) = - lu(k,402) * lu(k,891) + lu(k,900) = lu(k,900) - lu(k,403) * lu(k,891) + lu(k,903) = lu(k,903) - lu(k,404) * lu(k,891) + lu(k,3010) = lu(k,3010) - lu(k,402) * lu(k,2982) + lu(k,3074) = lu(k,3074) - lu(k,403) * lu(k,2982) + lu(k,3110) = lu(k,3110) - lu(k,404) * lu(k,2982) + lu(k,405) = 1._r8 / lu(k,405) + lu(k,406) = lu(k,406) * lu(k,405) + lu(k,407) = lu(k,407) * lu(k,405) + lu(k,408) = lu(k,408) * lu(k,405) + lu(k,409) = lu(k,409) * lu(k,405) + lu(k,410) = lu(k,410) * lu(k,405) + lu(k,1336) = lu(k,1336) - lu(k,406) * lu(k,1335) + lu(k,1340) = lu(k,1340) - lu(k,407) * lu(k,1335) + lu(k,1342) = lu(k,1342) - lu(k,408) * lu(k,1335) + lu(k,1346) = lu(k,1346) - lu(k,409) * lu(k,1335) + lu(k,1347) = - lu(k,410) * lu(k,1335) + lu(k,3290) = lu(k,3290) - lu(k,406) * lu(k,3226) + lu(k,3362) = lu(k,3362) - lu(k,407) * lu(k,3226) + lu(k,3368) = lu(k,3368) - lu(k,408) * lu(k,3226) + lu(k,3378) = lu(k,3378) - lu(k,409) * lu(k,3226) + lu(k,3379) = lu(k,3379) - lu(k,410) * lu(k,3226) + lu(k,4010) = lu(k,4010) - lu(k,406) * lu(k,3911) + lu(k,4085) = lu(k,4085) - lu(k,407) * lu(k,3911) + lu(k,4091) = lu(k,4091) - lu(k,408) * lu(k,3911) + lu(k,4101) = lu(k,4101) - lu(k,409) * lu(k,3911) + lu(k,4102) = lu(k,4102) - lu(k,410) * lu(k,3911) + lu(k,411) = 1._r8 / lu(k,411) + lu(k,412) = lu(k,412) * lu(k,411) + lu(k,413) = lu(k,413) * lu(k,411) + lu(k,414) = lu(k,414) * lu(k,411) + lu(k,415) = lu(k,415) * lu(k,411) + lu(k,416) = lu(k,416) * lu(k,411) + lu(k,1024) = lu(k,1024) - lu(k,412) * lu(k,1023) + lu(k,1026) = lu(k,1026) - lu(k,413) * lu(k,1023) + lu(k,1029) = lu(k,1029) - lu(k,414) * lu(k,1023) + lu(k,1032) = - lu(k,415) * lu(k,1023) + lu(k,1033) = - lu(k,416) * lu(k,1023) + lu(k,3274) = lu(k,3274) - lu(k,412) * lu(k,3227) + lu(k,3342) = lu(k,3342) - lu(k,413) * lu(k,3227) + lu(k,3369) = lu(k,3369) - lu(k,414) * lu(k,3227) + lu(k,3378) = lu(k,3378) - lu(k,415) * lu(k,3227) + lu(k,3379) = lu(k,3379) - lu(k,416) * lu(k,3227) + lu(k,3984) = lu(k,3984) - lu(k,412) * lu(k,3912) + lu(k,4065) = lu(k,4065) - lu(k,413) * lu(k,3912) + lu(k,4092) = lu(k,4092) - lu(k,414) * lu(k,3912) + lu(k,4101) = lu(k,4101) - lu(k,415) * lu(k,3912) + lu(k,4102) = lu(k,4102) - lu(k,416) * lu(k,3912) + 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,417) = 1._r8 / lu(k,417) + lu(k,418) = lu(k,418) * lu(k,417) + lu(k,419) = lu(k,419) * lu(k,417) + lu(k,420) = lu(k,420) * lu(k,417) + lu(k,421) = lu(k,421) * lu(k,417) + lu(k,422) = lu(k,422) * lu(k,417) + lu(k,513) = lu(k,513) - lu(k,418) * lu(k,512) + lu(k,514) = lu(k,514) - lu(k,419) * lu(k,512) + lu(k,516) = lu(k,516) - lu(k,420) * lu(k,512) + lu(k,518) = lu(k,518) - lu(k,421) * lu(k,512) + lu(k,520) = - lu(k,422) * lu(k,512) + lu(k,3234) = - lu(k,418) * lu(k,3228) + lu(k,3237) = lu(k,3237) - lu(k,419) * lu(k,3228) + lu(k,3299) = lu(k,3299) - lu(k,420) * lu(k,3228) + lu(k,3369) = lu(k,3369) - lu(k,421) * lu(k,3228) + lu(k,3378) = lu(k,3378) - lu(k,422) * lu(k,3228) + lu(k,3921) = lu(k,3921) - lu(k,418) * lu(k,3913) + lu(k,3928) = lu(k,3928) - lu(k,419) * lu(k,3913) + lu(k,4021) = lu(k,4021) - lu(k,420) * lu(k,3913) + lu(k,4092) = lu(k,4092) - lu(k,421) * lu(k,3913) + lu(k,4101) = lu(k,4101) - lu(k,422) * lu(k,3913) + lu(k,423) = 1._r8 / lu(k,423) + lu(k,424) = lu(k,424) * lu(k,423) + lu(k,425) = lu(k,425) * lu(k,423) + lu(k,426) = lu(k,426) * lu(k,423) + lu(k,427) = lu(k,427) * lu(k,423) + lu(k,428) = lu(k,428) * lu(k,423) + lu(k,2811) = - lu(k,424) * lu(k,2808) + lu(k,2818) = lu(k,2818) - lu(k,425) * lu(k,2808) + lu(k,2840) = lu(k,2840) - lu(k,426) * lu(k,2808) + lu(k,2850) = lu(k,2850) - lu(k,427) * lu(k,2808) + lu(k,2853) = lu(k,2853) - lu(k,428) * lu(k,2808) + lu(k,3636) = - lu(k,424) * lu(k,3620) + lu(k,3644) = - lu(k,425) * lu(k,3620) + lu(k,3650) = lu(k,3650) - lu(k,426) * lu(k,3620) + lu(k,3663) = lu(k,3663) - lu(k,427) * lu(k,3620) + lu(k,3667) = lu(k,3667) - lu(k,428) * lu(k,3620) + lu(k,4006) = lu(k,4006) - lu(k,424) * lu(k,3914) + lu(k,4057) = lu(k,4057) - lu(k,425) * lu(k,3914) + lu(k,4084) = lu(k,4084) - lu(k,426) * lu(k,3914) + lu(k,4097) = lu(k,4097) - lu(k,427) * lu(k,3914) + lu(k,4101) = lu(k,4101) - lu(k,428) * lu(k,3914) + 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,536) = lu(k,536) - lu(k,430) * lu(k,535) + lu(k,537) = lu(k,537) - lu(k,431) * lu(k,535) + lu(k,538) = lu(k,538) - lu(k,432) * lu(k,535) + lu(k,540) = lu(k,540) - lu(k,433) * lu(k,535) + lu(k,542) = - lu(k,434) * lu(k,535) + lu(k,3238) = lu(k,3238) - lu(k,430) * lu(k,3229) + lu(k,3299) = lu(k,3299) - lu(k,431) * lu(k,3229) + lu(k,3328) = lu(k,3328) - lu(k,432) * lu(k,3229) + lu(k,3369) = lu(k,3369) - lu(k,433) * lu(k,3229) + lu(k,3378) = lu(k,3378) - lu(k,434) * lu(k,3229) + lu(k,3931) = lu(k,3931) - lu(k,430) * lu(k,3915) + lu(k,4021) = lu(k,4021) - lu(k,431) * lu(k,3915) + lu(k,4052) = lu(k,4052) - lu(k,432) * lu(k,3915) + lu(k,4092) = lu(k,4092) - lu(k,433) * lu(k,3915) + lu(k,4101) = lu(k,4101) - lu(k,434) * lu(k,3915) + lu(k,437) = 1._r8 / lu(k,437) + lu(k,438) = lu(k,438) * lu(k,437) + lu(k,439) = lu(k,439) * lu(k,437) + lu(k,440) = lu(k,440) * lu(k,437) + lu(k,441) = lu(k,441) * lu(k,437) + lu(k,442) = lu(k,442) * lu(k,437) + lu(k,2990) = lu(k,2990) - lu(k,438) * lu(k,2983) + lu(k,3106) = lu(k,3106) - lu(k,439) * lu(k,2983) + lu(k,3110) = lu(k,3110) - lu(k,440) * lu(k,2983) + lu(k,3115) = lu(k,3115) - lu(k,441) * lu(k,2983) + lu(k,3119) = lu(k,3119) - lu(k,442) * lu(k,2983) + lu(k,3239) = lu(k,3239) - lu(k,438) * lu(k,3230) + lu(k,3365) = lu(k,3365) - lu(k,439) * lu(k,3230) + lu(k,3369) = lu(k,3369) - lu(k,440) * lu(k,3230) + lu(k,3374) = lu(k,3374) - lu(k,441) * lu(k,3230) + lu(k,3378) = lu(k,3378) - lu(k,442) * lu(k,3230) + lu(k,3933) = lu(k,3933) - lu(k,438) * lu(k,3916) + lu(k,4088) = lu(k,4088) - lu(k,439) * lu(k,3916) + lu(k,4092) = lu(k,4092) - lu(k,440) * lu(k,3916) + lu(k,4097) = lu(k,4097) - lu(k,441) * lu(k,3916) + lu(k,4101) = lu(k,4101) - lu(k,442) * lu(k,3916) + lu(k,443) = 1._r8 / lu(k,443) + lu(k,444) = lu(k,444) * lu(k,443) + lu(k,445) = lu(k,445) * lu(k,443) + lu(k,446) = lu(k,446) * lu(k,443) + lu(k,447) = lu(k,447) * lu(k,443) + lu(k,448) = lu(k,448) * lu(k,443) + lu(k,3369) = lu(k,3369) - lu(k,444) * lu(k,3231) + lu(k,3373) = lu(k,3373) - lu(k,445) * lu(k,3231) + lu(k,3374) = lu(k,3374) - lu(k,446) * lu(k,3231) + lu(k,3378) = lu(k,3378) - lu(k,447) * lu(k,3231) + lu(k,3379) = lu(k,3379) - lu(k,448) * lu(k,3231) + lu(k,3658) = lu(k,3658) - lu(k,444) * lu(k,3621) + lu(k,3662) = lu(k,3662) - lu(k,445) * lu(k,3621) + lu(k,3663) = lu(k,3663) - lu(k,446) * lu(k,3621) + lu(k,3667) = lu(k,3667) - lu(k,447) * lu(k,3621) + lu(k,3668) = - lu(k,448) * lu(k,3621) + lu(k,4092) = lu(k,4092) - lu(k,444) * lu(k,3917) + lu(k,4096) = lu(k,4096) - lu(k,445) * lu(k,3917) + lu(k,4097) = lu(k,4097) - lu(k,446) * lu(k,3917) + lu(k,4101) = lu(k,4101) - lu(k,447) * lu(k,3917) + lu(k,4102) = lu(k,4102) - lu(k,448) * lu(k,3917) + lu(k,449) = 1._r8 / lu(k,449) + lu(k,450) = lu(k,450) * lu(k,449) + lu(k,451) = lu(k,451) * lu(k,449) + lu(k,452) = lu(k,452) * lu(k,449) + lu(k,453) = lu(k,453) * lu(k,449) + lu(k,454) = lu(k,454) * lu(k,449) + lu(k,3363) = lu(k,3363) - lu(k,450) * lu(k,3232) + lu(k,3368) = lu(k,3368) - lu(k,451) * lu(k,3232) + lu(k,3370) = lu(k,3370) - lu(k,452) * lu(k,3232) + lu(k,3378) = lu(k,3378) - lu(k,453) * lu(k,3232) + lu(k,3379) = lu(k,3379) - lu(k,454) * lu(k,3232) + lu(k,3456) = - lu(k,450) * lu(k,3382) + lu(k,3461) = lu(k,3461) - lu(k,451) * lu(k,3382) + lu(k,3463) = lu(k,3463) - lu(k,452) * lu(k,3382) + lu(k,3471) = lu(k,3471) - lu(k,453) * lu(k,3382) + lu(k,3472) = - lu(k,454) * lu(k,3382) + lu(k,4086) = lu(k,4086) - lu(k,450) * lu(k,3918) + lu(k,4091) = lu(k,4091) - lu(k,451) * lu(k,3918) + lu(k,4093) = lu(k,4093) - lu(k,452) * lu(k,3918) + lu(k,4101) = lu(k,4101) - lu(k,453) * lu(k,3918) + lu(k,4102) = lu(k,4102) - lu(k,454) * lu(k,3918) + lu(k,456) = 1._r8 / lu(k,456) + lu(k,457) = lu(k,457) * lu(k,456) + lu(k,458) = lu(k,458) * lu(k,456) + lu(k,459) = lu(k,459) * lu(k,456) + lu(k,460) = lu(k,460) * lu(k,456) + lu(k,461) = lu(k,461) * lu(k,456) + lu(k,3042) = lu(k,3042) - lu(k,457) * lu(k,2984) + lu(k,3106) = lu(k,3106) - lu(k,458) * lu(k,2984) + lu(k,3110) = lu(k,3110) - lu(k,459) * lu(k,2984) + lu(k,3115) = lu(k,3115) - lu(k,460) * lu(k,2984) + lu(k,3119) = lu(k,3119) - lu(k,461) * lu(k,2984) + lu(k,3299) = lu(k,3299) - lu(k,457) * lu(k,3233) + lu(k,3365) = lu(k,3365) - lu(k,458) * lu(k,3233) + lu(k,3369) = lu(k,3369) - lu(k,459) * lu(k,3233) + lu(k,3374) = lu(k,3374) - lu(k,460) * lu(k,3233) + lu(k,3378) = lu(k,3378) - lu(k,461) * lu(k,3233) + lu(k,4021) = lu(k,4021) - lu(k,457) * lu(k,3919) + lu(k,4088) = lu(k,4088) - lu(k,458) * lu(k,3919) + lu(k,4092) = lu(k,4092) - lu(k,459) * lu(k,3919) + lu(k,4097) = lu(k,4097) - lu(k,460) * lu(k,3919) + lu(k,4101) = lu(k,4101) - lu(k,461) * lu(k,3919) + 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,462) = 1._r8 / lu(k,462) + lu(k,463) = lu(k,463) * lu(k,462) + lu(k,464) = lu(k,464) * lu(k,462) + lu(k,465) = lu(k,465) * lu(k,462) + lu(k,466) = lu(k,466) * lu(k,462) + lu(k,467) = lu(k,467) * lu(k,462) + lu(k,3793) = lu(k,3793) - lu(k,463) * lu(k,3787) + lu(k,3798) = lu(k,3798) - lu(k,464) * lu(k,3787) + lu(k,3808) = lu(k,3808) - lu(k,465) * lu(k,3787) + lu(k,3809) = lu(k,3809) - lu(k,466) * lu(k,3787) + lu(k,3810) = lu(k,3810) - lu(k,467) * lu(k,3787) + lu(k,3833) = lu(k,3833) - lu(k,463) * lu(k,3816) + lu(k,3839) = lu(k,3839) - lu(k,464) * lu(k,3816) + lu(k,3849) = - lu(k,465) * lu(k,3816) + lu(k,3850) = lu(k,3850) - lu(k,466) * lu(k,3816) + lu(k,3851) = lu(k,3851) - lu(k,467) * lu(k,3816) + lu(k,4062) = lu(k,4062) - lu(k,463) * lu(k,3920) + lu(k,4089) = lu(k,4089) - lu(k,464) * lu(k,3920) + lu(k,4099) = lu(k,4099) - lu(k,465) * lu(k,3920) + lu(k,4100) = lu(k,4100) - lu(k,466) * lu(k,3920) + lu(k,4101) = lu(k,4101) - lu(k,467) * lu(k,3920) + lu(k,468) = 1._r8 / lu(k,468) + lu(k,469) = lu(k,469) * lu(k,468) + lu(k,470) = lu(k,470) * lu(k,468) + lu(k,515) = - lu(k,469) * lu(k,513) + lu(k,518) = lu(k,518) - lu(k,470) * lu(k,513) + lu(k,742) = - lu(k,469) * lu(k,740) + lu(k,749) = lu(k,749) - lu(k,470) * lu(k,740) + lu(k,843) = - lu(k,469) * lu(k,841) + lu(k,851) = lu(k,851) - lu(k,470) * lu(k,841) + lu(k,872) = - lu(k,469) * lu(k,870) + lu(k,880) = lu(k,880) - lu(k,470) * lu(k,870) + lu(k,894) = - lu(k,469) * lu(k,892) + lu(k,903) = lu(k,903) - lu(k,470) * lu(k,892) + lu(k,3004) = lu(k,3004) - lu(k,469) * lu(k,2985) + lu(k,3110) = lu(k,3110) - lu(k,470) * lu(k,2985) + lu(k,3259) = lu(k,3259) - lu(k,469) * lu(k,3234) + lu(k,3369) = lu(k,3369) - lu(k,470) * lu(k,3234) + lu(k,3967) = - lu(k,469) * lu(k,3921) + lu(k,4092) = lu(k,4092) - lu(k,470) * lu(k,3921) + lu(k,471) = 1._r8 / lu(k,471) + lu(k,472) = lu(k,472) * lu(k,471) + lu(k,473) = lu(k,473) * lu(k,471) + lu(k,474) = lu(k,474) * lu(k,471) + lu(k,475) = lu(k,475) * lu(k,471) + lu(k,2401) = - lu(k,472) * lu(k,2400) + lu(k,2409) = lu(k,2409) - lu(k,473) * lu(k,2400) + lu(k,2422) = lu(k,2422) - lu(k,474) * lu(k,2400) + lu(k,2426) = lu(k,2426) - lu(k,475) * lu(k,2400) + lu(k,2461) = - lu(k,472) * lu(k,2460) + lu(k,2472) = lu(k,2472) - lu(k,473) * lu(k,2460) + lu(k,2485) = lu(k,2485) - lu(k,474) * lu(k,2460) + lu(k,2489) = lu(k,2489) - lu(k,475) * lu(k,2460) + lu(k,3272) = lu(k,3272) - lu(k,472) * lu(k,3235) + lu(k,3354) = lu(k,3354) - lu(k,473) * lu(k,3235) + lu(k,3369) = lu(k,3369) - lu(k,474) * lu(k,3235) + lu(k,3378) = lu(k,3378) - lu(k,475) * lu(k,3235) + lu(k,3982) = lu(k,3982) - lu(k,472) * lu(k,3922) + lu(k,4077) = lu(k,4077) - lu(k,473) * lu(k,3922) + lu(k,4092) = lu(k,4092) - lu(k,474) * lu(k,3922) + lu(k,4101) = lu(k,4101) - lu(k,475) * lu(k,3922) + 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,3104) = - lu(k,478) * lu(k,2986) + lu(k,3106) = lu(k,3106) - lu(k,479) * lu(k,2986) + lu(k,3108) = lu(k,3108) - lu(k,480) * lu(k,2986) + lu(k,3115) = lu(k,3115) - lu(k,481) * lu(k,2986) + lu(k,3117) = - lu(k,482) * lu(k,2986) + lu(k,3119) = lu(k,3119) - lu(k,483) * lu(k,2986) + lu(k,3652) = - lu(k,478) * lu(k,3622) + lu(k,3654) = lu(k,3654) - lu(k,479) * lu(k,3622) + lu(k,3656) = lu(k,3656) - lu(k,480) * lu(k,3622) + lu(k,3663) = lu(k,3663) - lu(k,481) * lu(k,3622) + lu(k,3665) = lu(k,3665) - lu(k,482) * lu(k,3622) + lu(k,3667) = lu(k,3667) - lu(k,483) * lu(k,3622) + lu(k,4086) = lu(k,4086) - lu(k,478) * lu(k,3923) + lu(k,4088) = lu(k,4088) - lu(k,479) * lu(k,3923) + lu(k,4090) = lu(k,4090) - lu(k,480) * lu(k,3923) + lu(k,4097) = lu(k,4097) - lu(k,481) * lu(k,3923) + lu(k,4099) = lu(k,4099) - lu(k,482) * lu(k,3923) + lu(k,4101) = lu(k,4101) - lu(k,483) * lu(k,3923) + lu(k,484) = 1._r8 / lu(k,484) + lu(k,485) = lu(k,485) * lu(k,484) + lu(k,486) = lu(k,486) * lu(k,484) + lu(k,487) = lu(k,487) * lu(k,484) + lu(k,711) = lu(k,711) - lu(k,485) * lu(k,710) + lu(k,714) = lu(k,714) - lu(k,486) * lu(k,710) + lu(k,715) = - lu(k,487) * lu(k,710) + lu(k,2997) = lu(k,2997) - lu(k,485) * lu(k,2987) + lu(k,3115) = lu(k,3115) - lu(k,486) * lu(k,2987) + lu(k,3116) = lu(k,3116) - lu(k,487) * lu(k,2987) + lu(k,3246) = lu(k,3246) - lu(k,485) * lu(k,3236) + lu(k,3374) = lu(k,3374) - lu(k,486) * lu(k,3236) + lu(k,3375) = lu(k,3375) - lu(k,487) * lu(k,3236) + lu(k,3630) = - lu(k,485) * lu(k,3623) + lu(k,3663) = lu(k,3663) - lu(k,486) * lu(k,3623) + lu(k,3664) = lu(k,3664) - lu(k,487) * lu(k,3623) + lu(k,3678) = lu(k,3678) - lu(k,485) * lu(k,3675) + lu(k,3765) = lu(k,3765) - lu(k,486) * lu(k,3675) + lu(k,3766) = lu(k,3766) - lu(k,487) * lu(k,3675) + lu(k,3951) = lu(k,3951) - lu(k,485) * lu(k,3924) + lu(k,4097) = lu(k,4097) - lu(k,486) * lu(k,3924) + lu(k,4098) = lu(k,4098) - lu(k,487) * lu(k,3924) + lu(k,488) = 1._r8 / lu(k,488) + lu(k,489) = lu(k,489) * lu(k,488) + lu(k,490) = lu(k,490) * lu(k,488) + lu(k,491) = lu(k,491) * lu(k,488) + lu(k,492) = lu(k,492) * lu(k,488) + lu(k,493) = lu(k,493) * lu(k,488) + lu(k,494) = lu(k,494) * lu(k,488) + lu(k,1838) = - lu(k,489) * lu(k,1835) + lu(k,1843) = lu(k,1843) - lu(k,490) * lu(k,1835) + lu(k,1854) = - lu(k,491) * lu(k,1835) + lu(k,1855) = lu(k,1855) - lu(k,492) * lu(k,1835) + lu(k,1861) = lu(k,1861) - lu(k,493) * lu(k,1835) + lu(k,1864) = lu(k,1864) - lu(k,494) * lu(k,1835) + lu(k,1886) = - lu(k,489) * lu(k,1883) + lu(k,1889) = - lu(k,490) * lu(k,1883) + lu(k,1902) = lu(k,1902) - lu(k,491) * lu(k,1883) + lu(k,1903) = - lu(k,492) * lu(k,1883) + lu(k,1908) = lu(k,1908) - lu(k,493) * lu(k,1883) + lu(k,1910) = lu(k,1910) - lu(k,494) * lu(k,1883) + lu(k,3972) = lu(k,3972) - lu(k,489) * lu(k,3925) + lu(k,4025) = lu(k,4025) - lu(k,490) * lu(k,3925) + lu(k,4056) = lu(k,4056) - lu(k,491) * lu(k,3925) + lu(k,4057) = lu(k,4057) - lu(k,492) * lu(k,3925) + lu(k,4092) = lu(k,4092) - lu(k,493) * lu(k,3925) + lu(k,4101) = lu(k,4101) - lu(k,494) * lu(k,3925) + 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,495) = 1._r8 / lu(k,495) + lu(k,496) = lu(k,496) * lu(k,495) + lu(k,497) = lu(k,497) * lu(k,495) + lu(k,498) = lu(k,498) * lu(k,495) + lu(k,499) = lu(k,499) * lu(k,495) + lu(k,500) = lu(k,500) * lu(k,495) + lu(k,501) = lu(k,501) * lu(k,495) + lu(k,3793) = lu(k,3793) - lu(k,496) * lu(k,3788) + lu(k,3798) = lu(k,3798) - lu(k,497) * lu(k,3788) + lu(k,3808) = lu(k,3808) - lu(k,498) * lu(k,3788) + lu(k,3809) = lu(k,3809) - lu(k,499) * lu(k,3788) + lu(k,3810) = lu(k,3810) - lu(k,500) * lu(k,3788) + lu(k,3811) = lu(k,3811) - lu(k,501) * lu(k,3788) + lu(k,3833) = lu(k,3833) - lu(k,496) * lu(k,3817) + lu(k,3839) = lu(k,3839) - lu(k,497) * lu(k,3817) + lu(k,3849) = lu(k,3849) - lu(k,498) * lu(k,3817) + lu(k,3850) = lu(k,3850) - lu(k,499) * lu(k,3817) + lu(k,3851) = lu(k,3851) - lu(k,500) * lu(k,3817) + lu(k,3852) = lu(k,3852) - lu(k,501) * lu(k,3817) + lu(k,4062) = lu(k,4062) - lu(k,496) * lu(k,3926) + lu(k,4089) = lu(k,4089) - lu(k,497) * lu(k,3926) + lu(k,4099) = lu(k,4099) - lu(k,498) * lu(k,3926) + lu(k,4100) = lu(k,4100) - lu(k,499) * lu(k,3926) + lu(k,4101) = lu(k,4101) - lu(k,500) * lu(k,3926) + lu(k,4102) = lu(k,4102) - lu(k,501) * lu(k,3926) + lu(k,502) = 1._r8 / lu(k,502) + lu(k,503) = lu(k,503) * lu(k,502) + lu(k,504) = lu(k,504) * lu(k,502) + lu(k,505) = lu(k,505) * lu(k,502) + lu(k,506) = lu(k,506) * lu(k,502) + lu(k,507) = lu(k,507) * lu(k,502) + lu(k,508) = lu(k,508) * lu(k,502) + lu(k,509) = lu(k,509) * lu(k,502) + lu(k,510) = lu(k,510) * lu(k,502) + lu(k,511) = lu(k,511) * lu(k,502) + lu(k,1193) = - lu(k,503) * lu(k,1192) + lu(k,1196) = - lu(k,504) * lu(k,1192) + lu(k,1197) = - lu(k,505) * lu(k,1192) + lu(k,1199) = - lu(k,506) * lu(k,1192) + lu(k,1205) = - lu(k,507) * lu(k,1192) + lu(k,1206) = lu(k,1206) - lu(k,508) * lu(k,1192) + lu(k,1207) = - lu(k,509) * lu(k,1192) + lu(k,1208) = lu(k,1208) - lu(k,510) * lu(k,1192) + lu(k,1209) = lu(k,1209) - lu(k,511) * lu(k,1192) + lu(k,3972) = lu(k,3972) - lu(k,503) * lu(k,3927) + lu(k,4013) = lu(k,4013) - lu(k,504) * lu(k,3927) + lu(k,4035) = lu(k,4035) - lu(k,505) * lu(k,3927) + lu(k,4052) = lu(k,4052) - lu(k,506) * lu(k,3927) + lu(k,4087) = lu(k,4087) - lu(k,507) * lu(k,3927) + lu(k,4091) = lu(k,4091) - lu(k,508) * lu(k,3927) + lu(k,4092) = lu(k,4092) - lu(k,509) * lu(k,3927) + lu(k,4097) = lu(k,4097) - lu(k,510) * lu(k,3927) + lu(k,4101) = lu(k,4101) - lu(k,511) * lu(k,3927) + 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,3004) = lu(k,3004) - lu(k,515) * lu(k,2988) + lu(k,3042) = lu(k,3042) - lu(k,516) * lu(k,2988) + lu(k,3106) = lu(k,3106) - lu(k,517) * lu(k,2988) + lu(k,3110) = lu(k,3110) - lu(k,518) * lu(k,2988) + lu(k,3115) = lu(k,3115) - lu(k,519) * lu(k,2988) + lu(k,3119) = lu(k,3119) - lu(k,520) * lu(k,2988) + lu(k,3259) = lu(k,3259) - lu(k,515) * lu(k,3237) + lu(k,3299) = lu(k,3299) - lu(k,516) * lu(k,3237) + lu(k,3365) = lu(k,3365) - lu(k,517) * lu(k,3237) + lu(k,3369) = lu(k,3369) - lu(k,518) * lu(k,3237) + lu(k,3374) = lu(k,3374) - lu(k,519) * lu(k,3237) + lu(k,3378) = lu(k,3378) - lu(k,520) * lu(k,3237) + lu(k,3967) = lu(k,3967) - lu(k,515) * lu(k,3928) + lu(k,4021) = lu(k,4021) - lu(k,516) * lu(k,3928) + lu(k,4088) = lu(k,4088) - lu(k,517) * lu(k,3928) + lu(k,4092) = lu(k,4092) - lu(k,518) * lu(k,3928) + lu(k,4097) = lu(k,4097) - lu(k,519) * lu(k,3928) + lu(k,4101) = lu(k,4101) - lu(k,520) * lu(k,3928) + lu(k,521) = 1._r8 / lu(k,521) + lu(k,522) = lu(k,522) * lu(k,521) + lu(k,523) = lu(k,523) * lu(k,521) + lu(k,524) = lu(k,524) * lu(k,521) + lu(k,525) = lu(k,525) * lu(k,521) + lu(k,526) = lu(k,526) * lu(k,521) + lu(k,527) = lu(k,527) * lu(k,521) + lu(k,1807) = - lu(k,522) * lu(k,1804) + lu(k,1810) = lu(k,1810) - lu(k,523) * lu(k,1804) + lu(k,1822) = - lu(k,524) * lu(k,1804) + lu(k,1823) = lu(k,1823) - lu(k,525) * lu(k,1804) + lu(k,1830) = lu(k,1830) - lu(k,526) * lu(k,1804) + lu(k,1833) = lu(k,1833) - lu(k,527) * lu(k,1804) + lu(k,1886) = lu(k,1886) - lu(k,522) * lu(k,1884) + lu(k,1887) = - lu(k,523) * lu(k,1884) + lu(k,1901) = lu(k,1901) - lu(k,524) * lu(k,1884) + lu(k,1903) = lu(k,1903) - lu(k,525) * lu(k,1884) + lu(k,1908) = lu(k,1908) - lu(k,526) * lu(k,1884) + lu(k,1910) = lu(k,1910) - lu(k,527) * lu(k,1884) + lu(k,3972) = lu(k,3972) - lu(k,522) * lu(k,3929) + lu(k,4019) = lu(k,4019) - lu(k,523) * lu(k,3929) + lu(k,4055) = lu(k,4055) - lu(k,524) * lu(k,3929) + lu(k,4057) = lu(k,4057) - lu(k,525) * lu(k,3929) + lu(k,4092) = lu(k,4092) - lu(k,526) * lu(k,3929) + lu(k,4101) = lu(k,4101) - lu(k,527) * lu(k,3929) + lu(k,528) = 1._r8 / lu(k,528) + lu(k,529) = lu(k,529) * lu(k,528) + lu(k,530) = lu(k,530) * lu(k,528) + lu(k,531) = lu(k,531) * lu(k,528) + lu(k,532) = lu(k,532) * lu(k,528) + lu(k,533) = lu(k,533) * lu(k,528) + lu(k,534) = lu(k,534) * lu(k,528) + lu(k,1620) = lu(k,1620) - lu(k,529) * lu(k,1616) + lu(k,1621) = - lu(k,530) * lu(k,1616) + lu(k,1622) = lu(k,1622) - lu(k,531) * lu(k,1616) + lu(k,1629) = lu(k,1629) - lu(k,532) * lu(k,1616) + lu(k,1630) = lu(k,1630) - lu(k,533) * lu(k,1616) + lu(k,1632) = lu(k,1632) - lu(k,534) * lu(k,1616) + lu(k,3641) = lu(k,3641) - lu(k,529) * lu(k,3624) + lu(k,3642) = - lu(k,530) * lu(k,3624) + lu(k,3644) = lu(k,3644) - lu(k,531) * lu(k,3624) + lu(k,3662) = lu(k,3662) - lu(k,532) * lu(k,3624) + lu(k,3663) = lu(k,3663) - lu(k,533) * lu(k,3624) + lu(k,3667) = lu(k,3667) - lu(k,534) * lu(k,3624) + lu(k,4034) = lu(k,4034) - lu(k,529) * lu(k,3930) + lu(k,4044) = lu(k,4044) - lu(k,530) * lu(k,3930) + lu(k,4057) = lu(k,4057) - lu(k,531) * lu(k,3930) + lu(k,4096) = lu(k,4096) - lu(k,532) * lu(k,3930) + lu(k,4097) = lu(k,4097) - lu(k,533) * lu(k,3930) + lu(k,4101) = lu(k,4101) - lu(k,534) * lu(k,3930) + lu(k,536) = 1._r8 / lu(k,536) + lu(k,537) = lu(k,537) * lu(k,536) + lu(k,538) = lu(k,538) * lu(k,536) + lu(k,539) = lu(k,539) * lu(k,536) + lu(k,540) = lu(k,540) * lu(k,536) + lu(k,541) = lu(k,541) * lu(k,536) + lu(k,542) = lu(k,542) * lu(k,536) + lu(k,3042) = lu(k,3042) - lu(k,537) * lu(k,2989) + lu(k,3069) = lu(k,3069) - lu(k,538) * lu(k,2989) + lu(k,3106) = lu(k,3106) - lu(k,539) * lu(k,2989) + lu(k,3110) = lu(k,3110) - lu(k,540) * lu(k,2989) + lu(k,3115) = lu(k,3115) - lu(k,541) * lu(k,2989) + lu(k,3119) = lu(k,3119) - lu(k,542) * lu(k,2989) + lu(k,3299) = lu(k,3299) - lu(k,537) * lu(k,3238) + lu(k,3328) = lu(k,3328) - lu(k,538) * lu(k,3238) + lu(k,3365) = lu(k,3365) - lu(k,539) * lu(k,3238) + lu(k,3369) = lu(k,3369) - lu(k,540) * lu(k,3238) + lu(k,3374) = lu(k,3374) - lu(k,541) * lu(k,3238) + lu(k,3378) = lu(k,3378) - lu(k,542) * lu(k,3238) + lu(k,4021) = lu(k,4021) - lu(k,537) * lu(k,3931) + lu(k,4052) = lu(k,4052) - lu(k,538) * lu(k,3931) + lu(k,4088) = lu(k,4088) - lu(k,539) * lu(k,3931) + lu(k,4092) = lu(k,4092) - lu(k,540) * lu(k,3931) + lu(k,4097) = lu(k,4097) - lu(k,541) * lu(k,3931) + lu(k,4101) = lu(k,4101) - lu(k,542) * lu(k,3931) + 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,543) = 1._r8 / lu(k,543) + lu(k,544) = lu(k,544) * lu(k,543) + lu(k,545) = lu(k,545) * lu(k,543) + lu(k,546) = lu(k,546) * lu(k,543) + lu(k,547) = lu(k,547) * lu(k,543) + lu(k,548) = lu(k,548) * lu(k,543) + lu(k,1600) = lu(k,1600) - lu(k,544) * lu(k,1598) + lu(k,1602) = lu(k,1602) - lu(k,545) * lu(k,1598) + lu(k,1604) = lu(k,1604) - lu(k,546) * lu(k,1598) + lu(k,1609) = lu(k,1609) - lu(k,547) * lu(k,1598) + lu(k,1611) = lu(k,1611) - lu(k,548) * lu(k,1598) + lu(k,3152) = lu(k,3152) - lu(k,544) * lu(k,3144) + lu(k,3157) = lu(k,3157) - lu(k,545) * lu(k,3144) + lu(k,3161) = lu(k,3161) - lu(k,546) * lu(k,3144) + lu(k,3169) = lu(k,3169) - lu(k,547) * lu(k,3144) + lu(k,3172) = lu(k,3172) - lu(k,548) * lu(k,3144) + lu(k,3705) = lu(k,3705) - lu(k,544) * lu(k,3676) + lu(k,3754) = lu(k,3754) - lu(k,545) * lu(k,3676) + lu(k,3758) = lu(k,3758) - lu(k,546) * lu(k,3676) + lu(k,3766) = lu(k,3766) - lu(k,547) * lu(k,3676) + lu(k,3769) = lu(k,3769) - lu(k,548) * lu(k,3676) + lu(k,4032) = lu(k,4032) - lu(k,544) * lu(k,3932) + lu(k,4086) = lu(k,4086) - lu(k,545) * lu(k,3932) + lu(k,4090) = lu(k,4090) - lu(k,546) * lu(k,3932) + lu(k,4098) = lu(k,4098) - lu(k,547) * lu(k,3932) + lu(k,4101) = lu(k,4101) - lu(k,548) * lu(k,3932) + 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,2997) = lu(k,2997) - lu(k,551) * lu(k,2990) + lu(k,3106) = lu(k,3106) - lu(k,552) * lu(k,2990) + lu(k,3110) = lu(k,3110) - lu(k,553) * lu(k,2990) + lu(k,3115) = lu(k,3115) - lu(k,554) * lu(k,2990) + lu(k,3119) = lu(k,3119) - lu(k,555) * lu(k,2990) + lu(k,3246) = lu(k,3246) - lu(k,551) * lu(k,3239) + lu(k,3365) = lu(k,3365) - lu(k,552) * lu(k,3239) + lu(k,3369) = lu(k,3369) - lu(k,553) * lu(k,3239) + lu(k,3374) = lu(k,3374) - lu(k,554) * lu(k,3239) + lu(k,3378) = lu(k,3378) - lu(k,555) * lu(k,3239) + lu(k,3630) = lu(k,3630) - lu(k,551) * lu(k,3625) + lu(k,3654) = lu(k,3654) - lu(k,552) * lu(k,3625) + lu(k,3658) = lu(k,3658) - lu(k,553) * lu(k,3625) + lu(k,3663) = lu(k,3663) - lu(k,554) * lu(k,3625) + lu(k,3667) = lu(k,3667) - lu(k,555) * lu(k,3625) + lu(k,3951) = lu(k,3951) - lu(k,551) * lu(k,3933) + lu(k,4088) = lu(k,4088) - lu(k,552) * lu(k,3933) + lu(k,4092) = lu(k,4092) - lu(k,553) * lu(k,3933) + lu(k,4097) = lu(k,4097) - lu(k,554) * lu(k,3933) + lu(k,4101) = lu(k,4101) - lu(k,555) * lu(k,3933) + lu(k,556) = 1._r8 / lu(k,556) + lu(k,557) = lu(k,557) * lu(k,556) + lu(k,558) = lu(k,558) * lu(k,556) + lu(k,559) = lu(k,559) * lu(k,556) + lu(k,560) = lu(k,560) * lu(k,556) + lu(k,719) = - lu(k,557) * lu(k,717) + lu(k,721) = - lu(k,558) * lu(k,717) + lu(k,724) = - lu(k,559) * lu(k,717) + lu(k,727) = lu(k,727) - lu(k,560) * lu(k,717) + lu(k,753) = - lu(k,557) * lu(k,751) + lu(k,754) = - lu(k,558) * lu(k,751) + lu(k,757) = - lu(k,559) * lu(k,751) + lu(k,761) = lu(k,761) - lu(k,560) * lu(k,751) + lu(k,1181) = - lu(k,557) * lu(k,1178) + lu(k,1183) = - lu(k,558) * lu(k,1178) + lu(k,1186) = - lu(k,559) * lu(k,1178) + lu(k,1191) = - lu(k,560) * lu(k,1178) + lu(k,2999) = lu(k,2999) - lu(k,557) * lu(k,2991) + lu(k,3034) = lu(k,3034) - lu(k,558) * lu(k,2991) + lu(k,3103) = lu(k,3103) - lu(k,559) * lu(k,2991) + lu(k,3119) = lu(k,3119) - lu(k,560) * lu(k,2991) + lu(k,3956) = lu(k,3956) - lu(k,557) * lu(k,3934) + lu(k,4011) = lu(k,4011) - lu(k,558) * lu(k,3934) + lu(k,4085) = lu(k,4085) - lu(k,559) * lu(k,3934) + lu(k,4101) = lu(k,4101) - lu(k,560) * lu(k,3934) + lu(k,561) = 1._r8 / lu(k,561) + lu(k,562) = lu(k,562) * lu(k,561) + lu(k,563) = lu(k,563) * lu(k,561) + lu(k,564) = lu(k,564) * lu(k,561) + lu(k,565) = lu(k,565) * lu(k,561) + lu(k,566) = lu(k,566) * lu(k,561) + lu(k,567) = lu(k,567) * lu(k,561) + lu(k,568) = lu(k,568) * lu(k,561) + lu(k,3146) = lu(k,3146) - lu(k,562) * lu(k,3145) + lu(k,3155) = lu(k,3155) - lu(k,563) * lu(k,3145) + lu(k,3158) = - lu(k,564) * lu(k,3145) + lu(k,3161) = lu(k,3161) - lu(k,565) * lu(k,3145) + lu(k,3165) = lu(k,3165) - lu(k,566) * lu(k,3145) + lu(k,3167) = lu(k,3167) - lu(k,567) * lu(k,3145) + lu(k,3168) = lu(k,3168) - lu(k,568) * lu(k,3145) + lu(k,3476) = lu(k,3476) - lu(k,562) * lu(k,3475) + lu(k,3479) = lu(k,3479) - lu(k,563) * lu(k,3475) + lu(k,3481) = - lu(k,564) * lu(k,3475) + lu(k,3484) = lu(k,3484) - lu(k,565) * lu(k,3475) + lu(k,3488) = lu(k,3488) - lu(k,566) * lu(k,3475) + lu(k,3490) = - lu(k,567) * lu(k,3475) + lu(k,3491) = lu(k,3491) - lu(k,568) * lu(k,3475) + lu(k,3634) = - lu(k,562) * lu(k,3626) + lu(k,3645) = - lu(k,563) * lu(k,3626) + lu(k,3653) = lu(k,3653) - lu(k,564) * lu(k,3626) + lu(k,3656) = lu(k,3656) - lu(k,565) * lu(k,3626) + lu(k,3660) = lu(k,3660) - lu(k,566) * lu(k,3626) + lu(k,3662) = lu(k,3662) - lu(k,567) * lu(k,3626) + lu(k,3663) = lu(k,3663) - lu(k,568) * lu(k,3626) + lu(k,569) = 1._r8 / lu(k,569) + lu(k,570) = lu(k,570) * lu(k,569) + lu(k,571) = lu(k,571) * lu(k,569) + lu(k,572) = lu(k,572) * lu(k,569) + lu(k,573) = lu(k,573) * lu(k,569) + lu(k,574) = lu(k,574) * lu(k,569) + lu(k,575) = lu(k,575) * lu(k,569) + lu(k,576) = lu(k,576) * lu(k,569) + lu(k,2865) = lu(k,2865) - lu(k,570) * lu(k,2855) + lu(k,2913) = lu(k,2913) - lu(k,571) * lu(k,2855) + lu(k,2919) = lu(k,2919) - lu(k,572) * lu(k,2855) + lu(k,2921) = lu(k,2921) - lu(k,573) * lu(k,2855) + lu(k,2922) = - lu(k,574) * lu(k,2855) + lu(k,2923) = lu(k,2923) - lu(k,575) * lu(k,2855) + lu(k,2927) = lu(k,2927) - lu(k,576) * lu(k,2855) + lu(k,3640) = - lu(k,570) * lu(k,3627) + lu(k,3651) = lu(k,3651) - lu(k,571) * lu(k,3627) + lu(k,3657) = - lu(k,572) * lu(k,3627) + lu(k,3659) = - lu(k,573) * lu(k,3627) + lu(k,3662) = lu(k,3662) - lu(k,574) * lu(k,3627) + lu(k,3663) = lu(k,3663) - lu(k,575) * lu(k,3627) + lu(k,3667) = lu(k,3667) - lu(k,576) * lu(k,3627) + lu(k,4033) = lu(k,4033) - lu(k,570) * lu(k,3935) + lu(k,4085) = lu(k,4085) - lu(k,571) * lu(k,3935) + lu(k,4091) = lu(k,4091) - lu(k,572) * lu(k,3935) + lu(k,4093) = lu(k,4093) - lu(k,573) * lu(k,3935) + lu(k,4096) = lu(k,4096) - lu(k,574) * lu(k,3935) + lu(k,4097) = lu(k,4097) - lu(k,575) * lu(k,3935) + lu(k,4101) = lu(k,4101) - lu(k,576) * lu(k,3935) + 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,577) = 1._r8 / lu(k,577) + lu(k,578) = lu(k,578) * lu(k,577) + lu(k,579) = lu(k,579) * lu(k,577) + lu(k,580) = lu(k,580) * lu(k,577) + lu(k,581) = lu(k,581) * lu(k,577) + lu(k,582) = lu(k,582) * lu(k,577) + lu(k,583) = lu(k,583) * lu(k,577) + lu(k,584) = lu(k,584) * lu(k,577) + lu(k,939) = lu(k,939) - lu(k,578) * lu(k,938) + lu(k,940) = lu(k,940) - lu(k,579) * lu(k,938) + lu(k,941) = - lu(k,580) * lu(k,938) + lu(k,943) = lu(k,943) - lu(k,581) * lu(k,938) + lu(k,944) = lu(k,944) - lu(k,582) * lu(k,938) + lu(k,946) = - lu(k,583) * lu(k,938) + lu(k,947) = - lu(k,584) * lu(k,938) + lu(k,3266) = lu(k,3266) - lu(k,578) * lu(k,3240) + lu(k,3294) = lu(k,3294) - lu(k,579) * lu(k,3240) + lu(k,3320) = lu(k,3320) - lu(k,580) * lu(k,3240) + lu(k,3368) = lu(k,3368) - lu(k,581) * lu(k,3240) + lu(k,3369) = lu(k,3369) - lu(k,582) * lu(k,3240) + lu(k,3378) = lu(k,3378) - lu(k,583) * lu(k,3240) + lu(k,3379) = lu(k,3379) - lu(k,584) * lu(k,3240) + lu(k,3976) = lu(k,3976) - lu(k,578) * lu(k,3936) + lu(k,4016) = lu(k,4016) - lu(k,579) * lu(k,3936) + lu(k,4044) = lu(k,4044) - lu(k,580) * lu(k,3936) + lu(k,4091) = lu(k,4091) - lu(k,581) * lu(k,3936) + lu(k,4092) = lu(k,4092) - lu(k,582) * lu(k,3936) + lu(k,4101) = lu(k,4101) - lu(k,583) * lu(k,3936) + lu(k,4102) = lu(k,4102) - lu(k,584) * lu(k,3936) + lu(k,585) = 1._r8 / lu(k,585) + lu(k,586) = lu(k,586) * lu(k,585) + lu(k,587) = lu(k,587) * lu(k,585) + lu(k,588) = lu(k,588) * lu(k,585) + lu(k,589) = lu(k,589) * lu(k,585) + lu(k,590) = lu(k,590) * lu(k,585) + lu(k,591) = lu(k,591) * lu(k,585) + lu(k,592) = lu(k,592) * lu(k,585) + lu(k,3682) = - lu(k,586) * lu(k,3677) + lu(k,3695) = lu(k,3695) - lu(k,587) * lu(k,3677) + lu(k,3726) = lu(k,3726) - lu(k,588) * lu(k,3677) + lu(k,3759) = lu(k,3759) - lu(k,589) * lu(k,3677) + lu(k,3760) = lu(k,3760) - lu(k,590) * lu(k,3677) + lu(k,3766) = lu(k,3766) - lu(k,591) * lu(k,3677) + lu(k,3769) = lu(k,3769) - lu(k,592) * lu(k,3677) + lu(k,3820) = - lu(k,586) * lu(k,3818) + lu(k,3824) = lu(k,3824) - lu(k,587) * lu(k,3818) + lu(k,3832) = lu(k,3832) - lu(k,588) * lu(k,3818) + lu(k,3841) = lu(k,3841) - lu(k,589) * lu(k,3818) + lu(k,3842) = lu(k,3842) - lu(k,590) * lu(k,3818) + lu(k,3848) = lu(k,3848) - lu(k,591) * lu(k,3818) + lu(k,3851) = lu(k,3851) - lu(k,592) * lu(k,3818) + lu(k,3966) = lu(k,3966) - lu(k,586) * lu(k,3937) + lu(k,4013) = lu(k,4013) - lu(k,587) * lu(k,3937) + lu(k,4057) = lu(k,4057) - lu(k,588) * lu(k,3937) + lu(k,4091) = lu(k,4091) - lu(k,589) * lu(k,3937) + lu(k,4092) = lu(k,4092) - lu(k,590) * lu(k,3937) + lu(k,4098) = lu(k,4098) - lu(k,591) * lu(k,3937) + lu(k,4101) = lu(k,4101) - lu(k,592) * lu(k,3937) + lu(k,593) = 1._r8 / lu(k,593) + lu(k,594) = lu(k,594) * lu(k,593) + lu(k,595) = lu(k,595) * lu(k,593) + lu(k,596) = lu(k,596) * lu(k,593) + lu(k,597) = lu(k,597) * lu(k,593) + lu(k,598) = lu(k,598) * lu(k,593) + lu(k,599) = lu(k,599) * lu(k,593) + lu(k,600) = lu(k,600) * lu(k,593) + lu(k,1974) = - lu(k,594) * lu(k,1972) + lu(k,1977) = - lu(k,595) * lu(k,1972) + lu(k,1992) = lu(k,1992) - lu(k,596) * lu(k,1972) + lu(k,2002) = lu(k,2002) - lu(k,597) * lu(k,1972) + lu(k,2003) = lu(k,2003) - lu(k,598) * lu(k,1972) + lu(k,2006) = lu(k,2006) - lu(k,599) * lu(k,1972) + lu(k,2007) = lu(k,2007) - lu(k,600) * lu(k,1972) + lu(k,3020) = lu(k,3020) - lu(k,594) * lu(k,2992) + lu(k,3047) = - lu(k,595) * lu(k,2992) + lu(k,3072) = lu(k,3072) - lu(k,596) * lu(k,2992) + lu(k,3109) = lu(k,3109) - lu(k,597) * lu(k,2992) + lu(k,3110) = lu(k,3110) - lu(k,598) * lu(k,2992) + lu(k,3115) = lu(k,3115) - lu(k,599) * lu(k,2992) + lu(k,3119) = lu(k,3119) - lu(k,600) * lu(k,2992) + lu(k,3986) = lu(k,3986) - lu(k,594) * lu(k,3938) + lu(k,4027) = lu(k,4027) - lu(k,595) * lu(k,3938) + lu(k,4055) = lu(k,4055) - lu(k,596) * lu(k,3938) + lu(k,4091) = lu(k,4091) - lu(k,597) * lu(k,3938) + lu(k,4092) = lu(k,4092) - lu(k,598) * lu(k,3938) + lu(k,4097) = lu(k,4097) - lu(k,599) * lu(k,3938) + lu(k,4101) = lu(k,4101) - lu(k,600) * lu(k,3938) + lu(k,601) = 1._r8 / lu(k,601) + lu(k,602) = lu(k,602) * lu(k,601) + lu(k,603) = lu(k,603) * lu(k,601) + lu(k,604) = lu(k,604) * lu(k,601) + lu(k,799) = lu(k,799) - lu(k,602) * lu(k,796) + lu(k,802) = lu(k,802) - lu(k,603) * lu(k,796) + lu(k,804) = lu(k,804) - lu(k,604) * lu(k,796) + lu(k,953) = - lu(k,602) * lu(k,949) + lu(k,957) = lu(k,957) - lu(k,603) * lu(k,949) + lu(k,959) = lu(k,959) - lu(k,604) * lu(k,949) + lu(k,2233) = - lu(k,602) * lu(k,2230) + lu(k,2249) = lu(k,2249) - lu(k,603) * lu(k,2230) + lu(k,2253) = lu(k,2253) - lu(k,604) * lu(k,2230) + lu(k,2673) = - lu(k,602) * lu(k,2670) + lu(k,2687) = lu(k,2687) - lu(k,603) * lu(k,2670) + lu(k,2691) = lu(k,2691) - lu(k,604) * lu(k,2670) + lu(k,3058) = lu(k,3058) - lu(k,602) * lu(k,2993) + lu(k,3110) = lu(k,3110) - lu(k,603) * lu(k,2993) + lu(k,3119) = lu(k,3119) - lu(k,604) * lu(k,2993) + lu(k,3317) = lu(k,3317) - lu(k,602) * lu(k,3241) + lu(k,3369) = lu(k,3369) - lu(k,603) * lu(k,3241) + lu(k,3378) = lu(k,3378) - lu(k,604) * lu(k,3241) + lu(k,4041) = lu(k,4041) - lu(k,602) * lu(k,3939) + lu(k,4092) = lu(k,4092) - lu(k,603) * lu(k,3939) + lu(k,4101) = lu(k,4101) - lu(k,604) * lu(k,3939) + lu(k,605) = 1._r8 / lu(k,605) + lu(k,606) = lu(k,606) * lu(k,605) + lu(k,607) = lu(k,607) * lu(k,605) + lu(k,608) = lu(k,608) * lu(k,605) + lu(k,609) = lu(k,609) * lu(k,605) + lu(k,610) = lu(k,610) * lu(k,605) + lu(k,611) = lu(k,611) * lu(k,605) + lu(k,612) = lu(k,612) * lu(k,605) + lu(k,3015) = lu(k,3015) - lu(k,606) * lu(k,2994) + lu(k,3037) = lu(k,3037) - lu(k,607) * lu(k,2994) + lu(k,3083) = lu(k,3083) - lu(k,608) * lu(k,2994) + lu(k,3106) = lu(k,3106) - lu(k,609) * lu(k,2994) + lu(k,3109) = lu(k,3109) - lu(k,610) * lu(k,2994) + lu(k,3110) = lu(k,3110) - lu(k,611) * lu(k,2994) + lu(k,3115) = lu(k,3115) - lu(k,612) * lu(k,2994) + lu(k,3530) = - lu(k,606) * lu(k,3528) + lu(k,3544) = lu(k,3544) - lu(k,607) * lu(k,3528) + lu(k,3579) = lu(k,3579) - lu(k,608) * lu(k,3528) + lu(k,3602) = lu(k,3602) - lu(k,609) * lu(k,3528) + lu(k,3605) = lu(k,3605) - lu(k,610) * lu(k,3528) + lu(k,3606) = lu(k,3606) - lu(k,611) * lu(k,3528) + lu(k,3611) = lu(k,3611) - lu(k,612) * lu(k,3528) + lu(k,3980) = lu(k,3980) - lu(k,606) * lu(k,3940) + lu(k,4016) = lu(k,4016) - lu(k,607) * lu(k,3940) + lu(k,4065) = lu(k,4065) - lu(k,608) * lu(k,3940) + lu(k,4088) = lu(k,4088) - lu(k,609) * lu(k,3940) + lu(k,4091) = lu(k,4091) - lu(k,610) * lu(k,3940) + lu(k,4092) = lu(k,4092) - lu(k,611) * lu(k,3940) + lu(k,4097) = lu(k,4097) - lu(k,612) * lu(k,3940) + lu(k,613) = 1._r8 / lu(k,613) + lu(k,614) = lu(k,614) * lu(k,613) + lu(k,615) = lu(k,615) * lu(k,613) + lu(k,616) = lu(k,616) * lu(k,613) + lu(k,617) = lu(k,617) * lu(k,613) + lu(k,618) = lu(k,618) * lu(k,613) + lu(k,619) = lu(k,619) * lu(k,613) + lu(k,620) = lu(k,620) * lu(k,613) + lu(k,621) = lu(k,621) * lu(k,613) + lu(k,622) = lu(k,622) * lu(k,613) + lu(k,623) = lu(k,623) * lu(k,613) + lu(k,624) = lu(k,624) * lu(k,613) + lu(k,625) = lu(k,625) * lu(k,613) + lu(k,1837) = lu(k,1837) - lu(k,614) * lu(k,1836) + lu(k,1838) = lu(k,1838) - lu(k,615) * lu(k,1836) + lu(k,1841) = - lu(k,616) * lu(k,1836) + lu(k,1844) = - lu(k,617) * lu(k,1836) + lu(k,1845) = lu(k,1845) - lu(k,618) * lu(k,1836) + lu(k,1852) = - lu(k,619) * lu(k,1836) + lu(k,1854) = lu(k,1854) - lu(k,620) * lu(k,1836) + lu(k,1855) = lu(k,1855) - lu(k,621) * lu(k,1836) + lu(k,1857) = lu(k,1857) - lu(k,622) * lu(k,1836) + lu(k,1861) = lu(k,1861) - lu(k,623) * lu(k,1836) + lu(k,1862) = lu(k,1862) - lu(k,624) * lu(k,1836) + lu(k,1864) = lu(k,1864) - lu(k,625) * lu(k,1836) + lu(k,3943) = lu(k,3943) - lu(k,614) * lu(k,3941) + lu(k,3972) = lu(k,3972) - lu(k,615) * lu(k,3941) + lu(k,4013) = lu(k,4013) - lu(k,616) * lu(k,3941) + lu(k,4026) = lu(k,4026) - lu(k,617) * lu(k,3941) + lu(k,4033) = lu(k,4033) - lu(k,618) * lu(k,3941) + lu(k,4052) = lu(k,4052) - lu(k,619) * lu(k,3941) + lu(k,4056) = lu(k,4056) - lu(k,620) * lu(k,3941) + lu(k,4057) = lu(k,4057) - lu(k,621) * lu(k,3941) + lu(k,4085) = lu(k,4085) - lu(k,622) * lu(k,3941) + lu(k,4092) = lu(k,4092) - lu(k,623) * lu(k,3941) + lu(k,4093) = lu(k,4093) - lu(k,624) * lu(k,3941) + lu(k,4101) = lu(k,4101) - lu(k,625) * lu(k,3941) + 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,1806) = lu(k,1806) - lu(k,627) * lu(k,1805) + lu(k,1807) = lu(k,1807) - lu(k,628) * lu(k,1805) + lu(k,1809) = - lu(k,629) * lu(k,1805) + lu(k,1812) = - lu(k,630) * lu(k,1805) + lu(k,1813) = lu(k,1813) - lu(k,631) * lu(k,1805) + lu(k,1820) = - lu(k,632) * lu(k,1805) + lu(k,1822) = lu(k,1822) - lu(k,633) * lu(k,1805) + lu(k,1823) = lu(k,1823) - lu(k,634) * lu(k,1805) + lu(k,1826) = lu(k,1826) - lu(k,635) * lu(k,1805) + lu(k,1830) = lu(k,1830) - lu(k,636) * lu(k,1805) + lu(k,1831) = lu(k,1831) - lu(k,637) * lu(k,1805) + lu(k,1833) = lu(k,1833) - lu(k,638) * lu(k,1805) + lu(k,3943) = lu(k,3943) - lu(k,627) * lu(k,3942) + lu(k,3972) = lu(k,3972) - lu(k,628) * lu(k,3942) + lu(k,3974) = lu(k,3974) - lu(k,629) * lu(k,3942) + lu(k,4029) = lu(k,4029) - lu(k,630) * lu(k,3942) + lu(k,4033) = lu(k,4033) - lu(k,631) * lu(k,3942) + lu(k,4052) = lu(k,4052) - lu(k,632) * lu(k,3942) + lu(k,4055) = lu(k,4055) - lu(k,633) * lu(k,3942) + lu(k,4057) = lu(k,4057) - lu(k,634) * lu(k,3942) + lu(k,4085) = lu(k,4085) - lu(k,635) * lu(k,3942) + lu(k,4092) = lu(k,4092) - lu(k,636) * lu(k,3942) + lu(k,4093) = lu(k,4093) - lu(k,637) * lu(k,3942) + lu(k,4101) = lu(k,4101) - lu(k,638) * lu(k,3942) + lu(k,639) = 1._r8 / lu(k,639) + lu(k,640) = lu(k,640) * lu(k,639) + lu(k,641) = lu(k,641) * lu(k,639) + lu(k,642) = lu(k,642) * lu(k,639) + lu(k,643) = lu(k,643) * lu(k,639) + lu(k,644) = lu(k,644) * lu(k,639) + lu(k,645) = lu(k,645) * lu(k,639) + lu(k,1809) = lu(k,1809) - lu(k,640) * lu(k,1806) + lu(k,1820) = lu(k,1820) - lu(k,641) * lu(k,1806) + lu(k,1823) = lu(k,1823) - lu(k,642) * lu(k,1806) + lu(k,1829) = lu(k,1829) - lu(k,643) * lu(k,1806) + lu(k,1830) = lu(k,1830) - lu(k,644) * lu(k,1806) + lu(k,1833) = lu(k,1833) - lu(k,645) * lu(k,1806) + lu(k,1840) = - lu(k,640) * lu(k,1837) + lu(k,1852) = lu(k,1852) - lu(k,641) * lu(k,1837) + lu(k,1855) = lu(k,1855) - lu(k,642) * lu(k,1837) + lu(k,1860) = lu(k,1860) - lu(k,643) * lu(k,1837) + lu(k,1861) = lu(k,1861) - lu(k,644) * lu(k,1837) + lu(k,1864) = lu(k,1864) - lu(k,645) * lu(k,1837) + lu(k,3974) = lu(k,3974) - lu(k,640) * lu(k,3943) + lu(k,4052) = lu(k,4052) - lu(k,641) * lu(k,3943) + lu(k,4057) = lu(k,4057) - lu(k,642) * lu(k,3943) + lu(k,4091) = lu(k,4091) - lu(k,643) * lu(k,3943) + lu(k,4092) = lu(k,4092) - lu(k,644) * lu(k,3943) + lu(k,4101) = lu(k,4101) - lu(k,645) * lu(k,3943) + lu(k,646) = 1._r8 / lu(k,646) + lu(k,647) = lu(k,647) * lu(k,646) + lu(k,648) = lu(k,648) * lu(k,646) + lu(k,649) = lu(k,649) * lu(k,646) + lu(k,650) = lu(k,650) * lu(k,646) + lu(k,651) = lu(k,651) * lu(k,646) + lu(k,652) = lu(k,652) * lu(k,646) + lu(k,653) = lu(k,653) * lu(k,646) + lu(k,654) = lu(k,654) * lu(k,646) + lu(k,3793) = lu(k,3793) - lu(k,647) * lu(k,3789) + lu(k,3798) = lu(k,3798) - lu(k,648) * lu(k,3789) + lu(k,3801) = lu(k,3801) - lu(k,649) * lu(k,3789) + lu(k,3802) = lu(k,3802) - lu(k,650) * lu(k,3789) + lu(k,3808) = lu(k,3808) - lu(k,651) * lu(k,3789) + lu(k,3809) = lu(k,3809) - lu(k,652) * lu(k,3789) + lu(k,3810) = lu(k,3810) - lu(k,653) * lu(k,3789) + lu(k,3811) = lu(k,3811) - lu(k,654) * lu(k,3789) + lu(k,3833) = lu(k,3833) - lu(k,647) * lu(k,3819) + lu(k,3839) = lu(k,3839) - lu(k,648) * lu(k,3819) + lu(k,3842) = lu(k,3842) - lu(k,649) * lu(k,3819) + lu(k,3843) = lu(k,3843) - lu(k,650) * lu(k,3819) + lu(k,3849) = lu(k,3849) - lu(k,651) * lu(k,3819) + lu(k,3850) = lu(k,3850) - lu(k,652) * lu(k,3819) + lu(k,3851) = lu(k,3851) - lu(k,653) * lu(k,3819) + lu(k,3852) = lu(k,3852) - lu(k,654) * lu(k,3819) + lu(k,4062) = lu(k,4062) - lu(k,647) * lu(k,3944) + lu(k,4089) = lu(k,4089) - lu(k,648) * lu(k,3944) + lu(k,4092) = lu(k,4092) - lu(k,649) * lu(k,3944) + lu(k,4093) = lu(k,4093) - lu(k,650) * lu(k,3944) + lu(k,4099) = lu(k,4099) - lu(k,651) * lu(k,3944) + lu(k,4100) = lu(k,4100) - lu(k,652) * lu(k,3944) + lu(k,4101) = lu(k,4101) - lu(k,653) * lu(k,3944) + lu(k,4102) = lu(k,4102) - lu(k,654) * lu(k,3944) + lu(k,655) = 1._r8 / lu(k,655) + lu(k,656) = lu(k,656) * lu(k,655) + lu(k,657) = lu(k,657) * lu(k,655) + lu(k,658) = lu(k,658) * lu(k,655) + lu(k,659) = lu(k,659) * lu(k,655) + lu(k,660) = lu(k,660) * lu(k,655) + lu(k,661) = lu(k,661) * lu(k,655) + lu(k,662) = lu(k,662) * lu(k,655) + lu(k,663) = lu(k,663) * lu(k,655) + lu(k,2721) = lu(k,2721) - lu(k,656) * lu(k,2717) + lu(k,2725) = lu(k,2725) - lu(k,657) * lu(k,2717) + lu(k,2728) = lu(k,2728) - lu(k,658) * lu(k,2717) + lu(k,2745) = lu(k,2745) - lu(k,659) * lu(k,2717) + lu(k,2753) = lu(k,2753) - lu(k,660) * lu(k,2717) + lu(k,2754) = lu(k,2754) - lu(k,661) * lu(k,2717) + lu(k,2757) = lu(k,2757) - lu(k,662) * lu(k,2717) + lu(k,2760) = lu(k,2760) - lu(k,663) * lu(k,2717) + lu(k,3640) = lu(k,3640) - lu(k,656) * lu(k,3628) + lu(k,3644) = lu(k,3644) - lu(k,657) * lu(k,3628) + lu(k,3646) = - lu(k,658) * lu(k,3628) + lu(k,3648) = lu(k,3648) - lu(k,659) * lu(k,3628) + lu(k,3657) = lu(k,3657) - lu(k,660) * lu(k,3628) + lu(k,3658) = lu(k,3658) - lu(k,661) * lu(k,3628) + lu(k,3663) = lu(k,3663) - lu(k,662) * lu(k,3628) + lu(k,3667) = lu(k,3667) - lu(k,663) * lu(k,3628) + lu(k,4033) = lu(k,4033) - lu(k,656) * lu(k,3945) + lu(k,4057) = lu(k,4057) - lu(k,657) * lu(k,3945) + lu(k,4065) = lu(k,4065) - lu(k,658) * lu(k,3945) + lu(k,4082) = lu(k,4082) - lu(k,659) * lu(k,3945) + lu(k,4091) = lu(k,4091) - lu(k,660) * lu(k,3945) + lu(k,4092) = lu(k,4092) - lu(k,661) * lu(k,3945) + lu(k,4097) = lu(k,4097) - lu(k,662) * lu(k,3945) + lu(k,4101) = lu(k,4101) - lu(k,663) * lu(k,3945) + lu(k,664) = 1._r8 / lu(k,664) + lu(k,665) = lu(k,665) * lu(k,664) + lu(k,666) = lu(k,666) * lu(k,664) + lu(k,667) = lu(k,667) * lu(k,664) + lu(k,668) = lu(k,668) * lu(k,664) + lu(k,669) = lu(k,669) * lu(k,664) + lu(k,670) = lu(k,670) * lu(k,664) + lu(k,671) = lu(k,671) * lu(k,664) + lu(k,672) = lu(k,672) * lu(k,664) + lu(k,2767) = lu(k,2767) - lu(k,665) * lu(k,2763) + lu(k,2771) = lu(k,2771) - lu(k,666) * lu(k,2763) + lu(k,2792) = lu(k,2792) - lu(k,667) * lu(k,2763) + lu(k,2794) = lu(k,2794) - lu(k,668) * lu(k,2763) + lu(k,2799) = lu(k,2799) - lu(k,669) * lu(k,2763) + lu(k,2800) = lu(k,2800) - lu(k,670) * lu(k,2763) + lu(k,2803) = lu(k,2803) - lu(k,671) * lu(k,2763) + lu(k,2806) = lu(k,2806) - lu(k,672) * lu(k,2763) + lu(k,3640) = lu(k,3640) - lu(k,665) * lu(k,3629) + lu(k,3644) = lu(k,3644) - lu(k,666) * lu(k,3629) + lu(k,3649) = lu(k,3649) - lu(k,667) * lu(k,3629) + lu(k,3651) = lu(k,3651) - lu(k,668) * lu(k,3629) + lu(k,3657) = lu(k,3657) - lu(k,669) * lu(k,3629) + lu(k,3658) = lu(k,3658) - lu(k,670) * lu(k,3629) + lu(k,3663) = lu(k,3663) - lu(k,671) * lu(k,3629) + lu(k,3667) = lu(k,3667) - lu(k,672) * lu(k,3629) + lu(k,4033) = lu(k,4033) - lu(k,665) * lu(k,3946) + lu(k,4057) = lu(k,4057) - lu(k,666) * lu(k,3946) + lu(k,4083) = lu(k,4083) - lu(k,667) * lu(k,3946) + lu(k,4085) = lu(k,4085) - lu(k,668) * lu(k,3946) + lu(k,4091) = lu(k,4091) - lu(k,669) * lu(k,3946) + lu(k,4092) = lu(k,4092) - lu(k,670) * lu(k,3946) + lu(k,4097) = lu(k,4097) - lu(k,671) * lu(k,3946) + lu(k,4101) = lu(k,4101) - lu(k,672) * lu(k,3946) + 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,673) = 1._r8 / lu(k,673) + lu(k,674) = lu(k,674) * lu(k,673) + lu(k,675) = lu(k,675) * lu(k,673) + lu(k,676) = lu(k,676) * lu(k,673) + lu(k,677) = lu(k,677) * lu(k,673) + lu(k,678) = lu(k,678) * lu(k,673) + lu(k,679) = lu(k,679) * lu(k,673) + lu(k,680) = lu(k,680) * lu(k,673) + lu(k,681) = lu(k,681) * lu(k,673) + lu(k,1938) = - lu(k,674) * lu(k,1936) + lu(k,1940) = - lu(k,675) * lu(k,1936) + lu(k,1956) = lu(k,1956) - lu(k,676) * lu(k,1936) + lu(k,1960) = - lu(k,677) * lu(k,1936) + lu(k,1963) = lu(k,1963) - lu(k,678) * lu(k,1936) + lu(k,1964) = lu(k,1964) - lu(k,679) * lu(k,1936) + lu(k,1967) = lu(k,1967) - lu(k,680) * lu(k,1936) + lu(k,1968) = lu(k,1968) - lu(k,681) * lu(k,1936) + lu(k,3026) = lu(k,3026) - lu(k,674) * lu(k,2995) + lu(k,3047) = lu(k,3047) - lu(k,675) * lu(k,2995) + lu(k,3073) = lu(k,3073) - lu(k,676) * lu(k,2995) + lu(k,3105) = - lu(k,677) * lu(k,2995) + lu(k,3109) = lu(k,3109) - lu(k,678) * lu(k,2995) + lu(k,3110) = lu(k,3110) - lu(k,679) * lu(k,2995) + lu(k,3115) = lu(k,3115) - lu(k,680) * lu(k,2995) + lu(k,3119) = lu(k,3119) - lu(k,681) * lu(k,2995) + lu(k,3996) = lu(k,3996) - lu(k,674) * lu(k,3947) + lu(k,4027) = lu(k,4027) - lu(k,675) * lu(k,3947) + lu(k,4056) = lu(k,4056) - lu(k,676) * lu(k,3947) + lu(k,4087) = lu(k,4087) - lu(k,677) * lu(k,3947) + lu(k,4091) = lu(k,4091) - lu(k,678) * lu(k,3947) + lu(k,4092) = lu(k,4092) - lu(k,679) * lu(k,3947) + lu(k,4097) = lu(k,4097) - lu(k,680) * lu(k,3947) + lu(k,4101) = lu(k,4101) - lu(k,681) * lu(k,3947) + lu(k,682) = 1._r8 / lu(k,682) + lu(k,683) = lu(k,683) * lu(k,682) + lu(k,684) = lu(k,684) * lu(k,682) + lu(k,685) = lu(k,685) * lu(k,682) + lu(k,686) = lu(k,686) * lu(k,682) + lu(k,687) = lu(k,687) * lu(k,682) + lu(k,688) = lu(k,688) * lu(k,682) + lu(k,2495) = - lu(k,683) * lu(k,2491) + lu(k,2501) = lu(k,2501) - lu(k,684) * lu(k,2491) + lu(k,2507) = lu(k,2507) - lu(k,685) * lu(k,2491) + lu(k,2519) = lu(k,2519) - lu(k,686) * lu(k,2491) + lu(k,2522) = lu(k,2522) - lu(k,687) * lu(k,2491) + lu(k,2523) = lu(k,2523) - lu(k,688) * lu(k,2491) + lu(k,2558) = - lu(k,683) * lu(k,2554) + lu(k,2564) = lu(k,2564) - lu(k,684) * lu(k,2554) + lu(k,2572) = - lu(k,685) * lu(k,2554) + lu(k,2584) = lu(k,2584) - lu(k,686) * lu(k,2554) + lu(k,2587) = lu(k,2587) - lu(k,687) * lu(k,2554) + lu(k,2588) = lu(k,2588) - lu(k,688) * lu(k,2554) + lu(k,3286) = lu(k,3286) - lu(k,683) * lu(k,3242) + lu(k,3314) = lu(k,3314) - lu(k,684) * lu(k,3242) + lu(k,3355) = lu(k,3355) - lu(k,685) * lu(k,3242) + lu(k,3369) = lu(k,3369) - lu(k,686) * lu(k,3242) + lu(k,3374) = lu(k,3374) - lu(k,687) * lu(k,3242) + lu(k,3378) = lu(k,3378) - lu(k,688) * lu(k,3242) + lu(k,4000) = lu(k,4000) - lu(k,683) * lu(k,3948) + lu(k,4038) = lu(k,4038) - lu(k,684) * lu(k,3948) + lu(k,4078) = lu(k,4078) - lu(k,685) * lu(k,3948) + lu(k,4092) = lu(k,4092) - lu(k,686) * lu(k,3948) + lu(k,4097) = lu(k,4097) - lu(k,687) * lu(k,3948) + lu(k,4101) = lu(k,4101) - lu(k,688) * lu(k,3948) + lu(k,689) = 1._r8 / lu(k,689) + lu(k,690) = lu(k,690) * lu(k,689) + lu(k,691) = lu(k,691) * lu(k,689) + lu(k,692) = lu(k,692) * lu(k,689) + lu(k,954) = - lu(k,690) * lu(k,950) + lu(k,957) = lu(k,957) - lu(k,691) * lu(k,950) + lu(k,959) = lu(k,959) - lu(k,692) * lu(k,950) + lu(k,1009) = - lu(k,690) * lu(k,1004) + lu(k,1011) = lu(k,1011) - lu(k,691) * lu(k,1004) + lu(k,1013) = lu(k,1013) - lu(k,692) * lu(k,1004) + lu(k,2379) = - lu(k,690) * lu(k,2368) + lu(k,2393) = lu(k,2393) - lu(k,691) * lu(k,2368) + lu(k,2397) = lu(k,2397) - lu(k,692) * lu(k,2368) + lu(k,2440) = lu(k,2440) - lu(k,690) * lu(k,2427) + lu(k,2454) = lu(k,2454) - lu(k,691) * lu(k,2427) + lu(k,2458) = lu(k,2458) - lu(k,692) * lu(k,2427) + lu(k,2653) = - lu(k,690) * lu(k,2647) + lu(k,2665) = lu(k,2665) - lu(k,691) * lu(k,2647) + lu(k,2669) = - lu(k,692) * lu(k,2647) + lu(k,2698) = - lu(k,690) * lu(k,2692) + lu(k,2710) = lu(k,2710) - lu(k,691) * lu(k,2692) + lu(k,2714) = lu(k,2714) - lu(k,692) * lu(k,2692) + lu(k,3346) = lu(k,3346) - lu(k,690) * lu(k,3243) + lu(k,3369) = lu(k,3369) - lu(k,691) * lu(k,3243) + lu(k,3378) = lu(k,3378) - lu(k,692) * lu(k,3243) + lu(k,4069) = lu(k,4069) - lu(k,690) * lu(k,3949) + lu(k,4092) = lu(k,4092) - lu(k,691) * lu(k,3949) + lu(k,4101) = lu(k,4101) - lu(k,692) * lu(k,3949) + lu(k,693) = 1._r8 / lu(k,693) + lu(k,694) = lu(k,694) * lu(k,693) + lu(k,695) = lu(k,695) * lu(k,693) + lu(k,696) = lu(k,696) * lu(k,693) + lu(k,697) = lu(k,697) * lu(k,693) + lu(k,698) = lu(k,698) * lu(k,693) + lu(k,699) = lu(k,699) * lu(k,693) + lu(k,700) = lu(k,700) * lu(k,693) + lu(k,701) = lu(k,701) * lu(k,693) + lu(k,3028) = - lu(k,694) * lu(k,2996) + lu(k,3036) = lu(k,3036) - lu(k,695) * lu(k,2996) + lu(k,3106) = lu(k,3106) - lu(k,696) * lu(k,2996) + lu(k,3109) = lu(k,3109) - lu(k,697) * lu(k,2996) + lu(k,3110) = lu(k,3110) - lu(k,698) * lu(k,2996) + lu(k,3115) = lu(k,3115) - lu(k,699) * lu(k,2996) + lu(k,3119) = lu(k,3119) - lu(k,700) * lu(k,2996) + lu(k,3120) = - lu(k,701) * lu(k,2996) + lu(k,3176) = - lu(k,694) * lu(k,3174) + lu(k,3177) = - lu(k,695) * lu(k,3174) + lu(k,3185) = - lu(k,696) * lu(k,3174) + lu(k,3188) = lu(k,3188) - lu(k,697) * lu(k,3174) + lu(k,3189) = lu(k,3189) - lu(k,698) * lu(k,3174) + lu(k,3194) = - lu(k,699) * lu(k,3174) + lu(k,3198) = lu(k,3198) - lu(k,700) * lu(k,3174) + lu(k,3199) = lu(k,3199) - lu(k,701) * lu(k,3174) + lu(k,3285) = lu(k,3285) - lu(k,694) * lu(k,3244) + lu(k,3293) = lu(k,3293) - lu(k,695) * lu(k,3244) + lu(k,3365) = lu(k,3365) - lu(k,696) * lu(k,3244) + lu(k,3368) = lu(k,3368) - lu(k,697) * lu(k,3244) + lu(k,3369) = lu(k,3369) - lu(k,698) * lu(k,3244) + lu(k,3374) = lu(k,3374) - lu(k,699) * lu(k,3244) + lu(k,3378) = lu(k,3378) - lu(k,700) * lu(k,3244) + lu(k,3379) = lu(k,3379) - lu(k,701) * lu(k,3244) + lu(k,702) = 1._r8 / lu(k,702) + lu(k,703) = lu(k,703) * lu(k,702) + lu(k,704) = lu(k,704) * lu(k,702) + lu(k,705) = lu(k,705) * lu(k,702) + lu(k,706) = lu(k,706) * lu(k,702) + lu(k,707) = lu(k,707) * lu(k,702) + lu(k,708) = lu(k,708) * lu(k,702) + lu(k,1619) = lu(k,1619) - lu(k,703) * lu(k,1617) + lu(k,1623) = lu(k,1623) - lu(k,704) * lu(k,1617) + lu(k,1626) = lu(k,1626) - lu(k,705) * lu(k,1617) + lu(k,1628) = lu(k,1628) - lu(k,706) * lu(k,1617) + lu(k,1632) = lu(k,1632) - lu(k,707) * lu(k,1617) + lu(k,1633) = - lu(k,708) * lu(k,1617) + lu(k,2865) = lu(k,2865) - lu(k,703) * lu(k,2856) + lu(k,2913) = lu(k,2913) - lu(k,704) * lu(k,2856) + lu(k,2919) = lu(k,2919) - lu(k,705) * lu(k,2856) + lu(k,2921) = lu(k,2921) - lu(k,706) * lu(k,2856) + lu(k,2927) = lu(k,2927) - lu(k,707) * lu(k,2856) + lu(k,2928) = - lu(k,708) * lu(k,2856) + lu(k,3309) = lu(k,3309) - lu(k,703) * lu(k,3245) + lu(k,3362) = lu(k,3362) - lu(k,704) * lu(k,3245) + lu(k,3368) = lu(k,3368) - lu(k,705) * lu(k,3245) + lu(k,3370) = lu(k,3370) - lu(k,706) * lu(k,3245) + lu(k,3378) = lu(k,3378) - lu(k,707) * lu(k,3245) + lu(k,3379) = lu(k,3379) - lu(k,708) * lu(k,3245) + lu(k,4033) = lu(k,4033) - lu(k,703) * lu(k,3950) + lu(k,4085) = lu(k,4085) - lu(k,704) * lu(k,3950) + lu(k,4091) = lu(k,4091) - lu(k,705) * lu(k,3950) + lu(k,4093) = lu(k,4093) - lu(k,706) * lu(k,3950) + lu(k,4101) = lu(k,4101) - lu(k,707) * lu(k,3950) + lu(k,4102) = lu(k,4102) - lu(k,708) * lu(k,3950) + 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,711) = 1._r8 / lu(k,711) + lu(k,712) = lu(k,712) * lu(k,711) + lu(k,713) = lu(k,713) * lu(k,711) + lu(k,714) = lu(k,714) * lu(k,711) + lu(k,715) = lu(k,715) * lu(k,711) + lu(k,716) = lu(k,716) * lu(k,711) + lu(k,3106) = lu(k,3106) - lu(k,712) * lu(k,2997) + lu(k,3110) = lu(k,3110) - lu(k,713) * lu(k,2997) + lu(k,3115) = lu(k,3115) - lu(k,714) * lu(k,2997) + lu(k,3116) = lu(k,3116) - lu(k,715) * lu(k,2997) + lu(k,3119) = lu(k,3119) - lu(k,716) * lu(k,2997) + lu(k,3365) = lu(k,3365) - lu(k,712) * lu(k,3246) + lu(k,3369) = lu(k,3369) - lu(k,713) * lu(k,3246) + lu(k,3374) = lu(k,3374) - lu(k,714) * lu(k,3246) + lu(k,3375) = lu(k,3375) - lu(k,715) * lu(k,3246) + lu(k,3378) = lu(k,3378) - lu(k,716) * lu(k,3246) + lu(k,3654) = lu(k,3654) - lu(k,712) * lu(k,3630) + lu(k,3658) = lu(k,3658) - lu(k,713) * lu(k,3630) + lu(k,3663) = lu(k,3663) - lu(k,714) * lu(k,3630) + lu(k,3664) = lu(k,3664) - lu(k,715) * lu(k,3630) + lu(k,3667) = lu(k,3667) - lu(k,716) * lu(k,3630) + lu(k,3756) = lu(k,3756) - lu(k,712) * lu(k,3678) + lu(k,3760) = lu(k,3760) - lu(k,713) * lu(k,3678) + lu(k,3765) = lu(k,3765) - lu(k,714) * lu(k,3678) + lu(k,3766) = lu(k,3766) - lu(k,715) * lu(k,3678) + lu(k,3769) = lu(k,3769) - lu(k,716) * lu(k,3678) + lu(k,4088) = lu(k,4088) - lu(k,712) * lu(k,3951) + lu(k,4092) = lu(k,4092) - lu(k,713) * lu(k,3951) + lu(k,4097) = lu(k,4097) - lu(k,714) * lu(k,3951) + lu(k,4098) = lu(k,4098) - lu(k,715) * lu(k,3951) + lu(k,4101) = lu(k,4101) - lu(k,716) * lu(k,3951) + lu(k,718) = 1._r8 / lu(k,718) + lu(k,719) = lu(k,719) * lu(k,718) + lu(k,720) = lu(k,720) * lu(k,718) + lu(k,721) = lu(k,721) * lu(k,718) + lu(k,722) = lu(k,722) * lu(k,718) + lu(k,723) = lu(k,723) * lu(k,718) + lu(k,724) = lu(k,724) * lu(k,718) + lu(k,725) = lu(k,725) * lu(k,718) + lu(k,726) = lu(k,726) * lu(k,718) + lu(k,727) = lu(k,727) * lu(k,718) + lu(k,1181) = lu(k,1181) - lu(k,719) * lu(k,1179) + lu(k,1182) = lu(k,1182) - lu(k,720) * lu(k,1179) + lu(k,1183) = lu(k,1183) - lu(k,721) * lu(k,1179) + lu(k,1184) = lu(k,1184) - lu(k,722) * lu(k,1179) + lu(k,1185) = lu(k,1185) - lu(k,723) * lu(k,1179) + lu(k,1186) = lu(k,1186) - lu(k,724) * lu(k,1179) + lu(k,1188) = lu(k,1188) - lu(k,725) * lu(k,1179) + lu(k,1189) = lu(k,1189) - lu(k,726) * lu(k,1179) + lu(k,1191) = lu(k,1191) - lu(k,727) * lu(k,1179) + lu(k,3249) = lu(k,3249) - lu(k,719) * lu(k,3247) + lu(k,3283) = lu(k,3283) - lu(k,720) * lu(k,3247) + lu(k,3291) = lu(k,3291) - lu(k,721) * lu(k,3247) + lu(k,3294) = lu(k,3294) - lu(k,722) * lu(k,3247) + lu(k,3342) = lu(k,3342) - lu(k,723) * lu(k,3247) + lu(k,3362) = lu(k,3362) - lu(k,724) * lu(k,3247) + lu(k,3368) = lu(k,3368) - lu(k,725) * lu(k,3247) + lu(k,3369) = lu(k,3369) - lu(k,726) * lu(k,3247) + lu(k,3378) = lu(k,3378) - lu(k,727) * lu(k,3247) + lu(k,3956) = lu(k,3956) - lu(k,719) * lu(k,3952) + lu(k,3997) = lu(k,3997) - lu(k,720) * lu(k,3952) + lu(k,4011) = lu(k,4011) - lu(k,721) * lu(k,3952) + lu(k,4016) = lu(k,4016) - lu(k,722) * lu(k,3952) + lu(k,4065) = lu(k,4065) - lu(k,723) * lu(k,3952) + lu(k,4085) = lu(k,4085) - lu(k,724) * lu(k,3952) + lu(k,4091) = lu(k,4091) - lu(k,725) * lu(k,3952) + lu(k,4092) = lu(k,4092) - lu(k,726) * lu(k,3952) + lu(k,4101) = lu(k,4101) - lu(k,727) * lu(k,3952) + lu(k,728) = 1._r8 / lu(k,728) + lu(k,729) = lu(k,729) * lu(k,728) + lu(k,730) = lu(k,730) * lu(k,728) + lu(k,731) = lu(k,731) * lu(k,728) + lu(k,732) = lu(k,732) * lu(k,728) + lu(k,733) = lu(k,733) * lu(k,728) + lu(k,734) = lu(k,734) * lu(k,728) + lu(k,735) = lu(k,735) * lu(k,728) + lu(k,736) = lu(k,736) * lu(k,728) + lu(k,737) = lu(k,737) * lu(k,728) + lu(k,2156) = - lu(k,729) * lu(k,2154) + lu(k,2159) = - lu(k,730) * lu(k,2154) + lu(k,2174) = lu(k,2174) - lu(k,731) * lu(k,2154) + lu(k,2175) = lu(k,2175) - lu(k,732) * lu(k,2154) + lu(k,2179) = lu(k,2179) - lu(k,733) * lu(k,2154) + lu(k,2188) = lu(k,2188) - lu(k,734) * lu(k,2154) + lu(k,2189) = lu(k,2189) - lu(k,735) * lu(k,2154) + lu(k,2192) = lu(k,2192) - lu(k,736) * lu(k,2154) + lu(k,2195) = lu(k,2195) - lu(k,737) * lu(k,2154) + lu(k,3388) = - lu(k,729) * lu(k,3383) + lu(k,3393) = - lu(k,730) * lu(k,3383) + lu(k,3425) = lu(k,3425) - lu(k,731) * lu(k,3383) + lu(k,3426) = lu(k,3426) - lu(k,732) * lu(k,3383) + lu(k,3430) = lu(k,3430) - lu(k,733) * lu(k,3383) + lu(k,3461) = lu(k,3461) - lu(k,734) * lu(k,3383) + lu(k,3462) = lu(k,3462) - lu(k,735) * lu(k,3383) + lu(k,3467) = lu(k,3467) - lu(k,736) * lu(k,3383) + lu(k,3471) = lu(k,3471) - lu(k,737) * lu(k,3383) + lu(k,4004) = lu(k,4004) - lu(k,729) * lu(k,3953) + lu(k,4017) = lu(k,4017) - lu(k,730) * lu(k,3953) + lu(k,4055) = lu(k,4055) - lu(k,731) * lu(k,3953) + lu(k,4056) = lu(k,4056) - lu(k,732) * lu(k,3953) + lu(k,4060) = lu(k,4060) - lu(k,733) * lu(k,3953) + lu(k,4091) = lu(k,4091) - lu(k,734) * lu(k,3953) + lu(k,4092) = lu(k,4092) - lu(k,735) * lu(k,3953) + lu(k,4097) = lu(k,4097) - lu(k,736) * lu(k,3953) + lu(k,4101) = lu(k,4101) - lu(k,737) * lu(k,3953) + lu(k,741) = 1._r8 / lu(k,741) + lu(k,742) = lu(k,742) * lu(k,741) + lu(k,743) = lu(k,743) * lu(k,741) + lu(k,744) = lu(k,744) * lu(k,741) + lu(k,745) = lu(k,745) * lu(k,741) + lu(k,746) = lu(k,746) * lu(k,741) + lu(k,747) = lu(k,747) * lu(k,741) + lu(k,748) = lu(k,748) * lu(k,741) + lu(k,749) = lu(k,749) * lu(k,741) + lu(k,750) = lu(k,750) * lu(k,741) + lu(k,872) = lu(k,872) - lu(k,742) * lu(k,871) + lu(k,873) = lu(k,873) - lu(k,743) * lu(k,871) + lu(k,874) = lu(k,874) - lu(k,744) * lu(k,871) + lu(k,875) = lu(k,875) - lu(k,745) * lu(k,871) + lu(k,876) = lu(k,876) - lu(k,746) * lu(k,871) + lu(k,877) = lu(k,877) - lu(k,747) * lu(k,871) + lu(k,878) = lu(k,878) - lu(k,748) * lu(k,871) + lu(k,880) = lu(k,880) - lu(k,749) * lu(k,871) + lu(k,882) = - lu(k,750) * lu(k,871) + lu(k,3259) = lu(k,3259) - lu(k,742) * lu(k,3248) + lu(k,3260) = lu(k,3260) - lu(k,743) * lu(k,3248) + lu(k,3263) = lu(k,3263) - lu(k,744) * lu(k,3248) + lu(k,3265) = lu(k,3265) - lu(k,745) * lu(k,3248) + lu(k,3299) = lu(k,3299) - lu(k,746) * lu(k,3248) + lu(k,3328) = lu(k,3328) - lu(k,747) * lu(k,3248) + lu(k,3333) = lu(k,3333) - lu(k,748) * lu(k,3248) + lu(k,3369) = lu(k,3369) - lu(k,749) * lu(k,3248) + lu(k,3378) = lu(k,3378) - lu(k,750) * lu(k,3248) + lu(k,3967) = lu(k,3967) - lu(k,742) * lu(k,3954) + lu(k,3968) = lu(k,3968) - lu(k,743) * lu(k,3954) + lu(k,3971) = - lu(k,744) * lu(k,3954) + lu(k,3975) = - lu(k,745) * lu(k,3954) + lu(k,4021) = lu(k,4021) - lu(k,746) * lu(k,3954) + lu(k,4052) = lu(k,4052) - lu(k,747) * lu(k,3954) + lu(k,4057) = lu(k,4057) - lu(k,748) * lu(k,3954) + lu(k,4092) = lu(k,4092) - lu(k,749) * lu(k,3954) + lu(k,4101) = lu(k,4101) - lu(k,750) * lu(k,3954) + lu(k,752) = 1._r8 / lu(k,752) + lu(k,753) = lu(k,753) * lu(k,752) + lu(k,754) = lu(k,754) * lu(k,752) + lu(k,755) = lu(k,755) * lu(k,752) + lu(k,756) = lu(k,756) * lu(k,752) + lu(k,757) = lu(k,757) * lu(k,752) + lu(k,758) = lu(k,758) * lu(k,752) + lu(k,759) = lu(k,759) * lu(k,752) + lu(k,760) = lu(k,760) * lu(k,752) + lu(k,761) = lu(k,761) * lu(k,752) + lu(k,1181) = lu(k,1181) - lu(k,753) * lu(k,1180) + lu(k,1183) = lu(k,1183) - lu(k,754) * lu(k,1180) + lu(k,1184) = lu(k,1184) - lu(k,755) * lu(k,1180) + lu(k,1185) = lu(k,1185) - lu(k,756) * lu(k,1180) + lu(k,1186) = lu(k,1186) - lu(k,757) * lu(k,1180) + lu(k,1188) = lu(k,1188) - lu(k,758) * lu(k,1180) + lu(k,1189) = lu(k,1189) - lu(k,759) * lu(k,1180) + lu(k,1190) = lu(k,1190) - lu(k,760) * lu(k,1180) + lu(k,1191) = lu(k,1191) - lu(k,761) * lu(k,1180) + lu(k,2999) = lu(k,2999) - lu(k,753) * lu(k,2998) + lu(k,3034) = lu(k,3034) - lu(k,754) * lu(k,2998) + lu(k,3037) = lu(k,3037) - lu(k,755) * lu(k,2998) + lu(k,3083) = lu(k,3083) - lu(k,756) * lu(k,2998) + lu(k,3103) = lu(k,3103) - lu(k,757) * lu(k,2998) + lu(k,3109) = lu(k,3109) - lu(k,758) * lu(k,2998) + lu(k,3110) = lu(k,3110) - lu(k,759) * lu(k,2998) + lu(k,3115) = lu(k,3115) - lu(k,760) * lu(k,2998) + lu(k,3119) = lu(k,3119) - lu(k,761) * lu(k,2998) + lu(k,3956) = lu(k,3956) - lu(k,753) * lu(k,3955) + lu(k,4011) = lu(k,4011) - lu(k,754) * lu(k,3955) + lu(k,4016) = lu(k,4016) - lu(k,755) * lu(k,3955) + lu(k,4065) = lu(k,4065) - lu(k,756) * lu(k,3955) + lu(k,4085) = lu(k,4085) - lu(k,757) * lu(k,3955) + lu(k,4091) = lu(k,4091) - lu(k,758) * lu(k,3955) + lu(k,4092) = lu(k,4092) - lu(k,759) * lu(k,3955) + lu(k,4097) = lu(k,4097) - lu(k,760) * lu(k,3955) + lu(k,4101) = lu(k,4101) - lu(k,761) * lu(k,3955) + 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,763) = 1._r8 / lu(k,763) + lu(k,764) = lu(k,764) * lu(k,763) + lu(k,765) = lu(k,765) * lu(k,763) + lu(k,766) = lu(k,766) * lu(k,763) + lu(k,767) = lu(k,767) * lu(k,763) + lu(k,768) = lu(k,768) * lu(k,763) + lu(k,769) = lu(k,769) * lu(k,763) + lu(k,1184) = lu(k,1184) - lu(k,764) * lu(k,1181) + lu(k,1186) = lu(k,1186) - lu(k,765) * lu(k,1181) + lu(k,1187) = lu(k,1187) - lu(k,766) * lu(k,1181) + lu(k,1189) = lu(k,1189) - lu(k,767) * lu(k,1181) + lu(k,1190) = lu(k,1190) - lu(k,768) * lu(k,1181) + lu(k,1191) = lu(k,1191) - lu(k,769) * lu(k,1181) + lu(k,3037) = lu(k,3037) - lu(k,764) * lu(k,2999) + lu(k,3103) = lu(k,3103) - lu(k,765) * lu(k,2999) + lu(k,3106) = lu(k,3106) - lu(k,766) * lu(k,2999) + lu(k,3110) = lu(k,3110) - lu(k,767) * lu(k,2999) + lu(k,3115) = lu(k,3115) - lu(k,768) * lu(k,2999) + lu(k,3119) = lu(k,3119) - lu(k,769) * lu(k,2999) + lu(k,3294) = lu(k,3294) - lu(k,764) * lu(k,3249) + lu(k,3362) = lu(k,3362) - lu(k,765) * lu(k,3249) + lu(k,3365) = lu(k,3365) - lu(k,766) * lu(k,3249) + lu(k,3369) = lu(k,3369) - lu(k,767) * lu(k,3249) + lu(k,3374) = lu(k,3374) - lu(k,768) * lu(k,3249) + lu(k,3378) = lu(k,3378) - lu(k,769) * lu(k,3249) + lu(k,4016) = lu(k,4016) - lu(k,764) * lu(k,3956) + lu(k,4085) = lu(k,4085) - lu(k,765) * lu(k,3956) + lu(k,4088) = lu(k,4088) - lu(k,766) * lu(k,3956) + lu(k,4092) = lu(k,4092) - lu(k,767) * lu(k,3956) + lu(k,4097) = lu(k,4097) - lu(k,768) * lu(k,3956) + lu(k,4101) = lu(k,4101) - lu(k,769) * lu(k,3956) + lu(k,770) = 1._r8 / lu(k,770) + lu(k,771) = lu(k,771) * lu(k,770) + lu(k,772) = lu(k,772) * lu(k,770) + lu(k,773) = lu(k,773) * lu(k,770) + lu(k,774) = lu(k,774) * lu(k,770) + lu(k,775) = lu(k,775) * lu(k,770) + lu(k,776) = lu(k,776) * lu(k,770) + lu(k,777) = lu(k,777) * lu(k,770) + lu(k,1299) = lu(k,1299) - lu(k,771) * lu(k,1297) + lu(k,1300) = lu(k,1300) - lu(k,772) * lu(k,1297) + lu(k,1301) = lu(k,1301) - lu(k,773) * lu(k,1297) + lu(k,1303) = lu(k,1303) - lu(k,774) * lu(k,1297) + lu(k,1304) = lu(k,1304) - lu(k,775) * lu(k,1297) + lu(k,1306) = lu(k,1306) - lu(k,776) * lu(k,1297) + lu(k,1308) = lu(k,1308) - lu(k,777) * lu(k,1297) + lu(k,1888) = - lu(k,771) * lu(k,1885) + lu(k,1892) = lu(k,1892) - lu(k,772) * lu(k,1885) + lu(k,1893) = lu(k,1893) - lu(k,773) * lu(k,1885) + lu(k,1898) = - lu(k,774) * lu(k,1885) + lu(k,1903) = lu(k,1903) - lu(k,775) * lu(k,1885) + lu(k,1908) = lu(k,1908) - lu(k,776) * lu(k,1885) + lu(k,1910) = lu(k,1910) - lu(k,777) * lu(k,1885) + lu(k,3299) = lu(k,3299) - lu(k,771) * lu(k,3250) + lu(k,3316) = lu(k,3316) - lu(k,772) * lu(k,3250) + lu(k,3320) = lu(k,3320) - lu(k,773) * lu(k,3250) + lu(k,3328) = lu(k,3328) - lu(k,774) * lu(k,3250) + lu(k,3333) = lu(k,3333) - lu(k,775) * lu(k,3250) + lu(k,3369) = lu(k,3369) - lu(k,776) * lu(k,3250) + lu(k,3378) = lu(k,3378) - lu(k,777) * lu(k,3250) + lu(k,4021) = lu(k,4021) - lu(k,771) * lu(k,3957) + lu(k,4040) = lu(k,4040) - lu(k,772) * lu(k,3957) + lu(k,4044) = lu(k,4044) - lu(k,773) * lu(k,3957) + lu(k,4052) = lu(k,4052) - lu(k,774) * lu(k,3957) + lu(k,4057) = lu(k,4057) - lu(k,775) * lu(k,3957) + lu(k,4092) = lu(k,4092) - lu(k,776) * lu(k,3957) + lu(k,4101) = lu(k,4101) - lu(k,777) * lu(k,3957) + lu(k,778) = 1._r8 / lu(k,778) + lu(k,779) = lu(k,779) * lu(k,778) + lu(k,780) = lu(k,780) * lu(k,778) + lu(k,781) = lu(k,781) * lu(k,778) + lu(k,782) = lu(k,782) * lu(k,778) + lu(k,1043) = - lu(k,779) * lu(k,1040) + lu(k,1047) = - lu(k,780) * lu(k,1040) + lu(k,1048) = - lu(k,781) * lu(k,1040) + lu(k,1053) = lu(k,1053) - lu(k,782) * lu(k,1040) + lu(k,1073) = - lu(k,779) * lu(k,1070) + lu(k,1077) = - lu(k,780) * lu(k,1070) + lu(k,1079) = - lu(k,781) * lu(k,1070) + lu(k,1084) = lu(k,1084) - lu(k,782) * lu(k,1070) + lu(k,1275) = - lu(k,779) * lu(k,1271) + lu(k,1280) = - lu(k,780) * lu(k,1271) + lu(k,1283) = - lu(k,781) * lu(k,1271) + lu(k,1288) = lu(k,1288) - lu(k,782) * lu(k,1271) + lu(k,2814) = lu(k,2814) - lu(k,779) * lu(k,2809) + lu(k,2835) = lu(k,2835) - lu(k,780) * lu(k,2809) + lu(k,2840) = lu(k,2840) - lu(k,781) * lu(k,2809) + lu(k,2853) = lu(k,2853) - lu(k,782) * lu(k,2809) + lu(k,3309) = lu(k,3309) - lu(k,779) * lu(k,3251) + lu(k,3356) = lu(k,3356) - lu(k,780) * lu(k,3251) + lu(k,3361) = lu(k,3361) - lu(k,781) * lu(k,3251) + lu(k,3378) = lu(k,3378) - lu(k,782) * lu(k,3251) + lu(k,3706) = lu(k,3706) - lu(k,779) * lu(k,3679) + lu(k,3747) = - lu(k,780) * lu(k,3679) + lu(k,3752) = - lu(k,781) * lu(k,3679) + lu(k,3769) = lu(k,3769) - lu(k,782) * lu(k,3679) + lu(k,4033) = lu(k,4033) - lu(k,779) * lu(k,3958) + lu(k,4079) = lu(k,4079) - lu(k,780) * lu(k,3958) + lu(k,4084) = lu(k,4084) - lu(k,781) * lu(k,3958) + lu(k,4101) = lu(k,4101) - lu(k,782) * lu(k,3958) + 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,2493) = - lu(k,784) * lu(k,2492) + lu(k,2502) = lu(k,2502) - lu(k,785) * lu(k,2492) + lu(k,2507) = lu(k,2507) - lu(k,786) * lu(k,2492) + lu(k,2515) = - lu(k,787) * lu(k,2492) + lu(k,2519) = lu(k,2519) - lu(k,788) * lu(k,2492) + lu(k,2522) = lu(k,2522) - lu(k,789) * lu(k,2492) + lu(k,2523) = lu(k,2523) - lu(k,790) * lu(k,2492) + lu(k,2556) = - lu(k,784) * lu(k,2555) + lu(k,2565) = lu(k,2565) - lu(k,785) * lu(k,2555) + lu(k,2572) = lu(k,2572) - lu(k,786) * lu(k,2555) + lu(k,2580) = - lu(k,787) * lu(k,2555) + lu(k,2584) = lu(k,2584) - lu(k,788) * lu(k,2555) + lu(k,2587) = lu(k,2587) - lu(k,789) * lu(k,2555) + lu(k,2588) = lu(k,2588) - lu(k,790) * lu(k,2555) + lu(k,3273) = lu(k,3273) - lu(k,784) * lu(k,3252) + lu(k,3315) = lu(k,3315) - lu(k,785) * lu(k,3252) + lu(k,3355) = lu(k,3355) - lu(k,786) * lu(k,3252) + lu(k,3364) = - lu(k,787) * lu(k,3252) + lu(k,3369) = lu(k,3369) - lu(k,788) * lu(k,3252) + lu(k,3374) = lu(k,3374) - lu(k,789) * lu(k,3252) + lu(k,3378) = lu(k,3378) - lu(k,790) * lu(k,3252) + lu(k,3983) = lu(k,3983) - lu(k,784) * lu(k,3959) + lu(k,4039) = lu(k,4039) - lu(k,785) * lu(k,3959) + lu(k,4078) = lu(k,4078) - lu(k,786) * lu(k,3959) + lu(k,4087) = lu(k,4087) - lu(k,787) * lu(k,3959) + lu(k,4092) = lu(k,4092) - lu(k,788) * lu(k,3959) + lu(k,4097) = lu(k,4097) - lu(k,789) * lu(k,3959) + lu(k,4101) = lu(k,4101) - lu(k,790) * lu(k,3959) + lu(k,791) = 1._r8 / lu(k,791) + lu(k,792) = lu(k,792) * lu(k,791) + lu(k,793) = lu(k,793) * lu(k,791) + lu(k,794) = lu(k,794) * lu(k,791) + lu(k,795) = lu(k,795) * lu(k,791) + lu(k,1388) = lu(k,1388) - lu(k,792) * lu(k,1382) + lu(k,1395) = lu(k,1395) - lu(k,793) * lu(k,1382) + lu(k,1399) = lu(k,1399) - lu(k,794) * lu(k,1382) + lu(k,1400) = - lu(k,795) * lu(k,1382) + lu(k,1619) = lu(k,1619) - lu(k,792) * lu(k,1618) + lu(k,1628) = lu(k,1628) - lu(k,793) * lu(k,1618) + lu(k,1632) = lu(k,1632) - lu(k,794) * lu(k,1618) + lu(k,1633) = lu(k,1633) - lu(k,795) * lu(k,1618) + lu(k,2865) = lu(k,2865) - lu(k,792) * lu(k,2857) + lu(k,2921) = lu(k,2921) - lu(k,793) * lu(k,2857) + lu(k,2927) = lu(k,2927) - lu(k,794) * lu(k,2857) + lu(k,2928) = lu(k,2928) - lu(k,795) * lu(k,2857) + lu(k,3309) = lu(k,3309) - lu(k,792) * lu(k,3253) + lu(k,3370) = lu(k,3370) - lu(k,793) * lu(k,3253) + lu(k,3378) = lu(k,3378) - lu(k,794) * lu(k,3253) + lu(k,3379) = lu(k,3379) - lu(k,795) * lu(k,3253) + lu(k,3404) = lu(k,3404) - lu(k,792) * lu(k,3384) + lu(k,3463) = lu(k,3463) - lu(k,793) * lu(k,3384) + lu(k,3471) = lu(k,3471) - lu(k,794) * lu(k,3384) + lu(k,3472) = lu(k,3472) - lu(k,795) * lu(k,3384) + lu(k,3706) = lu(k,3706) - lu(k,792) * lu(k,3680) + lu(k,3761) = lu(k,3761) - lu(k,793) * lu(k,3680) + lu(k,3769) = lu(k,3769) - lu(k,794) * lu(k,3680) + lu(k,3770) = - lu(k,795) * lu(k,3680) + lu(k,4033) = lu(k,4033) - lu(k,792) * lu(k,3960) + lu(k,4093) = lu(k,4093) - lu(k,793) * lu(k,3960) + lu(k,4101) = lu(k,4101) - lu(k,794) * lu(k,3960) + lu(k,4102) = lu(k,4102) - lu(k,795) * lu(k,3960) + 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,797) = 1._r8 / lu(k,797) + lu(k,798) = lu(k,798) * lu(k,797) + lu(k,799) = lu(k,799) * lu(k,797) + lu(k,800) = lu(k,800) * lu(k,797) + lu(k,801) = lu(k,801) * lu(k,797) + lu(k,802) = lu(k,802) * lu(k,797) + lu(k,803) = lu(k,803) * lu(k,797) + lu(k,804) = lu(k,804) * lu(k,797) + lu(k,2620) = - lu(k,798) * lu(k,2619) + lu(k,2626) = lu(k,2626) - lu(k,799) * lu(k,2619) + lu(k,2636) = - lu(k,800) * lu(k,2619) + lu(k,2639) = lu(k,2639) - lu(k,801) * lu(k,2619) + lu(k,2640) = - lu(k,802) * lu(k,2619) + lu(k,2642) = lu(k,2642) - lu(k,803) * lu(k,2619) + lu(k,2645) = lu(k,2645) - lu(k,804) * lu(k,2619) + lu(k,3014) = lu(k,3014) - lu(k,798) * lu(k,3000) + lu(k,3058) = lu(k,3058) - lu(k,799) * lu(k,3000) + lu(k,3106) = lu(k,3106) - lu(k,800) * lu(k,3000) + lu(k,3109) = lu(k,3109) - lu(k,801) * lu(k,3000) + lu(k,3110) = lu(k,3110) - lu(k,802) * lu(k,3000) + lu(k,3115) = lu(k,3115) - lu(k,803) * lu(k,3000) + lu(k,3119) = lu(k,3119) - lu(k,804) * lu(k,3000) + lu(k,3269) = lu(k,3269) - lu(k,798) * lu(k,3254) + lu(k,3317) = lu(k,3317) - lu(k,799) * lu(k,3254) + lu(k,3365) = lu(k,3365) - lu(k,800) * lu(k,3254) + lu(k,3368) = lu(k,3368) - lu(k,801) * lu(k,3254) + lu(k,3369) = lu(k,3369) - lu(k,802) * lu(k,3254) + lu(k,3374) = lu(k,3374) - lu(k,803) * lu(k,3254) + lu(k,3378) = lu(k,3378) - lu(k,804) * lu(k,3254) + lu(k,3979) = lu(k,3979) - lu(k,798) * lu(k,3961) + lu(k,4041) = lu(k,4041) - lu(k,799) * lu(k,3961) + lu(k,4088) = lu(k,4088) - lu(k,800) * lu(k,3961) + lu(k,4091) = lu(k,4091) - lu(k,801) * lu(k,3961) + lu(k,4092) = lu(k,4092) - lu(k,802) * lu(k,3961) + lu(k,4097) = lu(k,4097) - lu(k,803) * lu(k,3961) + lu(k,4101) = lu(k,4101) - lu(k,804) * lu(k,3961) + lu(k,805) = 1._r8 / lu(k,805) + lu(k,806) = lu(k,806) * lu(k,805) + lu(k,807) = lu(k,807) * lu(k,805) + lu(k,808) = lu(k,808) * lu(k,805) + lu(k,809) = lu(k,809) * lu(k,805) + lu(k,810) = lu(k,810) * lu(k,805) + lu(k,811) = lu(k,811) * lu(k,805) + lu(k,812) = lu(k,812) * lu(k,805) + lu(k,1686) = - lu(k,806) * lu(k,1685) + lu(k,1687) = - lu(k,807) * lu(k,1685) + lu(k,1688) = - lu(k,808) * lu(k,1685) + lu(k,1693) = - lu(k,809) * lu(k,1685) + lu(k,1694) = lu(k,1694) - lu(k,810) * lu(k,1685) + lu(k,1695) = lu(k,1695) - lu(k,811) * lu(k,1685) + lu(k,1696) = lu(k,1696) - lu(k,812) * lu(k,1685) + lu(k,3014) = lu(k,3014) - lu(k,806) * lu(k,3001) + lu(k,3030) = lu(k,3030) - lu(k,807) * lu(k,3001) + lu(k,3050) = lu(k,3050) - lu(k,808) * lu(k,3001) + lu(k,3106) = lu(k,3106) - lu(k,809) * lu(k,3001) + lu(k,3110) = lu(k,3110) - lu(k,810) * lu(k,3001) + lu(k,3115) = lu(k,3115) - lu(k,811) * lu(k,3001) + lu(k,3119) = lu(k,3119) - lu(k,812) * lu(k,3001) + lu(k,3269) = lu(k,3269) - lu(k,806) * lu(k,3255) + lu(k,3287) = - lu(k,807) * lu(k,3255) + lu(k,3307) = lu(k,3307) - lu(k,808) * lu(k,3255) + lu(k,3365) = lu(k,3365) - lu(k,809) * lu(k,3255) + lu(k,3369) = lu(k,3369) - lu(k,810) * lu(k,3255) + lu(k,3374) = lu(k,3374) - lu(k,811) * lu(k,3255) + lu(k,3378) = lu(k,3378) - lu(k,812) * lu(k,3255) + lu(k,3979) = lu(k,3979) - lu(k,806) * lu(k,3962) + lu(k,4001) = lu(k,4001) - lu(k,807) * lu(k,3962) + lu(k,4030) = lu(k,4030) - lu(k,808) * lu(k,3962) + lu(k,4088) = lu(k,4088) - lu(k,809) * lu(k,3962) + lu(k,4092) = lu(k,4092) - lu(k,810) * lu(k,3962) + lu(k,4097) = lu(k,4097) - lu(k,811) * lu(k,3962) + lu(k,4101) = lu(k,4101) - lu(k,812) * lu(k,3962) + lu(k,813) = 1._r8 / lu(k,813) + lu(k,814) = lu(k,814) * lu(k,813) + lu(k,815) = lu(k,815) * lu(k,813) + lu(k,816) = lu(k,816) * lu(k,813) + lu(k,817) = lu(k,817) * lu(k,813) + lu(k,818) = lu(k,818) * lu(k,813) + lu(k,819) = lu(k,819) * lu(k,813) + lu(k,820) = lu(k,820) * lu(k,813) + lu(k,1698) = - lu(k,814) * lu(k,1697) + lu(k,1699) = - lu(k,815) * lu(k,1697) + lu(k,1700) = - lu(k,816) * lu(k,1697) + lu(k,1706) = - lu(k,817) * lu(k,1697) + lu(k,1707) = lu(k,1707) - lu(k,818) * lu(k,1697) + lu(k,1708) = lu(k,1708) - lu(k,819) * lu(k,1697) + lu(k,1709) = lu(k,1709) - lu(k,820) * lu(k,1697) + lu(k,3014) = lu(k,3014) - lu(k,814) * lu(k,3002) + lu(k,3030) = lu(k,3030) - lu(k,815) * lu(k,3002) + lu(k,3048) = lu(k,3048) - lu(k,816) * lu(k,3002) + lu(k,3106) = lu(k,3106) - lu(k,817) * lu(k,3002) + lu(k,3110) = lu(k,3110) - lu(k,818) * lu(k,3002) + lu(k,3115) = lu(k,3115) - lu(k,819) * lu(k,3002) + lu(k,3119) = lu(k,3119) - lu(k,820) * lu(k,3002) + lu(k,3269) = lu(k,3269) - lu(k,814) * lu(k,3256) + lu(k,3287) = lu(k,3287) - lu(k,815) * lu(k,3256) + lu(k,3305) = lu(k,3305) - lu(k,816) * lu(k,3256) + lu(k,3365) = lu(k,3365) - lu(k,817) * lu(k,3256) + lu(k,3369) = lu(k,3369) - lu(k,818) * lu(k,3256) + lu(k,3374) = lu(k,3374) - lu(k,819) * lu(k,3256) + lu(k,3378) = lu(k,3378) - lu(k,820) * lu(k,3256) + lu(k,3979) = lu(k,3979) - lu(k,814) * lu(k,3963) + lu(k,4001) = lu(k,4001) - lu(k,815) * lu(k,3963) + lu(k,4028) = lu(k,4028) - lu(k,816) * lu(k,3963) + lu(k,4088) = lu(k,4088) - lu(k,817) * lu(k,3963) + lu(k,4092) = lu(k,4092) - lu(k,818) * lu(k,3963) + lu(k,4097) = lu(k,4097) - lu(k,819) * lu(k,3963) + lu(k,4101) = lu(k,4101) - lu(k,820) * lu(k,3963) + lu(k,827) = 1._r8 / lu(k,827) + lu(k,828) = lu(k,828) * lu(k,827) + lu(k,829) = lu(k,829) * lu(k,827) + lu(k,830) = lu(k,830) * lu(k,827) + lu(k,831) = lu(k,831) * lu(k,827) + lu(k,832) = lu(k,832) * lu(k,827) + lu(k,833) = lu(k,833) * lu(k,827) + lu(k,834) = lu(k,834) * lu(k,827) + lu(k,835) = lu(k,835) * lu(k,827) + lu(k,836) = lu(k,836) * lu(k,827) + lu(k,837) = lu(k,837) * lu(k,827) + lu(k,3559) = - lu(k,828) * lu(k,3529) + lu(k,3579) = lu(k,3579) - lu(k,829) * lu(k,3529) + lu(k,3587) = lu(k,3587) - lu(k,830) * lu(k,3529) + lu(k,3590) = lu(k,3590) - lu(k,831) * lu(k,3529) + lu(k,3591) = lu(k,3591) - lu(k,832) * lu(k,3529) + lu(k,3605) = lu(k,3605) - lu(k,833) * lu(k,3529) + lu(k,3606) = lu(k,3606) - lu(k,834) * lu(k,3529) + lu(k,3610) = lu(k,3610) - lu(k,835) * lu(k,3529) + lu(k,3612) = - lu(k,836) * lu(k,3529) + lu(k,3615) = lu(k,3615) - lu(k,837) * lu(k,3529) + lu(k,3713) = lu(k,3713) - lu(k,828) * lu(k,3681) + lu(k,3734) = lu(k,3734) - lu(k,829) * lu(k,3681) + lu(k,3741) = - lu(k,830) * lu(k,3681) + lu(k,3744) = - lu(k,831) * lu(k,3681) + lu(k,3745) = lu(k,3745) - lu(k,832) * lu(k,3681) + lu(k,3759) = lu(k,3759) - lu(k,833) * lu(k,3681) + lu(k,3760) = lu(k,3760) - lu(k,834) * lu(k,3681) + lu(k,3764) = lu(k,3764) - lu(k,835) * lu(k,3681) + lu(k,3766) = lu(k,3766) - lu(k,836) * lu(k,3681) + lu(k,3769) = lu(k,3769) - lu(k,837) * lu(k,3681) + lu(k,4044) = lu(k,4044) - lu(k,828) * lu(k,3964) + lu(k,4065) = lu(k,4065) - lu(k,829) * lu(k,3964) + lu(k,4073) = lu(k,4073) - lu(k,830) * lu(k,3964) + lu(k,4076) = - lu(k,831) * lu(k,3964) + lu(k,4077) = lu(k,4077) - lu(k,832) * lu(k,3964) + lu(k,4091) = lu(k,4091) - lu(k,833) * lu(k,3964) + lu(k,4092) = lu(k,4092) - lu(k,834) * lu(k,3964) + lu(k,4096) = lu(k,4096) - lu(k,835) * lu(k,3964) + lu(k,4098) = lu(k,4098) - lu(k,836) * lu(k,3964) + lu(k,4101) = lu(k,4101) - lu(k,837) * lu(k,3964) + end do + end subroutine lu_fac18 + subroutine lu_fac19( 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,842) = 1._r8 / lu(k,842) + lu(k,843) = lu(k,843) * lu(k,842) + lu(k,844) = lu(k,844) * lu(k,842) + lu(k,845) = lu(k,845) * lu(k,842) + lu(k,846) = lu(k,846) * lu(k,842) + lu(k,847) = lu(k,847) * lu(k,842) + lu(k,848) = lu(k,848) * lu(k,842) + lu(k,849) = lu(k,849) * lu(k,842) + lu(k,850) = lu(k,850) * lu(k,842) + lu(k,851) = lu(k,851) * lu(k,842) + lu(k,852) = lu(k,852) * lu(k,842) + lu(k,894) = lu(k,894) - lu(k,843) * lu(k,893) + lu(k,895) = lu(k,895) - lu(k,844) * lu(k,893) + lu(k,896) = lu(k,896) - lu(k,845) * lu(k,893) + lu(k,897) = lu(k,897) - lu(k,846) * lu(k,893) + lu(k,898) = lu(k,898) - lu(k,847) * lu(k,893) + lu(k,899) = lu(k,899) - lu(k,848) * lu(k,893) + lu(k,900) = lu(k,900) - lu(k,849) * lu(k,893) + lu(k,901) = lu(k,901) - lu(k,850) * lu(k,893) + lu(k,903) = lu(k,903) - lu(k,851) * lu(k,893) + lu(k,905) = - lu(k,852) * lu(k,893) + lu(k,3259) = lu(k,3259) - lu(k,843) * lu(k,3257) + lu(k,3262) = lu(k,3262) - lu(k,844) * lu(k,3257) + lu(k,3263) = lu(k,3263) - lu(k,845) * lu(k,3257) + lu(k,3265) = lu(k,3265) - lu(k,846) * lu(k,3257) + lu(k,3299) = lu(k,3299) - lu(k,847) * lu(k,3257) + lu(k,3328) = lu(k,3328) - lu(k,848) * lu(k,3257) + lu(k,3333) = lu(k,3333) - lu(k,849) * lu(k,3257) + lu(k,3362) = lu(k,3362) - lu(k,850) * lu(k,3257) + lu(k,3369) = lu(k,3369) - lu(k,851) * lu(k,3257) + lu(k,3378) = lu(k,3378) - lu(k,852) * lu(k,3257) + lu(k,3967) = lu(k,3967) - lu(k,843) * lu(k,3965) + lu(k,3970) = lu(k,3970) - lu(k,844) * lu(k,3965) + lu(k,3971) = lu(k,3971) - lu(k,845) * lu(k,3965) + lu(k,3975) = lu(k,3975) - lu(k,846) * lu(k,3965) + lu(k,4021) = lu(k,4021) - lu(k,847) * lu(k,3965) + lu(k,4052) = lu(k,4052) - lu(k,848) * lu(k,3965) + lu(k,4057) = lu(k,4057) - lu(k,849) * lu(k,3965) + lu(k,4085) = lu(k,4085) - lu(k,850) * lu(k,3965) + lu(k,4092) = lu(k,4092) - lu(k,851) * lu(k,3965) + lu(k,4101) = lu(k,4101) - lu(k,852) * lu(k,3965) + lu(k,855) = 1._r8 / lu(k,855) + lu(k,856) = lu(k,856) * lu(k,855) + lu(k,857) = lu(k,857) * lu(k,855) + lu(k,858) = lu(k,858) * lu(k,855) + lu(k,859) = lu(k,859) * lu(k,855) + lu(k,860) = lu(k,860) * lu(k,855) + lu(k,861) = lu(k,861) * lu(k,855) + lu(k,3057) = lu(k,3057) - lu(k,856) * lu(k,3003) + lu(k,3106) = lu(k,3106) - lu(k,857) * lu(k,3003) + lu(k,3109) = lu(k,3109) - lu(k,858) * lu(k,3003) + lu(k,3110) = lu(k,3110) - lu(k,859) * lu(k,3003) + lu(k,3115) = lu(k,3115) - lu(k,860) * lu(k,3003) + lu(k,3119) = lu(k,3119) - lu(k,861) * lu(k,3003) + lu(k,3316) = lu(k,3316) - lu(k,856) * lu(k,3258) + lu(k,3365) = lu(k,3365) - lu(k,857) * lu(k,3258) + lu(k,3368) = lu(k,3368) - lu(k,858) * lu(k,3258) + lu(k,3369) = lu(k,3369) - lu(k,859) * lu(k,3258) + lu(k,3374) = lu(k,3374) - lu(k,860) * lu(k,3258) + lu(k,3378) = lu(k,3378) - lu(k,861) * lu(k,3258) + lu(k,3709) = lu(k,3709) - lu(k,856) * lu(k,3682) + lu(k,3756) = lu(k,3756) - lu(k,857) * lu(k,3682) + lu(k,3759) = lu(k,3759) - lu(k,858) * lu(k,3682) + lu(k,3760) = lu(k,3760) - lu(k,859) * lu(k,3682) + lu(k,3765) = lu(k,3765) - lu(k,860) * lu(k,3682) + lu(k,3769) = lu(k,3769) - lu(k,861) * lu(k,3682) + lu(k,3831) = - lu(k,856) * lu(k,3820) + lu(k,3838) = - lu(k,857) * lu(k,3820) + lu(k,3841) = lu(k,3841) - lu(k,858) * lu(k,3820) + lu(k,3842) = lu(k,3842) - lu(k,859) * lu(k,3820) + lu(k,3847) = - lu(k,860) * lu(k,3820) + lu(k,3851) = lu(k,3851) - lu(k,861) * lu(k,3820) + lu(k,4040) = lu(k,4040) - lu(k,856) * lu(k,3966) + lu(k,4088) = lu(k,4088) - lu(k,857) * lu(k,3966) + lu(k,4091) = lu(k,4091) - lu(k,858) * lu(k,3966) + lu(k,4092) = lu(k,4092) - lu(k,859) * lu(k,3966) + lu(k,4097) = lu(k,4097) - lu(k,860) * lu(k,3966) + lu(k,4101) = lu(k,4101) - lu(k,861) * lu(k,3966) + lu(k,862) = 1._r8 / lu(k,862) + lu(k,863) = lu(k,863) * lu(k,862) + lu(k,864) = lu(k,864) * lu(k,862) + lu(k,865) = lu(k,865) * lu(k,862) + lu(k,866) = lu(k,866) * lu(k,862) + lu(k,867) = lu(k,867) * lu(k,862) + lu(k,876) = lu(k,876) - lu(k,863) * lu(k,872) + lu(k,878) = lu(k,878) - lu(k,864) * lu(k,872) + lu(k,879) = lu(k,879) - lu(k,865) * lu(k,872) + lu(k,880) = lu(k,880) - lu(k,866) * lu(k,872) + lu(k,881) = lu(k,881) - lu(k,867) * lu(k,872) + lu(k,898) = lu(k,898) - lu(k,863) * lu(k,894) + lu(k,900) = lu(k,900) - lu(k,864) * lu(k,894) + lu(k,902) = lu(k,902) - lu(k,865) * lu(k,894) + lu(k,903) = lu(k,903) - lu(k,866) * lu(k,894) + lu(k,904) = lu(k,904) - lu(k,867) * lu(k,894) + lu(k,3042) = lu(k,3042) - lu(k,863) * lu(k,3004) + lu(k,3074) = lu(k,3074) - lu(k,864) * lu(k,3004) + lu(k,3106) = lu(k,3106) - lu(k,865) * lu(k,3004) + lu(k,3110) = lu(k,3110) - lu(k,866) * lu(k,3004) + lu(k,3115) = lu(k,3115) - lu(k,867) * lu(k,3004) + lu(k,3299) = lu(k,3299) - lu(k,863) * lu(k,3259) + lu(k,3333) = lu(k,3333) - lu(k,864) * lu(k,3259) + lu(k,3365) = lu(k,3365) - lu(k,865) * lu(k,3259) + lu(k,3369) = lu(k,3369) - lu(k,866) * lu(k,3259) + lu(k,3374) = lu(k,3374) - lu(k,867) * lu(k,3259) + lu(k,3638) = - lu(k,863) * lu(k,3631) + lu(k,3644) = lu(k,3644) - lu(k,864) * lu(k,3631) + lu(k,3654) = lu(k,3654) - lu(k,865) * lu(k,3631) + lu(k,3658) = lu(k,3658) - lu(k,866) * lu(k,3631) + lu(k,3663) = lu(k,3663) - lu(k,867) * lu(k,3631) + lu(k,4021) = lu(k,4021) - lu(k,863) * lu(k,3967) + lu(k,4057) = lu(k,4057) - lu(k,864) * lu(k,3967) + lu(k,4088) = lu(k,4088) - lu(k,865) * lu(k,3967) + lu(k,4092) = lu(k,4092) - lu(k,866) * lu(k,3967) + lu(k,4097) = lu(k,4097) - lu(k,867) * lu(k,3967) + lu(k,873) = 1._r8 / lu(k,873) + lu(k,874) = lu(k,874) * lu(k,873) + lu(k,875) = lu(k,875) * lu(k,873) + lu(k,876) = lu(k,876) * lu(k,873) + lu(k,877) = lu(k,877) * lu(k,873) + lu(k,878) = lu(k,878) * lu(k,873) + lu(k,879) = lu(k,879) * lu(k,873) + lu(k,880) = lu(k,880) * lu(k,873) + lu(k,881) = lu(k,881) * lu(k,873) + lu(k,882) = lu(k,882) * lu(k,873) + lu(k,3008) = lu(k,3008) - lu(k,874) * lu(k,3005) + lu(k,3010) = lu(k,3010) - lu(k,875) * lu(k,3005) + lu(k,3042) = lu(k,3042) - lu(k,876) * lu(k,3005) + lu(k,3069) = lu(k,3069) - lu(k,877) * lu(k,3005) + lu(k,3074) = lu(k,3074) - lu(k,878) * lu(k,3005) + lu(k,3106) = lu(k,3106) - lu(k,879) * lu(k,3005) + lu(k,3110) = lu(k,3110) - lu(k,880) * lu(k,3005) + lu(k,3115) = lu(k,3115) - lu(k,881) * lu(k,3005) + lu(k,3119) = lu(k,3119) - lu(k,882) * lu(k,3005) + lu(k,3263) = lu(k,3263) - lu(k,874) * lu(k,3260) + lu(k,3265) = lu(k,3265) - lu(k,875) * lu(k,3260) + lu(k,3299) = lu(k,3299) - lu(k,876) * lu(k,3260) + lu(k,3328) = lu(k,3328) - lu(k,877) * lu(k,3260) + lu(k,3333) = lu(k,3333) - lu(k,878) * lu(k,3260) + lu(k,3365) = lu(k,3365) - lu(k,879) * lu(k,3260) + lu(k,3369) = lu(k,3369) - lu(k,880) * lu(k,3260) + lu(k,3374) = lu(k,3374) - lu(k,881) * lu(k,3260) + lu(k,3378) = lu(k,3378) - lu(k,882) * lu(k,3260) + lu(k,3971) = lu(k,3971) - lu(k,874) * lu(k,3968) + lu(k,3975) = lu(k,3975) - lu(k,875) * lu(k,3968) + lu(k,4021) = lu(k,4021) - lu(k,876) * lu(k,3968) + lu(k,4052) = lu(k,4052) - lu(k,877) * lu(k,3968) + lu(k,4057) = lu(k,4057) - lu(k,878) * lu(k,3968) + lu(k,4088) = lu(k,4088) - lu(k,879) * lu(k,3968) + lu(k,4092) = lu(k,4092) - lu(k,880) * lu(k,3968) + lu(k,4097) = lu(k,4097) - lu(k,881) * lu(k,3968) + lu(k,4101) = lu(k,4101) - lu(k,882) * lu(k,3968) + lu(k,883) = 1._r8 / lu(k,883) + lu(k,884) = lu(k,884) * lu(k,883) + lu(k,885) = lu(k,885) * lu(k,883) + lu(k,886) = lu(k,886) * lu(k,883) + lu(k,887) = lu(k,887) * lu(k,883) + lu(k,888) = lu(k,888) * lu(k,883) + lu(k,1364) = - lu(k,884) * lu(k,1359) + lu(k,1370) = - lu(k,885) * lu(k,1359) + lu(k,1373) = lu(k,1373) - lu(k,886) * lu(k,1359) + lu(k,1374) = lu(k,1374) - lu(k,887) * lu(k,1359) + lu(k,1376) = lu(k,1376) - lu(k,888) * lu(k,1359) + lu(k,1568) = lu(k,1568) - lu(k,884) * lu(k,1562) + lu(k,1582) = - lu(k,885) * lu(k,1562) + lu(k,1590) = - lu(k,886) * lu(k,1562) + lu(k,1591) = lu(k,1591) - lu(k,887) * lu(k,1562) + lu(k,1595) = lu(k,1595) - lu(k,888) * lu(k,1562) + lu(k,3042) = lu(k,3042) - lu(k,884) * lu(k,3006) + lu(k,3074) = lu(k,3074) - lu(k,885) * lu(k,3006) + lu(k,3109) = lu(k,3109) - lu(k,886) * lu(k,3006) + lu(k,3110) = lu(k,3110) - lu(k,887) * lu(k,3006) + lu(k,3119) = lu(k,3119) - lu(k,888) * lu(k,3006) + lu(k,3299) = lu(k,3299) - lu(k,884) * lu(k,3261) + lu(k,3333) = lu(k,3333) - lu(k,885) * lu(k,3261) + lu(k,3368) = lu(k,3368) - lu(k,886) * lu(k,3261) + lu(k,3369) = lu(k,3369) - lu(k,887) * lu(k,3261) + lu(k,3378) = lu(k,3378) - lu(k,888) * lu(k,3261) + lu(k,3700) = lu(k,3700) - lu(k,884) * lu(k,3683) + lu(k,3726) = lu(k,3726) - lu(k,885) * lu(k,3683) + lu(k,3759) = lu(k,3759) - lu(k,886) * lu(k,3683) + lu(k,3760) = lu(k,3760) - lu(k,887) * lu(k,3683) + lu(k,3769) = lu(k,3769) - lu(k,888) * lu(k,3683) + lu(k,4021) = lu(k,4021) - lu(k,884) * lu(k,3969) + lu(k,4057) = lu(k,4057) - lu(k,885) * lu(k,3969) + lu(k,4091) = lu(k,4091) - lu(k,886) * lu(k,3969) + lu(k,4092) = lu(k,4092) - lu(k,887) * lu(k,3969) + lu(k,4101) = lu(k,4101) - lu(k,888) * lu(k,3969) + lu(k,895) = 1._r8 / lu(k,895) + lu(k,896) = lu(k,896) * lu(k,895) + lu(k,897) = lu(k,897) * lu(k,895) + lu(k,898) = lu(k,898) * lu(k,895) + lu(k,899) = lu(k,899) * lu(k,895) + lu(k,900) = lu(k,900) * lu(k,895) + lu(k,901) = lu(k,901) * lu(k,895) + lu(k,902) = lu(k,902) * lu(k,895) + lu(k,903) = lu(k,903) * lu(k,895) + lu(k,904) = lu(k,904) * lu(k,895) + lu(k,905) = lu(k,905) * lu(k,895) + lu(k,3008) = lu(k,3008) - lu(k,896) * lu(k,3007) + lu(k,3010) = lu(k,3010) - lu(k,897) * lu(k,3007) + lu(k,3042) = lu(k,3042) - lu(k,898) * lu(k,3007) + lu(k,3069) = lu(k,3069) - lu(k,899) * lu(k,3007) + lu(k,3074) = lu(k,3074) - lu(k,900) * lu(k,3007) + lu(k,3103) = lu(k,3103) - lu(k,901) * lu(k,3007) + lu(k,3106) = lu(k,3106) - lu(k,902) * lu(k,3007) + lu(k,3110) = lu(k,3110) - lu(k,903) * lu(k,3007) + lu(k,3115) = lu(k,3115) - lu(k,904) * lu(k,3007) + lu(k,3119) = lu(k,3119) - lu(k,905) * lu(k,3007) + lu(k,3263) = lu(k,3263) - lu(k,896) * lu(k,3262) + lu(k,3265) = lu(k,3265) - lu(k,897) * lu(k,3262) + lu(k,3299) = lu(k,3299) - lu(k,898) * lu(k,3262) + lu(k,3328) = lu(k,3328) - lu(k,899) * lu(k,3262) + lu(k,3333) = lu(k,3333) - lu(k,900) * lu(k,3262) + lu(k,3362) = lu(k,3362) - lu(k,901) * lu(k,3262) + lu(k,3365) = lu(k,3365) - lu(k,902) * lu(k,3262) + lu(k,3369) = lu(k,3369) - lu(k,903) * lu(k,3262) + lu(k,3374) = lu(k,3374) - lu(k,904) * lu(k,3262) + lu(k,3378) = lu(k,3378) - lu(k,905) * lu(k,3262) + lu(k,3971) = lu(k,3971) - lu(k,896) * lu(k,3970) + lu(k,3975) = lu(k,3975) - lu(k,897) * lu(k,3970) + lu(k,4021) = lu(k,4021) - lu(k,898) * lu(k,3970) + lu(k,4052) = lu(k,4052) - lu(k,899) * lu(k,3970) + lu(k,4057) = lu(k,4057) - lu(k,900) * lu(k,3970) + lu(k,4085) = lu(k,4085) - lu(k,901) * lu(k,3970) + lu(k,4088) = lu(k,4088) - lu(k,902) * lu(k,3970) + lu(k,4092) = lu(k,4092) - lu(k,903) * lu(k,3970) + lu(k,4097) = lu(k,4097) - lu(k,904) * lu(k,3970) + lu(k,4101) = lu(k,4101) - lu(k,905) * lu(k,3970) + end do + end subroutine lu_fac19 + subroutine lu_fac20( 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,906) = 1._r8 / lu(k,906) + lu(k,907) = lu(k,907) * lu(k,906) + lu(k,908) = lu(k,908) * lu(k,906) + lu(k,909) = lu(k,909) * lu(k,906) + lu(k,910) = lu(k,910) * lu(k,906) + lu(k,911) = lu(k,911) * lu(k,906) + lu(k,912) = lu(k,912) * lu(k,906) + lu(k,913) = lu(k,913) * lu(k,906) + lu(k,3069) = lu(k,3069) - lu(k,907) * lu(k,3008) + lu(k,3074) = lu(k,3074) - lu(k,908) * lu(k,3008) + lu(k,3106) = lu(k,3106) - lu(k,909) * lu(k,3008) + lu(k,3110) = lu(k,3110) - lu(k,910) * lu(k,3008) + lu(k,3111) = lu(k,3111) - lu(k,911) * lu(k,3008) + lu(k,3115) = lu(k,3115) - lu(k,912) * lu(k,3008) + lu(k,3119) = lu(k,3119) - lu(k,913) * lu(k,3008) + lu(k,3328) = lu(k,3328) - lu(k,907) * lu(k,3263) + lu(k,3333) = lu(k,3333) - lu(k,908) * lu(k,3263) + lu(k,3365) = lu(k,3365) - lu(k,909) * lu(k,3263) + lu(k,3369) = lu(k,3369) - lu(k,910) * lu(k,3263) + lu(k,3370) = lu(k,3370) - lu(k,911) * lu(k,3263) + lu(k,3374) = lu(k,3374) - lu(k,912) * lu(k,3263) + lu(k,3378) = lu(k,3378) - lu(k,913) * lu(k,3263) + lu(k,3643) = - lu(k,907) * lu(k,3632) + lu(k,3644) = lu(k,3644) - lu(k,908) * lu(k,3632) + lu(k,3654) = lu(k,3654) - lu(k,909) * lu(k,3632) + lu(k,3658) = lu(k,3658) - lu(k,910) * lu(k,3632) + lu(k,3659) = lu(k,3659) - lu(k,911) * lu(k,3632) + lu(k,3663) = lu(k,3663) - lu(k,912) * lu(k,3632) + lu(k,3667) = lu(k,3667) - lu(k,913) * lu(k,3632) + lu(k,4052) = lu(k,4052) - lu(k,907) * lu(k,3971) + lu(k,4057) = lu(k,4057) - lu(k,908) * lu(k,3971) + lu(k,4088) = lu(k,4088) - lu(k,909) * lu(k,3971) + lu(k,4092) = lu(k,4092) - lu(k,910) * lu(k,3971) + lu(k,4093) = lu(k,4093) - lu(k,911) * lu(k,3971) + lu(k,4097) = lu(k,4097) - lu(k,912) * lu(k,3971) + lu(k,4101) = lu(k,4101) - lu(k,913) * lu(k,3971) + lu(k,914) = 1._r8 / lu(k,914) + lu(k,915) = lu(k,915) * lu(k,914) + lu(k,916) = lu(k,916) * lu(k,914) + lu(k,917) = lu(k,917) * lu(k,914) + lu(k,918) = lu(k,918) * lu(k,914) + lu(k,1198) = - lu(k,915) * lu(k,1193) + lu(k,1199) = lu(k,1199) - lu(k,916) * lu(k,1193) + lu(k,1202) = - lu(k,917) * lu(k,1193) + lu(k,1206) = lu(k,1206) - lu(k,918) * lu(k,1193) + lu(k,1256) = lu(k,1256) - lu(k,915) * lu(k,1251) + lu(k,1258) = - lu(k,916) * lu(k,1251) + lu(k,1259) = lu(k,1259) - lu(k,917) * lu(k,1251) + lu(k,1261) = lu(k,1261) - lu(k,918) * lu(k,1251) + lu(k,1527) = - lu(k,915) * lu(k,1521) + lu(k,1529) = - lu(k,916) * lu(k,1521) + lu(k,1530) = - lu(k,917) * lu(k,1521) + lu(k,1532) = - lu(k,918) * lu(k,1521) + lu(k,1815) = - lu(k,915) * lu(k,1807) + lu(k,1820) = lu(k,1820) - lu(k,916) * lu(k,1807) + lu(k,1823) = lu(k,1823) - lu(k,917) * lu(k,1807) + lu(k,1829) = lu(k,1829) - lu(k,918) * lu(k,1807) + lu(k,1847) = - lu(k,915) * lu(k,1838) + lu(k,1852) = lu(k,1852) - lu(k,916) * lu(k,1838) + lu(k,1855) = lu(k,1855) - lu(k,917) * lu(k,1838) + lu(k,1860) = lu(k,1860) - lu(k,918) * lu(k,1838) + lu(k,1893) = lu(k,1893) - lu(k,915) * lu(k,1886) + lu(k,1898) = lu(k,1898) - lu(k,916) * lu(k,1886) + lu(k,1903) = lu(k,1903) - lu(k,917) * lu(k,1886) + lu(k,1907) = lu(k,1907) - lu(k,918) * lu(k,1886) + lu(k,2133) = - lu(k,915) * lu(k,2125) + lu(k,2138) = lu(k,2138) - lu(k,916) * lu(k,2125) + lu(k,2139) = lu(k,2139) - lu(k,917) * lu(k,2125) + lu(k,2146) = - lu(k,918) * lu(k,2125) + lu(k,4044) = lu(k,4044) - lu(k,915) * lu(k,3972) + lu(k,4052) = lu(k,4052) - lu(k,916) * lu(k,3972) + lu(k,4057) = lu(k,4057) - lu(k,917) * lu(k,3972) + lu(k,4091) = lu(k,4091) - lu(k,918) * lu(k,3972) + lu(k,919) = 1._r8 / lu(k,919) + lu(k,920) = lu(k,920) * lu(k,919) + lu(k,921) = lu(k,921) * lu(k,919) + lu(k,922) = lu(k,922) * lu(k,919) + lu(k,923) = lu(k,923) * lu(k,919) + lu(k,1731) = - lu(k,920) * lu(k,1727) + lu(k,1733) = - lu(k,921) * lu(k,1727) + lu(k,1744) = lu(k,1744) - lu(k,922) * lu(k,1727) + lu(k,1747) = lu(k,1747) - lu(k,923) * lu(k,1727) + lu(k,1753) = - lu(k,920) * lu(k,1749) + lu(k,1755) = - lu(k,921) * lu(k,1749) + lu(k,1766) = lu(k,1766) - lu(k,922) * lu(k,1749) + lu(k,1769) = lu(k,1769) - lu(k,923) * lu(k,1749) + lu(k,1814) = - lu(k,920) * lu(k,1808) + lu(k,1815) = lu(k,1815) - lu(k,921) * lu(k,1808) + lu(k,1830) = lu(k,1830) - lu(k,922) * lu(k,1808) + lu(k,1833) = lu(k,1833) - lu(k,923) * lu(k,1808) + lu(k,1846) = - lu(k,920) * lu(k,1839) + lu(k,1847) = lu(k,1847) - lu(k,921) * lu(k,1839) + lu(k,1861) = lu(k,1861) - lu(k,922) * lu(k,1839) + lu(k,1864) = lu(k,1864) - lu(k,923) * lu(k,1839) + lu(k,1943) = - lu(k,920) * lu(k,1937) + lu(k,1945) = - lu(k,921) * lu(k,1937) + lu(k,1964) = lu(k,1964) - lu(k,922) * lu(k,1937) + lu(k,1968) = lu(k,1968) - lu(k,923) * lu(k,1937) + lu(k,1980) = - lu(k,920) * lu(k,1973) + lu(k,1982) = - lu(k,921) * lu(k,1973) + lu(k,2003) = lu(k,2003) - lu(k,922) * lu(k,1973) + lu(k,2007) = lu(k,2007) - lu(k,923) * lu(k,1973) + lu(k,3410) = lu(k,3410) - lu(k,920) * lu(k,3385) + lu(k,3414) = lu(k,3414) - lu(k,921) * lu(k,3385) + lu(k,3462) = lu(k,3462) - lu(k,922) * lu(k,3385) + lu(k,3471) = lu(k,3471) - lu(k,923) * lu(k,3385) + lu(k,4040) = lu(k,4040) - lu(k,920) * lu(k,3973) + lu(k,4044) = lu(k,4044) - lu(k,921) * lu(k,3973) + lu(k,4092) = lu(k,4092) - lu(k,922) * lu(k,3973) + lu(k,4101) = lu(k,4101) - lu(k,923) * lu(k,3973) + lu(k,924) = 1._r8 / lu(k,924) + lu(k,925) = lu(k,925) * lu(k,924) + lu(k,926) = lu(k,926) * lu(k,924) + lu(k,927) = lu(k,927) * lu(k,924) + lu(k,928) = lu(k,928) * lu(k,924) + lu(k,1369) = - lu(k,925) * lu(k,1360) + lu(k,1371) = - lu(k,926) * lu(k,1360) + lu(k,1373) = lu(k,1373) - lu(k,927) * lu(k,1360) + lu(k,1376) = lu(k,1376) - lu(k,928) * lu(k,1360) + lu(k,1581) = lu(k,1581) - lu(k,925) * lu(k,1563) + lu(k,1585) = - lu(k,926) * lu(k,1563) + lu(k,1590) = lu(k,1590) - lu(k,927) * lu(k,1563) + lu(k,1595) = lu(k,1595) - lu(k,928) * lu(k,1563) + lu(k,1820) = lu(k,1820) - lu(k,925) * lu(k,1809) + lu(k,1826) = lu(k,1826) - lu(k,926) * lu(k,1809) + lu(k,1829) = lu(k,1829) - lu(k,927) * lu(k,1809) + lu(k,1833) = lu(k,1833) - lu(k,928) * lu(k,1809) + lu(k,1852) = lu(k,1852) - lu(k,925) * lu(k,1840) + lu(k,1857) = lu(k,1857) - lu(k,926) * lu(k,1840) + lu(k,1860) = lu(k,1860) - lu(k,927) * lu(k,1840) + lu(k,1864) = lu(k,1864) - lu(k,928) * lu(k,1840) + lu(k,3069) = lu(k,3069) - lu(k,925) * lu(k,3009) + lu(k,3103) = lu(k,3103) - lu(k,926) * lu(k,3009) + lu(k,3109) = lu(k,3109) - lu(k,927) * lu(k,3009) + lu(k,3119) = lu(k,3119) - lu(k,928) * lu(k,3009) + lu(k,3328) = lu(k,3328) - lu(k,925) * lu(k,3264) + lu(k,3362) = lu(k,3362) - lu(k,926) * lu(k,3264) + lu(k,3368) = lu(k,3368) - lu(k,927) * lu(k,3264) + lu(k,3378) = lu(k,3378) - lu(k,928) * lu(k,3264) + lu(k,3721) = lu(k,3721) - lu(k,925) * lu(k,3684) + lu(k,3753) = lu(k,3753) - lu(k,926) * lu(k,3684) + lu(k,3759) = lu(k,3759) - lu(k,927) * lu(k,3684) + lu(k,3769) = lu(k,3769) - lu(k,928) * lu(k,3684) + lu(k,4052) = lu(k,4052) - lu(k,925) * lu(k,3974) + lu(k,4085) = lu(k,4085) - lu(k,926) * lu(k,3974) + lu(k,4091) = lu(k,4091) - lu(k,927) * lu(k,3974) + lu(k,4101) = lu(k,4101) - lu(k,928) * lu(k,3974) + lu(k,929) = 1._r8 / lu(k,929) + lu(k,930) = lu(k,930) * lu(k,929) + lu(k,931) = lu(k,931) * lu(k,929) + lu(k,932) = lu(k,932) * lu(k,929) + lu(k,933) = lu(k,933) * lu(k,929) + lu(k,934) = lu(k,934) * lu(k,929) + lu(k,935) = lu(k,935) * lu(k,929) + lu(k,936) = lu(k,936) * lu(k,929) + lu(k,937) = lu(k,937) * lu(k,929) + lu(k,3042) = lu(k,3042) - lu(k,930) * lu(k,3010) + lu(k,3069) = lu(k,3069) - lu(k,931) * lu(k,3010) + lu(k,3074) = lu(k,3074) - lu(k,932) * lu(k,3010) + lu(k,3106) = lu(k,3106) - lu(k,933) * lu(k,3010) + lu(k,3110) = lu(k,3110) - lu(k,934) * lu(k,3010) + lu(k,3111) = lu(k,3111) - lu(k,935) * lu(k,3010) + lu(k,3115) = lu(k,3115) - lu(k,936) * lu(k,3010) + lu(k,3119) = lu(k,3119) - lu(k,937) * lu(k,3010) + lu(k,3299) = lu(k,3299) - lu(k,930) * lu(k,3265) + lu(k,3328) = lu(k,3328) - lu(k,931) * lu(k,3265) + lu(k,3333) = lu(k,3333) - lu(k,932) * lu(k,3265) + lu(k,3365) = lu(k,3365) - lu(k,933) * lu(k,3265) + lu(k,3369) = lu(k,3369) - lu(k,934) * lu(k,3265) + lu(k,3370) = lu(k,3370) - lu(k,935) * lu(k,3265) + lu(k,3374) = lu(k,3374) - lu(k,936) * lu(k,3265) + lu(k,3378) = lu(k,3378) - lu(k,937) * lu(k,3265) + lu(k,3638) = lu(k,3638) - lu(k,930) * lu(k,3633) + lu(k,3643) = lu(k,3643) - lu(k,931) * lu(k,3633) + lu(k,3644) = lu(k,3644) - lu(k,932) * lu(k,3633) + lu(k,3654) = lu(k,3654) - lu(k,933) * lu(k,3633) + lu(k,3658) = lu(k,3658) - lu(k,934) * lu(k,3633) + lu(k,3659) = lu(k,3659) - lu(k,935) * lu(k,3633) + lu(k,3663) = lu(k,3663) - lu(k,936) * lu(k,3633) + lu(k,3667) = lu(k,3667) - lu(k,937) * lu(k,3633) + lu(k,4021) = lu(k,4021) - lu(k,930) * lu(k,3975) + lu(k,4052) = lu(k,4052) - lu(k,931) * lu(k,3975) + lu(k,4057) = lu(k,4057) - lu(k,932) * lu(k,3975) + lu(k,4088) = lu(k,4088) - lu(k,933) * lu(k,3975) + lu(k,4092) = lu(k,4092) - lu(k,934) * lu(k,3975) + lu(k,4093) = lu(k,4093) - lu(k,935) * lu(k,3975) + lu(k,4097) = lu(k,4097) - lu(k,936) * lu(k,3975) + lu(k,4101) = lu(k,4101) - lu(k,937) * lu(k,3975) + end do + end subroutine lu_fac20 + subroutine lu_fac21( 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,939) = 1._r8 / lu(k,939) + lu(k,940) = lu(k,940) * lu(k,939) + lu(k,941) = lu(k,941) * lu(k,939) + lu(k,942) = lu(k,942) * lu(k,939) + lu(k,943) = lu(k,943) * lu(k,939) + lu(k,944) = lu(k,944) * lu(k,939) + lu(k,945) = lu(k,945) * lu(k,939) + lu(k,946) = lu(k,946) * lu(k,939) + lu(k,947) = lu(k,947) * lu(k,939) + lu(k,1386) = lu(k,1386) - lu(k,940) * lu(k,1383) + lu(k,1389) = - lu(k,941) * lu(k,1383) + lu(k,1392) = - lu(k,942) * lu(k,1383) + lu(k,1393) = lu(k,1393) - lu(k,943) * lu(k,1383) + lu(k,1394) = lu(k,1394) - lu(k,944) * lu(k,1383) + lu(k,1397) = - lu(k,945) * lu(k,1383) + lu(k,1399) = lu(k,1399) - lu(k,946) * lu(k,1383) + lu(k,1400) = lu(k,1400) - lu(k,947) * lu(k,1383) + lu(k,3037) = lu(k,3037) - lu(k,940) * lu(k,3011) + lu(k,3061) = lu(k,3061) - lu(k,941) * lu(k,3011) + lu(k,3106) = lu(k,3106) - lu(k,942) * lu(k,3011) + lu(k,3109) = lu(k,3109) - lu(k,943) * lu(k,3011) + lu(k,3110) = lu(k,3110) - lu(k,944) * lu(k,3011) + lu(k,3115) = lu(k,3115) - lu(k,945) * lu(k,3011) + lu(k,3119) = lu(k,3119) - lu(k,946) * lu(k,3011) + lu(k,3120) = lu(k,3120) - lu(k,947) * lu(k,3011) + lu(k,3294) = lu(k,3294) - lu(k,940) * lu(k,3266) + lu(k,3320) = lu(k,3320) - lu(k,941) * lu(k,3266) + lu(k,3365) = lu(k,3365) - lu(k,942) * lu(k,3266) + lu(k,3368) = lu(k,3368) - lu(k,943) * lu(k,3266) + lu(k,3369) = lu(k,3369) - lu(k,944) * lu(k,3266) + lu(k,3374) = lu(k,3374) - lu(k,945) * lu(k,3266) + lu(k,3378) = lu(k,3378) - lu(k,946) * lu(k,3266) + lu(k,3379) = lu(k,3379) - lu(k,947) * lu(k,3266) + lu(k,4016) = lu(k,4016) - lu(k,940) * lu(k,3976) + lu(k,4044) = lu(k,4044) - lu(k,941) * lu(k,3976) + lu(k,4088) = lu(k,4088) - lu(k,942) * lu(k,3976) + lu(k,4091) = lu(k,4091) - lu(k,943) * lu(k,3976) + lu(k,4092) = lu(k,4092) - lu(k,944) * lu(k,3976) + lu(k,4097) = lu(k,4097) - lu(k,945) * lu(k,3976) + lu(k,4101) = lu(k,4101) - lu(k,946) * lu(k,3976) + lu(k,4102) = lu(k,4102) - lu(k,947) * lu(k,3976) + lu(k,951) = 1._r8 / lu(k,951) + lu(k,952) = lu(k,952) * lu(k,951) + lu(k,953) = lu(k,953) * lu(k,951) + lu(k,954) = lu(k,954) * lu(k,951) + lu(k,955) = lu(k,955) * lu(k,951) + lu(k,956) = lu(k,956) * lu(k,951) + lu(k,957) = lu(k,957) * lu(k,951) + lu(k,958) = lu(k,958) * lu(k,951) + lu(k,959) = lu(k,959) * lu(k,951) + lu(k,2316) = - lu(k,952) * lu(k,2315) + lu(k,2318) = - lu(k,953) * lu(k,2315) + lu(k,2321) = - lu(k,954) * lu(k,2315) + lu(k,2326) = - lu(k,955) * lu(k,2315) + lu(k,2328) = - lu(k,956) * lu(k,2315) + lu(k,2329) = lu(k,2329) - lu(k,957) * lu(k,2315) + lu(k,2331) = - lu(k,958) * lu(k,2315) + lu(k,2332) = lu(k,2332) - lu(k,959) * lu(k,2315) + lu(k,3014) = lu(k,3014) - lu(k,952) * lu(k,3012) + lu(k,3058) = lu(k,3058) - lu(k,953) * lu(k,3012) + lu(k,3087) = lu(k,3087) - lu(k,954) * lu(k,3012) + lu(k,3106) = lu(k,3106) - lu(k,955) * lu(k,3012) + lu(k,3109) = lu(k,3109) - lu(k,956) * lu(k,3012) + lu(k,3110) = lu(k,3110) - lu(k,957) * lu(k,3012) + lu(k,3115) = lu(k,3115) - lu(k,958) * lu(k,3012) + lu(k,3119) = lu(k,3119) - lu(k,959) * lu(k,3012) + lu(k,3269) = lu(k,3269) - lu(k,952) * lu(k,3267) + lu(k,3317) = lu(k,3317) - lu(k,953) * lu(k,3267) + lu(k,3346) = lu(k,3346) - lu(k,954) * lu(k,3267) + lu(k,3365) = lu(k,3365) - lu(k,955) * lu(k,3267) + lu(k,3368) = lu(k,3368) - lu(k,956) * lu(k,3267) + lu(k,3369) = lu(k,3369) - lu(k,957) * lu(k,3267) + lu(k,3374) = lu(k,3374) - lu(k,958) * lu(k,3267) + lu(k,3378) = lu(k,3378) - lu(k,959) * lu(k,3267) + lu(k,3979) = lu(k,3979) - lu(k,952) * lu(k,3977) + lu(k,4041) = lu(k,4041) - lu(k,953) * lu(k,3977) + lu(k,4069) = lu(k,4069) - lu(k,954) * lu(k,3977) + lu(k,4088) = lu(k,4088) - lu(k,955) * lu(k,3977) + lu(k,4091) = lu(k,4091) - lu(k,956) * lu(k,3977) + lu(k,4092) = lu(k,4092) - lu(k,957) * lu(k,3977) + lu(k,4097) = lu(k,4097) - lu(k,958) * lu(k,3977) + lu(k,4101) = lu(k,4101) - lu(k,959) * lu(k,3977) + lu(k,960) = 1._r8 / lu(k,960) + lu(k,961) = lu(k,961) * lu(k,960) + lu(k,962) = lu(k,962) * lu(k,960) + lu(k,963) = lu(k,963) * lu(k,960) + lu(k,964) = lu(k,964) * lu(k,960) + lu(k,965) = lu(k,965) * lu(k,960) + lu(k,966) = lu(k,966) * lu(k,960) + lu(k,967) = lu(k,967) * lu(k,960) + lu(k,968) = lu(k,968) * lu(k,960) + lu(k,2595) = lu(k,2595) - lu(k,961) * lu(k,2590) + lu(k,2596) = - lu(k,962) * lu(k,2590) + lu(k,2598) = - lu(k,963) * lu(k,2590) + lu(k,2601) = lu(k,2601) - lu(k,964) * lu(k,2590) + lu(k,2608) = - lu(k,965) * lu(k,2590) + lu(k,2612) = lu(k,2612) - lu(k,966) * lu(k,2590) + lu(k,2614) = lu(k,2614) - lu(k,967) * lu(k,2590) + lu(k,2617) = lu(k,2617) - lu(k,968) * lu(k,2590) + lu(k,3055) = lu(k,3055) - lu(k,961) * lu(k,3013) + lu(k,3056) = lu(k,3056) - lu(k,962) * lu(k,3013) + lu(k,3085) = lu(k,3085) - lu(k,963) * lu(k,3013) + lu(k,3096) = lu(k,3096) - lu(k,964) * lu(k,3013) + lu(k,3106) = lu(k,3106) - lu(k,965) * lu(k,3013) + lu(k,3110) = lu(k,3110) - lu(k,966) * lu(k,3013) + lu(k,3115) = lu(k,3115) - lu(k,967) * lu(k,3013) + lu(k,3119) = lu(k,3119) - lu(k,968) * lu(k,3013) + lu(k,3314) = lu(k,3314) - lu(k,961) * lu(k,3268) + lu(k,3315) = lu(k,3315) - lu(k,962) * lu(k,3268) + lu(k,3344) = lu(k,3344) - lu(k,963) * lu(k,3268) + lu(k,3355) = lu(k,3355) - lu(k,964) * lu(k,3268) + lu(k,3365) = lu(k,3365) - lu(k,965) * lu(k,3268) + lu(k,3369) = lu(k,3369) - lu(k,966) * lu(k,3268) + lu(k,3374) = lu(k,3374) - lu(k,967) * lu(k,3268) + lu(k,3378) = lu(k,3378) - lu(k,968) * lu(k,3268) + lu(k,4038) = lu(k,4038) - lu(k,961) * lu(k,3978) + lu(k,4039) = lu(k,4039) - lu(k,962) * lu(k,3978) + lu(k,4067) = lu(k,4067) - lu(k,963) * lu(k,3978) + lu(k,4078) = lu(k,4078) - lu(k,964) * lu(k,3978) + lu(k,4088) = lu(k,4088) - lu(k,965) * lu(k,3978) + lu(k,4092) = lu(k,4092) - lu(k,966) * lu(k,3978) + lu(k,4097) = lu(k,4097) - lu(k,967) * lu(k,3978) + lu(k,4101) = lu(k,4101) - lu(k,968) * lu(k,3978) + lu(k,969) = 1._r8 / lu(k,969) + lu(k,970) = lu(k,970) * lu(k,969) + lu(k,971) = lu(k,971) * lu(k,969) + lu(k,972) = lu(k,972) * lu(k,969) + lu(k,1007) = - lu(k,970) * lu(k,1005) + lu(k,1011) = lu(k,1011) - lu(k,971) * lu(k,1005) + lu(k,1013) = lu(k,1013) - lu(k,972) * lu(k,1005) + lu(k,1018) = - lu(k,970) * lu(k,1014) + lu(k,1020) = lu(k,1020) - lu(k,971) * lu(k,1014) + lu(k,1022) = lu(k,1022) - lu(k,972) * lu(k,1014) + lu(k,1220) = - lu(k,970) * lu(k,1216) + lu(k,1224) = lu(k,1224) - lu(k,971) * lu(k,1216) + lu(k,1226) = lu(k,1226) - lu(k,972) * lu(k,1216) + lu(k,1688) = lu(k,1688) - lu(k,970) * lu(k,1686) + lu(k,1694) = lu(k,1694) - lu(k,971) * lu(k,1686) + lu(k,1696) = lu(k,1696) - lu(k,972) * lu(k,1686) + lu(k,1701) = - lu(k,970) * lu(k,1698) + lu(k,1707) = lu(k,1707) - lu(k,971) * lu(k,1698) + lu(k,1709) = lu(k,1709) - lu(k,972) * lu(k,1698) + lu(k,2317) = - lu(k,970) * lu(k,2316) + lu(k,2329) = lu(k,2329) - lu(k,971) * lu(k,2316) + lu(k,2332) = lu(k,2332) - lu(k,972) * lu(k,2316) + lu(k,2432) = lu(k,2432) - lu(k,970) * lu(k,2428) + lu(k,2454) = lu(k,2454) - lu(k,971) * lu(k,2428) + lu(k,2458) = lu(k,2458) - lu(k,972) * lu(k,2428) + lu(k,2624) = - lu(k,970) * lu(k,2620) + lu(k,2640) = lu(k,2640) - lu(k,971) * lu(k,2620) + lu(k,2645) = lu(k,2645) - lu(k,972) * lu(k,2620) + lu(k,3050) = lu(k,3050) - lu(k,970) * lu(k,3014) + lu(k,3110) = lu(k,3110) - lu(k,971) * lu(k,3014) + lu(k,3119) = lu(k,3119) - lu(k,972) * lu(k,3014) + lu(k,3307) = lu(k,3307) - lu(k,970) * lu(k,3269) + lu(k,3369) = lu(k,3369) - lu(k,971) * lu(k,3269) + lu(k,3378) = lu(k,3378) - lu(k,972) * lu(k,3269) + lu(k,4030) = lu(k,4030) - lu(k,970) * lu(k,3979) + lu(k,4092) = lu(k,4092) - lu(k,971) * lu(k,3979) + lu(k,4101) = lu(k,4101) - lu(k,972) * lu(k,3979) + lu(k,974) = 1._r8 / lu(k,974) + lu(k,975) = lu(k,975) * lu(k,974) + lu(k,976) = lu(k,976) * lu(k,974) + lu(k,977) = lu(k,977) * lu(k,974) + lu(k,978) = lu(k,978) * lu(k,974) + lu(k,979) = lu(k,979) * lu(k,974) + lu(k,980) = lu(k,980) * lu(k,974) + lu(k,981) = lu(k,981) * lu(k,974) + lu(k,982) = lu(k,982) * lu(k,974) + lu(k,983) = lu(k,983) * lu(k,974) + lu(k,984) = lu(k,984) * lu(k,974) + lu(k,985) = lu(k,985) * lu(k,974) + lu(k,3037) = lu(k,3037) - lu(k,975) * lu(k,3015) + lu(k,3057) = lu(k,3057) - lu(k,976) * lu(k,3015) + lu(k,3061) = lu(k,3061) - lu(k,977) * lu(k,3015) + lu(k,3074) = lu(k,3074) - lu(k,978) * lu(k,3015) + lu(k,3083) = lu(k,3083) - lu(k,979) * lu(k,3015) + lu(k,3103) = lu(k,3103) - lu(k,980) * lu(k,3015) + lu(k,3105) = lu(k,3105) - lu(k,981) * lu(k,3015) + lu(k,3109) = lu(k,3109) - lu(k,982) * lu(k,3015) + lu(k,3110) = lu(k,3110) - lu(k,983) * lu(k,3015) + lu(k,3115) = lu(k,3115) - lu(k,984) * lu(k,3015) + lu(k,3119) = lu(k,3119) - lu(k,985) * lu(k,3015) + lu(k,3544) = lu(k,3544) - lu(k,975) * lu(k,3530) + lu(k,3555) = - lu(k,976) * lu(k,3530) + lu(k,3559) = lu(k,3559) - lu(k,977) * lu(k,3530) + lu(k,3570) = lu(k,3570) - lu(k,978) * lu(k,3530) + lu(k,3579) = lu(k,3579) - lu(k,979) * lu(k,3530) + lu(k,3599) = lu(k,3599) - lu(k,980) * lu(k,3530) + lu(k,3601) = lu(k,3601) - lu(k,981) * lu(k,3530) + lu(k,3605) = lu(k,3605) - lu(k,982) * lu(k,3530) + lu(k,3606) = lu(k,3606) - lu(k,983) * lu(k,3530) + lu(k,3611) = lu(k,3611) - lu(k,984) * lu(k,3530) + lu(k,3615) = lu(k,3615) - lu(k,985) * lu(k,3530) + lu(k,4016) = lu(k,4016) - lu(k,975) * lu(k,3980) + lu(k,4040) = lu(k,4040) - lu(k,976) * lu(k,3980) + lu(k,4044) = lu(k,4044) - lu(k,977) * lu(k,3980) + lu(k,4057) = lu(k,4057) - lu(k,978) * lu(k,3980) + lu(k,4065) = lu(k,4065) - lu(k,979) * lu(k,3980) + lu(k,4085) = lu(k,4085) - lu(k,980) * lu(k,3980) + lu(k,4087) = lu(k,4087) - lu(k,981) * lu(k,3980) + lu(k,4091) = lu(k,4091) - lu(k,982) * lu(k,3980) + lu(k,4092) = lu(k,4092) - lu(k,983) * lu(k,3980) + lu(k,4097) = lu(k,4097) - lu(k,984) * lu(k,3980) + lu(k,4101) = lu(k,4101) - lu(k,985) * lu(k,3980) + end do + end subroutine lu_fac21 + subroutine lu_fac22( 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,986) = 1._r8 / lu(k,986) + lu(k,987) = lu(k,987) * lu(k,986) + lu(k,988) = lu(k,988) * lu(k,986) + lu(k,989) = lu(k,989) * lu(k,986) + lu(k,990) = lu(k,990) * lu(k,986) + lu(k,991) = lu(k,991) * lu(k,986) + lu(k,992) = lu(k,992) * lu(k,986) + lu(k,993) = lu(k,993) * lu(k,986) + lu(k,1220) = lu(k,1220) - lu(k,987) * lu(k,1217) + lu(k,1221) = - lu(k,988) * lu(k,1217) + lu(k,1222) = - lu(k,989) * lu(k,1217) + lu(k,1224) = lu(k,1224) - lu(k,990) * lu(k,1217) + lu(k,1225) = lu(k,1225) - lu(k,991) * lu(k,1217) + lu(k,1226) = lu(k,1226) - lu(k,992) * lu(k,1217) + lu(k,1227) = - lu(k,993) * lu(k,1217) + lu(k,2531) = lu(k,2531) - lu(k,987) * lu(k,2525) + lu(k,2535) = - lu(k,988) * lu(k,2525) + lu(k,2536) = lu(k,2536) - lu(k,989) * lu(k,2525) + lu(k,2548) = lu(k,2548) - lu(k,990) * lu(k,2525) + lu(k,2551) = lu(k,2551) - lu(k,991) * lu(k,2525) + lu(k,2552) = lu(k,2552) - lu(k,992) * lu(k,2525) + lu(k,2553) = - lu(k,993) * lu(k,2525) + lu(k,3050) = lu(k,3050) - lu(k,987) * lu(k,3016) + lu(k,3087) = lu(k,3087) - lu(k,988) * lu(k,3016) + lu(k,3093) = lu(k,3093) - lu(k,989) * lu(k,3016) + lu(k,3110) = lu(k,3110) - lu(k,990) * lu(k,3016) + lu(k,3115) = lu(k,3115) - lu(k,991) * lu(k,3016) + lu(k,3119) = lu(k,3119) - lu(k,992) * lu(k,3016) + lu(k,3120) = lu(k,3120) - lu(k,993) * lu(k,3016) + lu(k,3307) = lu(k,3307) - lu(k,987) * lu(k,3270) + lu(k,3346) = lu(k,3346) - lu(k,988) * lu(k,3270) + lu(k,3352) = lu(k,3352) - lu(k,989) * lu(k,3270) + lu(k,3369) = lu(k,3369) - lu(k,990) * lu(k,3270) + lu(k,3374) = lu(k,3374) - lu(k,991) * lu(k,3270) + lu(k,3378) = lu(k,3378) - lu(k,992) * lu(k,3270) + lu(k,3379) = lu(k,3379) - lu(k,993) * lu(k,3270) + lu(k,4030) = lu(k,4030) - lu(k,987) * lu(k,3981) + lu(k,4069) = lu(k,4069) - lu(k,988) * lu(k,3981) + lu(k,4075) = lu(k,4075) - lu(k,989) * lu(k,3981) + lu(k,4092) = lu(k,4092) - lu(k,990) * lu(k,3981) + lu(k,4097) = lu(k,4097) - lu(k,991) * lu(k,3981) + lu(k,4101) = lu(k,4101) - lu(k,992) * lu(k,3981) + lu(k,4102) = lu(k,4102) - lu(k,993) * lu(k,3981) + lu(k,995) = 1._r8 / lu(k,995) + lu(k,996) = lu(k,996) * lu(k,995) + lu(k,997) = lu(k,997) * lu(k,995) + lu(k,998) = lu(k,998) * lu(k,995) + lu(k,999) = lu(k,999) * lu(k,995) + lu(k,1000) = lu(k,1000) * lu(k,995) + lu(k,1001) = lu(k,1001) * lu(k,995) + lu(k,1002) = lu(k,1002) * lu(k,995) + lu(k,3126) = lu(k,3126) - lu(k,996) * lu(k,3123) + lu(k,3129) = lu(k,3129) - lu(k,997) * lu(k,3123) + lu(k,3130) = lu(k,3130) - lu(k,998) * lu(k,3123) + lu(k,3134) = - lu(k,999) * lu(k,3123) + lu(k,3140) = lu(k,3140) - lu(k,1000) * lu(k,3123) + lu(k,3141) = lu(k,3141) - lu(k,1001) * lu(k,3123) + lu(k,3142) = lu(k,3142) - lu(k,1002) * lu(k,3123) + lu(k,3155) = lu(k,3155) - lu(k,996) * lu(k,3146) + lu(k,3160) = lu(k,3160) - lu(k,997) * lu(k,3146) + lu(k,3161) = lu(k,3161) - lu(k,998) * lu(k,3146) + lu(k,3165) = lu(k,3165) - lu(k,999) * lu(k,3146) + lu(k,3171) = lu(k,3171) - lu(k,1000) * lu(k,3146) + lu(k,3172) = lu(k,3172) - lu(k,1001) * lu(k,3146) + lu(k,3173) = - lu(k,1002) * lu(k,3146) + lu(k,3338) = lu(k,3338) - lu(k,996) * lu(k,3271) + lu(k,3366) = lu(k,3366) - lu(k,997) * lu(k,3271) + lu(k,3367) = lu(k,3367) - lu(k,998) * lu(k,3271) + lu(k,3371) = lu(k,3371) - lu(k,999) * lu(k,3271) + lu(k,3377) = lu(k,3377) - lu(k,1000) * lu(k,3271) + lu(k,3378) = lu(k,3378) - lu(k,1001) * lu(k,3271) + lu(k,3379) = lu(k,3379) - lu(k,1002) * lu(k,3271) + lu(k,3479) = lu(k,3479) - lu(k,996) * lu(k,3476) + lu(k,3483) = - lu(k,997) * lu(k,3476) + lu(k,3484) = lu(k,3484) - lu(k,998) * lu(k,3476) + lu(k,3488) = lu(k,3488) - lu(k,999) * lu(k,3476) + lu(k,3494) = lu(k,3494) - lu(k,1000) * lu(k,3476) + lu(k,3495) = lu(k,3495) - lu(k,1001) * lu(k,3476) + lu(k,3496) = - lu(k,1002) * lu(k,3476) + lu(k,3645) = lu(k,3645) - lu(k,996) * lu(k,3634) + lu(k,3655) = - lu(k,997) * lu(k,3634) + lu(k,3656) = lu(k,3656) - lu(k,998) * lu(k,3634) + lu(k,3660) = lu(k,3660) - lu(k,999) * lu(k,3634) + lu(k,3666) = - lu(k,1000) * lu(k,3634) + lu(k,3667) = lu(k,3667) - lu(k,1001) * lu(k,3634) + lu(k,3668) = lu(k,3668) - lu(k,1002) * lu(k,3634) + lu(k,1006) = 1._r8 / lu(k,1006) + lu(k,1007) = lu(k,1007) * lu(k,1006) + lu(k,1008) = lu(k,1008) * lu(k,1006) + lu(k,1009) = lu(k,1009) * lu(k,1006) + lu(k,1010) = lu(k,1010) * lu(k,1006) + lu(k,1011) = lu(k,1011) * lu(k,1006) + lu(k,1012) = lu(k,1012) * lu(k,1006) + lu(k,1013) = lu(k,1013) * lu(k,1006) + lu(k,2403) = - lu(k,1007) * lu(k,2401) + lu(k,2406) = - lu(k,1008) * lu(k,2401) + lu(k,2407) = - lu(k,1009) * lu(k,2401) + lu(k,2419) = lu(k,2419) - lu(k,1010) * lu(k,2401) + lu(k,2422) = lu(k,2422) - lu(k,1011) * lu(k,2401) + lu(k,2425) = lu(k,2425) - lu(k,1012) * lu(k,2401) + lu(k,2426) = lu(k,2426) - lu(k,1013) * lu(k,2401) + lu(k,2463) = - lu(k,1007) * lu(k,2461) + lu(k,2469) = - lu(k,1008) * lu(k,2461) + lu(k,2470) = - lu(k,1009) * lu(k,2461) + lu(k,2482) = lu(k,2482) - lu(k,1010) * lu(k,2461) + lu(k,2485) = lu(k,2485) - lu(k,1011) * lu(k,2461) + lu(k,2488) = lu(k,2488) - lu(k,1012) * lu(k,2461) + lu(k,2489) = lu(k,2489) - lu(k,1013) * lu(k,2461) + lu(k,3050) = lu(k,3050) - lu(k,1007) * lu(k,3017) + lu(k,3085) = lu(k,3085) - lu(k,1008) * lu(k,3017) + lu(k,3087) = lu(k,3087) - lu(k,1009) * lu(k,3017) + lu(k,3106) = lu(k,3106) - lu(k,1010) * lu(k,3017) + lu(k,3110) = lu(k,3110) - lu(k,1011) * lu(k,3017) + lu(k,3115) = lu(k,3115) - lu(k,1012) * lu(k,3017) + lu(k,3119) = lu(k,3119) - lu(k,1013) * lu(k,3017) + lu(k,3307) = lu(k,3307) - lu(k,1007) * lu(k,3272) + lu(k,3344) = lu(k,3344) - lu(k,1008) * lu(k,3272) + lu(k,3346) = lu(k,3346) - lu(k,1009) * lu(k,3272) + lu(k,3365) = lu(k,3365) - lu(k,1010) * lu(k,3272) + lu(k,3369) = lu(k,3369) - lu(k,1011) * lu(k,3272) + lu(k,3374) = lu(k,3374) - lu(k,1012) * lu(k,3272) + lu(k,3378) = lu(k,3378) - lu(k,1013) * lu(k,3272) + lu(k,4030) = lu(k,4030) - lu(k,1007) * lu(k,3982) + lu(k,4067) = lu(k,4067) - lu(k,1008) * lu(k,3982) + lu(k,4069) = lu(k,4069) - lu(k,1009) * lu(k,3982) + lu(k,4088) = lu(k,4088) - lu(k,1010) * lu(k,3982) + lu(k,4092) = lu(k,4092) - lu(k,1011) * lu(k,3982) + lu(k,4097) = lu(k,4097) - lu(k,1012) * lu(k,3982) + lu(k,4101) = lu(k,4101) - lu(k,1013) * lu(k,3982) + lu(k,1015) = 1._r8 / lu(k,1015) + lu(k,1016) = lu(k,1016) * lu(k,1015) + lu(k,1017) = lu(k,1017) * lu(k,1015) + lu(k,1018) = lu(k,1018) * lu(k,1015) + lu(k,1019) = lu(k,1019) * lu(k,1015) + lu(k,1020) = lu(k,1020) * lu(k,1015) + lu(k,1021) = lu(k,1021) * lu(k,1015) + lu(k,1022) = lu(k,1022) * lu(k,1015) + lu(k,2494) = - lu(k,1016) * lu(k,2493) + lu(k,2496) = lu(k,2496) - lu(k,1017) * lu(k,2493) + lu(k,2499) = - lu(k,1018) * lu(k,2493) + lu(k,2516) = lu(k,2516) - lu(k,1019) * lu(k,2493) + lu(k,2519) = lu(k,2519) - lu(k,1020) * lu(k,2493) + lu(k,2522) = lu(k,2522) - lu(k,1021) * lu(k,2493) + lu(k,2523) = lu(k,2523) - lu(k,1022) * lu(k,2493) + lu(k,2557) = - lu(k,1016) * lu(k,2556) + lu(k,2559) = lu(k,2559) - lu(k,1017) * lu(k,2556) + lu(k,2562) = - lu(k,1018) * lu(k,2556) + lu(k,2581) = lu(k,2581) - lu(k,1019) * lu(k,2556) + lu(k,2584) = lu(k,2584) - lu(k,1020) * lu(k,2556) + lu(k,2587) = lu(k,2587) - lu(k,1021) * lu(k,2556) + lu(k,2588) = lu(k,2588) - lu(k,1022) * lu(k,2556) + lu(k,3025) = lu(k,3025) - lu(k,1016) * lu(k,3018) + lu(k,3030) = lu(k,3030) - lu(k,1017) * lu(k,3018) + lu(k,3050) = lu(k,3050) - lu(k,1018) * lu(k,3018) + lu(k,3106) = lu(k,3106) - lu(k,1019) * lu(k,3018) + lu(k,3110) = lu(k,3110) - lu(k,1020) * lu(k,3018) + lu(k,3115) = lu(k,3115) - lu(k,1021) * lu(k,3018) + lu(k,3119) = lu(k,3119) - lu(k,1022) * lu(k,3018) + lu(k,3279) = lu(k,3279) - lu(k,1016) * lu(k,3273) + lu(k,3287) = lu(k,3287) - lu(k,1017) * lu(k,3273) + lu(k,3307) = lu(k,3307) - lu(k,1018) * lu(k,3273) + lu(k,3365) = lu(k,3365) - lu(k,1019) * lu(k,3273) + lu(k,3369) = lu(k,3369) - lu(k,1020) * lu(k,3273) + lu(k,3374) = lu(k,3374) - lu(k,1021) * lu(k,3273) + lu(k,3378) = lu(k,3378) - lu(k,1022) * lu(k,3273) + lu(k,3993) = lu(k,3993) - lu(k,1016) * lu(k,3983) + lu(k,4001) = lu(k,4001) - lu(k,1017) * lu(k,3983) + lu(k,4030) = lu(k,4030) - lu(k,1018) * lu(k,3983) + lu(k,4088) = lu(k,4088) - lu(k,1019) * lu(k,3983) + lu(k,4092) = lu(k,4092) - lu(k,1020) * lu(k,3983) + lu(k,4097) = lu(k,4097) - lu(k,1021) * lu(k,3983) + lu(k,4101) = lu(k,4101) - lu(k,1022) * lu(k,3983) + end do + end subroutine lu_fac22 + subroutine lu_fac23( 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,1024) = 1._r8 / lu(k,1024) + lu(k,1025) = lu(k,1025) * lu(k,1024) + lu(k,1026) = lu(k,1026) * lu(k,1024) + lu(k,1027) = lu(k,1027) * lu(k,1024) + lu(k,1028) = lu(k,1028) * lu(k,1024) + lu(k,1029) = lu(k,1029) * lu(k,1024) + lu(k,1030) = lu(k,1030) * lu(k,1024) + lu(k,1031) = lu(k,1031) * lu(k,1024) + lu(k,1032) = lu(k,1032) * lu(k,1024) + lu(k,1033) = lu(k,1033) * lu(k,1024) + lu(k,3037) = lu(k,3037) - lu(k,1025) * lu(k,3019) + lu(k,3083) = lu(k,3083) - lu(k,1026) * lu(k,3019) + lu(k,3106) = lu(k,3106) - lu(k,1027) * lu(k,3019) + lu(k,3109) = lu(k,3109) - lu(k,1028) * lu(k,3019) + lu(k,3110) = lu(k,3110) - lu(k,1029) * lu(k,3019) + lu(k,3111) = lu(k,3111) - lu(k,1030) * lu(k,3019) + lu(k,3115) = lu(k,3115) - lu(k,1031) * lu(k,3019) + lu(k,3119) = lu(k,3119) - lu(k,1032) * lu(k,3019) + lu(k,3120) = lu(k,3120) - lu(k,1033) * lu(k,3019) + lu(k,3294) = lu(k,3294) - lu(k,1025) * lu(k,3274) + lu(k,3342) = lu(k,3342) - lu(k,1026) * lu(k,3274) + lu(k,3365) = lu(k,3365) - lu(k,1027) * lu(k,3274) + lu(k,3368) = lu(k,3368) - lu(k,1028) * lu(k,3274) + lu(k,3369) = lu(k,3369) - lu(k,1029) * lu(k,3274) + lu(k,3370) = lu(k,3370) - lu(k,1030) * lu(k,3274) + lu(k,3374) = lu(k,3374) - lu(k,1031) * lu(k,3274) + lu(k,3378) = lu(k,3378) - lu(k,1032) * lu(k,3274) + lu(k,3379) = lu(k,3379) - lu(k,1033) * lu(k,3274) + lu(k,3392) = lu(k,3392) - lu(k,1025) * lu(k,3386) + lu(k,3435) = lu(k,3435) - lu(k,1026) * lu(k,3386) + lu(k,3458) = lu(k,3458) - lu(k,1027) * lu(k,3386) + lu(k,3461) = lu(k,3461) - lu(k,1028) * lu(k,3386) + lu(k,3462) = lu(k,3462) - lu(k,1029) * lu(k,3386) + lu(k,3463) = lu(k,3463) - lu(k,1030) * lu(k,3386) + lu(k,3467) = lu(k,3467) - lu(k,1031) * lu(k,3386) + lu(k,3471) = lu(k,3471) - lu(k,1032) * lu(k,3386) + lu(k,3472) = lu(k,3472) - lu(k,1033) * lu(k,3386) + lu(k,4016) = lu(k,4016) - lu(k,1025) * lu(k,3984) + lu(k,4065) = lu(k,4065) - lu(k,1026) * lu(k,3984) + lu(k,4088) = lu(k,4088) - lu(k,1027) * lu(k,3984) + lu(k,4091) = lu(k,4091) - lu(k,1028) * lu(k,3984) + lu(k,4092) = lu(k,4092) - lu(k,1029) * lu(k,3984) + lu(k,4093) = lu(k,4093) - lu(k,1030) * lu(k,3984) + lu(k,4097) = lu(k,4097) - lu(k,1031) * lu(k,3984) + lu(k,4101) = lu(k,4101) - lu(k,1032) * lu(k,3984) + lu(k,4102) = lu(k,4102) - lu(k,1033) * lu(k,3984) + lu(k,1041) = 1._r8 / lu(k,1041) + lu(k,1042) = lu(k,1042) * lu(k,1041) + lu(k,1043) = lu(k,1043) * lu(k,1041) + lu(k,1044) = lu(k,1044) * lu(k,1041) + lu(k,1045) = lu(k,1045) * lu(k,1041) + lu(k,1046) = lu(k,1046) * lu(k,1041) + lu(k,1047) = lu(k,1047) * lu(k,1041) + lu(k,1048) = lu(k,1048) * lu(k,1041) + lu(k,1049) = lu(k,1049) * lu(k,1041) + lu(k,1050) = lu(k,1050) * lu(k,1041) + lu(k,1051) = lu(k,1051) * lu(k,1041) + lu(k,1052) = lu(k,1052) * lu(k,1041) + lu(k,1053) = lu(k,1053) * lu(k,1041) + lu(k,3546) = - lu(k,1042) * lu(k,3531) + lu(k,3551) = lu(k,3551) - lu(k,1043) * lu(k,3531) + lu(k,3576) = lu(k,3576) - lu(k,1044) * lu(k,3531) + lu(k,3585) = lu(k,3585) - lu(k,1045) * lu(k,3531) + lu(k,3591) = lu(k,3591) - lu(k,1046) * lu(k,3531) + lu(k,3593) = lu(k,3593) - lu(k,1047) * lu(k,3531) + lu(k,3598) = lu(k,3598) - lu(k,1048) * lu(k,3531) + lu(k,3605) = lu(k,3605) - lu(k,1049) * lu(k,3531) + lu(k,3606) = lu(k,3606) - lu(k,1050) * lu(k,3531) + lu(k,3610) = lu(k,3610) - lu(k,1051) * lu(k,3531) + lu(k,3612) = lu(k,3612) - lu(k,1052) * lu(k,3531) + lu(k,3615) = lu(k,3615) - lu(k,1053) * lu(k,3531) + lu(k,3702) = lu(k,3702) - lu(k,1042) * lu(k,3685) + lu(k,3706) = lu(k,3706) - lu(k,1043) * lu(k,3685) + lu(k,3732) = - lu(k,1044) * lu(k,3685) + lu(k,3739) = - lu(k,1045) * lu(k,3685) + lu(k,3745) = lu(k,3745) - lu(k,1046) * lu(k,3685) + lu(k,3747) = lu(k,3747) - lu(k,1047) * lu(k,3685) + lu(k,3752) = lu(k,3752) - lu(k,1048) * lu(k,3685) + lu(k,3759) = lu(k,3759) - lu(k,1049) * lu(k,3685) + lu(k,3760) = lu(k,3760) - lu(k,1050) * lu(k,3685) + lu(k,3764) = lu(k,3764) - lu(k,1051) * lu(k,3685) + lu(k,3766) = lu(k,3766) - lu(k,1052) * lu(k,3685) + lu(k,3769) = lu(k,3769) - lu(k,1053) * lu(k,3685) + lu(k,4023) = lu(k,4023) - lu(k,1042) * lu(k,3985) + lu(k,4033) = lu(k,4033) - lu(k,1043) * lu(k,3985) + lu(k,4063) = - lu(k,1044) * lu(k,3985) + lu(k,4071) = lu(k,4071) - lu(k,1045) * lu(k,3985) + lu(k,4077) = lu(k,4077) - lu(k,1046) * lu(k,3985) + lu(k,4079) = lu(k,4079) - lu(k,1047) * lu(k,3985) + lu(k,4084) = lu(k,4084) - lu(k,1048) * lu(k,3985) + lu(k,4091) = lu(k,4091) - lu(k,1049) * lu(k,3985) + lu(k,4092) = lu(k,4092) - lu(k,1050) * lu(k,3985) + lu(k,4096) = lu(k,4096) - lu(k,1051) * lu(k,3985) + lu(k,4098) = lu(k,4098) - lu(k,1052) * lu(k,3985) + lu(k,4101) = lu(k,4101) - lu(k,1053) * lu(k,3985) + lu(k,1054) = 1._r8 / lu(k,1054) + lu(k,1055) = lu(k,1055) * lu(k,1054) + lu(k,1056) = lu(k,1056) * lu(k,1054) + lu(k,1057) = lu(k,1057) * lu(k,1054) + lu(k,1058) = lu(k,1058) * lu(k,1054) + lu(k,1059) = lu(k,1059) * lu(k,1054) + lu(k,1060) = lu(k,1060) * lu(k,1054) + lu(k,1061) = lu(k,1061) * lu(k,1054) + lu(k,1062) = lu(k,1062) * lu(k,1054) + lu(k,1063) = lu(k,1063) * lu(k,1054) + lu(k,1975) = - lu(k,1055) * lu(k,1974) + lu(k,1979) = - lu(k,1056) * lu(k,1974) + lu(k,1984) = - lu(k,1057) * lu(k,1974) + lu(k,1988) = - lu(k,1058) * lu(k,1974) + lu(k,2000) = lu(k,2000) - lu(k,1059) * lu(k,1974) + lu(k,2002) = lu(k,2002) - lu(k,1060) * lu(k,1974) + lu(k,2003) = lu(k,2003) - lu(k,1061) * lu(k,1974) + lu(k,2006) = lu(k,2006) - lu(k,1062) * lu(k,1974) + lu(k,2007) = lu(k,2007) - lu(k,1063) * lu(k,1974) + lu(k,3041) = - lu(k,1055) * lu(k,3020) + lu(k,3054) = lu(k,3054) - lu(k,1056) * lu(k,3020) + lu(k,3063) = lu(k,3063) - lu(k,1057) * lu(k,3020) + lu(k,3068) = lu(k,3068) - lu(k,1058) * lu(k,3020) + lu(k,3106) = lu(k,3106) - lu(k,1059) * lu(k,3020) + lu(k,3109) = lu(k,3109) - lu(k,1060) * lu(k,3020) + lu(k,3110) = lu(k,3110) - lu(k,1061) * lu(k,3020) + lu(k,3115) = lu(k,3115) - lu(k,1062) * lu(k,3020) + lu(k,3119) = lu(k,3119) - lu(k,1063) * lu(k,3020) + lu(k,3298) = lu(k,3298) - lu(k,1055) * lu(k,3275) + lu(k,3312) = - lu(k,1056) * lu(k,3275) + lu(k,3322) = - lu(k,1057) * lu(k,3275) + lu(k,3327) = lu(k,3327) - lu(k,1058) * lu(k,3275) + lu(k,3365) = lu(k,3365) - lu(k,1059) * lu(k,3275) + lu(k,3368) = lu(k,3368) - lu(k,1060) * lu(k,3275) + lu(k,3369) = lu(k,3369) - lu(k,1061) * lu(k,3275) + lu(k,3374) = lu(k,3374) - lu(k,1062) * lu(k,3275) + lu(k,3378) = lu(k,3378) - lu(k,1063) * lu(k,3275) + lu(k,4020) = lu(k,4020) - lu(k,1055) * lu(k,3986) + lu(k,4036) = lu(k,4036) - lu(k,1056) * lu(k,3986) + lu(k,4046) = lu(k,4046) - lu(k,1057) * lu(k,3986) + lu(k,4051) = lu(k,4051) - lu(k,1058) * lu(k,3986) + lu(k,4088) = lu(k,4088) - lu(k,1059) * lu(k,3986) + lu(k,4091) = lu(k,4091) - lu(k,1060) * lu(k,3986) + lu(k,4092) = lu(k,4092) - lu(k,1061) * lu(k,3986) + lu(k,4097) = lu(k,4097) - lu(k,1062) * lu(k,3986) + lu(k,4101) = lu(k,4101) - lu(k,1063) * lu(k,3986) + lu(k,1071) = 1._r8 / lu(k,1071) + lu(k,1072) = lu(k,1072) * lu(k,1071) + lu(k,1073) = lu(k,1073) * lu(k,1071) + lu(k,1074) = lu(k,1074) * lu(k,1071) + lu(k,1075) = lu(k,1075) * lu(k,1071) + lu(k,1076) = lu(k,1076) * lu(k,1071) + lu(k,1077) = lu(k,1077) * lu(k,1071) + lu(k,1078) = lu(k,1078) * lu(k,1071) + lu(k,1079) = lu(k,1079) * lu(k,1071) + lu(k,1080) = lu(k,1080) * lu(k,1071) + lu(k,1081) = lu(k,1081) * lu(k,1071) + lu(k,1082) = lu(k,1082) * lu(k,1071) + lu(k,1083) = lu(k,1083) * lu(k,1071) + lu(k,1084) = lu(k,1084) * lu(k,1071) + lu(k,3546) = lu(k,3546) - lu(k,1072) * lu(k,3532) + lu(k,3551) = lu(k,3551) - lu(k,1073) * lu(k,3532) + lu(k,3582) = lu(k,3582) - lu(k,1074) * lu(k,3532) + lu(k,3588) = lu(k,3588) - lu(k,1075) * lu(k,3532) + lu(k,3592) = lu(k,3592) - lu(k,1076) * lu(k,3532) + lu(k,3593) = lu(k,3593) - lu(k,1077) * lu(k,3532) + lu(k,3597) = lu(k,3597) - lu(k,1078) * lu(k,3532) + lu(k,3598) = lu(k,3598) - lu(k,1079) * lu(k,3532) + lu(k,3599) = lu(k,3599) - lu(k,1080) * lu(k,3532) + lu(k,3605) = lu(k,3605) - lu(k,1081) * lu(k,3532) + lu(k,3610) = lu(k,3610) - lu(k,1082) * lu(k,3532) + lu(k,3612) = lu(k,3612) - lu(k,1083) * lu(k,3532) + lu(k,3615) = lu(k,3615) - lu(k,1084) * lu(k,3532) + lu(k,3702) = lu(k,3702) - lu(k,1072) * lu(k,3686) + lu(k,3706) = lu(k,3706) - lu(k,1073) * lu(k,3686) + lu(k,3736) = - lu(k,1074) * lu(k,3686) + lu(k,3742) = - lu(k,1075) * lu(k,3686) + lu(k,3746) = lu(k,3746) - lu(k,1076) * lu(k,3686) + lu(k,3747) = lu(k,3747) - lu(k,1077) * lu(k,3686) + lu(k,3751) = lu(k,3751) - lu(k,1078) * lu(k,3686) + lu(k,3752) = lu(k,3752) - lu(k,1079) * lu(k,3686) + lu(k,3753) = lu(k,3753) - lu(k,1080) * lu(k,3686) + lu(k,3759) = lu(k,3759) - lu(k,1081) * lu(k,3686) + lu(k,3764) = lu(k,3764) - lu(k,1082) * lu(k,3686) + lu(k,3766) = lu(k,3766) - lu(k,1083) * lu(k,3686) + lu(k,3769) = lu(k,3769) - lu(k,1084) * lu(k,3686) + lu(k,4023) = lu(k,4023) - lu(k,1072) * lu(k,3987) + lu(k,4033) = lu(k,4033) - lu(k,1073) * lu(k,3987) + lu(k,4068) = lu(k,4068) - lu(k,1074) * lu(k,3987) + lu(k,4074) = - lu(k,1075) * lu(k,3987) + lu(k,4078) = lu(k,4078) - lu(k,1076) * lu(k,3987) + lu(k,4079) = lu(k,4079) - lu(k,1077) * lu(k,3987) + lu(k,4083) = lu(k,4083) - lu(k,1078) * lu(k,3987) + lu(k,4084) = lu(k,4084) - lu(k,1079) * lu(k,3987) + lu(k,4085) = lu(k,4085) - lu(k,1080) * lu(k,3987) + lu(k,4091) = lu(k,4091) - lu(k,1081) * lu(k,3987) + lu(k,4096) = lu(k,4096) - lu(k,1082) * lu(k,3987) + lu(k,4098) = lu(k,4098) - lu(k,1083) * lu(k,3987) + lu(k,4101) = lu(k,4101) - lu(k,1084) * lu(k,3987) + end do + end subroutine lu_fac23 + subroutine lu_fac24( 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,1092) = 1._r8 / lu(k,1092) + lu(k,1093) = lu(k,1093) * lu(k,1092) + lu(k,1094) = lu(k,1094) * lu(k,1092) + lu(k,1095) = lu(k,1095) * lu(k,1092) + lu(k,1096) = lu(k,1096) * lu(k,1092) + lu(k,1097) = lu(k,1097) * lu(k,1092) + lu(k,1098) = lu(k,1098) * lu(k,1092) + lu(k,1099) = lu(k,1099) * lu(k,1092) + lu(k,1100) = lu(k,1100) * lu(k,1092) + lu(k,1101) = lu(k,1101) * lu(k,1092) + lu(k,1102) = lu(k,1102) * lu(k,1092) + lu(k,1103) = lu(k,1103) * lu(k,1092) + lu(k,1104) = lu(k,1104) * lu(k,1092) + lu(k,1105) = lu(k,1105) * lu(k,1092) + lu(k,3534) = lu(k,3534) - lu(k,1093) * lu(k,3533) + lu(k,3535) = - lu(k,1094) * lu(k,3533) + lu(k,3536) = - lu(k,1095) * lu(k,3533) + lu(k,3541) = - lu(k,1096) * lu(k,3533) + lu(k,3546) = lu(k,3546) - lu(k,1097) * lu(k,3533) + lu(k,3551) = lu(k,3551) - lu(k,1098) * lu(k,3533) + lu(k,3584) = lu(k,3584) - lu(k,1099) * lu(k,3533) + lu(k,3589) = lu(k,3589) - lu(k,1100) * lu(k,3533) + lu(k,3596) = lu(k,3596) - lu(k,1101) * lu(k,3533) + lu(k,3605) = lu(k,3605) - lu(k,1102) * lu(k,3533) + lu(k,3610) = lu(k,3610) - lu(k,1103) * lu(k,3533) + lu(k,3612) = lu(k,3612) - lu(k,1104) * lu(k,3533) + lu(k,3615) = lu(k,3615) - lu(k,1105) * lu(k,3533) + lu(k,3688) = lu(k,3688) - lu(k,1093) * lu(k,3687) + lu(k,3689) = lu(k,3689) - lu(k,1094) * lu(k,3687) + lu(k,3690) = lu(k,3690) - lu(k,1095) * lu(k,3687) + lu(k,3695) = lu(k,3695) - lu(k,1096) * lu(k,3687) + lu(k,3702) = lu(k,3702) - lu(k,1097) * lu(k,3687) + lu(k,3706) = lu(k,3706) - lu(k,1098) * lu(k,3687) + lu(k,3738) = - lu(k,1099) * lu(k,3687) + lu(k,3743) = - lu(k,1100) * lu(k,3687) + lu(k,3750) = lu(k,3750) - lu(k,1101) * lu(k,3687) + lu(k,3759) = lu(k,3759) - lu(k,1102) * lu(k,3687) + lu(k,3764) = lu(k,3764) - lu(k,1103) * lu(k,3687) + lu(k,3766) = lu(k,3766) - lu(k,1104) * lu(k,3687) + lu(k,3769) = lu(k,3769) - lu(k,1105) * lu(k,3687) + lu(k,3989) = lu(k,3989) - lu(k,1093) * lu(k,3988) + lu(k,3997) = lu(k,3997) - lu(k,1094) * lu(k,3988) + lu(k,3999) = lu(k,3999) - lu(k,1095) * lu(k,3988) + lu(k,4013) = lu(k,4013) - lu(k,1096) * lu(k,3988) + lu(k,4023) = lu(k,4023) - lu(k,1097) * lu(k,3988) + lu(k,4033) = lu(k,4033) - lu(k,1098) * lu(k,3988) + lu(k,4070) = lu(k,4070) - lu(k,1099) * lu(k,3988) + lu(k,4075) = lu(k,4075) - lu(k,1100) * lu(k,3988) + lu(k,4082) = lu(k,4082) - lu(k,1101) * lu(k,3988) + lu(k,4091) = lu(k,4091) - lu(k,1102) * lu(k,3988) + lu(k,4096) = lu(k,4096) - lu(k,1103) * lu(k,3988) + lu(k,4098) = lu(k,4098) - lu(k,1104) * lu(k,3988) + lu(k,4101) = lu(k,4101) - lu(k,1105) * lu(k,3988) + lu(k,1106) = 1._r8 / lu(k,1106) + lu(k,1107) = lu(k,1107) * lu(k,1106) + lu(k,1108) = lu(k,1108) * lu(k,1106) + lu(k,1109) = lu(k,1109) * lu(k,1106) + lu(k,2382) = lu(k,2382) - lu(k,1107) * lu(k,2369) + lu(k,2385) = lu(k,2385) - lu(k,1108) * lu(k,2369) + lu(k,2397) = lu(k,2397) - lu(k,1109) * lu(k,2369) + lu(k,2443) = lu(k,2443) - lu(k,1107) * lu(k,2429) + lu(k,2446) = lu(k,2446) - lu(k,1108) * lu(k,2429) + lu(k,2458) = lu(k,2458) - lu(k,1109) * lu(k,2429) + lu(k,2537) = lu(k,2537) - lu(k,1107) * lu(k,2526) + lu(k,2540) = lu(k,2540) - lu(k,1108) * lu(k,2526) + lu(k,2552) = lu(k,2552) - lu(k,1109) * lu(k,2526) + lu(k,2742) = lu(k,2742) - lu(k,1107) * lu(k,2718) + lu(k,2745) = lu(k,2745) - lu(k,1108) * lu(k,2718) + lu(k,2760) = lu(k,2760) - lu(k,1109) * lu(k,2718) + lu(k,2788) = lu(k,2788) - lu(k,1107) * lu(k,2764) + lu(k,2791) = lu(k,2791) - lu(k,1108) * lu(k,2764) + lu(k,2806) = lu(k,2806) - lu(k,1109) * lu(k,2764) + lu(k,2835) = lu(k,2835) - lu(k,1107) * lu(k,2810) + lu(k,2838) = lu(k,2838) - lu(k,1108) * lu(k,2810) + lu(k,2853) = lu(k,2853) - lu(k,1109) * lu(k,2810) + lu(k,2907) = lu(k,2907) - lu(k,1107) * lu(k,2858) + lu(k,2910) = lu(k,2910) - lu(k,1108) * lu(k,2858) + lu(k,2927) = lu(k,2927) - lu(k,1109) * lu(k,2858) + lu(k,3097) = lu(k,3097) - lu(k,1107) * lu(k,3021) + lu(k,3100) = lu(k,3100) - lu(k,1108) * lu(k,3021) + lu(k,3119) = lu(k,3119) - lu(k,1109) * lu(k,3021) + lu(k,3356) = lu(k,3356) - lu(k,1107) * lu(k,3276) + lu(k,3359) = lu(k,3359) - lu(k,1108) * lu(k,3276) + lu(k,3378) = lu(k,3378) - lu(k,1109) * lu(k,3276) + lu(k,3449) = lu(k,3449) - lu(k,1107) * lu(k,3387) + lu(k,3452) = lu(k,3452) - lu(k,1108) * lu(k,3387) + lu(k,3471) = lu(k,3471) - lu(k,1109) * lu(k,3387) + lu(k,3593) = lu(k,3593) - lu(k,1107) * lu(k,3534) + lu(k,3596) = lu(k,3596) - lu(k,1108) * lu(k,3534) + lu(k,3615) = lu(k,3615) - lu(k,1109) * lu(k,3534) + lu(k,3747) = lu(k,3747) - lu(k,1107) * lu(k,3688) + lu(k,3750) = lu(k,3750) - lu(k,1108) * lu(k,3688) + lu(k,3769) = lu(k,3769) - lu(k,1109) * lu(k,3688) + lu(k,4079) = lu(k,4079) - lu(k,1107) * lu(k,3989) + lu(k,4082) = lu(k,4082) - lu(k,1108) * lu(k,3989) + lu(k,4101) = lu(k,4101) - lu(k,1109) * lu(k,3989) + lu(k,1110) = 1._r8 / lu(k,1110) + lu(k,1111) = lu(k,1111) * lu(k,1110) + lu(k,1112) = lu(k,1112) * lu(k,1110) + lu(k,1113) = lu(k,1113) * lu(k,1110) + lu(k,1114) = lu(k,1114) * lu(k,1110) + lu(k,1115) = lu(k,1115) * lu(k,1110) + lu(k,1116) = lu(k,1116) * lu(k,1110) + lu(k,1117) = lu(k,1117) * lu(k,1110) + lu(k,1118) = lu(k,1118) * lu(k,1110) + lu(k,1119) = lu(k,1119) * lu(k,1110) + lu(k,1120) = lu(k,1120) * lu(k,1110) + lu(k,1637) = lu(k,1637) - lu(k,1111) * lu(k,1634) + lu(k,1641) = - lu(k,1112) * lu(k,1634) + lu(k,1642) = - lu(k,1113) * lu(k,1634) + lu(k,1643) = lu(k,1643) - lu(k,1114) * lu(k,1634) + lu(k,1645) = lu(k,1645) - lu(k,1115) * lu(k,1634) + lu(k,1646) = lu(k,1646) - lu(k,1116) * lu(k,1634) + lu(k,1647) = lu(k,1647) - lu(k,1117) * lu(k,1634) + lu(k,1649) = - lu(k,1118) * lu(k,1634) + lu(k,1654) = lu(k,1654) - lu(k,1119) * lu(k,1634) + lu(k,1655) = lu(k,1655) - lu(k,1120) * lu(k,1634) + lu(k,1657) = - lu(k,1111) * lu(k,1656) + lu(k,1660) = lu(k,1660) - lu(k,1112) * lu(k,1656) + lu(k,1661) = lu(k,1661) - lu(k,1113) * lu(k,1656) + lu(k,1662) = - lu(k,1114) * lu(k,1656) + lu(k,1663) = - lu(k,1115) * lu(k,1656) + lu(k,1664) = - lu(k,1116) * lu(k,1656) + lu(k,1665) = - lu(k,1117) * lu(k,1656) + lu(k,1666) = lu(k,1666) - lu(k,1118) * lu(k,1656) + lu(k,1669) = lu(k,1669) - lu(k,1119) * lu(k,1656) + lu(k,1670) = lu(k,1670) - lu(k,1120) * lu(k,1656) + lu(k,3042) = lu(k,3042) - lu(k,1111) * lu(k,3022) + lu(k,3057) = lu(k,3057) - lu(k,1112) * lu(k,3022) + lu(k,3061) = lu(k,3061) - lu(k,1113) * lu(k,3022) + lu(k,3062) = lu(k,3062) - lu(k,1114) * lu(k,3022) + lu(k,3068) = lu(k,3068) - lu(k,1115) * lu(k,3022) + lu(k,3069) = lu(k,3069) - lu(k,1116) * lu(k,3022) + lu(k,3074) = lu(k,3074) - lu(k,1117) * lu(k,3022) + lu(k,3105) = lu(k,3105) - lu(k,1118) * lu(k,3022) + lu(k,3115) = lu(k,3115) - lu(k,1119) * lu(k,3022) + lu(k,3119) = lu(k,3119) - lu(k,1120) * lu(k,3022) + lu(k,4021) = lu(k,4021) - lu(k,1111) * lu(k,3990) + lu(k,4040) = lu(k,4040) - lu(k,1112) * lu(k,3990) + lu(k,4044) = lu(k,4044) - lu(k,1113) * lu(k,3990) + lu(k,4045) = lu(k,4045) - lu(k,1114) * lu(k,3990) + lu(k,4051) = lu(k,4051) - lu(k,1115) * lu(k,3990) + lu(k,4052) = lu(k,4052) - lu(k,1116) * lu(k,3990) + lu(k,4057) = lu(k,4057) - lu(k,1117) * lu(k,3990) + lu(k,4087) = lu(k,4087) - lu(k,1118) * lu(k,3990) + lu(k,4097) = lu(k,4097) - lu(k,1119) * lu(k,3990) + lu(k,4101) = lu(k,4101) - lu(k,1120) * lu(k,3990) + lu(k,1121) = 1._r8 / lu(k,1121) + lu(k,1122) = lu(k,1122) * lu(k,1121) + lu(k,1123) = lu(k,1123) * lu(k,1121) + lu(k,1124) = lu(k,1124) * lu(k,1121) + lu(k,1125) = lu(k,1125) * lu(k,1121) + lu(k,1126) = lu(k,1126) * lu(k,1121) + lu(k,1127) = lu(k,1127) * lu(k,1121) + lu(k,1128) = lu(k,1128) * lu(k,1121) + lu(k,1129) = lu(k,1129) * lu(k,1121) + lu(k,1130) = lu(k,1130) * lu(k,1121) + lu(k,1131) = lu(k,1131) * lu(k,1121) + lu(k,2063) = - lu(k,1122) * lu(k,2061) + lu(k,2065) = lu(k,2065) - lu(k,1123) * lu(k,2061) + lu(k,2069) = - lu(k,1124) * lu(k,2061) + lu(k,2070) = lu(k,2070) - lu(k,1125) * lu(k,2061) + lu(k,2072) = lu(k,2072) - lu(k,1126) * lu(k,2061) + lu(k,2082) = - lu(k,1127) * lu(k,2061) + lu(k,2085) = - lu(k,1128) * lu(k,2061) + lu(k,2086) = lu(k,2086) - lu(k,1129) * lu(k,2061) + lu(k,2088) = lu(k,2088) - lu(k,1130) * lu(k,2061) + lu(k,2091) = lu(k,2091) - lu(k,1131) * lu(k,2061) + lu(k,3041) = lu(k,3041) - lu(k,1122) * lu(k,3023) + lu(k,3043) = lu(k,3043) - lu(k,1123) * lu(k,3023) + lu(k,3054) = lu(k,3054) - lu(k,1124) * lu(k,3023) + lu(k,3057) = lu(k,3057) - lu(k,1125) * lu(k,3023) + lu(k,3062) = lu(k,3062) - lu(k,1126) * lu(k,3023) + lu(k,3106) = lu(k,3106) - lu(k,1127) * lu(k,3023) + lu(k,3109) = lu(k,3109) - lu(k,1128) * lu(k,3023) + lu(k,3110) = lu(k,3110) - lu(k,1129) * lu(k,3023) + lu(k,3115) = lu(k,3115) - lu(k,1130) * lu(k,3023) + lu(k,3119) = lu(k,3119) - lu(k,1131) * lu(k,3023) + lu(k,3298) = lu(k,3298) - lu(k,1122) * lu(k,3277) + lu(k,3300) = lu(k,3300) - lu(k,1123) * lu(k,3277) + lu(k,3312) = lu(k,3312) - lu(k,1124) * lu(k,3277) + lu(k,3316) = lu(k,3316) - lu(k,1125) * lu(k,3277) + lu(k,3321) = lu(k,3321) - lu(k,1126) * lu(k,3277) + lu(k,3365) = lu(k,3365) - lu(k,1127) * lu(k,3277) + lu(k,3368) = lu(k,3368) - lu(k,1128) * lu(k,3277) + lu(k,3369) = lu(k,3369) - lu(k,1129) * lu(k,3277) + lu(k,3374) = lu(k,3374) - lu(k,1130) * lu(k,3277) + lu(k,3378) = lu(k,3378) - lu(k,1131) * lu(k,3277) + lu(k,4020) = lu(k,4020) - lu(k,1122) * lu(k,3991) + lu(k,4022) = lu(k,4022) - lu(k,1123) * lu(k,3991) + lu(k,4036) = lu(k,4036) - lu(k,1124) * lu(k,3991) + lu(k,4040) = lu(k,4040) - lu(k,1125) * lu(k,3991) + lu(k,4045) = lu(k,4045) - lu(k,1126) * lu(k,3991) + lu(k,4088) = lu(k,4088) - lu(k,1127) * lu(k,3991) + lu(k,4091) = lu(k,4091) - lu(k,1128) * lu(k,3991) + lu(k,4092) = lu(k,4092) - lu(k,1129) * lu(k,3991) + lu(k,4097) = lu(k,4097) - lu(k,1130) * lu(k,3991) + lu(k,4101) = lu(k,4101) - lu(k,1131) * lu(k,3991) + end do + end subroutine lu_fac24 + subroutine lu_fac25( 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,1132) = 1._r8 / lu(k,1132) + lu(k,1133) = lu(k,1133) * lu(k,1132) + lu(k,1134) = lu(k,1134) * lu(k,1132) + lu(k,1135) = lu(k,1135) * lu(k,1132) + lu(k,1136) = lu(k,1136) * lu(k,1132) + lu(k,1137) = lu(k,1137) * lu(k,1132) + lu(k,1138) = lu(k,1138) * lu(k,1132) + lu(k,1139) = lu(k,1139) * lu(k,1132) + lu(k,1140) = lu(k,1140) * lu(k,1132) + lu(k,1141) = lu(k,1141) * lu(k,1132) + lu(k,1142) = lu(k,1142) * lu(k,1132) + lu(k,2094) = lu(k,2094) - lu(k,1133) * lu(k,2093) + lu(k,2095) = - lu(k,1134) * lu(k,2093) + lu(k,2101) = - lu(k,1135) * lu(k,2093) + lu(k,2103) = lu(k,2103) - lu(k,1136) * lu(k,2093) + lu(k,2107) = lu(k,2107) - lu(k,1137) * lu(k,2093) + lu(k,2114) = - lu(k,1138) * lu(k,2093) + lu(k,2117) = - lu(k,1139) * lu(k,2093) + lu(k,2118) = lu(k,2118) - lu(k,1140) * lu(k,2093) + lu(k,2120) = lu(k,2120) - lu(k,1141) * lu(k,2093) + lu(k,2123) = lu(k,2123) - lu(k,1142) * lu(k,2093) + lu(k,3039) = lu(k,3039) - lu(k,1133) * lu(k,3024) + lu(k,3041) = lu(k,3041) - lu(k,1134) * lu(k,3024) + lu(k,3054) = lu(k,3054) - lu(k,1135) * lu(k,3024) + lu(k,3061) = lu(k,3061) - lu(k,1136) * lu(k,3024) + lu(k,3068) = lu(k,3068) - lu(k,1137) * lu(k,3024) + lu(k,3106) = lu(k,3106) - lu(k,1138) * lu(k,3024) + lu(k,3109) = lu(k,3109) - lu(k,1139) * lu(k,3024) + lu(k,3110) = lu(k,3110) - lu(k,1140) * lu(k,3024) + lu(k,3115) = lu(k,3115) - lu(k,1141) * lu(k,3024) + lu(k,3119) = lu(k,3119) - lu(k,1142) * lu(k,3024) + lu(k,3296) = lu(k,3296) - lu(k,1133) * lu(k,3278) + lu(k,3298) = lu(k,3298) - lu(k,1134) * lu(k,3278) + lu(k,3312) = lu(k,3312) - lu(k,1135) * lu(k,3278) + lu(k,3320) = lu(k,3320) - lu(k,1136) * lu(k,3278) + lu(k,3327) = lu(k,3327) - lu(k,1137) * lu(k,3278) + lu(k,3365) = lu(k,3365) - lu(k,1138) * lu(k,3278) + lu(k,3368) = lu(k,3368) - lu(k,1139) * lu(k,3278) + lu(k,3369) = lu(k,3369) - lu(k,1140) * lu(k,3278) + lu(k,3374) = lu(k,3374) - lu(k,1141) * lu(k,3278) + lu(k,3378) = lu(k,3378) - lu(k,1142) * lu(k,3278) + lu(k,4018) = lu(k,4018) - lu(k,1133) * lu(k,3992) + lu(k,4020) = lu(k,4020) - lu(k,1134) * lu(k,3992) + lu(k,4036) = lu(k,4036) - lu(k,1135) * lu(k,3992) + lu(k,4044) = lu(k,4044) - lu(k,1136) * lu(k,3992) + lu(k,4051) = lu(k,4051) - lu(k,1137) * lu(k,3992) + lu(k,4088) = lu(k,4088) - lu(k,1138) * lu(k,3992) + lu(k,4091) = lu(k,4091) - lu(k,1139) * lu(k,3992) + lu(k,4092) = lu(k,4092) - lu(k,1140) * lu(k,3992) + lu(k,4097) = lu(k,4097) - lu(k,1141) * lu(k,3992) + lu(k,4101) = lu(k,4101) - lu(k,1142) * lu(k,3992) + lu(k,1143) = 1._r8 / lu(k,1143) + lu(k,1144) = lu(k,1144) * lu(k,1143) + lu(k,1145) = lu(k,1145) * lu(k,1143) + lu(k,1146) = lu(k,1146) * lu(k,1143) + lu(k,1147) = lu(k,1147) * lu(k,1143) + lu(k,1148) = lu(k,1148) * lu(k,1143) + lu(k,1149) = lu(k,1149) * lu(k,1143) + lu(k,2292) = lu(k,2292) - lu(k,1144) * lu(k,2289) + lu(k,2297) = lu(k,2297) - lu(k,1145) * lu(k,2289) + lu(k,2305) = - lu(k,1146) * lu(k,2289) + lu(k,2312) = lu(k,2312) - lu(k,1147) * lu(k,2289) + lu(k,2313) = lu(k,2313) - lu(k,1148) * lu(k,2289) + lu(k,2314) = - lu(k,1149) * lu(k,2289) + lu(k,2498) = - lu(k,1144) * lu(k,2494) + lu(k,2504) = - lu(k,1145) * lu(k,2494) + lu(k,2515) = lu(k,2515) - lu(k,1146) * lu(k,2494) + lu(k,2522) = lu(k,2522) - lu(k,1147) * lu(k,2494) + lu(k,2523) = lu(k,2523) - lu(k,1148) * lu(k,2494) + lu(k,2524) = - lu(k,1149) * lu(k,2494) + lu(k,2530) = lu(k,2530) - lu(k,1144) * lu(k,2527) + lu(k,2535) = lu(k,2535) - lu(k,1145) * lu(k,2527) + lu(k,2544) = - lu(k,1146) * lu(k,2527) + lu(k,2551) = lu(k,2551) - lu(k,1147) * lu(k,2527) + lu(k,2552) = lu(k,2552) - lu(k,1148) * lu(k,2527) + lu(k,2553) = lu(k,2553) - lu(k,1149) * lu(k,2527) + lu(k,2561) = - lu(k,1144) * lu(k,2557) + lu(k,2568) = - lu(k,1145) * lu(k,2557) + lu(k,2580) = lu(k,2580) - lu(k,1146) * lu(k,2557) + lu(k,2587) = lu(k,2587) - lu(k,1147) * lu(k,2557) + lu(k,2588) = lu(k,2588) - lu(k,1148) * lu(k,2557) + lu(k,2589) = - lu(k,1149) * lu(k,2557) + lu(k,3048) = lu(k,3048) - lu(k,1144) * lu(k,3025) + lu(k,3087) = lu(k,3087) - lu(k,1145) * lu(k,3025) + lu(k,3105) = lu(k,3105) - lu(k,1146) * lu(k,3025) + lu(k,3115) = lu(k,3115) - lu(k,1147) * lu(k,3025) + lu(k,3119) = lu(k,3119) - lu(k,1148) * lu(k,3025) + lu(k,3120) = lu(k,3120) - lu(k,1149) * lu(k,3025) + lu(k,3305) = lu(k,3305) - lu(k,1144) * lu(k,3279) + lu(k,3346) = lu(k,3346) - lu(k,1145) * lu(k,3279) + lu(k,3364) = lu(k,3364) - lu(k,1146) * lu(k,3279) + lu(k,3374) = lu(k,3374) - lu(k,1147) * lu(k,3279) + lu(k,3378) = lu(k,3378) - lu(k,1148) * lu(k,3279) + lu(k,3379) = lu(k,3379) - lu(k,1149) * lu(k,3279) + lu(k,4028) = lu(k,4028) - lu(k,1144) * lu(k,3993) + lu(k,4069) = lu(k,4069) - lu(k,1145) * lu(k,3993) + lu(k,4087) = lu(k,4087) - lu(k,1146) * lu(k,3993) + lu(k,4097) = lu(k,4097) - lu(k,1147) * lu(k,3993) + lu(k,4101) = lu(k,4101) - lu(k,1148) * lu(k,3993) + lu(k,4102) = lu(k,4102) - lu(k,1149) * lu(k,3993) + lu(k,1150) = 1._r8 / lu(k,1150) + lu(k,1151) = lu(k,1151) * lu(k,1150) + lu(k,1152) = lu(k,1152) * lu(k,1150) + lu(k,1153) = lu(k,1153) * lu(k,1150) + lu(k,1154) = lu(k,1154) * lu(k,1150) + lu(k,1155) = lu(k,1155) * lu(k,1150) + lu(k,1156) = lu(k,1156) * lu(k,1150) + lu(k,1157) = lu(k,1157) * lu(k,1150) + lu(k,2199) = lu(k,2199) - lu(k,1151) * lu(k,2197) + lu(k,2200) = - lu(k,1152) * lu(k,2197) + lu(k,2201) = - lu(k,1153) * lu(k,2197) + lu(k,2204) = lu(k,2204) - lu(k,1154) * lu(k,2197) + lu(k,2206) = - lu(k,1155) * lu(k,2197) + lu(k,2207) = - lu(k,1156) * lu(k,2197) + lu(k,2208) = - lu(k,1157) * lu(k,2197) + lu(k,3155) = lu(k,3155) - lu(k,1151) * lu(k,3147) + lu(k,3157) = lu(k,3157) - lu(k,1152) * lu(k,3147) + lu(k,3161) = lu(k,3161) - lu(k,1153) * lu(k,3147) + lu(k,3165) = lu(k,3165) - lu(k,1154) * lu(k,3147) + lu(k,3170) = - lu(k,1155) * lu(k,3147) + lu(k,3172) = lu(k,3172) - lu(k,1156) * lu(k,3147) + lu(k,3173) = lu(k,3173) - lu(k,1157) * lu(k,3147) + lu(k,3181) = lu(k,3181) - lu(k,1151) * lu(k,3175) + lu(k,3183) = lu(k,3183) - lu(k,1152) * lu(k,3175) + lu(k,3187) = lu(k,3187) - lu(k,1153) * lu(k,3175) + lu(k,3191) = - lu(k,1154) * lu(k,3175) + lu(k,3196) = - lu(k,1155) * lu(k,3175) + lu(k,3198) = lu(k,3198) - lu(k,1156) * lu(k,3175) + lu(k,3199) = lu(k,3199) - lu(k,1157) * lu(k,3175) + lu(k,3338) = lu(k,3338) - lu(k,1151) * lu(k,3280) + lu(k,3363) = lu(k,3363) - lu(k,1152) * lu(k,3280) + lu(k,3367) = lu(k,3367) - lu(k,1153) * lu(k,3280) + lu(k,3371) = lu(k,3371) - lu(k,1154) * lu(k,3280) + lu(k,3376) = - lu(k,1155) * lu(k,3280) + lu(k,3378) = lu(k,3378) - lu(k,1156) * lu(k,3280) + lu(k,3379) = lu(k,3379) - lu(k,1157) * lu(k,3280) + lu(k,3793) = lu(k,3793) - lu(k,1151) * lu(k,3790) + lu(k,3795) = lu(k,3795) - lu(k,1152) * lu(k,3790) + lu(k,3799) = lu(k,3799) - lu(k,1153) * lu(k,3790) + lu(k,3803) = lu(k,3803) - lu(k,1154) * lu(k,3790) + lu(k,3808) = lu(k,3808) - lu(k,1155) * lu(k,3790) + lu(k,3810) = lu(k,3810) - lu(k,1156) * lu(k,3790) + lu(k,3811) = lu(k,3811) - lu(k,1157) * lu(k,3790) + lu(k,4062) = lu(k,4062) - lu(k,1151) * lu(k,3994) + lu(k,4086) = lu(k,4086) - lu(k,1152) * lu(k,3994) + lu(k,4090) = lu(k,4090) - lu(k,1153) * lu(k,3994) + lu(k,4094) = lu(k,4094) - lu(k,1154) * lu(k,3994) + lu(k,4099) = lu(k,4099) - lu(k,1155) * lu(k,3994) + lu(k,4101) = lu(k,4101) - lu(k,1156) * lu(k,3994) + lu(k,4102) = lu(k,4102) - lu(k,1157) * lu(k,3994) + lu(k,1159) = 1._r8 / lu(k,1159) + lu(k,1160) = lu(k,1160) * lu(k,1159) + lu(k,1161) = lu(k,1161) * lu(k,1159) + lu(k,1162) = lu(k,1162) * lu(k,1159) + lu(k,1163) = lu(k,1163) * lu(k,1159) + lu(k,1164) = lu(k,1164) * lu(k,1159) + lu(k,1165) = lu(k,1165) * lu(k,1159) + lu(k,1327) = lu(k,1327) - lu(k,1160) * lu(k,1324) + lu(k,1328) = lu(k,1328) - lu(k,1161) * lu(k,1324) + lu(k,1329) = lu(k,1329) - lu(k,1162) * lu(k,1324) + lu(k,1332) = lu(k,1332) - lu(k,1163) * lu(k,1324) + lu(k,1333) = lu(k,1333) - lu(k,1164) * lu(k,1324) + lu(k,1334) = - lu(k,1165) * lu(k,1324) + lu(k,3129) = lu(k,3129) - lu(k,1160) * lu(k,3124) + lu(k,3130) = lu(k,3130) - lu(k,1161) * lu(k,3124) + lu(k,3135) = lu(k,3135) - lu(k,1162) * lu(k,3124) + lu(k,3140) = lu(k,3140) - lu(k,1163) * lu(k,3124) + lu(k,3141) = lu(k,3141) - lu(k,1164) * lu(k,3124) + lu(k,3142) = lu(k,3142) - lu(k,1165) * lu(k,3124) + lu(k,3160) = lu(k,3160) - lu(k,1160) * lu(k,3148) + lu(k,3161) = lu(k,3161) - lu(k,1161) * lu(k,3148) + lu(k,3166) = lu(k,3166) - lu(k,1162) * lu(k,3148) + lu(k,3171) = lu(k,3171) - lu(k,1163) * lu(k,3148) + lu(k,3172) = lu(k,3172) - lu(k,1164) * lu(k,3148) + lu(k,3173) = lu(k,3173) - lu(k,1165) * lu(k,3148) + lu(k,3366) = lu(k,3366) - lu(k,1160) * lu(k,3281) + lu(k,3367) = lu(k,3367) - lu(k,1161) * lu(k,3281) + lu(k,3372) = lu(k,3372) - lu(k,1162) * lu(k,3281) + lu(k,3377) = lu(k,3377) - lu(k,1163) * lu(k,3281) + lu(k,3378) = lu(k,3378) - lu(k,1164) * lu(k,3281) + lu(k,3379) = lu(k,3379) - lu(k,1165) * lu(k,3281) + lu(k,3509) = lu(k,3509) - lu(k,1160) * lu(k,3501) + lu(k,3510) = lu(k,3510) - lu(k,1161) * lu(k,3501) + lu(k,3515) = lu(k,3515) - lu(k,1162) * lu(k,3501) + lu(k,3520) = lu(k,3520) - lu(k,1163) * lu(k,3501) + lu(k,3521) = lu(k,3521) - lu(k,1164) * lu(k,3501) + lu(k,3522) = - lu(k,1165) * lu(k,3501) + lu(k,3839) = lu(k,3839) - lu(k,1160) * lu(k,3821) + lu(k,3840) = - lu(k,1161) * lu(k,3821) + lu(k,3845) = lu(k,3845) - lu(k,1162) * lu(k,3821) + lu(k,3850) = lu(k,3850) - lu(k,1163) * lu(k,3821) + lu(k,3851) = lu(k,3851) - lu(k,1164) * lu(k,3821) + lu(k,3852) = lu(k,3852) - lu(k,1165) * lu(k,3821) + lu(k,4089) = lu(k,4089) - lu(k,1160) * lu(k,3995) + lu(k,4090) = lu(k,4090) - lu(k,1161) * lu(k,3995) + lu(k,4095) = lu(k,4095) - lu(k,1162) * lu(k,3995) + lu(k,4100) = lu(k,4100) - lu(k,1163) * lu(k,3995) + lu(k,4101) = lu(k,4101) - lu(k,1164) * lu(k,3995) + lu(k,4102) = lu(k,4102) - lu(k,1165) * lu(k,3995) + end do + end subroutine lu_fac25 + subroutine lu_fac26( 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,1166) = 1._r8 / lu(k,1166) + lu(k,1167) = lu(k,1167) * lu(k,1166) + lu(k,1168) = lu(k,1168) * lu(k,1166) + lu(k,1169) = lu(k,1169) * lu(k,1166) + lu(k,1170) = lu(k,1170) * lu(k,1166) + lu(k,1171) = lu(k,1171) * lu(k,1166) + lu(k,1172) = lu(k,1172) * lu(k,1166) + lu(k,1173) = lu(k,1173) * lu(k,1166) + lu(k,1174) = lu(k,1174) * lu(k,1166) + lu(k,1175) = lu(k,1175) * lu(k,1166) + lu(k,1176) = lu(k,1176) * lu(k,1166) + lu(k,1177) = lu(k,1177) * lu(k,1166) + lu(k,1939) = - lu(k,1167) * lu(k,1938) + lu(k,1942) = - lu(k,1168) * lu(k,1938) + lu(k,1943) = lu(k,1943) - lu(k,1169) * lu(k,1938) + lu(k,1945) = lu(k,1945) - lu(k,1170) * lu(k,1938) + lu(k,1946) = - lu(k,1171) * lu(k,1938) + lu(k,1947) = - lu(k,1172) * lu(k,1938) + lu(k,1961) = lu(k,1961) - lu(k,1173) * lu(k,1938) + lu(k,1963) = lu(k,1963) - lu(k,1174) * lu(k,1938) + lu(k,1964) = lu(k,1964) - lu(k,1175) * lu(k,1938) + lu(k,1967) = lu(k,1967) - lu(k,1176) * lu(k,1938) + lu(k,1968) = lu(k,1968) - lu(k,1177) * lu(k,1938) + lu(k,3041) = lu(k,3041) - lu(k,1167) * lu(k,3026) + lu(k,3054) = lu(k,3054) - lu(k,1168) * lu(k,3026) + lu(k,3057) = lu(k,3057) - lu(k,1169) * lu(k,3026) + lu(k,3061) = lu(k,3061) - lu(k,1170) * lu(k,3026) + lu(k,3062) = lu(k,3062) - lu(k,1171) * lu(k,3026) + lu(k,3063) = lu(k,3063) - lu(k,1172) * lu(k,3026) + lu(k,3106) = lu(k,3106) - lu(k,1173) * lu(k,3026) + lu(k,3109) = lu(k,3109) - lu(k,1174) * lu(k,3026) + lu(k,3110) = lu(k,3110) - lu(k,1175) * lu(k,3026) + lu(k,3115) = lu(k,3115) - lu(k,1176) * lu(k,3026) + lu(k,3119) = lu(k,3119) - lu(k,1177) * lu(k,3026) + lu(k,3298) = lu(k,3298) - lu(k,1167) * lu(k,3282) + lu(k,3312) = lu(k,3312) - lu(k,1168) * lu(k,3282) + lu(k,3316) = lu(k,3316) - lu(k,1169) * lu(k,3282) + lu(k,3320) = lu(k,3320) - lu(k,1170) * lu(k,3282) + lu(k,3321) = lu(k,3321) - lu(k,1171) * lu(k,3282) + lu(k,3322) = lu(k,3322) - lu(k,1172) * lu(k,3282) + lu(k,3365) = lu(k,3365) - lu(k,1173) * lu(k,3282) + lu(k,3368) = lu(k,3368) - lu(k,1174) * lu(k,3282) + lu(k,3369) = lu(k,3369) - lu(k,1175) * lu(k,3282) + lu(k,3374) = lu(k,3374) - lu(k,1176) * lu(k,3282) + lu(k,3378) = lu(k,3378) - lu(k,1177) * lu(k,3282) + lu(k,4020) = lu(k,4020) - lu(k,1167) * lu(k,3996) + lu(k,4036) = lu(k,4036) - lu(k,1168) * lu(k,3996) + lu(k,4040) = lu(k,4040) - lu(k,1169) * lu(k,3996) + lu(k,4044) = lu(k,4044) - lu(k,1170) * lu(k,3996) + lu(k,4045) = lu(k,4045) - lu(k,1171) * lu(k,3996) + lu(k,4046) = lu(k,4046) - lu(k,1172) * lu(k,3996) + lu(k,4088) = lu(k,4088) - lu(k,1173) * lu(k,3996) + lu(k,4091) = lu(k,4091) - lu(k,1174) * lu(k,3996) + lu(k,4092) = lu(k,4092) - lu(k,1175) * lu(k,3996) + lu(k,4097) = lu(k,4097) - lu(k,1176) * lu(k,3996) + lu(k,4101) = lu(k,4101) - lu(k,1177) * lu(k,3996) + lu(k,1182) = 1._r8 / lu(k,1182) + lu(k,1183) = lu(k,1183) * lu(k,1182) + lu(k,1184) = lu(k,1184) * lu(k,1182) + lu(k,1185) = lu(k,1185) * lu(k,1182) + lu(k,1186) = lu(k,1186) * lu(k,1182) + lu(k,1187) = lu(k,1187) * lu(k,1182) + lu(k,1188) = lu(k,1188) * lu(k,1182) + lu(k,1189) = lu(k,1189) * lu(k,1182) + lu(k,1190) = lu(k,1190) * lu(k,1182) + lu(k,1191) = lu(k,1191) * lu(k,1182) + lu(k,3034) = lu(k,3034) - lu(k,1183) * lu(k,3027) + lu(k,3037) = lu(k,3037) - lu(k,1184) * lu(k,3027) + lu(k,3083) = lu(k,3083) - lu(k,1185) * lu(k,3027) + lu(k,3103) = lu(k,3103) - lu(k,1186) * lu(k,3027) + lu(k,3106) = lu(k,3106) - lu(k,1187) * lu(k,3027) + lu(k,3109) = lu(k,3109) - lu(k,1188) * lu(k,3027) + lu(k,3110) = lu(k,3110) - lu(k,1189) * lu(k,3027) + lu(k,3115) = lu(k,3115) - lu(k,1190) * lu(k,3027) + lu(k,3119) = lu(k,3119) - lu(k,1191) * lu(k,3027) + lu(k,3291) = lu(k,3291) - lu(k,1183) * lu(k,3283) + lu(k,3294) = lu(k,3294) - lu(k,1184) * lu(k,3283) + lu(k,3342) = lu(k,3342) - lu(k,1185) * lu(k,3283) + lu(k,3362) = lu(k,3362) - lu(k,1186) * lu(k,3283) + lu(k,3365) = lu(k,3365) - lu(k,1187) * lu(k,3283) + lu(k,3368) = lu(k,3368) - lu(k,1188) * lu(k,3283) + lu(k,3369) = lu(k,3369) - lu(k,1189) * lu(k,3283) + lu(k,3374) = lu(k,3374) - lu(k,1190) * lu(k,3283) + lu(k,3378) = lu(k,3378) - lu(k,1191) * lu(k,3283) + lu(k,3540) = - lu(k,1183) * lu(k,3535) + lu(k,3544) = lu(k,3544) - lu(k,1184) * lu(k,3535) + lu(k,3579) = lu(k,3579) - lu(k,1185) * lu(k,3535) + lu(k,3599) = lu(k,3599) - lu(k,1186) * lu(k,3535) + lu(k,3602) = lu(k,3602) - lu(k,1187) * lu(k,3535) + lu(k,3605) = lu(k,3605) - lu(k,1188) * lu(k,3535) + lu(k,3606) = lu(k,3606) - lu(k,1189) * lu(k,3535) + lu(k,3611) = lu(k,3611) - lu(k,1190) * lu(k,3535) + lu(k,3615) = lu(k,3615) - lu(k,1191) * lu(k,3535) + lu(k,3694) = - lu(k,1183) * lu(k,3689) + lu(k,3698) = lu(k,3698) - lu(k,1184) * lu(k,3689) + lu(k,3734) = lu(k,3734) - lu(k,1185) * lu(k,3689) + lu(k,3753) = lu(k,3753) - lu(k,1186) * lu(k,3689) + lu(k,3756) = lu(k,3756) - lu(k,1187) * lu(k,3689) + lu(k,3759) = lu(k,3759) - lu(k,1188) * lu(k,3689) + lu(k,3760) = lu(k,3760) - lu(k,1189) * lu(k,3689) + lu(k,3765) = lu(k,3765) - lu(k,1190) * lu(k,3689) + lu(k,3769) = lu(k,3769) - lu(k,1191) * lu(k,3689) + lu(k,4011) = lu(k,4011) - lu(k,1183) * lu(k,3997) + lu(k,4016) = lu(k,4016) - lu(k,1184) * lu(k,3997) + lu(k,4065) = lu(k,4065) - lu(k,1185) * lu(k,3997) + lu(k,4085) = lu(k,4085) - lu(k,1186) * lu(k,3997) + lu(k,4088) = lu(k,4088) - lu(k,1187) * lu(k,3997) + lu(k,4091) = lu(k,4091) - lu(k,1188) * lu(k,3997) + lu(k,4092) = lu(k,4092) - lu(k,1189) * lu(k,3997) + lu(k,4097) = lu(k,4097) - lu(k,1190) * lu(k,3997) + lu(k,4101) = lu(k,4101) - lu(k,1191) * lu(k,3997) + lu(k,1194) = 1._r8 / lu(k,1194) + lu(k,1195) = lu(k,1195) * lu(k,1194) + lu(k,1196) = lu(k,1196) * lu(k,1194) + lu(k,1197) = lu(k,1197) * lu(k,1194) + lu(k,1198) = lu(k,1198) * lu(k,1194) + lu(k,1199) = lu(k,1199) * lu(k,1194) + lu(k,1200) = lu(k,1200) * lu(k,1194) + lu(k,1201) = lu(k,1201) * lu(k,1194) + lu(k,1202) = lu(k,1202) * lu(k,1194) + lu(k,1203) = lu(k,1203) * lu(k,1194) + lu(k,1204) = lu(k,1204) * lu(k,1194) + lu(k,1205) = lu(k,1205) * lu(k,1194) + lu(k,1206) = lu(k,1206) * lu(k,1194) + lu(k,1207) = lu(k,1207) * lu(k,1194) + lu(k,1208) = lu(k,1208) * lu(k,1194) + lu(k,1209) = lu(k,1209) * lu(k,1194) + lu(k,2157) = - lu(k,1195) * lu(k,2155) + lu(k,2158) = - lu(k,1196) * lu(k,2155) + lu(k,2166) = - lu(k,1197) * lu(k,2155) + lu(k,2169) = - lu(k,1198) * lu(k,2155) + lu(k,2173) = - lu(k,1199) * lu(k,2155) + lu(k,2174) = lu(k,2174) - lu(k,1200) * lu(k,2155) + lu(k,2175) = lu(k,2175) - lu(k,1201) * lu(k,2155) + lu(k,2176) = - lu(k,1202) * lu(k,2155) + lu(k,2179) = lu(k,2179) - lu(k,1203) * lu(k,2155) + lu(k,2180) = lu(k,2180) - lu(k,1204) * lu(k,2155) + lu(k,2184) = - lu(k,1205) * lu(k,2155) + lu(k,2188) = lu(k,2188) - lu(k,1206) * lu(k,2155) + lu(k,2189) = lu(k,2189) - lu(k,1207) * lu(k,2155) + lu(k,2192) = lu(k,2192) - lu(k,1208) * lu(k,2155) + lu(k,2195) = lu(k,2195) - lu(k,1209) * lu(k,2155) + lu(k,3289) = lu(k,3289) - lu(k,1195) * lu(k,3284) + lu(k,3293) = lu(k,3293) - lu(k,1196) * lu(k,3284) + lu(k,3311) = lu(k,3311) - lu(k,1197) * lu(k,3284) + lu(k,3320) = lu(k,3320) - lu(k,1198) * lu(k,3284) + lu(k,3328) = lu(k,3328) - lu(k,1199) * lu(k,3284) + lu(k,3331) = lu(k,3331) - lu(k,1200) * lu(k,3284) + lu(k,3332) = lu(k,3332) - lu(k,1201) * lu(k,3284) + lu(k,3333) = lu(k,3333) - lu(k,1202) * lu(k,3284) + lu(k,3336) = - lu(k,1203) * lu(k,3284) + lu(k,3337) = lu(k,3337) - lu(k,1204) * lu(k,3284) + lu(k,3364) = lu(k,3364) - lu(k,1205) * lu(k,3284) + lu(k,3368) = lu(k,3368) - lu(k,1206) * lu(k,3284) + lu(k,3369) = lu(k,3369) - lu(k,1207) * lu(k,3284) + lu(k,3374) = lu(k,3374) - lu(k,1208) * lu(k,3284) + lu(k,3378) = lu(k,3378) - lu(k,1209) * lu(k,3284) + lu(k,4008) = lu(k,4008) - lu(k,1195) * lu(k,3998) + lu(k,4013) = lu(k,4013) - lu(k,1196) * lu(k,3998) + lu(k,4035) = lu(k,4035) - lu(k,1197) * lu(k,3998) + lu(k,4044) = lu(k,4044) - lu(k,1198) * lu(k,3998) + lu(k,4052) = lu(k,4052) - lu(k,1199) * lu(k,3998) + lu(k,4055) = lu(k,4055) - lu(k,1200) * lu(k,3998) + lu(k,4056) = lu(k,4056) - lu(k,1201) * lu(k,3998) + lu(k,4057) = lu(k,4057) - lu(k,1202) * lu(k,3998) + lu(k,4060) = lu(k,4060) - lu(k,1203) * lu(k,3998) + lu(k,4061) = lu(k,4061) - lu(k,1204) * lu(k,3998) + lu(k,4087) = lu(k,4087) - lu(k,1205) * lu(k,3998) + lu(k,4091) = lu(k,4091) - lu(k,1206) * lu(k,3998) + lu(k,4092) = lu(k,4092) - lu(k,1207) * lu(k,3998) + lu(k,4097) = lu(k,4097) - lu(k,1208) * lu(k,3998) + lu(k,4101) = lu(k,4101) - lu(k,1209) * lu(k,3998) + end do + end subroutine lu_fac26 + subroutine lu_fac27( 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,1210) = 1._r8 / lu(k,1210) + lu(k,1211) = lu(k,1211) * lu(k,1210) + lu(k,1212) = lu(k,1212) * lu(k,1210) + lu(k,1213) = lu(k,1213) * lu(k,1210) + lu(k,1214) = lu(k,1214) * lu(k,1210) + lu(k,1215) = lu(k,1215) * lu(k,1210) + lu(k,1409) = lu(k,1409) - lu(k,1211) * lu(k,1408) + lu(k,1424) = lu(k,1424) - lu(k,1212) * lu(k,1408) + lu(k,1425) = lu(k,1425) - lu(k,1213) * lu(k,1408) + lu(k,1429) = lu(k,1429) - lu(k,1214) * lu(k,1408) + lu(k,1430) = - lu(k,1215) * lu(k,1408) + lu(k,2592) = lu(k,2592) - lu(k,1211) * lu(k,2591) + lu(k,2611) = lu(k,2611) - lu(k,1212) * lu(k,2591) + lu(k,2612) = lu(k,2612) - lu(k,1213) * lu(k,2591) + lu(k,2617) = lu(k,2617) - lu(k,1214) * lu(k,2591) + lu(k,2618) = - lu(k,1215) * lu(k,2591) + lu(k,2622) = lu(k,2622) - lu(k,1211) * lu(k,2621) + lu(k,2639) = lu(k,2639) - lu(k,1212) * lu(k,2621) + lu(k,2640) = lu(k,2640) - lu(k,1213) * lu(k,2621) + lu(k,2645) = lu(k,2645) - lu(k,1214) * lu(k,2621) + lu(k,2646) = - lu(k,1215) * lu(k,2621) + lu(k,3036) = lu(k,3036) - lu(k,1211) * lu(k,3028) + lu(k,3109) = lu(k,3109) - lu(k,1212) * lu(k,3028) + lu(k,3110) = lu(k,3110) - lu(k,1213) * lu(k,3028) + lu(k,3119) = lu(k,3119) - lu(k,1214) * lu(k,3028) + lu(k,3120) = lu(k,3120) - lu(k,1215) * lu(k,3028) + lu(k,3177) = lu(k,3177) - lu(k,1211) * lu(k,3176) + lu(k,3188) = lu(k,3188) - lu(k,1212) * lu(k,3176) + lu(k,3189) = lu(k,3189) - lu(k,1213) * lu(k,3176) + lu(k,3198) = lu(k,3198) - lu(k,1214) * lu(k,3176) + lu(k,3199) = lu(k,3199) - lu(k,1215) * lu(k,3176) + lu(k,3293) = lu(k,3293) - lu(k,1211) * lu(k,3285) + lu(k,3368) = lu(k,3368) - lu(k,1212) * lu(k,3285) + lu(k,3369) = lu(k,3369) - lu(k,1213) * lu(k,3285) + lu(k,3378) = lu(k,3378) - lu(k,1214) * lu(k,3285) + lu(k,3379) = lu(k,3379) - lu(k,1215) * lu(k,3285) + lu(k,3541) = lu(k,3541) - lu(k,1211) * lu(k,3536) + lu(k,3605) = lu(k,3605) - lu(k,1212) * lu(k,3536) + lu(k,3606) = lu(k,3606) - lu(k,1213) * lu(k,3536) + lu(k,3615) = lu(k,3615) - lu(k,1214) * lu(k,3536) + lu(k,3616) = - lu(k,1215) * lu(k,3536) + lu(k,3695) = lu(k,3695) - lu(k,1211) * lu(k,3690) + lu(k,3759) = lu(k,3759) - lu(k,1212) * lu(k,3690) + lu(k,3760) = lu(k,3760) - lu(k,1213) * lu(k,3690) + lu(k,3769) = lu(k,3769) - lu(k,1214) * lu(k,3690) + lu(k,3770) = lu(k,3770) - lu(k,1215) * lu(k,3690) + lu(k,4013) = lu(k,4013) - lu(k,1211) * lu(k,3999) + lu(k,4091) = lu(k,4091) - lu(k,1212) * lu(k,3999) + lu(k,4092) = lu(k,4092) - lu(k,1213) * lu(k,3999) + lu(k,4101) = lu(k,4101) - lu(k,1214) * lu(k,3999) + lu(k,4102) = lu(k,4102) - lu(k,1215) * lu(k,3999) + lu(k,1218) = 1._r8 / lu(k,1218) + lu(k,1219) = lu(k,1219) * lu(k,1218) + lu(k,1220) = lu(k,1220) * lu(k,1218) + lu(k,1221) = lu(k,1221) * lu(k,1218) + lu(k,1222) = lu(k,1222) * lu(k,1218) + lu(k,1223) = lu(k,1223) * lu(k,1218) + lu(k,1224) = lu(k,1224) * lu(k,1218) + lu(k,1225) = lu(k,1225) * lu(k,1218) + lu(k,1226) = lu(k,1226) * lu(k,1218) + lu(k,1227) = lu(k,1227) * lu(k,1218) + lu(k,2496) = lu(k,2496) - lu(k,1219) * lu(k,2495) + lu(k,2499) = lu(k,2499) - lu(k,1220) * lu(k,2495) + lu(k,2504) = lu(k,2504) - lu(k,1221) * lu(k,2495) + lu(k,2506) = - lu(k,1222) * lu(k,2495) + lu(k,2516) = lu(k,2516) - lu(k,1223) * lu(k,2495) + lu(k,2519) = lu(k,2519) - lu(k,1224) * lu(k,2495) + lu(k,2522) = lu(k,2522) - lu(k,1225) * lu(k,2495) + lu(k,2523) = lu(k,2523) - lu(k,1226) * lu(k,2495) + lu(k,2524) = lu(k,2524) - lu(k,1227) * lu(k,2495) + lu(k,2559) = lu(k,2559) - lu(k,1219) * lu(k,2558) + lu(k,2562) = lu(k,2562) - lu(k,1220) * lu(k,2558) + lu(k,2568) = lu(k,2568) - lu(k,1221) * lu(k,2558) + lu(k,2569) = - lu(k,1222) * lu(k,2558) + lu(k,2581) = lu(k,2581) - lu(k,1223) * lu(k,2558) + lu(k,2584) = lu(k,2584) - lu(k,1224) * lu(k,2558) + lu(k,2587) = lu(k,2587) - lu(k,1225) * lu(k,2558) + lu(k,2588) = lu(k,2588) - lu(k,1226) * lu(k,2558) + lu(k,2589) = lu(k,2589) - lu(k,1227) * lu(k,2558) + lu(k,3030) = lu(k,3030) - lu(k,1219) * lu(k,3029) + lu(k,3050) = lu(k,3050) - lu(k,1220) * lu(k,3029) + lu(k,3087) = lu(k,3087) - lu(k,1221) * lu(k,3029) + lu(k,3093) = lu(k,3093) - lu(k,1222) * lu(k,3029) + lu(k,3106) = lu(k,3106) - lu(k,1223) * lu(k,3029) + lu(k,3110) = lu(k,3110) - lu(k,1224) * lu(k,3029) + lu(k,3115) = lu(k,3115) - lu(k,1225) * lu(k,3029) + lu(k,3119) = lu(k,3119) - lu(k,1226) * lu(k,3029) + lu(k,3120) = lu(k,3120) - lu(k,1227) * lu(k,3029) + lu(k,3287) = lu(k,3287) - lu(k,1219) * lu(k,3286) + lu(k,3307) = lu(k,3307) - lu(k,1220) * lu(k,3286) + lu(k,3346) = lu(k,3346) - lu(k,1221) * lu(k,3286) + lu(k,3352) = lu(k,3352) - lu(k,1222) * lu(k,3286) + lu(k,3365) = lu(k,3365) - lu(k,1223) * lu(k,3286) + lu(k,3369) = lu(k,3369) - lu(k,1224) * lu(k,3286) + lu(k,3374) = lu(k,3374) - lu(k,1225) * lu(k,3286) + lu(k,3378) = lu(k,3378) - lu(k,1226) * lu(k,3286) + lu(k,3379) = lu(k,3379) - lu(k,1227) * lu(k,3286) + lu(k,4001) = lu(k,4001) - lu(k,1219) * lu(k,4000) + lu(k,4030) = lu(k,4030) - lu(k,1220) * lu(k,4000) + lu(k,4069) = lu(k,4069) - lu(k,1221) * lu(k,4000) + lu(k,4075) = lu(k,4075) - lu(k,1222) * lu(k,4000) + lu(k,4088) = lu(k,4088) - lu(k,1223) * lu(k,4000) + lu(k,4092) = lu(k,4092) - lu(k,1224) * lu(k,4000) + lu(k,4097) = lu(k,4097) - lu(k,1225) * lu(k,4000) + lu(k,4101) = lu(k,4101) - lu(k,1226) * lu(k,4000) + lu(k,4102) = lu(k,4102) - lu(k,1227) * lu(k,4000) + lu(k,1228) = 1._r8 / lu(k,1228) + lu(k,1229) = lu(k,1229) * lu(k,1228) + lu(k,1230) = lu(k,1230) * lu(k,1228) + lu(k,1231) = lu(k,1231) * lu(k,1228) + lu(k,1232) = lu(k,1232) * lu(k,1228) + lu(k,1233) = lu(k,1233) * lu(k,1228) + lu(k,1688) = lu(k,1688) - lu(k,1229) * lu(k,1687) + lu(k,1692) = - lu(k,1230) * lu(k,1687) + lu(k,1694) = lu(k,1694) - lu(k,1231) * lu(k,1687) + lu(k,1695) = lu(k,1695) - lu(k,1232) * lu(k,1687) + lu(k,1696) = lu(k,1696) - lu(k,1233) * lu(k,1687) + lu(k,1701) = lu(k,1701) - lu(k,1229) * lu(k,1699) + lu(k,1705) = lu(k,1705) - lu(k,1230) * lu(k,1699) + lu(k,1707) = lu(k,1707) - lu(k,1231) * lu(k,1699) + lu(k,1708) = lu(k,1708) - lu(k,1232) * lu(k,1699) + lu(k,1709) = lu(k,1709) - lu(k,1233) * lu(k,1699) + lu(k,2293) = lu(k,2293) - lu(k,1229) * lu(k,2290) + lu(k,2305) = lu(k,2305) - lu(k,1230) * lu(k,2290) + lu(k,2309) = lu(k,2309) - lu(k,1231) * lu(k,2290) + lu(k,2312) = lu(k,2312) - lu(k,1232) * lu(k,2290) + lu(k,2313) = lu(k,2313) - lu(k,1233) * lu(k,2290) + lu(k,2499) = lu(k,2499) - lu(k,1229) * lu(k,2496) + lu(k,2515) = lu(k,2515) - lu(k,1230) * lu(k,2496) + lu(k,2519) = lu(k,2519) - lu(k,1231) * lu(k,2496) + lu(k,2522) = lu(k,2522) - lu(k,1232) * lu(k,2496) + lu(k,2523) = lu(k,2523) - lu(k,1233) * lu(k,2496) + lu(k,2531) = lu(k,2531) - lu(k,1229) * lu(k,2528) + lu(k,2544) = lu(k,2544) - lu(k,1230) * lu(k,2528) + lu(k,2548) = lu(k,2548) - lu(k,1231) * lu(k,2528) + lu(k,2551) = lu(k,2551) - lu(k,1232) * lu(k,2528) + lu(k,2552) = lu(k,2552) - lu(k,1233) * lu(k,2528) + lu(k,2562) = lu(k,2562) - lu(k,1229) * lu(k,2559) + lu(k,2580) = lu(k,2580) - lu(k,1230) * lu(k,2559) + lu(k,2584) = lu(k,2584) - lu(k,1231) * lu(k,2559) + lu(k,2587) = lu(k,2587) - lu(k,1232) * lu(k,2559) + lu(k,2588) = lu(k,2588) - lu(k,1233) * lu(k,2559) + lu(k,3050) = lu(k,3050) - lu(k,1229) * lu(k,3030) + lu(k,3105) = lu(k,3105) - lu(k,1230) * lu(k,3030) + lu(k,3110) = lu(k,3110) - lu(k,1231) * lu(k,3030) + lu(k,3115) = lu(k,3115) - lu(k,1232) * lu(k,3030) + lu(k,3119) = lu(k,3119) - lu(k,1233) * lu(k,3030) + lu(k,3307) = lu(k,3307) - lu(k,1229) * lu(k,3287) + lu(k,3364) = lu(k,3364) - lu(k,1230) * lu(k,3287) + lu(k,3369) = lu(k,3369) - lu(k,1231) * lu(k,3287) + lu(k,3374) = lu(k,3374) - lu(k,1232) * lu(k,3287) + lu(k,3378) = lu(k,3378) - lu(k,1233) * lu(k,3287) + lu(k,4030) = lu(k,4030) - lu(k,1229) * lu(k,4001) + lu(k,4087) = lu(k,4087) - lu(k,1230) * lu(k,4001) + lu(k,4092) = lu(k,4092) - lu(k,1231) * lu(k,4001) + lu(k,4097) = lu(k,4097) - lu(k,1232) * lu(k,4001) + lu(k,4101) = lu(k,4101) - lu(k,1233) * lu(k,4001) + lu(k,1235) = 1._r8 / lu(k,1235) + lu(k,1236) = lu(k,1236) * lu(k,1235) + lu(k,1237) = lu(k,1237) * lu(k,1235) + lu(k,1238) = lu(k,1238) * lu(k,1235) + lu(k,1239) = lu(k,1239) * lu(k,1235) + lu(k,1240) = lu(k,1240) * lu(k,1235) + lu(k,1600) = lu(k,1600) - lu(k,1236) * lu(k,1599) + lu(k,1604) = lu(k,1604) - lu(k,1237) * lu(k,1599) + lu(k,1605) = - lu(k,1238) * lu(k,1599) + lu(k,1611) = lu(k,1611) - lu(k,1239) * lu(k,1599) + lu(k,1612) = - lu(k,1240) * lu(k,1599) + lu(k,3152) = lu(k,3152) - lu(k,1236) * lu(k,3149) + lu(k,3161) = lu(k,3161) - lu(k,1237) * lu(k,3149) + lu(k,3163) = lu(k,3163) - lu(k,1238) * lu(k,3149) + lu(k,3172) = lu(k,3172) - lu(k,1239) * lu(k,3149) + lu(k,3173) = lu(k,3173) - lu(k,1240) * lu(k,3149) + lu(k,3478) = lu(k,3478) - lu(k,1236) * lu(k,3477) + lu(k,3484) = lu(k,3484) - lu(k,1237) * lu(k,3477) + lu(k,3486) = lu(k,3486) - lu(k,1238) * lu(k,3477) + lu(k,3495) = lu(k,3495) - lu(k,1239) * lu(k,3477) + lu(k,3496) = lu(k,3496) - lu(k,1240) * lu(k,3477) + lu(k,3504) = lu(k,3504) - lu(k,1236) * lu(k,3502) + lu(k,3510) = lu(k,3510) - lu(k,1237) * lu(k,3502) + lu(k,3512) = lu(k,3512) - lu(k,1238) * lu(k,3502) + lu(k,3521) = lu(k,3521) - lu(k,1239) * lu(k,3502) + lu(k,3522) = lu(k,3522) - lu(k,1240) * lu(k,3502) + lu(k,3550) = - lu(k,1236) * lu(k,3537) + lu(k,3604) = lu(k,3604) - lu(k,1237) * lu(k,3537) + lu(k,3606) = lu(k,3606) - lu(k,1238) * lu(k,3537) + lu(k,3615) = lu(k,3615) - lu(k,1239) * lu(k,3537) + lu(k,3616) = lu(k,3616) - lu(k,1240) * lu(k,3537) + lu(k,3639) = lu(k,3639) - lu(k,1236) * lu(k,3635) + lu(k,3656) = lu(k,3656) - lu(k,1237) * lu(k,3635) + lu(k,3658) = lu(k,3658) - lu(k,1238) * lu(k,3635) + lu(k,3667) = lu(k,3667) - lu(k,1239) * lu(k,3635) + lu(k,3668) = lu(k,3668) - lu(k,1240) * lu(k,3635) + lu(k,3705) = lu(k,3705) - lu(k,1236) * lu(k,3691) + lu(k,3758) = lu(k,3758) - lu(k,1237) * lu(k,3691) + lu(k,3760) = lu(k,3760) - lu(k,1238) * lu(k,3691) + lu(k,3769) = lu(k,3769) - lu(k,1239) * lu(k,3691) + lu(k,3770) = lu(k,3770) - lu(k,1240) * lu(k,3691) + lu(k,4032) = lu(k,4032) - lu(k,1236) * lu(k,4002) + lu(k,4090) = lu(k,4090) - lu(k,1237) * lu(k,4002) + lu(k,4092) = lu(k,4092) - lu(k,1238) * lu(k,4002) + lu(k,4101) = lu(k,4101) - lu(k,1239) * lu(k,4002) + lu(k,4102) = lu(k,4102) - lu(k,1240) * lu(k,4002) + lu(k,4108) = - lu(k,1236) * lu(k,4106) + lu(k,4116) = lu(k,4116) - lu(k,1237) * lu(k,4106) + lu(k,4118) = - lu(k,1238) * lu(k,4106) + lu(k,4127) = lu(k,4127) - lu(k,1239) * lu(k,4106) + lu(k,4128) = lu(k,4128) - lu(k,1240) * lu(k,4106) + lu(k,1242) = 1._r8 / lu(k,1242) + lu(k,1243) = lu(k,1243) * lu(k,1242) + lu(k,1244) = lu(k,1244) * lu(k,1242) + lu(k,1245) = lu(k,1245) * lu(k,1242) + lu(k,1246) = lu(k,1246) * lu(k,1242) + lu(k,1247) = lu(k,1247) * lu(k,1242) + lu(k,1248) = lu(k,1248) * lu(k,1242) + lu(k,1249) = lu(k,1249) * lu(k,1242) + lu(k,1250) = lu(k,1250) * lu(k,1242) + lu(k,1673) = lu(k,1673) - lu(k,1243) * lu(k,1672) + lu(k,1674) = - lu(k,1244) * lu(k,1672) + lu(k,1675) = lu(k,1675) - lu(k,1245) * lu(k,1672) + lu(k,1676) = - lu(k,1246) * lu(k,1672) + lu(k,1679) = - lu(k,1247) * lu(k,1672) + lu(k,1680) = - lu(k,1248) * lu(k,1672) + lu(k,1683) = lu(k,1683) - lu(k,1249) * lu(k,1672) + lu(k,1684) = lu(k,1684) - lu(k,1250) * lu(k,1672) + lu(k,2257) = lu(k,2257) - lu(k,1243) * lu(k,2255) + lu(k,2259) = lu(k,2259) - lu(k,1244) * lu(k,2255) + lu(k,2260) = lu(k,2260) - lu(k,1245) * lu(k,2255) + lu(k,2261) = - lu(k,1246) * lu(k,2255) + lu(k,2266) = lu(k,2266) - lu(k,1247) * lu(k,2255) + lu(k,2267) = - lu(k,1248) * lu(k,2255) + lu(k,2270) = lu(k,2270) - lu(k,1249) * lu(k,2255) + lu(k,2271) = lu(k,2271) - lu(k,1250) * lu(k,2255) + lu(k,2946) = - lu(k,1243) * lu(k,2945) + lu(k,2947) = - lu(k,1244) * lu(k,2945) + lu(k,2948) = lu(k,2948) - lu(k,1245) * lu(k,2945) + lu(k,2949) = lu(k,2949) - lu(k,1246) * lu(k,2945) + lu(k,2954) = - lu(k,1247) * lu(k,2945) + lu(k,2955) = lu(k,2955) - lu(k,1248) * lu(k,2945) + lu(k,2960) = lu(k,2960) - lu(k,1249) * lu(k,2945) + lu(k,2961) = lu(k,2961) - lu(k,1250) * lu(k,2945) + lu(k,3792) = lu(k,3792) - lu(k,1243) * lu(k,3791) + lu(k,3794) = lu(k,3794) - lu(k,1244) * lu(k,3791) + lu(k,3795) = lu(k,3795) - lu(k,1245) * lu(k,3791) + lu(k,3796) = - lu(k,1246) * lu(k,3791) + lu(k,3802) = lu(k,3802) - lu(k,1247) * lu(k,3791) + lu(k,3805) = - lu(k,1248) * lu(k,3791) + lu(k,3810) = lu(k,3810) - lu(k,1249) * lu(k,3791) + lu(k,3811) = lu(k,3811) - lu(k,1250) * lu(k,3791) + lu(k,4037) = lu(k,4037) - lu(k,1243) * lu(k,4003) + lu(k,4064) = lu(k,4064) - lu(k,1244) * lu(k,4003) + lu(k,4086) = lu(k,4086) - lu(k,1245) * lu(k,4003) + lu(k,4087) = lu(k,4087) - lu(k,1246) * lu(k,4003) + lu(k,4093) = lu(k,4093) - lu(k,1247) * lu(k,4003) + lu(k,4096) = lu(k,4096) - lu(k,1248) * lu(k,4003) + lu(k,4101) = lu(k,4101) - lu(k,1249) * lu(k,4003) + lu(k,4102) = lu(k,4102) - lu(k,1250) * lu(k,4003) + lu(k,4109) = lu(k,4109) - lu(k,1243) * lu(k,4107) + lu(k,4111) = - lu(k,1244) * lu(k,4107) + lu(k,4112) = lu(k,4112) - lu(k,1245) * lu(k,4107) + lu(k,4113) = - lu(k,1246) * lu(k,4107) + lu(k,4119) = - lu(k,1247) * lu(k,4107) + lu(k,4122) = - lu(k,1248) * lu(k,4107) + lu(k,4127) = lu(k,4127) - lu(k,1249) * lu(k,4107) + lu(k,4128) = lu(k,4128) - lu(k,1250) * lu(k,4107) + end do + end subroutine lu_fac27 + subroutine lu_fac28( 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,1252) = 1._r8 / lu(k,1252) + lu(k,1253) = lu(k,1253) * lu(k,1252) + lu(k,1254) = lu(k,1254) * lu(k,1252) + lu(k,1255) = lu(k,1255) * lu(k,1252) + lu(k,1256) = lu(k,1256) * lu(k,1252) + lu(k,1257) = lu(k,1257) * lu(k,1252) + lu(k,1258) = lu(k,1258) * lu(k,1252) + lu(k,1259) = lu(k,1259) * lu(k,1252) + lu(k,1260) = lu(k,1260) * lu(k,1252) + lu(k,1261) = lu(k,1261) * lu(k,1252) + lu(k,1262) = lu(k,1262) * lu(k,1252) + lu(k,1263) = lu(k,1263) * lu(k,1252) + lu(k,1264) = lu(k,1264) * lu(k,1252) + lu(k,1569) = lu(k,1569) - lu(k,1253) * lu(k,1564) + lu(k,1573) = - lu(k,1254) * lu(k,1564) + lu(k,1574) = - lu(k,1255) * lu(k,1564) + lu(k,1577) = - lu(k,1256) * lu(k,1564) + lu(k,1580) = - lu(k,1257) * lu(k,1564) + lu(k,1581) = lu(k,1581) - lu(k,1258) * lu(k,1564) + lu(k,1582) = lu(k,1582) - lu(k,1259) * lu(k,1564) + lu(k,1586) = lu(k,1586) - lu(k,1260) * lu(k,1564) + lu(k,1590) = lu(k,1590) - lu(k,1261) * lu(k,1564) + lu(k,1591) = lu(k,1591) - lu(k,1262) * lu(k,1564) + lu(k,1592) = lu(k,1592) - lu(k,1263) * lu(k,1564) + lu(k,1595) = lu(k,1595) - lu(k,1264) * lu(k,1564) + lu(k,2162) = - lu(k,1253) * lu(k,2156) + lu(k,2165) = lu(k,2165) - lu(k,1254) * lu(k,2156) + lu(k,2166) = lu(k,2166) - lu(k,1255) * lu(k,2156) + lu(k,2169) = lu(k,2169) - lu(k,1256) * lu(k,2156) + lu(k,2172) = - lu(k,1257) * lu(k,2156) + lu(k,2173) = lu(k,2173) - lu(k,1258) * lu(k,2156) + lu(k,2176) = lu(k,2176) - lu(k,1259) * lu(k,2156) + lu(k,2184) = lu(k,2184) - lu(k,1260) * lu(k,2156) + lu(k,2188) = lu(k,2188) - lu(k,1261) * lu(k,2156) + lu(k,2189) = lu(k,2189) - lu(k,1262) * lu(k,2156) + lu(k,2192) = lu(k,2192) - lu(k,1263) * lu(k,2156) + lu(k,2195) = lu(k,2195) - lu(k,1264) * lu(k,2156) + lu(k,3397) = - lu(k,1253) * lu(k,3388) + lu(k,3404) = lu(k,3404) - lu(k,1254) * lu(k,3388) + lu(k,3406) = - lu(k,1255) * lu(k,3388) + lu(k,3414) = lu(k,3414) - lu(k,1256) * lu(k,3388) + lu(k,3421) = - lu(k,1257) * lu(k,3388) + lu(k,3422) = lu(k,3422) - lu(k,1258) * lu(k,3388) + lu(k,3427) = lu(k,3427) - lu(k,1259) * lu(k,3388) + lu(k,3457) = - lu(k,1260) * lu(k,3388) + lu(k,3461) = lu(k,3461) - lu(k,1261) * lu(k,3388) + lu(k,3462) = lu(k,3462) - lu(k,1262) * lu(k,3388) + lu(k,3467) = lu(k,3467) - lu(k,1263) * lu(k,3388) + lu(k,3471) = lu(k,3471) - lu(k,1264) * lu(k,3388) + lu(k,4022) = lu(k,4022) - lu(k,1253) * lu(k,4004) + lu(k,4033) = lu(k,4033) - lu(k,1254) * lu(k,4004) + lu(k,4035) = lu(k,4035) - lu(k,1255) * lu(k,4004) + lu(k,4044) = lu(k,4044) - lu(k,1256) * lu(k,4004) + lu(k,4051) = lu(k,4051) - lu(k,1257) * lu(k,4004) + lu(k,4052) = lu(k,4052) - lu(k,1258) * lu(k,4004) + lu(k,4057) = lu(k,4057) - lu(k,1259) * lu(k,4004) + lu(k,4087) = lu(k,4087) - lu(k,1260) * lu(k,4004) + lu(k,4091) = lu(k,4091) - lu(k,1261) * lu(k,4004) + lu(k,4092) = lu(k,4092) - lu(k,1262) * lu(k,4004) + lu(k,4097) = lu(k,4097) - lu(k,1263) * lu(k,4004) + lu(k,4101) = lu(k,4101) - lu(k,1264) * lu(k,4004) + lu(k,1272) = 1._r8 / lu(k,1272) + lu(k,1273) = lu(k,1273) * lu(k,1272) + lu(k,1274) = lu(k,1274) * lu(k,1272) + lu(k,1275) = lu(k,1275) * lu(k,1272) + lu(k,1276) = lu(k,1276) * lu(k,1272) + lu(k,1277) = lu(k,1277) * lu(k,1272) + lu(k,1278) = lu(k,1278) * lu(k,1272) + lu(k,1279) = lu(k,1279) * lu(k,1272) + lu(k,1280) = lu(k,1280) * lu(k,1272) + lu(k,1281) = lu(k,1281) * lu(k,1272) + lu(k,1282) = lu(k,1282) * lu(k,1272) + lu(k,1283) = lu(k,1283) * lu(k,1272) + lu(k,1284) = lu(k,1284) * lu(k,1272) + lu(k,1285) = lu(k,1285) * lu(k,1272) + lu(k,1286) = lu(k,1286) * lu(k,1272) + lu(k,1287) = lu(k,1287) * lu(k,1272) + lu(k,1288) = lu(k,1288) * lu(k,1272) + lu(k,3539) = lu(k,3539) - lu(k,1273) * lu(k,3538) + lu(k,3546) = lu(k,3546) - lu(k,1274) * lu(k,3538) + lu(k,3551) = lu(k,3551) - lu(k,1275) * lu(k,3538) + lu(k,3570) = lu(k,3570) - lu(k,1276) * lu(k,3538) + lu(k,3580) = lu(k,3580) - lu(k,1277) * lu(k,3538) + lu(k,3583) = lu(k,3583) - lu(k,1278) * lu(k,3538) + lu(k,3586) = lu(k,3586) - lu(k,1279) * lu(k,3538) + lu(k,3593) = lu(k,3593) - lu(k,1280) * lu(k,3538) + lu(k,3595) = lu(k,3595) - lu(k,1281) * lu(k,3538) + lu(k,3596) = lu(k,3596) - lu(k,1282) * lu(k,3538) + lu(k,3598) = lu(k,3598) - lu(k,1283) * lu(k,3538) + lu(k,3605) = lu(k,3605) - lu(k,1284) * lu(k,3538) + lu(k,3606) = lu(k,3606) - lu(k,1285) * lu(k,3538) + lu(k,3610) = lu(k,3610) - lu(k,1286) * lu(k,3538) + lu(k,3612) = lu(k,3612) - lu(k,1287) * lu(k,3538) + lu(k,3615) = lu(k,3615) - lu(k,1288) * lu(k,3538) + lu(k,3693) = lu(k,3693) - lu(k,1273) * lu(k,3692) + lu(k,3702) = lu(k,3702) - lu(k,1274) * lu(k,3692) + lu(k,3706) = lu(k,3706) - lu(k,1275) * lu(k,3692) + lu(k,3726) = lu(k,3726) - lu(k,1276) * lu(k,3692) + lu(k,3735) = - lu(k,1277) * lu(k,3692) + lu(k,3737) = lu(k,3737) - lu(k,1278) * lu(k,3692) + lu(k,3740) = - lu(k,1279) * lu(k,3692) + lu(k,3747) = lu(k,3747) - lu(k,1280) * lu(k,3692) + lu(k,3749) = lu(k,3749) - lu(k,1281) * lu(k,3692) + lu(k,3750) = lu(k,3750) - lu(k,1282) * lu(k,3692) + lu(k,3752) = lu(k,3752) - lu(k,1283) * lu(k,3692) + lu(k,3759) = lu(k,3759) - lu(k,1284) * lu(k,3692) + lu(k,3760) = lu(k,3760) - lu(k,1285) * lu(k,3692) + lu(k,3764) = lu(k,3764) - lu(k,1286) * lu(k,3692) + lu(k,3766) = lu(k,3766) - lu(k,1287) * lu(k,3692) + lu(k,3769) = lu(k,3769) - lu(k,1288) * lu(k,3692) + lu(k,4006) = lu(k,4006) - lu(k,1273) * lu(k,4005) + lu(k,4023) = lu(k,4023) - lu(k,1274) * lu(k,4005) + lu(k,4033) = lu(k,4033) - lu(k,1275) * lu(k,4005) + lu(k,4057) = lu(k,4057) - lu(k,1276) * lu(k,4005) + lu(k,4066) = - lu(k,1277) * lu(k,4005) + lu(k,4069) = lu(k,4069) - lu(k,1278) * lu(k,4005) + lu(k,4072) = lu(k,4072) - lu(k,1279) * lu(k,4005) + lu(k,4079) = lu(k,4079) - lu(k,1280) * lu(k,4005) + lu(k,4081) = lu(k,4081) - lu(k,1281) * lu(k,4005) + lu(k,4082) = lu(k,4082) - lu(k,1282) * lu(k,4005) + lu(k,4084) = lu(k,4084) - lu(k,1283) * lu(k,4005) + lu(k,4091) = lu(k,4091) - lu(k,1284) * lu(k,4005) + lu(k,4092) = lu(k,4092) - lu(k,1285) * lu(k,4005) + lu(k,4096) = lu(k,4096) - lu(k,1286) * lu(k,4005) + lu(k,4098) = lu(k,4098) - lu(k,1287) * lu(k,4005) + lu(k,4101) = lu(k,4101) - lu(k,1288) * lu(k,4005) + lu(k,1289) = 1._r8 / lu(k,1289) + lu(k,1290) = lu(k,1290) * lu(k,1289) + lu(k,1291) = lu(k,1291) * lu(k,1289) + lu(k,1292) = lu(k,1292) * lu(k,1289) + lu(k,1293) = lu(k,1293) * lu(k,1289) + lu(k,1294) = lu(k,1294) * lu(k,1289) + lu(k,1295) = lu(k,1295) * lu(k,1289) + lu(k,1296) = lu(k,1296) * lu(k,1289) + lu(k,2652) = - lu(k,1290) * lu(k,2648) + lu(k,2656) = lu(k,2656) - lu(k,1291) * lu(k,2648) + lu(k,2657) = lu(k,2657) - lu(k,1292) * lu(k,2648) + lu(k,2661) = - lu(k,1293) * lu(k,2648) + lu(k,2665) = lu(k,2665) - lu(k,1294) * lu(k,2648) + lu(k,2667) = lu(k,2667) - lu(k,1295) * lu(k,2648) + lu(k,2669) = lu(k,2669) - lu(k,1296) * lu(k,2648) + lu(k,2818) = lu(k,2818) - lu(k,1290) * lu(k,2811) + lu(k,2837) = lu(k,2837) - lu(k,1291) * lu(k,2811) + lu(k,2838) = lu(k,2838) - lu(k,1292) * lu(k,2811) + lu(k,2842) = - lu(k,1293) * lu(k,2811) + lu(k,2847) = lu(k,2847) - lu(k,1294) * lu(k,2811) + lu(k,2849) = lu(k,2849) - lu(k,1295) * lu(k,2811) + lu(k,2853) = lu(k,2853) - lu(k,1296) * lu(k,2811) + lu(k,3427) = lu(k,3427) - lu(k,1290) * lu(k,3389) + lu(k,3451) = lu(k,3451) - lu(k,1291) * lu(k,3389) + lu(k,3452) = lu(k,3452) - lu(k,1292) * lu(k,3389) + lu(k,3457) = lu(k,3457) - lu(k,1293) * lu(k,3389) + lu(k,3462) = lu(k,3462) - lu(k,1294) * lu(k,3389) + lu(k,3466) = - lu(k,1295) * lu(k,3389) + lu(k,3471) = lu(k,3471) - lu(k,1296) * lu(k,3389) + lu(k,3570) = lu(k,3570) - lu(k,1290) * lu(k,3539) + lu(k,3595) = lu(k,3595) - lu(k,1291) * lu(k,3539) + lu(k,3596) = lu(k,3596) - lu(k,1292) * lu(k,3539) + lu(k,3601) = lu(k,3601) - lu(k,1293) * lu(k,3539) + lu(k,3606) = lu(k,3606) - lu(k,1294) * lu(k,3539) + lu(k,3610) = lu(k,3610) - lu(k,1295) * lu(k,3539) + lu(k,3615) = lu(k,3615) - lu(k,1296) * lu(k,3539) + lu(k,3644) = lu(k,3644) - lu(k,1290) * lu(k,3636) + lu(k,3647) = - lu(k,1291) * lu(k,3636) + lu(k,3648) = lu(k,3648) - lu(k,1292) * lu(k,3636) + lu(k,3653) = lu(k,3653) - lu(k,1293) * lu(k,3636) + lu(k,3658) = lu(k,3658) - lu(k,1294) * lu(k,3636) + lu(k,3662) = lu(k,3662) - lu(k,1295) * lu(k,3636) + lu(k,3667) = lu(k,3667) - lu(k,1296) * lu(k,3636) + lu(k,3726) = lu(k,3726) - lu(k,1290) * lu(k,3693) + lu(k,3749) = lu(k,3749) - lu(k,1291) * lu(k,3693) + lu(k,3750) = lu(k,3750) - lu(k,1292) * lu(k,3693) + lu(k,3755) = - lu(k,1293) * lu(k,3693) + lu(k,3760) = lu(k,3760) - lu(k,1294) * lu(k,3693) + lu(k,3764) = lu(k,3764) - lu(k,1295) * lu(k,3693) + lu(k,3769) = lu(k,3769) - lu(k,1296) * lu(k,3693) + lu(k,4057) = lu(k,4057) - lu(k,1290) * lu(k,4006) + lu(k,4081) = lu(k,4081) - lu(k,1291) * lu(k,4006) + lu(k,4082) = lu(k,4082) - lu(k,1292) * lu(k,4006) + lu(k,4087) = lu(k,4087) - lu(k,1293) * lu(k,4006) + lu(k,4092) = lu(k,4092) - lu(k,1294) * lu(k,4006) + lu(k,4096) = lu(k,4096) - lu(k,1295) * lu(k,4006) + lu(k,4101) = lu(k,4101) - lu(k,1296) * lu(k,4006) + end do + end subroutine lu_fac28 + subroutine lu_fac29( 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,1298) = 1._r8 / lu(k,1298) + lu(k,1299) = lu(k,1299) * lu(k,1298) + lu(k,1300) = lu(k,1300) * lu(k,1298) + lu(k,1301) = lu(k,1301) * lu(k,1298) + lu(k,1302) = lu(k,1302) * lu(k,1298) + lu(k,1303) = lu(k,1303) * lu(k,1298) + lu(k,1304) = lu(k,1304) * lu(k,1298) + lu(k,1305) = lu(k,1305) * lu(k,1298) + lu(k,1306) = lu(k,1306) * lu(k,1298) + lu(k,1307) = lu(k,1307) * lu(k,1298) + lu(k,1308) = lu(k,1308) * lu(k,1298) + lu(k,1523) = - lu(k,1299) * lu(k,1522) + lu(k,1526) = - lu(k,1300) * lu(k,1522) + lu(k,1527) = lu(k,1527) - lu(k,1301) * lu(k,1522) + lu(k,1528) = - lu(k,1302) * lu(k,1522) + lu(k,1529) = lu(k,1529) - lu(k,1303) * lu(k,1522) + lu(k,1530) = lu(k,1530) - lu(k,1304) * lu(k,1522) + lu(k,1531) = - lu(k,1305) * lu(k,1522) + lu(k,1533) = lu(k,1533) - lu(k,1306) * lu(k,1522) + lu(k,1534) = - lu(k,1307) * lu(k,1522) + lu(k,1535) = lu(k,1535) - lu(k,1308) * lu(k,1522) + lu(k,1867) = - lu(k,1299) * lu(k,1866) + lu(k,1869) = lu(k,1869) - lu(k,1300) * lu(k,1866) + lu(k,1870) = lu(k,1870) - lu(k,1301) * lu(k,1866) + lu(k,1871) = - lu(k,1302) * lu(k,1866) + lu(k,1874) = lu(k,1874) - lu(k,1303) * lu(k,1866) + lu(k,1875) = lu(k,1875) - lu(k,1304) * lu(k,1866) + lu(k,1877) = - lu(k,1305) * lu(k,1866) + lu(k,1880) = lu(k,1880) - lu(k,1306) * lu(k,1866) + lu(k,1881) = - lu(k,1307) * lu(k,1866) + lu(k,1882) = lu(k,1882) - lu(k,1308) * lu(k,1866) + lu(k,3042) = lu(k,3042) - lu(k,1299) * lu(k,3031) + lu(k,3057) = lu(k,3057) - lu(k,1300) * lu(k,3031) + lu(k,3061) = lu(k,3061) - lu(k,1301) * lu(k,3031) + lu(k,3063) = lu(k,3063) - lu(k,1302) * lu(k,3031) + lu(k,3069) = lu(k,3069) - lu(k,1303) * lu(k,3031) + lu(k,3074) = lu(k,3074) - lu(k,1304) * lu(k,3031) + lu(k,3106) = lu(k,3106) - lu(k,1305) * lu(k,3031) + lu(k,3110) = lu(k,3110) - lu(k,1306) * lu(k,3031) + lu(k,3115) = lu(k,3115) - lu(k,1307) * lu(k,3031) + lu(k,3119) = lu(k,3119) - lu(k,1308) * lu(k,3031) + lu(k,3299) = lu(k,3299) - lu(k,1299) * lu(k,3288) + lu(k,3316) = lu(k,3316) - lu(k,1300) * lu(k,3288) + lu(k,3320) = lu(k,3320) - lu(k,1301) * lu(k,3288) + lu(k,3322) = lu(k,3322) - lu(k,1302) * lu(k,3288) + lu(k,3328) = lu(k,3328) - lu(k,1303) * lu(k,3288) + lu(k,3333) = lu(k,3333) - lu(k,1304) * lu(k,3288) + lu(k,3365) = lu(k,3365) - lu(k,1305) * lu(k,3288) + lu(k,3369) = lu(k,3369) - lu(k,1306) * lu(k,3288) + lu(k,3374) = lu(k,3374) - lu(k,1307) * lu(k,3288) + lu(k,3378) = lu(k,3378) - lu(k,1308) * lu(k,3288) + lu(k,4021) = lu(k,4021) - lu(k,1299) * lu(k,4007) + lu(k,4040) = lu(k,4040) - lu(k,1300) * lu(k,4007) + lu(k,4044) = lu(k,4044) - lu(k,1301) * lu(k,4007) + lu(k,4046) = lu(k,4046) - lu(k,1302) * lu(k,4007) + lu(k,4052) = lu(k,4052) - lu(k,1303) * lu(k,4007) + lu(k,4057) = lu(k,4057) - lu(k,1304) * lu(k,4007) + lu(k,4088) = lu(k,4088) - lu(k,1305) * lu(k,4007) + lu(k,4092) = lu(k,4092) - lu(k,1306) * lu(k,4007) + lu(k,4097) = lu(k,4097) - lu(k,1307) * lu(k,4007) + lu(k,4101) = lu(k,4101) - lu(k,1308) * lu(k,4007) + lu(k,1309) = 1._r8 / lu(k,1309) + lu(k,1310) = lu(k,1310) * lu(k,1309) + lu(k,1311) = lu(k,1311) * lu(k,1309) + lu(k,1312) = lu(k,1312) * lu(k,1309) + lu(k,1313) = lu(k,1313) * lu(k,1309) + lu(k,1314) = lu(k,1314) * lu(k,1309) + lu(k,1315) = lu(k,1315) * lu(k,1309) + lu(k,1316) = lu(k,1316) * lu(k,1309) + lu(k,1317) = lu(k,1317) * lu(k,1309) + lu(k,1318) = lu(k,1318) * lu(k,1309) + lu(k,1319) = lu(k,1319) * lu(k,1309) + lu(k,1320) = lu(k,1320) * lu(k,1309) + lu(k,1321) = lu(k,1321) * lu(k,1309) + lu(k,1322) = lu(k,1322) * lu(k,1309) + lu(k,2160) = - lu(k,1310) * lu(k,2157) + lu(k,2161) = - lu(k,1311) * lu(k,2157) + lu(k,2162) = lu(k,2162) - lu(k,1312) * lu(k,2157) + lu(k,2167) = lu(k,2167) - lu(k,1313) * lu(k,2157) + lu(k,2168) = - lu(k,1314) * lu(k,2157) + lu(k,2169) = lu(k,2169) - lu(k,1315) * lu(k,2157) + lu(k,2170) = - lu(k,1316) * lu(k,2157) + lu(k,2172) = lu(k,2172) - lu(k,1317) * lu(k,2157) + lu(k,2185) = lu(k,2185) - lu(k,1318) * lu(k,2157) + lu(k,2188) = lu(k,2188) - lu(k,1319) * lu(k,2157) + lu(k,2189) = lu(k,2189) - lu(k,1320) * lu(k,2157) + lu(k,2192) = lu(k,2192) - lu(k,1321) * lu(k,2157) + lu(k,2195) = lu(k,2195) - lu(k,1322) * lu(k,2157) + lu(k,3039) = lu(k,3039) - lu(k,1310) * lu(k,3032) + lu(k,3041) = lu(k,3041) - lu(k,1311) * lu(k,3032) + lu(k,3043) = lu(k,3043) - lu(k,1312) * lu(k,3032) + lu(k,3054) = lu(k,3054) - lu(k,1313) * lu(k,3032) + lu(k,3057) = lu(k,3057) - lu(k,1314) * lu(k,3032) + lu(k,3061) = lu(k,3061) - lu(k,1315) * lu(k,3032) + lu(k,3062) = lu(k,3062) - lu(k,1316) * lu(k,3032) + lu(k,3068) = lu(k,3068) - lu(k,1317) * lu(k,3032) + lu(k,3106) = lu(k,3106) - lu(k,1318) * lu(k,3032) + lu(k,3109) = lu(k,3109) - lu(k,1319) * lu(k,3032) + lu(k,3110) = lu(k,3110) - lu(k,1320) * lu(k,3032) + lu(k,3115) = lu(k,3115) - lu(k,1321) * lu(k,3032) + lu(k,3119) = lu(k,3119) - lu(k,1322) * lu(k,3032) + lu(k,3296) = lu(k,3296) - lu(k,1310) * lu(k,3289) + lu(k,3298) = lu(k,3298) - lu(k,1311) * lu(k,3289) + lu(k,3300) = lu(k,3300) - lu(k,1312) * lu(k,3289) + lu(k,3312) = lu(k,3312) - lu(k,1313) * lu(k,3289) + lu(k,3316) = lu(k,3316) - lu(k,1314) * lu(k,3289) + lu(k,3320) = lu(k,3320) - lu(k,1315) * lu(k,3289) + lu(k,3321) = lu(k,3321) - lu(k,1316) * lu(k,3289) + lu(k,3327) = lu(k,3327) - lu(k,1317) * lu(k,3289) + lu(k,3365) = lu(k,3365) - lu(k,1318) * lu(k,3289) + lu(k,3368) = lu(k,3368) - lu(k,1319) * lu(k,3289) + lu(k,3369) = lu(k,3369) - lu(k,1320) * lu(k,3289) + lu(k,3374) = lu(k,3374) - lu(k,1321) * lu(k,3289) + lu(k,3378) = lu(k,3378) - lu(k,1322) * lu(k,3289) + lu(k,4018) = lu(k,4018) - lu(k,1310) * lu(k,4008) + lu(k,4020) = lu(k,4020) - lu(k,1311) * lu(k,4008) + lu(k,4022) = lu(k,4022) - lu(k,1312) * lu(k,4008) + lu(k,4036) = lu(k,4036) - lu(k,1313) * lu(k,4008) + lu(k,4040) = lu(k,4040) - lu(k,1314) * lu(k,4008) + lu(k,4044) = lu(k,4044) - lu(k,1315) * lu(k,4008) + lu(k,4045) = lu(k,4045) - lu(k,1316) * lu(k,4008) + lu(k,4051) = lu(k,4051) - lu(k,1317) * lu(k,4008) + lu(k,4088) = lu(k,4088) - lu(k,1318) * lu(k,4008) + lu(k,4091) = lu(k,4091) - lu(k,1319) * lu(k,4008) + lu(k,4092) = lu(k,4092) - lu(k,1320) * lu(k,4008) + lu(k,4097) = lu(k,4097) - lu(k,1321) * lu(k,4008) + lu(k,4101) = lu(k,4101) - lu(k,1322) * lu(k,4008) + lu(k,1325) = 1._r8 / lu(k,1325) + lu(k,1326) = lu(k,1326) * lu(k,1325) + lu(k,1327) = lu(k,1327) * lu(k,1325) + lu(k,1328) = lu(k,1328) * lu(k,1325) + lu(k,1329) = lu(k,1329) * lu(k,1325) + lu(k,1330) = lu(k,1330) * lu(k,1325) + lu(k,1331) = lu(k,1331) * lu(k,1325) + lu(k,1332) = lu(k,1332) * lu(k,1325) + lu(k,1333) = lu(k,1333) * lu(k,1325) + lu(k,1334) = lu(k,1334) * lu(k,1325) + lu(k,3128) = lu(k,3128) - lu(k,1326) * lu(k,3125) + lu(k,3129) = lu(k,3129) - lu(k,1327) * lu(k,3125) + lu(k,3130) = lu(k,3130) - lu(k,1328) * lu(k,3125) + lu(k,3135) = lu(k,3135) - lu(k,1329) * lu(k,3125) + lu(k,3136) = - lu(k,1330) * lu(k,3125) + lu(k,3137) = - lu(k,1331) * lu(k,3125) + lu(k,3140) = lu(k,3140) - lu(k,1332) * lu(k,3125) + lu(k,3141) = lu(k,3141) - lu(k,1333) * lu(k,3125) + lu(k,3142) = lu(k,3142) - lu(k,1334) * lu(k,3125) + lu(k,3158) = lu(k,3158) - lu(k,1326) * lu(k,3150) + lu(k,3160) = lu(k,3160) - lu(k,1327) * lu(k,3150) + lu(k,3161) = lu(k,3161) - lu(k,1328) * lu(k,3150) + lu(k,3166) = lu(k,3166) - lu(k,1329) * lu(k,3150) + lu(k,3167) = lu(k,3167) - lu(k,1330) * lu(k,3150) + lu(k,3168) = lu(k,3168) - lu(k,1331) * lu(k,3150) + lu(k,3171) = lu(k,3171) - lu(k,1332) * lu(k,3150) + lu(k,3172) = lu(k,3172) - lu(k,1333) * lu(k,3150) + lu(k,3173) = lu(k,3173) - lu(k,1334) * lu(k,3150) + lu(k,3507) = - lu(k,1326) * lu(k,3503) + lu(k,3509) = lu(k,3509) - lu(k,1327) * lu(k,3503) + lu(k,3510) = lu(k,3510) - lu(k,1328) * lu(k,3503) + lu(k,3515) = lu(k,3515) - lu(k,1329) * lu(k,3503) + lu(k,3516) = - lu(k,1330) * lu(k,3503) + lu(k,3517) = lu(k,3517) - lu(k,1331) * lu(k,3503) + lu(k,3520) = lu(k,3520) - lu(k,1332) * lu(k,3503) + lu(k,3521) = lu(k,3521) - lu(k,1333) * lu(k,3503) + lu(k,3522) = lu(k,3522) - lu(k,1334) * lu(k,3503) + lu(k,3653) = lu(k,3653) - lu(k,1326) * lu(k,3637) + lu(k,3655) = lu(k,3655) - lu(k,1327) * lu(k,3637) + lu(k,3656) = lu(k,3656) - lu(k,1328) * lu(k,3637) + lu(k,3661) = lu(k,3661) - lu(k,1329) * lu(k,3637) + lu(k,3662) = lu(k,3662) - lu(k,1330) * lu(k,3637) + lu(k,3663) = lu(k,3663) - lu(k,1331) * lu(k,3637) + lu(k,3666) = lu(k,3666) - lu(k,1332) * lu(k,3637) + lu(k,3667) = lu(k,3667) - lu(k,1333) * lu(k,3637) + lu(k,3668) = lu(k,3668) - lu(k,1334) * lu(k,3637) + lu(k,3837) = - lu(k,1326) * lu(k,3822) + lu(k,3839) = lu(k,3839) - lu(k,1327) * lu(k,3822) + lu(k,3840) = lu(k,3840) - lu(k,1328) * lu(k,3822) + lu(k,3845) = lu(k,3845) - lu(k,1329) * lu(k,3822) + lu(k,3846) = lu(k,3846) - lu(k,1330) * lu(k,3822) + lu(k,3847) = lu(k,3847) - lu(k,1331) * lu(k,3822) + lu(k,3850) = lu(k,3850) - lu(k,1332) * lu(k,3822) + lu(k,3851) = lu(k,3851) - lu(k,1333) * lu(k,3822) + lu(k,3852) = lu(k,3852) - lu(k,1334) * lu(k,3822) + lu(k,4087) = lu(k,4087) - lu(k,1326) * lu(k,4009) + lu(k,4089) = lu(k,4089) - lu(k,1327) * lu(k,4009) + lu(k,4090) = lu(k,4090) - lu(k,1328) * lu(k,4009) + lu(k,4095) = lu(k,4095) - lu(k,1329) * lu(k,4009) + lu(k,4096) = lu(k,4096) - lu(k,1330) * lu(k,4009) + lu(k,4097) = lu(k,4097) - lu(k,1331) * lu(k,4009) + lu(k,4100) = lu(k,4100) - lu(k,1332) * lu(k,4009) + lu(k,4101) = lu(k,4101) - lu(k,1333) * lu(k,4009) + lu(k,4102) = lu(k,4102) - lu(k,1334) * lu(k,4009) + end do + end subroutine lu_fac29 + subroutine lu_fac30( 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,1336) = 1._r8 / lu(k,1336) + lu(k,1337) = lu(k,1337) * lu(k,1336) + lu(k,1338) = lu(k,1338) * lu(k,1336) + lu(k,1339) = lu(k,1339) * lu(k,1336) + lu(k,1340) = lu(k,1340) * lu(k,1336) + lu(k,1341) = lu(k,1341) * lu(k,1336) + lu(k,1342) = lu(k,1342) * lu(k,1336) + lu(k,1343) = lu(k,1343) * lu(k,1336) + lu(k,1344) = lu(k,1344) * lu(k,1336) + lu(k,1345) = lu(k,1345) * lu(k,1336) + lu(k,1346) = lu(k,1346) * lu(k,1336) + lu(k,1347) = lu(k,1347) * lu(k,1336) + lu(k,2273) = - lu(k,1337) * lu(k,2272) + lu(k,2274) = - lu(k,1338) * lu(k,2272) + lu(k,2275) = - lu(k,1339) * lu(k,2272) + lu(k,2278) = lu(k,2278) - lu(k,1340) * lu(k,2272) + lu(k,2280) = - lu(k,1341) * lu(k,2272) + lu(k,2282) = - lu(k,1342) * lu(k,2272) + lu(k,2283) = - lu(k,1343) * lu(k,2272) + lu(k,2284) = lu(k,2284) - lu(k,1344) * lu(k,2272) + lu(k,2286) = - lu(k,1345) * lu(k,2272) + lu(k,2287) = lu(k,2287) - lu(k,1346) * lu(k,2272) + lu(k,2288) = lu(k,2288) - lu(k,1347) * lu(k,2272) + lu(k,3044) = - lu(k,1337) * lu(k,3033) + lu(k,3061) = lu(k,3061) - lu(k,1338) * lu(k,3033) + lu(k,3069) = lu(k,3069) - lu(k,1339) * lu(k,3033) + lu(k,3103) = lu(k,3103) - lu(k,1340) * lu(k,3033) + lu(k,3106) = lu(k,3106) - lu(k,1341) * lu(k,3033) + lu(k,3109) = lu(k,3109) - lu(k,1342) * lu(k,3033) + lu(k,3110) = lu(k,3110) - lu(k,1343) * lu(k,3033) + lu(k,3111) = lu(k,3111) - lu(k,1344) * lu(k,3033) + lu(k,3115) = lu(k,3115) - lu(k,1345) * lu(k,3033) + lu(k,3119) = lu(k,3119) - lu(k,1346) * lu(k,3033) + lu(k,3120) = lu(k,3120) - lu(k,1347) * lu(k,3033) + lu(k,3302) = - lu(k,1337) * lu(k,3290) + lu(k,3320) = lu(k,3320) - lu(k,1338) * lu(k,3290) + lu(k,3328) = lu(k,3328) - lu(k,1339) * lu(k,3290) + lu(k,3362) = lu(k,3362) - lu(k,1340) * lu(k,3290) + lu(k,3365) = lu(k,3365) - lu(k,1341) * lu(k,3290) + lu(k,3368) = lu(k,3368) - lu(k,1342) * lu(k,3290) + lu(k,3369) = lu(k,3369) - lu(k,1343) * lu(k,3290) + lu(k,3370) = lu(k,3370) - lu(k,1344) * lu(k,3290) + lu(k,3374) = lu(k,3374) - lu(k,1345) * lu(k,3290) + lu(k,3378) = lu(k,3378) - lu(k,1346) * lu(k,3290) + lu(k,3379) = lu(k,3379) - lu(k,1347) * lu(k,3290) + lu(k,3398) = lu(k,3398) - lu(k,1337) * lu(k,3390) + lu(k,3414) = lu(k,3414) - lu(k,1338) * lu(k,3390) + lu(k,3422) = lu(k,3422) - lu(k,1339) * lu(k,3390) + lu(k,3455) = lu(k,3455) - lu(k,1340) * lu(k,3390) + lu(k,3458) = lu(k,3458) - lu(k,1341) * lu(k,3390) + lu(k,3461) = lu(k,3461) - lu(k,1342) * lu(k,3390) + lu(k,3462) = lu(k,3462) - lu(k,1343) * lu(k,3390) + lu(k,3463) = lu(k,3463) - lu(k,1344) * lu(k,3390) + lu(k,3467) = lu(k,3467) - lu(k,1345) * lu(k,3390) + lu(k,3471) = lu(k,3471) - lu(k,1346) * lu(k,3390) + lu(k,3472) = lu(k,3472) - lu(k,1347) * lu(k,3390) + lu(k,4024) = lu(k,4024) - lu(k,1337) * lu(k,4010) + lu(k,4044) = lu(k,4044) - lu(k,1338) * lu(k,4010) + lu(k,4052) = lu(k,4052) - lu(k,1339) * lu(k,4010) + lu(k,4085) = lu(k,4085) - lu(k,1340) * lu(k,4010) + lu(k,4088) = lu(k,4088) - lu(k,1341) * lu(k,4010) + lu(k,4091) = lu(k,4091) - lu(k,1342) * lu(k,4010) + lu(k,4092) = lu(k,4092) - lu(k,1343) * lu(k,4010) + lu(k,4093) = lu(k,4093) - lu(k,1344) * lu(k,4010) + lu(k,4097) = lu(k,4097) - lu(k,1345) * lu(k,4010) + lu(k,4101) = lu(k,4101) - lu(k,1346) * lu(k,4010) + lu(k,4102) = lu(k,4102) - lu(k,1347) * lu(k,4010) + lu(k,1350) = 1._r8 / lu(k,1350) + lu(k,1351) = lu(k,1351) * lu(k,1350) + lu(k,1352) = lu(k,1352) * lu(k,1350) + lu(k,1353) = lu(k,1353) * lu(k,1350) + lu(k,1354) = lu(k,1354) * lu(k,1350) + lu(k,1355) = lu(k,1355) * lu(k,1350) + lu(k,1356) = lu(k,1356) * lu(k,1350) + lu(k,1357) = lu(k,1357) * lu(k,1350) + lu(k,1358) = lu(k,1358) * lu(k,1350) + lu(k,3037) = lu(k,3037) - lu(k,1351) * lu(k,3034) + lu(k,3044) = lu(k,3044) - lu(k,1352) * lu(k,3034) + lu(k,3106) = lu(k,3106) - lu(k,1353) * lu(k,3034) + lu(k,3109) = lu(k,3109) - lu(k,1354) * lu(k,3034) + lu(k,3110) = lu(k,3110) - lu(k,1355) * lu(k,3034) + lu(k,3111) = lu(k,3111) - lu(k,1356) * lu(k,3034) + lu(k,3115) = lu(k,3115) - lu(k,1357) * lu(k,3034) + lu(k,3119) = lu(k,3119) - lu(k,1358) * lu(k,3034) + lu(k,3294) = lu(k,3294) - lu(k,1351) * lu(k,3291) + lu(k,3302) = lu(k,3302) - lu(k,1352) * lu(k,3291) + lu(k,3365) = lu(k,3365) - lu(k,1353) * lu(k,3291) + lu(k,3368) = lu(k,3368) - lu(k,1354) * lu(k,3291) + lu(k,3369) = lu(k,3369) - lu(k,1355) * lu(k,3291) + lu(k,3370) = lu(k,3370) - lu(k,1356) * lu(k,3291) + lu(k,3374) = lu(k,3374) - lu(k,1357) * lu(k,3291) + lu(k,3378) = lu(k,3378) - lu(k,1358) * lu(k,3291) + lu(k,3392) = lu(k,3392) - lu(k,1351) * lu(k,3391) + lu(k,3398) = lu(k,3398) - lu(k,1352) * lu(k,3391) + lu(k,3458) = lu(k,3458) - lu(k,1353) * lu(k,3391) + lu(k,3461) = lu(k,3461) - lu(k,1354) * lu(k,3391) + lu(k,3462) = lu(k,3462) - lu(k,1355) * lu(k,3391) + lu(k,3463) = lu(k,3463) - lu(k,1356) * lu(k,3391) + lu(k,3467) = lu(k,3467) - lu(k,1357) * lu(k,3391) + lu(k,3471) = lu(k,3471) - lu(k,1358) * lu(k,3391) + lu(k,3544) = lu(k,3544) - lu(k,1351) * lu(k,3540) + lu(k,3547) = - lu(k,1352) * lu(k,3540) + lu(k,3602) = lu(k,3602) - lu(k,1353) * lu(k,3540) + lu(k,3605) = lu(k,3605) - lu(k,1354) * lu(k,3540) + lu(k,3606) = lu(k,3606) - lu(k,1355) * lu(k,3540) + lu(k,3607) = lu(k,3607) - lu(k,1356) * lu(k,3540) + lu(k,3611) = lu(k,3611) - lu(k,1357) * lu(k,3540) + lu(k,3615) = lu(k,3615) - lu(k,1358) * lu(k,3540) + lu(k,3698) = lu(k,3698) - lu(k,1351) * lu(k,3694) + lu(k,3703) = - lu(k,1352) * lu(k,3694) + lu(k,3756) = lu(k,3756) - lu(k,1353) * lu(k,3694) + lu(k,3759) = lu(k,3759) - lu(k,1354) * lu(k,3694) + lu(k,3760) = lu(k,3760) - lu(k,1355) * lu(k,3694) + lu(k,3761) = lu(k,3761) - lu(k,1356) * lu(k,3694) + lu(k,3765) = lu(k,3765) - lu(k,1357) * lu(k,3694) + lu(k,3769) = lu(k,3769) - lu(k,1358) * lu(k,3694) + lu(k,3825) = - lu(k,1351) * lu(k,3823) + lu(k,3828) = - lu(k,1352) * lu(k,3823) + lu(k,3838) = lu(k,3838) - lu(k,1353) * lu(k,3823) + lu(k,3841) = lu(k,3841) - lu(k,1354) * lu(k,3823) + lu(k,3842) = lu(k,3842) - lu(k,1355) * lu(k,3823) + lu(k,3843) = lu(k,3843) - lu(k,1356) * lu(k,3823) + lu(k,3847) = lu(k,3847) - lu(k,1357) * lu(k,3823) + lu(k,3851) = lu(k,3851) - lu(k,1358) * lu(k,3823) + lu(k,4016) = lu(k,4016) - lu(k,1351) * lu(k,4011) + lu(k,4024) = lu(k,4024) - lu(k,1352) * lu(k,4011) + lu(k,4088) = lu(k,4088) - lu(k,1353) * lu(k,4011) + lu(k,4091) = lu(k,4091) - lu(k,1354) * lu(k,4011) + lu(k,4092) = lu(k,4092) - lu(k,1355) * lu(k,4011) + lu(k,4093) = lu(k,4093) - lu(k,1356) * lu(k,4011) + lu(k,4097) = lu(k,4097) - lu(k,1357) * lu(k,4011) + lu(k,4101) = lu(k,4101) - lu(k,1358) * lu(k,4011) + lu(k,1361) = 1._r8 / lu(k,1361) + lu(k,1362) = lu(k,1362) * lu(k,1361) + lu(k,1363) = lu(k,1363) * lu(k,1361) + lu(k,1364) = lu(k,1364) * lu(k,1361) + lu(k,1365) = lu(k,1365) * lu(k,1361) + lu(k,1366) = lu(k,1366) * lu(k,1361) + lu(k,1367) = lu(k,1367) * lu(k,1361) + lu(k,1368) = lu(k,1368) * lu(k,1361) + lu(k,1369) = lu(k,1369) * lu(k,1361) + lu(k,1370) = lu(k,1370) * lu(k,1361) + lu(k,1371) = lu(k,1371) * lu(k,1361) + lu(k,1372) = lu(k,1372) * lu(k,1361) + lu(k,1373) = lu(k,1373) * lu(k,1361) + lu(k,1374) = lu(k,1374) * lu(k,1361) + lu(k,1375) = lu(k,1375) * lu(k,1361) + lu(k,1376) = lu(k,1376) * lu(k,1361) + lu(k,1566) = lu(k,1566) - lu(k,1362) * lu(k,1565) + lu(k,1567) = - lu(k,1363) * lu(k,1565) + lu(k,1568) = lu(k,1568) - lu(k,1364) * lu(k,1565) + lu(k,1569) = lu(k,1569) - lu(k,1365) * lu(k,1565) + lu(k,1575) = - lu(k,1366) * lu(k,1565) + lu(k,1578) = - lu(k,1367) * lu(k,1565) + lu(k,1580) = lu(k,1580) - lu(k,1368) * lu(k,1565) + lu(k,1581) = lu(k,1581) - lu(k,1369) * lu(k,1565) + lu(k,1582) = lu(k,1582) - lu(k,1370) * lu(k,1565) + lu(k,1585) = lu(k,1585) - lu(k,1371) * lu(k,1565) + lu(k,1587) = - lu(k,1372) * lu(k,1565) + lu(k,1590) = lu(k,1590) - lu(k,1373) * lu(k,1565) + lu(k,1591) = lu(k,1591) - lu(k,1374) * lu(k,1565) + lu(k,1592) = lu(k,1592) - lu(k,1375) * lu(k,1565) + lu(k,1595) = lu(k,1595) - lu(k,1376) * lu(k,1565) + lu(k,3039) = lu(k,3039) - lu(k,1362) * lu(k,3035) + lu(k,3041) = lu(k,3041) - lu(k,1363) * lu(k,3035) + lu(k,3042) = lu(k,3042) - lu(k,1364) * lu(k,3035) + lu(k,3043) = lu(k,3043) - lu(k,1365) * lu(k,3035) + lu(k,3054) = lu(k,3054) - lu(k,1366) * lu(k,3035) + lu(k,3062) = lu(k,3062) - lu(k,1367) * lu(k,3035) + lu(k,3068) = lu(k,3068) - lu(k,1368) * lu(k,3035) + lu(k,3069) = lu(k,3069) - lu(k,1369) * lu(k,3035) + lu(k,3074) = lu(k,3074) - lu(k,1370) * lu(k,3035) + lu(k,3103) = lu(k,3103) - lu(k,1371) * lu(k,3035) + lu(k,3106) = lu(k,3106) - lu(k,1372) * lu(k,3035) + lu(k,3109) = lu(k,3109) - lu(k,1373) * lu(k,3035) + lu(k,3110) = lu(k,3110) - lu(k,1374) * lu(k,3035) + lu(k,3115) = lu(k,3115) - lu(k,1375) * lu(k,3035) + lu(k,3119) = lu(k,3119) - lu(k,1376) * lu(k,3035) + lu(k,3296) = lu(k,3296) - lu(k,1362) * lu(k,3292) + lu(k,3298) = lu(k,3298) - lu(k,1363) * lu(k,3292) + lu(k,3299) = lu(k,3299) - lu(k,1364) * lu(k,3292) + lu(k,3300) = lu(k,3300) - lu(k,1365) * lu(k,3292) + lu(k,3312) = lu(k,3312) - lu(k,1366) * lu(k,3292) + lu(k,3321) = lu(k,3321) - lu(k,1367) * lu(k,3292) + lu(k,3327) = lu(k,3327) - lu(k,1368) * lu(k,3292) + lu(k,3328) = lu(k,3328) - lu(k,1369) * lu(k,3292) + lu(k,3333) = lu(k,3333) - lu(k,1370) * lu(k,3292) + lu(k,3362) = lu(k,3362) - lu(k,1371) * lu(k,3292) + lu(k,3365) = lu(k,3365) - lu(k,1372) * lu(k,3292) + lu(k,3368) = lu(k,3368) - lu(k,1373) * lu(k,3292) + lu(k,3369) = lu(k,3369) - lu(k,1374) * lu(k,3292) + lu(k,3374) = lu(k,3374) - lu(k,1375) * lu(k,3292) + lu(k,3378) = lu(k,3378) - lu(k,1376) * lu(k,3292) + lu(k,4018) = lu(k,4018) - lu(k,1362) * lu(k,4012) + lu(k,4020) = lu(k,4020) - lu(k,1363) * lu(k,4012) + lu(k,4021) = lu(k,4021) - lu(k,1364) * lu(k,4012) + lu(k,4022) = lu(k,4022) - lu(k,1365) * lu(k,4012) + lu(k,4036) = lu(k,4036) - lu(k,1366) * lu(k,4012) + lu(k,4045) = lu(k,4045) - lu(k,1367) * lu(k,4012) + lu(k,4051) = lu(k,4051) - lu(k,1368) * lu(k,4012) + lu(k,4052) = lu(k,4052) - lu(k,1369) * lu(k,4012) + lu(k,4057) = lu(k,4057) - lu(k,1370) * lu(k,4012) + lu(k,4085) = lu(k,4085) - lu(k,1371) * lu(k,4012) + lu(k,4088) = lu(k,4088) - lu(k,1372) * lu(k,4012) + lu(k,4091) = lu(k,4091) - lu(k,1373) * lu(k,4012) + lu(k,4092) = lu(k,4092) - lu(k,1374) * lu(k,4012) + lu(k,4097) = lu(k,4097) - lu(k,1375) * lu(k,4012) + lu(k,4101) = lu(k,4101) - lu(k,1376) * lu(k,4012) + end do + end subroutine lu_fac30 + subroutine lu_fac31( 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,1377) = 1._r8 / lu(k,1377) + lu(k,1378) = lu(k,1378) * lu(k,1377) + lu(k,1379) = lu(k,1379) * lu(k,1377) + lu(k,1380) = lu(k,1380) * lu(k,1377) + lu(k,1381) = lu(k,1381) * lu(k,1377) + lu(k,1388) = lu(k,1388) - lu(k,1378) * lu(k,1384) + lu(k,1394) = lu(k,1394) - lu(k,1379) * lu(k,1384) + lu(k,1399) = lu(k,1399) - lu(k,1380) * lu(k,1384) + lu(k,1400) = lu(k,1400) - lu(k,1381) * lu(k,1384) + lu(k,1412) = lu(k,1412) - lu(k,1378) * lu(k,1409) + lu(k,1425) = lu(k,1425) - lu(k,1379) * lu(k,1409) + lu(k,1429) = lu(k,1429) - lu(k,1380) * lu(k,1409) + lu(k,1430) = lu(k,1430) - lu(k,1381) * lu(k,1409) + lu(k,1845) = lu(k,1845) - lu(k,1378) * lu(k,1841) + lu(k,1861) = lu(k,1861) - lu(k,1379) * lu(k,1841) + lu(k,1864) = lu(k,1864) - lu(k,1380) * lu(k,1841) + lu(k,1865) = - lu(k,1381) * lu(k,1841) + lu(k,2011) = - lu(k,1378) * lu(k,2009) + lu(k,2024) = lu(k,2024) - lu(k,1379) * lu(k,2009) + lu(k,2029) = lu(k,2029) - lu(k,1380) * lu(k,2009) + lu(k,2030) = lu(k,2030) - lu(k,1381) * lu(k,2009) + lu(k,2036) = lu(k,2036) - lu(k,1378) * lu(k,2031) + lu(k,2049) = lu(k,2049) - lu(k,1379) * lu(k,2031) + lu(k,2054) = lu(k,2054) - lu(k,1380) * lu(k,2031) + lu(k,2055) = - lu(k,1381) * lu(k,2031) + lu(k,2165) = lu(k,2165) - lu(k,1378) * lu(k,2158) + lu(k,2189) = lu(k,2189) - lu(k,1379) * lu(k,2158) + lu(k,2195) = lu(k,2195) - lu(k,1380) * lu(k,2158) + lu(k,2196) = - lu(k,1381) * lu(k,2158) + lu(k,2594) = - lu(k,1378) * lu(k,2592) + lu(k,2612) = lu(k,2612) - lu(k,1379) * lu(k,2592) + lu(k,2617) = lu(k,2617) - lu(k,1380) * lu(k,2592) + lu(k,2618) = lu(k,2618) - lu(k,1381) * lu(k,2592) + lu(k,2625) = - lu(k,1378) * lu(k,2622) + lu(k,2640) = lu(k,2640) - lu(k,1379) * lu(k,2622) + lu(k,2645) = lu(k,2645) - lu(k,1380) * lu(k,2622) + lu(k,2646) = lu(k,2646) - lu(k,1381) * lu(k,2622) + lu(k,3051) = lu(k,3051) - lu(k,1378) * lu(k,3036) + lu(k,3110) = lu(k,3110) - lu(k,1379) * lu(k,3036) + lu(k,3119) = lu(k,3119) - lu(k,1380) * lu(k,3036) + lu(k,3120) = lu(k,3120) - lu(k,1381) * lu(k,3036) + lu(k,3178) = - lu(k,1378) * lu(k,3177) + lu(k,3189) = lu(k,3189) - lu(k,1379) * lu(k,3177) + lu(k,3198) = lu(k,3198) - lu(k,1380) * lu(k,3177) + lu(k,3199) = lu(k,3199) - lu(k,1381) * lu(k,3177) + lu(k,3309) = lu(k,3309) - lu(k,1378) * lu(k,3293) + lu(k,3369) = lu(k,3369) - lu(k,1379) * lu(k,3293) + lu(k,3378) = lu(k,3378) - lu(k,1380) * lu(k,3293) + lu(k,3379) = lu(k,3379) - lu(k,1381) * lu(k,3293) + lu(k,3551) = lu(k,3551) - lu(k,1378) * lu(k,3541) + lu(k,3606) = lu(k,3606) - lu(k,1379) * lu(k,3541) + lu(k,3615) = lu(k,3615) - lu(k,1380) * lu(k,3541) + lu(k,3616) = lu(k,3616) - lu(k,1381) * lu(k,3541) + lu(k,3706) = lu(k,3706) - lu(k,1378) * lu(k,3695) + lu(k,3760) = lu(k,3760) - lu(k,1379) * lu(k,3695) + lu(k,3769) = lu(k,3769) - lu(k,1380) * lu(k,3695) + lu(k,3770) = lu(k,3770) - lu(k,1381) * lu(k,3695) + lu(k,3829) = - lu(k,1378) * lu(k,3824) + lu(k,3842) = lu(k,3842) - lu(k,1379) * lu(k,3824) + lu(k,3851) = lu(k,3851) - lu(k,1380) * lu(k,3824) + lu(k,3852) = lu(k,3852) - lu(k,1381) * lu(k,3824) + lu(k,4033) = lu(k,4033) - lu(k,1378) * lu(k,4013) + lu(k,4092) = lu(k,4092) - lu(k,1379) * lu(k,4013) + lu(k,4101) = lu(k,4101) - lu(k,1380) * lu(k,4013) + lu(k,4102) = lu(k,4102) - lu(k,1381) * lu(k,4013) + lu(k,1385) = 1._r8 / lu(k,1385) + lu(k,1386) = lu(k,1386) * lu(k,1385) + lu(k,1387) = lu(k,1387) * lu(k,1385) + lu(k,1388) = lu(k,1388) * lu(k,1385) + lu(k,1389) = lu(k,1389) * lu(k,1385) + lu(k,1390) = lu(k,1390) * lu(k,1385) + lu(k,1391) = lu(k,1391) * lu(k,1385) + lu(k,1392) = lu(k,1392) * lu(k,1385) + lu(k,1393) = lu(k,1393) * lu(k,1385) + lu(k,1394) = lu(k,1394) * lu(k,1385) + lu(k,1395) = lu(k,1395) * lu(k,1385) + lu(k,1396) = lu(k,1396) * lu(k,1385) + lu(k,1397) = lu(k,1397) * lu(k,1385) + lu(k,1398) = lu(k,1398) * lu(k,1385) + lu(k,1399) = lu(k,1399) * lu(k,1385) + lu(k,1400) = lu(k,1400) * lu(k,1385) + lu(k,2033) = lu(k,2033) - lu(k,1386) * lu(k,2032) + lu(k,2034) = - lu(k,1387) * lu(k,2032) + lu(k,2036) = lu(k,2036) - lu(k,1388) * lu(k,2032) + lu(k,2038) = - lu(k,1389) * lu(k,2032) + lu(k,2042) = lu(k,2042) - lu(k,1390) * lu(k,2032) + lu(k,2043) = - lu(k,1391) * lu(k,2032) + lu(k,2046) = - lu(k,1392) * lu(k,2032) + lu(k,2048) = lu(k,2048) - lu(k,1393) * lu(k,2032) + lu(k,2049) = lu(k,2049) - lu(k,1394) * lu(k,2032) + lu(k,2050) = lu(k,2050) - lu(k,1395) * lu(k,2032) + lu(k,2051) = - lu(k,1396) * lu(k,2032) + lu(k,2052) = - lu(k,1397) * lu(k,2032) + lu(k,2053) = lu(k,2053) - lu(k,1398) * lu(k,2032) + lu(k,2054) = lu(k,2054) - lu(k,1399) * lu(k,2032) + lu(k,2055) = lu(k,2055) - lu(k,1400) * lu(k,2032) + lu(k,3544) = lu(k,3544) - lu(k,1386) * lu(k,3542) + lu(k,3545) = lu(k,3545) - lu(k,1387) * lu(k,3542) + lu(k,3551) = lu(k,3551) - lu(k,1388) * lu(k,3542) + lu(k,3559) = lu(k,3559) - lu(k,1389) * lu(k,3542) + lu(k,3570) = lu(k,3570) - lu(k,1390) * lu(k,3542) + lu(k,3578) = - lu(k,1391) * lu(k,3542) + lu(k,3602) = lu(k,3602) - lu(k,1392) * lu(k,3542) + lu(k,3605) = lu(k,3605) - lu(k,1393) * lu(k,3542) + lu(k,3606) = lu(k,3606) - lu(k,1394) * lu(k,3542) + lu(k,3607) = lu(k,3607) - lu(k,1395) * lu(k,3542) + lu(k,3610) = lu(k,3610) - lu(k,1396) * lu(k,3542) + lu(k,3611) = lu(k,3611) - lu(k,1397) * lu(k,3542) + lu(k,3612) = lu(k,3612) - lu(k,1398) * lu(k,3542) + lu(k,3615) = lu(k,3615) - lu(k,1399) * lu(k,3542) + lu(k,3616) = lu(k,3616) - lu(k,1400) * lu(k,3542) + lu(k,3698) = lu(k,3698) - lu(k,1386) * lu(k,3696) + lu(k,3701) = lu(k,3701) - lu(k,1387) * lu(k,3696) + lu(k,3706) = lu(k,3706) - lu(k,1388) * lu(k,3696) + lu(k,3713) = lu(k,3713) - lu(k,1389) * lu(k,3696) + lu(k,3726) = lu(k,3726) - lu(k,1390) * lu(k,3696) + lu(k,3733) = lu(k,3733) - lu(k,1391) * lu(k,3696) + lu(k,3756) = lu(k,3756) - lu(k,1392) * lu(k,3696) + lu(k,3759) = lu(k,3759) - lu(k,1393) * lu(k,3696) + lu(k,3760) = lu(k,3760) - lu(k,1394) * lu(k,3696) + lu(k,3761) = lu(k,3761) - lu(k,1395) * lu(k,3696) + lu(k,3764) = lu(k,3764) - lu(k,1396) * lu(k,3696) + lu(k,3765) = lu(k,3765) - lu(k,1397) * lu(k,3696) + lu(k,3766) = lu(k,3766) - lu(k,1398) * lu(k,3696) + lu(k,3769) = lu(k,3769) - lu(k,1399) * lu(k,3696) + lu(k,3770) = lu(k,3770) - lu(k,1400) * lu(k,3696) + lu(k,4016) = lu(k,4016) - lu(k,1386) * lu(k,4014) + lu(k,4022) = lu(k,4022) - lu(k,1387) * lu(k,4014) + lu(k,4033) = lu(k,4033) - lu(k,1388) * lu(k,4014) + lu(k,4044) = lu(k,4044) - lu(k,1389) * lu(k,4014) + lu(k,4057) = lu(k,4057) - lu(k,1390) * lu(k,4014) + lu(k,4064) = lu(k,4064) - lu(k,1391) * lu(k,4014) + lu(k,4088) = lu(k,4088) - lu(k,1392) * lu(k,4014) + lu(k,4091) = lu(k,4091) - lu(k,1393) * lu(k,4014) + lu(k,4092) = lu(k,4092) - lu(k,1394) * lu(k,4014) + lu(k,4093) = lu(k,4093) - lu(k,1395) * lu(k,4014) + lu(k,4096) = lu(k,4096) - lu(k,1396) * lu(k,4014) + lu(k,4097) = lu(k,4097) - lu(k,1397) * lu(k,4014) + lu(k,4098) = lu(k,4098) - lu(k,1398) * lu(k,4014) + lu(k,4101) = lu(k,4101) - lu(k,1399) * lu(k,4014) + lu(k,4102) = lu(k,4102) - lu(k,1400) * lu(k,4014) + lu(k,1410) = 1._r8 / lu(k,1410) + lu(k,1411) = lu(k,1411) * lu(k,1410) + lu(k,1412) = lu(k,1412) * lu(k,1410) + lu(k,1413) = lu(k,1413) * lu(k,1410) + lu(k,1414) = lu(k,1414) * lu(k,1410) + lu(k,1415) = lu(k,1415) * lu(k,1410) + lu(k,1416) = lu(k,1416) * lu(k,1410) + lu(k,1417) = lu(k,1417) * lu(k,1410) + lu(k,1418) = lu(k,1418) * lu(k,1410) + lu(k,1419) = lu(k,1419) * lu(k,1410) + lu(k,1420) = lu(k,1420) * lu(k,1410) + lu(k,1421) = lu(k,1421) * lu(k,1410) + lu(k,1422) = lu(k,1422) * lu(k,1410) + lu(k,1423) = lu(k,1423) * lu(k,1410) + lu(k,1424) = lu(k,1424) * lu(k,1410) + lu(k,1425) = lu(k,1425) * lu(k,1410) + lu(k,1426) = lu(k,1426) * lu(k,1410) + lu(k,1427) = lu(k,1427) * lu(k,1410) + lu(k,1428) = lu(k,1428) * lu(k,1410) + lu(k,1429) = lu(k,1429) * lu(k,1410) + lu(k,1430) = lu(k,1430) * lu(k,1410) + lu(k,3546) = lu(k,3546) - lu(k,1411) * lu(k,3543) + lu(k,3551) = lu(k,3551) - lu(k,1412) * lu(k,3543) + lu(k,3557) = - lu(k,1413) * lu(k,3543) + lu(k,3558) = - lu(k,1414) * lu(k,3543) + lu(k,3560) = - lu(k,1415) * lu(k,3543) + lu(k,3561) = - lu(k,1416) * lu(k,3543) + lu(k,3566) = - lu(k,1417) * lu(k,3543) + lu(k,3567) = - lu(k,1418) * lu(k,3543) + lu(k,3568) = lu(k,3568) - lu(k,1419) * lu(k,3543) + lu(k,3569) = lu(k,3569) - lu(k,1420) * lu(k,3543) + lu(k,3570) = lu(k,3570) - lu(k,1421) * lu(k,3543) + lu(k,3574) = lu(k,3574) - lu(k,1422) * lu(k,3543) + lu(k,3599) = lu(k,3599) - lu(k,1423) * lu(k,3543) + lu(k,3605) = lu(k,3605) - lu(k,1424) * lu(k,3543) + lu(k,3606) = lu(k,3606) - lu(k,1425) * lu(k,3543) + lu(k,3607) = lu(k,3607) - lu(k,1426) * lu(k,3543) + lu(k,3610) = lu(k,3610) - lu(k,1427) * lu(k,3543) + lu(k,3612) = lu(k,3612) - lu(k,1428) * lu(k,3543) + lu(k,3615) = lu(k,3615) - lu(k,1429) * lu(k,3543) + lu(k,3616) = lu(k,3616) - lu(k,1430) * lu(k,3543) + lu(k,3702) = lu(k,3702) - lu(k,1411) * lu(k,3697) + lu(k,3706) = lu(k,3706) - lu(k,1412) * lu(k,3697) + lu(k,3711) = - lu(k,1413) * lu(k,3697) + lu(k,3712) = - lu(k,1414) * lu(k,3697) + lu(k,3716) = - lu(k,1415) * lu(k,3697) + lu(k,3717) = - lu(k,1416) * lu(k,3697) + lu(k,3722) = - lu(k,1417) * lu(k,3697) + lu(k,3723) = - lu(k,1418) * lu(k,3697) + lu(k,3724) = lu(k,3724) - lu(k,1419) * lu(k,3697) + lu(k,3725) = lu(k,3725) - lu(k,1420) * lu(k,3697) + lu(k,3726) = lu(k,3726) - lu(k,1421) * lu(k,3697) + lu(k,3730) = - lu(k,1422) * lu(k,3697) + lu(k,3753) = lu(k,3753) - lu(k,1423) * lu(k,3697) + lu(k,3759) = lu(k,3759) - lu(k,1424) * lu(k,3697) + lu(k,3760) = lu(k,3760) - lu(k,1425) * lu(k,3697) + lu(k,3761) = lu(k,3761) - lu(k,1426) * lu(k,3697) + lu(k,3764) = lu(k,3764) - lu(k,1427) * lu(k,3697) + lu(k,3766) = lu(k,3766) - lu(k,1428) * lu(k,3697) + lu(k,3769) = lu(k,3769) - lu(k,1429) * lu(k,3697) + lu(k,3770) = lu(k,3770) - lu(k,1430) * lu(k,3697) + lu(k,4023) = lu(k,4023) - lu(k,1411) * lu(k,4015) + lu(k,4033) = lu(k,4033) - lu(k,1412) * lu(k,4015) + lu(k,4042) = lu(k,4042) - lu(k,1413) * lu(k,4015) + lu(k,4043) = lu(k,4043) - lu(k,1414) * lu(k,4015) + lu(k,4047) = lu(k,4047) - lu(k,1415) * lu(k,4015) + lu(k,4048) = lu(k,4048) - lu(k,1416) * lu(k,4015) + lu(k,4053) = lu(k,4053) - lu(k,1417) * lu(k,4015) + lu(k,4054) = lu(k,4054) - lu(k,1418) * lu(k,4015) + lu(k,4055) = lu(k,4055) - lu(k,1419) * lu(k,4015) + lu(k,4056) = lu(k,4056) - lu(k,1420) * lu(k,4015) + lu(k,4057) = lu(k,4057) - lu(k,1421) * lu(k,4015) + lu(k,4061) = lu(k,4061) - lu(k,1422) * lu(k,4015) + lu(k,4085) = lu(k,4085) - lu(k,1423) * lu(k,4015) + lu(k,4091) = lu(k,4091) - lu(k,1424) * lu(k,4015) + lu(k,4092) = lu(k,4092) - lu(k,1425) * lu(k,4015) + lu(k,4093) = lu(k,4093) - lu(k,1426) * lu(k,4015) + lu(k,4096) = lu(k,4096) - lu(k,1427) * lu(k,4015) + lu(k,4098) = lu(k,4098) - lu(k,1428) * lu(k,4015) + lu(k,4101) = lu(k,4101) - lu(k,1429) * lu(k,4015) + lu(k,4102) = lu(k,4102) - lu(k,1430) * lu(k,4015) + end do + end subroutine lu_fac31 + subroutine lu_fac32( 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,1431) = 1._r8 / lu(k,1431) + lu(k,1432) = lu(k,1432) * lu(k,1431) + lu(k,1433) = lu(k,1433) * lu(k,1431) + lu(k,1434) = lu(k,1434) * lu(k,1431) + lu(k,1435) = lu(k,1435) * lu(k,1431) + lu(k,1436) = lu(k,1436) * lu(k,1431) + lu(k,1437) = lu(k,1437) * lu(k,1431) + lu(k,1438) = lu(k,1438) * lu(k,1431) + lu(k,1439) = lu(k,1439) * lu(k,1431) + lu(k,2042) = lu(k,2042) - lu(k,1432) * lu(k,2033) + lu(k,2044) = lu(k,2044) - lu(k,1433) * lu(k,2033) + lu(k,2045) = - lu(k,1434) * lu(k,2033) + lu(k,2049) = lu(k,2049) - lu(k,1435) * lu(k,2033) + lu(k,2050) = lu(k,2050) - lu(k,1436) * lu(k,2033) + lu(k,2051) = lu(k,2051) - lu(k,1437) * lu(k,2033) + lu(k,2054) = lu(k,2054) - lu(k,1438) * lu(k,2033) + lu(k,2055) = lu(k,2055) - lu(k,1439) * lu(k,2033) + lu(k,3074) = lu(k,3074) - lu(k,1432) * lu(k,3037) + lu(k,3103) = lu(k,3103) - lu(k,1433) * lu(k,3037) + lu(k,3105) = lu(k,3105) - lu(k,1434) * lu(k,3037) + lu(k,3110) = lu(k,3110) - lu(k,1435) * lu(k,3037) + lu(k,3111) = lu(k,3111) - lu(k,1436) * lu(k,3037) + lu(k,3114) = lu(k,3114) - lu(k,1437) * lu(k,3037) + lu(k,3119) = lu(k,3119) - lu(k,1438) * lu(k,3037) + lu(k,3120) = lu(k,3120) - lu(k,1439) * lu(k,3037) + lu(k,3333) = lu(k,3333) - lu(k,1432) * lu(k,3294) + lu(k,3362) = lu(k,3362) - lu(k,1433) * lu(k,3294) + lu(k,3364) = lu(k,3364) - lu(k,1434) * lu(k,3294) + lu(k,3369) = lu(k,3369) - lu(k,1435) * lu(k,3294) + lu(k,3370) = lu(k,3370) - lu(k,1436) * lu(k,3294) + lu(k,3373) = lu(k,3373) - lu(k,1437) * lu(k,3294) + lu(k,3378) = lu(k,3378) - lu(k,1438) * lu(k,3294) + lu(k,3379) = lu(k,3379) - lu(k,1439) * lu(k,3294) + lu(k,3427) = lu(k,3427) - lu(k,1432) * lu(k,3392) + lu(k,3455) = lu(k,3455) - lu(k,1433) * lu(k,3392) + lu(k,3457) = lu(k,3457) - lu(k,1434) * lu(k,3392) + lu(k,3462) = lu(k,3462) - lu(k,1435) * lu(k,3392) + lu(k,3463) = lu(k,3463) - lu(k,1436) * lu(k,3392) + lu(k,3466) = lu(k,3466) - lu(k,1437) * lu(k,3392) + lu(k,3471) = lu(k,3471) - lu(k,1438) * lu(k,3392) + lu(k,3472) = lu(k,3472) - lu(k,1439) * lu(k,3392) + lu(k,3570) = lu(k,3570) - lu(k,1432) * lu(k,3544) + lu(k,3599) = lu(k,3599) - lu(k,1433) * lu(k,3544) + lu(k,3601) = lu(k,3601) - lu(k,1434) * lu(k,3544) + lu(k,3606) = lu(k,3606) - lu(k,1435) * lu(k,3544) + lu(k,3607) = lu(k,3607) - lu(k,1436) * lu(k,3544) + lu(k,3610) = lu(k,3610) - lu(k,1437) * lu(k,3544) + lu(k,3615) = lu(k,3615) - lu(k,1438) * lu(k,3544) + lu(k,3616) = lu(k,3616) - lu(k,1439) * lu(k,3544) + lu(k,3726) = lu(k,3726) - lu(k,1432) * lu(k,3698) + lu(k,3753) = lu(k,3753) - lu(k,1433) * lu(k,3698) + lu(k,3755) = lu(k,3755) - lu(k,1434) * lu(k,3698) + lu(k,3760) = lu(k,3760) - lu(k,1435) * lu(k,3698) + lu(k,3761) = lu(k,3761) - lu(k,1436) * lu(k,3698) + lu(k,3764) = lu(k,3764) - lu(k,1437) * lu(k,3698) + lu(k,3769) = lu(k,3769) - lu(k,1438) * lu(k,3698) + lu(k,3770) = lu(k,3770) - lu(k,1439) * lu(k,3698) + lu(k,3832) = lu(k,3832) - lu(k,1432) * lu(k,3825) + lu(k,3835) = - lu(k,1433) * lu(k,3825) + lu(k,3837) = lu(k,3837) - lu(k,1434) * lu(k,3825) + lu(k,3842) = lu(k,3842) - lu(k,1435) * lu(k,3825) + lu(k,3843) = lu(k,3843) - lu(k,1436) * lu(k,3825) + lu(k,3846) = lu(k,3846) - lu(k,1437) * lu(k,3825) + lu(k,3851) = lu(k,3851) - lu(k,1438) * lu(k,3825) + lu(k,3852) = lu(k,3852) - lu(k,1439) * lu(k,3825) + lu(k,4057) = lu(k,4057) - lu(k,1432) * lu(k,4016) + lu(k,4085) = lu(k,4085) - lu(k,1433) * lu(k,4016) + lu(k,4087) = lu(k,4087) - lu(k,1434) * lu(k,4016) + lu(k,4092) = lu(k,4092) - lu(k,1435) * lu(k,4016) + lu(k,4093) = lu(k,4093) - lu(k,1436) * lu(k,4016) + lu(k,4096) = lu(k,4096) - lu(k,1437) * lu(k,4016) + lu(k,4101) = lu(k,4101) - lu(k,1438) * lu(k,4016) + lu(k,4102) = lu(k,4102) - lu(k,1439) * lu(k,4016) + lu(k,1440) = 1._r8 / lu(k,1440) + lu(k,1441) = lu(k,1441) * lu(k,1440) + lu(k,1442) = lu(k,1442) * lu(k,1440) + lu(k,1443) = lu(k,1443) * lu(k,1440) + lu(k,1444) = lu(k,1444) * lu(k,1440) + lu(k,1445) = lu(k,1445) * lu(k,1440) + lu(k,1446) = lu(k,1446) * lu(k,1440) + lu(k,1447) = lu(k,1447) * lu(k,1440) + lu(k,1448) = lu(k,1448) * lu(k,1440) + lu(k,1449) = lu(k,1449) * lu(k,1440) + lu(k,1450) = lu(k,1450) * lu(k,1440) + lu(k,1451) = lu(k,1451) * lu(k,1440) + lu(k,1452) = lu(k,1452) * lu(k,1440) + lu(k,1453) = lu(k,1453) * lu(k,1440) + lu(k,2160) = lu(k,2160) - lu(k,1441) * lu(k,2159) + lu(k,2161) = lu(k,2161) - lu(k,1442) * lu(k,2159) + lu(k,2162) = lu(k,2162) - lu(k,1443) * lu(k,2159) + lu(k,2167) = lu(k,2167) - lu(k,1444) * lu(k,2159) + lu(k,2168) = lu(k,2168) - lu(k,1445) * lu(k,2159) + lu(k,2169) = lu(k,2169) - lu(k,1446) * lu(k,2159) + lu(k,2170) = lu(k,2170) - lu(k,1447) * lu(k,2159) + lu(k,2172) = lu(k,2172) - lu(k,1448) * lu(k,2159) + lu(k,2185) = lu(k,2185) - lu(k,1449) * lu(k,2159) + lu(k,2188) = lu(k,2188) - lu(k,1450) * lu(k,2159) + lu(k,2189) = lu(k,2189) - lu(k,1451) * lu(k,2159) + lu(k,2192) = lu(k,2192) - lu(k,1452) * lu(k,2159) + lu(k,2195) = lu(k,2195) - lu(k,1453) * lu(k,2159) + lu(k,3039) = lu(k,3039) - lu(k,1441) * lu(k,3038) + lu(k,3041) = lu(k,3041) - lu(k,1442) * lu(k,3038) + lu(k,3043) = lu(k,3043) - lu(k,1443) * lu(k,3038) + lu(k,3054) = lu(k,3054) - lu(k,1444) * lu(k,3038) + lu(k,3057) = lu(k,3057) - lu(k,1445) * lu(k,3038) + lu(k,3061) = lu(k,3061) - lu(k,1446) * lu(k,3038) + lu(k,3062) = lu(k,3062) - lu(k,1447) * lu(k,3038) + lu(k,3068) = lu(k,3068) - lu(k,1448) * lu(k,3038) + lu(k,3106) = lu(k,3106) - lu(k,1449) * lu(k,3038) + lu(k,3109) = lu(k,3109) - lu(k,1450) * lu(k,3038) + lu(k,3110) = lu(k,3110) - lu(k,1451) * lu(k,3038) + lu(k,3115) = lu(k,3115) - lu(k,1452) * lu(k,3038) + lu(k,3119) = lu(k,3119) - lu(k,1453) * lu(k,3038) + lu(k,3296) = lu(k,3296) - lu(k,1441) * lu(k,3295) + lu(k,3298) = lu(k,3298) - lu(k,1442) * lu(k,3295) + lu(k,3300) = lu(k,3300) - lu(k,1443) * lu(k,3295) + lu(k,3312) = lu(k,3312) - lu(k,1444) * lu(k,3295) + lu(k,3316) = lu(k,3316) - lu(k,1445) * lu(k,3295) + lu(k,3320) = lu(k,3320) - lu(k,1446) * lu(k,3295) + lu(k,3321) = lu(k,3321) - lu(k,1447) * lu(k,3295) + lu(k,3327) = lu(k,3327) - lu(k,1448) * lu(k,3295) + lu(k,3365) = lu(k,3365) - lu(k,1449) * lu(k,3295) + lu(k,3368) = lu(k,3368) - lu(k,1450) * lu(k,3295) + lu(k,3369) = lu(k,3369) - lu(k,1451) * lu(k,3295) + lu(k,3374) = lu(k,3374) - lu(k,1452) * lu(k,3295) + lu(k,3378) = lu(k,3378) - lu(k,1453) * lu(k,3295) + lu(k,3394) = - lu(k,1441) * lu(k,3393) + lu(k,3396) = - lu(k,1442) * lu(k,3393) + lu(k,3397) = lu(k,3397) - lu(k,1443) * lu(k,3393) + lu(k,3407) = - lu(k,1444) * lu(k,3393) + lu(k,3410) = lu(k,3410) - lu(k,1445) * lu(k,3393) + lu(k,3414) = lu(k,3414) - lu(k,1446) * lu(k,3393) + lu(k,3415) = - lu(k,1447) * lu(k,3393) + lu(k,3421) = lu(k,3421) - lu(k,1448) * lu(k,3393) + lu(k,3458) = lu(k,3458) - lu(k,1449) * lu(k,3393) + lu(k,3461) = lu(k,3461) - lu(k,1450) * lu(k,3393) + lu(k,3462) = lu(k,3462) - lu(k,1451) * lu(k,3393) + lu(k,3467) = lu(k,3467) - lu(k,1452) * lu(k,3393) + lu(k,3471) = lu(k,3471) - lu(k,1453) * lu(k,3393) + lu(k,4018) = lu(k,4018) - lu(k,1441) * lu(k,4017) + lu(k,4020) = lu(k,4020) - lu(k,1442) * lu(k,4017) + lu(k,4022) = lu(k,4022) - lu(k,1443) * lu(k,4017) + lu(k,4036) = lu(k,4036) - lu(k,1444) * lu(k,4017) + lu(k,4040) = lu(k,4040) - lu(k,1445) * lu(k,4017) + lu(k,4044) = lu(k,4044) - lu(k,1446) * lu(k,4017) + lu(k,4045) = lu(k,4045) - lu(k,1447) * lu(k,4017) + lu(k,4051) = lu(k,4051) - lu(k,1448) * lu(k,4017) + lu(k,4088) = lu(k,4088) - lu(k,1449) * lu(k,4017) + lu(k,4091) = lu(k,4091) - lu(k,1450) * lu(k,4017) + lu(k,4092) = lu(k,4092) - lu(k,1451) * lu(k,4017) + lu(k,4097) = lu(k,4097) - lu(k,1452) * lu(k,4017) + lu(k,4101) = lu(k,4101) - lu(k,1453) * lu(k,4017) + lu(k,1454) = 1._r8 / lu(k,1454) + lu(k,1455) = lu(k,1455) * lu(k,1454) + lu(k,1456) = lu(k,1456) * lu(k,1454) + lu(k,1457) = lu(k,1457) * lu(k,1454) + lu(k,1458) = lu(k,1458) * lu(k,1454) + lu(k,1459) = lu(k,1459) * lu(k,1454) + lu(k,1460) = lu(k,1460) * lu(k,1454) + lu(k,1573) = lu(k,1573) - lu(k,1455) * lu(k,1566) + lu(k,1582) = lu(k,1582) - lu(k,1456) * lu(k,1566) + lu(k,1590) = lu(k,1590) - lu(k,1457) * lu(k,1566) + lu(k,1591) = lu(k,1591) - lu(k,1458) * lu(k,1566) + lu(k,1592) = lu(k,1592) - lu(k,1459) * lu(k,1566) + lu(k,1595) = lu(k,1595) - lu(k,1460) * lu(k,1566) + lu(k,1639) = - lu(k,1455) * lu(k,1635) + lu(k,1647) = lu(k,1647) - lu(k,1456) * lu(k,1635) + lu(k,1652) = - lu(k,1457) * lu(k,1635) + lu(k,1653) = lu(k,1653) - lu(k,1458) * lu(k,1635) + lu(k,1654) = lu(k,1654) - lu(k,1459) * lu(k,1635) + lu(k,1655) = lu(k,1655) - lu(k,1460) * lu(k,1635) + lu(k,1914) = - lu(k,1455) * lu(k,1912) + lu(k,1918) = lu(k,1918) - lu(k,1456) * lu(k,1912) + lu(k,1922) = lu(k,1922) - lu(k,1457) * lu(k,1912) + lu(k,1923) = lu(k,1923) - lu(k,1458) * lu(k,1912) + lu(k,1924) = lu(k,1924) - lu(k,1459) * lu(k,1912) + lu(k,1925) = lu(k,1925) - lu(k,1460) * lu(k,1912) + lu(k,2100) = - lu(k,1455) * lu(k,2094) + lu(k,2109) = lu(k,2109) - lu(k,1456) * lu(k,2094) + lu(k,2117) = lu(k,2117) - lu(k,1457) * lu(k,2094) + lu(k,2118) = lu(k,2118) - lu(k,1458) * lu(k,2094) + lu(k,2120) = lu(k,2120) - lu(k,1459) * lu(k,2094) + lu(k,2123) = lu(k,2123) - lu(k,1460) * lu(k,2094) + lu(k,2130) = lu(k,2130) - lu(k,1455) * lu(k,2126) + lu(k,2139) = lu(k,2139) - lu(k,1456) * lu(k,2126) + lu(k,2146) = lu(k,2146) - lu(k,1457) * lu(k,2126) + lu(k,2147) = lu(k,2147) - lu(k,1458) * lu(k,2126) + lu(k,2149) = lu(k,2149) - lu(k,1459) * lu(k,2126) + lu(k,2152) = lu(k,2152) - lu(k,1460) * lu(k,2126) + lu(k,2165) = lu(k,2165) - lu(k,1455) * lu(k,2160) + lu(k,2176) = lu(k,2176) - lu(k,1456) * lu(k,2160) + lu(k,2188) = lu(k,2188) - lu(k,1457) * lu(k,2160) + lu(k,2189) = lu(k,2189) - lu(k,1458) * lu(k,2160) + lu(k,2192) = lu(k,2192) - lu(k,1459) * lu(k,2160) + lu(k,2195) = lu(k,2195) - lu(k,1460) * lu(k,2160) + lu(k,3051) = lu(k,3051) - lu(k,1455) * lu(k,3039) + lu(k,3074) = lu(k,3074) - lu(k,1456) * lu(k,3039) + lu(k,3109) = lu(k,3109) - lu(k,1457) * lu(k,3039) + lu(k,3110) = lu(k,3110) - lu(k,1458) * lu(k,3039) + lu(k,3115) = lu(k,3115) - lu(k,1459) * lu(k,3039) + lu(k,3119) = lu(k,3119) - lu(k,1460) * lu(k,3039) + lu(k,3309) = lu(k,3309) - lu(k,1455) * lu(k,3296) + lu(k,3333) = lu(k,3333) - lu(k,1456) * lu(k,3296) + lu(k,3368) = lu(k,3368) - lu(k,1457) * lu(k,3296) + lu(k,3369) = lu(k,3369) - lu(k,1458) * lu(k,3296) + lu(k,3374) = lu(k,3374) - lu(k,1459) * lu(k,3296) + lu(k,3378) = lu(k,3378) - lu(k,1460) * lu(k,3296) + lu(k,3404) = lu(k,3404) - lu(k,1455) * lu(k,3394) + lu(k,3427) = lu(k,3427) - lu(k,1456) * lu(k,3394) + lu(k,3461) = lu(k,3461) - lu(k,1457) * lu(k,3394) + lu(k,3462) = lu(k,3462) - lu(k,1458) * lu(k,3394) + lu(k,3467) = lu(k,3467) - lu(k,1459) * lu(k,3394) + lu(k,3471) = lu(k,3471) - lu(k,1460) * lu(k,3394) + lu(k,3706) = lu(k,3706) - lu(k,1455) * lu(k,3699) + lu(k,3726) = lu(k,3726) - lu(k,1456) * lu(k,3699) + lu(k,3759) = lu(k,3759) - lu(k,1457) * lu(k,3699) + lu(k,3760) = lu(k,3760) - lu(k,1458) * lu(k,3699) + lu(k,3765) = lu(k,3765) - lu(k,1459) * lu(k,3699) + lu(k,3769) = lu(k,3769) - lu(k,1460) * lu(k,3699) + lu(k,4033) = lu(k,4033) - lu(k,1455) * lu(k,4018) + lu(k,4057) = lu(k,4057) - lu(k,1456) * lu(k,4018) + lu(k,4091) = lu(k,4091) - lu(k,1457) * lu(k,4018) + lu(k,4092) = lu(k,4092) - lu(k,1458) * lu(k,4018) + lu(k,4097) = lu(k,4097) - lu(k,1459) * lu(k,4018) + lu(k,4101) = lu(k,4101) - lu(k,1460) * lu(k,4018) + lu(k,1461) = 1._r8 / lu(k,1461) + lu(k,1462) = lu(k,1462) * lu(k,1461) + lu(k,1463) = lu(k,1463) * lu(k,1461) + lu(k,1464) = lu(k,1464) * lu(k,1461) + lu(k,1465) = lu(k,1465) * lu(k,1461) + lu(k,1466) = lu(k,1466) * lu(k,1461) + lu(k,1467) = lu(k,1467) * lu(k,1461) + lu(k,1545) = lu(k,1545) - lu(k,1462) * lu(k,1542) + lu(k,1547) = lu(k,1547) - lu(k,1463) * lu(k,1542) + lu(k,1548) = lu(k,1548) - lu(k,1464) * lu(k,1542) + lu(k,1552) = lu(k,1552) - lu(k,1465) * lu(k,1542) + lu(k,1553) = lu(k,1553) - lu(k,1466) * lu(k,1542) + lu(k,1556) = lu(k,1556) - lu(k,1467) * lu(k,1542) + lu(k,1755) = lu(k,1755) - lu(k,1462) * lu(k,1750) + lu(k,1758) = - lu(k,1463) * lu(k,1750) + lu(k,1760) = lu(k,1760) - lu(k,1464) * lu(k,1750) + lu(k,1765) = lu(k,1765) - lu(k,1465) * lu(k,1750) + lu(k,1766) = lu(k,1766) - lu(k,1466) * lu(k,1750) + lu(k,1769) = lu(k,1769) - lu(k,1467) * lu(k,1750) + lu(k,1791) = lu(k,1791) - lu(k,1462) * lu(k,1786) + lu(k,1795) = lu(k,1795) - lu(k,1463) * lu(k,1786) + lu(k,1796) = lu(k,1796) - lu(k,1464) * lu(k,1786) + lu(k,1799) = - lu(k,1465) * lu(k,1786) + lu(k,1800) = - lu(k,1466) * lu(k,1786) + lu(k,1802) = lu(k,1802) - lu(k,1467) * lu(k,1786) + lu(k,1815) = lu(k,1815) - lu(k,1462) * lu(k,1810) + lu(k,1820) = lu(k,1820) - lu(k,1463) * lu(k,1810) + lu(k,1823) = lu(k,1823) - lu(k,1464) * lu(k,1810) + lu(k,1829) = lu(k,1829) - lu(k,1465) * lu(k,1810) + lu(k,1830) = lu(k,1830) - lu(k,1466) * lu(k,1810) + lu(k,1833) = lu(k,1833) - lu(k,1467) * lu(k,1810) + lu(k,1893) = lu(k,1893) - lu(k,1462) * lu(k,1887) + lu(k,1898) = lu(k,1898) - lu(k,1463) * lu(k,1887) + lu(k,1903) = lu(k,1903) - lu(k,1464) * lu(k,1887) + lu(k,1907) = lu(k,1907) - lu(k,1465) * lu(k,1887) + lu(k,1908) = lu(k,1908) - lu(k,1466) * lu(k,1887) + lu(k,1910) = lu(k,1910) - lu(k,1467) * lu(k,1887) + lu(k,2071) = - lu(k,1462) * lu(k,2062) + lu(k,2076) = lu(k,2076) - lu(k,1463) * lu(k,2062) + lu(k,2077) = lu(k,2077) - lu(k,1464) * lu(k,2062) + lu(k,2085) = lu(k,2085) - lu(k,1465) * lu(k,2062) + lu(k,2086) = lu(k,2086) - lu(k,1466) * lu(k,2062) + lu(k,2091) = lu(k,2091) - lu(k,1467) * lu(k,2062) + lu(k,2873) = lu(k,2873) - lu(k,1462) * lu(k,2859) + lu(k,2880) = lu(k,2880) - lu(k,1463) * lu(k,2859) + lu(k,2885) = lu(k,2885) - lu(k,1464) * lu(k,2859) + lu(k,2919) = lu(k,2919) - lu(k,1465) * lu(k,2859) + lu(k,2920) = lu(k,2920) - lu(k,1466) * lu(k,2859) + lu(k,2927) = lu(k,2927) - lu(k,1467) * lu(k,2859) + lu(k,3061) = lu(k,3061) - lu(k,1462) * lu(k,3040) + lu(k,3069) = lu(k,3069) - lu(k,1463) * lu(k,3040) + lu(k,3074) = lu(k,3074) - lu(k,1464) * lu(k,3040) + lu(k,3109) = lu(k,3109) - lu(k,1465) * lu(k,3040) + lu(k,3110) = lu(k,3110) - lu(k,1466) * lu(k,3040) + lu(k,3119) = lu(k,3119) - lu(k,1467) * lu(k,3040) + lu(k,3320) = lu(k,3320) - lu(k,1462) * lu(k,3297) + lu(k,3328) = lu(k,3328) - lu(k,1463) * lu(k,3297) + lu(k,3333) = lu(k,3333) - lu(k,1464) * lu(k,3297) + lu(k,3368) = lu(k,3368) - lu(k,1465) * lu(k,3297) + lu(k,3369) = lu(k,3369) - lu(k,1466) * lu(k,3297) + lu(k,3378) = lu(k,3378) - lu(k,1467) * lu(k,3297) + lu(k,3414) = lu(k,3414) - lu(k,1462) * lu(k,3395) + lu(k,3422) = lu(k,3422) - lu(k,1463) * lu(k,3395) + lu(k,3427) = lu(k,3427) - lu(k,1464) * lu(k,3395) + lu(k,3461) = lu(k,3461) - lu(k,1465) * lu(k,3395) + lu(k,3462) = lu(k,3462) - lu(k,1466) * lu(k,3395) + lu(k,3471) = lu(k,3471) - lu(k,1467) * lu(k,3395) + lu(k,4044) = lu(k,4044) - lu(k,1462) * lu(k,4019) + lu(k,4052) = lu(k,4052) - lu(k,1463) * lu(k,4019) + lu(k,4057) = lu(k,4057) - lu(k,1464) * lu(k,4019) + lu(k,4091) = lu(k,4091) - lu(k,1465) * lu(k,4019) + lu(k,4092) = lu(k,4092) - lu(k,1466) * lu(k,4019) + lu(k,4101) = lu(k,4101) - lu(k,1467) * lu(k,4019) + end do + end subroutine lu_fac32 + subroutine lu_fac33( 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,1468) = 1._r8 / lu(k,1468) + lu(k,1469) = lu(k,1469) * lu(k,1468) + lu(k,1470) = lu(k,1470) * lu(k,1468) + lu(k,1471) = lu(k,1471) * lu(k,1468) + lu(k,1472) = lu(k,1472) * lu(k,1468) + lu(k,1473) = lu(k,1473) * lu(k,1468) + lu(k,1474) = lu(k,1474) * lu(k,1468) + lu(k,1576) = - lu(k,1469) * lu(k,1567) + lu(k,1577) = lu(k,1577) - lu(k,1470) * lu(k,1567) + lu(k,1579) = - lu(k,1471) * lu(k,1567) + lu(k,1591) = lu(k,1591) - lu(k,1472) * lu(k,1567) + lu(k,1592) = lu(k,1592) - lu(k,1473) * lu(k,1567) + lu(k,1595) = lu(k,1595) - lu(k,1474) * lu(k,1567) + lu(k,1641) = lu(k,1641) - lu(k,1469) * lu(k,1636) + lu(k,1642) = lu(k,1642) - lu(k,1470) * lu(k,1636) + lu(k,1644) = - lu(k,1471) * lu(k,1636) + lu(k,1653) = lu(k,1653) - lu(k,1472) * lu(k,1636) + lu(k,1654) = lu(k,1654) - lu(k,1473) * lu(k,1636) + lu(k,1655) = lu(k,1655) - lu(k,1474) * lu(k,1636) + lu(k,1943) = lu(k,1943) - lu(k,1469) * lu(k,1939) + lu(k,1945) = lu(k,1945) - lu(k,1470) * lu(k,1939) + lu(k,1947) = lu(k,1947) - lu(k,1471) * lu(k,1939) + lu(k,1964) = lu(k,1964) - lu(k,1472) * lu(k,1939) + lu(k,1967) = lu(k,1967) - lu(k,1473) * lu(k,1939) + lu(k,1968) = lu(k,1968) - lu(k,1474) * lu(k,1939) + lu(k,1980) = lu(k,1980) - lu(k,1469) * lu(k,1975) + lu(k,1982) = lu(k,1982) - lu(k,1470) * lu(k,1975) + lu(k,1984) = lu(k,1984) - lu(k,1471) * lu(k,1975) + lu(k,2003) = lu(k,2003) - lu(k,1472) * lu(k,1975) + lu(k,2006) = lu(k,2006) - lu(k,1473) * lu(k,1975) + lu(k,2007) = lu(k,2007) - lu(k,1474) * lu(k,1975) + lu(k,2070) = lu(k,2070) - lu(k,1469) * lu(k,2063) + lu(k,2071) = lu(k,2071) - lu(k,1470) * lu(k,2063) + lu(k,2073) = - lu(k,1471) * lu(k,2063) + lu(k,2086) = lu(k,2086) - lu(k,1472) * lu(k,2063) + lu(k,2088) = lu(k,2088) - lu(k,1473) * lu(k,2063) + lu(k,2091) = lu(k,2091) - lu(k,1474) * lu(k,2063) + lu(k,2102) = - lu(k,1469) * lu(k,2095) + lu(k,2103) = lu(k,2103) - lu(k,1470) * lu(k,2095) + lu(k,2105) = - lu(k,1471) * lu(k,2095) + lu(k,2118) = lu(k,2118) - lu(k,1472) * lu(k,2095) + lu(k,2120) = lu(k,2120) - lu(k,1473) * lu(k,2095) + lu(k,2123) = lu(k,2123) - lu(k,1474) * lu(k,2095) + lu(k,2168) = lu(k,2168) - lu(k,1469) * lu(k,2161) + lu(k,2169) = lu(k,2169) - lu(k,1470) * lu(k,2161) + lu(k,2171) = - lu(k,1471) * lu(k,2161) + lu(k,2189) = lu(k,2189) - lu(k,1472) * lu(k,2161) + lu(k,2192) = lu(k,2192) - lu(k,1473) * lu(k,2161) + lu(k,2195) = lu(k,2195) - lu(k,1474) * lu(k,2161) + lu(k,3057) = lu(k,3057) - lu(k,1469) * lu(k,3041) + lu(k,3061) = lu(k,3061) - lu(k,1470) * lu(k,3041) + lu(k,3063) = lu(k,3063) - lu(k,1471) * lu(k,3041) + lu(k,3110) = lu(k,3110) - lu(k,1472) * lu(k,3041) + lu(k,3115) = lu(k,3115) - lu(k,1473) * lu(k,3041) + lu(k,3119) = lu(k,3119) - lu(k,1474) * lu(k,3041) + lu(k,3316) = lu(k,3316) - lu(k,1469) * lu(k,3298) + lu(k,3320) = lu(k,3320) - lu(k,1470) * lu(k,3298) + lu(k,3322) = lu(k,3322) - lu(k,1471) * lu(k,3298) + lu(k,3369) = lu(k,3369) - lu(k,1472) * lu(k,3298) + lu(k,3374) = lu(k,3374) - lu(k,1473) * lu(k,3298) + lu(k,3378) = lu(k,3378) - lu(k,1474) * lu(k,3298) + lu(k,3410) = lu(k,3410) - lu(k,1469) * lu(k,3396) + lu(k,3414) = lu(k,3414) - lu(k,1470) * lu(k,3396) + lu(k,3416) = - lu(k,1471) * lu(k,3396) + lu(k,3462) = lu(k,3462) - lu(k,1472) * lu(k,3396) + lu(k,3467) = lu(k,3467) - lu(k,1473) * lu(k,3396) + lu(k,3471) = lu(k,3471) - lu(k,1474) * lu(k,3396) + lu(k,4040) = lu(k,4040) - lu(k,1469) * lu(k,4020) + lu(k,4044) = lu(k,4044) - lu(k,1470) * lu(k,4020) + lu(k,4046) = lu(k,4046) - lu(k,1471) * lu(k,4020) + lu(k,4092) = lu(k,4092) - lu(k,1472) * lu(k,4020) + lu(k,4097) = lu(k,4097) - lu(k,1473) * lu(k,4020) + lu(k,4101) = lu(k,4101) - lu(k,1474) * lu(k,4020) + lu(k,1476) = 1._r8 / lu(k,1476) + lu(k,1477) = lu(k,1477) * lu(k,1476) + lu(k,1478) = lu(k,1478) * lu(k,1476) + lu(k,1479) = lu(k,1479) * lu(k,1476) + lu(k,1480) = lu(k,1480) * lu(k,1476) + lu(k,1525) = - lu(k,1477) * lu(k,1523) + lu(k,1530) = lu(k,1530) - lu(k,1478) * lu(k,1523) + lu(k,1533) = lu(k,1533) - lu(k,1479) * lu(k,1523) + lu(k,1535) = lu(k,1535) - lu(k,1480) * lu(k,1523) + lu(k,1573) = lu(k,1573) - lu(k,1477) * lu(k,1568) + lu(k,1582) = lu(k,1582) - lu(k,1478) * lu(k,1568) + lu(k,1591) = lu(k,1591) - lu(k,1479) * lu(k,1568) + lu(k,1595) = lu(k,1595) - lu(k,1480) * lu(k,1568) + lu(k,1639) = lu(k,1639) - lu(k,1477) * lu(k,1637) + lu(k,1647) = lu(k,1647) - lu(k,1478) * lu(k,1637) + lu(k,1653) = lu(k,1653) - lu(k,1479) * lu(k,1637) + lu(k,1655) = lu(k,1655) - lu(k,1480) * lu(k,1637) + lu(k,1658) = - lu(k,1477) * lu(k,1657) + lu(k,1665) = lu(k,1665) - lu(k,1478) * lu(k,1657) + lu(k,1668) = lu(k,1668) - lu(k,1479) * lu(k,1657) + lu(k,1670) = lu(k,1670) - lu(k,1480) * lu(k,1657) + lu(k,1711) = lu(k,1711) - lu(k,1477) * lu(k,1710) + lu(k,1713) = lu(k,1713) - lu(k,1478) * lu(k,1710) + lu(k,1716) = lu(k,1716) - lu(k,1479) * lu(k,1710) + lu(k,1717) = lu(k,1717) - lu(k,1480) * lu(k,1710) + lu(k,1789) = - lu(k,1477) * lu(k,1787) + lu(k,1796) = lu(k,1796) - lu(k,1478) * lu(k,1787) + lu(k,1800) = lu(k,1800) - lu(k,1479) * lu(k,1787) + lu(k,1802) = lu(k,1802) - lu(k,1480) * lu(k,1787) + lu(k,1868) = lu(k,1868) - lu(k,1477) * lu(k,1867) + lu(k,1875) = lu(k,1875) - lu(k,1478) * lu(k,1867) + lu(k,1880) = lu(k,1880) - lu(k,1479) * lu(k,1867) + lu(k,1882) = lu(k,1882) - lu(k,1480) * lu(k,1867) + lu(k,1891) = - lu(k,1477) * lu(k,1888) + lu(k,1903) = lu(k,1903) - lu(k,1478) * lu(k,1888) + lu(k,1908) = lu(k,1908) - lu(k,1479) * lu(k,1888) + lu(k,1910) = lu(k,1910) - lu(k,1480) * lu(k,1888) + lu(k,2068) = - lu(k,1477) * lu(k,2064) + lu(k,2077) = lu(k,2077) - lu(k,1478) * lu(k,2064) + lu(k,2086) = lu(k,2086) - lu(k,1479) * lu(k,2064) + lu(k,2091) = lu(k,2091) - lu(k,1480) * lu(k,2064) + lu(k,2100) = lu(k,2100) - lu(k,1477) * lu(k,2096) + lu(k,2109) = lu(k,2109) - lu(k,1478) * lu(k,2096) + lu(k,2118) = lu(k,2118) - lu(k,1479) * lu(k,2096) + lu(k,2123) = lu(k,2123) - lu(k,1480) * lu(k,2096) + lu(k,2130) = lu(k,2130) - lu(k,1477) * lu(k,2127) + lu(k,2139) = lu(k,2139) - lu(k,1478) * lu(k,2127) + lu(k,2147) = lu(k,2147) - lu(k,1479) * lu(k,2127) + lu(k,2152) = lu(k,2152) - lu(k,1480) * lu(k,2127) + lu(k,3051) = lu(k,3051) - lu(k,1477) * lu(k,3042) + lu(k,3074) = lu(k,3074) - lu(k,1478) * lu(k,3042) + lu(k,3110) = lu(k,3110) - lu(k,1479) * lu(k,3042) + lu(k,3119) = lu(k,3119) - lu(k,1480) * lu(k,3042) + lu(k,3309) = lu(k,3309) - lu(k,1477) * lu(k,3299) + lu(k,3333) = lu(k,3333) - lu(k,1478) * lu(k,3299) + lu(k,3369) = lu(k,3369) - lu(k,1479) * lu(k,3299) + lu(k,3378) = lu(k,3378) - lu(k,1480) * lu(k,3299) + lu(k,3640) = lu(k,3640) - lu(k,1477) * lu(k,3638) + lu(k,3644) = lu(k,3644) - lu(k,1478) * lu(k,3638) + lu(k,3658) = lu(k,3658) - lu(k,1479) * lu(k,3638) + lu(k,3667) = lu(k,3667) - lu(k,1480) * lu(k,3638) + lu(k,3706) = lu(k,3706) - lu(k,1477) * lu(k,3700) + lu(k,3726) = lu(k,3726) - lu(k,1478) * lu(k,3700) + lu(k,3760) = lu(k,3760) - lu(k,1479) * lu(k,3700) + lu(k,3769) = lu(k,3769) - lu(k,1480) * lu(k,3700) + lu(k,3829) = lu(k,3829) - lu(k,1477) * lu(k,3826) + lu(k,3832) = lu(k,3832) - lu(k,1478) * lu(k,3826) + lu(k,3842) = lu(k,3842) - lu(k,1479) * lu(k,3826) + lu(k,3851) = lu(k,3851) - lu(k,1480) * lu(k,3826) + lu(k,4033) = lu(k,4033) - lu(k,1477) * lu(k,4021) + lu(k,4057) = lu(k,4057) - lu(k,1478) * lu(k,4021) + lu(k,4092) = lu(k,4092) - lu(k,1479) * lu(k,4021) + lu(k,4101) = lu(k,4101) - lu(k,1480) * lu(k,4021) + lu(k,1481) = 1._r8 / lu(k,1481) + lu(k,1482) = lu(k,1482) * lu(k,1481) + lu(k,1483) = lu(k,1483) * lu(k,1481) + lu(k,1484) = lu(k,1484) * lu(k,1481) + lu(k,1485) = lu(k,1485) * lu(k,1481) + lu(k,1486) = lu(k,1486) * lu(k,1481) + lu(k,1581) = lu(k,1581) - lu(k,1482) * lu(k,1569) + lu(k,1585) = lu(k,1585) - lu(k,1483) * lu(k,1569) + lu(k,1590) = lu(k,1590) - lu(k,1484) * lu(k,1569) + lu(k,1592) = lu(k,1592) - lu(k,1485) * lu(k,1569) + lu(k,1595) = lu(k,1595) - lu(k,1486) * lu(k,1569) + lu(k,1646) = lu(k,1646) - lu(k,1482) * lu(k,1638) + lu(k,1648) = - lu(k,1483) * lu(k,1638) + lu(k,1652) = lu(k,1652) - lu(k,1484) * lu(k,1638) + lu(k,1654) = lu(k,1654) - lu(k,1485) * lu(k,1638) + lu(k,1655) = lu(k,1655) - lu(k,1486) * lu(k,1638) + lu(k,1779) = lu(k,1779) - lu(k,1482) * lu(k,1776) + lu(k,1781) = - lu(k,1483) * lu(k,1776) + lu(k,1782) = lu(k,1782) - lu(k,1484) * lu(k,1776) + lu(k,1784) = lu(k,1784) - lu(k,1485) * lu(k,1776) + lu(k,1785) = lu(k,1785) - lu(k,1486) * lu(k,1776) + lu(k,1917) = lu(k,1917) - lu(k,1482) * lu(k,1913) + lu(k,1919) = lu(k,1919) - lu(k,1483) * lu(k,1913) + lu(k,1922) = lu(k,1922) - lu(k,1484) * lu(k,1913) + lu(k,1924) = lu(k,1924) - lu(k,1485) * lu(k,1913) + lu(k,1925) = lu(k,1925) - lu(k,1486) * lu(k,1913) + lu(k,2040) = lu(k,2040) - lu(k,1482) * lu(k,2034) + lu(k,2044) = lu(k,2044) - lu(k,1483) * lu(k,2034) + lu(k,2048) = lu(k,2048) - lu(k,1484) * lu(k,2034) + lu(k,2052) = lu(k,2052) - lu(k,1485) * lu(k,2034) + lu(k,2054) = lu(k,2054) - lu(k,1486) * lu(k,2034) + lu(k,2076) = lu(k,2076) - lu(k,1482) * lu(k,2065) + lu(k,2080) = - lu(k,1483) * lu(k,2065) + lu(k,2085) = lu(k,2085) - lu(k,1484) * lu(k,2065) + lu(k,2088) = lu(k,2088) - lu(k,1485) * lu(k,2065) + lu(k,2091) = lu(k,2091) - lu(k,1486) * lu(k,2065) + lu(k,2138) = lu(k,2138) - lu(k,1482) * lu(k,2128) + lu(k,2141) = lu(k,2141) - lu(k,1483) * lu(k,2128) + lu(k,2146) = lu(k,2146) - lu(k,1484) * lu(k,2128) + lu(k,2149) = lu(k,2149) - lu(k,1485) * lu(k,2128) + lu(k,2152) = lu(k,2152) - lu(k,1486) * lu(k,2128) + lu(k,2173) = lu(k,2173) - lu(k,1482) * lu(k,2162) + lu(k,2183) = lu(k,2183) - lu(k,1483) * lu(k,2162) + lu(k,2188) = lu(k,2188) - lu(k,1484) * lu(k,2162) + lu(k,2192) = lu(k,2192) - lu(k,1485) * lu(k,2162) + lu(k,2195) = lu(k,2195) - lu(k,1486) * lu(k,2162) + lu(k,3069) = lu(k,3069) - lu(k,1482) * lu(k,3043) + lu(k,3103) = lu(k,3103) - lu(k,1483) * lu(k,3043) + lu(k,3109) = lu(k,3109) - lu(k,1484) * lu(k,3043) + lu(k,3115) = lu(k,3115) - lu(k,1485) * lu(k,3043) + lu(k,3119) = lu(k,3119) - lu(k,1486) * lu(k,3043) + lu(k,3328) = lu(k,3328) - lu(k,1482) * lu(k,3300) + lu(k,3362) = lu(k,3362) - lu(k,1483) * lu(k,3300) + lu(k,3368) = lu(k,3368) - lu(k,1484) * lu(k,3300) + lu(k,3374) = lu(k,3374) - lu(k,1485) * lu(k,3300) + lu(k,3378) = lu(k,3378) - lu(k,1486) * lu(k,3300) + lu(k,3422) = lu(k,3422) - lu(k,1482) * lu(k,3397) + lu(k,3455) = lu(k,3455) - lu(k,1483) * lu(k,3397) + lu(k,3461) = lu(k,3461) - lu(k,1484) * lu(k,3397) + lu(k,3467) = lu(k,3467) - lu(k,1485) * lu(k,3397) + lu(k,3471) = lu(k,3471) - lu(k,1486) * lu(k,3397) + lu(k,3565) = lu(k,3565) - lu(k,1482) * lu(k,3545) + lu(k,3599) = lu(k,3599) - lu(k,1483) * lu(k,3545) + lu(k,3605) = lu(k,3605) - lu(k,1484) * lu(k,3545) + lu(k,3611) = lu(k,3611) - lu(k,1485) * lu(k,3545) + lu(k,3615) = lu(k,3615) - lu(k,1486) * lu(k,3545) + lu(k,3721) = lu(k,3721) - lu(k,1482) * lu(k,3701) + lu(k,3753) = lu(k,3753) - lu(k,1483) * lu(k,3701) + lu(k,3759) = lu(k,3759) - lu(k,1484) * lu(k,3701) + lu(k,3765) = lu(k,3765) - lu(k,1485) * lu(k,3701) + lu(k,3769) = lu(k,3769) - lu(k,1486) * lu(k,3701) + lu(k,4052) = lu(k,4052) - lu(k,1482) * lu(k,4022) + lu(k,4085) = lu(k,4085) - lu(k,1483) * lu(k,4022) + lu(k,4091) = lu(k,4091) - lu(k,1484) * lu(k,4022) + lu(k,4097) = lu(k,4097) - lu(k,1485) * lu(k,4022) + lu(k,4101) = lu(k,4101) - lu(k,1486) * lu(k,4022) + lu(k,1487) = 1._r8 / lu(k,1487) + lu(k,1488) = lu(k,1488) * lu(k,1487) + lu(k,1489) = lu(k,1489) * lu(k,1487) + lu(k,1490) = lu(k,1490) * lu(k,1487) + lu(k,1491) = lu(k,1491) * lu(k,1487) + lu(k,1492) = lu(k,1492) * lu(k,1487) + lu(k,1493) = lu(k,1493) * lu(k,1487) + lu(k,1588) = - lu(k,1488) * lu(k,1570) + lu(k,1589) = - lu(k,1489) * lu(k,1570) + lu(k,1591) = lu(k,1591) - lu(k,1490) * lu(k,1570) + lu(k,1594) = - lu(k,1491) * lu(k,1570) + lu(k,1595) = lu(k,1595) - lu(k,1492) * lu(k,1570) + lu(k,1596) = - lu(k,1493) * lu(k,1570) + lu(k,2083) = - lu(k,1488) * lu(k,2066) + lu(k,2084) = - lu(k,1489) * lu(k,2066) + lu(k,2086) = lu(k,2086) - lu(k,1490) * lu(k,2066) + lu(k,2090) = - lu(k,1491) * lu(k,2066) + lu(k,2091) = lu(k,2091) - lu(k,1492) * lu(k,2066) + lu(k,2092) = - lu(k,1493) * lu(k,2066) + lu(k,2115) = - lu(k,1488) * lu(k,2097) + lu(k,2116) = - lu(k,1489) * lu(k,2097) + lu(k,2118) = lu(k,2118) - lu(k,1490) * lu(k,2097) + lu(k,2122) = - lu(k,1491) * lu(k,2097) + lu(k,2123) = lu(k,2123) - lu(k,1492) * lu(k,2097) + lu(k,2124) = - lu(k,1493) * lu(k,2097) + lu(k,2144) = - lu(k,1488) * lu(k,2129) + lu(k,2145) = - lu(k,1489) * lu(k,2129) + lu(k,2147) = lu(k,2147) - lu(k,1490) * lu(k,2129) + lu(k,2151) = - lu(k,1491) * lu(k,2129) + lu(k,2152) = lu(k,2152) - lu(k,1492) * lu(k,2129) + lu(k,2153) = - lu(k,1493) * lu(k,2129) + lu(k,2609) = - lu(k,1488) * lu(k,2593) + lu(k,2610) = - lu(k,1489) * lu(k,2593) + lu(k,2612) = lu(k,2612) - lu(k,1490) * lu(k,2593) + lu(k,2616) = - lu(k,1491) * lu(k,2593) + lu(k,2617) = lu(k,2617) - lu(k,1492) * lu(k,2593) + lu(k,2618) = lu(k,2618) - lu(k,1493) * lu(k,2593) + lu(k,2637) = - lu(k,1488) * lu(k,2623) + lu(k,2638) = - lu(k,1489) * lu(k,2623) + lu(k,2640) = lu(k,2640) - lu(k,1490) * lu(k,2623) + lu(k,2644) = - lu(k,1491) * lu(k,2623) + lu(k,2645) = lu(k,2645) - lu(k,1492) * lu(k,2623) + lu(k,2646) = lu(k,2646) - lu(k,1493) * lu(k,2623) + lu(k,3160) = lu(k,3160) - lu(k,1488) * lu(k,3151) + lu(k,3161) = lu(k,3161) - lu(k,1489) * lu(k,3151) + lu(k,3163) = lu(k,3163) - lu(k,1490) * lu(k,3151) + lu(k,3171) = lu(k,3171) - lu(k,1491) * lu(k,3151) + lu(k,3172) = lu(k,3172) - lu(k,1492) * lu(k,3151) + lu(k,3173) = lu(k,3173) - lu(k,1493) * lu(k,3151) + lu(k,3366) = lu(k,3366) - lu(k,1488) * lu(k,3301) + lu(k,3367) = lu(k,3367) - lu(k,1489) * lu(k,3301) + lu(k,3369) = lu(k,3369) - lu(k,1490) * lu(k,3301) + lu(k,3377) = lu(k,3377) - lu(k,1491) * lu(k,3301) + lu(k,3378) = lu(k,3378) - lu(k,1492) * lu(k,3301) + lu(k,3379) = lu(k,3379) - lu(k,1493) * lu(k,3301) + lu(k,3603) = - lu(k,1488) * lu(k,3546) + lu(k,3604) = lu(k,3604) - lu(k,1489) * lu(k,3546) + lu(k,3606) = lu(k,3606) - lu(k,1490) * lu(k,3546) + lu(k,3614) = - lu(k,1491) * lu(k,3546) + lu(k,3615) = lu(k,3615) - lu(k,1492) * lu(k,3546) + lu(k,3616) = lu(k,3616) - lu(k,1493) * lu(k,3546) + lu(k,3757) = - lu(k,1488) * lu(k,3702) + lu(k,3758) = lu(k,3758) - lu(k,1489) * lu(k,3702) + lu(k,3760) = lu(k,3760) - lu(k,1490) * lu(k,3702) + lu(k,3768) = lu(k,3768) - lu(k,1491) * lu(k,3702) + lu(k,3769) = lu(k,3769) - lu(k,1492) * lu(k,3702) + lu(k,3770) = lu(k,3770) - lu(k,1493) * lu(k,3702) + lu(k,3839) = lu(k,3839) - lu(k,1488) * lu(k,3827) + lu(k,3840) = lu(k,3840) - lu(k,1489) * lu(k,3827) + lu(k,3842) = lu(k,3842) - lu(k,1490) * lu(k,3827) + lu(k,3850) = lu(k,3850) - lu(k,1491) * lu(k,3827) + lu(k,3851) = lu(k,3851) - lu(k,1492) * lu(k,3827) + lu(k,3852) = lu(k,3852) - lu(k,1493) * lu(k,3827) + lu(k,4089) = lu(k,4089) - lu(k,1488) * lu(k,4023) + lu(k,4090) = lu(k,4090) - lu(k,1489) * lu(k,4023) + lu(k,4092) = lu(k,4092) - lu(k,1490) * lu(k,4023) + lu(k,4100) = lu(k,4100) - lu(k,1491) * lu(k,4023) + lu(k,4101) = lu(k,4101) - lu(k,1492) * lu(k,4023) + lu(k,4102) = lu(k,4102) - lu(k,1493) * lu(k,4023) + end do + end subroutine lu_fac33 + subroutine lu_fac34( 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,1494) = 1._r8 / lu(k,1494) + lu(k,1495) = lu(k,1495) * lu(k,1494) + lu(k,1496) = lu(k,1496) * lu(k,1494) + lu(k,1497) = lu(k,1497) * lu(k,1494) + lu(k,1516) = lu(k,1516) - lu(k,1495) * lu(k,1506) + lu(k,1517) = lu(k,1517) - lu(k,1496) * lu(k,1506) + lu(k,1520) = lu(k,1520) - lu(k,1497) * lu(k,1506) + lu(k,1743) = lu(k,1743) - lu(k,1495) * lu(k,1728) + lu(k,1744) = lu(k,1744) - lu(k,1496) * lu(k,1728) + lu(k,1747) = lu(k,1747) - lu(k,1497) * lu(k,1728) + lu(k,1765) = lu(k,1765) - lu(k,1495) * lu(k,1751) + lu(k,1766) = lu(k,1766) - lu(k,1496) * lu(k,1751) + lu(k,1769) = lu(k,1769) - lu(k,1497) * lu(k,1751) + lu(k,1829) = lu(k,1829) - lu(k,1495) * lu(k,1811) + lu(k,1830) = lu(k,1830) - lu(k,1496) * lu(k,1811) + lu(k,1833) = lu(k,1833) - lu(k,1497) * lu(k,1811) + lu(k,1860) = lu(k,1860) - lu(k,1495) * lu(k,1842) + lu(k,1861) = lu(k,1861) - lu(k,1496) * lu(k,1842) + lu(k,1864) = lu(k,1864) - lu(k,1497) * lu(k,1842) + lu(k,2002) = lu(k,2002) - lu(k,1495) * lu(k,1976) + lu(k,2003) = lu(k,2003) - lu(k,1496) * lu(k,1976) + lu(k,2007) = lu(k,2007) - lu(k,1497) * lu(k,1976) + lu(k,2188) = lu(k,2188) - lu(k,1495) * lu(k,2163) + lu(k,2189) = lu(k,2189) - lu(k,1496) * lu(k,2163) + lu(k,2195) = lu(k,2195) - lu(k,1497) * lu(k,2163) + lu(k,2224) = lu(k,2224) - lu(k,1495) * lu(k,2210) + lu(k,2225) = lu(k,2225) - lu(k,1496) * lu(k,2210) + lu(k,2229) = lu(k,2229) - lu(k,1497) * lu(k,2210) + lu(k,2282) = lu(k,2282) - lu(k,1495) * lu(k,2273) + lu(k,2283) = lu(k,2283) - lu(k,1496) * lu(k,2273) + lu(k,2287) = lu(k,2287) - lu(k,1497) * lu(k,2273) + lu(k,2308) = lu(k,2308) - lu(k,1495) * lu(k,2291) + lu(k,2309) = lu(k,2309) - lu(k,1496) * lu(k,2291) + lu(k,2313) = lu(k,2313) - lu(k,1497) * lu(k,2291) + lu(k,2352) = lu(k,2352) - lu(k,1495) * lu(k,2333) + lu(k,2353) = lu(k,2353) - lu(k,1496) * lu(k,2333) + lu(k,2357) = lu(k,2357) - lu(k,1497) * lu(k,2333) + lu(k,2421) = lu(k,2421) - lu(k,1495) * lu(k,2402) + lu(k,2422) = lu(k,2422) - lu(k,1496) * lu(k,2402) + lu(k,2426) = lu(k,2426) - lu(k,1497) * lu(k,2402) + lu(k,2453) = lu(k,2453) - lu(k,1495) * lu(k,2430) + lu(k,2454) = lu(k,2454) - lu(k,1496) * lu(k,2430) + lu(k,2458) = lu(k,2458) - lu(k,1497) * lu(k,2430) + lu(k,2484) = lu(k,2484) - lu(k,1495) * lu(k,2462) + lu(k,2485) = lu(k,2485) - lu(k,1496) * lu(k,2462) + lu(k,2489) = lu(k,2489) - lu(k,1497) * lu(k,2462) + lu(k,2518) = lu(k,2518) - lu(k,1495) * lu(k,2497) + lu(k,2519) = lu(k,2519) - lu(k,1496) * lu(k,2497) + lu(k,2523) = lu(k,2523) - lu(k,1497) * lu(k,2497) + lu(k,2547) = lu(k,2547) - lu(k,1495) * lu(k,2529) + lu(k,2548) = lu(k,2548) - lu(k,1496) * lu(k,2529) + lu(k,2552) = lu(k,2552) - lu(k,1497) * lu(k,2529) + lu(k,2583) = lu(k,2583) - lu(k,1495) * lu(k,2560) + lu(k,2584) = lu(k,2584) - lu(k,1496) * lu(k,2560) + lu(k,2588) = lu(k,2588) - lu(k,1497) * lu(k,2560) + lu(k,2664) = lu(k,2664) - lu(k,1495) * lu(k,2649) + lu(k,2665) = lu(k,2665) - lu(k,1496) * lu(k,2649) + lu(k,2669) = lu(k,2669) - lu(k,1497) * lu(k,2649) + lu(k,3109) = lu(k,3109) - lu(k,1495) * lu(k,3044) + lu(k,3110) = lu(k,3110) - lu(k,1496) * lu(k,3044) + lu(k,3119) = lu(k,3119) - lu(k,1497) * lu(k,3044) + lu(k,3368) = lu(k,3368) - lu(k,1495) * lu(k,3302) + lu(k,3369) = lu(k,3369) - lu(k,1496) * lu(k,3302) + lu(k,3378) = lu(k,3378) - lu(k,1497) * lu(k,3302) + lu(k,3461) = lu(k,3461) - lu(k,1495) * lu(k,3398) + lu(k,3462) = lu(k,3462) - lu(k,1496) * lu(k,3398) + lu(k,3471) = lu(k,3471) - lu(k,1497) * lu(k,3398) + lu(k,3605) = lu(k,3605) - lu(k,1495) * lu(k,3547) + lu(k,3606) = lu(k,3606) - lu(k,1496) * lu(k,3547) + lu(k,3615) = lu(k,3615) - lu(k,1497) * lu(k,3547) + lu(k,3759) = lu(k,3759) - lu(k,1495) * lu(k,3703) + lu(k,3760) = lu(k,3760) - lu(k,1496) * lu(k,3703) + lu(k,3769) = lu(k,3769) - lu(k,1497) * lu(k,3703) + lu(k,3841) = lu(k,3841) - lu(k,1495) * lu(k,3828) + lu(k,3842) = lu(k,3842) - lu(k,1496) * lu(k,3828) + lu(k,3851) = lu(k,3851) - lu(k,1497) * lu(k,3828) + lu(k,4091) = lu(k,4091) - lu(k,1495) * lu(k,4024) + lu(k,4092) = lu(k,4092) - lu(k,1496) * lu(k,4024) + lu(k,4101) = lu(k,4101) - lu(k,1497) * lu(k,4024) + lu(k,1498) = 1._r8 / lu(k,1498) + lu(k,1499) = lu(k,1499) * lu(k,1498) + lu(k,1500) = lu(k,1500) * lu(k,1498) + lu(k,1501) = lu(k,1501) * lu(k,1498) + lu(k,1502) = lu(k,1502) * lu(k,1498) + lu(k,1503) = lu(k,1503) * lu(k,1498) + lu(k,1504) = lu(k,1504) * lu(k,1498) + lu(k,1505) = lu(k,1505) * lu(k,1498) + lu(k,1510) = lu(k,1510) - lu(k,1499) * lu(k,1507) + lu(k,1512) = lu(k,1512) - lu(k,1500) * lu(k,1507) + lu(k,1513) = lu(k,1513) - lu(k,1501) * lu(k,1507) + lu(k,1514) = lu(k,1514) - lu(k,1502) * lu(k,1507) + lu(k,1516) = lu(k,1516) - lu(k,1503) * lu(k,1507) + lu(k,1517) = lu(k,1517) - lu(k,1504) * lu(k,1507) + lu(k,1520) = lu(k,1520) - lu(k,1505) * lu(k,1507) + lu(k,1731) = lu(k,1731) - lu(k,1499) * lu(k,1729) + lu(k,1736) = - lu(k,1500) * lu(k,1729) + lu(k,1738) = lu(k,1738) - lu(k,1501) * lu(k,1729) + lu(k,1740) = lu(k,1740) - lu(k,1502) * lu(k,1729) + lu(k,1743) = lu(k,1743) - lu(k,1503) * lu(k,1729) + lu(k,1744) = lu(k,1744) - lu(k,1504) * lu(k,1729) + lu(k,1747) = lu(k,1747) - lu(k,1505) * lu(k,1729) + lu(k,1790) = lu(k,1790) - lu(k,1499) * lu(k,1788) + lu(k,1795) = lu(k,1795) - lu(k,1500) * lu(k,1788) + lu(k,1796) = lu(k,1796) - lu(k,1501) * lu(k,1788) + lu(k,1797) = - lu(k,1502) * lu(k,1788) + lu(k,1799) = lu(k,1799) - lu(k,1503) * lu(k,1788) + lu(k,1800) = lu(k,1800) - lu(k,1504) * lu(k,1788) + lu(k,1802) = lu(k,1802) - lu(k,1505) * lu(k,1788) + lu(k,1846) = lu(k,1846) - lu(k,1499) * lu(k,1843) + lu(k,1852) = lu(k,1852) - lu(k,1500) * lu(k,1843) + lu(k,1855) = lu(k,1855) - lu(k,1501) * lu(k,1843) + lu(k,1857) = lu(k,1857) - lu(k,1502) * lu(k,1843) + lu(k,1860) = lu(k,1860) - lu(k,1503) * lu(k,1843) + lu(k,1861) = lu(k,1861) - lu(k,1504) * lu(k,1843) + lu(k,1864) = lu(k,1864) - lu(k,1505) * lu(k,1843) + lu(k,1892) = lu(k,1892) - lu(k,1499) * lu(k,1889) + lu(k,1898) = lu(k,1898) - lu(k,1500) * lu(k,1889) + lu(k,1903) = lu(k,1903) - lu(k,1501) * lu(k,1889) + lu(k,1904) = - lu(k,1502) * lu(k,1889) + lu(k,1907) = lu(k,1907) - lu(k,1503) * lu(k,1889) + lu(k,1908) = lu(k,1908) - lu(k,1504) * lu(k,1889) + lu(k,1910) = lu(k,1910) - lu(k,1505) * lu(k,1889) + lu(k,2102) = lu(k,2102) - lu(k,1499) * lu(k,2098) + lu(k,2108) = lu(k,2108) - lu(k,1500) * lu(k,2098) + lu(k,2109) = lu(k,2109) - lu(k,1501) * lu(k,2098) + lu(k,2112) = - lu(k,1502) * lu(k,2098) + lu(k,2117) = lu(k,2117) - lu(k,1503) * lu(k,2098) + lu(k,2118) = lu(k,2118) - lu(k,1504) * lu(k,2098) + lu(k,2123) = lu(k,2123) - lu(k,1505) * lu(k,2098) + lu(k,2869) = lu(k,2869) - lu(k,1499) * lu(k,2860) + lu(k,2880) = lu(k,2880) - lu(k,1500) * lu(k,2860) + lu(k,2885) = lu(k,2885) - lu(k,1501) * lu(k,2860) + lu(k,2913) = lu(k,2913) - lu(k,1502) * lu(k,2860) + lu(k,2919) = lu(k,2919) - lu(k,1503) * lu(k,2860) + lu(k,2920) = lu(k,2920) - lu(k,1504) * lu(k,2860) + lu(k,2927) = lu(k,2927) - lu(k,1505) * lu(k,2860) + lu(k,3057) = lu(k,3057) - lu(k,1499) * lu(k,3045) + lu(k,3069) = lu(k,3069) - lu(k,1500) * lu(k,3045) + lu(k,3074) = lu(k,3074) - lu(k,1501) * lu(k,3045) + lu(k,3103) = lu(k,3103) - lu(k,1502) * lu(k,3045) + lu(k,3109) = lu(k,3109) - lu(k,1503) * lu(k,3045) + lu(k,3110) = lu(k,3110) - lu(k,1504) * lu(k,3045) + lu(k,3119) = lu(k,3119) - lu(k,1505) * lu(k,3045) + lu(k,3316) = lu(k,3316) - lu(k,1499) * lu(k,3303) + lu(k,3328) = lu(k,3328) - lu(k,1500) * lu(k,3303) + lu(k,3333) = lu(k,3333) - lu(k,1501) * lu(k,3303) + lu(k,3362) = lu(k,3362) - lu(k,1502) * lu(k,3303) + lu(k,3368) = lu(k,3368) - lu(k,1503) * lu(k,3303) + lu(k,3369) = lu(k,3369) - lu(k,1504) * lu(k,3303) + lu(k,3378) = lu(k,3378) - lu(k,1505) * lu(k,3303) + lu(k,3410) = lu(k,3410) - lu(k,1499) * lu(k,3399) + lu(k,3422) = lu(k,3422) - lu(k,1500) * lu(k,3399) + lu(k,3427) = lu(k,3427) - lu(k,1501) * lu(k,3399) + lu(k,3455) = lu(k,3455) - lu(k,1502) * lu(k,3399) + lu(k,3461) = lu(k,3461) - lu(k,1503) * lu(k,3399) + lu(k,3462) = lu(k,3462) - lu(k,1504) * lu(k,3399) + lu(k,3471) = lu(k,3471) - lu(k,1505) * lu(k,3399) + lu(k,4040) = lu(k,4040) - lu(k,1499) * lu(k,4025) + lu(k,4052) = lu(k,4052) - lu(k,1500) * lu(k,4025) + lu(k,4057) = lu(k,4057) - lu(k,1501) * lu(k,4025) + lu(k,4085) = lu(k,4085) - lu(k,1502) * lu(k,4025) + lu(k,4091) = lu(k,4091) - lu(k,1503) * lu(k,4025) + lu(k,4092) = lu(k,4092) - lu(k,1504) * lu(k,4025) + lu(k,4101) = lu(k,4101) - lu(k,1505) * lu(k,4025) + lu(k,1508) = 1._r8 / lu(k,1508) + lu(k,1509) = lu(k,1509) * lu(k,1508) + lu(k,1510) = lu(k,1510) * lu(k,1508) + lu(k,1511) = lu(k,1511) * lu(k,1508) + lu(k,1512) = lu(k,1512) * lu(k,1508) + lu(k,1513) = lu(k,1513) * lu(k,1508) + lu(k,1514) = lu(k,1514) * lu(k,1508) + lu(k,1515) = lu(k,1515) * lu(k,1508) + lu(k,1516) = lu(k,1516) * lu(k,1508) + lu(k,1517) = lu(k,1517) * lu(k,1508) + lu(k,1518) = lu(k,1518) * lu(k,1508) + lu(k,1519) = lu(k,1519) * lu(k,1508) + lu(k,1520) = lu(k,1520) * lu(k,1508) + lu(k,1845) = lu(k,1845) - lu(k,1509) * lu(k,1844) + lu(k,1846) = lu(k,1846) - lu(k,1510) * lu(k,1844) + lu(k,1851) = - lu(k,1511) * lu(k,1844) + lu(k,1852) = lu(k,1852) - lu(k,1512) * lu(k,1844) + lu(k,1855) = lu(k,1855) - lu(k,1513) * lu(k,1844) + lu(k,1857) = lu(k,1857) - lu(k,1514) * lu(k,1844) + lu(k,1858) = lu(k,1858) - lu(k,1515) * lu(k,1844) + lu(k,1860) = lu(k,1860) - lu(k,1516) * lu(k,1844) + lu(k,1861) = lu(k,1861) - lu(k,1517) * lu(k,1844) + lu(k,1862) = lu(k,1862) - lu(k,1518) * lu(k,1844) + lu(k,1863) = lu(k,1863) - lu(k,1519) * lu(k,1844) + lu(k,1864) = lu(k,1864) - lu(k,1520) * lu(k,1844) + lu(k,2036) = lu(k,2036) - lu(k,1509) * lu(k,2035) + lu(k,2037) = - lu(k,1510) * lu(k,2035) + lu(k,2039) = - lu(k,1511) * lu(k,2035) + lu(k,2040) = lu(k,2040) - lu(k,1512) * lu(k,2035) + lu(k,2042) = lu(k,2042) - lu(k,1513) * lu(k,2035) + lu(k,2044) = lu(k,2044) - lu(k,1514) * lu(k,2035) + lu(k,2046) = lu(k,2046) - lu(k,1515) * lu(k,2035) + lu(k,2048) = lu(k,2048) - lu(k,1516) * lu(k,2035) + lu(k,2049) = lu(k,2049) - lu(k,1517) * lu(k,2035) + lu(k,2050) = lu(k,2050) - lu(k,1518) * lu(k,2035) + lu(k,2052) = lu(k,2052) - lu(k,1519) * lu(k,2035) + lu(k,2054) = lu(k,2054) - lu(k,1520) * lu(k,2035) + lu(k,2865) = lu(k,2865) - lu(k,1509) * lu(k,2861) + lu(k,2869) = lu(k,2869) - lu(k,1510) * lu(k,2861) + lu(k,2879) = - lu(k,1511) * lu(k,2861) + lu(k,2880) = lu(k,2880) - lu(k,1512) * lu(k,2861) + lu(k,2885) = lu(k,2885) - lu(k,1513) * lu(k,2861) + lu(k,2913) = lu(k,2913) - lu(k,1514) * lu(k,2861) + lu(k,2916) = lu(k,2916) - lu(k,1515) * lu(k,2861) + lu(k,2919) = lu(k,2919) - lu(k,1516) * lu(k,2861) + lu(k,2920) = lu(k,2920) - lu(k,1517) * lu(k,2861) + lu(k,2921) = lu(k,2921) - lu(k,1518) * lu(k,2861) + lu(k,2923) = lu(k,2923) - lu(k,1519) * lu(k,2861) + lu(k,2927) = lu(k,2927) - lu(k,1520) * lu(k,2861) + lu(k,3051) = lu(k,3051) - lu(k,1509) * lu(k,3046) + lu(k,3057) = lu(k,3057) - lu(k,1510) * lu(k,3046) + lu(k,3068) = lu(k,3068) - lu(k,1511) * lu(k,3046) + lu(k,3069) = lu(k,3069) - lu(k,1512) * lu(k,3046) + lu(k,3074) = lu(k,3074) - lu(k,1513) * lu(k,3046) + lu(k,3103) = lu(k,3103) - lu(k,1514) * lu(k,3046) + lu(k,3106) = lu(k,3106) - lu(k,1515) * lu(k,3046) + lu(k,3109) = lu(k,3109) - lu(k,1516) * lu(k,3046) + lu(k,3110) = lu(k,3110) - lu(k,1517) * lu(k,3046) + lu(k,3111) = lu(k,3111) - lu(k,1518) * lu(k,3046) + lu(k,3115) = lu(k,3115) - lu(k,1519) * lu(k,3046) + lu(k,3119) = lu(k,3119) - lu(k,1520) * lu(k,3046) + lu(k,3309) = lu(k,3309) - lu(k,1509) * lu(k,3304) + lu(k,3316) = lu(k,3316) - lu(k,1510) * lu(k,3304) + lu(k,3327) = lu(k,3327) - lu(k,1511) * lu(k,3304) + lu(k,3328) = lu(k,3328) - lu(k,1512) * lu(k,3304) + lu(k,3333) = lu(k,3333) - lu(k,1513) * lu(k,3304) + lu(k,3362) = lu(k,3362) - lu(k,1514) * lu(k,3304) + lu(k,3365) = lu(k,3365) - lu(k,1515) * lu(k,3304) + lu(k,3368) = lu(k,3368) - lu(k,1516) * lu(k,3304) + lu(k,3369) = lu(k,3369) - lu(k,1517) * lu(k,3304) + lu(k,3370) = lu(k,3370) - lu(k,1518) * lu(k,3304) + lu(k,3374) = lu(k,3374) - lu(k,1519) * lu(k,3304) + lu(k,3378) = lu(k,3378) - lu(k,1520) * lu(k,3304) + lu(k,3404) = lu(k,3404) - lu(k,1509) * lu(k,3400) + lu(k,3410) = lu(k,3410) - lu(k,1510) * lu(k,3400) + lu(k,3421) = lu(k,3421) - lu(k,1511) * lu(k,3400) + lu(k,3422) = lu(k,3422) - lu(k,1512) * lu(k,3400) + lu(k,3427) = lu(k,3427) - lu(k,1513) * lu(k,3400) + lu(k,3455) = lu(k,3455) - lu(k,1514) * lu(k,3400) + lu(k,3458) = lu(k,3458) - lu(k,1515) * lu(k,3400) + lu(k,3461) = lu(k,3461) - lu(k,1516) * lu(k,3400) + lu(k,3462) = lu(k,3462) - lu(k,1517) * lu(k,3400) + lu(k,3463) = lu(k,3463) - lu(k,1518) * lu(k,3400) + lu(k,3467) = lu(k,3467) - lu(k,1519) * lu(k,3400) + lu(k,3471) = lu(k,3471) - lu(k,1520) * lu(k,3400) + lu(k,4033) = lu(k,4033) - lu(k,1509) * lu(k,4026) + lu(k,4040) = lu(k,4040) - lu(k,1510) * lu(k,4026) + lu(k,4051) = lu(k,4051) - lu(k,1511) * lu(k,4026) + lu(k,4052) = lu(k,4052) - lu(k,1512) * lu(k,4026) + lu(k,4057) = lu(k,4057) - lu(k,1513) * lu(k,4026) + lu(k,4085) = lu(k,4085) - lu(k,1514) * lu(k,4026) + lu(k,4088) = lu(k,4088) - lu(k,1515) * lu(k,4026) + lu(k,4091) = lu(k,4091) - lu(k,1516) * lu(k,4026) + lu(k,4092) = lu(k,4092) - lu(k,1517) * lu(k,4026) + lu(k,4093) = lu(k,4093) - lu(k,1518) * lu(k,4026) + lu(k,4097) = lu(k,4097) - lu(k,1519) * lu(k,4026) + lu(k,4101) = lu(k,4101) - lu(k,1520) * lu(k,4026) + lu(k,1524) = 1._r8 / lu(k,1524) + lu(k,1525) = lu(k,1525) * lu(k,1524) + lu(k,1526) = lu(k,1526) * lu(k,1524) + lu(k,1527) = lu(k,1527) * lu(k,1524) + lu(k,1528) = lu(k,1528) * lu(k,1524) + lu(k,1529) = lu(k,1529) * lu(k,1524) + lu(k,1530) = lu(k,1530) * lu(k,1524) + lu(k,1531) = lu(k,1531) * lu(k,1524) + lu(k,1532) = lu(k,1532) * lu(k,1524) + lu(k,1533) = lu(k,1533) * lu(k,1524) + lu(k,1534) = lu(k,1534) * lu(k,1524) + lu(k,1535) = lu(k,1535) * lu(k,1524) + lu(k,1573) = lu(k,1573) - lu(k,1525) * lu(k,1571) + lu(k,1576) = lu(k,1576) - lu(k,1526) * lu(k,1571) + lu(k,1577) = lu(k,1577) - lu(k,1527) * lu(k,1571) + lu(k,1579) = lu(k,1579) - lu(k,1528) * lu(k,1571) + lu(k,1581) = lu(k,1581) - lu(k,1529) * lu(k,1571) + lu(k,1582) = lu(k,1582) - lu(k,1530) * lu(k,1571) + lu(k,1587) = lu(k,1587) - lu(k,1531) * lu(k,1571) + lu(k,1590) = lu(k,1590) - lu(k,1532) * lu(k,1571) + lu(k,1591) = lu(k,1591) - lu(k,1533) * lu(k,1571) + lu(k,1592) = lu(k,1592) - lu(k,1534) * lu(k,1571) + lu(k,1595) = lu(k,1595) - lu(k,1535) * lu(k,1571) + lu(k,1891) = lu(k,1891) - lu(k,1525) * lu(k,1890) + lu(k,1892) = lu(k,1892) - lu(k,1526) * lu(k,1890) + lu(k,1893) = lu(k,1893) - lu(k,1527) * lu(k,1890) + lu(k,1894) = - lu(k,1528) * lu(k,1890) + lu(k,1898) = lu(k,1898) - lu(k,1529) * lu(k,1890) + lu(k,1903) = lu(k,1903) - lu(k,1530) * lu(k,1890) + lu(k,1905) = - lu(k,1531) * lu(k,1890) + lu(k,1907) = lu(k,1907) - lu(k,1532) * lu(k,1890) + lu(k,1908) = lu(k,1908) - lu(k,1533) * lu(k,1890) + lu(k,1909) = - lu(k,1534) * lu(k,1890) + lu(k,1910) = lu(k,1910) - lu(k,1535) * lu(k,1890) + lu(k,1941) = lu(k,1941) - lu(k,1525) * lu(k,1940) + lu(k,1943) = lu(k,1943) - lu(k,1526) * lu(k,1940) + lu(k,1945) = lu(k,1945) - lu(k,1527) * lu(k,1940) + lu(k,1947) = lu(k,1947) - lu(k,1528) * lu(k,1940) + lu(k,1952) = - lu(k,1529) * lu(k,1940) + lu(k,1957) = - lu(k,1530) * lu(k,1940) + lu(k,1961) = lu(k,1961) - lu(k,1531) * lu(k,1940) + lu(k,1963) = lu(k,1963) - lu(k,1532) * lu(k,1940) + lu(k,1964) = lu(k,1964) - lu(k,1533) * lu(k,1940) + lu(k,1967) = lu(k,1967) - lu(k,1534) * lu(k,1940) + lu(k,1968) = lu(k,1968) - lu(k,1535) * lu(k,1940) + lu(k,1978) = lu(k,1978) - lu(k,1525) * lu(k,1977) + lu(k,1980) = lu(k,1980) - lu(k,1526) * lu(k,1977) + lu(k,1982) = lu(k,1982) - lu(k,1527) * lu(k,1977) + lu(k,1984) = lu(k,1984) - lu(k,1528) * lu(k,1977) + lu(k,1989) = - lu(k,1529) * lu(k,1977) + lu(k,1994) = - lu(k,1530) * lu(k,1977) + lu(k,2000) = lu(k,2000) - lu(k,1531) * lu(k,1977) + lu(k,2002) = lu(k,2002) - lu(k,1532) * lu(k,1977) + lu(k,2003) = lu(k,2003) - lu(k,1533) * lu(k,1977) + lu(k,2006) = lu(k,2006) - lu(k,1534) * lu(k,1977) + lu(k,2007) = lu(k,2007) - lu(k,1535) * lu(k,1977) + lu(k,2068) = lu(k,2068) - lu(k,1525) * lu(k,2067) + lu(k,2070) = lu(k,2070) - lu(k,1526) * lu(k,2067) + lu(k,2071) = lu(k,2071) - lu(k,1527) * lu(k,2067) + lu(k,2073) = lu(k,2073) - lu(k,1528) * lu(k,2067) + lu(k,2076) = lu(k,2076) - lu(k,1529) * lu(k,2067) + lu(k,2077) = lu(k,2077) - lu(k,1530) * lu(k,2067) + lu(k,2082) = lu(k,2082) - lu(k,1531) * lu(k,2067) + lu(k,2085) = lu(k,2085) - lu(k,1532) * lu(k,2067) + lu(k,2086) = lu(k,2086) - lu(k,1533) * lu(k,2067) + lu(k,2088) = lu(k,2088) - lu(k,1534) * lu(k,2067) + lu(k,2091) = lu(k,2091) - lu(k,1535) * lu(k,2067) + lu(k,2100) = lu(k,2100) - lu(k,1525) * lu(k,2099) + lu(k,2102) = lu(k,2102) - lu(k,1526) * lu(k,2099) + lu(k,2103) = lu(k,2103) - lu(k,1527) * lu(k,2099) + lu(k,2105) = lu(k,2105) - lu(k,1528) * lu(k,2099) + lu(k,2108) = lu(k,2108) - lu(k,1529) * lu(k,2099) + lu(k,2109) = lu(k,2109) - lu(k,1530) * lu(k,2099) + lu(k,2114) = lu(k,2114) - lu(k,1531) * lu(k,2099) + lu(k,2117) = lu(k,2117) - lu(k,1532) * lu(k,2099) + lu(k,2118) = lu(k,2118) - lu(k,1533) * lu(k,2099) + lu(k,2120) = lu(k,2120) - lu(k,1534) * lu(k,2099) + lu(k,2123) = lu(k,2123) - lu(k,1535) * lu(k,2099) + lu(k,3051) = lu(k,3051) - lu(k,1525) * lu(k,3047) + lu(k,3057) = lu(k,3057) - lu(k,1526) * lu(k,3047) + lu(k,3061) = lu(k,3061) - lu(k,1527) * lu(k,3047) + lu(k,3063) = lu(k,3063) - lu(k,1528) * lu(k,3047) + lu(k,3069) = lu(k,3069) - lu(k,1529) * lu(k,3047) + lu(k,3074) = lu(k,3074) - lu(k,1530) * lu(k,3047) + lu(k,3106) = lu(k,3106) - lu(k,1531) * lu(k,3047) + lu(k,3109) = lu(k,3109) - lu(k,1532) * lu(k,3047) + lu(k,3110) = lu(k,3110) - lu(k,1533) * lu(k,3047) + lu(k,3115) = lu(k,3115) - lu(k,1534) * lu(k,3047) + lu(k,3119) = lu(k,3119) - lu(k,1535) * lu(k,3047) + lu(k,4033) = lu(k,4033) - lu(k,1525) * lu(k,4027) + lu(k,4040) = lu(k,4040) - lu(k,1526) * lu(k,4027) + lu(k,4044) = lu(k,4044) - lu(k,1527) * lu(k,4027) + lu(k,4046) = lu(k,4046) - lu(k,1528) * lu(k,4027) + lu(k,4052) = lu(k,4052) - lu(k,1529) * lu(k,4027) + lu(k,4057) = lu(k,4057) - lu(k,1530) * lu(k,4027) + lu(k,4088) = lu(k,4088) - lu(k,1531) * lu(k,4027) + lu(k,4091) = lu(k,4091) - lu(k,1532) * lu(k,4027) + lu(k,4092) = lu(k,4092) - lu(k,1533) * lu(k,4027) + lu(k,4097) = lu(k,4097) - lu(k,1534) * lu(k,4027) + lu(k,4101) = lu(k,4101) - lu(k,1535) * lu(k,4027) + end do + end subroutine lu_fac34 + subroutine lu_fac35( 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,1536) = 1._r8 / lu(k,1536) + lu(k,1537) = lu(k,1537) * lu(k,1536) + lu(k,1538) = lu(k,1538) * lu(k,1536) + lu(k,1539) = lu(k,1539) * lu(k,1536) + lu(k,1540) = lu(k,1540) * lu(k,1536) + lu(k,1541) = lu(k,1541) * lu(k,1536) + lu(k,1703) = - lu(k,1537) * lu(k,1700) + lu(k,1705) = lu(k,1705) - lu(k,1538) * lu(k,1700) + lu(k,1707) = lu(k,1707) - lu(k,1539) * lu(k,1700) + lu(k,1708) = lu(k,1708) - lu(k,1540) * lu(k,1700) + lu(k,1709) = lu(k,1709) - lu(k,1541) * lu(k,1700) + lu(k,2237) = - lu(k,1537) * lu(k,2231) + lu(k,2245) = - lu(k,1538) * lu(k,2231) + lu(k,2249) = lu(k,2249) - lu(k,1539) * lu(k,2231) + lu(k,2252) = lu(k,2252) - lu(k,1540) * lu(k,2231) + lu(k,2253) = lu(k,2253) - lu(k,1541) * lu(k,2231) + lu(k,2297) = lu(k,2297) - lu(k,1537) * lu(k,2292) + lu(k,2305) = lu(k,2305) - lu(k,1538) * lu(k,2292) + lu(k,2309) = lu(k,2309) - lu(k,1539) * lu(k,2292) + lu(k,2312) = lu(k,2312) - lu(k,1540) * lu(k,2292) + lu(k,2313) = lu(k,2313) - lu(k,1541) * lu(k,2292) + lu(k,2379) = lu(k,2379) - lu(k,1537) * lu(k,2370) + lu(k,2389) = - lu(k,1538) * lu(k,2370) + lu(k,2393) = lu(k,2393) - lu(k,1539) * lu(k,2370) + lu(k,2396) = lu(k,2396) - lu(k,1540) * lu(k,2370) + lu(k,2397) = lu(k,2397) - lu(k,1541) * lu(k,2370) + lu(k,2440) = lu(k,2440) - lu(k,1537) * lu(k,2431) + lu(k,2450) = - lu(k,1538) * lu(k,2431) + lu(k,2454) = lu(k,2454) - lu(k,1539) * lu(k,2431) + lu(k,2457) = lu(k,2457) - lu(k,1540) * lu(k,2431) + lu(k,2458) = lu(k,2458) - lu(k,1541) * lu(k,2431) + lu(k,2504) = lu(k,2504) - lu(k,1537) * lu(k,2498) + lu(k,2515) = lu(k,2515) - lu(k,1538) * lu(k,2498) + lu(k,2519) = lu(k,2519) - lu(k,1539) * lu(k,2498) + lu(k,2522) = lu(k,2522) - lu(k,1540) * lu(k,2498) + lu(k,2523) = lu(k,2523) - lu(k,1541) * lu(k,2498) + lu(k,2535) = lu(k,2535) - lu(k,1537) * lu(k,2530) + lu(k,2544) = lu(k,2544) - lu(k,1538) * lu(k,2530) + lu(k,2548) = lu(k,2548) - lu(k,1539) * lu(k,2530) + lu(k,2551) = lu(k,2551) - lu(k,1540) * lu(k,2530) + lu(k,2552) = lu(k,2552) - lu(k,1541) * lu(k,2530) + lu(k,2568) = lu(k,2568) - lu(k,1537) * lu(k,2561) + lu(k,2580) = lu(k,2580) - lu(k,1538) * lu(k,2561) + lu(k,2584) = lu(k,2584) - lu(k,1539) * lu(k,2561) + lu(k,2587) = lu(k,2587) - lu(k,1540) * lu(k,2561) + lu(k,2588) = lu(k,2588) - lu(k,1541) * lu(k,2561) + lu(k,2698) = lu(k,2698) - lu(k,1537) * lu(k,2693) + lu(k,2706) = - lu(k,1538) * lu(k,2693) + lu(k,2710) = lu(k,2710) - lu(k,1539) * lu(k,2693) + lu(k,2713) = lu(k,2713) - lu(k,1540) * lu(k,2693) + lu(k,2714) = lu(k,2714) - lu(k,1541) * lu(k,2693) + lu(k,2732) = lu(k,2732) - lu(k,1537) * lu(k,2719) + lu(k,2749) = - lu(k,1538) * lu(k,2719) + lu(k,2754) = lu(k,2754) - lu(k,1539) * lu(k,2719) + lu(k,2757) = lu(k,2757) - lu(k,1540) * lu(k,2719) + lu(k,2760) = lu(k,2760) - lu(k,1541) * lu(k,2719) + lu(k,2778) = lu(k,2778) - lu(k,1537) * lu(k,2765) + lu(k,2795) = - lu(k,1538) * lu(k,2765) + lu(k,2800) = lu(k,2800) - lu(k,1539) * lu(k,2765) + lu(k,2803) = lu(k,2803) - lu(k,1540) * lu(k,2765) + lu(k,2806) = lu(k,2806) - lu(k,1541) * lu(k,2765) + lu(k,2825) = lu(k,2825) - lu(k,1537) * lu(k,2812) + lu(k,2842) = lu(k,2842) - lu(k,1538) * lu(k,2812) + lu(k,2847) = lu(k,2847) - lu(k,1539) * lu(k,2812) + lu(k,2850) = lu(k,2850) - lu(k,1540) * lu(k,2812) + lu(k,2853) = lu(k,2853) - lu(k,1541) * lu(k,2812) + lu(k,2897) = lu(k,2897) - lu(k,1537) * lu(k,2862) + lu(k,2915) = - lu(k,1538) * lu(k,2862) + lu(k,2920) = lu(k,2920) - lu(k,1539) * lu(k,2862) + lu(k,2923) = lu(k,2923) - lu(k,1540) * lu(k,2862) + lu(k,2927) = lu(k,2927) - lu(k,1541) * lu(k,2862) + lu(k,3087) = lu(k,3087) - lu(k,1537) * lu(k,3048) + lu(k,3105) = lu(k,3105) - lu(k,1538) * lu(k,3048) + lu(k,3110) = lu(k,3110) - lu(k,1539) * lu(k,3048) + lu(k,3115) = lu(k,3115) - lu(k,1540) * lu(k,3048) + lu(k,3119) = lu(k,3119) - lu(k,1541) * lu(k,3048) + lu(k,3346) = lu(k,3346) - lu(k,1537) * lu(k,3305) + lu(k,3364) = lu(k,3364) - lu(k,1538) * lu(k,3305) + lu(k,3369) = lu(k,3369) - lu(k,1539) * lu(k,3305) + lu(k,3374) = lu(k,3374) - lu(k,1540) * lu(k,3305) + lu(k,3378) = lu(k,3378) - lu(k,1541) * lu(k,3305) + lu(k,3439) = lu(k,3439) - lu(k,1537) * lu(k,3401) + lu(k,3457) = lu(k,3457) - lu(k,1538) * lu(k,3401) + lu(k,3462) = lu(k,3462) - lu(k,1539) * lu(k,3401) + lu(k,3467) = lu(k,3467) - lu(k,1540) * lu(k,3401) + lu(k,3471) = lu(k,3471) - lu(k,1541) * lu(k,3401) + lu(k,3583) = lu(k,3583) - lu(k,1537) * lu(k,3548) + lu(k,3601) = lu(k,3601) - lu(k,1538) * lu(k,3548) + lu(k,3606) = lu(k,3606) - lu(k,1539) * lu(k,3548) + lu(k,3611) = lu(k,3611) - lu(k,1540) * lu(k,3548) + lu(k,3615) = lu(k,3615) - lu(k,1541) * lu(k,3548) + lu(k,4069) = lu(k,4069) - lu(k,1537) * lu(k,4028) + lu(k,4087) = lu(k,4087) - lu(k,1538) * lu(k,4028) + lu(k,4092) = lu(k,4092) - lu(k,1539) * lu(k,4028) + lu(k,4097) = lu(k,4097) - lu(k,1540) * lu(k,4028) + lu(k,4101) = lu(k,4101) - lu(k,1541) * lu(k,4028) + lu(k,1543) = 1._r8 / lu(k,1543) + lu(k,1544) = lu(k,1544) * lu(k,1543) + lu(k,1545) = lu(k,1545) * lu(k,1543) + lu(k,1546) = lu(k,1546) * lu(k,1543) + lu(k,1547) = lu(k,1547) * lu(k,1543) + lu(k,1548) = lu(k,1548) * lu(k,1543) + lu(k,1549) = lu(k,1549) * lu(k,1543) + lu(k,1550) = lu(k,1550) * lu(k,1543) + lu(k,1551) = lu(k,1551) * lu(k,1543) + lu(k,1552) = lu(k,1552) * lu(k,1543) + lu(k,1553) = lu(k,1553) * lu(k,1543) + lu(k,1554) = lu(k,1554) * lu(k,1543) + lu(k,1555) = lu(k,1555) * lu(k,1543) + lu(k,1556) = lu(k,1556) * lu(k,1543) + lu(k,1813) = lu(k,1813) - lu(k,1544) * lu(k,1812) + lu(k,1815) = lu(k,1815) - lu(k,1545) * lu(k,1812) + lu(k,1816) = - lu(k,1546) * lu(k,1812) + lu(k,1820) = lu(k,1820) - lu(k,1547) * lu(k,1812) + lu(k,1823) = lu(k,1823) - lu(k,1548) * lu(k,1812) + lu(k,1825) = - lu(k,1549) * lu(k,1812) + lu(k,1826) = lu(k,1826) - lu(k,1550) * lu(k,1812) + lu(k,1827) = lu(k,1827) - lu(k,1551) * lu(k,1812) + lu(k,1829) = lu(k,1829) - lu(k,1552) * lu(k,1812) + lu(k,1830) = lu(k,1830) - lu(k,1553) * lu(k,1812) + lu(k,1831) = lu(k,1831) - lu(k,1554) * lu(k,1812) + lu(k,1832) = lu(k,1832) - lu(k,1555) * lu(k,1812) + lu(k,1833) = lu(k,1833) - lu(k,1556) * lu(k,1812) + lu(k,2011) = lu(k,2011) - lu(k,1544) * lu(k,2010) + lu(k,2013) = - lu(k,1545) * lu(k,2010) + lu(k,2014) = - lu(k,1546) * lu(k,2010) + lu(k,2015) = lu(k,2015) - lu(k,1547) * lu(k,2010) + lu(k,2017) = lu(k,2017) - lu(k,1548) * lu(k,2010) + lu(k,2018) = - lu(k,1549) * lu(k,2010) + lu(k,2019) = lu(k,2019) - lu(k,1550) * lu(k,2010) + lu(k,2021) = - lu(k,1551) * lu(k,2010) + lu(k,2023) = lu(k,2023) - lu(k,1552) * lu(k,2010) + lu(k,2024) = lu(k,2024) - lu(k,1553) * lu(k,2010) + lu(k,2025) = lu(k,2025) - lu(k,1554) * lu(k,2010) + lu(k,2027) = - lu(k,1555) * lu(k,2010) + lu(k,2029) = lu(k,2029) - lu(k,1556) * lu(k,2010) + lu(k,2865) = lu(k,2865) - lu(k,1544) * lu(k,2863) + lu(k,2873) = lu(k,2873) - lu(k,1545) * lu(k,2863) + lu(k,2874) = - lu(k,1546) * lu(k,2863) + lu(k,2880) = lu(k,2880) - lu(k,1547) * lu(k,2863) + lu(k,2885) = lu(k,2885) - lu(k,1548) * lu(k,2863) + lu(k,2893) = lu(k,2893) - lu(k,1549) * lu(k,2863) + lu(k,2913) = lu(k,2913) - lu(k,1550) * lu(k,2863) + lu(k,2916) = lu(k,2916) - lu(k,1551) * lu(k,2863) + lu(k,2919) = lu(k,2919) - lu(k,1552) * lu(k,2863) + lu(k,2920) = lu(k,2920) - lu(k,1553) * lu(k,2863) + lu(k,2921) = lu(k,2921) - lu(k,1554) * lu(k,2863) + lu(k,2923) = lu(k,2923) - lu(k,1555) * lu(k,2863) + lu(k,2927) = lu(k,2927) - lu(k,1556) * lu(k,2863) + lu(k,3051) = lu(k,3051) - lu(k,1544) * lu(k,3049) + lu(k,3061) = lu(k,3061) - lu(k,1545) * lu(k,3049) + lu(k,3062) = lu(k,3062) - lu(k,1546) * lu(k,3049) + lu(k,3069) = lu(k,3069) - lu(k,1547) * lu(k,3049) + lu(k,3074) = lu(k,3074) - lu(k,1548) * lu(k,3049) + lu(k,3083) = lu(k,3083) - lu(k,1549) * lu(k,3049) + lu(k,3103) = lu(k,3103) - lu(k,1550) * lu(k,3049) + lu(k,3106) = lu(k,3106) - lu(k,1551) * lu(k,3049) + lu(k,3109) = lu(k,3109) - lu(k,1552) * lu(k,3049) + lu(k,3110) = lu(k,3110) - lu(k,1553) * lu(k,3049) + lu(k,3111) = lu(k,3111) - lu(k,1554) * lu(k,3049) + lu(k,3115) = lu(k,3115) - lu(k,1555) * lu(k,3049) + lu(k,3119) = lu(k,3119) - lu(k,1556) * lu(k,3049) + lu(k,3309) = lu(k,3309) - lu(k,1544) * lu(k,3306) + lu(k,3320) = lu(k,3320) - lu(k,1545) * lu(k,3306) + lu(k,3321) = lu(k,3321) - lu(k,1546) * lu(k,3306) + lu(k,3328) = lu(k,3328) - lu(k,1547) * lu(k,3306) + lu(k,3333) = lu(k,3333) - lu(k,1548) * lu(k,3306) + lu(k,3342) = lu(k,3342) - lu(k,1549) * lu(k,3306) + lu(k,3362) = lu(k,3362) - lu(k,1550) * lu(k,3306) + lu(k,3365) = lu(k,3365) - lu(k,1551) * lu(k,3306) + lu(k,3368) = lu(k,3368) - lu(k,1552) * lu(k,3306) + lu(k,3369) = lu(k,3369) - lu(k,1553) * lu(k,3306) + lu(k,3370) = lu(k,3370) - lu(k,1554) * lu(k,3306) + lu(k,3374) = lu(k,3374) - lu(k,1555) * lu(k,3306) + lu(k,3378) = lu(k,3378) - lu(k,1556) * lu(k,3306) + lu(k,3404) = lu(k,3404) - lu(k,1544) * lu(k,3402) + lu(k,3414) = lu(k,3414) - lu(k,1545) * lu(k,3402) + lu(k,3415) = lu(k,3415) - lu(k,1546) * lu(k,3402) + lu(k,3422) = lu(k,3422) - lu(k,1547) * lu(k,3402) + lu(k,3427) = lu(k,3427) - lu(k,1548) * lu(k,3402) + lu(k,3435) = lu(k,3435) - lu(k,1549) * lu(k,3402) + lu(k,3455) = lu(k,3455) - lu(k,1550) * lu(k,3402) + lu(k,3458) = lu(k,3458) - lu(k,1551) * lu(k,3402) + lu(k,3461) = lu(k,3461) - lu(k,1552) * lu(k,3402) + lu(k,3462) = lu(k,3462) - lu(k,1553) * lu(k,3402) + lu(k,3463) = lu(k,3463) - lu(k,1554) * lu(k,3402) + lu(k,3467) = lu(k,3467) - lu(k,1555) * lu(k,3402) + lu(k,3471) = lu(k,3471) - lu(k,1556) * lu(k,3402) + lu(k,4033) = lu(k,4033) - lu(k,1544) * lu(k,4029) + lu(k,4044) = lu(k,4044) - lu(k,1545) * lu(k,4029) + lu(k,4045) = lu(k,4045) - lu(k,1546) * lu(k,4029) + lu(k,4052) = lu(k,4052) - lu(k,1547) * lu(k,4029) + lu(k,4057) = lu(k,4057) - lu(k,1548) * lu(k,4029) + lu(k,4065) = lu(k,4065) - lu(k,1549) * lu(k,4029) + lu(k,4085) = lu(k,4085) - lu(k,1550) * lu(k,4029) + lu(k,4088) = lu(k,4088) - lu(k,1551) * lu(k,4029) + lu(k,4091) = lu(k,4091) - lu(k,1552) * lu(k,4029) + lu(k,4092) = lu(k,4092) - lu(k,1553) * lu(k,4029) + lu(k,4093) = lu(k,4093) - lu(k,1554) * lu(k,4029) + lu(k,4097) = lu(k,4097) - lu(k,1555) * lu(k,4029) + lu(k,4101) = lu(k,4101) - lu(k,1556) * lu(k,4029) + lu(k,1557) = 1._r8 / lu(k,1557) + lu(k,1558) = lu(k,1558) * lu(k,1557) + lu(k,1559) = lu(k,1559) * lu(k,1557) + lu(k,1560) = lu(k,1560) * lu(k,1557) + lu(k,1561) = lu(k,1561) * lu(k,1557) + lu(k,1690) = - lu(k,1558) * lu(k,1688) + lu(k,1694) = lu(k,1694) - lu(k,1559) * lu(k,1688) + lu(k,1695) = lu(k,1695) - lu(k,1560) * lu(k,1688) + lu(k,1696) = lu(k,1696) - lu(k,1561) * lu(k,1688) + lu(k,1703) = lu(k,1703) - lu(k,1558) * lu(k,1701) + lu(k,1707) = lu(k,1707) - lu(k,1559) * lu(k,1701) + lu(k,1708) = lu(k,1708) - lu(k,1560) * lu(k,1701) + lu(k,1709) = lu(k,1709) - lu(k,1561) * lu(k,1701) + lu(k,2297) = lu(k,2297) - lu(k,1558) * lu(k,2293) + lu(k,2309) = lu(k,2309) - lu(k,1559) * lu(k,2293) + lu(k,2312) = lu(k,2312) - lu(k,1560) * lu(k,2293) + lu(k,2313) = lu(k,2313) - lu(k,1561) * lu(k,2293) + lu(k,2321) = lu(k,2321) - lu(k,1558) * lu(k,2317) + lu(k,2329) = lu(k,2329) - lu(k,1559) * lu(k,2317) + lu(k,2331) = lu(k,2331) - lu(k,1560) * lu(k,2317) + lu(k,2332) = lu(k,2332) - lu(k,1561) * lu(k,2317) + lu(k,2379) = lu(k,2379) - lu(k,1558) * lu(k,2371) + lu(k,2393) = lu(k,2393) - lu(k,1559) * lu(k,2371) + lu(k,2396) = lu(k,2396) - lu(k,1560) * lu(k,2371) + lu(k,2397) = lu(k,2397) - lu(k,1561) * lu(k,2371) + lu(k,2407) = lu(k,2407) - lu(k,1558) * lu(k,2403) + lu(k,2422) = lu(k,2422) - lu(k,1559) * lu(k,2403) + lu(k,2425) = lu(k,2425) - lu(k,1560) * lu(k,2403) + lu(k,2426) = lu(k,2426) - lu(k,1561) * lu(k,2403) + lu(k,2440) = lu(k,2440) - lu(k,1558) * lu(k,2432) + lu(k,2454) = lu(k,2454) - lu(k,1559) * lu(k,2432) + lu(k,2457) = lu(k,2457) - lu(k,1560) * lu(k,2432) + lu(k,2458) = lu(k,2458) - lu(k,1561) * lu(k,2432) + lu(k,2470) = lu(k,2470) - lu(k,1558) * lu(k,2463) + lu(k,2485) = lu(k,2485) - lu(k,1559) * lu(k,2463) + lu(k,2488) = lu(k,2488) - lu(k,1560) * lu(k,2463) + lu(k,2489) = lu(k,2489) - lu(k,1561) * lu(k,2463) + lu(k,2504) = lu(k,2504) - lu(k,1558) * lu(k,2499) + lu(k,2519) = lu(k,2519) - lu(k,1559) * lu(k,2499) + lu(k,2522) = lu(k,2522) - lu(k,1560) * lu(k,2499) + lu(k,2523) = lu(k,2523) - lu(k,1561) * lu(k,2499) + lu(k,2535) = lu(k,2535) - lu(k,1558) * lu(k,2531) + lu(k,2548) = lu(k,2548) - lu(k,1559) * lu(k,2531) + lu(k,2551) = lu(k,2551) - lu(k,1560) * lu(k,2531) + lu(k,2552) = lu(k,2552) - lu(k,1561) * lu(k,2531) + lu(k,2568) = lu(k,2568) - lu(k,1558) * lu(k,2562) + lu(k,2584) = lu(k,2584) - lu(k,1559) * lu(k,2562) + lu(k,2587) = lu(k,2587) - lu(k,1560) * lu(k,2562) + lu(k,2588) = lu(k,2588) - lu(k,1561) * lu(k,2562) + lu(k,2628) = - lu(k,1558) * lu(k,2624) + lu(k,2640) = lu(k,2640) - lu(k,1559) * lu(k,2624) + lu(k,2642) = lu(k,2642) - lu(k,1560) * lu(k,2624) + lu(k,2645) = lu(k,2645) - lu(k,1561) * lu(k,2624) + lu(k,2653) = lu(k,2653) - lu(k,1558) * lu(k,2650) + lu(k,2665) = lu(k,2665) - lu(k,1559) * lu(k,2650) + lu(k,2668) = lu(k,2668) - lu(k,1560) * lu(k,2650) + lu(k,2669) = lu(k,2669) - lu(k,1561) * lu(k,2650) + lu(k,2675) = - lu(k,1558) * lu(k,2671) + lu(k,2687) = lu(k,2687) - lu(k,1559) * lu(k,2671) + lu(k,2690) = lu(k,2690) - lu(k,1560) * lu(k,2671) + lu(k,2691) = lu(k,2691) - lu(k,1561) * lu(k,2671) + lu(k,2732) = lu(k,2732) - lu(k,1558) * lu(k,2720) + lu(k,2754) = lu(k,2754) - lu(k,1559) * lu(k,2720) + lu(k,2757) = lu(k,2757) - lu(k,1560) * lu(k,2720) + lu(k,2760) = lu(k,2760) - lu(k,1561) * lu(k,2720) + lu(k,2778) = lu(k,2778) - lu(k,1558) * lu(k,2766) + lu(k,2800) = lu(k,2800) - lu(k,1559) * lu(k,2766) + lu(k,2803) = lu(k,2803) - lu(k,1560) * lu(k,2766) + lu(k,2806) = lu(k,2806) - lu(k,1561) * lu(k,2766) + lu(k,2825) = lu(k,2825) - lu(k,1558) * lu(k,2813) + lu(k,2847) = lu(k,2847) - lu(k,1559) * lu(k,2813) + lu(k,2850) = lu(k,2850) - lu(k,1560) * lu(k,2813) + lu(k,2853) = lu(k,2853) - lu(k,1561) * lu(k,2813) + lu(k,2897) = lu(k,2897) - lu(k,1558) * lu(k,2864) + lu(k,2920) = lu(k,2920) - lu(k,1559) * lu(k,2864) + lu(k,2923) = lu(k,2923) - lu(k,1560) * lu(k,2864) + lu(k,2927) = lu(k,2927) - lu(k,1561) * lu(k,2864) + lu(k,3087) = lu(k,3087) - lu(k,1558) * lu(k,3050) + lu(k,3110) = lu(k,3110) - lu(k,1559) * lu(k,3050) + lu(k,3115) = lu(k,3115) - lu(k,1560) * lu(k,3050) + lu(k,3119) = lu(k,3119) - lu(k,1561) * lu(k,3050) + lu(k,3346) = lu(k,3346) - lu(k,1558) * lu(k,3307) + lu(k,3369) = lu(k,3369) - lu(k,1559) * lu(k,3307) + lu(k,3374) = lu(k,3374) - lu(k,1560) * lu(k,3307) + lu(k,3378) = lu(k,3378) - lu(k,1561) * lu(k,3307) + lu(k,3439) = lu(k,3439) - lu(k,1558) * lu(k,3403) + lu(k,3462) = lu(k,3462) - lu(k,1559) * lu(k,3403) + lu(k,3467) = lu(k,3467) - lu(k,1560) * lu(k,3403) + lu(k,3471) = lu(k,3471) - lu(k,1561) * lu(k,3403) + lu(k,3583) = lu(k,3583) - lu(k,1558) * lu(k,3549) + lu(k,3606) = lu(k,3606) - lu(k,1559) * lu(k,3549) + lu(k,3611) = lu(k,3611) - lu(k,1560) * lu(k,3549) + lu(k,3615) = lu(k,3615) - lu(k,1561) * lu(k,3549) + lu(k,4069) = lu(k,4069) - lu(k,1558) * lu(k,4030) + lu(k,4092) = lu(k,4092) - lu(k,1559) * lu(k,4030) + lu(k,4097) = lu(k,4097) - lu(k,1560) * lu(k,4030) + lu(k,4101) = lu(k,4101) - lu(k,1561) * lu(k,4030) + lu(k,1572) = 1._r8 / lu(k,1572) + lu(k,1573) = lu(k,1573) * lu(k,1572) + lu(k,1574) = lu(k,1574) * lu(k,1572) + lu(k,1575) = lu(k,1575) * lu(k,1572) + lu(k,1576) = lu(k,1576) * lu(k,1572) + lu(k,1577) = lu(k,1577) * lu(k,1572) + lu(k,1578) = lu(k,1578) * lu(k,1572) + lu(k,1579) = lu(k,1579) * lu(k,1572) + lu(k,1580) = lu(k,1580) * lu(k,1572) + lu(k,1581) = lu(k,1581) * lu(k,1572) + lu(k,1582) = lu(k,1582) * lu(k,1572) + lu(k,1583) = lu(k,1583) * lu(k,1572) + lu(k,1584) = lu(k,1584) * lu(k,1572) + lu(k,1585) = lu(k,1585) * lu(k,1572) + lu(k,1586) = lu(k,1586) * lu(k,1572) + lu(k,1587) = lu(k,1587) * lu(k,1572) + lu(k,1588) = lu(k,1588) * lu(k,1572) + lu(k,1589) = lu(k,1589) * lu(k,1572) + lu(k,1590) = lu(k,1590) * lu(k,1572) + lu(k,1591) = lu(k,1591) * lu(k,1572) + lu(k,1592) = lu(k,1592) * lu(k,1572) + lu(k,1593) = lu(k,1593) * lu(k,1572) + lu(k,1594) = lu(k,1594) * lu(k,1572) + lu(k,1595) = lu(k,1595) * lu(k,1572) + lu(k,1596) = lu(k,1596) * lu(k,1572) + lu(k,2165) = lu(k,2165) - lu(k,1573) * lu(k,2164) + lu(k,2166) = lu(k,2166) - lu(k,1574) * lu(k,2164) + lu(k,2167) = lu(k,2167) - lu(k,1575) * lu(k,2164) + lu(k,2168) = lu(k,2168) - lu(k,1576) * lu(k,2164) + lu(k,2169) = lu(k,2169) - lu(k,1577) * lu(k,2164) + lu(k,2170) = lu(k,2170) - lu(k,1578) * lu(k,2164) + lu(k,2171) = lu(k,2171) - lu(k,1579) * lu(k,2164) + lu(k,2172) = lu(k,2172) - lu(k,1580) * lu(k,2164) + lu(k,2173) = lu(k,2173) - lu(k,1581) * lu(k,2164) + lu(k,2176) = lu(k,2176) - lu(k,1582) * lu(k,2164) + lu(k,2179) = lu(k,2179) - lu(k,1583) * lu(k,2164) + lu(k,2180) = lu(k,2180) - lu(k,1584) * lu(k,2164) + lu(k,2183) = lu(k,2183) - lu(k,1585) * lu(k,2164) + lu(k,2184) = lu(k,2184) - lu(k,1586) * lu(k,2164) + lu(k,2185) = lu(k,2185) - lu(k,1587) * lu(k,2164) + lu(k,2186) = - lu(k,1588) * lu(k,2164) + lu(k,2187) = - lu(k,1589) * lu(k,2164) + lu(k,2188) = lu(k,2188) - lu(k,1590) * lu(k,2164) + lu(k,2189) = lu(k,2189) - lu(k,1591) * lu(k,2164) + lu(k,2192) = lu(k,2192) - lu(k,1592) * lu(k,2164) + lu(k,2193) = - lu(k,1593) * lu(k,2164) + lu(k,2194) = - lu(k,1594) * lu(k,2164) + lu(k,2195) = lu(k,2195) - lu(k,1595) * lu(k,2164) + lu(k,2196) = lu(k,2196) - lu(k,1596) * lu(k,2164) + lu(k,3309) = lu(k,3309) - lu(k,1573) * lu(k,3308) + lu(k,3311) = lu(k,3311) - lu(k,1574) * lu(k,3308) + lu(k,3312) = lu(k,3312) - lu(k,1575) * lu(k,3308) + lu(k,3316) = lu(k,3316) - lu(k,1576) * lu(k,3308) + lu(k,3320) = lu(k,3320) - lu(k,1577) * lu(k,3308) + lu(k,3321) = lu(k,3321) - lu(k,1578) * lu(k,3308) + lu(k,3322) = lu(k,3322) - lu(k,1579) * lu(k,3308) + lu(k,3327) = lu(k,3327) - lu(k,1580) * lu(k,3308) + lu(k,3328) = lu(k,3328) - lu(k,1581) * lu(k,3308) + lu(k,3333) = lu(k,3333) - lu(k,1582) * lu(k,3308) + lu(k,3336) = lu(k,3336) - lu(k,1583) * lu(k,3308) + lu(k,3337) = lu(k,3337) - lu(k,1584) * lu(k,3308) + lu(k,3362) = lu(k,3362) - lu(k,1585) * lu(k,3308) + lu(k,3364) = lu(k,3364) - lu(k,1586) * lu(k,3308) + lu(k,3365) = lu(k,3365) - lu(k,1587) * lu(k,3308) + lu(k,3366) = lu(k,3366) - lu(k,1588) * lu(k,3308) + lu(k,3367) = lu(k,3367) - lu(k,1589) * lu(k,3308) + lu(k,3368) = lu(k,3368) - lu(k,1590) * lu(k,3308) + lu(k,3369) = lu(k,3369) - lu(k,1591) * lu(k,3308) + lu(k,3374) = lu(k,3374) - lu(k,1592) * lu(k,3308) + lu(k,3375) = lu(k,3375) - lu(k,1593) * lu(k,3308) + lu(k,3377) = lu(k,3377) - lu(k,1594) * lu(k,3308) + lu(k,3378) = lu(k,3378) - lu(k,1595) * lu(k,3308) + lu(k,3379) = lu(k,3379) - lu(k,1596) * lu(k,3308) + lu(k,3706) = lu(k,3706) - lu(k,1573) * lu(k,3704) + lu(k,3707) = - lu(k,1574) * lu(k,3704) + lu(k,3708) = - lu(k,1575) * lu(k,3704) + lu(k,3709) = lu(k,3709) - lu(k,1576) * lu(k,3704) + lu(k,3713) = lu(k,3713) - lu(k,1577) * lu(k,3704) + lu(k,3714) = - lu(k,1578) * lu(k,3704) + lu(k,3715) = - lu(k,1579) * lu(k,3704) + lu(k,3720) = - lu(k,1580) * lu(k,3704) + lu(k,3721) = lu(k,3721) - lu(k,1581) * lu(k,3704) + lu(k,3726) = lu(k,3726) - lu(k,1582) * lu(k,3704) + lu(k,3729) = lu(k,3729) - lu(k,1583) * lu(k,3704) + lu(k,3730) = lu(k,3730) - lu(k,1584) * lu(k,3704) + lu(k,3753) = lu(k,3753) - lu(k,1585) * lu(k,3704) + lu(k,3755) = lu(k,3755) - lu(k,1586) * lu(k,3704) + lu(k,3756) = lu(k,3756) - lu(k,1587) * lu(k,3704) + lu(k,3757) = lu(k,3757) - lu(k,1588) * lu(k,3704) + lu(k,3758) = lu(k,3758) - lu(k,1589) * lu(k,3704) + lu(k,3759) = lu(k,3759) - lu(k,1590) * lu(k,3704) + lu(k,3760) = lu(k,3760) - lu(k,1591) * lu(k,3704) + lu(k,3765) = lu(k,3765) - lu(k,1592) * lu(k,3704) + lu(k,3766) = lu(k,3766) - lu(k,1593) * lu(k,3704) + lu(k,3768) = lu(k,3768) - lu(k,1594) * lu(k,3704) + lu(k,3769) = lu(k,3769) - lu(k,1595) * lu(k,3704) + lu(k,3770) = lu(k,3770) - lu(k,1596) * lu(k,3704) + lu(k,4033) = lu(k,4033) - lu(k,1573) * lu(k,4031) + lu(k,4035) = lu(k,4035) - lu(k,1574) * lu(k,4031) + lu(k,4036) = lu(k,4036) - lu(k,1575) * lu(k,4031) + lu(k,4040) = lu(k,4040) - lu(k,1576) * lu(k,4031) + lu(k,4044) = lu(k,4044) - lu(k,1577) * lu(k,4031) + lu(k,4045) = lu(k,4045) - lu(k,1578) * lu(k,4031) + lu(k,4046) = lu(k,4046) - lu(k,1579) * lu(k,4031) + lu(k,4051) = lu(k,4051) - lu(k,1580) * lu(k,4031) + lu(k,4052) = lu(k,4052) - lu(k,1581) * lu(k,4031) + lu(k,4057) = lu(k,4057) - lu(k,1582) * lu(k,4031) + lu(k,4060) = lu(k,4060) - lu(k,1583) * lu(k,4031) + lu(k,4061) = lu(k,4061) - lu(k,1584) * lu(k,4031) + lu(k,4085) = lu(k,4085) - lu(k,1585) * lu(k,4031) + lu(k,4087) = lu(k,4087) - lu(k,1586) * lu(k,4031) + lu(k,4088) = lu(k,4088) - lu(k,1587) * lu(k,4031) + lu(k,4089) = lu(k,4089) - lu(k,1588) * lu(k,4031) + lu(k,4090) = lu(k,4090) - lu(k,1589) * lu(k,4031) + lu(k,4091) = lu(k,4091) - lu(k,1590) * lu(k,4031) + lu(k,4092) = lu(k,4092) - lu(k,1591) * lu(k,4031) + lu(k,4097) = lu(k,4097) - lu(k,1592) * lu(k,4031) + lu(k,4098) = lu(k,4098) - lu(k,1593) * lu(k,4031) + lu(k,4100) = lu(k,4100) - lu(k,1594) * lu(k,4031) + lu(k,4101) = lu(k,4101) - lu(k,1595) * lu(k,4031) + lu(k,4102) = lu(k,4102) - lu(k,1596) * lu(k,4031) + end do + end subroutine lu_fac35 + subroutine lu_fac36( 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,1600) = 1._r8 / lu(k,1600) + lu(k,1601) = lu(k,1601) * lu(k,1600) + lu(k,1602) = lu(k,1602) * lu(k,1600) + lu(k,1603) = lu(k,1603) * lu(k,1600) + lu(k,1604) = lu(k,1604) * lu(k,1600) + lu(k,1605) = lu(k,1605) * lu(k,1600) + lu(k,1606) = lu(k,1606) * lu(k,1600) + lu(k,1607) = lu(k,1607) * lu(k,1600) + lu(k,1608) = lu(k,1608) * lu(k,1600) + lu(k,1609) = lu(k,1609) * lu(k,1600) + lu(k,1610) = lu(k,1610) * lu(k,1600) + lu(k,1611) = lu(k,1611) * lu(k,1600) + lu(k,1612) = lu(k,1612) * lu(k,1600) + lu(k,3155) = lu(k,3155) - lu(k,1601) * lu(k,3152) + lu(k,3157) = lu(k,3157) - lu(k,1602) * lu(k,3152) + lu(k,3159) = lu(k,3159) - lu(k,1603) * lu(k,3152) + lu(k,3161) = lu(k,3161) - lu(k,1604) * lu(k,3152) + lu(k,3163) = lu(k,3163) - lu(k,1605) * lu(k,3152) + lu(k,3165) = lu(k,3165) - lu(k,1606) * lu(k,3152) + lu(k,3166) = lu(k,3166) - lu(k,1607) * lu(k,3152) + lu(k,3168) = lu(k,3168) - lu(k,1608) * lu(k,3152) + lu(k,3169) = lu(k,3169) - lu(k,1609) * lu(k,3152) + lu(k,3171) = lu(k,3171) - lu(k,1610) * lu(k,3152) + lu(k,3172) = lu(k,3172) - lu(k,1611) * lu(k,3152) + lu(k,3173) = lu(k,3173) - lu(k,1612) * lu(k,3152) + lu(k,3479) = lu(k,3479) - lu(k,1601) * lu(k,3478) + lu(k,3480) = - lu(k,1602) * lu(k,3478) + lu(k,3482) = lu(k,3482) - lu(k,1603) * lu(k,3478) + lu(k,3484) = lu(k,3484) - lu(k,1604) * lu(k,3478) + lu(k,3486) = lu(k,3486) - lu(k,1605) * lu(k,3478) + lu(k,3488) = lu(k,3488) - lu(k,1606) * lu(k,3478) + lu(k,3489) = lu(k,3489) - lu(k,1607) * lu(k,3478) + lu(k,3491) = lu(k,3491) - lu(k,1608) * lu(k,3478) + lu(k,3492) = - lu(k,1609) * lu(k,3478) + lu(k,3494) = lu(k,3494) - lu(k,1610) * lu(k,3478) + lu(k,3495) = lu(k,3495) - lu(k,1611) * lu(k,3478) + lu(k,3496) = lu(k,3496) - lu(k,1612) * lu(k,3478) + lu(k,3505) = lu(k,3505) - lu(k,1601) * lu(k,3504) + lu(k,3506) = - lu(k,1602) * lu(k,3504) + lu(k,3508) = lu(k,3508) - lu(k,1603) * lu(k,3504) + lu(k,3510) = lu(k,3510) - lu(k,1604) * lu(k,3504) + lu(k,3512) = lu(k,3512) - lu(k,1605) * lu(k,3504) + lu(k,3514) = lu(k,3514) - lu(k,1606) * lu(k,3504) + lu(k,3515) = lu(k,3515) - lu(k,1607) * lu(k,3504) + lu(k,3517) = lu(k,3517) - lu(k,1608) * lu(k,3504) + lu(k,3518) = - lu(k,1609) * lu(k,3504) + lu(k,3520) = lu(k,3520) - lu(k,1610) * lu(k,3504) + lu(k,3521) = lu(k,3521) - lu(k,1611) * lu(k,3504) + lu(k,3522) = lu(k,3522) - lu(k,1612) * lu(k,3504) + lu(k,3575) = - lu(k,1601) * lu(k,3550) + lu(k,3600) = - lu(k,1602) * lu(k,3550) + lu(k,3602) = lu(k,3602) - lu(k,1603) * lu(k,3550) + lu(k,3604) = lu(k,3604) - lu(k,1604) * lu(k,3550) + lu(k,3606) = lu(k,3606) - lu(k,1605) * lu(k,3550) + lu(k,3608) = - lu(k,1606) * lu(k,3550) + lu(k,3609) = - lu(k,1607) * lu(k,3550) + lu(k,3611) = lu(k,3611) - lu(k,1608) * lu(k,3550) + lu(k,3612) = lu(k,3612) - lu(k,1609) * lu(k,3550) + lu(k,3614) = lu(k,3614) - lu(k,1610) * lu(k,3550) + lu(k,3615) = lu(k,3615) - lu(k,1611) * lu(k,3550) + lu(k,3616) = lu(k,3616) - lu(k,1612) * lu(k,3550) + lu(k,3645) = lu(k,3645) - lu(k,1601) * lu(k,3639) + lu(k,3652) = lu(k,3652) - lu(k,1602) * lu(k,3639) + lu(k,3654) = lu(k,3654) - lu(k,1603) * lu(k,3639) + lu(k,3656) = lu(k,3656) - lu(k,1604) * lu(k,3639) + lu(k,3658) = lu(k,3658) - lu(k,1605) * lu(k,3639) + lu(k,3660) = lu(k,3660) - lu(k,1606) * lu(k,3639) + lu(k,3661) = lu(k,3661) - lu(k,1607) * lu(k,3639) + lu(k,3663) = lu(k,3663) - lu(k,1608) * lu(k,3639) + lu(k,3664) = lu(k,3664) - lu(k,1609) * lu(k,3639) + lu(k,3666) = lu(k,3666) - lu(k,1610) * lu(k,3639) + lu(k,3667) = lu(k,3667) - lu(k,1611) * lu(k,3639) + lu(k,3668) = lu(k,3668) - lu(k,1612) * lu(k,3639) + lu(k,3731) = lu(k,3731) - lu(k,1601) * lu(k,3705) + lu(k,3754) = lu(k,3754) - lu(k,1602) * lu(k,3705) + lu(k,3756) = lu(k,3756) - lu(k,1603) * lu(k,3705) + lu(k,3758) = lu(k,3758) - lu(k,1604) * lu(k,3705) + lu(k,3760) = lu(k,3760) - lu(k,1605) * lu(k,3705) + lu(k,3762) = lu(k,3762) - lu(k,1606) * lu(k,3705) + lu(k,3763) = lu(k,3763) - lu(k,1607) * lu(k,3705) + lu(k,3765) = lu(k,3765) - lu(k,1608) * lu(k,3705) + lu(k,3766) = lu(k,3766) - lu(k,1609) * lu(k,3705) + lu(k,3768) = lu(k,3768) - lu(k,1610) * lu(k,3705) + lu(k,3769) = lu(k,3769) - lu(k,1611) * lu(k,3705) + lu(k,3770) = lu(k,3770) - lu(k,1612) * lu(k,3705) + lu(k,4062) = lu(k,4062) - lu(k,1601) * lu(k,4032) + lu(k,4086) = lu(k,4086) - lu(k,1602) * lu(k,4032) + lu(k,4088) = lu(k,4088) - lu(k,1603) * lu(k,4032) + lu(k,4090) = lu(k,4090) - lu(k,1604) * lu(k,4032) + lu(k,4092) = lu(k,4092) - lu(k,1605) * lu(k,4032) + lu(k,4094) = lu(k,4094) - lu(k,1606) * lu(k,4032) + lu(k,4095) = lu(k,4095) - lu(k,1607) * lu(k,4032) + lu(k,4097) = lu(k,4097) - lu(k,1608) * lu(k,4032) + lu(k,4098) = lu(k,4098) - lu(k,1609) * lu(k,4032) + lu(k,4100) = lu(k,4100) - lu(k,1610) * lu(k,4032) + lu(k,4101) = lu(k,4101) - lu(k,1611) * lu(k,4032) + lu(k,4102) = lu(k,4102) - lu(k,1612) * lu(k,4032) + lu(k,4110) = - lu(k,1601) * lu(k,4108) + lu(k,4112) = lu(k,4112) - lu(k,1602) * lu(k,4108) + lu(k,4114) = - lu(k,1603) * lu(k,4108) + lu(k,4116) = lu(k,4116) - lu(k,1604) * lu(k,4108) + lu(k,4118) = lu(k,4118) - lu(k,1605) * lu(k,4108) + lu(k,4120) = - lu(k,1606) * lu(k,4108) + lu(k,4121) = - lu(k,1607) * lu(k,4108) + lu(k,4123) = - lu(k,1608) * lu(k,4108) + lu(k,4124) = - lu(k,1609) * lu(k,4108) + lu(k,4126) = - lu(k,1610) * lu(k,4108) + lu(k,4127) = lu(k,4127) - lu(k,1611) * lu(k,4108) + lu(k,4128) = lu(k,4128) - lu(k,1612) * lu(k,4108) + lu(k,1613) = 1._r8 / lu(k,1613) + lu(k,1614) = lu(k,1614) * lu(k,1613) + lu(k,1615) = lu(k,1615) * lu(k,1613) + lu(k,1622) = lu(k,1622) - lu(k,1614) * lu(k,1619) + lu(k,1625) = - lu(k,1615) * lu(k,1619) + lu(k,1647) = lu(k,1647) - lu(k,1614) * lu(k,1639) + lu(k,1651) = - lu(k,1615) * lu(k,1639) + lu(k,1665) = lu(k,1665) - lu(k,1614) * lu(k,1658) + lu(k,1667) = - lu(k,1615) * lu(k,1658) + lu(k,1713) = lu(k,1713) - lu(k,1614) * lu(k,1711) + lu(k,1714) = - lu(k,1615) * lu(k,1711) + lu(k,1738) = lu(k,1738) - lu(k,1614) * lu(k,1730) + lu(k,1742) = - lu(k,1615) * lu(k,1730) + lu(k,1760) = lu(k,1760) - lu(k,1614) * lu(k,1752) + lu(k,1764) = - lu(k,1615) * lu(k,1752) + lu(k,1796) = lu(k,1796) - lu(k,1614) * lu(k,1789) + lu(k,1798) = - lu(k,1615) * lu(k,1789) + lu(k,1823) = lu(k,1823) - lu(k,1614) * lu(k,1813) + lu(k,1828) = - lu(k,1615) * lu(k,1813) + lu(k,1855) = lu(k,1855) - lu(k,1614) * lu(k,1845) + lu(k,1859) = - lu(k,1615) * lu(k,1845) + lu(k,1875) = lu(k,1875) - lu(k,1614) * lu(k,1868) + lu(k,1878) = - lu(k,1615) * lu(k,1868) + lu(k,1903) = lu(k,1903) - lu(k,1614) * lu(k,1891) + lu(k,1906) = - lu(k,1615) * lu(k,1891) + lu(k,1918) = lu(k,1918) - lu(k,1614) * lu(k,1914) + lu(k,1921) = - lu(k,1615) * lu(k,1914) + lu(k,1957) = lu(k,1957) - lu(k,1614) * lu(k,1941) + lu(k,1962) = - lu(k,1615) * lu(k,1941) + lu(k,1994) = lu(k,1994) - lu(k,1614) * lu(k,1978) + lu(k,2001) = - lu(k,1615) * lu(k,1978) + lu(k,2017) = lu(k,2017) - lu(k,1614) * lu(k,2011) + lu(k,2022) = - lu(k,1615) * lu(k,2011) + lu(k,2042) = lu(k,2042) - lu(k,1614) * lu(k,2036) + lu(k,2047) = - lu(k,1615) * lu(k,2036) + lu(k,2057) = lu(k,2057) - lu(k,1614) * lu(k,2056) + lu(k,2058) = - lu(k,1615) * lu(k,2056) + lu(k,2077) = lu(k,2077) - lu(k,1614) * lu(k,2068) + lu(k,2084) = lu(k,2084) - lu(k,1615) * lu(k,2068) + lu(k,2109) = lu(k,2109) - lu(k,1614) * lu(k,2100) + lu(k,2116) = lu(k,2116) - lu(k,1615) * lu(k,2100) + lu(k,2139) = lu(k,2139) - lu(k,1614) * lu(k,2130) + lu(k,2145) = lu(k,2145) - lu(k,1615) * lu(k,2130) + lu(k,2176) = lu(k,2176) - lu(k,1614) * lu(k,2165) + lu(k,2187) = lu(k,2187) - lu(k,1615) * lu(k,2165) + lu(k,2212) = - lu(k,1614) * lu(k,2211) + lu(k,2223) = - lu(k,1615) * lu(k,2211) + lu(k,2234) = - lu(k,1614) * lu(k,2232) + lu(k,2247) = - lu(k,1615) * lu(k,2232) + lu(k,2258) = lu(k,2258) - lu(k,1614) * lu(k,2256) + lu(k,2263) = lu(k,2263) - lu(k,1615) * lu(k,2256) + lu(k,2295) = - lu(k,1614) * lu(k,2294) + lu(k,2307) = - lu(k,1615) * lu(k,2294) + lu(k,2337) = - lu(k,1614) * lu(k,2334) + lu(k,2351) = - lu(k,1615) * lu(k,2334) + lu(k,2376) = - lu(k,1614) * lu(k,2372) + lu(k,2391) = - lu(k,1615) * lu(k,2372) + lu(k,2405) = - lu(k,1614) * lu(k,2404) + lu(k,2420) = - lu(k,1615) * lu(k,2404) + lu(k,2437) = - lu(k,1614) * lu(k,2433) + lu(k,2452) = - lu(k,1615) * lu(k,2433) + lu(k,2467) = - lu(k,1614) * lu(k,2464) + lu(k,2483) = - lu(k,1615) * lu(k,2464) + lu(k,2503) = - lu(k,1614) * lu(k,2500) + lu(k,2517) = - lu(k,1615) * lu(k,2500) + lu(k,2534) = - lu(k,1614) * lu(k,2532) + lu(k,2546) = - lu(k,1615) * lu(k,2532) + lu(k,2566) = - lu(k,1614) * lu(k,2563) + lu(k,2582) = - lu(k,1615) * lu(k,2563) + lu(k,2597) = - lu(k,1614) * lu(k,2594) + lu(k,2610) = lu(k,2610) - lu(k,1615) * lu(k,2594) + lu(k,2627) = - lu(k,1614) * lu(k,2625) + lu(k,2638) = lu(k,2638) - lu(k,1615) * lu(k,2625) + lu(k,2652) = lu(k,2652) - lu(k,1614) * lu(k,2651) + lu(k,2663) = - lu(k,1615) * lu(k,2651) + lu(k,2674) = lu(k,2674) - lu(k,1614) * lu(k,2672) + lu(k,2685) = - lu(k,1615) * lu(k,2672) + lu(k,2695) = - lu(k,1614) * lu(k,2694) + lu(k,2708) = - lu(k,1615) * lu(k,2694) + lu(k,2725) = lu(k,2725) - lu(k,1614) * lu(k,2721) + lu(k,2752) = - lu(k,1615) * lu(k,2721) + lu(k,2771) = lu(k,2771) - lu(k,1614) * lu(k,2767) + lu(k,2798) = - lu(k,1615) * lu(k,2767) + lu(k,2818) = lu(k,2818) - lu(k,1614) * lu(k,2814) + lu(k,2845) = - lu(k,1615) * lu(k,2814) + lu(k,2885) = lu(k,2885) - lu(k,1614) * lu(k,2865) + lu(k,2918) = - lu(k,1615) * lu(k,2865) + lu(k,3074) = lu(k,3074) - lu(k,1614) * lu(k,3051) + lu(k,3108) = lu(k,3108) - lu(k,1615) * lu(k,3051) + lu(k,3180) = lu(k,3180) - lu(k,1614) * lu(k,3178) + lu(k,3187) = lu(k,3187) - lu(k,1615) * lu(k,3178) + lu(k,3333) = lu(k,3333) - lu(k,1614) * lu(k,3309) + lu(k,3367) = lu(k,3367) - lu(k,1615) * lu(k,3309) + lu(k,3427) = lu(k,3427) - lu(k,1614) * lu(k,3404) + lu(k,3460) = - lu(k,1615) * lu(k,3404) + lu(k,3570) = lu(k,3570) - lu(k,1614) * lu(k,3551) + lu(k,3604) = lu(k,3604) - lu(k,1615) * lu(k,3551) + lu(k,3644) = lu(k,3644) - lu(k,1614) * lu(k,3640) + lu(k,3656) = lu(k,3656) - lu(k,1615) * lu(k,3640) + lu(k,3726) = lu(k,3726) - lu(k,1614) * lu(k,3706) + lu(k,3758) = lu(k,3758) - lu(k,1615) * lu(k,3706) + lu(k,3832) = lu(k,3832) - lu(k,1614) * lu(k,3829) + lu(k,3840) = lu(k,3840) - lu(k,1615) * lu(k,3829) + lu(k,4057) = lu(k,4057) - lu(k,1614) * lu(k,4033) + lu(k,4090) = lu(k,4090) - lu(k,1615) * lu(k,4033) + end do + end subroutine lu_fac36 + subroutine lu_fac37( 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,1620) = 1._r8 / lu(k,1620) + lu(k,1621) = lu(k,1621) * lu(k,1620) + lu(k,1622) = lu(k,1622) * lu(k,1620) + lu(k,1623) = lu(k,1623) * lu(k,1620) + lu(k,1624) = lu(k,1624) * lu(k,1620) + lu(k,1625) = lu(k,1625) * lu(k,1620) + lu(k,1626) = lu(k,1626) * lu(k,1620) + lu(k,1627) = lu(k,1627) * lu(k,1620) + lu(k,1628) = lu(k,1628) * lu(k,1620) + lu(k,1629) = lu(k,1629) * lu(k,1620) + lu(k,1630) = lu(k,1630) * lu(k,1620) + lu(k,1631) = lu(k,1631) * lu(k,1620) + lu(k,1632) = lu(k,1632) * lu(k,1620) + lu(k,1633) = lu(k,1633) * lu(k,1620) + lu(k,2013) = lu(k,2013) - lu(k,1621) * lu(k,2012) + lu(k,2017) = lu(k,2017) - lu(k,1622) * lu(k,2012) + lu(k,2019) = lu(k,2019) - lu(k,1623) * lu(k,2012) + lu(k,2021) = lu(k,2021) - lu(k,1624) * lu(k,2012) + lu(k,2022) = lu(k,2022) - lu(k,1625) * lu(k,2012) + lu(k,2023) = lu(k,2023) - lu(k,1626) * lu(k,2012) + lu(k,2024) = lu(k,2024) - lu(k,1627) * lu(k,2012) + lu(k,2025) = lu(k,2025) - lu(k,1628) * lu(k,2012) + lu(k,2026) = - lu(k,1629) * lu(k,2012) + lu(k,2027) = lu(k,2027) - lu(k,1630) * lu(k,2012) + lu(k,2028) = lu(k,2028) - lu(k,1631) * lu(k,2012) + lu(k,2029) = lu(k,2029) - lu(k,1632) * lu(k,2012) + lu(k,2030) = lu(k,2030) - lu(k,1633) * lu(k,2012) + lu(k,2873) = lu(k,2873) - lu(k,1621) * lu(k,2866) + lu(k,2885) = lu(k,2885) - lu(k,1622) * lu(k,2866) + lu(k,2913) = lu(k,2913) - lu(k,1623) * lu(k,2866) + lu(k,2916) = lu(k,2916) - lu(k,1624) * lu(k,2866) + lu(k,2918) = lu(k,2918) - lu(k,1625) * lu(k,2866) + lu(k,2919) = lu(k,2919) - lu(k,1626) * lu(k,2866) + lu(k,2920) = lu(k,2920) - lu(k,1627) * lu(k,2866) + lu(k,2921) = lu(k,2921) - lu(k,1628) * lu(k,2866) + lu(k,2922) = lu(k,2922) - lu(k,1629) * lu(k,2866) + lu(k,2923) = lu(k,2923) - lu(k,1630) * lu(k,2866) + lu(k,2924) = lu(k,2924) - lu(k,1631) * lu(k,2866) + lu(k,2927) = lu(k,2927) - lu(k,1632) * lu(k,2866) + lu(k,2928) = lu(k,2928) - lu(k,1633) * lu(k,2866) + lu(k,3061) = lu(k,3061) - lu(k,1621) * lu(k,3052) + lu(k,3074) = lu(k,3074) - lu(k,1622) * lu(k,3052) + lu(k,3103) = lu(k,3103) - lu(k,1623) * lu(k,3052) + lu(k,3106) = lu(k,3106) - lu(k,1624) * lu(k,3052) + lu(k,3108) = lu(k,3108) - lu(k,1625) * lu(k,3052) + lu(k,3109) = lu(k,3109) - lu(k,1626) * lu(k,3052) + lu(k,3110) = lu(k,3110) - lu(k,1627) * lu(k,3052) + lu(k,3111) = lu(k,3111) - lu(k,1628) * lu(k,3052) + lu(k,3114) = lu(k,3114) - lu(k,1629) * lu(k,3052) + lu(k,3115) = lu(k,3115) - lu(k,1630) * lu(k,3052) + lu(k,3116) = lu(k,3116) - lu(k,1631) * lu(k,3052) + lu(k,3119) = lu(k,3119) - lu(k,1632) * lu(k,3052) + lu(k,3120) = lu(k,3120) - lu(k,1633) * lu(k,3052) + lu(k,3320) = lu(k,3320) - lu(k,1621) * lu(k,3310) + lu(k,3333) = lu(k,3333) - lu(k,1622) * lu(k,3310) + lu(k,3362) = lu(k,3362) - lu(k,1623) * lu(k,3310) + lu(k,3365) = lu(k,3365) - lu(k,1624) * lu(k,3310) + lu(k,3367) = lu(k,3367) - lu(k,1625) * lu(k,3310) + lu(k,3368) = lu(k,3368) - lu(k,1626) * lu(k,3310) + lu(k,3369) = lu(k,3369) - lu(k,1627) * lu(k,3310) + lu(k,3370) = lu(k,3370) - lu(k,1628) * lu(k,3310) + lu(k,3373) = lu(k,3373) - lu(k,1629) * lu(k,3310) + lu(k,3374) = lu(k,3374) - lu(k,1630) * lu(k,3310) + lu(k,3375) = lu(k,3375) - lu(k,1631) * lu(k,3310) + lu(k,3378) = lu(k,3378) - lu(k,1632) * lu(k,3310) + lu(k,3379) = lu(k,3379) - lu(k,1633) * lu(k,3310) + lu(k,3414) = lu(k,3414) - lu(k,1621) * lu(k,3405) + lu(k,3427) = lu(k,3427) - lu(k,1622) * lu(k,3405) + lu(k,3455) = lu(k,3455) - lu(k,1623) * lu(k,3405) + lu(k,3458) = lu(k,3458) - lu(k,1624) * lu(k,3405) + lu(k,3460) = lu(k,3460) - lu(k,1625) * lu(k,3405) + lu(k,3461) = lu(k,3461) - lu(k,1626) * lu(k,3405) + lu(k,3462) = lu(k,3462) - lu(k,1627) * lu(k,3405) + lu(k,3463) = lu(k,3463) - lu(k,1628) * lu(k,3405) + lu(k,3466) = lu(k,3466) - lu(k,1629) * lu(k,3405) + lu(k,3467) = lu(k,3467) - lu(k,1630) * lu(k,3405) + lu(k,3468) = - lu(k,1631) * lu(k,3405) + lu(k,3471) = lu(k,3471) - lu(k,1632) * lu(k,3405) + lu(k,3472) = lu(k,3472) - lu(k,1633) * lu(k,3405) + lu(k,3559) = lu(k,3559) - lu(k,1621) * lu(k,3552) + lu(k,3570) = lu(k,3570) - lu(k,1622) * lu(k,3552) + lu(k,3599) = lu(k,3599) - lu(k,1623) * lu(k,3552) + lu(k,3602) = lu(k,3602) - lu(k,1624) * lu(k,3552) + lu(k,3604) = lu(k,3604) - lu(k,1625) * lu(k,3552) + lu(k,3605) = lu(k,3605) - lu(k,1626) * lu(k,3552) + lu(k,3606) = lu(k,3606) - lu(k,1627) * lu(k,3552) + lu(k,3607) = lu(k,3607) - lu(k,1628) * lu(k,3552) + lu(k,3610) = lu(k,3610) - lu(k,1629) * lu(k,3552) + lu(k,3611) = lu(k,3611) - lu(k,1630) * lu(k,3552) + lu(k,3612) = lu(k,3612) - lu(k,1631) * lu(k,3552) + lu(k,3615) = lu(k,3615) - lu(k,1632) * lu(k,3552) + lu(k,3616) = lu(k,3616) - lu(k,1633) * lu(k,3552) + lu(k,3642) = lu(k,3642) - lu(k,1621) * lu(k,3641) + lu(k,3644) = lu(k,3644) - lu(k,1622) * lu(k,3641) + lu(k,3651) = lu(k,3651) - lu(k,1623) * lu(k,3641) + lu(k,3654) = lu(k,3654) - lu(k,1624) * lu(k,3641) + lu(k,3656) = lu(k,3656) - lu(k,1625) * lu(k,3641) + lu(k,3657) = lu(k,3657) - lu(k,1626) * lu(k,3641) + lu(k,3658) = lu(k,3658) - lu(k,1627) * lu(k,3641) + lu(k,3659) = lu(k,3659) - lu(k,1628) * lu(k,3641) + lu(k,3662) = lu(k,3662) - lu(k,1629) * lu(k,3641) + lu(k,3663) = lu(k,3663) - lu(k,1630) * lu(k,3641) + lu(k,3664) = lu(k,3664) - lu(k,1631) * lu(k,3641) + lu(k,3667) = lu(k,3667) - lu(k,1632) * lu(k,3641) + lu(k,3668) = lu(k,3668) - lu(k,1633) * lu(k,3641) + lu(k,4044) = lu(k,4044) - lu(k,1621) * lu(k,4034) + lu(k,4057) = lu(k,4057) - lu(k,1622) * lu(k,4034) + lu(k,4085) = lu(k,4085) - lu(k,1623) * lu(k,4034) + lu(k,4088) = lu(k,4088) - lu(k,1624) * lu(k,4034) + lu(k,4090) = lu(k,4090) - lu(k,1625) * lu(k,4034) + lu(k,4091) = lu(k,4091) - lu(k,1626) * lu(k,4034) + lu(k,4092) = lu(k,4092) - lu(k,1627) * lu(k,4034) + lu(k,4093) = lu(k,4093) - lu(k,1628) * lu(k,4034) + lu(k,4096) = lu(k,4096) - lu(k,1629) * lu(k,4034) + lu(k,4097) = lu(k,4097) - lu(k,1630) * lu(k,4034) + lu(k,4098) = lu(k,4098) - lu(k,1631) * lu(k,4034) + lu(k,4101) = lu(k,4101) - lu(k,1632) * lu(k,4034) + lu(k,4102) = lu(k,4102) - lu(k,1633) * lu(k,4034) + lu(k,1640) = 1._r8 / lu(k,1640) + lu(k,1641) = lu(k,1641) * lu(k,1640) + lu(k,1642) = lu(k,1642) * lu(k,1640) + lu(k,1643) = lu(k,1643) * lu(k,1640) + lu(k,1644) = lu(k,1644) * lu(k,1640) + lu(k,1645) = lu(k,1645) * lu(k,1640) + lu(k,1646) = lu(k,1646) * lu(k,1640) + lu(k,1647) = lu(k,1647) * lu(k,1640) + lu(k,1648) = lu(k,1648) * lu(k,1640) + lu(k,1649) = lu(k,1649) * lu(k,1640) + lu(k,1650) = lu(k,1650) * lu(k,1640) + lu(k,1651) = lu(k,1651) * lu(k,1640) + lu(k,1652) = lu(k,1652) * lu(k,1640) + lu(k,1653) = lu(k,1653) * lu(k,1640) + lu(k,1654) = lu(k,1654) * lu(k,1640) + lu(k,1655) = lu(k,1655) * lu(k,1640) + lu(k,2132) = - lu(k,1641) * lu(k,2131) + lu(k,2133) = lu(k,2133) - lu(k,1642) * lu(k,2131) + lu(k,2134) = lu(k,2134) - lu(k,1643) * lu(k,2131) + lu(k,2135) = - lu(k,1644) * lu(k,2131) + lu(k,2137) = lu(k,2137) - lu(k,1645) * lu(k,2131) + lu(k,2138) = lu(k,2138) - lu(k,1646) * lu(k,2131) + lu(k,2139) = lu(k,2139) - lu(k,1647) * lu(k,2131) + lu(k,2141) = lu(k,2141) - lu(k,1648) * lu(k,2131) + lu(k,2142) = lu(k,2142) - lu(k,1649) * lu(k,2131) + lu(k,2143) = - lu(k,1650) * lu(k,2131) + lu(k,2145) = lu(k,2145) - lu(k,1651) * lu(k,2131) + lu(k,2146) = lu(k,2146) - lu(k,1652) * lu(k,2131) + lu(k,2147) = lu(k,2147) - lu(k,1653) * lu(k,2131) + lu(k,2149) = lu(k,2149) - lu(k,1654) * lu(k,2131) + lu(k,2152) = lu(k,2152) - lu(k,1655) * lu(k,2131) + lu(k,2168) = lu(k,2168) - lu(k,1641) * lu(k,2166) + lu(k,2169) = lu(k,2169) - lu(k,1642) * lu(k,2166) + lu(k,2170) = lu(k,2170) - lu(k,1643) * lu(k,2166) + lu(k,2171) = lu(k,2171) - lu(k,1644) * lu(k,2166) + lu(k,2172) = lu(k,2172) - lu(k,1645) * lu(k,2166) + lu(k,2173) = lu(k,2173) - lu(k,1646) * lu(k,2166) + lu(k,2176) = lu(k,2176) - lu(k,1647) * lu(k,2166) + lu(k,2183) = lu(k,2183) - lu(k,1648) * lu(k,2166) + lu(k,2184) = lu(k,2184) - lu(k,1649) * lu(k,2166) + lu(k,2185) = lu(k,2185) - lu(k,1650) * lu(k,2166) + lu(k,2187) = lu(k,2187) - lu(k,1651) * lu(k,2166) + lu(k,2188) = lu(k,2188) - lu(k,1652) * lu(k,2166) + lu(k,2189) = lu(k,2189) - lu(k,1653) * lu(k,2166) + lu(k,2192) = lu(k,2192) - lu(k,1654) * lu(k,2166) + lu(k,2195) = lu(k,2195) - lu(k,1655) * lu(k,2166) + lu(k,3057) = lu(k,3057) - lu(k,1641) * lu(k,3053) + lu(k,3061) = lu(k,3061) - lu(k,1642) * lu(k,3053) + lu(k,3062) = lu(k,3062) - lu(k,1643) * lu(k,3053) + lu(k,3063) = lu(k,3063) - lu(k,1644) * lu(k,3053) + lu(k,3068) = lu(k,3068) - lu(k,1645) * lu(k,3053) + lu(k,3069) = lu(k,3069) - lu(k,1646) * lu(k,3053) + lu(k,3074) = lu(k,3074) - lu(k,1647) * lu(k,3053) + lu(k,3103) = lu(k,3103) - lu(k,1648) * lu(k,3053) + lu(k,3105) = lu(k,3105) - lu(k,1649) * lu(k,3053) + lu(k,3106) = lu(k,3106) - lu(k,1650) * lu(k,3053) + lu(k,3108) = lu(k,3108) - lu(k,1651) * lu(k,3053) + lu(k,3109) = lu(k,3109) - lu(k,1652) * lu(k,3053) + lu(k,3110) = lu(k,3110) - lu(k,1653) * lu(k,3053) + lu(k,3115) = lu(k,3115) - lu(k,1654) * lu(k,3053) + lu(k,3119) = lu(k,3119) - lu(k,1655) * lu(k,3053) + lu(k,3316) = lu(k,3316) - lu(k,1641) * lu(k,3311) + lu(k,3320) = lu(k,3320) - lu(k,1642) * lu(k,3311) + lu(k,3321) = lu(k,3321) - lu(k,1643) * lu(k,3311) + lu(k,3322) = lu(k,3322) - lu(k,1644) * lu(k,3311) + lu(k,3327) = lu(k,3327) - lu(k,1645) * lu(k,3311) + lu(k,3328) = lu(k,3328) - lu(k,1646) * lu(k,3311) + lu(k,3333) = lu(k,3333) - lu(k,1647) * lu(k,3311) + lu(k,3362) = lu(k,3362) - lu(k,1648) * lu(k,3311) + lu(k,3364) = lu(k,3364) - lu(k,1649) * lu(k,3311) + lu(k,3365) = lu(k,3365) - lu(k,1650) * lu(k,3311) + lu(k,3367) = lu(k,3367) - lu(k,1651) * lu(k,3311) + lu(k,3368) = lu(k,3368) - lu(k,1652) * lu(k,3311) + lu(k,3369) = lu(k,3369) - lu(k,1653) * lu(k,3311) + lu(k,3374) = lu(k,3374) - lu(k,1654) * lu(k,3311) + lu(k,3378) = lu(k,3378) - lu(k,1655) * lu(k,3311) + lu(k,3410) = lu(k,3410) - lu(k,1641) * lu(k,3406) + lu(k,3414) = lu(k,3414) - lu(k,1642) * lu(k,3406) + lu(k,3415) = lu(k,3415) - lu(k,1643) * lu(k,3406) + lu(k,3416) = lu(k,3416) - lu(k,1644) * lu(k,3406) + lu(k,3421) = lu(k,3421) - lu(k,1645) * lu(k,3406) + lu(k,3422) = lu(k,3422) - lu(k,1646) * lu(k,3406) + lu(k,3427) = lu(k,3427) - lu(k,1647) * lu(k,3406) + lu(k,3455) = lu(k,3455) - lu(k,1648) * lu(k,3406) + lu(k,3457) = lu(k,3457) - lu(k,1649) * lu(k,3406) + lu(k,3458) = lu(k,3458) - lu(k,1650) * lu(k,3406) + lu(k,3460) = lu(k,3460) - lu(k,1651) * lu(k,3406) + lu(k,3461) = lu(k,3461) - lu(k,1652) * lu(k,3406) + lu(k,3462) = lu(k,3462) - lu(k,1653) * lu(k,3406) + lu(k,3467) = lu(k,3467) - lu(k,1654) * lu(k,3406) + lu(k,3471) = lu(k,3471) - lu(k,1655) * lu(k,3406) + lu(k,3709) = lu(k,3709) - lu(k,1641) * lu(k,3707) + lu(k,3713) = lu(k,3713) - lu(k,1642) * lu(k,3707) + lu(k,3714) = lu(k,3714) - lu(k,1643) * lu(k,3707) + lu(k,3715) = lu(k,3715) - lu(k,1644) * lu(k,3707) + lu(k,3720) = lu(k,3720) - lu(k,1645) * lu(k,3707) + lu(k,3721) = lu(k,3721) - lu(k,1646) * lu(k,3707) + lu(k,3726) = lu(k,3726) - lu(k,1647) * lu(k,3707) + lu(k,3753) = lu(k,3753) - lu(k,1648) * lu(k,3707) + lu(k,3755) = lu(k,3755) - lu(k,1649) * lu(k,3707) + lu(k,3756) = lu(k,3756) - lu(k,1650) * lu(k,3707) + lu(k,3758) = lu(k,3758) - lu(k,1651) * lu(k,3707) + lu(k,3759) = lu(k,3759) - lu(k,1652) * lu(k,3707) + lu(k,3760) = lu(k,3760) - lu(k,1653) * lu(k,3707) + lu(k,3765) = lu(k,3765) - lu(k,1654) * lu(k,3707) + lu(k,3769) = lu(k,3769) - lu(k,1655) * lu(k,3707) + lu(k,4040) = lu(k,4040) - lu(k,1641) * lu(k,4035) + lu(k,4044) = lu(k,4044) - lu(k,1642) * lu(k,4035) + lu(k,4045) = lu(k,4045) - lu(k,1643) * lu(k,4035) + lu(k,4046) = lu(k,4046) - lu(k,1644) * lu(k,4035) + lu(k,4051) = lu(k,4051) - lu(k,1645) * lu(k,4035) + lu(k,4052) = lu(k,4052) - lu(k,1646) * lu(k,4035) + lu(k,4057) = lu(k,4057) - lu(k,1647) * lu(k,4035) + lu(k,4085) = lu(k,4085) - lu(k,1648) * lu(k,4035) + lu(k,4087) = lu(k,4087) - lu(k,1649) * lu(k,4035) + lu(k,4088) = lu(k,4088) - lu(k,1650) * lu(k,4035) + lu(k,4090) = lu(k,4090) - lu(k,1651) * lu(k,4035) + lu(k,4091) = lu(k,4091) - lu(k,1652) * lu(k,4035) + lu(k,4092) = lu(k,4092) - lu(k,1653) * lu(k,4035) + lu(k,4097) = lu(k,4097) - lu(k,1654) * lu(k,4035) + lu(k,4101) = lu(k,4101) - lu(k,1655) * lu(k,4035) + lu(k,1659) = 1._r8 / lu(k,1659) + lu(k,1660) = lu(k,1660) * lu(k,1659) + lu(k,1661) = lu(k,1661) * lu(k,1659) + lu(k,1662) = lu(k,1662) * lu(k,1659) + lu(k,1663) = lu(k,1663) * lu(k,1659) + lu(k,1664) = lu(k,1664) * lu(k,1659) + lu(k,1665) = lu(k,1665) * lu(k,1659) + lu(k,1666) = lu(k,1666) * lu(k,1659) + lu(k,1667) = lu(k,1667) * lu(k,1659) + lu(k,1668) = lu(k,1668) * lu(k,1659) + lu(k,1669) = lu(k,1669) * lu(k,1659) + lu(k,1670) = lu(k,1670) * lu(k,1659) + lu(k,1943) = lu(k,1943) - lu(k,1660) * lu(k,1942) + lu(k,1945) = lu(k,1945) - lu(k,1661) * lu(k,1942) + lu(k,1946) = lu(k,1946) - lu(k,1662) * lu(k,1942) + lu(k,1951) = - lu(k,1663) * lu(k,1942) + lu(k,1952) = lu(k,1952) - lu(k,1664) * lu(k,1942) + lu(k,1957) = lu(k,1957) - lu(k,1665) * lu(k,1942) + lu(k,1960) = lu(k,1960) - lu(k,1666) * lu(k,1942) + lu(k,1962) = lu(k,1962) - lu(k,1667) * lu(k,1942) + lu(k,1964) = lu(k,1964) - lu(k,1668) * lu(k,1942) + lu(k,1967) = lu(k,1967) - lu(k,1669) * lu(k,1942) + lu(k,1968) = lu(k,1968) - lu(k,1670) * lu(k,1942) + lu(k,1980) = lu(k,1980) - lu(k,1660) * lu(k,1979) + lu(k,1982) = lu(k,1982) - lu(k,1661) * lu(k,1979) + lu(k,1983) = - lu(k,1662) * lu(k,1979) + lu(k,1988) = lu(k,1988) - lu(k,1663) * lu(k,1979) + lu(k,1989) = lu(k,1989) - lu(k,1664) * lu(k,1979) + lu(k,1994) = lu(k,1994) - lu(k,1665) * lu(k,1979) + lu(k,1999) = - lu(k,1666) * lu(k,1979) + lu(k,2001) = lu(k,2001) - lu(k,1667) * lu(k,1979) + lu(k,2003) = lu(k,2003) - lu(k,1668) * lu(k,1979) + lu(k,2006) = lu(k,2006) - lu(k,1669) * lu(k,1979) + lu(k,2007) = lu(k,2007) - lu(k,1670) * lu(k,1979) + lu(k,2070) = lu(k,2070) - lu(k,1660) * lu(k,2069) + lu(k,2071) = lu(k,2071) - lu(k,1661) * lu(k,2069) + lu(k,2072) = lu(k,2072) - lu(k,1662) * lu(k,2069) + lu(k,2075) = - lu(k,1663) * lu(k,2069) + lu(k,2076) = lu(k,2076) - lu(k,1664) * lu(k,2069) + lu(k,2077) = lu(k,2077) - lu(k,1665) * lu(k,2069) + lu(k,2081) = lu(k,2081) - lu(k,1666) * lu(k,2069) + lu(k,2084) = lu(k,2084) - lu(k,1667) * lu(k,2069) + lu(k,2086) = lu(k,2086) - lu(k,1668) * lu(k,2069) + lu(k,2088) = lu(k,2088) - lu(k,1669) * lu(k,2069) + lu(k,2091) = lu(k,2091) - lu(k,1670) * lu(k,2069) + lu(k,2102) = lu(k,2102) - lu(k,1660) * lu(k,2101) + lu(k,2103) = lu(k,2103) - lu(k,1661) * lu(k,2101) + lu(k,2104) = - lu(k,1662) * lu(k,2101) + lu(k,2107) = lu(k,2107) - lu(k,1663) * lu(k,2101) + lu(k,2108) = lu(k,2108) - lu(k,1664) * lu(k,2101) + lu(k,2109) = lu(k,2109) - lu(k,1665) * lu(k,2101) + lu(k,2113) = lu(k,2113) - lu(k,1666) * lu(k,2101) + lu(k,2116) = lu(k,2116) - lu(k,1667) * lu(k,2101) + lu(k,2118) = lu(k,2118) - lu(k,1668) * lu(k,2101) + lu(k,2120) = lu(k,2120) - lu(k,1669) * lu(k,2101) + lu(k,2123) = lu(k,2123) - lu(k,1670) * lu(k,2101) + lu(k,2168) = lu(k,2168) - lu(k,1660) * lu(k,2167) + lu(k,2169) = lu(k,2169) - lu(k,1661) * lu(k,2167) + lu(k,2170) = lu(k,2170) - lu(k,1662) * lu(k,2167) + lu(k,2172) = lu(k,2172) - lu(k,1663) * lu(k,2167) + lu(k,2173) = lu(k,2173) - lu(k,1664) * lu(k,2167) + lu(k,2176) = lu(k,2176) - lu(k,1665) * lu(k,2167) + lu(k,2184) = lu(k,2184) - lu(k,1666) * lu(k,2167) + lu(k,2187) = lu(k,2187) - lu(k,1667) * lu(k,2167) + lu(k,2189) = lu(k,2189) - lu(k,1668) * lu(k,2167) + lu(k,2192) = lu(k,2192) - lu(k,1669) * lu(k,2167) + lu(k,2195) = lu(k,2195) - lu(k,1670) * lu(k,2167) + lu(k,3057) = lu(k,3057) - lu(k,1660) * lu(k,3054) + lu(k,3061) = lu(k,3061) - lu(k,1661) * lu(k,3054) + lu(k,3062) = lu(k,3062) - lu(k,1662) * lu(k,3054) + lu(k,3068) = lu(k,3068) - lu(k,1663) * lu(k,3054) + lu(k,3069) = lu(k,3069) - lu(k,1664) * lu(k,3054) + lu(k,3074) = lu(k,3074) - lu(k,1665) * lu(k,3054) + lu(k,3105) = lu(k,3105) - lu(k,1666) * lu(k,3054) + lu(k,3108) = lu(k,3108) - lu(k,1667) * lu(k,3054) + lu(k,3110) = lu(k,3110) - lu(k,1668) * lu(k,3054) + lu(k,3115) = lu(k,3115) - lu(k,1669) * lu(k,3054) + lu(k,3119) = lu(k,3119) - lu(k,1670) * lu(k,3054) + lu(k,3316) = lu(k,3316) - lu(k,1660) * lu(k,3312) + lu(k,3320) = lu(k,3320) - lu(k,1661) * lu(k,3312) + lu(k,3321) = lu(k,3321) - lu(k,1662) * lu(k,3312) + lu(k,3327) = lu(k,3327) - lu(k,1663) * lu(k,3312) + lu(k,3328) = lu(k,3328) - lu(k,1664) * lu(k,3312) + lu(k,3333) = lu(k,3333) - lu(k,1665) * lu(k,3312) + lu(k,3364) = lu(k,3364) - lu(k,1666) * lu(k,3312) + lu(k,3367) = lu(k,3367) - lu(k,1667) * lu(k,3312) + lu(k,3369) = lu(k,3369) - lu(k,1668) * lu(k,3312) + lu(k,3374) = lu(k,3374) - lu(k,1669) * lu(k,3312) + lu(k,3378) = lu(k,3378) - lu(k,1670) * lu(k,3312) + lu(k,3410) = lu(k,3410) - lu(k,1660) * lu(k,3407) + lu(k,3414) = lu(k,3414) - lu(k,1661) * lu(k,3407) + lu(k,3415) = lu(k,3415) - lu(k,1662) * lu(k,3407) + lu(k,3421) = lu(k,3421) - lu(k,1663) * lu(k,3407) + lu(k,3422) = lu(k,3422) - lu(k,1664) * lu(k,3407) + lu(k,3427) = lu(k,3427) - lu(k,1665) * lu(k,3407) + lu(k,3457) = lu(k,3457) - lu(k,1666) * lu(k,3407) + lu(k,3460) = lu(k,3460) - lu(k,1667) * lu(k,3407) + lu(k,3462) = lu(k,3462) - lu(k,1668) * lu(k,3407) + lu(k,3467) = lu(k,3467) - lu(k,1669) * lu(k,3407) + lu(k,3471) = lu(k,3471) - lu(k,1670) * lu(k,3407) + lu(k,3709) = lu(k,3709) - lu(k,1660) * lu(k,3708) + lu(k,3713) = lu(k,3713) - lu(k,1661) * lu(k,3708) + lu(k,3714) = lu(k,3714) - lu(k,1662) * lu(k,3708) + lu(k,3720) = lu(k,3720) - lu(k,1663) * lu(k,3708) + lu(k,3721) = lu(k,3721) - lu(k,1664) * lu(k,3708) + lu(k,3726) = lu(k,3726) - lu(k,1665) * lu(k,3708) + lu(k,3755) = lu(k,3755) - lu(k,1666) * lu(k,3708) + lu(k,3758) = lu(k,3758) - lu(k,1667) * lu(k,3708) + lu(k,3760) = lu(k,3760) - lu(k,1668) * lu(k,3708) + lu(k,3765) = lu(k,3765) - lu(k,1669) * lu(k,3708) + lu(k,3769) = lu(k,3769) - lu(k,1670) * lu(k,3708) + lu(k,4040) = lu(k,4040) - lu(k,1660) * lu(k,4036) + lu(k,4044) = lu(k,4044) - lu(k,1661) * lu(k,4036) + lu(k,4045) = lu(k,4045) - lu(k,1662) * lu(k,4036) + lu(k,4051) = lu(k,4051) - lu(k,1663) * lu(k,4036) + lu(k,4052) = lu(k,4052) - lu(k,1664) * lu(k,4036) + lu(k,4057) = lu(k,4057) - lu(k,1665) * lu(k,4036) + lu(k,4087) = lu(k,4087) - lu(k,1666) * lu(k,4036) + lu(k,4090) = lu(k,4090) - lu(k,1667) * lu(k,4036) + lu(k,4092) = lu(k,4092) - lu(k,1668) * lu(k,4036) + lu(k,4097) = lu(k,4097) - lu(k,1669) * lu(k,4036) + lu(k,4101) = lu(k,4101) - lu(k,1670) * lu(k,4036) + end do + end subroutine lu_fac37 + subroutine lu_fac38( 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,1673) = 1._r8 / lu(k,1673) + lu(k,1674) = lu(k,1674) * lu(k,1673) + lu(k,1675) = lu(k,1675) * lu(k,1673) + lu(k,1676) = lu(k,1676) * lu(k,1673) + lu(k,1677) = lu(k,1677) * lu(k,1673) + lu(k,1678) = lu(k,1678) * lu(k,1673) + lu(k,1679) = lu(k,1679) * lu(k,1673) + lu(k,1680) = lu(k,1680) * lu(k,1673) + lu(k,1681) = lu(k,1681) * lu(k,1673) + lu(k,1682) = lu(k,1682) * lu(k,1673) + lu(k,1683) = lu(k,1683) * lu(k,1673) + lu(k,1684) = lu(k,1684) * lu(k,1673) + lu(k,2259) = lu(k,2259) - lu(k,1674) * lu(k,2257) + lu(k,2260) = lu(k,2260) - lu(k,1675) * lu(k,2257) + lu(k,2261) = lu(k,2261) - lu(k,1676) * lu(k,2257) + lu(k,2262) = lu(k,2262) - lu(k,1677) * lu(k,2257) + lu(k,2263) = lu(k,2263) - lu(k,1678) * lu(k,2257) + lu(k,2266) = lu(k,2266) - lu(k,1679) * lu(k,2257) + lu(k,2267) = lu(k,2267) - lu(k,1680) * lu(k,2257) + lu(k,2268) = lu(k,2268) - lu(k,1681) * lu(k,2257) + lu(k,2269) = lu(k,2269) - lu(k,1682) * lu(k,2257) + lu(k,2270) = lu(k,2270) - lu(k,1683) * lu(k,2257) + lu(k,2271) = lu(k,2271) - lu(k,1684) * lu(k,2257) + lu(k,2930) = - lu(k,1674) * lu(k,2929) + lu(k,2931) = lu(k,2931) - lu(k,1675) * lu(k,2929) + lu(k,2932) = - lu(k,1676) * lu(k,2929) + lu(k,2933) = - lu(k,1677) * lu(k,2929) + lu(k,2934) = lu(k,2934) - lu(k,1678) * lu(k,2929) + lu(k,2937) = - lu(k,1679) * lu(k,2929) + lu(k,2938) = - lu(k,1680) * lu(k,2929) + lu(k,2940) = - lu(k,1681) * lu(k,2929) + lu(k,2941) = - lu(k,1682) * lu(k,2929) + lu(k,2942) = lu(k,2942) - lu(k,1683) * lu(k,2929) + lu(k,2943) = lu(k,2943) - lu(k,1684) * lu(k,2929) + lu(k,2947) = lu(k,2947) - lu(k,1674) * lu(k,2946) + lu(k,2948) = lu(k,2948) - lu(k,1675) * lu(k,2946) + lu(k,2949) = lu(k,2949) - lu(k,1676) * lu(k,2946) + lu(k,2950) = - lu(k,1677) * lu(k,2946) + lu(k,2951) = - lu(k,1678) * lu(k,2946) + lu(k,2954) = lu(k,2954) - lu(k,1679) * lu(k,2946) + lu(k,2955) = lu(k,2955) - lu(k,1680) * lu(k,2946) + lu(k,2958) = - lu(k,1681) * lu(k,2946) + lu(k,2959) = - lu(k,1682) * lu(k,2946) + lu(k,2960) = lu(k,2960) - lu(k,1683) * lu(k,2946) + lu(k,2961) = lu(k,2961) - lu(k,1684) * lu(k,2946) + lu(k,3156) = - lu(k,1674) * lu(k,3153) + lu(k,3157) = lu(k,3157) - lu(k,1675) * lu(k,3153) + lu(k,3158) = lu(k,3158) - lu(k,1676) * lu(k,3153) + lu(k,3160) = lu(k,3160) - lu(k,1677) * lu(k,3153) + lu(k,3161) = lu(k,3161) - lu(k,1678) * lu(k,3153) + lu(k,3164) = - lu(k,1679) * lu(k,3153) + lu(k,3167) = lu(k,3167) - lu(k,1680) * lu(k,3153) + lu(k,3170) = lu(k,3170) - lu(k,1681) * lu(k,3153) + lu(k,3171) = lu(k,3171) - lu(k,1682) * lu(k,3153) + lu(k,3172) = lu(k,3172) - lu(k,1683) * lu(k,3153) + lu(k,3173) = lu(k,3173) - lu(k,1684) * lu(k,3153) + lu(k,3182) = - lu(k,1674) * lu(k,3179) + lu(k,3183) = lu(k,3183) - lu(k,1675) * lu(k,3179) + lu(k,3184) = lu(k,3184) - lu(k,1676) * lu(k,3179) + lu(k,3186) = lu(k,3186) - lu(k,1677) * lu(k,3179) + lu(k,3187) = lu(k,3187) - lu(k,1678) * lu(k,3179) + lu(k,3190) = - lu(k,1679) * lu(k,3179) + lu(k,3193) = lu(k,3193) - lu(k,1680) * lu(k,3179) + lu(k,3196) = lu(k,3196) - lu(k,1681) * lu(k,3179) + lu(k,3197) = lu(k,3197) - lu(k,1682) * lu(k,3179) + lu(k,3198) = lu(k,3198) - lu(k,1683) * lu(k,3179) + lu(k,3199) = lu(k,3199) - lu(k,1684) * lu(k,3179) + lu(k,3341) = - lu(k,1674) * lu(k,3313) + lu(k,3363) = lu(k,3363) - lu(k,1675) * lu(k,3313) + lu(k,3364) = lu(k,3364) - lu(k,1676) * lu(k,3313) + lu(k,3366) = lu(k,3366) - lu(k,1677) * lu(k,3313) + lu(k,3367) = lu(k,3367) - lu(k,1678) * lu(k,3313) + lu(k,3370) = lu(k,3370) - lu(k,1679) * lu(k,3313) + lu(k,3373) = lu(k,3373) - lu(k,1680) * lu(k,3313) + lu(k,3376) = lu(k,3376) - lu(k,1681) * lu(k,3313) + lu(k,3377) = lu(k,3377) - lu(k,1682) * lu(k,3313) + lu(k,3378) = lu(k,3378) - lu(k,1683) * lu(k,3313) + lu(k,3379) = lu(k,3379) - lu(k,1684) * lu(k,3313) + lu(k,3794) = lu(k,3794) - lu(k,1674) * lu(k,3792) + lu(k,3795) = lu(k,3795) - lu(k,1675) * lu(k,3792) + lu(k,3796) = lu(k,3796) - lu(k,1676) * lu(k,3792) + lu(k,3798) = lu(k,3798) - lu(k,1677) * lu(k,3792) + lu(k,3799) = lu(k,3799) - lu(k,1678) * lu(k,3792) + lu(k,3802) = lu(k,3802) - lu(k,1679) * lu(k,3792) + lu(k,3805) = lu(k,3805) - lu(k,1680) * lu(k,3792) + lu(k,3808) = lu(k,3808) - lu(k,1681) * lu(k,3792) + lu(k,3809) = lu(k,3809) - lu(k,1682) * lu(k,3792) + lu(k,3810) = lu(k,3810) - lu(k,1683) * lu(k,3792) + lu(k,3811) = lu(k,3811) - lu(k,1684) * lu(k,3792) + lu(k,3834) = lu(k,3834) - lu(k,1674) * lu(k,3830) + lu(k,3836) = lu(k,3836) - lu(k,1675) * lu(k,3830) + lu(k,3837) = lu(k,3837) - lu(k,1676) * lu(k,3830) + lu(k,3839) = lu(k,3839) - lu(k,1677) * lu(k,3830) + lu(k,3840) = lu(k,3840) - lu(k,1678) * lu(k,3830) + lu(k,3843) = lu(k,3843) - lu(k,1679) * lu(k,3830) + lu(k,3846) = lu(k,3846) - lu(k,1680) * lu(k,3830) + lu(k,3849) = lu(k,3849) - lu(k,1681) * lu(k,3830) + lu(k,3850) = lu(k,3850) - lu(k,1682) * lu(k,3830) + lu(k,3851) = lu(k,3851) - lu(k,1683) * lu(k,3830) + lu(k,3852) = lu(k,3852) - lu(k,1684) * lu(k,3830) + lu(k,4064) = lu(k,4064) - lu(k,1674) * lu(k,4037) + lu(k,4086) = lu(k,4086) - lu(k,1675) * lu(k,4037) + lu(k,4087) = lu(k,4087) - lu(k,1676) * lu(k,4037) + lu(k,4089) = lu(k,4089) - lu(k,1677) * lu(k,4037) + lu(k,4090) = lu(k,4090) - lu(k,1678) * lu(k,4037) + lu(k,4093) = lu(k,4093) - lu(k,1679) * lu(k,4037) + lu(k,4096) = lu(k,4096) - lu(k,1680) * lu(k,4037) + lu(k,4099) = lu(k,4099) - lu(k,1681) * lu(k,4037) + lu(k,4100) = lu(k,4100) - lu(k,1682) * lu(k,4037) + lu(k,4101) = lu(k,4101) - lu(k,1683) * lu(k,4037) + lu(k,4102) = lu(k,4102) - lu(k,1684) * lu(k,4037) + lu(k,4111) = lu(k,4111) - lu(k,1674) * lu(k,4109) + lu(k,4112) = lu(k,4112) - lu(k,1675) * lu(k,4109) + lu(k,4113) = lu(k,4113) - lu(k,1676) * lu(k,4109) + lu(k,4115) = - lu(k,1677) * lu(k,4109) + lu(k,4116) = lu(k,4116) - lu(k,1678) * lu(k,4109) + lu(k,4119) = lu(k,4119) - lu(k,1679) * lu(k,4109) + lu(k,4122) = lu(k,4122) - lu(k,1680) * lu(k,4109) + lu(k,4125) = lu(k,4125) - lu(k,1681) * lu(k,4109) + lu(k,4126) = lu(k,4126) - lu(k,1682) * lu(k,4109) + lu(k,4127) = lu(k,4127) - lu(k,1683) * lu(k,4109) + lu(k,4128) = lu(k,4128) - lu(k,1684) * lu(k,4109) + lu(k,1689) = 1._r8 / lu(k,1689) + lu(k,1690) = lu(k,1690) * lu(k,1689) + lu(k,1691) = lu(k,1691) * lu(k,1689) + lu(k,1692) = lu(k,1692) * lu(k,1689) + lu(k,1693) = lu(k,1693) * lu(k,1689) + lu(k,1694) = lu(k,1694) * lu(k,1689) + lu(k,1695) = lu(k,1695) * lu(k,1689) + lu(k,1696) = lu(k,1696) * lu(k,1689) + lu(k,2340) = - lu(k,1690) * lu(k,2335) + lu(k,2341) = lu(k,2341) - lu(k,1691) * lu(k,2335) + lu(k,2349) = - lu(k,1692) * lu(k,2335) + lu(k,2350) = lu(k,2350) - lu(k,1693) * lu(k,2335) + lu(k,2353) = lu(k,2353) - lu(k,1694) * lu(k,2335) + lu(k,2356) = lu(k,2356) - lu(k,1695) * lu(k,2335) + lu(k,2357) = lu(k,2357) - lu(k,1696) * lu(k,2335) + lu(k,2379) = lu(k,2379) - lu(k,1690) * lu(k,2373) + lu(k,2381) = lu(k,2381) - lu(k,1691) * lu(k,2373) + lu(k,2389) = lu(k,2389) - lu(k,1692) * lu(k,2373) + lu(k,2390) = lu(k,2390) - lu(k,1693) * lu(k,2373) + lu(k,2393) = lu(k,2393) - lu(k,1694) * lu(k,2373) + lu(k,2396) = lu(k,2396) - lu(k,1695) * lu(k,2373) + lu(k,2397) = lu(k,2397) - lu(k,1696) * lu(k,2373) + lu(k,2440) = lu(k,2440) - lu(k,1690) * lu(k,2434) + lu(k,2442) = lu(k,2442) - lu(k,1691) * lu(k,2434) + lu(k,2450) = lu(k,2450) - lu(k,1692) * lu(k,2434) + lu(k,2451) = lu(k,2451) - lu(k,1693) * lu(k,2434) + lu(k,2454) = lu(k,2454) - lu(k,1694) * lu(k,2434) + lu(k,2457) = lu(k,2457) - lu(k,1695) * lu(k,2434) + lu(k,2458) = lu(k,2458) - lu(k,1696) * lu(k,2434) + lu(k,2470) = lu(k,2470) - lu(k,1690) * lu(k,2465) + lu(k,2473) = - lu(k,1691) * lu(k,2465) + lu(k,2481) = - lu(k,1692) * lu(k,2465) + lu(k,2482) = lu(k,2482) - lu(k,1693) * lu(k,2465) + lu(k,2485) = lu(k,2485) - lu(k,1694) * lu(k,2465) + lu(k,2488) = lu(k,2488) - lu(k,1695) * lu(k,2465) + lu(k,2489) = lu(k,2489) - lu(k,1696) * lu(k,2465) + lu(k,2504) = lu(k,2504) - lu(k,1690) * lu(k,2501) + lu(k,2507) = lu(k,2507) - lu(k,1691) * lu(k,2501) + lu(k,2515) = lu(k,2515) - lu(k,1692) * lu(k,2501) + lu(k,2516) = lu(k,2516) - lu(k,1693) * lu(k,2501) + lu(k,2519) = lu(k,2519) - lu(k,1694) * lu(k,2501) + lu(k,2522) = lu(k,2522) - lu(k,1695) * lu(k,2501) + lu(k,2523) = lu(k,2523) - lu(k,1696) * lu(k,2501) + lu(k,2568) = lu(k,2568) - lu(k,1690) * lu(k,2564) + lu(k,2572) = lu(k,2572) - lu(k,1691) * lu(k,2564) + lu(k,2580) = lu(k,2580) - lu(k,1692) * lu(k,2564) + lu(k,2581) = lu(k,2581) - lu(k,1693) * lu(k,2564) + lu(k,2584) = lu(k,2584) - lu(k,1694) * lu(k,2564) + lu(k,2587) = lu(k,2587) - lu(k,1695) * lu(k,2564) + lu(k,2588) = lu(k,2588) - lu(k,1696) * lu(k,2564) + lu(k,2599) = - lu(k,1690) * lu(k,2595) + lu(k,2601) = lu(k,2601) - lu(k,1691) * lu(k,2595) + lu(k,2607) = - lu(k,1692) * lu(k,2595) + lu(k,2608) = lu(k,2608) - lu(k,1693) * lu(k,2595) + lu(k,2612) = lu(k,2612) - lu(k,1694) * lu(k,2595) + lu(k,2614) = lu(k,2614) - lu(k,1695) * lu(k,2595) + lu(k,2617) = lu(k,2617) - lu(k,1696) * lu(k,2595) + lu(k,2732) = lu(k,2732) - lu(k,1690) * lu(k,2722) + lu(k,2741) = lu(k,2741) - lu(k,1691) * lu(k,2722) + lu(k,2749) = lu(k,2749) - lu(k,1692) * lu(k,2722) + lu(k,2750) = lu(k,2750) - lu(k,1693) * lu(k,2722) + lu(k,2754) = lu(k,2754) - lu(k,1694) * lu(k,2722) + lu(k,2757) = lu(k,2757) - lu(k,1695) * lu(k,2722) + lu(k,2760) = lu(k,2760) - lu(k,1696) * lu(k,2722) + lu(k,2778) = lu(k,2778) - lu(k,1690) * lu(k,2768) + lu(k,2787) = lu(k,2787) - lu(k,1691) * lu(k,2768) + lu(k,2795) = lu(k,2795) - lu(k,1692) * lu(k,2768) + lu(k,2796) = lu(k,2796) - lu(k,1693) * lu(k,2768) + lu(k,2800) = lu(k,2800) - lu(k,1694) * lu(k,2768) + lu(k,2803) = lu(k,2803) - lu(k,1695) * lu(k,2768) + lu(k,2806) = lu(k,2806) - lu(k,1696) * lu(k,2768) + lu(k,2825) = lu(k,2825) - lu(k,1690) * lu(k,2815) + lu(k,2834) = lu(k,2834) - lu(k,1691) * lu(k,2815) + lu(k,2842) = lu(k,2842) - lu(k,1692) * lu(k,2815) + lu(k,2843) = lu(k,2843) - lu(k,1693) * lu(k,2815) + lu(k,2847) = lu(k,2847) - lu(k,1694) * lu(k,2815) + lu(k,2850) = lu(k,2850) - lu(k,1695) * lu(k,2815) + lu(k,2853) = lu(k,2853) - lu(k,1696) * lu(k,2815) + lu(k,2897) = lu(k,2897) - lu(k,1690) * lu(k,2867) + lu(k,2906) = lu(k,2906) - lu(k,1691) * lu(k,2867) + lu(k,2915) = lu(k,2915) - lu(k,1692) * lu(k,2867) + lu(k,2916) = lu(k,2916) - lu(k,1693) * lu(k,2867) + lu(k,2920) = lu(k,2920) - lu(k,1694) * lu(k,2867) + lu(k,2923) = lu(k,2923) - lu(k,1695) * lu(k,2867) + lu(k,2927) = lu(k,2927) - lu(k,1696) * lu(k,2867) + lu(k,3087) = lu(k,3087) - lu(k,1690) * lu(k,3055) + lu(k,3096) = lu(k,3096) - lu(k,1691) * lu(k,3055) + lu(k,3105) = lu(k,3105) - lu(k,1692) * lu(k,3055) + lu(k,3106) = lu(k,3106) - lu(k,1693) * lu(k,3055) + lu(k,3110) = lu(k,3110) - lu(k,1694) * lu(k,3055) + lu(k,3115) = lu(k,3115) - lu(k,1695) * lu(k,3055) + lu(k,3119) = lu(k,3119) - lu(k,1696) * lu(k,3055) + lu(k,3346) = lu(k,3346) - lu(k,1690) * lu(k,3314) + lu(k,3355) = lu(k,3355) - lu(k,1691) * lu(k,3314) + lu(k,3364) = lu(k,3364) - lu(k,1692) * lu(k,3314) + lu(k,3365) = lu(k,3365) - lu(k,1693) * lu(k,3314) + lu(k,3369) = lu(k,3369) - lu(k,1694) * lu(k,3314) + lu(k,3374) = lu(k,3374) - lu(k,1695) * lu(k,3314) + lu(k,3378) = lu(k,3378) - lu(k,1696) * lu(k,3314) + lu(k,3439) = lu(k,3439) - lu(k,1690) * lu(k,3408) + lu(k,3448) = lu(k,3448) - lu(k,1691) * lu(k,3408) + lu(k,3457) = lu(k,3457) - lu(k,1692) * lu(k,3408) + lu(k,3458) = lu(k,3458) - lu(k,1693) * lu(k,3408) + lu(k,3462) = lu(k,3462) - lu(k,1694) * lu(k,3408) + lu(k,3467) = lu(k,3467) - lu(k,1695) * lu(k,3408) + lu(k,3471) = lu(k,3471) - lu(k,1696) * lu(k,3408) + lu(k,3583) = lu(k,3583) - lu(k,1690) * lu(k,3553) + lu(k,3592) = lu(k,3592) - lu(k,1691) * lu(k,3553) + lu(k,3601) = lu(k,3601) - lu(k,1692) * lu(k,3553) + lu(k,3602) = lu(k,3602) - lu(k,1693) * lu(k,3553) + lu(k,3606) = lu(k,3606) - lu(k,1694) * lu(k,3553) + lu(k,3611) = lu(k,3611) - lu(k,1695) * lu(k,3553) + lu(k,3615) = lu(k,3615) - lu(k,1696) * lu(k,3553) + lu(k,4069) = lu(k,4069) - lu(k,1690) * lu(k,4038) + lu(k,4078) = lu(k,4078) - lu(k,1691) * lu(k,4038) + lu(k,4087) = lu(k,4087) - lu(k,1692) * lu(k,4038) + lu(k,4088) = lu(k,4088) - lu(k,1693) * lu(k,4038) + lu(k,4092) = lu(k,4092) - lu(k,1694) * lu(k,4038) + lu(k,4097) = lu(k,4097) - lu(k,1695) * lu(k,4038) + lu(k,4101) = lu(k,4101) - lu(k,1696) * lu(k,4038) + lu(k,1702) = 1._r8 / lu(k,1702) + lu(k,1703) = lu(k,1703) * lu(k,1702) + lu(k,1704) = lu(k,1704) * lu(k,1702) + lu(k,1705) = lu(k,1705) * lu(k,1702) + lu(k,1706) = lu(k,1706) * lu(k,1702) + lu(k,1707) = lu(k,1707) * lu(k,1702) + lu(k,1708) = lu(k,1708) * lu(k,1702) + lu(k,1709) = lu(k,1709) * lu(k,1702) + lu(k,2340) = lu(k,2340) - lu(k,1703) * lu(k,2336) + lu(k,2341) = lu(k,2341) - lu(k,1704) * lu(k,2336) + lu(k,2349) = lu(k,2349) - lu(k,1705) * lu(k,2336) + lu(k,2350) = lu(k,2350) - lu(k,1706) * lu(k,2336) + lu(k,2353) = lu(k,2353) - lu(k,1707) * lu(k,2336) + lu(k,2356) = lu(k,2356) - lu(k,1708) * lu(k,2336) + lu(k,2357) = lu(k,2357) - lu(k,1709) * lu(k,2336) + lu(k,2379) = lu(k,2379) - lu(k,1703) * lu(k,2374) + lu(k,2381) = lu(k,2381) - lu(k,1704) * lu(k,2374) + lu(k,2389) = lu(k,2389) - lu(k,1705) * lu(k,2374) + lu(k,2390) = lu(k,2390) - lu(k,1706) * lu(k,2374) + lu(k,2393) = lu(k,2393) - lu(k,1707) * lu(k,2374) + lu(k,2396) = lu(k,2396) - lu(k,1708) * lu(k,2374) + lu(k,2397) = lu(k,2397) - lu(k,1709) * lu(k,2374) + lu(k,2440) = lu(k,2440) - lu(k,1703) * lu(k,2435) + lu(k,2442) = lu(k,2442) - lu(k,1704) * lu(k,2435) + lu(k,2450) = lu(k,2450) - lu(k,1705) * lu(k,2435) + lu(k,2451) = lu(k,2451) - lu(k,1706) * lu(k,2435) + lu(k,2454) = lu(k,2454) - lu(k,1707) * lu(k,2435) + lu(k,2457) = lu(k,2457) - lu(k,1708) * lu(k,2435) + lu(k,2458) = lu(k,2458) - lu(k,1709) * lu(k,2435) + lu(k,2470) = lu(k,2470) - lu(k,1703) * lu(k,2466) + lu(k,2473) = lu(k,2473) - lu(k,1704) * lu(k,2466) + lu(k,2481) = lu(k,2481) - lu(k,1705) * lu(k,2466) + lu(k,2482) = lu(k,2482) - lu(k,1706) * lu(k,2466) + lu(k,2485) = lu(k,2485) - lu(k,1707) * lu(k,2466) + lu(k,2488) = lu(k,2488) - lu(k,1708) * lu(k,2466) + lu(k,2489) = lu(k,2489) - lu(k,1709) * lu(k,2466) + lu(k,2504) = lu(k,2504) - lu(k,1703) * lu(k,2502) + lu(k,2507) = lu(k,2507) - lu(k,1704) * lu(k,2502) + lu(k,2515) = lu(k,2515) - lu(k,1705) * lu(k,2502) + lu(k,2516) = lu(k,2516) - lu(k,1706) * lu(k,2502) + lu(k,2519) = lu(k,2519) - lu(k,1707) * lu(k,2502) + lu(k,2522) = lu(k,2522) - lu(k,1708) * lu(k,2502) + lu(k,2523) = lu(k,2523) - lu(k,1709) * lu(k,2502) + lu(k,2568) = lu(k,2568) - lu(k,1703) * lu(k,2565) + lu(k,2572) = lu(k,2572) - lu(k,1704) * lu(k,2565) + lu(k,2580) = lu(k,2580) - lu(k,1705) * lu(k,2565) + lu(k,2581) = lu(k,2581) - lu(k,1706) * lu(k,2565) + lu(k,2584) = lu(k,2584) - lu(k,1707) * lu(k,2565) + lu(k,2587) = lu(k,2587) - lu(k,1708) * lu(k,2565) + lu(k,2588) = lu(k,2588) - lu(k,1709) * lu(k,2565) + lu(k,2599) = lu(k,2599) - lu(k,1703) * lu(k,2596) + lu(k,2601) = lu(k,2601) - lu(k,1704) * lu(k,2596) + lu(k,2607) = lu(k,2607) - lu(k,1705) * lu(k,2596) + lu(k,2608) = lu(k,2608) - lu(k,1706) * lu(k,2596) + lu(k,2612) = lu(k,2612) - lu(k,1707) * lu(k,2596) + lu(k,2614) = lu(k,2614) - lu(k,1708) * lu(k,2596) + lu(k,2617) = lu(k,2617) - lu(k,1709) * lu(k,2596) + lu(k,2732) = lu(k,2732) - lu(k,1703) * lu(k,2723) + lu(k,2741) = lu(k,2741) - lu(k,1704) * lu(k,2723) + lu(k,2749) = lu(k,2749) - lu(k,1705) * lu(k,2723) + lu(k,2750) = lu(k,2750) - lu(k,1706) * lu(k,2723) + lu(k,2754) = lu(k,2754) - lu(k,1707) * lu(k,2723) + lu(k,2757) = lu(k,2757) - lu(k,1708) * lu(k,2723) + lu(k,2760) = lu(k,2760) - lu(k,1709) * lu(k,2723) + lu(k,2778) = lu(k,2778) - lu(k,1703) * lu(k,2769) + lu(k,2787) = lu(k,2787) - lu(k,1704) * lu(k,2769) + lu(k,2795) = lu(k,2795) - lu(k,1705) * lu(k,2769) + lu(k,2796) = lu(k,2796) - lu(k,1706) * lu(k,2769) + lu(k,2800) = lu(k,2800) - lu(k,1707) * lu(k,2769) + lu(k,2803) = lu(k,2803) - lu(k,1708) * lu(k,2769) + lu(k,2806) = lu(k,2806) - lu(k,1709) * lu(k,2769) + lu(k,2825) = lu(k,2825) - lu(k,1703) * lu(k,2816) + lu(k,2834) = lu(k,2834) - lu(k,1704) * lu(k,2816) + lu(k,2842) = lu(k,2842) - lu(k,1705) * lu(k,2816) + lu(k,2843) = lu(k,2843) - lu(k,1706) * lu(k,2816) + lu(k,2847) = lu(k,2847) - lu(k,1707) * lu(k,2816) + lu(k,2850) = lu(k,2850) - lu(k,1708) * lu(k,2816) + lu(k,2853) = lu(k,2853) - lu(k,1709) * lu(k,2816) + lu(k,2897) = lu(k,2897) - lu(k,1703) * lu(k,2868) + lu(k,2906) = lu(k,2906) - lu(k,1704) * lu(k,2868) + lu(k,2915) = lu(k,2915) - lu(k,1705) * lu(k,2868) + lu(k,2916) = lu(k,2916) - lu(k,1706) * lu(k,2868) + lu(k,2920) = lu(k,2920) - lu(k,1707) * lu(k,2868) + lu(k,2923) = lu(k,2923) - lu(k,1708) * lu(k,2868) + lu(k,2927) = lu(k,2927) - lu(k,1709) * lu(k,2868) + lu(k,3087) = lu(k,3087) - lu(k,1703) * lu(k,3056) + lu(k,3096) = lu(k,3096) - lu(k,1704) * lu(k,3056) + lu(k,3105) = lu(k,3105) - lu(k,1705) * lu(k,3056) + lu(k,3106) = lu(k,3106) - lu(k,1706) * lu(k,3056) + lu(k,3110) = lu(k,3110) - lu(k,1707) * lu(k,3056) + lu(k,3115) = lu(k,3115) - lu(k,1708) * lu(k,3056) + lu(k,3119) = lu(k,3119) - lu(k,1709) * lu(k,3056) + lu(k,3346) = lu(k,3346) - lu(k,1703) * lu(k,3315) + lu(k,3355) = lu(k,3355) - lu(k,1704) * lu(k,3315) + lu(k,3364) = lu(k,3364) - lu(k,1705) * lu(k,3315) + lu(k,3365) = lu(k,3365) - lu(k,1706) * lu(k,3315) + lu(k,3369) = lu(k,3369) - lu(k,1707) * lu(k,3315) + lu(k,3374) = lu(k,3374) - lu(k,1708) * lu(k,3315) + lu(k,3378) = lu(k,3378) - lu(k,1709) * lu(k,3315) + lu(k,3439) = lu(k,3439) - lu(k,1703) * lu(k,3409) + lu(k,3448) = lu(k,3448) - lu(k,1704) * lu(k,3409) + lu(k,3457) = lu(k,3457) - lu(k,1705) * lu(k,3409) + lu(k,3458) = lu(k,3458) - lu(k,1706) * lu(k,3409) + lu(k,3462) = lu(k,3462) - lu(k,1707) * lu(k,3409) + lu(k,3467) = lu(k,3467) - lu(k,1708) * lu(k,3409) + lu(k,3471) = lu(k,3471) - lu(k,1709) * lu(k,3409) + lu(k,3583) = lu(k,3583) - lu(k,1703) * lu(k,3554) + lu(k,3592) = lu(k,3592) - lu(k,1704) * lu(k,3554) + lu(k,3601) = lu(k,3601) - lu(k,1705) * lu(k,3554) + lu(k,3602) = lu(k,3602) - lu(k,1706) * lu(k,3554) + lu(k,3606) = lu(k,3606) - lu(k,1707) * lu(k,3554) + lu(k,3611) = lu(k,3611) - lu(k,1708) * lu(k,3554) + lu(k,3615) = lu(k,3615) - lu(k,1709) * lu(k,3554) + lu(k,4069) = lu(k,4069) - lu(k,1703) * lu(k,4039) + lu(k,4078) = lu(k,4078) - lu(k,1704) * lu(k,4039) + lu(k,4087) = lu(k,4087) - lu(k,1705) * lu(k,4039) + lu(k,4088) = lu(k,4088) - lu(k,1706) * lu(k,4039) + lu(k,4092) = lu(k,4092) - lu(k,1707) * lu(k,4039) + lu(k,4097) = lu(k,4097) - lu(k,1708) * lu(k,4039) + lu(k,4101) = lu(k,4101) - lu(k,1709) * lu(k,4039) + end do + end subroutine lu_fac38 + subroutine lu_fac39( 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,1712) = 1._r8 / lu(k,1712) + lu(k,1713) = lu(k,1713) * lu(k,1712) + lu(k,1714) = lu(k,1714) * lu(k,1712) + lu(k,1715) = lu(k,1715) * lu(k,1712) + lu(k,1716) = lu(k,1716) * lu(k,1712) + lu(k,1717) = lu(k,1717) * lu(k,1712) + lu(k,1738) = lu(k,1738) - lu(k,1713) * lu(k,1731) + lu(k,1742) = lu(k,1742) - lu(k,1714) * lu(k,1731) + lu(k,1743) = lu(k,1743) - lu(k,1715) * lu(k,1731) + lu(k,1744) = lu(k,1744) - lu(k,1716) * lu(k,1731) + lu(k,1747) = lu(k,1747) - lu(k,1717) * lu(k,1731) + lu(k,1760) = lu(k,1760) - lu(k,1713) * lu(k,1753) + lu(k,1764) = lu(k,1764) - lu(k,1714) * lu(k,1753) + lu(k,1765) = lu(k,1765) - lu(k,1715) * lu(k,1753) + lu(k,1766) = lu(k,1766) - lu(k,1716) * lu(k,1753) + lu(k,1769) = lu(k,1769) - lu(k,1717) * lu(k,1753) + lu(k,1796) = lu(k,1796) - lu(k,1713) * lu(k,1790) + lu(k,1798) = lu(k,1798) - lu(k,1714) * lu(k,1790) + lu(k,1799) = lu(k,1799) - lu(k,1715) * lu(k,1790) + lu(k,1800) = lu(k,1800) - lu(k,1716) * lu(k,1790) + lu(k,1802) = lu(k,1802) - lu(k,1717) * lu(k,1790) + lu(k,1823) = lu(k,1823) - lu(k,1713) * lu(k,1814) + lu(k,1828) = lu(k,1828) - lu(k,1714) * lu(k,1814) + lu(k,1829) = lu(k,1829) - lu(k,1715) * lu(k,1814) + lu(k,1830) = lu(k,1830) - lu(k,1716) * lu(k,1814) + lu(k,1833) = lu(k,1833) - lu(k,1717) * lu(k,1814) + lu(k,1855) = lu(k,1855) - lu(k,1713) * lu(k,1846) + lu(k,1859) = lu(k,1859) - lu(k,1714) * lu(k,1846) + lu(k,1860) = lu(k,1860) - lu(k,1715) * lu(k,1846) + lu(k,1861) = lu(k,1861) - lu(k,1716) * lu(k,1846) + lu(k,1864) = lu(k,1864) - lu(k,1717) * lu(k,1846) + lu(k,1875) = lu(k,1875) - lu(k,1713) * lu(k,1869) + lu(k,1878) = lu(k,1878) - lu(k,1714) * lu(k,1869) + lu(k,1879) = - lu(k,1715) * lu(k,1869) + lu(k,1880) = lu(k,1880) - lu(k,1716) * lu(k,1869) + lu(k,1882) = lu(k,1882) - lu(k,1717) * lu(k,1869) + lu(k,1903) = lu(k,1903) - lu(k,1713) * lu(k,1892) + lu(k,1906) = lu(k,1906) - lu(k,1714) * lu(k,1892) + lu(k,1907) = lu(k,1907) - lu(k,1715) * lu(k,1892) + lu(k,1908) = lu(k,1908) - lu(k,1716) * lu(k,1892) + lu(k,1910) = lu(k,1910) - lu(k,1717) * lu(k,1892) + lu(k,1918) = lu(k,1918) - lu(k,1713) * lu(k,1915) + lu(k,1921) = lu(k,1921) - lu(k,1714) * lu(k,1915) + lu(k,1922) = lu(k,1922) - lu(k,1715) * lu(k,1915) + lu(k,1923) = lu(k,1923) - lu(k,1716) * lu(k,1915) + lu(k,1925) = lu(k,1925) - lu(k,1717) * lu(k,1915) + lu(k,1957) = lu(k,1957) - lu(k,1713) * lu(k,1943) + lu(k,1962) = lu(k,1962) - lu(k,1714) * lu(k,1943) + lu(k,1963) = lu(k,1963) - lu(k,1715) * lu(k,1943) + lu(k,1964) = lu(k,1964) - lu(k,1716) * lu(k,1943) + lu(k,1968) = lu(k,1968) - lu(k,1717) * lu(k,1943) + lu(k,1994) = lu(k,1994) - lu(k,1713) * lu(k,1980) + lu(k,2001) = lu(k,2001) - lu(k,1714) * lu(k,1980) + lu(k,2002) = lu(k,2002) - lu(k,1715) * lu(k,1980) + lu(k,2003) = lu(k,2003) - lu(k,1716) * lu(k,1980) + lu(k,2007) = lu(k,2007) - lu(k,1717) * lu(k,1980) + lu(k,2042) = lu(k,2042) - lu(k,1713) * lu(k,2037) + lu(k,2047) = lu(k,2047) - lu(k,1714) * lu(k,2037) + lu(k,2048) = lu(k,2048) - lu(k,1715) * lu(k,2037) + lu(k,2049) = lu(k,2049) - lu(k,1716) * lu(k,2037) + lu(k,2054) = lu(k,2054) - lu(k,1717) * lu(k,2037) + lu(k,2077) = lu(k,2077) - lu(k,1713) * lu(k,2070) + lu(k,2084) = lu(k,2084) - lu(k,1714) * lu(k,2070) + lu(k,2085) = lu(k,2085) - lu(k,1715) * lu(k,2070) + lu(k,2086) = lu(k,2086) - lu(k,1716) * lu(k,2070) + lu(k,2091) = lu(k,2091) - lu(k,1717) * lu(k,2070) + lu(k,2109) = lu(k,2109) - lu(k,1713) * lu(k,2102) + lu(k,2116) = lu(k,2116) - lu(k,1714) * lu(k,2102) + lu(k,2117) = lu(k,2117) - lu(k,1715) * lu(k,2102) + lu(k,2118) = lu(k,2118) - lu(k,1716) * lu(k,2102) + lu(k,2123) = lu(k,2123) - lu(k,1717) * lu(k,2102) + lu(k,2139) = lu(k,2139) - lu(k,1713) * lu(k,2132) + lu(k,2145) = lu(k,2145) - lu(k,1714) * lu(k,2132) + lu(k,2146) = lu(k,2146) - lu(k,1715) * lu(k,2132) + lu(k,2147) = lu(k,2147) - lu(k,1716) * lu(k,2132) + lu(k,2152) = lu(k,2152) - lu(k,1717) * lu(k,2132) + lu(k,2176) = lu(k,2176) - lu(k,1713) * lu(k,2168) + lu(k,2187) = lu(k,2187) - lu(k,1714) * lu(k,2168) + lu(k,2188) = lu(k,2188) - lu(k,1715) * lu(k,2168) + lu(k,2189) = lu(k,2189) - lu(k,1716) * lu(k,2168) + lu(k,2195) = lu(k,2195) - lu(k,1717) * lu(k,2168) + lu(k,2885) = lu(k,2885) - lu(k,1713) * lu(k,2869) + lu(k,2918) = lu(k,2918) - lu(k,1714) * lu(k,2869) + lu(k,2919) = lu(k,2919) - lu(k,1715) * lu(k,2869) + lu(k,2920) = lu(k,2920) - lu(k,1716) * lu(k,2869) + lu(k,2927) = lu(k,2927) - lu(k,1717) * lu(k,2869) + lu(k,3074) = lu(k,3074) - lu(k,1713) * lu(k,3057) + lu(k,3108) = lu(k,3108) - lu(k,1714) * lu(k,3057) + lu(k,3109) = lu(k,3109) - lu(k,1715) * lu(k,3057) + lu(k,3110) = lu(k,3110) - lu(k,1716) * lu(k,3057) + lu(k,3119) = lu(k,3119) - lu(k,1717) * lu(k,3057) + lu(k,3333) = lu(k,3333) - lu(k,1713) * lu(k,3316) + lu(k,3367) = lu(k,3367) - lu(k,1714) * lu(k,3316) + lu(k,3368) = lu(k,3368) - lu(k,1715) * lu(k,3316) + lu(k,3369) = lu(k,3369) - lu(k,1716) * lu(k,3316) + lu(k,3378) = lu(k,3378) - lu(k,1717) * lu(k,3316) + lu(k,3427) = lu(k,3427) - lu(k,1713) * lu(k,3410) + lu(k,3460) = lu(k,3460) - lu(k,1714) * lu(k,3410) + lu(k,3461) = lu(k,3461) - lu(k,1715) * lu(k,3410) + lu(k,3462) = lu(k,3462) - lu(k,1716) * lu(k,3410) + lu(k,3471) = lu(k,3471) - lu(k,1717) * lu(k,3410) + lu(k,3570) = lu(k,3570) - lu(k,1713) * lu(k,3555) + lu(k,3604) = lu(k,3604) - lu(k,1714) * lu(k,3555) + lu(k,3605) = lu(k,3605) - lu(k,1715) * lu(k,3555) + lu(k,3606) = lu(k,3606) - lu(k,1716) * lu(k,3555) + lu(k,3615) = lu(k,3615) - lu(k,1717) * lu(k,3555) + lu(k,3726) = lu(k,3726) - lu(k,1713) * lu(k,3709) + lu(k,3758) = lu(k,3758) - lu(k,1714) * lu(k,3709) + lu(k,3759) = lu(k,3759) - lu(k,1715) * lu(k,3709) + lu(k,3760) = lu(k,3760) - lu(k,1716) * lu(k,3709) + lu(k,3769) = lu(k,3769) - lu(k,1717) * lu(k,3709) + lu(k,3832) = lu(k,3832) - lu(k,1713) * lu(k,3831) + lu(k,3840) = lu(k,3840) - lu(k,1714) * lu(k,3831) + lu(k,3841) = lu(k,3841) - lu(k,1715) * lu(k,3831) + lu(k,3842) = lu(k,3842) - lu(k,1716) * lu(k,3831) + lu(k,3851) = lu(k,3851) - lu(k,1717) * lu(k,3831) + lu(k,4057) = lu(k,4057) - lu(k,1713) * lu(k,4040) + lu(k,4090) = lu(k,4090) - lu(k,1714) * lu(k,4040) + lu(k,4091) = lu(k,4091) - lu(k,1715) * lu(k,4040) + lu(k,4092) = lu(k,4092) - lu(k,1716) * lu(k,4040) + lu(k,4101) = lu(k,4101) - lu(k,1717) * lu(k,4040) + lu(k,1718) = 1._r8 / lu(k,1718) + lu(k,1719) = lu(k,1719) * lu(k,1718) + lu(k,1720) = lu(k,1720) * lu(k,1718) + lu(k,1721) = lu(k,1721) * lu(k,1718) + lu(k,1722) = lu(k,1722) * lu(k,1718) + lu(k,1723) = lu(k,1723) * lu(k,1718) + lu(k,1724) = lu(k,1724) * lu(k,1718) + lu(k,1725) = lu(k,1725) * lu(k,1718) + lu(k,2234) = lu(k,2234) - lu(k,1719) * lu(k,2233) + lu(k,2239) = lu(k,2239) - lu(k,1720) * lu(k,2233) + lu(k,2242) = lu(k,2242) - lu(k,1721) * lu(k,2233) + lu(k,2245) = lu(k,2245) - lu(k,1722) * lu(k,2233) + lu(k,2249) = lu(k,2249) - lu(k,1723) * lu(k,2233) + lu(k,2251) = lu(k,2251) - lu(k,1724) * lu(k,2233) + lu(k,2253) = lu(k,2253) - lu(k,1725) * lu(k,2233) + lu(k,2319) = - lu(k,1719) * lu(k,2318) + lu(k,2323) = - lu(k,1720) * lu(k,2318) + lu(k,2324) = - lu(k,1721) * lu(k,2318) + lu(k,2325) = - lu(k,1722) * lu(k,2318) + lu(k,2329) = lu(k,2329) - lu(k,1723) * lu(k,2318) + lu(k,2330) = - lu(k,1724) * lu(k,2318) + lu(k,2332) = lu(k,2332) - lu(k,1725) * lu(k,2318) + lu(k,2376) = lu(k,2376) - lu(k,1719) * lu(k,2375) + lu(k,2383) = lu(k,2383) - lu(k,1720) * lu(k,2375) + lu(k,2386) = lu(k,2386) - lu(k,1721) * lu(k,2375) + lu(k,2389) = lu(k,2389) - lu(k,1722) * lu(k,2375) + lu(k,2393) = lu(k,2393) - lu(k,1723) * lu(k,2375) + lu(k,2395) = lu(k,2395) - lu(k,1724) * lu(k,2375) + lu(k,2397) = lu(k,2397) - lu(k,1725) * lu(k,2375) + lu(k,2437) = lu(k,2437) - lu(k,1719) * lu(k,2436) + lu(k,2444) = lu(k,2444) - lu(k,1720) * lu(k,2436) + lu(k,2447) = lu(k,2447) - lu(k,1721) * lu(k,2436) + lu(k,2450) = lu(k,2450) - lu(k,1722) * lu(k,2436) + lu(k,2454) = lu(k,2454) - lu(k,1723) * lu(k,2436) + lu(k,2456) = lu(k,2456) - lu(k,1724) * lu(k,2436) + lu(k,2458) = lu(k,2458) - lu(k,1725) * lu(k,2436) + lu(k,2534) = lu(k,2534) - lu(k,1719) * lu(k,2533) + lu(k,2538) = lu(k,2538) - lu(k,1720) * lu(k,2533) + lu(k,2541) = lu(k,2541) - lu(k,1721) * lu(k,2533) + lu(k,2544) = lu(k,2544) - lu(k,1722) * lu(k,2533) + lu(k,2548) = lu(k,2548) - lu(k,1723) * lu(k,2533) + lu(k,2550) = lu(k,2550) - lu(k,1724) * lu(k,2533) + lu(k,2552) = lu(k,2552) - lu(k,1725) * lu(k,2533) + lu(k,2627) = lu(k,2627) - lu(k,1719) * lu(k,2626) + lu(k,2631) = - lu(k,1720) * lu(k,2626) + lu(k,2633) = lu(k,2633) - lu(k,1721) * lu(k,2626) + lu(k,2635) = - lu(k,1722) * lu(k,2626) + lu(k,2640) = lu(k,2640) - lu(k,1723) * lu(k,2626) + lu(k,2641) = lu(k,2641) - lu(k,1724) * lu(k,2626) + lu(k,2645) = lu(k,2645) - lu(k,1725) * lu(k,2626) + lu(k,2674) = lu(k,2674) - lu(k,1719) * lu(k,2673) + lu(k,2677) = lu(k,2677) - lu(k,1720) * lu(k,2673) + lu(k,2680) = lu(k,2680) - lu(k,1721) * lu(k,2673) + lu(k,2683) = - lu(k,1722) * lu(k,2673) + lu(k,2687) = lu(k,2687) - lu(k,1723) * lu(k,2673) + lu(k,2689) = lu(k,2689) - lu(k,1724) * lu(k,2673) + lu(k,2691) = lu(k,2691) - lu(k,1725) * lu(k,2673) + lu(k,2725) = lu(k,2725) - lu(k,1719) * lu(k,2724) + lu(k,2743) = lu(k,2743) - lu(k,1720) * lu(k,2724) + lu(k,2746) = lu(k,2746) - lu(k,1721) * lu(k,2724) + lu(k,2749) = lu(k,2749) - lu(k,1722) * lu(k,2724) + lu(k,2754) = lu(k,2754) - lu(k,1723) * lu(k,2724) + lu(k,2756) = lu(k,2756) - lu(k,1724) * lu(k,2724) + lu(k,2760) = lu(k,2760) - lu(k,1725) * lu(k,2724) + lu(k,2771) = lu(k,2771) - lu(k,1719) * lu(k,2770) + lu(k,2789) = lu(k,2789) - lu(k,1720) * lu(k,2770) + lu(k,2792) = lu(k,2792) - lu(k,1721) * lu(k,2770) + lu(k,2795) = lu(k,2795) - lu(k,1722) * lu(k,2770) + lu(k,2800) = lu(k,2800) - lu(k,1723) * lu(k,2770) + lu(k,2802) = lu(k,2802) - lu(k,1724) * lu(k,2770) + lu(k,2806) = lu(k,2806) - lu(k,1725) * lu(k,2770) + lu(k,2818) = lu(k,2818) - lu(k,1719) * lu(k,2817) + lu(k,2836) = lu(k,2836) - lu(k,1720) * lu(k,2817) + lu(k,2839) = lu(k,2839) - lu(k,1721) * lu(k,2817) + lu(k,2842) = lu(k,2842) - lu(k,1722) * lu(k,2817) + lu(k,2847) = lu(k,2847) - lu(k,1723) * lu(k,2817) + lu(k,2849) = lu(k,2849) - lu(k,1724) * lu(k,2817) + lu(k,2853) = lu(k,2853) - lu(k,1725) * lu(k,2817) + lu(k,2885) = lu(k,2885) - lu(k,1719) * lu(k,2870) + lu(k,2908) = lu(k,2908) - lu(k,1720) * lu(k,2870) + lu(k,2911) = lu(k,2911) - lu(k,1721) * lu(k,2870) + lu(k,2915) = lu(k,2915) - lu(k,1722) * lu(k,2870) + lu(k,2920) = lu(k,2920) - lu(k,1723) * lu(k,2870) + lu(k,2922) = lu(k,2922) - lu(k,1724) * lu(k,2870) + lu(k,2927) = lu(k,2927) - lu(k,1725) * lu(k,2870) + lu(k,3074) = lu(k,3074) - lu(k,1719) * lu(k,3058) + lu(k,3098) = lu(k,3098) - lu(k,1720) * lu(k,3058) + lu(k,3101) = lu(k,3101) - lu(k,1721) * lu(k,3058) + lu(k,3105) = lu(k,3105) - lu(k,1722) * lu(k,3058) + lu(k,3110) = lu(k,3110) - lu(k,1723) * lu(k,3058) + lu(k,3114) = lu(k,3114) - lu(k,1724) * lu(k,3058) + lu(k,3119) = lu(k,3119) - lu(k,1725) * lu(k,3058) + lu(k,3333) = lu(k,3333) - lu(k,1719) * lu(k,3317) + lu(k,3357) = lu(k,3357) - lu(k,1720) * lu(k,3317) + lu(k,3360) = lu(k,3360) - lu(k,1721) * lu(k,3317) + lu(k,3364) = lu(k,3364) - lu(k,1722) * lu(k,3317) + lu(k,3369) = lu(k,3369) - lu(k,1723) * lu(k,3317) + lu(k,3373) = lu(k,3373) - lu(k,1724) * lu(k,3317) + lu(k,3378) = lu(k,3378) - lu(k,1725) * lu(k,3317) + lu(k,3427) = lu(k,3427) - lu(k,1719) * lu(k,3411) + lu(k,3450) = lu(k,3450) - lu(k,1720) * lu(k,3411) + lu(k,3453) = lu(k,3453) - lu(k,1721) * lu(k,3411) + lu(k,3457) = lu(k,3457) - lu(k,1722) * lu(k,3411) + lu(k,3462) = lu(k,3462) - lu(k,1723) * lu(k,3411) + lu(k,3466) = lu(k,3466) - lu(k,1724) * lu(k,3411) + lu(k,3471) = lu(k,3471) - lu(k,1725) * lu(k,3411) + lu(k,3570) = lu(k,3570) - lu(k,1719) * lu(k,3556) + lu(k,3594) = lu(k,3594) - lu(k,1720) * lu(k,3556) + lu(k,3597) = lu(k,3597) - lu(k,1721) * lu(k,3556) + lu(k,3601) = lu(k,3601) - lu(k,1722) * lu(k,3556) + lu(k,3606) = lu(k,3606) - lu(k,1723) * lu(k,3556) + lu(k,3610) = lu(k,3610) - lu(k,1724) * lu(k,3556) + lu(k,3615) = lu(k,3615) - lu(k,1725) * lu(k,3556) + lu(k,3726) = lu(k,3726) - lu(k,1719) * lu(k,3710) + lu(k,3748) = - lu(k,1720) * lu(k,3710) + lu(k,3751) = lu(k,3751) - lu(k,1721) * lu(k,3710) + lu(k,3755) = lu(k,3755) - lu(k,1722) * lu(k,3710) + lu(k,3760) = lu(k,3760) - lu(k,1723) * lu(k,3710) + lu(k,3764) = lu(k,3764) - lu(k,1724) * lu(k,3710) + lu(k,3769) = lu(k,3769) - lu(k,1725) * lu(k,3710) + lu(k,4057) = lu(k,4057) - lu(k,1719) * lu(k,4041) + lu(k,4080) = lu(k,4080) - lu(k,1720) * lu(k,4041) + lu(k,4083) = lu(k,4083) - lu(k,1721) * lu(k,4041) + lu(k,4087) = lu(k,4087) - lu(k,1722) * lu(k,4041) + lu(k,4092) = lu(k,4092) - lu(k,1723) * lu(k,4041) + lu(k,4096) = lu(k,4096) - lu(k,1724) * lu(k,4041) + lu(k,4101) = lu(k,4101) - lu(k,1725) * lu(k,4041) + lu(k,1732) = 1._r8 / lu(k,1732) + lu(k,1733) = lu(k,1733) * lu(k,1732) + lu(k,1734) = lu(k,1734) * lu(k,1732) + lu(k,1735) = lu(k,1735) * lu(k,1732) + lu(k,1736) = lu(k,1736) * lu(k,1732) + lu(k,1737) = lu(k,1737) * lu(k,1732) + lu(k,1738) = lu(k,1738) * lu(k,1732) + lu(k,1739) = lu(k,1739) * lu(k,1732) + lu(k,1740) = lu(k,1740) * lu(k,1732) + lu(k,1741) = lu(k,1741) * lu(k,1732) + lu(k,1742) = lu(k,1742) * lu(k,1732) + lu(k,1743) = lu(k,1743) * lu(k,1732) + lu(k,1744) = lu(k,1744) * lu(k,1732) + lu(k,1745) = lu(k,1745) * lu(k,1732) + lu(k,1746) = lu(k,1746) * lu(k,1732) + lu(k,1747) = lu(k,1747) * lu(k,1732) + lu(k,1945) = lu(k,1945) - lu(k,1733) * lu(k,1944) + lu(k,1949) = - lu(k,1734) * lu(k,1944) + lu(k,1950) = lu(k,1950) - lu(k,1735) * lu(k,1944) + lu(k,1952) = lu(k,1952) - lu(k,1736) * lu(k,1944) + lu(k,1953) = lu(k,1953) - lu(k,1737) * lu(k,1944) + lu(k,1957) = lu(k,1957) - lu(k,1738) * lu(k,1944) + lu(k,1958) = - lu(k,1739) * lu(k,1944) + lu(k,1959) = lu(k,1959) - lu(k,1740) * lu(k,1944) + lu(k,1961) = lu(k,1961) - lu(k,1741) * lu(k,1944) + lu(k,1962) = lu(k,1962) - lu(k,1742) * lu(k,1944) + lu(k,1963) = lu(k,1963) - lu(k,1743) * lu(k,1944) + lu(k,1964) = lu(k,1964) - lu(k,1744) * lu(k,1944) + lu(k,1965) = lu(k,1965) - lu(k,1745) * lu(k,1944) + lu(k,1967) = lu(k,1967) - lu(k,1746) * lu(k,1944) + lu(k,1968) = lu(k,1968) - lu(k,1747) * lu(k,1944) + lu(k,2873) = lu(k,2873) - lu(k,1733) * lu(k,2871) + lu(k,2877) = lu(k,2877) - lu(k,1734) * lu(k,2871) + lu(k,2878) = - lu(k,1735) * lu(k,2871) + lu(k,2880) = lu(k,2880) - lu(k,1736) * lu(k,2871) + lu(k,2881) = lu(k,2881) - lu(k,1737) * lu(k,2871) + lu(k,2885) = lu(k,2885) - lu(k,1738) * lu(k,2871) + lu(k,2887) = - lu(k,1739) * lu(k,2871) + lu(k,2913) = lu(k,2913) - lu(k,1740) * lu(k,2871) + lu(k,2916) = lu(k,2916) - lu(k,1741) * lu(k,2871) + lu(k,2918) = lu(k,2918) - lu(k,1742) * lu(k,2871) + lu(k,2919) = lu(k,2919) - lu(k,1743) * lu(k,2871) + lu(k,2920) = lu(k,2920) - lu(k,1744) * lu(k,2871) + lu(k,2921) = lu(k,2921) - lu(k,1745) * lu(k,2871) + lu(k,2923) = lu(k,2923) - lu(k,1746) * lu(k,2871) + lu(k,2927) = lu(k,2927) - lu(k,1747) * lu(k,2871) + lu(k,3061) = lu(k,3061) - lu(k,1733) * lu(k,3059) + lu(k,3066) = lu(k,3066) - lu(k,1734) * lu(k,3059) + lu(k,3067) = - lu(k,1735) * lu(k,3059) + lu(k,3069) = lu(k,3069) - lu(k,1736) * lu(k,3059) + lu(k,3070) = lu(k,3070) - lu(k,1737) * lu(k,3059) + lu(k,3074) = lu(k,3074) - lu(k,1738) * lu(k,3059) + lu(k,3076) = lu(k,3076) - lu(k,1739) * lu(k,3059) + lu(k,3103) = lu(k,3103) - lu(k,1740) * lu(k,3059) + lu(k,3106) = lu(k,3106) - lu(k,1741) * lu(k,3059) + lu(k,3108) = lu(k,3108) - lu(k,1742) * lu(k,3059) + lu(k,3109) = lu(k,3109) - lu(k,1743) * lu(k,3059) + lu(k,3110) = lu(k,3110) - lu(k,1744) * lu(k,3059) + lu(k,3111) = lu(k,3111) - lu(k,1745) * lu(k,3059) + lu(k,3115) = lu(k,3115) - lu(k,1746) * lu(k,3059) + lu(k,3119) = lu(k,3119) - lu(k,1747) * lu(k,3059) + lu(k,3320) = lu(k,3320) - lu(k,1733) * lu(k,3318) + lu(k,3325) = - lu(k,1734) * lu(k,3318) + lu(k,3326) = lu(k,3326) - lu(k,1735) * lu(k,3318) + lu(k,3328) = lu(k,3328) - lu(k,1736) * lu(k,3318) + lu(k,3329) = lu(k,3329) - lu(k,1737) * lu(k,3318) + lu(k,3333) = lu(k,3333) - lu(k,1738) * lu(k,3318) + lu(k,3335) = - lu(k,1739) * lu(k,3318) + lu(k,3362) = lu(k,3362) - lu(k,1740) * lu(k,3318) + lu(k,3365) = lu(k,3365) - lu(k,1741) * lu(k,3318) + lu(k,3367) = lu(k,3367) - lu(k,1742) * lu(k,3318) + lu(k,3368) = lu(k,3368) - lu(k,1743) * lu(k,3318) + lu(k,3369) = lu(k,3369) - lu(k,1744) * lu(k,3318) + lu(k,3370) = lu(k,3370) - lu(k,1745) * lu(k,3318) + lu(k,3374) = lu(k,3374) - lu(k,1746) * lu(k,3318) + lu(k,3378) = lu(k,3378) - lu(k,1747) * lu(k,3318) + lu(k,3414) = lu(k,3414) - lu(k,1733) * lu(k,3412) + lu(k,3419) = lu(k,3419) - lu(k,1734) * lu(k,3412) + lu(k,3420) = - lu(k,1735) * lu(k,3412) + lu(k,3422) = lu(k,3422) - lu(k,1736) * lu(k,3412) + lu(k,3423) = lu(k,3423) - lu(k,1737) * lu(k,3412) + lu(k,3427) = lu(k,3427) - lu(k,1738) * lu(k,3412) + lu(k,3429) = lu(k,3429) - lu(k,1739) * lu(k,3412) + lu(k,3455) = lu(k,3455) - lu(k,1740) * lu(k,3412) + lu(k,3458) = lu(k,3458) - lu(k,1741) * lu(k,3412) + lu(k,3460) = lu(k,3460) - lu(k,1742) * lu(k,3412) + lu(k,3461) = lu(k,3461) - lu(k,1743) * lu(k,3412) + lu(k,3462) = lu(k,3462) - lu(k,1744) * lu(k,3412) + lu(k,3463) = lu(k,3463) - lu(k,1745) * lu(k,3412) + lu(k,3467) = lu(k,3467) - lu(k,1746) * lu(k,3412) + lu(k,3471) = lu(k,3471) - lu(k,1747) * lu(k,3412) + lu(k,3559) = lu(k,3559) - lu(k,1733) * lu(k,3557) + lu(k,3562) = - lu(k,1734) * lu(k,3557) + lu(k,3563) = - lu(k,1735) * lu(k,3557) + lu(k,3565) = lu(k,3565) - lu(k,1736) * lu(k,3557) + lu(k,3566) = lu(k,3566) - lu(k,1737) * lu(k,3557) + lu(k,3570) = lu(k,3570) - lu(k,1738) * lu(k,3557) + lu(k,3572) = - lu(k,1739) * lu(k,3557) + lu(k,3599) = lu(k,3599) - lu(k,1740) * lu(k,3557) + lu(k,3602) = lu(k,3602) - lu(k,1741) * lu(k,3557) + lu(k,3604) = lu(k,3604) - lu(k,1742) * lu(k,3557) + lu(k,3605) = lu(k,3605) - lu(k,1743) * lu(k,3557) + lu(k,3606) = lu(k,3606) - lu(k,1744) * lu(k,3557) + lu(k,3607) = lu(k,3607) - lu(k,1745) * lu(k,3557) + lu(k,3611) = lu(k,3611) - lu(k,1746) * lu(k,3557) + lu(k,3615) = lu(k,3615) - lu(k,1747) * lu(k,3557) + lu(k,3713) = lu(k,3713) - lu(k,1733) * lu(k,3711) + lu(k,3718) = - lu(k,1734) * lu(k,3711) + lu(k,3719) = - lu(k,1735) * lu(k,3711) + lu(k,3721) = lu(k,3721) - lu(k,1736) * lu(k,3711) + lu(k,3722) = lu(k,3722) - lu(k,1737) * lu(k,3711) + lu(k,3726) = lu(k,3726) - lu(k,1738) * lu(k,3711) + lu(k,3728) = lu(k,3728) - lu(k,1739) * lu(k,3711) + lu(k,3753) = lu(k,3753) - lu(k,1740) * lu(k,3711) + lu(k,3756) = lu(k,3756) - lu(k,1741) * lu(k,3711) + lu(k,3758) = lu(k,3758) - lu(k,1742) * lu(k,3711) + lu(k,3759) = lu(k,3759) - lu(k,1743) * lu(k,3711) + lu(k,3760) = lu(k,3760) - lu(k,1744) * lu(k,3711) + lu(k,3761) = lu(k,3761) - lu(k,1745) * lu(k,3711) + lu(k,3765) = lu(k,3765) - lu(k,1746) * lu(k,3711) + lu(k,3769) = lu(k,3769) - lu(k,1747) * lu(k,3711) + lu(k,4044) = lu(k,4044) - lu(k,1733) * lu(k,4042) + lu(k,4049) = lu(k,4049) - lu(k,1734) * lu(k,4042) + lu(k,4050) = lu(k,4050) - lu(k,1735) * lu(k,4042) + lu(k,4052) = lu(k,4052) - lu(k,1736) * lu(k,4042) + lu(k,4053) = lu(k,4053) - lu(k,1737) * lu(k,4042) + lu(k,4057) = lu(k,4057) - lu(k,1738) * lu(k,4042) + lu(k,4059) = lu(k,4059) - lu(k,1739) * lu(k,4042) + lu(k,4085) = lu(k,4085) - lu(k,1740) * lu(k,4042) + lu(k,4088) = lu(k,4088) - lu(k,1741) * lu(k,4042) + lu(k,4090) = lu(k,4090) - lu(k,1742) * lu(k,4042) + lu(k,4091) = lu(k,4091) - lu(k,1743) * lu(k,4042) + lu(k,4092) = lu(k,4092) - lu(k,1744) * lu(k,4042) + lu(k,4093) = lu(k,4093) - lu(k,1745) * lu(k,4042) + lu(k,4097) = lu(k,4097) - lu(k,1746) * lu(k,4042) + lu(k,4101) = lu(k,4101) - lu(k,1747) * lu(k,4042) + end do + end subroutine lu_fac39 + subroutine lu_fac40( 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,1754) = 1._r8 / lu(k,1754) + lu(k,1755) = lu(k,1755) * lu(k,1754) + lu(k,1756) = lu(k,1756) * lu(k,1754) + lu(k,1757) = lu(k,1757) * lu(k,1754) + lu(k,1758) = lu(k,1758) * lu(k,1754) + lu(k,1759) = lu(k,1759) * lu(k,1754) + lu(k,1760) = lu(k,1760) * lu(k,1754) + lu(k,1761) = lu(k,1761) * lu(k,1754) + lu(k,1762) = lu(k,1762) * lu(k,1754) + lu(k,1763) = lu(k,1763) * lu(k,1754) + lu(k,1764) = lu(k,1764) * lu(k,1754) + lu(k,1765) = lu(k,1765) * lu(k,1754) + lu(k,1766) = lu(k,1766) * lu(k,1754) + lu(k,1767) = lu(k,1767) * lu(k,1754) + lu(k,1768) = lu(k,1768) * lu(k,1754) + lu(k,1769) = lu(k,1769) * lu(k,1754) + lu(k,1982) = lu(k,1982) - lu(k,1755) * lu(k,1981) + lu(k,1986) = lu(k,1986) - lu(k,1756) * lu(k,1981) + lu(k,1987) = lu(k,1987) - lu(k,1757) * lu(k,1981) + lu(k,1989) = lu(k,1989) - lu(k,1758) * lu(k,1981) + lu(k,1991) = lu(k,1991) - lu(k,1759) * lu(k,1981) + lu(k,1994) = lu(k,1994) - lu(k,1760) * lu(k,1981) + lu(k,1995) = - lu(k,1761) * lu(k,1981) + lu(k,1998) = lu(k,1998) - lu(k,1762) * lu(k,1981) + lu(k,2000) = lu(k,2000) - lu(k,1763) * lu(k,1981) + lu(k,2001) = lu(k,2001) - lu(k,1764) * lu(k,1981) + lu(k,2002) = lu(k,2002) - lu(k,1765) * lu(k,1981) + lu(k,2003) = lu(k,2003) - lu(k,1766) * lu(k,1981) + lu(k,2004) = lu(k,2004) - lu(k,1767) * lu(k,1981) + lu(k,2006) = lu(k,2006) - lu(k,1768) * lu(k,1981) + lu(k,2007) = lu(k,2007) - lu(k,1769) * lu(k,1981) + lu(k,2873) = lu(k,2873) - lu(k,1755) * lu(k,2872) + lu(k,2877) = lu(k,2877) - lu(k,1756) * lu(k,2872) + lu(k,2878) = lu(k,2878) - lu(k,1757) * lu(k,2872) + lu(k,2880) = lu(k,2880) - lu(k,1758) * lu(k,2872) + lu(k,2882) = lu(k,2882) - lu(k,1759) * lu(k,2872) + lu(k,2885) = lu(k,2885) - lu(k,1760) * lu(k,2872) + lu(k,2886) = - lu(k,1761) * lu(k,2872) + lu(k,2913) = lu(k,2913) - lu(k,1762) * lu(k,2872) + lu(k,2916) = lu(k,2916) - lu(k,1763) * lu(k,2872) + lu(k,2918) = lu(k,2918) - lu(k,1764) * lu(k,2872) + lu(k,2919) = lu(k,2919) - lu(k,1765) * lu(k,2872) + lu(k,2920) = lu(k,2920) - lu(k,1766) * lu(k,2872) + lu(k,2921) = lu(k,2921) - lu(k,1767) * lu(k,2872) + lu(k,2923) = lu(k,2923) - lu(k,1768) * lu(k,2872) + lu(k,2927) = lu(k,2927) - lu(k,1769) * lu(k,2872) + lu(k,3061) = lu(k,3061) - lu(k,1755) * lu(k,3060) + lu(k,3066) = lu(k,3066) - lu(k,1756) * lu(k,3060) + lu(k,3067) = lu(k,3067) - lu(k,1757) * lu(k,3060) + lu(k,3069) = lu(k,3069) - lu(k,1758) * lu(k,3060) + lu(k,3071) = lu(k,3071) - lu(k,1759) * lu(k,3060) + lu(k,3074) = lu(k,3074) - lu(k,1760) * lu(k,3060) + lu(k,3075) = lu(k,3075) - lu(k,1761) * lu(k,3060) + lu(k,3103) = lu(k,3103) - lu(k,1762) * lu(k,3060) + lu(k,3106) = lu(k,3106) - lu(k,1763) * lu(k,3060) + lu(k,3108) = lu(k,3108) - lu(k,1764) * lu(k,3060) + lu(k,3109) = lu(k,3109) - lu(k,1765) * lu(k,3060) + lu(k,3110) = lu(k,3110) - lu(k,1766) * lu(k,3060) + lu(k,3111) = lu(k,3111) - lu(k,1767) * lu(k,3060) + lu(k,3115) = lu(k,3115) - lu(k,1768) * lu(k,3060) + lu(k,3119) = lu(k,3119) - lu(k,1769) * lu(k,3060) + lu(k,3320) = lu(k,3320) - lu(k,1755) * lu(k,3319) + lu(k,3325) = lu(k,3325) - lu(k,1756) * lu(k,3319) + lu(k,3326) = lu(k,3326) - lu(k,1757) * lu(k,3319) + lu(k,3328) = lu(k,3328) - lu(k,1758) * lu(k,3319) + lu(k,3330) = lu(k,3330) - lu(k,1759) * lu(k,3319) + lu(k,3333) = lu(k,3333) - lu(k,1760) * lu(k,3319) + lu(k,3334) = - lu(k,1761) * lu(k,3319) + lu(k,3362) = lu(k,3362) - lu(k,1762) * lu(k,3319) + lu(k,3365) = lu(k,3365) - lu(k,1763) * lu(k,3319) + lu(k,3367) = lu(k,3367) - lu(k,1764) * lu(k,3319) + lu(k,3368) = lu(k,3368) - lu(k,1765) * lu(k,3319) + lu(k,3369) = lu(k,3369) - lu(k,1766) * lu(k,3319) + lu(k,3370) = lu(k,3370) - lu(k,1767) * lu(k,3319) + lu(k,3374) = lu(k,3374) - lu(k,1768) * lu(k,3319) + lu(k,3378) = lu(k,3378) - lu(k,1769) * lu(k,3319) + lu(k,3414) = lu(k,3414) - lu(k,1755) * lu(k,3413) + lu(k,3419) = lu(k,3419) - lu(k,1756) * lu(k,3413) + lu(k,3420) = lu(k,3420) - lu(k,1757) * lu(k,3413) + lu(k,3422) = lu(k,3422) - lu(k,1758) * lu(k,3413) + lu(k,3424) = lu(k,3424) - lu(k,1759) * lu(k,3413) + lu(k,3427) = lu(k,3427) - lu(k,1760) * lu(k,3413) + lu(k,3428) = lu(k,3428) - lu(k,1761) * lu(k,3413) + lu(k,3455) = lu(k,3455) - lu(k,1762) * lu(k,3413) + lu(k,3458) = lu(k,3458) - lu(k,1763) * lu(k,3413) + lu(k,3460) = lu(k,3460) - lu(k,1764) * lu(k,3413) + lu(k,3461) = lu(k,3461) - lu(k,1765) * lu(k,3413) + lu(k,3462) = lu(k,3462) - lu(k,1766) * lu(k,3413) + lu(k,3463) = lu(k,3463) - lu(k,1767) * lu(k,3413) + lu(k,3467) = lu(k,3467) - lu(k,1768) * lu(k,3413) + lu(k,3471) = lu(k,3471) - lu(k,1769) * lu(k,3413) + lu(k,3559) = lu(k,3559) - lu(k,1755) * lu(k,3558) + lu(k,3562) = lu(k,3562) - lu(k,1756) * lu(k,3558) + lu(k,3563) = lu(k,3563) - lu(k,1757) * lu(k,3558) + lu(k,3565) = lu(k,3565) - lu(k,1758) * lu(k,3558) + lu(k,3567) = lu(k,3567) - lu(k,1759) * lu(k,3558) + lu(k,3570) = lu(k,3570) - lu(k,1760) * lu(k,3558) + lu(k,3571) = - lu(k,1761) * lu(k,3558) + lu(k,3599) = lu(k,3599) - lu(k,1762) * lu(k,3558) + lu(k,3602) = lu(k,3602) - lu(k,1763) * lu(k,3558) + lu(k,3604) = lu(k,3604) - lu(k,1764) * lu(k,3558) + lu(k,3605) = lu(k,3605) - lu(k,1765) * lu(k,3558) + lu(k,3606) = lu(k,3606) - lu(k,1766) * lu(k,3558) + lu(k,3607) = lu(k,3607) - lu(k,1767) * lu(k,3558) + lu(k,3611) = lu(k,3611) - lu(k,1768) * lu(k,3558) + lu(k,3615) = lu(k,3615) - lu(k,1769) * lu(k,3558) + lu(k,3713) = lu(k,3713) - lu(k,1755) * lu(k,3712) + lu(k,3718) = lu(k,3718) - lu(k,1756) * lu(k,3712) + lu(k,3719) = lu(k,3719) - lu(k,1757) * lu(k,3712) + lu(k,3721) = lu(k,3721) - lu(k,1758) * lu(k,3712) + lu(k,3723) = lu(k,3723) - lu(k,1759) * lu(k,3712) + lu(k,3726) = lu(k,3726) - lu(k,1760) * lu(k,3712) + lu(k,3727) = lu(k,3727) - lu(k,1761) * lu(k,3712) + lu(k,3753) = lu(k,3753) - lu(k,1762) * lu(k,3712) + lu(k,3756) = lu(k,3756) - lu(k,1763) * lu(k,3712) + lu(k,3758) = lu(k,3758) - lu(k,1764) * lu(k,3712) + lu(k,3759) = lu(k,3759) - lu(k,1765) * lu(k,3712) + lu(k,3760) = lu(k,3760) - lu(k,1766) * lu(k,3712) + lu(k,3761) = lu(k,3761) - lu(k,1767) * lu(k,3712) + lu(k,3765) = lu(k,3765) - lu(k,1768) * lu(k,3712) + lu(k,3769) = lu(k,3769) - lu(k,1769) * lu(k,3712) + lu(k,4044) = lu(k,4044) - lu(k,1755) * lu(k,4043) + lu(k,4049) = lu(k,4049) - lu(k,1756) * lu(k,4043) + lu(k,4050) = lu(k,4050) - lu(k,1757) * lu(k,4043) + lu(k,4052) = lu(k,4052) - lu(k,1758) * lu(k,4043) + lu(k,4054) = lu(k,4054) - lu(k,1759) * lu(k,4043) + lu(k,4057) = lu(k,4057) - lu(k,1760) * lu(k,4043) + lu(k,4058) = lu(k,4058) - lu(k,1761) * lu(k,4043) + lu(k,4085) = lu(k,4085) - lu(k,1762) * lu(k,4043) + lu(k,4088) = lu(k,4088) - lu(k,1763) * lu(k,4043) + lu(k,4090) = lu(k,4090) - lu(k,1764) * lu(k,4043) + lu(k,4091) = lu(k,4091) - lu(k,1765) * lu(k,4043) + lu(k,4092) = lu(k,4092) - lu(k,1766) * lu(k,4043) + lu(k,4093) = lu(k,4093) - lu(k,1767) * lu(k,4043) + lu(k,4097) = lu(k,4097) - lu(k,1768) * lu(k,4043) + lu(k,4101) = lu(k,4101) - lu(k,1769) * lu(k,4043) + lu(k,1770) = 1._r8 / lu(k,1770) + lu(k,1771) = lu(k,1771) * lu(k,1770) + lu(k,1772) = lu(k,1772) * lu(k,1770) + lu(k,1773) = lu(k,1773) * lu(k,1770) + lu(k,1774) = lu(k,1774) * lu(k,1770) + lu(k,1775) = lu(k,1775) * lu(k,1770) + lu(k,1779) = lu(k,1779) - lu(k,1771) * lu(k,1777) + lu(k,1781) = lu(k,1781) - lu(k,1772) * lu(k,1777) + lu(k,1782) = lu(k,1782) - lu(k,1773) * lu(k,1777) + lu(k,1783) = lu(k,1783) - lu(k,1774) * lu(k,1777) + lu(k,1785) = lu(k,1785) - lu(k,1775) * lu(k,1777) + lu(k,1795) = lu(k,1795) - lu(k,1771) * lu(k,1791) + lu(k,1797) = lu(k,1797) - lu(k,1772) * lu(k,1791) + lu(k,1799) = lu(k,1799) - lu(k,1773) * lu(k,1791) + lu(k,1800) = lu(k,1800) - lu(k,1774) * lu(k,1791) + lu(k,1802) = lu(k,1802) - lu(k,1775) * lu(k,1791) + lu(k,1820) = lu(k,1820) - lu(k,1771) * lu(k,1815) + lu(k,1826) = lu(k,1826) - lu(k,1772) * lu(k,1815) + lu(k,1829) = lu(k,1829) - lu(k,1773) * lu(k,1815) + lu(k,1830) = lu(k,1830) - lu(k,1774) * lu(k,1815) + lu(k,1833) = lu(k,1833) - lu(k,1775) * lu(k,1815) + lu(k,1852) = lu(k,1852) - lu(k,1771) * lu(k,1847) + lu(k,1857) = lu(k,1857) - lu(k,1772) * lu(k,1847) + lu(k,1860) = lu(k,1860) - lu(k,1773) * lu(k,1847) + lu(k,1861) = lu(k,1861) - lu(k,1774) * lu(k,1847) + lu(k,1864) = lu(k,1864) - lu(k,1775) * lu(k,1847) + lu(k,1874) = lu(k,1874) - lu(k,1771) * lu(k,1870) + lu(k,1876) = lu(k,1876) - lu(k,1772) * lu(k,1870) + lu(k,1879) = lu(k,1879) - lu(k,1773) * lu(k,1870) + lu(k,1880) = lu(k,1880) - lu(k,1774) * lu(k,1870) + lu(k,1882) = lu(k,1882) - lu(k,1775) * lu(k,1870) + lu(k,1898) = lu(k,1898) - lu(k,1771) * lu(k,1893) + lu(k,1904) = lu(k,1904) - lu(k,1772) * lu(k,1893) + lu(k,1907) = lu(k,1907) - lu(k,1773) * lu(k,1893) + lu(k,1908) = lu(k,1908) - lu(k,1774) * lu(k,1893) + lu(k,1910) = lu(k,1910) - lu(k,1775) * lu(k,1893) + lu(k,1952) = lu(k,1952) - lu(k,1771) * lu(k,1945) + lu(k,1959) = lu(k,1959) - lu(k,1772) * lu(k,1945) + lu(k,1963) = lu(k,1963) - lu(k,1773) * lu(k,1945) + lu(k,1964) = lu(k,1964) - lu(k,1774) * lu(k,1945) + lu(k,1968) = lu(k,1968) - lu(k,1775) * lu(k,1945) + lu(k,1989) = lu(k,1989) - lu(k,1771) * lu(k,1982) + lu(k,1998) = lu(k,1998) - lu(k,1772) * lu(k,1982) + lu(k,2002) = lu(k,2002) - lu(k,1773) * lu(k,1982) + lu(k,2003) = lu(k,2003) - lu(k,1774) * lu(k,1982) + lu(k,2007) = lu(k,2007) - lu(k,1775) * lu(k,1982) + lu(k,2015) = lu(k,2015) - lu(k,1771) * lu(k,2013) + lu(k,2019) = lu(k,2019) - lu(k,1772) * lu(k,2013) + lu(k,2023) = lu(k,2023) - lu(k,1773) * lu(k,2013) + lu(k,2024) = lu(k,2024) - lu(k,1774) * lu(k,2013) + lu(k,2029) = lu(k,2029) - lu(k,1775) * lu(k,2013) + lu(k,2040) = lu(k,2040) - lu(k,1771) * lu(k,2038) + lu(k,2044) = lu(k,2044) - lu(k,1772) * lu(k,2038) + lu(k,2048) = lu(k,2048) - lu(k,1773) * lu(k,2038) + lu(k,2049) = lu(k,2049) - lu(k,1774) * lu(k,2038) + lu(k,2054) = lu(k,2054) - lu(k,1775) * lu(k,2038) + lu(k,2076) = lu(k,2076) - lu(k,1771) * lu(k,2071) + lu(k,2080) = lu(k,2080) - lu(k,1772) * lu(k,2071) + lu(k,2085) = lu(k,2085) - lu(k,1773) * lu(k,2071) + lu(k,2086) = lu(k,2086) - lu(k,1774) * lu(k,2071) + lu(k,2091) = lu(k,2091) - lu(k,1775) * lu(k,2071) + lu(k,2108) = lu(k,2108) - lu(k,1771) * lu(k,2103) + lu(k,2112) = lu(k,2112) - lu(k,1772) * lu(k,2103) + lu(k,2117) = lu(k,2117) - lu(k,1773) * lu(k,2103) + lu(k,2118) = lu(k,2118) - lu(k,1774) * lu(k,2103) + lu(k,2123) = lu(k,2123) - lu(k,1775) * lu(k,2103) + lu(k,2138) = lu(k,2138) - lu(k,1771) * lu(k,2133) + lu(k,2141) = lu(k,2141) - lu(k,1772) * lu(k,2133) + lu(k,2146) = lu(k,2146) - lu(k,1773) * lu(k,2133) + lu(k,2147) = lu(k,2147) - lu(k,1774) * lu(k,2133) + lu(k,2152) = lu(k,2152) - lu(k,1775) * lu(k,2133) + lu(k,2173) = lu(k,2173) - lu(k,1771) * lu(k,2169) + lu(k,2183) = lu(k,2183) - lu(k,1772) * lu(k,2169) + lu(k,2188) = lu(k,2188) - lu(k,1773) * lu(k,2169) + lu(k,2189) = lu(k,2189) - lu(k,1774) * lu(k,2169) + lu(k,2195) = lu(k,2195) - lu(k,1775) * lu(k,2169) + lu(k,2275) = lu(k,2275) - lu(k,1771) * lu(k,2274) + lu(k,2278) = lu(k,2278) - lu(k,1772) * lu(k,2274) + lu(k,2282) = lu(k,2282) - lu(k,1773) * lu(k,2274) + lu(k,2283) = lu(k,2283) - lu(k,1774) * lu(k,2274) + lu(k,2287) = lu(k,2287) - lu(k,1775) * lu(k,2274) + lu(k,2880) = lu(k,2880) - lu(k,1771) * lu(k,2873) + lu(k,2913) = lu(k,2913) - lu(k,1772) * lu(k,2873) + lu(k,2919) = lu(k,2919) - lu(k,1773) * lu(k,2873) + lu(k,2920) = lu(k,2920) - lu(k,1774) * lu(k,2873) + lu(k,2927) = lu(k,2927) - lu(k,1775) * lu(k,2873) + lu(k,3069) = lu(k,3069) - lu(k,1771) * lu(k,3061) + lu(k,3103) = lu(k,3103) - lu(k,1772) * lu(k,3061) + lu(k,3109) = lu(k,3109) - lu(k,1773) * lu(k,3061) + lu(k,3110) = lu(k,3110) - lu(k,1774) * lu(k,3061) + lu(k,3119) = lu(k,3119) - lu(k,1775) * lu(k,3061) + lu(k,3328) = lu(k,3328) - lu(k,1771) * lu(k,3320) + lu(k,3362) = lu(k,3362) - lu(k,1772) * lu(k,3320) + lu(k,3368) = lu(k,3368) - lu(k,1773) * lu(k,3320) + lu(k,3369) = lu(k,3369) - lu(k,1774) * lu(k,3320) + lu(k,3378) = lu(k,3378) - lu(k,1775) * lu(k,3320) + lu(k,3422) = lu(k,3422) - lu(k,1771) * lu(k,3414) + lu(k,3455) = lu(k,3455) - lu(k,1772) * lu(k,3414) + lu(k,3461) = lu(k,3461) - lu(k,1773) * lu(k,3414) + lu(k,3462) = lu(k,3462) - lu(k,1774) * lu(k,3414) + lu(k,3471) = lu(k,3471) - lu(k,1775) * lu(k,3414) + lu(k,3565) = lu(k,3565) - lu(k,1771) * lu(k,3559) + lu(k,3599) = lu(k,3599) - lu(k,1772) * lu(k,3559) + lu(k,3605) = lu(k,3605) - lu(k,1773) * lu(k,3559) + lu(k,3606) = lu(k,3606) - lu(k,1774) * lu(k,3559) + lu(k,3615) = lu(k,3615) - lu(k,1775) * lu(k,3559) + lu(k,3643) = lu(k,3643) - lu(k,1771) * lu(k,3642) + lu(k,3651) = lu(k,3651) - lu(k,1772) * lu(k,3642) + lu(k,3657) = lu(k,3657) - lu(k,1773) * lu(k,3642) + lu(k,3658) = lu(k,3658) - lu(k,1774) * lu(k,3642) + lu(k,3667) = lu(k,3667) - lu(k,1775) * lu(k,3642) + lu(k,3721) = lu(k,3721) - lu(k,1771) * lu(k,3713) + lu(k,3753) = lu(k,3753) - lu(k,1772) * lu(k,3713) + lu(k,3759) = lu(k,3759) - lu(k,1773) * lu(k,3713) + lu(k,3760) = lu(k,3760) - lu(k,1774) * lu(k,3713) + lu(k,3769) = lu(k,3769) - lu(k,1775) * lu(k,3713) + lu(k,4052) = lu(k,4052) - lu(k,1771) * lu(k,4044) + lu(k,4085) = lu(k,4085) - lu(k,1772) * lu(k,4044) + lu(k,4091) = lu(k,4091) - lu(k,1773) * lu(k,4044) + lu(k,4092) = lu(k,4092) - lu(k,1774) * lu(k,4044) + lu(k,4101) = lu(k,4101) - lu(k,1775) * lu(k,4044) + lu(k,1778) = 1._r8 / lu(k,1778) + lu(k,1779) = lu(k,1779) * lu(k,1778) + lu(k,1780) = lu(k,1780) * lu(k,1778) + lu(k,1781) = lu(k,1781) * lu(k,1778) + lu(k,1782) = lu(k,1782) * lu(k,1778) + lu(k,1783) = lu(k,1783) * lu(k,1778) + lu(k,1784) = lu(k,1784) * lu(k,1778) + lu(k,1785) = lu(k,1785) * lu(k,1778) + lu(k,1795) = lu(k,1795) - lu(k,1779) * lu(k,1792) + lu(k,1796) = lu(k,1796) - lu(k,1780) * lu(k,1792) + lu(k,1797) = lu(k,1797) - lu(k,1781) * lu(k,1792) + lu(k,1799) = lu(k,1799) - lu(k,1782) * lu(k,1792) + lu(k,1800) = lu(k,1800) - lu(k,1783) * lu(k,1792) + lu(k,1801) = lu(k,1801) - lu(k,1784) * lu(k,1792) + lu(k,1802) = lu(k,1802) - lu(k,1785) * lu(k,1792) + lu(k,1820) = lu(k,1820) - lu(k,1779) * lu(k,1816) + lu(k,1823) = lu(k,1823) - lu(k,1780) * lu(k,1816) + lu(k,1826) = lu(k,1826) - lu(k,1781) * lu(k,1816) + lu(k,1829) = lu(k,1829) - lu(k,1782) * lu(k,1816) + lu(k,1830) = lu(k,1830) - lu(k,1783) * lu(k,1816) + lu(k,1832) = lu(k,1832) - lu(k,1784) * lu(k,1816) + lu(k,1833) = lu(k,1833) - lu(k,1785) * lu(k,1816) + lu(k,1952) = lu(k,1952) - lu(k,1779) * lu(k,1946) + lu(k,1957) = lu(k,1957) - lu(k,1780) * lu(k,1946) + lu(k,1959) = lu(k,1959) - lu(k,1781) * lu(k,1946) + lu(k,1963) = lu(k,1963) - lu(k,1782) * lu(k,1946) + lu(k,1964) = lu(k,1964) - lu(k,1783) * lu(k,1946) + lu(k,1967) = lu(k,1967) - lu(k,1784) * lu(k,1946) + lu(k,1968) = lu(k,1968) - lu(k,1785) * lu(k,1946) + lu(k,1989) = lu(k,1989) - lu(k,1779) * lu(k,1983) + lu(k,1994) = lu(k,1994) - lu(k,1780) * lu(k,1983) + lu(k,1998) = lu(k,1998) - lu(k,1781) * lu(k,1983) + lu(k,2002) = lu(k,2002) - lu(k,1782) * lu(k,1983) + lu(k,2003) = lu(k,2003) - lu(k,1783) * lu(k,1983) + lu(k,2006) = lu(k,2006) - lu(k,1784) * lu(k,1983) + lu(k,2007) = lu(k,2007) - lu(k,1785) * lu(k,1983) + lu(k,2015) = lu(k,2015) - lu(k,1779) * lu(k,2014) + lu(k,2017) = lu(k,2017) - lu(k,1780) * lu(k,2014) + lu(k,2019) = lu(k,2019) - lu(k,1781) * lu(k,2014) + lu(k,2023) = lu(k,2023) - lu(k,1782) * lu(k,2014) + lu(k,2024) = lu(k,2024) - lu(k,1783) * lu(k,2014) + lu(k,2027) = lu(k,2027) - lu(k,1784) * lu(k,2014) + lu(k,2029) = lu(k,2029) - lu(k,1785) * lu(k,2014) + lu(k,2076) = lu(k,2076) - lu(k,1779) * lu(k,2072) + lu(k,2077) = lu(k,2077) - lu(k,1780) * lu(k,2072) + lu(k,2080) = lu(k,2080) - lu(k,1781) * lu(k,2072) + lu(k,2085) = lu(k,2085) - lu(k,1782) * lu(k,2072) + lu(k,2086) = lu(k,2086) - lu(k,1783) * lu(k,2072) + lu(k,2088) = lu(k,2088) - lu(k,1784) * lu(k,2072) + lu(k,2091) = lu(k,2091) - lu(k,1785) * lu(k,2072) + lu(k,2108) = lu(k,2108) - lu(k,1779) * lu(k,2104) + lu(k,2109) = lu(k,2109) - lu(k,1780) * lu(k,2104) + lu(k,2112) = lu(k,2112) - lu(k,1781) * lu(k,2104) + lu(k,2117) = lu(k,2117) - lu(k,1782) * lu(k,2104) + lu(k,2118) = lu(k,2118) - lu(k,1783) * lu(k,2104) + lu(k,2120) = lu(k,2120) - lu(k,1784) * lu(k,2104) + lu(k,2123) = lu(k,2123) - lu(k,1785) * lu(k,2104) + lu(k,2138) = lu(k,2138) - lu(k,1779) * lu(k,2134) + lu(k,2139) = lu(k,2139) - lu(k,1780) * lu(k,2134) + lu(k,2141) = lu(k,2141) - lu(k,1781) * lu(k,2134) + lu(k,2146) = lu(k,2146) - lu(k,1782) * lu(k,2134) + lu(k,2147) = lu(k,2147) - lu(k,1783) * lu(k,2134) + lu(k,2149) = lu(k,2149) - lu(k,1784) * lu(k,2134) + lu(k,2152) = lu(k,2152) - lu(k,1785) * lu(k,2134) + lu(k,2173) = lu(k,2173) - lu(k,1779) * lu(k,2170) + lu(k,2176) = lu(k,2176) - lu(k,1780) * lu(k,2170) + lu(k,2183) = lu(k,2183) - lu(k,1781) * lu(k,2170) + lu(k,2188) = lu(k,2188) - lu(k,1782) * lu(k,2170) + lu(k,2189) = lu(k,2189) - lu(k,1783) * lu(k,2170) + lu(k,2192) = lu(k,2192) - lu(k,1784) * lu(k,2170) + lu(k,2195) = lu(k,2195) - lu(k,1785) * lu(k,2170) + lu(k,2880) = lu(k,2880) - lu(k,1779) * lu(k,2874) + lu(k,2885) = lu(k,2885) - lu(k,1780) * lu(k,2874) + lu(k,2913) = lu(k,2913) - lu(k,1781) * lu(k,2874) + lu(k,2919) = lu(k,2919) - lu(k,1782) * lu(k,2874) + lu(k,2920) = lu(k,2920) - lu(k,1783) * lu(k,2874) + lu(k,2923) = lu(k,2923) - lu(k,1784) * lu(k,2874) + lu(k,2927) = lu(k,2927) - lu(k,1785) * lu(k,2874) + lu(k,3069) = lu(k,3069) - lu(k,1779) * lu(k,3062) + lu(k,3074) = lu(k,3074) - lu(k,1780) * lu(k,3062) + lu(k,3103) = lu(k,3103) - lu(k,1781) * lu(k,3062) + lu(k,3109) = lu(k,3109) - lu(k,1782) * lu(k,3062) + lu(k,3110) = lu(k,3110) - lu(k,1783) * lu(k,3062) + lu(k,3115) = lu(k,3115) - lu(k,1784) * lu(k,3062) + lu(k,3119) = lu(k,3119) - lu(k,1785) * lu(k,3062) + lu(k,3328) = lu(k,3328) - lu(k,1779) * lu(k,3321) + lu(k,3333) = lu(k,3333) - lu(k,1780) * lu(k,3321) + lu(k,3362) = lu(k,3362) - lu(k,1781) * lu(k,3321) + lu(k,3368) = lu(k,3368) - lu(k,1782) * lu(k,3321) + lu(k,3369) = lu(k,3369) - lu(k,1783) * lu(k,3321) + lu(k,3374) = lu(k,3374) - lu(k,1784) * lu(k,3321) + lu(k,3378) = lu(k,3378) - lu(k,1785) * lu(k,3321) + lu(k,3422) = lu(k,3422) - lu(k,1779) * lu(k,3415) + lu(k,3427) = lu(k,3427) - lu(k,1780) * lu(k,3415) + lu(k,3455) = lu(k,3455) - lu(k,1781) * lu(k,3415) + lu(k,3461) = lu(k,3461) - lu(k,1782) * lu(k,3415) + lu(k,3462) = lu(k,3462) - lu(k,1783) * lu(k,3415) + lu(k,3467) = lu(k,3467) - lu(k,1784) * lu(k,3415) + lu(k,3471) = lu(k,3471) - lu(k,1785) * lu(k,3415) + lu(k,3721) = lu(k,3721) - lu(k,1779) * lu(k,3714) + lu(k,3726) = lu(k,3726) - lu(k,1780) * lu(k,3714) + lu(k,3753) = lu(k,3753) - lu(k,1781) * lu(k,3714) + lu(k,3759) = lu(k,3759) - lu(k,1782) * lu(k,3714) + lu(k,3760) = lu(k,3760) - lu(k,1783) * lu(k,3714) + lu(k,3765) = lu(k,3765) - lu(k,1784) * lu(k,3714) + lu(k,3769) = lu(k,3769) - lu(k,1785) * lu(k,3714) + lu(k,4052) = lu(k,4052) - lu(k,1779) * lu(k,4045) + lu(k,4057) = lu(k,4057) - lu(k,1780) * lu(k,4045) + lu(k,4085) = lu(k,4085) - lu(k,1781) * lu(k,4045) + lu(k,4091) = lu(k,4091) - lu(k,1782) * lu(k,4045) + lu(k,4092) = lu(k,4092) - lu(k,1783) * lu(k,4045) + lu(k,4097) = lu(k,4097) - lu(k,1784) * lu(k,4045) + lu(k,4101) = lu(k,4101) - lu(k,1785) * lu(k,4045) + lu(k,1793) = 1._r8 / lu(k,1793) + lu(k,1794) = lu(k,1794) * lu(k,1793) + lu(k,1795) = lu(k,1795) * lu(k,1793) + lu(k,1796) = lu(k,1796) * lu(k,1793) + lu(k,1797) = lu(k,1797) * lu(k,1793) + lu(k,1798) = lu(k,1798) * lu(k,1793) + lu(k,1799) = lu(k,1799) * lu(k,1793) + lu(k,1800) = lu(k,1800) * lu(k,1793) + lu(k,1801) = lu(k,1801) * lu(k,1793) + lu(k,1802) = lu(k,1802) * lu(k,1793) + lu(k,1873) = - lu(k,1794) * lu(k,1871) + lu(k,1874) = lu(k,1874) - lu(k,1795) * lu(k,1871) + lu(k,1875) = lu(k,1875) - lu(k,1796) * lu(k,1871) + lu(k,1876) = lu(k,1876) - lu(k,1797) * lu(k,1871) + lu(k,1878) = lu(k,1878) - lu(k,1798) * lu(k,1871) + lu(k,1879) = lu(k,1879) - lu(k,1799) * lu(k,1871) + lu(k,1880) = lu(k,1880) - lu(k,1800) * lu(k,1871) + lu(k,1881) = lu(k,1881) - lu(k,1801) * lu(k,1871) + lu(k,1882) = lu(k,1882) - lu(k,1802) * lu(k,1871) + lu(k,1897) = - lu(k,1794) * lu(k,1894) + lu(k,1898) = lu(k,1898) - lu(k,1795) * lu(k,1894) + lu(k,1903) = lu(k,1903) - lu(k,1796) * lu(k,1894) + lu(k,1904) = lu(k,1904) - lu(k,1797) * lu(k,1894) + lu(k,1906) = lu(k,1906) - lu(k,1798) * lu(k,1894) + lu(k,1907) = lu(k,1907) - lu(k,1799) * lu(k,1894) + lu(k,1908) = lu(k,1908) - lu(k,1800) * lu(k,1894) + lu(k,1909) = lu(k,1909) - lu(k,1801) * lu(k,1894) + lu(k,1910) = lu(k,1910) - lu(k,1802) * lu(k,1894) + lu(k,1951) = lu(k,1951) - lu(k,1794) * lu(k,1947) + lu(k,1952) = lu(k,1952) - lu(k,1795) * lu(k,1947) + lu(k,1957) = lu(k,1957) - lu(k,1796) * lu(k,1947) + lu(k,1959) = lu(k,1959) - lu(k,1797) * lu(k,1947) + lu(k,1962) = lu(k,1962) - lu(k,1798) * lu(k,1947) + lu(k,1963) = lu(k,1963) - lu(k,1799) * lu(k,1947) + lu(k,1964) = lu(k,1964) - lu(k,1800) * lu(k,1947) + lu(k,1967) = lu(k,1967) - lu(k,1801) * lu(k,1947) + lu(k,1968) = lu(k,1968) - lu(k,1802) * lu(k,1947) + lu(k,1988) = lu(k,1988) - lu(k,1794) * lu(k,1984) + lu(k,1989) = lu(k,1989) - lu(k,1795) * lu(k,1984) + lu(k,1994) = lu(k,1994) - lu(k,1796) * lu(k,1984) + lu(k,1998) = lu(k,1998) - lu(k,1797) * lu(k,1984) + lu(k,2001) = lu(k,2001) - lu(k,1798) * lu(k,1984) + lu(k,2002) = lu(k,2002) - lu(k,1799) * lu(k,1984) + lu(k,2003) = lu(k,2003) - lu(k,1800) * lu(k,1984) + lu(k,2006) = lu(k,2006) - lu(k,1801) * lu(k,1984) + lu(k,2007) = lu(k,2007) - lu(k,1802) * lu(k,1984) + lu(k,2075) = lu(k,2075) - lu(k,1794) * lu(k,2073) + lu(k,2076) = lu(k,2076) - lu(k,1795) * lu(k,2073) + lu(k,2077) = lu(k,2077) - lu(k,1796) * lu(k,2073) + lu(k,2080) = lu(k,2080) - lu(k,1797) * lu(k,2073) + lu(k,2084) = lu(k,2084) - lu(k,1798) * lu(k,2073) + lu(k,2085) = lu(k,2085) - lu(k,1799) * lu(k,2073) + lu(k,2086) = lu(k,2086) - lu(k,1800) * lu(k,2073) + lu(k,2088) = lu(k,2088) - lu(k,1801) * lu(k,2073) + lu(k,2091) = lu(k,2091) - lu(k,1802) * lu(k,2073) + lu(k,2107) = lu(k,2107) - lu(k,1794) * lu(k,2105) + lu(k,2108) = lu(k,2108) - lu(k,1795) * lu(k,2105) + lu(k,2109) = lu(k,2109) - lu(k,1796) * lu(k,2105) + lu(k,2112) = lu(k,2112) - lu(k,1797) * lu(k,2105) + lu(k,2116) = lu(k,2116) - lu(k,1798) * lu(k,2105) + lu(k,2117) = lu(k,2117) - lu(k,1799) * lu(k,2105) + lu(k,2118) = lu(k,2118) - lu(k,1800) * lu(k,2105) + lu(k,2120) = lu(k,2120) - lu(k,1801) * lu(k,2105) + lu(k,2123) = lu(k,2123) - lu(k,1802) * lu(k,2105) + lu(k,2137) = lu(k,2137) - lu(k,1794) * lu(k,2135) + lu(k,2138) = lu(k,2138) - lu(k,1795) * lu(k,2135) + lu(k,2139) = lu(k,2139) - lu(k,1796) * lu(k,2135) + lu(k,2141) = lu(k,2141) - lu(k,1797) * lu(k,2135) + lu(k,2145) = lu(k,2145) - lu(k,1798) * lu(k,2135) + lu(k,2146) = lu(k,2146) - lu(k,1799) * lu(k,2135) + lu(k,2147) = lu(k,2147) - lu(k,1800) * lu(k,2135) + lu(k,2149) = lu(k,2149) - lu(k,1801) * lu(k,2135) + lu(k,2152) = lu(k,2152) - lu(k,1802) * lu(k,2135) + lu(k,2172) = lu(k,2172) - lu(k,1794) * lu(k,2171) + lu(k,2173) = lu(k,2173) - lu(k,1795) * lu(k,2171) + lu(k,2176) = lu(k,2176) - lu(k,1796) * lu(k,2171) + lu(k,2183) = lu(k,2183) - lu(k,1797) * lu(k,2171) + lu(k,2187) = lu(k,2187) - lu(k,1798) * lu(k,2171) + lu(k,2188) = lu(k,2188) - lu(k,1799) * lu(k,2171) + lu(k,2189) = lu(k,2189) - lu(k,1800) * lu(k,2171) + lu(k,2192) = lu(k,2192) - lu(k,1801) * lu(k,2171) + lu(k,2195) = lu(k,2195) - lu(k,1802) * lu(k,2171) + lu(k,3068) = lu(k,3068) - lu(k,1794) * lu(k,3063) + lu(k,3069) = lu(k,3069) - lu(k,1795) * lu(k,3063) + lu(k,3074) = lu(k,3074) - lu(k,1796) * lu(k,3063) + lu(k,3103) = lu(k,3103) - lu(k,1797) * lu(k,3063) + lu(k,3108) = lu(k,3108) - lu(k,1798) * lu(k,3063) + lu(k,3109) = lu(k,3109) - lu(k,1799) * lu(k,3063) + lu(k,3110) = lu(k,3110) - lu(k,1800) * lu(k,3063) + lu(k,3115) = lu(k,3115) - lu(k,1801) * lu(k,3063) + lu(k,3119) = lu(k,3119) - lu(k,1802) * lu(k,3063) + lu(k,3327) = lu(k,3327) - lu(k,1794) * lu(k,3322) + lu(k,3328) = lu(k,3328) - lu(k,1795) * lu(k,3322) + lu(k,3333) = lu(k,3333) - lu(k,1796) * lu(k,3322) + lu(k,3362) = lu(k,3362) - lu(k,1797) * lu(k,3322) + lu(k,3367) = lu(k,3367) - lu(k,1798) * lu(k,3322) + lu(k,3368) = lu(k,3368) - lu(k,1799) * lu(k,3322) + lu(k,3369) = lu(k,3369) - lu(k,1800) * lu(k,3322) + lu(k,3374) = lu(k,3374) - lu(k,1801) * lu(k,3322) + lu(k,3378) = lu(k,3378) - lu(k,1802) * lu(k,3322) + lu(k,3421) = lu(k,3421) - lu(k,1794) * lu(k,3416) + lu(k,3422) = lu(k,3422) - lu(k,1795) * lu(k,3416) + lu(k,3427) = lu(k,3427) - lu(k,1796) * lu(k,3416) + lu(k,3455) = lu(k,3455) - lu(k,1797) * lu(k,3416) + lu(k,3460) = lu(k,3460) - lu(k,1798) * lu(k,3416) + lu(k,3461) = lu(k,3461) - lu(k,1799) * lu(k,3416) + lu(k,3462) = lu(k,3462) - lu(k,1800) * lu(k,3416) + lu(k,3467) = lu(k,3467) - lu(k,1801) * lu(k,3416) + lu(k,3471) = lu(k,3471) - lu(k,1802) * lu(k,3416) + lu(k,3720) = lu(k,3720) - lu(k,1794) * lu(k,3715) + lu(k,3721) = lu(k,3721) - lu(k,1795) * lu(k,3715) + lu(k,3726) = lu(k,3726) - lu(k,1796) * lu(k,3715) + lu(k,3753) = lu(k,3753) - lu(k,1797) * lu(k,3715) + lu(k,3758) = lu(k,3758) - lu(k,1798) * lu(k,3715) + lu(k,3759) = lu(k,3759) - lu(k,1799) * lu(k,3715) + lu(k,3760) = lu(k,3760) - lu(k,1800) * lu(k,3715) + lu(k,3765) = lu(k,3765) - lu(k,1801) * lu(k,3715) + lu(k,3769) = lu(k,3769) - lu(k,1802) * lu(k,3715) + lu(k,4051) = lu(k,4051) - lu(k,1794) * lu(k,4046) + lu(k,4052) = lu(k,4052) - lu(k,1795) * lu(k,4046) + lu(k,4057) = lu(k,4057) - lu(k,1796) * lu(k,4046) + lu(k,4085) = lu(k,4085) - lu(k,1797) * lu(k,4046) + lu(k,4090) = lu(k,4090) - lu(k,1798) * lu(k,4046) + lu(k,4091) = lu(k,4091) - lu(k,1799) * lu(k,4046) + lu(k,4092) = lu(k,4092) - lu(k,1800) * lu(k,4046) + lu(k,4097) = lu(k,4097) - lu(k,1801) * lu(k,4046) + lu(k,4101) = lu(k,4101) - lu(k,1802) * lu(k,4046) + lu(k,1817) = 1._r8 / lu(k,1817) + lu(k,1818) = lu(k,1818) * lu(k,1817) + lu(k,1819) = lu(k,1819) * lu(k,1817) + lu(k,1820) = lu(k,1820) * lu(k,1817) + lu(k,1821) = lu(k,1821) * lu(k,1817) + lu(k,1822) = lu(k,1822) * lu(k,1817) + lu(k,1823) = lu(k,1823) * lu(k,1817) + lu(k,1824) = lu(k,1824) * lu(k,1817) + lu(k,1825) = lu(k,1825) * lu(k,1817) + lu(k,1826) = lu(k,1826) * lu(k,1817) + lu(k,1827) = lu(k,1827) * lu(k,1817) + lu(k,1828) = lu(k,1828) * lu(k,1817) + lu(k,1829) = lu(k,1829) * lu(k,1817) + lu(k,1830) = lu(k,1830) * lu(k,1817) + lu(k,1831) = lu(k,1831) * lu(k,1817) + lu(k,1832) = lu(k,1832) * lu(k,1817) + lu(k,1833) = lu(k,1833) * lu(k,1817) + lu(k,1986) = lu(k,1986) - lu(k,1818) * lu(k,1985) + lu(k,1987) = lu(k,1987) - lu(k,1819) * lu(k,1985) + lu(k,1989) = lu(k,1989) - lu(k,1820) * lu(k,1985) + lu(k,1991) = lu(k,1991) - lu(k,1821) * lu(k,1985) + lu(k,1992) = lu(k,1992) - lu(k,1822) * lu(k,1985) + lu(k,1994) = lu(k,1994) - lu(k,1823) * lu(k,1985) + lu(k,1995) = lu(k,1995) - lu(k,1824) * lu(k,1985) + lu(k,1997) = - lu(k,1825) * lu(k,1985) + lu(k,1998) = lu(k,1998) - lu(k,1826) * lu(k,1985) + lu(k,2000) = lu(k,2000) - lu(k,1827) * lu(k,1985) + lu(k,2001) = lu(k,2001) - lu(k,1828) * lu(k,1985) + lu(k,2002) = lu(k,2002) - lu(k,1829) * lu(k,1985) + lu(k,2003) = lu(k,2003) - lu(k,1830) * lu(k,1985) + lu(k,2004) = lu(k,2004) - lu(k,1831) * lu(k,1985) + lu(k,2006) = lu(k,2006) - lu(k,1832) * lu(k,1985) + lu(k,2007) = lu(k,2007) - lu(k,1833) * lu(k,1985) + lu(k,2877) = lu(k,2877) - lu(k,1818) * lu(k,2875) + lu(k,2878) = lu(k,2878) - lu(k,1819) * lu(k,2875) + lu(k,2880) = lu(k,2880) - lu(k,1820) * lu(k,2875) + lu(k,2882) = lu(k,2882) - lu(k,1821) * lu(k,2875) + lu(k,2883) = lu(k,2883) - lu(k,1822) * lu(k,2875) + lu(k,2885) = lu(k,2885) - lu(k,1823) * lu(k,2875) + lu(k,2886) = lu(k,2886) - lu(k,1824) * lu(k,2875) + lu(k,2893) = lu(k,2893) - lu(k,1825) * lu(k,2875) + lu(k,2913) = lu(k,2913) - lu(k,1826) * lu(k,2875) + lu(k,2916) = lu(k,2916) - lu(k,1827) * lu(k,2875) + lu(k,2918) = lu(k,2918) - lu(k,1828) * lu(k,2875) + lu(k,2919) = lu(k,2919) - lu(k,1829) * lu(k,2875) + lu(k,2920) = lu(k,2920) - lu(k,1830) * lu(k,2875) + lu(k,2921) = lu(k,2921) - lu(k,1831) * lu(k,2875) + lu(k,2923) = lu(k,2923) - lu(k,1832) * lu(k,2875) + lu(k,2927) = lu(k,2927) - lu(k,1833) * lu(k,2875) + lu(k,3066) = lu(k,3066) - lu(k,1818) * lu(k,3064) + lu(k,3067) = lu(k,3067) - lu(k,1819) * lu(k,3064) + lu(k,3069) = lu(k,3069) - lu(k,1820) * lu(k,3064) + lu(k,3071) = lu(k,3071) - lu(k,1821) * lu(k,3064) + lu(k,3072) = lu(k,3072) - lu(k,1822) * lu(k,3064) + lu(k,3074) = lu(k,3074) - lu(k,1823) * lu(k,3064) + lu(k,3075) = lu(k,3075) - lu(k,1824) * lu(k,3064) + lu(k,3083) = lu(k,3083) - lu(k,1825) * lu(k,3064) + lu(k,3103) = lu(k,3103) - lu(k,1826) * lu(k,3064) + lu(k,3106) = lu(k,3106) - lu(k,1827) * lu(k,3064) + lu(k,3108) = lu(k,3108) - lu(k,1828) * lu(k,3064) + lu(k,3109) = lu(k,3109) - lu(k,1829) * lu(k,3064) + lu(k,3110) = lu(k,3110) - lu(k,1830) * lu(k,3064) + lu(k,3111) = lu(k,3111) - lu(k,1831) * lu(k,3064) + lu(k,3115) = lu(k,3115) - lu(k,1832) * lu(k,3064) + lu(k,3119) = lu(k,3119) - lu(k,1833) * lu(k,3064) + lu(k,3325) = lu(k,3325) - lu(k,1818) * lu(k,3323) + lu(k,3326) = lu(k,3326) - lu(k,1819) * lu(k,3323) + lu(k,3328) = lu(k,3328) - lu(k,1820) * lu(k,3323) + lu(k,3330) = lu(k,3330) - lu(k,1821) * lu(k,3323) + lu(k,3331) = lu(k,3331) - lu(k,1822) * lu(k,3323) + lu(k,3333) = lu(k,3333) - lu(k,1823) * lu(k,3323) + lu(k,3334) = lu(k,3334) - lu(k,1824) * lu(k,3323) + lu(k,3342) = lu(k,3342) - lu(k,1825) * lu(k,3323) + lu(k,3362) = lu(k,3362) - lu(k,1826) * lu(k,3323) + lu(k,3365) = lu(k,3365) - lu(k,1827) * lu(k,3323) + lu(k,3367) = lu(k,3367) - lu(k,1828) * lu(k,3323) + lu(k,3368) = lu(k,3368) - lu(k,1829) * lu(k,3323) + lu(k,3369) = lu(k,3369) - lu(k,1830) * lu(k,3323) + lu(k,3370) = lu(k,3370) - lu(k,1831) * lu(k,3323) + lu(k,3374) = lu(k,3374) - lu(k,1832) * lu(k,3323) + lu(k,3378) = lu(k,3378) - lu(k,1833) * lu(k,3323) + lu(k,3419) = lu(k,3419) - lu(k,1818) * lu(k,3417) + lu(k,3420) = lu(k,3420) - lu(k,1819) * lu(k,3417) + lu(k,3422) = lu(k,3422) - lu(k,1820) * lu(k,3417) + lu(k,3424) = lu(k,3424) - lu(k,1821) * lu(k,3417) + lu(k,3425) = lu(k,3425) - lu(k,1822) * lu(k,3417) + lu(k,3427) = lu(k,3427) - lu(k,1823) * lu(k,3417) + lu(k,3428) = lu(k,3428) - lu(k,1824) * lu(k,3417) + lu(k,3435) = lu(k,3435) - lu(k,1825) * lu(k,3417) + lu(k,3455) = lu(k,3455) - lu(k,1826) * lu(k,3417) + lu(k,3458) = lu(k,3458) - lu(k,1827) * lu(k,3417) + lu(k,3460) = lu(k,3460) - lu(k,1828) * lu(k,3417) + lu(k,3461) = lu(k,3461) - lu(k,1829) * lu(k,3417) + lu(k,3462) = lu(k,3462) - lu(k,1830) * lu(k,3417) + lu(k,3463) = lu(k,3463) - lu(k,1831) * lu(k,3417) + lu(k,3467) = lu(k,3467) - lu(k,1832) * lu(k,3417) + lu(k,3471) = lu(k,3471) - lu(k,1833) * lu(k,3417) + lu(k,3562) = lu(k,3562) - lu(k,1818) * lu(k,3560) + lu(k,3563) = lu(k,3563) - lu(k,1819) * lu(k,3560) + lu(k,3565) = lu(k,3565) - lu(k,1820) * lu(k,3560) + lu(k,3567) = lu(k,3567) - lu(k,1821) * lu(k,3560) + lu(k,3568) = lu(k,3568) - lu(k,1822) * lu(k,3560) + lu(k,3570) = lu(k,3570) - lu(k,1823) * lu(k,3560) + lu(k,3571) = lu(k,3571) - lu(k,1824) * lu(k,3560) + lu(k,3579) = lu(k,3579) - lu(k,1825) * lu(k,3560) + lu(k,3599) = lu(k,3599) - lu(k,1826) * lu(k,3560) + lu(k,3602) = lu(k,3602) - lu(k,1827) * lu(k,3560) + lu(k,3604) = lu(k,3604) - lu(k,1828) * lu(k,3560) + lu(k,3605) = lu(k,3605) - lu(k,1829) * lu(k,3560) + lu(k,3606) = lu(k,3606) - lu(k,1830) * lu(k,3560) + lu(k,3607) = lu(k,3607) - lu(k,1831) * lu(k,3560) + lu(k,3611) = lu(k,3611) - lu(k,1832) * lu(k,3560) + lu(k,3615) = lu(k,3615) - lu(k,1833) * lu(k,3560) + lu(k,3718) = lu(k,3718) - lu(k,1818) * lu(k,3716) + lu(k,3719) = lu(k,3719) - lu(k,1819) * lu(k,3716) + lu(k,3721) = lu(k,3721) - lu(k,1820) * lu(k,3716) + lu(k,3723) = lu(k,3723) - lu(k,1821) * lu(k,3716) + lu(k,3724) = lu(k,3724) - lu(k,1822) * lu(k,3716) + lu(k,3726) = lu(k,3726) - lu(k,1823) * lu(k,3716) + lu(k,3727) = lu(k,3727) - lu(k,1824) * lu(k,3716) + lu(k,3734) = lu(k,3734) - lu(k,1825) * lu(k,3716) + lu(k,3753) = lu(k,3753) - lu(k,1826) * lu(k,3716) + lu(k,3756) = lu(k,3756) - lu(k,1827) * lu(k,3716) + lu(k,3758) = lu(k,3758) - lu(k,1828) * lu(k,3716) + lu(k,3759) = lu(k,3759) - lu(k,1829) * lu(k,3716) + lu(k,3760) = lu(k,3760) - lu(k,1830) * lu(k,3716) + lu(k,3761) = lu(k,3761) - lu(k,1831) * lu(k,3716) + lu(k,3765) = lu(k,3765) - lu(k,1832) * lu(k,3716) + lu(k,3769) = lu(k,3769) - lu(k,1833) * lu(k,3716) + lu(k,4049) = lu(k,4049) - lu(k,1818) * lu(k,4047) + lu(k,4050) = lu(k,4050) - lu(k,1819) * lu(k,4047) + lu(k,4052) = lu(k,4052) - lu(k,1820) * lu(k,4047) + lu(k,4054) = lu(k,4054) - lu(k,1821) * lu(k,4047) + lu(k,4055) = lu(k,4055) - lu(k,1822) * lu(k,4047) + lu(k,4057) = lu(k,4057) - lu(k,1823) * lu(k,4047) + lu(k,4058) = lu(k,4058) - lu(k,1824) * lu(k,4047) + lu(k,4065) = lu(k,4065) - lu(k,1825) * lu(k,4047) + lu(k,4085) = lu(k,4085) - lu(k,1826) * lu(k,4047) + lu(k,4088) = lu(k,4088) - lu(k,1827) * lu(k,4047) + lu(k,4090) = lu(k,4090) - lu(k,1828) * lu(k,4047) + lu(k,4091) = lu(k,4091) - lu(k,1829) * lu(k,4047) + lu(k,4092) = lu(k,4092) - lu(k,1830) * lu(k,4047) + lu(k,4093) = lu(k,4093) - lu(k,1831) * lu(k,4047) + lu(k,4097) = lu(k,4097) - lu(k,1832) * lu(k,4047) + lu(k,4101) = lu(k,4101) - lu(k,1833) * lu(k,4047) + end do + end subroutine lu_fac40 + subroutine lu_fac41( 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,1848) = 1._r8 / lu(k,1848) + lu(k,1849) = lu(k,1849) * lu(k,1848) + lu(k,1850) = lu(k,1850) * lu(k,1848) + lu(k,1851) = lu(k,1851) * lu(k,1848) + lu(k,1852) = lu(k,1852) * lu(k,1848) + lu(k,1853) = lu(k,1853) * lu(k,1848) + lu(k,1854) = lu(k,1854) * lu(k,1848) + lu(k,1855) = lu(k,1855) * lu(k,1848) + lu(k,1856) = lu(k,1856) * lu(k,1848) + lu(k,1857) = lu(k,1857) * lu(k,1848) + lu(k,1858) = lu(k,1858) * lu(k,1848) + lu(k,1859) = lu(k,1859) * lu(k,1848) + lu(k,1860) = lu(k,1860) * lu(k,1848) + lu(k,1861) = lu(k,1861) * lu(k,1848) + lu(k,1862) = lu(k,1862) * lu(k,1848) + lu(k,1863) = lu(k,1863) * lu(k,1848) + lu(k,1864) = lu(k,1864) * lu(k,1848) + lu(k,1865) = lu(k,1865) * lu(k,1848) + lu(k,1949) = lu(k,1949) - lu(k,1849) * lu(k,1948) + lu(k,1950) = lu(k,1950) - lu(k,1850) * lu(k,1948) + lu(k,1951) = lu(k,1951) - lu(k,1851) * lu(k,1948) + lu(k,1952) = lu(k,1952) - lu(k,1852) * lu(k,1948) + lu(k,1953) = lu(k,1953) - lu(k,1853) * lu(k,1948) + lu(k,1956) = lu(k,1956) - lu(k,1854) * lu(k,1948) + lu(k,1957) = lu(k,1957) - lu(k,1855) * lu(k,1948) + lu(k,1958) = lu(k,1958) - lu(k,1856) * lu(k,1948) + lu(k,1959) = lu(k,1959) - lu(k,1857) * lu(k,1948) + lu(k,1961) = lu(k,1961) - lu(k,1858) * lu(k,1948) + lu(k,1962) = lu(k,1962) - lu(k,1859) * lu(k,1948) + lu(k,1963) = lu(k,1963) - lu(k,1860) * lu(k,1948) + lu(k,1964) = lu(k,1964) - lu(k,1861) * lu(k,1948) + lu(k,1965) = lu(k,1965) - lu(k,1862) * lu(k,1948) + lu(k,1967) = lu(k,1967) - lu(k,1863) * lu(k,1948) + lu(k,1968) = lu(k,1968) - lu(k,1864) * lu(k,1948) + lu(k,1969) = - lu(k,1865) * lu(k,1948) + lu(k,2877) = lu(k,2877) - lu(k,1849) * lu(k,2876) + lu(k,2878) = lu(k,2878) - lu(k,1850) * lu(k,2876) + lu(k,2879) = lu(k,2879) - lu(k,1851) * lu(k,2876) + lu(k,2880) = lu(k,2880) - lu(k,1852) * lu(k,2876) + lu(k,2881) = lu(k,2881) - lu(k,1853) * lu(k,2876) + lu(k,2884) = lu(k,2884) - lu(k,1854) * lu(k,2876) + lu(k,2885) = lu(k,2885) - lu(k,1855) * lu(k,2876) + lu(k,2887) = lu(k,2887) - lu(k,1856) * lu(k,2876) + lu(k,2913) = lu(k,2913) - lu(k,1857) * lu(k,2876) + lu(k,2916) = lu(k,2916) - lu(k,1858) * lu(k,2876) + lu(k,2918) = lu(k,2918) - lu(k,1859) * lu(k,2876) + lu(k,2919) = lu(k,2919) - lu(k,1860) * lu(k,2876) + lu(k,2920) = lu(k,2920) - lu(k,1861) * lu(k,2876) + lu(k,2921) = lu(k,2921) - lu(k,1862) * lu(k,2876) + lu(k,2923) = lu(k,2923) - lu(k,1863) * lu(k,2876) + lu(k,2927) = lu(k,2927) - lu(k,1864) * lu(k,2876) + lu(k,2928) = lu(k,2928) - lu(k,1865) * lu(k,2876) + lu(k,3066) = lu(k,3066) - lu(k,1849) * lu(k,3065) + lu(k,3067) = lu(k,3067) - lu(k,1850) * lu(k,3065) + lu(k,3068) = lu(k,3068) - lu(k,1851) * lu(k,3065) + lu(k,3069) = lu(k,3069) - lu(k,1852) * lu(k,3065) + lu(k,3070) = lu(k,3070) - lu(k,1853) * lu(k,3065) + lu(k,3073) = lu(k,3073) - lu(k,1854) * lu(k,3065) + lu(k,3074) = lu(k,3074) - lu(k,1855) * lu(k,3065) + lu(k,3076) = lu(k,3076) - lu(k,1856) * lu(k,3065) + lu(k,3103) = lu(k,3103) - lu(k,1857) * lu(k,3065) + lu(k,3106) = lu(k,3106) - lu(k,1858) * lu(k,3065) + lu(k,3108) = lu(k,3108) - lu(k,1859) * lu(k,3065) + lu(k,3109) = lu(k,3109) - lu(k,1860) * lu(k,3065) + lu(k,3110) = lu(k,3110) - lu(k,1861) * lu(k,3065) + lu(k,3111) = lu(k,3111) - lu(k,1862) * lu(k,3065) + lu(k,3115) = lu(k,3115) - lu(k,1863) * lu(k,3065) + lu(k,3119) = lu(k,3119) - lu(k,1864) * lu(k,3065) + lu(k,3120) = lu(k,3120) - lu(k,1865) * lu(k,3065) + lu(k,3325) = lu(k,3325) - lu(k,1849) * lu(k,3324) + lu(k,3326) = lu(k,3326) - lu(k,1850) * lu(k,3324) + lu(k,3327) = lu(k,3327) - lu(k,1851) * lu(k,3324) + lu(k,3328) = lu(k,3328) - lu(k,1852) * lu(k,3324) + lu(k,3329) = lu(k,3329) - lu(k,1853) * lu(k,3324) + lu(k,3332) = lu(k,3332) - lu(k,1854) * lu(k,3324) + lu(k,3333) = lu(k,3333) - lu(k,1855) * lu(k,3324) + lu(k,3335) = lu(k,3335) - lu(k,1856) * lu(k,3324) + lu(k,3362) = lu(k,3362) - lu(k,1857) * lu(k,3324) + lu(k,3365) = lu(k,3365) - lu(k,1858) * lu(k,3324) + lu(k,3367) = lu(k,3367) - lu(k,1859) * lu(k,3324) + lu(k,3368) = lu(k,3368) - lu(k,1860) * lu(k,3324) + lu(k,3369) = lu(k,3369) - lu(k,1861) * lu(k,3324) + lu(k,3370) = lu(k,3370) - lu(k,1862) * lu(k,3324) + lu(k,3374) = lu(k,3374) - lu(k,1863) * lu(k,3324) + lu(k,3378) = lu(k,3378) - lu(k,1864) * lu(k,3324) + lu(k,3379) = lu(k,3379) - lu(k,1865) * lu(k,3324) + lu(k,3419) = lu(k,3419) - lu(k,1849) * lu(k,3418) + lu(k,3420) = lu(k,3420) - lu(k,1850) * lu(k,3418) + lu(k,3421) = lu(k,3421) - lu(k,1851) * lu(k,3418) + lu(k,3422) = lu(k,3422) - lu(k,1852) * lu(k,3418) + lu(k,3423) = lu(k,3423) - lu(k,1853) * lu(k,3418) + lu(k,3426) = lu(k,3426) - lu(k,1854) * lu(k,3418) + lu(k,3427) = lu(k,3427) - lu(k,1855) * lu(k,3418) + lu(k,3429) = lu(k,3429) - lu(k,1856) * lu(k,3418) + lu(k,3455) = lu(k,3455) - lu(k,1857) * lu(k,3418) + lu(k,3458) = lu(k,3458) - lu(k,1858) * lu(k,3418) + lu(k,3460) = lu(k,3460) - lu(k,1859) * lu(k,3418) + lu(k,3461) = lu(k,3461) - lu(k,1860) * lu(k,3418) + lu(k,3462) = lu(k,3462) - lu(k,1861) * lu(k,3418) + lu(k,3463) = lu(k,3463) - lu(k,1862) * lu(k,3418) + lu(k,3467) = lu(k,3467) - lu(k,1863) * lu(k,3418) + lu(k,3471) = lu(k,3471) - lu(k,1864) * lu(k,3418) + lu(k,3472) = lu(k,3472) - lu(k,1865) * lu(k,3418) + lu(k,3562) = lu(k,3562) - lu(k,1849) * lu(k,3561) + lu(k,3563) = lu(k,3563) - lu(k,1850) * lu(k,3561) + lu(k,3564) = - lu(k,1851) * lu(k,3561) + lu(k,3565) = lu(k,3565) - lu(k,1852) * lu(k,3561) + lu(k,3566) = lu(k,3566) - lu(k,1853) * lu(k,3561) + lu(k,3569) = lu(k,3569) - lu(k,1854) * lu(k,3561) + lu(k,3570) = lu(k,3570) - lu(k,1855) * lu(k,3561) + lu(k,3572) = lu(k,3572) - lu(k,1856) * lu(k,3561) + lu(k,3599) = lu(k,3599) - lu(k,1857) * lu(k,3561) + lu(k,3602) = lu(k,3602) - lu(k,1858) * lu(k,3561) + lu(k,3604) = lu(k,3604) - lu(k,1859) * lu(k,3561) + lu(k,3605) = lu(k,3605) - lu(k,1860) * lu(k,3561) + lu(k,3606) = lu(k,3606) - lu(k,1861) * lu(k,3561) + lu(k,3607) = lu(k,3607) - lu(k,1862) * lu(k,3561) + lu(k,3611) = lu(k,3611) - lu(k,1863) * lu(k,3561) + lu(k,3615) = lu(k,3615) - lu(k,1864) * lu(k,3561) + lu(k,3616) = lu(k,3616) - lu(k,1865) * lu(k,3561) + lu(k,3718) = lu(k,3718) - lu(k,1849) * lu(k,3717) + lu(k,3719) = lu(k,3719) - lu(k,1850) * lu(k,3717) + lu(k,3720) = lu(k,3720) - lu(k,1851) * lu(k,3717) + lu(k,3721) = lu(k,3721) - lu(k,1852) * lu(k,3717) + lu(k,3722) = lu(k,3722) - lu(k,1853) * lu(k,3717) + lu(k,3725) = lu(k,3725) - lu(k,1854) * lu(k,3717) + lu(k,3726) = lu(k,3726) - lu(k,1855) * lu(k,3717) + lu(k,3728) = lu(k,3728) - lu(k,1856) * lu(k,3717) + lu(k,3753) = lu(k,3753) - lu(k,1857) * lu(k,3717) + lu(k,3756) = lu(k,3756) - lu(k,1858) * lu(k,3717) + lu(k,3758) = lu(k,3758) - lu(k,1859) * lu(k,3717) + lu(k,3759) = lu(k,3759) - lu(k,1860) * lu(k,3717) + lu(k,3760) = lu(k,3760) - lu(k,1861) * lu(k,3717) + lu(k,3761) = lu(k,3761) - lu(k,1862) * lu(k,3717) + lu(k,3765) = lu(k,3765) - lu(k,1863) * lu(k,3717) + lu(k,3769) = lu(k,3769) - lu(k,1864) * lu(k,3717) + lu(k,3770) = lu(k,3770) - lu(k,1865) * lu(k,3717) + lu(k,4049) = lu(k,4049) - lu(k,1849) * lu(k,4048) + lu(k,4050) = lu(k,4050) - lu(k,1850) * lu(k,4048) + lu(k,4051) = lu(k,4051) - lu(k,1851) * lu(k,4048) + lu(k,4052) = lu(k,4052) - lu(k,1852) * lu(k,4048) + lu(k,4053) = lu(k,4053) - lu(k,1853) * lu(k,4048) + lu(k,4056) = lu(k,4056) - lu(k,1854) * lu(k,4048) + lu(k,4057) = lu(k,4057) - lu(k,1855) * lu(k,4048) + lu(k,4059) = lu(k,4059) - lu(k,1856) * lu(k,4048) + lu(k,4085) = lu(k,4085) - lu(k,1857) * lu(k,4048) + lu(k,4088) = lu(k,4088) - lu(k,1858) * lu(k,4048) + lu(k,4090) = lu(k,4090) - lu(k,1859) * lu(k,4048) + lu(k,4091) = lu(k,4091) - lu(k,1860) * lu(k,4048) + lu(k,4092) = lu(k,4092) - lu(k,1861) * lu(k,4048) + lu(k,4093) = lu(k,4093) - lu(k,1862) * lu(k,4048) + lu(k,4097) = lu(k,4097) - lu(k,1863) * lu(k,4048) + lu(k,4101) = lu(k,4101) - lu(k,1864) * lu(k,4048) + lu(k,4102) = lu(k,4102) - lu(k,1865) * lu(k,4048) + lu(k,1872) = 1._r8 / lu(k,1872) + lu(k,1873) = lu(k,1873) * lu(k,1872) + lu(k,1874) = lu(k,1874) * lu(k,1872) + lu(k,1875) = lu(k,1875) * lu(k,1872) + lu(k,1876) = lu(k,1876) * lu(k,1872) + lu(k,1877) = lu(k,1877) * lu(k,1872) + lu(k,1878) = lu(k,1878) * lu(k,1872) + lu(k,1879) = lu(k,1879) * lu(k,1872) + lu(k,1880) = lu(k,1880) * lu(k,1872) + lu(k,1881) = lu(k,1881) * lu(k,1872) + lu(k,1882) = lu(k,1882) * lu(k,1872) + lu(k,1897) = lu(k,1897) - lu(k,1873) * lu(k,1895) + lu(k,1898) = lu(k,1898) - lu(k,1874) * lu(k,1895) + lu(k,1903) = lu(k,1903) - lu(k,1875) * lu(k,1895) + lu(k,1904) = lu(k,1904) - lu(k,1876) * lu(k,1895) + lu(k,1905) = lu(k,1905) - lu(k,1877) * lu(k,1895) + lu(k,1906) = lu(k,1906) - lu(k,1878) * lu(k,1895) + lu(k,1907) = lu(k,1907) - lu(k,1879) * lu(k,1895) + lu(k,1908) = lu(k,1908) - lu(k,1880) * lu(k,1895) + lu(k,1909) = lu(k,1909) - lu(k,1881) * lu(k,1895) + lu(k,1910) = lu(k,1910) - lu(k,1882) * lu(k,1895) + lu(k,1951) = lu(k,1951) - lu(k,1873) * lu(k,1949) + lu(k,1952) = lu(k,1952) - lu(k,1874) * lu(k,1949) + lu(k,1957) = lu(k,1957) - lu(k,1875) * lu(k,1949) + lu(k,1959) = lu(k,1959) - lu(k,1876) * lu(k,1949) + lu(k,1961) = lu(k,1961) - lu(k,1877) * lu(k,1949) + lu(k,1962) = lu(k,1962) - lu(k,1878) * lu(k,1949) + lu(k,1963) = lu(k,1963) - lu(k,1879) * lu(k,1949) + lu(k,1964) = lu(k,1964) - lu(k,1880) * lu(k,1949) + lu(k,1967) = lu(k,1967) - lu(k,1881) * lu(k,1949) + lu(k,1968) = lu(k,1968) - lu(k,1882) * lu(k,1949) + lu(k,1988) = lu(k,1988) - lu(k,1873) * lu(k,1986) + lu(k,1989) = lu(k,1989) - lu(k,1874) * lu(k,1986) + lu(k,1994) = lu(k,1994) - lu(k,1875) * lu(k,1986) + lu(k,1998) = lu(k,1998) - lu(k,1876) * lu(k,1986) + lu(k,2000) = lu(k,2000) - lu(k,1877) * lu(k,1986) + lu(k,2001) = lu(k,2001) - lu(k,1878) * lu(k,1986) + lu(k,2002) = lu(k,2002) - lu(k,1879) * lu(k,1986) + lu(k,2003) = lu(k,2003) - lu(k,1880) * lu(k,1986) + lu(k,2006) = lu(k,2006) - lu(k,1881) * lu(k,1986) + lu(k,2007) = lu(k,2007) - lu(k,1882) * lu(k,1986) + lu(k,2075) = lu(k,2075) - lu(k,1873) * lu(k,2074) + lu(k,2076) = lu(k,2076) - lu(k,1874) * lu(k,2074) + lu(k,2077) = lu(k,2077) - lu(k,1875) * lu(k,2074) + lu(k,2080) = lu(k,2080) - lu(k,1876) * lu(k,2074) + lu(k,2082) = lu(k,2082) - lu(k,1877) * lu(k,2074) + lu(k,2084) = lu(k,2084) - lu(k,1878) * lu(k,2074) + lu(k,2085) = lu(k,2085) - lu(k,1879) * lu(k,2074) + lu(k,2086) = lu(k,2086) - lu(k,1880) * lu(k,2074) + lu(k,2088) = lu(k,2088) - lu(k,1881) * lu(k,2074) + lu(k,2091) = lu(k,2091) - lu(k,1882) * lu(k,2074) + lu(k,2107) = lu(k,2107) - lu(k,1873) * lu(k,2106) + lu(k,2108) = lu(k,2108) - lu(k,1874) * lu(k,2106) + lu(k,2109) = lu(k,2109) - lu(k,1875) * lu(k,2106) + lu(k,2112) = lu(k,2112) - lu(k,1876) * lu(k,2106) + lu(k,2114) = lu(k,2114) - lu(k,1877) * lu(k,2106) + lu(k,2116) = lu(k,2116) - lu(k,1878) * lu(k,2106) + lu(k,2117) = lu(k,2117) - lu(k,1879) * lu(k,2106) + lu(k,2118) = lu(k,2118) - lu(k,1880) * lu(k,2106) + lu(k,2120) = lu(k,2120) - lu(k,1881) * lu(k,2106) + lu(k,2123) = lu(k,2123) - lu(k,1882) * lu(k,2106) + lu(k,2137) = lu(k,2137) - lu(k,1873) * lu(k,2136) + lu(k,2138) = lu(k,2138) - lu(k,1874) * lu(k,2136) + lu(k,2139) = lu(k,2139) - lu(k,1875) * lu(k,2136) + lu(k,2141) = lu(k,2141) - lu(k,1876) * lu(k,2136) + lu(k,2143) = lu(k,2143) - lu(k,1877) * lu(k,2136) + lu(k,2145) = lu(k,2145) - lu(k,1878) * lu(k,2136) + lu(k,2146) = lu(k,2146) - lu(k,1879) * lu(k,2136) + lu(k,2147) = lu(k,2147) - lu(k,1880) * lu(k,2136) + lu(k,2149) = lu(k,2149) - lu(k,1881) * lu(k,2136) + lu(k,2152) = lu(k,2152) - lu(k,1882) * lu(k,2136) + lu(k,2879) = lu(k,2879) - lu(k,1873) * lu(k,2877) + lu(k,2880) = lu(k,2880) - lu(k,1874) * lu(k,2877) + lu(k,2885) = lu(k,2885) - lu(k,1875) * lu(k,2877) + lu(k,2913) = lu(k,2913) - lu(k,1876) * lu(k,2877) + lu(k,2916) = lu(k,2916) - lu(k,1877) * lu(k,2877) + lu(k,2918) = lu(k,2918) - lu(k,1878) * lu(k,2877) + lu(k,2919) = lu(k,2919) - lu(k,1879) * lu(k,2877) + lu(k,2920) = lu(k,2920) - lu(k,1880) * lu(k,2877) + lu(k,2923) = lu(k,2923) - lu(k,1881) * lu(k,2877) + lu(k,2927) = lu(k,2927) - lu(k,1882) * lu(k,2877) + lu(k,3068) = lu(k,3068) - lu(k,1873) * lu(k,3066) + lu(k,3069) = lu(k,3069) - lu(k,1874) * lu(k,3066) + lu(k,3074) = lu(k,3074) - lu(k,1875) * lu(k,3066) + lu(k,3103) = lu(k,3103) - lu(k,1876) * lu(k,3066) + lu(k,3106) = lu(k,3106) - lu(k,1877) * lu(k,3066) + lu(k,3108) = lu(k,3108) - lu(k,1878) * lu(k,3066) + lu(k,3109) = lu(k,3109) - lu(k,1879) * lu(k,3066) + lu(k,3110) = lu(k,3110) - lu(k,1880) * lu(k,3066) + lu(k,3115) = lu(k,3115) - lu(k,1881) * lu(k,3066) + lu(k,3119) = lu(k,3119) - lu(k,1882) * lu(k,3066) + lu(k,3327) = lu(k,3327) - lu(k,1873) * lu(k,3325) + lu(k,3328) = lu(k,3328) - lu(k,1874) * lu(k,3325) + lu(k,3333) = lu(k,3333) - lu(k,1875) * lu(k,3325) + lu(k,3362) = lu(k,3362) - lu(k,1876) * lu(k,3325) + lu(k,3365) = lu(k,3365) - lu(k,1877) * lu(k,3325) + lu(k,3367) = lu(k,3367) - lu(k,1878) * lu(k,3325) + lu(k,3368) = lu(k,3368) - lu(k,1879) * lu(k,3325) + lu(k,3369) = lu(k,3369) - lu(k,1880) * lu(k,3325) + lu(k,3374) = lu(k,3374) - lu(k,1881) * lu(k,3325) + lu(k,3378) = lu(k,3378) - lu(k,1882) * lu(k,3325) + lu(k,3421) = lu(k,3421) - lu(k,1873) * lu(k,3419) + lu(k,3422) = lu(k,3422) - lu(k,1874) * lu(k,3419) + lu(k,3427) = lu(k,3427) - lu(k,1875) * lu(k,3419) + lu(k,3455) = lu(k,3455) - lu(k,1876) * lu(k,3419) + lu(k,3458) = lu(k,3458) - lu(k,1877) * lu(k,3419) + lu(k,3460) = lu(k,3460) - lu(k,1878) * lu(k,3419) + lu(k,3461) = lu(k,3461) - lu(k,1879) * lu(k,3419) + lu(k,3462) = lu(k,3462) - lu(k,1880) * lu(k,3419) + lu(k,3467) = lu(k,3467) - lu(k,1881) * lu(k,3419) + lu(k,3471) = lu(k,3471) - lu(k,1882) * lu(k,3419) + lu(k,3564) = lu(k,3564) - lu(k,1873) * lu(k,3562) + lu(k,3565) = lu(k,3565) - lu(k,1874) * lu(k,3562) + lu(k,3570) = lu(k,3570) - lu(k,1875) * lu(k,3562) + lu(k,3599) = lu(k,3599) - lu(k,1876) * lu(k,3562) + lu(k,3602) = lu(k,3602) - lu(k,1877) * lu(k,3562) + lu(k,3604) = lu(k,3604) - lu(k,1878) * lu(k,3562) + lu(k,3605) = lu(k,3605) - lu(k,1879) * lu(k,3562) + lu(k,3606) = lu(k,3606) - lu(k,1880) * lu(k,3562) + lu(k,3611) = lu(k,3611) - lu(k,1881) * lu(k,3562) + lu(k,3615) = lu(k,3615) - lu(k,1882) * lu(k,3562) + lu(k,3720) = lu(k,3720) - lu(k,1873) * lu(k,3718) + lu(k,3721) = lu(k,3721) - lu(k,1874) * lu(k,3718) + lu(k,3726) = lu(k,3726) - lu(k,1875) * lu(k,3718) + lu(k,3753) = lu(k,3753) - lu(k,1876) * lu(k,3718) + lu(k,3756) = lu(k,3756) - lu(k,1877) * lu(k,3718) + lu(k,3758) = lu(k,3758) - lu(k,1878) * lu(k,3718) + lu(k,3759) = lu(k,3759) - lu(k,1879) * lu(k,3718) + lu(k,3760) = lu(k,3760) - lu(k,1880) * lu(k,3718) + lu(k,3765) = lu(k,3765) - lu(k,1881) * lu(k,3718) + lu(k,3769) = lu(k,3769) - lu(k,1882) * lu(k,3718) + lu(k,4051) = lu(k,4051) - lu(k,1873) * lu(k,4049) + lu(k,4052) = lu(k,4052) - lu(k,1874) * lu(k,4049) + lu(k,4057) = lu(k,4057) - lu(k,1875) * lu(k,4049) + lu(k,4085) = lu(k,4085) - lu(k,1876) * lu(k,4049) + lu(k,4088) = lu(k,4088) - lu(k,1877) * lu(k,4049) + lu(k,4090) = lu(k,4090) - lu(k,1878) * lu(k,4049) + lu(k,4091) = lu(k,4091) - lu(k,1879) * lu(k,4049) + lu(k,4092) = lu(k,4092) - lu(k,1880) * lu(k,4049) + lu(k,4097) = lu(k,4097) - lu(k,1881) * lu(k,4049) + lu(k,4101) = lu(k,4101) - lu(k,1882) * lu(k,4049) + lu(k,1896) = 1._r8 / lu(k,1896) + lu(k,1897) = lu(k,1897) * lu(k,1896) + lu(k,1898) = lu(k,1898) * lu(k,1896) + lu(k,1899) = lu(k,1899) * lu(k,1896) + lu(k,1900) = lu(k,1900) * lu(k,1896) + lu(k,1901) = lu(k,1901) * lu(k,1896) + lu(k,1902) = lu(k,1902) * lu(k,1896) + lu(k,1903) = lu(k,1903) * lu(k,1896) + lu(k,1904) = lu(k,1904) * lu(k,1896) + lu(k,1905) = lu(k,1905) * lu(k,1896) + lu(k,1906) = lu(k,1906) * lu(k,1896) + lu(k,1907) = lu(k,1907) * lu(k,1896) + lu(k,1908) = lu(k,1908) * lu(k,1896) + lu(k,1909) = lu(k,1909) * lu(k,1896) + lu(k,1910) = lu(k,1910) * lu(k,1896) + lu(k,1951) = lu(k,1951) - lu(k,1897) * lu(k,1950) + lu(k,1952) = lu(k,1952) - lu(k,1898) * lu(k,1950) + lu(k,1953) = lu(k,1953) - lu(k,1899) * lu(k,1950) + lu(k,1954) = - lu(k,1900) * lu(k,1950) + lu(k,1955) = - lu(k,1901) * lu(k,1950) + lu(k,1956) = lu(k,1956) - lu(k,1902) * lu(k,1950) + lu(k,1957) = lu(k,1957) - lu(k,1903) * lu(k,1950) + lu(k,1959) = lu(k,1959) - lu(k,1904) * lu(k,1950) + lu(k,1961) = lu(k,1961) - lu(k,1905) * lu(k,1950) + lu(k,1962) = lu(k,1962) - lu(k,1906) * lu(k,1950) + lu(k,1963) = lu(k,1963) - lu(k,1907) * lu(k,1950) + lu(k,1964) = lu(k,1964) - lu(k,1908) * lu(k,1950) + lu(k,1967) = lu(k,1967) - lu(k,1909) * lu(k,1950) + lu(k,1968) = lu(k,1968) - lu(k,1910) * lu(k,1950) + lu(k,1988) = lu(k,1988) - lu(k,1897) * lu(k,1987) + lu(k,1989) = lu(k,1989) - lu(k,1898) * lu(k,1987) + lu(k,1990) = - lu(k,1899) * lu(k,1987) + lu(k,1991) = lu(k,1991) - lu(k,1900) * lu(k,1987) + lu(k,1992) = lu(k,1992) - lu(k,1901) * lu(k,1987) + lu(k,1993) = - lu(k,1902) * lu(k,1987) + lu(k,1994) = lu(k,1994) - lu(k,1903) * lu(k,1987) + lu(k,1998) = lu(k,1998) - lu(k,1904) * lu(k,1987) + lu(k,2000) = lu(k,2000) - lu(k,1905) * lu(k,1987) + lu(k,2001) = lu(k,2001) - lu(k,1906) * lu(k,1987) + lu(k,2002) = lu(k,2002) - lu(k,1907) * lu(k,1987) + lu(k,2003) = lu(k,2003) - lu(k,1908) * lu(k,1987) + lu(k,2006) = lu(k,2006) - lu(k,1909) * lu(k,1987) + lu(k,2007) = lu(k,2007) - lu(k,1910) * lu(k,1987) + lu(k,2879) = lu(k,2879) - lu(k,1897) * lu(k,2878) + lu(k,2880) = lu(k,2880) - lu(k,1898) * lu(k,2878) + lu(k,2881) = lu(k,2881) - lu(k,1899) * lu(k,2878) + lu(k,2882) = lu(k,2882) - lu(k,1900) * lu(k,2878) + lu(k,2883) = lu(k,2883) - lu(k,1901) * lu(k,2878) + lu(k,2884) = lu(k,2884) - lu(k,1902) * lu(k,2878) + lu(k,2885) = lu(k,2885) - lu(k,1903) * lu(k,2878) + lu(k,2913) = lu(k,2913) - lu(k,1904) * lu(k,2878) + lu(k,2916) = lu(k,2916) - lu(k,1905) * lu(k,2878) + lu(k,2918) = lu(k,2918) - lu(k,1906) * lu(k,2878) + lu(k,2919) = lu(k,2919) - lu(k,1907) * lu(k,2878) + lu(k,2920) = lu(k,2920) - lu(k,1908) * lu(k,2878) + lu(k,2923) = lu(k,2923) - lu(k,1909) * lu(k,2878) + lu(k,2927) = lu(k,2927) - lu(k,1910) * lu(k,2878) + lu(k,3068) = lu(k,3068) - lu(k,1897) * lu(k,3067) + lu(k,3069) = lu(k,3069) - lu(k,1898) * lu(k,3067) + lu(k,3070) = lu(k,3070) - lu(k,1899) * lu(k,3067) + lu(k,3071) = lu(k,3071) - lu(k,1900) * lu(k,3067) + lu(k,3072) = lu(k,3072) - lu(k,1901) * lu(k,3067) + lu(k,3073) = lu(k,3073) - lu(k,1902) * lu(k,3067) + lu(k,3074) = lu(k,3074) - lu(k,1903) * lu(k,3067) + lu(k,3103) = lu(k,3103) - lu(k,1904) * lu(k,3067) + lu(k,3106) = lu(k,3106) - lu(k,1905) * lu(k,3067) + lu(k,3108) = lu(k,3108) - lu(k,1906) * lu(k,3067) + lu(k,3109) = lu(k,3109) - lu(k,1907) * lu(k,3067) + lu(k,3110) = lu(k,3110) - lu(k,1908) * lu(k,3067) + lu(k,3115) = lu(k,3115) - lu(k,1909) * lu(k,3067) + lu(k,3119) = lu(k,3119) - lu(k,1910) * lu(k,3067) + lu(k,3327) = lu(k,3327) - lu(k,1897) * lu(k,3326) + lu(k,3328) = lu(k,3328) - lu(k,1898) * lu(k,3326) + lu(k,3329) = lu(k,3329) - lu(k,1899) * lu(k,3326) + lu(k,3330) = lu(k,3330) - lu(k,1900) * lu(k,3326) + lu(k,3331) = lu(k,3331) - lu(k,1901) * lu(k,3326) + lu(k,3332) = lu(k,3332) - lu(k,1902) * lu(k,3326) + lu(k,3333) = lu(k,3333) - lu(k,1903) * lu(k,3326) + lu(k,3362) = lu(k,3362) - lu(k,1904) * lu(k,3326) + lu(k,3365) = lu(k,3365) - lu(k,1905) * lu(k,3326) + lu(k,3367) = lu(k,3367) - lu(k,1906) * lu(k,3326) + lu(k,3368) = lu(k,3368) - lu(k,1907) * lu(k,3326) + lu(k,3369) = lu(k,3369) - lu(k,1908) * lu(k,3326) + lu(k,3374) = lu(k,3374) - lu(k,1909) * lu(k,3326) + lu(k,3378) = lu(k,3378) - lu(k,1910) * lu(k,3326) + lu(k,3421) = lu(k,3421) - lu(k,1897) * lu(k,3420) + lu(k,3422) = lu(k,3422) - lu(k,1898) * lu(k,3420) + lu(k,3423) = lu(k,3423) - lu(k,1899) * lu(k,3420) + lu(k,3424) = lu(k,3424) - lu(k,1900) * lu(k,3420) + lu(k,3425) = lu(k,3425) - lu(k,1901) * lu(k,3420) + lu(k,3426) = lu(k,3426) - lu(k,1902) * lu(k,3420) + lu(k,3427) = lu(k,3427) - lu(k,1903) * lu(k,3420) + lu(k,3455) = lu(k,3455) - lu(k,1904) * lu(k,3420) + lu(k,3458) = lu(k,3458) - lu(k,1905) * lu(k,3420) + lu(k,3460) = lu(k,3460) - lu(k,1906) * lu(k,3420) + lu(k,3461) = lu(k,3461) - lu(k,1907) * lu(k,3420) + lu(k,3462) = lu(k,3462) - lu(k,1908) * lu(k,3420) + lu(k,3467) = lu(k,3467) - lu(k,1909) * lu(k,3420) + lu(k,3471) = lu(k,3471) - lu(k,1910) * lu(k,3420) + lu(k,3564) = lu(k,3564) - lu(k,1897) * lu(k,3563) + lu(k,3565) = lu(k,3565) - lu(k,1898) * lu(k,3563) + lu(k,3566) = lu(k,3566) - lu(k,1899) * lu(k,3563) + lu(k,3567) = lu(k,3567) - lu(k,1900) * lu(k,3563) + lu(k,3568) = lu(k,3568) - lu(k,1901) * lu(k,3563) + lu(k,3569) = lu(k,3569) - lu(k,1902) * lu(k,3563) + lu(k,3570) = lu(k,3570) - lu(k,1903) * lu(k,3563) + lu(k,3599) = lu(k,3599) - lu(k,1904) * lu(k,3563) + lu(k,3602) = lu(k,3602) - lu(k,1905) * lu(k,3563) + lu(k,3604) = lu(k,3604) - lu(k,1906) * lu(k,3563) + lu(k,3605) = lu(k,3605) - lu(k,1907) * lu(k,3563) + lu(k,3606) = lu(k,3606) - lu(k,1908) * lu(k,3563) + lu(k,3611) = lu(k,3611) - lu(k,1909) * lu(k,3563) + lu(k,3615) = lu(k,3615) - lu(k,1910) * lu(k,3563) + lu(k,3720) = lu(k,3720) - lu(k,1897) * lu(k,3719) + lu(k,3721) = lu(k,3721) - lu(k,1898) * lu(k,3719) + lu(k,3722) = lu(k,3722) - lu(k,1899) * lu(k,3719) + lu(k,3723) = lu(k,3723) - lu(k,1900) * lu(k,3719) + lu(k,3724) = lu(k,3724) - lu(k,1901) * lu(k,3719) + lu(k,3725) = lu(k,3725) - lu(k,1902) * lu(k,3719) + lu(k,3726) = lu(k,3726) - lu(k,1903) * lu(k,3719) + lu(k,3753) = lu(k,3753) - lu(k,1904) * lu(k,3719) + lu(k,3756) = lu(k,3756) - lu(k,1905) * lu(k,3719) + lu(k,3758) = lu(k,3758) - lu(k,1906) * lu(k,3719) + lu(k,3759) = lu(k,3759) - lu(k,1907) * lu(k,3719) + lu(k,3760) = lu(k,3760) - lu(k,1908) * lu(k,3719) + lu(k,3765) = lu(k,3765) - lu(k,1909) * lu(k,3719) + lu(k,3769) = lu(k,3769) - lu(k,1910) * lu(k,3719) + lu(k,4051) = lu(k,4051) - lu(k,1897) * lu(k,4050) + lu(k,4052) = lu(k,4052) - lu(k,1898) * lu(k,4050) + lu(k,4053) = lu(k,4053) - lu(k,1899) * lu(k,4050) + lu(k,4054) = lu(k,4054) - lu(k,1900) * lu(k,4050) + lu(k,4055) = lu(k,4055) - lu(k,1901) * lu(k,4050) + lu(k,4056) = lu(k,4056) - lu(k,1902) * lu(k,4050) + lu(k,4057) = lu(k,4057) - lu(k,1903) * lu(k,4050) + lu(k,4085) = lu(k,4085) - lu(k,1904) * lu(k,4050) + lu(k,4088) = lu(k,4088) - lu(k,1905) * lu(k,4050) + lu(k,4090) = lu(k,4090) - lu(k,1906) * lu(k,4050) + lu(k,4091) = lu(k,4091) - lu(k,1907) * lu(k,4050) + lu(k,4092) = lu(k,4092) - lu(k,1908) * lu(k,4050) + lu(k,4097) = lu(k,4097) - lu(k,1909) * lu(k,4050) + lu(k,4101) = lu(k,4101) - lu(k,1910) * lu(k,4050) + lu(k,1916) = 1._r8 / lu(k,1916) + lu(k,1917) = lu(k,1917) * lu(k,1916) + lu(k,1918) = lu(k,1918) * lu(k,1916) + lu(k,1919) = lu(k,1919) * lu(k,1916) + lu(k,1920) = lu(k,1920) * lu(k,1916) + lu(k,1921) = lu(k,1921) * lu(k,1916) + lu(k,1922) = lu(k,1922) * lu(k,1916) + lu(k,1923) = lu(k,1923) * lu(k,1916) + lu(k,1924) = lu(k,1924) * lu(k,1916) + lu(k,1925) = lu(k,1925) * lu(k,1916) + lu(k,1952) = lu(k,1952) - lu(k,1917) * lu(k,1951) + lu(k,1957) = lu(k,1957) - lu(k,1918) * lu(k,1951) + lu(k,1959) = lu(k,1959) - lu(k,1919) * lu(k,1951) + lu(k,1960) = lu(k,1960) - lu(k,1920) * lu(k,1951) + lu(k,1962) = lu(k,1962) - lu(k,1921) * lu(k,1951) + lu(k,1963) = lu(k,1963) - lu(k,1922) * lu(k,1951) + lu(k,1964) = lu(k,1964) - lu(k,1923) * lu(k,1951) + lu(k,1967) = lu(k,1967) - lu(k,1924) * lu(k,1951) + lu(k,1968) = lu(k,1968) - lu(k,1925) * lu(k,1951) + lu(k,1989) = lu(k,1989) - lu(k,1917) * lu(k,1988) + lu(k,1994) = lu(k,1994) - lu(k,1918) * lu(k,1988) + lu(k,1998) = lu(k,1998) - lu(k,1919) * lu(k,1988) + lu(k,1999) = lu(k,1999) - lu(k,1920) * lu(k,1988) + lu(k,2001) = lu(k,2001) - lu(k,1921) * lu(k,1988) + lu(k,2002) = lu(k,2002) - lu(k,1922) * lu(k,1988) + lu(k,2003) = lu(k,2003) - lu(k,1923) * lu(k,1988) + lu(k,2006) = lu(k,2006) - lu(k,1924) * lu(k,1988) + lu(k,2007) = lu(k,2007) - lu(k,1925) * lu(k,1988) + lu(k,2040) = lu(k,2040) - lu(k,1917) * lu(k,2039) + lu(k,2042) = lu(k,2042) - lu(k,1918) * lu(k,2039) + lu(k,2044) = lu(k,2044) - lu(k,1919) * lu(k,2039) + lu(k,2045) = lu(k,2045) - lu(k,1920) * lu(k,2039) + lu(k,2047) = lu(k,2047) - lu(k,1921) * lu(k,2039) + lu(k,2048) = lu(k,2048) - lu(k,1922) * lu(k,2039) + lu(k,2049) = lu(k,2049) - lu(k,1923) * lu(k,2039) + lu(k,2052) = lu(k,2052) - lu(k,1924) * lu(k,2039) + lu(k,2054) = lu(k,2054) - lu(k,1925) * lu(k,2039) + lu(k,2076) = lu(k,2076) - lu(k,1917) * lu(k,2075) + lu(k,2077) = lu(k,2077) - lu(k,1918) * lu(k,2075) + lu(k,2080) = lu(k,2080) - lu(k,1919) * lu(k,2075) + lu(k,2081) = lu(k,2081) - lu(k,1920) * lu(k,2075) + lu(k,2084) = lu(k,2084) - lu(k,1921) * lu(k,2075) + lu(k,2085) = lu(k,2085) - lu(k,1922) * lu(k,2075) + lu(k,2086) = lu(k,2086) - lu(k,1923) * lu(k,2075) + lu(k,2088) = lu(k,2088) - lu(k,1924) * lu(k,2075) + lu(k,2091) = lu(k,2091) - lu(k,1925) * lu(k,2075) + lu(k,2108) = lu(k,2108) - lu(k,1917) * lu(k,2107) + lu(k,2109) = lu(k,2109) - lu(k,1918) * lu(k,2107) + lu(k,2112) = lu(k,2112) - lu(k,1919) * lu(k,2107) + lu(k,2113) = lu(k,2113) - lu(k,1920) * lu(k,2107) + lu(k,2116) = lu(k,2116) - lu(k,1921) * lu(k,2107) + lu(k,2117) = lu(k,2117) - lu(k,1922) * lu(k,2107) + lu(k,2118) = lu(k,2118) - lu(k,1923) * lu(k,2107) + lu(k,2120) = lu(k,2120) - lu(k,1924) * lu(k,2107) + lu(k,2123) = lu(k,2123) - lu(k,1925) * lu(k,2107) + lu(k,2138) = lu(k,2138) - lu(k,1917) * lu(k,2137) + lu(k,2139) = lu(k,2139) - lu(k,1918) * lu(k,2137) + lu(k,2141) = lu(k,2141) - lu(k,1919) * lu(k,2137) + lu(k,2142) = lu(k,2142) - lu(k,1920) * lu(k,2137) + lu(k,2145) = lu(k,2145) - lu(k,1921) * lu(k,2137) + lu(k,2146) = lu(k,2146) - lu(k,1922) * lu(k,2137) + lu(k,2147) = lu(k,2147) - lu(k,1923) * lu(k,2137) + lu(k,2149) = lu(k,2149) - lu(k,1924) * lu(k,2137) + lu(k,2152) = lu(k,2152) - lu(k,1925) * lu(k,2137) + lu(k,2173) = lu(k,2173) - lu(k,1917) * lu(k,2172) + lu(k,2176) = lu(k,2176) - lu(k,1918) * lu(k,2172) + lu(k,2183) = lu(k,2183) - lu(k,1919) * lu(k,2172) + lu(k,2184) = lu(k,2184) - lu(k,1920) * lu(k,2172) + lu(k,2187) = lu(k,2187) - lu(k,1921) * lu(k,2172) + lu(k,2188) = lu(k,2188) - lu(k,1922) * lu(k,2172) + lu(k,2189) = lu(k,2189) - lu(k,1923) * lu(k,2172) + lu(k,2192) = lu(k,2192) - lu(k,1924) * lu(k,2172) + lu(k,2195) = lu(k,2195) - lu(k,1925) * lu(k,2172) + lu(k,2880) = lu(k,2880) - lu(k,1917) * lu(k,2879) + lu(k,2885) = lu(k,2885) - lu(k,1918) * lu(k,2879) + lu(k,2913) = lu(k,2913) - lu(k,1919) * lu(k,2879) + lu(k,2915) = lu(k,2915) - lu(k,1920) * lu(k,2879) + lu(k,2918) = lu(k,2918) - lu(k,1921) * lu(k,2879) + lu(k,2919) = lu(k,2919) - lu(k,1922) * lu(k,2879) + lu(k,2920) = lu(k,2920) - lu(k,1923) * lu(k,2879) + lu(k,2923) = lu(k,2923) - lu(k,1924) * lu(k,2879) + lu(k,2927) = lu(k,2927) - lu(k,1925) * lu(k,2879) + lu(k,3069) = lu(k,3069) - lu(k,1917) * lu(k,3068) + lu(k,3074) = lu(k,3074) - lu(k,1918) * lu(k,3068) + lu(k,3103) = lu(k,3103) - lu(k,1919) * lu(k,3068) + lu(k,3105) = lu(k,3105) - lu(k,1920) * lu(k,3068) + lu(k,3108) = lu(k,3108) - lu(k,1921) * lu(k,3068) + lu(k,3109) = lu(k,3109) - lu(k,1922) * lu(k,3068) + lu(k,3110) = lu(k,3110) - lu(k,1923) * lu(k,3068) + lu(k,3115) = lu(k,3115) - lu(k,1924) * lu(k,3068) + lu(k,3119) = lu(k,3119) - lu(k,1925) * lu(k,3068) + lu(k,3328) = lu(k,3328) - lu(k,1917) * lu(k,3327) + lu(k,3333) = lu(k,3333) - lu(k,1918) * lu(k,3327) + lu(k,3362) = lu(k,3362) - lu(k,1919) * lu(k,3327) + lu(k,3364) = lu(k,3364) - lu(k,1920) * lu(k,3327) + lu(k,3367) = lu(k,3367) - lu(k,1921) * lu(k,3327) + lu(k,3368) = lu(k,3368) - lu(k,1922) * lu(k,3327) + lu(k,3369) = lu(k,3369) - lu(k,1923) * lu(k,3327) + lu(k,3374) = lu(k,3374) - lu(k,1924) * lu(k,3327) + lu(k,3378) = lu(k,3378) - lu(k,1925) * lu(k,3327) + lu(k,3422) = lu(k,3422) - lu(k,1917) * lu(k,3421) + lu(k,3427) = lu(k,3427) - lu(k,1918) * lu(k,3421) + lu(k,3455) = lu(k,3455) - lu(k,1919) * lu(k,3421) + lu(k,3457) = lu(k,3457) - lu(k,1920) * lu(k,3421) + lu(k,3460) = lu(k,3460) - lu(k,1921) * lu(k,3421) + lu(k,3461) = lu(k,3461) - lu(k,1922) * lu(k,3421) + lu(k,3462) = lu(k,3462) - lu(k,1923) * lu(k,3421) + lu(k,3467) = lu(k,3467) - lu(k,1924) * lu(k,3421) + lu(k,3471) = lu(k,3471) - lu(k,1925) * lu(k,3421) + lu(k,3565) = lu(k,3565) - lu(k,1917) * lu(k,3564) + lu(k,3570) = lu(k,3570) - lu(k,1918) * lu(k,3564) + lu(k,3599) = lu(k,3599) - lu(k,1919) * lu(k,3564) + lu(k,3601) = lu(k,3601) - lu(k,1920) * lu(k,3564) + lu(k,3604) = lu(k,3604) - lu(k,1921) * lu(k,3564) + lu(k,3605) = lu(k,3605) - lu(k,1922) * lu(k,3564) + lu(k,3606) = lu(k,3606) - lu(k,1923) * lu(k,3564) + lu(k,3611) = lu(k,3611) - lu(k,1924) * lu(k,3564) + lu(k,3615) = lu(k,3615) - lu(k,1925) * lu(k,3564) + lu(k,3721) = lu(k,3721) - lu(k,1917) * lu(k,3720) + lu(k,3726) = lu(k,3726) - lu(k,1918) * lu(k,3720) + lu(k,3753) = lu(k,3753) - lu(k,1919) * lu(k,3720) + lu(k,3755) = lu(k,3755) - lu(k,1920) * lu(k,3720) + lu(k,3758) = lu(k,3758) - lu(k,1921) * lu(k,3720) + lu(k,3759) = lu(k,3759) - lu(k,1922) * lu(k,3720) + lu(k,3760) = lu(k,3760) - lu(k,1923) * lu(k,3720) + lu(k,3765) = lu(k,3765) - lu(k,1924) * lu(k,3720) + lu(k,3769) = lu(k,3769) - lu(k,1925) * lu(k,3720) + lu(k,4052) = lu(k,4052) - lu(k,1917) * lu(k,4051) + lu(k,4057) = lu(k,4057) - lu(k,1918) * lu(k,4051) + lu(k,4085) = lu(k,4085) - lu(k,1919) * lu(k,4051) + lu(k,4087) = lu(k,4087) - lu(k,1920) * lu(k,4051) + lu(k,4090) = lu(k,4090) - lu(k,1921) * lu(k,4051) + lu(k,4091) = lu(k,4091) - lu(k,1922) * lu(k,4051) + lu(k,4092) = lu(k,4092) - lu(k,1923) * lu(k,4051) + lu(k,4097) = lu(k,4097) - lu(k,1924) * lu(k,4051) + lu(k,4101) = lu(k,4101) - lu(k,1925) * lu(k,4051) + end do + end subroutine lu_fac41 + subroutine lu_fac42( 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,1926) = 1._r8 / lu(k,1926) + lu(k,1927) = lu(k,1927) * lu(k,1926) + lu(k,1928) = lu(k,1928) * lu(k,1926) + lu(k,1929) = lu(k,1929) * lu(k,1926) + lu(k,1930) = lu(k,1930) * lu(k,1926) + lu(k,1931) = lu(k,1931) * lu(k,1926) + lu(k,1932) = lu(k,1932) * lu(k,1926) + lu(k,1933) = lu(k,1933) * lu(k,1926) + lu(k,1957) = lu(k,1957) - lu(k,1927) * lu(k,1952) + lu(k,1959) = lu(k,1959) - lu(k,1928) * lu(k,1952) + lu(k,1960) = lu(k,1960) - lu(k,1929) * lu(k,1952) + lu(k,1964) = lu(k,1964) - lu(k,1930) * lu(k,1952) + lu(k,1966) = - lu(k,1931) * lu(k,1952) + lu(k,1968) = lu(k,1968) - lu(k,1932) * lu(k,1952) + lu(k,1969) = lu(k,1969) - lu(k,1933) * lu(k,1952) + lu(k,1994) = lu(k,1994) - lu(k,1927) * lu(k,1989) + lu(k,1998) = lu(k,1998) - lu(k,1928) * lu(k,1989) + lu(k,1999) = lu(k,1999) - lu(k,1929) * lu(k,1989) + lu(k,2003) = lu(k,2003) - lu(k,1930) * lu(k,1989) + lu(k,2005) = - lu(k,1931) * lu(k,1989) + lu(k,2007) = lu(k,2007) - lu(k,1932) * lu(k,1989) + lu(k,2008) = - lu(k,1933) * lu(k,1989) + lu(k,2017) = lu(k,2017) - lu(k,1927) * lu(k,2015) + lu(k,2019) = lu(k,2019) - lu(k,1928) * lu(k,2015) + lu(k,2020) = - lu(k,1929) * lu(k,2015) + lu(k,2024) = lu(k,2024) - lu(k,1930) * lu(k,2015) + lu(k,2026) = lu(k,2026) - lu(k,1931) * lu(k,2015) + lu(k,2029) = lu(k,2029) - lu(k,1932) * lu(k,2015) + lu(k,2030) = lu(k,2030) - lu(k,1933) * lu(k,2015) + lu(k,2042) = lu(k,2042) - lu(k,1927) * lu(k,2040) + lu(k,2044) = lu(k,2044) - lu(k,1928) * lu(k,2040) + lu(k,2045) = lu(k,2045) - lu(k,1929) * lu(k,2040) + lu(k,2049) = lu(k,2049) - lu(k,1930) * lu(k,2040) + lu(k,2051) = lu(k,2051) - lu(k,1931) * lu(k,2040) + lu(k,2054) = lu(k,2054) - lu(k,1932) * lu(k,2040) + lu(k,2055) = lu(k,2055) - lu(k,1933) * lu(k,2040) + lu(k,2077) = lu(k,2077) - lu(k,1927) * lu(k,2076) + lu(k,2080) = lu(k,2080) - lu(k,1928) * lu(k,2076) + lu(k,2081) = lu(k,2081) - lu(k,1929) * lu(k,2076) + lu(k,2086) = lu(k,2086) - lu(k,1930) * lu(k,2076) + lu(k,2087) = - lu(k,1931) * lu(k,2076) + lu(k,2091) = lu(k,2091) - lu(k,1932) * lu(k,2076) + lu(k,2092) = lu(k,2092) - lu(k,1933) * lu(k,2076) + lu(k,2109) = lu(k,2109) - lu(k,1927) * lu(k,2108) + lu(k,2112) = lu(k,2112) - lu(k,1928) * lu(k,2108) + lu(k,2113) = lu(k,2113) - lu(k,1929) * lu(k,2108) + lu(k,2118) = lu(k,2118) - lu(k,1930) * lu(k,2108) + lu(k,2119) = - lu(k,1931) * lu(k,2108) + lu(k,2123) = lu(k,2123) - lu(k,1932) * lu(k,2108) + lu(k,2124) = lu(k,2124) - lu(k,1933) * lu(k,2108) + lu(k,2139) = lu(k,2139) - lu(k,1927) * lu(k,2138) + lu(k,2141) = lu(k,2141) - lu(k,1928) * lu(k,2138) + lu(k,2142) = lu(k,2142) - lu(k,1929) * lu(k,2138) + lu(k,2147) = lu(k,2147) - lu(k,1930) * lu(k,2138) + lu(k,2148) = - lu(k,1931) * lu(k,2138) + lu(k,2152) = lu(k,2152) - lu(k,1932) * lu(k,2138) + lu(k,2153) = lu(k,2153) - lu(k,1933) * lu(k,2138) + lu(k,2176) = lu(k,2176) - lu(k,1927) * lu(k,2173) + lu(k,2183) = lu(k,2183) - lu(k,1928) * lu(k,2173) + lu(k,2184) = lu(k,2184) - lu(k,1929) * lu(k,2173) + lu(k,2189) = lu(k,2189) - lu(k,1930) * lu(k,2173) + lu(k,2191) = lu(k,2191) - lu(k,1931) * lu(k,2173) + lu(k,2195) = lu(k,2195) - lu(k,1932) * lu(k,2173) + lu(k,2196) = lu(k,2196) - lu(k,1933) * lu(k,2173) + lu(k,2276) = - lu(k,1927) * lu(k,2275) + lu(k,2278) = lu(k,2278) - lu(k,1928) * lu(k,2275) + lu(k,2279) = - lu(k,1929) * lu(k,2275) + lu(k,2283) = lu(k,2283) - lu(k,1930) * lu(k,2275) + lu(k,2285) = - lu(k,1931) * lu(k,2275) + lu(k,2287) = lu(k,2287) - lu(k,1932) * lu(k,2275) + lu(k,2288) = lu(k,2288) - lu(k,1933) * lu(k,2275) + lu(k,2885) = lu(k,2885) - lu(k,1927) * lu(k,2880) + lu(k,2913) = lu(k,2913) - lu(k,1928) * lu(k,2880) + lu(k,2915) = lu(k,2915) - lu(k,1929) * lu(k,2880) + lu(k,2920) = lu(k,2920) - lu(k,1930) * lu(k,2880) + lu(k,2922) = lu(k,2922) - lu(k,1931) * lu(k,2880) + lu(k,2927) = lu(k,2927) - lu(k,1932) * lu(k,2880) + lu(k,2928) = lu(k,2928) - lu(k,1933) * lu(k,2880) + lu(k,3074) = lu(k,3074) - lu(k,1927) * lu(k,3069) + lu(k,3103) = lu(k,3103) - lu(k,1928) * lu(k,3069) + lu(k,3105) = lu(k,3105) - lu(k,1929) * lu(k,3069) + lu(k,3110) = lu(k,3110) - lu(k,1930) * lu(k,3069) + lu(k,3114) = lu(k,3114) - lu(k,1931) * lu(k,3069) + lu(k,3119) = lu(k,3119) - lu(k,1932) * lu(k,3069) + lu(k,3120) = lu(k,3120) - lu(k,1933) * lu(k,3069) + lu(k,3333) = lu(k,3333) - lu(k,1927) * lu(k,3328) + lu(k,3362) = lu(k,3362) - lu(k,1928) * lu(k,3328) + lu(k,3364) = lu(k,3364) - lu(k,1929) * lu(k,3328) + lu(k,3369) = lu(k,3369) - lu(k,1930) * lu(k,3328) + lu(k,3373) = lu(k,3373) - lu(k,1931) * lu(k,3328) + lu(k,3378) = lu(k,3378) - lu(k,1932) * lu(k,3328) + lu(k,3379) = lu(k,3379) - lu(k,1933) * lu(k,3328) + lu(k,3427) = lu(k,3427) - lu(k,1927) * lu(k,3422) + lu(k,3455) = lu(k,3455) - lu(k,1928) * lu(k,3422) + lu(k,3457) = lu(k,3457) - lu(k,1929) * lu(k,3422) + lu(k,3462) = lu(k,3462) - lu(k,1930) * lu(k,3422) + lu(k,3466) = lu(k,3466) - lu(k,1931) * lu(k,3422) + lu(k,3471) = lu(k,3471) - lu(k,1932) * lu(k,3422) + lu(k,3472) = lu(k,3472) - lu(k,1933) * lu(k,3422) + lu(k,3570) = lu(k,3570) - lu(k,1927) * lu(k,3565) + lu(k,3599) = lu(k,3599) - lu(k,1928) * lu(k,3565) + lu(k,3601) = lu(k,3601) - lu(k,1929) * lu(k,3565) + lu(k,3606) = lu(k,3606) - lu(k,1930) * lu(k,3565) + lu(k,3610) = lu(k,3610) - lu(k,1931) * lu(k,3565) + lu(k,3615) = lu(k,3615) - lu(k,1932) * lu(k,3565) + lu(k,3616) = lu(k,3616) - lu(k,1933) * lu(k,3565) + lu(k,3644) = lu(k,3644) - lu(k,1927) * lu(k,3643) + lu(k,3651) = lu(k,3651) - lu(k,1928) * lu(k,3643) + lu(k,3653) = lu(k,3653) - lu(k,1929) * lu(k,3643) + lu(k,3658) = lu(k,3658) - lu(k,1930) * lu(k,3643) + lu(k,3662) = lu(k,3662) - lu(k,1931) * lu(k,3643) + lu(k,3667) = lu(k,3667) - lu(k,1932) * lu(k,3643) + lu(k,3668) = lu(k,3668) - lu(k,1933) * lu(k,3643) + lu(k,3726) = lu(k,3726) - lu(k,1927) * lu(k,3721) + lu(k,3753) = lu(k,3753) - lu(k,1928) * lu(k,3721) + lu(k,3755) = lu(k,3755) - lu(k,1929) * lu(k,3721) + lu(k,3760) = lu(k,3760) - lu(k,1930) * lu(k,3721) + lu(k,3764) = lu(k,3764) - lu(k,1931) * lu(k,3721) + lu(k,3769) = lu(k,3769) - lu(k,1932) * lu(k,3721) + lu(k,3770) = lu(k,3770) - lu(k,1933) * lu(k,3721) + lu(k,4057) = lu(k,4057) - lu(k,1927) * lu(k,4052) + lu(k,4085) = lu(k,4085) - lu(k,1928) * lu(k,4052) + lu(k,4087) = lu(k,4087) - lu(k,1929) * lu(k,4052) + lu(k,4092) = lu(k,4092) - lu(k,1930) * lu(k,4052) + lu(k,4096) = lu(k,4096) - lu(k,1931) * lu(k,4052) + lu(k,4101) = lu(k,4101) - lu(k,1932) * lu(k,4052) + lu(k,4102) = lu(k,4102) - lu(k,1933) * lu(k,4052) + lu(k,1953) = 1._r8 / lu(k,1953) + lu(k,1954) = lu(k,1954) * lu(k,1953) + lu(k,1955) = lu(k,1955) * lu(k,1953) + lu(k,1956) = lu(k,1956) * lu(k,1953) + lu(k,1957) = lu(k,1957) * lu(k,1953) + lu(k,1958) = lu(k,1958) * lu(k,1953) + lu(k,1959) = lu(k,1959) * lu(k,1953) + lu(k,1960) = lu(k,1960) * lu(k,1953) + lu(k,1961) = lu(k,1961) * lu(k,1953) + lu(k,1962) = lu(k,1962) * lu(k,1953) + lu(k,1963) = lu(k,1963) * lu(k,1953) + lu(k,1964) = lu(k,1964) * lu(k,1953) + lu(k,1965) = lu(k,1965) * lu(k,1953) + lu(k,1966) = lu(k,1966) * lu(k,1953) + lu(k,1967) = lu(k,1967) * lu(k,1953) + lu(k,1968) = lu(k,1968) * lu(k,1953) + lu(k,1969) = lu(k,1969) * lu(k,1953) + lu(k,1991) = lu(k,1991) - lu(k,1954) * lu(k,1990) + lu(k,1992) = lu(k,1992) - lu(k,1955) * lu(k,1990) + lu(k,1993) = lu(k,1993) - lu(k,1956) * lu(k,1990) + lu(k,1994) = lu(k,1994) - lu(k,1957) * lu(k,1990) + lu(k,1996) = - lu(k,1958) * lu(k,1990) + lu(k,1998) = lu(k,1998) - lu(k,1959) * lu(k,1990) + lu(k,1999) = lu(k,1999) - lu(k,1960) * lu(k,1990) + lu(k,2000) = lu(k,2000) - lu(k,1961) * lu(k,1990) + lu(k,2001) = lu(k,2001) - lu(k,1962) * lu(k,1990) + lu(k,2002) = lu(k,2002) - lu(k,1963) * lu(k,1990) + lu(k,2003) = lu(k,2003) - lu(k,1964) * lu(k,1990) + lu(k,2004) = lu(k,2004) - lu(k,1965) * lu(k,1990) + lu(k,2005) = lu(k,2005) - lu(k,1966) * lu(k,1990) + lu(k,2006) = lu(k,2006) - lu(k,1967) * lu(k,1990) + lu(k,2007) = lu(k,2007) - lu(k,1968) * lu(k,1990) + lu(k,2008) = lu(k,2008) - lu(k,1969) * lu(k,1990) + lu(k,2882) = lu(k,2882) - lu(k,1954) * lu(k,2881) + lu(k,2883) = lu(k,2883) - lu(k,1955) * lu(k,2881) + lu(k,2884) = lu(k,2884) - lu(k,1956) * lu(k,2881) + lu(k,2885) = lu(k,2885) - lu(k,1957) * lu(k,2881) + lu(k,2887) = lu(k,2887) - lu(k,1958) * lu(k,2881) + lu(k,2913) = lu(k,2913) - lu(k,1959) * lu(k,2881) + lu(k,2915) = lu(k,2915) - lu(k,1960) * lu(k,2881) + lu(k,2916) = lu(k,2916) - lu(k,1961) * lu(k,2881) + lu(k,2918) = lu(k,2918) - lu(k,1962) * lu(k,2881) + lu(k,2919) = lu(k,2919) - lu(k,1963) * lu(k,2881) + lu(k,2920) = lu(k,2920) - lu(k,1964) * lu(k,2881) + lu(k,2921) = lu(k,2921) - lu(k,1965) * lu(k,2881) + lu(k,2922) = lu(k,2922) - lu(k,1966) * lu(k,2881) + lu(k,2923) = lu(k,2923) - lu(k,1967) * lu(k,2881) + lu(k,2927) = lu(k,2927) - lu(k,1968) * lu(k,2881) + lu(k,2928) = lu(k,2928) - lu(k,1969) * lu(k,2881) + lu(k,3071) = lu(k,3071) - lu(k,1954) * lu(k,3070) + lu(k,3072) = lu(k,3072) - lu(k,1955) * lu(k,3070) + lu(k,3073) = lu(k,3073) - lu(k,1956) * lu(k,3070) + lu(k,3074) = lu(k,3074) - lu(k,1957) * lu(k,3070) + lu(k,3076) = lu(k,3076) - lu(k,1958) * lu(k,3070) + lu(k,3103) = lu(k,3103) - lu(k,1959) * lu(k,3070) + lu(k,3105) = lu(k,3105) - lu(k,1960) * lu(k,3070) + lu(k,3106) = lu(k,3106) - lu(k,1961) * lu(k,3070) + lu(k,3108) = lu(k,3108) - lu(k,1962) * lu(k,3070) + lu(k,3109) = lu(k,3109) - lu(k,1963) * lu(k,3070) + lu(k,3110) = lu(k,3110) - lu(k,1964) * lu(k,3070) + lu(k,3111) = lu(k,3111) - lu(k,1965) * lu(k,3070) + lu(k,3114) = lu(k,3114) - lu(k,1966) * lu(k,3070) + lu(k,3115) = lu(k,3115) - lu(k,1967) * lu(k,3070) + lu(k,3119) = lu(k,3119) - lu(k,1968) * lu(k,3070) + lu(k,3120) = lu(k,3120) - lu(k,1969) * lu(k,3070) + lu(k,3330) = lu(k,3330) - lu(k,1954) * lu(k,3329) + lu(k,3331) = lu(k,3331) - lu(k,1955) * lu(k,3329) + lu(k,3332) = lu(k,3332) - lu(k,1956) * lu(k,3329) + lu(k,3333) = lu(k,3333) - lu(k,1957) * lu(k,3329) + lu(k,3335) = lu(k,3335) - lu(k,1958) * lu(k,3329) + lu(k,3362) = lu(k,3362) - lu(k,1959) * lu(k,3329) + lu(k,3364) = lu(k,3364) - lu(k,1960) * lu(k,3329) + lu(k,3365) = lu(k,3365) - lu(k,1961) * lu(k,3329) + lu(k,3367) = lu(k,3367) - lu(k,1962) * lu(k,3329) + lu(k,3368) = lu(k,3368) - lu(k,1963) * lu(k,3329) + lu(k,3369) = lu(k,3369) - lu(k,1964) * lu(k,3329) + lu(k,3370) = lu(k,3370) - lu(k,1965) * lu(k,3329) + lu(k,3373) = lu(k,3373) - lu(k,1966) * lu(k,3329) + lu(k,3374) = lu(k,3374) - lu(k,1967) * lu(k,3329) + lu(k,3378) = lu(k,3378) - lu(k,1968) * lu(k,3329) + lu(k,3379) = lu(k,3379) - lu(k,1969) * lu(k,3329) + lu(k,3424) = lu(k,3424) - lu(k,1954) * lu(k,3423) + lu(k,3425) = lu(k,3425) - lu(k,1955) * lu(k,3423) + lu(k,3426) = lu(k,3426) - lu(k,1956) * lu(k,3423) + lu(k,3427) = lu(k,3427) - lu(k,1957) * lu(k,3423) + lu(k,3429) = lu(k,3429) - lu(k,1958) * lu(k,3423) + lu(k,3455) = lu(k,3455) - lu(k,1959) * lu(k,3423) + lu(k,3457) = lu(k,3457) - lu(k,1960) * lu(k,3423) + lu(k,3458) = lu(k,3458) - lu(k,1961) * lu(k,3423) + lu(k,3460) = lu(k,3460) - lu(k,1962) * lu(k,3423) + lu(k,3461) = lu(k,3461) - lu(k,1963) * lu(k,3423) + lu(k,3462) = lu(k,3462) - lu(k,1964) * lu(k,3423) + lu(k,3463) = lu(k,3463) - lu(k,1965) * lu(k,3423) + lu(k,3466) = lu(k,3466) - lu(k,1966) * lu(k,3423) + lu(k,3467) = lu(k,3467) - lu(k,1967) * lu(k,3423) + lu(k,3471) = lu(k,3471) - lu(k,1968) * lu(k,3423) + lu(k,3472) = lu(k,3472) - lu(k,1969) * lu(k,3423) + lu(k,3567) = lu(k,3567) - lu(k,1954) * lu(k,3566) + lu(k,3568) = lu(k,3568) - lu(k,1955) * lu(k,3566) + lu(k,3569) = lu(k,3569) - lu(k,1956) * lu(k,3566) + lu(k,3570) = lu(k,3570) - lu(k,1957) * lu(k,3566) + lu(k,3572) = lu(k,3572) - lu(k,1958) * lu(k,3566) + lu(k,3599) = lu(k,3599) - lu(k,1959) * lu(k,3566) + lu(k,3601) = lu(k,3601) - lu(k,1960) * lu(k,3566) + lu(k,3602) = lu(k,3602) - lu(k,1961) * lu(k,3566) + lu(k,3604) = lu(k,3604) - lu(k,1962) * lu(k,3566) + lu(k,3605) = lu(k,3605) - lu(k,1963) * lu(k,3566) + lu(k,3606) = lu(k,3606) - lu(k,1964) * lu(k,3566) + lu(k,3607) = lu(k,3607) - lu(k,1965) * lu(k,3566) + lu(k,3610) = lu(k,3610) - lu(k,1966) * lu(k,3566) + lu(k,3611) = lu(k,3611) - lu(k,1967) * lu(k,3566) + lu(k,3615) = lu(k,3615) - lu(k,1968) * lu(k,3566) + lu(k,3616) = lu(k,3616) - lu(k,1969) * lu(k,3566) + lu(k,3723) = lu(k,3723) - lu(k,1954) * lu(k,3722) + lu(k,3724) = lu(k,3724) - lu(k,1955) * lu(k,3722) + lu(k,3725) = lu(k,3725) - lu(k,1956) * lu(k,3722) + lu(k,3726) = lu(k,3726) - lu(k,1957) * lu(k,3722) + lu(k,3728) = lu(k,3728) - lu(k,1958) * lu(k,3722) + lu(k,3753) = lu(k,3753) - lu(k,1959) * lu(k,3722) + lu(k,3755) = lu(k,3755) - lu(k,1960) * lu(k,3722) + lu(k,3756) = lu(k,3756) - lu(k,1961) * lu(k,3722) + lu(k,3758) = lu(k,3758) - lu(k,1962) * lu(k,3722) + lu(k,3759) = lu(k,3759) - lu(k,1963) * lu(k,3722) + lu(k,3760) = lu(k,3760) - lu(k,1964) * lu(k,3722) + lu(k,3761) = lu(k,3761) - lu(k,1965) * lu(k,3722) + lu(k,3764) = lu(k,3764) - lu(k,1966) * lu(k,3722) + lu(k,3765) = lu(k,3765) - lu(k,1967) * lu(k,3722) + lu(k,3769) = lu(k,3769) - lu(k,1968) * lu(k,3722) + lu(k,3770) = lu(k,3770) - lu(k,1969) * lu(k,3722) + lu(k,4054) = lu(k,4054) - lu(k,1954) * lu(k,4053) + lu(k,4055) = lu(k,4055) - lu(k,1955) * lu(k,4053) + lu(k,4056) = lu(k,4056) - lu(k,1956) * lu(k,4053) + lu(k,4057) = lu(k,4057) - lu(k,1957) * lu(k,4053) + lu(k,4059) = lu(k,4059) - lu(k,1958) * lu(k,4053) + lu(k,4085) = lu(k,4085) - lu(k,1959) * lu(k,4053) + lu(k,4087) = lu(k,4087) - lu(k,1960) * lu(k,4053) + lu(k,4088) = lu(k,4088) - lu(k,1961) * lu(k,4053) + lu(k,4090) = lu(k,4090) - lu(k,1962) * lu(k,4053) + lu(k,4091) = lu(k,4091) - lu(k,1963) * lu(k,4053) + lu(k,4092) = lu(k,4092) - lu(k,1964) * lu(k,4053) + lu(k,4093) = lu(k,4093) - lu(k,1965) * lu(k,4053) + lu(k,4096) = lu(k,4096) - lu(k,1966) * lu(k,4053) + lu(k,4097) = lu(k,4097) - lu(k,1967) * lu(k,4053) + lu(k,4101) = lu(k,4101) - lu(k,1968) * lu(k,4053) + lu(k,4102) = lu(k,4102) - lu(k,1969) * lu(k,4053) + lu(k,1991) = 1._r8 / lu(k,1991) + lu(k,1992) = lu(k,1992) * lu(k,1991) + lu(k,1993) = lu(k,1993) * lu(k,1991) + lu(k,1994) = lu(k,1994) * lu(k,1991) + lu(k,1995) = lu(k,1995) * lu(k,1991) + lu(k,1996) = lu(k,1996) * lu(k,1991) + lu(k,1997) = lu(k,1997) * lu(k,1991) + lu(k,1998) = lu(k,1998) * lu(k,1991) + lu(k,1999) = lu(k,1999) * lu(k,1991) + lu(k,2000) = lu(k,2000) * lu(k,1991) + lu(k,2001) = lu(k,2001) * lu(k,1991) + lu(k,2002) = lu(k,2002) * lu(k,1991) + lu(k,2003) = lu(k,2003) * lu(k,1991) + lu(k,2004) = lu(k,2004) * lu(k,1991) + lu(k,2005) = lu(k,2005) * lu(k,1991) + lu(k,2006) = lu(k,2006) * lu(k,1991) + lu(k,2007) = lu(k,2007) * lu(k,1991) + lu(k,2008) = lu(k,2008) * lu(k,1991) + lu(k,2883) = lu(k,2883) - lu(k,1992) * lu(k,2882) + lu(k,2884) = lu(k,2884) - lu(k,1993) * lu(k,2882) + lu(k,2885) = lu(k,2885) - lu(k,1994) * lu(k,2882) + lu(k,2886) = lu(k,2886) - lu(k,1995) * lu(k,2882) + lu(k,2887) = lu(k,2887) - lu(k,1996) * lu(k,2882) + lu(k,2893) = lu(k,2893) - lu(k,1997) * lu(k,2882) + lu(k,2913) = lu(k,2913) - lu(k,1998) * lu(k,2882) + lu(k,2915) = lu(k,2915) - lu(k,1999) * lu(k,2882) + lu(k,2916) = lu(k,2916) - lu(k,2000) * lu(k,2882) + lu(k,2918) = lu(k,2918) - lu(k,2001) * lu(k,2882) + lu(k,2919) = lu(k,2919) - lu(k,2002) * lu(k,2882) + lu(k,2920) = lu(k,2920) - lu(k,2003) * lu(k,2882) + lu(k,2921) = lu(k,2921) - lu(k,2004) * lu(k,2882) + lu(k,2922) = lu(k,2922) - lu(k,2005) * lu(k,2882) + lu(k,2923) = lu(k,2923) - lu(k,2006) * lu(k,2882) + lu(k,2927) = lu(k,2927) - lu(k,2007) * lu(k,2882) + lu(k,2928) = lu(k,2928) - lu(k,2008) * lu(k,2882) + lu(k,3072) = lu(k,3072) - lu(k,1992) * lu(k,3071) + lu(k,3073) = lu(k,3073) - lu(k,1993) * lu(k,3071) + lu(k,3074) = lu(k,3074) - lu(k,1994) * lu(k,3071) + lu(k,3075) = lu(k,3075) - lu(k,1995) * lu(k,3071) + lu(k,3076) = lu(k,3076) - lu(k,1996) * lu(k,3071) + lu(k,3083) = lu(k,3083) - lu(k,1997) * lu(k,3071) + lu(k,3103) = lu(k,3103) - lu(k,1998) * lu(k,3071) + lu(k,3105) = lu(k,3105) - lu(k,1999) * lu(k,3071) + lu(k,3106) = lu(k,3106) - lu(k,2000) * lu(k,3071) + lu(k,3108) = lu(k,3108) - lu(k,2001) * lu(k,3071) + lu(k,3109) = lu(k,3109) - lu(k,2002) * lu(k,3071) + lu(k,3110) = lu(k,3110) - lu(k,2003) * lu(k,3071) + lu(k,3111) = lu(k,3111) - lu(k,2004) * lu(k,3071) + lu(k,3114) = lu(k,3114) - lu(k,2005) * lu(k,3071) + lu(k,3115) = lu(k,3115) - lu(k,2006) * lu(k,3071) + lu(k,3119) = lu(k,3119) - lu(k,2007) * lu(k,3071) + lu(k,3120) = lu(k,3120) - lu(k,2008) * lu(k,3071) + lu(k,3331) = lu(k,3331) - lu(k,1992) * lu(k,3330) + lu(k,3332) = lu(k,3332) - lu(k,1993) * lu(k,3330) + lu(k,3333) = lu(k,3333) - lu(k,1994) * lu(k,3330) + lu(k,3334) = lu(k,3334) - lu(k,1995) * lu(k,3330) + lu(k,3335) = lu(k,3335) - lu(k,1996) * lu(k,3330) + lu(k,3342) = lu(k,3342) - lu(k,1997) * lu(k,3330) + lu(k,3362) = lu(k,3362) - lu(k,1998) * lu(k,3330) + lu(k,3364) = lu(k,3364) - lu(k,1999) * lu(k,3330) + lu(k,3365) = lu(k,3365) - lu(k,2000) * lu(k,3330) + lu(k,3367) = lu(k,3367) - lu(k,2001) * lu(k,3330) + lu(k,3368) = lu(k,3368) - lu(k,2002) * lu(k,3330) + lu(k,3369) = lu(k,3369) - lu(k,2003) * lu(k,3330) + lu(k,3370) = lu(k,3370) - lu(k,2004) * lu(k,3330) + lu(k,3373) = lu(k,3373) - lu(k,2005) * lu(k,3330) + lu(k,3374) = lu(k,3374) - lu(k,2006) * lu(k,3330) + lu(k,3378) = lu(k,3378) - lu(k,2007) * lu(k,3330) + lu(k,3379) = lu(k,3379) - lu(k,2008) * lu(k,3330) + lu(k,3425) = lu(k,3425) - lu(k,1992) * lu(k,3424) + lu(k,3426) = lu(k,3426) - lu(k,1993) * lu(k,3424) + lu(k,3427) = lu(k,3427) - lu(k,1994) * lu(k,3424) + lu(k,3428) = lu(k,3428) - lu(k,1995) * lu(k,3424) + lu(k,3429) = lu(k,3429) - lu(k,1996) * lu(k,3424) + lu(k,3435) = lu(k,3435) - lu(k,1997) * lu(k,3424) + lu(k,3455) = lu(k,3455) - lu(k,1998) * lu(k,3424) + lu(k,3457) = lu(k,3457) - lu(k,1999) * lu(k,3424) + lu(k,3458) = lu(k,3458) - lu(k,2000) * lu(k,3424) + lu(k,3460) = lu(k,3460) - lu(k,2001) * lu(k,3424) + lu(k,3461) = lu(k,3461) - lu(k,2002) * lu(k,3424) + lu(k,3462) = lu(k,3462) - lu(k,2003) * lu(k,3424) + lu(k,3463) = lu(k,3463) - lu(k,2004) * lu(k,3424) + lu(k,3466) = lu(k,3466) - lu(k,2005) * lu(k,3424) + lu(k,3467) = lu(k,3467) - lu(k,2006) * lu(k,3424) + lu(k,3471) = lu(k,3471) - lu(k,2007) * lu(k,3424) + lu(k,3472) = lu(k,3472) - lu(k,2008) * lu(k,3424) + lu(k,3568) = lu(k,3568) - lu(k,1992) * lu(k,3567) + lu(k,3569) = lu(k,3569) - lu(k,1993) * lu(k,3567) + lu(k,3570) = lu(k,3570) - lu(k,1994) * lu(k,3567) + lu(k,3571) = lu(k,3571) - lu(k,1995) * lu(k,3567) + lu(k,3572) = lu(k,3572) - lu(k,1996) * lu(k,3567) + lu(k,3579) = lu(k,3579) - lu(k,1997) * lu(k,3567) + lu(k,3599) = lu(k,3599) - lu(k,1998) * lu(k,3567) + lu(k,3601) = lu(k,3601) - lu(k,1999) * lu(k,3567) + lu(k,3602) = lu(k,3602) - lu(k,2000) * lu(k,3567) + lu(k,3604) = lu(k,3604) - lu(k,2001) * lu(k,3567) + lu(k,3605) = lu(k,3605) - lu(k,2002) * lu(k,3567) + lu(k,3606) = lu(k,3606) - lu(k,2003) * lu(k,3567) + lu(k,3607) = lu(k,3607) - lu(k,2004) * lu(k,3567) + lu(k,3610) = lu(k,3610) - lu(k,2005) * lu(k,3567) + lu(k,3611) = lu(k,3611) - lu(k,2006) * lu(k,3567) + lu(k,3615) = lu(k,3615) - lu(k,2007) * lu(k,3567) + lu(k,3616) = lu(k,3616) - lu(k,2008) * lu(k,3567) + lu(k,3724) = lu(k,3724) - lu(k,1992) * lu(k,3723) + lu(k,3725) = lu(k,3725) - lu(k,1993) * lu(k,3723) + lu(k,3726) = lu(k,3726) - lu(k,1994) * lu(k,3723) + lu(k,3727) = lu(k,3727) - lu(k,1995) * lu(k,3723) + lu(k,3728) = lu(k,3728) - lu(k,1996) * lu(k,3723) + lu(k,3734) = lu(k,3734) - lu(k,1997) * lu(k,3723) + lu(k,3753) = lu(k,3753) - lu(k,1998) * lu(k,3723) + lu(k,3755) = lu(k,3755) - lu(k,1999) * lu(k,3723) + lu(k,3756) = lu(k,3756) - lu(k,2000) * lu(k,3723) + lu(k,3758) = lu(k,3758) - lu(k,2001) * lu(k,3723) + lu(k,3759) = lu(k,3759) - lu(k,2002) * lu(k,3723) + lu(k,3760) = lu(k,3760) - lu(k,2003) * lu(k,3723) + lu(k,3761) = lu(k,3761) - lu(k,2004) * lu(k,3723) + lu(k,3764) = lu(k,3764) - lu(k,2005) * lu(k,3723) + lu(k,3765) = lu(k,3765) - lu(k,2006) * lu(k,3723) + lu(k,3769) = lu(k,3769) - lu(k,2007) * lu(k,3723) + lu(k,3770) = lu(k,3770) - lu(k,2008) * lu(k,3723) + lu(k,4055) = lu(k,4055) - lu(k,1992) * lu(k,4054) + lu(k,4056) = lu(k,4056) - lu(k,1993) * lu(k,4054) + lu(k,4057) = lu(k,4057) - lu(k,1994) * lu(k,4054) + lu(k,4058) = lu(k,4058) - lu(k,1995) * lu(k,4054) + lu(k,4059) = lu(k,4059) - lu(k,1996) * lu(k,4054) + lu(k,4065) = lu(k,4065) - lu(k,1997) * lu(k,4054) + lu(k,4085) = lu(k,4085) - lu(k,1998) * lu(k,4054) + lu(k,4087) = lu(k,4087) - lu(k,1999) * lu(k,4054) + lu(k,4088) = lu(k,4088) - lu(k,2000) * lu(k,4054) + lu(k,4090) = lu(k,4090) - lu(k,2001) * lu(k,4054) + lu(k,4091) = lu(k,4091) - lu(k,2002) * lu(k,4054) + lu(k,4092) = lu(k,4092) - lu(k,2003) * lu(k,4054) + lu(k,4093) = lu(k,4093) - lu(k,2004) * lu(k,4054) + lu(k,4096) = lu(k,4096) - lu(k,2005) * lu(k,4054) + lu(k,4097) = lu(k,4097) - lu(k,2006) * lu(k,4054) + lu(k,4101) = lu(k,4101) - lu(k,2007) * lu(k,4054) + lu(k,4102) = lu(k,4102) - lu(k,2008) * lu(k,4054) + end do + end subroutine lu_fac42 + subroutine lu_fac43( 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,2016) = 1._r8 / lu(k,2016) + lu(k,2017) = lu(k,2017) * lu(k,2016) + lu(k,2018) = lu(k,2018) * lu(k,2016) + lu(k,2019) = lu(k,2019) * lu(k,2016) + lu(k,2020) = lu(k,2020) * lu(k,2016) + lu(k,2021) = lu(k,2021) * lu(k,2016) + lu(k,2022) = lu(k,2022) * lu(k,2016) + lu(k,2023) = lu(k,2023) * lu(k,2016) + lu(k,2024) = lu(k,2024) * lu(k,2016) + lu(k,2025) = lu(k,2025) * lu(k,2016) + lu(k,2026) = lu(k,2026) * lu(k,2016) + lu(k,2027) = lu(k,2027) * lu(k,2016) + lu(k,2028) = lu(k,2028) * lu(k,2016) + lu(k,2029) = lu(k,2029) * lu(k,2016) + lu(k,2030) = lu(k,2030) * lu(k,2016) + lu(k,2176) = lu(k,2176) - lu(k,2017) * lu(k,2174) + lu(k,2182) = - lu(k,2018) * lu(k,2174) + lu(k,2183) = lu(k,2183) - lu(k,2019) * lu(k,2174) + lu(k,2184) = lu(k,2184) - lu(k,2020) * lu(k,2174) + lu(k,2185) = lu(k,2185) - lu(k,2021) * lu(k,2174) + lu(k,2187) = lu(k,2187) - lu(k,2022) * lu(k,2174) + lu(k,2188) = lu(k,2188) - lu(k,2023) * lu(k,2174) + lu(k,2189) = lu(k,2189) - lu(k,2024) * lu(k,2174) + lu(k,2190) = lu(k,2190) - lu(k,2025) * lu(k,2174) + lu(k,2191) = lu(k,2191) - lu(k,2026) * lu(k,2174) + lu(k,2192) = lu(k,2192) - lu(k,2027) * lu(k,2174) + lu(k,2193) = lu(k,2193) - lu(k,2028) * lu(k,2174) + lu(k,2195) = lu(k,2195) - lu(k,2029) * lu(k,2174) + lu(k,2196) = lu(k,2196) - lu(k,2030) * lu(k,2174) + lu(k,2885) = lu(k,2885) - lu(k,2017) * lu(k,2883) + lu(k,2893) = lu(k,2893) - lu(k,2018) * lu(k,2883) + lu(k,2913) = lu(k,2913) - lu(k,2019) * lu(k,2883) + lu(k,2915) = lu(k,2915) - lu(k,2020) * lu(k,2883) + lu(k,2916) = lu(k,2916) - lu(k,2021) * lu(k,2883) + lu(k,2918) = lu(k,2918) - lu(k,2022) * lu(k,2883) + lu(k,2919) = lu(k,2919) - lu(k,2023) * lu(k,2883) + lu(k,2920) = lu(k,2920) - lu(k,2024) * lu(k,2883) + lu(k,2921) = lu(k,2921) - lu(k,2025) * lu(k,2883) + lu(k,2922) = lu(k,2922) - lu(k,2026) * lu(k,2883) + lu(k,2923) = lu(k,2923) - lu(k,2027) * lu(k,2883) + lu(k,2924) = lu(k,2924) - lu(k,2028) * lu(k,2883) + lu(k,2927) = lu(k,2927) - lu(k,2029) * lu(k,2883) + lu(k,2928) = lu(k,2928) - lu(k,2030) * lu(k,2883) + lu(k,3074) = lu(k,3074) - lu(k,2017) * lu(k,3072) + lu(k,3083) = lu(k,3083) - lu(k,2018) * lu(k,3072) + lu(k,3103) = lu(k,3103) - lu(k,2019) * lu(k,3072) + lu(k,3105) = lu(k,3105) - lu(k,2020) * lu(k,3072) + lu(k,3106) = lu(k,3106) - lu(k,2021) * lu(k,3072) + lu(k,3108) = lu(k,3108) - lu(k,2022) * lu(k,3072) + lu(k,3109) = lu(k,3109) - lu(k,2023) * lu(k,3072) + lu(k,3110) = lu(k,3110) - lu(k,2024) * lu(k,3072) + lu(k,3111) = lu(k,3111) - lu(k,2025) * lu(k,3072) + lu(k,3114) = lu(k,3114) - lu(k,2026) * lu(k,3072) + lu(k,3115) = lu(k,3115) - lu(k,2027) * lu(k,3072) + lu(k,3116) = lu(k,3116) - lu(k,2028) * lu(k,3072) + lu(k,3119) = lu(k,3119) - lu(k,2029) * lu(k,3072) + lu(k,3120) = lu(k,3120) - lu(k,2030) * lu(k,3072) + lu(k,3333) = lu(k,3333) - lu(k,2017) * lu(k,3331) + lu(k,3342) = lu(k,3342) - lu(k,2018) * lu(k,3331) + lu(k,3362) = lu(k,3362) - lu(k,2019) * lu(k,3331) + lu(k,3364) = lu(k,3364) - lu(k,2020) * lu(k,3331) + lu(k,3365) = lu(k,3365) - lu(k,2021) * lu(k,3331) + lu(k,3367) = lu(k,3367) - lu(k,2022) * lu(k,3331) + lu(k,3368) = lu(k,3368) - lu(k,2023) * lu(k,3331) + lu(k,3369) = lu(k,3369) - lu(k,2024) * lu(k,3331) + lu(k,3370) = lu(k,3370) - lu(k,2025) * lu(k,3331) + lu(k,3373) = lu(k,3373) - lu(k,2026) * lu(k,3331) + lu(k,3374) = lu(k,3374) - lu(k,2027) * lu(k,3331) + lu(k,3375) = lu(k,3375) - lu(k,2028) * lu(k,3331) + lu(k,3378) = lu(k,3378) - lu(k,2029) * lu(k,3331) + lu(k,3379) = lu(k,3379) - lu(k,2030) * lu(k,3331) + lu(k,3427) = lu(k,3427) - lu(k,2017) * lu(k,3425) + lu(k,3435) = lu(k,3435) - lu(k,2018) * lu(k,3425) + lu(k,3455) = lu(k,3455) - lu(k,2019) * lu(k,3425) + lu(k,3457) = lu(k,3457) - lu(k,2020) * lu(k,3425) + lu(k,3458) = lu(k,3458) - lu(k,2021) * lu(k,3425) + lu(k,3460) = lu(k,3460) - lu(k,2022) * lu(k,3425) + lu(k,3461) = lu(k,3461) - lu(k,2023) * lu(k,3425) + lu(k,3462) = lu(k,3462) - lu(k,2024) * lu(k,3425) + lu(k,3463) = lu(k,3463) - lu(k,2025) * lu(k,3425) + lu(k,3466) = lu(k,3466) - lu(k,2026) * lu(k,3425) + lu(k,3467) = lu(k,3467) - lu(k,2027) * lu(k,3425) + lu(k,3468) = lu(k,3468) - lu(k,2028) * lu(k,3425) + lu(k,3471) = lu(k,3471) - lu(k,2029) * lu(k,3425) + lu(k,3472) = lu(k,3472) - lu(k,2030) * lu(k,3425) + lu(k,3570) = lu(k,3570) - lu(k,2017) * lu(k,3568) + lu(k,3579) = lu(k,3579) - lu(k,2018) * lu(k,3568) + lu(k,3599) = lu(k,3599) - lu(k,2019) * lu(k,3568) + lu(k,3601) = lu(k,3601) - lu(k,2020) * lu(k,3568) + lu(k,3602) = lu(k,3602) - lu(k,2021) * lu(k,3568) + lu(k,3604) = lu(k,3604) - lu(k,2022) * lu(k,3568) + lu(k,3605) = lu(k,3605) - lu(k,2023) * lu(k,3568) + lu(k,3606) = lu(k,3606) - lu(k,2024) * lu(k,3568) + lu(k,3607) = lu(k,3607) - lu(k,2025) * lu(k,3568) + lu(k,3610) = lu(k,3610) - lu(k,2026) * lu(k,3568) + lu(k,3611) = lu(k,3611) - lu(k,2027) * lu(k,3568) + lu(k,3612) = lu(k,3612) - lu(k,2028) * lu(k,3568) + lu(k,3615) = lu(k,3615) - lu(k,2029) * lu(k,3568) + lu(k,3616) = lu(k,3616) - lu(k,2030) * lu(k,3568) + lu(k,3726) = lu(k,3726) - lu(k,2017) * lu(k,3724) + lu(k,3734) = lu(k,3734) - lu(k,2018) * lu(k,3724) + lu(k,3753) = lu(k,3753) - lu(k,2019) * lu(k,3724) + lu(k,3755) = lu(k,3755) - lu(k,2020) * lu(k,3724) + lu(k,3756) = lu(k,3756) - lu(k,2021) * lu(k,3724) + lu(k,3758) = lu(k,3758) - lu(k,2022) * lu(k,3724) + lu(k,3759) = lu(k,3759) - lu(k,2023) * lu(k,3724) + lu(k,3760) = lu(k,3760) - lu(k,2024) * lu(k,3724) + lu(k,3761) = lu(k,3761) - lu(k,2025) * lu(k,3724) + lu(k,3764) = lu(k,3764) - lu(k,2026) * lu(k,3724) + lu(k,3765) = lu(k,3765) - lu(k,2027) * lu(k,3724) + lu(k,3766) = lu(k,3766) - lu(k,2028) * lu(k,3724) + lu(k,3769) = lu(k,3769) - lu(k,2029) * lu(k,3724) + lu(k,3770) = lu(k,3770) - lu(k,2030) * lu(k,3724) + lu(k,4057) = lu(k,4057) - lu(k,2017) * lu(k,4055) + lu(k,4065) = lu(k,4065) - lu(k,2018) * lu(k,4055) + lu(k,4085) = lu(k,4085) - lu(k,2019) * lu(k,4055) + lu(k,4087) = lu(k,4087) - lu(k,2020) * lu(k,4055) + lu(k,4088) = lu(k,4088) - lu(k,2021) * lu(k,4055) + lu(k,4090) = lu(k,4090) - lu(k,2022) * lu(k,4055) + lu(k,4091) = lu(k,4091) - lu(k,2023) * lu(k,4055) + lu(k,4092) = lu(k,4092) - lu(k,2024) * lu(k,4055) + lu(k,4093) = lu(k,4093) - lu(k,2025) * lu(k,4055) + lu(k,4096) = lu(k,4096) - lu(k,2026) * lu(k,4055) + lu(k,4097) = lu(k,4097) - lu(k,2027) * lu(k,4055) + lu(k,4098) = lu(k,4098) - lu(k,2028) * lu(k,4055) + lu(k,4101) = lu(k,4101) - lu(k,2029) * lu(k,4055) + lu(k,4102) = lu(k,4102) - lu(k,2030) * lu(k,4055) + lu(k,2041) = 1._r8 / lu(k,2041) + lu(k,2042) = lu(k,2042) * lu(k,2041) + lu(k,2043) = lu(k,2043) * lu(k,2041) + lu(k,2044) = lu(k,2044) * lu(k,2041) + lu(k,2045) = lu(k,2045) * lu(k,2041) + lu(k,2046) = lu(k,2046) * lu(k,2041) + lu(k,2047) = lu(k,2047) * lu(k,2041) + lu(k,2048) = lu(k,2048) * lu(k,2041) + lu(k,2049) = lu(k,2049) * lu(k,2041) + lu(k,2050) = lu(k,2050) * lu(k,2041) + lu(k,2051) = lu(k,2051) * lu(k,2041) + lu(k,2052) = lu(k,2052) * lu(k,2041) + lu(k,2053) = lu(k,2053) * lu(k,2041) + lu(k,2054) = lu(k,2054) * lu(k,2041) + lu(k,2055) = lu(k,2055) * lu(k,2041) + lu(k,2176) = lu(k,2176) - lu(k,2042) * lu(k,2175) + lu(k,2181) = - lu(k,2043) * lu(k,2175) + lu(k,2183) = lu(k,2183) - lu(k,2044) * lu(k,2175) + lu(k,2184) = lu(k,2184) - lu(k,2045) * lu(k,2175) + lu(k,2185) = lu(k,2185) - lu(k,2046) * lu(k,2175) + lu(k,2187) = lu(k,2187) - lu(k,2047) * lu(k,2175) + lu(k,2188) = lu(k,2188) - lu(k,2048) * lu(k,2175) + lu(k,2189) = lu(k,2189) - lu(k,2049) * lu(k,2175) + lu(k,2190) = lu(k,2190) - lu(k,2050) * lu(k,2175) + lu(k,2191) = lu(k,2191) - lu(k,2051) * lu(k,2175) + lu(k,2192) = lu(k,2192) - lu(k,2052) * lu(k,2175) + lu(k,2193) = lu(k,2193) - lu(k,2053) * lu(k,2175) + lu(k,2195) = lu(k,2195) - lu(k,2054) * lu(k,2175) + lu(k,2196) = lu(k,2196) - lu(k,2055) * lu(k,2175) + lu(k,2885) = lu(k,2885) - lu(k,2042) * lu(k,2884) + lu(k,2892) = - lu(k,2043) * lu(k,2884) + lu(k,2913) = lu(k,2913) - lu(k,2044) * lu(k,2884) + lu(k,2915) = lu(k,2915) - lu(k,2045) * lu(k,2884) + lu(k,2916) = lu(k,2916) - lu(k,2046) * lu(k,2884) + lu(k,2918) = lu(k,2918) - lu(k,2047) * lu(k,2884) + lu(k,2919) = lu(k,2919) - lu(k,2048) * lu(k,2884) + lu(k,2920) = lu(k,2920) - lu(k,2049) * lu(k,2884) + lu(k,2921) = lu(k,2921) - lu(k,2050) * lu(k,2884) + lu(k,2922) = lu(k,2922) - lu(k,2051) * lu(k,2884) + lu(k,2923) = lu(k,2923) - lu(k,2052) * lu(k,2884) + lu(k,2924) = lu(k,2924) - lu(k,2053) * lu(k,2884) + lu(k,2927) = lu(k,2927) - lu(k,2054) * lu(k,2884) + lu(k,2928) = lu(k,2928) - lu(k,2055) * lu(k,2884) + lu(k,3074) = lu(k,3074) - lu(k,2042) * lu(k,3073) + lu(k,3082) = - lu(k,2043) * lu(k,3073) + lu(k,3103) = lu(k,3103) - lu(k,2044) * lu(k,3073) + lu(k,3105) = lu(k,3105) - lu(k,2045) * lu(k,3073) + lu(k,3106) = lu(k,3106) - lu(k,2046) * lu(k,3073) + lu(k,3108) = lu(k,3108) - lu(k,2047) * lu(k,3073) + lu(k,3109) = lu(k,3109) - lu(k,2048) * lu(k,3073) + lu(k,3110) = lu(k,3110) - lu(k,2049) * lu(k,3073) + lu(k,3111) = lu(k,3111) - lu(k,2050) * lu(k,3073) + lu(k,3114) = lu(k,3114) - lu(k,2051) * lu(k,3073) + lu(k,3115) = lu(k,3115) - lu(k,2052) * lu(k,3073) + lu(k,3116) = lu(k,3116) - lu(k,2053) * lu(k,3073) + lu(k,3119) = lu(k,3119) - lu(k,2054) * lu(k,3073) + lu(k,3120) = lu(k,3120) - lu(k,2055) * lu(k,3073) + lu(k,3333) = lu(k,3333) - lu(k,2042) * lu(k,3332) + lu(k,3341) = lu(k,3341) - lu(k,2043) * lu(k,3332) + lu(k,3362) = lu(k,3362) - lu(k,2044) * lu(k,3332) + lu(k,3364) = lu(k,3364) - lu(k,2045) * lu(k,3332) + lu(k,3365) = lu(k,3365) - lu(k,2046) * lu(k,3332) + lu(k,3367) = lu(k,3367) - lu(k,2047) * lu(k,3332) + lu(k,3368) = lu(k,3368) - lu(k,2048) * lu(k,3332) + lu(k,3369) = lu(k,3369) - lu(k,2049) * lu(k,3332) + lu(k,3370) = lu(k,3370) - lu(k,2050) * lu(k,3332) + lu(k,3373) = lu(k,3373) - lu(k,2051) * lu(k,3332) + lu(k,3374) = lu(k,3374) - lu(k,2052) * lu(k,3332) + lu(k,3375) = lu(k,3375) - lu(k,2053) * lu(k,3332) + lu(k,3378) = lu(k,3378) - lu(k,2054) * lu(k,3332) + lu(k,3379) = lu(k,3379) - lu(k,2055) * lu(k,3332) + lu(k,3427) = lu(k,3427) - lu(k,2042) * lu(k,3426) + lu(k,3434) = - lu(k,2043) * lu(k,3426) + lu(k,3455) = lu(k,3455) - lu(k,2044) * lu(k,3426) + lu(k,3457) = lu(k,3457) - lu(k,2045) * lu(k,3426) + lu(k,3458) = lu(k,3458) - lu(k,2046) * lu(k,3426) + lu(k,3460) = lu(k,3460) - lu(k,2047) * lu(k,3426) + lu(k,3461) = lu(k,3461) - lu(k,2048) * lu(k,3426) + lu(k,3462) = lu(k,3462) - lu(k,2049) * lu(k,3426) + lu(k,3463) = lu(k,3463) - lu(k,2050) * lu(k,3426) + lu(k,3466) = lu(k,3466) - lu(k,2051) * lu(k,3426) + lu(k,3467) = lu(k,3467) - lu(k,2052) * lu(k,3426) + lu(k,3468) = lu(k,3468) - lu(k,2053) * lu(k,3426) + lu(k,3471) = lu(k,3471) - lu(k,2054) * lu(k,3426) + lu(k,3472) = lu(k,3472) - lu(k,2055) * lu(k,3426) + lu(k,3570) = lu(k,3570) - lu(k,2042) * lu(k,3569) + lu(k,3578) = lu(k,3578) - lu(k,2043) * lu(k,3569) + lu(k,3599) = lu(k,3599) - lu(k,2044) * lu(k,3569) + lu(k,3601) = lu(k,3601) - lu(k,2045) * lu(k,3569) + lu(k,3602) = lu(k,3602) - lu(k,2046) * lu(k,3569) + lu(k,3604) = lu(k,3604) - lu(k,2047) * lu(k,3569) + lu(k,3605) = lu(k,3605) - lu(k,2048) * lu(k,3569) + lu(k,3606) = lu(k,3606) - lu(k,2049) * lu(k,3569) + lu(k,3607) = lu(k,3607) - lu(k,2050) * lu(k,3569) + lu(k,3610) = lu(k,3610) - lu(k,2051) * lu(k,3569) + lu(k,3611) = lu(k,3611) - lu(k,2052) * lu(k,3569) + lu(k,3612) = lu(k,3612) - lu(k,2053) * lu(k,3569) + lu(k,3615) = lu(k,3615) - lu(k,2054) * lu(k,3569) + lu(k,3616) = lu(k,3616) - lu(k,2055) * lu(k,3569) + lu(k,3726) = lu(k,3726) - lu(k,2042) * lu(k,3725) + lu(k,3733) = lu(k,3733) - lu(k,2043) * lu(k,3725) + lu(k,3753) = lu(k,3753) - lu(k,2044) * lu(k,3725) + lu(k,3755) = lu(k,3755) - lu(k,2045) * lu(k,3725) + lu(k,3756) = lu(k,3756) - lu(k,2046) * lu(k,3725) + lu(k,3758) = lu(k,3758) - lu(k,2047) * lu(k,3725) + lu(k,3759) = lu(k,3759) - lu(k,2048) * lu(k,3725) + lu(k,3760) = lu(k,3760) - lu(k,2049) * lu(k,3725) + lu(k,3761) = lu(k,3761) - lu(k,2050) * lu(k,3725) + lu(k,3764) = lu(k,3764) - lu(k,2051) * lu(k,3725) + lu(k,3765) = lu(k,3765) - lu(k,2052) * lu(k,3725) + lu(k,3766) = lu(k,3766) - lu(k,2053) * lu(k,3725) + lu(k,3769) = lu(k,3769) - lu(k,2054) * lu(k,3725) + lu(k,3770) = lu(k,3770) - lu(k,2055) * lu(k,3725) + lu(k,4057) = lu(k,4057) - lu(k,2042) * lu(k,4056) + lu(k,4064) = lu(k,4064) - lu(k,2043) * lu(k,4056) + lu(k,4085) = lu(k,4085) - lu(k,2044) * lu(k,4056) + lu(k,4087) = lu(k,4087) - lu(k,2045) * lu(k,4056) + lu(k,4088) = lu(k,4088) - lu(k,2046) * lu(k,4056) + lu(k,4090) = lu(k,4090) - lu(k,2047) * lu(k,4056) + lu(k,4091) = lu(k,4091) - lu(k,2048) * lu(k,4056) + lu(k,4092) = lu(k,4092) - lu(k,2049) * lu(k,4056) + lu(k,4093) = lu(k,4093) - lu(k,2050) * lu(k,4056) + lu(k,4096) = lu(k,4096) - lu(k,2051) * lu(k,4056) + lu(k,4097) = lu(k,4097) - lu(k,2052) * lu(k,4056) + lu(k,4098) = lu(k,4098) - lu(k,2053) * lu(k,4056) + lu(k,4101) = lu(k,4101) - lu(k,2054) * lu(k,4056) + lu(k,4102) = lu(k,4102) - lu(k,2055) * lu(k,4056) + lu(k,2057) = 1._r8 / lu(k,2057) + lu(k,2058) = lu(k,2058) * lu(k,2057) + lu(k,2059) = lu(k,2059) * lu(k,2057) + lu(k,2060) = lu(k,2060) * lu(k,2057) + lu(k,2084) = lu(k,2084) - lu(k,2058) * lu(k,2077) + lu(k,2086) = lu(k,2086) - lu(k,2059) * lu(k,2077) + lu(k,2091) = lu(k,2091) - lu(k,2060) * lu(k,2077) + lu(k,2116) = lu(k,2116) - lu(k,2058) * lu(k,2109) + lu(k,2118) = lu(k,2118) - lu(k,2059) * lu(k,2109) + lu(k,2123) = lu(k,2123) - lu(k,2060) * lu(k,2109) + lu(k,2145) = lu(k,2145) - lu(k,2058) * lu(k,2139) + lu(k,2147) = lu(k,2147) - lu(k,2059) * lu(k,2139) + lu(k,2152) = lu(k,2152) - lu(k,2060) * lu(k,2139) + lu(k,2187) = lu(k,2187) - lu(k,2058) * lu(k,2176) + lu(k,2189) = lu(k,2189) - lu(k,2059) * lu(k,2176) + lu(k,2195) = lu(k,2195) - lu(k,2060) * lu(k,2176) + lu(k,2201) = lu(k,2201) - lu(k,2058) * lu(k,2198) + lu(k,2203) = lu(k,2203) - lu(k,2059) * lu(k,2198) + lu(k,2207) = lu(k,2207) - lu(k,2060) * lu(k,2198) + lu(k,2223) = lu(k,2223) - lu(k,2058) * lu(k,2212) + lu(k,2225) = lu(k,2225) - lu(k,2059) * lu(k,2212) + lu(k,2229) = lu(k,2229) - lu(k,2060) * lu(k,2212) + lu(k,2247) = lu(k,2247) - lu(k,2058) * lu(k,2234) + lu(k,2249) = lu(k,2249) - lu(k,2059) * lu(k,2234) + lu(k,2253) = lu(k,2253) - lu(k,2060) * lu(k,2234) + lu(k,2263) = lu(k,2263) - lu(k,2058) * lu(k,2258) + lu(k,2265) = lu(k,2265) - lu(k,2059) * lu(k,2258) + lu(k,2270) = lu(k,2270) - lu(k,2060) * lu(k,2258) + lu(k,2281) = - lu(k,2058) * lu(k,2276) + lu(k,2283) = lu(k,2283) - lu(k,2059) * lu(k,2276) + lu(k,2287) = lu(k,2287) - lu(k,2060) * lu(k,2276) + lu(k,2307) = lu(k,2307) - lu(k,2058) * lu(k,2295) + lu(k,2309) = lu(k,2309) - lu(k,2059) * lu(k,2295) + lu(k,2313) = lu(k,2313) - lu(k,2060) * lu(k,2295) + lu(k,2327) = - lu(k,2058) * lu(k,2319) + lu(k,2329) = lu(k,2329) - lu(k,2059) * lu(k,2319) + lu(k,2332) = lu(k,2332) - lu(k,2060) * lu(k,2319) + lu(k,2351) = lu(k,2351) - lu(k,2058) * lu(k,2337) + lu(k,2353) = lu(k,2353) - lu(k,2059) * lu(k,2337) + lu(k,2357) = lu(k,2357) - lu(k,2060) * lu(k,2337) + lu(k,2364) = - lu(k,2058) * lu(k,2358) + lu(k,2365) = lu(k,2365) - lu(k,2059) * lu(k,2358) + lu(k,2367) = lu(k,2367) - lu(k,2060) * lu(k,2358) + lu(k,2391) = lu(k,2391) - lu(k,2058) * lu(k,2376) + lu(k,2393) = lu(k,2393) - lu(k,2059) * lu(k,2376) + lu(k,2397) = lu(k,2397) - lu(k,2060) * lu(k,2376) + lu(k,2420) = lu(k,2420) - lu(k,2058) * lu(k,2405) + lu(k,2422) = lu(k,2422) - lu(k,2059) * lu(k,2405) + lu(k,2426) = lu(k,2426) - lu(k,2060) * lu(k,2405) + lu(k,2452) = lu(k,2452) - lu(k,2058) * lu(k,2437) + lu(k,2454) = lu(k,2454) - lu(k,2059) * lu(k,2437) + lu(k,2458) = lu(k,2458) - lu(k,2060) * lu(k,2437) + lu(k,2483) = lu(k,2483) - lu(k,2058) * lu(k,2467) + lu(k,2485) = lu(k,2485) - lu(k,2059) * lu(k,2467) + lu(k,2489) = lu(k,2489) - lu(k,2060) * lu(k,2467) + lu(k,2517) = lu(k,2517) - lu(k,2058) * lu(k,2503) + lu(k,2519) = lu(k,2519) - lu(k,2059) * lu(k,2503) + lu(k,2523) = lu(k,2523) - lu(k,2060) * lu(k,2503) + lu(k,2546) = lu(k,2546) - lu(k,2058) * lu(k,2534) + lu(k,2548) = lu(k,2548) - lu(k,2059) * lu(k,2534) + lu(k,2552) = lu(k,2552) - lu(k,2060) * lu(k,2534) + lu(k,2582) = lu(k,2582) - lu(k,2058) * lu(k,2566) + lu(k,2584) = lu(k,2584) - lu(k,2059) * lu(k,2566) + lu(k,2588) = lu(k,2588) - lu(k,2060) * lu(k,2566) + lu(k,2610) = lu(k,2610) - lu(k,2058) * lu(k,2597) + lu(k,2612) = lu(k,2612) - lu(k,2059) * lu(k,2597) + lu(k,2617) = lu(k,2617) - lu(k,2060) * lu(k,2597) + lu(k,2638) = lu(k,2638) - lu(k,2058) * lu(k,2627) + lu(k,2640) = lu(k,2640) - lu(k,2059) * lu(k,2627) + lu(k,2645) = lu(k,2645) - lu(k,2060) * lu(k,2627) + lu(k,2663) = lu(k,2663) - lu(k,2058) * lu(k,2652) + lu(k,2665) = lu(k,2665) - lu(k,2059) * lu(k,2652) + lu(k,2669) = lu(k,2669) - lu(k,2060) * lu(k,2652) + lu(k,2685) = lu(k,2685) - lu(k,2058) * lu(k,2674) + lu(k,2687) = lu(k,2687) - lu(k,2059) * lu(k,2674) + lu(k,2691) = lu(k,2691) - lu(k,2060) * lu(k,2674) + lu(k,2708) = lu(k,2708) - lu(k,2058) * lu(k,2695) + lu(k,2710) = lu(k,2710) - lu(k,2059) * lu(k,2695) + lu(k,2714) = lu(k,2714) - lu(k,2060) * lu(k,2695) + lu(k,2752) = lu(k,2752) - lu(k,2058) * lu(k,2725) + lu(k,2754) = lu(k,2754) - lu(k,2059) * lu(k,2725) + lu(k,2760) = lu(k,2760) - lu(k,2060) * lu(k,2725) + lu(k,2798) = lu(k,2798) - lu(k,2058) * lu(k,2771) + lu(k,2800) = lu(k,2800) - lu(k,2059) * lu(k,2771) + lu(k,2806) = lu(k,2806) - lu(k,2060) * lu(k,2771) + lu(k,2845) = lu(k,2845) - lu(k,2058) * lu(k,2818) + lu(k,2847) = lu(k,2847) - lu(k,2059) * lu(k,2818) + lu(k,2853) = lu(k,2853) - lu(k,2060) * lu(k,2818) + lu(k,2918) = lu(k,2918) - lu(k,2058) * lu(k,2885) + lu(k,2920) = lu(k,2920) - lu(k,2059) * lu(k,2885) + lu(k,2927) = lu(k,2927) - lu(k,2060) * lu(k,2885) + lu(k,3108) = lu(k,3108) - lu(k,2058) * lu(k,3074) + lu(k,3110) = lu(k,3110) - lu(k,2059) * lu(k,3074) + lu(k,3119) = lu(k,3119) - lu(k,2060) * lu(k,3074) + lu(k,3161) = lu(k,3161) - lu(k,2058) * lu(k,3154) + lu(k,3163) = lu(k,3163) - lu(k,2059) * lu(k,3154) + lu(k,3172) = lu(k,3172) - lu(k,2060) * lu(k,3154) + lu(k,3187) = lu(k,3187) - lu(k,2058) * lu(k,3180) + lu(k,3189) = lu(k,3189) - lu(k,2059) * lu(k,3180) + lu(k,3198) = lu(k,3198) - lu(k,2060) * lu(k,3180) + lu(k,3367) = lu(k,3367) - lu(k,2058) * lu(k,3333) + lu(k,3369) = lu(k,3369) - lu(k,2059) * lu(k,3333) + lu(k,3378) = lu(k,3378) - lu(k,2060) * lu(k,3333) + lu(k,3460) = lu(k,3460) - lu(k,2058) * lu(k,3427) + lu(k,3462) = lu(k,3462) - lu(k,2059) * lu(k,3427) + lu(k,3471) = lu(k,3471) - lu(k,2060) * lu(k,3427) + lu(k,3604) = lu(k,3604) - lu(k,2058) * lu(k,3570) + lu(k,3606) = lu(k,3606) - lu(k,2059) * lu(k,3570) + lu(k,3615) = lu(k,3615) - lu(k,2060) * lu(k,3570) + lu(k,3656) = lu(k,3656) - lu(k,2058) * lu(k,3644) + lu(k,3658) = lu(k,3658) - lu(k,2059) * lu(k,3644) + lu(k,3667) = lu(k,3667) - lu(k,2060) * lu(k,3644) + lu(k,3758) = lu(k,3758) - lu(k,2058) * lu(k,3726) + lu(k,3760) = lu(k,3760) - lu(k,2059) * lu(k,3726) + lu(k,3769) = lu(k,3769) - lu(k,2060) * lu(k,3726) + lu(k,3840) = lu(k,3840) - lu(k,2058) * lu(k,3832) + lu(k,3842) = lu(k,3842) - lu(k,2059) * lu(k,3832) + lu(k,3851) = lu(k,3851) - lu(k,2060) * lu(k,3832) + lu(k,4090) = lu(k,4090) - lu(k,2058) * lu(k,4057) + lu(k,4092) = lu(k,4092) - lu(k,2059) * lu(k,4057) + lu(k,4101) = lu(k,4101) - lu(k,2060) * lu(k,4057) + lu(k,2078) = 1._r8 / lu(k,2078) + lu(k,2079) = lu(k,2079) * lu(k,2078) + lu(k,2080) = lu(k,2080) * lu(k,2078) + lu(k,2081) = lu(k,2081) * lu(k,2078) + lu(k,2082) = lu(k,2082) * lu(k,2078) + lu(k,2083) = lu(k,2083) * lu(k,2078) + lu(k,2084) = lu(k,2084) * lu(k,2078) + lu(k,2085) = lu(k,2085) * lu(k,2078) + lu(k,2086) = lu(k,2086) * lu(k,2078) + lu(k,2087) = lu(k,2087) * lu(k,2078) + lu(k,2088) = lu(k,2088) * lu(k,2078) + lu(k,2089) = lu(k,2089) * lu(k,2078) + lu(k,2090) = lu(k,2090) * lu(k,2078) + lu(k,2091) = lu(k,2091) * lu(k,2078) + lu(k,2092) = lu(k,2092) * lu(k,2078) + lu(k,2179) = lu(k,2179) - lu(k,2079) * lu(k,2177) + lu(k,2183) = lu(k,2183) - lu(k,2080) * lu(k,2177) + lu(k,2184) = lu(k,2184) - lu(k,2081) * lu(k,2177) + lu(k,2185) = lu(k,2185) - lu(k,2082) * lu(k,2177) + lu(k,2186) = lu(k,2186) - lu(k,2083) * lu(k,2177) + lu(k,2187) = lu(k,2187) - lu(k,2084) * lu(k,2177) + lu(k,2188) = lu(k,2188) - lu(k,2085) * lu(k,2177) + lu(k,2189) = lu(k,2189) - lu(k,2086) * lu(k,2177) + lu(k,2191) = lu(k,2191) - lu(k,2087) * lu(k,2177) + lu(k,2192) = lu(k,2192) - lu(k,2088) * lu(k,2177) + lu(k,2193) = lu(k,2193) - lu(k,2089) * lu(k,2177) + lu(k,2194) = lu(k,2194) - lu(k,2090) * lu(k,2177) + lu(k,2195) = lu(k,2195) - lu(k,2091) * lu(k,2177) + lu(k,2196) = lu(k,2196) - lu(k,2092) * lu(k,2177) + lu(k,2888) = lu(k,2888) - lu(k,2079) * lu(k,2886) + lu(k,2913) = lu(k,2913) - lu(k,2080) * lu(k,2886) + lu(k,2915) = lu(k,2915) - lu(k,2081) * lu(k,2886) + lu(k,2916) = lu(k,2916) - lu(k,2082) * lu(k,2886) + lu(k,2917) = - lu(k,2083) * lu(k,2886) + lu(k,2918) = lu(k,2918) - lu(k,2084) * lu(k,2886) + lu(k,2919) = lu(k,2919) - lu(k,2085) * lu(k,2886) + lu(k,2920) = lu(k,2920) - lu(k,2086) * lu(k,2886) + lu(k,2922) = lu(k,2922) - lu(k,2087) * lu(k,2886) + lu(k,2923) = lu(k,2923) - lu(k,2088) * lu(k,2886) + lu(k,2924) = lu(k,2924) - lu(k,2089) * lu(k,2886) + lu(k,2926) = - lu(k,2090) * lu(k,2886) + lu(k,2927) = lu(k,2927) - lu(k,2091) * lu(k,2886) + lu(k,2928) = lu(k,2928) - lu(k,2092) * lu(k,2886) + lu(k,3077) = lu(k,3077) - lu(k,2079) * lu(k,3075) + lu(k,3103) = lu(k,3103) - lu(k,2080) * lu(k,3075) + lu(k,3105) = lu(k,3105) - lu(k,2081) * lu(k,3075) + lu(k,3106) = lu(k,3106) - lu(k,2082) * lu(k,3075) + lu(k,3107) = - lu(k,2083) * lu(k,3075) + lu(k,3108) = lu(k,3108) - lu(k,2084) * lu(k,3075) + lu(k,3109) = lu(k,3109) - lu(k,2085) * lu(k,3075) + lu(k,3110) = lu(k,3110) - lu(k,2086) * lu(k,3075) + lu(k,3114) = lu(k,3114) - lu(k,2087) * lu(k,3075) + lu(k,3115) = lu(k,3115) - lu(k,2088) * lu(k,3075) + lu(k,3116) = lu(k,3116) - lu(k,2089) * lu(k,3075) + lu(k,3118) = lu(k,3118) - lu(k,2090) * lu(k,3075) + lu(k,3119) = lu(k,3119) - lu(k,2091) * lu(k,3075) + lu(k,3120) = lu(k,3120) - lu(k,2092) * lu(k,3075) + lu(k,3336) = lu(k,3336) - lu(k,2079) * lu(k,3334) + lu(k,3362) = lu(k,3362) - lu(k,2080) * lu(k,3334) + lu(k,3364) = lu(k,3364) - lu(k,2081) * lu(k,3334) + lu(k,3365) = lu(k,3365) - lu(k,2082) * lu(k,3334) + lu(k,3366) = lu(k,3366) - lu(k,2083) * lu(k,3334) + lu(k,3367) = lu(k,3367) - lu(k,2084) * lu(k,3334) + lu(k,3368) = lu(k,3368) - lu(k,2085) * lu(k,3334) + lu(k,3369) = lu(k,3369) - lu(k,2086) * lu(k,3334) + lu(k,3373) = lu(k,3373) - lu(k,2087) * lu(k,3334) + lu(k,3374) = lu(k,3374) - lu(k,2088) * lu(k,3334) + lu(k,3375) = lu(k,3375) - lu(k,2089) * lu(k,3334) + lu(k,3377) = lu(k,3377) - lu(k,2090) * lu(k,3334) + lu(k,3378) = lu(k,3378) - lu(k,2091) * lu(k,3334) + lu(k,3379) = lu(k,3379) - lu(k,2092) * lu(k,3334) + lu(k,3430) = lu(k,3430) - lu(k,2079) * lu(k,3428) + lu(k,3455) = lu(k,3455) - lu(k,2080) * lu(k,3428) + lu(k,3457) = lu(k,3457) - lu(k,2081) * lu(k,3428) + lu(k,3458) = lu(k,3458) - lu(k,2082) * lu(k,3428) + lu(k,3459) = - lu(k,2083) * lu(k,3428) + lu(k,3460) = lu(k,3460) - lu(k,2084) * lu(k,3428) + lu(k,3461) = lu(k,3461) - lu(k,2085) * lu(k,3428) + lu(k,3462) = lu(k,3462) - lu(k,2086) * lu(k,3428) + lu(k,3466) = lu(k,3466) - lu(k,2087) * lu(k,3428) + lu(k,3467) = lu(k,3467) - lu(k,2088) * lu(k,3428) + lu(k,3468) = lu(k,3468) - lu(k,2089) * lu(k,3428) + lu(k,3470) = lu(k,3470) - lu(k,2090) * lu(k,3428) + lu(k,3471) = lu(k,3471) - lu(k,2091) * lu(k,3428) + lu(k,3472) = lu(k,3472) - lu(k,2092) * lu(k,3428) + lu(k,3573) = lu(k,3573) - lu(k,2079) * lu(k,3571) + lu(k,3599) = lu(k,3599) - lu(k,2080) * lu(k,3571) + lu(k,3601) = lu(k,3601) - lu(k,2081) * lu(k,3571) + lu(k,3602) = lu(k,3602) - lu(k,2082) * lu(k,3571) + lu(k,3603) = lu(k,3603) - lu(k,2083) * lu(k,3571) + lu(k,3604) = lu(k,3604) - lu(k,2084) * lu(k,3571) + lu(k,3605) = lu(k,3605) - lu(k,2085) * lu(k,3571) + lu(k,3606) = lu(k,3606) - lu(k,2086) * lu(k,3571) + lu(k,3610) = lu(k,3610) - lu(k,2087) * lu(k,3571) + lu(k,3611) = lu(k,3611) - lu(k,2088) * lu(k,3571) + lu(k,3612) = lu(k,3612) - lu(k,2089) * lu(k,3571) + lu(k,3614) = lu(k,3614) - lu(k,2090) * lu(k,3571) + lu(k,3615) = lu(k,3615) - lu(k,2091) * lu(k,3571) + lu(k,3616) = lu(k,3616) - lu(k,2092) * lu(k,3571) + lu(k,3729) = lu(k,3729) - lu(k,2079) * lu(k,3727) + lu(k,3753) = lu(k,3753) - lu(k,2080) * lu(k,3727) + lu(k,3755) = lu(k,3755) - lu(k,2081) * lu(k,3727) + lu(k,3756) = lu(k,3756) - lu(k,2082) * lu(k,3727) + lu(k,3757) = lu(k,3757) - lu(k,2083) * lu(k,3727) + lu(k,3758) = lu(k,3758) - lu(k,2084) * lu(k,3727) + lu(k,3759) = lu(k,3759) - lu(k,2085) * lu(k,3727) + lu(k,3760) = lu(k,3760) - lu(k,2086) * lu(k,3727) + lu(k,3764) = lu(k,3764) - lu(k,2087) * lu(k,3727) + lu(k,3765) = lu(k,3765) - lu(k,2088) * lu(k,3727) + lu(k,3766) = lu(k,3766) - lu(k,2089) * lu(k,3727) + lu(k,3768) = lu(k,3768) - lu(k,2090) * lu(k,3727) + lu(k,3769) = lu(k,3769) - lu(k,2091) * lu(k,3727) + lu(k,3770) = lu(k,3770) - lu(k,2092) * lu(k,3727) + lu(k,4060) = lu(k,4060) - lu(k,2079) * lu(k,4058) + lu(k,4085) = lu(k,4085) - lu(k,2080) * lu(k,4058) + lu(k,4087) = lu(k,4087) - lu(k,2081) * lu(k,4058) + lu(k,4088) = lu(k,4088) - lu(k,2082) * lu(k,4058) + lu(k,4089) = lu(k,4089) - lu(k,2083) * lu(k,4058) + lu(k,4090) = lu(k,4090) - lu(k,2084) * lu(k,4058) + lu(k,4091) = lu(k,4091) - lu(k,2085) * lu(k,4058) + lu(k,4092) = lu(k,4092) - lu(k,2086) * lu(k,4058) + lu(k,4096) = lu(k,4096) - lu(k,2087) * lu(k,4058) + lu(k,4097) = lu(k,4097) - lu(k,2088) * lu(k,4058) + lu(k,4098) = lu(k,4098) - lu(k,2089) * lu(k,4058) + lu(k,4100) = lu(k,4100) - lu(k,2090) * lu(k,4058) + lu(k,4101) = lu(k,4101) - lu(k,2091) * lu(k,4058) + lu(k,4102) = lu(k,4102) - lu(k,2092) * lu(k,4058) + end do + end subroutine lu_fac43 + subroutine lu_fac44( 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,2110) = 1._r8 / lu(k,2110) + lu(k,2111) = lu(k,2111) * lu(k,2110) + lu(k,2112) = lu(k,2112) * lu(k,2110) + lu(k,2113) = lu(k,2113) * lu(k,2110) + lu(k,2114) = lu(k,2114) * lu(k,2110) + lu(k,2115) = lu(k,2115) * lu(k,2110) + lu(k,2116) = lu(k,2116) * lu(k,2110) + lu(k,2117) = lu(k,2117) * lu(k,2110) + lu(k,2118) = lu(k,2118) * lu(k,2110) + lu(k,2119) = lu(k,2119) * lu(k,2110) + lu(k,2120) = lu(k,2120) * lu(k,2110) + lu(k,2121) = lu(k,2121) * lu(k,2110) + lu(k,2122) = lu(k,2122) * lu(k,2110) + lu(k,2123) = lu(k,2123) * lu(k,2110) + lu(k,2124) = lu(k,2124) * lu(k,2110) + lu(k,2179) = lu(k,2179) - lu(k,2111) * lu(k,2178) + lu(k,2183) = lu(k,2183) - lu(k,2112) * lu(k,2178) + lu(k,2184) = lu(k,2184) - lu(k,2113) * lu(k,2178) + lu(k,2185) = lu(k,2185) - lu(k,2114) * lu(k,2178) + lu(k,2186) = lu(k,2186) - lu(k,2115) * lu(k,2178) + lu(k,2187) = lu(k,2187) - lu(k,2116) * lu(k,2178) + lu(k,2188) = lu(k,2188) - lu(k,2117) * lu(k,2178) + lu(k,2189) = lu(k,2189) - lu(k,2118) * lu(k,2178) + lu(k,2191) = lu(k,2191) - lu(k,2119) * lu(k,2178) + lu(k,2192) = lu(k,2192) - lu(k,2120) * lu(k,2178) + lu(k,2193) = lu(k,2193) - lu(k,2121) * lu(k,2178) + lu(k,2194) = lu(k,2194) - lu(k,2122) * lu(k,2178) + lu(k,2195) = lu(k,2195) - lu(k,2123) * lu(k,2178) + lu(k,2196) = lu(k,2196) - lu(k,2124) * lu(k,2178) + lu(k,2888) = lu(k,2888) - lu(k,2111) * lu(k,2887) + lu(k,2913) = lu(k,2913) - lu(k,2112) * lu(k,2887) + lu(k,2915) = lu(k,2915) - lu(k,2113) * lu(k,2887) + lu(k,2916) = lu(k,2916) - lu(k,2114) * lu(k,2887) + lu(k,2917) = lu(k,2917) - lu(k,2115) * lu(k,2887) + lu(k,2918) = lu(k,2918) - lu(k,2116) * lu(k,2887) + lu(k,2919) = lu(k,2919) - lu(k,2117) * lu(k,2887) + lu(k,2920) = lu(k,2920) - lu(k,2118) * lu(k,2887) + lu(k,2922) = lu(k,2922) - lu(k,2119) * lu(k,2887) + lu(k,2923) = lu(k,2923) - lu(k,2120) * lu(k,2887) + lu(k,2924) = lu(k,2924) - lu(k,2121) * lu(k,2887) + lu(k,2926) = lu(k,2926) - lu(k,2122) * lu(k,2887) + lu(k,2927) = lu(k,2927) - lu(k,2123) * lu(k,2887) + lu(k,2928) = lu(k,2928) - lu(k,2124) * lu(k,2887) + lu(k,3077) = lu(k,3077) - lu(k,2111) * lu(k,3076) + lu(k,3103) = lu(k,3103) - lu(k,2112) * lu(k,3076) + lu(k,3105) = lu(k,3105) - lu(k,2113) * lu(k,3076) + lu(k,3106) = lu(k,3106) - lu(k,2114) * lu(k,3076) + lu(k,3107) = lu(k,3107) - lu(k,2115) * lu(k,3076) + lu(k,3108) = lu(k,3108) - lu(k,2116) * lu(k,3076) + lu(k,3109) = lu(k,3109) - lu(k,2117) * lu(k,3076) + lu(k,3110) = lu(k,3110) - lu(k,2118) * lu(k,3076) + lu(k,3114) = lu(k,3114) - lu(k,2119) * lu(k,3076) + lu(k,3115) = lu(k,3115) - lu(k,2120) * lu(k,3076) + lu(k,3116) = lu(k,3116) - lu(k,2121) * lu(k,3076) + lu(k,3118) = lu(k,3118) - lu(k,2122) * lu(k,3076) + lu(k,3119) = lu(k,3119) - lu(k,2123) * lu(k,3076) + lu(k,3120) = lu(k,3120) - lu(k,2124) * lu(k,3076) + lu(k,3336) = lu(k,3336) - lu(k,2111) * lu(k,3335) + lu(k,3362) = lu(k,3362) - lu(k,2112) * lu(k,3335) + lu(k,3364) = lu(k,3364) - lu(k,2113) * lu(k,3335) + lu(k,3365) = lu(k,3365) - lu(k,2114) * lu(k,3335) + lu(k,3366) = lu(k,3366) - lu(k,2115) * lu(k,3335) + lu(k,3367) = lu(k,3367) - lu(k,2116) * lu(k,3335) + lu(k,3368) = lu(k,3368) - lu(k,2117) * lu(k,3335) + lu(k,3369) = lu(k,3369) - lu(k,2118) * lu(k,3335) + lu(k,3373) = lu(k,3373) - lu(k,2119) * lu(k,3335) + lu(k,3374) = lu(k,3374) - lu(k,2120) * lu(k,3335) + lu(k,3375) = lu(k,3375) - lu(k,2121) * lu(k,3335) + lu(k,3377) = lu(k,3377) - lu(k,2122) * lu(k,3335) + lu(k,3378) = lu(k,3378) - lu(k,2123) * lu(k,3335) + lu(k,3379) = lu(k,3379) - lu(k,2124) * lu(k,3335) + lu(k,3430) = lu(k,3430) - lu(k,2111) * lu(k,3429) + lu(k,3455) = lu(k,3455) - lu(k,2112) * lu(k,3429) + lu(k,3457) = lu(k,3457) - lu(k,2113) * lu(k,3429) + lu(k,3458) = lu(k,3458) - lu(k,2114) * lu(k,3429) + lu(k,3459) = lu(k,3459) - lu(k,2115) * lu(k,3429) + lu(k,3460) = lu(k,3460) - lu(k,2116) * lu(k,3429) + lu(k,3461) = lu(k,3461) - lu(k,2117) * lu(k,3429) + lu(k,3462) = lu(k,3462) - lu(k,2118) * lu(k,3429) + lu(k,3466) = lu(k,3466) - lu(k,2119) * lu(k,3429) + lu(k,3467) = lu(k,3467) - lu(k,2120) * lu(k,3429) + lu(k,3468) = lu(k,3468) - lu(k,2121) * lu(k,3429) + lu(k,3470) = lu(k,3470) - lu(k,2122) * lu(k,3429) + lu(k,3471) = lu(k,3471) - lu(k,2123) * lu(k,3429) + lu(k,3472) = lu(k,3472) - lu(k,2124) * lu(k,3429) + lu(k,3573) = lu(k,3573) - lu(k,2111) * lu(k,3572) + lu(k,3599) = lu(k,3599) - lu(k,2112) * lu(k,3572) + lu(k,3601) = lu(k,3601) - lu(k,2113) * lu(k,3572) + lu(k,3602) = lu(k,3602) - lu(k,2114) * lu(k,3572) + lu(k,3603) = lu(k,3603) - lu(k,2115) * lu(k,3572) + lu(k,3604) = lu(k,3604) - lu(k,2116) * lu(k,3572) + lu(k,3605) = lu(k,3605) - lu(k,2117) * lu(k,3572) + lu(k,3606) = lu(k,3606) - lu(k,2118) * lu(k,3572) + lu(k,3610) = lu(k,3610) - lu(k,2119) * lu(k,3572) + lu(k,3611) = lu(k,3611) - lu(k,2120) * lu(k,3572) + lu(k,3612) = lu(k,3612) - lu(k,2121) * lu(k,3572) + lu(k,3614) = lu(k,3614) - lu(k,2122) * lu(k,3572) + lu(k,3615) = lu(k,3615) - lu(k,2123) * lu(k,3572) + lu(k,3616) = lu(k,3616) - lu(k,2124) * lu(k,3572) + lu(k,3729) = lu(k,3729) - lu(k,2111) * lu(k,3728) + lu(k,3753) = lu(k,3753) - lu(k,2112) * lu(k,3728) + lu(k,3755) = lu(k,3755) - lu(k,2113) * lu(k,3728) + lu(k,3756) = lu(k,3756) - lu(k,2114) * lu(k,3728) + lu(k,3757) = lu(k,3757) - lu(k,2115) * lu(k,3728) + lu(k,3758) = lu(k,3758) - lu(k,2116) * lu(k,3728) + lu(k,3759) = lu(k,3759) - lu(k,2117) * lu(k,3728) + lu(k,3760) = lu(k,3760) - lu(k,2118) * lu(k,3728) + lu(k,3764) = lu(k,3764) - lu(k,2119) * lu(k,3728) + lu(k,3765) = lu(k,3765) - lu(k,2120) * lu(k,3728) + lu(k,3766) = lu(k,3766) - lu(k,2121) * lu(k,3728) + lu(k,3768) = lu(k,3768) - lu(k,2122) * lu(k,3728) + lu(k,3769) = lu(k,3769) - lu(k,2123) * lu(k,3728) + lu(k,3770) = lu(k,3770) - lu(k,2124) * lu(k,3728) + lu(k,4060) = lu(k,4060) - lu(k,2111) * lu(k,4059) + lu(k,4085) = lu(k,4085) - lu(k,2112) * lu(k,4059) + lu(k,4087) = lu(k,4087) - lu(k,2113) * lu(k,4059) + lu(k,4088) = lu(k,4088) - lu(k,2114) * lu(k,4059) + lu(k,4089) = lu(k,4089) - lu(k,2115) * lu(k,4059) + lu(k,4090) = lu(k,4090) - lu(k,2116) * lu(k,4059) + lu(k,4091) = lu(k,4091) - lu(k,2117) * lu(k,4059) + lu(k,4092) = lu(k,4092) - lu(k,2118) * lu(k,4059) + lu(k,4096) = lu(k,4096) - lu(k,2119) * lu(k,4059) + lu(k,4097) = lu(k,4097) - lu(k,2120) * lu(k,4059) + lu(k,4098) = lu(k,4098) - lu(k,2121) * lu(k,4059) + lu(k,4100) = lu(k,4100) - lu(k,2122) * lu(k,4059) + lu(k,4101) = lu(k,4101) - lu(k,2123) * lu(k,4059) + lu(k,4102) = lu(k,4102) - lu(k,2124) * lu(k,4059) + lu(k,2140) = 1._r8 / lu(k,2140) + lu(k,2141) = lu(k,2141) * lu(k,2140) + lu(k,2142) = lu(k,2142) * lu(k,2140) + lu(k,2143) = lu(k,2143) * lu(k,2140) + lu(k,2144) = lu(k,2144) * lu(k,2140) + lu(k,2145) = lu(k,2145) * lu(k,2140) + lu(k,2146) = lu(k,2146) * lu(k,2140) + lu(k,2147) = lu(k,2147) * lu(k,2140) + lu(k,2148) = lu(k,2148) * lu(k,2140) + lu(k,2149) = lu(k,2149) * lu(k,2140) + lu(k,2150) = lu(k,2150) * lu(k,2140) + lu(k,2151) = lu(k,2151) * lu(k,2140) + lu(k,2152) = lu(k,2152) * lu(k,2140) + lu(k,2153) = lu(k,2153) * lu(k,2140) + lu(k,2183) = lu(k,2183) - lu(k,2141) * lu(k,2179) + lu(k,2184) = lu(k,2184) - lu(k,2142) * lu(k,2179) + lu(k,2185) = lu(k,2185) - lu(k,2143) * lu(k,2179) + lu(k,2186) = lu(k,2186) - lu(k,2144) * lu(k,2179) + lu(k,2187) = lu(k,2187) - lu(k,2145) * lu(k,2179) + lu(k,2188) = lu(k,2188) - lu(k,2146) * lu(k,2179) + lu(k,2189) = lu(k,2189) - lu(k,2147) * lu(k,2179) + lu(k,2191) = lu(k,2191) - lu(k,2148) * lu(k,2179) + lu(k,2192) = lu(k,2192) - lu(k,2149) * lu(k,2179) + lu(k,2193) = lu(k,2193) - lu(k,2150) * lu(k,2179) + lu(k,2194) = lu(k,2194) - lu(k,2151) * lu(k,2179) + lu(k,2195) = lu(k,2195) - lu(k,2152) * lu(k,2179) + lu(k,2196) = lu(k,2196) - lu(k,2153) * lu(k,2179) + lu(k,2913) = lu(k,2913) - lu(k,2141) * lu(k,2888) + lu(k,2915) = lu(k,2915) - lu(k,2142) * lu(k,2888) + lu(k,2916) = lu(k,2916) - lu(k,2143) * lu(k,2888) + lu(k,2917) = lu(k,2917) - lu(k,2144) * lu(k,2888) + lu(k,2918) = lu(k,2918) - lu(k,2145) * lu(k,2888) + lu(k,2919) = lu(k,2919) - lu(k,2146) * lu(k,2888) + lu(k,2920) = lu(k,2920) - lu(k,2147) * lu(k,2888) + lu(k,2922) = lu(k,2922) - lu(k,2148) * lu(k,2888) + lu(k,2923) = lu(k,2923) - lu(k,2149) * lu(k,2888) + lu(k,2924) = lu(k,2924) - lu(k,2150) * lu(k,2888) + lu(k,2926) = lu(k,2926) - lu(k,2151) * lu(k,2888) + lu(k,2927) = lu(k,2927) - lu(k,2152) * lu(k,2888) + lu(k,2928) = lu(k,2928) - lu(k,2153) * lu(k,2888) + lu(k,3103) = lu(k,3103) - lu(k,2141) * lu(k,3077) + lu(k,3105) = lu(k,3105) - lu(k,2142) * lu(k,3077) + lu(k,3106) = lu(k,3106) - lu(k,2143) * lu(k,3077) + lu(k,3107) = lu(k,3107) - lu(k,2144) * lu(k,3077) + lu(k,3108) = lu(k,3108) - lu(k,2145) * lu(k,3077) + lu(k,3109) = lu(k,3109) - lu(k,2146) * lu(k,3077) + lu(k,3110) = lu(k,3110) - lu(k,2147) * lu(k,3077) + lu(k,3114) = lu(k,3114) - lu(k,2148) * lu(k,3077) + lu(k,3115) = lu(k,3115) - lu(k,2149) * lu(k,3077) + lu(k,3116) = lu(k,3116) - lu(k,2150) * lu(k,3077) + lu(k,3118) = lu(k,3118) - lu(k,2151) * lu(k,3077) + lu(k,3119) = lu(k,3119) - lu(k,2152) * lu(k,3077) + lu(k,3120) = lu(k,3120) - lu(k,2153) * lu(k,3077) + lu(k,3362) = lu(k,3362) - lu(k,2141) * lu(k,3336) + lu(k,3364) = lu(k,3364) - lu(k,2142) * lu(k,3336) + lu(k,3365) = lu(k,3365) - lu(k,2143) * lu(k,3336) + lu(k,3366) = lu(k,3366) - lu(k,2144) * lu(k,3336) + lu(k,3367) = lu(k,3367) - lu(k,2145) * lu(k,3336) + lu(k,3368) = lu(k,3368) - lu(k,2146) * lu(k,3336) + lu(k,3369) = lu(k,3369) - lu(k,2147) * lu(k,3336) + lu(k,3373) = lu(k,3373) - lu(k,2148) * lu(k,3336) + lu(k,3374) = lu(k,3374) - lu(k,2149) * lu(k,3336) + lu(k,3375) = lu(k,3375) - lu(k,2150) * lu(k,3336) + lu(k,3377) = lu(k,3377) - lu(k,2151) * lu(k,3336) + lu(k,3378) = lu(k,3378) - lu(k,2152) * lu(k,3336) + lu(k,3379) = lu(k,3379) - lu(k,2153) * lu(k,3336) + lu(k,3455) = lu(k,3455) - lu(k,2141) * lu(k,3430) + lu(k,3457) = lu(k,3457) - lu(k,2142) * lu(k,3430) + lu(k,3458) = lu(k,3458) - lu(k,2143) * lu(k,3430) + lu(k,3459) = lu(k,3459) - lu(k,2144) * lu(k,3430) + lu(k,3460) = lu(k,3460) - lu(k,2145) * lu(k,3430) + lu(k,3461) = lu(k,3461) - lu(k,2146) * lu(k,3430) + lu(k,3462) = lu(k,3462) - lu(k,2147) * lu(k,3430) + lu(k,3466) = lu(k,3466) - lu(k,2148) * lu(k,3430) + lu(k,3467) = lu(k,3467) - lu(k,2149) * lu(k,3430) + lu(k,3468) = lu(k,3468) - lu(k,2150) * lu(k,3430) + lu(k,3470) = lu(k,3470) - lu(k,2151) * lu(k,3430) + lu(k,3471) = lu(k,3471) - lu(k,2152) * lu(k,3430) + lu(k,3472) = lu(k,3472) - lu(k,2153) * lu(k,3430) + lu(k,3599) = lu(k,3599) - lu(k,2141) * lu(k,3573) + lu(k,3601) = lu(k,3601) - lu(k,2142) * lu(k,3573) + lu(k,3602) = lu(k,3602) - lu(k,2143) * lu(k,3573) + lu(k,3603) = lu(k,3603) - lu(k,2144) * lu(k,3573) + lu(k,3604) = lu(k,3604) - lu(k,2145) * lu(k,3573) + lu(k,3605) = lu(k,3605) - lu(k,2146) * lu(k,3573) + lu(k,3606) = lu(k,3606) - lu(k,2147) * lu(k,3573) + lu(k,3610) = lu(k,3610) - lu(k,2148) * lu(k,3573) + lu(k,3611) = lu(k,3611) - lu(k,2149) * lu(k,3573) + lu(k,3612) = lu(k,3612) - lu(k,2150) * lu(k,3573) + lu(k,3614) = lu(k,3614) - lu(k,2151) * lu(k,3573) + lu(k,3615) = lu(k,3615) - lu(k,2152) * lu(k,3573) + lu(k,3616) = lu(k,3616) - lu(k,2153) * lu(k,3573) + lu(k,3753) = lu(k,3753) - lu(k,2141) * lu(k,3729) + lu(k,3755) = lu(k,3755) - lu(k,2142) * lu(k,3729) + lu(k,3756) = lu(k,3756) - lu(k,2143) * lu(k,3729) + lu(k,3757) = lu(k,3757) - lu(k,2144) * lu(k,3729) + lu(k,3758) = lu(k,3758) - lu(k,2145) * lu(k,3729) + lu(k,3759) = lu(k,3759) - lu(k,2146) * lu(k,3729) + lu(k,3760) = lu(k,3760) - lu(k,2147) * lu(k,3729) + lu(k,3764) = lu(k,3764) - lu(k,2148) * lu(k,3729) + lu(k,3765) = lu(k,3765) - lu(k,2149) * lu(k,3729) + lu(k,3766) = lu(k,3766) - lu(k,2150) * lu(k,3729) + lu(k,3768) = lu(k,3768) - lu(k,2151) * lu(k,3729) + lu(k,3769) = lu(k,3769) - lu(k,2152) * lu(k,3729) + lu(k,3770) = lu(k,3770) - lu(k,2153) * lu(k,3729) + lu(k,4085) = lu(k,4085) - lu(k,2141) * lu(k,4060) + lu(k,4087) = lu(k,4087) - lu(k,2142) * lu(k,4060) + lu(k,4088) = lu(k,4088) - lu(k,2143) * lu(k,4060) + lu(k,4089) = lu(k,4089) - lu(k,2144) * lu(k,4060) + lu(k,4090) = lu(k,4090) - lu(k,2145) * lu(k,4060) + lu(k,4091) = lu(k,4091) - lu(k,2146) * lu(k,4060) + lu(k,4092) = lu(k,4092) - lu(k,2147) * lu(k,4060) + lu(k,4096) = lu(k,4096) - lu(k,2148) * lu(k,4060) + lu(k,4097) = lu(k,4097) - lu(k,2149) * lu(k,4060) + lu(k,4098) = lu(k,4098) - lu(k,2150) * lu(k,4060) + lu(k,4100) = lu(k,4100) - lu(k,2151) * lu(k,4060) + lu(k,4101) = lu(k,4101) - lu(k,2152) * lu(k,4060) + lu(k,4102) = lu(k,4102) - lu(k,2153) * lu(k,4060) + lu(k,2180) = 1._r8 / lu(k,2180) + lu(k,2181) = lu(k,2181) * lu(k,2180) + lu(k,2182) = lu(k,2182) * lu(k,2180) + lu(k,2183) = lu(k,2183) * lu(k,2180) + lu(k,2184) = lu(k,2184) * lu(k,2180) + lu(k,2185) = lu(k,2185) * lu(k,2180) + lu(k,2186) = lu(k,2186) * lu(k,2180) + lu(k,2187) = lu(k,2187) * lu(k,2180) + lu(k,2188) = lu(k,2188) * lu(k,2180) + lu(k,2189) = lu(k,2189) * lu(k,2180) + lu(k,2190) = lu(k,2190) * lu(k,2180) + lu(k,2191) = lu(k,2191) * lu(k,2180) + lu(k,2192) = lu(k,2192) * lu(k,2180) + lu(k,2193) = lu(k,2193) * lu(k,2180) + lu(k,2194) = lu(k,2194) * lu(k,2180) + lu(k,2195) = lu(k,2195) * lu(k,2180) + lu(k,2196) = lu(k,2196) * lu(k,2180) + lu(k,2892) = lu(k,2892) - lu(k,2181) * lu(k,2889) + lu(k,2893) = lu(k,2893) - lu(k,2182) * lu(k,2889) + lu(k,2913) = lu(k,2913) - lu(k,2183) * lu(k,2889) + lu(k,2915) = lu(k,2915) - lu(k,2184) * lu(k,2889) + lu(k,2916) = lu(k,2916) - lu(k,2185) * lu(k,2889) + lu(k,2917) = lu(k,2917) - lu(k,2186) * lu(k,2889) + lu(k,2918) = lu(k,2918) - lu(k,2187) * lu(k,2889) + lu(k,2919) = lu(k,2919) - lu(k,2188) * lu(k,2889) + lu(k,2920) = lu(k,2920) - lu(k,2189) * lu(k,2889) + lu(k,2921) = lu(k,2921) - lu(k,2190) * lu(k,2889) + lu(k,2922) = lu(k,2922) - lu(k,2191) * lu(k,2889) + lu(k,2923) = lu(k,2923) - lu(k,2192) * lu(k,2889) + lu(k,2924) = lu(k,2924) - lu(k,2193) * lu(k,2889) + lu(k,2926) = lu(k,2926) - lu(k,2194) * lu(k,2889) + lu(k,2927) = lu(k,2927) - lu(k,2195) * lu(k,2889) + lu(k,2928) = lu(k,2928) - lu(k,2196) * lu(k,2889) + lu(k,3082) = lu(k,3082) - lu(k,2181) * lu(k,3078) + lu(k,3083) = lu(k,3083) - lu(k,2182) * lu(k,3078) + lu(k,3103) = lu(k,3103) - lu(k,2183) * lu(k,3078) + lu(k,3105) = lu(k,3105) - lu(k,2184) * lu(k,3078) + lu(k,3106) = lu(k,3106) - lu(k,2185) * lu(k,3078) + lu(k,3107) = lu(k,3107) - lu(k,2186) * lu(k,3078) + lu(k,3108) = lu(k,3108) - lu(k,2187) * lu(k,3078) + lu(k,3109) = lu(k,3109) - lu(k,2188) * lu(k,3078) + lu(k,3110) = lu(k,3110) - lu(k,2189) * lu(k,3078) + lu(k,3111) = lu(k,3111) - lu(k,2190) * lu(k,3078) + lu(k,3114) = lu(k,3114) - lu(k,2191) * lu(k,3078) + lu(k,3115) = lu(k,3115) - lu(k,2192) * lu(k,3078) + lu(k,3116) = lu(k,3116) - lu(k,2193) * lu(k,3078) + lu(k,3118) = lu(k,3118) - lu(k,2194) * lu(k,3078) + lu(k,3119) = lu(k,3119) - lu(k,2195) * lu(k,3078) + lu(k,3120) = lu(k,3120) - lu(k,2196) * lu(k,3078) + lu(k,3341) = lu(k,3341) - lu(k,2181) * lu(k,3337) + lu(k,3342) = lu(k,3342) - lu(k,2182) * lu(k,3337) + lu(k,3362) = lu(k,3362) - lu(k,2183) * lu(k,3337) + lu(k,3364) = lu(k,3364) - lu(k,2184) * lu(k,3337) + lu(k,3365) = lu(k,3365) - lu(k,2185) * lu(k,3337) + lu(k,3366) = lu(k,3366) - lu(k,2186) * lu(k,3337) + lu(k,3367) = lu(k,3367) - lu(k,2187) * lu(k,3337) + lu(k,3368) = lu(k,3368) - lu(k,2188) * lu(k,3337) + lu(k,3369) = lu(k,3369) - lu(k,2189) * lu(k,3337) + lu(k,3370) = lu(k,3370) - lu(k,2190) * lu(k,3337) + lu(k,3373) = lu(k,3373) - lu(k,2191) * lu(k,3337) + lu(k,3374) = lu(k,3374) - lu(k,2192) * lu(k,3337) + lu(k,3375) = lu(k,3375) - lu(k,2193) * lu(k,3337) + lu(k,3377) = lu(k,3377) - lu(k,2194) * lu(k,3337) + lu(k,3378) = lu(k,3378) - lu(k,2195) * lu(k,3337) + lu(k,3379) = lu(k,3379) - lu(k,2196) * lu(k,3337) + lu(k,3434) = lu(k,3434) - lu(k,2181) * lu(k,3431) + lu(k,3435) = lu(k,3435) - lu(k,2182) * lu(k,3431) + lu(k,3455) = lu(k,3455) - lu(k,2183) * lu(k,3431) + lu(k,3457) = lu(k,3457) - lu(k,2184) * lu(k,3431) + lu(k,3458) = lu(k,3458) - lu(k,2185) * lu(k,3431) + lu(k,3459) = lu(k,3459) - lu(k,2186) * lu(k,3431) + lu(k,3460) = lu(k,3460) - lu(k,2187) * lu(k,3431) + lu(k,3461) = lu(k,3461) - lu(k,2188) * lu(k,3431) + lu(k,3462) = lu(k,3462) - lu(k,2189) * lu(k,3431) + lu(k,3463) = lu(k,3463) - lu(k,2190) * lu(k,3431) + lu(k,3466) = lu(k,3466) - lu(k,2191) * lu(k,3431) + lu(k,3467) = lu(k,3467) - lu(k,2192) * lu(k,3431) + lu(k,3468) = lu(k,3468) - lu(k,2193) * lu(k,3431) + lu(k,3470) = lu(k,3470) - lu(k,2194) * lu(k,3431) + lu(k,3471) = lu(k,3471) - lu(k,2195) * lu(k,3431) + lu(k,3472) = lu(k,3472) - lu(k,2196) * lu(k,3431) + lu(k,3578) = lu(k,3578) - lu(k,2181) * lu(k,3574) + lu(k,3579) = lu(k,3579) - lu(k,2182) * lu(k,3574) + lu(k,3599) = lu(k,3599) - lu(k,2183) * lu(k,3574) + lu(k,3601) = lu(k,3601) - lu(k,2184) * lu(k,3574) + lu(k,3602) = lu(k,3602) - lu(k,2185) * lu(k,3574) + lu(k,3603) = lu(k,3603) - lu(k,2186) * lu(k,3574) + lu(k,3604) = lu(k,3604) - lu(k,2187) * lu(k,3574) + lu(k,3605) = lu(k,3605) - lu(k,2188) * lu(k,3574) + lu(k,3606) = lu(k,3606) - lu(k,2189) * lu(k,3574) + lu(k,3607) = lu(k,3607) - lu(k,2190) * lu(k,3574) + lu(k,3610) = lu(k,3610) - lu(k,2191) * lu(k,3574) + lu(k,3611) = lu(k,3611) - lu(k,2192) * lu(k,3574) + lu(k,3612) = lu(k,3612) - lu(k,2193) * lu(k,3574) + lu(k,3614) = lu(k,3614) - lu(k,2194) * lu(k,3574) + lu(k,3615) = lu(k,3615) - lu(k,2195) * lu(k,3574) + lu(k,3616) = lu(k,3616) - lu(k,2196) * lu(k,3574) + lu(k,3733) = lu(k,3733) - lu(k,2181) * lu(k,3730) + lu(k,3734) = lu(k,3734) - lu(k,2182) * lu(k,3730) + lu(k,3753) = lu(k,3753) - lu(k,2183) * lu(k,3730) + lu(k,3755) = lu(k,3755) - lu(k,2184) * lu(k,3730) + lu(k,3756) = lu(k,3756) - lu(k,2185) * lu(k,3730) + lu(k,3757) = lu(k,3757) - lu(k,2186) * lu(k,3730) + lu(k,3758) = lu(k,3758) - lu(k,2187) * lu(k,3730) + lu(k,3759) = lu(k,3759) - lu(k,2188) * lu(k,3730) + lu(k,3760) = lu(k,3760) - lu(k,2189) * lu(k,3730) + lu(k,3761) = lu(k,3761) - lu(k,2190) * lu(k,3730) + lu(k,3764) = lu(k,3764) - lu(k,2191) * lu(k,3730) + lu(k,3765) = lu(k,3765) - lu(k,2192) * lu(k,3730) + lu(k,3766) = lu(k,3766) - lu(k,2193) * lu(k,3730) + lu(k,3768) = lu(k,3768) - lu(k,2194) * lu(k,3730) + lu(k,3769) = lu(k,3769) - lu(k,2195) * lu(k,3730) + lu(k,3770) = lu(k,3770) - lu(k,2196) * lu(k,3730) + lu(k,4064) = lu(k,4064) - lu(k,2181) * lu(k,4061) + lu(k,4065) = lu(k,4065) - lu(k,2182) * lu(k,4061) + lu(k,4085) = lu(k,4085) - lu(k,2183) * lu(k,4061) + lu(k,4087) = lu(k,4087) - lu(k,2184) * lu(k,4061) + lu(k,4088) = lu(k,4088) - lu(k,2185) * lu(k,4061) + lu(k,4089) = lu(k,4089) - lu(k,2186) * lu(k,4061) + lu(k,4090) = lu(k,4090) - lu(k,2187) * lu(k,4061) + lu(k,4091) = lu(k,4091) - lu(k,2188) * lu(k,4061) + lu(k,4092) = lu(k,4092) - lu(k,2189) * lu(k,4061) + lu(k,4093) = lu(k,4093) - lu(k,2190) * lu(k,4061) + lu(k,4096) = lu(k,4096) - lu(k,2191) * lu(k,4061) + lu(k,4097) = lu(k,4097) - lu(k,2192) * lu(k,4061) + lu(k,4098) = lu(k,4098) - lu(k,2193) * lu(k,4061) + lu(k,4100) = lu(k,4100) - lu(k,2194) * lu(k,4061) + lu(k,4101) = lu(k,4101) - lu(k,2195) * lu(k,4061) + lu(k,4102) = lu(k,4102) - lu(k,2196) * lu(k,4061) + lu(k,2199) = 1._r8 / lu(k,2199) + lu(k,2200) = lu(k,2200) * lu(k,2199) + lu(k,2201) = lu(k,2201) * lu(k,2199) + lu(k,2202) = lu(k,2202) * lu(k,2199) + lu(k,2203) = lu(k,2203) * lu(k,2199) + lu(k,2204) = lu(k,2204) * lu(k,2199) + lu(k,2205) = lu(k,2205) * lu(k,2199) + lu(k,2206) = lu(k,2206) * lu(k,2199) + lu(k,2207) = lu(k,2207) * lu(k,2199) + lu(k,2208) = lu(k,2208) * lu(k,2199) + lu(k,3104) = lu(k,3104) - lu(k,2200) * lu(k,3079) + lu(k,3108) = lu(k,3108) - lu(k,2201) * lu(k,3079) + lu(k,3109) = lu(k,3109) - lu(k,2202) * lu(k,3079) + lu(k,3110) = lu(k,3110) - lu(k,2203) * lu(k,3079) + lu(k,3112) = lu(k,3112) - lu(k,2204) * lu(k,3079) + lu(k,3116) = lu(k,3116) - lu(k,2205) * lu(k,3079) + lu(k,3117) = lu(k,3117) - lu(k,2206) * lu(k,3079) + lu(k,3119) = lu(k,3119) - lu(k,2207) * lu(k,3079) + lu(k,3120) = lu(k,3120) - lu(k,2208) * lu(k,3079) + lu(k,3127) = lu(k,3127) - lu(k,2200) * lu(k,3126) + lu(k,3130) = lu(k,3130) - lu(k,2201) * lu(k,3126) + lu(k,3131) = - lu(k,2202) * lu(k,3126) + lu(k,3132) = - lu(k,2203) * lu(k,3126) + lu(k,3134) = lu(k,3134) - lu(k,2204) * lu(k,3126) + lu(k,3138) = - lu(k,2205) * lu(k,3126) + lu(k,3139) = lu(k,3139) - lu(k,2206) * lu(k,3126) + lu(k,3141) = lu(k,3141) - lu(k,2207) * lu(k,3126) + lu(k,3142) = lu(k,3142) - lu(k,2208) * lu(k,3126) + lu(k,3157) = lu(k,3157) - lu(k,2200) * lu(k,3155) + lu(k,3161) = lu(k,3161) - lu(k,2201) * lu(k,3155) + lu(k,3162) = lu(k,3162) - lu(k,2202) * lu(k,3155) + lu(k,3163) = lu(k,3163) - lu(k,2203) * lu(k,3155) + lu(k,3165) = lu(k,3165) - lu(k,2204) * lu(k,3155) + lu(k,3169) = lu(k,3169) - lu(k,2205) * lu(k,3155) + lu(k,3170) = lu(k,3170) - lu(k,2206) * lu(k,3155) + lu(k,3172) = lu(k,3172) - lu(k,2207) * lu(k,3155) + lu(k,3173) = lu(k,3173) - lu(k,2208) * lu(k,3155) + lu(k,3183) = lu(k,3183) - lu(k,2200) * lu(k,3181) + lu(k,3187) = lu(k,3187) - lu(k,2201) * lu(k,3181) + lu(k,3188) = lu(k,3188) - lu(k,2202) * lu(k,3181) + lu(k,3189) = lu(k,3189) - lu(k,2203) * lu(k,3181) + lu(k,3191) = lu(k,3191) - lu(k,2204) * lu(k,3181) + lu(k,3195) = - lu(k,2205) * lu(k,3181) + lu(k,3196) = lu(k,3196) - lu(k,2206) * lu(k,3181) + lu(k,3198) = lu(k,3198) - lu(k,2207) * lu(k,3181) + lu(k,3199) = lu(k,3199) - lu(k,2208) * lu(k,3181) + lu(k,3363) = lu(k,3363) - lu(k,2200) * lu(k,3338) + lu(k,3367) = lu(k,3367) - lu(k,2201) * lu(k,3338) + lu(k,3368) = lu(k,3368) - lu(k,2202) * lu(k,3338) + lu(k,3369) = lu(k,3369) - lu(k,2203) * lu(k,3338) + lu(k,3371) = lu(k,3371) - lu(k,2204) * lu(k,3338) + lu(k,3375) = lu(k,3375) - lu(k,2205) * lu(k,3338) + lu(k,3376) = lu(k,3376) - lu(k,2206) * lu(k,3338) + lu(k,3378) = lu(k,3378) - lu(k,2207) * lu(k,3338) + lu(k,3379) = lu(k,3379) - lu(k,2208) * lu(k,3338) + lu(k,3480) = lu(k,3480) - lu(k,2200) * lu(k,3479) + lu(k,3484) = lu(k,3484) - lu(k,2201) * lu(k,3479) + lu(k,3485) = - lu(k,2202) * lu(k,3479) + lu(k,3486) = lu(k,3486) - lu(k,2203) * lu(k,3479) + lu(k,3488) = lu(k,3488) - lu(k,2204) * lu(k,3479) + lu(k,3492) = lu(k,3492) - lu(k,2205) * lu(k,3479) + lu(k,3493) = - lu(k,2206) * lu(k,3479) + lu(k,3495) = lu(k,3495) - lu(k,2207) * lu(k,3479) + lu(k,3496) = lu(k,3496) - lu(k,2208) * lu(k,3479) + lu(k,3506) = lu(k,3506) - lu(k,2200) * lu(k,3505) + lu(k,3510) = lu(k,3510) - lu(k,2201) * lu(k,3505) + lu(k,3511) = lu(k,3511) - lu(k,2202) * lu(k,3505) + lu(k,3512) = lu(k,3512) - lu(k,2203) * lu(k,3505) + lu(k,3514) = lu(k,3514) - lu(k,2204) * lu(k,3505) + lu(k,3518) = lu(k,3518) - lu(k,2205) * lu(k,3505) + lu(k,3519) = - lu(k,2206) * lu(k,3505) + lu(k,3521) = lu(k,3521) - lu(k,2207) * lu(k,3505) + lu(k,3522) = lu(k,3522) - lu(k,2208) * lu(k,3505) + lu(k,3600) = lu(k,3600) - lu(k,2200) * lu(k,3575) + lu(k,3604) = lu(k,3604) - lu(k,2201) * lu(k,3575) + lu(k,3605) = lu(k,3605) - lu(k,2202) * lu(k,3575) + lu(k,3606) = lu(k,3606) - lu(k,2203) * lu(k,3575) + lu(k,3608) = lu(k,3608) - lu(k,2204) * lu(k,3575) + lu(k,3612) = lu(k,3612) - lu(k,2205) * lu(k,3575) + lu(k,3613) = - lu(k,2206) * lu(k,3575) + lu(k,3615) = lu(k,3615) - lu(k,2207) * lu(k,3575) + lu(k,3616) = lu(k,3616) - lu(k,2208) * lu(k,3575) + lu(k,3652) = lu(k,3652) - lu(k,2200) * lu(k,3645) + lu(k,3656) = lu(k,3656) - lu(k,2201) * lu(k,3645) + lu(k,3657) = lu(k,3657) - lu(k,2202) * lu(k,3645) + lu(k,3658) = lu(k,3658) - lu(k,2203) * lu(k,3645) + lu(k,3660) = lu(k,3660) - lu(k,2204) * lu(k,3645) + lu(k,3664) = lu(k,3664) - lu(k,2205) * lu(k,3645) + lu(k,3665) = lu(k,3665) - lu(k,2206) * lu(k,3645) + lu(k,3667) = lu(k,3667) - lu(k,2207) * lu(k,3645) + lu(k,3668) = lu(k,3668) - lu(k,2208) * lu(k,3645) + lu(k,3754) = lu(k,3754) - lu(k,2200) * lu(k,3731) + lu(k,3758) = lu(k,3758) - lu(k,2201) * lu(k,3731) + lu(k,3759) = lu(k,3759) - lu(k,2202) * lu(k,3731) + lu(k,3760) = lu(k,3760) - lu(k,2203) * lu(k,3731) + lu(k,3762) = lu(k,3762) - lu(k,2204) * lu(k,3731) + lu(k,3766) = lu(k,3766) - lu(k,2205) * lu(k,3731) + lu(k,3767) = lu(k,3767) - lu(k,2206) * lu(k,3731) + lu(k,3769) = lu(k,3769) - lu(k,2207) * lu(k,3731) + lu(k,3770) = lu(k,3770) - lu(k,2208) * lu(k,3731) + lu(k,3795) = lu(k,3795) - lu(k,2200) * lu(k,3793) + lu(k,3799) = lu(k,3799) - lu(k,2201) * lu(k,3793) + lu(k,3800) = lu(k,3800) - lu(k,2202) * lu(k,3793) + lu(k,3801) = lu(k,3801) - lu(k,2203) * lu(k,3793) + lu(k,3803) = lu(k,3803) - lu(k,2204) * lu(k,3793) + lu(k,3807) = lu(k,3807) - lu(k,2205) * lu(k,3793) + lu(k,3808) = lu(k,3808) - lu(k,2206) * lu(k,3793) + lu(k,3810) = lu(k,3810) - lu(k,2207) * lu(k,3793) + lu(k,3811) = lu(k,3811) - lu(k,2208) * lu(k,3793) + lu(k,3836) = lu(k,3836) - lu(k,2200) * lu(k,3833) + lu(k,3840) = lu(k,3840) - lu(k,2201) * lu(k,3833) + lu(k,3841) = lu(k,3841) - lu(k,2202) * lu(k,3833) + lu(k,3842) = lu(k,3842) - lu(k,2203) * lu(k,3833) + lu(k,3844) = - lu(k,2204) * lu(k,3833) + lu(k,3848) = lu(k,3848) - lu(k,2205) * lu(k,3833) + lu(k,3849) = lu(k,3849) - lu(k,2206) * lu(k,3833) + lu(k,3851) = lu(k,3851) - lu(k,2207) * lu(k,3833) + lu(k,3852) = lu(k,3852) - lu(k,2208) * lu(k,3833) + lu(k,4086) = lu(k,4086) - lu(k,2200) * lu(k,4062) + lu(k,4090) = lu(k,4090) - lu(k,2201) * lu(k,4062) + lu(k,4091) = lu(k,4091) - lu(k,2202) * lu(k,4062) + lu(k,4092) = lu(k,4092) - lu(k,2203) * lu(k,4062) + lu(k,4094) = lu(k,4094) - lu(k,2204) * lu(k,4062) + lu(k,4098) = lu(k,4098) - lu(k,2205) * lu(k,4062) + lu(k,4099) = lu(k,4099) - lu(k,2206) * lu(k,4062) + lu(k,4101) = lu(k,4101) - lu(k,2207) * lu(k,4062) + lu(k,4102) = lu(k,4102) - lu(k,2208) * lu(k,4062) + lu(k,4112) = lu(k,4112) - lu(k,2200) * lu(k,4110) + lu(k,4116) = lu(k,4116) - lu(k,2201) * lu(k,4110) + lu(k,4117) = - lu(k,2202) * lu(k,4110) + lu(k,4118) = lu(k,4118) - lu(k,2203) * lu(k,4110) + lu(k,4120) = lu(k,4120) - lu(k,2204) * lu(k,4110) + lu(k,4124) = lu(k,4124) - lu(k,2205) * lu(k,4110) + lu(k,4125) = lu(k,4125) - lu(k,2206) * lu(k,4110) + lu(k,4127) = lu(k,4127) - lu(k,2207) * lu(k,4110) + lu(k,4128) = lu(k,4128) - lu(k,2208) * lu(k,4110) + end do + end subroutine lu_fac44 + subroutine lu_fac45( 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,2213) = 1._r8 / lu(k,2213) + lu(k,2214) = lu(k,2214) * lu(k,2213) + lu(k,2215) = lu(k,2215) * lu(k,2213) + lu(k,2216) = lu(k,2216) * lu(k,2213) + lu(k,2217) = lu(k,2217) * lu(k,2213) + lu(k,2218) = lu(k,2218) * lu(k,2213) + lu(k,2219) = lu(k,2219) * lu(k,2213) + lu(k,2220) = lu(k,2220) * lu(k,2213) + lu(k,2221) = lu(k,2221) * lu(k,2213) + lu(k,2222) = lu(k,2222) * lu(k,2213) + lu(k,2223) = lu(k,2223) * lu(k,2213) + lu(k,2224) = lu(k,2224) * lu(k,2213) + lu(k,2225) = lu(k,2225) * lu(k,2213) + lu(k,2226) = lu(k,2226) * lu(k,2213) + lu(k,2227) = lu(k,2227) * lu(k,2213) + lu(k,2228) = lu(k,2228) * lu(k,2213) + lu(k,2229) = lu(k,2229) * lu(k,2213) + lu(k,2740) = lu(k,2740) - lu(k,2214) * lu(k,2726) + lu(k,2742) = lu(k,2742) - lu(k,2215) * lu(k,2726) + lu(k,2743) = lu(k,2743) - lu(k,2216) * lu(k,2726) + lu(k,2744) = lu(k,2744) - lu(k,2217) * lu(k,2726) + lu(k,2745) = lu(k,2745) - lu(k,2218) * lu(k,2726) + lu(k,2746) = lu(k,2746) - lu(k,2219) * lu(k,2726) + lu(k,2747) = lu(k,2747) - lu(k,2220) * lu(k,2726) + lu(k,2748) = lu(k,2748) - lu(k,2221) * lu(k,2726) + lu(k,2750) = lu(k,2750) - lu(k,2222) * lu(k,2726) + lu(k,2752) = lu(k,2752) - lu(k,2223) * lu(k,2726) + lu(k,2753) = lu(k,2753) - lu(k,2224) * lu(k,2726) + lu(k,2754) = lu(k,2754) - lu(k,2225) * lu(k,2726) + lu(k,2755) = lu(k,2755) - lu(k,2226) * lu(k,2726) + lu(k,2756) = lu(k,2756) - lu(k,2227) * lu(k,2726) + lu(k,2757) = lu(k,2757) - lu(k,2228) * lu(k,2726) + lu(k,2760) = lu(k,2760) - lu(k,2229) * lu(k,2726) + lu(k,2786) = lu(k,2786) - lu(k,2214) * lu(k,2772) + lu(k,2788) = lu(k,2788) - lu(k,2215) * lu(k,2772) + lu(k,2789) = lu(k,2789) - lu(k,2216) * lu(k,2772) + lu(k,2790) = lu(k,2790) - lu(k,2217) * lu(k,2772) + lu(k,2791) = lu(k,2791) - lu(k,2218) * lu(k,2772) + lu(k,2792) = lu(k,2792) - lu(k,2219) * lu(k,2772) + lu(k,2793) = lu(k,2793) - lu(k,2220) * lu(k,2772) + lu(k,2794) = lu(k,2794) - lu(k,2221) * lu(k,2772) + lu(k,2796) = lu(k,2796) - lu(k,2222) * lu(k,2772) + lu(k,2798) = lu(k,2798) - lu(k,2223) * lu(k,2772) + lu(k,2799) = lu(k,2799) - lu(k,2224) * lu(k,2772) + lu(k,2800) = lu(k,2800) - lu(k,2225) * lu(k,2772) + lu(k,2801) = lu(k,2801) - lu(k,2226) * lu(k,2772) + lu(k,2802) = lu(k,2802) - lu(k,2227) * lu(k,2772) + lu(k,2803) = lu(k,2803) - lu(k,2228) * lu(k,2772) + lu(k,2806) = lu(k,2806) - lu(k,2229) * lu(k,2772) + lu(k,2833) = lu(k,2833) - lu(k,2214) * lu(k,2819) + lu(k,2835) = lu(k,2835) - lu(k,2215) * lu(k,2819) + lu(k,2836) = lu(k,2836) - lu(k,2216) * lu(k,2819) + lu(k,2837) = lu(k,2837) - lu(k,2217) * lu(k,2819) + lu(k,2838) = lu(k,2838) - lu(k,2218) * lu(k,2819) + lu(k,2839) = lu(k,2839) - lu(k,2219) * lu(k,2819) + lu(k,2840) = lu(k,2840) - lu(k,2220) * lu(k,2819) + lu(k,2841) = lu(k,2841) - lu(k,2221) * lu(k,2819) + lu(k,2843) = lu(k,2843) - lu(k,2222) * lu(k,2819) + lu(k,2845) = lu(k,2845) - lu(k,2223) * lu(k,2819) + lu(k,2846) = lu(k,2846) - lu(k,2224) * lu(k,2819) + lu(k,2847) = lu(k,2847) - lu(k,2225) * lu(k,2819) + lu(k,2848) = lu(k,2848) - lu(k,2226) * lu(k,2819) + lu(k,2849) = lu(k,2849) - lu(k,2227) * lu(k,2819) + lu(k,2850) = lu(k,2850) - lu(k,2228) * lu(k,2819) + lu(k,2853) = lu(k,2853) - lu(k,2229) * lu(k,2819) + lu(k,2905) = lu(k,2905) - lu(k,2214) * lu(k,2890) + lu(k,2907) = lu(k,2907) - lu(k,2215) * lu(k,2890) + lu(k,2908) = lu(k,2908) - lu(k,2216) * lu(k,2890) + lu(k,2909) = lu(k,2909) - lu(k,2217) * lu(k,2890) + lu(k,2910) = lu(k,2910) - lu(k,2218) * lu(k,2890) + lu(k,2911) = lu(k,2911) - lu(k,2219) * lu(k,2890) + lu(k,2912) = lu(k,2912) - lu(k,2220) * lu(k,2890) + lu(k,2913) = lu(k,2913) - lu(k,2221) * lu(k,2890) + lu(k,2916) = lu(k,2916) - lu(k,2222) * lu(k,2890) + lu(k,2918) = lu(k,2918) - lu(k,2223) * lu(k,2890) + lu(k,2919) = lu(k,2919) - lu(k,2224) * lu(k,2890) + lu(k,2920) = lu(k,2920) - lu(k,2225) * lu(k,2890) + lu(k,2921) = lu(k,2921) - lu(k,2226) * lu(k,2890) + lu(k,2922) = lu(k,2922) - lu(k,2227) * lu(k,2890) + lu(k,2923) = lu(k,2923) - lu(k,2228) * lu(k,2890) + lu(k,2927) = lu(k,2927) - lu(k,2229) * lu(k,2890) + lu(k,3095) = lu(k,3095) - lu(k,2214) * lu(k,3080) + lu(k,3097) = lu(k,3097) - lu(k,2215) * lu(k,3080) + lu(k,3098) = lu(k,3098) - lu(k,2216) * lu(k,3080) + lu(k,3099) = lu(k,3099) - lu(k,2217) * lu(k,3080) + lu(k,3100) = lu(k,3100) - lu(k,2218) * lu(k,3080) + lu(k,3101) = lu(k,3101) - lu(k,2219) * lu(k,3080) + lu(k,3102) = lu(k,3102) - lu(k,2220) * lu(k,3080) + lu(k,3103) = lu(k,3103) - lu(k,2221) * lu(k,3080) + lu(k,3106) = lu(k,3106) - lu(k,2222) * lu(k,3080) + lu(k,3108) = lu(k,3108) - lu(k,2223) * lu(k,3080) + lu(k,3109) = lu(k,3109) - lu(k,2224) * lu(k,3080) + lu(k,3110) = lu(k,3110) - lu(k,2225) * lu(k,3080) + lu(k,3111) = lu(k,3111) - lu(k,2226) * lu(k,3080) + lu(k,3114) = lu(k,3114) - lu(k,2227) * lu(k,3080) + lu(k,3115) = lu(k,3115) - lu(k,2228) * lu(k,3080) + lu(k,3119) = lu(k,3119) - lu(k,2229) * lu(k,3080) + lu(k,3354) = lu(k,3354) - lu(k,2214) * lu(k,3339) + lu(k,3356) = lu(k,3356) - lu(k,2215) * lu(k,3339) + lu(k,3357) = lu(k,3357) - lu(k,2216) * lu(k,3339) + lu(k,3358) = lu(k,3358) - lu(k,2217) * lu(k,3339) + lu(k,3359) = lu(k,3359) - lu(k,2218) * lu(k,3339) + lu(k,3360) = lu(k,3360) - lu(k,2219) * lu(k,3339) + lu(k,3361) = lu(k,3361) - lu(k,2220) * lu(k,3339) + lu(k,3362) = lu(k,3362) - lu(k,2221) * lu(k,3339) + lu(k,3365) = lu(k,3365) - lu(k,2222) * lu(k,3339) + lu(k,3367) = lu(k,3367) - lu(k,2223) * lu(k,3339) + lu(k,3368) = lu(k,3368) - lu(k,2224) * lu(k,3339) + lu(k,3369) = lu(k,3369) - lu(k,2225) * lu(k,3339) + lu(k,3370) = lu(k,3370) - lu(k,2226) * lu(k,3339) + lu(k,3373) = lu(k,3373) - lu(k,2227) * lu(k,3339) + lu(k,3374) = lu(k,3374) - lu(k,2228) * lu(k,3339) + lu(k,3378) = lu(k,3378) - lu(k,2229) * lu(k,3339) + lu(k,3447) = lu(k,3447) - lu(k,2214) * lu(k,3432) + lu(k,3449) = lu(k,3449) - lu(k,2215) * lu(k,3432) + lu(k,3450) = lu(k,3450) - lu(k,2216) * lu(k,3432) + lu(k,3451) = lu(k,3451) - lu(k,2217) * lu(k,3432) + lu(k,3452) = lu(k,3452) - lu(k,2218) * lu(k,3432) + lu(k,3453) = lu(k,3453) - lu(k,2219) * lu(k,3432) + lu(k,3454) = lu(k,3454) - lu(k,2220) * lu(k,3432) + lu(k,3455) = lu(k,3455) - lu(k,2221) * lu(k,3432) + lu(k,3458) = lu(k,3458) - lu(k,2222) * lu(k,3432) + lu(k,3460) = lu(k,3460) - lu(k,2223) * lu(k,3432) + lu(k,3461) = lu(k,3461) - lu(k,2224) * lu(k,3432) + lu(k,3462) = lu(k,3462) - lu(k,2225) * lu(k,3432) + lu(k,3463) = lu(k,3463) - lu(k,2226) * lu(k,3432) + lu(k,3466) = lu(k,3466) - lu(k,2227) * lu(k,3432) + lu(k,3467) = lu(k,3467) - lu(k,2228) * lu(k,3432) + lu(k,3471) = lu(k,3471) - lu(k,2229) * lu(k,3432) + lu(k,3591) = lu(k,3591) - lu(k,2214) * lu(k,3576) + lu(k,3593) = lu(k,3593) - lu(k,2215) * lu(k,3576) + lu(k,3594) = lu(k,3594) - lu(k,2216) * lu(k,3576) + lu(k,3595) = lu(k,3595) - lu(k,2217) * lu(k,3576) + lu(k,3596) = lu(k,3596) - lu(k,2218) * lu(k,3576) + lu(k,3597) = lu(k,3597) - lu(k,2219) * lu(k,3576) + lu(k,3598) = lu(k,3598) - lu(k,2220) * lu(k,3576) + lu(k,3599) = lu(k,3599) - lu(k,2221) * lu(k,3576) + lu(k,3602) = lu(k,3602) - lu(k,2222) * lu(k,3576) + lu(k,3604) = lu(k,3604) - lu(k,2223) * lu(k,3576) + lu(k,3605) = lu(k,3605) - lu(k,2224) * lu(k,3576) + lu(k,3606) = lu(k,3606) - lu(k,2225) * lu(k,3576) + lu(k,3607) = lu(k,3607) - lu(k,2226) * lu(k,3576) + lu(k,3610) = lu(k,3610) - lu(k,2227) * lu(k,3576) + lu(k,3611) = lu(k,3611) - lu(k,2228) * lu(k,3576) + lu(k,3615) = lu(k,3615) - lu(k,2229) * lu(k,3576) + lu(k,3745) = lu(k,3745) - lu(k,2214) * lu(k,3732) + lu(k,3747) = lu(k,3747) - lu(k,2215) * lu(k,3732) + lu(k,3748) = lu(k,3748) - lu(k,2216) * lu(k,3732) + lu(k,3749) = lu(k,3749) - lu(k,2217) * lu(k,3732) + lu(k,3750) = lu(k,3750) - lu(k,2218) * lu(k,3732) + lu(k,3751) = lu(k,3751) - lu(k,2219) * lu(k,3732) + lu(k,3752) = lu(k,3752) - lu(k,2220) * lu(k,3732) + lu(k,3753) = lu(k,3753) - lu(k,2221) * lu(k,3732) + lu(k,3756) = lu(k,3756) - lu(k,2222) * lu(k,3732) + lu(k,3758) = lu(k,3758) - lu(k,2223) * lu(k,3732) + lu(k,3759) = lu(k,3759) - lu(k,2224) * lu(k,3732) + lu(k,3760) = lu(k,3760) - lu(k,2225) * lu(k,3732) + lu(k,3761) = lu(k,3761) - lu(k,2226) * lu(k,3732) + lu(k,3764) = lu(k,3764) - lu(k,2227) * lu(k,3732) + lu(k,3765) = lu(k,3765) - lu(k,2228) * lu(k,3732) + lu(k,3769) = lu(k,3769) - lu(k,2229) * lu(k,3732) + lu(k,4077) = lu(k,4077) - lu(k,2214) * lu(k,4063) + lu(k,4079) = lu(k,4079) - lu(k,2215) * lu(k,4063) + lu(k,4080) = lu(k,4080) - lu(k,2216) * lu(k,4063) + lu(k,4081) = lu(k,4081) - lu(k,2217) * lu(k,4063) + lu(k,4082) = lu(k,4082) - lu(k,2218) * lu(k,4063) + lu(k,4083) = lu(k,4083) - lu(k,2219) * lu(k,4063) + lu(k,4084) = lu(k,4084) - lu(k,2220) * lu(k,4063) + lu(k,4085) = lu(k,4085) - lu(k,2221) * lu(k,4063) + lu(k,4088) = lu(k,4088) - lu(k,2222) * lu(k,4063) + lu(k,4090) = lu(k,4090) - lu(k,2223) * lu(k,4063) + lu(k,4091) = lu(k,4091) - lu(k,2224) * lu(k,4063) + lu(k,4092) = lu(k,4092) - lu(k,2225) * lu(k,4063) + lu(k,4093) = lu(k,4093) - lu(k,2226) * lu(k,4063) + lu(k,4096) = lu(k,4096) - lu(k,2227) * lu(k,4063) + lu(k,4097) = lu(k,4097) - lu(k,2228) * lu(k,4063) + lu(k,4101) = lu(k,4101) - lu(k,2229) * lu(k,4063) + lu(k,2235) = 1._r8 / lu(k,2235) + lu(k,2236) = lu(k,2236) * lu(k,2235) + lu(k,2237) = lu(k,2237) * lu(k,2235) + lu(k,2238) = lu(k,2238) * lu(k,2235) + lu(k,2239) = lu(k,2239) * lu(k,2235) + lu(k,2240) = lu(k,2240) * lu(k,2235) + lu(k,2241) = lu(k,2241) * lu(k,2235) + lu(k,2242) = lu(k,2242) * lu(k,2235) + lu(k,2243) = lu(k,2243) * lu(k,2235) + lu(k,2244) = lu(k,2244) * lu(k,2235) + lu(k,2245) = lu(k,2245) * lu(k,2235) + lu(k,2246) = lu(k,2246) * lu(k,2235) + lu(k,2247) = lu(k,2247) * lu(k,2235) + lu(k,2248) = lu(k,2248) * lu(k,2235) + lu(k,2249) = lu(k,2249) * lu(k,2235) + lu(k,2250) = lu(k,2250) * lu(k,2235) + lu(k,2251) = lu(k,2251) * lu(k,2235) + lu(k,2252) = lu(k,2252) * lu(k,2235) + lu(k,2253) = lu(k,2253) * lu(k,2235) + lu(k,2697) = - lu(k,2236) * lu(k,2696) + lu(k,2698) = lu(k,2698) - lu(k,2237) * lu(k,2696) + lu(k,2699) = lu(k,2699) - lu(k,2238) * lu(k,2696) + lu(k,2700) = lu(k,2700) - lu(k,2239) * lu(k,2696) + lu(k,2701) = lu(k,2701) - lu(k,2240) * lu(k,2696) + lu(k,2702) = lu(k,2702) - lu(k,2241) * lu(k,2696) + lu(k,2703) = lu(k,2703) - lu(k,2242) * lu(k,2696) + lu(k,2704) = lu(k,2704) - lu(k,2243) * lu(k,2696) + lu(k,2705) = lu(k,2705) - lu(k,2244) * lu(k,2696) + lu(k,2706) = lu(k,2706) - lu(k,2245) * lu(k,2696) + lu(k,2707) = lu(k,2707) - lu(k,2246) * lu(k,2696) + lu(k,2708) = lu(k,2708) - lu(k,2247) * lu(k,2696) + lu(k,2709) = lu(k,2709) - lu(k,2248) * lu(k,2696) + lu(k,2710) = lu(k,2710) - lu(k,2249) * lu(k,2696) + lu(k,2711) = lu(k,2711) - lu(k,2250) * lu(k,2696) + lu(k,2712) = lu(k,2712) - lu(k,2251) * lu(k,2696) + lu(k,2713) = lu(k,2713) - lu(k,2252) * lu(k,2696) + lu(k,2714) = lu(k,2714) - lu(k,2253) * lu(k,2696) + lu(k,2728) = lu(k,2728) - lu(k,2236) * lu(k,2727) + lu(k,2732) = lu(k,2732) - lu(k,2237) * lu(k,2727) + lu(k,2742) = lu(k,2742) - lu(k,2238) * lu(k,2727) + lu(k,2743) = lu(k,2743) - lu(k,2239) * lu(k,2727) + lu(k,2744) = lu(k,2744) - lu(k,2240) * lu(k,2727) + lu(k,2745) = lu(k,2745) - lu(k,2241) * lu(k,2727) + lu(k,2746) = lu(k,2746) - lu(k,2242) * lu(k,2727) + lu(k,2747) = lu(k,2747) - lu(k,2243) * lu(k,2727) + lu(k,2748) = lu(k,2748) - lu(k,2244) * lu(k,2727) + lu(k,2749) = lu(k,2749) - lu(k,2245) * lu(k,2727) + lu(k,2750) = lu(k,2750) - lu(k,2246) * lu(k,2727) + lu(k,2752) = lu(k,2752) - lu(k,2247) * lu(k,2727) + lu(k,2753) = lu(k,2753) - lu(k,2248) * lu(k,2727) + lu(k,2754) = lu(k,2754) - lu(k,2249) * lu(k,2727) + lu(k,2755) = lu(k,2755) - lu(k,2250) * lu(k,2727) + lu(k,2756) = lu(k,2756) - lu(k,2251) * lu(k,2727) + lu(k,2757) = lu(k,2757) - lu(k,2252) * lu(k,2727) + lu(k,2760) = lu(k,2760) - lu(k,2253) * lu(k,2727) + lu(k,2774) = lu(k,2774) - lu(k,2236) * lu(k,2773) + lu(k,2778) = lu(k,2778) - lu(k,2237) * lu(k,2773) + lu(k,2788) = lu(k,2788) - lu(k,2238) * lu(k,2773) + lu(k,2789) = lu(k,2789) - lu(k,2239) * lu(k,2773) + lu(k,2790) = lu(k,2790) - lu(k,2240) * lu(k,2773) + lu(k,2791) = lu(k,2791) - lu(k,2241) * lu(k,2773) + lu(k,2792) = lu(k,2792) - lu(k,2242) * lu(k,2773) + lu(k,2793) = lu(k,2793) - lu(k,2243) * lu(k,2773) + lu(k,2794) = lu(k,2794) - lu(k,2244) * lu(k,2773) + lu(k,2795) = lu(k,2795) - lu(k,2245) * lu(k,2773) + lu(k,2796) = lu(k,2796) - lu(k,2246) * lu(k,2773) + lu(k,2798) = lu(k,2798) - lu(k,2247) * lu(k,2773) + lu(k,2799) = lu(k,2799) - lu(k,2248) * lu(k,2773) + lu(k,2800) = lu(k,2800) - lu(k,2249) * lu(k,2773) + lu(k,2801) = lu(k,2801) - lu(k,2250) * lu(k,2773) + lu(k,2802) = lu(k,2802) - lu(k,2251) * lu(k,2773) + lu(k,2803) = lu(k,2803) - lu(k,2252) * lu(k,2773) + lu(k,2806) = lu(k,2806) - lu(k,2253) * lu(k,2773) + lu(k,2821) = lu(k,2821) - lu(k,2236) * lu(k,2820) + lu(k,2825) = lu(k,2825) - lu(k,2237) * lu(k,2820) + lu(k,2835) = lu(k,2835) - lu(k,2238) * lu(k,2820) + lu(k,2836) = lu(k,2836) - lu(k,2239) * lu(k,2820) + lu(k,2837) = lu(k,2837) - lu(k,2240) * lu(k,2820) + lu(k,2838) = lu(k,2838) - lu(k,2241) * lu(k,2820) + lu(k,2839) = lu(k,2839) - lu(k,2242) * lu(k,2820) + lu(k,2840) = lu(k,2840) - lu(k,2243) * lu(k,2820) + lu(k,2841) = lu(k,2841) - lu(k,2244) * lu(k,2820) + lu(k,2842) = lu(k,2842) - lu(k,2245) * lu(k,2820) + lu(k,2843) = lu(k,2843) - lu(k,2246) * lu(k,2820) + lu(k,2845) = lu(k,2845) - lu(k,2247) * lu(k,2820) + lu(k,2846) = lu(k,2846) - lu(k,2248) * lu(k,2820) + lu(k,2847) = lu(k,2847) - lu(k,2249) * lu(k,2820) + lu(k,2848) = lu(k,2848) - lu(k,2250) * lu(k,2820) + lu(k,2849) = lu(k,2849) - lu(k,2251) * lu(k,2820) + lu(k,2850) = lu(k,2850) - lu(k,2252) * lu(k,2820) + lu(k,2853) = lu(k,2853) - lu(k,2253) * lu(k,2820) + lu(k,2893) = lu(k,2893) - lu(k,2236) * lu(k,2891) + lu(k,2897) = lu(k,2897) - lu(k,2237) * lu(k,2891) + lu(k,2907) = lu(k,2907) - lu(k,2238) * lu(k,2891) + lu(k,2908) = lu(k,2908) - lu(k,2239) * lu(k,2891) + lu(k,2909) = lu(k,2909) - lu(k,2240) * lu(k,2891) + lu(k,2910) = lu(k,2910) - lu(k,2241) * lu(k,2891) + lu(k,2911) = lu(k,2911) - lu(k,2242) * lu(k,2891) + lu(k,2912) = lu(k,2912) - lu(k,2243) * lu(k,2891) + lu(k,2913) = lu(k,2913) - lu(k,2244) * lu(k,2891) + lu(k,2915) = lu(k,2915) - lu(k,2245) * lu(k,2891) + lu(k,2916) = lu(k,2916) - lu(k,2246) * lu(k,2891) + lu(k,2918) = lu(k,2918) - lu(k,2247) * lu(k,2891) + lu(k,2919) = lu(k,2919) - lu(k,2248) * lu(k,2891) + lu(k,2920) = lu(k,2920) - lu(k,2249) * lu(k,2891) + lu(k,2921) = lu(k,2921) - lu(k,2250) * lu(k,2891) + lu(k,2922) = lu(k,2922) - lu(k,2251) * lu(k,2891) + lu(k,2923) = lu(k,2923) - lu(k,2252) * lu(k,2891) + lu(k,2927) = lu(k,2927) - lu(k,2253) * lu(k,2891) + lu(k,3083) = lu(k,3083) - lu(k,2236) * lu(k,3081) + lu(k,3087) = lu(k,3087) - lu(k,2237) * lu(k,3081) + lu(k,3097) = lu(k,3097) - lu(k,2238) * lu(k,3081) + lu(k,3098) = lu(k,3098) - lu(k,2239) * lu(k,3081) + lu(k,3099) = lu(k,3099) - lu(k,2240) * lu(k,3081) + lu(k,3100) = lu(k,3100) - lu(k,2241) * lu(k,3081) + lu(k,3101) = lu(k,3101) - lu(k,2242) * lu(k,3081) + lu(k,3102) = lu(k,3102) - lu(k,2243) * lu(k,3081) + lu(k,3103) = lu(k,3103) - lu(k,2244) * lu(k,3081) + lu(k,3105) = lu(k,3105) - lu(k,2245) * lu(k,3081) + lu(k,3106) = lu(k,3106) - lu(k,2246) * lu(k,3081) + lu(k,3108) = lu(k,3108) - lu(k,2247) * lu(k,3081) + lu(k,3109) = lu(k,3109) - lu(k,2248) * lu(k,3081) + lu(k,3110) = lu(k,3110) - lu(k,2249) * lu(k,3081) + lu(k,3111) = lu(k,3111) - lu(k,2250) * lu(k,3081) + lu(k,3114) = lu(k,3114) - lu(k,2251) * lu(k,3081) + lu(k,3115) = lu(k,3115) - lu(k,2252) * lu(k,3081) + lu(k,3119) = lu(k,3119) - lu(k,2253) * lu(k,3081) + lu(k,3342) = lu(k,3342) - lu(k,2236) * lu(k,3340) + lu(k,3346) = lu(k,3346) - lu(k,2237) * lu(k,3340) + lu(k,3356) = lu(k,3356) - lu(k,2238) * lu(k,3340) + lu(k,3357) = lu(k,3357) - lu(k,2239) * lu(k,3340) + lu(k,3358) = lu(k,3358) - lu(k,2240) * lu(k,3340) + lu(k,3359) = lu(k,3359) - lu(k,2241) * lu(k,3340) + lu(k,3360) = lu(k,3360) - lu(k,2242) * lu(k,3340) + lu(k,3361) = lu(k,3361) - lu(k,2243) * lu(k,3340) + lu(k,3362) = lu(k,3362) - lu(k,2244) * lu(k,3340) + lu(k,3364) = lu(k,3364) - lu(k,2245) * lu(k,3340) + lu(k,3365) = lu(k,3365) - lu(k,2246) * lu(k,3340) + lu(k,3367) = lu(k,3367) - lu(k,2247) * lu(k,3340) + lu(k,3368) = lu(k,3368) - lu(k,2248) * lu(k,3340) + lu(k,3369) = lu(k,3369) - lu(k,2249) * lu(k,3340) + lu(k,3370) = lu(k,3370) - lu(k,2250) * lu(k,3340) + lu(k,3373) = lu(k,3373) - lu(k,2251) * lu(k,3340) + lu(k,3374) = lu(k,3374) - lu(k,2252) * lu(k,3340) + lu(k,3378) = lu(k,3378) - lu(k,2253) * lu(k,3340) + lu(k,3435) = lu(k,3435) - lu(k,2236) * lu(k,3433) + lu(k,3439) = lu(k,3439) - lu(k,2237) * lu(k,3433) + lu(k,3449) = lu(k,3449) - lu(k,2238) * lu(k,3433) + lu(k,3450) = lu(k,3450) - lu(k,2239) * lu(k,3433) + lu(k,3451) = lu(k,3451) - lu(k,2240) * lu(k,3433) + lu(k,3452) = lu(k,3452) - lu(k,2241) * lu(k,3433) + lu(k,3453) = lu(k,3453) - lu(k,2242) * lu(k,3433) + lu(k,3454) = lu(k,3454) - lu(k,2243) * lu(k,3433) + lu(k,3455) = lu(k,3455) - lu(k,2244) * lu(k,3433) + lu(k,3457) = lu(k,3457) - lu(k,2245) * lu(k,3433) + lu(k,3458) = lu(k,3458) - lu(k,2246) * lu(k,3433) + lu(k,3460) = lu(k,3460) - lu(k,2247) * lu(k,3433) + lu(k,3461) = lu(k,3461) - lu(k,2248) * lu(k,3433) + lu(k,3462) = lu(k,3462) - lu(k,2249) * lu(k,3433) + lu(k,3463) = lu(k,3463) - lu(k,2250) * lu(k,3433) + lu(k,3466) = lu(k,3466) - lu(k,2251) * lu(k,3433) + lu(k,3467) = lu(k,3467) - lu(k,2252) * lu(k,3433) + lu(k,3471) = lu(k,3471) - lu(k,2253) * lu(k,3433) + lu(k,3579) = lu(k,3579) - lu(k,2236) * lu(k,3577) + lu(k,3583) = lu(k,3583) - lu(k,2237) * lu(k,3577) + lu(k,3593) = lu(k,3593) - lu(k,2238) * lu(k,3577) + lu(k,3594) = lu(k,3594) - lu(k,2239) * lu(k,3577) + lu(k,3595) = lu(k,3595) - lu(k,2240) * lu(k,3577) + lu(k,3596) = lu(k,3596) - lu(k,2241) * lu(k,3577) + lu(k,3597) = lu(k,3597) - lu(k,2242) * lu(k,3577) + lu(k,3598) = lu(k,3598) - lu(k,2243) * lu(k,3577) + lu(k,3599) = lu(k,3599) - lu(k,2244) * lu(k,3577) + lu(k,3601) = lu(k,3601) - lu(k,2245) * lu(k,3577) + lu(k,3602) = lu(k,3602) - lu(k,2246) * lu(k,3577) + lu(k,3604) = lu(k,3604) - lu(k,2247) * lu(k,3577) + lu(k,3605) = lu(k,3605) - lu(k,2248) * lu(k,3577) + lu(k,3606) = lu(k,3606) - lu(k,2249) * lu(k,3577) + lu(k,3607) = lu(k,3607) - lu(k,2250) * lu(k,3577) + lu(k,3610) = lu(k,3610) - lu(k,2251) * lu(k,3577) + lu(k,3611) = lu(k,3611) - lu(k,2252) * lu(k,3577) + lu(k,3615) = lu(k,3615) - lu(k,2253) * lu(k,3577) + lu(k,2259) = 1._r8 / lu(k,2259) + lu(k,2260) = lu(k,2260) * lu(k,2259) + lu(k,2261) = lu(k,2261) * lu(k,2259) + lu(k,2262) = lu(k,2262) * lu(k,2259) + lu(k,2263) = lu(k,2263) * lu(k,2259) + lu(k,2264) = lu(k,2264) * lu(k,2259) + lu(k,2265) = lu(k,2265) * lu(k,2259) + lu(k,2266) = lu(k,2266) * lu(k,2259) + lu(k,2267) = lu(k,2267) * lu(k,2259) + lu(k,2268) = lu(k,2268) * lu(k,2259) + lu(k,2269) = lu(k,2269) * lu(k,2259) + lu(k,2270) = lu(k,2270) * lu(k,2259) + lu(k,2271) = lu(k,2271) * lu(k,2259) + lu(k,2914) = - lu(k,2260) * lu(k,2892) + lu(k,2915) = lu(k,2915) - lu(k,2261) * lu(k,2892) + lu(k,2917) = lu(k,2917) - lu(k,2262) * lu(k,2892) + lu(k,2918) = lu(k,2918) - lu(k,2263) * lu(k,2892) + lu(k,2919) = lu(k,2919) - lu(k,2264) * lu(k,2892) + lu(k,2920) = lu(k,2920) - lu(k,2265) * lu(k,2892) + lu(k,2921) = lu(k,2921) - lu(k,2266) * lu(k,2892) + lu(k,2922) = lu(k,2922) - lu(k,2267) * lu(k,2892) + lu(k,2925) = - lu(k,2268) * lu(k,2892) + lu(k,2926) = lu(k,2926) - lu(k,2269) * lu(k,2892) + lu(k,2927) = lu(k,2927) - lu(k,2270) * lu(k,2892) + lu(k,2928) = lu(k,2928) - lu(k,2271) * lu(k,2892) + lu(k,2931) = lu(k,2931) - lu(k,2260) * lu(k,2930) + lu(k,2932) = lu(k,2932) - lu(k,2261) * lu(k,2930) + lu(k,2933) = lu(k,2933) - lu(k,2262) * lu(k,2930) + lu(k,2934) = lu(k,2934) - lu(k,2263) * lu(k,2930) + lu(k,2935) = - lu(k,2264) * lu(k,2930) + lu(k,2936) = lu(k,2936) - lu(k,2265) * lu(k,2930) + lu(k,2937) = lu(k,2937) - lu(k,2266) * lu(k,2930) + lu(k,2938) = lu(k,2938) - lu(k,2267) * lu(k,2930) + lu(k,2940) = lu(k,2940) - lu(k,2268) * lu(k,2930) + lu(k,2941) = lu(k,2941) - lu(k,2269) * lu(k,2930) + lu(k,2942) = lu(k,2942) - lu(k,2270) * lu(k,2930) + lu(k,2943) = lu(k,2943) - lu(k,2271) * lu(k,2930) + lu(k,2948) = lu(k,2948) - lu(k,2260) * lu(k,2947) + lu(k,2949) = lu(k,2949) - lu(k,2261) * lu(k,2947) + lu(k,2950) = lu(k,2950) - lu(k,2262) * lu(k,2947) + lu(k,2951) = lu(k,2951) - lu(k,2263) * lu(k,2947) + lu(k,2952) = - lu(k,2264) * lu(k,2947) + lu(k,2953) = - lu(k,2265) * lu(k,2947) + lu(k,2954) = lu(k,2954) - lu(k,2266) * lu(k,2947) + lu(k,2955) = lu(k,2955) - lu(k,2267) * lu(k,2947) + lu(k,2958) = lu(k,2958) - lu(k,2268) * lu(k,2947) + lu(k,2959) = lu(k,2959) - lu(k,2269) * lu(k,2947) + lu(k,2960) = lu(k,2960) - lu(k,2270) * lu(k,2947) + lu(k,2961) = lu(k,2961) - lu(k,2271) * lu(k,2947) + lu(k,3104) = lu(k,3104) - lu(k,2260) * lu(k,3082) + lu(k,3105) = lu(k,3105) - lu(k,2261) * lu(k,3082) + lu(k,3107) = lu(k,3107) - lu(k,2262) * lu(k,3082) + lu(k,3108) = lu(k,3108) - lu(k,2263) * lu(k,3082) + lu(k,3109) = lu(k,3109) - lu(k,2264) * lu(k,3082) + lu(k,3110) = lu(k,3110) - lu(k,2265) * lu(k,3082) + lu(k,3111) = lu(k,3111) - lu(k,2266) * lu(k,3082) + lu(k,3114) = lu(k,3114) - lu(k,2267) * lu(k,3082) + lu(k,3117) = lu(k,3117) - lu(k,2268) * lu(k,3082) + lu(k,3118) = lu(k,3118) - lu(k,2269) * lu(k,3082) + lu(k,3119) = lu(k,3119) - lu(k,2270) * lu(k,3082) + lu(k,3120) = lu(k,3120) - lu(k,2271) * lu(k,3082) + lu(k,3157) = lu(k,3157) - lu(k,2260) * lu(k,3156) + lu(k,3158) = lu(k,3158) - lu(k,2261) * lu(k,3156) + lu(k,3160) = lu(k,3160) - lu(k,2262) * lu(k,3156) + lu(k,3161) = lu(k,3161) - lu(k,2263) * lu(k,3156) + lu(k,3162) = lu(k,3162) - lu(k,2264) * lu(k,3156) + lu(k,3163) = lu(k,3163) - lu(k,2265) * lu(k,3156) + lu(k,3164) = lu(k,3164) - lu(k,2266) * lu(k,3156) + lu(k,3167) = lu(k,3167) - lu(k,2267) * lu(k,3156) + lu(k,3170) = lu(k,3170) - lu(k,2268) * lu(k,3156) + lu(k,3171) = lu(k,3171) - lu(k,2269) * lu(k,3156) + lu(k,3172) = lu(k,3172) - lu(k,2270) * lu(k,3156) + lu(k,3173) = lu(k,3173) - lu(k,2271) * lu(k,3156) + lu(k,3183) = lu(k,3183) - lu(k,2260) * lu(k,3182) + lu(k,3184) = lu(k,3184) - lu(k,2261) * lu(k,3182) + lu(k,3186) = lu(k,3186) - lu(k,2262) * lu(k,3182) + lu(k,3187) = lu(k,3187) - lu(k,2263) * lu(k,3182) + lu(k,3188) = lu(k,3188) - lu(k,2264) * lu(k,3182) + lu(k,3189) = lu(k,3189) - lu(k,2265) * lu(k,3182) + lu(k,3190) = lu(k,3190) - lu(k,2266) * lu(k,3182) + lu(k,3193) = lu(k,3193) - lu(k,2267) * lu(k,3182) + lu(k,3196) = lu(k,3196) - lu(k,2268) * lu(k,3182) + lu(k,3197) = lu(k,3197) - lu(k,2269) * lu(k,3182) + lu(k,3198) = lu(k,3198) - lu(k,2270) * lu(k,3182) + lu(k,3199) = lu(k,3199) - lu(k,2271) * lu(k,3182) + lu(k,3363) = lu(k,3363) - lu(k,2260) * lu(k,3341) + lu(k,3364) = lu(k,3364) - lu(k,2261) * lu(k,3341) + lu(k,3366) = lu(k,3366) - lu(k,2262) * lu(k,3341) + lu(k,3367) = lu(k,3367) - lu(k,2263) * lu(k,3341) + lu(k,3368) = lu(k,3368) - lu(k,2264) * lu(k,3341) + lu(k,3369) = lu(k,3369) - lu(k,2265) * lu(k,3341) + lu(k,3370) = lu(k,3370) - lu(k,2266) * lu(k,3341) + lu(k,3373) = lu(k,3373) - lu(k,2267) * lu(k,3341) + lu(k,3376) = lu(k,3376) - lu(k,2268) * lu(k,3341) + lu(k,3377) = lu(k,3377) - lu(k,2269) * lu(k,3341) + lu(k,3378) = lu(k,3378) - lu(k,2270) * lu(k,3341) + lu(k,3379) = lu(k,3379) - lu(k,2271) * lu(k,3341) + lu(k,3456) = lu(k,3456) - lu(k,2260) * lu(k,3434) + lu(k,3457) = lu(k,3457) - lu(k,2261) * lu(k,3434) + lu(k,3459) = lu(k,3459) - lu(k,2262) * lu(k,3434) + lu(k,3460) = lu(k,3460) - lu(k,2263) * lu(k,3434) + lu(k,3461) = lu(k,3461) - lu(k,2264) * lu(k,3434) + lu(k,3462) = lu(k,3462) - lu(k,2265) * lu(k,3434) + lu(k,3463) = lu(k,3463) - lu(k,2266) * lu(k,3434) + lu(k,3466) = lu(k,3466) - lu(k,2267) * lu(k,3434) + lu(k,3469) = - lu(k,2268) * lu(k,3434) + lu(k,3470) = lu(k,3470) - lu(k,2269) * lu(k,3434) + lu(k,3471) = lu(k,3471) - lu(k,2270) * lu(k,3434) + lu(k,3472) = lu(k,3472) - lu(k,2271) * lu(k,3434) + lu(k,3600) = lu(k,3600) - lu(k,2260) * lu(k,3578) + lu(k,3601) = lu(k,3601) - lu(k,2261) * lu(k,3578) + lu(k,3603) = lu(k,3603) - lu(k,2262) * lu(k,3578) + lu(k,3604) = lu(k,3604) - lu(k,2263) * lu(k,3578) + lu(k,3605) = lu(k,3605) - lu(k,2264) * lu(k,3578) + lu(k,3606) = lu(k,3606) - lu(k,2265) * lu(k,3578) + lu(k,3607) = lu(k,3607) - lu(k,2266) * lu(k,3578) + lu(k,3610) = lu(k,3610) - lu(k,2267) * lu(k,3578) + lu(k,3613) = lu(k,3613) - lu(k,2268) * lu(k,3578) + lu(k,3614) = lu(k,3614) - lu(k,2269) * lu(k,3578) + lu(k,3615) = lu(k,3615) - lu(k,2270) * lu(k,3578) + lu(k,3616) = lu(k,3616) - lu(k,2271) * lu(k,3578) + lu(k,3754) = lu(k,3754) - lu(k,2260) * lu(k,3733) + lu(k,3755) = lu(k,3755) - lu(k,2261) * lu(k,3733) + lu(k,3757) = lu(k,3757) - lu(k,2262) * lu(k,3733) + lu(k,3758) = lu(k,3758) - lu(k,2263) * lu(k,3733) + lu(k,3759) = lu(k,3759) - lu(k,2264) * lu(k,3733) + lu(k,3760) = lu(k,3760) - lu(k,2265) * lu(k,3733) + lu(k,3761) = lu(k,3761) - lu(k,2266) * lu(k,3733) + lu(k,3764) = lu(k,3764) - lu(k,2267) * lu(k,3733) + lu(k,3767) = lu(k,3767) - lu(k,2268) * lu(k,3733) + lu(k,3768) = lu(k,3768) - lu(k,2269) * lu(k,3733) + lu(k,3769) = lu(k,3769) - lu(k,2270) * lu(k,3733) + lu(k,3770) = lu(k,3770) - lu(k,2271) * lu(k,3733) + lu(k,3795) = lu(k,3795) - lu(k,2260) * lu(k,3794) + lu(k,3796) = lu(k,3796) - lu(k,2261) * lu(k,3794) + lu(k,3798) = lu(k,3798) - lu(k,2262) * lu(k,3794) + lu(k,3799) = lu(k,3799) - lu(k,2263) * lu(k,3794) + lu(k,3800) = lu(k,3800) - lu(k,2264) * lu(k,3794) + lu(k,3801) = lu(k,3801) - lu(k,2265) * lu(k,3794) + lu(k,3802) = lu(k,3802) - lu(k,2266) * lu(k,3794) + lu(k,3805) = lu(k,3805) - lu(k,2267) * lu(k,3794) + lu(k,3808) = lu(k,3808) - lu(k,2268) * lu(k,3794) + lu(k,3809) = lu(k,3809) - lu(k,2269) * lu(k,3794) + lu(k,3810) = lu(k,3810) - lu(k,2270) * lu(k,3794) + lu(k,3811) = lu(k,3811) - lu(k,2271) * lu(k,3794) + lu(k,3836) = lu(k,3836) - lu(k,2260) * lu(k,3834) + lu(k,3837) = lu(k,3837) - lu(k,2261) * lu(k,3834) + lu(k,3839) = lu(k,3839) - lu(k,2262) * lu(k,3834) + lu(k,3840) = lu(k,3840) - lu(k,2263) * lu(k,3834) + lu(k,3841) = lu(k,3841) - lu(k,2264) * lu(k,3834) + lu(k,3842) = lu(k,3842) - lu(k,2265) * lu(k,3834) + lu(k,3843) = lu(k,3843) - lu(k,2266) * lu(k,3834) + lu(k,3846) = lu(k,3846) - lu(k,2267) * lu(k,3834) + lu(k,3849) = lu(k,3849) - lu(k,2268) * lu(k,3834) + lu(k,3850) = lu(k,3850) - lu(k,2269) * lu(k,3834) + lu(k,3851) = lu(k,3851) - lu(k,2270) * lu(k,3834) + lu(k,3852) = lu(k,3852) - lu(k,2271) * lu(k,3834) + lu(k,4086) = lu(k,4086) - lu(k,2260) * lu(k,4064) + lu(k,4087) = lu(k,4087) - lu(k,2261) * lu(k,4064) + lu(k,4089) = lu(k,4089) - lu(k,2262) * lu(k,4064) + lu(k,4090) = lu(k,4090) - lu(k,2263) * lu(k,4064) + lu(k,4091) = lu(k,4091) - lu(k,2264) * lu(k,4064) + lu(k,4092) = lu(k,4092) - lu(k,2265) * lu(k,4064) + lu(k,4093) = lu(k,4093) - lu(k,2266) * lu(k,4064) + lu(k,4096) = lu(k,4096) - lu(k,2267) * lu(k,4064) + lu(k,4099) = lu(k,4099) - lu(k,2268) * lu(k,4064) + lu(k,4100) = lu(k,4100) - lu(k,2269) * lu(k,4064) + lu(k,4101) = lu(k,4101) - lu(k,2270) * lu(k,4064) + lu(k,4102) = lu(k,4102) - lu(k,2271) * lu(k,4064) + lu(k,4112) = lu(k,4112) - lu(k,2260) * lu(k,4111) + lu(k,4113) = lu(k,4113) - lu(k,2261) * lu(k,4111) + lu(k,4115) = lu(k,4115) - lu(k,2262) * lu(k,4111) + lu(k,4116) = lu(k,4116) - lu(k,2263) * lu(k,4111) + lu(k,4117) = lu(k,4117) - lu(k,2264) * lu(k,4111) + lu(k,4118) = lu(k,4118) - lu(k,2265) * lu(k,4111) + lu(k,4119) = lu(k,4119) - lu(k,2266) * lu(k,4111) + lu(k,4122) = lu(k,4122) - lu(k,2267) * lu(k,4111) + lu(k,4125) = lu(k,4125) - lu(k,2268) * lu(k,4111) + lu(k,4126) = lu(k,4126) - lu(k,2269) * lu(k,4111) + lu(k,4127) = lu(k,4127) - lu(k,2270) * lu(k,4111) + lu(k,4128) = lu(k,4128) - lu(k,2271) * lu(k,4111) + end do + end subroutine lu_fac45 + subroutine lu_fac46( 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,2277) = 1._r8 / lu(k,2277) + lu(k,2278) = lu(k,2278) * lu(k,2277) + lu(k,2279) = lu(k,2279) * lu(k,2277) + lu(k,2280) = lu(k,2280) * lu(k,2277) + lu(k,2281) = lu(k,2281) * lu(k,2277) + lu(k,2282) = lu(k,2282) * lu(k,2277) + lu(k,2283) = lu(k,2283) * lu(k,2277) + lu(k,2284) = lu(k,2284) * lu(k,2277) + lu(k,2285) = lu(k,2285) * lu(k,2277) + lu(k,2286) = lu(k,2286) * lu(k,2277) + lu(k,2287) = lu(k,2287) * lu(k,2277) + lu(k,2288) = lu(k,2288) * lu(k,2277) + lu(k,2388) = lu(k,2388) - lu(k,2278) * lu(k,2377) + lu(k,2389) = lu(k,2389) - lu(k,2279) * lu(k,2377) + lu(k,2390) = lu(k,2390) - lu(k,2280) * lu(k,2377) + lu(k,2391) = lu(k,2391) - lu(k,2281) * lu(k,2377) + lu(k,2392) = lu(k,2392) - lu(k,2282) * lu(k,2377) + lu(k,2393) = lu(k,2393) - lu(k,2283) * lu(k,2377) + lu(k,2394) = lu(k,2394) - lu(k,2284) * lu(k,2377) + lu(k,2395) = lu(k,2395) - lu(k,2285) * lu(k,2377) + lu(k,2396) = lu(k,2396) - lu(k,2286) * lu(k,2377) + lu(k,2397) = lu(k,2397) - lu(k,2287) * lu(k,2377) + lu(k,2398) = - lu(k,2288) * lu(k,2377) + lu(k,2449) = lu(k,2449) - lu(k,2278) * lu(k,2438) + lu(k,2450) = lu(k,2450) - lu(k,2279) * lu(k,2438) + lu(k,2451) = lu(k,2451) - lu(k,2280) * lu(k,2438) + lu(k,2452) = lu(k,2452) - lu(k,2281) * lu(k,2438) + lu(k,2453) = lu(k,2453) - lu(k,2282) * lu(k,2438) + lu(k,2454) = lu(k,2454) - lu(k,2283) * lu(k,2438) + lu(k,2455) = lu(k,2455) - lu(k,2284) * lu(k,2438) + lu(k,2456) = lu(k,2456) - lu(k,2285) * lu(k,2438) + lu(k,2457) = lu(k,2457) - lu(k,2286) * lu(k,2438) + lu(k,2458) = lu(k,2458) - lu(k,2287) * lu(k,2438) + lu(k,2459) = - lu(k,2288) * lu(k,2438) + lu(k,2480) = lu(k,2480) - lu(k,2278) * lu(k,2468) + lu(k,2481) = lu(k,2481) - lu(k,2279) * lu(k,2468) + lu(k,2482) = lu(k,2482) - lu(k,2280) * lu(k,2468) + lu(k,2483) = lu(k,2483) - lu(k,2281) * lu(k,2468) + lu(k,2484) = lu(k,2484) - lu(k,2282) * lu(k,2468) + lu(k,2485) = lu(k,2485) - lu(k,2283) * lu(k,2468) + lu(k,2486) = lu(k,2486) - lu(k,2284) * lu(k,2468) + lu(k,2487) = lu(k,2487) - lu(k,2285) * lu(k,2468) + lu(k,2488) = lu(k,2488) - lu(k,2286) * lu(k,2468) + lu(k,2489) = lu(k,2489) - lu(k,2287) * lu(k,2468) + lu(k,2490) = - lu(k,2288) * lu(k,2468) + lu(k,2579) = lu(k,2579) - lu(k,2278) * lu(k,2567) + lu(k,2580) = lu(k,2580) - lu(k,2279) * lu(k,2567) + lu(k,2581) = lu(k,2581) - lu(k,2280) * lu(k,2567) + lu(k,2582) = lu(k,2582) - lu(k,2281) * lu(k,2567) + lu(k,2583) = lu(k,2583) - lu(k,2282) * lu(k,2567) + lu(k,2584) = lu(k,2584) - lu(k,2283) * lu(k,2567) + lu(k,2585) = lu(k,2585) - lu(k,2284) * lu(k,2567) + lu(k,2586) = lu(k,2586) - lu(k,2285) * lu(k,2567) + lu(k,2587) = lu(k,2587) - lu(k,2286) * lu(k,2567) + lu(k,2588) = lu(k,2588) - lu(k,2287) * lu(k,2567) + lu(k,2589) = lu(k,2589) - lu(k,2288) * lu(k,2567) + lu(k,2705) = lu(k,2705) - lu(k,2278) * lu(k,2697) + lu(k,2706) = lu(k,2706) - lu(k,2279) * lu(k,2697) + lu(k,2707) = lu(k,2707) - lu(k,2280) * lu(k,2697) + lu(k,2708) = lu(k,2708) - lu(k,2281) * lu(k,2697) + lu(k,2709) = lu(k,2709) - lu(k,2282) * lu(k,2697) + lu(k,2710) = lu(k,2710) - lu(k,2283) * lu(k,2697) + lu(k,2711) = lu(k,2711) - lu(k,2284) * lu(k,2697) + lu(k,2712) = lu(k,2712) - lu(k,2285) * lu(k,2697) + lu(k,2713) = lu(k,2713) - lu(k,2286) * lu(k,2697) + lu(k,2714) = lu(k,2714) - lu(k,2287) * lu(k,2697) + lu(k,2715) = - lu(k,2288) * lu(k,2697) + lu(k,2748) = lu(k,2748) - lu(k,2278) * lu(k,2728) + lu(k,2749) = lu(k,2749) - lu(k,2279) * lu(k,2728) + lu(k,2750) = lu(k,2750) - lu(k,2280) * lu(k,2728) + lu(k,2752) = lu(k,2752) - lu(k,2281) * lu(k,2728) + lu(k,2753) = lu(k,2753) - lu(k,2282) * lu(k,2728) + lu(k,2754) = lu(k,2754) - lu(k,2283) * lu(k,2728) + lu(k,2755) = lu(k,2755) - lu(k,2284) * lu(k,2728) + lu(k,2756) = lu(k,2756) - lu(k,2285) * lu(k,2728) + lu(k,2757) = lu(k,2757) - lu(k,2286) * lu(k,2728) + lu(k,2760) = lu(k,2760) - lu(k,2287) * lu(k,2728) + lu(k,2761) = - lu(k,2288) * lu(k,2728) + lu(k,2794) = lu(k,2794) - lu(k,2278) * lu(k,2774) + lu(k,2795) = lu(k,2795) - lu(k,2279) * lu(k,2774) + lu(k,2796) = lu(k,2796) - lu(k,2280) * lu(k,2774) + lu(k,2798) = lu(k,2798) - lu(k,2281) * lu(k,2774) + lu(k,2799) = lu(k,2799) - lu(k,2282) * lu(k,2774) + lu(k,2800) = lu(k,2800) - lu(k,2283) * lu(k,2774) + lu(k,2801) = lu(k,2801) - lu(k,2284) * lu(k,2774) + lu(k,2802) = lu(k,2802) - lu(k,2285) * lu(k,2774) + lu(k,2803) = lu(k,2803) - lu(k,2286) * lu(k,2774) + lu(k,2806) = lu(k,2806) - lu(k,2287) * lu(k,2774) + lu(k,2807) = - lu(k,2288) * lu(k,2774) + lu(k,2841) = lu(k,2841) - lu(k,2278) * lu(k,2821) + lu(k,2842) = lu(k,2842) - lu(k,2279) * lu(k,2821) + lu(k,2843) = lu(k,2843) - lu(k,2280) * lu(k,2821) + lu(k,2845) = lu(k,2845) - lu(k,2281) * lu(k,2821) + lu(k,2846) = lu(k,2846) - lu(k,2282) * lu(k,2821) + lu(k,2847) = lu(k,2847) - lu(k,2283) * lu(k,2821) + lu(k,2848) = lu(k,2848) - lu(k,2284) * lu(k,2821) + lu(k,2849) = lu(k,2849) - lu(k,2285) * lu(k,2821) + lu(k,2850) = lu(k,2850) - lu(k,2286) * lu(k,2821) + lu(k,2853) = lu(k,2853) - lu(k,2287) * lu(k,2821) + lu(k,2854) = - lu(k,2288) * lu(k,2821) + lu(k,2913) = lu(k,2913) - lu(k,2278) * lu(k,2893) + lu(k,2915) = lu(k,2915) - lu(k,2279) * lu(k,2893) + lu(k,2916) = lu(k,2916) - lu(k,2280) * lu(k,2893) + lu(k,2918) = lu(k,2918) - lu(k,2281) * lu(k,2893) + lu(k,2919) = lu(k,2919) - lu(k,2282) * lu(k,2893) + lu(k,2920) = lu(k,2920) - lu(k,2283) * lu(k,2893) + lu(k,2921) = lu(k,2921) - lu(k,2284) * lu(k,2893) + lu(k,2922) = lu(k,2922) - lu(k,2285) * lu(k,2893) + lu(k,2923) = lu(k,2923) - lu(k,2286) * lu(k,2893) + lu(k,2927) = lu(k,2927) - lu(k,2287) * lu(k,2893) + lu(k,2928) = lu(k,2928) - lu(k,2288) * lu(k,2893) + lu(k,3103) = lu(k,3103) - lu(k,2278) * lu(k,3083) + lu(k,3105) = lu(k,3105) - lu(k,2279) * lu(k,3083) + lu(k,3106) = lu(k,3106) - lu(k,2280) * lu(k,3083) + lu(k,3108) = lu(k,3108) - lu(k,2281) * lu(k,3083) + lu(k,3109) = lu(k,3109) - lu(k,2282) * lu(k,3083) + lu(k,3110) = lu(k,3110) - lu(k,2283) * lu(k,3083) + lu(k,3111) = lu(k,3111) - lu(k,2284) * lu(k,3083) + lu(k,3114) = lu(k,3114) - lu(k,2285) * lu(k,3083) + lu(k,3115) = lu(k,3115) - lu(k,2286) * lu(k,3083) + lu(k,3119) = lu(k,3119) - lu(k,2287) * lu(k,3083) + lu(k,3120) = lu(k,3120) - lu(k,2288) * lu(k,3083) + lu(k,3362) = lu(k,3362) - lu(k,2278) * lu(k,3342) + lu(k,3364) = lu(k,3364) - lu(k,2279) * lu(k,3342) + lu(k,3365) = lu(k,3365) - lu(k,2280) * lu(k,3342) + lu(k,3367) = lu(k,3367) - lu(k,2281) * lu(k,3342) + lu(k,3368) = lu(k,3368) - lu(k,2282) * lu(k,3342) + lu(k,3369) = lu(k,3369) - lu(k,2283) * lu(k,3342) + lu(k,3370) = lu(k,3370) - lu(k,2284) * lu(k,3342) + lu(k,3373) = lu(k,3373) - lu(k,2285) * lu(k,3342) + lu(k,3374) = lu(k,3374) - lu(k,2286) * lu(k,3342) + lu(k,3378) = lu(k,3378) - lu(k,2287) * lu(k,3342) + lu(k,3379) = lu(k,3379) - lu(k,2288) * lu(k,3342) + lu(k,3455) = lu(k,3455) - lu(k,2278) * lu(k,3435) + lu(k,3457) = lu(k,3457) - lu(k,2279) * lu(k,3435) + lu(k,3458) = lu(k,3458) - lu(k,2280) * lu(k,3435) + lu(k,3460) = lu(k,3460) - lu(k,2281) * lu(k,3435) + lu(k,3461) = lu(k,3461) - lu(k,2282) * lu(k,3435) + lu(k,3462) = lu(k,3462) - lu(k,2283) * lu(k,3435) + lu(k,3463) = lu(k,3463) - lu(k,2284) * lu(k,3435) + lu(k,3466) = lu(k,3466) - lu(k,2285) * lu(k,3435) + lu(k,3467) = lu(k,3467) - lu(k,2286) * lu(k,3435) + lu(k,3471) = lu(k,3471) - lu(k,2287) * lu(k,3435) + lu(k,3472) = lu(k,3472) - lu(k,2288) * lu(k,3435) + lu(k,3599) = lu(k,3599) - lu(k,2278) * lu(k,3579) + lu(k,3601) = lu(k,3601) - lu(k,2279) * lu(k,3579) + lu(k,3602) = lu(k,3602) - lu(k,2280) * lu(k,3579) + lu(k,3604) = lu(k,3604) - lu(k,2281) * lu(k,3579) + lu(k,3605) = lu(k,3605) - lu(k,2282) * lu(k,3579) + lu(k,3606) = lu(k,3606) - lu(k,2283) * lu(k,3579) + lu(k,3607) = lu(k,3607) - lu(k,2284) * lu(k,3579) + lu(k,3610) = lu(k,3610) - lu(k,2285) * lu(k,3579) + lu(k,3611) = lu(k,3611) - lu(k,2286) * lu(k,3579) + lu(k,3615) = lu(k,3615) - lu(k,2287) * lu(k,3579) + lu(k,3616) = lu(k,3616) - lu(k,2288) * lu(k,3579) + lu(k,3651) = lu(k,3651) - lu(k,2278) * lu(k,3646) + lu(k,3653) = lu(k,3653) - lu(k,2279) * lu(k,3646) + lu(k,3654) = lu(k,3654) - lu(k,2280) * lu(k,3646) + lu(k,3656) = lu(k,3656) - lu(k,2281) * lu(k,3646) + lu(k,3657) = lu(k,3657) - lu(k,2282) * lu(k,3646) + lu(k,3658) = lu(k,3658) - lu(k,2283) * lu(k,3646) + lu(k,3659) = lu(k,3659) - lu(k,2284) * lu(k,3646) + lu(k,3662) = lu(k,3662) - lu(k,2285) * lu(k,3646) + lu(k,3663) = lu(k,3663) - lu(k,2286) * lu(k,3646) + lu(k,3667) = lu(k,3667) - lu(k,2287) * lu(k,3646) + lu(k,3668) = lu(k,3668) - lu(k,2288) * lu(k,3646) + lu(k,3753) = lu(k,3753) - lu(k,2278) * lu(k,3734) + lu(k,3755) = lu(k,3755) - lu(k,2279) * lu(k,3734) + lu(k,3756) = lu(k,3756) - lu(k,2280) * lu(k,3734) + lu(k,3758) = lu(k,3758) - lu(k,2281) * lu(k,3734) + lu(k,3759) = lu(k,3759) - lu(k,2282) * lu(k,3734) + lu(k,3760) = lu(k,3760) - lu(k,2283) * lu(k,3734) + lu(k,3761) = lu(k,3761) - lu(k,2284) * lu(k,3734) + lu(k,3764) = lu(k,3764) - lu(k,2285) * lu(k,3734) + lu(k,3765) = lu(k,3765) - lu(k,2286) * lu(k,3734) + lu(k,3769) = lu(k,3769) - lu(k,2287) * lu(k,3734) + lu(k,3770) = lu(k,3770) - lu(k,2288) * lu(k,3734) + lu(k,4085) = lu(k,4085) - lu(k,2278) * lu(k,4065) + lu(k,4087) = lu(k,4087) - lu(k,2279) * lu(k,4065) + lu(k,4088) = lu(k,4088) - lu(k,2280) * lu(k,4065) + lu(k,4090) = lu(k,4090) - lu(k,2281) * lu(k,4065) + lu(k,4091) = lu(k,4091) - lu(k,2282) * lu(k,4065) + lu(k,4092) = lu(k,4092) - lu(k,2283) * lu(k,4065) + lu(k,4093) = lu(k,4093) - lu(k,2284) * lu(k,4065) + lu(k,4096) = lu(k,4096) - lu(k,2285) * lu(k,4065) + lu(k,4097) = lu(k,4097) - lu(k,2286) * lu(k,4065) + lu(k,4101) = lu(k,4101) - lu(k,2287) * lu(k,4065) + lu(k,4102) = lu(k,4102) - lu(k,2288) * lu(k,4065) + lu(k,2296) = 1._r8 / lu(k,2296) + lu(k,2297) = lu(k,2297) * lu(k,2296) + lu(k,2298) = lu(k,2298) * lu(k,2296) + lu(k,2299) = lu(k,2299) * lu(k,2296) + lu(k,2300) = lu(k,2300) * lu(k,2296) + lu(k,2301) = lu(k,2301) * lu(k,2296) + lu(k,2302) = lu(k,2302) * lu(k,2296) + lu(k,2303) = lu(k,2303) * lu(k,2296) + lu(k,2304) = lu(k,2304) * lu(k,2296) + lu(k,2305) = lu(k,2305) * lu(k,2296) + lu(k,2306) = lu(k,2306) * lu(k,2296) + lu(k,2307) = lu(k,2307) * lu(k,2296) + lu(k,2308) = lu(k,2308) * lu(k,2296) + lu(k,2309) = lu(k,2309) * lu(k,2296) + lu(k,2310) = lu(k,2310) * lu(k,2296) + lu(k,2311) = lu(k,2311) * lu(k,2296) + lu(k,2312) = lu(k,2312) * lu(k,2296) + lu(k,2313) = lu(k,2313) * lu(k,2296) + lu(k,2314) = lu(k,2314) * lu(k,2296) + lu(k,2732) = lu(k,2732) - lu(k,2297) * lu(k,2729) + lu(k,2742) = lu(k,2742) - lu(k,2298) * lu(k,2729) + lu(k,2743) = lu(k,2743) - lu(k,2299) * lu(k,2729) + lu(k,2744) = lu(k,2744) - lu(k,2300) * lu(k,2729) + lu(k,2745) = lu(k,2745) - lu(k,2301) * lu(k,2729) + lu(k,2746) = lu(k,2746) - lu(k,2302) * lu(k,2729) + lu(k,2747) = lu(k,2747) - lu(k,2303) * lu(k,2729) + lu(k,2748) = lu(k,2748) - lu(k,2304) * lu(k,2729) + lu(k,2749) = lu(k,2749) - lu(k,2305) * lu(k,2729) + lu(k,2750) = lu(k,2750) - lu(k,2306) * lu(k,2729) + lu(k,2752) = lu(k,2752) - lu(k,2307) * lu(k,2729) + lu(k,2753) = lu(k,2753) - lu(k,2308) * lu(k,2729) + lu(k,2754) = lu(k,2754) - lu(k,2309) * lu(k,2729) + lu(k,2755) = lu(k,2755) - lu(k,2310) * lu(k,2729) + lu(k,2756) = lu(k,2756) - lu(k,2311) * lu(k,2729) + lu(k,2757) = lu(k,2757) - lu(k,2312) * lu(k,2729) + lu(k,2760) = lu(k,2760) - lu(k,2313) * lu(k,2729) + lu(k,2761) = lu(k,2761) - lu(k,2314) * lu(k,2729) + lu(k,2778) = lu(k,2778) - lu(k,2297) * lu(k,2775) + lu(k,2788) = lu(k,2788) - lu(k,2298) * lu(k,2775) + lu(k,2789) = lu(k,2789) - lu(k,2299) * lu(k,2775) + lu(k,2790) = lu(k,2790) - lu(k,2300) * lu(k,2775) + lu(k,2791) = lu(k,2791) - lu(k,2301) * lu(k,2775) + lu(k,2792) = lu(k,2792) - lu(k,2302) * lu(k,2775) + lu(k,2793) = lu(k,2793) - lu(k,2303) * lu(k,2775) + lu(k,2794) = lu(k,2794) - lu(k,2304) * lu(k,2775) + lu(k,2795) = lu(k,2795) - lu(k,2305) * lu(k,2775) + lu(k,2796) = lu(k,2796) - lu(k,2306) * lu(k,2775) + lu(k,2798) = lu(k,2798) - lu(k,2307) * lu(k,2775) + lu(k,2799) = lu(k,2799) - lu(k,2308) * lu(k,2775) + lu(k,2800) = lu(k,2800) - lu(k,2309) * lu(k,2775) + lu(k,2801) = lu(k,2801) - lu(k,2310) * lu(k,2775) + lu(k,2802) = lu(k,2802) - lu(k,2311) * lu(k,2775) + lu(k,2803) = lu(k,2803) - lu(k,2312) * lu(k,2775) + lu(k,2806) = lu(k,2806) - lu(k,2313) * lu(k,2775) + lu(k,2807) = lu(k,2807) - lu(k,2314) * lu(k,2775) + lu(k,2825) = lu(k,2825) - lu(k,2297) * lu(k,2822) + lu(k,2835) = lu(k,2835) - lu(k,2298) * lu(k,2822) + lu(k,2836) = lu(k,2836) - lu(k,2299) * lu(k,2822) + lu(k,2837) = lu(k,2837) - lu(k,2300) * lu(k,2822) + lu(k,2838) = lu(k,2838) - lu(k,2301) * lu(k,2822) + lu(k,2839) = lu(k,2839) - lu(k,2302) * lu(k,2822) + lu(k,2840) = lu(k,2840) - lu(k,2303) * lu(k,2822) + lu(k,2841) = lu(k,2841) - lu(k,2304) * lu(k,2822) + lu(k,2842) = lu(k,2842) - lu(k,2305) * lu(k,2822) + lu(k,2843) = lu(k,2843) - lu(k,2306) * lu(k,2822) + lu(k,2845) = lu(k,2845) - lu(k,2307) * lu(k,2822) + lu(k,2846) = lu(k,2846) - lu(k,2308) * lu(k,2822) + lu(k,2847) = lu(k,2847) - lu(k,2309) * lu(k,2822) + lu(k,2848) = lu(k,2848) - lu(k,2310) * lu(k,2822) + lu(k,2849) = lu(k,2849) - lu(k,2311) * lu(k,2822) + lu(k,2850) = lu(k,2850) - lu(k,2312) * lu(k,2822) + lu(k,2853) = lu(k,2853) - lu(k,2313) * lu(k,2822) + lu(k,2854) = lu(k,2854) - lu(k,2314) * lu(k,2822) + lu(k,2897) = lu(k,2897) - lu(k,2297) * lu(k,2894) + lu(k,2907) = lu(k,2907) - lu(k,2298) * lu(k,2894) + lu(k,2908) = lu(k,2908) - lu(k,2299) * lu(k,2894) + lu(k,2909) = lu(k,2909) - lu(k,2300) * lu(k,2894) + lu(k,2910) = lu(k,2910) - lu(k,2301) * lu(k,2894) + lu(k,2911) = lu(k,2911) - lu(k,2302) * lu(k,2894) + lu(k,2912) = lu(k,2912) - lu(k,2303) * lu(k,2894) + lu(k,2913) = lu(k,2913) - lu(k,2304) * lu(k,2894) + lu(k,2915) = lu(k,2915) - lu(k,2305) * lu(k,2894) + lu(k,2916) = lu(k,2916) - lu(k,2306) * lu(k,2894) + lu(k,2918) = lu(k,2918) - lu(k,2307) * lu(k,2894) + lu(k,2919) = lu(k,2919) - lu(k,2308) * lu(k,2894) + lu(k,2920) = lu(k,2920) - lu(k,2309) * lu(k,2894) + lu(k,2921) = lu(k,2921) - lu(k,2310) * lu(k,2894) + lu(k,2922) = lu(k,2922) - lu(k,2311) * lu(k,2894) + lu(k,2923) = lu(k,2923) - lu(k,2312) * lu(k,2894) + lu(k,2927) = lu(k,2927) - lu(k,2313) * lu(k,2894) + lu(k,2928) = lu(k,2928) - lu(k,2314) * lu(k,2894) + lu(k,3087) = lu(k,3087) - lu(k,2297) * lu(k,3084) + lu(k,3097) = lu(k,3097) - lu(k,2298) * lu(k,3084) + lu(k,3098) = lu(k,3098) - lu(k,2299) * lu(k,3084) + lu(k,3099) = lu(k,3099) - lu(k,2300) * lu(k,3084) + lu(k,3100) = lu(k,3100) - lu(k,2301) * lu(k,3084) + lu(k,3101) = lu(k,3101) - lu(k,2302) * lu(k,3084) + lu(k,3102) = lu(k,3102) - lu(k,2303) * lu(k,3084) + lu(k,3103) = lu(k,3103) - lu(k,2304) * lu(k,3084) + lu(k,3105) = lu(k,3105) - lu(k,2305) * lu(k,3084) + lu(k,3106) = lu(k,3106) - lu(k,2306) * lu(k,3084) + lu(k,3108) = lu(k,3108) - lu(k,2307) * lu(k,3084) + lu(k,3109) = lu(k,3109) - lu(k,2308) * lu(k,3084) + lu(k,3110) = lu(k,3110) - lu(k,2309) * lu(k,3084) + lu(k,3111) = lu(k,3111) - lu(k,2310) * lu(k,3084) + lu(k,3114) = lu(k,3114) - lu(k,2311) * lu(k,3084) + lu(k,3115) = lu(k,3115) - lu(k,2312) * lu(k,3084) + lu(k,3119) = lu(k,3119) - lu(k,2313) * lu(k,3084) + lu(k,3120) = lu(k,3120) - lu(k,2314) * lu(k,3084) + lu(k,3346) = lu(k,3346) - lu(k,2297) * lu(k,3343) + lu(k,3356) = lu(k,3356) - lu(k,2298) * lu(k,3343) + lu(k,3357) = lu(k,3357) - lu(k,2299) * lu(k,3343) + lu(k,3358) = lu(k,3358) - lu(k,2300) * lu(k,3343) + lu(k,3359) = lu(k,3359) - lu(k,2301) * lu(k,3343) + lu(k,3360) = lu(k,3360) - lu(k,2302) * lu(k,3343) + lu(k,3361) = lu(k,3361) - lu(k,2303) * lu(k,3343) + lu(k,3362) = lu(k,3362) - lu(k,2304) * lu(k,3343) + lu(k,3364) = lu(k,3364) - lu(k,2305) * lu(k,3343) + lu(k,3365) = lu(k,3365) - lu(k,2306) * lu(k,3343) + lu(k,3367) = lu(k,3367) - lu(k,2307) * lu(k,3343) + lu(k,3368) = lu(k,3368) - lu(k,2308) * lu(k,3343) + lu(k,3369) = lu(k,3369) - lu(k,2309) * lu(k,3343) + lu(k,3370) = lu(k,3370) - lu(k,2310) * lu(k,3343) + lu(k,3373) = lu(k,3373) - lu(k,2311) * lu(k,3343) + lu(k,3374) = lu(k,3374) - lu(k,2312) * lu(k,3343) + lu(k,3378) = lu(k,3378) - lu(k,2313) * lu(k,3343) + lu(k,3379) = lu(k,3379) - lu(k,2314) * lu(k,3343) + lu(k,3439) = lu(k,3439) - lu(k,2297) * lu(k,3436) + lu(k,3449) = lu(k,3449) - lu(k,2298) * lu(k,3436) + lu(k,3450) = lu(k,3450) - lu(k,2299) * lu(k,3436) + lu(k,3451) = lu(k,3451) - lu(k,2300) * lu(k,3436) + lu(k,3452) = lu(k,3452) - lu(k,2301) * lu(k,3436) + lu(k,3453) = lu(k,3453) - lu(k,2302) * lu(k,3436) + lu(k,3454) = lu(k,3454) - lu(k,2303) * lu(k,3436) + lu(k,3455) = lu(k,3455) - lu(k,2304) * lu(k,3436) + lu(k,3457) = lu(k,3457) - lu(k,2305) * lu(k,3436) + lu(k,3458) = lu(k,3458) - lu(k,2306) * lu(k,3436) + lu(k,3460) = lu(k,3460) - lu(k,2307) * lu(k,3436) + lu(k,3461) = lu(k,3461) - lu(k,2308) * lu(k,3436) + lu(k,3462) = lu(k,3462) - lu(k,2309) * lu(k,3436) + lu(k,3463) = lu(k,3463) - lu(k,2310) * lu(k,3436) + lu(k,3466) = lu(k,3466) - lu(k,2311) * lu(k,3436) + lu(k,3467) = lu(k,3467) - lu(k,2312) * lu(k,3436) + lu(k,3471) = lu(k,3471) - lu(k,2313) * lu(k,3436) + lu(k,3472) = lu(k,3472) - lu(k,2314) * lu(k,3436) + lu(k,3583) = lu(k,3583) - lu(k,2297) * lu(k,3580) + lu(k,3593) = lu(k,3593) - lu(k,2298) * lu(k,3580) + lu(k,3594) = lu(k,3594) - lu(k,2299) * lu(k,3580) + lu(k,3595) = lu(k,3595) - lu(k,2300) * lu(k,3580) + lu(k,3596) = lu(k,3596) - lu(k,2301) * lu(k,3580) + lu(k,3597) = lu(k,3597) - lu(k,2302) * lu(k,3580) + lu(k,3598) = lu(k,3598) - lu(k,2303) * lu(k,3580) + lu(k,3599) = lu(k,3599) - lu(k,2304) * lu(k,3580) + lu(k,3601) = lu(k,3601) - lu(k,2305) * lu(k,3580) + lu(k,3602) = lu(k,3602) - lu(k,2306) * lu(k,3580) + lu(k,3604) = lu(k,3604) - lu(k,2307) * lu(k,3580) + lu(k,3605) = lu(k,3605) - lu(k,2308) * lu(k,3580) + lu(k,3606) = lu(k,3606) - lu(k,2309) * lu(k,3580) + lu(k,3607) = lu(k,3607) - lu(k,2310) * lu(k,3580) + lu(k,3610) = lu(k,3610) - lu(k,2311) * lu(k,3580) + lu(k,3611) = lu(k,3611) - lu(k,2312) * lu(k,3580) + lu(k,3615) = lu(k,3615) - lu(k,2313) * lu(k,3580) + lu(k,3616) = lu(k,3616) - lu(k,2314) * lu(k,3580) + lu(k,3737) = lu(k,3737) - lu(k,2297) * lu(k,3735) + lu(k,3747) = lu(k,3747) - lu(k,2298) * lu(k,3735) + lu(k,3748) = lu(k,3748) - lu(k,2299) * lu(k,3735) + lu(k,3749) = lu(k,3749) - lu(k,2300) * lu(k,3735) + lu(k,3750) = lu(k,3750) - lu(k,2301) * lu(k,3735) + lu(k,3751) = lu(k,3751) - lu(k,2302) * lu(k,3735) + lu(k,3752) = lu(k,3752) - lu(k,2303) * lu(k,3735) + lu(k,3753) = lu(k,3753) - lu(k,2304) * lu(k,3735) + lu(k,3755) = lu(k,3755) - lu(k,2305) * lu(k,3735) + lu(k,3756) = lu(k,3756) - lu(k,2306) * lu(k,3735) + lu(k,3758) = lu(k,3758) - lu(k,2307) * lu(k,3735) + lu(k,3759) = lu(k,3759) - lu(k,2308) * lu(k,3735) + lu(k,3760) = lu(k,3760) - lu(k,2309) * lu(k,3735) + lu(k,3761) = lu(k,3761) - lu(k,2310) * lu(k,3735) + lu(k,3764) = lu(k,3764) - lu(k,2311) * lu(k,3735) + lu(k,3765) = lu(k,3765) - lu(k,2312) * lu(k,3735) + lu(k,3769) = lu(k,3769) - lu(k,2313) * lu(k,3735) + lu(k,3770) = lu(k,3770) - lu(k,2314) * lu(k,3735) + lu(k,4069) = lu(k,4069) - lu(k,2297) * lu(k,4066) + lu(k,4079) = lu(k,4079) - lu(k,2298) * lu(k,4066) + lu(k,4080) = lu(k,4080) - lu(k,2299) * lu(k,4066) + lu(k,4081) = lu(k,4081) - lu(k,2300) * lu(k,4066) + lu(k,4082) = lu(k,4082) - lu(k,2301) * lu(k,4066) + lu(k,4083) = lu(k,4083) - lu(k,2302) * lu(k,4066) + lu(k,4084) = lu(k,4084) - lu(k,2303) * lu(k,4066) + lu(k,4085) = lu(k,4085) - lu(k,2304) * lu(k,4066) + lu(k,4087) = lu(k,4087) - lu(k,2305) * lu(k,4066) + lu(k,4088) = lu(k,4088) - lu(k,2306) * lu(k,4066) + lu(k,4090) = lu(k,4090) - lu(k,2307) * lu(k,4066) + lu(k,4091) = lu(k,4091) - lu(k,2308) * lu(k,4066) + lu(k,4092) = lu(k,4092) - lu(k,2309) * lu(k,4066) + lu(k,4093) = lu(k,4093) - lu(k,2310) * lu(k,4066) + lu(k,4096) = lu(k,4096) - lu(k,2311) * lu(k,4066) + lu(k,4097) = lu(k,4097) - lu(k,2312) * lu(k,4066) + lu(k,4101) = lu(k,4101) - lu(k,2313) * lu(k,4066) + lu(k,4102) = lu(k,4102) - lu(k,2314) * lu(k,4066) + lu(k,2320) = 1._r8 / lu(k,2320) + lu(k,2321) = lu(k,2321) * lu(k,2320) + lu(k,2322) = lu(k,2322) * lu(k,2320) + lu(k,2323) = lu(k,2323) * lu(k,2320) + lu(k,2324) = lu(k,2324) * lu(k,2320) + lu(k,2325) = lu(k,2325) * lu(k,2320) + lu(k,2326) = lu(k,2326) * lu(k,2320) + lu(k,2327) = lu(k,2327) * lu(k,2320) + lu(k,2328) = lu(k,2328) * lu(k,2320) + lu(k,2329) = lu(k,2329) * lu(k,2320) + lu(k,2330) = lu(k,2330) * lu(k,2320) + lu(k,2331) = lu(k,2331) * lu(k,2320) + lu(k,2332) = lu(k,2332) * lu(k,2320) + lu(k,2340) = lu(k,2340) - lu(k,2321) * lu(k,2338) + lu(k,2341) = lu(k,2341) - lu(k,2322) * lu(k,2338) + lu(k,2343) = lu(k,2343) - lu(k,2323) * lu(k,2338) + lu(k,2346) = lu(k,2346) - lu(k,2324) * lu(k,2338) + lu(k,2349) = lu(k,2349) - lu(k,2325) * lu(k,2338) + lu(k,2350) = lu(k,2350) - lu(k,2326) * lu(k,2338) + lu(k,2351) = lu(k,2351) - lu(k,2327) * lu(k,2338) + lu(k,2352) = lu(k,2352) - lu(k,2328) * lu(k,2338) + lu(k,2353) = lu(k,2353) - lu(k,2329) * lu(k,2338) + lu(k,2355) = lu(k,2355) - lu(k,2330) * lu(k,2338) + lu(k,2356) = lu(k,2356) - lu(k,2331) * lu(k,2338) + lu(k,2357) = lu(k,2357) - lu(k,2332) * lu(k,2338) + lu(k,2379) = lu(k,2379) - lu(k,2321) * lu(k,2378) + lu(k,2381) = lu(k,2381) - lu(k,2322) * lu(k,2378) + lu(k,2383) = lu(k,2383) - lu(k,2323) * lu(k,2378) + lu(k,2386) = lu(k,2386) - lu(k,2324) * lu(k,2378) + lu(k,2389) = lu(k,2389) - lu(k,2325) * lu(k,2378) + lu(k,2390) = lu(k,2390) - lu(k,2326) * lu(k,2378) + lu(k,2391) = lu(k,2391) - lu(k,2327) * lu(k,2378) + lu(k,2392) = lu(k,2392) - lu(k,2328) * lu(k,2378) + lu(k,2393) = lu(k,2393) - lu(k,2329) * lu(k,2378) + lu(k,2395) = lu(k,2395) - lu(k,2330) * lu(k,2378) + lu(k,2396) = lu(k,2396) - lu(k,2331) * lu(k,2378) + lu(k,2397) = lu(k,2397) - lu(k,2332) * lu(k,2378) + lu(k,2407) = lu(k,2407) - lu(k,2321) * lu(k,2406) + lu(k,2410) = - lu(k,2322) * lu(k,2406) + lu(k,2412) = lu(k,2412) - lu(k,2323) * lu(k,2406) + lu(k,2415) = lu(k,2415) - lu(k,2324) * lu(k,2406) + lu(k,2418) = - lu(k,2325) * lu(k,2406) + lu(k,2419) = lu(k,2419) - lu(k,2326) * lu(k,2406) + lu(k,2420) = lu(k,2420) - lu(k,2327) * lu(k,2406) + lu(k,2421) = lu(k,2421) - lu(k,2328) * lu(k,2406) + lu(k,2422) = lu(k,2422) - lu(k,2329) * lu(k,2406) + lu(k,2424) = lu(k,2424) - lu(k,2330) * lu(k,2406) + lu(k,2425) = lu(k,2425) - lu(k,2331) * lu(k,2406) + lu(k,2426) = lu(k,2426) - lu(k,2332) * lu(k,2406) + lu(k,2440) = lu(k,2440) - lu(k,2321) * lu(k,2439) + lu(k,2442) = lu(k,2442) - lu(k,2322) * lu(k,2439) + lu(k,2444) = lu(k,2444) - lu(k,2323) * lu(k,2439) + lu(k,2447) = lu(k,2447) - lu(k,2324) * lu(k,2439) + lu(k,2450) = lu(k,2450) - lu(k,2325) * lu(k,2439) + lu(k,2451) = lu(k,2451) - lu(k,2326) * lu(k,2439) + lu(k,2452) = lu(k,2452) - lu(k,2327) * lu(k,2439) + lu(k,2453) = lu(k,2453) - lu(k,2328) * lu(k,2439) + lu(k,2454) = lu(k,2454) - lu(k,2329) * lu(k,2439) + lu(k,2456) = lu(k,2456) - lu(k,2330) * lu(k,2439) + lu(k,2457) = lu(k,2457) - lu(k,2331) * lu(k,2439) + lu(k,2458) = lu(k,2458) - lu(k,2332) * lu(k,2439) + lu(k,2470) = lu(k,2470) - lu(k,2321) * lu(k,2469) + lu(k,2473) = lu(k,2473) - lu(k,2322) * lu(k,2469) + lu(k,2475) = lu(k,2475) - lu(k,2323) * lu(k,2469) + lu(k,2478) = lu(k,2478) - lu(k,2324) * lu(k,2469) + lu(k,2481) = lu(k,2481) - lu(k,2325) * lu(k,2469) + lu(k,2482) = lu(k,2482) - lu(k,2326) * lu(k,2469) + lu(k,2483) = lu(k,2483) - lu(k,2327) * lu(k,2469) + lu(k,2484) = lu(k,2484) - lu(k,2328) * lu(k,2469) + lu(k,2485) = lu(k,2485) - lu(k,2329) * lu(k,2469) + lu(k,2487) = lu(k,2487) - lu(k,2330) * lu(k,2469) + lu(k,2488) = lu(k,2488) - lu(k,2331) * lu(k,2469) + lu(k,2489) = lu(k,2489) - lu(k,2332) * lu(k,2469) + lu(k,2599) = lu(k,2599) - lu(k,2321) * lu(k,2598) + lu(k,2601) = lu(k,2601) - lu(k,2322) * lu(k,2598) + lu(k,2603) = - lu(k,2323) * lu(k,2598) + lu(k,2605) = - lu(k,2324) * lu(k,2598) + lu(k,2607) = lu(k,2607) - lu(k,2325) * lu(k,2598) + lu(k,2608) = lu(k,2608) - lu(k,2326) * lu(k,2598) + lu(k,2610) = lu(k,2610) - lu(k,2327) * lu(k,2598) + lu(k,2611) = lu(k,2611) - lu(k,2328) * lu(k,2598) + lu(k,2612) = lu(k,2612) - lu(k,2329) * lu(k,2598) + lu(k,2613) = lu(k,2613) - lu(k,2330) * lu(k,2598) + lu(k,2614) = lu(k,2614) - lu(k,2331) * lu(k,2598) + lu(k,2617) = lu(k,2617) - lu(k,2332) * lu(k,2598) + lu(k,2732) = lu(k,2732) - lu(k,2321) * lu(k,2730) + lu(k,2741) = lu(k,2741) - lu(k,2322) * lu(k,2730) + lu(k,2743) = lu(k,2743) - lu(k,2323) * lu(k,2730) + lu(k,2746) = lu(k,2746) - lu(k,2324) * lu(k,2730) + lu(k,2749) = lu(k,2749) - lu(k,2325) * lu(k,2730) + lu(k,2750) = lu(k,2750) - lu(k,2326) * lu(k,2730) + lu(k,2752) = lu(k,2752) - lu(k,2327) * lu(k,2730) + lu(k,2753) = lu(k,2753) - lu(k,2328) * lu(k,2730) + lu(k,2754) = lu(k,2754) - lu(k,2329) * lu(k,2730) + lu(k,2756) = lu(k,2756) - lu(k,2330) * lu(k,2730) + lu(k,2757) = lu(k,2757) - lu(k,2331) * lu(k,2730) + lu(k,2760) = lu(k,2760) - lu(k,2332) * lu(k,2730) + lu(k,2778) = lu(k,2778) - lu(k,2321) * lu(k,2776) + lu(k,2787) = lu(k,2787) - lu(k,2322) * lu(k,2776) + lu(k,2789) = lu(k,2789) - lu(k,2323) * lu(k,2776) + lu(k,2792) = lu(k,2792) - lu(k,2324) * lu(k,2776) + lu(k,2795) = lu(k,2795) - lu(k,2325) * lu(k,2776) + lu(k,2796) = lu(k,2796) - lu(k,2326) * lu(k,2776) + lu(k,2798) = lu(k,2798) - lu(k,2327) * lu(k,2776) + lu(k,2799) = lu(k,2799) - lu(k,2328) * lu(k,2776) + lu(k,2800) = lu(k,2800) - lu(k,2329) * lu(k,2776) + lu(k,2802) = lu(k,2802) - lu(k,2330) * lu(k,2776) + lu(k,2803) = lu(k,2803) - lu(k,2331) * lu(k,2776) + lu(k,2806) = lu(k,2806) - lu(k,2332) * lu(k,2776) + lu(k,2825) = lu(k,2825) - lu(k,2321) * lu(k,2823) + lu(k,2834) = lu(k,2834) - lu(k,2322) * lu(k,2823) + lu(k,2836) = lu(k,2836) - lu(k,2323) * lu(k,2823) + lu(k,2839) = lu(k,2839) - lu(k,2324) * lu(k,2823) + lu(k,2842) = lu(k,2842) - lu(k,2325) * lu(k,2823) + lu(k,2843) = lu(k,2843) - lu(k,2326) * lu(k,2823) + lu(k,2845) = lu(k,2845) - lu(k,2327) * lu(k,2823) + lu(k,2846) = lu(k,2846) - lu(k,2328) * lu(k,2823) + lu(k,2847) = lu(k,2847) - lu(k,2329) * lu(k,2823) + lu(k,2849) = lu(k,2849) - lu(k,2330) * lu(k,2823) + lu(k,2850) = lu(k,2850) - lu(k,2331) * lu(k,2823) + lu(k,2853) = lu(k,2853) - lu(k,2332) * lu(k,2823) + lu(k,2897) = lu(k,2897) - lu(k,2321) * lu(k,2895) + lu(k,2906) = lu(k,2906) - lu(k,2322) * lu(k,2895) + lu(k,2908) = lu(k,2908) - lu(k,2323) * lu(k,2895) + lu(k,2911) = lu(k,2911) - lu(k,2324) * lu(k,2895) + lu(k,2915) = lu(k,2915) - lu(k,2325) * lu(k,2895) + lu(k,2916) = lu(k,2916) - lu(k,2326) * lu(k,2895) + lu(k,2918) = lu(k,2918) - lu(k,2327) * lu(k,2895) + lu(k,2919) = lu(k,2919) - lu(k,2328) * lu(k,2895) + lu(k,2920) = lu(k,2920) - lu(k,2329) * lu(k,2895) + lu(k,2922) = lu(k,2922) - lu(k,2330) * lu(k,2895) + lu(k,2923) = lu(k,2923) - lu(k,2331) * lu(k,2895) + lu(k,2927) = lu(k,2927) - lu(k,2332) * lu(k,2895) + lu(k,3087) = lu(k,3087) - lu(k,2321) * lu(k,3085) + lu(k,3096) = lu(k,3096) - lu(k,2322) * lu(k,3085) + lu(k,3098) = lu(k,3098) - lu(k,2323) * lu(k,3085) + lu(k,3101) = lu(k,3101) - lu(k,2324) * lu(k,3085) + lu(k,3105) = lu(k,3105) - lu(k,2325) * lu(k,3085) + lu(k,3106) = lu(k,3106) - lu(k,2326) * lu(k,3085) + lu(k,3108) = lu(k,3108) - lu(k,2327) * lu(k,3085) + lu(k,3109) = lu(k,3109) - lu(k,2328) * lu(k,3085) + lu(k,3110) = lu(k,3110) - lu(k,2329) * lu(k,3085) + lu(k,3114) = lu(k,3114) - lu(k,2330) * lu(k,3085) + lu(k,3115) = lu(k,3115) - lu(k,2331) * lu(k,3085) + lu(k,3119) = lu(k,3119) - lu(k,2332) * lu(k,3085) + lu(k,3346) = lu(k,3346) - lu(k,2321) * lu(k,3344) + lu(k,3355) = lu(k,3355) - lu(k,2322) * lu(k,3344) + lu(k,3357) = lu(k,3357) - lu(k,2323) * lu(k,3344) + lu(k,3360) = lu(k,3360) - lu(k,2324) * lu(k,3344) + lu(k,3364) = lu(k,3364) - lu(k,2325) * lu(k,3344) + lu(k,3365) = lu(k,3365) - lu(k,2326) * lu(k,3344) + lu(k,3367) = lu(k,3367) - lu(k,2327) * lu(k,3344) + lu(k,3368) = lu(k,3368) - lu(k,2328) * lu(k,3344) + lu(k,3369) = lu(k,3369) - lu(k,2329) * lu(k,3344) + lu(k,3373) = lu(k,3373) - lu(k,2330) * lu(k,3344) + lu(k,3374) = lu(k,3374) - lu(k,2331) * lu(k,3344) + lu(k,3378) = lu(k,3378) - lu(k,2332) * lu(k,3344) + lu(k,3439) = lu(k,3439) - lu(k,2321) * lu(k,3437) + lu(k,3448) = lu(k,3448) - lu(k,2322) * lu(k,3437) + lu(k,3450) = lu(k,3450) - lu(k,2323) * lu(k,3437) + lu(k,3453) = lu(k,3453) - lu(k,2324) * lu(k,3437) + lu(k,3457) = lu(k,3457) - lu(k,2325) * lu(k,3437) + lu(k,3458) = lu(k,3458) - lu(k,2326) * lu(k,3437) + lu(k,3460) = lu(k,3460) - lu(k,2327) * lu(k,3437) + lu(k,3461) = lu(k,3461) - lu(k,2328) * lu(k,3437) + lu(k,3462) = lu(k,3462) - lu(k,2329) * lu(k,3437) + lu(k,3466) = lu(k,3466) - lu(k,2330) * lu(k,3437) + lu(k,3467) = lu(k,3467) - lu(k,2331) * lu(k,3437) + lu(k,3471) = lu(k,3471) - lu(k,2332) * lu(k,3437) + lu(k,3583) = lu(k,3583) - lu(k,2321) * lu(k,3581) + lu(k,3592) = lu(k,3592) - lu(k,2322) * lu(k,3581) + lu(k,3594) = lu(k,3594) - lu(k,2323) * lu(k,3581) + lu(k,3597) = lu(k,3597) - lu(k,2324) * lu(k,3581) + lu(k,3601) = lu(k,3601) - lu(k,2325) * lu(k,3581) + lu(k,3602) = lu(k,3602) - lu(k,2326) * lu(k,3581) + lu(k,3604) = lu(k,3604) - lu(k,2327) * lu(k,3581) + lu(k,3605) = lu(k,3605) - lu(k,2328) * lu(k,3581) + lu(k,3606) = lu(k,3606) - lu(k,2329) * lu(k,3581) + lu(k,3610) = lu(k,3610) - lu(k,2330) * lu(k,3581) + lu(k,3611) = lu(k,3611) - lu(k,2331) * lu(k,3581) + lu(k,3615) = lu(k,3615) - lu(k,2332) * lu(k,3581) + lu(k,4069) = lu(k,4069) - lu(k,2321) * lu(k,4067) + lu(k,4078) = lu(k,4078) - lu(k,2322) * lu(k,4067) + lu(k,4080) = lu(k,4080) - lu(k,2323) * lu(k,4067) + lu(k,4083) = lu(k,4083) - lu(k,2324) * lu(k,4067) + lu(k,4087) = lu(k,4087) - lu(k,2325) * lu(k,4067) + lu(k,4088) = lu(k,4088) - lu(k,2326) * lu(k,4067) + lu(k,4090) = lu(k,4090) - lu(k,2327) * lu(k,4067) + lu(k,4091) = lu(k,4091) - lu(k,2328) * lu(k,4067) + lu(k,4092) = lu(k,4092) - lu(k,2329) * lu(k,4067) + lu(k,4096) = lu(k,4096) - lu(k,2330) * lu(k,4067) + lu(k,4097) = lu(k,4097) - lu(k,2331) * lu(k,4067) + lu(k,4101) = lu(k,4101) - lu(k,2332) * lu(k,4067) + end do + end subroutine lu_fac46 + subroutine lu_fac47( 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,2339) = 1._r8 / lu(k,2339) + lu(k,2340) = lu(k,2340) * lu(k,2339) + lu(k,2341) = lu(k,2341) * lu(k,2339) + lu(k,2342) = lu(k,2342) * lu(k,2339) + lu(k,2343) = lu(k,2343) * lu(k,2339) + lu(k,2344) = lu(k,2344) * lu(k,2339) + lu(k,2345) = lu(k,2345) * lu(k,2339) + lu(k,2346) = lu(k,2346) * lu(k,2339) + lu(k,2347) = lu(k,2347) * lu(k,2339) + lu(k,2348) = lu(k,2348) * lu(k,2339) + lu(k,2349) = lu(k,2349) * lu(k,2339) + lu(k,2350) = lu(k,2350) * lu(k,2339) + lu(k,2351) = lu(k,2351) * lu(k,2339) + lu(k,2352) = lu(k,2352) * lu(k,2339) + lu(k,2353) = lu(k,2353) * lu(k,2339) + lu(k,2354) = lu(k,2354) * lu(k,2339) + lu(k,2355) = lu(k,2355) * lu(k,2339) + lu(k,2356) = lu(k,2356) * lu(k,2339) + lu(k,2357) = lu(k,2357) * lu(k,2339) + lu(k,2732) = lu(k,2732) - lu(k,2340) * lu(k,2731) + lu(k,2741) = lu(k,2741) - lu(k,2341) * lu(k,2731) + lu(k,2742) = lu(k,2742) - lu(k,2342) * lu(k,2731) + lu(k,2743) = lu(k,2743) - lu(k,2343) * lu(k,2731) + lu(k,2744) = lu(k,2744) - lu(k,2344) * lu(k,2731) + lu(k,2745) = lu(k,2745) - lu(k,2345) * lu(k,2731) + lu(k,2746) = lu(k,2746) - lu(k,2346) * lu(k,2731) + lu(k,2747) = lu(k,2747) - lu(k,2347) * lu(k,2731) + lu(k,2748) = lu(k,2748) - lu(k,2348) * lu(k,2731) + lu(k,2749) = lu(k,2749) - lu(k,2349) * lu(k,2731) + lu(k,2750) = lu(k,2750) - lu(k,2350) * lu(k,2731) + lu(k,2752) = lu(k,2752) - lu(k,2351) * lu(k,2731) + lu(k,2753) = lu(k,2753) - lu(k,2352) * lu(k,2731) + lu(k,2754) = lu(k,2754) - lu(k,2353) * lu(k,2731) + lu(k,2755) = lu(k,2755) - lu(k,2354) * lu(k,2731) + lu(k,2756) = lu(k,2756) - lu(k,2355) * lu(k,2731) + lu(k,2757) = lu(k,2757) - lu(k,2356) * lu(k,2731) + lu(k,2760) = lu(k,2760) - lu(k,2357) * lu(k,2731) + lu(k,2778) = lu(k,2778) - lu(k,2340) * lu(k,2777) + lu(k,2787) = lu(k,2787) - lu(k,2341) * lu(k,2777) + lu(k,2788) = lu(k,2788) - lu(k,2342) * lu(k,2777) + lu(k,2789) = lu(k,2789) - lu(k,2343) * lu(k,2777) + lu(k,2790) = lu(k,2790) - lu(k,2344) * lu(k,2777) + lu(k,2791) = lu(k,2791) - lu(k,2345) * lu(k,2777) + lu(k,2792) = lu(k,2792) - lu(k,2346) * lu(k,2777) + lu(k,2793) = lu(k,2793) - lu(k,2347) * lu(k,2777) + lu(k,2794) = lu(k,2794) - lu(k,2348) * lu(k,2777) + lu(k,2795) = lu(k,2795) - lu(k,2349) * lu(k,2777) + lu(k,2796) = lu(k,2796) - lu(k,2350) * lu(k,2777) + lu(k,2798) = lu(k,2798) - lu(k,2351) * lu(k,2777) + lu(k,2799) = lu(k,2799) - lu(k,2352) * lu(k,2777) + lu(k,2800) = lu(k,2800) - lu(k,2353) * lu(k,2777) + lu(k,2801) = lu(k,2801) - lu(k,2354) * lu(k,2777) + lu(k,2802) = lu(k,2802) - lu(k,2355) * lu(k,2777) + lu(k,2803) = lu(k,2803) - lu(k,2356) * lu(k,2777) + lu(k,2806) = lu(k,2806) - lu(k,2357) * lu(k,2777) + lu(k,2825) = lu(k,2825) - lu(k,2340) * lu(k,2824) + lu(k,2834) = lu(k,2834) - lu(k,2341) * lu(k,2824) + lu(k,2835) = lu(k,2835) - lu(k,2342) * lu(k,2824) + lu(k,2836) = lu(k,2836) - lu(k,2343) * lu(k,2824) + lu(k,2837) = lu(k,2837) - lu(k,2344) * lu(k,2824) + lu(k,2838) = lu(k,2838) - lu(k,2345) * lu(k,2824) + lu(k,2839) = lu(k,2839) - lu(k,2346) * lu(k,2824) + lu(k,2840) = lu(k,2840) - lu(k,2347) * lu(k,2824) + lu(k,2841) = lu(k,2841) - lu(k,2348) * lu(k,2824) + lu(k,2842) = lu(k,2842) - lu(k,2349) * lu(k,2824) + lu(k,2843) = lu(k,2843) - lu(k,2350) * lu(k,2824) + lu(k,2845) = lu(k,2845) - lu(k,2351) * lu(k,2824) + lu(k,2846) = lu(k,2846) - lu(k,2352) * lu(k,2824) + lu(k,2847) = lu(k,2847) - lu(k,2353) * lu(k,2824) + lu(k,2848) = lu(k,2848) - lu(k,2354) * lu(k,2824) + lu(k,2849) = lu(k,2849) - lu(k,2355) * lu(k,2824) + lu(k,2850) = lu(k,2850) - lu(k,2356) * lu(k,2824) + lu(k,2853) = lu(k,2853) - lu(k,2357) * lu(k,2824) + lu(k,2897) = lu(k,2897) - lu(k,2340) * lu(k,2896) + lu(k,2906) = lu(k,2906) - lu(k,2341) * lu(k,2896) + lu(k,2907) = lu(k,2907) - lu(k,2342) * lu(k,2896) + lu(k,2908) = lu(k,2908) - lu(k,2343) * lu(k,2896) + lu(k,2909) = lu(k,2909) - lu(k,2344) * lu(k,2896) + lu(k,2910) = lu(k,2910) - lu(k,2345) * lu(k,2896) + lu(k,2911) = lu(k,2911) - lu(k,2346) * lu(k,2896) + lu(k,2912) = lu(k,2912) - lu(k,2347) * lu(k,2896) + lu(k,2913) = lu(k,2913) - lu(k,2348) * lu(k,2896) + lu(k,2915) = lu(k,2915) - lu(k,2349) * lu(k,2896) + lu(k,2916) = lu(k,2916) - lu(k,2350) * lu(k,2896) + lu(k,2918) = lu(k,2918) - lu(k,2351) * lu(k,2896) + lu(k,2919) = lu(k,2919) - lu(k,2352) * lu(k,2896) + lu(k,2920) = lu(k,2920) - lu(k,2353) * lu(k,2896) + lu(k,2921) = lu(k,2921) - lu(k,2354) * lu(k,2896) + lu(k,2922) = lu(k,2922) - lu(k,2355) * lu(k,2896) + lu(k,2923) = lu(k,2923) - lu(k,2356) * lu(k,2896) + lu(k,2927) = lu(k,2927) - lu(k,2357) * lu(k,2896) + lu(k,3087) = lu(k,3087) - lu(k,2340) * lu(k,3086) + lu(k,3096) = lu(k,3096) - lu(k,2341) * lu(k,3086) + lu(k,3097) = lu(k,3097) - lu(k,2342) * lu(k,3086) + lu(k,3098) = lu(k,3098) - lu(k,2343) * lu(k,3086) + lu(k,3099) = lu(k,3099) - lu(k,2344) * lu(k,3086) + lu(k,3100) = lu(k,3100) - lu(k,2345) * lu(k,3086) + lu(k,3101) = lu(k,3101) - lu(k,2346) * lu(k,3086) + lu(k,3102) = lu(k,3102) - lu(k,2347) * lu(k,3086) + lu(k,3103) = lu(k,3103) - lu(k,2348) * lu(k,3086) + lu(k,3105) = lu(k,3105) - lu(k,2349) * lu(k,3086) + lu(k,3106) = lu(k,3106) - lu(k,2350) * lu(k,3086) + lu(k,3108) = lu(k,3108) - lu(k,2351) * lu(k,3086) + lu(k,3109) = lu(k,3109) - lu(k,2352) * lu(k,3086) + lu(k,3110) = lu(k,3110) - lu(k,2353) * lu(k,3086) + lu(k,3111) = lu(k,3111) - lu(k,2354) * lu(k,3086) + lu(k,3114) = lu(k,3114) - lu(k,2355) * lu(k,3086) + lu(k,3115) = lu(k,3115) - lu(k,2356) * lu(k,3086) + lu(k,3119) = lu(k,3119) - lu(k,2357) * lu(k,3086) + lu(k,3346) = lu(k,3346) - lu(k,2340) * lu(k,3345) + lu(k,3355) = lu(k,3355) - lu(k,2341) * lu(k,3345) + lu(k,3356) = lu(k,3356) - lu(k,2342) * lu(k,3345) + lu(k,3357) = lu(k,3357) - lu(k,2343) * lu(k,3345) + lu(k,3358) = lu(k,3358) - lu(k,2344) * lu(k,3345) + lu(k,3359) = lu(k,3359) - lu(k,2345) * lu(k,3345) + lu(k,3360) = lu(k,3360) - lu(k,2346) * lu(k,3345) + lu(k,3361) = lu(k,3361) - lu(k,2347) * lu(k,3345) + lu(k,3362) = lu(k,3362) - lu(k,2348) * lu(k,3345) + lu(k,3364) = lu(k,3364) - lu(k,2349) * lu(k,3345) + lu(k,3365) = lu(k,3365) - lu(k,2350) * lu(k,3345) + lu(k,3367) = lu(k,3367) - lu(k,2351) * lu(k,3345) + lu(k,3368) = lu(k,3368) - lu(k,2352) * lu(k,3345) + lu(k,3369) = lu(k,3369) - lu(k,2353) * lu(k,3345) + lu(k,3370) = lu(k,3370) - lu(k,2354) * lu(k,3345) + lu(k,3373) = lu(k,3373) - lu(k,2355) * lu(k,3345) + lu(k,3374) = lu(k,3374) - lu(k,2356) * lu(k,3345) + lu(k,3378) = lu(k,3378) - lu(k,2357) * lu(k,3345) + lu(k,3439) = lu(k,3439) - lu(k,2340) * lu(k,3438) + lu(k,3448) = lu(k,3448) - lu(k,2341) * lu(k,3438) + lu(k,3449) = lu(k,3449) - lu(k,2342) * lu(k,3438) + lu(k,3450) = lu(k,3450) - lu(k,2343) * lu(k,3438) + lu(k,3451) = lu(k,3451) - lu(k,2344) * lu(k,3438) + lu(k,3452) = lu(k,3452) - lu(k,2345) * lu(k,3438) + lu(k,3453) = lu(k,3453) - lu(k,2346) * lu(k,3438) + lu(k,3454) = lu(k,3454) - lu(k,2347) * lu(k,3438) + lu(k,3455) = lu(k,3455) - lu(k,2348) * lu(k,3438) + lu(k,3457) = lu(k,3457) - lu(k,2349) * lu(k,3438) + lu(k,3458) = lu(k,3458) - lu(k,2350) * lu(k,3438) + lu(k,3460) = lu(k,3460) - lu(k,2351) * lu(k,3438) + lu(k,3461) = lu(k,3461) - lu(k,2352) * lu(k,3438) + lu(k,3462) = lu(k,3462) - lu(k,2353) * lu(k,3438) + lu(k,3463) = lu(k,3463) - lu(k,2354) * lu(k,3438) + lu(k,3466) = lu(k,3466) - lu(k,2355) * lu(k,3438) + lu(k,3467) = lu(k,3467) - lu(k,2356) * lu(k,3438) + lu(k,3471) = lu(k,3471) - lu(k,2357) * lu(k,3438) + lu(k,3583) = lu(k,3583) - lu(k,2340) * lu(k,3582) + lu(k,3592) = lu(k,3592) - lu(k,2341) * lu(k,3582) + lu(k,3593) = lu(k,3593) - lu(k,2342) * lu(k,3582) + lu(k,3594) = lu(k,3594) - lu(k,2343) * lu(k,3582) + lu(k,3595) = lu(k,3595) - lu(k,2344) * lu(k,3582) + lu(k,3596) = lu(k,3596) - lu(k,2345) * lu(k,3582) + lu(k,3597) = lu(k,3597) - lu(k,2346) * lu(k,3582) + lu(k,3598) = lu(k,3598) - lu(k,2347) * lu(k,3582) + lu(k,3599) = lu(k,3599) - lu(k,2348) * lu(k,3582) + lu(k,3601) = lu(k,3601) - lu(k,2349) * lu(k,3582) + lu(k,3602) = lu(k,3602) - lu(k,2350) * lu(k,3582) + lu(k,3604) = lu(k,3604) - lu(k,2351) * lu(k,3582) + lu(k,3605) = lu(k,3605) - lu(k,2352) * lu(k,3582) + lu(k,3606) = lu(k,3606) - lu(k,2353) * lu(k,3582) + lu(k,3607) = lu(k,3607) - lu(k,2354) * lu(k,3582) + lu(k,3610) = lu(k,3610) - lu(k,2355) * lu(k,3582) + lu(k,3611) = lu(k,3611) - lu(k,2356) * lu(k,3582) + lu(k,3615) = lu(k,3615) - lu(k,2357) * lu(k,3582) + lu(k,3737) = lu(k,3737) - lu(k,2340) * lu(k,3736) + lu(k,3746) = lu(k,3746) - lu(k,2341) * lu(k,3736) + lu(k,3747) = lu(k,3747) - lu(k,2342) * lu(k,3736) + lu(k,3748) = lu(k,3748) - lu(k,2343) * lu(k,3736) + lu(k,3749) = lu(k,3749) - lu(k,2344) * lu(k,3736) + lu(k,3750) = lu(k,3750) - lu(k,2345) * lu(k,3736) + lu(k,3751) = lu(k,3751) - lu(k,2346) * lu(k,3736) + lu(k,3752) = lu(k,3752) - lu(k,2347) * lu(k,3736) + lu(k,3753) = lu(k,3753) - lu(k,2348) * lu(k,3736) + lu(k,3755) = lu(k,3755) - lu(k,2349) * lu(k,3736) + lu(k,3756) = lu(k,3756) - lu(k,2350) * lu(k,3736) + lu(k,3758) = lu(k,3758) - lu(k,2351) * lu(k,3736) + lu(k,3759) = lu(k,3759) - lu(k,2352) * lu(k,3736) + lu(k,3760) = lu(k,3760) - lu(k,2353) * lu(k,3736) + lu(k,3761) = lu(k,3761) - lu(k,2354) * lu(k,3736) + lu(k,3764) = lu(k,3764) - lu(k,2355) * lu(k,3736) + lu(k,3765) = lu(k,3765) - lu(k,2356) * lu(k,3736) + lu(k,3769) = lu(k,3769) - lu(k,2357) * lu(k,3736) + lu(k,4069) = lu(k,4069) - lu(k,2340) * lu(k,4068) + lu(k,4078) = lu(k,4078) - lu(k,2341) * lu(k,4068) + lu(k,4079) = lu(k,4079) - lu(k,2342) * lu(k,4068) + lu(k,4080) = lu(k,4080) - lu(k,2343) * lu(k,4068) + lu(k,4081) = lu(k,4081) - lu(k,2344) * lu(k,4068) + lu(k,4082) = lu(k,4082) - lu(k,2345) * lu(k,4068) + lu(k,4083) = lu(k,4083) - lu(k,2346) * lu(k,4068) + lu(k,4084) = lu(k,4084) - lu(k,2347) * lu(k,4068) + lu(k,4085) = lu(k,4085) - lu(k,2348) * lu(k,4068) + lu(k,4087) = lu(k,4087) - lu(k,2349) * lu(k,4068) + lu(k,4088) = lu(k,4088) - lu(k,2350) * lu(k,4068) + lu(k,4090) = lu(k,4090) - lu(k,2351) * lu(k,4068) + lu(k,4091) = lu(k,4091) - lu(k,2352) * lu(k,4068) + lu(k,4092) = lu(k,4092) - lu(k,2353) * lu(k,4068) + lu(k,4093) = lu(k,4093) - lu(k,2354) * lu(k,4068) + lu(k,4096) = lu(k,4096) - lu(k,2355) * lu(k,4068) + lu(k,4097) = lu(k,4097) - lu(k,2356) * lu(k,4068) + lu(k,4101) = lu(k,4101) - lu(k,2357) * lu(k,4068) + lu(k,2359) = 1._r8 / lu(k,2359) + lu(k,2360) = lu(k,2360) * lu(k,2359) + lu(k,2361) = lu(k,2361) * lu(k,2359) + lu(k,2362) = lu(k,2362) * lu(k,2359) + lu(k,2363) = lu(k,2363) * lu(k,2359) + lu(k,2364) = lu(k,2364) * lu(k,2359) + lu(k,2365) = lu(k,2365) * lu(k,2359) + lu(k,2366) = lu(k,2366) * lu(k,2359) + lu(k,2367) = lu(k,2367) * lu(k,2359) + lu(k,2382) = lu(k,2382) - lu(k,2360) * lu(k,2379) + lu(k,2384) = lu(k,2384) - lu(k,2361) * lu(k,2379) + lu(k,2387) = lu(k,2387) - lu(k,2362) * lu(k,2379) + lu(k,2389) = lu(k,2389) - lu(k,2363) * lu(k,2379) + lu(k,2391) = lu(k,2391) - lu(k,2364) * lu(k,2379) + lu(k,2393) = lu(k,2393) - lu(k,2365) * lu(k,2379) + lu(k,2395) = lu(k,2395) - lu(k,2366) * lu(k,2379) + lu(k,2397) = lu(k,2397) - lu(k,2367) * lu(k,2379) + lu(k,2411) = lu(k,2411) - lu(k,2360) * lu(k,2407) + lu(k,2413) = lu(k,2413) - lu(k,2361) * lu(k,2407) + lu(k,2416) = lu(k,2416) - lu(k,2362) * lu(k,2407) + lu(k,2418) = lu(k,2418) - lu(k,2363) * lu(k,2407) + lu(k,2420) = lu(k,2420) - lu(k,2364) * lu(k,2407) + lu(k,2422) = lu(k,2422) - lu(k,2365) * lu(k,2407) + lu(k,2424) = lu(k,2424) - lu(k,2366) * lu(k,2407) + lu(k,2426) = lu(k,2426) - lu(k,2367) * lu(k,2407) + lu(k,2443) = lu(k,2443) - lu(k,2360) * lu(k,2440) + lu(k,2445) = lu(k,2445) - lu(k,2361) * lu(k,2440) + lu(k,2448) = lu(k,2448) - lu(k,2362) * lu(k,2440) + lu(k,2450) = lu(k,2450) - lu(k,2363) * lu(k,2440) + lu(k,2452) = lu(k,2452) - lu(k,2364) * lu(k,2440) + lu(k,2454) = lu(k,2454) - lu(k,2365) * lu(k,2440) + lu(k,2456) = lu(k,2456) - lu(k,2366) * lu(k,2440) + lu(k,2458) = lu(k,2458) - lu(k,2367) * lu(k,2440) + lu(k,2474) = lu(k,2474) - lu(k,2360) * lu(k,2470) + lu(k,2476) = lu(k,2476) - lu(k,2361) * lu(k,2470) + lu(k,2479) = lu(k,2479) - lu(k,2362) * lu(k,2470) + lu(k,2481) = lu(k,2481) - lu(k,2363) * lu(k,2470) + lu(k,2483) = lu(k,2483) - lu(k,2364) * lu(k,2470) + lu(k,2485) = lu(k,2485) - lu(k,2365) * lu(k,2470) + lu(k,2487) = lu(k,2487) - lu(k,2366) * lu(k,2470) + lu(k,2489) = lu(k,2489) - lu(k,2367) * lu(k,2470) + lu(k,2508) = lu(k,2508) - lu(k,2360) * lu(k,2504) + lu(k,2510) = lu(k,2510) - lu(k,2361) * lu(k,2504) + lu(k,2513) = lu(k,2513) - lu(k,2362) * lu(k,2504) + lu(k,2515) = lu(k,2515) - lu(k,2363) * lu(k,2504) + lu(k,2517) = lu(k,2517) - lu(k,2364) * lu(k,2504) + lu(k,2519) = lu(k,2519) - lu(k,2365) * lu(k,2504) + lu(k,2521) = lu(k,2521) - lu(k,2366) * lu(k,2504) + lu(k,2523) = lu(k,2523) - lu(k,2367) * lu(k,2504) + lu(k,2537) = lu(k,2537) - lu(k,2360) * lu(k,2535) + lu(k,2539) = lu(k,2539) - lu(k,2361) * lu(k,2535) + lu(k,2542) = lu(k,2542) - lu(k,2362) * lu(k,2535) + lu(k,2544) = lu(k,2544) - lu(k,2363) * lu(k,2535) + lu(k,2546) = lu(k,2546) - lu(k,2364) * lu(k,2535) + lu(k,2548) = lu(k,2548) - lu(k,2365) * lu(k,2535) + lu(k,2550) = lu(k,2550) - lu(k,2366) * lu(k,2535) + lu(k,2552) = lu(k,2552) - lu(k,2367) * lu(k,2535) + lu(k,2573) = lu(k,2573) - lu(k,2360) * lu(k,2568) + lu(k,2575) = lu(k,2575) - lu(k,2361) * lu(k,2568) + lu(k,2578) = lu(k,2578) - lu(k,2362) * lu(k,2568) + lu(k,2580) = lu(k,2580) - lu(k,2363) * lu(k,2568) + lu(k,2582) = lu(k,2582) - lu(k,2364) * lu(k,2568) + lu(k,2584) = lu(k,2584) - lu(k,2365) * lu(k,2568) + lu(k,2586) = lu(k,2586) - lu(k,2366) * lu(k,2568) + lu(k,2588) = lu(k,2588) - lu(k,2367) * lu(k,2568) + lu(k,2602) = - lu(k,2360) * lu(k,2599) + lu(k,2604) = - lu(k,2361) * lu(k,2599) + lu(k,2606) = - lu(k,2362) * lu(k,2599) + lu(k,2607) = lu(k,2607) - lu(k,2363) * lu(k,2599) + lu(k,2610) = lu(k,2610) - lu(k,2364) * lu(k,2599) + lu(k,2612) = lu(k,2612) - lu(k,2365) * lu(k,2599) + lu(k,2613) = lu(k,2613) - lu(k,2366) * lu(k,2599) + lu(k,2617) = lu(k,2617) - lu(k,2367) * lu(k,2599) + lu(k,2630) = - lu(k,2360) * lu(k,2628) + lu(k,2632) = - lu(k,2361) * lu(k,2628) + lu(k,2634) = - lu(k,2362) * lu(k,2628) + lu(k,2635) = lu(k,2635) - lu(k,2363) * lu(k,2628) + lu(k,2638) = lu(k,2638) - lu(k,2364) * lu(k,2628) + lu(k,2640) = lu(k,2640) - lu(k,2365) * lu(k,2628) + lu(k,2641) = lu(k,2641) - lu(k,2366) * lu(k,2628) + lu(k,2645) = lu(k,2645) - lu(k,2367) * lu(k,2628) + lu(k,2654) = lu(k,2654) - lu(k,2360) * lu(k,2653) + lu(k,2656) = lu(k,2656) - lu(k,2361) * lu(k,2653) + lu(k,2659) = lu(k,2659) - lu(k,2362) * lu(k,2653) + lu(k,2661) = lu(k,2661) - lu(k,2363) * lu(k,2653) + lu(k,2663) = lu(k,2663) - lu(k,2364) * lu(k,2653) + lu(k,2665) = lu(k,2665) - lu(k,2365) * lu(k,2653) + lu(k,2667) = lu(k,2667) - lu(k,2366) * lu(k,2653) + lu(k,2669) = lu(k,2669) - lu(k,2367) * lu(k,2653) + lu(k,2676) = lu(k,2676) - lu(k,2360) * lu(k,2675) + lu(k,2678) = lu(k,2678) - lu(k,2361) * lu(k,2675) + lu(k,2681) = lu(k,2681) - lu(k,2362) * lu(k,2675) + lu(k,2683) = lu(k,2683) - lu(k,2363) * lu(k,2675) + lu(k,2685) = lu(k,2685) - lu(k,2364) * lu(k,2675) + lu(k,2687) = lu(k,2687) - lu(k,2365) * lu(k,2675) + lu(k,2689) = lu(k,2689) - lu(k,2366) * lu(k,2675) + lu(k,2691) = lu(k,2691) - lu(k,2367) * lu(k,2675) + lu(k,2699) = lu(k,2699) - lu(k,2360) * lu(k,2698) + lu(k,2701) = lu(k,2701) - lu(k,2361) * lu(k,2698) + lu(k,2704) = lu(k,2704) - lu(k,2362) * lu(k,2698) + lu(k,2706) = lu(k,2706) - lu(k,2363) * lu(k,2698) + lu(k,2708) = lu(k,2708) - lu(k,2364) * lu(k,2698) + lu(k,2710) = lu(k,2710) - lu(k,2365) * lu(k,2698) + lu(k,2712) = lu(k,2712) - lu(k,2366) * lu(k,2698) + lu(k,2714) = lu(k,2714) - lu(k,2367) * lu(k,2698) + lu(k,2742) = lu(k,2742) - lu(k,2360) * lu(k,2732) + lu(k,2744) = lu(k,2744) - lu(k,2361) * lu(k,2732) + lu(k,2747) = lu(k,2747) - lu(k,2362) * lu(k,2732) + lu(k,2749) = lu(k,2749) - lu(k,2363) * lu(k,2732) + lu(k,2752) = lu(k,2752) - lu(k,2364) * lu(k,2732) + lu(k,2754) = lu(k,2754) - lu(k,2365) * lu(k,2732) + lu(k,2756) = lu(k,2756) - lu(k,2366) * lu(k,2732) + lu(k,2760) = lu(k,2760) - lu(k,2367) * lu(k,2732) + lu(k,2788) = lu(k,2788) - lu(k,2360) * lu(k,2778) + lu(k,2790) = lu(k,2790) - lu(k,2361) * lu(k,2778) + lu(k,2793) = lu(k,2793) - lu(k,2362) * lu(k,2778) + lu(k,2795) = lu(k,2795) - lu(k,2363) * lu(k,2778) + lu(k,2798) = lu(k,2798) - lu(k,2364) * lu(k,2778) + lu(k,2800) = lu(k,2800) - lu(k,2365) * lu(k,2778) + lu(k,2802) = lu(k,2802) - lu(k,2366) * lu(k,2778) + lu(k,2806) = lu(k,2806) - lu(k,2367) * lu(k,2778) + lu(k,2835) = lu(k,2835) - lu(k,2360) * lu(k,2825) + lu(k,2837) = lu(k,2837) - lu(k,2361) * lu(k,2825) + lu(k,2840) = lu(k,2840) - lu(k,2362) * lu(k,2825) + lu(k,2842) = lu(k,2842) - lu(k,2363) * lu(k,2825) + lu(k,2845) = lu(k,2845) - lu(k,2364) * lu(k,2825) + lu(k,2847) = lu(k,2847) - lu(k,2365) * lu(k,2825) + lu(k,2849) = lu(k,2849) - lu(k,2366) * lu(k,2825) + lu(k,2853) = lu(k,2853) - lu(k,2367) * lu(k,2825) + lu(k,2907) = lu(k,2907) - lu(k,2360) * lu(k,2897) + lu(k,2909) = lu(k,2909) - lu(k,2361) * lu(k,2897) + lu(k,2912) = lu(k,2912) - lu(k,2362) * lu(k,2897) + lu(k,2915) = lu(k,2915) - lu(k,2363) * lu(k,2897) + lu(k,2918) = lu(k,2918) - lu(k,2364) * lu(k,2897) + lu(k,2920) = lu(k,2920) - lu(k,2365) * lu(k,2897) + lu(k,2922) = lu(k,2922) - lu(k,2366) * lu(k,2897) + lu(k,2927) = lu(k,2927) - lu(k,2367) * lu(k,2897) + lu(k,3097) = lu(k,3097) - lu(k,2360) * lu(k,3087) + lu(k,3099) = lu(k,3099) - lu(k,2361) * lu(k,3087) + lu(k,3102) = lu(k,3102) - lu(k,2362) * lu(k,3087) + lu(k,3105) = lu(k,3105) - lu(k,2363) * lu(k,3087) + lu(k,3108) = lu(k,3108) - lu(k,2364) * lu(k,3087) + lu(k,3110) = lu(k,3110) - lu(k,2365) * lu(k,3087) + lu(k,3114) = lu(k,3114) - lu(k,2366) * lu(k,3087) + lu(k,3119) = lu(k,3119) - lu(k,2367) * lu(k,3087) + lu(k,3356) = lu(k,3356) - lu(k,2360) * lu(k,3346) + lu(k,3358) = lu(k,3358) - lu(k,2361) * lu(k,3346) + lu(k,3361) = lu(k,3361) - lu(k,2362) * lu(k,3346) + lu(k,3364) = lu(k,3364) - lu(k,2363) * lu(k,3346) + lu(k,3367) = lu(k,3367) - lu(k,2364) * lu(k,3346) + lu(k,3369) = lu(k,3369) - lu(k,2365) * lu(k,3346) + lu(k,3373) = lu(k,3373) - lu(k,2366) * lu(k,3346) + lu(k,3378) = lu(k,3378) - lu(k,2367) * lu(k,3346) + lu(k,3449) = lu(k,3449) - lu(k,2360) * lu(k,3439) + lu(k,3451) = lu(k,3451) - lu(k,2361) * lu(k,3439) + lu(k,3454) = lu(k,3454) - lu(k,2362) * lu(k,3439) + lu(k,3457) = lu(k,3457) - lu(k,2363) * lu(k,3439) + lu(k,3460) = lu(k,3460) - lu(k,2364) * lu(k,3439) + lu(k,3462) = lu(k,3462) - lu(k,2365) * lu(k,3439) + lu(k,3466) = lu(k,3466) - lu(k,2366) * lu(k,3439) + lu(k,3471) = lu(k,3471) - lu(k,2367) * lu(k,3439) + lu(k,3593) = lu(k,3593) - lu(k,2360) * lu(k,3583) + lu(k,3595) = lu(k,3595) - lu(k,2361) * lu(k,3583) + lu(k,3598) = lu(k,3598) - lu(k,2362) * lu(k,3583) + lu(k,3601) = lu(k,3601) - lu(k,2363) * lu(k,3583) + lu(k,3604) = lu(k,3604) - lu(k,2364) * lu(k,3583) + lu(k,3606) = lu(k,3606) - lu(k,2365) * lu(k,3583) + lu(k,3610) = lu(k,3610) - lu(k,2366) * lu(k,3583) + lu(k,3615) = lu(k,3615) - lu(k,2367) * lu(k,3583) + lu(k,3747) = lu(k,3747) - lu(k,2360) * lu(k,3737) + lu(k,3749) = lu(k,3749) - lu(k,2361) * lu(k,3737) + lu(k,3752) = lu(k,3752) - lu(k,2362) * lu(k,3737) + lu(k,3755) = lu(k,3755) - lu(k,2363) * lu(k,3737) + lu(k,3758) = lu(k,3758) - lu(k,2364) * lu(k,3737) + lu(k,3760) = lu(k,3760) - lu(k,2365) * lu(k,3737) + lu(k,3764) = lu(k,3764) - lu(k,2366) * lu(k,3737) + lu(k,3769) = lu(k,3769) - lu(k,2367) * lu(k,3737) + lu(k,4079) = lu(k,4079) - lu(k,2360) * lu(k,4069) + lu(k,4081) = lu(k,4081) - lu(k,2361) * lu(k,4069) + lu(k,4084) = lu(k,4084) - lu(k,2362) * lu(k,4069) + lu(k,4087) = lu(k,4087) - lu(k,2363) * lu(k,4069) + lu(k,4090) = lu(k,4090) - lu(k,2364) * lu(k,4069) + lu(k,4092) = lu(k,4092) - lu(k,2365) * lu(k,4069) + lu(k,4096) = lu(k,4096) - lu(k,2366) * lu(k,4069) + lu(k,4101) = lu(k,4101) - lu(k,2367) * lu(k,4069) + lu(k,2380) = 1._r8 / lu(k,2380) + lu(k,2381) = lu(k,2381) * lu(k,2380) + lu(k,2382) = lu(k,2382) * lu(k,2380) + lu(k,2383) = lu(k,2383) * lu(k,2380) + lu(k,2384) = lu(k,2384) * lu(k,2380) + lu(k,2385) = lu(k,2385) * lu(k,2380) + lu(k,2386) = lu(k,2386) * lu(k,2380) + lu(k,2387) = lu(k,2387) * lu(k,2380) + lu(k,2388) = lu(k,2388) * lu(k,2380) + lu(k,2389) = lu(k,2389) * lu(k,2380) + lu(k,2390) = lu(k,2390) * lu(k,2380) + lu(k,2391) = lu(k,2391) * lu(k,2380) + lu(k,2392) = lu(k,2392) * lu(k,2380) + lu(k,2393) = lu(k,2393) * lu(k,2380) + lu(k,2394) = lu(k,2394) * lu(k,2380) + lu(k,2395) = lu(k,2395) * lu(k,2380) + lu(k,2396) = lu(k,2396) * lu(k,2380) + lu(k,2397) = lu(k,2397) * lu(k,2380) + lu(k,2398) = lu(k,2398) * lu(k,2380) + lu(k,2741) = lu(k,2741) - lu(k,2381) * lu(k,2733) + lu(k,2742) = lu(k,2742) - lu(k,2382) * lu(k,2733) + lu(k,2743) = lu(k,2743) - lu(k,2383) * lu(k,2733) + lu(k,2744) = lu(k,2744) - lu(k,2384) * lu(k,2733) + lu(k,2745) = lu(k,2745) - lu(k,2385) * lu(k,2733) + lu(k,2746) = lu(k,2746) - lu(k,2386) * lu(k,2733) + lu(k,2747) = lu(k,2747) - lu(k,2387) * lu(k,2733) + lu(k,2748) = lu(k,2748) - lu(k,2388) * lu(k,2733) + lu(k,2749) = lu(k,2749) - lu(k,2389) * lu(k,2733) + lu(k,2750) = lu(k,2750) - lu(k,2390) * lu(k,2733) + lu(k,2752) = lu(k,2752) - lu(k,2391) * lu(k,2733) + lu(k,2753) = lu(k,2753) - lu(k,2392) * lu(k,2733) + lu(k,2754) = lu(k,2754) - lu(k,2393) * lu(k,2733) + lu(k,2755) = lu(k,2755) - lu(k,2394) * lu(k,2733) + lu(k,2756) = lu(k,2756) - lu(k,2395) * lu(k,2733) + lu(k,2757) = lu(k,2757) - lu(k,2396) * lu(k,2733) + lu(k,2760) = lu(k,2760) - lu(k,2397) * lu(k,2733) + lu(k,2761) = lu(k,2761) - lu(k,2398) * lu(k,2733) + lu(k,2787) = lu(k,2787) - lu(k,2381) * lu(k,2779) + lu(k,2788) = lu(k,2788) - lu(k,2382) * lu(k,2779) + lu(k,2789) = lu(k,2789) - lu(k,2383) * lu(k,2779) + lu(k,2790) = lu(k,2790) - lu(k,2384) * lu(k,2779) + lu(k,2791) = lu(k,2791) - lu(k,2385) * lu(k,2779) + lu(k,2792) = lu(k,2792) - lu(k,2386) * lu(k,2779) + lu(k,2793) = lu(k,2793) - lu(k,2387) * lu(k,2779) + lu(k,2794) = lu(k,2794) - lu(k,2388) * lu(k,2779) + lu(k,2795) = lu(k,2795) - lu(k,2389) * lu(k,2779) + lu(k,2796) = lu(k,2796) - lu(k,2390) * lu(k,2779) + lu(k,2798) = lu(k,2798) - lu(k,2391) * lu(k,2779) + lu(k,2799) = lu(k,2799) - lu(k,2392) * lu(k,2779) + lu(k,2800) = lu(k,2800) - lu(k,2393) * lu(k,2779) + lu(k,2801) = lu(k,2801) - lu(k,2394) * lu(k,2779) + lu(k,2802) = lu(k,2802) - lu(k,2395) * lu(k,2779) + lu(k,2803) = lu(k,2803) - lu(k,2396) * lu(k,2779) + lu(k,2806) = lu(k,2806) - lu(k,2397) * lu(k,2779) + lu(k,2807) = lu(k,2807) - lu(k,2398) * lu(k,2779) + lu(k,2834) = lu(k,2834) - lu(k,2381) * lu(k,2826) + lu(k,2835) = lu(k,2835) - lu(k,2382) * lu(k,2826) + lu(k,2836) = lu(k,2836) - lu(k,2383) * lu(k,2826) + lu(k,2837) = lu(k,2837) - lu(k,2384) * lu(k,2826) + lu(k,2838) = lu(k,2838) - lu(k,2385) * lu(k,2826) + lu(k,2839) = lu(k,2839) - lu(k,2386) * lu(k,2826) + lu(k,2840) = lu(k,2840) - lu(k,2387) * lu(k,2826) + lu(k,2841) = lu(k,2841) - lu(k,2388) * lu(k,2826) + lu(k,2842) = lu(k,2842) - lu(k,2389) * lu(k,2826) + lu(k,2843) = lu(k,2843) - lu(k,2390) * lu(k,2826) + lu(k,2845) = lu(k,2845) - lu(k,2391) * lu(k,2826) + lu(k,2846) = lu(k,2846) - lu(k,2392) * lu(k,2826) + lu(k,2847) = lu(k,2847) - lu(k,2393) * lu(k,2826) + lu(k,2848) = lu(k,2848) - lu(k,2394) * lu(k,2826) + lu(k,2849) = lu(k,2849) - lu(k,2395) * lu(k,2826) + lu(k,2850) = lu(k,2850) - lu(k,2396) * lu(k,2826) + lu(k,2853) = lu(k,2853) - lu(k,2397) * lu(k,2826) + lu(k,2854) = lu(k,2854) - lu(k,2398) * lu(k,2826) + lu(k,2906) = lu(k,2906) - lu(k,2381) * lu(k,2898) + lu(k,2907) = lu(k,2907) - lu(k,2382) * lu(k,2898) + lu(k,2908) = lu(k,2908) - lu(k,2383) * lu(k,2898) + lu(k,2909) = lu(k,2909) - lu(k,2384) * lu(k,2898) + lu(k,2910) = lu(k,2910) - lu(k,2385) * lu(k,2898) + lu(k,2911) = lu(k,2911) - lu(k,2386) * lu(k,2898) + lu(k,2912) = lu(k,2912) - lu(k,2387) * lu(k,2898) + lu(k,2913) = lu(k,2913) - lu(k,2388) * lu(k,2898) + lu(k,2915) = lu(k,2915) - lu(k,2389) * lu(k,2898) + lu(k,2916) = lu(k,2916) - lu(k,2390) * lu(k,2898) + lu(k,2918) = lu(k,2918) - lu(k,2391) * lu(k,2898) + lu(k,2919) = lu(k,2919) - lu(k,2392) * lu(k,2898) + lu(k,2920) = lu(k,2920) - lu(k,2393) * lu(k,2898) + lu(k,2921) = lu(k,2921) - lu(k,2394) * lu(k,2898) + lu(k,2922) = lu(k,2922) - lu(k,2395) * lu(k,2898) + lu(k,2923) = lu(k,2923) - lu(k,2396) * lu(k,2898) + lu(k,2927) = lu(k,2927) - lu(k,2397) * lu(k,2898) + lu(k,2928) = lu(k,2928) - lu(k,2398) * lu(k,2898) + lu(k,3096) = lu(k,3096) - lu(k,2381) * lu(k,3088) + lu(k,3097) = lu(k,3097) - lu(k,2382) * lu(k,3088) + lu(k,3098) = lu(k,3098) - lu(k,2383) * lu(k,3088) + lu(k,3099) = lu(k,3099) - lu(k,2384) * lu(k,3088) + lu(k,3100) = lu(k,3100) - lu(k,2385) * lu(k,3088) + lu(k,3101) = lu(k,3101) - lu(k,2386) * lu(k,3088) + lu(k,3102) = lu(k,3102) - lu(k,2387) * lu(k,3088) + lu(k,3103) = lu(k,3103) - lu(k,2388) * lu(k,3088) + lu(k,3105) = lu(k,3105) - lu(k,2389) * lu(k,3088) + lu(k,3106) = lu(k,3106) - lu(k,2390) * lu(k,3088) + lu(k,3108) = lu(k,3108) - lu(k,2391) * lu(k,3088) + lu(k,3109) = lu(k,3109) - lu(k,2392) * lu(k,3088) + lu(k,3110) = lu(k,3110) - lu(k,2393) * lu(k,3088) + lu(k,3111) = lu(k,3111) - lu(k,2394) * lu(k,3088) + lu(k,3114) = lu(k,3114) - lu(k,2395) * lu(k,3088) + lu(k,3115) = lu(k,3115) - lu(k,2396) * lu(k,3088) + lu(k,3119) = lu(k,3119) - lu(k,2397) * lu(k,3088) + lu(k,3120) = lu(k,3120) - lu(k,2398) * lu(k,3088) + lu(k,3355) = lu(k,3355) - lu(k,2381) * lu(k,3347) + lu(k,3356) = lu(k,3356) - lu(k,2382) * lu(k,3347) + lu(k,3357) = lu(k,3357) - lu(k,2383) * lu(k,3347) + lu(k,3358) = lu(k,3358) - lu(k,2384) * lu(k,3347) + lu(k,3359) = lu(k,3359) - lu(k,2385) * lu(k,3347) + lu(k,3360) = lu(k,3360) - lu(k,2386) * lu(k,3347) + lu(k,3361) = lu(k,3361) - lu(k,2387) * lu(k,3347) + lu(k,3362) = lu(k,3362) - lu(k,2388) * lu(k,3347) + lu(k,3364) = lu(k,3364) - lu(k,2389) * lu(k,3347) + lu(k,3365) = lu(k,3365) - lu(k,2390) * lu(k,3347) + lu(k,3367) = lu(k,3367) - lu(k,2391) * lu(k,3347) + lu(k,3368) = lu(k,3368) - lu(k,2392) * lu(k,3347) + lu(k,3369) = lu(k,3369) - lu(k,2393) * lu(k,3347) + lu(k,3370) = lu(k,3370) - lu(k,2394) * lu(k,3347) + lu(k,3373) = lu(k,3373) - lu(k,2395) * lu(k,3347) + lu(k,3374) = lu(k,3374) - lu(k,2396) * lu(k,3347) + lu(k,3378) = lu(k,3378) - lu(k,2397) * lu(k,3347) + lu(k,3379) = lu(k,3379) - lu(k,2398) * lu(k,3347) + lu(k,3448) = lu(k,3448) - lu(k,2381) * lu(k,3440) + lu(k,3449) = lu(k,3449) - lu(k,2382) * lu(k,3440) + lu(k,3450) = lu(k,3450) - lu(k,2383) * lu(k,3440) + lu(k,3451) = lu(k,3451) - lu(k,2384) * lu(k,3440) + lu(k,3452) = lu(k,3452) - lu(k,2385) * lu(k,3440) + lu(k,3453) = lu(k,3453) - lu(k,2386) * lu(k,3440) + lu(k,3454) = lu(k,3454) - lu(k,2387) * lu(k,3440) + lu(k,3455) = lu(k,3455) - lu(k,2388) * lu(k,3440) + lu(k,3457) = lu(k,3457) - lu(k,2389) * lu(k,3440) + lu(k,3458) = lu(k,3458) - lu(k,2390) * lu(k,3440) + lu(k,3460) = lu(k,3460) - lu(k,2391) * lu(k,3440) + lu(k,3461) = lu(k,3461) - lu(k,2392) * lu(k,3440) + lu(k,3462) = lu(k,3462) - lu(k,2393) * lu(k,3440) + lu(k,3463) = lu(k,3463) - lu(k,2394) * lu(k,3440) + lu(k,3466) = lu(k,3466) - lu(k,2395) * lu(k,3440) + lu(k,3467) = lu(k,3467) - lu(k,2396) * lu(k,3440) + lu(k,3471) = lu(k,3471) - lu(k,2397) * lu(k,3440) + lu(k,3472) = lu(k,3472) - lu(k,2398) * lu(k,3440) + lu(k,3592) = lu(k,3592) - lu(k,2381) * lu(k,3584) + lu(k,3593) = lu(k,3593) - lu(k,2382) * lu(k,3584) + lu(k,3594) = lu(k,3594) - lu(k,2383) * lu(k,3584) + lu(k,3595) = lu(k,3595) - lu(k,2384) * lu(k,3584) + lu(k,3596) = lu(k,3596) - lu(k,2385) * lu(k,3584) + lu(k,3597) = lu(k,3597) - lu(k,2386) * lu(k,3584) + lu(k,3598) = lu(k,3598) - lu(k,2387) * lu(k,3584) + lu(k,3599) = lu(k,3599) - lu(k,2388) * lu(k,3584) + lu(k,3601) = lu(k,3601) - lu(k,2389) * lu(k,3584) + lu(k,3602) = lu(k,3602) - lu(k,2390) * lu(k,3584) + lu(k,3604) = lu(k,3604) - lu(k,2391) * lu(k,3584) + lu(k,3605) = lu(k,3605) - lu(k,2392) * lu(k,3584) + lu(k,3606) = lu(k,3606) - lu(k,2393) * lu(k,3584) + lu(k,3607) = lu(k,3607) - lu(k,2394) * lu(k,3584) + lu(k,3610) = lu(k,3610) - lu(k,2395) * lu(k,3584) + lu(k,3611) = lu(k,3611) - lu(k,2396) * lu(k,3584) + lu(k,3615) = lu(k,3615) - lu(k,2397) * lu(k,3584) + lu(k,3616) = lu(k,3616) - lu(k,2398) * lu(k,3584) + lu(k,3746) = lu(k,3746) - lu(k,2381) * lu(k,3738) + lu(k,3747) = lu(k,3747) - lu(k,2382) * lu(k,3738) + lu(k,3748) = lu(k,3748) - lu(k,2383) * lu(k,3738) + lu(k,3749) = lu(k,3749) - lu(k,2384) * lu(k,3738) + lu(k,3750) = lu(k,3750) - lu(k,2385) * lu(k,3738) + lu(k,3751) = lu(k,3751) - lu(k,2386) * lu(k,3738) + lu(k,3752) = lu(k,3752) - lu(k,2387) * lu(k,3738) + lu(k,3753) = lu(k,3753) - lu(k,2388) * lu(k,3738) + lu(k,3755) = lu(k,3755) - lu(k,2389) * lu(k,3738) + lu(k,3756) = lu(k,3756) - lu(k,2390) * lu(k,3738) + lu(k,3758) = lu(k,3758) - lu(k,2391) * lu(k,3738) + lu(k,3759) = lu(k,3759) - lu(k,2392) * lu(k,3738) + lu(k,3760) = lu(k,3760) - lu(k,2393) * lu(k,3738) + lu(k,3761) = lu(k,3761) - lu(k,2394) * lu(k,3738) + lu(k,3764) = lu(k,3764) - lu(k,2395) * lu(k,3738) + lu(k,3765) = lu(k,3765) - lu(k,2396) * lu(k,3738) + lu(k,3769) = lu(k,3769) - lu(k,2397) * lu(k,3738) + lu(k,3770) = lu(k,3770) - lu(k,2398) * lu(k,3738) + lu(k,4078) = lu(k,4078) - lu(k,2381) * lu(k,4070) + lu(k,4079) = lu(k,4079) - lu(k,2382) * lu(k,4070) + lu(k,4080) = lu(k,4080) - lu(k,2383) * lu(k,4070) + lu(k,4081) = lu(k,4081) - lu(k,2384) * lu(k,4070) + lu(k,4082) = lu(k,4082) - lu(k,2385) * lu(k,4070) + lu(k,4083) = lu(k,4083) - lu(k,2386) * lu(k,4070) + lu(k,4084) = lu(k,4084) - lu(k,2387) * lu(k,4070) + lu(k,4085) = lu(k,4085) - lu(k,2388) * lu(k,4070) + lu(k,4087) = lu(k,4087) - lu(k,2389) * lu(k,4070) + lu(k,4088) = lu(k,4088) - lu(k,2390) * lu(k,4070) + lu(k,4090) = lu(k,4090) - lu(k,2391) * lu(k,4070) + lu(k,4091) = lu(k,4091) - lu(k,2392) * lu(k,4070) + lu(k,4092) = lu(k,4092) - lu(k,2393) * lu(k,4070) + lu(k,4093) = lu(k,4093) - lu(k,2394) * lu(k,4070) + lu(k,4096) = lu(k,4096) - lu(k,2395) * lu(k,4070) + lu(k,4097) = lu(k,4097) - lu(k,2396) * lu(k,4070) + lu(k,4101) = lu(k,4101) - lu(k,2397) * lu(k,4070) + lu(k,4102) = lu(k,4102) - lu(k,2398) * lu(k,4070) + end do + end subroutine lu_fac47 + subroutine lu_fac48( 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,2408) = 1._r8 / lu(k,2408) + lu(k,2409) = lu(k,2409) * lu(k,2408) + lu(k,2410) = lu(k,2410) * lu(k,2408) + lu(k,2411) = lu(k,2411) * lu(k,2408) + lu(k,2412) = lu(k,2412) * lu(k,2408) + lu(k,2413) = lu(k,2413) * lu(k,2408) + lu(k,2414) = lu(k,2414) * lu(k,2408) + lu(k,2415) = lu(k,2415) * lu(k,2408) + lu(k,2416) = lu(k,2416) * lu(k,2408) + lu(k,2417) = lu(k,2417) * lu(k,2408) + lu(k,2418) = lu(k,2418) * lu(k,2408) + lu(k,2419) = lu(k,2419) * lu(k,2408) + lu(k,2420) = lu(k,2420) * lu(k,2408) + lu(k,2421) = lu(k,2421) * lu(k,2408) + lu(k,2422) = lu(k,2422) * lu(k,2408) + lu(k,2423) = lu(k,2423) * lu(k,2408) + lu(k,2424) = lu(k,2424) * lu(k,2408) + lu(k,2425) = lu(k,2425) * lu(k,2408) + lu(k,2426) = lu(k,2426) * lu(k,2408) + lu(k,2740) = lu(k,2740) - lu(k,2409) * lu(k,2734) + lu(k,2741) = lu(k,2741) - lu(k,2410) * lu(k,2734) + lu(k,2742) = lu(k,2742) - lu(k,2411) * lu(k,2734) + lu(k,2743) = lu(k,2743) - lu(k,2412) * lu(k,2734) + lu(k,2744) = lu(k,2744) - lu(k,2413) * lu(k,2734) + lu(k,2745) = lu(k,2745) - lu(k,2414) * lu(k,2734) + lu(k,2746) = lu(k,2746) - lu(k,2415) * lu(k,2734) + lu(k,2747) = lu(k,2747) - lu(k,2416) * lu(k,2734) + lu(k,2748) = lu(k,2748) - lu(k,2417) * lu(k,2734) + lu(k,2749) = lu(k,2749) - lu(k,2418) * lu(k,2734) + lu(k,2750) = lu(k,2750) - lu(k,2419) * lu(k,2734) + lu(k,2752) = lu(k,2752) - lu(k,2420) * lu(k,2734) + lu(k,2753) = lu(k,2753) - lu(k,2421) * lu(k,2734) + lu(k,2754) = lu(k,2754) - lu(k,2422) * lu(k,2734) + lu(k,2755) = lu(k,2755) - lu(k,2423) * lu(k,2734) + lu(k,2756) = lu(k,2756) - lu(k,2424) * lu(k,2734) + lu(k,2757) = lu(k,2757) - lu(k,2425) * lu(k,2734) + lu(k,2760) = lu(k,2760) - lu(k,2426) * lu(k,2734) + lu(k,2786) = lu(k,2786) - lu(k,2409) * lu(k,2780) + lu(k,2787) = lu(k,2787) - lu(k,2410) * lu(k,2780) + lu(k,2788) = lu(k,2788) - lu(k,2411) * lu(k,2780) + lu(k,2789) = lu(k,2789) - lu(k,2412) * lu(k,2780) + lu(k,2790) = lu(k,2790) - lu(k,2413) * lu(k,2780) + lu(k,2791) = lu(k,2791) - lu(k,2414) * lu(k,2780) + lu(k,2792) = lu(k,2792) - lu(k,2415) * lu(k,2780) + lu(k,2793) = lu(k,2793) - lu(k,2416) * lu(k,2780) + lu(k,2794) = lu(k,2794) - lu(k,2417) * lu(k,2780) + lu(k,2795) = lu(k,2795) - lu(k,2418) * lu(k,2780) + lu(k,2796) = lu(k,2796) - lu(k,2419) * lu(k,2780) + lu(k,2798) = lu(k,2798) - lu(k,2420) * lu(k,2780) + lu(k,2799) = lu(k,2799) - lu(k,2421) * lu(k,2780) + lu(k,2800) = lu(k,2800) - lu(k,2422) * lu(k,2780) + lu(k,2801) = lu(k,2801) - lu(k,2423) * lu(k,2780) + lu(k,2802) = lu(k,2802) - lu(k,2424) * lu(k,2780) + lu(k,2803) = lu(k,2803) - lu(k,2425) * lu(k,2780) + lu(k,2806) = lu(k,2806) - lu(k,2426) * lu(k,2780) + lu(k,2833) = lu(k,2833) - lu(k,2409) * lu(k,2827) + lu(k,2834) = lu(k,2834) - lu(k,2410) * lu(k,2827) + lu(k,2835) = lu(k,2835) - lu(k,2411) * lu(k,2827) + lu(k,2836) = lu(k,2836) - lu(k,2412) * lu(k,2827) + lu(k,2837) = lu(k,2837) - lu(k,2413) * lu(k,2827) + lu(k,2838) = lu(k,2838) - lu(k,2414) * lu(k,2827) + lu(k,2839) = lu(k,2839) - lu(k,2415) * lu(k,2827) + lu(k,2840) = lu(k,2840) - lu(k,2416) * lu(k,2827) + lu(k,2841) = lu(k,2841) - lu(k,2417) * lu(k,2827) + lu(k,2842) = lu(k,2842) - lu(k,2418) * lu(k,2827) + lu(k,2843) = lu(k,2843) - lu(k,2419) * lu(k,2827) + lu(k,2845) = lu(k,2845) - lu(k,2420) * lu(k,2827) + lu(k,2846) = lu(k,2846) - lu(k,2421) * lu(k,2827) + lu(k,2847) = lu(k,2847) - lu(k,2422) * lu(k,2827) + lu(k,2848) = lu(k,2848) - lu(k,2423) * lu(k,2827) + lu(k,2849) = lu(k,2849) - lu(k,2424) * lu(k,2827) + lu(k,2850) = lu(k,2850) - lu(k,2425) * lu(k,2827) + lu(k,2853) = lu(k,2853) - lu(k,2426) * lu(k,2827) + lu(k,2905) = lu(k,2905) - lu(k,2409) * lu(k,2899) + lu(k,2906) = lu(k,2906) - lu(k,2410) * lu(k,2899) + lu(k,2907) = lu(k,2907) - lu(k,2411) * lu(k,2899) + lu(k,2908) = lu(k,2908) - lu(k,2412) * lu(k,2899) + lu(k,2909) = lu(k,2909) - lu(k,2413) * lu(k,2899) + lu(k,2910) = lu(k,2910) - lu(k,2414) * lu(k,2899) + lu(k,2911) = lu(k,2911) - lu(k,2415) * lu(k,2899) + lu(k,2912) = lu(k,2912) - lu(k,2416) * lu(k,2899) + lu(k,2913) = lu(k,2913) - lu(k,2417) * lu(k,2899) + lu(k,2915) = lu(k,2915) - lu(k,2418) * lu(k,2899) + lu(k,2916) = lu(k,2916) - lu(k,2419) * lu(k,2899) + lu(k,2918) = lu(k,2918) - lu(k,2420) * lu(k,2899) + lu(k,2919) = lu(k,2919) - lu(k,2421) * lu(k,2899) + lu(k,2920) = lu(k,2920) - lu(k,2422) * lu(k,2899) + lu(k,2921) = lu(k,2921) - lu(k,2423) * lu(k,2899) + lu(k,2922) = lu(k,2922) - lu(k,2424) * lu(k,2899) + lu(k,2923) = lu(k,2923) - lu(k,2425) * lu(k,2899) + lu(k,2927) = lu(k,2927) - lu(k,2426) * lu(k,2899) + lu(k,3095) = lu(k,3095) - lu(k,2409) * lu(k,3089) + lu(k,3096) = lu(k,3096) - lu(k,2410) * lu(k,3089) + lu(k,3097) = lu(k,3097) - lu(k,2411) * lu(k,3089) + lu(k,3098) = lu(k,3098) - lu(k,2412) * lu(k,3089) + lu(k,3099) = lu(k,3099) - lu(k,2413) * lu(k,3089) + lu(k,3100) = lu(k,3100) - lu(k,2414) * lu(k,3089) + lu(k,3101) = lu(k,3101) - lu(k,2415) * lu(k,3089) + lu(k,3102) = lu(k,3102) - lu(k,2416) * lu(k,3089) + lu(k,3103) = lu(k,3103) - lu(k,2417) * lu(k,3089) + lu(k,3105) = lu(k,3105) - lu(k,2418) * lu(k,3089) + lu(k,3106) = lu(k,3106) - lu(k,2419) * lu(k,3089) + lu(k,3108) = lu(k,3108) - lu(k,2420) * lu(k,3089) + lu(k,3109) = lu(k,3109) - lu(k,2421) * lu(k,3089) + lu(k,3110) = lu(k,3110) - lu(k,2422) * lu(k,3089) + lu(k,3111) = lu(k,3111) - lu(k,2423) * lu(k,3089) + lu(k,3114) = lu(k,3114) - lu(k,2424) * lu(k,3089) + lu(k,3115) = lu(k,3115) - lu(k,2425) * lu(k,3089) + lu(k,3119) = lu(k,3119) - lu(k,2426) * lu(k,3089) + lu(k,3354) = lu(k,3354) - lu(k,2409) * lu(k,3348) + lu(k,3355) = lu(k,3355) - lu(k,2410) * lu(k,3348) + lu(k,3356) = lu(k,3356) - lu(k,2411) * lu(k,3348) + lu(k,3357) = lu(k,3357) - lu(k,2412) * lu(k,3348) + lu(k,3358) = lu(k,3358) - lu(k,2413) * lu(k,3348) + lu(k,3359) = lu(k,3359) - lu(k,2414) * lu(k,3348) + lu(k,3360) = lu(k,3360) - lu(k,2415) * lu(k,3348) + lu(k,3361) = lu(k,3361) - lu(k,2416) * lu(k,3348) + lu(k,3362) = lu(k,3362) - lu(k,2417) * lu(k,3348) + lu(k,3364) = lu(k,3364) - lu(k,2418) * lu(k,3348) + lu(k,3365) = lu(k,3365) - lu(k,2419) * lu(k,3348) + lu(k,3367) = lu(k,3367) - lu(k,2420) * lu(k,3348) + lu(k,3368) = lu(k,3368) - lu(k,2421) * lu(k,3348) + lu(k,3369) = lu(k,3369) - lu(k,2422) * lu(k,3348) + lu(k,3370) = lu(k,3370) - lu(k,2423) * lu(k,3348) + lu(k,3373) = lu(k,3373) - lu(k,2424) * lu(k,3348) + lu(k,3374) = lu(k,3374) - lu(k,2425) * lu(k,3348) + lu(k,3378) = lu(k,3378) - lu(k,2426) * lu(k,3348) + lu(k,3447) = lu(k,3447) - lu(k,2409) * lu(k,3441) + lu(k,3448) = lu(k,3448) - lu(k,2410) * lu(k,3441) + lu(k,3449) = lu(k,3449) - lu(k,2411) * lu(k,3441) + lu(k,3450) = lu(k,3450) - lu(k,2412) * lu(k,3441) + lu(k,3451) = lu(k,3451) - lu(k,2413) * lu(k,3441) + lu(k,3452) = lu(k,3452) - lu(k,2414) * lu(k,3441) + lu(k,3453) = lu(k,3453) - lu(k,2415) * lu(k,3441) + lu(k,3454) = lu(k,3454) - lu(k,2416) * lu(k,3441) + lu(k,3455) = lu(k,3455) - lu(k,2417) * lu(k,3441) + lu(k,3457) = lu(k,3457) - lu(k,2418) * lu(k,3441) + lu(k,3458) = lu(k,3458) - lu(k,2419) * lu(k,3441) + lu(k,3460) = lu(k,3460) - lu(k,2420) * lu(k,3441) + lu(k,3461) = lu(k,3461) - lu(k,2421) * lu(k,3441) + lu(k,3462) = lu(k,3462) - lu(k,2422) * lu(k,3441) + lu(k,3463) = lu(k,3463) - lu(k,2423) * lu(k,3441) + lu(k,3466) = lu(k,3466) - lu(k,2424) * lu(k,3441) + lu(k,3467) = lu(k,3467) - lu(k,2425) * lu(k,3441) + lu(k,3471) = lu(k,3471) - lu(k,2426) * lu(k,3441) + lu(k,3591) = lu(k,3591) - lu(k,2409) * lu(k,3585) + lu(k,3592) = lu(k,3592) - lu(k,2410) * lu(k,3585) + lu(k,3593) = lu(k,3593) - lu(k,2411) * lu(k,3585) + lu(k,3594) = lu(k,3594) - lu(k,2412) * lu(k,3585) + lu(k,3595) = lu(k,3595) - lu(k,2413) * lu(k,3585) + lu(k,3596) = lu(k,3596) - lu(k,2414) * lu(k,3585) + lu(k,3597) = lu(k,3597) - lu(k,2415) * lu(k,3585) + lu(k,3598) = lu(k,3598) - lu(k,2416) * lu(k,3585) + lu(k,3599) = lu(k,3599) - lu(k,2417) * lu(k,3585) + lu(k,3601) = lu(k,3601) - lu(k,2418) * lu(k,3585) + lu(k,3602) = lu(k,3602) - lu(k,2419) * lu(k,3585) + lu(k,3604) = lu(k,3604) - lu(k,2420) * lu(k,3585) + lu(k,3605) = lu(k,3605) - lu(k,2421) * lu(k,3585) + lu(k,3606) = lu(k,3606) - lu(k,2422) * lu(k,3585) + lu(k,3607) = lu(k,3607) - lu(k,2423) * lu(k,3585) + lu(k,3610) = lu(k,3610) - lu(k,2424) * lu(k,3585) + lu(k,3611) = lu(k,3611) - lu(k,2425) * lu(k,3585) + lu(k,3615) = lu(k,3615) - lu(k,2426) * lu(k,3585) + lu(k,3745) = lu(k,3745) - lu(k,2409) * lu(k,3739) + lu(k,3746) = lu(k,3746) - lu(k,2410) * lu(k,3739) + lu(k,3747) = lu(k,3747) - lu(k,2411) * lu(k,3739) + lu(k,3748) = lu(k,3748) - lu(k,2412) * lu(k,3739) + lu(k,3749) = lu(k,3749) - lu(k,2413) * lu(k,3739) + lu(k,3750) = lu(k,3750) - lu(k,2414) * lu(k,3739) + lu(k,3751) = lu(k,3751) - lu(k,2415) * lu(k,3739) + lu(k,3752) = lu(k,3752) - lu(k,2416) * lu(k,3739) + lu(k,3753) = lu(k,3753) - lu(k,2417) * lu(k,3739) + lu(k,3755) = lu(k,3755) - lu(k,2418) * lu(k,3739) + lu(k,3756) = lu(k,3756) - lu(k,2419) * lu(k,3739) + lu(k,3758) = lu(k,3758) - lu(k,2420) * lu(k,3739) + lu(k,3759) = lu(k,3759) - lu(k,2421) * lu(k,3739) + lu(k,3760) = lu(k,3760) - lu(k,2422) * lu(k,3739) + lu(k,3761) = lu(k,3761) - lu(k,2423) * lu(k,3739) + lu(k,3764) = lu(k,3764) - lu(k,2424) * lu(k,3739) + lu(k,3765) = lu(k,3765) - lu(k,2425) * lu(k,3739) + lu(k,3769) = lu(k,3769) - lu(k,2426) * lu(k,3739) + lu(k,4077) = lu(k,4077) - lu(k,2409) * lu(k,4071) + lu(k,4078) = lu(k,4078) - lu(k,2410) * lu(k,4071) + lu(k,4079) = lu(k,4079) - lu(k,2411) * lu(k,4071) + lu(k,4080) = lu(k,4080) - lu(k,2412) * lu(k,4071) + lu(k,4081) = lu(k,4081) - lu(k,2413) * lu(k,4071) + lu(k,4082) = lu(k,4082) - lu(k,2414) * lu(k,4071) + lu(k,4083) = lu(k,4083) - lu(k,2415) * lu(k,4071) + lu(k,4084) = lu(k,4084) - lu(k,2416) * lu(k,4071) + lu(k,4085) = lu(k,4085) - lu(k,2417) * lu(k,4071) + lu(k,4087) = lu(k,4087) - lu(k,2418) * lu(k,4071) + lu(k,4088) = lu(k,4088) - lu(k,2419) * lu(k,4071) + lu(k,4090) = lu(k,4090) - lu(k,2420) * lu(k,4071) + lu(k,4091) = lu(k,4091) - lu(k,2421) * lu(k,4071) + lu(k,4092) = lu(k,4092) - lu(k,2422) * lu(k,4071) + lu(k,4093) = lu(k,4093) - lu(k,2423) * lu(k,4071) + lu(k,4096) = lu(k,4096) - lu(k,2424) * lu(k,4071) + lu(k,4097) = lu(k,4097) - lu(k,2425) * lu(k,4071) + lu(k,4101) = lu(k,4101) - lu(k,2426) * lu(k,4071) + lu(k,2441) = 1._r8 / lu(k,2441) + lu(k,2442) = lu(k,2442) * lu(k,2441) + lu(k,2443) = lu(k,2443) * lu(k,2441) + lu(k,2444) = lu(k,2444) * lu(k,2441) + lu(k,2445) = lu(k,2445) * lu(k,2441) + lu(k,2446) = lu(k,2446) * lu(k,2441) + lu(k,2447) = lu(k,2447) * lu(k,2441) + lu(k,2448) = lu(k,2448) * lu(k,2441) + lu(k,2449) = lu(k,2449) * lu(k,2441) + lu(k,2450) = lu(k,2450) * lu(k,2441) + lu(k,2451) = lu(k,2451) * lu(k,2441) + lu(k,2452) = lu(k,2452) * lu(k,2441) + lu(k,2453) = lu(k,2453) * lu(k,2441) + lu(k,2454) = lu(k,2454) * lu(k,2441) + lu(k,2455) = lu(k,2455) * lu(k,2441) + lu(k,2456) = lu(k,2456) * lu(k,2441) + lu(k,2457) = lu(k,2457) * lu(k,2441) + lu(k,2458) = lu(k,2458) * lu(k,2441) + lu(k,2459) = lu(k,2459) * lu(k,2441) + lu(k,2741) = lu(k,2741) - lu(k,2442) * lu(k,2735) + lu(k,2742) = lu(k,2742) - lu(k,2443) * lu(k,2735) + lu(k,2743) = lu(k,2743) - lu(k,2444) * lu(k,2735) + lu(k,2744) = lu(k,2744) - lu(k,2445) * lu(k,2735) + lu(k,2745) = lu(k,2745) - lu(k,2446) * lu(k,2735) + lu(k,2746) = lu(k,2746) - lu(k,2447) * lu(k,2735) + lu(k,2747) = lu(k,2747) - lu(k,2448) * lu(k,2735) + lu(k,2748) = lu(k,2748) - lu(k,2449) * lu(k,2735) + lu(k,2749) = lu(k,2749) - lu(k,2450) * lu(k,2735) + lu(k,2750) = lu(k,2750) - lu(k,2451) * lu(k,2735) + lu(k,2752) = lu(k,2752) - lu(k,2452) * lu(k,2735) + lu(k,2753) = lu(k,2753) - lu(k,2453) * lu(k,2735) + lu(k,2754) = lu(k,2754) - lu(k,2454) * lu(k,2735) + lu(k,2755) = lu(k,2755) - lu(k,2455) * lu(k,2735) + lu(k,2756) = lu(k,2756) - lu(k,2456) * lu(k,2735) + lu(k,2757) = lu(k,2757) - lu(k,2457) * lu(k,2735) + lu(k,2760) = lu(k,2760) - lu(k,2458) * lu(k,2735) + lu(k,2761) = lu(k,2761) - lu(k,2459) * lu(k,2735) + lu(k,2787) = lu(k,2787) - lu(k,2442) * lu(k,2781) + lu(k,2788) = lu(k,2788) - lu(k,2443) * lu(k,2781) + lu(k,2789) = lu(k,2789) - lu(k,2444) * lu(k,2781) + lu(k,2790) = lu(k,2790) - lu(k,2445) * lu(k,2781) + lu(k,2791) = lu(k,2791) - lu(k,2446) * lu(k,2781) + lu(k,2792) = lu(k,2792) - lu(k,2447) * lu(k,2781) + lu(k,2793) = lu(k,2793) - lu(k,2448) * lu(k,2781) + lu(k,2794) = lu(k,2794) - lu(k,2449) * lu(k,2781) + lu(k,2795) = lu(k,2795) - lu(k,2450) * lu(k,2781) + lu(k,2796) = lu(k,2796) - lu(k,2451) * lu(k,2781) + lu(k,2798) = lu(k,2798) - lu(k,2452) * lu(k,2781) + lu(k,2799) = lu(k,2799) - lu(k,2453) * lu(k,2781) + lu(k,2800) = lu(k,2800) - lu(k,2454) * lu(k,2781) + lu(k,2801) = lu(k,2801) - lu(k,2455) * lu(k,2781) + lu(k,2802) = lu(k,2802) - lu(k,2456) * lu(k,2781) + lu(k,2803) = lu(k,2803) - lu(k,2457) * lu(k,2781) + lu(k,2806) = lu(k,2806) - lu(k,2458) * lu(k,2781) + lu(k,2807) = lu(k,2807) - lu(k,2459) * lu(k,2781) + lu(k,2834) = lu(k,2834) - lu(k,2442) * lu(k,2828) + lu(k,2835) = lu(k,2835) - lu(k,2443) * lu(k,2828) + lu(k,2836) = lu(k,2836) - lu(k,2444) * lu(k,2828) + lu(k,2837) = lu(k,2837) - lu(k,2445) * lu(k,2828) + lu(k,2838) = lu(k,2838) - lu(k,2446) * lu(k,2828) + lu(k,2839) = lu(k,2839) - lu(k,2447) * lu(k,2828) + lu(k,2840) = lu(k,2840) - lu(k,2448) * lu(k,2828) + lu(k,2841) = lu(k,2841) - lu(k,2449) * lu(k,2828) + lu(k,2842) = lu(k,2842) - lu(k,2450) * lu(k,2828) + lu(k,2843) = lu(k,2843) - lu(k,2451) * lu(k,2828) + lu(k,2845) = lu(k,2845) - lu(k,2452) * lu(k,2828) + lu(k,2846) = lu(k,2846) - lu(k,2453) * lu(k,2828) + lu(k,2847) = lu(k,2847) - lu(k,2454) * lu(k,2828) + lu(k,2848) = lu(k,2848) - lu(k,2455) * lu(k,2828) + lu(k,2849) = lu(k,2849) - lu(k,2456) * lu(k,2828) + lu(k,2850) = lu(k,2850) - lu(k,2457) * lu(k,2828) + lu(k,2853) = lu(k,2853) - lu(k,2458) * lu(k,2828) + lu(k,2854) = lu(k,2854) - lu(k,2459) * lu(k,2828) + lu(k,2906) = lu(k,2906) - lu(k,2442) * lu(k,2900) + lu(k,2907) = lu(k,2907) - lu(k,2443) * lu(k,2900) + lu(k,2908) = lu(k,2908) - lu(k,2444) * lu(k,2900) + lu(k,2909) = lu(k,2909) - lu(k,2445) * lu(k,2900) + lu(k,2910) = lu(k,2910) - lu(k,2446) * lu(k,2900) + lu(k,2911) = lu(k,2911) - lu(k,2447) * lu(k,2900) + lu(k,2912) = lu(k,2912) - lu(k,2448) * lu(k,2900) + lu(k,2913) = lu(k,2913) - lu(k,2449) * lu(k,2900) + lu(k,2915) = lu(k,2915) - lu(k,2450) * lu(k,2900) + lu(k,2916) = lu(k,2916) - lu(k,2451) * lu(k,2900) + lu(k,2918) = lu(k,2918) - lu(k,2452) * lu(k,2900) + lu(k,2919) = lu(k,2919) - lu(k,2453) * lu(k,2900) + lu(k,2920) = lu(k,2920) - lu(k,2454) * lu(k,2900) + lu(k,2921) = lu(k,2921) - lu(k,2455) * lu(k,2900) + lu(k,2922) = lu(k,2922) - lu(k,2456) * lu(k,2900) + lu(k,2923) = lu(k,2923) - lu(k,2457) * lu(k,2900) + lu(k,2927) = lu(k,2927) - lu(k,2458) * lu(k,2900) + lu(k,2928) = lu(k,2928) - lu(k,2459) * lu(k,2900) + lu(k,3096) = lu(k,3096) - lu(k,2442) * lu(k,3090) + lu(k,3097) = lu(k,3097) - lu(k,2443) * lu(k,3090) + lu(k,3098) = lu(k,3098) - lu(k,2444) * lu(k,3090) + lu(k,3099) = lu(k,3099) - lu(k,2445) * lu(k,3090) + lu(k,3100) = lu(k,3100) - lu(k,2446) * lu(k,3090) + lu(k,3101) = lu(k,3101) - lu(k,2447) * lu(k,3090) + lu(k,3102) = lu(k,3102) - lu(k,2448) * lu(k,3090) + lu(k,3103) = lu(k,3103) - lu(k,2449) * lu(k,3090) + lu(k,3105) = lu(k,3105) - lu(k,2450) * lu(k,3090) + lu(k,3106) = lu(k,3106) - lu(k,2451) * lu(k,3090) + lu(k,3108) = lu(k,3108) - lu(k,2452) * lu(k,3090) + lu(k,3109) = lu(k,3109) - lu(k,2453) * lu(k,3090) + lu(k,3110) = lu(k,3110) - lu(k,2454) * lu(k,3090) + lu(k,3111) = lu(k,3111) - lu(k,2455) * lu(k,3090) + lu(k,3114) = lu(k,3114) - lu(k,2456) * lu(k,3090) + lu(k,3115) = lu(k,3115) - lu(k,2457) * lu(k,3090) + lu(k,3119) = lu(k,3119) - lu(k,2458) * lu(k,3090) + lu(k,3120) = lu(k,3120) - lu(k,2459) * lu(k,3090) + lu(k,3355) = lu(k,3355) - lu(k,2442) * lu(k,3349) + lu(k,3356) = lu(k,3356) - lu(k,2443) * lu(k,3349) + lu(k,3357) = lu(k,3357) - lu(k,2444) * lu(k,3349) + lu(k,3358) = lu(k,3358) - lu(k,2445) * lu(k,3349) + lu(k,3359) = lu(k,3359) - lu(k,2446) * lu(k,3349) + lu(k,3360) = lu(k,3360) - lu(k,2447) * lu(k,3349) + lu(k,3361) = lu(k,3361) - lu(k,2448) * lu(k,3349) + lu(k,3362) = lu(k,3362) - lu(k,2449) * lu(k,3349) + lu(k,3364) = lu(k,3364) - lu(k,2450) * lu(k,3349) + lu(k,3365) = lu(k,3365) - lu(k,2451) * lu(k,3349) + lu(k,3367) = lu(k,3367) - lu(k,2452) * lu(k,3349) + lu(k,3368) = lu(k,3368) - lu(k,2453) * lu(k,3349) + lu(k,3369) = lu(k,3369) - lu(k,2454) * lu(k,3349) + lu(k,3370) = lu(k,3370) - lu(k,2455) * lu(k,3349) + lu(k,3373) = lu(k,3373) - lu(k,2456) * lu(k,3349) + lu(k,3374) = lu(k,3374) - lu(k,2457) * lu(k,3349) + lu(k,3378) = lu(k,3378) - lu(k,2458) * lu(k,3349) + lu(k,3379) = lu(k,3379) - lu(k,2459) * lu(k,3349) + lu(k,3448) = lu(k,3448) - lu(k,2442) * lu(k,3442) + lu(k,3449) = lu(k,3449) - lu(k,2443) * lu(k,3442) + lu(k,3450) = lu(k,3450) - lu(k,2444) * lu(k,3442) + lu(k,3451) = lu(k,3451) - lu(k,2445) * lu(k,3442) + lu(k,3452) = lu(k,3452) - lu(k,2446) * lu(k,3442) + lu(k,3453) = lu(k,3453) - lu(k,2447) * lu(k,3442) + lu(k,3454) = lu(k,3454) - lu(k,2448) * lu(k,3442) + lu(k,3455) = lu(k,3455) - lu(k,2449) * lu(k,3442) + lu(k,3457) = lu(k,3457) - lu(k,2450) * lu(k,3442) + lu(k,3458) = lu(k,3458) - lu(k,2451) * lu(k,3442) + lu(k,3460) = lu(k,3460) - lu(k,2452) * lu(k,3442) + lu(k,3461) = lu(k,3461) - lu(k,2453) * lu(k,3442) + lu(k,3462) = lu(k,3462) - lu(k,2454) * lu(k,3442) + lu(k,3463) = lu(k,3463) - lu(k,2455) * lu(k,3442) + lu(k,3466) = lu(k,3466) - lu(k,2456) * lu(k,3442) + lu(k,3467) = lu(k,3467) - lu(k,2457) * lu(k,3442) + lu(k,3471) = lu(k,3471) - lu(k,2458) * lu(k,3442) + lu(k,3472) = lu(k,3472) - lu(k,2459) * lu(k,3442) + lu(k,3592) = lu(k,3592) - lu(k,2442) * lu(k,3586) + lu(k,3593) = lu(k,3593) - lu(k,2443) * lu(k,3586) + lu(k,3594) = lu(k,3594) - lu(k,2444) * lu(k,3586) + lu(k,3595) = lu(k,3595) - lu(k,2445) * lu(k,3586) + lu(k,3596) = lu(k,3596) - lu(k,2446) * lu(k,3586) + lu(k,3597) = lu(k,3597) - lu(k,2447) * lu(k,3586) + lu(k,3598) = lu(k,3598) - lu(k,2448) * lu(k,3586) + lu(k,3599) = lu(k,3599) - lu(k,2449) * lu(k,3586) + lu(k,3601) = lu(k,3601) - lu(k,2450) * lu(k,3586) + lu(k,3602) = lu(k,3602) - lu(k,2451) * lu(k,3586) + lu(k,3604) = lu(k,3604) - lu(k,2452) * lu(k,3586) + lu(k,3605) = lu(k,3605) - lu(k,2453) * lu(k,3586) + lu(k,3606) = lu(k,3606) - lu(k,2454) * lu(k,3586) + lu(k,3607) = lu(k,3607) - lu(k,2455) * lu(k,3586) + lu(k,3610) = lu(k,3610) - lu(k,2456) * lu(k,3586) + lu(k,3611) = lu(k,3611) - lu(k,2457) * lu(k,3586) + lu(k,3615) = lu(k,3615) - lu(k,2458) * lu(k,3586) + lu(k,3616) = lu(k,3616) - lu(k,2459) * lu(k,3586) + lu(k,3746) = lu(k,3746) - lu(k,2442) * lu(k,3740) + lu(k,3747) = lu(k,3747) - lu(k,2443) * lu(k,3740) + lu(k,3748) = lu(k,3748) - lu(k,2444) * lu(k,3740) + lu(k,3749) = lu(k,3749) - lu(k,2445) * lu(k,3740) + lu(k,3750) = lu(k,3750) - lu(k,2446) * lu(k,3740) + lu(k,3751) = lu(k,3751) - lu(k,2447) * lu(k,3740) + lu(k,3752) = lu(k,3752) - lu(k,2448) * lu(k,3740) + lu(k,3753) = lu(k,3753) - lu(k,2449) * lu(k,3740) + lu(k,3755) = lu(k,3755) - lu(k,2450) * lu(k,3740) + lu(k,3756) = lu(k,3756) - lu(k,2451) * lu(k,3740) + lu(k,3758) = lu(k,3758) - lu(k,2452) * lu(k,3740) + lu(k,3759) = lu(k,3759) - lu(k,2453) * lu(k,3740) + lu(k,3760) = lu(k,3760) - lu(k,2454) * lu(k,3740) + lu(k,3761) = lu(k,3761) - lu(k,2455) * lu(k,3740) + lu(k,3764) = lu(k,3764) - lu(k,2456) * lu(k,3740) + lu(k,3765) = lu(k,3765) - lu(k,2457) * lu(k,3740) + lu(k,3769) = lu(k,3769) - lu(k,2458) * lu(k,3740) + lu(k,3770) = lu(k,3770) - lu(k,2459) * lu(k,3740) + lu(k,4078) = lu(k,4078) - lu(k,2442) * lu(k,4072) + lu(k,4079) = lu(k,4079) - lu(k,2443) * lu(k,4072) + lu(k,4080) = lu(k,4080) - lu(k,2444) * lu(k,4072) + lu(k,4081) = lu(k,4081) - lu(k,2445) * lu(k,4072) + lu(k,4082) = lu(k,4082) - lu(k,2446) * lu(k,4072) + lu(k,4083) = lu(k,4083) - lu(k,2447) * lu(k,4072) + lu(k,4084) = lu(k,4084) - lu(k,2448) * lu(k,4072) + lu(k,4085) = lu(k,4085) - lu(k,2449) * lu(k,4072) + lu(k,4087) = lu(k,4087) - lu(k,2450) * lu(k,4072) + lu(k,4088) = lu(k,4088) - lu(k,2451) * lu(k,4072) + lu(k,4090) = lu(k,4090) - lu(k,2452) * lu(k,4072) + lu(k,4091) = lu(k,4091) - lu(k,2453) * lu(k,4072) + lu(k,4092) = lu(k,4092) - lu(k,2454) * lu(k,4072) + lu(k,4093) = lu(k,4093) - lu(k,2455) * lu(k,4072) + lu(k,4096) = lu(k,4096) - lu(k,2456) * lu(k,4072) + lu(k,4097) = lu(k,4097) - lu(k,2457) * lu(k,4072) + lu(k,4101) = lu(k,4101) - lu(k,2458) * lu(k,4072) + lu(k,4102) = lu(k,4102) - lu(k,2459) * lu(k,4072) + lu(k,2471) = 1._r8 / lu(k,2471) + lu(k,2472) = lu(k,2472) * lu(k,2471) + lu(k,2473) = lu(k,2473) * lu(k,2471) + lu(k,2474) = lu(k,2474) * lu(k,2471) + lu(k,2475) = lu(k,2475) * lu(k,2471) + lu(k,2476) = lu(k,2476) * lu(k,2471) + lu(k,2477) = lu(k,2477) * lu(k,2471) + lu(k,2478) = lu(k,2478) * lu(k,2471) + lu(k,2479) = lu(k,2479) * lu(k,2471) + lu(k,2480) = lu(k,2480) * lu(k,2471) + lu(k,2481) = lu(k,2481) * lu(k,2471) + lu(k,2482) = lu(k,2482) * lu(k,2471) + lu(k,2483) = lu(k,2483) * lu(k,2471) + lu(k,2484) = lu(k,2484) * lu(k,2471) + lu(k,2485) = lu(k,2485) * lu(k,2471) + lu(k,2486) = lu(k,2486) * lu(k,2471) + lu(k,2487) = lu(k,2487) * lu(k,2471) + lu(k,2488) = lu(k,2488) * lu(k,2471) + lu(k,2489) = lu(k,2489) * lu(k,2471) + lu(k,2490) = lu(k,2490) * lu(k,2471) + lu(k,2740) = lu(k,2740) - lu(k,2472) * lu(k,2736) + lu(k,2741) = lu(k,2741) - lu(k,2473) * lu(k,2736) + lu(k,2742) = lu(k,2742) - lu(k,2474) * lu(k,2736) + lu(k,2743) = lu(k,2743) - lu(k,2475) * lu(k,2736) + lu(k,2744) = lu(k,2744) - lu(k,2476) * lu(k,2736) + lu(k,2745) = lu(k,2745) - lu(k,2477) * lu(k,2736) + lu(k,2746) = lu(k,2746) - lu(k,2478) * lu(k,2736) + lu(k,2747) = lu(k,2747) - lu(k,2479) * lu(k,2736) + lu(k,2748) = lu(k,2748) - lu(k,2480) * lu(k,2736) + lu(k,2749) = lu(k,2749) - lu(k,2481) * lu(k,2736) + lu(k,2750) = lu(k,2750) - lu(k,2482) * lu(k,2736) + lu(k,2752) = lu(k,2752) - lu(k,2483) * lu(k,2736) + lu(k,2753) = lu(k,2753) - lu(k,2484) * lu(k,2736) + lu(k,2754) = lu(k,2754) - lu(k,2485) * lu(k,2736) + lu(k,2755) = lu(k,2755) - lu(k,2486) * lu(k,2736) + lu(k,2756) = lu(k,2756) - lu(k,2487) * lu(k,2736) + lu(k,2757) = lu(k,2757) - lu(k,2488) * lu(k,2736) + lu(k,2760) = lu(k,2760) - lu(k,2489) * lu(k,2736) + lu(k,2761) = lu(k,2761) - lu(k,2490) * lu(k,2736) + lu(k,2786) = lu(k,2786) - lu(k,2472) * lu(k,2782) + lu(k,2787) = lu(k,2787) - lu(k,2473) * lu(k,2782) + lu(k,2788) = lu(k,2788) - lu(k,2474) * lu(k,2782) + lu(k,2789) = lu(k,2789) - lu(k,2475) * lu(k,2782) + lu(k,2790) = lu(k,2790) - lu(k,2476) * lu(k,2782) + lu(k,2791) = lu(k,2791) - lu(k,2477) * lu(k,2782) + lu(k,2792) = lu(k,2792) - lu(k,2478) * lu(k,2782) + lu(k,2793) = lu(k,2793) - lu(k,2479) * lu(k,2782) + lu(k,2794) = lu(k,2794) - lu(k,2480) * lu(k,2782) + lu(k,2795) = lu(k,2795) - lu(k,2481) * lu(k,2782) + lu(k,2796) = lu(k,2796) - lu(k,2482) * lu(k,2782) + lu(k,2798) = lu(k,2798) - lu(k,2483) * lu(k,2782) + lu(k,2799) = lu(k,2799) - lu(k,2484) * lu(k,2782) + lu(k,2800) = lu(k,2800) - lu(k,2485) * lu(k,2782) + lu(k,2801) = lu(k,2801) - lu(k,2486) * lu(k,2782) + lu(k,2802) = lu(k,2802) - lu(k,2487) * lu(k,2782) + lu(k,2803) = lu(k,2803) - lu(k,2488) * lu(k,2782) + lu(k,2806) = lu(k,2806) - lu(k,2489) * lu(k,2782) + lu(k,2807) = lu(k,2807) - lu(k,2490) * lu(k,2782) + lu(k,2833) = lu(k,2833) - lu(k,2472) * lu(k,2829) + lu(k,2834) = lu(k,2834) - lu(k,2473) * lu(k,2829) + lu(k,2835) = lu(k,2835) - lu(k,2474) * lu(k,2829) + lu(k,2836) = lu(k,2836) - lu(k,2475) * lu(k,2829) + lu(k,2837) = lu(k,2837) - lu(k,2476) * lu(k,2829) + lu(k,2838) = lu(k,2838) - lu(k,2477) * lu(k,2829) + lu(k,2839) = lu(k,2839) - lu(k,2478) * lu(k,2829) + lu(k,2840) = lu(k,2840) - lu(k,2479) * lu(k,2829) + lu(k,2841) = lu(k,2841) - lu(k,2480) * lu(k,2829) + lu(k,2842) = lu(k,2842) - lu(k,2481) * lu(k,2829) + lu(k,2843) = lu(k,2843) - lu(k,2482) * lu(k,2829) + lu(k,2845) = lu(k,2845) - lu(k,2483) * lu(k,2829) + lu(k,2846) = lu(k,2846) - lu(k,2484) * lu(k,2829) + lu(k,2847) = lu(k,2847) - lu(k,2485) * lu(k,2829) + lu(k,2848) = lu(k,2848) - lu(k,2486) * lu(k,2829) + lu(k,2849) = lu(k,2849) - lu(k,2487) * lu(k,2829) + lu(k,2850) = lu(k,2850) - lu(k,2488) * lu(k,2829) + lu(k,2853) = lu(k,2853) - lu(k,2489) * lu(k,2829) + lu(k,2854) = lu(k,2854) - lu(k,2490) * lu(k,2829) + lu(k,2905) = lu(k,2905) - lu(k,2472) * lu(k,2901) + lu(k,2906) = lu(k,2906) - lu(k,2473) * lu(k,2901) + lu(k,2907) = lu(k,2907) - lu(k,2474) * lu(k,2901) + lu(k,2908) = lu(k,2908) - lu(k,2475) * lu(k,2901) + lu(k,2909) = lu(k,2909) - lu(k,2476) * lu(k,2901) + lu(k,2910) = lu(k,2910) - lu(k,2477) * lu(k,2901) + lu(k,2911) = lu(k,2911) - lu(k,2478) * lu(k,2901) + lu(k,2912) = lu(k,2912) - lu(k,2479) * lu(k,2901) + lu(k,2913) = lu(k,2913) - lu(k,2480) * lu(k,2901) + lu(k,2915) = lu(k,2915) - lu(k,2481) * lu(k,2901) + lu(k,2916) = lu(k,2916) - lu(k,2482) * lu(k,2901) + lu(k,2918) = lu(k,2918) - lu(k,2483) * lu(k,2901) + lu(k,2919) = lu(k,2919) - lu(k,2484) * lu(k,2901) + lu(k,2920) = lu(k,2920) - lu(k,2485) * lu(k,2901) + lu(k,2921) = lu(k,2921) - lu(k,2486) * lu(k,2901) + lu(k,2922) = lu(k,2922) - lu(k,2487) * lu(k,2901) + lu(k,2923) = lu(k,2923) - lu(k,2488) * lu(k,2901) + lu(k,2927) = lu(k,2927) - lu(k,2489) * lu(k,2901) + lu(k,2928) = lu(k,2928) - lu(k,2490) * lu(k,2901) + lu(k,3095) = lu(k,3095) - lu(k,2472) * lu(k,3091) + lu(k,3096) = lu(k,3096) - lu(k,2473) * lu(k,3091) + lu(k,3097) = lu(k,3097) - lu(k,2474) * lu(k,3091) + lu(k,3098) = lu(k,3098) - lu(k,2475) * lu(k,3091) + lu(k,3099) = lu(k,3099) - lu(k,2476) * lu(k,3091) + lu(k,3100) = lu(k,3100) - lu(k,2477) * lu(k,3091) + lu(k,3101) = lu(k,3101) - lu(k,2478) * lu(k,3091) + lu(k,3102) = lu(k,3102) - lu(k,2479) * lu(k,3091) + lu(k,3103) = lu(k,3103) - lu(k,2480) * lu(k,3091) + lu(k,3105) = lu(k,3105) - lu(k,2481) * lu(k,3091) + lu(k,3106) = lu(k,3106) - lu(k,2482) * lu(k,3091) + lu(k,3108) = lu(k,3108) - lu(k,2483) * lu(k,3091) + lu(k,3109) = lu(k,3109) - lu(k,2484) * lu(k,3091) + lu(k,3110) = lu(k,3110) - lu(k,2485) * lu(k,3091) + lu(k,3111) = lu(k,3111) - lu(k,2486) * lu(k,3091) + lu(k,3114) = lu(k,3114) - lu(k,2487) * lu(k,3091) + lu(k,3115) = lu(k,3115) - lu(k,2488) * lu(k,3091) + lu(k,3119) = lu(k,3119) - lu(k,2489) * lu(k,3091) + lu(k,3120) = lu(k,3120) - lu(k,2490) * lu(k,3091) + lu(k,3354) = lu(k,3354) - lu(k,2472) * lu(k,3350) + lu(k,3355) = lu(k,3355) - lu(k,2473) * lu(k,3350) + lu(k,3356) = lu(k,3356) - lu(k,2474) * lu(k,3350) + lu(k,3357) = lu(k,3357) - lu(k,2475) * lu(k,3350) + lu(k,3358) = lu(k,3358) - lu(k,2476) * lu(k,3350) + lu(k,3359) = lu(k,3359) - lu(k,2477) * lu(k,3350) + lu(k,3360) = lu(k,3360) - lu(k,2478) * lu(k,3350) + lu(k,3361) = lu(k,3361) - lu(k,2479) * lu(k,3350) + lu(k,3362) = lu(k,3362) - lu(k,2480) * lu(k,3350) + lu(k,3364) = lu(k,3364) - lu(k,2481) * lu(k,3350) + lu(k,3365) = lu(k,3365) - lu(k,2482) * lu(k,3350) + lu(k,3367) = lu(k,3367) - lu(k,2483) * lu(k,3350) + lu(k,3368) = lu(k,3368) - lu(k,2484) * lu(k,3350) + lu(k,3369) = lu(k,3369) - lu(k,2485) * lu(k,3350) + lu(k,3370) = lu(k,3370) - lu(k,2486) * lu(k,3350) + lu(k,3373) = lu(k,3373) - lu(k,2487) * lu(k,3350) + lu(k,3374) = lu(k,3374) - lu(k,2488) * lu(k,3350) + lu(k,3378) = lu(k,3378) - lu(k,2489) * lu(k,3350) + lu(k,3379) = lu(k,3379) - lu(k,2490) * lu(k,3350) + lu(k,3447) = lu(k,3447) - lu(k,2472) * lu(k,3443) + lu(k,3448) = lu(k,3448) - lu(k,2473) * lu(k,3443) + lu(k,3449) = lu(k,3449) - lu(k,2474) * lu(k,3443) + lu(k,3450) = lu(k,3450) - lu(k,2475) * lu(k,3443) + lu(k,3451) = lu(k,3451) - lu(k,2476) * lu(k,3443) + lu(k,3452) = lu(k,3452) - lu(k,2477) * lu(k,3443) + lu(k,3453) = lu(k,3453) - lu(k,2478) * lu(k,3443) + lu(k,3454) = lu(k,3454) - lu(k,2479) * lu(k,3443) + lu(k,3455) = lu(k,3455) - lu(k,2480) * lu(k,3443) + lu(k,3457) = lu(k,3457) - lu(k,2481) * lu(k,3443) + lu(k,3458) = lu(k,3458) - lu(k,2482) * lu(k,3443) + lu(k,3460) = lu(k,3460) - lu(k,2483) * lu(k,3443) + lu(k,3461) = lu(k,3461) - lu(k,2484) * lu(k,3443) + lu(k,3462) = lu(k,3462) - lu(k,2485) * lu(k,3443) + lu(k,3463) = lu(k,3463) - lu(k,2486) * lu(k,3443) + lu(k,3466) = lu(k,3466) - lu(k,2487) * lu(k,3443) + lu(k,3467) = lu(k,3467) - lu(k,2488) * lu(k,3443) + lu(k,3471) = lu(k,3471) - lu(k,2489) * lu(k,3443) + lu(k,3472) = lu(k,3472) - lu(k,2490) * lu(k,3443) + lu(k,3591) = lu(k,3591) - lu(k,2472) * lu(k,3587) + lu(k,3592) = lu(k,3592) - lu(k,2473) * lu(k,3587) + lu(k,3593) = lu(k,3593) - lu(k,2474) * lu(k,3587) + lu(k,3594) = lu(k,3594) - lu(k,2475) * lu(k,3587) + lu(k,3595) = lu(k,3595) - lu(k,2476) * lu(k,3587) + lu(k,3596) = lu(k,3596) - lu(k,2477) * lu(k,3587) + lu(k,3597) = lu(k,3597) - lu(k,2478) * lu(k,3587) + lu(k,3598) = lu(k,3598) - lu(k,2479) * lu(k,3587) + lu(k,3599) = lu(k,3599) - lu(k,2480) * lu(k,3587) + lu(k,3601) = lu(k,3601) - lu(k,2481) * lu(k,3587) + lu(k,3602) = lu(k,3602) - lu(k,2482) * lu(k,3587) + lu(k,3604) = lu(k,3604) - lu(k,2483) * lu(k,3587) + lu(k,3605) = lu(k,3605) - lu(k,2484) * lu(k,3587) + lu(k,3606) = lu(k,3606) - lu(k,2485) * lu(k,3587) + lu(k,3607) = lu(k,3607) - lu(k,2486) * lu(k,3587) + lu(k,3610) = lu(k,3610) - lu(k,2487) * lu(k,3587) + lu(k,3611) = lu(k,3611) - lu(k,2488) * lu(k,3587) + lu(k,3615) = lu(k,3615) - lu(k,2489) * lu(k,3587) + lu(k,3616) = lu(k,3616) - lu(k,2490) * lu(k,3587) + lu(k,3745) = lu(k,3745) - lu(k,2472) * lu(k,3741) + lu(k,3746) = lu(k,3746) - lu(k,2473) * lu(k,3741) + lu(k,3747) = lu(k,3747) - lu(k,2474) * lu(k,3741) + lu(k,3748) = lu(k,3748) - lu(k,2475) * lu(k,3741) + lu(k,3749) = lu(k,3749) - lu(k,2476) * lu(k,3741) + lu(k,3750) = lu(k,3750) - lu(k,2477) * lu(k,3741) + lu(k,3751) = lu(k,3751) - lu(k,2478) * lu(k,3741) + lu(k,3752) = lu(k,3752) - lu(k,2479) * lu(k,3741) + lu(k,3753) = lu(k,3753) - lu(k,2480) * lu(k,3741) + lu(k,3755) = lu(k,3755) - lu(k,2481) * lu(k,3741) + lu(k,3756) = lu(k,3756) - lu(k,2482) * lu(k,3741) + lu(k,3758) = lu(k,3758) - lu(k,2483) * lu(k,3741) + lu(k,3759) = lu(k,3759) - lu(k,2484) * lu(k,3741) + lu(k,3760) = lu(k,3760) - lu(k,2485) * lu(k,3741) + lu(k,3761) = lu(k,3761) - lu(k,2486) * lu(k,3741) + lu(k,3764) = lu(k,3764) - lu(k,2487) * lu(k,3741) + lu(k,3765) = lu(k,3765) - lu(k,2488) * lu(k,3741) + lu(k,3769) = lu(k,3769) - lu(k,2489) * lu(k,3741) + lu(k,3770) = lu(k,3770) - lu(k,2490) * lu(k,3741) + lu(k,4077) = lu(k,4077) - lu(k,2472) * lu(k,4073) + lu(k,4078) = lu(k,4078) - lu(k,2473) * lu(k,4073) + lu(k,4079) = lu(k,4079) - lu(k,2474) * lu(k,4073) + lu(k,4080) = lu(k,4080) - lu(k,2475) * lu(k,4073) + lu(k,4081) = lu(k,4081) - lu(k,2476) * lu(k,4073) + lu(k,4082) = lu(k,4082) - lu(k,2477) * lu(k,4073) + lu(k,4083) = lu(k,4083) - lu(k,2478) * lu(k,4073) + lu(k,4084) = lu(k,4084) - lu(k,2479) * lu(k,4073) + lu(k,4085) = lu(k,4085) - lu(k,2480) * lu(k,4073) + lu(k,4087) = lu(k,4087) - lu(k,2481) * lu(k,4073) + lu(k,4088) = lu(k,4088) - lu(k,2482) * lu(k,4073) + lu(k,4090) = lu(k,4090) - lu(k,2483) * lu(k,4073) + lu(k,4091) = lu(k,4091) - lu(k,2484) * lu(k,4073) + lu(k,4092) = lu(k,4092) - lu(k,2485) * lu(k,4073) + lu(k,4093) = lu(k,4093) - lu(k,2486) * lu(k,4073) + lu(k,4096) = lu(k,4096) - lu(k,2487) * lu(k,4073) + lu(k,4097) = lu(k,4097) - lu(k,2488) * lu(k,4073) + lu(k,4101) = lu(k,4101) - lu(k,2489) * lu(k,4073) + lu(k,4102) = lu(k,4102) - lu(k,2490) * lu(k,4073) + end do + end subroutine lu_fac48 + subroutine lu_fac49( 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,2505) = 1._r8 / lu(k,2505) + lu(k,2506) = lu(k,2506) * lu(k,2505) + lu(k,2507) = lu(k,2507) * lu(k,2505) + lu(k,2508) = lu(k,2508) * lu(k,2505) + lu(k,2509) = lu(k,2509) * lu(k,2505) + lu(k,2510) = lu(k,2510) * lu(k,2505) + lu(k,2511) = lu(k,2511) * lu(k,2505) + lu(k,2512) = lu(k,2512) * lu(k,2505) + lu(k,2513) = lu(k,2513) * lu(k,2505) + lu(k,2514) = lu(k,2514) * lu(k,2505) + lu(k,2515) = lu(k,2515) * lu(k,2505) + lu(k,2516) = lu(k,2516) * lu(k,2505) + lu(k,2517) = lu(k,2517) * lu(k,2505) + lu(k,2518) = lu(k,2518) * lu(k,2505) + lu(k,2519) = lu(k,2519) * lu(k,2505) + lu(k,2520) = lu(k,2520) * lu(k,2505) + lu(k,2521) = lu(k,2521) * lu(k,2505) + lu(k,2522) = lu(k,2522) * lu(k,2505) + lu(k,2523) = lu(k,2523) * lu(k,2505) + lu(k,2524) = lu(k,2524) * lu(k,2505) + lu(k,2738) = lu(k,2738) - lu(k,2506) * lu(k,2737) + lu(k,2741) = lu(k,2741) - lu(k,2507) * lu(k,2737) + lu(k,2742) = lu(k,2742) - lu(k,2508) * lu(k,2737) + lu(k,2743) = lu(k,2743) - lu(k,2509) * lu(k,2737) + lu(k,2744) = lu(k,2744) - lu(k,2510) * lu(k,2737) + lu(k,2745) = lu(k,2745) - lu(k,2511) * lu(k,2737) + lu(k,2746) = lu(k,2746) - lu(k,2512) * lu(k,2737) + lu(k,2747) = lu(k,2747) - lu(k,2513) * lu(k,2737) + lu(k,2748) = lu(k,2748) - lu(k,2514) * lu(k,2737) + lu(k,2749) = lu(k,2749) - lu(k,2515) * lu(k,2737) + lu(k,2750) = lu(k,2750) - lu(k,2516) * lu(k,2737) + lu(k,2752) = lu(k,2752) - lu(k,2517) * lu(k,2737) + lu(k,2753) = lu(k,2753) - lu(k,2518) * lu(k,2737) + lu(k,2754) = lu(k,2754) - lu(k,2519) * lu(k,2737) + lu(k,2755) = lu(k,2755) - lu(k,2520) * lu(k,2737) + lu(k,2756) = lu(k,2756) - lu(k,2521) * lu(k,2737) + lu(k,2757) = lu(k,2757) - lu(k,2522) * lu(k,2737) + lu(k,2760) = lu(k,2760) - lu(k,2523) * lu(k,2737) + lu(k,2761) = lu(k,2761) - lu(k,2524) * lu(k,2737) + lu(k,2784) = lu(k,2784) - lu(k,2506) * lu(k,2783) + lu(k,2787) = lu(k,2787) - lu(k,2507) * lu(k,2783) + lu(k,2788) = lu(k,2788) - lu(k,2508) * lu(k,2783) + lu(k,2789) = lu(k,2789) - lu(k,2509) * lu(k,2783) + lu(k,2790) = lu(k,2790) - lu(k,2510) * lu(k,2783) + lu(k,2791) = lu(k,2791) - lu(k,2511) * lu(k,2783) + lu(k,2792) = lu(k,2792) - lu(k,2512) * lu(k,2783) + lu(k,2793) = lu(k,2793) - lu(k,2513) * lu(k,2783) + lu(k,2794) = lu(k,2794) - lu(k,2514) * lu(k,2783) + lu(k,2795) = lu(k,2795) - lu(k,2515) * lu(k,2783) + lu(k,2796) = lu(k,2796) - lu(k,2516) * lu(k,2783) + lu(k,2798) = lu(k,2798) - lu(k,2517) * lu(k,2783) + lu(k,2799) = lu(k,2799) - lu(k,2518) * lu(k,2783) + lu(k,2800) = lu(k,2800) - lu(k,2519) * lu(k,2783) + lu(k,2801) = lu(k,2801) - lu(k,2520) * lu(k,2783) + lu(k,2802) = lu(k,2802) - lu(k,2521) * lu(k,2783) + lu(k,2803) = lu(k,2803) - lu(k,2522) * lu(k,2783) + lu(k,2806) = lu(k,2806) - lu(k,2523) * lu(k,2783) + lu(k,2807) = lu(k,2807) - lu(k,2524) * lu(k,2783) + lu(k,2831) = lu(k,2831) - lu(k,2506) * lu(k,2830) + lu(k,2834) = lu(k,2834) - lu(k,2507) * lu(k,2830) + lu(k,2835) = lu(k,2835) - lu(k,2508) * lu(k,2830) + lu(k,2836) = lu(k,2836) - lu(k,2509) * lu(k,2830) + lu(k,2837) = lu(k,2837) - lu(k,2510) * lu(k,2830) + lu(k,2838) = lu(k,2838) - lu(k,2511) * lu(k,2830) + lu(k,2839) = lu(k,2839) - lu(k,2512) * lu(k,2830) + lu(k,2840) = lu(k,2840) - lu(k,2513) * lu(k,2830) + lu(k,2841) = lu(k,2841) - lu(k,2514) * lu(k,2830) + lu(k,2842) = lu(k,2842) - lu(k,2515) * lu(k,2830) + lu(k,2843) = lu(k,2843) - lu(k,2516) * lu(k,2830) + lu(k,2845) = lu(k,2845) - lu(k,2517) * lu(k,2830) + lu(k,2846) = lu(k,2846) - lu(k,2518) * lu(k,2830) + lu(k,2847) = lu(k,2847) - lu(k,2519) * lu(k,2830) + lu(k,2848) = lu(k,2848) - lu(k,2520) * lu(k,2830) + lu(k,2849) = lu(k,2849) - lu(k,2521) * lu(k,2830) + lu(k,2850) = lu(k,2850) - lu(k,2522) * lu(k,2830) + lu(k,2853) = lu(k,2853) - lu(k,2523) * lu(k,2830) + lu(k,2854) = lu(k,2854) - lu(k,2524) * lu(k,2830) + lu(k,2903) = lu(k,2903) - lu(k,2506) * lu(k,2902) + lu(k,2906) = lu(k,2906) - lu(k,2507) * lu(k,2902) + lu(k,2907) = lu(k,2907) - lu(k,2508) * lu(k,2902) + lu(k,2908) = lu(k,2908) - lu(k,2509) * lu(k,2902) + lu(k,2909) = lu(k,2909) - lu(k,2510) * lu(k,2902) + lu(k,2910) = lu(k,2910) - lu(k,2511) * lu(k,2902) + lu(k,2911) = lu(k,2911) - lu(k,2512) * lu(k,2902) + lu(k,2912) = lu(k,2912) - lu(k,2513) * lu(k,2902) + lu(k,2913) = lu(k,2913) - lu(k,2514) * lu(k,2902) + lu(k,2915) = lu(k,2915) - lu(k,2515) * lu(k,2902) + lu(k,2916) = lu(k,2916) - lu(k,2516) * lu(k,2902) + lu(k,2918) = lu(k,2918) - lu(k,2517) * lu(k,2902) + lu(k,2919) = lu(k,2919) - lu(k,2518) * lu(k,2902) + lu(k,2920) = lu(k,2920) - lu(k,2519) * lu(k,2902) + lu(k,2921) = lu(k,2921) - lu(k,2520) * lu(k,2902) + lu(k,2922) = lu(k,2922) - lu(k,2521) * lu(k,2902) + lu(k,2923) = lu(k,2923) - lu(k,2522) * lu(k,2902) + lu(k,2927) = lu(k,2927) - lu(k,2523) * lu(k,2902) + lu(k,2928) = lu(k,2928) - lu(k,2524) * lu(k,2902) + lu(k,3093) = lu(k,3093) - lu(k,2506) * lu(k,3092) + lu(k,3096) = lu(k,3096) - lu(k,2507) * lu(k,3092) + lu(k,3097) = lu(k,3097) - lu(k,2508) * lu(k,3092) + lu(k,3098) = lu(k,3098) - lu(k,2509) * lu(k,3092) + lu(k,3099) = lu(k,3099) - lu(k,2510) * lu(k,3092) + lu(k,3100) = lu(k,3100) - lu(k,2511) * lu(k,3092) + lu(k,3101) = lu(k,3101) - lu(k,2512) * lu(k,3092) + lu(k,3102) = lu(k,3102) - lu(k,2513) * lu(k,3092) + lu(k,3103) = lu(k,3103) - lu(k,2514) * lu(k,3092) + lu(k,3105) = lu(k,3105) - lu(k,2515) * lu(k,3092) + lu(k,3106) = lu(k,3106) - lu(k,2516) * lu(k,3092) + lu(k,3108) = lu(k,3108) - lu(k,2517) * lu(k,3092) + lu(k,3109) = lu(k,3109) - lu(k,2518) * lu(k,3092) + lu(k,3110) = lu(k,3110) - lu(k,2519) * lu(k,3092) + lu(k,3111) = lu(k,3111) - lu(k,2520) * lu(k,3092) + lu(k,3114) = lu(k,3114) - lu(k,2521) * lu(k,3092) + lu(k,3115) = lu(k,3115) - lu(k,2522) * lu(k,3092) + lu(k,3119) = lu(k,3119) - lu(k,2523) * lu(k,3092) + lu(k,3120) = lu(k,3120) - lu(k,2524) * lu(k,3092) + lu(k,3352) = lu(k,3352) - lu(k,2506) * lu(k,3351) + lu(k,3355) = lu(k,3355) - lu(k,2507) * lu(k,3351) + lu(k,3356) = lu(k,3356) - lu(k,2508) * lu(k,3351) + lu(k,3357) = lu(k,3357) - lu(k,2509) * lu(k,3351) + lu(k,3358) = lu(k,3358) - lu(k,2510) * lu(k,3351) + lu(k,3359) = lu(k,3359) - lu(k,2511) * lu(k,3351) + lu(k,3360) = lu(k,3360) - lu(k,2512) * lu(k,3351) + lu(k,3361) = lu(k,3361) - lu(k,2513) * lu(k,3351) + lu(k,3362) = lu(k,3362) - lu(k,2514) * lu(k,3351) + lu(k,3364) = lu(k,3364) - lu(k,2515) * lu(k,3351) + lu(k,3365) = lu(k,3365) - lu(k,2516) * lu(k,3351) + lu(k,3367) = lu(k,3367) - lu(k,2517) * lu(k,3351) + lu(k,3368) = lu(k,3368) - lu(k,2518) * lu(k,3351) + lu(k,3369) = lu(k,3369) - lu(k,2519) * lu(k,3351) + lu(k,3370) = lu(k,3370) - lu(k,2520) * lu(k,3351) + lu(k,3373) = lu(k,3373) - lu(k,2521) * lu(k,3351) + lu(k,3374) = lu(k,3374) - lu(k,2522) * lu(k,3351) + lu(k,3378) = lu(k,3378) - lu(k,2523) * lu(k,3351) + lu(k,3379) = lu(k,3379) - lu(k,2524) * lu(k,3351) + lu(k,3445) = lu(k,3445) - lu(k,2506) * lu(k,3444) + lu(k,3448) = lu(k,3448) - lu(k,2507) * lu(k,3444) + lu(k,3449) = lu(k,3449) - lu(k,2508) * lu(k,3444) + lu(k,3450) = lu(k,3450) - lu(k,2509) * lu(k,3444) + lu(k,3451) = lu(k,3451) - lu(k,2510) * lu(k,3444) + lu(k,3452) = lu(k,3452) - lu(k,2511) * lu(k,3444) + lu(k,3453) = lu(k,3453) - lu(k,2512) * lu(k,3444) + lu(k,3454) = lu(k,3454) - lu(k,2513) * lu(k,3444) + lu(k,3455) = lu(k,3455) - lu(k,2514) * lu(k,3444) + lu(k,3457) = lu(k,3457) - lu(k,2515) * lu(k,3444) + lu(k,3458) = lu(k,3458) - lu(k,2516) * lu(k,3444) + lu(k,3460) = lu(k,3460) - lu(k,2517) * lu(k,3444) + lu(k,3461) = lu(k,3461) - lu(k,2518) * lu(k,3444) + lu(k,3462) = lu(k,3462) - lu(k,2519) * lu(k,3444) + lu(k,3463) = lu(k,3463) - lu(k,2520) * lu(k,3444) + lu(k,3466) = lu(k,3466) - lu(k,2521) * lu(k,3444) + lu(k,3467) = lu(k,3467) - lu(k,2522) * lu(k,3444) + lu(k,3471) = lu(k,3471) - lu(k,2523) * lu(k,3444) + lu(k,3472) = lu(k,3472) - lu(k,2524) * lu(k,3444) + lu(k,3589) = lu(k,3589) - lu(k,2506) * lu(k,3588) + lu(k,3592) = lu(k,3592) - lu(k,2507) * lu(k,3588) + lu(k,3593) = lu(k,3593) - lu(k,2508) * lu(k,3588) + lu(k,3594) = lu(k,3594) - lu(k,2509) * lu(k,3588) + lu(k,3595) = lu(k,3595) - lu(k,2510) * lu(k,3588) + lu(k,3596) = lu(k,3596) - lu(k,2511) * lu(k,3588) + lu(k,3597) = lu(k,3597) - lu(k,2512) * lu(k,3588) + lu(k,3598) = lu(k,3598) - lu(k,2513) * lu(k,3588) + lu(k,3599) = lu(k,3599) - lu(k,2514) * lu(k,3588) + lu(k,3601) = lu(k,3601) - lu(k,2515) * lu(k,3588) + lu(k,3602) = lu(k,3602) - lu(k,2516) * lu(k,3588) + lu(k,3604) = lu(k,3604) - lu(k,2517) * lu(k,3588) + lu(k,3605) = lu(k,3605) - lu(k,2518) * lu(k,3588) + lu(k,3606) = lu(k,3606) - lu(k,2519) * lu(k,3588) + lu(k,3607) = lu(k,3607) - lu(k,2520) * lu(k,3588) + lu(k,3610) = lu(k,3610) - lu(k,2521) * lu(k,3588) + lu(k,3611) = lu(k,3611) - lu(k,2522) * lu(k,3588) + lu(k,3615) = lu(k,3615) - lu(k,2523) * lu(k,3588) + lu(k,3616) = lu(k,3616) - lu(k,2524) * lu(k,3588) + lu(k,3743) = lu(k,3743) - lu(k,2506) * lu(k,3742) + lu(k,3746) = lu(k,3746) - lu(k,2507) * lu(k,3742) + lu(k,3747) = lu(k,3747) - lu(k,2508) * lu(k,3742) + lu(k,3748) = lu(k,3748) - lu(k,2509) * lu(k,3742) + lu(k,3749) = lu(k,3749) - lu(k,2510) * lu(k,3742) + lu(k,3750) = lu(k,3750) - lu(k,2511) * lu(k,3742) + lu(k,3751) = lu(k,3751) - lu(k,2512) * lu(k,3742) + lu(k,3752) = lu(k,3752) - lu(k,2513) * lu(k,3742) + lu(k,3753) = lu(k,3753) - lu(k,2514) * lu(k,3742) + lu(k,3755) = lu(k,3755) - lu(k,2515) * lu(k,3742) + lu(k,3756) = lu(k,3756) - lu(k,2516) * lu(k,3742) + lu(k,3758) = lu(k,3758) - lu(k,2517) * lu(k,3742) + lu(k,3759) = lu(k,3759) - lu(k,2518) * lu(k,3742) + lu(k,3760) = lu(k,3760) - lu(k,2519) * lu(k,3742) + lu(k,3761) = lu(k,3761) - lu(k,2520) * lu(k,3742) + lu(k,3764) = lu(k,3764) - lu(k,2521) * lu(k,3742) + lu(k,3765) = lu(k,3765) - lu(k,2522) * lu(k,3742) + lu(k,3769) = lu(k,3769) - lu(k,2523) * lu(k,3742) + lu(k,3770) = lu(k,3770) - lu(k,2524) * lu(k,3742) + lu(k,4075) = lu(k,4075) - lu(k,2506) * lu(k,4074) + lu(k,4078) = lu(k,4078) - lu(k,2507) * lu(k,4074) + lu(k,4079) = lu(k,4079) - lu(k,2508) * lu(k,4074) + lu(k,4080) = lu(k,4080) - lu(k,2509) * lu(k,4074) + lu(k,4081) = lu(k,4081) - lu(k,2510) * lu(k,4074) + lu(k,4082) = lu(k,4082) - lu(k,2511) * lu(k,4074) + lu(k,4083) = lu(k,4083) - lu(k,2512) * lu(k,4074) + lu(k,4084) = lu(k,4084) - lu(k,2513) * lu(k,4074) + lu(k,4085) = lu(k,4085) - lu(k,2514) * lu(k,4074) + lu(k,4087) = lu(k,4087) - lu(k,2515) * lu(k,4074) + lu(k,4088) = lu(k,4088) - lu(k,2516) * lu(k,4074) + lu(k,4090) = lu(k,4090) - lu(k,2517) * lu(k,4074) + lu(k,4091) = lu(k,4091) - lu(k,2518) * lu(k,4074) + lu(k,4092) = lu(k,4092) - lu(k,2519) * lu(k,4074) + lu(k,4093) = lu(k,4093) - lu(k,2520) * lu(k,4074) + lu(k,4096) = lu(k,4096) - lu(k,2521) * lu(k,4074) + lu(k,4097) = lu(k,4097) - lu(k,2522) * lu(k,4074) + lu(k,4101) = lu(k,4101) - lu(k,2523) * lu(k,4074) + lu(k,4102) = lu(k,4102) - lu(k,2524) * lu(k,4074) + lu(k,2536) = 1._r8 / lu(k,2536) + lu(k,2537) = lu(k,2537) * lu(k,2536) + lu(k,2538) = lu(k,2538) * lu(k,2536) + lu(k,2539) = lu(k,2539) * lu(k,2536) + lu(k,2540) = lu(k,2540) * lu(k,2536) + lu(k,2541) = lu(k,2541) * lu(k,2536) + lu(k,2542) = lu(k,2542) * lu(k,2536) + lu(k,2543) = lu(k,2543) * lu(k,2536) + lu(k,2544) = lu(k,2544) * lu(k,2536) + lu(k,2545) = lu(k,2545) * lu(k,2536) + lu(k,2546) = lu(k,2546) * lu(k,2536) + lu(k,2547) = lu(k,2547) * lu(k,2536) + lu(k,2548) = lu(k,2548) * lu(k,2536) + lu(k,2549) = lu(k,2549) * lu(k,2536) + lu(k,2550) = lu(k,2550) * lu(k,2536) + lu(k,2551) = lu(k,2551) * lu(k,2536) + lu(k,2552) = lu(k,2552) * lu(k,2536) + lu(k,2553) = lu(k,2553) * lu(k,2536) + lu(k,2573) = lu(k,2573) - lu(k,2537) * lu(k,2569) + lu(k,2574) = lu(k,2574) - lu(k,2538) * lu(k,2569) + lu(k,2575) = lu(k,2575) - lu(k,2539) * lu(k,2569) + lu(k,2576) = lu(k,2576) - lu(k,2540) * lu(k,2569) + lu(k,2577) = lu(k,2577) - lu(k,2541) * lu(k,2569) + lu(k,2578) = lu(k,2578) - lu(k,2542) * lu(k,2569) + lu(k,2579) = lu(k,2579) - lu(k,2543) * lu(k,2569) + lu(k,2580) = lu(k,2580) - lu(k,2544) * lu(k,2569) + lu(k,2581) = lu(k,2581) - lu(k,2545) * lu(k,2569) + lu(k,2582) = lu(k,2582) - lu(k,2546) * lu(k,2569) + lu(k,2583) = lu(k,2583) - lu(k,2547) * lu(k,2569) + lu(k,2584) = lu(k,2584) - lu(k,2548) * lu(k,2569) + lu(k,2585) = lu(k,2585) - lu(k,2549) * lu(k,2569) + lu(k,2586) = lu(k,2586) - lu(k,2550) * lu(k,2569) + lu(k,2587) = lu(k,2587) - lu(k,2551) * lu(k,2569) + lu(k,2588) = lu(k,2588) - lu(k,2552) * lu(k,2569) + lu(k,2589) = lu(k,2589) - lu(k,2553) * lu(k,2569) + lu(k,2742) = lu(k,2742) - lu(k,2537) * lu(k,2738) + lu(k,2743) = lu(k,2743) - lu(k,2538) * lu(k,2738) + lu(k,2744) = lu(k,2744) - lu(k,2539) * lu(k,2738) + lu(k,2745) = lu(k,2745) - lu(k,2540) * lu(k,2738) + lu(k,2746) = lu(k,2746) - lu(k,2541) * lu(k,2738) + lu(k,2747) = lu(k,2747) - lu(k,2542) * lu(k,2738) + lu(k,2748) = lu(k,2748) - lu(k,2543) * lu(k,2738) + lu(k,2749) = lu(k,2749) - lu(k,2544) * lu(k,2738) + lu(k,2750) = lu(k,2750) - lu(k,2545) * lu(k,2738) + lu(k,2752) = lu(k,2752) - lu(k,2546) * lu(k,2738) + lu(k,2753) = lu(k,2753) - lu(k,2547) * lu(k,2738) + lu(k,2754) = lu(k,2754) - lu(k,2548) * lu(k,2738) + lu(k,2755) = lu(k,2755) - lu(k,2549) * lu(k,2738) + lu(k,2756) = lu(k,2756) - lu(k,2550) * lu(k,2738) + lu(k,2757) = lu(k,2757) - lu(k,2551) * lu(k,2738) + lu(k,2760) = lu(k,2760) - lu(k,2552) * lu(k,2738) + lu(k,2761) = lu(k,2761) - lu(k,2553) * lu(k,2738) + lu(k,2788) = lu(k,2788) - lu(k,2537) * lu(k,2784) + lu(k,2789) = lu(k,2789) - lu(k,2538) * lu(k,2784) + lu(k,2790) = lu(k,2790) - lu(k,2539) * lu(k,2784) + lu(k,2791) = lu(k,2791) - lu(k,2540) * lu(k,2784) + lu(k,2792) = lu(k,2792) - lu(k,2541) * lu(k,2784) + lu(k,2793) = lu(k,2793) - lu(k,2542) * lu(k,2784) + lu(k,2794) = lu(k,2794) - lu(k,2543) * lu(k,2784) + lu(k,2795) = lu(k,2795) - lu(k,2544) * lu(k,2784) + lu(k,2796) = lu(k,2796) - lu(k,2545) * lu(k,2784) + lu(k,2798) = lu(k,2798) - lu(k,2546) * lu(k,2784) + lu(k,2799) = lu(k,2799) - lu(k,2547) * lu(k,2784) + lu(k,2800) = lu(k,2800) - lu(k,2548) * lu(k,2784) + lu(k,2801) = lu(k,2801) - lu(k,2549) * lu(k,2784) + lu(k,2802) = lu(k,2802) - lu(k,2550) * lu(k,2784) + lu(k,2803) = lu(k,2803) - lu(k,2551) * lu(k,2784) + lu(k,2806) = lu(k,2806) - lu(k,2552) * lu(k,2784) + lu(k,2807) = lu(k,2807) - lu(k,2553) * lu(k,2784) + lu(k,2835) = lu(k,2835) - lu(k,2537) * lu(k,2831) + lu(k,2836) = lu(k,2836) - lu(k,2538) * lu(k,2831) + lu(k,2837) = lu(k,2837) - lu(k,2539) * lu(k,2831) + lu(k,2838) = lu(k,2838) - lu(k,2540) * lu(k,2831) + lu(k,2839) = lu(k,2839) - lu(k,2541) * lu(k,2831) + lu(k,2840) = lu(k,2840) - lu(k,2542) * lu(k,2831) + lu(k,2841) = lu(k,2841) - lu(k,2543) * lu(k,2831) + lu(k,2842) = lu(k,2842) - lu(k,2544) * lu(k,2831) + lu(k,2843) = lu(k,2843) - lu(k,2545) * lu(k,2831) + lu(k,2845) = lu(k,2845) - lu(k,2546) * lu(k,2831) + lu(k,2846) = lu(k,2846) - lu(k,2547) * lu(k,2831) + lu(k,2847) = lu(k,2847) - lu(k,2548) * lu(k,2831) + lu(k,2848) = lu(k,2848) - lu(k,2549) * lu(k,2831) + lu(k,2849) = lu(k,2849) - lu(k,2550) * lu(k,2831) + lu(k,2850) = lu(k,2850) - lu(k,2551) * lu(k,2831) + lu(k,2853) = lu(k,2853) - lu(k,2552) * lu(k,2831) + lu(k,2854) = lu(k,2854) - lu(k,2553) * lu(k,2831) + lu(k,2907) = lu(k,2907) - lu(k,2537) * lu(k,2903) + lu(k,2908) = lu(k,2908) - lu(k,2538) * lu(k,2903) + lu(k,2909) = lu(k,2909) - lu(k,2539) * lu(k,2903) + lu(k,2910) = lu(k,2910) - lu(k,2540) * lu(k,2903) + lu(k,2911) = lu(k,2911) - lu(k,2541) * lu(k,2903) + lu(k,2912) = lu(k,2912) - lu(k,2542) * lu(k,2903) + lu(k,2913) = lu(k,2913) - lu(k,2543) * lu(k,2903) + lu(k,2915) = lu(k,2915) - lu(k,2544) * lu(k,2903) + lu(k,2916) = lu(k,2916) - lu(k,2545) * lu(k,2903) + lu(k,2918) = lu(k,2918) - lu(k,2546) * lu(k,2903) + lu(k,2919) = lu(k,2919) - lu(k,2547) * lu(k,2903) + lu(k,2920) = lu(k,2920) - lu(k,2548) * lu(k,2903) + lu(k,2921) = lu(k,2921) - lu(k,2549) * lu(k,2903) + lu(k,2922) = lu(k,2922) - lu(k,2550) * lu(k,2903) + lu(k,2923) = lu(k,2923) - lu(k,2551) * lu(k,2903) + lu(k,2927) = lu(k,2927) - lu(k,2552) * lu(k,2903) + lu(k,2928) = lu(k,2928) - lu(k,2553) * lu(k,2903) + lu(k,3097) = lu(k,3097) - lu(k,2537) * lu(k,3093) + lu(k,3098) = lu(k,3098) - lu(k,2538) * lu(k,3093) + lu(k,3099) = lu(k,3099) - lu(k,2539) * lu(k,3093) + lu(k,3100) = lu(k,3100) - lu(k,2540) * lu(k,3093) + lu(k,3101) = lu(k,3101) - lu(k,2541) * lu(k,3093) + lu(k,3102) = lu(k,3102) - lu(k,2542) * lu(k,3093) + lu(k,3103) = lu(k,3103) - lu(k,2543) * lu(k,3093) + lu(k,3105) = lu(k,3105) - lu(k,2544) * lu(k,3093) + lu(k,3106) = lu(k,3106) - lu(k,2545) * lu(k,3093) + lu(k,3108) = lu(k,3108) - lu(k,2546) * lu(k,3093) + lu(k,3109) = lu(k,3109) - lu(k,2547) * lu(k,3093) + lu(k,3110) = lu(k,3110) - lu(k,2548) * lu(k,3093) + lu(k,3111) = lu(k,3111) - lu(k,2549) * lu(k,3093) + lu(k,3114) = lu(k,3114) - lu(k,2550) * lu(k,3093) + lu(k,3115) = lu(k,3115) - lu(k,2551) * lu(k,3093) + lu(k,3119) = lu(k,3119) - lu(k,2552) * lu(k,3093) + lu(k,3120) = lu(k,3120) - lu(k,2553) * lu(k,3093) + lu(k,3356) = lu(k,3356) - lu(k,2537) * lu(k,3352) + lu(k,3357) = lu(k,3357) - lu(k,2538) * lu(k,3352) + lu(k,3358) = lu(k,3358) - lu(k,2539) * lu(k,3352) + lu(k,3359) = lu(k,3359) - lu(k,2540) * lu(k,3352) + lu(k,3360) = lu(k,3360) - lu(k,2541) * lu(k,3352) + lu(k,3361) = lu(k,3361) - lu(k,2542) * lu(k,3352) + lu(k,3362) = lu(k,3362) - lu(k,2543) * lu(k,3352) + lu(k,3364) = lu(k,3364) - lu(k,2544) * lu(k,3352) + lu(k,3365) = lu(k,3365) - lu(k,2545) * lu(k,3352) + lu(k,3367) = lu(k,3367) - lu(k,2546) * lu(k,3352) + lu(k,3368) = lu(k,3368) - lu(k,2547) * lu(k,3352) + lu(k,3369) = lu(k,3369) - lu(k,2548) * lu(k,3352) + lu(k,3370) = lu(k,3370) - lu(k,2549) * lu(k,3352) + lu(k,3373) = lu(k,3373) - lu(k,2550) * lu(k,3352) + lu(k,3374) = lu(k,3374) - lu(k,2551) * lu(k,3352) + lu(k,3378) = lu(k,3378) - lu(k,2552) * lu(k,3352) + lu(k,3379) = lu(k,3379) - lu(k,2553) * lu(k,3352) + lu(k,3449) = lu(k,3449) - lu(k,2537) * lu(k,3445) + lu(k,3450) = lu(k,3450) - lu(k,2538) * lu(k,3445) + lu(k,3451) = lu(k,3451) - lu(k,2539) * lu(k,3445) + lu(k,3452) = lu(k,3452) - lu(k,2540) * lu(k,3445) + lu(k,3453) = lu(k,3453) - lu(k,2541) * lu(k,3445) + lu(k,3454) = lu(k,3454) - lu(k,2542) * lu(k,3445) + lu(k,3455) = lu(k,3455) - lu(k,2543) * lu(k,3445) + lu(k,3457) = lu(k,3457) - lu(k,2544) * lu(k,3445) + lu(k,3458) = lu(k,3458) - lu(k,2545) * lu(k,3445) + lu(k,3460) = lu(k,3460) - lu(k,2546) * lu(k,3445) + lu(k,3461) = lu(k,3461) - lu(k,2547) * lu(k,3445) + lu(k,3462) = lu(k,3462) - lu(k,2548) * lu(k,3445) + lu(k,3463) = lu(k,3463) - lu(k,2549) * lu(k,3445) + lu(k,3466) = lu(k,3466) - lu(k,2550) * lu(k,3445) + lu(k,3467) = lu(k,3467) - lu(k,2551) * lu(k,3445) + lu(k,3471) = lu(k,3471) - lu(k,2552) * lu(k,3445) + lu(k,3472) = lu(k,3472) - lu(k,2553) * lu(k,3445) + lu(k,3593) = lu(k,3593) - lu(k,2537) * lu(k,3589) + lu(k,3594) = lu(k,3594) - lu(k,2538) * lu(k,3589) + lu(k,3595) = lu(k,3595) - lu(k,2539) * lu(k,3589) + lu(k,3596) = lu(k,3596) - lu(k,2540) * lu(k,3589) + lu(k,3597) = lu(k,3597) - lu(k,2541) * lu(k,3589) + lu(k,3598) = lu(k,3598) - lu(k,2542) * lu(k,3589) + lu(k,3599) = lu(k,3599) - lu(k,2543) * lu(k,3589) + lu(k,3601) = lu(k,3601) - lu(k,2544) * lu(k,3589) + lu(k,3602) = lu(k,3602) - lu(k,2545) * lu(k,3589) + lu(k,3604) = lu(k,3604) - lu(k,2546) * lu(k,3589) + lu(k,3605) = lu(k,3605) - lu(k,2547) * lu(k,3589) + lu(k,3606) = lu(k,3606) - lu(k,2548) * lu(k,3589) + lu(k,3607) = lu(k,3607) - lu(k,2549) * lu(k,3589) + lu(k,3610) = lu(k,3610) - lu(k,2550) * lu(k,3589) + lu(k,3611) = lu(k,3611) - lu(k,2551) * lu(k,3589) + lu(k,3615) = lu(k,3615) - lu(k,2552) * lu(k,3589) + lu(k,3616) = lu(k,3616) - lu(k,2553) * lu(k,3589) + lu(k,3747) = lu(k,3747) - lu(k,2537) * lu(k,3743) + lu(k,3748) = lu(k,3748) - lu(k,2538) * lu(k,3743) + lu(k,3749) = lu(k,3749) - lu(k,2539) * lu(k,3743) + lu(k,3750) = lu(k,3750) - lu(k,2540) * lu(k,3743) + lu(k,3751) = lu(k,3751) - lu(k,2541) * lu(k,3743) + lu(k,3752) = lu(k,3752) - lu(k,2542) * lu(k,3743) + lu(k,3753) = lu(k,3753) - lu(k,2543) * lu(k,3743) + lu(k,3755) = lu(k,3755) - lu(k,2544) * lu(k,3743) + lu(k,3756) = lu(k,3756) - lu(k,2545) * lu(k,3743) + lu(k,3758) = lu(k,3758) - lu(k,2546) * lu(k,3743) + lu(k,3759) = lu(k,3759) - lu(k,2547) * lu(k,3743) + lu(k,3760) = lu(k,3760) - lu(k,2548) * lu(k,3743) + lu(k,3761) = lu(k,3761) - lu(k,2549) * lu(k,3743) + lu(k,3764) = lu(k,3764) - lu(k,2550) * lu(k,3743) + lu(k,3765) = lu(k,3765) - lu(k,2551) * lu(k,3743) + lu(k,3769) = lu(k,3769) - lu(k,2552) * lu(k,3743) + lu(k,3770) = lu(k,3770) - lu(k,2553) * lu(k,3743) + lu(k,4079) = lu(k,4079) - lu(k,2537) * lu(k,4075) + lu(k,4080) = lu(k,4080) - lu(k,2538) * lu(k,4075) + lu(k,4081) = lu(k,4081) - lu(k,2539) * lu(k,4075) + lu(k,4082) = lu(k,4082) - lu(k,2540) * lu(k,4075) + lu(k,4083) = lu(k,4083) - lu(k,2541) * lu(k,4075) + lu(k,4084) = lu(k,4084) - lu(k,2542) * lu(k,4075) + lu(k,4085) = lu(k,4085) - lu(k,2543) * lu(k,4075) + lu(k,4087) = lu(k,4087) - lu(k,2544) * lu(k,4075) + lu(k,4088) = lu(k,4088) - lu(k,2545) * lu(k,4075) + lu(k,4090) = lu(k,4090) - lu(k,2546) * lu(k,4075) + lu(k,4091) = lu(k,4091) - lu(k,2547) * lu(k,4075) + lu(k,4092) = lu(k,4092) - lu(k,2548) * lu(k,4075) + lu(k,4093) = lu(k,4093) - lu(k,2549) * lu(k,4075) + lu(k,4096) = lu(k,4096) - lu(k,2550) * lu(k,4075) + lu(k,4097) = lu(k,4097) - lu(k,2551) * lu(k,4075) + lu(k,4101) = lu(k,4101) - lu(k,2552) * lu(k,4075) + lu(k,4102) = lu(k,4102) - lu(k,2553) * lu(k,4075) + lu(k,2570) = 1._r8 / lu(k,2570) + lu(k,2571) = lu(k,2571) * lu(k,2570) + lu(k,2572) = lu(k,2572) * lu(k,2570) + lu(k,2573) = lu(k,2573) * lu(k,2570) + lu(k,2574) = lu(k,2574) * lu(k,2570) + lu(k,2575) = lu(k,2575) * lu(k,2570) + lu(k,2576) = lu(k,2576) * lu(k,2570) + lu(k,2577) = lu(k,2577) * lu(k,2570) + lu(k,2578) = lu(k,2578) * lu(k,2570) + lu(k,2579) = lu(k,2579) * lu(k,2570) + lu(k,2580) = lu(k,2580) * lu(k,2570) + lu(k,2581) = lu(k,2581) * lu(k,2570) + lu(k,2582) = lu(k,2582) * lu(k,2570) + lu(k,2583) = lu(k,2583) * lu(k,2570) + lu(k,2584) = lu(k,2584) * lu(k,2570) + lu(k,2585) = lu(k,2585) * lu(k,2570) + lu(k,2586) = lu(k,2586) * lu(k,2570) + lu(k,2587) = lu(k,2587) * lu(k,2570) + lu(k,2588) = lu(k,2588) * lu(k,2570) + lu(k,2589) = lu(k,2589) * lu(k,2570) + lu(k,2740) = lu(k,2740) - lu(k,2571) * lu(k,2739) + lu(k,2741) = lu(k,2741) - lu(k,2572) * lu(k,2739) + lu(k,2742) = lu(k,2742) - lu(k,2573) * lu(k,2739) + lu(k,2743) = lu(k,2743) - lu(k,2574) * lu(k,2739) + lu(k,2744) = lu(k,2744) - lu(k,2575) * lu(k,2739) + lu(k,2745) = lu(k,2745) - lu(k,2576) * lu(k,2739) + lu(k,2746) = lu(k,2746) - lu(k,2577) * lu(k,2739) + lu(k,2747) = lu(k,2747) - lu(k,2578) * lu(k,2739) + lu(k,2748) = lu(k,2748) - lu(k,2579) * lu(k,2739) + lu(k,2749) = lu(k,2749) - lu(k,2580) * lu(k,2739) + lu(k,2750) = lu(k,2750) - lu(k,2581) * lu(k,2739) + lu(k,2752) = lu(k,2752) - lu(k,2582) * lu(k,2739) + lu(k,2753) = lu(k,2753) - lu(k,2583) * lu(k,2739) + lu(k,2754) = lu(k,2754) - lu(k,2584) * lu(k,2739) + lu(k,2755) = lu(k,2755) - lu(k,2585) * lu(k,2739) + lu(k,2756) = lu(k,2756) - lu(k,2586) * lu(k,2739) + lu(k,2757) = lu(k,2757) - lu(k,2587) * lu(k,2739) + lu(k,2760) = lu(k,2760) - lu(k,2588) * lu(k,2739) + lu(k,2761) = lu(k,2761) - lu(k,2589) * lu(k,2739) + lu(k,2786) = lu(k,2786) - lu(k,2571) * lu(k,2785) + lu(k,2787) = lu(k,2787) - lu(k,2572) * lu(k,2785) + lu(k,2788) = lu(k,2788) - lu(k,2573) * lu(k,2785) + lu(k,2789) = lu(k,2789) - lu(k,2574) * lu(k,2785) + lu(k,2790) = lu(k,2790) - lu(k,2575) * lu(k,2785) + lu(k,2791) = lu(k,2791) - lu(k,2576) * lu(k,2785) + lu(k,2792) = lu(k,2792) - lu(k,2577) * lu(k,2785) + lu(k,2793) = lu(k,2793) - lu(k,2578) * lu(k,2785) + lu(k,2794) = lu(k,2794) - lu(k,2579) * lu(k,2785) + lu(k,2795) = lu(k,2795) - lu(k,2580) * lu(k,2785) + lu(k,2796) = lu(k,2796) - lu(k,2581) * lu(k,2785) + lu(k,2798) = lu(k,2798) - lu(k,2582) * lu(k,2785) + lu(k,2799) = lu(k,2799) - lu(k,2583) * lu(k,2785) + lu(k,2800) = lu(k,2800) - lu(k,2584) * lu(k,2785) + lu(k,2801) = lu(k,2801) - lu(k,2585) * lu(k,2785) + lu(k,2802) = lu(k,2802) - lu(k,2586) * lu(k,2785) + lu(k,2803) = lu(k,2803) - lu(k,2587) * lu(k,2785) + lu(k,2806) = lu(k,2806) - lu(k,2588) * lu(k,2785) + lu(k,2807) = lu(k,2807) - lu(k,2589) * lu(k,2785) + lu(k,2833) = lu(k,2833) - lu(k,2571) * lu(k,2832) + lu(k,2834) = lu(k,2834) - lu(k,2572) * lu(k,2832) + lu(k,2835) = lu(k,2835) - lu(k,2573) * lu(k,2832) + lu(k,2836) = lu(k,2836) - lu(k,2574) * lu(k,2832) + lu(k,2837) = lu(k,2837) - lu(k,2575) * lu(k,2832) + lu(k,2838) = lu(k,2838) - lu(k,2576) * lu(k,2832) + lu(k,2839) = lu(k,2839) - lu(k,2577) * lu(k,2832) + lu(k,2840) = lu(k,2840) - lu(k,2578) * lu(k,2832) + lu(k,2841) = lu(k,2841) - lu(k,2579) * lu(k,2832) + lu(k,2842) = lu(k,2842) - lu(k,2580) * lu(k,2832) + lu(k,2843) = lu(k,2843) - lu(k,2581) * lu(k,2832) + lu(k,2845) = lu(k,2845) - lu(k,2582) * lu(k,2832) + lu(k,2846) = lu(k,2846) - lu(k,2583) * lu(k,2832) + lu(k,2847) = lu(k,2847) - lu(k,2584) * lu(k,2832) + lu(k,2848) = lu(k,2848) - lu(k,2585) * lu(k,2832) + lu(k,2849) = lu(k,2849) - lu(k,2586) * lu(k,2832) + lu(k,2850) = lu(k,2850) - lu(k,2587) * lu(k,2832) + lu(k,2853) = lu(k,2853) - lu(k,2588) * lu(k,2832) + lu(k,2854) = lu(k,2854) - lu(k,2589) * lu(k,2832) + lu(k,2905) = lu(k,2905) - lu(k,2571) * lu(k,2904) + lu(k,2906) = lu(k,2906) - lu(k,2572) * lu(k,2904) + lu(k,2907) = lu(k,2907) - lu(k,2573) * lu(k,2904) + lu(k,2908) = lu(k,2908) - lu(k,2574) * lu(k,2904) + lu(k,2909) = lu(k,2909) - lu(k,2575) * lu(k,2904) + lu(k,2910) = lu(k,2910) - lu(k,2576) * lu(k,2904) + lu(k,2911) = lu(k,2911) - lu(k,2577) * lu(k,2904) + lu(k,2912) = lu(k,2912) - lu(k,2578) * lu(k,2904) + lu(k,2913) = lu(k,2913) - lu(k,2579) * lu(k,2904) + lu(k,2915) = lu(k,2915) - lu(k,2580) * lu(k,2904) + lu(k,2916) = lu(k,2916) - lu(k,2581) * lu(k,2904) + lu(k,2918) = lu(k,2918) - lu(k,2582) * lu(k,2904) + lu(k,2919) = lu(k,2919) - lu(k,2583) * lu(k,2904) + lu(k,2920) = lu(k,2920) - lu(k,2584) * lu(k,2904) + lu(k,2921) = lu(k,2921) - lu(k,2585) * lu(k,2904) + lu(k,2922) = lu(k,2922) - lu(k,2586) * lu(k,2904) + lu(k,2923) = lu(k,2923) - lu(k,2587) * lu(k,2904) + lu(k,2927) = lu(k,2927) - lu(k,2588) * lu(k,2904) + lu(k,2928) = lu(k,2928) - lu(k,2589) * lu(k,2904) + lu(k,3095) = lu(k,3095) - lu(k,2571) * lu(k,3094) + lu(k,3096) = lu(k,3096) - lu(k,2572) * lu(k,3094) + lu(k,3097) = lu(k,3097) - lu(k,2573) * lu(k,3094) + lu(k,3098) = lu(k,3098) - lu(k,2574) * lu(k,3094) + lu(k,3099) = lu(k,3099) - lu(k,2575) * lu(k,3094) + lu(k,3100) = lu(k,3100) - lu(k,2576) * lu(k,3094) + lu(k,3101) = lu(k,3101) - lu(k,2577) * lu(k,3094) + lu(k,3102) = lu(k,3102) - lu(k,2578) * lu(k,3094) + lu(k,3103) = lu(k,3103) - lu(k,2579) * lu(k,3094) + lu(k,3105) = lu(k,3105) - lu(k,2580) * lu(k,3094) + lu(k,3106) = lu(k,3106) - lu(k,2581) * lu(k,3094) + lu(k,3108) = lu(k,3108) - lu(k,2582) * lu(k,3094) + lu(k,3109) = lu(k,3109) - lu(k,2583) * lu(k,3094) + lu(k,3110) = lu(k,3110) - lu(k,2584) * lu(k,3094) + lu(k,3111) = lu(k,3111) - lu(k,2585) * lu(k,3094) + lu(k,3114) = lu(k,3114) - lu(k,2586) * lu(k,3094) + lu(k,3115) = lu(k,3115) - lu(k,2587) * lu(k,3094) + lu(k,3119) = lu(k,3119) - lu(k,2588) * lu(k,3094) + lu(k,3120) = lu(k,3120) - lu(k,2589) * lu(k,3094) + lu(k,3354) = lu(k,3354) - lu(k,2571) * lu(k,3353) + lu(k,3355) = lu(k,3355) - lu(k,2572) * lu(k,3353) + lu(k,3356) = lu(k,3356) - lu(k,2573) * lu(k,3353) + lu(k,3357) = lu(k,3357) - lu(k,2574) * lu(k,3353) + lu(k,3358) = lu(k,3358) - lu(k,2575) * lu(k,3353) + lu(k,3359) = lu(k,3359) - lu(k,2576) * lu(k,3353) + lu(k,3360) = lu(k,3360) - lu(k,2577) * lu(k,3353) + lu(k,3361) = lu(k,3361) - lu(k,2578) * lu(k,3353) + lu(k,3362) = lu(k,3362) - lu(k,2579) * lu(k,3353) + lu(k,3364) = lu(k,3364) - lu(k,2580) * lu(k,3353) + lu(k,3365) = lu(k,3365) - lu(k,2581) * lu(k,3353) + lu(k,3367) = lu(k,3367) - lu(k,2582) * lu(k,3353) + lu(k,3368) = lu(k,3368) - lu(k,2583) * lu(k,3353) + lu(k,3369) = lu(k,3369) - lu(k,2584) * lu(k,3353) + lu(k,3370) = lu(k,3370) - lu(k,2585) * lu(k,3353) + lu(k,3373) = lu(k,3373) - lu(k,2586) * lu(k,3353) + lu(k,3374) = lu(k,3374) - lu(k,2587) * lu(k,3353) + lu(k,3378) = lu(k,3378) - lu(k,2588) * lu(k,3353) + lu(k,3379) = lu(k,3379) - lu(k,2589) * lu(k,3353) + lu(k,3447) = lu(k,3447) - lu(k,2571) * lu(k,3446) + lu(k,3448) = lu(k,3448) - lu(k,2572) * lu(k,3446) + lu(k,3449) = lu(k,3449) - lu(k,2573) * lu(k,3446) + lu(k,3450) = lu(k,3450) - lu(k,2574) * lu(k,3446) + lu(k,3451) = lu(k,3451) - lu(k,2575) * lu(k,3446) + lu(k,3452) = lu(k,3452) - lu(k,2576) * lu(k,3446) + lu(k,3453) = lu(k,3453) - lu(k,2577) * lu(k,3446) + lu(k,3454) = lu(k,3454) - lu(k,2578) * lu(k,3446) + lu(k,3455) = lu(k,3455) - lu(k,2579) * lu(k,3446) + lu(k,3457) = lu(k,3457) - lu(k,2580) * lu(k,3446) + lu(k,3458) = lu(k,3458) - lu(k,2581) * lu(k,3446) + lu(k,3460) = lu(k,3460) - lu(k,2582) * lu(k,3446) + lu(k,3461) = lu(k,3461) - lu(k,2583) * lu(k,3446) + lu(k,3462) = lu(k,3462) - lu(k,2584) * lu(k,3446) + lu(k,3463) = lu(k,3463) - lu(k,2585) * lu(k,3446) + lu(k,3466) = lu(k,3466) - lu(k,2586) * lu(k,3446) + lu(k,3467) = lu(k,3467) - lu(k,2587) * lu(k,3446) + lu(k,3471) = lu(k,3471) - lu(k,2588) * lu(k,3446) + lu(k,3472) = lu(k,3472) - lu(k,2589) * lu(k,3446) + lu(k,3591) = lu(k,3591) - lu(k,2571) * lu(k,3590) + lu(k,3592) = lu(k,3592) - lu(k,2572) * lu(k,3590) + lu(k,3593) = lu(k,3593) - lu(k,2573) * lu(k,3590) + lu(k,3594) = lu(k,3594) - lu(k,2574) * lu(k,3590) + lu(k,3595) = lu(k,3595) - lu(k,2575) * lu(k,3590) + lu(k,3596) = lu(k,3596) - lu(k,2576) * lu(k,3590) + lu(k,3597) = lu(k,3597) - lu(k,2577) * lu(k,3590) + lu(k,3598) = lu(k,3598) - lu(k,2578) * lu(k,3590) + lu(k,3599) = lu(k,3599) - lu(k,2579) * lu(k,3590) + lu(k,3601) = lu(k,3601) - lu(k,2580) * lu(k,3590) + lu(k,3602) = lu(k,3602) - lu(k,2581) * lu(k,3590) + lu(k,3604) = lu(k,3604) - lu(k,2582) * lu(k,3590) + lu(k,3605) = lu(k,3605) - lu(k,2583) * lu(k,3590) + lu(k,3606) = lu(k,3606) - lu(k,2584) * lu(k,3590) + lu(k,3607) = lu(k,3607) - lu(k,2585) * lu(k,3590) + lu(k,3610) = lu(k,3610) - lu(k,2586) * lu(k,3590) + lu(k,3611) = lu(k,3611) - lu(k,2587) * lu(k,3590) + lu(k,3615) = lu(k,3615) - lu(k,2588) * lu(k,3590) + lu(k,3616) = lu(k,3616) - lu(k,2589) * lu(k,3590) + lu(k,3745) = lu(k,3745) - lu(k,2571) * lu(k,3744) + lu(k,3746) = lu(k,3746) - lu(k,2572) * lu(k,3744) + lu(k,3747) = lu(k,3747) - lu(k,2573) * lu(k,3744) + lu(k,3748) = lu(k,3748) - lu(k,2574) * lu(k,3744) + lu(k,3749) = lu(k,3749) - lu(k,2575) * lu(k,3744) + lu(k,3750) = lu(k,3750) - lu(k,2576) * lu(k,3744) + lu(k,3751) = lu(k,3751) - lu(k,2577) * lu(k,3744) + lu(k,3752) = lu(k,3752) - lu(k,2578) * lu(k,3744) + lu(k,3753) = lu(k,3753) - lu(k,2579) * lu(k,3744) + lu(k,3755) = lu(k,3755) - lu(k,2580) * lu(k,3744) + lu(k,3756) = lu(k,3756) - lu(k,2581) * lu(k,3744) + lu(k,3758) = lu(k,3758) - lu(k,2582) * lu(k,3744) + lu(k,3759) = lu(k,3759) - lu(k,2583) * lu(k,3744) + lu(k,3760) = lu(k,3760) - lu(k,2584) * lu(k,3744) + lu(k,3761) = lu(k,3761) - lu(k,2585) * lu(k,3744) + lu(k,3764) = lu(k,3764) - lu(k,2586) * lu(k,3744) + lu(k,3765) = lu(k,3765) - lu(k,2587) * lu(k,3744) + lu(k,3769) = lu(k,3769) - lu(k,2588) * lu(k,3744) + lu(k,3770) = lu(k,3770) - lu(k,2589) * lu(k,3744) + lu(k,4077) = lu(k,4077) - lu(k,2571) * lu(k,4076) + lu(k,4078) = lu(k,4078) - lu(k,2572) * lu(k,4076) + lu(k,4079) = lu(k,4079) - lu(k,2573) * lu(k,4076) + lu(k,4080) = lu(k,4080) - lu(k,2574) * lu(k,4076) + lu(k,4081) = lu(k,4081) - lu(k,2575) * lu(k,4076) + lu(k,4082) = lu(k,4082) - lu(k,2576) * lu(k,4076) + lu(k,4083) = lu(k,4083) - lu(k,2577) * lu(k,4076) + lu(k,4084) = lu(k,4084) - lu(k,2578) * lu(k,4076) + lu(k,4085) = lu(k,4085) - lu(k,2579) * lu(k,4076) + lu(k,4087) = lu(k,4087) - lu(k,2580) * lu(k,4076) + lu(k,4088) = lu(k,4088) - lu(k,2581) * lu(k,4076) + lu(k,4090) = lu(k,4090) - lu(k,2582) * lu(k,4076) + lu(k,4091) = lu(k,4091) - lu(k,2583) * lu(k,4076) + lu(k,4092) = lu(k,4092) - lu(k,2584) * lu(k,4076) + lu(k,4093) = lu(k,4093) - lu(k,2585) * lu(k,4076) + lu(k,4096) = lu(k,4096) - lu(k,2586) * lu(k,4076) + lu(k,4097) = lu(k,4097) - lu(k,2587) * lu(k,4076) + lu(k,4101) = lu(k,4101) - lu(k,2588) * lu(k,4076) + lu(k,4102) = lu(k,4102) - lu(k,2589) * lu(k,4076) + end do + end subroutine lu_fac49 + subroutine lu_fac50( 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,2600) = 1._r8 / lu(k,2600) + lu(k,2601) = lu(k,2601) * lu(k,2600) + lu(k,2602) = lu(k,2602) * lu(k,2600) + lu(k,2603) = lu(k,2603) * lu(k,2600) + lu(k,2604) = lu(k,2604) * lu(k,2600) + lu(k,2605) = lu(k,2605) * lu(k,2600) + lu(k,2606) = lu(k,2606) * lu(k,2600) + lu(k,2607) = lu(k,2607) * lu(k,2600) + lu(k,2608) = lu(k,2608) * lu(k,2600) + lu(k,2609) = lu(k,2609) * lu(k,2600) + lu(k,2610) = lu(k,2610) * lu(k,2600) + lu(k,2611) = lu(k,2611) * lu(k,2600) + lu(k,2612) = lu(k,2612) * lu(k,2600) + lu(k,2613) = lu(k,2613) * lu(k,2600) + lu(k,2614) = lu(k,2614) * lu(k,2600) + lu(k,2615) = lu(k,2615) * lu(k,2600) + lu(k,2616) = lu(k,2616) * lu(k,2600) + lu(k,2617) = lu(k,2617) * lu(k,2600) + lu(k,2618) = lu(k,2618) * lu(k,2600) + lu(k,2741) = lu(k,2741) - lu(k,2601) * lu(k,2740) + lu(k,2742) = lu(k,2742) - lu(k,2602) * lu(k,2740) + lu(k,2743) = lu(k,2743) - lu(k,2603) * lu(k,2740) + lu(k,2744) = lu(k,2744) - lu(k,2604) * lu(k,2740) + lu(k,2746) = lu(k,2746) - lu(k,2605) * lu(k,2740) + lu(k,2747) = lu(k,2747) - lu(k,2606) * lu(k,2740) + lu(k,2749) = lu(k,2749) - lu(k,2607) * lu(k,2740) + lu(k,2750) = lu(k,2750) - lu(k,2608) * lu(k,2740) + lu(k,2751) = - lu(k,2609) * lu(k,2740) + lu(k,2752) = lu(k,2752) - lu(k,2610) * lu(k,2740) + lu(k,2753) = lu(k,2753) - lu(k,2611) * lu(k,2740) + lu(k,2754) = lu(k,2754) - lu(k,2612) * lu(k,2740) + lu(k,2756) = lu(k,2756) - lu(k,2613) * lu(k,2740) + lu(k,2757) = lu(k,2757) - lu(k,2614) * lu(k,2740) + lu(k,2758) = lu(k,2758) - lu(k,2615) * lu(k,2740) + lu(k,2759) = - lu(k,2616) * lu(k,2740) + lu(k,2760) = lu(k,2760) - lu(k,2617) * lu(k,2740) + lu(k,2761) = lu(k,2761) - lu(k,2618) * lu(k,2740) + lu(k,2787) = lu(k,2787) - lu(k,2601) * lu(k,2786) + lu(k,2788) = lu(k,2788) - lu(k,2602) * lu(k,2786) + lu(k,2789) = lu(k,2789) - lu(k,2603) * lu(k,2786) + lu(k,2790) = lu(k,2790) - lu(k,2604) * lu(k,2786) + lu(k,2792) = lu(k,2792) - lu(k,2605) * lu(k,2786) + lu(k,2793) = lu(k,2793) - lu(k,2606) * lu(k,2786) + lu(k,2795) = lu(k,2795) - lu(k,2607) * lu(k,2786) + lu(k,2796) = lu(k,2796) - lu(k,2608) * lu(k,2786) + lu(k,2797) = - lu(k,2609) * lu(k,2786) + lu(k,2798) = lu(k,2798) - lu(k,2610) * lu(k,2786) + lu(k,2799) = lu(k,2799) - lu(k,2611) * lu(k,2786) + lu(k,2800) = lu(k,2800) - lu(k,2612) * lu(k,2786) + lu(k,2802) = lu(k,2802) - lu(k,2613) * lu(k,2786) + lu(k,2803) = lu(k,2803) - lu(k,2614) * lu(k,2786) + lu(k,2804) = lu(k,2804) - lu(k,2615) * lu(k,2786) + lu(k,2805) = - lu(k,2616) * lu(k,2786) + lu(k,2806) = lu(k,2806) - lu(k,2617) * lu(k,2786) + lu(k,2807) = lu(k,2807) - lu(k,2618) * lu(k,2786) + lu(k,2834) = lu(k,2834) - lu(k,2601) * lu(k,2833) + lu(k,2835) = lu(k,2835) - lu(k,2602) * lu(k,2833) + lu(k,2836) = lu(k,2836) - lu(k,2603) * lu(k,2833) + lu(k,2837) = lu(k,2837) - lu(k,2604) * lu(k,2833) + lu(k,2839) = lu(k,2839) - lu(k,2605) * lu(k,2833) + lu(k,2840) = lu(k,2840) - lu(k,2606) * lu(k,2833) + lu(k,2842) = lu(k,2842) - lu(k,2607) * lu(k,2833) + lu(k,2843) = lu(k,2843) - lu(k,2608) * lu(k,2833) + lu(k,2844) = - lu(k,2609) * lu(k,2833) + lu(k,2845) = lu(k,2845) - lu(k,2610) * lu(k,2833) + lu(k,2846) = lu(k,2846) - lu(k,2611) * lu(k,2833) + lu(k,2847) = lu(k,2847) - lu(k,2612) * lu(k,2833) + lu(k,2849) = lu(k,2849) - lu(k,2613) * lu(k,2833) + lu(k,2850) = lu(k,2850) - lu(k,2614) * lu(k,2833) + lu(k,2851) = lu(k,2851) - lu(k,2615) * lu(k,2833) + lu(k,2852) = - lu(k,2616) * lu(k,2833) + lu(k,2853) = lu(k,2853) - lu(k,2617) * lu(k,2833) + lu(k,2854) = lu(k,2854) - lu(k,2618) * lu(k,2833) + lu(k,2906) = lu(k,2906) - lu(k,2601) * lu(k,2905) + lu(k,2907) = lu(k,2907) - lu(k,2602) * lu(k,2905) + lu(k,2908) = lu(k,2908) - lu(k,2603) * lu(k,2905) + lu(k,2909) = lu(k,2909) - lu(k,2604) * lu(k,2905) + lu(k,2911) = lu(k,2911) - lu(k,2605) * lu(k,2905) + lu(k,2912) = lu(k,2912) - lu(k,2606) * lu(k,2905) + lu(k,2915) = lu(k,2915) - lu(k,2607) * lu(k,2905) + lu(k,2916) = lu(k,2916) - lu(k,2608) * lu(k,2905) + lu(k,2917) = lu(k,2917) - lu(k,2609) * lu(k,2905) + lu(k,2918) = lu(k,2918) - lu(k,2610) * lu(k,2905) + lu(k,2919) = lu(k,2919) - lu(k,2611) * lu(k,2905) + lu(k,2920) = lu(k,2920) - lu(k,2612) * lu(k,2905) + lu(k,2922) = lu(k,2922) - lu(k,2613) * lu(k,2905) + lu(k,2923) = lu(k,2923) - lu(k,2614) * lu(k,2905) + lu(k,2924) = lu(k,2924) - lu(k,2615) * lu(k,2905) + lu(k,2926) = lu(k,2926) - lu(k,2616) * lu(k,2905) + lu(k,2927) = lu(k,2927) - lu(k,2617) * lu(k,2905) + lu(k,2928) = lu(k,2928) - lu(k,2618) * lu(k,2905) + lu(k,3096) = lu(k,3096) - lu(k,2601) * lu(k,3095) + lu(k,3097) = lu(k,3097) - lu(k,2602) * lu(k,3095) + lu(k,3098) = lu(k,3098) - lu(k,2603) * lu(k,3095) + lu(k,3099) = lu(k,3099) - lu(k,2604) * lu(k,3095) + lu(k,3101) = lu(k,3101) - lu(k,2605) * lu(k,3095) + lu(k,3102) = lu(k,3102) - lu(k,2606) * lu(k,3095) + lu(k,3105) = lu(k,3105) - lu(k,2607) * lu(k,3095) + lu(k,3106) = lu(k,3106) - lu(k,2608) * lu(k,3095) + lu(k,3107) = lu(k,3107) - lu(k,2609) * lu(k,3095) + lu(k,3108) = lu(k,3108) - lu(k,2610) * lu(k,3095) + lu(k,3109) = lu(k,3109) - lu(k,2611) * lu(k,3095) + lu(k,3110) = lu(k,3110) - lu(k,2612) * lu(k,3095) + lu(k,3114) = lu(k,3114) - lu(k,2613) * lu(k,3095) + lu(k,3115) = lu(k,3115) - lu(k,2614) * lu(k,3095) + lu(k,3116) = lu(k,3116) - lu(k,2615) * lu(k,3095) + lu(k,3118) = lu(k,3118) - lu(k,2616) * lu(k,3095) + lu(k,3119) = lu(k,3119) - lu(k,2617) * lu(k,3095) + lu(k,3120) = lu(k,3120) - lu(k,2618) * lu(k,3095) + lu(k,3355) = lu(k,3355) - lu(k,2601) * lu(k,3354) + lu(k,3356) = lu(k,3356) - lu(k,2602) * lu(k,3354) + lu(k,3357) = lu(k,3357) - lu(k,2603) * lu(k,3354) + lu(k,3358) = lu(k,3358) - lu(k,2604) * lu(k,3354) + lu(k,3360) = lu(k,3360) - lu(k,2605) * lu(k,3354) + lu(k,3361) = lu(k,3361) - lu(k,2606) * lu(k,3354) + lu(k,3364) = lu(k,3364) - lu(k,2607) * lu(k,3354) + lu(k,3365) = lu(k,3365) - lu(k,2608) * lu(k,3354) + lu(k,3366) = lu(k,3366) - lu(k,2609) * lu(k,3354) + lu(k,3367) = lu(k,3367) - lu(k,2610) * lu(k,3354) + lu(k,3368) = lu(k,3368) - lu(k,2611) * lu(k,3354) + lu(k,3369) = lu(k,3369) - lu(k,2612) * lu(k,3354) + lu(k,3373) = lu(k,3373) - lu(k,2613) * lu(k,3354) + lu(k,3374) = lu(k,3374) - lu(k,2614) * lu(k,3354) + lu(k,3375) = lu(k,3375) - lu(k,2615) * lu(k,3354) + lu(k,3377) = lu(k,3377) - lu(k,2616) * lu(k,3354) + lu(k,3378) = lu(k,3378) - lu(k,2617) * lu(k,3354) + lu(k,3379) = lu(k,3379) - lu(k,2618) * lu(k,3354) + lu(k,3448) = lu(k,3448) - lu(k,2601) * lu(k,3447) + lu(k,3449) = lu(k,3449) - lu(k,2602) * lu(k,3447) + lu(k,3450) = lu(k,3450) - lu(k,2603) * lu(k,3447) + lu(k,3451) = lu(k,3451) - lu(k,2604) * lu(k,3447) + lu(k,3453) = lu(k,3453) - lu(k,2605) * lu(k,3447) + lu(k,3454) = lu(k,3454) - lu(k,2606) * lu(k,3447) + lu(k,3457) = lu(k,3457) - lu(k,2607) * lu(k,3447) + lu(k,3458) = lu(k,3458) - lu(k,2608) * lu(k,3447) + lu(k,3459) = lu(k,3459) - lu(k,2609) * lu(k,3447) + lu(k,3460) = lu(k,3460) - lu(k,2610) * lu(k,3447) + lu(k,3461) = lu(k,3461) - lu(k,2611) * lu(k,3447) + lu(k,3462) = lu(k,3462) - lu(k,2612) * lu(k,3447) + lu(k,3466) = lu(k,3466) - lu(k,2613) * lu(k,3447) + lu(k,3467) = lu(k,3467) - lu(k,2614) * lu(k,3447) + lu(k,3468) = lu(k,3468) - lu(k,2615) * lu(k,3447) + lu(k,3470) = lu(k,3470) - lu(k,2616) * lu(k,3447) + lu(k,3471) = lu(k,3471) - lu(k,2617) * lu(k,3447) + lu(k,3472) = lu(k,3472) - lu(k,2618) * lu(k,3447) + lu(k,3592) = lu(k,3592) - lu(k,2601) * lu(k,3591) + lu(k,3593) = lu(k,3593) - lu(k,2602) * lu(k,3591) + lu(k,3594) = lu(k,3594) - lu(k,2603) * lu(k,3591) + lu(k,3595) = lu(k,3595) - lu(k,2604) * lu(k,3591) + lu(k,3597) = lu(k,3597) - lu(k,2605) * lu(k,3591) + lu(k,3598) = lu(k,3598) - lu(k,2606) * lu(k,3591) + lu(k,3601) = lu(k,3601) - lu(k,2607) * lu(k,3591) + lu(k,3602) = lu(k,3602) - lu(k,2608) * lu(k,3591) + lu(k,3603) = lu(k,3603) - lu(k,2609) * lu(k,3591) + lu(k,3604) = lu(k,3604) - lu(k,2610) * lu(k,3591) + lu(k,3605) = lu(k,3605) - lu(k,2611) * lu(k,3591) + lu(k,3606) = lu(k,3606) - lu(k,2612) * lu(k,3591) + lu(k,3610) = lu(k,3610) - lu(k,2613) * lu(k,3591) + lu(k,3611) = lu(k,3611) - lu(k,2614) * lu(k,3591) + lu(k,3612) = lu(k,3612) - lu(k,2615) * lu(k,3591) + lu(k,3614) = lu(k,3614) - lu(k,2616) * lu(k,3591) + lu(k,3615) = lu(k,3615) - lu(k,2617) * lu(k,3591) + lu(k,3616) = lu(k,3616) - lu(k,2618) * lu(k,3591) + lu(k,3746) = lu(k,3746) - lu(k,2601) * lu(k,3745) + lu(k,3747) = lu(k,3747) - lu(k,2602) * lu(k,3745) + lu(k,3748) = lu(k,3748) - lu(k,2603) * lu(k,3745) + lu(k,3749) = lu(k,3749) - lu(k,2604) * lu(k,3745) + lu(k,3751) = lu(k,3751) - lu(k,2605) * lu(k,3745) + lu(k,3752) = lu(k,3752) - lu(k,2606) * lu(k,3745) + lu(k,3755) = lu(k,3755) - lu(k,2607) * lu(k,3745) + lu(k,3756) = lu(k,3756) - lu(k,2608) * lu(k,3745) + lu(k,3757) = lu(k,3757) - lu(k,2609) * lu(k,3745) + lu(k,3758) = lu(k,3758) - lu(k,2610) * lu(k,3745) + lu(k,3759) = lu(k,3759) - lu(k,2611) * lu(k,3745) + lu(k,3760) = lu(k,3760) - lu(k,2612) * lu(k,3745) + lu(k,3764) = lu(k,3764) - lu(k,2613) * lu(k,3745) + lu(k,3765) = lu(k,3765) - lu(k,2614) * lu(k,3745) + lu(k,3766) = lu(k,3766) - lu(k,2615) * lu(k,3745) + lu(k,3768) = lu(k,3768) - lu(k,2616) * lu(k,3745) + lu(k,3769) = lu(k,3769) - lu(k,2617) * lu(k,3745) + lu(k,3770) = lu(k,3770) - lu(k,2618) * lu(k,3745) + lu(k,4078) = lu(k,4078) - lu(k,2601) * lu(k,4077) + lu(k,4079) = lu(k,4079) - lu(k,2602) * lu(k,4077) + lu(k,4080) = lu(k,4080) - lu(k,2603) * lu(k,4077) + lu(k,4081) = lu(k,4081) - lu(k,2604) * lu(k,4077) + lu(k,4083) = lu(k,4083) - lu(k,2605) * lu(k,4077) + lu(k,4084) = lu(k,4084) - lu(k,2606) * lu(k,4077) + lu(k,4087) = lu(k,4087) - lu(k,2607) * lu(k,4077) + lu(k,4088) = lu(k,4088) - lu(k,2608) * lu(k,4077) + lu(k,4089) = lu(k,4089) - lu(k,2609) * lu(k,4077) + lu(k,4090) = lu(k,4090) - lu(k,2610) * lu(k,4077) + lu(k,4091) = lu(k,4091) - lu(k,2611) * lu(k,4077) + lu(k,4092) = lu(k,4092) - lu(k,2612) * lu(k,4077) + lu(k,4096) = lu(k,4096) - lu(k,2613) * lu(k,4077) + lu(k,4097) = lu(k,4097) - lu(k,2614) * lu(k,4077) + lu(k,4098) = lu(k,4098) - lu(k,2615) * lu(k,4077) + lu(k,4100) = lu(k,4100) - lu(k,2616) * lu(k,4077) + lu(k,4101) = lu(k,4101) - lu(k,2617) * lu(k,4077) + lu(k,4102) = lu(k,4102) - lu(k,2618) * lu(k,4077) + lu(k,2629) = 1._r8 / lu(k,2629) + lu(k,2630) = lu(k,2630) * lu(k,2629) + lu(k,2631) = lu(k,2631) * lu(k,2629) + lu(k,2632) = lu(k,2632) * lu(k,2629) + lu(k,2633) = lu(k,2633) * lu(k,2629) + lu(k,2634) = lu(k,2634) * lu(k,2629) + lu(k,2635) = lu(k,2635) * lu(k,2629) + lu(k,2636) = lu(k,2636) * lu(k,2629) + lu(k,2637) = lu(k,2637) * lu(k,2629) + lu(k,2638) = lu(k,2638) * lu(k,2629) + lu(k,2639) = lu(k,2639) * lu(k,2629) + lu(k,2640) = lu(k,2640) * lu(k,2629) + lu(k,2641) = lu(k,2641) * lu(k,2629) + lu(k,2642) = lu(k,2642) * lu(k,2629) + lu(k,2643) = lu(k,2643) * lu(k,2629) + lu(k,2644) = lu(k,2644) * lu(k,2629) + lu(k,2645) = lu(k,2645) * lu(k,2629) + lu(k,2646) = lu(k,2646) * lu(k,2629) + lu(k,2742) = lu(k,2742) - lu(k,2630) * lu(k,2741) + lu(k,2743) = lu(k,2743) - lu(k,2631) * lu(k,2741) + lu(k,2744) = lu(k,2744) - lu(k,2632) * lu(k,2741) + lu(k,2746) = lu(k,2746) - lu(k,2633) * lu(k,2741) + lu(k,2747) = lu(k,2747) - lu(k,2634) * lu(k,2741) + lu(k,2749) = lu(k,2749) - lu(k,2635) * lu(k,2741) + lu(k,2750) = lu(k,2750) - lu(k,2636) * lu(k,2741) + lu(k,2751) = lu(k,2751) - lu(k,2637) * lu(k,2741) + lu(k,2752) = lu(k,2752) - lu(k,2638) * lu(k,2741) + lu(k,2753) = lu(k,2753) - lu(k,2639) * lu(k,2741) + lu(k,2754) = lu(k,2754) - lu(k,2640) * lu(k,2741) + lu(k,2756) = lu(k,2756) - lu(k,2641) * lu(k,2741) + lu(k,2757) = lu(k,2757) - lu(k,2642) * lu(k,2741) + lu(k,2758) = lu(k,2758) - lu(k,2643) * lu(k,2741) + lu(k,2759) = lu(k,2759) - lu(k,2644) * lu(k,2741) + lu(k,2760) = lu(k,2760) - lu(k,2645) * lu(k,2741) + lu(k,2761) = lu(k,2761) - lu(k,2646) * lu(k,2741) + lu(k,2788) = lu(k,2788) - lu(k,2630) * lu(k,2787) + lu(k,2789) = lu(k,2789) - lu(k,2631) * lu(k,2787) + lu(k,2790) = lu(k,2790) - lu(k,2632) * lu(k,2787) + lu(k,2792) = lu(k,2792) - lu(k,2633) * lu(k,2787) + lu(k,2793) = lu(k,2793) - lu(k,2634) * lu(k,2787) + lu(k,2795) = lu(k,2795) - lu(k,2635) * lu(k,2787) + lu(k,2796) = lu(k,2796) - lu(k,2636) * lu(k,2787) + lu(k,2797) = lu(k,2797) - lu(k,2637) * lu(k,2787) + lu(k,2798) = lu(k,2798) - lu(k,2638) * lu(k,2787) + lu(k,2799) = lu(k,2799) - lu(k,2639) * lu(k,2787) + lu(k,2800) = lu(k,2800) - lu(k,2640) * lu(k,2787) + lu(k,2802) = lu(k,2802) - lu(k,2641) * lu(k,2787) + lu(k,2803) = lu(k,2803) - lu(k,2642) * lu(k,2787) + lu(k,2804) = lu(k,2804) - lu(k,2643) * lu(k,2787) + lu(k,2805) = lu(k,2805) - lu(k,2644) * lu(k,2787) + lu(k,2806) = lu(k,2806) - lu(k,2645) * lu(k,2787) + lu(k,2807) = lu(k,2807) - lu(k,2646) * lu(k,2787) + lu(k,2835) = lu(k,2835) - lu(k,2630) * lu(k,2834) + lu(k,2836) = lu(k,2836) - lu(k,2631) * lu(k,2834) + lu(k,2837) = lu(k,2837) - lu(k,2632) * lu(k,2834) + lu(k,2839) = lu(k,2839) - lu(k,2633) * lu(k,2834) + lu(k,2840) = lu(k,2840) - lu(k,2634) * lu(k,2834) + lu(k,2842) = lu(k,2842) - lu(k,2635) * lu(k,2834) + lu(k,2843) = lu(k,2843) - lu(k,2636) * lu(k,2834) + lu(k,2844) = lu(k,2844) - lu(k,2637) * lu(k,2834) + lu(k,2845) = lu(k,2845) - lu(k,2638) * lu(k,2834) + lu(k,2846) = lu(k,2846) - lu(k,2639) * lu(k,2834) + lu(k,2847) = lu(k,2847) - lu(k,2640) * lu(k,2834) + lu(k,2849) = lu(k,2849) - lu(k,2641) * lu(k,2834) + lu(k,2850) = lu(k,2850) - lu(k,2642) * lu(k,2834) + lu(k,2851) = lu(k,2851) - lu(k,2643) * lu(k,2834) + lu(k,2852) = lu(k,2852) - lu(k,2644) * lu(k,2834) + lu(k,2853) = lu(k,2853) - lu(k,2645) * lu(k,2834) + lu(k,2854) = lu(k,2854) - lu(k,2646) * lu(k,2834) + lu(k,2907) = lu(k,2907) - lu(k,2630) * lu(k,2906) + lu(k,2908) = lu(k,2908) - lu(k,2631) * lu(k,2906) + lu(k,2909) = lu(k,2909) - lu(k,2632) * lu(k,2906) + lu(k,2911) = lu(k,2911) - lu(k,2633) * lu(k,2906) + lu(k,2912) = lu(k,2912) - lu(k,2634) * lu(k,2906) + lu(k,2915) = lu(k,2915) - lu(k,2635) * lu(k,2906) + lu(k,2916) = lu(k,2916) - lu(k,2636) * lu(k,2906) + lu(k,2917) = lu(k,2917) - lu(k,2637) * lu(k,2906) + lu(k,2918) = lu(k,2918) - lu(k,2638) * lu(k,2906) + lu(k,2919) = lu(k,2919) - lu(k,2639) * lu(k,2906) + lu(k,2920) = lu(k,2920) - lu(k,2640) * lu(k,2906) + lu(k,2922) = lu(k,2922) - lu(k,2641) * lu(k,2906) + lu(k,2923) = lu(k,2923) - lu(k,2642) * lu(k,2906) + lu(k,2924) = lu(k,2924) - lu(k,2643) * lu(k,2906) + lu(k,2926) = lu(k,2926) - lu(k,2644) * lu(k,2906) + lu(k,2927) = lu(k,2927) - lu(k,2645) * lu(k,2906) + lu(k,2928) = lu(k,2928) - lu(k,2646) * lu(k,2906) + lu(k,3097) = lu(k,3097) - lu(k,2630) * lu(k,3096) + lu(k,3098) = lu(k,3098) - lu(k,2631) * lu(k,3096) + lu(k,3099) = lu(k,3099) - lu(k,2632) * lu(k,3096) + lu(k,3101) = lu(k,3101) - lu(k,2633) * lu(k,3096) + lu(k,3102) = lu(k,3102) - lu(k,2634) * lu(k,3096) + lu(k,3105) = lu(k,3105) - lu(k,2635) * lu(k,3096) + lu(k,3106) = lu(k,3106) - lu(k,2636) * lu(k,3096) + lu(k,3107) = lu(k,3107) - lu(k,2637) * lu(k,3096) + lu(k,3108) = lu(k,3108) - lu(k,2638) * lu(k,3096) + lu(k,3109) = lu(k,3109) - lu(k,2639) * lu(k,3096) + lu(k,3110) = lu(k,3110) - lu(k,2640) * lu(k,3096) + lu(k,3114) = lu(k,3114) - lu(k,2641) * lu(k,3096) + lu(k,3115) = lu(k,3115) - lu(k,2642) * lu(k,3096) + lu(k,3116) = lu(k,3116) - lu(k,2643) * lu(k,3096) + lu(k,3118) = lu(k,3118) - lu(k,2644) * lu(k,3096) + lu(k,3119) = lu(k,3119) - lu(k,2645) * lu(k,3096) + lu(k,3120) = lu(k,3120) - lu(k,2646) * lu(k,3096) + lu(k,3356) = lu(k,3356) - lu(k,2630) * lu(k,3355) + lu(k,3357) = lu(k,3357) - lu(k,2631) * lu(k,3355) + lu(k,3358) = lu(k,3358) - lu(k,2632) * lu(k,3355) + lu(k,3360) = lu(k,3360) - lu(k,2633) * lu(k,3355) + lu(k,3361) = lu(k,3361) - lu(k,2634) * lu(k,3355) + lu(k,3364) = lu(k,3364) - lu(k,2635) * lu(k,3355) + lu(k,3365) = lu(k,3365) - lu(k,2636) * lu(k,3355) + lu(k,3366) = lu(k,3366) - lu(k,2637) * lu(k,3355) + lu(k,3367) = lu(k,3367) - lu(k,2638) * lu(k,3355) + lu(k,3368) = lu(k,3368) - lu(k,2639) * lu(k,3355) + lu(k,3369) = lu(k,3369) - lu(k,2640) * lu(k,3355) + lu(k,3373) = lu(k,3373) - lu(k,2641) * lu(k,3355) + lu(k,3374) = lu(k,3374) - lu(k,2642) * lu(k,3355) + lu(k,3375) = lu(k,3375) - lu(k,2643) * lu(k,3355) + lu(k,3377) = lu(k,3377) - lu(k,2644) * lu(k,3355) + lu(k,3378) = lu(k,3378) - lu(k,2645) * lu(k,3355) + lu(k,3379) = lu(k,3379) - lu(k,2646) * lu(k,3355) + lu(k,3449) = lu(k,3449) - lu(k,2630) * lu(k,3448) + lu(k,3450) = lu(k,3450) - lu(k,2631) * lu(k,3448) + lu(k,3451) = lu(k,3451) - lu(k,2632) * lu(k,3448) + lu(k,3453) = lu(k,3453) - lu(k,2633) * lu(k,3448) + lu(k,3454) = lu(k,3454) - lu(k,2634) * lu(k,3448) + lu(k,3457) = lu(k,3457) - lu(k,2635) * lu(k,3448) + lu(k,3458) = lu(k,3458) - lu(k,2636) * lu(k,3448) + lu(k,3459) = lu(k,3459) - lu(k,2637) * lu(k,3448) + lu(k,3460) = lu(k,3460) - lu(k,2638) * lu(k,3448) + lu(k,3461) = lu(k,3461) - lu(k,2639) * lu(k,3448) + lu(k,3462) = lu(k,3462) - lu(k,2640) * lu(k,3448) + lu(k,3466) = lu(k,3466) - lu(k,2641) * lu(k,3448) + lu(k,3467) = lu(k,3467) - lu(k,2642) * lu(k,3448) + lu(k,3468) = lu(k,3468) - lu(k,2643) * lu(k,3448) + lu(k,3470) = lu(k,3470) - lu(k,2644) * lu(k,3448) + lu(k,3471) = lu(k,3471) - lu(k,2645) * lu(k,3448) + lu(k,3472) = lu(k,3472) - lu(k,2646) * lu(k,3448) + lu(k,3593) = lu(k,3593) - lu(k,2630) * lu(k,3592) + lu(k,3594) = lu(k,3594) - lu(k,2631) * lu(k,3592) + lu(k,3595) = lu(k,3595) - lu(k,2632) * lu(k,3592) + lu(k,3597) = lu(k,3597) - lu(k,2633) * lu(k,3592) + lu(k,3598) = lu(k,3598) - lu(k,2634) * lu(k,3592) + lu(k,3601) = lu(k,3601) - lu(k,2635) * lu(k,3592) + lu(k,3602) = lu(k,3602) - lu(k,2636) * lu(k,3592) + lu(k,3603) = lu(k,3603) - lu(k,2637) * lu(k,3592) + lu(k,3604) = lu(k,3604) - lu(k,2638) * lu(k,3592) + lu(k,3605) = lu(k,3605) - lu(k,2639) * lu(k,3592) + lu(k,3606) = lu(k,3606) - lu(k,2640) * lu(k,3592) + lu(k,3610) = lu(k,3610) - lu(k,2641) * lu(k,3592) + lu(k,3611) = lu(k,3611) - lu(k,2642) * lu(k,3592) + lu(k,3612) = lu(k,3612) - lu(k,2643) * lu(k,3592) + lu(k,3614) = lu(k,3614) - lu(k,2644) * lu(k,3592) + lu(k,3615) = lu(k,3615) - lu(k,2645) * lu(k,3592) + lu(k,3616) = lu(k,3616) - lu(k,2646) * lu(k,3592) + lu(k,3747) = lu(k,3747) - lu(k,2630) * lu(k,3746) + lu(k,3748) = lu(k,3748) - lu(k,2631) * lu(k,3746) + lu(k,3749) = lu(k,3749) - lu(k,2632) * lu(k,3746) + lu(k,3751) = lu(k,3751) - lu(k,2633) * lu(k,3746) + lu(k,3752) = lu(k,3752) - lu(k,2634) * lu(k,3746) + lu(k,3755) = lu(k,3755) - lu(k,2635) * lu(k,3746) + lu(k,3756) = lu(k,3756) - lu(k,2636) * lu(k,3746) + lu(k,3757) = lu(k,3757) - lu(k,2637) * lu(k,3746) + lu(k,3758) = lu(k,3758) - lu(k,2638) * lu(k,3746) + lu(k,3759) = lu(k,3759) - lu(k,2639) * lu(k,3746) + lu(k,3760) = lu(k,3760) - lu(k,2640) * lu(k,3746) + lu(k,3764) = lu(k,3764) - lu(k,2641) * lu(k,3746) + lu(k,3765) = lu(k,3765) - lu(k,2642) * lu(k,3746) + lu(k,3766) = lu(k,3766) - lu(k,2643) * lu(k,3746) + lu(k,3768) = lu(k,3768) - lu(k,2644) * lu(k,3746) + lu(k,3769) = lu(k,3769) - lu(k,2645) * lu(k,3746) + lu(k,3770) = lu(k,3770) - lu(k,2646) * lu(k,3746) + lu(k,4079) = lu(k,4079) - lu(k,2630) * lu(k,4078) + lu(k,4080) = lu(k,4080) - lu(k,2631) * lu(k,4078) + lu(k,4081) = lu(k,4081) - lu(k,2632) * lu(k,4078) + lu(k,4083) = lu(k,4083) - lu(k,2633) * lu(k,4078) + lu(k,4084) = lu(k,4084) - lu(k,2634) * lu(k,4078) + lu(k,4087) = lu(k,4087) - lu(k,2635) * lu(k,4078) + lu(k,4088) = lu(k,4088) - lu(k,2636) * lu(k,4078) + lu(k,4089) = lu(k,4089) - lu(k,2637) * lu(k,4078) + lu(k,4090) = lu(k,4090) - lu(k,2638) * lu(k,4078) + lu(k,4091) = lu(k,4091) - lu(k,2639) * lu(k,4078) + lu(k,4092) = lu(k,4092) - lu(k,2640) * lu(k,4078) + lu(k,4096) = lu(k,4096) - lu(k,2641) * lu(k,4078) + lu(k,4097) = lu(k,4097) - lu(k,2642) * lu(k,4078) + lu(k,4098) = lu(k,4098) - lu(k,2643) * lu(k,4078) + lu(k,4100) = lu(k,4100) - lu(k,2644) * lu(k,4078) + lu(k,4101) = lu(k,4101) - lu(k,2645) * lu(k,4078) + lu(k,4102) = lu(k,4102) - lu(k,2646) * lu(k,4078) + lu(k,2654) = 1._r8 / lu(k,2654) + lu(k,2655) = lu(k,2655) * lu(k,2654) + lu(k,2656) = lu(k,2656) * lu(k,2654) + lu(k,2657) = lu(k,2657) * lu(k,2654) + lu(k,2658) = lu(k,2658) * lu(k,2654) + lu(k,2659) = lu(k,2659) * lu(k,2654) + lu(k,2660) = lu(k,2660) * lu(k,2654) + lu(k,2661) = lu(k,2661) * lu(k,2654) + lu(k,2662) = lu(k,2662) * lu(k,2654) + lu(k,2663) = lu(k,2663) * lu(k,2654) + lu(k,2664) = lu(k,2664) * lu(k,2654) + lu(k,2665) = lu(k,2665) * lu(k,2654) + lu(k,2666) = lu(k,2666) * lu(k,2654) + lu(k,2667) = lu(k,2667) * lu(k,2654) + lu(k,2668) = lu(k,2668) * lu(k,2654) + lu(k,2669) = lu(k,2669) * lu(k,2654) + lu(k,2677) = lu(k,2677) - lu(k,2655) * lu(k,2676) + lu(k,2678) = lu(k,2678) - lu(k,2656) * lu(k,2676) + lu(k,2679) = lu(k,2679) - lu(k,2657) * lu(k,2676) + lu(k,2680) = lu(k,2680) - lu(k,2658) * lu(k,2676) + lu(k,2681) = lu(k,2681) - lu(k,2659) * lu(k,2676) + lu(k,2682) = lu(k,2682) - lu(k,2660) * lu(k,2676) + lu(k,2683) = lu(k,2683) - lu(k,2661) * lu(k,2676) + lu(k,2684) = lu(k,2684) - lu(k,2662) * lu(k,2676) + lu(k,2685) = lu(k,2685) - lu(k,2663) * lu(k,2676) + lu(k,2686) = lu(k,2686) - lu(k,2664) * lu(k,2676) + lu(k,2687) = lu(k,2687) - lu(k,2665) * lu(k,2676) + lu(k,2688) = lu(k,2688) - lu(k,2666) * lu(k,2676) + lu(k,2689) = lu(k,2689) - lu(k,2667) * lu(k,2676) + lu(k,2690) = lu(k,2690) - lu(k,2668) * lu(k,2676) + lu(k,2691) = lu(k,2691) - lu(k,2669) * lu(k,2676) + lu(k,2700) = lu(k,2700) - lu(k,2655) * lu(k,2699) + lu(k,2701) = lu(k,2701) - lu(k,2656) * lu(k,2699) + lu(k,2702) = lu(k,2702) - lu(k,2657) * lu(k,2699) + lu(k,2703) = lu(k,2703) - lu(k,2658) * lu(k,2699) + lu(k,2704) = lu(k,2704) - lu(k,2659) * lu(k,2699) + lu(k,2705) = lu(k,2705) - lu(k,2660) * lu(k,2699) + lu(k,2706) = lu(k,2706) - lu(k,2661) * lu(k,2699) + lu(k,2707) = lu(k,2707) - lu(k,2662) * lu(k,2699) + lu(k,2708) = lu(k,2708) - lu(k,2663) * lu(k,2699) + lu(k,2709) = lu(k,2709) - lu(k,2664) * lu(k,2699) + lu(k,2710) = lu(k,2710) - lu(k,2665) * lu(k,2699) + lu(k,2711) = lu(k,2711) - lu(k,2666) * lu(k,2699) + lu(k,2712) = lu(k,2712) - lu(k,2667) * lu(k,2699) + lu(k,2713) = lu(k,2713) - lu(k,2668) * lu(k,2699) + lu(k,2714) = lu(k,2714) - lu(k,2669) * lu(k,2699) + lu(k,2743) = lu(k,2743) - lu(k,2655) * lu(k,2742) + lu(k,2744) = lu(k,2744) - lu(k,2656) * lu(k,2742) + lu(k,2745) = lu(k,2745) - lu(k,2657) * lu(k,2742) + lu(k,2746) = lu(k,2746) - lu(k,2658) * lu(k,2742) + lu(k,2747) = lu(k,2747) - lu(k,2659) * lu(k,2742) + lu(k,2748) = lu(k,2748) - lu(k,2660) * lu(k,2742) + lu(k,2749) = lu(k,2749) - lu(k,2661) * lu(k,2742) + lu(k,2750) = lu(k,2750) - lu(k,2662) * lu(k,2742) + lu(k,2752) = lu(k,2752) - lu(k,2663) * lu(k,2742) + lu(k,2753) = lu(k,2753) - lu(k,2664) * lu(k,2742) + lu(k,2754) = lu(k,2754) - lu(k,2665) * lu(k,2742) + lu(k,2755) = lu(k,2755) - lu(k,2666) * lu(k,2742) + lu(k,2756) = lu(k,2756) - lu(k,2667) * lu(k,2742) + lu(k,2757) = lu(k,2757) - lu(k,2668) * lu(k,2742) + lu(k,2760) = lu(k,2760) - lu(k,2669) * lu(k,2742) + lu(k,2789) = lu(k,2789) - lu(k,2655) * lu(k,2788) + lu(k,2790) = lu(k,2790) - lu(k,2656) * lu(k,2788) + lu(k,2791) = lu(k,2791) - lu(k,2657) * lu(k,2788) + lu(k,2792) = lu(k,2792) - lu(k,2658) * lu(k,2788) + lu(k,2793) = lu(k,2793) - lu(k,2659) * lu(k,2788) + lu(k,2794) = lu(k,2794) - lu(k,2660) * lu(k,2788) + lu(k,2795) = lu(k,2795) - lu(k,2661) * lu(k,2788) + lu(k,2796) = lu(k,2796) - lu(k,2662) * lu(k,2788) + lu(k,2798) = lu(k,2798) - lu(k,2663) * lu(k,2788) + lu(k,2799) = lu(k,2799) - lu(k,2664) * lu(k,2788) + lu(k,2800) = lu(k,2800) - lu(k,2665) * lu(k,2788) + lu(k,2801) = lu(k,2801) - lu(k,2666) * lu(k,2788) + lu(k,2802) = lu(k,2802) - lu(k,2667) * lu(k,2788) + lu(k,2803) = lu(k,2803) - lu(k,2668) * lu(k,2788) + lu(k,2806) = lu(k,2806) - lu(k,2669) * lu(k,2788) + lu(k,2836) = lu(k,2836) - lu(k,2655) * lu(k,2835) + lu(k,2837) = lu(k,2837) - lu(k,2656) * lu(k,2835) + lu(k,2838) = lu(k,2838) - lu(k,2657) * lu(k,2835) + lu(k,2839) = lu(k,2839) - lu(k,2658) * lu(k,2835) + lu(k,2840) = lu(k,2840) - lu(k,2659) * lu(k,2835) + lu(k,2841) = lu(k,2841) - lu(k,2660) * lu(k,2835) + lu(k,2842) = lu(k,2842) - lu(k,2661) * lu(k,2835) + lu(k,2843) = lu(k,2843) - lu(k,2662) * lu(k,2835) + lu(k,2845) = lu(k,2845) - lu(k,2663) * lu(k,2835) + lu(k,2846) = lu(k,2846) - lu(k,2664) * lu(k,2835) + lu(k,2847) = lu(k,2847) - lu(k,2665) * lu(k,2835) + lu(k,2848) = lu(k,2848) - lu(k,2666) * lu(k,2835) + lu(k,2849) = lu(k,2849) - lu(k,2667) * lu(k,2835) + lu(k,2850) = lu(k,2850) - lu(k,2668) * lu(k,2835) + lu(k,2853) = lu(k,2853) - lu(k,2669) * lu(k,2835) + lu(k,2908) = lu(k,2908) - lu(k,2655) * lu(k,2907) + lu(k,2909) = lu(k,2909) - lu(k,2656) * lu(k,2907) + lu(k,2910) = lu(k,2910) - lu(k,2657) * lu(k,2907) + lu(k,2911) = lu(k,2911) - lu(k,2658) * lu(k,2907) + lu(k,2912) = lu(k,2912) - lu(k,2659) * lu(k,2907) + lu(k,2913) = lu(k,2913) - lu(k,2660) * lu(k,2907) + lu(k,2915) = lu(k,2915) - lu(k,2661) * lu(k,2907) + lu(k,2916) = lu(k,2916) - lu(k,2662) * lu(k,2907) + lu(k,2918) = lu(k,2918) - lu(k,2663) * lu(k,2907) + lu(k,2919) = lu(k,2919) - lu(k,2664) * lu(k,2907) + lu(k,2920) = lu(k,2920) - lu(k,2665) * lu(k,2907) + lu(k,2921) = lu(k,2921) - lu(k,2666) * lu(k,2907) + lu(k,2922) = lu(k,2922) - lu(k,2667) * lu(k,2907) + lu(k,2923) = lu(k,2923) - lu(k,2668) * lu(k,2907) + lu(k,2927) = lu(k,2927) - lu(k,2669) * lu(k,2907) + lu(k,3098) = lu(k,3098) - lu(k,2655) * lu(k,3097) + lu(k,3099) = lu(k,3099) - lu(k,2656) * lu(k,3097) + lu(k,3100) = lu(k,3100) - lu(k,2657) * lu(k,3097) + lu(k,3101) = lu(k,3101) - lu(k,2658) * lu(k,3097) + lu(k,3102) = lu(k,3102) - lu(k,2659) * lu(k,3097) + lu(k,3103) = lu(k,3103) - lu(k,2660) * lu(k,3097) + lu(k,3105) = lu(k,3105) - lu(k,2661) * lu(k,3097) + lu(k,3106) = lu(k,3106) - lu(k,2662) * lu(k,3097) + lu(k,3108) = lu(k,3108) - lu(k,2663) * lu(k,3097) + lu(k,3109) = lu(k,3109) - lu(k,2664) * lu(k,3097) + lu(k,3110) = lu(k,3110) - lu(k,2665) * lu(k,3097) + lu(k,3111) = lu(k,3111) - lu(k,2666) * lu(k,3097) + lu(k,3114) = lu(k,3114) - lu(k,2667) * lu(k,3097) + lu(k,3115) = lu(k,3115) - lu(k,2668) * lu(k,3097) + lu(k,3119) = lu(k,3119) - lu(k,2669) * lu(k,3097) + lu(k,3357) = lu(k,3357) - lu(k,2655) * lu(k,3356) + lu(k,3358) = lu(k,3358) - lu(k,2656) * lu(k,3356) + lu(k,3359) = lu(k,3359) - lu(k,2657) * lu(k,3356) + lu(k,3360) = lu(k,3360) - lu(k,2658) * lu(k,3356) + lu(k,3361) = lu(k,3361) - lu(k,2659) * lu(k,3356) + lu(k,3362) = lu(k,3362) - lu(k,2660) * lu(k,3356) + lu(k,3364) = lu(k,3364) - lu(k,2661) * lu(k,3356) + lu(k,3365) = lu(k,3365) - lu(k,2662) * lu(k,3356) + lu(k,3367) = lu(k,3367) - lu(k,2663) * lu(k,3356) + lu(k,3368) = lu(k,3368) - lu(k,2664) * lu(k,3356) + lu(k,3369) = lu(k,3369) - lu(k,2665) * lu(k,3356) + lu(k,3370) = lu(k,3370) - lu(k,2666) * lu(k,3356) + lu(k,3373) = lu(k,3373) - lu(k,2667) * lu(k,3356) + lu(k,3374) = lu(k,3374) - lu(k,2668) * lu(k,3356) + lu(k,3378) = lu(k,3378) - lu(k,2669) * lu(k,3356) + lu(k,3450) = lu(k,3450) - lu(k,2655) * lu(k,3449) + lu(k,3451) = lu(k,3451) - lu(k,2656) * lu(k,3449) + lu(k,3452) = lu(k,3452) - lu(k,2657) * lu(k,3449) + lu(k,3453) = lu(k,3453) - lu(k,2658) * lu(k,3449) + lu(k,3454) = lu(k,3454) - lu(k,2659) * lu(k,3449) + lu(k,3455) = lu(k,3455) - lu(k,2660) * lu(k,3449) + lu(k,3457) = lu(k,3457) - lu(k,2661) * lu(k,3449) + lu(k,3458) = lu(k,3458) - lu(k,2662) * lu(k,3449) + lu(k,3460) = lu(k,3460) - lu(k,2663) * lu(k,3449) + lu(k,3461) = lu(k,3461) - lu(k,2664) * lu(k,3449) + lu(k,3462) = lu(k,3462) - lu(k,2665) * lu(k,3449) + lu(k,3463) = lu(k,3463) - lu(k,2666) * lu(k,3449) + lu(k,3466) = lu(k,3466) - lu(k,2667) * lu(k,3449) + lu(k,3467) = lu(k,3467) - lu(k,2668) * lu(k,3449) + lu(k,3471) = lu(k,3471) - lu(k,2669) * lu(k,3449) + lu(k,3594) = lu(k,3594) - lu(k,2655) * lu(k,3593) + lu(k,3595) = lu(k,3595) - lu(k,2656) * lu(k,3593) + lu(k,3596) = lu(k,3596) - lu(k,2657) * lu(k,3593) + lu(k,3597) = lu(k,3597) - lu(k,2658) * lu(k,3593) + lu(k,3598) = lu(k,3598) - lu(k,2659) * lu(k,3593) + lu(k,3599) = lu(k,3599) - lu(k,2660) * lu(k,3593) + lu(k,3601) = lu(k,3601) - lu(k,2661) * lu(k,3593) + lu(k,3602) = lu(k,3602) - lu(k,2662) * lu(k,3593) + lu(k,3604) = lu(k,3604) - lu(k,2663) * lu(k,3593) + lu(k,3605) = lu(k,3605) - lu(k,2664) * lu(k,3593) + lu(k,3606) = lu(k,3606) - lu(k,2665) * lu(k,3593) + lu(k,3607) = lu(k,3607) - lu(k,2666) * lu(k,3593) + lu(k,3610) = lu(k,3610) - lu(k,2667) * lu(k,3593) + lu(k,3611) = lu(k,3611) - lu(k,2668) * lu(k,3593) + lu(k,3615) = lu(k,3615) - lu(k,2669) * lu(k,3593) + lu(k,3748) = lu(k,3748) - lu(k,2655) * lu(k,3747) + lu(k,3749) = lu(k,3749) - lu(k,2656) * lu(k,3747) + lu(k,3750) = lu(k,3750) - lu(k,2657) * lu(k,3747) + lu(k,3751) = lu(k,3751) - lu(k,2658) * lu(k,3747) + lu(k,3752) = lu(k,3752) - lu(k,2659) * lu(k,3747) + lu(k,3753) = lu(k,3753) - lu(k,2660) * lu(k,3747) + lu(k,3755) = lu(k,3755) - lu(k,2661) * lu(k,3747) + lu(k,3756) = lu(k,3756) - lu(k,2662) * lu(k,3747) + lu(k,3758) = lu(k,3758) - lu(k,2663) * lu(k,3747) + lu(k,3759) = lu(k,3759) - lu(k,2664) * lu(k,3747) + lu(k,3760) = lu(k,3760) - lu(k,2665) * lu(k,3747) + lu(k,3761) = lu(k,3761) - lu(k,2666) * lu(k,3747) + lu(k,3764) = lu(k,3764) - lu(k,2667) * lu(k,3747) + lu(k,3765) = lu(k,3765) - lu(k,2668) * lu(k,3747) + lu(k,3769) = lu(k,3769) - lu(k,2669) * lu(k,3747) + lu(k,4080) = lu(k,4080) - lu(k,2655) * lu(k,4079) + lu(k,4081) = lu(k,4081) - lu(k,2656) * lu(k,4079) + lu(k,4082) = lu(k,4082) - lu(k,2657) * lu(k,4079) + lu(k,4083) = lu(k,4083) - lu(k,2658) * lu(k,4079) + lu(k,4084) = lu(k,4084) - lu(k,2659) * lu(k,4079) + lu(k,4085) = lu(k,4085) - lu(k,2660) * lu(k,4079) + lu(k,4087) = lu(k,4087) - lu(k,2661) * lu(k,4079) + lu(k,4088) = lu(k,4088) - lu(k,2662) * lu(k,4079) + lu(k,4090) = lu(k,4090) - lu(k,2663) * lu(k,4079) + lu(k,4091) = lu(k,4091) - lu(k,2664) * lu(k,4079) + lu(k,4092) = lu(k,4092) - lu(k,2665) * lu(k,4079) + lu(k,4093) = lu(k,4093) - lu(k,2666) * lu(k,4079) + lu(k,4096) = lu(k,4096) - lu(k,2667) * lu(k,4079) + lu(k,4097) = lu(k,4097) - lu(k,2668) * lu(k,4079) + lu(k,4101) = lu(k,4101) - lu(k,2669) * lu(k,4079) + end do + end subroutine lu_fac50 + subroutine lu_fac51( 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,2677) = 1._r8 / lu(k,2677) + lu(k,2678) = lu(k,2678) * lu(k,2677) + lu(k,2679) = lu(k,2679) * lu(k,2677) + lu(k,2680) = lu(k,2680) * lu(k,2677) + lu(k,2681) = lu(k,2681) * lu(k,2677) + lu(k,2682) = lu(k,2682) * lu(k,2677) + lu(k,2683) = lu(k,2683) * lu(k,2677) + lu(k,2684) = lu(k,2684) * lu(k,2677) + lu(k,2685) = lu(k,2685) * lu(k,2677) + lu(k,2686) = lu(k,2686) * lu(k,2677) + lu(k,2687) = lu(k,2687) * lu(k,2677) + lu(k,2688) = lu(k,2688) * lu(k,2677) + lu(k,2689) = lu(k,2689) * lu(k,2677) + lu(k,2690) = lu(k,2690) * lu(k,2677) + lu(k,2691) = lu(k,2691) * lu(k,2677) + lu(k,2701) = lu(k,2701) - lu(k,2678) * lu(k,2700) + lu(k,2702) = lu(k,2702) - lu(k,2679) * lu(k,2700) + lu(k,2703) = lu(k,2703) - lu(k,2680) * lu(k,2700) + lu(k,2704) = lu(k,2704) - lu(k,2681) * lu(k,2700) + lu(k,2705) = lu(k,2705) - lu(k,2682) * lu(k,2700) + lu(k,2706) = lu(k,2706) - lu(k,2683) * lu(k,2700) + lu(k,2707) = lu(k,2707) - lu(k,2684) * lu(k,2700) + lu(k,2708) = lu(k,2708) - lu(k,2685) * lu(k,2700) + lu(k,2709) = lu(k,2709) - lu(k,2686) * lu(k,2700) + lu(k,2710) = lu(k,2710) - lu(k,2687) * lu(k,2700) + lu(k,2711) = lu(k,2711) - lu(k,2688) * lu(k,2700) + lu(k,2712) = lu(k,2712) - lu(k,2689) * lu(k,2700) + lu(k,2713) = lu(k,2713) - lu(k,2690) * lu(k,2700) + lu(k,2714) = lu(k,2714) - lu(k,2691) * lu(k,2700) + lu(k,2744) = lu(k,2744) - lu(k,2678) * lu(k,2743) + lu(k,2745) = lu(k,2745) - lu(k,2679) * lu(k,2743) + lu(k,2746) = lu(k,2746) - lu(k,2680) * lu(k,2743) + lu(k,2747) = lu(k,2747) - lu(k,2681) * lu(k,2743) + lu(k,2748) = lu(k,2748) - lu(k,2682) * lu(k,2743) + lu(k,2749) = lu(k,2749) - lu(k,2683) * lu(k,2743) + lu(k,2750) = lu(k,2750) - lu(k,2684) * lu(k,2743) + lu(k,2752) = lu(k,2752) - lu(k,2685) * lu(k,2743) + lu(k,2753) = lu(k,2753) - lu(k,2686) * lu(k,2743) + lu(k,2754) = lu(k,2754) - lu(k,2687) * lu(k,2743) + lu(k,2755) = lu(k,2755) - lu(k,2688) * lu(k,2743) + lu(k,2756) = lu(k,2756) - lu(k,2689) * lu(k,2743) + lu(k,2757) = lu(k,2757) - lu(k,2690) * lu(k,2743) + lu(k,2760) = lu(k,2760) - lu(k,2691) * lu(k,2743) + lu(k,2790) = lu(k,2790) - lu(k,2678) * lu(k,2789) + lu(k,2791) = lu(k,2791) - lu(k,2679) * lu(k,2789) + lu(k,2792) = lu(k,2792) - lu(k,2680) * lu(k,2789) + lu(k,2793) = lu(k,2793) - lu(k,2681) * lu(k,2789) + lu(k,2794) = lu(k,2794) - lu(k,2682) * lu(k,2789) + lu(k,2795) = lu(k,2795) - lu(k,2683) * lu(k,2789) + lu(k,2796) = lu(k,2796) - lu(k,2684) * lu(k,2789) + lu(k,2798) = lu(k,2798) - lu(k,2685) * lu(k,2789) + lu(k,2799) = lu(k,2799) - lu(k,2686) * lu(k,2789) + lu(k,2800) = lu(k,2800) - lu(k,2687) * lu(k,2789) + lu(k,2801) = lu(k,2801) - lu(k,2688) * lu(k,2789) + lu(k,2802) = lu(k,2802) - lu(k,2689) * lu(k,2789) + lu(k,2803) = lu(k,2803) - lu(k,2690) * lu(k,2789) + lu(k,2806) = lu(k,2806) - lu(k,2691) * lu(k,2789) + lu(k,2837) = lu(k,2837) - lu(k,2678) * lu(k,2836) + lu(k,2838) = lu(k,2838) - lu(k,2679) * lu(k,2836) + lu(k,2839) = lu(k,2839) - lu(k,2680) * lu(k,2836) + lu(k,2840) = lu(k,2840) - lu(k,2681) * lu(k,2836) + lu(k,2841) = lu(k,2841) - lu(k,2682) * lu(k,2836) + lu(k,2842) = lu(k,2842) - lu(k,2683) * lu(k,2836) + lu(k,2843) = lu(k,2843) - lu(k,2684) * lu(k,2836) + lu(k,2845) = lu(k,2845) - lu(k,2685) * lu(k,2836) + lu(k,2846) = lu(k,2846) - lu(k,2686) * lu(k,2836) + lu(k,2847) = lu(k,2847) - lu(k,2687) * lu(k,2836) + lu(k,2848) = lu(k,2848) - lu(k,2688) * lu(k,2836) + lu(k,2849) = lu(k,2849) - lu(k,2689) * lu(k,2836) + lu(k,2850) = lu(k,2850) - lu(k,2690) * lu(k,2836) + lu(k,2853) = lu(k,2853) - lu(k,2691) * lu(k,2836) + lu(k,2909) = lu(k,2909) - lu(k,2678) * lu(k,2908) + lu(k,2910) = lu(k,2910) - lu(k,2679) * lu(k,2908) + lu(k,2911) = lu(k,2911) - lu(k,2680) * lu(k,2908) + lu(k,2912) = lu(k,2912) - lu(k,2681) * lu(k,2908) + lu(k,2913) = lu(k,2913) - lu(k,2682) * lu(k,2908) + lu(k,2915) = lu(k,2915) - lu(k,2683) * lu(k,2908) + lu(k,2916) = lu(k,2916) - lu(k,2684) * lu(k,2908) + lu(k,2918) = lu(k,2918) - lu(k,2685) * lu(k,2908) + lu(k,2919) = lu(k,2919) - lu(k,2686) * lu(k,2908) + lu(k,2920) = lu(k,2920) - lu(k,2687) * lu(k,2908) + lu(k,2921) = lu(k,2921) - lu(k,2688) * lu(k,2908) + lu(k,2922) = lu(k,2922) - lu(k,2689) * lu(k,2908) + lu(k,2923) = lu(k,2923) - lu(k,2690) * lu(k,2908) + lu(k,2927) = lu(k,2927) - lu(k,2691) * lu(k,2908) + lu(k,3099) = lu(k,3099) - lu(k,2678) * lu(k,3098) + lu(k,3100) = lu(k,3100) - lu(k,2679) * lu(k,3098) + lu(k,3101) = lu(k,3101) - lu(k,2680) * lu(k,3098) + lu(k,3102) = lu(k,3102) - lu(k,2681) * lu(k,3098) + lu(k,3103) = lu(k,3103) - lu(k,2682) * lu(k,3098) + lu(k,3105) = lu(k,3105) - lu(k,2683) * lu(k,3098) + lu(k,3106) = lu(k,3106) - lu(k,2684) * lu(k,3098) + lu(k,3108) = lu(k,3108) - lu(k,2685) * lu(k,3098) + lu(k,3109) = lu(k,3109) - lu(k,2686) * lu(k,3098) + lu(k,3110) = lu(k,3110) - lu(k,2687) * lu(k,3098) + lu(k,3111) = lu(k,3111) - lu(k,2688) * lu(k,3098) + lu(k,3114) = lu(k,3114) - lu(k,2689) * lu(k,3098) + lu(k,3115) = lu(k,3115) - lu(k,2690) * lu(k,3098) + lu(k,3119) = lu(k,3119) - lu(k,2691) * lu(k,3098) + lu(k,3358) = lu(k,3358) - lu(k,2678) * lu(k,3357) + lu(k,3359) = lu(k,3359) - lu(k,2679) * lu(k,3357) + lu(k,3360) = lu(k,3360) - lu(k,2680) * lu(k,3357) + lu(k,3361) = lu(k,3361) - lu(k,2681) * lu(k,3357) + lu(k,3362) = lu(k,3362) - lu(k,2682) * lu(k,3357) + lu(k,3364) = lu(k,3364) - lu(k,2683) * lu(k,3357) + lu(k,3365) = lu(k,3365) - lu(k,2684) * lu(k,3357) + lu(k,3367) = lu(k,3367) - lu(k,2685) * lu(k,3357) + lu(k,3368) = lu(k,3368) - lu(k,2686) * lu(k,3357) + lu(k,3369) = lu(k,3369) - lu(k,2687) * lu(k,3357) + lu(k,3370) = lu(k,3370) - lu(k,2688) * lu(k,3357) + lu(k,3373) = lu(k,3373) - lu(k,2689) * lu(k,3357) + lu(k,3374) = lu(k,3374) - lu(k,2690) * lu(k,3357) + lu(k,3378) = lu(k,3378) - lu(k,2691) * lu(k,3357) + lu(k,3451) = lu(k,3451) - lu(k,2678) * lu(k,3450) + lu(k,3452) = lu(k,3452) - lu(k,2679) * lu(k,3450) + lu(k,3453) = lu(k,3453) - lu(k,2680) * lu(k,3450) + lu(k,3454) = lu(k,3454) - lu(k,2681) * lu(k,3450) + lu(k,3455) = lu(k,3455) - lu(k,2682) * lu(k,3450) + lu(k,3457) = lu(k,3457) - lu(k,2683) * lu(k,3450) + lu(k,3458) = lu(k,3458) - lu(k,2684) * lu(k,3450) + lu(k,3460) = lu(k,3460) - lu(k,2685) * lu(k,3450) + lu(k,3461) = lu(k,3461) - lu(k,2686) * lu(k,3450) + lu(k,3462) = lu(k,3462) - lu(k,2687) * lu(k,3450) + lu(k,3463) = lu(k,3463) - lu(k,2688) * lu(k,3450) + lu(k,3466) = lu(k,3466) - lu(k,2689) * lu(k,3450) + lu(k,3467) = lu(k,3467) - lu(k,2690) * lu(k,3450) + lu(k,3471) = lu(k,3471) - lu(k,2691) * lu(k,3450) + lu(k,3595) = lu(k,3595) - lu(k,2678) * lu(k,3594) + lu(k,3596) = lu(k,3596) - lu(k,2679) * lu(k,3594) + lu(k,3597) = lu(k,3597) - lu(k,2680) * lu(k,3594) + lu(k,3598) = lu(k,3598) - lu(k,2681) * lu(k,3594) + lu(k,3599) = lu(k,3599) - lu(k,2682) * lu(k,3594) + lu(k,3601) = lu(k,3601) - lu(k,2683) * lu(k,3594) + lu(k,3602) = lu(k,3602) - lu(k,2684) * lu(k,3594) + lu(k,3604) = lu(k,3604) - lu(k,2685) * lu(k,3594) + lu(k,3605) = lu(k,3605) - lu(k,2686) * lu(k,3594) + lu(k,3606) = lu(k,3606) - lu(k,2687) * lu(k,3594) + lu(k,3607) = lu(k,3607) - lu(k,2688) * lu(k,3594) + lu(k,3610) = lu(k,3610) - lu(k,2689) * lu(k,3594) + lu(k,3611) = lu(k,3611) - lu(k,2690) * lu(k,3594) + lu(k,3615) = lu(k,3615) - lu(k,2691) * lu(k,3594) + lu(k,3749) = lu(k,3749) - lu(k,2678) * lu(k,3748) + lu(k,3750) = lu(k,3750) - lu(k,2679) * lu(k,3748) + lu(k,3751) = lu(k,3751) - lu(k,2680) * lu(k,3748) + lu(k,3752) = lu(k,3752) - lu(k,2681) * lu(k,3748) + lu(k,3753) = lu(k,3753) - lu(k,2682) * lu(k,3748) + lu(k,3755) = lu(k,3755) - lu(k,2683) * lu(k,3748) + lu(k,3756) = lu(k,3756) - lu(k,2684) * lu(k,3748) + lu(k,3758) = lu(k,3758) - lu(k,2685) * lu(k,3748) + lu(k,3759) = lu(k,3759) - lu(k,2686) * lu(k,3748) + lu(k,3760) = lu(k,3760) - lu(k,2687) * lu(k,3748) + lu(k,3761) = lu(k,3761) - lu(k,2688) * lu(k,3748) + lu(k,3764) = lu(k,3764) - lu(k,2689) * lu(k,3748) + lu(k,3765) = lu(k,3765) - lu(k,2690) * lu(k,3748) + lu(k,3769) = lu(k,3769) - lu(k,2691) * lu(k,3748) + lu(k,4081) = lu(k,4081) - lu(k,2678) * lu(k,4080) + lu(k,4082) = lu(k,4082) - lu(k,2679) * lu(k,4080) + lu(k,4083) = lu(k,4083) - lu(k,2680) * lu(k,4080) + lu(k,4084) = lu(k,4084) - lu(k,2681) * lu(k,4080) + lu(k,4085) = lu(k,4085) - lu(k,2682) * lu(k,4080) + lu(k,4087) = lu(k,4087) - lu(k,2683) * lu(k,4080) + lu(k,4088) = lu(k,4088) - lu(k,2684) * lu(k,4080) + lu(k,4090) = lu(k,4090) - lu(k,2685) * lu(k,4080) + lu(k,4091) = lu(k,4091) - lu(k,2686) * lu(k,4080) + lu(k,4092) = lu(k,4092) - lu(k,2687) * lu(k,4080) + lu(k,4093) = lu(k,4093) - lu(k,2688) * lu(k,4080) + lu(k,4096) = lu(k,4096) - lu(k,2689) * lu(k,4080) + lu(k,4097) = lu(k,4097) - lu(k,2690) * lu(k,4080) + lu(k,4101) = lu(k,4101) - lu(k,2691) * lu(k,4080) + lu(k,2701) = 1._r8 / lu(k,2701) + lu(k,2702) = lu(k,2702) * lu(k,2701) + lu(k,2703) = lu(k,2703) * lu(k,2701) + lu(k,2704) = lu(k,2704) * lu(k,2701) + lu(k,2705) = lu(k,2705) * lu(k,2701) + lu(k,2706) = lu(k,2706) * lu(k,2701) + lu(k,2707) = lu(k,2707) * lu(k,2701) + lu(k,2708) = lu(k,2708) * lu(k,2701) + lu(k,2709) = lu(k,2709) * lu(k,2701) + lu(k,2710) = lu(k,2710) * lu(k,2701) + lu(k,2711) = lu(k,2711) * lu(k,2701) + lu(k,2712) = lu(k,2712) * lu(k,2701) + lu(k,2713) = lu(k,2713) * lu(k,2701) + lu(k,2714) = lu(k,2714) * lu(k,2701) + lu(k,2715) = lu(k,2715) * lu(k,2701) + lu(k,2745) = lu(k,2745) - lu(k,2702) * lu(k,2744) + lu(k,2746) = lu(k,2746) - lu(k,2703) * lu(k,2744) + lu(k,2747) = lu(k,2747) - lu(k,2704) * lu(k,2744) + lu(k,2748) = lu(k,2748) - lu(k,2705) * lu(k,2744) + lu(k,2749) = lu(k,2749) - lu(k,2706) * lu(k,2744) + lu(k,2750) = lu(k,2750) - lu(k,2707) * lu(k,2744) + lu(k,2752) = lu(k,2752) - lu(k,2708) * lu(k,2744) + lu(k,2753) = lu(k,2753) - lu(k,2709) * lu(k,2744) + lu(k,2754) = lu(k,2754) - lu(k,2710) * lu(k,2744) + lu(k,2755) = lu(k,2755) - lu(k,2711) * lu(k,2744) + lu(k,2756) = lu(k,2756) - lu(k,2712) * lu(k,2744) + lu(k,2757) = lu(k,2757) - lu(k,2713) * lu(k,2744) + lu(k,2760) = lu(k,2760) - lu(k,2714) * lu(k,2744) + lu(k,2761) = lu(k,2761) - lu(k,2715) * lu(k,2744) + lu(k,2791) = lu(k,2791) - lu(k,2702) * lu(k,2790) + lu(k,2792) = lu(k,2792) - lu(k,2703) * lu(k,2790) + lu(k,2793) = lu(k,2793) - lu(k,2704) * lu(k,2790) + lu(k,2794) = lu(k,2794) - lu(k,2705) * lu(k,2790) + lu(k,2795) = lu(k,2795) - lu(k,2706) * lu(k,2790) + lu(k,2796) = lu(k,2796) - lu(k,2707) * lu(k,2790) + lu(k,2798) = lu(k,2798) - lu(k,2708) * lu(k,2790) + lu(k,2799) = lu(k,2799) - lu(k,2709) * lu(k,2790) + lu(k,2800) = lu(k,2800) - lu(k,2710) * lu(k,2790) + lu(k,2801) = lu(k,2801) - lu(k,2711) * lu(k,2790) + lu(k,2802) = lu(k,2802) - lu(k,2712) * lu(k,2790) + lu(k,2803) = lu(k,2803) - lu(k,2713) * lu(k,2790) + lu(k,2806) = lu(k,2806) - lu(k,2714) * lu(k,2790) + lu(k,2807) = lu(k,2807) - lu(k,2715) * lu(k,2790) + lu(k,2838) = lu(k,2838) - lu(k,2702) * lu(k,2837) + lu(k,2839) = lu(k,2839) - lu(k,2703) * lu(k,2837) + lu(k,2840) = lu(k,2840) - lu(k,2704) * lu(k,2837) + lu(k,2841) = lu(k,2841) - lu(k,2705) * lu(k,2837) + lu(k,2842) = lu(k,2842) - lu(k,2706) * lu(k,2837) + lu(k,2843) = lu(k,2843) - lu(k,2707) * lu(k,2837) + lu(k,2845) = lu(k,2845) - lu(k,2708) * lu(k,2837) + lu(k,2846) = lu(k,2846) - lu(k,2709) * lu(k,2837) + lu(k,2847) = lu(k,2847) - lu(k,2710) * lu(k,2837) + lu(k,2848) = lu(k,2848) - lu(k,2711) * lu(k,2837) + lu(k,2849) = lu(k,2849) - lu(k,2712) * lu(k,2837) + lu(k,2850) = lu(k,2850) - lu(k,2713) * lu(k,2837) + lu(k,2853) = lu(k,2853) - lu(k,2714) * lu(k,2837) + lu(k,2854) = lu(k,2854) - lu(k,2715) * lu(k,2837) + lu(k,2910) = lu(k,2910) - lu(k,2702) * lu(k,2909) + lu(k,2911) = lu(k,2911) - lu(k,2703) * lu(k,2909) + lu(k,2912) = lu(k,2912) - lu(k,2704) * lu(k,2909) + lu(k,2913) = lu(k,2913) - lu(k,2705) * lu(k,2909) + lu(k,2915) = lu(k,2915) - lu(k,2706) * lu(k,2909) + lu(k,2916) = lu(k,2916) - lu(k,2707) * lu(k,2909) + lu(k,2918) = lu(k,2918) - lu(k,2708) * lu(k,2909) + lu(k,2919) = lu(k,2919) - lu(k,2709) * lu(k,2909) + lu(k,2920) = lu(k,2920) - lu(k,2710) * lu(k,2909) + lu(k,2921) = lu(k,2921) - lu(k,2711) * lu(k,2909) + lu(k,2922) = lu(k,2922) - lu(k,2712) * lu(k,2909) + lu(k,2923) = lu(k,2923) - lu(k,2713) * lu(k,2909) + lu(k,2927) = lu(k,2927) - lu(k,2714) * lu(k,2909) + lu(k,2928) = lu(k,2928) - lu(k,2715) * lu(k,2909) + lu(k,3100) = lu(k,3100) - lu(k,2702) * lu(k,3099) + lu(k,3101) = lu(k,3101) - lu(k,2703) * lu(k,3099) + lu(k,3102) = lu(k,3102) - lu(k,2704) * lu(k,3099) + lu(k,3103) = lu(k,3103) - lu(k,2705) * lu(k,3099) + lu(k,3105) = lu(k,3105) - lu(k,2706) * lu(k,3099) + lu(k,3106) = lu(k,3106) - lu(k,2707) * lu(k,3099) + lu(k,3108) = lu(k,3108) - lu(k,2708) * lu(k,3099) + lu(k,3109) = lu(k,3109) - lu(k,2709) * lu(k,3099) + lu(k,3110) = lu(k,3110) - lu(k,2710) * lu(k,3099) + lu(k,3111) = lu(k,3111) - lu(k,2711) * lu(k,3099) + lu(k,3114) = lu(k,3114) - lu(k,2712) * lu(k,3099) + lu(k,3115) = lu(k,3115) - lu(k,2713) * lu(k,3099) + lu(k,3119) = lu(k,3119) - lu(k,2714) * lu(k,3099) + lu(k,3120) = lu(k,3120) - lu(k,2715) * lu(k,3099) + lu(k,3359) = lu(k,3359) - lu(k,2702) * lu(k,3358) + lu(k,3360) = lu(k,3360) - lu(k,2703) * lu(k,3358) + lu(k,3361) = lu(k,3361) - lu(k,2704) * lu(k,3358) + lu(k,3362) = lu(k,3362) - lu(k,2705) * lu(k,3358) + lu(k,3364) = lu(k,3364) - lu(k,2706) * lu(k,3358) + lu(k,3365) = lu(k,3365) - lu(k,2707) * lu(k,3358) + lu(k,3367) = lu(k,3367) - lu(k,2708) * lu(k,3358) + lu(k,3368) = lu(k,3368) - lu(k,2709) * lu(k,3358) + lu(k,3369) = lu(k,3369) - lu(k,2710) * lu(k,3358) + lu(k,3370) = lu(k,3370) - lu(k,2711) * lu(k,3358) + lu(k,3373) = lu(k,3373) - lu(k,2712) * lu(k,3358) + lu(k,3374) = lu(k,3374) - lu(k,2713) * lu(k,3358) + lu(k,3378) = lu(k,3378) - lu(k,2714) * lu(k,3358) + lu(k,3379) = lu(k,3379) - lu(k,2715) * lu(k,3358) + lu(k,3452) = lu(k,3452) - lu(k,2702) * lu(k,3451) + lu(k,3453) = lu(k,3453) - lu(k,2703) * lu(k,3451) + lu(k,3454) = lu(k,3454) - lu(k,2704) * lu(k,3451) + lu(k,3455) = lu(k,3455) - lu(k,2705) * lu(k,3451) + lu(k,3457) = lu(k,3457) - lu(k,2706) * lu(k,3451) + lu(k,3458) = lu(k,3458) - lu(k,2707) * lu(k,3451) + lu(k,3460) = lu(k,3460) - lu(k,2708) * lu(k,3451) + lu(k,3461) = lu(k,3461) - lu(k,2709) * lu(k,3451) + lu(k,3462) = lu(k,3462) - lu(k,2710) * lu(k,3451) + lu(k,3463) = lu(k,3463) - lu(k,2711) * lu(k,3451) + lu(k,3466) = lu(k,3466) - lu(k,2712) * lu(k,3451) + lu(k,3467) = lu(k,3467) - lu(k,2713) * lu(k,3451) + lu(k,3471) = lu(k,3471) - lu(k,2714) * lu(k,3451) + lu(k,3472) = lu(k,3472) - lu(k,2715) * lu(k,3451) + lu(k,3596) = lu(k,3596) - lu(k,2702) * lu(k,3595) + lu(k,3597) = lu(k,3597) - lu(k,2703) * lu(k,3595) + lu(k,3598) = lu(k,3598) - lu(k,2704) * lu(k,3595) + lu(k,3599) = lu(k,3599) - lu(k,2705) * lu(k,3595) + lu(k,3601) = lu(k,3601) - lu(k,2706) * lu(k,3595) + lu(k,3602) = lu(k,3602) - lu(k,2707) * lu(k,3595) + lu(k,3604) = lu(k,3604) - lu(k,2708) * lu(k,3595) + lu(k,3605) = lu(k,3605) - lu(k,2709) * lu(k,3595) + lu(k,3606) = lu(k,3606) - lu(k,2710) * lu(k,3595) + lu(k,3607) = lu(k,3607) - lu(k,2711) * lu(k,3595) + lu(k,3610) = lu(k,3610) - lu(k,2712) * lu(k,3595) + lu(k,3611) = lu(k,3611) - lu(k,2713) * lu(k,3595) + lu(k,3615) = lu(k,3615) - lu(k,2714) * lu(k,3595) + lu(k,3616) = lu(k,3616) - lu(k,2715) * lu(k,3595) + lu(k,3648) = lu(k,3648) - lu(k,2702) * lu(k,3647) + lu(k,3649) = lu(k,3649) - lu(k,2703) * lu(k,3647) + lu(k,3650) = lu(k,3650) - lu(k,2704) * lu(k,3647) + lu(k,3651) = lu(k,3651) - lu(k,2705) * lu(k,3647) + lu(k,3653) = lu(k,3653) - lu(k,2706) * lu(k,3647) + lu(k,3654) = lu(k,3654) - lu(k,2707) * lu(k,3647) + lu(k,3656) = lu(k,3656) - lu(k,2708) * lu(k,3647) + lu(k,3657) = lu(k,3657) - lu(k,2709) * lu(k,3647) + lu(k,3658) = lu(k,3658) - lu(k,2710) * lu(k,3647) + lu(k,3659) = lu(k,3659) - lu(k,2711) * lu(k,3647) + lu(k,3662) = lu(k,3662) - lu(k,2712) * lu(k,3647) + lu(k,3663) = lu(k,3663) - lu(k,2713) * lu(k,3647) + lu(k,3667) = lu(k,3667) - lu(k,2714) * lu(k,3647) + lu(k,3668) = lu(k,3668) - lu(k,2715) * lu(k,3647) + lu(k,3750) = lu(k,3750) - lu(k,2702) * lu(k,3749) + lu(k,3751) = lu(k,3751) - lu(k,2703) * lu(k,3749) + lu(k,3752) = lu(k,3752) - lu(k,2704) * lu(k,3749) + lu(k,3753) = lu(k,3753) - lu(k,2705) * lu(k,3749) + lu(k,3755) = lu(k,3755) - lu(k,2706) * lu(k,3749) + lu(k,3756) = lu(k,3756) - lu(k,2707) * lu(k,3749) + lu(k,3758) = lu(k,3758) - lu(k,2708) * lu(k,3749) + lu(k,3759) = lu(k,3759) - lu(k,2709) * lu(k,3749) + lu(k,3760) = lu(k,3760) - lu(k,2710) * lu(k,3749) + lu(k,3761) = lu(k,3761) - lu(k,2711) * lu(k,3749) + lu(k,3764) = lu(k,3764) - lu(k,2712) * lu(k,3749) + lu(k,3765) = lu(k,3765) - lu(k,2713) * lu(k,3749) + lu(k,3769) = lu(k,3769) - lu(k,2714) * lu(k,3749) + lu(k,3770) = lu(k,3770) - lu(k,2715) * lu(k,3749) + lu(k,4082) = lu(k,4082) - lu(k,2702) * lu(k,4081) + lu(k,4083) = lu(k,4083) - lu(k,2703) * lu(k,4081) + lu(k,4084) = lu(k,4084) - lu(k,2704) * lu(k,4081) + lu(k,4085) = lu(k,4085) - lu(k,2705) * lu(k,4081) + lu(k,4087) = lu(k,4087) - lu(k,2706) * lu(k,4081) + lu(k,4088) = lu(k,4088) - lu(k,2707) * lu(k,4081) + lu(k,4090) = lu(k,4090) - lu(k,2708) * lu(k,4081) + lu(k,4091) = lu(k,4091) - lu(k,2709) * lu(k,4081) + lu(k,4092) = lu(k,4092) - lu(k,2710) * lu(k,4081) + lu(k,4093) = lu(k,4093) - lu(k,2711) * lu(k,4081) + lu(k,4096) = lu(k,4096) - lu(k,2712) * lu(k,4081) + lu(k,4097) = lu(k,4097) - lu(k,2713) * lu(k,4081) + lu(k,4101) = lu(k,4101) - lu(k,2714) * lu(k,4081) + lu(k,4102) = lu(k,4102) - lu(k,2715) * lu(k,4081) + lu(k,2745) = 1._r8 / lu(k,2745) + lu(k,2746) = lu(k,2746) * lu(k,2745) + lu(k,2747) = lu(k,2747) * lu(k,2745) + lu(k,2748) = lu(k,2748) * lu(k,2745) + lu(k,2749) = lu(k,2749) * lu(k,2745) + lu(k,2750) = lu(k,2750) * lu(k,2745) + lu(k,2751) = lu(k,2751) * lu(k,2745) + lu(k,2752) = lu(k,2752) * lu(k,2745) + lu(k,2753) = lu(k,2753) * lu(k,2745) + lu(k,2754) = lu(k,2754) * lu(k,2745) + lu(k,2755) = lu(k,2755) * lu(k,2745) + lu(k,2756) = lu(k,2756) * lu(k,2745) + lu(k,2757) = lu(k,2757) * lu(k,2745) + lu(k,2758) = lu(k,2758) * lu(k,2745) + lu(k,2759) = lu(k,2759) * lu(k,2745) + lu(k,2760) = lu(k,2760) * lu(k,2745) + lu(k,2761) = lu(k,2761) * lu(k,2745) + lu(k,2792) = lu(k,2792) - lu(k,2746) * lu(k,2791) + lu(k,2793) = lu(k,2793) - lu(k,2747) * lu(k,2791) + lu(k,2794) = lu(k,2794) - lu(k,2748) * lu(k,2791) + lu(k,2795) = lu(k,2795) - lu(k,2749) * lu(k,2791) + lu(k,2796) = lu(k,2796) - lu(k,2750) * lu(k,2791) + lu(k,2797) = lu(k,2797) - lu(k,2751) * lu(k,2791) + lu(k,2798) = lu(k,2798) - lu(k,2752) * lu(k,2791) + lu(k,2799) = lu(k,2799) - lu(k,2753) * lu(k,2791) + lu(k,2800) = lu(k,2800) - lu(k,2754) * lu(k,2791) + lu(k,2801) = lu(k,2801) - lu(k,2755) * lu(k,2791) + lu(k,2802) = lu(k,2802) - lu(k,2756) * lu(k,2791) + lu(k,2803) = lu(k,2803) - lu(k,2757) * lu(k,2791) + lu(k,2804) = lu(k,2804) - lu(k,2758) * lu(k,2791) + lu(k,2805) = lu(k,2805) - lu(k,2759) * lu(k,2791) + lu(k,2806) = lu(k,2806) - lu(k,2760) * lu(k,2791) + lu(k,2807) = lu(k,2807) - lu(k,2761) * lu(k,2791) + lu(k,2839) = lu(k,2839) - lu(k,2746) * lu(k,2838) + lu(k,2840) = lu(k,2840) - lu(k,2747) * lu(k,2838) + lu(k,2841) = lu(k,2841) - lu(k,2748) * lu(k,2838) + lu(k,2842) = lu(k,2842) - lu(k,2749) * lu(k,2838) + lu(k,2843) = lu(k,2843) - lu(k,2750) * lu(k,2838) + lu(k,2844) = lu(k,2844) - lu(k,2751) * lu(k,2838) + lu(k,2845) = lu(k,2845) - lu(k,2752) * lu(k,2838) + lu(k,2846) = lu(k,2846) - lu(k,2753) * lu(k,2838) + lu(k,2847) = lu(k,2847) - lu(k,2754) * lu(k,2838) + lu(k,2848) = lu(k,2848) - lu(k,2755) * lu(k,2838) + lu(k,2849) = lu(k,2849) - lu(k,2756) * lu(k,2838) + lu(k,2850) = lu(k,2850) - lu(k,2757) * lu(k,2838) + lu(k,2851) = lu(k,2851) - lu(k,2758) * lu(k,2838) + lu(k,2852) = lu(k,2852) - lu(k,2759) * lu(k,2838) + lu(k,2853) = lu(k,2853) - lu(k,2760) * lu(k,2838) + lu(k,2854) = lu(k,2854) - lu(k,2761) * lu(k,2838) + lu(k,2911) = lu(k,2911) - lu(k,2746) * lu(k,2910) + lu(k,2912) = lu(k,2912) - lu(k,2747) * lu(k,2910) + lu(k,2913) = lu(k,2913) - lu(k,2748) * lu(k,2910) + lu(k,2915) = lu(k,2915) - lu(k,2749) * lu(k,2910) + lu(k,2916) = lu(k,2916) - lu(k,2750) * lu(k,2910) + lu(k,2917) = lu(k,2917) - lu(k,2751) * lu(k,2910) + lu(k,2918) = lu(k,2918) - lu(k,2752) * lu(k,2910) + lu(k,2919) = lu(k,2919) - lu(k,2753) * lu(k,2910) + lu(k,2920) = lu(k,2920) - lu(k,2754) * lu(k,2910) + lu(k,2921) = lu(k,2921) - lu(k,2755) * lu(k,2910) + lu(k,2922) = lu(k,2922) - lu(k,2756) * lu(k,2910) + lu(k,2923) = lu(k,2923) - lu(k,2757) * lu(k,2910) + lu(k,2924) = lu(k,2924) - lu(k,2758) * lu(k,2910) + lu(k,2926) = lu(k,2926) - lu(k,2759) * lu(k,2910) + lu(k,2927) = lu(k,2927) - lu(k,2760) * lu(k,2910) + lu(k,2928) = lu(k,2928) - lu(k,2761) * lu(k,2910) + lu(k,3101) = lu(k,3101) - lu(k,2746) * lu(k,3100) + lu(k,3102) = lu(k,3102) - lu(k,2747) * lu(k,3100) + lu(k,3103) = lu(k,3103) - lu(k,2748) * lu(k,3100) + lu(k,3105) = lu(k,3105) - lu(k,2749) * lu(k,3100) + lu(k,3106) = lu(k,3106) - lu(k,2750) * lu(k,3100) + lu(k,3107) = lu(k,3107) - lu(k,2751) * lu(k,3100) + lu(k,3108) = lu(k,3108) - lu(k,2752) * lu(k,3100) + lu(k,3109) = lu(k,3109) - lu(k,2753) * lu(k,3100) + lu(k,3110) = lu(k,3110) - lu(k,2754) * lu(k,3100) + lu(k,3111) = lu(k,3111) - lu(k,2755) * lu(k,3100) + lu(k,3114) = lu(k,3114) - lu(k,2756) * lu(k,3100) + lu(k,3115) = lu(k,3115) - lu(k,2757) * lu(k,3100) + lu(k,3116) = lu(k,3116) - lu(k,2758) * lu(k,3100) + lu(k,3118) = lu(k,3118) - lu(k,2759) * lu(k,3100) + lu(k,3119) = lu(k,3119) - lu(k,2760) * lu(k,3100) + lu(k,3120) = lu(k,3120) - lu(k,2761) * lu(k,3100) + lu(k,3360) = lu(k,3360) - lu(k,2746) * lu(k,3359) + lu(k,3361) = lu(k,3361) - lu(k,2747) * lu(k,3359) + lu(k,3362) = lu(k,3362) - lu(k,2748) * lu(k,3359) + lu(k,3364) = lu(k,3364) - lu(k,2749) * lu(k,3359) + lu(k,3365) = lu(k,3365) - lu(k,2750) * lu(k,3359) + lu(k,3366) = lu(k,3366) - lu(k,2751) * lu(k,3359) + lu(k,3367) = lu(k,3367) - lu(k,2752) * lu(k,3359) + lu(k,3368) = lu(k,3368) - lu(k,2753) * lu(k,3359) + lu(k,3369) = lu(k,3369) - lu(k,2754) * lu(k,3359) + lu(k,3370) = lu(k,3370) - lu(k,2755) * lu(k,3359) + lu(k,3373) = lu(k,3373) - lu(k,2756) * lu(k,3359) + lu(k,3374) = lu(k,3374) - lu(k,2757) * lu(k,3359) + lu(k,3375) = lu(k,3375) - lu(k,2758) * lu(k,3359) + lu(k,3377) = lu(k,3377) - lu(k,2759) * lu(k,3359) + lu(k,3378) = lu(k,3378) - lu(k,2760) * lu(k,3359) + lu(k,3379) = lu(k,3379) - lu(k,2761) * lu(k,3359) + lu(k,3453) = lu(k,3453) - lu(k,2746) * lu(k,3452) + lu(k,3454) = lu(k,3454) - lu(k,2747) * lu(k,3452) + lu(k,3455) = lu(k,3455) - lu(k,2748) * lu(k,3452) + lu(k,3457) = lu(k,3457) - lu(k,2749) * lu(k,3452) + lu(k,3458) = lu(k,3458) - lu(k,2750) * lu(k,3452) + lu(k,3459) = lu(k,3459) - lu(k,2751) * lu(k,3452) + lu(k,3460) = lu(k,3460) - lu(k,2752) * lu(k,3452) + lu(k,3461) = lu(k,3461) - lu(k,2753) * lu(k,3452) + lu(k,3462) = lu(k,3462) - lu(k,2754) * lu(k,3452) + lu(k,3463) = lu(k,3463) - lu(k,2755) * lu(k,3452) + lu(k,3466) = lu(k,3466) - lu(k,2756) * lu(k,3452) + lu(k,3467) = lu(k,3467) - lu(k,2757) * lu(k,3452) + lu(k,3468) = lu(k,3468) - lu(k,2758) * lu(k,3452) + lu(k,3470) = lu(k,3470) - lu(k,2759) * lu(k,3452) + lu(k,3471) = lu(k,3471) - lu(k,2760) * lu(k,3452) + lu(k,3472) = lu(k,3472) - lu(k,2761) * lu(k,3452) + lu(k,3597) = lu(k,3597) - lu(k,2746) * lu(k,3596) + lu(k,3598) = lu(k,3598) - lu(k,2747) * lu(k,3596) + lu(k,3599) = lu(k,3599) - lu(k,2748) * lu(k,3596) + lu(k,3601) = lu(k,3601) - lu(k,2749) * lu(k,3596) + lu(k,3602) = lu(k,3602) - lu(k,2750) * lu(k,3596) + lu(k,3603) = lu(k,3603) - lu(k,2751) * lu(k,3596) + lu(k,3604) = lu(k,3604) - lu(k,2752) * lu(k,3596) + lu(k,3605) = lu(k,3605) - lu(k,2753) * lu(k,3596) + lu(k,3606) = lu(k,3606) - lu(k,2754) * lu(k,3596) + lu(k,3607) = lu(k,3607) - lu(k,2755) * lu(k,3596) + lu(k,3610) = lu(k,3610) - lu(k,2756) * lu(k,3596) + lu(k,3611) = lu(k,3611) - lu(k,2757) * lu(k,3596) + lu(k,3612) = lu(k,3612) - lu(k,2758) * lu(k,3596) + lu(k,3614) = lu(k,3614) - lu(k,2759) * lu(k,3596) + lu(k,3615) = lu(k,3615) - lu(k,2760) * lu(k,3596) + lu(k,3616) = lu(k,3616) - lu(k,2761) * lu(k,3596) + lu(k,3649) = lu(k,3649) - lu(k,2746) * lu(k,3648) + lu(k,3650) = lu(k,3650) - lu(k,2747) * lu(k,3648) + lu(k,3651) = lu(k,3651) - lu(k,2748) * lu(k,3648) + lu(k,3653) = lu(k,3653) - lu(k,2749) * lu(k,3648) + lu(k,3654) = lu(k,3654) - lu(k,2750) * lu(k,3648) + lu(k,3655) = lu(k,3655) - lu(k,2751) * lu(k,3648) + lu(k,3656) = lu(k,3656) - lu(k,2752) * lu(k,3648) + lu(k,3657) = lu(k,3657) - lu(k,2753) * lu(k,3648) + lu(k,3658) = lu(k,3658) - lu(k,2754) * lu(k,3648) + lu(k,3659) = lu(k,3659) - lu(k,2755) * lu(k,3648) + lu(k,3662) = lu(k,3662) - lu(k,2756) * lu(k,3648) + lu(k,3663) = lu(k,3663) - lu(k,2757) * lu(k,3648) + lu(k,3664) = lu(k,3664) - lu(k,2758) * lu(k,3648) + lu(k,3666) = lu(k,3666) - lu(k,2759) * lu(k,3648) + lu(k,3667) = lu(k,3667) - lu(k,2760) * lu(k,3648) + lu(k,3668) = lu(k,3668) - lu(k,2761) * lu(k,3648) + lu(k,3751) = lu(k,3751) - lu(k,2746) * lu(k,3750) + lu(k,3752) = lu(k,3752) - lu(k,2747) * lu(k,3750) + lu(k,3753) = lu(k,3753) - lu(k,2748) * lu(k,3750) + lu(k,3755) = lu(k,3755) - lu(k,2749) * lu(k,3750) + lu(k,3756) = lu(k,3756) - lu(k,2750) * lu(k,3750) + lu(k,3757) = lu(k,3757) - lu(k,2751) * lu(k,3750) + lu(k,3758) = lu(k,3758) - lu(k,2752) * lu(k,3750) + lu(k,3759) = lu(k,3759) - lu(k,2753) * lu(k,3750) + lu(k,3760) = lu(k,3760) - lu(k,2754) * lu(k,3750) + lu(k,3761) = lu(k,3761) - lu(k,2755) * lu(k,3750) + lu(k,3764) = lu(k,3764) - lu(k,2756) * lu(k,3750) + lu(k,3765) = lu(k,3765) - lu(k,2757) * lu(k,3750) + lu(k,3766) = lu(k,3766) - lu(k,2758) * lu(k,3750) + lu(k,3768) = lu(k,3768) - lu(k,2759) * lu(k,3750) + lu(k,3769) = lu(k,3769) - lu(k,2760) * lu(k,3750) + lu(k,3770) = lu(k,3770) - lu(k,2761) * lu(k,3750) + lu(k,4083) = lu(k,4083) - lu(k,2746) * lu(k,4082) + lu(k,4084) = lu(k,4084) - lu(k,2747) * lu(k,4082) + lu(k,4085) = lu(k,4085) - lu(k,2748) * lu(k,4082) + lu(k,4087) = lu(k,4087) - lu(k,2749) * lu(k,4082) + lu(k,4088) = lu(k,4088) - lu(k,2750) * lu(k,4082) + lu(k,4089) = lu(k,4089) - lu(k,2751) * lu(k,4082) + lu(k,4090) = lu(k,4090) - lu(k,2752) * lu(k,4082) + lu(k,4091) = lu(k,4091) - lu(k,2753) * lu(k,4082) + lu(k,4092) = lu(k,4092) - lu(k,2754) * lu(k,4082) + lu(k,4093) = lu(k,4093) - lu(k,2755) * lu(k,4082) + lu(k,4096) = lu(k,4096) - lu(k,2756) * lu(k,4082) + lu(k,4097) = lu(k,4097) - lu(k,2757) * lu(k,4082) + lu(k,4098) = lu(k,4098) - lu(k,2758) * lu(k,4082) + lu(k,4100) = lu(k,4100) - lu(k,2759) * lu(k,4082) + lu(k,4101) = lu(k,4101) - lu(k,2760) * lu(k,4082) + lu(k,4102) = lu(k,4102) - lu(k,2761) * lu(k,4082) + lu(k,2792) = 1._r8 / lu(k,2792) + lu(k,2793) = lu(k,2793) * lu(k,2792) + lu(k,2794) = lu(k,2794) * lu(k,2792) + lu(k,2795) = lu(k,2795) * lu(k,2792) + lu(k,2796) = lu(k,2796) * lu(k,2792) + lu(k,2797) = lu(k,2797) * lu(k,2792) + lu(k,2798) = lu(k,2798) * lu(k,2792) + lu(k,2799) = lu(k,2799) * lu(k,2792) + lu(k,2800) = lu(k,2800) * lu(k,2792) + lu(k,2801) = lu(k,2801) * lu(k,2792) + lu(k,2802) = lu(k,2802) * lu(k,2792) + lu(k,2803) = lu(k,2803) * lu(k,2792) + lu(k,2804) = lu(k,2804) * lu(k,2792) + lu(k,2805) = lu(k,2805) * lu(k,2792) + lu(k,2806) = lu(k,2806) * lu(k,2792) + lu(k,2807) = lu(k,2807) * lu(k,2792) + lu(k,2840) = lu(k,2840) - lu(k,2793) * lu(k,2839) + lu(k,2841) = lu(k,2841) - lu(k,2794) * lu(k,2839) + lu(k,2842) = lu(k,2842) - lu(k,2795) * lu(k,2839) + lu(k,2843) = lu(k,2843) - lu(k,2796) * lu(k,2839) + lu(k,2844) = lu(k,2844) - lu(k,2797) * lu(k,2839) + lu(k,2845) = lu(k,2845) - lu(k,2798) * lu(k,2839) + lu(k,2846) = lu(k,2846) - lu(k,2799) * lu(k,2839) + lu(k,2847) = lu(k,2847) - lu(k,2800) * lu(k,2839) + lu(k,2848) = lu(k,2848) - lu(k,2801) * lu(k,2839) + lu(k,2849) = lu(k,2849) - lu(k,2802) * lu(k,2839) + lu(k,2850) = lu(k,2850) - lu(k,2803) * lu(k,2839) + lu(k,2851) = lu(k,2851) - lu(k,2804) * lu(k,2839) + lu(k,2852) = lu(k,2852) - lu(k,2805) * lu(k,2839) + lu(k,2853) = lu(k,2853) - lu(k,2806) * lu(k,2839) + lu(k,2854) = lu(k,2854) - lu(k,2807) * lu(k,2839) + lu(k,2912) = lu(k,2912) - lu(k,2793) * lu(k,2911) + lu(k,2913) = lu(k,2913) - lu(k,2794) * lu(k,2911) + lu(k,2915) = lu(k,2915) - lu(k,2795) * lu(k,2911) + lu(k,2916) = lu(k,2916) - lu(k,2796) * lu(k,2911) + lu(k,2917) = lu(k,2917) - lu(k,2797) * lu(k,2911) + lu(k,2918) = lu(k,2918) - lu(k,2798) * lu(k,2911) + lu(k,2919) = lu(k,2919) - lu(k,2799) * lu(k,2911) + lu(k,2920) = lu(k,2920) - lu(k,2800) * lu(k,2911) + lu(k,2921) = lu(k,2921) - lu(k,2801) * lu(k,2911) + lu(k,2922) = lu(k,2922) - lu(k,2802) * lu(k,2911) + lu(k,2923) = lu(k,2923) - lu(k,2803) * lu(k,2911) + lu(k,2924) = lu(k,2924) - lu(k,2804) * lu(k,2911) + lu(k,2926) = lu(k,2926) - lu(k,2805) * lu(k,2911) + lu(k,2927) = lu(k,2927) - lu(k,2806) * lu(k,2911) + lu(k,2928) = lu(k,2928) - lu(k,2807) * lu(k,2911) + lu(k,3102) = lu(k,3102) - lu(k,2793) * lu(k,3101) + lu(k,3103) = lu(k,3103) - lu(k,2794) * lu(k,3101) + lu(k,3105) = lu(k,3105) - lu(k,2795) * lu(k,3101) + lu(k,3106) = lu(k,3106) - lu(k,2796) * lu(k,3101) + lu(k,3107) = lu(k,3107) - lu(k,2797) * lu(k,3101) + lu(k,3108) = lu(k,3108) - lu(k,2798) * lu(k,3101) + lu(k,3109) = lu(k,3109) - lu(k,2799) * lu(k,3101) + lu(k,3110) = lu(k,3110) - lu(k,2800) * lu(k,3101) + lu(k,3111) = lu(k,3111) - lu(k,2801) * lu(k,3101) + lu(k,3114) = lu(k,3114) - lu(k,2802) * lu(k,3101) + lu(k,3115) = lu(k,3115) - lu(k,2803) * lu(k,3101) + lu(k,3116) = lu(k,3116) - lu(k,2804) * lu(k,3101) + lu(k,3118) = lu(k,3118) - lu(k,2805) * lu(k,3101) + lu(k,3119) = lu(k,3119) - lu(k,2806) * lu(k,3101) + lu(k,3120) = lu(k,3120) - lu(k,2807) * lu(k,3101) + lu(k,3361) = lu(k,3361) - lu(k,2793) * lu(k,3360) + lu(k,3362) = lu(k,3362) - lu(k,2794) * lu(k,3360) + lu(k,3364) = lu(k,3364) - lu(k,2795) * lu(k,3360) + lu(k,3365) = lu(k,3365) - lu(k,2796) * lu(k,3360) + lu(k,3366) = lu(k,3366) - lu(k,2797) * lu(k,3360) + lu(k,3367) = lu(k,3367) - lu(k,2798) * lu(k,3360) + lu(k,3368) = lu(k,3368) - lu(k,2799) * lu(k,3360) + lu(k,3369) = lu(k,3369) - lu(k,2800) * lu(k,3360) + lu(k,3370) = lu(k,3370) - lu(k,2801) * lu(k,3360) + lu(k,3373) = lu(k,3373) - lu(k,2802) * lu(k,3360) + lu(k,3374) = lu(k,3374) - lu(k,2803) * lu(k,3360) + lu(k,3375) = lu(k,3375) - lu(k,2804) * lu(k,3360) + lu(k,3377) = lu(k,3377) - lu(k,2805) * lu(k,3360) + lu(k,3378) = lu(k,3378) - lu(k,2806) * lu(k,3360) + lu(k,3379) = lu(k,3379) - lu(k,2807) * lu(k,3360) + lu(k,3454) = lu(k,3454) - lu(k,2793) * lu(k,3453) + lu(k,3455) = lu(k,3455) - lu(k,2794) * lu(k,3453) + lu(k,3457) = lu(k,3457) - lu(k,2795) * lu(k,3453) + lu(k,3458) = lu(k,3458) - lu(k,2796) * lu(k,3453) + lu(k,3459) = lu(k,3459) - lu(k,2797) * lu(k,3453) + lu(k,3460) = lu(k,3460) - lu(k,2798) * lu(k,3453) + lu(k,3461) = lu(k,3461) - lu(k,2799) * lu(k,3453) + lu(k,3462) = lu(k,3462) - lu(k,2800) * lu(k,3453) + lu(k,3463) = lu(k,3463) - lu(k,2801) * lu(k,3453) + lu(k,3466) = lu(k,3466) - lu(k,2802) * lu(k,3453) + lu(k,3467) = lu(k,3467) - lu(k,2803) * lu(k,3453) + lu(k,3468) = lu(k,3468) - lu(k,2804) * lu(k,3453) + lu(k,3470) = lu(k,3470) - lu(k,2805) * lu(k,3453) + lu(k,3471) = lu(k,3471) - lu(k,2806) * lu(k,3453) + lu(k,3472) = lu(k,3472) - lu(k,2807) * lu(k,3453) + lu(k,3598) = lu(k,3598) - lu(k,2793) * lu(k,3597) + lu(k,3599) = lu(k,3599) - lu(k,2794) * lu(k,3597) + lu(k,3601) = lu(k,3601) - lu(k,2795) * lu(k,3597) + lu(k,3602) = lu(k,3602) - lu(k,2796) * lu(k,3597) + lu(k,3603) = lu(k,3603) - lu(k,2797) * lu(k,3597) + lu(k,3604) = lu(k,3604) - lu(k,2798) * lu(k,3597) + lu(k,3605) = lu(k,3605) - lu(k,2799) * lu(k,3597) + lu(k,3606) = lu(k,3606) - lu(k,2800) * lu(k,3597) + lu(k,3607) = lu(k,3607) - lu(k,2801) * lu(k,3597) + lu(k,3610) = lu(k,3610) - lu(k,2802) * lu(k,3597) + lu(k,3611) = lu(k,3611) - lu(k,2803) * lu(k,3597) + lu(k,3612) = lu(k,3612) - lu(k,2804) * lu(k,3597) + lu(k,3614) = lu(k,3614) - lu(k,2805) * lu(k,3597) + lu(k,3615) = lu(k,3615) - lu(k,2806) * lu(k,3597) + lu(k,3616) = lu(k,3616) - lu(k,2807) * lu(k,3597) + lu(k,3650) = lu(k,3650) - lu(k,2793) * lu(k,3649) + lu(k,3651) = lu(k,3651) - lu(k,2794) * lu(k,3649) + lu(k,3653) = lu(k,3653) - lu(k,2795) * lu(k,3649) + lu(k,3654) = lu(k,3654) - lu(k,2796) * lu(k,3649) + lu(k,3655) = lu(k,3655) - lu(k,2797) * lu(k,3649) + lu(k,3656) = lu(k,3656) - lu(k,2798) * lu(k,3649) + lu(k,3657) = lu(k,3657) - lu(k,2799) * lu(k,3649) + lu(k,3658) = lu(k,3658) - lu(k,2800) * lu(k,3649) + lu(k,3659) = lu(k,3659) - lu(k,2801) * lu(k,3649) + lu(k,3662) = lu(k,3662) - lu(k,2802) * lu(k,3649) + lu(k,3663) = lu(k,3663) - lu(k,2803) * lu(k,3649) + lu(k,3664) = lu(k,3664) - lu(k,2804) * lu(k,3649) + lu(k,3666) = lu(k,3666) - lu(k,2805) * lu(k,3649) + lu(k,3667) = lu(k,3667) - lu(k,2806) * lu(k,3649) + lu(k,3668) = lu(k,3668) - lu(k,2807) * lu(k,3649) + lu(k,3752) = lu(k,3752) - lu(k,2793) * lu(k,3751) + lu(k,3753) = lu(k,3753) - lu(k,2794) * lu(k,3751) + lu(k,3755) = lu(k,3755) - lu(k,2795) * lu(k,3751) + lu(k,3756) = lu(k,3756) - lu(k,2796) * lu(k,3751) + lu(k,3757) = lu(k,3757) - lu(k,2797) * lu(k,3751) + lu(k,3758) = lu(k,3758) - lu(k,2798) * lu(k,3751) + lu(k,3759) = lu(k,3759) - lu(k,2799) * lu(k,3751) + lu(k,3760) = lu(k,3760) - lu(k,2800) * lu(k,3751) + lu(k,3761) = lu(k,3761) - lu(k,2801) * lu(k,3751) + lu(k,3764) = lu(k,3764) - lu(k,2802) * lu(k,3751) + lu(k,3765) = lu(k,3765) - lu(k,2803) * lu(k,3751) + lu(k,3766) = lu(k,3766) - lu(k,2804) * lu(k,3751) + lu(k,3768) = lu(k,3768) - lu(k,2805) * lu(k,3751) + lu(k,3769) = lu(k,3769) - lu(k,2806) * lu(k,3751) + lu(k,3770) = lu(k,3770) - lu(k,2807) * lu(k,3751) + lu(k,4084) = lu(k,4084) - lu(k,2793) * lu(k,4083) + lu(k,4085) = lu(k,4085) - lu(k,2794) * lu(k,4083) + lu(k,4087) = lu(k,4087) - lu(k,2795) * lu(k,4083) + lu(k,4088) = lu(k,4088) - lu(k,2796) * lu(k,4083) + lu(k,4089) = lu(k,4089) - lu(k,2797) * lu(k,4083) + lu(k,4090) = lu(k,4090) - lu(k,2798) * lu(k,4083) + lu(k,4091) = lu(k,4091) - lu(k,2799) * lu(k,4083) + lu(k,4092) = lu(k,4092) - lu(k,2800) * lu(k,4083) + lu(k,4093) = lu(k,4093) - lu(k,2801) * lu(k,4083) + lu(k,4096) = lu(k,4096) - lu(k,2802) * lu(k,4083) + lu(k,4097) = lu(k,4097) - lu(k,2803) * lu(k,4083) + lu(k,4098) = lu(k,4098) - lu(k,2804) * lu(k,4083) + lu(k,4100) = lu(k,4100) - lu(k,2805) * lu(k,4083) + lu(k,4101) = lu(k,4101) - lu(k,2806) * lu(k,4083) + lu(k,4102) = lu(k,4102) - lu(k,2807) * lu(k,4083) + end do + end subroutine lu_fac51 + subroutine lu_fac52( 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,2840) = 1._r8 / lu(k,2840) + lu(k,2841) = lu(k,2841) * lu(k,2840) + lu(k,2842) = lu(k,2842) * lu(k,2840) + lu(k,2843) = lu(k,2843) * lu(k,2840) + lu(k,2844) = lu(k,2844) * lu(k,2840) + lu(k,2845) = lu(k,2845) * lu(k,2840) + lu(k,2846) = lu(k,2846) * lu(k,2840) + lu(k,2847) = lu(k,2847) * lu(k,2840) + lu(k,2848) = lu(k,2848) * lu(k,2840) + lu(k,2849) = lu(k,2849) * lu(k,2840) + lu(k,2850) = lu(k,2850) * lu(k,2840) + lu(k,2851) = lu(k,2851) * lu(k,2840) + lu(k,2852) = lu(k,2852) * lu(k,2840) + lu(k,2853) = lu(k,2853) * lu(k,2840) + lu(k,2854) = lu(k,2854) * lu(k,2840) + lu(k,2913) = lu(k,2913) - lu(k,2841) * lu(k,2912) + lu(k,2915) = lu(k,2915) - lu(k,2842) * lu(k,2912) + lu(k,2916) = lu(k,2916) - lu(k,2843) * lu(k,2912) + lu(k,2917) = lu(k,2917) - lu(k,2844) * lu(k,2912) + lu(k,2918) = lu(k,2918) - lu(k,2845) * lu(k,2912) + lu(k,2919) = lu(k,2919) - lu(k,2846) * lu(k,2912) + lu(k,2920) = lu(k,2920) - lu(k,2847) * lu(k,2912) + lu(k,2921) = lu(k,2921) - lu(k,2848) * lu(k,2912) + lu(k,2922) = lu(k,2922) - lu(k,2849) * lu(k,2912) + lu(k,2923) = lu(k,2923) - lu(k,2850) * lu(k,2912) + lu(k,2924) = lu(k,2924) - lu(k,2851) * lu(k,2912) + lu(k,2926) = lu(k,2926) - lu(k,2852) * lu(k,2912) + lu(k,2927) = lu(k,2927) - lu(k,2853) * lu(k,2912) + lu(k,2928) = lu(k,2928) - lu(k,2854) * lu(k,2912) + lu(k,3103) = lu(k,3103) - lu(k,2841) * lu(k,3102) + lu(k,3105) = lu(k,3105) - lu(k,2842) * lu(k,3102) + lu(k,3106) = lu(k,3106) - lu(k,2843) * lu(k,3102) + lu(k,3107) = lu(k,3107) - lu(k,2844) * lu(k,3102) + lu(k,3108) = lu(k,3108) - lu(k,2845) * lu(k,3102) + lu(k,3109) = lu(k,3109) - lu(k,2846) * lu(k,3102) + lu(k,3110) = lu(k,3110) - lu(k,2847) * lu(k,3102) + lu(k,3111) = lu(k,3111) - lu(k,2848) * lu(k,3102) + lu(k,3114) = lu(k,3114) - lu(k,2849) * lu(k,3102) + lu(k,3115) = lu(k,3115) - lu(k,2850) * lu(k,3102) + lu(k,3116) = lu(k,3116) - lu(k,2851) * lu(k,3102) + lu(k,3118) = lu(k,3118) - lu(k,2852) * lu(k,3102) + lu(k,3119) = lu(k,3119) - lu(k,2853) * lu(k,3102) + lu(k,3120) = lu(k,3120) - lu(k,2854) * lu(k,3102) + lu(k,3362) = lu(k,3362) - lu(k,2841) * lu(k,3361) + lu(k,3364) = lu(k,3364) - lu(k,2842) * lu(k,3361) + lu(k,3365) = lu(k,3365) - lu(k,2843) * lu(k,3361) + lu(k,3366) = lu(k,3366) - lu(k,2844) * lu(k,3361) + lu(k,3367) = lu(k,3367) - lu(k,2845) * lu(k,3361) + lu(k,3368) = lu(k,3368) - lu(k,2846) * lu(k,3361) + lu(k,3369) = lu(k,3369) - lu(k,2847) * lu(k,3361) + lu(k,3370) = lu(k,3370) - lu(k,2848) * lu(k,3361) + lu(k,3373) = lu(k,3373) - lu(k,2849) * lu(k,3361) + lu(k,3374) = lu(k,3374) - lu(k,2850) * lu(k,3361) + lu(k,3375) = lu(k,3375) - lu(k,2851) * lu(k,3361) + lu(k,3377) = lu(k,3377) - lu(k,2852) * lu(k,3361) + lu(k,3378) = lu(k,3378) - lu(k,2853) * lu(k,3361) + lu(k,3379) = lu(k,3379) - lu(k,2854) * lu(k,3361) + lu(k,3455) = lu(k,3455) - lu(k,2841) * lu(k,3454) + lu(k,3457) = lu(k,3457) - lu(k,2842) * lu(k,3454) + lu(k,3458) = lu(k,3458) - lu(k,2843) * lu(k,3454) + lu(k,3459) = lu(k,3459) - lu(k,2844) * lu(k,3454) + lu(k,3460) = lu(k,3460) - lu(k,2845) * lu(k,3454) + lu(k,3461) = lu(k,3461) - lu(k,2846) * lu(k,3454) + lu(k,3462) = lu(k,3462) - lu(k,2847) * lu(k,3454) + lu(k,3463) = lu(k,3463) - lu(k,2848) * lu(k,3454) + lu(k,3466) = lu(k,3466) - lu(k,2849) * lu(k,3454) + lu(k,3467) = lu(k,3467) - lu(k,2850) * lu(k,3454) + lu(k,3468) = lu(k,3468) - lu(k,2851) * lu(k,3454) + lu(k,3470) = lu(k,3470) - lu(k,2852) * lu(k,3454) + lu(k,3471) = lu(k,3471) - lu(k,2853) * lu(k,3454) + lu(k,3472) = lu(k,3472) - lu(k,2854) * lu(k,3454) + lu(k,3599) = lu(k,3599) - lu(k,2841) * lu(k,3598) + lu(k,3601) = lu(k,3601) - lu(k,2842) * lu(k,3598) + lu(k,3602) = lu(k,3602) - lu(k,2843) * lu(k,3598) + lu(k,3603) = lu(k,3603) - lu(k,2844) * lu(k,3598) + lu(k,3604) = lu(k,3604) - lu(k,2845) * lu(k,3598) + lu(k,3605) = lu(k,3605) - lu(k,2846) * lu(k,3598) + lu(k,3606) = lu(k,3606) - lu(k,2847) * lu(k,3598) + lu(k,3607) = lu(k,3607) - lu(k,2848) * lu(k,3598) + lu(k,3610) = lu(k,3610) - lu(k,2849) * lu(k,3598) + lu(k,3611) = lu(k,3611) - lu(k,2850) * lu(k,3598) + lu(k,3612) = lu(k,3612) - lu(k,2851) * lu(k,3598) + lu(k,3614) = lu(k,3614) - lu(k,2852) * lu(k,3598) + lu(k,3615) = lu(k,3615) - lu(k,2853) * lu(k,3598) + lu(k,3616) = lu(k,3616) - lu(k,2854) * lu(k,3598) + lu(k,3651) = lu(k,3651) - lu(k,2841) * lu(k,3650) + lu(k,3653) = lu(k,3653) - lu(k,2842) * lu(k,3650) + lu(k,3654) = lu(k,3654) - lu(k,2843) * lu(k,3650) + lu(k,3655) = lu(k,3655) - lu(k,2844) * lu(k,3650) + lu(k,3656) = lu(k,3656) - lu(k,2845) * lu(k,3650) + lu(k,3657) = lu(k,3657) - lu(k,2846) * lu(k,3650) + lu(k,3658) = lu(k,3658) - lu(k,2847) * lu(k,3650) + lu(k,3659) = lu(k,3659) - lu(k,2848) * lu(k,3650) + lu(k,3662) = lu(k,3662) - lu(k,2849) * lu(k,3650) + lu(k,3663) = lu(k,3663) - lu(k,2850) * lu(k,3650) + lu(k,3664) = lu(k,3664) - lu(k,2851) * lu(k,3650) + lu(k,3666) = lu(k,3666) - lu(k,2852) * lu(k,3650) + lu(k,3667) = lu(k,3667) - lu(k,2853) * lu(k,3650) + lu(k,3668) = lu(k,3668) - lu(k,2854) * lu(k,3650) + lu(k,3753) = lu(k,3753) - lu(k,2841) * lu(k,3752) + lu(k,3755) = lu(k,3755) - lu(k,2842) * lu(k,3752) + lu(k,3756) = lu(k,3756) - lu(k,2843) * lu(k,3752) + lu(k,3757) = lu(k,3757) - lu(k,2844) * lu(k,3752) + lu(k,3758) = lu(k,3758) - lu(k,2845) * lu(k,3752) + lu(k,3759) = lu(k,3759) - lu(k,2846) * lu(k,3752) + lu(k,3760) = lu(k,3760) - lu(k,2847) * lu(k,3752) + lu(k,3761) = lu(k,3761) - lu(k,2848) * lu(k,3752) + lu(k,3764) = lu(k,3764) - lu(k,2849) * lu(k,3752) + lu(k,3765) = lu(k,3765) - lu(k,2850) * lu(k,3752) + lu(k,3766) = lu(k,3766) - lu(k,2851) * lu(k,3752) + lu(k,3768) = lu(k,3768) - lu(k,2852) * lu(k,3752) + lu(k,3769) = lu(k,3769) - lu(k,2853) * lu(k,3752) + lu(k,3770) = lu(k,3770) - lu(k,2854) * lu(k,3752) + lu(k,4085) = lu(k,4085) - lu(k,2841) * lu(k,4084) + lu(k,4087) = lu(k,4087) - lu(k,2842) * lu(k,4084) + lu(k,4088) = lu(k,4088) - lu(k,2843) * lu(k,4084) + lu(k,4089) = lu(k,4089) - lu(k,2844) * lu(k,4084) + lu(k,4090) = lu(k,4090) - lu(k,2845) * lu(k,4084) + lu(k,4091) = lu(k,4091) - lu(k,2846) * lu(k,4084) + lu(k,4092) = lu(k,4092) - lu(k,2847) * lu(k,4084) + lu(k,4093) = lu(k,4093) - lu(k,2848) * lu(k,4084) + lu(k,4096) = lu(k,4096) - lu(k,2849) * lu(k,4084) + lu(k,4097) = lu(k,4097) - lu(k,2850) * lu(k,4084) + lu(k,4098) = lu(k,4098) - lu(k,2851) * lu(k,4084) + lu(k,4100) = lu(k,4100) - lu(k,2852) * lu(k,4084) + lu(k,4101) = lu(k,4101) - lu(k,2853) * lu(k,4084) + lu(k,4102) = lu(k,4102) - lu(k,2854) * lu(k,4084) + lu(k,2913) = 1._r8 / lu(k,2913) + lu(k,2914) = lu(k,2914) * lu(k,2913) + lu(k,2915) = lu(k,2915) * lu(k,2913) + lu(k,2916) = lu(k,2916) * lu(k,2913) + lu(k,2917) = lu(k,2917) * lu(k,2913) + lu(k,2918) = lu(k,2918) * lu(k,2913) + lu(k,2919) = lu(k,2919) * lu(k,2913) + lu(k,2920) = lu(k,2920) * lu(k,2913) + lu(k,2921) = lu(k,2921) * lu(k,2913) + lu(k,2922) = lu(k,2922) * lu(k,2913) + lu(k,2923) = lu(k,2923) * lu(k,2913) + lu(k,2924) = lu(k,2924) * lu(k,2913) + lu(k,2925) = lu(k,2925) * lu(k,2913) + lu(k,2926) = lu(k,2926) * lu(k,2913) + lu(k,2927) = lu(k,2927) * lu(k,2913) + lu(k,2928) = lu(k,2928) * lu(k,2913) + lu(k,3104) = lu(k,3104) - lu(k,2914) * lu(k,3103) + lu(k,3105) = lu(k,3105) - lu(k,2915) * lu(k,3103) + lu(k,3106) = lu(k,3106) - lu(k,2916) * lu(k,3103) + lu(k,3107) = lu(k,3107) - lu(k,2917) * lu(k,3103) + lu(k,3108) = lu(k,3108) - lu(k,2918) * lu(k,3103) + lu(k,3109) = lu(k,3109) - lu(k,2919) * lu(k,3103) + lu(k,3110) = lu(k,3110) - lu(k,2920) * lu(k,3103) + lu(k,3111) = lu(k,3111) - lu(k,2921) * lu(k,3103) + lu(k,3114) = lu(k,3114) - lu(k,2922) * lu(k,3103) + lu(k,3115) = lu(k,3115) - lu(k,2923) * lu(k,3103) + lu(k,3116) = lu(k,3116) - lu(k,2924) * lu(k,3103) + lu(k,3117) = lu(k,3117) - lu(k,2925) * lu(k,3103) + lu(k,3118) = lu(k,3118) - lu(k,2926) * lu(k,3103) + lu(k,3119) = lu(k,3119) - lu(k,2927) * lu(k,3103) + lu(k,3120) = lu(k,3120) - lu(k,2928) * lu(k,3103) + lu(k,3363) = lu(k,3363) - lu(k,2914) * lu(k,3362) + lu(k,3364) = lu(k,3364) - lu(k,2915) * lu(k,3362) + lu(k,3365) = lu(k,3365) - lu(k,2916) * lu(k,3362) + lu(k,3366) = lu(k,3366) - lu(k,2917) * lu(k,3362) + lu(k,3367) = lu(k,3367) - lu(k,2918) * lu(k,3362) + lu(k,3368) = lu(k,3368) - lu(k,2919) * lu(k,3362) + lu(k,3369) = lu(k,3369) - lu(k,2920) * lu(k,3362) + lu(k,3370) = lu(k,3370) - lu(k,2921) * lu(k,3362) + lu(k,3373) = lu(k,3373) - lu(k,2922) * lu(k,3362) + lu(k,3374) = lu(k,3374) - lu(k,2923) * lu(k,3362) + lu(k,3375) = lu(k,3375) - lu(k,2924) * lu(k,3362) + lu(k,3376) = lu(k,3376) - lu(k,2925) * lu(k,3362) + lu(k,3377) = lu(k,3377) - lu(k,2926) * lu(k,3362) + lu(k,3378) = lu(k,3378) - lu(k,2927) * lu(k,3362) + lu(k,3379) = lu(k,3379) - lu(k,2928) * lu(k,3362) + lu(k,3456) = lu(k,3456) - lu(k,2914) * lu(k,3455) + lu(k,3457) = lu(k,3457) - lu(k,2915) * lu(k,3455) + lu(k,3458) = lu(k,3458) - lu(k,2916) * lu(k,3455) + lu(k,3459) = lu(k,3459) - lu(k,2917) * lu(k,3455) + lu(k,3460) = lu(k,3460) - lu(k,2918) * lu(k,3455) + lu(k,3461) = lu(k,3461) - lu(k,2919) * lu(k,3455) + lu(k,3462) = lu(k,3462) - lu(k,2920) * lu(k,3455) + lu(k,3463) = lu(k,3463) - lu(k,2921) * lu(k,3455) + lu(k,3466) = lu(k,3466) - lu(k,2922) * lu(k,3455) + lu(k,3467) = lu(k,3467) - lu(k,2923) * lu(k,3455) + lu(k,3468) = lu(k,3468) - lu(k,2924) * lu(k,3455) + lu(k,3469) = lu(k,3469) - lu(k,2925) * lu(k,3455) + lu(k,3470) = lu(k,3470) - lu(k,2926) * lu(k,3455) + lu(k,3471) = lu(k,3471) - lu(k,2927) * lu(k,3455) + lu(k,3472) = lu(k,3472) - lu(k,2928) * lu(k,3455) + lu(k,3600) = lu(k,3600) - lu(k,2914) * lu(k,3599) + lu(k,3601) = lu(k,3601) - lu(k,2915) * lu(k,3599) + lu(k,3602) = lu(k,3602) - lu(k,2916) * lu(k,3599) + lu(k,3603) = lu(k,3603) - lu(k,2917) * lu(k,3599) + lu(k,3604) = lu(k,3604) - lu(k,2918) * lu(k,3599) + lu(k,3605) = lu(k,3605) - lu(k,2919) * lu(k,3599) + lu(k,3606) = lu(k,3606) - lu(k,2920) * lu(k,3599) + lu(k,3607) = lu(k,3607) - lu(k,2921) * lu(k,3599) + lu(k,3610) = lu(k,3610) - lu(k,2922) * lu(k,3599) + lu(k,3611) = lu(k,3611) - lu(k,2923) * lu(k,3599) + lu(k,3612) = lu(k,3612) - lu(k,2924) * lu(k,3599) + lu(k,3613) = lu(k,3613) - lu(k,2925) * lu(k,3599) + lu(k,3614) = lu(k,3614) - lu(k,2926) * lu(k,3599) + lu(k,3615) = lu(k,3615) - lu(k,2927) * lu(k,3599) + lu(k,3616) = lu(k,3616) - lu(k,2928) * lu(k,3599) + lu(k,3652) = lu(k,3652) - lu(k,2914) * lu(k,3651) + lu(k,3653) = lu(k,3653) - lu(k,2915) * lu(k,3651) + lu(k,3654) = lu(k,3654) - lu(k,2916) * lu(k,3651) + lu(k,3655) = lu(k,3655) - lu(k,2917) * lu(k,3651) + lu(k,3656) = lu(k,3656) - lu(k,2918) * lu(k,3651) + lu(k,3657) = lu(k,3657) - lu(k,2919) * lu(k,3651) + lu(k,3658) = lu(k,3658) - lu(k,2920) * lu(k,3651) + lu(k,3659) = lu(k,3659) - lu(k,2921) * lu(k,3651) + lu(k,3662) = lu(k,3662) - lu(k,2922) * lu(k,3651) + lu(k,3663) = lu(k,3663) - lu(k,2923) * lu(k,3651) + lu(k,3664) = lu(k,3664) - lu(k,2924) * lu(k,3651) + lu(k,3665) = lu(k,3665) - lu(k,2925) * lu(k,3651) + lu(k,3666) = lu(k,3666) - lu(k,2926) * lu(k,3651) + lu(k,3667) = lu(k,3667) - lu(k,2927) * lu(k,3651) + lu(k,3668) = lu(k,3668) - lu(k,2928) * lu(k,3651) + lu(k,3754) = lu(k,3754) - lu(k,2914) * lu(k,3753) + lu(k,3755) = lu(k,3755) - lu(k,2915) * lu(k,3753) + lu(k,3756) = lu(k,3756) - lu(k,2916) * lu(k,3753) + lu(k,3757) = lu(k,3757) - lu(k,2917) * lu(k,3753) + lu(k,3758) = lu(k,3758) - lu(k,2918) * lu(k,3753) + lu(k,3759) = lu(k,3759) - lu(k,2919) * lu(k,3753) + lu(k,3760) = lu(k,3760) - lu(k,2920) * lu(k,3753) + lu(k,3761) = lu(k,3761) - lu(k,2921) * lu(k,3753) + lu(k,3764) = lu(k,3764) - lu(k,2922) * lu(k,3753) + lu(k,3765) = lu(k,3765) - lu(k,2923) * lu(k,3753) + lu(k,3766) = lu(k,3766) - lu(k,2924) * lu(k,3753) + lu(k,3767) = lu(k,3767) - lu(k,2925) * lu(k,3753) + lu(k,3768) = lu(k,3768) - lu(k,2926) * lu(k,3753) + lu(k,3769) = lu(k,3769) - lu(k,2927) * lu(k,3753) + lu(k,3770) = lu(k,3770) - lu(k,2928) * lu(k,3753) + lu(k,3836) = lu(k,3836) - lu(k,2914) * lu(k,3835) + lu(k,3837) = lu(k,3837) - lu(k,2915) * lu(k,3835) + lu(k,3838) = lu(k,3838) - lu(k,2916) * lu(k,3835) + lu(k,3839) = lu(k,3839) - lu(k,2917) * lu(k,3835) + lu(k,3840) = lu(k,3840) - lu(k,2918) * lu(k,3835) + lu(k,3841) = lu(k,3841) - lu(k,2919) * lu(k,3835) + lu(k,3842) = lu(k,3842) - lu(k,2920) * lu(k,3835) + lu(k,3843) = lu(k,3843) - lu(k,2921) * lu(k,3835) + lu(k,3846) = lu(k,3846) - lu(k,2922) * lu(k,3835) + lu(k,3847) = lu(k,3847) - lu(k,2923) * lu(k,3835) + lu(k,3848) = lu(k,3848) - lu(k,2924) * lu(k,3835) + lu(k,3849) = lu(k,3849) - lu(k,2925) * lu(k,3835) + lu(k,3850) = lu(k,3850) - lu(k,2926) * lu(k,3835) + lu(k,3851) = lu(k,3851) - lu(k,2927) * lu(k,3835) + lu(k,3852) = lu(k,3852) - lu(k,2928) * lu(k,3835) + lu(k,4086) = lu(k,4086) - lu(k,2914) * lu(k,4085) + lu(k,4087) = lu(k,4087) - lu(k,2915) * lu(k,4085) + lu(k,4088) = lu(k,4088) - lu(k,2916) * lu(k,4085) + lu(k,4089) = lu(k,4089) - lu(k,2917) * lu(k,4085) + lu(k,4090) = lu(k,4090) - lu(k,2918) * lu(k,4085) + lu(k,4091) = lu(k,4091) - lu(k,2919) * lu(k,4085) + lu(k,4092) = lu(k,4092) - lu(k,2920) * lu(k,4085) + lu(k,4093) = lu(k,4093) - lu(k,2921) * lu(k,4085) + lu(k,4096) = lu(k,4096) - lu(k,2922) * lu(k,4085) + lu(k,4097) = lu(k,4097) - lu(k,2923) * lu(k,4085) + lu(k,4098) = lu(k,4098) - lu(k,2924) * lu(k,4085) + lu(k,4099) = lu(k,4099) - lu(k,2925) * lu(k,4085) + lu(k,4100) = lu(k,4100) - lu(k,2926) * lu(k,4085) + lu(k,4101) = lu(k,4101) - lu(k,2927) * lu(k,4085) + lu(k,4102) = lu(k,4102) - lu(k,2928) * lu(k,4085) + lu(k,2931) = 1._r8 / lu(k,2931) + lu(k,2932) = lu(k,2932) * lu(k,2931) + lu(k,2933) = lu(k,2933) * lu(k,2931) + lu(k,2934) = lu(k,2934) * lu(k,2931) + lu(k,2935) = lu(k,2935) * lu(k,2931) + lu(k,2936) = lu(k,2936) * lu(k,2931) + lu(k,2937) = lu(k,2937) * lu(k,2931) + lu(k,2938) = lu(k,2938) * lu(k,2931) + lu(k,2939) = lu(k,2939) * lu(k,2931) + lu(k,2940) = lu(k,2940) * lu(k,2931) + lu(k,2941) = lu(k,2941) * lu(k,2931) + lu(k,2942) = lu(k,2942) * lu(k,2931) + lu(k,2943) = lu(k,2943) * lu(k,2931) + lu(k,2949) = lu(k,2949) - lu(k,2932) * lu(k,2948) + lu(k,2950) = lu(k,2950) - lu(k,2933) * lu(k,2948) + lu(k,2951) = lu(k,2951) - lu(k,2934) * lu(k,2948) + lu(k,2952) = lu(k,2952) - lu(k,2935) * lu(k,2948) + lu(k,2953) = lu(k,2953) - lu(k,2936) * lu(k,2948) + lu(k,2954) = lu(k,2954) - lu(k,2937) * lu(k,2948) + lu(k,2955) = lu(k,2955) - lu(k,2938) * lu(k,2948) + lu(k,2957) = - lu(k,2939) * lu(k,2948) + lu(k,2958) = lu(k,2958) - lu(k,2940) * lu(k,2948) + lu(k,2959) = lu(k,2959) - lu(k,2941) * lu(k,2948) + lu(k,2960) = lu(k,2960) - lu(k,2942) * lu(k,2948) + lu(k,2961) = lu(k,2961) - lu(k,2943) * lu(k,2948) + lu(k,3105) = lu(k,3105) - lu(k,2932) * lu(k,3104) + lu(k,3107) = lu(k,3107) - lu(k,2933) * lu(k,3104) + lu(k,3108) = lu(k,3108) - lu(k,2934) * lu(k,3104) + lu(k,3109) = lu(k,3109) - lu(k,2935) * lu(k,3104) + lu(k,3110) = lu(k,3110) - lu(k,2936) * lu(k,3104) + lu(k,3111) = lu(k,3111) - lu(k,2937) * lu(k,3104) + lu(k,3114) = lu(k,3114) - lu(k,2938) * lu(k,3104) + lu(k,3116) = lu(k,3116) - lu(k,2939) * lu(k,3104) + lu(k,3117) = lu(k,3117) - lu(k,2940) * lu(k,3104) + lu(k,3118) = lu(k,3118) - lu(k,2941) * lu(k,3104) + lu(k,3119) = lu(k,3119) - lu(k,2942) * lu(k,3104) + lu(k,3120) = lu(k,3120) - lu(k,2943) * lu(k,3104) + lu(k,3128) = lu(k,3128) - lu(k,2932) * lu(k,3127) + lu(k,3129) = lu(k,3129) - lu(k,2933) * lu(k,3127) + lu(k,3130) = lu(k,3130) - lu(k,2934) * lu(k,3127) + lu(k,3131) = lu(k,3131) - lu(k,2935) * lu(k,3127) + lu(k,3132) = lu(k,3132) - lu(k,2936) * lu(k,3127) + lu(k,3133) = - lu(k,2937) * lu(k,3127) + lu(k,3136) = lu(k,3136) - lu(k,2938) * lu(k,3127) + lu(k,3138) = lu(k,3138) - lu(k,2939) * lu(k,3127) + lu(k,3139) = lu(k,3139) - lu(k,2940) * lu(k,3127) + lu(k,3140) = lu(k,3140) - lu(k,2941) * lu(k,3127) + lu(k,3141) = lu(k,3141) - lu(k,2942) * lu(k,3127) + lu(k,3142) = lu(k,3142) - lu(k,2943) * lu(k,3127) + lu(k,3158) = lu(k,3158) - lu(k,2932) * lu(k,3157) + lu(k,3160) = lu(k,3160) - lu(k,2933) * lu(k,3157) + lu(k,3161) = lu(k,3161) - lu(k,2934) * lu(k,3157) + lu(k,3162) = lu(k,3162) - lu(k,2935) * lu(k,3157) + lu(k,3163) = lu(k,3163) - lu(k,2936) * lu(k,3157) + lu(k,3164) = lu(k,3164) - lu(k,2937) * lu(k,3157) + lu(k,3167) = lu(k,3167) - lu(k,2938) * lu(k,3157) + lu(k,3169) = lu(k,3169) - lu(k,2939) * lu(k,3157) + lu(k,3170) = lu(k,3170) - lu(k,2940) * lu(k,3157) + lu(k,3171) = lu(k,3171) - lu(k,2941) * lu(k,3157) + lu(k,3172) = lu(k,3172) - lu(k,2942) * lu(k,3157) + lu(k,3173) = lu(k,3173) - lu(k,2943) * lu(k,3157) + lu(k,3184) = lu(k,3184) - lu(k,2932) * lu(k,3183) + lu(k,3186) = lu(k,3186) - lu(k,2933) * lu(k,3183) + lu(k,3187) = lu(k,3187) - lu(k,2934) * lu(k,3183) + lu(k,3188) = lu(k,3188) - lu(k,2935) * lu(k,3183) + lu(k,3189) = lu(k,3189) - lu(k,2936) * lu(k,3183) + lu(k,3190) = lu(k,3190) - lu(k,2937) * lu(k,3183) + lu(k,3193) = lu(k,3193) - lu(k,2938) * lu(k,3183) + lu(k,3195) = lu(k,3195) - lu(k,2939) * lu(k,3183) + lu(k,3196) = lu(k,3196) - lu(k,2940) * lu(k,3183) + lu(k,3197) = lu(k,3197) - lu(k,2941) * lu(k,3183) + lu(k,3198) = lu(k,3198) - lu(k,2942) * lu(k,3183) + lu(k,3199) = lu(k,3199) - lu(k,2943) * lu(k,3183) + lu(k,3364) = lu(k,3364) - lu(k,2932) * lu(k,3363) + lu(k,3366) = lu(k,3366) - lu(k,2933) * lu(k,3363) + lu(k,3367) = lu(k,3367) - lu(k,2934) * lu(k,3363) + lu(k,3368) = lu(k,3368) - lu(k,2935) * lu(k,3363) + lu(k,3369) = lu(k,3369) - lu(k,2936) * lu(k,3363) + lu(k,3370) = lu(k,3370) - lu(k,2937) * lu(k,3363) + lu(k,3373) = lu(k,3373) - lu(k,2938) * lu(k,3363) + lu(k,3375) = lu(k,3375) - lu(k,2939) * lu(k,3363) + lu(k,3376) = lu(k,3376) - lu(k,2940) * lu(k,3363) + lu(k,3377) = lu(k,3377) - lu(k,2941) * lu(k,3363) + lu(k,3378) = lu(k,3378) - lu(k,2942) * lu(k,3363) + lu(k,3379) = lu(k,3379) - lu(k,2943) * lu(k,3363) + lu(k,3457) = lu(k,3457) - lu(k,2932) * lu(k,3456) + lu(k,3459) = lu(k,3459) - lu(k,2933) * lu(k,3456) + lu(k,3460) = lu(k,3460) - lu(k,2934) * lu(k,3456) + lu(k,3461) = lu(k,3461) - lu(k,2935) * lu(k,3456) + lu(k,3462) = lu(k,3462) - lu(k,2936) * lu(k,3456) + lu(k,3463) = lu(k,3463) - lu(k,2937) * lu(k,3456) + lu(k,3466) = lu(k,3466) - lu(k,2938) * lu(k,3456) + lu(k,3468) = lu(k,3468) - lu(k,2939) * lu(k,3456) + lu(k,3469) = lu(k,3469) - lu(k,2940) * lu(k,3456) + lu(k,3470) = lu(k,3470) - lu(k,2941) * lu(k,3456) + lu(k,3471) = lu(k,3471) - lu(k,2942) * lu(k,3456) + lu(k,3472) = lu(k,3472) - lu(k,2943) * lu(k,3456) + lu(k,3481) = lu(k,3481) - lu(k,2932) * lu(k,3480) + lu(k,3483) = lu(k,3483) - lu(k,2933) * lu(k,3480) + lu(k,3484) = lu(k,3484) - lu(k,2934) * lu(k,3480) + lu(k,3485) = lu(k,3485) - lu(k,2935) * lu(k,3480) + lu(k,3486) = lu(k,3486) - lu(k,2936) * lu(k,3480) + lu(k,3487) = - lu(k,2937) * lu(k,3480) + lu(k,3490) = lu(k,3490) - lu(k,2938) * lu(k,3480) + lu(k,3492) = lu(k,3492) - lu(k,2939) * lu(k,3480) + lu(k,3493) = lu(k,3493) - lu(k,2940) * lu(k,3480) + lu(k,3494) = lu(k,3494) - lu(k,2941) * lu(k,3480) + lu(k,3495) = lu(k,3495) - lu(k,2942) * lu(k,3480) + lu(k,3496) = lu(k,3496) - lu(k,2943) * lu(k,3480) + lu(k,3507) = lu(k,3507) - lu(k,2932) * lu(k,3506) + lu(k,3509) = lu(k,3509) - lu(k,2933) * lu(k,3506) + lu(k,3510) = lu(k,3510) - lu(k,2934) * lu(k,3506) + lu(k,3511) = lu(k,3511) - lu(k,2935) * lu(k,3506) + lu(k,3512) = lu(k,3512) - lu(k,2936) * lu(k,3506) + lu(k,3513) = lu(k,3513) - lu(k,2937) * lu(k,3506) + lu(k,3516) = lu(k,3516) - lu(k,2938) * lu(k,3506) + lu(k,3518) = lu(k,3518) - lu(k,2939) * lu(k,3506) + lu(k,3519) = lu(k,3519) - lu(k,2940) * lu(k,3506) + lu(k,3520) = lu(k,3520) - lu(k,2941) * lu(k,3506) + lu(k,3521) = lu(k,3521) - lu(k,2942) * lu(k,3506) + lu(k,3522) = lu(k,3522) - lu(k,2943) * lu(k,3506) + lu(k,3601) = lu(k,3601) - lu(k,2932) * lu(k,3600) + lu(k,3603) = lu(k,3603) - lu(k,2933) * lu(k,3600) + lu(k,3604) = lu(k,3604) - lu(k,2934) * lu(k,3600) + lu(k,3605) = lu(k,3605) - lu(k,2935) * lu(k,3600) + lu(k,3606) = lu(k,3606) - lu(k,2936) * lu(k,3600) + lu(k,3607) = lu(k,3607) - lu(k,2937) * lu(k,3600) + lu(k,3610) = lu(k,3610) - lu(k,2938) * lu(k,3600) + lu(k,3612) = lu(k,3612) - lu(k,2939) * lu(k,3600) + lu(k,3613) = lu(k,3613) - lu(k,2940) * lu(k,3600) + lu(k,3614) = lu(k,3614) - lu(k,2941) * lu(k,3600) + lu(k,3615) = lu(k,3615) - lu(k,2942) * lu(k,3600) + lu(k,3616) = lu(k,3616) - lu(k,2943) * lu(k,3600) + lu(k,3653) = lu(k,3653) - lu(k,2932) * lu(k,3652) + lu(k,3655) = lu(k,3655) - lu(k,2933) * lu(k,3652) + lu(k,3656) = lu(k,3656) - lu(k,2934) * lu(k,3652) + lu(k,3657) = lu(k,3657) - lu(k,2935) * lu(k,3652) + lu(k,3658) = lu(k,3658) - lu(k,2936) * lu(k,3652) + lu(k,3659) = lu(k,3659) - lu(k,2937) * lu(k,3652) + lu(k,3662) = lu(k,3662) - lu(k,2938) * lu(k,3652) + lu(k,3664) = lu(k,3664) - lu(k,2939) * lu(k,3652) + lu(k,3665) = lu(k,3665) - lu(k,2940) * lu(k,3652) + lu(k,3666) = lu(k,3666) - lu(k,2941) * lu(k,3652) + lu(k,3667) = lu(k,3667) - lu(k,2942) * lu(k,3652) + lu(k,3668) = lu(k,3668) - lu(k,2943) * lu(k,3652) + lu(k,3755) = lu(k,3755) - lu(k,2932) * lu(k,3754) + lu(k,3757) = lu(k,3757) - lu(k,2933) * lu(k,3754) + lu(k,3758) = lu(k,3758) - lu(k,2934) * lu(k,3754) + lu(k,3759) = lu(k,3759) - lu(k,2935) * lu(k,3754) + lu(k,3760) = lu(k,3760) - lu(k,2936) * lu(k,3754) + lu(k,3761) = lu(k,3761) - lu(k,2937) * lu(k,3754) + lu(k,3764) = lu(k,3764) - lu(k,2938) * lu(k,3754) + lu(k,3766) = lu(k,3766) - lu(k,2939) * lu(k,3754) + lu(k,3767) = lu(k,3767) - lu(k,2940) * lu(k,3754) + lu(k,3768) = lu(k,3768) - lu(k,2941) * lu(k,3754) + lu(k,3769) = lu(k,3769) - lu(k,2942) * lu(k,3754) + lu(k,3770) = lu(k,3770) - lu(k,2943) * lu(k,3754) + lu(k,3796) = lu(k,3796) - lu(k,2932) * lu(k,3795) + lu(k,3798) = lu(k,3798) - lu(k,2933) * lu(k,3795) + lu(k,3799) = lu(k,3799) - lu(k,2934) * lu(k,3795) + lu(k,3800) = lu(k,3800) - lu(k,2935) * lu(k,3795) + lu(k,3801) = lu(k,3801) - lu(k,2936) * lu(k,3795) + lu(k,3802) = lu(k,3802) - lu(k,2937) * lu(k,3795) + lu(k,3805) = lu(k,3805) - lu(k,2938) * lu(k,3795) + lu(k,3807) = lu(k,3807) - lu(k,2939) * lu(k,3795) + lu(k,3808) = lu(k,3808) - lu(k,2940) * lu(k,3795) + lu(k,3809) = lu(k,3809) - lu(k,2941) * lu(k,3795) + lu(k,3810) = lu(k,3810) - lu(k,2942) * lu(k,3795) + lu(k,3811) = lu(k,3811) - lu(k,2943) * lu(k,3795) + lu(k,3837) = lu(k,3837) - lu(k,2932) * lu(k,3836) + lu(k,3839) = lu(k,3839) - lu(k,2933) * lu(k,3836) + lu(k,3840) = lu(k,3840) - lu(k,2934) * lu(k,3836) + lu(k,3841) = lu(k,3841) - lu(k,2935) * lu(k,3836) + lu(k,3842) = lu(k,3842) - lu(k,2936) * lu(k,3836) + lu(k,3843) = lu(k,3843) - lu(k,2937) * lu(k,3836) + lu(k,3846) = lu(k,3846) - lu(k,2938) * lu(k,3836) + lu(k,3848) = lu(k,3848) - lu(k,2939) * lu(k,3836) + lu(k,3849) = lu(k,3849) - lu(k,2940) * lu(k,3836) + lu(k,3850) = lu(k,3850) - lu(k,2941) * lu(k,3836) + lu(k,3851) = lu(k,3851) - lu(k,2942) * lu(k,3836) + lu(k,3852) = lu(k,3852) - lu(k,2943) * lu(k,3836) + lu(k,4087) = lu(k,4087) - lu(k,2932) * lu(k,4086) + lu(k,4089) = lu(k,4089) - lu(k,2933) * lu(k,4086) + lu(k,4090) = lu(k,4090) - lu(k,2934) * lu(k,4086) + lu(k,4091) = lu(k,4091) - lu(k,2935) * lu(k,4086) + lu(k,4092) = lu(k,4092) - lu(k,2936) * lu(k,4086) + lu(k,4093) = lu(k,4093) - lu(k,2937) * lu(k,4086) + lu(k,4096) = lu(k,4096) - lu(k,2938) * lu(k,4086) + lu(k,4098) = lu(k,4098) - lu(k,2939) * lu(k,4086) + lu(k,4099) = lu(k,4099) - lu(k,2940) * lu(k,4086) + lu(k,4100) = lu(k,4100) - lu(k,2941) * lu(k,4086) + lu(k,4101) = lu(k,4101) - lu(k,2942) * lu(k,4086) + lu(k,4102) = lu(k,4102) - lu(k,2943) * lu(k,4086) + lu(k,4113) = lu(k,4113) - lu(k,2932) * lu(k,4112) + lu(k,4115) = lu(k,4115) - lu(k,2933) * lu(k,4112) + lu(k,4116) = lu(k,4116) - lu(k,2934) * lu(k,4112) + lu(k,4117) = lu(k,4117) - lu(k,2935) * lu(k,4112) + lu(k,4118) = lu(k,4118) - lu(k,2936) * lu(k,4112) + lu(k,4119) = lu(k,4119) - lu(k,2937) * lu(k,4112) + lu(k,4122) = lu(k,4122) - lu(k,2938) * lu(k,4112) + lu(k,4124) = lu(k,4124) - lu(k,2939) * lu(k,4112) + lu(k,4125) = lu(k,4125) - lu(k,2940) * lu(k,4112) + lu(k,4126) = lu(k,4126) - lu(k,2941) * lu(k,4112) + lu(k,4127) = lu(k,4127) - lu(k,2942) * lu(k,4112) + lu(k,4128) = lu(k,4128) - lu(k,2943) * lu(k,4112) + lu(k,2949) = 1._r8 / lu(k,2949) + lu(k,2950) = lu(k,2950) * lu(k,2949) + lu(k,2951) = lu(k,2951) * lu(k,2949) + lu(k,2952) = lu(k,2952) * lu(k,2949) + lu(k,2953) = lu(k,2953) * lu(k,2949) + lu(k,2954) = lu(k,2954) * lu(k,2949) + lu(k,2955) = lu(k,2955) * lu(k,2949) + lu(k,2956) = lu(k,2956) * lu(k,2949) + lu(k,2957) = lu(k,2957) * lu(k,2949) + lu(k,2958) = lu(k,2958) * lu(k,2949) + lu(k,2959) = lu(k,2959) * lu(k,2949) + lu(k,2960) = lu(k,2960) * lu(k,2949) + lu(k,2961) = lu(k,2961) * lu(k,2949) + lu(k,3107) = lu(k,3107) - lu(k,2950) * lu(k,3105) + lu(k,3108) = lu(k,3108) - lu(k,2951) * lu(k,3105) + lu(k,3109) = lu(k,3109) - lu(k,2952) * lu(k,3105) + lu(k,3110) = lu(k,3110) - lu(k,2953) * lu(k,3105) + lu(k,3111) = lu(k,3111) - lu(k,2954) * lu(k,3105) + lu(k,3114) = lu(k,3114) - lu(k,2955) * lu(k,3105) + lu(k,3115) = lu(k,3115) - lu(k,2956) * lu(k,3105) + lu(k,3116) = lu(k,3116) - lu(k,2957) * lu(k,3105) + lu(k,3117) = lu(k,3117) - lu(k,2958) * lu(k,3105) + lu(k,3118) = lu(k,3118) - lu(k,2959) * lu(k,3105) + lu(k,3119) = lu(k,3119) - lu(k,2960) * lu(k,3105) + lu(k,3120) = lu(k,3120) - lu(k,2961) * lu(k,3105) + lu(k,3129) = lu(k,3129) - lu(k,2950) * lu(k,3128) + lu(k,3130) = lu(k,3130) - lu(k,2951) * lu(k,3128) + lu(k,3131) = lu(k,3131) - lu(k,2952) * lu(k,3128) + lu(k,3132) = lu(k,3132) - lu(k,2953) * lu(k,3128) + lu(k,3133) = lu(k,3133) - lu(k,2954) * lu(k,3128) + lu(k,3136) = lu(k,3136) - lu(k,2955) * lu(k,3128) + lu(k,3137) = lu(k,3137) - lu(k,2956) * lu(k,3128) + lu(k,3138) = lu(k,3138) - lu(k,2957) * lu(k,3128) + lu(k,3139) = lu(k,3139) - lu(k,2958) * lu(k,3128) + lu(k,3140) = lu(k,3140) - lu(k,2959) * lu(k,3128) + lu(k,3141) = lu(k,3141) - lu(k,2960) * lu(k,3128) + lu(k,3142) = lu(k,3142) - lu(k,2961) * lu(k,3128) + lu(k,3160) = lu(k,3160) - lu(k,2950) * lu(k,3158) + lu(k,3161) = lu(k,3161) - lu(k,2951) * lu(k,3158) + lu(k,3162) = lu(k,3162) - lu(k,2952) * lu(k,3158) + lu(k,3163) = lu(k,3163) - lu(k,2953) * lu(k,3158) + lu(k,3164) = lu(k,3164) - lu(k,2954) * lu(k,3158) + lu(k,3167) = lu(k,3167) - lu(k,2955) * lu(k,3158) + lu(k,3168) = lu(k,3168) - lu(k,2956) * lu(k,3158) + lu(k,3169) = lu(k,3169) - lu(k,2957) * lu(k,3158) + lu(k,3170) = lu(k,3170) - lu(k,2958) * lu(k,3158) + lu(k,3171) = lu(k,3171) - lu(k,2959) * lu(k,3158) + lu(k,3172) = lu(k,3172) - lu(k,2960) * lu(k,3158) + lu(k,3173) = lu(k,3173) - lu(k,2961) * lu(k,3158) + lu(k,3186) = lu(k,3186) - lu(k,2950) * lu(k,3184) + lu(k,3187) = lu(k,3187) - lu(k,2951) * lu(k,3184) + lu(k,3188) = lu(k,3188) - lu(k,2952) * lu(k,3184) + lu(k,3189) = lu(k,3189) - lu(k,2953) * lu(k,3184) + lu(k,3190) = lu(k,3190) - lu(k,2954) * lu(k,3184) + lu(k,3193) = lu(k,3193) - lu(k,2955) * lu(k,3184) + lu(k,3194) = lu(k,3194) - lu(k,2956) * lu(k,3184) + lu(k,3195) = lu(k,3195) - lu(k,2957) * lu(k,3184) + lu(k,3196) = lu(k,3196) - lu(k,2958) * lu(k,3184) + lu(k,3197) = lu(k,3197) - lu(k,2959) * lu(k,3184) + lu(k,3198) = lu(k,3198) - lu(k,2960) * lu(k,3184) + lu(k,3199) = lu(k,3199) - lu(k,2961) * lu(k,3184) + lu(k,3366) = lu(k,3366) - lu(k,2950) * lu(k,3364) + lu(k,3367) = lu(k,3367) - lu(k,2951) * lu(k,3364) + lu(k,3368) = lu(k,3368) - lu(k,2952) * lu(k,3364) + lu(k,3369) = lu(k,3369) - lu(k,2953) * lu(k,3364) + lu(k,3370) = lu(k,3370) - lu(k,2954) * lu(k,3364) + lu(k,3373) = lu(k,3373) - lu(k,2955) * lu(k,3364) + lu(k,3374) = lu(k,3374) - lu(k,2956) * lu(k,3364) + lu(k,3375) = lu(k,3375) - lu(k,2957) * lu(k,3364) + lu(k,3376) = lu(k,3376) - lu(k,2958) * lu(k,3364) + lu(k,3377) = lu(k,3377) - lu(k,2959) * lu(k,3364) + lu(k,3378) = lu(k,3378) - lu(k,2960) * lu(k,3364) + lu(k,3379) = lu(k,3379) - lu(k,2961) * lu(k,3364) + lu(k,3459) = lu(k,3459) - lu(k,2950) * lu(k,3457) + lu(k,3460) = lu(k,3460) - lu(k,2951) * lu(k,3457) + lu(k,3461) = lu(k,3461) - lu(k,2952) * lu(k,3457) + lu(k,3462) = lu(k,3462) - lu(k,2953) * lu(k,3457) + lu(k,3463) = lu(k,3463) - lu(k,2954) * lu(k,3457) + lu(k,3466) = lu(k,3466) - lu(k,2955) * lu(k,3457) + lu(k,3467) = lu(k,3467) - lu(k,2956) * lu(k,3457) + lu(k,3468) = lu(k,3468) - lu(k,2957) * lu(k,3457) + lu(k,3469) = lu(k,3469) - lu(k,2958) * lu(k,3457) + lu(k,3470) = lu(k,3470) - lu(k,2959) * lu(k,3457) + lu(k,3471) = lu(k,3471) - lu(k,2960) * lu(k,3457) + lu(k,3472) = lu(k,3472) - lu(k,2961) * lu(k,3457) + lu(k,3483) = lu(k,3483) - lu(k,2950) * lu(k,3481) + lu(k,3484) = lu(k,3484) - lu(k,2951) * lu(k,3481) + lu(k,3485) = lu(k,3485) - lu(k,2952) * lu(k,3481) + lu(k,3486) = lu(k,3486) - lu(k,2953) * lu(k,3481) + lu(k,3487) = lu(k,3487) - lu(k,2954) * lu(k,3481) + lu(k,3490) = lu(k,3490) - lu(k,2955) * lu(k,3481) + lu(k,3491) = lu(k,3491) - lu(k,2956) * lu(k,3481) + lu(k,3492) = lu(k,3492) - lu(k,2957) * lu(k,3481) + lu(k,3493) = lu(k,3493) - lu(k,2958) * lu(k,3481) + lu(k,3494) = lu(k,3494) - lu(k,2959) * lu(k,3481) + lu(k,3495) = lu(k,3495) - lu(k,2960) * lu(k,3481) + lu(k,3496) = lu(k,3496) - lu(k,2961) * lu(k,3481) + lu(k,3509) = lu(k,3509) - lu(k,2950) * lu(k,3507) + lu(k,3510) = lu(k,3510) - lu(k,2951) * lu(k,3507) + lu(k,3511) = lu(k,3511) - lu(k,2952) * lu(k,3507) + lu(k,3512) = lu(k,3512) - lu(k,2953) * lu(k,3507) + lu(k,3513) = lu(k,3513) - lu(k,2954) * lu(k,3507) + lu(k,3516) = lu(k,3516) - lu(k,2955) * lu(k,3507) + lu(k,3517) = lu(k,3517) - lu(k,2956) * lu(k,3507) + lu(k,3518) = lu(k,3518) - lu(k,2957) * lu(k,3507) + lu(k,3519) = lu(k,3519) - lu(k,2958) * lu(k,3507) + lu(k,3520) = lu(k,3520) - lu(k,2959) * lu(k,3507) + lu(k,3521) = lu(k,3521) - lu(k,2960) * lu(k,3507) + lu(k,3522) = lu(k,3522) - lu(k,2961) * lu(k,3507) + lu(k,3603) = lu(k,3603) - lu(k,2950) * lu(k,3601) + lu(k,3604) = lu(k,3604) - lu(k,2951) * lu(k,3601) + lu(k,3605) = lu(k,3605) - lu(k,2952) * lu(k,3601) + lu(k,3606) = lu(k,3606) - lu(k,2953) * lu(k,3601) + lu(k,3607) = lu(k,3607) - lu(k,2954) * lu(k,3601) + lu(k,3610) = lu(k,3610) - lu(k,2955) * lu(k,3601) + lu(k,3611) = lu(k,3611) - lu(k,2956) * lu(k,3601) + lu(k,3612) = lu(k,3612) - lu(k,2957) * lu(k,3601) + lu(k,3613) = lu(k,3613) - lu(k,2958) * lu(k,3601) + lu(k,3614) = lu(k,3614) - lu(k,2959) * lu(k,3601) + lu(k,3615) = lu(k,3615) - lu(k,2960) * lu(k,3601) + lu(k,3616) = lu(k,3616) - lu(k,2961) * lu(k,3601) + lu(k,3655) = lu(k,3655) - lu(k,2950) * lu(k,3653) + lu(k,3656) = lu(k,3656) - lu(k,2951) * lu(k,3653) + lu(k,3657) = lu(k,3657) - lu(k,2952) * lu(k,3653) + lu(k,3658) = lu(k,3658) - lu(k,2953) * lu(k,3653) + lu(k,3659) = lu(k,3659) - lu(k,2954) * lu(k,3653) + lu(k,3662) = lu(k,3662) - lu(k,2955) * lu(k,3653) + lu(k,3663) = lu(k,3663) - lu(k,2956) * lu(k,3653) + lu(k,3664) = lu(k,3664) - lu(k,2957) * lu(k,3653) + lu(k,3665) = lu(k,3665) - lu(k,2958) * lu(k,3653) + lu(k,3666) = lu(k,3666) - lu(k,2959) * lu(k,3653) + lu(k,3667) = lu(k,3667) - lu(k,2960) * lu(k,3653) + lu(k,3668) = lu(k,3668) - lu(k,2961) * lu(k,3653) + lu(k,3757) = lu(k,3757) - lu(k,2950) * lu(k,3755) + lu(k,3758) = lu(k,3758) - lu(k,2951) * lu(k,3755) + lu(k,3759) = lu(k,3759) - lu(k,2952) * lu(k,3755) + lu(k,3760) = lu(k,3760) - lu(k,2953) * lu(k,3755) + lu(k,3761) = lu(k,3761) - lu(k,2954) * lu(k,3755) + lu(k,3764) = lu(k,3764) - lu(k,2955) * lu(k,3755) + lu(k,3765) = lu(k,3765) - lu(k,2956) * lu(k,3755) + lu(k,3766) = lu(k,3766) - lu(k,2957) * lu(k,3755) + lu(k,3767) = lu(k,3767) - lu(k,2958) * lu(k,3755) + lu(k,3768) = lu(k,3768) - lu(k,2959) * lu(k,3755) + lu(k,3769) = lu(k,3769) - lu(k,2960) * lu(k,3755) + lu(k,3770) = lu(k,3770) - lu(k,2961) * lu(k,3755) + lu(k,3798) = lu(k,3798) - lu(k,2950) * lu(k,3796) + lu(k,3799) = lu(k,3799) - lu(k,2951) * lu(k,3796) + lu(k,3800) = lu(k,3800) - lu(k,2952) * lu(k,3796) + lu(k,3801) = lu(k,3801) - lu(k,2953) * lu(k,3796) + lu(k,3802) = lu(k,3802) - lu(k,2954) * lu(k,3796) + lu(k,3805) = lu(k,3805) - lu(k,2955) * lu(k,3796) + lu(k,3806) = - lu(k,2956) * lu(k,3796) + lu(k,3807) = lu(k,3807) - lu(k,2957) * lu(k,3796) + lu(k,3808) = lu(k,3808) - lu(k,2958) * lu(k,3796) + lu(k,3809) = lu(k,3809) - lu(k,2959) * lu(k,3796) + lu(k,3810) = lu(k,3810) - lu(k,2960) * lu(k,3796) + lu(k,3811) = lu(k,3811) - lu(k,2961) * lu(k,3796) + lu(k,3839) = lu(k,3839) - lu(k,2950) * lu(k,3837) + lu(k,3840) = lu(k,3840) - lu(k,2951) * lu(k,3837) + lu(k,3841) = lu(k,3841) - lu(k,2952) * lu(k,3837) + lu(k,3842) = lu(k,3842) - lu(k,2953) * lu(k,3837) + lu(k,3843) = lu(k,3843) - lu(k,2954) * lu(k,3837) + lu(k,3846) = lu(k,3846) - lu(k,2955) * lu(k,3837) + lu(k,3847) = lu(k,3847) - lu(k,2956) * lu(k,3837) + lu(k,3848) = lu(k,3848) - lu(k,2957) * lu(k,3837) + lu(k,3849) = lu(k,3849) - lu(k,2958) * lu(k,3837) + lu(k,3850) = lu(k,3850) - lu(k,2959) * lu(k,3837) + lu(k,3851) = lu(k,3851) - lu(k,2960) * lu(k,3837) + lu(k,3852) = lu(k,3852) - lu(k,2961) * lu(k,3837) + lu(k,4089) = lu(k,4089) - lu(k,2950) * lu(k,4087) + lu(k,4090) = lu(k,4090) - lu(k,2951) * lu(k,4087) + lu(k,4091) = lu(k,4091) - lu(k,2952) * lu(k,4087) + lu(k,4092) = lu(k,4092) - lu(k,2953) * lu(k,4087) + lu(k,4093) = lu(k,4093) - lu(k,2954) * lu(k,4087) + lu(k,4096) = lu(k,4096) - lu(k,2955) * lu(k,4087) + lu(k,4097) = lu(k,4097) - lu(k,2956) * lu(k,4087) + lu(k,4098) = lu(k,4098) - lu(k,2957) * lu(k,4087) + lu(k,4099) = lu(k,4099) - lu(k,2958) * lu(k,4087) + lu(k,4100) = lu(k,4100) - lu(k,2959) * lu(k,4087) + lu(k,4101) = lu(k,4101) - lu(k,2960) * lu(k,4087) + lu(k,4102) = lu(k,4102) - lu(k,2961) * lu(k,4087) + lu(k,4115) = lu(k,4115) - lu(k,2950) * lu(k,4113) + lu(k,4116) = lu(k,4116) - lu(k,2951) * lu(k,4113) + lu(k,4117) = lu(k,4117) - lu(k,2952) * lu(k,4113) + lu(k,4118) = lu(k,4118) - lu(k,2953) * lu(k,4113) + lu(k,4119) = lu(k,4119) - lu(k,2954) * lu(k,4113) + lu(k,4122) = lu(k,4122) - lu(k,2955) * lu(k,4113) + lu(k,4123) = lu(k,4123) - lu(k,2956) * lu(k,4113) + lu(k,4124) = lu(k,4124) - lu(k,2957) * lu(k,4113) + lu(k,4125) = lu(k,4125) - lu(k,2958) * lu(k,4113) + lu(k,4126) = lu(k,4126) - lu(k,2959) * lu(k,4113) + lu(k,4127) = lu(k,4127) - lu(k,2960) * lu(k,4113) + lu(k,4128) = lu(k,4128) - lu(k,2961) * lu(k,4113) + end do + end subroutine lu_fac52 + subroutine lu_fac53( 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,3106) = 1._r8 / lu(k,3106) + lu(k,3107) = lu(k,3107) * lu(k,3106) + lu(k,3108) = lu(k,3108) * lu(k,3106) + lu(k,3109) = lu(k,3109) * lu(k,3106) + lu(k,3110) = lu(k,3110) * lu(k,3106) + lu(k,3111) = lu(k,3111) * lu(k,3106) + lu(k,3112) = lu(k,3112) * lu(k,3106) + lu(k,3113) = lu(k,3113) * lu(k,3106) + lu(k,3114) = lu(k,3114) * lu(k,3106) + lu(k,3115) = lu(k,3115) * lu(k,3106) + lu(k,3116) = lu(k,3116) * lu(k,3106) + lu(k,3117) = lu(k,3117) * lu(k,3106) + lu(k,3118) = lu(k,3118) * lu(k,3106) + lu(k,3119) = lu(k,3119) * lu(k,3106) + lu(k,3120) = lu(k,3120) * lu(k,3106) + lu(k,3160) = lu(k,3160) - lu(k,3107) * lu(k,3159) + lu(k,3161) = lu(k,3161) - lu(k,3108) * lu(k,3159) + lu(k,3162) = lu(k,3162) - lu(k,3109) * lu(k,3159) + lu(k,3163) = lu(k,3163) - lu(k,3110) * lu(k,3159) + lu(k,3164) = lu(k,3164) - lu(k,3111) * lu(k,3159) + lu(k,3165) = lu(k,3165) - lu(k,3112) * lu(k,3159) + lu(k,3166) = lu(k,3166) - lu(k,3113) * lu(k,3159) + lu(k,3167) = lu(k,3167) - lu(k,3114) * lu(k,3159) + lu(k,3168) = lu(k,3168) - lu(k,3115) * lu(k,3159) + lu(k,3169) = lu(k,3169) - lu(k,3116) * lu(k,3159) + lu(k,3170) = lu(k,3170) - lu(k,3117) * lu(k,3159) + lu(k,3171) = lu(k,3171) - lu(k,3118) * lu(k,3159) + lu(k,3172) = lu(k,3172) - lu(k,3119) * lu(k,3159) + lu(k,3173) = lu(k,3173) - lu(k,3120) * lu(k,3159) + lu(k,3186) = lu(k,3186) - lu(k,3107) * lu(k,3185) + lu(k,3187) = lu(k,3187) - lu(k,3108) * lu(k,3185) + lu(k,3188) = lu(k,3188) - lu(k,3109) * lu(k,3185) + lu(k,3189) = lu(k,3189) - lu(k,3110) * lu(k,3185) + lu(k,3190) = lu(k,3190) - lu(k,3111) * lu(k,3185) + lu(k,3191) = lu(k,3191) - lu(k,3112) * lu(k,3185) + lu(k,3192) = - lu(k,3113) * lu(k,3185) + lu(k,3193) = lu(k,3193) - lu(k,3114) * lu(k,3185) + lu(k,3194) = lu(k,3194) - lu(k,3115) * lu(k,3185) + lu(k,3195) = lu(k,3195) - lu(k,3116) * lu(k,3185) + lu(k,3196) = lu(k,3196) - lu(k,3117) * lu(k,3185) + lu(k,3197) = lu(k,3197) - lu(k,3118) * lu(k,3185) + lu(k,3198) = lu(k,3198) - lu(k,3119) * lu(k,3185) + lu(k,3199) = lu(k,3199) - lu(k,3120) * lu(k,3185) + lu(k,3366) = lu(k,3366) - lu(k,3107) * lu(k,3365) + lu(k,3367) = lu(k,3367) - lu(k,3108) * lu(k,3365) + lu(k,3368) = lu(k,3368) - lu(k,3109) * lu(k,3365) + lu(k,3369) = lu(k,3369) - lu(k,3110) * lu(k,3365) + lu(k,3370) = lu(k,3370) - lu(k,3111) * lu(k,3365) + lu(k,3371) = lu(k,3371) - lu(k,3112) * lu(k,3365) + lu(k,3372) = lu(k,3372) - lu(k,3113) * lu(k,3365) + lu(k,3373) = lu(k,3373) - lu(k,3114) * lu(k,3365) + lu(k,3374) = lu(k,3374) - lu(k,3115) * lu(k,3365) + lu(k,3375) = lu(k,3375) - lu(k,3116) * lu(k,3365) + lu(k,3376) = lu(k,3376) - lu(k,3117) * lu(k,3365) + lu(k,3377) = lu(k,3377) - lu(k,3118) * lu(k,3365) + lu(k,3378) = lu(k,3378) - lu(k,3119) * lu(k,3365) + lu(k,3379) = lu(k,3379) - lu(k,3120) * lu(k,3365) + lu(k,3459) = lu(k,3459) - lu(k,3107) * lu(k,3458) + lu(k,3460) = lu(k,3460) - lu(k,3108) * lu(k,3458) + lu(k,3461) = lu(k,3461) - lu(k,3109) * lu(k,3458) + lu(k,3462) = lu(k,3462) - lu(k,3110) * lu(k,3458) + lu(k,3463) = lu(k,3463) - lu(k,3111) * lu(k,3458) + lu(k,3464) = - lu(k,3112) * lu(k,3458) + lu(k,3465) = lu(k,3465) - lu(k,3113) * lu(k,3458) + lu(k,3466) = lu(k,3466) - lu(k,3114) * lu(k,3458) + lu(k,3467) = lu(k,3467) - lu(k,3115) * lu(k,3458) + lu(k,3468) = lu(k,3468) - lu(k,3116) * lu(k,3458) + lu(k,3469) = lu(k,3469) - lu(k,3117) * lu(k,3458) + lu(k,3470) = lu(k,3470) - lu(k,3118) * lu(k,3458) + lu(k,3471) = lu(k,3471) - lu(k,3119) * lu(k,3458) + lu(k,3472) = lu(k,3472) - lu(k,3120) * lu(k,3458) + lu(k,3483) = lu(k,3483) - lu(k,3107) * lu(k,3482) + lu(k,3484) = lu(k,3484) - lu(k,3108) * lu(k,3482) + lu(k,3485) = lu(k,3485) - lu(k,3109) * lu(k,3482) + lu(k,3486) = lu(k,3486) - lu(k,3110) * lu(k,3482) + lu(k,3487) = lu(k,3487) - lu(k,3111) * lu(k,3482) + lu(k,3488) = lu(k,3488) - lu(k,3112) * lu(k,3482) + lu(k,3489) = lu(k,3489) - lu(k,3113) * lu(k,3482) + lu(k,3490) = lu(k,3490) - lu(k,3114) * lu(k,3482) + lu(k,3491) = lu(k,3491) - lu(k,3115) * lu(k,3482) + lu(k,3492) = lu(k,3492) - lu(k,3116) * lu(k,3482) + lu(k,3493) = lu(k,3493) - lu(k,3117) * lu(k,3482) + lu(k,3494) = lu(k,3494) - lu(k,3118) * lu(k,3482) + lu(k,3495) = lu(k,3495) - lu(k,3119) * lu(k,3482) + lu(k,3496) = lu(k,3496) - lu(k,3120) * lu(k,3482) + lu(k,3509) = lu(k,3509) - lu(k,3107) * lu(k,3508) + lu(k,3510) = lu(k,3510) - lu(k,3108) * lu(k,3508) + lu(k,3511) = lu(k,3511) - lu(k,3109) * lu(k,3508) + lu(k,3512) = lu(k,3512) - lu(k,3110) * lu(k,3508) + lu(k,3513) = lu(k,3513) - lu(k,3111) * lu(k,3508) + lu(k,3514) = lu(k,3514) - lu(k,3112) * lu(k,3508) + lu(k,3515) = lu(k,3515) - lu(k,3113) * lu(k,3508) + lu(k,3516) = lu(k,3516) - lu(k,3114) * lu(k,3508) + lu(k,3517) = lu(k,3517) - lu(k,3115) * lu(k,3508) + lu(k,3518) = lu(k,3518) - lu(k,3116) * lu(k,3508) + lu(k,3519) = lu(k,3519) - lu(k,3117) * lu(k,3508) + lu(k,3520) = lu(k,3520) - lu(k,3118) * lu(k,3508) + lu(k,3521) = lu(k,3521) - lu(k,3119) * lu(k,3508) + lu(k,3522) = lu(k,3522) - lu(k,3120) * lu(k,3508) + lu(k,3603) = lu(k,3603) - lu(k,3107) * lu(k,3602) + lu(k,3604) = lu(k,3604) - lu(k,3108) * lu(k,3602) + lu(k,3605) = lu(k,3605) - lu(k,3109) * lu(k,3602) + lu(k,3606) = lu(k,3606) - lu(k,3110) * lu(k,3602) + lu(k,3607) = lu(k,3607) - lu(k,3111) * lu(k,3602) + lu(k,3608) = lu(k,3608) - lu(k,3112) * lu(k,3602) + lu(k,3609) = lu(k,3609) - lu(k,3113) * lu(k,3602) + lu(k,3610) = lu(k,3610) - lu(k,3114) * lu(k,3602) + lu(k,3611) = lu(k,3611) - lu(k,3115) * lu(k,3602) + lu(k,3612) = lu(k,3612) - lu(k,3116) * lu(k,3602) + lu(k,3613) = lu(k,3613) - lu(k,3117) * lu(k,3602) + lu(k,3614) = lu(k,3614) - lu(k,3118) * lu(k,3602) + lu(k,3615) = lu(k,3615) - lu(k,3119) * lu(k,3602) + lu(k,3616) = lu(k,3616) - lu(k,3120) * lu(k,3602) + lu(k,3655) = lu(k,3655) - lu(k,3107) * lu(k,3654) + lu(k,3656) = lu(k,3656) - lu(k,3108) * lu(k,3654) + lu(k,3657) = lu(k,3657) - lu(k,3109) * lu(k,3654) + lu(k,3658) = lu(k,3658) - lu(k,3110) * lu(k,3654) + lu(k,3659) = lu(k,3659) - lu(k,3111) * lu(k,3654) + lu(k,3660) = lu(k,3660) - lu(k,3112) * lu(k,3654) + lu(k,3661) = lu(k,3661) - lu(k,3113) * lu(k,3654) + lu(k,3662) = lu(k,3662) - lu(k,3114) * lu(k,3654) + lu(k,3663) = lu(k,3663) - lu(k,3115) * lu(k,3654) + lu(k,3664) = lu(k,3664) - lu(k,3116) * lu(k,3654) + lu(k,3665) = lu(k,3665) - lu(k,3117) * lu(k,3654) + lu(k,3666) = lu(k,3666) - lu(k,3118) * lu(k,3654) + lu(k,3667) = lu(k,3667) - lu(k,3119) * lu(k,3654) + lu(k,3668) = lu(k,3668) - lu(k,3120) * lu(k,3654) + lu(k,3757) = lu(k,3757) - lu(k,3107) * lu(k,3756) + lu(k,3758) = lu(k,3758) - lu(k,3108) * lu(k,3756) + lu(k,3759) = lu(k,3759) - lu(k,3109) * lu(k,3756) + lu(k,3760) = lu(k,3760) - lu(k,3110) * lu(k,3756) + lu(k,3761) = lu(k,3761) - lu(k,3111) * lu(k,3756) + lu(k,3762) = lu(k,3762) - lu(k,3112) * lu(k,3756) + lu(k,3763) = lu(k,3763) - lu(k,3113) * lu(k,3756) + lu(k,3764) = lu(k,3764) - lu(k,3114) * lu(k,3756) + lu(k,3765) = lu(k,3765) - lu(k,3115) * lu(k,3756) + lu(k,3766) = lu(k,3766) - lu(k,3116) * lu(k,3756) + lu(k,3767) = lu(k,3767) - lu(k,3117) * lu(k,3756) + lu(k,3768) = lu(k,3768) - lu(k,3118) * lu(k,3756) + lu(k,3769) = lu(k,3769) - lu(k,3119) * lu(k,3756) + lu(k,3770) = lu(k,3770) - lu(k,3120) * lu(k,3756) + lu(k,3798) = lu(k,3798) - lu(k,3107) * lu(k,3797) + lu(k,3799) = lu(k,3799) - lu(k,3108) * lu(k,3797) + lu(k,3800) = lu(k,3800) - lu(k,3109) * lu(k,3797) + lu(k,3801) = lu(k,3801) - lu(k,3110) * lu(k,3797) + lu(k,3802) = lu(k,3802) - lu(k,3111) * lu(k,3797) + lu(k,3803) = lu(k,3803) - lu(k,3112) * lu(k,3797) + lu(k,3804) = lu(k,3804) - lu(k,3113) * lu(k,3797) + lu(k,3805) = lu(k,3805) - lu(k,3114) * lu(k,3797) + lu(k,3806) = lu(k,3806) - lu(k,3115) * lu(k,3797) + lu(k,3807) = lu(k,3807) - lu(k,3116) * lu(k,3797) + lu(k,3808) = lu(k,3808) - lu(k,3117) * lu(k,3797) + lu(k,3809) = lu(k,3809) - lu(k,3118) * lu(k,3797) + lu(k,3810) = lu(k,3810) - lu(k,3119) * lu(k,3797) + lu(k,3811) = lu(k,3811) - lu(k,3120) * lu(k,3797) + lu(k,3839) = lu(k,3839) - lu(k,3107) * lu(k,3838) + lu(k,3840) = lu(k,3840) - lu(k,3108) * lu(k,3838) + lu(k,3841) = lu(k,3841) - lu(k,3109) * lu(k,3838) + lu(k,3842) = lu(k,3842) - lu(k,3110) * lu(k,3838) + lu(k,3843) = lu(k,3843) - lu(k,3111) * lu(k,3838) + lu(k,3844) = lu(k,3844) - lu(k,3112) * lu(k,3838) + lu(k,3845) = lu(k,3845) - lu(k,3113) * lu(k,3838) + lu(k,3846) = lu(k,3846) - lu(k,3114) * lu(k,3838) + lu(k,3847) = lu(k,3847) - lu(k,3115) * lu(k,3838) + lu(k,3848) = lu(k,3848) - lu(k,3116) * lu(k,3838) + lu(k,3849) = lu(k,3849) - lu(k,3117) * lu(k,3838) + lu(k,3850) = lu(k,3850) - lu(k,3118) * lu(k,3838) + lu(k,3851) = lu(k,3851) - lu(k,3119) * lu(k,3838) + lu(k,3852) = lu(k,3852) - lu(k,3120) * lu(k,3838) + lu(k,4089) = lu(k,4089) - lu(k,3107) * lu(k,4088) + lu(k,4090) = lu(k,4090) - lu(k,3108) * lu(k,4088) + lu(k,4091) = lu(k,4091) - lu(k,3109) * lu(k,4088) + lu(k,4092) = lu(k,4092) - lu(k,3110) * lu(k,4088) + lu(k,4093) = lu(k,4093) - lu(k,3111) * lu(k,4088) + lu(k,4094) = lu(k,4094) - lu(k,3112) * lu(k,4088) + lu(k,4095) = lu(k,4095) - lu(k,3113) * lu(k,4088) + lu(k,4096) = lu(k,4096) - lu(k,3114) * lu(k,4088) + lu(k,4097) = lu(k,4097) - lu(k,3115) * lu(k,4088) + lu(k,4098) = lu(k,4098) - lu(k,3116) * lu(k,4088) + lu(k,4099) = lu(k,4099) - lu(k,3117) * lu(k,4088) + lu(k,4100) = lu(k,4100) - lu(k,3118) * lu(k,4088) + lu(k,4101) = lu(k,4101) - lu(k,3119) * lu(k,4088) + lu(k,4102) = lu(k,4102) - lu(k,3120) * lu(k,4088) + lu(k,4115) = lu(k,4115) - lu(k,3107) * lu(k,4114) + lu(k,4116) = lu(k,4116) - lu(k,3108) * lu(k,4114) + lu(k,4117) = lu(k,4117) - lu(k,3109) * lu(k,4114) + lu(k,4118) = lu(k,4118) - lu(k,3110) * lu(k,4114) + lu(k,4119) = lu(k,4119) - lu(k,3111) * lu(k,4114) + lu(k,4120) = lu(k,4120) - lu(k,3112) * lu(k,4114) + lu(k,4121) = lu(k,4121) - lu(k,3113) * lu(k,4114) + lu(k,4122) = lu(k,4122) - lu(k,3114) * lu(k,4114) + lu(k,4123) = lu(k,4123) - lu(k,3115) * lu(k,4114) + lu(k,4124) = lu(k,4124) - lu(k,3116) * lu(k,4114) + lu(k,4125) = lu(k,4125) - lu(k,3117) * lu(k,4114) + lu(k,4126) = lu(k,4126) - lu(k,3118) * lu(k,4114) + lu(k,4127) = lu(k,4127) - lu(k,3119) * lu(k,4114) + lu(k,4128) = lu(k,4128) - lu(k,3120) * lu(k,4114) + lu(k,3129) = 1._r8 / lu(k,3129) + lu(k,3130) = lu(k,3130) * lu(k,3129) + lu(k,3131) = lu(k,3131) * lu(k,3129) + lu(k,3132) = lu(k,3132) * lu(k,3129) + lu(k,3133) = lu(k,3133) * lu(k,3129) + lu(k,3134) = lu(k,3134) * lu(k,3129) + lu(k,3135) = lu(k,3135) * lu(k,3129) + lu(k,3136) = lu(k,3136) * lu(k,3129) + lu(k,3137) = lu(k,3137) * lu(k,3129) + lu(k,3138) = lu(k,3138) * lu(k,3129) + lu(k,3139) = lu(k,3139) * lu(k,3129) + lu(k,3140) = lu(k,3140) * lu(k,3129) + lu(k,3141) = lu(k,3141) * lu(k,3129) + lu(k,3142) = lu(k,3142) * lu(k,3129) + lu(k,3161) = lu(k,3161) - lu(k,3130) * lu(k,3160) + lu(k,3162) = lu(k,3162) - lu(k,3131) * lu(k,3160) + lu(k,3163) = lu(k,3163) - lu(k,3132) * lu(k,3160) + lu(k,3164) = lu(k,3164) - lu(k,3133) * lu(k,3160) + lu(k,3165) = lu(k,3165) - lu(k,3134) * lu(k,3160) + lu(k,3166) = lu(k,3166) - lu(k,3135) * lu(k,3160) + lu(k,3167) = lu(k,3167) - lu(k,3136) * lu(k,3160) + lu(k,3168) = lu(k,3168) - lu(k,3137) * lu(k,3160) + lu(k,3169) = lu(k,3169) - lu(k,3138) * lu(k,3160) + lu(k,3170) = lu(k,3170) - lu(k,3139) * lu(k,3160) + lu(k,3171) = lu(k,3171) - lu(k,3140) * lu(k,3160) + lu(k,3172) = lu(k,3172) - lu(k,3141) * lu(k,3160) + lu(k,3173) = lu(k,3173) - lu(k,3142) * lu(k,3160) + lu(k,3187) = lu(k,3187) - lu(k,3130) * lu(k,3186) + lu(k,3188) = lu(k,3188) - lu(k,3131) * lu(k,3186) + lu(k,3189) = lu(k,3189) - lu(k,3132) * lu(k,3186) + lu(k,3190) = lu(k,3190) - lu(k,3133) * lu(k,3186) + lu(k,3191) = lu(k,3191) - lu(k,3134) * lu(k,3186) + lu(k,3192) = lu(k,3192) - lu(k,3135) * lu(k,3186) + lu(k,3193) = lu(k,3193) - lu(k,3136) * lu(k,3186) + lu(k,3194) = lu(k,3194) - lu(k,3137) * lu(k,3186) + lu(k,3195) = lu(k,3195) - lu(k,3138) * lu(k,3186) + lu(k,3196) = lu(k,3196) - lu(k,3139) * lu(k,3186) + lu(k,3197) = lu(k,3197) - lu(k,3140) * lu(k,3186) + lu(k,3198) = lu(k,3198) - lu(k,3141) * lu(k,3186) + lu(k,3199) = lu(k,3199) - lu(k,3142) * lu(k,3186) + lu(k,3367) = lu(k,3367) - lu(k,3130) * lu(k,3366) + lu(k,3368) = lu(k,3368) - lu(k,3131) * lu(k,3366) + lu(k,3369) = lu(k,3369) - lu(k,3132) * lu(k,3366) + lu(k,3370) = lu(k,3370) - lu(k,3133) * lu(k,3366) + lu(k,3371) = lu(k,3371) - lu(k,3134) * lu(k,3366) + lu(k,3372) = lu(k,3372) - lu(k,3135) * lu(k,3366) + lu(k,3373) = lu(k,3373) - lu(k,3136) * lu(k,3366) + lu(k,3374) = lu(k,3374) - lu(k,3137) * lu(k,3366) + lu(k,3375) = lu(k,3375) - lu(k,3138) * lu(k,3366) + lu(k,3376) = lu(k,3376) - lu(k,3139) * lu(k,3366) + lu(k,3377) = lu(k,3377) - lu(k,3140) * lu(k,3366) + lu(k,3378) = lu(k,3378) - lu(k,3141) * lu(k,3366) + lu(k,3379) = lu(k,3379) - lu(k,3142) * lu(k,3366) + lu(k,3460) = lu(k,3460) - lu(k,3130) * lu(k,3459) + lu(k,3461) = lu(k,3461) - lu(k,3131) * lu(k,3459) + lu(k,3462) = lu(k,3462) - lu(k,3132) * lu(k,3459) + lu(k,3463) = lu(k,3463) - lu(k,3133) * lu(k,3459) + lu(k,3464) = lu(k,3464) - lu(k,3134) * lu(k,3459) + lu(k,3465) = lu(k,3465) - lu(k,3135) * lu(k,3459) + lu(k,3466) = lu(k,3466) - lu(k,3136) * lu(k,3459) + lu(k,3467) = lu(k,3467) - lu(k,3137) * lu(k,3459) + lu(k,3468) = lu(k,3468) - lu(k,3138) * lu(k,3459) + lu(k,3469) = lu(k,3469) - lu(k,3139) * lu(k,3459) + lu(k,3470) = lu(k,3470) - lu(k,3140) * lu(k,3459) + lu(k,3471) = lu(k,3471) - lu(k,3141) * lu(k,3459) + lu(k,3472) = lu(k,3472) - lu(k,3142) * lu(k,3459) + lu(k,3484) = lu(k,3484) - lu(k,3130) * lu(k,3483) + lu(k,3485) = lu(k,3485) - lu(k,3131) * lu(k,3483) + lu(k,3486) = lu(k,3486) - lu(k,3132) * lu(k,3483) + lu(k,3487) = lu(k,3487) - lu(k,3133) * lu(k,3483) + lu(k,3488) = lu(k,3488) - lu(k,3134) * lu(k,3483) + lu(k,3489) = lu(k,3489) - lu(k,3135) * lu(k,3483) + lu(k,3490) = lu(k,3490) - lu(k,3136) * lu(k,3483) + lu(k,3491) = lu(k,3491) - lu(k,3137) * lu(k,3483) + lu(k,3492) = lu(k,3492) - lu(k,3138) * lu(k,3483) + lu(k,3493) = lu(k,3493) - lu(k,3139) * lu(k,3483) + lu(k,3494) = lu(k,3494) - lu(k,3140) * lu(k,3483) + lu(k,3495) = lu(k,3495) - lu(k,3141) * lu(k,3483) + lu(k,3496) = lu(k,3496) - lu(k,3142) * lu(k,3483) + lu(k,3510) = lu(k,3510) - lu(k,3130) * lu(k,3509) + lu(k,3511) = lu(k,3511) - lu(k,3131) * lu(k,3509) + lu(k,3512) = lu(k,3512) - lu(k,3132) * lu(k,3509) + lu(k,3513) = lu(k,3513) - lu(k,3133) * lu(k,3509) + lu(k,3514) = lu(k,3514) - lu(k,3134) * lu(k,3509) + lu(k,3515) = lu(k,3515) - lu(k,3135) * lu(k,3509) + lu(k,3516) = lu(k,3516) - lu(k,3136) * lu(k,3509) + lu(k,3517) = lu(k,3517) - lu(k,3137) * lu(k,3509) + lu(k,3518) = lu(k,3518) - lu(k,3138) * lu(k,3509) + lu(k,3519) = lu(k,3519) - lu(k,3139) * lu(k,3509) + lu(k,3520) = lu(k,3520) - lu(k,3140) * lu(k,3509) + lu(k,3521) = lu(k,3521) - lu(k,3141) * lu(k,3509) + lu(k,3522) = lu(k,3522) - lu(k,3142) * lu(k,3509) + lu(k,3604) = lu(k,3604) - lu(k,3130) * lu(k,3603) + lu(k,3605) = lu(k,3605) - lu(k,3131) * lu(k,3603) + lu(k,3606) = lu(k,3606) - lu(k,3132) * lu(k,3603) + lu(k,3607) = lu(k,3607) - lu(k,3133) * lu(k,3603) + lu(k,3608) = lu(k,3608) - lu(k,3134) * lu(k,3603) + lu(k,3609) = lu(k,3609) - lu(k,3135) * lu(k,3603) + lu(k,3610) = lu(k,3610) - lu(k,3136) * lu(k,3603) + lu(k,3611) = lu(k,3611) - lu(k,3137) * lu(k,3603) + lu(k,3612) = lu(k,3612) - lu(k,3138) * lu(k,3603) + lu(k,3613) = lu(k,3613) - lu(k,3139) * lu(k,3603) + lu(k,3614) = lu(k,3614) - lu(k,3140) * lu(k,3603) + lu(k,3615) = lu(k,3615) - lu(k,3141) * lu(k,3603) + lu(k,3616) = lu(k,3616) - lu(k,3142) * lu(k,3603) + lu(k,3656) = lu(k,3656) - lu(k,3130) * lu(k,3655) + lu(k,3657) = lu(k,3657) - lu(k,3131) * lu(k,3655) + lu(k,3658) = lu(k,3658) - lu(k,3132) * lu(k,3655) + lu(k,3659) = lu(k,3659) - lu(k,3133) * lu(k,3655) + lu(k,3660) = lu(k,3660) - lu(k,3134) * lu(k,3655) + lu(k,3661) = lu(k,3661) - lu(k,3135) * lu(k,3655) + lu(k,3662) = lu(k,3662) - lu(k,3136) * lu(k,3655) + lu(k,3663) = lu(k,3663) - lu(k,3137) * lu(k,3655) + lu(k,3664) = lu(k,3664) - lu(k,3138) * lu(k,3655) + lu(k,3665) = lu(k,3665) - lu(k,3139) * lu(k,3655) + lu(k,3666) = lu(k,3666) - lu(k,3140) * lu(k,3655) + lu(k,3667) = lu(k,3667) - lu(k,3141) * lu(k,3655) + lu(k,3668) = lu(k,3668) - lu(k,3142) * lu(k,3655) + lu(k,3758) = lu(k,3758) - lu(k,3130) * lu(k,3757) + lu(k,3759) = lu(k,3759) - lu(k,3131) * lu(k,3757) + lu(k,3760) = lu(k,3760) - lu(k,3132) * lu(k,3757) + lu(k,3761) = lu(k,3761) - lu(k,3133) * lu(k,3757) + lu(k,3762) = lu(k,3762) - lu(k,3134) * lu(k,3757) + lu(k,3763) = lu(k,3763) - lu(k,3135) * lu(k,3757) + lu(k,3764) = lu(k,3764) - lu(k,3136) * lu(k,3757) + lu(k,3765) = lu(k,3765) - lu(k,3137) * lu(k,3757) + lu(k,3766) = lu(k,3766) - lu(k,3138) * lu(k,3757) + lu(k,3767) = lu(k,3767) - lu(k,3139) * lu(k,3757) + lu(k,3768) = lu(k,3768) - lu(k,3140) * lu(k,3757) + lu(k,3769) = lu(k,3769) - lu(k,3141) * lu(k,3757) + lu(k,3770) = lu(k,3770) - lu(k,3142) * lu(k,3757) + lu(k,3799) = lu(k,3799) - lu(k,3130) * lu(k,3798) + lu(k,3800) = lu(k,3800) - lu(k,3131) * lu(k,3798) + lu(k,3801) = lu(k,3801) - lu(k,3132) * lu(k,3798) + lu(k,3802) = lu(k,3802) - lu(k,3133) * lu(k,3798) + lu(k,3803) = lu(k,3803) - lu(k,3134) * lu(k,3798) + lu(k,3804) = lu(k,3804) - lu(k,3135) * lu(k,3798) + lu(k,3805) = lu(k,3805) - lu(k,3136) * lu(k,3798) + lu(k,3806) = lu(k,3806) - lu(k,3137) * lu(k,3798) + lu(k,3807) = lu(k,3807) - lu(k,3138) * lu(k,3798) + lu(k,3808) = lu(k,3808) - lu(k,3139) * lu(k,3798) + lu(k,3809) = lu(k,3809) - lu(k,3140) * lu(k,3798) + lu(k,3810) = lu(k,3810) - lu(k,3141) * lu(k,3798) + lu(k,3811) = lu(k,3811) - lu(k,3142) * lu(k,3798) + lu(k,3840) = lu(k,3840) - lu(k,3130) * lu(k,3839) + lu(k,3841) = lu(k,3841) - lu(k,3131) * lu(k,3839) + lu(k,3842) = lu(k,3842) - lu(k,3132) * lu(k,3839) + lu(k,3843) = lu(k,3843) - lu(k,3133) * lu(k,3839) + lu(k,3844) = lu(k,3844) - lu(k,3134) * lu(k,3839) + lu(k,3845) = lu(k,3845) - lu(k,3135) * lu(k,3839) + lu(k,3846) = lu(k,3846) - lu(k,3136) * lu(k,3839) + lu(k,3847) = lu(k,3847) - lu(k,3137) * lu(k,3839) + lu(k,3848) = lu(k,3848) - lu(k,3138) * lu(k,3839) + lu(k,3849) = lu(k,3849) - lu(k,3139) * lu(k,3839) + lu(k,3850) = lu(k,3850) - lu(k,3140) * lu(k,3839) + lu(k,3851) = lu(k,3851) - lu(k,3141) * lu(k,3839) + lu(k,3852) = lu(k,3852) - lu(k,3142) * lu(k,3839) + lu(k,4090) = lu(k,4090) - lu(k,3130) * lu(k,4089) + lu(k,4091) = lu(k,4091) - lu(k,3131) * lu(k,4089) + lu(k,4092) = lu(k,4092) - lu(k,3132) * lu(k,4089) + lu(k,4093) = lu(k,4093) - lu(k,3133) * lu(k,4089) + lu(k,4094) = lu(k,4094) - lu(k,3134) * lu(k,4089) + lu(k,4095) = lu(k,4095) - lu(k,3135) * lu(k,4089) + lu(k,4096) = lu(k,4096) - lu(k,3136) * lu(k,4089) + lu(k,4097) = lu(k,4097) - lu(k,3137) * lu(k,4089) + lu(k,4098) = lu(k,4098) - lu(k,3138) * lu(k,4089) + lu(k,4099) = lu(k,4099) - lu(k,3139) * lu(k,4089) + lu(k,4100) = lu(k,4100) - lu(k,3140) * lu(k,4089) + lu(k,4101) = lu(k,4101) - lu(k,3141) * lu(k,4089) + lu(k,4102) = lu(k,4102) - lu(k,3142) * lu(k,4089) + lu(k,4116) = lu(k,4116) - lu(k,3130) * lu(k,4115) + lu(k,4117) = lu(k,4117) - lu(k,3131) * lu(k,4115) + lu(k,4118) = lu(k,4118) - lu(k,3132) * lu(k,4115) + lu(k,4119) = lu(k,4119) - lu(k,3133) * lu(k,4115) + lu(k,4120) = lu(k,4120) - lu(k,3134) * lu(k,4115) + lu(k,4121) = lu(k,4121) - lu(k,3135) * lu(k,4115) + lu(k,4122) = lu(k,4122) - lu(k,3136) * lu(k,4115) + lu(k,4123) = lu(k,4123) - lu(k,3137) * lu(k,4115) + lu(k,4124) = lu(k,4124) - lu(k,3138) * lu(k,4115) + lu(k,4125) = lu(k,4125) - lu(k,3139) * lu(k,4115) + lu(k,4126) = lu(k,4126) - lu(k,3140) * lu(k,4115) + lu(k,4127) = lu(k,4127) - lu(k,3141) * lu(k,4115) + lu(k,4128) = lu(k,4128) - lu(k,3142) * lu(k,4115) + lu(k,3161) = 1._r8 / lu(k,3161) + lu(k,3162) = lu(k,3162) * lu(k,3161) + lu(k,3163) = lu(k,3163) * lu(k,3161) + lu(k,3164) = lu(k,3164) * lu(k,3161) + lu(k,3165) = lu(k,3165) * lu(k,3161) + lu(k,3166) = lu(k,3166) * lu(k,3161) + lu(k,3167) = lu(k,3167) * lu(k,3161) + lu(k,3168) = lu(k,3168) * lu(k,3161) + lu(k,3169) = lu(k,3169) * lu(k,3161) + lu(k,3170) = lu(k,3170) * lu(k,3161) + lu(k,3171) = lu(k,3171) * lu(k,3161) + lu(k,3172) = lu(k,3172) * lu(k,3161) + lu(k,3173) = lu(k,3173) * lu(k,3161) + lu(k,3188) = lu(k,3188) - lu(k,3162) * lu(k,3187) + lu(k,3189) = lu(k,3189) - lu(k,3163) * lu(k,3187) + lu(k,3190) = lu(k,3190) - lu(k,3164) * lu(k,3187) + lu(k,3191) = lu(k,3191) - lu(k,3165) * lu(k,3187) + lu(k,3192) = lu(k,3192) - lu(k,3166) * lu(k,3187) + lu(k,3193) = lu(k,3193) - lu(k,3167) * lu(k,3187) + lu(k,3194) = lu(k,3194) - lu(k,3168) * lu(k,3187) + lu(k,3195) = lu(k,3195) - lu(k,3169) * lu(k,3187) + lu(k,3196) = lu(k,3196) - lu(k,3170) * lu(k,3187) + lu(k,3197) = lu(k,3197) - lu(k,3171) * lu(k,3187) + lu(k,3198) = lu(k,3198) - lu(k,3172) * lu(k,3187) + lu(k,3199) = lu(k,3199) - lu(k,3173) * lu(k,3187) + lu(k,3368) = lu(k,3368) - lu(k,3162) * lu(k,3367) + lu(k,3369) = lu(k,3369) - lu(k,3163) * lu(k,3367) + lu(k,3370) = lu(k,3370) - lu(k,3164) * lu(k,3367) + lu(k,3371) = lu(k,3371) - lu(k,3165) * lu(k,3367) + lu(k,3372) = lu(k,3372) - lu(k,3166) * lu(k,3367) + lu(k,3373) = lu(k,3373) - lu(k,3167) * lu(k,3367) + lu(k,3374) = lu(k,3374) - lu(k,3168) * lu(k,3367) + lu(k,3375) = lu(k,3375) - lu(k,3169) * lu(k,3367) + lu(k,3376) = lu(k,3376) - lu(k,3170) * lu(k,3367) + lu(k,3377) = lu(k,3377) - lu(k,3171) * lu(k,3367) + lu(k,3378) = lu(k,3378) - lu(k,3172) * lu(k,3367) + lu(k,3379) = lu(k,3379) - lu(k,3173) * lu(k,3367) + lu(k,3461) = lu(k,3461) - lu(k,3162) * lu(k,3460) + lu(k,3462) = lu(k,3462) - lu(k,3163) * lu(k,3460) + lu(k,3463) = lu(k,3463) - lu(k,3164) * lu(k,3460) + lu(k,3464) = lu(k,3464) - lu(k,3165) * lu(k,3460) + lu(k,3465) = lu(k,3465) - lu(k,3166) * lu(k,3460) + lu(k,3466) = lu(k,3466) - lu(k,3167) * lu(k,3460) + lu(k,3467) = lu(k,3467) - lu(k,3168) * lu(k,3460) + lu(k,3468) = lu(k,3468) - lu(k,3169) * lu(k,3460) + lu(k,3469) = lu(k,3469) - lu(k,3170) * lu(k,3460) + lu(k,3470) = lu(k,3470) - lu(k,3171) * lu(k,3460) + lu(k,3471) = lu(k,3471) - lu(k,3172) * lu(k,3460) + lu(k,3472) = lu(k,3472) - lu(k,3173) * lu(k,3460) + lu(k,3485) = lu(k,3485) - lu(k,3162) * lu(k,3484) + lu(k,3486) = lu(k,3486) - lu(k,3163) * lu(k,3484) + lu(k,3487) = lu(k,3487) - lu(k,3164) * lu(k,3484) + lu(k,3488) = lu(k,3488) - lu(k,3165) * lu(k,3484) + lu(k,3489) = lu(k,3489) - lu(k,3166) * lu(k,3484) + lu(k,3490) = lu(k,3490) - lu(k,3167) * lu(k,3484) + lu(k,3491) = lu(k,3491) - lu(k,3168) * lu(k,3484) + lu(k,3492) = lu(k,3492) - lu(k,3169) * lu(k,3484) + lu(k,3493) = lu(k,3493) - lu(k,3170) * lu(k,3484) + lu(k,3494) = lu(k,3494) - lu(k,3171) * lu(k,3484) + lu(k,3495) = lu(k,3495) - lu(k,3172) * lu(k,3484) + lu(k,3496) = lu(k,3496) - lu(k,3173) * lu(k,3484) + lu(k,3511) = lu(k,3511) - lu(k,3162) * lu(k,3510) + lu(k,3512) = lu(k,3512) - lu(k,3163) * lu(k,3510) + lu(k,3513) = lu(k,3513) - lu(k,3164) * lu(k,3510) + lu(k,3514) = lu(k,3514) - lu(k,3165) * lu(k,3510) + lu(k,3515) = lu(k,3515) - lu(k,3166) * lu(k,3510) + lu(k,3516) = lu(k,3516) - lu(k,3167) * lu(k,3510) + lu(k,3517) = lu(k,3517) - lu(k,3168) * lu(k,3510) + lu(k,3518) = lu(k,3518) - lu(k,3169) * lu(k,3510) + lu(k,3519) = lu(k,3519) - lu(k,3170) * lu(k,3510) + lu(k,3520) = lu(k,3520) - lu(k,3171) * lu(k,3510) + lu(k,3521) = lu(k,3521) - lu(k,3172) * lu(k,3510) + lu(k,3522) = lu(k,3522) - lu(k,3173) * lu(k,3510) + lu(k,3605) = lu(k,3605) - lu(k,3162) * lu(k,3604) + lu(k,3606) = lu(k,3606) - lu(k,3163) * lu(k,3604) + lu(k,3607) = lu(k,3607) - lu(k,3164) * lu(k,3604) + lu(k,3608) = lu(k,3608) - lu(k,3165) * lu(k,3604) + lu(k,3609) = lu(k,3609) - lu(k,3166) * lu(k,3604) + lu(k,3610) = lu(k,3610) - lu(k,3167) * lu(k,3604) + lu(k,3611) = lu(k,3611) - lu(k,3168) * lu(k,3604) + lu(k,3612) = lu(k,3612) - lu(k,3169) * lu(k,3604) + lu(k,3613) = lu(k,3613) - lu(k,3170) * lu(k,3604) + lu(k,3614) = lu(k,3614) - lu(k,3171) * lu(k,3604) + lu(k,3615) = lu(k,3615) - lu(k,3172) * lu(k,3604) + lu(k,3616) = lu(k,3616) - lu(k,3173) * lu(k,3604) + lu(k,3657) = lu(k,3657) - lu(k,3162) * lu(k,3656) + lu(k,3658) = lu(k,3658) - lu(k,3163) * lu(k,3656) + lu(k,3659) = lu(k,3659) - lu(k,3164) * lu(k,3656) + lu(k,3660) = lu(k,3660) - lu(k,3165) * lu(k,3656) + lu(k,3661) = lu(k,3661) - lu(k,3166) * lu(k,3656) + lu(k,3662) = lu(k,3662) - lu(k,3167) * lu(k,3656) + lu(k,3663) = lu(k,3663) - lu(k,3168) * lu(k,3656) + lu(k,3664) = lu(k,3664) - lu(k,3169) * lu(k,3656) + lu(k,3665) = lu(k,3665) - lu(k,3170) * lu(k,3656) + lu(k,3666) = lu(k,3666) - lu(k,3171) * lu(k,3656) + lu(k,3667) = lu(k,3667) - lu(k,3172) * lu(k,3656) + lu(k,3668) = lu(k,3668) - lu(k,3173) * lu(k,3656) + lu(k,3759) = lu(k,3759) - lu(k,3162) * lu(k,3758) + lu(k,3760) = lu(k,3760) - lu(k,3163) * lu(k,3758) + lu(k,3761) = lu(k,3761) - lu(k,3164) * lu(k,3758) + lu(k,3762) = lu(k,3762) - lu(k,3165) * lu(k,3758) + lu(k,3763) = lu(k,3763) - lu(k,3166) * lu(k,3758) + lu(k,3764) = lu(k,3764) - lu(k,3167) * lu(k,3758) + lu(k,3765) = lu(k,3765) - lu(k,3168) * lu(k,3758) + lu(k,3766) = lu(k,3766) - lu(k,3169) * lu(k,3758) + lu(k,3767) = lu(k,3767) - lu(k,3170) * lu(k,3758) + lu(k,3768) = lu(k,3768) - lu(k,3171) * lu(k,3758) + lu(k,3769) = lu(k,3769) - lu(k,3172) * lu(k,3758) + lu(k,3770) = lu(k,3770) - lu(k,3173) * lu(k,3758) + lu(k,3800) = lu(k,3800) - lu(k,3162) * lu(k,3799) + lu(k,3801) = lu(k,3801) - lu(k,3163) * lu(k,3799) + lu(k,3802) = lu(k,3802) - lu(k,3164) * lu(k,3799) + lu(k,3803) = lu(k,3803) - lu(k,3165) * lu(k,3799) + lu(k,3804) = lu(k,3804) - lu(k,3166) * lu(k,3799) + lu(k,3805) = lu(k,3805) - lu(k,3167) * lu(k,3799) + lu(k,3806) = lu(k,3806) - lu(k,3168) * lu(k,3799) + lu(k,3807) = lu(k,3807) - lu(k,3169) * lu(k,3799) + lu(k,3808) = lu(k,3808) - lu(k,3170) * lu(k,3799) + lu(k,3809) = lu(k,3809) - lu(k,3171) * lu(k,3799) + lu(k,3810) = lu(k,3810) - lu(k,3172) * lu(k,3799) + lu(k,3811) = lu(k,3811) - lu(k,3173) * lu(k,3799) + lu(k,3841) = lu(k,3841) - lu(k,3162) * lu(k,3840) + lu(k,3842) = lu(k,3842) - lu(k,3163) * lu(k,3840) + lu(k,3843) = lu(k,3843) - lu(k,3164) * lu(k,3840) + lu(k,3844) = lu(k,3844) - lu(k,3165) * lu(k,3840) + lu(k,3845) = lu(k,3845) - lu(k,3166) * lu(k,3840) + lu(k,3846) = lu(k,3846) - lu(k,3167) * lu(k,3840) + lu(k,3847) = lu(k,3847) - lu(k,3168) * lu(k,3840) + lu(k,3848) = lu(k,3848) - lu(k,3169) * lu(k,3840) + lu(k,3849) = lu(k,3849) - lu(k,3170) * lu(k,3840) + lu(k,3850) = lu(k,3850) - lu(k,3171) * lu(k,3840) + lu(k,3851) = lu(k,3851) - lu(k,3172) * lu(k,3840) + lu(k,3852) = lu(k,3852) - lu(k,3173) * lu(k,3840) + lu(k,4091) = lu(k,4091) - lu(k,3162) * lu(k,4090) + lu(k,4092) = lu(k,4092) - lu(k,3163) * lu(k,4090) + lu(k,4093) = lu(k,4093) - lu(k,3164) * lu(k,4090) + lu(k,4094) = lu(k,4094) - lu(k,3165) * lu(k,4090) + lu(k,4095) = lu(k,4095) - lu(k,3166) * lu(k,4090) + lu(k,4096) = lu(k,4096) - lu(k,3167) * lu(k,4090) + lu(k,4097) = lu(k,4097) - lu(k,3168) * lu(k,4090) + lu(k,4098) = lu(k,4098) - lu(k,3169) * lu(k,4090) + lu(k,4099) = lu(k,4099) - lu(k,3170) * lu(k,4090) + lu(k,4100) = lu(k,4100) - lu(k,3171) * lu(k,4090) + lu(k,4101) = lu(k,4101) - lu(k,3172) * lu(k,4090) + lu(k,4102) = lu(k,4102) - lu(k,3173) * lu(k,4090) + lu(k,4117) = lu(k,4117) - lu(k,3162) * lu(k,4116) + lu(k,4118) = lu(k,4118) - lu(k,3163) * lu(k,4116) + lu(k,4119) = lu(k,4119) - lu(k,3164) * lu(k,4116) + lu(k,4120) = lu(k,4120) - lu(k,3165) * lu(k,4116) + lu(k,4121) = lu(k,4121) - lu(k,3166) * lu(k,4116) + lu(k,4122) = lu(k,4122) - lu(k,3167) * lu(k,4116) + lu(k,4123) = lu(k,4123) - lu(k,3168) * lu(k,4116) + lu(k,4124) = lu(k,4124) - lu(k,3169) * lu(k,4116) + lu(k,4125) = lu(k,4125) - lu(k,3170) * lu(k,4116) + lu(k,4126) = lu(k,4126) - lu(k,3171) * lu(k,4116) + lu(k,4127) = lu(k,4127) - lu(k,3172) * lu(k,4116) + lu(k,4128) = lu(k,4128) - lu(k,3173) * lu(k,4116) + lu(k,3188) = 1._r8 / lu(k,3188) + lu(k,3189) = lu(k,3189) * lu(k,3188) + lu(k,3190) = lu(k,3190) * lu(k,3188) + lu(k,3191) = lu(k,3191) * lu(k,3188) + lu(k,3192) = lu(k,3192) * lu(k,3188) + lu(k,3193) = lu(k,3193) * lu(k,3188) + lu(k,3194) = lu(k,3194) * lu(k,3188) + lu(k,3195) = lu(k,3195) * lu(k,3188) + lu(k,3196) = lu(k,3196) * lu(k,3188) + lu(k,3197) = lu(k,3197) * lu(k,3188) + lu(k,3198) = lu(k,3198) * lu(k,3188) + lu(k,3199) = lu(k,3199) * lu(k,3188) + lu(k,3369) = lu(k,3369) - lu(k,3189) * lu(k,3368) + lu(k,3370) = lu(k,3370) - lu(k,3190) * lu(k,3368) + lu(k,3371) = lu(k,3371) - lu(k,3191) * lu(k,3368) + lu(k,3372) = lu(k,3372) - lu(k,3192) * lu(k,3368) + lu(k,3373) = lu(k,3373) - lu(k,3193) * lu(k,3368) + lu(k,3374) = lu(k,3374) - lu(k,3194) * lu(k,3368) + lu(k,3375) = lu(k,3375) - lu(k,3195) * lu(k,3368) + lu(k,3376) = lu(k,3376) - lu(k,3196) * lu(k,3368) + lu(k,3377) = lu(k,3377) - lu(k,3197) * lu(k,3368) + lu(k,3378) = lu(k,3378) - lu(k,3198) * lu(k,3368) + lu(k,3379) = lu(k,3379) - lu(k,3199) * lu(k,3368) + lu(k,3462) = lu(k,3462) - lu(k,3189) * lu(k,3461) + lu(k,3463) = lu(k,3463) - lu(k,3190) * lu(k,3461) + lu(k,3464) = lu(k,3464) - lu(k,3191) * lu(k,3461) + lu(k,3465) = lu(k,3465) - lu(k,3192) * lu(k,3461) + lu(k,3466) = lu(k,3466) - lu(k,3193) * lu(k,3461) + lu(k,3467) = lu(k,3467) - lu(k,3194) * lu(k,3461) + lu(k,3468) = lu(k,3468) - lu(k,3195) * lu(k,3461) + lu(k,3469) = lu(k,3469) - lu(k,3196) * lu(k,3461) + lu(k,3470) = lu(k,3470) - lu(k,3197) * lu(k,3461) + lu(k,3471) = lu(k,3471) - lu(k,3198) * lu(k,3461) + lu(k,3472) = lu(k,3472) - lu(k,3199) * lu(k,3461) + lu(k,3486) = lu(k,3486) - lu(k,3189) * lu(k,3485) + lu(k,3487) = lu(k,3487) - lu(k,3190) * lu(k,3485) + lu(k,3488) = lu(k,3488) - lu(k,3191) * lu(k,3485) + lu(k,3489) = lu(k,3489) - lu(k,3192) * lu(k,3485) + lu(k,3490) = lu(k,3490) - lu(k,3193) * lu(k,3485) + lu(k,3491) = lu(k,3491) - lu(k,3194) * lu(k,3485) + lu(k,3492) = lu(k,3492) - lu(k,3195) * lu(k,3485) + lu(k,3493) = lu(k,3493) - lu(k,3196) * lu(k,3485) + lu(k,3494) = lu(k,3494) - lu(k,3197) * lu(k,3485) + lu(k,3495) = lu(k,3495) - lu(k,3198) * lu(k,3485) + lu(k,3496) = lu(k,3496) - lu(k,3199) * lu(k,3485) + lu(k,3512) = lu(k,3512) - lu(k,3189) * lu(k,3511) + lu(k,3513) = lu(k,3513) - lu(k,3190) * lu(k,3511) + lu(k,3514) = lu(k,3514) - lu(k,3191) * lu(k,3511) + lu(k,3515) = lu(k,3515) - lu(k,3192) * lu(k,3511) + lu(k,3516) = lu(k,3516) - lu(k,3193) * lu(k,3511) + lu(k,3517) = lu(k,3517) - lu(k,3194) * lu(k,3511) + lu(k,3518) = lu(k,3518) - lu(k,3195) * lu(k,3511) + lu(k,3519) = lu(k,3519) - lu(k,3196) * lu(k,3511) + lu(k,3520) = lu(k,3520) - lu(k,3197) * lu(k,3511) + lu(k,3521) = lu(k,3521) - lu(k,3198) * lu(k,3511) + lu(k,3522) = lu(k,3522) - lu(k,3199) * lu(k,3511) + lu(k,3606) = lu(k,3606) - lu(k,3189) * lu(k,3605) + lu(k,3607) = lu(k,3607) - lu(k,3190) * lu(k,3605) + lu(k,3608) = lu(k,3608) - lu(k,3191) * lu(k,3605) + lu(k,3609) = lu(k,3609) - lu(k,3192) * lu(k,3605) + lu(k,3610) = lu(k,3610) - lu(k,3193) * lu(k,3605) + lu(k,3611) = lu(k,3611) - lu(k,3194) * lu(k,3605) + lu(k,3612) = lu(k,3612) - lu(k,3195) * lu(k,3605) + lu(k,3613) = lu(k,3613) - lu(k,3196) * lu(k,3605) + lu(k,3614) = lu(k,3614) - lu(k,3197) * lu(k,3605) + lu(k,3615) = lu(k,3615) - lu(k,3198) * lu(k,3605) + lu(k,3616) = lu(k,3616) - lu(k,3199) * lu(k,3605) + lu(k,3658) = lu(k,3658) - lu(k,3189) * lu(k,3657) + lu(k,3659) = lu(k,3659) - lu(k,3190) * lu(k,3657) + lu(k,3660) = lu(k,3660) - lu(k,3191) * lu(k,3657) + lu(k,3661) = lu(k,3661) - lu(k,3192) * lu(k,3657) + lu(k,3662) = lu(k,3662) - lu(k,3193) * lu(k,3657) + lu(k,3663) = lu(k,3663) - lu(k,3194) * lu(k,3657) + lu(k,3664) = lu(k,3664) - lu(k,3195) * lu(k,3657) + lu(k,3665) = lu(k,3665) - lu(k,3196) * lu(k,3657) + lu(k,3666) = lu(k,3666) - lu(k,3197) * lu(k,3657) + lu(k,3667) = lu(k,3667) - lu(k,3198) * lu(k,3657) + lu(k,3668) = lu(k,3668) - lu(k,3199) * lu(k,3657) + lu(k,3760) = lu(k,3760) - lu(k,3189) * lu(k,3759) + lu(k,3761) = lu(k,3761) - lu(k,3190) * lu(k,3759) + lu(k,3762) = lu(k,3762) - lu(k,3191) * lu(k,3759) + lu(k,3763) = lu(k,3763) - lu(k,3192) * lu(k,3759) + lu(k,3764) = lu(k,3764) - lu(k,3193) * lu(k,3759) + lu(k,3765) = lu(k,3765) - lu(k,3194) * lu(k,3759) + lu(k,3766) = lu(k,3766) - lu(k,3195) * lu(k,3759) + lu(k,3767) = lu(k,3767) - lu(k,3196) * lu(k,3759) + lu(k,3768) = lu(k,3768) - lu(k,3197) * lu(k,3759) + lu(k,3769) = lu(k,3769) - lu(k,3198) * lu(k,3759) + lu(k,3770) = lu(k,3770) - lu(k,3199) * lu(k,3759) + lu(k,3801) = lu(k,3801) - lu(k,3189) * lu(k,3800) + lu(k,3802) = lu(k,3802) - lu(k,3190) * lu(k,3800) + lu(k,3803) = lu(k,3803) - lu(k,3191) * lu(k,3800) + lu(k,3804) = lu(k,3804) - lu(k,3192) * lu(k,3800) + lu(k,3805) = lu(k,3805) - lu(k,3193) * lu(k,3800) + lu(k,3806) = lu(k,3806) - lu(k,3194) * lu(k,3800) + lu(k,3807) = lu(k,3807) - lu(k,3195) * lu(k,3800) + lu(k,3808) = lu(k,3808) - lu(k,3196) * lu(k,3800) + lu(k,3809) = lu(k,3809) - lu(k,3197) * lu(k,3800) + lu(k,3810) = lu(k,3810) - lu(k,3198) * lu(k,3800) + lu(k,3811) = lu(k,3811) - lu(k,3199) * lu(k,3800) + lu(k,3842) = lu(k,3842) - lu(k,3189) * lu(k,3841) + lu(k,3843) = lu(k,3843) - lu(k,3190) * lu(k,3841) + lu(k,3844) = lu(k,3844) - lu(k,3191) * lu(k,3841) + lu(k,3845) = lu(k,3845) - lu(k,3192) * lu(k,3841) + lu(k,3846) = lu(k,3846) - lu(k,3193) * lu(k,3841) + lu(k,3847) = lu(k,3847) - lu(k,3194) * lu(k,3841) + lu(k,3848) = lu(k,3848) - lu(k,3195) * lu(k,3841) + lu(k,3849) = lu(k,3849) - lu(k,3196) * lu(k,3841) + lu(k,3850) = lu(k,3850) - lu(k,3197) * lu(k,3841) + lu(k,3851) = lu(k,3851) - lu(k,3198) * lu(k,3841) + lu(k,3852) = lu(k,3852) - lu(k,3199) * lu(k,3841) + lu(k,4092) = lu(k,4092) - lu(k,3189) * lu(k,4091) + lu(k,4093) = lu(k,4093) - lu(k,3190) * lu(k,4091) + lu(k,4094) = lu(k,4094) - lu(k,3191) * lu(k,4091) + lu(k,4095) = lu(k,4095) - lu(k,3192) * lu(k,4091) + lu(k,4096) = lu(k,4096) - lu(k,3193) * lu(k,4091) + lu(k,4097) = lu(k,4097) - lu(k,3194) * lu(k,4091) + lu(k,4098) = lu(k,4098) - lu(k,3195) * lu(k,4091) + lu(k,4099) = lu(k,4099) - lu(k,3196) * lu(k,4091) + lu(k,4100) = lu(k,4100) - lu(k,3197) * lu(k,4091) + lu(k,4101) = lu(k,4101) - lu(k,3198) * lu(k,4091) + lu(k,4102) = lu(k,4102) - lu(k,3199) * lu(k,4091) + lu(k,4118) = lu(k,4118) - lu(k,3189) * lu(k,4117) + lu(k,4119) = lu(k,4119) - lu(k,3190) * lu(k,4117) + lu(k,4120) = lu(k,4120) - lu(k,3191) * lu(k,4117) + lu(k,4121) = lu(k,4121) - lu(k,3192) * lu(k,4117) + lu(k,4122) = lu(k,4122) - lu(k,3193) * lu(k,4117) + lu(k,4123) = lu(k,4123) - lu(k,3194) * lu(k,4117) + lu(k,4124) = lu(k,4124) - lu(k,3195) * lu(k,4117) + lu(k,4125) = lu(k,4125) - lu(k,3196) * lu(k,4117) + lu(k,4126) = lu(k,4126) - lu(k,3197) * lu(k,4117) + lu(k,4127) = lu(k,4127) - lu(k,3198) * lu(k,4117) + lu(k,4128) = lu(k,4128) - lu(k,3199) * lu(k,4117) + end do + end subroutine lu_fac53 + subroutine lu_fac54( 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,3369) = 1._r8 / lu(k,3369) + lu(k,3370) = lu(k,3370) * lu(k,3369) + lu(k,3371) = lu(k,3371) * lu(k,3369) + lu(k,3372) = lu(k,3372) * lu(k,3369) + lu(k,3373) = lu(k,3373) * lu(k,3369) + lu(k,3374) = lu(k,3374) * lu(k,3369) + lu(k,3375) = lu(k,3375) * lu(k,3369) + lu(k,3376) = lu(k,3376) * lu(k,3369) + lu(k,3377) = lu(k,3377) * lu(k,3369) + lu(k,3378) = lu(k,3378) * lu(k,3369) + lu(k,3379) = lu(k,3379) * lu(k,3369) + lu(k,3463) = lu(k,3463) - lu(k,3370) * lu(k,3462) + lu(k,3464) = lu(k,3464) - lu(k,3371) * lu(k,3462) + lu(k,3465) = lu(k,3465) - lu(k,3372) * lu(k,3462) + lu(k,3466) = lu(k,3466) - lu(k,3373) * lu(k,3462) + lu(k,3467) = lu(k,3467) - lu(k,3374) * lu(k,3462) + lu(k,3468) = lu(k,3468) - lu(k,3375) * lu(k,3462) + lu(k,3469) = lu(k,3469) - lu(k,3376) * lu(k,3462) + lu(k,3470) = lu(k,3470) - lu(k,3377) * lu(k,3462) + lu(k,3471) = lu(k,3471) - lu(k,3378) * lu(k,3462) + lu(k,3472) = lu(k,3472) - lu(k,3379) * lu(k,3462) + lu(k,3487) = lu(k,3487) - lu(k,3370) * lu(k,3486) + lu(k,3488) = lu(k,3488) - lu(k,3371) * lu(k,3486) + lu(k,3489) = lu(k,3489) - lu(k,3372) * lu(k,3486) + lu(k,3490) = lu(k,3490) - lu(k,3373) * lu(k,3486) + lu(k,3491) = lu(k,3491) - lu(k,3374) * lu(k,3486) + lu(k,3492) = lu(k,3492) - lu(k,3375) * lu(k,3486) + lu(k,3493) = lu(k,3493) - lu(k,3376) * lu(k,3486) + lu(k,3494) = lu(k,3494) - lu(k,3377) * lu(k,3486) + lu(k,3495) = lu(k,3495) - lu(k,3378) * lu(k,3486) + lu(k,3496) = lu(k,3496) - lu(k,3379) * lu(k,3486) + lu(k,3513) = lu(k,3513) - lu(k,3370) * lu(k,3512) + lu(k,3514) = lu(k,3514) - lu(k,3371) * lu(k,3512) + lu(k,3515) = lu(k,3515) - lu(k,3372) * lu(k,3512) + lu(k,3516) = lu(k,3516) - lu(k,3373) * lu(k,3512) + lu(k,3517) = lu(k,3517) - lu(k,3374) * lu(k,3512) + lu(k,3518) = lu(k,3518) - lu(k,3375) * lu(k,3512) + lu(k,3519) = lu(k,3519) - lu(k,3376) * lu(k,3512) + lu(k,3520) = lu(k,3520) - lu(k,3377) * lu(k,3512) + lu(k,3521) = lu(k,3521) - lu(k,3378) * lu(k,3512) + lu(k,3522) = lu(k,3522) - lu(k,3379) * lu(k,3512) + lu(k,3607) = lu(k,3607) - lu(k,3370) * lu(k,3606) + lu(k,3608) = lu(k,3608) - lu(k,3371) * lu(k,3606) + lu(k,3609) = lu(k,3609) - lu(k,3372) * lu(k,3606) + lu(k,3610) = lu(k,3610) - lu(k,3373) * lu(k,3606) + lu(k,3611) = lu(k,3611) - lu(k,3374) * lu(k,3606) + lu(k,3612) = lu(k,3612) - lu(k,3375) * lu(k,3606) + lu(k,3613) = lu(k,3613) - lu(k,3376) * lu(k,3606) + lu(k,3614) = lu(k,3614) - lu(k,3377) * lu(k,3606) + lu(k,3615) = lu(k,3615) - lu(k,3378) * lu(k,3606) + lu(k,3616) = lu(k,3616) - lu(k,3379) * lu(k,3606) + lu(k,3659) = lu(k,3659) - lu(k,3370) * lu(k,3658) + lu(k,3660) = lu(k,3660) - lu(k,3371) * lu(k,3658) + lu(k,3661) = lu(k,3661) - lu(k,3372) * lu(k,3658) + lu(k,3662) = lu(k,3662) - lu(k,3373) * lu(k,3658) + lu(k,3663) = lu(k,3663) - lu(k,3374) * lu(k,3658) + lu(k,3664) = lu(k,3664) - lu(k,3375) * lu(k,3658) + lu(k,3665) = lu(k,3665) - lu(k,3376) * lu(k,3658) + lu(k,3666) = lu(k,3666) - lu(k,3377) * lu(k,3658) + lu(k,3667) = lu(k,3667) - lu(k,3378) * lu(k,3658) + lu(k,3668) = lu(k,3668) - lu(k,3379) * lu(k,3658) + lu(k,3761) = lu(k,3761) - lu(k,3370) * lu(k,3760) + lu(k,3762) = lu(k,3762) - lu(k,3371) * lu(k,3760) + lu(k,3763) = lu(k,3763) - lu(k,3372) * lu(k,3760) + lu(k,3764) = lu(k,3764) - lu(k,3373) * lu(k,3760) + lu(k,3765) = lu(k,3765) - lu(k,3374) * lu(k,3760) + lu(k,3766) = lu(k,3766) - lu(k,3375) * lu(k,3760) + lu(k,3767) = lu(k,3767) - lu(k,3376) * lu(k,3760) + lu(k,3768) = lu(k,3768) - lu(k,3377) * lu(k,3760) + lu(k,3769) = lu(k,3769) - lu(k,3378) * lu(k,3760) + lu(k,3770) = lu(k,3770) - lu(k,3379) * lu(k,3760) + lu(k,3802) = lu(k,3802) - lu(k,3370) * lu(k,3801) + lu(k,3803) = lu(k,3803) - lu(k,3371) * lu(k,3801) + lu(k,3804) = lu(k,3804) - lu(k,3372) * lu(k,3801) + lu(k,3805) = lu(k,3805) - lu(k,3373) * lu(k,3801) + lu(k,3806) = lu(k,3806) - lu(k,3374) * lu(k,3801) + lu(k,3807) = lu(k,3807) - lu(k,3375) * lu(k,3801) + lu(k,3808) = lu(k,3808) - lu(k,3376) * lu(k,3801) + lu(k,3809) = lu(k,3809) - lu(k,3377) * lu(k,3801) + lu(k,3810) = lu(k,3810) - lu(k,3378) * lu(k,3801) + lu(k,3811) = lu(k,3811) - lu(k,3379) * lu(k,3801) + lu(k,3843) = lu(k,3843) - lu(k,3370) * lu(k,3842) + lu(k,3844) = lu(k,3844) - lu(k,3371) * lu(k,3842) + lu(k,3845) = lu(k,3845) - lu(k,3372) * lu(k,3842) + lu(k,3846) = lu(k,3846) - lu(k,3373) * lu(k,3842) + lu(k,3847) = lu(k,3847) - lu(k,3374) * lu(k,3842) + lu(k,3848) = lu(k,3848) - lu(k,3375) * lu(k,3842) + lu(k,3849) = lu(k,3849) - lu(k,3376) * lu(k,3842) + lu(k,3850) = lu(k,3850) - lu(k,3377) * lu(k,3842) + lu(k,3851) = lu(k,3851) - lu(k,3378) * lu(k,3842) + lu(k,3852) = lu(k,3852) - lu(k,3379) * lu(k,3842) + lu(k,4093) = lu(k,4093) - lu(k,3370) * lu(k,4092) + lu(k,4094) = lu(k,4094) - lu(k,3371) * lu(k,4092) + lu(k,4095) = lu(k,4095) - lu(k,3372) * lu(k,4092) + lu(k,4096) = lu(k,4096) - lu(k,3373) * lu(k,4092) + lu(k,4097) = lu(k,4097) - lu(k,3374) * lu(k,4092) + lu(k,4098) = lu(k,4098) - lu(k,3375) * lu(k,4092) + lu(k,4099) = lu(k,4099) - lu(k,3376) * lu(k,4092) + lu(k,4100) = lu(k,4100) - lu(k,3377) * lu(k,4092) + lu(k,4101) = lu(k,4101) - lu(k,3378) * lu(k,4092) + lu(k,4102) = lu(k,4102) - lu(k,3379) * lu(k,4092) + lu(k,4119) = lu(k,4119) - lu(k,3370) * lu(k,4118) + lu(k,4120) = lu(k,4120) - lu(k,3371) * lu(k,4118) + lu(k,4121) = lu(k,4121) - lu(k,3372) * lu(k,4118) + lu(k,4122) = lu(k,4122) - lu(k,3373) * lu(k,4118) + lu(k,4123) = lu(k,4123) - lu(k,3374) * lu(k,4118) + lu(k,4124) = lu(k,4124) - lu(k,3375) * lu(k,4118) + lu(k,4125) = lu(k,4125) - lu(k,3376) * lu(k,4118) + lu(k,4126) = lu(k,4126) - lu(k,3377) * lu(k,4118) + lu(k,4127) = lu(k,4127) - lu(k,3378) * lu(k,4118) + lu(k,4128) = lu(k,4128) - lu(k,3379) * lu(k,4118) + lu(k,3463) = 1._r8 / lu(k,3463) + lu(k,3464) = lu(k,3464) * lu(k,3463) + lu(k,3465) = lu(k,3465) * lu(k,3463) + lu(k,3466) = lu(k,3466) * lu(k,3463) + lu(k,3467) = lu(k,3467) * lu(k,3463) + lu(k,3468) = lu(k,3468) * lu(k,3463) + lu(k,3469) = lu(k,3469) * lu(k,3463) + lu(k,3470) = lu(k,3470) * lu(k,3463) + lu(k,3471) = lu(k,3471) * lu(k,3463) + lu(k,3472) = lu(k,3472) * lu(k,3463) + lu(k,3488) = lu(k,3488) - lu(k,3464) * lu(k,3487) + lu(k,3489) = lu(k,3489) - lu(k,3465) * lu(k,3487) + lu(k,3490) = lu(k,3490) - lu(k,3466) * lu(k,3487) + lu(k,3491) = lu(k,3491) - lu(k,3467) * lu(k,3487) + lu(k,3492) = lu(k,3492) - lu(k,3468) * lu(k,3487) + lu(k,3493) = lu(k,3493) - lu(k,3469) * lu(k,3487) + lu(k,3494) = lu(k,3494) - lu(k,3470) * lu(k,3487) + lu(k,3495) = lu(k,3495) - lu(k,3471) * lu(k,3487) + lu(k,3496) = lu(k,3496) - lu(k,3472) * lu(k,3487) + lu(k,3514) = lu(k,3514) - lu(k,3464) * lu(k,3513) + lu(k,3515) = lu(k,3515) - lu(k,3465) * lu(k,3513) + lu(k,3516) = lu(k,3516) - lu(k,3466) * lu(k,3513) + lu(k,3517) = lu(k,3517) - lu(k,3467) * lu(k,3513) + lu(k,3518) = lu(k,3518) - lu(k,3468) * lu(k,3513) + lu(k,3519) = lu(k,3519) - lu(k,3469) * lu(k,3513) + lu(k,3520) = lu(k,3520) - lu(k,3470) * lu(k,3513) + lu(k,3521) = lu(k,3521) - lu(k,3471) * lu(k,3513) + lu(k,3522) = lu(k,3522) - lu(k,3472) * lu(k,3513) + lu(k,3608) = lu(k,3608) - lu(k,3464) * lu(k,3607) + lu(k,3609) = lu(k,3609) - lu(k,3465) * lu(k,3607) + lu(k,3610) = lu(k,3610) - lu(k,3466) * lu(k,3607) + lu(k,3611) = lu(k,3611) - lu(k,3467) * lu(k,3607) + lu(k,3612) = lu(k,3612) - lu(k,3468) * lu(k,3607) + lu(k,3613) = lu(k,3613) - lu(k,3469) * lu(k,3607) + lu(k,3614) = lu(k,3614) - lu(k,3470) * lu(k,3607) + lu(k,3615) = lu(k,3615) - lu(k,3471) * lu(k,3607) + lu(k,3616) = lu(k,3616) - lu(k,3472) * lu(k,3607) + lu(k,3660) = lu(k,3660) - lu(k,3464) * lu(k,3659) + lu(k,3661) = lu(k,3661) - lu(k,3465) * lu(k,3659) + lu(k,3662) = lu(k,3662) - lu(k,3466) * lu(k,3659) + lu(k,3663) = lu(k,3663) - lu(k,3467) * lu(k,3659) + lu(k,3664) = lu(k,3664) - lu(k,3468) * lu(k,3659) + lu(k,3665) = lu(k,3665) - lu(k,3469) * lu(k,3659) + lu(k,3666) = lu(k,3666) - lu(k,3470) * lu(k,3659) + lu(k,3667) = lu(k,3667) - lu(k,3471) * lu(k,3659) + lu(k,3668) = lu(k,3668) - lu(k,3472) * lu(k,3659) + lu(k,3762) = lu(k,3762) - lu(k,3464) * lu(k,3761) + lu(k,3763) = lu(k,3763) - lu(k,3465) * lu(k,3761) + lu(k,3764) = lu(k,3764) - lu(k,3466) * lu(k,3761) + lu(k,3765) = lu(k,3765) - lu(k,3467) * lu(k,3761) + lu(k,3766) = lu(k,3766) - lu(k,3468) * lu(k,3761) + lu(k,3767) = lu(k,3767) - lu(k,3469) * lu(k,3761) + lu(k,3768) = lu(k,3768) - lu(k,3470) * lu(k,3761) + lu(k,3769) = lu(k,3769) - lu(k,3471) * lu(k,3761) + lu(k,3770) = lu(k,3770) - lu(k,3472) * lu(k,3761) + lu(k,3803) = lu(k,3803) - lu(k,3464) * lu(k,3802) + lu(k,3804) = lu(k,3804) - lu(k,3465) * lu(k,3802) + lu(k,3805) = lu(k,3805) - lu(k,3466) * lu(k,3802) + lu(k,3806) = lu(k,3806) - lu(k,3467) * lu(k,3802) + lu(k,3807) = lu(k,3807) - lu(k,3468) * lu(k,3802) + lu(k,3808) = lu(k,3808) - lu(k,3469) * lu(k,3802) + lu(k,3809) = lu(k,3809) - lu(k,3470) * lu(k,3802) + lu(k,3810) = lu(k,3810) - lu(k,3471) * lu(k,3802) + lu(k,3811) = lu(k,3811) - lu(k,3472) * lu(k,3802) + lu(k,3844) = lu(k,3844) - lu(k,3464) * lu(k,3843) + lu(k,3845) = lu(k,3845) - lu(k,3465) * lu(k,3843) + lu(k,3846) = lu(k,3846) - lu(k,3466) * lu(k,3843) + lu(k,3847) = lu(k,3847) - lu(k,3467) * lu(k,3843) + lu(k,3848) = lu(k,3848) - lu(k,3468) * lu(k,3843) + lu(k,3849) = lu(k,3849) - lu(k,3469) * lu(k,3843) + lu(k,3850) = lu(k,3850) - lu(k,3470) * lu(k,3843) + lu(k,3851) = lu(k,3851) - lu(k,3471) * lu(k,3843) + lu(k,3852) = lu(k,3852) - lu(k,3472) * lu(k,3843) + lu(k,4094) = lu(k,4094) - lu(k,3464) * lu(k,4093) + lu(k,4095) = lu(k,4095) - lu(k,3465) * lu(k,4093) + lu(k,4096) = lu(k,4096) - lu(k,3466) * lu(k,4093) + lu(k,4097) = lu(k,4097) - lu(k,3467) * lu(k,4093) + lu(k,4098) = lu(k,4098) - lu(k,3468) * lu(k,4093) + lu(k,4099) = lu(k,4099) - lu(k,3469) * lu(k,4093) + lu(k,4100) = lu(k,4100) - lu(k,3470) * lu(k,4093) + lu(k,4101) = lu(k,4101) - lu(k,3471) * lu(k,4093) + lu(k,4102) = lu(k,4102) - lu(k,3472) * lu(k,4093) + lu(k,4120) = lu(k,4120) - lu(k,3464) * lu(k,4119) + lu(k,4121) = lu(k,4121) - lu(k,3465) * lu(k,4119) + lu(k,4122) = lu(k,4122) - lu(k,3466) * lu(k,4119) + lu(k,4123) = lu(k,4123) - lu(k,3467) * lu(k,4119) + lu(k,4124) = lu(k,4124) - lu(k,3468) * lu(k,4119) + lu(k,4125) = lu(k,4125) - lu(k,3469) * lu(k,4119) + lu(k,4126) = lu(k,4126) - lu(k,3470) * lu(k,4119) + lu(k,4127) = lu(k,4127) - lu(k,3471) * lu(k,4119) + lu(k,4128) = lu(k,4128) - lu(k,3472) * lu(k,4119) + lu(k,3488) = 1._r8 / lu(k,3488) + lu(k,3489) = lu(k,3489) * lu(k,3488) + lu(k,3490) = lu(k,3490) * lu(k,3488) + lu(k,3491) = lu(k,3491) * lu(k,3488) + lu(k,3492) = lu(k,3492) * lu(k,3488) + lu(k,3493) = lu(k,3493) * lu(k,3488) + lu(k,3494) = lu(k,3494) * lu(k,3488) + lu(k,3495) = lu(k,3495) * lu(k,3488) + lu(k,3496) = lu(k,3496) * lu(k,3488) + lu(k,3515) = lu(k,3515) - lu(k,3489) * lu(k,3514) + lu(k,3516) = lu(k,3516) - lu(k,3490) * lu(k,3514) + lu(k,3517) = lu(k,3517) - lu(k,3491) * lu(k,3514) + lu(k,3518) = lu(k,3518) - lu(k,3492) * lu(k,3514) + lu(k,3519) = lu(k,3519) - lu(k,3493) * lu(k,3514) + lu(k,3520) = lu(k,3520) - lu(k,3494) * lu(k,3514) + lu(k,3521) = lu(k,3521) - lu(k,3495) * lu(k,3514) + lu(k,3522) = lu(k,3522) - lu(k,3496) * lu(k,3514) + lu(k,3609) = lu(k,3609) - lu(k,3489) * lu(k,3608) + lu(k,3610) = lu(k,3610) - lu(k,3490) * lu(k,3608) + lu(k,3611) = lu(k,3611) - lu(k,3491) * lu(k,3608) + lu(k,3612) = lu(k,3612) - lu(k,3492) * lu(k,3608) + lu(k,3613) = lu(k,3613) - lu(k,3493) * lu(k,3608) + lu(k,3614) = lu(k,3614) - lu(k,3494) * lu(k,3608) + lu(k,3615) = lu(k,3615) - lu(k,3495) * lu(k,3608) + lu(k,3616) = lu(k,3616) - lu(k,3496) * lu(k,3608) + lu(k,3661) = lu(k,3661) - lu(k,3489) * lu(k,3660) + lu(k,3662) = lu(k,3662) - lu(k,3490) * lu(k,3660) + lu(k,3663) = lu(k,3663) - lu(k,3491) * lu(k,3660) + lu(k,3664) = lu(k,3664) - lu(k,3492) * lu(k,3660) + lu(k,3665) = lu(k,3665) - lu(k,3493) * lu(k,3660) + lu(k,3666) = lu(k,3666) - lu(k,3494) * lu(k,3660) + lu(k,3667) = lu(k,3667) - lu(k,3495) * lu(k,3660) + lu(k,3668) = lu(k,3668) - lu(k,3496) * lu(k,3660) + lu(k,3763) = lu(k,3763) - lu(k,3489) * lu(k,3762) + lu(k,3764) = lu(k,3764) - lu(k,3490) * lu(k,3762) + lu(k,3765) = lu(k,3765) - lu(k,3491) * lu(k,3762) + lu(k,3766) = lu(k,3766) - lu(k,3492) * lu(k,3762) + lu(k,3767) = lu(k,3767) - lu(k,3493) * lu(k,3762) + lu(k,3768) = lu(k,3768) - lu(k,3494) * lu(k,3762) + lu(k,3769) = lu(k,3769) - lu(k,3495) * lu(k,3762) + lu(k,3770) = lu(k,3770) - lu(k,3496) * lu(k,3762) + lu(k,3804) = lu(k,3804) - lu(k,3489) * lu(k,3803) + lu(k,3805) = lu(k,3805) - lu(k,3490) * lu(k,3803) + lu(k,3806) = lu(k,3806) - lu(k,3491) * lu(k,3803) + lu(k,3807) = lu(k,3807) - lu(k,3492) * lu(k,3803) + lu(k,3808) = lu(k,3808) - lu(k,3493) * lu(k,3803) + lu(k,3809) = lu(k,3809) - lu(k,3494) * lu(k,3803) + lu(k,3810) = lu(k,3810) - lu(k,3495) * lu(k,3803) + lu(k,3811) = lu(k,3811) - lu(k,3496) * lu(k,3803) + lu(k,3845) = lu(k,3845) - lu(k,3489) * lu(k,3844) + lu(k,3846) = lu(k,3846) - lu(k,3490) * lu(k,3844) + lu(k,3847) = lu(k,3847) - lu(k,3491) * lu(k,3844) + lu(k,3848) = lu(k,3848) - lu(k,3492) * lu(k,3844) + lu(k,3849) = lu(k,3849) - lu(k,3493) * lu(k,3844) + lu(k,3850) = lu(k,3850) - lu(k,3494) * lu(k,3844) + lu(k,3851) = lu(k,3851) - lu(k,3495) * lu(k,3844) + lu(k,3852) = lu(k,3852) - lu(k,3496) * lu(k,3844) + lu(k,4095) = lu(k,4095) - lu(k,3489) * lu(k,4094) + lu(k,4096) = lu(k,4096) - lu(k,3490) * lu(k,4094) + lu(k,4097) = lu(k,4097) - lu(k,3491) * lu(k,4094) + lu(k,4098) = lu(k,4098) - lu(k,3492) * lu(k,4094) + lu(k,4099) = lu(k,4099) - lu(k,3493) * lu(k,4094) + lu(k,4100) = lu(k,4100) - lu(k,3494) * lu(k,4094) + lu(k,4101) = lu(k,4101) - lu(k,3495) * lu(k,4094) + lu(k,4102) = lu(k,4102) - lu(k,3496) * lu(k,4094) + lu(k,4121) = lu(k,4121) - lu(k,3489) * lu(k,4120) + lu(k,4122) = lu(k,4122) - lu(k,3490) * lu(k,4120) + lu(k,4123) = lu(k,4123) - lu(k,3491) * lu(k,4120) + lu(k,4124) = lu(k,4124) - lu(k,3492) * lu(k,4120) + lu(k,4125) = lu(k,4125) - lu(k,3493) * lu(k,4120) + lu(k,4126) = lu(k,4126) - lu(k,3494) * lu(k,4120) + lu(k,4127) = lu(k,4127) - lu(k,3495) * lu(k,4120) + lu(k,4128) = lu(k,4128) - lu(k,3496) * lu(k,4120) + lu(k,3515) = 1._r8 / lu(k,3515) + lu(k,3516) = lu(k,3516) * lu(k,3515) + lu(k,3517) = lu(k,3517) * lu(k,3515) + lu(k,3518) = lu(k,3518) * lu(k,3515) + lu(k,3519) = lu(k,3519) * lu(k,3515) + lu(k,3520) = lu(k,3520) * lu(k,3515) + lu(k,3521) = lu(k,3521) * lu(k,3515) + lu(k,3522) = lu(k,3522) * lu(k,3515) + lu(k,3610) = lu(k,3610) - lu(k,3516) * lu(k,3609) + lu(k,3611) = lu(k,3611) - lu(k,3517) * lu(k,3609) + lu(k,3612) = lu(k,3612) - lu(k,3518) * lu(k,3609) + lu(k,3613) = lu(k,3613) - lu(k,3519) * lu(k,3609) + lu(k,3614) = lu(k,3614) - lu(k,3520) * lu(k,3609) + lu(k,3615) = lu(k,3615) - lu(k,3521) * lu(k,3609) + lu(k,3616) = lu(k,3616) - lu(k,3522) * lu(k,3609) + lu(k,3662) = lu(k,3662) - lu(k,3516) * lu(k,3661) + lu(k,3663) = lu(k,3663) - lu(k,3517) * lu(k,3661) + lu(k,3664) = lu(k,3664) - lu(k,3518) * lu(k,3661) + lu(k,3665) = lu(k,3665) - lu(k,3519) * lu(k,3661) + lu(k,3666) = lu(k,3666) - lu(k,3520) * lu(k,3661) + lu(k,3667) = lu(k,3667) - lu(k,3521) * lu(k,3661) + lu(k,3668) = lu(k,3668) - lu(k,3522) * lu(k,3661) + lu(k,3764) = lu(k,3764) - lu(k,3516) * lu(k,3763) + lu(k,3765) = lu(k,3765) - lu(k,3517) * lu(k,3763) + lu(k,3766) = lu(k,3766) - lu(k,3518) * lu(k,3763) + lu(k,3767) = lu(k,3767) - lu(k,3519) * lu(k,3763) + lu(k,3768) = lu(k,3768) - lu(k,3520) * lu(k,3763) + lu(k,3769) = lu(k,3769) - lu(k,3521) * lu(k,3763) + lu(k,3770) = lu(k,3770) - lu(k,3522) * lu(k,3763) + lu(k,3805) = lu(k,3805) - lu(k,3516) * lu(k,3804) + lu(k,3806) = lu(k,3806) - lu(k,3517) * lu(k,3804) + lu(k,3807) = lu(k,3807) - lu(k,3518) * lu(k,3804) + lu(k,3808) = lu(k,3808) - lu(k,3519) * lu(k,3804) + lu(k,3809) = lu(k,3809) - lu(k,3520) * lu(k,3804) + lu(k,3810) = lu(k,3810) - lu(k,3521) * lu(k,3804) + lu(k,3811) = lu(k,3811) - lu(k,3522) * lu(k,3804) + lu(k,3846) = lu(k,3846) - lu(k,3516) * lu(k,3845) + lu(k,3847) = lu(k,3847) - lu(k,3517) * lu(k,3845) + lu(k,3848) = lu(k,3848) - lu(k,3518) * lu(k,3845) + lu(k,3849) = lu(k,3849) - lu(k,3519) * lu(k,3845) + lu(k,3850) = lu(k,3850) - lu(k,3520) * lu(k,3845) + lu(k,3851) = lu(k,3851) - lu(k,3521) * lu(k,3845) + lu(k,3852) = lu(k,3852) - lu(k,3522) * lu(k,3845) + lu(k,4096) = lu(k,4096) - lu(k,3516) * lu(k,4095) + lu(k,4097) = lu(k,4097) - lu(k,3517) * lu(k,4095) + lu(k,4098) = lu(k,4098) - lu(k,3518) * lu(k,4095) + lu(k,4099) = lu(k,4099) - lu(k,3519) * lu(k,4095) + lu(k,4100) = lu(k,4100) - lu(k,3520) * lu(k,4095) + lu(k,4101) = lu(k,4101) - lu(k,3521) * lu(k,4095) + lu(k,4102) = lu(k,4102) - lu(k,3522) * lu(k,4095) + lu(k,4122) = lu(k,4122) - lu(k,3516) * lu(k,4121) + lu(k,4123) = lu(k,4123) - lu(k,3517) * lu(k,4121) + lu(k,4124) = lu(k,4124) - lu(k,3518) * lu(k,4121) + lu(k,4125) = lu(k,4125) - lu(k,3519) * lu(k,4121) + lu(k,4126) = lu(k,4126) - lu(k,3520) * lu(k,4121) + lu(k,4127) = lu(k,4127) - lu(k,3521) * lu(k,4121) + lu(k,4128) = lu(k,4128) - lu(k,3522) * lu(k,4121) + lu(k,3610) = 1._r8 / lu(k,3610) + lu(k,3611) = lu(k,3611) * lu(k,3610) + lu(k,3612) = lu(k,3612) * lu(k,3610) + lu(k,3613) = lu(k,3613) * lu(k,3610) + lu(k,3614) = lu(k,3614) * lu(k,3610) + lu(k,3615) = lu(k,3615) * lu(k,3610) + lu(k,3616) = lu(k,3616) * lu(k,3610) + lu(k,3663) = lu(k,3663) - lu(k,3611) * lu(k,3662) + lu(k,3664) = lu(k,3664) - lu(k,3612) * lu(k,3662) + lu(k,3665) = lu(k,3665) - lu(k,3613) * lu(k,3662) + lu(k,3666) = lu(k,3666) - lu(k,3614) * lu(k,3662) + lu(k,3667) = lu(k,3667) - lu(k,3615) * lu(k,3662) + lu(k,3668) = lu(k,3668) - lu(k,3616) * lu(k,3662) + lu(k,3765) = lu(k,3765) - lu(k,3611) * lu(k,3764) + lu(k,3766) = lu(k,3766) - lu(k,3612) * lu(k,3764) + lu(k,3767) = lu(k,3767) - lu(k,3613) * lu(k,3764) + lu(k,3768) = lu(k,3768) - lu(k,3614) * lu(k,3764) + lu(k,3769) = lu(k,3769) - lu(k,3615) * lu(k,3764) + lu(k,3770) = lu(k,3770) - lu(k,3616) * lu(k,3764) + lu(k,3806) = lu(k,3806) - lu(k,3611) * lu(k,3805) + lu(k,3807) = lu(k,3807) - lu(k,3612) * lu(k,3805) + lu(k,3808) = lu(k,3808) - lu(k,3613) * lu(k,3805) + lu(k,3809) = lu(k,3809) - lu(k,3614) * lu(k,3805) + lu(k,3810) = lu(k,3810) - lu(k,3615) * lu(k,3805) + lu(k,3811) = lu(k,3811) - lu(k,3616) * lu(k,3805) + lu(k,3847) = lu(k,3847) - lu(k,3611) * lu(k,3846) + lu(k,3848) = lu(k,3848) - lu(k,3612) * lu(k,3846) + lu(k,3849) = lu(k,3849) - lu(k,3613) * lu(k,3846) + lu(k,3850) = lu(k,3850) - lu(k,3614) * lu(k,3846) + lu(k,3851) = lu(k,3851) - lu(k,3615) * lu(k,3846) + lu(k,3852) = lu(k,3852) - lu(k,3616) * lu(k,3846) + lu(k,4097) = lu(k,4097) - lu(k,3611) * lu(k,4096) + lu(k,4098) = lu(k,4098) - lu(k,3612) * lu(k,4096) + lu(k,4099) = lu(k,4099) - lu(k,3613) * lu(k,4096) + lu(k,4100) = lu(k,4100) - lu(k,3614) * lu(k,4096) + lu(k,4101) = lu(k,4101) - lu(k,3615) * lu(k,4096) + lu(k,4102) = lu(k,4102) - lu(k,3616) * lu(k,4096) + lu(k,4123) = lu(k,4123) - lu(k,3611) * lu(k,4122) + lu(k,4124) = lu(k,4124) - lu(k,3612) * lu(k,4122) + lu(k,4125) = lu(k,4125) - lu(k,3613) * lu(k,4122) + lu(k,4126) = lu(k,4126) - lu(k,3614) * lu(k,4122) + lu(k,4127) = lu(k,4127) - lu(k,3615) * lu(k,4122) + lu(k,4128) = lu(k,4128) - lu(k,3616) * lu(k,4122) + lu(k,3663) = 1._r8 / lu(k,3663) + lu(k,3664) = lu(k,3664) * lu(k,3663) + lu(k,3665) = lu(k,3665) * lu(k,3663) + lu(k,3666) = lu(k,3666) * lu(k,3663) + lu(k,3667) = lu(k,3667) * lu(k,3663) + lu(k,3668) = lu(k,3668) * lu(k,3663) + lu(k,3766) = lu(k,3766) - lu(k,3664) * lu(k,3765) + lu(k,3767) = lu(k,3767) - lu(k,3665) * lu(k,3765) + lu(k,3768) = lu(k,3768) - lu(k,3666) * lu(k,3765) + lu(k,3769) = lu(k,3769) - lu(k,3667) * lu(k,3765) + lu(k,3770) = lu(k,3770) - lu(k,3668) * lu(k,3765) + lu(k,3807) = lu(k,3807) - lu(k,3664) * lu(k,3806) + lu(k,3808) = lu(k,3808) - lu(k,3665) * lu(k,3806) + lu(k,3809) = lu(k,3809) - lu(k,3666) * lu(k,3806) + lu(k,3810) = lu(k,3810) - lu(k,3667) * lu(k,3806) + lu(k,3811) = lu(k,3811) - lu(k,3668) * lu(k,3806) + lu(k,3848) = lu(k,3848) - lu(k,3664) * lu(k,3847) + lu(k,3849) = lu(k,3849) - lu(k,3665) * lu(k,3847) + lu(k,3850) = lu(k,3850) - lu(k,3666) * lu(k,3847) + lu(k,3851) = lu(k,3851) - lu(k,3667) * lu(k,3847) + lu(k,3852) = lu(k,3852) - lu(k,3668) * lu(k,3847) + lu(k,4098) = lu(k,4098) - lu(k,3664) * lu(k,4097) + lu(k,4099) = lu(k,4099) - lu(k,3665) * lu(k,4097) + lu(k,4100) = lu(k,4100) - lu(k,3666) * lu(k,4097) + lu(k,4101) = lu(k,4101) - lu(k,3667) * lu(k,4097) + lu(k,4102) = lu(k,4102) - lu(k,3668) * lu(k,4097) + lu(k,4124) = lu(k,4124) - lu(k,3664) * lu(k,4123) + lu(k,4125) = lu(k,4125) - lu(k,3665) * lu(k,4123) + lu(k,4126) = lu(k,4126) - lu(k,3666) * lu(k,4123) + lu(k,4127) = lu(k,4127) - lu(k,3667) * lu(k,4123) + lu(k,4128) = lu(k,4128) - lu(k,3668) * lu(k,4123) + end do + end subroutine lu_fac54 + subroutine lu_fac55( 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,3766) = 1._r8 / lu(k,3766) + lu(k,3767) = lu(k,3767) * lu(k,3766) + lu(k,3768) = lu(k,3768) * lu(k,3766) + lu(k,3769) = lu(k,3769) * lu(k,3766) + lu(k,3770) = lu(k,3770) * lu(k,3766) + lu(k,3808) = lu(k,3808) - lu(k,3767) * lu(k,3807) + lu(k,3809) = lu(k,3809) - lu(k,3768) * lu(k,3807) + lu(k,3810) = lu(k,3810) - lu(k,3769) * lu(k,3807) + lu(k,3811) = lu(k,3811) - lu(k,3770) * lu(k,3807) + lu(k,3849) = lu(k,3849) - lu(k,3767) * lu(k,3848) + lu(k,3850) = lu(k,3850) - lu(k,3768) * lu(k,3848) + lu(k,3851) = lu(k,3851) - lu(k,3769) * lu(k,3848) + lu(k,3852) = lu(k,3852) - lu(k,3770) * lu(k,3848) + lu(k,4099) = lu(k,4099) - lu(k,3767) * lu(k,4098) + lu(k,4100) = lu(k,4100) - lu(k,3768) * lu(k,4098) + lu(k,4101) = lu(k,4101) - lu(k,3769) * lu(k,4098) + lu(k,4102) = lu(k,4102) - lu(k,3770) * lu(k,4098) + lu(k,4125) = lu(k,4125) - lu(k,3767) * lu(k,4124) + lu(k,4126) = lu(k,4126) - lu(k,3768) * lu(k,4124) + lu(k,4127) = lu(k,4127) - lu(k,3769) * lu(k,4124) + lu(k,4128) = lu(k,4128) - lu(k,3770) * lu(k,4124) + lu(k,3808) = 1._r8 / lu(k,3808) + lu(k,3809) = lu(k,3809) * lu(k,3808) + lu(k,3810) = lu(k,3810) * lu(k,3808) + lu(k,3811) = lu(k,3811) * lu(k,3808) + lu(k,3850) = lu(k,3850) - lu(k,3809) * lu(k,3849) + lu(k,3851) = lu(k,3851) - lu(k,3810) * lu(k,3849) + lu(k,3852) = lu(k,3852) - lu(k,3811) * lu(k,3849) + lu(k,4100) = lu(k,4100) - lu(k,3809) * lu(k,4099) + lu(k,4101) = lu(k,4101) - lu(k,3810) * lu(k,4099) + lu(k,4102) = lu(k,4102) - lu(k,3811) * lu(k,4099) + lu(k,4126) = lu(k,4126) - lu(k,3809) * lu(k,4125) + lu(k,4127) = lu(k,4127) - lu(k,3810) * lu(k,4125) + lu(k,4128) = lu(k,4128) - lu(k,3811) * lu(k,4125) + lu(k,3850) = 1._r8 / lu(k,3850) + lu(k,3851) = lu(k,3851) * lu(k,3850) + lu(k,3852) = lu(k,3852) * lu(k,3850) + lu(k,4101) = lu(k,4101) - lu(k,3851) * lu(k,4100) + lu(k,4102) = lu(k,4102) - lu(k,3852) * lu(k,4100) + lu(k,4127) = lu(k,4127) - lu(k,3851) * lu(k,4126) + lu(k,4128) = lu(k,4128) - lu(k,3852) * lu(k,4126) + lu(k,4101) = 1._r8 / lu(k,4101) + lu(k,4102) = lu(k,4102) * lu(k,4101) + lu(k,4128) = lu(k,4128) - lu(k,4102) * lu(k,4127) + lu(k,4128) = 1._r8 / lu(k,4128) + end do + end subroutine lu_fac55 + 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 ) + call lu_fac19( avec_len, lu ) + call lu_fac20( avec_len, lu ) + call lu_fac21( avec_len, lu ) + call lu_fac22( avec_len, lu ) + call lu_fac23( avec_len, lu ) + call lu_fac24( avec_len, lu ) + call lu_fac25( avec_len, lu ) + call lu_fac26( avec_len, lu ) + call lu_fac27( avec_len, lu ) + call lu_fac28( avec_len, lu ) + call lu_fac29( avec_len, lu ) + call lu_fac30( avec_len, lu ) + call lu_fac31( avec_len, lu ) + call lu_fac32( avec_len, lu ) + call lu_fac33( avec_len, lu ) + call lu_fac34( avec_len, lu ) + call lu_fac35( avec_len, lu ) + call lu_fac36( avec_len, lu ) + call lu_fac37( avec_len, lu ) + call lu_fac38( avec_len, lu ) + call lu_fac39( avec_len, lu ) + call lu_fac40( avec_len, lu ) + call lu_fac41( avec_len, lu ) + call lu_fac42( avec_len, lu ) + call lu_fac43( avec_len, lu ) + call lu_fac44( avec_len, lu ) + call lu_fac45( avec_len, lu ) + call lu_fac46( avec_len, lu ) + call lu_fac47( avec_len, lu ) + call lu_fac48( avec_len, lu ) + call lu_fac49( avec_len, lu ) + call lu_fac50( avec_len, lu ) + call lu_fac51( avec_len, lu ) + call lu_fac52( avec_len, lu ) + call lu_fac53( avec_len, lu ) + call lu_fac54( avec_len, lu ) + call lu_fac55( avec_len, lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_trop_strat_mam5_ts2/mo_lu_solve.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/mo_lu_solve.F90 new file mode 100644 index 0000000000..d1088593a0 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/mo_lu_solve.F90 @@ -0,0 +1,4568 @@ + 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,310) = b(k,310) - lu(k,115) * b(k,58) + b(k,315) = b(k,315) - lu(k,116) * b(k,58) + b(k,316) = b(k,316) - lu(k,118) * b(k,59) + b(k,317) = b(k,317) - lu(k,119) * b(k,59) + b(k,314) = b(k,314) - lu(k,121) * b(k,60) + b(k,315) = b(k,315) - lu(k,122) * b(k,60) + b(k,307) = b(k,307) - lu(k,124) * b(k,61) + b(k,316) = b(k,316) - lu(k,125) * b(k,61) + b(k,90) = b(k,90) - lu(k,127) * b(k,62) + b(k,276) = b(k,276) - lu(k,128) * b(k,62) + b(k,314) = b(k,314) - lu(k,129) * b(k,62) + b(k,198) = b(k,198) - lu(k,131) * b(k,63) + b(k,316) = b(k,316) - lu(k,132) * b(k,63) + b(k,317) = b(k,317) - lu(k,133) * b(k,63) + b(k,92) = b(k,92) - lu(k,135) * b(k,64) + b(k,314) = b(k,314) - lu(k,136) * b(k,64) + b(k,315) = b(k,315) - lu(k,137) * b(k,64) + b(k,90) = b(k,90) - lu(k,139) * b(k,65) + b(k,314) = b(k,314) - lu(k,140) * b(k,65) + b(k,315) = b(k,315) - lu(k,141) * b(k,65) + b(k,90) = b(k,90) - lu(k,143) * b(k,66) + b(k,314) = b(k,314) - lu(k,144) * b(k,66) + b(k,315) = b(k,315) - lu(k,145) * b(k,66) + b(k,315) = b(k,315) - lu(k,147) * b(k,67) + b(k,316) = b(k,316) - lu(k,148) * b(k,67) + b(k,317) = b(k,317) - lu(k,149) * b(k,67) + b(k,101) = b(k,101) - lu(k,151) * b(k,68) + b(k,316) = b(k,316) - lu(k,152) * b(k,68) + b(k,98) = b(k,98) - lu(k,154) * b(k,69) + b(k,317) = b(k,317) - lu(k,155) * b(k,69) + b(k,144) = b(k,144) - lu(k,157) * b(k,70) + b(k,312) = b(k,312) - lu(k,158) * b(k,70) + b(k,90) = b(k,90) - lu(k,160) * b(k,71) + b(k,276) = b(k,276) - lu(k,161) * b(k,71) + b(k,314) = b(k,314) - lu(k,162) * b(k,71) + b(k,315) = b(k,315) - lu(k,163) * b(k,71) + b(k,90) = b(k,90) - lu(k,165) * b(k,72) + b(k,217) = b(k,217) - lu(k,166) * b(k,72) + b(k,276) = b(k,276) - lu(k,167) * b(k,72) + b(k,314) = b(k,314) - lu(k,168) * b(k,72) + b(k,90) = b(k,90) - lu(k,170) * b(k,73) + b(k,92) = b(k,92) - lu(k,171) * b(k,73) + b(k,314) = b(k,314) - lu(k,172) * b(k,73) + b(k,315) = b(k,315) - lu(k,173) * b(k,73) + b(k,90) = b(k,90) - lu(k,175) * b(k,74) + b(k,217) = b(k,217) - lu(k,176) * b(k,74) + b(k,314) = b(k,314) - lu(k,177) * b(k,74) + b(k,315) = b(k,315) - lu(k,178) * b(k,74) + b(k,315) = b(k,315) - lu(k,180) * b(k,75) + b(k,77) = b(k,77) - lu(k,183) * b(k,76) + b(k,78) = b(k,78) - lu(k,184) * b(k,76) + b(k,139) = b(k,139) - lu(k,185) * b(k,76) + b(k,307) = b(k,307) - lu(k,186) * b(k,76) + b(k,316) = b(k,316) - lu(k,187) * b(k,76) + b(k,132) = b(k,132) - lu(k,189) * b(k,77) + b(k,271) = b(k,271) - lu(k,190) * b(k,77) + b(k,307) = b(k,307) - lu(k,191) * b(k,77) + b(k,130) = b(k,130) - lu(k,193) * b(k,78) + b(k,135) = b(k,135) - lu(k,194) * b(k,78) + b(k,307) = b(k,307) - lu(k,195) * b(k,78) + b(k,316) = b(k,316) - lu(k,196) * b(k,78) + b(k,307) = b(k,307) - lu(k,198) * b(k,79) + b(k,314) = b(k,314) - lu(k,199) * b(k,79) + b(k,316) = b(k,316) - lu(k,200) * b(k,79) + b(k,303) = b(k,303) - lu(k,202) * b(k,80) + b(k,314) = b(k,314) - lu(k,203) * b(k,80) + b(k,211) = b(k,211) - lu(k,205) * b(k,81) + b(k,316) = b(k,316) - lu(k,206) * b(k,81) + b(k,302) = b(k,302) - lu(k,208) * b(k,82) + b(k,312) = b(k,312) - lu(k,209) * b(k,82) + b(k,84) = b(k,84) - lu(k,212) * b(k,83) + b(k,85) = b(k,85) - lu(k,213) * b(k,83) + b(k,127) = b(k,127) - lu(k,214) * b(k,83) + b(k,181) = b(k,181) - lu(k,215) * b(k,83) + b(k,307) = b(k,307) - lu(k,216) * b(k,83) + b(k,316) = b(k,316) - lu(k,217) * b(k,83) + b(k,130) = b(k,130) - lu(k,219) * b(k,84) + b(k,135) = b(k,135) - lu(k,220) * b(k,84) + b(k,307) = b(k,307) - lu(k,221) * b(k,84) + b(k,316) = b(k,316) - lu(k,222) * b(k,84) + b(k,271) = b(k,271) - lu(k,224) * b(k,85) + b(k,300) = b(k,300) - lu(k,225) * b(k,85) + b(k,307) = b(k,307) - lu(k,226) * b(k,85) + b(k,87) = b(k,87) - lu(k,230) * b(k,86) + b(k,127) = b(k,127) - lu(k,231) * b(k,86) + b(k,183) = b(k,183) - lu(k,232) * b(k,86) + b(k,271) = b(k,271) - lu(k,233) * b(k,86) + b(k,300) = b(k,300) - lu(k,234) * b(k,86) + b(k,307) = b(k,307) - lu(k,235) * b(k,86) + b(k,316) = b(k,316) - lu(k,236) * b(k,86) + b(k,135) = b(k,135) - lu(k,238) * b(k,87) + b(k,142) = b(k,142) - lu(k,239) * b(k,87) + b(k,307) = b(k,307) - lu(k,240) * b(k,87) + b(k,316) = b(k,316) - lu(k,241) * b(k,87) + b(k,276) = b(k,276) - lu(k,243) * b(k,88) + b(k,315) = b(k,315) - lu(k,244) * b(k,88) + b(k,144) = b(k,144) - lu(k,246) * b(k,89) + b(k,316) = b(k,316) - lu(k,247) * b(k,89) + b(k,217) = b(k,217) - lu(k,249) * b(k,90) + b(k,314) = b(k,314) - lu(k,250) * b(k,90) + b(k,92) = b(k,92) - lu(k,252) * b(k,91) + b(k,314) = b(k,314) - lu(k,253) * b(k,91) + b(k,315) = b(k,315) - lu(k,254) * b(k,91) + b(k,316) = b(k,316) - lu(k,255) * b(k,91) + b(k,217) = b(k,217) - lu(k,257) * b(k,92) + b(k,314) = b(k,314) - lu(k,258) * b(k,92) + b(k,315) = b(k,315) - lu(k,259) * b(k,92) + b(k,217) = b(k,217) - lu(k,262) * b(k,93) + b(k,314) = b(k,314) - lu(k,263) * b(k,93) + b(k,315) = b(k,315) - lu(k,264) * b(k,93) + b(k,316) = b(k,316) - lu(k,265) * b(k,93) + b(k,262) = b(k,262) - lu(k,267) * b(k,94) + b(k,267) = b(k,267) - lu(k,268) * b(k,94) + b(k,256) = b(k,256) - lu(k,270) * b(k,95) + b(k,267) = b(k,267) - lu(k,271) * b(k,95) + b(k,261) = b(k,261) - lu(k,273) * b(k,96) + b(k,268) = b(k,268) - lu(k,274) * b(k,96) + b(k,257) = b(k,257) - lu(k,276) * b(k,97) + b(k,268) = b(k,268) - lu(k,277) * b(k,97) + b(k,216) = b(k,216) - lu(k,280) * b(k,98) + b(k,305) = b(k,305) - lu(k,281) * b(k,98) + b(k,317) = b(k,317) - lu(k,282) * b(k,98) + b(k,230) = b(k,230) - lu(k,284) * b(k,99) + b(k,307) = b(k,307) - lu(k,285) * b(k,99) + b(k,316) = b(k,316) - lu(k,286) * b(k,99) + b(k,135) = b(k,135) - lu(k,288) * b(k,100) + b(k,164) = b(k,164) - lu(k,289) * b(k,100) + b(k,316) = b(k,316) - lu(k,290) * b(k,100) + b(k,254) = b(k,254) - lu(k,292) * b(k,101) + b(k,306) = b(k,306) - lu(k,293) * b(k,101) + b(k,307) = b(k,307) - lu(k,294) * b(k,101) + b(k,302) = b(k,302) - lu(k,296) * b(k,102) + b(k,303) = b(k,303) - lu(k,297) * b(k,102) + b(k,305) = b(k,305) - lu(k,298) * b(k,102) + b(k,311) = b(k,311) - lu(k,299) * b(k,102) + b(k,312) = b(k,312) - lu(k,300) * b(k,102) + b(k,184) = b(k,184) - lu(k,302) * b(k,103) + b(k,307) = b(k,307) - lu(k,303) * b(k,103) + b(k,216) = b(k,216) - lu(k,305) * b(k,104) + b(k,302) = b(k,302) - lu(k,306) * b(k,104) + b(k,307) = b(k,307) - lu(k,307) * b(k,104) + b(k,311) = b(k,311) - lu(k,308) * b(k,104) + b(k,316) = b(k,316) - lu(k,309) * b(k,104) + b(k,227) = b(k,227) - lu(k,311) * b(k,105) + b(k,235) = b(k,235) - lu(k,312) * b(k,105) + b(k,271) = b(k,271) - lu(k,313) * b(k,105) + b(k,307) = b(k,307) - lu(k,314) * b(k,105) + b(k,316) = b(k,316) - lu(k,315) * b(k,105) + b(k,225) = b(k,225) - lu(k,317) * b(k,106) + b(k,304) = b(k,304) - lu(k,318) * b(k,106) + b(k,315) = b(k,315) - lu(k,319) * b(k,106) + b(k,316) = b(k,316) - lu(k,320) * b(k,106) + b(k,317) = b(k,317) - lu(k,321) * b(k,106) + b(k,217) = b(k,217) - lu(k,323) * b(k,107) + b(k,301) = b(k,301) - lu(k,324) * b(k,107) + b(k,217) = b(k,217) - lu(k,327) * b(k,108) + b(k,314) = b(k,314) - lu(k,328) * b(k,108) + b(k,315) = b(k,315) - lu(k,329) * b(k,108) + b(k,316) = b(k,316) - lu(k,330) * b(k,108) + b(k,317) = b(k,317) - lu(k,331) * b(k,108) + b(k,169) = b(k,169) - lu(k,333) * b(k,109) + b(k,230) = b(k,230) - lu(k,334) * b(k,109) + b(k,300) = b(k,300) - lu(k,335) * b(k,109) + b(k,316) = b(k,316) - lu(k,336) * b(k,109) + b(k,266) = b(k,266) - lu(k,338) * b(k,110) + b(k,271) = b(k,271) - lu(k,339) * b(k,110) + b(k,300) = b(k,300) - lu(k,340) * b(k,110) + b(k,307) = b(k,307) - lu(k,341) * b(k,110) + b(k,216) = b(k,216) - lu(k,343) * b(k,111) + b(k,246) = b(k,246) - lu(k,344) * b(k,111) + b(k,305) = b(k,305) - lu(k,345) * b(k,111) + b(k,310) = b(k,310) - lu(k,346) * b(k,111) + b(k,130) = b(k,130) - lu(k,348) * b(k,112) + b(k,235) = b(k,235) - lu(k,349) * b(k,112) + b(k,307) = b(k,307) - lu(k,350) * b(k,112) + b(k,316) = b(k,316) - lu(k,351) * b(k,112) + b(k,127) = b(k,127) - lu(k,354) * b(k,113) + b(k,144) = b(k,144) - lu(k,355) * b(k,113) + b(k,307) = b(k,307) - lu(k,356) * b(k,113) + b(k,316) = b(k,316) - lu(k,357) * b(k,113) + b(k,225) = b(k,225) - lu(k,359) * b(k,114) + b(k,230) = b(k,230) - lu(k,360) * b(k,114) + b(k,307) = b(k,307) - lu(k,361) * b(k,114) + b(k,316) = b(k,316) - lu(k,362) * b(k,114) + b(k,247) = b(k,247) - lu(k,364) * b(k,115) + b(k,296) = b(k,296) - lu(k,365) * b(k,115) + b(k,297) = b(k,297) - lu(k,366) * b(k,115) + b(k,316) = b(k,316) - lu(k,367) * b(k,115) + b(k,247) = b(k,247) - lu(k,369) * b(k,116) + b(k,295) = b(k,295) - lu(k,370) * b(k,116) + b(k,298) = b(k,298) - lu(k,371) * b(k,116) + b(k,316) = b(k,316) - lu(k,372) * b(k,116) + b(k,161) = b(k,161) - lu(k,374) * b(k,117) + b(k,307) = b(k,307) - lu(k,375) * b(k,117) + b(k,316) = b(k,316) - lu(k,376) * b(k,117) + b(k,152) = b(k,152) - lu(k,378) * b(k,118) + b(k,230) = b(k,230) - lu(k,379) * b(k,118) + b(k,280) = b(k,280) - lu(k,380) * b(k,118) + b(k,306) = b(k,306) - lu(k,381) * b(k,118) + b(k,311) = b(k,311) - lu(k,382) * b(k,118) + b(k,312) = b(k,312) - lu(k,383) * b(k,118) + b(k,316) = b(k,316) - lu(k,384) * b(k,118) + 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,143) = b(k,143) - lu(k,386) * b(k,119) + b(k,216) = b(k,216) - lu(k,387) * b(k,119) + b(k,246) = b(k,246) - lu(k,388) * b(k,119) + b(k,271) = b(k,271) - lu(k,389) * b(k,119) + b(k,301) = b(k,301) - lu(k,390) * b(k,119) + b(k,305) = b(k,305) - lu(k,391) * b(k,119) + b(k,316) = b(k,316) - lu(k,392) * b(k,119) + b(k,271) = b(k,271) - lu(k,394) * b(k,120) + b(k,304) = b(k,304) - lu(k,395) * b(k,120) + b(k,307) = b(k,307) - lu(k,396) * b(k,120) + b(k,308) = b(k,308) - lu(k,397) * b(k,120) + b(k,315) = b(k,315) - lu(k,398) * b(k,120) + b(k,316) = b(k,316) - lu(k,399) * b(k,120) + b(k,317) = b(k,317) - lu(k,400) * b(k,120) + b(k,188) = b(k,188) - lu(k,402) * b(k,121) + b(k,271) = b(k,271) - lu(k,403) * b(k,121) + b(k,307) = b(k,307) - lu(k,404) * b(k,121) + b(k,224) = b(k,224) - lu(k,406) * b(k,122) + b(k,300) = b(k,300) - lu(k,407) * b(k,122) + b(k,306) = b(k,306) - lu(k,408) * b(k,122) + b(k,316) = b(k,316) - lu(k,409) * b(k,122) + b(k,317) = b(k,317) - lu(k,410) * b(k,122) + b(k,198) = b(k,198) - lu(k,412) * b(k,123) + b(k,280) = b(k,280) - lu(k,413) * b(k,123) + b(k,307) = b(k,307) - lu(k,414) * b(k,123) + b(k,316) = b(k,316) - lu(k,415) * b(k,123) + b(k,317) = b(k,317) - lu(k,416) * b(k,123) + b(k,132) = b(k,132) - lu(k,418) * b(k,124) + b(k,139) = b(k,139) - lu(k,419) * b(k,124) + b(k,235) = b(k,235) - lu(k,420) * b(k,124) + b(k,307) = b(k,307) - lu(k,421) * b(k,124) + b(k,316) = b(k,316) - lu(k,422) * b(k,124) + b(k,220) = b(k,220) - lu(k,424) * b(k,125) + b(k,271) = b(k,271) - lu(k,425) * b(k,125) + b(k,299) = b(k,299) - lu(k,426) * b(k,125) + b(k,312) = b(k,312) - lu(k,427) * b(k,125) + b(k,316) = b(k,316) - lu(k,428) * b(k,125) + b(k,142) = b(k,142) - lu(k,430) * b(k,126) + b(k,235) = b(k,235) - lu(k,431) * b(k,126) + b(k,266) = b(k,266) - lu(k,432) * b(k,126) + b(k,307) = b(k,307) - lu(k,433) * b(k,126) + b(k,316) = b(k,316) - lu(k,434) * b(k,126) + b(k,144) = b(k,144) - lu(k,438) * b(k,127) + b(k,303) = b(k,303) - lu(k,439) * b(k,127) + b(k,307) = b(k,307) - lu(k,440) * b(k,127) + b(k,312) = b(k,312) - lu(k,441) * b(k,127) + b(k,316) = b(k,316) - lu(k,442) * b(k,127) + b(k,307) = b(k,307) - lu(k,444) * b(k,128) + b(k,311) = b(k,311) - lu(k,445) * b(k,128) + b(k,312) = b(k,312) - lu(k,446) * b(k,128) + b(k,316) = b(k,316) - lu(k,447) * b(k,128) + b(k,317) = b(k,317) - lu(k,448) * b(k,128) + b(k,301) = b(k,301) - lu(k,450) * b(k,129) + b(k,306) = b(k,306) - lu(k,451) * b(k,129) + b(k,308) = b(k,308) - lu(k,452) * b(k,129) + b(k,316) = b(k,316) - lu(k,453) * b(k,129) + b(k,317) = b(k,317) - lu(k,454) * b(k,129) + b(k,235) = b(k,235) - lu(k,457) * b(k,130) + b(k,303) = b(k,303) - lu(k,458) * b(k,130) + b(k,307) = b(k,307) - lu(k,459) * b(k,130) + b(k,312) = b(k,312) - lu(k,460) * b(k,130) + b(k,316) = b(k,316) - lu(k,461) * b(k,130) + b(k,276) = b(k,276) - lu(k,463) * b(k,131) + b(k,304) = b(k,304) - lu(k,464) * b(k,131) + b(k,314) = b(k,314) - lu(k,465) * b(k,131) + b(k,315) = b(k,315) - lu(k,466) * b(k,131) + b(k,316) = b(k,316) - lu(k,467) * b(k,131) + b(k,180) = b(k,180) - lu(k,469) * b(k,132) + b(k,307) = b(k,307) - lu(k,470) * b(k,132) + b(k,196) = b(k,196) - lu(k,472) * b(k,133) + b(k,292) = b(k,292) - lu(k,473) * b(k,133) + b(k,307) = b(k,307) - lu(k,474) * b(k,133) + b(k,316) = b(k,316) - lu(k,475) * b(k,133) + b(k,301) = b(k,301) - lu(k,478) * b(k,134) + b(k,303) = b(k,303) - lu(k,479) * b(k,134) + b(k,305) = b(k,305) - lu(k,480) * b(k,134) + b(k,312) = b(k,312) - lu(k,481) * b(k,134) + b(k,314) = b(k,314) - lu(k,482) * b(k,134) + b(k,316) = b(k,316) - lu(k,483) * b(k,134) + b(k,164) = b(k,164) - lu(k,485) * b(k,135) + b(k,312) = b(k,312) - lu(k,486) * b(k,135) + b(k,313) = b(k,313) - lu(k,487) * b(k,135) + b(k,185) = b(k,185) - lu(k,489) * b(k,136) + b(k,239) = b(k,239) - lu(k,490) * b(k,136) + b(k,270) = b(k,270) - lu(k,491) * b(k,136) + b(k,271) = b(k,271) - lu(k,492) * b(k,136) + b(k,307) = b(k,307) - lu(k,493) * b(k,136) + b(k,316) = b(k,316) - lu(k,494) * b(k,136) + b(k,276) = b(k,276) - lu(k,496) * b(k,137) + b(k,304) = b(k,304) - lu(k,497) * b(k,137) + b(k,314) = b(k,314) - lu(k,498) * b(k,137) + b(k,315) = b(k,315) - lu(k,499) * b(k,137) + b(k,316) = b(k,316) - lu(k,500) * b(k,137) + b(k,317) = b(k,317) - lu(k,501) * b(k,137) + b(k,185) = b(k,185) - lu(k,503) * b(k,138) + b(k,227) = b(k,227) - lu(k,504) * b(k,138) + b(k,249) = b(k,249) - lu(k,505) * b(k,138) + b(k,266) = b(k,266) - lu(k,506) * b(k,138) + b(k,302) = b(k,302) - lu(k,507) * b(k,138) + b(k,306) = b(k,306) - lu(k,508) * b(k,138) + b(k,307) = b(k,307) - lu(k,509) * b(k,138) + b(k,312) = b(k,312) - lu(k,510) * b(k,138) + b(k,316) = b(k,316) - lu(k,511) * b(k,138) + b(k,180) = b(k,180) - lu(k,515) * b(k,139) + b(k,235) = b(k,235) - lu(k,516) * b(k,139) + b(k,303) = b(k,303) - lu(k,517) * b(k,139) + b(k,307) = b(k,307) - lu(k,518) * b(k,139) + b(k,312) = b(k,312) - lu(k,519) * b(k,139) + b(k,316) = b(k,316) - lu(k,520) * b(k,139) + b(k,185) = b(k,185) - lu(k,522) * b(k,140) + b(k,233) = b(k,233) - lu(k,523) * b(k,140) + b(k,269) = b(k,269) - lu(k,524) * b(k,140) + b(k,271) = b(k,271) - lu(k,525) * b(k,140) + b(k,307) = b(k,307) - lu(k,526) * b(k,140) + b(k,316) = b(k,316) - lu(k,527) * b(k,140) + b(k,248) = b(k,248) - lu(k,529) * b(k,141) + b(k,258) = b(k,258) - lu(k,530) * b(k,141) + b(k,271) = b(k,271) - lu(k,531) * b(k,141) + b(k,311) = b(k,311) - lu(k,532) * b(k,141) + b(k,312) = b(k,312) - lu(k,533) * b(k,141) + b(k,316) = b(k,316) - lu(k,534) * b(k,141) + b(k,235) = b(k,235) - lu(k,537) * b(k,142) + b(k,266) = b(k,266) - lu(k,538) * b(k,142) + b(k,303) = b(k,303) - lu(k,539) * b(k,142) + b(k,307) = b(k,307) - lu(k,540) * b(k,142) + b(k,312) = b(k,312) - lu(k,541) * b(k,142) + b(k,316) = b(k,316) - lu(k,542) * b(k,142) + b(k,246) = b(k,246) - lu(k,544) * b(k,143) + b(k,301) = b(k,301) - lu(k,545) * b(k,143) + b(k,305) = b(k,305) - lu(k,546) * b(k,143) + b(k,313) = b(k,313) - lu(k,547) * b(k,143) + b(k,316) = b(k,316) - lu(k,548) * b(k,143) + b(k,164) = b(k,164) - lu(k,551) * b(k,144) + b(k,303) = b(k,303) - lu(k,552) * b(k,144) + b(k,307) = b(k,307) - lu(k,553) * b(k,144) + b(k,312) = b(k,312) - lu(k,554) * b(k,144) + b(k,316) = b(k,316) - lu(k,555) * b(k,144) + b(k,169) = b(k,169) - lu(k,557) * b(k,145) + b(k,225) = b(k,225) - lu(k,558) * b(k,145) + b(k,300) = b(k,300) - lu(k,559) * b(k,145) + b(k,316) = b(k,316) - lu(k,560) * b(k,145) + b(k,195) = b(k,195) - lu(k,562) * b(k,146) + b(k,276) = b(k,276) - lu(k,563) * b(k,146) + b(k,302) = b(k,302) - lu(k,564) * b(k,146) + b(k,305) = b(k,305) - lu(k,565) * b(k,146) + b(k,309) = b(k,309) - lu(k,566) * b(k,146) + b(k,311) = b(k,311) - lu(k,567) * b(k,146) + b(k,312) = b(k,312) - lu(k,568) * b(k,146) + b(k,247) = b(k,247) - lu(k,570) * b(k,147) + b(k,300) = b(k,300) - lu(k,571) * b(k,147) + b(k,306) = b(k,306) - lu(k,572) * b(k,147) + b(k,308) = b(k,308) - lu(k,573) * b(k,147) + b(k,311) = b(k,311) - lu(k,574) * b(k,147) + b(k,312) = b(k,312) - lu(k,575) * b(k,147) + b(k,316) = b(k,316) - lu(k,576) * b(k,147) + b(k,189) = b(k,189) - lu(k,578) * b(k,148) + b(k,230) = b(k,230) - lu(k,579) * b(k,148) + b(k,258) = b(k,258) - lu(k,580) * b(k,148) + b(k,306) = b(k,306) - lu(k,581) * b(k,148) + b(k,307) = b(k,307) - lu(k,582) * b(k,148) + b(k,316) = b(k,316) - lu(k,583) * b(k,148) + b(k,317) = b(k,317) - lu(k,584) * b(k,148) + b(k,179) = b(k,179) - lu(k,586) * b(k,149) + b(k,227) = b(k,227) - lu(k,587) * b(k,149) + b(k,271) = b(k,271) - lu(k,588) * b(k,149) + b(k,306) = b(k,306) - lu(k,589) * b(k,149) + b(k,307) = b(k,307) - lu(k,590) * b(k,149) + b(k,313) = b(k,313) - lu(k,591) * b(k,149) + b(k,316) = b(k,316) - lu(k,592) * b(k,149) + b(k,200) = b(k,200) - lu(k,594) * b(k,150) + b(k,241) = b(k,241) - lu(k,595) * b(k,150) + b(k,269) = b(k,269) - lu(k,596) * b(k,150) + b(k,306) = b(k,306) - lu(k,597) * b(k,150) + b(k,307) = b(k,307) - lu(k,598) * b(k,150) + b(k,312) = b(k,312) - lu(k,599) * b(k,150) + b(k,316) = b(k,316) - lu(k,600) * b(k,150) + b(k,255) = b(k,255) - lu(k,602) * b(k,151) + b(k,307) = b(k,307) - lu(k,603) * b(k,151) + b(k,316) = b(k,316) - lu(k,604) * b(k,151) + b(k,193) = b(k,193) - lu(k,606) * b(k,152) + b(k,230) = b(k,230) - lu(k,607) * b(k,152) + b(k,280) = b(k,280) - lu(k,608) * b(k,152) + b(k,303) = b(k,303) - lu(k,609) * b(k,152) + b(k,306) = b(k,306) - lu(k,610) * b(k,152) + b(k,307) = b(k,307) - lu(k,611) * b(k,152) + b(k,312) = b(k,312) - lu(k,612) * b(k,152) + b(k,155) = b(k,155) - lu(k,614) * b(k,153) + b(k,185) = b(k,185) - lu(k,615) * b(k,153) + b(k,227) = b(k,227) - lu(k,616) * b(k,153) + b(k,240) = b(k,240) - lu(k,617) * b(k,153) + b(k,247) = b(k,247) - lu(k,618) * b(k,153) + b(k,266) = b(k,266) - lu(k,619) * b(k,153) + b(k,270) = b(k,270) - lu(k,620) * b(k,153) + b(k,271) = b(k,271) - lu(k,621) * b(k,153) + b(k,300) = b(k,300) - lu(k,622) * b(k,153) + b(k,307) = b(k,307) - lu(k,623) * b(k,153) + b(k,308) = b(k,308) - lu(k,624) * b(k,153) + b(k,316) = b(k,316) - lu(k,625) * b(k,153) + b(k,155) = b(k,155) - lu(k,627) * b(k,154) + b(k,185) = b(k,185) - lu(k,628) * b(k,154) + b(k,187) = b(k,187) - lu(k,629) * b(k,154) + b(k,243) = b(k,243) - lu(k,630) * b(k,154) + b(k,247) = b(k,247) - lu(k,631) * b(k,154) + b(k,266) = b(k,266) - lu(k,632) * b(k,154) + b(k,269) = b(k,269) - lu(k,633) * b(k,154) + b(k,271) = b(k,271) - lu(k,634) * b(k,154) + b(k,300) = b(k,300) - lu(k,635) * b(k,154) + b(k,307) = b(k,307) - lu(k,636) * b(k,154) + b(k,308) = b(k,308) - lu(k,637) * b(k,154) + b(k,316) = b(k,316) - lu(k,638) * b(k,154) + 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,187) = b(k,187) - lu(k,640) * b(k,155) + b(k,266) = b(k,266) - lu(k,641) * b(k,155) + b(k,271) = b(k,271) - lu(k,642) * b(k,155) + b(k,306) = b(k,306) - lu(k,643) * b(k,155) + b(k,307) = b(k,307) - lu(k,644) * b(k,155) + b(k,316) = b(k,316) - lu(k,645) * b(k,155) + b(k,276) = b(k,276) - lu(k,647) * b(k,156) + b(k,304) = b(k,304) - lu(k,648) * b(k,156) + b(k,307) = b(k,307) - lu(k,649) * b(k,156) + b(k,308) = b(k,308) - lu(k,650) * b(k,156) + b(k,314) = b(k,314) - lu(k,651) * b(k,156) + b(k,315) = b(k,315) - lu(k,652) * b(k,156) + b(k,316) = b(k,316) - lu(k,653) * b(k,156) + b(k,317) = b(k,317) - lu(k,654) * b(k,156) + b(k,247) = b(k,247) - lu(k,656) * b(k,157) + b(k,271) = b(k,271) - lu(k,657) * b(k,157) + b(k,280) = b(k,280) - lu(k,658) * b(k,157) + b(k,297) = b(k,297) - lu(k,659) * b(k,157) + b(k,306) = b(k,306) - lu(k,660) * b(k,157) + b(k,307) = b(k,307) - lu(k,661) * b(k,157) + b(k,312) = b(k,312) - lu(k,662) * b(k,157) + b(k,316) = b(k,316) - lu(k,663) * b(k,157) + b(k,247) = b(k,247) - lu(k,665) * b(k,158) + b(k,271) = b(k,271) - lu(k,666) * b(k,158) + b(k,298) = b(k,298) - lu(k,667) * b(k,158) + b(k,300) = b(k,300) - lu(k,668) * b(k,158) + b(k,306) = b(k,306) - lu(k,669) * b(k,158) + b(k,307) = b(k,307) - lu(k,670) * b(k,158) + b(k,312) = b(k,312) - lu(k,671) * b(k,158) + b(k,316) = b(k,316) - lu(k,672) * b(k,158) + b(k,210) = b(k,210) - lu(k,674) * b(k,159) + b(k,241) = b(k,241) - lu(k,675) * b(k,159) + b(k,270) = b(k,270) - lu(k,676) * b(k,159) + b(k,302) = b(k,302) - lu(k,677) * b(k,159) + b(k,306) = b(k,306) - lu(k,678) * b(k,159) + b(k,307) = b(k,307) - lu(k,679) * b(k,159) + b(k,312) = b(k,312) - lu(k,680) * b(k,159) + b(k,316) = b(k,316) - lu(k,681) * b(k,159) + b(k,214) = b(k,214) - lu(k,683) * b(k,160) + b(k,252) = b(k,252) - lu(k,684) * b(k,160) + b(k,293) = b(k,293) - lu(k,685) * b(k,160) + b(k,307) = b(k,307) - lu(k,686) * b(k,160) + b(k,312) = b(k,312) - lu(k,687) * b(k,160) + b(k,316) = b(k,316) - lu(k,688) * b(k,160) + b(k,284) = b(k,284) - lu(k,690) * b(k,161) + b(k,307) = b(k,307) - lu(k,691) * b(k,161) + b(k,316) = b(k,316) - lu(k,692) * b(k,161) + b(k,213) = b(k,213) - lu(k,694) * b(k,162) + b(k,227) = b(k,227) - lu(k,695) * b(k,162) + b(k,303) = b(k,303) - lu(k,696) * b(k,162) + b(k,306) = b(k,306) - lu(k,697) * b(k,162) + b(k,307) = b(k,307) - lu(k,698) * b(k,162) + b(k,312) = b(k,312) - lu(k,699) * b(k,162) + b(k,316) = b(k,316) - lu(k,700) * b(k,162) + b(k,317) = b(k,317) - lu(k,701) * b(k,162) + b(k,247) = b(k,247) - lu(k,703) * b(k,163) + b(k,300) = b(k,300) - lu(k,704) * b(k,163) + b(k,306) = b(k,306) - lu(k,705) * b(k,163) + b(k,308) = b(k,308) - lu(k,706) * b(k,163) + b(k,316) = b(k,316) - lu(k,707) * b(k,163) + b(k,317) = b(k,317) - lu(k,708) * b(k,163) + b(k,303) = b(k,303) - lu(k,712) * b(k,164) + b(k,307) = b(k,307) - lu(k,713) * b(k,164) + b(k,312) = b(k,312) - lu(k,714) * b(k,164) + b(k,313) = b(k,313) - lu(k,715) * b(k,164) + b(k,316) = b(k,316) - lu(k,716) * b(k,164) + b(k,169) = b(k,169) - lu(k,719) * b(k,165) + b(k,211) = b(k,211) - lu(k,720) * b(k,165) + b(k,225) = b(k,225) - lu(k,721) * b(k,165) + b(k,230) = b(k,230) - lu(k,722) * b(k,165) + b(k,280) = b(k,280) - lu(k,723) * b(k,165) + b(k,300) = b(k,300) - lu(k,724) * b(k,165) + b(k,306) = b(k,306) - lu(k,725) * b(k,165) + b(k,307) = b(k,307) - lu(k,726) * b(k,165) + b(k,316) = b(k,316) - lu(k,727) * b(k,165) + b(k,218) = b(k,218) - lu(k,729) * b(k,166) + b(k,231) = b(k,231) - lu(k,730) * b(k,166) + b(k,269) = b(k,269) - lu(k,731) * b(k,166) + b(k,270) = b(k,270) - lu(k,732) * b(k,166) + b(k,274) = b(k,274) - lu(k,733) * b(k,166) + b(k,306) = b(k,306) - lu(k,734) * b(k,166) + b(k,307) = b(k,307) - lu(k,735) * b(k,166) + b(k,312) = b(k,312) - lu(k,736) * b(k,166) + b(k,316) = b(k,316) - lu(k,737) * b(k,166) + b(k,180) = b(k,180) - lu(k,742) * b(k,167) + b(k,181) = b(k,181) - lu(k,743) * b(k,167) + b(k,184) = b(k,184) - lu(k,744) * b(k,167) + b(k,188) = b(k,188) - lu(k,745) * b(k,167) + b(k,235) = b(k,235) - lu(k,746) * b(k,167) + b(k,266) = b(k,266) - lu(k,747) * b(k,167) + b(k,271) = b(k,271) - lu(k,748) * b(k,167) + b(k,307) = b(k,307) - lu(k,749) * b(k,167) + b(k,316) = b(k,316) - lu(k,750) * b(k,167) + b(k,169) = b(k,169) - lu(k,753) * b(k,168) + b(k,225) = b(k,225) - lu(k,754) * b(k,168) + b(k,230) = b(k,230) - lu(k,755) * b(k,168) + b(k,280) = b(k,280) - lu(k,756) * b(k,168) + b(k,300) = b(k,300) - lu(k,757) * b(k,168) + b(k,306) = b(k,306) - lu(k,758) * b(k,168) + b(k,307) = b(k,307) - lu(k,759) * b(k,168) + b(k,312) = b(k,312) - lu(k,760) * b(k,168) + b(k,316) = b(k,316) - lu(k,761) * b(k,168) + b(k,230) = b(k,230) - lu(k,764) * b(k,169) + b(k,300) = b(k,300) - lu(k,765) * b(k,169) + b(k,303) = b(k,303) - lu(k,766) * b(k,169) + b(k,307) = b(k,307) - lu(k,767) * b(k,169) + b(k,312) = b(k,312) - lu(k,768) * b(k,169) + b(k,316) = b(k,316) - lu(k,769) * b(k,169) + b(k,235) = b(k,235) - lu(k,771) * b(k,170) + b(k,254) = b(k,254) - lu(k,772) * b(k,170) + b(k,258) = b(k,258) - lu(k,773) * b(k,170) + b(k,266) = b(k,266) - lu(k,774) * b(k,170) + b(k,271) = b(k,271) - lu(k,775) * b(k,170) + b(k,307) = b(k,307) - lu(k,776) * b(k,170) + b(k,316) = b(k,316) - lu(k,777) * b(k,170) + b(k,247) = b(k,247) - lu(k,779) * b(k,171) + b(k,294) = b(k,294) - lu(k,780) * b(k,171) + b(k,299) = b(k,299) - lu(k,781) * b(k,171) + b(k,316) = b(k,316) - lu(k,782) * b(k,171) + b(k,197) = b(k,197) - lu(k,784) * b(k,172) + b(k,253) = b(k,253) - lu(k,785) * b(k,172) + b(k,293) = b(k,293) - lu(k,786) * b(k,172) + b(k,302) = b(k,302) - lu(k,787) * b(k,172) + b(k,307) = b(k,307) - lu(k,788) * b(k,172) + b(k,312) = b(k,312) - lu(k,789) * b(k,172) + b(k,316) = b(k,316) - lu(k,790) * b(k,172) + b(k,247) = b(k,247) - lu(k,792) * b(k,173) + b(k,308) = b(k,308) - lu(k,793) * b(k,173) + b(k,316) = b(k,316) - lu(k,794) * b(k,173) + b(k,317) = b(k,317) - lu(k,795) * b(k,173) + b(k,192) = b(k,192) - lu(k,798) * b(k,174) + b(k,255) = b(k,255) - lu(k,799) * b(k,174) + b(k,303) = b(k,303) - lu(k,800) * b(k,174) + b(k,306) = b(k,306) - lu(k,801) * b(k,174) + b(k,307) = b(k,307) - lu(k,802) * b(k,174) + b(k,312) = b(k,312) - lu(k,803) * b(k,174) + b(k,316) = b(k,316) - lu(k,804) * b(k,174) + b(k,192) = b(k,192) - lu(k,806) * b(k,175) + b(k,215) = b(k,215) - lu(k,807) * b(k,175) + b(k,244) = b(k,244) - lu(k,808) * b(k,175) + b(k,303) = b(k,303) - lu(k,809) * b(k,175) + b(k,307) = b(k,307) - lu(k,810) * b(k,175) + b(k,312) = b(k,312) - lu(k,811) * b(k,175) + b(k,316) = b(k,316) - lu(k,812) * b(k,175) + b(k,192) = b(k,192) - lu(k,814) * b(k,176) + b(k,215) = b(k,215) - lu(k,815) * b(k,176) + b(k,242) = b(k,242) - lu(k,816) * b(k,176) + b(k,303) = b(k,303) - lu(k,817) * b(k,176) + b(k,307) = b(k,307) - lu(k,818) * b(k,176) + b(k,312) = b(k,312) - lu(k,819) * b(k,176) + b(k,316) = b(k,316) - lu(k,820) * b(k,176) + b(k,258) = b(k,258) - lu(k,828) * b(k,177) + b(k,280) = b(k,280) - lu(k,829) * b(k,177) + b(k,288) = b(k,288) - lu(k,830) * b(k,177) + b(k,291) = b(k,291) - lu(k,831) * b(k,177) + b(k,292) = b(k,292) - lu(k,832) * b(k,177) + b(k,306) = b(k,306) - lu(k,833) * b(k,177) + b(k,307) = b(k,307) - lu(k,834) * b(k,177) + b(k,311) = b(k,311) - lu(k,835) * b(k,177) + b(k,313) = b(k,313) - lu(k,836) * b(k,177) + b(k,316) = b(k,316) - lu(k,837) * b(k,177) + b(k,180) = b(k,180) - lu(k,843) * b(k,178) + b(k,183) = b(k,183) - lu(k,844) * b(k,178) + b(k,184) = b(k,184) - lu(k,845) * b(k,178) + b(k,188) = b(k,188) - lu(k,846) * b(k,178) + b(k,235) = b(k,235) - lu(k,847) * b(k,178) + b(k,266) = b(k,266) - lu(k,848) * b(k,178) + b(k,271) = b(k,271) - lu(k,849) * b(k,178) + b(k,300) = b(k,300) - lu(k,850) * b(k,178) + b(k,307) = b(k,307) - lu(k,851) * b(k,178) + b(k,316) = b(k,316) - lu(k,852) * b(k,178) + b(k,254) = b(k,254) - lu(k,856) * b(k,179) + b(k,303) = b(k,303) - lu(k,857) * b(k,179) + b(k,306) = b(k,306) - lu(k,858) * b(k,179) + b(k,307) = b(k,307) - lu(k,859) * b(k,179) + b(k,312) = b(k,312) - lu(k,860) * b(k,179) + b(k,316) = b(k,316) - lu(k,861) * b(k,179) + b(k,235) = b(k,235) - lu(k,863) * b(k,180) + b(k,271) = b(k,271) - lu(k,864) * b(k,180) + b(k,303) = b(k,303) - lu(k,865) * b(k,180) + b(k,307) = b(k,307) - lu(k,866) * b(k,180) + b(k,312) = b(k,312) - lu(k,867) * b(k,180) + b(k,184) = b(k,184) - lu(k,874) * b(k,181) + b(k,188) = b(k,188) - lu(k,875) * b(k,181) + b(k,235) = b(k,235) - lu(k,876) * b(k,181) + b(k,266) = b(k,266) - lu(k,877) * b(k,181) + b(k,271) = b(k,271) - lu(k,878) * b(k,181) + b(k,303) = b(k,303) - lu(k,879) * b(k,181) + b(k,307) = b(k,307) - lu(k,880) * b(k,181) + b(k,312) = b(k,312) - lu(k,881) * b(k,181) + b(k,316) = b(k,316) - lu(k,882) * b(k,181) + b(k,235) = b(k,235) - lu(k,884) * b(k,182) + b(k,271) = b(k,271) - lu(k,885) * b(k,182) + b(k,306) = b(k,306) - lu(k,886) * b(k,182) + b(k,307) = b(k,307) - lu(k,887) * b(k,182) + b(k,316) = b(k,316) - lu(k,888) * b(k,182) + b(k,184) = b(k,184) - lu(k,896) * b(k,183) + b(k,188) = b(k,188) - lu(k,897) * b(k,183) + b(k,235) = b(k,235) - lu(k,898) * b(k,183) + b(k,266) = b(k,266) - lu(k,899) * b(k,183) + b(k,271) = b(k,271) - lu(k,900) * b(k,183) + b(k,300) = b(k,300) - lu(k,901) * b(k,183) + b(k,303) = b(k,303) - lu(k,902) * b(k,183) + b(k,307) = b(k,307) - lu(k,903) * b(k,183) + b(k,312) = b(k,312) - lu(k,904) * b(k,183) + b(k,316) = b(k,316) - lu(k,905) * b(k,183) + 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,266) = b(k,266) - lu(k,907) * b(k,184) + b(k,271) = b(k,271) - lu(k,908) * b(k,184) + b(k,303) = b(k,303) - lu(k,909) * b(k,184) + b(k,307) = b(k,307) - lu(k,910) * b(k,184) + b(k,308) = b(k,308) - lu(k,911) * b(k,184) + b(k,312) = b(k,312) - lu(k,912) * b(k,184) + b(k,316) = b(k,316) - lu(k,913) * b(k,184) + b(k,258) = b(k,258) - lu(k,915) * b(k,185) + b(k,266) = b(k,266) - lu(k,916) * b(k,185) + b(k,271) = b(k,271) - lu(k,917) * b(k,185) + b(k,306) = b(k,306) - lu(k,918) * b(k,185) + b(k,254) = b(k,254) - lu(k,920) * b(k,186) + b(k,258) = b(k,258) - lu(k,921) * b(k,186) + b(k,307) = b(k,307) - lu(k,922) * b(k,186) + b(k,316) = b(k,316) - lu(k,923) * b(k,186) + b(k,266) = b(k,266) - lu(k,925) * b(k,187) + b(k,300) = b(k,300) - lu(k,926) * b(k,187) + b(k,306) = b(k,306) - lu(k,927) * b(k,187) + b(k,316) = b(k,316) - lu(k,928) * b(k,187) + b(k,235) = b(k,235) - lu(k,930) * b(k,188) + b(k,266) = b(k,266) - lu(k,931) * b(k,188) + b(k,271) = b(k,271) - lu(k,932) * b(k,188) + b(k,303) = b(k,303) - lu(k,933) * b(k,188) + b(k,307) = b(k,307) - lu(k,934) * b(k,188) + b(k,308) = b(k,308) - lu(k,935) * b(k,188) + b(k,312) = b(k,312) - lu(k,936) * b(k,188) + b(k,316) = b(k,316) - lu(k,937) * b(k,188) + b(k,230) = b(k,230) - lu(k,940) * b(k,189) + b(k,258) = b(k,258) - lu(k,941) * b(k,189) + b(k,303) = b(k,303) - lu(k,942) * b(k,189) + b(k,306) = b(k,306) - lu(k,943) * b(k,189) + b(k,307) = b(k,307) - lu(k,944) * b(k,189) + b(k,312) = b(k,312) - lu(k,945) * b(k,189) + b(k,316) = b(k,316) - lu(k,946) * b(k,189) + b(k,317) = b(k,317) - lu(k,947) * b(k,189) + b(k,192) = b(k,192) - lu(k,952) * b(k,190) + b(k,255) = b(k,255) - lu(k,953) * b(k,190) + b(k,284) = b(k,284) - lu(k,954) * b(k,190) + b(k,303) = b(k,303) - lu(k,955) * b(k,190) + b(k,306) = b(k,306) - lu(k,956) * b(k,190) + b(k,307) = b(k,307) - lu(k,957) * b(k,190) + b(k,312) = b(k,312) - lu(k,958) * b(k,190) + b(k,316) = b(k,316) - lu(k,959) * b(k,190) + b(k,252) = b(k,252) - lu(k,961) * b(k,191) + b(k,253) = b(k,253) - lu(k,962) * b(k,191) + b(k,282) = b(k,282) - lu(k,963) * b(k,191) + b(k,293) = b(k,293) - lu(k,964) * b(k,191) + b(k,303) = b(k,303) - lu(k,965) * b(k,191) + b(k,307) = b(k,307) - lu(k,966) * b(k,191) + b(k,312) = b(k,312) - lu(k,967) * b(k,191) + b(k,316) = b(k,316) - lu(k,968) * b(k,191) + b(k,244) = b(k,244) - lu(k,970) * b(k,192) + b(k,307) = b(k,307) - lu(k,971) * b(k,192) + b(k,316) = b(k,316) - lu(k,972) * b(k,192) + b(k,230) = b(k,230) - lu(k,975) * b(k,193) + b(k,254) = b(k,254) - lu(k,976) * b(k,193) + b(k,258) = b(k,258) - lu(k,977) * b(k,193) + b(k,271) = b(k,271) - lu(k,978) * b(k,193) + b(k,280) = b(k,280) - lu(k,979) * b(k,193) + b(k,300) = b(k,300) - lu(k,980) * b(k,193) + b(k,302) = b(k,302) - lu(k,981) * b(k,193) + b(k,306) = b(k,306) - lu(k,982) * b(k,193) + b(k,307) = b(k,307) - lu(k,983) * b(k,193) + b(k,312) = b(k,312) - lu(k,984) * b(k,193) + b(k,316) = b(k,316) - lu(k,985) * b(k,193) + b(k,244) = b(k,244) - lu(k,987) * b(k,194) + b(k,284) = b(k,284) - lu(k,988) * b(k,194) + b(k,290) = b(k,290) - lu(k,989) * b(k,194) + b(k,307) = b(k,307) - lu(k,990) * b(k,194) + b(k,312) = b(k,312) - lu(k,991) * b(k,194) + b(k,316) = b(k,316) - lu(k,992) * b(k,194) + b(k,317) = b(k,317) - lu(k,993) * b(k,194) + b(k,276) = b(k,276) - lu(k,996) * b(k,195) + b(k,304) = b(k,304) - lu(k,997) * b(k,195) + b(k,305) = b(k,305) - lu(k,998) * b(k,195) + b(k,309) = b(k,309) - lu(k,999) * b(k,195) + b(k,315) = b(k,315) - lu(k,1000) * b(k,195) + b(k,316) = b(k,316) - lu(k,1001) * b(k,195) + b(k,317) = b(k,317) - lu(k,1002) * b(k,195) + b(k,244) = b(k,244) - lu(k,1007) * b(k,196) + b(k,282) = b(k,282) - lu(k,1008) * b(k,196) + b(k,284) = b(k,284) - lu(k,1009) * b(k,196) + b(k,303) = b(k,303) - lu(k,1010) * b(k,196) + b(k,307) = b(k,307) - lu(k,1011) * b(k,196) + b(k,312) = b(k,312) - lu(k,1012) * b(k,196) + b(k,316) = b(k,316) - lu(k,1013) * b(k,196) + b(k,207) = b(k,207) - lu(k,1016) * b(k,197) + b(k,215) = b(k,215) - lu(k,1017) * b(k,197) + b(k,244) = b(k,244) - lu(k,1018) * b(k,197) + b(k,303) = b(k,303) - lu(k,1019) * b(k,197) + b(k,307) = b(k,307) - lu(k,1020) * b(k,197) + b(k,312) = b(k,312) - lu(k,1021) * b(k,197) + b(k,316) = b(k,316) - lu(k,1022) * b(k,197) + b(k,230) = b(k,230) - lu(k,1025) * b(k,198) + b(k,280) = b(k,280) - lu(k,1026) * b(k,198) + b(k,303) = b(k,303) - lu(k,1027) * b(k,198) + b(k,306) = b(k,306) - lu(k,1028) * b(k,198) + b(k,307) = b(k,307) - lu(k,1029) * b(k,198) + b(k,308) = b(k,308) - lu(k,1030) * b(k,198) + b(k,312) = b(k,312) - lu(k,1031) * b(k,198) + b(k,316) = b(k,316) - lu(k,1032) * b(k,198) + b(k,317) = b(k,317) - lu(k,1033) * b(k,198) + b(k,237) = b(k,237) - lu(k,1042) * b(k,199) + b(k,247) = b(k,247) - lu(k,1043) * b(k,199) + b(k,277) = b(k,277) - lu(k,1044) * b(k,199) + b(k,286) = b(k,286) - lu(k,1045) * b(k,199) + b(k,292) = b(k,292) - lu(k,1046) * b(k,199) + b(k,294) = b(k,294) - lu(k,1047) * b(k,199) + b(k,299) = b(k,299) - lu(k,1048) * b(k,199) + b(k,306) = b(k,306) - lu(k,1049) * b(k,199) + b(k,307) = b(k,307) - lu(k,1050) * b(k,199) + b(k,311) = b(k,311) - lu(k,1051) * b(k,199) + b(k,313) = b(k,313) - lu(k,1052) * b(k,199) + b(k,316) = b(k,316) - lu(k,1053) * b(k,199) + b(k,234) = b(k,234) - lu(k,1055) * b(k,200) + b(k,250) = b(k,250) - lu(k,1056) * b(k,200) + b(k,260) = b(k,260) - lu(k,1057) * b(k,200) + b(k,265) = b(k,265) - lu(k,1058) * b(k,200) + b(k,303) = b(k,303) - lu(k,1059) * b(k,200) + b(k,306) = b(k,306) - lu(k,1060) * b(k,200) + b(k,307) = b(k,307) - lu(k,1061) * b(k,200) + b(k,312) = b(k,312) - lu(k,1062) * b(k,200) + b(k,316) = b(k,316) - lu(k,1063) * b(k,200) + b(k,237) = b(k,237) - lu(k,1072) * b(k,201) + b(k,247) = b(k,247) - lu(k,1073) * b(k,201) + b(k,283) = b(k,283) - lu(k,1074) * b(k,201) + b(k,289) = b(k,289) - lu(k,1075) * b(k,201) + b(k,293) = b(k,293) - lu(k,1076) * b(k,201) + b(k,294) = b(k,294) - lu(k,1077) * b(k,201) + b(k,298) = b(k,298) - lu(k,1078) * b(k,201) + b(k,299) = b(k,299) - lu(k,1079) * b(k,201) + b(k,300) = b(k,300) - lu(k,1080) * b(k,201) + b(k,306) = b(k,306) - lu(k,1081) * b(k,201) + b(k,311) = b(k,311) - lu(k,1082) * b(k,201) + b(k,313) = b(k,313) - lu(k,1083) * b(k,201) + b(k,316) = b(k,316) - lu(k,1084) * b(k,201) + b(k,203) = b(k,203) - lu(k,1093) * b(k,202) + b(k,211) = b(k,211) - lu(k,1094) * b(k,202) + b(k,213) = b(k,213) - lu(k,1095) * b(k,202) + b(k,227) = b(k,227) - lu(k,1096) * b(k,202) + b(k,237) = b(k,237) - lu(k,1097) * b(k,202) + b(k,247) = b(k,247) - lu(k,1098) * b(k,202) + b(k,285) = b(k,285) - lu(k,1099) * b(k,202) + b(k,290) = b(k,290) - lu(k,1100) * b(k,202) + b(k,297) = b(k,297) - lu(k,1101) * b(k,202) + b(k,306) = b(k,306) - lu(k,1102) * b(k,202) + b(k,311) = b(k,311) - lu(k,1103) * b(k,202) + b(k,313) = b(k,313) - lu(k,1104) * b(k,202) + b(k,316) = b(k,316) - lu(k,1105) * b(k,202) + b(k,294) = b(k,294) - lu(k,1107) * b(k,203) + b(k,297) = b(k,297) - lu(k,1108) * b(k,203) + b(k,316) = b(k,316) - lu(k,1109) * b(k,203) + b(k,235) = b(k,235) - lu(k,1111) * b(k,204) + b(k,254) = b(k,254) - lu(k,1112) * b(k,204) + b(k,258) = b(k,258) - lu(k,1113) * b(k,204) + b(k,259) = b(k,259) - lu(k,1114) * b(k,204) + b(k,265) = b(k,265) - lu(k,1115) * b(k,204) + b(k,266) = b(k,266) - lu(k,1116) * b(k,204) + b(k,271) = b(k,271) - lu(k,1117) * b(k,204) + b(k,302) = b(k,302) - lu(k,1118) * b(k,204) + b(k,312) = b(k,312) - lu(k,1119) * b(k,204) + b(k,316) = b(k,316) - lu(k,1120) * b(k,204) + b(k,234) = b(k,234) - lu(k,1122) * b(k,205) + b(k,236) = b(k,236) - lu(k,1123) * b(k,205) + b(k,250) = b(k,250) - lu(k,1124) * b(k,205) + b(k,254) = b(k,254) - lu(k,1125) * b(k,205) + b(k,259) = b(k,259) - lu(k,1126) * b(k,205) + b(k,303) = b(k,303) - lu(k,1127) * b(k,205) + b(k,306) = b(k,306) - lu(k,1128) * b(k,205) + b(k,307) = b(k,307) - lu(k,1129) * b(k,205) + b(k,312) = b(k,312) - lu(k,1130) * b(k,205) + b(k,316) = b(k,316) - lu(k,1131) * b(k,205) + b(k,232) = b(k,232) - lu(k,1133) * b(k,206) + b(k,234) = b(k,234) - lu(k,1134) * b(k,206) + b(k,250) = b(k,250) - lu(k,1135) * b(k,206) + b(k,258) = b(k,258) - lu(k,1136) * b(k,206) + b(k,265) = b(k,265) - lu(k,1137) * b(k,206) + b(k,303) = b(k,303) - lu(k,1138) * b(k,206) + b(k,306) = b(k,306) - lu(k,1139) * b(k,206) + b(k,307) = b(k,307) - lu(k,1140) * b(k,206) + b(k,312) = b(k,312) - lu(k,1141) * b(k,206) + b(k,316) = b(k,316) - lu(k,1142) * b(k,206) + b(k,242) = b(k,242) - lu(k,1144) * b(k,207) + b(k,284) = b(k,284) - lu(k,1145) * b(k,207) + b(k,302) = b(k,302) - lu(k,1146) * b(k,207) + b(k,312) = b(k,312) - lu(k,1147) * b(k,207) + b(k,316) = b(k,316) - lu(k,1148) * b(k,207) + b(k,317) = b(k,317) - lu(k,1149) * b(k,207) + b(k,276) = b(k,276) - lu(k,1151) * b(k,208) + b(k,301) = b(k,301) - lu(k,1152) * b(k,208) + b(k,305) = b(k,305) - lu(k,1153) * b(k,208) + b(k,309) = b(k,309) - lu(k,1154) * b(k,208) + b(k,314) = b(k,314) - lu(k,1155) * b(k,208) + b(k,316) = b(k,316) - lu(k,1156) * b(k,208) + b(k,317) = b(k,317) - lu(k,1157) * b(k,208) + b(k,304) = b(k,304) - lu(k,1160) * b(k,209) + b(k,305) = b(k,305) - lu(k,1161) * b(k,209) + b(k,310) = b(k,310) - lu(k,1162) * b(k,209) + b(k,315) = b(k,315) - lu(k,1163) * b(k,209) + b(k,316) = b(k,316) - lu(k,1164) * b(k,209) + b(k,317) = b(k,317) - lu(k,1165) * b(k,209) + 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 + b(k,234) = b(k,234) - lu(k,1167) * b(k,210) + b(k,250) = b(k,250) - lu(k,1168) * b(k,210) + b(k,254) = b(k,254) - lu(k,1169) * b(k,210) + b(k,258) = b(k,258) - lu(k,1170) * b(k,210) + b(k,259) = b(k,259) - lu(k,1171) * b(k,210) + b(k,260) = b(k,260) - lu(k,1172) * b(k,210) + b(k,303) = b(k,303) - lu(k,1173) * b(k,210) + b(k,306) = b(k,306) - lu(k,1174) * b(k,210) + b(k,307) = b(k,307) - lu(k,1175) * b(k,210) + b(k,312) = b(k,312) - lu(k,1176) * b(k,210) + b(k,316) = b(k,316) - lu(k,1177) * b(k,210) + b(k,225) = b(k,225) - lu(k,1183) * b(k,211) + b(k,230) = b(k,230) - lu(k,1184) * b(k,211) + b(k,280) = b(k,280) - lu(k,1185) * b(k,211) + b(k,300) = b(k,300) - lu(k,1186) * b(k,211) + b(k,303) = b(k,303) - lu(k,1187) * b(k,211) + b(k,306) = b(k,306) - lu(k,1188) * b(k,211) + b(k,307) = b(k,307) - lu(k,1189) * b(k,211) + b(k,312) = b(k,312) - lu(k,1190) * b(k,211) + b(k,316) = b(k,316) - lu(k,1191) * b(k,211) + b(k,222) = b(k,222) - lu(k,1195) * b(k,212) + b(k,227) = b(k,227) - lu(k,1196) * b(k,212) + b(k,249) = b(k,249) - lu(k,1197) * b(k,212) + b(k,258) = b(k,258) - lu(k,1198) * b(k,212) + b(k,266) = b(k,266) - lu(k,1199) * b(k,212) + b(k,269) = b(k,269) - lu(k,1200) * b(k,212) + b(k,270) = b(k,270) - lu(k,1201) * b(k,212) + b(k,271) = b(k,271) - lu(k,1202) * b(k,212) + b(k,274) = b(k,274) - lu(k,1203) * b(k,212) + b(k,275) = b(k,275) - lu(k,1204) * b(k,212) + b(k,302) = b(k,302) - lu(k,1205) * b(k,212) + b(k,306) = b(k,306) - lu(k,1206) * b(k,212) + b(k,307) = b(k,307) - lu(k,1207) * b(k,212) + b(k,312) = b(k,312) - lu(k,1208) * b(k,212) + b(k,316) = b(k,316) - lu(k,1209) * b(k,212) + b(k,227) = b(k,227) - lu(k,1211) * b(k,213) + b(k,306) = b(k,306) - lu(k,1212) * b(k,213) + b(k,307) = b(k,307) - lu(k,1213) * b(k,213) + b(k,316) = b(k,316) - lu(k,1214) * b(k,213) + b(k,317) = b(k,317) - lu(k,1215) * b(k,213) + b(k,215) = b(k,215) - lu(k,1219) * b(k,214) + b(k,244) = b(k,244) - lu(k,1220) * b(k,214) + b(k,284) = b(k,284) - lu(k,1221) * b(k,214) + b(k,290) = b(k,290) - lu(k,1222) * b(k,214) + b(k,303) = b(k,303) - lu(k,1223) * b(k,214) + b(k,307) = b(k,307) - lu(k,1224) * b(k,214) + b(k,312) = b(k,312) - lu(k,1225) * b(k,214) + b(k,316) = b(k,316) - lu(k,1226) * b(k,214) + b(k,317) = b(k,317) - lu(k,1227) * b(k,214) + b(k,244) = b(k,244) - lu(k,1229) * b(k,215) + b(k,302) = b(k,302) - lu(k,1230) * b(k,215) + b(k,307) = b(k,307) - lu(k,1231) * b(k,215) + b(k,312) = b(k,312) - lu(k,1232) * b(k,215) + b(k,316) = b(k,316) - lu(k,1233) * b(k,215) + b(k,246) = b(k,246) - lu(k,1236) * b(k,216) + b(k,305) = b(k,305) - lu(k,1237) * b(k,216) + b(k,307) = b(k,307) - lu(k,1238) * b(k,216) + b(k,316) = b(k,316) - lu(k,1239) * b(k,216) + b(k,317) = b(k,317) - lu(k,1240) * b(k,216) + b(k,251) = b(k,251) - lu(k,1243) * b(k,217) + b(k,279) = b(k,279) - lu(k,1244) * b(k,217) + b(k,301) = b(k,301) - lu(k,1245) * b(k,217) + b(k,302) = b(k,302) - lu(k,1246) * b(k,217) + b(k,308) = b(k,308) - lu(k,1247) * b(k,217) + b(k,311) = b(k,311) - lu(k,1248) * b(k,217) + b(k,316) = b(k,316) - lu(k,1249) * b(k,217) + b(k,317) = b(k,317) - lu(k,1250) * b(k,217) + b(k,236) = b(k,236) - lu(k,1253) * b(k,218) + b(k,247) = b(k,247) - lu(k,1254) * b(k,218) + b(k,249) = b(k,249) - lu(k,1255) * b(k,218) + b(k,258) = b(k,258) - lu(k,1256) * b(k,218) + b(k,265) = b(k,265) - lu(k,1257) * b(k,218) + b(k,266) = b(k,266) - lu(k,1258) * b(k,218) + b(k,271) = b(k,271) - lu(k,1259) * b(k,218) + b(k,302) = b(k,302) - lu(k,1260) * b(k,218) + b(k,306) = b(k,306) - lu(k,1261) * b(k,218) + b(k,307) = b(k,307) - lu(k,1262) * b(k,218) + b(k,312) = b(k,312) - lu(k,1263) * b(k,218) + b(k,316) = b(k,316) - lu(k,1264) * b(k,218) + b(k,220) = b(k,220) - lu(k,1273) * b(k,219) + b(k,237) = b(k,237) - lu(k,1274) * b(k,219) + b(k,247) = b(k,247) - lu(k,1275) * b(k,219) + b(k,271) = b(k,271) - lu(k,1276) * b(k,219) + b(k,281) = b(k,281) - lu(k,1277) * b(k,219) + b(k,284) = b(k,284) - lu(k,1278) * b(k,219) + b(k,287) = b(k,287) - lu(k,1279) * b(k,219) + b(k,294) = b(k,294) - lu(k,1280) * b(k,219) + b(k,296) = b(k,296) - lu(k,1281) * b(k,219) + b(k,297) = b(k,297) - lu(k,1282) * b(k,219) + b(k,299) = b(k,299) - lu(k,1283) * b(k,219) + b(k,306) = b(k,306) - lu(k,1284) * b(k,219) + b(k,307) = b(k,307) - lu(k,1285) * b(k,219) + b(k,311) = b(k,311) - lu(k,1286) * b(k,219) + b(k,313) = b(k,313) - lu(k,1287) * b(k,219) + b(k,316) = b(k,316) - lu(k,1288) * b(k,219) + b(k,271) = b(k,271) - lu(k,1290) * b(k,220) + b(k,296) = b(k,296) - lu(k,1291) * b(k,220) + b(k,297) = b(k,297) - lu(k,1292) * b(k,220) + b(k,302) = b(k,302) - lu(k,1293) * b(k,220) + b(k,307) = b(k,307) - lu(k,1294) * b(k,220) + b(k,311) = b(k,311) - lu(k,1295) * b(k,220) + b(k,316) = b(k,316) - lu(k,1296) * b(k,220) + b(k,235) = b(k,235) - lu(k,1299) * b(k,221) + b(k,254) = b(k,254) - lu(k,1300) * b(k,221) + b(k,258) = b(k,258) - lu(k,1301) * b(k,221) + b(k,260) = b(k,260) - lu(k,1302) * b(k,221) + b(k,266) = b(k,266) - lu(k,1303) * b(k,221) + b(k,271) = b(k,271) - lu(k,1304) * b(k,221) + b(k,303) = b(k,303) - lu(k,1305) * b(k,221) + b(k,307) = b(k,307) - lu(k,1306) * b(k,221) + b(k,312) = b(k,312) - lu(k,1307) * b(k,221) + b(k,316) = b(k,316) - lu(k,1308) * b(k,221) + b(k,232) = b(k,232) - lu(k,1310) * b(k,222) + b(k,234) = b(k,234) - lu(k,1311) * b(k,222) + b(k,236) = b(k,236) - lu(k,1312) * b(k,222) + b(k,250) = b(k,250) - lu(k,1313) * b(k,222) + b(k,254) = b(k,254) - lu(k,1314) * b(k,222) + b(k,258) = b(k,258) - lu(k,1315) * b(k,222) + b(k,259) = b(k,259) - lu(k,1316) * b(k,222) + b(k,265) = b(k,265) - lu(k,1317) * b(k,222) + b(k,303) = b(k,303) - lu(k,1318) * b(k,222) + b(k,306) = b(k,306) - lu(k,1319) * b(k,222) + b(k,307) = b(k,307) - lu(k,1320) * b(k,222) + b(k,312) = b(k,312) - lu(k,1321) * b(k,222) + b(k,316) = b(k,316) - lu(k,1322) * b(k,222) + b(k,302) = b(k,302) - lu(k,1326) * b(k,223) + b(k,304) = b(k,304) - lu(k,1327) * b(k,223) + b(k,305) = b(k,305) - lu(k,1328) * b(k,223) + b(k,310) = b(k,310) - lu(k,1329) * b(k,223) + b(k,311) = b(k,311) - lu(k,1330) * b(k,223) + b(k,312) = b(k,312) - lu(k,1331) * b(k,223) + b(k,315) = b(k,315) - lu(k,1332) * b(k,223) + b(k,316) = b(k,316) - lu(k,1333) * b(k,223) + b(k,317) = b(k,317) - lu(k,1334) * b(k,223) + b(k,238) = b(k,238) - lu(k,1337) * b(k,224) + b(k,258) = b(k,258) - lu(k,1338) * b(k,224) + b(k,266) = b(k,266) - lu(k,1339) * b(k,224) + b(k,300) = b(k,300) - lu(k,1340) * b(k,224) + b(k,303) = b(k,303) - lu(k,1341) * b(k,224) + b(k,306) = b(k,306) - lu(k,1342) * b(k,224) + b(k,307) = b(k,307) - lu(k,1343) * b(k,224) + b(k,308) = b(k,308) - lu(k,1344) * b(k,224) + b(k,312) = b(k,312) - lu(k,1345) * b(k,224) + b(k,316) = b(k,316) - lu(k,1346) * b(k,224) + b(k,317) = b(k,317) - lu(k,1347) * b(k,224) + b(k,230) = b(k,230) - lu(k,1351) * b(k,225) + b(k,238) = b(k,238) - lu(k,1352) * b(k,225) + b(k,303) = b(k,303) - lu(k,1353) * b(k,225) + b(k,306) = b(k,306) - lu(k,1354) * b(k,225) + b(k,307) = b(k,307) - lu(k,1355) * b(k,225) + b(k,308) = b(k,308) - lu(k,1356) * b(k,225) + b(k,312) = b(k,312) - lu(k,1357) * b(k,225) + b(k,316) = b(k,316) - lu(k,1358) * b(k,225) + b(k,232) = b(k,232) - lu(k,1362) * b(k,226) + b(k,234) = b(k,234) - lu(k,1363) * b(k,226) + b(k,235) = b(k,235) - lu(k,1364) * b(k,226) + b(k,236) = b(k,236) - lu(k,1365) * b(k,226) + b(k,250) = b(k,250) - lu(k,1366) * b(k,226) + b(k,259) = b(k,259) - lu(k,1367) * b(k,226) + b(k,265) = b(k,265) - lu(k,1368) * b(k,226) + b(k,266) = b(k,266) - lu(k,1369) * b(k,226) + b(k,271) = b(k,271) - lu(k,1370) * b(k,226) + b(k,300) = b(k,300) - lu(k,1371) * b(k,226) + b(k,303) = b(k,303) - lu(k,1372) * b(k,226) + b(k,306) = b(k,306) - lu(k,1373) * b(k,226) + b(k,307) = b(k,307) - lu(k,1374) * b(k,226) + b(k,312) = b(k,312) - lu(k,1375) * b(k,226) + b(k,316) = b(k,316) - lu(k,1376) * b(k,226) + b(k,247) = b(k,247) - lu(k,1378) * b(k,227) + b(k,307) = b(k,307) - lu(k,1379) * b(k,227) + b(k,316) = b(k,316) - lu(k,1380) * b(k,227) + b(k,317) = b(k,317) - lu(k,1381) * b(k,227) + b(k,230) = b(k,230) - lu(k,1386) * b(k,228) + b(k,236) = b(k,236) - lu(k,1387) * b(k,228) + b(k,247) = b(k,247) - lu(k,1388) * b(k,228) + b(k,258) = b(k,258) - lu(k,1389) * b(k,228) + b(k,271) = b(k,271) - lu(k,1390) * b(k,228) + b(k,279) = b(k,279) - lu(k,1391) * b(k,228) + b(k,303) = b(k,303) - lu(k,1392) * b(k,228) + b(k,306) = b(k,306) - lu(k,1393) * b(k,228) + b(k,307) = b(k,307) - lu(k,1394) * b(k,228) + b(k,308) = b(k,308) - lu(k,1395) * b(k,228) + b(k,311) = b(k,311) - lu(k,1396) * b(k,228) + b(k,312) = b(k,312) - lu(k,1397) * b(k,228) + b(k,313) = b(k,313) - lu(k,1398) * b(k,228) + b(k,316) = b(k,316) - lu(k,1399) * b(k,228) + b(k,317) = b(k,317) - lu(k,1400) * b(k,228) + b(k,237) = b(k,237) - lu(k,1411) * b(k,229) + b(k,247) = b(k,247) - lu(k,1412) * b(k,229) + b(k,256) = b(k,256) - lu(k,1413) * b(k,229) + b(k,257) = b(k,257) - lu(k,1414) * b(k,229) + b(k,261) = b(k,261) - lu(k,1415) * b(k,229) + b(k,262) = b(k,262) - lu(k,1416) * b(k,229) + b(k,267) = b(k,267) - lu(k,1417) * b(k,229) + b(k,268) = b(k,268) - lu(k,1418) * b(k,229) + b(k,269) = b(k,269) - lu(k,1419) * b(k,229) + b(k,270) = b(k,270) - lu(k,1420) * b(k,229) + b(k,271) = b(k,271) - lu(k,1421) * b(k,229) + b(k,275) = b(k,275) - lu(k,1422) * b(k,229) + b(k,300) = b(k,300) - lu(k,1423) * b(k,229) + b(k,306) = b(k,306) - lu(k,1424) * b(k,229) + b(k,307) = b(k,307) - lu(k,1425) * b(k,229) + b(k,308) = b(k,308) - lu(k,1426) * b(k,229) + b(k,311) = b(k,311) - lu(k,1427) * b(k,229) + b(k,313) = b(k,313) - lu(k,1428) * b(k,229) + b(k,316) = b(k,316) - lu(k,1429) * b(k,229) + b(k,317) = b(k,317) - lu(k,1430) * b(k,229) + 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,271) = b(k,271) - lu(k,1432) * b(k,230) + b(k,300) = b(k,300) - lu(k,1433) * b(k,230) + b(k,302) = b(k,302) - lu(k,1434) * b(k,230) + b(k,307) = b(k,307) - lu(k,1435) * b(k,230) + b(k,308) = b(k,308) - lu(k,1436) * b(k,230) + b(k,311) = b(k,311) - lu(k,1437) * b(k,230) + b(k,316) = b(k,316) - lu(k,1438) * b(k,230) + b(k,317) = b(k,317) - lu(k,1439) * b(k,230) + b(k,232) = b(k,232) - lu(k,1441) * b(k,231) + b(k,234) = b(k,234) - lu(k,1442) * b(k,231) + b(k,236) = b(k,236) - lu(k,1443) * b(k,231) + b(k,250) = b(k,250) - lu(k,1444) * b(k,231) + b(k,254) = b(k,254) - lu(k,1445) * b(k,231) + b(k,258) = b(k,258) - lu(k,1446) * b(k,231) + b(k,259) = b(k,259) - lu(k,1447) * b(k,231) + b(k,265) = b(k,265) - lu(k,1448) * b(k,231) + b(k,303) = b(k,303) - lu(k,1449) * b(k,231) + b(k,306) = b(k,306) - lu(k,1450) * b(k,231) + b(k,307) = b(k,307) - lu(k,1451) * b(k,231) + b(k,312) = b(k,312) - lu(k,1452) * b(k,231) + b(k,316) = b(k,316) - lu(k,1453) * b(k,231) + b(k,247) = b(k,247) - lu(k,1455) * b(k,232) + b(k,271) = b(k,271) - lu(k,1456) * b(k,232) + b(k,306) = b(k,306) - lu(k,1457) * b(k,232) + b(k,307) = b(k,307) - lu(k,1458) * b(k,232) + b(k,312) = b(k,312) - lu(k,1459) * b(k,232) + b(k,316) = b(k,316) - lu(k,1460) * b(k,232) + b(k,258) = b(k,258) - lu(k,1462) * b(k,233) + b(k,266) = b(k,266) - lu(k,1463) * b(k,233) + b(k,271) = b(k,271) - lu(k,1464) * b(k,233) + b(k,306) = b(k,306) - lu(k,1465) * b(k,233) + b(k,307) = b(k,307) - lu(k,1466) * b(k,233) + b(k,316) = b(k,316) - lu(k,1467) * b(k,233) + b(k,254) = b(k,254) - lu(k,1469) * b(k,234) + b(k,258) = b(k,258) - lu(k,1470) * b(k,234) + b(k,260) = b(k,260) - lu(k,1471) * b(k,234) + b(k,307) = b(k,307) - lu(k,1472) * b(k,234) + b(k,312) = b(k,312) - lu(k,1473) * b(k,234) + b(k,316) = b(k,316) - lu(k,1474) * b(k,234) + b(k,247) = b(k,247) - lu(k,1477) * b(k,235) + b(k,271) = b(k,271) - lu(k,1478) * b(k,235) + b(k,307) = b(k,307) - lu(k,1479) * b(k,235) + b(k,316) = b(k,316) - lu(k,1480) * b(k,235) + b(k,266) = b(k,266) - lu(k,1482) * b(k,236) + b(k,300) = b(k,300) - lu(k,1483) * b(k,236) + b(k,306) = b(k,306) - lu(k,1484) * b(k,236) + b(k,312) = b(k,312) - lu(k,1485) * b(k,236) + b(k,316) = b(k,316) - lu(k,1486) * b(k,236) + b(k,304) = b(k,304) - lu(k,1488) * b(k,237) + b(k,305) = b(k,305) - lu(k,1489) * b(k,237) + b(k,307) = b(k,307) - lu(k,1490) * b(k,237) + b(k,315) = b(k,315) - lu(k,1491) * b(k,237) + b(k,316) = b(k,316) - lu(k,1492) * b(k,237) + b(k,317) = b(k,317) - lu(k,1493) * b(k,237) + b(k,306) = b(k,306) - lu(k,1495) * b(k,238) + b(k,307) = b(k,307) - lu(k,1496) * b(k,238) + b(k,316) = b(k,316) - lu(k,1497) * b(k,238) + b(k,254) = b(k,254) - lu(k,1499) * b(k,239) + b(k,266) = b(k,266) - lu(k,1500) * b(k,239) + b(k,271) = b(k,271) - lu(k,1501) * b(k,239) + b(k,300) = b(k,300) - lu(k,1502) * b(k,239) + b(k,306) = b(k,306) - lu(k,1503) * b(k,239) + b(k,307) = b(k,307) - lu(k,1504) * b(k,239) + b(k,316) = b(k,316) - lu(k,1505) * b(k,239) + b(k,247) = b(k,247) - lu(k,1509) * b(k,240) + b(k,254) = b(k,254) - lu(k,1510) * b(k,240) + b(k,265) = b(k,265) - lu(k,1511) * b(k,240) + b(k,266) = b(k,266) - lu(k,1512) * b(k,240) + b(k,271) = b(k,271) - lu(k,1513) * b(k,240) + b(k,300) = b(k,300) - lu(k,1514) * b(k,240) + b(k,303) = b(k,303) - lu(k,1515) * b(k,240) + b(k,306) = b(k,306) - lu(k,1516) * b(k,240) + b(k,307) = b(k,307) - lu(k,1517) * b(k,240) + b(k,308) = b(k,308) - lu(k,1518) * b(k,240) + b(k,312) = b(k,312) - lu(k,1519) * b(k,240) + b(k,316) = b(k,316) - lu(k,1520) * b(k,240) + b(k,247) = b(k,247) - lu(k,1525) * b(k,241) + b(k,254) = b(k,254) - lu(k,1526) * b(k,241) + b(k,258) = b(k,258) - lu(k,1527) * b(k,241) + b(k,260) = b(k,260) - lu(k,1528) * b(k,241) + b(k,266) = b(k,266) - lu(k,1529) * b(k,241) + b(k,271) = b(k,271) - lu(k,1530) * b(k,241) + b(k,303) = b(k,303) - lu(k,1531) * b(k,241) + b(k,306) = b(k,306) - lu(k,1532) * b(k,241) + b(k,307) = b(k,307) - lu(k,1533) * b(k,241) + b(k,312) = b(k,312) - lu(k,1534) * b(k,241) + b(k,316) = b(k,316) - lu(k,1535) * b(k,241) + b(k,284) = b(k,284) - lu(k,1537) * b(k,242) + b(k,302) = b(k,302) - lu(k,1538) * b(k,242) + b(k,307) = b(k,307) - lu(k,1539) * b(k,242) + b(k,312) = b(k,312) - lu(k,1540) * b(k,242) + b(k,316) = b(k,316) - lu(k,1541) * b(k,242) + b(k,247) = b(k,247) - lu(k,1544) * b(k,243) + b(k,258) = b(k,258) - lu(k,1545) * b(k,243) + b(k,259) = b(k,259) - lu(k,1546) * b(k,243) + b(k,266) = b(k,266) - lu(k,1547) * b(k,243) + b(k,271) = b(k,271) - lu(k,1548) * b(k,243) + b(k,280) = b(k,280) - lu(k,1549) * b(k,243) + b(k,300) = b(k,300) - lu(k,1550) * b(k,243) + b(k,303) = b(k,303) - lu(k,1551) * b(k,243) + b(k,306) = b(k,306) - lu(k,1552) * b(k,243) + b(k,307) = b(k,307) - lu(k,1553) * b(k,243) + b(k,308) = b(k,308) - lu(k,1554) * b(k,243) + b(k,312) = b(k,312) - lu(k,1555) * b(k,243) + b(k,316) = b(k,316) - lu(k,1556) * b(k,243) + b(k,284) = b(k,284) - lu(k,1558) * b(k,244) + b(k,307) = b(k,307) - lu(k,1559) * b(k,244) + b(k,312) = b(k,312) - lu(k,1560) * b(k,244) + b(k,316) = b(k,316) - lu(k,1561) * b(k,244) + b(k,247) = b(k,247) - lu(k,1573) * b(k,245) + b(k,249) = b(k,249) - lu(k,1574) * b(k,245) + b(k,250) = b(k,250) - lu(k,1575) * b(k,245) + b(k,254) = b(k,254) - lu(k,1576) * b(k,245) + b(k,258) = b(k,258) - lu(k,1577) * b(k,245) + b(k,259) = b(k,259) - lu(k,1578) * b(k,245) + b(k,260) = b(k,260) - lu(k,1579) * b(k,245) + b(k,265) = b(k,265) - lu(k,1580) * b(k,245) + b(k,266) = b(k,266) - lu(k,1581) * b(k,245) + b(k,271) = b(k,271) - lu(k,1582) * b(k,245) + b(k,274) = b(k,274) - lu(k,1583) * b(k,245) + b(k,275) = b(k,275) - lu(k,1584) * b(k,245) + b(k,300) = b(k,300) - lu(k,1585) * b(k,245) + b(k,302) = b(k,302) - lu(k,1586) * b(k,245) + b(k,303) = b(k,303) - lu(k,1587) * b(k,245) + b(k,304) = b(k,304) - lu(k,1588) * b(k,245) + b(k,305) = b(k,305) - lu(k,1589) * b(k,245) + b(k,306) = b(k,306) - lu(k,1590) * b(k,245) + b(k,307) = b(k,307) - lu(k,1591) * b(k,245) + b(k,312) = b(k,312) - lu(k,1592) * b(k,245) + b(k,313) = b(k,313) - lu(k,1593) * b(k,245) + b(k,315) = b(k,315) - lu(k,1594) * b(k,245) + b(k,316) = b(k,316) - lu(k,1595) * b(k,245) + b(k,317) = b(k,317) - lu(k,1596) * b(k,245) + b(k,276) = b(k,276) - lu(k,1601) * b(k,246) + b(k,301) = b(k,301) - lu(k,1602) * b(k,246) + b(k,303) = b(k,303) - lu(k,1603) * b(k,246) + b(k,305) = b(k,305) - lu(k,1604) * b(k,246) + b(k,307) = b(k,307) - lu(k,1605) * b(k,246) + b(k,309) = b(k,309) - lu(k,1606) * b(k,246) + b(k,310) = b(k,310) - lu(k,1607) * b(k,246) + b(k,312) = b(k,312) - lu(k,1608) * b(k,246) + b(k,313) = b(k,313) - lu(k,1609) * b(k,246) + b(k,315) = b(k,315) - lu(k,1610) * b(k,246) + b(k,316) = b(k,316) - lu(k,1611) * b(k,246) + b(k,317) = b(k,317) - lu(k,1612) * b(k,246) + b(k,271) = b(k,271) - lu(k,1614) * b(k,247) + b(k,305) = b(k,305) - lu(k,1615) * b(k,247) + b(k,258) = b(k,258) - lu(k,1621) * b(k,248) + b(k,271) = b(k,271) - lu(k,1622) * b(k,248) + b(k,300) = b(k,300) - lu(k,1623) * b(k,248) + b(k,303) = b(k,303) - lu(k,1624) * b(k,248) + b(k,305) = b(k,305) - lu(k,1625) * b(k,248) + b(k,306) = b(k,306) - lu(k,1626) * b(k,248) + b(k,307) = b(k,307) - lu(k,1627) * b(k,248) + b(k,308) = b(k,308) - lu(k,1628) * b(k,248) + b(k,311) = b(k,311) - lu(k,1629) * b(k,248) + b(k,312) = b(k,312) - lu(k,1630) * b(k,248) + b(k,313) = b(k,313) - lu(k,1631) * b(k,248) + b(k,316) = b(k,316) - lu(k,1632) * b(k,248) + b(k,317) = b(k,317) - lu(k,1633) * b(k,248) + b(k,254) = b(k,254) - lu(k,1641) * b(k,249) + b(k,258) = b(k,258) - lu(k,1642) * b(k,249) + b(k,259) = b(k,259) - lu(k,1643) * b(k,249) + b(k,260) = b(k,260) - lu(k,1644) * b(k,249) + b(k,265) = b(k,265) - lu(k,1645) * b(k,249) + b(k,266) = b(k,266) - lu(k,1646) * b(k,249) + b(k,271) = b(k,271) - lu(k,1647) * b(k,249) + b(k,300) = b(k,300) - lu(k,1648) * b(k,249) + b(k,302) = b(k,302) - lu(k,1649) * b(k,249) + b(k,303) = b(k,303) - lu(k,1650) * b(k,249) + b(k,305) = b(k,305) - lu(k,1651) * b(k,249) + b(k,306) = b(k,306) - lu(k,1652) * b(k,249) + b(k,307) = b(k,307) - lu(k,1653) * b(k,249) + b(k,312) = b(k,312) - lu(k,1654) * b(k,249) + b(k,316) = b(k,316) - lu(k,1655) * b(k,249) + b(k,254) = b(k,254) - lu(k,1660) * b(k,250) + b(k,258) = b(k,258) - lu(k,1661) * b(k,250) + b(k,259) = b(k,259) - lu(k,1662) * b(k,250) + b(k,265) = b(k,265) - lu(k,1663) * b(k,250) + b(k,266) = b(k,266) - lu(k,1664) * b(k,250) + b(k,271) = b(k,271) - lu(k,1665) * b(k,250) + b(k,302) = b(k,302) - lu(k,1666) * b(k,250) + b(k,305) = b(k,305) - lu(k,1667) * b(k,250) + b(k,307) = b(k,307) - lu(k,1668) * b(k,250) + b(k,312) = b(k,312) - lu(k,1669) * b(k,250) + b(k,316) = b(k,316) - lu(k,1670) * b(k,250) + b(k,279) = b(k,279) - lu(k,1674) * b(k,251) + b(k,301) = b(k,301) - lu(k,1675) * b(k,251) + b(k,302) = b(k,302) - lu(k,1676) * b(k,251) + b(k,304) = b(k,304) - lu(k,1677) * b(k,251) + b(k,305) = b(k,305) - lu(k,1678) * b(k,251) + b(k,308) = b(k,308) - lu(k,1679) * b(k,251) + b(k,311) = b(k,311) - lu(k,1680) * b(k,251) + b(k,314) = b(k,314) - lu(k,1681) * b(k,251) + b(k,315) = b(k,315) - lu(k,1682) * b(k,251) + b(k,316) = b(k,316) - lu(k,1683) * b(k,251) + b(k,317) = b(k,317) - lu(k,1684) * b(k,251) + b(k,284) = b(k,284) - lu(k,1690) * b(k,252) + b(k,293) = b(k,293) - lu(k,1691) * b(k,252) + b(k,302) = b(k,302) - lu(k,1692) * b(k,252) + b(k,303) = b(k,303) - lu(k,1693) * b(k,252) + b(k,307) = b(k,307) - lu(k,1694) * b(k,252) + b(k,312) = b(k,312) - lu(k,1695) * b(k,252) + b(k,316) = b(k,316) - lu(k,1696) * b(k,252) + 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,284) = b(k,284) - lu(k,1703) * b(k,253) + b(k,293) = b(k,293) - lu(k,1704) * b(k,253) + b(k,302) = b(k,302) - lu(k,1705) * b(k,253) + b(k,303) = b(k,303) - lu(k,1706) * b(k,253) + b(k,307) = b(k,307) - lu(k,1707) * b(k,253) + b(k,312) = b(k,312) - lu(k,1708) * b(k,253) + b(k,316) = b(k,316) - lu(k,1709) * b(k,253) + b(k,271) = b(k,271) - lu(k,1713) * b(k,254) + b(k,305) = b(k,305) - lu(k,1714) * b(k,254) + b(k,306) = b(k,306) - lu(k,1715) * b(k,254) + b(k,307) = b(k,307) - lu(k,1716) * b(k,254) + b(k,316) = b(k,316) - lu(k,1717) * b(k,254) + b(k,271) = b(k,271) - lu(k,1719) * b(k,255) + b(k,295) = b(k,295) - lu(k,1720) * b(k,255) + b(k,298) = b(k,298) - lu(k,1721) * b(k,255) + b(k,302) = b(k,302) - lu(k,1722) * b(k,255) + b(k,307) = b(k,307) - lu(k,1723) * b(k,255) + b(k,311) = b(k,311) - lu(k,1724) * b(k,255) + b(k,316) = b(k,316) - lu(k,1725) * b(k,255) + b(k,258) = b(k,258) - lu(k,1733) * b(k,256) + b(k,263) = b(k,263) - lu(k,1734) * b(k,256) + b(k,264) = b(k,264) - lu(k,1735) * b(k,256) + b(k,266) = b(k,266) - lu(k,1736) * b(k,256) + b(k,267) = b(k,267) - lu(k,1737) * b(k,256) + b(k,271) = b(k,271) - lu(k,1738) * b(k,256) + b(k,273) = b(k,273) - lu(k,1739) * b(k,256) + b(k,300) = b(k,300) - lu(k,1740) * b(k,256) + b(k,303) = b(k,303) - lu(k,1741) * b(k,256) + b(k,305) = b(k,305) - lu(k,1742) * b(k,256) + b(k,306) = b(k,306) - lu(k,1743) * b(k,256) + b(k,307) = b(k,307) - lu(k,1744) * b(k,256) + b(k,308) = b(k,308) - lu(k,1745) * b(k,256) + b(k,312) = b(k,312) - lu(k,1746) * b(k,256) + b(k,316) = b(k,316) - lu(k,1747) * b(k,256) + b(k,258) = b(k,258) - lu(k,1755) * b(k,257) + b(k,263) = b(k,263) - lu(k,1756) * b(k,257) + b(k,264) = b(k,264) - lu(k,1757) * b(k,257) + b(k,266) = b(k,266) - lu(k,1758) * b(k,257) + b(k,268) = b(k,268) - lu(k,1759) * b(k,257) + b(k,271) = b(k,271) - lu(k,1760) * b(k,257) + b(k,272) = b(k,272) - lu(k,1761) * b(k,257) + b(k,300) = b(k,300) - lu(k,1762) * b(k,257) + b(k,303) = b(k,303) - lu(k,1763) * b(k,257) + b(k,305) = b(k,305) - lu(k,1764) * b(k,257) + b(k,306) = b(k,306) - lu(k,1765) * b(k,257) + b(k,307) = b(k,307) - lu(k,1766) * b(k,257) + b(k,308) = b(k,308) - lu(k,1767) * b(k,257) + b(k,312) = b(k,312) - lu(k,1768) * b(k,257) + b(k,316) = b(k,316) - lu(k,1769) * b(k,257) + b(k,266) = b(k,266) - lu(k,1771) * b(k,258) + b(k,300) = b(k,300) - lu(k,1772) * b(k,258) + b(k,306) = b(k,306) - lu(k,1773) * b(k,258) + b(k,307) = b(k,307) - lu(k,1774) * b(k,258) + b(k,316) = b(k,316) - lu(k,1775) * b(k,258) + b(k,266) = b(k,266) - lu(k,1779) * b(k,259) + b(k,271) = b(k,271) - lu(k,1780) * b(k,259) + b(k,300) = b(k,300) - lu(k,1781) * b(k,259) + b(k,306) = b(k,306) - lu(k,1782) * b(k,259) + b(k,307) = b(k,307) - lu(k,1783) * b(k,259) + b(k,312) = b(k,312) - lu(k,1784) * b(k,259) + b(k,316) = b(k,316) - lu(k,1785) * b(k,259) + b(k,265) = b(k,265) - lu(k,1794) * b(k,260) + b(k,266) = b(k,266) - lu(k,1795) * b(k,260) + b(k,271) = b(k,271) - lu(k,1796) * b(k,260) + b(k,300) = b(k,300) - lu(k,1797) * b(k,260) + b(k,305) = b(k,305) - lu(k,1798) * b(k,260) + b(k,306) = b(k,306) - lu(k,1799) * b(k,260) + b(k,307) = b(k,307) - lu(k,1800) * b(k,260) + b(k,312) = b(k,312) - lu(k,1801) * b(k,260) + b(k,316) = b(k,316) - lu(k,1802) * b(k,260) + b(k,263) = b(k,263) - lu(k,1818) * b(k,261) + b(k,264) = b(k,264) - lu(k,1819) * b(k,261) + b(k,266) = b(k,266) - lu(k,1820) * b(k,261) + b(k,268) = b(k,268) - lu(k,1821) * b(k,261) + b(k,269) = b(k,269) - lu(k,1822) * b(k,261) + b(k,271) = b(k,271) - lu(k,1823) * b(k,261) + b(k,272) = b(k,272) - lu(k,1824) * b(k,261) + b(k,280) = b(k,280) - lu(k,1825) * b(k,261) + b(k,300) = b(k,300) - lu(k,1826) * b(k,261) + b(k,303) = b(k,303) - lu(k,1827) * b(k,261) + b(k,305) = b(k,305) - lu(k,1828) * b(k,261) + b(k,306) = b(k,306) - lu(k,1829) * b(k,261) + b(k,307) = b(k,307) - lu(k,1830) * b(k,261) + b(k,308) = b(k,308) - lu(k,1831) * b(k,261) + b(k,312) = b(k,312) - lu(k,1832) * b(k,261) + b(k,316) = b(k,316) - lu(k,1833) * b(k,261) + b(k,263) = b(k,263) - lu(k,1849) * b(k,262) + b(k,264) = b(k,264) - lu(k,1850) * b(k,262) + b(k,265) = b(k,265) - lu(k,1851) * b(k,262) + b(k,266) = b(k,266) - lu(k,1852) * b(k,262) + b(k,267) = b(k,267) - lu(k,1853) * b(k,262) + b(k,270) = b(k,270) - lu(k,1854) * b(k,262) + b(k,271) = b(k,271) - lu(k,1855) * b(k,262) + b(k,273) = b(k,273) - lu(k,1856) * b(k,262) + b(k,300) = b(k,300) - lu(k,1857) * b(k,262) + b(k,303) = b(k,303) - lu(k,1858) * b(k,262) + b(k,305) = b(k,305) - lu(k,1859) * b(k,262) + b(k,306) = b(k,306) - lu(k,1860) * b(k,262) + b(k,307) = b(k,307) - lu(k,1861) * b(k,262) + b(k,308) = b(k,308) - lu(k,1862) * b(k,262) + b(k,312) = b(k,312) - lu(k,1863) * b(k,262) + b(k,316) = b(k,316) - lu(k,1864) * b(k,262) + b(k,317) = b(k,317) - lu(k,1865) * b(k,262) + b(k,265) = b(k,265) - lu(k,1873) * b(k,263) + b(k,266) = b(k,266) - lu(k,1874) * b(k,263) + b(k,271) = b(k,271) - lu(k,1875) * b(k,263) + b(k,300) = b(k,300) - lu(k,1876) * b(k,263) + b(k,303) = b(k,303) - lu(k,1877) * b(k,263) + b(k,305) = b(k,305) - lu(k,1878) * b(k,263) + b(k,306) = b(k,306) - lu(k,1879) * b(k,263) + b(k,307) = b(k,307) - lu(k,1880) * b(k,263) + b(k,312) = b(k,312) - lu(k,1881) * b(k,263) + b(k,316) = b(k,316) - lu(k,1882) * b(k,263) + b(k,265) = b(k,265) - lu(k,1897) * b(k,264) + b(k,266) = b(k,266) - lu(k,1898) * b(k,264) + b(k,267) = b(k,267) - lu(k,1899) * b(k,264) + b(k,268) = b(k,268) - lu(k,1900) * b(k,264) + b(k,269) = b(k,269) - lu(k,1901) * b(k,264) + b(k,270) = b(k,270) - lu(k,1902) * b(k,264) + b(k,271) = b(k,271) - lu(k,1903) * b(k,264) + b(k,300) = b(k,300) - lu(k,1904) * b(k,264) + b(k,303) = b(k,303) - lu(k,1905) * b(k,264) + b(k,305) = b(k,305) - lu(k,1906) * b(k,264) + b(k,306) = b(k,306) - lu(k,1907) * b(k,264) + b(k,307) = b(k,307) - lu(k,1908) * b(k,264) + b(k,312) = b(k,312) - lu(k,1909) * b(k,264) + b(k,316) = b(k,316) - lu(k,1910) * b(k,264) + b(k,266) = b(k,266) - lu(k,1917) * b(k,265) + b(k,271) = b(k,271) - lu(k,1918) * b(k,265) + b(k,300) = b(k,300) - lu(k,1919) * b(k,265) + b(k,302) = b(k,302) - lu(k,1920) * b(k,265) + b(k,305) = b(k,305) - lu(k,1921) * b(k,265) + b(k,306) = b(k,306) - lu(k,1922) * b(k,265) + b(k,307) = b(k,307) - lu(k,1923) * b(k,265) + b(k,312) = b(k,312) - lu(k,1924) * b(k,265) + b(k,316) = b(k,316) - lu(k,1925) * b(k,265) + b(k,271) = b(k,271) - lu(k,1927) * b(k,266) + b(k,300) = b(k,300) - lu(k,1928) * b(k,266) + b(k,302) = b(k,302) - lu(k,1929) * b(k,266) + b(k,307) = b(k,307) - lu(k,1930) * b(k,266) + b(k,311) = b(k,311) - lu(k,1931) * b(k,266) + b(k,316) = b(k,316) - lu(k,1932) * b(k,266) + b(k,317) = b(k,317) - lu(k,1933) * b(k,266) + b(k,268) = b(k,268) - lu(k,1954) * b(k,267) + b(k,269) = b(k,269) - lu(k,1955) * b(k,267) + b(k,270) = b(k,270) - lu(k,1956) * b(k,267) + b(k,271) = b(k,271) - lu(k,1957) * b(k,267) + b(k,273) = b(k,273) - lu(k,1958) * b(k,267) + b(k,300) = b(k,300) - lu(k,1959) * b(k,267) + b(k,302) = b(k,302) - lu(k,1960) * b(k,267) + b(k,303) = b(k,303) - lu(k,1961) * b(k,267) + b(k,305) = b(k,305) - lu(k,1962) * b(k,267) + b(k,306) = b(k,306) - lu(k,1963) * b(k,267) + b(k,307) = b(k,307) - lu(k,1964) * b(k,267) + b(k,308) = b(k,308) - lu(k,1965) * b(k,267) + b(k,311) = b(k,311) - lu(k,1966) * b(k,267) + b(k,312) = b(k,312) - lu(k,1967) * b(k,267) + b(k,316) = b(k,316) - lu(k,1968) * b(k,267) + b(k,317) = b(k,317) - lu(k,1969) * b(k,267) + b(k,269) = b(k,269) - lu(k,1992) * b(k,268) + b(k,270) = b(k,270) - lu(k,1993) * b(k,268) + b(k,271) = b(k,271) - lu(k,1994) * b(k,268) + b(k,272) = b(k,272) - lu(k,1995) * b(k,268) + b(k,273) = b(k,273) - lu(k,1996) * b(k,268) + b(k,280) = b(k,280) - lu(k,1997) * b(k,268) + b(k,300) = b(k,300) - lu(k,1998) * b(k,268) + b(k,302) = b(k,302) - lu(k,1999) * b(k,268) + b(k,303) = b(k,303) - lu(k,2000) * b(k,268) + b(k,305) = b(k,305) - lu(k,2001) * b(k,268) + b(k,306) = b(k,306) - lu(k,2002) * b(k,268) + b(k,307) = b(k,307) - lu(k,2003) * b(k,268) + b(k,308) = b(k,308) - lu(k,2004) * b(k,268) + b(k,311) = b(k,311) - lu(k,2005) * b(k,268) + b(k,312) = b(k,312) - lu(k,2006) * b(k,268) + b(k,316) = b(k,316) - lu(k,2007) * b(k,268) + b(k,317) = b(k,317) - lu(k,2008) * b(k,268) + b(k,271) = b(k,271) - lu(k,2017) * b(k,269) + b(k,280) = b(k,280) - lu(k,2018) * b(k,269) + b(k,300) = b(k,300) - lu(k,2019) * b(k,269) + b(k,302) = b(k,302) - lu(k,2020) * b(k,269) + b(k,303) = b(k,303) - lu(k,2021) * b(k,269) + b(k,305) = b(k,305) - lu(k,2022) * b(k,269) + b(k,306) = b(k,306) - lu(k,2023) * b(k,269) + b(k,307) = b(k,307) - lu(k,2024) * b(k,269) + b(k,308) = b(k,308) - lu(k,2025) * b(k,269) + b(k,311) = b(k,311) - lu(k,2026) * b(k,269) + b(k,312) = b(k,312) - lu(k,2027) * b(k,269) + b(k,313) = b(k,313) - lu(k,2028) * b(k,269) + b(k,316) = b(k,316) - lu(k,2029) * b(k,269) + b(k,317) = b(k,317) - lu(k,2030) * b(k,269) + b(k,271) = b(k,271) - lu(k,2042) * b(k,270) + b(k,279) = b(k,279) - lu(k,2043) * b(k,270) + b(k,300) = b(k,300) - lu(k,2044) * b(k,270) + b(k,302) = b(k,302) - lu(k,2045) * b(k,270) + b(k,303) = b(k,303) - lu(k,2046) * b(k,270) + b(k,305) = b(k,305) - lu(k,2047) * b(k,270) + b(k,306) = b(k,306) - lu(k,2048) * b(k,270) + b(k,307) = b(k,307) - lu(k,2049) * b(k,270) + b(k,308) = b(k,308) - lu(k,2050) * b(k,270) + b(k,311) = b(k,311) - lu(k,2051) * b(k,270) + b(k,312) = b(k,312) - lu(k,2052) * b(k,270) + b(k,313) = b(k,313) - lu(k,2053) * b(k,270) + b(k,316) = b(k,316) - lu(k,2054) * b(k,270) + b(k,317) = b(k,317) - lu(k,2055) * b(k,270) + 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,305) = b(k,305) - lu(k,2058) * b(k,271) + b(k,307) = b(k,307) - lu(k,2059) * b(k,271) + b(k,316) = b(k,316) - lu(k,2060) * b(k,271) + b(k,274) = b(k,274) - lu(k,2079) * b(k,272) + b(k,300) = b(k,300) - lu(k,2080) * b(k,272) + b(k,302) = b(k,302) - lu(k,2081) * b(k,272) + b(k,303) = b(k,303) - lu(k,2082) * b(k,272) + b(k,304) = b(k,304) - lu(k,2083) * b(k,272) + b(k,305) = b(k,305) - lu(k,2084) * b(k,272) + b(k,306) = b(k,306) - lu(k,2085) * b(k,272) + b(k,307) = b(k,307) - lu(k,2086) * b(k,272) + b(k,311) = b(k,311) - lu(k,2087) * b(k,272) + b(k,312) = b(k,312) - lu(k,2088) * b(k,272) + b(k,313) = b(k,313) - lu(k,2089) * b(k,272) + b(k,315) = b(k,315) - lu(k,2090) * b(k,272) + b(k,316) = b(k,316) - lu(k,2091) * b(k,272) + b(k,317) = b(k,317) - lu(k,2092) * b(k,272) + b(k,274) = b(k,274) - lu(k,2111) * b(k,273) + b(k,300) = b(k,300) - lu(k,2112) * b(k,273) + b(k,302) = b(k,302) - lu(k,2113) * b(k,273) + b(k,303) = b(k,303) - lu(k,2114) * b(k,273) + b(k,304) = b(k,304) - lu(k,2115) * b(k,273) + b(k,305) = b(k,305) - lu(k,2116) * b(k,273) + b(k,306) = b(k,306) - lu(k,2117) * b(k,273) + b(k,307) = b(k,307) - lu(k,2118) * b(k,273) + b(k,311) = b(k,311) - lu(k,2119) * b(k,273) + b(k,312) = b(k,312) - lu(k,2120) * b(k,273) + b(k,313) = b(k,313) - lu(k,2121) * b(k,273) + b(k,315) = b(k,315) - lu(k,2122) * b(k,273) + b(k,316) = b(k,316) - lu(k,2123) * b(k,273) + b(k,317) = b(k,317) - lu(k,2124) * b(k,273) + b(k,300) = b(k,300) - lu(k,2141) * b(k,274) + b(k,302) = b(k,302) - lu(k,2142) * b(k,274) + b(k,303) = b(k,303) - lu(k,2143) * b(k,274) + b(k,304) = b(k,304) - lu(k,2144) * b(k,274) + b(k,305) = b(k,305) - lu(k,2145) * b(k,274) + b(k,306) = b(k,306) - lu(k,2146) * b(k,274) + b(k,307) = b(k,307) - lu(k,2147) * b(k,274) + b(k,311) = b(k,311) - lu(k,2148) * b(k,274) + b(k,312) = b(k,312) - lu(k,2149) * b(k,274) + b(k,313) = b(k,313) - lu(k,2150) * b(k,274) + b(k,315) = b(k,315) - lu(k,2151) * b(k,274) + b(k,316) = b(k,316) - lu(k,2152) * b(k,274) + b(k,317) = b(k,317) - lu(k,2153) * b(k,274) + b(k,279) = b(k,279) - lu(k,2181) * b(k,275) + b(k,280) = b(k,280) - lu(k,2182) * b(k,275) + b(k,300) = b(k,300) - lu(k,2183) * b(k,275) + b(k,302) = b(k,302) - lu(k,2184) * b(k,275) + b(k,303) = b(k,303) - lu(k,2185) * b(k,275) + b(k,304) = b(k,304) - lu(k,2186) * b(k,275) + b(k,305) = b(k,305) - lu(k,2187) * b(k,275) + b(k,306) = b(k,306) - lu(k,2188) * b(k,275) + b(k,307) = b(k,307) - lu(k,2189) * b(k,275) + b(k,308) = b(k,308) - lu(k,2190) * b(k,275) + b(k,311) = b(k,311) - lu(k,2191) * b(k,275) + b(k,312) = b(k,312) - lu(k,2192) * b(k,275) + b(k,313) = b(k,313) - lu(k,2193) * b(k,275) + b(k,315) = b(k,315) - lu(k,2194) * b(k,275) + b(k,316) = b(k,316) - lu(k,2195) * b(k,275) + b(k,317) = b(k,317) - lu(k,2196) * b(k,275) + b(k,301) = b(k,301) - lu(k,2200) * b(k,276) + b(k,305) = b(k,305) - lu(k,2201) * b(k,276) + b(k,306) = b(k,306) - lu(k,2202) * b(k,276) + b(k,307) = b(k,307) - lu(k,2203) * b(k,276) + b(k,309) = b(k,309) - lu(k,2204) * b(k,276) + b(k,313) = b(k,313) - lu(k,2205) * b(k,276) + b(k,314) = b(k,314) - lu(k,2206) * b(k,276) + b(k,316) = b(k,316) - lu(k,2207) * b(k,276) + b(k,317) = b(k,317) - lu(k,2208) * b(k,276) + b(k,292) = b(k,292) - lu(k,2214) * b(k,277) + b(k,294) = b(k,294) - lu(k,2215) * b(k,277) + b(k,295) = b(k,295) - lu(k,2216) * b(k,277) + b(k,296) = b(k,296) - lu(k,2217) * b(k,277) + b(k,297) = b(k,297) - lu(k,2218) * b(k,277) + b(k,298) = b(k,298) - lu(k,2219) * b(k,277) + b(k,299) = b(k,299) - lu(k,2220) * b(k,277) + b(k,300) = b(k,300) - lu(k,2221) * b(k,277) + b(k,303) = b(k,303) - lu(k,2222) * b(k,277) + b(k,305) = b(k,305) - lu(k,2223) * b(k,277) + b(k,306) = b(k,306) - lu(k,2224) * b(k,277) + b(k,307) = b(k,307) - lu(k,2225) * b(k,277) + b(k,308) = b(k,308) - lu(k,2226) * b(k,277) + b(k,311) = b(k,311) - lu(k,2227) * b(k,277) + b(k,312) = b(k,312) - lu(k,2228) * b(k,277) + b(k,316) = b(k,316) - lu(k,2229) * b(k,277) + b(k,280) = b(k,280) - lu(k,2236) * b(k,278) + b(k,284) = b(k,284) - lu(k,2237) * b(k,278) + b(k,294) = b(k,294) - lu(k,2238) * b(k,278) + b(k,295) = b(k,295) - lu(k,2239) * b(k,278) + b(k,296) = b(k,296) - lu(k,2240) * b(k,278) + b(k,297) = b(k,297) - lu(k,2241) * b(k,278) + b(k,298) = b(k,298) - lu(k,2242) * b(k,278) + b(k,299) = b(k,299) - lu(k,2243) * b(k,278) + b(k,300) = b(k,300) - lu(k,2244) * b(k,278) + b(k,302) = b(k,302) - lu(k,2245) * b(k,278) + b(k,303) = b(k,303) - lu(k,2246) * b(k,278) + b(k,305) = b(k,305) - lu(k,2247) * b(k,278) + b(k,306) = b(k,306) - lu(k,2248) * b(k,278) + b(k,307) = b(k,307) - lu(k,2249) * b(k,278) + b(k,308) = b(k,308) - lu(k,2250) * b(k,278) + b(k,311) = b(k,311) - lu(k,2251) * b(k,278) + b(k,312) = b(k,312) - lu(k,2252) * b(k,278) + b(k,316) = b(k,316) - lu(k,2253) * b(k,278) + b(k,301) = b(k,301) - lu(k,2260) * b(k,279) + b(k,302) = b(k,302) - lu(k,2261) * b(k,279) + b(k,304) = b(k,304) - lu(k,2262) * b(k,279) + b(k,305) = b(k,305) - lu(k,2263) * b(k,279) + b(k,306) = b(k,306) - lu(k,2264) * b(k,279) + b(k,307) = b(k,307) - lu(k,2265) * b(k,279) + b(k,308) = b(k,308) - lu(k,2266) * b(k,279) + b(k,311) = b(k,311) - lu(k,2267) * b(k,279) + b(k,314) = b(k,314) - lu(k,2268) * b(k,279) + b(k,315) = b(k,315) - lu(k,2269) * b(k,279) + b(k,316) = b(k,316) - lu(k,2270) * b(k,279) + b(k,317) = b(k,317) - lu(k,2271) * b(k,279) + b(k,300) = b(k,300) - lu(k,2278) * b(k,280) + b(k,302) = b(k,302) - lu(k,2279) * b(k,280) + b(k,303) = b(k,303) - lu(k,2280) * b(k,280) + b(k,305) = b(k,305) - lu(k,2281) * b(k,280) + b(k,306) = b(k,306) - lu(k,2282) * b(k,280) + b(k,307) = b(k,307) - lu(k,2283) * b(k,280) + b(k,308) = b(k,308) - lu(k,2284) * b(k,280) + b(k,311) = b(k,311) - lu(k,2285) * b(k,280) + b(k,312) = b(k,312) - lu(k,2286) * b(k,280) + b(k,316) = b(k,316) - lu(k,2287) * b(k,280) + b(k,317) = b(k,317) - lu(k,2288) * b(k,280) + b(k,284) = b(k,284) - lu(k,2297) * b(k,281) + b(k,294) = b(k,294) - lu(k,2298) * b(k,281) + b(k,295) = b(k,295) - lu(k,2299) * b(k,281) + b(k,296) = b(k,296) - lu(k,2300) * b(k,281) + b(k,297) = b(k,297) - lu(k,2301) * b(k,281) + b(k,298) = b(k,298) - lu(k,2302) * b(k,281) + b(k,299) = b(k,299) - lu(k,2303) * b(k,281) + b(k,300) = b(k,300) - lu(k,2304) * b(k,281) + b(k,302) = b(k,302) - lu(k,2305) * b(k,281) + b(k,303) = b(k,303) - lu(k,2306) * b(k,281) + b(k,305) = b(k,305) - lu(k,2307) * b(k,281) + b(k,306) = b(k,306) - lu(k,2308) * b(k,281) + b(k,307) = b(k,307) - lu(k,2309) * b(k,281) + b(k,308) = b(k,308) - lu(k,2310) * b(k,281) + b(k,311) = b(k,311) - lu(k,2311) * b(k,281) + b(k,312) = b(k,312) - lu(k,2312) * b(k,281) + b(k,316) = b(k,316) - lu(k,2313) * b(k,281) + b(k,317) = b(k,317) - lu(k,2314) * b(k,281) + b(k,284) = b(k,284) - lu(k,2321) * b(k,282) + b(k,293) = b(k,293) - lu(k,2322) * b(k,282) + b(k,295) = b(k,295) - lu(k,2323) * b(k,282) + b(k,298) = b(k,298) - lu(k,2324) * b(k,282) + b(k,302) = b(k,302) - lu(k,2325) * b(k,282) + b(k,303) = b(k,303) - lu(k,2326) * b(k,282) + b(k,305) = b(k,305) - lu(k,2327) * b(k,282) + b(k,306) = b(k,306) - lu(k,2328) * b(k,282) + b(k,307) = b(k,307) - lu(k,2329) * b(k,282) + b(k,311) = b(k,311) - lu(k,2330) * b(k,282) + b(k,312) = b(k,312) - lu(k,2331) * b(k,282) + b(k,316) = b(k,316) - lu(k,2332) * b(k,282) + b(k,284) = b(k,284) - lu(k,2340) * b(k,283) + b(k,293) = b(k,293) - lu(k,2341) * b(k,283) + b(k,294) = b(k,294) - lu(k,2342) * b(k,283) + b(k,295) = b(k,295) - lu(k,2343) * b(k,283) + b(k,296) = b(k,296) - lu(k,2344) * b(k,283) + b(k,297) = b(k,297) - lu(k,2345) * b(k,283) + b(k,298) = b(k,298) - lu(k,2346) * b(k,283) + b(k,299) = b(k,299) - lu(k,2347) * b(k,283) + b(k,300) = b(k,300) - lu(k,2348) * b(k,283) + b(k,302) = b(k,302) - lu(k,2349) * b(k,283) + b(k,303) = b(k,303) - lu(k,2350) * b(k,283) + b(k,305) = b(k,305) - lu(k,2351) * b(k,283) + b(k,306) = b(k,306) - lu(k,2352) * b(k,283) + b(k,307) = b(k,307) - lu(k,2353) * b(k,283) + b(k,308) = b(k,308) - lu(k,2354) * b(k,283) + b(k,311) = b(k,311) - lu(k,2355) * b(k,283) + b(k,312) = b(k,312) - lu(k,2356) * b(k,283) + b(k,316) = b(k,316) - lu(k,2357) * b(k,283) + b(k,294) = b(k,294) - lu(k,2360) * b(k,284) + b(k,296) = b(k,296) - lu(k,2361) * b(k,284) + b(k,299) = b(k,299) - lu(k,2362) * b(k,284) + b(k,302) = b(k,302) - lu(k,2363) * b(k,284) + b(k,305) = b(k,305) - lu(k,2364) * b(k,284) + b(k,307) = b(k,307) - lu(k,2365) * b(k,284) + b(k,311) = b(k,311) - lu(k,2366) * b(k,284) + b(k,316) = b(k,316) - lu(k,2367) * b(k,284) + b(k,293) = b(k,293) - lu(k,2381) * b(k,285) + b(k,294) = b(k,294) - lu(k,2382) * b(k,285) + b(k,295) = b(k,295) - lu(k,2383) * b(k,285) + b(k,296) = b(k,296) - lu(k,2384) * b(k,285) + b(k,297) = b(k,297) - lu(k,2385) * b(k,285) + b(k,298) = b(k,298) - lu(k,2386) * b(k,285) + b(k,299) = b(k,299) - lu(k,2387) * b(k,285) + b(k,300) = b(k,300) - lu(k,2388) * b(k,285) + b(k,302) = b(k,302) - lu(k,2389) * b(k,285) + b(k,303) = b(k,303) - lu(k,2390) * b(k,285) + b(k,305) = b(k,305) - lu(k,2391) * b(k,285) + b(k,306) = b(k,306) - lu(k,2392) * b(k,285) + b(k,307) = b(k,307) - lu(k,2393) * b(k,285) + b(k,308) = b(k,308) - lu(k,2394) * b(k,285) + b(k,311) = b(k,311) - lu(k,2395) * b(k,285) + b(k,312) = b(k,312) - lu(k,2396) * b(k,285) + b(k,316) = b(k,316) - lu(k,2397) * b(k,285) + b(k,317) = b(k,317) - lu(k,2398) * b(k,285) + b(k,292) = b(k,292) - lu(k,2409) * b(k,286) + b(k,293) = b(k,293) - lu(k,2410) * b(k,286) + b(k,294) = b(k,294) - lu(k,2411) * b(k,286) + b(k,295) = b(k,295) - lu(k,2412) * b(k,286) + b(k,296) = b(k,296) - lu(k,2413) * b(k,286) + b(k,297) = b(k,297) - lu(k,2414) * b(k,286) + b(k,298) = b(k,298) - lu(k,2415) * b(k,286) + b(k,299) = b(k,299) - lu(k,2416) * b(k,286) + b(k,300) = b(k,300) - lu(k,2417) * b(k,286) + b(k,302) = b(k,302) - lu(k,2418) * b(k,286) + b(k,303) = b(k,303) - lu(k,2419) * b(k,286) + b(k,305) = b(k,305) - lu(k,2420) * b(k,286) + b(k,306) = b(k,306) - lu(k,2421) * b(k,286) + b(k,307) = b(k,307) - lu(k,2422) * b(k,286) + b(k,308) = b(k,308) - lu(k,2423) * b(k,286) + b(k,311) = b(k,311) - lu(k,2424) * b(k,286) + b(k,312) = b(k,312) - lu(k,2425) * b(k,286) + b(k,316) = b(k,316) - lu(k,2426) * b(k,286) + end do + end subroutine lu_slv08 + subroutine lu_slv09( 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,293) = b(k,293) - lu(k,2442) * b(k,287) + b(k,294) = b(k,294) - lu(k,2443) * b(k,287) + b(k,295) = b(k,295) - lu(k,2444) * b(k,287) + b(k,296) = b(k,296) - lu(k,2445) * b(k,287) + b(k,297) = b(k,297) - lu(k,2446) * b(k,287) + b(k,298) = b(k,298) - lu(k,2447) * b(k,287) + b(k,299) = b(k,299) - lu(k,2448) * b(k,287) + b(k,300) = b(k,300) - lu(k,2449) * b(k,287) + b(k,302) = b(k,302) - lu(k,2450) * b(k,287) + b(k,303) = b(k,303) - lu(k,2451) * b(k,287) + b(k,305) = b(k,305) - lu(k,2452) * b(k,287) + b(k,306) = b(k,306) - lu(k,2453) * b(k,287) + b(k,307) = b(k,307) - lu(k,2454) * b(k,287) + b(k,308) = b(k,308) - lu(k,2455) * b(k,287) + b(k,311) = b(k,311) - lu(k,2456) * b(k,287) + b(k,312) = b(k,312) - lu(k,2457) * b(k,287) + b(k,316) = b(k,316) - lu(k,2458) * b(k,287) + b(k,317) = b(k,317) - lu(k,2459) * b(k,287) + b(k,292) = b(k,292) - lu(k,2472) * b(k,288) + b(k,293) = b(k,293) - lu(k,2473) * b(k,288) + b(k,294) = b(k,294) - lu(k,2474) * b(k,288) + b(k,295) = b(k,295) - lu(k,2475) * b(k,288) + b(k,296) = b(k,296) - lu(k,2476) * b(k,288) + b(k,297) = b(k,297) - lu(k,2477) * b(k,288) + b(k,298) = b(k,298) - lu(k,2478) * b(k,288) + b(k,299) = b(k,299) - lu(k,2479) * b(k,288) + b(k,300) = b(k,300) - lu(k,2480) * b(k,288) + b(k,302) = b(k,302) - lu(k,2481) * b(k,288) + b(k,303) = b(k,303) - lu(k,2482) * b(k,288) + b(k,305) = b(k,305) - lu(k,2483) * b(k,288) + b(k,306) = b(k,306) - lu(k,2484) * b(k,288) + b(k,307) = b(k,307) - lu(k,2485) * b(k,288) + b(k,308) = b(k,308) - lu(k,2486) * b(k,288) + b(k,311) = b(k,311) - lu(k,2487) * b(k,288) + b(k,312) = b(k,312) - lu(k,2488) * b(k,288) + b(k,316) = b(k,316) - lu(k,2489) * b(k,288) + b(k,317) = b(k,317) - lu(k,2490) * b(k,288) + b(k,290) = b(k,290) - lu(k,2506) * b(k,289) + b(k,293) = b(k,293) - lu(k,2507) * b(k,289) + b(k,294) = b(k,294) - lu(k,2508) * b(k,289) + b(k,295) = b(k,295) - lu(k,2509) * b(k,289) + b(k,296) = b(k,296) - lu(k,2510) * b(k,289) + b(k,297) = b(k,297) - lu(k,2511) * b(k,289) + b(k,298) = b(k,298) - lu(k,2512) * b(k,289) + b(k,299) = b(k,299) - lu(k,2513) * b(k,289) + b(k,300) = b(k,300) - lu(k,2514) * b(k,289) + b(k,302) = b(k,302) - lu(k,2515) * b(k,289) + b(k,303) = b(k,303) - lu(k,2516) * b(k,289) + b(k,305) = b(k,305) - lu(k,2517) * b(k,289) + b(k,306) = b(k,306) - lu(k,2518) * b(k,289) + b(k,307) = b(k,307) - lu(k,2519) * b(k,289) + b(k,308) = b(k,308) - lu(k,2520) * b(k,289) + b(k,311) = b(k,311) - lu(k,2521) * b(k,289) + b(k,312) = b(k,312) - lu(k,2522) * b(k,289) + b(k,316) = b(k,316) - lu(k,2523) * b(k,289) + b(k,317) = b(k,317) - lu(k,2524) * b(k,289) + b(k,294) = b(k,294) - lu(k,2537) * b(k,290) + b(k,295) = b(k,295) - lu(k,2538) * b(k,290) + b(k,296) = b(k,296) - lu(k,2539) * b(k,290) + b(k,297) = b(k,297) - lu(k,2540) * b(k,290) + b(k,298) = b(k,298) - lu(k,2541) * b(k,290) + b(k,299) = b(k,299) - lu(k,2542) * b(k,290) + b(k,300) = b(k,300) - lu(k,2543) * b(k,290) + b(k,302) = b(k,302) - lu(k,2544) * b(k,290) + b(k,303) = b(k,303) - lu(k,2545) * b(k,290) + b(k,305) = b(k,305) - lu(k,2546) * b(k,290) + b(k,306) = b(k,306) - lu(k,2547) * b(k,290) + b(k,307) = b(k,307) - lu(k,2548) * b(k,290) + b(k,308) = b(k,308) - lu(k,2549) * b(k,290) + b(k,311) = b(k,311) - lu(k,2550) * b(k,290) + b(k,312) = b(k,312) - lu(k,2551) * b(k,290) + b(k,316) = b(k,316) - lu(k,2552) * b(k,290) + b(k,317) = b(k,317) - lu(k,2553) * b(k,290) + b(k,292) = b(k,292) - lu(k,2571) * b(k,291) + b(k,293) = b(k,293) - lu(k,2572) * b(k,291) + b(k,294) = b(k,294) - lu(k,2573) * b(k,291) + b(k,295) = b(k,295) - lu(k,2574) * b(k,291) + b(k,296) = b(k,296) - lu(k,2575) * b(k,291) + b(k,297) = b(k,297) - lu(k,2576) * b(k,291) + b(k,298) = b(k,298) - lu(k,2577) * b(k,291) + b(k,299) = b(k,299) - lu(k,2578) * b(k,291) + b(k,300) = b(k,300) - lu(k,2579) * b(k,291) + b(k,302) = b(k,302) - lu(k,2580) * b(k,291) + b(k,303) = b(k,303) - lu(k,2581) * b(k,291) + b(k,305) = b(k,305) - lu(k,2582) * b(k,291) + b(k,306) = b(k,306) - lu(k,2583) * b(k,291) + b(k,307) = b(k,307) - lu(k,2584) * b(k,291) + b(k,308) = b(k,308) - lu(k,2585) * b(k,291) + b(k,311) = b(k,311) - lu(k,2586) * b(k,291) + b(k,312) = b(k,312) - lu(k,2587) * b(k,291) + b(k,316) = b(k,316) - lu(k,2588) * b(k,291) + b(k,317) = b(k,317) - lu(k,2589) * b(k,291) + b(k,293) = b(k,293) - lu(k,2601) * b(k,292) + b(k,294) = b(k,294) - lu(k,2602) * b(k,292) + b(k,295) = b(k,295) - lu(k,2603) * b(k,292) + b(k,296) = b(k,296) - lu(k,2604) * b(k,292) + b(k,298) = b(k,298) - lu(k,2605) * b(k,292) + b(k,299) = b(k,299) - lu(k,2606) * b(k,292) + b(k,302) = b(k,302) - lu(k,2607) * b(k,292) + b(k,303) = b(k,303) - lu(k,2608) * b(k,292) + b(k,304) = b(k,304) - lu(k,2609) * b(k,292) + b(k,305) = b(k,305) - lu(k,2610) * b(k,292) + b(k,306) = b(k,306) - lu(k,2611) * b(k,292) + b(k,307) = b(k,307) - lu(k,2612) * b(k,292) + b(k,311) = b(k,311) - lu(k,2613) * b(k,292) + b(k,312) = b(k,312) - lu(k,2614) * b(k,292) + b(k,313) = b(k,313) - lu(k,2615) * b(k,292) + b(k,315) = b(k,315) - lu(k,2616) * b(k,292) + b(k,316) = b(k,316) - lu(k,2617) * b(k,292) + b(k,317) = b(k,317) - lu(k,2618) * b(k,292) + b(k,294) = b(k,294) - lu(k,2630) * b(k,293) + b(k,295) = b(k,295) - lu(k,2631) * b(k,293) + b(k,296) = b(k,296) - lu(k,2632) * b(k,293) + b(k,298) = b(k,298) - lu(k,2633) * b(k,293) + b(k,299) = b(k,299) - lu(k,2634) * b(k,293) + b(k,302) = b(k,302) - lu(k,2635) * b(k,293) + b(k,303) = b(k,303) - lu(k,2636) * b(k,293) + b(k,304) = b(k,304) - lu(k,2637) * b(k,293) + b(k,305) = b(k,305) - lu(k,2638) * b(k,293) + b(k,306) = b(k,306) - lu(k,2639) * b(k,293) + b(k,307) = b(k,307) - lu(k,2640) * b(k,293) + b(k,311) = b(k,311) - lu(k,2641) * b(k,293) + b(k,312) = b(k,312) - lu(k,2642) * b(k,293) + b(k,313) = b(k,313) - lu(k,2643) * b(k,293) + b(k,315) = b(k,315) - lu(k,2644) * b(k,293) + b(k,316) = b(k,316) - lu(k,2645) * b(k,293) + b(k,317) = b(k,317) - lu(k,2646) * b(k,293) + b(k,295) = b(k,295) - lu(k,2655) * b(k,294) + b(k,296) = b(k,296) - lu(k,2656) * b(k,294) + b(k,297) = b(k,297) - lu(k,2657) * b(k,294) + b(k,298) = b(k,298) - lu(k,2658) * b(k,294) + b(k,299) = b(k,299) - lu(k,2659) * b(k,294) + b(k,300) = b(k,300) - lu(k,2660) * b(k,294) + b(k,302) = b(k,302) - lu(k,2661) * b(k,294) + b(k,303) = b(k,303) - lu(k,2662) * b(k,294) + b(k,305) = b(k,305) - lu(k,2663) * b(k,294) + b(k,306) = b(k,306) - lu(k,2664) * b(k,294) + b(k,307) = b(k,307) - lu(k,2665) * b(k,294) + b(k,308) = b(k,308) - lu(k,2666) * b(k,294) + b(k,311) = b(k,311) - lu(k,2667) * b(k,294) + b(k,312) = b(k,312) - lu(k,2668) * b(k,294) + b(k,316) = b(k,316) - lu(k,2669) * b(k,294) + b(k,296) = b(k,296) - lu(k,2678) * b(k,295) + b(k,297) = b(k,297) - lu(k,2679) * b(k,295) + b(k,298) = b(k,298) - lu(k,2680) * b(k,295) + b(k,299) = b(k,299) - lu(k,2681) * b(k,295) + b(k,300) = b(k,300) - lu(k,2682) * b(k,295) + b(k,302) = b(k,302) - lu(k,2683) * b(k,295) + b(k,303) = b(k,303) - lu(k,2684) * b(k,295) + b(k,305) = b(k,305) - lu(k,2685) * b(k,295) + b(k,306) = b(k,306) - lu(k,2686) * b(k,295) + b(k,307) = b(k,307) - lu(k,2687) * b(k,295) + b(k,308) = b(k,308) - lu(k,2688) * b(k,295) + b(k,311) = b(k,311) - lu(k,2689) * b(k,295) + b(k,312) = b(k,312) - lu(k,2690) * b(k,295) + b(k,316) = b(k,316) - lu(k,2691) * b(k,295) + b(k,297) = b(k,297) - lu(k,2702) * b(k,296) + b(k,298) = b(k,298) - lu(k,2703) * b(k,296) + b(k,299) = b(k,299) - lu(k,2704) * b(k,296) + b(k,300) = b(k,300) - lu(k,2705) * b(k,296) + b(k,302) = b(k,302) - lu(k,2706) * b(k,296) + b(k,303) = b(k,303) - lu(k,2707) * b(k,296) + b(k,305) = b(k,305) - lu(k,2708) * b(k,296) + b(k,306) = b(k,306) - lu(k,2709) * b(k,296) + b(k,307) = b(k,307) - lu(k,2710) * b(k,296) + b(k,308) = b(k,308) - lu(k,2711) * b(k,296) + b(k,311) = b(k,311) - lu(k,2712) * b(k,296) + b(k,312) = b(k,312) - lu(k,2713) * b(k,296) + b(k,316) = b(k,316) - lu(k,2714) * b(k,296) + b(k,317) = b(k,317) - lu(k,2715) * b(k,296) + b(k,298) = b(k,298) - lu(k,2746) * b(k,297) + b(k,299) = b(k,299) - lu(k,2747) * b(k,297) + b(k,300) = b(k,300) - lu(k,2748) * b(k,297) + b(k,302) = b(k,302) - lu(k,2749) * b(k,297) + b(k,303) = b(k,303) - lu(k,2750) * b(k,297) + b(k,304) = b(k,304) - lu(k,2751) * b(k,297) + b(k,305) = b(k,305) - lu(k,2752) * b(k,297) + b(k,306) = b(k,306) - lu(k,2753) * b(k,297) + b(k,307) = b(k,307) - lu(k,2754) * b(k,297) + b(k,308) = b(k,308) - lu(k,2755) * b(k,297) + b(k,311) = b(k,311) - lu(k,2756) * b(k,297) + b(k,312) = b(k,312) - lu(k,2757) * b(k,297) + b(k,313) = b(k,313) - lu(k,2758) * b(k,297) + b(k,315) = b(k,315) - lu(k,2759) * b(k,297) + b(k,316) = b(k,316) - lu(k,2760) * b(k,297) + b(k,317) = b(k,317) - lu(k,2761) * b(k,297) + b(k,299) = b(k,299) - lu(k,2793) * b(k,298) + b(k,300) = b(k,300) - lu(k,2794) * b(k,298) + b(k,302) = b(k,302) - lu(k,2795) * b(k,298) + b(k,303) = b(k,303) - lu(k,2796) * b(k,298) + b(k,304) = b(k,304) - lu(k,2797) * b(k,298) + b(k,305) = b(k,305) - lu(k,2798) * b(k,298) + b(k,306) = b(k,306) - lu(k,2799) * b(k,298) + b(k,307) = b(k,307) - lu(k,2800) * b(k,298) + b(k,308) = b(k,308) - lu(k,2801) * b(k,298) + b(k,311) = b(k,311) - lu(k,2802) * b(k,298) + b(k,312) = b(k,312) - lu(k,2803) * b(k,298) + b(k,313) = b(k,313) - lu(k,2804) * b(k,298) + b(k,315) = b(k,315) - lu(k,2805) * b(k,298) + b(k,316) = b(k,316) - lu(k,2806) * b(k,298) + b(k,317) = b(k,317) - lu(k,2807) * b(k,298) + end do + end subroutine lu_slv09 + subroutine lu_slv10( 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,300) = b(k,300) - lu(k,2841) * b(k,299) + b(k,302) = b(k,302) - lu(k,2842) * b(k,299) + b(k,303) = b(k,303) - lu(k,2843) * b(k,299) + b(k,304) = b(k,304) - lu(k,2844) * b(k,299) + b(k,305) = b(k,305) - lu(k,2845) * b(k,299) + b(k,306) = b(k,306) - lu(k,2846) * b(k,299) + b(k,307) = b(k,307) - lu(k,2847) * b(k,299) + b(k,308) = b(k,308) - lu(k,2848) * b(k,299) + b(k,311) = b(k,311) - lu(k,2849) * b(k,299) + b(k,312) = b(k,312) - lu(k,2850) * b(k,299) + b(k,313) = b(k,313) - lu(k,2851) * b(k,299) + b(k,315) = b(k,315) - lu(k,2852) * b(k,299) + b(k,316) = b(k,316) - lu(k,2853) * b(k,299) + b(k,317) = b(k,317) - lu(k,2854) * b(k,299) + b(k,301) = b(k,301) - lu(k,2914) * b(k,300) + b(k,302) = b(k,302) - lu(k,2915) * b(k,300) + b(k,303) = b(k,303) - lu(k,2916) * b(k,300) + b(k,304) = b(k,304) - lu(k,2917) * b(k,300) + b(k,305) = b(k,305) - lu(k,2918) * b(k,300) + b(k,306) = b(k,306) - lu(k,2919) * b(k,300) + b(k,307) = b(k,307) - lu(k,2920) * b(k,300) + b(k,308) = b(k,308) - lu(k,2921) * b(k,300) + b(k,311) = b(k,311) - lu(k,2922) * b(k,300) + b(k,312) = b(k,312) - lu(k,2923) * b(k,300) + b(k,313) = b(k,313) - lu(k,2924) * b(k,300) + b(k,314) = b(k,314) - lu(k,2925) * b(k,300) + b(k,315) = b(k,315) - lu(k,2926) * b(k,300) + b(k,316) = b(k,316) - lu(k,2927) * b(k,300) + b(k,317) = b(k,317) - lu(k,2928) * b(k,300) + b(k,302) = b(k,302) - lu(k,2932) * b(k,301) + b(k,304) = b(k,304) - lu(k,2933) * b(k,301) + b(k,305) = b(k,305) - lu(k,2934) * b(k,301) + b(k,306) = b(k,306) - lu(k,2935) * b(k,301) + b(k,307) = b(k,307) - lu(k,2936) * b(k,301) + b(k,308) = b(k,308) - lu(k,2937) * b(k,301) + b(k,311) = b(k,311) - lu(k,2938) * b(k,301) + b(k,313) = b(k,313) - lu(k,2939) * b(k,301) + b(k,314) = b(k,314) - lu(k,2940) * b(k,301) + b(k,315) = b(k,315) - lu(k,2941) * b(k,301) + b(k,316) = b(k,316) - lu(k,2942) * b(k,301) + b(k,317) = b(k,317) - lu(k,2943) * b(k,301) + b(k,304) = b(k,304) - lu(k,2950) * b(k,302) + b(k,305) = b(k,305) - lu(k,2951) * b(k,302) + b(k,306) = b(k,306) - lu(k,2952) * b(k,302) + b(k,307) = b(k,307) - lu(k,2953) * b(k,302) + b(k,308) = b(k,308) - lu(k,2954) * b(k,302) + b(k,311) = b(k,311) - lu(k,2955) * b(k,302) + b(k,312) = b(k,312) - lu(k,2956) * b(k,302) + b(k,313) = b(k,313) - lu(k,2957) * b(k,302) + b(k,314) = b(k,314) - lu(k,2958) * b(k,302) + b(k,315) = b(k,315) - lu(k,2959) * b(k,302) + b(k,316) = b(k,316) - lu(k,2960) * b(k,302) + b(k,317) = b(k,317) - lu(k,2961) * b(k,302) + b(k,304) = b(k,304) - lu(k,3107) * b(k,303) + b(k,305) = b(k,305) - lu(k,3108) * b(k,303) + b(k,306) = b(k,306) - lu(k,3109) * b(k,303) + b(k,307) = b(k,307) - lu(k,3110) * b(k,303) + b(k,308) = b(k,308) - lu(k,3111) * b(k,303) + b(k,309) = b(k,309) - lu(k,3112) * b(k,303) + b(k,310) = b(k,310) - lu(k,3113) * b(k,303) + b(k,311) = b(k,311) - lu(k,3114) * b(k,303) + b(k,312) = b(k,312) - lu(k,3115) * b(k,303) + b(k,313) = b(k,313) - lu(k,3116) * b(k,303) + b(k,314) = b(k,314) - lu(k,3117) * b(k,303) + b(k,315) = b(k,315) - lu(k,3118) * b(k,303) + b(k,316) = b(k,316) - lu(k,3119) * b(k,303) + b(k,317) = b(k,317) - lu(k,3120) * b(k,303) + b(k,305) = b(k,305) - lu(k,3130) * b(k,304) + b(k,306) = b(k,306) - lu(k,3131) * b(k,304) + b(k,307) = b(k,307) - lu(k,3132) * b(k,304) + b(k,308) = b(k,308) - lu(k,3133) * b(k,304) + b(k,309) = b(k,309) - lu(k,3134) * b(k,304) + b(k,310) = b(k,310) - lu(k,3135) * b(k,304) + b(k,311) = b(k,311) - lu(k,3136) * b(k,304) + b(k,312) = b(k,312) - lu(k,3137) * b(k,304) + b(k,313) = b(k,313) - lu(k,3138) * b(k,304) + b(k,314) = b(k,314) - lu(k,3139) * b(k,304) + b(k,315) = b(k,315) - lu(k,3140) * b(k,304) + b(k,316) = b(k,316) - lu(k,3141) * b(k,304) + b(k,317) = b(k,317) - lu(k,3142) * b(k,304) + b(k,306) = b(k,306) - lu(k,3162) * b(k,305) + b(k,307) = b(k,307) - lu(k,3163) * b(k,305) + b(k,308) = b(k,308) - lu(k,3164) * b(k,305) + b(k,309) = b(k,309) - lu(k,3165) * b(k,305) + b(k,310) = b(k,310) - lu(k,3166) * b(k,305) + b(k,311) = b(k,311) - lu(k,3167) * b(k,305) + b(k,312) = b(k,312) - lu(k,3168) * b(k,305) + b(k,313) = b(k,313) - lu(k,3169) * b(k,305) + b(k,314) = b(k,314) - lu(k,3170) * b(k,305) + b(k,315) = b(k,315) - lu(k,3171) * b(k,305) + b(k,316) = b(k,316) - lu(k,3172) * b(k,305) + b(k,317) = b(k,317) - lu(k,3173) * b(k,305) + b(k,307) = b(k,307) - lu(k,3189) * b(k,306) + b(k,308) = b(k,308) - lu(k,3190) * b(k,306) + b(k,309) = b(k,309) - lu(k,3191) * b(k,306) + b(k,310) = b(k,310) - lu(k,3192) * b(k,306) + b(k,311) = b(k,311) - lu(k,3193) * b(k,306) + b(k,312) = b(k,312) - lu(k,3194) * b(k,306) + b(k,313) = b(k,313) - lu(k,3195) * b(k,306) + b(k,314) = b(k,314) - lu(k,3196) * b(k,306) + b(k,315) = b(k,315) - lu(k,3197) * b(k,306) + b(k,316) = b(k,316) - lu(k,3198) * b(k,306) + b(k,317) = b(k,317) - lu(k,3199) * b(k,306) + b(k,308) = b(k,308) - lu(k,3370) * b(k,307) + b(k,309) = b(k,309) - lu(k,3371) * b(k,307) + b(k,310) = b(k,310) - lu(k,3372) * b(k,307) + b(k,311) = b(k,311) - lu(k,3373) * b(k,307) + b(k,312) = b(k,312) - lu(k,3374) * b(k,307) + b(k,313) = b(k,313) - lu(k,3375) * b(k,307) + b(k,314) = b(k,314) - lu(k,3376) * b(k,307) + b(k,315) = b(k,315) - lu(k,3377) * b(k,307) + b(k,316) = b(k,316) - lu(k,3378) * b(k,307) + b(k,317) = b(k,317) - lu(k,3379) * b(k,307) + b(k,309) = b(k,309) - lu(k,3464) * b(k,308) + b(k,310) = b(k,310) - lu(k,3465) * b(k,308) + b(k,311) = b(k,311) - lu(k,3466) * b(k,308) + b(k,312) = b(k,312) - lu(k,3467) * b(k,308) + b(k,313) = b(k,313) - lu(k,3468) * b(k,308) + b(k,314) = b(k,314) - lu(k,3469) * b(k,308) + b(k,315) = b(k,315) - lu(k,3470) * b(k,308) + b(k,316) = b(k,316) - lu(k,3471) * b(k,308) + b(k,317) = b(k,317) - lu(k,3472) * b(k,308) + b(k,310) = b(k,310) - lu(k,3489) * b(k,309) + b(k,311) = b(k,311) - lu(k,3490) * b(k,309) + b(k,312) = b(k,312) - lu(k,3491) * b(k,309) + b(k,313) = b(k,313) - lu(k,3492) * b(k,309) + b(k,314) = b(k,314) - lu(k,3493) * b(k,309) + b(k,315) = b(k,315) - lu(k,3494) * b(k,309) + b(k,316) = b(k,316) - lu(k,3495) * b(k,309) + b(k,317) = b(k,317) - lu(k,3496) * b(k,309) + b(k,311) = b(k,311) - lu(k,3516) * b(k,310) + b(k,312) = b(k,312) - lu(k,3517) * b(k,310) + b(k,313) = b(k,313) - lu(k,3518) * b(k,310) + b(k,314) = b(k,314) - lu(k,3519) * b(k,310) + b(k,315) = b(k,315) - lu(k,3520) * b(k,310) + b(k,316) = b(k,316) - lu(k,3521) * b(k,310) + b(k,317) = b(k,317) - lu(k,3522) * b(k,310) + b(k,312) = b(k,312) - lu(k,3611) * b(k,311) + b(k,313) = b(k,313) - lu(k,3612) * b(k,311) + b(k,314) = b(k,314) - lu(k,3613) * b(k,311) + b(k,315) = b(k,315) - lu(k,3614) * b(k,311) + b(k,316) = b(k,316) - lu(k,3615) * b(k,311) + b(k,317) = b(k,317) - lu(k,3616) * b(k,311) + b(k,313) = b(k,313) - lu(k,3664) * b(k,312) + b(k,314) = b(k,314) - lu(k,3665) * b(k,312) + b(k,315) = b(k,315) - lu(k,3666) * b(k,312) + b(k,316) = b(k,316) - lu(k,3667) * b(k,312) + b(k,317) = b(k,317) - lu(k,3668) * b(k,312) + b(k,314) = b(k,314) - lu(k,3767) * b(k,313) + b(k,315) = b(k,315) - lu(k,3768) * b(k,313) + b(k,316) = b(k,316) - lu(k,3769) * b(k,313) + b(k,317) = b(k,317) - lu(k,3770) * b(k,313) + b(k,315) = b(k,315) - lu(k,3809) * b(k,314) + b(k,316) = b(k,316) - lu(k,3810) * b(k,314) + b(k,317) = b(k,317) - lu(k,3811) * b(k,314) + b(k,316) = b(k,316) - lu(k,3851) * b(k,315) + b(k,317) = b(k,317) - lu(k,3852) * b(k,315) + b(k,317) = b(k,317) - lu(k,4102) * b(k,316) + end do + end subroutine lu_slv10 + subroutine lu_slv11( 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,317) = b(k,317) * lu(k,4128) + b(k,316) = b(k,316) - lu(k,4127) * b(k,317) + b(k,315) = b(k,315) - lu(k,4126) * b(k,317) + b(k,314) = b(k,314) - lu(k,4125) * b(k,317) + b(k,313) = b(k,313) - lu(k,4124) * b(k,317) + b(k,312) = b(k,312) - lu(k,4123) * b(k,317) + b(k,311) = b(k,311) - lu(k,4122) * b(k,317) + b(k,310) = b(k,310) - lu(k,4121) * b(k,317) + b(k,309) = b(k,309) - lu(k,4120) * b(k,317) + b(k,308) = b(k,308) - lu(k,4119) * b(k,317) + b(k,307) = b(k,307) - lu(k,4118) * b(k,317) + b(k,306) = b(k,306) - lu(k,4117) * b(k,317) + b(k,305) = b(k,305) - lu(k,4116) * b(k,317) + b(k,304) = b(k,304) - lu(k,4115) * b(k,317) + b(k,303) = b(k,303) - lu(k,4114) * b(k,317) + b(k,302) = b(k,302) - lu(k,4113) * b(k,317) + b(k,301) = b(k,301) - lu(k,4112) * b(k,317) + b(k,279) = b(k,279) - lu(k,4111) * b(k,317) + b(k,276) = b(k,276) - lu(k,4110) * b(k,317) + b(k,251) = b(k,251) - lu(k,4109) * b(k,317) + b(k,246) = b(k,246) - lu(k,4108) * b(k,317) + b(k,217) = b(k,217) - lu(k,4107) * b(k,317) + b(k,216) = b(k,216) - lu(k,4106) * b(k,317) + b(k,107) = b(k,107) - lu(k,4105) * b(k,317) + b(k,98) = b(k,98) - lu(k,4104) * b(k,317) + b(k,69) = b(k,69) - lu(k,4103) * b(k,317) + b(k,316) = b(k,316) * lu(k,4101) + b(k,315) = b(k,315) - lu(k,4100) * b(k,316) + b(k,314) = b(k,314) - lu(k,4099) * b(k,316) + b(k,313) = b(k,313) - lu(k,4098) * b(k,316) + b(k,312) = b(k,312) - lu(k,4097) * b(k,316) + b(k,311) = b(k,311) - lu(k,4096) * b(k,316) + b(k,310) = b(k,310) - lu(k,4095) * b(k,316) + b(k,309) = b(k,309) - lu(k,4094) * b(k,316) + b(k,308) = b(k,308) - lu(k,4093) * b(k,316) + b(k,307) = b(k,307) - lu(k,4092) * b(k,316) + b(k,306) = b(k,306) - lu(k,4091) * b(k,316) + b(k,305) = b(k,305) - lu(k,4090) * b(k,316) + b(k,304) = b(k,304) - lu(k,4089) * b(k,316) + b(k,303) = b(k,303) - lu(k,4088) * b(k,316) + b(k,302) = b(k,302) - lu(k,4087) * b(k,316) + b(k,301) = b(k,301) - lu(k,4086) * b(k,316) + b(k,300) = b(k,300) - lu(k,4085) * b(k,316) + b(k,299) = b(k,299) - lu(k,4084) * b(k,316) + b(k,298) = b(k,298) - lu(k,4083) * b(k,316) + b(k,297) = b(k,297) - lu(k,4082) * b(k,316) + b(k,296) = b(k,296) - lu(k,4081) * b(k,316) + b(k,295) = b(k,295) - lu(k,4080) * b(k,316) + b(k,294) = b(k,294) - lu(k,4079) * b(k,316) + b(k,293) = b(k,293) - lu(k,4078) * b(k,316) + b(k,292) = b(k,292) - lu(k,4077) * b(k,316) + b(k,291) = b(k,291) - lu(k,4076) * b(k,316) + b(k,290) = b(k,290) - lu(k,4075) * b(k,316) + b(k,289) = b(k,289) - lu(k,4074) * b(k,316) + b(k,288) = b(k,288) - lu(k,4073) * b(k,316) + b(k,287) = b(k,287) - lu(k,4072) * b(k,316) + b(k,286) = b(k,286) - lu(k,4071) * b(k,316) + b(k,285) = b(k,285) - lu(k,4070) * b(k,316) + b(k,284) = b(k,284) - lu(k,4069) * b(k,316) + b(k,283) = b(k,283) - lu(k,4068) * b(k,316) + b(k,282) = b(k,282) - lu(k,4067) * b(k,316) + b(k,281) = b(k,281) - lu(k,4066) * b(k,316) + b(k,280) = b(k,280) - lu(k,4065) * b(k,316) + b(k,279) = b(k,279) - lu(k,4064) * b(k,316) + b(k,277) = b(k,277) - lu(k,4063) * b(k,316) + b(k,276) = b(k,276) - lu(k,4062) * b(k,316) + b(k,275) = b(k,275) - lu(k,4061) * b(k,316) + b(k,274) = b(k,274) - lu(k,4060) * b(k,316) + b(k,273) = b(k,273) - lu(k,4059) * b(k,316) + b(k,272) = b(k,272) - lu(k,4058) * b(k,316) + b(k,271) = b(k,271) - lu(k,4057) * b(k,316) + b(k,270) = b(k,270) - lu(k,4056) * b(k,316) + b(k,269) = b(k,269) - lu(k,4055) * b(k,316) + b(k,268) = b(k,268) - lu(k,4054) * b(k,316) + b(k,267) = b(k,267) - lu(k,4053) * b(k,316) + b(k,266) = b(k,266) - lu(k,4052) * b(k,316) + b(k,265) = b(k,265) - lu(k,4051) * b(k,316) + b(k,264) = b(k,264) - lu(k,4050) * b(k,316) + b(k,263) = b(k,263) - lu(k,4049) * b(k,316) + b(k,262) = b(k,262) - lu(k,4048) * b(k,316) + b(k,261) = b(k,261) - lu(k,4047) * b(k,316) + b(k,260) = b(k,260) - lu(k,4046) * b(k,316) + b(k,259) = b(k,259) - lu(k,4045) * b(k,316) + b(k,258) = b(k,258) - lu(k,4044) * b(k,316) + b(k,257) = b(k,257) - lu(k,4043) * b(k,316) + b(k,256) = b(k,256) - lu(k,4042) * b(k,316) + b(k,255) = b(k,255) - lu(k,4041) * b(k,316) + b(k,254) = b(k,254) - lu(k,4040) * b(k,316) + b(k,253) = b(k,253) - lu(k,4039) * b(k,316) + b(k,252) = b(k,252) - lu(k,4038) * b(k,316) + b(k,251) = b(k,251) - lu(k,4037) * b(k,316) + b(k,250) = b(k,250) - lu(k,4036) * b(k,316) + b(k,249) = b(k,249) - lu(k,4035) * b(k,316) + b(k,248) = b(k,248) - lu(k,4034) * b(k,316) + b(k,247) = b(k,247) - lu(k,4033) * b(k,316) + b(k,246) = b(k,246) - lu(k,4032) * b(k,316) + b(k,245) = b(k,245) - lu(k,4031) * b(k,316) + b(k,244) = b(k,244) - lu(k,4030) * b(k,316) + b(k,243) = b(k,243) - lu(k,4029) * b(k,316) + b(k,242) = b(k,242) - lu(k,4028) * b(k,316) + b(k,241) = b(k,241) - lu(k,4027) * b(k,316) + b(k,240) = b(k,240) - lu(k,4026) * b(k,316) + b(k,239) = b(k,239) - lu(k,4025) * b(k,316) + b(k,238) = b(k,238) - lu(k,4024) * b(k,316) + b(k,237) = b(k,237) - lu(k,4023) * b(k,316) + b(k,236) = b(k,236) - lu(k,4022) * b(k,316) + b(k,235) = b(k,235) - lu(k,4021) * b(k,316) + b(k,234) = b(k,234) - lu(k,4020) * b(k,316) + b(k,233) = b(k,233) - lu(k,4019) * b(k,316) + b(k,232) = b(k,232) - lu(k,4018) * b(k,316) + b(k,231) = b(k,231) - lu(k,4017) * b(k,316) + b(k,230) = b(k,230) - lu(k,4016) * b(k,316) + b(k,229) = b(k,229) - lu(k,4015) * b(k,316) + b(k,228) = b(k,228) - lu(k,4014) * b(k,316) + b(k,227) = b(k,227) - lu(k,4013) * b(k,316) + b(k,226) = b(k,226) - lu(k,4012) * b(k,316) + b(k,225) = b(k,225) - lu(k,4011) * b(k,316) + b(k,224) = b(k,224) - lu(k,4010) * b(k,316) + b(k,223) = b(k,223) - lu(k,4009) * b(k,316) + b(k,222) = b(k,222) - lu(k,4008) * b(k,316) + b(k,221) = b(k,221) - lu(k,4007) * b(k,316) + b(k,220) = b(k,220) - lu(k,4006) * b(k,316) + b(k,219) = b(k,219) - lu(k,4005) * b(k,316) + b(k,218) = b(k,218) - lu(k,4004) * b(k,316) + b(k,217) = b(k,217) - lu(k,4003) * b(k,316) + b(k,216) = b(k,216) - lu(k,4002) * b(k,316) + b(k,215) = b(k,215) - lu(k,4001) * b(k,316) + b(k,214) = b(k,214) - lu(k,4000) * b(k,316) + b(k,213) = b(k,213) - lu(k,3999) * b(k,316) + b(k,212) = b(k,212) - lu(k,3998) * b(k,316) + b(k,211) = b(k,211) - lu(k,3997) * b(k,316) + b(k,210) = b(k,210) - lu(k,3996) * b(k,316) + b(k,209) = b(k,209) - lu(k,3995) * b(k,316) + b(k,208) = b(k,208) - lu(k,3994) * b(k,316) + b(k,207) = b(k,207) - lu(k,3993) * b(k,316) + b(k,206) = b(k,206) - lu(k,3992) * b(k,316) + b(k,205) = b(k,205) - lu(k,3991) * b(k,316) + b(k,204) = b(k,204) - lu(k,3990) * b(k,316) + b(k,203) = b(k,203) - lu(k,3989) * b(k,316) + b(k,202) = b(k,202) - lu(k,3988) * b(k,316) + b(k,201) = b(k,201) - lu(k,3987) * b(k,316) + b(k,200) = b(k,200) - lu(k,3986) * b(k,316) + b(k,199) = b(k,199) - lu(k,3985) * b(k,316) + b(k,198) = b(k,198) - lu(k,3984) * b(k,316) + b(k,197) = b(k,197) - lu(k,3983) * b(k,316) + b(k,196) = b(k,196) - lu(k,3982) * b(k,316) + b(k,194) = b(k,194) - lu(k,3981) * b(k,316) + b(k,193) = b(k,193) - lu(k,3980) * b(k,316) + b(k,192) = b(k,192) - lu(k,3979) * b(k,316) + b(k,191) = b(k,191) - lu(k,3978) * b(k,316) + b(k,190) = b(k,190) - lu(k,3977) * b(k,316) + b(k,189) = b(k,189) - lu(k,3976) * b(k,316) + b(k,188) = b(k,188) - lu(k,3975) * b(k,316) + b(k,187) = b(k,187) - lu(k,3974) * b(k,316) + b(k,186) = b(k,186) - lu(k,3973) * b(k,316) + b(k,185) = b(k,185) - lu(k,3972) * b(k,316) + b(k,184) = b(k,184) - lu(k,3971) * b(k,316) + b(k,183) = b(k,183) - lu(k,3970) * b(k,316) + b(k,182) = b(k,182) - lu(k,3969) * b(k,316) + b(k,181) = b(k,181) - lu(k,3968) * b(k,316) + b(k,180) = b(k,180) - lu(k,3967) * b(k,316) + b(k,179) = b(k,179) - lu(k,3966) * b(k,316) + b(k,178) = b(k,178) - lu(k,3965) * b(k,316) + b(k,177) = b(k,177) - lu(k,3964) * b(k,316) + b(k,176) = b(k,176) - lu(k,3963) * b(k,316) + b(k,175) = b(k,175) - lu(k,3962) * b(k,316) + b(k,174) = b(k,174) - lu(k,3961) * b(k,316) + b(k,173) = b(k,173) - lu(k,3960) * b(k,316) + b(k,172) = b(k,172) - lu(k,3959) * b(k,316) + b(k,171) = b(k,171) - lu(k,3958) * b(k,316) + b(k,170) = b(k,170) - lu(k,3957) * b(k,316) + b(k,169) = b(k,169) - lu(k,3956) * b(k,316) + b(k,168) = b(k,168) - lu(k,3955) * b(k,316) + b(k,167) = b(k,167) - lu(k,3954) * b(k,316) + b(k,166) = b(k,166) - lu(k,3953) * b(k,316) + b(k,165) = b(k,165) - lu(k,3952) * b(k,316) + b(k,164) = b(k,164) - lu(k,3951) * b(k,316) + b(k,163) = b(k,163) - lu(k,3950) * b(k,316) + b(k,161) = b(k,161) - lu(k,3949) * b(k,316) + b(k,160) = b(k,160) - lu(k,3948) * b(k,316) + b(k,159) = b(k,159) - lu(k,3947) * b(k,316) + b(k,158) = b(k,158) - lu(k,3946) * b(k,316) + b(k,157) = b(k,157) - lu(k,3945) * b(k,316) + b(k,156) = b(k,156) - lu(k,3944) * b(k,316) + b(k,155) = b(k,155) - lu(k,3943) * b(k,316) + b(k,154) = b(k,154) - lu(k,3942) * b(k,316) + b(k,153) = b(k,153) - lu(k,3941) * b(k,316) + b(k,152) = b(k,152) - lu(k,3940) * b(k,316) + b(k,151) = b(k,151) - lu(k,3939) * b(k,316) + b(k,150) = b(k,150) - lu(k,3938) * b(k,316) + b(k,149) = b(k,149) - lu(k,3937) * b(k,316) + b(k,148) = b(k,148) - lu(k,3936) * b(k,316) + b(k,147) = b(k,147) - lu(k,3935) * b(k,316) + b(k,145) = b(k,145) - lu(k,3934) * b(k,316) + b(k,144) = b(k,144) - lu(k,3933) * b(k,316) + b(k,143) = b(k,143) - lu(k,3932) * b(k,316) + b(k,142) = b(k,142) - lu(k,3931) * b(k,316) + b(k,141) = b(k,141) - lu(k,3930) * b(k,316) + b(k,140) = b(k,140) - lu(k,3929) * b(k,316) + b(k,139) = b(k,139) - lu(k,3928) * b(k,316) + b(k,138) = b(k,138) - lu(k,3927) * b(k,316) + b(k,137) = b(k,137) - lu(k,3926) * b(k,316) + b(k,136) = b(k,136) - lu(k,3925) * b(k,316) + b(k,135) = b(k,135) - lu(k,3924) * b(k,316) + b(k,134) = b(k,134) - lu(k,3923) * b(k,316) + b(k,133) = b(k,133) - lu(k,3922) * b(k,316) + b(k,132) = b(k,132) - lu(k,3921) * b(k,316) + b(k,131) = b(k,131) - lu(k,3920) * b(k,316) + b(k,130) = b(k,130) - lu(k,3919) * b(k,316) + b(k,129) = b(k,129) - lu(k,3918) * b(k,316) + b(k,128) = b(k,128) - lu(k,3917) * b(k,316) + b(k,127) = b(k,127) - lu(k,3916) * b(k,316) + b(k,126) = b(k,126) - lu(k,3915) * b(k,316) + b(k,125) = b(k,125) - lu(k,3914) * b(k,316) + b(k,124) = b(k,124) - lu(k,3913) * b(k,316) + b(k,123) = b(k,123) - lu(k,3912) * b(k,316) + b(k,122) = b(k,122) - lu(k,3911) * b(k,316) + b(k,120) = b(k,120) - lu(k,3910) * b(k,316) + b(k,119) = b(k,119) - lu(k,3909) * b(k,316) + b(k,118) = b(k,118) - lu(k,3908) * b(k,316) + b(k,117) = b(k,117) - lu(k,3907) * b(k,316) + b(k,116) = b(k,116) - lu(k,3906) * b(k,316) + b(k,115) = b(k,115) - lu(k,3905) * b(k,316) + b(k,114) = b(k,114) - lu(k,3904) * b(k,316) + b(k,113) = b(k,113) - lu(k,3903) * b(k,316) + b(k,112) = b(k,112) - lu(k,3902) * b(k,316) + b(k,109) = b(k,109) - lu(k,3901) * b(k,316) + b(k,108) = b(k,108) - lu(k,3900) * b(k,316) + b(k,106) = b(k,106) - lu(k,3899) * b(k,316) + b(k,105) = b(k,105) - lu(k,3898) * b(k,316) + b(k,104) = b(k,104) - lu(k,3897) * b(k,316) + b(k,100) = b(k,100) - lu(k,3896) * b(k,316) + b(k,99) = b(k,99) - lu(k,3895) * b(k,316) + b(k,98) = b(k,98) - lu(k,3894) * b(k,316) + b(k,97) = b(k,97) - lu(k,3893) * b(k,316) + b(k,96) = b(k,96) - lu(k,3892) * b(k,316) + b(k,95) = b(k,95) - lu(k,3891) * b(k,316) + b(k,94) = b(k,94) - lu(k,3890) * b(k,316) + b(k,93) = b(k,93) - lu(k,3889) * b(k,316) + b(k,92) = b(k,92) - lu(k,3888) * b(k,316) + b(k,91) = b(k,91) - lu(k,3887) * b(k,316) + b(k,90) = b(k,90) - lu(k,3886) * b(k,316) + b(k,89) = b(k,89) - lu(k,3885) * b(k,316) + b(k,87) = b(k,87) - lu(k,3884) * b(k,316) + b(k,86) = b(k,86) - lu(k,3883) * b(k,316) + b(k,85) = b(k,85) - lu(k,3882) * b(k,316) + b(k,84) = b(k,84) - lu(k,3881) * b(k,316) + b(k,83) = b(k,83) - lu(k,3880) * b(k,316) + b(k,82) = b(k,82) - lu(k,3879) * b(k,316) + b(k,81) = b(k,81) - lu(k,3878) * b(k,316) + b(k,79) = b(k,79) - lu(k,3877) * b(k,316) + b(k,78) = b(k,78) - lu(k,3876) * b(k,316) + b(k,77) = b(k,77) - lu(k,3875) * b(k,316) + b(k,76) = b(k,76) - lu(k,3874) * b(k,316) + b(k,67) = b(k,67) - lu(k,3873) * b(k,316) + b(k,63) = b(k,63) - lu(k,3872) * b(k,316) + b(k,61) = b(k,61) - lu(k,3871) * b(k,316) + b(k,59) = b(k,59) - lu(k,3870) * b(k,316) + b(k,57) = b(k,57) - lu(k,3869) * b(k,316) + b(k,56) = b(k,56) - lu(k,3868) * b(k,316) + b(k,55) = b(k,55) - lu(k,3867) * b(k,316) + b(k,54) = b(k,54) - lu(k,3866) * b(k,316) + b(k,53) = b(k,53) - lu(k,3865) * b(k,316) + b(k,52) = b(k,52) - lu(k,3864) * b(k,316) + b(k,51) = b(k,51) - lu(k,3863) * b(k,316) + b(k,50) = b(k,50) - lu(k,3862) * b(k,316) + b(k,49) = b(k,49) - lu(k,3861) * b(k,316) + b(k,48) = b(k,48) - lu(k,3860) * b(k,316) + b(k,47) = b(k,47) - lu(k,3859) * b(k,316) + b(k,46) = b(k,46) - lu(k,3858) * b(k,316) + b(k,43) = b(k,43) - lu(k,3857) * b(k,316) + b(k,42) = b(k,42) - lu(k,3856) * b(k,316) + b(k,41) = b(k,41) - lu(k,3855) * b(k,316) + b(k,40) = b(k,40) - lu(k,3854) * b(k,316) + b(k,39) = b(k,39) - lu(k,3853) * b(k,316) + end do + end subroutine lu_slv11 + subroutine lu_slv12( 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,315) = b(k,315) * lu(k,3850) + b(k,314) = b(k,314) - lu(k,3849) * b(k,315) + b(k,313) = b(k,313) - lu(k,3848) * b(k,315) + b(k,312) = b(k,312) - lu(k,3847) * b(k,315) + b(k,311) = b(k,311) - lu(k,3846) * b(k,315) + b(k,310) = b(k,310) - lu(k,3845) * b(k,315) + b(k,309) = b(k,309) - lu(k,3844) * b(k,315) + b(k,308) = b(k,308) - lu(k,3843) * b(k,315) + b(k,307) = b(k,307) - lu(k,3842) * b(k,315) + b(k,306) = b(k,306) - lu(k,3841) * b(k,315) + b(k,305) = b(k,305) - lu(k,3840) * b(k,315) + b(k,304) = b(k,304) - lu(k,3839) * b(k,315) + b(k,303) = b(k,303) - lu(k,3838) * b(k,315) + b(k,302) = b(k,302) - lu(k,3837) * b(k,315) + b(k,301) = b(k,301) - lu(k,3836) * b(k,315) + b(k,300) = b(k,300) - lu(k,3835) * b(k,315) + b(k,279) = b(k,279) - lu(k,3834) * b(k,315) + b(k,276) = b(k,276) - lu(k,3833) * b(k,315) + b(k,271) = b(k,271) - lu(k,3832) * b(k,315) + b(k,254) = b(k,254) - lu(k,3831) * b(k,315) + b(k,251) = b(k,251) - lu(k,3830) * b(k,315) + b(k,247) = b(k,247) - lu(k,3829) * b(k,315) + b(k,238) = b(k,238) - lu(k,3828) * b(k,315) + b(k,237) = b(k,237) - lu(k,3827) * b(k,315) + b(k,235) = b(k,235) - lu(k,3826) * b(k,315) + b(k,230) = b(k,230) - lu(k,3825) * b(k,315) + b(k,227) = b(k,227) - lu(k,3824) * b(k,315) + b(k,225) = b(k,225) - lu(k,3823) * b(k,315) + b(k,223) = b(k,223) - lu(k,3822) * b(k,315) + b(k,209) = b(k,209) - lu(k,3821) * b(k,315) + b(k,179) = b(k,179) - lu(k,3820) * b(k,315) + b(k,156) = b(k,156) - lu(k,3819) * b(k,315) + b(k,149) = b(k,149) - lu(k,3818) * b(k,315) + b(k,137) = b(k,137) - lu(k,3817) * b(k,315) + b(k,131) = b(k,131) - lu(k,3816) * b(k,315) + b(k,120) = b(k,120) - lu(k,3815) * b(k,315) + b(k,106) = b(k,106) - lu(k,3814) * b(k,315) + b(k,105) = b(k,105) - lu(k,3813) * b(k,315) + b(k,75) = b(k,75) - lu(k,3812) * b(k,315) + b(k,314) = b(k,314) * lu(k,3808) + b(k,313) = b(k,313) - lu(k,3807) * b(k,314) + b(k,312) = b(k,312) - lu(k,3806) * b(k,314) + b(k,311) = b(k,311) - lu(k,3805) * b(k,314) + b(k,310) = b(k,310) - lu(k,3804) * b(k,314) + b(k,309) = b(k,309) - lu(k,3803) * b(k,314) + b(k,308) = b(k,308) - lu(k,3802) * b(k,314) + b(k,307) = b(k,307) - lu(k,3801) * b(k,314) + b(k,306) = b(k,306) - lu(k,3800) * b(k,314) + b(k,305) = b(k,305) - lu(k,3799) * b(k,314) + b(k,304) = b(k,304) - lu(k,3798) * b(k,314) + b(k,303) = b(k,303) - lu(k,3797) * b(k,314) + b(k,302) = b(k,302) - lu(k,3796) * b(k,314) + b(k,301) = b(k,301) - lu(k,3795) * b(k,314) + b(k,279) = b(k,279) - lu(k,3794) * b(k,314) + b(k,276) = b(k,276) - lu(k,3793) * b(k,314) + b(k,251) = b(k,251) - lu(k,3792) * b(k,314) + b(k,217) = b(k,217) - lu(k,3791) * b(k,314) + b(k,208) = b(k,208) - lu(k,3790) * b(k,314) + b(k,156) = b(k,156) - lu(k,3789) * b(k,314) + b(k,137) = b(k,137) - lu(k,3788) * b(k,314) + b(k,131) = b(k,131) - lu(k,3787) * b(k,314) + b(k,108) = b(k,108) - lu(k,3786) * b(k,314) + b(k,93) = b(k,93) - lu(k,3785) * b(k,314) + b(k,92) = b(k,92) - lu(k,3784) * b(k,314) + b(k,91) = b(k,91) - lu(k,3783) * b(k,314) + b(k,90) = b(k,90) - lu(k,3782) * b(k,314) + b(k,80) = b(k,80) - lu(k,3781) * b(k,314) + b(k,79) = b(k,79) - lu(k,3780) * b(k,314) + b(k,74) = b(k,74) - lu(k,3779) * b(k,314) + b(k,73) = b(k,73) - lu(k,3778) * b(k,314) + b(k,72) = b(k,72) - lu(k,3777) * b(k,314) + b(k,71) = b(k,71) - lu(k,3776) * b(k,314) + b(k,66) = b(k,66) - lu(k,3775) * b(k,314) + b(k,65) = b(k,65) - lu(k,3774) * b(k,314) + b(k,64) = b(k,64) - lu(k,3773) * b(k,314) + b(k,62) = b(k,62) - lu(k,3772) * b(k,314) + b(k,60) = b(k,60) - lu(k,3771) * b(k,314) + b(k,313) = b(k,313) * lu(k,3766) + b(k,312) = b(k,312) - lu(k,3765) * b(k,313) + b(k,311) = b(k,311) - lu(k,3764) * b(k,313) + b(k,310) = b(k,310) - lu(k,3763) * b(k,313) + b(k,309) = b(k,309) - lu(k,3762) * b(k,313) + b(k,308) = b(k,308) - lu(k,3761) * b(k,313) + b(k,307) = b(k,307) - lu(k,3760) * b(k,313) + b(k,306) = b(k,306) - lu(k,3759) * b(k,313) + b(k,305) = b(k,305) - lu(k,3758) * b(k,313) + b(k,304) = b(k,304) - lu(k,3757) * b(k,313) + b(k,303) = b(k,303) - lu(k,3756) * b(k,313) + b(k,302) = b(k,302) - lu(k,3755) * b(k,313) + b(k,301) = b(k,301) - lu(k,3754) * b(k,313) + b(k,300) = b(k,300) - lu(k,3753) * b(k,313) + b(k,299) = b(k,299) - lu(k,3752) * b(k,313) + b(k,298) = b(k,298) - lu(k,3751) * b(k,313) + b(k,297) = b(k,297) - lu(k,3750) * b(k,313) + b(k,296) = b(k,296) - lu(k,3749) * b(k,313) + b(k,295) = b(k,295) - lu(k,3748) * b(k,313) + b(k,294) = b(k,294) - lu(k,3747) * b(k,313) + b(k,293) = b(k,293) - lu(k,3746) * b(k,313) + b(k,292) = b(k,292) - lu(k,3745) * b(k,313) + b(k,291) = b(k,291) - lu(k,3744) * b(k,313) + b(k,290) = b(k,290) - lu(k,3743) * b(k,313) + b(k,289) = b(k,289) - lu(k,3742) * b(k,313) + b(k,288) = b(k,288) - lu(k,3741) * b(k,313) + b(k,287) = b(k,287) - lu(k,3740) * b(k,313) + b(k,286) = b(k,286) - lu(k,3739) * b(k,313) + b(k,285) = b(k,285) - lu(k,3738) * b(k,313) + b(k,284) = b(k,284) - lu(k,3737) * b(k,313) + b(k,283) = b(k,283) - lu(k,3736) * b(k,313) + b(k,281) = b(k,281) - lu(k,3735) * b(k,313) + b(k,280) = b(k,280) - lu(k,3734) * b(k,313) + b(k,279) = b(k,279) - lu(k,3733) * b(k,313) + b(k,277) = b(k,277) - lu(k,3732) * b(k,313) + b(k,276) = b(k,276) - lu(k,3731) * b(k,313) + b(k,275) = b(k,275) - lu(k,3730) * b(k,313) + b(k,274) = b(k,274) - lu(k,3729) * b(k,313) + b(k,273) = b(k,273) - lu(k,3728) * b(k,313) + b(k,272) = b(k,272) - lu(k,3727) * b(k,313) + b(k,271) = b(k,271) - lu(k,3726) * b(k,313) + b(k,270) = b(k,270) - lu(k,3725) * b(k,313) + b(k,269) = b(k,269) - lu(k,3724) * b(k,313) + b(k,268) = b(k,268) - lu(k,3723) * b(k,313) + b(k,267) = b(k,267) - lu(k,3722) * b(k,313) + b(k,266) = b(k,266) - lu(k,3721) * b(k,313) + b(k,265) = b(k,265) - lu(k,3720) * b(k,313) + b(k,264) = b(k,264) - lu(k,3719) * b(k,313) + b(k,263) = b(k,263) - lu(k,3718) * b(k,313) + b(k,262) = b(k,262) - lu(k,3717) * b(k,313) + b(k,261) = b(k,261) - lu(k,3716) * b(k,313) + b(k,260) = b(k,260) - lu(k,3715) * b(k,313) + b(k,259) = b(k,259) - lu(k,3714) * b(k,313) + b(k,258) = b(k,258) - lu(k,3713) * b(k,313) + b(k,257) = b(k,257) - lu(k,3712) * b(k,313) + b(k,256) = b(k,256) - lu(k,3711) * b(k,313) + b(k,255) = b(k,255) - lu(k,3710) * b(k,313) + b(k,254) = b(k,254) - lu(k,3709) * b(k,313) + b(k,250) = b(k,250) - lu(k,3708) * b(k,313) + b(k,249) = b(k,249) - lu(k,3707) * b(k,313) + b(k,247) = b(k,247) - lu(k,3706) * b(k,313) + b(k,246) = b(k,246) - lu(k,3705) * b(k,313) + b(k,245) = b(k,245) - lu(k,3704) * b(k,313) + b(k,238) = b(k,238) - lu(k,3703) * b(k,313) + b(k,237) = b(k,237) - lu(k,3702) * b(k,313) + b(k,236) = b(k,236) - lu(k,3701) * b(k,313) + b(k,235) = b(k,235) - lu(k,3700) * b(k,313) + b(k,232) = b(k,232) - lu(k,3699) * b(k,313) + b(k,230) = b(k,230) - lu(k,3698) * b(k,313) + b(k,229) = b(k,229) - lu(k,3697) * b(k,313) + b(k,228) = b(k,228) - lu(k,3696) * b(k,313) + b(k,227) = b(k,227) - lu(k,3695) * b(k,313) + b(k,225) = b(k,225) - lu(k,3694) * b(k,313) + b(k,220) = b(k,220) - lu(k,3693) * b(k,313) + b(k,219) = b(k,219) - lu(k,3692) * b(k,313) + b(k,216) = b(k,216) - lu(k,3691) * b(k,313) + b(k,213) = b(k,213) - lu(k,3690) * b(k,313) + b(k,211) = b(k,211) - lu(k,3689) * b(k,313) + b(k,203) = b(k,203) - lu(k,3688) * b(k,313) + b(k,202) = b(k,202) - lu(k,3687) * b(k,313) + b(k,201) = b(k,201) - lu(k,3686) * b(k,313) + b(k,199) = b(k,199) - lu(k,3685) * b(k,313) + b(k,187) = b(k,187) - lu(k,3684) * b(k,313) + b(k,182) = b(k,182) - lu(k,3683) * b(k,313) + b(k,179) = b(k,179) - lu(k,3682) * b(k,313) + b(k,177) = b(k,177) - lu(k,3681) * b(k,313) + b(k,173) = b(k,173) - lu(k,3680) * b(k,313) + b(k,171) = b(k,171) - lu(k,3679) * b(k,313) + b(k,164) = b(k,164) - lu(k,3678) * b(k,313) + b(k,149) = b(k,149) - lu(k,3677) * b(k,313) + b(k,143) = b(k,143) - lu(k,3676) * b(k,313) + b(k,135) = b(k,135) - lu(k,3675) * b(k,313) + b(k,81) = b(k,81) - lu(k,3674) * b(k,313) + b(k,43) = b(k,43) - lu(k,3673) * b(k,313) + b(k,42) = b(k,42) - lu(k,3672) * b(k,313) + b(k,41) = b(k,41) - lu(k,3671) * b(k,313) + b(k,40) = b(k,40) - lu(k,3670) * b(k,313) + b(k,39) = b(k,39) - lu(k,3669) * b(k,313) + b(k,312) = b(k,312) * lu(k,3663) + b(k,311) = b(k,311) - lu(k,3662) * b(k,312) + b(k,310) = b(k,310) - lu(k,3661) * b(k,312) + b(k,309) = b(k,309) - lu(k,3660) * b(k,312) + b(k,308) = b(k,308) - lu(k,3659) * b(k,312) + b(k,307) = b(k,307) - lu(k,3658) * b(k,312) + b(k,306) = b(k,306) - lu(k,3657) * b(k,312) + b(k,305) = b(k,305) - lu(k,3656) * b(k,312) + b(k,304) = b(k,304) - lu(k,3655) * b(k,312) + b(k,303) = b(k,303) - lu(k,3654) * b(k,312) + b(k,302) = b(k,302) - lu(k,3653) * b(k,312) + b(k,301) = b(k,301) - lu(k,3652) * b(k,312) + b(k,300) = b(k,300) - lu(k,3651) * b(k,312) + b(k,299) = b(k,299) - lu(k,3650) * b(k,312) + b(k,298) = b(k,298) - lu(k,3649) * b(k,312) + b(k,297) = b(k,297) - lu(k,3648) * b(k,312) + b(k,296) = b(k,296) - lu(k,3647) * b(k,312) + b(k,280) = b(k,280) - lu(k,3646) * b(k,312) + b(k,276) = b(k,276) - lu(k,3645) * b(k,312) + b(k,271) = b(k,271) - lu(k,3644) * b(k,312) + b(k,266) = b(k,266) - lu(k,3643) * b(k,312) + b(k,258) = b(k,258) - lu(k,3642) * b(k,312) + b(k,248) = b(k,248) - lu(k,3641) * b(k,312) + b(k,247) = b(k,247) - lu(k,3640) * b(k,312) + b(k,246) = b(k,246) - lu(k,3639) * b(k,312) + b(k,235) = b(k,235) - lu(k,3638) * b(k,312) + b(k,223) = b(k,223) - lu(k,3637) * b(k,312) + b(k,220) = b(k,220) - lu(k,3636) * b(k,312) + b(k,216) = b(k,216) - lu(k,3635) * b(k,312) + b(k,195) = b(k,195) - lu(k,3634) * b(k,312) + b(k,188) = b(k,188) - lu(k,3633) * b(k,312) + b(k,184) = b(k,184) - lu(k,3632) * b(k,312) + b(k,180) = b(k,180) - lu(k,3631) * b(k,312) + b(k,164) = b(k,164) - lu(k,3630) * b(k,312) + b(k,158) = b(k,158) - lu(k,3629) * b(k,312) + b(k,157) = b(k,157) - lu(k,3628) * b(k,312) + b(k,147) = b(k,147) - lu(k,3627) * b(k,312) + b(k,146) = b(k,146) - lu(k,3626) * b(k,312) + b(k,144) = b(k,144) - lu(k,3625) * b(k,312) + b(k,141) = b(k,141) - lu(k,3624) * b(k,312) + b(k,135) = b(k,135) - lu(k,3623) * b(k,312) + b(k,134) = b(k,134) - lu(k,3622) * b(k,312) + b(k,128) = b(k,128) - lu(k,3621) * b(k,312) + b(k,125) = b(k,125) - lu(k,3620) * b(k,312) + b(k,102) = b(k,102) - lu(k,3619) * b(k,312) + b(k,80) = b(k,80) - lu(k,3618) * b(k,312) + b(k,70) = b(k,70) - lu(k,3617) * b(k,312) + end do + end subroutine lu_slv12 + subroutine lu_slv13( 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,311) = b(k,311) * lu(k,3610) + b(k,310) = b(k,310) - lu(k,3609) * b(k,311) + b(k,309) = b(k,309) - lu(k,3608) * b(k,311) + b(k,308) = b(k,308) - lu(k,3607) * b(k,311) + b(k,307) = b(k,307) - lu(k,3606) * b(k,311) + b(k,306) = b(k,306) - lu(k,3605) * b(k,311) + b(k,305) = b(k,305) - lu(k,3604) * b(k,311) + b(k,304) = b(k,304) - lu(k,3603) * b(k,311) + b(k,303) = b(k,303) - lu(k,3602) * b(k,311) + b(k,302) = b(k,302) - lu(k,3601) * b(k,311) + b(k,301) = b(k,301) - lu(k,3600) * b(k,311) + b(k,300) = b(k,300) - lu(k,3599) * b(k,311) + b(k,299) = b(k,299) - lu(k,3598) * b(k,311) + b(k,298) = b(k,298) - lu(k,3597) * b(k,311) + b(k,297) = b(k,297) - lu(k,3596) * b(k,311) + b(k,296) = b(k,296) - lu(k,3595) * b(k,311) + b(k,295) = b(k,295) - lu(k,3594) * b(k,311) + b(k,294) = b(k,294) - lu(k,3593) * b(k,311) + b(k,293) = b(k,293) - lu(k,3592) * b(k,311) + b(k,292) = b(k,292) - lu(k,3591) * b(k,311) + b(k,291) = b(k,291) - lu(k,3590) * b(k,311) + b(k,290) = b(k,290) - lu(k,3589) * b(k,311) + b(k,289) = b(k,289) - lu(k,3588) * b(k,311) + b(k,288) = b(k,288) - lu(k,3587) * b(k,311) + b(k,287) = b(k,287) - lu(k,3586) * b(k,311) + b(k,286) = b(k,286) - lu(k,3585) * b(k,311) + b(k,285) = b(k,285) - lu(k,3584) * b(k,311) + b(k,284) = b(k,284) - lu(k,3583) * b(k,311) + b(k,283) = b(k,283) - lu(k,3582) * b(k,311) + b(k,282) = b(k,282) - lu(k,3581) * b(k,311) + b(k,281) = b(k,281) - lu(k,3580) * b(k,311) + b(k,280) = b(k,280) - lu(k,3579) * b(k,311) + b(k,279) = b(k,279) - lu(k,3578) * b(k,311) + b(k,278) = b(k,278) - lu(k,3577) * b(k,311) + b(k,277) = b(k,277) - lu(k,3576) * b(k,311) + b(k,276) = b(k,276) - lu(k,3575) * b(k,311) + b(k,275) = b(k,275) - lu(k,3574) * b(k,311) + b(k,274) = b(k,274) - lu(k,3573) * b(k,311) + b(k,273) = b(k,273) - lu(k,3572) * b(k,311) + b(k,272) = b(k,272) - lu(k,3571) * b(k,311) + b(k,271) = b(k,271) - lu(k,3570) * b(k,311) + b(k,270) = b(k,270) - lu(k,3569) * b(k,311) + b(k,269) = b(k,269) - lu(k,3568) * b(k,311) + b(k,268) = b(k,268) - lu(k,3567) * b(k,311) + b(k,267) = b(k,267) - lu(k,3566) * b(k,311) + b(k,266) = b(k,266) - lu(k,3565) * b(k,311) + b(k,265) = b(k,265) - lu(k,3564) * b(k,311) + b(k,264) = b(k,264) - lu(k,3563) * b(k,311) + b(k,263) = b(k,263) - lu(k,3562) * b(k,311) + b(k,262) = b(k,262) - lu(k,3561) * b(k,311) + b(k,261) = b(k,261) - lu(k,3560) * b(k,311) + b(k,258) = b(k,258) - lu(k,3559) * b(k,311) + b(k,257) = b(k,257) - lu(k,3558) * b(k,311) + b(k,256) = b(k,256) - lu(k,3557) * b(k,311) + b(k,255) = b(k,255) - lu(k,3556) * b(k,311) + b(k,254) = b(k,254) - lu(k,3555) * b(k,311) + b(k,253) = b(k,253) - lu(k,3554) * b(k,311) + b(k,252) = b(k,252) - lu(k,3553) * b(k,311) + b(k,248) = b(k,248) - lu(k,3552) * b(k,311) + b(k,247) = b(k,247) - lu(k,3551) * b(k,311) + b(k,246) = b(k,246) - lu(k,3550) * b(k,311) + b(k,244) = b(k,244) - lu(k,3549) * b(k,311) + b(k,242) = b(k,242) - lu(k,3548) * b(k,311) + b(k,238) = b(k,238) - lu(k,3547) * b(k,311) + b(k,237) = b(k,237) - lu(k,3546) * b(k,311) + b(k,236) = b(k,236) - lu(k,3545) * b(k,311) + b(k,230) = b(k,230) - lu(k,3544) * b(k,311) + b(k,229) = b(k,229) - lu(k,3543) * b(k,311) + b(k,228) = b(k,228) - lu(k,3542) * b(k,311) + b(k,227) = b(k,227) - lu(k,3541) * b(k,311) + b(k,225) = b(k,225) - lu(k,3540) * b(k,311) + b(k,220) = b(k,220) - lu(k,3539) * b(k,311) + b(k,219) = b(k,219) - lu(k,3538) * b(k,311) + b(k,216) = b(k,216) - lu(k,3537) * b(k,311) + b(k,213) = b(k,213) - lu(k,3536) * b(k,311) + b(k,211) = b(k,211) - lu(k,3535) * b(k,311) + b(k,203) = b(k,203) - lu(k,3534) * b(k,311) + b(k,202) = b(k,202) - lu(k,3533) * b(k,311) + b(k,201) = b(k,201) - lu(k,3532) * b(k,311) + b(k,199) = b(k,199) - lu(k,3531) * b(k,311) + b(k,193) = b(k,193) - lu(k,3530) * b(k,311) + b(k,177) = b(k,177) - lu(k,3529) * b(k,311) + b(k,152) = b(k,152) - lu(k,3528) * b(k,311) + b(k,118) = b(k,118) - lu(k,3527) * b(k,311) + b(k,104) = b(k,104) - lu(k,3526) * b(k,311) + b(k,102) = b(k,102) - lu(k,3525) * b(k,311) + b(k,43) = b(k,43) - lu(k,3524) * b(k,311) + b(k,42) = b(k,42) - lu(k,3523) * b(k,311) + b(k,310) = b(k,310) * lu(k,3515) + b(k,309) = b(k,309) - lu(k,3514) * b(k,310) + b(k,308) = b(k,308) - lu(k,3513) * b(k,310) + b(k,307) = b(k,307) - lu(k,3512) * b(k,310) + b(k,306) = b(k,306) - lu(k,3511) * b(k,310) + b(k,305) = b(k,305) - lu(k,3510) * b(k,310) + b(k,304) = b(k,304) - lu(k,3509) * b(k,310) + b(k,303) = b(k,303) - lu(k,3508) * b(k,310) + b(k,302) = b(k,302) - lu(k,3507) * b(k,310) + b(k,301) = b(k,301) - lu(k,3506) * b(k,310) + b(k,276) = b(k,276) - lu(k,3505) * b(k,310) + b(k,246) = b(k,246) - lu(k,3504) * b(k,310) + b(k,223) = b(k,223) - lu(k,3503) * b(k,310) + b(k,216) = b(k,216) - lu(k,3502) * b(k,310) + b(k,209) = b(k,209) - lu(k,3501) * b(k,310) + b(k,111) = b(k,111) - lu(k,3500) * b(k,310) + b(k,88) = b(k,88) - lu(k,3499) * b(k,310) + b(k,75) = b(k,75) - lu(k,3498) * b(k,310) + b(k,58) = b(k,58) - lu(k,3497) * b(k,310) + b(k,309) = b(k,309) * lu(k,3488) + b(k,308) = b(k,308) - lu(k,3487) * b(k,309) + b(k,307) = b(k,307) - lu(k,3486) * b(k,309) + b(k,306) = b(k,306) - lu(k,3485) * b(k,309) + b(k,305) = b(k,305) - lu(k,3484) * b(k,309) + b(k,304) = b(k,304) - lu(k,3483) * b(k,309) + b(k,303) = b(k,303) - lu(k,3482) * b(k,309) + b(k,302) = b(k,302) - lu(k,3481) * b(k,309) + b(k,301) = b(k,301) - lu(k,3480) * b(k,309) + b(k,276) = b(k,276) - lu(k,3479) * b(k,309) + b(k,246) = b(k,246) - lu(k,3478) * b(k,309) + b(k,216) = b(k,216) - lu(k,3477) * b(k,309) + b(k,195) = b(k,195) - lu(k,3476) * b(k,309) + b(k,146) = b(k,146) - lu(k,3475) * b(k,309) + b(k,111) = b(k,111) - lu(k,3474) * b(k,309) + b(k,88) = b(k,88) - lu(k,3473) * b(k,309) + b(k,308) = b(k,308) * lu(k,3463) + b(k,307) = b(k,307) - lu(k,3462) * b(k,308) + b(k,306) = b(k,306) - lu(k,3461) * b(k,308) + b(k,305) = b(k,305) - lu(k,3460) * b(k,308) + b(k,304) = b(k,304) - lu(k,3459) * b(k,308) + b(k,303) = b(k,303) - lu(k,3458) * b(k,308) + b(k,302) = b(k,302) - lu(k,3457) * b(k,308) + b(k,301) = b(k,301) - lu(k,3456) * b(k,308) + b(k,300) = b(k,300) - lu(k,3455) * b(k,308) + b(k,299) = b(k,299) - lu(k,3454) * b(k,308) + b(k,298) = b(k,298) - lu(k,3453) * b(k,308) + b(k,297) = b(k,297) - lu(k,3452) * b(k,308) + b(k,296) = b(k,296) - lu(k,3451) * b(k,308) + b(k,295) = b(k,295) - lu(k,3450) * b(k,308) + b(k,294) = b(k,294) - lu(k,3449) * b(k,308) + b(k,293) = b(k,293) - lu(k,3448) * b(k,308) + b(k,292) = b(k,292) - lu(k,3447) * b(k,308) + b(k,291) = b(k,291) - lu(k,3446) * b(k,308) + b(k,290) = b(k,290) - lu(k,3445) * b(k,308) + b(k,289) = b(k,289) - lu(k,3444) * b(k,308) + b(k,288) = b(k,288) - lu(k,3443) * b(k,308) + b(k,287) = b(k,287) - lu(k,3442) * b(k,308) + b(k,286) = b(k,286) - lu(k,3441) * b(k,308) + b(k,285) = b(k,285) - lu(k,3440) * b(k,308) + b(k,284) = b(k,284) - lu(k,3439) * b(k,308) + b(k,283) = b(k,283) - lu(k,3438) * b(k,308) + b(k,282) = b(k,282) - lu(k,3437) * b(k,308) + b(k,281) = b(k,281) - lu(k,3436) * b(k,308) + b(k,280) = b(k,280) - lu(k,3435) * b(k,308) + b(k,279) = b(k,279) - lu(k,3434) * b(k,308) + b(k,278) = b(k,278) - lu(k,3433) * b(k,308) + b(k,277) = b(k,277) - lu(k,3432) * b(k,308) + b(k,275) = b(k,275) - lu(k,3431) * b(k,308) + b(k,274) = b(k,274) - lu(k,3430) * b(k,308) + b(k,273) = b(k,273) - lu(k,3429) * b(k,308) + b(k,272) = b(k,272) - lu(k,3428) * b(k,308) + b(k,271) = b(k,271) - lu(k,3427) * b(k,308) + b(k,270) = b(k,270) - lu(k,3426) * b(k,308) + b(k,269) = b(k,269) - lu(k,3425) * b(k,308) + b(k,268) = b(k,268) - lu(k,3424) * b(k,308) + b(k,267) = b(k,267) - lu(k,3423) * b(k,308) + b(k,266) = b(k,266) - lu(k,3422) * b(k,308) + b(k,265) = b(k,265) - lu(k,3421) * b(k,308) + b(k,264) = b(k,264) - lu(k,3420) * b(k,308) + b(k,263) = b(k,263) - lu(k,3419) * b(k,308) + b(k,262) = b(k,262) - lu(k,3418) * b(k,308) + b(k,261) = b(k,261) - lu(k,3417) * b(k,308) + b(k,260) = b(k,260) - lu(k,3416) * b(k,308) + b(k,259) = b(k,259) - lu(k,3415) * b(k,308) + b(k,258) = b(k,258) - lu(k,3414) * b(k,308) + b(k,257) = b(k,257) - lu(k,3413) * b(k,308) + b(k,256) = b(k,256) - lu(k,3412) * b(k,308) + b(k,255) = b(k,255) - lu(k,3411) * b(k,308) + b(k,254) = b(k,254) - lu(k,3410) * b(k,308) + b(k,253) = b(k,253) - lu(k,3409) * b(k,308) + b(k,252) = b(k,252) - lu(k,3408) * b(k,308) + b(k,250) = b(k,250) - lu(k,3407) * b(k,308) + b(k,249) = b(k,249) - lu(k,3406) * b(k,308) + b(k,248) = b(k,248) - lu(k,3405) * b(k,308) + b(k,247) = b(k,247) - lu(k,3404) * b(k,308) + b(k,244) = b(k,244) - lu(k,3403) * b(k,308) + b(k,243) = b(k,243) - lu(k,3402) * b(k,308) + b(k,242) = b(k,242) - lu(k,3401) * b(k,308) + b(k,240) = b(k,240) - lu(k,3400) * b(k,308) + b(k,239) = b(k,239) - lu(k,3399) * b(k,308) + b(k,238) = b(k,238) - lu(k,3398) * b(k,308) + b(k,236) = b(k,236) - lu(k,3397) * b(k,308) + b(k,234) = b(k,234) - lu(k,3396) * b(k,308) + b(k,233) = b(k,233) - lu(k,3395) * b(k,308) + b(k,232) = b(k,232) - lu(k,3394) * b(k,308) + b(k,231) = b(k,231) - lu(k,3393) * b(k,308) + b(k,230) = b(k,230) - lu(k,3392) * b(k,308) + b(k,225) = b(k,225) - lu(k,3391) * b(k,308) + b(k,224) = b(k,224) - lu(k,3390) * b(k,308) + b(k,220) = b(k,220) - lu(k,3389) * b(k,308) + b(k,218) = b(k,218) - lu(k,3388) * b(k,308) + b(k,203) = b(k,203) - lu(k,3387) * b(k,308) + b(k,198) = b(k,198) - lu(k,3386) * b(k,308) + b(k,186) = b(k,186) - lu(k,3385) * b(k,308) + b(k,173) = b(k,173) - lu(k,3384) * b(k,308) + b(k,166) = b(k,166) - lu(k,3383) * b(k,308) + b(k,129) = b(k,129) - lu(k,3382) * b(k,308) + b(k,99) = b(k,99) - lu(k,3381) * b(k,308) + b(k,44) = b(k,44) - lu(k,3380) * b(k,308) + end do + end subroutine lu_slv13 + subroutine lu_slv14( 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,307) = b(k,307) * lu(k,3369) + b(k,306) = b(k,306) - lu(k,3368) * b(k,307) + b(k,305) = b(k,305) - lu(k,3367) * b(k,307) + b(k,304) = b(k,304) - lu(k,3366) * b(k,307) + b(k,303) = b(k,303) - lu(k,3365) * b(k,307) + b(k,302) = b(k,302) - lu(k,3364) * b(k,307) + b(k,301) = b(k,301) - lu(k,3363) * b(k,307) + b(k,300) = b(k,300) - lu(k,3362) * b(k,307) + b(k,299) = b(k,299) - lu(k,3361) * b(k,307) + b(k,298) = b(k,298) - lu(k,3360) * b(k,307) + b(k,297) = b(k,297) - lu(k,3359) * b(k,307) + b(k,296) = b(k,296) - lu(k,3358) * b(k,307) + b(k,295) = b(k,295) - lu(k,3357) * b(k,307) + b(k,294) = b(k,294) - lu(k,3356) * b(k,307) + b(k,293) = b(k,293) - lu(k,3355) * b(k,307) + b(k,292) = b(k,292) - lu(k,3354) * b(k,307) + b(k,291) = b(k,291) - lu(k,3353) * b(k,307) + b(k,290) = b(k,290) - lu(k,3352) * b(k,307) + b(k,289) = b(k,289) - lu(k,3351) * b(k,307) + b(k,288) = b(k,288) - lu(k,3350) * b(k,307) + b(k,287) = b(k,287) - lu(k,3349) * b(k,307) + b(k,286) = b(k,286) - lu(k,3348) * b(k,307) + b(k,285) = b(k,285) - lu(k,3347) * b(k,307) + b(k,284) = b(k,284) - lu(k,3346) * b(k,307) + b(k,283) = b(k,283) - lu(k,3345) * b(k,307) + b(k,282) = b(k,282) - lu(k,3344) * b(k,307) + b(k,281) = b(k,281) - lu(k,3343) * b(k,307) + b(k,280) = b(k,280) - lu(k,3342) * b(k,307) + b(k,279) = b(k,279) - lu(k,3341) * b(k,307) + b(k,278) = b(k,278) - lu(k,3340) * b(k,307) + b(k,277) = b(k,277) - lu(k,3339) * b(k,307) + b(k,276) = b(k,276) - lu(k,3338) * b(k,307) + b(k,275) = b(k,275) - lu(k,3337) * b(k,307) + b(k,274) = b(k,274) - lu(k,3336) * b(k,307) + b(k,273) = b(k,273) - lu(k,3335) * b(k,307) + b(k,272) = b(k,272) - lu(k,3334) * b(k,307) + b(k,271) = b(k,271) - lu(k,3333) * b(k,307) + b(k,270) = b(k,270) - lu(k,3332) * b(k,307) + b(k,269) = b(k,269) - lu(k,3331) * b(k,307) + b(k,268) = b(k,268) - lu(k,3330) * b(k,307) + b(k,267) = b(k,267) - lu(k,3329) * b(k,307) + b(k,266) = b(k,266) - lu(k,3328) * b(k,307) + b(k,265) = b(k,265) - lu(k,3327) * b(k,307) + b(k,264) = b(k,264) - lu(k,3326) * b(k,307) + b(k,263) = b(k,263) - lu(k,3325) * b(k,307) + b(k,262) = b(k,262) - lu(k,3324) * b(k,307) + b(k,261) = b(k,261) - lu(k,3323) * b(k,307) + b(k,260) = b(k,260) - lu(k,3322) * b(k,307) + b(k,259) = b(k,259) - lu(k,3321) * b(k,307) + b(k,258) = b(k,258) - lu(k,3320) * b(k,307) + b(k,257) = b(k,257) - lu(k,3319) * b(k,307) + b(k,256) = b(k,256) - lu(k,3318) * b(k,307) + b(k,255) = b(k,255) - lu(k,3317) * b(k,307) + b(k,254) = b(k,254) - lu(k,3316) * b(k,307) + b(k,253) = b(k,253) - lu(k,3315) * b(k,307) + b(k,252) = b(k,252) - lu(k,3314) * b(k,307) + b(k,251) = b(k,251) - lu(k,3313) * b(k,307) + b(k,250) = b(k,250) - lu(k,3312) * b(k,307) + b(k,249) = b(k,249) - lu(k,3311) * b(k,307) + b(k,248) = b(k,248) - lu(k,3310) * b(k,307) + b(k,247) = b(k,247) - lu(k,3309) * b(k,307) + b(k,245) = b(k,245) - lu(k,3308) * b(k,307) + b(k,244) = b(k,244) - lu(k,3307) * b(k,307) + b(k,243) = b(k,243) - lu(k,3306) * b(k,307) + b(k,242) = b(k,242) - lu(k,3305) * b(k,307) + b(k,240) = b(k,240) - lu(k,3304) * b(k,307) + b(k,239) = b(k,239) - lu(k,3303) * b(k,307) + b(k,238) = b(k,238) - lu(k,3302) * b(k,307) + b(k,237) = b(k,237) - lu(k,3301) * b(k,307) + b(k,236) = b(k,236) - lu(k,3300) * b(k,307) + b(k,235) = b(k,235) - lu(k,3299) * b(k,307) + b(k,234) = b(k,234) - lu(k,3298) * b(k,307) + b(k,233) = b(k,233) - lu(k,3297) * b(k,307) + b(k,232) = b(k,232) - lu(k,3296) * b(k,307) + b(k,231) = b(k,231) - lu(k,3295) * b(k,307) + b(k,230) = b(k,230) - lu(k,3294) * b(k,307) + b(k,227) = b(k,227) - lu(k,3293) * b(k,307) + b(k,226) = b(k,226) - lu(k,3292) * b(k,307) + b(k,225) = b(k,225) - lu(k,3291) * b(k,307) + b(k,224) = b(k,224) - lu(k,3290) * b(k,307) + b(k,222) = b(k,222) - lu(k,3289) * b(k,307) + b(k,221) = b(k,221) - lu(k,3288) * b(k,307) + b(k,215) = b(k,215) - lu(k,3287) * b(k,307) + b(k,214) = b(k,214) - lu(k,3286) * b(k,307) + b(k,213) = b(k,213) - lu(k,3285) * b(k,307) + b(k,212) = b(k,212) - lu(k,3284) * b(k,307) + b(k,211) = b(k,211) - lu(k,3283) * b(k,307) + b(k,210) = b(k,210) - lu(k,3282) * b(k,307) + b(k,209) = b(k,209) - lu(k,3281) * b(k,307) + b(k,208) = b(k,208) - lu(k,3280) * b(k,307) + b(k,207) = b(k,207) - lu(k,3279) * b(k,307) + b(k,206) = b(k,206) - lu(k,3278) * b(k,307) + b(k,205) = b(k,205) - lu(k,3277) * b(k,307) + b(k,203) = b(k,203) - lu(k,3276) * b(k,307) + b(k,200) = b(k,200) - lu(k,3275) * b(k,307) + b(k,198) = b(k,198) - lu(k,3274) * b(k,307) + b(k,197) = b(k,197) - lu(k,3273) * b(k,307) + b(k,196) = b(k,196) - lu(k,3272) * b(k,307) + b(k,195) = b(k,195) - lu(k,3271) * b(k,307) + b(k,194) = b(k,194) - lu(k,3270) * b(k,307) + b(k,192) = b(k,192) - lu(k,3269) * b(k,307) + b(k,191) = b(k,191) - lu(k,3268) * b(k,307) + b(k,190) = b(k,190) - lu(k,3267) * b(k,307) + b(k,189) = b(k,189) - lu(k,3266) * b(k,307) + b(k,188) = b(k,188) - lu(k,3265) * b(k,307) + b(k,187) = b(k,187) - lu(k,3264) * b(k,307) + b(k,184) = b(k,184) - lu(k,3263) * b(k,307) + b(k,183) = b(k,183) - lu(k,3262) * b(k,307) + b(k,182) = b(k,182) - lu(k,3261) * b(k,307) + b(k,181) = b(k,181) - lu(k,3260) * b(k,307) + b(k,180) = b(k,180) - lu(k,3259) * b(k,307) + b(k,179) = b(k,179) - lu(k,3258) * b(k,307) + b(k,178) = b(k,178) - lu(k,3257) * b(k,307) + b(k,176) = b(k,176) - lu(k,3256) * b(k,307) + b(k,175) = b(k,175) - lu(k,3255) * b(k,307) + b(k,174) = b(k,174) - lu(k,3254) * b(k,307) + b(k,173) = b(k,173) - lu(k,3253) * b(k,307) + b(k,172) = b(k,172) - lu(k,3252) * b(k,307) + b(k,171) = b(k,171) - lu(k,3251) * b(k,307) + b(k,170) = b(k,170) - lu(k,3250) * b(k,307) + b(k,169) = b(k,169) - lu(k,3249) * b(k,307) + b(k,167) = b(k,167) - lu(k,3248) * b(k,307) + b(k,165) = b(k,165) - lu(k,3247) * b(k,307) + b(k,164) = b(k,164) - lu(k,3246) * b(k,307) + b(k,163) = b(k,163) - lu(k,3245) * b(k,307) + b(k,162) = b(k,162) - lu(k,3244) * b(k,307) + b(k,161) = b(k,161) - lu(k,3243) * b(k,307) + b(k,160) = b(k,160) - lu(k,3242) * b(k,307) + b(k,151) = b(k,151) - lu(k,3241) * b(k,307) + b(k,148) = b(k,148) - lu(k,3240) * b(k,307) + b(k,144) = b(k,144) - lu(k,3239) * b(k,307) + b(k,142) = b(k,142) - lu(k,3238) * b(k,307) + b(k,139) = b(k,139) - lu(k,3237) * b(k,307) + b(k,135) = b(k,135) - lu(k,3236) * b(k,307) + b(k,133) = b(k,133) - lu(k,3235) * b(k,307) + b(k,132) = b(k,132) - lu(k,3234) * b(k,307) + b(k,130) = b(k,130) - lu(k,3233) * b(k,307) + b(k,129) = b(k,129) - lu(k,3232) * b(k,307) + b(k,128) = b(k,128) - lu(k,3231) * b(k,307) + b(k,127) = b(k,127) - lu(k,3230) * b(k,307) + b(k,126) = b(k,126) - lu(k,3229) * b(k,307) + b(k,124) = b(k,124) - lu(k,3228) * b(k,307) + b(k,123) = b(k,123) - lu(k,3227) * b(k,307) + b(k,122) = b(k,122) - lu(k,3226) * b(k,307) + b(k,117) = b(k,117) - lu(k,3225) * b(k,307) + b(k,116) = b(k,116) - lu(k,3224) * b(k,307) + b(k,115) = b(k,115) - lu(k,3223) * b(k,307) + b(k,114) = b(k,114) - lu(k,3222) * b(k,307) + b(k,113) = b(k,113) - lu(k,3221) * b(k,307) + b(k,112) = b(k,112) - lu(k,3220) * b(k,307) + b(k,109) = b(k,109) - lu(k,3219) * b(k,307) + b(k,101) = b(k,101) - lu(k,3218) * b(k,307) + b(k,100) = b(k,100) - lu(k,3217) * b(k,307) + b(k,68) = b(k,68) - lu(k,3216) * b(k,307) + b(k,57) = b(k,57) - lu(k,3215) * b(k,307) + b(k,56) = b(k,56) - lu(k,3214) * b(k,307) + b(k,55) = b(k,55) - lu(k,3213) * b(k,307) + b(k,54) = b(k,54) - lu(k,3212) * b(k,307) + b(k,52) = b(k,52) - lu(k,3211) * b(k,307) + b(k,51) = b(k,51) - lu(k,3210) * b(k,307) + b(k,50) = b(k,50) - lu(k,3209) * b(k,307) + b(k,49) = b(k,49) - lu(k,3208) * b(k,307) + b(k,48) = b(k,48) - lu(k,3207) * b(k,307) + b(k,47) = b(k,47) - lu(k,3206) * b(k,307) + b(k,44) = b(k,44) - lu(k,3205) * b(k,307) + b(k,43) = b(k,43) - lu(k,3204) * b(k,307) + b(k,42) = b(k,42) - lu(k,3203) * b(k,307) + b(k,41) = b(k,41) - lu(k,3202) * b(k,307) + b(k,40) = b(k,40) - lu(k,3201) * b(k,307) + b(k,39) = b(k,39) - lu(k,3200) * b(k,307) + b(k,306) = b(k,306) * lu(k,3188) + b(k,305) = b(k,305) - lu(k,3187) * b(k,306) + b(k,304) = b(k,304) - lu(k,3186) * b(k,306) + b(k,303) = b(k,303) - lu(k,3185) * b(k,306) + b(k,302) = b(k,302) - lu(k,3184) * b(k,306) + b(k,301) = b(k,301) - lu(k,3183) * b(k,306) + b(k,279) = b(k,279) - lu(k,3182) * b(k,306) + b(k,276) = b(k,276) - lu(k,3181) * b(k,306) + b(k,271) = b(k,271) - lu(k,3180) * b(k,306) + b(k,251) = b(k,251) - lu(k,3179) * b(k,306) + b(k,247) = b(k,247) - lu(k,3178) * b(k,306) + b(k,227) = b(k,227) - lu(k,3177) * b(k,306) + b(k,213) = b(k,213) - lu(k,3176) * b(k,306) + b(k,208) = b(k,208) - lu(k,3175) * b(k,306) + b(k,162) = b(k,162) - lu(k,3174) * b(k,306) + b(k,305) = b(k,305) * lu(k,3161) + b(k,304) = b(k,304) - lu(k,3160) * b(k,305) + b(k,303) = b(k,303) - lu(k,3159) * b(k,305) + b(k,302) = b(k,302) - lu(k,3158) * b(k,305) + b(k,301) = b(k,301) - lu(k,3157) * b(k,305) + b(k,279) = b(k,279) - lu(k,3156) * b(k,305) + b(k,276) = b(k,276) - lu(k,3155) * b(k,305) + b(k,271) = b(k,271) - lu(k,3154) * b(k,305) + b(k,251) = b(k,251) - lu(k,3153) * b(k,305) + b(k,246) = b(k,246) - lu(k,3152) * b(k,305) + b(k,237) = b(k,237) - lu(k,3151) * b(k,305) + b(k,223) = b(k,223) - lu(k,3150) * b(k,305) + b(k,216) = b(k,216) - lu(k,3149) * b(k,305) + b(k,209) = b(k,209) - lu(k,3148) * b(k,305) + b(k,208) = b(k,208) - lu(k,3147) * b(k,305) + b(k,195) = b(k,195) - lu(k,3146) * b(k,305) + b(k,146) = b(k,146) - lu(k,3145) * b(k,305) + b(k,143) = b(k,143) - lu(k,3144) * b(k,305) + b(k,119) = b(k,119) - lu(k,3143) * b(k,305) + end do + end subroutine lu_slv14 + subroutine lu_slv15( 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,304) = b(k,304) * lu(k,3129) + b(k,302) = b(k,302) - lu(k,3128) * b(k,304) + b(k,301) = b(k,301) - lu(k,3127) * b(k,304) + b(k,276) = b(k,276) - lu(k,3126) * b(k,304) + b(k,223) = b(k,223) - lu(k,3125) * b(k,304) + b(k,209) = b(k,209) - lu(k,3124) * b(k,304) + b(k,195) = b(k,195) - lu(k,3123) * b(k,304) + b(k,88) = b(k,88) - lu(k,3122) * b(k,304) + b(k,75) = b(k,75) - lu(k,3121) * b(k,304) + b(k,303) = b(k,303) * lu(k,3106) + b(k,302) = b(k,302) - lu(k,3105) * b(k,303) + b(k,301) = b(k,301) - lu(k,3104) * b(k,303) + b(k,300) = b(k,300) - lu(k,3103) * b(k,303) + b(k,299) = b(k,299) - lu(k,3102) * b(k,303) + b(k,298) = b(k,298) - lu(k,3101) * b(k,303) + b(k,297) = b(k,297) - lu(k,3100) * b(k,303) + b(k,296) = b(k,296) - lu(k,3099) * b(k,303) + b(k,295) = b(k,295) - lu(k,3098) * b(k,303) + b(k,294) = b(k,294) - lu(k,3097) * b(k,303) + b(k,293) = b(k,293) - lu(k,3096) * b(k,303) + b(k,292) = b(k,292) - lu(k,3095) * b(k,303) + b(k,291) = b(k,291) - lu(k,3094) * b(k,303) + b(k,290) = b(k,290) - lu(k,3093) * b(k,303) + b(k,289) = b(k,289) - lu(k,3092) * b(k,303) + b(k,288) = b(k,288) - lu(k,3091) * b(k,303) + b(k,287) = b(k,287) - lu(k,3090) * b(k,303) + b(k,286) = b(k,286) - lu(k,3089) * b(k,303) + b(k,285) = b(k,285) - lu(k,3088) * b(k,303) + b(k,284) = b(k,284) - lu(k,3087) * b(k,303) + b(k,283) = b(k,283) - lu(k,3086) * b(k,303) + b(k,282) = b(k,282) - lu(k,3085) * b(k,303) + b(k,281) = b(k,281) - lu(k,3084) * b(k,303) + b(k,280) = b(k,280) - lu(k,3083) * b(k,303) + b(k,279) = b(k,279) - lu(k,3082) * b(k,303) + b(k,278) = b(k,278) - lu(k,3081) * b(k,303) + b(k,277) = b(k,277) - lu(k,3080) * b(k,303) + b(k,276) = b(k,276) - lu(k,3079) * b(k,303) + b(k,275) = b(k,275) - lu(k,3078) * b(k,303) + b(k,274) = b(k,274) - lu(k,3077) * b(k,303) + b(k,273) = b(k,273) - lu(k,3076) * b(k,303) + b(k,272) = b(k,272) - lu(k,3075) * b(k,303) + b(k,271) = b(k,271) - lu(k,3074) * b(k,303) + b(k,270) = b(k,270) - lu(k,3073) * b(k,303) + b(k,269) = b(k,269) - lu(k,3072) * b(k,303) + b(k,268) = b(k,268) - lu(k,3071) * b(k,303) + b(k,267) = b(k,267) - lu(k,3070) * b(k,303) + b(k,266) = b(k,266) - lu(k,3069) * b(k,303) + b(k,265) = b(k,265) - lu(k,3068) * b(k,303) + b(k,264) = b(k,264) - lu(k,3067) * b(k,303) + b(k,263) = b(k,263) - lu(k,3066) * b(k,303) + b(k,262) = b(k,262) - lu(k,3065) * b(k,303) + b(k,261) = b(k,261) - lu(k,3064) * b(k,303) + b(k,260) = b(k,260) - lu(k,3063) * b(k,303) + b(k,259) = b(k,259) - lu(k,3062) * b(k,303) + b(k,258) = b(k,258) - lu(k,3061) * b(k,303) + b(k,257) = b(k,257) - lu(k,3060) * b(k,303) + b(k,256) = b(k,256) - lu(k,3059) * b(k,303) + b(k,255) = b(k,255) - lu(k,3058) * b(k,303) + b(k,254) = b(k,254) - lu(k,3057) * b(k,303) + b(k,253) = b(k,253) - lu(k,3056) * b(k,303) + b(k,252) = b(k,252) - lu(k,3055) * b(k,303) + b(k,250) = b(k,250) - lu(k,3054) * b(k,303) + b(k,249) = b(k,249) - lu(k,3053) * b(k,303) + b(k,248) = b(k,248) - lu(k,3052) * b(k,303) + b(k,247) = b(k,247) - lu(k,3051) * b(k,303) + b(k,244) = b(k,244) - lu(k,3050) * b(k,303) + b(k,243) = b(k,243) - lu(k,3049) * b(k,303) + b(k,242) = b(k,242) - lu(k,3048) * b(k,303) + b(k,241) = b(k,241) - lu(k,3047) * b(k,303) + b(k,240) = b(k,240) - lu(k,3046) * b(k,303) + b(k,239) = b(k,239) - lu(k,3045) * b(k,303) + b(k,238) = b(k,238) - lu(k,3044) * b(k,303) + b(k,236) = b(k,236) - lu(k,3043) * b(k,303) + b(k,235) = b(k,235) - lu(k,3042) * b(k,303) + b(k,234) = b(k,234) - lu(k,3041) * b(k,303) + b(k,233) = b(k,233) - lu(k,3040) * b(k,303) + b(k,232) = b(k,232) - lu(k,3039) * b(k,303) + b(k,231) = b(k,231) - lu(k,3038) * b(k,303) + b(k,230) = b(k,230) - lu(k,3037) * b(k,303) + b(k,227) = b(k,227) - lu(k,3036) * b(k,303) + b(k,226) = b(k,226) - lu(k,3035) * b(k,303) + b(k,225) = b(k,225) - lu(k,3034) * b(k,303) + b(k,224) = b(k,224) - lu(k,3033) * b(k,303) + b(k,222) = b(k,222) - lu(k,3032) * b(k,303) + b(k,221) = b(k,221) - lu(k,3031) * b(k,303) + b(k,215) = b(k,215) - lu(k,3030) * b(k,303) + b(k,214) = b(k,214) - lu(k,3029) * b(k,303) + b(k,213) = b(k,213) - lu(k,3028) * b(k,303) + b(k,211) = b(k,211) - lu(k,3027) * b(k,303) + b(k,210) = b(k,210) - lu(k,3026) * b(k,303) + b(k,207) = b(k,207) - lu(k,3025) * b(k,303) + b(k,206) = b(k,206) - lu(k,3024) * b(k,303) + b(k,205) = b(k,205) - lu(k,3023) * b(k,303) + b(k,204) = b(k,204) - lu(k,3022) * b(k,303) + b(k,203) = b(k,203) - lu(k,3021) * b(k,303) + b(k,200) = b(k,200) - lu(k,3020) * b(k,303) + b(k,198) = b(k,198) - lu(k,3019) * b(k,303) + b(k,197) = b(k,197) - lu(k,3018) * b(k,303) + b(k,196) = b(k,196) - lu(k,3017) * b(k,303) + b(k,194) = b(k,194) - lu(k,3016) * b(k,303) + b(k,193) = b(k,193) - lu(k,3015) * b(k,303) + b(k,192) = b(k,192) - lu(k,3014) * b(k,303) + b(k,191) = b(k,191) - lu(k,3013) * b(k,303) + b(k,190) = b(k,190) - lu(k,3012) * b(k,303) + b(k,189) = b(k,189) - lu(k,3011) * b(k,303) + b(k,188) = b(k,188) - lu(k,3010) * b(k,303) + b(k,187) = b(k,187) - lu(k,3009) * b(k,303) + b(k,184) = b(k,184) - lu(k,3008) * b(k,303) + b(k,183) = b(k,183) - lu(k,3007) * b(k,303) + b(k,182) = b(k,182) - lu(k,3006) * b(k,303) + b(k,181) = b(k,181) - lu(k,3005) * b(k,303) + b(k,180) = b(k,180) - lu(k,3004) * b(k,303) + b(k,179) = b(k,179) - lu(k,3003) * b(k,303) + b(k,176) = b(k,176) - lu(k,3002) * b(k,303) + b(k,175) = b(k,175) - lu(k,3001) * b(k,303) + b(k,174) = b(k,174) - lu(k,3000) * b(k,303) + b(k,169) = b(k,169) - lu(k,2999) * b(k,303) + b(k,168) = b(k,168) - lu(k,2998) * b(k,303) + b(k,164) = b(k,164) - lu(k,2997) * b(k,303) + b(k,162) = b(k,162) - lu(k,2996) * b(k,303) + b(k,159) = b(k,159) - lu(k,2995) * b(k,303) + b(k,152) = b(k,152) - lu(k,2994) * b(k,303) + b(k,151) = b(k,151) - lu(k,2993) * b(k,303) + b(k,150) = b(k,150) - lu(k,2992) * b(k,303) + b(k,145) = b(k,145) - lu(k,2991) * b(k,303) + b(k,144) = b(k,144) - lu(k,2990) * b(k,303) + b(k,142) = b(k,142) - lu(k,2989) * b(k,303) + b(k,139) = b(k,139) - lu(k,2988) * b(k,303) + b(k,135) = b(k,135) - lu(k,2987) * b(k,303) + b(k,134) = b(k,134) - lu(k,2986) * b(k,303) + b(k,132) = b(k,132) - lu(k,2985) * b(k,303) + b(k,130) = b(k,130) - lu(k,2984) * b(k,303) + b(k,127) = b(k,127) - lu(k,2983) * b(k,303) + b(k,121) = b(k,121) - lu(k,2982) * b(k,303) + b(k,110) = b(k,110) - lu(k,2981) * b(k,303) + b(k,103) = b(k,103) - lu(k,2980) * b(k,303) + b(k,101) = b(k,101) - lu(k,2979) * b(k,303) + b(k,89) = b(k,89) - lu(k,2978) * b(k,303) + b(k,57) = b(k,57) - lu(k,2977) * b(k,303) + b(k,56) = b(k,56) - lu(k,2976) * b(k,303) + b(k,55) = b(k,55) - lu(k,2975) * b(k,303) + b(k,54) = b(k,54) - lu(k,2974) * b(k,303) + b(k,52) = b(k,52) - lu(k,2973) * b(k,303) + b(k,51) = b(k,51) - lu(k,2972) * b(k,303) + b(k,50) = b(k,50) - lu(k,2971) * b(k,303) + b(k,49) = b(k,49) - lu(k,2970) * b(k,303) + b(k,48) = b(k,48) - lu(k,2969) * b(k,303) + b(k,47) = b(k,47) - lu(k,2968) * b(k,303) + b(k,44) = b(k,44) - lu(k,2967) * b(k,303) + b(k,43) = b(k,43) - lu(k,2966) * b(k,303) + b(k,42) = b(k,42) - lu(k,2965) * b(k,303) + b(k,41) = b(k,41) - lu(k,2964) * b(k,303) + b(k,40) = b(k,40) - lu(k,2963) * b(k,303) + b(k,39) = b(k,39) - lu(k,2962) * b(k,303) + b(k,302) = b(k,302) * lu(k,2949) + b(k,301) = b(k,301) - lu(k,2948) * b(k,302) + b(k,279) = b(k,279) - lu(k,2947) * b(k,302) + b(k,251) = b(k,251) - lu(k,2946) * b(k,302) + b(k,217) = b(k,217) - lu(k,2945) * b(k,302) + b(k,107) = b(k,107) - lu(k,2944) * b(k,302) + b(k,301) = b(k,301) * lu(k,2931) + b(k,279) = b(k,279) - lu(k,2930) * b(k,301) + b(k,251) = b(k,251) - lu(k,2929) * b(k,301) + b(k,300) = b(k,300) * lu(k,2913) + b(k,299) = b(k,299) - lu(k,2912) * b(k,300) + b(k,298) = b(k,298) - lu(k,2911) * b(k,300) + b(k,297) = b(k,297) - lu(k,2910) * b(k,300) + b(k,296) = b(k,296) - lu(k,2909) * b(k,300) + b(k,295) = b(k,295) - lu(k,2908) * b(k,300) + b(k,294) = b(k,294) - lu(k,2907) * b(k,300) + b(k,293) = b(k,293) - lu(k,2906) * b(k,300) + b(k,292) = b(k,292) - lu(k,2905) * b(k,300) + b(k,291) = b(k,291) - lu(k,2904) * b(k,300) + b(k,290) = b(k,290) - lu(k,2903) * b(k,300) + b(k,289) = b(k,289) - lu(k,2902) * b(k,300) + b(k,288) = b(k,288) - lu(k,2901) * b(k,300) + b(k,287) = b(k,287) - lu(k,2900) * b(k,300) + b(k,286) = b(k,286) - lu(k,2899) * b(k,300) + b(k,285) = b(k,285) - lu(k,2898) * b(k,300) + b(k,284) = b(k,284) - lu(k,2897) * b(k,300) + b(k,283) = b(k,283) - lu(k,2896) * b(k,300) + b(k,282) = b(k,282) - lu(k,2895) * b(k,300) + b(k,281) = b(k,281) - lu(k,2894) * b(k,300) + b(k,280) = b(k,280) - lu(k,2893) * b(k,300) + b(k,279) = b(k,279) - lu(k,2892) * b(k,300) + b(k,278) = b(k,278) - lu(k,2891) * b(k,300) + b(k,277) = b(k,277) - lu(k,2890) * b(k,300) + b(k,275) = b(k,275) - lu(k,2889) * b(k,300) + b(k,274) = b(k,274) - lu(k,2888) * b(k,300) + b(k,273) = b(k,273) - lu(k,2887) * b(k,300) + b(k,272) = b(k,272) - lu(k,2886) * b(k,300) + b(k,271) = b(k,271) - lu(k,2885) * b(k,300) + b(k,270) = b(k,270) - lu(k,2884) * b(k,300) + b(k,269) = b(k,269) - lu(k,2883) * b(k,300) + b(k,268) = b(k,268) - lu(k,2882) * b(k,300) + b(k,267) = b(k,267) - lu(k,2881) * b(k,300) + b(k,266) = b(k,266) - lu(k,2880) * b(k,300) + b(k,265) = b(k,265) - lu(k,2879) * b(k,300) + b(k,264) = b(k,264) - lu(k,2878) * b(k,300) + b(k,263) = b(k,263) - lu(k,2877) * b(k,300) + b(k,262) = b(k,262) - lu(k,2876) * b(k,300) + b(k,261) = b(k,261) - lu(k,2875) * b(k,300) + b(k,259) = b(k,259) - lu(k,2874) * b(k,300) + b(k,258) = b(k,258) - lu(k,2873) * b(k,300) + b(k,257) = b(k,257) - lu(k,2872) * b(k,300) + b(k,256) = b(k,256) - lu(k,2871) * b(k,300) + b(k,255) = b(k,255) - lu(k,2870) * b(k,300) + b(k,254) = b(k,254) - lu(k,2869) * b(k,300) + b(k,253) = b(k,253) - lu(k,2868) * b(k,300) + b(k,252) = b(k,252) - lu(k,2867) * b(k,300) + b(k,248) = b(k,248) - lu(k,2866) * b(k,300) + b(k,247) = b(k,247) - lu(k,2865) * b(k,300) + b(k,244) = b(k,244) - lu(k,2864) * b(k,300) + b(k,243) = b(k,243) - lu(k,2863) * b(k,300) + b(k,242) = b(k,242) - lu(k,2862) * b(k,300) + b(k,240) = b(k,240) - lu(k,2861) * b(k,300) + b(k,239) = b(k,239) - lu(k,2860) * b(k,300) + b(k,233) = b(k,233) - lu(k,2859) * b(k,300) + b(k,203) = b(k,203) - lu(k,2858) * b(k,300) + b(k,173) = b(k,173) - lu(k,2857) * b(k,300) + b(k,163) = b(k,163) - lu(k,2856) * b(k,300) + b(k,147) = b(k,147) - lu(k,2855) * b(k,300) + end do + end subroutine lu_slv15 + subroutine lu_slv16( 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,299) = b(k,299) * lu(k,2840) + b(k,298) = b(k,298) - lu(k,2839) * b(k,299) + b(k,297) = b(k,297) - lu(k,2838) * b(k,299) + b(k,296) = b(k,296) - lu(k,2837) * b(k,299) + b(k,295) = b(k,295) - lu(k,2836) * b(k,299) + b(k,294) = b(k,294) - lu(k,2835) * b(k,299) + b(k,293) = b(k,293) - lu(k,2834) * b(k,299) + b(k,292) = b(k,292) - lu(k,2833) * b(k,299) + b(k,291) = b(k,291) - lu(k,2832) * b(k,299) + b(k,290) = b(k,290) - lu(k,2831) * b(k,299) + b(k,289) = b(k,289) - lu(k,2830) * b(k,299) + b(k,288) = b(k,288) - lu(k,2829) * b(k,299) + b(k,287) = b(k,287) - lu(k,2828) * b(k,299) + b(k,286) = b(k,286) - lu(k,2827) * b(k,299) + b(k,285) = b(k,285) - lu(k,2826) * b(k,299) + b(k,284) = b(k,284) - lu(k,2825) * b(k,299) + b(k,283) = b(k,283) - lu(k,2824) * b(k,299) + b(k,282) = b(k,282) - lu(k,2823) * b(k,299) + b(k,281) = b(k,281) - lu(k,2822) * b(k,299) + b(k,280) = b(k,280) - lu(k,2821) * b(k,299) + b(k,278) = b(k,278) - lu(k,2820) * b(k,299) + b(k,277) = b(k,277) - lu(k,2819) * b(k,299) + b(k,271) = b(k,271) - lu(k,2818) * b(k,299) + b(k,255) = b(k,255) - lu(k,2817) * b(k,299) + b(k,253) = b(k,253) - lu(k,2816) * b(k,299) + b(k,252) = b(k,252) - lu(k,2815) * b(k,299) + b(k,247) = b(k,247) - lu(k,2814) * b(k,299) + b(k,244) = b(k,244) - lu(k,2813) * b(k,299) + b(k,242) = b(k,242) - lu(k,2812) * b(k,299) + b(k,220) = b(k,220) - lu(k,2811) * b(k,299) + b(k,203) = b(k,203) - lu(k,2810) * b(k,299) + b(k,171) = b(k,171) - lu(k,2809) * b(k,299) + b(k,125) = b(k,125) - lu(k,2808) * b(k,299) + b(k,298) = b(k,298) * lu(k,2792) + b(k,297) = b(k,297) - lu(k,2791) * b(k,298) + b(k,296) = b(k,296) - lu(k,2790) * b(k,298) + b(k,295) = b(k,295) - lu(k,2789) * b(k,298) + b(k,294) = b(k,294) - lu(k,2788) * b(k,298) + b(k,293) = b(k,293) - lu(k,2787) * b(k,298) + b(k,292) = b(k,292) - lu(k,2786) * b(k,298) + b(k,291) = b(k,291) - lu(k,2785) * b(k,298) + b(k,290) = b(k,290) - lu(k,2784) * b(k,298) + b(k,289) = b(k,289) - lu(k,2783) * b(k,298) + b(k,288) = b(k,288) - lu(k,2782) * b(k,298) + b(k,287) = b(k,287) - lu(k,2781) * b(k,298) + b(k,286) = b(k,286) - lu(k,2780) * b(k,298) + b(k,285) = b(k,285) - lu(k,2779) * b(k,298) + b(k,284) = b(k,284) - lu(k,2778) * b(k,298) + b(k,283) = b(k,283) - lu(k,2777) * b(k,298) + b(k,282) = b(k,282) - lu(k,2776) * b(k,298) + b(k,281) = b(k,281) - lu(k,2775) * b(k,298) + b(k,280) = b(k,280) - lu(k,2774) * b(k,298) + b(k,278) = b(k,278) - lu(k,2773) * b(k,298) + b(k,277) = b(k,277) - lu(k,2772) * b(k,298) + b(k,271) = b(k,271) - lu(k,2771) * b(k,298) + b(k,255) = b(k,255) - lu(k,2770) * b(k,298) + b(k,253) = b(k,253) - lu(k,2769) * b(k,298) + b(k,252) = b(k,252) - lu(k,2768) * b(k,298) + b(k,247) = b(k,247) - lu(k,2767) * b(k,298) + b(k,244) = b(k,244) - lu(k,2766) * b(k,298) + b(k,242) = b(k,242) - lu(k,2765) * b(k,298) + b(k,203) = b(k,203) - lu(k,2764) * b(k,298) + b(k,158) = b(k,158) - lu(k,2763) * b(k,298) + b(k,116) = b(k,116) - lu(k,2762) * b(k,298) + b(k,297) = b(k,297) * lu(k,2745) + b(k,296) = b(k,296) - lu(k,2744) * b(k,297) + b(k,295) = b(k,295) - lu(k,2743) * b(k,297) + b(k,294) = b(k,294) - lu(k,2742) * b(k,297) + b(k,293) = b(k,293) - lu(k,2741) * b(k,297) + b(k,292) = b(k,292) - lu(k,2740) * b(k,297) + b(k,291) = b(k,291) - lu(k,2739) * b(k,297) + b(k,290) = b(k,290) - lu(k,2738) * b(k,297) + b(k,289) = b(k,289) - lu(k,2737) * b(k,297) + b(k,288) = b(k,288) - lu(k,2736) * b(k,297) + b(k,287) = b(k,287) - lu(k,2735) * b(k,297) + b(k,286) = b(k,286) - lu(k,2734) * b(k,297) + b(k,285) = b(k,285) - lu(k,2733) * b(k,297) + b(k,284) = b(k,284) - lu(k,2732) * b(k,297) + b(k,283) = b(k,283) - lu(k,2731) * b(k,297) + b(k,282) = b(k,282) - lu(k,2730) * b(k,297) + b(k,281) = b(k,281) - lu(k,2729) * b(k,297) + b(k,280) = b(k,280) - lu(k,2728) * b(k,297) + b(k,278) = b(k,278) - lu(k,2727) * b(k,297) + b(k,277) = b(k,277) - lu(k,2726) * b(k,297) + b(k,271) = b(k,271) - lu(k,2725) * b(k,297) + b(k,255) = b(k,255) - lu(k,2724) * b(k,297) + b(k,253) = b(k,253) - lu(k,2723) * b(k,297) + b(k,252) = b(k,252) - lu(k,2722) * b(k,297) + b(k,247) = b(k,247) - lu(k,2721) * b(k,297) + b(k,244) = b(k,244) - lu(k,2720) * b(k,297) + b(k,242) = b(k,242) - lu(k,2719) * b(k,297) + b(k,203) = b(k,203) - lu(k,2718) * b(k,297) + b(k,157) = b(k,157) - lu(k,2717) * b(k,297) + b(k,115) = b(k,115) - lu(k,2716) * b(k,297) + b(k,296) = b(k,296) * lu(k,2701) + b(k,295) = b(k,295) - lu(k,2700) * b(k,296) + b(k,294) = b(k,294) - lu(k,2699) * b(k,296) + b(k,284) = b(k,284) - lu(k,2698) * b(k,296) + b(k,280) = b(k,280) - lu(k,2697) * b(k,296) + b(k,278) = b(k,278) - lu(k,2696) * b(k,296) + b(k,271) = b(k,271) - lu(k,2695) * b(k,296) + b(k,247) = b(k,247) - lu(k,2694) * b(k,296) + b(k,242) = b(k,242) - lu(k,2693) * b(k,296) + b(k,161) = b(k,161) - lu(k,2692) * b(k,296) + b(k,295) = b(k,295) * lu(k,2677) + b(k,294) = b(k,294) - lu(k,2676) * b(k,295) + b(k,284) = b(k,284) - lu(k,2675) * b(k,295) + b(k,271) = b(k,271) - lu(k,2674) * b(k,295) + b(k,255) = b(k,255) - lu(k,2673) * b(k,295) + b(k,247) = b(k,247) - lu(k,2672) * b(k,295) + b(k,244) = b(k,244) - lu(k,2671) * b(k,295) + b(k,151) = b(k,151) - lu(k,2670) * b(k,295) + b(k,294) = b(k,294) * lu(k,2654) + b(k,284) = b(k,284) - lu(k,2653) * b(k,294) + b(k,271) = b(k,271) - lu(k,2652) * b(k,294) + b(k,247) = b(k,247) - lu(k,2651) * b(k,294) + b(k,244) = b(k,244) - lu(k,2650) * b(k,294) + b(k,238) = b(k,238) - lu(k,2649) * b(k,294) + b(k,220) = b(k,220) - lu(k,2648) * b(k,294) + b(k,161) = b(k,161) - lu(k,2647) * b(k,294) + b(k,293) = b(k,293) * lu(k,2629) + b(k,284) = b(k,284) - lu(k,2628) * b(k,293) + b(k,271) = b(k,271) - lu(k,2627) * b(k,293) + b(k,255) = b(k,255) - lu(k,2626) * b(k,293) + b(k,247) = b(k,247) - lu(k,2625) * b(k,293) + b(k,244) = b(k,244) - lu(k,2624) * b(k,293) + b(k,237) = b(k,237) - lu(k,2623) * b(k,293) + b(k,227) = b(k,227) - lu(k,2622) * b(k,293) + b(k,213) = b(k,213) - lu(k,2621) * b(k,293) + b(k,192) = b(k,192) - lu(k,2620) * b(k,293) + b(k,174) = b(k,174) - lu(k,2619) * b(k,293) + b(k,292) = b(k,292) * lu(k,2600) + b(k,284) = b(k,284) - lu(k,2599) * b(k,292) + b(k,282) = b(k,282) - lu(k,2598) * b(k,292) + b(k,271) = b(k,271) - lu(k,2597) * b(k,292) + b(k,253) = b(k,253) - lu(k,2596) * b(k,292) + b(k,252) = b(k,252) - lu(k,2595) * b(k,292) + b(k,247) = b(k,247) - lu(k,2594) * b(k,292) + b(k,237) = b(k,237) - lu(k,2593) * b(k,292) + b(k,227) = b(k,227) - lu(k,2592) * b(k,292) + b(k,213) = b(k,213) - lu(k,2591) * b(k,292) + b(k,191) = b(k,191) - lu(k,2590) * b(k,292) + b(k,291) = b(k,291) * lu(k,2570) + b(k,290) = b(k,290) - lu(k,2569) * b(k,291) + b(k,284) = b(k,284) - lu(k,2568) * b(k,291) + b(k,280) = b(k,280) - lu(k,2567) * b(k,291) + b(k,271) = b(k,271) - lu(k,2566) * b(k,291) + b(k,253) = b(k,253) - lu(k,2565) * b(k,291) + b(k,252) = b(k,252) - lu(k,2564) * b(k,291) + b(k,247) = b(k,247) - lu(k,2563) * b(k,291) + b(k,244) = b(k,244) - lu(k,2562) * b(k,291) + b(k,242) = b(k,242) - lu(k,2561) * b(k,291) + b(k,238) = b(k,238) - lu(k,2560) * b(k,291) + b(k,215) = b(k,215) - lu(k,2559) * b(k,291) + b(k,214) = b(k,214) - lu(k,2558) * b(k,291) + b(k,207) = b(k,207) - lu(k,2557) * b(k,291) + b(k,197) = b(k,197) - lu(k,2556) * b(k,291) + b(k,172) = b(k,172) - lu(k,2555) * b(k,291) + b(k,160) = b(k,160) - lu(k,2554) * b(k,291) + b(k,290) = b(k,290) * lu(k,2536) + b(k,284) = b(k,284) - lu(k,2535) * b(k,290) + b(k,271) = b(k,271) - lu(k,2534) * b(k,290) + b(k,255) = b(k,255) - lu(k,2533) * b(k,290) + b(k,247) = b(k,247) - lu(k,2532) * b(k,290) + b(k,244) = b(k,244) - lu(k,2531) * b(k,290) + b(k,242) = b(k,242) - lu(k,2530) * b(k,290) + b(k,238) = b(k,238) - lu(k,2529) * b(k,290) + b(k,215) = b(k,215) - lu(k,2528) * b(k,290) + b(k,207) = b(k,207) - lu(k,2527) * b(k,290) + b(k,203) = b(k,203) - lu(k,2526) * b(k,290) + b(k,194) = b(k,194) - lu(k,2525) * b(k,290) + b(k,289) = b(k,289) * lu(k,2505) + b(k,284) = b(k,284) - lu(k,2504) * b(k,289) + b(k,271) = b(k,271) - lu(k,2503) * b(k,289) + b(k,253) = b(k,253) - lu(k,2502) * b(k,289) + b(k,252) = b(k,252) - lu(k,2501) * b(k,289) + b(k,247) = b(k,247) - lu(k,2500) * b(k,289) + b(k,244) = b(k,244) - lu(k,2499) * b(k,289) + b(k,242) = b(k,242) - lu(k,2498) * b(k,289) + b(k,238) = b(k,238) - lu(k,2497) * b(k,289) + b(k,215) = b(k,215) - lu(k,2496) * b(k,289) + b(k,214) = b(k,214) - lu(k,2495) * b(k,289) + b(k,207) = b(k,207) - lu(k,2494) * b(k,289) + b(k,197) = b(k,197) - lu(k,2493) * b(k,289) + b(k,172) = b(k,172) - lu(k,2492) * b(k,289) + b(k,160) = b(k,160) - lu(k,2491) * b(k,289) + b(k,288) = b(k,288) * lu(k,2471) + b(k,284) = b(k,284) - lu(k,2470) * b(k,288) + b(k,282) = b(k,282) - lu(k,2469) * b(k,288) + b(k,280) = b(k,280) - lu(k,2468) * b(k,288) + b(k,271) = b(k,271) - lu(k,2467) * b(k,288) + b(k,253) = b(k,253) - lu(k,2466) * b(k,288) + b(k,252) = b(k,252) - lu(k,2465) * b(k,288) + b(k,247) = b(k,247) - lu(k,2464) * b(k,288) + b(k,244) = b(k,244) - lu(k,2463) * b(k,288) + b(k,238) = b(k,238) - lu(k,2462) * b(k,288) + b(k,196) = b(k,196) - lu(k,2461) * b(k,288) + b(k,133) = b(k,133) - lu(k,2460) * b(k,288) + b(k,287) = b(k,287) * lu(k,2441) + b(k,284) = b(k,284) - lu(k,2440) * b(k,287) + b(k,282) = b(k,282) - lu(k,2439) * b(k,287) + b(k,280) = b(k,280) - lu(k,2438) * b(k,287) + b(k,271) = b(k,271) - lu(k,2437) * b(k,287) + b(k,255) = b(k,255) - lu(k,2436) * b(k,287) + b(k,253) = b(k,253) - lu(k,2435) * b(k,287) + b(k,252) = b(k,252) - lu(k,2434) * b(k,287) + b(k,247) = b(k,247) - lu(k,2433) * b(k,287) + b(k,244) = b(k,244) - lu(k,2432) * b(k,287) + b(k,242) = b(k,242) - lu(k,2431) * b(k,287) + b(k,238) = b(k,238) - lu(k,2430) * b(k,287) + b(k,203) = b(k,203) - lu(k,2429) * b(k,287) + b(k,192) = b(k,192) - lu(k,2428) * b(k,287) + b(k,161) = b(k,161) - lu(k,2427) * b(k,287) + end do + end subroutine lu_slv16 + subroutine lu_slv17( 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,286) = b(k,286) * lu(k,2408) + b(k,284) = b(k,284) - lu(k,2407) * b(k,286) + b(k,282) = b(k,282) - lu(k,2406) * b(k,286) + b(k,271) = b(k,271) - lu(k,2405) * b(k,286) + b(k,247) = b(k,247) - lu(k,2404) * b(k,286) + b(k,244) = b(k,244) - lu(k,2403) * b(k,286) + b(k,238) = b(k,238) - lu(k,2402) * b(k,286) + b(k,196) = b(k,196) - lu(k,2401) * b(k,286) + b(k,133) = b(k,133) - lu(k,2400) * b(k,286) + b(k,44) = b(k,44) - lu(k,2399) * b(k,286) + b(k,285) = b(k,285) * lu(k,2380) + b(k,284) = b(k,284) - lu(k,2379) * b(k,285) + b(k,282) = b(k,282) - lu(k,2378) * b(k,285) + b(k,280) = b(k,280) - lu(k,2377) * b(k,285) + b(k,271) = b(k,271) - lu(k,2376) * b(k,285) + b(k,255) = b(k,255) - lu(k,2375) * b(k,285) + b(k,253) = b(k,253) - lu(k,2374) * b(k,285) + b(k,252) = b(k,252) - lu(k,2373) * b(k,285) + b(k,247) = b(k,247) - lu(k,2372) * b(k,285) + b(k,244) = b(k,244) - lu(k,2371) * b(k,285) + b(k,242) = b(k,242) - lu(k,2370) * b(k,285) + b(k,203) = b(k,203) - lu(k,2369) * b(k,285) + b(k,161) = b(k,161) - lu(k,2368) * b(k,285) + b(k,284) = b(k,284) * lu(k,2359) + b(k,271) = b(k,271) - lu(k,2358) * b(k,284) + b(k,283) = b(k,283) * lu(k,2339) + b(k,282) = b(k,282) - lu(k,2338) * b(k,283) + b(k,271) = b(k,271) - lu(k,2337) * b(k,283) + b(k,253) = b(k,253) - lu(k,2336) * b(k,283) + b(k,252) = b(k,252) - lu(k,2335) * b(k,283) + b(k,247) = b(k,247) - lu(k,2334) * b(k,283) + b(k,238) = b(k,238) - lu(k,2333) * b(k,283) + b(k,282) = b(k,282) * lu(k,2320) + b(k,271) = b(k,271) - lu(k,2319) * b(k,282) + b(k,255) = b(k,255) - lu(k,2318) * b(k,282) + b(k,244) = b(k,244) - lu(k,2317) * b(k,282) + b(k,192) = b(k,192) - lu(k,2316) * b(k,282) + b(k,190) = b(k,190) - lu(k,2315) * b(k,282) + b(k,281) = b(k,281) * lu(k,2296) + b(k,271) = b(k,271) - lu(k,2295) * b(k,281) + b(k,247) = b(k,247) - lu(k,2294) * b(k,281) + b(k,244) = b(k,244) - lu(k,2293) * b(k,281) + b(k,242) = b(k,242) - lu(k,2292) * b(k,281) + b(k,238) = b(k,238) - lu(k,2291) * b(k,281) + b(k,215) = b(k,215) - lu(k,2290) * b(k,281) + b(k,207) = b(k,207) - lu(k,2289) * b(k,281) + b(k,280) = b(k,280) * lu(k,2277) + b(k,271) = b(k,271) - lu(k,2276) * b(k,280) + b(k,266) = b(k,266) - lu(k,2275) * b(k,280) + b(k,258) = b(k,258) - lu(k,2274) * b(k,280) + b(k,238) = b(k,238) - lu(k,2273) * b(k,280) + b(k,224) = b(k,224) - lu(k,2272) * b(k,280) + b(k,279) = b(k,279) * lu(k,2259) + b(k,271) = b(k,271) - lu(k,2258) * b(k,279) + b(k,251) = b(k,251) - lu(k,2257) * b(k,279) + b(k,247) = b(k,247) - lu(k,2256) * b(k,279) + b(k,217) = b(k,217) - lu(k,2255) * b(k,279) + b(k,107) = b(k,107) - lu(k,2254) * b(k,279) + b(k,278) = b(k,278) * lu(k,2235) + b(k,271) = b(k,271) - lu(k,2234) * b(k,278) + b(k,255) = b(k,255) - lu(k,2233) * b(k,278) + b(k,247) = b(k,247) - lu(k,2232) * b(k,278) + b(k,242) = b(k,242) - lu(k,2231) * b(k,278) + b(k,151) = b(k,151) - lu(k,2230) * b(k,278) + b(k,277) = b(k,277) * lu(k,2213) + b(k,271) = b(k,271) - lu(k,2212) * b(k,277) + b(k,247) = b(k,247) - lu(k,2211) * b(k,277) + b(k,238) = b(k,238) - lu(k,2210) * b(k,277) + b(k,44) = b(k,44) - lu(k,2209) * b(k,277) + b(k,276) = b(k,276) * lu(k,2199) + b(k,271) = b(k,271) - lu(k,2198) * b(k,276) + b(k,208) = b(k,208) - lu(k,2197) * b(k,276) + b(k,275) = b(k,275) * lu(k,2180) + b(k,274) = b(k,274) - lu(k,2179) * b(k,275) + b(k,273) = b(k,273) - lu(k,2178) * b(k,275) + b(k,272) = b(k,272) - lu(k,2177) * b(k,275) + b(k,271) = b(k,271) - lu(k,2176) * b(k,275) + b(k,270) = b(k,270) - lu(k,2175) * b(k,275) + b(k,269) = b(k,269) - lu(k,2174) * b(k,275) + b(k,266) = b(k,266) - lu(k,2173) * b(k,275) + b(k,265) = b(k,265) - lu(k,2172) * b(k,275) + b(k,260) = b(k,260) - lu(k,2171) * b(k,275) + b(k,259) = b(k,259) - lu(k,2170) * b(k,275) + b(k,258) = b(k,258) - lu(k,2169) * b(k,275) + b(k,254) = b(k,254) - lu(k,2168) * b(k,275) + b(k,250) = b(k,250) - lu(k,2167) * b(k,275) + b(k,249) = b(k,249) - lu(k,2166) * b(k,275) + b(k,247) = b(k,247) - lu(k,2165) * b(k,275) + b(k,245) = b(k,245) - lu(k,2164) * b(k,275) + b(k,238) = b(k,238) - lu(k,2163) * b(k,275) + b(k,236) = b(k,236) - lu(k,2162) * b(k,275) + b(k,234) = b(k,234) - lu(k,2161) * b(k,275) + b(k,232) = b(k,232) - lu(k,2160) * b(k,275) + b(k,231) = b(k,231) - lu(k,2159) * b(k,275) + b(k,227) = b(k,227) - lu(k,2158) * b(k,275) + b(k,222) = b(k,222) - lu(k,2157) * b(k,275) + b(k,218) = b(k,218) - lu(k,2156) * b(k,275) + b(k,212) = b(k,212) - lu(k,2155) * b(k,275) + b(k,166) = b(k,166) - lu(k,2154) * b(k,275) + b(k,274) = b(k,274) * lu(k,2140) + b(k,271) = b(k,271) - lu(k,2139) * b(k,274) + b(k,266) = b(k,266) - lu(k,2138) * b(k,274) + b(k,265) = b(k,265) - lu(k,2137) * b(k,274) + b(k,263) = b(k,263) - lu(k,2136) * b(k,274) + b(k,260) = b(k,260) - lu(k,2135) * b(k,274) + b(k,259) = b(k,259) - lu(k,2134) * b(k,274) + b(k,258) = b(k,258) - lu(k,2133) * b(k,274) + b(k,254) = b(k,254) - lu(k,2132) * b(k,274) + b(k,249) = b(k,249) - lu(k,2131) * b(k,274) + b(k,247) = b(k,247) - lu(k,2130) * b(k,274) + b(k,237) = b(k,237) - lu(k,2129) * b(k,274) + b(k,236) = b(k,236) - lu(k,2128) * b(k,274) + b(k,235) = b(k,235) - lu(k,2127) * b(k,274) + b(k,232) = b(k,232) - lu(k,2126) * b(k,274) + b(k,185) = b(k,185) - lu(k,2125) * b(k,274) + b(k,273) = b(k,273) * lu(k,2110) + b(k,271) = b(k,271) - lu(k,2109) * b(k,273) + b(k,266) = b(k,266) - lu(k,2108) * b(k,273) + b(k,265) = b(k,265) - lu(k,2107) * b(k,273) + b(k,263) = b(k,263) - lu(k,2106) * b(k,273) + b(k,260) = b(k,260) - lu(k,2105) * b(k,273) + b(k,259) = b(k,259) - lu(k,2104) * b(k,273) + b(k,258) = b(k,258) - lu(k,2103) * b(k,273) + b(k,254) = b(k,254) - lu(k,2102) * b(k,273) + b(k,250) = b(k,250) - lu(k,2101) * b(k,273) + b(k,247) = b(k,247) - lu(k,2100) * b(k,273) + b(k,241) = b(k,241) - lu(k,2099) * b(k,273) + b(k,239) = b(k,239) - lu(k,2098) * b(k,273) + b(k,237) = b(k,237) - lu(k,2097) * b(k,273) + b(k,235) = b(k,235) - lu(k,2096) * b(k,273) + b(k,234) = b(k,234) - lu(k,2095) * b(k,273) + b(k,232) = b(k,232) - lu(k,2094) * b(k,273) + b(k,206) = b(k,206) - lu(k,2093) * b(k,273) + b(k,272) = b(k,272) * lu(k,2078) + b(k,271) = b(k,271) - lu(k,2077) * b(k,272) + b(k,266) = b(k,266) - lu(k,2076) * b(k,272) + b(k,265) = b(k,265) - lu(k,2075) * b(k,272) + b(k,263) = b(k,263) - lu(k,2074) * b(k,272) + b(k,260) = b(k,260) - lu(k,2073) * b(k,272) + b(k,259) = b(k,259) - lu(k,2072) * b(k,272) + b(k,258) = b(k,258) - lu(k,2071) * b(k,272) + b(k,254) = b(k,254) - lu(k,2070) * b(k,272) + b(k,250) = b(k,250) - lu(k,2069) * b(k,272) + b(k,247) = b(k,247) - lu(k,2068) * b(k,272) + b(k,241) = b(k,241) - lu(k,2067) * b(k,272) + b(k,237) = b(k,237) - lu(k,2066) * b(k,272) + b(k,236) = b(k,236) - lu(k,2065) * b(k,272) + b(k,235) = b(k,235) - lu(k,2064) * b(k,272) + b(k,234) = b(k,234) - lu(k,2063) * b(k,272) + b(k,233) = b(k,233) - lu(k,2062) * b(k,272) + b(k,205) = b(k,205) - lu(k,2061) * b(k,272) + b(k,271) = b(k,271) * lu(k,2057) + b(k,247) = b(k,247) - lu(k,2056) * b(k,271) + b(k,270) = b(k,270) * lu(k,2041) + b(k,266) = b(k,266) - lu(k,2040) * b(k,270) + b(k,265) = b(k,265) - lu(k,2039) * b(k,270) + b(k,258) = b(k,258) - lu(k,2038) * b(k,270) + b(k,254) = b(k,254) - lu(k,2037) * b(k,270) + b(k,247) = b(k,247) - lu(k,2036) * b(k,270) + b(k,240) = b(k,240) - lu(k,2035) * b(k,270) + b(k,236) = b(k,236) - lu(k,2034) * b(k,270) + b(k,230) = b(k,230) - lu(k,2033) * b(k,270) + b(k,228) = b(k,228) - lu(k,2032) * b(k,270) + b(k,227) = b(k,227) - lu(k,2031) * b(k,270) + b(k,269) = b(k,269) * lu(k,2016) + b(k,266) = b(k,266) - lu(k,2015) * b(k,269) + b(k,259) = b(k,259) - lu(k,2014) * b(k,269) + b(k,258) = b(k,258) - lu(k,2013) * b(k,269) + b(k,248) = b(k,248) - lu(k,2012) * b(k,269) + b(k,247) = b(k,247) - lu(k,2011) * b(k,269) + b(k,243) = b(k,243) - lu(k,2010) * b(k,269) + b(k,227) = b(k,227) - lu(k,2009) * b(k,269) + b(k,268) = b(k,268) * lu(k,1991) + b(k,267) = b(k,267) - lu(k,1990) * b(k,268) + b(k,266) = b(k,266) - lu(k,1989) * b(k,268) + b(k,265) = b(k,265) - lu(k,1988) * b(k,268) + b(k,264) = b(k,264) - lu(k,1987) * b(k,268) + b(k,263) = b(k,263) - lu(k,1986) * b(k,268) + b(k,261) = b(k,261) - lu(k,1985) * b(k,268) + b(k,260) = b(k,260) - lu(k,1984) * b(k,268) + b(k,259) = b(k,259) - lu(k,1983) * b(k,268) + b(k,258) = b(k,258) - lu(k,1982) * b(k,268) + b(k,257) = b(k,257) - lu(k,1981) * b(k,268) + b(k,254) = b(k,254) - lu(k,1980) * b(k,268) + b(k,250) = b(k,250) - lu(k,1979) * b(k,268) + b(k,247) = b(k,247) - lu(k,1978) * b(k,268) + b(k,241) = b(k,241) - lu(k,1977) * b(k,268) + b(k,238) = b(k,238) - lu(k,1976) * b(k,268) + b(k,234) = b(k,234) - lu(k,1975) * b(k,268) + b(k,200) = b(k,200) - lu(k,1974) * b(k,268) + b(k,186) = b(k,186) - lu(k,1973) * b(k,268) + b(k,150) = b(k,150) - lu(k,1972) * b(k,268) + b(k,97) = b(k,97) - lu(k,1971) * b(k,268) + b(k,96) = b(k,96) - lu(k,1970) * b(k,268) + b(k,267) = b(k,267) * lu(k,1953) + b(k,266) = b(k,266) - lu(k,1952) * b(k,267) + b(k,265) = b(k,265) - lu(k,1951) * b(k,267) + b(k,264) = b(k,264) - lu(k,1950) * b(k,267) + b(k,263) = b(k,263) - lu(k,1949) * b(k,267) + b(k,262) = b(k,262) - lu(k,1948) * b(k,267) + b(k,260) = b(k,260) - lu(k,1947) * b(k,267) + b(k,259) = b(k,259) - lu(k,1946) * b(k,267) + b(k,258) = b(k,258) - lu(k,1945) * b(k,267) + b(k,256) = b(k,256) - lu(k,1944) * b(k,267) + b(k,254) = b(k,254) - lu(k,1943) * b(k,267) + b(k,250) = b(k,250) - lu(k,1942) * b(k,267) + b(k,247) = b(k,247) - lu(k,1941) * b(k,267) + b(k,241) = b(k,241) - lu(k,1940) * b(k,267) + b(k,234) = b(k,234) - lu(k,1939) * b(k,267) + b(k,210) = b(k,210) - lu(k,1938) * b(k,267) + b(k,186) = b(k,186) - lu(k,1937) * b(k,267) + b(k,159) = b(k,159) - lu(k,1936) * b(k,267) + b(k,95) = b(k,95) - lu(k,1935) * b(k,267) + b(k,94) = b(k,94) - lu(k,1934) * b(k,267) + end do + end subroutine lu_slv17 + subroutine lu_slv18( 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,266) = b(k,266) * lu(k,1926) + b(k,265) = b(k,265) * lu(k,1916) + b(k,254) = b(k,254) - lu(k,1915) * b(k,265) + b(k,247) = b(k,247) - lu(k,1914) * b(k,265) + b(k,236) = b(k,236) - lu(k,1913) * b(k,265) + b(k,232) = b(k,232) - lu(k,1912) * b(k,265) + b(k,82) = b(k,82) - lu(k,1911) * b(k,265) + b(k,264) = b(k,264) * lu(k,1896) + b(k,263) = b(k,263) - lu(k,1895) * b(k,264) + b(k,260) = b(k,260) - lu(k,1894) * b(k,264) + b(k,258) = b(k,258) - lu(k,1893) * b(k,264) + b(k,254) = b(k,254) - lu(k,1892) * b(k,264) + b(k,247) = b(k,247) - lu(k,1891) * b(k,264) + b(k,241) = b(k,241) - lu(k,1890) * b(k,264) + b(k,239) = b(k,239) - lu(k,1889) * b(k,264) + b(k,235) = b(k,235) - lu(k,1888) * b(k,264) + b(k,233) = b(k,233) - lu(k,1887) * b(k,264) + b(k,185) = b(k,185) - lu(k,1886) * b(k,264) + b(k,170) = b(k,170) - lu(k,1885) * b(k,264) + b(k,140) = b(k,140) - lu(k,1884) * b(k,264) + b(k,136) = b(k,136) - lu(k,1883) * b(k,264) + b(k,263) = b(k,263) * lu(k,1872) + b(k,260) = b(k,260) - lu(k,1871) * b(k,263) + b(k,258) = b(k,258) - lu(k,1870) * b(k,263) + b(k,254) = b(k,254) - lu(k,1869) * b(k,263) + b(k,247) = b(k,247) - lu(k,1868) * b(k,263) + b(k,235) = b(k,235) - lu(k,1867) * b(k,263) + b(k,221) = b(k,221) - lu(k,1866) * b(k,263) + b(k,262) = b(k,262) * lu(k,1848) + b(k,258) = b(k,258) - lu(k,1847) * b(k,262) + b(k,254) = b(k,254) - lu(k,1846) * b(k,262) + b(k,247) = b(k,247) - lu(k,1845) * b(k,262) + b(k,240) = b(k,240) - lu(k,1844) * b(k,262) + b(k,239) = b(k,239) - lu(k,1843) * b(k,262) + b(k,238) = b(k,238) - lu(k,1842) * b(k,262) + b(k,227) = b(k,227) - lu(k,1841) * b(k,262) + b(k,187) = b(k,187) - lu(k,1840) * b(k,262) + b(k,186) = b(k,186) - lu(k,1839) * b(k,262) + b(k,185) = b(k,185) - lu(k,1838) * b(k,262) + b(k,155) = b(k,155) - lu(k,1837) * b(k,262) + b(k,153) = b(k,153) - lu(k,1836) * b(k,262) + b(k,136) = b(k,136) - lu(k,1835) * b(k,262) + b(k,94) = b(k,94) - lu(k,1834) * b(k,262) + b(k,261) = b(k,261) * lu(k,1817) + b(k,259) = b(k,259) - lu(k,1816) * b(k,261) + b(k,258) = b(k,258) - lu(k,1815) * b(k,261) + b(k,254) = b(k,254) - lu(k,1814) * b(k,261) + b(k,247) = b(k,247) - lu(k,1813) * b(k,261) + b(k,243) = b(k,243) - lu(k,1812) * b(k,261) + b(k,238) = b(k,238) - lu(k,1811) * b(k,261) + b(k,233) = b(k,233) - lu(k,1810) * b(k,261) + b(k,187) = b(k,187) - lu(k,1809) * b(k,261) + b(k,186) = b(k,186) - lu(k,1808) * b(k,261) + b(k,185) = b(k,185) - lu(k,1807) * b(k,261) + b(k,155) = b(k,155) - lu(k,1806) * b(k,261) + b(k,154) = b(k,154) - lu(k,1805) * b(k,261) + b(k,140) = b(k,140) - lu(k,1804) * b(k,261) + b(k,96) = b(k,96) - lu(k,1803) * b(k,261) + b(k,260) = b(k,260) * lu(k,1793) + b(k,259) = b(k,259) - lu(k,1792) * b(k,260) + b(k,258) = b(k,258) - lu(k,1791) * b(k,260) + b(k,254) = b(k,254) - lu(k,1790) * b(k,260) + b(k,247) = b(k,247) - lu(k,1789) * b(k,260) + b(k,239) = b(k,239) - lu(k,1788) * b(k,260) + b(k,235) = b(k,235) - lu(k,1787) * b(k,260) + b(k,233) = b(k,233) - lu(k,1786) * b(k,260) + b(k,259) = b(k,259) * lu(k,1778) + b(k,258) = b(k,258) - lu(k,1777) * b(k,259) + b(k,236) = b(k,236) - lu(k,1776) * b(k,259) + b(k,258) = b(k,258) * lu(k,1770) + b(k,257) = b(k,257) * lu(k,1754) + b(k,254) = b(k,254) - lu(k,1753) * b(k,257) + b(k,247) = b(k,247) - lu(k,1752) * b(k,257) + b(k,238) = b(k,238) - lu(k,1751) * b(k,257) + b(k,233) = b(k,233) - lu(k,1750) * b(k,257) + b(k,186) = b(k,186) - lu(k,1749) * b(k,257) + b(k,97) = b(k,97) - lu(k,1748) * b(k,257) + b(k,256) = b(k,256) * lu(k,1732) + b(k,254) = b(k,254) - lu(k,1731) * b(k,256) + b(k,247) = b(k,247) - lu(k,1730) * b(k,256) + b(k,239) = b(k,239) - lu(k,1729) * b(k,256) + b(k,238) = b(k,238) - lu(k,1728) * b(k,256) + b(k,186) = b(k,186) - lu(k,1727) * b(k,256) + b(k,95) = b(k,95) - lu(k,1726) * b(k,256) + b(k,255) = b(k,255) * lu(k,1718) + b(k,254) = b(k,254) * lu(k,1712) + b(k,247) = b(k,247) - lu(k,1711) * b(k,254) + b(k,235) = b(k,235) - lu(k,1710) * b(k,254) + b(k,253) = b(k,253) * lu(k,1702) + b(k,244) = b(k,244) - lu(k,1701) * b(k,253) + b(k,242) = b(k,242) - lu(k,1700) * b(k,253) + b(k,215) = b(k,215) - lu(k,1699) * b(k,253) + b(k,192) = b(k,192) - lu(k,1698) * b(k,253) + b(k,176) = b(k,176) - lu(k,1697) * b(k,253) + b(k,252) = b(k,252) * lu(k,1689) + b(k,244) = b(k,244) - lu(k,1688) * b(k,252) + b(k,215) = b(k,215) - lu(k,1687) * b(k,252) + b(k,192) = b(k,192) - lu(k,1686) * b(k,252) + b(k,175) = b(k,175) - lu(k,1685) * b(k,252) + b(k,251) = b(k,251) * lu(k,1673) + b(k,217) = b(k,217) - lu(k,1672) * b(k,251) + b(k,107) = b(k,107) - lu(k,1671) * b(k,251) + b(k,250) = b(k,250) * lu(k,1659) + b(k,247) = b(k,247) - lu(k,1658) * b(k,250) + b(k,235) = b(k,235) - lu(k,1657) * b(k,250) + b(k,204) = b(k,204) - lu(k,1656) * b(k,250) + b(k,249) = b(k,249) * lu(k,1640) + b(k,247) = b(k,247) - lu(k,1639) * b(k,249) + b(k,236) = b(k,236) - lu(k,1638) * b(k,249) + b(k,235) = b(k,235) - lu(k,1637) * b(k,249) + b(k,234) = b(k,234) - lu(k,1636) * b(k,249) + b(k,232) = b(k,232) - lu(k,1635) * b(k,249) + b(k,204) = b(k,204) - lu(k,1634) * b(k,249) + b(k,248) = b(k,248) * lu(k,1620) + b(k,247) = b(k,247) - lu(k,1619) * b(k,248) + b(k,173) = b(k,173) - lu(k,1618) * b(k,248) + b(k,163) = b(k,163) - lu(k,1617) * b(k,248) + b(k,141) = b(k,141) - lu(k,1616) * b(k,248) + b(k,247) = b(k,247) * lu(k,1613) + b(k,246) = b(k,246) * lu(k,1600) + b(k,216) = b(k,216) - lu(k,1599) * b(k,246) + b(k,143) = b(k,143) - lu(k,1598) * b(k,246) + b(k,111) = b(k,111) - lu(k,1597) * b(k,246) + b(k,245) = b(k,245) * lu(k,1572) + b(k,241) = b(k,241) - lu(k,1571) * b(k,245) + b(k,237) = b(k,237) - lu(k,1570) * b(k,245) + b(k,236) = b(k,236) - lu(k,1569) * b(k,245) + b(k,235) = b(k,235) - lu(k,1568) * b(k,245) + b(k,234) = b(k,234) - lu(k,1567) * b(k,245) + b(k,232) = b(k,232) - lu(k,1566) * b(k,245) + b(k,226) = b(k,226) - lu(k,1565) * b(k,245) + b(k,218) = b(k,218) - lu(k,1564) * b(k,245) + b(k,187) = b(k,187) - lu(k,1563) * b(k,245) + b(k,182) = b(k,182) - lu(k,1562) * b(k,245) + b(k,244) = b(k,244) * lu(k,1557) + b(k,243) = b(k,243) * lu(k,1543) + b(k,233) = b(k,233) - lu(k,1542) * b(k,243) + b(k,242) = b(k,242) * lu(k,1536) + b(k,241) = b(k,241) * lu(k,1524) + b(k,235) = b(k,235) - lu(k,1523) * b(k,241) + b(k,221) = b(k,221) - lu(k,1522) * b(k,241) + b(k,185) = b(k,185) - lu(k,1521) * b(k,241) + b(k,240) = b(k,240) * lu(k,1508) + b(k,239) = b(k,239) - lu(k,1507) * b(k,240) + b(k,238) = b(k,238) - lu(k,1506) * b(k,240) + b(k,239) = b(k,239) * lu(k,1498) + b(k,238) = b(k,238) * lu(k,1494) + b(k,237) = b(k,237) * lu(k,1487) + b(k,236) = b(k,236) * lu(k,1481) + b(k,235) = b(k,235) * lu(k,1476) + b(k,39) = b(k,39) - lu(k,1475) * b(k,235) + b(k,234) = b(k,234) * lu(k,1468) + b(k,233) = b(k,233) * lu(k,1461) + b(k,232) = b(k,232) * lu(k,1454) + b(k,231) = b(k,231) * lu(k,1440) + b(k,230) = b(k,230) * lu(k,1431) + b(k,229) = b(k,229) * lu(k,1410) + b(k,227) = b(k,227) - lu(k,1409) * b(k,229) + b(k,213) = b(k,213) - lu(k,1408) * b(k,229) + b(k,97) = b(k,97) - lu(k,1407) * b(k,229) + b(k,96) = b(k,96) - lu(k,1406) * b(k,229) + b(k,95) = b(k,95) - lu(k,1405) * b(k,229) + b(k,94) = b(k,94) - lu(k,1404) * b(k,229) + b(k,51) = b(k,51) - lu(k,1403) * b(k,229) + b(k,43) = b(k,43) - lu(k,1402) * b(k,229) + b(k,42) = b(k,42) - lu(k,1401) * b(k,229) + b(k,228) = b(k,228) * lu(k,1385) + b(k,227) = b(k,227) - lu(k,1384) * b(k,228) + b(k,189) = b(k,189) - lu(k,1383) * b(k,228) + b(k,173) = b(k,173) - lu(k,1382) * b(k,228) + b(k,227) = b(k,227) * lu(k,1377) + b(k,226) = b(k,226) * lu(k,1361) + b(k,187) = b(k,187) - lu(k,1360) * b(k,226) + b(k,182) = b(k,182) - lu(k,1359) * b(k,226) + b(k,225) = b(k,225) * lu(k,1350) + b(k,114) = b(k,114) - lu(k,1349) * b(k,225) + b(k,99) = b(k,99) - lu(k,1348) * b(k,225) + b(k,224) = b(k,224) * lu(k,1336) + b(k,122) = b(k,122) - lu(k,1335) * b(k,224) + b(k,223) = b(k,223) * lu(k,1325) + b(k,209) = b(k,209) - lu(k,1324) * b(k,223) + b(k,75) = b(k,75) - lu(k,1323) * b(k,223) + b(k,222) = b(k,222) * lu(k,1309) + b(k,221) = b(k,221) * lu(k,1298) + b(k,170) = b(k,170) - lu(k,1297) * b(k,221) + b(k,220) = b(k,220) * lu(k,1289) + b(k,219) = b(k,219) * lu(k,1272) + b(k,171) = b(k,171) - lu(k,1271) * b(k,219) + b(k,47) = b(k,47) - lu(k,1270) * b(k,219) + b(k,43) = b(k,43) - lu(k,1269) * b(k,219) + b(k,42) = b(k,42) - lu(k,1268) * b(k,219) + b(k,41) = b(k,41) - lu(k,1267) * b(k,219) + b(k,40) = b(k,40) - lu(k,1266) * b(k,219) + b(k,39) = b(k,39) - lu(k,1265) * b(k,219) + b(k,218) = b(k,218) * lu(k,1252) + b(k,185) = b(k,185) - lu(k,1251) * b(k,218) + b(k,217) = b(k,217) * lu(k,1242) + b(k,107) = b(k,107) - lu(k,1241) * b(k,217) + b(k,216) = b(k,216) * lu(k,1235) + b(k,98) = b(k,98) - lu(k,1234) * b(k,216) + b(k,215) = b(k,215) * lu(k,1228) + end do + end subroutine lu_slv18 + subroutine lu_slv19( 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,214) = b(k,214) * lu(k,1218) + b(k,194) = b(k,194) - lu(k,1217) * b(k,214) + b(k,192) = b(k,192) - lu(k,1216) * b(k,214) + b(k,213) = b(k,213) * lu(k,1210) + b(k,212) = b(k,212) * lu(k,1194) + b(k,185) = b(k,185) - lu(k,1193) * b(k,212) + b(k,138) = b(k,138) - lu(k,1192) * b(k,212) + b(k,211) = b(k,211) * lu(k,1182) + b(k,169) = b(k,169) - lu(k,1181) * b(k,211) + b(k,168) = b(k,168) - lu(k,1180) * b(k,211) + b(k,165) = b(k,165) - lu(k,1179) * b(k,211) + b(k,145) = b(k,145) - lu(k,1178) * b(k,211) + b(k,210) = b(k,210) * lu(k,1166) + b(k,209) = b(k,209) * lu(k,1159) + b(k,75) = b(k,75) - lu(k,1158) * b(k,209) + b(k,208) = b(k,208) * lu(k,1150) + b(k,207) = b(k,207) * lu(k,1143) + b(k,206) = b(k,206) * lu(k,1132) + b(k,205) = b(k,205) * lu(k,1121) + b(k,204) = b(k,204) * lu(k,1110) + b(k,203) = b(k,203) * lu(k,1106) + b(k,202) = b(k,202) * lu(k,1092) + b(k,81) = b(k,81) - lu(k,1091) * b(k,202) + b(k,50) = b(k,50) - lu(k,1090) * b(k,202) + b(k,43) = b(k,43) - lu(k,1089) * b(k,202) + b(k,42) = b(k,42) - lu(k,1088) * b(k,202) + b(k,41) = b(k,41) - lu(k,1087) * b(k,202) + b(k,40) = b(k,40) - lu(k,1086) * b(k,202) + b(k,39) = b(k,39) - lu(k,1085) * b(k,202) + b(k,201) = b(k,201) * lu(k,1071) + b(k,171) = b(k,171) - lu(k,1070) * b(k,201) + b(k,54) = b(k,54) - lu(k,1069) * b(k,201) + b(k,43) = b(k,43) - lu(k,1068) * b(k,201) + b(k,42) = b(k,42) - lu(k,1067) * b(k,201) + b(k,41) = b(k,41) - lu(k,1066) * b(k,201) + b(k,40) = b(k,40) - lu(k,1065) * b(k,201) + b(k,39) = b(k,39) - lu(k,1064) * b(k,201) + b(k,200) = b(k,200) * lu(k,1054) + b(k,199) = b(k,199) * lu(k,1041) + b(k,171) = b(k,171) - lu(k,1040) * b(k,199) + b(k,48) = b(k,48) - lu(k,1039) * b(k,199) + b(k,43) = b(k,43) - lu(k,1038) * b(k,199) + b(k,42) = b(k,42) - lu(k,1037) * b(k,199) + b(k,41) = b(k,41) - lu(k,1036) * b(k,199) + b(k,40) = b(k,40) - lu(k,1035) * b(k,199) + b(k,39) = b(k,39) - lu(k,1034) * b(k,199) + b(k,198) = b(k,198) * lu(k,1024) + b(k,123) = b(k,123) - lu(k,1023) * b(k,198) + b(k,197) = b(k,197) * lu(k,1015) + b(k,192) = b(k,192) - lu(k,1014) * b(k,197) + b(k,196) = b(k,196) * lu(k,1006) + b(k,192) = b(k,192) - lu(k,1005) * b(k,196) + b(k,161) = b(k,161) - lu(k,1004) * b(k,196) + b(k,117) = b(k,117) - lu(k,1003) * b(k,196) + b(k,195) = b(k,195) * lu(k,995) + b(k,88) = b(k,88) - lu(k,994) * b(k,195) + b(k,194) = b(k,194) * lu(k,986) + b(k,193) = b(k,193) * lu(k,974) + b(k,82) = b(k,82) - lu(k,973) * b(k,193) + b(k,192) = b(k,192) * lu(k,969) + b(k,191) = b(k,191) * lu(k,960) + b(k,190) = b(k,190) * lu(k,951) + b(k,161) = b(k,161) - lu(k,950) * b(k,190) + b(k,151) = b(k,151) - lu(k,949) * b(k,190) + b(k,117) = b(k,117) - lu(k,948) * b(k,190) + b(k,189) = b(k,189) * lu(k,939) + b(k,148) = b(k,148) - lu(k,938) * b(k,189) + b(k,188) = b(k,188) * lu(k,929) + b(k,187) = b(k,187) * lu(k,924) + b(k,186) = b(k,186) * lu(k,919) + b(k,185) = b(k,185) * lu(k,914) + b(k,184) = b(k,184) * lu(k,906) + b(k,183) = b(k,183) * lu(k,895) + b(k,180) = b(k,180) - lu(k,894) * b(k,183) + b(k,178) = b(k,178) - lu(k,893) * b(k,183) + b(k,132) = b(k,132) - lu(k,892) * b(k,183) + b(k,121) = b(k,121) - lu(k,891) * b(k,183) + b(k,110) = b(k,110) - lu(k,890) * b(k,183) + b(k,103) = b(k,103) - lu(k,889) * b(k,183) + b(k,182) = b(k,182) * lu(k,883) + b(k,181) = b(k,181) * lu(k,873) + b(k,180) = b(k,180) - lu(k,872) * b(k,181) + b(k,167) = b(k,167) - lu(k,871) * b(k,181) + b(k,132) = b(k,132) - lu(k,870) * b(k,181) + b(k,121) = b(k,121) - lu(k,869) * b(k,181) + b(k,103) = b(k,103) - lu(k,868) * b(k,181) + b(k,180) = b(k,180) * lu(k,862) + b(k,179) = b(k,179) * lu(k,855) + b(k,101) = b(k,101) - lu(k,854) * b(k,179) + b(k,68) = b(k,68) - lu(k,853) * b(k,179) + b(k,178) = b(k,178) * lu(k,842) + b(k,132) = b(k,132) - lu(k,841) * b(k,178) + b(k,121) = b(k,121) - lu(k,840) * b(k,178) + b(k,110) = b(k,110) - lu(k,839) * b(k,178) + b(k,103) = b(k,103) - lu(k,838) * b(k,178) + b(k,177) = b(k,177) * lu(k,827) + b(k,55) = b(k,55) - lu(k,826) * b(k,177) + b(k,43) = b(k,43) - lu(k,825) * b(k,177) + b(k,42) = b(k,42) - lu(k,824) * b(k,177) + b(k,41) = b(k,41) - lu(k,823) * b(k,177) + b(k,40) = b(k,40) - lu(k,822) * b(k,177) + b(k,39) = b(k,39) - lu(k,821) * b(k,177) + b(k,176) = b(k,176) * lu(k,813) + b(k,175) = b(k,175) * lu(k,805) + b(k,174) = b(k,174) * lu(k,797) + b(k,151) = b(k,151) - lu(k,796) * b(k,174) + b(k,173) = b(k,173) * lu(k,791) + b(k,172) = b(k,172) * lu(k,783) + b(k,171) = b(k,171) * lu(k,778) + b(k,170) = b(k,170) * lu(k,770) + b(k,169) = b(k,169) * lu(k,763) + b(k,109) = b(k,109) - lu(k,762) * b(k,169) + b(k,168) = b(k,168) * lu(k,752) + b(k,145) = b(k,145) - lu(k,751) * b(k,168) + b(k,167) = b(k,167) * lu(k,741) + b(k,132) = b(k,132) - lu(k,740) * b(k,167) + b(k,121) = b(k,121) - lu(k,739) * b(k,167) + b(k,103) = b(k,103) - lu(k,738) * b(k,167) + b(k,166) = b(k,166) * lu(k,728) + b(k,165) = b(k,165) * lu(k,718) + b(k,145) = b(k,145) - lu(k,717) * b(k,165) + b(k,164) = b(k,164) * lu(k,711) + b(k,135) = b(k,135) - lu(k,710) * b(k,164) + b(k,100) = b(k,100) - lu(k,709) * b(k,164) + b(k,163) = b(k,163) * lu(k,702) + b(k,162) = b(k,162) * lu(k,693) + b(k,161) = b(k,161) * lu(k,689) + b(k,160) = b(k,160) * lu(k,682) + b(k,159) = b(k,159) * lu(k,673) + b(k,158) = b(k,158) * lu(k,664) + b(k,157) = b(k,157) * lu(k,655) + b(k,156) = b(k,156) * lu(k,646) + b(k,155) = b(k,155) * lu(k,639) + b(k,154) = b(k,154) * lu(k,626) + b(k,153) = b(k,153) * lu(k,613) + b(k,152) = b(k,152) * lu(k,605) + b(k,151) = b(k,151) * lu(k,601) + b(k,150) = b(k,150) * lu(k,593) + b(k,149) = b(k,149) * lu(k,585) + b(k,148) = b(k,148) * lu(k,577) + b(k,147) = b(k,147) * lu(k,569) + b(k,146) = b(k,146) * lu(k,561) + b(k,145) = b(k,145) * lu(k,556) + b(k,144) = b(k,144) * lu(k,550) + b(k,70) = b(k,70) - lu(k,549) * b(k,144) + b(k,143) = b(k,143) * lu(k,543) + b(k,142) = b(k,142) * lu(k,536) + b(k,126) = b(k,126) - lu(k,535) * b(k,142) + b(k,141) = b(k,141) * lu(k,528) + b(k,140) = b(k,140) * lu(k,521) + b(k,139) = b(k,139) * lu(k,514) + b(k,132) = b(k,132) - lu(k,513) * b(k,139) + b(k,124) = b(k,124) - lu(k,512) * b(k,139) + b(k,138) = b(k,138) * lu(k,502) + b(k,137) = b(k,137) * lu(k,495) + b(k,136) = b(k,136) * lu(k,488) + b(k,135) = b(k,135) * lu(k,484) + b(k,134) = b(k,134) * lu(k,477) + b(k,80) = b(k,80) - lu(k,476) * b(k,134) + b(k,133) = b(k,133) * lu(k,471) + b(k,132) = b(k,132) * lu(k,468) + b(k,131) = b(k,131) * lu(k,462) + b(k,130) = b(k,130) * lu(k,456) + b(k,112) = b(k,112) - lu(k,455) * b(k,130) + b(k,129) = b(k,129) * lu(k,449) + b(k,128) = b(k,128) * lu(k,443) + b(k,127) = b(k,127) * lu(k,437) + b(k,113) = b(k,113) - lu(k,436) * b(k,127) + b(k,89) = b(k,89) - lu(k,435) * b(k,127) + b(k,126) = b(k,126) * lu(k,429) + b(k,125) = b(k,125) * lu(k,423) + b(k,124) = b(k,124) * lu(k,417) + b(k,123) = b(k,123) * lu(k,411) + b(k,122) = b(k,122) * lu(k,405) + b(k,121) = b(k,121) * lu(k,401) + b(k,120) = b(k,120) * lu(k,393) + b(k,119) = b(k,119) * lu(k,385) + b(k,118) = b(k,118) * lu(k,377) + b(k,117) = b(k,117) * lu(k,373) + b(k,116) = b(k,116) * lu(k,368) + b(k,115) = b(k,115) * lu(k,363) + b(k,114) = b(k,114) * lu(k,358) + b(k,113) = b(k,113) * lu(k,353) + b(k,89) = b(k,89) - lu(k,352) * b(k,113) + b(k,112) = b(k,112) * lu(k,347) + b(k,111) = b(k,111) * lu(k,342) + b(k,110) = b(k,110) * lu(k,337) + b(k,109) = b(k,109) * lu(k,332) + b(k,108) = b(k,108) * lu(k,326) + b(k,90) = b(k,90) - lu(k,325) * b(k,108) + b(k,107) = b(k,107) * lu(k,322) + b(k,106) = b(k,106) * lu(k,316) + b(k,105) = b(k,105) * lu(k,310) + b(k,104) = b(k,104) * lu(k,304) + b(k,103) = b(k,103) * lu(k,301) + b(k,102) = b(k,102) * lu(k,295) + b(k,101) = b(k,101) * lu(k,291) + b(k,100) = b(k,100) * lu(k,287) + b(k,99) = b(k,99) * lu(k,283) + b(k,98) = b(k,98) * lu(k,279) + b(k,69) = b(k,69) - lu(k,278) * b(k,98) + end do + end subroutine lu_slv19 + subroutine lu_slv20( 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,97) = b(k,97) * lu(k,275) + b(k,96) = b(k,96) * lu(k,272) + b(k,95) = b(k,95) * lu(k,269) + b(k,94) = b(k,94) * lu(k,266) + b(k,93) = b(k,93) * lu(k,261) + b(k,90) = b(k,90) - lu(k,260) * b(k,93) + b(k,92) = b(k,92) * lu(k,256) + b(k,91) = b(k,91) * lu(k,251) + b(k,90) = b(k,90) * lu(k,248) + b(k,89) = b(k,89) * lu(k,245) + b(k,88) = b(k,88) * lu(k,242) + b(k,87) = b(k,87) * lu(k,237) + b(k,86) = b(k,86) * lu(k,229) + b(k,85) = b(k,85) - lu(k,228) * b(k,86) + b(k,57) = b(k,57) - lu(k,227) * b(k,86) + b(k,85) = b(k,85) * lu(k,223) + b(k,84) = b(k,84) * lu(k,218) + b(k,83) = b(k,83) * lu(k,211) + b(k,56) = b(k,56) - lu(k,210) * b(k,83) + b(k,82) = b(k,82) * lu(k,207) + b(k,81) = b(k,81) * lu(k,204) + b(k,80) = b(k,80) * lu(k,201) + b(k,79) = b(k,79) * lu(k,197) + b(k,78) = b(k,78) * lu(k,192) + b(k,77) = b(k,77) * lu(k,188) + b(k,76) = b(k,76) * lu(k,182) + b(k,49) = b(k,49) - lu(k,181) * b(k,76) + b(k,75) = b(k,75) * lu(k,179) + b(k,74) = b(k,74) * lu(k,174) + b(k,73) = b(k,73) * lu(k,169) + b(k,72) = b(k,72) * lu(k,164) + b(k,71) = b(k,71) * lu(k,159) + b(k,70) = b(k,70) * lu(k,156) + b(k,69) = b(k,69) * lu(k,153) + b(k,68) = b(k,68) * lu(k,150) + b(k,67) = b(k,67) * lu(k,146) + b(k,66) = b(k,66) * lu(k,142) + b(k,65) = b(k,65) * lu(k,138) + b(k,64) = b(k,64) * lu(k,134) + b(k,63) = b(k,63) * lu(k,130) + b(k,62) = b(k,62) * lu(k,126) + b(k,61) = b(k,61) * lu(k,123) + b(k,60) = b(k,60) * lu(k,120) + b(k,59) = b(k,59) * lu(k,117) + b(k,58) = b(k,58) * lu(k,114) + b(k,57) = b(k,57) * lu(k,113) + b(k,43) = b(k,43) - lu(k,112) * b(k,57) + b(k,42) = b(k,42) - lu(k,111) * b(k,57) + b(k,41) = b(k,41) - lu(k,110) * b(k,57) + b(k,40) = b(k,40) - lu(k,109) * b(k,57) + b(k,39) = b(k,39) - lu(k,108) * b(k,57) + b(k,56) = b(k,56) * lu(k,107) + b(k,43) = b(k,43) - lu(k,106) * b(k,56) + b(k,42) = b(k,42) - lu(k,105) * b(k,56) + b(k,41) = b(k,41) - lu(k,104) * b(k,56) + b(k,40) = b(k,40) - lu(k,103) * b(k,56) + b(k,39) = b(k,39) - lu(k,102) * b(k,56) + b(k,55) = b(k,55) * lu(k,101) + b(k,43) = b(k,43) - lu(k,100) * b(k,55) + b(k,42) = b(k,42) - lu(k,99) * b(k,55) + b(k,41) = b(k,41) - lu(k,98) * b(k,55) + b(k,40) = b(k,40) - lu(k,97) * b(k,55) + b(k,39) = b(k,39) - lu(k,96) * b(k,55) + b(k,54) = b(k,54) * lu(k,95) + b(k,43) = b(k,43) - lu(k,94) * b(k,54) + b(k,42) = b(k,42) - lu(k,93) * b(k,54) + b(k,41) = b(k,41) - lu(k,92) * b(k,54) + b(k,40) = b(k,40) - lu(k,91) * b(k,54) + b(k,39) = b(k,39) - lu(k,90) * b(k,54) + b(k,53) = b(k,53) * lu(k,89) + b(k,52) = b(k,52) - lu(k,88) * b(k,53) + b(k,52) = b(k,52) * lu(k,87) + b(k,43) = b(k,43) - lu(k,86) * b(k,52) + b(k,42) = b(k,42) - lu(k,85) * b(k,52) + b(k,41) = b(k,41) - lu(k,84) * b(k,52) + b(k,40) = b(k,40) - lu(k,83) * b(k,52) + b(k,39) = b(k,39) - lu(k,82) * b(k,52) + b(k,51) = b(k,51) * lu(k,81) + b(k,43) = b(k,43) - lu(k,80) * b(k,51) + b(k,42) = b(k,42) - lu(k,79) * b(k,51) + b(k,41) = b(k,41) - lu(k,78) * b(k,51) + b(k,40) = b(k,40) - lu(k,77) * b(k,51) + b(k,39) = b(k,39) - lu(k,76) * b(k,51) + b(k,50) = b(k,50) * lu(k,75) + b(k,43) = b(k,43) - lu(k,74) * b(k,50) + b(k,42) = b(k,42) - lu(k,73) * b(k,50) + b(k,41) = b(k,41) - lu(k,72) * b(k,50) + b(k,40) = b(k,40) - lu(k,71) * b(k,50) + b(k,39) = b(k,39) - lu(k,70) * b(k,50) + b(k,49) = b(k,49) * lu(k,69) + b(k,43) = b(k,43) - lu(k,68) * b(k,49) + b(k,42) = b(k,42) - lu(k,67) * b(k,49) + b(k,41) = b(k,41) - lu(k,66) * b(k,49) + b(k,40) = b(k,40) - lu(k,65) * b(k,49) + b(k,39) = b(k,39) - lu(k,64) * b(k,49) + b(k,48) = b(k,48) * lu(k,63) + b(k,43) = b(k,43) - lu(k,62) * b(k,48) + b(k,42) = b(k,42) - lu(k,61) * b(k,48) + b(k,41) = b(k,41) - lu(k,60) * b(k,48) + b(k,40) = b(k,40) - lu(k,59) * b(k,48) + b(k,39) = b(k,39) - lu(k,58) * b(k,48) + b(k,47) = b(k,47) * lu(k,57) + b(k,43) = b(k,43) - lu(k,56) * b(k,47) + b(k,42) = b(k,42) - lu(k,55) * b(k,47) + b(k,41) = b(k,41) - lu(k,54) * b(k,47) + b(k,40) = b(k,40) - lu(k,53) * b(k,47) + b(k,39) = b(k,39) - lu(k,52) * b(k,47) + b(k,46) = b(k,46) * lu(k,51) + b(k,43) = b(k,43) - lu(k,50) * b(k,46) + b(k,42) = b(k,42) - lu(k,49) * b(k,46) + b(k,41) = b(k,41) - lu(k,48) * b(k,46) + b(k,40) = b(k,40) - lu(k,47) * b(k,46) + b(k,39) = b(k,39) - lu(k,46) * b(k,46) + b(k,45) = b(k,45) * lu(k,45) + b(k,44) = b(k,44) * lu(k,44) + b(k,43) = b(k,43) * lu(k,43) + b(k,42) = b(k,42) * lu(k,42) + b(k,41) = b(k,41) * lu(k,41) + b(k,40) = b(k,40) * lu(k,40) + b(k,39) = b(k,39) * lu(k,39) + b(k,38) = b(k,38) * lu(k,38) + b(k,37) = b(k,37) * lu(k,37) + b(k,36) = b(k,36) * lu(k,36) + b(k,35) = b(k,35) * lu(k,35) + b(k,34) = b(k,34) * lu(k,34) + b(k,33) = b(k,33) * lu(k,33) + b(k,32) = b(k,32) * lu(k,32) + b(k,31) = b(k,31) * lu(k,31) + b(k,30) = b(k,30) * lu(k,30) + b(k,29) = b(k,29) * lu(k,29) + b(k,28) = b(k,28) * lu(k,28) + b(k,27) = b(k,27) * lu(k,27) + b(k,26) = b(k,26) * lu(k,26) + b(k,25) = b(k,25) * lu(k,25) + b(k,24) = b(k,24) * lu(k,24) + b(k,23) = b(k,23) * lu(k,23) + b(k,22) = b(k,22) * lu(k,22) + b(k,21) = b(k,21) * lu(k,21) + b(k,20) = b(k,20) * lu(k,20) + b(k,19) = b(k,19) * lu(k,19) + b(k,18) = b(k,18) * lu(k,18) + b(k,17) = b(k,17) * lu(k,17) + b(k,16) = b(k,16) * lu(k,16) + b(k,15) = b(k,15) * lu(k,15) + b(k,14) = b(k,14) * lu(k,14) + b(k,13) = b(k,13) * lu(k,13) + b(k,12) = b(k,12) * lu(k,12) + b(k,11) = b(k,11) * lu(k,11) + b(k,10) = b(k,10) * lu(k,10) + 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_slv20 + 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 ) + call lu_slv09( avec_len, lu, b ) + call lu_slv10( avec_len, lu, b ) + call lu_slv11( avec_len, lu, b ) + call lu_slv12( avec_len, lu, b ) + call lu_slv13( avec_len, lu, b ) + call lu_slv14( avec_len, lu, b ) + call lu_slv15( avec_len, lu, b ) + call lu_slv16( avec_len, lu, b ) + call lu_slv17( avec_len, lu, b ) + call lu_slv18( avec_len, lu, b ) + call lu_slv19( avec_len, lu, b ) + call lu_slv20( avec_len, lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_trop_strat_mam5_ts2/mo_nln_matrix.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/mo_nln_matrix.F90 new file mode 100644 index 0000000000..0f98044d76 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/mo_nln_matrix.F90 @@ -0,0 +1,6968 @@ + 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,752) = -(rxt(k,408)*y(k,295)) + mat(k,3955) = -rxt(k,408)*y(k,1) + mat(k,2998) = rxt(k,411)*y(k,236) + mat(k,1180) = rxt(k,411)*y(k,147) + mat(k,718) = -(rxt(k,412)*y(k,295)) + mat(k,3952) = -rxt(k,412)*y(k,2) + mat(k,1179) = rxt(k,409)*y(k,258) + mat(k,3247) = rxt(k,409)*y(k,236) + mat(k,1272) = -(rxt(k,584)*y(k,149) + rxt(k,602)*y(k,158) + rxt(k,603) & + *y(k,295)) + mat(k,3538) = -rxt(k,584)*y(k,4) + mat(k,3692) = -rxt(k,602)*y(k,4) + mat(k,4005) = -rxt(k,603)*y(k,4) + mat(k,1041) = -(rxt(k,604)*y(k,149) + rxt(k,622)*y(k,158) + rxt(k,623) & + *y(k,295)) + mat(k,3531) = -rxt(k,604)*y(k,7) + mat(k,3685) = -rxt(k,622)*y(k,7) + mat(k,3985) = -rxt(k,623)*y(k,7) + mat(k,182) = -(rxt(k,543)*y(k,295)) + mat(k,3874) = -rxt(k,543)*y(k,8) + mat(k,417) = -(rxt(k,546)*y(k,295)) + mat(k,3913) = -rxt(k,546)*y(k,9) + mat(k,512) = rxt(k,544)*y(k,258) + mat(k,3228) = rxt(k,544)*y(k,243) + mat(k,183) = .120_r8*rxt(k,543)*y(k,295) + mat(k,3875) = .120_r8*rxt(k,543)*y(k,8) + mat(k,2985) = .500_r8*rxt(k,545)*y(k,243) + .200_r8*rxt(k,572)*y(k,314) & + + .060_r8*rxt(k,578)*y(k,316) + mat(k,513) = .500_r8*rxt(k,545)*y(k,147) + mat(k,870) = .200_r8*rxt(k,572)*y(k,147) + mat(k,892) = .060_r8*rxt(k,578)*y(k,147) + mat(k,2980) = .200_r8*rxt(k,572)*y(k,314) + .200_r8*rxt(k,578)*y(k,316) + mat(k,868) = .200_r8*rxt(k,572)*y(k,147) + mat(k,889) = .200_r8*rxt(k,578)*y(k,147) + mat(k,2982) = .200_r8*rxt(k,572)*y(k,314) + .150_r8*rxt(k,578)*y(k,316) + mat(k,869) = .200_r8*rxt(k,572)*y(k,147) + mat(k,891) = .150_r8*rxt(k,578)*y(k,147) + mat(k,2981) = .210_r8*rxt(k,578)*y(k,316) + mat(k,890) = .210_r8*rxt(k,578)*y(k,147) + mat(k,204) = -(rxt(k,413)*y(k,295)) + mat(k,3878) = -rxt(k,413)*y(k,15) + mat(k,1091) = .190_r8*rxt(k,642)*y(k,158) + mat(k,3674) = .190_r8*rxt(k,642)*y(k,17) + mat(k,377) = -(rxt(k,374)*y(k,149) + rxt(k,375)*y(k,295)) + mat(k,3527) = -rxt(k,374)*y(k,16) + mat(k,3908) = -rxt(k,375)*y(k,16) + mat(k,1092) = -(rxt(k,624)*y(k,149) + rxt(k,642)*y(k,158) + rxt(k,643) & + *y(k,295)) + mat(k,3533) = -rxt(k,624)*y(k,17) + mat(k,3687) = -rxt(k,642)*y(k,17) + mat(k,3988) = -rxt(k,643)*y(k,17) + mat(k,2199) = -(rxt(k,254)*y(k,43) + rxt(k,255)*y(k,258) + rxt(k,256) & + *y(k,158)) + mat(k,3181) = -rxt(k,254)*y(k,18) + mat(k,3338) = -rxt(k,255)*y(k,18) + mat(k,3731) = -rxt(k,256)*y(k,18) + mat(k,3479) = 4.000_r8*rxt(k,257)*y(k,20) + (rxt(k,258)+rxt(k,259))*y(k,60) & + + rxt(k,262)*y(k,147) + rxt(k,265)*y(k,157) + rxt(k,800) & + *y(k,174) + rxt(k,266)*y(k,295) + mat(k,161) = rxt(k,244)*y(k,294) + mat(k,167) = rxt(k,270)*y(k,294) + mat(k,496) = 2.000_r8*rxt(k,281)*y(k,57) + 2.000_r8*rxt(k,293)*y(k,294) & + + 2.000_r8*rxt(k,282)*y(k,295) + mat(k,647) = rxt(k,283)*y(k,57) + rxt(k,294)*y(k,294) + rxt(k,284)*y(k,295) + mat(k,463) = 3.000_r8*rxt(k,288)*y(k,57) + 3.000_r8*rxt(k,271)*y(k,294) & + + 3.000_r8*rxt(k,289)*y(k,295) + mat(k,3833) = 2.000_r8*rxt(k,281)*y(k,42) + rxt(k,283)*y(k,44) & + + 3.000_r8*rxt(k,288)*y(k,56) + mat(k,3505) = (rxt(k,258)+rxt(k,259))*y(k,20) + mat(k,128) = 2.000_r8*rxt(k,272)*y(k,294) + mat(k,1151) = rxt(k,267)*y(k,157) + rxt(k,273)*y(k,294) + rxt(k,268)*y(k,295) + mat(k,3079) = rxt(k,262)*y(k,20) + mat(k,3155) = rxt(k,265)*y(k,20) + rxt(k,267)*y(k,83) + mat(k,1601) = rxt(k,800)*y(k,20) + mat(k,3793) = rxt(k,244)*y(k,35) + rxt(k,270)*y(k,36) + 2.000_r8*rxt(k,293) & + *y(k,42) + rxt(k,294)*y(k,44) + 3.000_r8*rxt(k,271)*y(k,56) & + + 2.000_r8*rxt(k,272)*y(k,80) + rxt(k,273)*y(k,83) + mat(k,4062) = rxt(k,266)*y(k,20) + 2.000_r8*rxt(k,282)*y(k,42) + rxt(k,284) & + *y(k,44) + 3.000_r8*rxt(k,289)*y(k,56) + rxt(k,268)*y(k,83) + mat(k,3473) = rxt(k,260)*y(k,60) + mat(k,3499) = rxt(k,260)*y(k,20) + mat(k,3122) = (rxt(k,892)+rxt(k,897))*y(k,95) + mat(k,994) = (rxt(k,892)+rxt(k,897))*y(k,87) + mat(k,3488) = -(4._r8*rxt(k,257)*y(k,20) + (rxt(k,258) + rxt(k,259) + rxt(k,260) & + ) * y(k,60) + rxt(k,261)*y(k,258) + rxt(k,262)*y(k,147) & + + rxt(k,263)*y(k,148) + rxt(k,265)*y(k,157) + rxt(k,266) & + *y(k,295) + rxt(k,800)*y(k,174)) + mat(k,3514) = -(rxt(k,258) + rxt(k,259) + rxt(k,260)) * y(k,20) + mat(k,3371) = -rxt(k,261)*y(k,20) + mat(k,3112) = -rxt(k,262)*y(k,20) + mat(k,3660) = -rxt(k,263)*y(k,20) + mat(k,3165) = -rxt(k,265)*y(k,20) + mat(k,4094) = -rxt(k,266)*y(k,20) + mat(k,1606) = -rxt(k,800)*y(k,20) + mat(k,2204) = rxt(k,256)*y(k,158) + mat(k,566) = rxt(k,264)*y(k,157) + mat(k,1154) = rxt(k,274)*y(k,294) + mat(k,999) = rxt(k,269)*y(k,157) + mat(k,3165) = mat(k,3165) + rxt(k,264)*y(k,21) + rxt(k,269)*y(k,95) + mat(k,3762) = rxt(k,256)*y(k,18) + mat(k,3803) = rxt(k,274)*y(k,83) + mat(k,561) = -(rxt(k,264)*y(k,157)) + mat(k,3145) = -rxt(k,264)*y(k,21) + mat(k,3475) = rxt(k,263)*y(k,148) + mat(k,3626) = rxt(k,263)*y(k,20) + mat(k,245) = -(rxt(k,547)*y(k,295)) + mat(k,3885) = -rxt(k,547)*y(k,23) + mat(k,2978) = rxt(k,550)*y(k,248) + mat(k,435) = rxt(k,550)*y(k,147) + mat(k,353) = -(rxt(k,549)*y(k,295)) + mat(k,3903) = -rxt(k,549)*y(k,24) + mat(k,436) = rxt(k,548)*y(k,258) + mat(k,3221) = rxt(k,548)*y(k,248) + mat(k,310) = -(rxt(k,320)*y(k,57) + rxt(k,321)*y(k,295)) + mat(k,3813) = -rxt(k,320)*y(k,25) + mat(k,3898) = -rxt(k,321)*y(k,25) + mat(k,585) = -(rxt(k,322)*y(k,57) + rxt(k,323)*y(k,158) + rxt(k,350)*y(k,295)) + mat(k,3818) = -rxt(k,322)*y(k,26) + mat(k,3677) = -rxt(k,323)*y(k,26) + mat(k,3937) = -rxt(k,350)*y(k,26) + mat(k,283) = -(rxt(k,328)*y(k,295)) + mat(k,3895) = -rxt(k,328)*y(k,27) + mat(k,1348) = .800_r8*rxt(k,324)*y(k,249) + .200_r8*rxt(k,325)*y(k,253) + mat(k,3381) = .200_r8*rxt(k,325)*y(k,249) + mat(k,358) = -(rxt(k,329)*y(k,295)) + mat(k,3904) = -rxt(k,329)*y(k,28) + mat(k,1349) = rxt(k,326)*y(k,258) + mat(k,3222) = rxt(k,326)*y(k,249) + mat(k,316) = -(rxt(k,330)*y(k,57) + rxt(k,331)*y(k,295)) + mat(k,3814) = -rxt(k,330)*y(k,29) + mat(k,3899) = -rxt(k,331)*y(k,29) + mat(k,1385) = -(rxt(k,353)*y(k,149) + rxt(k,354)*y(k,158) + rxt(k,372) & + *y(k,295)) + mat(k,3542) = -rxt(k,353)*y(k,30) + mat(k,3696) = -rxt(k,354)*y(k,30) + mat(k,4014) = -rxt(k,372)*y(k,30) + mat(k,411) = -(rxt(k,358)*y(k,295)) + mat(k,3912) = -rxt(k,358)*y(k,31) + mat(k,1023) = rxt(k,356)*y(k,258) + mat(k,3227) = rxt(k,356)*y(k,250) + mat(k,130) = -(rxt(k,359)*y(k,295)) + mat(k,3872) = -rxt(k,359)*y(k,32) + mat(k,287) = -(rxt(k,553)*y(k,295)) + mat(k,3896) = -rxt(k,553)*y(k,33) + mat(k,709) = rxt(k,551)*y(k,258) + mat(k,3217) = rxt(k,551)*y(k,251) + mat(k,120) = -(rxt(k,243)*y(k,294)) + mat(k,3771) = -rxt(k,243)*y(k,34) + mat(k,159) = -(rxt(k,244)*y(k,294)) + mat(k,3776) = -rxt(k,244)*y(k,35) + mat(k,164) = -(rxt(k,270)*y(k,294)) + mat(k,3777) = -rxt(k,270)*y(k,36) + mat(k,134) = -(rxt(k,245)*y(k,294)) + mat(k,3773) = -rxt(k,245)*y(k,37) + mat(k,169) = -(rxt(k,246)*y(k,294)) + mat(k,3778) = -rxt(k,246)*y(k,38) + mat(k,138) = -(rxt(k,247)*y(k,294)) + mat(k,3774) = -rxt(k,247)*y(k,39) + mat(k,174) = -(rxt(k,248)*y(k,294)) + mat(k,3779) = -rxt(k,248)*y(k,40) + mat(k,142) = -(rxt(k,249)*y(k,294)) + mat(k,3775) = -rxt(k,249)*y(k,41) + mat(k,495) = -(rxt(k,281)*y(k,57) + rxt(k,282)*y(k,295) + rxt(k,293)*y(k,294)) + mat(k,3817) = -rxt(k,281)*y(k,42) + mat(k,3926) = -rxt(k,282)*y(k,42) + mat(k,3788) = -rxt(k,293)*y(k,42) + mat(k,3188) = -(rxt(k,218)*y(k,57) + rxt(k,254)*y(k,18) + rxt(k,298)*y(k,258) & + + rxt(k,299)*y(k,149) + rxt(k,300)*y(k,157) + rxt(k,301) & + *y(k,295)) + mat(k,3841) = -rxt(k,218)*y(k,43) + mat(k,2202) = -rxt(k,254)*y(k,43) + mat(k,3368) = -rxt(k,298)*y(k,43) + mat(k,3605) = -rxt(k,299)*y(k,43) + mat(k,3162) = -rxt(k,300)*y(k,43) + mat(k,4091) = -rxt(k,301)*y(k,43) + mat(k,758) = .400_r8*rxt(k,408)*y(k,295) + mat(k,1284) = .270_r8*rxt(k,602)*y(k,158) + mat(k,1049) = .080_r8*rxt(k,622)*y(k,158) + mat(k,381) = .500_r8*rxt(k,374)*y(k,149) + mat(k,1102) = .810_r8*rxt(k,642)*y(k,158) + mat(k,589) = rxt(k,323)*y(k,158) + mat(k,1393) = .500_r8*rxt(k,354)*y(k,158) + mat(k,705) = .500_r8*rxt(k,340)*y(k,295) + mat(k,1495) = rxt(k,306)*y(k,295) + mat(k,451) = .300_r8*rxt(k,307)*y(k,295) + mat(k,2264) = (rxt(k,316)+rxt(k,317))*y(k,294) + mat(k,3511) = rxt(k,225)*y(k,253) + mat(k,1715) = .800_r8*rxt(k,345)*y(k,295) + mat(k,886) = .110_r8*rxt(k,347)*y(k,295) + mat(k,1212) = .500_r8*rxt(k,311)*y(k,295) + mat(k,927) = .300_r8*rxt(k,363)*y(k,295) + mat(k,918) = .500_r8*rxt(k,419)*y(k,295) + mat(k,508) = .400_r8*rxt(k,422)*y(k,295) + mat(k,1261) = .590_r8*rxt(k,423)*y(k,295) + mat(k,1424) = 1.010_r8*rxt(k,486)*y(k,158) + mat(k,1081) = .330_r8*rxt(k,662)*y(k,158) + mat(k,2023) = .120_r8*rxt(k,385)*y(k,158) + mat(k,2048) = .600_r8*rxt(k,403)*y(k,158) + mat(k,833) = .390_r8*rxt(k,682)*y(k,158) + mat(k,3109) = .100_r8*rxt(k,410)*y(k,236) + .210_r8*rxt(k,597)*y(k,238) & + + .020_r8*rxt(k,629)*y(k,245) + .490_r8*rxt(k,637)*y(k,246) & + + rxt(k,305)*y(k,253) + .500_r8*rxt(k,377)*y(k,255) & + + .500_r8*rxt(k,342)*y(k,257) + rxt(k,505)*y(k,261) + rxt(k,507) & + *y(k,262) + .060_r8*rxt(k,513)*y(k,269) + .270_r8*rxt(k,515) & + *y(k,270) + rxt(k,517)*y(k,271) + .130_r8*rxt(k,519)*y(k,272) & + + .330_r8*rxt(k,521)*y(k,273) + .460_r8*rxt(k,523)*y(k,274) & + + .530_r8*rxt(k,525)*y(k,275) + .040_r8*rxt(k,527)*y(k,276) & + + .430_r8*rxt(k,657)*y(k,282) + .140_r8*rxt(k,535)*y(k,284) & + + rxt(k,392)*y(k,286) + .240_r8*rxt(k,537)*y(k,289) & + + .040_r8*rxt(k,669)*y(k,290) + .300_r8*rxt(k,677)*y(k,291) & + + rxt(k,366)*y(k,297) + rxt(k,370)*y(k,298) + .310_r8*rxt(k,688) & + *y(k,299) + 1.820_r8*rxt(k,741)*y(k,306) + .310_r8*rxt(k,761) & + *y(k,308) + mat(k,3605) = mat(k,3605) + .500_r8*rxt(k,374)*y(k,16) + .440_r8*rxt(k,759) & + *y(k,212) + .500_r8*rxt(k,764)*y(k,213) + .270_r8*rxt(k,598) & + *y(k,238) + .020_r8*rxt(k,630)*y(k,245) + .650_r8*rxt(k,638) & + *y(k,246) + .460_r8*rxt(k,478)*y(k,274) + .560_r8*rxt(k,658) & + *y(k,282) + rxt(k,393)*y(k,286) + .040_r8*rxt(k,670)*y(k,290) & + + .420_r8*rxt(k,678)*y(k,291) + 2.000_r8*rxt(k,742)*y(k,306) + mat(k,1457) = rxt(k,348)*y(k,295) + mat(k,3759) = .270_r8*rxt(k,602)*y(k,4) + .080_r8*rxt(k,622)*y(k,7) & + + .810_r8*rxt(k,642)*y(k,17) + rxt(k,323)*y(k,26) & + + .500_r8*rxt(k,354)*y(k,30) + 1.010_r8*rxt(k,486)*y(k,109) & + + .330_r8*rxt(k,662)*y(k,125) + .120_r8*rxt(k,385)*y(k,126) & + + .600_r8*rxt(k,403)*y(k,132) + .390_r8*rxt(k,682)*y(k,135) & + + .620_r8*rxt(k,762)*y(k,212) + .340_r8*rxt(k,767)*y(k,213) + mat(k,572) = rxt(k,349)*y(k,295) + mat(k,660) = 2.000_r8*rxt(k,718)*y(k,295) + mat(k,669) = rxt(k,737)*y(k,295) + mat(k,2639) = .440_r8*rxt(k,759)*y(k,149) + .620_r8*rxt(k,762)*y(k,158) + mat(k,2611) = .500_r8*rxt(k,764)*y(k,149) + .340_r8*rxt(k,767)*y(k,158) + mat(k,1188) = .100_r8*rxt(k,410)*y(k,147) + mat(k,2308) = .950_r8*rxt(k,587)*y(k,253) + mat(k,2453) = .210_r8*rxt(k,597)*y(k,147) + .270_r8*rxt(k,598)*y(k,149) & + + .270_r8*rxt(k,594)*y(k,252) + .830_r8*rxt(k,595)*y(k,253) & + + .080_r8*rxt(k,596)*y(k,258) + .270_r8*rxt(k,599)*y(k,302) & + + .270_r8*rxt(k,600)*y(k,304) + .270_r8*rxt(k,601)*y(k,307) + mat(k,2224) = .950_r8*rxt(k,607)*y(k,253) + mat(k,2421) = .750_r8*rxt(k,615)*y(k,253) + mat(k,2547) = .020_r8*rxt(k,629)*y(k,147) + .020_r8*rxt(k,630)*y(k,149) & + + .080_r8*rxt(k,625)*y(k,245) + .020_r8*rxt(k,626)*y(k,252) & + + .990_r8*rxt(k,627)*y(k,253) + .020_r8*rxt(k,628)*y(k,258) & + + .020_r8*rxt(k,631)*y(k,302) + .020_r8*rxt(k,632)*y(k,304) & + + .020_r8*rxt(k,633)*y(k,307) + mat(k,2392) = .490_r8*rxt(k,637)*y(k,147) + .650_r8*rxt(k,638)*y(k,149) & + + .650_r8*rxt(k,634)*y(k,252) + 1.400_r8*rxt(k,635)*y(k,253) & + + .030_r8*rxt(k,636)*y(k,258) + .650_r8*rxt(k,639)*y(k,302) & + + .650_r8*rxt(k,640)*y(k,304) + .650_r8*rxt(k,641)*y(k,307) + mat(k,1354) = .700_r8*rxt(k,325)*y(k,253) + mat(k,1028) = rxt(k,355)*y(k,253) + mat(k,2919) = .270_r8*rxt(k,594)*y(k,238) + .020_r8*rxt(k,626)*y(k,245) & + + .650_r8*rxt(k,634)*y(k,246) + rxt(k,336)*y(k,253) + rxt(k,424) & + *y(k,261) + rxt(k,430)*y(k,262) + .460_r8*rxt(k,474)*y(k,274) & + + .560_r8*rxt(k,654)*y(k,282) + .140_r8*rxt(k,381)*y(k,284) & + + rxt(k,388)*y(k,286) + .250_r8*rxt(k,400)*y(k,289) & + + .040_r8*rxt(k,665)*y(k,290) + .420_r8*rxt(k,674)*y(k,291) & + + 2.000_r8*rxt(k,738)*y(k,306) + mat(k,3461) = rxt(k,225)*y(k,60) + rxt(k,305)*y(k,147) + .950_r8*rxt(k,587) & + *y(k,237) + .830_r8*rxt(k,595)*y(k,238) + .950_r8*rxt(k,607) & + *y(k,240) + .750_r8*rxt(k,615)*y(k,241) + .990_r8*rxt(k,627) & + *y(k,245) + 1.400_r8*rxt(k,635)*y(k,246) + .700_r8*rxt(k,325) & + *y(k,249) + rxt(k,355)*y(k,250) + rxt(k,336)*y(k,252) + ( & + + 4.000_r8*rxt(k,302)+2.000_r8*rxt(k,303))*y(k,253) & + + 1.750_r8*rxt(k,425)*y(k,261) + 1.250_r8*rxt(k,431)*y(k,262) & + + .750_r8*rxt(k,445)*y(k,267) + .750_r8*rxt(k,449)*y(k,268) & + + .710_r8*rxt(k,475)*y(k,274) + .750_r8*rxt(k,492)*y(k,278) & + + .750_r8*rxt(k,496)*y(k,279) + .910_r8*rxt(k,646)*y(k,281) & + + 1.030_r8*rxt(k,655)*y(k,282) + 1.100_r8*rxt(k,382)*y(k,284) & + + 2.000_r8*rxt(k,389)*y(k,286) + .870_r8*rxt(k,401)*y(k,289) & + + .980_r8*rxt(k,666)*y(k,290) + .750_r8*rxt(k,675)*y(k,291) & + + .800_r8*rxt(k,368)*y(k,298) + .750_r8*rxt(k,694)*y(k,301) & + + rxt(k,702)*y(k,302) + rxt(k,710)*y(k,303) + rxt(k,720) & + *y(k,304) + rxt(k,729)*y(k,305) + 3.000_r8*rxt(k,739)*y(k,306) & + + rxt(k,750)*y(k,307) + mat(k,610) = .500_r8*rxt(k,377)*y(k,147) + mat(k,858) = .500_r8*rxt(k,342)*y(k,147) + mat(k,3368) = mat(k,3368) + .080_r8*rxt(k,596)*y(k,238) + .020_r8*rxt(k,628) & + *y(k,245) + .030_r8*rxt(k,636)*y(k,246) + .060_r8*rxt(k,426) & + *y(k,261) + .060_r8*rxt(k,432)*y(k,262) + .030_r8*rxt(k,457) & + *y(k,269) + .060_r8*rxt(k,461)*y(k,270) + .600_r8*rxt(k,464) & + *y(k,271) + .060_r8*rxt(k,467)*y(k,272) + .100_r8*rxt(k,471) & + *y(k,273) + .240_r8*rxt(k,476)*y(k,274) + .170_r8*rxt(k,479) & + *y(k,275) + .030_r8*rxt(k,482)*y(k,276) + .060_r8*rxt(k,656) & + *y(k,282) + .080_r8*rxt(k,383)*y(k,284) + .490_r8*rxt(k,390) & + *y(k,286) + .050_r8*rxt(k,402)*y(k,289) + .020_r8*rxt(k,667) & + *y(k,290) + .040_r8*rxt(k,676)*y(k,291) + .150_r8*rxt(k,369) & + *y(k,298) + .080_r8*rxt(k,687)*y(k,299) + 1.060_r8*rxt(k,740) & + *y(k,306) + .040_r8*rxt(k,760)*y(k,308) + mat(k,1963) = rxt(k,505)*y(k,147) + rxt(k,424)*y(k,252) + 1.750_r8*rxt(k,425) & + *y(k,253) + .060_r8*rxt(k,426)*y(k,258) + mat(k,2002) = rxt(k,507)*y(k,147) + rxt(k,430)*y(k,252) + 1.250_r8*rxt(k,431) & + *y(k,253) + .060_r8*rxt(k,432)*y(k,258) + mat(k,1743) = .750_r8*rxt(k,445)*y(k,253) + mat(k,1765) = .750_r8*rxt(k,449)*y(k,253) + mat(k,1128) = .060_r8*rxt(k,513)*y(k,147) + .030_r8*rxt(k,457)*y(k,258) + mat(k,1174) = .270_r8*rxt(k,515)*y(k,147) + .060_r8*rxt(k,461)*y(k,258) + mat(k,1060) = rxt(k,517)*y(k,147) + .600_r8*rxt(k,464)*y(k,258) + mat(k,1139) = .130_r8*rxt(k,519)*y(k,147) + .060_r8*rxt(k,467)*y(k,258) + mat(k,1450) = .330_r8*rxt(k,521)*y(k,147) + .100_r8*rxt(k,471)*y(k,258) + mat(k,2188) = .460_r8*rxt(k,523)*y(k,147) + .460_r8*rxt(k,478)*y(k,149) & + + .460_r8*rxt(k,474)*y(k,252) + .710_r8*rxt(k,475)*y(k,253) & + + .240_r8*rxt(k,476)*y(k,258) + .320_r8*rxt(k,477)*y(k,274) + mat(k,1319) = .530_r8*rxt(k,525)*y(k,147) + .170_r8*rxt(k,479)*y(k,258) + mat(k,1373) = .040_r8*rxt(k,527)*y(k,147) + .030_r8*rxt(k,482)*y(k,258) + mat(k,1860) = .750_r8*rxt(k,492)*y(k,253) + mat(k,1829) = .750_r8*rxt(k,496)*y(k,253) + mat(k,2518) = .910_r8*rxt(k,646)*y(k,253) + mat(k,2352) = .430_r8*rxt(k,657)*y(k,147) + .560_r8*rxt(k,658)*y(k,149) & + + .560_r8*rxt(k,654)*y(k,252) + 1.030_r8*rxt(k,655)*y(k,253) & + + .060_r8*rxt(k,656)*y(k,258) + .560_r8*rxt(k,659)*y(k,302) & + + .560_r8*rxt(k,660)*y(k,304) + .560_r8*rxt(k,661)*y(k,307) + mat(k,1552) = .140_r8*rxt(k,535)*y(k,147) + .140_r8*rxt(k,381)*y(k,252) & + + 1.100_r8*rxt(k,382)*y(k,253) + .080_r8*rxt(k,383)*y(k,258) + mat(k,1626) = rxt(k,392)*y(k,147) + rxt(k,393)*y(k,149) + rxt(k,388)*y(k,252) & + + 2.000_r8*rxt(k,389)*y(k,253) + .490_r8*rxt(k,390)*y(k,258) & + + 4.000_r8*rxt(k,391)*y(k,286) + mat(k,1516) = .240_r8*rxt(k,537)*y(k,147) + .250_r8*rxt(k,400)*y(k,252) & + + .870_r8*rxt(k,401)*y(k,253) + .050_r8*rxt(k,402)*y(k,258) + mat(k,2583) = .040_r8*rxt(k,669)*y(k,147) + .040_r8*rxt(k,670)*y(k,149) & + + .040_r8*rxt(k,665)*y(k,252) + .980_r8*rxt(k,666)*y(k,253) & + + .020_r8*rxt(k,667)*y(k,258) + .120_r8*rxt(k,668)*y(k,290) & + + .040_r8*rxt(k,671)*y(k,302) + .040_r8*rxt(k,672)*y(k,304) & + + .040_r8*rxt(k,673)*y(k,307) + mat(k,2484) = .300_r8*rxt(k,677)*y(k,147) + .420_r8*rxt(k,678)*y(k,149) & + + .420_r8*rxt(k,674)*y(k,252) + .750_r8*rxt(k,675)*y(k,253) & + + .040_r8*rxt(k,676)*y(k,258) + .420_r8*rxt(k,679)*y(k,302) & + + .420_r8*rxt(k,680)*y(k,304) + .420_r8*rxt(k,681)*y(k,307) + mat(k,3800) = (rxt(k,316)+rxt(k,317))*y(k,55) + mat(k,4091) = mat(k,4091) + .400_r8*rxt(k,408)*y(k,1) + .500_r8*rxt(k,340) & + *y(k,52) + rxt(k,306)*y(k,53) + .300_r8*rxt(k,307)*y(k,54) & + + .800_r8*rxt(k,345)*y(k,76) + .110_r8*rxt(k,347)*y(k,89) & + + .500_r8*rxt(k,311)*y(k,92) + .300_r8*rxt(k,363)*y(k,104) & + + .500_r8*rxt(k,419)*y(k,105) + .400_r8*rxt(k,422)*y(k,107) & + + .590_r8*rxt(k,423)*y(k,108) + rxt(k,348)*y(k,150) + rxt(k,349) & + *y(k,163) + 2.000_r8*rxt(k,718)*y(k,204) + rxt(k,737)*y(k,206) + mat(k,943) = rxt(k,366)*y(k,147) + mat(k,1342) = rxt(k,370)*y(k,147) + .800_r8*rxt(k,368)*y(k,253) & + + .150_r8*rxt(k,369)*y(k,258) + mat(k,956) = .310_r8*rxt(k,688)*y(k,147) + .080_r8*rxt(k,687)*y(k,258) + mat(k,2664) = .750_r8*rxt(k,694)*y(k,253) + mat(k,2753) = .270_r8*rxt(k,599)*y(k,238) + .020_r8*rxt(k,631)*y(k,245) & + + .650_r8*rxt(k,639)*y(k,246) + rxt(k,702)*y(k,253) & + + .560_r8*rxt(k,659)*y(k,282) + .040_r8*rxt(k,671)*y(k,290) & + + .420_r8*rxt(k,679)*y(k,291) + 2.000_r8*rxt(k,743)*y(k,306) + mat(k,2709) = rxt(k,710)*y(k,253) + mat(k,2799) = .270_r8*rxt(k,600)*y(k,238) + .020_r8*rxt(k,632)*y(k,245) & + + .650_r8*rxt(k,640)*y(k,246) + rxt(k,720)*y(k,253) & + + .560_r8*rxt(k,660)*y(k,282) + .040_r8*rxt(k,672)*y(k,290) & + + .420_r8*rxt(k,680)*y(k,291) + 2.000_r8*rxt(k,744)*y(k,306) + mat(k,2248) = rxt(k,729)*y(k,253) + mat(k,2686) = 1.820_r8*rxt(k,741)*y(k,147) + 2.000_r8*rxt(k,742)*y(k,149) & + + 2.000_r8*rxt(k,738)*y(k,252) + 3.000_r8*rxt(k,739)*y(k,253) & + + 1.060_r8*rxt(k,740)*y(k,258) + 2.000_r8*rxt(k,743)*y(k,302) & + + 2.000_r8*rxt(k,744)*y(k,304) + 2.000_r8*rxt(k,745)*y(k,307) + mat(k,2846) = .270_r8*rxt(k,601)*y(k,238) + .020_r8*rxt(k,633)*y(k,245) & + + .650_r8*rxt(k,641)*y(k,246) + rxt(k,750)*y(k,253) & + + .560_r8*rxt(k,661)*y(k,282) + .040_r8*rxt(k,673)*y(k,290) & + + .420_r8*rxt(k,681)*y(k,291) + 2.000_r8*rxt(k,745)*y(k,306) + mat(k,801) = .310_r8*rxt(k,761)*y(k,147) + .040_r8*rxt(k,760)*y(k,258) + 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,646) = -(rxt(k,283)*y(k,57) + rxt(k,284)*y(k,295) + rxt(k,294)*y(k,294)) + mat(k,3819) = -rxt(k,283)*y(k,44) + mat(k,3944) = -rxt(k,284)*y(k,44) + mat(k,3789) = -rxt(k,294)*y(k,44) + mat(k,146) = -(rxt(k,285)*y(k,295)) + mat(k,3873) = -rxt(k,285)*y(k,45) + mat(k,1431) = -(rxt(k,332)*y(k,149) + rxt(k,333)*y(k,295)) + mat(k,3544) = -rxt(k,332)*y(k,46) + mat(k,4016) = -rxt(k,333)*y(k,46) + mat(k,755) = .800_r8*rxt(k,408)*y(k,295) + mat(k,379) = rxt(k,374)*y(k,149) + mat(k,284) = rxt(k,328)*y(k,295) + mat(k,360) = .500_r8*rxt(k,329)*y(k,295) + mat(k,1386) = .500_r8*rxt(k,354)*y(k,158) + mat(k,2033) = .100_r8*rxt(k,403)*y(k,158) + mat(k,3037) = .400_r8*rxt(k,410)*y(k,236) + rxt(k,327)*y(k,249) & + + .270_r8*rxt(k,357)*y(k,250) + rxt(k,377)*y(k,255) + rxt(k,395) & + *y(k,288) + rxt(k,366)*y(k,297) + mat(k,3544) = mat(k,3544) + rxt(k,374)*y(k,16) + mat(k,3698) = .500_r8*rxt(k,354)*y(k,30) + .100_r8*rxt(k,403)*y(k,132) + mat(k,1184) = .400_r8*rxt(k,410)*y(k,147) + mat(k,1351) = rxt(k,327)*y(k,147) + 3.200_r8*rxt(k,324)*y(k,249) & + + .800_r8*rxt(k,325)*y(k,253) + mat(k,1025) = .270_r8*rxt(k,357)*y(k,147) + mat(k,3392) = .800_r8*rxt(k,325)*y(k,249) + mat(k,607) = rxt(k,377)*y(k,147) + mat(k,3294) = .200_r8*rxt(k,394)*y(k,288) + mat(k,764) = rxt(k,395)*y(k,147) + .200_r8*rxt(k,394)*y(k,258) + mat(k,4016) = mat(k,4016) + .800_r8*rxt(k,408)*y(k,1) + rxt(k,328)*y(k,27) & + + .500_r8*rxt(k,329)*y(k,28) + mat(k,940) = rxt(k,366)*y(k,147) + mat(k,393) = -(rxt(k,286)*y(k,57) + rxt(k,287)*y(k,295)) + mat(k,3815) = -rxt(k,286)*y(k,47) + mat(k,3910) = -rxt(k,287)*y(k,47) + mat(k,123) = -(rxt(k,334)*y(k,295)) + mat(k,3871) = -rxt(k,334)*y(k,48) + mat(k,2277) = -(rxt(k,373)*y(k,295)) + mat(k,4065) = -rxt(k,373)*y(k,49) + mat(k,756) = .800_r8*rxt(k,408)*y(k,295) + mat(k,380) = .500_r8*rxt(k,374)*y(k,149) + mat(k,829) = .250_r8*rxt(k,682)*y(k,158) + mat(k,3083) = .250_r8*rxt(k,410)*y(k,236) + .090_r8*rxt(k,597)*y(k,238) & + + .080_r8*rxt(k,637)*y(k,246) + .820_r8*rxt(k,357)*y(k,250) & + + .500_r8*rxt(k,377)*y(k,255) + .850_r8*rxt(k,669)*y(k,290) & + + .330_r8*rxt(k,677)*y(k,291) + .700_r8*rxt(k,731)*y(k,305) + mat(k,3579) = .500_r8*rxt(k,374)*y(k,16) + .120_r8*rxt(k,598)*y(k,238) & + + .110_r8*rxt(k,638)*y(k,246) + .910_r8*rxt(k,670)*y(k,290) & + + .460_r8*rxt(k,678)*y(k,291) + rxt(k,732)*y(k,305) + mat(k,3734) = .250_r8*rxt(k,682)*y(k,135) + mat(k,658) = rxt(k,718)*y(k,295) + mat(k,1185) = .250_r8*rxt(k,410)*y(k,147) + mat(k,2438) = .090_r8*rxt(k,597)*y(k,147) + .120_r8*rxt(k,598)*y(k,149) & + + .120_r8*rxt(k,594)*y(k,252) + .060_r8*rxt(k,595)*y(k,253) & + + .060_r8*rxt(k,596)*y(k,258) + .120_r8*rxt(k,599)*y(k,302) & + + .120_r8*rxt(k,600)*y(k,304) + .120_r8*rxt(k,601)*y(k,307) + mat(k,2377) = .080_r8*rxt(k,637)*y(k,147) + .110_r8*rxt(k,638)*y(k,149) & + + .110_r8*rxt(k,634)*y(k,252) + .080_r8*rxt(k,635)*y(k,253) & + + .110_r8*rxt(k,639)*y(k,302) + .110_r8*rxt(k,640)*y(k,304) & + + .110_r8*rxt(k,641)*y(k,307) + mat(k,1026) = .820_r8*rxt(k,357)*y(k,147) + .820_r8*rxt(k,355)*y(k,253) + mat(k,2893) = .120_r8*rxt(k,594)*y(k,238) + .110_r8*rxt(k,634)*y(k,246) & + + .910_r8*rxt(k,665)*y(k,290) + .460_r8*rxt(k,674)*y(k,291) & + + rxt(k,728)*y(k,305) + mat(k,3435) = .060_r8*rxt(k,595)*y(k,238) + .080_r8*rxt(k,635)*y(k,246) & + + .820_r8*rxt(k,355)*y(k,250) + .100_r8*rxt(k,382)*y(k,284) & + + .740_r8*rxt(k,666)*y(k,290) + rxt(k,729)*y(k,305) + mat(k,608) = .500_r8*rxt(k,377)*y(k,147) + mat(k,3342) = .060_r8*rxt(k,596)*y(k,238) + .460_r8*rxt(k,667)*y(k,290) & + + .050_r8*rxt(k,676)*y(k,291) + .150_r8*rxt(k,730)*y(k,305) + mat(k,1549) = .100_r8*rxt(k,382)*y(k,253) + mat(k,2567) = .850_r8*rxt(k,669)*y(k,147) + .910_r8*rxt(k,670)*y(k,149) & + + .910_r8*rxt(k,665)*y(k,252) + .740_r8*rxt(k,666)*y(k,253) & + + .460_r8*rxt(k,667)*y(k,258) + 2.960_r8*rxt(k,668)*y(k,290) & + + .910_r8*rxt(k,671)*y(k,302) + .910_r8*rxt(k,672)*y(k,304) & + + .910_r8*rxt(k,673)*y(k,307) + mat(k,2468) = .330_r8*rxt(k,677)*y(k,147) + .460_r8*rxt(k,678)*y(k,149) & + + .460_r8*rxt(k,674)*y(k,252) + .050_r8*rxt(k,676)*y(k,258) & + + .460_r8*rxt(k,679)*y(k,302) + .460_r8*rxt(k,680)*y(k,304) & + + .460_r8*rxt(k,681)*y(k,307) + mat(k,4065) = mat(k,4065) + .800_r8*rxt(k,408)*y(k,1) + rxt(k,718)*y(k,204) + mat(k,2728) = .120_r8*rxt(k,599)*y(k,238) + .110_r8*rxt(k,639)*y(k,246) & + + .910_r8*rxt(k,671)*y(k,290) + .460_r8*rxt(k,679)*y(k,291) & + + rxt(k,733)*y(k,305) + mat(k,2774) = .120_r8*rxt(k,600)*y(k,238) + .110_r8*rxt(k,640)*y(k,246) & + + .910_r8*rxt(k,672)*y(k,290) + .460_r8*rxt(k,680)*y(k,291) & + + rxt(k,734)*y(k,305) + mat(k,2236) = .700_r8*rxt(k,731)*y(k,147) + rxt(k,732)*y(k,149) + rxt(k,728) & + *y(k,252) + rxt(k,729)*y(k,253) + .150_r8*rxt(k,730)*y(k,258) & + + rxt(k,733)*y(k,302) + rxt(k,734)*y(k,304) + rxt(k,735) & + *y(k,307) + mat(k,2821) = .120_r8*rxt(k,601)*y(k,238) + .110_r8*rxt(k,641)*y(k,246) & + + .910_r8*rxt(k,673)*y(k,290) + .460_r8*rxt(k,681)*y(k,291) & + + rxt(k,735)*y(k,305) + mat(k,1926) = -(rxt(k,360)*y(k,149) + rxt(k,361)*y(k,295)) + mat(k,3565) = -rxt(k,360)*y(k,50) + mat(k,4052) = -rxt(k,361)*y(k,50) + mat(k,619) = .380_r8*rxt(k,414)*y(k,295) + mat(k,632) = .030_r8*rxt(k,415)*y(k,295) + mat(k,1771) = rxt(k,362)*y(k,295) + mat(k,1874) = .460_r8*rxt(k,418)*y(k,295) + mat(k,925) = .700_r8*rxt(k,363)*y(k,295) + mat(k,916) = .500_r8*rxt(k,419)*y(k,295) + mat(k,506) = .400_r8*rxt(k,422)*y(k,295) + mat(k,774) = .720_r8*rxt(k,456)*y(k,295) + mat(k,2076) = .170_r8*rxt(k,459)*y(k,158) + mat(k,2108) = .170_r8*rxt(k,469)*y(k,158) + mat(k,1581) = .170_r8*rxt(k,484)*y(k,158) + mat(k,2015) = .880_r8*rxt(k,385)*y(k,158) + mat(k,2040) = .500_r8*rxt(k,403)*y(k,158) + mat(k,1500) = .440_r8*rxt(k,405)*y(k,295) + mat(k,2138) = .340_r8*rxt(k,501)*y(k,158) + mat(k,3069) = .170_r8*rxt(k,556)*y(k,254) + .710_r8*rxt(k,503)*y(k,260) & + + .140_r8*rxt(k,535)*y(k,284) + .170_r8*rxt(k,562)*y(k,287) & + + .240_r8*rxt(k,537)*y(k,289) + .120_r8*rxt(k,539)*y(k,293) & + + .400_r8*rxt(k,572)*y(k,314) + .540_r8*rxt(k,578)*y(k,316) & + + .510_r8*rxt(k,581)*y(k,318) + mat(k,1482) = rxt(k,364)*y(k,295) + mat(k,3721) = .170_r8*rxt(k,459)*y(k,115) + .170_r8*rxt(k,469)*y(k,118) & + + .170_r8*rxt(k,484)*y(k,121) + .880_r8*rxt(k,385)*y(k,126) & + + .500_r8*rxt(k,403)*y(k,132) + .340_r8*rxt(k,501)*y(k,139) + mat(k,2880) = .140_r8*rxt(k,381)*y(k,284) + .250_r8*rxt(k,400)*y(k,289) + mat(k,3422) = .120_r8*rxt(k,401)*y(k,289) + .500_r8*rxt(k,368)*y(k,298) + mat(k,907) = .170_r8*rxt(k,556)*y(k,147) + .070_r8*rxt(k,555)*y(k,258) + mat(k,3328) = .070_r8*rxt(k,555)*y(k,254) + .460_r8*rxt(k,421)*y(k,260) & + + .080_r8*rxt(k,383)*y(k,284) + .070_r8*rxt(k,561)*y(k,287) & + + .050_r8*rxt(k,402)*y(k,289) + .100_r8*rxt(k,499)*y(k,293) + mat(k,1303) = .710_r8*rxt(k,503)*y(k,147) + .460_r8*rxt(k,421)*y(k,258) + mat(k,1547) = .140_r8*rxt(k,535)*y(k,147) + .140_r8*rxt(k,381)*y(k,252) & + + .080_r8*rxt(k,383)*y(k,258) + mat(k,931) = .170_r8*rxt(k,562)*y(k,147) + .070_r8*rxt(k,561)*y(k,258) + mat(k,1512) = .240_r8*rxt(k,537)*y(k,147) + .250_r8*rxt(k,400)*y(k,252) & + + .120_r8*rxt(k,401)*y(k,253) + .050_r8*rxt(k,402)*y(k,258) + mat(k,1646) = .120_r8*rxt(k,539)*y(k,147) + .100_r8*rxt(k,499)*y(k,258) + mat(k,4052) = mat(k,4052) + .380_r8*rxt(k,414)*y(k,98) + .030_r8*rxt(k,415) & + *y(k,99) + rxt(k,362)*y(k,102) + .460_r8*rxt(k,418)*y(k,103) & + + .700_r8*rxt(k,363)*y(k,104) + .500_r8*rxt(k,419)*y(k,105) & + + .400_r8*rxt(k,422)*y(k,107) + .720_r8*rxt(k,456)*y(k,114) & + + .440_r8*rxt(k,405)*y(k,134) + rxt(k,364)*y(k,151) + mat(k,1339) = .500_r8*rxt(k,368)*y(k,253) + mat(k,877) = .400_r8*rxt(k,572)*y(k,147) + mat(k,899) = .540_r8*rxt(k,578)*y(k,147) + mat(k,538) = .510_r8*rxt(k,581)*y(k,147) + mat(k,791) = -(rxt(k,339)*y(k,295)) + mat(k,3960) = -rxt(k,339)*y(k,51) + mat(k,1382) = .120_r8*rxt(k,354)*y(k,158) + mat(k,3680) = .120_r8*rxt(k,354)*y(k,30) + mat(k,2857) = .100_r8*rxt(k,336)*y(k,253) + .150_r8*rxt(k,337)*y(k,258) + mat(k,3384) = .100_r8*rxt(k,336)*y(k,252) + mat(k,3253) = .150_r8*rxt(k,337)*y(k,252) + .150_r8*rxt(k,390)*y(k,286) + mat(k,1618) = .150_r8*rxt(k,390)*y(k,258) + mat(k,702) = -(rxt(k,340)*y(k,295)) + mat(k,3950) = -rxt(k,340)*y(k,52) + mat(k,2856) = .360_r8*rxt(k,337)*y(k,258) + mat(k,3245) = .360_r8*rxt(k,337)*y(k,252) + .360_r8*rxt(k,390)*y(k,286) + mat(k,1617) = .360_r8*rxt(k,390)*y(k,258) + mat(k,1494) = -(rxt(k,306)*y(k,295)) + mat(k,4024) = -rxt(k,306)*y(k,53) + mat(k,2291) = .050_r8*rxt(k,587)*y(k,253) + mat(k,2430) = .170_r8*rxt(k,595)*y(k,253) + mat(k,2210) = .050_r8*rxt(k,607)*y(k,253) + mat(k,2402) = .250_r8*rxt(k,615)*y(k,253) + mat(k,2529) = .030_r8*rxt(k,627)*y(k,253) + mat(k,1352) = .300_r8*rxt(k,325)*y(k,253) + mat(k,3398) = .050_r8*rxt(k,587)*y(k,237) + .170_r8*rxt(k,595)*y(k,238) & + + .050_r8*rxt(k,607)*y(k,240) + .250_r8*rxt(k,615)*y(k,241) & + + .030_r8*rxt(k,627)*y(k,245) + .300_r8*rxt(k,325)*y(k,249) & + + 2.000_r8*rxt(k,303)*y(k,253) + .250_r8*rxt(k,431)*y(k,262) & + + .250_r8*rxt(k,445)*y(k,267) + .250_r8*rxt(k,449)*y(k,268) & + + .360_r8*rxt(k,475)*y(k,274) + .250_r8*rxt(k,492)*y(k,278) & + + .250_r8*rxt(k,496)*y(k,279) + .090_r8*rxt(k,646)*y(k,281) & + + .250_r8*rxt(k,655)*y(k,282) + .250_r8*rxt(k,401)*y(k,289) & + + .050_r8*rxt(k,666)*y(k,290) + .250_r8*rxt(k,675)*y(k,291) & + + .500_r8*rxt(k,368)*y(k,298) + .250_r8*rxt(k,694)*y(k,301) + mat(k,1976) = .250_r8*rxt(k,431)*y(k,253) + mat(k,1728) = .250_r8*rxt(k,445)*y(k,253) + mat(k,1751) = .250_r8*rxt(k,449)*y(k,253) + mat(k,2163) = .360_r8*rxt(k,475)*y(k,253) + mat(k,1842) = .250_r8*rxt(k,492)*y(k,253) + mat(k,1811) = .250_r8*rxt(k,496)*y(k,253) + mat(k,2497) = .090_r8*rxt(k,646)*y(k,253) + mat(k,2333) = .250_r8*rxt(k,655)*y(k,253) + mat(k,1506) = .250_r8*rxt(k,401)*y(k,253) + mat(k,2560) = .050_r8*rxt(k,666)*y(k,253) + mat(k,2462) = .250_r8*rxt(k,675)*y(k,253) + mat(k,1337) = .500_r8*rxt(k,368)*y(k,253) + mat(k,2649) = .250_r8*rxt(k,694)*y(k,253) + mat(k,449) = -(rxt(k,307)*y(k,295)) + mat(k,3918) = -rxt(k,307)*y(k,54) + mat(k,3382) = rxt(k,304)*y(k,258) + mat(k,3232) = rxt(k,304)*y(k,253) + mat(k,2259) = -(rxt(k,219)*y(k,57) + rxt(k,275)*y(k,75) + rxt(k,308)*y(k,295) & + + (rxt(k,315) + rxt(k,316) + rxt(k,317)) * y(k,294)) + mat(k,3834) = -rxt(k,219)*y(k,55) + mat(k,1244) = -rxt(k,275)*y(k,55) + mat(k,4064) = -rxt(k,308)*y(k,55) + mat(k,3794) = -(rxt(k,315) + rxt(k,316) + rxt(k,317)) * y(k,55) + mat(k,1391) = .100_r8*rxt(k,354)*y(k,158) + mat(k,3733) = .100_r8*rxt(k,354)*y(k,30) + mat(k,462) = -(rxt(k,271)*y(k,294) + rxt(k,288)*y(k,57) + rxt(k,289)*y(k,295)) + mat(k,3787) = -rxt(k,271)*y(k,56) + mat(k,3816) = -rxt(k,288)*y(k,56) + mat(k,3920) = -rxt(k,289)*y(k,56) + mat(k,3850) = -(rxt(k,218)*y(k,43) + rxt(k,219)*y(k,55) + rxt(k,220)*y(k,79) & + + rxt(k,221)*y(k,81) + (rxt(k,222) + rxt(k,223)) * y(k,258) & + + rxt(k,224)*y(k,158) + rxt(k,231)*y(k,61) + rxt(k,240)*y(k,96) & + + rxt(k,281)*y(k,42) + rxt(k,283)*y(k,44) + rxt(k,286)*y(k,47) & + + rxt(k,288)*y(k,56) + rxt(k,330)*y(k,29)) + mat(k,3197) = -rxt(k,218)*y(k,57) + mat(k,2269) = -rxt(k,219)*y(k,57) + mat(k,1682) = -rxt(k,220)*y(k,57) + mat(k,1491) = -rxt(k,221)*y(k,57) + mat(k,3377) = -(rxt(k,222) + rxt(k,223)) * y(k,57) + mat(k,3768) = -rxt(k,224)*y(k,57) + mat(k,1332) = -rxt(k,231)*y(k,57) + mat(k,1163) = -rxt(k,240)*y(k,57) + mat(k,499) = -rxt(k,281)*y(k,57) + mat(k,652) = -rxt(k,283)*y(k,57) + mat(k,398) = -rxt(k,286)*y(k,57) + mat(k,466) = -rxt(k,288)*y(k,57) + mat(k,319) = -rxt(k,330)*y(k,57) + mat(k,3494) = rxt(k,259)*y(k,60) + mat(k,122) = 4.000_r8*rxt(k,243)*y(k,294) + mat(k,163) = rxt(k,244)*y(k,294) + mat(k,137) = 2.000_r8*rxt(k,245)*y(k,294) + mat(k,173) = 2.000_r8*rxt(k,246)*y(k,294) + mat(k,141) = 2.000_r8*rxt(k,247)*y(k,294) + mat(k,178) = rxt(k,248)*y(k,294) + mat(k,145) = 2.000_r8*rxt(k,249)*y(k,294) + mat(k,147) = 3.000_r8*rxt(k,285)*y(k,295) + mat(k,398) = mat(k,398) + rxt(k,287)*y(k,295) + mat(k,3520) = rxt(k,259)*y(k,20) + (4.000_r8*rxt(k,226)+2.000_r8*rxt(k,228)) & + *y(k,60) + rxt(k,230)*y(k,147) + rxt(k,235)*y(k,157) & + + rxt(k,801)*y(k,174) + rxt(k,225)*y(k,253) + rxt(k,236) & + *y(k,295) + mat(k,259) = rxt(k,280)*y(k,294) + mat(k,254) = rxt(k,295)*y(k,294) + rxt(k,290)*y(k,295) + mat(k,264) = rxt(k,296)*y(k,294) + rxt(k,291)*y(k,295) + mat(k,329) = rxt(k,297)*y(k,294) + rxt(k,292)*y(k,295) + mat(k,3140) = rxt(k,238)*y(k,157) + rxt(k,250)*y(k,294) + rxt(k,239)*y(k,295) + mat(k,3118) = rxt(k,230)*y(k,60) + mat(k,3171) = rxt(k,235)*y(k,60) + rxt(k,238)*y(k,87) + mat(k,1610) = rxt(k,801)*y(k,60) + mat(k,3470) = rxt(k,225)*y(k,60) + mat(k,3809) = 4.000_r8*rxt(k,243)*y(k,34) + rxt(k,244)*y(k,35) & + + 2.000_r8*rxt(k,245)*y(k,37) + 2.000_r8*rxt(k,246)*y(k,38) & + + 2.000_r8*rxt(k,247)*y(k,39) + rxt(k,248)*y(k,40) & + + 2.000_r8*rxt(k,249)*y(k,41) + rxt(k,280)*y(k,66) + rxt(k,295) & + *y(k,84) + rxt(k,296)*y(k,85) + rxt(k,297)*y(k,86) + rxt(k,250) & + *y(k,87) + mat(k,4100) = 3.000_r8*rxt(k,285)*y(k,45) + rxt(k,287)*y(k,47) + rxt(k,236) & + *y(k,60) + rxt(k,290)*y(k,84) + rxt(k,291)*y(k,85) + rxt(k,292) & + *y(k,86) + rxt(k,239)*y(k,87) + 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,3812) = rxt(k,231)*y(k,61) + mat(k,3498) = 2.000_r8*rxt(k,227)*y(k,60) + mat(k,1323) = rxt(k,231)*y(k,57) + (rxt(k,890)+rxt(k,895)+rxt(k,900))*y(k,87) + mat(k,3121) = (rxt(k,890)+rxt(k,895)+rxt(k,900))*y(k,61) + (rxt(k,885) & + +rxt(k,891)+rxt(k,896))*y(k,96) + mat(k,1158) = (rxt(k,885)+rxt(k,891)+rxt(k,896))*y(k,87) + mat(k,3497) = 2.000_r8*rxt(k,252)*y(k,60) + mat(k,3515) = -(rxt(k,225)*y(k,253) + (4._r8*rxt(k,226) + 4._r8*rxt(k,227) & + + 4._r8*rxt(k,228) + 4._r8*rxt(k,252)) * y(k,60) + rxt(k,229) & + *y(k,258) + rxt(k,230)*y(k,147) + rxt(k,232)*y(k,148) + rxt(k,235) & + *y(k,157) + (rxt(k,236) + rxt(k,237)) * y(k,295) + (rxt(k,258) & + + rxt(k,259) + rxt(k,260)) * y(k,20) + rxt(k,801)*y(k,174)) + mat(k,3465) = -rxt(k,225)*y(k,60) + mat(k,3372) = -rxt(k,229)*y(k,60) + mat(k,3113) = -rxt(k,230)*y(k,60) + mat(k,3661) = -rxt(k,232)*y(k,60) + mat(k,3166) = -rxt(k,235)*y(k,60) + mat(k,4095) = -(rxt(k,236) + rxt(k,237)) * y(k,60) + mat(k,3489) = -(rxt(k,258) + rxt(k,259) + rxt(k,260)) * y(k,60) + mat(k,1607) = -rxt(k,801)*y(k,60) + mat(k,3845) = rxt(k,240)*y(k,96) + rxt(k,224)*y(k,158) + rxt(k,223)*y(k,258) + mat(k,1329) = rxt(k,233)*y(k,157) + mat(k,3135) = rxt(k,251)*y(k,294) + mat(k,1162) = rxt(k,240)*y(k,57) + rxt(k,241)*y(k,157) + rxt(k,242)*y(k,295) + mat(k,3166) = mat(k,3166) + rxt(k,233)*y(k,61) + rxt(k,241)*y(k,96) + mat(k,3763) = rxt(k,224)*y(k,57) + mat(k,346) = rxt(k,806)*y(k,174) + mat(k,1607) = mat(k,1607) + rxt(k,806)*y(k,160) + mat(k,3372) = mat(k,3372) + rxt(k,223)*y(k,57) + mat(k,3804) = rxt(k,251)*y(k,87) + mat(k,4095) = mat(k,4095) + rxt(k,242)*y(k,96) + mat(k,1325) = -(rxt(k,231)*y(k,57) + rxt(k,233)*y(k,157) + rxt(k,234) & + *y(k,295) + (rxt(k,890) + rxt(k,895) + rxt(k,900)) * y(k,87)) + mat(k,3822) = -rxt(k,231)*y(k,61) + mat(k,3150) = -rxt(k,233)*y(k,61) + mat(k,4009) = -rxt(k,234)*y(k,61) + mat(k,3125) = -(rxt(k,890) + rxt(k,895) + rxt(k,900)) * y(k,61) + mat(k,3503) = rxt(k,232)*y(k,148) + mat(k,3637) = rxt(k,232)*y(k,60) + mat(k,2057) = -(rxt(k,319)*y(k,295)) + mat(k,4057) = -rxt(k,319)*y(k,63) + mat(k,1276) = .170_r8*rxt(k,602)*y(k,158) + mat(k,2198) = rxt(k,254)*y(k,43) + mat(k,313) = .350_r8*rxt(k,321)*y(k,295) + mat(k,588) = .630_r8*rxt(k,323)*y(k,158) + mat(k,1390) = .560_r8*rxt(k,354)*y(k,158) + mat(k,3180) = rxt(k,254)*y(k,18) + rxt(k,218)*y(k,57) + rxt(k,299)*y(k,149) & + + rxt(k,300)*y(k,157) + rxt(k,301)*y(k,295) + mat(k,394) = rxt(k,286)*y(k,57) + mat(k,1927) = rxt(k,360)*y(k,149) + rxt(k,361)*y(k,295) + mat(k,3832) = rxt(k,218)*y(k,43) + rxt(k,286)*y(k,47) + mat(k,642) = rxt(k,376)*y(k,295) + mat(k,1478) = rxt(k,346)*y(k,295) + mat(k,885) = .110_r8*rxt(k,347)*y(k,295) + mat(k,621) = 1.060_r8*rxt(k,414)*y(k,295) + mat(k,634) = .760_r8*rxt(k,415)*y(k,295) + mat(k,492) = .420_r8*rxt(k,416)*y(k,295) + mat(k,525) = .230_r8*rxt(k,417)*y(k,295) + mat(k,1875) = rxt(k,418)*y(k,295) + mat(k,917) = 1.500_r8*rxt(k,419)*y(k,295) + mat(k,1259) = .350_r8*rxt(k,423)*y(k,295) + mat(k,1421) = .350_r8*rxt(k,486)*y(k,158) + mat(k,1117) = rxt(k,452)*y(k,295) + mat(k,1796) = rxt(k,454)*y(k,295) + mat(k,775) = 2.000_r8*rxt(k,456)*y(k,295) + mat(k,2077) = .060_r8*rxt(k,460)*y(k,295) + mat(k,2109) = .040_r8*rxt(k,470)*y(k,295) + mat(k,2017) = .650_r8*rxt(k,385)*y(k,158) + mat(k,1780) = rxt(k,380)*y(k,295) + mat(k,1464) = rxt(k,387)*y(k,295) + mat(k,531) = .250_r8*rxt(k,398)*y(k,295) + mat(k,2042) = .560_r8*rxt(k,403)*y(k,158) + mat(k,1918) = .500_r8*rxt(k,399)*y(k,295) + mat(k,1501) = 1.560_r8*rxt(k,405)*y(k,295) + mat(k,2139) = .300_r8*rxt(k,501)*y(k,158) + .630_r8*rxt(k,502)*y(k,295) + mat(k,3074) = .170_r8*rxt(k,556)*y(k,254) + .400_r8*rxt(k,503)*y(k,260) & + + .550_r8*rxt(k,509)*y(k,267) + .550_r8*rxt(k,511)*y(k,268) & + + .550_r8*rxt(k,530)*y(k,278) + .550_r8*rxt(k,533)*y(k,279) & + + .860_r8*rxt(k,535)*y(k,284) + .400_r8*rxt(k,559)*y(k,285) & + + .650_r8*rxt(k,392)*y(k,286) + .350_r8*rxt(k,562)*y(k,287) & + + .750_r8*rxt(k,539)*y(k,293) + .910_r8*rxt(k,741)*y(k,306) + mat(k,3570) = rxt(k,299)*y(k,43) + rxt(k,360)*y(k,50) + .650_r8*rxt(k,393) & + *y(k,286) + rxt(k,742)*y(k,306) + mat(k,3154) = rxt(k,300)*y(k,43) + rxt(k,795)*y(k,161) + mat(k,3726) = .170_r8*rxt(k,602)*y(k,4) + .630_r8*rxt(k,323)*y(k,26) & + + .560_r8*rxt(k,354)*y(k,30) + .350_r8*rxt(k,486)*y(k,109) & + + .650_r8*rxt(k,385)*y(k,126) + .560_r8*rxt(k,403)*y(k,132) & + + .300_r8*rxt(k,501)*y(k,139) + mat(k,389) = rxt(k,795)*y(k,157) + rxt(k,796)*y(k,295) + mat(k,657) = 2.000_r8*rxt(k,718)*y(k,295) + mat(k,666) = rxt(k,737)*y(k,295) + mat(k,425) = rxt(k,757)*y(k,295) + mat(k,2885) = .550_r8*rxt(k,444)*y(k,267) + .550_r8*rxt(k,448)*y(k,268) & + + .550_r8*rxt(k,491)*y(k,278) + .550_r8*rxt(k,495)*y(k,279) & + + .860_r8*rxt(k,381)*y(k,284) + .650_r8*rxt(k,388)*y(k,286) & + + rxt(k,738)*y(k,306) + mat(k,3427) = .280_r8*rxt(k,445)*y(k,267) + .280_r8*rxt(k,449)*y(k,268) & + + .280_r8*rxt(k,492)*y(k,278) + .280_r8*rxt(k,496)*y(k,279) & + + .900_r8*rxt(k,382)*y(k,284) + .650_r8*rxt(k,389)*y(k,286) & + + rxt(k,401)*y(k,289) + rxt(k,739)*y(k,306) + mat(k,908) = .170_r8*rxt(k,556)*y(k,147) + .070_r8*rxt(k,555)*y(k,258) + mat(k,3333) = .070_r8*rxt(k,555)*y(k,254) + .260_r8*rxt(k,421)*y(k,260) & + + .510_r8*rxt(k,383)*y(k,284) + .160_r8*rxt(k,558)*y(k,285) & + + .320_r8*rxt(k,390)*y(k,286) + .140_r8*rxt(k,561)*y(k,287) & + + .260_r8*rxt(k,402)*y(k,289) + .600_r8*rxt(k,499)*y(k,293) & + + .530_r8*rxt(k,740)*y(k,306) + mat(k,1304) = .400_r8*rxt(k,503)*y(k,147) + .260_r8*rxt(k,421)*y(k,258) + mat(k,1738) = .550_r8*rxt(k,509)*y(k,147) + .550_r8*rxt(k,444)*y(k,252) & + + .280_r8*rxt(k,445)*y(k,253) + mat(k,1760) = .550_r8*rxt(k,511)*y(k,147) + .550_r8*rxt(k,448)*y(k,252) & + + .280_r8*rxt(k,449)*y(k,253) + mat(k,1855) = .550_r8*rxt(k,530)*y(k,147) + .550_r8*rxt(k,491)*y(k,252) & + + .280_r8*rxt(k,492)*y(k,253) + mat(k,1823) = .550_r8*rxt(k,533)*y(k,147) + .550_r8*rxt(k,495)*y(k,252) & + + .280_r8*rxt(k,496)*y(k,253) + mat(k,1548) = .860_r8*rxt(k,535)*y(k,147) + .860_r8*rxt(k,381)*y(k,252) & + + .900_r8*rxt(k,382)*y(k,253) + .510_r8*rxt(k,383)*y(k,258) + mat(k,864) = .400_r8*rxt(k,559)*y(k,147) + .160_r8*rxt(k,558)*y(k,258) + mat(k,1622) = .650_r8*rxt(k,392)*y(k,147) + .650_r8*rxt(k,393)*y(k,149) & + + .650_r8*rxt(k,388)*y(k,252) + .650_r8*rxt(k,389)*y(k,253) & + + .320_r8*rxt(k,390)*y(k,258) + 2.600_r8*rxt(k,391)*y(k,286) + mat(k,932) = .350_r8*rxt(k,562)*y(k,147) + .140_r8*rxt(k,561)*y(k,258) + mat(k,1513) = rxt(k,401)*y(k,253) + .260_r8*rxt(k,402)*y(k,258) + mat(k,1647) = .750_r8*rxt(k,539)*y(k,147) + .600_r8*rxt(k,499)*y(k,258) + mat(k,4057) = mat(k,4057) + .350_r8*rxt(k,321)*y(k,25) + rxt(k,301)*y(k,43) & + + rxt(k,361)*y(k,50) + rxt(k,376)*y(k,68) + rxt(k,346)*y(k,77) & + + .110_r8*rxt(k,347)*y(k,89) + 1.060_r8*rxt(k,414)*y(k,98) & + + .760_r8*rxt(k,415)*y(k,99) + .420_r8*rxt(k,416)*y(k,100) & + + .230_r8*rxt(k,417)*y(k,101) + rxt(k,418)*y(k,103) & + + 1.500_r8*rxt(k,419)*y(k,105) + .350_r8*rxt(k,423)*y(k,108) & + + rxt(k,452)*y(k,111) + rxt(k,454)*y(k,112) & + + 2.000_r8*rxt(k,456)*y(k,114) + .060_r8*rxt(k,460)*y(k,115) & + + .040_r8*rxt(k,470)*y(k,118) + rxt(k,380)*y(k,127) + rxt(k,387) & + *y(k,128) + .250_r8*rxt(k,398)*y(k,131) + .500_r8*rxt(k,399) & + *y(k,133) + 1.560_r8*rxt(k,405)*y(k,134) + .630_r8*rxt(k,502) & + *y(k,139) + rxt(k,796)*y(k,161) + 2.000_r8*rxt(k,718)*y(k,204) & + + rxt(k,737)*y(k,206) + rxt(k,757)*y(k,210) + mat(k,2725) = rxt(k,743)*y(k,306) + mat(k,2771) = rxt(k,744)*y(k,306) + mat(k,2674) = .910_r8*rxt(k,741)*y(k,147) + rxt(k,742)*y(k,149) + rxt(k,738) & + *y(k,252) + rxt(k,739)*y(k,253) + .530_r8*rxt(k,740)*y(k,258) & + + rxt(k,743)*y(k,302) + rxt(k,744)*y(k,304) + rxt(k,745) & + *y(k,307) + mat(k,2818) = rxt(k,745)*y(k,306) + mat(k,1098) = .190_r8*rxt(k,642)*y(k,158) + mat(k,1388) = .200_r8*rxt(k,354)*y(k,158) + mat(k,792) = rxt(k,339)*y(k,295) + mat(k,703) = .500_r8*rxt(k,340)*y(k,295) + mat(k,2056) = rxt(k,319)*y(k,295) + mat(k,1711) = .800_r8*rxt(k,345)*y(k,295) + mat(k,1477) = rxt(k,346)*y(k,295) + mat(k,1378) = rxt(k,310)*y(k,295) + mat(k,618) = .540_r8*rxt(k,414)*y(k,295) + mat(k,631) = .540_r8*rxt(k,415)*y(k,295) + mat(k,1868) = .360_r8*rxt(k,418)*y(k,295) + mat(k,1254) = .190_r8*rxt(k,423)*y(k,295) + mat(k,1412) = .420_r8*rxt(k,486)*y(k,158) + mat(k,2036) = .100_r8*rxt(k,403)*y(k,158) + mat(k,2130) = .450_r8*rxt(k,502)*y(k,295) + mat(k,3051) = rxt(k,338)*y(k,252) + rxt(k,392)*y(k,286) + rxt(k,704)*y(k,302) & + + rxt(k,722)*y(k,304) + rxt(k,752)*y(k,307) + mat(k,3551) = rxt(k,393)*y(k,286) + rxt(k,705)*y(k,302) + rxt(k,723)*y(k,304) & + + rxt(k,753)*y(k,307) + mat(k,1455) = rxt(k,348)*y(k,295) + mat(k,3706) = .190_r8*rxt(k,642)*y(k,17) + .200_r8*rxt(k,354)*y(k,30) & + + .420_r8*rxt(k,486)*y(k,109) + .100_r8*rxt(k,403)*y(k,132) + mat(k,656) = 2.000_r8*rxt(k,718)*y(k,295) + mat(k,665) = 3.000_r8*rxt(k,737)*y(k,295) + mat(k,779) = .290_r8*rxt(k,748)*y(k,295) + mat(k,364) = .290_r8*rxt(k,746)*y(k,295) + mat(k,369) = .290_r8*rxt(k,747)*y(k,295) + mat(k,2294) = rxt(k,586)*y(k,252) + rxt(k,591)*y(k,302) + rxt(k,592)*y(k,304) & + + rxt(k,593)*y(k,307) + mat(k,2433) = rxt(k,594)*y(k,252) + rxt(k,599)*y(k,302) + rxt(k,600)*y(k,304) & + + rxt(k,601)*y(k,307) + mat(k,2211) = rxt(k,606)*y(k,252) + rxt(k,611)*y(k,302) + rxt(k,612)*y(k,304) & + + rxt(k,613)*y(k,307) + mat(k,2404) = rxt(k,614)*y(k,252) + rxt(k,619)*y(k,302) + rxt(k,620)*y(k,304) & + + rxt(k,621)*y(k,307) + mat(k,2532) = rxt(k,626)*y(k,252) + rxt(k,631)*y(k,302) + rxt(k,632)*y(k,304) & + + rxt(k,633)*y(k,307) + mat(k,2372) = rxt(k,634)*y(k,252) + rxt(k,639)*y(k,302) + rxt(k,640)*y(k,304) & + + rxt(k,641)*y(k,307) + mat(k,2865) = rxt(k,338)*y(k,147) + rxt(k,586)*y(k,237) + rxt(k,594)*y(k,238) & + + rxt(k,606)*y(k,240) + rxt(k,614)*y(k,241) + rxt(k,626) & + *y(k,245) + rxt(k,634)*y(k,246) + 4.000_r8*rxt(k,335)*y(k,252) & + + .900_r8*rxt(k,336)*y(k,253) + .490_r8*rxt(k,337)*y(k,258) & + + rxt(k,424)*y(k,261) + rxt(k,430)*y(k,262) + rxt(k,444) & + *y(k,267) + rxt(k,448)*y(k,268) + rxt(k,474)*y(k,274) & + + rxt(k,491)*y(k,278) + rxt(k,495)*y(k,279) + rxt(k,645) & + *y(k,281) + rxt(k,654)*y(k,282) + rxt(k,381)*y(k,284) & + + 2.000_r8*rxt(k,388)*y(k,286) + rxt(k,400)*y(k,289) & + + rxt(k,665)*y(k,290) + rxt(k,674)*y(k,291) + rxt(k,693) & + *y(k,301) + 2.000_r8*rxt(k,701)*y(k,302) + rxt(k,709)*y(k,303) & + + 2.000_r8*rxt(k,719)*y(k,304) + rxt(k,728)*y(k,305) & + + rxt(k,738)*y(k,306) + 2.000_r8*rxt(k,749)*y(k,307) + mat(k,3404) = .900_r8*rxt(k,336)*y(k,252) + rxt(k,389)*y(k,286) + rxt(k,702) & + *y(k,302) + rxt(k,720)*y(k,304) + rxt(k,750)*y(k,307) + mat(k,3309) = .490_r8*rxt(k,337)*y(k,252) + .490_r8*rxt(k,390)*y(k,286) & + + .490_r8*rxt(k,703)*y(k,302) + .490_r8*rxt(k,721)*y(k,304) & + + .490_r8*rxt(k,751)*y(k,307) + mat(k,1941) = rxt(k,424)*y(k,252) + mat(k,1978) = rxt(k,430)*y(k,252) + mat(k,1730) = rxt(k,444)*y(k,252) + mat(k,1752) = rxt(k,448)*y(k,252) + mat(k,2165) = rxt(k,474)*y(k,252) + mat(k,1845) = rxt(k,491)*y(k,252) + mat(k,1813) = rxt(k,495)*y(k,252) + mat(k,2500) = rxt(k,645)*y(k,252) + rxt(k,651)*y(k,302) + rxt(k,652)*y(k,304) & + + rxt(k,653)*y(k,307) + mat(k,2334) = rxt(k,654)*y(k,252) + rxt(k,659)*y(k,302) + rxt(k,660)*y(k,304) & + + rxt(k,661)*y(k,307) + mat(k,1544) = rxt(k,381)*y(k,252) + mat(k,1619) = rxt(k,392)*y(k,147) + rxt(k,393)*y(k,149) + 2.000_r8*rxt(k,388) & + *y(k,252) + rxt(k,389)*y(k,253) + .490_r8*rxt(k,390)*y(k,258) & + + 4.000_r8*rxt(k,391)*y(k,286) + mat(k,1509) = rxt(k,400)*y(k,252) + mat(k,2563) = rxt(k,665)*y(k,252) + rxt(k,671)*y(k,302) + rxt(k,672)*y(k,304) & + + rxt(k,673)*y(k,307) + mat(k,2464) = rxt(k,674)*y(k,252) + rxt(k,679)*y(k,302) + rxt(k,680)*y(k,304) & + + rxt(k,681)*y(k,307) + mat(k,4033) = rxt(k,339)*y(k,51) + .500_r8*rxt(k,340)*y(k,52) + rxt(k,319) & + *y(k,63) + .800_r8*rxt(k,345)*y(k,76) + rxt(k,346)*y(k,77) & + + rxt(k,310)*y(k,90) + .540_r8*rxt(k,414)*y(k,98) & + + .540_r8*rxt(k,415)*y(k,99) + .360_r8*rxt(k,418)*y(k,103) & + + .190_r8*rxt(k,423)*y(k,108) + .450_r8*rxt(k,502)*y(k,139) & + + rxt(k,348)*y(k,150) + 2.000_r8*rxt(k,718)*y(k,204) & + + 3.000_r8*rxt(k,737)*y(k,206) + .290_r8*rxt(k,748)*y(k,207) & + + .290_r8*rxt(k,746)*y(k,208) + .290_r8*rxt(k,747)*y(k,209) + mat(k,2651) = rxt(k,693)*y(k,252) + rxt(k,698)*y(k,302) + rxt(k,699)*y(k,304) & + + rxt(k,700)*y(k,307) + mat(k,2721) = rxt(k,704)*y(k,147) + rxt(k,705)*y(k,149) + rxt(k,591)*y(k,237) & + + rxt(k,599)*y(k,238) + rxt(k,611)*y(k,240) + rxt(k,619) & + *y(k,241) + rxt(k,631)*y(k,245) + rxt(k,639)*y(k,246) & + + 2.000_r8*rxt(k,701)*y(k,252) + rxt(k,702)*y(k,253) & + + .490_r8*rxt(k,703)*y(k,258) + rxt(k,651)*y(k,281) + rxt(k,659) & + *y(k,282) + rxt(k,671)*y(k,290) + rxt(k,679)*y(k,291) & + + rxt(k,698)*y(k,301) + 4.000_r8*rxt(k,706)*y(k,302) & + + rxt(k,714)*y(k,303) + 2.000_r8*rxt(k,724)*y(k,304) & + + rxt(k,733)*y(k,305) + rxt(k,743)*y(k,306) & + + 2.000_r8*rxt(k,707)*y(k,307) + mat(k,2694) = rxt(k,709)*y(k,252) + rxt(k,714)*y(k,302) + rxt(k,715)*y(k,304) & + + rxt(k,716)*y(k,307) + mat(k,2767) = rxt(k,722)*y(k,147) + rxt(k,723)*y(k,149) + rxt(k,592)*y(k,237) & + + rxt(k,600)*y(k,238) + rxt(k,612)*y(k,240) + rxt(k,620) & + *y(k,241) + rxt(k,632)*y(k,245) + rxt(k,640)*y(k,246) & + + 2.000_r8*rxt(k,719)*y(k,252) + rxt(k,720)*y(k,253) & + + .490_r8*rxt(k,721)*y(k,258) + rxt(k,652)*y(k,281) + rxt(k,660) & + *y(k,282) + rxt(k,672)*y(k,290) + rxt(k,680)*y(k,291) & + + rxt(k,699)*y(k,301) + 2.000_r8*rxt(k,724)*y(k,302) & + + rxt(k,715)*y(k,303) + 4.000_r8*rxt(k,725)*y(k,304) & + + rxt(k,734)*y(k,305) + rxt(k,744)*y(k,306) & + + 2.000_r8*rxt(k,726)*y(k,307) + mat(k,2232) = rxt(k,728)*y(k,252) + rxt(k,733)*y(k,302) + rxt(k,734)*y(k,304) & + + rxt(k,735)*y(k,307) + mat(k,2672) = rxt(k,738)*y(k,252) + rxt(k,743)*y(k,302) + rxt(k,744)*y(k,304) & + + rxt(k,745)*y(k,307) + mat(k,2814) = rxt(k,752)*y(k,147) + rxt(k,753)*y(k,149) + rxt(k,593)*y(k,237) & + + rxt(k,601)*y(k,238) + rxt(k,613)*y(k,240) + rxt(k,621) & + *y(k,241) + rxt(k,633)*y(k,245) + rxt(k,641)*y(k,246) & + + 2.000_r8*rxt(k,749)*y(k,252) + rxt(k,750)*y(k,253) & + + .490_r8*rxt(k,751)*y(k,258) + rxt(k,653)*y(k,281) + rxt(k,661) & + *y(k,282) + rxt(k,673)*y(k,290) + rxt(k,681)*y(k,291) & + + rxt(k,700)*y(k,301) + 2.000_r8*rxt(k,707)*y(k,302) & + + rxt(k,716)*y(k,303) + 2.000_r8*rxt(k,726)*y(k,304) & + + rxt(k,735)*y(k,305) + rxt(k,745)*y(k,306) & + + 4.000_r8*rxt(k,754)*y(k,307) + 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,248) = -(rxt(k,279)*y(k,294)) + mat(k,3782) = -rxt(k,279)*y(k,65) + mat(k,160) = rxt(k,244)*y(k,294) + mat(k,165) = rxt(k,270)*y(k,294) + mat(k,170) = rxt(k,246)*y(k,294) + mat(k,139) = 2.000_r8*rxt(k,247)*y(k,294) + mat(k,175) = 2.000_r8*rxt(k,248)*y(k,294) + mat(k,143) = rxt(k,249)*y(k,294) + mat(k,127) = 2.000_r8*rxt(k,272)*y(k,294) + mat(k,260) = rxt(k,296)*y(k,294) + rxt(k,291)*y(k,295) + mat(k,325) = rxt(k,297)*y(k,294) + rxt(k,292)*y(k,295) + mat(k,3782) = mat(k,3782) + rxt(k,244)*y(k,35) + rxt(k,270)*y(k,36) & + + rxt(k,246)*y(k,38) + 2.000_r8*rxt(k,247)*y(k,39) & + + 2.000_r8*rxt(k,248)*y(k,40) + rxt(k,249)*y(k,41) & + + 2.000_r8*rxt(k,272)*y(k,80) + rxt(k,296)*y(k,85) + rxt(k,297) & + *y(k,86) + mat(k,3886) = rxt(k,291)*y(k,85) + rxt(k,292)*y(k,86) + mat(k,256) = -(rxt(k,280)*y(k,294)) + mat(k,3784) = -rxt(k,280)*y(k,66) + mat(k,135) = rxt(k,245)*y(k,294) + mat(k,171) = rxt(k,246)*y(k,294) + mat(k,252) = rxt(k,295)*y(k,294) + rxt(k,290)*y(k,295) + mat(k,3784) = mat(k,3784) + rxt(k,245)*y(k,37) + rxt(k,246)*y(k,38) & + + rxt(k,295)*y(k,84) + mat(k,3888) = rxt(k,290)*y(k,84) + mat(k,218) = -(rxt(k,554)*y(k,295)) + mat(k,3881) = -rxt(k,554)*y(k,67) + mat(k,212) = .180_r8*rxt(k,574)*y(k,295) + mat(k,3881) = mat(k,3881) + .180_r8*rxt(k,574)*y(k,228) + mat(k,639) = -(rxt(k,376)*y(k,295)) + mat(k,3943) = -rxt(k,376)*y(k,68) + mat(k,614) = .070_r8*rxt(k,414)*y(k,295) + mat(k,627) = .170_r8*rxt(k,415)*y(k,295) + mat(k,3943) = mat(k,3943) + .070_r8*rxt(k,414)*y(k,98) + .170_r8*rxt(k,415) & + *y(k,99) + mat(k,304) = -(rxt(k,793)*y(k,149) + (rxt(k,794) + rxt(k,808)) * y(k,295)) + mat(k,3526) = -rxt(k,793)*y(k,69) + mat(k,3897) = -(rxt(k,794) + rxt(k,808)) * y(k,69) + mat(k,853) = rxt(k,341)*y(k,258) + mat(k,3216) = rxt(k,341)*y(k,257) + mat(k,1242) = -(rxt(k,275)*y(k,55) + rxt(k,276)*y(k,79) + rxt(k,277)*y(k,319) & + + rxt(k,278)*y(k,93)) + mat(k,2255) = -rxt(k,275)*y(k,75) + mat(k,1672) = -rxt(k,276)*y(k,75) + mat(k,4107) = -rxt(k,277)*y(k,75) + mat(k,2945) = -rxt(k,278)*y(k,75) + mat(k,166) = rxt(k,270)*y(k,294) + mat(k,176) = rxt(k,248)*y(k,294) + mat(k,249) = 2.000_r8*rxt(k,279)*y(k,294) + mat(k,257) = rxt(k,280)*y(k,294) + mat(k,3791) = rxt(k,270)*y(k,36) + rxt(k,248)*y(k,40) + 2.000_r8*rxt(k,279) & + *y(k,65) + rxt(k,280)*y(k,66) + mat(k,1712) = -(rxt(k,345)*y(k,295)) + mat(k,4040) = -rxt(k,345)*y(k,76) + mat(k,2070) = .830_r8*rxt(k,459)*y(k,158) + mat(k,920) = rxt(k,488)*y(k,295) + mat(k,1892) = .070_r8*rxt(k,490)*y(k,295) + mat(k,3057) = .570_r8*rxt(k,503)*y(k,260) + .940_r8*rxt(k,513)*y(k,269) & + + .730_r8*rxt(k,515)*y(k,270) + .340_r8*rxt(k,521)*y(k,273) & + + .400_r8*rxt(k,525)*y(k,275) + .760_r8*rxt(k,537)*y(k,289) + mat(k,3709) = .830_r8*rxt(k,459)*y(k,115) + mat(k,2869) = .750_r8*rxt(k,400)*y(k,289) + mat(k,3410) = .380_r8*rxt(k,401)*y(k,289) + mat(k,3316) = .370_r8*rxt(k,421)*y(k,260) + .550_r8*rxt(k,457)*y(k,269) & + + .460_r8*rxt(k,461)*y(k,270) + .150_r8*rxt(k,471)*y(k,273) & + + .280_r8*rxt(k,479)*y(k,275) + .360_r8*rxt(k,402)*y(k,289) + mat(k,1300) = .570_r8*rxt(k,503)*y(k,147) + .370_r8*rxt(k,421)*y(k,258) + mat(k,1125) = .940_r8*rxt(k,513)*y(k,147) + .550_r8*rxt(k,457)*y(k,258) + mat(k,1169) = .730_r8*rxt(k,515)*y(k,147) + .460_r8*rxt(k,461)*y(k,258) + mat(k,1445) = .340_r8*rxt(k,521)*y(k,147) + .150_r8*rxt(k,471)*y(k,258) + mat(k,1314) = .400_r8*rxt(k,525)*y(k,147) + .280_r8*rxt(k,479)*y(k,258) + mat(k,1510) = .760_r8*rxt(k,537)*y(k,147) + .750_r8*rxt(k,400)*y(k,252) & + + .380_r8*rxt(k,401)*y(k,253) + .360_r8*rxt(k,402)*y(k,258) + mat(k,4040) = mat(k,4040) + rxt(k,488)*y(k,122) + .070_r8*rxt(k,490)*y(k,123) + mat(k,1476) = -(rxt(k,346)*y(k,295)) + mat(k,4021) = -rxt(k,346)*y(k,77) + mat(k,312) = .650_r8*rxt(k,321)*y(k,295) + mat(k,1710) = .200_r8*rxt(k,345)*y(k,295) + mat(k,884) = .890_r8*rxt(k,347)*y(k,295) + mat(k,2064) = .170_r8*rxt(k,459)*y(k,158) + mat(k,2096) = .170_r8*rxt(k,469)*y(k,158) + mat(k,1568) = .170_r8*rxt(k,484)*y(k,158) + mat(k,2127) = .660_r8*rxt(k,501)*y(k,158) + mat(k,3042) = rxt(k,545)*y(k,243) + .230_r8*rxt(k,503)*y(k,260) & + + .400_r8*rxt(k,559)*y(k,285) + .170_r8*rxt(k,562)*y(k,287) & + + .130_r8*rxt(k,539)*y(k,293) + .700_r8*rxt(k,565)*y(k,296) & + + .600_r8*rxt(k,572)*y(k,314) + .340_r8*rxt(k,578)*y(k,316) & + + .170_r8*rxt(k,581)*y(k,318) + mat(k,3700) = .170_r8*rxt(k,459)*y(k,115) + .170_r8*rxt(k,469)*y(k,118) & + + .170_r8*rxt(k,484)*y(k,121) + .660_r8*rxt(k,501)*y(k,139) + mat(k,516) = rxt(k,545)*y(k,147) + mat(k,3299) = .150_r8*rxt(k,421)*y(k,260) + .160_r8*rxt(k,558)*y(k,285) & + + .070_r8*rxt(k,561)*y(k,287) + .100_r8*rxt(k,499)*y(k,293) + mat(k,1299) = .230_r8*rxt(k,503)*y(k,147) + .150_r8*rxt(k,421)*y(k,258) + mat(k,863) = .400_r8*rxt(k,559)*y(k,147) + .160_r8*rxt(k,558)*y(k,258) + mat(k,930) = .170_r8*rxt(k,562)*y(k,147) + .070_r8*rxt(k,561)*y(k,258) + mat(k,1637) = .130_r8*rxt(k,539)*y(k,147) + .100_r8*rxt(k,499)*y(k,258) + mat(k,4021) = mat(k,4021) + .650_r8*rxt(k,321)*y(k,25) + .200_r8*rxt(k,345) & + *y(k,76) + .890_r8*rxt(k,347)*y(k,89) + mat(k,457) = .700_r8*rxt(k,565)*y(k,147) + mat(k,876) = .600_r8*rxt(k,572)*y(k,147) + mat(k,898) = .340_r8*rxt(k,578)*y(k,147) + mat(k,537) = .170_r8*rxt(k,581)*y(k,147) + mat(k,2931) = -((rxt(k,178) + rxt(k,179) + rxt(k,180)) * y(k,258) + rxt(k,184) & + *y(k,158)) + mat(k,3363) = -(rxt(k,178) + rxt(k,179) + rxt(k,180)) * y(k,78) + mat(k,3754) = -rxt(k,184)*y(k,78) + mat(k,3183) = rxt(k,301)*y(k,295) + mat(k,2260) = rxt(k,316)*y(k,294) + mat(k,3836) = rxt(k,220)*y(k,79) + mat(k,1245) = rxt(k,276)*y(k,79) + mat(k,1675) = rxt(k,220)*y(k,57) + rxt(k,276)*y(k,75) + rxt(k,176)*y(k,157) & + + rxt(k,168)*y(k,294) + rxt(k,185)*y(k,295) + mat(k,1152) = rxt(k,274)*y(k,294) + mat(k,3127) = rxt(k,251)*y(k,294) + mat(k,478) = rxt(k,206)*y(k,295) + mat(k,3157) = rxt(k,176)*y(k,79) + rxt(k,188)*y(k,295) + mat(k,390) = rxt(k,796)*y(k,295) + mat(k,545) = rxt(k,802)*y(k,295) + mat(k,1602) = rxt(k,807)*y(k,295) + mat(k,3795) = rxt(k,316)*y(k,55) + rxt(k,168)*y(k,79) + rxt(k,274)*y(k,83) & + + rxt(k,251)*y(k,87) + mat(k,4086) = rxt(k,301)*y(k,43) + rxt(k,185)*y(k,79) + rxt(k,206)*y(k,136) & + + rxt(k,188)*y(k,157) + rxt(k,796)*y(k,161) + rxt(k,802) & + *y(k,172) + rxt(k,807)*y(k,174) + mat(k,1673) = -(rxt(k,168)*y(k,294) + rxt(k,176)*y(k,157) + rxt(k,185) & + *y(k,295) + rxt(k,220)*y(k,57) + rxt(k,276)*y(k,75)) + mat(k,3792) = -rxt(k,168)*y(k,79) + mat(k,3153) = -rxt(k,176)*y(k,79) + mat(k,4037) = -rxt(k,185)*y(k,79) + mat(k,3830) = -rxt(k,220)*y(k,79) + mat(k,1243) = -rxt(k,276)*y(k,79) + mat(k,2257) = rxt(k,317)*y(k,294) + mat(k,2929) = rxt(k,178)*y(k,258) + mat(k,3313) = rxt(k,178)*y(k,78) + mat(k,3792) = mat(k,3792) + rxt(k,317)*y(k,55) + mat(k,126) = -(rxt(k,272)*y(k,294)) + mat(k,3772) = -rxt(k,272)*y(k,80) + mat(k,1487) = -(rxt(k,177)*y(k,157) + rxt(k,186)*y(k,295) + rxt(k,221) & + *y(k,57)) + mat(k,3151) = -rxt(k,177)*y(k,81) + mat(k,4023) = -rxt(k,186)*y(k,81) + mat(k,3827) = -rxt(k,221)*y(k,81) + mat(k,1274) = .220_r8*rxt(k,602)*y(k,158) + mat(k,1042) = .170_r8*rxt(k,622)*y(k,158) + mat(k,1097) = .320_r8*rxt(k,642)*y(k,158) + mat(k,1411) = .030_r8*rxt(k,486)*y(k,158) + mat(k,2066) = .660_r8*rxt(k,459)*y(k,158) + mat(k,2097) = .660_r8*rxt(k,469)*y(k,158) + mat(k,1570) = .660_r8*rxt(k,484)*y(k,158) + mat(k,1072) = .330_r8*rxt(k,662)*y(k,158) + mat(k,2129) = .660_r8*rxt(k,501)*y(k,158) + mat(k,3702) = .220_r8*rxt(k,602)*y(k,4) + .170_r8*rxt(k,622)*y(k,7) & + + .320_r8*rxt(k,642)*y(k,17) + .030_r8*rxt(k,486)*y(k,109) & + + .660_r8*rxt(k,459)*y(k,115) + .660_r8*rxt(k,469)*y(k,118) & + + .660_r8*rxt(k,484)*y(k,121) + .330_r8*rxt(k,662)*y(k,125) & + + .660_r8*rxt(k,501)*y(k,139) + .020_r8*rxt(k,762)*y(k,212) & + + .040_r8*rxt(k,767)*y(k,213) + mat(k,2623) = .020_r8*rxt(k,762)*y(k,158) + mat(k,2593) = .040_r8*rxt(k,767)*y(k,158) + mat(k,3301) = 2.000_r8*rxt(k,192)*y(k,258) + mat(k,4023) = mat(k,4023) + 2.000_r8*rxt(k,191)*y(k,295) + mat(k,278) = rxt(k,809)*y(k,319) + mat(k,4103) = rxt(k,809)*y(k,176) + mat(k,1150) = -(rxt(k,267)*y(k,157) + rxt(k,268)*y(k,295) + (rxt(k,273) & + + rxt(k,274)) * y(k,294)) + mat(k,3147) = -rxt(k,267)*y(k,83) + mat(k,3994) = -rxt(k,268)*y(k,83) + mat(k,3790) = -(rxt(k,273) + rxt(k,274)) * y(k,83) + mat(k,2197) = rxt(k,254)*y(k,43) + rxt(k,255)*y(k,258) + mat(k,3175) = rxt(k,254)*y(k,18) + mat(k,3280) = rxt(k,255)*y(k,18) + mat(k,251) = -(rxt(k,290)*y(k,295) + rxt(k,295)*y(k,294)) + mat(k,3887) = -rxt(k,290)*y(k,84) + mat(k,3783) = -rxt(k,295)*y(k,84) + mat(k,261) = -(rxt(k,291)*y(k,295) + rxt(k,296)*y(k,294)) + mat(k,3889) = -rxt(k,291)*y(k,85) + mat(k,3785) = -rxt(k,296)*y(k,85) + mat(k,326) = -(rxt(k,292)*y(k,295) + rxt(k,297)*y(k,294)) + mat(k,3900) = -rxt(k,292)*y(k,86) + mat(k,3786) = -rxt(k,297)*y(k,86) + mat(k,3129) = -(rxt(k,238)*y(k,157) + rxt(k,239)*y(k,295) + (rxt(k,250) & + + rxt(k,251)) * y(k,294) + (rxt(k,885) + rxt(k,891) + rxt(k,896) & + ) * y(k,96) + (rxt(k,890) + rxt(k,895) + rxt(k,900)) * y(k,61) & + + (rxt(k,892) + rxt(k,897)) * y(k,95)) + mat(k,3160) = -rxt(k,238)*y(k,87) + mat(k,4089) = -rxt(k,239)*y(k,87) + mat(k,3798) = -(rxt(k,250) + rxt(k,251)) * y(k,87) + mat(k,1160) = -(rxt(k,885) + rxt(k,891) + rxt(k,896)) * y(k,87) + mat(k,1327) = -(rxt(k,890) + rxt(k,895) + rxt(k,900)) * y(k,87) + mat(k,997) = -(rxt(k,892) + rxt(k,897)) * y(k,87) + mat(k,318) = rxt(k,330)*y(k,57) + mat(k,497) = rxt(k,281)*y(k,57) + mat(k,3186) = rxt(k,218)*y(k,57) + mat(k,648) = rxt(k,283)*y(k,57) + mat(k,395) = 2.000_r8*rxt(k,286)*y(k,57) + mat(k,2262) = rxt(k,219)*y(k,57) + mat(k,464) = rxt(k,288)*y(k,57) + mat(k,3839) = rxt(k,330)*y(k,29) + rxt(k,281)*y(k,42) + rxt(k,218)*y(k,43) & + + rxt(k,283)*y(k,44) + 2.000_r8*rxt(k,286)*y(k,47) + rxt(k,219) & + *y(k,55) + rxt(k,288)*y(k,56) + rxt(k,220)*y(k,79) + rxt(k,221) & + *y(k,81) + rxt(k,240)*y(k,96) + rxt(k,222)*y(k,258) + mat(k,3509) = rxt(k,237)*y(k,295) + mat(k,1677) = rxt(k,220)*y(k,57) + mat(k,1488) = rxt(k,221)*y(k,57) + mat(k,1160) = mat(k,1160) + rxt(k,240)*y(k,57) + mat(k,3366) = rxt(k,222)*y(k,57) + mat(k,4089) = mat(k,4089) + rxt(k,237)*y(k,60) + 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,197) = -(rxt(k,309)*y(k,295) + rxt(k,318)*y(k,294)) + mat(k,3877) = -rxt(k,309)*y(k,88) + mat(k,3780) = -rxt(k,318)*y(k,88) + mat(k,883) = -(rxt(k,347)*y(k,295)) + mat(k,3969) = -rxt(k,347)*y(k,89) + mat(k,1562) = .700_r8*rxt(k,484)*y(k,158) + mat(k,3006) = .810_r8*rxt(k,527)*y(k,276) + mat(k,3683) = .700_r8*rxt(k,484)*y(k,121) + mat(k,3261) = .680_r8*rxt(k,482)*y(k,276) + mat(k,1359) = .810_r8*rxt(k,527)*y(k,147) + .680_r8*rxt(k,482)*y(k,258) + mat(k,1377) = -(rxt(k,310)*y(k,295)) + mat(k,4013) = -rxt(k,310)*y(k,90) + mat(k,1096) = .080_r8*rxt(k,642)*y(k,158) + mat(k,311) = .350_r8*rxt(k,321)*y(k,295) + mat(k,587) = .370_r8*rxt(k,323)*y(k,158) + mat(k,1384) = .120_r8*rxt(k,354)*y(k,158) + mat(k,1211) = .500_r8*rxt(k,311)*y(k,295) + mat(k,504) = .400_r8*rxt(k,422)*y(k,295) + mat(k,1409) = .220_r8*rxt(k,486)*y(k,158) + mat(k,2009) = .330_r8*rxt(k,385)*y(k,158) + mat(k,2031) = .120_r8*rxt(k,403)*y(k,158) + mat(k,3036) = rxt(k,314)*y(k,259) + mat(k,3695) = .080_r8*rxt(k,642)*y(k,17) + .370_r8*rxt(k,323)*y(k,26) & + + .120_r8*rxt(k,354)*y(k,30) + .220_r8*rxt(k,486)*y(k,109) & + + .330_r8*rxt(k,385)*y(k,126) + .120_r8*rxt(k,403)*y(k,132) & + + .150_r8*rxt(k,762)*y(k,212) + .260_r8*rxt(k,767)*y(k,213) + mat(k,2622) = .150_r8*rxt(k,762)*y(k,158) + mat(k,2592) = .260_r8*rxt(k,767)*y(k,158) + mat(k,3293) = .500_r8*rxt(k,312)*y(k,259) + mat(k,695) = rxt(k,314)*y(k,147) + .500_r8*rxt(k,312)*y(k,258) + mat(k,4013) = mat(k,4013) + .350_r8*rxt(k,321)*y(k,25) + .500_r8*rxt(k,311) & + *y(k,92) + .400_r8*rxt(k,422)*y(k,107) + mat(k,2254) = rxt(k,275)*y(k,75) + mat(k,1241) = rxt(k,275)*y(k,55) + rxt(k,276)*y(k,79) + rxt(k,278)*y(k,93) & + + rxt(k,277)*y(k,319) + mat(k,1671) = rxt(k,276)*y(k,75) + mat(k,2944) = rxt(k,278)*y(k,75) + mat(k,4105) = rxt(k,277)*y(k,75) + mat(k,1210) = -(rxt(k,311)*y(k,295)) + mat(k,3999) = -rxt(k,311)*y(k,92) + mat(k,1095) = .110_r8*rxt(k,642)*y(k,158) + mat(k,1408) = .330_r8*rxt(k,486)*y(k,158) + mat(k,3690) = .110_r8*rxt(k,642)*y(k,17) + .330_r8*rxt(k,486)*y(k,109) & + + .230_r8*rxt(k,762)*y(k,212) + .400_r8*rxt(k,767)*y(k,213) + mat(k,2621) = .230_r8*rxt(k,762)*y(k,158) + mat(k,2591) = .400_r8*rxt(k,767)*y(k,158) + mat(k,3285) = .500_r8*rxt(k,312)*y(k,259) + mat(k,694) = .500_r8*rxt(k,312)*y(k,258) + mat(k,2949) = -(rxt(k,215)*y(k,295) + rxt(k,278)*y(k,75)) + mat(k,4087) = -rxt(k,215)*y(k,93) + mat(k,1246) = -rxt(k,278)*y(k,93) + mat(k,3184) = rxt(k,299)*y(k,149) + mat(k,1434) = rxt(k,332)*y(k,149) + mat(k,1929) = rxt(k,360)*y(k,149) + mat(k,1326) = (rxt(k,890)+rxt(k,895)+rxt(k,900))*y(k,87) + mat(k,306) = rxt(k,793)*y(k,149) + mat(k,3128) = (rxt(k,890)+rxt(k,895)+rxt(k,900))*y(k,61) + mat(k,3653) = rxt(k,214)*y(k,295) + mat(k,3601) = rxt(k,299)*y(k,43) + rxt(k,332)*y(k,46) + rxt(k,360)*y(k,50) & + + rxt(k,793)*y(k,69) + rxt(k,755)*y(k,202) + rxt(k,708)*y(k,203) & + + rxt(k,727)*y(k,205) + mat(k,2363) = rxt(k,755)*y(k,149) + mat(k,1293) = rxt(k,708)*y(k,149) + mat(k,1722) = rxt(k,727)*y(k,149) + mat(k,4087) = mat(k,4087) + rxt(k,214)*y(k,148) + mat(k,443) = -(rxt(k,193)*y(k,295)) + mat(k,3917) = -rxt(k,193)*y(k,94) + mat(k,3621) = rxt(k,212)*y(k,258) + mat(k,3231) = rxt(k,212)*y(k,148) + mat(k,995) = -(rxt(k,269)*y(k,157) + (rxt(k,892) + rxt(k,897)) * y(k,87)) + mat(k,3146) = -rxt(k,269)*y(k,95) + mat(k,3123) = -(rxt(k,892) + rxt(k,897)) * y(k,95) + mat(k,3476) = rxt(k,261)*y(k,258) + mat(k,3271) = rxt(k,261)*y(k,20) + mat(k,1159) = -(rxt(k,240)*y(k,57) + rxt(k,241)*y(k,157) + rxt(k,242) & + *y(k,295) + (rxt(k,885) + rxt(k,891) + rxt(k,896)) * y(k,87)) + mat(k,3821) = -rxt(k,240)*y(k,96) + mat(k,3148) = -rxt(k,241)*y(k,96) + mat(k,3995) = -rxt(k,242)*y(k,96) + mat(k,3124) = -(rxt(k,885) + rxt(k,891) + rxt(k,896)) * y(k,96) + mat(k,3501) = rxt(k,229)*y(k,258) + mat(k,1324) = rxt(k,234)*y(k,295) + mat(k,3281) = rxt(k,229)*y(k,60) + mat(k,3995) = mat(k,3995) + rxt(k,234)*y(k,61) + mat(k,974) = -(rxt(k,379)*y(k,295)) + mat(k,3980) = -rxt(k,379)*y(k,97) + mat(k,3015) = rxt(k,378)*y(k,255) + mat(k,606) = rxt(k,378)*y(k,147) + mat(k,613) = -(rxt(k,414)*y(k,295)) + mat(k,3941) = -rxt(k,414)*y(k,98) + mat(k,626) = -(rxt(k,415)*y(k,295)) + mat(k,3942) = -rxt(k,415)*y(k,99) + mat(k,488) = -(rxt(k,416)*y(k,295)) + mat(k,3925) = -rxt(k,416)*y(k,100) + mat(k,1883) = .090_r8*rxt(k,489)*y(k,295) + mat(k,3925) = mat(k,3925) + .090_r8*rxt(k,489)*y(k,123) + mat(k,521) = -(rxt(k,417)*y(k,295)) + mat(k,3929) = -rxt(k,417)*y(k,101) + mat(k,1884) = .090_r8*rxt(k,489)*y(k,295) + mat(k,3929) = mat(k,3929) + .090_r8*rxt(k,489)*y(k,123) + mat(k,1770) = -(rxt(k,362)*y(k,295)) + mat(k,4044) = -rxt(k,362)*y(k,102) + mat(k,1870) = .220_r8*rxt(k,418)*y(k,295) + mat(k,915) = .500_r8*rxt(k,419)*y(k,295) + mat(k,1256) = .190_r8*rxt(k,423)*y(k,295) + mat(k,773) = .280_r8*rxt(k,456)*y(k,295) + mat(k,2103) = .830_r8*rxt(k,469)*y(k,158) + mat(k,921) = rxt(k,488)*y(k,295) + mat(k,1893) = .070_r8*rxt(k,490)*y(k,295) + mat(k,1777) = .500_r8*rxt(k,380)*y(k,295) + mat(k,1462) = rxt(k,387)*y(k,295) + mat(k,530) = .250_r8*rxt(k,398)*y(k,295) + mat(k,828) = .180_r8*rxt(k,682)*y(k,158) + mat(k,3061) = .290_r8*rxt(k,503)*y(k,260) + .730_r8*rxt(k,515)*y(k,270) & + + .870_r8*rxt(k,519)*y(k,272) + .330_r8*rxt(k,521)*y(k,273) & + + .070_r8*rxt(k,525)*y(k,275) + .860_r8*rxt(k,535)*y(k,284) + mat(k,3713) = .830_r8*rxt(k,469)*y(k,118) + .180_r8*rxt(k,682)*y(k,135) + mat(k,580) = .500_r8*rxt(k,367)*y(k,295) + mat(k,2873) = .860_r8*rxt(k,381)*y(k,284) + mat(k,3414) = .900_r8*rxt(k,382)*y(k,284) + .200_r8*rxt(k,368)*y(k,298) + mat(k,3320) = .190_r8*rxt(k,421)*y(k,260) + .460_r8*rxt(k,461)*y(k,270) & + + .440_r8*rxt(k,467)*y(k,272) + .150_r8*rxt(k,471)*y(k,273) & + + .060_r8*rxt(k,479)*y(k,275) + .510_r8*rxt(k,383)*y(k,284) + mat(k,1301) = .290_r8*rxt(k,503)*y(k,147) + .190_r8*rxt(k,421)*y(k,258) + mat(k,1170) = .730_r8*rxt(k,515)*y(k,147) + .460_r8*rxt(k,461)*y(k,258) + mat(k,1136) = .870_r8*rxt(k,519)*y(k,147) + .440_r8*rxt(k,467)*y(k,258) + mat(k,1446) = .330_r8*rxt(k,521)*y(k,147) + .150_r8*rxt(k,471)*y(k,258) + mat(k,1315) = .070_r8*rxt(k,525)*y(k,147) + .060_r8*rxt(k,479)*y(k,258) + mat(k,1545) = .860_r8*rxt(k,535)*y(k,147) + .860_r8*rxt(k,381)*y(k,252) & + + .900_r8*rxt(k,382)*y(k,253) + .510_r8*rxt(k,383)*y(k,258) + mat(k,4044) = mat(k,4044) + .220_r8*rxt(k,418)*y(k,103) + .500_r8*rxt(k,419) & + *y(k,105) + .190_r8*rxt(k,423)*y(k,108) + .280_r8*rxt(k,456) & + *y(k,114) + rxt(k,488)*y(k,122) + .070_r8*rxt(k,490)*y(k,123) & + + .500_r8*rxt(k,380)*y(k,127) + rxt(k,387)*y(k,128) & + + .250_r8*rxt(k,398)*y(k,131) + .500_r8*rxt(k,367)*y(k,170) + mat(k,1338) = .200_r8*rxt(k,368)*y(k,253) + mat(k,1872) = -(rxt(k,418)*y(k,295)) + mat(k,4049) = -rxt(k,418)*y(k,103) + mat(k,1895) = .130_r8*rxt(k,489)*y(k,295) + mat(k,3066) = .450_r8*rxt(k,509)*y(k,267) + .450_r8*rxt(k,511)*y(k,268) & + + .450_r8*rxt(k,530)*y(k,278) + .450_r8*rxt(k,533)*y(k,279) + mat(k,2877) = .450_r8*rxt(k,444)*y(k,267) + .450_r8*rxt(k,448)*y(k,268) & + + .450_r8*rxt(k,491)*y(k,278) + .450_r8*rxt(k,495)*y(k,279) + mat(k,3419) = .250_r8*rxt(k,431)*y(k,262) + .470_r8*rxt(k,445)*y(k,267) & + + .470_r8*rxt(k,449)*y(k,268) + .470_r8*rxt(k,492)*y(k,278) & + + .470_r8*rxt(k,496)*y(k,279) + mat(k,1986) = .250_r8*rxt(k,431)*y(k,253) + mat(k,1734) = .450_r8*rxt(k,509)*y(k,147) + .450_r8*rxt(k,444)*y(k,252) & + + .470_r8*rxt(k,445)*y(k,253) + mat(k,1756) = .450_r8*rxt(k,511)*y(k,147) + .450_r8*rxt(k,448)*y(k,252) & + + .470_r8*rxt(k,449)*y(k,253) + mat(k,1849) = .450_r8*rxt(k,530)*y(k,147) + .450_r8*rxt(k,491)*y(k,252) & + + .470_r8*rxt(k,492)*y(k,253) + mat(k,1818) = .450_r8*rxt(k,533)*y(k,147) + .450_r8*rxt(k,495)*y(k,252) & + + .470_r8*rxt(k,496)*y(k,253) + mat(k,4049) = mat(k,4049) + .130_r8*rxt(k,489)*y(k,123) + mat(k,924) = -(rxt(k,363)*y(k,295)) + mat(k,3974) = -rxt(k,363)*y(k,104) + mat(k,640) = rxt(k,376)*y(k,295) + mat(k,629) = .150_r8*rxt(k,415)*y(k,295) + mat(k,1563) = .130_r8*rxt(k,484)*y(k,158) + mat(k,3009) = .150_r8*rxt(k,527)*y(k,276) + mat(k,3684) = .130_r8*rxt(k,484)*y(k,121) + mat(k,3264) = .120_r8*rxt(k,482)*y(k,276) + mat(k,1360) = .150_r8*rxt(k,527)*y(k,147) + .120_r8*rxt(k,482)*y(k,258) + mat(k,3974) = mat(k,3974) + rxt(k,376)*y(k,68) + .150_r8*rxt(k,415)*y(k,99) + mat(k,914) = -(rxt(k,419)*y(k,295)) + mat(k,3972) = -rxt(k,419)*y(k,105) + mat(k,615) = .080_r8*rxt(k,414)*y(k,295) + mat(k,628) = .180_r8*rxt(k,415)*y(k,295) + mat(k,489) = .580_r8*rxt(k,416)*y(k,295) + mat(k,522) = .770_r8*rxt(k,417)*y(k,295) + mat(k,1521) = .190_r8*rxt(k,420)*y(k,295) + mat(k,2125) = .040_r8*rxt(k,502)*y(k,295) + mat(k,3972) = mat(k,3972) + .080_r8*rxt(k,414)*y(k,98) + .180_r8*rxt(k,415) & + *y(k,99) + .580_r8*rxt(k,416)*y(k,100) + .770_r8*rxt(k,417) & + *y(k,101) + .190_r8*rxt(k,420)*y(k,106) + .040_r8*rxt(k,502) & + *y(k,139) + mat(k,1524) = -(rxt(k,420)*y(k,295)) + mat(k,4027) = -rxt(k,420)*y(k,106) + mat(k,2067) = .080_r8*rxt(k,460)*y(k,295) + mat(k,675) = .150_r8*rxt(k,463)*y(k,295) + mat(k,595) = .130_r8*rxt(k,466)*y(k,295) + mat(k,2099) = .040_r8*rxt(k,470)*y(k,295) + mat(k,1571) = .070_r8*rxt(k,485)*y(k,295) + mat(k,1890) = .850_r8*rxt(k,490)*y(k,295) + mat(k,4027) = mat(k,4027) + .080_r8*rxt(k,460)*y(k,115) + .150_r8*rxt(k,463) & + *y(k,116) + .130_r8*rxt(k,466)*y(k,117) + .040_r8*rxt(k,470) & + *y(k,118) + .070_r8*rxt(k,485)*y(k,121) + .850_r8*rxt(k,490) & + *y(k,123) + mat(k,502) = -(rxt(k,422)*y(k,295)) + mat(k,3927) = -rxt(k,422)*y(k,107) + mat(k,502) = mat(k,502) + .200_r8*rxt(k,422)*y(k,295) + mat(k,1192) = .400_r8*rxt(k,481)*y(k,295) + mat(k,3927) = mat(k,3927) + .200_r8*rxt(k,422)*y(k,107) + .400_r8*rxt(k,481) & + *y(k,120) + mat(k,1252) = -(rxt(k,423)*y(k,295)) + mat(k,4004) = -rxt(k,423)*y(k,108) + mat(k,1252) = mat(k,1252) + .060_r8*rxt(k,423)*y(k,295) + mat(k,729) = .030_r8*rxt(k,472)*y(k,295) + mat(k,1564) = .200_r8*rxt(k,485)*y(k,295) + mat(k,4004) = mat(k,4004) + .060_r8*rxt(k,423)*y(k,108) + .030_r8*rxt(k,472) & + *y(k,119) + .200_r8*rxt(k,485)*y(k,121) + 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,1410) = -(rxt(k,473)*y(k,149) + rxt(k,486)*y(k,158) + rxt(k,487) & + *y(k,295)) + mat(k,3543) = -rxt(k,473)*y(k,109) + mat(k,3697) = -rxt(k,486)*y(k,109) + mat(k,4015) = -rxt(k,487)*y(k,109) + mat(k,1659) = -(rxt(k,453)*y(k,295)) + mat(k,4036) = -rxt(k,453)*y(k,110) + mat(k,3054) = rxt(k,514)*y(k,269) + rxt(k,516)*y(k,270) + rxt(k,518)*y(k,271) & + + rxt(k,520)*y(k,272) + rxt(k,522)*y(k,273) + rxt(k,524) & + *y(k,274) + rxt(k,526)*y(k,275) + rxt(k,528)*y(k,276) + mat(k,1124) = rxt(k,514)*y(k,147) + mat(k,1168) = rxt(k,516)*y(k,147) + mat(k,1056) = rxt(k,518)*y(k,147) + mat(k,1135) = rxt(k,520)*y(k,147) + mat(k,1444) = rxt(k,522)*y(k,147) + mat(k,2167) = rxt(k,524)*y(k,147) + mat(k,1313) = rxt(k,526)*y(k,147) + mat(k,1366) = rxt(k,528)*y(k,147) + mat(k,1110) = -(rxt(k,452)*y(k,295)) + mat(k,3990) = -rxt(k,452)*y(k,111) + mat(k,1656) = rxt(k,453)*y(k,295) + mat(k,3022) = rxt(k,540)*y(k,293) + mat(k,1634) = rxt(k,540)*y(k,147) + mat(k,3990) = mat(k,3990) + rxt(k,453)*y(k,110) + mat(k,1793) = -(rxt(k,454)*y(k,295)) + mat(k,4046) = -rxt(k,454)*y(k,112) + mat(k,1471) = rxt(k,455)*y(k,295) + mat(k,3063) = rxt(k,504)*y(k,260) + mat(k,1302) = rxt(k,504)*y(k,147) + mat(k,4046) = mat(k,4046) + rxt(k,455)*y(k,113) + mat(k,1468) = -(rxt(k,455)*y(k,295)) + mat(k,4020) = -rxt(k,455)*y(k,113) + mat(k,3298) = .420_r8*rxt(k,457)*y(k,269) + .480_r8*rxt(k,461)*y(k,270) & + + .400_r8*rxt(k,464)*y(k,271) + .500_r8*rxt(k,467)*y(k,272) & + + .600_r8*rxt(k,471)*y(k,273) + .490_r8*rxt(k,479)*y(k,275) & + + .170_r8*rxt(k,482)*y(k,276) + .200_r8*rxt(k,499)*y(k,293) + mat(k,1122) = .420_r8*rxt(k,457)*y(k,258) + mat(k,1167) = .480_r8*rxt(k,461)*y(k,258) + mat(k,1055) = .400_r8*rxt(k,464)*y(k,258) + mat(k,1134) = .500_r8*rxt(k,467)*y(k,258) + mat(k,1442) = .600_r8*rxt(k,471)*y(k,258) + mat(k,1311) = .490_r8*rxt(k,479)*y(k,258) + mat(k,1363) = .170_r8*rxt(k,482)*y(k,258) + mat(k,1636) = .200_r8*rxt(k,499)*y(k,258) + mat(k,770) = -(rxt(k,456)*y(k,295)) + mat(k,3957) = -rxt(k,456)*y(k,114) + mat(k,1885) = .080_r8*rxt(k,490)*y(k,295) + mat(k,3250) = .350_r8*rxt(k,421)*y(k,260) + mat(k,1297) = .350_r8*rxt(k,421)*y(k,258) + mat(k,3957) = mat(k,3957) + .080_r8*rxt(k,490)*y(k,123) + mat(k,2078) = -(rxt(k,459)*y(k,158) + rxt(k,460)*y(k,295)) + mat(k,3727) = -rxt(k,459)*y(k,115) + mat(k,4058) = -rxt(k,460)*y(k,115) + mat(k,3075) = rxt(k,512)*y(k,268) + rxt(k,534)*y(k,279) + mat(k,3428) = .280_r8*rxt(k,475)*y(k,274) + mat(k,1761) = rxt(k,512)*y(k,147) + mat(k,2177) = .280_r8*rxt(k,475)*y(k,253) + 1.060_r8*rxt(k,477)*y(k,274) + mat(k,1824) = rxt(k,534)*y(k,147) + mat(k,673) = -(rxt(k,463)*y(k,295)) + mat(k,3947) = -rxt(k,463)*y(k,116) + mat(k,2995) = rxt(k,506)*y(k,261) + mat(k,1936) = rxt(k,506)*y(k,147) + mat(k,593) = -(rxt(k,466)*y(k,295)) + mat(k,3938) = -rxt(k,466)*y(k,117) + mat(k,2992) = rxt(k,508)*y(k,262) + mat(k,1972) = rxt(k,508)*y(k,147) + mat(k,2110) = -(rxt(k,469)*y(k,158) + rxt(k,470)*y(k,295)) + mat(k,3728) = -rxt(k,469)*y(k,118) + mat(k,4059) = -rxt(k,470)*y(k,118) + mat(k,3076) = rxt(k,510)*y(k,267) + rxt(k,531)*y(k,278) + mat(k,3429) = .050_r8*rxt(k,475)*y(k,274) + mat(k,1739) = rxt(k,510)*y(k,147) + mat(k,2178) = .050_r8*rxt(k,475)*y(k,253) + .180_r8*rxt(k,477)*y(k,274) + mat(k,1856) = rxt(k,531)*y(k,147) + mat(k,728) = -(rxt(k,472)*y(k,295)) + mat(k,3953) = -rxt(k,472)*y(k,119) + mat(k,3383) = .070_r8*rxt(k,475)*y(k,274) + mat(k,2154) = .070_r8*rxt(k,475)*y(k,253) + .300_r8*rxt(k,477)*y(k,274) + mat(k,1194) = -(rxt(k,481)*y(k,295)) + mat(k,3998) = -rxt(k,481)*y(k,120) + mat(k,3284) = .230_r8*rxt(k,476)*y(k,274) + mat(k,2155) = .230_r8*rxt(k,476)*y(k,258) + mat(k,1572) = -(rxt(k,484)*y(k,158) + rxt(k,485)*y(k,295)) + mat(k,3704) = -rxt(k,484)*y(k,121) + mat(k,4031) = -rxt(k,485)*y(k,121) + mat(k,3308) = .530_r8*rxt(k,476)*y(k,274) + mat(k,2164) = .530_r8*rxt(k,476)*y(k,258) + mat(k,919) = -(rxt(k,488)*y(k,295)) + mat(k,3973) = -rxt(k,488)*y(k,122) + mat(k,3385) = .250_r8*rxt(k,425)*y(k,261) + .250_r8*rxt(k,431)*y(k,262) & + + .250_r8*rxt(k,445)*y(k,267) + .250_r8*rxt(k,449)*y(k,268) & + + .250_r8*rxt(k,492)*y(k,278) + .250_r8*rxt(k,496)*y(k,279) + mat(k,1937) = .250_r8*rxt(k,425)*y(k,253) + mat(k,1973) = .250_r8*rxt(k,431)*y(k,253) + mat(k,1727) = .250_r8*rxt(k,445)*y(k,253) + mat(k,1749) = .250_r8*rxt(k,449)*y(k,253) + mat(k,1839) = .250_r8*rxt(k,492)*y(k,253) + mat(k,1808) = .250_r8*rxt(k,496)*y(k,253) + mat(k,1896) = -((rxt(k,489) + rxt(k,490)) * y(k,295)) + mat(k,4050) = -(rxt(k,489) + rxt(k,490)) * y(k,123) + mat(k,3326) = .940_r8*rxt(k,426)*y(k,261) + .940_r8*rxt(k,432)*y(k,262) & + + rxt(k,446)*y(k,267) + rxt(k,450)*y(k,268) + rxt(k,493) & + *y(k,278) + rxt(k,497)*y(k,279) + mat(k,1950) = .940_r8*rxt(k,426)*y(k,258) + mat(k,1987) = .940_r8*rxt(k,432)*y(k,258) + mat(k,1735) = rxt(k,446)*y(k,258) + mat(k,1757) = rxt(k,450)*y(k,258) + mat(k,1850) = rxt(k,493)*y(k,258) + mat(k,1819) = rxt(k,497)*y(k,258) + mat(k,89) = -(rxt(k,866)*y(k,295)) + mat(k,3865) = -rxt(k,866)*y(k,124) + mat(k,1071) = -(rxt(k,644)*y(k,149) + rxt(k,662)*y(k,158) + rxt(k,663) & + *y(k,295)) + mat(k,3532) = -rxt(k,644)*y(k,125) + mat(k,3686) = -rxt(k,662)*y(k,125) + mat(k,3987) = -rxt(k,663)*y(k,125) + mat(k,2016) = -(rxt(k,385)*y(k,158) + rxt(k,386)*y(k,295)) + mat(k,3724) = -rxt(k,385)*y(k,126) + mat(k,4055) = -rxt(k,386)*y(k,126) + mat(k,633) = .350_r8*rxt(k,415)*y(k,295) + mat(k,524) = .140_r8*rxt(k,417)*y(k,295) + mat(k,1419) = .410_r8*rxt(k,486)*y(k,158) + mat(k,3072) = rxt(k,507)*y(k,262) + .040_r8*rxt(k,523)*y(k,274) + mat(k,3568) = .040_r8*rxt(k,478)*y(k,274) + mat(k,3724) = mat(k,3724) + .410_r8*rxt(k,486)*y(k,109) + mat(k,2883) = rxt(k,430)*y(k,262) + .040_r8*rxt(k,474)*y(k,274) + mat(k,3425) = .500_r8*rxt(k,431)*y(k,262) + .020_r8*rxt(k,475)*y(k,274) + mat(k,3331) = .060_r8*rxt(k,432)*y(k,262) + .020_r8*rxt(k,476)*y(k,274) + mat(k,1992) = rxt(k,507)*y(k,147) + rxt(k,430)*y(k,252) + .500_r8*rxt(k,431) & + *y(k,253) + .060_r8*rxt(k,432)*y(k,258) + mat(k,2174) = .040_r8*rxt(k,523)*y(k,147) + .040_r8*rxt(k,478)*y(k,149) & + + .040_r8*rxt(k,474)*y(k,252) + .020_r8*rxt(k,475)*y(k,253) & + + .020_r8*rxt(k,476)*y(k,258) + .320_r8*rxt(k,477)*y(k,274) + mat(k,4055) = mat(k,4055) + .350_r8*rxt(k,415)*y(k,99) + .140_r8*rxt(k,417) & + *y(k,101) + mat(k,1778) = -(rxt(k,380)*y(k,295)) + mat(k,4045) = -rxt(k,380)*y(k,127) + mat(k,1114) = .500_r8*rxt(k,452)*y(k,295) + mat(k,1792) = .250_r8*rxt(k,454)*y(k,295) + mat(k,2072) = .060_r8*rxt(k,460)*y(k,295) + mat(k,2134) = .240_r8*rxt(k,502)*y(k,295) + mat(k,3062) = .060_r8*rxt(k,513)*y(k,269) + .270_r8*rxt(k,515)*y(k,270) & + + .210_r8*rxt(k,521)*y(k,273) + .490_r8*rxt(k,525)*y(k,275) & + + .020_r8*rxt(k,527)*y(k,276) + rxt(k,536)*y(k,284) & + + .390_r8*rxt(k,539)*y(k,293) + mat(k,3321) = .030_r8*rxt(k,457)*y(k,269) + .060_r8*rxt(k,461)*y(k,270) & + + .060_r8*rxt(k,471)*y(k,273) + .150_r8*rxt(k,479)*y(k,275) & + + .020_r8*rxt(k,482)*y(k,276) + .290_r8*rxt(k,499)*y(k,293) + mat(k,1126) = .060_r8*rxt(k,513)*y(k,147) + .030_r8*rxt(k,457)*y(k,258) + mat(k,1171) = .270_r8*rxt(k,515)*y(k,147) + .060_r8*rxt(k,461)*y(k,258) + mat(k,1447) = .210_r8*rxt(k,521)*y(k,147) + .060_r8*rxt(k,471)*y(k,258) + mat(k,1316) = .490_r8*rxt(k,525)*y(k,147) + .150_r8*rxt(k,479)*y(k,258) + mat(k,1367) = .020_r8*rxt(k,527)*y(k,147) + .020_r8*rxt(k,482)*y(k,258) + mat(k,1546) = rxt(k,536)*y(k,147) + mat(k,1643) = .390_r8*rxt(k,539)*y(k,147) + .290_r8*rxt(k,499)*y(k,258) + mat(k,4045) = mat(k,4045) + .500_r8*rxt(k,452)*y(k,111) + .250_r8*rxt(k,454) & + *y(k,112) + .060_r8*rxt(k,460)*y(k,115) + .240_r8*rxt(k,502) & + *y(k,139) + mat(k,1461) = -(rxt(k,387)*y(k,295)) + mat(k,4019) = -rxt(k,387)*y(k,128) + mat(k,523) = .090_r8*rxt(k,417)*y(k,295) + mat(k,1786) = .250_r8*rxt(k,454)*y(k,295) + mat(k,3040) = .550_r8*rxt(k,511)*y(k,268) + .550_r8*rxt(k,533)*y(k,279) + mat(k,2859) = .550_r8*rxt(k,448)*y(k,268) + .550_r8*rxt(k,495)*y(k,279) + mat(k,3395) = .280_r8*rxt(k,449)*y(k,268) + .280_r8*rxt(k,496)*y(k,279) + mat(k,3297) = .410_r8*rxt(k,383)*y(k,284) + mat(k,1750) = .550_r8*rxt(k,511)*y(k,147) + .550_r8*rxt(k,448)*y(k,252) & + + .280_r8*rxt(k,449)*y(k,253) + mat(k,1810) = .550_r8*rxt(k,533)*y(k,147) + .550_r8*rxt(k,495)*y(k,252) & + + .280_r8*rxt(k,496)*y(k,253) + mat(k,1542) = .410_r8*rxt(k,383)*y(k,258) + mat(k,4019) = mat(k,4019) + .090_r8*rxt(k,417)*y(k,101) + .250_r8*rxt(k,454) & + *y(k,112) + mat(k,556) = -(rxt(k,396)*y(k,295)) + mat(k,3934) = -rxt(k,396)*y(k,129) + mat(k,2991) = .800_r8*rxt(k,410)*y(k,236) + mat(k,1178) = .800_r8*rxt(k,410)*y(k,147) + mat(k,332) = -(rxt(k,397)*y(k,295)) + mat(k,3901) = -rxt(k,397)*y(k,130) + mat(k,3219) = .800_r8*rxt(k,394)*y(k,288) + mat(k,762) = .800_r8*rxt(k,394)*y(k,258) + mat(k,528) = -(rxt(k,398)*y(k,295)) + mat(k,3930) = -rxt(k,398)*y(k,131) + mat(k,3624) = rxt(k,406)*y(k,286) + mat(k,1616) = rxt(k,406)*y(k,148) + mat(k,2041) = -(rxt(k,403)*y(k,158) + rxt(k,404)*y(k,295)) + mat(k,3725) = -rxt(k,403)*y(k,132) + mat(k,4056) = -rxt(k,404)*y(k,132) + mat(k,620) = .350_r8*rxt(k,414)*y(k,295) + mat(k,491) = .230_r8*rxt(k,416)*y(k,295) + mat(k,1420) = .170_r8*rxt(k,486)*y(k,158) + mat(k,3073) = rxt(k,505)*y(k,261) + .420_r8*rxt(k,523)*y(k,274) + mat(k,3569) = .420_r8*rxt(k,478)*y(k,274) + mat(k,3725) = mat(k,3725) + .170_r8*rxt(k,486)*y(k,109) + mat(k,2884) = rxt(k,424)*y(k,261) + .420_r8*rxt(k,474)*y(k,274) + mat(k,3426) = .750_r8*rxt(k,425)*y(k,261) + .050_r8*rxt(k,475)*y(k,274) + mat(k,3332) = .060_r8*rxt(k,426)*y(k,261) + .220_r8*rxt(k,476)*y(k,274) + mat(k,1956) = rxt(k,505)*y(k,147) + rxt(k,424)*y(k,252) + .750_r8*rxt(k,425) & + *y(k,253) + .060_r8*rxt(k,426)*y(k,258) + mat(k,2175) = .420_r8*rxt(k,523)*y(k,147) + .420_r8*rxt(k,478)*y(k,149) & + + .420_r8*rxt(k,474)*y(k,252) + .050_r8*rxt(k,475)*y(k,253) & + + .220_r8*rxt(k,476)*y(k,258) + mat(k,4056) = mat(k,4056) + .350_r8*rxt(k,414)*y(k,98) + .230_r8*rxt(k,416) & + *y(k,100) + 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,1916) = -(rxt(k,399)*y(k,295)) + mat(k,4051) = -rxt(k,399)*y(k,133) + mat(k,1257) = .050_r8*rxt(k,423)*y(k,295) + mat(k,1115) = .500_r8*rxt(k,452)*y(k,295) + mat(k,1794) = .250_r8*rxt(k,454)*y(k,295) + mat(k,2107) = .040_r8*rxt(k,470)*y(k,295) + mat(k,2137) = .040_r8*rxt(k,502)*y(k,295) + mat(k,3068) = rxt(k,517)*y(k,271) + .130_r8*rxt(k,519)*y(k,272) & + + .120_r8*rxt(k,521)*y(k,273) + .040_r8*rxt(k,525)*y(k,275) & + + .020_r8*rxt(k,527)*y(k,276) + rxt(k,538)*y(k,289) & + + .360_r8*rxt(k,539)*y(k,293) + mat(k,3327) = .600_r8*rxt(k,464)*y(k,271) + .060_r8*rxt(k,467)*y(k,272) & + + .040_r8*rxt(k,471)*y(k,273) + .020_r8*rxt(k,479)*y(k,275) & + + .010_r8*rxt(k,482)*y(k,276) + .310_r8*rxt(k,499)*y(k,293) + mat(k,1058) = rxt(k,517)*y(k,147) + .600_r8*rxt(k,464)*y(k,258) + mat(k,1137) = .130_r8*rxt(k,519)*y(k,147) + .060_r8*rxt(k,467)*y(k,258) + mat(k,1448) = .120_r8*rxt(k,521)*y(k,147) + .040_r8*rxt(k,471)*y(k,258) + mat(k,1317) = .040_r8*rxt(k,525)*y(k,147) + .020_r8*rxt(k,479)*y(k,258) + mat(k,1368) = .020_r8*rxt(k,527)*y(k,147) + .010_r8*rxt(k,482)*y(k,258) + mat(k,1511) = rxt(k,538)*y(k,147) + mat(k,1645) = .360_r8*rxt(k,539)*y(k,147) + .310_r8*rxt(k,499)*y(k,258) + mat(k,4051) = mat(k,4051) + .050_r8*rxt(k,423)*y(k,108) + .500_r8*rxt(k,452) & + *y(k,111) + .250_r8*rxt(k,454)*y(k,112) + .040_r8*rxt(k,470) & + *y(k,118) + .040_r8*rxt(k,502)*y(k,139) + mat(k,1498) = -(rxt(k,405)*y(k,295)) + mat(k,4025) = -rxt(k,405)*y(k,134) + mat(k,490) = .190_r8*rxt(k,416)*y(k,295) + mat(k,1788) = .250_r8*rxt(k,454)*y(k,295) + mat(k,3045) = .550_r8*rxt(k,509)*y(k,267) + .550_r8*rxt(k,530)*y(k,278) + mat(k,2860) = .550_r8*rxt(k,444)*y(k,267) + .550_r8*rxt(k,491)*y(k,278) + mat(k,3399) = .280_r8*rxt(k,445)*y(k,267) + .280_r8*rxt(k,492)*y(k,278) + mat(k,3303) = .460_r8*rxt(k,402)*y(k,289) + mat(k,1729) = .550_r8*rxt(k,509)*y(k,147) + .550_r8*rxt(k,444)*y(k,252) & + + .280_r8*rxt(k,445)*y(k,253) + mat(k,1843) = .550_r8*rxt(k,530)*y(k,147) + .550_r8*rxt(k,491)*y(k,252) & + + .280_r8*rxt(k,492)*y(k,253) + mat(k,1507) = .460_r8*rxt(k,402)*y(k,258) + mat(k,4025) = mat(k,4025) + .190_r8*rxt(k,416)*y(k,100) + .250_r8*rxt(k,454) & + *y(k,112) + mat(k,827) = -(rxt(k,664)*y(k,149) + rxt(k,682)*y(k,158) + rxt(k,683) & + *y(k,295)) + mat(k,3529) = -rxt(k,664)*y(k,135) + mat(k,3681) = -rxt(k,682)*y(k,135) + mat(k,3964) = -rxt(k,683)*y(k,135) + mat(k,477) = -(rxt(k,194)*y(k,147) + (rxt(k,195) + rxt(k,196) + rxt(k,197) & + ) * y(k,148) + rxt(k,206)*y(k,295)) + mat(k,2986) = -rxt(k,194)*y(k,136) + mat(k,3622) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,136) + mat(k,3923) = -rxt(k,206)*y(k,136) + mat(k,201) = -((rxt(k,210) + rxt(k,211)) * y(k,294)) + mat(k,3781) = -(rxt(k,210) + rxt(k,211)) * y(k,137) + mat(k,476) = rxt(k,195)*y(k,148) + mat(k,3618) = rxt(k,195)*y(k,136) + mat(k,3619) = rxt(k,213)*y(k,149) + mat(k,3525) = rxt(k,213)*y(k,148) + mat(k,2140) = -(rxt(k,501)*y(k,158) + rxt(k,502)*y(k,295)) + mat(k,3729) = -rxt(k,501)*y(k,139) + mat(k,4060) = -rxt(k,502)*y(k,139) + mat(k,2079) = .040_r8*rxt(k,460)*y(k,295) + mat(k,2111) = .030_r8*rxt(k,470)*y(k,295) + mat(k,733) = .050_r8*rxt(k,472)*y(k,295) + mat(k,1203) = .020_r8*rxt(k,481)*y(k,295) + mat(k,1583) = .090_r8*rxt(k,485)*y(k,295) + mat(k,3077) = .540_r8*rxt(k,523)*y(k,274) + mat(k,3573) = .540_r8*rxt(k,478)*y(k,274) + mat(k,2888) = .540_r8*rxt(k,474)*y(k,274) + mat(k,3430) = .530_r8*rxt(k,475)*y(k,274) + mat(k,2179) = .540_r8*rxt(k,523)*y(k,147) + .540_r8*rxt(k,478)*y(k,149) & + + .540_r8*rxt(k,474)*y(k,252) + .530_r8*rxt(k,475)*y(k,253) & + + 2.140_r8*rxt(k,477)*y(k,274) + mat(k,4060) = mat(k,4060) + .040_r8*rxt(k,460)*y(k,115) + .030_r8*rxt(k,470) & + *y(k,118) + .050_r8*rxt(k,472)*y(k,119) + .020_r8*rxt(k,481) & + *y(k,120) + .090_r8*rxt(k,485)*y(k,121) + mat(k,117) = -(rxt(k,810)*y(k,295)) + mat(k,3870) = -rxt(k,810)*y(k,143) + mat(k,3106) = -(rxt(k,194)*y(k,136) + rxt(k,203)*y(k,149) + rxt(k,207) & + *y(k,258) + rxt(k,208)*y(k,158) + rxt(k,209)*y(k,157) + rxt(k,230) & + *y(k,60) + rxt(k,262)*y(k,20) + rxt(k,305)*y(k,253) + rxt(k,314) & + *y(k,259) + rxt(k,327)*y(k,249) + rxt(k,338)*y(k,252) + rxt(k,342) & + *y(k,257) + rxt(k,357)*y(k,250) + rxt(k,366)*y(k,297) + rxt(k,370) & + *y(k,298) + (rxt(k,377) + rxt(k,378)) * y(k,255) + rxt(k,392) & + *y(k,286) + rxt(k,395)*y(k,288) + (rxt(k,410) + rxt(k,411) & + ) * y(k,236) + (rxt(k,503) + rxt(k,504)) * y(k,260) + (rxt(k,505) & + + rxt(k,506)) * y(k,261) + (rxt(k,507) + rxt(k,508)) * y(k,262) & + + (rxt(k,509) + rxt(k,510)) * y(k,267) + (rxt(k,511) + rxt(k,512) & + ) * y(k,268) + (rxt(k,513) + rxt(k,514)) * y(k,269) + (rxt(k,515) & + + rxt(k,516)) * y(k,270) + (rxt(k,517) + rxt(k,518)) * y(k,271) & + + (rxt(k,519) + rxt(k,520)) * y(k,272) + (rxt(k,521) + rxt(k,522) & + ) * y(k,273) + (rxt(k,523) + rxt(k,524)) * y(k,274) + (rxt(k,525) & + + rxt(k,526)) * y(k,275) + (rxt(k,527) + rxt(k,528)) * y(k,276) & + + (rxt(k,530) + rxt(k,531)) * y(k,278) + (rxt(k,533) + rxt(k,534) & + ) * y(k,279) + (rxt(k,535) + rxt(k,536)) * y(k,284) + (rxt(k,537) & + + rxt(k,538)) * y(k,289) + (rxt(k,539) + rxt(k,540)) * y(k,293) & + + rxt(k,542)*y(k,235) + rxt(k,545)*y(k,243) + rxt(k,550) & + *y(k,248) + rxt(k,552)*y(k,251) + rxt(k,556)*y(k,254) + rxt(k,559) & + *y(k,285) + rxt(k,562)*y(k,287) + rxt(k,565)*y(k,296) + rxt(k,572) & + *y(k,314) + rxt(k,578)*y(k,316) + rxt(k,581)*y(k,318) + rxt(k,589) & + *y(k,237) + rxt(k,597)*y(k,238) + rxt(k,609)*y(k,240) + rxt(k,617) & + *y(k,241) + rxt(k,629)*y(k,245) + rxt(k,637)*y(k,246) + rxt(k,649) & + *y(k,281) + rxt(k,657)*y(k,282) + rxt(k,669)*y(k,290) + rxt(k,677) & + *y(k,291) + rxt(k,688)*y(k,299) + rxt(k,692)*y(k,300) + rxt(k,696) & + *y(k,301) + rxt(k,704)*y(k,302) + rxt(k,712)*y(k,303) + rxt(k,722) & + *y(k,304) + rxt(k,731)*y(k,305) + rxt(k,741)*y(k,306) + rxt(k,752) & + *y(k,307) + rxt(k,761)*y(k,308) + rxt(k,766)*y(k,309) + rxt(k,773) & + *y(k,310) + rxt(k,777)*y(k,311) + rxt(k,781)*y(k,312) + rxt(k,785) & + *y(k,313)) + mat(k,479) = -rxt(k,194)*y(k,147) + mat(k,3602) = -rxt(k,203)*y(k,147) + mat(k,3365) = -rxt(k,207)*y(k,147) + mat(k,3756) = -rxt(k,208)*y(k,147) + mat(k,3159) = -rxt(k,209)*y(k,147) + mat(k,3508) = -rxt(k,230)*y(k,147) + mat(k,3482) = -rxt(k,262)*y(k,147) + mat(k,3458) = -rxt(k,305)*y(k,147) + mat(k,696) = -rxt(k,314)*y(k,147) + mat(k,1353) = -rxt(k,327)*y(k,147) + mat(k,2916) = -rxt(k,338)*y(k,147) + mat(k,857) = -rxt(k,342)*y(k,147) + mat(k,1027) = -rxt(k,357)*y(k,147) + mat(k,942) = -rxt(k,366)*y(k,147) + mat(k,1341) = -rxt(k,370)*y(k,147) + mat(k,609) = -(rxt(k,377) + rxt(k,378)) * y(k,147) + mat(k,1624) = -rxt(k,392)*y(k,147) + mat(k,766) = -rxt(k,395)*y(k,147) + mat(k,1187) = -(rxt(k,410) + rxt(k,411)) * y(k,147) + mat(k,1305) = -(rxt(k,503) + rxt(k,504)) * y(k,147) + mat(k,1961) = -(rxt(k,505) + rxt(k,506)) * y(k,147) + mat(k,2000) = -(rxt(k,507) + rxt(k,508)) * y(k,147) + mat(k,1741) = -(rxt(k,509) + rxt(k,510)) * y(k,147) + mat(k,1763) = -(rxt(k,511) + rxt(k,512)) * y(k,147) + mat(k,1127) = -(rxt(k,513) + rxt(k,514)) * y(k,147) + mat(k,1173) = -(rxt(k,515) + rxt(k,516)) * y(k,147) + mat(k,1059) = -(rxt(k,517) + rxt(k,518)) * y(k,147) + mat(k,1138) = -(rxt(k,519) + rxt(k,520)) * y(k,147) + mat(k,1449) = -(rxt(k,521) + rxt(k,522)) * y(k,147) + mat(k,2185) = -(rxt(k,523) + rxt(k,524)) * y(k,147) + mat(k,1318) = -(rxt(k,525) + rxt(k,526)) * y(k,147) + mat(k,1372) = -(rxt(k,527) + rxt(k,528)) * y(k,147) + mat(k,1858) = -(rxt(k,530) + rxt(k,531)) * y(k,147) + mat(k,1827) = -(rxt(k,533) + rxt(k,534)) * y(k,147) + mat(k,1551) = -(rxt(k,535) + rxt(k,536)) * y(k,147) + mat(k,1515) = -(rxt(k,537) + rxt(k,538)) * y(k,147) + mat(k,1650) = -(rxt(k,539) + rxt(k,540)) * y(k,147) + mat(k,552) = -rxt(k,542)*y(k,147) + mat(k,517) = -rxt(k,545)*y(k,147) + mat(k,439) = -rxt(k,550)*y(k,147) + mat(k,712) = -rxt(k,552)*y(k,147) + mat(k,909) = -rxt(k,556)*y(k,147) + mat(k,865) = -rxt(k,559)*y(k,147) + mat(k,933) = -rxt(k,562)*y(k,147) + mat(k,458) = -rxt(k,565)*y(k,147) + mat(k,879) = -rxt(k,572)*y(k,147) + mat(k,902) = -rxt(k,578)*y(k,147) + mat(k,539) = -rxt(k,581)*y(k,147) + mat(k,2306) = -rxt(k,589)*y(k,147) + mat(k,2451) = -rxt(k,597)*y(k,147) + mat(k,2222) = -rxt(k,609)*y(k,147) + mat(k,2419) = -rxt(k,617)*y(k,147) + mat(k,2545) = -rxt(k,629)*y(k,147) + mat(k,2390) = -rxt(k,637)*y(k,147) + mat(k,2516) = -rxt(k,649)*y(k,147) + mat(k,2350) = -rxt(k,657)*y(k,147) + mat(k,2581) = -rxt(k,669)*y(k,147) + mat(k,2482) = -rxt(k,677)*y(k,147) + mat(k,955) = -rxt(k,688)*y(k,147) + mat(k,1010) = -rxt(k,692)*y(k,147) + mat(k,2662) = -rxt(k,696)*y(k,147) + mat(k,2750) = -rxt(k,704)*y(k,147) + mat(k,2707) = -rxt(k,712)*y(k,147) + mat(k,2796) = -rxt(k,722)*y(k,147) + mat(k,2246) = -rxt(k,731)*y(k,147) + mat(k,2684) = -rxt(k,741)*y(k,147) + mat(k,2843) = -rxt(k,752)*y(k,147) + mat(k,800) = -rxt(k,761)*y(k,147) + mat(k,965) = -rxt(k,766)*y(k,147) + mat(k,1223) = -rxt(k,773)*y(k,147) + mat(k,1019) = -rxt(k,777)*y(k,147) + mat(k,809) = -rxt(k,781)*y(k,147) + mat(k,817) = -rxt(k,785)*y(k,147) + mat(k,479) = mat(k,479) + 2.000_r8*rxt(k,196)*y(k,148) + rxt(k,206)*y(k,295) + mat(k,202) = 2.000_r8*rxt(k,210)*y(k,294) + mat(k,3654) = 2.000_r8*rxt(k,196)*y(k,136) + rxt(k,199)*y(k,157) + rxt(k,803) & + *y(k,174) + mat(k,3159) = mat(k,3159) + rxt(k,199)*y(k,148) + mat(k,1603) = rxt(k,803)*y(k,148) + mat(k,3797) = 2.000_r8*rxt(k,210)*y(k,137) + mat(k,4088) = rxt(k,206)*y(k,136) + mat(k,3663) = -((rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,136) + (rxt(k,199) & + + rxt(k,201)) * y(k,157) + rxt(k,200)*y(k,158) + rxt(k,212) & + *y(k,258) + rxt(k,213)*y(k,149) + rxt(k,214)*y(k,295) + rxt(k,232) & + *y(k,60) + rxt(k,263)*y(k,20) + rxt(k,351)*y(k,252) + rxt(k,406) & + *y(k,286) + rxt(k,557)*y(k,254) + rxt(k,560)*y(k,285) + rxt(k,563) & + *y(k,287) + rxt(k,567)*y(k,165) + rxt(k,570)*y(k,235) + rxt(k,684) & + *y(k,302) + rxt(k,685)*y(k,304) + rxt(k,686)*y(k,307) + rxt(k,803) & + *y(k,174)) + mat(k,481) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,148) + mat(k,3168) = -(rxt(k,199) + rxt(k,201)) * y(k,148) + mat(k,3765) = -rxt(k,200)*y(k,148) + mat(k,3374) = -rxt(k,212)*y(k,148) + mat(k,3611) = -rxt(k,213)*y(k,148) + mat(k,4097) = -rxt(k,214)*y(k,148) + mat(k,3517) = -rxt(k,232)*y(k,148) + mat(k,3491) = -rxt(k,263)*y(k,148) + mat(k,2923) = -rxt(k,351)*y(k,148) + mat(k,1630) = -rxt(k,406)*y(k,148) + mat(k,912) = -rxt(k,557)*y(k,148) + mat(k,867) = -rxt(k,560)*y(k,148) + mat(k,936) = -rxt(k,563)*y(k,148) + mat(k,486) = -rxt(k,567)*y(k,148) + mat(k,554) = -rxt(k,570)*y(k,148) + mat(k,2757) = -rxt(k,684)*y(k,148) + mat(k,2803) = -rxt(k,685)*y(k,148) + mat(k,2850) = -rxt(k,686)*y(k,148) + mat(k,1608) = -rxt(k,803)*y(k,148) + mat(k,760) = rxt(k,408)*y(k,295) + mat(k,383) = rxt(k,374)*y(k,149) + mat(k,3491) = mat(k,3491) + rxt(k,262)*y(k,147) + mat(k,3517) = mat(k,3517) + rxt(k,230)*y(k,147) + mat(k,446) = rxt(k,193)*y(k,295) + mat(k,510) = .400_r8*rxt(k,422)*y(k,295) + mat(k,1263) = .190_r8*rxt(k,423)*y(k,295) + mat(k,1119) = rxt(k,452)*y(k,295) + mat(k,1801) = .500_r8*rxt(k,454)*y(k,295) + mat(k,2088) = .170_r8*rxt(k,459)*y(k,158) + .080_r8*rxt(k,460)*y(k,295) + mat(k,680) = .150_r8*rxt(k,463)*y(k,295) + mat(k,599) = .130_r8*rxt(k,466)*y(k,295) + mat(k,2120) = .170_r8*rxt(k,469)*y(k,158) + .040_r8*rxt(k,470)*y(k,295) + mat(k,1592) = .170_r8*rxt(k,484)*y(k,158) + .070_r8*rxt(k,485)*y(k,295) + mat(k,1784) = .500_r8*rxt(k,380)*y(k,295) + mat(k,2149) = .170_r8*rxt(k,501)*y(k,158) + .040_r8*rxt(k,502)*y(k,295) + mat(k,3115) = rxt(k,262)*y(k,20) + rxt(k,230)*y(k,60) + 2.000_r8*rxt(k,203) & + *y(k,149) + rxt(k,209)*y(k,157) + rxt(k,208)*y(k,158) & + + rxt(k,542)*y(k,235) + rxt(k,410)*y(k,236) & + + 1.860_r8*rxt(k,589)*y(k,237) + .770_r8*rxt(k,597)*y(k,238) & + + 1.860_r8*rxt(k,609)*y(k,240) + .700_r8*rxt(k,617)*y(k,241) & + + rxt(k,545)*y(k,243) + 1.390_r8*rxt(k,629)*y(k,245) & + + .750_r8*rxt(k,637)*y(k,246) + rxt(k,550)*y(k,248) + rxt(k,327) & + *y(k,249) + rxt(k,357)*y(k,250) + rxt(k,552)*y(k,251) & + + rxt(k,338)*y(k,252) + rxt(k,305)*y(k,253) + rxt(k,556) & + *y(k,254) + rxt(k,377)*y(k,255) + rxt(k,342)*y(k,257) & + + rxt(k,207)*y(k,258) + rxt(k,314)*y(k,259) + rxt(k,503) & + *y(k,260) + rxt(k,505)*y(k,261) + rxt(k,507)*y(k,262) & + + rxt(k,509)*y(k,267) + rxt(k,511)*y(k,268) + rxt(k,513) & + *y(k,269) + 1.730_r8*rxt(k,515)*y(k,270) + rxt(k,517)*y(k,271) & + + rxt(k,519)*y(k,272) + rxt(k,521)*y(k,273) & + + 1.460_r8*rxt(k,523)*y(k,274) + rxt(k,525)*y(k,275) & + + rxt(k,527)*y(k,276) + rxt(k,530)*y(k,278) + rxt(k,533) & + *y(k,279) + 1.360_r8*rxt(k,649)*y(k,281) + .770_r8*rxt(k,657) & + *y(k,282) + rxt(k,535)*y(k,284) + rxt(k,559)*y(k,285) & + + rxt(k,392)*y(k,286) + rxt(k,562)*y(k,287) + rxt(k,395) & + *y(k,288) + rxt(k,537)*y(k,289) + 1.820_r8*rxt(k,669)*y(k,290) & + + .710_r8*rxt(k,677)*y(k,291) + rxt(k,539)*y(k,293) + rxt(k,565) & + *y(k,296) + rxt(k,366)*y(k,297) + rxt(k,370)*y(k,298) & + + .700_r8*rxt(k,688)*y(k,299) + .700_r8*rxt(k,692)*y(k,300) & + + .700_r8*rxt(k,696)*y(k,301) + rxt(k,704)*y(k,302) & + + .830_r8*rxt(k,712)*y(k,303) + rxt(k,722)*y(k,304) & + + .700_r8*rxt(k,731)*y(k,305) + .910_r8*rxt(k,741)*y(k,306) & + + rxt(k,752)*y(k,307) + .700_r8*rxt(k,761)*y(k,308) & + + .700_r8*rxt(k,766)*y(k,309) + .700_r8*rxt(k,773)*y(k,310) & + + .700_r8*rxt(k,777)*y(k,311) + .700_r8*rxt(k,781)*y(k,312) & + + .700_r8*rxt(k,785)*y(k,313) + rxt(k,572)*y(k,314) + rxt(k,578) & + *y(k,316) + rxt(k,581)*y(k,318) + mat(k,3611) = mat(k,3611) + rxt(k,374)*y(k,16) + 2.000_r8*rxt(k,203)*y(k,147) & + + rxt(k,204)*y(k,157) + rxt(k,759)*y(k,212) + .500_r8*rxt(k,764) & + *y(k,213) + 2.000_r8*rxt(k,590)*y(k,237) + rxt(k,598)*y(k,238) & + + 2.000_r8*rxt(k,610)*y(k,240) + rxt(k,618)*y(k,241) & + + 1.500_r8*rxt(k,630)*y(k,245) + rxt(k,638)*y(k,246) & + + rxt(k,202)*y(k,258) + 1.460_r8*rxt(k,478)*y(k,274) & + + 1.460_r8*rxt(k,650)*y(k,281) + rxt(k,658)*y(k,282) & + + rxt(k,393)*y(k,286) + 1.950_r8*rxt(k,670)*y(k,290) & + + rxt(k,678)*y(k,291) + rxt(k,205)*y(k,295) + rxt(k,697) & + *y(k,301) + rxt(k,705)*y(k,302) + rxt(k,713)*y(k,303) & + + rxt(k,723)*y(k,304) + rxt(k,732)*y(k,305) + rxt(k,742) & + *y(k,306) + rxt(k,753)*y(k,307) + mat(k,1459) = rxt(k,348)*y(k,295) + mat(k,1485) = rxt(k,364)*y(k,295) + mat(k,3168) = mat(k,3168) + rxt(k,209)*y(k,147) + rxt(k,204)*y(k,149) + mat(k,3765) = mat(k,3765) + .170_r8*rxt(k,459)*y(k,115) + .170_r8*rxt(k,469) & + *y(k,118) + .170_r8*rxt(k,484)*y(k,121) + .170_r8*rxt(k,501) & + *y(k,139) + rxt(k,208)*y(k,147) + mat(k,662) = rxt(k,718)*y(k,295) + mat(k,671) = rxt(k,737)*y(k,295) + mat(k,427) = rxt(k,757)*y(k,295) + mat(k,2642) = rxt(k,759)*y(k,149) + mat(k,2614) = .500_r8*rxt(k,764)*y(k,149) + mat(k,1232) = rxt(k,769)*y(k,295) + mat(k,1560) = rxt(k,783)*y(k,295) + mat(k,1540) = rxt(k,787)*y(k,295) + mat(k,554) = mat(k,554) + rxt(k,542)*y(k,147) + mat(k,1190) = rxt(k,410)*y(k,147) + mat(k,2312) = 1.860_r8*rxt(k,589)*y(k,147) + 2.000_r8*rxt(k,590)*y(k,149) & + + 3.280_r8*rxt(k,585)*y(k,237) + rxt(k,586)*y(k,252) & + + .820_r8*rxt(k,587)*y(k,253) + .700_r8*rxt(k,588)*y(k,258) & + + rxt(k,591)*y(k,302) + rxt(k,592)*y(k,304) + rxt(k,593) & + *y(k,307) + mat(k,2457) = .770_r8*rxt(k,597)*y(k,147) + rxt(k,598)*y(k,149) + mat(k,2228) = 1.860_r8*rxt(k,609)*y(k,147) + 2.000_r8*rxt(k,610)*y(k,149) & + + 3.280_r8*rxt(k,605)*y(k,240) + rxt(k,606)*y(k,252) & + + .820_r8*rxt(k,607)*y(k,253) + .500_r8*rxt(k,608)*y(k,258) & + + rxt(k,611)*y(k,302) + rxt(k,612)*y(k,304) + rxt(k,613) & + *y(k,307) + mat(k,2425) = .700_r8*rxt(k,617)*y(k,147) + rxt(k,618)*y(k,149) + mat(k,519) = rxt(k,545)*y(k,147) + mat(k,2551) = 1.390_r8*rxt(k,629)*y(k,147) + 1.500_r8*rxt(k,630)*y(k,149) & + + 1.880_r8*rxt(k,625)*y(k,245) + .500_r8*rxt(k,626)*y(k,252) & + + .360_r8*rxt(k,627)*y(k,253) + .240_r8*rxt(k,628)*y(k,258) & + + .500_r8*rxt(k,631)*y(k,302) + .500_r8*rxt(k,632)*y(k,304) & + + .500_r8*rxt(k,633)*y(k,307) + mat(k,2396) = .750_r8*rxt(k,637)*y(k,147) + rxt(k,638)*y(k,149) + mat(k,441) = rxt(k,550)*y(k,147) + mat(k,1357) = rxt(k,327)*y(k,147) + mat(k,1031) = rxt(k,357)*y(k,147) + mat(k,714) = rxt(k,552)*y(k,147) + mat(k,2923) = mat(k,2923) + rxt(k,338)*y(k,147) + rxt(k,586)*y(k,237) & + + rxt(k,606)*y(k,240) + .500_r8*rxt(k,626)*y(k,245) & + + .460_r8*rxt(k,474)*y(k,274) + .460_r8*rxt(k,645)*y(k,281) & + + .950_r8*rxt(k,665)*y(k,290) + mat(k,3467) = rxt(k,305)*y(k,147) + .820_r8*rxt(k,587)*y(k,237) & + + .820_r8*rxt(k,607)*y(k,240) + .360_r8*rxt(k,627)*y(k,245) & + + .070_r8*rxt(k,475)*y(k,274) + .310_r8*rxt(k,646)*y(k,281) & + + .770_r8*rxt(k,666)*y(k,290) + mat(k,912) = mat(k,912) + rxt(k,556)*y(k,147) + mat(k,612) = rxt(k,377)*y(k,147) + mat(k,860) = rxt(k,342)*y(k,147) + mat(k,3374) = mat(k,3374) + rxt(k,207)*y(k,147) + rxt(k,202)*y(k,149) & + + .700_r8*rxt(k,588)*y(k,237) + .500_r8*rxt(k,608)*y(k,240) & + + .240_r8*rxt(k,628)*y(k,245) + .460_r8*rxt(k,461)*y(k,270) & + + .240_r8*rxt(k,476)*y(k,274) + .230_r8*rxt(k,647)*y(k,281) & + + .480_r8*rxt(k,667)*y(k,290) + mat(k,699) = rxt(k,314)*y(k,147) + mat(k,1307) = rxt(k,503)*y(k,147) + mat(k,1967) = rxt(k,505)*y(k,147) + mat(k,2006) = rxt(k,507)*y(k,147) + mat(k,1746) = rxt(k,509)*y(k,147) + mat(k,1768) = rxt(k,511)*y(k,147) + mat(k,1130) = rxt(k,513)*y(k,147) + mat(k,1176) = 1.730_r8*rxt(k,515)*y(k,147) + .460_r8*rxt(k,461)*y(k,258) + mat(k,1062) = rxt(k,517)*y(k,147) + mat(k,1141) = rxt(k,519)*y(k,147) + mat(k,1452) = rxt(k,521)*y(k,147) + mat(k,2192) = 1.460_r8*rxt(k,523)*y(k,147) + 1.460_r8*rxt(k,478)*y(k,149) & + + .460_r8*rxt(k,474)*y(k,252) + .070_r8*rxt(k,475)*y(k,253) & + + .240_r8*rxt(k,476)*y(k,258) + .320_r8*rxt(k,477)*y(k,274) + mat(k,1321) = rxt(k,525)*y(k,147) + mat(k,1375) = rxt(k,527)*y(k,147) + mat(k,1863) = rxt(k,530)*y(k,147) + mat(k,1832) = rxt(k,533)*y(k,147) + mat(k,2522) = 1.360_r8*rxt(k,649)*y(k,147) + 1.460_r8*rxt(k,650)*y(k,149) & + + .460_r8*rxt(k,645)*y(k,252) + .310_r8*rxt(k,646)*y(k,253) & + + .230_r8*rxt(k,647)*y(k,258) + 1.720_r8*rxt(k,648)*y(k,281) & + + .460_r8*rxt(k,651)*y(k,302) + .460_r8*rxt(k,652)*y(k,304) & + + .460_r8*rxt(k,653)*y(k,307) + mat(k,2356) = .770_r8*rxt(k,657)*y(k,147) + rxt(k,658)*y(k,149) + mat(k,1555) = rxt(k,535)*y(k,147) + mat(k,867) = mat(k,867) + rxt(k,559)*y(k,147) + mat(k,1630) = mat(k,1630) + rxt(k,392)*y(k,147) + rxt(k,393)*y(k,149) + mat(k,936) = mat(k,936) + rxt(k,562)*y(k,147) + mat(k,768) = rxt(k,395)*y(k,147) + mat(k,1519) = rxt(k,537)*y(k,147) + mat(k,2587) = 1.820_r8*rxt(k,669)*y(k,147) + 1.950_r8*rxt(k,670)*y(k,149) & + + .950_r8*rxt(k,665)*y(k,252) + .770_r8*rxt(k,666)*y(k,253) & + + .480_r8*rxt(k,667)*y(k,258) + 3.080_r8*rxt(k,668)*y(k,290) & + + .950_r8*rxt(k,671)*y(k,302) + .950_r8*rxt(k,672)*y(k,304) & + + .950_r8*rxt(k,673)*y(k,307) + mat(k,2488) = .710_r8*rxt(k,677)*y(k,147) + rxt(k,678)*y(k,149) + mat(k,1654) = rxt(k,539)*y(k,147) + mat(k,4097) = mat(k,4097) + rxt(k,408)*y(k,1) + rxt(k,193)*y(k,94) & + + .400_r8*rxt(k,422)*y(k,107) + .190_r8*rxt(k,423)*y(k,108) & + + rxt(k,452)*y(k,111) + .500_r8*rxt(k,454)*y(k,112) & + + .080_r8*rxt(k,460)*y(k,115) + .150_r8*rxt(k,463)*y(k,116) & + + .130_r8*rxt(k,466)*y(k,117) + .040_r8*rxt(k,470)*y(k,118) & + + .070_r8*rxt(k,485)*y(k,121) + .500_r8*rxt(k,380)*y(k,127) & + + .040_r8*rxt(k,502)*y(k,139) + rxt(k,205)*y(k,149) + rxt(k,348) & + *y(k,150) + rxt(k,364)*y(k,151) + rxt(k,718)*y(k,204) & + + rxt(k,737)*y(k,206) + rxt(k,757)*y(k,210) + rxt(k,769) & + *y(k,214) + rxt(k,783)*y(k,221) + rxt(k,787)*y(k,223) + mat(k,460) = rxt(k,565)*y(k,147) + mat(k,945) = rxt(k,366)*y(k,147) + mat(k,1345) = rxt(k,370)*y(k,147) + mat(k,958) = .700_r8*rxt(k,688)*y(k,147) + mat(k,1012) = .700_r8*rxt(k,692)*y(k,147) + mat(k,2668) = .700_r8*rxt(k,696)*y(k,147) + rxt(k,697)*y(k,149) + mat(k,2757) = mat(k,2757) + rxt(k,704)*y(k,147) + rxt(k,705)*y(k,149) & + + rxt(k,591)*y(k,237) + rxt(k,611)*y(k,240) + .500_r8*rxt(k,631) & + *y(k,245) + .460_r8*rxt(k,651)*y(k,281) + .950_r8*rxt(k,671) & + *y(k,290) + mat(k,2713) = .830_r8*rxt(k,712)*y(k,147) + rxt(k,713)*y(k,149) + mat(k,2803) = mat(k,2803) + rxt(k,722)*y(k,147) + rxt(k,723)*y(k,149) & + + rxt(k,592)*y(k,237) + rxt(k,612)*y(k,240) + .500_r8*rxt(k,632) & + *y(k,245) + .460_r8*rxt(k,652)*y(k,281) + .950_r8*rxt(k,672) & + *y(k,290) + mat(k,2252) = .700_r8*rxt(k,731)*y(k,147) + rxt(k,732)*y(k,149) + mat(k,2690) = .910_r8*rxt(k,741)*y(k,147) + rxt(k,742)*y(k,149) + mat(k,2850) = mat(k,2850) + rxt(k,752)*y(k,147) + rxt(k,753)*y(k,149) & + + rxt(k,593)*y(k,237) + rxt(k,613)*y(k,240) + .500_r8*rxt(k,633) & + *y(k,245) + .460_r8*rxt(k,653)*y(k,281) + .950_r8*rxt(k,673) & + *y(k,290) + mat(k,803) = .700_r8*rxt(k,761)*y(k,147) + mat(k,967) = .700_r8*rxt(k,766)*y(k,147) + mat(k,1225) = .700_r8*rxt(k,773)*y(k,147) + mat(k,1021) = .700_r8*rxt(k,777)*y(k,147) + mat(k,811) = .700_r8*rxt(k,781)*y(k,147) + mat(k,819) = .700_r8*rxt(k,785)*y(k,147) + mat(k,881) = rxt(k,572)*y(k,147) + mat(k,904) = rxt(k,578)*y(k,147) + mat(k,541) = rxt(k,581)*y(k,147) + end do + end subroutine nlnmat07 + subroutine nlnmat08( 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,3610) = -(rxt(k,202)*y(k,258) + rxt(k,203)*y(k,147) + rxt(k,204) & + *y(k,157) + rxt(k,205)*y(k,295) + rxt(k,213)*y(k,148) + rxt(k,299) & + *y(k,43) + rxt(k,332)*y(k,46) + rxt(k,353)*y(k,30) + rxt(k,360) & + *y(k,50) + rxt(k,374)*y(k,16) + rxt(k,393)*y(k,286) + rxt(k,473) & + *y(k,109) + rxt(k,478)*y(k,274) + rxt(k,584)*y(k,4) + rxt(k,590) & + *y(k,237) + rxt(k,598)*y(k,238) + rxt(k,604)*y(k,7) + rxt(k,610) & + *y(k,240) + rxt(k,618)*y(k,241) + rxt(k,624)*y(k,17) + rxt(k,630) & + *y(k,245) + rxt(k,638)*y(k,246) + rxt(k,644)*y(k,125) + rxt(k,650) & + *y(k,281) + rxt(k,658)*y(k,282) + rxt(k,664)*y(k,135) + rxt(k,670) & + *y(k,290) + rxt(k,678)*y(k,291) + rxt(k,697)*y(k,301) + rxt(k,705) & + *y(k,302) + rxt(k,708)*y(k,203) + rxt(k,713)*y(k,303) + rxt(k,723) & + *y(k,304) + rxt(k,727)*y(k,205) + rxt(k,732)*y(k,305) + rxt(k,742) & + *y(k,306) + rxt(k,753)*y(k,307) + rxt(k,755)*y(k,202) + rxt(k,759) & + *y(k,212) + rxt(k,764)*y(k,213) + rxt(k,793)*y(k,69)) + mat(k,3373) = -rxt(k,202)*y(k,149) + mat(k,3114) = -rxt(k,203)*y(k,149) + mat(k,3167) = -rxt(k,204)*y(k,149) + mat(k,4096) = -rxt(k,205)*y(k,149) + mat(k,3662) = -rxt(k,213)*y(k,149) + mat(k,3193) = -rxt(k,299)*y(k,149) + mat(k,1437) = -rxt(k,332)*y(k,149) + mat(k,1396) = -rxt(k,353)*y(k,149) + mat(k,1931) = -rxt(k,360)*y(k,149) + mat(k,382) = -rxt(k,374)*y(k,149) + mat(k,1629) = -rxt(k,393)*y(k,149) + mat(k,1427) = -rxt(k,473)*y(k,149) + mat(k,2191) = -rxt(k,478)*y(k,149) + mat(k,1286) = -rxt(k,584)*y(k,149) + mat(k,2311) = -rxt(k,590)*y(k,149) + mat(k,2456) = -rxt(k,598)*y(k,149) + mat(k,1051) = -rxt(k,604)*y(k,149) + mat(k,2227) = -rxt(k,610)*y(k,149) + mat(k,2424) = -rxt(k,618)*y(k,149) + mat(k,1103) = -rxt(k,624)*y(k,149) + mat(k,2550) = -rxt(k,630)*y(k,149) + mat(k,2395) = -rxt(k,638)*y(k,149) + mat(k,1082) = -rxt(k,644)*y(k,149) + mat(k,2521) = -rxt(k,650)*y(k,149) + mat(k,2355) = -rxt(k,658)*y(k,149) + mat(k,835) = -rxt(k,664)*y(k,149) + mat(k,2586) = -rxt(k,670)*y(k,149) + mat(k,2487) = -rxt(k,678)*y(k,149) + mat(k,2667) = -rxt(k,697)*y(k,149) + mat(k,2756) = -rxt(k,705)*y(k,149) + mat(k,1295) = -rxt(k,708)*y(k,149) + mat(k,2712) = -rxt(k,713)*y(k,149) + mat(k,2802) = -rxt(k,723)*y(k,149) + mat(k,1724) = -rxt(k,727)*y(k,149) + mat(k,2251) = -rxt(k,732)*y(k,149) + mat(k,2689) = -rxt(k,742)*y(k,149) + mat(k,2849) = -rxt(k,753)*y(k,149) + mat(k,2366) = -rxt(k,755)*y(k,149) + mat(k,2641) = -rxt(k,759)*y(k,149) + mat(k,2613) = -rxt(k,764)*y(k,149) + mat(k,308) = -rxt(k,793)*y(k,149) + mat(k,567) = rxt(k,264)*y(k,157) + mat(k,3846) = rxt(k,231)*y(k,61) + mat(k,1330) = rxt(k,231)*y(k,57) + rxt(k,233)*y(k,157) + rxt(k,234)*y(k,295) + mat(k,1248) = rxt(k,278)*y(k,93) + mat(k,2955) = rxt(k,278)*y(k,75) + rxt(k,215)*y(k,295) + mat(k,532) = rxt(k,398)*y(k,295) + mat(k,3662) = mat(k,3662) + rxt(k,201)*y(k,157) + rxt(k,200)*y(k,158) + mat(k,3167) = mat(k,3167) + rxt(k,264)*y(k,21) + rxt(k,233)*y(k,61) & + + rxt(k,201)*y(k,148) + mat(k,3764) = rxt(k,200)*y(k,148) + mat(k,574) = rxt(k,349)*y(k,295) + mat(k,4096) = mat(k,4096) + rxt(k,234)*y(k,61) + rxt(k,215)*y(k,93) & + + rxt(k,398)*y(k,131) + rxt(k,349)*y(k,163) + mat(k,1454) = -(rxt(k,348)*y(k,295)) + mat(k,4018) = -rxt(k,348)*y(k,150) + mat(k,2094) = .830_r8*rxt(k,469)*y(k,158) + mat(k,1566) = .130_r8*rxt(k,484)*y(k,158) + mat(k,2126) = .220_r8*rxt(k,501)*y(k,158) + .100_r8*rxt(k,502)*y(k,295) + mat(k,3039) = .870_r8*rxt(k,519)*y(k,272) + .330_r8*rxt(k,521)*y(k,273) & + + .070_r8*rxt(k,525)*y(k,275) + .150_r8*rxt(k,527)*y(k,276) & + + .120_r8*rxt(k,539)*y(k,293) + mat(k,3699) = .830_r8*rxt(k,469)*y(k,118) + .130_r8*rxt(k,484)*y(k,121) & + + .220_r8*rxt(k,501)*y(k,139) + mat(k,3296) = .440_r8*rxt(k,467)*y(k,272) + .150_r8*rxt(k,471)*y(k,273) & + + .060_r8*rxt(k,479)*y(k,275) + .120_r8*rxt(k,482)*y(k,276) & + + .100_r8*rxt(k,499)*y(k,293) + mat(k,1133) = .870_r8*rxt(k,519)*y(k,147) + .440_r8*rxt(k,467)*y(k,258) + mat(k,1441) = .330_r8*rxt(k,521)*y(k,147) + .150_r8*rxt(k,471)*y(k,258) + mat(k,1310) = .070_r8*rxt(k,525)*y(k,147) + .060_r8*rxt(k,479)*y(k,258) + mat(k,1362) = .150_r8*rxt(k,527)*y(k,147) + .120_r8*rxt(k,482)*y(k,258) + mat(k,1635) = .120_r8*rxt(k,539)*y(k,147) + .100_r8*rxt(k,499)*y(k,258) + mat(k,4018) = mat(k,4018) + .100_r8*rxt(k,502)*y(k,139) + mat(k,1481) = -(rxt(k,364)*y(k,295)) + mat(k,4022) = -rxt(k,364)*y(k,151) + mat(k,1387) = rxt(k,353)*y(k,149) + mat(k,1253) = .350_r8*rxt(k,423)*y(k,295) + mat(k,2065) = .830_r8*rxt(k,459)*y(k,158) + mat(k,1569) = .700_r8*rxt(k,484)*y(k,158) + mat(k,1776) = .500_r8*rxt(k,380)*y(k,295) + mat(k,1913) = .500_r8*rxt(k,399)*y(k,295) + mat(k,2128) = .610_r8*rxt(k,501)*y(k,158) + .350_r8*rxt(k,502)*y(k,295) + mat(k,3043) = .940_r8*rxt(k,513)*y(k,269) + .340_r8*rxt(k,521)*y(k,273) & + + .400_r8*rxt(k,525)*y(k,275) + .810_r8*rxt(k,527)*y(k,276) & + + .130_r8*rxt(k,539)*y(k,293) + mat(k,3545) = rxt(k,353)*y(k,30) + mat(k,3701) = .830_r8*rxt(k,459)*y(k,115) + .700_r8*rxt(k,484)*y(k,121) & + + .610_r8*rxt(k,501)*y(k,139) + mat(k,3300) = .550_r8*rxt(k,457)*y(k,269) + .150_r8*rxt(k,471)*y(k,273) & + + .280_r8*rxt(k,479)*y(k,275) + .680_r8*rxt(k,482)*y(k,276) & + + .100_r8*rxt(k,499)*y(k,293) + mat(k,1123) = .940_r8*rxt(k,513)*y(k,147) + .550_r8*rxt(k,457)*y(k,258) + mat(k,1443) = .340_r8*rxt(k,521)*y(k,147) + .150_r8*rxt(k,471)*y(k,258) + mat(k,1312) = .400_r8*rxt(k,525)*y(k,147) + .280_r8*rxt(k,479)*y(k,258) + mat(k,1365) = .810_r8*rxt(k,527)*y(k,147) + .680_r8*rxt(k,482)*y(k,258) + mat(k,1638) = .130_r8*rxt(k,539)*y(k,147) + .100_r8*rxt(k,499)*y(k,258) + mat(k,4022) = mat(k,4022) + .350_r8*rxt(k,423)*y(k,108) + .500_r8*rxt(k,380) & + *y(k,127) + .500_r8*rxt(k,399)*y(k,133) + .350_r8*rxt(k,502) & + *y(k,139) + mat(k,3161) = -(rxt(k,173)*y(k,158) + 4._r8*rxt(k,174)*y(k,157) + rxt(k,176) & + *y(k,79) + rxt(k,177)*y(k,81) + rxt(k,182)*y(k,258) + rxt(k,188) & + *y(k,295) + (rxt(k,199) + rxt(k,201)) * y(k,148) + rxt(k,204) & + *y(k,149) + rxt(k,209)*y(k,147) + rxt(k,233)*y(k,61) + rxt(k,235) & + *y(k,60) + rxt(k,238)*y(k,87) + rxt(k,241)*y(k,96) + rxt(k,264) & + *y(k,21) + rxt(k,265)*y(k,20) + rxt(k,267)*y(k,83) + rxt(k,269) & + *y(k,95) + rxt(k,300)*y(k,43) + rxt(k,795)*y(k,161)) + mat(k,3758) = -rxt(k,173)*y(k,157) + mat(k,1678) = -rxt(k,176)*y(k,157) + mat(k,1489) = -rxt(k,177)*y(k,157) + mat(k,3367) = -rxt(k,182)*y(k,157) + mat(k,4090) = -rxt(k,188)*y(k,157) + mat(k,3656) = -(rxt(k,199) + rxt(k,201)) * y(k,157) + mat(k,3604) = -rxt(k,204)*y(k,157) + mat(k,3108) = -rxt(k,209)*y(k,157) + mat(k,1328) = -rxt(k,233)*y(k,157) + mat(k,3510) = -rxt(k,235)*y(k,157) + mat(k,3130) = -rxt(k,238)*y(k,157) + mat(k,1161) = -rxt(k,241)*y(k,157) + mat(k,565) = -rxt(k,264)*y(k,157) + mat(k,3484) = -rxt(k,265)*y(k,157) + mat(k,1153) = -rxt(k,267)*y(k,157) + mat(k,998) = -rxt(k,269)*y(k,157) + mat(k,3187) = -rxt(k,300)*y(k,157) + mat(k,391) = -rxt(k,795)*y(k,157) + mat(k,2934) = rxt(k,180)*y(k,258) + mat(k,480) = rxt(k,194)*y(k,147) + rxt(k,195)*y(k,148) + mat(k,3108) = mat(k,3108) + rxt(k,194)*y(k,136) + mat(k,3656) = mat(k,3656) + rxt(k,195)*y(k,136) + mat(k,3367) = mat(k,3367) + rxt(k,180)*y(k,78) + mat(k,4090) = mat(k,4090) + 2.000_r8*rxt(k,190)*y(k,295) + mat(k,3766) = -(rxt(k,172)*y(k,294) + rxt(k,173)*y(k,157) + rxt(k,183) & + *y(k,258) + rxt(k,184)*y(k,78) + rxt(k,189)*y(k,295) + rxt(k,200) & + *y(k,148) + rxt(k,208)*y(k,147) + rxt(k,224)*y(k,57) + rxt(k,256) & + *y(k,18) + rxt(k,323)*y(k,26) + rxt(k,354)*y(k,30) + rxt(k,385) & + *y(k,126) + rxt(k,403)*y(k,132) + rxt(k,459)*y(k,115) + rxt(k,469) & + *y(k,118) + rxt(k,484)*y(k,121) + rxt(k,486)*y(k,109) + rxt(k,501) & + *y(k,139) + rxt(k,568)*y(k,165) + rxt(k,602)*y(k,4) + rxt(k,622) & + *y(k,7) + rxt(k,642)*y(k,17) + rxt(k,662)*y(k,125) + rxt(k,682) & + *y(k,135) + rxt(k,762)*y(k,212) + rxt(k,767)*y(k,213) + rxt(k,799) & + *y(k,172) + rxt(k,805)*y(k,174)) + mat(k,3807) = -rxt(k,172)*y(k,158) + mat(k,3169) = -rxt(k,173)*y(k,158) + mat(k,3375) = -rxt(k,183)*y(k,158) + mat(k,2939) = -rxt(k,184)*y(k,158) + mat(k,4098) = -rxt(k,189)*y(k,158) + mat(k,3664) = -rxt(k,200)*y(k,158) + mat(k,3116) = -rxt(k,208)*y(k,158) + mat(k,3848) = -rxt(k,224)*y(k,158) + mat(k,2205) = -rxt(k,256)*y(k,158) + mat(k,591) = -rxt(k,323)*y(k,158) + mat(k,1398) = -rxt(k,354)*y(k,158) + mat(k,2028) = -rxt(k,385)*y(k,158) + mat(k,2053) = -rxt(k,403)*y(k,158) + mat(k,2089) = -rxt(k,459)*y(k,158) + mat(k,2121) = -rxt(k,469)*y(k,158) + mat(k,1593) = -rxt(k,484)*y(k,158) + mat(k,1428) = -rxt(k,486)*y(k,158) + mat(k,2150) = -rxt(k,501)*y(k,158) + mat(k,487) = -rxt(k,568)*y(k,158) + mat(k,1287) = -rxt(k,602)*y(k,158) + mat(k,1052) = -rxt(k,622)*y(k,158) + mat(k,1104) = -rxt(k,642)*y(k,158) + mat(k,1083) = -rxt(k,662)*y(k,158) + mat(k,836) = -rxt(k,682)*y(k,158) + mat(k,2643) = -rxt(k,762)*y(k,158) + mat(k,2615) = -rxt(k,767)*y(k,158) + mat(k,547) = -rxt(k,799)*y(k,158) + mat(k,1609) = -rxt(k,805)*y(k,158) + mat(k,2924) = .150_r8*rxt(k,337)*y(k,258) + mat(k,3375) = mat(k,3375) + .150_r8*rxt(k,337)*y(k,252) + .150_r8*rxt(k,390) & + *y(k,286) + .150_r8*rxt(k,703)*y(k,302) + .150_r8*rxt(k,721) & + *y(k,304) + .150_r8*rxt(k,751)*y(k,307) + mat(k,1631) = .150_r8*rxt(k,390)*y(k,258) + mat(k,2758) = .150_r8*rxt(k,703)*y(k,258) + mat(k,2804) = .150_r8*rxt(k,721)*y(k,258) + mat(k,2851) = .150_r8*rxt(k,751)*y(k,258) + mat(k,342) = -(rxt(k,806)*y(k,174)) + mat(k,1597) = -rxt(k,806)*y(k,160) + mat(k,3474) = rxt(k,258)*y(k,60) + mat(k,3500) = rxt(k,258)*y(k,20) + 2.000_r8*rxt(k,228)*y(k,60) + mat(k,385) = -(rxt(k,795)*y(k,157) + rxt(k,796)*y(k,295)) + mat(k,3143) = -rxt(k,795)*y(k,161) + mat(k,3909) = -rxt(k,796)*y(k,161) + mat(k,973) = rxt(k,379)*y(k,295) + mat(k,1911) = .500_r8*rxt(k,399)*y(k,295) + mat(k,3879) = rxt(k,379)*y(k,97) + .500_r8*rxt(k,399)*y(k,133) + mat(k,569) = -(rxt(k,349)*y(k,295)) + mat(k,3935) = -rxt(k,349)*y(k,163) + mat(k,3627) = rxt(k,351)*y(k,252) + mat(k,2855) = rxt(k,351)*y(k,148) + end do + end subroutine nlnmat08 + subroutine nlnmat09( 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,3617) = rxt(k,570)*y(k,235) + mat(k,549) = rxt(k,570)*y(k,148) + mat(k,484) = -(rxt(k,567)*y(k,148) + rxt(k,568)*y(k,158)) + mat(k,3623) = -rxt(k,567)*y(k,165) + mat(k,3675) = -rxt(k,568)*y(k,165) + mat(k,220) = .070_r8*rxt(k,554)*y(k,295) + mat(k,2987) = rxt(k,552)*y(k,251) + mat(k,194) = .060_r8*rxt(k,566)*y(k,295) + mat(k,238) = .070_r8*rxt(k,582)*y(k,295) + mat(k,710) = rxt(k,552)*y(k,147) + mat(k,3924) = .070_r8*rxt(k,554)*y(k,67) + .060_r8*rxt(k,566)*y(k,166) & + + .070_r8*rxt(k,582)*y(k,231) + mat(k,192) = -(rxt(k,566)*y(k,295)) + mat(k,3876) = -rxt(k,566)*y(k,166) + mat(k,184) = .530_r8*rxt(k,543)*y(k,295) + mat(k,3876) = mat(k,3876) + .530_r8*rxt(k,543)*y(k,8) + mat(k,347) = -(rxt(k,569)*y(k,295)) + mat(k,3902) = -rxt(k,569)*y(k,167) + mat(k,3220) = rxt(k,564)*y(k,296) + mat(k,455) = rxt(k,564)*y(k,258) + mat(k,577) = -(rxt(k,367)*y(k,295)) + mat(k,3936) = -rxt(k,367)*y(k,170) + mat(k,3240) = rxt(k,365)*y(k,297) + mat(k,938) = rxt(k,365)*y(k,258) + mat(k,405) = -(rxt(k,371)*y(k,295)) + mat(k,3911) = -rxt(k,371)*y(k,171) + mat(k,3226) = .850_r8*rxt(k,369)*y(k,298) + mat(k,1335) = .850_r8*rxt(k,369)*y(k,258) + mat(k,543) = -(rxt(k,799)*y(k,158) + rxt(k,802)*y(k,295)) + mat(k,3676) = -rxt(k,799)*y(k,172) + mat(k,3932) = -rxt(k,802)*y(k,172) + mat(k,1600) = -(rxt(k,800)*y(k,20) + rxt(k,801)*y(k,60) + rxt(k,803)*y(k,148) & + + rxt(k,805)*y(k,158) + rxt(k,806)*y(k,160) + rxt(k,807) & + *y(k,295)) + mat(k,3478) = -rxt(k,800)*y(k,174) + mat(k,3504) = -rxt(k,801)*y(k,174) + mat(k,3639) = -rxt(k,803)*y(k,174) + mat(k,3705) = -rxt(k,805)*y(k,174) + mat(k,344) = -rxt(k,806)*y(k,174) + mat(k,4032) = -rxt(k,807)*y(k,174) + mat(k,3152) = rxt(k,795)*y(k,161) + mat(k,3705) = mat(k,3705) + rxt(k,799)*y(k,172) + mat(k,388) = rxt(k,795)*y(k,157) + mat(k,544) = rxt(k,799)*y(k,158) + rxt(k,802)*y(k,295) + mat(k,4032) = mat(k,4032) + rxt(k,802)*y(k,172) + mat(k,1235) = -(rxt(k,798)*y(k,295)) + mat(k,4002) = -rxt(k,798)*y(k,175) + mat(k,3477) = rxt(k,800)*y(k,174) + mat(k,3502) = rxt(k,801)*y(k,174) + mat(k,305) = rxt(k,793)*y(k,149) + (rxt(k,794)+.500_r8*rxt(k,808))*y(k,295) + mat(k,3635) = rxt(k,803)*y(k,174) + mat(k,3537) = rxt(k,793)*y(k,69) + mat(k,3691) = rxt(k,805)*y(k,174) + mat(k,343) = rxt(k,806)*y(k,174) + mat(k,387) = rxt(k,796)*y(k,295) + mat(k,1599) = rxt(k,800)*y(k,20) + rxt(k,801)*y(k,60) + rxt(k,803)*y(k,148) & + + rxt(k,805)*y(k,158) + rxt(k,806)*y(k,160) + rxt(k,807) & + *y(k,295) + mat(k,4002) = mat(k,4002) + (rxt(k,794)+.500_r8*rxt(k,808))*y(k,69) & + + rxt(k,796)*y(k,161) + rxt(k,807)*y(k,174) + mat(k,279) = -(rxt(k,809)*y(k,319)) + mat(k,4104) = -rxt(k,809)*y(k,176) + mat(k,1234) = rxt(k,798)*y(k,295) + mat(k,3894) = rxt(k,798)*y(k,175) + mat(k,1265) = .0508005_r8*rxt(k,844)*y(k,158) + mat(k,1034) = .2202005_r8*rxt(k,849)*y(k,158) + mat(k,1085) = .0508005_r8*rxt(k,857)*y(k,158) + mat(k,1064) = .0508005_r8*rxt(k,870)*y(k,158) + mat(k,821) = .0508005_r8*rxt(k,875)*y(k,158) + mat(k,2962) = .0245005_r8*rxt(k,843)*y(k,239) + .1279005_r8*rxt(k,848) & + *y(k,242) + .0097005_r8*rxt(k,853)*y(k,244) & + + .0245005_r8*rxt(k,856)*y(k,247) + .0003005_r8*rxt(k,861) & + *y(k,277) + .1056005_r8*rxt(k,865)*y(k,280) & + + .0245005_r8*rxt(k,869)*y(k,283) + .0245005_r8*rxt(k,874) & + *y(k,292) + .0154005_r8*rxt(k,880)*y(k,315) & + + .0063005_r8*rxt(k,883)*y(k,317) + mat(k,3669) = .0508005_r8*rxt(k,844)*y(k,4) + .2202005_r8*rxt(k,849)*y(k,7) & + + .0508005_r8*rxt(k,857)*y(k,17) + .0508005_r8*rxt(k,870) & + *y(k,125) + .0508005_r8*rxt(k,875)*y(k,135) + mat(k,46) = .5931005_r8*rxt(k,877)*y(k,295) + mat(k,52) = .0245005_r8*rxt(k,843)*y(k,147) + .0508005_r8*rxt(k,842)*y(k,258) + mat(k,58) = .1279005_r8*rxt(k,848)*y(k,147) + .2202005_r8*rxt(k,847)*y(k,258) + mat(k,64) = .0097005_r8*rxt(k,853)*y(k,147) + .0023005_r8*rxt(k,852)*y(k,258) + mat(k,70) = .0245005_r8*rxt(k,856)*y(k,147) + .0508005_r8*rxt(k,855)*y(k,258) + mat(k,3200) = .0508005_r8*rxt(k,842)*y(k,239) + .2202005_r8*rxt(k,847) & + *y(k,242) + .0023005_r8*rxt(k,852)*y(k,244) & + + .0508005_r8*rxt(k,855)*y(k,247) + .0031005_r8*rxt(k,860) & + *y(k,277) + .2381005_r8*rxt(k,864)*y(k,280) & + + .0508005_r8*rxt(k,868)*y(k,283) + .0508005_r8*rxt(k,873) & + *y(k,292) + .1364005_r8*rxt(k,879)*y(k,315) & + + .1677005_r8*rxt(k,882)*y(k,317) + mat(k,76) = .0003005_r8*rxt(k,861)*y(k,147) + .0031005_r8*rxt(k,860)*y(k,258) + mat(k,82) = .1056005_r8*rxt(k,865)*y(k,147) + .2381005_r8*rxt(k,864)*y(k,258) + mat(k,90) = .0245005_r8*rxt(k,869)*y(k,147) + .0508005_r8*rxt(k,868)*y(k,258) + mat(k,96) = .0245005_r8*rxt(k,874)*y(k,147) + .0508005_r8*rxt(k,873)*y(k,258) + mat(k,3853) = .5931005_r8*rxt(k,877)*y(k,198) + mat(k,102) = .0154005_r8*rxt(k,880)*y(k,147) + .1364005_r8*rxt(k,879) & + *y(k,258) + mat(k,108) = .0063005_r8*rxt(k,883)*y(k,147) + .1677005_r8*rxt(k,882) & + *y(k,258) + mat(k,1266) = .1149005_r8*rxt(k,844)*y(k,158) + mat(k,1035) = .2067005_r8*rxt(k,849)*y(k,158) + mat(k,1086) = .1149005_r8*rxt(k,857)*y(k,158) + mat(k,1065) = .1149005_r8*rxt(k,870)*y(k,158) + mat(k,822) = .1149005_r8*rxt(k,875)*y(k,158) + mat(k,2963) = .0082005_r8*rxt(k,843)*y(k,239) + .1792005_r8*rxt(k,848) & + *y(k,242) + .0034005_r8*rxt(k,853)*y(k,244) & + + .0082005_r8*rxt(k,856)*y(k,247) + .0003005_r8*rxt(k,861) & + *y(k,277) + .1026005_r8*rxt(k,865)*y(k,280) & + + .0082005_r8*rxt(k,869)*y(k,283) + .0082005_r8*rxt(k,874) & + *y(k,292) + .0452005_r8*rxt(k,880)*y(k,315) & + + .0237005_r8*rxt(k,883)*y(k,317) + mat(k,3670) = .1149005_r8*rxt(k,844)*y(k,4) + .2067005_r8*rxt(k,849)*y(k,7) & + + .1149005_r8*rxt(k,857)*y(k,17) + .1149005_r8*rxt(k,870) & + *y(k,125) + .1149005_r8*rxt(k,875)*y(k,135) + mat(k,47) = .1534005_r8*rxt(k,877)*y(k,295) + mat(k,53) = .0082005_r8*rxt(k,843)*y(k,147) + .1149005_r8*rxt(k,842)*y(k,258) + mat(k,59) = .1792005_r8*rxt(k,848)*y(k,147) + .2067005_r8*rxt(k,847)*y(k,258) + mat(k,65) = .0034005_r8*rxt(k,853)*y(k,147) + .0008005_r8*rxt(k,852)*y(k,258) + mat(k,71) = .0082005_r8*rxt(k,856)*y(k,147) + .1149005_r8*rxt(k,855)*y(k,258) + mat(k,3201) = .1149005_r8*rxt(k,842)*y(k,239) + .2067005_r8*rxt(k,847) & + *y(k,242) + .0008005_r8*rxt(k,852)*y(k,244) & + + .1149005_r8*rxt(k,855)*y(k,247) + .0035005_r8*rxt(k,860) & + *y(k,277) + .1308005_r8*rxt(k,864)*y(k,280) & + + .1149005_r8*rxt(k,868)*y(k,283) + .1149005_r8*rxt(k,873) & + *y(k,292) + .0101005_r8*rxt(k,879)*y(k,315) & + + .0174005_r8*rxt(k,882)*y(k,317) + mat(k,77) = .0003005_r8*rxt(k,861)*y(k,147) + .0035005_r8*rxt(k,860)*y(k,258) + mat(k,83) = .1026005_r8*rxt(k,865)*y(k,147) + .1308005_r8*rxt(k,864)*y(k,258) + mat(k,91) = .0082005_r8*rxt(k,869)*y(k,147) + .1149005_r8*rxt(k,868)*y(k,258) + mat(k,97) = .0082005_r8*rxt(k,874)*y(k,147) + .1149005_r8*rxt(k,873)*y(k,258) + mat(k,3854) = .1534005_r8*rxt(k,877)*y(k,198) + mat(k,103) = .0452005_r8*rxt(k,880)*y(k,147) + .0101005_r8*rxt(k,879) & + *y(k,258) + mat(k,109) = .0237005_r8*rxt(k,883)*y(k,147) + .0174005_r8*rxt(k,882) & + *y(k,258) + mat(k,1267) = .0348005_r8*rxt(k,844)*y(k,158) + mat(k,1036) = .0653005_r8*rxt(k,849)*y(k,158) + mat(k,1087) = .0348005_r8*rxt(k,857)*y(k,158) + mat(k,1066) = .0348005_r8*rxt(k,870)*y(k,158) + mat(k,823) = .0348005_r8*rxt(k,875)*y(k,158) + mat(k,2964) = .0772005_r8*rxt(k,843)*y(k,239) + .0676005_r8*rxt(k,848) & + *y(k,242) + .1579005_r8*rxt(k,853)*y(k,244) & + + .0772005_r8*rxt(k,856)*y(k,247) + .0073005_r8*rxt(k,861) & + *y(k,277) + .0521005_r8*rxt(k,865)*y(k,280) & + + .0772005_r8*rxt(k,869)*y(k,283) + .0772005_r8*rxt(k,874) & + *y(k,292) + .0966005_r8*rxt(k,880)*y(k,315) & + + .0025005_r8*rxt(k,883)*y(k,317) + mat(k,3671) = .0348005_r8*rxt(k,844)*y(k,4) + .0653005_r8*rxt(k,849)*y(k,7) & + + .0348005_r8*rxt(k,857)*y(k,17) + .0348005_r8*rxt(k,870) & + *y(k,125) + .0348005_r8*rxt(k,875)*y(k,135) + mat(k,48) = .0459005_r8*rxt(k,877)*y(k,295) + mat(k,54) = .0772005_r8*rxt(k,843)*y(k,147) + .0348005_r8*rxt(k,842)*y(k,258) + mat(k,60) = .0676005_r8*rxt(k,848)*y(k,147) + .0653005_r8*rxt(k,847)*y(k,258) + mat(k,66) = .1579005_r8*rxt(k,853)*y(k,147) + .0843005_r8*rxt(k,852)*y(k,258) + mat(k,72) = .0772005_r8*rxt(k,856)*y(k,147) + .0348005_r8*rxt(k,855)*y(k,258) + mat(k,3202) = .0348005_r8*rxt(k,842)*y(k,239) + .0653005_r8*rxt(k,847) & + *y(k,242) + .0843005_r8*rxt(k,852)*y(k,244) & + + .0348005_r8*rxt(k,855)*y(k,247) + .0003005_r8*rxt(k,860) & + *y(k,277) + .0348005_r8*rxt(k,864)*y(k,280) & + + .0348005_r8*rxt(k,868)*y(k,283) + .0348005_r8*rxt(k,873) & + *y(k,292) + .0763005_r8*rxt(k,879)*y(k,315) + .086_r8*rxt(k,882) & + *y(k,317) + mat(k,78) = .0073005_r8*rxt(k,861)*y(k,147) + .0003005_r8*rxt(k,860)*y(k,258) + mat(k,84) = .0521005_r8*rxt(k,865)*y(k,147) + .0348005_r8*rxt(k,864)*y(k,258) + mat(k,92) = .0772005_r8*rxt(k,869)*y(k,147) + .0348005_r8*rxt(k,868)*y(k,258) + mat(k,98) = .0772005_r8*rxt(k,874)*y(k,147) + .0348005_r8*rxt(k,873)*y(k,258) + mat(k,3855) = .0459005_r8*rxt(k,877)*y(k,198) + mat(k,104) = .0966005_r8*rxt(k,880)*y(k,147) + .0763005_r8*rxt(k,879) & + *y(k,258) + mat(k,110) = .0025005_r8*rxt(k,883)*y(k,147) + .086_r8*rxt(k,882)*y(k,258) + mat(k,1268) = .1749305_r8*rxt(k,841)*y(k,149) + .0554005_r8*rxt(k,844) & + *y(k,158) + mat(k,1037) = .1749305_r8*rxt(k,846)*y(k,149) + .1284005_r8*rxt(k,849) & + *y(k,158) + mat(k,1088) = .1749305_r8*rxt(k,854)*y(k,149) + .0554005_r8*rxt(k,857) & + *y(k,158) + mat(k,1401) = .0590245_r8*rxt(k,859)*y(k,149) + .0033005_r8*rxt(k,862) & + *y(k,158) + mat(k,1067) = .1749305_r8*rxt(k,867)*y(k,149) + .0554005_r8*rxt(k,870) & + *y(k,158) + mat(k,824) = .1749305_r8*rxt(k,872)*y(k,149) + .0554005_r8*rxt(k,875) & + *y(k,158) + mat(k,2965) = .0332005_r8*rxt(k,843)*y(k,239) + .079_r8*rxt(k,848)*y(k,242) & + + .0059005_r8*rxt(k,853)*y(k,244) + .0332005_r8*rxt(k,856) & + *y(k,247) + .0057005_r8*rxt(k,861)*y(k,277) & + + .0143005_r8*rxt(k,865)*y(k,280) + .0332005_r8*rxt(k,869) & + *y(k,283) + .0332005_r8*rxt(k,874)*y(k,292) & + + .0073005_r8*rxt(k,880)*y(k,315) + .011_r8*rxt(k,883)*y(k,317) + mat(k,3523) = .1749305_r8*rxt(k,841)*y(k,4) + .1749305_r8*rxt(k,846)*y(k,7) & + + .1749305_r8*rxt(k,854)*y(k,17) + .0590245_r8*rxt(k,859) & + *y(k,109) + .1749305_r8*rxt(k,867)*y(k,125) & + + .1749305_r8*rxt(k,872)*y(k,135) + mat(k,3672) = .0554005_r8*rxt(k,844)*y(k,4) + .1284005_r8*rxt(k,849)*y(k,7) & + + .0554005_r8*rxt(k,857)*y(k,17) + .0033005_r8*rxt(k,862) & + *y(k,109) + .0554005_r8*rxt(k,870)*y(k,125) & + + .0554005_r8*rxt(k,875)*y(k,135) + mat(k,49) = .0085005_r8*rxt(k,877)*y(k,295) + mat(k,55) = .0332005_r8*rxt(k,843)*y(k,147) + .0554005_r8*rxt(k,842)*y(k,258) + mat(k,61) = .079_r8*rxt(k,848)*y(k,147) + .1284005_r8*rxt(k,847)*y(k,258) + mat(k,67) = .0059005_r8*rxt(k,853)*y(k,147) + .0443005_r8*rxt(k,852)*y(k,258) + mat(k,73) = .0332005_r8*rxt(k,856)*y(k,147) + .0554005_r8*rxt(k,855)*y(k,258) + mat(k,3203) = .0554005_r8*rxt(k,842)*y(k,239) + .1284005_r8*rxt(k,847) & + *y(k,242) + .0443005_r8*rxt(k,852)*y(k,244) & + + .0554005_r8*rxt(k,855)*y(k,247) + .0271005_r8*rxt(k,860) & + *y(k,277) + .0076005_r8*rxt(k,864)*y(k,280) & + + .0554005_r8*rxt(k,868)*y(k,283) + .0554005_r8*rxt(k,873) & + *y(k,292) + .2157005_r8*rxt(k,879)*y(k,315) & + + .0512005_r8*rxt(k,882)*y(k,317) + mat(k,79) = .0057005_r8*rxt(k,861)*y(k,147) + .0271005_r8*rxt(k,860)*y(k,258) + mat(k,85) = .0143005_r8*rxt(k,865)*y(k,147) + .0076005_r8*rxt(k,864)*y(k,258) + mat(k,93) = .0332005_r8*rxt(k,869)*y(k,147) + .0554005_r8*rxt(k,868)*y(k,258) + mat(k,99) = .0332005_r8*rxt(k,874)*y(k,147) + .0554005_r8*rxt(k,873)*y(k,258) + mat(k,3856) = .0085005_r8*rxt(k,877)*y(k,198) + mat(k,105) = .0073005_r8*rxt(k,880)*y(k,147) + .2157005_r8*rxt(k,879) & + *y(k,258) + mat(k,111) = .011_r8*rxt(k,883)*y(k,147) + .0512005_r8*rxt(k,882)*y(k,258) + end do + end subroutine nlnmat09 + subroutine nlnmat10( 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,1269) = .5901905_r8*rxt(k,841)*y(k,149) + .1278005_r8*rxt(k,844) & + *y(k,158) + mat(k,1038) = .5901905_r8*rxt(k,846)*y(k,149) + .114_r8*rxt(k,849)*y(k,158) + mat(k,1089) = .5901905_r8*rxt(k,854)*y(k,149) + .1278005_r8*rxt(k,857) & + *y(k,158) + mat(k,1402) = .0250245_r8*rxt(k,859)*y(k,149) + mat(k,1068) = .5901905_r8*rxt(k,867)*y(k,149) + .1278005_r8*rxt(k,870) & + *y(k,158) + mat(k,825) = .5901905_r8*rxt(k,872)*y(k,149) + .1278005_r8*rxt(k,875) & + *y(k,158) + mat(k,2966) = .130_r8*rxt(k,843)*y(k,239) + .1254005_r8*rxt(k,848)*y(k,242) & + + .0536005_r8*rxt(k,853)*y(k,244) + .130_r8*rxt(k,856)*y(k,247) & + + .0623005_r8*rxt(k,861)*y(k,277) + .0166005_r8*rxt(k,865) & + *y(k,280) + .130_r8*rxt(k,869)*y(k,283) + .130_r8*rxt(k,874) & + *y(k,292) + .238_r8*rxt(k,880)*y(k,315) + .1185005_r8*rxt(k,883) & + *y(k,317) + mat(k,3524) = .5901905_r8*rxt(k,841)*y(k,4) + .5901905_r8*rxt(k,846)*y(k,7) & + + .5901905_r8*rxt(k,854)*y(k,17) + .0250245_r8*rxt(k,859) & + *y(k,109) + .5901905_r8*rxt(k,867)*y(k,125) & + + .5901905_r8*rxt(k,872)*y(k,135) + mat(k,3673) = .1278005_r8*rxt(k,844)*y(k,4) + .114_r8*rxt(k,849)*y(k,7) & + + .1278005_r8*rxt(k,857)*y(k,17) + .1278005_r8*rxt(k,870) & + *y(k,125) + .1278005_r8*rxt(k,875)*y(k,135) + mat(k,50) = .0128005_r8*rxt(k,877)*y(k,295) + mat(k,56) = .130_r8*rxt(k,843)*y(k,147) + .1278005_r8*rxt(k,842)*y(k,258) + mat(k,62) = .1254005_r8*rxt(k,848)*y(k,147) + .114_r8*rxt(k,847)*y(k,258) + mat(k,68) = .0536005_r8*rxt(k,853)*y(k,147) + .1621005_r8*rxt(k,852)*y(k,258) + mat(k,74) = .130_r8*rxt(k,856)*y(k,147) + .1278005_r8*rxt(k,855)*y(k,258) + mat(k,3204) = .1278005_r8*rxt(k,842)*y(k,239) + .114_r8*rxt(k,847)*y(k,242) & + + .1621005_r8*rxt(k,852)*y(k,244) + .1278005_r8*rxt(k,855) & + *y(k,247) + .0474005_r8*rxt(k,860)*y(k,277) & + + .0113005_r8*rxt(k,864)*y(k,280) + .1278005_r8*rxt(k,868) & + *y(k,283) + .1278005_r8*rxt(k,873)*y(k,292) & + + .0738005_r8*rxt(k,879)*y(k,315) + .1598005_r8*rxt(k,882) & + *y(k,317) + mat(k,80) = .0623005_r8*rxt(k,861)*y(k,147) + .0474005_r8*rxt(k,860)*y(k,258) + mat(k,86) = .0166005_r8*rxt(k,865)*y(k,147) + .0113005_r8*rxt(k,864)*y(k,258) + mat(k,94) = .130_r8*rxt(k,869)*y(k,147) + .1278005_r8*rxt(k,868)*y(k,258) + mat(k,100) = .130_r8*rxt(k,874)*y(k,147) + .1278005_r8*rxt(k,873)*y(k,258) + mat(k,3857) = .0128005_r8*rxt(k,877)*y(k,198) + mat(k,106) = .238_r8*rxt(k,880)*y(k,147) + .0738005_r8*rxt(k,879)*y(k,258) + mat(k,112) = .1185005_r8*rxt(k,883)*y(k,147) + .1598005_r8*rxt(k,882) & + *y(k,258) + mat(k,2967) = .070_r8*rxt(k,609)*y(k,240) + .300_r8*rxt(k,617)*y(k,241) + mat(k,2209) = .070_r8*rxt(k,609)*y(k,147) + .720_r8*rxt(k,605)*y(k,240) & + + .180_r8*rxt(k,607)*y(k,253) + .500_r8*rxt(k,608)*y(k,258) + mat(k,2399) = .300_r8*rxt(k,617)*y(k,147) + mat(k,3380) = .180_r8*rxt(k,607)*y(k,240) + mat(k,3205) = .500_r8*rxt(k,608)*y(k,240) + mat(k,51) = -(rxt(k,877)*y(k,295)) + mat(k,3858) = -rxt(k,877)*y(k,198) + mat(k,213) = .100_r8*rxt(k,574)*y(k,295) + mat(k,228) = .230_r8*rxt(k,576)*y(k,295) + mat(k,3882) = .100_r8*rxt(k,574)*y(k,228) + .230_r8*rxt(k,576)*y(k,229) + mat(k,2320) = -(rxt(k,689)*y(k,295)) + mat(k,4067) = -rxt(k,689)*y(k,200) + mat(k,3085) = .110_r8*rxt(k,597)*y(k,238) + .700_r8*rxt(k,692)*y(k,300) + mat(k,3581) = .140_r8*rxt(k,598)*y(k,238) + mat(k,2439) = .110_r8*rxt(k,597)*y(k,147) + .140_r8*rxt(k,598)*y(k,149) & + + .140_r8*rxt(k,594)*y(k,252) + .130_r8*rxt(k,595)*y(k,253) & + + .250_r8*rxt(k,596)*y(k,258) + .140_r8*rxt(k,599)*y(k,302) & + + .140_r8*rxt(k,600)*y(k,304) + .140_r8*rxt(k,601)*y(k,307) + mat(k,2378) = .680_r8*rxt(k,636)*y(k,258) + mat(k,2895) = .140_r8*rxt(k,594)*y(k,238) + mat(k,3437) = .130_r8*rxt(k,595)*y(k,238) + mat(k,3344) = .250_r8*rxt(k,596)*y(k,238) + .680_r8*rxt(k,636)*y(k,246) & + + .900_r8*rxt(k,656)*y(k,282) + .180_r8*rxt(k,691)*y(k,300) & + + .900_r8*rxt(k,765)*y(k,309) + mat(k,2338) = .900_r8*rxt(k,656)*y(k,258) + mat(k,1008) = .700_r8*rxt(k,692)*y(k,147) + .180_r8*rxt(k,691)*y(k,258) + mat(k,2730) = .140_r8*rxt(k,599)*y(k,238) + mat(k,2776) = .140_r8*rxt(k,600)*y(k,238) + mat(k,2823) = .140_r8*rxt(k,601)*y(k,238) + mat(k,963) = .900_r8*rxt(k,765)*y(k,258) + mat(k,471) = -(rxt(k,690)*y(k,295)) + mat(k,3922) = -rxt(k,690)*y(k,201) + mat(k,2400) = .900_r8*rxt(k,616)*y(k,258) + mat(k,3235) = .900_r8*rxt(k,616)*y(k,241) + .900_r8*rxt(k,676)*y(k,291) + mat(k,2460) = .900_r8*rxt(k,676)*y(k,258) + mat(k,2359) = -(rxt(k,755)*y(k,149) + rxt(k,756)*y(k,295)) + mat(k,3583) = -rxt(k,755)*y(k,202) + mat(k,4069) = -rxt(k,756)*y(k,202) + mat(k,1278) = .220_r8*rxt(k,602)*y(k,158) + mat(k,3087) = .930_r8*rxt(k,589)*y(k,237) + .300_r8*rxt(k,597)*y(k,238) + mat(k,3583) = mat(k,3583) + rxt(k,590)*y(k,237) + .390_r8*rxt(k,598)*y(k,238) + mat(k,3737) = .220_r8*rxt(k,602)*y(k,4) + mat(k,1558) = rxt(k,783)*y(k,295) + mat(k,1537) = rxt(k,787)*y(k,295) + mat(k,690) = rxt(k,789)*y(k,295) + mat(k,2297) = .930_r8*rxt(k,589)*y(k,147) + rxt(k,590)*y(k,149) & + + 3.280_r8*rxt(k,585)*y(k,237) + rxt(k,586)*y(k,252) & + + .820_r8*rxt(k,587)*y(k,253) + .700_r8*rxt(k,588)*y(k,258) & + + rxt(k,591)*y(k,302) + rxt(k,592)*y(k,304) + rxt(k,593) & + *y(k,307) + mat(k,2440) = .300_r8*rxt(k,597)*y(k,147) + .390_r8*rxt(k,598)*y(k,149) & + + .390_r8*rxt(k,594)*y(k,252) + .420_r8*rxt(k,595)*y(k,253) & + + .290_r8*rxt(k,596)*y(k,258) + .390_r8*rxt(k,599)*y(k,302) & + + .390_r8*rxt(k,600)*y(k,304) + .390_r8*rxt(k,601)*y(k,307) + mat(k,2897) = rxt(k,586)*y(k,237) + .390_r8*rxt(k,594)*y(k,238) + mat(k,3439) = .820_r8*rxt(k,587)*y(k,237) + .420_r8*rxt(k,595)*y(k,238) + mat(k,3346) = .700_r8*rxt(k,588)*y(k,237) + .290_r8*rxt(k,596)*y(k,238) + mat(k,4069) = mat(k,4069) + rxt(k,783)*y(k,221) + rxt(k,787)*y(k,223) & + + rxt(k,789)*y(k,225) + mat(k,2732) = rxt(k,591)*y(k,237) + .390_r8*rxt(k,599)*y(k,238) + mat(k,2778) = rxt(k,592)*y(k,237) + .390_r8*rxt(k,600)*y(k,238) + mat(k,2825) = rxt(k,593)*y(k,237) + .390_r8*rxt(k,601)*y(k,238) + mat(k,1289) = -(rxt(k,708)*y(k,149) + rxt(k,717)*y(k,295)) + mat(k,3539) = -rxt(k,708)*y(k,203) + mat(k,4006) = -rxt(k,717)*y(k,203) + mat(k,1273) = .170_r8*rxt(k,602)*y(k,158) + mat(k,3693) = .170_r8*rxt(k,602)*y(k,4) + mat(k,424) = rxt(k,757)*y(k,295) + mat(k,3389) = .500_r8*rxt(k,694)*y(k,301) + mat(k,4006) = mat(k,4006) + rxt(k,757)*y(k,210) + mat(k,2648) = .500_r8*rxt(k,694)*y(k,253) + mat(k,655) = -(rxt(k,718)*y(k,295)) + mat(k,3945) = -rxt(k,718)*y(k,204) + mat(k,3628) = rxt(k,684)*y(k,302) + mat(k,2717) = rxt(k,684)*y(k,148) + mat(k,1718) = -(rxt(k,727)*y(k,149) + rxt(k,736)*y(k,295)) + mat(k,3556) = -rxt(k,727)*y(k,205) + mat(k,4041) = -rxt(k,736)*y(k,205) + mat(k,3058) = .270_r8*rxt(k,597)*y(k,238) + .440_r8*rxt(k,629)*y(k,245) & + + .310_r8*rxt(k,637)*y(k,246) + .700_r8*rxt(k,761)*y(k,308) + mat(k,3556) = mat(k,3556) + rxt(k,759)*y(k,212) + .350_r8*rxt(k,598)*y(k,238) & + + .480_r8*rxt(k,630)*y(k,245) + .410_r8*rxt(k,638)*y(k,246) + mat(k,3710) = rxt(k,762)*y(k,212) + mat(k,2626) = rxt(k,759)*y(k,149) + rxt(k,762)*y(k,158) + mat(k,602) = rxt(k,788)*y(k,295) + mat(k,2436) = .270_r8*rxt(k,597)*y(k,147) + .350_r8*rxt(k,598)*y(k,149) & + + .350_r8*rxt(k,594)*y(k,252) + .200_r8*rxt(k,595)*y(k,253) & + + .350_r8*rxt(k,599)*y(k,302) + .350_r8*rxt(k,600)*y(k,304) & + + .350_r8*rxt(k,601)*y(k,307) + mat(k,2533) = .440_r8*rxt(k,629)*y(k,147) + .480_r8*rxt(k,630)*y(k,149) & + + 1.800_r8*rxt(k,625)*y(k,245) + .480_r8*rxt(k,626)*y(k,252) & + + .340_r8*rxt(k,627)*y(k,253) + .220_r8*rxt(k,628)*y(k,258) & + + .480_r8*rxt(k,631)*y(k,302) + .480_r8*rxt(k,632)*y(k,304) & + + .480_r8*rxt(k,633)*y(k,307) + mat(k,2375) = .310_r8*rxt(k,637)*y(k,147) + .410_r8*rxt(k,638)*y(k,149) & + + .410_r8*rxt(k,634)*y(k,252) + .310_r8*rxt(k,635)*y(k,253) & + + .410_r8*rxt(k,639)*y(k,302) + .410_r8*rxt(k,640)*y(k,304) & + + .410_r8*rxt(k,641)*y(k,307) + mat(k,2870) = .350_r8*rxt(k,594)*y(k,238) + .480_r8*rxt(k,626)*y(k,245) & + + .410_r8*rxt(k,634)*y(k,246) + mat(k,3411) = .200_r8*rxt(k,595)*y(k,238) + .340_r8*rxt(k,627)*y(k,245) & + + .310_r8*rxt(k,635)*y(k,246) + mat(k,3317) = .220_r8*rxt(k,628)*y(k,245) + .100_r8*rxt(k,760)*y(k,308) + mat(k,4041) = mat(k,4041) + rxt(k,788)*y(k,226) + mat(k,2724) = .350_r8*rxt(k,599)*y(k,238) + .480_r8*rxt(k,631)*y(k,245) & + + .410_r8*rxt(k,639)*y(k,246) + mat(k,2770) = .350_r8*rxt(k,600)*y(k,238) + .480_r8*rxt(k,632)*y(k,245) & + + .410_r8*rxt(k,640)*y(k,246) + mat(k,2817) = .350_r8*rxt(k,601)*y(k,238) + .480_r8*rxt(k,633)*y(k,245) & + + .410_r8*rxt(k,641)*y(k,246) + mat(k,799) = .700_r8*rxt(k,761)*y(k,147) + .100_r8*rxt(k,760)*y(k,258) + mat(k,664) = -(rxt(k,737)*y(k,295)) + mat(k,3946) = -rxt(k,737)*y(k,206) + mat(k,3629) = rxt(k,685)*y(k,304) + mat(k,2763) = rxt(k,685)*y(k,148) + mat(k,778) = -(rxt(k,748)*y(k,295)) + mat(k,3958) = -rxt(k,748)*y(k,207) + mat(k,1271) = .010_r8*rxt(k,602)*y(k,158) + mat(k,1040) = .130_r8*rxt(k,622)*y(k,158) + mat(k,1070) = .010_r8*rxt(k,662)*y(k,158) + mat(k,3679) = .010_r8*rxt(k,602)*y(k,4) + .130_r8*rxt(k,622)*y(k,7) & + + .010_r8*rxt(k,662)*y(k,125) + mat(k,3251) = .510_r8*rxt(k,751)*y(k,307) + mat(k,2809) = .510_r8*rxt(k,751)*y(k,258) + mat(k,363) = -(rxt(k,746)*y(k,295)) + mat(k,3905) = -rxt(k,746)*y(k,208) + mat(k,3223) = .510_r8*rxt(k,703)*y(k,302) + mat(k,2716) = .510_r8*rxt(k,703)*y(k,258) + mat(k,368) = -(rxt(k,747)*y(k,295)) + mat(k,3906) = -rxt(k,747)*y(k,209) + mat(k,3224) = .510_r8*rxt(k,721)*y(k,304) + mat(k,2762) = .510_r8*rxt(k,721)*y(k,258) + mat(k,423) = -(rxt(k,757)*y(k,295)) + mat(k,3914) = -rxt(k,757)*y(k,210) + mat(k,3620) = rxt(k,686)*y(k,307) + mat(k,2808) = rxt(k,686)*y(k,148) + mat(k,373) = -(rxt(k,758)*y(k,295)) + mat(k,3907) = -rxt(k,758)*y(k,211) + mat(k,3225) = .820_r8*rxt(k,687)*y(k,299) + .820_r8*rxt(k,691)*y(k,300) + mat(k,948) = .820_r8*rxt(k,687)*y(k,258) + mat(k,1003) = .820_r8*rxt(k,691)*y(k,258) + mat(k,2629) = -(rxt(k,759)*y(k,149) + rxt(k,762)*y(k,158) + rxt(k,763) & + *y(k,295)) + mat(k,3592) = -rxt(k,759)*y(k,212) + mat(k,3746) = -rxt(k,762)*y(k,212) + mat(k,4078) = -rxt(k,763)*y(k,212) + mat(k,1076) = .660_r8*rxt(k,662)*y(k,158) + mat(k,3096) = .090_r8*rxt(k,597)*y(k,238) + .200_r8*rxt(k,637)*y(k,246) & + + .430_r8*rxt(k,649)*y(k,281) + .770_r8*rxt(k,657)*y(k,282) & + + .700_r8*rxt(k,766)*y(k,309) + mat(k,3592) = mat(k,3592) + .500_r8*rxt(k,764)*y(k,213) + .120_r8*rxt(k,598) & + *y(k,238) + .270_r8*rxt(k,638)*y(k,246) + .460_r8*rxt(k,650) & + *y(k,281) + rxt(k,658)*y(k,282) + mat(k,3746) = mat(k,3746) + .660_r8*rxt(k,662)*y(k,125) + rxt(k,767)*y(k,213) + mat(k,2601) = .500_r8*rxt(k,764)*y(k,149) + rxt(k,767)*y(k,158) + mat(k,2442) = .090_r8*rxt(k,597)*y(k,147) + .120_r8*rxt(k,598)*y(k,149) & + + .120_r8*rxt(k,594)*y(k,252) + .140_r8*rxt(k,595)*y(k,253) & + + .060_r8*rxt(k,596)*y(k,258) + .120_r8*rxt(k,599)*y(k,302) & + + .120_r8*rxt(k,600)*y(k,304) + .120_r8*rxt(k,601)*y(k,307) + mat(k,2381) = .200_r8*rxt(k,637)*y(k,147) + .270_r8*rxt(k,638)*y(k,149) & + + .270_r8*rxt(k,634)*y(k,252) + .370_r8*rxt(k,635)*y(k,253) & + + .270_r8*rxt(k,639)*y(k,302) + .270_r8*rxt(k,640)*y(k,304) & + + .270_r8*rxt(k,641)*y(k,307) + mat(k,2906) = .120_r8*rxt(k,594)*y(k,238) + .270_r8*rxt(k,634)*y(k,246) & + + .460_r8*rxt(k,645)*y(k,281) + rxt(k,654)*y(k,282) + mat(k,3448) = .140_r8*rxt(k,595)*y(k,238) + .370_r8*rxt(k,635)*y(k,246) & + + .310_r8*rxt(k,646)*y(k,281) + rxt(k,655)*y(k,282) + mat(k,3355) = .060_r8*rxt(k,596)*y(k,238) + .230_r8*rxt(k,647)*y(k,281) & + + .100_r8*rxt(k,656)*y(k,282) + .100_r8*rxt(k,765)*y(k,309) + mat(k,2507) = .430_r8*rxt(k,649)*y(k,147) + .460_r8*rxt(k,650)*y(k,149) & + + .460_r8*rxt(k,645)*y(k,252) + .310_r8*rxt(k,646)*y(k,253) & + + .230_r8*rxt(k,647)*y(k,258) + 1.720_r8*rxt(k,648)*y(k,281) & + + .460_r8*rxt(k,651)*y(k,302) + .460_r8*rxt(k,652)*y(k,304) & + + .460_r8*rxt(k,653)*y(k,307) + mat(k,2341) = .770_r8*rxt(k,657)*y(k,147) + rxt(k,658)*y(k,149) + rxt(k,654) & + *y(k,252) + rxt(k,655)*y(k,253) + .100_r8*rxt(k,656)*y(k,258) & + + rxt(k,659)*y(k,302) + rxt(k,660)*y(k,304) + rxt(k,661) & + *y(k,307) + mat(k,2741) = .120_r8*rxt(k,599)*y(k,238) + .270_r8*rxt(k,639)*y(k,246) & + + .460_r8*rxt(k,651)*y(k,281) + rxt(k,659)*y(k,282) + mat(k,2787) = .120_r8*rxt(k,600)*y(k,238) + .270_r8*rxt(k,640)*y(k,246) & + + .460_r8*rxt(k,652)*y(k,281) + rxt(k,660)*y(k,282) + mat(k,2834) = .120_r8*rxt(k,601)*y(k,238) + .270_r8*rxt(k,641)*y(k,246) & + + .460_r8*rxt(k,653)*y(k,281) + rxt(k,661)*y(k,282) + mat(k,964) = .700_r8*rxt(k,766)*y(k,147) + .100_r8*rxt(k,765)*y(k,258) + end do + end subroutine nlnmat10 + subroutine nlnmat11( 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,2600) = -(rxt(k,764)*y(k,149) + rxt(k,767)*y(k,158) + rxt(k,768) & + *y(k,295)) + mat(k,3591) = -rxt(k,764)*y(k,213) + mat(k,3745) = -rxt(k,767)*y(k,213) + mat(k,4077) = -rxt(k,768)*y(k,213) + mat(k,1046) = .870_r8*rxt(k,622)*y(k,158) + mat(k,832) = rxt(k,682)*y(k,158) + mat(k,3095) = .930_r8*rxt(k,609)*y(k,240) + .700_r8*rxt(k,617)*y(k,241) & + + .890_r8*rxt(k,669)*y(k,290) + .710_r8*rxt(k,677)*y(k,291) + mat(k,3591) = mat(k,3591) + rxt(k,610)*y(k,240) + rxt(k,618)*y(k,241) & + + .950_r8*rxt(k,670)*y(k,290) + rxt(k,678)*y(k,291) + mat(k,3745) = mat(k,3745) + .870_r8*rxt(k,622)*y(k,7) + rxt(k,682)*y(k,135) + mat(k,2214) = .930_r8*rxt(k,609)*y(k,147) + rxt(k,610)*y(k,149) & + + 3.280_r8*rxt(k,605)*y(k,240) + rxt(k,606)*y(k,252) & + + .820_r8*rxt(k,607)*y(k,253) + .500_r8*rxt(k,608)*y(k,258) & + + rxt(k,611)*y(k,302) + rxt(k,612)*y(k,304) + rxt(k,613) & + *y(k,307) + mat(k,2409) = .700_r8*rxt(k,617)*y(k,147) + rxt(k,618)*y(k,149) + rxt(k,614) & + *y(k,252) + rxt(k,615)*y(k,253) + .100_r8*rxt(k,616)*y(k,258) & + + rxt(k,619)*y(k,302) + rxt(k,620)*y(k,304) + rxt(k,621) & + *y(k,307) + mat(k,2905) = rxt(k,606)*y(k,240) + rxt(k,614)*y(k,241) + .950_r8*rxt(k,665) & + *y(k,290) + rxt(k,674)*y(k,291) + mat(k,3447) = .820_r8*rxt(k,607)*y(k,240) + rxt(k,615)*y(k,241) & + + .770_r8*rxt(k,666)*y(k,290) + rxt(k,675)*y(k,291) + mat(k,3354) = .500_r8*rxt(k,608)*y(k,240) + .100_r8*rxt(k,616)*y(k,241) & + + .480_r8*rxt(k,667)*y(k,290) + .100_r8*rxt(k,676)*y(k,291) + mat(k,2571) = .890_r8*rxt(k,669)*y(k,147) + .950_r8*rxt(k,670)*y(k,149) & + + .950_r8*rxt(k,665)*y(k,252) + .770_r8*rxt(k,666)*y(k,253) & + + .480_r8*rxt(k,667)*y(k,258) + 3.080_r8*rxt(k,668)*y(k,290) & + + .950_r8*rxt(k,671)*y(k,302) + .950_r8*rxt(k,672)*y(k,304) & + + .950_r8*rxt(k,673)*y(k,307) + mat(k,2472) = .710_r8*rxt(k,677)*y(k,147) + rxt(k,678)*y(k,149) + rxt(k,674) & + *y(k,252) + rxt(k,675)*y(k,253) + .100_r8*rxt(k,676)*y(k,258) & + + rxt(k,679)*y(k,302) + rxt(k,680)*y(k,304) + rxt(k,681) & + *y(k,307) + mat(k,2740) = rxt(k,611)*y(k,240) + rxt(k,619)*y(k,241) + .950_r8*rxt(k,671) & + *y(k,290) + rxt(k,679)*y(k,291) + mat(k,2786) = rxt(k,612)*y(k,240) + rxt(k,620)*y(k,241) + .950_r8*rxt(k,672) & + *y(k,290) + rxt(k,680)*y(k,291) + mat(k,2833) = rxt(k,613)*y(k,240) + rxt(k,621)*y(k,241) + .950_r8*rxt(k,673) & + *y(k,290) + rxt(k,681)*y(k,291) + mat(k,1228) = -(rxt(k,769)*y(k,295)) + mat(k,4001) = -rxt(k,769)*y(k,214) + mat(k,3030) = .070_r8*rxt(k,589)*y(k,237) + .070_r8*rxt(k,629)*y(k,245) & + + .070_r8*rxt(k,649)*y(k,281) + .070_r8*rxt(k,669)*y(k,290) & + + .300_r8*rxt(k,773)*y(k,310) + .300_r8*rxt(k,777)*y(k,311) & + + .300_r8*rxt(k,781)*y(k,312) + .300_r8*rxt(k,785)*y(k,313) + mat(k,2290) = .070_r8*rxt(k,589)*y(k,147) + mat(k,2528) = .070_r8*rxt(k,629)*y(k,147) + mat(k,2496) = .070_r8*rxt(k,649)*y(k,147) + mat(k,2559) = .070_r8*rxt(k,669)*y(k,147) + mat(k,1219) = .300_r8*rxt(k,773)*y(k,147) + mat(k,1017) = .300_r8*rxt(k,777)*y(k,147) + mat(k,807) = .300_r8*rxt(k,781)*y(k,147) + mat(k,815) = .300_r8*rxt(k,785)*y(k,147) + mat(k,969) = -(rxt(k,770)*y(k,295)) + mat(k,3979) = -rxt(k,770)*y(k,215) + mat(k,3014) = .010_r8*rxt(k,597)*y(k,238) + .300_r8*rxt(k,688)*y(k,299) & + + .300_r8*rxt(k,692)*y(k,300) + .300_r8*rxt(k,761)*y(k,308) + mat(k,2428) = .010_r8*rxt(k,597)*y(k,147) + mat(k,3269) = .900_r8*rxt(k,772)*y(k,310) + .900_r8*rxt(k,776)*y(k,311) & + + .900_r8*rxt(k,780)*y(k,312) + .900_r8*rxt(k,784)*y(k,313) + mat(k,952) = .300_r8*rxt(k,688)*y(k,147) + mat(k,1005) = .300_r8*rxt(k,692)*y(k,147) + mat(k,798) = .300_r8*rxt(k,761)*y(k,147) + mat(k,1216) = .900_r8*rxt(k,772)*y(k,258) + mat(k,1014) = .900_r8*rxt(k,776)*y(k,258) + mat(k,806) = .900_r8*rxt(k,780)*y(k,258) + mat(k,814) = .900_r8*rxt(k,784)*y(k,258) + mat(k,1106) = -(rxt(k,771)*y(k,295)) + mat(k,3989) = -rxt(k,771)*y(k,216) + mat(k,1093) = .510_r8*rxt(k,642)*y(k,158) + mat(k,3021) = .020_r8*rxt(k,629)*y(k,245) + .240_r8*rxt(k,637)*y(k,246) + mat(k,3534) = .020_r8*rxt(k,630)*y(k,245) + .320_r8*rxt(k,638)*y(k,246) + mat(k,3688) = .510_r8*rxt(k,642)*y(k,17) + mat(k,2429) = .110_r8*rxt(k,595)*y(k,253) + mat(k,2526) = .020_r8*rxt(k,629)*y(k,147) + .020_r8*rxt(k,630)*y(k,149) & + + .080_r8*rxt(k,625)*y(k,245) + .020_r8*rxt(k,626)*y(k,252) & + + .020_r8*rxt(k,627)*y(k,253) + .020_r8*rxt(k,628)*y(k,258) & + + .020_r8*rxt(k,631)*y(k,302) + .020_r8*rxt(k,632)*y(k,304) & + + .020_r8*rxt(k,633)*y(k,307) + mat(k,2369) = .240_r8*rxt(k,637)*y(k,147) + .320_r8*rxt(k,638)*y(k,149) & + + .320_r8*rxt(k,634)*y(k,252) + .320_r8*rxt(k,635)*y(k,253) & + + .030_r8*rxt(k,636)*y(k,258) + .320_r8*rxt(k,639)*y(k,302) & + + .320_r8*rxt(k,640)*y(k,304) + .320_r8*rxt(k,641)*y(k,307) + mat(k,2858) = .020_r8*rxt(k,626)*y(k,245) + .320_r8*rxt(k,634)*y(k,246) + mat(k,3387) = .110_r8*rxt(k,595)*y(k,238) + .020_r8*rxt(k,627)*y(k,245) & + + .320_r8*rxt(k,635)*y(k,246) + mat(k,3276) = .020_r8*rxt(k,628)*y(k,245) + .030_r8*rxt(k,636)*y(k,246) + mat(k,2718) = .020_r8*rxt(k,631)*y(k,245) + .320_r8*rxt(k,639)*y(k,246) + mat(k,2764) = .020_r8*rxt(k,632)*y(k,245) + .320_r8*rxt(k,640)*y(k,246) + mat(k,2810) = .020_r8*rxt(k,633)*y(k,245) + .320_r8*rxt(k,641)*y(k,246) + mat(k,986) = -(rxt(k,775)*y(k,295)) + mat(k,3981) = -rxt(k,775)*y(k,217) + mat(k,3016) = .700_r8*rxt(k,773)*y(k,310) + mat(k,2525) = .450_r8*rxt(k,628)*y(k,258) + mat(k,3270) = .450_r8*rxt(k,628)*y(k,245) + .100_r8*rxt(k,772)*y(k,310) + mat(k,1217) = .700_r8*rxt(k,773)*y(k,147) + .100_r8*rxt(k,772)*y(k,258) + mat(k,682) = -(rxt(k,774)*y(k,295)) + mat(k,3948) = -rxt(k,774)*y(k,218) + mat(k,3242) = .320_r8*rxt(k,647)*y(k,281) + .360_r8*rxt(k,667)*y(k,290) + mat(k,2491) = .320_r8*rxt(k,647)*y(k,258) + mat(k,2554) = .360_r8*rxt(k,667)*y(k,258) + mat(k,1143) = -(rxt(k,779)*y(k,295)) + mat(k,3993) = -rxt(k,779)*y(k,219) + mat(k,3025) = .700_r8*rxt(k,777)*y(k,311) + mat(k,2289) = .300_r8*rxt(k,588)*y(k,258) + mat(k,2527) = .080_r8*rxt(k,628)*y(k,258) + mat(k,3279) = .300_r8*rxt(k,588)*y(k,237) + .080_r8*rxt(k,628)*y(k,245) & + + .100_r8*rxt(k,776)*y(k,311) + mat(k,1016) = .700_r8*rxt(k,777)*y(k,147) + .100_r8*rxt(k,776)*y(k,258) + mat(k,783) = -(rxt(k,778)*y(k,295)) + mat(k,3959) = -rxt(k,778)*y(k,220) + mat(k,3252) = .180_r8*rxt(k,647)*y(k,281) + .160_r8*rxt(k,667)*y(k,290) + mat(k,2492) = .180_r8*rxt(k,647)*y(k,258) + mat(k,2555) = .160_r8*rxt(k,667)*y(k,258) + mat(k,1557) = -(rxt(k,783)*y(k,295)) + mat(k,4030) = -rxt(k,783)*y(k,221) + mat(k,3050) = .100_r8*rxt(k,597)*y(k,238) + .420_r8*rxt(k,629)*y(k,245) & + + .020_r8*rxt(k,637)*y(k,246) + .300_r8*rxt(k,696)*y(k,301) & + + .090_r8*rxt(k,741)*y(k,306) + .700_r8*rxt(k,781)*y(k,312) + mat(k,3549) = .450_r8*rxt(k,630)*y(k,245) + mat(k,1229) = rxt(k,769)*y(k,295) + mat(k,970) = rxt(k,770)*y(k,295) + mat(k,2293) = .180_r8*rxt(k,585)*y(k,237) + .090_r8*rxt(k,587)*y(k,253) + mat(k,2432) = .100_r8*rxt(k,597)*y(k,147) + mat(k,2531) = .420_r8*rxt(k,629)*y(k,147) + .450_r8*rxt(k,630)*y(k,149) & + + 1.840_r8*rxt(k,625)*y(k,245) + .450_r8*rxt(k,626)*y(k,252) & + + .560_r8*rxt(k,627)*y(k,253) + .230_r8*rxt(k,628)*y(k,258) & + + .450_r8*rxt(k,631)*y(k,302) + .450_r8*rxt(k,632)*y(k,304) & + + .450_r8*rxt(k,633)*y(k,307) + mat(k,2371) = .020_r8*rxt(k,637)*y(k,147) + mat(k,2864) = .450_r8*rxt(k,626)*y(k,245) + mat(k,3403) = .090_r8*rxt(k,587)*y(k,237) + .560_r8*rxt(k,627)*y(k,245) + mat(k,3307) = .230_r8*rxt(k,628)*y(k,245) + .100_r8*rxt(k,780)*y(k,312) + mat(k,4030) = mat(k,4030) + rxt(k,769)*y(k,214) + rxt(k,770)*y(k,215) + mat(k,2650) = .300_r8*rxt(k,696)*y(k,147) + mat(k,2720) = .450_r8*rxt(k,631)*y(k,245) + mat(k,2766) = .450_r8*rxt(k,632)*y(k,245) + mat(k,2671) = .090_r8*rxt(k,741)*y(k,147) + mat(k,2813) = .450_r8*rxt(k,633)*y(k,245) + mat(k,808) = .700_r8*rxt(k,781)*y(k,147) + .100_r8*rxt(k,780)*y(k,258) + mat(k,1689) = -(rxt(k,782)*y(k,295)) + mat(k,4038) = -rxt(k,782)*y(k,222) + mat(k,3055) = .020_r8*rxt(k,597)*y(k,238) + .040_r8*rxt(k,637)*y(k,246) & + + .330_r8*rxt(k,649)*y(k,281) + .060_r8*rxt(k,657)*y(k,282) & + + .040_r8*rxt(k,669)*y(k,290) + .100_r8*rxt(k,677)*y(k,291) & + + .120_r8*rxt(k,766)*y(k,309) + mat(k,3553) = .500_r8*rxt(k,764)*y(k,213) + .350_r8*rxt(k,650)*y(k,281) & + + .050_r8*rxt(k,670)*y(k,290) + mat(k,2595) = .500_r8*rxt(k,764)*y(k,149) + mat(k,2434) = .020_r8*rxt(k,597)*y(k,147) + mat(k,2373) = .040_r8*rxt(k,637)*y(k,147) + mat(k,2867) = .350_r8*rxt(k,645)*y(k,281) + .050_r8*rxt(k,665)*y(k,290) + mat(k,3408) = .420_r8*rxt(k,646)*y(k,281) + .140_r8*rxt(k,666)*y(k,290) + mat(k,3314) = .180_r8*rxt(k,647)*y(k,281) + mat(k,2501) = .330_r8*rxt(k,649)*y(k,147) + .350_r8*rxt(k,650)*y(k,149) & + + .350_r8*rxt(k,645)*y(k,252) + .420_r8*rxt(k,646)*y(k,253) & + + .180_r8*rxt(k,647)*y(k,258) + 1.440_r8*rxt(k,648)*y(k,281) & + + .350_r8*rxt(k,651)*y(k,302) + .350_r8*rxt(k,652)*y(k,304) & + + .350_r8*rxt(k,653)*y(k,307) + mat(k,2335) = .060_r8*rxt(k,657)*y(k,147) + mat(k,2564) = .040_r8*rxt(k,669)*y(k,147) + .050_r8*rxt(k,670)*y(k,149) & + + .050_r8*rxt(k,665)*y(k,252) + .140_r8*rxt(k,666)*y(k,253) & + + .380_r8*rxt(k,668)*y(k,290) + .050_r8*rxt(k,671)*y(k,302) & + + .050_r8*rxt(k,672)*y(k,304) + .050_r8*rxt(k,673)*y(k,307) + mat(k,2465) = .100_r8*rxt(k,677)*y(k,147) + mat(k,2722) = .350_r8*rxt(k,651)*y(k,281) + .050_r8*rxt(k,671)*y(k,290) + mat(k,2768) = .350_r8*rxt(k,652)*y(k,281) + .050_r8*rxt(k,672)*y(k,290) + mat(k,2815) = .350_r8*rxt(k,653)*y(k,281) + .050_r8*rxt(k,673)*y(k,290) + mat(k,961) = .120_r8*rxt(k,766)*y(k,147) + mat(k,1536) = -(rxt(k,787)*y(k,295)) + mat(k,4028) = -rxt(k,787)*y(k,223) + mat(k,3048) = .050_r8*rxt(k,597)*y(k,238) + .050_r8*rxt(k,629)*y(k,245) & + + .060_r8*rxt(k,637)*y(k,246) + .170_r8*rxt(k,712)*y(k,303) & + + .300_r8*rxt(k,731)*y(k,305) + .700_r8*rxt(k,785)*y(k,313) + mat(k,3548) = .050_r8*rxt(k,630)*y(k,245) + mat(k,1144) = rxt(k,779)*y(k,295) + mat(k,2292) = .540_r8*rxt(k,585)*y(k,237) + .090_r8*rxt(k,587)*y(k,253) + mat(k,2431) = .050_r8*rxt(k,597)*y(k,147) + mat(k,2530) = .050_r8*rxt(k,629)*y(k,147) + .050_r8*rxt(k,630)*y(k,149) & + + .280_r8*rxt(k,625)*y(k,245) + .050_r8*rxt(k,626)*y(k,252) & + + .080_r8*rxt(k,627)*y(k,253) + .050_r8*rxt(k,631)*y(k,302) & + + .050_r8*rxt(k,632)*y(k,304) + .050_r8*rxt(k,633)*y(k,307) + mat(k,2370) = .060_r8*rxt(k,637)*y(k,147) + mat(k,2862) = .050_r8*rxt(k,626)*y(k,245) + mat(k,3401) = .090_r8*rxt(k,587)*y(k,237) + .080_r8*rxt(k,627)*y(k,245) + mat(k,3305) = .100_r8*rxt(k,784)*y(k,313) + mat(k,4028) = mat(k,4028) + rxt(k,779)*y(k,219) + mat(k,2719) = .050_r8*rxt(k,631)*y(k,245) + mat(k,2693) = .170_r8*rxt(k,712)*y(k,147) + mat(k,2765) = .050_r8*rxt(k,632)*y(k,245) + mat(k,2231) = .300_r8*rxt(k,731)*y(k,147) + mat(k,2812) = .050_r8*rxt(k,633)*y(k,245) + mat(k,816) = .700_r8*rxt(k,785)*y(k,147) + .100_r8*rxt(k,784)*y(k,258) + mat(k,1702) = -(rxt(k,786)*y(k,295)) + mat(k,4039) = -rxt(k,786)*y(k,224) + mat(k,3056) = .050_r8*rxt(k,597)*y(k,238) + .130_r8*rxt(k,637)*y(k,246) & + + .170_r8*rxt(k,649)*y(k,281) + .170_r8*rxt(k,657)*y(k,282) & + + .190_r8*rxt(k,677)*y(k,291) + .180_r8*rxt(k,766)*y(k,309) + mat(k,3554) = .190_r8*rxt(k,650)*y(k,281) + mat(k,2435) = .050_r8*rxt(k,597)*y(k,147) + mat(k,2374) = .130_r8*rxt(k,637)*y(k,147) + mat(k,2868) = .190_r8*rxt(k,645)*y(k,281) + mat(k,3409) = .270_r8*rxt(k,646)*y(k,281) + .090_r8*rxt(k,666)*y(k,290) + mat(k,3315) = .090_r8*rxt(k,647)*y(k,281) + mat(k,2502) = .170_r8*rxt(k,649)*y(k,147) + .190_r8*rxt(k,650)*y(k,149) & + + .190_r8*rxt(k,645)*y(k,252) + .270_r8*rxt(k,646)*y(k,253) & + + .090_r8*rxt(k,647)*y(k,258) + .840_r8*rxt(k,648)*y(k,281) & + + .190_r8*rxt(k,651)*y(k,302) + .190_r8*rxt(k,652)*y(k,304) & + + .190_r8*rxt(k,653)*y(k,307) + mat(k,2336) = .170_r8*rxt(k,657)*y(k,147) + mat(k,2565) = .090_r8*rxt(k,666)*y(k,253) + .540_r8*rxt(k,668)*y(k,290) + mat(k,2466) = .190_r8*rxt(k,677)*y(k,147) + mat(k,2723) = .190_r8*rxt(k,651)*y(k,281) + mat(k,2769) = .190_r8*rxt(k,652)*y(k,281) + mat(k,2816) = .190_r8*rxt(k,653)*y(k,281) + mat(k,962) = .180_r8*rxt(k,766)*y(k,147) + end do + end subroutine nlnmat11 + subroutine nlnmat12( 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,689) = -(rxt(k,789)*y(k,295)) + mat(k,3949) = -rxt(k,789)*y(k,225) + mat(k,374) = rxt(k,758)*y(k,295) + mat(k,2427) = .400_r8*rxt(k,596)*y(k,258) + mat(k,2368) = .290_r8*rxt(k,636)*y(k,258) + mat(k,3243) = .400_r8*rxt(k,596)*y(k,238) + .290_r8*rxt(k,636)*y(k,246) & + + rxt(k,695)*y(k,301) + .620_r8*rxt(k,711)*y(k,303) + mat(k,3949) = mat(k,3949) + rxt(k,758)*y(k,211) + mat(k,2647) = rxt(k,695)*y(k,258) + mat(k,2692) = .620_r8*rxt(k,711)*y(k,258) + mat(k,601) = -(rxt(k,788)*y(k,295)) + mat(k,3939) = -rxt(k,788)*y(k,226) + mat(k,2993) = .700_r8*rxt(k,688)*y(k,299) + mat(k,3241) = .180_r8*rxt(k,687)*y(k,299) + .850_r8*rxt(k,730)*y(k,305) & + + .470_r8*rxt(k,740)*y(k,306) + .900_r8*rxt(k,760)*y(k,308) + mat(k,949) = .700_r8*rxt(k,688)*y(k,147) + .180_r8*rxt(k,687)*y(k,258) + mat(k,2230) = .850_r8*rxt(k,730)*y(k,258) + mat(k,2670) = .470_r8*rxt(k,740)*y(k,258) + mat(k,796) = .900_r8*rxt(k,760)*y(k,258) + mat(k,741) = -(rxt(k,573)*y(k,295)) + mat(k,3954) = -rxt(k,573)*y(k,227) + mat(k,3248) = rxt(k,571)*y(k,314) + mat(k,871) = rxt(k,571)*y(k,258) + mat(k,211) = -(rxt(k,574)*y(k,295)) + mat(k,3880) = -rxt(k,574)*y(k,228) + mat(k,229) = -(rxt(k,576)*y(k,295)) + mat(k,3883) = -rxt(k,576)*y(k,229) + mat(k,842) = -(rxt(k,579)*y(k,295)) + mat(k,3965) = -rxt(k,579)*y(k,230) + mat(k,3257) = rxt(k,577)*y(k,316) + mat(k,893) = rxt(k,577)*y(k,258) + mat(k,237) = -(rxt(k,582)*y(k,295)) + mat(k,3884) = -rxt(k,582)*y(k,231) + mat(k,230) = .150_r8*rxt(k,576)*y(k,295) + mat(k,3884) = mat(k,3884) + .150_r8*rxt(k,576)*y(k,229) + mat(k,429) = -(rxt(k,583)*y(k,295)) + mat(k,3915) = -rxt(k,583)*y(k,232) + mat(k,3229) = rxt(k,580)*y(k,318) + mat(k,535) = rxt(k,580)*y(k,258) + mat(k,550) = -(rxt(k,541)*y(k,258) + rxt(k,542)*y(k,147) + rxt(k,570) & + *y(k,148)) + mat(k,3239) = -rxt(k,541)*y(k,235) + mat(k,2990) = -rxt(k,542)*y(k,235) + mat(k,3625) = -rxt(k,570)*y(k,235) + mat(k,246) = rxt(k,547)*y(k,295) + mat(k,3933) = rxt(k,547)*y(k,23) + mat(k,1182) = -(rxt(k,409)*y(k,258) + (rxt(k,410) + rxt(k,411)) * y(k,147)) + mat(k,3283) = -rxt(k,409)*y(k,236) + mat(k,3027) = -(rxt(k,410) + rxt(k,411)) * y(k,236) + mat(k,720) = rxt(k,412)*y(k,295) + mat(k,205) = rxt(k,413)*y(k,295) + mat(k,3997) = rxt(k,412)*y(k,2) + rxt(k,413)*y(k,15) + mat(k,2296) = -(4._r8*rxt(k,585)*y(k,237) + rxt(k,586)*y(k,252) + rxt(k,587) & + *y(k,253) + rxt(k,588)*y(k,258) + rxt(k,589)*y(k,147) + rxt(k,590) & + *y(k,149) + rxt(k,591)*y(k,302) + rxt(k,592)*y(k,304) + rxt(k,593) & + *y(k,307)) + mat(k,2894) = -rxt(k,586)*y(k,237) + mat(k,3436) = -rxt(k,587)*y(k,237) + mat(k,3343) = -rxt(k,588)*y(k,237) + mat(k,3084) = -rxt(k,589)*y(k,237) + mat(k,3580) = -rxt(k,590)*y(k,237) + mat(k,2729) = -rxt(k,591)*y(k,237) + mat(k,2775) = -rxt(k,592)*y(k,237) + mat(k,2822) = -rxt(k,593)*y(k,237) + mat(k,1277) = rxt(k,584)*y(k,149) + mat(k,3580) = mat(k,3580) + rxt(k,584)*y(k,4) + mat(k,2441) = -(rxt(k,594)*y(k,252) + rxt(k,595)*y(k,253) + rxt(k,596) & + *y(k,258) + rxt(k,597)*y(k,147) + rxt(k,598)*y(k,149) + rxt(k,599) & + *y(k,302) + rxt(k,600)*y(k,304) + rxt(k,601)*y(k,307)) + mat(k,2900) = -rxt(k,594)*y(k,238) + mat(k,3442) = -rxt(k,595)*y(k,238) + mat(k,3349) = -rxt(k,596)*y(k,238) + mat(k,3090) = -rxt(k,597)*y(k,238) + mat(k,3586) = -rxt(k,598)*y(k,238) + mat(k,2735) = -rxt(k,599)*y(k,238) + mat(k,2781) = -rxt(k,600)*y(k,238) + mat(k,2828) = -rxt(k,601)*y(k,238) + mat(k,1279) = rxt(k,603)*y(k,295) + mat(k,4072) = rxt(k,603)*y(k,4) + mat(k,57) = -(rxt(k,842)*y(k,258) + rxt(k,843)*y(k,147)) + mat(k,3206) = -rxt(k,842)*y(k,239) + mat(k,2968) = -rxt(k,843)*y(k,239) + mat(k,1270) = rxt(k,845)*y(k,295) + mat(k,3859) = rxt(k,845)*y(k,4) + mat(k,2213) = -(4._r8*rxt(k,605)*y(k,240) + rxt(k,606)*y(k,252) + rxt(k,607) & + *y(k,253) + rxt(k,608)*y(k,258) + rxt(k,609)*y(k,147) + rxt(k,610) & + *y(k,149) + rxt(k,611)*y(k,302) + rxt(k,612)*y(k,304) + rxt(k,613) & + *y(k,307)) + mat(k,2890) = -rxt(k,606)*y(k,240) + mat(k,3432) = -rxt(k,607)*y(k,240) + mat(k,3339) = -rxt(k,608)*y(k,240) + mat(k,3080) = -rxt(k,609)*y(k,240) + mat(k,3576) = -rxt(k,610)*y(k,240) + mat(k,2726) = -rxt(k,611)*y(k,240) + mat(k,2772) = -rxt(k,612)*y(k,240) + mat(k,2819) = -rxt(k,613)*y(k,240) + mat(k,1044) = rxt(k,604)*y(k,149) + mat(k,3576) = mat(k,3576) + rxt(k,604)*y(k,7) + mat(k,2408) = -(rxt(k,614)*y(k,252) + rxt(k,615)*y(k,253) + rxt(k,616) & + *y(k,258) + rxt(k,617)*y(k,147) + rxt(k,618)*y(k,149) + rxt(k,619) & + *y(k,302) + rxt(k,620)*y(k,304) + rxt(k,621)*y(k,307)) + mat(k,2899) = -rxt(k,614)*y(k,241) + mat(k,3441) = -rxt(k,615)*y(k,241) + mat(k,3348) = -rxt(k,616)*y(k,241) + mat(k,3089) = -rxt(k,617)*y(k,241) + mat(k,3585) = -rxt(k,618)*y(k,241) + mat(k,2734) = -rxt(k,619)*y(k,241) + mat(k,2780) = -rxt(k,620)*y(k,241) + mat(k,2827) = -rxt(k,621)*y(k,241) + mat(k,1045) = rxt(k,623)*y(k,295) + mat(k,4071) = rxt(k,623)*y(k,7) + mat(k,63) = -(rxt(k,847)*y(k,258) + rxt(k,848)*y(k,147)) + mat(k,3207) = -rxt(k,847)*y(k,242) + mat(k,2969) = -rxt(k,848)*y(k,242) + mat(k,1039) = rxt(k,850)*y(k,295) + mat(k,3860) = rxt(k,850)*y(k,7) + mat(k,514) = -(rxt(k,544)*y(k,258) + rxt(k,545)*y(k,147)) + mat(k,3237) = -rxt(k,544)*y(k,243) + mat(k,2988) = -rxt(k,545)*y(k,243) + mat(k,185) = .350_r8*rxt(k,543)*y(k,295) + mat(k,419) = rxt(k,546)*y(k,295) + mat(k,3928) = .350_r8*rxt(k,543)*y(k,8) + rxt(k,546)*y(k,9) + mat(k,69) = -(rxt(k,852)*y(k,258) + rxt(k,853)*y(k,147)) + mat(k,3208) = -rxt(k,852)*y(k,244) + mat(k,2970) = -rxt(k,853)*y(k,244) + mat(k,181) = rxt(k,851)*y(k,295) + mat(k,3861) = rxt(k,851)*y(k,8) + mat(k,2536) = -(4._r8*rxt(k,625)*y(k,245) + rxt(k,626)*y(k,252) + rxt(k,627) & + *y(k,253) + rxt(k,628)*y(k,258) + rxt(k,629)*y(k,147) + rxt(k,630) & + *y(k,149) + rxt(k,631)*y(k,302) + rxt(k,632)*y(k,304) + rxt(k,633) & + *y(k,307)) + mat(k,2903) = -rxt(k,626)*y(k,245) + mat(k,3445) = -rxt(k,627)*y(k,245) + mat(k,3352) = -rxt(k,628)*y(k,245) + mat(k,3093) = -rxt(k,629)*y(k,245) + mat(k,3589) = -rxt(k,630)*y(k,245) + mat(k,2738) = -rxt(k,631)*y(k,245) + mat(k,2784) = -rxt(k,632)*y(k,245) + mat(k,2831) = -rxt(k,633)*y(k,245) + mat(k,1100) = rxt(k,624)*y(k,149) + mat(k,3589) = mat(k,3589) + rxt(k,624)*y(k,17) + mat(k,989) = rxt(k,775)*y(k,295) + mat(k,4075) = rxt(k,775)*y(k,217) + mat(k,2380) = -(rxt(k,634)*y(k,252) + rxt(k,635)*y(k,253) + rxt(k,636) & + *y(k,258) + rxt(k,637)*y(k,147) + rxt(k,638)*y(k,149) + rxt(k,639) & + *y(k,302) + rxt(k,640)*y(k,304) + rxt(k,641)*y(k,307)) + mat(k,2898) = -rxt(k,634)*y(k,246) + mat(k,3440) = -rxt(k,635)*y(k,246) + mat(k,3347) = -rxt(k,636)*y(k,246) + mat(k,3088) = -rxt(k,637)*y(k,246) + mat(k,3584) = -rxt(k,638)*y(k,246) + mat(k,2733) = -rxt(k,639)*y(k,246) + mat(k,2779) = -rxt(k,640)*y(k,246) + mat(k,2826) = -rxt(k,641)*y(k,246) + mat(k,1099) = rxt(k,643)*y(k,295) + mat(k,4070) = rxt(k,643)*y(k,17) + mat(k,75) = -(rxt(k,855)*y(k,258) + rxt(k,856)*y(k,147)) + mat(k,3209) = -rxt(k,855)*y(k,247) + mat(k,2971) = -rxt(k,856)*y(k,247) + mat(k,1090) = rxt(k,858)*y(k,295) + mat(k,3862) = rxt(k,858)*y(k,17) + mat(k,437) = -(rxt(k,548)*y(k,258) + rxt(k,550)*y(k,147)) + mat(k,3230) = -rxt(k,548)*y(k,248) + mat(k,2983) = -rxt(k,550)*y(k,248) + mat(k,354) = rxt(k,549)*y(k,295) + mat(k,214) = .070_r8*rxt(k,574)*y(k,295) + mat(k,231) = .060_r8*rxt(k,576)*y(k,295) + mat(k,3916) = rxt(k,549)*y(k,24) + .070_r8*rxt(k,574)*y(k,228) & + + .060_r8*rxt(k,576)*y(k,229) + mat(k,1350) = -(4._r8*rxt(k,324)*y(k,249) + rxt(k,325)*y(k,253) + rxt(k,326) & + *y(k,258) + rxt(k,327)*y(k,147)) + mat(k,3391) = -rxt(k,325)*y(k,249) + mat(k,3291) = -rxt(k,326)*y(k,249) + mat(k,3034) = -rxt(k,327)*y(k,249) + mat(k,359) = .500_r8*rxt(k,329)*y(k,295) + mat(k,317) = rxt(k,330)*y(k,57) + rxt(k,331)*y(k,295) + mat(k,3823) = rxt(k,330)*y(k,29) + mat(k,4011) = .500_r8*rxt(k,329)*y(k,28) + rxt(k,331)*y(k,29) + mat(k,1024) = -(rxt(k,355)*y(k,253) + rxt(k,356)*y(k,258) + rxt(k,357) & + *y(k,147)) + mat(k,3386) = -rxt(k,355)*y(k,250) + mat(k,3274) = -rxt(k,356)*y(k,250) + mat(k,3019) = -rxt(k,357)*y(k,250) + mat(k,412) = rxt(k,358)*y(k,295) + mat(k,131) = rxt(k,359)*y(k,295) + mat(k,3984) = rxt(k,358)*y(k,31) + rxt(k,359)*y(k,32) + mat(k,711) = -(rxt(k,551)*y(k,258) + rxt(k,552)*y(k,147)) + mat(k,3246) = -rxt(k,551)*y(k,251) + mat(k,2997) = -rxt(k,552)*y(k,251) + mat(k,289) = rxt(k,553)*y(k,295) + mat(k,2997) = mat(k,2997) + rxt(k,542)*y(k,235) + mat(k,3678) = rxt(k,568)*y(k,165) + mat(k,485) = rxt(k,568)*y(k,158) + mat(k,551) = rxt(k,542)*y(k,147) + .400_r8*rxt(k,541)*y(k,258) + mat(k,3246) = mat(k,3246) + .400_r8*rxt(k,541)*y(k,235) + mat(k,3951) = rxt(k,553)*y(k,33) + mat(k,2913) = -(4._r8*rxt(k,335)*y(k,252) + rxt(k,336)*y(k,253) + rxt(k,337) & + *y(k,258) + rxt(k,338)*y(k,147) + rxt(k,351)*y(k,148) + rxt(k,381) & + *y(k,284) + rxt(k,388)*y(k,286) + rxt(k,400)*y(k,289) + rxt(k,424) & + *y(k,261) + rxt(k,430)*y(k,262) + rxt(k,444)*y(k,267) + rxt(k,448) & + *y(k,268) + rxt(k,474)*y(k,274) + rxt(k,491)*y(k,278) + rxt(k,495) & + *y(k,279) + rxt(k,586)*y(k,237) + rxt(k,594)*y(k,238) + rxt(k,606) & + *y(k,240) + rxt(k,614)*y(k,241) + rxt(k,626)*y(k,245) + rxt(k,634) & + *y(k,246) + rxt(k,645)*y(k,281) + rxt(k,654)*y(k,282) + rxt(k,665) & + *y(k,290) + rxt(k,674)*y(k,291) + rxt(k,693)*y(k,301) + rxt(k,701) & + *y(k,302) + rxt(k,709)*y(k,303) + rxt(k,719)*y(k,304) + rxt(k,728) & + *y(k,305) + rxt(k,749)*y(k,307)) + mat(k,3455) = -rxt(k,336)*y(k,252) + mat(k,3362) = -rxt(k,337)*y(k,252) + mat(k,3103) = -rxt(k,338)*y(k,252) + mat(k,3651) = -rxt(k,351)*y(k,252) + mat(k,1550) = -rxt(k,381)*y(k,252) + mat(k,1623) = -rxt(k,388)*y(k,252) + mat(k,1514) = -rxt(k,400)*y(k,252) + mat(k,1959) = -rxt(k,424)*y(k,252) + mat(k,1998) = -rxt(k,430)*y(k,252) + mat(k,1740) = -rxt(k,444)*y(k,252) + mat(k,1762) = -rxt(k,448)*y(k,252) + mat(k,2183) = -rxt(k,474)*y(k,252) + mat(k,1857) = -rxt(k,491)*y(k,252) + mat(k,1826) = -rxt(k,495)*y(k,252) + mat(k,2304) = -rxt(k,586)*y(k,252) + mat(k,2449) = -rxt(k,594)*y(k,252) + mat(k,2221) = -rxt(k,606)*y(k,252) + mat(k,2417) = -rxt(k,614)*y(k,252) + mat(k,2543) = -rxt(k,626)*y(k,252) + mat(k,2388) = -rxt(k,634)*y(k,252) + mat(k,2514) = -rxt(k,645)*y(k,252) + mat(k,2348) = -rxt(k,654)*y(k,252) + mat(k,2579) = -rxt(k,665)*y(k,252) + mat(k,2480) = -rxt(k,674)*y(k,252) + mat(k,2660) = -rxt(k,693)*y(k,252) + mat(k,2748) = -rxt(k,701)*y(k,252) + mat(k,2705) = -rxt(k,709)*y(k,252) + mat(k,2794) = -rxt(k,719)*y(k,252) + mat(k,2244) = -rxt(k,728)*y(k,252) + mat(k,2841) = -rxt(k,749)*y(k,252) + mat(k,1433) = rxt(k,332)*y(k,149) + rxt(k,333)*y(k,295) + mat(k,1928) = rxt(k,360)*y(k,149) + rxt(k,361)*y(k,295) + mat(k,704) = .500_r8*rxt(k,340)*y(k,295) + mat(k,622) = .060_r8*rxt(k,414)*y(k,295) + mat(k,635) = .060_r8*rxt(k,415)*y(k,295) + mat(k,926) = .300_r8*rxt(k,363)*y(k,295) + mat(k,1423) = .070_r8*rxt(k,486)*y(k,158) + mat(k,1080) = .330_r8*rxt(k,662)*y(k,158) + mat(k,2019) = .100_r8*rxt(k,385)*y(k,158) + mat(k,2044) = .280_r8*rxt(k,403)*y(k,158) + mat(k,1502) = .560_r8*rxt(k,405)*y(k,295) + mat(k,2141) = .040_r8*rxt(k,501)*y(k,158) + .100_r8*rxt(k,502)*y(k,295) + mat(k,3103) = mat(k,3103) + .350_r8*rxt(k,392)*y(k,286) + rxt(k,395)*y(k,288) & + + .760_r8*rxt(k,537)*y(k,289) + rxt(k,370)*y(k,298) & + + .910_r8*rxt(k,741)*y(k,306) + mat(k,3599) = rxt(k,332)*y(k,46) + rxt(k,360)*y(k,50) + .350_r8*rxt(k,393) & + *y(k,286) + rxt(k,742)*y(k,306) + mat(k,3753) = .070_r8*rxt(k,486)*y(k,109) + .330_r8*rxt(k,662)*y(k,125) & + + .100_r8*rxt(k,385)*y(k,126) + .280_r8*rxt(k,403)*y(k,132) & + + .040_r8*rxt(k,501)*y(k,139) + mat(k,668) = 2.000_r8*rxt(k,737)*y(k,295) + mat(k,2913) = mat(k,2913) + .350_r8*rxt(k,388)*y(k,286) + .750_r8*rxt(k,400) & + *y(k,289) + mat(k,3455) = mat(k,3455) + .350_r8*rxt(k,389)*y(k,286) + .880_r8*rxt(k,401) & + *y(k,289) + .300_r8*rxt(k,368)*y(k,298) + rxt(k,739)*y(k,306) + mat(k,3362) = mat(k,3362) + .170_r8*rxt(k,390)*y(k,286) + .200_r8*rxt(k,394) & + *y(k,288) + .490_r8*rxt(k,402)*y(k,289) + .150_r8*rxt(k,369) & + *y(k,298) + .530_r8*rxt(k,740)*y(k,306) + mat(k,1623) = mat(k,1623) + .350_r8*rxt(k,392)*y(k,147) + .350_r8*rxt(k,393) & + *y(k,149) + .350_r8*rxt(k,388)*y(k,252) + .350_r8*rxt(k,389) & + *y(k,253) + .170_r8*rxt(k,390)*y(k,258) + 1.400_r8*rxt(k,391) & + *y(k,286) + mat(k,765) = rxt(k,395)*y(k,147) + .200_r8*rxt(k,394)*y(k,258) + mat(k,1514) = mat(k,1514) + .760_r8*rxt(k,537)*y(k,147) + .750_r8*rxt(k,400) & + *y(k,252) + .880_r8*rxt(k,401)*y(k,253) + .490_r8*rxt(k,402) & + *y(k,258) + mat(k,4085) = rxt(k,333)*y(k,46) + rxt(k,361)*y(k,50) + .500_r8*rxt(k,340) & + *y(k,52) + .060_r8*rxt(k,414)*y(k,98) + .060_r8*rxt(k,415) & + *y(k,99) + .300_r8*rxt(k,363)*y(k,104) + .560_r8*rxt(k,405) & + *y(k,134) + .100_r8*rxt(k,502)*y(k,139) + 2.000_r8*rxt(k,737) & + *y(k,206) + mat(k,1340) = rxt(k,370)*y(k,147) + .300_r8*rxt(k,368)*y(k,253) & + + .150_r8*rxt(k,369)*y(k,258) + mat(k,2748) = mat(k,2748) + rxt(k,743)*y(k,306) + mat(k,2794) = mat(k,2794) + rxt(k,744)*y(k,306) + mat(k,2682) = .910_r8*rxt(k,741)*y(k,147) + rxt(k,742)*y(k,149) + rxt(k,739) & + *y(k,253) + .530_r8*rxt(k,740)*y(k,258) + rxt(k,743)*y(k,302) & + + rxt(k,744)*y(k,304) + rxt(k,745)*y(k,307) + mat(k,2841) = mat(k,2841) + rxt(k,745)*y(k,306) + end do + end subroutine nlnmat12 + subroutine nlnmat13( 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,3463) = -(rxt(k,225)*y(k,60) + (4._r8*rxt(k,302) + 4._r8*rxt(k,303) & + ) * y(k,253) + rxt(k,304)*y(k,258) + rxt(k,305)*y(k,147) & + + rxt(k,325)*y(k,249) + rxt(k,336)*y(k,252) + rxt(k,355) & + *y(k,250) + rxt(k,368)*y(k,298) + rxt(k,382)*y(k,284) + rxt(k,389) & + *y(k,286) + rxt(k,401)*y(k,289) + rxt(k,425)*y(k,261) + rxt(k,431) & + *y(k,262) + rxt(k,445)*y(k,267) + rxt(k,449)*y(k,268) + rxt(k,475) & + *y(k,274) + rxt(k,492)*y(k,278) + rxt(k,496)*y(k,279) + rxt(k,587) & + *y(k,237) + rxt(k,595)*y(k,238) + rxt(k,607)*y(k,240) + rxt(k,615) & + *y(k,241) + rxt(k,627)*y(k,245) + rxt(k,635)*y(k,246) + rxt(k,646) & + *y(k,281) + rxt(k,655)*y(k,282) + rxt(k,666)*y(k,290) + rxt(k,675) & + *y(k,291) + rxt(k,694)*y(k,301) + rxt(k,702)*y(k,302) + rxt(k,710) & + *y(k,303) + rxt(k,720)*y(k,304) + rxt(k,729)*y(k,305) + rxt(k,739) & + *y(k,306) + rxt(k,750)*y(k,307)) + mat(k,3513) = -rxt(k,225)*y(k,253) + mat(k,3370) = -rxt(k,304)*y(k,253) + mat(k,3111) = -rxt(k,305)*y(k,253) + mat(k,1356) = -rxt(k,325)*y(k,253) + mat(k,2921) = -rxt(k,336)*y(k,253) + mat(k,1030) = -rxt(k,355)*y(k,253) + mat(k,1344) = -rxt(k,368)*y(k,253) + mat(k,1554) = -rxt(k,382)*y(k,253) + mat(k,1628) = -rxt(k,389)*y(k,253) + mat(k,1518) = -rxt(k,401)*y(k,253) + mat(k,1965) = -rxt(k,425)*y(k,253) + mat(k,2004) = -rxt(k,431)*y(k,253) + mat(k,1745) = -rxt(k,445)*y(k,253) + mat(k,1767) = -rxt(k,449)*y(k,253) + mat(k,2190) = -rxt(k,475)*y(k,253) + mat(k,1862) = -rxt(k,492)*y(k,253) + mat(k,1831) = -rxt(k,496)*y(k,253) + mat(k,2310) = -rxt(k,587)*y(k,253) + mat(k,2455) = -rxt(k,595)*y(k,253) + mat(k,2226) = -rxt(k,607)*y(k,253) + mat(k,2423) = -rxt(k,615)*y(k,253) + mat(k,2549) = -rxt(k,627)*y(k,253) + mat(k,2394) = -rxt(k,635)*y(k,253) + mat(k,2520) = -rxt(k,646)*y(k,253) + mat(k,2354) = -rxt(k,655)*y(k,253) + mat(k,2585) = -rxt(k,666)*y(k,253) + mat(k,2486) = -rxt(k,675)*y(k,253) + mat(k,2666) = -rxt(k,694)*y(k,253) + mat(k,2755) = -rxt(k,702)*y(k,253) + mat(k,2711) = -rxt(k,710)*y(k,253) + mat(k,2801) = -rxt(k,720)*y(k,253) + mat(k,2250) = -rxt(k,729)*y(k,253) + mat(k,2688) = -rxt(k,739)*y(k,253) + mat(k,2848) = -rxt(k,750)*y(k,253) + mat(k,1395) = .280_r8*rxt(k,354)*y(k,158) + mat(k,793) = rxt(k,339)*y(k,295) + mat(k,452) = .700_r8*rxt(k,307)*y(k,295) + mat(k,2266) = rxt(k,219)*y(k,57) + rxt(k,275)*y(k,75) + rxt(k,315)*y(k,294) & + + rxt(k,308)*y(k,295) + mat(k,3843) = rxt(k,219)*y(k,55) + mat(k,1247) = rxt(k,275)*y(k,55) + mat(k,624) = .060_r8*rxt(k,414)*y(k,295) + mat(k,637) = .060_r8*rxt(k,415)*y(k,295) + mat(k,1426) = .210_r8*rxt(k,486)*y(k,158) + mat(k,3111) = mat(k,3111) + rxt(k,338)*y(k,252) + .830_r8*rxt(k,556)*y(k,254) & + + .650_r8*rxt(k,392)*y(k,286) + .170_r8*rxt(k,562)*y(k,287) + mat(k,3607) = .650_r8*rxt(k,393)*y(k,286) + mat(k,3761) = .280_r8*rxt(k,354)*y(k,30) + .210_r8*rxt(k,486)*y(k,109) + mat(k,2310) = mat(k,2310) + rxt(k,586)*y(k,252) + mat(k,2455) = mat(k,2455) + rxt(k,594)*y(k,252) + mat(k,2226) = mat(k,2226) + rxt(k,606)*y(k,252) + mat(k,2423) = mat(k,2423) + rxt(k,614)*y(k,252) + mat(k,2549) = mat(k,2549) + rxt(k,626)*y(k,252) + mat(k,2394) = mat(k,2394) + rxt(k,634)*y(k,252) + mat(k,2921) = mat(k,2921) + rxt(k,338)*y(k,147) + rxt(k,586)*y(k,237) & + + rxt(k,594)*y(k,238) + rxt(k,606)*y(k,240) + rxt(k,614) & + *y(k,241) + rxt(k,626)*y(k,245) + rxt(k,634)*y(k,246) & + + 4.000_r8*rxt(k,335)*y(k,252) + .900_r8*rxt(k,336)*y(k,253) & + + .490_r8*rxt(k,337)*y(k,258) + rxt(k,424)*y(k,261) + rxt(k,430) & + *y(k,262) + rxt(k,444)*y(k,267) + rxt(k,448)*y(k,268) & + + rxt(k,474)*y(k,274) + rxt(k,491)*y(k,278) + rxt(k,495) & + *y(k,279) + rxt(k,645)*y(k,281) + rxt(k,654)*y(k,282) & + + rxt(k,381)*y(k,284) + 1.650_r8*rxt(k,388)*y(k,286) & + + rxt(k,400)*y(k,289) + rxt(k,665)*y(k,290) + rxt(k,674) & + *y(k,291) + rxt(k,693)*y(k,301) + rxt(k,701)*y(k,302) & + + rxt(k,709)*y(k,303) + rxt(k,719)*y(k,304) + rxt(k,728) & + *y(k,305) + rxt(k,738)*y(k,306) + rxt(k,749)*y(k,307) + mat(k,3463) = mat(k,3463) + .900_r8*rxt(k,336)*y(k,252) + .650_r8*rxt(k,389) & + *y(k,286) + mat(k,911) = .830_r8*rxt(k,556)*y(k,147) + .330_r8*rxt(k,555)*y(k,258) + mat(k,3370) = mat(k,3370) + .490_r8*rxt(k,337)*y(k,252) + .330_r8*rxt(k,555) & + *y(k,254) + .320_r8*rxt(k,390)*y(k,286) + .070_r8*rxt(k,561) & + *y(k,287) + mat(k,1965) = mat(k,1965) + rxt(k,424)*y(k,252) + mat(k,2004) = mat(k,2004) + rxt(k,430)*y(k,252) + mat(k,1745) = mat(k,1745) + rxt(k,444)*y(k,252) + mat(k,1767) = mat(k,1767) + rxt(k,448)*y(k,252) + mat(k,2190) = mat(k,2190) + rxt(k,474)*y(k,252) + mat(k,1862) = mat(k,1862) + rxt(k,491)*y(k,252) + mat(k,1831) = mat(k,1831) + rxt(k,495)*y(k,252) + mat(k,2520) = mat(k,2520) + rxt(k,645)*y(k,252) + mat(k,2354) = mat(k,2354) + rxt(k,654)*y(k,252) + mat(k,1554) = mat(k,1554) + rxt(k,381)*y(k,252) + mat(k,1628) = mat(k,1628) + .650_r8*rxt(k,392)*y(k,147) + .650_r8*rxt(k,393) & + *y(k,149) + 1.650_r8*rxt(k,388)*y(k,252) + .650_r8*rxt(k,389) & + *y(k,253) + .320_r8*rxt(k,390)*y(k,258) + 2.600_r8*rxt(k,391) & + *y(k,286) + mat(k,935) = .170_r8*rxt(k,562)*y(k,147) + .070_r8*rxt(k,561)*y(k,258) + mat(k,1518) = mat(k,1518) + rxt(k,400)*y(k,252) + mat(k,2585) = mat(k,2585) + rxt(k,665)*y(k,252) + mat(k,2486) = mat(k,2486) + rxt(k,674)*y(k,252) + mat(k,3802) = rxt(k,315)*y(k,55) + mat(k,4093) = rxt(k,339)*y(k,51) + .700_r8*rxt(k,307)*y(k,54) + rxt(k,308) & + *y(k,55) + .060_r8*rxt(k,414)*y(k,98) + .060_r8*rxt(k,415) & + *y(k,99) + mat(k,2666) = mat(k,2666) + rxt(k,693)*y(k,252) + mat(k,2755) = mat(k,2755) + rxt(k,701)*y(k,252) + mat(k,2711) = mat(k,2711) + rxt(k,709)*y(k,252) + mat(k,2801) = mat(k,2801) + rxt(k,719)*y(k,252) + mat(k,2250) = mat(k,2250) + rxt(k,728)*y(k,252) + mat(k,2688) = mat(k,2688) + rxt(k,738)*y(k,252) + mat(k,2848) = mat(k,2848) + rxt(k,749)*y(k,252) + mat(k,906) = -(rxt(k,555)*y(k,258) + rxt(k,556)*y(k,147) + rxt(k,557) & + *y(k,148)) + mat(k,3263) = -rxt(k,555)*y(k,254) + mat(k,3008) = -rxt(k,556)*y(k,254) + mat(k,3632) = -rxt(k,557)*y(k,254) + mat(k,605) = -((rxt(k,377) + rxt(k,378)) * y(k,147)) + mat(k,2994) = -(rxt(k,377) + rxt(k,378)) * y(k,255) + mat(k,378) = rxt(k,375)*y(k,295) + mat(k,3940) = rxt(k,375)*y(k,16) + mat(k,2979) = .750_r8*rxt(k,342)*y(k,257) + mat(k,854) = .750_r8*rxt(k,342)*y(k,147) + mat(k,855) = -(rxt(k,341)*y(k,258) + rxt(k,342)*y(k,147)) + mat(k,3258) = -rxt(k,341)*y(k,257) + mat(k,3003) = -rxt(k,342)*y(k,257) + mat(k,586) = rxt(k,350)*y(k,295) + mat(k,3966) = rxt(k,350)*y(k,26) + mat(k,3369) = -((rxt(k,178) + rxt(k,179) + rxt(k,180)) * y(k,78) + rxt(k,182) & + *y(k,157) + rxt(k,183)*y(k,158) + rxt(k,187)*y(k,295) & + + 4._r8*rxt(k,192)*y(k,258) + rxt(k,202)*y(k,149) + rxt(k,207) & + *y(k,147) + rxt(k,212)*y(k,148) + (rxt(k,222) + rxt(k,223) & + ) * y(k,57) + rxt(k,229)*y(k,60) + rxt(k,255)*y(k,18) + rxt(k,261) & + *y(k,20) + rxt(k,298)*y(k,43) + rxt(k,304)*y(k,253) + rxt(k,312) & + *y(k,259) + rxt(k,326)*y(k,249) + rxt(k,337)*y(k,252) + rxt(k,341) & + *y(k,257) + rxt(k,356)*y(k,250) + rxt(k,365)*y(k,297) + rxt(k,369) & + *y(k,298) + rxt(k,383)*y(k,284) + rxt(k,390)*y(k,286) + rxt(k,394) & + *y(k,288) + rxt(k,402)*y(k,289) + rxt(k,409)*y(k,236) + rxt(k,421) & + *y(k,260) + rxt(k,426)*y(k,261) + rxt(k,432)*y(k,262) + rxt(k,446) & + *y(k,267) + rxt(k,450)*y(k,268) + rxt(k,457)*y(k,269) + rxt(k,461) & + *y(k,270) + rxt(k,464)*y(k,271) + rxt(k,467)*y(k,272) + rxt(k,471) & + *y(k,273) + rxt(k,476)*y(k,274) + rxt(k,479)*y(k,275) + rxt(k,482) & + *y(k,276) + rxt(k,493)*y(k,278) + rxt(k,497)*y(k,279) + rxt(k,499) & + *y(k,293) + rxt(k,541)*y(k,235) + rxt(k,544)*y(k,243) + rxt(k,548) & + *y(k,248) + rxt(k,551)*y(k,251) + rxt(k,555)*y(k,254) + rxt(k,558) & + *y(k,285) + rxt(k,561)*y(k,287) + rxt(k,564)*y(k,296) + rxt(k,571) & + *y(k,314) + rxt(k,577)*y(k,316) + rxt(k,580)*y(k,318) + rxt(k,588) & + *y(k,237) + rxt(k,596)*y(k,238) + rxt(k,608)*y(k,240) + rxt(k,616) & + *y(k,241) + rxt(k,628)*y(k,245) + rxt(k,636)*y(k,246) + rxt(k,647) & + *y(k,281) + rxt(k,656)*y(k,282) + rxt(k,667)*y(k,290) + rxt(k,676) & + *y(k,291) + rxt(k,687)*y(k,299) + rxt(k,691)*y(k,300) + rxt(k,695) & + *y(k,301) + rxt(k,703)*y(k,302) + rxt(k,711)*y(k,303) + rxt(k,721) & + *y(k,304) + rxt(k,730)*y(k,305) + rxt(k,740)*y(k,306) + rxt(k,751) & + *y(k,307) + rxt(k,760)*y(k,308) + rxt(k,765)*y(k,309) + rxt(k,772) & + *y(k,310) + rxt(k,776)*y(k,311) + rxt(k,780)*y(k,312) + rxt(k,784) & + *y(k,313)) + mat(k,2936) = -(rxt(k,178) + rxt(k,179) + rxt(k,180)) * y(k,258) + mat(k,3163) = -rxt(k,182)*y(k,258) + mat(k,3760) = -rxt(k,183)*y(k,258) + mat(k,4092) = -rxt(k,187)*y(k,258) + mat(k,3606) = -rxt(k,202)*y(k,258) + mat(k,3110) = -rxt(k,207)*y(k,258) + mat(k,3658) = -rxt(k,212)*y(k,258) + mat(k,3842) = -(rxt(k,222) + rxt(k,223)) * y(k,258) + mat(k,3512) = -rxt(k,229)*y(k,258) + mat(k,2203) = -rxt(k,255)*y(k,258) + mat(k,3486) = -rxt(k,261)*y(k,258) + mat(k,3189) = -rxt(k,298)*y(k,258) + mat(k,3462) = -rxt(k,304)*y(k,258) + mat(k,698) = -rxt(k,312)*y(k,258) + mat(k,1355) = -rxt(k,326)*y(k,258) + mat(k,2920) = -rxt(k,337)*y(k,258) + mat(k,859) = -rxt(k,341)*y(k,258) + mat(k,1029) = -rxt(k,356)*y(k,258) + mat(k,944) = -rxt(k,365)*y(k,258) + mat(k,1343) = -rxt(k,369)*y(k,258) + mat(k,1553) = -rxt(k,383)*y(k,258) + mat(k,1627) = -rxt(k,390)*y(k,258) + mat(k,767) = -rxt(k,394)*y(k,258) + mat(k,1517) = -rxt(k,402)*y(k,258) + mat(k,1189) = -rxt(k,409)*y(k,258) + mat(k,1306) = -rxt(k,421)*y(k,258) + mat(k,1964) = -rxt(k,426)*y(k,258) + mat(k,2003) = -rxt(k,432)*y(k,258) + mat(k,1744) = -rxt(k,446)*y(k,258) + mat(k,1766) = -rxt(k,450)*y(k,258) + mat(k,1129) = -rxt(k,457)*y(k,258) + mat(k,1175) = -rxt(k,461)*y(k,258) + mat(k,1061) = -rxt(k,464)*y(k,258) + mat(k,1140) = -rxt(k,467)*y(k,258) + mat(k,1451) = -rxt(k,471)*y(k,258) + mat(k,2189) = -rxt(k,476)*y(k,258) + mat(k,1320) = -rxt(k,479)*y(k,258) + mat(k,1374) = -rxt(k,482)*y(k,258) + mat(k,1861) = -rxt(k,493)*y(k,258) + mat(k,1830) = -rxt(k,497)*y(k,258) + mat(k,1653) = -rxt(k,499)*y(k,258) + mat(k,553) = -rxt(k,541)*y(k,258) + mat(k,518) = -rxt(k,544)*y(k,258) + mat(k,440) = -rxt(k,548)*y(k,258) + mat(k,713) = -rxt(k,551)*y(k,258) + mat(k,910) = -rxt(k,555)*y(k,258) + mat(k,866) = -rxt(k,558)*y(k,258) + mat(k,934) = -rxt(k,561)*y(k,258) + mat(k,459) = -rxt(k,564)*y(k,258) + mat(k,880) = -rxt(k,571)*y(k,258) + mat(k,903) = -rxt(k,577)*y(k,258) + mat(k,540) = -rxt(k,580)*y(k,258) + mat(k,2309) = -rxt(k,588)*y(k,258) + mat(k,2454) = -rxt(k,596)*y(k,258) + mat(k,2225) = -rxt(k,608)*y(k,258) + mat(k,2422) = -rxt(k,616)*y(k,258) + mat(k,2548) = -rxt(k,628)*y(k,258) + mat(k,2393) = -rxt(k,636)*y(k,258) + mat(k,2519) = -rxt(k,647)*y(k,258) + mat(k,2353) = -rxt(k,656)*y(k,258) + mat(k,2584) = -rxt(k,667)*y(k,258) + mat(k,2485) = -rxt(k,676)*y(k,258) + mat(k,957) = -rxt(k,687)*y(k,258) + mat(k,1011) = -rxt(k,691)*y(k,258) + mat(k,2665) = -rxt(k,695)*y(k,258) + mat(k,2754) = -rxt(k,703)*y(k,258) + mat(k,2710) = -rxt(k,711)*y(k,258) + mat(k,2800) = -rxt(k,721)*y(k,258) + mat(k,2249) = -rxt(k,730)*y(k,258) + mat(k,2687) = -rxt(k,740)*y(k,258) + mat(k,2847) = -rxt(k,751)*y(k,258) + mat(k,802) = -rxt(k,760)*y(k,258) + mat(k,966) = -rxt(k,765)*y(k,258) + mat(k,1224) = -rxt(k,772)*y(k,258) + mat(k,1020) = -rxt(k,776)*y(k,258) + mat(k,810) = -rxt(k,780)*y(k,258) + mat(k,818) = -rxt(k,784)*y(k,258) + mat(k,1285) = .170_r8*rxt(k,602)*y(k,158) + mat(k,1050) = .080_r8*rxt(k,622)*y(k,158) + mat(k,186) = .650_r8*rxt(k,543)*y(k,295) + mat(k,2203) = mat(k,2203) + rxt(k,254)*y(k,43) + mat(k,3486) = mat(k,3486) + rxt(k,266)*y(k,295) + mat(k,314) = .350_r8*rxt(k,321)*y(k,295) + mat(k,590) = .130_r8*rxt(k,323)*y(k,158) + mat(k,285) = rxt(k,328)*y(k,295) + mat(k,1394) = .280_r8*rxt(k,354)*y(k,158) + mat(k,3189) = mat(k,3189) + rxt(k,254)*y(k,18) + rxt(k,218)*y(k,57) & + + rxt(k,299)*y(k,149) + rxt(k,300)*y(k,157) + mat(k,649) = rxt(k,283)*y(k,57) + rxt(k,284)*y(k,295) + mat(k,396) = rxt(k,286)*y(k,57) + rxt(k,287)*y(k,295) + mat(k,124) = rxt(k,334)*y(k,295) + mat(k,1496) = rxt(k,306)*y(k,295) + mat(k,2265) = rxt(k,316)*y(k,294) + mat(k,3842) = mat(k,3842) + rxt(k,218)*y(k,43) + rxt(k,283)*y(k,44) & + + rxt(k,286)*y(k,47) + rxt(k,221)*y(k,81) + mat(k,3512) = mat(k,3512) + rxt(k,225)*y(k,253) + rxt(k,236)*y(k,295) + mat(k,2059) = rxt(k,319)*y(k,295) + mat(k,221) = .730_r8*rxt(k,554)*y(k,295) + mat(k,307) = .500_r8*rxt(k,808)*y(k,295) + mat(k,1716) = rxt(k,345)*y(k,295) + mat(k,1479) = rxt(k,346)*y(k,295) + mat(k,1490) = rxt(k,221)*y(k,57) + rxt(k,177)*y(k,157) + rxt(k,186)*y(k,295) + mat(k,198) = rxt(k,309)*y(k,295) + mat(k,887) = .110_r8*rxt(k,347)*y(k,295) + mat(k,1379) = rxt(k,310)*y(k,295) + mat(k,1213) = .500_r8*rxt(k,311)*y(k,295) + mat(k,983) = rxt(k,379)*y(k,295) + mat(k,623) = .510_r8*rxt(k,414)*y(k,295) + mat(k,636) = .410_r8*rxt(k,415)*y(k,295) + mat(k,1774) = rxt(k,362)*y(k,295) + mat(k,1880) = .320_r8*rxt(k,418)*y(k,295) + mat(k,1533) = .190_r8*rxt(k,420)*y(k,295) + mat(k,1262) = .400_r8*rxt(k,423)*y(k,295) + mat(k,1425) = .420_r8*rxt(k,486)*y(k,158) + mat(k,1668) = rxt(k,453)*y(k,295) + mat(k,1472) = rxt(k,455)*y(k,295) + mat(k,2086) = .170_r8*rxt(k,459)*y(k,158) + .040_r8*rxt(k,460)*y(k,295) + mat(k,2118) = .170_r8*rxt(k,469)*y(k,158) + .030_r8*rxt(k,470)*y(k,295) + mat(k,735) = .050_r8*rxt(k,472)*y(k,295) + mat(k,922) = rxt(k,488)*y(k,295) + mat(k,1908) = .180_r8*rxt(k,489)*y(k,295) + mat(k,2024) = .140_r8*rxt(k,385)*y(k,158) + mat(k,1783) = .500_r8*rxt(k,380)*y(k,295) + mat(k,2049) = .280_r8*rxt(k,403)*y(k,158) + mat(k,1923) = rxt(k,399)*y(k,295) + mat(k,1504) = .440_r8*rxt(k,405)*y(k,295) + mat(k,834) = .630_r8*rxt(k,682)*y(k,158) + mat(k,2147) = .130_r8*rxt(k,501)*y(k,158) + .630_r8*rxt(k,502)*y(k,295) + mat(k,3110) = mat(k,3110) + rxt(k,410)*y(k,236) + .770_r8*rxt(k,597)*y(k,238) & + + .700_r8*rxt(k,617)*y(k,241) + rxt(k,545)*y(k,243) & + + .470_r8*rxt(k,629)*y(k,245) + .750_r8*rxt(k,637)*y(k,246) & + + rxt(k,550)*y(k,248) + rxt(k,327)*y(k,249) + rxt(k,357) & + *y(k,250) + rxt(k,305)*y(k,253) + .170_r8*rxt(k,556)*y(k,254) & + + rxt(k,377)*y(k,255) + .250_r8*rxt(k,342)*y(k,257) + rxt(k,314) & + *y(k,259) + rxt(k,503)*y(k,260) + rxt(k,505)*y(k,261) & + + rxt(k,507)*y(k,262) + .450_r8*rxt(k,509)*y(k,267) & + + .450_r8*rxt(k,511)*y(k,268) + rxt(k,513)*y(k,269) & + + .270_r8*rxt(k,515)*y(k,270) + rxt(k,517)*y(k,271) + rxt(k,519) & + *y(k,272) + rxt(k,521)*y(k,273) + .540_r8*rxt(k,523)*y(k,274) & + + .530_r8*rxt(k,525)*y(k,275) + .960_r8*rxt(k,527)*y(k,276) & + + .450_r8*rxt(k,530)*y(k,278) + .450_r8*rxt(k,533)*y(k,279) & + + .500_r8*rxt(k,649)*y(k,281) + .770_r8*rxt(k,657)*y(k,282) & + + rxt(k,535)*y(k,284) + .400_r8*rxt(k,559)*y(k,285) & + + .830_r8*rxt(k,562)*y(k,287) + .240_r8*rxt(k,537)*y(k,289) & + + .040_r8*rxt(k,669)*y(k,290) + .710_r8*rxt(k,677)*y(k,291) & + + rxt(k,539)*y(k,293) + rxt(k,565)*y(k,296) + rxt(k,366) & + *y(k,297) + .700_r8*rxt(k,688)*y(k,299) + .700_r8*rxt(k,692) & + *y(k,300) + .910_r8*rxt(k,741)*y(k,306) + .700_r8*rxt(k,761) & + *y(k,308) + .700_r8*rxt(k,766)*y(k,309) + .700_r8*rxt(k,773) & + *y(k,310) + .700_r8*rxt(k,777)*y(k,311) + .700_r8*rxt(k,781) & + *y(k,312) + .700_r8*rxt(k,785)*y(k,313) + rxt(k,572)*y(k,314) & + + rxt(k,578)*y(k,316) + rxt(k,581)*y(k,318) + mat(k,3606) = mat(k,3606) + rxt(k,299)*y(k,43) + .500_r8*rxt(k,764)*y(k,213) & + + rxt(k,598)*y(k,238) + rxt(k,618)*y(k,241) + .500_r8*rxt(k,630) & + *y(k,245) + rxt(k,638)*y(k,246) + .540_r8*rxt(k,478)*y(k,274) & + + .540_r8*rxt(k,650)*y(k,281) + rxt(k,658)*y(k,282) & + + .050_r8*rxt(k,670)*y(k,290) + rxt(k,678)*y(k,291) + rxt(k,205) & + *y(k,295) + rxt(k,742)*y(k,306) + mat(k,3163) = mat(k,3163) + rxt(k,300)*y(k,43) + rxt(k,177)*y(k,81) + mat(k,3760) = mat(k,3760) + .170_r8*rxt(k,602)*y(k,4) + .080_r8*rxt(k,622) & + *y(k,7) + .130_r8*rxt(k,323)*y(k,26) + .280_r8*rxt(k,354) & + *y(k,30) + .420_r8*rxt(k,486)*y(k,109) + .170_r8*rxt(k,459) & + *y(k,115) + .170_r8*rxt(k,469)*y(k,118) + .140_r8*rxt(k,385) & + *y(k,126) + .280_r8*rxt(k,403)*y(k,132) + .630_r8*rxt(k,682) & + *y(k,135) + .130_r8*rxt(k,501)*y(k,139) + rxt(k,189)*y(k,295) + mat(k,195) = .800_r8*rxt(k,566)*y(k,295) + mat(k,1238) = rxt(k,798)*y(k,295) + mat(k,661) = rxt(k,718)*y(k,295) + mat(k,670) = rxt(k,737)*y(k,295) + mat(k,2612) = .500_r8*rxt(k,764)*y(k,149) + mat(k,216) = .280_r8*rxt(k,574)*y(k,295) + mat(k,235) = .380_r8*rxt(k,576)*y(k,295) + mat(k,240) = .630_r8*rxt(k,582)*y(k,295) + mat(k,1189) = mat(k,1189) + rxt(k,410)*y(k,147) + mat(k,2309) = mat(k,2309) + .820_r8*rxt(k,587)*y(k,253) + mat(k,2454) = mat(k,2454) + .770_r8*rxt(k,597)*y(k,147) + rxt(k,598)*y(k,149) & + + rxt(k,594)*y(k,252) + 1.160_r8*rxt(k,595)*y(k,253) & + + .480_r8*rxt(k,596)*y(k,258) + rxt(k,599)*y(k,302) + rxt(k,600) & + *y(k,304) + rxt(k,601)*y(k,307) + mat(k,2225) = mat(k,2225) + .820_r8*rxt(k,607)*y(k,253) + mat(k,2422) = mat(k,2422) + .700_r8*rxt(k,617)*y(k,147) + rxt(k,618)*y(k,149) & + + rxt(k,614)*y(k,252) + rxt(k,615)*y(k,253) + .100_r8*rxt(k,616) & + *y(k,258) + rxt(k,619)*y(k,302) + rxt(k,620)*y(k,304) & + + rxt(k,621)*y(k,307) + mat(k,518) = mat(k,518) + rxt(k,545)*y(k,147) + mat(k,2548) = mat(k,2548) + .470_r8*rxt(k,629)*y(k,147) + .500_r8*rxt(k,630) & + *y(k,149) + 1.880_r8*rxt(k,625)*y(k,245) + .500_r8*rxt(k,626) & + *y(k,252) + 1.100_r8*rxt(k,627)*y(k,253) + .500_r8*rxt(k,631) & + *y(k,302) + .500_r8*rxt(k,632)*y(k,304) + .500_r8*rxt(k,633) & + *y(k,307) + mat(k,2393) = mat(k,2393) + .750_r8*rxt(k,637)*y(k,147) + rxt(k,638)*y(k,149) & + + rxt(k,634)*y(k,252) + 1.500_r8*rxt(k,635)*y(k,253) & + + .030_r8*rxt(k,636)*y(k,258) + rxt(k,639)*y(k,302) + rxt(k,640) & + *y(k,304) + rxt(k,641)*y(k,307) + mat(k,440) = mat(k,440) + rxt(k,550)*y(k,147) + mat(k,1355) = mat(k,1355) + rxt(k,327)*y(k,147) + 2.400_r8*rxt(k,324) & + *y(k,249) + rxt(k,325)*y(k,253) + mat(k,1029) = mat(k,1029) + rxt(k,357)*y(k,147) + rxt(k,355)*y(k,253) + mat(k,2920) = mat(k,2920) + rxt(k,594)*y(k,238) + rxt(k,614)*y(k,241) & + + .500_r8*rxt(k,626)*y(k,245) + rxt(k,634)*y(k,246) & + + .900_r8*rxt(k,336)*y(k,253) + rxt(k,424)*y(k,261) + rxt(k,430) & + *y(k,262) + .450_r8*rxt(k,444)*y(k,267) + .450_r8*rxt(k,448) & + *y(k,268) + .540_r8*rxt(k,474)*y(k,274) + .450_r8*rxt(k,491) & + *y(k,278) + .450_r8*rxt(k,495)*y(k,279) + .540_r8*rxt(k,645) & + *y(k,281) + rxt(k,654)*y(k,282) + rxt(k,381)*y(k,284) & + + .250_r8*rxt(k,400)*y(k,289) + .050_r8*rxt(k,665)*y(k,290) & + + rxt(k,674)*y(k,291) + rxt(k,738)*y(k,306) + mat(k,3462) = mat(k,3462) + rxt(k,225)*y(k,60) + rxt(k,305)*y(k,147) & + + .820_r8*rxt(k,587)*y(k,237) + 1.160_r8*rxt(k,595)*y(k,238) & + + .820_r8*rxt(k,607)*y(k,240) + rxt(k,615)*y(k,241) & + + 1.100_r8*rxt(k,627)*y(k,245) + 1.500_r8*rxt(k,635)*y(k,246) & + + rxt(k,325)*y(k,249) + rxt(k,355)*y(k,250) + .900_r8*rxt(k,336) & + *y(k,252) + 4.000_r8*rxt(k,302)*y(k,253) + 1.500_r8*rxt(k,425) & + *y(k,261) + rxt(k,431)*y(k,262) + .720_r8*rxt(k,445)*y(k,267) & + + .720_r8*rxt(k,449)*y(k,268) + .400_r8*rxt(k,475)*y(k,274) & + + .720_r8*rxt(k,492)*y(k,278) + .720_r8*rxt(k,496)*y(k,279) & + + 1.010_r8*rxt(k,646)*y(k,281) + rxt(k,655)*y(k,282) & + + 1.500_r8*rxt(k,382)*y(k,284) + rxt(k,389)*y(k,286) & + + .620_r8*rxt(k,401)*y(k,289) + .870_r8*rxt(k,666)*y(k,290) & + + rxt(k,675)*y(k,291) + .300_r8*rxt(k,368)*y(k,298) & + + .500_r8*rxt(k,694)*y(k,301) + rxt(k,702)*y(k,302) + rxt(k,710) & + *y(k,303) + rxt(k,720)*y(k,304) + rxt(k,729)*y(k,305) & + + 2.000_r8*rxt(k,739)*y(k,306) + rxt(k,750)*y(k,307) + mat(k,910) = mat(k,910) + .170_r8*rxt(k,556)*y(k,147) + .070_r8*rxt(k,555) & + *y(k,258) + mat(k,611) = rxt(k,377)*y(k,147) + mat(k,859) = mat(k,859) + .250_r8*rxt(k,342)*y(k,147) + mat(k,3369) = mat(k,3369) + .480_r8*rxt(k,596)*y(k,238) + .100_r8*rxt(k,616) & + *y(k,241) + .030_r8*rxt(k,636)*y(k,246) + .070_r8*rxt(k,555) & + *y(k,254) + .200_r8*rxt(k,312)*y(k,259) + .650_r8*rxt(k,421) & + *y(k,260) + .060_r8*rxt(k,426)*y(k,261) + .060_r8*rxt(k,432) & + *y(k,262) + .580_r8*rxt(k,457)*y(k,269) + .060_r8*rxt(k,461) & + *y(k,270) + .600_r8*rxt(k,464)*y(k,271) + .500_r8*rxt(k,467) & + *y(k,272) + .400_r8*rxt(k,471)*y(k,273) + .170_r8*rxt(k,479) & + *y(k,275) + .800_r8*rxt(k,482)*y(k,276) + .270_r8*rxt(k,647) & + *y(k,281) + .100_r8*rxt(k,656)*y(k,282) + .590_r8*rxt(k,383) & + *y(k,284) + .160_r8*rxt(k,558)*y(k,285) + .330_r8*rxt(k,561) & + *y(k,287) + .180_r8*rxt(k,402)*y(k,289) + .100_r8*rxt(k,676) & + *y(k,291) + .800_r8*rxt(k,499)*y(k,293) + .180_r8*rxt(k,687) & + *y(k,299) + .180_r8*rxt(k,691)*y(k,300) + .530_r8*rxt(k,740) & + *y(k,306) + .100_r8*rxt(k,760)*y(k,308) + .100_r8*rxt(k,765) & + *y(k,309) + .100_r8*rxt(k,772)*y(k,310) + .100_r8*rxt(k,776) & + *y(k,311) + .100_r8*rxt(k,780)*y(k,312) + .100_r8*rxt(k,784) & + *y(k,313) + mat(k,698) = mat(k,698) + rxt(k,314)*y(k,147) + .200_r8*rxt(k,312)*y(k,258) + mat(k,1306) = mat(k,1306) + rxt(k,503)*y(k,147) + .650_r8*rxt(k,421)*y(k,258) + mat(k,1964) = mat(k,1964) + rxt(k,505)*y(k,147) + rxt(k,424)*y(k,252) & + + 1.500_r8*rxt(k,425)*y(k,253) + .060_r8*rxt(k,426)*y(k,258) + mat(k,2003) = mat(k,2003) + rxt(k,507)*y(k,147) + rxt(k,430)*y(k,252) & + + rxt(k,431)*y(k,253) + .060_r8*rxt(k,432)*y(k,258) + mat(k,1744) = mat(k,1744) + .450_r8*rxt(k,509)*y(k,147) + .450_r8*rxt(k,444) & + *y(k,252) + .720_r8*rxt(k,445)*y(k,253) + mat(k,1766) = mat(k,1766) + .450_r8*rxt(k,511)*y(k,147) + .450_r8*rxt(k,448) & + *y(k,252) + .720_r8*rxt(k,449)*y(k,253) + mat(k,1129) = mat(k,1129) + rxt(k,513)*y(k,147) + .580_r8*rxt(k,457)*y(k,258) + mat(k,1175) = mat(k,1175) + .270_r8*rxt(k,515)*y(k,147) + .060_r8*rxt(k,461) & + *y(k,258) + mat(k,1061) = mat(k,1061) + rxt(k,517)*y(k,147) + .600_r8*rxt(k,464)*y(k,258) + mat(k,1140) = mat(k,1140) + rxt(k,519)*y(k,147) + .500_r8*rxt(k,467)*y(k,258) + mat(k,1451) = mat(k,1451) + rxt(k,521)*y(k,147) + .400_r8*rxt(k,471)*y(k,258) + mat(k,2189) = mat(k,2189) + .540_r8*rxt(k,523)*y(k,147) + .540_r8*rxt(k,478) & + *y(k,149) + .540_r8*rxt(k,474)*y(k,252) + .400_r8*rxt(k,475) & + *y(k,253) + .800_r8*rxt(k,477)*y(k,274) + mat(k,1320) = mat(k,1320) + .530_r8*rxt(k,525)*y(k,147) + .170_r8*rxt(k,479) & + *y(k,258) + mat(k,1374) = mat(k,1374) + .960_r8*rxt(k,527)*y(k,147) + .800_r8*rxt(k,482) & + *y(k,258) + mat(k,1861) = mat(k,1861) + .450_r8*rxt(k,530)*y(k,147) + .450_r8*rxt(k,491) & + *y(k,252) + .720_r8*rxt(k,492)*y(k,253) + mat(k,1830) = mat(k,1830) + .450_r8*rxt(k,533)*y(k,147) + .450_r8*rxt(k,495) & + *y(k,252) + .720_r8*rxt(k,496)*y(k,253) + mat(k,2519) = mat(k,2519) + .500_r8*rxt(k,649)*y(k,147) + .540_r8*rxt(k,650) & + *y(k,149) + .540_r8*rxt(k,645)*y(k,252) + 1.010_r8*rxt(k,646) & + *y(k,253) + .270_r8*rxt(k,647)*y(k,258) + 1.980_r8*rxt(k,648) & + *y(k,281) + .540_r8*rxt(k,651)*y(k,302) + .540_r8*rxt(k,652) & + *y(k,304) + .540_r8*rxt(k,653)*y(k,307) + mat(k,2353) = mat(k,2353) + .770_r8*rxt(k,657)*y(k,147) + rxt(k,658)*y(k,149) & + + rxt(k,654)*y(k,252) + rxt(k,655)*y(k,253) + .100_r8*rxt(k,656) & + *y(k,258) + rxt(k,659)*y(k,302) + rxt(k,660)*y(k,304) & + + rxt(k,661)*y(k,307) + mat(k,1553) = mat(k,1553) + rxt(k,535)*y(k,147) + rxt(k,381)*y(k,252) & + + 1.500_r8*rxt(k,382)*y(k,253) + .590_r8*rxt(k,383)*y(k,258) + mat(k,866) = mat(k,866) + .400_r8*rxt(k,559)*y(k,147) + .160_r8*rxt(k,558) & + *y(k,258) + mat(k,1627) = mat(k,1627) + rxt(k,389)*y(k,253) + mat(k,934) = mat(k,934) + .830_r8*rxt(k,562)*y(k,147) + .330_r8*rxt(k,561) & + *y(k,258) + mat(k,1517) = mat(k,1517) + .240_r8*rxt(k,537)*y(k,147) + .250_r8*rxt(k,400) & + *y(k,252) + .620_r8*rxt(k,401)*y(k,253) + .180_r8*rxt(k,402) & + *y(k,258) + mat(k,2584) = mat(k,2584) + .040_r8*rxt(k,669)*y(k,147) + .050_r8*rxt(k,670) & + *y(k,149) + .050_r8*rxt(k,665)*y(k,252) + .870_r8*rxt(k,666) & + *y(k,253) + .050_r8*rxt(k,671)*y(k,302) + .050_r8*rxt(k,672) & + *y(k,304) + .050_r8*rxt(k,673)*y(k,307) + mat(k,2485) = mat(k,2485) + .710_r8*rxt(k,677)*y(k,147) + rxt(k,678)*y(k,149) & + + rxt(k,674)*y(k,252) + rxt(k,675)*y(k,253) + .100_r8*rxt(k,676) & + *y(k,258) + rxt(k,679)*y(k,302) + rxt(k,680)*y(k,304) & + + rxt(k,681)*y(k,307) + mat(k,1653) = mat(k,1653) + rxt(k,539)*y(k,147) + .800_r8*rxt(k,499)*y(k,258) + mat(k,3801) = rxt(k,316)*y(k,55) + mat(k,4092) = mat(k,4092) + .650_r8*rxt(k,543)*y(k,8) + rxt(k,266)*y(k,20) & + + .350_r8*rxt(k,321)*y(k,25) + rxt(k,328)*y(k,27) + rxt(k,284) & + *y(k,44) + rxt(k,287)*y(k,47) + rxt(k,334)*y(k,48) + rxt(k,306) & + *y(k,53) + rxt(k,236)*y(k,60) + rxt(k,319)*y(k,63) & + + .730_r8*rxt(k,554)*y(k,67) + .500_r8*rxt(k,808)*y(k,69) & + + rxt(k,345)*y(k,76) + rxt(k,346)*y(k,77) + rxt(k,186)*y(k,81) & + + rxt(k,309)*y(k,88) + .110_r8*rxt(k,347)*y(k,89) + rxt(k,310) & + *y(k,90) + .500_r8*rxt(k,311)*y(k,92) + rxt(k,379)*y(k,97) & + + .510_r8*rxt(k,414)*y(k,98) + .410_r8*rxt(k,415)*y(k,99) & + + rxt(k,362)*y(k,102) + .320_r8*rxt(k,418)*y(k,103) & + + .190_r8*rxt(k,420)*y(k,106) + .400_r8*rxt(k,423)*y(k,108) & + + rxt(k,453)*y(k,110) + rxt(k,455)*y(k,113) + .040_r8*rxt(k,460) & + *y(k,115) + .030_r8*rxt(k,470)*y(k,118) + .050_r8*rxt(k,472) & + *y(k,119) + rxt(k,488)*y(k,122) + .180_r8*rxt(k,489)*y(k,123) & + + .500_r8*rxt(k,380)*y(k,127) + rxt(k,399)*y(k,133) & + + .440_r8*rxt(k,405)*y(k,134) + .630_r8*rxt(k,502)*y(k,139) & + + rxt(k,205)*y(k,149) + rxt(k,189)*y(k,158) + .800_r8*rxt(k,566) & + *y(k,166) + rxt(k,798)*y(k,175) + rxt(k,718)*y(k,204) & + + rxt(k,737)*y(k,206) + .280_r8*rxt(k,574)*y(k,228) & + + .380_r8*rxt(k,576)*y(k,229) + .630_r8*rxt(k,582)*y(k,231) + mat(k,459) = mat(k,459) + rxt(k,565)*y(k,147) + mat(k,944) = mat(k,944) + rxt(k,366)*y(k,147) + mat(k,1343) = mat(k,1343) + .300_r8*rxt(k,368)*y(k,253) + mat(k,957) = mat(k,957) + .700_r8*rxt(k,688)*y(k,147) + .180_r8*rxt(k,687) & + *y(k,258) + mat(k,1011) = mat(k,1011) + .700_r8*rxt(k,692)*y(k,147) + .180_r8*rxt(k,691) & + *y(k,258) + mat(k,2665) = mat(k,2665) + .500_r8*rxt(k,694)*y(k,253) + mat(k,2754) = mat(k,2754) + rxt(k,599)*y(k,238) + rxt(k,619)*y(k,241) & + + .500_r8*rxt(k,631)*y(k,245) + rxt(k,639)*y(k,246) + rxt(k,702) & + *y(k,253) + .540_r8*rxt(k,651)*y(k,281) + rxt(k,659)*y(k,282) & + + .050_r8*rxt(k,671)*y(k,290) + rxt(k,679)*y(k,291) + rxt(k,743) & + *y(k,306) + mat(k,2710) = mat(k,2710) + rxt(k,710)*y(k,253) + mat(k,2800) = mat(k,2800) + rxt(k,600)*y(k,238) + rxt(k,620)*y(k,241) & + + .500_r8*rxt(k,632)*y(k,245) + rxt(k,640)*y(k,246) + rxt(k,720) & + *y(k,253) + .540_r8*rxt(k,652)*y(k,281) + rxt(k,660)*y(k,282) & + + .050_r8*rxt(k,672)*y(k,290) + rxt(k,680)*y(k,291) + rxt(k,744) & + *y(k,306) + mat(k,2249) = mat(k,2249) + rxt(k,729)*y(k,253) + mat(k,2687) = mat(k,2687) + .910_r8*rxt(k,741)*y(k,147) + rxt(k,742)*y(k,149) & + + rxt(k,738)*y(k,252) + 2.000_r8*rxt(k,739)*y(k,253) & + + .530_r8*rxt(k,740)*y(k,258) + rxt(k,743)*y(k,302) + rxt(k,744) & + *y(k,304) + rxt(k,745)*y(k,307) + mat(k,2847) = mat(k,2847) + rxt(k,601)*y(k,238) + rxt(k,621)*y(k,241) & + + .500_r8*rxt(k,633)*y(k,245) + rxt(k,641)*y(k,246) + rxt(k,750) & + *y(k,253) + .540_r8*rxt(k,653)*y(k,281) + rxt(k,661)*y(k,282) & + + .050_r8*rxt(k,673)*y(k,290) + rxt(k,681)*y(k,291) + rxt(k,745) & + *y(k,306) + mat(k,802) = mat(k,802) + .700_r8*rxt(k,761)*y(k,147) + .100_r8*rxt(k,760) & + *y(k,258) + mat(k,966) = mat(k,966) + .700_r8*rxt(k,766)*y(k,147) + .100_r8*rxt(k,765) & + *y(k,258) + mat(k,1224) = mat(k,1224) + .700_r8*rxt(k,773)*y(k,147) + .100_r8*rxt(k,772) & + *y(k,258) + mat(k,1020) = mat(k,1020) + .700_r8*rxt(k,777)*y(k,147) + .100_r8*rxt(k,776) & + *y(k,258) + mat(k,810) = mat(k,810) + .700_r8*rxt(k,781)*y(k,147) + .100_r8*rxt(k,780) & + *y(k,258) + mat(k,818) = mat(k,818) + .700_r8*rxt(k,785)*y(k,147) + .100_r8*rxt(k,784) & + *y(k,258) + mat(k,880) = mat(k,880) + rxt(k,572)*y(k,147) + mat(k,903) = mat(k,903) + rxt(k,578)*y(k,147) + mat(k,540) = mat(k,540) + rxt(k,581)*y(k,147) + end do + end subroutine nlnmat13 + subroutine nlnmat14( 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,693) = -(rxt(k,312)*y(k,258) + rxt(k,314)*y(k,147)) + mat(k,3244) = -rxt(k,312)*y(k,259) + mat(k,2996) = -rxt(k,314)*y(k,259) + mat(k,3174) = rxt(k,298)*y(k,258) + mat(k,3244) = mat(k,3244) + rxt(k,298)*y(k,43) + mat(k,1298) = -(rxt(k,421)*y(k,258) + (rxt(k,503) + rxt(k,504)) * y(k,147)) + mat(k,3288) = -rxt(k,421)*y(k,260) + mat(k,3031) = -(rxt(k,503) + rxt(k,504)) * y(k,260) + mat(k,1866) = .320_r8*rxt(k,418)*y(k,295) + mat(k,1522) = .810_r8*rxt(k,420)*y(k,295) + mat(k,4007) = .320_r8*rxt(k,418)*y(k,103) + .810_r8*rxt(k,420)*y(k,106) + mat(k,1953) = -(rxt(k,424)*y(k,252) + rxt(k,425)*y(k,253) + rxt(k,426) & + *y(k,258) + (rxt(k,505) + rxt(k,506)) * y(k,147)) + mat(k,2881) = -rxt(k,424)*y(k,261) + mat(k,3423) = -rxt(k,425)*y(k,261) + mat(k,3329) = -rxt(k,426)*y(k,261) + mat(k,3070) = -(rxt(k,505) + rxt(k,506)) * y(k,261) + mat(k,1899) = .530_r8*rxt(k,489)*y(k,295) + mat(k,4053) = .530_r8*rxt(k,489)*y(k,123) + mat(k,1991) = -(rxt(k,430)*y(k,252) + rxt(k,431)*y(k,253) + rxt(k,432) & + *y(k,258) + (rxt(k,507) + rxt(k,508)) * y(k,147)) + mat(k,2882) = -rxt(k,430)*y(k,262) + mat(k,3424) = -rxt(k,431)*y(k,262) + mat(k,3330) = -rxt(k,432)*y(k,262) + mat(k,3071) = -(rxt(k,507) + rxt(k,508)) * y(k,262) + mat(k,1900) = .160_r8*rxt(k,489)*y(k,295) + mat(k,4054) = .160_r8*rxt(k,489)*y(k,123) + mat(k,1404) = .315_r8*rxt(k,487)*y(k,295) + mat(k,3890) = .315_r8*rxt(k,487)*y(k,109) + mat(k,1405) = .315_r8*rxt(k,487)*y(k,295) + mat(k,3891) = .315_r8*rxt(k,487)*y(k,109) + mat(k,1406) = .259_r8*rxt(k,487)*y(k,295) + mat(k,3892) = .259_r8*rxt(k,487)*y(k,109) + mat(k,1407) = .111_r8*rxt(k,487)*y(k,295) + mat(k,3893) = .111_r8*rxt(k,487)*y(k,109) + mat(k,1732) = -(rxt(k,444)*y(k,252) + rxt(k,445)*y(k,253) + rxt(k,446) & + *y(k,258) + (rxt(k,509) + rxt(k,510)) * y(k,147)) + mat(k,2871) = -rxt(k,444)*y(k,267) + mat(k,3412) = -rxt(k,445)*y(k,267) + mat(k,3318) = -rxt(k,446)*y(k,267) + mat(k,3059) = -(rxt(k,509) + rxt(k,510)) * y(k,267) + mat(k,1754) = -(rxt(k,448)*y(k,252) + rxt(k,449)*y(k,253) + rxt(k,450) & + *y(k,258) + (rxt(k,511) + rxt(k,512)) * y(k,147)) + mat(k,2872) = -rxt(k,448)*y(k,268) + mat(k,3413) = -rxt(k,449)*y(k,268) + mat(k,3319) = -rxt(k,450)*y(k,268) + mat(k,3060) = -(rxt(k,511) + rxt(k,512)) * y(k,268) + mat(k,1121) = -(rxt(k,457)*y(k,258) + (rxt(k,513) + rxt(k,514)) * y(k,147)) + mat(k,3277) = -rxt(k,457)*y(k,269) + mat(k,3023) = -(rxt(k,513) + rxt(k,514)) * y(k,269) + mat(k,2061) = .820_r8*rxt(k,460)*y(k,295) + mat(k,3991) = .820_r8*rxt(k,460)*y(k,115) + mat(k,1166) = -(rxt(k,461)*y(k,258) + (rxt(k,515) + rxt(k,516)) * y(k,147)) + mat(k,3282) = -rxt(k,461)*y(k,270) + mat(k,3026) = -(rxt(k,515) + rxt(k,516)) * y(k,270) + mat(k,674) = .850_r8*rxt(k,463)*y(k,295) + mat(k,3996) = .850_r8*rxt(k,463)*y(k,116) + mat(k,1054) = -(rxt(k,464)*y(k,258) + (rxt(k,517) + rxt(k,518)) * y(k,147)) + mat(k,3275) = -rxt(k,464)*y(k,271) + mat(k,3020) = -(rxt(k,517) + rxt(k,518)) * y(k,271) + mat(k,594) = .870_r8*rxt(k,466)*y(k,295) + mat(k,3986) = .870_r8*rxt(k,466)*y(k,117) + mat(k,1132) = -(rxt(k,467)*y(k,258) + (rxt(k,519) + rxt(k,520)) * y(k,147)) + mat(k,3278) = -rxt(k,467)*y(k,272) + mat(k,3024) = -(rxt(k,519) + rxt(k,520)) * y(k,272) + mat(k,2093) = .890_r8*rxt(k,470)*y(k,295) + mat(k,3992) = .890_r8*rxt(k,470)*y(k,118) + mat(k,1440) = -(rxt(k,471)*y(k,258) + (rxt(k,521) + rxt(k,522)) * y(k,147)) + mat(k,3295) = -rxt(k,471)*y(k,273) + mat(k,3038) = -(rxt(k,521) + rxt(k,522)) * y(k,273) + mat(k,730) = .920_r8*rxt(k,472)*y(k,295) + mat(k,4017) = .920_r8*rxt(k,472)*y(k,119) + mat(k,2180) = -(rxt(k,474)*y(k,252) + rxt(k,475)*y(k,253) + rxt(k,476) & + *y(k,258) + 4._r8*rxt(k,477)*y(k,274) + rxt(k,478)*y(k,149) & + + (rxt(k,523) + rxt(k,524)) * y(k,147)) + mat(k,2889) = -rxt(k,474)*y(k,274) + mat(k,3431) = -rxt(k,475)*y(k,274) + mat(k,3337) = -rxt(k,476)*y(k,274) + mat(k,3574) = -rxt(k,478)*y(k,274) + mat(k,3078) = -(rxt(k,523) + rxt(k,524)) * y(k,274) + mat(k,1422) = rxt(k,473)*y(k,149) + mat(k,1204) = .170_r8*rxt(k,481)*y(k,295) + mat(k,1584) = .070_r8*rxt(k,485)*y(k,295) + mat(k,3574) = mat(k,3574) + rxt(k,473)*y(k,109) + mat(k,4061) = .170_r8*rxt(k,481)*y(k,120) + .070_r8*rxt(k,485)*y(k,121) + mat(k,1309) = -(rxt(k,479)*y(k,258) + (rxt(k,525) + rxt(k,526)) * y(k,147)) + mat(k,3289) = -rxt(k,479)*y(k,275) + mat(k,3032) = -(rxt(k,525) + rxt(k,526)) * y(k,275) + mat(k,1195) = .410_r8*rxt(k,481)*y(k,295) + mat(k,4008) = .410_r8*rxt(k,481)*y(k,120) + mat(k,1361) = -(rxt(k,482)*y(k,258) + (rxt(k,527) + rxt(k,528)) * y(k,147)) + mat(k,3292) = -rxt(k,482)*y(k,276) + mat(k,3035) = -(rxt(k,527) + rxt(k,528)) * y(k,276) + mat(k,1565) = .570_r8*rxt(k,485)*y(k,295) + mat(k,4012) = .570_r8*rxt(k,485)*y(k,121) + mat(k,81) = -(rxt(k,860)*y(k,258) + rxt(k,861)*y(k,147)) + mat(k,3210) = -rxt(k,860)*y(k,277) + mat(k,2972) = -rxt(k,861)*y(k,277) + mat(k,1403) = rxt(k,863)*y(k,295) + mat(k,3863) = rxt(k,863)*y(k,109) + mat(k,1848) = -(rxt(k,491)*y(k,252) + rxt(k,492)*y(k,253) + rxt(k,493) & + *y(k,258) + (rxt(k,530) + rxt(k,531)) * y(k,147)) + mat(k,2876) = -rxt(k,491)*y(k,278) + mat(k,3418) = -rxt(k,492)*y(k,278) + mat(k,3324) = -rxt(k,493)*y(k,278) + mat(k,3065) = -(rxt(k,530) + rxt(k,531)) * y(k,278) + mat(k,1817) = -(rxt(k,495)*y(k,252) + rxt(k,496)*y(k,253) + rxt(k,497) & + *y(k,258) + (rxt(k,533) + rxt(k,534)) * y(k,147)) + mat(k,2875) = -rxt(k,495)*y(k,279) + mat(k,3417) = -rxt(k,496)*y(k,279) + mat(k,3323) = -rxt(k,497)*y(k,279) + mat(k,3064) = -(rxt(k,533) + rxt(k,534)) * y(k,279) + mat(k,87) = -(rxt(k,864)*y(k,258) + rxt(k,865)*y(k,147)) + mat(k,3211) = -rxt(k,864)*y(k,280) + mat(k,2973) = -rxt(k,865)*y(k,280) + mat(k,88) = rxt(k,866)*y(k,295) + mat(k,3864) = rxt(k,866)*y(k,124) + mat(k,2505) = -(rxt(k,645)*y(k,252) + rxt(k,646)*y(k,253) + rxt(k,647) & + *y(k,258) + 4._r8*rxt(k,648)*y(k,281) + rxt(k,649)*y(k,147) & + + rxt(k,650)*y(k,149) + rxt(k,651)*y(k,302) + rxt(k,652) & + *y(k,304) + rxt(k,653)*y(k,307)) + mat(k,2902) = -rxt(k,645)*y(k,281) + mat(k,3444) = -rxt(k,646)*y(k,281) + mat(k,3351) = -rxt(k,647)*y(k,281) + mat(k,3092) = -rxt(k,649)*y(k,281) + mat(k,3588) = -rxt(k,650)*y(k,281) + mat(k,2737) = -rxt(k,651)*y(k,281) + mat(k,2783) = -rxt(k,652)*y(k,281) + mat(k,2830) = -rxt(k,653)*y(k,281) + mat(k,1075) = rxt(k,644)*y(k,149) + mat(k,3588) = mat(k,3588) + rxt(k,644)*y(k,125) + mat(k,2339) = -(rxt(k,654)*y(k,252) + rxt(k,655)*y(k,253) + rxt(k,656) & + *y(k,258) + rxt(k,657)*y(k,147) + rxt(k,658)*y(k,149) + rxt(k,659) & + *y(k,302) + rxt(k,660)*y(k,304) + rxt(k,661)*y(k,307)) + mat(k,2896) = -rxt(k,654)*y(k,282) + mat(k,3438) = -rxt(k,655)*y(k,282) + mat(k,3345) = -rxt(k,656)*y(k,282) + mat(k,3086) = -rxt(k,657)*y(k,282) + mat(k,3582) = -rxt(k,658)*y(k,282) + mat(k,2731) = -rxt(k,659)*y(k,282) + mat(k,2777) = -rxt(k,660)*y(k,282) + mat(k,2824) = -rxt(k,661)*y(k,282) + mat(k,1074) = rxt(k,663)*y(k,295) + mat(k,4068) = rxt(k,663)*y(k,125) + mat(k,95) = -(rxt(k,868)*y(k,258) + rxt(k,869)*y(k,147)) + mat(k,3212) = -rxt(k,868)*y(k,283) + mat(k,2974) = -rxt(k,869)*y(k,283) + mat(k,1069) = rxt(k,871)*y(k,295) + mat(k,3866) = rxt(k,871)*y(k,125) + mat(k,1543) = -(rxt(k,381)*y(k,252) + rxt(k,382)*y(k,253) + rxt(k,383) & + *y(k,258) + (rxt(k,535) + rxt(k,536)) * y(k,147)) + mat(k,2863) = -rxt(k,381)*y(k,284) + mat(k,3402) = -rxt(k,382)*y(k,284) + mat(k,3306) = -rxt(k,383)*y(k,284) + mat(k,3049) = -(rxt(k,535) + rxt(k,536)) * y(k,284) + mat(k,2010) = .550_r8*rxt(k,386)*y(k,295) + mat(k,4029) = .550_r8*rxt(k,386)*y(k,126) + mat(k,862) = -(rxt(k,558)*y(k,258) + rxt(k,559)*y(k,147) + rxt(k,560) & + *y(k,148)) + mat(k,3259) = -rxt(k,558)*y(k,285) + mat(k,3004) = -rxt(k,559)*y(k,285) + mat(k,3631) = -rxt(k,560)*y(k,285) + mat(k,1620) = -(rxt(k,388)*y(k,252) + rxt(k,389)*y(k,253) + rxt(k,390) & + *y(k,258) + 4._r8*rxt(k,391)*y(k,286) + rxt(k,392)*y(k,147) & + + rxt(k,393)*y(k,149) + rxt(k,406)*y(k,148)) + mat(k,2866) = -rxt(k,388)*y(k,286) + mat(k,3405) = -rxt(k,389)*y(k,286) + mat(k,3310) = -rxt(k,390)*y(k,286) + mat(k,3052) = -rxt(k,392)*y(k,286) + mat(k,3552) = -rxt(k,393)*y(k,286) + mat(k,3641) = -rxt(k,406)*y(k,286) + mat(k,2012) = .450_r8*rxt(k,386)*y(k,295) + mat(k,4034) = .450_r8*rxt(k,386)*y(k,126) + mat(k,929) = -(rxt(k,561)*y(k,258) + rxt(k,562)*y(k,147) + rxt(k,563) & + *y(k,148)) + mat(k,3265) = -rxt(k,561)*y(k,287) + mat(k,3010) = -rxt(k,562)*y(k,287) + mat(k,3633) = -rxt(k,563)*y(k,287) + mat(k,763) = -(rxt(k,394)*y(k,258) + rxt(k,395)*y(k,147)) + mat(k,3249) = -rxt(k,394)*y(k,288) + mat(k,2999) = -rxt(k,395)*y(k,288) + mat(k,557) = rxt(k,396)*y(k,295) + mat(k,333) = rxt(k,397)*y(k,295) + mat(k,3956) = rxt(k,396)*y(k,129) + rxt(k,397)*y(k,130) + mat(k,1508) = -(rxt(k,400)*y(k,252) + rxt(k,401)*y(k,253) + rxt(k,402) & + *y(k,258) + (rxt(k,537) + rxt(k,538)) * y(k,147)) + mat(k,2861) = -rxt(k,400)*y(k,289) + mat(k,3400) = -rxt(k,401)*y(k,289) + mat(k,3304) = -rxt(k,402)*y(k,289) + mat(k,3046) = -(rxt(k,537) + rxt(k,538)) * y(k,289) + mat(k,2035) = rxt(k,404)*y(k,295) + mat(k,4026) = rxt(k,404)*y(k,132) + mat(k,2570) = -(rxt(k,665)*y(k,252) + rxt(k,666)*y(k,253) + rxt(k,667) & + *y(k,258) + 4._r8*rxt(k,668)*y(k,290) + rxt(k,669)*y(k,147) & + + rxt(k,670)*y(k,149) + rxt(k,671)*y(k,302) + rxt(k,672) & + *y(k,304) + rxt(k,673)*y(k,307)) + mat(k,2904) = -rxt(k,665)*y(k,290) + mat(k,3446) = -rxt(k,666)*y(k,290) + mat(k,3353) = -rxt(k,667)*y(k,290) + mat(k,3094) = -rxt(k,669)*y(k,290) + mat(k,3590) = -rxt(k,670)*y(k,290) + mat(k,2739) = -rxt(k,671)*y(k,290) + mat(k,2785) = -rxt(k,672)*y(k,290) + mat(k,2832) = -rxt(k,673)*y(k,290) + mat(k,831) = rxt(k,664)*y(k,149) + mat(k,3590) = mat(k,3590) + rxt(k,664)*y(k,135) + end do + end subroutine nlnmat14 + subroutine nlnmat15( 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,2471) = -(rxt(k,674)*y(k,252) + rxt(k,675)*y(k,253) + rxt(k,676) & + *y(k,258) + rxt(k,677)*y(k,147) + rxt(k,678)*y(k,149) + rxt(k,679) & + *y(k,302) + rxt(k,680)*y(k,304) + rxt(k,681)*y(k,307)) + mat(k,2901) = -rxt(k,674)*y(k,291) + mat(k,3443) = -rxt(k,675)*y(k,291) + mat(k,3350) = -rxt(k,676)*y(k,291) + mat(k,3091) = -rxt(k,677)*y(k,291) + mat(k,3587) = -rxt(k,678)*y(k,291) + mat(k,2736) = -rxt(k,679)*y(k,291) + mat(k,2782) = -rxt(k,680)*y(k,291) + mat(k,2829) = -rxt(k,681)*y(k,291) + mat(k,830) = rxt(k,683)*y(k,295) + mat(k,4073) = rxt(k,683)*y(k,135) + mat(k,101) = -(rxt(k,873)*y(k,258) + rxt(k,874)*y(k,147)) + mat(k,3213) = -rxt(k,873)*y(k,292) + mat(k,2975) = -rxt(k,874)*y(k,292) + mat(k,826) = rxt(k,876)*y(k,295) + mat(k,3867) = rxt(k,876)*y(k,135) + mat(k,1640) = -(rxt(k,499)*y(k,258) + (rxt(k,539) + rxt(k,540)) * y(k,147)) + mat(k,3311) = -rxt(k,499)*y(k,293) + mat(k,3053) = -(rxt(k,539) + rxt(k,540)) * y(k,293) + mat(k,505) = .400_r8*rxt(k,422)*y(k,295) + mat(k,1255) = .350_r8*rxt(k,423)*y(k,295) + mat(k,2131) = .230_r8*rxt(k,502)*y(k,295) + mat(k,4035) = .400_r8*rxt(k,422)*y(k,107) + .350_r8*rxt(k,423)*y(k,108) & + + .230_r8*rxt(k,502)*y(k,139) + mat(k,3808) = -(rxt(k,168)*y(k,79) + rxt(k,169)*y(k,319) + rxt(k,172) & + *y(k,158) + (rxt(k,210) + rxt(k,211)) * y(k,137) + rxt(k,243) & + *y(k,34) + rxt(k,244)*y(k,35) + rxt(k,245)*y(k,37) + rxt(k,246) & + *y(k,38) + rxt(k,247)*y(k,39) + rxt(k,248)*y(k,40) + rxt(k,249) & + *y(k,41) + (rxt(k,250) + rxt(k,251)) * y(k,87) + rxt(k,270) & + *y(k,36) + rxt(k,271)*y(k,56) + rxt(k,272)*y(k,80) + (rxt(k,273) & + + rxt(k,274)) * y(k,83) + rxt(k,279)*y(k,65) + rxt(k,280) & + *y(k,66) + rxt(k,293)*y(k,42) + rxt(k,294)*y(k,44) + rxt(k,295) & + *y(k,84) + rxt(k,296)*y(k,85) + rxt(k,297)*y(k,86) + (rxt(k,315) & + + rxt(k,316) + rxt(k,317)) * y(k,55) + rxt(k,318)*y(k,88)) + mat(k,1681) = -rxt(k,168)*y(k,294) + mat(k,4125) = -rxt(k,169)*y(k,294) + mat(k,3767) = -rxt(k,172)*y(k,294) + mat(k,203) = -(rxt(k,210) + rxt(k,211)) * y(k,294) + mat(k,121) = -rxt(k,243)*y(k,294) + mat(k,162) = -rxt(k,244)*y(k,294) + mat(k,136) = -rxt(k,245)*y(k,294) + mat(k,172) = -rxt(k,246)*y(k,294) + mat(k,140) = -rxt(k,247)*y(k,294) + mat(k,177) = -rxt(k,248)*y(k,294) + mat(k,144) = -rxt(k,249)*y(k,294) + mat(k,3139) = -(rxt(k,250) + rxt(k,251)) * y(k,294) + mat(k,168) = -rxt(k,270)*y(k,294) + mat(k,465) = -rxt(k,271)*y(k,294) + mat(k,129) = -rxt(k,272)*y(k,294) + mat(k,1155) = -(rxt(k,273) + rxt(k,274)) * y(k,294) + mat(k,250) = -rxt(k,279)*y(k,294) + mat(k,258) = -rxt(k,280)*y(k,294) + mat(k,498) = -rxt(k,293)*y(k,294) + mat(k,651) = -rxt(k,294)*y(k,294) + mat(k,253) = -rxt(k,295)*y(k,294) + mat(k,263) = -rxt(k,296)*y(k,294) + mat(k,328) = -rxt(k,297)*y(k,294) + mat(k,2268) = -(rxt(k,315) + rxt(k,316) + rxt(k,317)) * y(k,294) + mat(k,199) = -rxt(k,318)*y(k,294) + mat(k,4101) = -(rxt(k,185)*y(k,79) + rxt(k,186)*y(k,81) + rxt(k,187)*y(k,258) & + + rxt(k,188)*y(k,157) + rxt(k,189)*y(k,158) + (4._r8*rxt(k,190) & + + 4._r8*rxt(k,191)) * y(k,295) + rxt(k,193)*y(k,94) + rxt(k,205) & + *y(k,149) + rxt(k,206)*y(k,136) + rxt(k,214)*y(k,148) + rxt(k,215) & + *y(k,93) + rxt(k,234)*y(k,61) + (rxt(k,236) + rxt(k,237) & + ) * y(k,60) + rxt(k,239)*y(k,87) + rxt(k,242)*y(k,96) + rxt(k,266) & + *y(k,20) + rxt(k,268)*y(k,83) + rxt(k,282)*y(k,42) + rxt(k,284) & + *y(k,44) + rxt(k,285)*y(k,45) + rxt(k,287)*y(k,47) + rxt(k,289) & + *y(k,56) + rxt(k,290)*y(k,84) + rxt(k,291)*y(k,85) + rxt(k,292) & + *y(k,86) + rxt(k,301)*y(k,43) + rxt(k,306)*y(k,53) + rxt(k,307) & + *y(k,54) + rxt(k,308)*y(k,55) + rxt(k,309)*y(k,88) + rxt(k,310) & + *y(k,90) + rxt(k,311)*y(k,92) + rxt(k,319)*y(k,63) + rxt(k,321) & + *y(k,25) + rxt(k,328)*y(k,27) + rxt(k,329)*y(k,28) + rxt(k,331) & + *y(k,29) + rxt(k,333)*y(k,46) + rxt(k,334)*y(k,48) + rxt(k,339) & + *y(k,51) + rxt(k,340)*y(k,52) + rxt(k,345)*y(k,76) + rxt(k,346) & + *y(k,77) + rxt(k,347)*y(k,89) + rxt(k,348)*y(k,150) + rxt(k,349) & + *y(k,163) + rxt(k,350)*y(k,26) + rxt(k,358)*y(k,31) + rxt(k,359) & + *y(k,32) + rxt(k,361)*y(k,50) + rxt(k,362)*y(k,102) + rxt(k,363) & + *y(k,104) + rxt(k,364)*y(k,151) + rxt(k,367)*y(k,170) + rxt(k,371) & + *y(k,171) + rxt(k,372)*y(k,30) + rxt(k,373)*y(k,49) + rxt(k,375) & + *y(k,16) + rxt(k,379)*y(k,97) + rxt(k,380)*y(k,127) + rxt(k,386) & + *y(k,126) + rxt(k,396)*y(k,129) + rxt(k,397)*y(k,130) + rxt(k,398) & + *y(k,131) + rxt(k,399)*y(k,133) + rxt(k,404)*y(k,132) + rxt(k,405) & + *y(k,134) + rxt(k,408)*y(k,1) + rxt(k,412)*y(k,2) + rxt(k,413) & + *y(k,15) + rxt(k,414)*y(k,98) + rxt(k,415)*y(k,99) + rxt(k,418) & + *y(k,103) + rxt(k,420)*y(k,106) + rxt(k,422)*y(k,107) + rxt(k,423) & + *y(k,108) + rxt(k,452)*y(k,111) + rxt(k,453)*y(k,110) + rxt(k,454) & + *y(k,112) + rxt(k,455)*y(k,113) + rxt(k,460)*y(k,115) + rxt(k,463) & + *y(k,116) + rxt(k,466)*y(k,117) + rxt(k,470)*y(k,118) + rxt(k,472) & + *y(k,119) + rxt(k,481)*y(k,120) + rxt(k,485)*y(k,121) + rxt(k,487) & + *y(k,109) + rxt(k,488)*y(k,122) + (rxt(k,489) + rxt(k,490) & + ) * y(k,123) + rxt(k,502)*y(k,139) + rxt(k,543)*y(k,8) + rxt(k,546) & + *y(k,9) + rxt(k,547)*y(k,23) + rxt(k,549)*y(k,24) + rxt(k,553) & + *y(k,33) + rxt(k,554)*y(k,67) + rxt(k,566)*y(k,166) + rxt(k,569) & + *y(k,167) + rxt(k,573)*y(k,227) + rxt(k,574)*y(k,228) + rxt(k,576) & + *y(k,229) + rxt(k,579)*y(k,230) + rxt(k,582)*y(k,231) + rxt(k,583) & + *y(k,232) + rxt(k,603)*y(k,4) + rxt(k,623)*y(k,7) + rxt(k,643) & + *y(k,17) + rxt(k,663)*y(k,125) + rxt(k,683)*y(k,135) + rxt(k,689) & + *y(k,200) + rxt(k,690)*y(k,201) + rxt(k,717)*y(k,203) + rxt(k,718) & + *y(k,204) + rxt(k,736)*y(k,205) + rxt(k,737)*y(k,206) + rxt(k,746) & + *y(k,208) + rxt(k,747)*y(k,209) + rxt(k,748)*y(k,207) + rxt(k,756) & + *y(k,202) + rxt(k,757)*y(k,210) + rxt(k,763)*y(k,212) + rxt(k,768) & + *y(k,213) + rxt(k,769)*y(k,214) + rxt(k,771)*y(k,216) + rxt(k,774) & + *y(k,218) + rxt(k,775)*y(k,217) + rxt(k,778)*y(k,220) + rxt(k,782) & + *y(k,222) + rxt(k,783)*y(k,221) + rxt(k,786)*y(k,224) + rxt(k,787) & + *y(k,223) + (rxt(k,794) + rxt(k,808)) * y(k,69) + rxt(k,796) & + *y(k,161) + rxt(k,798)*y(k,175) + rxt(k,802)*y(k,172) + rxt(k,807) & + *y(k,174) + rxt(k,810)*y(k,143)) + mat(k,1683) = -rxt(k,185)*y(k,295) + mat(k,1492) = -rxt(k,186)*y(k,295) + mat(k,3378) = -rxt(k,187)*y(k,295) + mat(k,3172) = -rxt(k,188)*y(k,295) + mat(k,3769) = -rxt(k,189)*y(k,295) + mat(k,447) = -rxt(k,193)*y(k,295) + mat(k,3615) = -rxt(k,205)*y(k,295) + mat(k,483) = -rxt(k,206)*y(k,295) + mat(k,3667) = -rxt(k,214)*y(k,295) + mat(k,2960) = -rxt(k,215)*y(k,295) + mat(k,1333) = -rxt(k,234)*y(k,295) + mat(k,3521) = -(rxt(k,236) + rxt(k,237)) * y(k,295) + mat(k,3141) = -rxt(k,239)*y(k,295) + mat(k,1164) = -rxt(k,242)*y(k,295) + mat(k,3495) = -rxt(k,266)*y(k,295) + mat(k,1156) = -rxt(k,268)*y(k,295) + mat(k,500) = -rxt(k,282)*y(k,295) + mat(k,653) = -rxt(k,284)*y(k,295) + mat(k,148) = -rxt(k,285)*y(k,295) + mat(k,399) = -rxt(k,287)*y(k,295) + mat(k,467) = -rxt(k,289)*y(k,295) + mat(k,255) = -rxt(k,290)*y(k,295) + mat(k,265) = -rxt(k,291)*y(k,295) + mat(k,330) = -rxt(k,292)*y(k,295) + mat(k,3198) = -rxt(k,301)*y(k,295) + mat(k,1497) = -rxt(k,306)*y(k,295) + mat(k,453) = -rxt(k,307)*y(k,295) + mat(k,2270) = -rxt(k,308)*y(k,295) + mat(k,200) = -rxt(k,309)*y(k,295) + mat(k,1380) = -rxt(k,310)*y(k,295) + mat(k,1214) = -rxt(k,311)*y(k,295) + mat(k,2060) = -rxt(k,319)*y(k,295) + mat(k,315) = -rxt(k,321)*y(k,295) + mat(k,286) = -rxt(k,328)*y(k,295) + mat(k,362) = -rxt(k,329)*y(k,295) + mat(k,320) = -rxt(k,331)*y(k,295) + mat(k,1438) = -rxt(k,333)*y(k,295) + mat(k,125) = -rxt(k,334)*y(k,295) + mat(k,794) = -rxt(k,339)*y(k,295) + mat(k,707) = -rxt(k,340)*y(k,295) + mat(k,1717) = -rxt(k,345)*y(k,295) + mat(k,1480) = -rxt(k,346)*y(k,295) + mat(k,888) = -rxt(k,347)*y(k,295) + mat(k,1460) = -rxt(k,348)*y(k,295) + mat(k,576) = -rxt(k,349)*y(k,295) + mat(k,592) = -rxt(k,350)*y(k,295) + mat(k,415) = -rxt(k,358)*y(k,295) + mat(k,132) = -rxt(k,359)*y(k,295) + mat(k,1932) = -rxt(k,361)*y(k,295) + mat(k,1775) = -rxt(k,362)*y(k,295) + mat(k,928) = -rxt(k,363)*y(k,295) + mat(k,1486) = -rxt(k,364)*y(k,295) + mat(k,583) = -rxt(k,367)*y(k,295) + mat(k,409) = -rxt(k,371)*y(k,295) + mat(k,1399) = -rxt(k,372)*y(k,295) + mat(k,2287) = -rxt(k,373)*y(k,295) + mat(k,384) = -rxt(k,375)*y(k,295) + mat(k,985) = -rxt(k,379)*y(k,295) + mat(k,1785) = -rxt(k,380)*y(k,295) + mat(k,2029) = -rxt(k,386)*y(k,295) + mat(k,560) = -rxt(k,396)*y(k,295) + mat(k,336) = -rxt(k,397)*y(k,295) + mat(k,534) = -rxt(k,398)*y(k,295) + mat(k,1925) = -rxt(k,399)*y(k,295) + mat(k,2054) = -rxt(k,404)*y(k,295) + mat(k,1505) = -rxt(k,405)*y(k,295) + mat(k,761) = -rxt(k,408)*y(k,295) + mat(k,727) = -rxt(k,412)*y(k,295) + mat(k,206) = -rxt(k,413)*y(k,295) + mat(k,625) = -rxt(k,414)*y(k,295) + mat(k,638) = -rxt(k,415)*y(k,295) + mat(k,1882) = -rxt(k,418)*y(k,295) + mat(k,1535) = -rxt(k,420)*y(k,295) + mat(k,511) = -rxt(k,422)*y(k,295) + mat(k,1264) = -rxt(k,423)*y(k,295) + mat(k,1120) = -rxt(k,452)*y(k,295) + mat(k,1670) = -rxt(k,453)*y(k,295) + mat(k,1802) = -rxt(k,454)*y(k,295) + mat(k,1474) = -rxt(k,455)*y(k,295) + mat(k,2091) = -rxt(k,460)*y(k,295) + mat(k,681) = -rxt(k,463)*y(k,295) + mat(k,600) = -rxt(k,466)*y(k,295) + mat(k,2123) = -rxt(k,470)*y(k,295) + mat(k,737) = -rxt(k,472)*y(k,295) + mat(k,1209) = -rxt(k,481)*y(k,295) + mat(k,1595) = -rxt(k,485)*y(k,295) + mat(k,1429) = -rxt(k,487)*y(k,295) + mat(k,923) = -rxt(k,488)*y(k,295) + mat(k,1910) = -(rxt(k,489) + rxt(k,490)) * y(k,295) + mat(k,2152) = -rxt(k,502)*y(k,295) + mat(k,187) = -rxt(k,543)*y(k,295) + mat(k,422) = -rxt(k,546)*y(k,295) + mat(k,247) = -rxt(k,547)*y(k,295) + mat(k,357) = -rxt(k,549)*y(k,295) + mat(k,290) = -rxt(k,553)*y(k,295) + mat(k,222) = -rxt(k,554)*y(k,295) + mat(k,196) = -rxt(k,566)*y(k,295) + mat(k,351) = -rxt(k,569)*y(k,295) + mat(k,750) = -rxt(k,573)*y(k,295) + mat(k,217) = -rxt(k,574)*y(k,295) + mat(k,236) = -rxt(k,576)*y(k,295) + mat(k,852) = -rxt(k,579)*y(k,295) + mat(k,241) = -rxt(k,582)*y(k,295) + mat(k,434) = -rxt(k,583)*y(k,295) + mat(k,1288) = -rxt(k,603)*y(k,295) + mat(k,1053) = -rxt(k,623)*y(k,295) + mat(k,1105) = -rxt(k,643)*y(k,295) + mat(k,1084) = -rxt(k,663)*y(k,295) + mat(k,837) = -rxt(k,683)*y(k,295) + mat(k,2332) = -rxt(k,689)*y(k,295) + mat(k,475) = -rxt(k,690)*y(k,295) + mat(k,1296) = -rxt(k,717)*y(k,295) + mat(k,663) = -rxt(k,718)*y(k,295) + mat(k,1725) = -rxt(k,736)*y(k,295) + mat(k,672) = -rxt(k,737)*y(k,295) + mat(k,367) = -rxt(k,746)*y(k,295) + mat(k,372) = -rxt(k,747)*y(k,295) + mat(k,782) = -rxt(k,748)*y(k,295) + mat(k,2367) = -rxt(k,756)*y(k,295) + mat(k,428) = -rxt(k,757)*y(k,295) + mat(k,2645) = -rxt(k,763)*y(k,295) + mat(k,2617) = -rxt(k,768)*y(k,295) + mat(k,1233) = -rxt(k,769)*y(k,295) + mat(k,1109) = -rxt(k,771)*y(k,295) + mat(k,688) = -rxt(k,774)*y(k,295) + mat(k,992) = -rxt(k,775)*y(k,295) + mat(k,790) = -rxt(k,778)*y(k,295) + mat(k,1696) = -rxt(k,782)*y(k,295) + mat(k,1561) = -rxt(k,783)*y(k,295) + mat(k,1709) = -rxt(k,786)*y(k,295) + mat(k,1541) = -rxt(k,787)*y(k,295) + mat(k,309) = -(rxt(k,794) + rxt(k,808)) * y(k,295) + mat(k,392) = -rxt(k,796)*y(k,295) + mat(k,1239) = -rxt(k,798)*y(k,295) + mat(k,548) = -rxt(k,802)*y(k,295) + mat(k,1611) = -rxt(k,807)*y(k,295) + mat(k,118) = -rxt(k,810)*y(k,295) + mat(k,1288) = mat(k,1288) + .770_r8*rxt(k,602)*y(k,158) + mat(k,1053) = mat(k,1053) + .080_r8*rxt(k,622)*y(k,158) + mat(k,1105) = mat(k,1105) + .300_r8*rxt(k,642)*y(k,158) + mat(k,315) = mat(k,315) + .650_r8*rxt(k,321)*y(k,295) + mat(k,592) = mat(k,592) + .130_r8*rxt(k,323)*y(k,158) + mat(k,362) = mat(k,362) + .500_r8*rxt(k,329)*y(k,295) + mat(k,1399) = mat(k,1399) + .360_r8*rxt(k,354)*y(k,158) + mat(k,3198) = mat(k,3198) + rxt(k,300)*y(k,157) + mat(k,453) = mat(k,453) + .300_r8*rxt(k,307)*y(k,295) + mat(k,2270) = mat(k,2270) + rxt(k,315)*y(k,294) + mat(k,3851) = rxt(k,223)*y(k,258) + mat(k,1249) = rxt(k,277)*y(k,319) + mat(k,2942) = rxt(k,184)*y(k,158) + 2.000_r8*rxt(k,179)*y(k,258) + mat(k,1683) = mat(k,1683) + rxt(k,176)*y(k,157) + rxt(k,168)*y(k,294) + mat(k,1492) = mat(k,1492) + rxt(k,177)*y(k,157) + mat(k,1156) = mat(k,1156) + rxt(k,267)*y(k,157) + rxt(k,273)*y(k,294) + mat(k,3141) = mat(k,3141) + rxt(k,238)*y(k,157) + rxt(k,250)*y(k,294) + mat(k,200) = mat(k,200) + rxt(k,318)*y(k,294) + mat(k,888) = mat(k,888) + .890_r8*rxt(k,347)*y(k,295) + mat(k,1214) = mat(k,1214) + .500_r8*rxt(k,311)*y(k,295) + mat(k,1001) = rxt(k,269)*y(k,157) + mat(k,1164) = mat(k,1164) + rxt(k,241)*y(k,157) + mat(k,625) = mat(k,625) + .430_r8*rxt(k,414)*y(k,295) + mat(k,638) = mat(k,638) + .530_r8*rxt(k,415)*y(k,295) + mat(k,1882) = mat(k,1882) + 1.080_r8*rxt(k,418)*y(k,295) + mat(k,928) = mat(k,928) + .700_r8*rxt(k,363)*y(k,295) + mat(k,1429) = mat(k,1429) + .250_r8*rxt(k,486)*y(k,158) + mat(k,1802) = mat(k,1802) + .500_r8*rxt(k,454)*y(k,295) + mat(k,2091) = mat(k,2091) + .340_r8*rxt(k,459)*y(k,158) + .060_r8*rxt(k,460) & + *y(k,295) + mat(k,2123) = mat(k,2123) + .340_r8*rxt(k,469)*y(k,158) + .040_r8*rxt(k,470) & + *y(k,295) + mat(k,737) = mat(k,737) + .030_r8*rxt(k,472)*y(k,295) + mat(k,1209) = mat(k,1209) + .420_r8*rxt(k,481)*y(k,295) + mat(k,1595) = mat(k,1595) + .510_r8*rxt(k,484)*y(k,158) + .290_r8*rxt(k,485) & + *y(k,295) + mat(k,1910) = mat(k,1910) + (.130_r8*rxt(k,489)+.920_r8*rxt(k,490))*y(k,295) + mat(k,1084) = mat(k,1084) + .660_r8*rxt(k,662)*y(k,158) + mat(k,2029) = mat(k,2029) + .240_r8*rxt(k,385)*y(k,158) + mat(k,2054) = mat(k,2054) + .360_r8*rxt(k,403)*y(k,158) + mat(k,837) = mat(k,837) + .630_r8*rxt(k,682)*y(k,158) + mat(k,2152) = mat(k,2152) + .340_r8*rxt(k,501)*y(k,158) + mat(k,3119) = rxt(k,207)*y(k,258) + .550_r8*rxt(k,509)*y(k,267) & + + .550_r8*rxt(k,511)*y(k,268) + .470_r8*rxt(k,525)*y(k,275) & + + .040_r8*rxt(k,527)*y(k,276) + .550_r8*rxt(k,530)*y(k,278) & + + .550_r8*rxt(k,533)*y(k,279) + mat(k,3615) = mat(k,3615) + rxt(k,202)*y(k,258) + mat(k,3172) = mat(k,3172) + rxt(k,300)*y(k,43) + rxt(k,176)*y(k,79) & + + rxt(k,177)*y(k,81) + rxt(k,267)*y(k,83) + rxt(k,238)*y(k,87) & + + rxt(k,269)*y(k,95) + rxt(k,241)*y(k,96) + rxt(k,182)*y(k,258) + mat(k,3769) = mat(k,3769) + .770_r8*rxt(k,602)*y(k,4) + .080_r8*rxt(k,622) & + *y(k,7) + .300_r8*rxt(k,642)*y(k,17) + .130_r8*rxt(k,323) & + *y(k,26) + .360_r8*rxt(k,354)*y(k,30) + rxt(k,184)*y(k,78) & + + .250_r8*rxt(k,486)*y(k,109) + .340_r8*rxt(k,459)*y(k,115) & + + .340_r8*rxt(k,469)*y(k,118) + .510_r8*rxt(k,484)*y(k,121) & + + .660_r8*rxt(k,662)*y(k,125) + .240_r8*rxt(k,385)*y(k,126) & + + .360_r8*rxt(k,403)*y(k,132) + .630_r8*rxt(k,682)*y(k,135) & + + .340_r8*rxt(k,501)*y(k,139) + .090_r8*rxt(k,762)*y(k,212) & + + rxt(k,183)*y(k,258) + mat(k,583) = mat(k,583) + .500_r8*rxt(k,367)*y(k,295) + mat(k,2645) = mat(k,2645) + .090_r8*rxt(k,762)*y(k,158) + mat(k,555) = .400_r8*rxt(k,541)*y(k,258) + mat(k,2313) = .700_r8*rxt(k,588)*y(k,258) + mat(k,2458) = .350_r8*rxt(k,596)*y(k,258) + mat(k,2229) = .500_r8*rxt(k,608)*y(k,258) + mat(k,2426) = .100_r8*rxt(k,616)*y(k,258) + mat(k,2552) = .470_r8*rxt(k,628)*y(k,258) + mat(k,2397) = .030_r8*rxt(k,636)*y(k,258) + mat(k,2927) = .490_r8*rxt(k,337)*y(k,258) + .550_r8*rxt(k,444)*y(k,267) & + + .550_r8*rxt(k,448)*y(k,268) + .550_r8*rxt(k,491)*y(k,278) & + + .550_r8*rxt(k,495)*y(k,279) + mat(k,3471) = .280_r8*rxt(k,445)*y(k,267) + .280_r8*rxt(k,449)*y(k,268) & + + .280_r8*rxt(k,492)*y(k,278) + .280_r8*rxt(k,496)*y(k,279) + mat(k,913) = .400_r8*rxt(k,555)*y(k,258) + mat(k,3378) = mat(k,3378) + rxt(k,223)*y(k,57) + 2.000_r8*rxt(k,179)*y(k,78) & + + rxt(k,207)*y(k,147) + rxt(k,202)*y(k,149) + rxt(k,182) & + *y(k,157) + rxt(k,183)*y(k,158) + .400_r8*rxt(k,541)*y(k,235) & + + .700_r8*rxt(k,588)*y(k,237) + .350_r8*rxt(k,596)*y(k,238) & + + .500_r8*rxt(k,608)*y(k,240) + .100_r8*rxt(k,616)*y(k,241) & + + .470_r8*rxt(k,628)*y(k,245) + .030_r8*rxt(k,636)*y(k,246) & + + .490_r8*rxt(k,337)*y(k,252) + .400_r8*rxt(k,555)*y(k,254) & + + .200_r8*rxt(k,312)*y(k,259) + .650_r8*rxt(k,421)*y(k,260) & + + .060_r8*rxt(k,426)*y(k,261) + .060_r8*rxt(k,432)*y(k,262) & + + .580_r8*rxt(k,457)*y(k,269) + .520_r8*rxt(k,461)*y(k,270) & + + .600_r8*rxt(k,464)*y(k,271) + .500_r8*rxt(k,467)*y(k,272) & + + .400_r8*rxt(k,471)*y(k,273) + .240_r8*rxt(k,476)*y(k,274) & + + .850_r8*rxt(k,479)*y(k,275) + .860_r8*rxt(k,482)*y(k,276) & + + .500_r8*rxt(k,647)*y(k,281) + .100_r8*rxt(k,656)*y(k,282) & + + .590_r8*rxt(k,383)*y(k,284) + .490_r8*rxt(k,390)*y(k,286) & + + .400_r8*rxt(k,561)*y(k,287) + .200_r8*rxt(k,394)*y(k,288) & + + .540_r8*rxt(k,402)*y(k,289) + .480_r8*rxt(k,667)*y(k,290) & + + .100_r8*rxt(k,676)*y(k,291) + .800_r8*rxt(k,499)*y(k,293) & + + .150_r8*rxt(k,369)*y(k,298) + .180_r8*rxt(k,687)*y(k,299) & + + .180_r8*rxt(k,691)*y(k,300) + .490_r8*rxt(k,703)*y(k,302) & + + .380_r8*rxt(k,711)*y(k,303) + .490_r8*rxt(k,721)*y(k,304) & + + .150_r8*rxt(k,730)*y(k,305) + .530_r8*rxt(k,740)*y(k,306) & + + .490_r8*rxt(k,751)*y(k,307) + .100_r8*rxt(k,760)*y(k,308) & + + .100_r8*rxt(k,765)*y(k,309) + .100_r8*rxt(k,772)*y(k,310) & + + .100_r8*rxt(k,776)*y(k,311) + .100_r8*rxt(k,780)*y(k,312) & + + .100_r8*rxt(k,784)*y(k,313) + mat(k,700) = .200_r8*rxt(k,312)*y(k,258) + mat(k,1308) = .650_r8*rxt(k,421)*y(k,258) + mat(k,1968) = .060_r8*rxt(k,426)*y(k,258) + mat(k,2007) = .060_r8*rxt(k,432)*y(k,258) + mat(k,1747) = .550_r8*rxt(k,509)*y(k,147) + .550_r8*rxt(k,444)*y(k,252) & + + .280_r8*rxt(k,445)*y(k,253) + mat(k,1769) = .550_r8*rxt(k,511)*y(k,147) + .550_r8*rxt(k,448)*y(k,252) & + + .280_r8*rxt(k,449)*y(k,253) + mat(k,1131) = .580_r8*rxt(k,457)*y(k,258) + mat(k,1177) = .520_r8*rxt(k,461)*y(k,258) + mat(k,1063) = .600_r8*rxt(k,464)*y(k,258) + mat(k,1142) = .500_r8*rxt(k,467)*y(k,258) + mat(k,1453) = .400_r8*rxt(k,471)*y(k,258) + mat(k,2195) = .240_r8*rxt(k,476)*y(k,258) + mat(k,1322) = .470_r8*rxt(k,525)*y(k,147) + .850_r8*rxt(k,479)*y(k,258) + mat(k,1376) = .040_r8*rxt(k,527)*y(k,147) + .860_r8*rxt(k,482)*y(k,258) + mat(k,1864) = .550_r8*rxt(k,530)*y(k,147) + .550_r8*rxt(k,491)*y(k,252) & + + .280_r8*rxt(k,492)*y(k,253) + mat(k,1833) = .550_r8*rxt(k,533)*y(k,147) + .550_r8*rxt(k,495)*y(k,252) & + + .280_r8*rxt(k,496)*y(k,253) + mat(k,2523) = .500_r8*rxt(k,647)*y(k,258) + mat(k,2357) = .100_r8*rxt(k,656)*y(k,258) + mat(k,1556) = .590_r8*rxt(k,383)*y(k,258) + mat(k,1632) = .490_r8*rxt(k,390)*y(k,258) + mat(k,937) = .400_r8*rxt(k,561)*y(k,258) + mat(k,769) = .200_r8*rxt(k,394)*y(k,258) + mat(k,1520) = .540_r8*rxt(k,402)*y(k,258) + mat(k,2588) = .480_r8*rxt(k,667)*y(k,258) + mat(k,2489) = .100_r8*rxt(k,676)*y(k,258) + mat(k,1655) = .800_r8*rxt(k,499)*y(k,258) + mat(k,3810) = rxt(k,315)*y(k,55) + rxt(k,168)*y(k,79) + rxt(k,273)*y(k,83) & + + rxt(k,250)*y(k,87) + rxt(k,318)*y(k,88) + 2.000_r8*rxt(k,169) & + *y(k,319) + mat(k,4101) = mat(k,4101) + .650_r8*rxt(k,321)*y(k,25) + .500_r8*rxt(k,329) & + *y(k,28) + .300_r8*rxt(k,307)*y(k,54) + .890_r8*rxt(k,347) & + *y(k,89) + .500_r8*rxt(k,311)*y(k,92) + .430_r8*rxt(k,414) & + *y(k,98) + .530_r8*rxt(k,415)*y(k,99) + 1.080_r8*rxt(k,418) & + *y(k,103) + .700_r8*rxt(k,363)*y(k,104) + .500_r8*rxt(k,454) & + *y(k,112) + .060_r8*rxt(k,460)*y(k,115) + .040_r8*rxt(k,470) & + *y(k,118) + .030_r8*rxt(k,472)*y(k,119) + .420_r8*rxt(k,481) & + *y(k,120) + .290_r8*rxt(k,485)*y(k,121) + (.130_r8*rxt(k,489) & + +.920_r8*rxt(k,490))*y(k,123) + .500_r8*rxt(k,367)*y(k,170) + mat(k,1346) = .150_r8*rxt(k,369)*y(k,258) + mat(k,959) = .180_r8*rxt(k,687)*y(k,258) + mat(k,1013) = .180_r8*rxt(k,691)*y(k,258) + mat(k,2760) = .490_r8*rxt(k,703)*y(k,258) + mat(k,2714) = .380_r8*rxt(k,711)*y(k,258) + mat(k,2806) = .490_r8*rxt(k,721)*y(k,258) + mat(k,2253) = .150_r8*rxt(k,730)*y(k,258) + mat(k,2691) = .530_r8*rxt(k,740)*y(k,258) + mat(k,2853) = .490_r8*rxt(k,751)*y(k,258) + mat(k,804) = .100_r8*rxt(k,760)*y(k,258) + mat(k,968) = .100_r8*rxt(k,765)*y(k,258) + mat(k,1226) = .100_r8*rxt(k,772)*y(k,258) + mat(k,1022) = .100_r8*rxt(k,776)*y(k,258) + mat(k,812) = .100_r8*rxt(k,780)*y(k,258) + mat(k,820) = .100_r8*rxt(k,784)*y(k,258) + mat(k,4127) = rxt(k,277)*y(k,75) + 2.000_r8*rxt(k,169)*y(k,294) + end do + end subroutine nlnmat15 + subroutine nlnmat16( 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,456) = -(rxt(k,564)*y(k,258) + rxt(k,565)*y(k,147)) + mat(k,3233) = -rxt(k,564)*y(k,296) + mat(k,2984) = -rxt(k,565)*y(k,296) + mat(k,219) = .200_r8*rxt(k,554)*y(k,295) + mat(k,193) = .140_r8*rxt(k,566)*y(k,295) + mat(k,348) = rxt(k,569)*y(k,295) + mat(k,3919) = .200_r8*rxt(k,554)*y(k,67) + .140_r8*rxt(k,566)*y(k,166) & + + rxt(k,569)*y(k,167) + mat(k,939) = -(rxt(k,365)*y(k,258) + rxt(k,366)*y(k,147)) + mat(k,3266) = -rxt(k,365)*y(k,297) + mat(k,3011) = -rxt(k,366)*y(k,297) + mat(k,1383) = rxt(k,372)*y(k,295) + mat(k,578) = .500_r8*rxt(k,367)*y(k,295) + mat(k,3976) = rxt(k,372)*y(k,30) + .500_r8*rxt(k,367)*y(k,170) + mat(k,1336) = -(rxt(k,368)*y(k,253) + rxt(k,369)*y(k,258) + rxt(k,370) & + *y(k,147)) + mat(k,3390) = -rxt(k,368)*y(k,298) + mat(k,3290) = -rxt(k,369)*y(k,298) + mat(k,3033) = -rxt(k,370)*y(k,298) + mat(k,2272) = rxt(k,373)*y(k,295) + mat(k,406) = rxt(k,371)*y(k,295) + mat(k,4010) = rxt(k,373)*y(k,49) + rxt(k,371)*y(k,171) + mat(k,951) = -(rxt(k,687)*y(k,258) + rxt(k,688)*y(k,147)) + mat(k,3267) = -rxt(k,687)*y(k,299) + mat(k,3012) = -rxt(k,688)*y(k,299) + mat(k,2315) = rxt(k,689)*y(k,295) + mat(k,3977) = rxt(k,689)*y(k,200) + mat(k,1006) = -(rxt(k,691)*y(k,258) + rxt(k,692)*y(k,147)) + mat(k,3272) = -rxt(k,691)*y(k,300) + mat(k,3017) = -rxt(k,692)*y(k,300) + mat(k,472) = rxt(k,690)*y(k,295) + mat(k,3982) = rxt(k,690)*y(k,201) + mat(k,2654) = -(rxt(k,693)*y(k,252) + rxt(k,694)*y(k,253) + rxt(k,695) & + *y(k,258) + rxt(k,696)*y(k,147) + rxt(k,697)*y(k,149) + rxt(k,698) & + *y(k,302) + rxt(k,699)*y(k,304)) + mat(k,2907) = -rxt(k,693)*y(k,301) + mat(k,3449) = -rxt(k,694)*y(k,301) + mat(k,3356) = -rxt(k,695)*y(k,301) + mat(k,3097) = -rxt(k,696)*y(k,301) + mat(k,3593) = -rxt(k,697)*y(k,301) + mat(k,2742) = -rxt(k,698)*y(k,301) + mat(k,2788) = -rxt(k,699)*y(k,301) + mat(k,3097) = mat(k,3097) + rxt(k,752)*y(k,307) + mat(k,3593) = mat(k,3593) + rxt(k,753)*y(k,307) + mat(k,780) = .290_r8*rxt(k,748)*y(k,295) + mat(k,1107) = .860_r8*rxt(k,771)*y(k,295) + mat(k,2298) = rxt(k,593)*y(k,307) + mat(k,2443) = rxt(k,601)*y(k,307) + mat(k,2215) = rxt(k,613)*y(k,307) + mat(k,2411) = rxt(k,621)*y(k,307) + mat(k,2537) = rxt(k,633)*y(k,307) + mat(k,2382) = rxt(k,641)*y(k,307) + mat(k,2907) = mat(k,2907) + rxt(k,749)*y(k,307) + mat(k,3449) = mat(k,3449) + rxt(k,750)*y(k,307) + mat(k,3356) = mat(k,3356) + .490_r8*rxt(k,751)*y(k,307) + mat(k,2508) = rxt(k,653)*y(k,307) + mat(k,2342) = rxt(k,661)*y(k,307) + mat(k,2573) = rxt(k,673)*y(k,307) + mat(k,2474) = rxt(k,681)*y(k,307) + mat(k,4079) = .290_r8*rxt(k,748)*y(k,207) + .860_r8*rxt(k,771)*y(k,216) + mat(k,2742) = mat(k,2742) + rxt(k,707)*y(k,307) + mat(k,2699) = rxt(k,716)*y(k,307) + mat(k,2788) = mat(k,2788) + rxt(k,726)*y(k,307) + mat(k,2238) = rxt(k,735)*y(k,307) + mat(k,2676) = rxt(k,745)*y(k,307) + mat(k,2835) = rxt(k,752)*y(k,147) + rxt(k,753)*y(k,149) + rxt(k,593)*y(k,237) & + + rxt(k,601)*y(k,238) + rxt(k,613)*y(k,240) + rxt(k,621) & + *y(k,241) + rxt(k,633)*y(k,245) + rxt(k,641)*y(k,246) & + + rxt(k,749)*y(k,252) + rxt(k,750)*y(k,253) + .490_r8*rxt(k,751) & + *y(k,258) + rxt(k,653)*y(k,281) + rxt(k,661)*y(k,282) & + + rxt(k,673)*y(k,290) + rxt(k,681)*y(k,291) + rxt(k,707) & + *y(k,302) + rxt(k,716)*y(k,303) + rxt(k,726)*y(k,304) & + + rxt(k,735)*y(k,305) + rxt(k,745)*y(k,306) & + + 4.000_r8*rxt(k,754)*y(k,307) + mat(k,2745) = -(rxt(k,591)*y(k,237) + rxt(k,599)*y(k,238) + rxt(k,611) & + *y(k,240) + rxt(k,619)*y(k,241) + rxt(k,631)*y(k,245) + rxt(k,639) & + *y(k,246) + rxt(k,651)*y(k,281) + rxt(k,659)*y(k,282) + rxt(k,671) & + *y(k,290) + rxt(k,679)*y(k,291) + rxt(k,684)*y(k,148) + rxt(k,698) & + *y(k,301) + rxt(k,701)*y(k,252) + rxt(k,702)*y(k,253) + rxt(k,703) & + *y(k,258) + rxt(k,704)*y(k,147) + rxt(k,705)*y(k,149) & + + 4._r8*rxt(k,706)*y(k,302) + rxt(k,707)*y(k,307) + rxt(k,714) & + *y(k,303) + rxt(k,724)*y(k,304) + rxt(k,733)*y(k,305) + rxt(k,743) & + *y(k,306)) + mat(k,2301) = -rxt(k,591)*y(k,302) + mat(k,2446) = -rxt(k,599)*y(k,302) + mat(k,2218) = -rxt(k,611)*y(k,302) + mat(k,2414) = -rxt(k,619)*y(k,302) + mat(k,2540) = -rxt(k,631)*y(k,302) + mat(k,2385) = -rxt(k,639)*y(k,302) + mat(k,2511) = -rxt(k,651)*y(k,302) + mat(k,2345) = -rxt(k,659)*y(k,302) + mat(k,2576) = -rxt(k,671)*y(k,302) + mat(k,2477) = -rxt(k,679)*y(k,302) + mat(k,3648) = -rxt(k,684)*y(k,302) + mat(k,2657) = -rxt(k,698)*y(k,302) + mat(k,2910) = -rxt(k,701)*y(k,302) + mat(k,3452) = -rxt(k,702)*y(k,302) + mat(k,3359) = -rxt(k,703)*y(k,302) + mat(k,3100) = -rxt(k,704)*y(k,302) + mat(k,3596) = -rxt(k,705)*y(k,302) + mat(k,2838) = -rxt(k,707)*y(k,302) + mat(k,2702) = -rxt(k,714)*y(k,302) + mat(k,2791) = -rxt(k,724)*y(k,302) + mat(k,2241) = -rxt(k,733)*y(k,302) + mat(k,2679) = -rxt(k,743)*y(k,302) + mat(k,1282) = .270_r8*rxt(k,602)*y(k,158) + mat(k,1101) = .300_r8*rxt(k,642)*y(k,158) + mat(k,3596) = mat(k,3596) + rxt(k,708)*y(k,203) + mat(k,3750) = .270_r8*rxt(k,602)*y(k,4) + .300_r8*rxt(k,642)*y(k,17) + mat(k,1292) = rxt(k,708)*y(k,149) + rxt(k,717)*y(k,295) + mat(k,366) = .710_r8*rxt(k,746)*y(k,295) + mat(k,1108) = .140_r8*rxt(k,771)*y(k,295) + mat(k,4082) = rxt(k,717)*y(k,203) + .710_r8*rxt(k,746)*y(k,208) & + + .140_r8*rxt(k,771)*y(k,216) + mat(k,2701) = -(rxt(k,709)*y(k,252) + rxt(k,710)*y(k,253) + rxt(k,711) & + *y(k,258) + rxt(k,712)*y(k,147) + rxt(k,713)*y(k,149) + rxt(k,715) & + *y(k,304) + rxt(k,716)*y(k,307)) + mat(k,2909) = -rxt(k,709)*y(k,303) + mat(k,3451) = -rxt(k,710)*y(k,303) + mat(k,3358) = -rxt(k,711)*y(k,303) + mat(k,3099) = -rxt(k,712)*y(k,303) + mat(k,3595) = -rxt(k,713)*y(k,303) + mat(k,2790) = -rxt(k,715)*y(k,303) + mat(k,2837) = -rxt(k,716)*y(k,303) + mat(k,1281) = .330_r8*rxt(k,602)*y(k,158) + mat(k,3099) = mat(k,3099) + .700_r8*rxt(k,696)*y(k,301) + rxt(k,704)*y(k,302) + mat(k,3595) = mat(k,3595) + rxt(k,697)*y(k,301) + rxt(k,705)*y(k,302) + mat(k,3749) = .330_r8*rxt(k,602)*y(k,4) + mat(k,2361) = .230_r8*rxt(k,756)*y(k,295) + mat(k,365) = .290_r8*rxt(k,746)*y(k,295) + mat(k,2300) = rxt(k,591)*y(k,302) + mat(k,2445) = rxt(k,599)*y(k,302) + mat(k,2217) = rxt(k,611)*y(k,302) + mat(k,2413) = rxt(k,619)*y(k,302) + mat(k,2539) = rxt(k,631)*y(k,302) + mat(k,2384) = rxt(k,639)*y(k,302) + mat(k,2909) = mat(k,2909) + rxt(k,693)*y(k,301) + rxt(k,701)*y(k,302) + mat(k,3451) = mat(k,3451) + .500_r8*rxt(k,694)*y(k,301) + rxt(k,702)*y(k,302) + mat(k,3358) = mat(k,3358) + .490_r8*rxt(k,703)*y(k,302) + mat(k,2510) = rxt(k,651)*y(k,302) + mat(k,2344) = rxt(k,659)*y(k,302) + mat(k,2575) = rxt(k,671)*y(k,302) + mat(k,2476) = rxt(k,679)*y(k,302) + mat(k,4081) = .230_r8*rxt(k,756)*y(k,202) + .290_r8*rxt(k,746)*y(k,208) + mat(k,2656) = .700_r8*rxt(k,696)*y(k,147) + rxt(k,697)*y(k,149) + rxt(k,693) & + *y(k,252) + .500_r8*rxt(k,694)*y(k,253) + 2.000_r8*rxt(k,698) & + *y(k,302) + rxt(k,699)*y(k,304) + rxt(k,700)*y(k,307) + mat(k,2744) = rxt(k,704)*y(k,147) + rxt(k,705)*y(k,149) + rxt(k,591)*y(k,237) & + + rxt(k,599)*y(k,238) + rxt(k,611)*y(k,240) + rxt(k,619) & + *y(k,241) + rxt(k,631)*y(k,245) + rxt(k,639)*y(k,246) & + + rxt(k,701)*y(k,252) + rxt(k,702)*y(k,253) + .490_r8*rxt(k,703) & + *y(k,258) + rxt(k,651)*y(k,281) + rxt(k,659)*y(k,282) & + + rxt(k,671)*y(k,290) + rxt(k,679)*y(k,291) & + + 2.000_r8*rxt(k,698)*y(k,301) + 4.000_r8*rxt(k,706)*y(k,302) & + + rxt(k,724)*y(k,304) + rxt(k,733)*y(k,305) + rxt(k,743) & + *y(k,306) + rxt(k,707)*y(k,307) + mat(k,2790) = mat(k,2790) + rxt(k,699)*y(k,301) + rxt(k,724)*y(k,302) + mat(k,2240) = rxt(k,733)*y(k,302) + mat(k,2678) = rxt(k,743)*y(k,302) + mat(k,2837) = mat(k,2837) + rxt(k,700)*y(k,301) + rxt(k,707)*y(k,302) + mat(k,2792) = -(rxt(k,592)*y(k,237) + rxt(k,600)*y(k,238) + rxt(k,612) & + *y(k,240) + rxt(k,620)*y(k,241) + rxt(k,632)*y(k,245) + rxt(k,640) & + *y(k,246) + rxt(k,652)*y(k,281) + rxt(k,660)*y(k,282) + rxt(k,672) & + *y(k,290) + rxt(k,680)*y(k,291) + rxt(k,685)*y(k,148) + rxt(k,699) & + *y(k,301) + rxt(k,715)*y(k,303) + rxt(k,719)*y(k,252) + rxt(k,720) & + *y(k,253) + rxt(k,721)*y(k,258) + rxt(k,722)*y(k,147) + rxt(k,723) & + *y(k,149) + rxt(k,724)*y(k,302) + 4._r8*rxt(k,725)*y(k,304) & + + rxt(k,726)*y(k,307) + rxt(k,734)*y(k,305) + rxt(k,744) & + *y(k,306)) + mat(k,2302) = -rxt(k,592)*y(k,304) + mat(k,2447) = -rxt(k,600)*y(k,304) + mat(k,2219) = -rxt(k,612)*y(k,304) + mat(k,2415) = -rxt(k,620)*y(k,304) + mat(k,2541) = -rxt(k,632)*y(k,304) + mat(k,2386) = -rxt(k,640)*y(k,304) + mat(k,2512) = -rxt(k,652)*y(k,304) + mat(k,2346) = -rxt(k,660)*y(k,304) + mat(k,2577) = -rxt(k,672)*y(k,304) + mat(k,2478) = -rxt(k,680)*y(k,304) + mat(k,3649) = -rxt(k,685)*y(k,304) + mat(k,2658) = -rxt(k,699)*y(k,304) + mat(k,2703) = -rxt(k,715)*y(k,304) + mat(k,2911) = -rxt(k,719)*y(k,304) + mat(k,3453) = -rxt(k,720)*y(k,304) + mat(k,3360) = -rxt(k,721)*y(k,304) + mat(k,3101) = -rxt(k,722)*y(k,304) + mat(k,3597) = -rxt(k,723)*y(k,304) + mat(k,2746) = -rxt(k,724)*y(k,304) + mat(k,2839) = -rxt(k,726)*y(k,304) + mat(k,2242) = -rxt(k,734)*y(k,304) + mat(k,2680) = -rxt(k,744)*y(k,304) + mat(k,1078) = .330_r8*rxt(k,662)*y(k,158) + mat(k,3597) = mat(k,3597) + rxt(k,727)*y(k,205) + mat(k,3751) = .330_r8*rxt(k,662)*y(k,125) + mat(k,1721) = rxt(k,727)*y(k,149) + .750_r8*rxt(k,736)*y(k,295) + mat(k,371) = .710_r8*rxt(k,747)*y(k,295) + mat(k,2633) = .170_r8*rxt(k,763)*y(k,295) + mat(k,4083) = .750_r8*rxt(k,736)*y(k,205) + .710_r8*rxt(k,747)*y(k,209) & + + .170_r8*rxt(k,763)*y(k,212) + mat(k,2235) = -(rxt(k,728)*y(k,252) + rxt(k,729)*y(k,253) + rxt(k,730) & + *y(k,258) + rxt(k,731)*y(k,147) + rxt(k,732)*y(k,149) + rxt(k,733) & + *y(k,302) + rxt(k,734)*y(k,304) + rxt(k,735)*y(k,307)) + mat(k,2891) = -rxt(k,728)*y(k,305) + mat(k,3433) = -rxt(k,729)*y(k,305) + mat(k,3340) = -rxt(k,730)*y(k,305) + mat(k,3081) = -rxt(k,731)*y(k,305) + mat(k,3577) = -rxt(k,732)*y(k,305) + mat(k,2727) = -rxt(k,733)*y(k,305) + mat(k,2773) = -rxt(k,734)*y(k,305) + mat(k,2820) = -rxt(k,735)*y(k,305) + mat(k,3081) = mat(k,3081) + .830_r8*rxt(k,712)*y(k,303) + mat(k,3577) = mat(k,3577) + rxt(k,713)*y(k,303) + mat(k,2891) = mat(k,2891) + rxt(k,709)*y(k,303) + mat(k,3433) = mat(k,3433) + rxt(k,710)*y(k,303) + mat(k,3340) = mat(k,3340) + .380_r8*rxt(k,711)*y(k,303) + mat(k,2727) = mat(k,2727) + rxt(k,714)*y(k,303) + mat(k,2696) = .830_r8*rxt(k,712)*y(k,147) + rxt(k,713)*y(k,149) + rxt(k,709) & + *y(k,252) + rxt(k,710)*y(k,253) + .380_r8*rxt(k,711)*y(k,258) & + + rxt(k,714)*y(k,302) + rxt(k,715)*y(k,304) + rxt(k,716) & + *y(k,307) + mat(k,2773) = mat(k,2773) + rxt(k,715)*y(k,303) + mat(k,2820) = mat(k,2820) + rxt(k,716)*y(k,303) + end do + end subroutine nlnmat16 + subroutine nlnmat17( 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,2677) = -(rxt(k,738)*y(k,252) + rxt(k,739)*y(k,253) + rxt(k,740) & + *y(k,258) + rxt(k,741)*y(k,147) + rxt(k,742)*y(k,149) + rxt(k,743) & + *y(k,302) + rxt(k,745)*y(k,307)) + mat(k,2908) = -rxt(k,738)*y(k,306) + mat(k,3450) = -rxt(k,739)*y(k,306) + mat(k,3357) = -rxt(k,740)*y(k,306) + mat(k,3098) = -rxt(k,741)*y(k,306) + mat(k,3594) = -rxt(k,742)*y(k,306) + mat(k,2743) = -rxt(k,743)*y(k,306) + mat(k,2836) = -rxt(k,745)*y(k,306) + mat(k,3098) = mat(k,3098) + rxt(k,722)*y(k,304) + .700_r8*rxt(k,731)*y(k,305) + mat(k,3594) = mat(k,3594) + rxt(k,723)*y(k,304) + rxt(k,732)*y(k,305) + mat(k,1720) = .250_r8*rxt(k,736)*y(k,295) + mat(k,370) = .290_r8*rxt(k,747)*y(k,295) + mat(k,2299) = rxt(k,592)*y(k,304) + mat(k,2444) = rxt(k,600)*y(k,304) + mat(k,2216) = rxt(k,612)*y(k,304) + mat(k,2412) = rxt(k,620)*y(k,304) + mat(k,2538) = rxt(k,632)*y(k,304) + mat(k,2383) = rxt(k,640)*y(k,304) + mat(k,2908) = mat(k,2908) + rxt(k,719)*y(k,304) + rxt(k,728)*y(k,305) + mat(k,3450) = mat(k,3450) + rxt(k,720)*y(k,304) + rxt(k,729)*y(k,305) + mat(k,3357) = mat(k,3357) + .490_r8*rxt(k,721)*y(k,304) + .150_r8*rxt(k,730) & + *y(k,305) + mat(k,2509) = rxt(k,652)*y(k,304) + mat(k,2343) = rxt(k,660)*y(k,304) + mat(k,2574) = rxt(k,672)*y(k,304) + mat(k,2475) = rxt(k,680)*y(k,304) + mat(k,4080) = .250_r8*rxt(k,736)*y(k,205) + .290_r8*rxt(k,747)*y(k,209) + mat(k,2655) = rxt(k,699)*y(k,304) + mat(k,2743) = mat(k,2743) + rxt(k,724)*y(k,304) + rxt(k,733)*y(k,305) + mat(k,2700) = rxt(k,715)*y(k,304) + mat(k,2789) = rxt(k,722)*y(k,147) + rxt(k,723)*y(k,149) + rxt(k,592)*y(k,237) & + + rxt(k,600)*y(k,238) + rxt(k,612)*y(k,240) + rxt(k,620) & + *y(k,241) + rxt(k,632)*y(k,245) + rxt(k,640)*y(k,246) & + + rxt(k,719)*y(k,252) + rxt(k,720)*y(k,253) + .490_r8*rxt(k,721) & + *y(k,258) + rxt(k,652)*y(k,281) + rxt(k,660)*y(k,282) & + + rxt(k,672)*y(k,290) + rxt(k,680)*y(k,291) + rxt(k,699) & + *y(k,301) + rxt(k,724)*y(k,302) + rxt(k,715)*y(k,303) & + + 4.000_r8*rxt(k,725)*y(k,304) + 2.000_r8*rxt(k,734)*y(k,305) & + + rxt(k,726)*y(k,307) + mat(k,2239) = .700_r8*rxt(k,731)*y(k,147) + rxt(k,732)*y(k,149) + rxt(k,728) & + *y(k,252) + rxt(k,729)*y(k,253) + .150_r8*rxt(k,730)*y(k,258) & + + rxt(k,733)*y(k,302) + 2.000_r8*rxt(k,734)*y(k,304) & + + rxt(k,735)*y(k,307) + mat(k,2836) = mat(k,2836) + rxt(k,726)*y(k,304) + rxt(k,735)*y(k,305) + mat(k,2840) = -(rxt(k,593)*y(k,237) + rxt(k,601)*y(k,238) + rxt(k,613) & + *y(k,240) + rxt(k,621)*y(k,241) + rxt(k,633)*y(k,245) + rxt(k,641) & + *y(k,246) + rxt(k,653)*y(k,281) + rxt(k,661)*y(k,282) + rxt(k,673) & + *y(k,290) + rxt(k,681)*y(k,291) + rxt(k,686)*y(k,148) + rxt(k,700) & + *y(k,301) + rxt(k,707)*y(k,302) + rxt(k,716)*y(k,303) + rxt(k,726) & + *y(k,304) + rxt(k,735)*y(k,305) + rxt(k,745)*y(k,306) + rxt(k,749) & + *y(k,252) + rxt(k,750)*y(k,253) + rxt(k,751)*y(k,258) + rxt(k,752) & + *y(k,147) + rxt(k,753)*y(k,149) + 4._r8*rxt(k,754)*y(k,307)) + mat(k,2303) = -rxt(k,593)*y(k,307) + mat(k,2448) = -rxt(k,601)*y(k,307) + mat(k,2220) = -rxt(k,613)*y(k,307) + mat(k,2416) = -rxt(k,621)*y(k,307) + mat(k,2542) = -rxt(k,633)*y(k,307) + mat(k,2387) = -rxt(k,641)*y(k,307) + mat(k,2513) = -rxt(k,653)*y(k,307) + mat(k,2347) = -rxt(k,661)*y(k,307) + mat(k,2578) = -rxt(k,673)*y(k,307) + mat(k,2479) = -rxt(k,681)*y(k,307) + mat(k,3650) = -rxt(k,686)*y(k,307) + mat(k,2659) = -rxt(k,700)*y(k,307) + mat(k,2747) = -rxt(k,707)*y(k,307) + mat(k,2704) = -rxt(k,716)*y(k,307) + mat(k,2793) = -rxt(k,726)*y(k,307) + mat(k,2243) = -rxt(k,735)*y(k,307) + mat(k,2681) = -rxt(k,745)*y(k,307) + mat(k,2912) = -rxt(k,749)*y(k,307) + mat(k,3454) = -rxt(k,750)*y(k,307) + mat(k,3361) = -rxt(k,751)*y(k,307) + mat(k,3102) = -rxt(k,752)*y(k,307) + mat(k,3598) = -rxt(k,753)*y(k,307) + mat(k,3598) = mat(k,3598) + rxt(k,755)*y(k,202) + mat(k,2362) = rxt(k,755)*y(k,149) + .770_r8*rxt(k,756)*y(k,295) + mat(k,781) = .710_r8*rxt(k,748)*y(k,295) + mat(k,4084) = .770_r8*rxt(k,756)*y(k,202) + .710_r8*rxt(k,748)*y(k,207) + mat(k,797) = -(rxt(k,760)*y(k,258) + rxt(k,761)*y(k,147)) + mat(k,3254) = -rxt(k,760)*y(k,308) + mat(k,3000) = -rxt(k,761)*y(k,308) + mat(k,2619) = .830_r8*rxt(k,763)*y(k,295) + mat(k,3961) = .830_r8*rxt(k,763)*y(k,212) + mat(k,960) = -(rxt(k,765)*y(k,258) + rxt(k,766)*y(k,147)) + mat(k,3268) = -rxt(k,765)*y(k,309) + mat(k,3013) = -rxt(k,766)*y(k,309) + mat(k,2590) = rxt(k,768)*y(k,295) + mat(k,3978) = rxt(k,768)*y(k,213) + mat(k,1218) = -(rxt(k,772)*y(k,258) + rxt(k,773)*y(k,147)) + mat(k,3286) = -rxt(k,772)*y(k,310) + mat(k,3029) = -rxt(k,773)*y(k,310) + mat(k,683) = rxt(k,774)*y(k,295) + mat(k,4000) = rxt(k,774)*y(k,218) + mat(k,1015) = -(rxt(k,776)*y(k,258) + rxt(k,777)*y(k,147)) + mat(k,3273) = -rxt(k,776)*y(k,311) + mat(k,3018) = -rxt(k,777)*y(k,311) + mat(k,784) = rxt(k,778)*y(k,295) + mat(k,3983) = rxt(k,778)*y(k,220) + mat(k,805) = -(rxt(k,780)*y(k,258) + rxt(k,781)*y(k,147)) + mat(k,3255) = -rxt(k,780)*y(k,312) + mat(k,3001) = -rxt(k,781)*y(k,312) + mat(k,1685) = rxt(k,782)*y(k,295) + mat(k,3962) = rxt(k,782)*y(k,222) + mat(k,813) = -(rxt(k,784)*y(k,258) + rxt(k,785)*y(k,147)) + mat(k,3256) = -rxt(k,784)*y(k,313) + mat(k,3002) = -rxt(k,785)*y(k,313) + mat(k,1697) = rxt(k,786)*y(k,295) + mat(k,3963) = rxt(k,786)*y(k,224) + mat(k,873) = -(rxt(k,571)*y(k,258) + rxt(k,572)*y(k,147)) + mat(k,3260) = -rxt(k,571)*y(k,314) + mat(k,3005) = -rxt(k,572)*y(k,314) + mat(k,743) = rxt(k,573)*y(k,295) + mat(k,215) = .650_r8*rxt(k,574)*y(k,295) + mat(k,3968) = rxt(k,573)*y(k,227) + .650_r8*rxt(k,574)*y(k,228) + mat(k,107) = -(rxt(k,879)*y(k,258) + rxt(k,880)*y(k,147)) + mat(k,3214) = -rxt(k,879)*y(k,315) + mat(k,2976) = -rxt(k,880)*y(k,315) + mat(k,210) = rxt(k,878)*y(k,295) + mat(k,3868) = rxt(k,878)*y(k,228) + mat(k,895) = -(rxt(k,577)*y(k,258) + rxt(k,578)*y(k,147)) + mat(k,3262) = -rxt(k,577)*y(k,316) + mat(k,3007) = -rxt(k,578)*y(k,316) + mat(k,232) = .560_r8*rxt(k,576)*y(k,295) + mat(k,844) = rxt(k,579)*y(k,295) + mat(k,3970) = .560_r8*rxt(k,576)*y(k,229) + rxt(k,579)*y(k,230) + mat(k,113) = -(rxt(k,882)*y(k,258) + rxt(k,883)*y(k,147)) + mat(k,3215) = -rxt(k,882)*y(k,317) + mat(k,2977) = -rxt(k,883)*y(k,317) + mat(k,227) = rxt(k,881)*y(k,295) + mat(k,3869) = rxt(k,881)*y(k,229) + mat(k,536) = -(rxt(k,580)*y(k,258) + rxt(k,581)*y(k,147)) + mat(k,3238) = -rxt(k,580)*y(k,318) + mat(k,2989) = -rxt(k,581)*y(k,318) + mat(k,239) = .300_r8*rxt(k,582)*y(k,295) + mat(k,430) = rxt(k,583)*y(k,295) + mat(k,3931) = .300_r8*rxt(k,582)*y(k,231) + rxt(k,583)*y(k,232) + mat(k,4128) = -(rxt(k,169)*y(k,294) + rxt(k,277)*y(k,75) + rxt(k,809) & + *y(k,176)) + mat(k,3811) = -rxt(k,169)*y(k,319) + mat(k,1250) = -rxt(k,277)*y(k,319) + mat(k,282) = -rxt(k,809)*y(k,319) + mat(k,321) = rxt(k,331)*y(k,295) + mat(k,416) = rxt(k,358)*y(k,295) + mat(k,133) = rxt(k,359)*y(k,295) + mat(k,501) = rxt(k,282)*y(k,295) + mat(k,3199) = rxt(k,301)*y(k,295) + mat(k,654) = rxt(k,284)*y(k,295) + mat(k,149) = rxt(k,285)*y(k,295) + mat(k,1439) = rxt(k,333)*y(k,295) + mat(k,400) = rxt(k,287)*y(k,295) + mat(k,2288) = rxt(k,373)*y(k,295) + mat(k,1933) = rxt(k,361)*y(k,295) + mat(k,795) = rxt(k,339)*y(k,295) + mat(k,708) = rxt(k,340)*y(k,295) + mat(k,454) = rxt(k,307)*y(k,295) + mat(k,2271) = rxt(k,308)*y(k,295) + mat(k,2943) = rxt(k,180)*y(k,258) + mat(k,1684) = rxt(k,185)*y(k,295) + mat(k,1493) = rxt(k,186)*y(k,295) + mat(k,1157) = rxt(k,268)*y(k,295) + mat(k,331) = rxt(k,292)*y(k,295) + mat(k,3142) = (rxt(k,892)+rxt(k,897))*y(k,95) + (rxt(k,885)+rxt(k,891) & + +rxt(k,896))*y(k,96) + rxt(k,239)*y(k,295) + mat(k,1381) = rxt(k,310)*y(k,295) + mat(k,1215) = rxt(k,311)*y(k,295) + mat(k,2961) = rxt(k,215)*y(k,295) + mat(k,448) = rxt(k,193)*y(k,295) + mat(k,1002) = (rxt(k,892)+rxt(k,897))*y(k,87) + mat(k,1165) = (rxt(k,885)+rxt(k,891)+rxt(k,896))*y(k,87) + rxt(k,242) & + *y(k,295) + mat(k,2030) = .450_r8*rxt(k,386)*y(k,295) + mat(k,119) = rxt(k,810)*y(k,295) + mat(k,584) = rxt(k,367)*y(k,295) + mat(k,410) = rxt(k,371)*y(k,295) + mat(k,993) = rxt(k,775)*y(k,295) + mat(k,1149) = rxt(k,779)*y(k,295) + mat(k,3379) = rxt(k,180)*y(k,78) + .300_r8*rxt(k,312)*y(k,259) + rxt(k,187) & + *y(k,295) + mat(k,701) = .300_r8*rxt(k,312)*y(k,258) + mat(k,4102) = rxt(k,331)*y(k,29) + rxt(k,358)*y(k,31) + rxt(k,359)*y(k,32) & + + rxt(k,282)*y(k,42) + rxt(k,301)*y(k,43) + rxt(k,284)*y(k,44) & + + rxt(k,285)*y(k,45) + rxt(k,333)*y(k,46) + rxt(k,287)*y(k,47) & + + rxt(k,373)*y(k,49) + rxt(k,361)*y(k,50) + rxt(k,339)*y(k,51) & + + rxt(k,340)*y(k,52) + rxt(k,307)*y(k,54) + rxt(k,308)*y(k,55) & + + rxt(k,185)*y(k,79) + rxt(k,186)*y(k,81) + rxt(k,268)*y(k,83) & + + rxt(k,292)*y(k,86) + rxt(k,239)*y(k,87) + rxt(k,310)*y(k,90) & + + rxt(k,311)*y(k,92) + rxt(k,215)*y(k,93) + rxt(k,193)*y(k,94) & + + rxt(k,242)*y(k,96) + .450_r8*rxt(k,386)*y(k,126) + rxt(k,810) & + *y(k,143) + rxt(k,367)*y(k,170) + rxt(k,371)*y(k,171) & + + rxt(k,775)*y(k,217) + rxt(k,779)*y(k,219) + rxt(k,187) & + *y(k,258) + 2.000_r8*rxt(k,190)*y(k,295) + end do + end subroutine nlnmat17 + 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) = lmat(k, 39) + mat(k, 40) = lmat(k, 40) + mat(k, 41) = lmat(k, 41) + mat(k, 42) = lmat(k, 42) + mat(k, 43) = lmat(k, 43) + mat(k, 44) = lmat(k, 44) + mat(k, 45) = lmat(k, 45) + mat(k, 51) = mat(k, 51) + lmat(k, 51) + mat(k, 57) = mat(k, 57) + lmat(k, 57) + mat(k, 63) = mat(k, 63) + lmat(k, 63) + mat(k, 69) = mat(k, 69) + lmat(k, 69) + mat(k, 75) = mat(k, 75) + lmat(k, 75) + mat(k, 81) = mat(k, 81) + lmat(k, 81) + mat(k, 87) = mat(k, 87) + lmat(k, 87) + mat(k, 89) = mat(k, 89) + lmat(k, 89) + mat(k, 95) = mat(k, 95) + lmat(k, 95) + mat(k, 101) = mat(k, 101) + lmat(k, 101) + mat(k, 107) = mat(k, 107) + lmat(k, 107) + mat(k, 113) = mat(k, 113) + lmat(k, 113) + mat(k, 114) = lmat(k, 114) + mat(k, 115) = lmat(k, 115) + mat(k, 116) = lmat(k, 116) + mat(k, 117) = mat(k, 117) + lmat(k, 117) + mat(k, 120) = mat(k, 120) + lmat(k, 120) + mat(k, 122) = mat(k, 122) + lmat(k, 122) + mat(k, 123) = mat(k, 123) + lmat(k, 123) + mat(k, 126) = mat(k, 126) + lmat(k, 126) + mat(k, 127) = mat(k, 127) + lmat(k, 127) + mat(k, 128) = mat(k, 128) + lmat(k, 128) + mat(k, 130) = mat(k, 130) + lmat(k, 130) + mat(k, 134) = mat(k, 134) + lmat(k, 134) + mat(k, 135) = mat(k, 135) + lmat(k, 135) + mat(k, 137) = mat(k, 137) + lmat(k, 137) + mat(k, 138) = mat(k, 138) + lmat(k, 138) + mat(k, 139) = mat(k, 139) + lmat(k, 139) + mat(k, 141) = mat(k, 141) + lmat(k, 141) + mat(k, 142) = mat(k, 142) + lmat(k, 142) + mat(k, 143) = mat(k, 143) + lmat(k, 143) + mat(k, 145) = mat(k, 145) + lmat(k, 145) + mat(k, 146) = mat(k, 146) + lmat(k, 146) + mat(k, 147) = mat(k, 147) + lmat(k, 147) + mat(k, 150) = lmat(k, 150) + mat(k, 151) = lmat(k, 151) + mat(k, 152) = lmat(k, 152) + mat(k, 153) = lmat(k, 153) + mat(k, 154) = lmat(k, 154) + mat(k, 155) = lmat(k, 155) + mat(k, 156) = lmat(k, 156) + mat(k, 157) = lmat(k, 157) + mat(k, 158) = lmat(k, 158) + mat(k, 159) = mat(k, 159) + lmat(k, 159) + mat(k, 160) = mat(k, 160) + lmat(k, 160) + mat(k, 161) = mat(k, 161) + lmat(k, 161) + mat(k, 163) = mat(k, 163) + lmat(k, 163) + mat(k, 164) = mat(k, 164) + lmat(k, 164) + mat(k, 165) = mat(k, 165) + lmat(k, 165) + mat(k, 166) = mat(k, 166) + lmat(k, 166) + mat(k, 167) = mat(k, 167) + lmat(k, 167) + mat(k, 169) = mat(k, 169) + lmat(k, 169) + mat(k, 170) = mat(k, 170) + lmat(k, 170) + mat(k, 171) = mat(k, 171) + lmat(k, 171) + mat(k, 173) = mat(k, 173) + lmat(k, 173) + mat(k, 174) = mat(k, 174) + lmat(k, 174) + mat(k, 175) = mat(k, 175) + lmat(k, 175) + mat(k, 176) = mat(k, 176) + lmat(k, 176) + mat(k, 178) = mat(k, 178) + lmat(k, 178) + mat(k, 179) = lmat(k, 179) + mat(k, 180) = lmat(k, 180) + mat(k, 182) = mat(k, 182) + lmat(k, 182) + mat(k, 188) = lmat(k, 188) + mat(k, 189) = lmat(k, 189) + mat(k, 190) = lmat(k, 190) + mat(k, 191) = lmat(k, 191) + mat(k, 192) = mat(k, 192) + lmat(k, 192) + mat(k, 197) = mat(k, 197) + lmat(k, 197) + mat(k, 201) = mat(k, 201) + lmat(k, 201) + mat(k, 203) = mat(k, 203) + lmat(k, 203) + mat(k, 204) = mat(k, 204) + lmat(k, 204) + mat(k, 207) = lmat(k, 207) + mat(k, 208) = lmat(k, 208) + mat(k, 209) = lmat(k, 209) + mat(k, 211) = mat(k, 211) + lmat(k, 211) + mat(k, 218) = mat(k, 218) + lmat(k, 218) + mat(k, 223) = lmat(k, 223) + mat(k, 224) = lmat(k, 224) + mat(k, 225) = lmat(k, 225) + mat(k, 226) = lmat(k, 226) + mat(k, 229) = mat(k, 229) + lmat(k, 229) + mat(k, 237) = mat(k, 237) + lmat(k, 237) + mat(k, 242) = lmat(k, 242) + mat(k, 243) = lmat(k, 243) + mat(k, 244) = lmat(k, 244) + mat(k, 245) = mat(k, 245) + lmat(k, 245) + mat(k, 248) = mat(k, 248) + lmat(k, 248) + mat(k, 249) = mat(k, 249) + lmat(k, 249) + mat(k, 251) = mat(k, 251) + lmat(k, 251) + mat(k, 252) = mat(k, 252) + lmat(k, 252) + mat(k, 254) = mat(k, 254) + lmat(k, 254) + mat(k, 256) = mat(k, 256) + lmat(k, 256) + mat(k, 257) = 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, 261) = mat(k, 261) + lmat(k, 261) + mat(k, 264) = mat(k, 264) + lmat(k, 264) + mat(k, 266) = lmat(k, 266) + mat(k, 267) = lmat(k, 267) + 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, 272) = lmat(k, 272) + mat(k, 273) = lmat(k, 273) + mat(k, 274) = lmat(k, 274) + mat(k, 275) = lmat(k, 275) + mat(k, 276) = lmat(k, 276) + mat(k, 277) = lmat(k, 277) + mat(k, 279) = mat(k, 279) + lmat(k, 279) + mat(k, 280) = lmat(k, 280) + mat(k, 281) = lmat(k, 281) + mat(k, 283) = mat(k, 283) + lmat(k, 283) + mat(k, 287) = mat(k, 287) + lmat(k, 287) + mat(k, 288) = lmat(k, 288) + mat(k, 290) = mat(k, 290) + lmat(k, 290) + mat(k, 291) = lmat(k, 291) + mat(k, 292) = lmat(k, 292) + mat(k, 293) = lmat(k, 293) + mat(k, 294) = lmat(k, 294) + mat(k, 295) = lmat(k, 295) + mat(k, 296) = lmat(k, 296) + mat(k, 297) = lmat(k, 297) + mat(k, 298) = lmat(k, 298) + mat(k, 299) = lmat(k, 299) + mat(k, 300) = lmat(k, 300) + mat(k, 301) = lmat(k, 301) + mat(k, 302) = lmat(k, 302) + mat(k, 303) = lmat(k, 303) + mat(k, 304) = mat(k, 304) + lmat(k, 304) + mat(k, 310) = mat(k, 310) + lmat(k, 310) + mat(k, 316) = mat(k, 316) + lmat(k, 316) + mat(k, 322) = lmat(k, 322) + mat(k, 323) = lmat(k, 323) + mat(k, 324) = lmat(k, 324) + mat(k, 325) = mat(k, 325) + lmat(k, 325) + mat(k, 326) = mat(k, 326) + lmat(k, 326) + mat(k, 329) = mat(k, 329) + lmat(k, 329) + mat(k, 332) = mat(k, 332) + lmat(k, 332) + mat(k, 334) = lmat(k, 334) + mat(k, 335) = lmat(k, 335) + mat(k, 336) = mat(k, 336) + lmat(k, 336) + mat(k, 337) = lmat(k, 337) + mat(k, 338) = lmat(k, 338) + mat(k, 339) = lmat(k, 339) + mat(k, 340) = lmat(k, 340) + mat(k, 341) = lmat(k, 341) + mat(k, 342) = mat(k, 342) + lmat(k, 342) + mat(k, 345) = lmat(k, 345) + mat(k, 346) = mat(k, 346) + lmat(k, 346) + mat(k, 347) = mat(k, 347) + lmat(k, 347) + mat(k, 349) = lmat(k, 349) + mat(k, 350) = lmat(k, 350) + mat(k, 351) = mat(k, 351) + lmat(k, 351) + mat(k, 352) = lmat(k, 352) + mat(k, 353) = mat(k, 353) + lmat(k, 353) + mat(k, 356) = lmat(k, 356) + mat(k, 357) = mat(k, 357) + lmat(k, 357) + mat(k, 358) = mat(k, 358) + lmat(k, 358) + mat(k, 360) = mat(k, 360) + lmat(k, 360) + mat(k, 361) = lmat(k, 361) + mat(k, 362) = mat(k, 362) + lmat(k, 362) + mat(k, 363) = mat(k, 363) + lmat(k, 363) + mat(k, 364) = mat(k, 364) + lmat(k, 364) + mat(k, 365) = mat(k, 365) + lmat(k, 365) + mat(k, 367) = mat(k, 367) + lmat(k, 367) + mat(k, 368) = mat(k, 368) + lmat(k, 368) + mat(k, 369) = mat(k, 369) + lmat(k, 369) + mat(k, 370) = mat(k, 370) + lmat(k, 370) + mat(k, 372) = mat(k, 372) + lmat(k, 372) + mat(k, 373) = mat(k, 373) + lmat(k, 373) + mat(k, 374) = mat(k, 374) + lmat(k, 374) + mat(k, 375) = lmat(k, 375) + mat(k, 376) = lmat(k, 376) + mat(k, 377) = mat(k, 377) + lmat(k, 377) + mat(k, 385) = mat(k, 385) + lmat(k, 385) + mat(k, 386) = lmat(k, 386) + mat(k, 389) = mat(k, 389) + lmat(k, 389) + mat(k, 393) = mat(k, 393) + lmat(k, 393) + mat(k, 397) = lmat(k, 397) + mat(k, 398) = mat(k, 398) + lmat(k, 398) + mat(k, 401) = lmat(k, 401) + mat(k, 402) = lmat(k, 402) + mat(k, 403) = lmat(k, 403) + mat(k, 404) = lmat(k, 404) + mat(k, 405) = mat(k, 405) + lmat(k, 405) + mat(k, 407) = lmat(k, 407) + mat(k, 408) = lmat(k, 408) + mat(k, 409) = mat(k, 409) + lmat(k, 409) + mat(k, 411) = mat(k, 411) + lmat(k, 411) + mat(k, 413) = lmat(k, 413) + mat(k, 414) = lmat(k, 414) + mat(k, 415) = mat(k, 415) + lmat(k, 415) + mat(k, 417) = mat(k, 417) + lmat(k, 417) + mat(k, 418) = lmat(k, 418) + mat(k, 420) = lmat(k, 420) + mat(k, 421) = lmat(k, 421) + mat(k, 422) = mat(k, 422) + lmat(k, 422) + mat(k, 423) = mat(k, 423) + lmat(k, 423) + mat(k, 426) = lmat(k, 426) + mat(k, 427) = mat(k, 427) + lmat(k, 427) + mat(k, 429) = mat(k, 429) + lmat(k, 429) + mat(k, 431) = lmat(k, 431) + mat(k, 432) = lmat(k, 432) + mat(k, 433) = lmat(k, 433) + mat(k, 434) = mat(k, 434) + lmat(k, 434) + mat(k, 437) = mat(k, 437) + lmat(k, 437) + mat(k, 443) = mat(k, 443) + lmat(k, 443) + mat(k, 444) = lmat(k, 444) + mat(k, 445) = lmat(k, 445) + mat(k, 446) = mat(k, 446) + lmat(k, 446) + mat(k, 447) = mat(k, 447) + lmat(k, 447) + mat(k, 449) = mat(k, 449) + lmat(k, 449) + mat(k, 450) = lmat(k, 450) + mat(k, 451) = mat(k, 451) + lmat(k, 451) + mat(k, 453) = mat(k, 453) + lmat(k, 453) + mat(k, 456) = mat(k, 456) + lmat(k, 456) + mat(k, 462) = mat(k, 462) + lmat(k, 462) + mat(k, 463) = mat(k, 463) + lmat(k, 463) + mat(k, 468) = lmat(k, 468) + mat(k, 469) = lmat(k, 469) + mat(k, 470) = lmat(k, 470) + mat(k, 471) = mat(k, 471) + lmat(k, 471) + mat(k, 473) = lmat(k, 473) + mat(k, 474) = lmat(k, 474) + mat(k, 475) = mat(k, 475) + lmat(k, 475) + mat(k, 477) = mat(k, 477) + lmat(k, 477) + mat(k, 479) = mat(k, 479) + lmat(k, 479) + mat(k, 480) = mat(k, 480) + lmat(k, 480) + mat(k, 484) = mat(k, 484) + lmat(k, 484) + mat(k, 488) = mat(k, 488) + lmat(k, 488) + mat(k, 491) = mat(k, 491) + lmat(k, 491) + mat(k, 492) = mat(k, 492) + lmat(k, 492) + mat(k, 493) = lmat(k, 493) + mat(k, 494) = lmat(k, 494) + mat(k, 495) = mat(k, 495) + lmat(k, 495) + mat(k, 496) = mat(k, 496) + lmat(k, 496) + mat(k, 502) = mat(k, 502) + lmat(k, 502) + mat(k, 503) = lmat(k, 503) + mat(k, 507) = lmat(k, 507) + mat(k, 509) = lmat(k, 509) + mat(k, 510) = mat(k, 510) + lmat(k, 510) + mat(k, 514) = mat(k, 514) + lmat(k, 514) + mat(k, 521) = mat(k, 521) + lmat(k, 521) + mat(k, 524) = mat(k, 524) + lmat(k, 524) + mat(k, 525) = mat(k, 525) + lmat(k, 525) + mat(k, 526) = lmat(k, 526) + mat(k, 527) = lmat(k, 527) + mat(k, 528) = mat(k, 528) + lmat(k, 528) + mat(k, 529) = lmat(k, 529) + mat(k, 533) = lmat(k, 533) + mat(k, 536) = mat(k, 536) + lmat(k, 536) + mat(k, 543) = mat(k, 543) + lmat(k, 543) + mat(k, 544) = mat(k, 544) + lmat(k, 544) + mat(k, 546) = lmat(k, 546) + mat(k, 550) = mat(k, 550) + lmat(k, 550) + mat(k, 556) = mat(k, 556) + lmat(k, 556) + mat(k, 558) = lmat(k, 558) + mat(k, 559) = lmat(k, 559) + mat(k, 561) = mat(k, 561) + lmat(k, 561) + mat(k, 562) = lmat(k, 562) + mat(k, 563) = lmat(k, 563) + mat(k, 564) = lmat(k, 564) + mat(k, 566) = mat(k, 566) + lmat(k, 566) + mat(k, 567) = mat(k, 567) + lmat(k, 567) + mat(k, 568) = lmat(k, 568) + mat(k, 569) = mat(k, 569) + lmat(k, 569) + mat(k, 570) = lmat(k, 570) + mat(k, 571) = lmat(k, 571) + mat(k, 573) = lmat(k, 573) + mat(k, 574) = mat(k, 574) + lmat(k, 574) + mat(k, 575) = lmat(k, 575) + mat(k, 577) = mat(k, 577) + lmat(k, 577) + mat(k, 579) = lmat(k, 579) + mat(k, 581) = lmat(k, 581) + mat(k, 582) = lmat(k, 582) + mat(k, 583) = mat(k, 583) + lmat(k, 583) + mat(k, 585) = mat(k, 585) + lmat(k, 585) + mat(k, 593) = mat(k, 593) + lmat(k, 593) + mat(k, 596) = lmat(k, 596) + mat(k, 597) = lmat(k, 597) + mat(k, 598) = lmat(k, 598) + mat(k, 599) = mat(k, 599) + lmat(k, 599) + mat(k, 601) = mat(k, 601) + lmat(k, 601) + mat(k, 602) = mat(k, 602) + lmat(k, 602) + mat(k, 603) = lmat(k, 603) + mat(k, 604) = lmat(k, 604) + mat(k, 605) = mat(k, 605) + lmat(k, 605) + mat(k, 613) = mat(k, 613) + lmat(k, 613) + mat(k, 616) = lmat(k, 616) + mat(k, 617) = lmat(k, 617) + mat(k, 618) = mat(k, 618) + lmat(k, 618) + mat(k, 619) = mat(k, 619) + lmat(k, 619) + mat(k, 621) = mat(k, 621) + lmat(k, 621) + mat(k, 622) = mat(k, 622) + lmat(k, 622) + mat(k, 623) = mat(k, 623) + lmat(k, 623) + mat(k, 624) = mat(k, 624) + lmat(k, 624) + mat(k, 625) = mat(k, 625) + lmat(k, 625) + mat(k, 626) = mat(k, 626) + lmat(k, 626) + mat(k, 630) = lmat(k, 630) + mat(k, 631) = mat(k, 631) + lmat(k, 631) + mat(k, 632) = mat(k, 632) + lmat(k, 632) + mat(k, 634) = mat(k, 634) + lmat(k, 634) + mat(k, 635) = mat(k, 635) + lmat(k, 635) + mat(k, 636) = mat(k, 636) + lmat(k, 636) + mat(k, 637) = mat(k, 637) + lmat(k, 637) + mat(k, 638) = mat(k, 638) + lmat(k, 638) + mat(k, 639) = mat(k, 639) + lmat(k, 639) + mat(k, 640) = mat(k, 640) + lmat(k, 640) + mat(k, 641) = lmat(k, 641) + mat(k, 642) = mat(k, 642) + lmat(k, 642) + mat(k, 643) = lmat(k, 643) + mat(k, 644) = lmat(k, 644) + mat(k, 645) = lmat(k, 645) + mat(k, 646) = mat(k, 646) + lmat(k, 646) + mat(k, 647) = mat(k, 647) + lmat(k, 647) + mat(k, 650) = lmat(k, 650) + mat(k, 655) = mat(k, 655) + lmat(k, 655) + mat(k, 659) = lmat(k, 659) + mat(k, 662) = mat(k, 662) + lmat(k, 662) + mat(k, 664) = mat(k, 664) + lmat(k, 664) + mat(k, 667) = lmat(k, 667) + mat(k, 671) = mat(k, 671) + lmat(k, 671) + mat(k, 673) = mat(k, 673) + lmat(k, 673) + mat(k, 676) = lmat(k, 676) + mat(k, 677) = lmat(k, 677) + mat(k, 678) = lmat(k, 678) + mat(k, 679) = lmat(k, 679) + mat(k, 680) = mat(k, 680) + lmat(k, 680) + mat(k, 682) = mat(k, 682) + lmat(k, 682) + mat(k, 684) = lmat(k, 684) + mat(k, 685) = lmat(k, 685) + mat(k, 686) = lmat(k, 686) + mat(k, 687) = lmat(k, 687) + mat(k, 688) = mat(k, 688) + lmat(k, 688) + mat(k, 689) = mat(k, 689) + lmat(k, 689) + mat(k, 690) = mat(k, 690) + lmat(k, 690) + mat(k, 691) = lmat(k, 691) + mat(k, 692) = lmat(k, 692) + mat(k, 693) = mat(k, 693) + lmat(k, 693) + mat(k, 697) = lmat(k, 697) + mat(k, 698) = mat(k, 698) + lmat(k, 698) + mat(k, 702) = mat(k, 702) + lmat(k, 702) + mat(k, 703) = mat(k, 703) + lmat(k, 703) + mat(k, 706) = lmat(k, 706) + mat(k, 707) = mat(k, 707) + lmat(k, 707) + mat(k, 711) = mat(k, 711) + lmat(k, 711) + mat(k, 717) = lmat(k, 717) + mat(k, 718) = mat(k, 718) + lmat(k, 718) + mat(k, 722) = lmat(k, 722) + mat(k, 723) = lmat(k, 723) + mat(k, 725) = lmat(k, 725) + mat(k, 726) = lmat(k, 726) + mat(k, 727) = mat(k, 727) + lmat(k, 727) + mat(k, 728) = mat(k, 728) + lmat(k, 728) + mat(k, 731) = lmat(k, 731) + mat(k, 732) = lmat(k, 732) + mat(k, 734) = lmat(k, 734) + mat(k, 735) = mat(k, 735) + lmat(k, 735) + mat(k, 736) = lmat(k, 736) + mat(k, 738) = lmat(k, 738) + mat(k, 739) = lmat(k, 739) + mat(k, 740) = lmat(k, 740) + mat(k, 741) = mat(k, 741) + lmat(k, 741) + mat(k, 746) = lmat(k, 746) + mat(k, 747) = lmat(k, 747) + mat(k, 749) = lmat(k, 749) + mat(k, 750) = mat(k, 750) + lmat(k, 750) + mat(k, 751) = lmat(k, 751) + mat(k, 752) = mat(k, 752) + lmat(k, 752) + mat(k, 755) = mat(k, 755) + lmat(k, 755) + mat(k, 756) = mat(k, 756) + lmat(k, 756) + mat(k, 758) = mat(k, 758) + lmat(k, 758) + mat(k, 759) = lmat(k, 759) + mat(k, 760) = mat(k, 760) + lmat(k, 760) + mat(k, 763) = mat(k, 763) + lmat(k, 763) + mat(k, 770) = mat(k, 770) + lmat(k, 770) + mat(k, 771) = lmat(k, 771) + mat(k, 772) = lmat(k, 772) + mat(k, 773) = mat(k, 773) + lmat(k, 773) + mat(k, 774) = mat(k, 774) + lmat(k, 774) + mat(k, 776) = lmat(k, 776) + mat(k, 777) = lmat(k, 777) + mat(k, 778) = mat(k, 778) + lmat(k, 778) + mat(k, 779) = mat(k, 779) + lmat(k, 779) + mat(k, 780) = mat(k, 780) + lmat(k, 780) + mat(k, 782) = mat(k, 782) + lmat(k, 782) + mat(k, 783) = mat(k, 783) + lmat(k, 783) + mat(k, 785) = lmat(k, 785) + mat(k, 786) = lmat(k, 786) + mat(k, 787) = lmat(k, 787) + mat(k, 788) = lmat(k, 788) + mat(k, 789) = lmat(k, 789) + mat(k, 790) = mat(k, 790) + lmat(k, 790) + mat(k, 791) = mat(k, 791) + lmat(k, 791) + mat(k, 797) = mat(k, 797) + lmat(k, 797) + mat(k, 805) = mat(k, 805) + lmat(k, 805) + mat(k, 813) = mat(k, 813) + lmat(k, 813) + mat(k, 827) = mat(k, 827) + lmat(k, 827) + mat(k, 838) = lmat(k, 838) + mat(k, 839) = lmat(k, 839) + mat(k, 840) = lmat(k, 840) + mat(k, 841) = lmat(k, 841) + mat(k, 842) = mat(k, 842) + lmat(k, 842) + mat(k, 847) = lmat(k, 847) + mat(k, 848) = lmat(k, 848) + mat(k, 851) = lmat(k, 851) + mat(k, 852) = mat(k, 852) + lmat(k, 852) + mat(k, 855) = mat(k, 855) + lmat(k, 855) + mat(k, 862) = mat(k, 862) + lmat(k, 862) + mat(k, 873) = mat(k, 873) + lmat(k, 873) + mat(k, 883) = mat(k, 883) + lmat(k, 883) + mat(k, 885) = mat(k, 885) + lmat(k, 885) + mat(k, 886) = mat(k, 886) + lmat(k, 886) + mat(k, 887) = mat(k, 887) + lmat(k, 887) + mat(k, 888) = mat(k, 888) + lmat(k, 888) + mat(k, 895) = mat(k, 895) + lmat(k, 895) + mat(k, 906) = mat(k, 906) + lmat(k, 906) + mat(k, 914) = mat(k, 914) + lmat(k, 914) + mat(k, 919) = mat(k, 919) + lmat(k, 919) + mat(k, 924) = mat(k, 924) + lmat(k, 924) + mat(k, 926) = mat(k, 926) + lmat(k, 926) + mat(k, 927) = mat(k, 927) + lmat(k, 927) + mat(k, 928) = mat(k, 928) + lmat(k, 928) + mat(k, 929) = mat(k, 929) + lmat(k, 929) + mat(k, 939) = mat(k, 939) + lmat(k, 939) + mat(k, 951) = mat(k, 951) + lmat(k, 951) + mat(k, 960) = mat(k, 960) + lmat(k, 960) + mat(k, 969) = mat(k, 969) + lmat(k, 969) + mat(k, 970) = mat(k, 970) + lmat(k, 970) + mat(k, 971) = lmat(k, 971) + mat(k, 972) = lmat(k, 972) + mat(k, 974) = mat(k, 974) + lmat(k, 974) + mat(k, 975) = lmat(k, 975) + mat(k, 976) = lmat(k, 976) + mat(k, 977) = lmat(k, 977) + mat(k, 978) = lmat(k, 978) + mat(k, 979) = lmat(k, 979) + mat(k, 980) = lmat(k, 980) + mat(k, 981) = lmat(k, 981) + mat(k, 982) = lmat(k, 982) + mat(k, 983) = mat(k, 983) + lmat(k, 983) + mat(k, 984) = lmat(k, 984) + mat(k, 986) = mat(k, 986) + lmat(k, 986) + mat(k, 987) = lmat(k, 987) + mat(k, 988) = lmat(k, 988) + mat(k, 990) = lmat(k, 990) + mat(k, 991) = lmat(k, 991) + mat(k, 992) = mat(k, 992) + lmat(k, 992) + mat(k, 995) = mat(k, 995) + lmat(k, 995) + mat(k, 996) = lmat(k, 996) + mat(k,1001) = mat(k,1001) + lmat(k,1001) + mat(k,1006) = mat(k,1006) + lmat(k,1006) + mat(k,1015) = mat(k,1015) + lmat(k,1015) + mat(k,1024) = mat(k,1024) + lmat(k,1024) + mat(k,1041) = mat(k,1041) + lmat(k,1041) + mat(k,1054) = mat(k,1054) + lmat(k,1054) + mat(k,1057) = lmat(k,1057) + mat(k,1061) = mat(k,1061) + lmat(k,1061) + mat(k,1071) = mat(k,1071) + lmat(k,1071) + mat(k,1092) = mat(k,1092) + lmat(k,1092) + mat(k,1106) = mat(k,1106) + lmat(k,1106) + mat(k,1110) = mat(k,1110) + lmat(k,1110) + mat(k,1111) = lmat(k,1111) + mat(k,1112) = lmat(k,1112) + mat(k,1113) = lmat(k,1113) + mat(k,1116) = lmat(k,1116) + mat(k,1118) = lmat(k,1118) + mat(k,1119) = mat(k,1119) + lmat(k,1119) + mat(k,1121) = mat(k,1121) + lmat(k,1121) + mat(k,1122) = mat(k,1122) + lmat(k,1122) + mat(k,1129) = mat(k,1129) + lmat(k,1129) + mat(k,1132) = mat(k,1132) + lmat(k,1132) + mat(k,1134) = mat(k,1134) + lmat(k,1134) + mat(k,1140) = mat(k,1140) + lmat(k,1140) + mat(k,1143) = mat(k,1143) + lmat(k,1143) + mat(k,1145) = lmat(k,1145) + mat(k,1146) = lmat(k,1146) + mat(k,1147) = lmat(k,1147) + mat(k,1148) = lmat(k,1148) + mat(k,1150) = mat(k,1150) + lmat(k,1150) + mat(k,1151) = mat(k,1151) + lmat(k,1151) + mat(k,1152) = mat(k,1152) + lmat(k,1152) + mat(k,1159) = mat(k,1159) + lmat(k,1159) + mat(k,1163) = mat(k,1163) + lmat(k,1163) + mat(k,1164) = mat(k,1164) + lmat(k,1164) + mat(k,1166) = mat(k,1166) + lmat(k,1166) + mat(k,1172) = lmat(k,1172) + mat(k,1175) = mat(k,1175) + lmat(k,1175) + mat(k,1182) = mat(k,1182) + lmat(k,1182) + mat(k,1194) = mat(k,1194) + lmat(k,1194) + mat(k,1200) = lmat(k,1200) + mat(k,1201) = lmat(k,1201) + mat(k,1206) = lmat(k,1206) + mat(k,1208) = lmat(k,1208) + mat(k,1209) = mat(k,1209) + lmat(k,1209) + mat(k,1210) = mat(k,1210) + lmat(k,1210) + mat(k,1212) = mat(k,1212) + lmat(k,1212) + mat(k,1214) = mat(k,1214) + lmat(k,1214) + mat(k,1218) = mat(k,1218) + lmat(k,1218) + mat(k,1228) = mat(k,1228) + lmat(k,1228) + mat(k,1229) = mat(k,1229) + lmat(k,1229) + mat(k,1230) = lmat(k,1230) + mat(k,1231) = lmat(k,1231) + mat(k,1232) = mat(k,1232) + lmat(k,1232) + mat(k,1235) = mat(k,1235) + lmat(k,1235) + mat(k,1236) = lmat(k,1236) + mat(k,1237) = lmat(k,1237) + mat(k,1242) = mat(k,1242) + lmat(k,1242) + mat(k,1251) = lmat(k,1251) + mat(k,1252) = mat(k,1252) + lmat(k,1252) + mat(k,1260) = lmat(k,1260) + mat(k,1262) = mat(k,1262) + lmat(k,1262) + mat(k,1263) = mat(k,1263) + lmat(k,1263) + mat(k,1272) = mat(k,1272) + lmat(k,1272) + mat(k,1289) = mat(k,1289) + lmat(k,1289) + mat(k,1290) = lmat(k,1290) + mat(k,1291) = lmat(k,1291) + mat(k,1294) = lmat(k,1294) + mat(k,1298) = mat(k,1298) + lmat(k,1298) + mat(k,1309) = mat(k,1309) + lmat(k,1309) + mat(k,1311) = mat(k,1311) + lmat(k,1311) + mat(k,1322) = mat(k,1322) + lmat(k,1322) + mat(k,1324) = mat(k,1324) + lmat(k,1324) + mat(k,1325) = mat(k,1325) + lmat(k,1325) + mat(k,1326) = mat(k,1326) + lmat(k,1326) + mat(k,1329) = mat(k,1329) + lmat(k,1329) + mat(k,1330) = mat(k,1330) + lmat(k,1330) + mat(k,1331) = lmat(k,1331) + mat(k,1332) = mat(k,1332) + lmat(k,1332) + mat(k,1336) = mat(k,1336) + lmat(k,1336) + mat(k,1350) = mat(k,1350) + lmat(k,1350) + mat(k,1361) = mat(k,1361) + lmat(k,1361) + mat(k,1363) = mat(k,1363) + lmat(k,1363) + mat(k,1376) = mat(k,1376) + lmat(k,1376) + mat(k,1377) = mat(k,1377) + lmat(k,1377) + mat(k,1385) = mat(k,1385) + lmat(k,1385) + mat(k,1410) = mat(k,1410) + lmat(k,1410) + mat(k,1431) = mat(k,1431) + lmat(k,1431) + mat(k,1432) = lmat(k,1432) + mat(k,1435) = lmat(k,1435) + mat(k,1436) = lmat(k,1436) + mat(k,1440) = mat(k,1440) + lmat(k,1440) + mat(k,1454) = mat(k,1454) + lmat(k,1454) + mat(k,1456) = lmat(k,1456) + mat(k,1457) = mat(k,1457) + lmat(k,1457) + mat(k,1458) = lmat(k,1458) + mat(k,1459) = mat(k,1459) + lmat(k,1459) + mat(k,1461) = mat(k,1461) + lmat(k,1461) + mat(k,1462) = mat(k,1462) + lmat(k,1462) + mat(k,1463) = lmat(k,1463) + mat(k,1464) = mat(k,1464) + lmat(k,1464) + mat(k,1465) = lmat(k,1465) + mat(k,1466) = lmat(k,1466) + mat(k,1467) = lmat(k,1467) + mat(k,1468) = mat(k,1468) + lmat(k,1468) + mat(k,1469) = lmat(k,1469) + mat(k,1470) = lmat(k,1470) + mat(k,1473) = lmat(k,1473) + mat(k,1474) = mat(k,1474) + lmat(k,1474) + mat(k,1475) = lmat(k,1475) + mat(k,1476) = mat(k,1476) + lmat(k,1476) + mat(k,1478) = mat(k,1478) + lmat(k,1478) + mat(k,1479) = mat(k,1479) + lmat(k,1479) + mat(k,1481) = mat(k,1481) + lmat(k,1481) + mat(k,1483) = lmat(k,1483) + mat(k,1484) = lmat(k,1484) + mat(k,1485) = mat(k,1485) + lmat(k,1485) + mat(k,1487) = mat(k,1487) + lmat(k,1487) + mat(k,1492) = mat(k,1492) + lmat(k,1492) + mat(k,1494) = mat(k,1494) + lmat(k,1494) + mat(k,1498) = mat(k,1498) + lmat(k,1498) + mat(k,1499) = lmat(k,1499) + mat(k,1500) = mat(k,1500) + lmat(k,1500) + mat(k,1502) = mat(k,1502) + lmat(k,1502) + mat(k,1503) = lmat(k,1503) + mat(k,1504) = mat(k,1504) + lmat(k,1504) + mat(k,1505) = mat(k,1505) + lmat(k,1505) + mat(k,1508) = mat(k,1508) + lmat(k,1508) + mat(k,1524) = mat(k,1524) + lmat(k,1524) + mat(k,1536) = mat(k,1536) + lmat(k,1536) + mat(k,1537) = mat(k,1537) + lmat(k,1537) + mat(k,1538) = lmat(k,1538) + mat(k,1539) = lmat(k,1539) + mat(k,1540) = mat(k,1540) + lmat(k,1540) + mat(k,1543) = mat(k,1543) + lmat(k,1543) + mat(k,1545) = mat(k,1545) + lmat(k,1545) + mat(k,1548) = mat(k,1548) + lmat(k,1548) + mat(k,1556) = mat(k,1556) + lmat(k,1556) + mat(k,1557) = mat(k,1557) + lmat(k,1557) + mat(k,1558) = mat(k,1558) + lmat(k,1558) + mat(k,1559) = lmat(k,1559) + mat(k,1560) = mat(k,1560) + lmat(k,1560) + mat(k,1572) = mat(k,1572) + lmat(k,1572) + mat(k,1583) = mat(k,1583) + lmat(k,1583) + mat(k,1586) = lmat(k,1586) + mat(k,1591) = lmat(k,1591) + mat(k,1595) = mat(k,1595) + lmat(k,1595) + mat(k,1598) = lmat(k,1598) + mat(k,1599) = mat(k,1599) + lmat(k,1599) + mat(k,1600) = mat(k,1600) + lmat(k,1600) + mat(k,1604) = lmat(k,1604) + mat(k,1613) = lmat(k,1613) + mat(k,1614) = lmat(k,1614) + mat(k,1615) = lmat(k,1615) + mat(k,1620) = mat(k,1620) + lmat(k,1620) + mat(k,1640) = mat(k,1640) + lmat(k,1640) + mat(k,1643) = mat(k,1643) + lmat(k,1643) + mat(k,1645) = mat(k,1645) + lmat(k,1645) + mat(k,1647) = mat(k,1647) + lmat(k,1647) + mat(k,1655) = mat(k,1655) + lmat(k,1655) + mat(k,1659) = mat(k,1659) + lmat(k,1659) + mat(k,1660) = lmat(k,1660) + mat(k,1661) = lmat(k,1661) + mat(k,1666) = lmat(k,1666) + mat(k,1669) = lmat(k,1669) + mat(k,1673) = mat(k,1673) + lmat(k,1673) + mat(k,1689) = mat(k,1689) + lmat(k,1689) + mat(k,1691) = lmat(k,1691) + mat(k,1694) = lmat(k,1694) + mat(k,1695) = lmat(k,1695) + mat(k,1702) = mat(k,1702) + lmat(k,1702) + mat(k,1704) = lmat(k,1704) + mat(k,1705) = lmat(k,1705) + mat(k,1707) = lmat(k,1707) + mat(k,1708) = lmat(k,1708) + mat(k,1712) = mat(k,1712) + lmat(k,1712) + mat(k,1713) = lmat(k,1713) + mat(k,1715) = mat(k,1715) + lmat(k,1715) + mat(k,1716) = mat(k,1716) + lmat(k,1716) + mat(k,1718) = mat(k,1718) + lmat(k,1718) + mat(k,1719) = lmat(k,1719) + mat(k,1720) = mat(k,1720) + lmat(k,1720) + mat(k,1723) = lmat(k,1723) + mat(k,1726) = lmat(k,1726) + mat(k,1732) = mat(k,1732) + lmat(k,1732) + mat(k,1748) = lmat(k,1748) + mat(k,1754) = mat(k,1754) + lmat(k,1754) + mat(k,1770) = mat(k,1770) + lmat(k,1770) + mat(k,1772) = lmat(k,1772) + mat(k,1773) = lmat(k,1773) + mat(k,1774) = mat(k,1774) + lmat(k,1774) + mat(k,1776) = mat(k,1776) + lmat(k,1776) + mat(k,1777) = mat(k,1777) + lmat(k,1777) + mat(k,1778) = mat(k,1778) + lmat(k,1778) + mat(k,1779) = lmat(k,1779) + mat(k,1780) = mat(k,1780) + lmat(k,1780) + mat(k,1782) = lmat(k,1782) + mat(k,1783) = mat(k,1783) + lmat(k,1783) + mat(k,1784) = mat(k,1784) + lmat(k,1784) + mat(k,1787) = lmat(k,1787) + mat(k,1790) = lmat(k,1790) + mat(k,1791) = lmat(k,1791) + mat(k,1793) = mat(k,1793) + lmat(k,1793) + mat(k,1795) = lmat(k,1795) + mat(k,1801) = mat(k,1801) + lmat(k,1801) + mat(k,1802) = mat(k,1802) + lmat(k,1802) + mat(k,1803) = lmat(k,1803) + mat(k,1804) = lmat(k,1804) + mat(k,1805) = lmat(k,1805) + mat(k,1806) = lmat(k,1806) + mat(k,1817) = mat(k,1817) + lmat(k,1817) + mat(k,1823) = mat(k,1823) + lmat(k,1823) + mat(k,1830) = mat(k,1830) + lmat(k,1830) + mat(k,1833) = mat(k,1833) + lmat(k,1833) + mat(k,1834) = lmat(k,1834) + mat(k,1835) = lmat(k,1835) + mat(k,1836) = lmat(k,1836) + mat(k,1837) = lmat(k,1837) + mat(k,1848) = mat(k,1848) + lmat(k,1848) + mat(k,1855) = mat(k,1855) + lmat(k,1855) + mat(k,1861) = mat(k,1861) + lmat(k,1861) + mat(k,1864) = mat(k,1864) + lmat(k,1864) + mat(k,1868) = mat(k,1868) + lmat(k,1868) + mat(k,1869) = lmat(k,1869) + mat(k,1870) = mat(k,1870) + lmat(k,1870) + mat(k,1872) = mat(k,1872) + lmat(k,1872) + mat(k,1874) = mat(k,1874) + lmat(k,1874) + mat(k,1875) = mat(k,1875) + lmat(k,1875) + mat(k,1876) = lmat(k,1876) + mat(k,1880) = mat(k,1880) + lmat(k,1880) + mat(k,1882) = mat(k,1882) + lmat(k,1882) + mat(k,1896) = mat(k,1896) + lmat(k,1896) + mat(k,1901) = lmat(k,1901) + mat(k,1902) = lmat(k,1902) + mat(k,1907) = lmat(k,1907) + mat(k,1908) = mat(k,1908) + lmat(k,1908) + mat(k,1910) = mat(k,1910) + lmat(k,1910) + mat(k,1912) = lmat(k,1912) + mat(k,1915) = lmat(k,1915) + mat(k,1916) = mat(k,1916) + lmat(k,1916) + mat(k,1917) = lmat(k,1917) + mat(k,1919) = lmat(k,1919) + mat(k,1922) = lmat(k,1922) + mat(k,1923) = mat(k,1923) + lmat(k,1923) + mat(k,1924) = lmat(k,1924) + mat(k,1926) = mat(k,1926) + lmat(k,1926) + mat(k,1927) = mat(k,1927) + lmat(k,1927) + mat(k,1928) = mat(k,1928) + lmat(k,1928) + mat(k,1930) = lmat(k,1930) + mat(k,1934) = lmat(k,1934) + mat(k,1935) = lmat(k,1935) + mat(k,1953) = mat(k,1953) + lmat(k,1953) + mat(k,1956) = mat(k,1956) + lmat(k,1956) + mat(k,1963) = mat(k,1963) + lmat(k,1963) + mat(k,1968) = mat(k,1968) + lmat(k,1968) + mat(k,1970) = lmat(k,1970) + mat(k,1971) = lmat(k,1971) + mat(k,1991) = mat(k,1991) + lmat(k,1991) + mat(k,1992) = mat(k,1992) + lmat(k,1992) + mat(k,2002) = mat(k,2002) + lmat(k,2002) + mat(k,2007) = mat(k,2007) + lmat(k,2007) + mat(k,2012) = mat(k,2012) + lmat(k,2012) + mat(k,2016) = mat(k,2016) + lmat(k,2016) + mat(k,2017) = mat(k,2017) + lmat(k,2017) + mat(k,2019) = mat(k,2019) + lmat(k,2019) + mat(k,2023) = mat(k,2023) + lmat(k,2023) + mat(k,2024) = mat(k,2024) + lmat(k,2024) + mat(k,2025) = lmat(k,2025) + mat(k,2032) = lmat(k,2032) + mat(k,2041) = mat(k,2041) + lmat(k,2041) + mat(k,2042) = mat(k,2042) + lmat(k,2042) + mat(k,2044) = mat(k,2044) + lmat(k,2044) + mat(k,2050) = lmat(k,2050) + mat(k,2057) = mat(k,2057) + lmat(k,2057) + mat(k,2062) = lmat(k,2062) + mat(k,2074) = lmat(k,2074) + mat(k,2077) = mat(k,2077) + lmat(k,2077) + mat(k,2078) = mat(k,2078) + lmat(k,2078) + mat(k,2081) = lmat(k,2081) + mat(k,2086) = mat(k,2086) + lmat(k,2086) + mat(k,2088) = mat(k,2088) + lmat(k,2088) + mat(k,2091) = mat(k,2091) + lmat(k,2091) + mat(k,2098) = lmat(k,2098) + mat(k,2106) = lmat(k,2106) + mat(k,2109) = mat(k,2109) + lmat(k,2109) + mat(k,2110) = mat(k,2110) + lmat(k,2110) + mat(k,2113) = lmat(k,2113) + mat(k,2118) = mat(k,2118) + lmat(k,2118) + mat(k,2120) = mat(k,2120) + lmat(k,2120) + mat(k,2123) = mat(k,2123) + lmat(k,2123) + mat(k,2136) = lmat(k,2136) + mat(k,2140) = mat(k,2140) + lmat(k,2140) + mat(k,2142) = lmat(k,2142) + mat(k,2147) = mat(k,2147) + lmat(k,2147) + mat(k,2149) = mat(k,2149) + lmat(k,2149) + mat(k,2180) = mat(k,2180) + lmat(k,2180) + mat(k,2199) = mat(k,2199) + lmat(k,2199) + mat(k,2213) = mat(k,2213) + lmat(k,2213) + mat(k,2235) = mat(k,2235) + lmat(k,2235) + mat(k,2256) = lmat(k,2256) + mat(k,2257) = mat(k,2257) + lmat(k,2257) + mat(k,2258) = lmat(k,2258) + mat(k,2259) = mat(k,2259) + lmat(k,2259) + mat(k,2260) = mat(k,2260) + lmat(k,2260) + mat(k,2263) = lmat(k,2263) + mat(k,2264) = mat(k,2264) + lmat(k,2264) + mat(k,2266) = mat(k,2266) + lmat(k,2266) + mat(k,2270) = mat(k,2270) + lmat(k,2270) + mat(k,2271) = mat(k,2271) + lmat(k,2271) + mat(k,2277) = mat(k,2277) + lmat(k,2277) + mat(k,2278) = lmat(k,2278) + mat(k,2284) = lmat(k,2284) + mat(k,2296) = mat(k,2296) + lmat(k,2296) + mat(k,2320) = mat(k,2320) + lmat(k,2320) + mat(k,2322) = lmat(k,2322) + mat(k,2329) = lmat(k,2329) + mat(k,2332) = mat(k,2332) + lmat(k,2332) + mat(k,2339) = mat(k,2339) + lmat(k,2339) + mat(k,2358) = lmat(k,2358) + mat(k,2359) = mat(k,2359) + lmat(k,2359) + mat(k,2360) = lmat(k,2360) + mat(k,2365) = lmat(k,2365) + mat(k,2380) = mat(k,2380) + lmat(k,2380) + mat(k,2408) = mat(k,2408) + lmat(k,2408) + mat(k,2441) = mat(k,2441) + lmat(k,2441) + mat(k,2471) = mat(k,2471) + lmat(k,2471) + mat(k,2505) = mat(k,2505) + lmat(k,2505) + mat(k,2536) = mat(k,2536) + lmat(k,2536) + mat(k,2570) = mat(k,2570) + lmat(k,2570) + mat(k,2600) = mat(k,2600) + lmat(k,2600) + mat(k,2629) = mat(k,2629) + lmat(k,2629) + mat(k,2654) = mat(k,2654) + lmat(k,2654) + mat(k,2677) = mat(k,2677) + lmat(k,2677) + mat(k,2701) = mat(k,2701) + lmat(k,2701) + mat(k,2745) = mat(k,2745) + lmat(k,2745) + mat(k,2792) = mat(k,2792) + lmat(k,2792) + mat(k,2840) = mat(k,2840) + lmat(k,2840) + mat(k,2913) = mat(k,2913) + lmat(k,2913) + mat(k,2931) = mat(k,2931) + lmat(k,2931) + mat(k,2936) = mat(k,2936) + lmat(k,2936) + mat(k,2949) = mat(k,2949) + lmat(k,2949) + mat(k,2956) = lmat(k,2956) + mat(k,2960) = mat(k,2960) + lmat(k,2960) + mat(k,2986) = mat(k,2986) + lmat(k,2986) + mat(k,3106) = mat(k,3106) + lmat(k,3106) + mat(k,3108) = mat(k,3108) + lmat(k,3108) + mat(k,3127) = mat(k,3127) + lmat(k,3127) + mat(k,3129) = mat(k,3129) + lmat(k,3129) + mat(k,3140) = mat(k,3140) + lmat(k,3140) + mat(k,3161) = mat(k,3161) + lmat(k,3161) + mat(k,3169) = mat(k,3169) + lmat(k,3169) + mat(k,3179) = lmat(k,3179) + mat(k,3180) = mat(k,3180) + lmat(k,3180) + mat(k,3183) = mat(k,3183) + lmat(k,3183) + mat(k,3188) = mat(k,3188) + lmat(k,3188) + mat(k,3369) = mat(k,3369) + lmat(k,3369) + mat(k,3379) = mat(k,3379) + lmat(k,3379) + mat(k,3463) = mat(k,3463) + lmat(k,3463) + mat(k,3479) = mat(k,3479) + lmat(k,3479) + mat(k,3484) = mat(k,3484) + lmat(k,3484) + mat(k,3488) = mat(k,3488) + lmat(k,3488) + mat(k,3510) = mat(k,3510) + lmat(k,3510) + mat(k,3515) = mat(k,3515) + lmat(k,3515) + mat(k,3520) = mat(k,3520) + lmat(k,3520) + mat(k,3601) = mat(k,3601) + lmat(k,3601) + mat(k,3602) = mat(k,3602) + lmat(k,3602) + mat(k,3604) = mat(k,3604) + lmat(k,3604) + mat(k,3610) = mat(k,3610) + lmat(k,3610) + mat(k,3611) = mat(k,3611) + lmat(k,3611) + mat(k,3653) = mat(k,3653) + lmat(k,3653) + mat(k,3654) = mat(k,3654) + lmat(k,3654) + mat(k,3656) = mat(k,3656) + lmat(k,3656) + mat(k,3663) = mat(k,3663) + lmat(k,3663) + mat(k,3667) = mat(k,3667) + lmat(k,3667) + mat(k,3758) = mat(k,3758) + lmat(k,3758) + mat(k,3766) = mat(k,3766) + lmat(k,3766) + mat(k,3767) = mat(k,3767) + lmat(k,3767) + mat(k,3799) = lmat(k,3799) + mat(k,3808) = mat(k,3808) + lmat(k,3808) + mat(k,3850) = mat(k,3850) + lmat(k,3850) + mat(k,4101) = mat(k,4101) + lmat(k,4101) + mat(k,4109) = lmat(k,4109) + mat(k,4112) = lmat(k,4112) + mat(k,4116) = lmat(k,4116) + mat(k,4125) = mat(k,4125) + lmat(k,4125) + mat(k,4127) = mat(k,4127) + lmat(k,4127) + mat(k,4128) = mat(k,4128) + lmat(k,4128) + mat(k, 233) = 0._r8 + mat(k, 234) = 0._r8 + mat(k, 262) = 0._r8 + mat(k, 327) = 0._r8 + mat(k, 355) = 0._r8 + mat(k, 438) = 0._r8 + mat(k, 442) = 0._r8 + mat(k, 461) = 0._r8 + mat(k, 482) = 0._r8 + mat(k, 515) = 0._r8 + mat(k, 520) = 0._r8 + mat(k, 542) = 0._r8 + mat(k, 715) = 0._r8 + mat(k, 716) = 0._r8 + mat(k, 719) = 0._r8 + mat(k, 721) = 0._r8 + mat(k, 724) = 0._r8 + mat(k, 742) = 0._r8 + mat(k, 744) = 0._r8 + mat(k, 745) = 0._r8 + mat(k, 748) = 0._r8 + mat(k, 753) = 0._r8 + mat(k, 754) = 0._r8 + mat(k, 757) = 0._r8 + mat(k, 843) = 0._r8 + mat(k, 845) = 0._r8 + mat(k, 846) = 0._r8 + mat(k, 849) = 0._r8 + mat(k, 850) = 0._r8 + mat(k, 856) = 0._r8 + mat(k, 861) = 0._r8 + mat(k, 872) = 0._r8 + mat(k, 874) = 0._r8 + mat(k, 875) = 0._r8 + mat(k, 878) = 0._r8 + mat(k, 882) = 0._r8 + mat(k, 894) = 0._r8 + mat(k, 896) = 0._r8 + mat(k, 897) = 0._r8 + mat(k, 900) = 0._r8 + mat(k, 901) = 0._r8 + mat(k, 905) = 0._r8 + mat(k, 941) = 0._r8 + mat(k, 946) = 0._r8 + mat(k, 947) = 0._r8 + mat(k, 950) = 0._r8 + mat(k, 953) = 0._r8 + mat(k, 954) = 0._r8 + mat(k,1000) = 0._r8 + mat(k,1004) = 0._r8 + mat(k,1007) = 0._r8 + mat(k,1009) = 0._r8 + mat(k,1018) = 0._r8 + mat(k,1032) = 0._r8 + mat(k,1033) = 0._r8 + mat(k,1043) = 0._r8 + mat(k,1047) = 0._r8 + mat(k,1048) = 0._r8 + mat(k,1073) = 0._r8 + mat(k,1077) = 0._r8 + mat(k,1079) = 0._r8 + mat(k,1094) = 0._r8 + mat(k,1181) = 0._r8 + mat(k,1183) = 0._r8 + mat(k,1186) = 0._r8 + mat(k,1191) = 0._r8 + mat(k,1193) = 0._r8 + mat(k,1196) = 0._r8 + mat(k,1197) = 0._r8 + mat(k,1198) = 0._r8 + mat(k,1199) = 0._r8 + mat(k,1202) = 0._r8 + mat(k,1205) = 0._r8 + mat(k,1207) = 0._r8 + mat(k,1220) = 0._r8 + mat(k,1221) = 0._r8 + mat(k,1222) = 0._r8 + mat(k,1227) = 0._r8 + mat(k,1240) = 0._r8 + mat(k,1258) = 0._r8 + mat(k,1275) = 0._r8 + mat(k,1280) = 0._r8 + mat(k,1283) = 0._r8 + mat(k,1334) = 0._r8 + mat(k,1347) = 0._r8 + mat(k,1358) = 0._r8 + mat(k,1364) = 0._r8 + mat(k,1369) = 0._r8 + mat(k,1370) = 0._r8 + mat(k,1371) = 0._r8 + mat(k,1389) = 0._r8 + mat(k,1392) = 0._r8 + mat(k,1397) = 0._r8 + mat(k,1400) = 0._r8 + mat(k,1413) = 0._r8 + mat(k,1414) = 0._r8 + mat(k,1415) = 0._r8 + mat(k,1416) = 0._r8 + mat(k,1417) = 0._r8 + mat(k,1418) = 0._r8 + mat(k,1430) = 0._r8 + mat(k,1523) = 0._r8 + mat(k,1525) = 0._r8 + mat(k,1526) = 0._r8 + mat(k,1527) = 0._r8 + mat(k,1528) = 0._r8 + mat(k,1529) = 0._r8 + mat(k,1530) = 0._r8 + mat(k,1531) = 0._r8 + mat(k,1532) = 0._r8 + mat(k,1534) = 0._r8 + mat(k,1567) = 0._r8 + mat(k,1573) = 0._r8 + mat(k,1574) = 0._r8 + mat(k,1575) = 0._r8 + mat(k,1576) = 0._r8 + mat(k,1577) = 0._r8 + mat(k,1578) = 0._r8 + mat(k,1579) = 0._r8 + mat(k,1580) = 0._r8 + mat(k,1582) = 0._r8 + mat(k,1585) = 0._r8 + mat(k,1587) = 0._r8 + mat(k,1588) = 0._r8 + mat(k,1589) = 0._r8 + mat(k,1590) = 0._r8 + mat(k,1594) = 0._r8 + mat(k,1596) = 0._r8 + mat(k,1605) = 0._r8 + mat(k,1612) = 0._r8 + mat(k,1621) = 0._r8 + mat(k,1625) = 0._r8 + mat(k,1633) = 0._r8 + mat(k,1639) = 0._r8 + mat(k,1641) = 0._r8 + mat(k,1642) = 0._r8 + mat(k,1644) = 0._r8 + mat(k,1648) = 0._r8 + mat(k,1649) = 0._r8 + mat(k,1651) = 0._r8 + mat(k,1652) = 0._r8 + mat(k,1657) = 0._r8 + mat(k,1658) = 0._r8 + mat(k,1662) = 0._r8 + mat(k,1663) = 0._r8 + mat(k,1664) = 0._r8 + mat(k,1665) = 0._r8 + mat(k,1667) = 0._r8 + mat(k,1674) = 0._r8 + mat(k,1676) = 0._r8 + mat(k,1679) = 0._r8 + mat(k,1680) = 0._r8 + mat(k,1686) = 0._r8 + mat(k,1687) = 0._r8 + mat(k,1688) = 0._r8 + mat(k,1690) = 0._r8 + mat(k,1692) = 0._r8 + mat(k,1693) = 0._r8 + mat(k,1698) = 0._r8 + mat(k,1699) = 0._r8 + mat(k,1700) = 0._r8 + mat(k,1701) = 0._r8 + mat(k,1703) = 0._r8 + mat(k,1706) = 0._r8 + mat(k,1714) = 0._r8 + mat(k,1731) = 0._r8 + mat(k,1733) = 0._r8 + mat(k,1736) = 0._r8 + mat(k,1737) = 0._r8 + mat(k,1742) = 0._r8 + mat(k,1753) = 0._r8 + mat(k,1755) = 0._r8 + mat(k,1758) = 0._r8 + mat(k,1759) = 0._r8 + mat(k,1764) = 0._r8 + mat(k,1781) = 0._r8 + mat(k,1789) = 0._r8 + mat(k,1797) = 0._r8 + mat(k,1798) = 0._r8 + mat(k,1799) = 0._r8 + mat(k,1800) = 0._r8 + mat(k,1807) = 0._r8 + mat(k,1809) = 0._r8 + mat(k,1812) = 0._r8 + mat(k,1814) = 0._r8 + mat(k,1815) = 0._r8 + mat(k,1816) = 0._r8 + mat(k,1820) = 0._r8 + mat(k,1821) = 0._r8 + mat(k,1822) = 0._r8 + mat(k,1825) = 0._r8 + mat(k,1828) = 0._r8 + mat(k,1838) = 0._r8 + mat(k,1840) = 0._r8 + mat(k,1841) = 0._r8 + mat(k,1844) = 0._r8 + mat(k,1846) = 0._r8 + mat(k,1847) = 0._r8 + mat(k,1851) = 0._r8 + mat(k,1852) = 0._r8 + mat(k,1853) = 0._r8 + mat(k,1854) = 0._r8 + mat(k,1859) = 0._r8 + mat(k,1865) = 0._r8 + mat(k,1867) = 0._r8 + mat(k,1871) = 0._r8 + mat(k,1873) = 0._r8 + mat(k,1877) = 0._r8 + mat(k,1878) = 0._r8 + mat(k,1879) = 0._r8 + mat(k,1881) = 0._r8 + mat(k,1886) = 0._r8 + mat(k,1887) = 0._r8 + mat(k,1888) = 0._r8 + mat(k,1889) = 0._r8 + mat(k,1891) = 0._r8 + mat(k,1894) = 0._r8 + mat(k,1897) = 0._r8 + mat(k,1898) = 0._r8 + mat(k,1903) = 0._r8 + mat(k,1904) = 0._r8 + mat(k,1905) = 0._r8 + mat(k,1906) = 0._r8 + mat(k,1909) = 0._r8 + mat(k,1914) = 0._r8 + mat(k,1920) = 0._r8 + mat(k,1921) = 0._r8 + mat(k,1938) = 0._r8 + mat(k,1939) = 0._r8 + mat(k,1940) = 0._r8 + mat(k,1942) = 0._r8 + mat(k,1943) = 0._r8 + mat(k,1944) = 0._r8 + mat(k,1945) = 0._r8 + mat(k,1946) = 0._r8 + mat(k,1947) = 0._r8 + mat(k,1948) = 0._r8 + mat(k,1949) = 0._r8 + mat(k,1951) = 0._r8 + mat(k,1952) = 0._r8 + mat(k,1954) = 0._r8 + mat(k,1955) = 0._r8 + mat(k,1957) = 0._r8 + mat(k,1958) = 0._r8 + mat(k,1960) = 0._r8 + mat(k,1962) = 0._r8 + mat(k,1966) = 0._r8 + mat(k,1969) = 0._r8 + mat(k,1974) = 0._r8 + mat(k,1975) = 0._r8 + mat(k,1977) = 0._r8 + mat(k,1979) = 0._r8 + mat(k,1980) = 0._r8 + mat(k,1981) = 0._r8 + mat(k,1982) = 0._r8 + mat(k,1983) = 0._r8 + mat(k,1984) = 0._r8 + mat(k,1985) = 0._r8 + mat(k,1988) = 0._r8 + mat(k,1989) = 0._r8 + mat(k,1990) = 0._r8 + mat(k,1993) = 0._r8 + mat(k,1994) = 0._r8 + mat(k,1995) = 0._r8 + mat(k,1996) = 0._r8 + mat(k,1997) = 0._r8 + mat(k,1999) = 0._r8 + mat(k,2001) = 0._r8 + mat(k,2005) = 0._r8 + mat(k,2008) = 0._r8 + mat(k,2011) = 0._r8 + mat(k,2013) = 0._r8 + mat(k,2014) = 0._r8 + mat(k,2018) = 0._r8 + mat(k,2020) = 0._r8 + mat(k,2021) = 0._r8 + mat(k,2022) = 0._r8 + mat(k,2026) = 0._r8 + mat(k,2027) = 0._r8 + mat(k,2034) = 0._r8 + mat(k,2037) = 0._r8 + mat(k,2038) = 0._r8 + mat(k,2039) = 0._r8 + mat(k,2043) = 0._r8 + mat(k,2045) = 0._r8 + mat(k,2046) = 0._r8 + mat(k,2047) = 0._r8 + mat(k,2051) = 0._r8 + mat(k,2052) = 0._r8 + mat(k,2055) = 0._r8 + mat(k,2058) = 0._r8 + mat(k,2063) = 0._r8 + mat(k,2068) = 0._r8 + mat(k,2069) = 0._r8 + mat(k,2071) = 0._r8 + mat(k,2073) = 0._r8 + mat(k,2075) = 0._r8 + mat(k,2080) = 0._r8 + mat(k,2082) = 0._r8 + mat(k,2083) = 0._r8 + mat(k,2084) = 0._r8 + mat(k,2085) = 0._r8 + mat(k,2087) = 0._r8 + mat(k,2090) = 0._r8 + mat(k,2092) = 0._r8 + mat(k,2095) = 0._r8 + mat(k,2100) = 0._r8 + mat(k,2101) = 0._r8 + mat(k,2102) = 0._r8 + mat(k,2104) = 0._r8 + mat(k,2105) = 0._r8 + mat(k,2112) = 0._r8 + mat(k,2114) = 0._r8 + mat(k,2115) = 0._r8 + mat(k,2116) = 0._r8 + mat(k,2117) = 0._r8 + mat(k,2119) = 0._r8 + mat(k,2122) = 0._r8 + mat(k,2124) = 0._r8 + mat(k,2132) = 0._r8 + mat(k,2133) = 0._r8 + mat(k,2135) = 0._r8 + mat(k,2143) = 0._r8 + mat(k,2144) = 0._r8 + mat(k,2145) = 0._r8 + mat(k,2146) = 0._r8 + mat(k,2148) = 0._r8 + mat(k,2151) = 0._r8 + mat(k,2153) = 0._r8 + mat(k,2156) = 0._r8 + mat(k,2157) = 0._r8 + mat(k,2158) = 0._r8 + mat(k,2159) = 0._r8 + mat(k,2160) = 0._r8 + mat(k,2161) = 0._r8 + mat(k,2162) = 0._r8 + mat(k,2166) = 0._r8 + mat(k,2168) = 0._r8 + mat(k,2169) = 0._r8 + mat(k,2170) = 0._r8 + mat(k,2171) = 0._r8 + mat(k,2172) = 0._r8 + mat(k,2173) = 0._r8 + mat(k,2176) = 0._r8 + mat(k,2181) = 0._r8 + mat(k,2182) = 0._r8 + mat(k,2184) = 0._r8 + mat(k,2186) = 0._r8 + mat(k,2187) = 0._r8 + mat(k,2193) = 0._r8 + mat(k,2194) = 0._r8 + mat(k,2196) = 0._r8 + mat(k,2200) = 0._r8 + mat(k,2201) = 0._r8 + mat(k,2206) = 0._r8 + mat(k,2207) = 0._r8 + mat(k,2208) = 0._r8 + mat(k,2212) = 0._r8 + mat(k,2223) = 0._r8 + mat(k,2233) = 0._r8 + mat(k,2234) = 0._r8 + mat(k,2237) = 0._r8 + mat(k,2245) = 0._r8 + mat(k,2247) = 0._r8 + mat(k,2261) = 0._r8 + mat(k,2267) = 0._r8 + mat(k,2273) = 0._r8 + mat(k,2274) = 0._r8 + mat(k,2275) = 0._r8 + mat(k,2276) = 0._r8 + mat(k,2279) = 0._r8 + mat(k,2280) = 0._r8 + mat(k,2281) = 0._r8 + mat(k,2282) = 0._r8 + mat(k,2283) = 0._r8 + mat(k,2285) = 0._r8 + mat(k,2286) = 0._r8 + mat(k,2295) = 0._r8 + mat(k,2305) = 0._r8 + mat(k,2307) = 0._r8 + mat(k,2314) = 0._r8 + mat(k,2316) = 0._r8 + mat(k,2317) = 0._r8 + mat(k,2318) = 0._r8 + mat(k,2319) = 0._r8 + mat(k,2321) = 0._r8 + mat(k,2323) = 0._r8 + mat(k,2324) = 0._r8 + mat(k,2325) = 0._r8 + mat(k,2326) = 0._r8 + mat(k,2327) = 0._r8 + mat(k,2328) = 0._r8 + mat(k,2330) = 0._r8 + mat(k,2331) = 0._r8 + mat(k,2337) = 0._r8 + mat(k,2340) = 0._r8 + mat(k,2349) = 0._r8 + mat(k,2351) = 0._r8 + mat(k,2364) = 0._r8 + mat(k,2376) = 0._r8 + mat(k,2379) = 0._r8 + mat(k,2389) = 0._r8 + mat(k,2391) = 0._r8 + mat(k,2398) = 0._r8 + mat(k,2401) = 0._r8 + mat(k,2403) = 0._r8 + mat(k,2405) = 0._r8 + mat(k,2406) = 0._r8 + mat(k,2407) = 0._r8 + mat(k,2410) = 0._r8 + mat(k,2418) = 0._r8 + mat(k,2420) = 0._r8 + mat(k,2437) = 0._r8 + mat(k,2450) = 0._r8 + mat(k,2452) = 0._r8 + mat(k,2459) = 0._r8 + mat(k,2461) = 0._r8 + mat(k,2463) = 0._r8 + mat(k,2467) = 0._r8 + mat(k,2469) = 0._r8 + mat(k,2470) = 0._r8 + mat(k,2473) = 0._r8 + mat(k,2481) = 0._r8 + mat(k,2483) = 0._r8 + mat(k,2490) = 0._r8 + mat(k,2493) = 0._r8 + mat(k,2494) = 0._r8 + mat(k,2495) = 0._r8 + mat(k,2498) = 0._r8 + mat(k,2499) = 0._r8 + mat(k,2503) = 0._r8 + mat(k,2504) = 0._r8 + mat(k,2506) = 0._r8 + mat(k,2515) = 0._r8 + mat(k,2517) = 0._r8 + mat(k,2524) = 0._r8 + mat(k,2534) = 0._r8 + mat(k,2535) = 0._r8 + mat(k,2544) = 0._r8 + mat(k,2546) = 0._r8 + mat(k,2553) = 0._r8 + mat(k,2556) = 0._r8 + mat(k,2557) = 0._r8 + mat(k,2558) = 0._r8 + mat(k,2561) = 0._r8 + mat(k,2562) = 0._r8 + mat(k,2566) = 0._r8 + mat(k,2568) = 0._r8 + mat(k,2569) = 0._r8 + mat(k,2572) = 0._r8 + mat(k,2580) = 0._r8 + mat(k,2582) = 0._r8 + mat(k,2589) = 0._r8 + mat(k,2594) = 0._r8 + mat(k,2596) = 0._r8 + mat(k,2597) = 0._r8 + mat(k,2598) = 0._r8 + mat(k,2599) = 0._r8 + mat(k,2602) = 0._r8 + mat(k,2603) = 0._r8 + mat(k,2604) = 0._r8 + mat(k,2605) = 0._r8 + mat(k,2606) = 0._r8 + mat(k,2607) = 0._r8 + mat(k,2608) = 0._r8 + mat(k,2609) = 0._r8 + mat(k,2610) = 0._r8 + mat(k,2616) = 0._r8 + mat(k,2618) = 0._r8 + mat(k,2620) = 0._r8 + mat(k,2624) = 0._r8 + mat(k,2625) = 0._r8 + mat(k,2627) = 0._r8 + mat(k,2628) = 0._r8 + mat(k,2630) = 0._r8 + mat(k,2631) = 0._r8 + mat(k,2632) = 0._r8 + mat(k,2634) = 0._r8 + mat(k,2635) = 0._r8 + mat(k,2636) = 0._r8 + mat(k,2637) = 0._r8 + mat(k,2638) = 0._r8 + mat(k,2640) = 0._r8 + mat(k,2644) = 0._r8 + mat(k,2646) = 0._r8 + mat(k,2652) = 0._r8 + mat(k,2653) = 0._r8 + mat(k,2661) = 0._r8 + mat(k,2663) = 0._r8 + mat(k,2669) = 0._r8 + mat(k,2673) = 0._r8 + mat(k,2675) = 0._r8 + mat(k,2683) = 0._r8 + mat(k,2685) = 0._r8 + mat(k,2695) = 0._r8 + mat(k,2697) = 0._r8 + mat(k,2698) = 0._r8 + mat(k,2706) = 0._r8 + mat(k,2708) = 0._r8 + mat(k,2715) = 0._r8 + mat(k,2749) = 0._r8 + mat(k,2751) = 0._r8 + mat(k,2752) = 0._r8 + mat(k,2759) = 0._r8 + mat(k,2761) = 0._r8 + mat(k,2795) = 0._r8 + mat(k,2797) = 0._r8 + mat(k,2798) = 0._r8 + mat(k,2805) = 0._r8 + mat(k,2807) = 0._r8 + mat(k,2811) = 0._r8 + mat(k,2842) = 0._r8 + mat(k,2844) = 0._r8 + mat(k,2845) = 0._r8 + mat(k,2852) = 0._r8 + mat(k,2854) = 0._r8 + mat(k,2874) = 0._r8 + mat(k,2878) = 0._r8 + mat(k,2879) = 0._r8 + mat(k,2886) = 0._r8 + mat(k,2887) = 0._r8 + mat(k,2892) = 0._r8 + mat(k,2914) = 0._r8 + mat(k,2915) = 0._r8 + mat(k,2917) = 0._r8 + mat(k,2918) = 0._r8 + mat(k,2922) = 0._r8 + mat(k,2925) = 0._r8 + mat(k,2926) = 0._r8 + mat(k,2928) = 0._r8 + mat(k,2930) = 0._r8 + mat(k,2932) = 0._r8 + mat(k,2933) = 0._r8 + mat(k,2935) = 0._r8 + mat(k,2937) = 0._r8 + mat(k,2938) = 0._r8 + mat(k,2940) = 0._r8 + mat(k,2941) = 0._r8 + mat(k,2946) = 0._r8 + mat(k,2947) = 0._r8 + mat(k,2948) = 0._r8 + mat(k,2950) = 0._r8 + mat(k,2951) = 0._r8 + mat(k,2952) = 0._r8 + mat(k,2953) = 0._r8 + mat(k,2954) = 0._r8 + mat(k,2957) = 0._r8 + mat(k,2958) = 0._r8 + mat(k,2959) = 0._r8 + mat(k,3028) = 0._r8 + mat(k,3041) = 0._r8 + mat(k,3044) = 0._r8 + mat(k,3047) = 0._r8 + mat(k,3067) = 0._r8 + mat(k,3082) = 0._r8 + mat(k,3104) = 0._r8 + mat(k,3105) = 0._r8 + mat(k,3107) = 0._r8 + mat(k,3117) = 0._r8 + mat(k,3120) = 0._r8 + mat(k,3126) = 0._r8 + mat(k,3131) = 0._r8 + mat(k,3132) = 0._r8 + mat(k,3133) = 0._r8 + mat(k,3134) = 0._r8 + mat(k,3136) = 0._r8 + mat(k,3137) = 0._r8 + mat(k,3138) = 0._r8 + mat(k,3144) = 0._r8 + mat(k,3149) = 0._r8 + mat(k,3156) = 0._r8 + mat(k,3158) = 0._r8 + mat(k,3164) = 0._r8 + mat(k,3170) = 0._r8 + mat(k,3173) = 0._r8 + mat(k,3176) = 0._r8 + mat(k,3177) = 0._r8 + mat(k,3178) = 0._r8 + mat(k,3182) = 0._r8 + mat(k,3185) = 0._r8 + mat(k,3190) = 0._r8 + mat(k,3191) = 0._r8 + mat(k,3192) = 0._r8 + mat(k,3194) = 0._r8 + mat(k,3195) = 0._r8 + mat(k,3196) = 0._r8 + mat(k,3218) = 0._r8 + mat(k,3234) = 0._r8 + mat(k,3236) = 0._r8 + mat(k,3287) = 0._r8 + mat(k,3302) = 0._r8 + mat(k,3312) = 0._r8 + mat(k,3322) = 0._r8 + mat(k,3325) = 0._r8 + mat(k,3334) = 0._r8 + mat(k,3335) = 0._r8 + mat(k,3336) = 0._r8 + mat(k,3341) = 0._r8 + mat(k,3364) = 0._r8 + mat(k,3376) = 0._r8 + mat(k,3388) = 0._r8 + mat(k,3393) = 0._r8 + mat(k,3394) = 0._r8 + mat(k,3396) = 0._r8 + mat(k,3397) = 0._r8 + mat(k,3406) = 0._r8 + mat(k,3407) = 0._r8 + mat(k,3415) = 0._r8 + mat(k,3416) = 0._r8 + mat(k,3420) = 0._r8 + mat(k,3421) = 0._r8 + mat(k,3434) = 0._r8 + mat(k,3456) = 0._r8 + mat(k,3457) = 0._r8 + mat(k,3459) = 0._r8 + mat(k,3460) = 0._r8 + mat(k,3464) = 0._r8 + mat(k,3466) = 0._r8 + mat(k,3468) = 0._r8 + mat(k,3469) = 0._r8 + mat(k,3472) = 0._r8 + mat(k,3480) = 0._r8 + mat(k,3481) = 0._r8 + mat(k,3483) = 0._r8 + mat(k,3485) = 0._r8 + mat(k,3487) = 0._r8 + mat(k,3490) = 0._r8 + mat(k,3492) = 0._r8 + mat(k,3493) = 0._r8 + mat(k,3496) = 0._r8 + mat(k,3506) = 0._r8 + mat(k,3507) = 0._r8 + mat(k,3516) = 0._r8 + mat(k,3518) = 0._r8 + mat(k,3519) = 0._r8 + mat(k,3522) = 0._r8 + mat(k,3528) = 0._r8 + mat(k,3530) = 0._r8 + mat(k,3535) = 0._r8 + mat(k,3536) = 0._r8 + mat(k,3540) = 0._r8 + mat(k,3541) = 0._r8 + mat(k,3546) = 0._r8 + mat(k,3547) = 0._r8 + mat(k,3550) = 0._r8 + mat(k,3555) = 0._r8 + mat(k,3557) = 0._r8 + mat(k,3558) = 0._r8 + mat(k,3559) = 0._r8 + mat(k,3560) = 0._r8 + mat(k,3561) = 0._r8 + mat(k,3562) = 0._r8 + mat(k,3563) = 0._r8 + mat(k,3564) = 0._r8 + mat(k,3566) = 0._r8 + mat(k,3567) = 0._r8 + mat(k,3571) = 0._r8 + mat(k,3572) = 0._r8 + mat(k,3575) = 0._r8 + mat(k,3578) = 0._r8 + mat(k,3600) = 0._r8 + mat(k,3603) = 0._r8 + mat(k,3608) = 0._r8 + mat(k,3609) = 0._r8 + mat(k,3612) = 0._r8 + mat(k,3613) = 0._r8 + mat(k,3614) = 0._r8 + mat(k,3616) = 0._r8 + mat(k,3630) = 0._r8 + mat(k,3634) = 0._r8 + mat(k,3636) = 0._r8 + mat(k,3638) = 0._r8 + mat(k,3640) = 0._r8 + mat(k,3642) = 0._r8 + mat(k,3643) = 0._r8 + mat(k,3644) = 0._r8 + mat(k,3645) = 0._r8 + mat(k,3646) = 0._r8 + mat(k,3647) = 0._r8 + mat(k,3652) = 0._r8 + mat(k,3655) = 0._r8 + mat(k,3657) = 0._r8 + mat(k,3659) = 0._r8 + mat(k,3665) = 0._r8 + mat(k,3666) = 0._r8 + mat(k,3668) = 0._r8 + mat(k,3682) = 0._r8 + mat(k,3689) = 0._r8 + mat(k,3694) = 0._r8 + mat(k,3703) = 0._r8 + mat(k,3707) = 0._r8 + mat(k,3708) = 0._r8 + mat(k,3711) = 0._r8 + mat(k,3712) = 0._r8 + mat(k,3714) = 0._r8 + mat(k,3715) = 0._r8 + mat(k,3716) = 0._r8 + mat(k,3717) = 0._r8 + mat(k,3718) = 0._r8 + mat(k,3719) = 0._r8 + mat(k,3720) = 0._r8 + mat(k,3722) = 0._r8 + mat(k,3723) = 0._r8 + mat(k,3730) = 0._r8 + mat(k,3732) = 0._r8 + mat(k,3735) = 0._r8 + mat(k,3736) = 0._r8 + mat(k,3738) = 0._r8 + mat(k,3739) = 0._r8 + mat(k,3740) = 0._r8 + mat(k,3741) = 0._r8 + mat(k,3742) = 0._r8 + mat(k,3743) = 0._r8 + mat(k,3744) = 0._r8 + mat(k,3747) = 0._r8 + mat(k,3748) = 0._r8 + mat(k,3752) = 0._r8 + mat(k,3755) = 0._r8 + mat(k,3757) = 0._r8 + mat(k,3770) = 0._r8 + mat(k,3796) = 0._r8 + mat(k,3805) = 0._r8 + mat(k,3806) = 0._r8 + mat(k,3820) = 0._r8 + mat(k,3824) = 0._r8 + mat(k,3825) = 0._r8 + mat(k,3826) = 0._r8 + mat(k,3828) = 0._r8 + mat(k,3829) = 0._r8 + mat(k,3831) = 0._r8 + mat(k,3835) = 0._r8 + mat(k,3837) = 0._r8 + mat(k,3838) = 0._r8 + mat(k,3840) = 0._r8 + mat(k,3844) = 0._r8 + mat(k,3847) = 0._r8 + mat(k,3849) = 0._r8 + mat(k,3852) = 0._r8 + mat(k,3921) = 0._r8 + mat(k,3967) = 0._r8 + mat(k,3971) = 0._r8 + mat(k,3975) = 0._r8 + mat(k,4003) = 0._r8 + mat(k,4042) = 0._r8 + mat(k,4043) = 0._r8 + mat(k,4047) = 0._r8 + mat(k,4048) = 0._r8 + mat(k,4063) = 0._r8 + mat(k,4066) = 0._r8 + mat(k,4074) = 0._r8 + mat(k,4076) = 0._r8 + mat(k,4099) = 0._r8 + mat(k,4106) = 0._r8 + mat(k,4108) = 0._r8 + mat(k,4110) = 0._r8 + mat(k,4111) = 0._r8 + mat(k,4113) = 0._r8 + mat(k,4114) = 0._r8 + mat(k,4115) = 0._r8 + mat(k,4117) = 0._r8 + mat(k,4118) = 0._r8 + mat(k,4119) = 0._r8 + mat(k,4120) = 0._r8 + mat(k,4121) = 0._r8 + mat(k,4122) = 0._r8 + mat(k,4123) = 0._r8 + mat(k,4124) = 0._r8 + mat(k,4126) = 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, 10) = mat(k, 10) - 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, 33) = mat(k, 33) - 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, 37) = mat(k, 37) - dti(k) + mat(k, 38) = mat(k, 38) - dti(k) + mat(k, 39) = mat(k, 39) - dti(k) + mat(k, 40) = mat(k, 40) - dti(k) + mat(k, 41) = mat(k, 41) - dti(k) + mat(k, 42) = mat(k, 42) - dti(k) + mat(k, 43) = mat(k, 43) - dti(k) + mat(k, 44) = mat(k, 44) - dti(k) + mat(k, 45) = mat(k, 45) - dti(k) + mat(k, 51) = mat(k, 51) - dti(k) + mat(k, 57) = mat(k, 57) - dti(k) + mat(k, 63) = mat(k, 63) - dti(k) + mat(k, 69) = mat(k, 69) - dti(k) + mat(k, 75) = mat(k, 75) - dti(k) + mat(k, 81) = mat(k, 81) - dti(k) + mat(k, 87) = mat(k, 87) - dti(k) + mat(k, 89) = mat(k, 89) - dti(k) + mat(k, 95) = mat(k, 95) - dti(k) + mat(k, 101) = mat(k, 101) - dti(k) + mat(k, 107) = mat(k, 107) - dti(k) + mat(k, 113) = mat(k, 113) - dti(k) + mat(k, 114) = mat(k, 114) - dti(k) + mat(k, 117) = mat(k, 117) - dti(k) + mat(k, 120) = mat(k, 120) - dti(k) + mat(k, 123) = mat(k, 123) - dti(k) + mat(k, 126) = mat(k, 126) - dti(k) + mat(k, 130) = mat(k, 130) - dti(k) + mat(k, 134) = mat(k, 134) - dti(k) + mat(k, 138) = mat(k, 138) - dti(k) + mat(k, 142) = mat(k, 142) - dti(k) + mat(k, 146) = mat(k, 146) - dti(k) + mat(k, 150) = mat(k, 150) - dti(k) + mat(k, 153) = mat(k, 153) - dti(k) + mat(k, 156) = mat(k, 156) - dti(k) + mat(k, 159) = mat(k, 159) - dti(k) + mat(k, 164) = mat(k, 164) - dti(k) + mat(k, 169) = mat(k, 169) - dti(k) + mat(k, 174) = mat(k, 174) - dti(k) + mat(k, 179) = mat(k, 179) - dti(k) + mat(k, 182) = mat(k, 182) - dti(k) + mat(k, 188) = mat(k, 188) - dti(k) + mat(k, 192) = mat(k, 192) - dti(k) + mat(k, 197) = mat(k, 197) - dti(k) + mat(k, 201) = mat(k, 201) - dti(k) + mat(k, 204) = mat(k, 204) - dti(k) + mat(k, 207) = mat(k, 207) - dti(k) + mat(k, 211) = mat(k, 211) - dti(k) + mat(k, 218) = mat(k, 218) - dti(k) + mat(k, 223) = mat(k, 223) - dti(k) + mat(k, 229) = mat(k, 229) - dti(k) + mat(k, 237) = mat(k, 237) - dti(k) + mat(k, 242) = mat(k, 242) - dti(k) + mat(k, 245) = mat(k, 245) - dti(k) + mat(k, 248) = mat(k, 248) - dti(k) + mat(k, 251) = mat(k, 251) - dti(k) + mat(k, 256) = mat(k, 256) - dti(k) + mat(k, 261) = mat(k, 261) - dti(k) + mat(k, 266) = mat(k, 266) - dti(k) + mat(k, 269) = mat(k, 269) - dti(k) + mat(k, 272) = mat(k, 272) - dti(k) + mat(k, 275) = mat(k, 275) - dti(k) + mat(k, 279) = mat(k, 279) - dti(k) + mat(k, 283) = mat(k, 283) - dti(k) + mat(k, 287) = mat(k, 287) - dti(k) + mat(k, 291) = mat(k, 291) - dti(k) + mat(k, 295) = mat(k, 295) - dti(k) + mat(k, 301) = mat(k, 301) - dti(k) + mat(k, 304) = mat(k, 304) - dti(k) + mat(k, 310) = mat(k, 310) - dti(k) + mat(k, 316) = mat(k, 316) - dti(k) + mat(k, 322) = mat(k, 322) - dti(k) + mat(k, 326) = mat(k, 326) - dti(k) + mat(k, 332) = mat(k, 332) - dti(k) + mat(k, 337) = mat(k, 337) - dti(k) + mat(k, 342) = mat(k, 342) - dti(k) + mat(k, 347) = mat(k, 347) - dti(k) + mat(k, 353) = mat(k, 353) - dti(k) + mat(k, 358) = mat(k, 358) - dti(k) + mat(k, 363) = mat(k, 363) - dti(k) + mat(k, 368) = mat(k, 368) - dti(k) + mat(k, 373) = mat(k, 373) - dti(k) + mat(k, 377) = mat(k, 377) - dti(k) + mat(k, 385) = mat(k, 385) - dti(k) + mat(k, 393) = mat(k, 393) - dti(k) + mat(k, 401) = mat(k, 401) - dti(k) + mat(k, 405) = mat(k, 405) - dti(k) + mat(k, 411) = mat(k, 411) - dti(k) + mat(k, 417) = mat(k, 417) - dti(k) + mat(k, 423) = mat(k, 423) - dti(k) + mat(k, 429) = mat(k, 429) - dti(k) + mat(k, 437) = mat(k, 437) - dti(k) + mat(k, 443) = mat(k, 443) - dti(k) + mat(k, 449) = mat(k, 449) - dti(k) + mat(k, 456) = mat(k, 456) - dti(k) + mat(k, 462) = mat(k, 462) - dti(k) + mat(k, 468) = mat(k, 468) - dti(k) + mat(k, 471) = mat(k, 471) - dti(k) + mat(k, 477) = mat(k, 477) - dti(k) + mat(k, 484) = mat(k, 484) - dti(k) + mat(k, 488) = mat(k, 488) - dti(k) + mat(k, 495) = mat(k, 495) - dti(k) + mat(k, 502) = mat(k, 502) - dti(k) + mat(k, 514) = mat(k, 514) - dti(k) + mat(k, 521) = mat(k, 521) - dti(k) + mat(k, 528) = mat(k, 528) - dti(k) + mat(k, 536) = mat(k, 536) - dti(k) + mat(k, 543) = mat(k, 543) - dti(k) + mat(k, 550) = mat(k, 550) - dti(k) + mat(k, 556) = mat(k, 556) - dti(k) + mat(k, 561) = mat(k, 561) - dti(k) + mat(k, 569) = mat(k, 569) - dti(k) + mat(k, 577) = mat(k, 577) - dti(k) + mat(k, 585) = mat(k, 585) - dti(k) + mat(k, 593) = mat(k, 593) - dti(k) + mat(k, 601) = mat(k, 601) - dti(k) + mat(k, 605) = mat(k, 605) - dti(k) + mat(k, 613) = mat(k, 613) - dti(k) + mat(k, 626) = mat(k, 626) - dti(k) + mat(k, 639) = mat(k, 639) - dti(k) + mat(k, 646) = mat(k, 646) - dti(k) + mat(k, 655) = mat(k, 655) - dti(k) + mat(k, 664) = mat(k, 664) - dti(k) + mat(k, 673) = mat(k, 673) - dti(k) + mat(k, 682) = mat(k, 682) - dti(k) + mat(k, 689) = mat(k, 689) - dti(k) + mat(k, 693) = mat(k, 693) - dti(k) + mat(k, 702) = mat(k, 702) - dti(k) + mat(k, 711) = mat(k, 711) - dti(k) + mat(k, 718) = mat(k, 718) - dti(k) + mat(k, 728) = mat(k, 728) - dti(k) + mat(k, 741) = mat(k, 741) - dti(k) + mat(k, 752) = mat(k, 752) - dti(k) + mat(k, 763) = mat(k, 763) - dti(k) + mat(k, 770) = mat(k, 770) - dti(k) + mat(k, 778) = mat(k, 778) - dti(k) + mat(k, 783) = mat(k, 783) - dti(k) + mat(k, 791) = mat(k, 791) - dti(k) + mat(k, 797) = mat(k, 797) - dti(k) + mat(k, 805) = mat(k, 805) - dti(k) + mat(k, 813) = mat(k, 813) - dti(k) + mat(k, 827) = mat(k, 827) - dti(k) + mat(k, 842) = mat(k, 842) - dti(k) + mat(k, 855) = mat(k, 855) - dti(k) + mat(k, 862) = mat(k, 862) - dti(k) + mat(k, 873) = mat(k, 873) - dti(k) + mat(k, 883) = mat(k, 883) - dti(k) + mat(k, 895) = mat(k, 895) - dti(k) + mat(k, 906) = mat(k, 906) - dti(k) + mat(k, 914) = mat(k, 914) - dti(k) + mat(k, 919) = mat(k, 919) - dti(k) + mat(k, 924) = mat(k, 924) - dti(k) + mat(k, 929) = mat(k, 929) - dti(k) + mat(k, 939) = mat(k, 939) - dti(k) + mat(k, 951) = mat(k, 951) - dti(k) + mat(k, 960) = mat(k, 960) - dti(k) + mat(k, 969) = mat(k, 969) - dti(k) + mat(k, 974) = mat(k, 974) - dti(k) + mat(k, 986) = mat(k, 986) - dti(k) + mat(k, 995) = mat(k, 995) - dti(k) + mat(k,1006) = mat(k,1006) - dti(k) + mat(k,1015) = mat(k,1015) - dti(k) + mat(k,1024) = mat(k,1024) - dti(k) + mat(k,1041) = mat(k,1041) - dti(k) + mat(k,1054) = mat(k,1054) - dti(k) + mat(k,1071) = mat(k,1071) - dti(k) + mat(k,1092) = mat(k,1092) - dti(k) + mat(k,1106) = mat(k,1106) - dti(k) + mat(k,1110) = mat(k,1110) - dti(k) + mat(k,1121) = mat(k,1121) - dti(k) + mat(k,1132) = mat(k,1132) - dti(k) + mat(k,1143) = mat(k,1143) - dti(k) + mat(k,1150) = mat(k,1150) - dti(k) + mat(k,1159) = mat(k,1159) - dti(k) + mat(k,1166) = mat(k,1166) - dti(k) + mat(k,1182) = mat(k,1182) - dti(k) + mat(k,1194) = mat(k,1194) - dti(k) + mat(k,1210) = mat(k,1210) - dti(k) + mat(k,1218) = mat(k,1218) - dti(k) + mat(k,1228) = mat(k,1228) - dti(k) + mat(k,1235) = mat(k,1235) - dti(k) + mat(k,1242) = mat(k,1242) - dti(k) + mat(k,1252) = mat(k,1252) - dti(k) + mat(k,1272) = mat(k,1272) - dti(k) + mat(k,1289) = mat(k,1289) - dti(k) + mat(k,1298) = mat(k,1298) - dti(k) + mat(k,1309) = mat(k,1309) - dti(k) + mat(k,1325) = mat(k,1325) - dti(k) + mat(k,1336) = mat(k,1336) - dti(k) + mat(k,1350) = mat(k,1350) - dti(k) + mat(k,1361) = mat(k,1361) - dti(k) + mat(k,1377) = mat(k,1377) - dti(k) + mat(k,1385) = mat(k,1385) - dti(k) + mat(k,1410) = mat(k,1410) - dti(k) + mat(k,1431) = mat(k,1431) - dti(k) + mat(k,1440) = mat(k,1440) - dti(k) + mat(k,1454) = mat(k,1454) - dti(k) + mat(k,1461) = mat(k,1461) - dti(k) + mat(k,1468) = mat(k,1468) - dti(k) + mat(k,1476) = mat(k,1476) - dti(k) + mat(k,1481) = mat(k,1481) - dti(k) + mat(k,1487) = mat(k,1487) - dti(k) + mat(k,1494) = mat(k,1494) - dti(k) + mat(k,1498) = mat(k,1498) - dti(k) + mat(k,1508) = mat(k,1508) - dti(k) + mat(k,1524) = mat(k,1524) - dti(k) + mat(k,1536) = mat(k,1536) - dti(k) + mat(k,1543) = mat(k,1543) - dti(k) + mat(k,1557) = mat(k,1557) - dti(k) + mat(k,1572) = mat(k,1572) - dti(k) + mat(k,1600) = mat(k,1600) - dti(k) + mat(k,1613) = mat(k,1613) - dti(k) + mat(k,1620) = mat(k,1620) - dti(k) + mat(k,1640) = mat(k,1640) - dti(k) + mat(k,1659) = mat(k,1659) - dti(k) + mat(k,1673) = mat(k,1673) - dti(k) + mat(k,1689) = mat(k,1689) - dti(k) + mat(k,1702) = mat(k,1702) - dti(k) + mat(k,1712) = mat(k,1712) - dti(k) + mat(k,1718) = mat(k,1718) - dti(k) + mat(k,1732) = mat(k,1732) - dti(k) + mat(k,1754) = mat(k,1754) - dti(k) + mat(k,1770) = mat(k,1770) - dti(k) + mat(k,1778) = mat(k,1778) - dti(k) + mat(k,1793) = mat(k,1793) - dti(k) + mat(k,1817) = mat(k,1817) - dti(k) + mat(k,1848) = mat(k,1848) - dti(k) + mat(k,1872) = mat(k,1872) - dti(k) + mat(k,1896) = mat(k,1896) - dti(k) + mat(k,1916) = mat(k,1916) - dti(k) + mat(k,1926) = mat(k,1926) - dti(k) + mat(k,1953) = mat(k,1953) - dti(k) + mat(k,1991) = mat(k,1991) - dti(k) + mat(k,2016) = mat(k,2016) - dti(k) + mat(k,2041) = mat(k,2041) - dti(k) + mat(k,2057) = mat(k,2057) - dti(k) + mat(k,2078) = mat(k,2078) - dti(k) + mat(k,2110) = mat(k,2110) - dti(k) + mat(k,2140) = mat(k,2140) - dti(k) + mat(k,2180) = mat(k,2180) - dti(k) + mat(k,2199) = mat(k,2199) - dti(k) + mat(k,2213) = mat(k,2213) - dti(k) + mat(k,2235) = mat(k,2235) - dti(k) + mat(k,2259) = mat(k,2259) - dti(k) + mat(k,2277) = mat(k,2277) - dti(k) + mat(k,2296) = mat(k,2296) - dti(k) + mat(k,2320) = mat(k,2320) - dti(k) + mat(k,2339) = mat(k,2339) - dti(k) + mat(k,2359) = mat(k,2359) - dti(k) + mat(k,2380) = mat(k,2380) - dti(k) + mat(k,2408) = mat(k,2408) - dti(k) + mat(k,2441) = mat(k,2441) - dti(k) + mat(k,2471) = mat(k,2471) - dti(k) + mat(k,2505) = mat(k,2505) - dti(k) + mat(k,2536) = mat(k,2536) - dti(k) + mat(k,2570) = mat(k,2570) - dti(k) + mat(k,2600) = mat(k,2600) - dti(k) + mat(k,2629) = mat(k,2629) - dti(k) + mat(k,2654) = mat(k,2654) - dti(k) + mat(k,2677) = mat(k,2677) - dti(k) + mat(k,2701) = mat(k,2701) - dti(k) + mat(k,2745) = mat(k,2745) - dti(k) + mat(k,2792) = mat(k,2792) - dti(k) + mat(k,2840) = mat(k,2840) - dti(k) + mat(k,2913) = mat(k,2913) - dti(k) + mat(k,2931) = mat(k,2931) - dti(k) + mat(k,2949) = mat(k,2949) - dti(k) + mat(k,3106) = mat(k,3106) - dti(k) + mat(k,3129) = mat(k,3129) - dti(k) + mat(k,3161) = mat(k,3161) - dti(k) + mat(k,3188) = mat(k,3188) - dti(k) + mat(k,3369) = mat(k,3369) - dti(k) + mat(k,3463) = mat(k,3463) - dti(k) + mat(k,3488) = mat(k,3488) - dti(k) + mat(k,3515) = mat(k,3515) - dti(k) + mat(k,3610) = mat(k,3610) - dti(k) + mat(k,3663) = mat(k,3663) - dti(k) + mat(k,3766) = mat(k,3766) - dti(k) + mat(k,3808) = mat(k,3808) - dti(k) + mat(k,3850) = mat(k,3850) - dti(k) + mat(k,4101) = mat(k,4101) - dti(k) + mat(k,4128) = mat(k,4128) - 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 nlnmat08( avec_len, mat, y, rxt ) + call nlnmat09( avec_len, mat, y, rxt ) + call nlnmat10( avec_len, mat, y, rxt ) + call nlnmat11( avec_len, mat, y, rxt ) + call nlnmat12( avec_len, mat, y, rxt ) + call nlnmat13( avec_len, mat, y, rxt ) + call nlnmat14( avec_len, mat, y, rxt ) + call nlnmat15( avec_len, mat, y, rxt ) + call nlnmat16( avec_len, mat, y, rxt ) + call nlnmat17( 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_ts2/mo_phtadj.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/mo_phtadj.F90 new file mode 100644 index 0000000000..6698bf2f2b --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/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_ts2/mo_prod_loss.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/mo_prod_loss.F90 new file mode 100644 index 0000000000..d896ada155 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/mo_prod_loss.F90 @@ -0,0 +1,2325 @@ + 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,233))* y(k,233) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,234))* y(k,234) + 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,168) = (rxt(k,408)* y(k,295) + rxt(k,19) + het_rates(k,1))* y(k,1) + prod(k,168) =rxt(k,411)*y(k,236)*y(k,147) + loss(k,165) = (rxt(k,412)* y(k,295) + rxt(k,20) + het_rates(k,2))* y(k,2) + prod(k,165) =rxt(k,409)*y(k,258)*y(k,236) + loss(k,1) = ( + het_rates(k,3))* y(k,3) + prod(k,1) = 0._r8 + loss(k,219) = (rxt(k,584)* y(k,149) +rxt(k,602)* y(k,158) +rxt(k,603) & + * y(k,295) + het_rates(k,4))* y(k,4) + prod(k,219) = 0._r8 + loss(k,2) = ( + het_rates(k,5))* y(k,5) + prod(k,2) = 0._r8 + loss(k,3) = ( + het_rates(k,6))* y(k,6) + prod(k,3) = 0._r8 + loss(k,199) = (rxt(k,604)* y(k,149) +rxt(k,622)* y(k,158) +rxt(k,623) & + * y(k,295) + het_rates(k,7))* y(k,7) + prod(k,199) = 0._r8 + loss(k,76) = (rxt(k,543)* y(k,295) + het_rates(k,8))* y(k,8) + prod(k,76) = 0._r8 + loss(k,124) = (rxt(k,546)* y(k,295) + rxt(k,21) + het_rates(k,9))* y(k,9) + prod(k,124) =rxt(k,544)*y(k,258)*y(k,243) + loss(k,77) = ( + rxt(k,22) + het_rates(k,10))* y(k,10) + prod(k,77) =.120_r8*rxt(k,543)*y(k,295)*y(k,8) + loss(k,132) = ( + rxt(k,23) + het_rates(k,11))* y(k,11) + prod(k,132) = (.500_r8*rxt(k,545)*y(k,243) +.200_r8*rxt(k,572)*y(k,314) + & + .060_r8*rxt(k,578)*y(k,316))*y(k,147) +.500_r8*rxt(k,21)*y(k,9) & + +rxt(k,22)*y(k,10) +.200_r8*rxt(k,115)*y(k,227) +.060_r8*rxt(k,116) & + *y(k,230) + loss(k,103) = ( + rxt(k,24) + het_rates(k,12))* y(k,12) + prod(k,103) = (.200_r8*rxt(k,572)*y(k,314) +.200_r8*rxt(k,578)*y(k,316)) & + *y(k,147) +.200_r8*rxt(k,115)*y(k,227) +.200_r8*rxt(k,116)*y(k,230) + loss(k,121) = ( + rxt(k,25) + het_rates(k,13))* y(k,13) + prod(k,121) = (.200_r8*rxt(k,572)*y(k,314) +.150_r8*rxt(k,578)*y(k,316)) & + *y(k,147) +.200_r8*rxt(k,115)*y(k,227) +.150_r8*rxt(k,116)*y(k,230) + loss(k,110) = ( + rxt(k,26) + het_rates(k,14))* y(k,14) + prod(k,110) =.210_r8*rxt(k,578)*y(k,316)*y(k,147) +.210_r8*rxt(k,116) & + *y(k,230) + loss(k,81) = (rxt(k,413)* y(k,295) + het_rates(k,15))* y(k,15) + prod(k,81) =.190_r8*rxt(k,642)*y(k,158)*y(k,17) + loss(k,118) = (rxt(k,374)* y(k,149) +rxt(k,375)* y(k,295) + het_rates(k,16)) & + * y(k,16) + prod(k,118) = 0._r8 + loss(k,202) = (rxt(k,624)* y(k,149) +rxt(k,642)* y(k,158) +rxt(k,643) & + * y(k,295) + het_rates(k,17))* y(k,17) + prod(k,202) = 0._r8 + loss(k,276) = (rxt(k,254)* y(k,43) +rxt(k,256)* y(k,158) +rxt(k,255) & + * y(k,258) + het_rates(k,18))* y(k,18) + prod(k,276) = (rxt(k,119) +2.000_r8*rxt(k,257)*y(k,20) +rxt(k,258)*y(k,60) + & + rxt(k,259)*y(k,60) +rxt(k,262)*y(k,147) +rxt(k,265)*y(k,157) + & + rxt(k,266)*y(k,295) +rxt(k,800)*y(k,174))*y(k,20) & + + (rxt(k,244)*y(k,35) +rxt(k,270)*y(k,36) + & + 3.000_r8*rxt(k,271)*y(k,56) +2.000_r8*rxt(k,272)*y(k,80) + & + rxt(k,273)*y(k,83) +2.000_r8*rxt(k,293)*y(k,42) +rxt(k,294)*y(k,44)) & + *y(k,294) + (rxt(k,268)*y(k,83) +2.000_r8*rxt(k,282)*y(k,42) + & + rxt(k,284)*y(k,44) +3.000_r8*rxt(k,289)*y(k,56))*y(k,295) & + + (2.000_r8*rxt(k,281)*y(k,42) +rxt(k,283)*y(k,44) + & + 3.000_r8*rxt(k,288)*y(k,56))*y(k,57) + (rxt(k,143) + & + rxt(k,267)*y(k,157))*y(k,83) +rxt(k,118)*y(k,19) +rxt(k,121)*y(k,21) & + +rxt(k,123)*y(k,35) +rxt(k,124)*y(k,36) +2.000_r8*rxt(k,130)*y(k,42) & + +rxt(k,131)*y(k,44) +3.000_r8*rxt(k,134)*y(k,56) & + +2.000_r8*rxt(k,142)*y(k,80) +rxt(k,149)*y(k,95) + loss(k,88) = ( + rxt(k,118) + het_rates(k,19))* y(k,19) + prod(k,88) = (rxt(k,892)*y(k,95) +rxt(k,897)*y(k,95))*y(k,87) & + +rxt(k,260)*y(k,60)*y(k,20) + loss(k,309) = (2._r8*rxt(k,257)* y(k,20) + (rxt(k,258) +rxt(k,259) + & + rxt(k,260))* y(k,60) +rxt(k,262)* y(k,147) +rxt(k,263)* y(k,148) & + +rxt(k,265)* y(k,157) +rxt(k,800)* y(k,174) +rxt(k,261)* y(k,258) & + +rxt(k,266)* y(k,295) + rxt(k,119) + het_rates(k,20))* y(k,20) + prod(k,309) = (rxt(k,120) +rxt(k,264)*y(k,157))*y(k,21) +rxt(k,256)*y(k,158) & + *y(k,18) +rxt(k,274)*y(k,294)*y(k,83) +rxt(k,269)*y(k,157)*y(k,95) + loss(k,146) = (rxt(k,264)* y(k,157) + rxt(k,120) + rxt(k,121) + rxt(k,886) & + + rxt(k,889) + rxt(k,894) + het_rates(k,21))* y(k,21) + prod(k,146) =rxt(k,263)*y(k,148)*y(k,20) + loss(k,4) = ( + het_rates(k,22))* y(k,22) + prod(k,4) = 0._r8 + loss(k,89) = (rxt(k,547)* y(k,295) + het_rates(k,23))* y(k,23) + prod(k,89) =rxt(k,27)*y(k,24) +rxt(k,550)*y(k,248)*y(k,147) + loss(k,113) = (rxt(k,549)* y(k,295) + rxt(k,27) + het_rates(k,24))* y(k,24) + prod(k,113) =rxt(k,548)*y(k,258)*y(k,248) + loss(k,105) = (rxt(k,320)* y(k,57) +rxt(k,321)* y(k,295) + het_rates(k,25)) & + * y(k,25) + prod(k,105) = 0._r8 + loss(k,149) = (rxt(k,322)* y(k,57) +rxt(k,323)* y(k,158) +rxt(k,350) & + * y(k,295) + het_rates(k,26))* y(k,26) + prod(k,149) = 0._r8 + loss(k,99) = (rxt(k,328)* y(k,295) + het_rates(k,27))* y(k,27) + prod(k,99) = (.400_r8*rxt(k,324)*y(k,249) +.200_r8*rxt(k,325)*y(k,253)) & + *y(k,249) + loss(k,114) = (rxt(k,329)* y(k,295) + rxt(k,28) + het_rates(k,28))* y(k,28) + prod(k,114) =rxt(k,326)*y(k,258)*y(k,249) + loss(k,106) = (rxt(k,330)* y(k,57) +rxt(k,331)* y(k,295) + het_rates(k,29)) & + * y(k,29) + prod(k,106) = 0._r8 + loss(k,228) = (rxt(k,353)* y(k,149) +rxt(k,354)* y(k,158) +rxt(k,372) & + * y(k,295) + het_rates(k,30))* y(k,30) + prod(k,228) =.700_r8*rxt(k,79)*y(k,132) + loss(k,123) = (rxt(k,358)* y(k,295) + rxt(k,29) + het_rates(k,31))* y(k,31) + prod(k,123) =rxt(k,356)*y(k,258)*y(k,250) + loss(k,63) = (rxt(k,359)* y(k,295) + het_rates(k,32))* y(k,32) + prod(k,63) = 0._r8 + loss(k,100) = (rxt(k,553)* y(k,295) + rxt(k,30) + het_rates(k,33))* y(k,33) + prod(k,100) =rxt(k,551)*y(k,258)*y(k,251) + loss(k,60) = (rxt(k,243)* y(k,294) + rxt(k,122) + het_rates(k,34))* y(k,34) + prod(k,60) = 0._r8 + loss(k,71) = (rxt(k,244)* y(k,294) + rxt(k,123) + het_rates(k,35))* y(k,35) + prod(k,71) = 0._r8 + loss(k,72) = (rxt(k,270)* y(k,294) + rxt(k,124) + het_rates(k,36))* y(k,36) + prod(k,72) = 0._r8 + loss(k,64) = (rxt(k,245)* y(k,294) + rxt(k,125) + het_rates(k,37))* y(k,37) + prod(k,64) = 0._r8 + loss(k,73) = (rxt(k,246)* y(k,294) + rxt(k,126) + het_rates(k,38))* y(k,38) + prod(k,73) = 0._r8 + loss(k,65) = (rxt(k,247)* y(k,294) + rxt(k,127) + het_rates(k,39))* y(k,39) + prod(k,65) = 0._r8 + loss(k,74) = (rxt(k,248)* y(k,294) + rxt(k,128) + het_rates(k,40))* y(k,40) + prod(k,74) = 0._r8 + loss(k,66) = (rxt(k,249)* y(k,294) + rxt(k,129) + het_rates(k,41))* y(k,41) + prod(k,66) = 0._r8 + loss(k,137) = (rxt(k,281)* y(k,57) +rxt(k,293)* y(k,294) +rxt(k,282) & + * y(k,295) + rxt(k,130) + het_rates(k,42))* y(k,42) + prod(k,137) = 0._r8 + loss(k,306) = (rxt(k,254)* y(k,18) +rxt(k,218)* y(k,57) +rxt(k,299)* y(k,149) & + +rxt(k,300)* y(k,157) +rxt(k,298)* y(k,258) +rxt(k,301)* y(k,295) & + + rxt(k,31) + rxt(k,32) + het_rates(k,43))* y(k,43) + prod(k,306) = (rxt(k,225)*y(k,60) +2.000_r8*rxt(k,302)*y(k,253) + & + rxt(k,303)*y(k,253) +rxt(k,305)*y(k,147) + & + .700_r8*rxt(k,325)*y(k,249) +rxt(k,336)*y(k,252) + & + rxt(k,355)*y(k,250) +.800_r8*rxt(k,368)*y(k,298) + & + 1.100_r8*rxt(k,382)*y(k,284) +2.000_r8*rxt(k,389)*y(k,286) + & + .870_r8*rxt(k,401)*y(k,289) +1.750_r8*rxt(k,425)*y(k,261) + & + 1.250_r8*rxt(k,431)*y(k,262) +.750_r8*rxt(k,445)*y(k,267) + & + .750_r8*rxt(k,449)*y(k,268) +.710_r8*rxt(k,475)*y(k,274) + & + .750_r8*rxt(k,492)*y(k,278) +.750_r8*rxt(k,496)*y(k,279) + & + .950_r8*rxt(k,587)*y(k,237) +.830_r8*rxt(k,595)*y(k,238) + & + .950_r8*rxt(k,607)*y(k,240) +.750_r8*rxt(k,615)*y(k,241) + & + .990_r8*rxt(k,627)*y(k,245) +1.400_r8*rxt(k,635)*y(k,246) + & + .910_r8*rxt(k,646)*y(k,281) +1.030_r8*rxt(k,655)*y(k,282) + & + .980_r8*rxt(k,666)*y(k,290) +.750_r8*rxt(k,675)*y(k,291) + & + .750_r8*rxt(k,694)*y(k,301) +rxt(k,702)*y(k,302) + & + rxt(k,710)*y(k,303) +rxt(k,720)*y(k,304) +rxt(k,729)*y(k,305) + & + 3.000_r8*rxt(k,739)*y(k,306) +rxt(k,750)*y(k,307))*y(k,253) & + + (.500_r8*rxt(k,342)*y(k,257) +rxt(k,366)*y(k,297) + & + rxt(k,370)*y(k,298) +.500_r8*rxt(k,377)*y(k,255) + & + rxt(k,392)*y(k,286) +.100_r8*rxt(k,410)*y(k,236) + & + rxt(k,505)*y(k,261) +rxt(k,507)*y(k,262) + & + .060_r8*rxt(k,513)*y(k,269) +.270_r8*rxt(k,515)*y(k,270) + & + rxt(k,517)*y(k,271) +.130_r8*rxt(k,519)*y(k,272) + & + .330_r8*rxt(k,521)*y(k,273) +.460_r8*rxt(k,523)*y(k,274) + & + .530_r8*rxt(k,525)*y(k,275) +.040_r8*rxt(k,527)*y(k,276) + & + .140_r8*rxt(k,535)*y(k,284) +.240_r8*rxt(k,537)*y(k,289) + & + .210_r8*rxt(k,597)*y(k,238) +.020_r8*rxt(k,629)*y(k,245) + & + .490_r8*rxt(k,637)*y(k,246) +.430_r8*rxt(k,657)*y(k,282) + & + .040_r8*rxt(k,669)*y(k,290) +.300_r8*rxt(k,677)*y(k,291) + & + .310_r8*rxt(k,688)*y(k,299) +1.820_r8*rxt(k,741)*y(k,306) + & + .310_r8*rxt(k,761)*y(k,308))*y(k,147) & + + (.150_r8*rxt(k,369)*y(k,298) +.080_r8*rxt(k,383)*y(k,284) + & + .490_r8*rxt(k,390)*y(k,286) +.050_r8*rxt(k,402)*y(k,289) + & + .060_r8*rxt(k,426)*y(k,261) +.060_r8*rxt(k,432)*y(k,262) + & + .030_r8*rxt(k,457)*y(k,269) +.060_r8*rxt(k,461)*y(k,270) + & + .600_r8*rxt(k,464)*y(k,271) +.060_r8*rxt(k,467)*y(k,272) + & + .100_r8*rxt(k,471)*y(k,273) +.240_r8*rxt(k,476)*y(k,274) + & + .170_r8*rxt(k,479)*y(k,275) +.030_r8*rxt(k,482)*y(k,276) + & + .080_r8*rxt(k,596)*y(k,238) +.020_r8*rxt(k,628)*y(k,245) + & + .030_r8*rxt(k,636)*y(k,246) +.060_r8*rxt(k,656)*y(k,282) + & + .020_r8*rxt(k,667)*y(k,290) +.040_r8*rxt(k,676)*y(k,291) + & + .080_r8*rxt(k,687)*y(k,299) +1.060_r8*rxt(k,740)*y(k,306) + & + .040_r8*rxt(k,760)*y(k,308))*y(k,258) + (rxt(k,306)*y(k,53) + & + .300_r8*rxt(k,307)*y(k,54) +.500_r8*rxt(k,311)*y(k,92) + & + .500_r8*rxt(k,340)*y(k,52) +.800_r8*rxt(k,345)*y(k,76) + & + .110_r8*rxt(k,347)*y(k,89) +rxt(k,348)*y(k,150) + & + rxt(k,349)*y(k,163) +.300_r8*rxt(k,363)*y(k,104) + & + .400_r8*rxt(k,408)*y(k,1) +.500_r8*rxt(k,419)*y(k,105) + & + .400_r8*rxt(k,422)*y(k,107) +.590_r8*rxt(k,423)*y(k,108) + & + 2.000_r8*rxt(k,718)*y(k,204) +rxt(k,737)*y(k,206))*y(k,295) & + + (.140_r8*rxt(k,381)*y(k,284) +rxt(k,388)*y(k,286) + & + .250_r8*rxt(k,400)*y(k,289) +rxt(k,424)*y(k,261) + & + rxt(k,430)*y(k,262) +.460_r8*rxt(k,474)*y(k,274) + & + .270_r8*rxt(k,594)*y(k,238) +.020_r8*rxt(k,626)*y(k,245) + & + .650_r8*rxt(k,634)*y(k,246) +.560_r8*rxt(k,654)*y(k,282) + & + .040_r8*rxt(k,665)*y(k,290) +.420_r8*rxt(k,674)*y(k,291) + & + 2.000_r8*rxt(k,738)*y(k,306))*y(k,252) & + + (.500_r8*rxt(k,374)*y(k,16) +rxt(k,393)*y(k,286) + & + .460_r8*rxt(k,478)*y(k,274) +.270_r8*rxt(k,598)*y(k,238) + & + .020_r8*rxt(k,630)*y(k,245) +.650_r8*rxt(k,638)*y(k,246) + & + .560_r8*rxt(k,658)*y(k,282) +.040_r8*rxt(k,670)*y(k,290) + & + .420_r8*rxt(k,678)*y(k,291) +2.000_r8*rxt(k,742)*y(k,306) + & + .440_r8*rxt(k,759)*y(k,212) +.500_r8*rxt(k,764)*y(k,213))*y(k,149) & + + (rxt(k,323)*y(k,26) +.500_r8*rxt(k,354)*y(k,30) + & + .120_r8*rxt(k,385)*y(k,126) +.600_r8*rxt(k,403)*y(k,132) + & + 1.010_r8*rxt(k,486)*y(k,109) +.270_r8*rxt(k,602)*y(k,4) + & + .080_r8*rxt(k,622)*y(k,7) +.810_r8*rxt(k,642)*y(k,17) + & + .330_r8*rxt(k,662)*y(k,125) +.390_r8*rxt(k,682)*y(k,135) + & + .620_r8*rxt(k,762)*y(k,212) +.340_r8*rxt(k,767)*y(k,213))*y(k,158) & + + (.270_r8*rxt(k,599)*y(k,238) +.020_r8*rxt(k,631)*y(k,245) + & + .650_r8*rxt(k,639)*y(k,246) +.560_r8*rxt(k,659)*y(k,282) + & + .040_r8*rxt(k,671)*y(k,290) +.420_r8*rxt(k,679)*y(k,291) + & + 2.000_r8*rxt(k,743)*y(k,306))*y(k,302) & + + (.270_r8*rxt(k,600)*y(k,238) +.020_r8*rxt(k,632)*y(k,245) + & + .650_r8*rxt(k,640)*y(k,246) +.560_r8*rxt(k,660)*y(k,282) + & + .040_r8*rxt(k,672)*y(k,290) +.420_r8*rxt(k,680)*y(k,291) + & + 2.000_r8*rxt(k,744)*y(k,306))*y(k,304) & + + (.270_r8*rxt(k,601)*y(k,238) +.020_r8*rxt(k,633)*y(k,245) + & + .650_r8*rxt(k,641)*y(k,246) +.560_r8*rxt(k,661)*y(k,282) + & + .040_r8*rxt(k,673)*y(k,290) +.420_r8*rxt(k,681)*y(k,291) + & + 2.000_r8*rxt(k,745)*y(k,306))*y(k,307) + (.180_r8*rxt(k,39) + & + rxt(k,316)*y(k,294) +rxt(k,317)*y(k,294))*y(k,55) + (rxt(k,55) + & + rxt(k,56))*y(k,104) +.100_r8*rxt(k,19)*y(k,1) +.100_r8*rxt(k,20) & + *y(k,2) +rxt(k,37)*y(k,54) +.500_r8*rxt(k,41)*y(k,68) +rxt(k,43) & + *y(k,76) +rxt(k,45)*y(k,89) +rxt(k,46)*y(k,92) +.330_r8*rxt(k,47) & + *y(k,97) +rxt(k,52)*y(k,102) +rxt(k,65)*y(k,116) +rxt(k,66)*y(k,117) & + +rxt(k,68)*y(k,119) +rxt(k,69)*y(k,120) +rxt(k,71)*y(k,123) & + +rxt(k,72)*y(k,126) +.250_r8*rxt(k,74)*y(k,127) +.140_r8*rxt(k,75) & + *y(k,128) +.250_r8*rxt(k,80)*y(k,133) +.440_r8*rxt(k,81)*y(k,134) & + +rxt(k,83)*y(k,150) +rxt(k,84)*y(k,151) +rxt(k,88)*y(k,170) & + +rxt(k,89)*y(k,171) +.040_r8*rxt(k,625)*y(k,245)*y(k,245) & + +2.000_r8*rxt(k,343)*y(k,256) +rxt(k,313)*y(k,259) +rxt(k,427) & + *y(k,261) +rxt(k,433)*y(k,262) +.160_r8*rxt(k,477)*y(k,274)*y(k,274) & + +2.000_r8*rxt(k,391)*y(k,286)*y(k,286) +.060_r8*rxt(k,668)*y(k,290) & + *y(k,290) + loss(k,156) = (rxt(k,283)* y(k,57) +rxt(k,294)* y(k,294) +rxt(k,284) & + * y(k,295) + rxt(k,131) + het_rates(k,44))* y(k,44) + prod(k,156) = 0._r8 + loss(k,67) = (rxt(k,285)* y(k,295) + rxt(k,132) + het_rates(k,45))* y(k,45) + prod(k,67) = 0._r8 + loss(k,230) = (rxt(k,332)* y(k,149) +rxt(k,333)* y(k,295) + rxt(k,33) & + + het_rates(k,46))* y(k,46) + prod(k,230) = (rxt(k,327)*y(k,249) +.270_r8*rxt(k,357)*y(k,250) + & + rxt(k,366)*y(k,297) +rxt(k,377)*y(k,255) +rxt(k,395)*y(k,288) + & + .400_r8*rxt(k,410)*y(k,236))*y(k,147) + (rxt(k,328)*y(k,27) + & + .500_r8*rxt(k,329)*y(k,28) +.800_r8*rxt(k,408)*y(k,1))*y(k,295) & + + (.500_r8*rxt(k,354)*y(k,30) +.100_r8*rxt(k,403)*y(k,132))*y(k,158) & + + (1.600_r8*rxt(k,324)*y(k,249) +.800_r8*rxt(k,325)*y(k,253)) & + *y(k,249) +.400_r8*rxt(k,19)*y(k,1) +.400_r8*rxt(k,20)*y(k,2) & + +rxt(k,374)*y(k,149)*y(k,16) +rxt(k,28)*y(k,28) +.330_r8*rxt(k,47) & + *y(k,97) +rxt(k,77)*y(k,130) +rxt(k,88)*y(k,170) & + +.200_r8*rxt(k,394)*y(k,288)*y(k,258) + loss(k,120) = (rxt(k,286)* y(k,57) +rxt(k,287)* y(k,295) + rxt(k,133) & + + het_rates(k,47))* y(k,47) + prod(k,120) = 0._r8 + loss(k,61) = (rxt(k,334)* y(k,295) + het_rates(k,48))* y(k,48) + prod(k,61) = 0._r8 + loss(k,280) = (rxt(k,373)* y(k,295) + rxt(k,34) + het_rates(k,49))* y(k,49) + prod(k,280) = (.910_r8*rxt(k,665)*y(k,252) +.740_r8*rxt(k,666)*y(k,253) + & + .460_r8*rxt(k,667)*y(k,258) +1.480_r8*rxt(k,668)*y(k,290) + & + .850_r8*rxt(k,669)*y(k,147) +.910_r8*rxt(k,670)*y(k,149) + & + .910_r8*rxt(k,671)*y(k,302) +.910_r8*rxt(k,672)*y(k,304) + & + .910_r8*rxt(k,673)*y(k,307))*y(k,290) & + + (.120_r8*rxt(k,594)*y(k,252) +.060_r8*rxt(k,595)*y(k,253) + & + .060_r8*rxt(k,596)*y(k,258) +.090_r8*rxt(k,597)*y(k,147) + & + .120_r8*rxt(k,598)*y(k,149) +.120_r8*rxt(k,599)*y(k,302) + & + .120_r8*rxt(k,600)*y(k,304) +.120_r8*rxt(k,601)*y(k,307))*y(k,238) & + + (rxt(k,728)*y(k,252) +rxt(k,729)*y(k,253) + & + .150_r8*rxt(k,730)*y(k,258) +.700_r8*rxt(k,731)*y(k,147) + & + rxt(k,732)*y(k,149) +rxt(k,733)*y(k,302) +rxt(k,734)*y(k,304) + & + rxt(k,735)*y(k,307))*y(k,305) + (.110_r8*rxt(k,634)*y(k,252) + & + .080_r8*rxt(k,635)*y(k,253) +.080_r8*rxt(k,637)*y(k,147) + & + .110_r8*rxt(k,638)*y(k,149) +.110_r8*rxt(k,639)*y(k,302) + & + .110_r8*rxt(k,640)*y(k,304) +.110_r8*rxt(k,641)*y(k,307))*y(k,246) & + + (.460_r8*rxt(k,674)*y(k,252) +.050_r8*rxt(k,676)*y(k,258) + & + .330_r8*rxt(k,677)*y(k,147) +.460_r8*rxt(k,678)*y(k,149) + & + .460_r8*rxt(k,679)*y(k,302) +.460_r8*rxt(k,680)*y(k,304) + & + .460_r8*rxt(k,681)*y(k,307))*y(k,291) & + + (.820_r8*rxt(k,357)*y(k,250) +.500_r8*rxt(k,377)*y(k,255) + & + .250_r8*rxt(k,410)*y(k,236))*y(k,147) + (.250_r8*rxt(k,19) + & + .800_r8*rxt(k,408)*y(k,295))*y(k,1) + (.820_r8*rxt(k,355)*y(k,250) + & + .100_r8*rxt(k,382)*y(k,284))*y(k,253) +.250_r8*rxt(k,20)*y(k,2) & + +.500_r8*rxt(k,374)*y(k,149)*y(k,16) +.820_r8*rxt(k,29)*y(k,31) & + +.170_r8*rxt(k,47)*y(k,97) +.250_r8*rxt(k,682)*y(k,158)*y(k,135) & + +rxt(k,718)*y(k,295)*y(k,204) + loss(k,266) = (rxt(k,360)* y(k,149) +rxt(k,361)* y(k,295) + rxt(k,35) & + + het_rates(k,50))* y(k,50) + prod(k,266) = (rxt(k,362)*y(k,102) +.700_r8*rxt(k,363)*y(k,104) + & + rxt(k,364)*y(k,151) +.440_r8*rxt(k,405)*y(k,134) + & + .380_r8*rxt(k,414)*y(k,98) +.030_r8*rxt(k,415)*y(k,99) + & + .460_r8*rxt(k,418)*y(k,103) +.500_r8*rxt(k,419)*y(k,105) + & + .400_r8*rxt(k,422)*y(k,107) +.720_r8*rxt(k,456)*y(k,114))*y(k,295) & + + (.710_r8*rxt(k,503)*y(k,260) +.140_r8*rxt(k,535)*y(k,284) + & + .240_r8*rxt(k,537)*y(k,289) +.120_r8*rxt(k,539)*y(k,293) + & + .170_r8*rxt(k,556)*y(k,254) +.170_r8*rxt(k,562)*y(k,287) + & + .400_r8*rxt(k,572)*y(k,314) +.540_r8*rxt(k,578)*y(k,316) + & + .510_r8*rxt(k,581)*y(k,318))*y(k,147) & + + (.880_r8*rxt(k,385)*y(k,126) +.500_r8*rxt(k,403)*y(k,132) + & + .170_r8*rxt(k,459)*y(k,115) +.170_r8*rxt(k,469)*y(k,118) + & + .170_r8*rxt(k,484)*y(k,121) +.340_r8*rxt(k,501)*y(k,139))*y(k,158) & + + (.080_r8*rxt(k,383)*y(k,284) +.050_r8*rxt(k,402)*y(k,289) + & + .460_r8*rxt(k,421)*y(k,260) +.100_r8*rxt(k,499)*y(k,293) + & + .070_r8*rxt(k,555)*y(k,254) +.070_r8*rxt(k,561)*y(k,287))*y(k,258) & + + (.140_r8*rxt(k,381)*y(k,284) +.250_r8*rxt(k,400)*y(k,289)) & + *y(k,252) + (.500_r8*rxt(k,368)*y(k,298) + & + .120_r8*rxt(k,401)*y(k,289))*y(k,253) +rxt(k,26)*y(k,14) & + +.500_r8*rxt(k,41)*y(k,68) +.680_r8*rxt(k,48)*y(k,98) & + +.670_r8*rxt(k,49)*y(k,99) +rxt(k,54)*y(k,103) +.500_r8*rxt(k,60) & + *y(k,111) +.500_r8*rxt(k,61)*y(k,112) +.720_r8*rxt(k,63)*y(k,114) & + +.250_r8*rxt(k,74)*y(k,127) +.140_r8*rxt(k,75)*y(k,128) & + +.250_r8*rxt(k,80)*y(k,133) +.440_r8*rxt(k,81)*y(k,134) & + +.400_r8*rxt(k,115)*y(k,227) +.540_r8*rxt(k,116)*y(k,230) & + +.510_r8*rxt(k,117)*y(k,232) + loss(k,173) = (rxt(k,339)* y(k,295) + het_rates(k,51))* y(k,51) + prod(k,173) = (.100_r8*rxt(k,336)*y(k,253) +.150_r8*rxt(k,337)*y(k,258)) & + *y(k,252) +.120_r8*rxt(k,354)*y(k,158)*y(k,30) & + +.150_r8*rxt(k,390)*y(k,286)*y(k,258) + loss(k,163) = (rxt(k,340)* y(k,295) + rxt(k,36) + het_rates(k,52))* y(k,52) + prod(k,163) = (.360_r8*rxt(k,337)*y(k,252) +.360_r8*rxt(k,390)*y(k,286)) & + *y(k,258) + loss(k,238) = (rxt(k,306)* y(k,295) + het_rates(k,53))* y(k,53) + prod(k,238) = (rxt(k,303)*y(k,253) +.300_r8*rxt(k,325)*y(k,249) + & + .500_r8*rxt(k,368)*y(k,298) +.250_r8*rxt(k,401)*y(k,289) + & + .250_r8*rxt(k,431)*y(k,262) +.250_r8*rxt(k,445)*y(k,267) + & + .250_r8*rxt(k,449)*y(k,268) +.360_r8*rxt(k,475)*y(k,274) + & + .250_r8*rxt(k,492)*y(k,278) +.250_r8*rxt(k,496)*y(k,279) + & + .050_r8*rxt(k,587)*y(k,237) +.170_r8*rxt(k,595)*y(k,238) + & + .050_r8*rxt(k,607)*y(k,240) +.250_r8*rxt(k,615)*y(k,241) + & + .030_r8*rxt(k,627)*y(k,245) +.090_r8*rxt(k,646)*y(k,281) + & + .250_r8*rxt(k,655)*y(k,282) +.050_r8*rxt(k,666)*y(k,290) + & + .250_r8*rxt(k,675)*y(k,291) +.250_r8*rxt(k,694)*y(k,301))*y(k,253) + loss(k,129) = (rxt(k,307)* y(k,295) + rxt(k,37) + het_rates(k,54))* y(k,54) + prod(k,129) =rxt(k,304)*y(k,258)*y(k,253) + loss(k,279) = (rxt(k,219)* y(k,57) +rxt(k,275)* y(k,75) + (rxt(k,315) + & + rxt(k,316) +rxt(k,317))* y(k,294) +rxt(k,308)* y(k,295) + rxt(k,38) & + + rxt(k,39) + het_rates(k,55))* y(k,55) + prod(k,279) =.100_r8*rxt(k,354)*y(k,158)*y(k,30) + loss(k,131) = (rxt(k,288)* y(k,57) +rxt(k,271)* y(k,294) +rxt(k,289) & + * y(k,295) + rxt(k,134) + het_rates(k,56))* y(k,56) + prod(k,131) = 0._r8 + loss(k,315) = (rxt(k,330)* y(k,29) +rxt(k,281)* y(k,42) +rxt(k,218)* y(k,43) & + +rxt(k,283)* y(k,44) +rxt(k,286)* y(k,47) +rxt(k,219)* y(k,55) & + +rxt(k,288)* y(k,56) +rxt(k,231)* y(k,61) +rxt(k,220)* y(k,79) & + +rxt(k,221)* y(k,81) +rxt(k,240)* y(k,96) +rxt(k,224)* y(k,158) & + + (rxt(k,222) +rxt(k,223))* y(k,258) + het_rates(k,57))* y(k,57) + prod(k,315) = (4.000_r8*rxt(k,243)*y(k,34) +rxt(k,244)*y(k,35) + & + 2.000_r8*rxt(k,245)*y(k,37) +2.000_r8*rxt(k,246)*y(k,38) + & + 2.000_r8*rxt(k,247)*y(k,39) +rxt(k,248)*y(k,40) + & + 2.000_r8*rxt(k,249)*y(k,41) +rxt(k,250)*y(k,87) +rxt(k,280)*y(k,66) + & + rxt(k,295)*y(k,84) +rxt(k,296)*y(k,85) +rxt(k,297)*y(k,86))*y(k,294) & + + (rxt(k,137) +rxt(k,225)*y(k,253) +2.000_r8*rxt(k,226)*y(k,60) + & + rxt(k,228)*y(k,60) +rxt(k,230)*y(k,147) +rxt(k,235)*y(k,157) + & + rxt(k,236)*y(k,295) +rxt(k,259)*y(k,20) +rxt(k,801)*y(k,174))*y(k,60) & + + (rxt(k,239)*y(k,87) +3.000_r8*rxt(k,285)*y(k,45) + & + rxt(k,287)*y(k,47) +rxt(k,290)*y(k,84) +rxt(k,291)*y(k,85) + & + rxt(k,292)*y(k,86))*y(k,295) + (rxt(k,147) +rxt(k,238)*y(k,157)) & + *y(k,87) +rxt(k,118)*y(k,19) +4.000_r8*rxt(k,122)*y(k,34) +rxt(k,123) & + *y(k,35) +2.000_r8*rxt(k,125)*y(k,37) +2.000_r8*rxt(k,126)*y(k,38) & + +2.000_r8*rxt(k,127)*y(k,39) +rxt(k,128)*y(k,40) & + +2.000_r8*rxt(k,129)*y(k,41) +3.000_r8*rxt(k,132)*y(k,45) & + +rxt(k,133)*y(k,47) +2.000_r8*rxt(k,135)*y(k,58) & + +2.000_r8*rxt(k,136)*y(k,59) +rxt(k,138)*y(k,61) +rxt(k,141)*y(k,66) & + +rxt(k,144)*y(k,84) +rxt(k,145)*y(k,85) +rxt(k,146)*y(k,86) & + +rxt(k,150)*y(k,96) + loss(k,75) = ( + rxt(k,135) + het_rates(k,58))* y(k,58) + prod(k,75) = (rxt(k,885)*y(k,96) +rxt(k,890)*y(k,61) +rxt(k,891)*y(k,96) + & + rxt(k,895)*y(k,61) +rxt(k,896)*y(k,96) +rxt(k,900)*y(k,61))*y(k,87) & + +rxt(k,231)*y(k,61)*y(k,57) +rxt(k,227)*y(k,60)*y(k,60) + loss(k,58) = ( + rxt(k,136) + rxt(k,253) + het_rates(k,59))* y(k,59) + prod(k,58) =rxt(k,252)*y(k,60)*y(k,60) + loss(k,310) = ((rxt(k,258) +rxt(k,259) +rxt(k,260))* y(k,20) & + + 2._r8*(rxt(k,226) +rxt(k,227) +rxt(k,228) +rxt(k,252))* y(k,60) & + +rxt(k,230)* y(k,147) +rxt(k,232)* y(k,148) +rxt(k,235)* y(k,157) & + +rxt(k,801)* y(k,174) +rxt(k,225)* y(k,253) +rxt(k,229)* y(k,258) & + + (rxt(k,236) +rxt(k,237))* y(k,295) + rxt(k,137) + het_rates(k,60)) & + * y(k,60) + prod(k,310) = (rxt(k,223)*y(k,258) +rxt(k,224)*y(k,158) +rxt(k,240)*y(k,96)) & + *y(k,57) + (rxt(k,139) +rxt(k,233)*y(k,157))*y(k,61) & + + (rxt(k,241)*y(k,157) +rxt(k,242)*y(k,295))*y(k,96) + (rxt(k,151) + & + rxt(k,806)*y(k,174))*y(k,160) +2.000_r8*rxt(k,253)*y(k,59) & + +rxt(k,251)*y(k,294)*y(k,87) + loss(k,223) = (rxt(k,231)* y(k,57) + (rxt(k,890) +rxt(k,895) +rxt(k,900)) & + * y(k,87) +rxt(k,233)* y(k,157) +rxt(k,234)* y(k,295) + rxt(k,138) & + + rxt(k,139) + rxt(k,888) + rxt(k,893) + rxt(k,899) & + + het_rates(k,61))* y(k,61) + prod(k,223) =rxt(k,232)*y(k,148)*y(k,60) + loss(k,5) = ( + het_rates(k,62))* y(k,62) + prod(k,5) = 0._r8 + loss(k,271) = (rxt(k,319)* y(k,295) + het_rates(k,63))* y(k,63) + prod(k,271) = (rxt(k,301)*y(k,43) +.350_r8*rxt(k,321)*y(k,25) + & + rxt(k,346)*y(k,77) +.110_r8*rxt(k,347)*y(k,89) +rxt(k,361)*y(k,50) + & + rxt(k,376)*y(k,68) +rxt(k,380)*y(k,127) +rxt(k,387)*y(k,128) + & + .250_r8*rxt(k,398)*y(k,131) +.500_r8*rxt(k,399)*y(k,133) + & + 1.560_r8*rxt(k,405)*y(k,134) +1.060_r8*rxt(k,414)*y(k,98) + & + .760_r8*rxt(k,415)*y(k,99) +.420_r8*rxt(k,416)*y(k,100) + & + .230_r8*rxt(k,417)*y(k,101) +rxt(k,418)*y(k,103) + & + 1.500_r8*rxt(k,419)*y(k,105) +.350_r8*rxt(k,423)*y(k,108) + & + rxt(k,452)*y(k,111) +rxt(k,454)*y(k,112) + & + 2.000_r8*rxt(k,456)*y(k,114) +.060_r8*rxt(k,460)*y(k,115) + & + .040_r8*rxt(k,470)*y(k,118) +.630_r8*rxt(k,502)*y(k,139) + & + 2.000_r8*rxt(k,718)*y(k,204) +rxt(k,737)*y(k,206) + & + rxt(k,757)*y(k,210) +rxt(k,796)*y(k,161))*y(k,295) & + + (.650_r8*rxt(k,392)*y(k,286) +.400_r8*rxt(k,503)*y(k,260) + & + .550_r8*rxt(k,509)*y(k,267) +.550_r8*rxt(k,511)*y(k,268) + & + .550_r8*rxt(k,530)*y(k,278) +.550_r8*rxt(k,533)*y(k,279) + & + .860_r8*rxt(k,535)*y(k,284) +.750_r8*rxt(k,539)*y(k,293) + & + .170_r8*rxt(k,556)*y(k,254) +.400_r8*rxt(k,559)*y(k,285) + & + .350_r8*rxt(k,562)*y(k,287) +.910_r8*rxt(k,741)*y(k,306))*y(k,147) & + + (.510_r8*rxt(k,383)*y(k,284) +.320_r8*rxt(k,390)*y(k,286) + & + .260_r8*rxt(k,402)*y(k,289) +.260_r8*rxt(k,421)*y(k,260) + & + .600_r8*rxt(k,499)*y(k,293) +.070_r8*rxt(k,555)*y(k,254) + & + .160_r8*rxt(k,558)*y(k,285) +.140_r8*rxt(k,561)*y(k,287) + & + .530_r8*rxt(k,740)*y(k,306))*y(k,258) & + + (.900_r8*rxt(k,382)*y(k,284) +.650_r8*rxt(k,389)*y(k,286) + & + rxt(k,401)*y(k,289) +.280_r8*rxt(k,445)*y(k,267) + & + .280_r8*rxt(k,449)*y(k,268) +.280_r8*rxt(k,492)*y(k,278) + & + .280_r8*rxt(k,496)*y(k,279) +rxt(k,739)*y(k,306))*y(k,253) & + + (.630_r8*rxt(k,323)*y(k,26) +.560_r8*rxt(k,354)*y(k,30) + & + .650_r8*rxt(k,385)*y(k,126) +.560_r8*rxt(k,403)*y(k,132) + & + .350_r8*rxt(k,486)*y(k,109) +.300_r8*rxt(k,501)*y(k,139) + & + .170_r8*rxt(k,602)*y(k,4))*y(k,158) + (.860_r8*rxt(k,381)*y(k,284) + & + .650_r8*rxt(k,388)*y(k,286) +.550_r8*rxt(k,444)*y(k,267) + & + .550_r8*rxt(k,448)*y(k,268) +.550_r8*rxt(k,491)*y(k,278) + & + .550_r8*rxt(k,495)*y(k,279) +rxt(k,738)*y(k,306))*y(k,252) & + + (rxt(k,31) +rxt(k,32) +rxt(k,218)*y(k,57) +rxt(k,254)*y(k,18) + & + rxt(k,299)*y(k,149) +rxt(k,300)*y(k,157))*y(k,43) & + + (rxt(k,742)*y(k,149) +rxt(k,743)*y(k,302) +rxt(k,744)*y(k,304) + & + rxt(k,745)*y(k,307))*y(k,306) + (rxt(k,35) +rxt(k,360)*y(k,149)) & + *y(k,50) + (1.500_r8*rxt(k,53) +rxt(k,54))*y(k,103) + (rxt(k,154) + & + rxt(k,795)*y(k,157))*y(k,161) + (1.300_r8*rxt(k,391)*y(k,286) + & + .650_r8*rxt(k,393)*y(k,149))*y(k,286) +1.500_r8*rxt(k,22)*y(k,10) & + +.600_r8*rxt(k,25)*y(k,13) +rxt(k,26)*y(k,14) +rxt(k,33)*y(k,46) & + +rxt(k,286)*y(k,57)*y(k,47) +.380_r8*rxt(k,39)*y(k,55) +rxt(k,40) & + *y(k,64) +.500_r8*rxt(k,41)*y(k,68) +rxt(k,43)*y(k,76) & + +2.000_r8*rxt(k,44)*y(k,77) +rxt(k,45)*y(k,89) +.330_r8*rxt(k,47) & + *y(k,97) +1.320_r8*rxt(k,48)*y(k,98) +1.740_r8*rxt(k,49)*y(k,99) & + +rxt(k,50)*y(k,100) +rxt(k,51)*y(k,101) +.550_r8*rxt(k,64)*y(k,115) & + +.550_r8*rxt(k,67)*y(k,118) +1.650_r8*rxt(k,72)*y(k,126) & + +.750_r8*rxt(k,74)*y(k,127) +.860_r8*rxt(k,75)*y(k,128) & + +.700_r8*rxt(k,79)*y(k,132) +rxt(k,83)*y(k,150) +1.500_r8*rxt(k,90) & + *y(k,199) +rxt(k,93)*y(k,202) +rxt(k,94)*y(k,203) +rxt(k,96)*y(k,205) & + +.600_r8*rxt(k,529)*y(k,278) +.600_r8*rxt(k,532)*y(k,279) & + +rxt(k,384)*y(k,284) +rxt(k,500)*y(k,293) + loss(k,247) = ( + rxt(k,40) + het_rates(k,64))* y(k,64) + prod(k,247) = (2.000_r8*rxt(k,335)*y(k,252) +.900_r8*rxt(k,336)*y(k,253) + & + .490_r8*rxt(k,337)*y(k,258) +rxt(k,338)*y(k,147) + & + rxt(k,381)*y(k,284) +2.000_r8*rxt(k,388)*y(k,286) + & + rxt(k,400)*y(k,289) +rxt(k,424)*y(k,261) +rxt(k,430)*y(k,262) + & + rxt(k,444)*y(k,267) +rxt(k,448)*y(k,268) +rxt(k,474)*y(k,274) + & + rxt(k,491)*y(k,278) +rxt(k,495)*y(k,279) +rxt(k,586)*y(k,237) + & + rxt(k,594)*y(k,238) +rxt(k,606)*y(k,240) +rxt(k,614)*y(k,241) + & + rxt(k,626)*y(k,245) +rxt(k,634)*y(k,246) +rxt(k,645)*y(k,281) + & + rxt(k,654)*y(k,282) +rxt(k,665)*y(k,290) +rxt(k,674)*y(k,291) + & + rxt(k,693)*y(k,301) +2.000_r8*rxt(k,701)*y(k,302) + & + rxt(k,709)*y(k,303) +2.000_r8*rxt(k,719)*y(k,304) + & + rxt(k,728)*y(k,305) +rxt(k,738)*y(k,306) + & + 2.000_r8*rxt(k,749)*y(k,307))*y(k,252) + (rxt(k,591)*y(k,237) + & + rxt(k,599)*y(k,238) +rxt(k,611)*y(k,240) +rxt(k,619)*y(k,241) + & + rxt(k,631)*y(k,245) +rxt(k,639)*y(k,246) +rxt(k,651)*y(k,281) + & + rxt(k,659)*y(k,282) +rxt(k,671)*y(k,290) +rxt(k,679)*y(k,291) + & + rxt(k,698)*y(k,301) +rxt(k,702)*y(k,253) + & + .490_r8*rxt(k,703)*y(k,258) +rxt(k,704)*y(k,147) + & + rxt(k,705)*y(k,149) +2.000_r8*rxt(k,706)*y(k,302) + & + 2.000_r8*rxt(k,707)*y(k,307) +rxt(k,714)*y(k,303) + & + 2.000_r8*rxt(k,724)*y(k,304) +rxt(k,733)*y(k,305) + & + rxt(k,743)*y(k,306))*y(k,302) + (rxt(k,592)*y(k,237) + & + rxt(k,600)*y(k,238) +rxt(k,612)*y(k,240) +rxt(k,620)*y(k,241) + & + rxt(k,632)*y(k,245) +rxt(k,640)*y(k,246) +rxt(k,652)*y(k,281) + & + rxt(k,660)*y(k,282) +rxt(k,672)*y(k,290) +rxt(k,680)*y(k,291) + & + rxt(k,699)*y(k,301) +rxt(k,715)*y(k,303) +rxt(k,720)*y(k,253) + & + .490_r8*rxt(k,721)*y(k,258) +rxt(k,722)*y(k,147) + & + rxt(k,723)*y(k,149) +2.000_r8*rxt(k,725)*y(k,304) + & + 2.000_r8*rxt(k,726)*y(k,307) +rxt(k,734)*y(k,305) + & + rxt(k,744)*y(k,306))*y(k,304) + (rxt(k,593)*y(k,237) + & + rxt(k,601)*y(k,238) +rxt(k,613)*y(k,240) +rxt(k,621)*y(k,241) + & + rxt(k,633)*y(k,245) +rxt(k,641)*y(k,246) +rxt(k,653)*y(k,281) + & + rxt(k,661)*y(k,282) +rxt(k,673)*y(k,290) +rxt(k,681)*y(k,291) + & + rxt(k,700)*y(k,301) +rxt(k,716)*y(k,303) +rxt(k,735)*y(k,305) + & + rxt(k,745)*y(k,306) +rxt(k,750)*y(k,253) + & + .490_r8*rxt(k,751)*y(k,258) +rxt(k,752)*y(k,147) + & + rxt(k,753)*y(k,149) +2.000_r8*rxt(k,754)*y(k,307))*y(k,307) & + + (rxt(k,310)*y(k,90) +rxt(k,319)*y(k,63) +rxt(k,339)*y(k,51) + & + .500_r8*rxt(k,340)*y(k,52) +.800_r8*rxt(k,345)*y(k,76) + & + rxt(k,346)*y(k,77) +rxt(k,348)*y(k,150) +.540_r8*rxt(k,414)*y(k,98) + & + .540_r8*rxt(k,415)*y(k,99) +.360_r8*rxt(k,418)*y(k,103) + & + .190_r8*rxt(k,423)*y(k,108) +.450_r8*rxt(k,502)*y(k,139) + & + 2.000_r8*rxt(k,718)*y(k,204) +3.000_r8*rxt(k,737)*y(k,206) + & + .290_r8*rxt(k,746)*y(k,208) +.290_r8*rxt(k,747)*y(k,209) + & + .290_r8*rxt(k,748)*y(k,207))*y(k,295) + (rxt(k,389)*y(k,253) + & + .490_r8*rxt(k,390)*y(k,258) +2.000_r8*rxt(k,391)*y(k,286) + & + rxt(k,392)*y(k,147) +rxt(k,393)*y(k,149))*y(k,286) & + + (.200_r8*rxt(k,354)*y(k,30) +.100_r8*rxt(k,403)*y(k,132) + & + .420_r8*rxt(k,486)*y(k,109) +.190_r8*rxt(k,642)*y(k,17))*y(k,158) & + +rxt(k,36)*y(k,52) +.440_r8*rxt(k,39)*y(k,55) +.170_r8*rxt(k,48) & + *y(k,98) +.280_r8*rxt(k,49)*y(k,99) +rxt(k,54)*y(k,103) & + +.400_r8*rxt(k,86)*y(k,163) +rxt(k,98)*y(k,207) +rxt(k,99)*y(k,208) & + +rxt(k,100)*y(k,209) + loss(k,90) = (rxt(k,279)* y(k,294) + rxt(k,140) + het_rates(k,65))* y(k,65) + prod(k,90) = (rxt(k,244)*y(k,35) +rxt(k,246)*y(k,38) + & + 2.000_r8*rxt(k,247)*y(k,39) +2.000_r8*rxt(k,248)*y(k,40) + & + rxt(k,249)*y(k,41) +rxt(k,270)*y(k,36) +2.000_r8*rxt(k,272)*y(k,80) + & + rxt(k,296)*y(k,85) +rxt(k,297)*y(k,86))*y(k,294) + (rxt(k,145) + & + rxt(k,291)*y(k,295))*y(k,85) + (rxt(k,146) +rxt(k,292)*y(k,295)) & + *y(k,86) +rxt(k,123)*y(k,35) +rxt(k,124)*y(k,36) +rxt(k,126)*y(k,38) & + +2.000_r8*rxt(k,127)*y(k,39) +2.000_r8*rxt(k,128)*y(k,40) & + +rxt(k,129)*y(k,41) +2.000_r8*rxt(k,142)*y(k,80) + loss(k,92) = (rxt(k,280)* y(k,294) + rxt(k,141) + het_rates(k,66))* y(k,66) + prod(k,92) = (rxt(k,144) +rxt(k,290)*y(k,295) +rxt(k,295)*y(k,294))*y(k,84) & + + (rxt(k,125) +rxt(k,245)*y(k,294))*y(k,37) + (rxt(k,126) + & + rxt(k,246)*y(k,294))*y(k,38) + loss(k,84) = (rxt(k,554)* y(k,295) + het_rates(k,67))* y(k,67) + prod(k,84) =.180_r8*rxt(k,574)*y(k,295)*y(k,228) + loss(k,155) = (rxt(k,376)* y(k,295) + rxt(k,41) + het_rates(k,68))* y(k,68) + prod(k,155) = (.070_r8*rxt(k,414)*y(k,98) +.170_r8*rxt(k,415)*y(k,99)) & + *y(k,295) +.600_r8*rxt(k,529)*y(k,278) +.600_r8*rxt(k,532)*y(k,279) + loss(k,104) = (rxt(k,793)* y(k,149) + (rxt(k,794) +rxt(k,808))* y(k,295) & + + het_rates(k,69))* y(k,69) + prod(k,104) = 0._r8 + loss(k,6) = ( + het_rates(k,70))* y(k,70) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,71))* y(k,71) + prod(k,7) = 0._r8 + loss(k,8) = ( + het_rates(k,72))* y(k,72) + prod(k,8) = 0._r8 + loss(k,9) = ( + rxt(k,901) + het_rates(k,73))* y(k,73) + prod(k,9) = 0._r8 + loss(k,68) = ( + rxt(k,42) + het_rates(k,74))* y(k,74) + prod(k,68) =rxt(k,341)*y(k,258)*y(k,257) + loss(k,217) = (rxt(k,275)* y(k,55) +rxt(k,276)* y(k,79) +rxt(k,278)* y(k,93) & + +rxt(k,277)* y(k,319) + het_rates(k,75))* y(k,75) + prod(k,217) = (rxt(k,248)*y(k,40) +rxt(k,270)*y(k,36) + & + 2.000_r8*rxt(k,279)*y(k,65) +rxt(k,280)*y(k,66))*y(k,294) +rxt(k,124) & + *y(k,36) +rxt(k,128)*y(k,40) +2.000_r8*rxt(k,140)*y(k,65) +rxt(k,141) & + *y(k,66) +rxt(k,148)*y(k,91) + loss(k,254) = (rxt(k,345)* y(k,295) + rxt(k,43) + het_rates(k,76))* y(k,76) + prod(k,254) = (.570_r8*rxt(k,503)*y(k,260) +.940_r8*rxt(k,513)*y(k,269) + & + .730_r8*rxt(k,515)*y(k,270) +.340_r8*rxt(k,521)*y(k,273) + & + .400_r8*rxt(k,525)*y(k,275) +.760_r8*rxt(k,537)*y(k,289))*y(k,147) & + + (.360_r8*rxt(k,402)*y(k,289) +.370_r8*rxt(k,421)*y(k,260) + & + .550_r8*rxt(k,457)*y(k,269) +.460_r8*rxt(k,461)*y(k,270) + & + .150_r8*rxt(k,471)*y(k,273) +.280_r8*rxt(k,479)*y(k,275))*y(k,258) & + + (.750_r8*rxt(k,400)*y(k,252) +.380_r8*rxt(k,401)*y(k,253)) & + *y(k,289) + (rxt(k,488)*y(k,122) +.070_r8*rxt(k,490)*y(k,123)) & + *y(k,295) +.330_r8*rxt(k,47)*y(k,97) +.500_r8*rxt(k,53)*y(k,103) & + +rxt(k,59)*y(k,110) +.500_r8*rxt(k,60)*y(k,111) +.500_r8*rxt(k,61) & + *y(k,112) +rxt(k,62)*y(k,113) +.720_r8*rxt(k,63)*y(k,114) & + +.830_r8*rxt(k,459)*y(k,158)*y(k,115) +.500_r8*rxt(k,80)*y(k,133) & + +.560_r8*rxt(k,81)*y(k,134) +rxt(k,344)*y(k,256) + loss(k,235) = (rxt(k,346)* y(k,295) + rxt(k,44) + rxt(k,811) & + + het_rates(k,77))* y(k,77) + prod(k,235) = (.230_r8*rxt(k,503)*y(k,260) +.130_r8*rxt(k,539)*y(k,293) + & + rxt(k,545)*y(k,243) +.400_r8*rxt(k,559)*y(k,285) + & + .170_r8*rxt(k,562)*y(k,287) +.700_r8*rxt(k,565)*y(k,296) + & + .600_r8*rxt(k,572)*y(k,314) +.340_r8*rxt(k,578)*y(k,316) + & + .170_r8*rxt(k,581)*y(k,318))*y(k,147) & + + (.170_r8*rxt(k,459)*y(k,115) +.170_r8*rxt(k,469)*y(k,118) + & + .170_r8*rxt(k,484)*y(k,121) +.660_r8*rxt(k,501)*y(k,139))*y(k,158) & + + (.150_r8*rxt(k,421)*y(k,260) +.100_r8*rxt(k,499)*y(k,293) + & + .160_r8*rxt(k,558)*y(k,285) +.070_r8*rxt(k,561)*y(k,287))*y(k,258) & + + (.650_r8*rxt(k,321)*y(k,25) +.200_r8*rxt(k,345)*y(k,76) + & + .890_r8*rxt(k,347)*y(k,89))*y(k,295) +rxt(k,21)*y(k,9) & + +.500_r8*rxt(k,60)*y(k,111) +.500_r8*rxt(k,61)*y(k,112) & + +.280_r8*rxt(k,63)*y(k,114) +.700_r8*rxt(k,87)*y(k,167) & + +.600_r8*rxt(k,115)*y(k,227) +.340_r8*rxt(k,116)*y(k,230) & + +.170_r8*rxt(k,117)*y(k,232) + loss(k,301) = (rxt(k,184)* y(k,158) + (rxt(k,178) +rxt(k,179) +rxt(k,180)) & + * y(k,258) + rxt(k,181) + het_rates(k,78))* y(k,78) + prod(k,301) = (rxt(k,185)*y(k,79) +rxt(k,188)*y(k,157) +rxt(k,206)*y(k,136) + & + rxt(k,301)*y(k,43) +rxt(k,796)*y(k,161) +rxt(k,802)*y(k,172) + & + rxt(k,807)*y(k,174))*y(k,295) + (rxt(k,168)*y(k,294) + & + rxt(k,176)*y(k,157) +rxt(k,220)*y(k,57) +rxt(k,276)*y(k,75))*y(k,79) & + + (rxt(k,38) +.330_r8*rxt(k,39) +rxt(k,316)*y(k,294))*y(k,55) & + + (rxt(k,143) +rxt(k,274)*y(k,294))*y(k,83) + (rxt(k,147) + & + rxt(k,251)*y(k,294))*y(k,87) + (rxt(k,2) +2.000_r8*rxt(k,3))*y(k,319) & + +2.000_r8*rxt(k,31)*y(k,43) +rxt(k,37)*y(k,54) +rxt(k,148)*y(k,91) + loss(k,251) = (rxt(k,220)* y(k,57) +rxt(k,276)* y(k,75) +rxt(k,176)* y(k,157) & + +rxt(k,168)* y(k,294) +rxt(k,185)* y(k,295) + het_rates(k,79)) & + * y(k,79) + prod(k,251) = (1.440_r8*rxt(k,39) +rxt(k,317)*y(k,294))*y(k,55) +rxt(k,32) & + *y(k,43) +rxt(k,178)*y(k,258)*y(k,78) +rxt(k,1)*y(k,319) + loss(k,62) = (rxt(k,272)* y(k,294) + rxt(k,142) + het_rates(k,80))* y(k,80) + prod(k,62) = 0._r8 + loss(k,237) = (rxt(k,221)* y(k,57) +rxt(k,177)* y(k,157) +rxt(k,186) & + * y(k,295) + rxt(k,4) + het_rates(k,81))* y(k,81) + prod(k,237) = (.660_r8*rxt(k,459)*y(k,115) +.660_r8*rxt(k,469)*y(k,118) + & + .660_r8*rxt(k,484)*y(k,121) +.030_r8*rxt(k,486)*y(k,109) + & + .660_r8*rxt(k,501)*y(k,139) +.220_r8*rxt(k,602)*y(k,4) + & + .170_r8*rxt(k,622)*y(k,7) +.320_r8*rxt(k,642)*y(k,17) + & + .330_r8*rxt(k,662)*y(k,125) +.020_r8*rxt(k,762)*y(k,212) + & + .040_r8*rxt(k,767)*y(k,213))*y(k,158) +rxt(k,192)*y(k,258)*y(k,258) & + +rxt(k,191)*y(k,295)*y(k,295) + loss(k,69) = ( + rxt(k,153) + het_rates(k,82))* y(k,82) + prod(k,69) =rxt(k,809)*y(k,319)*y(k,176) + loss(k,208) = (rxt(k,267)* y(k,157) + (rxt(k,273) +rxt(k,274))* y(k,294) & + +rxt(k,268)* y(k,295) + rxt(k,143) + het_rates(k,83))* y(k,83) + prod(k,208) = (rxt(k,254)*y(k,43) +rxt(k,255)*y(k,258))*y(k,18) + loss(k,91) = (rxt(k,295)* y(k,294) +rxt(k,290)* y(k,295) + rxt(k,144) & + + het_rates(k,84))* y(k,84) + prod(k,91) = 0._r8 + loss(k,93) = (rxt(k,296)* y(k,294) +rxt(k,291)* y(k,295) + rxt(k,145) & + + het_rates(k,85))* y(k,85) + prod(k,93) = 0._r8 + loss(k,108) = (rxt(k,297)* y(k,294) +rxt(k,292)* y(k,295) + rxt(k,146) & + + het_rates(k,86))* y(k,86) + prod(k,108) = 0._r8 + loss(k,304) = ((rxt(k,890) +rxt(k,895) +rxt(k,900))* y(k,61) + (rxt(k,892) + & + rxt(k,897))* y(k,95) + (rxt(k,885) +rxt(k,891) +rxt(k,896))* y(k,96) & + +rxt(k,238)* y(k,157) + (rxt(k,250) +rxt(k,251))* y(k,294) & + +rxt(k,239)* y(k,295) + rxt(k,147) + het_rates(k,87))* y(k,87) + prod(k,304) = (rxt(k,218)*y(k,43) +rxt(k,219)*y(k,55) +rxt(k,220)*y(k,79) + & + rxt(k,221)*y(k,81) +rxt(k,222)*y(k,258) +rxt(k,240)*y(k,96) + & + rxt(k,281)*y(k,42) +rxt(k,283)*y(k,44) +2.000_r8*rxt(k,286)*y(k,47) + & + rxt(k,288)*y(k,56) +rxt(k,330)*y(k,29))*y(k,57) +rxt(k,237)*y(k,295) & + *y(k,60) + loss(k,79) = (rxt(k,318)* y(k,294) +rxt(k,309)* y(k,295) + het_rates(k,88)) & + * y(k,88) + prod(k,79) = 0._r8 + loss(k,182) = (rxt(k,347)* y(k,295) + rxt(k,45) + het_rates(k,89))* y(k,89) + prod(k,182) = (.680_r8*rxt(k,482)*y(k,258) +.810_r8*rxt(k,527)*y(k,147)) & + *y(k,276) +.700_r8*rxt(k,484)*y(k,158)*y(k,121) + loss(k,227) = (rxt(k,310)* y(k,295) + het_rates(k,90))* y(k,90) + prod(k,227) = (.370_r8*rxt(k,323)*y(k,26) +.120_r8*rxt(k,354)*y(k,30) + & + .330_r8*rxt(k,385)*y(k,126) +.120_r8*rxt(k,403)*y(k,132) + & + .220_r8*rxt(k,486)*y(k,109) +.080_r8*rxt(k,642)*y(k,17) + & + .150_r8*rxt(k,762)*y(k,212) +.260_r8*rxt(k,767)*y(k,213))*y(k,158) & + + (.500_r8*rxt(k,311)*y(k,92) +.350_r8*rxt(k,321)*y(k,25) + & + .400_r8*rxt(k,422)*y(k,107))*y(k,295) & + + (.500_r8*rxt(k,312)*y(k,258) +rxt(k,314)*y(k,147))*y(k,259) & + +.410_r8*rxt(k,48)*y(k,98) + loss(k,107) = ( + rxt(k,148) + het_rates(k,91))* y(k,91) + prod(k,107) = (rxt(k,275)*y(k,55) +rxt(k,276)*y(k,79) +rxt(k,277)*y(k,319) + & + rxt(k,278)*y(k,93))*y(k,75) + loss(k,213) = (rxt(k,311)* y(k,295) + rxt(k,46) + het_rates(k,92))* y(k,92) + prod(k,213) = (.330_r8*rxt(k,486)*y(k,109) +.110_r8*rxt(k,642)*y(k,17) + & + .230_r8*rxt(k,762)*y(k,212) +.400_r8*rxt(k,767)*y(k,213))*y(k,158) & + +.500_r8*rxt(k,312)*y(k,259)*y(k,258) + loss(k,302) = (rxt(k,278)* y(k,75) +rxt(k,215)* y(k,295) + rxt(k,9) & + + het_rates(k,93))* y(k,93) + prod(k,302) = (rxt(k,831) +rxt(k,299)*y(k,43) +rxt(k,332)*y(k,46) + & + rxt(k,360)*y(k,50) +rxt(k,708)*y(k,203) +rxt(k,727)*y(k,205) + & + rxt(k,755)*y(k,202) +rxt(k,793)*y(k,69))*y(k,149) + (rxt(k,888) + & + rxt(k,893) +rxt(k,899) +rxt(k,890)*y(k,87) +rxt(k,895)*y(k,87) + & + rxt(k,900)*y(k,87))*y(k,61) + (2.000_r8*rxt(k,827) + & + 2.000_r8*rxt(k,884) +2.000_r8*rxt(k,887) +2.000_r8*rxt(k,898)) & + *y(k,138) + (rxt(k,886) +rxt(k,889) +rxt(k,894))*y(k,21) & + + (.500_r8*rxt(k,830) +rxt(k,214)*y(k,295))*y(k,148) +rxt(k,813) & + *y(k,97) +rxt(k,816)*y(k,107) +rxt(k,817)*y(k,108) +rxt(k,819) & + *y(k,110) +rxt(k,820)*y(k,111) +rxt(k,824)*y(k,115) +rxt(k,825) & + *y(k,116) +rxt(k,826)*y(k,118) +rxt(k,818)*y(k,121) +rxt(k,828) & + *y(k,139) +rxt(k,832)*y(k,162) +rxt(k,835)*y(k,214) +rxt(k,838) & + *y(k,219) +rxt(k,837)*y(k,220) +rxt(k,840)*y(k,223) +rxt(k,839) & + *y(k,224) + loss(k,128) = (rxt(k,193)* y(k,295) + rxt(k,10) + rxt(k,11) + rxt(k,216) & + + het_rates(k,94))* y(k,94) + prod(k,128) =rxt(k,212)*y(k,258)*y(k,148) + loss(k,195) = ((rxt(k,892) +rxt(k,897))* y(k,87) +rxt(k,269)* y(k,157) & + + rxt(k,149) + het_rates(k,95))* y(k,95) + prod(k,195) = (rxt(k,886) +rxt(k,889) +rxt(k,894))*y(k,21) & + +rxt(k,261)*y(k,258)*y(k,20) + loss(k,209) = (rxt(k,240)* y(k,57) + (rxt(k,885) +rxt(k,891) +rxt(k,896)) & + * y(k,87) +rxt(k,241)* y(k,157) +rxt(k,242)* y(k,295) + rxt(k,150) & + + het_rates(k,96))* y(k,96) + prod(k,209) = (rxt(k,888) +rxt(k,893) +rxt(k,899) +rxt(k,234)*y(k,295)) & + *y(k,61) +rxt(k,229)*y(k,258)*y(k,60) + loss(k,193) = (rxt(k,379)* y(k,295) + rxt(k,47) + rxt(k,813) & + + het_rates(k,97))* y(k,97) + prod(k,193) =rxt(k,378)*y(k,255)*y(k,147) + loss(k,153) = (rxt(k,414)* y(k,295) + rxt(k,48) + het_rates(k,98))* y(k,98) + prod(k,153) =.250_r8*rxt(k,529)*y(k,278) + loss(k,154) = (rxt(k,415)* y(k,295) + rxt(k,49) + het_rates(k,99))* y(k,99) + prod(k,154) =.250_r8*rxt(k,532)*y(k,279) + loss(k,136) = (rxt(k,416)* y(k,295) + rxt(k,50) + het_rates(k,100))* y(k,100) + prod(k,136) =.090_r8*rxt(k,489)*y(k,295)*y(k,123) +.150_r8*rxt(k,529) & + *y(k,278) + loss(k,140) = (rxt(k,417)* y(k,295) + rxt(k,51) + het_rates(k,101))* y(k,101) + prod(k,140) =.090_r8*rxt(k,489)*y(k,295)*y(k,123) +.150_r8*rxt(k,532) & + *y(k,279) + loss(k,258) = (rxt(k,362)* y(k,295) + rxt(k,52) + het_rates(k,102))* y(k,102) + prod(k,258) = (.500_r8*rxt(k,367)*y(k,170) +.500_r8*rxt(k,380)*y(k,127) + & + rxt(k,387)*y(k,128) +.250_r8*rxt(k,398)*y(k,131) + & + .220_r8*rxt(k,418)*y(k,103) +.500_r8*rxt(k,419)*y(k,105) + & + .190_r8*rxt(k,423)*y(k,108) +.280_r8*rxt(k,456)*y(k,114) + & + rxt(k,488)*y(k,122) +.070_r8*rxt(k,490)*y(k,123))*y(k,295) & + + (.290_r8*rxt(k,503)*y(k,260) +.730_r8*rxt(k,515)*y(k,270) + & + .870_r8*rxt(k,519)*y(k,272) +.330_r8*rxt(k,521)*y(k,273) + & + .070_r8*rxt(k,525)*y(k,275) +.860_r8*rxt(k,535)*y(k,284))*y(k,147) & + + (.510_r8*rxt(k,383)*y(k,284) +.190_r8*rxt(k,421)*y(k,260) + & + .460_r8*rxt(k,461)*y(k,270) +.440_r8*rxt(k,467)*y(k,272) + & + .150_r8*rxt(k,471)*y(k,273) +.060_r8*rxt(k,479)*y(k,275))*y(k,258) & + + (rxt(k,384) +.860_r8*rxt(k,381)*y(k,252) + & + .900_r8*rxt(k,382)*y(k,253))*y(k,284) & + + (.830_r8*rxt(k,469)*y(k,118) +.180_r8*rxt(k,682)*y(k,135)) & + *y(k,158) +.170_r8*rxt(k,47)*y(k,97) +.500_r8*rxt(k,53)*y(k,103) & + +rxt(k,59)*y(k,110) +.500_r8*rxt(k,60)*y(k,111) +.500_r8*rxt(k,61) & + *y(k,112) +rxt(k,62)*y(k,113) +.280_r8*rxt(k,63)*y(k,114) & + +.500_r8*rxt(k,74)*y(k,127) +.860_r8*rxt(k,75)*y(k,128) & + +.200_r8*rxt(k,368)*y(k,298)*y(k,253) + loss(k,263) = (rxt(k,418)* y(k,295) + rxt(k,53) + rxt(k,54) & + + het_rates(k,103))* y(k,103) + prod(k,263) = (.250_r8*rxt(k,431)*y(k,262) +.470_r8*rxt(k,445)*y(k,267) + & + .470_r8*rxt(k,449)*y(k,268) +.470_r8*rxt(k,492)*y(k,278) + & + .470_r8*rxt(k,496)*y(k,279))*y(k,253) & + + (.450_r8*rxt(k,509)*y(k,267) +.450_r8*rxt(k,511)*y(k,268) + & + .450_r8*rxt(k,530)*y(k,278) +.450_r8*rxt(k,533)*y(k,279))*y(k,147) & + + (.450_r8*rxt(k,444)*y(k,267) +.450_r8*rxt(k,448)*y(k,268) + & + .450_r8*rxt(k,491)*y(k,278) +.450_r8*rxt(k,495)*y(k,279))*y(k,252) & + +.450_r8*rxt(k,64)*y(k,115) +.450_r8*rxt(k,67)*y(k,118) & + +.130_r8*rxt(k,489)*y(k,295)*y(k,123) +rxt(k,82)*y(k,139) + loss(k,187) = (rxt(k,363)* y(k,295) + rxt(k,55) + rxt(k,56) & + + het_rates(k,104))* y(k,104) + prod(k,187) = (.500_r8*rxt(k,41) +rxt(k,376)*y(k,295))*y(k,68) & + + (.120_r8*rxt(k,482)*y(k,258) +.150_r8*rxt(k,527)*y(k,147)) & + *y(k,276) +.150_r8*rxt(k,415)*y(k,295)*y(k,99) & + +.130_r8*rxt(k,484)*y(k,158)*y(k,121) + loss(k,185) = (rxt(k,419)* y(k,295) + rxt(k,814) + het_rates(k,105)) & + * y(k,105) + prod(k,185) = (.080_r8*rxt(k,414)*y(k,98) +.180_r8*rxt(k,415)*y(k,99) + & + .580_r8*rxt(k,416)*y(k,100) +.770_r8*rxt(k,417)*y(k,101) + & + .190_r8*rxt(k,420)*y(k,106) +.040_r8*rxt(k,502)*y(k,139))*y(k,295) & + +rxt(k,57)*y(k,107) +rxt(k,58)*y(k,108) + loss(k,241) = (rxt(k,420)* y(k,295) + rxt(k,815) + het_rates(k,106)) & + * y(k,106) + prod(k,241) = (.080_r8*rxt(k,460)*y(k,115) +.150_r8*rxt(k,463)*y(k,116) + & + .130_r8*rxt(k,466)*y(k,117) +.040_r8*rxt(k,470)*y(k,118) + & + .070_r8*rxt(k,485)*y(k,121) +.850_r8*rxt(k,490)*y(k,123))*y(k,295) + loss(k,138) = (rxt(k,422)* y(k,295) + rxt(k,57) + rxt(k,816) & + + het_rates(k,107))* y(k,107) + prod(k,138) = (.200_r8*rxt(k,422)*y(k,107) +.400_r8*rxt(k,481)*y(k,120)) & + *y(k,295) + loss(k,218) = (rxt(k,423)* y(k,295) + rxt(k,58) + rxt(k,817) & + + het_rates(k,108))* y(k,108) + prod(k,218) = (.060_r8*rxt(k,423)*y(k,108) +.030_r8*rxt(k,472)*y(k,119) + & + .200_r8*rxt(k,485)*y(k,121))*y(k,295) + loss(k,229) = (rxt(k,473)* y(k,149) +rxt(k,486)* y(k,158) +rxt(k,487) & + * y(k,295) + het_rates(k,109))* y(k,109) + prod(k,229) = 0._r8 + loss(k,250) = (rxt(k,453)* y(k,295) + rxt(k,59) + rxt(k,819) & + + het_rates(k,110))* y(k,110) + prod(k,250) = (rxt(k,514)*y(k,269) +rxt(k,516)*y(k,270) + & + rxt(k,518)*y(k,271) +rxt(k,520)*y(k,272) +rxt(k,522)*y(k,273) + & + rxt(k,524)*y(k,274) +rxt(k,526)*y(k,275) +rxt(k,528)*y(k,276)) & + *y(k,147) + loss(k,204) = (rxt(k,452)* y(k,295) + rxt(k,60) + rxt(k,820) & + + het_rates(k,111))* y(k,111) + prod(k,204) =rxt(k,453)*y(k,295)*y(k,110) +rxt(k,540)*y(k,293)*y(k,147) + loss(k,260) = (rxt(k,454)* y(k,295) + rxt(k,61) + rxt(k,821) & + + het_rates(k,112))* y(k,112) + prod(k,260) =rxt(k,455)*y(k,295)*y(k,113) +rxt(k,504)*y(k,260)*y(k,147) & + +rxt(k,462)*y(k,270) +rxt(k,465)*y(k,271) + loss(k,234) = (rxt(k,455)* y(k,295) + rxt(k,62) + rxt(k,822) & + + het_rates(k,113))* y(k,113) + prod(k,234) = (.420_r8*rxt(k,457)*y(k,269) +.480_r8*rxt(k,461)*y(k,270) + & + .400_r8*rxt(k,464)*y(k,271) +.500_r8*rxt(k,467)*y(k,272) + & + .600_r8*rxt(k,471)*y(k,273) +.490_r8*rxt(k,479)*y(k,275) + & + .170_r8*rxt(k,482)*y(k,276) +.200_r8*rxt(k,499)*y(k,293))*y(k,258) & + +rxt(k,458)*y(k,269) +rxt(k,468)*y(k,272) +rxt(k,480)*y(k,275) & + +rxt(k,483)*y(k,276) + loss(k,170) = (rxt(k,456)* y(k,295) + rxt(k,63) + rxt(k,823) & + + het_rates(k,114))* y(k,114) + prod(k,170) =.080_r8*rxt(k,490)*y(k,295)*y(k,123) & + +.350_r8*rxt(k,421)*y(k,260)*y(k,258) + loss(k,272) = (rxt(k,459)* y(k,158) +rxt(k,460)* y(k,295) + rxt(k,64) & + + rxt(k,824) + het_rates(k,115))* y(k,115) + prod(k,272) = (rxt(k,512)*y(k,268) +rxt(k,534)*y(k,279))*y(k,147) & + + (.280_r8*rxt(k,475)*y(k,253) +.530_r8*rxt(k,477)*y(k,274)) & + *y(k,274) + loss(k,159) = (rxt(k,463)* y(k,295) + rxt(k,65) + rxt(k,825) & + + het_rates(k,116))* y(k,116) + prod(k,159) =rxt(k,506)*y(k,261)*y(k,147) + loss(k,150) = (rxt(k,466)* y(k,295) + rxt(k,66) + het_rates(k,117))* y(k,117) + prod(k,150) =rxt(k,508)*y(k,262)*y(k,147) + loss(k,273) = (rxt(k,469)* y(k,158) +rxt(k,470)* y(k,295) + rxt(k,67) & + + rxt(k,826) + het_rates(k,118))* y(k,118) + prod(k,273) = (rxt(k,510)*y(k,267) +rxt(k,531)*y(k,278))*y(k,147) & + + (.050_r8*rxt(k,475)*y(k,253) +.090_r8*rxt(k,477)*y(k,274)) & + *y(k,274) + loss(k,166) = (rxt(k,472)* y(k,295) + rxt(k,68) + het_rates(k,119))* y(k,119) + prod(k,166) = (.070_r8*rxt(k,475)*y(k,253) +.150_r8*rxt(k,477)*y(k,274)) & + *y(k,274) + loss(k,212) = (rxt(k,481)* y(k,295) + rxt(k,69) + het_rates(k,120))* y(k,120) + prod(k,212) =.230_r8*rxt(k,476)*y(k,274)*y(k,258) + loss(k,245) = (rxt(k,484)* y(k,158) +rxt(k,485)* y(k,295) + rxt(k,70) & + + rxt(k,818) + het_rates(k,121))* y(k,121) + prod(k,245) =.530_r8*rxt(k,476)*y(k,274)*y(k,258) + loss(k,186) = (rxt(k,488)* y(k,295) + het_rates(k,122))* y(k,122) + prod(k,186) = (.250_r8*rxt(k,425)*y(k,261) +.250_r8*rxt(k,431)*y(k,262) + & + .250_r8*rxt(k,445)*y(k,267) +.250_r8*rxt(k,449)*y(k,268) + & + .250_r8*rxt(k,492)*y(k,278) +.250_r8*rxt(k,496)*y(k,279))*y(k,253) + loss(k,264) = ((rxt(k,489) +rxt(k,490))* y(k,295) + rxt(k,71) & + + het_rates(k,123))* y(k,123) + prod(k,264) = (.940_r8*rxt(k,426)*y(k,261) +.940_r8*rxt(k,432)*y(k,262) + & + rxt(k,446)*y(k,267) +rxt(k,450)*y(k,268) +rxt(k,493)*y(k,278) + & + rxt(k,497)*y(k,279))*y(k,258) + loss(k,53) = (rxt(k,866)* y(k,295) + het_rates(k,124))* y(k,124) + prod(k,53) = 0._r8 + loss(k,201) = (rxt(k,644)* y(k,149) +rxt(k,662)* y(k,158) +rxt(k,663) & + * y(k,295) + het_rates(k,125))* y(k,125) + prod(k,201) = 0._r8 + loss(k,269) = (rxt(k,385)* y(k,158) +rxt(k,386)* y(k,295) + rxt(k,72) & + + rxt(k,73) + het_rates(k,126))* y(k,126) + prod(k,269) = (.040_r8*rxt(k,474)*y(k,252) +.020_r8*rxt(k,475)*y(k,253) + & + .020_r8*rxt(k,476)*y(k,258) +.160_r8*rxt(k,477)*y(k,274) + & + .040_r8*rxt(k,478)*y(k,149) +.040_r8*rxt(k,523)*y(k,147))*y(k,274) & + + (rxt(k,433) +rxt(k,430)*y(k,252) +.500_r8*rxt(k,431)*y(k,253) + & + .060_r8*rxt(k,432)*y(k,258) +rxt(k,507)*y(k,147))*y(k,262) & + + (rxt(k,51) +.140_r8*rxt(k,417)*y(k,295))*y(k,101) & + +.350_r8*rxt(k,415)*y(k,295)*y(k,99) +.410_r8*rxt(k,486)*y(k,158) & + *y(k,109) +rxt(k,66)*y(k,117) +.500_r8*rxt(k,68)*y(k,119) & + +.120_r8*rxt(k,69)*y(k,120) +.300_r8*rxt(k,71)*y(k,123) + loss(k,259) = (rxt(k,380)* y(k,295) + rxt(k,74) + het_rates(k,127))* y(k,127) + prod(k,259) = (.060_r8*rxt(k,513)*y(k,269) +.270_r8*rxt(k,515)*y(k,270) + & + .210_r8*rxt(k,521)*y(k,273) +.490_r8*rxt(k,525)*y(k,275) + & + .020_r8*rxt(k,527)*y(k,276) +rxt(k,536)*y(k,284) + & + .390_r8*rxt(k,539)*y(k,293))*y(k,147) & + + (.030_r8*rxt(k,457)*y(k,269) +.060_r8*rxt(k,461)*y(k,270) + & + .060_r8*rxt(k,471)*y(k,273) +.150_r8*rxt(k,479)*y(k,275) + & + .020_r8*rxt(k,482)*y(k,276) +.290_r8*rxt(k,499)*y(k,293))*y(k,258) & + + (.500_r8*rxt(k,452)*y(k,111) +.250_r8*rxt(k,454)*y(k,112) + & + .060_r8*rxt(k,460)*y(k,115) +.240_r8*rxt(k,502)*y(k,139))*y(k,295) & + +.510_r8*rxt(k,500)*y(k,293) + loss(k,233) = (rxt(k,387)* y(k,295) + rxt(k,75) + het_rates(k,128))* y(k,128) + prod(k,233) = (.550_r8*rxt(k,448)*y(k,252) +.280_r8*rxt(k,449)*y(k,253) + & + .550_r8*rxt(k,511)*y(k,147))*y(k,268) & + + (.550_r8*rxt(k,495)*y(k,252) +.280_r8*rxt(k,496)*y(k,253) + & + .550_r8*rxt(k,533)*y(k,147))*y(k,279) & + + (.090_r8*rxt(k,417)*y(k,101) +.250_r8*rxt(k,454)*y(k,112)) & + *y(k,295) +.550_r8*rxt(k,64)*y(k,115) +.410_r8*rxt(k,383)*y(k,284) & + *y(k,258) + loss(k,145) = (rxt(k,396)* y(k,295) + rxt(k,76) + het_rates(k,129))* y(k,129) + prod(k,145) =.800_r8*rxt(k,19)*y(k,1) +.800_r8*rxt(k,20)*y(k,2) & + +.800_r8*rxt(k,410)*y(k,236)*y(k,147) + loss(k,109) = (rxt(k,397)* y(k,295) + rxt(k,77) + het_rates(k,130))* y(k,130) + prod(k,109) =.800_r8*rxt(k,394)*y(k,288)*y(k,258) + loss(k,141) = (rxt(k,398)* y(k,295) + rxt(k,78) + rxt(k,407) & + + het_rates(k,131))* y(k,131) + prod(k,141) =rxt(k,406)*y(k,286)*y(k,148) + loss(k,270) = (rxt(k,403)* y(k,158) +rxt(k,404)* y(k,295) + rxt(k,79) & + + het_rates(k,132))* y(k,132) + prod(k,270) = (rxt(k,427) +rxt(k,424)*y(k,252) +.750_r8*rxt(k,425)*y(k,253) + & + .060_r8*rxt(k,426)*y(k,258) +rxt(k,505)*y(k,147))*y(k,261) & + + (.420_r8*rxt(k,474)*y(k,252) +.050_r8*rxt(k,475)*y(k,253) + & + .220_r8*rxt(k,476)*y(k,258) +.420_r8*rxt(k,478)*y(k,149) + & + .420_r8*rxt(k,523)*y(k,147))*y(k,274) + (rxt(k,50) + & + .230_r8*rxt(k,416)*y(k,295))*y(k,100) +.350_r8*rxt(k,414)*y(k,295) & + *y(k,98) +.170_r8*rxt(k,486)*y(k,158)*y(k,109) +rxt(k,65)*y(k,116) & + +.500_r8*rxt(k,68)*y(k,119) +.880_r8*rxt(k,69)*y(k,120) & + +.700_r8*rxt(k,71)*y(k,123) + loss(k,265) = (rxt(k,399)* y(k,295) + rxt(k,80) + het_rates(k,133))* y(k,133) + prod(k,265) = (rxt(k,517)*y(k,271) +.130_r8*rxt(k,519)*y(k,272) + & + .120_r8*rxt(k,521)*y(k,273) +.040_r8*rxt(k,525)*y(k,275) + & + .020_r8*rxt(k,527)*y(k,276) +rxt(k,538)*y(k,289) + & + .360_r8*rxt(k,539)*y(k,293))*y(k,147) & + + (.600_r8*rxt(k,464)*y(k,271) +.060_r8*rxt(k,467)*y(k,272) + & + .040_r8*rxt(k,471)*y(k,273) +.020_r8*rxt(k,479)*y(k,275) + & + .010_r8*rxt(k,482)*y(k,276) +.310_r8*rxt(k,499)*y(k,293))*y(k,258) & + + (.050_r8*rxt(k,423)*y(k,108) +.500_r8*rxt(k,452)*y(k,111) + & + .250_r8*rxt(k,454)*y(k,112) +.040_r8*rxt(k,470)*y(k,118) + & + .040_r8*rxt(k,502)*y(k,139))*y(k,295) +.490_r8*rxt(k,500)*y(k,293) + loss(k,239) = (rxt(k,405)* y(k,295) + rxt(k,81) + het_rates(k,134))* y(k,134) + prod(k,239) = (.550_r8*rxt(k,444)*y(k,252) +.280_r8*rxt(k,445)*y(k,253) + & + .550_r8*rxt(k,509)*y(k,147))*y(k,267) & + + (.550_r8*rxt(k,491)*y(k,252) +.280_r8*rxt(k,492)*y(k,253) + & + .550_r8*rxt(k,530)*y(k,147))*y(k,278) & + + (.190_r8*rxt(k,416)*y(k,100) +.250_r8*rxt(k,454)*y(k,112)) & + *y(k,295) +.550_r8*rxt(k,67)*y(k,118) +.460_r8*rxt(k,402)*y(k,289) & + *y(k,258) + loss(k,177) = (rxt(k,664)* y(k,149) +rxt(k,682)* y(k,158) +rxt(k,683) & + * y(k,295) + het_rates(k,135))* y(k,135) + prod(k,177) = 0._r8 + loss(k,134) = (rxt(k,194)* y(k,147) + (rxt(k,195) +rxt(k,196) +rxt(k,197)) & + * y(k,148) +rxt(k,206)* y(k,295) + rxt(k,198) + het_rates(k,136)) & + * y(k,136) + prod(k,134) =rxt(k,15)*y(k,147) + loss(k,80) = ((rxt(k,210) +rxt(k,211))* y(k,294) + rxt(k,12) & + + het_rates(k,137))* y(k,137) + prod(k,80) =rxt(k,195)*y(k,148)*y(k,136) + loss(k,102) = ( + rxt(k,13) + rxt(k,14) + rxt(k,217) + rxt(k,827) & + + rxt(k,884) + rxt(k,887) + rxt(k,898) + het_rates(k,138))* y(k,138) + prod(k,102) =rxt(k,213)*y(k,149)*y(k,148) + loss(k,274) = (rxt(k,501)* y(k,158) +rxt(k,502)* y(k,295) + rxt(k,82) & + + rxt(k,828) + het_rates(k,139))* y(k,139) + prod(k,274) = (.540_r8*rxt(k,474)*y(k,252) +.530_r8*rxt(k,475)*y(k,253) + & + 1.070_r8*rxt(k,477)*y(k,274) +.540_r8*rxt(k,478)*y(k,149) + & + .540_r8*rxt(k,523)*y(k,147))*y(k,274) & + + (.040_r8*rxt(k,460)*y(k,115) +.030_r8*rxt(k,470)*y(k,118) + & + .050_r8*rxt(k,472)*y(k,119) +.020_r8*rxt(k,481)*y(k,120) + & + .090_r8*rxt(k,485)*y(k,121))*y(k,295) +rxt(k,70)*y(k,121) + loss(k,10) = ( + het_rates(k,140))* y(k,140) + prod(k,10) = 0._r8 + loss(k,11) = ( + het_rates(k,141))* y(k,141) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,142))* y(k,142) + prod(k,12) = 0._r8 + loss(k,59) = (rxt(k,810)* y(k,295) + het_rates(k,143))* y(k,143) + prod(k,59) = 0._r8 + loss(k,13) = ( + rxt(k,829) + het_rates(k,144))* y(k,144) + prod(k,13) = 0._r8 + loss(k,14) = ( + rxt(k,903) + het_rates(k,145))* y(k,145) + prod(k,14) = 0._r8 + loss(k,15) = ( + rxt(k,902) + het_rates(k,146))* y(k,146) + prod(k,15) = 0._r8 + loss(k,303) = (rxt(k,262)* y(k,20) +rxt(k,230)* y(k,60) +rxt(k,194)* y(k,136) & + +rxt(k,203)* y(k,149) +rxt(k,209)* y(k,157) +rxt(k,208)* y(k,158) & + +rxt(k,542)* y(k,235) + (rxt(k,410) +rxt(k,411))* y(k,236) & + +rxt(k,589)* y(k,237) +rxt(k,597)* y(k,238) +rxt(k,609)* y(k,240) & + +rxt(k,617)* y(k,241) +rxt(k,545)* y(k,243) +rxt(k,629)* y(k,245) & + +rxt(k,637)* y(k,246) +rxt(k,550)* y(k,248) +rxt(k,327)* y(k,249) & + +rxt(k,357)* y(k,250) +rxt(k,552)* y(k,251) +rxt(k,338)* y(k,252) & + +rxt(k,305)* y(k,253) +rxt(k,556)* y(k,254) + (rxt(k,377) + & + rxt(k,378))* y(k,255) +rxt(k,342)* y(k,257) +rxt(k,207)* y(k,258) & + +rxt(k,314)* y(k,259) + (rxt(k,503) +rxt(k,504))* y(k,260) & + + (rxt(k,505) +rxt(k,506))* y(k,261) + (rxt(k,507) +rxt(k,508)) & + * y(k,262) + (rxt(k,509) +rxt(k,510))* y(k,267) + (rxt(k,511) + & + rxt(k,512))* y(k,268) + (rxt(k,513) +rxt(k,514))* y(k,269) & + + (rxt(k,515) +rxt(k,516))* y(k,270) + (rxt(k,517) +rxt(k,518)) & + * y(k,271) + (rxt(k,519) +rxt(k,520))* y(k,272) + (rxt(k,521) + & + rxt(k,522))* y(k,273) + (rxt(k,523) +rxt(k,524))* y(k,274) & + + (rxt(k,525) +rxt(k,526))* y(k,275) + (rxt(k,527) +rxt(k,528)) & + * y(k,276) + (rxt(k,530) +rxt(k,531))* y(k,278) + (rxt(k,533) + & + rxt(k,534))* y(k,279) +rxt(k,649)* y(k,281) +rxt(k,657)* y(k,282) & + + (rxt(k,535) +rxt(k,536))* y(k,284) +rxt(k,559)* y(k,285) & + +rxt(k,392)* y(k,286) +rxt(k,562)* y(k,287) +rxt(k,395)* y(k,288) & + + (rxt(k,537) +rxt(k,538))* y(k,289) +rxt(k,669)* y(k,290) & + +rxt(k,677)* y(k,291) + (rxt(k,539) +rxt(k,540))* y(k,293) & + +rxt(k,565)* y(k,296) +rxt(k,366)* y(k,297) +rxt(k,370)* y(k,298) & + +rxt(k,688)* y(k,299) +rxt(k,692)* y(k,300) +rxt(k,696)* y(k,301) & + +rxt(k,704)* y(k,302) +rxt(k,712)* y(k,303) +rxt(k,722)* y(k,304) & + +rxt(k,731)* y(k,305) +rxt(k,741)* y(k,306) +rxt(k,752)* y(k,307) & + +rxt(k,761)* y(k,308) +rxt(k,766)* y(k,309) +rxt(k,773)* y(k,310) & + +rxt(k,777)* y(k,311) +rxt(k,781)* y(k,312) +rxt(k,785)* y(k,313) & + +rxt(k,572)* y(k,314) +rxt(k,578)* y(k,316) +rxt(k,581)* y(k,318) & + + rxt(k,15) + het_rates(k,147))* y(k,147) + prod(k,303) = (rxt(k,16) +.500_r8*rxt(k,830) +2.000_r8*rxt(k,196)*y(k,136) + & + rxt(k,199)*y(k,157) +rxt(k,803)*y(k,174))*y(k,148) + (rxt(k,198) + & + rxt(k,206)*y(k,295))*y(k,136) +2.000_r8*rxt(k,210)*y(k,294)*y(k,137) & + +rxt(k,14)*y(k,138) +rxt(k,17)*y(k,149) + loss(k,312) = (rxt(k,263)* y(k,20) +rxt(k,232)* y(k,60) + (rxt(k,195) + & + rxt(k,196) +rxt(k,197))* y(k,136) +rxt(k,213)* y(k,149) & + + (rxt(k,199) +rxt(k,201))* y(k,157) +rxt(k,200)* y(k,158) & + +rxt(k,567)* y(k,165) +rxt(k,803)* y(k,174) +rxt(k,570)* y(k,235) & + +rxt(k,351)* y(k,252) +rxt(k,557)* y(k,254) +rxt(k,212)* y(k,258) & + +rxt(k,560)* y(k,285) +rxt(k,406)* y(k,286) +rxt(k,563)* y(k,287) & + +rxt(k,214)* y(k,295) +rxt(k,684)* y(k,302) +rxt(k,685)* y(k,304) & + +rxt(k,686)* y(k,307) + rxt(k,16) + rxt(k,830) + het_rates(k,148)) & + * y(k,148) + prod(k,312) = (2.000_r8*rxt(k,203)*y(k,149) +rxt(k,207)*y(k,258) + & + rxt(k,208)*y(k,158) +rxt(k,209)*y(k,157) +rxt(k,230)*y(k,60) + & + rxt(k,262)*y(k,20) +rxt(k,305)*y(k,253) +rxt(k,314)*y(k,259) + & + rxt(k,327)*y(k,249) +rxt(k,338)*y(k,252) +rxt(k,342)*y(k,257) + & + rxt(k,357)*y(k,250) +rxt(k,366)*y(k,297) +rxt(k,370)*y(k,298) + & + rxt(k,377)*y(k,255) +rxt(k,392)*y(k,286) +rxt(k,395)*y(k,288) + & + rxt(k,410)*y(k,236) +rxt(k,503)*y(k,260) +rxt(k,505)*y(k,261) + & + rxt(k,507)*y(k,262) +rxt(k,509)*y(k,267) +rxt(k,511)*y(k,268) + & + rxt(k,513)*y(k,269) +1.730_r8*rxt(k,515)*y(k,270) + & + rxt(k,517)*y(k,271) +rxt(k,519)*y(k,272) +rxt(k,521)*y(k,273) + & + 1.460_r8*rxt(k,523)*y(k,274) +rxt(k,525)*y(k,275) + & + rxt(k,527)*y(k,276) +rxt(k,530)*y(k,278) +rxt(k,533)*y(k,279) + & + rxt(k,535)*y(k,284) +rxt(k,537)*y(k,289) +rxt(k,539)*y(k,293) + & + rxt(k,542)*y(k,235) +rxt(k,545)*y(k,243) +rxt(k,550)*y(k,248) + & + rxt(k,552)*y(k,251) +rxt(k,556)*y(k,254) +rxt(k,559)*y(k,285) + & + rxt(k,562)*y(k,287) +rxt(k,565)*y(k,296) +rxt(k,572)*y(k,314) + & + rxt(k,578)*y(k,316) +rxt(k,581)*y(k,318) + & + 1.860_r8*rxt(k,589)*y(k,237) +.770_r8*rxt(k,597)*y(k,238) + & + 1.860_r8*rxt(k,609)*y(k,240) +.700_r8*rxt(k,617)*y(k,241) + & + 1.390_r8*rxt(k,629)*y(k,245) +.750_r8*rxt(k,637)*y(k,246) + & + 1.360_r8*rxt(k,649)*y(k,281) +.770_r8*rxt(k,657)*y(k,282) + & + 1.820_r8*rxt(k,669)*y(k,290) +.710_r8*rxt(k,677)*y(k,291) + & + .700_r8*rxt(k,688)*y(k,299) +.700_r8*rxt(k,692)*y(k,300) + & + .700_r8*rxt(k,696)*y(k,301) +rxt(k,704)*y(k,302) + & + .830_r8*rxt(k,712)*y(k,303) +rxt(k,722)*y(k,304) + & + .700_r8*rxt(k,731)*y(k,305) +.910_r8*rxt(k,741)*y(k,306) + & + rxt(k,752)*y(k,307) +.700_r8*rxt(k,761)*y(k,308) + & + .700_r8*rxt(k,766)*y(k,309) +.700_r8*rxt(k,773)*y(k,310) + & + .700_r8*rxt(k,777)*y(k,311) +.700_r8*rxt(k,781)*y(k,312) + & + .700_r8*rxt(k,785)*y(k,313))*y(k,147) + (rxt(k,18) + & + rxt(k,202)*y(k,258) +rxt(k,204)*y(k,157) +rxt(k,205)*y(k,295) + & + rxt(k,374)*y(k,16) +rxt(k,393)*y(k,286) + & + 1.460_r8*rxt(k,478)*y(k,274) +2.000_r8*rxt(k,590)*y(k,237) + & + rxt(k,598)*y(k,238) +2.000_r8*rxt(k,610)*y(k,240) + & + rxt(k,618)*y(k,241) +1.500_r8*rxt(k,630)*y(k,245) + & + rxt(k,638)*y(k,246) +1.460_r8*rxt(k,650)*y(k,281) + & + rxt(k,658)*y(k,282) +1.950_r8*rxt(k,670)*y(k,290) + & + rxt(k,678)*y(k,291) +rxt(k,697)*y(k,301) +rxt(k,705)*y(k,302) + & + rxt(k,713)*y(k,303) +rxt(k,723)*y(k,304) +rxt(k,732)*y(k,305) + & + rxt(k,742)*y(k,306) +rxt(k,753)*y(k,307) +rxt(k,759)*y(k,212) + & + .500_r8*rxt(k,764)*y(k,213))*y(k,149) + (rxt(k,193)*y(k,94) + & + rxt(k,348)*y(k,150) +rxt(k,364)*y(k,151) + & + .500_r8*rxt(k,380)*y(k,127) +rxt(k,408)*y(k,1) + & + .400_r8*rxt(k,422)*y(k,107) +.190_r8*rxt(k,423)*y(k,108) + & + rxt(k,452)*y(k,111) +.500_r8*rxt(k,454)*y(k,112) + & + .080_r8*rxt(k,460)*y(k,115) +.150_r8*rxt(k,463)*y(k,116) + & + .130_r8*rxt(k,466)*y(k,117) +.040_r8*rxt(k,470)*y(k,118) + & + .070_r8*rxt(k,485)*y(k,121) +.040_r8*rxt(k,502)*y(k,139) + & + rxt(k,718)*y(k,204) +rxt(k,737)*y(k,206) +rxt(k,757)*y(k,210) + & + rxt(k,769)*y(k,214) +rxt(k,783)*y(k,221) +rxt(k,787)*y(k,223)) & + *y(k,295) + (1.640_r8*rxt(k,585)*y(k,237) +rxt(k,586)*y(k,252) + & + .820_r8*rxt(k,587)*y(k,253) +.700_r8*rxt(k,588)*y(k,258) + & + rxt(k,591)*y(k,302) +rxt(k,592)*y(k,304) +rxt(k,593)*y(k,307)) & + *y(k,237) + (1.640_r8*rxt(k,605)*y(k,240) +rxt(k,606)*y(k,252) + & + .820_r8*rxt(k,607)*y(k,253) +.500_r8*rxt(k,608)*y(k,258) + & + rxt(k,611)*y(k,302) +rxt(k,612)*y(k,304) +rxt(k,613)*y(k,307)) & + *y(k,240) + (.940_r8*rxt(k,625)*y(k,245) + & + .500_r8*rxt(k,626)*y(k,252) +.360_r8*rxt(k,627)*y(k,253) + & + .240_r8*rxt(k,628)*y(k,258) +.500_r8*rxt(k,631)*y(k,302) + & + .500_r8*rxt(k,632)*y(k,304) +.500_r8*rxt(k,633)*y(k,307))*y(k,245) & + + (.460_r8*rxt(k,645)*y(k,252) +.310_r8*rxt(k,646)*y(k,253) + & + .230_r8*rxt(k,647)*y(k,258) +.860_r8*rxt(k,648)*y(k,281) + & + .460_r8*rxt(k,651)*y(k,302) +.460_r8*rxt(k,652)*y(k,304) + & + .460_r8*rxt(k,653)*y(k,307))*y(k,281) & + + (.950_r8*rxt(k,665)*y(k,252) +.770_r8*rxt(k,666)*y(k,253) + & + .480_r8*rxt(k,667)*y(k,258) +1.540_r8*rxt(k,668)*y(k,290) + & + .950_r8*rxt(k,671)*y(k,302) +.950_r8*rxt(k,672)*y(k,304) + & + .950_r8*rxt(k,673)*y(k,307))*y(k,290) & + + (.170_r8*rxt(k,459)*y(k,115) +.170_r8*rxt(k,469)*y(k,118) + & + .170_r8*rxt(k,484)*y(k,121) +.170_r8*rxt(k,501)*y(k,139))*y(k,158) & + + (.460_r8*rxt(k,474)*y(k,252) +.070_r8*rxt(k,475)*y(k,253) + & + .240_r8*rxt(k,476)*y(k,258) +.160_r8*rxt(k,477)*y(k,274))*y(k,274) & + + (rxt(k,11) +rxt(k,216))*y(k,94) + (rxt(k,78) +rxt(k,407))*y(k,131) & + + (rxt(k,13) +rxt(k,217))*y(k,138) + (.600_r8*rxt(k,86) +rxt(k,352)) & + *y(k,163) + (rxt(k,95) +rxt(k,790))*y(k,204) + (rxt(k,97) + & + rxt(k,791))*y(k,206) + (rxt(k,101) +rxt(k,792))*y(k,210) +rxt(k,19) & + *y(k,1) +rxt(k,120)*y(k,21) +rxt(k,139)*y(k,61) +rxt(k,9)*y(k,93) & + +rxt(k,47)*y(k,97) +rxt(k,57)*y(k,107) +rxt(k,58)*y(k,108) & + +2.000_r8*rxt(k,59)*y(k,110) +2.000_r8*rxt(k,60)*y(k,111) +rxt(k,61) & + *y(k,112) +rxt(k,62)*y(k,113) +rxt(k,64)*y(k,115) +rxt(k,65)*y(k,116) & + +rxt(k,66)*y(k,117) +rxt(k,67)*y(k,118) +rxt(k,68)*y(k,119) & + +rxt(k,69)*y(k,120) +.750_r8*rxt(k,74)*y(k,127) +.750_r8*rxt(k,80) & + *y(k,133) +rxt(k,82)*y(k,139) +rxt(k,83)*y(k,150) +rxt(k,84)*y(k,151) & + +rxt(k,85)*y(k,162) +rxt(k,575)*y(k,164) +rxt(k,103)*y(k,214) & + +.500_r8*rxt(k,105)*y(k,217) +.460_r8*rxt(k,106)*y(k,218) & + +rxt(k,107)*y(k,219) +.460_r8*rxt(k,108)*y(k,220) +rxt(k,109) & + *y(k,221) +rxt(k,110)*y(k,222) +rxt(k,111)*y(k,223) +rxt(k,112) & + *y(k,224) +.460_r8*rxt(k,461)*y(k,270)*y(k,258) + loss(k,311) = (rxt(k,584)* y(k,4) +rxt(k,604)* y(k,7) +rxt(k,374)* y(k,16) & + +rxt(k,624)* y(k,17) +rxt(k,353)* y(k,30) +rxt(k,299)* y(k,43) & + +rxt(k,332)* y(k,46) +rxt(k,360)* y(k,50) +rxt(k,793)* y(k,69) & + +rxt(k,473)* y(k,109) +rxt(k,644)* y(k,125) +rxt(k,664)* y(k,135) & + +rxt(k,203)* y(k,147) +rxt(k,213)* y(k,148) +rxt(k,204)* y(k,157) & + +rxt(k,755)* y(k,202) +rxt(k,708)* y(k,203) +rxt(k,727)* y(k,205) & + +rxt(k,759)* y(k,212) +rxt(k,764)* y(k,213) +rxt(k,590)* y(k,237) & + +rxt(k,598)* y(k,238) +rxt(k,610)* y(k,240) +rxt(k,618)* y(k,241) & + +rxt(k,630)* y(k,245) +rxt(k,638)* y(k,246) +rxt(k,202)* y(k,258) & + +rxt(k,478)* y(k,274) +rxt(k,650)* y(k,281) +rxt(k,658)* y(k,282) & + +rxt(k,393)* y(k,286) +rxt(k,670)* y(k,290) +rxt(k,678)* y(k,291) & + +rxt(k,205)* y(k,295) +rxt(k,697)* y(k,301) +rxt(k,705)* y(k,302) & + +rxt(k,713)* y(k,303) +rxt(k,723)* y(k,304) +rxt(k,732)* y(k,305) & + +rxt(k,742)* y(k,306) +rxt(k,753)* y(k,307) + rxt(k,17) + rxt(k,18) & + + rxt(k,831) + het_rates(k,149))* y(k,149) + prod(k,311) = (rxt(k,138) +rxt(k,231)*y(k,57) +rxt(k,233)*y(k,157) + & + rxt(k,234)*y(k,295))*y(k,61) + (rxt(k,13) +rxt(k,14) +rxt(k,217)) & + *y(k,138) + (rxt(k,215)*y(k,93) +rxt(k,349)*y(k,163) + & + rxt(k,398)*y(k,131))*y(k,295) + (rxt(k,121) +rxt(k,264)*y(k,157)) & + *y(k,21) + (rxt(k,200)*y(k,158) +rxt(k,201)*y(k,157))*y(k,148) & + +rxt(k,278)*y(k,93)*y(k,75) +rxt(k,10)*y(k,94) +.400_r8*rxt(k,86) & + *y(k,163) + loss(k,232) = (rxt(k,348)* y(k,295) + rxt(k,83) + het_rates(k,150))* y(k,150) + prod(k,232) = (.870_r8*rxt(k,519)*y(k,272) +.330_r8*rxt(k,521)*y(k,273) + & + .070_r8*rxt(k,525)*y(k,275) +.150_r8*rxt(k,527)*y(k,276) + & + .120_r8*rxt(k,539)*y(k,293))*y(k,147) & + + (.440_r8*rxt(k,467)*y(k,272) +.150_r8*rxt(k,471)*y(k,273) + & + .060_r8*rxt(k,479)*y(k,275) +.120_r8*rxt(k,482)*y(k,276) + & + .100_r8*rxt(k,499)*y(k,293))*y(k,258) & + + (.830_r8*rxt(k,469)*y(k,118) +.130_r8*rxt(k,484)*y(k,121) + & + .220_r8*rxt(k,501)*y(k,139))*y(k,158) +.250_r8*rxt(k,80)*y(k,133) & + +.100_r8*rxt(k,502)*y(k,295)*y(k,139) + loss(k,236) = (rxt(k,364)* y(k,295) + rxt(k,84) + het_rates(k,151))* y(k,151) + prod(k,236) = (.940_r8*rxt(k,513)*y(k,269) +.340_r8*rxt(k,521)*y(k,273) + & + .400_r8*rxt(k,525)*y(k,275) +.810_r8*rxt(k,527)*y(k,276) + & + .130_r8*rxt(k,539)*y(k,293))*y(k,147) & + + (.550_r8*rxt(k,457)*y(k,269) +.150_r8*rxt(k,471)*y(k,273) + & + .280_r8*rxt(k,479)*y(k,275) +.680_r8*rxt(k,482)*y(k,276) + & + .100_r8*rxt(k,499)*y(k,293))*y(k,258) & + + (.500_r8*rxt(k,380)*y(k,127) +.500_r8*rxt(k,399)*y(k,133) + & + .350_r8*rxt(k,423)*y(k,108) +.350_r8*rxt(k,502)*y(k,139))*y(k,295) & + + (.830_r8*rxt(k,459)*y(k,115) +.700_r8*rxt(k,484)*y(k,121) + & + .610_r8*rxt(k,501)*y(k,139))*y(k,158) +rxt(k,353)*y(k,149)*y(k,30) & + +.250_r8*rxt(k,74)*y(k,127) + loss(k,16) = ( + het_rates(k,152))* y(k,152) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,153))* y(k,153) + prod(k,17) = 0._r8 + loss(k,18) = ( + het_rates(k,154))* y(k,154) + prod(k,18) = 0._r8 + loss(k,19) = ( + het_rates(k,155))* y(k,155) + prod(k,19) = 0._r8 + loss(k,20) = ( + het_rates(k,156))* y(k,156) + prod(k,20) = 0._r8 + loss(k,305) = (rxt(k,265)* y(k,20) +rxt(k,264)* y(k,21) +rxt(k,300)* y(k,43) & + +rxt(k,235)* y(k,60) +rxt(k,233)* y(k,61) +rxt(k,176)* y(k,79) & + +rxt(k,177)* y(k,81) +rxt(k,267)* y(k,83) +rxt(k,238)* y(k,87) & + +rxt(k,269)* y(k,95) +rxt(k,241)* y(k,96) +rxt(k,209)* y(k,147) & + + (rxt(k,199) +rxt(k,201))* y(k,148) +rxt(k,204)* y(k,149) & + + 2._r8*rxt(k,174)* y(k,157) +rxt(k,173)* y(k,158) +rxt(k,795) & + * y(k,161) +rxt(k,182)* y(k,258) +rxt(k,188)* y(k,295) + rxt(k,175) & + + het_rates(k,157))* y(k,157) + prod(k,305) = (rxt(k,198) +rxt(k,194)*y(k,147) +rxt(k,195)*y(k,148))*y(k,136) & + + (rxt(k,155) +rxt(k,804))*y(k,174) + (rxt(k,170) +rxt(k,171)) & + *y(k,294) +rxt(k,119)*y(k,20) +.180_r8*rxt(k,39)*y(k,55) +rxt(k,137) & + *y(k,60) +rxt(k,40)*y(k,64) +rxt(k,180)*y(k,258)*y(k,78) +rxt(k,14) & + *y(k,138) +rxt(k,15)*y(k,147) +rxt(k,16)*y(k,148) +rxt(k,18)*y(k,149) & + +rxt(k,8)*y(k,158) +rxt(k,151)*y(k,160) +rxt(k,797)*y(k,172) & + +rxt(k,156)*y(k,175) +rxt(k,157)*y(k,176) +rxt(k,190)*y(k,295) & + *y(k,295) +rxt(k,3)*y(k,319) + loss(k,313) = (rxt(k,602)* y(k,4) +rxt(k,622)* y(k,7) +rxt(k,642)* y(k,17) & + +rxt(k,256)* y(k,18) +rxt(k,323)* y(k,26) +rxt(k,354)* y(k,30) & + +rxt(k,224)* y(k,57) +rxt(k,184)* y(k,78) +rxt(k,486)* y(k,109) & + +rxt(k,459)* y(k,115) +rxt(k,469)* y(k,118) +rxt(k,484)* y(k,121) & + +rxt(k,662)* y(k,125) +rxt(k,385)* y(k,126) +rxt(k,403)* y(k,132) & + +rxt(k,682)* y(k,135) +rxt(k,501)* y(k,139) +rxt(k,208)* y(k,147) & + +rxt(k,200)* y(k,148) +rxt(k,173)* y(k,157) +rxt(k,568)* y(k,165) & + +rxt(k,799)* y(k,172) +rxt(k,805)* y(k,174) +rxt(k,762)* y(k,212) & + +rxt(k,767)* y(k,213) +rxt(k,183)* y(k,258) +rxt(k,172)* y(k,294) & + +rxt(k,189)* y(k,295) + rxt(k,7) + rxt(k,8) + het_rates(k,158)) & + * y(k,158) + prod(k,313) = (.150_r8*rxt(k,337)*y(k,252) +.150_r8*rxt(k,390)*y(k,286) + & + .150_r8*rxt(k,703)*y(k,302) +.150_r8*rxt(k,721)*y(k,304) + & + .150_r8*rxt(k,751)*y(k,307))*y(k,258) +rxt(k,175)*y(k,157) + loss(k,21) = ( + het_rates(k,159))* y(k,159) + prod(k,21) = 0._r8 + loss(k,111) = (rxt(k,806)* y(k,174) + rxt(k,151) + het_rates(k,160)) & + * y(k,160) + prod(k,111) = (rxt(k,228)*y(k,60) +rxt(k,258)*y(k,20))*y(k,60) + loss(k,119) = (rxt(k,795)* y(k,157) +rxt(k,796)* y(k,295) + rxt(k,154) & + + het_rates(k,161))* y(k,161) + prod(k,119) = 0._r8 + loss(k,82) = ( + rxt(k,85) + rxt(k,832) + het_rates(k,162))* y(k,162) + prod(k,82) = (rxt(k,379)*y(k,97) +.500_r8*rxt(k,399)*y(k,133))*y(k,295) + loss(k,147) = (rxt(k,349)* y(k,295) + rxt(k,86) + rxt(k,352) & + + het_rates(k,163))* y(k,163) + prod(k,147) =rxt(k,351)*y(k,252)*y(k,148) + loss(k,70) = ( + rxt(k,575) + het_rates(k,164))* y(k,164) + prod(k,70) =rxt(k,570)*y(k,235)*y(k,148) + loss(k,135) = (rxt(k,567)* y(k,148) +rxt(k,568)* y(k,158) + het_rates(k,165)) & + * y(k,165) + prod(k,135) = (.070_r8*rxt(k,554)*y(k,67) +.060_r8*rxt(k,566)*y(k,166) + & + .070_r8*rxt(k,582)*y(k,231))*y(k,295) +rxt(k,30)*y(k,33) & + +rxt(k,552)*y(k,251)*y(k,147) + loss(k,78) = (rxt(k,566)* y(k,295) + het_rates(k,166))* y(k,166) + prod(k,78) =.530_r8*rxt(k,543)*y(k,295)*y(k,8) + loss(k,112) = (rxt(k,569)* y(k,295) + rxt(k,87) + het_rates(k,167))* y(k,167) + prod(k,112) =rxt(k,564)*y(k,296)*y(k,258) + loss(k,22) = ( + het_rates(k,168))* y(k,168) + prod(k,22) = 0._r8 + loss(k,23) = ( + het_rates(k,169))* y(k,169) + prod(k,23) = 0._r8 + loss(k,148) = (rxt(k,367)* y(k,295) + rxt(k,88) + het_rates(k,170))* y(k,170) + prod(k,148) =rxt(k,365)*y(k,297)*y(k,258) + loss(k,122) = (rxt(k,371)* y(k,295) + rxt(k,89) + het_rates(k,171))* y(k,171) + prod(k,122) =.850_r8*rxt(k,369)*y(k,298)*y(k,258) + loss(k,143) = (rxt(k,799)* y(k,158) +rxt(k,802)* y(k,295) + rxt(k,797) & + + het_rates(k,172))* y(k,172) + prod(k,143) =rxt(k,154)*y(k,161) +rxt(k,155)*y(k,174) + loss(k,24) = ( + rxt(k,152) + het_rates(k,173))* y(k,173) + prod(k,24) = 0._r8 + loss(k,246) = (rxt(k,800)* y(k,20) +rxt(k,801)* y(k,60) +rxt(k,803)* y(k,148) & + +rxt(k,805)* y(k,158) +rxt(k,806)* y(k,160) +rxt(k,807)* y(k,295) & + + rxt(k,155) + rxt(k,804) + het_rates(k,174))* y(k,174) + prod(k,246) = (rxt(k,797) +rxt(k,799)*y(k,158) +rxt(k,802)*y(k,295))*y(k,172) & + +rxt(k,795)*y(k,161)*y(k,157) +rxt(k,156)*y(k,175) + loss(k,216) = (rxt(k,798)* y(k,295) + rxt(k,156) + het_rates(k,175)) & + * y(k,175) + prod(k,216) = (rxt(k,804) +rxt(k,800)*y(k,20) +rxt(k,801)*y(k,60) + & + rxt(k,803)*y(k,148) +rxt(k,805)*y(k,158) +rxt(k,806)*y(k,160) + & + rxt(k,807)*y(k,295))*y(k,174) + (rxt(k,793)*y(k,149) + & + rxt(k,794)*y(k,295) +.500_r8*rxt(k,808)*y(k,295))*y(k,69) & + +rxt(k,796)*y(k,295)*y(k,161) +rxt(k,157)*y(k,176) + loss(k,98) = (rxt(k,809)* y(k,319) + rxt(k,157) + het_rates(k,176))* y(k,176) + prod(k,98) =rxt(k,153)*y(k,82) +rxt(k,798)*y(k,295)*y(k,175) + loss(k,25) = ( + het_rates(k,177))* y(k,177) + prod(k,25) = 0._r8 + loss(k,26) = ( + het_rates(k,178))* y(k,178) + prod(k,26) = 0._r8 + loss(k,27) = ( + het_rates(k,179))* y(k,179) + prod(k,27) = 0._r8 + loss(k,28) = ( + het_rates(k,180))* y(k,180) + prod(k,28) = 0._r8 + loss(k,29) = ( + rxt(k,158) + het_rates(k,181))* y(k,181) + prod(k,29) = 0._r8 + loss(k,30) = ( + rxt(k,159) + het_rates(k,182))* y(k,182) + prod(k,30) = 0._r8 + loss(k,31) = ( + rxt(k,160) + het_rates(k,183))* y(k,183) + prod(k,31) = 0._r8 + loss(k,32) = ( + rxt(k,161) + het_rates(k,184))* y(k,184) + prod(k,32) = 0._r8 + loss(k,33) = ( + rxt(k,162) + het_rates(k,185))* y(k,185) + prod(k,33) = 0._r8 + loss(k,34) = ( + rxt(k,163) + het_rates(k,186))* y(k,186) + prod(k,34) = 0._r8 + loss(k,35) = ( + rxt(k,164) + het_rates(k,187))* y(k,187) + prod(k,35) = 0._r8 + loss(k,36) = ( + rxt(k,165) + het_rates(k,188))* y(k,188) + prod(k,36) = 0._r8 + loss(k,37) = ( + rxt(k,166) + het_rates(k,189))* y(k,189) + prod(k,37) = 0._r8 + loss(k,38) = ( + rxt(k,167) + het_rates(k,190))* y(k,190) + prod(k,38) = 0._r8 + loss(k,39) = ( + het_rates(k,191))* y(k,191) + prod(k,39) = (.0245005_r8*rxt(k,843)*y(k,239) + & + .1279005_r8*rxt(k,848)*y(k,242) +.0097005_r8*rxt(k,853)*y(k,244) + & + .0245005_r8*rxt(k,856)*y(k,247) +.0003005_r8*rxt(k,861)*y(k,277) + & + .1056005_r8*rxt(k,865)*y(k,280) +.0245005_r8*rxt(k,869)*y(k,283) + & + .0245005_r8*rxt(k,874)*y(k,292) +.0154005_r8*rxt(k,880)*y(k,315) + & + .0063005_r8*rxt(k,883)*y(k,317))*y(k,147) & + + (.0508005_r8*rxt(k,842)*y(k,239) + & + .2202005_r8*rxt(k,847)*y(k,242) +.0023005_r8*rxt(k,852)*y(k,244) + & + .0508005_r8*rxt(k,855)*y(k,247) +.0031005_r8*rxt(k,860)*y(k,277) + & + .2381005_r8*rxt(k,864)*y(k,280) +.0508005_r8*rxt(k,868)*y(k,283) + & + .0508005_r8*rxt(k,873)*y(k,292) +.1364005_r8*rxt(k,879)*y(k,315) + & + .1677005_r8*rxt(k,882)*y(k,317))*y(k,258) & + + (.0508005_r8*rxt(k,844)*y(k,4) +.2202005_r8*rxt(k,849)*y(k,7) + & + .0508005_r8*rxt(k,857)*y(k,17) +.0508005_r8*rxt(k,870)*y(k,125) + & + .0508005_r8*rxt(k,875)*y(k,135))*y(k,158) +rxt(k,811)*y(k,77) & + +.5931005_r8*rxt(k,877)*y(k,295)*y(k,198) + loss(k,40) = ( + het_rates(k,192))* y(k,192) + prod(k,40) = (.0082005_r8*rxt(k,843)*y(k,239) + & + .1792005_r8*rxt(k,848)*y(k,242) +.0034005_r8*rxt(k,853)*y(k,244) + & + .0082005_r8*rxt(k,856)*y(k,247) +.0003005_r8*rxt(k,861)*y(k,277) + & + .1026005_r8*rxt(k,865)*y(k,280) +.0082005_r8*rxt(k,869)*y(k,283) + & + .0082005_r8*rxt(k,874)*y(k,292) +.0452005_r8*rxt(k,880)*y(k,315) + & + .0237005_r8*rxt(k,883)*y(k,317))*y(k,147) & + + (.1149005_r8*rxt(k,842)*y(k,239) + & + .2067005_r8*rxt(k,847)*y(k,242) +.0008005_r8*rxt(k,852)*y(k,244) + & + .1149005_r8*rxt(k,855)*y(k,247) +.0035005_r8*rxt(k,860)*y(k,277) + & + .1308005_r8*rxt(k,864)*y(k,280) +.1149005_r8*rxt(k,868)*y(k,283) + & + .1149005_r8*rxt(k,873)*y(k,292) +.0101005_r8*rxt(k,879)*y(k,315) + & + .0174005_r8*rxt(k,882)*y(k,317))*y(k,258) & + + (.1149005_r8*rxt(k,844)*y(k,4) +.2067005_r8*rxt(k,849)*y(k,7) + & + .1149005_r8*rxt(k,857)*y(k,17) +.1149005_r8*rxt(k,870)*y(k,125) + & + .1149005_r8*rxt(k,875)*y(k,135))*y(k,158) & + +.1534005_r8*rxt(k,877)*y(k,295)*y(k,198) + loss(k,41) = ( + het_rates(k,193))* y(k,193) + prod(k,41) = (.0772005_r8*rxt(k,843)*y(k,239) + & + .0676005_r8*rxt(k,848)*y(k,242) +.1579005_r8*rxt(k,853)*y(k,244) + & + .0772005_r8*rxt(k,856)*y(k,247) +.0073005_r8*rxt(k,861)*y(k,277) + & + .0521005_r8*rxt(k,865)*y(k,280) +.0772005_r8*rxt(k,869)*y(k,283) + & + .0772005_r8*rxt(k,874)*y(k,292) +.0966005_r8*rxt(k,880)*y(k,315) + & + .0025005_r8*rxt(k,883)*y(k,317))*y(k,147) & + + (.0348005_r8*rxt(k,842)*y(k,239) + & + .0653005_r8*rxt(k,847)*y(k,242) +.0843005_r8*rxt(k,852)*y(k,244) + & + .0348005_r8*rxt(k,855)*y(k,247) +.0003005_r8*rxt(k,860)*y(k,277) + & + .0348005_r8*rxt(k,864)*y(k,280) +.0348005_r8*rxt(k,868)*y(k,283) + & + .0348005_r8*rxt(k,873)*y(k,292) +.0763005_r8*rxt(k,879)*y(k,315) + & + .086_r8*rxt(k,882)*y(k,317))*y(k,258) & + + (.0348005_r8*rxt(k,844)*y(k,4) +.0653005_r8*rxt(k,849)*y(k,7) + & + .0348005_r8*rxt(k,857)*y(k,17) +.0348005_r8*rxt(k,870)*y(k,125) + & + .0348005_r8*rxt(k,875)*y(k,135))*y(k,158) & + +.0459005_r8*rxt(k,877)*y(k,295)*y(k,198) + loss(k,42) = ( + het_rates(k,194))* y(k,194) + prod(k,42) = (.0332005_r8*rxt(k,843)*y(k,239) +.079_r8*rxt(k,848)*y(k,242) + & + .0059005_r8*rxt(k,853)*y(k,244) +.0332005_r8*rxt(k,856)*y(k,247) + & + .0057005_r8*rxt(k,861)*y(k,277) +.0143005_r8*rxt(k,865)*y(k,280) + & + .0332005_r8*rxt(k,869)*y(k,283) +.0332005_r8*rxt(k,874)*y(k,292) + & + .0073005_r8*rxt(k,880)*y(k,315) +.011_r8*rxt(k,883)*y(k,317)) & + *y(k,147) + (.0554005_r8*rxt(k,842)*y(k,239) + & + .1284005_r8*rxt(k,847)*y(k,242) +.0443005_r8*rxt(k,852)*y(k,244) + & + .0554005_r8*rxt(k,855)*y(k,247) +.0271005_r8*rxt(k,860)*y(k,277) + & + .0076005_r8*rxt(k,864)*y(k,280) +.0554005_r8*rxt(k,868)*y(k,283) + & + .0554005_r8*rxt(k,873)*y(k,292) +.2157005_r8*rxt(k,879)*y(k,315) + & + .0512005_r8*rxt(k,882)*y(k,317))*y(k,258) & + + (.1749305_r8*rxt(k,841)*y(k,4) +.1749305_r8*rxt(k,846)*y(k,7) + & + .1749305_r8*rxt(k,854)*y(k,17) +.0590245_r8*rxt(k,859)*y(k,109) + & + .1749305_r8*rxt(k,867)*y(k,125) +.1749305_r8*rxt(k,872)*y(k,135)) & + *y(k,149) + (.0554005_r8*rxt(k,844)*y(k,4) + & + .1284005_r8*rxt(k,849)*y(k,7) +.0554005_r8*rxt(k,857)*y(k,17) + & + .0033005_r8*rxt(k,862)*y(k,109) +.0554005_r8*rxt(k,870)*y(k,125) + & + .0554005_r8*rxt(k,875)*y(k,135))*y(k,158) & + +.0085005_r8*rxt(k,877)*y(k,295)*y(k,198) + loss(k,43) = ( + het_rates(k,195))* y(k,195) + prod(k,43) = (.130_r8*rxt(k,843)*y(k,239) +.1254005_r8*rxt(k,848)*y(k,242) + & + .0536005_r8*rxt(k,853)*y(k,244) +.130_r8*rxt(k,856)*y(k,247) + & + .0623005_r8*rxt(k,861)*y(k,277) +.0166005_r8*rxt(k,865)*y(k,280) + & + .130_r8*rxt(k,869)*y(k,283) +.130_r8*rxt(k,874)*y(k,292) + & + .238_r8*rxt(k,880)*y(k,315) +.1185005_r8*rxt(k,883)*y(k,317)) & + *y(k,147) + (.1278005_r8*rxt(k,842)*y(k,239) + & + .114_r8*rxt(k,847)*y(k,242) +.1621005_r8*rxt(k,852)*y(k,244) + & + .1278005_r8*rxt(k,855)*y(k,247) +.0474005_r8*rxt(k,860)*y(k,277) + & + .0113005_r8*rxt(k,864)*y(k,280) +.1278005_r8*rxt(k,868)*y(k,283) + & + .1278005_r8*rxt(k,873)*y(k,292) +.0738005_r8*rxt(k,879)*y(k,315) + & + .1598005_r8*rxt(k,882)*y(k,317))*y(k,258) & + + (.5901905_r8*rxt(k,841)*y(k,4) +.5901905_r8*rxt(k,846)*y(k,7) + & + .5901905_r8*rxt(k,854)*y(k,17) +.0250245_r8*rxt(k,859)*y(k,109) + & + .5901905_r8*rxt(k,867)*y(k,125) +.5901905_r8*rxt(k,872)*y(k,135)) & + *y(k,149) + (.1278005_r8*rxt(k,844)*y(k,4) + & + .114_r8*rxt(k,849)*y(k,7) +.1278005_r8*rxt(k,857)*y(k,17) + & + .1278005_r8*rxt(k,870)*y(k,125) +.1278005_r8*rxt(k,875)*y(k,135)) & + *y(k,158) +.0128005_r8*rxt(k,877)*y(k,295)*y(k,198) + loss(k,44) = ( + rxt(k,833) + het_rates(k,196))* y(k,196) + prod(k,44) = (.360_r8*rxt(k,605)*y(k,240) +.180_r8*rxt(k,607)*y(k,253) + & + .500_r8*rxt(k,608)*y(k,258) +.070_r8*rxt(k,609)*y(k,147))*y(k,240) & + +.300_r8*rxt(k,617)*y(k,241)*y(k,147) + loss(k,45) = ( + rxt(k,904) + het_rates(k,197))* y(k,197) + prod(k,45) = 0._r8 + loss(k,46) = (rxt(k,877)* y(k,295) + het_rates(k,198))* y(k,198) + prod(k,46) = 0._r8 + loss(k,85) = ( + rxt(k,90) + het_rates(k,199))* y(k,199) + prod(k,85) = (.100_r8*rxt(k,574)*y(k,228) +.230_r8*rxt(k,576)*y(k,229)) & + *y(k,295) + loss(k,282) = (rxt(k,689)* y(k,295) + rxt(k,91) + het_rates(k,200))* y(k,200) + prod(k,282) = (.140_r8*rxt(k,594)*y(k,252) +.130_r8*rxt(k,595)*y(k,253) + & + .250_r8*rxt(k,596)*y(k,258) +.110_r8*rxt(k,597)*y(k,147) + & + .140_r8*rxt(k,598)*y(k,149) +.140_r8*rxt(k,599)*y(k,302) + & + .140_r8*rxt(k,600)*y(k,304) +.140_r8*rxt(k,601)*y(k,307))*y(k,238) & + + (.680_r8*rxt(k,636)*y(k,246) +.900_r8*rxt(k,656)*y(k,282) + & + .180_r8*rxt(k,691)*y(k,300) +.900_r8*rxt(k,765)*y(k,309))*y(k,258) & + +.700_r8*rxt(k,692)*y(k,300)*y(k,147) + loss(k,133) = (rxt(k,690)* y(k,295) + rxt(k,92) + het_rates(k,201))* y(k,201) + prod(k,133) = (.900_r8*rxt(k,616)*y(k,241) +.900_r8*rxt(k,676)*y(k,291)) & + *y(k,258) + loss(k,284) = (rxt(k,755)* y(k,149) +rxt(k,756)* y(k,295) + rxt(k,93) & + + het_rates(k,202))* y(k,202) + prod(k,284) = (1.640_r8*rxt(k,585)*y(k,237) +rxt(k,586)*y(k,252) + & + .820_r8*rxt(k,587)*y(k,253) +.700_r8*rxt(k,588)*y(k,258) + & + .930_r8*rxt(k,589)*y(k,147) +rxt(k,590)*y(k,149) + & + rxt(k,591)*y(k,302) +rxt(k,592)*y(k,304) +rxt(k,593)*y(k,307)) & + *y(k,237) + (.390_r8*rxt(k,594)*y(k,252) + & + .420_r8*rxt(k,595)*y(k,253) +.290_r8*rxt(k,596)*y(k,258) + & + .300_r8*rxt(k,597)*y(k,147) +.390_r8*rxt(k,598)*y(k,149) + & + .390_r8*rxt(k,599)*y(k,302) +.390_r8*rxt(k,600)*y(k,304) + & + .390_r8*rxt(k,601)*y(k,307))*y(k,238) + (rxt(k,783)*y(k,221) + & + rxt(k,787)*y(k,223) +rxt(k,789)*y(k,225))*y(k,295) & + +.220_r8*rxt(k,602)*y(k,158)*y(k,4) +.500_r8*rxt(k,105)*y(k,217) & + +rxt(k,107)*y(k,219) +rxt(k,109)*y(k,221) +rxt(k,111)*y(k,223) & + +rxt(k,113)*y(k,225) + loss(k,220) = (rxt(k,708)* y(k,149) +rxt(k,717)* y(k,295) + rxt(k,94) & + + het_rates(k,203))* y(k,203) + prod(k,220) =.170_r8*rxt(k,602)*y(k,158)*y(k,4) +rxt(k,757)*y(k,295)*y(k,210) & + +.500_r8*rxt(k,694)*y(k,301)*y(k,253) + loss(k,157) = (rxt(k,718)* y(k,295) + rxt(k,95) + rxt(k,790) & + + het_rates(k,204))* y(k,204) + prod(k,157) =rxt(k,684)*y(k,302)*y(k,148) + loss(k,255) = (rxt(k,727)* y(k,149) +rxt(k,736)* y(k,295) + rxt(k,96) & + + het_rates(k,205))* y(k,205) + prod(k,255) = (.900_r8*rxt(k,625)*y(k,245) +.480_r8*rxt(k,626)*y(k,252) + & + .340_r8*rxt(k,627)*y(k,253) +.220_r8*rxt(k,628)*y(k,258) + & + .440_r8*rxt(k,629)*y(k,147) +.480_r8*rxt(k,630)*y(k,149) + & + .480_r8*rxt(k,631)*y(k,302) +.480_r8*rxt(k,632)*y(k,304) + & + .480_r8*rxt(k,633)*y(k,307))*y(k,245) & + + (.350_r8*rxt(k,594)*y(k,252) +.200_r8*rxt(k,595)*y(k,253) + & + .270_r8*rxt(k,597)*y(k,147) +.350_r8*rxt(k,598)*y(k,149) + & + .350_r8*rxt(k,599)*y(k,302) +.350_r8*rxt(k,600)*y(k,304) + & + .350_r8*rxt(k,601)*y(k,307))*y(k,238) & + + (.410_r8*rxt(k,634)*y(k,252) +.310_r8*rxt(k,635)*y(k,253) + & + .310_r8*rxt(k,637)*y(k,147) +.410_r8*rxt(k,638)*y(k,149) + & + .410_r8*rxt(k,639)*y(k,302) +.410_r8*rxt(k,640)*y(k,304) + & + .410_r8*rxt(k,641)*y(k,307))*y(k,246) + (rxt(k,759)*y(k,149) + & + rxt(k,762)*y(k,158))*y(k,212) + (rxt(k,114) +rxt(k,788)*y(k,295)) & + *y(k,226) + (.100_r8*rxt(k,760)*y(k,258) + & + .700_r8*rxt(k,761)*y(k,147))*y(k,308) + loss(k,158) = (rxt(k,737)* y(k,295) + rxt(k,97) + rxt(k,791) & + + het_rates(k,206))* y(k,206) + prod(k,158) =rxt(k,685)*y(k,304)*y(k,148) + loss(k,171) = (rxt(k,748)* y(k,295) + rxt(k,98) + het_rates(k,207))* y(k,207) + prod(k,171) = (.010_r8*rxt(k,602)*y(k,4) +.130_r8*rxt(k,622)*y(k,7) + & + .010_r8*rxt(k,662)*y(k,125))*y(k,158) +.510_r8*rxt(k,751)*y(k,307) & + *y(k,258) + loss(k,115) = (rxt(k,746)* y(k,295) + rxt(k,99) + het_rates(k,208))* y(k,208) + prod(k,115) =.510_r8*rxt(k,703)*y(k,302)*y(k,258) + loss(k,116) = (rxt(k,747)* y(k,295) + rxt(k,100) + het_rates(k,209)) & + * y(k,209) + prod(k,116) =.510_r8*rxt(k,721)*y(k,304)*y(k,258) + loss(k,125) = (rxt(k,757)* y(k,295) + rxt(k,101) + rxt(k,792) & + + het_rates(k,210))* y(k,210) + prod(k,125) =rxt(k,686)*y(k,307)*y(k,148) + loss(k,117) = (rxt(k,758)* y(k,295) + rxt(k,102) + rxt(k,834) & + + het_rates(k,211))* y(k,211) + prod(k,117) = (.820_r8*rxt(k,687)*y(k,299) +.820_r8*rxt(k,691)*y(k,300)) & + *y(k,258) + loss(k,293) = (rxt(k,759)* y(k,149) +rxt(k,762)* y(k,158) +rxt(k,763) & + * y(k,295) + het_rates(k,212))* y(k,212) + prod(k,293) = (.460_r8*rxt(k,645)*y(k,252) +.310_r8*rxt(k,646)*y(k,253) + & + .230_r8*rxt(k,647)*y(k,258) +.860_r8*rxt(k,648)*y(k,281) + & + .430_r8*rxt(k,649)*y(k,147) +.460_r8*rxt(k,650)*y(k,149) + & + .460_r8*rxt(k,651)*y(k,302) +.460_r8*rxt(k,652)*y(k,304) + & + .460_r8*rxt(k,653)*y(k,307))*y(k,281) & + + (.120_r8*rxt(k,594)*y(k,252) +.140_r8*rxt(k,595)*y(k,253) + & + .060_r8*rxt(k,596)*y(k,258) +.090_r8*rxt(k,597)*y(k,147) + & + .120_r8*rxt(k,598)*y(k,149) +.120_r8*rxt(k,599)*y(k,302) + & + .120_r8*rxt(k,600)*y(k,304) +.120_r8*rxt(k,601)*y(k,307))*y(k,238) & + + (rxt(k,654)*y(k,252) +rxt(k,655)*y(k,253) + & + .100_r8*rxt(k,656)*y(k,258) +.770_r8*rxt(k,657)*y(k,147) + & + rxt(k,658)*y(k,149) +rxt(k,659)*y(k,302) +rxt(k,660)*y(k,304) + & + rxt(k,661)*y(k,307))*y(k,282) + (.270_r8*rxt(k,634)*y(k,252) + & + .370_r8*rxt(k,635)*y(k,253) +.200_r8*rxt(k,637)*y(k,147) + & + .270_r8*rxt(k,638)*y(k,149) +.270_r8*rxt(k,639)*y(k,302) + & + .270_r8*rxt(k,640)*y(k,304) +.270_r8*rxt(k,641)*y(k,307))*y(k,246) & + + (.660_r8*rxt(k,662)*y(k,125) +rxt(k,767)*y(k,213))*y(k,158) & + + (.100_r8*rxt(k,765)*y(k,258) +.700_r8*rxt(k,766)*y(k,147)) & + *y(k,309) +.500_r8*rxt(k,764)*y(k,213)*y(k,149) +rxt(k,91)*y(k,200) & + +.460_r8*rxt(k,106)*y(k,218) +.460_r8*rxt(k,108)*y(k,220) & + +rxt(k,110)*y(k,222) +rxt(k,112)*y(k,224) + loss(k,292) = (rxt(k,764)* y(k,149) +rxt(k,767)* y(k,158) +rxt(k,768) & + * y(k,295) + het_rates(k,213))* y(k,213) + prod(k,292) = (1.640_r8*rxt(k,605)*y(k,240) +rxt(k,606)*y(k,252) + & + .820_r8*rxt(k,607)*y(k,253) +.500_r8*rxt(k,608)*y(k,258) + & + .930_r8*rxt(k,609)*y(k,147) +rxt(k,610)*y(k,149) + & + rxt(k,611)*y(k,302) +rxt(k,612)*y(k,304) +rxt(k,613)*y(k,307)) & + *y(k,240) + (.950_r8*rxt(k,665)*y(k,252) + & + .770_r8*rxt(k,666)*y(k,253) +.480_r8*rxt(k,667)*y(k,258) + & + 1.540_r8*rxt(k,668)*y(k,290) +.890_r8*rxt(k,669)*y(k,147) + & + .950_r8*rxt(k,670)*y(k,149) +.950_r8*rxt(k,671)*y(k,302) + & + .950_r8*rxt(k,672)*y(k,304) +.950_r8*rxt(k,673)*y(k,307))*y(k,290) & + + (rxt(k,614)*y(k,252) +rxt(k,615)*y(k,253) + & + .100_r8*rxt(k,616)*y(k,258) +.700_r8*rxt(k,617)*y(k,147) + & + rxt(k,618)*y(k,149) +rxt(k,619)*y(k,302) +rxt(k,620)*y(k,304) + & + rxt(k,621)*y(k,307))*y(k,241) + (rxt(k,674)*y(k,252) + & + rxt(k,675)*y(k,253) +.100_r8*rxt(k,676)*y(k,258) + & + .710_r8*rxt(k,677)*y(k,147) +rxt(k,678)*y(k,149) + & + rxt(k,679)*y(k,302) +rxt(k,680)*y(k,304) +rxt(k,681)*y(k,307)) & + *y(k,291) + (.870_r8*rxt(k,622)*y(k,7) +rxt(k,682)*y(k,135))*y(k,158) & + +rxt(k,92)*y(k,201) + loss(k,215) = (rxt(k,769)* y(k,295) + rxt(k,103) + rxt(k,835) & + + het_rates(k,214))* y(k,214) + prod(k,215) = (.070_r8*rxt(k,589)*y(k,237) +.070_r8*rxt(k,629)*y(k,245) + & + .070_r8*rxt(k,649)*y(k,281) +.070_r8*rxt(k,669)*y(k,290) + & + .300_r8*rxt(k,773)*y(k,310) +.300_r8*rxt(k,777)*y(k,311) + & + .300_r8*rxt(k,781)*y(k,312) +.300_r8*rxt(k,785)*y(k,313))*y(k,147) + loss(k,192) = (rxt(k,770)* y(k,295) + rxt(k,104) + rxt(k,836) & + + het_rates(k,215))* y(k,215) + prod(k,192) = (.010_r8*rxt(k,597)*y(k,238) +.300_r8*rxt(k,688)*y(k,299) + & + .300_r8*rxt(k,692)*y(k,300) +.300_r8*rxt(k,761)*y(k,308))*y(k,147) & + + (.900_r8*rxt(k,772)*y(k,310) +.900_r8*rxt(k,776)*y(k,311) + & + .900_r8*rxt(k,780)*y(k,312) +.900_r8*rxt(k,784)*y(k,313))*y(k,258) + loss(k,203) = (rxt(k,771)* y(k,295) + het_rates(k,216))* y(k,216) + prod(k,203) = (.040_r8*rxt(k,625)*y(k,245) +.020_r8*rxt(k,626)*y(k,252) + & + .020_r8*rxt(k,627)*y(k,253) +.020_r8*rxt(k,628)*y(k,258) + & + .020_r8*rxt(k,629)*y(k,147) +.020_r8*rxt(k,630)*y(k,149) + & + .020_r8*rxt(k,631)*y(k,302) +.020_r8*rxt(k,632)*y(k,304) + & + .020_r8*rxt(k,633)*y(k,307))*y(k,245) & + + (.320_r8*rxt(k,634)*y(k,252) +.320_r8*rxt(k,635)*y(k,253) + & + .030_r8*rxt(k,636)*y(k,258) +.240_r8*rxt(k,637)*y(k,147) + & + .320_r8*rxt(k,638)*y(k,149) +.320_r8*rxt(k,639)*y(k,302) + & + .320_r8*rxt(k,640)*y(k,304) +.320_r8*rxt(k,641)*y(k,307))*y(k,246) & + +.510_r8*rxt(k,642)*y(k,158)*y(k,17) +.110_r8*rxt(k,595)*y(k,253) & + *y(k,238) + loss(k,194) = (rxt(k,775)* y(k,295) + rxt(k,105) + het_rates(k,217)) & + * y(k,217) + prod(k,194) = (.450_r8*rxt(k,628)*y(k,245) +.100_r8*rxt(k,772)*y(k,310)) & + *y(k,258) +.700_r8*rxt(k,773)*y(k,310)*y(k,147) + loss(k,160) = (rxt(k,774)* y(k,295) + rxt(k,106) + het_rates(k,218)) & + * y(k,218) + prod(k,160) = (.320_r8*rxt(k,647)*y(k,281) +.360_r8*rxt(k,667)*y(k,290)) & + *y(k,258) + loss(k,207) = (rxt(k,779)* y(k,295) + rxt(k,107) + rxt(k,838) & + + het_rates(k,219))* y(k,219) + prod(k,207) = (.300_r8*rxt(k,588)*y(k,237) +.080_r8*rxt(k,628)*y(k,245) + & + .100_r8*rxt(k,776)*y(k,311))*y(k,258) +.700_r8*rxt(k,777)*y(k,311) & + *y(k,147) + loss(k,172) = (rxt(k,778)* y(k,295) + rxt(k,108) + rxt(k,837) & + + het_rates(k,220))* y(k,220) + prod(k,172) = (.180_r8*rxt(k,647)*y(k,281) +.160_r8*rxt(k,667)*y(k,290)) & + *y(k,258) + loss(k,244) = (rxt(k,783)* y(k,295) + rxt(k,109) + het_rates(k,221)) & + * y(k,221) + prod(k,244) = (.920_r8*rxt(k,625)*y(k,245) +.450_r8*rxt(k,626)*y(k,252) + & + .560_r8*rxt(k,627)*y(k,253) +.230_r8*rxt(k,628)*y(k,258) + & + .420_r8*rxt(k,629)*y(k,147) +.450_r8*rxt(k,630)*y(k,149) + & + .450_r8*rxt(k,631)*y(k,302) +.450_r8*rxt(k,632)*y(k,304) + & + .450_r8*rxt(k,633)*y(k,307))*y(k,245) & + + (.100_r8*rxt(k,597)*y(k,238) +.020_r8*rxt(k,637)*y(k,246) + & + .300_r8*rxt(k,696)*y(k,301) +.090_r8*rxt(k,741)*y(k,306) + & + .700_r8*rxt(k,781)*y(k,312))*y(k,147) + (rxt(k,103) + & + rxt(k,769)*y(k,295))*y(k,214) + (rxt(k,104) +rxt(k,770)*y(k,295)) & + *y(k,215) + (.090_r8*rxt(k,585)*y(k,237) + & + .090_r8*rxt(k,587)*y(k,253))*y(k,237) +.500_r8*rxt(k,105)*y(k,217) & + +.100_r8*rxt(k,780)*y(k,312)*y(k,258) + loss(k,252) = (rxt(k,782)* y(k,295) + rxt(k,110) + het_rates(k,222)) & + * y(k,222) + prod(k,252) = (.350_r8*rxt(k,645)*y(k,252) +.420_r8*rxt(k,646)*y(k,253) + & + .180_r8*rxt(k,647)*y(k,258) +.720_r8*rxt(k,648)*y(k,281) + & + .330_r8*rxt(k,649)*y(k,147) +.350_r8*rxt(k,650)*y(k,149) + & + .350_r8*rxt(k,651)*y(k,302) +.350_r8*rxt(k,652)*y(k,304) + & + .350_r8*rxt(k,653)*y(k,307))*y(k,281) & + + (.050_r8*rxt(k,665)*y(k,252) +.140_r8*rxt(k,666)*y(k,253) + & + .190_r8*rxt(k,668)*y(k,290) +.040_r8*rxt(k,669)*y(k,147) + & + .050_r8*rxt(k,670)*y(k,149) +.050_r8*rxt(k,671)*y(k,302) + & + .050_r8*rxt(k,672)*y(k,304) +.050_r8*rxt(k,673)*y(k,307))*y(k,290) & + + (.020_r8*rxt(k,597)*y(k,238) +.040_r8*rxt(k,637)*y(k,246) + & + .060_r8*rxt(k,657)*y(k,282) +.100_r8*rxt(k,677)*y(k,291) + & + .120_r8*rxt(k,766)*y(k,309))*y(k,147) +.500_r8*rxt(k,764)*y(k,213) & + *y(k,149) +.540_r8*rxt(k,106)*y(k,218) + loss(k,242) = (rxt(k,787)* y(k,295) + rxt(k,111) + rxt(k,840) & + + het_rates(k,223))* y(k,223) + prod(k,242) = (.140_r8*rxt(k,625)*y(k,245) +.050_r8*rxt(k,626)*y(k,252) + & + .080_r8*rxt(k,627)*y(k,253) +.050_r8*rxt(k,629)*y(k,147) + & + .050_r8*rxt(k,630)*y(k,149) +.050_r8*rxt(k,631)*y(k,302) + & + .050_r8*rxt(k,632)*y(k,304) +.050_r8*rxt(k,633)*y(k,307))*y(k,245) & + + (.050_r8*rxt(k,597)*y(k,238) +.060_r8*rxt(k,637)*y(k,246) + & + .170_r8*rxt(k,712)*y(k,303) +.300_r8*rxt(k,731)*y(k,305) + & + .700_r8*rxt(k,785)*y(k,313))*y(k,147) & + + (.270_r8*rxt(k,585)*y(k,237) +.090_r8*rxt(k,587)*y(k,253)) & + *y(k,237) +rxt(k,779)*y(k,295)*y(k,219) +.100_r8*rxt(k,784)*y(k,313) & + *y(k,258) + loss(k,253) = (rxt(k,786)* y(k,295) + rxt(k,112) + rxt(k,839) & + + het_rates(k,224))* y(k,224) + prod(k,253) = (.190_r8*rxt(k,645)*y(k,252) +.270_r8*rxt(k,646)*y(k,253) + & + .090_r8*rxt(k,647)*y(k,258) +.420_r8*rxt(k,648)*y(k,281) + & + .170_r8*rxt(k,649)*y(k,147) +.190_r8*rxt(k,650)*y(k,149) + & + .190_r8*rxt(k,651)*y(k,302) +.190_r8*rxt(k,652)*y(k,304) + & + .190_r8*rxt(k,653)*y(k,307))*y(k,281) & + + (.050_r8*rxt(k,597)*y(k,238) +.130_r8*rxt(k,637)*y(k,246) + & + .170_r8*rxt(k,657)*y(k,282) +.190_r8*rxt(k,677)*y(k,291) + & + .180_r8*rxt(k,766)*y(k,309))*y(k,147) & + + (.090_r8*rxt(k,666)*y(k,253) +.270_r8*rxt(k,668)*y(k,290)) & + *y(k,290) +.540_r8*rxt(k,108)*y(k,220) + loss(k,161) = (rxt(k,789)* y(k,295) + rxt(k,113) + het_rates(k,225)) & + * y(k,225) + prod(k,161) = (.400_r8*rxt(k,596)*y(k,238) +.290_r8*rxt(k,636)*y(k,246) + & + rxt(k,695)*y(k,301) +.620_r8*rxt(k,711)*y(k,303))*y(k,258) & + + (rxt(k,102) +rxt(k,758)*y(k,295))*y(k,211) + loss(k,151) = (rxt(k,788)* y(k,295) + rxt(k,114) + het_rates(k,226)) & + * y(k,226) + prod(k,151) = (.180_r8*rxt(k,687)*y(k,299) +.850_r8*rxt(k,730)*y(k,305) + & + .470_r8*rxt(k,740)*y(k,306) +.900_r8*rxt(k,760)*y(k,308))*y(k,258) & + +.700_r8*rxt(k,688)*y(k,299)*y(k,147) + loss(k,167) = (rxt(k,573)* y(k,295) + rxt(k,115) + het_rates(k,227)) & + * y(k,227) + prod(k,167) =rxt(k,571)*y(k,314)*y(k,258) + loss(k,83) = (rxt(k,574)* y(k,295) + het_rates(k,228))* y(k,228) + prod(k,83) = 0._r8 + loss(k,86) = (rxt(k,576)* y(k,295) + het_rates(k,229))* y(k,229) + prod(k,86) = 0._r8 + loss(k,178) = (rxt(k,579)* y(k,295) + rxt(k,116) + het_rates(k,230)) & + * y(k,230) + prod(k,178) =rxt(k,577)*y(k,316)*y(k,258) + loss(k,87) = (rxt(k,582)* y(k,295) + het_rates(k,231))* y(k,231) + prod(k,87) =.150_r8*rxt(k,576)*y(k,295)*y(k,229) + loss(k,126) = (rxt(k,583)* y(k,295) + rxt(k,117) + het_rates(k,232)) & + * y(k,232) + prod(k,126) =rxt(k,580)*y(k,318)*y(k,258) + loss(k,144) = (rxt(k,542)* y(k,147) +rxt(k,570)* y(k,148) +rxt(k,541) & + * y(k,258) + het_rates(k,235))* y(k,235) + prod(k,144) =rxt(k,547)*y(k,295)*y(k,23) +rxt(k,575)*y(k,164) + loss(k,211) = ((rxt(k,410) +rxt(k,411))* y(k,147) +rxt(k,409)* y(k,258) & + + het_rates(k,236))* y(k,236) + prod(k,211) = (rxt(k,412)*y(k,2) +rxt(k,413)*y(k,15))*y(k,295) + loss(k,281) = (rxt(k,589)* y(k,147) +rxt(k,590)* y(k,149) + 2._r8*rxt(k,585) & + * y(k,237) +rxt(k,586)* y(k,252) +rxt(k,587)* y(k,253) +rxt(k,588) & + * y(k,258) +rxt(k,591)* y(k,302) +rxt(k,592)* y(k,304) +rxt(k,593) & + * y(k,307) + het_rates(k,237))* y(k,237) + prod(k,281) =rxt(k,584)*y(k,149)*y(k,4) + loss(k,287) = (rxt(k,597)* y(k,147) +rxt(k,598)* y(k,149) +rxt(k,594) & + * y(k,252) +rxt(k,595)* y(k,253) +rxt(k,596)* y(k,258) +rxt(k,599) & + * y(k,302) +rxt(k,600)* y(k,304) +rxt(k,601)* y(k,307) & + + het_rates(k,238))* y(k,238) + prod(k,287) =rxt(k,603)*y(k,295)*y(k,4) + loss(k,47) = (rxt(k,843)* y(k,147) +rxt(k,842)* y(k,258) + het_rates(k,239)) & + * y(k,239) + prod(k,47) =rxt(k,845)*y(k,295)*y(k,4) + loss(k,277) = (rxt(k,609)* y(k,147) +rxt(k,610)* y(k,149) + 2._r8*rxt(k,605) & + * y(k,240) +rxt(k,606)* y(k,252) +rxt(k,607)* y(k,253) +rxt(k,608) & + * y(k,258) +rxt(k,611)* y(k,302) +rxt(k,612)* y(k,304) +rxt(k,613) & + * y(k,307) + het_rates(k,240))* y(k,240) + prod(k,277) =rxt(k,604)*y(k,149)*y(k,7) + loss(k,286) = (rxt(k,617)* y(k,147) +rxt(k,618)* y(k,149) +rxt(k,614) & + * y(k,252) +rxt(k,615)* y(k,253) +rxt(k,616)* y(k,258) +rxt(k,619) & + * y(k,302) +rxt(k,620)* y(k,304) +rxt(k,621)* y(k,307) & + + het_rates(k,241))* y(k,241) + prod(k,286) =rxt(k,623)*y(k,295)*y(k,7) + loss(k,48) = (rxt(k,848)* y(k,147) +rxt(k,847)* y(k,258) + het_rates(k,242)) & + * y(k,242) + prod(k,48) =rxt(k,850)*y(k,295)*y(k,7) + loss(k,139) = (rxt(k,545)* y(k,147) +rxt(k,544)* y(k,258) + het_rates(k,243)) & + * y(k,243) + prod(k,139) = (.350_r8*rxt(k,543)*y(k,8) +rxt(k,546)*y(k,9))*y(k,295) + loss(k,49) = (rxt(k,853)* y(k,147) +rxt(k,852)* y(k,258) + het_rates(k,244)) & + * y(k,244) + prod(k,49) =rxt(k,851)*y(k,295)*y(k,8) + loss(k,290) = (rxt(k,629)* y(k,147) +rxt(k,630)* y(k,149) + 2._r8*rxt(k,625) & + * y(k,245) +rxt(k,626)* y(k,252) +rxt(k,627)* y(k,253) +rxt(k,628) & + * y(k,258) +rxt(k,631)* y(k,302) +rxt(k,632)* y(k,304) +rxt(k,633) & + * y(k,307) + het_rates(k,245))* y(k,245) + prod(k,290) =rxt(k,624)*y(k,149)*y(k,17) +rxt(k,775)*y(k,295)*y(k,217) + loss(k,285) = (rxt(k,637)* y(k,147) +rxt(k,638)* y(k,149) +rxt(k,634) & + * y(k,252) +rxt(k,635)* y(k,253) +rxt(k,636)* y(k,258) +rxt(k,639) & + * y(k,302) +rxt(k,640)* y(k,304) +rxt(k,641)* y(k,307) & + + het_rates(k,246))* y(k,246) + prod(k,285) =rxt(k,643)*y(k,295)*y(k,17) + loss(k,50) = (rxt(k,856)* y(k,147) +rxt(k,855)* y(k,258) + het_rates(k,247)) & + * y(k,247) + prod(k,50) =rxt(k,858)*y(k,295)*y(k,17) + loss(k,127) = (rxt(k,550)* y(k,147) +rxt(k,548)* y(k,258) + het_rates(k,248)) & + * y(k,248) + prod(k,127) = (rxt(k,549)*y(k,24) +.070_r8*rxt(k,574)*y(k,228) + & + .060_r8*rxt(k,576)*y(k,229))*y(k,295) + loss(k,225) = (rxt(k,327)* y(k,147) + 2._r8*rxt(k,324)* y(k,249) +rxt(k,325) & + * y(k,253) +rxt(k,326)* y(k,258) + het_rates(k,249))* y(k,249) + prod(k,225) = (rxt(k,330)*y(k,57) +rxt(k,331)*y(k,295))*y(k,29) & + +.500_r8*rxt(k,329)*y(k,295)*y(k,28) +rxt(k,76)*y(k,129) + loss(k,198) = (rxt(k,357)* y(k,147) +rxt(k,355)* y(k,253) +rxt(k,356) & + * y(k,258) + het_rates(k,250))* y(k,250) + prod(k,198) = (rxt(k,358)*y(k,31) +rxt(k,359)*y(k,32))*y(k,295) + loss(k,164) = (rxt(k,552)* y(k,147) +rxt(k,551)* y(k,258) + het_rates(k,251)) & + * y(k,251) + prod(k,164) = (.400_r8*rxt(k,541)*y(k,258) +rxt(k,542)*y(k,147))*y(k,235) & + +rxt(k,553)*y(k,295)*y(k,33) +rxt(k,568)*y(k,165)*y(k,158) + loss(k,300) = (rxt(k,338)* y(k,147) +rxt(k,351)* y(k,148) +rxt(k,586) & + * y(k,237) +rxt(k,594)* y(k,238) +rxt(k,606)* y(k,240) +rxt(k,614) & + * y(k,241) +rxt(k,626)* y(k,245) +rxt(k,634)* y(k,246) & + + 2._r8*rxt(k,335)* y(k,252) +rxt(k,336)* y(k,253) +rxt(k,337) & + * y(k,258) +rxt(k,424)* y(k,261) +rxt(k,430)* y(k,262) +rxt(k,444) & + * y(k,267) +rxt(k,448)* y(k,268) +rxt(k,474)* y(k,274) +rxt(k,491) & + * y(k,278) +rxt(k,495)* y(k,279) +rxt(k,645)* y(k,281) +rxt(k,654) & + * y(k,282) +rxt(k,381)* y(k,284) +rxt(k,388)* y(k,286) +rxt(k,400) & + * y(k,289) +rxt(k,665)* y(k,290) +rxt(k,674)* y(k,291) +rxt(k,693) & + * y(k,301) +rxt(k,701)* y(k,302) +rxt(k,709)* y(k,303) +rxt(k,719) & + * y(k,304) +rxt(k,728)* y(k,305) +rxt(k,749)* y(k,307) & + + het_rates(k,252))* y(k,252) + prod(k,300) = (rxt(k,333)*y(k,46) +.500_r8*rxt(k,340)*y(k,52) + & + rxt(k,361)*y(k,50) +.300_r8*rxt(k,363)*y(k,104) + & + .560_r8*rxt(k,405)*y(k,134) +.060_r8*rxt(k,414)*y(k,98) + & + .060_r8*rxt(k,415)*y(k,99) +.100_r8*rxt(k,502)*y(k,139) + & + 2.000_r8*rxt(k,737)*y(k,206))*y(k,295) + (rxt(k,739)*y(k,253) + & + .530_r8*rxt(k,740)*y(k,258) +.910_r8*rxt(k,741)*y(k,147) + & + rxt(k,742)*y(k,149) +rxt(k,743)*y(k,302) +rxt(k,744)*y(k,304) + & + rxt(k,745)*y(k,307))*y(k,306) + (.350_r8*rxt(k,388)*y(k,252) + & + .350_r8*rxt(k,389)*y(k,253) +.170_r8*rxt(k,390)*y(k,258) + & + .700_r8*rxt(k,391)*y(k,286) +.350_r8*rxt(k,392)*y(k,147) + & + .350_r8*rxt(k,393)*y(k,149))*y(k,286) & + + (.100_r8*rxt(k,385)*y(k,126) +.280_r8*rxt(k,403)*y(k,132) + & + .070_r8*rxt(k,486)*y(k,109) +.040_r8*rxt(k,501)*y(k,139) + & + .330_r8*rxt(k,662)*y(k,125))*y(k,158) & + + (.750_r8*rxt(k,400)*y(k,252) +.880_r8*rxt(k,401)*y(k,253) + & + .490_r8*rxt(k,402)*y(k,258) +.760_r8*rxt(k,537)*y(k,147))*y(k,289) & + + (.300_r8*rxt(k,368)*y(k,253) +.150_r8*rxt(k,369)*y(k,258) + & + rxt(k,370)*y(k,147))*y(k,298) + (rxt(k,35) +rxt(k,360)*y(k,149)) & + *y(k,50) + (rxt(k,55) +rxt(k,56))*y(k,104) + (.600_r8*rxt(k,86) + & + rxt(k,352))*y(k,163) + (.200_r8*rxt(k,394)*y(k,258) + & + rxt(k,395)*y(k,147))*y(k,288) +rxt(k,26)*y(k,14) +rxt(k,332)*y(k,149) & + *y(k,46) +rxt(k,34)*y(k,49) +.330_r8*rxt(k,47)*y(k,97) & + +.050_r8*rxt(k,48)*y(k,98) +.070_r8*rxt(k,49)*y(k,99) +rxt(k,52) & + *y(k,102) +.500_r8*rxt(k,53)*y(k,103) +.350_r8*rxt(k,72)*y(k,126) & + +rxt(k,76)*y(k,129) +rxt(k,77)*y(k,130) +.300_r8*rxt(k,79)*y(k,132) & + +.750_r8*rxt(k,80)*y(k,133) +.560_r8*rxt(k,81)*y(k,134) +rxt(k,84) & + *y(k,151) +rxt(k,89)*y(k,171) +.500_r8*rxt(k,90)*y(k,199) + loss(k,308) = (rxt(k,225)* y(k,60) +rxt(k,305)* y(k,147) +rxt(k,587) & + * y(k,237) +rxt(k,595)* y(k,238) +rxt(k,607)* y(k,240) +rxt(k,615) & + * y(k,241) +rxt(k,627)* y(k,245) +rxt(k,635)* y(k,246) +rxt(k,325) & + * y(k,249) +rxt(k,355)* y(k,250) +rxt(k,336)* y(k,252) & + + 2._r8*(rxt(k,302) +rxt(k,303))* y(k,253) +rxt(k,304)* y(k,258) & + +rxt(k,425)* y(k,261) +rxt(k,431)* y(k,262) +rxt(k,445)* y(k,267) & + +rxt(k,449)* y(k,268) +rxt(k,475)* y(k,274) +rxt(k,492)* y(k,278) & + +rxt(k,496)* y(k,279) +rxt(k,646)* y(k,281) +rxt(k,655)* y(k,282) & + +rxt(k,382)* y(k,284) +rxt(k,389)* y(k,286) +rxt(k,401)* y(k,289) & + +rxt(k,666)* y(k,290) +rxt(k,675)* y(k,291) +rxt(k,368)* y(k,298) & + +rxt(k,694)* y(k,301) +rxt(k,702)* y(k,302) +rxt(k,710)* y(k,303) & + +rxt(k,720)* y(k,304) +rxt(k,729)* y(k,305) +rxt(k,739)* y(k,306) & + +rxt(k,750)* y(k,307) + het_rates(k,253))* y(k,253) + prod(k,308) = (2.000_r8*rxt(k,335)*y(k,252) +.900_r8*rxt(k,336)*y(k,253) + & + .490_r8*rxt(k,337)*y(k,258) +rxt(k,338)*y(k,147) + & + rxt(k,381)*y(k,284) +1.650_r8*rxt(k,388)*y(k,286) + & + rxt(k,400)*y(k,289) +rxt(k,424)*y(k,261) +rxt(k,430)*y(k,262) + & + rxt(k,444)*y(k,267) +rxt(k,448)*y(k,268) +rxt(k,474)*y(k,274) + & + rxt(k,491)*y(k,278) +rxt(k,495)*y(k,279) +rxt(k,586)*y(k,237) + & + rxt(k,594)*y(k,238) +rxt(k,606)*y(k,240) +rxt(k,614)*y(k,241) + & + rxt(k,626)*y(k,245) +rxt(k,634)*y(k,246) +rxt(k,645)*y(k,281) + & + rxt(k,654)*y(k,282) +rxt(k,665)*y(k,290) +rxt(k,674)*y(k,291) + & + rxt(k,693)*y(k,301) +rxt(k,701)*y(k,302) +rxt(k,709)*y(k,303) + & + rxt(k,719)*y(k,304) +rxt(k,728)*y(k,305) +rxt(k,738)*y(k,306) + & + rxt(k,749)*y(k,307))*y(k,252) + (rxt(k,38) +rxt(k,219)*y(k,57) + & + rxt(k,275)*y(k,75) +rxt(k,308)*y(k,295) +rxt(k,315)*y(k,294))*y(k,55) & + + (.650_r8*rxt(k,389)*y(k,253) +.320_r8*rxt(k,390)*y(k,258) + & + 1.300_r8*rxt(k,391)*y(k,286) +.650_r8*rxt(k,392)*y(k,147) + & + .650_r8*rxt(k,393)*y(k,149))*y(k,286) + (.700_r8*rxt(k,307)*y(k,54) + & + rxt(k,339)*y(k,51) +.060_r8*rxt(k,414)*y(k,98) + & + .060_r8*rxt(k,415)*y(k,99))*y(k,295) + (.830_r8*rxt(k,556)*y(k,254) + & + .170_r8*rxt(k,562)*y(k,287))*y(k,147) + (.280_r8*rxt(k,354)*y(k,30) + & + .210_r8*rxt(k,486)*y(k,109))*y(k,158) & + + (.330_r8*rxt(k,555)*y(k,254) +.070_r8*rxt(k,561)*y(k,287)) & + *y(k,258) +rxt(k,131)*y(k,44) +rxt(k,33)*y(k,46) +rxt(k,133)*y(k,47) & + +rxt(k,34)*y(k,49) +rxt(k,36)*y(k,52) +.040_r8*rxt(k,48)*y(k,98) & + +.070_r8*rxt(k,49)*y(k,99) +.650_r8*rxt(k,72)*y(k,126) & + +.300_r8*rxt(k,79)*y(k,132) +.400_r8*rxt(k,86)*y(k,163) + loss(k,184) = (rxt(k,556)* y(k,147) +rxt(k,557)* y(k,148) +rxt(k,555) & + * y(k,258) + het_rates(k,254))* y(k,254) + prod(k,184) =.600_r8*rxt(k,24)*y(k,12) + loss(k,152) = ((rxt(k,377) +rxt(k,378))* y(k,147) + het_rates(k,255)) & + * y(k,255) + prod(k,152) =rxt(k,375)*y(k,295)*y(k,16) + loss(k,101) = ( + rxt(k,343) + rxt(k,344) + het_rates(k,256))* y(k,256) + prod(k,101) =rxt(k,42)*y(k,74) +.750_r8*rxt(k,342)*y(k,257)*y(k,147) + loss(k,179) = (rxt(k,342)* y(k,147) +rxt(k,341)* y(k,258) + het_rates(k,257)) & + * y(k,257) + prod(k,179) =rxt(k,350)*y(k,295)*y(k,26) + loss(k,307) = (rxt(k,255)* y(k,18) +rxt(k,261)* y(k,20) +rxt(k,298)* y(k,43) & + + (rxt(k,222) +rxt(k,223))* y(k,57) +rxt(k,229)* y(k,60) & + + (rxt(k,178) +rxt(k,179) +rxt(k,180))* y(k,78) +rxt(k,207) & + * y(k,147) +rxt(k,212)* y(k,148) +rxt(k,202)* y(k,149) +rxt(k,182) & + * y(k,157) +rxt(k,183)* y(k,158) +rxt(k,541)* y(k,235) +rxt(k,409) & + * y(k,236) +rxt(k,588)* y(k,237) +rxt(k,596)* y(k,238) +rxt(k,608) & + * y(k,240) +rxt(k,616)* y(k,241) +rxt(k,544)* y(k,243) +rxt(k,628) & + * y(k,245) +rxt(k,636)* y(k,246) +rxt(k,548)* y(k,248) +rxt(k,326) & + * y(k,249) +rxt(k,356)* y(k,250) +rxt(k,551)* y(k,251) +rxt(k,337) & + * y(k,252) +rxt(k,304)* y(k,253) +rxt(k,555)* y(k,254) +rxt(k,341) & + * y(k,257) + 2._r8*rxt(k,192)* y(k,258) +rxt(k,312)* y(k,259) & + +rxt(k,421)* y(k,260) +rxt(k,426)* y(k,261) +rxt(k,432)* y(k,262) & + +rxt(k,446)* y(k,267) +rxt(k,450)* y(k,268) +rxt(k,457)* y(k,269) & + +rxt(k,461)* y(k,270) +rxt(k,464)* y(k,271) +rxt(k,467)* y(k,272) & + +rxt(k,471)* y(k,273) +rxt(k,476)* y(k,274) +rxt(k,479)* y(k,275) & + +rxt(k,482)* y(k,276) +rxt(k,493)* y(k,278) +rxt(k,497)* y(k,279) & + +rxt(k,647)* y(k,281) +rxt(k,656)* y(k,282) +rxt(k,383)* y(k,284) & + +rxt(k,558)* y(k,285) +rxt(k,390)* y(k,286) +rxt(k,561)* y(k,287) & + +rxt(k,394)* y(k,288) +rxt(k,402)* y(k,289) +rxt(k,667)* y(k,290) & + +rxt(k,676)* y(k,291) +rxt(k,499)* y(k,293) +rxt(k,187)* y(k,295) & + +rxt(k,564)* y(k,296) +rxt(k,365)* y(k,297) +rxt(k,369)* y(k,298) & + +rxt(k,687)* y(k,299) +rxt(k,691)* y(k,300) +rxt(k,695)* y(k,301) & + +rxt(k,703)* y(k,302) +rxt(k,711)* y(k,303) +rxt(k,721)* y(k,304) & + +rxt(k,730)* y(k,305) +rxt(k,740)* y(k,306) +rxt(k,751)* y(k,307) & + +rxt(k,760)* y(k,308) +rxt(k,765)* y(k,309) +rxt(k,772)* y(k,310) & + +rxt(k,776)* y(k,311) +rxt(k,780)* y(k,312) +rxt(k,784)* y(k,313) & + +rxt(k,571)* y(k,314) +rxt(k,577)* y(k,316) +rxt(k,580)* y(k,318) & + + rxt(k,812) + het_rates(k,258))* y(k,258) + prod(k,307) = (rxt(k,305)*y(k,253) +rxt(k,314)*y(k,259) + & + rxt(k,327)*y(k,249) +.250_r8*rxt(k,342)*y(k,257) + & + rxt(k,357)*y(k,250) +rxt(k,366)*y(k,297) +rxt(k,377)*y(k,255) + & + rxt(k,410)*y(k,236) +rxt(k,503)*y(k,260) +rxt(k,505)*y(k,261) + & + rxt(k,507)*y(k,262) +.450_r8*rxt(k,509)*y(k,267) + & + .450_r8*rxt(k,511)*y(k,268) +rxt(k,513)*y(k,269) + & + .270_r8*rxt(k,515)*y(k,270) +rxt(k,517)*y(k,271) + & + rxt(k,519)*y(k,272) +rxt(k,521)*y(k,273) + & + .540_r8*rxt(k,523)*y(k,274) +.530_r8*rxt(k,525)*y(k,275) + & + .960_r8*rxt(k,527)*y(k,276) +.450_r8*rxt(k,530)*y(k,278) + & + .450_r8*rxt(k,533)*y(k,279) +rxt(k,535)*y(k,284) + & + .240_r8*rxt(k,537)*y(k,289) +rxt(k,539)*y(k,293) + & + rxt(k,545)*y(k,243) +rxt(k,550)*y(k,248) + & + .170_r8*rxt(k,556)*y(k,254) +.400_r8*rxt(k,559)*y(k,285) + & + .830_r8*rxt(k,562)*y(k,287) +rxt(k,565)*y(k,296) + & + rxt(k,572)*y(k,314) +rxt(k,578)*y(k,316) +rxt(k,581)*y(k,318) + & + .770_r8*rxt(k,597)*y(k,238) +.700_r8*rxt(k,617)*y(k,241) + & + .470_r8*rxt(k,629)*y(k,245) +.750_r8*rxt(k,637)*y(k,246) + & + .500_r8*rxt(k,649)*y(k,281) +.770_r8*rxt(k,657)*y(k,282) + & + .040_r8*rxt(k,669)*y(k,290) +.710_r8*rxt(k,677)*y(k,291) + & + .700_r8*rxt(k,688)*y(k,299) +.700_r8*rxt(k,692)*y(k,300) + & + .910_r8*rxt(k,741)*y(k,306) +.700_r8*rxt(k,761)*y(k,308) + & + .700_r8*rxt(k,766)*y(k,309) +.700_r8*rxt(k,773)*y(k,310) + & + .700_r8*rxt(k,777)*y(k,311) +.700_r8*rxt(k,781)*y(k,312) + & + .700_r8*rxt(k,785)*y(k,313))*y(k,147) + (rxt(k,186)*y(k,81) + & + rxt(k,189)*y(k,158) +rxt(k,205)*y(k,149) +rxt(k,236)*y(k,60) + & + rxt(k,266)*y(k,20) +rxt(k,284)*y(k,44) +rxt(k,287)*y(k,47) + & + rxt(k,306)*y(k,53) +rxt(k,309)*y(k,88) +rxt(k,310)*y(k,90) + & + .500_r8*rxt(k,311)*y(k,92) +rxt(k,319)*y(k,63) + & + .350_r8*rxt(k,321)*y(k,25) +rxt(k,328)*y(k,27) +rxt(k,334)*y(k,48) + & + rxt(k,345)*y(k,76) +rxt(k,346)*y(k,77) +.110_r8*rxt(k,347)*y(k,89) + & + rxt(k,362)*y(k,102) +rxt(k,379)*y(k,97) + & + .500_r8*rxt(k,380)*y(k,127) +rxt(k,399)*y(k,133) + & + .440_r8*rxt(k,405)*y(k,134) +.510_r8*rxt(k,414)*y(k,98) + & + .410_r8*rxt(k,415)*y(k,99) +.320_r8*rxt(k,418)*y(k,103) + & + .190_r8*rxt(k,420)*y(k,106) +.400_r8*rxt(k,423)*y(k,108) + & + rxt(k,453)*y(k,110) +rxt(k,455)*y(k,113) + & + .040_r8*rxt(k,460)*y(k,115) +.030_r8*rxt(k,470)*y(k,118) + & + .050_r8*rxt(k,472)*y(k,119) +rxt(k,488)*y(k,122) + & + .180_r8*rxt(k,489)*y(k,123) +.630_r8*rxt(k,502)*y(k,139) + & + .650_r8*rxt(k,543)*y(k,8) +.730_r8*rxt(k,554)*y(k,67) + & + .800_r8*rxt(k,566)*y(k,166) +.280_r8*rxt(k,574)*y(k,228) + & + .380_r8*rxt(k,576)*y(k,229) +.630_r8*rxt(k,582)*y(k,231) + & + rxt(k,718)*y(k,204) +rxt(k,737)*y(k,206) +rxt(k,798)*y(k,175) + & + .500_r8*rxt(k,808)*y(k,69))*y(k,295) + (rxt(k,225)*y(k,60) + & + 2.000_r8*rxt(k,302)*y(k,253) +rxt(k,325)*y(k,249) + & + .900_r8*rxt(k,336)*y(k,252) +rxt(k,355)*y(k,250) + & + .300_r8*rxt(k,368)*y(k,298) +1.500_r8*rxt(k,382)*y(k,284) + & + rxt(k,389)*y(k,286) +.620_r8*rxt(k,401)*y(k,289) + & + 1.500_r8*rxt(k,425)*y(k,261) +rxt(k,431)*y(k,262) + & + .720_r8*rxt(k,445)*y(k,267) +.720_r8*rxt(k,449)*y(k,268) + & + .400_r8*rxt(k,475)*y(k,274) +.720_r8*rxt(k,492)*y(k,278) + & + .720_r8*rxt(k,496)*y(k,279) +.820_r8*rxt(k,587)*y(k,237) + & + 1.160_r8*rxt(k,595)*y(k,238) +.820_r8*rxt(k,607)*y(k,240) + & + rxt(k,615)*y(k,241) +1.100_r8*rxt(k,627)*y(k,245) + & + 1.500_r8*rxt(k,635)*y(k,246) +1.010_r8*rxt(k,646)*y(k,281) + & + rxt(k,655)*y(k,282) +.870_r8*rxt(k,666)*y(k,290) + & + rxt(k,675)*y(k,291) +.500_r8*rxt(k,694)*y(k,301) + & + rxt(k,702)*y(k,302) +rxt(k,710)*y(k,303) +rxt(k,720)*y(k,304) + & + rxt(k,729)*y(k,305) +2.000_r8*rxt(k,739)*y(k,306) + & + rxt(k,750)*y(k,307))*y(k,253) + (.200_r8*rxt(k,312)*y(k,259) + & + .590_r8*rxt(k,383)*y(k,284) +.180_r8*rxt(k,402)*y(k,289) + & + .650_r8*rxt(k,421)*y(k,260) +.060_r8*rxt(k,426)*y(k,261) + & + .060_r8*rxt(k,432)*y(k,262) +.580_r8*rxt(k,457)*y(k,269) + & + .060_r8*rxt(k,461)*y(k,270) +.600_r8*rxt(k,464)*y(k,271) + & + .500_r8*rxt(k,467)*y(k,272) +.400_r8*rxt(k,471)*y(k,273) + & + .170_r8*rxt(k,479)*y(k,275) +.800_r8*rxt(k,482)*y(k,276) + & + .800_r8*rxt(k,499)*y(k,293) +.070_r8*rxt(k,555)*y(k,254) + & + .160_r8*rxt(k,558)*y(k,285) +.330_r8*rxt(k,561)*y(k,287) + & + .480_r8*rxt(k,596)*y(k,238) +.100_r8*rxt(k,616)*y(k,241) + & + .030_r8*rxt(k,636)*y(k,246) +.270_r8*rxt(k,647)*y(k,281) + & + .100_r8*rxt(k,656)*y(k,282) +.100_r8*rxt(k,676)*y(k,291) + & + .180_r8*rxt(k,687)*y(k,299) +.180_r8*rxt(k,691)*y(k,300) + & + .530_r8*rxt(k,740)*y(k,306) +.100_r8*rxt(k,760)*y(k,308) + & + .100_r8*rxt(k,765)*y(k,309) +.100_r8*rxt(k,772)*y(k,310) + & + .100_r8*rxt(k,776)*y(k,311) +.100_r8*rxt(k,780)*y(k,312) + & + .100_r8*rxt(k,784)*y(k,313))*y(k,258) + (rxt(k,381)*y(k,284) + & + .250_r8*rxt(k,400)*y(k,289) +rxt(k,424)*y(k,261) + & + rxt(k,430)*y(k,262) +.450_r8*rxt(k,444)*y(k,267) + & + .450_r8*rxt(k,448)*y(k,268) +.540_r8*rxt(k,474)*y(k,274) + & + .450_r8*rxt(k,491)*y(k,278) +.450_r8*rxt(k,495)*y(k,279) + & + rxt(k,594)*y(k,238) +rxt(k,614)*y(k,241) + & + .500_r8*rxt(k,626)*y(k,245) +rxt(k,634)*y(k,246) + & + .540_r8*rxt(k,645)*y(k,281) +rxt(k,654)*y(k,282) + & + .050_r8*rxt(k,665)*y(k,290) +rxt(k,674)*y(k,291) + & + rxt(k,738)*y(k,306))*y(k,252) + (rxt(k,299)*y(k,43) + & + .540_r8*rxt(k,478)*y(k,274) +rxt(k,598)*y(k,238) + & + rxt(k,618)*y(k,241) +.500_r8*rxt(k,630)*y(k,245) + & + rxt(k,638)*y(k,246) +.540_r8*rxt(k,650)*y(k,281) + & + rxt(k,658)*y(k,282) +.050_r8*rxt(k,670)*y(k,290) + & + rxt(k,678)*y(k,291) +rxt(k,742)*y(k,306) + & + .500_r8*rxt(k,764)*y(k,213))*y(k,149) + (.130_r8*rxt(k,323)*y(k,26) + & + .280_r8*rxt(k,354)*y(k,30) +.140_r8*rxt(k,385)*y(k,126) + & + .280_r8*rxt(k,403)*y(k,132) +.170_r8*rxt(k,459)*y(k,115) + & + .170_r8*rxt(k,469)*y(k,118) +.420_r8*rxt(k,486)*y(k,109) + & + .130_r8*rxt(k,501)*y(k,139) +.170_r8*rxt(k,602)*y(k,4) + & + .080_r8*rxt(k,622)*y(k,7) +.630_r8*rxt(k,682)*y(k,135))*y(k,158) & + + (rxt(k,599)*y(k,238) +rxt(k,619)*y(k,241) + & + .500_r8*rxt(k,631)*y(k,245) +rxt(k,639)*y(k,246) + & + .540_r8*rxt(k,651)*y(k,281) +rxt(k,659)*y(k,282) + & + .050_r8*rxt(k,671)*y(k,290) +rxt(k,679)*y(k,291) + & + rxt(k,743)*y(k,306))*y(k,302) + (rxt(k,600)*y(k,238) + & + rxt(k,620)*y(k,241) +.500_r8*rxt(k,632)*y(k,245) + & + rxt(k,640)*y(k,246) +.540_r8*rxt(k,652)*y(k,281) + & + rxt(k,660)*y(k,282) +.050_r8*rxt(k,672)*y(k,290) + & + rxt(k,680)*y(k,291) +rxt(k,744)*y(k,306))*y(k,304) & + + (rxt(k,601)*y(k,238) +rxt(k,621)*y(k,241) + & + .500_r8*rxt(k,633)*y(k,245) +rxt(k,641)*y(k,246) + & + .540_r8*rxt(k,653)*y(k,281) +rxt(k,661)*y(k,282) + & + .050_r8*rxt(k,673)*y(k,290) +rxt(k,681)*y(k,291) + & + rxt(k,745)*y(k,306))*y(k,307) + (rxt(k,218)*y(k,43) + & + rxt(k,221)*y(k,81) +rxt(k,283)*y(k,44) +rxt(k,286)*y(k,47))*y(k,57) & + + (rxt(k,254)*y(k,18) +rxt(k,300)*y(k,157))*y(k,43) + (rxt(k,11) + & + rxt(k,216))*y(k,94) + (1.500_r8*rxt(k,53) +rxt(k,54))*y(k,103) & + + (rxt(k,72) +rxt(k,73))*y(k,126) + (rxt(k,343) +rxt(k,344)) & + *y(k,256) +rxt(k,19)*y(k,1) +.900_r8*rxt(k,20)*y(k,2) +rxt(k,21) & + *y(k,9) +1.500_r8*rxt(k,22)*y(k,10) +rxt(k,23)*y(k,11) & + +.600_r8*rxt(k,24)*y(k,12) +.600_r8*rxt(k,25)*y(k,13) +rxt(k,26) & + *y(k,14) +rxt(k,27)*y(k,24) +rxt(k,28)*y(k,28) +rxt(k,29)*y(k,31) & + +rxt(k,33)*y(k,46) +rxt(k,35)*y(k,50) +rxt(k,316)*y(k,294)*y(k,55) & + +.500_r8*rxt(k,41)*y(k,68) +2.000_r8*rxt(k,43)*y(k,76) & + +2.000_r8*rxt(k,44)*y(k,77) +rxt(k,181)*y(k,78) +rxt(k,177)*y(k,157) & + *y(k,81) +rxt(k,45)*y(k,89) +.670_r8*rxt(k,47)*y(k,97) & + +.620_r8*rxt(k,48)*y(k,98) +.560_r8*rxt(k,49)*y(k,99) +rxt(k,50) & + *y(k,100) +rxt(k,51)*y(k,101) +rxt(k,52)*y(k,102) +rxt(k,57)*y(k,107) & + +rxt(k,58)*y(k,108) +rxt(k,63)*y(k,114) +.450_r8*rxt(k,64)*y(k,115) & + +rxt(k,65)*y(k,116) +rxt(k,66)*y(k,117) +.450_r8*rxt(k,67)*y(k,118) & + +rxt(k,68)*y(k,119) +rxt(k,70)*y(k,121) +rxt(k,71)*y(k,123) & + +1.250_r8*rxt(k,74)*y(k,127) +rxt(k,75)*y(k,128) +.500_r8*rxt(k,80) & + *y(k,133) +.440_r8*rxt(k,81)*y(k,134) +rxt(k,82)*y(k,139) +rxt(k,83) & + *y(k,150) +rxt(k,87)*y(k,167) +rxt(k,88)*y(k,170) +rxt(k,90)*y(k,199) & + +rxt(k,91)*y(k,200) +rxt(k,92)*y(k,201) +rxt(k,93)*y(k,202) & + +rxt(k,94)*y(k,203) +rxt(k,96)*y(k,205) +rxt(k,102)*y(k,211) & + +rxt(k,103)*y(k,214) +rxt(k,104)*y(k,215) +.500_r8*rxt(k,105) & + *y(k,217) +.540_r8*rxt(k,106)*y(k,218) +.540_r8*rxt(k,108)*y(k,220) & + +rxt(k,109)*y(k,221) +rxt(k,110)*y(k,222) +rxt(k,111)*y(k,223) & + +rxt(k,112)*y(k,224) +rxt(k,113)*y(k,225) +rxt(k,114)*y(k,226) & + +rxt(k,115)*y(k,227) +rxt(k,116)*y(k,230) +rxt(k,117)*y(k,232) & + +.940_r8*rxt(k,625)*y(k,245)*y(k,245) +1.200_r8*rxt(k,324)*y(k,249) & + *y(k,249) +rxt(k,313)*y(k,259) +rxt(k,458)*y(k,269) +rxt(k,462) & + *y(k,270) +rxt(k,465)*y(k,271) +rxt(k,468)*y(k,272) & + +.400_r8*rxt(k,477)*y(k,274)*y(k,274) +.400_r8*rxt(k,529)*y(k,278) & + +.400_r8*rxt(k,532)*y(k,279) +.990_r8*rxt(k,648)*y(k,281)*y(k,281) + loss(k,162) = (rxt(k,314)* y(k,147) +rxt(k,312)* y(k,258) + rxt(k,313) & + + het_rates(k,259))* y(k,259) + prod(k,162) =rxt(k,298)*y(k,258)*y(k,43) + loss(k,221) = ((rxt(k,503) +rxt(k,504))* y(k,147) +rxt(k,421)* y(k,258) & + + het_rates(k,260))* y(k,260) + prod(k,221) = (.320_r8*rxt(k,418)*y(k,103) +.810_r8*rxt(k,420)*y(k,106)) & + *y(k,295) + loss(k,267) = ((rxt(k,505) +rxt(k,506))* y(k,147) +rxt(k,424)* y(k,252) & + +rxt(k,425)* y(k,253) +rxt(k,426)* y(k,258) + rxt(k,427) & + + rxt(k,428) + rxt(k,429) + het_rates(k,261))* y(k,261) + prod(k,267) =.530_r8*rxt(k,489)*y(k,295)*y(k,123) +rxt(k,436)*y(k,263) & + +rxt(k,438)*y(k,264) + loss(k,268) = ((rxt(k,507) +rxt(k,508))* y(k,147) +rxt(k,430)* y(k,252) & + +rxt(k,431)* y(k,253) +rxt(k,432)* y(k,258) + rxt(k,433) & + + rxt(k,434) + rxt(k,435) + het_rates(k,262))* y(k,262) + prod(k,268) =.160_r8*rxt(k,489)*y(k,295)*y(k,123) +rxt(k,440)*y(k,265) & + +rxt(k,442)*y(k,266) + loss(k,94) = ( + rxt(k,436) + rxt(k,437) + het_rates(k,263))* y(k,263) + prod(k,94) =.315_r8*rxt(k,487)*y(k,295)*y(k,109) +rxt(k,428)*y(k,261) & + +rxt(k,494)*y(k,278) + loss(k,95) = ( + rxt(k,438) + rxt(k,439) + het_rates(k,264))* y(k,264) + prod(k,95) =.315_r8*rxt(k,487)*y(k,295)*y(k,109) +rxt(k,429)*y(k,261) & + +rxt(k,447)*y(k,267) + loss(k,96) = ( + rxt(k,440) + rxt(k,441) + het_rates(k,265))* y(k,265) + prod(k,96) =.259_r8*rxt(k,487)*y(k,295)*y(k,109) +rxt(k,434)*y(k,262) & + +rxt(k,498)*y(k,279) + loss(k,97) = ( + rxt(k,442) + rxt(k,443) + het_rates(k,266))* y(k,266) + prod(k,97) =.111_r8*rxt(k,487)*y(k,295)*y(k,109) +rxt(k,435)*y(k,262) & + +rxt(k,451)*y(k,268) + loss(k,256) = ((rxt(k,509) +rxt(k,510))* y(k,147) +rxt(k,444)* y(k,252) & + +rxt(k,445)* y(k,253) +rxt(k,446)* y(k,258) + rxt(k,447) & + + het_rates(k,267))* y(k,267) + prod(k,256) =rxt(k,439)*y(k,264) + loss(k,257) = ((rxt(k,511) +rxt(k,512))* y(k,147) +rxt(k,448)* y(k,252) & + +rxt(k,449)* y(k,253) +rxt(k,450)* y(k,258) + rxt(k,451) & + + het_rates(k,268))* y(k,268) + prod(k,257) =rxt(k,443)*y(k,266) + loss(k,205) = ((rxt(k,513) +rxt(k,514))* y(k,147) +rxt(k,457)* y(k,258) & + + rxt(k,458) + het_rates(k,269))* y(k,269) + prod(k,205) =.820_r8*rxt(k,460)*y(k,295)*y(k,115) + loss(k,210) = ((rxt(k,515) +rxt(k,516))* y(k,147) +rxt(k,461)* y(k,258) & + + rxt(k,462) + het_rates(k,270))* y(k,270) + prod(k,210) =.850_r8*rxt(k,463)*y(k,295)*y(k,116) + loss(k,200) = ((rxt(k,517) +rxt(k,518))* y(k,147) +rxt(k,464)* y(k,258) & + + rxt(k,465) + het_rates(k,271))* y(k,271) + prod(k,200) =.870_r8*rxt(k,466)*y(k,295)*y(k,117) + loss(k,206) = ((rxt(k,519) +rxt(k,520))* y(k,147) +rxt(k,467)* y(k,258) & + + rxt(k,468) + het_rates(k,272))* y(k,272) + prod(k,206) =.890_r8*rxt(k,470)*y(k,295)*y(k,118) + loss(k,231) = ((rxt(k,521) +rxt(k,522))* y(k,147) +rxt(k,471)* y(k,258) & + + het_rates(k,273))* y(k,273) + prod(k,231) =.920_r8*rxt(k,472)*y(k,295)*y(k,119) + loss(k,275) = ((rxt(k,523) +rxt(k,524))* y(k,147) +rxt(k,478)* y(k,149) & + +rxt(k,474)* y(k,252) +rxt(k,475)* y(k,253) +rxt(k,476)* y(k,258) & + + 2._r8*rxt(k,477)* y(k,274) + het_rates(k,274))* y(k,274) + prod(k,275) = (.170_r8*rxt(k,481)*y(k,120) +.070_r8*rxt(k,485)*y(k,121)) & + *y(k,295) +rxt(k,473)*y(k,149)*y(k,109) + loss(k,222) = ((rxt(k,525) +rxt(k,526))* y(k,147) +rxt(k,479)* y(k,258) & + + rxt(k,480) + het_rates(k,275))* y(k,275) + prod(k,222) =.410_r8*rxt(k,481)*y(k,295)*y(k,120) + loss(k,226) = ((rxt(k,527) +rxt(k,528))* y(k,147) +rxt(k,482)* y(k,258) & + + rxt(k,483) + het_rates(k,276))* y(k,276) + prod(k,226) =.570_r8*rxt(k,485)*y(k,295)*y(k,121) + loss(k,51) = (rxt(k,861)* y(k,147) +rxt(k,860)* y(k,258) + het_rates(k,277)) & + * y(k,277) + prod(k,51) =rxt(k,863)*y(k,295)*y(k,109) + loss(k,262) = ((rxt(k,530) +rxt(k,531))* y(k,147) +rxt(k,491)* y(k,252) & + +rxt(k,492)* y(k,253) +rxt(k,493)* y(k,258) + rxt(k,494) & + + rxt(k,529) + het_rates(k,278))* y(k,278) + prod(k,262) =rxt(k,437)*y(k,263) + loss(k,261) = ((rxt(k,533) +rxt(k,534))* y(k,147) +rxt(k,495)* y(k,252) & + +rxt(k,496)* y(k,253) +rxt(k,497)* y(k,258) + rxt(k,498) & + + rxt(k,532) + het_rates(k,279))* y(k,279) + prod(k,261) =rxt(k,441)*y(k,265) + loss(k,52) = (rxt(k,865)* y(k,147) +rxt(k,864)* y(k,258) + het_rates(k,280)) & + * y(k,280) + prod(k,52) =rxt(k,866)*y(k,295)*y(k,124) + loss(k,289) = (rxt(k,649)* y(k,147) +rxt(k,650)* y(k,149) +rxt(k,645) & + * y(k,252) +rxt(k,646)* y(k,253) +rxt(k,647)* y(k,258) & + + 2._r8*rxt(k,648)* y(k,281) +rxt(k,651)* y(k,302) +rxt(k,652) & + * y(k,304) +rxt(k,653)* y(k,307) + het_rates(k,281))* y(k,281) + prod(k,289) =rxt(k,644)*y(k,149)*y(k,125) + loss(k,283) = (rxt(k,657)* y(k,147) +rxt(k,658)* y(k,149) +rxt(k,654) & + * y(k,252) +rxt(k,655)* y(k,253) +rxt(k,656)* y(k,258) +rxt(k,659) & + * y(k,302) +rxt(k,660)* y(k,304) +rxt(k,661)* y(k,307) & + + het_rates(k,282))* y(k,282) + prod(k,283) =rxt(k,663)*y(k,295)*y(k,125) + loss(k,54) = (rxt(k,869)* y(k,147) +rxt(k,868)* y(k,258) + het_rates(k,283)) & + * y(k,283) + prod(k,54) =rxt(k,871)*y(k,295)*y(k,125) + loss(k,243) = ((rxt(k,535) +rxt(k,536))* y(k,147) +rxt(k,381)* y(k,252) & + +rxt(k,382)* y(k,253) +rxt(k,383)* y(k,258) + rxt(k,384) & + + het_rates(k,284))* y(k,284) + prod(k,243) =.190_r8*rxt(k,49)*y(k,99) +.550_r8*rxt(k,386)*y(k,295)*y(k,126) + loss(k,180) = (rxt(k,559)* y(k,147) +rxt(k,560)* y(k,148) +rxt(k,558) & + * y(k,258) + het_rates(k,285))* y(k,285) + prod(k,180) =.600_r8*rxt(k,23)*y(k,11) + loss(k,248) = (rxt(k,392)* y(k,147) +rxt(k,406)* y(k,148) +rxt(k,393) & + * y(k,149) +rxt(k,388)* y(k,252) +rxt(k,389)* y(k,253) +rxt(k,390) & + * y(k,258) + 2._r8*rxt(k,391)* y(k,286) + het_rates(k,286))* y(k,286) + prod(k,248) = (rxt(k,73) +.450_r8*rxt(k,386)*y(k,295))*y(k,126) & + + (rxt(k,78) +rxt(k,407))*y(k,131) + loss(k,188) = (rxt(k,562)* y(k,147) +rxt(k,563)* y(k,148) +rxt(k,561) & + * y(k,258) + het_rates(k,287))* y(k,287) + prod(k,188) =.600_r8*rxt(k,25)*y(k,13) + loss(k,169) = (rxt(k,395)* y(k,147) +rxt(k,394)* y(k,258) + het_rates(k,288)) & + * y(k,288) + prod(k,169) = (rxt(k,396)*y(k,129) +rxt(k,397)*y(k,130))*y(k,295) + loss(k,240) = ((rxt(k,537) +rxt(k,538))* y(k,147) +rxt(k,400)* y(k,252) & + +rxt(k,401)* y(k,253) +rxt(k,402)* y(k,258) + het_rates(k,289)) & + * y(k,289) + prod(k,240) =.230_r8*rxt(k,48)*y(k,98) +rxt(k,404)*y(k,295)*y(k,132) + loss(k,291) = (rxt(k,669)* y(k,147) +rxt(k,670)* y(k,149) +rxt(k,665) & + * y(k,252) +rxt(k,666)* y(k,253) +rxt(k,667)* y(k,258) & + + 2._r8*rxt(k,668)* y(k,290) +rxt(k,671)* y(k,302) +rxt(k,672) & + * y(k,304) +rxt(k,673)* y(k,307) + het_rates(k,290))* y(k,290) + prod(k,291) =rxt(k,664)*y(k,149)*y(k,135) + loss(k,288) = (rxt(k,677)* y(k,147) +rxt(k,678)* y(k,149) +rxt(k,674) & + * y(k,252) +rxt(k,675)* y(k,253) +rxt(k,676)* y(k,258) +rxt(k,679) & + * y(k,302) +rxt(k,680)* y(k,304) +rxt(k,681)* y(k,307) & + + het_rates(k,291))* y(k,291) + prod(k,288) =rxt(k,683)*y(k,295)*y(k,135) + loss(k,55) = (rxt(k,874)* y(k,147) +rxt(k,873)* y(k,258) + het_rates(k,292)) & + * y(k,292) + prod(k,55) =rxt(k,876)*y(k,295)*y(k,135) + loss(k,249) = ((rxt(k,539) +rxt(k,540))* y(k,147) +rxt(k,499)* y(k,258) & + + rxt(k,500) + het_rates(k,293))* y(k,293) + prod(k,249) = (.400_r8*rxt(k,422)*y(k,107) +.350_r8*rxt(k,423)*y(k,108) + & + .230_r8*rxt(k,502)*y(k,139))*y(k,295) + loss(k,314) = (rxt(k,243)* y(k,34) +rxt(k,244)* y(k,35) +rxt(k,270)* y(k,36) & + +rxt(k,245)* y(k,37) +rxt(k,246)* y(k,38) +rxt(k,247)* y(k,39) & + +rxt(k,248)* y(k,40) +rxt(k,249)* y(k,41) +rxt(k,293)* y(k,42) & + +rxt(k,294)* y(k,44) + (rxt(k,315) +rxt(k,316) +rxt(k,317))* y(k,55) & + +rxt(k,271)* y(k,56) +rxt(k,279)* y(k,65) +rxt(k,280)* y(k,66) & + +rxt(k,168)* y(k,79) +rxt(k,272)* y(k,80) + (rxt(k,273) +rxt(k,274)) & + * y(k,83) +rxt(k,295)* y(k,84) +rxt(k,296)* y(k,85) +rxt(k,297) & + * y(k,86) + (rxt(k,250) +rxt(k,251))* y(k,87) +rxt(k,318)* y(k,88) & + + (rxt(k,210) +rxt(k,211))* y(k,137) +rxt(k,172)* y(k,158) & + +rxt(k,169)* y(k,319) + rxt(k,170) + rxt(k,171) + het_rates(k,294)) & + * y(k,294) + prod(k,314) =rxt(k,12)*y(k,137) +rxt(k,7)*y(k,158) +rxt(k,1)*y(k,319) + loss(k,316) = (rxt(k,408)* y(k,1) +rxt(k,412)* y(k,2) +rxt(k,603)* y(k,4) & + +rxt(k,623)* y(k,7) +rxt(k,543)* y(k,8) +rxt(k,546)* y(k,9) & + +rxt(k,413)* y(k,15) +rxt(k,375)* y(k,16) +rxt(k,643)* y(k,17) & + +rxt(k,266)* y(k,20) +rxt(k,547)* y(k,23) +rxt(k,549)* y(k,24) & + +rxt(k,321)* y(k,25) +rxt(k,350)* y(k,26) +rxt(k,328)* y(k,27) & + +rxt(k,329)* y(k,28) +rxt(k,331)* y(k,29) +rxt(k,372)* y(k,30) & + +rxt(k,358)* y(k,31) +rxt(k,359)* y(k,32) +rxt(k,553)* y(k,33) & + +rxt(k,282)* y(k,42) +rxt(k,301)* y(k,43) +rxt(k,284)* y(k,44) & + +rxt(k,285)* y(k,45) +rxt(k,333)* y(k,46) +rxt(k,287)* y(k,47) & + +rxt(k,334)* y(k,48) +rxt(k,373)* y(k,49) +rxt(k,361)* y(k,50) & + +rxt(k,339)* y(k,51) +rxt(k,340)* y(k,52) +rxt(k,306)* y(k,53) & + +rxt(k,307)* y(k,54) +rxt(k,308)* y(k,55) +rxt(k,289)* y(k,56) & + + (rxt(k,236) +rxt(k,237))* y(k,60) +rxt(k,234)* y(k,61) +rxt(k,319) & + * y(k,63) +rxt(k,554)* y(k,67) + (rxt(k,794) +rxt(k,808))* y(k,69) & + +rxt(k,345)* y(k,76) +rxt(k,346)* y(k,77) +rxt(k,185)* y(k,79) & + +rxt(k,186)* y(k,81) +rxt(k,268)* y(k,83) +rxt(k,290)* y(k,84) & + +rxt(k,291)* y(k,85) +rxt(k,292)* y(k,86) +rxt(k,239)* y(k,87) & + +rxt(k,309)* y(k,88) +rxt(k,347)* y(k,89) +rxt(k,310)* y(k,90) & + +rxt(k,311)* y(k,92) +rxt(k,215)* y(k,93) +rxt(k,193)* y(k,94) & + +rxt(k,242)* y(k,96) +rxt(k,379)* y(k,97) +rxt(k,414)* y(k,98) & + +rxt(k,415)* y(k,99) +rxt(k,362)* y(k,102) +rxt(k,418)* y(k,103) & + +rxt(k,363)* y(k,104) +rxt(k,420)* y(k,106) +rxt(k,422)* y(k,107) & + +rxt(k,423)* y(k,108) +rxt(k,487)* y(k,109) +rxt(k,453)* y(k,110) & + +rxt(k,452)* y(k,111) +rxt(k,454)* y(k,112) +rxt(k,455)* y(k,113) & + +rxt(k,460)* y(k,115) +rxt(k,463)* y(k,116) +rxt(k,466)* y(k,117) & + +rxt(k,470)* y(k,118) +rxt(k,472)* y(k,119) +rxt(k,481)* y(k,120) & + +rxt(k,485)* y(k,121) +rxt(k,488)* y(k,122) + (rxt(k,489) + & + rxt(k,490))* y(k,123) +rxt(k,663)* y(k,125) +rxt(k,386)* y(k,126) & + +rxt(k,380)* y(k,127) +rxt(k,396)* y(k,129) +rxt(k,397)* y(k,130) & + +rxt(k,398)* y(k,131) +rxt(k,404)* y(k,132) +rxt(k,399)* y(k,133) & + +rxt(k,405)* y(k,134) +rxt(k,683)* y(k,135) +rxt(k,206)* y(k,136) & + +rxt(k,502)* y(k,139) +rxt(k,810)* y(k,143) +rxt(k,214)* y(k,148) & + +rxt(k,205)* y(k,149) +rxt(k,348)* y(k,150) +rxt(k,364)* y(k,151) & + +rxt(k,188)* y(k,157) +rxt(k,189)* y(k,158) +rxt(k,796)* y(k,161) & + +rxt(k,349)* y(k,163) +rxt(k,566)* y(k,166) +rxt(k,569)* y(k,167) & + +rxt(k,367)* y(k,170) +rxt(k,371)* y(k,171) +rxt(k,802)* y(k,172) & + +rxt(k,807)* y(k,174) +rxt(k,798)* y(k,175) +rxt(k,689)* y(k,200) & + +rxt(k,690)* y(k,201) +rxt(k,756)* y(k,202) +rxt(k,717)* y(k,203) & + +rxt(k,718)* y(k,204) +rxt(k,736)* y(k,205) +rxt(k,737)* y(k,206) & + +rxt(k,748)* y(k,207) +rxt(k,746)* y(k,208) +rxt(k,747)* y(k,209) & + +rxt(k,757)* y(k,210) +rxt(k,763)* y(k,212) +rxt(k,768)* y(k,213) & + +rxt(k,769)* y(k,214) +rxt(k,771)* y(k,216) +rxt(k,775)* y(k,217) & + +rxt(k,774)* y(k,218) +rxt(k,778)* y(k,220) +rxt(k,783)* y(k,221) & + +rxt(k,782)* y(k,222) +rxt(k,787)* y(k,223) +rxt(k,786)* y(k,224) & + +rxt(k,573)* y(k,227) +rxt(k,574)* y(k,228) +rxt(k,576)* y(k,229) & + +rxt(k,579)* y(k,230) +rxt(k,582)* y(k,231) +rxt(k,583)* y(k,232) & + +rxt(k,187)* y(k,258) + 2._r8*(rxt(k,190) +rxt(k,191))* y(k,295) & + + het_rates(k,295))* y(k,295) + prod(k,316) = (2.000_r8*rxt(k,179)*y(k,78) +rxt(k,182)*y(k,157) + & + rxt(k,183)*y(k,158) +rxt(k,202)*y(k,149) +rxt(k,207)*y(k,147) + & + rxt(k,223)*y(k,57) +.200_r8*rxt(k,312)*y(k,259) + & + .490_r8*rxt(k,337)*y(k,252) +.150_r8*rxt(k,369)*y(k,298) + & + .590_r8*rxt(k,383)*y(k,284) +.490_r8*rxt(k,390)*y(k,286) + & + .200_r8*rxt(k,394)*y(k,288) +.540_r8*rxt(k,402)*y(k,289) + & + .650_r8*rxt(k,421)*y(k,260) +.060_r8*rxt(k,426)*y(k,261) + & + .060_r8*rxt(k,432)*y(k,262) +.580_r8*rxt(k,457)*y(k,269) + & + .520_r8*rxt(k,461)*y(k,270) +.600_r8*rxt(k,464)*y(k,271) + & + .500_r8*rxt(k,467)*y(k,272) +.400_r8*rxt(k,471)*y(k,273) + & + .240_r8*rxt(k,476)*y(k,274) +.850_r8*rxt(k,479)*y(k,275) + & + .860_r8*rxt(k,482)*y(k,276) +.800_r8*rxt(k,499)*y(k,293) + & + .400_r8*rxt(k,541)*y(k,235) +.400_r8*rxt(k,555)*y(k,254) + & + .400_r8*rxt(k,561)*y(k,287) +.700_r8*rxt(k,588)*y(k,237) + & + .350_r8*rxt(k,596)*y(k,238) +.500_r8*rxt(k,608)*y(k,240) + & + .100_r8*rxt(k,616)*y(k,241) +.470_r8*rxt(k,628)*y(k,245) + & + .030_r8*rxt(k,636)*y(k,246) +.500_r8*rxt(k,647)*y(k,281) + & + .100_r8*rxt(k,656)*y(k,282) +.480_r8*rxt(k,667)*y(k,290) + & + .100_r8*rxt(k,676)*y(k,291) +.180_r8*rxt(k,687)*y(k,299) + & + .180_r8*rxt(k,691)*y(k,300) +.490_r8*rxt(k,703)*y(k,302) + & + .380_r8*rxt(k,711)*y(k,303) +.490_r8*rxt(k,721)*y(k,304) + & + .150_r8*rxt(k,730)*y(k,305) +.530_r8*rxt(k,740)*y(k,306) + & + .490_r8*rxt(k,751)*y(k,307) +.100_r8*rxt(k,760)*y(k,308) + & + .100_r8*rxt(k,765)*y(k,309) +.100_r8*rxt(k,772)*y(k,310) + & + .100_r8*rxt(k,776)*y(k,311) +.100_r8*rxt(k,780)*y(k,312) + & + .100_r8*rxt(k,784)*y(k,313))*y(k,258) + (.300_r8*rxt(k,307)*y(k,54) + & + .500_r8*rxt(k,311)*y(k,92) +.650_r8*rxt(k,321)*y(k,25) + & + .500_r8*rxt(k,329)*y(k,28) +.890_r8*rxt(k,347)*y(k,89) + & + .700_r8*rxt(k,363)*y(k,104) +.500_r8*rxt(k,367)*y(k,170) + & + .430_r8*rxt(k,414)*y(k,98) +.530_r8*rxt(k,415)*y(k,99) + & + 1.080_r8*rxt(k,418)*y(k,103) +.500_r8*rxt(k,454)*y(k,112) + & + .060_r8*rxt(k,460)*y(k,115) +.040_r8*rxt(k,470)*y(k,118) + & + .030_r8*rxt(k,472)*y(k,119) +.420_r8*rxt(k,481)*y(k,120) + & + .290_r8*rxt(k,485)*y(k,121) +.130_r8*rxt(k,489)*y(k,123) + & + .920_r8*rxt(k,490)*y(k,123))*y(k,295) + (rxt(k,184)*y(k,78) + & + .130_r8*rxt(k,323)*y(k,26) +.360_r8*rxt(k,354)*y(k,30) + & + .240_r8*rxt(k,385)*y(k,126) +.360_r8*rxt(k,403)*y(k,132) + & + .340_r8*rxt(k,459)*y(k,115) +.340_r8*rxt(k,469)*y(k,118) + & + .510_r8*rxt(k,484)*y(k,121) +.250_r8*rxt(k,486)*y(k,109) + & + .340_r8*rxt(k,501)*y(k,139) +.770_r8*rxt(k,602)*y(k,4) + & + .080_r8*rxt(k,622)*y(k,7) +.300_r8*rxt(k,642)*y(k,17) + & + .660_r8*rxt(k,662)*y(k,125) +.630_r8*rxt(k,682)*y(k,135) + & + .090_r8*rxt(k,762)*y(k,212))*y(k,158) + (rxt(k,176)*y(k,79) + & + rxt(k,177)*y(k,81) +rxt(k,238)*y(k,87) +rxt(k,241)*y(k,96) + & + rxt(k,267)*y(k,83) +rxt(k,269)*y(k,95) +rxt(k,300)*y(k,43))*y(k,157) & + + (.550_r8*rxt(k,509)*y(k,267) +.550_r8*rxt(k,511)*y(k,268) + & + .470_r8*rxt(k,525)*y(k,275) +.040_r8*rxt(k,527)*y(k,276) + & + .550_r8*rxt(k,530)*y(k,278) +.550_r8*rxt(k,533)*y(k,279))*y(k,147) & + + (rxt(k,168)*y(k,79) +2.000_r8*rxt(k,169)*y(k,319) + & + rxt(k,250)*y(k,87) +rxt(k,273)*y(k,83) +rxt(k,315)*y(k,55) + & + rxt(k,318)*y(k,88))*y(k,294) + (.550_r8*rxt(k,444)*y(k,267) + & + .550_r8*rxt(k,448)*y(k,268) +.550_r8*rxt(k,491)*y(k,278) + & + .550_r8*rxt(k,495)*y(k,279))*y(k,252) & + + (.280_r8*rxt(k,445)*y(k,267) +.280_r8*rxt(k,449)*y(k,268) + & + .280_r8*rxt(k,492)*y(k,278) +.280_r8*rxt(k,496)*y(k,279))*y(k,253) & + + (rxt(k,55) +rxt(k,56))*y(k,104) + (rxt(k,2) +rxt(k,277)*y(k,75)) & + *y(k,319) +rxt(k,20)*y(k,2) +rxt(k,21)*y(k,9) +rxt(k,27)*y(k,24) & + +rxt(k,28)*y(k,28) +rxt(k,29)*y(k,31) +rxt(k,30)*y(k,33) +rxt(k,36) & + *y(k,52) +rxt(k,37)*y(k,54) +.330_r8*rxt(k,39)*y(k,55) & + +1.500_r8*rxt(k,41)*y(k,68) +rxt(k,42)*y(k,74) +2.000_r8*rxt(k,4) & + *y(k,81) +rxt(k,45)*y(k,89) +2.000_r8*rxt(k,46)*y(k,92) +rxt(k,9) & + *y(k,93) +rxt(k,10)*y(k,94) +rxt(k,149)*y(k,95) +rxt(k,150)*y(k,96) & + +1.110_r8*rxt(k,48)*y(k,98) +1.180_r8*rxt(k,49)*y(k,99) +rxt(k,50) & + *y(k,100) +rxt(k,51)*y(k,101) +3.000_r8*rxt(k,54)*y(k,103) +rxt(k,61) & + *y(k,112) +rxt(k,62)*y(k,113) +rxt(k,63)*y(k,114) +.550_r8*rxt(k,64) & + *y(k,115) +.550_r8*rxt(k,67)*y(k,118) +rxt(k,69)*y(k,120) +rxt(k,70) & + *y(k,121) +rxt(k,71)*y(k,123) +rxt(k,75)*y(k,128) +rxt(k,77)*y(k,130) & + +rxt(k,81)*y(k,134) +.500_r8*rxt(k,830)*y(k,148) +rxt(k,87)*y(k,167) & + +rxt(k,88)*y(k,170) +rxt(k,89)*y(k,171) +rxt(k,91)*y(k,200) & + +rxt(k,92)*y(k,201) +rxt(k,98)*y(k,207) +rxt(k,99)*y(k,208) & + +rxt(k,100)*y(k,209) +rxt(k,102)*y(k,211) +rxt(k,104)*y(k,215) & + +rxt(k,105)*y(k,217) +rxt(k,106)*y(k,218) +rxt(k,107)*y(k,219) & + +rxt(k,108)*y(k,220) +rxt(k,113)*y(k,225) +rxt(k,114)*y(k,226) & + +rxt(k,115)*y(k,227) +rxt(k,116)*y(k,230) +rxt(k,117)*y(k,232) & + +rxt(k,427)*y(k,261) +rxt(k,433)*y(k,262) +rxt(k,480)*y(k,275) & + +rxt(k,483)*y(k,276) +.600_r8*rxt(k,529)*y(k,278) & + +.600_r8*rxt(k,532)*y(k,279) +rxt(k,384)*y(k,284) +rxt(k,500) & + *y(k,293) + loss(k,130) = (rxt(k,565)* y(k,147) +rxt(k,564)* y(k,258) + het_rates(k,296)) & + * y(k,296) + prod(k,130) = (.200_r8*rxt(k,554)*y(k,67) +.140_r8*rxt(k,566)*y(k,166) + & + rxt(k,569)*y(k,167))*y(k,295) + loss(k,189) = (rxt(k,366)* y(k,147) +rxt(k,365)* y(k,258) + het_rates(k,297)) & + * y(k,297) + prod(k,189) = (.500_r8*rxt(k,367)*y(k,170) +rxt(k,372)*y(k,30))*y(k,295) + loss(k,224) = (rxt(k,370)* y(k,147) +rxt(k,368)* y(k,253) +rxt(k,369) & + * y(k,258) + het_rates(k,298))* y(k,298) + prod(k,224) = (rxt(k,371)*y(k,171) +rxt(k,373)*y(k,49))*y(k,295) + loss(k,190) = (rxt(k,688)* y(k,147) +rxt(k,687)* y(k,258) + het_rates(k,299)) & + * y(k,299) + prod(k,190) =rxt(k,689)*y(k,295)*y(k,200) + loss(k,196) = (rxt(k,692)* y(k,147) +rxt(k,691)* y(k,258) + het_rates(k,300)) & + * y(k,300) + prod(k,196) =rxt(k,690)*y(k,295)*y(k,201) + loss(k,294) = (rxt(k,696)* y(k,147) +rxt(k,697)* y(k,149) +rxt(k,693) & + * y(k,252) +rxt(k,694)* y(k,253) +rxt(k,695)* y(k,258) +rxt(k,698) & + * y(k,302) +rxt(k,699)* y(k,304) + het_rates(k,301))* y(k,301) + prod(k,294) = (rxt(k,593)*y(k,237) +rxt(k,601)*y(k,238) + & + rxt(k,613)*y(k,240) +rxt(k,621)*y(k,241) +rxt(k,633)*y(k,245) + & + rxt(k,641)*y(k,246) +rxt(k,653)*y(k,281) +rxt(k,661)*y(k,282) + & + rxt(k,673)*y(k,290) +rxt(k,681)*y(k,291) +rxt(k,707)*y(k,302) + & + rxt(k,716)*y(k,303) +rxt(k,726)*y(k,304) +rxt(k,735)*y(k,305) + & + rxt(k,745)*y(k,306) +rxt(k,749)*y(k,252) +rxt(k,750)*y(k,253) + & + .490_r8*rxt(k,751)*y(k,258) +rxt(k,752)*y(k,147) + & + rxt(k,753)*y(k,149) +2.000_r8*rxt(k,754)*y(k,307))*y(k,307) & + + (rxt(k,98) +.290_r8*rxt(k,748)*y(k,295))*y(k,207) +rxt(k,93) & + *y(k,202) +.860_r8*rxt(k,771)*y(k,295)*y(k,216) + loss(k,297) = (rxt(k,704)* y(k,147) +rxt(k,684)* y(k,148) +rxt(k,705) & + * y(k,149) +rxt(k,591)* y(k,237) +rxt(k,599)* y(k,238) +rxt(k,611) & + * y(k,240) +rxt(k,619)* y(k,241) +rxt(k,631)* y(k,245) +rxt(k,639) & + * y(k,246) +rxt(k,701)* y(k,252) +rxt(k,702)* y(k,253) +rxt(k,703) & + * y(k,258) +rxt(k,651)* y(k,281) +rxt(k,659)* y(k,282) +rxt(k,671) & + * y(k,290) +rxt(k,679)* y(k,291) +rxt(k,698)* y(k,301) & + + 2._r8*rxt(k,706)* y(k,302) +rxt(k,714)* y(k,303) +rxt(k,724) & + * y(k,304) +rxt(k,733)* y(k,305) +rxt(k,743)* y(k,306) +rxt(k,707) & + * y(k,307) + het_rates(k,302))* y(k,302) + prod(k,297) = (rxt(k,717)*y(k,203) +.710_r8*rxt(k,746)*y(k,208) + & + .140_r8*rxt(k,771)*y(k,216))*y(k,295) + (.270_r8*rxt(k,602)*y(k,4) + & + .300_r8*rxt(k,642)*y(k,17))*y(k,158) + (rxt(k,95) +rxt(k,790)) & + *y(k,204) +rxt(k,708)*y(k,203)*y(k,149) + loss(k,296) = (rxt(k,712)* y(k,147) +rxt(k,713)* y(k,149) +rxt(k,709) & + * y(k,252) +rxt(k,710)* y(k,253) +rxt(k,711)* y(k,258) +rxt(k,715) & + * y(k,304) +rxt(k,716)* y(k,307) + het_rates(k,303))* y(k,303) + prod(k,296) = (rxt(k,591)*y(k,237) +rxt(k,599)*y(k,238) + & + rxt(k,611)*y(k,240) +rxt(k,619)*y(k,241) +rxt(k,631)*y(k,245) + & + rxt(k,639)*y(k,246) +rxt(k,651)*y(k,281) +rxt(k,659)*y(k,282) + & + rxt(k,671)*y(k,290) +rxt(k,679)*y(k,291) + & + 2.000_r8*rxt(k,698)*y(k,301) +rxt(k,701)*y(k,252) + & + rxt(k,702)*y(k,253) +.490_r8*rxt(k,703)*y(k,258) + & + rxt(k,704)*y(k,147) +rxt(k,705)*y(k,149) + & + 2.000_r8*rxt(k,706)*y(k,302) +rxt(k,707)*y(k,307) + & + rxt(k,724)*y(k,304) +rxt(k,733)*y(k,305) +rxt(k,743)*y(k,306)) & + *y(k,302) + (rxt(k,693)*y(k,252) +.500_r8*rxt(k,694)*y(k,253) + & + .700_r8*rxt(k,696)*y(k,147) +rxt(k,697)*y(k,149) + & + rxt(k,699)*y(k,304) +rxt(k,700)*y(k,307))*y(k,301) + (rxt(k,99) + & + .290_r8*rxt(k,746)*y(k,295))*y(k,208) +.330_r8*rxt(k,602)*y(k,158) & + *y(k,4) +.230_r8*rxt(k,756)*y(k,295)*y(k,202) +rxt(k,94)*y(k,203) + loss(k,298) = (rxt(k,722)* y(k,147) +rxt(k,685)* y(k,148) +rxt(k,723) & + * y(k,149) +rxt(k,592)* y(k,237) +rxt(k,600)* y(k,238) +rxt(k,612) & + * y(k,240) +rxt(k,620)* y(k,241) +rxt(k,632)* y(k,245) +rxt(k,640) & + * y(k,246) +rxt(k,719)* y(k,252) +rxt(k,720)* y(k,253) +rxt(k,721) & + * y(k,258) +rxt(k,652)* y(k,281) +rxt(k,660)* y(k,282) +rxt(k,672) & + * y(k,290) +rxt(k,680)* y(k,291) +rxt(k,699)* y(k,301) +rxt(k,724) & + * y(k,302) +rxt(k,715)* y(k,303) + 2._r8*rxt(k,725)* y(k,304) & + +rxt(k,734)* y(k,305) +rxt(k,744)* y(k,306) +rxt(k,726)* y(k,307) & + + het_rates(k,304))* y(k,304) + prod(k,298) = (.750_r8*rxt(k,736)*y(k,205) +.710_r8*rxt(k,747)*y(k,209) + & + .170_r8*rxt(k,763)*y(k,212))*y(k,295) + (rxt(k,97) +rxt(k,791)) & + *y(k,206) +.330_r8*rxt(k,662)*y(k,158)*y(k,125) +rxt(k,727)*y(k,205) & + *y(k,149) + loss(k,278) = (rxt(k,731)* y(k,147) +rxt(k,732)* y(k,149) +rxt(k,728) & + * y(k,252) +rxt(k,729)* y(k,253) +rxt(k,730)* y(k,258) +rxt(k,733) & + * y(k,302) +rxt(k,734)* y(k,304) +rxt(k,735)* y(k,307) & + + het_rates(k,305))* y(k,305) + prod(k,278) = (rxt(k,709)*y(k,252) +rxt(k,710)*y(k,253) + & + .380_r8*rxt(k,711)*y(k,258) +.830_r8*rxt(k,712)*y(k,147) + & + rxt(k,713)*y(k,149) +rxt(k,714)*y(k,302) +rxt(k,715)*y(k,304) + & + rxt(k,716)*y(k,307))*y(k,303) + loss(k,295) = (rxt(k,741)* y(k,147) +rxt(k,742)* y(k,149) +rxt(k,738) & + * y(k,252) +rxt(k,739)* y(k,253) +rxt(k,740)* y(k,258) +rxt(k,743) & + * y(k,302) +rxt(k,745)* y(k,307) + het_rates(k,306))* y(k,306) + prod(k,295) = (rxt(k,592)*y(k,237) +rxt(k,600)*y(k,238) + & + rxt(k,612)*y(k,240) +rxt(k,620)*y(k,241) +rxt(k,632)*y(k,245) + & + rxt(k,640)*y(k,246) +rxt(k,652)*y(k,281) +rxt(k,660)*y(k,282) + & + rxt(k,672)*y(k,290) +rxt(k,680)*y(k,291) +rxt(k,699)*y(k,301) + & + rxt(k,715)*y(k,303) +rxt(k,719)*y(k,252) +rxt(k,720)*y(k,253) + & + .490_r8*rxt(k,721)*y(k,258) +rxt(k,722)*y(k,147) + & + rxt(k,723)*y(k,149) +rxt(k,724)*y(k,302) + & + 2.000_r8*rxt(k,725)*y(k,304) +rxt(k,726)*y(k,307) + & + 2.000_r8*rxt(k,734)*y(k,305))*y(k,304) + (rxt(k,728)*y(k,252) + & + rxt(k,729)*y(k,253) +.150_r8*rxt(k,730)*y(k,258) + & + .700_r8*rxt(k,731)*y(k,147) +rxt(k,732)*y(k,149) + & + rxt(k,733)*y(k,302) +rxt(k,735)*y(k,307))*y(k,305) + (rxt(k,96) + & + .250_r8*rxt(k,736)*y(k,295))*y(k,205) + (rxt(k,100) + & + .290_r8*rxt(k,747)*y(k,295))*y(k,209) + loss(k,299) = (rxt(k,752)* y(k,147) +rxt(k,686)* y(k,148) +rxt(k,753) & + * y(k,149) +rxt(k,593)* y(k,237) +rxt(k,601)* y(k,238) +rxt(k,613) & + * y(k,240) +rxt(k,621)* y(k,241) +rxt(k,633)* y(k,245) +rxt(k,641) & + * y(k,246) +rxt(k,749)* y(k,252) +rxt(k,750)* y(k,253) +rxt(k,751) & + * y(k,258) +rxt(k,653)* y(k,281) +rxt(k,661)* y(k,282) +rxt(k,673) & + * y(k,290) +rxt(k,681)* y(k,291) +rxt(k,700)* y(k,301) +rxt(k,707) & + * y(k,302) +rxt(k,716)* y(k,303) +rxt(k,726)* y(k,304) +rxt(k,735) & + * y(k,305) +rxt(k,745)* y(k,306) + 2._r8*rxt(k,754)* y(k,307) & + + het_rates(k,307))* y(k,307) + prod(k,299) = (rxt(k,755)*y(k,149) +.770_r8*rxt(k,756)*y(k,295))*y(k,202) & + + (rxt(k,101) +rxt(k,792))*y(k,210) +.710_r8*rxt(k,748)*y(k,295) & + *y(k,207) + loss(k,174) = (rxt(k,761)* y(k,147) +rxt(k,760)* y(k,258) + het_rates(k,308)) & + * y(k,308) + prod(k,174) =.830_r8*rxt(k,763)*y(k,295)*y(k,212) + loss(k,191) = (rxt(k,766)* y(k,147) +rxt(k,765)* y(k,258) + het_rates(k,309)) & + * y(k,309) + prod(k,191) =rxt(k,768)*y(k,295)*y(k,213) + loss(k,214) = (rxt(k,773)* y(k,147) +rxt(k,772)* y(k,258) + het_rates(k,310)) & + * y(k,310) + prod(k,214) =rxt(k,774)*y(k,295)*y(k,218) + loss(k,197) = (rxt(k,777)* y(k,147) +rxt(k,776)* y(k,258) + het_rates(k,311)) & + * y(k,311) + prod(k,197) =rxt(k,778)*y(k,295)*y(k,220) + loss(k,175) = (rxt(k,781)* y(k,147) +rxt(k,780)* y(k,258) + het_rates(k,312)) & + * y(k,312) + prod(k,175) =rxt(k,782)*y(k,295)*y(k,222) + loss(k,176) = (rxt(k,785)* y(k,147) +rxt(k,784)* y(k,258) + het_rates(k,313)) & + * y(k,313) + prod(k,176) =rxt(k,786)*y(k,295)*y(k,224) + loss(k,181) = (rxt(k,572)* y(k,147) +rxt(k,571)* y(k,258) + het_rates(k,314)) & + * y(k,314) + prod(k,181) = (rxt(k,573)*y(k,227) +.650_r8*rxt(k,574)*y(k,228))*y(k,295) + loss(k,56) = (rxt(k,880)* y(k,147) +rxt(k,879)* y(k,258) + het_rates(k,315)) & + * y(k,315) + prod(k,56) =rxt(k,878)*y(k,295)*y(k,228) + loss(k,183) = (rxt(k,578)* y(k,147) +rxt(k,577)* y(k,258) + het_rates(k,316)) & + * y(k,316) + prod(k,183) = (.560_r8*rxt(k,576)*y(k,229) +rxt(k,579)*y(k,230))*y(k,295) + loss(k,57) = (rxt(k,883)* y(k,147) +rxt(k,882)* y(k,258) + het_rates(k,317)) & + * y(k,317) + prod(k,57) =rxt(k,881)*y(k,295)*y(k,229) + loss(k,142) = (rxt(k,581)* y(k,147) +rxt(k,580)* y(k,258) + het_rates(k,318)) & + * y(k,318) + prod(k,142) = (.300_r8*rxt(k,582)*y(k,231) +rxt(k,583)*y(k,232))*y(k,295) + loss(k,317) = (rxt(k,277)* y(k,75) +rxt(k,809)* y(k,176) +rxt(k,169) & + * y(k,294) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,319)) & + * y(k,319) + prod(k,317) = (rxt(k,185)*y(k,79) +rxt(k,186)*y(k,81) +rxt(k,187)*y(k,258) + & + rxt(k,190)*y(k,295) +rxt(k,193)*y(k,94) +rxt(k,215)*y(k,93) + & + rxt(k,239)*y(k,87) +rxt(k,242)*y(k,96) +rxt(k,268)*y(k,83) + & + rxt(k,282)*y(k,42) +rxt(k,284)*y(k,44) +rxt(k,285)*y(k,45) + & + rxt(k,287)*y(k,47) +rxt(k,292)*y(k,86) +rxt(k,301)*y(k,43) + & + rxt(k,307)*y(k,54) +rxt(k,308)*y(k,55) +rxt(k,310)*y(k,90) + & + rxt(k,311)*y(k,92) +rxt(k,331)*y(k,29) +rxt(k,333)*y(k,46) + & + rxt(k,339)*y(k,51) +rxt(k,340)*y(k,52) +rxt(k,358)*y(k,31) + & + rxt(k,359)*y(k,32) +rxt(k,361)*y(k,50) +rxt(k,367)*y(k,170) + & + rxt(k,371)*y(k,171) +rxt(k,373)*y(k,49) + & + .450_r8*rxt(k,386)*y(k,126) +rxt(k,775)*y(k,217) + & + rxt(k,779)*y(k,219) +rxt(k,810)*y(k,143))*y(k,295) & + + (rxt(k,885)*y(k,96) +rxt(k,891)*y(k,96) +rxt(k,892)*y(k,95) + & + rxt(k,896)*y(k,96) +rxt(k,897)*y(k,95))*y(k,87) + (rxt(k,812) + & + rxt(k,180)*y(k,78) +.300_r8*rxt(k,312)*y(k,259))*y(k,258) & + +.050_r8*rxt(k,39)*y(k,55) +rxt(k,153)*y(k,82) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_trop_strat_mam5_ts2/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..9b4228edd5 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/mo_rxt_rates_conv.F90 @@ -0,0 +1,916 @@ +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,:, 319) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 319) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 319) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 81) ! rate_const*H2O2 + ! rate_const*O2 + ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 158) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 158) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 93) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 94) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 94) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 137) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 138) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 138) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 147) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 148) ! rate_const*NO2 + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 149) ! rate_const*NO3 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 149) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 1) ! rate_const*ALKNIT + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 2) ! rate_const*ALKOOH + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 9) ! rate_const*BENZOOH + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 10) ! rate_const*BEPOMUC + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 11) ! rate_const*BIGALD1 + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 12) ! rate_const*BIGALD2 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 13) ! rate_const*BIGALD3 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 14) ! rate_const*BIGALD4 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 24) ! rate_const*BZOOH + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 31) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 33) ! rate_const*C6H5OOH + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 43) ! rate_const*CH2O + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 43) ! rate_const*CH2O + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 46) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 49) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 50) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 52) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 54) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 55) ! rate_const*CH4 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 55) ! rate_const*CH4 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 64) ! rate_const*CO2 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 68) ! rate_const*DHPMPAL + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 74) ! rate_const*EOOH + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 76) ! rate_const*GLYALD + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 77) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 89) ! rate_const*HCOCH2OOH + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 92) ! rate_const*HMHP + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 97) ! rate_const*HONITR + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 98) ! rate_const*HPALD1 + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 99) ! rate_const*HPALD4 + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 100) ! rate_const*HPALDB1C + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 101) ! rate_const*HPALDB4C + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 102) ! rate_const*HYAC + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 103) ! rate_const*HYDRALD + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 103) ! rate_const*HYDRALD + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 104) ! rate_const*HYPERACET + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 104) ! rate_const*HYPERACET + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 107) ! rate_const*INHEB + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 108) ! rate_const*INHED + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 110) ! rate_const*ISOPFDN + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 111) ! rate_const*ISOPFDNC + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 112) ! rate_const*ISOPFNC + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 113) ! rate_const*ISOPFNP + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 114) ! rate_const*ISOPHFP + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 115) ! rate_const*ISOPN1D + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 116) ! rate_const*ISOPN2B + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 117) ! rate_const*ISOPN3B + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 118) ! rate_const*ISOPN4D + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 119) ! rate_const*ISOPNBNO3 + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 120) ! rate_const*ISOPNOOHB + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 121) ! rate_const*ISOPNOOHD + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 123) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 126) ! rate_const*MACR + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 126) ! rate_const*MACR + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 127) ! rate_const*MACRN + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 128) ! rate_const*MACROOH + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 129) ! rate_const*MEK + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 130) ! rate_const*MEKOOH + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 131) ! rate_const*MPAN + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 132) ! rate_const*MVK + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 133) ! rate_const*MVKN + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 134) ! rate_const*MVKOOH + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 139) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 150) ! rate_const*NO3CH2CHO + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 151) ! rate_const*NOA + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 162) ! rate_const*ONITR + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 163) ! rate_const*PAN + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 167) ! rate_const*PHENOOH + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 170) ! rate_const*POOH + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 171) ! rate_const*ROOH + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 199) ! rate_const*TEPOMUC + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 200) ! rate_const*TERP1OOH + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 201) ! rate_const*TERP2AOOH + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 202) ! rate_const*TERPA + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 203) ! rate_const*TERPA2 + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 204) ! rate_const*TERPA2PAN + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 205) ! rate_const*TERPA3 + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 206) ! rate_const*TERPA3PAN + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 207) ! rate_const*TERPACID + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 208) ! rate_const*TERPACID2 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 209) ! rate_const*TERPACID3 + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 210) ! rate_const*TERPAPAN + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 211) ! rate_const*TERPDHDP + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 214) ! rate_const*TERPFDN + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 215) ! rate_const*TERPHFN + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 217) ! rate_const*TERPNPS + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 218) ! rate_const*TERPNPS1 + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 219) ! rate_const*TERPNPT + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 220) ! rate_const*TERPNPT1 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 221) ! rate_const*TERPNS + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 222) ! rate_const*TERPNS1 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 223) ! rate_const*TERPNT + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 224) ! rate_const*TERPNT1 + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 225) ! rate_const*TERPOOH + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 226) ! rate_const*TERPOOHL + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 227) ! rate_const*TOLOOH + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 230) ! rate_const*XYLENOOH + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 232) ! rate_const*XYLOLOOH + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 19) ! rate_const*BRCL + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 20) ! rate_const*BRO + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 21) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 21) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 34) ! rate_const*CCL4 + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 35) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 36) ! rate_const*CF3BR + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 37) ! rate_const*CFC11 + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 38) ! rate_const*CFC113 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 39) ! rate_const*CFC114 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 40) ! rate_const*CFC115 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 41) ! rate_const*CFC12 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 42) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 44) ! rate_const*CH3BR + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 45) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 47) ! rate_const*CH3CL + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 56) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 58) ! rate_const*CL2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 59) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 60) ! rate_const*CLO + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 61) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 61) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 65) ! rate_const*COF2 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 66) ! rate_const*COFCL + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 80) ! rate_const*H2402 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 83) ! rate_const*HBR + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 84) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 85) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 86) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 87) ! rate_const*HCL + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 91) ! rate_const*HF + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 95) ! rate_const*HOBR + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 96) ! rate_const*HOCL + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 160) ! rate_const*OCLO + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 173) ! rate_const*SF6 + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 82) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 161) ! rate_const*OCS + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 174) ! rate_const*SO + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 175) ! rate_const*SO2 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 176) ! rate_const*SO3 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 181) ! rate_const*soa1_a1 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 182) ! rate_const*soa1_a2 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 183) ! rate_const*soa2_a1 + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 184) ! rate_const*soa2_a2 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 185) ! rate_const*soa3_a1 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 186) ! rate_const*soa3_a2 + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 187) ! rate_const*soa4_a1 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 188) ! rate_const*soa4_a2 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 189) ! rate_const*soa5_a1 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 190) ! rate_const*soa5_a2 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 294)*sol(:ncol,:, 79) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 294)*sol(:ncol,:, 319) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 294) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 294) ! rate_const*O2*O1D + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 294)*sol(:ncol,:, 158) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 157)*sol(:ncol,:, 158) ! rate_const*O*O3 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 157)*sol(:ncol,:, 157) ! rate_const*M*O*O + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 157) ! rate_const*O2*M*O + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 79)*sol(:ncol,:, 157) ! rate_const*H2*O + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 81)*sol(:ncol,:, 157) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 78)*sol(:ncol,:, 258) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 78)*sol(:ncol,:, 258) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 78)*sol(:ncol,:, 258) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 78) ! rate_const*O2*M*H + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 258)*sol(:ncol,:, 157) ! rate_const*HO2*O + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 258)*sol(:ncol,:, 158) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 78)*sol(:ncol,:, 158) ! rate_const*H*O3 + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 295)*sol(:ncol,:, 79) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 295)*sol(:ncol,:, 81) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 295)*sol(:ncol,:, 258) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 295)*sol(:ncol,:, 157) ! rate_const*OH*O + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 295)*sol(:ncol,:, 158) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 295)*sol(:ncol,:, 295) ! rate_const*OH*OH + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 295)*sol(:ncol,:, 295) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 258)*sol(:ncol,:, 258) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 94)*sol(:ncol,:, 295) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 136)*sol(:ncol,:, 147) ! rate_const*N*NO + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 136)*sol(:ncol,:, 148) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 136)*sol(:ncol,:, 148) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 136)*sol(:ncol,:, 148) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 136) ! rate_const*O2*N + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 148)*sol(:ncol,:, 157) ! rate_const*NO2*O + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 148)*sol(:ncol,:, 158) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 148)*sol(:ncol,:, 157) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 149)*sol(:ncol,:, 258) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 149)*sol(:ncol,:, 147) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 149)*sol(:ncol,:, 157) ! rate_const*NO3*O + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 149)*sol(:ncol,:, 295) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 136)*sol(:ncol,:, 295) ! rate_const*N*OH + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 147)*sol(:ncol,:, 258) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 147)*sol(:ncol,:, 158) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 147)*sol(:ncol,:, 157) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 294)*sol(:ncol,:, 137) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 294)*sol(:ncol,:, 137) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 148)*sol(:ncol,:, 258) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 148)*sol(:ncol,:, 149) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 148)*sol(:ncol,:, 295) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 93)*sol(:ncol,:, 295) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 94) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 138) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 57)*sol(:ncol,:, 43) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 57)*sol(:ncol,:, 55) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 57)*sol(:ncol,:, 79) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 57)*sol(:ncol,:, 81) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 57)*sol(:ncol,:, 258) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 57)*sol(:ncol,:, 258) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 57)*sol(:ncol,:, 158) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 60)*sol(:ncol,:, 253) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 60)*sol(:ncol,:, 60) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 60)*sol(:ncol,:, 60) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 60)*sol(:ncol,:, 60) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 60)*sol(:ncol,:, 258) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 60)*sol(:ncol,:, 147) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 61)*sol(:ncol,:, 57) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 60)*sol(:ncol,:, 148) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 61)*sol(:ncol,:, 157) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 61)*sol(:ncol,:, 295) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 60)*sol(:ncol,:, 157) ! rate_const*CLO*O + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 60)*sol(:ncol,:, 295) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 60)*sol(:ncol,:, 295) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 87)*sol(:ncol,:, 157) ! rate_const*HCL*O + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 87)*sol(:ncol,:, 295) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 96)*sol(:ncol,:, 57) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 96)*sol(:ncol,:, 157) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 96)*sol(:ncol,:, 295) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 294)*sol(:ncol,:, 34) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 294)*sol(:ncol,:, 35) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 294)*sol(:ncol,:, 37) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 294)*sol(:ncol,:, 38) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 294)*sol(:ncol,:, 39) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 294)*sol(:ncol,:, 40) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 294)*sol(:ncol,:, 41) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 294)*sol(:ncol,:, 87) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 294)*sol(:ncol,:, 87) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 60)*sol(:ncol,:, 60) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 59) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 18)*sol(:ncol,:, 43) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 18)*sol(:ncol,:, 258) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 18)*sol(:ncol,:, 158) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 20)*sol(:ncol,:, 20) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 20)*sol(:ncol,:, 60) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 20)*sol(:ncol,:, 60) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 20)*sol(:ncol,:, 60) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 20)*sol(:ncol,:, 258) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 20)*sol(:ncol,:, 147) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 20)*sol(:ncol,:, 148) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 21)*sol(:ncol,:, 157) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 20)*sol(:ncol,:, 157) ! rate_const*BRO*O + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 20)*sol(:ncol,:, 295) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 83)*sol(:ncol,:, 157) ! rate_const*HBR*O + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 83)*sol(:ncol,:, 295) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 95)*sol(:ncol,:, 157) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 294)*sol(:ncol,:, 36) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 294)*sol(:ncol,:, 56) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 294)*sol(:ncol,:, 80) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 294)*sol(:ncol,:, 83) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 294)*sol(:ncol,:, 83) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 75)*sol(:ncol,:, 55) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 75)*sol(:ncol,:, 79) ! rate_const*F*H2 + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 75)*sol(:ncol,:, 319) ! rate_const*F*H2O + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 75)*sol(:ncol,:, 93) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 294)*sol(:ncol,:, 65) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 294)*sol(:ncol,:, 66) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 42)*sol(:ncol,:, 57) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 42)*sol(:ncol,:, 295) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 44)*sol(:ncol,:, 57) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 44)*sol(:ncol,:, 295) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 45)*sol(:ncol,:, 295) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 47)*sol(:ncol,:, 57) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 47)*sol(:ncol,:, 295) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 56)*sol(:ncol,:, 57) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 56)*sol(:ncol,:, 295) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 84)*sol(:ncol,:, 295) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 85)*sol(:ncol,:, 295) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 86)*sol(:ncol,:, 295) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 294)*sol(:ncol,:, 42) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 294)*sol(:ncol,:, 44) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 294)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 294)*sol(:ncol,:, 85) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 294)*sol(:ncol,:, 86) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 43)*sol(:ncol,:, 258) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 43)*sol(:ncol,:, 149) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 43)*sol(:ncol,:, 157) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 43)*sol(:ncol,:, 295) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 253)*sol(:ncol,:, 253) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 253)*sol(:ncol,:, 253) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 253)*sol(:ncol,:, 258) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 253)*sol(:ncol,:, 147) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 53)*sol(:ncol,:, 295) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 54)*sol(:ncol,:, 295) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 55)*sol(:ncol,:, 295) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 88)*sol(:ncol,:, 295) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 90)*sol(:ncol,:, 295) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 92)*sol(:ncol,:, 295) ! rate_const*HMHP*OH + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 259)*sol(:ncol,:, 258) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 259) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 259)*sol(:ncol,:, 147) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 294)*sol(:ncol,:, 55) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 294)*sol(:ncol,:, 55) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 294)*sol(:ncol,:, 55) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 294)*sol(:ncol,:, 88) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 63)*sol(:ncol,:, 295) ! rate_const*CO*OH + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 25)*sol(:ncol,:, 57) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 25)*sol(:ncol,:, 295) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 26)*sol(:ncol,:, 57) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 26)*sol(:ncol,:, 158) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 249)*sol(:ncol,:, 249) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 249)*sol(:ncol,:, 253) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 249)*sol(:ncol,:, 258) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 249)*sol(:ncol,:, 147) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 27)*sol(:ncol,:, 295) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 28)*sol(:ncol,:, 295) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 29)*sol(:ncol,:, 57) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 29)*sol(:ncol,:, 295) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 46)*sol(:ncol,:, 149) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 46)*sol(:ncol,:, 295) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 48)*sol(:ncol,:, 295) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 252)*sol(:ncol,:, 252) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 252)*sol(:ncol,:, 253) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 252)*sol(:ncol,:, 258) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 252)*sol(:ncol,:, 147) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 51)*sol(:ncol,:, 295) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 52)*sol(:ncol,:, 295) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 257)*sol(:ncol,:, 258) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 257)*sol(:ncol,:, 147) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 256) ! rate_const*EO + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 256) ! rate_const*O2*EO + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 76)*sol(:ncol,:, 295) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 77)*sol(:ncol,:, 295) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 89)*sol(:ncol,:, 295) ! rate_const*HCOCH2OOH*OH + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 150)*sol(:ncol,:, 295) ! rate_const*NO3CH2CHO*OH + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 163)*sol(:ncol,:, 295) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 26)*sol(:ncol,:, 295) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 252)*sol(:ncol,:, 148) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 163) ! rate_const*M*PAN + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 30)*sol(:ncol,:, 149) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 30)*sol(:ncol,:, 158) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 250)*sol(:ncol,:, 253) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 250)*sol(:ncol,:, 258) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 250)*sol(:ncol,:, 147) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 31)*sol(:ncol,:, 295) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 32)*sol(:ncol,:, 295) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 50)*sol(:ncol,:, 149) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 50)*sol(:ncol,:, 295) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 102)*sol(:ncol,:, 295) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 104)*sol(:ncol,:, 295) ! rate_const*HYPERACET*OH + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 151)*sol(:ncol,:, 295) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 297)*sol(:ncol,:, 258) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 297)*sol(:ncol,:, 147) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 170)*sol(:ncol,:, 295) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 298)*sol(:ncol,:, 253) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 298)*sol(:ncol,:, 258) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 298)*sol(:ncol,:, 147) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 171)*sol(:ncol,:, 295) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 30)*sol(:ncol,:, 295) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 49)*sol(:ncol,:, 295) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 16)*sol(:ncol,:, 149) ! rate_const*BIGENE*NO3 + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 16)*sol(:ncol,:, 295) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 68)*sol(:ncol,:, 295) ! rate_const*DHPMPAL*OH + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 255)*sol(:ncol,:, 147) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 255)*sol(:ncol,:, 147) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 97)*sol(:ncol,:, 295) ! rate_const*HONITR*OH + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 127)*sol(:ncol,:, 295) ! rate_const*MACRN*OH + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 284)*sol(:ncol,:, 252) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 284)*sol(:ncol,:, 253) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 284)*sol(:ncol,:, 258) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 284) ! rate_const*MACRO2 + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 126)*sol(:ncol,:, 158) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 126)*sol(:ncol,:, 295) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 128)*sol(:ncol,:, 295) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 286)*sol(:ncol,:, 252) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 286)*sol(:ncol,:, 253) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 286)*sol(:ncol,:, 258) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 286)*sol(:ncol,:, 286) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 286)*sol(:ncol,:, 147) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 286)*sol(:ncol,:, 149) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 288)*sol(:ncol,:, 258) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 288)*sol(:ncol,:, 147) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 129)*sol(:ncol,:, 295) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 130)*sol(:ncol,:, 295) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 131)*sol(:ncol,:, 295) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 133)*sol(:ncol,:, 295) ! rate_const*MVKN*OH + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 289)*sol(:ncol,:, 252) ! rate_const*MVKO2*CH3CO3 + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 289)*sol(:ncol,:, 253) ! rate_const*MVKO2*CH3O2 + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 289)*sol(:ncol,:, 258) ! rate_const*MVKO2*HO2 + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 132)*sol(:ncol,:, 158) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 132)*sol(:ncol,:, 295) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 134)*sol(:ncol,:, 295) ! rate_const*MVKOOH*OH + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 286)*sol(:ncol,:, 148) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 131) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 1)*sol(:ncol,:, 295) ! rate_const*ALKNIT*OH + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 236)*sol(:ncol,:, 258) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 236)*sol(:ncol,:, 147) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 236)*sol(:ncol,:, 147) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 2)*sol(:ncol,:, 295) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 15)*sol(:ncol,:, 295) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 98)*sol(:ncol,:, 295) ! rate_const*HPALD1*OH + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 99)*sol(:ncol,:, 295) ! rate_const*HPALD4*OH + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 100)*sol(:ncol,:, 295) ! rate_const*HPALDB1C*OH + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 101)*sol(:ncol,:, 295) ! rate_const*HPALDB4C*OH + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 103)*sol(:ncol,:, 295) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 105)*sol(:ncol,:, 295) ! rate_const*ICHE*OH + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 106)*sol(:ncol,:, 295) ! rate_const*IEPOX*OH + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 260)*sol(:ncol,:, 258) ! rate_const*IEPOXOO*HO2 + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 107)*sol(:ncol,:, 295) ! rate_const*INHEB*OH + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 108)*sol(:ncol,:, 295) ! rate_const*INHED*OH + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 261)*sol(:ncol,:, 252) ! rate_const*ISOPB1O2*CH3CO3 + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 261)*sol(:ncol,:, 253) ! rate_const*ISOPB1O2*CH3O2 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 261)*sol(:ncol,:, 258) ! rate_const*ISOPB1O2*HO2 + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 261) ! rate_const*ISOPB1O2 + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 261) ! rate_const*ISOPB1O2 + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 261) ! rate_const*ISOPB1O2 + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 262)*sol(:ncol,:, 252) ! rate_const*ISOPB4O2*CH3CO3 + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 262)*sol(:ncol,:, 253) ! rate_const*ISOPB4O2*CH3O2 + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 262)*sol(:ncol,:, 258) ! rate_const*ISOPB4O2*HO2 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 262) ! rate_const*ISOPB4O2 + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 262) ! rate_const*ISOPB4O2 + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 262) ! rate_const*ISOPB4O2 + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 263) ! rate_const*O2*ISOPC1C + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 263) ! rate_const*O2*ISOPC1C + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 264) ! rate_const*O2*ISOPC1T + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 264) ! rate_const*O2*ISOPC1T + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 265) ! rate_const*O2*ISOPC4C + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 265) ! rate_const*O2*ISOPC4C + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 266) ! rate_const*O2*ISOPC4T + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 266) ! rate_const*O2*ISOPC4T + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 267)*sol(:ncol,:, 252) ! rate_const*ISOPED1O2*CH3CO3 + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 267)*sol(:ncol,:, 253) ! rate_const*ISOPED1O2*CH3O2 + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 267)*sol(:ncol,:, 258) ! rate_const*ISOPED1O2*HO2 + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 267) ! rate_const*ISOPED1O2 + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 268)*sol(:ncol,:, 252) ! rate_const*ISOPED4O2*CH3CO3 + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 268)*sol(:ncol,:, 253) ! rate_const*ISOPED4O2*CH3O2 + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 268)*sol(:ncol,:, 258) ! rate_const*ISOPED4O2*HO2 + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 268) ! rate_const*ISOPED4O2 + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 111)*sol(:ncol,:, 295) ! rate_const*ISOPFDNC*OH + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 110)*sol(:ncol,:, 295) ! rate_const*ISOPFDN*OH + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 112)*sol(:ncol,:, 295) ! rate_const*ISOPFNC*OH + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 113)*sol(:ncol,:, 295) ! rate_const*ISOPFNP*OH + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 114)*sol(:ncol,:, 295) ! rate_const*ISOPHFP*OH + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 269)*sol(:ncol,:, 258) ! rate_const*ISOPN1DO2*HO2 + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 269) ! rate_const*ISOPN1DO2 + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 115)*sol(:ncol,:, 158) ! rate_const*ISOPN1D*O3 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 115)*sol(:ncol,:, 295) ! rate_const*ISOPN1D*OH + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 270)*sol(:ncol,:, 258) ! rate_const*ISOPN2BO2*HO2 + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 270) ! rate_const*ISOPN2BO2 + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 116)*sol(:ncol,:, 295) ! rate_const*ISOPN2B*OH + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 271)*sol(:ncol,:, 258) ! rate_const*ISOPN3BO2*HO2 + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 271) ! rate_const*ISOPN3BO2 + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 117)*sol(:ncol,:, 295) ! rate_const*ISOPN3B*OH + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 272)*sol(:ncol,:, 258) ! rate_const*ISOPN4DO2*HO2 + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 272) ! rate_const*ISOPN4DO2 + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 118)*sol(:ncol,:, 158) ! rate_const*ISOPN4D*O3 + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 118)*sol(:ncol,:, 295) ! rate_const*ISOPN4D*OH + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 273)*sol(:ncol,:, 258) ! rate_const*ISOPNBNO3O2*HO2 + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 119)*sol(:ncol,:, 295) ! rate_const*ISOPNBNO3*OH + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 109)*sol(:ncol,:, 149) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 274)*sol(:ncol,:, 252) ! rate_const*ISOPNO3*CH3CO3 + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 274)*sol(:ncol,:, 253) ! rate_const*ISOPNO3*CH3O2 + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 274)*sol(:ncol,:, 258) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 274)*sol(:ncol,:, 274) ! rate_const*ISOPNO3*ISOPNO3 + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 274)*sol(:ncol,:, 149) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 275)*sol(:ncol,:, 258) ! rate_const*ISOPNOOHBO2*HO2 + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 275) ! rate_const*ISOPNOOHBO2 + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 120)*sol(:ncol,:, 295) ! rate_const*ISOPNOOHB*OH + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 276)*sol(:ncol,:, 258) ! rate_const*ISOPNOOHDO2*HO2 + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 276) ! rate_const*ISOPNOOHDO2 + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 121)*sol(:ncol,:, 158) ! rate_const*ISOPNOOHD*O3 + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 121)*sol(:ncol,:, 295) ! rate_const*ISOPNOOHD*OH + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 109)*sol(:ncol,:, 158) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 109)*sol(:ncol,:, 295) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 122)*sol(:ncol,:, 295) ! rate_const*ISOPOH*OH + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 123)*sol(:ncol,:, 295) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 123)*sol(:ncol,:, 295) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 278)*sol(:ncol,:, 252) ! rate_const*ISOPZD1O2*CH3CO3 + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 278)*sol(:ncol,:, 253) ! rate_const*ISOPZD1O2*CH3O2 + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 278)*sol(:ncol,:, 258) ! rate_const*ISOPZD1O2*HO2 + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 278) ! rate_const*ISOPZD1O2 + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 279)*sol(:ncol,:, 252) ! rate_const*ISOPZD4O2*CH3CO3 + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 279)*sol(:ncol,:, 253) ! rate_const*ISOPZD4O2*CH3O2 + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 279)*sol(:ncol,:, 258) ! rate_const*ISOPZD4O2*HO2 + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 279) ! rate_const*ISOPZD4O2 + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 293)*sol(:ncol,:, 258) ! rate_const*NC4CHOO2*HO2 + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 293) ! rate_const*NC4CHOO2 + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 139)*sol(:ncol,:, 158) ! rate_const*NC4CHO*O3 + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 139)*sol(:ncol,:, 295) ! rate_const*NC4CHO*OH + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 260)*sol(:ncol,:, 147) ! rate_const*IEPOXOO*NO + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 260)*sol(:ncol,:, 147) ! rate_const*IEPOXOO*NO + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 261)*sol(:ncol,:, 147) ! rate_const*ISOPB1O2*NO + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 261)*sol(:ncol,:, 147) ! rate_const*ISOPB1O2*NO + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 262)*sol(:ncol,:, 147) ! rate_const*ISOPB4O2*NO + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 262)*sol(:ncol,:, 147) ! rate_const*ISOPB4O2*NO + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 267)*sol(:ncol,:, 147) ! rate_const*ISOPED1O2*NO + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 267)*sol(:ncol,:, 147) ! rate_const*ISOPED1O2*NO + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 268)*sol(:ncol,:, 147) ! rate_const*ISOPED4O2*NO + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 268)*sol(:ncol,:, 147) ! rate_const*ISOPED4O2*NO + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 269)*sol(:ncol,:, 147) ! rate_const*ISOPN1DO2*NO + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 269)*sol(:ncol,:, 147) ! rate_const*ISOPN1DO2*NO + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 270)*sol(:ncol,:, 147) ! rate_const*ISOPN2BO2*NO + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 270)*sol(:ncol,:, 147) ! rate_const*ISOPN2BO2*NO + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 271)*sol(:ncol,:, 147) ! rate_const*ISOPN3BO2*NO + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 271)*sol(:ncol,:, 147) ! rate_const*ISOPN3BO2*NO + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 272)*sol(:ncol,:, 147) ! rate_const*ISOPN4DO2*NO + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 272)*sol(:ncol,:, 147) ! rate_const*ISOPN4DO2*NO + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 273)*sol(:ncol,:, 147) ! rate_const*ISOPNBNO3O2*NO + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 273)*sol(:ncol,:, 147) ! rate_const*ISOPNBNO3O2*NO + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 274)*sol(:ncol,:, 147) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 274)*sol(:ncol,:, 147) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 275)*sol(:ncol,:, 147) ! rate_const*ISOPNOOHBO2*NO + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 275)*sol(:ncol,:, 147) ! rate_const*ISOPNOOHBO2*NO + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 276)*sol(:ncol,:, 147) ! rate_const*ISOPNOOHDO2*NO + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 276)*sol(:ncol,:, 147) ! rate_const*ISOPNOOHDO2*NO + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 278) ! rate_const*ISOPZD1O2 + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 278)*sol(:ncol,:, 147) ! rate_const*ISOPZD1O2*NO + rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 278)*sol(:ncol,:, 147) ! rate_const*ISOPZD1O2*NO + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 279) ! rate_const*ISOPZD4O2 + rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 279)*sol(:ncol,:, 147) ! rate_const*ISOPZD4O2*NO + rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 279)*sol(:ncol,:, 147) ! rate_const*ISOPZD4O2*NO + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 284)*sol(:ncol,:, 147) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 284)*sol(:ncol,:, 147) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 289)*sol(:ncol,:, 147) ! rate_const*MVKO2*NO + rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 289)*sol(:ncol,:, 147) ! rate_const*MVKO2*NO + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 293)*sol(:ncol,:, 147) ! rate_const*NC4CHOO2*NO + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 293)*sol(:ncol,:, 147) ! rate_const*NC4CHOO2*NO + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 235)*sol(:ncol,:, 258) ! rate_const*ACBZO2*HO2 + rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 235)*sol(:ncol,:, 147) ! rate_const*ACBZO2*NO + rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 8)*sol(:ncol,:, 295) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 243)*sol(:ncol,:, 258) ! rate_const*BENZO2*HO2 + rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 243)*sol(:ncol,:, 147) ! rate_const*BENZO2*NO + rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 9)*sol(:ncol,:, 295) ! rate_const*BENZOOH*OH + rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 23)*sol(:ncol,:, 295) ! rate_const*BZALD*OH + rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 248)*sol(:ncol,:, 258) ! rate_const*BZOO*HO2 + rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 24)*sol(:ncol,:, 295) ! rate_const*BZOOH*OH + rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 248)*sol(:ncol,:, 147) ! rate_const*BZOO*NO + rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 251)*sol(:ncol,:, 258) ! rate_const*C6H5O2*HO2 + rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 251)*sol(:ncol,:, 147) ! rate_const*C6H5O2*NO + rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 33)*sol(:ncol,:, 295) ! rate_const*C6H5OOH*OH + rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 67)*sol(:ncol,:, 295) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 254)*sol(:ncol,:, 258) ! rate_const*DICARBO2*HO2 + rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 254)*sol(:ncol,:, 147) ! rate_const*DICARBO2*NO + rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 254)*sol(:ncol,:, 148) ! rate_const*M*DICARBO2*NO2 + rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 285)*sol(:ncol,:, 258) ! rate_const*MALO2*HO2 + rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 285)*sol(:ncol,:, 147) ! rate_const*MALO2*NO + rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 285)*sol(:ncol,:, 148) ! rate_const*M*MALO2*NO2 + rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 287)*sol(:ncol,:, 258) ! rate_const*MDIALO2*HO2 + rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 287)*sol(:ncol,:, 147) ! rate_const*MDIALO2*NO + rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 287)*sol(:ncol,:, 148) ! rate_const*M*MDIALO2*NO2 + rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 296)*sol(:ncol,:, 258) ! rate_const*PHENO2*HO2 + rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 296)*sol(:ncol,:, 147) ! rate_const*PHENO2*NO + rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 166)*sol(:ncol,:, 295) ! rate_const*PHENOL*OH + rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 165)*sol(:ncol,:, 148) ! rate_const*PHENO*NO2 + rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 165)*sol(:ncol,:, 158) ! rate_const*PHENO*O3 + rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 167)*sol(:ncol,:, 295) ! rate_const*PHENOOH*OH + rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 235)*sol(:ncol,:, 148) ! rate_const*M*ACBZO2*NO2 + rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 314)*sol(:ncol,:, 258) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 314)*sol(:ncol,:, 147) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 227)*sol(:ncol,:, 295) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 228)*sol(:ncol,:, 295) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 164) ! rate_const*M*PBZNIT + rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 229)*sol(:ncol,:, 295) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 316)*sol(:ncol,:, 258) ! rate_const*XYLENO2*HO2 + rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 316)*sol(:ncol,:, 147) ! rate_const*XYLENO2*NO + rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 230)*sol(:ncol,:, 295) ! rate_const*XYLENOOH*OH + rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 318)*sol(:ncol,:, 258) ! rate_const*XYLOLO2*HO2 + rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 318)*sol(:ncol,:, 147) ! rate_const*XYLOLO2*NO + rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 231)*sol(:ncol,:, 295) ! rate_const*XYLOL*OH + rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 232)*sol(:ncol,:, 295) ! rate_const*XYLOLOOH*OH + rxt_rates(:ncol,:, 584) = rxt_rates(:ncol,:, 584)*sol(:ncol,:, 4)*sol(:ncol,:, 149) ! rate_const*APIN*NO3 + rxt_rates(:ncol,:, 585) = rxt_rates(:ncol,:, 585)*sol(:ncol,:, 237)*sol(:ncol,:, 237) ! rate_const*APINNO3*APINNO3 + rxt_rates(:ncol,:, 586) = rxt_rates(:ncol,:, 586)*sol(:ncol,:, 237)*sol(:ncol,:, 252) ! rate_const*APINNO3*CH3CO3 + rxt_rates(:ncol,:, 587) = rxt_rates(:ncol,:, 587)*sol(:ncol,:, 237)*sol(:ncol,:, 253) ! rate_const*APINNO3*CH3O2 + rxt_rates(:ncol,:, 588) = rxt_rates(:ncol,:, 588)*sol(:ncol,:, 237)*sol(:ncol,:, 258) ! rate_const*APINNO3*HO2 + rxt_rates(:ncol,:, 589) = rxt_rates(:ncol,:, 589)*sol(:ncol,:, 237)*sol(:ncol,:, 147) ! rate_const*APINNO3*NO + rxt_rates(:ncol,:, 590) = rxt_rates(:ncol,:, 590)*sol(:ncol,:, 237)*sol(:ncol,:, 149) ! rate_const*APINNO3*NO3 + rxt_rates(:ncol,:, 591) = rxt_rates(:ncol,:, 591)*sol(:ncol,:, 237)*sol(:ncol,:, 302) ! rate_const*APINNO3*TERPA2CO3 + rxt_rates(:ncol,:, 592) = rxt_rates(:ncol,:, 592)*sol(:ncol,:, 237)*sol(:ncol,:, 304) ! rate_const*APINNO3*TERPA3CO3 + rxt_rates(:ncol,:, 593) = rxt_rates(:ncol,:, 593)*sol(:ncol,:, 237)*sol(:ncol,:, 307) ! rate_const*APINNO3*TERPACO3 + rxt_rates(:ncol,:, 594) = rxt_rates(:ncol,:, 594)*sol(:ncol,:, 238)*sol(:ncol,:, 252) ! rate_const*APINO2*CH3CO3 + rxt_rates(:ncol,:, 595) = rxt_rates(:ncol,:, 595)*sol(:ncol,:, 238)*sol(:ncol,:, 253) ! rate_const*APINO2*CH3O2 + rxt_rates(:ncol,:, 596) = rxt_rates(:ncol,:, 596)*sol(:ncol,:, 238)*sol(:ncol,:, 258) ! rate_const*APINO2*HO2 + rxt_rates(:ncol,:, 597) = rxt_rates(:ncol,:, 597)*sol(:ncol,:, 238)*sol(:ncol,:, 147) ! rate_const*APINO2*NO + rxt_rates(:ncol,:, 598) = rxt_rates(:ncol,:, 598)*sol(:ncol,:, 238)*sol(:ncol,:, 149) ! rate_const*APINO2*NO3 + rxt_rates(:ncol,:, 599) = rxt_rates(:ncol,:, 599)*sol(:ncol,:, 238)*sol(:ncol,:, 302) ! rate_const*APINO2*TERPA2CO3 + rxt_rates(:ncol,:, 600) = rxt_rates(:ncol,:, 600)*sol(:ncol,:, 238)*sol(:ncol,:, 304) ! rate_const*APINO2*TERPA3CO3 + rxt_rates(:ncol,:, 601) = rxt_rates(:ncol,:, 601)*sol(:ncol,:, 238)*sol(:ncol,:, 307) ! rate_const*APINO2*TERPACO3 + rxt_rates(:ncol,:, 602) = rxt_rates(:ncol,:, 602)*sol(:ncol,:, 4)*sol(:ncol,:, 158) ! rate_const*APIN*O3 + rxt_rates(:ncol,:, 603) = rxt_rates(:ncol,:, 603)*sol(:ncol,:, 4)*sol(:ncol,:, 295) ! rate_const*APIN*OH + rxt_rates(:ncol,:, 604) = rxt_rates(:ncol,:, 604)*sol(:ncol,:, 7)*sol(:ncol,:, 149) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 605) = rxt_rates(:ncol,:, 605)*sol(:ncol,:, 240)*sol(:ncol,:, 240) ! rate_const*BCARYNO3*BCARYNO3 + rxt_rates(:ncol,:, 606) = rxt_rates(:ncol,:, 606)*sol(:ncol,:, 240)*sol(:ncol,:, 252) ! rate_const*BCARYNO3*CH3CO3 + rxt_rates(:ncol,:, 607) = rxt_rates(:ncol,:, 607)*sol(:ncol,:, 240)*sol(:ncol,:, 253) ! rate_const*BCARYNO3*CH3O2 + rxt_rates(:ncol,:, 608) = rxt_rates(:ncol,:, 608)*sol(:ncol,:, 240)*sol(:ncol,:, 258) ! rate_const*BCARYNO3*HO2 + rxt_rates(:ncol,:, 609) = rxt_rates(:ncol,:, 609)*sol(:ncol,:, 240)*sol(:ncol,:, 147) ! rate_const*BCARYNO3*NO + rxt_rates(:ncol,:, 610) = rxt_rates(:ncol,:, 610)*sol(:ncol,:, 240)*sol(:ncol,:, 149) ! rate_const*BCARYNO3*NO3 + rxt_rates(:ncol,:, 611) = rxt_rates(:ncol,:, 611)*sol(:ncol,:, 240)*sol(:ncol,:, 302) ! rate_const*BCARYNO3*TERPA2CO3 + rxt_rates(:ncol,:, 612) = rxt_rates(:ncol,:, 612)*sol(:ncol,:, 240)*sol(:ncol,:, 304) ! rate_const*BCARYNO3*TERPA3CO3 + rxt_rates(:ncol,:, 613) = rxt_rates(:ncol,:, 613)*sol(:ncol,:, 240)*sol(:ncol,:, 307) ! rate_const*BCARYNO3*TERPACO3 + rxt_rates(:ncol,:, 614) = rxt_rates(:ncol,:, 614)*sol(:ncol,:, 241)*sol(:ncol,:, 252) ! rate_const*BCARYO2*CH3CO3 + rxt_rates(:ncol,:, 615) = rxt_rates(:ncol,:, 615)*sol(:ncol,:, 241)*sol(:ncol,:, 253) ! rate_const*BCARYO2*CH3O2 + rxt_rates(:ncol,:, 616) = rxt_rates(:ncol,:, 616)*sol(:ncol,:, 241)*sol(:ncol,:, 258) ! rate_const*BCARYO2*HO2 + rxt_rates(:ncol,:, 617) = rxt_rates(:ncol,:, 617)*sol(:ncol,:, 241)*sol(:ncol,:, 147) ! rate_const*BCARYO2*NO + rxt_rates(:ncol,:, 618) = rxt_rates(:ncol,:, 618)*sol(:ncol,:, 241)*sol(:ncol,:, 149) ! rate_const*BCARYO2*NO3 + rxt_rates(:ncol,:, 619) = rxt_rates(:ncol,:, 619)*sol(:ncol,:, 241)*sol(:ncol,:, 302) ! rate_const*BCARYO2*TERPA2CO3 + rxt_rates(:ncol,:, 620) = rxt_rates(:ncol,:, 620)*sol(:ncol,:, 241)*sol(:ncol,:, 304) ! rate_const*BCARYO2*TERPA3CO3 + rxt_rates(:ncol,:, 621) = rxt_rates(:ncol,:, 621)*sol(:ncol,:, 241)*sol(:ncol,:, 307) ! rate_const*BCARYO2*TERPACO3 + rxt_rates(:ncol,:, 622) = rxt_rates(:ncol,:, 622)*sol(:ncol,:, 7)*sol(:ncol,:, 158) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 623) = rxt_rates(:ncol,:, 623)*sol(:ncol,:, 7)*sol(:ncol,:, 295) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 624) = rxt_rates(:ncol,:, 624)*sol(:ncol,:, 17)*sol(:ncol,:, 149) ! rate_const*BPIN*NO3 + rxt_rates(:ncol,:, 625) = rxt_rates(:ncol,:, 625)*sol(:ncol,:, 245)*sol(:ncol,:, 245) ! rate_const*BPINNO3*BPINNO3 + rxt_rates(:ncol,:, 626) = rxt_rates(:ncol,:, 626)*sol(:ncol,:, 245)*sol(:ncol,:, 252) ! rate_const*BPINNO3*CH3CO3 + rxt_rates(:ncol,:, 627) = rxt_rates(:ncol,:, 627)*sol(:ncol,:, 245)*sol(:ncol,:, 253) ! rate_const*BPINNO3*CH3O2 + rxt_rates(:ncol,:, 628) = rxt_rates(:ncol,:, 628)*sol(:ncol,:, 245)*sol(:ncol,:, 258) ! rate_const*BPINNO3*HO2 + rxt_rates(:ncol,:, 629) = rxt_rates(:ncol,:, 629)*sol(:ncol,:, 245)*sol(:ncol,:, 147) ! rate_const*BPINNO3*NO + rxt_rates(:ncol,:, 630) = rxt_rates(:ncol,:, 630)*sol(:ncol,:, 245)*sol(:ncol,:, 149) ! rate_const*BPINNO3*NO3 + rxt_rates(:ncol,:, 631) = rxt_rates(:ncol,:, 631)*sol(:ncol,:, 245)*sol(:ncol,:, 302) ! rate_const*BPINNO3*TERPA2CO3 + rxt_rates(:ncol,:, 632) = rxt_rates(:ncol,:, 632)*sol(:ncol,:, 245)*sol(:ncol,:, 304) ! rate_const*BPINNO3*TERPA3CO3 + rxt_rates(:ncol,:, 633) = rxt_rates(:ncol,:, 633)*sol(:ncol,:, 245)*sol(:ncol,:, 307) ! rate_const*BPINNO3*TERPACO3 + rxt_rates(:ncol,:, 634) = rxt_rates(:ncol,:, 634)*sol(:ncol,:, 246)*sol(:ncol,:, 252) ! rate_const*BPINO2*CH3CO3 + rxt_rates(:ncol,:, 635) = rxt_rates(:ncol,:, 635)*sol(:ncol,:, 246)*sol(:ncol,:, 253) ! rate_const*BPINO2*CH3O2 + rxt_rates(:ncol,:, 636) = rxt_rates(:ncol,:, 636)*sol(:ncol,:, 246)*sol(:ncol,:, 258) ! rate_const*BPINO2*HO2 + rxt_rates(:ncol,:, 637) = rxt_rates(:ncol,:, 637)*sol(:ncol,:, 246)*sol(:ncol,:, 147) ! rate_const*BPINO2*NO + rxt_rates(:ncol,:, 638) = rxt_rates(:ncol,:, 638)*sol(:ncol,:, 246)*sol(:ncol,:, 149) ! rate_const*BPINO2*NO3 + rxt_rates(:ncol,:, 639) = rxt_rates(:ncol,:, 639)*sol(:ncol,:, 246)*sol(:ncol,:, 302) ! rate_const*BPINO2*TERPA2CO3 + rxt_rates(:ncol,:, 640) = rxt_rates(:ncol,:, 640)*sol(:ncol,:, 246)*sol(:ncol,:, 304) ! rate_const*BPINO2*TERPA3CO3 + rxt_rates(:ncol,:, 641) = rxt_rates(:ncol,:, 641)*sol(:ncol,:, 246)*sol(:ncol,:, 307) ! rate_const*BPINO2*TERPACO3 + rxt_rates(:ncol,:, 642) = rxt_rates(:ncol,:, 642)*sol(:ncol,:, 17)*sol(:ncol,:, 158) ! rate_const*BPIN*O3 + rxt_rates(:ncol,:, 643) = rxt_rates(:ncol,:, 643)*sol(:ncol,:, 17)*sol(:ncol,:, 295) ! rate_const*BPIN*OH + rxt_rates(:ncol,:, 644) = rxt_rates(:ncol,:, 644)*sol(:ncol,:, 125)*sol(:ncol,:, 149) ! rate_const*LIMON*NO3 + rxt_rates(:ncol,:, 645) = rxt_rates(:ncol,:, 645)*sol(:ncol,:, 281)*sol(:ncol,:, 252) ! rate_const*LIMONNO3*CH3CO3 + rxt_rates(:ncol,:, 646) = rxt_rates(:ncol,:, 646)*sol(:ncol,:, 281)*sol(:ncol,:, 253) ! rate_const*LIMONNO3*CH3O2 + rxt_rates(:ncol,:, 647) = rxt_rates(:ncol,:, 647)*sol(:ncol,:, 281)*sol(:ncol,:, 258) ! rate_const*LIMONNO3*HO2 + rxt_rates(:ncol,:, 648) = rxt_rates(:ncol,:, 648)*sol(:ncol,:, 281)*sol(:ncol,:, 281) ! rate_const*LIMONNO3*LIMONNO3 + rxt_rates(:ncol,:, 649) = rxt_rates(:ncol,:, 649)*sol(:ncol,:, 281)*sol(:ncol,:, 147) ! rate_const*LIMONNO3*NO + rxt_rates(:ncol,:, 650) = rxt_rates(:ncol,:, 650)*sol(:ncol,:, 281)*sol(:ncol,:, 149) ! rate_const*LIMONNO3*NO3 + rxt_rates(:ncol,:, 651) = rxt_rates(:ncol,:, 651)*sol(:ncol,:, 281)*sol(:ncol,:, 302) ! rate_const*LIMONNO3*TERPA2CO3 + rxt_rates(:ncol,:, 652) = rxt_rates(:ncol,:, 652)*sol(:ncol,:, 281)*sol(:ncol,:, 304) ! rate_const*LIMONNO3*TERPA3CO3 + rxt_rates(:ncol,:, 653) = rxt_rates(:ncol,:, 653)*sol(:ncol,:, 281)*sol(:ncol,:, 307) ! rate_const*LIMONNO3*TERPACO3 + rxt_rates(:ncol,:, 654) = rxt_rates(:ncol,:, 654)*sol(:ncol,:, 282)*sol(:ncol,:, 252) ! rate_const*LIMONO2*CH3CO3 + rxt_rates(:ncol,:, 655) = rxt_rates(:ncol,:, 655)*sol(:ncol,:, 282)*sol(:ncol,:, 253) ! rate_const*LIMONO2*CH3O2 + rxt_rates(:ncol,:, 656) = rxt_rates(:ncol,:, 656)*sol(:ncol,:, 282)*sol(:ncol,:, 258) ! rate_const*LIMONO2*HO2 + rxt_rates(:ncol,:, 657) = rxt_rates(:ncol,:, 657)*sol(:ncol,:, 282)*sol(:ncol,:, 147) ! rate_const*LIMONO2*NO + rxt_rates(:ncol,:, 658) = rxt_rates(:ncol,:, 658)*sol(:ncol,:, 282)*sol(:ncol,:, 149) ! rate_const*LIMONO2*NO3 + rxt_rates(:ncol,:, 659) = rxt_rates(:ncol,:, 659)*sol(:ncol,:, 282)*sol(:ncol,:, 302) ! rate_const*LIMONO2*TERPA2CO3 + rxt_rates(:ncol,:, 660) = rxt_rates(:ncol,:, 660)*sol(:ncol,:, 282)*sol(:ncol,:, 304) ! rate_const*LIMONO2*TERPA3CO3 + rxt_rates(:ncol,:, 661) = rxt_rates(:ncol,:, 661)*sol(:ncol,:, 282)*sol(:ncol,:, 307) ! rate_const*LIMONO2*TERPACO3 + rxt_rates(:ncol,:, 662) = rxt_rates(:ncol,:, 662)*sol(:ncol,:, 125)*sol(:ncol,:, 158) ! rate_const*LIMON*O3 + rxt_rates(:ncol,:, 663) = rxt_rates(:ncol,:, 663)*sol(:ncol,:, 125)*sol(:ncol,:, 295) ! rate_const*LIMON*OH + rxt_rates(:ncol,:, 664) = rxt_rates(:ncol,:, 664)*sol(:ncol,:, 135)*sol(:ncol,:, 149) ! rate_const*MYRC*NO3 + rxt_rates(:ncol,:, 665) = rxt_rates(:ncol,:, 665)*sol(:ncol,:, 290)*sol(:ncol,:, 252) ! rate_const*MYRCNO3*CH3CO3 + rxt_rates(:ncol,:, 666) = rxt_rates(:ncol,:, 666)*sol(:ncol,:, 290)*sol(:ncol,:, 253) ! rate_const*MYRCNO3*CH3O2 + rxt_rates(:ncol,:, 667) = rxt_rates(:ncol,:, 667)*sol(:ncol,:, 290)*sol(:ncol,:, 258) ! rate_const*MYRCNO3*HO2 + rxt_rates(:ncol,:, 668) = rxt_rates(:ncol,:, 668)*sol(:ncol,:, 290)*sol(:ncol,:, 290) ! rate_const*MYRCNO3*MYRCNO3 + rxt_rates(:ncol,:, 669) = rxt_rates(:ncol,:, 669)*sol(:ncol,:, 290)*sol(:ncol,:, 147) ! rate_const*MYRCNO3*NO + rxt_rates(:ncol,:, 670) = rxt_rates(:ncol,:, 670)*sol(:ncol,:, 290)*sol(:ncol,:, 149) ! rate_const*MYRCNO3*NO3 + rxt_rates(:ncol,:, 671) = rxt_rates(:ncol,:, 671)*sol(:ncol,:, 290)*sol(:ncol,:, 302) ! rate_const*MYRCNO3*TERPA2CO3 + rxt_rates(:ncol,:, 672) = rxt_rates(:ncol,:, 672)*sol(:ncol,:, 290)*sol(:ncol,:, 304) ! rate_const*MYRCNO3*TERPA3CO3 + rxt_rates(:ncol,:, 673) = rxt_rates(:ncol,:, 673)*sol(:ncol,:, 290)*sol(:ncol,:, 307) ! rate_const*MYRCNO3*TERPACO3 + rxt_rates(:ncol,:, 674) = rxt_rates(:ncol,:, 674)*sol(:ncol,:, 291)*sol(:ncol,:, 252) ! rate_const*MYRCO2*CH3CO3 + rxt_rates(:ncol,:, 675) = rxt_rates(:ncol,:, 675)*sol(:ncol,:, 291)*sol(:ncol,:, 253) ! rate_const*MYRCO2*CH3O2 + rxt_rates(:ncol,:, 676) = rxt_rates(:ncol,:, 676)*sol(:ncol,:, 291)*sol(:ncol,:, 258) ! rate_const*MYRCO2*HO2 + rxt_rates(:ncol,:, 677) = rxt_rates(:ncol,:, 677)*sol(:ncol,:, 291)*sol(:ncol,:, 147) ! rate_const*MYRCO2*NO + rxt_rates(:ncol,:, 678) = rxt_rates(:ncol,:, 678)*sol(:ncol,:, 291)*sol(:ncol,:, 149) ! rate_const*MYRCO2*NO3 + rxt_rates(:ncol,:, 679) = rxt_rates(:ncol,:, 679)*sol(:ncol,:, 291)*sol(:ncol,:, 302) ! rate_const*MYRCO2*TERPA2CO3 + rxt_rates(:ncol,:, 680) = rxt_rates(:ncol,:, 680)*sol(:ncol,:, 291)*sol(:ncol,:, 304) ! rate_const*MYRCO2*TERPA3CO3 + rxt_rates(:ncol,:, 681) = rxt_rates(:ncol,:, 681)*sol(:ncol,:, 291)*sol(:ncol,:, 307) ! rate_const*MYRCO2*TERPACO3 + rxt_rates(:ncol,:, 682) = rxt_rates(:ncol,:, 682)*sol(:ncol,:, 135)*sol(:ncol,:, 158) ! rate_const*MYRC*O3 + rxt_rates(:ncol,:, 683) = rxt_rates(:ncol,:, 683)*sol(:ncol,:, 135)*sol(:ncol,:, 295) ! rate_const*MYRC*OH + rxt_rates(:ncol,:, 684) = rxt_rates(:ncol,:, 684)*sol(:ncol,:, 302)*sol(:ncol,:, 148) ! rate_const*M*TERPA2CO3*NO2 + rxt_rates(:ncol,:, 685) = rxt_rates(:ncol,:, 685)*sol(:ncol,:, 304)*sol(:ncol,:, 148) ! rate_const*M*TERPA3CO3*NO2 + rxt_rates(:ncol,:, 686) = rxt_rates(:ncol,:, 686)*sol(:ncol,:, 307)*sol(:ncol,:, 148) ! rate_const*M*TERPACO3*NO2 + rxt_rates(:ncol,:, 687) = rxt_rates(:ncol,:, 687)*sol(:ncol,:, 299)*sol(:ncol,:, 258) ! rate_const*TERP1OOHO2*HO2 + rxt_rates(:ncol,:, 688) = rxt_rates(:ncol,:, 688)*sol(:ncol,:, 299)*sol(:ncol,:, 147) ! rate_const*TERP1OOHO2*NO + rxt_rates(:ncol,:, 689) = rxt_rates(:ncol,:, 689)*sol(:ncol,:, 200)*sol(:ncol,:, 295) ! rate_const*TERP1OOH*OH + rxt_rates(:ncol,:, 690) = rxt_rates(:ncol,:, 690)*sol(:ncol,:, 201)*sol(:ncol,:, 295) ! rate_const*TERP2AOOH*OH + rxt_rates(:ncol,:, 691) = rxt_rates(:ncol,:, 691)*sol(:ncol,:, 300)*sol(:ncol,:, 258) ! rate_const*TERP2OOHO2*HO2 + rxt_rates(:ncol,:, 692) = rxt_rates(:ncol,:, 692)*sol(:ncol,:, 300)*sol(:ncol,:, 147) ! rate_const*TERP2OOHO2*NO + rxt_rates(:ncol,:, 693) = rxt_rates(:ncol,:, 693)*sol(:ncol,:, 301)*sol(:ncol,:, 252) ! rate_const*TERPA1O2*CH3CO3 + rxt_rates(:ncol,:, 694) = rxt_rates(:ncol,:, 694)*sol(:ncol,:, 301)*sol(:ncol,:, 253) ! rate_const*TERPA1O2*CH3O2 + rxt_rates(:ncol,:, 695) = rxt_rates(:ncol,:, 695)*sol(:ncol,:, 301)*sol(:ncol,:, 258) ! rate_const*TERPA1O2*HO2 + rxt_rates(:ncol,:, 696) = rxt_rates(:ncol,:, 696)*sol(:ncol,:, 301)*sol(:ncol,:, 147) ! rate_const*TERPA1O2*NO + rxt_rates(:ncol,:, 697) = rxt_rates(:ncol,:, 697)*sol(:ncol,:, 301)*sol(:ncol,:, 149) ! rate_const*TERPA1O2*NO3 + rxt_rates(:ncol,:, 698) = rxt_rates(:ncol,:, 698)*sol(:ncol,:, 301)*sol(:ncol,:, 302) ! rate_const*TERPA1O2*TERPA2CO3 + rxt_rates(:ncol,:, 699) = rxt_rates(:ncol,:, 699)*sol(:ncol,:, 301)*sol(:ncol,:, 304) ! rate_const*TERPA1O2*TERPA3CO3 + rxt_rates(:ncol,:, 700) = rxt_rates(:ncol,:, 700)*sol(:ncol,:, 301)*sol(:ncol,:, 307) ! rate_const*TERPA1O2*TERPACO3 + rxt_rates(:ncol,:, 701) = rxt_rates(:ncol,:, 701)*sol(:ncol,:, 302)*sol(:ncol,:, 252) ! rate_const*TERPA2CO3*CH3CO3 + rxt_rates(:ncol,:, 702) = rxt_rates(:ncol,:, 702)*sol(:ncol,:, 302)*sol(:ncol,:, 253) ! rate_const*TERPA2CO3*CH3O2 + rxt_rates(:ncol,:, 703) = rxt_rates(:ncol,:, 703)*sol(:ncol,:, 302)*sol(:ncol,:, 258) ! rate_const*TERPA2CO3*HO2 + rxt_rates(:ncol,:, 704) = rxt_rates(:ncol,:, 704)*sol(:ncol,:, 302)*sol(:ncol,:, 147) ! rate_const*TERPA2CO3*NO + rxt_rates(:ncol,:, 705) = rxt_rates(:ncol,:, 705)*sol(:ncol,:, 302)*sol(:ncol,:, 149) ! rate_const*TERPA2CO3*NO3 + rxt_rates(:ncol,:, 706) = rxt_rates(:ncol,:, 706)*sol(:ncol,:, 302)*sol(:ncol,:, 302) ! rate_const*TERPA2CO3*TERPA2CO3 + rxt_rates(:ncol,:, 707) = rxt_rates(:ncol,:, 707)*sol(:ncol,:, 302)*sol(:ncol,:, 307) ! rate_const*TERPA2CO3*TERPACO3 + rxt_rates(:ncol,:, 708) = rxt_rates(:ncol,:, 708)*sol(:ncol,:, 203)*sol(:ncol,:, 149) ! rate_const*TERPA2*NO3 + rxt_rates(:ncol,:, 709) = rxt_rates(:ncol,:, 709)*sol(:ncol,:, 303)*sol(:ncol,:, 252) ! rate_const*TERPA2O2*CH3CO3 + rxt_rates(:ncol,:, 710) = rxt_rates(:ncol,:, 710)*sol(:ncol,:, 303)*sol(:ncol,:, 253) ! rate_const*TERPA2O2*CH3O2 + rxt_rates(:ncol,:, 711) = rxt_rates(:ncol,:, 711)*sol(:ncol,:, 303)*sol(:ncol,:, 258) ! rate_const*TERPA2O2*HO2 + rxt_rates(:ncol,:, 712) = rxt_rates(:ncol,:, 712)*sol(:ncol,:, 303)*sol(:ncol,:, 147) ! rate_const*TERPA2O2*NO + rxt_rates(:ncol,:, 713) = rxt_rates(:ncol,:, 713)*sol(:ncol,:, 303)*sol(:ncol,:, 149) ! rate_const*TERPA2O2*NO3 + rxt_rates(:ncol,:, 714) = rxt_rates(:ncol,:, 714)*sol(:ncol,:, 303)*sol(:ncol,:, 302) ! rate_const*TERPA2O2*TERPA2CO3 + rxt_rates(:ncol,:, 715) = rxt_rates(:ncol,:, 715)*sol(:ncol,:, 303)*sol(:ncol,:, 304) ! rate_const*TERPA2O2*TERPA3CO3 + rxt_rates(:ncol,:, 716) = rxt_rates(:ncol,:, 716)*sol(:ncol,:, 303)*sol(:ncol,:, 307) ! rate_const*TERPA2O2*TERPACO3 + rxt_rates(:ncol,:, 717) = rxt_rates(:ncol,:, 717)*sol(:ncol,:, 203)*sol(:ncol,:, 295) ! rate_const*TERPA2*OH + rxt_rates(:ncol,:, 718) = rxt_rates(:ncol,:, 718)*sol(:ncol,:, 204)*sol(:ncol,:, 295) ! rate_const*TERPA2PAN*OH + rxt_rates(:ncol,:, 719) = rxt_rates(:ncol,:, 719)*sol(:ncol,:, 304)*sol(:ncol,:, 252) ! rate_const*TERPA3CO3*CH3CO3 + rxt_rates(:ncol,:, 720) = rxt_rates(:ncol,:, 720)*sol(:ncol,:, 304)*sol(:ncol,:, 253) ! rate_const*TERPA3CO3*CH3O2 + rxt_rates(:ncol,:, 721) = rxt_rates(:ncol,:, 721)*sol(:ncol,:, 304)*sol(:ncol,:, 258) ! rate_const*TERPA3CO3*HO2 + rxt_rates(:ncol,:, 722) = rxt_rates(:ncol,:, 722)*sol(:ncol,:, 304)*sol(:ncol,:, 147) ! rate_const*TERPA3CO3*NO + rxt_rates(:ncol,:, 723) = rxt_rates(:ncol,:, 723)*sol(:ncol,:, 304)*sol(:ncol,:, 149) ! rate_const*TERPA3CO3*NO3 + rxt_rates(:ncol,:, 724) = rxt_rates(:ncol,:, 724)*sol(:ncol,:, 304)*sol(:ncol,:, 302) ! rate_const*TERPA3CO3*TERPA2CO3 + rxt_rates(:ncol,:, 725) = rxt_rates(:ncol,:, 725)*sol(:ncol,:, 304)*sol(:ncol,:, 304) ! rate_const*TERPA3CO3*TERPA3CO3 + rxt_rates(:ncol,:, 726) = rxt_rates(:ncol,:, 726)*sol(:ncol,:, 304)*sol(:ncol,:, 307) ! rate_const*TERPA3CO3*TERPACO3 + rxt_rates(:ncol,:, 727) = rxt_rates(:ncol,:, 727)*sol(:ncol,:, 205)*sol(:ncol,:, 149) ! rate_const*TERPA3*NO3 + rxt_rates(:ncol,:, 728) = rxt_rates(:ncol,:, 728)*sol(:ncol,:, 305)*sol(:ncol,:, 252) ! rate_const*TERPA3O2*CH3CO3 + rxt_rates(:ncol,:, 729) = rxt_rates(:ncol,:, 729)*sol(:ncol,:, 305)*sol(:ncol,:, 253) ! rate_const*TERPA3O2*CH3O2 + rxt_rates(:ncol,:, 730) = rxt_rates(:ncol,:, 730)*sol(:ncol,:, 305)*sol(:ncol,:, 258) ! rate_const*TERPA3O2*HO2 + rxt_rates(:ncol,:, 731) = rxt_rates(:ncol,:, 731)*sol(:ncol,:, 305)*sol(:ncol,:, 147) ! rate_const*TERPA3O2*NO + rxt_rates(:ncol,:, 732) = rxt_rates(:ncol,:, 732)*sol(:ncol,:, 305)*sol(:ncol,:, 149) ! rate_const*TERPA3O2*NO3 + rxt_rates(:ncol,:, 733) = rxt_rates(:ncol,:, 733)*sol(:ncol,:, 305)*sol(:ncol,:, 302) ! rate_const*TERPA3O2*TERPA2CO3 + rxt_rates(:ncol,:, 734) = rxt_rates(:ncol,:, 734)*sol(:ncol,:, 305)*sol(:ncol,:, 304) ! rate_const*TERPA3O2*TERPA3CO3 + rxt_rates(:ncol,:, 735) = rxt_rates(:ncol,:, 735)*sol(:ncol,:, 305)*sol(:ncol,:, 307) ! rate_const*TERPA3O2*TERPACO3 + rxt_rates(:ncol,:, 736) = rxt_rates(:ncol,:, 736)*sol(:ncol,:, 205)*sol(:ncol,:, 295) ! rate_const*TERPA3*OH + rxt_rates(:ncol,:, 737) = rxt_rates(:ncol,:, 737)*sol(:ncol,:, 206)*sol(:ncol,:, 295) ! rate_const*TERPA3PAN*OH + rxt_rates(:ncol,:, 738) = rxt_rates(:ncol,:, 738)*sol(:ncol,:, 306)*sol(:ncol,:, 252) ! rate_const*TERPA4O2*CH3CO3 + rxt_rates(:ncol,:, 739) = rxt_rates(:ncol,:, 739)*sol(:ncol,:, 306)*sol(:ncol,:, 253) ! rate_const*TERPA4O2*CH3O2 + rxt_rates(:ncol,:, 740) = rxt_rates(:ncol,:, 740)*sol(:ncol,:, 306)*sol(:ncol,:, 258) ! rate_const*TERPA4O2*HO2 + rxt_rates(:ncol,:, 741) = rxt_rates(:ncol,:, 741)*sol(:ncol,:, 306)*sol(:ncol,:, 147) ! rate_const*TERPA4O2*NO + rxt_rates(:ncol,:, 742) = rxt_rates(:ncol,:, 742)*sol(:ncol,:, 306)*sol(:ncol,:, 149) ! rate_const*TERPA4O2*NO3 + rxt_rates(:ncol,:, 743) = rxt_rates(:ncol,:, 743)*sol(:ncol,:, 306)*sol(:ncol,:, 302) ! rate_const*TERPA4O2*TERPA2CO3 + rxt_rates(:ncol,:, 744) = rxt_rates(:ncol,:, 744)*sol(:ncol,:, 306)*sol(:ncol,:, 304) ! rate_const*TERPA4O2*TERPA3CO3 + rxt_rates(:ncol,:, 745) = rxt_rates(:ncol,:, 745)*sol(:ncol,:, 306)*sol(:ncol,:, 307) ! rate_const*TERPA4O2*TERPACO3 + rxt_rates(:ncol,:, 746) = rxt_rates(:ncol,:, 746)*sol(:ncol,:, 208)*sol(:ncol,:, 295) ! rate_const*TERPACID2*OH + rxt_rates(:ncol,:, 747) = rxt_rates(:ncol,:, 747)*sol(:ncol,:, 209)*sol(:ncol,:, 295) ! rate_const*TERPACID3*OH + rxt_rates(:ncol,:, 748) = rxt_rates(:ncol,:, 748)*sol(:ncol,:, 207)*sol(:ncol,:, 295) ! rate_const*TERPACID*OH + rxt_rates(:ncol,:, 749) = rxt_rates(:ncol,:, 749)*sol(:ncol,:, 307)*sol(:ncol,:, 252) ! rate_const*TERPACO3*CH3CO3 + rxt_rates(:ncol,:, 750) = rxt_rates(:ncol,:, 750)*sol(:ncol,:, 307)*sol(:ncol,:, 253) ! rate_const*TERPACO3*CH3O2 + rxt_rates(:ncol,:, 751) = rxt_rates(:ncol,:, 751)*sol(:ncol,:, 307)*sol(:ncol,:, 258) ! rate_const*TERPACO3*HO2 + rxt_rates(:ncol,:, 752) = rxt_rates(:ncol,:, 752)*sol(:ncol,:, 307)*sol(:ncol,:, 147) ! rate_const*TERPACO3*NO + rxt_rates(:ncol,:, 753) = rxt_rates(:ncol,:, 753)*sol(:ncol,:, 307)*sol(:ncol,:, 149) ! rate_const*TERPACO3*NO3 + rxt_rates(:ncol,:, 754) = rxt_rates(:ncol,:, 754)*sol(:ncol,:, 307)*sol(:ncol,:, 307) ! rate_const*TERPACO3*TERPACO3 + rxt_rates(:ncol,:, 755) = rxt_rates(:ncol,:, 755)*sol(:ncol,:, 202)*sol(:ncol,:, 149) ! rate_const*TERPA*NO3 + rxt_rates(:ncol,:, 756) = rxt_rates(:ncol,:, 756)*sol(:ncol,:, 202)*sol(:ncol,:, 295) ! rate_const*TERPA*OH + rxt_rates(:ncol,:, 757) = rxt_rates(:ncol,:, 757)*sol(:ncol,:, 210)*sol(:ncol,:, 295) ! rate_const*TERPAPAN*OH + rxt_rates(:ncol,:, 758) = rxt_rates(:ncol,:, 758)*sol(:ncol,:, 211)*sol(:ncol,:, 295) ! rate_const*TERPDHDP*OH + rxt_rates(:ncol,:, 759) = rxt_rates(:ncol,:, 759)*sol(:ncol,:, 212)*sol(:ncol,:, 149) ! rate_const*TERPF1*NO3 + rxt_rates(:ncol,:, 760) = rxt_rates(:ncol,:, 760)*sol(:ncol,:, 308)*sol(:ncol,:, 258) ! rate_const*TERPF1O2*HO2 + rxt_rates(:ncol,:, 761) = rxt_rates(:ncol,:, 761)*sol(:ncol,:, 308)*sol(:ncol,:, 147) ! rate_const*TERPF1O2*NO + rxt_rates(:ncol,:, 762) = rxt_rates(:ncol,:, 762)*sol(:ncol,:, 212)*sol(:ncol,:, 158) ! rate_const*TERPF1*O3 + rxt_rates(:ncol,:, 763) = rxt_rates(:ncol,:, 763)*sol(:ncol,:, 212)*sol(:ncol,:, 295) ! rate_const*TERPF1*OH + rxt_rates(:ncol,:, 764) = rxt_rates(:ncol,:, 764)*sol(:ncol,:, 213)*sol(:ncol,:, 149) ! rate_const*TERPF2*NO3 + rxt_rates(:ncol,:, 765) = rxt_rates(:ncol,:, 765)*sol(:ncol,:, 309)*sol(:ncol,:, 258) ! rate_const*TERPF2O2*HO2 + rxt_rates(:ncol,:, 766) = rxt_rates(:ncol,:, 766)*sol(:ncol,:, 309)*sol(:ncol,:, 147) ! rate_const*TERPF2O2*NO + rxt_rates(:ncol,:, 767) = rxt_rates(:ncol,:, 767)*sol(:ncol,:, 213)*sol(:ncol,:, 158) ! rate_const*TERPF2*O3 + rxt_rates(:ncol,:, 768) = rxt_rates(:ncol,:, 768)*sol(:ncol,:, 213)*sol(:ncol,:, 295) ! rate_const*TERPF2*OH + rxt_rates(:ncol,:, 769) = rxt_rates(:ncol,:, 769)*sol(:ncol,:, 214)*sol(:ncol,:, 295) ! rate_const*TERPFDN*OH + rxt_rates(:ncol,:, 770) = rxt_rates(:ncol,:, 770)*sol(:ncol,:, 215)*sol(:ncol,:, 295) ! rate_const*TERPHFN*OH + rxt_rates(:ncol,:, 771) = rxt_rates(:ncol,:, 771)*sol(:ncol,:, 216)*sol(:ncol,:, 295) ! rate_const*TERPK*OH + rxt_rates(:ncol,:, 772) = rxt_rates(:ncol,:, 772)*sol(:ncol,:, 310)*sol(:ncol,:, 258) ! rate_const*TERPNPS1O2*HO2 + rxt_rates(:ncol,:, 773) = rxt_rates(:ncol,:, 773)*sol(:ncol,:, 310)*sol(:ncol,:, 147) ! rate_const*TERPNPS1O2*NO + rxt_rates(:ncol,:, 774) = rxt_rates(:ncol,:, 774)*sol(:ncol,:, 218)*sol(:ncol,:, 295) ! rate_const*TERPNPS1*OH + rxt_rates(:ncol,:, 775) = rxt_rates(:ncol,:, 775)*sol(:ncol,:, 217)*sol(:ncol,:, 295) ! rate_const*TERPNPS*OH + rxt_rates(:ncol,:, 776) = rxt_rates(:ncol,:, 776)*sol(:ncol,:, 311)*sol(:ncol,:, 258) ! rate_const*TERPNPT1O2*HO2 + rxt_rates(:ncol,:, 777) = rxt_rates(:ncol,:, 777)*sol(:ncol,:, 311)*sol(:ncol,:, 147) ! rate_const*TERPNPT1O2*NO + rxt_rates(:ncol,:, 778) = rxt_rates(:ncol,:, 778)*sol(:ncol,:, 220)*sol(:ncol,:, 295) ! rate_const*TERPNPT1*OH + rxt_rates(:ncol,:, 779) = rxt_rates(:ncol,:, 779)*sol(:ncol,:, 219)*sol(:ncol,:, 295) ! rate_const*TERPNPT*OH + rxt_rates(:ncol,:, 780) = rxt_rates(:ncol,:, 780)*sol(:ncol,:, 312)*sol(:ncol,:, 258) ! rate_const*TERPNS1O2*HO2 + rxt_rates(:ncol,:, 781) = rxt_rates(:ncol,:, 781)*sol(:ncol,:, 312)*sol(:ncol,:, 147) ! rate_const*TERPNS1O2*NO + rxt_rates(:ncol,:, 782) = rxt_rates(:ncol,:, 782)*sol(:ncol,:, 222)*sol(:ncol,:, 295) ! rate_const*TERPNS1*OH + rxt_rates(:ncol,:, 783) = rxt_rates(:ncol,:, 783)*sol(:ncol,:, 221)*sol(:ncol,:, 295) ! rate_const*TERPNS*OH + rxt_rates(:ncol,:, 784) = rxt_rates(:ncol,:, 784)*sol(:ncol,:, 313)*sol(:ncol,:, 258) ! rate_const*TERPNT1O2*HO2 + rxt_rates(:ncol,:, 785) = rxt_rates(:ncol,:, 785)*sol(:ncol,:, 313)*sol(:ncol,:, 147) ! rate_const*TERPNT1O2*NO + rxt_rates(:ncol,:, 786) = rxt_rates(:ncol,:, 786)*sol(:ncol,:, 224)*sol(:ncol,:, 295) ! rate_const*TERPNT1*OH + rxt_rates(:ncol,:, 787) = rxt_rates(:ncol,:, 787)*sol(:ncol,:, 223)*sol(:ncol,:, 295) ! rate_const*TERPNT*OH + rxt_rates(:ncol,:, 788) = rxt_rates(:ncol,:, 788)*sol(:ncol,:, 226)*sol(:ncol,:, 295) ! rate_const*TERPOOHL*OH + rxt_rates(:ncol,:, 789) = rxt_rates(:ncol,:, 789)*sol(:ncol,:, 225)*sol(:ncol,:, 295) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 790) = rxt_rates(:ncol,:, 790)*sol(:ncol,:, 204) ! rate_const*M*TERPA2PAN + rxt_rates(:ncol,:, 791) = rxt_rates(:ncol,:, 791)*sol(:ncol,:, 206) ! rate_const*M*TERPA3PAN + rxt_rates(:ncol,:, 792) = rxt_rates(:ncol,:, 792)*sol(:ncol,:, 210) ! rate_const*M*TERPAPAN + rxt_rates(:ncol,:, 793) = rxt_rates(:ncol,:, 793)*sol(:ncol,:, 69)*sol(:ncol,:, 149) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 794) = rxt_rates(:ncol,:, 794)*sol(:ncol,:, 69)*sol(:ncol,:, 295) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 795) = rxt_rates(:ncol,:, 795)*sol(:ncol,:, 161)*sol(:ncol,:, 157) ! rate_const*OCS*O + rxt_rates(:ncol,:, 796) = rxt_rates(:ncol,:, 796)*sol(:ncol,:, 161)*sol(:ncol,:, 295) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 797) = rxt_rates(:ncol,:, 797)*sol(:ncol,:, 172) ! rate_const*O2*S + rxt_rates(:ncol,:, 798) = rxt_rates(:ncol,:, 798)*sol(:ncol,:, 175)*sol(:ncol,:, 295) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 799) = rxt_rates(:ncol,:, 799)*sol(:ncol,:, 172)*sol(:ncol,:, 158) ! rate_const*S*O3 + rxt_rates(:ncol,:, 800) = rxt_rates(:ncol,:, 800)*sol(:ncol,:, 174)*sol(:ncol,:, 20) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 801) = rxt_rates(:ncol,:, 801)*sol(:ncol,:, 174)*sol(:ncol,:, 60) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 802) = rxt_rates(:ncol,:, 802)*sol(:ncol,:, 172)*sol(:ncol,:, 295) ! rate_const*S*OH + rxt_rates(:ncol,:, 803) = rxt_rates(:ncol,:, 803)*sol(:ncol,:, 174)*sol(:ncol,:, 148) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 804) = rxt_rates(:ncol,:, 804)*sol(:ncol,:, 174) ! rate_const*O2*SO + rxt_rates(:ncol,:, 805) = rxt_rates(:ncol,:, 805)*sol(:ncol,:, 174)*sol(:ncol,:, 158) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 806) = rxt_rates(:ncol,:, 806)*sol(:ncol,:, 174)*sol(:ncol,:, 160) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 807) = rxt_rates(:ncol,:, 807)*sol(:ncol,:, 174)*sol(:ncol,:, 295) ! rate_const*SO*OH + rxt_rates(:ncol,:, 808) = rxt_rates(:ncol,:, 808)*sol(:ncol,:, 69)*sol(:ncol,:, 295) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 809) = rxt_rates(:ncol,:, 809)*sol(:ncol,:, 176)*sol(:ncol,:, 319) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 810) = rxt_rates(:ncol,:, 810)*sol(:ncol,:, 143)*sol(:ncol,:, 295) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 811) = rxt_rates(:ncol,:, 811)*sol(:ncol,:, 77) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 812) = rxt_rates(:ncol,:, 812)*sol(:ncol,:, 258) ! rate_const*HO2 + rxt_rates(:ncol,:, 813) = rxt_rates(:ncol,:, 813)*sol(:ncol,:, 97) ! rate_const*HONITR + rxt_rates(:ncol,:, 814) = rxt_rates(:ncol,:, 814)*sol(:ncol,:, 105) ! rate_const*ICHE + rxt_rates(:ncol,:, 815) = rxt_rates(:ncol,:, 815)*sol(:ncol,:, 106) ! rate_const*IEPOX + rxt_rates(:ncol,:, 816) = rxt_rates(:ncol,:, 816)*sol(:ncol,:, 107) ! rate_const*INHEB + rxt_rates(:ncol,:, 817) = rxt_rates(:ncol,:, 817)*sol(:ncol,:, 108) ! rate_const*INHED + rxt_rates(:ncol,:, 818) = rxt_rates(:ncol,:, 818)*sol(:ncol,:, 121) ! rate_const*ISOPNOOHD + rxt_rates(:ncol,:, 819) = rxt_rates(:ncol,:, 819)*sol(:ncol,:, 110) ! rate_const*ISOPFDN + rxt_rates(:ncol,:, 820) = rxt_rates(:ncol,:, 820)*sol(:ncol,:, 111) ! rate_const*ISOPFDNC + rxt_rates(:ncol,:, 821) = rxt_rates(:ncol,:, 821)*sol(:ncol,:, 112) ! rate_const*ISOPFNC + rxt_rates(:ncol,:, 822) = rxt_rates(:ncol,:, 822)*sol(:ncol,:, 113) ! rate_const*ISOPFNP + rxt_rates(:ncol,:, 823) = rxt_rates(:ncol,:, 823)*sol(:ncol,:, 114) ! rate_const*ISOPHFP + rxt_rates(:ncol,:, 824) = rxt_rates(:ncol,:, 824)*sol(:ncol,:, 115) ! rate_const*ISOPN1D + rxt_rates(:ncol,:, 825) = rxt_rates(:ncol,:, 825)*sol(:ncol,:, 116) ! rate_const*ISOPN2B + rxt_rates(:ncol,:, 826) = rxt_rates(:ncol,:, 826)*sol(:ncol,:, 118) ! rate_const*ISOPN4D + rxt_rates(:ncol,:, 827) = rxt_rates(:ncol,:, 827)*sol(:ncol,:, 138) ! rate_const*N2O5 + rxt_rates(:ncol,:, 828) = rxt_rates(:ncol,:, 828)*sol(:ncol,:, 139) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 829) = rxt_rates(:ncol,:, 829)*sol(:ncol,:, 144) ! rate_const*NH4 + rxt_rates(:ncol,:, 830) = rxt_rates(:ncol,:, 830)*sol(:ncol,:, 148) ! rate_const*NO2 + rxt_rates(:ncol,:, 831) = rxt_rates(:ncol,:, 831)*sol(:ncol,:, 149) ! rate_const*NO3 + rxt_rates(:ncol,:, 832) = rxt_rates(:ncol,:, 832)*sol(:ncol,:, 162) ! rate_const*ONITR + rxt_rates(:ncol,:, 833) = rxt_rates(:ncol,:, 833)*sol(:ncol,:, 196) ! rate_const*SQTN + rxt_rates(:ncol,:, 834) = rxt_rates(:ncol,:, 834)*sol(:ncol,:, 211) ! rate_const*TERPDHDP + rxt_rates(:ncol,:, 835) = rxt_rates(:ncol,:, 835)*sol(:ncol,:, 214) ! rate_const*TERPFDN + rxt_rates(:ncol,:, 836) = rxt_rates(:ncol,:, 836)*sol(:ncol,:, 215) ! rate_const*TERPHFN + rxt_rates(:ncol,:, 837) = rxt_rates(:ncol,:, 837)*sol(:ncol,:, 220) ! rate_const*TERPNPT1 + rxt_rates(:ncol,:, 838) = rxt_rates(:ncol,:, 838)*sol(:ncol,:, 219) ! rate_const*TERPNPT + rxt_rates(:ncol,:, 839) = rxt_rates(:ncol,:, 839)*sol(:ncol,:, 224) ! rate_const*TERPNT1 + rxt_rates(:ncol,:, 840) = rxt_rates(:ncol,:, 840)*sol(:ncol,:, 223) ! rate_const*TERPNT + rxt_rates(:ncol,:, 841) = rxt_rates(:ncol,:, 841)*sol(:ncol,:, 4)*sol(:ncol,:, 149) ! rate_const*APIN*NO3 + rxt_rates(:ncol,:, 842) = rxt_rates(:ncol,:, 842)*sol(:ncol,:, 239)*sol(:ncol,:, 258) ! rate_const*APINO2VBS*HO2 + rxt_rates(:ncol,:, 843) = rxt_rates(:ncol,:, 843)*sol(:ncol,:, 239)*sol(:ncol,:, 147) ! rate_const*APINO2VBS*NO + rxt_rates(:ncol,:, 844) = rxt_rates(:ncol,:, 844)*sol(:ncol,:, 4)*sol(:ncol,:, 158) ! rate_const*APIN*O3 + rxt_rates(:ncol,:, 845) = rxt_rates(:ncol,:, 845)*sol(:ncol,:, 4)*sol(:ncol,:, 295) ! rate_const*APIN*OH + rxt_rates(:ncol,:, 846) = rxt_rates(:ncol,:, 846)*sol(:ncol,:, 7)*sol(:ncol,:, 149) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 847) = rxt_rates(:ncol,:, 847)*sol(:ncol,:, 242)*sol(:ncol,:, 258) ! rate_const*BCARYO2VBS*HO2 + rxt_rates(:ncol,:, 848) = rxt_rates(:ncol,:, 848)*sol(:ncol,:, 242)*sol(:ncol,:, 147) ! rate_const*BCARYO2VBS*NO + rxt_rates(:ncol,:, 849) = rxt_rates(:ncol,:, 849)*sol(:ncol,:, 7)*sol(:ncol,:, 158) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 850) = rxt_rates(:ncol,:, 850)*sol(:ncol,:, 7)*sol(:ncol,:, 295) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 851) = rxt_rates(:ncol,:, 851)*sol(:ncol,:, 8)*sol(:ncol,:, 295) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 852) = rxt_rates(:ncol,:, 852)*sol(:ncol,:, 244)*sol(:ncol,:, 258) ! rate_const*BENZO2VBS*HO2 + rxt_rates(:ncol,:, 853) = rxt_rates(:ncol,:, 853)*sol(:ncol,:, 244)*sol(:ncol,:, 147) ! rate_const*BENZO2VBS*NO + rxt_rates(:ncol,:, 854) = rxt_rates(:ncol,:, 854)*sol(:ncol,:, 17)*sol(:ncol,:, 149) ! rate_const*BPIN*NO3 + rxt_rates(:ncol,:, 855) = rxt_rates(:ncol,:, 855)*sol(:ncol,:, 247)*sol(:ncol,:, 258) ! rate_const*BPINO2VBS*HO2 + rxt_rates(:ncol,:, 856) = rxt_rates(:ncol,:, 856)*sol(:ncol,:, 247)*sol(:ncol,:, 147) ! rate_const*BPINO2VBS*NO + rxt_rates(:ncol,:, 857) = rxt_rates(:ncol,:, 857)*sol(:ncol,:, 17)*sol(:ncol,:, 158) ! rate_const*BPIN*O3 + rxt_rates(:ncol,:, 858) = rxt_rates(:ncol,:, 858)*sol(:ncol,:, 17)*sol(:ncol,:, 295) ! rate_const*BPIN*OH + rxt_rates(:ncol,:, 859) = rxt_rates(:ncol,:, 859)*sol(:ncol,:, 109)*sol(:ncol,:, 149) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 860) = rxt_rates(:ncol,:, 860)*sol(:ncol,:, 277)*sol(:ncol,:, 258) ! rate_const*ISOPO2VBS*HO2 + rxt_rates(:ncol,:, 861) = rxt_rates(:ncol,:, 861)*sol(:ncol,:, 277)*sol(:ncol,:, 147) ! rate_const*ISOPO2VBS*NO + rxt_rates(:ncol,:, 862) = rxt_rates(:ncol,:, 862)*sol(:ncol,:, 109)*sol(:ncol,:, 158) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 863) = rxt_rates(:ncol,:, 863)*sol(:ncol,:, 109)*sol(:ncol,:, 295) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 864) = rxt_rates(:ncol,:, 864)*sol(:ncol,:, 280)*sol(:ncol,:, 258) ! rate_const*IVOCO2VBS*HO2 + rxt_rates(:ncol,:, 865) = rxt_rates(:ncol,:, 865)*sol(:ncol,:, 280)*sol(:ncol,:, 147) ! rate_const*IVOCO2VBS*NO + rxt_rates(:ncol,:, 866) = rxt_rates(:ncol,:, 866)*sol(:ncol,:, 124)*sol(:ncol,:, 295) ! rate_const*IVOC*OH + rxt_rates(:ncol,:, 867) = rxt_rates(:ncol,:, 867)*sol(:ncol,:, 125)*sol(:ncol,:, 149) ! rate_const*LIMON*NO3 + rxt_rates(:ncol,:, 868) = rxt_rates(:ncol,:, 868)*sol(:ncol,:, 283)*sol(:ncol,:, 258) ! rate_const*LIMONO2VBS*HO2 + rxt_rates(:ncol,:, 869) = rxt_rates(:ncol,:, 869)*sol(:ncol,:, 283)*sol(:ncol,:, 147) ! rate_const*LIMONO2VBS*NO + rxt_rates(:ncol,:, 870) = rxt_rates(:ncol,:, 870)*sol(:ncol,:, 125)*sol(:ncol,:, 158) ! rate_const*LIMON*O3 + rxt_rates(:ncol,:, 871) = rxt_rates(:ncol,:, 871)*sol(:ncol,:, 125)*sol(:ncol,:, 295) ! rate_const*LIMON*OH + rxt_rates(:ncol,:, 872) = rxt_rates(:ncol,:, 872)*sol(:ncol,:, 135)*sol(:ncol,:, 149) ! rate_const*MYRC*NO3 + rxt_rates(:ncol,:, 873) = rxt_rates(:ncol,:, 873)*sol(:ncol,:, 292)*sol(:ncol,:, 258) ! rate_const*MYRCO2VBS*HO2 + rxt_rates(:ncol,:, 874) = rxt_rates(:ncol,:, 874)*sol(:ncol,:, 292)*sol(:ncol,:, 147) ! rate_const*MYRCO2VBS*NO + rxt_rates(:ncol,:, 875) = rxt_rates(:ncol,:, 875)*sol(:ncol,:, 135)*sol(:ncol,:, 158) ! rate_const*MYRC*O3 + rxt_rates(:ncol,:, 876) = rxt_rates(:ncol,:, 876)*sol(:ncol,:, 135)*sol(:ncol,:, 295) ! rate_const*MYRC*OH + rxt_rates(:ncol,:, 877) = rxt_rates(:ncol,:, 877)*sol(:ncol,:, 198)*sol(:ncol,:, 295) ! rate_const*SVOC*OH + rxt_rates(:ncol,:, 878) = rxt_rates(:ncol,:, 878)*sol(:ncol,:, 228)*sol(:ncol,:, 295) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 879) = rxt_rates(:ncol,:, 879)*sol(:ncol,:, 315)*sol(:ncol,:, 258) ! rate_const*TOLUO2VBS*HO2 + rxt_rates(:ncol,:, 880) = rxt_rates(:ncol,:, 880)*sol(:ncol,:, 315)*sol(:ncol,:, 147) ! rate_const*TOLUO2VBS*NO + rxt_rates(:ncol,:, 881) = rxt_rates(:ncol,:, 881)*sol(:ncol,:, 229)*sol(:ncol,:, 295) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 882) = rxt_rates(:ncol,:, 882)*sol(:ncol,:, 317)*sol(:ncol,:, 258) ! rate_const*XYLEO2VBS*HO2 + rxt_rates(:ncol,:, 883) = rxt_rates(:ncol,:, 883)*sol(:ncol,:, 317)*sol(:ncol,:, 147) ! rate_const*XYLEO2VBS*NO + rxt_rates(:ncol,:, 884) = rxt_rates(:ncol,:, 884)*sol(:ncol,:, 138) ! rate_const*N2O5 + rxt_rates(:ncol,:, 885) = rxt_rates(:ncol,:, 885)*sol(:ncol,:, 96)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 886) = rxt_rates(:ncol,:, 886)*sol(:ncol,:, 21) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 887) = rxt_rates(:ncol,:, 887)*sol(:ncol,:, 138) ! rate_const*N2O5 + rxt_rates(:ncol,:, 888) = rxt_rates(:ncol,:, 888)*sol(:ncol,:, 61) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 889) = rxt_rates(:ncol,:, 889)*sol(:ncol,:, 21) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 890) = rxt_rates(:ncol,:, 890)*sol(:ncol,:, 61)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 891) = rxt_rates(:ncol,:, 891)*sol(:ncol,:, 96)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 892) = rxt_rates(:ncol,:, 892)*sol(:ncol,:, 95)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 893) = rxt_rates(:ncol,:, 893)*sol(:ncol,:, 61) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 894) = rxt_rates(:ncol,:, 894)*sol(:ncol,:, 21) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 895) = rxt_rates(:ncol,:, 895)*sol(:ncol,:, 61)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 896) = rxt_rates(:ncol,:, 896)*sol(:ncol,:, 96)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 897) = rxt_rates(:ncol,:, 897)*sol(:ncol,:, 95)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 898) = rxt_rates(:ncol,:, 898)*sol(:ncol,:, 138) ! rate_const*N2O5 + rxt_rates(:ncol,:, 899) = rxt_rates(:ncol,:, 899)*sol(:ncol,:, 61) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 900) = rxt_rates(:ncol,:, 900)*sol(:ncol,:, 61)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 901) = rxt_rates(:ncol,:, 901)*sol(:ncol,:, 73) ! rate_const*E90 + rxt_rates(:ncol,:, 902) = rxt_rates(:ncol,:, 902)*sol(:ncol,:, 146) ! rate_const*NH_50 + rxt_rates(:ncol,:, 903) = rxt_rates(:ncol,:, 903)*sol(:ncol,:, 145) ! rate_const*NH_5 + rxt_rates(:ncol,:, 904) = rxt_rates(:ncol,:, 904)*sol(:ncol,:, 197) ! rate_const*ST80_25 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_strat_mam5_ts2/mo_setrxt.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/mo_setrxt.F90 new file mode 100644 index 0000000000..3eacb8cb42 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/mo_setrxt.F90 @@ -0,0 +1,1076 @@ + + 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(:,168) = 1.2e-10_r8 + rate(:,172) = 1.2e-10_r8 + rate(:,178) = 6.9e-12_r8 + rate(:,179) = 7.2e-11_r8 + rate(:,180) = 1.6e-12_r8 + rate(:,186) = 1.8e-12_r8 + rate(:,190) = 1.8e-12_r8 + rate(:,202) = 3.5e-12_r8 + rate(:,204) = 1.3e-11_r8 + rate(:,205) = 2.2e-11_r8 + rate(:,206) = 5e-11_r8 + rate(:,241) = 1.7e-13_r8 + rate(:,243) = 2.607e-10_r8 + rate(:,244) = 9.75e-11_r8 + rate(:,245) = 2.07e-10_r8 + rate(:,246) = 2.088e-10_r8 + rate(:,247) = 1.17e-10_r8 + rate(:,248) = 4.644e-11_r8 + rate(:,249) = 1.204e-10_r8 + rate(:,250) = 9.9e-11_r8 + rate(:,251) = 3.3e-12_r8 + rate(:,270) = 4.5e-11_r8 + rate(:,271) = 4.62e-10_r8 + rate(:,272) = 1.2e-10_r8 + rate(:,273) = 9e-11_r8 + rate(:,274) = 3e-11_r8 + rate(:,279) = 2.14e-11_r8 + rate(:,280) = 1.9e-10_r8 + rate(:,293) = 2.57e-10_r8 + rate(:,294) = 1.8e-10_r8 + rate(:,295) = 1.794e-10_r8 + rate(:,296) = 1.3e-10_r8 + rate(:,297) = 7.65e-11_r8 + rate(:,310) = 4e-13_r8 + rate(:,315) = 1.31e-10_r8 + rate(:,316) = 3.5e-11_r8 + rate(:,317) = 9e-12_r8 + rate(:,324) = 6.8e-14_r8 + rate(:,325) = 2e-13_r8 + rate(:,340) = 1e-12_r8 + rate(:,344) = 1e-14_r8 + rate(:,345) = 1e-11_r8 + rate(:,346) = 1.15e-11_r8 + rate(:,347) = 3.3e-11_r8 + rate(:,348) = 3.4e-12_r8 + rate(:,349) = 4e-14_r8 + rate(:,362) = 3e-12_r8 + rate(:,363) = 1.2e-11_r8 + rate(:,364) = 6.7e-13_r8 + rate(:,374) = 3.5e-13_r8 + rate(:,375) = 5.4e-11_r8 + rate(:,376) = 3.77e-11_r8 + rate(:,379) = 2e-12_r8 + rate(:,380) = 1.29e-11_r8 + rate(:,382) = 4.5e-14_r8 + rate(:,387) = 3.77e-11_r8 + rate(:,393) = 4e-12_r8 + rate(:,399) = 1.78e-12_r8 + rate(:,401) = 6.1e-13_r8 + rate(:,405) = 4.8e-11_r8 + rate(:,408) = 1.6e-12_r8 + rate(:,410) = 6.7e-12_r8 + rate(:,413) = 3.5e-12_r8 + rate(:,418) = 6.42e-11_r8 + rate(:,425) = 1.6e-13_r8 + rate(:,431) = 1.4e-12_r8 + rate(:,436) = 7.5e-13_r8 + rate(:,437) = 1.4e-13_r8 + rate(:,438) = 7.5e-13_r8 + rate(:,439) = 3.6e-13_r8 + rate(:,440) = 6.5e-13_r8 + rate(:,441) = 2.1e-13_r8 + rate(:,442) = 6.5e-13_r8 + rate(:,443) = 4.9e-13_r8 + rate(:,445) = 1.2e-12_r8 + rate(:,449) = 9.8e-13_r8 + rate(:,452) = 1.85e-11_r8 + rate(:,453) = 1.63e-12_r8 + rate(:,454) = 2.5e-11_r8 + rate(:,455) = 1.1e-11_r8 + rate(:,456) = 3.3e-11_r8 + rate(:,459) = 2.8e-17_r8 + rate(:,460) = 8e-11_r8 + rate(:,463) = 3e-11_r8 + rate(:,466) = 4.2e-11_r8 + rate(:,469) = 2.8e-17_r8 + rate(:,470) = 1.1e-10_r8 + rate(:,472) = 3.9e-11_r8 + rate(:,475) = 1.3e-12_r8 + rate(:,477) = 5e-12_r8 + rate(:,478) = 2.3e-12_r8 + rate(:,481) = 3.9e-11_r8 + rate(:,484) = 2.8e-17_r8 + rate(:,485) = 9.2e-11_r8 + rate(:,488) = 3.85e-11_r8 + rate(:,492) = 1.2e-12_r8 + rate(:,496) = 9.8e-13_r8 + rate(:,501) = 4.4e-18_r8 + rate(:,502) = 3.6e-11_r8 + rate(:,554) = 4.7e-11_r8 + rate(:,567) = 2.1e-12_r8 + rate(:,568) = 2.8e-13_r8 + rate(:,576) = 1.7e-11_r8 + rate(:,582) = 8.4e-11_r8 + rate(:,585) = 5.3e-13_r8 + rate(:,587) = 2e-12_r8 + rate(:,590) = 2.3e-12_r8 + rate(:,595) = 2e-12_r8 + rate(:,598) = 2.3e-12_r8 + rate(:,604) = 1.9e-11_r8 + rate(:,605) = 5.3e-13_r8 + rate(:,607) = 2e-12_r8 + rate(:,610) = 2.3e-12_r8 + rate(:,615) = 2e-12_r8 + rate(:,618) = 2.3e-12_r8 + rate(:,622) = 1.2e-14_r8 + rate(:,623) = 2e-10_r8 + rate(:,624) = 2.5e-12_r8 + rate(:,625) = 5.3e-13_r8 + rate(:,627) = 2e-12_r8 + rate(:,630) = 2.3e-12_r8 + rate(:,635) = 2e-12_r8 + rate(:,638) = 2.3e-12_r8 + rate(:,644) = 1.2e-11_r8 + rate(:,646) = 2e-12_r8 + rate(:,648) = 5.3e-13_r8 + rate(:,650) = 2.3e-12_r8 + rate(:,655) = 2e-12_r8 + rate(:,658) = 2.3e-12_r8 + rate(:,664) = 1.1e-11_r8 + rate(:,666) = 2e-12_r8 + rate(:,668) = 5.3e-13_r8 + rate(:,670) = 2.3e-12_r8 + rate(:,675) = 2e-12_r8 + rate(:,678) = 2.3e-12_r8 + rate(:,683) = 2.1e-10_r8 + rate(:,689) = 8.9e-11_r8 + rate(:,690) = 8.9e-11_r8 + rate(:,694) = 2e-12_r8 + rate(:,697) = 2.3e-12_r8 + rate(:,705) = 4e-12_r8 + rate(:,708) = 2e-14_r8 + rate(:,710) = 2e-12_r8 + rate(:,713) = 2.3e-12_r8 + rate(:,718) = 2.52e-11_r8 + rate(:,723) = 4e-12_r8 + rate(:,727) = 2e-14_r8 + rate(:,729) = 2e-12_r8 + rate(:,732) = 2.3e-12_r8 + rate(:,737) = 1.92e-11_r8 + rate(:,739) = 2e-12_r8 + rate(:,742) = 2.3e-12_r8 + rate(:,746) = 8.8e-12_r8 + rate(:,747) = 8.8e-12_r8 + rate(:,748) = 8.8e-12_r8 + rate(:,753) = 4e-12_r8 + rate(:,755) = 2e-14_r8 + rate(:,757) = 3.66e-12_r8 + rate(:,758) = 2.8e-11_r8 + rate(:,759) = 2.6e-13_r8 + rate(:,762) = 8.3e-18_r8 + rate(:,763) = 1.1e-10_r8 + rate(:,767) = 1.1e-16_r8 + rate(:,769) = 3.64e-12_r8 + rate(:,770) = 2.8e-11_r8 + rate(:,771) = 1.7e-11_r8 + rate(:,774) = 1.1e-10_r8 + rate(:,775) = 9.58e-12_r8 + rate(:,778) = 1.1e-10_r8 + rate(:,779) = 1.23e-11_r8 + rate(:,782) = 1.1e-10_r8 + rate(:,783) = 3.64e-12_r8 + rate(:,786) = 1.1e-10_r8 + rate(:,787) = 5.5e-12_r8 + rate(:,788) = 4.65e-11_r8 + rate(:,789) = 2.8e-11_r8 + rate(:,797) = 2.3e-12_r8 + rate(:,799) = 1.2e-11_r8 + rate(:,800) = 5.7e-11_r8 + rate(:,801) = 2.8e-11_r8 + rate(:,802) = 6.6e-11_r8 + rate(:,803) = 1.4e-11_r8 + rate(:,806) = 1.9e-12_r8 + rate(:,829) = 6.34e-08_r8 + rate(:,846) = 1.9e-11_r8 + rate(:,849) = 1.2e-14_r8 + rate(:,850) = 2e-10_r8 + rate(:,854) = 2.5e-12_r8 + rate(:,866) = 1.34e-11_r8 + rate(:,867) = 1.2e-11_r8 + rate(:,872) = 1.1e-11_r8 + rate(:,876) = 2.1e-10_r8 + rate(:,877) = 1.34e-11_r8 + rate(:,881) = 1.7e-11_r8 + rate(:,901) = 1.29e-07_r8 + rate(:,902) = 2.31e-07_r8 + rate(:,903) = 2.31e-06_r8 + rate(:,904) = 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(:,169) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,170) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:,171) = 3.3e-11_r8 * exp( 55._r8 * itemp(:) ) + rate(:,173) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,176) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + rate(:,177) = 1.4e-12_r8 * exp( -2000._r8 * itemp(:) ) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,182) = 3e-11_r8 * exp_fac(:) + rate(:,268) = 5.5e-12_r8 * exp_fac(:) + rate(:,307) = 3.8e-12_r8 * exp_fac(:) + rate(:,329) = 3.8e-12_r8 * exp_fac(:) + rate(:,358) = 3.8e-12_r8 * exp_fac(:) + rate(:,367) = 3.8e-12_r8 * exp_fac(:) + rate(:,371) = 3.8e-12_r8 * exp_fac(:) + rate(:,397) = 3.8e-12_r8 * exp_fac(:) + rate(:,412) = 3.8e-12_r8 * exp_fac(:) + rate(:,489) = 5.53e-12_r8 * exp_fac(:) + rate(:,546) = 3.8e-12_r8 * exp_fac(:) + rate(:,549) = 3.8e-12_r8 * exp_fac(:) + rate(:,553) = 3.8e-12_r8 * exp_fac(:) + rate(:,569) = 3.8e-12_r8 * exp_fac(:) + rate(:,573) = 3.8e-12_r8 * exp_fac(:) + rate(:,579) = 3.8e-12_r8 * exp_fac(:) + rate(:,583) = 3.8e-12_r8 * exp_fac(:) + rate(:,183) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,184) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,185) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,187) = 4.8e-11_r8 * exp_fac(:) + rate(:,266) = 1.7e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 180._r8 * itemp(:) ) + rate(:,188) = 1.8e-11_r8 * exp_fac(:) + rate(:,342) = 4.2e-12_r8 * exp_fac(:) + rate(:,357) = 4.2e-12_r8 * exp_fac(:) + rate(:,366) = 4.2e-12_r8 * exp_fac(:) + rate(:,395) = 4.2e-12_r8 * exp_fac(:) + rate(:,189) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,193) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) + rate(:,194) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,195) = 2.9e-12_r8 * exp_fac(:) + rate(:,196) = 1.45e-12_r8 * exp_fac(:) + rate(:,197) = 1.45e-12_r8 * exp_fac(:) + rate(:,198) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:,199) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,200) = 1.2e-13_r8 * exp_fac(:) + rate(:,226) = 3e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,203) = 1.7e-11_r8 * exp_fac(:) + rate(:,301) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,207) = 3.44e-12_r8 * exp_fac(:) + rate(:,259) = 2.3e-12_r8 * exp_fac(:) + rate(:,262) = 8.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,208) = 3e-12_r8 * exp_fac(:) + rate(:,267) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,210) = 7.26e-11_r8 * exp_fac(:) + rate(:,211) = 4.64e-11_r8 * exp_fac(:) + rate(:,218) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + exp_fac(:) = exp( -1270._r8 * itemp(:) ) + rate(:,219) = 7.1e-12_r8 * exp_fac(:) + rate(:,642) = 1.35e-15_r8 * exp_fac(:) + rate(:,857) = 1.35e-15_r8 * exp_fac(:) + rate(:,220) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,221) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,222) = 1.4e-11_r8 * exp_fac(:) + rate(:,236) = 7.4e-12_r8 * exp_fac(:) + rate(:,338) = 8.1e-12_r8 * exp_fac(:) + rate(:,392) = 8.1e-12_r8 * exp_fac(:) + rate(:,704) = 8.1e-12_r8 * exp_fac(:) + rate(:,722) = 8.1e-12_r8 * exp_fac(:) + rate(:,752) = 8.1e-12_r8 * exp_fac(:) + rate(:,223) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,224) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,225) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,227) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,228) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,229) = 2.6e-12_r8 * exp_fac(:) + rate(:,230) = 6.4e-12_r8 * exp_fac(:) + rate(:,260) = 4.1e-13_r8 * exp_fac(:) + rate(:,542) = 7.5e-12_r8 * exp_fac(:) + rate(:,556) = 7.5e-12_r8 * exp_fac(:) + rate(:,559) = 7.5e-12_r8 * exp_fac(:) + rate(:,562) = 7.5e-12_r8 * exp_fac(:) + rate(:,231) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,233) = 3.6e-12_r8 * exp_fac(:) + rate(:,282) = 2e-12_r8 * exp_fac(:) + rate(:,234) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,235) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,237) = 6e-13_r8 * exp_fac(:) + rate(:,257) = 1.5e-12_r8 * exp_fac(:) + rate(:,265) = 1.9e-11_r8 * exp_fac(:) + rate(:,238) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,239) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,240) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + exp_fac(:) = exp( -500._r8 * itemp(:) ) + rate(:,242) = 3e-12_r8 * exp_fac(:) + rate(:,276) = 1.4e-10_r8 * exp_fac(:) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,254) = 1.7e-11_r8 * exp_fac(:) + rate(:,281) = 6.3e-12_r8 * exp_fac(:) + rate(:,255) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,256) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,258) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + exp_fac(:) = exp( 460._r8 * itemp(:) ) + rate(:,261) = 4.5e-12_r8 * exp_fac(:) + rate(:,643) = 1.62e-11_r8 * exp_fac(:) + rate(:,858) = 1.62e-11_r8 * exp_fac(:) + rate(:,264) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,269) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,275) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) + exp_fac(:) = exp( 0._r8 * itemp(:) ) + rate(:,277) = 1.4e-11_r8 * exp_fac(:) + rate(:,279) = 2.14e-11_r8 * exp_fac(:) + rate(:,280) = 1.9e-10_r8 * exp_fac(:) + rate(:,293) = 2.57e-10_r8 * exp_fac(:) + rate(:,294) = 1.8e-10_r8 * exp_fac(:) + rate(:,295) = 1.794e-10_r8 * exp_fac(:) + rate(:,296) = 1.3e-10_r8 * exp_fac(:) + rate(:,297) = 7.65e-11_r8 * exp_fac(:) + rate(:,310) = 4e-13_r8 * exp_fac(:) + rate(:,315) = 1.31e-10_r8 * exp_fac(:) + rate(:,316) = 3.5e-11_r8 * exp_fac(:) + rate(:,317) = 9e-12_r8 * exp_fac(:) + rate(:,324) = 6.8e-14_r8 * exp_fac(:) + rate(:,325) = 2e-13_r8 * exp_fac(:) + rate(:,340) = 1e-12_r8 * exp_fac(:) + rate(:,344) = 1e-14_r8 * exp_fac(:) + rate(:,345) = 1e-11_r8 * exp_fac(:) + rate(:,346) = 1.15e-11_r8 * exp_fac(:) + rate(:,347) = 3.3e-11_r8 * exp_fac(:) + rate(:,348) = 3.4e-12_r8 * exp_fac(:) + rate(:,349) = 4e-14_r8 * exp_fac(:) + rate(:,362) = 3e-12_r8 * exp_fac(:) + rate(:,363) = 1.2e-11_r8 * exp_fac(:) + rate(:,364) = 6.7e-13_r8 * exp_fac(:) + rate(:,374) = 3.5e-13_r8 * exp_fac(:) + rate(:,375) = 5.4e-11_r8 * exp_fac(:) + rate(:,376) = 3.77e-11_r8 * exp_fac(:) + rate(:,379) = 2e-12_r8 * exp_fac(:) + rate(:,380) = 1.29e-11_r8 * exp_fac(:) + rate(:,382) = 4.5e-14_r8 * exp_fac(:) + rate(:,387) = 3.77e-11_r8 * exp_fac(:) + rate(:,393) = 4e-12_r8 * exp_fac(:) + rate(:,399) = 1.78e-12_r8 * exp_fac(:) + rate(:,401) = 6.1e-13_r8 * exp_fac(:) + rate(:,405) = 4.8e-11_r8 * exp_fac(:) + rate(:,408) = 1.6e-12_r8 * exp_fac(:) + rate(:,410) = 6.7e-12_r8 * exp_fac(:) + rate(:,413) = 3.5e-12_r8 * exp_fac(:) + rate(:,418) = 6.42e-11_r8 * exp_fac(:) + rate(:,425) = 1.6e-13_r8 * exp_fac(:) + rate(:,431) = 1.4e-12_r8 * exp_fac(:) + rate(:,436) = 7.5e-13_r8 * exp_fac(:) + rate(:,437) = 1.4e-13_r8 * exp_fac(:) + rate(:,438) = 7.5e-13_r8 * exp_fac(:) + rate(:,439) = 3.6e-13_r8 * exp_fac(:) + rate(:,440) = 6.5e-13_r8 * exp_fac(:) + rate(:,441) = 2.1e-13_r8 * exp_fac(:) + rate(:,442) = 6.5e-13_r8 * exp_fac(:) + rate(:,443) = 4.9e-13_r8 * exp_fac(:) + rate(:,445) = 1.2e-12_r8 * exp_fac(:) + rate(:,449) = 9.8e-13_r8 * exp_fac(:) + rate(:,452) = 1.85e-11_r8 * exp_fac(:) + rate(:,453) = 1.63e-12_r8 * exp_fac(:) + rate(:,454) = 2.5e-11_r8 * exp_fac(:) + rate(:,455) = 1.1e-11_r8 * exp_fac(:) + rate(:,456) = 3.3e-11_r8 * exp_fac(:) + rate(:,459) = 2.8e-17_r8 * exp_fac(:) + rate(:,460) = 8e-11_r8 * exp_fac(:) + rate(:,463) = 3e-11_r8 * exp_fac(:) + rate(:,466) = 4.2e-11_r8 * exp_fac(:) + rate(:,469) = 2.8e-17_r8 * exp_fac(:) + rate(:,470) = 1.1e-10_r8 * exp_fac(:) + rate(:,472) = 3.9e-11_r8 * exp_fac(:) + rate(:,475) = 1.3e-12_r8 * exp_fac(:) + rate(:,477) = 5e-12_r8 * exp_fac(:) + rate(:,478) = 2.3e-12_r8 * exp_fac(:) + rate(:,481) = 3.9e-11_r8 * exp_fac(:) + rate(:,484) = 2.8e-17_r8 * exp_fac(:) + rate(:,485) = 9.2e-11_r8 * exp_fac(:) + rate(:,488) = 3.85e-11_r8 * exp_fac(:) + rate(:,492) = 1.2e-12_r8 * exp_fac(:) + rate(:,496) = 9.8e-13_r8 * exp_fac(:) + rate(:,501) = 4.4e-18_r8 * exp_fac(:) + rate(:,502) = 3.6e-11_r8 * exp_fac(:) + rate(:,554) = 4.7e-11_r8 * exp_fac(:) + rate(:,567) = 2.1e-12_r8 * exp_fac(:) + rate(:,568) = 2.8e-13_r8 * exp_fac(:) + rate(:,576) = 1.7e-11_r8 * exp_fac(:) + rate(:,582) = 8.4e-11_r8 * exp_fac(:) + rate(:,585) = 5.3e-13_r8 * exp_fac(:) + rate(:,587) = 2e-12_r8 * exp_fac(:) + rate(:,590) = 2.3e-12_r8 * exp_fac(:) + rate(:,595) = 2e-12_r8 * exp_fac(:) + rate(:,598) = 2.3e-12_r8 * exp_fac(:) + rate(:,604) = 1.9e-11_r8 * exp_fac(:) + rate(:,605) = 5.3e-13_r8 * exp_fac(:) + rate(:,607) = 2e-12_r8 * exp_fac(:) + rate(:,610) = 2.3e-12_r8 * exp_fac(:) + rate(:,615) = 2e-12_r8 * exp_fac(:) + rate(:,618) = 2.3e-12_r8 * exp_fac(:) + rate(:,622) = 1.2e-14_r8 * exp_fac(:) + rate(:,623) = 2e-10_r8 * exp_fac(:) + rate(:,624) = 2.5e-12_r8 * exp_fac(:) + rate(:,625) = 5.3e-13_r8 * exp_fac(:) + rate(:,627) = 2e-12_r8 * exp_fac(:) + rate(:,630) = 2.3e-12_r8 * exp_fac(:) + rate(:,635) = 2e-12_r8 * exp_fac(:) + rate(:,638) = 2.3e-12_r8 * exp_fac(:) + rate(:,644) = 1.2e-11_r8 * exp_fac(:) + rate(:,646) = 2e-12_r8 * exp_fac(:) + rate(:,648) = 5.3e-13_r8 * exp_fac(:) + rate(:,650) = 2.3e-12_r8 * exp_fac(:) + rate(:,655) = 2e-12_r8 * exp_fac(:) + rate(:,658) = 2.3e-12_r8 * exp_fac(:) + rate(:,664) = 1.1e-11_r8 * exp_fac(:) + rate(:,666) = 2e-12_r8 * exp_fac(:) + rate(:,668) = 5.3e-13_r8 * exp_fac(:) + rate(:,670) = 2.3e-12_r8 * exp_fac(:) + rate(:,675) = 2e-12_r8 * exp_fac(:) + rate(:,678) = 2.3e-12_r8 * exp_fac(:) + rate(:,683) = 2.1e-10_r8 * exp_fac(:) + rate(:,689) = 8.9e-11_r8 * exp_fac(:) + rate(:,690) = 8.9e-11_r8 * exp_fac(:) + rate(:,694) = 2e-12_r8 * exp_fac(:) + rate(:,697) = 2.3e-12_r8 * exp_fac(:) + rate(:,705) = 4e-12_r8 * exp_fac(:) + rate(:,708) = 2e-14_r8 * exp_fac(:) + rate(:,710) = 2e-12_r8 * exp_fac(:) + rate(:,713) = 2.3e-12_r8 * exp_fac(:) + rate(:,718) = 2.52e-11_r8 * exp_fac(:) + rate(:,723) = 4e-12_r8 * exp_fac(:) + rate(:,727) = 2e-14_r8 * exp_fac(:) + rate(:,729) = 2e-12_r8 * exp_fac(:) + rate(:,732) = 2.3e-12_r8 * exp_fac(:) + rate(:,737) = 1.92e-11_r8 * exp_fac(:) + rate(:,739) = 2e-12_r8 * exp_fac(:) + rate(:,742) = 2.3e-12_r8 * exp_fac(:) + rate(:,746) = 8.8e-12_r8 * exp_fac(:) + rate(:,747) = 8.8e-12_r8 * exp_fac(:) + rate(:,748) = 8.8e-12_r8 * exp_fac(:) + rate(:,753) = 4e-12_r8 * exp_fac(:) + rate(:,755) = 2e-14_r8 * exp_fac(:) + rate(:,757) = 3.66e-12_r8 * exp_fac(:) + rate(:,758) = 2.8e-11_r8 * exp_fac(:) + rate(:,759) = 2.6e-13_r8 * exp_fac(:) + rate(:,762) = 8.3e-18_r8 * exp_fac(:) + rate(:,763) = 1.1e-10_r8 * exp_fac(:) + rate(:,767) = 1.1e-16_r8 * exp_fac(:) + rate(:,769) = 3.64e-12_r8 * exp_fac(:) + rate(:,770) = 2.8e-11_r8 * exp_fac(:) + rate(:,771) = 1.7e-11_r8 * exp_fac(:) + rate(:,774) = 1.1e-10_r8 * exp_fac(:) + rate(:,775) = 9.58e-12_r8 * exp_fac(:) + rate(:,778) = 1.1e-10_r8 * exp_fac(:) + rate(:,779) = 1.23e-11_r8 * exp_fac(:) + rate(:,782) = 1.1e-10_r8 * exp_fac(:) + rate(:,783) = 3.64e-12_r8 * exp_fac(:) + rate(:,786) = 1.1e-10_r8 * exp_fac(:) + rate(:,787) = 5.5e-12_r8 * exp_fac(:) + rate(:,788) = 4.65e-11_r8 * exp_fac(:) + rate(:,789) = 2.8e-11_r8 * exp_fac(:) + rate(:,797) = 2.3e-12_r8 * exp_fac(:) + rate(:,799) = 1.2e-11_r8 * exp_fac(:) + rate(:,800) = 5.7e-11_r8 * exp_fac(:) + rate(:,801) = 2.8e-11_r8 * exp_fac(:) + rate(:,802) = 6.6e-11_r8 * exp_fac(:) + rate(:,803) = 1.4e-11_r8 * exp_fac(:) + rate(:,806) = 1.9e-12_r8 * exp_fac(:) + rate(:,829) = 6.34e-08_r8 * exp_fac(:) + rate(:,846) = 1.9e-11_r8 * exp_fac(:) + rate(:,849) = 1.2e-14_r8 * exp_fac(:) + rate(:,850) = 2e-10_r8 * exp_fac(:) + rate(:,854) = 2.5e-12_r8 * exp_fac(:) + rate(:,866) = 1.34e-11_r8 * exp_fac(:) + rate(:,867) = 1.2e-11_r8 * exp_fac(:) + rate(:,872) = 1.1e-11_r8 * exp_fac(:) + rate(:,876) = 2.1e-10_r8 * exp_fac(:) + rate(:,877) = 1.34e-11_r8 * exp_fac(:) + rate(:,881) = 1.7e-11_r8 * exp_fac(:) + rate(:,901) = 1.29e-07_r8 * exp_fac(:) + rate(:,902) = 2.31e-07_r8 * exp_fac(:) + rate(:,903) = 2.31e-06_r8 * exp_fac(:) + rate(:,904) = 4.63e-07_r8 * exp_fac(:) + rate(:,278) = 6e-12_r8 * exp( 400._r8 * itemp(:) ) + rate(:,283) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,284) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + exp_fac(:) = exp( -1520._r8 * itemp(:) ) + rate(:,285) = 1.64e-12_r8 * exp_fac(:) + rate(:,403) = 8.5e-16_r8 * exp_fac(:) + exp_fac(:) = exp( -1100._r8 * itemp(:) ) + rate(:,286) = 2.03e-11_r8 * exp_fac(:) + rate(:,805) = 3.4e-12_r8 * exp_fac(:) + rate(:,287) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,288) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,289) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,290) = 1.25e-12_r8 * exp_fac(:) + rate(:,300) = 3.4e-11_r8 * exp_fac(:) + rate(:,291) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,292) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,298) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) + rate(:,299) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,302) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) + rate(:,303) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) + rate(:,304) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + exp_fac(:) = exp( 300._r8 * itemp(:) ) + rate(:,305) = 2.8e-12_r8 * exp_fac(:) + rate(:,370) = 2.9e-12_r8 * exp_fac(:) + rate(:,306) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) + rate(:,308) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + exp_fac(:) = exp( 500._r8 * itemp(:) ) + rate(:,311) = 1.3e-12_r8 * exp_fac(:) + rate(:,335) = 2.9e-12_r8 * exp_fac(:) + rate(:,336) = 2e-12_r8 * exp_fac(:) + rate(:,368) = 7.1e-13_r8 * exp_fac(:) + rate(:,381) = 2e-12_r8 * exp_fac(:) + rate(:,388) = 2.9e-12_r8 * exp_fac(:) + rate(:,389) = 2e-12_r8 * exp_fac(:) + rate(:,391) = 2.9e-12_r8 * exp_fac(:) + rate(:,400) = 2e-12_r8 * exp_fac(:) + rate(:,424) = 2e-12_r8 * exp_fac(:) + rate(:,430) = 2e-12_r8 * exp_fac(:) + rate(:,444) = 2e-12_r8 * exp_fac(:) + rate(:,448) = 2e-12_r8 * exp_fac(:) + rate(:,474) = 2e-12_r8 * exp_fac(:) + rate(:,491) = 2e-12_r8 * exp_fac(:) + rate(:,495) = 2e-12_r8 * exp_fac(:) + rate(:,586) = 2e-12_r8 * exp_fac(:) + rate(:,591) = 2e-12_r8 * exp_fac(:) + rate(:,592) = 2e-12_r8 * exp_fac(:) + rate(:,593) = 2e-12_r8 * exp_fac(:) + rate(:,594) = 2e-12_r8 * exp_fac(:) + rate(:,599) = 2e-12_r8 * exp_fac(:) + rate(:,600) = 2e-12_r8 * exp_fac(:) + rate(:,601) = 2e-12_r8 * exp_fac(:) + rate(:,606) = 2e-12_r8 * exp_fac(:) + rate(:,611) = 2e-12_r8 * exp_fac(:) + rate(:,612) = 2e-12_r8 * exp_fac(:) + rate(:,613) = 2e-12_r8 * exp_fac(:) + rate(:,614) = 2e-12_r8 * exp_fac(:) + rate(:,619) = 2e-12_r8 * exp_fac(:) + rate(:,620) = 2e-12_r8 * exp_fac(:) + rate(:,621) = 2e-12_r8 * exp_fac(:) + rate(:,626) = 2e-12_r8 * exp_fac(:) + rate(:,631) = 2e-12_r8 * exp_fac(:) + rate(:,632) = 2e-12_r8 * exp_fac(:) + rate(:,633) = 2e-12_r8 * exp_fac(:) + rate(:,634) = 2e-12_r8 * exp_fac(:) + rate(:,639) = 2e-12_r8 * exp_fac(:) + rate(:,640) = 2e-12_r8 * exp_fac(:) + rate(:,641) = 2e-12_r8 * exp_fac(:) + rate(:,645) = 2e-12_r8 * exp_fac(:) + rate(:,651) = 2e-12_r8 * exp_fac(:) + rate(:,652) = 2e-12_r8 * exp_fac(:) + rate(:,653) = 2e-12_r8 * exp_fac(:) + rate(:,654) = 2e-12_r8 * exp_fac(:) + rate(:,659) = 2e-12_r8 * exp_fac(:) + rate(:,660) = 2e-12_r8 * exp_fac(:) + rate(:,661) = 2e-12_r8 * exp_fac(:) + rate(:,665) = 2e-12_r8 * exp_fac(:) + rate(:,671) = 2e-12_r8 * exp_fac(:) + rate(:,672) = 2e-12_r8 * exp_fac(:) + rate(:,673) = 2e-12_r8 * exp_fac(:) + rate(:,674) = 2e-12_r8 * exp_fac(:) + rate(:,679) = 2e-12_r8 * exp_fac(:) + rate(:,680) = 2e-12_r8 * exp_fac(:) + rate(:,681) = 2e-12_r8 * exp_fac(:) + rate(:,693) = 2e-12_r8 * exp_fac(:) + rate(:,698) = 2e-12_r8 * exp_fac(:) + rate(:,699) = 2e-12_r8 * exp_fac(:) + rate(:,700) = 2e-12_r8 * exp_fac(:) + rate(:,701) = 2.9e-12_r8 * exp_fac(:) + rate(:,702) = 2e-12_r8 * exp_fac(:) + rate(:,706) = 2.9e-12_r8 * exp_fac(:) + rate(:,707) = 2.9e-12_r8 * exp_fac(:) + rate(:,709) = 2e-12_r8 * exp_fac(:) + rate(:,714) = 2e-12_r8 * exp_fac(:) + rate(:,715) = 2e-12_r8 * exp_fac(:) + rate(:,716) = 2e-12_r8 * exp_fac(:) + rate(:,719) = 2.9e-12_r8 * exp_fac(:) + rate(:,720) = 2e-12_r8 * exp_fac(:) + rate(:,724) = 2.9e-12_r8 * exp_fac(:) + rate(:,725) = 2.9e-12_r8 * exp_fac(:) + rate(:,726) = 2.9e-12_r8 * exp_fac(:) + rate(:,728) = 2e-12_r8 * exp_fac(:) + rate(:,733) = 2e-12_r8 * exp_fac(:) + rate(:,734) = 2e-12_r8 * exp_fac(:) + rate(:,735) = 2e-12_r8 * exp_fac(:) + rate(:,738) = 2e-12_r8 * exp_fac(:) + rate(:,743) = 2e-12_r8 * exp_fac(:) + rate(:,744) = 2e-12_r8 * exp_fac(:) + rate(:,745) = 2e-12_r8 * exp_fac(:) + rate(:,749) = 2.9e-12_r8 * exp_fac(:) + rate(:,750) = 2e-12_r8 * exp_fac(:) + rate(:,754) = 2.9e-12_r8 * exp_fac(:) + rate(:,312) = 5.6e-15_r8 * exp( 2300._r8 * itemp(:) ) + rate(:,313) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) + rate(:,314) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) + rate(:,318) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) + rate(:,323) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + exp_fac(:) = exp( 700._r8 * itemp(:) ) + rate(:,326) = 7.5e-13_r8 * exp_fac(:) + rate(:,341) = 7.5e-13_r8 * exp_fac(:) + rate(:,356) = 7.5e-13_r8 * exp_fac(:) + rate(:,365) = 7.5e-13_r8 * exp_fac(:) + rate(:,369) = 8.6e-13_r8 * exp_fac(:) + rate(:,394) = 7.5e-13_r8 * exp_fac(:) + rate(:,409) = 7.5e-13_r8 * exp_fac(:) + rate(:,544) = 7.5e-13_r8 * exp_fac(:) + rate(:,548) = 7.5e-13_r8 * exp_fac(:) + rate(:,551) = 7.5e-13_r8 * exp_fac(:) + rate(:,564) = 7.5e-13_r8 * exp_fac(:) + rate(:,571) = 7.5e-13_r8 * exp_fac(:) + rate(:,577) = 7.5e-13_r8 * exp_fac(:) + rate(:,580) = 7.5e-13_r8 * exp_fac(:) + rate(:,852) = 7.5e-13_r8 * exp_fac(:) + rate(:,864) = 7.5e-13_r8 * exp_fac(:) + rate(:,879) = 7.5e-13_r8 * exp_fac(:) + rate(:,882) = 7.5e-13_r8 * exp_fac(:) + exp_fac(:) = exp( 365._r8 * itemp(:) ) + rate(:,327) = 2.6e-12_r8 * exp_fac(:) + rate(:,545) = 2.6e-12_r8 * exp_fac(:) + rate(:,550) = 2.6e-12_r8 * exp_fac(:) + rate(:,552) = 2.6e-12_r8 * exp_fac(:) + rate(:,565) = 2.6e-12_r8 * exp_fac(:) + rate(:,572) = 2.6e-12_r8 * exp_fac(:) + rate(:,578) = 2.6e-12_r8 * exp_fac(:) + rate(:,581) = 2.6e-12_r8 * exp_fac(:) + rate(:,853) = 2.6e-12_r8 * exp_fac(:) + rate(:,865) = 2.6e-12_r8 * exp_fac(:) + rate(:,880) = 2.6e-12_r8 * exp_fac(:) + rate(:,883) = 2.6e-12_r8 * exp_fac(:) + rate(:,328) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,330) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,331) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + exp_fac(:) = exp( -1900._r8 * itemp(:) ) + rate(:,332) = 1.4e-12_r8 * exp_fac(:) + rate(:,354) = 6.5e-15_r8 * exp_fac(:) + rate(:,333) = 4.63e-12_r8 * exp( 350._r8 * itemp(:) ) + rate(:,334) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) + exp_fac(:) = exp( 1040._r8 * itemp(:) ) + rate(:,337) = 4.3e-13_r8 * exp_fac(:) + rate(:,390) = 4.3e-13_r8 * exp_fac(:) + rate(:,541) = 4.3e-13_r8 * exp_fac(:) + rate(:,555) = 4.3e-13_r8 * exp_fac(:) + rate(:,558) = 4.3e-13_r8 * exp_fac(:) + rate(:,561) = 4.3e-13_r8 * exp_fac(:) + rate(:,703) = 4.3e-13_r8 * exp_fac(:) + rate(:,721) = 4.3e-13_r8 * exp_fac(:) + rate(:,751) = 4.3e-13_r8 * exp_fac(:) + rate(:,339) = 3.15e-14_r8 * exp( 920._r8 * itemp(:) ) + rate(:,343) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,353) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,355) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,359) = 9.19e-12_r8 * exp( -630._r8 * itemp(:) ) + rate(:,360) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) + rate(:,361) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + rate(:,377) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) + rate(:,378) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) + exp_fac(:) = exp( 1300._r8 * itemp(:) ) + rate(:,383) = 2.11e-13_r8 * exp_fac(:) + rate(:,402) = 2.11e-13_r8 * exp_fac(:) + rate(:,421) = 2.38e-13_r8 * exp_fac(:) + rate(:,426) = 2.12e-13_r8 * exp_fac(:) + rate(:,432) = 2.12e-13_r8 * exp_fac(:) + rate(:,446) = 2.12e-13_r8 * exp_fac(:) + rate(:,450) = 2.12e-13_r8 * exp_fac(:) + rate(:,457) = 2.6e-13_r8 * exp_fac(:) + rate(:,461) = 2.6e-13_r8 * exp_fac(:) + rate(:,464) = 2.6e-13_r8 * exp_fac(:) + rate(:,467) = 2.6e-13_r8 * exp_fac(:) + rate(:,471) = 2.6e-13_r8 * exp_fac(:) + rate(:,476) = 2.47e-13_r8 * exp_fac(:) + rate(:,479) = 2.64e-13_r8 * exp_fac(:) + rate(:,482) = 2.64e-13_r8 * exp_fac(:) + rate(:,493) = 2.12e-13_r8 * exp_fac(:) + rate(:,497) = 2.12e-13_r8 * exp_fac(:) + rate(:,499) = 2.6e-13_r8 * exp_fac(:) + rate(:,588) = 2.71e-13_r8 * exp_fac(:) + rate(:,596) = 2.6e-13_r8 * exp_fac(:) + rate(:,608) = 2.78e-13_r8 * exp_fac(:) + rate(:,616) = 2.75e-13_r8 * exp_fac(:) + rate(:,628) = 2.71e-13_r8 * exp_fac(:) + rate(:,636) = 2.6e-13_r8 * exp_fac(:) + rate(:,647) = 2.71e-13_r8 * exp_fac(:) + rate(:,656) = 2.6e-13_r8 * exp_fac(:) + rate(:,667) = 2.71e-13_r8 * exp_fac(:) + rate(:,676) = 2.6e-13_r8 * exp_fac(:) + rate(:,687) = 2.71e-13_r8 * exp_fac(:) + rate(:,691) = 2.71e-13_r8 * exp_fac(:) + rate(:,695) = 2.54e-13_r8 * exp_fac(:) + rate(:,711) = 2.62e-13_r8 * exp_fac(:) + rate(:,730) = 2.66e-13_r8 * exp_fac(:) + rate(:,740) = 2.51e-13_r8 * exp_fac(:) + rate(:,760) = 2.68e-13_r8 * exp_fac(:) + rate(:,765) = 2.47e-13_r8 * exp_fac(:) + rate(:,772) = 2.76e-13_r8 * exp_fac(:) + rate(:,776) = 2.76e-13_r8 * exp_fac(:) + rate(:,780) = 2.75e-13_r8 * exp_fac(:) + rate(:,784) = 2.75e-13_r8 * exp_fac(:) + rate(:,842) = 2.6e-13_r8 * exp_fac(:) + rate(:,847) = 2.75e-13_r8 * exp_fac(:) + rate(:,855) = 2.6e-13_r8 * exp_fac(:) + rate(:,860) = 2.12e-13_r8 * exp_fac(:) + rate(:,868) = 2.6e-13_r8 * exp_fac(:) + rate(:,873) = 2.6e-13_r8 * exp_fac(:) + rate(:,384) = 2.9e+07_r8 * exp( -5297._r8 * itemp(:) ) + rate(:,385) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) + exp_fac(:) = exp( 360._r8 * itemp(:) ) + rate(:,386) = 9.6e-12_r8 * exp_fac(:) + rate(:,589) = 2.7e-12_r8 * exp_fac(:) + rate(:,597) = 2.7e-12_r8 * exp_fac(:) + rate(:,609) = 2.7e-12_r8 * exp_fac(:) + rate(:,617) = 2.7e-12_r8 * exp_fac(:) + rate(:,629) = 2.7e-12_r8 * exp_fac(:) + rate(:,637) = 2.7e-12_r8 * exp_fac(:) + rate(:,649) = 2.7e-12_r8 * exp_fac(:) + rate(:,657) = 2.7e-12_r8 * exp_fac(:) + rate(:,669) = 2.7e-12_r8 * exp_fac(:) + rate(:,677) = 2.7e-12_r8 * exp_fac(:) + rate(:,688) = 2.7e-12_r8 * exp_fac(:) + rate(:,692) = 2.7e-12_r8 * exp_fac(:) + rate(:,696) = 2.7e-12_r8 * exp_fac(:) + rate(:,712) = 2.7e-12_r8 * exp_fac(:) + rate(:,731) = 2.7e-12_r8 * exp_fac(:) + rate(:,741) = 2.7e-12_r8 * exp_fac(:) + rate(:,761) = 2.7e-12_r8 * exp_fac(:) + rate(:,766) = 2.7e-12_r8 * exp_fac(:) + rate(:,773) = 2.7e-12_r8 * exp_fac(:) + rate(:,777) = 2.7e-12_r8 * exp_fac(:) + rate(:,781) = 2.7e-12_r8 * exp_fac(:) + rate(:,785) = 2.7e-12_r8 * exp_fac(:) + rate(:,843) = 2.7e-12_r8 * exp_fac(:) + rate(:,848) = 2.7e-12_r8 * exp_fac(:) + rate(:,856) = 2.7e-12_r8 * exp_fac(:) + rate(:,861) = 2.7e-12_r8 * exp_fac(:) + rate(:,869) = 2.7e-12_r8 * exp_fac(:) + rate(:,874) = 2.7e-12_r8 * exp_fac(:) + rate(:,396) = 2.3e-12_r8 * exp( -170._r8 * itemp(:) ) + rate(:,404) = 2.7e-12_r8 * exp( 580._r8 * itemp(:) ) + rate(:,411) = 5.4e-14_r8 * exp( 870._r8 * itemp(:) ) + exp_fac(:) = exp( 450._r8 * itemp(:) ) + rate(:,414) = 1.17e-11_r8 * exp_fac(:) + rate(:,415) = 1.17e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 390._r8 * itemp(:) ) + rate(:,416) = 2.2e-11_r8 * exp_fac(:) + rate(:,417) = 3.5e-11_r8 * exp_fac(:) + rate(:,487) = 2.7e-11_r8 * exp_fac(:) + rate(:,490) = 2.08e-11_r8 * exp_fac(:) + rate(:,768) = 2.7e-11_r8 * exp_fac(:) + rate(:,863) = 2.7e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 410._r8 * itemp(:) ) + rate(:,419) = 9.85e-12_r8 * exp_fac(:) + rate(:,603) = 1.34e-11_r8 * exp_fac(:) + rate(:,845) = 1.34e-11_r8 * exp_fac(:) + exp_fac(:) = exp( -400._r8 * itemp(:) ) + rate(:,420) = 4.43e-11_r8 * exp_fac(:) + rate(:,422) = 4.43e-11_r8 * exp_fac(:) + rate(:,423) = 3.22e-11_r8 * exp_fac(:) + rate(:,427) = 1.04e+11_r8 * exp( -9746._r8 * itemp(:) ) + rate(:,428) = 2.24e+15_r8 * exp( -10865._r8 * itemp(:) ) + rate(:,429) = 2.22e+15_r8 * exp( -10355._r8 * itemp(:) ) + rate(:,433) = 1.88e+11_r8 * exp( -9752._r8 * itemp(:) ) + rate(:,434) = 2.49e+15_r8 * exp( -11112._r8 * itemp(:) ) + rate(:,435) = 2.49e+15_r8 * exp( -10890._r8 * itemp(:) ) + rate(:,447) = 1.83e+14_r8 * exp( -8930._r8 * itemp(:) ) + rate(:,451) = 2.08e+14_r8 * exp( -9400._r8 * itemp(:) ) + exp_fac(:) = exp( -10000._r8 * itemp(:) ) + rate(:,458) = 1.256e+13_r8 * exp_fac(:) + rate(:,462) = 1.875e+13_r8 * exp_fac(:) + rate(:,465) = 1.875e+13_r8 * exp_fac(:) + rate(:,468) = 5.092e+12_r8 * exp_fac(:) + rate(:,480) = 8.72e+12_r8 * exp_fac(:) + rate(:,483) = 6.55e+12_r8 * exp_fac(:) + exp_fac(:) = exp( -450._r8 * itemp(:) ) + rate(:,473) = 2.95e-12_r8 * exp_fac(:) + rate(:,764) = 2.95e-12_r8 * exp_fac(:) + rate(:,859) = 2.95e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1995._r8 * itemp(:) ) + rate(:,486) = 1.03e-14_r8 * exp_fac(:) + rate(:,862) = 1.03e-14_r8 * exp_fac(:) + rate(:,494) = 1.79e+14_r8 * exp( -8830._r8 * itemp(:) ) + rate(:,498) = 1.75e+14_r8 * exp( -9054._r8 * itemp(:) ) + rate(:,500) = 1e+07_r8 * exp( -5000._r8 * itemp(:) ) + exp_fac(:) = exp( -193._r8 * itemp(:) ) + rate(:,543) = 2.3e-12_r8 * exp_fac(:) + rate(:,851) = 2.3e-12_r8 * exp_fac(:) + rate(:,547) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) + rate(:,566) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) + exp_fac(:) = exp( 352._r8 * itemp(:) ) + rate(:,574) = 1.7e-12_r8 * exp_fac(:) + rate(:,878) = 1.7e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 490._r8 * itemp(:) ) + rate(:,584) = 1.2e-12_r8 * exp_fac(:) + rate(:,841) = 1.2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -640._r8 * itemp(:) ) + rate(:,602) = 8.05e-16_r8 * exp_fac(:) + rate(:,844) = 8.05e-16_r8 * exp_fac(:) + exp_fac(:) = exp( -770._r8 * itemp(:) ) + rate(:,662) = 2.8e-15_r8 * exp_fac(:) + rate(:,870) = 2.8e-15_r8 * exp_fac(:) + exp_fac(:) = exp( 470._r8 * itemp(:) ) + rate(:,663) = 3.41e-11_r8 * exp_fac(:) + rate(:,871) = 3.41e-11_r8 * exp_fac(:) + exp_fac(:) = exp( -520._r8 * itemp(:) ) + rate(:,682) = 2.65e-15_r8 * exp_fac(:) + rate(:,875) = 2.65e-15_r8 * exp_fac(:) + exp_fac(:) = exp( 600._r8 * itemp(:) ) + rate(:,717) = 5.2e-12_r8 * exp_fac(:) + rate(:,736) = 5.2e-12_r8 * exp_fac(:) + rate(:,756) = 5.2e-12_r8 * exp_fac(:) + rate(:,793) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,794) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,795) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,796) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,804) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,807) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) + rate(:,810) = 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(:,181), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,191), 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(:,201), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,209), 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(:,212), 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(:,213), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,214), 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(:,232), 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(:,252), 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(:,263), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.1e-33_r8 * itemp(:)**1.5_r8 + kinf(:) = 9.8e-15_r8 * itemp(:)**(-4.6_r8) + call jpl( rate(:,309), m, 0.8_r8, ko, kinf, n ) + + ko(:) = 5.2e-30_r8 * itemp(:)**2.4_r8 + kinf(:) = 2.2e-10_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,320), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.5e-30_r8 + kinf(:) = 8.3e-13_r8 * itemp(:)**(-2._r8) + call jpl( rate(:,321), 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(:,322), 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(:,350), 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(:,351), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,372), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,398), 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(:,406), m, 0.6_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(:,557), m, 0.6_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(:,560), m, 0.6_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(:,563), m, 0.6_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(:,570), m, 0.6_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(:,684), m, 0.6_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(:,685), m, 0.6_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(:,686), 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(:,798), 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,178) = 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,170) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:n,173) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,182) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,183) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,184) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,187) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,188) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,189) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,194) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,198) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:n,199) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,207) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) + rate(:n,208) = 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,181) = wrk(:) + + + + + + + + + + + + + + + + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_trop_strat_mam5_ts2/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_mam5_ts2/mo_sim_dat.F90 new file mode 100644 index 0000000000..b21ade74da --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts2/mo_sim_dat.F90 @@ -0,0 +1,1193 @@ + + 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, 317, 0 /) + + cls_rxt_cnt(:,1) = (/ 6, 0, 0, 2 /) + cls_rxt_cnt(:,4) = (/ 2, 255, 647, 317 /) + + solsym(:319) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','APIN ','bc_a1 ', & + 'bc_a4 ','BCARY ','BENZENE ','BENZOOH ','BEPOMUC ', & + 'BIGALD1 ','BIGALD2 ','BIGALD3 ','BIGALD4 ','BIGALK ', & + 'BIGENE ','BPIN ','BR ','BRCL ','BRO ', & + 'BRONO2 ','BRY ','BZALD ','BZOOH ','C2H2 ', & + 'C2H4 ','C2H5OH ','C2H5OOH ','C2H6 ','C3H6 ', & + 'C3H7OOH ','C3H8 ','C6H5OOH ','CCL4 ','CF2CLBR ', & + 'CF3BR ','CFC11 ','CFC113 ','CFC114 ','CFC115 ', & + 'CFC12 ','CH2BR2 ','CH2O ','CH3BR ','CH3CCL3 ', & + 'CH3CHO ','CH3CL ','CH3CN ','CH3COCH3 ','CH3COCHO ', & + 'CH3COOH ','CH3COOOH ','CH3OH ','CH3OOH ','CH4 ', & + 'CHBR3 ','CL ','CL2 ','CL2O2 ','CLO ', & + 'CLONO2 ','CLY ','CO ','CO2 ','COF2 ', & + 'COFCL ','CRESOL ','DHPMPAL ','DMS ','dst_a1 ', & + 'dst_a2 ','dst_a3 ','E90 ','EOOH ','F ', & + 'GLYALD ','GLYOXAL ','H ','H2 ','H2402 ', & + 'H2O2 ','H2SO4 ','HBR ','HCFC141B ','HCFC142B ', & + 'HCFC22 ','HCL ','HCN ','HCOCH2OOH ','HCOOH ', & + 'HF ','HMHP ','HNO3 ','HO2NO2 ','HOBR ', & + 'HOCL ','HONITR ','HPALD1 ','HPALD4 ','HPALDB1C ', & + 'HPALDB4C ','HYAC ','HYDRALD ','HYPERACET ','ICHE ', & + 'IEPOX ','INHEB ','INHED ','ISOP ','ISOPFDN ', & + 'ISOPFDNC ','ISOPFNC ','ISOPFNP ','ISOPHFP ','ISOPN1D ', & + 'ISOPN2B ','ISOPN3B ','ISOPN4D ','ISOPNBNO3 ','ISOPNOOHB ', & + 'ISOPNOOHD ','ISOPOH ','ISOPOOH ','IVOC ','LIMON ', & + 'MACR ','MACRN ','MACROOH ','MEK ','MEKOOH ', & + 'MPAN ','MVK ','MVKN ','MVKOOH ','MYRC ', & + 'N ','N2O ','N2O5 ','NC4CHO ','ncl_a1 ', & + 'ncl_a2 ','ncl_a3 ','NH3 ','NH4 ','NH_5 ', & + 'NH_50 ','NO ','NO2 ','NO3 ','NO3CH2CHO ', & + 'NOA ','num_a1 ','num_a2 ','num_a3 ','num_a4 ', & + 'num_a5 ','O ','O3 ','O3S ','OCLO ', & + 'OCS ','ONITR ','PAN ','PBZNIT ','PHENO ', & + 'PHENOL ','PHENOOH ','pom_a1 ','pom_a4 ','POOH ', & + 'ROOH ','S ','SF6 ','SO ','SO2 ', & + 'SO3 ','so4_a1 ','so4_a2 ','so4_a3 ','so4_a5 ', & + 'soa1_a1 ','soa1_a2 ','soa2_a1 ','soa2_a2 ','soa3_a1 ', & + 'soa3_a2 ','soa4_a1 ','soa4_a2 ','soa5_a1 ','soa5_a2 ', & + 'SOAG0 ','SOAG1 ','SOAG2 ','SOAG3 ','SOAG4 ', & + 'SQTN ','ST80_25 ','SVOC ','TEPOMUC ','TERP1OOH ', & + 'TERP2AOOH ','TERPA ','TERPA2 ','TERPA2PAN ','TERPA3 ', & + 'TERPA3PAN ','TERPACID ','TERPACID2 ','TERPACID3 ','TERPAPAN ', & + 'TERPDHDP ','TERPF1 ','TERPF2 ','TERPFDN ','TERPHFN ', & + 'TERPK ','TERPNPS ','TERPNPS1 ','TERPNPT ','TERPNPT1 ', & + 'TERPNS ','TERPNS1 ','TERPNT ','TERPNT1 ','TERPOOH ', & + 'TERPOOHL ','TOLOOH ','TOLUENE ','XYLENES ','XYLENOOH ', & + 'XYLOL ','XYLOLOOH ','NHDEP ','NDEP ','ACBZO2 ', & + 'ALKO2 ','APINNO3 ','APINO2 ','APINO2VBS ','BCARYNO3 ', & + 'BCARYO2 ','BCARYO2VBS ','BENZO2 ','BENZO2VBS ','BPINNO3 ', & + 'BPINO2 ','BPINO2VBS ','BZOO ','C2H5O2 ','C3H7O2 ', & + 'C6H5O2 ','CH3CO3 ','CH3O2 ','DICARBO2 ','ENEO2 ', & + 'EO ','EO2 ','HO2 ','HOCH2OO ','IEPOXOO ', & + 'ISOPB1O2 ','ISOPB4O2 ','ISOPC1C ','ISOPC1T ','ISOPC4C ', & + 'ISOPC4T ','ISOPED1O2 ','ISOPED4O2 ','ISOPN1DO2 ','ISOPN2BO2 ', & + 'ISOPN3BO2 ','ISOPN4DO2 ','ISOPNBNO3O2 ','ISOPNO3 ','ISOPNOOHBO2 ', & + 'ISOPNOOHDO2 ','ISOPO2VBS ','ISOPZD1O2 ','ISOPZD4O2 ','IVOCO2VBS ', & + 'LIMONNO3 ','LIMONO2 ','LIMONO2VBS ','MACRO2 ','MALO2 ', & + 'MCO3 ','MDIALO2 ','MEKO2 ','MVKO2 ','MYRCNO3 ', & + 'MYRCO2 ','MYRCO2VBS ','NC4CHOO2 ','O1D ','OH ', & + 'PHENO2 ','PO2 ','RO2 ','TERP1OOHO2 ','TERP2OOHO2 ', & + 'TERPA1O2 ','TERPA2CO3 ','TERPA2O2 ','TERPA3CO3 ','TERPA3O2 ', & + 'TERPA4O2 ','TERPACO3 ','TERPF1O2 ','TERPF2O2 ','TERPNPS1O2 ', & + 'TERPNPT1O2 ','TERPNS1O2 ','TERPNT1O2 ','TOLO2 ','TOLUO2VBS ', & + 'XYLENO2 ','XYLEO2VBS ','XYLOLO2 ','H2O ' /) + + adv_mass(:319) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 136.228400_r8, 12.011000_r8, & + 12.011000_r8, 204.342600_r8, 78.110400_r8, 160.122200_r8, 126.108600_r8, & + 84.072400_r8, 98.098200_r8, 98.098200_r8, 112.124000_r8, 72.143800_r8, & + 56.103200_r8, 136.228400_r8, 79.904000_r8, 115.356700_r8, 95.903400_r8, & + 141.908940_r8, 99.716850_r8, 106.120800_r8, 124.135000_r8, 26.036800_r8, & + 28.051600_r8, 46.065800_r8, 62.065200_r8, 30.066400_r8, 42.077400_r8, & + 76.091000_r8, 44.092200_r8, 110.109200_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, 41.050940_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, 66.007206_r8, & + 82.461503_r8, 108.135600_r8, 136.100200_r8, 62.132400_r8, 135.064039_r8, & + 135.064039_r8, 135.064039_r8, 28.010400_r8, 78.064600_r8, 18.998403_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, 27.025140_r8, 76.049800_r8, 46.024600_r8, & + 20.005803_r8, 64.038800_r8, 63.012340_r8, 79.011740_r8, 96.910800_r8, & + 52.459500_r8, 135.114940_r8, 116.112400_r8, 116.112400_r8, 116.112400_r8, & + 116.112400_r8, 74.076200_r8, 100.113000_r8, 90.075600_r8, 116.112400_r8, & + 118.127200_r8, 163.125340_r8, 163.125340_r8, 68.114200_r8, 226.137680_r8, & + 224.122880_r8, 195.124140_r8, 197.138940_r8, 150.126000_r8, 147.125940_r8, & + 147.125940_r8, 147.125940_r8, 147.125940_r8, 147.125940_r8, 163.125340_r8, & + 163.125340_r8, 102.127800_r8, 118.127200_r8, 184.350200_r8, 136.228400_r8, & + 70.087800_r8, 149.099540_r8, 120.100800_r8, 72.102600_r8, 104.101400_r8, & + 147.084740_r8, 70.087800_r8, 149.099540_r8, 120.100800_r8, 136.228400_r8, & + 14.006740_r8, 44.012880_r8, 108.010480_r8, 145.111140_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, 105.048540_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, 183.117740_r8, 93.102400_r8, & + 94.109800_r8, 176.121600_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, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 283.354340_r8, 28.010400_r8, 310.582400_r8, 140.134400_r8, 186.241400_r8, & + 186.241400_r8, 168.227200_r8, 154.201400_r8, 231.198340_r8, 170.200800_r8, & + 247.197740_r8, 200.226000_r8, 186.200200_r8, 202.199600_r8, 245.224140_r8, & + 236.254400_r8, 168.227200_r8, 110.150400_r8, 294.251880_r8, 265.253140_r8, & + 138.202000_r8, 231.239540_r8, 231.239540_r8, 231.239540_r8, 231.239540_r8, & + 215.240140_r8, 215.240140_r8, 215.240140_r8, 215.240140_r8, 186.241400_r8, & + 218.240200_r8, 174.148000_r8, 92.136200_r8, 106.162000_r8, 188.173800_r8, & + 122.161400_r8, 204.173200_r8, 14.006740_r8, 14.006740_r8, 137.112200_r8, & + 103.135200_r8, 230.232140_r8, 185.234000_r8, 185.234000_r8, 298.346340_r8, & + 253.348200_r8, 253.348200_r8, 159.114800_r8, 159.114800_r8, 230.232140_r8, & + 185.234000_r8, 185.234000_r8, 123.127600_r8, 61.057800_r8, 75.083600_r8, & + 109.101800_r8, 75.042400_r8, 47.032000_r8, 129.089600_r8, 105.108800_r8, & + 61.057800_r8, 77.057200_r8, 33.006200_r8, 63.031400_r8, 149.118600_r8, & + 117.119800_r8, 117.119800_r8, 85.121000_r8, 85.121000_r8, 85.121000_r8, & + 85.121000_r8, 117.119800_r8, 117.119800_r8, 196.131540_r8, 196.131540_r8, & + 196.131540_r8, 196.131540_r8, 196.131540_r8, 162.117940_r8, 212.130940_r8, & + 212.130940_r8, 117.119800_r8, 117.119800_r8, 117.119800_r8, 233.355800_r8, & + 230.232140_r8, 185.234000_r8, 185.234000_r8, 119.093400_r8, 115.063800_r8, & + 101.079200_r8, 117.078600_r8, 103.094000_r8, 119.093400_r8, 230.232140_r8, & + 185.234000_r8, 185.234000_r8, 194.116740_r8, 15.999400_r8, 17.006800_r8, & + 175.114200_r8, 91.083000_r8, 89.068200_r8, 235.247000_r8, 235.247000_r8, & + 171.208200_r8, 185.192800_r8, 187.207600_r8, 201.192200_r8, 203.207000_r8, & + 161.129600_r8, 199.218600_r8, 217.232800_r8, 159.156000_r8, 280.245140_r8, & + 280.245140_r8, 264.245740_r8, 264.245740_r8, 173.140600_r8, 173.140600_r8, & + 187.166400_r8, 187.166400_r8, 203.165800_r8, 18.014200_r8 /) + + crb_mass(:319) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 120.110000_r8, 12.011000_r8, & + 12.011000_r8, 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, & + 48.044000_r8, 60.055000_r8, 60.055000_r8, 72.066000_r8, 60.055000_r8, & + 48.044000_r8, 120.110000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 84.077000_r8, 84.077000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 36.033000_r8, & + 36.033000_r8, 36.033000_r8, 72.066000_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, 24.022000_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, 12.011000_r8, & + 12.011000_r8, 84.077000_r8, 48.044000_r8, 24.022000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_r8, 24.022000_r8, 0.000000_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, 12.011000_r8, 24.022000_r8, 12.011000_r8, & + 0.000000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 48.044000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 36.033000_r8, 60.055000_r8, 36.033000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 156.143000_r8, 120.110000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 120.110000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 60.055000_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, 24.022000_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, 84.077000_r8, 72.066000_r8, & + 72.066000_r8, 72.066000_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, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 12.011000_r8, 264.242000_r8, 84.077000_r8, 120.110000_r8, & + 120.110000_r8, 120.110000_r8, 108.099000_r8, 108.099000_r8, 108.099000_r8, & + 108.099000_r8, 120.110000_r8, 108.099000_r8, 108.099000_r8, 120.110000_r8, & + 120.110000_r8, 120.110000_r8, 84.077000_r8, 120.110000_r8, 120.110000_r8, & + 108.099000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, & + 120.110000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, & + 120.110000_r8, 84.077000_r8, 84.077000_r8, 96.088000_r8, 96.088000_r8, & + 96.088000_r8, 96.088000_r8, 0.000000_r8, 0.000000_r8, 84.077000_r8, & + 60.055000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 72.066000_r8, 72.066000_r8, 120.110000_r8, & + 120.110000_r8, 120.110000_r8, 84.077000_r8, 24.022000_r8, 36.033000_r8, & + 72.066000_r8, 24.022000_r8, 12.011000_r8, 60.055000_r8, 48.044000_r8, & + 24.022000_r8, 24.022000_r8, 0.000000_r8, 12.011000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 156.143000_r8, & + 120.110000_r8, 120.110000_r8, 120.110000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 120.110000_r8, & + 120.110000_r8, 120.110000_r8, 60.055000_r8, 0.000000_r8, 0.000000_r8, & + 72.066000_r8, 36.033000_r8, 36.033000_r8, 120.110000_r8, 120.110000_r8, & + 108.099000_r8, 108.099000_r8, 108.099000_r8, 108.099000_r8, 108.099000_r8, & + 72.066000_r8, 120.110000_r8, 120.110000_r8, 84.077000_r8, 120.110000_r8, & + 120.110000_r8, 120.110000_r8, 120.110000_r8, 84.077000_r8, 84.077000_r8, & + 96.088000_r8, 96.088000_r8, 96.088000_r8, 0.000000_r8 /) + + fix_mass(: 3) = (/ 0.00000000_r8, 31.9988000_r8, 28.0134800_r8 /) + + clsmap(: 2,1) = (/ 233, 234 /) + clsmap(:317,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, 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, 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 /) + + permute(:317,4) = (/ 168, 165, 1, 219, 2, 3, 199, 76, 124, 77, & + 132, 103, 121, 110, 81, 118, 202, 276, 88, 309, & + 146, 4, 89, 113, 105, 149, 99, 114, 106, 228, & + 123, 63, 100, 60, 71, 72, 64, 73, 65, 74, & + 66, 137, 306, 156, 67, 230, 120, 61, 280, 266, & + 173, 163, 238, 129, 279, 131, 315, 75, 58, 310, & + 223, 5, 271, 247, 90, 92, 84, 155, 104, 6, & + 7, 8, 9, 68, 217, 254, 235, 301, 251, 62, & + 237, 69, 208, 91, 93, 108, 304, 79, 182, 227, & + 107, 213, 302, 128, 195, 209, 193, 153, 154, 136, & + 140, 258, 263, 187, 185, 241, 138, 218, 229, 250, & + 204, 260, 234, 170, 272, 159, 150, 273, 166, 212, & + 245, 186, 264, 53, 201, 269, 259, 233, 145, 109, & + 141, 270, 265, 239, 177, 134, 80, 102, 274, 10, & + 11, 12, 59, 13, 14, 15, 303, 312, 311, 232, & + 236, 16, 17, 18, 19, 20, 305, 313, 21, 111, & + 119, 82, 147, 70, 135, 78, 112, 22, 23, 148, & + 122, 143, 24, 246, 216, 98, 25, 26, 27, 28, & + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, & + 39, 40, 41, 42, 43, 44, 45, 46, 85, 282, & + 133, 284, 220, 157, 255, 158, 171, 115, 116, 125, & + 117, 293, 292, 215, 192, 203, 194, 160, 207, 172, & + 244, 252, 242, 253, 161, 151, 167, 83, 86, 178, & + 87, 126, 144, 211, 281, 287, 47, 277, 286, 48, & + 139, 49, 290, 285, 50, 127, 225, 198, 164, 300, & + 308, 184, 152, 101, 179, 307, 162, 221, 267, 268, & + 94, 95, 96, 97, 256, 257, 205, 210, 200, 206, & + 231, 275, 222, 226, 51, 262, 261, 52, 289, 283, & + 54, 243, 180, 248, 188, 169, 240, 291, 288, 55, & + 249, 314, 316, 130, 189, 224, 190, 196, 294, 297, & + 296, 298, 278, 295, 299, 174, 191, 214, 197, 175, & + 176, 181, 56, 183, 57, 142, 317 /) + + diag_map(:317) = (/ 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, 51, 57, 63, 69, 75, & + 81, 87, 89, 95, 101, 107, 113, 114, 117, 120, & + 123, 126, 130, 134, 138, 142, 146, 150, 153, 156, & + 159, 164, 169, 174, 179, 182, 188, 192, 197, 201, & + 204, 207, 211, 218, 223, 229, 237, 242, 245, 248, & + 251, 256, 261, 266, 269, 272, 275, 279, 283, 287, & + 291, 295, 301, 304, 310, 316, 322, 326, 332, 337, & + 342, 347, 353, 358, 363, 368, 373, 377, 385, 393, & + 401, 405, 411, 417, 423, 429, 437, 443, 449, 456, & + 462, 468, 471, 477, 484, 488, 495, 502, 514, 521, & + 528, 536, 543, 550, 556, 561, 569, 577, 585, 593, & + 601, 605, 613, 626, 639, 646, 655, 664, 673, 682, & + 689, 693, 702, 711, 718, 728, 741, 752, 763, 770, & + 778, 783, 791, 797, 805, 813, 827, 842, 855, 862, & + 873, 883, 895, 906, 914, 919, 924, 929, 939, 951, & + 960, 969, 974, 986, 995,1006,1015,1024,1041,1054, & + 1071,1092,1106,1110,1121,1132,1143,1150,1159,1166, & + 1182,1194,1210,1218,1228,1235,1242,1252,1272,1289, & + 1298,1309,1325,1336,1350,1361,1377,1385,1410,1431, & + 1440,1454,1461,1468,1476,1481,1487,1494,1498,1508, & + 1524,1536,1543,1557,1572,1600,1613,1620,1640,1659, & + 1673,1689,1702,1712,1718,1732,1754,1770,1778,1793, & + 1817,1848,1872,1896,1916,1926,1953,1991,2016,2041, & + 2057,2078,2110,2140,2180,2199,2213,2235,2259,2277, & + 2296,2320,2339,2359,2380,2408,2441,2471,2505,2536, & + 2570,2600,2629,2654,2677,2701,2745,2792,2840,2913, & + 2931,2949,3106,3129,3161,3188,3369,3463,3488,3515, & + 3610,3663,3766,3808,3850,4101,4128 /) + + extfrc_lst(: 16) = (/ 'num_a4 ','pom_a4 ','bc_a4 ','SVOC ','SO2 ', & + 'NO2 ','so4_a1 ','so4_a2 ','so4_a5 ','CO ', & + 'num_a1 ','num_a2 ','num_a5 ','NO ','N ', & + 'OH ' /) + + frc_from_dataset(: 16) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .false., .false., & + .false. /) + + inv_lst(: 3) = (/ 'M ', 'O2 ', 'N2 ' /) + + slvd_lst(: 84) = (/ 'ACBZO2 ', 'ALKO2 ', 'APINNO3 ', 'APINO2 ', 'APINO2VBS ', & + 'BCARYNO3 ', 'BCARYO2 ', 'BCARYO2VBS ', 'BENZO2 ', 'BENZO2VBS ', & + 'BPINNO3 ', 'BPINO2 ', 'BPINO2VBS ', 'BZOO ', 'C2H5O2 ', & + 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', 'CH3O2 ', 'DICARBO2 ', & + 'ENEO2 ', 'EO ', 'EO2 ', 'HO2 ', 'HOCH2OO ', & + 'IEPOXOO ', 'ISOPB1O2 ', 'ISOPB4O2 ', 'ISOPC1C ', 'ISOPC1T ', & + 'ISOPC4C ', 'ISOPC4T ', 'ISOPED1O2 ', 'ISOPED4O2 ', 'ISOPN1DO2 ', & + 'ISOPN2BO2 ', 'ISOPN3BO2 ', 'ISOPN4DO2 ', 'ISOPNBNO3O2 ', 'ISOPNO3 ', & + 'ISOPNOOHBO2 ', 'ISOPNOOHDO2 ', 'ISOPO2VBS ', 'ISOPZD1O2 ', 'ISOPZD4O2 ', & + 'IVOCO2VBS ', 'LIMONNO3 ', 'LIMONO2 ', 'LIMONO2VBS ', 'MACRO2 ', & + 'MALO2 ', 'MCO3 ', 'MDIALO2 ', 'MEKO2 ', 'MVKO2 ', & + 'MYRCNO3 ', 'MYRCO2 ', 'MYRCO2VBS ', 'NC4CHOO2 ', 'O1D ', & + 'OH ', 'PHENO2 ', 'PO2 ', 'RO2 ', 'TERP1OOHO2 ', & + 'TERP2OOHO2 ', 'TERPA1O2 ', 'TERPA2CO3 ', 'TERPA2O2 ', 'TERPA3CO3 ', & + 'TERPA3O2 ', 'TERPA4O2 ', 'TERPACO3 ', 'TERPF1O2 ', 'TERPF2O2 ', & + 'TERPNPS1O2 ', 'TERPNPT1O2 ', 'TERPNS1O2 ', 'TERPNT1O2 ', 'TOLO2 ', & + 'TOLUO2VBS ', 'XYLENO2 ', 'XYLEO2VBS ', 'XYLOLO2 ' /) + + 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 ', & + 'jalknit ', 'jalkooh ', & + 'jbenzooh ', 'jbepomuc ', & + 'jbigald1 ', 'jbigald2 ', & + 'jbigald3 ', 'jbigald4 ', & + 'jbzooh ', 'jc2h5ooh ', & + 'jc3h7ooh ', 'jc6h5ooh ', & + 'jch2o_a ', 'jch2o_b ', & + 'jch3cho ', 'jacet ', & + 'jmgly ', 'jch3co3h ', & + 'jch3ooh ', 'jch4_a ', & + 'jch4_b ', 'jco2 ', & + 'jdhpmpal ', 'jeooh ', & + 'jglyald ', 'jglyoxal ', & + 'jhcoch2ooh ', 'jhmhp ', & + 'jhonitr ', 'jhpald1 ', & + 'jhpald4 ', 'jhpaldb1c ', & + 'jhpaldb4c ', 'jhyac ', & + 'jhydrald_b ', 'jhydrald_a ', & + 'jhyperacet_c ', 'jhyperacet_p ', & + 'jinheb ', 'jinhed ', & + 'jisopfdn ', 'jisopfdnc ', & + 'jisopfnc ', 'jisopfnp ', & + 'jisophfp ', 'jisopn1d ', & + 'jisopn2b ', 'jisopn3b ', & + 'jisopn4d ', 'jisopnbno3 ', & + 'jisopnoohb ', 'jisopnoohd ', & + 'jisopooh ', 'jmacr_b ', & + 'jmacr_a ', 'jmacrn ', & + 'jmacrooh ', 'jmek ', & + 'jmekooh ', 'jmpan ', & + 'jmvk ', 'jmvkn ', & + 'jmvkooh ', 'jnc4cho ', & + 'jno3ch2cho ', 'jnoa ', & + 'jonitr ', 'jpan ', & + 'jphenooh ', 'jpooh ', & + 'jrooh ', 'jtepomuc ', & + 'jterp1ooh ', 'jterp2aooh ', & + 'jterpa ', 'jterpa2 ', & + 'jterpa2pan ', 'jterpa3 ', & + 'jterpa3pan ', 'jterpacid ', & + 'jterpacid2 ', 'jterpacid3 ', & + 'jterpapan ', 'jterpdhdp ', & + 'jterpfdn ', 'jterphfn ', & + 'jterpnps ', 'jterpnps1 ', & + 'jterpnpt ', 'jterpnpt1 ', & + 'jterpns ', 'jterpns1 ', & + 'jterpnt ', 'jterpnt1 ', & + 'jterpooh ', 'jterpoohl ', & + 'jtolooh ', 'jxylenooh ', & + 'jxylolooh ', 'jbrcl ', & + 'jbro ', 'jbrono2_b ', & + 'jbrono2_a ', 'jccl4 ', & + 'jcf2clbr ', 'jcf3br ', & + 'jcfcl3 ', 'jcfc113 ', & + 'jcfc114 ', 'jcfc115 ', & + 'jcf2cl2 ', 'jch2br2 ', & + 'jch3br ', 'jch3ccl3 ', & + 'jch3cl ', 'jchbr3 ', & + 'jcl2 ', 'jcl2o2 ', & + 'jclo ', 'jclono2_a ', & + 'jclono2_b ', 'jcof2 ', & + 'jcofcl ', 'jh2402 ', & + 'jhbr ', 'jhcfc141b ', & + 'jhcfc142b ', 'jhcfc22 ', & + 'jhcl ', 'jhf ', & + 'jhobr ', 'jhocl ', & + 'joclo ', 'jsf6 ', & + 'jh2so4 ', 'jocs ', & + 'jso ', 'jso2 ', & + 'jso3 ', 'jsoa1_a1 ', & + 'jsoa1_a2 ', 'jsoa2_a1 ', & + 'jsoa2_a2 ', 'jsoa3_a1 ', & + 'jsoa3_a2 ', 'jsoa4_a1 ', & + 'jsoa4_a2 ', 'jsoa5_a1 ', & + 'jsoa5_a2 ', 'O1D_H2 ', & + 'O1D_H2O ', 'O1D_N2 ', & + 'O1D_O2ab ', 'O1D_O3 ', & + '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 ' /) + rxt_tag_lst( 201: 400) = (/ '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 ', & + 'F_CH4 ', 'F_H2 ', & + 'F_H2O ', 'F_HNO3 ', & + 'O1D_COF2 ', 'O1D_COFCL ', & + 'CH2BR2_CL ', 'CH2BR2_OH ', & + 'CH3BR_CL ', 'CH3BR_OH ', & + 'CH3CCL3_OH ', 'CH3CL_CL ', & + 'CH3CL_OH ', 'CHBR3_CL ', & + 'CHBR3_OH ', 'HCFC141B_OH ', & + 'HCFC142B_OH ', 'HCFC22_OH ', & + 'O1D_CH2BR2 ', 'O1D_CH3BR ', & + 'O1D_HCFC141B ', 'O1D_HCFC142B ', & + 'O1D_HCFC22 ', 'CH2O_HO2 ', & + 'CH2O_NO3 ', 'CH2O_O ', & + 'CH2O_OH ', 'CH3O2_CH3O2a ', & + 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & + 'CH3O2_NO ', 'CH3OH_OH ', & + 'CH3OOH_OH ', 'CH4_OH ', & + 'HCN_OH ', 'HCOOH_OH ', & + 'HMHP_OH ', 'HOCH2OO_HO2 ', & + 'HOCH2OO_M ', 'HOCH2OO_NO ', & + 'O1D_CH4a ', 'O1D_CH4b ', & + 'O1D_CH4c ', 'O1D_HCN ', & + 'usr_CO_OH ', 'C2H2_CL_M ', & + 'C2H2_OH_M ', '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 ', 'CH3CN_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 ', & + 'HCOCH2OOH_OH ', 'NO3CH2CHO_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 ', & + 'HYPERACET_OH ', 'NOA_OH ', & + 'PO2_HO2 ', 'PO2_NO ', & + 'POOH_OH ', 'RO2_CH3O2 ', & + 'RO2_HO2 ', 'RO2_NO ', & + 'ROOH_OH ', 'tag_C3H6_OH ', & + 'usr_CH3COCH3_OH ', 'BIGENE_NO3 ', & + 'BIGENE_OH ', 'DHPMPAL_OH ', & + 'ENEO2_NO ', 'ENEO2_NOb ', & + 'HONITR_OH ', 'MACRN_OH ', & + 'MACRO2_CH3CO3 ', 'MACRO2_CH3O2 ', & + 'MACRO2_HO2 ', 'MACRO2_isom ', & + 'MACR_O3 ', 'MACR_OH ', & + 'MACROOH_OH ', 'MCO3_CH3CO3 ', & + 'MCO3_CH3O2 ', 'MCO3_HO2 ', & + 'MCO3_MCO3 ', 'MCO3_NO ', & + 'MCO3_NO3 ', 'MEKO2_HO2 ', & + 'MEKO2_NO ', 'MEK_OH ', & + 'MEKOOH_OH ', 'MPAN_OH_M ', & + 'MVKN_OH ', 'MVKO2_CH3CO3 ' /) + rxt_tag_lst( 401: 600) = (/ 'MVKO2_CH3O2 ', 'MVKO2_HO2 ', & + 'MVK_O3 ', 'MVK_OH ', & + 'MVKOOH_OH ', 'tag_MCO3_NO2 ', & + 'usr_MPAN_M ', 'ALKNIT_OH ', & + 'ALKO2_HO2 ', 'ALKO2_NO ', & + 'ALKO2_NOb ', 'ALKOOH_OH ', & + 'BIGALK_OH ', 'HPALD1_OH ', & + 'HPALD4_OH ', 'HPALDB1C_OH ', & + 'HPALDB4C_OH ', 'HYDRALD_OH ', & + 'ICHE_OH ', 'IEPOX_OH ', & + 'IEPOXOO_HO2 ', 'INHEB_OH ', & + 'INHED_OH ', 'ISOPB1O2_CH3CO3 ', & + 'ISOPB1O2_CH3O2 ', 'ISOPB1O2_HO2 ', & + 'ISOPB1O2_I ', 'ISOPB1O2_M_C ', & + 'ISOPB1O2_M_T ', 'ISOPB4O2_CH3CO3 ', & + 'ISOPB4O2_CH3O2 ', 'ISOPB4O2_HO2 ', & + 'ISOPB4O2_I ', 'ISOPB4O2_M_C ', & + 'ISOPB4O2_M_T ', 'ISOPC1C_O2_B ', & + 'ISOPC1C_O2_D ', 'ISOPC1T_O2_B ', & + 'ISOPC1T_O2_D ', 'ISOPC4C_O2_B ', & + 'ISOPC4C_O2_D ', 'ISOPC4T_O2_B ', & + 'ISOPC4T_O2_D ', 'ISOPED1O2_CH3CO3 ', & + 'ISOPED1O2_CH3O2 ', 'ISOPED1O2_HO2 ', & + 'ISOPED1O2_M_C ', 'ISOPED4O2_CH3CO3 ', & + 'ISOPED4O2_CH3O2 ', 'ISOPED4O2_HO2 ', & + 'ISOPED4O2_M ', 'ISOPFDNC_OH ', & + 'ISOPFDN_OH ', 'ISOPFNC_OH ', & + 'ISOPFNP_OH ', 'ISOPHFP_OH ', & + 'ISOPN1DO2_HO2 ', 'ISOPN1DO2_I ', & + 'ISOPN1D_O3 ', 'ISOPN1D_OH ', & + 'ISOPN2BO2_HO2 ', 'ISOPN2BO2_I ', & + 'ISOPN2B_OH ', 'ISOPN3BO2_HO2 ', & + 'ISOPN3BO2_I ', 'ISOPN3B_OH ', & + 'ISOPN4DO2_HO2 ', 'ISOPN4DO2_I ', & + 'ISOPN4D_O3 ', 'ISOPN4D_OH ', & + 'ISOPNBNO3O2_HO2 ', 'ISOPNBNO3_OH ', & + 'ISOP_NO3 ', 'ISOPNO3_CH3CO3 ', & + 'ISOPNO3_CH3O2 ', 'ISOPNO3_HO2 ', & + 'ISOPNO3_ISOPNO3 ', 'ISOPNO3_NO3 ', & + 'ISOPNOOHBO2_HO2 ', 'ISOPNOOHBO2_I ', & + 'ISOPNOOHB_OH ', 'ISOPNOOHDO2_HO2 ', & + 'ISOPNOOHDO2_I ', 'ISOPNOOHD_O3 ', & + 'ISOPNOOHD_OH ', 'ISOP_O3 ', & + 'ISOP_OH ', 'ISOPOH_OH ', & + 'ISOPOOH_OH_abs ', 'ISOPOOH_OH_add ', & + 'ISOPZD1O2_CH3CO3 ', 'ISOPZD1O2_CH3O2 ', & + 'ISOPZD1O2_HO2 ', 'ISOPZD1O2_M ', & + 'ISOPZD4O2_CH3CO3 ', 'ISOPZD4O2_CH3O2 ', & + 'ISOPZD4O2_HO2 ', 'ISOPZD4O2_M_C ', & + 'NC4CHOO2_HO2 ', 'NC4CHOO2_isom ', & + 'NC4CHO_O3 ', 'NC4CHO_OH ', & + 'usr_IEPOXOO_NOa ', 'usr_IEPOXOO_NOn ', & + 'usr_ISOPB1O2_NOa ', 'usr_ISOPB1O2_NOn ', & + 'usr_ISOPB4O2_NOa ', 'usr_ISOPB4O2_NOn ', & + 'usr_ISOPED1O2_NOa ', 'usr_ISOPED1O2_NOn ', & + 'usr_ISOPED4O2_NOa ', 'usr_ISOPED4O2_NOn ', & + 'usr_ISOPN1DO2_NOa ', 'usr_ISOPN1DO2_NOn ', & + 'usr_ISOPN2BO2_NOa ', 'usr_ISOPN2BO2_NOn ', & + 'usr_ISOPN3BO2_NOa ', 'usr_ISOPN3BO2_NOn ', & + 'usr_ISOPN4DO2_NOa ', 'usr_ISOPN4DO2_NOn ', & + 'usr_ISOPNBNO3O2_NOa ', 'usr_ISOPNBNO3O2_NOn ', & + 'usr_ISOPNO3_NOa ', 'usr_ISOPNO3_NOn ', & + 'usr_ISOPNOOHBO2_NOa ', 'usr_ISOPNOOHBO2_NOn ', & + 'usr_ISOPNOOHDO2_NOa ', 'usr_ISOPNOOHDO2_NOn ', & + 'usr_ISOPZD1O2 ', 'usr_ISOPZD1O2_NOa ', & + 'usr_ISOPZD1O2_NOn ', 'usr_ISOPZD4O2 ', & + 'usr_ISOPZD4O2_NOa ', 'usr_ISOPZD4O2_NOn ', & + 'usr_MACRO2_NOa ', 'usr_MACRO2_NOn ', & + 'usr_MVKO2_NOa ', 'usr_MVKO2_NOn ', & + 'usr_NC4CHOO2_NOa ', 'usr_NC4CHOO2_NOn ', & + 'ACBZO2_HO2 ', 'ACBZO2_NO ', & + 'BENZENE_OH ', 'BENZO2_HO2 ', & + 'BENZO2_NO ', 'BENZOOH_OH ', & + 'BZALD_OH ', 'BZOO_HO2 ', & + 'BZOOH_OH ', 'BZOO_NO ', & + 'C6H5O2_HO2 ', 'C6H5O2_NO ', & + 'C6H5OOH_OH ', 'CRESOL_OH ', & + 'DICARBO2_HO2 ', 'DICARBO2_NO ', & + 'DICARBO2_NO2 ', 'MALO2_HO2 ', & + 'MALO2_NO ', 'MALO2_NO2 ', & + 'MDIALO2_HO2 ', 'MDIALO2_NO ', & + 'MDIALO2_NO2 ', 'PHENO2_HO2 ', & + 'PHENO2_NO ', 'PHENOL_OH ', & + 'PHENO_NO2 ', 'PHENO_O3 ', & + 'PHENOOH_OH ', 'tag_ACBZO2_NO2 ', & + 'TOLO2_HO2 ', 'TOLO2_NO ', & + 'TOLOOH_OH ', 'TOLUENE_OH ', & + 'usr_PBZNIT_M ', 'XYLENES_OH ', & + 'XYLENO2_HO2 ', 'XYLENO2_NO ', & + 'XYLENOOH_OH ', 'XYLOLO2_HO2 ', & + 'XYLOLO2_NO ', 'XYLOL_OH ', & + 'XYLOLOOH_OH ', 'APIN_NO3 ', & + 'APINNO3_APINNO3 ', 'APINNO3_CH3CO3 ', & + 'APINNO3_CH3O2 ', 'APINNO3_HO2 ', & + 'APINNO3_NO ', 'APINNO3_NO3 ', & + 'APINNO3_TERPA2CO3 ', 'APINNO3_TERPA3CO3 ', & + 'APINNO3_TERPACO3 ', 'APINO2_CH3CO3 ', & + 'APINO2_CH3O2 ', 'APINO2_HO2 ', & + 'APINO2_NO ', 'APINO2_NO3 ', & + 'APINO2_TERPA2CO3 ', 'APINO2_TERPA3CO3 ' /) + rxt_tag_lst( 601: 800) = (/ 'APINO2_TERPACO3 ', 'APIN_O3 ', & + 'APIN_OH ', 'BCARY_NO3 ', & + 'BCARYNO3_BCARYNO3 ', 'BCARYNO3_CH3CO3 ', & + 'BCARYNO3_CH3O2 ', 'BCARYNO3_HO2 ', & + 'BCARYNO3_NO ', 'BCARYNO3_NO3 ', & + 'BCARYNO3_TERPA2CO3 ', 'BCARYNO3_TERPA3CO3 ', & + 'BCARYNO3_TERPACO3 ', 'BCARYO2_CH3CO3 ', & + 'BCARYO2_CH3O2 ', 'BCARYO2_HO2 ', & + 'BCARYO2_NO ', 'BCARYO2_NO3 ', & + 'BCARYO2_TERPA2CO3 ', 'BCARYO2_TERPA3CO3 ', & + 'BCARYO2_TERPACO3 ', 'BCARY_O3 ', & + 'BCARY_OH ', 'BPIN_NO3 ', & + 'BPINNO3_BPINNO3 ', 'BPINNO3_CH3CO3 ', & + 'BPINNO3_CH3O2 ', 'BPINNO3_HO2 ', & + 'BPINNO3_NO ', 'BPINNO3_NO3 ', & + 'BPINNO3_TERPA2CO3 ', 'BPINNO3_TERPA3CO3 ', & + 'BPINNO3_TERPACO3 ', 'BPINO2_CH3CO3 ', & + 'BPINO2_CH3O2 ', 'BPINO2_HO2 ', & + 'BPINO2_NO ', 'BPINO2_NO3 ', & + 'BPINO2_TERPA2CO3 ', 'BPINO2_TERPA3CO3 ', & + 'BPINO2_TERPACO3 ', 'BPIN_O3 ', & + 'BPIN_OH ', 'LIMON_NO3 ', & + 'LIMONNO3_CH3CO3 ', 'LIMONNO3_CH3O2 ', & + 'LIMONNO3_HO2 ', 'LIMONNO3_LIMONNO3 ', & + 'LIMONNO3_NO ', 'LIMONNO3_NO3 ', & + 'LIMONNO3_TERPA2CO3 ', 'LIMONNO3_TERPA3CO3 ', & + 'LIMONNO3_TERPACO3 ', 'LIMONO2_CH3CO3 ', & + 'LIMONO2_CH3O2 ', 'LIMONO2_HO2 ', & + 'LIMONO2_NO ', 'LIMONO2_NO3 ', & + 'LIMONO2_TERPA2CO3 ', 'LIMONO2_TERPA3CO3 ', & + 'LIMONO2_TERPACO3 ', 'LIMON_O3 ', & + 'LIMON_OH ', 'MYRC_NO3 ', & + 'MYRCNO3_CH3CO3 ', 'MYRCNO3_CH3O2 ', & + 'MYRCNO3_HO2 ', 'MYRCNO3_MYRCNO3 ', & + 'MYRCNO3_NO ', 'MYRCNO3_NO3 ', & + 'MYRCNO3_TERPA2CO3 ', 'MYRCNO3_TERPA3CO3 ', & + 'MYRCNO3_TERPACO3 ', 'MYRCO2_CH3CO3 ', & + 'MYRCO2_CH3O2 ', 'MYRCO2_HO2 ', & + 'MYRCO2_NO ', 'MYRCO2_NO3 ', & + 'MYRCO2_TERPA2CO3 ', 'MYRCO2_TERPA3CO3 ', & + 'MYRCO2_TERPACO3 ', 'MYRC_O3 ', & + 'MYRC_OH ', 'tag_TERPA2CO3_NO2 ', & + 'tag_TERPA3CO3_NO2 ', 'tag_TERPACO3_NO2 ', & + 'TERP1OOHO2_HO2 ', 'TERP1OOHO2_NO ', & + 'TERP1OOH_OH ', 'TERP2AOOH_OH ', & + 'TERP2OOHO2_HO2 ', 'TERP2OOHO2_NO ', & + 'TERPA1O2_CH3CO3 ', 'TERPA1O2_CH3O2 ', & + 'TERPA1O2_HO2 ', 'TERPA1O2_NO ', & + 'TERPA1O2_NO3 ', 'TERPA1O2_TERPA2CO3 ', & + 'TERPA1O2_TERPA3CO3 ', 'TERPA1O2_TERPACO3 ', & + 'TERPA2CO3_CH3CO3 ', 'TERPA2CO3_CH3O2 ', & + 'TERPA2CO3_HO2 ', 'TERPA2CO3_NO ', & + 'TERPA2CO3_NO3 ', 'TERPA2CO3_TERPA2CO3 ', & + 'TERPA2CO3_TERPACO3 ', 'TERPA2_NO3 ', & + 'TERPA2O2_CH3CO3 ', 'TERPA2O2_CH3O2 ', & + 'TERPA2O2_HO2 ', 'TERPA2O2_NO ', & + 'TERPA2O2_NO3 ', 'TERPA2O2_TERPA2CO3 ', & + 'TERPA2O2_TERPA3CO3 ', 'TERPA2O2_TERPACO3 ', & + 'TERPA2_OH ', 'TERPA2PAN_OH ', & + 'TERPA3CO3_CH3CO3 ', 'TERPA3CO3_CH3O2 ', & + 'TERPA3CO3_HO2 ', 'TERPA3CO3_NO ', & + 'TERPA3CO3_NO3 ', 'TERPA3CO3_TERPA2CO3 ', & + 'TERPA3CO3_TERPA3CO3 ', 'TERPA3CO3_TERPACO3 ', & + 'TERPA3_NO3 ', 'TERPA3O2_CH3CO3 ', & + 'TERPA3O2_CH3O2 ', 'TERPA3O2_HO2 ', & + 'TERPA3O2_NO ', 'TERPA3O2_NO3 ', & + 'TERPA3O2_TERPA2CO3 ', 'TERPA3O2_TERPA3CO3 ', & + 'TERPA3O2_TERPACO3 ', 'TERPA3_OH ', & + 'TERPA3PAN_OH ', 'TERPA4O2_CH3CO3 ', & + 'TERPA4O2_CH3O2 ', 'TERPA4O2_HO2 ', & + 'TERPA4O2_NO ', 'TERPA4O2_NO3 ', & + 'TERPA4O2_TERPA2CO3 ', 'TERPA4O2_TERPA3CO3 ', & + 'TERPA4O2_TERPACO3 ', 'TERPACID2_OH ', & + 'TERPACID3_OH ', 'TERPACID_OH ', & + 'TERPACO3_CH3CO3 ', 'TERPACO3_CH3O2 ', & + 'TERPACO3_HO2 ', 'TERPACO3_NO ', & + 'TERPACO3_NO3 ', 'TERPACO3_TERPACO3 ', & + 'TERPA_NO3 ', 'TERPA_OH ', & + 'TERPAPAN_OH ', 'TERPDHDP_OH ', & + 'TERPF1_NO3 ', 'TERPF1O2_HO2 ', & + 'TERPF1O2_NO ', 'TERPF1_O3 ', & + 'TERPF1_OH ', 'TERPF2_NO3 ', & + 'TERPF2O2_HO2 ', 'TERPF2O2_NO ', & + 'TERPF2_O3 ', 'TERPF2_OH ', & + 'TERPFDN_OH ', 'TERPHFN_OH ', & + 'TERPK_OH ', 'TERPNPS1O2_HO2 ', & + 'TERPNPS1O2_NO ', 'TERPNPS1_OH ', & + 'TERPNPS_OH ', 'TERPNPT1O2_HO2 ', & + 'TERPNPT1O2_NO ', 'TERPNPT1_OH ', & + 'TERPNPT_OH ', 'TERPNS1O2_HO2 ', & + 'TERPNS1O2_NO ', 'TERPNS1_OH ', & + 'TERPNS_OH ', 'TERPNT1O2_HO2 ', & + 'TERPNT1O2_NO ', 'TERPNT1_OH ', & + 'TERPNT_OH ', 'TERPOOHL_OH ', & + 'TERPOOH_OH ', 'usr_TERPA2PAN_M ', & + 'usr_TERPA3PAN_M ', 'usr_TERPAPAN_M ', & + 'DMS_NO3 ', 'DMS_OHa ', & + 'OCS_O ', 'OCS_OH ', & + 'S_O2 ', 'SO2_OH_M ', & + 'S_O3 ', 'SO_BRO ' /) + rxt_tag_lst( 801: 904) = (/ 'SO_CLO ', 'S_OH ', & + 'SO_NO2 ', 'SO_O2 ', & + 'SO_O3 ', 'SO_OCLO ', & + 'SO_OH ', 'usr_DMS_OH ', & + 'usr_SO3_H2O ', 'NH3_OH ', & + 'usr_GLYOXAL_aer ', 'usr_HO2_aer ', & + 'usr_HONITR_aer ', 'usr_ICHE_aer ', & + 'usr_IEPOX_aer ', 'usr_INHEB_aer ', & + 'usr_INHED_aer ', 'usr_INOOHD_aer ', & + 'usr_ISOPFDN_aer ', 'usr_ISOPFDNC_aer ', & + 'usr_ISOPFNC_aer ', 'usr_ISOPFNP_aer ', & + 'usr_ISOPHFP_aer ', 'usr_ISOPN1D_aer ', & + 'usr_ISOPN2B_aer ', 'usr_ISOPN4D_aer ', & + 'usr_N2O5_aer ', 'usr_NC4CHO_aer ', & + 'usr_NH4_strat_tau ', 'usr_NO2_aer ', & + 'usr_NO3_aer ', 'usr_ONITR_aer ', & + 'usr_SQTN_aer ', 'usr_TERPDHDP_aer ', & + 'usr_TERPFDN_aer ', 'usr_TERPHFN_aer ', & + 'usr_TERPNPT1_aer ', 'usr_TERPNPT_aer ', & + 'usr_TERPNT1_aer ', 'usr_TERPNT_aer ', & + 'APIN_NO3_vbs ', 'APINO2_HO2_vbs ', & + 'APINO2_NO_vbs ', 'APIN_O3_vbs ', & + 'APIN_OH_vbs ', 'BCARY_NO3_vbs ', & + 'BCARYO2_HO2_vbs ', 'BCARYO2_NO_vbs ', & + 'BCARY_O3_vbs ', 'BCARY_OH_vbs ', & + 'BENZENE_OH_vbs ', 'BENZO2_HO2_vbs ', & + 'BENZO2_NO_vbs ', 'BPIN_NO3_vbs ', & + 'BPINO2_HO2_vbs ', 'BPINO2_NO_vbs ', & + 'BPIN_O3_vbs ', 'BPIN_OH_vbs ', & + 'ISOP_NO3_vbs ', 'ISOPO2_HO2_vbs ', & + 'ISOPO2_NO_vbs ', 'ISOP_O3_vbs ', & + 'ISOP_OH_vbs ', 'IVOCO2_HO2_vbs ', & + 'IVOCO2_NO_vbs ', 'IVOC_OH_vbs ', & + 'LIMON_NO3_vbs ', 'LIMONO2_HO2_vbs ', & + 'LIMONO2_NO_vbs ', 'LIMON_O3_vbs ', & + 'LIMON_OH_vbs ', 'MYRC_NO3_vbs ', & + 'MYRCO2_HO2_vbs ', 'MYRCO2_NO_vbs ', & + 'MYRC_O3_vbs ', 'MYRC_OH_vbs ', & + 'SVOC_OH ', 'TOLUENE_OH_vbs ', & + 'TOLUO2_HO2_vbs ', 'TOLUO2_NO_vbs ', & + 'XYLENES_OH_vbs ', 'XYLEO2_HO2_vbs ', & + 'XYLEO2_NO_vbs ', '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, 364, 365, 366, 367, 368, 369, 370, & + 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, & + 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, & + 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, & + 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, & + 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, & + 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, & + 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, & + 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, & + 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, & + 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, & + 471, 472, 473, 474, 475, 476, 477, 478, 479, 480, & + 481, 482, 483, 484, 485, 486, 487, 488, 489, 490, & + 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, & + 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, & + 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, & + 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, & + 531, 532, 533, 534, 535, 536, 537, 538, 539, 540, & + 541, 542, 543, 544, 545, 546, 547, 548, 549, 550, & + 551, 552, 553, 554, 555, 556, 557, 558, 559, 560, & + 561, 562, 563, 564, 565, 566, 567, 568, 569, 570, & + 571, 572, 573, 574, 575, 576, 577, 578, 579, 580, & + 581, 582, 583, 584, 585, 586, 587, 588, 589, 590, & + 591, 592, 593, 594, 595, 596, 597, 598, 599, 600, & + 601, 602, 603, 604, 605, 606, 607, 608, 609, 610, & + 611, 612, 613, 614, 615, 616, 617, 618, 619, 620, & + 621, 622, 623, 624, 625, 626, 627, 628, 629, 630, & + 631, 632, 633, 634, 635, 636, 637, 638, 639, 640, & + 641, 642, 643, 644, 645, 646, 647, 648, 649, 650, & + 651, 652, 653, 654, 655, 656, 657, 658, 659, 660, & + 661, 662, 663, 664, 665, 666, 667, 668, 669, 670, & + 671, 672, 673, 674, 675, 676, 677, 678, 679, 680, & + 681, 682, 683, 684, 685, 686, 687, 688, 689, 690, & + 691, 692, 693, 694, 695, 696, 697, 698, 699, 700, & + 701, 702, 703, 704, 705, 706, 707, 708, 709, 710, & + 711, 712, 713, 714, 715, 716, 717, 718, 719, 720, & + 721, 722, 723, 724, 725, 726, 727, 728, 729, 730, & + 731, 732, 733, 734, 735, 736, 737, 738, 739, 740, & + 741, 742, 743, 744, 745, 746, 747, 748, 749, 750, & + 751, 752, 753, 754, 755, 756, 757, 758, 759, 760, & + 761, 762, 763, 764, 765, 766, 767, 768, 769, 770, & + 771, 772, 773, 774, 775, 776, 777, 778, 779, 780, & + 781, 782, 783, 784, 785, 786, 787, 788, 789, 790, & + 791, 792, 793, 794, 795, 796, 797, 798, 799, 800, & + 801, 802, 803, 804, 805, 806, 807, 808, 809, 810, & + 811, 812, 813, 814, 815, 816, 817, 818, 819, 820, & + 821, 822, 823, 824, 825, 826, 827, 828, 829, 830, & + 831, 832, 833, 834, 835, 836, 837, 838, 839, 840, & + 841, 842, 843, 844, 845, 846, 847, 848, 849, 850, & + 851, 852, 853, 854, 855, 856, 857, 858, 859, 860, & + 861, 862, 863, 864, 865, 866, 867, 868, 869, 870, & + 871, 872, 873, 874, 875, 876, 877, 878, 879, 880, & + 881, 882, 883, 884, 885, 886, 887, 888, 889, 890, & + 891, 892, 893, 894, 895, 896, 897, 898, 899, 900, & + 901, 902, 903, 904 /) + 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 ', & + 'jch3ooh ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', ' ', ' ', & + ' ', ' ', ' ', 'jh2o2 ', & + ' ', ' ', ' ', ' ', & + 'jch3ooh ', 'jch3ooh ', ' ', 'jmgly ', & + 'jch3ooh ', 'jch3ooh ', 'jch2o_a ', 'jmacr_a ', & + 'jmacr_a ', 'jch3ooh ', 'jch3ooh ', ' ', & + 'jmacr_b ', 'jmacr_a ', 'jacet ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch2o_a ', & + 'jch2o_a ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', ' ', & + ' ', 'jch2o_a ', 'jch3ooh ', 'jacet ', & + 'jch3ooh ', 'jpan ', ' ', 'jch2o_a ', & + 'jch3ooh ', 'jch2o_a ', 'jch2o_a ', 'jch2o_a ', & + 'jch3cho ', ' ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jno2 ', 'jch3ooh ', 'jch3ooh ', & + 'jch3cho ', 'jch3cho ', 'jpan ', 'jch3cho ', & + 'jpan ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jpan ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', '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, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 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, .10_r8, .14_r8, .20_r8, .20_r8, & + .006_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, & + 4.62_r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 0.75_r8, 1._r8, 110.0_r8, 110.0_r8, 4.62_r8, & + 4.62_r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 10.0_r8, & + 10.0_r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 5.8_r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1.26_r8, & + 1._r8, 9.2_r8, 4.3_r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, .10_r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 0.71_r8, 0.71_r8, 0.71_r8, & + 1._r8, 2.0_r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 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, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_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(:) = (/ 170, 173, 174, 175, 178, & + 181, 182, 183, 184, 187, & + 188, 189, 192, 194, 198, & + 199, 207, 208 /) + 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, 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, 2, 2, & + 2, 3, 2, 2, 2, 1, 2, 2, 2, 2, & + 2, 2, 3, 3, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 1, 2, 2, 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, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 3, 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, 1, & + 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & + 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, & + 1, 2, 2, 2, 1, 2, 2, 1, 2, 2, & + 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 1, 2, 2, 1, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, & + 1, 2, 1, 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, 1, 2, 2, 1, 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, 3, 2, 2, 3, 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, 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, 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, 3, 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, 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, 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, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 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, 2, 1, 2, 1, 1, & + 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, & + 1, 1, 2, 1, 1, 1, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.doc b/src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.doc new file mode 100644 index 0000000000..56b6bbe782 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.doc @@ -0,0 +1,1126 @@ + + + Solution species + ( 1) bc_a1 (C) + ( 2) bc_a4 (C) + ( 3) BIGALK (C5H12) + ( 4) BR (Br) + ( 5) BRCL (BrCl) + ( 6) BRO (BrO) + ( 7) BRONO2 (BrONO2) + ( 8) BRY + ( 9) C2H4 + ( 10) C2H5OH + ( 11) C2H5OOH + ( 12) C2H6 + ( 13) C3H6 + ( 14) C3H7OOH + ( 15) C3H8 + ( 16) CCL4 (CCl4) + ( 17) CF2CLBR (CF2ClBr) + ( 18) CF3BR (CF3Br) + ( 19) CFC11 (CFCl3) + ( 20) CFC113 (CCl2FCClF2) + ( 21) CFC114 (CClF2CClF2) + ( 22) CFC115 (CClF2CF3) + ( 23) CFC12 (CF2Cl2) + ( 24) CH2BR2 (CH2Br2) + ( 25) CH2O + ( 26) CH3BR (CH3Br) + ( 27) CH3CCL3 (CH3CCl3) + ( 28) CH3CHO + ( 29) CH3CL (CH3Cl) + ( 30) CH3COCH3 + ( 31) CH3COCHO + ( 32) CH3COOH + ( 33) CH3COOOH + ( 34) CH3OH + ( 35) CH3OOH + ( 36) CH4 + ( 37) CHBR3 (CHBr3) + ( 38) CL (Cl) + ( 39) CL2 (Cl2) + ( 40) CL2O2 (Cl2O2) + ( 41) CLO (ClO) + ( 42) CLONO2 (ClONO2) + ( 43) CLY + ( 44) CO + ( 45) CO2 + ( 46) DMS (CH3SCH3) + ( 47) dst_a1 (AlSiO5) + ( 48) dst_a2 (AlSiO5) + ( 49) dst_a3 (AlSiO5) + ( 50) E90 (CO) + ( 51) EOOH (HOCH2CH2OOH) + ( 52) GLYALD (HOCH2CHO) + ( 53) GLYOXAL (C2H2O2) + ( 54) H + ( 55) H2 + ( 56) H2402 (CBrF2CBrF2) + ( 57) H2O2 + ( 58) H2SO4 (H2SO4) + ( 59) HBR (HBr) + ( 60) HCFC141B (CH3CCl2F) + ( 61) HCFC142B (CH3CClF2) + ( 62) HCFC22 (CHF2Cl) + ( 63) HCL (HCl) + ( 64) HF + ( 65) HNO3 + ( 66) HO2NO2 + ( 67) HOBR (HOBr) + ( 68) HOCL (HOCl) + ( 69) HYAC (CH3COCH2OH) + ( 70) HYDRALD (HOCH2CCH3CHCHO) + ( 71) ISOP (C5H8) + ( 72) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + ( 73) ISOPOOH (HOCH2COOHCH3CHCH2) + ( 74) MACR (CH2CCH3CHO) + ( 75) MACROOH (CH3COCHOOHCH2OH) + ( 76) MPAN (CH2CCH3CO3NO2) + ( 77) MVK (CH2CHCOCH3) + ( 78) N + ( 79) N2O + ( 80) N2O5 + ( 81) ncl_a1 (NaCl) + ( 82) ncl_a2 (NaCl) + ( 83) ncl_a3 (NaCl) + ( 84) NH3 + ( 85) NH4 + ( 86) NH_5 (CO) + ( 87) NH_50 (CO) + ( 88) NO + ( 89) NO2 + ( 90) NO3 + ( 91) NOA (CH3COCH2ONO2) + ( 92) num_a1 (H) + ( 93) num_a2 (H) + ( 94) num_a3 (H) + ( 95) num_a4 (H) + ( 96) num_a5 (H) + ( 97) O + ( 98) O3 + ( 99) O3S (O3) + (100) OCLO (OClO) + (101) OCS (OCS) + (102) ONITR (C4H7NO4) + (103) PAN (CH3CO3NO2) + (104) pom_a1 (C) + (105) pom_a4 (C) + (106) POOH (C3H6OHOOH) + (107) ROOH (CH3COCH2OOH) + (108) S (S) + (109) SF6 + (110) SO (SO) + (111) SO2 + (112) SO3 (SO3) + (113) so4_a1 (NH4HSO4) + (114) so4_a2 (NH4HSO4) + (115) so4_a3 (NH4HSO4) + (116) so4_a5 (NH4HSO4) + (117) soa_a1 (C) + (118) soa_a2 (C) + (119) SOAE (C) + (120) SOAG (C) + (121) ST80_25 (CO) + (122) TERP (C10H16) + (123) XOOH (HOCH2COOHCH3CHOHCHO) + (124) NHDEP (N) + (125) NDEP (N) + (126) C2H5O2 + (127) C3H7O2 + (128) CH3CO3 + (129) CH3O2 + (130) EO (HOCH2CH2O) + (131) EO2 (HOCH2CH2O2) + (132) HO2 + (133) ISOPO2 (HOCH2COOCH3CHCH2) + (134) MACRO2 (CH3COCHO2CH2OH) + (135) MCO3 (CH2CCH3CO3) + (136) O1D (O) + (137) OH + (138) PO2 (C3H6OHO2) + (139) RO2 (CH3COCH2O2) + (140) XO2 (HOCH2COOCH3CHOHCHO) + (141) H2O + + + Invariant species + ( 1) M + ( 2) O2 + ( 3) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) NHDEP + ( 2) NDEP + + Implicit + -------- + ( 1) bc_a1 + ( 2) bc_a4 + ( 3) BIGALK + ( 4) BR + ( 5) BRCL + ( 6) BRO + ( 7) BRONO2 + ( 8) BRY + ( 9) C2H4 + ( 10) C2H5OH + ( 11) C2H5OOH + ( 12) C2H6 + ( 13) C3H6 + ( 14) C3H7OOH + ( 15) C3H8 + ( 16) CCL4 + ( 17) CF2CLBR + ( 18) CF3BR + ( 19) CFC11 + ( 20) CFC113 + ( 21) CFC114 + ( 22) CFC115 + ( 23) CFC12 + ( 24) CH2BR2 + ( 25) CH2O + ( 26) CH3BR + ( 27) CH3CCL3 + ( 28) CH3CHO + ( 29) CH3CL + ( 30) CH3COCH3 + ( 31) CH3COCHO + ( 32) CH3COOH + ( 33) CH3COOOH + ( 34) CH3OH + ( 35) CH3OOH + ( 36) CH4 + ( 37) CHBR3 + ( 38) CL + ( 39) CL2 + ( 40) CL2O2 + ( 41) CLO + ( 42) CLONO2 + ( 43) CLY + ( 44) CO + ( 45) CO2 + ( 46) DMS + ( 47) dst_a1 + ( 48) dst_a2 + ( 49) dst_a3 + ( 50) E90 + ( 51) EOOH + ( 52) GLYALD + ( 53) GLYOXAL + ( 54) H + ( 55) H2 + ( 56) H2402 + ( 57) H2O2 + ( 58) H2SO4 + ( 59) HBR + ( 60) HCFC141B + ( 61) HCFC142B + ( 62) HCFC22 + ( 63) HCL + ( 64) HF + ( 65) HNO3 + ( 66) HO2NO2 + ( 67) HOBR + ( 68) HOCL + ( 69) HYAC + ( 70) HYDRALD + ( 71) ISOP + ( 72) ISOPNO3 + ( 73) ISOPOOH + ( 74) MACR + ( 75) MACROOH + ( 76) MPAN + ( 77) MVK + ( 78) N + ( 79) N2O + ( 80) N2O5 + ( 81) ncl_a1 + ( 82) ncl_a2 + ( 83) ncl_a3 + ( 84) NH3 + ( 85) NH4 + ( 86) NH_5 + ( 87) NH_50 + ( 88) NO + ( 89) NO2 + ( 90) NO3 + ( 91) NOA + ( 92) num_a1 + ( 93) num_a2 + ( 94) num_a3 + ( 95) num_a4 + ( 96) num_a5 + ( 97) O + ( 98) O3 + ( 99) O3S + (100) OCLO + (101) OCS + (102) ONITR + (103) PAN + (104) pom_a1 + (105) pom_a4 + (106) POOH + (107) ROOH + (108) S + (109) SF6 + (110) SO + (111) SO2 + (112) SO3 + (113) so4_a1 + (114) so4_a2 + (115) so4_a3 + (116) so4_a5 + (117) soa_a1 + (118) soa_a2 + (119) SOAE + (120) SOAG + (121) ST80_25 + (122) TERP + (123) XOOH + (124) C2H5O2 + (125) C3H7O2 + (126) CH3CO3 + (127) CH3O2 + (128) EO + (129) EO2 + (130) HO2 + (131) ISOPO2 + (132) MACRO2 + (133) MCO3 + (134) O1D + (135) OH + (136) PO2 + (137) RO2 + (138) XO2 + (139) H2O + + Photolysis + jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) + jh2o_a ( 2) H2O + hv -> OH + H rate = ** User defined ** ( 2) + jh2o_c ( 3) H2O + hv -> 2*H + O rate = ** User defined ** ( 3) + jh2o2 ( 4) H2O2 + hv -> 2*OH rate = ** User defined ** ( 4) + jo2_a ( 5) O2 + hv -> O + O1D rate = ** User defined ** ( 5) + jo2_b ( 6) O2 + hv -> 2*O rate = ** User defined ** ( 6) + jo3_a ( 7) O3 + hv -> O1D + O2 rate = ** User defined ** ( 7) + jo3_b ( 8) O3 + hv -> O + O2 rate = ** User defined ** ( 8) + jhno3 ( 9) HNO3 + hv -> NO2 + OH rate = ** User defined ** ( 9) + jho2no2_a ( 10) HO2NO2 + hv -> OH + NO3 rate = ** User defined ** ( 10) + jho2no2_b ( 11) HO2NO2 + hv -> NO2 + HO2 rate = ** User defined ** ( 11) + jn2o ( 12) N2O + hv -> O1D + N2 rate = ** User defined ** ( 12) + jn2o5_a ( 13) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 13) + jn2o5_b ( 14) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 14) + jno ( 15) NO + hv -> N + O rate = ** User defined ** ( 15) + jno2 ( 16) NO2 + hv -> NO + O rate = ** User defined ** ( 16) + jno3_b ( 17) NO3 + hv -> NO + O2 rate = ** User defined ** ( 17) + jno3_a ( 18) NO3 + hv -> NO2 + O rate = ** User defined ** ( 18) + jc2h5ooh ( 19) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 19) + jc3h7ooh ( 20) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 20) + jch2o_a ( 21) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 21) + jch2o_b ( 22) CH2O + hv -> CO + H2 rate = ** User defined ** ( 22) + jch3cho ( 23) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 23) + jacet ( 24) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 24) + jmgly ( 25) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 25) + jch3co3h ( 26) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 26) + jch3ooh ( 27) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 27) + jch4_b ( 28) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 28) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jch4_a ( 29) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 29) + jco2 ( 30) CO2 + hv -> CO + O rate = ** User defined ** ( 30) + jeooh ( 31) EOOH + hv -> EO + OH rate = ** User defined ** ( 31) + jglyald ( 32) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 32) + jglyoxal ( 33) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 33) + jhyac ( 34) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 34) + jisopooh ( 35) ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 rate = ** User defined ** ( 35) + jmacr_a ( 36) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 36) + jmacr_b ( 37) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 37) + jmpan ( 38) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 38) + jmvk ( 39) MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 rate = ** User defined ** ( 39) + jnoa ( 40) NOA + hv -> NO2 + CH2O + CH3CO3 rate = ** User defined ** ( 40) + jonitr ( 41) ONITR + hv -> HO2 + CO + NO2 + CH2O rate = ** User defined ** ( 41) + jpan ( 42) PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 rate = ** User defined ** ( 42) + jpooh ( 43) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 43) + jrooh ( 44) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 44) + jxooh ( 45) XOOH + hv -> OH rate = ** User defined ** ( 45) + jbrcl ( 46) BRCL + hv -> BR + CL rate = ** User defined ** ( 46) + jbro ( 47) BRO + hv -> BR + O rate = ** User defined ** ( 47) + jbrono2_b ( 48) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 48) + jbrono2_a ( 49) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 49) + jccl4 ( 50) CCL4 + hv -> 4*CL rate = ** User defined ** ( 50) + jcf2clbr ( 51) CF2CLBR + hv -> BR + CL + {COF2} rate = ** User defined ** ( 51) + jcf3br ( 52) CF3BR + hv -> BR + {F} + {COF2} rate = ** User defined ** ( 52) + jcfcl3 ( 53) CFC11 + hv -> 3*CL rate = ** User defined ** ( 53) + jcfc113 ( 54) CFC113 + hv -> 3*CL rate = ** User defined ** ( 54) + jcfc114 ( 55) CFC114 + hv -> 2*CL + 2*{COF2} rate = ** User defined ** ( 55) + jcfc115 ( 56) CFC115 + hv -> CL + {F} + 2*{COF2} rate = ** User defined ** ( 56) + jcf2cl2 ( 57) CFC12 + hv -> 2*CL + {COF2} rate = ** User defined ** ( 57) + jch2br2 ( 58) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 58) + jch3br ( 59) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 59) + jch3ccl3 ( 60) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 60) + jch3cl ( 61) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 61) + jchbr3 ( 62) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 62) + jcl2 ( 63) CL2 + hv -> 2*CL rate = ** User defined ** ( 63) + jcl2o2 ( 64) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 64) + jclo ( 65) CLO + hv -> CL + O rate = ** User defined ** ( 65) + jclono2_b ( 66) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 66) + jclono2_a ( 67) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 67) + jh2402 ( 68) H2402 + hv -> 2*BR + 2*{COF2} rate = ** User defined ** ( 68) + jhbr ( 69) HBR + hv -> BR + H rate = ** User defined ** ( 69) + jhcfc141b ( 70) HCFC141B + hv -> CL + {COFCL} rate = ** User defined ** ( 70) + jhcfc142b ( 71) HCFC142B + hv -> CL + {COF2} rate = ** User defined ** ( 71) + jhcfc22 ( 72) HCFC22 + hv -> CL + {COF2} rate = ** User defined ** ( 72) + jhcl ( 73) HCL + hv -> H + CL rate = ** User defined ** ( 73) + jhf ( 74) HF + hv -> H + {F} rate = ** User defined ** ( 74) + jhobr ( 75) HOBR + hv -> BR + OH rate = ** User defined ** ( 75) + jhocl ( 76) HOCL + hv -> OH + CL rate = ** User defined ** ( 76) + joclo ( 77) OCLO + hv -> O + CLO rate = ** User defined ** ( 77) + jsf6 ( 78) SF6 + hv -> {sink} rate = ** User defined ** ( 78) + jh2so4 ( 79) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** ( 79) + jocs ( 80) OCS + hv -> S + CO rate = ** User defined ** ( 80) + jso ( 81) SO + hv -> S + O rate = ** User defined ** ( 81) + jso2 ( 82) SO2 + hv -> SO + O rate = ** User defined ** ( 82) + jso3 ( 83) SO3 + hv -> SO2 + O rate = ** User defined ** ( 83) + jsoa_a1 ( 84) soa_a1 + hv -> (No products) rate = ** User defined ** ( 84) + jsoa_a2 ( 85) soa_a2 + hv -> (No products) rate = ** User defined ** ( 85) + + Reactions + O1D_H2 ( 1) O1D + H2 -> H + OH rate = 1.20E-10 ( 86) + O1D_H2O ( 2) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) ( 87) + O1D_N2 ( 3) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) ( 88) + O1D_O2ab ( 4) O1D + O2 -> O + O2 rate = 3.30E-11*exp( 55./t) ( 89) + O1D_O3 ( 5) O1D + O3 -> O2 + O2 rate = 1.20E-10 ( 90) + O1D_O3a ( 6) O1D + O3 -> O2 + 2*O rate = 1.20E-10 ( 91) + O_O3 ( 7) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) ( 92) + usr_O_O ( 8) O + O + M -> O2 + M rate = ** User defined ** ( 93) + usr_O_O2 ( 9) O + O2 + M -> O3 + M rate = ** User defined ** ( 94) + H2_O ( 10) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) ( 95) + H2O2_O ( 11) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) ( 96) + H_HO2 ( 12) H + HO2 -> H2 + O2 rate = 6.90E-12 ( 97) + H_HO2a ( 13) H + HO2 -> 2*OH rate = 7.20E-11 ( 98) + H_HO2b ( 14) H + HO2 -> H2O + O rate = 1.60E-12 ( 99) + H_O2 ( 15) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (100) + ki=9.50E-11*(300/t)**-0.40 + f=0.60 + HO2_O ( 16) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (101) + HO2_O3 ( 17) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (102) + H_O3 ( 18) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (103) + OH_H2 ( 19) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (104) + OH_H2O2 ( 20) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (105) + OH_HO2 ( 21) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (106) + OH_O ( 22) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (107) + OH_O3 ( 23) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (108) + OH_OH ( 24) OH + OH -> H2O + O rate = 1.80E-12 (109) + OH_OH_M ( 25) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (110) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 ( 26) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (111) + HO2NO2_OH ( 27) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (112) + N_NO ( 28) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (113) + N_NO2a ( 29) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (114) + N_NO2b ( 30) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (115) + N_NO2c ( 31) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (116) + N_O2 ( 32) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (117) + NO2_O ( 33) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (118) + NO2_O3 ( 34) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (119) + NO2_O_M ( 35) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (120) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 ( 36) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (121) + NO3_NO ( 37) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (122) + NO3_O ( 38) NO3 + O -> NO2 + O2 rate = 1.30E-11 (123) + NO3_OH ( 39) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (124) + N_OH ( 40) N + OH -> NO + H rate = 5.00E-11 (125) + NO_HO2 ( 41) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (126) + NO_O3 ( 42) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (127) + NO_O_M ( 43) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (128) + ki=3.00E-11 + f=0.60 + O1D_N2Oa ( 44) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (129) + O1D_N2Ob ( 45) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (130) + tag_NO2_HO2 ( 46) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (131) + ki=4.00E-12*(300/t)**0.30 + f=0.60 + tag_NO2_NO3 ( 47) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (132) + ki=1.60E-12*(300/t)**-0.10 + f=0.60 + tag_NO2_OH ( 48) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (133) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 49) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (134) + usr_HO2NO2_M ( 50) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (135) + usr_N2O5_M ( 51) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (136) + CL_CH2O ( 52) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (137) + CL_CH4 ( 53) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (138) + CL_H2 ( 54) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (139) + CL_H2O2 ( 55) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (140) + CL_HO2a ( 56) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (141) + CL_HO2b ( 57) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (142) + CL_O3 ( 58) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (143) + CLO_CH3O2 ( 59) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (144) + CLO_CLOa ( 60) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (145) + CLO_CLOb ( 61) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (146) + CLO_CLOc ( 62) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (147) + CLO_HO2 ( 63) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (148) + CLO_NO ( 64) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (149) + CLONO2_CL ( 65) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (150) + CLO_NO2_M ( 66) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (151) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLONO2_O ( 67) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (152) + CLONO2_OH ( 68) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (153) + CLO_O ( 69) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (154) + CLO_OHa ( 70) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (155) + CLO_OHb ( 71) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (156) + HCL_O ( 72) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (157) + HCL_OH ( 73) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (158) + HOCL_CL ( 74) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (159) + HOCL_O ( 75) HOCL + O -> CLO + OH rate = 1.70E-13 (160) + HOCL_OH ( 76) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (161) + O1D_CCL4 ( 77) O1D + CCL4 -> 4*CL rate = 2.61E-10 (162) + O1D_CF2CLBR ( 78) O1D + CF2CLBR -> CL + BR + {COF2} rate = 9.75E-11 (163) + O1D_CFC11 ( 79) O1D + CFC11 -> 3*CL rate = 2.07E-10 (164) + O1D_CFC113 ( 80) O1D + CFC113 -> 3*CL rate = 2.09E-10 (165) + O1D_CFC114 ( 81) O1D + CFC114 -> 2*CL + 2*{COF2} rate = 1.17E-10 (166) + O1D_CFC115 ( 82) O1D + CFC115 -> CL + {F} + 2*{COF2} rate = 4.64E-11 (167) + O1D_CFC12 ( 83) O1D + CFC12 -> 2*CL + {COF2} rate = 1.20E-10 (168) + O1D_HCLa ( 84) O1D + HCL -> CL + OH rate = 9.90E-11 (169) + O1D_HCLb ( 85) O1D + HCL -> CLO + H rate = 3.30E-12 (170) + tag_CLO_CLO_M ( 86) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (171) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M ( 87) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (172) + BR_CH2O ( 88) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (173) + BR_HO2 ( 89) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (174) + BR_O3 ( 90) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (175) + BRO_BRO ( 91) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (176) + BRO_CLOa ( 92) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (177) + BRO_CLOb ( 93) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (178) + BRO_CLOc ( 94) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (179) + BRO_HO2 ( 95) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (180) + BRO_NO ( 96) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (181) + BRO_NO2_M ( 97) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (182) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRONO2_O ( 98) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (183) + BRO_O ( 99) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (184) + BRO_OH (100) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (185) + HBR_O (101) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (186) + HBR_OH (102) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (187) + HOBR_O (103) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (188) + O1D_CF3BR (104) O1D + CF3BR -> BR + {F} + {COF2} rate = 4.50E-11 (189) + O1D_CHBR3 (105) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (190) + O1D_H2402 (106) O1D + H2402 -> 2*BR + 2*{COF2} rate = 1.20E-10 (191) + O1D_HBRa (107) O1D + HBR -> BR + OH rate = 9.00E-11 (192) + O1D_HBRb (108) O1D + HBR -> BRO + H rate = 3.00E-11 (193) + CH2BR2_CL (109) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (194) + CH2BR2_OH (110) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (195) + CH3BR_CL (111) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (196) + CH3BR_OH (112) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (197) + CH3CCL3_OH (113) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (198) + CH3CL_CL (114) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (199) + CH3CL_OH (115) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (200) + CHBR3_CL (116) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (201) + CHBR3_OH (117) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (202) + HCFC141B_OH (118) HCFC141B + OH -> CL + CL rate = 1.25E-12*exp( -1600./t) (203) + HCFC142B_OH (119) HCFC142B + OH -> CL + {COF2} rate = 1.30E-12*exp( -1770./t) (204) + HCFC22_OH (120) HCFC22 + OH -> H2O + CL + {COF2} rate = 9.20E-13*exp( -1560./t) (205) + O1D_CH2BR2 (121) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (206) + O1D_CH3BR (122) O1D + CH3BR -> BR rate = 1.80E-10 (207) + O1D_HCFC141B (123) O1D + HCFC141B -> CL + CL rate = 1.79E-10 (208) + O1D_HCFC142B (124) O1D + HCFC142B -> CL + {COF2} rate = 1.30E-10 (209) + O1D_HCFC22 (125) O1D + HCFC22 -> CL + {COF2} rate = 7.65E-11 (210) + CH2O_NO3 (126) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (211) + CH2O_O (127) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (212) + CH2O_OH (128) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (213) + CH3O2_CH3O2a (129) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (214) + CH3O2_CH3O2b (130) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (215) + CH3O2_HO2 (131) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (216) + CH3O2_NO (132) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (217) + CH3OH_OH (133) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (218) + CH3OOH_OH (134) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (219) + CH4_OH (135) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (220) + O1D_CH4a (136) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (221) + O1D_CH4b (137) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (222) + O1D_CH4c (138) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (223) + usr_CO_OH (139) CO + OH -> CO2 + HO2 rate = ** User defined ** (224) + C2H4_CL_M (140) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (225) + ki=3.10E-10*(300/t) + f=0.60 + C2H4_O3 (141) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*{HCOOH} + CH2O rate = 1.20E-14*exp( -2630./t) (226) + C2H5O2_C2H5O2 (142) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (227) + C2H5O2_CH3O2 (143) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (228) + + 0.2*C2H5OH + C2H5O2_HO2 (144) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (229) + C2H5O2_NO (145) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (230) + C2H5OH_OH (146) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (231) + C2H5OOH_OH (147) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (232) + C2H6_CL (148) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (233) + C2H6_OH (149) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (234) + CH3CHO_NO3 (150) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (235) + CH3CHO_OH (151) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (236) + CH3CO3_CH3CO3 (152) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (237) + CH3CO3_CH3O2 (153) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (238) + + 0.1*CH3COOH + CH3CO3_HO2 (154) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (239) + + 0.45*CH3O2 + CH3CO3_NO (155) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (240) + CH3COOH_OH (156) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 3.15E-14*exp( 920./t) (241) + CH3COOOH_OH (157) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (242) + EO2_HO2 (158) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (243) + EO2_NO (159) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (244) + EO_M (160) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (245) + EO_O2 (161) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (246) + GLYALD_OH (162) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (247) + GLYOXAL_OH (163) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (248) + PAN_OH (164) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (249) + tag_C2H4_OH (165) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (250) + ki=9.00E-12*(300/t)**0.85 + f=0.48 + tag_CH3CO3_NO2 (166) CH3CO3 + NO2 + M -> PAN + M troe : ko=7.30E-29*(300/t)**4.10 (251) + ki=9.50E-12*(300/t)**1.60 + f=0.60 + usr_PAN_M (167) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (252) + C3H6_NO3 (168) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (253) + C3H6_O3 (169) C3H6 + O3 -> 0.5*CH2O + 0.12*{HCOOH} + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (254) + + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + + 0.36*OH + C3H7O2_CH3O2 (170) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (255) + C3H7O2_HO2 (171) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (256) + C3H7O2_NO (172) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (257) + C3H7OOH_OH (173) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (258) + C3H8_OH (174) C3H8 + OH -> C3H7O2 + H2O rate = 9.19E-12*exp( -630./t) (259) + CH3COCHO_NO3 (175) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (260) + CH3COCHO_OH (176) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (261) + HYAC_OH (177) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (262) + NOA_OH (178) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (263) + PO2_HO2 (179) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (264) + PO2_NO (180) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (265) + POOH_OH (181) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (266) + RO2_CH3O2 (182) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (267) + + 0.5*CH3COCHO + 0.5*CH3OH + RO2_HO2 (183) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (268) + RO2_NO (184) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (269) + ROOH_OH (185) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (270) + tag_C3H6_OH (186) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (271) + ki=3.00E-11 + f=0.50 + usr_CH3COCH3_OH (187) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (272) + MACRO2_CH3CO3 (188) MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 rate = 1.40E-11 (273) + + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + + 0.53*CH3CO3 + MACRO2_CH3O2 (189) MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO rate = 5.00E-13*exp( 400./t) (274) + + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + + 0.23*HYAC + MACRO2_HO2 (190) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (275) + MACRO2_NO3 (191) MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO rate = 2.40E-12 (276) + + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 + MACRO2_NOa (192) MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD rate = 2.70E-12*exp( 360./t) (277) + + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO + MACRO2_NOb (193) MACRO2 + NO -> 0.8*ONITR rate = 1.30E-13*exp( 360./t) (278) + MACR_O3 (194) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (279) + + 0.88*CH3COCHO + 0.33*{HCOOH} + 0.14*HO2 + MACR_OH (195) MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 rate = 9.60E-12*exp( 360./t) (280) + MACROOH_OH (196) MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 rate = 2.30E-11*exp( 200./t) (281) + MCO3_CH3CO3 (197) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (282) + MCO3_CH3O2 (198) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (283) + MCO3_HO2 (199) MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH rate = 4.30E-13*exp( 1040./t) (284) + + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 + MCO3_MCO3 (200) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (285) + MCO3_NO (201) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (286) + MCO3_NO3 (202) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (287) + MPAN_OH_M (203) MPAN + OH + M -> 0.5*HYAC + 0.5*NO3 + 0.5*CH2O + 0.5*HO2 + 0.5*CO2 troe : ko=8.00E-27*(300/t)**3.50 (288) + + M + 0.5*NDEP ki=3.00E-11 + f=0.50 + MVK_O3 (204) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (289) + + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*{HCOOH} + MVK_OH (205) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (290) + tag_MCO3_NO2 (206) MCO3 + NO2 + M -> MPAN + M troe : ko=9.70E-29*(300/t)**5.60 (291) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + usr_MPAN_M (207) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (292) + BIGALK_OH (208) BIGALK + OH -> 1.67*C3H7O2 rate = 3.50E-12 (293) + HYDRALD_OH (209) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (294) + ISOP_NO3 (210) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (295) + ISOPNO3_HO2 (211) ISOPNO3 + HO2 -> 0.206*NO2 + 0.206*CH2O + 0.206*OH + 0.167*MACR rate = 8.00E-13*exp( 700./t) (296) + + 0.039*MVK + 0.794*ONITR + ISOPNO3_NO (212) ISOPNO3 + NO -> 1.206*NO2 + 0.794*HO2 + 0.072*CH2O + 0.167*MACR rate = 2.70E-12*exp( 360./t) (297) + + 0.039*MVK + 0.794*ONITR + ISOPNO3_NO3 (213) ISOPNO3 + NO3 -> 1.206*NO2 + 0.072*CH2O + 0.167*MACR + 0.039*MVK rate = 2.40E-12 (298) + + 0.794*ONITR + 0.794*HO2 + ISOPO2_CH3CO3 (214) ISOPO2 + CH3CO3 -> CH3O2 + HO2 + 0.6*CH2O + 0.25*MACR + 0.35*MVK rate = 1.40E-11 (299) + + 0.4*HYDRALD + ISOPO2_CH3O2 (215) ISOPO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.2*CH2O + 0.19*MACR rate = 5.00E-13*exp( 400./t) (300) + + 0.26*MVK + 0.3*HYDRALD + ISOPO2_HO2 (216) ISOPO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (301) + ISOPO2_NO (217) ISOPO2 + NO -> 0.08*ONITR + 0.92*NO2 + 0.23*MACR + 0.32*MVK rate = 4.40E-12*exp( 180./t) (302) + + 0.33*HYDRALD + 0.02*GLYOXAL + 0.02*GLYALD + + 0.02*CH3COCHO + 0.02*HYAC + 0.55*CH2O + 0.92*HO2 + ISOPO2_NO3 (218) ISOPO2 + NO3 -> HO2 + NO2 + 0.6*CH2O + 0.25*MACR + 0.35*MVK rate = 2.40E-12 (303) + + 0.4*HYDRALD + ISOP_O3 (219) ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*{HCOOH} + 0.62*CO + 0.32*OH rate = 1.05E-14*exp( -2000./t) (304) + + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + + 0.05*CH3O2 + ISOP_OH (220) ISOP + OH -> ISOPO2 rate = 2.54E-11*exp( 410./t) (305) + ISOPOOH_OH (221) ISOPOOH + OH -> 0.8*XO2 + 0.2*ISOPO2 rate = 1.52E-11*exp( 200./t) (306) + ONITR_NO3 (222) ONITR + NO3 -> HO2 + NO2 + HYDRALD rate = 1.40E-12*exp( -1860./t) (307) + ONITR_OH (223) ONITR + OH -> HYDRALD + 0.4*NO2 + HO2 rate = 4.50E-11 (308) + XO2_CH3CO3 (224) XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (309) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 + XO2_CH3O2 (225) XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO rate = 5.00E-13*exp( 400./t) (310) + + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD + XO2_HO2 (226) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (311) + XO2_NO (227) XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL rate = 2.70E-12*exp( 360./t) (312) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + XO2_NO3 (228) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (313) + + 0.25*CH3COCHO + 0.25*GLYALD + XOOH_OH (229) XOOH + OH -> 0.5*XO2 + 0.5*OH rate = 1.52E-12*exp( 200./t) (314) + TERP_NO3 (230) TERP + NO3 -> 1.7*ISOPO2 + NO2 rate = 1.20E-12*exp( 490./t) (315) + TERP_O3 (231) TERP + O3 -> 1.122*MACR + 0.442*MVK + 0.765*O + 1.156*OH rate = 6.30E-16*exp( -580./t) (316) + TERP_OH (232) TERP + OH -> 1.64*ISOPO2 + 0.1*CH3COCH3 rate = 1.20E-11*exp( 440./t) (317) + DMS_NO3 (233) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (318) + DMS_OHa (234) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (319) + OCS_O (235) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (320) + OCS_OH (236) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (321) + S_O2 (237) S + O2 -> SO + O rate = 2.30E-12 (322) + SO2_OH_M (238) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (323) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + S_O3 (239) S + O3 -> SO + O2 rate = 1.20E-11 (324) + SO_BRO (240) SO + BRO -> SO2 + BR rate = 5.70E-11 (325) + SO_CLO (241) SO + CLO -> SO2 + CL rate = 2.80E-11 (326) + S_OH (242) S + OH -> SO + H rate = 6.60E-11 (327) + SO_NO2 (243) SO + NO2 -> SO2 + NO rate = 1.40E-11 (328) + SO_O2 (244) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (329) + SO_O3 (245) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (330) + SO_OCLO (246) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (331) + SO_OH (247) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (332) + usr_DMS_OH (248) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (333) + usr_SO3_H2O (249) SO3 + H2O -> H2SO4 rate = ** User defined ** (334) + NH3_OH (250) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (335) + usr_HO2_aer (251) HO2 -> H2O rate = ** User defined ** (336) + usr_N2O5_aer (252) N2O5 -> 2*HNO3 rate = ** User defined ** (337) + usr_NH4_strat_ta (253) NH4 -> NHDEP rate = 6.34E-08 (338) + usr_NO2_aer (254) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (339) + usr_NO3_aer (255) NO3 -> HNO3 rate = ** User defined ** (340) + usr_ONITR_aer (256) ONITR -> HNO3 rate = ** User defined ** (341) + SOAE_tau (257) SOAE -> SOAG rate = 1.16E-05 (342) + het1 (258) N2O5 -> 2*HNO3 rate = ** User defined ** (343) + het10 (259) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (344) + het11 (260) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (345) + het12 (261) N2O5 -> 2*HNO3 rate = ** User defined ** (346) + het13 (262) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (347) + het14 (263) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (348) + het15 (264) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (349) + het16 (265) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (350) + het17 (266) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (351) + het2 (267) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (352) + het3 (268) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (353) + het4 (269) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (354) + het5 (270) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (355) + het6 (271) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (356) + het7 (272) N2O5 -> 2*HNO3 rate = ** User defined ** (357) + het8 (273) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (358) + het9 (274) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (359) + E90_tau (275) E90 -> {sink} rate = 1.29E-07 (360) + NH_50_tau (276) NH_50 -> (No products) rate = 2.31E-07 (361) + NH_5_tau (277) NH_5 -> (No products) rate = 2.31E-06 (362) + ST80_25_tau (278) ST80_25 -> (No products) rate = 4.63E-07 (363) + +Extraneous prod/loss species + ( 1) NO2 (dataset) + ( 2) so4_a2 (dataset) + ( 3) SO2 (dataset) + ( 4) so4_a1 (dataset) + ( 5) num_a2 (dataset) + ( 6) num_a1 (dataset) + ( 7) bc_a4 (dataset) + ( 8) num_a4 (dataset) + ( 9) NO + + + Equation Report + + d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(BIGALK)/dt = - r208*OH*BIGALK + d(BR)/dt = j46*BRCL + j47*BRO + j49*BRONO2 + j51*CF2CLBR + j52*CF3BR + 2*j58*CH2BR2 + j59*CH3BR + + 3*j62*CHBR3 + 2*j68*H2402 + j69*HBR + j75*HOBR + r78*O1D*CF2CLBR + 2*r91*BRO*BRO + r92*BRO*CLO + + r93*BRO*CLO + r96*BRO*NO + r99*BRO*O + r100*BRO*OH + r101*HBR*O + r102*HBR*OH + r104*O1D*CF3BR + + 3*r105*O1D*CHBR3 + 2*r106*O1D*H2402 + r107*O1D*HBR + 2*r109*CH2BR2*CL + 2*r110*CH2BR2*OH + + r111*CH3BR*CL + r112*CH3BR*OH + 3*r116*CHBR3*CL + 3*r117*CHBR3*OH + 2*r121*O1D*CH2BR2 + + r122*O1D*CH3BR + r240*SO*BRO + - r88*CH2O*BR - r89*HO2*BR - r90*O3*BR + d(BRCL)/dt = r94*BRO*CLO + r266*HOBR*HCL + r271*HOBR*HCL + - j46*BRCL + d(BRO)/dt = j48*BRONO2 + r90*BR*O3 + r98*BRONO2*O + r103*HOBR*O + r108*O1D*HBR + - j47*BRO - 2*r91*BRO*BRO - r92*CLO*BRO - r93*CLO*BRO - r94*CLO*BRO - r95*HO2*BRO - r96*NO*BRO + - r97*M*NO2*BRO - r99*O*BRO - r100*OH*BRO - r240*SO*BRO + d(BRONO2)/dt = r97*M*BRO*NO2 + - j48*BRONO2 - j49*BRONO2 - r260*BRONO2 - r263*BRONO2 - r268*BRONO2 - r98*O*BRONO2 + d(BRY)/dt = 0 + d(C2H4)/dt = - r140*M*CL*C2H4 - r141*O3*C2H4 - r165*M*OH*C2H4 + d(C2H5OH)/dt = .4*r142*C2H5O2*C2H5O2 + .2*r143*C2H5O2*CH3O2 + - r146*OH*C2H5OH + d(C2H5OOH)/dt = r144*C2H5O2*HO2 + - j19*C2H5OOH - r147*OH*C2H5OOH + d(C2H6)/dt = - r148*CL*C2H6 - r149*OH*C2H6 + d(C3H6)/dt = .7*j39*MVK + .13*r219*ISOP*O3 + - r168*NO3*C3H6 - r169*O3*C3H6 - r186*M*OH*C3H6 + d(C3H7OOH)/dt = r171*C3H7O2*HO2 + - j20*C3H7OOH - r173*OH*C3H7OOH + d(C3H8)/dt = - r174*OH*C3H8 + d(CCL4)/dt = - j50*CCL4 - r77*O1D*CCL4 + d(CF2CLBR)/dt = - j51*CF2CLBR - r78*O1D*CF2CLBR + d(CF3BR)/dt = - j52*CF3BR - r104*O1D*CF3BR + d(CFC11)/dt = - j53*CFC11 - r79*O1D*CFC11 + d(CFC113)/dt = - j54*CFC113 - r80*O1D*CFC113 + d(CFC114)/dt = - j55*CFC114 - r81*O1D*CFC114 + d(CFC115)/dt = - j56*CFC115 - r82*O1D*CFC115 + d(CFC12)/dt = - j57*CFC12 - r83*O1D*CFC12 + d(CH2BR2)/dt = - j58*CH2BR2 - r109*CL*CH2BR2 - r110*OH*CH2BR2 - r121*O1D*CH2BR2 + d(CH2O)/dt = j27*CH3OOH + .18*j28*CH4 + j32*GLYALD + j34*HYAC + .69*j35*ISOPOOH + 1.34*j36*MACR + j40*NOA + + j41*ONITR + j43*POOH + j44*ROOH + 2*r160*EO + r59*CLO*CH3O2 + 2*r129*CH3O2*CH3O2 + + r130*CH3O2*CH3O2 + r132*CH3O2*NO + r133*CH3OH*OH + .3*r134*CH3OOH*OH + r137*O1D*CH4 + + r138*O1D*CH4 + r141*C2H4*O3 + .7*r143*C2H5O2*CH3O2 + r153*CH3CO3*CH3O2 + .5*r157*CH3COOOH*OH + + .5*r159*EO2*NO + .8*r162*GLYALD*OH + r164*PAN*OH + .5*r169*C3H6*O3 + r170*C3H7O2*CH3O2 + + r180*PO2*NO + .8*r182*RO2*CH3O2 + .15*r183*RO2*HO2 + r184*RO2*NO + .25*r188*MACRO2*CH3CO3 + + .88*r189*MACRO2*CH3O2 + .25*r191*MACRO2*NO3 + .25*r192*MACRO2*NO + .12*r194*MACR*O3 + + r197*MCO3*CH3CO3 + 2*r198*MCO3*CH3O2 + .45*r199*MCO3*HO2 + 2*r200*MCO3*MCO3 + r201*MCO3*NO + + r202*MCO3*NO3 + .5*r203*M*MPAN*OH + .6*r204*MVK*O3 + .206*r211*ISOPNO3*HO2 + + .072*r212*ISOPNO3*NO + .072*r213*ISOPNO3*NO3 + .6*r214*ISOPO2*CH3CO3 + 1.2*r215*ISOPO2*CH3O2 + + .55*r217*ISOPO2*NO + .6*r218*ISOPO2*NO3 + .91*r219*ISOP*O3 + .25*r224*XO2*CH3CO3 + + .8*r225*XO2*CH3O2 + .25*r227*XO2*NO + - j21*CH2O - j22*CH2O - r52*CL*CH2O - r88*BR*CH2O - r126*NO3*CH2O - r127*O*CH2O - r128*OH*CH2O + d(CH3BR)/dt = - j59*CH3BR - r111*CL*CH3BR - r112*OH*CH3BR - r122*O1D*CH3BR + d(CH3CCL3)/dt = - j60*CH3CCL3 - r113*OH*CH3CCL3 + d(CH3CHO)/dt = j19*C2H5OOH + j43*POOH + 1.6*r142*C2H5O2*C2H5O2 + .8*r143*C2H5O2*CH3O2 + r145*C2H5O2*NO + + r146*C2H5OH*OH + .5*r147*C2H5OOH*OH + .5*r169*C3H6*O3 + .27*r172*C3H7O2*NO + r180*PO2*NO + + .1*r204*MVK*O3 + - j23*CH3CHO - r150*NO3*CH3CHO - r151*OH*CH3CHO + d(CH3CL)/dt = - j61*CH3CL - r114*CL*CH3CL - r115*OH*CH3CL + d(CH3COCH3)/dt = .82*j20*C3H7OOH + .82*r170*C3H7O2*CH3O2 + .82*r172*C3H7O2*NO + .1*r232*TERP*OH + - j24*CH3COCH3 - r187*OH*CH3COCH3 + d(CH3COCHO)/dt = r177*HYAC*OH + r178*NOA*OH + .5*r182*RO2*CH3O2 + .25*r188*MACRO2*CH3CO3 + + .24*r189*MACRO2*CH3O2 + .25*r191*MACRO2*NO3 + .25*r192*MACRO2*NO + .88*r194*MACR*O3 + + .5*r204*MVK*O3 + .02*r217*ISOPO2*NO + .25*r224*XO2*CH3CO3 + .1*r225*XO2*CH3O2 + + .25*r227*XO2*NO + .25*r228*XO2*NO3 + - j25*CH3COCHO - r175*NO3*CH3COCHO - r176*OH*CH3COCHO + d(CH3COOH)/dt = .1*r153*CH3CO3*CH3O2 + .15*r154*CH3CO3*HO2 + .12*r169*C3H6*O3 + .15*r199*MCO3*HO2 + - r156*OH*CH3COOH + d(CH3COOOH)/dt = .4*r154*CH3CO3*HO2 + .4*r199*MCO3*HO2 + - j26*CH3COOOH - r157*OH*CH3COOOH + d(CH3OH)/dt = r130*CH3O2*CH3O2 + .3*r143*C2H5O2*CH3O2 + .5*r182*RO2*CH3O2 + .25*r189*MACRO2*CH3O2 + + .25*r215*ISOPO2*CH3O2 + .3*r225*XO2*CH3O2 + - r133*OH*CH3OH + d(CH3OOH)/dt = r131*CH3O2*HO2 + - j27*CH3OOH - r134*OH*CH3OOH + d(CH4)/dt = .1*r169*C3H6*O3 + - j28*CH4 - j29*CH4 - r53*CL*CH4 - r135*OH*CH4 - r136*O1D*CH4 - r137*O1D*CH4 - r138*O1D*CH4 + d(CHBR3)/dt = - j62*CHBR3 - r105*O1D*CHBR3 - r116*CL*CHBR3 - r117*OH*CHBR3 + d(CL)/dt = j46*BRCL + 4*j50*CCL4 + j51*CF2CLBR + 3*j53*CFC11 + 3*j54*CFC113 + 2*j55*CFC114 + j56*CFC115 + + 2*j57*CFC12 + 3*j60*CH3CCL3 + j61*CH3CL + 2*j63*CL2 + 2*j64*CL2O2 + j65*CLO + j67*CLONO2 + + j70*HCFC141B + j71*HCFC142B + j72*HCFC22 + j73*HCL + j76*HOCL + r59*CLO*CH3O2 + 2*r60*CLO*CLO + + r62*CLO*CLO + r64*CLO*NO + r69*CLO*O + r70*CLO*OH + r72*HCL*O + r73*HCL*OH + 4*r77*O1D*CCL4 + + r78*O1D*CF2CLBR + 3*r79*O1D*CFC11 + 3*r80*O1D*CFC113 + 2*r81*O1D*CFC114 + r82*O1D*CFC115 + + 2*r83*O1D*CFC12 + r84*O1D*HCL + r93*BRO*CLO + 3*r113*CH3CCL3*OH + r115*CH3CL*OH + + r118*HCFC141B*OH + r118*HCFC141B*OH + r119*HCFC142B*OH + r120*HCFC22*OH + r123*O1D*HCFC141B + + r123*O1D*HCFC141B + r124*O1D*HCFC142B + r125*O1D*HCFC22 + r241*SO*CLO + - r52*CH2O*CL - r53*CH4*CL - r54*H2*CL - r55*H2O2*CL - r56*HO2*CL - r57*HO2*CL - r58*O3*CL + - r65*CLONO2*CL - r74*HOCL*CL - r109*CH2BR2*CL - r111*CH3BR*CL - r114*CH3CL*CL - r116*CHBR3*CL + - r148*C2H6*CL + d(CL2)/dt = r61*CLO*CLO + r65*CLONO2*CL + r259*HOCL*HCL + r264*CLONO2*HCL + r265*HOCL*HCL + r269*CLONO2*HCL + + r270*HOCL*HCL + r274*CLONO2*HCL + - j63*CL2 + d(CL2O2)/dt = r86*M*CLO*CLO + - j64*CL2O2 - r87*M*CL2O2 + d(CLO)/dt = j66*CLONO2 + j77*OCLO + r87*M*CL2O2 + r87*M*CL2O2 + r57*CL*HO2 + r58*CL*O3 + r67*CLONO2*O + + r74*HOCL*CL + r75*HOCL*O + r76*HOCL*OH + r85*O1D*HCL + r246*SO*OCLO + - j65*CLO - r59*CH3O2*CLO - 2*r60*CLO*CLO - 2*r61*CLO*CLO - 2*r62*CLO*CLO - r63*HO2*CLO + - r64*NO*CLO - r66*M*NO2*CLO - r69*O*CLO - r70*OH*CLO - r71*OH*CLO - 2*r86*M*CLO*CLO + - r92*BRO*CLO - r93*BRO*CLO - r94*BRO*CLO - r241*SO*CLO + d(CLONO2)/dt = r66*M*CLO*NO2 + - j66*CLONO2 - j67*CLONO2 - r262*CLONO2 - r267*CLONO2 - r273*CLONO2 - r65*CL*CLONO2 + - r67*O*CLONO2 - r68*OH*CLONO2 - r264*HCL*CLONO2 - r269*HCL*CLONO2 - r274*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = j21*CH2O + j22*CH2O + j23*CH3CHO + j25*CH3COCHO + .38*j28*CH4 + j30*CO2 + j32*GLYALD + + 2*j33*GLYOXAL + 1.34*j37*MACR + .7*j39*MVK + j41*ONITR + j80*OCS + r52*CL*CH2O + r88*BR*CH2O + + r114*CH3CL*CL + r126*CH2O*NO3 + r127*CH2O*O + r128*CH2O*OH + .63*r141*C2H4*O3 + r163*GLYOXAL*OH + + .56*r169*C3H6*O3 + r175*CH3COCHO*NO3 + r176*CH3COCHO*OH + .22*r188*MACRO2*CH3CO3 + + .11*r189*MACRO2*CH3O2 + .22*r191*MACRO2*NO3 + .22*r192*MACRO2*NO + .65*r194*MACR*O3 + + .56*r204*MVK*O3 + .62*r219*ISOP*O3 + .25*r224*XO2*CH3CO3 + .2*r225*XO2*CH3O2 + .25*r227*XO2*NO + + .5*r228*XO2*NO3 + r235*OCS*O + r236*OCS*OH + - r139*OH*CO + d(CO2)/dt = j26*CH3COOOH + .44*j28*CH4 + .4*j42*PAN + r139*CO*OH + 2*r152*CH3CO3*CH3CO3 + + .9*r153*CH3CO3*CH3O2 + r155*CH3CO3*NO + r156*CH3COOH*OH + .5*r157*CH3COOOH*OH + + .8*r162*GLYALD*OH + r163*GLYOXAL*OH + .2*r169*C3H6*O3 + 2*r197*MCO3*CH3CO3 + r198*MCO3*CH3O2 + + .45*r199*MCO3*HO2 + 2*r200*MCO3*MCO3 + .5*r203*M*MPAN*OH + .1*r204*MVK*O3 + r224*XO2*CH3CO3 + - j30*CO2 + d(DMS)/dt = - r233*NO3*DMS - r234*OH*DMS - r248*OH*DMS + d(dst_a1)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(E90)/dt = - r275*E90 + d(EOOH)/dt = r158*EO2*HO2 + - j31*EOOH + d(GLYALD)/dt = r161*O2*EO + .53*r188*MACRO2*CH3CO3 + .26*r189*MACRO2*CH3O2 + .53*r191*MACRO2*NO3 + + .53*r192*MACRO2*NO + .02*r217*ISOPO2*NO + .25*r224*XO2*CH3CO3 + .1*r225*XO2*CH3O2 + + .25*r227*XO2*NO + .25*r228*XO2*NO3 + - j32*GLYALD - r162*OH*GLYALD + d(GLYOXAL)/dt = .2*r162*GLYALD*OH + .02*r217*ISOPO2*NO + .25*r224*XO2*CH3CO3 + .1*r225*XO2*CH3O2 + + .25*r227*XO2*NO + .25*r228*XO2*NO3 + - j33*GLYOXAL - r163*OH*GLYOXAL + d(H)/dt = j2*H2O + 2*j3*H2O + 2*j21*CH2O + j27*CH3OOH + .33*j28*CH4 + j29*CH4 + j69*HBR + j73*HCL + j74*HF + + r1*O1D*H2 + r10*H2*O + r19*OH*H2 + r22*OH*O + r40*N*OH + r54*CL*H2 + r85*O1D*HCL + + r108*O1D*HBR + r128*CH2O*OH + r137*O1D*CH4 + r236*OCS*OH + r242*S*OH + r247*SO*OH + - r15*O2*M*H - r12*HO2*H - r13*HO2*H - r14*HO2*H - r18*O3*H + d(H2)/dt = j1*H2O + j22*CH2O + 1.4400001*j28*CH4 + r12*H*HO2 + r138*O1D*CH4 + - r1*O1D*H2 - r10*O*H2 - r19*OH*H2 - r54*CL*H2 + d(H2402)/dt = - j68*H2402 - r106*O1D*H2402 + d(H2O2)/dt = r25*M*OH*OH + r26*HO2*HO2 + - j4*H2O2 - r11*O*H2O2 - r20*OH*H2O2 - r55*CL*H2O2 + d(H2SO4)/dt = r249*SO3*H2O + - j79*H2SO4 + d(HBR)/dt = r88*BR*CH2O + r89*BR*HO2 + - j69*HBR - r101*O*HBR - r102*OH*HBR - r107*O1D*HBR - r108*O1D*HBR + d(HCFC141B)/dt = - j70*HCFC141B - r118*OH*HCFC141B - r123*O1D*HCFC141B + d(HCFC142B)/dt = - j71*HCFC142B - r119*OH*HCFC142B - r124*O1D*HCFC142B + d(HCFC22)/dt = - j72*HCFC22 - r120*OH*HCFC22 - r125*O1D*HCFC22 + d(HCL)/dt = r52*CL*CH2O + r53*CL*CH4 + r54*CL*H2 + r55*CL*H2O2 + r56*CL*HO2 + r71*CLO*OH + r74*HOCL*CL + + r109*CH2BR2*CL + r111*CH3BR*CL + 2*r114*CH3CL*CL + r116*CHBR3*CL + r148*C2H6*CL + - j73*HCL - r72*O*HCL - r73*OH*HCL - r84*O1D*HCL - r85*O1D*HCL - r259*HOCL*HCL + - r264*CLONO2*HCL - r265*HOCL*HCL - r266*HOBR*HCL - r269*CLONO2*HCL - r270*HOCL*HCL + - r271*HOBR*HCL - r274*CLONO2*HCL + d(HF)/dt = - j74*HF + d(HNO3)/dt = 2*r252*N2O5 + .5*r254*NO2 + r255*NO3 + r256*ONITR + 2*r258*N2O5 + r260*BRONO2 + 2*r261*N2O5 + + r262*CLONO2 + r263*BRONO2 + r267*CLONO2 + r268*BRONO2 + 2*r272*N2O5 + r273*CLONO2 + + r48*M*NO2*OH + r126*CH2O*NO3 + r150*CH3CHO*NO3 + r175*CH3COCHO*NO3 + r233*DMS*NO3 + + r264*CLONO2*HCL + r269*CLONO2*HCL + r274*CLONO2*HCL + - j9*HNO3 - r49*OH*HNO3 + d(HO2NO2)/dt = r46*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r50*M*HO2NO2 - r27*OH*HO2NO2 + d(HOBR)/dt = r260*BRONO2 + r263*BRONO2 + r268*BRONO2 + r95*BRO*HO2 + - j75*HOBR - r103*O*HOBR - r266*HCL*HOBR - r271*HCL*HOBR + d(HOCL)/dt = r262*CLONO2 + r267*CLONO2 + r273*CLONO2 + r63*CLO*HO2 + r68*CLONO2*OH + - j76*HOCL - r74*CL*HOCL - r75*O*HOCL - r76*OH*HOCL - r259*HCL*HOCL - r265*HCL*HOCL + - r270*HCL*HOCL + d(HYAC)/dt = .5*r181*POOH*OH + .2*r182*RO2*CH3O2 + .22*r188*MACRO2*CH3CO3 + .23*r189*MACRO2*CH3O2 + + .22*r191*MACRO2*NO3 + .22*r192*MACRO2*NO + .5*r203*M*MPAN*OH + .02*r217*ISOPO2*NO + + .25*r224*XO2*CH3CO3 + .1*r225*XO2*CH3O2 + .25*r227*XO2*NO + .25*r228*XO2*NO3 + - j34*HYAC - r177*OH*HYAC + d(HYDRALD)/dt = .4*r214*ISOPO2*CH3CO3 + .3*r215*ISOPO2*CH3O2 + .33*r217*ISOPO2*NO + .4*r218*ISOPO2*NO3 + + r222*ONITR*NO3 + r223*ONITR*OH + - r209*OH*HYDRALD + d(ISOP)/dt = - r210*NO3*ISOP - r219*O3*ISOP - r220*OH*ISOP + d(ISOPNO3)/dt = r210*ISOP*NO3 + - r211*HO2*ISOPNO3 - r212*NO*ISOPNO3 - r213*NO3*ISOPNO3 + d(ISOPOOH)/dt = r216*ISOPO2*HO2 + - j35*ISOPOOH - r221*OH*ISOPOOH + d(MACR)/dt = .288*j35*ISOPOOH + .167*r211*ISOPNO3*HO2 + .167*r212*ISOPNO3*NO + .167*r213*ISOPNO3*NO3 + + .25*r214*ISOPO2*CH3CO3 + .19*r215*ISOPO2*CH3O2 + .23*r217*ISOPO2*NO + .25*r218*ISOPO2*NO3 + + .3*r219*ISOP*O3 + 1.122*r231*TERP*O3 + - j36*MACR - j37*MACR - r194*O3*MACR - r195*OH*MACR + d(MACROOH)/dt = r190*MACRO2*HO2 + - r196*OH*MACROOH + d(MPAN)/dt = r206*M*MCO3*NO2 + - j38*MPAN - r207*M*MPAN - r203*M*OH*MPAN + d(MVK)/dt = .402*j35*ISOPOOH + .039*r211*ISOPNO3*HO2 + .039*r212*ISOPNO3*NO + .039*r213*ISOPNO3*NO3 + + .35*r214*ISOPO2*CH3CO3 + .26*r215*ISOPO2*CH3O2 + .32*r217*ISOPO2*NO + .35*r218*ISOPO2*NO3 + + .2*r219*ISOP*O3 + .442*r231*TERP*O3 + - j39*MVK - r204*O3*MVK - r205*OH*MVK + d(N)/dt = j15*NO + - r32*O2*N - r28*NO*N - r29*NO2*N - r30*NO2*N - r31*NO2*N - r40*OH*N + d(N2O)/dt = r29*N*NO2 + - j12*N2O - r44*O1D*N2O - r45*O1D*N2O + d(N2O5)/dt = r47*M*NO2*NO3 + - j13*N2O5 - j14*N2O5 - r51*M*N2O5 - r252*N2O5 - r258*N2O5 - r261*N2O5 - r272*N2O5 + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 + d(ncl_a3)/dt = 0 + d(NH3)/dt = - r250*OH*NH3 + d(NH4)/dt = - r253*NH4 + d(NH_5)/dt = - r277*NH_5 + d(NH_50)/dt = - r276*NH_50 + d(NO)/dt = j14*N2O5 + j16*NO2 + j17*NO3 + r32*O2*N + .5*r254*NO2 + 2*r30*N*NO2 + r33*NO2*O + r40*N*OH + + 2*r44*O1D*N2O + r243*SO*NO2 + - j15*NO - r28*N*NO - r37*NO3*NO - r41*HO2*NO - r42*O3*NO - r43*M*O*NO - r64*CLO*NO + - r96*BRO*NO - r132*CH3O2*NO - r145*C2H5O2*NO - r155*CH3CO3*NO - r159*EO2*NO - r172*C3H7O2*NO + - r180*PO2*NO - r184*RO2*NO - r192*MACRO2*NO - r193*MACRO2*NO - r201*MCO3*NO - r212*ISOPNO3*NO + - r217*ISOPO2*NO - r227*XO2*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j38*MPAN + j40*NOA + j41*ONITR + .6*j42*PAN + + j48*BRONO2 + j66*CLONO2 + r50*M*HO2NO2 + r51*M*N2O5 + r167*M*PAN + r207*M*MPAN + + r27*HO2NO2*OH + r36*NO3*HO2 + 2*r37*NO3*NO + r38*NO3*O + r39*NO3*OH + r41*NO*HO2 + r42*NO*O3 + + r43*M*NO*O + r64*CLO*NO + r96*BRO*NO + r132*CH3O2*NO + r145*C2H5O2*NO + r155*CH3CO3*NO + + r159*EO2*NO + r172*C3H7O2*NO + r178*NOA*OH + r180*PO2*NO + r184*RO2*NO + r191*MACRO2*NO3 + + r192*MACRO2*NO + r201*MCO3*NO + r202*MCO3*NO3 + .206*r211*ISOPNO3*HO2 + 1.206*r212*ISOPNO3*NO + + 1.206*r213*ISOPNO3*NO3 + .92*r217*ISOPO2*NO + r218*ISOPO2*NO3 + r222*ONITR*NO3 + + .4*r223*ONITR*OH + r227*XO2*NO + r228*XO2*NO3 + r230*TERP*NO3 + - j16*NO2 - r254*NO2 - r29*N*NO2 - r30*N*NO2 - r31*N*NO2 - r33*O*NO2 - r34*O3*NO2 + - r35*M*O*NO2 - r46*M*HO2*NO2 - r47*M*NO3*NO2 - r48*M*OH*NO2 - r66*M*CLO*NO2 - r97*M*BRO*NO2 + - r166*M*CH3CO3*NO2 - r206*M*MCO3*NO2 - r243*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j42*PAN + j49*BRONO2 + j67*CLONO2 + r51*M*N2O5 + + r34*NO2*O3 + r35*M*NO2*O + r49*HNO3*OH + r65*CLONO2*CL + r67*CLONO2*O + r68*CLONO2*OH + + r98*BRONO2*O + r164*PAN*OH + .5*r203*M*MPAN*OH + - j17*NO3 - j18*NO3 - r255*NO3 - r36*HO2*NO3 - r37*NO*NO3 - r38*O*NO3 - r39*OH*NO3 + - r47*M*NO2*NO3 - r126*CH2O*NO3 - r150*CH3CHO*NO3 - r168*C3H6*NO3 - r175*CH3COCHO*NO3 + - r191*MACRO2*NO3 - r202*MCO3*NO3 - r210*ISOP*NO3 - r213*ISOPNO3*NO3 - r218*ISOPO2*NO3 + - r222*ONITR*NO3 - r228*XO2*NO3 - r230*TERP*NO3 - r233*DMS*NO3 + d(NOA)/dt = r168*C3H6*NO3 + - j40*NOA - r178*OH*NOA + d(num_a1)/dt = 0 + d(num_a2)/dt = 0 + d(num_a3)/dt = 0 + d(num_a4)/dt = 0 + d(num_a5)/dt = 0 + d(O)/dt = j5*O2 + 2*j6*O2 + j3*H2O + j8*O3 + j14*N2O5 + j15*NO + j16*NO2 + j18*NO3 + .18*j28*CH4 + + j30*CO2 + j47*BRO + j65*CLO + j77*OCLO + j81*SO + j82*SO2 + j83*SO3 + r3*N2*O1D + r4*O2*O1D + + r32*O2*N + r237*O2*S + r244*O2*SO + 2*r6*O1D*O3 + r14*H*HO2 + r24*OH*OH + r28*N*NO + r29*N*NO2 + + .765*r231*TERP*O3 + - r9*O2*M*O - r7*O3*O - 2*r8*M*O*O - r10*H2*O - r11*H2O2*O - r16*HO2*O - r22*OH*O - r33*NO2*O + - r35*M*NO2*O - r38*NO3*O - r43*M*NO*O - r67*CLONO2*O - r69*CLO*O - r72*HCL*O - r75*HOCL*O + - r98*BRONO2*O - r99*BRO*O - r101*HBR*O - r103*HOBR*O - r127*CH2O*O - r235*OCS*O + d(O3)/dt = r9*O2*M*O + .15*r154*CH3CO3*HO2 + .15*r199*MCO3*HO2 + - j7*O3 - j8*O3 - r5*O1D*O3 - r6*O1D*O3 - r7*O*O3 - r17*HO2*O3 - r18*H*O3 - r23*OH*O3 + - r34*NO2*O3 - r42*NO*O3 - r58*CL*O3 - r90*BR*O3 - r141*C2H4*O3 - r169*C3H6*O3 - r194*MACR*O3 + - r204*MVK*O3 - r219*ISOP*O3 - r231*TERP*O3 - r239*S*O3 - r245*SO*O3 + d(O3S)/dt = 0 + d(OCLO)/dt = r62*CLO*CLO + r92*BRO*CLO + - j77*OCLO - r246*SO*OCLO + d(OCS)/dt = - j80*OCS - r235*O*OCS - r236*OH*OCS + d(ONITR)/dt = .8*r193*MACRO2*NO + .794*r211*ISOPNO3*HO2 + .794*r212*ISOPNO3*NO + .794*r213*ISOPNO3*NO3 + + .08*r217*ISOPO2*NO + - j41*ONITR - r256*ONITR - r222*NO3*ONITR - r223*OH*ONITR + d(PAN)/dt = r166*M*CH3CO3*NO2 + - j42*PAN - r167*M*PAN - r164*OH*PAN + d(pom_a1)/dt = 0 + d(pom_a4)/dt = 0 + d(POOH)/dt = r179*PO2*HO2 + - j43*POOH - r181*OH*POOH + d(ROOH)/dt = .85*r183*RO2*HO2 + - j44*ROOH - r185*OH*ROOH + d(S)/dt = j80*OCS + j81*SO + - r237*O2*S - r239*O3*S - r242*OH*S + d(SF6)/dt = - j78*SF6 + d(SO)/dt = j82*SO2 + r237*O2*S + r235*OCS*O + r239*S*O3 + r242*S*OH + - j81*SO - r244*O2*SO - r240*BRO*SO - r241*CLO*SO - r243*NO2*SO - r245*O3*SO - r246*OCLO*SO + - r247*OH*SO + d(SO2)/dt = j83*SO3 + r244*O2*SO + r233*DMS*NO3 + r234*DMS*OH + r236*OCS*OH + r240*SO*BRO + r241*SO*CLO + + r243*SO*NO2 + r245*SO*O3 + r246*SO*OCLO + r247*SO*OH + .5*r248*DMS*OH + - j82*SO2 - r238*M*OH*SO2 + d(SO3)/dt = j79*H2SO4 + r238*M*SO2*OH + - j83*SO3 - r249*H2O*SO3 + d(so4_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(so4_a3)/dt = 0 + d(so4_a5)/dt = 0 + d(soa_a1)/dt = - j84*soa_a1 + d(soa_a2)/dt = - j85*soa_a2 + d(SOAE)/dt = - r257*SOAE + d(SOAG)/dt = r257*SOAE + d(ST80_25)/dt = - r278*ST80_25 + d(TERP)/dt = - r230*NO3*TERP - r231*O3*TERP - r232*OH*TERP + d(XOOH)/dt = r226*XO2*HO2 + - j45*XOOH - r229*OH*XOOH + d(NHDEP)/dt = r253*NH4 + r250*NH3*OH + d(NDEP)/dt = .5*r203*M*MPAN*OH + d(C2H5O2)/dt = .5*r147*C2H5OOH*OH + r148*C2H6*CL + r149*C2H6*OH + - 2*r142*C2H5O2*C2H5O2 - r143*CH3O2*C2H5O2 - r144*HO2*C2H5O2 - r145*NO*C2H5O2 + d(C3H7O2)/dt = r173*C3H7OOH*OH + r174*C3H8*OH + 1.67*r208*BIGALK*OH + - r170*CH3O2*C3H7O2 - r171*HO2*C3H7O2 - r172*NO*C3H7O2 + d(CH3CO3)/dt = j24*CH3COCH3 + j25*CH3COCHO + j34*HYAC + 1.34*j36*MACR + .3*j39*MVK + j40*NOA + .6*j42*PAN + + j44*ROOH + r167*M*PAN + r150*CH3CHO*NO3 + r151*CH3CHO*OH + .5*r157*CH3COOOH*OH + + r175*CH3COCHO*NO3 + r176*CH3COCHO*OH + .3*r182*RO2*CH3O2 + .15*r183*RO2*HO2 + r184*RO2*NO + + .53*r188*MACRO2*CH3CO3 + .26*r189*MACRO2*CH3O2 + .53*r191*MACRO2*NO3 + .53*r192*MACRO2*NO + + .1*r194*MACR*O3 + r198*MCO3*CH3O2 + .45*r199*MCO3*HO2 + 2*r200*MCO3*MCO3 + r201*MCO3*NO + + r202*MCO3*NO3 + .28*r204*MVK*O3 + .08*r219*ISOP*O3 + - 2*r152*CH3CO3*CH3CO3 - r153*CH3O2*CH3CO3 - r154*HO2*CH3CO3 - r155*NO*CH3CO3 + - r166*M*NO2*CH3CO3 - r188*MACRO2*CH3CO3 - r214*ISOPO2*CH3CO3 - r224*XO2*CH3CO3 + d(CH3O2)/dt = j23*CH3CHO + j24*CH3COCH3 + j26*CH3COOOH + j29*CH4 + .3*j39*MVK + .4*j42*PAN + j59*CH3BR + + j61*CH3CL + r53*CL*CH4 + .7*r134*CH3OOH*OH + r135*CH4*OH + r136*O1D*CH4 + + 2*r152*CH3CO3*CH3CO3 + .9*r153*CH3CO3*CH3O2 + .45*r154*CH3CO3*HO2 + r155*CH3CO3*NO + + r156*CH3COOH*OH + .28*r169*C3H6*O3 + r188*MACRO2*CH3CO3 + r197*MCO3*CH3CO3 + + r214*ISOPO2*CH3CO3 + .05*r219*ISOP*O3 + r224*XO2*CH3CO3 + - r59*CLO*CH3O2 - 2*r129*CH3O2*CH3O2 - 2*r130*CH3O2*CH3O2 - r131*HO2*CH3O2 - r132*NO*CH3O2 + - r143*C2H5O2*CH3O2 - r153*CH3CO3*CH3O2 - r170*C3H7O2*CH3O2 - r182*RO2*CH3O2 + - r189*MACRO2*CH3O2 - r198*MCO3*CH3O2 - r215*ISOPO2*CH3O2 - r225*XO2*CH3O2 + d(EO)/dt = j31*EOOH + .75*r159*EO2*NO + - r160*EO - r161*O2*EO + d(EO2)/dt = r165*M*C2H4*OH + - r158*HO2*EO2 - r159*NO*EO2 + d(HO2)/dt = j11*HO2NO2 + j19*C2H5OOH + j20*C3H7OOH + j23*CH3CHO + j25*CH3COCHO + 2*j32*GLYALD + + 2*j33*GLYOXAL + j34*HYAC + j35*ISOPOOH + 1.34*j36*MACR + .66*j37*MACR + j41*ONITR + j43*POOH + + r15*O2*M*H + r50*M*HO2NO2 + r160*EO + r161*O2*EO + r11*H2O2*O + r20*OH*H2O2 + r23*OH*O3 + + r39*NO3*OH + r52*CL*CH2O + r55*CL*H2O2 + r59*CLO*CH3O2 + r70*CLO*OH + r88*BR*CH2O + + r100*BRO*OH + r111*CH3BR*CL + r112*CH3BR*OH + r114*CH3CL*CL + r115*CH3CL*OH + r126*CH2O*NO3 + + r127*CH2O*O + 2*r129*CH3O2*CH3O2 + r132*CH3O2*NO + r133*CH3OH*OH + r137*O1D*CH4 + r139*CO*OH + + .13*r141*C2H4*O3 + 1.2*r142*C2H5O2*C2H5O2 + r143*C2H5O2*CH3O2 + r145*C2H5O2*NO + r146*C2H5OH*OH + + .9*r153*CH3CO3*CH3O2 + .25*r159*EO2*NO + r162*GLYALD*OH + r163*GLYOXAL*OH + .28*r169*C3H6*O3 + + r170*C3H7O2*CH3O2 + r172*C3H7O2*NO + r177*HYAC*OH + r180*PO2*NO + .3*r182*RO2*CH3O2 + + .47*r188*MACRO2*CH3CO3 + .73*r189*MACRO2*CH3O2 + .47*r191*MACRO2*NO3 + .47*r192*MACRO2*NO + + .14*r194*MACR*O3 + .2*r196*MACROOH*OH + r198*MCO3*CH3O2 + .5*r203*M*MPAN*OH + .28*r204*MVK*O3 + + .794*r212*ISOPNO3*NO + .794*r213*ISOPNO3*NO3 + r214*ISOPO2*CH3CO3 + r215*ISOPO2*CH3O2 + + .92*r217*ISOPO2*NO + r218*ISOPO2*NO3 + .37*r219*ISOP*O3 + r222*ONITR*NO3 + r223*ONITR*OH + + r224*XO2*CH3CO3 + .8*r225*XO2*CH3O2 + r227*XO2*NO + r228*XO2*NO3 + r238*M*SO2*OH + + .5*r248*DMS*OH + - r251*HO2 - r12*H*HO2 - r13*H*HO2 - r14*H*HO2 - r16*O*HO2 - r17*O3*HO2 - r21*OH*HO2 + - 2*r26*HO2*HO2 - r36*NO3*HO2 - r41*NO*HO2 - r46*M*NO2*HO2 - r56*CL*HO2 - r57*CL*HO2 + - r63*CLO*HO2 - r89*BR*HO2 - r95*BRO*HO2 - r131*CH3O2*HO2 - r144*C2H5O2*HO2 - r154*CH3CO3*HO2 + - r158*EO2*HO2 - r171*C3H7O2*HO2 - r179*PO2*HO2 - r183*RO2*HO2 - r190*MACRO2*HO2 - r199*MCO3*HO2 + - r211*ISOPNO3*HO2 - r216*ISOPO2*HO2 - r226*XO2*HO2 + d(ISOPO2)/dt = r220*ISOP*OH + .2*r221*ISOPOOH*OH + 1.7*r230*TERP*NO3 + 1.64*r232*TERP*OH + - r214*CH3CO3*ISOPO2 - r215*CH3O2*ISOPO2 - r216*HO2*ISOPO2 - r217*NO*ISOPO2 - r218*NO3*ISOPO2 + d(MACRO2)/dt = .5*r195*MACR*OH + .2*r196*MACROOH*OH + r205*MVK*OH + - r188*CH3CO3*MACRO2 - r189*CH3O2*MACRO2 - r190*HO2*MACRO2 - r191*NO3*MACRO2 - r192*NO*MACRO2 + - r193*NO*MACRO2 + d(MCO3)/dt = .66*j36*MACR + j38*MPAN + r207*M*MPAN + .5*r195*MACR*OH + .5*r196*MACROOH*OH + - r197*CH3CO3*MCO3 - r198*CH3O2*MCO3 - r199*HO2*MCO3 - 2*r200*MCO3*MCO3 - r201*NO*MCO3 + - r202*NO3*MCO3 - r206*M*NO2*MCO3 + d(O1D)/dt = j5*O2 + j1*H2O + j7*O3 + j12*N2O + - r3*N2*O1D - r4*O2*O1D - r1*H2*O1D - r2*H2O*O1D - r5*O3*O1D - r6*O3*O1D - r44*N2O*O1D + - r45*N2O*O1D - r77*CCL4*O1D - r78*CF2CLBR*O1D - r79*CFC11*O1D - r80*CFC113*O1D - r81*CFC114*O1D + - r82*CFC115*O1D - r83*CFC12*O1D - r84*HCL*O1D - r85*HCL*O1D - r104*CF3BR*O1D - r105*CHBR3*O1D + - r106*H2402*O1D - r107*HBR*O1D - r108*HBR*O1D - r121*CH2BR2*O1D - r122*CH3BR*O1D + - r123*HCFC141B*O1D - r124*HCFC142B*O1D - r125*HCFC22*O1D - r136*CH4*O1D - r137*CH4*O1D + - r138*CH4*O1D + d(OH)/dt = j2*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j19*C2H5OOH + j20*C3H7OOH + j26*CH3COOOH + + j27*CH3OOH + .33*j28*CH4 + j31*EOOH + j43*POOH + j44*ROOH + j45*XOOH + j75*HOBR + j76*HOCL + + .5*r254*NO2 + r1*O1D*H2 + 2*r2*O1D*H2O + r10*H2*O + r11*H2O2*O + 2*r13*H*HO2 + r16*HO2*O + + r17*HO2*O3 + r18*H*O3 + r36*NO3*HO2 + r41*NO*HO2 + r57*CL*HO2 + r72*HCL*O + r75*HOCL*O + + r84*O1D*HCL + r101*HBR*O + r103*HOBR*O + r107*O1D*HBR + r127*CH2O*O + .3*r134*CH3OOH*OH + + r136*O1D*CH4 + .13*r141*C2H4*O3 + .5*r147*C2H5OOH*OH + .45*r154*CH3CO3*HO2 + .36*r169*C3H6*O3 + + .5*r181*POOH*OH + .15*r183*RO2*HO2 + .24*r194*MACR*O3 + .1*r196*MACROOH*OH + .45*r199*MCO3*HO2 + + .36*r204*MVK*O3 + .206*r211*ISOPNO3*HO2 + .32*r219*ISOP*O3 + .5*r229*XOOH*OH + + 1.156*r231*TERP*O3 + - r19*H2*OH - r20*H2O2*OH - r21*HO2*OH - r22*O*OH - r23*O3*OH - 2*r24*OH*OH - 2*r25*M*OH*OH + - r27*HO2NO2*OH - r39*NO3*OH - r40*N*OH - r48*M*NO2*OH - r49*HNO3*OH - r68*CLONO2*OH + - r70*CLO*OH - r71*CLO*OH - r73*HCL*OH - r76*HOCL*OH - r100*BRO*OH - r102*HBR*OH + - r110*CH2BR2*OH - r112*CH3BR*OH - r113*CH3CCL3*OH - r115*CH3CL*OH - r117*CHBR3*OH + - r118*HCFC141B*OH - r119*HCFC142B*OH - r120*HCFC22*OH - r128*CH2O*OH - r133*CH3OH*OH + - r134*CH3OOH*OH - r135*CH4*OH - r139*CO*OH - r146*C2H5OH*OH - r147*C2H5OOH*OH - r149*C2H6*OH + - r151*CH3CHO*OH - r156*CH3COOH*OH - r157*CH3COOOH*OH - r162*GLYALD*OH - r163*GLYOXAL*OH + - r164*PAN*OH - r165*M*C2H4*OH - r173*C3H7OOH*OH - r174*C3H8*OH - r176*CH3COCHO*OH - r177*HYAC*OH + - r178*NOA*OH - r181*POOH*OH - r185*ROOH*OH - r186*M*C3H6*OH - r187*CH3COCH3*OH - r195*MACR*OH + - r196*MACROOH*OH - r203*M*MPAN*OH - r205*MVK*OH - r208*BIGALK*OH - r209*HYDRALD*OH + - r220*ISOP*OH - r221*ISOPOOH*OH - r223*ONITR*OH - r229*XOOH*OH - r232*TERP*OH - r234*DMS*OH + - r236*OCS*OH - r238*M*SO2*OH - r242*S*OH - r247*SO*OH - r248*DMS*OH - r250*NH3*OH + d(PO2)/dt = .5*r181*POOH*OH + r186*M*C3H6*OH + - r179*HO2*PO2 - r180*NO*PO2 + d(RO2)/dt = r185*ROOH*OH + r187*CH3COCH3*OH + - r182*CH3O2*RO2 - r183*HO2*RO2 - r184*NO*RO2 + d(XO2)/dt = r209*HYDRALD*OH + .8*r221*ISOPOOH*OH + .5*r229*XOOH*OH + - r224*CH3CO3*XO2 - r225*CH3O2*XO2 - r226*HO2*XO2 - r227*NO*XO2 - r228*NO3*XO2 + d(H2O)/dt = .05*j28*CH4 + j79*H2SO4 + r251*HO2 + r14*H*HO2 + r19*OH*H2 + r20*OH*H2O2 + r21*OH*HO2 + + r24*OH*OH + r27*HO2NO2*OH + r49*HNO3*OH + r73*HCL*OH + r76*HOCL*OH + r102*HBR*OH + + r110*CH2BR2*OH + r112*CH3BR*OH + r113*CH3CCL3*OH + r115*CH3CL*OH + r120*HCFC22*OH + + r128*CH2O*OH + r134*CH3OOH*OH + r135*CH4*OH + r149*C2H6*OH + r151*CH3CHO*OH + r156*CH3COOH*OH + + r157*CH3COOOH*OH + r173*C3H7OOH*OH + r174*C3H8*OH + r176*CH3COCHO*OH + r181*POOH*OH + + r185*ROOH*OH + r187*CH3COCH3*OH + .5*r195*MACR*OH + r250*NH3*OH + r259*HOCL*HCL + + r265*HOCL*HCL + r266*HOBR*HCL + r270*HOCL*HCL + r271*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r2*O1D*H2O - r249*SO3*H2O diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.in b/src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.in new file mode 100644 index 0000000000..afc2928b01 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/chem_mech.in @@ -0,0 +1,804 @@ +* Comments +* User-given Tag Description: TS4-simpleSOA +* Tag database identifier : MZ331_TS4_20230410 +* Tag created by : lke +* Tag created from branch : TS4 +* Tag created on : 2023-04-10 17:47:58.117698-06 +* Comments for this tag follow: +* lke : 2023-04-10 : Reduced TS mechanism for climate simulations with new simple SOA scheme, with MAM5. + + SPECIES + + Solution + bc_a1 -> C, + bc_a4 -> C, + BIGALK -> C5H12, + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + C2H4, + C2H5OH, + C2H5OOH, + C2H6, + C3H6, + C3H7OOH, + C3H8, + CCL4 -> CCl4, + CF2CLBR -> CF2ClBr, + CF3BR -> CF3Br, + CFC11 -> CFCl3, + CFC113 -> CCl2FCClF2, + CFC114 -> CClF2CClF2, + CFC115 -> CClF2CF3, + CFC12 -> CF2Cl2, + CH2BR2 -> CH2Br2, + CH2O, + CH3BR -> CH3Br, + CH3CCL3 -> CH3CCl3, + CH3CHO, + CH3CL -> CH3Cl, + CH3COCH3, + CH3COCHO, + CH3COOH, + CH3COOOH, + CH3OH, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + E90 -> CO, + EOOH -> HOCH2CH2OOH, + GLYALD -> HOCH2CHO, + GLYOXAL -> C2H2O2, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HF, + HNO3, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + HYAC -> CH3COCH2OH, + HYDRALD -> HOCH2CCH3CHCHO, + ISOP -> C5H8, + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, + ISOPOOH -> HOCH2COOHCH3CHCH2, + MACR -> CH2CCH3CHO, + MACROOH -> CH3COCHOOHCH2OH, + MPAN -> CH2CCH3CO3NO2, + MVK -> CH2CHCOCH3, + N, + N2O, + N2O5, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + NH3, + NH4, + NH_5 -> CO, + NH_50 -> CO, + NO, + NO2, + NO3, + NOA -> CH3COCH2ONO2, + num_a1 -> H, + num_a2 -> H, + num_a3 -> H, + num_a4 -> H, + num_a5 -> H, + O, + O3, + O3S -> O3, + OCLO -> OClO, + OCS -> OCS, + ONITR -> C4H7NO4, + PAN -> CH3CO3NO2, + pom_a1 -> C, + pom_a4 -> C, + POOH -> C3H6OHOOH, + ROOH -> CH3COCH2OOH, + S -> S, + SF6, + SO -> SO, + SO2, + SO3 -> SO3, + so4_a1 -> NH4HSO4, + so4_a2 -> NH4HSO4, + so4_a3 -> NH4HSO4, + so4_a5 -> NH4HSO4, + soa_a1 -> C, + soa_a2 -> C, + SOAE -> C, + SOAG -> C, + ST80_25 -> CO, + TERP -> C10H16, + XOOH -> HOCH2COOHCH3CHOHCHO, + NHDEP -> N, + NDEP -> N, + C2H5O2, + C3H7O2, + CH3CO3, + CH3O2, + EO -> HOCH2CH2O, + EO2 -> HOCH2CH2O2, + HO2, + ISOPO2 -> HOCH2COOCH3CHCH2, + MACRO2 -> CH3COCHO2CH2OH, + MCO3 -> CH2CCH3CO3, + O1D -> O, + OH, + PO2 -> C3H6OHO2, + RO2 -> CH3COCH2O2, + XO2 -> HOCH2COOCH3CHOHCHO, + H2O + + End Solution + + + Fixed + M, O2, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + C2H5O2, + C3H7O2, + CH3CO3, + CH3O2, + EO, + EO2, + HO2, + ISOPO2, + MACRO2, + MCO3, + O1D, + OH, + PO2, + RO2, + XO2 + End Not-Transported + + END Species + + + Solution classes + Explicit + NHDEP + NDEP + End Explicit + + Implicit + bc_a1 + bc_a4 + BIGALK + BR + BRCL + BRO + BRONO2 + BRY + C2H4 + C2H5OH + C2H5OOH + C2H6 + C3H6 + C3H7OOH + C3H8 + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH2O + CH3BR + CH3CCL3 + CH3CHO + CH3CL + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CH4 + CHBR3 + CL + CL2 + CL2O2 + CLO + CLONO2 + CLY + CO + CO2 + DMS + dst_a1 + dst_a2 + dst_a3 + E90 + EOOH + GLYALD + GLYOXAL + H + H2 + H2402 + H2O2 + H2SO4 + HBR + HCFC141B + HCFC142B + HCFC22 + HCL + HF + HNO3 + HO2NO2 + HOBR + HOCL + HYAC + HYDRALD + ISOP + ISOPNO3 + ISOPOOH + MACR + MACROOH + MPAN + MVK + N + N2O + N2O5 + ncl_a1 + ncl_a2 + ncl_a3 + NH3 + NH4 + NH_5 + NH_50 + NO + NO2 + NO3 + NOA + num_a1 + num_a2 + num_a3 + num_a4 + num_a5 + O + O3 + O3S + OCLO + OCS + ONITR + PAN + pom_a1 + pom_a4 + POOH + ROOH + S + SF6 + SO + SO2 + SO3 + so4_a1 + so4_a2 + so4_a3 + so4_a5 + soa_a1 + soa_a2 + SOAE + SOAG + ST80_25 + TERP + XOOH + C2H5O2 + C3H7O2 + CH3CO3 + CH3O2 + EO + EO2 + HO2 + ISOPO2 + MACRO2 + MCO3 + O1D + OH + PO2 + RO2 + XO2 + H2O + End Implicit + + End Solution classes + + + CHEMISTRY + Photolysis +********************************* +*** odd-oxygen +********************************* +[jh2o_b] H2O + hv -> H2 + O1D +[jh2o_a] H2O + hv -> OH + H +[jh2o_c] H2O + hv -> 2*H + O +[jh2o2] H2O2 + hv -> 2*OH +[jo2_a=userdefined,] O2 + hv -> O + O1D +[jo2_b=userdefined,] O2 + hv -> 2*O +[jo3_a] O3 + hv -> O1D + O2 +[jo3_b] O3 + hv -> O + O2 +********************************* +*** odd-nitrogen +********************************* +[jhno3] HNO3 + hv -> NO2 + OH +[jho2no2_a] HO2NO2 + hv -> OH + NO3 +[jho2no2_b] HO2NO2 + hv -> NO2 + HO2 +[jn2o] N2O + hv -> O1D + N2 +[jn2o5_a] N2O5 + hv -> NO2 + NO3 +[jn2o5_b] N2O5 + hv -> NO + O + NO3 +[jno=userdefined,] NO + hv -> N + O +[jno2] NO2 + hv -> NO + O +[jno3_b] NO3 + hv -> NO + O2 +[jno3_a] NO3 + hv -> NO2 + O +********************************* +*** organics +********************************* +[jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH +[jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 +[jch2o_a] CH2O + hv -> CO + 2*H +[jch2o_b] CH2O + hv -> CO + H2 +[jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2 +[jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2 +[jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2 +[jch3co3h->,0.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2 +[jch3ooh] CH3OOH + hv -> CH2O + H + OH +[jch4_b] CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H + 0.44*CO2 + 0.38*CO + 0.05*H2O +[jch4_a] CH4 + hv -> H + CH3O2 +[jco2] CO2 + hv -> CO + O +[jeooh->,jch3ooh] EOOH + hv -> EO + OH +[jglyald] GLYALD + hv -> 2*HO2 + CO + CH2O +[jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2 +[jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 +[jmacr_a] MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 +[jmacr_b] MACR + hv -> 0.66*HO2 + 1.34*CO +[jmpan->,jpan] MPAN + hv -> MCO3 + NO2 +[jmvk] MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 +[jnoa->,jch2o_a] NOA + hv -> NO2 + CH2O + CH3CO3 +[jonitr->,jch3cho] ONITR + hv -> HO2 + CO + NO2 + CH2O +[jpan] PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 +[jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH +[jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH +[jxooh->,jch3ooh] XOOH + hv -> OH +********************************* +*** halogens +********************************* +[jbrcl] BRCL + hv -> BR + CL +[jbro] BRO + hv -> BR + O +[jbrono2_b] BRONO2 + hv -> BRO + NO2 +[jbrono2_a] BRONO2 + hv -> BR + NO3 +[jccl4] CCL4 + hv -> 4*CL +[jcf2clbr] CF2CLBR + hv -> BR + CL + COF2 +[jcf3br] CF3BR + hv -> BR + F + COF2 +[jcfcl3] CFC11 + hv -> 3*CL +[jcfc113] CFC113 + hv -> 3*CL +[jcfc114] CFC114 + hv -> 2*CL + 2*COF2 +[jcfc115] CFC115 + hv -> CL + F + 2*COF2 +[jcf2cl2] CFC12 + hv -> 2*CL + COF2 +[jch2br2] CH2BR2 + hv -> 2*BR +[jch3br] CH3BR + hv -> BR + CH3O2 +[jch3ccl3] CH3CCL3 + hv -> 3*CL +[jch3cl] CH3CL + hv -> CL + CH3O2 +[jchbr3] CHBR3 + hv -> 3*BR +[jcl2] CL2 + hv -> 2*CL +[jcl2o2] CL2O2 + hv -> 2*CL +[jclo] CLO + hv -> CL + O +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jclono2_a] CLONO2 + hv -> CL + NO3 +[jh2402] H2402 + hv -> 2*BR + 2*COF2 +[jhbr] HBR + hv -> BR + H +[jhcfc141b] HCFC141B + hv -> CL + COFCL +[jhcfc142b] HCFC142B + hv -> CL + COF2 +[jhcfc22] HCFC22 + hv -> CL + COF2 +[jhcl] HCL + hv -> H + CL +[jhf] HF + hv -> H + F +[jhobr] HOBR + hv -> BR + OH +[jhocl] HOCL + hv -> OH + CL +[joclo] OCLO + hv -> O + CLO +[jsf6] SF6 + hv -> sink +********************************* +*** sulfur +********************************* +[jh2so4] H2SO4 + hv -> SO3 + H2O +[jocs] OCS + hv -> S + CO +[jso] SO + hv -> S + O +[jso2] SO2 + hv -> SO + O +[jso3] SO3 + hv -> SO2 + O +********************************* +*** soa +********************************* +[jsoa_a1->,.0004*jno2] soa_a1 + hv -> +[jsoa_a2->,.0004*jno2] soa_a2 + hv -> + End Photolysis + + Reactions +********************************* +*** odd-oxygen +********************************* +[O1D_H2] O1D + H2 -> H + OH ; 1.2e-10 +[O1D_H2O] O1D + H2O -> 2*OH ; 1.63e-10, 60 +[O1D_N2,cph=189.81] O1D + N2 -> O + N2 ; 2.15e-11, 110 +[O1D_O2ab] O1D + O2 -> O + O2 ; 3.3e-11, 55 +[O1D_O3] O1D + O3 -> O2 + O2 ; 1.2e-10 +[O1D_O3a] O1D + O3 -> O2 + 2*O ; 1.2e-10 +[O_O3,cph=392.19] O + O3 -> 2*O2 ; 8e-12, -2060 +[usr_O_O,cph=493.58] O + O + M -> O2 + M +[usr_O_O2,cph=101.39] O + O2 + M -> O3 + M +********************************* +*** odd-hydrogen +********************************* +[H2_O] H2 + O -> OH + H ; 1.6e-11, -4570 +[H2O2_O] H2O2 + O -> OH + HO2 ; 1.4e-12, -2000 +[H_HO2,cph=232.59] H + HO2 -> H2 + O2 ; 6.9e-12 +[H_HO2a] H + HO2 -> 2*OH ; 7.2e-11 +[H_HO2b] H + HO2 -> H2O + O ; 1.6e-12 +[H_O2,cph=203.4] H + O2 + M -> HO2 + M ; 5.3e-32, 1.8, 9.5e-11, -0.4, 0.6 +[HO2_O,cph=226.58] HO2 + O -> OH + O2 ; 3e-11, 200 +[HO2_O3,cph=120.1] HO2 + O3 -> OH + 2*O2 ; 1e-14, -490 +[H_O3,cph=194.71] H + O3 -> OH + O2 ; 1.4e-10, -470 +[OH_H2] OH + H2 -> H2O + H ; 2.8e-12, -1800 +[OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.8e-12 +[OH_HO2,cph=293.62] OH + HO2 -> H2O + O2 ; 4.8e-11, 250 +[OH_O,cph=67.67] OH + O -> H + O2 ; 1.8e-11, 180 +[OH_O3,cph=165.3] OH + O3 -> HO2 + O2 ; 1.7e-12, -940 +[OH_OH] OH + OH -> H2O + O ; 1.8e-12 +[OH_OH_M] OH + OH + M -> H2O2 + M ; 6.9e-31, 1, 2.6e-11, 0, 0.6 +[usr_HO2_HO2,cph=165.51] HO2 + HO2 -> H2O2 + O2 +********************************* +*** odd-nitrogen +********************************* +[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 4.5e-13, 610 +[N_NO,cph=313.75] N + NO -> N2 + O ; 2.1e-11, 100 +[N_NO2a] N + NO2 -> N2O + O ; 2.9e-12, 220 +[N_NO2b] N + NO2 -> 2*NO ; 1.45e-12, 220 +[N_NO2c] N + NO2 -> N2 + O2 ; 1.45e-12, 220 +[N_O2,cph=133.75] N + O2 -> NO + O ; 3.3e-12, -3150 +[NO2_O,cph=193.02] NO2 + O -> NO + O2 ; 5.1e-12, 210 +[NO2_O3] NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450 +[NO2_O_M] NO2 + O + M -> NO3 + M ; 2.5e-31, 1.8, 2.2e-11, 0.7, 0.6 +[NO3_HO2] NO3 + HO2 -> OH + NO2 + O2 ; 3.5e-12 +[NO3_NO] NO3 + NO -> 2*NO2 ; 1.7e-11, 125 +[NO3_O] NO3 + O -> NO2 + O2 ; 1.3e-11 +[NO3_OH] NO3 + OH -> HO2 + NO2 ; 2.2e-11 +[N_OH] N + OH -> NO + H ; 5e-11 +[NO_HO2,cph=34.47] NO + HO2 -> NO2 + OH ; 3.44e-12, 260 +[NO_O3,cph=199.17] NO + O3 -> NO2 + O2 ; 3e-12, -1500 +[NO_O_M] NO + O + M -> NO2 + M ; 9e-32, 1.5, 3e-11, 0, 0.6 +[O1D_N2Oa] O1D + N2O -> 2*NO ; 7.26e-11, 20 +[O1D_N2Ob] O1D + N2O -> N2 + O2 ; 4.64e-11, 20 +[tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 1.9e-31, 3.4, 4e-12, 0.3, 0.6 +[tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.4e-30, 3, 1.6e-12, -0.1, 0.6 +[tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.8e-30, 3, 2.8e-11, 0, 0.6 +[usr_HNO3_OH] HNO3 + OH -> NO3 + H2O +[usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M +[usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M +********************************* +*** odd-chlorine +********************************* +[CL_CH2O] CL + CH2O -> HCL + HO2 + CO ; 8.1e-11, -30 +[CL_CH4] CL + CH4 -> CH3O2 + HCL ; 7.1e-12, -1270 +[CL_H2] CL + H2 -> HCL + H ; 3.05e-11, -2270 +[CL_H2O2] CL + H2O2 -> HCL + HO2 ; 1.1e-11, -980 +[CL_HO2a] CL + HO2 -> HCL + O2 ; 1.4e-11, 270 +[CL_HO2b] CL + HO2 -> OH + CLO ; 3.6e-11, -375 +[CL_O3] CL + O3 -> CLO + O2 ; 2.3e-11, -200 +[CLO_CH3O2] CLO + CH3O2 -> CL + HO2 + CH2O ; 3.3e-12, -115 +[CLO_CLOa] CLO + CLO -> 2*CL + O2 ; 3e-11, -2450 +[CLO_CLOb] CLO + CLO -> CL2 + O2 ; 1e-12, -1590 +[CLO_CLOc] CLO + CLO -> CL + OCLO ; 3.5e-13, -1370 +[CLO_HO2] CLO + HO2 -> O2 + HOCL ; 2.6e-12, 290 +[CLO_NO] CLO + NO -> NO2 + CL ; 6.4e-12, 290 +[CLONO2_CL] CLONO2 + CL -> CL2 + NO3 ; 6.5e-12, 135 +[CLO_NO2_M] CLO + NO2 + M -> CLONO2 + M ; 1.8e-31, 3.4, 1.5e-11, 1.9, 0.6 +[CLONO2_O] CLONO2 + O -> CLO + NO3 ; 3.6e-12, -840 +[CLONO2_OH] CLONO2 + OH -> HOCL + NO3 ; 1.2e-12, -330 +[CLO_O] CLO + O -> CL + O2 ; 2.8e-11, 85 +[CLO_OHa] CLO + OH -> CL + HO2 ; 7.4e-12, 270 +[CLO_OHb] CLO + OH -> HCL + O2 ; 6e-13, 230 +[HCL_O] HCL + O -> CL + OH ; 1e-11, -3300 +[HCL_OH] HCL + OH -> H2O + CL ; 1.8e-12, -250 +[HOCL_CL] HOCL + CL -> HCL + CLO ; 3.4e-12, -130 +[HOCL_O] HOCL + O -> CLO + OH ; 1.7e-13 +[HOCL_OH] HOCL + OH -> H2O + CLO ; 3e-12, -500 +[O1D_CCL4] O1D + CCL4 -> 4*CL ; 2.607e-10 +[O1D_CF2CLBR] O1D + CF2CLBR -> CL + BR + COF2 ; 9.75e-11 +[O1D_CFC11] O1D + CFC11 -> 3*CL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 3*CL ; 2.088e-10 +[O1D_CFC114] O1D + CFC114 -> 2*CL + 2*COF2 ; 1.17e-10 +[O1D_CFC115] O1D + CFC115 -> CL + F + 2*COF2 ; 4.644e-11 +[O1D_CFC12] O1D + CFC12 -> 2*CL + COF2 ; 1.204e-10 +[O1D_HCLa] O1D + HCL -> CL + OH ; 9.9e-11 +[O1D_HCLb] O1D + HCL -> CLO + H ; 3.3e-12 +[tag_CLO_CLO_M] CLO + CLO + M -> CL2O2 + M ; 1.9e-32, 3.6, 3.7e-12, 1.6, 0.6 +[usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M +********************************* +*** odd-bromine +********************************* +[BR_CH2O] BR + CH2O -> HBR + HO2 + CO ; 1.7e-11, -800 +[BR_HO2] BR + HO2 -> HBR + O2 ; 4.8e-12, -310 +[BR_O3] BR + O3 -> BRO + O2 ; 1.6e-11, -780 +[BRO_BRO] BRO + BRO -> 2*BR + O2 ; 1.5e-12, 230 +[BRO_CLOa] BRO + CLO -> BR + OCLO ; 9.5e-13, 550 +[BRO_CLOb] BRO + CLO -> BR + CL + O2 ; 2.3e-12, 260 +[BRO_CLOc] BRO + CLO -> BRCL + O2 ; 4.1e-13, 290 +[BRO_HO2] BRO + HO2 -> HOBR + O2 ; 4.5e-12, 460 +[BRO_NO] BRO + NO -> BR + NO2 ; 8.8e-12, 260 +[BRO_NO2_M] BRO + NO2 + M -> BRONO2 + M ; 5.2e-31, 3.2, 6.9e-12, 2.9, 0.6 +[BRONO2_O] BRONO2 + O -> BRO + NO3 ; 1.9e-11, 215 +[BRO_O] BRO + O -> BR + O2 ; 1.9e-11, 230 +[BRO_OH] BRO + OH -> BR + HO2 ; 1.7e-11, 250 +[HBR_O] HBR + O -> BR + OH ; 5.8e-12, -1500 +[HBR_OH] HBR + OH -> BR + H2O ; 5.5e-12, 200 +[HOBR_O] HOBR + O -> BRO + OH ; 1.2e-10, -430 +[O1D_CF3BR] O1D + CF3BR -> BR + F + COF2 ; 4.5e-11 +[O1D_CHBR3] O1D + CHBR3 -> 3*BR ; 4.62e-10 +[O1D_H2402] O1D + H2402 -> 2*BR + 2*COF2 ; 1.2e-10 +[O1D_HBRa] O1D + HBR -> BR + OH ; 9e-11 +[O1D_HBRb] O1D + HBR -> BRO + H ; 3e-11 +********************************* +*** organic-halogens +********************************* +[CH2BR2_CL] CH2BR2 + CL -> 2*BR + HCL ; 6.3e-12, -800 +[CH2BR2_OH] CH2BR2 + OH -> 2*BR + H2O ; 2e-12, -840 +[CH3BR_CL] CH3BR + CL -> HCL + HO2 + BR ; 1.46e-11, -1040 +[CH3BR_OH] CH3BR + OH -> BR + H2O + HO2 ; 1.42e-12, -1150 +[CH3CCL3_OH] CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520 +[CH3CL_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.03e-11, -1100 +[CH3CL_OH] CH3CL + OH -> CL + H2O + HO2 ; 1.96e-12, -1200 +[CHBR3_CL] CHBR3 + CL -> 3*BR + HCL ; 4.85e-12, -850 +[CHBR3_OH] CHBR3 + OH -> 3*BR ; 9e-13, -360 +[HCFC141B_OH] HCFC141B + OH -> CL + CL ; 1.25e-12, -1600 +[HCFC142B_OH] HCFC142B + OH -> CL + COF2 ; 1.3e-12, -1770 +[HCFC22_OH] HCFC22 + OH -> H2O + CL + COF2 ; 9.2e-13, -1560 +[O1D_CH2BR2] O1D + CH2BR2 -> 2*BR ; 2.57e-10 +[O1D_CH3BR] O1D + CH3BR -> BR ; 1.8e-10 +[O1D_HCFC141B] O1D + HCFC141B -> CL + CL ; 1.794e-10 +[O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.3e-10 +[O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.65e-11 +********************************* +*** C1 +********************************* +[CH2O_NO3] CH2O + NO3 -> CO + HO2 + HNO3 ; 6e-13, -2058 +[CH2O_O] CH2O + O -> HO2 + OH + CO ; 3.4e-11, -1600 +[CH2O_OH] CH2O + OH -> CO + H2O + H ; 5.5e-12, 125 +[CH3O2_CH3O2a] CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 ; 5e-13, -424 +[CH3O2_CH3O2b] CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14, 706 +[CH3O2_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750 +[CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 +[CH3OH_OH] CH3OH + OH -> HO2 + CH2O ; 2.9e-12, -345 +[CH3OOH_OH] CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O ; 3.8e-12, 200 +[CH4_OH] CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775 +[O1D_CH4a] O1D + CH4 -> CH3O2 + OH ; 1.31e-10 +[O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.5e-11 +[O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9e-12 +[usr_CO_OH] CO + OH -> CO2 + HO2 +********************************* +*** C2 +********************************* +[C2H4_CL_M] C2H4 + CL + M -> CL + M ; 1.6e-29, 3.3, 3.1e-10, 1, 0.6 +[C2H4_O3] C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O ; 1.2e-14, -2630 +[C2H5O2_C2H5O2] C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH ; 6.8e-14 +[C2H5O2_CH3O2] C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH + 0.2*C2H5OH ; 2e-13 +[C2H5O2_HO2] C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700 +[C2H5O2_NO] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365 +[C2H5OH_OH] C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12, -230 +[C2H5OOH_OH] C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH ; 3.8e-12, 200 +[C2H6_CL] C2H6 + CL -> HCL + C2H5O2 ; 7.2e-11, -70 +[C2H6_OH] C2H6 + OH -> C2H5O2 + H2O ; 7.66e-12, -1020 +[CH3CHO_NO3] CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900 +[CH3CHO_OH] CH3CHO + OH -> CH3CO3 + H2O ; 4.63e-12, 350 +[CH3CO3_CH3CO3] CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.9e-12, 500 +[CH3CO3_CH3O2] CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 + 0.1*CH3COOH ; 2e-12, 500 +[CH3CO3_HO2] CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH + 0.45*CH3O2 ; 4.3e-13, 1040 +[CH3CO3_NO] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270 +[CH3COOH_OH] CH3COOH + OH -> CH3O2 + CO2 + H2O ; 3.15e-14, 920 +[CH3COOOH_OH] CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O ; 1e-12 +[EO2_HO2] EO2 + HO2 -> EOOH ; 7.5e-13, 700 +[EO2_NO] EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 ; 4.2e-12, 180 +[EO_M] EO -> 2*CH2O + HO2 ; 1.6e+11, -4150 +[EO_O2] EO + O2 -> GLYALD + HO2 ; 1e-14 +[GLYALD_OH] GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 ; 1e-11 +[GLYOXAL_OH] GLYOXAL + OH -> HO2 + CO + CO2 ; 1.15e-11 +[PAN_OH] PAN + OH -> CH2O + NO3 ; 4e-14 +[tag_C2H4_OH] C2H4 + OH + M -> EO2 + M ; 8.6e-29, 3.1, 9e-12, 0.85, 0.48 +[tag_CH3CO3_NO2] CH3CO3 + NO2 + M -> PAN + M ; 7.3e-29, 4.1, 9.5e-12, 1.6, 0.6 +[usr_PAN_M] PAN + M -> CH3CO3 + NO2 + M +********************************* +*** C3 +********************************* +[C3H6_NO3] C3H6 + NO3 -> NOA ; 4.6e-13, -1156 +[C3H6_O3] C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + 0.36*OH ; 6.5e-15, -1900 +[C3H7O2_CH3O2] C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 ; 3.75e-13, -40 +[C3H7O2_HO2] C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700 +[C3H7O2_NO] C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO ; 4.2e-12, 180 +[C3H7OOH_OH] C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200 +[C3H8_OH] C3H8 + OH -> C3H7O2 + H2O ; 9.19e-12, -630 +[CH3COCHO_NO3] CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860 +[CH3COCHO_OH] CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13, 830 +[HYAC_OH] HYAC + OH -> CH3COCHO + HO2 ; 3e-12 +[NOA_OH] NOA + OH -> NO2 + CH3COCHO ; 6.7e-13 +[PO2_HO2] PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700 +[PO2_NO] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180 +[POOH_OH] POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O ; 3.8e-12, 200 +[RO2_CH3O2] RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC + 0.5*CH3COCHO + 0.5*CH3OH ; 7.1e-13, 500 +[RO2_HO2] RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 ; 8.6e-13, 700 +[RO2_NO] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300 +[ROOH_OH] ROOH + OH -> RO2 + H2O ; 3.8e-12, 200 +[tag_C3H6_OH] C3H6 + OH + M -> PO2 + M ; 8e-27, 3.5, 3e-11, 0, 0.5 +[usr_CH3COCH3_OH] CH3COCH3 + OH -> RO2 + H2O +********************************* +*** C4 +********************************* +[MACRO2_CH3CO3] MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + 0.53*CH3CO3 ; 1.4e-11 +[MACRO2_CH3O2] MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + 0.23*HYAC ; 5e-13, 400 +[MACRO2_HO2] MACRO2 + HO2 -> MACROOH ; 8e-13, 700 +[MACRO2_NO3] MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 ; 2.4e-12 +[MACRO2_NOa] MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO ; 2.7e-12, 360 +[MACRO2_NOb] MACRO2 + NO -> 0.8*ONITR ; 1.3e-13, 360 +[MACR_O3] MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 ; 1.5e-15, -2100 +[MACR_OH] MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 ; 9.6e-12, 360 +[MACROOH_OH] MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 ; 2.3e-11, 200 +[MCO3_CH3CO3] MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530 +[MCO3_CH3O2] MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 ; 2e-12, 500 +[MCO3_HO2] MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 ; 4.3e-13, 1040 +[MCO3_MCO3] MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 ; 2.3e-12, 530 +[MCO3_NO] MCO3 + NO -> NO2 + CH2O + CH3CO3 ; 5.3e-12, 360 +[MCO3_NO3] MCO3 + NO3 -> NO2 + CH2O + CH3CO3 ; 5e-12 +[MPAN_OH_M] MPAN + OH + M -> 0.5*HYAC + 0.5*NO3 + 0.5*CH2O + 0.5*HO2 + 0.5*CO2 + M + 0.5*NDEP ; 8e-27, 3.5, 3e-11, 0, 0.5 +[MVK_O3] MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH ; 8.5e-16, -1520 +[MVK_OH] MVK + OH -> MACRO2 ; 4.13e-12, 452 +[tag_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M +********************************* +*** C5 +********************************* +[BIGALK_OH] BIGALK + OH -> 1.67*C3H7O2 ; 3.5e-12 +[HYDRALD_OH] HYDRALD + OH -> XO2 ; 1.86e-11, 175 +[ISOP_NO3] ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446 +[ISOPNO3_HO2] ISOPNO3 + HO2 -> 0.206*NO2 + 0.206*CH2O + 0.206*OH + 0.167*MACR + 0.039*MVK + 0.794*ONITR ; 8e-13, 700 +[ISOPNO3_NO] ISOPNO3 + NO -> 1.206*NO2 + 0.794*HO2 + 0.072*CH2O + 0.167*MACR + 0.039*MVK + 0.794*ONITR ; 2.7e-12, 360 +[ISOPNO3_NO3] ISOPNO3 + NO3 -> 1.206*NO2 + 0.072*CH2O + 0.167*MACR + 0.039*MVK + 0.794*ONITR + 0.794*HO2 ; 2.4e-12 +[ISOPO2_CH3CO3] ISOPO2 + CH3CO3 -> CH3O2 + HO2 + 0.6*CH2O + 0.25*MACR + 0.35*MVK + 0.4*HYDRALD ; 1.4e-11 +[ISOPO2_CH3O2] ISOPO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.2*CH2O + 0.19*MACR + 0.26*MVK + 0.3*HYDRALD ; 5e-13, 400 +[ISOPO2_HO2] ISOPO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPO2_NO] ISOPO2 + NO -> 0.08*ONITR + 0.92*NO2 + 0.23*MACR + 0.32*MVK + 0.33*HYDRALD + 0.02*GLYOXAL + 0.02*GLYALD + 0.02*CH3COCHO + 0.02*HYAC + 0.55*CH2O + 0.92*HO2 ; 4.4e-12, 180 +[ISOPO2_NO3] ISOPO2 + NO3 -> HO2 + NO2 + 0.6*CH2O + 0.25*MACR + 0.35*MVK + 0.4*HYDRALD ; 2.4e-12 +[ISOP_O3] ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + 0.05*CH3O2 ; 1.05e-14, -2000 +[ISOP_OH] ISOP + OH -> ISOPO2 ; 2.54e-11, 410 +[ISOPOOH_OH] ISOPOOH + OH -> 0.8*XO2 + 0.2*ISOPO2 ; 1.52e-11, 200 +[ONITR_NO3] ONITR + NO3 -> HO2 + NO2 + HYDRALD ; 1.4e-12, -1860 +[ONITR_OH] ONITR + OH -> HYDRALD + 0.4*NO2 + HO2 ; 4.5e-11 +[XO2_CH3CO3] XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 ; 1.3e-12, 640 +[XO2_CH3O2] XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD ; 5e-13, 400 +[XO2_HO2] XO2 + HO2 -> XOOH ; 8e-13, 700 +[XO2_NO] XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD ; 2.7e-12, 360 +[XO2_NO3] XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL + 0.25*CH3COCHO + 0.25*GLYALD ; 2.4e-12 +[XOOH_OH] XOOH + OH -> 0.5*XO2 + 0.5*OH ; 1.52e-12, 200 +********************************* +*** C10 +********************************* +[TERP_NO3] TERP + NO3 -> 1.7*ISOPO2 + NO2 ; 1.2e-12, 490 +[TERP_O3] TERP + O3 -> 1.122*MACR + 0.442*MVK + 0.765*O + 1.156*OH ; 6.3e-16, -580 +[TERP_OH] TERP + OH -> 1.64*ISOPO2 + 0.1*CH3COCH3 ; 1.2e-11, 440 +********************************* +*** Sulfur +********************************* +[DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 +[DMS_OHa] DMS + OH -> SO2 ; 1.1e-11, -280 +[OCS_O] OCS + O -> SO + CO ; 2.1e-11, -2200 +[OCS_OH] OCS + OH -> SO2 + CO + H ; 7.2e-14, -1070 +[S_O2] S + O2 -> SO + O ; 2.3e-12 +[SO2_OH_M] SO2 + OH + M -> SO3 + HO2 ; 2.9e-31, 4.1, 1.7e-12, -0.2, 0.6 +[S_O3] S + O3 -> SO + O2 ; 1.2e-11 +[SO_BRO] SO + BRO -> SO2 + BR ; 5.7e-11 +[SO_CLO] SO + CLO -> SO2 + CL ; 2.8e-11 +[S_OH] S + OH -> SO + H ; 6.6e-11 +[SO_NO2] SO + NO2 -> SO2 + NO ; 1.4e-11 +[SO_O2] SO + O2 -> SO2 + O ; 1.6e-13, -2280 +[SO_O3] SO + O3 -> SO2 + O2 ; 3.4e-12, -1100 +[SO_OCLO] SO + OCLO -> SO2 + CLO ; 1.9e-12 +[SO_OH] SO + OH -> SO2 + H ; 2.6e-11, 330 +[usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 +[usr_SO3_H2O] SO3 + H2O -> H2SO4 +********************************* +*** Tropospheric Aerosol +********************************* +[NH3_OH] NH3 + OH -> H2O + 1*NHDEP ; 1.7e-12, -710 +[usr_HO2_aer] HO2 -> H2O +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NH4_strat_tau] NH4 -> 1*NHDEP ; 6.34e-08 +[usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 +[usr_NO3_aer] NO3 -> HNO3 +[usr_ONITR_aer] ONITR -> HNO3 +********************************* +*** SOA +********************************* +[SOAE_tau] SOAE -> SOAG ; 1.157e-05 +********************************* +*** Stratospheric Aerosol +********************************* +[het1] N2O5 -> 2*HNO3 +[het10] HOCL + HCL -> CL2 + H2O +[het11] BRONO2 -> HOBR + HNO3 +[het12] N2O5 -> 2*HNO3 +[het13] CLONO2 -> HOCL + HNO3 +[het14] BRONO2 -> HOBR + HNO3 +[het15] CLONO2 + HCL -> CL2 + HNO3 +[het16] HOCL + HCL -> CL2 + H2O +[het17] HOBR + HCL -> BRCL + H2O +[het2] CLONO2 -> HOCL + HNO3 +[het3] BRONO2 -> HOBR + HNO3 +[het4] CLONO2 + HCL -> CL2 + HNO3 +[het5] HOCL + HCL -> CL2 + H2O +[het6] HOBR + HCL -> BRCL + H2O +[het7] N2O5 -> 2*HNO3 +[het8] CLONO2 -> HOCL + HNO3 +[het9] CLONO2 + HCL -> CL2 + HNO3 +********************************* +*** Tracers +********************************* +[E90_tau] E90 -> sink ; 1.29e-07 +[NH_50_tau] NH_50 -> ; 2.31e-07 +[NH_5_tau] NH_5 -> ; 2.31e-06 +[ST80_25_tau] ST80_25 -> ; 4.63e-07 + End Reactions + + Ext Forcing + NO2 <- dataset + so4_a2 <- dataset + SO2 <- dataset + so4_a1 <- dataset + num_a2 <- dataset + num_a1 <- dataset + bc_a4 <- dataset + num_a4 <- dataset + NO + End Ext Forcing + + End Chemistry + + SIMULATION PARAMETERS + + Version Options + machine = nec + model = cam + model_architecture = VECTOR + vector_length = 32 + architecture = hybrid + namemod = on + End Version Options + + + End Simulation Parameters diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/chem_mods.F90 new file mode 100644 index 0000000000..3c9024e6f9 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/chem_mods.F90 @@ -0,0 +1,51 @@ + module chem_mods +!-------------------------------------------------------------- +! ... Basic chemistry parameters and arrays +!-------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + save + integer, parameter :: phtcnt = 85, & ! number of photolysis reactions + rxntot = 363, & ! number of total reactions + gascnt = 278, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 141, & ! number of "gas phase" species + nfs = 3, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 1307, & ! number of non-zero matrix entries + extcnt = 9, & ! number of species with external forcing + clscnt1 = 2, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 139, & ! number of species in implicit class + clscnt5 = 0, & ! number of species in rodas class + indexm = 1, & ! index of total atm density in invariant array + indexh2o = 0, & ! index of water vapor density + clsze = 1, & ! loop length for implicit chemistry + rxt_tag_cnt = 363, & + enthalpy_cnt = 18, & + nslvd = 15 + integer :: clscnt(5) = 0 + integer :: cls_rxt_cnt(4,5) = 0 + integer :: clsmap(gas_pcnst,5) = 0 + integer :: permute(gas_pcnst,5) = 0 + integer :: diag_map(clscnt4) = 0 + real(r8) :: adv_mass(gas_pcnst) = 0._r8 + real(r8) :: crb_mass(gas_pcnst) = 0._r8 + real(r8) :: fix_mass(max(1,nfs)) + real(r8), allocatable :: cph_enthalpy(:) + integer, allocatable :: cph_rid(:) + integer, allocatable :: num_rnts(:) + integer, allocatable :: rxt_tag_map(:) + real(r8), allocatable :: pht_alias_mult(:,:) + character(len=32), allocatable :: rxt_tag_lst(:) + character(len=16), allocatable :: pht_alias_lst(:,:) + character(len=16) :: inv_lst(max(1,nfs)) + character(len=16) :: extfrc_lst(max(1,extcnt)) + logical :: frc_from_dataset(max(1,extcnt)) + logical :: is_vector + logical :: is_scalar + character(len=16) :: slvd_lst(max(1,nslvd)) + integer, parameter :: veclen = 32 + end module chem_mods diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/m_rxt_id.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/m_rxt_id.F90 new file mode 100644 index 0000000000..b11d3b8ba0 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/m_rxt_id.F90 @@ -0,0 +1,366 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o_b = 1 + integer, parameter :: rid_jh2o_a = 2 + integer, parameter :: rid_jh2o_c = 3 + integer, parameter :: rid_jh2o2 = 4 + integer, parameter :: rid_jo2_a = 5 + integer, parameter :: rid_jo2_b = 6 + integer, parameter :: rid_jo3_a = 7 + integer, parameter :: rid_jo3_b = 8 + integer, parameter :: rid_jhno3 = 9 + integer, parameter :: rid_jho2no2_a = 10 + integer, parameter :: rid_jho2no2_b = 11 + integer, parameter :: rid_jn2o = 12 + integer, parameter :: rid_jn2o5_a = 13 + integer, parameter :: rid_jn2o5_b = 14 + integer, parameter :: rid_jno = 15 + integer, parameter :: rid_jno2 = 16 + integer, parameter :: rid_jno3_b = 17 + integer, parameter :: rid_jno3_a = 18 + integer, parameter :: rid_jc2h5ooh = 19 + integer, parameter :: rid_jc3h7ooh = 20 + integer, parameter :: rid_jch2o_a = 21 + integer, parameter :: rid_jch2o_b = 22 + integer, parameter :: rid_jch3cho = 23 + integer, parameter :: rid_jacet = 24 + integer, parameter :: rid_jmgly = 25 + integer, parameter :: rid_jch3co3h = 26 + integer, parameter :: rid_jch3ooh = 27 + integer, parameter :: rid_jch4_b = 28 + integer, parameter :: rid_jch4_a = 29 + integer, parameter :: rid_jco2 = 30 + integer, parameter :: rid_jeooh = 31 + integer, parameter :: rid_jglyald = 32 + integer, parameter :: rid_jglyoxal = 33 + integer, parameter :: rid_jhyac = 34 + integer, parameter :: rid_jisopooh = 35 + integer, parameter :: rid_jmacr_a = 36 + integer, parameter :: rid_jmacr_b = 37 + integer, parameter :: rid_jmpan = 38 + integer, parameter :: rid_jmvk = 39 + integer, parameter :: rid_jnoa = 40 + integer, parameter :: rid_jonitr = 41 + integer, parameter :: rid_jpan = 42 + integer, parameter :: rid_jpooh = 43 + integer, parameter :: rid_jrooh = 44 + integer, parameter :: rid_jxooh = 45 + integer, parameter :: rid_jbrcl = 46 + integer, parameter :: rid_jbro = 47 + integer, parameter :: rid_jbrono2_b = 48 + integer, parameter :: rid_jbrono2_a = 49 + integer, parameter :: rid_jccl4 = 50 + integer, parameter :: rid_jcf2clbr = 51 + integer, parameter :: rid_jcf3br = 52 + integer, parameter :: rid_jcfcl3 = 53 + integer, parameter :: rid_jcfc113 = 54 + integer, parameter :: rid_jcfc114 = 55 + integer, parameter :: rid_jcfc115 = 56 + integer, parameter :: rid_jcf2cl2 = 57 + integer, parameter :: rid_jch2br2 = 58 + integer, parameter :: rid_jch3br = 59 + integer, parameter :: rid_jch3ccl3 = 60 + integer, parameter :: rid_jch3cl = 61 + integer, parameter :: rid_jchbr3 = 62 + integer, parameter :: rid_jcl2 = 63 + integer, parameter :: rid_jcl2o2 = 64 + integer, parameter :: rid_jclo = 65 + integer, parameter :: rid_jclono2_b = 66 + integer, parameter :: rid_jclono2_a = 67 + integer, parameter :: rid_jh2402 = 68 + integer, parameter :: rid_jhbr = 69 + integer, parameter :: rid_jhcfc141b = 70 + integer, parameter :: rid_jhcfc142b = 71 + integer, parameter :: rid_jhcfc22 = 72 + integer, parameter :: rid_jhcl = 73 + integer, parameter :: rid_jhf = 74 + integer, parameter :: rid_jhobr = 75 + integer, parameter :: rid_jhocl = 76 + integer, parameter :: rid_joclo = 77 + integer, parameter :: rid_jsf6 = 78 + integer, parameter :: rid_jh2so4 = 79 + integer, parameter :: rid_jocs = 80 + integer, parameter :: rid_jso = 81 + integer, parameter :: rid_jso2 = 82 + integer, parameter :: rid_jso3 = 83 + integer, parameter :: rid_jsoa_a1 = 84 + integer, parameter :: rid_jsoa_a2 = 85 + integer, parameter :: rid_O1D_H2 = 86 + integer, parameter :: rid_O1D_H2O = 87 + integer, parameter :: rid_O1D_N2 = 88 + integer, parameter :: rid_O1D_O2ab = 89 + integer, parameter :: rid_O1D_O3 = 90 + integer, parameter :: rid_O1D_O3a = 91 + integer, parameter :: rid_O_O3 = 92 + integer, parameter :: rid_usr_O_O = 93 + integer, parameter :: rid_usr_O_O2 = 94 + integer, parameter :: rid_H2_O = 95 + integer, parameter :: rid_H2O2_O = 96 + integer, parameter :: rid_H_HO2 = 97 + integer, parameter :: rid_H_HO2a = 98 + integer, parameter :: rid_H_HO2b = 99 + integer, parameter :: rid_H_O2 = 100 + integer, parameter :: rid_HO2_O = 101 + integer, parameter :: rid_HO2_O3 = 102 + integer, parameter :: rid_H_O3 = 103 + integer, parameter :: rid_OH_H2 = 104 + integer, parameter :: rid_OH_H2O2 = 105 + integer, parameter :: rid_OH_HO2 = 106 + integer, parameter :: rid_OH_O = 107 + integer, parameter :: rid_OH_O3 = 108 + integer, parameter :: rid_OH_OH = 109 + integer, parameter :: rid_OH_OH_M = 110 + integer, parameter :: rid_usr_HO2_HO2 = 111 + integer, parameter :: rid_HO2NO2_OH = 112 + integer, parameter :: rid_N_NO = 113 + integer, parameter :: rid_N_NO2a = 114 + integer, parameter :: rid_N_NO2b = 115 + integer, parameter :: rid_N_NO2c = 116 + integer, parameter :: rid_N_O2 = 117 + integer, parameter :: rid_NO2_O = 118 + integer, parameter :: rid_NO2_O3 = 119 + integer, parameter :: rid_NO2_O_M = 120 + integer, parameter :: rid_NO3_HO2 = 121 + integer, parameter :: rid_NO3_NO = 122 + integer, parameter :: rid_NO3_O = 123 + integer, parameter :: rid_NO3_OH = 124 + integer, parameter :: rid_N_OH = 125 + integer, parameter :: rid_NO_HO2 = 126 + integer, parameter :: rid_NO_O3 = 127 + integer, parameter :: rid_NO_O_M = 128 + integer, parameter :: rid_O1D_N2Oa = 129 + integer, parameter :: rid_O1D_N2Ob = 130 + integer, parameter :: rid_tag_NO2_HO2 = 131 + integer, parameter :: rid_tag_NO2_NO3 = 132 + integer, parameter :: rid_tag_NO2_OH = 133 + integer, parameter :: rid_usr_HNO3_OH = 134 + integer, parameter :: rid_usr_HO2NO2_M = 135 + integer, parameter :: rid_usr_N2O5_M = 136 + integer, parameter :: rid_CL_CH2O = 137 + integer, parameter :: rid_CL_CH4 = 138 + integer, parameter :: rid_CL_H2 = 139 + integer, parameter :: rid_CL_H2O2 = 140 + integer, parameter :: rid_CL_HO2a = 141 + integer, parameter :: rid_CL_HO2b = 142 + integer, parameter :: rid_CL_O3 = 143 + integer, parameter :: rid_CLO_CH3O2 = 144 + integer, parameter :: rid_CLO_CLOa = 145 + integer, parameter :: rid_CLO_CLOb = 146 + integer, parameter :: rid_CLO_CLOc = 147 + integer, parameter :: rid_CLO_HO2 = 148 + integer, parameter :: rid_CLO_NO = 149 + integer, parameter :: rid_CLONO2_CL = 150 + integer, parameter :: rid_CLO_NO2_M = 151 + integer, parameter :: rid_CLONO2_O = 152 + integer, parameter :: rid_CLONO2_OH = 153 + integer, parameter :: rid_CLO_O = 154 + integer, parameter :: rid_CLO_OHa = 155 + integer, parameter :: rid_CLO_OHb = 156 + integer, parameter :: rid_HCL_O = 157 + integer, parameter :: rid_HCL_OH = 158 + integer, parameter :: rid_HOCL_CL = 159 + integer, parameter :: rid_HOCL_O = 160 + integer, parameter :: rid_HOCL_OH = 161 + integer, parameter :: rid_O1D_CCL4 = 162 + integer, parameter :: rid_O1D_CF2CLBR = 163 + integer, parameter :: rid_O1D_CFC11 = 164 + integer, parameter :: rid_O1D_CFC113 = 165 + integer, parameter :: rid_O1D_CFC114 = 166 + integer, parameter :: rid_O1D_CFC115 = 167 + integer, parameter :: rid_O1D_CFC12 = 168 + integer, parameter :: rid_O1D_HCLa = 169 + integer, parameter :: rid_O1D_HCLb = 170 + integer, parameter :: rid_tag_CLO_CLO_M = 171 + integer, parameter :: rid_usr_CL2O2_M = 172 + integer, parameter :: rid_BR_CH2O = 173 + integer, parameter :: rid_BR_HO2 = 174 + integer, parameter :: rid_BR_O3 = 175 + integer, parameter :: rid_BRO_BRO = 176 + integer, parameter :: rid_BRO_CLOa = 177 + integer, parameter :: rid_BRO_CLOb = 178 + integer, parameter :: rid_BRO_CLOc = 179 + integer, parameter :: rid_BRO_HO2 = 180 + integer, parameter :: rid_BRO_NO = 181 + integer, parameter :: rid_BRO_NO2_M = 182 + integer, parameter :: rid_BRONO2_O = 183 + integer, parameter :: rid_BRO_O = 184 + integer, parameter :: rid_BRO_OH = 185 + integer, parameter :: rid_HBR_O = 186 + integer, parameter :: rid_HBR_OH = 187 + integer, parameter :: rid_HOBR_O = 188 + integer, parameter :: rid_O1D_CF3BR = 189 + integer, parameter :: rid_O1D_CHBR3 = 190 + integer, parameter :: rid_O1D_H2402 = 191 + integer, parameter :: rid_O1D_HBRa = 192 + integer, parameter :: rid_O1D_HBRb = 193 + integer, parameter :: rid_CH2BR2_CL = 194 + integer, parameter :: rid_CH2BR2_OH = 195 + integer, parameter :: rid_CH3BR_CL = 196 + integer, parameter :: rid_CH3BR_OH = 197 + integer, parameter :: rid_CH3CCL3_OH = 198 + integer, parameter :: rid_CH3CL_CL = 199 + integer, parameter :: rid_CH3CL_OH = 200 + integer, parameter :: rid_CHBR3_CL = 201 + integer, parameter :: rid_CHBR3_OH = 202 + integer, parameter :: rid_HCFC141B_OH = 203 + integer, parameter :: rid_HCFC142B_OH = 204 + integer, parameter :: rid_HCFC22_OH = 205 + integer, parameter :: rid_O1D_CH2BR2 = 206 + integer, parameter :: rid_O1D_CH3BR = 207 + integer, parameter :: rid_O1D_HCFC141B = 208 + integer, parameter :: rid_O1D_HCFC142B = 209 + integer, parameter :: rid_O1D_HCFC22 = 210 + integer, parameter :: rid_CH2O_NO3 = 211 + integer, parameter :: rid_CH2O_O = 212 + integer, parameter :: rid_CH2O_OH = 213 + integer, parameter :: rid_CH3O2_CH3O2a = 214 + integer, parameter :: rid_CH3O2_CH3O2b = 215 + integer, parameter :: rid_CH3O2_HO2 = 216 + integer, parameter :: rid_CH3O2_NO = 217 + integer, parameter :: rid_CH3OH_OH = 218 + integer, parameter :: rid_CH3OOH_OH = 219 + integer, parameter :: rid_CH4_OH = 220 + integer, parameter :: rid_O1D_CH4a = 221 + integer, parameter :: rid_O1D_CH4b = 222 + integer, parameter :: rid_O1D_CH4c = 223 + integer, parameter :: rid_usr_CO_OH = 224 + integer, parameter :: rid_C2H4_CL_M = 225 + integer, parameter :: rid_C2H4_O3 = 226 + integer, parameter :: rid_C2H5O2_C2H5O2 = 227 + integer, parameter :: rid_C2H5O2_CH3O2 = 228 + integer, parameter :: rid_C2H5O2_HO2 = 229 + integer, parameter :: rid_C2H5O2_NO = 230 + integer, parameter :: rid_C2H5OH_OH = 231 + integer, parameter :: rid_C2H5OOH_OH = 232 + integer, parameter :: rid_C2H6_CL = 233 + integer, parameter :: rid_C2H6_OH = 234 + integer, parameter :: rid_CH3CHO_NO3 = 235 + integer, parameter :: rid_CH3CHO_OH = 236 + integer, parameter :: rid_CH3CO3_CH3CO3 = 237 + integer, parameter :: rid_CH3CO3_CH3O2 = 238 + integer, parameter :: rid_CH3CO3_HO2 = 239 + integer, parameter :: rid_CH3CO3_NO = 240 + integer, parameter :: rid_CH3COOH_OH = 241 + integer, parameter :: rid_CH3COOOH_OH = 242 + integer, parameter :: rid_EO2_HO2 = 243 + integer, parameter :: rid_EO2_NO = 244 + integer, parameter :: rid_EO_M = 245 + integer, parameter :: rid_EO_O2 = 246 + integer, parameter :: rid_GLYALD_OH = 247 + integer, parameter :: rid_GLYOXAL_OH = 248 + integer, parameter :: rid_PAN_OH = 249 + integer, parameter :: rid_tag_C2H4_OH = 250 + integer, parameter :: rid_tag_CH3CO3_NO2 = 251 + integer, parameter :: rid_usr_PAN_M = 252 + integer, parameter :: rid_C3H6_NO3 = 253 + integer, parameter :: rid_C3H6_O3 = 254 + integer, parameter :: rid_C3H7O2_CH3O2 = 255 + integer, parameter :: rid_C3H7O2_HO2 = 256 + integer, parameter :: rid_C3H7O2_NO = 257 + integer, parameter :: rid_C3H7OOH_OH = 258 + integer, parameter :: rid_C3H8_OH = 259 + integer, parameter :: rid_CH3COCHO_NO3 = 260 + integer, parameter :: rid_CH3COCHO_OH = 261 + integer, parameter :: rid_HYAC_OH = 262 + integer, parameter :: rid_NOA_OH = 263 + integer, parameter :: rid_PO2_HO2 = 264 + integer, parameter :: rid_PO2_NO = 265 + integer, parameter :: rid_POOH_OH = 266 + integer, parameter :: rid_RO2_CH3O2 = 267 + integer, parameter :: rid_RO2_HO2 = 268 + integer, parameter :: rid_RO2_NO = 269 + integer, parameter :: rid_ROOH_OH = 270 + integer, parameter :: rid_tag_C3H6_OH = 271 + integer, parameter :: rid_usr_CH3COCH3_OH = 272 + integer, parameter :: rid_MACRO2_CH3CO3 = 273 + integer, parameter :: rid_MACRO2_CH3O2 = 274 + integer, parameter :: rid_MACRO2_HO2 = 275 + integer, parameter :: rid_MACRO2_NO3 = 276 + integer, parameter :: rid_MACRO2_NOa = 277 + integer, parameter :: rid_MACRO2_NOb = 278 + integer, parameter :: rid_MACR_O3 = 279 + integer, parameter :: rid_MACR_OH = 280 + integer, parameter :: rid_MACROOH_OH = 281 + integer, parameter :: rid_MCO3_CH3CO3 = 282 + integer, parameter :: rid_MCO3_CH3O2 = 283 + integer, parameter :: rid_MCO3_HO2 = 284 + integer, parameter :: rid_MCO3_MCO3 = 285 + integer, parameter :: rid_MCO3_NO = 286 + integer, parameter :: rid_MCO3_NO3 = 287 + integer, parameter :: rid_MPAN_OH_M = 288 + integer, parameter :: rid_MVK_O3 = 289 + integer, parameter :: rid_MVK_OH = 290 + integer, parameter :: rid_tag_MCO3_NO2 = 291 + integer, parameter :: rid_usr_MPAN_M = 292 + integer, parameter :: rid_BIGALK_OH = 293 + integer, parameter :: rid_HYDRALD_OH = 294 + integer, parameter :: rid_ISOP_NO3 = 295 + integer, parameter :: rid_ISOPNO3_HO2 = 296 + integer, parameter :: rid_ISOPNO3_NO = 297 + integer, parameter :: rid_ISOPNO3_NO3 = 298 + integer, parameter :: rid_ISOPO2_CH3CO3 = 299 + integer, parameter :: rid_ISOPO2_CH3O2 = 300 + integer, parameter :: rid_ISOPO2_HO2 = 301 + integer, parameter :: rid_ISOPO2_NO = 302 + integer, parameter :: rid_ISOPO2_NO3 = 303 + integer, parameter :: rid_ISOP_O3 = 304 + integer, parameter :: rid_ISOP_OH = 305 + integer, parameter :: rid_ISOPOOH_OH = 306 + integer, parameter :: rid_ONITR_NO3 = 307 + integer, parameter :: rid_ONITR_OH = 308 + integer, parameter :: rid_XO2_CH3CO3 = 309 + integer, parameter :: rid_XO2_CH3O2 = 310 + integer, parameter :: rid_XO2_HO2 = 311 + integer, parameter :: rid_XO2_NO = 312 + integer, parameter :: rid_XO2_NO3 = 313 + integer, parameter :: rid_XOOH_OH = 314 + integer, parameter :: rid_TERP_NO3 = 315 + integer, parameter :: rid_TERP_O3 = 316 + integer, parameter :: rid_TERP_OH = 317 + integer, parameter :: rid_DMS_NO3 = 318 + integer, parameter :: rid_DMS_OHa = 319 + integer, parameter :: rid_OCS_O = 320 + integer, parameter :: rid_OCS_OH = 321 + integer, parameter :: rid_S_O2 = 322 + integer, parameter :: rid_SO2_OH_M = 323 + integer, parameter :: rid_S_O3 = 324 + integer, parameter :: rid_SO_BRO = 325 + integer, parameter :: rid_SO_CLO = 326 + integer, parameter :: rid_S_OH = 327 + integer, parameter :: rid_SO_NO2 = 328 + integer, parameter :: rid_SO_O2 = 329 + integer, parameter :: rid_SO_O3 = 330 + integer, parameter :: rid_SO_OCLO = 331 + integer, parameter :: rid_SO_OH = 332 + integer, parameter :: rid_usr_DMS_OH = 333 + integer, parameter :: rid_usr_SO3_H2O = 334 + integer, parameter :: rid_NH3_OH = 335 + integer, parameter :: rid_usr_HO2_aer = 336 + integer, parameter :: rid_usr_N2O5_aer = 337 + integer, parameter :: rid_usr_NH4_strat_tau = 338 + integer, parameter :: rid_usr_NO2_aer = 339 + integer, parameter :: rid_usr_NO3_aer = 340 + integer, parameter :: rid_usr_ONITR_aer = 341 + integer, parameter :: rid_SOAE_tau = 342 + integer, parameter :: rid_het1 = 343 + integer, parameter :: rid_het10 = 344 + integer, parameter :: rid_het11 = 345 + integer, parameter :: rid_het12 = 346 + integer, parameter :: rid_het13 = 347 + integer, parameter :: rid_het14 = 348 + integer, parameter :: rid_het15 = 349 + integer, parameter :: rid_het16 = 350 + integer, parameter :: rid_het17 = 351 + integer, parameter :: rid_het2 = 352 + integer, parameter :: rid_het3 = 353 + integer, parameter :: rid_het4 = 354 + integer, parameter :: rid_het5 = 355 + integer, parameter :: rid_het6 = 356 + integer, parameter :: rid_het7 = 357 + integer, parameter :: rid_het8 = 358 + integer, parameter :: rid_het9 = 359 + integer, parameter :: rid_E90_tau = 360 + integer, parameter :: rid_NH_50_tau = 361 + integer, parameter :: rid_NH_5_tau = 362 + integer, parameter :: rid_ST80_25_tau = 363 + end module m_rxt_id diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/m_spc_id.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/m_spc_id.F90 new file mode 100644 index 0000000000..83897dbc50 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/m_spc_id.F90 @@ -0,0 +1,144 @@ + module m_spc_id + implicit none + integer, parameter :: id_bc_a1 = 1 + integer, parameter :: id_bc_a4 = 2 + integer, parameter :: id_BIGALK = 3 + integer, parameter :: id_BR = 4 + integer, parameter :: id_BRCL = 5 + integer, parameter :: id_BRO = 6 + integer, parameter :: id_BRONO2 = 7 + integer, parameter :: id_BRY = 8 + integer, parameter :: id_C2H4 = 9 + integer, parameter :: id_C2H5OH = 10 + integer, parameter :: id_C2H5OOH = 11 + integer, parameter :: id_C2H6 = 12 + integer, parameter :: id_C3H6 = 13 + integer, parameter :: id_C3H7OOH = 14 + integer, parameter :: id_C3H8 = 15 + integer, parameter :: id_CCL4 = 16 + integer, parameter :: id_CF2CLBR = 17 + integer, parameter :: id_CF3BR = 18 + integer, parameter :: id_CFC11 = 19 + integer, parameter :: id_CFC113 = 20 + integer, parameter :: id_CFC114 = 21 + integer, parameter :: id_CFC115 = 22 + integer, parameter :: id_CFC12 = 23 + integer, parameter :: id_CH2BR2 = 24 + integer, parameter :: id_CH2O = 25 + integer, parameter :: id_CH3BR = 26 + integer, parameter :: id_CH3CCL3 = 27 + integer, parameter :: id_CH3CHO = 28 + integer, parameter :: id_CH3CL = 29 + integer, parameter :: id_CH3COCH3 = 30 + integer, parameter :: id_CH3COCHO = 31 + integer, parameter :: id_CH3COOH = 32 + integer, parameter :: id_CH3COOOH = 33 + integer, parameter :: id_CH3OH = 34 + integer, parameter :: id_CH3OOH = 35 + integer, parameter :: id_CH4 = 36 + integer, parameter :: id_CHBR3 = 37 + integer, parameter :: id_CL = 38 + integer, parameter :: id_CL2 = 39 + integer, parameter :: id_CL2O2 = 40 + integer, parameter :: id_CLO = 41 + integer, parameter :: id_CLONO2 = 42 + integer, parameter :: id_CLY = 43 + integer, parameter :: id_CO = 44 + integer, parameter :: id_CO2 = 45 + integer, parameter :: id_DMS = 46 + integer, parameter :: id_dst_a1 = 47 + integer, parameter :: id_dst_a2 = 48 + integer, parameter :: id_dst_a3 = 49 + integer, parameter :: id_E90 = 50 + integer, parameter :: id_EOOH = 51 + integer, parameter :: id_GLYALD = 52 + integer, parameter :: id_GLYOXAL = 53 + integer, parameter :: id_H = 54 + integer, parameter :: id_H2 = 55 + integer, parameter :: id_H2402 = 56 + integer, parameter :: id_H2O2 = 57 + integer, parameter :: id_H2SO4 = 58 + integer, parameter :: id_HBR = 59 + integer, parameter :: id_HCFC141B = 60 + integer, parameter :: id_HCFC142B = 61 + integer, parameter :: id_HCFC22 = 62 + integer, parameter :: id_HCL = 63 + integer, parameter :: id_HF = 64 + integer, parameter :: id_HNO3 = 65 + integer, parameter :: id_HO2NO2 = 66 + integer, parameter :: id_HOBR = 67 + integer, parameter :: id_HOCL = 68 + integer, parameter :: id_HYAC = 69 + integer, parameter :: id_HYDRALD = 70 + integer, parameter :: id_ISOP = 71 + integer, parameter :: id_ISOPNO3 = 72 + integer, parameter :: id_ISOPOOH = 73 + integer, parameter :: id_MACR = 74 + integer, parameter :: id_MACROOH = 75 + integer, parameter :: id_MPAN = 76 + integer, parameter :: id_MVK = 77 + integer, parameter :: id_N = 78 + integer, parameter :: id_N2O = 79 + integer, parameter :: id_N2O5 = 80 + integer, parameter :: id_ncl_a1 = 81 + integer, parameter :: id_ncl_a2 = 82 + integer, parameter :: id_ncl_a3 = 83 + integer, parameter :: id_NH3 = 84 + integer, parameter :: id_NH4 = 85 + integer, parameter :: id_NH_5 = 86 + integer, parameter :: id_NH_50 = 87 + integer, parameter :: id_NO = 88 + integer, parameter :: id_NO2 = 89 + integer, parameter :: id_NO3 = 90 + integer, parameter :: id_NOA = 91 + integer, parameter :: id_num_a1 = 92 + integer, parameter :: id_num_a2 = 93 + integer, parameter :: id_num_a3 = 94 + integer, parameter :: id_num_a4 = 95 + integer, parameter :: id_num_a5 = 96 + integer, parameter :: id_O = 97 + integer, parameter :: id_O3 = 98 + integer, parameter :: id_O3S = 99 + integer, parameter :: id_OCLO = 100 + integer, parameter :: id_OCS = 101 + integer, parameter :: id_ONITR = 102 + integer, parameter :: id_PAN = 103 + integer, parameter :: id_pom_a1 = 104 + integer, parameter :: id_pom_a4 = 105 + integer, parameter :: id_POOH = 106 + integer, parameter :: id_ROOH = 107 + integer, parameter :: id_S = 108 + integer, parameter :: id_SF6 = 109 + integer, parameter :: id_SO = 110 + integer, parameter :: id_SO2 = 111 + integer, parameter :: id_SO3 = 112 + integer, parameter :: id_so4_a1 = 113 + integer, parameter :: id_so4_a2 = 114 + integer, parameter :: id_so4_a3 = 115 + integer, parameter :: id_so4_a5 = 116 + integer, parameter :: id_soa_a1 = 117 + integer, parameter :: id_soa_a2 = 118 + integer, parameter :: id_SOAE = 119 + integer, parameter :: id_SOAG = 120 + integer, parameter :: id_ST80_25 = 121 + integer, parameter :: id_TERP = 122 + integer, parameter :: id_XOOH = 123 + integer, parameter :: id_NHDEP = 124 + integer, parameter :: id_NDEP = 125 + integer, parameter :: id_C2H5O2 = 126 + integer, parameter :: id_C3H7O2 = 127 + integer, parameter :: id_CH3CO3 = 128 + integer, parameter :: id_CH3O2 = 129 + integer, parameter :: id_EO = 130 + integer, parameter :: id_EO2 = 131 + integer, parameter :: id_HO2 = 132 + integer, parameter :: id_ISOPO2 = 133 + integer, parameter :: id_MACRO2 = 134 + integer, parameter :: id_MCO3 = 135 + integer, parameter :: id_O1D = 136 + integer, parameter :: id_OH = 137 + integer, parameter :: id_PO2 = 138 + integer, parameter :: id_RO2 = 139 + integer, parameter :: id_XO2 = 140 + integer, parameter :: id_H2O = 141 + end module m_spc_id diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_adjrxt.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_adjrxt.F90 new file mode 100644 index 0000000000..b8fc745806 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_adjrxt.F90 @@ -0,0 +1,291 @@ + module mo_adjrxt + private + public :: adjrxt + contains + subroutine adjrxt( rate, inv, m, ncol, nlev ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : nfs, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,nfs) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: rate(ncol,nlev,rxntot) + rate(:,:, 88) = rate(:,:, 88) * inv(:,:, 3) + rate(:,:, 89) = rate(:,:, 89) * inv(:,:, 2) + rate(:,:, 93) = rate(:,:, 93) * inv(:,:, 1) + rate(:,:, 110) = rate(:,:, 110) * inv(:,:, 1) + rate(:,:, 117) = rate(:,:, 117) * inv(:,:, 2) + rate(:,:, 120) = rate(:,:, 120) * inv(:,:, 1) + rate(:,:, 128) = rate(:,:, 128) * inv(:,:, 1) + rate(:,:, 131) = rate(:,:, 131) * inv(:,:, 1) + rate(:,:, 132) = rate(:,:, 132) * inv(:,:, 1) + rate(:,:, 133) = rate(:,:, 133) * inv(:,:, 1) + rate(:,:, 135) = rate(:,:, 135) * inv(:,:, 1) + rate(:,:, 136) = rate(:,:, 136) * inv(:,:, 1) + rate(:,:, 151) = rate(:,:, 151) * inv(:,:, 1) + rate(:,:, 171) = rate(:,:, 171) * inv(:,:, 1) + rate(:,:, 172) = rate(:,:, 172) * inv(:,:, 1) + rate(:,:, 182) = rate(:,:, 182) * inv(:,:, 1) + rate(:,:, 225) = rate(:,:, 225) * inv(:,:, 1) + rate(:,:, 246) = rate(:,:, 246) * inv(:,:, 2) + rate(:,:, 250) = rate(:,:, 250) * inv(:,:, 1) + rate(:,:, 251) = rate(:,:, 251) * inv(:,:, 1) + rate(:,:, 252) = rate(:,:, 252) * inv(:,:, 1) + rate(:,:, 271) = rate(:,:, 271) * inv(:,:, 1) + rate(:,:, 288) = rate(:,:, 288) * inv(:,:, 1) + rate(:,:, 291) = rate(:,:, 291) * inv(:,:, 1) + rate(:,:, 292) = rate(:,:, 292) * inv(:,:, 1) + rate(:,:, 322) = rate(:,:, 322) * inv(:,:, 2) + rate(:,:, 323) = rate(:,:, 323) * inv(:,:, 1) + rate(:,:, 329) = rate(:,:, 329) * inv(:,:, 2) + rate(:,:, 94) = rate(:,:, 94) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 100) = rate(:,:, 100) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 86) = rate(:,:, 86) * m(:,:) + rate(:,:, 87) = rate(:,:, 87) * m(:,:) + rate(:,:, 90) = rate(:,:, 90) * m(:,:) + rate(:,:, 91) = rate(:,:, 91) * m(:,:) + rate(:,:, 92) = rate(:,:, 92) * m(:,:) + rate(:,:, 93) = rate(:,:, 93) * m(:,:) + rate(:,:, 95) = rate(:,:, 95) * m(:,:) + rate(:,:, 96) = rate(:,:, 96) * m(:,:) + rate(:,:, 97) = rate(:,:, 97) * m(:,:) + rate(:,:, 98) = rate(:,:, 98) * m(:,:) + rate(:,:, 99) = rate(:,:, 99) * m(:,:) + rate(:,:, 101) = rate(:,:, 101) * m(:,:) + rate(:,:, 102) = rate(:,:, 102) * m(:,:) + rate(:,:, 103) = rate(:,:, 103) * m(:,:) + rate(:,:, 104) = rate(:,:, 104) * m(:,:) + rate(:,:, 105) = rate(:,:, 105) * m(:,:) + rate(:,:, 106) = rate(:,:, 106) * m(:,:) + rate(:,:, 107) = rate(:,:, 107) * m(:,:) + rate(:,:, 108) = rate(:,:, 108) * m(:,:) + rate(:,:, 109) = rate(:,:, 109) * m(:,:) + rate(:,:, 110) = rate(:,:, 110) * m(:,:) + rate(:,:, 111) = rate(:,:, 111) * m(:,:) + rate(:,:, 112) = rate(:,:, 112) * m(:,:) + rate(:,:, 113) = rate(:,:, 113) * m(:,:) + rate(:,:, 114) = rate(:,:, 114) * m(:,:) + rate(:,:, 115) = rate(:,:, 115) * m(:,:) + rate(:,:, 116) = rate(:,:, 116) * m(:,:) + rate(:,:, 118) = rate(:,:, 118) * m(:,:) + rate(:,:, 119) = rate(:,:, 119) * m(:,:) + rate(:,:, 120) = rate(:,:, 120) * m(:,:) + rate(:,:, 121) = rate(:,:, 121) * m(:,:) + rate(:,:, 122) = rate(:,:, 122) * m(:,:) + rate(:,:, 123) = rate(:,:, 123) * m(:,:) + rate(:,:, 124) = rate(:,:, 124) * m(:,:) + rate(:,:, 125) = rate(:,:, 125) * m(:,:) + rate(:,:, 126) = rate(:,:, 126) * m(:,:) + rate(:,:, 127) = rate(:,:, 127) * m(:,:) + rate(:,:, 128) = rate(:,:, 128) * m(:,:) + rate(:,:, 129) = rate(:,:, 129) * m(:,:) + rate(:,:, 130) = rate(:,:, 130) * m(:,:) + rate(:,:, 131) = rate(:,:, 131) * m(:,:) + rate(:,:, 132) = rate(:,:, 132) * m(:,:) + rate(:,:, 133) = rate(:,:, 133) * m(:,:) + rate(:,:, 134) = rate(:,:, 134) * m(:,:) + rate(:,:, 137) = rate(:,:, 137) * m(:,:) + rate(:,:, 138) = rate(:,:, 138) * m(:,:) + rate(:,:, 139) = rate(:,:, 139) * m(:,:) + rate(:,:, 140) = rate(:,:, 140) * m(:,:) + rate(:,:, 141) = rate(:,:, 141) * m(:,:) + rate(:,:, 142) = rate(:,:, 142) * m(:,:) + rate(:,:, 143) = rate(:,:, 143) * m(:,:) + rate(:,:, 144) = rate(:,:, 144) * m(:,:) + rate(:,:, 145) = rate(:,:, 145) * m(:,:) + rate(:,:, 146) = rate(:,:, 146) * m(:,:) + rate(:,:, 147) = rate(:,:, 147) * m(:,:) + rate(:,:, 148) = rate(:,:, 148) * m(:,:) + rate(:,:, 149) = rate(:,:, 149) * m(:,:) + rate(:,:, 150) = rate(:,:, 150) * m(:,:) + rate(:,:, 151) = rate(:,:, 151) * m(:,:) + rate(:,:, 152) = rate(:,:, 152) * m(:,:) + rate(:,:, 153) = rate(:,:, 153) * m(:,:) + rate(:,:, 154) = rate(:,:, 154) * m(:,:) + rate(:,:, 155) = rate(:,:, 155) * m(:,:) + rate(:,:, 156) = rate(:,:, 156) * m(:,:) + rate(:,:, 157) = rate(:,:, 157) * m(:,:) + rate(:,:, 158) = rate(:,:, 158) * m(:,:) + rate(:,:, 159) = rate(:,:, 159) * m(:,:) + rate(:,:, 160) = rate(:,:, 160) * m(:,:) + rate(:,:, 161) = rate(:,:, 161) * m(:,:) + rate(:,:, 162) = rate(:,:, 162) * m(:,:) + rate(:,:, 163) = rate(:,:, 163) * m(:,:) + rate(:,:, 164) = rate(:,:, 164) * m(:,:) + rate(:,:, 165) = rate(:,:, 165) * m(:,:) + rate(:,:, 166) = rate(:,:, 166) * m(:,:) + rate(:,:, 167) = rate(:,:, 167) * m(:,:) + rate(:,:, 168) = rate(:,:, 168) * m(:,:) + rate(:,:, 169) = rate(:,:, 169) * m(:,:) + rate(:,:, 170) = rate(:,:, 170) * m(:,:) + rate(:,:, 171) = rate(:,:, 171) * m(:,:) + rate(:,:, 173) = rate(:,:, 173) * m(:,:) + rate(:,:, 174) = rate(:,:, 174) * m(:,:) + rate(:,:, 175) = rate(:,:, 175) * m(:,:) + rate(:,:, 176) = rate(:,:, 176) * m(:,:) + rate(:,:, 177) = rate(:,:, 177) * m(:,:) + rate(:,:, 178) = rate(:,:, 178) * m(:,:) + rate(:,:, 179) = rate(:,:, 179) * m(:,:) + rate(:,:, 180) = rate(:,:, 180) * m(:,:) + rate(:,:, 181) = rate(:,:, 181) * m(:,:) + rate(:,:, 182) = rate(:,:, 182) * m(:,:) + rate(:,:, 183) = rate(:,:, 183) * m(:,:) + rate(:,:, 184) = rate(:,:, 184) * m(:,:) + rate(:,:, 185) = rate(:,:, 185) * m(:,:) + rate(:,:, 186) = rate(:,:, 186) * m(:,:) + rate(:,:, 187) = rate(:,:, 187) * m(:,:) + rate(:,:, 188) = rate(:,:, 188) * m(:,:) + rate(:,:, 189) = rate(:,:, 189) * m(:,:) + rate(:,:, 190) = rate(:,:, 190) * m(:,:) + rate(:,:, 191) = rate(:,:, 191) * m(:,:) + rate(:,:, 192) = rate(:,:, 192) * m(:,:) + rate(:,:, 193) = rate(:,:, 193) * m(:,:) + rate(:,:, 194) = rate(:,:, 194) * m(:,:) + rate(:,:, 195) = rate(:,:, 195) * m(:,:) + rate(:,:, 196) = rate(:,:, 196) * m(:,:) + rate(:,:, 197) = rate(:,:, 197) * m(:,:) + rate(:,:, 198) = rate(:,:, 198) * m(:,:) + rate(:,:, 199) = rate(:,:, 199) * m(:,:) + rate(:,:, 200) = rate(:,:, 200) * m(:,:) + rate(:,:, 201) = rate(:,:, 201) * m(:,:) + rate(:,:, 202) = rate(:,:, 202) * m(:,:) + rate(:,:, 203) = rate(:,:, 203) * m(:,:) + rate(:,:, 204) = rate(:,:, 204) * m(:,:) + rate(:,:, 205) = rate(:,:, 205) * m(:,:) + rate(:,:, 206) = rate(:,:, 206) * m(:,:) + rate(:,:, 207) = rate(:,:, 207) * m(:,:) + rate(:,:, 208) = rate(:,:, 208) * m(:,:) + rate(:,:, 209) = rate(:,:, 209) * m(:,:) + rate(:,:, 210) = rate(:,:, 210) * m(:,:) + rate(:,:, 211) = rate(:,:, 211) * m(:,:) + rate(:,:, 212) = rate(:,:, 212) * m(:,:) + rate(:,:, 213) = rate(:,:, 213) * m(:,:) + rate(:,:, 214) = rate(:,:, 214) * m(:,:) + rate(:,:, 215) = rate(:,:, 215) * m(:,:) + rate(:,:, 216) = rate(:,:, 216) * m(:,:) + rate(:,:, 217) = rate(:,:, 217) * m(:,:) + rate(:,:, 218) = rate(:,:, 218) * m(:,:) + rate(:,:, 219) = rate(:,:, 219) * m(:,:) + rate(:,:, 220) = rate(:,:, 220) * m(:,:) + rate(:,:, 221) = rate(:,:, 221) * m(:,:) + rate(:,:, 222) = rate(:,:, 222) * m(:,:) + rate(:,:, 223) = rate(:,:, 223) * m(:,:) + rate(:,:, 224) = rate(:,:, 224) * m(:,:) + rate(:,:, 225) = rate(:,:, 225) * m(:,:) + rate(:,:, 226) = rate(:,:, 226) * m(:,:) + rate(:,:, 227) = rate(:,:, 227) * m(:,:) + rate(:,:, 228) = rate(:,:, 228) * m(:,:) + rate(:,:, 229) = rate(:,:, 229) * m(:,:) + rate(:,:, 230) = rate(:,:, 230) * m(:,:) + rate(:,:, 231) = rate(:,:, 231) * m(:,:) + rate(:,:, 232) = rate(:,:, 232) * m(:,:) + rate(:,:, 233) = rate(:,:, 233) * m(:,:) + rate(:,:, 234) = rate(:,:, 234) * m(:,:) + rate(:,:, 235) = rate(:,:, 235) * m(:,:) + rate(:,:, 236) = rate(:,:, 236) * m(:,:) + rate(:,:, 237) = rate(:,:, 237) * m(:,:) + rate(:,:, 238) = rate(:,:, 238) * m(:,:) + rate(:,:, 239) = rate(:,:, 239) * m(:,:) + rate(:,:, 240) = rate(:,:, 240) * m(:,:) + rate(:,:, 241) = rate(:,:, 241) * m(:,:) + rate(:,:, 242) = rate(:,:, 242) * m(:,:) + rate(:,:, 243) = rate(:,:, 243) * m(:,:) + rate(:,:, 244) = rate(:,:, 244) * m(:,:) + rate(:,:, 247) = rate(:,:, 247) * m(:,:) + rate(:,:, 248) = rate(:,:, 248) * m(:,:) + rate(:,:, 249) = rate(:,:, 249) * m(:,:) + rate(:,:, 250) = rate(:,:, 250) * m(:,:) + rate(:,:, 251) = rate(:,:, 251) * m(:,:) + rate(:,:, 253) = rate(:,:, 253) * m(:,:) + rate(:,:, 254) = rate(:,:, 254) * m(:,:) + rate(:,:, 255) = rate(:,:, 255) * m(:,:) + rate(:,:, 256) = rate(:,:, 256) * m(:,:) + rate(:,:, 257) = rate(:,:, 257) * m(:,:) + rate(:,:, 258) = rate(:,:, 258) * m(:,:) + rate(:,:, 259) = rate(:,:, 259) * m(:,:) + rate(:,:, 260) = rate(:,:, 260) * m(:,:) + rate(:,:, 261) = rate(:,:, 261) * m(:,:) + rate(:,:, 262) = rate(:,:, 262) * m(:,:) + rate(:,:, 263) = rate(:,:, 263) * m(:,:) + rate(:,:, 264) = rate(:,:, 264) * m(:,:) + rate(:,:, 265) = rate(:,:, 265) * m(:,:) + rate(:,:, 266) = rate(:,:, 266) * m(:,:) + rate(:,:, 267) = rate(:,:, 267) * m(:,:) + rate(:,:, 268) = rate(:,:, 268) * m(:,:) + rate(:,:, 269) = rate(:,:, 269) * m(:,:) + rate(:,:, 270) = rate(:,:, 270) * m(:,:) + rate(:,:, 271) = rate(:,:, 271) * m(:,:) + rate(:,:, 272) = rate(:,:, 272) * m(:,:) + rate(:,:, 273) = rate(:,:, 273) * m(:,:) + rate(:,:, 274) = rate(:,:, 274) * m(:,:) + rate(:,:, 275) = rate(:,:, 275) * m(:,:) + rate(:,:, 276) = rate(:,:, 276) * m(:,:) + rate(:,:, 277) = rate(:,:, 277) * m(:,:) + rate(:,:, 278) = rate(:,:, 278) * m(:,:) + rate(:,:, 279) = rate(:,:, 279) * m(:,:) + rate(:,:, 280) = rate(:,:, 280) * m(:,:) + rate(:,:, 281) = rate(:,:, 281) * m(:,:) + rate(:,:, 282) = rate(:,:, 282) * m(:,:) + rate(:,:, 283) = rate(:,:, 283) * m(:,:) + rate(:,:, 284) = rate(:,:, 284) * m(:,:) + rate(:,:, 285) = rate(:,:, 285) * m(:,:) + rate(:,:, 286) = rate(:,:, 286) * m(:,:) + rate(:,:, 287) = rate(:,:, 287) * m(:,:) + rate(:,:, 288) = rate(:,:, 288) * m(:,:) + rate(:,:, 289) = rate(:,:, 289) * m(:,:) + rate(:,:, 290) = rate(:,:, 290) * m(:,:) + rate(:,:, 291) = rate(:,:, 291) * m(:,:) + rate(:,:, 293) = rate(:,:, 293) * m(:,:) + rate(:,:, 294) = rate(:,:, 294) * m(:,:) + rate(:,:, 295) = rate(:,:, 295) * m(:,:) + rate(:,:, 296) = rate(:,:, 296) * m(:,:) + rate(:,:, 297) = rate(:,:, 297) * m(:,:) + rate(:,:, 298) = rate(:,:, 298) * m(:,:) + rate(:,:, 299) = rate(:,:, 299) * m(:,:) + rate(:,:, 300) = rate(:,:, 300) * m(:,:) + rate(:,:, 301) = rate(:,:, 301) * m(:,:) + rate(:,:, 302) = rate(:,:, 302) * m(:,:) + rate(:,:, 303) = rate(:,:, 303) * m(:,:) + rate(:,:, 304) = rate(:,:, 304) * m(:,:) + rate(:,:, 305) = rate(:,:, 305) * m(:,:) + rate(:,:, 306) = rate(:,:, 306) * m(:,:) + rate(:,:, 307) = rate(:,:, 307) * m(:,:) + rate(:,:, 308) = rate(:,:, 308) * m(:,:) + rate(:,:, 309) = rate(:,:, 309) * m(:,:) + rate(:,:, 310) = rate(:,:, 310) * m(:,:) + rate(:,:, 311) = rate(:,:, 311) * m(:,:) + rate(:,:, 312) = rate(:,:, 312) * m(:,:) + rate(:,:, 313) = rate(:,:, 313) * m(:,:) + rate(:,:, 314) = rate(:,:, 314) * m(:,:) + rate(:,:, 315) = rate(:,:, 315) * m(:,:) + rate(:,:, 316) = rate(:,:, 316) * m(:,:) + rate(:,:, 317) = rate(:,:, 317) * m(:,:) + rate(:,:, 318) = rate(:,:, 318) * m(:,:) + rate(:,:, 319) = rate(:,:, 319) * m(:,:) + rate(:,:, 320) = rate(:,:, 320) * m(:,:) + rate(:,:, 321) = rate(:,:, 321) * m(:,:) + rate(:,:, 323) = rate(:,:, 323) * m(:,:) + rate(:,:, 324) = rate(:,:, 324) * m(:,:) + rate(:,:, 325) = rate(:,:, 325) * m(:,:) + rate(:,:, 326) = rate(:,:, 326) * m(:,:) + rate(:,:, 327) = rate(:,:, 327) * m(:,:) + rate(:,:, 328) = rate(:,:, 328) * m(:,:) + rate(:,:, 330) = rate(:,:, 330) * m(:,:) + rate(:,:, 331) = rate(:,:, 331) * m(:,:) + rate(:,:, 332) = rate(:,:, 332) * m(:,:) + rate(:,:, 333) = rate(:,:, 333) * m(:,:) + rate(:,:, 334) = rate(:,:, 334) * m(:,:) + rate(:,:, 335) = rate(:,:, 335) * m(:,:) + rate(:,:, 344) = rate(:,:, 344) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_exp_sol.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_exp_sol.F90 @@ -0,0 +1,81 @@ +module mo_exp_sol + private + public :: exp_sol + public :: exp_sol_inti +contains + subroutine exp_sol_inti + use mo_tracname, only : solsym + use chem_mods, only : clscnt1, clsmap + use cam_history, only : addfld + implicit none + integer :: i,j + do i = 1,clscnt1 + j = clsmap(i,1) + call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) + call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) + enddo + end subroutine exp_sol_inti + subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) + !----------------------------------------------------------------------- + ! ... Exp_sol advances the volumetric mixing ratio + ! forward one time step via the fully explicit + ! Euler scheme + !----------------------------------------------------------------------- + use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot + use ppgrid, only : pcols, pver + use mo_prod_loss, only : exp_prod_loss + use mo_indprd, only : indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_history, only : outfld + use mo_tracname, only : solsym + implicit none + !----------------------------------------------------------------------- + ! ... Dummy arguments + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) + real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) + real(r8), intent(in) :: xhnm(ncol,pver) + integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) + real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: i, k, l, m + integer :: chnkpnts + real(r8), dimension(ncol,pver,max(1,clscnt1)) :: & + prod, & + loss + real(r8), dimension(ncol,pver,clscnt1) :: ind_prd + real(r8), dimension(ncol,pver) :: wrk + chnkpnts = ncol*pver + !----------------------------------------------------------------------- + ! ... Put "independent" production in the forcing + !----------------------------------------------------------------------- + call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & + reaction_rates, chnkpnts ) + !----------------------------------------------------------------------- + ! ... Form F(y) + !----------------------------------------------------------------------- + call exp_prod_loss( 1, chnkpnts, prod, loss, base_sol, reaction_rates, & + het_rates, chnkpnts ) + !----------------------------------------------------------------------- + ! ... Solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + do m = 1,clscnt1 + l = clsmap(m,1) + do i = 1,ncol + do k = ltrop(i)+1,pver + base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) + end do + end do + wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) + wrk(:,:) = (loss(:,:,m))*xhnm + call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) + end do + end subroutine exp_sol +end module mo_exp_sol diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_imp_sol.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_imp_sol.F90 @@ -0,0 +1,435 @@ +module mo_imp_sol + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, gas_pcnst, clsmap, veclen + use cam_logfile, only : iulog + implicit none + private + public :: imp_slv_inti, imp_sol + save + real(r8), parameter :: rel_err = 1.e-3_r8 + real(r8), parameter :: high_rel_err = 1.e-4_r8 + !----------------------------------------------------------------------- + ! Newton-Raphson iteration limits + !----------------------------------------------------------------------- + integer, parameter :: itermax = 11 + integer, parameter :: cut_limit = 5 + real(r8), parameter :: sol_min = 1.e-20_r8 + real(r8), parameter :: small = 1.e-40_r8 + real(r8) :: epsilon(clscnt4) + logical :: factor(itermax) +contains + subroutine imp_slv_inti + !----------------------------------------------------------------------- + ! ... Initialize the implict solver + !----------------------------------------------------------------------- + use mo_chem_utls, only : get_spc_ndx + implicit none + !----------------------------------------------------------------------- + ! ... Local variables + !----------------------------------------------------------------------- + integer :: m, ox_ndx, o3a_ndx + real(r8) :: eps(gas_pcnst) + factor(:) = .true. + eps(:) = rel_err + ox_ndx = get_spc_ndx( 'OX' ) + if( ox_ndx < 1 ) then + ox_ndx = get_spc_ndx( 'O3' ) + end if + if( ox_ndx > 0 ) then + eps(ox_ndx) = high_rel_err + end if + m = get_spc_ndx( 'NO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'N2O5' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'OH' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'HO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + o3a_ndx = get_spc_ndx( 'O3A' ) + if( o3a_ndx > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XHO2NO2' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'XNO2NO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + m = get_spc_ndx( 'NO2XNO3' ) + if( m > 0 ) then + eps(m) = high_rel_err + end if + do m = 1,clscnt4 + epsilon(m) = eps(clsmap(m,4)) + end do + end subroutine imp_slv_inti + subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & + ncol, nlev, lchnk, prod_out, loss_out ) + !----------------------------------------------------------------------- + ! ... imp_sol advances the volumetric mixing ratio + ! forward one time step via the fully implicit euler scheme. + ! this source is meant for vector architectures such as the + ! nec sx6 and cray x1 + !----------------------------------------------------------------------- + use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt + use mo_tracname, only : solsym + use mo_lin_matrix, only : linmat + use mo_nln_matrix, only : nlnmat + use mo_lu_factor, only : lu_fac + use mo_lu_solve, only : lu_slv + use mo_prod_loss, only : imp_prod_loss + use mo_indprd, only : indprd + use time_manager, only : get_nstep + use perf_mod, only : t_startf, t_stopf + implicit none + !----------------------------------------------------------------------- + ! ... dummy args + !----------------------------------------------------------------------- + integer, intent(in) :: ncol ! columns in chunck + integer, intent(in) :: nlev + integer, intent(in) :: lchnk ! chunk id + real(r8), intent(in) :: delt ! time step (s) + real(r8), intent(in) :: reaction_rates(ncol*nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s) + real(r8), intent(in) :: extfrc(ncol*nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s) + real(r8), intent(in) :: het_rates(ncol*nlev,max(1,gas_pcnst)) ! washout rates (1/s) + real(r8), intent(inout) :: base_sol(ncol*nlev,gas_pcnst) ! species mixing ratios (vmr) + real(r8), intent(out) :: prod_out(ncol*nlev,max(1,clscnt4)) + real(r8), intent(out) :: loss_out(ncol*nlev,max(1,clscnt4)) + !----------------------------------------------------------------------- + ! ... local variables + !----------------------------------------------------------------------- + integer :: nr_iter + integer :: ofl + integer :: ofu + integer :: avec_len + integer :: bndx ! base index + integer :: cndx ! class index + integer :: pndx ! permuted class index + integer :: i,m + integer :: fail_cnt(veclen) + integer :: cut_cnt(veclen) + integer :: stp_con_cnt(veclen) + integer :: nstep + real(r8) :: interval_done(veclen) + real(r8) :: dt(veclen) + real(r8) :: dti(veclen) + real(r8) :: max_delta(max(1,clscnt4)) + real(r8) :: ind_prd(ncol*nlev,max(1,clscnt4)) + logical :: convergence + integer :: chnkpnts ! total spatial points in chunk; ncol*ncol + logical :: diags_out(ncol*nlev,max(1,clscnt4)) + real(r8) :: sys_jac_blk(veclen,max(1,nzcnt)) + real(r8) :: lin_jac_blk(veclen,max(1,nzcnt)) + real(r8) :: solution_blk(veclen,max(1,clscnt4)) + real(r8) :: forcing_blk(veclen,max(1,clscnt4)) + real(r8) :: iter_invariant_blk(veclen,max(1,clscnt4)) + real(r8) :: prod_blk(veclen,max(1,clscnt4)) + real(r8) :: loss_blk(veclen,max(1,clscnt4)) + real(r8) :: ind_prd_blk(veclen,max(1,clscnt4)) + real(r8) :: sbase_sol_blk(veclen,gas_pcnst) + real(r8) :: wrk_blk(veclen) + logical :: spc_conv_blk(veclen,max(1,clscnt4)) + logical :: cls_conv_blk(veclen) + logical :: time_stp_done_blk(veclen) + real(r8) :: reaction_rates_blk(veclen,max(1,rxntot)) + real(r8) :: extfrc_blk(veclen,max(1,extcnt)) + real(r8) :: het_rates_blk(veclen,max(1,gas_pcnst)) + real(r8) :: base_sol_blk(veclen,gas_pcnst) + chnkpnts = ncol*nlev + prod_out = 0._r8 + loss_out = 0._r8 + diags_out = .false. + !----------------------------------------------------------------------- + ! ... class independent forcing + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, & + reaction_rates, chnkpnts ) + else + do m = 1,clscnt4 + ind_prd(:,m) = 0._r8 + end do + end if + nstep = get_nstep() + ofl = 1 + chnkpnts_loop : do + ofu = min( chnkpnts,ofl + veclen - 1 ) + avec_len = (ofu - ofl) + 1 + reaction_rates_blk(1:avec_len,:) = reaction_rates(ofl:ofu,:) + extfrc_blk(1:avec_len,:) = extfrc(ofl:ofu,:) + het_rates_blk(1:avec_len,:) = het_rates(ofl:ofu,:) + ind_prd_blk(1:avec_len,:) = ind_prd(ofl:ofu,:) + base_sol_blk(1:avec_len,:) = base_sol(ofl:ofu,:) + cls_conv_blk(1:avec_len) = .false. + dt(1:avec_len) = delt + cut_cnt(1:avec_len) = 0 + fail_cnt(1:avec_len) = 0 + stp_con_cnt(1:avec_len) = 0 + interval_done(1:avec_len) = 0._r8 + time_stp_done_blk(1:avec_len) = .false. + !----------------------------------------------------------------------- + ! ... time step loop + !----------------------------------------------------------------------- + time_step_loop : do + dti(1:avec_len) = 1._r8 / dt(1:avec_len) + !----------------------------------------------------------------------- + ! ... transfer from base to class array + !----------------------------------------------------------------------- + do cndx = 1,clscnt4 + bndx = clsmap(cndx,4) + pndx = permute(cndx,4) + do i = 1, avec_len + solution_blk(i,pndx) = base_sol_blk(i,bndx) + end do + end do + do m = 1,gas_pcnst + sbase_sol_blk(1:avec_len,m) = base_sol_blk(1:avec_len,m) + end do + !----------------------------------------------------------------------- + ! ... set the iteration invariant part of the function f(y) + !----------------------------------------------------------------------- + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + do i = 1, avec_len + iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m) + ind_prd_blk(i,m) + end do + end do + else + do m = 1,clscnt4 + do i = 1, avec_len + iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m) + end do + end do + end if + !----------------------------------------------------------------------- + ! ... the linear component + !----------------------------------------------------------------------- + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( avec_len, lin_jac_blk, base_sol_blk, & + reaction_rates_blk, het_rates_blk ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax + !----------------------------------------------------------------------- + ! ... the non-linear component + !----------------------------------------------------------------------- + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( avec_len, sys_jac_blk, base_sol_blk, & + reaction_rates_blk, lin_jac_blk, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( avec_len, sys_jac_blk ) + call t_stopf( 'lu_fac' ) + end if + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( avec_len, prod_blk, loss_blk, & + base_sol_blk, reaction_rates_blk, het_rates_blk ) + call t_stopf( 'prod_loss' ) + do m = 1,clscnt4 + do i = 1, avec_len + forcing_blk(i,m) = solution_blk(i,m)*dti(i) & + - (iter_invariant_blk(i,m) + prod_blk(i,m) - loss_blk(i,m)) + end do + end do + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( avec_len, sys_jac_blk, forcing_blk ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + do i = 1, avec_len + if( .not. cls_conv_blk(i) )then + solution_blk(i,m) = solution_blk(i,m) + forcing_blk(i,m) + else + forcing_blk(i,m) = 0._r8 + endif + end do + end do + !----------------------------------------------------------------------- + ! ... convergence measures and test + !----------------------------------------------------------------------- + conv_chk : if( nr_iter > 1 ) then + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + do cndx = 1,clscnt4 + pndx = permute(cndx,4) + bndx = clsmap(cndx,4) + do i = 1, avec_len + if ( abs( solution_blk(i,pndx) ) > sol_min ) then + wrk_blk(i) = abs( forcing_blk(i,pndx)/solution_blk(i,pndx) ) + else + wrk_blk(i) = 0._r8 + endif + enddo + max_delta(cndx) = maxval( wrk_blk(1:avec_len) ) + do i = 1, avec_len + solution_blk(i,pndx) = max( 0._r8,solution_blk(i,pndx) ) + base_sol_blk(i,bndx) = solution_blk(i,pndx) + if ( abs( forcing_blk(i,pndx) ) > small ) then + spc_conv_blk(i,cndx) = abs(forcing_blk(i,pndx)) <= epsilon(cndx)*abs(solution_blk(i,pndx)) + else + spc_conv_blk(i,cndx) = .true. + endif + enddo + where( spc_conv_blk(1:avec_len,cndx) .and. .not.diags_out(ofl:ofu,cndx) ) + ! capture output production and loss diagnostics at converged ponits + prod_out(ofl:ofu,cndx) = prod_blk(1:avec_len,cndx) + ind_prd_blk(1:avec_len,cndx) + loss_out(ofl:ofu,cndx) = loss_blk(1:avec_len,cndx) + diags_out(ofl:ofu,cndx) = .true. + endwhere + end do + do i = 1, avec_len + if( .not. cls_conv_blk(i) ) then + cls_conv_blk(i) = all( spc_conv_blk(i,:) ) + end if + end do + convergence = all( cls_conv_blk(:) ) + if( convergence ) then + exit iter_loop + end if + else conv_chk +!----------------------------------------------------------------------- +! ... limit iterate +!----------------------------------------------------------------------- + do m = 1,clscnt4 + do i = 1, avec_len + solution_blk(i,m) = max( 0._r8,solution_blk(i,m) ) + end do + end do +!----------------------------------------------------------------------- +! ... transfer latest solution back to base array +!----------------------------------------------------------------------- + do cndx = 1,clscnt4 + pndx = permute(cndx,4) + bndx = clsmap(cndx,4) + do i = 1, avec_len + base_sol_blk(i,bndx) = solution_blk(i,pndx) + end do + end do + end if conv_chk + end do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + do i = 1,avec_len + if( .not. cls_conv_blk(i) ) then + fail_cnt(i) = fail_cnt(i) + 1 + write(iulog,'('' imp_sol: time step '',1p,g15.7,'' failed to converge @ (lchnk,vctrpos,nstep) = '',3i8)') & + dt(i),lchnk,ofl+i-1,nstep + stp_con_cnt(i) = 0 + if( cut_cnt(i) < cut_limit ) then + cut_cnt(i) = cut_cnt(i) + 1 + if( cut_cnt(i) < cut_limit ) then + dt(i) = .5_r8 * dt(i) + else + dt(i) = .1_r8 * dt(i) + end if + base_sol_blk(i,:) = sbase_sol_blk(i,:) + else + write(iulog,'('' imp_sol: step failed to converge @ (lchnk,vctrpos,nstep,dt,time) = '',3i8,1p,2g15.7)') & + lchnk,ofl+i-1,nstep,dt(i),interval_done+dt(i) + do m = 1,clscnt4 + if( .not. spc_conv_blk(i,m) ) then + write(iulog,'(1x,a16,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + cls_conv_blk(i) = .true. + if( .not. time_stp_done_blk(i) ) then + interval_done(i) = interval_done(i) + dt(i) + time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8 + endif + end if + elseif( .not. time_stp_done_blk(i) ) then + interval_done(i) = interval_done(i) + dt(i) + time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8 + stp_con_cnt(i) = stp_con_cnt(i) + 1 + if( .not. time_stp_done_blk(i) ) then + if( stp_con_cnt(i) >= 2 ) then + dt(i) = 2._r8*dt(i) + stp_con_cnt(i) = 0 + end if + dt(i) = min( dt(i),delt-interval_done(i) ) + else + base_sol(ofl+i-1,1:gas_pcnst) = base_sol_blk(i,1:gas_pcnst) + endif + endif + end do + convergence = all( cls_conv_blk(:) ) + do i = 1,avec_len + if( cls_conv_blk(i) .and. .not. time_stp_done_blk(i) ) then + cls_conv_blk(i) = .false. + endif + end do + if( .not. convergence ) then + cycle time_step_loop + endif + !----------------------------------------------------------------------- + ! ... check for time step done + !----------------------------------------------------------------------- + if( all( time_stp_done_blk(1:avec_len) ) ) then + exit time_step_loop + end if + end do time_step_loop + ofl = ofu + 1 + if( ofl > chnkpnts ) then + exit chnkpnts_loop + end if + end do chnkpnts_loop + end subroutine imp_sol +end module mo_imp_sol diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_indprd.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_indprd.F90 new file mode 100644 index 0000000000..e3a9106c2e --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_indprd.F90 @@ -0,0 +1,170 @@ + module mo_indprd + use shr_kind_mod, only : r8 => shr_kind_r8 + private + public :: indprd + contains + subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) + use chem_mods, only : gas_pcnst, extcnt, rxntot + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: class + integer, intent(in) :: chnkpnts + integer, intent(in) :: nprod + real(r8), intent(in) :: y(chnkpnts,gas_pcnst) + real(r8), intent(in) :: rxt(chnkpnts,rxntot) + real(r8), intent(in) :: extfrc(chnkpnts,extcnt) + real(r8), intent(inout) :: prod(chnkpnts,nprod) +!-------------------------------------------------------------------- +! ... "independent" production for Explicit species +!-------------------------------------------------------------------- + if( class == 1 ) then + prod(:,1) =rxt(:,335)*y(:,137)*y(:,84) +rxt(:,338)*y(:,85) + prod(:,2) =.500_r8*rxt(:,288)*y(:,137)*y(:,76) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,1) = 0._r8 + prod(:,2) = + extfrc(:,7) + prod(:,35) = 0._r8 + prod(:,126) = 0._r8 + prod(:,56) = 0._r8 + prod(:,131) = 0._r8 + prod(:,83) = 0._r8 + prod(:,3) = 0._r8 + prod(:,76) = 0._r8 + prod(:,57) = 0._r8 + prod(:,64) = 0._r8 + prod(:,61) = 0._r8 + prod(:,112) = 0._r8 + prod(:,71) = 0._r8 + prod(:,45) = 0._r8 + prod(:,38) = 0._r8 + prod(:,46) = 0._r8 + prod(:,39) = 0._r8 + prod(:,40) = 0._r8 + prod(:,41) = 0._r8 + prod(:,42) = 0._r8 + prod(:,43) = 0._r8 + prod(:,44) = 0._r8 + prod(:,77) = 0._r8 + prod(:,125) = 0._r8 + prod(:,86) = 0._r8 + prod(:,47) = 0._r8 + prod(:,113) = 0._r8 + prod(:,68) = 0._r8 + prod(:,95) = 0._r8 + prod(:,116) = 0._r8 + prod(:,89) = 0._r8 + prod(:,87) = 0._r8 + prod(:,80) = 0._r8 + prod(:,73) = 0._r8 + prod(:,107) = 0._r8 + prod(:,70) = 0._r8 + prod(:,128) = 0._r8 + prod(:,50) = 0._r8 + prod(:,34) = 0._r8 + prod(:,137) = 0._r8 + prod(:,104) = 0._r8 + prod(:,4) = 0._r8 + prod(:,110) = 0._r8 + prod(:,90) = 0._r8 + prod(:,62) = 0._r8 + prod(:,5) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,48) = 0._r8 + prod(:,105) = 0._r8 + prod(:,92) = 0._r8 + prod(:,124) = 0._r8 + prod(:,111) = 0._r8 + prod(:,36) = 0._r8 + prod(:,84) = 0._r8 + prod(:,49) = 0._r8 + prod(:,100) = 0._r8 + prod(:,51) = 0._r8 + prod(:,52) = 0._r8 + prod(:,55) = 0._r8 + prod(:,127) = 0._r8 + prod(:,9) = 0._r8 + prod(:,101) = 0._r8 + prod(:,69) = 0._r8 + prod(:,94) = 0._r8 + prod(:,99) = 0._r8 + prod(:,109) = 0._r8 + prod(:,66) = 0._r8 + prod(:,103) = 0._r8 + prod(:,97) = 0._r8 + prod(:,79) = 0._r8 + prod(:,114) = 0._r8 + prod(:,63) = 0._r8 + prod(:,85) = 0._r8 + prod(:,122) = 0._r8 + prod(:,75) = 0._r8 + prod(:,53) = 0._r8 + prod(:,60) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,37) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) = 0._r8 + prod(:,138) = + extfrc(:,9) + prod(:,133) = + extfrc(:,1) + prod(:,136) = 0._r8 + prod(:,72) = 0._r8 + prod(:,16) = + extfrc(:,6) + prod(:,17) = + extfrc(:,5) + prod(:,18) = 0._r8 + prod(:,19) = + extfrc(:,8) + prod(:,20) = 0._r8 + prod(:,129) = (rxt(:,5) +2.000_r8*rxt(:,6)) + prod(:,132) = 0._r8 + prod(:,21) = 0._r8 + prod(:,65) = 0._r8 + prod(:,67) = 0._r8 + prod(:,106) = 0._r8 + prod(:,81) = 0._r8 + prod(:,22) = 0._r8 + prod(:,23) = 0._r8 + prod(:,82) = 0._r8 + prod(:,74) = 0._r8 + prod(:,78) = 0._r8 + prod(:,24) = 0._r8 + prod(:,117) = 0._r8 + prod(:,102) = + extfrc(:,3) + prod(:,58) = 0._r8 + prod(:,25) = + extfrc(:,4) + prod(:,26) = + extfrc(:,2) + prod(:,27) = 0._r8 + prod(:,28) = 0._r8 + prod(:,29) = 0._r8 + prod(:,30) = 0._r8 + prod(:,31) = 0._r8 + prod(:,32) = 0._r8 + prod(:,33) = 0._r8 + prod(:,88) = 0._r8 + prod(:,54) = 0._r8 + prod(:,96) = 0._r8 + prod(:,98) = 0._r8 + prod(:,121) = 0._r8 + prod(:,123) = 0._r8 + prod(:,59) = 0._r8 + prod(:,91) = 0._r8 + prod(:,130) = 0._r8 + prod(:,118) = 0._r8 + prod(:,119) = 0._r8 + prod(:,120) = 0._r8 + prod(:,134) =rxt(:,5) + prod(:,135) = 0._r8 + prod(:,93) = 0._r8 + prod(:,108) = 0._r8 + prod(:,115) = 0._r8 + prod(:,139) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_lin_matrix.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_lin_matrix.F90 new file mode 100644 index 0000000000..e182d93817 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_lin_matrix.F90 @@ -0,0 +1,396 @@ + module mo_lin_matrix + use chem_mods, only: veclen + private + public :: linmat + contains + subroutine linmat01( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,1) = -( het_rates(k,1) ) + mat(k,2) = -( het_rates(k,2) ) + mat(k,39) = -( het_rates(k,3) ) + mat(k,800) = -( het_rates(k,4) ) + mat(k,109) = rxt(k,46) + mat(k,961) = rxt(k,47) + mat(k,271) = rxt(k,49) + mat(k,74) = rxt(k,51) + mat(k,52) = rxt(k,52) + mat(k,228) = 2.000_r8*rxt(k,58) + mat(k,294) = rxt(k,59) + mat(k,183) = 3.000_r8*rxt(k,62) + mat(k,43) = 2.000_r8*rxt(k,68) + mat(k,410) = rxt(k,69) + mat(k,353) = rxt(k,75) + mat(k,108) = -( rxt(k,46) + het_rates(k,5) ) + mat(k,966) = -( rxt(k,47) + het_rates(k,6) ) + mat(k,273) = rxt(k,48) + mat(k,268) = -( rxt(k,48) + rxt(k,49) + rxt(k,345) + rxt(k,348) + rxt(k,353) & + + het_rates(k,7) ) + mat(k,3) = -( het_rates(k,8) ) + mat(k,220) = -( het_rates(k,9) ) + mat(k,111) = -( het_rates(k,10) ) + mat(k,147) = -( rxt(k,19) + het_rates(k,11) ) + mat(k,130) = -( het_rates(k,12) ) + mat(k,530) = -( het_rates(k,13) ) + mat(k,709) = .700_r8*rxt(k,39) + mat(k,188) = -( rxt(k,20) + het_rates(k,14) ) + mat(k,69) = -( het_rates(k,15) ) + mat(k,48) = -( rxt(k,50) + het_rates(k,16) ) + mat(k,73) = -( rxt(k,51) + het_rates(k,17) ) + mat(k,51) = -( rxt(k,52) + het_rates(k,18) ) + mat(k,54) = -( rxt(k,53) + het_rates(k,19) ) + mat(k,57) = -( rxt(k,54) + het_rates(k,20) ) + mat(k,60) = -( rxt(k,55) + het_rates(k,21) ) + mat(k,63) = -( rxt(k,56) + het_rates(k,22) ) + mat(k,66) = -( rxt(k,57) + het_rates(k,23) ) + mat(k,227) = -( rxt(k,58) + het_rates(k,24) ) + mat(k,783) = -( rxt(k,21) + rxt(k,22) + het_rates(k,25) ) + mat(k,203) = rxt(k,27) + mat(k,482) = .180_r8*rxt(k,28) + mat(k,461) = rxt(k,32) + mat(k,506) = rxt(k,34) + mat(k,245) = .690_r8*rxt(k,35) + mat(k,565) = 1.340_r8*rxt(k,36) + mat(k,197) = rxt(k,40) + mat(k,470) = rxt(k,41) + mat(k,264) = rxt(k,43) + mat(k,209) = rxt(k,44) + mat(k,122) = 2.000_r8*rxt(k,245) + mat(k,292) = -( rxt(k,59) + het_rates(k,26) ) + mat(k,77) = -( rxt(k,60) + het_rates(k,27) ) + mat(k,550) = -( rxt(k,23) + het_rates(k,28) ) + mat(k,149) = rxt(k,19) + mat(k,263) = rxt(k,43) + mat(k,168) = -( rxt(k,61) + het_rates(k,29) ) + mat(k,360) = -( rxt(k,24) + het_rates(k,30) ) + mat(k,189) = .820_r8*rxt(k,20) + mat(k,591) = -( rxt(k,25) + het_rates(k,31) ) + mat(k,318) = -( het_rates(k,32) ) + mat(k,301) = -( rxt(k,26) + het_rates(k,33) ) + mat(k,248) = -( het_rates(k,34) ) + mat(k,200) = -( rxt(k,27) + het_rates(k,35) ) + mat(k,477) = -( rxt(k,28) + rxt(k,29) + het_rates(k,36) ) + mat(k,182) = -( rxt(k,62) + het_rates(k,37) ) + mat(k,856) = -( het_rates(k,38) ) + mat(k,110) = rxt(k,46) + mat(k,49) = 4.000_r8*rxt(k,50) + mat(k,75) = rxt(k,51) + mat(k,55) = 3.000_r8*rxt(k,53) + mat(k,58) = 3.000_r8*rxt(k,54) + mat(k,61) = 2.000_r8*rxt(k,55) + mat(k,64) = rxt(k,56) + mat(k,67) = 2.000_r8*rxt(k,57) + mat(k,78) = 3.000_r8*rxt(k,60) + mat(k,172) = rxt(k,61) + mat(k,88) = 2.000_r8*rxt(k,63) + mat(k,37) = 2.000_r8*rxt(k,64) + mat(k,1234) = rxt(k,65) + mat(k,450) = rxt(k,67) + mat(k,90) = rxt(k,70) + mat(k,94) = rxt(k,71) + mat(k,104) = rxt(k,72) + mat(k,821) = rxt(k,73) + mat(k,403) = rxt(k,76) + mat(k,87) = -( rxt(k,63) + het_rates(k,39) ) + mat(k,36) = -( rxt(k,64) + rxt(k,172) + het_rates(k,40) ) + mat(k,1243) = -( rxt(k,65) + het_rates(k,41) ) + mat(k,455) = rxt(k,66) + mat(k,156) = rxt(k,77) + mat(k,38) = 2.000_r8*rxt(k,172) + mat(k,448) = -( rxt(k,66) + rxt(k,67) + rxt(k,347) + rxt(k,352) + rxt(k,358) & + + het_rates(k,42) ) + mat(k,4) = -( het_rates(k,43) ) + mat(k,510) = -( het_rates(k,44) ) + mat(k,780) = rxt(k,21) + rxt(k,22) + mat(k,549) = rxt(k,23) + mat(k,590) = rxt(k,25) + mat(k,478) = .380_r8*rxt(k,28) + mat(k,324) = rxt(k,30) + mat(k,460) = rxt(k,32) + mat(k,337) = 2.000_r8*rxt(k,33) + mat(k,559) = 1.340_r8*rxt(k,37) + mat(k,708) = .700_r8*rxt(k,39) + mat(k,468) = rxt(k,41) + mat(k,163) = rxt(k,80) + mat(k,323) = -( rxt(k,30) + het_rates(k,45) ) + mat(k,302) = rxt(k,26) + mat(k,476) = .440_r8*rxt(k,28) + mat(k,253) = .400_r8*rxt(k,42) + mat(k,136) = -( het_rates(k,46) ) + mat(k,5) = -( het_rates(k,47) ) + mat(k,6) = -( het_rates(k,48) ) + mat(k,7) = -( het_rates(k,49) ) + mat(k,8) = -( rxt(k,360) + het_rates(k,50) ) + mat(k,81) = -( rxt(k,31) + het_rates(k,51) ) + mat(k,459) = -( rxt(k,32) + het_rates(k,52) ) + mat(k,121) = rxt(k,246) + mat(k,336) = -( rxt(k,33) + het_rates(k,53) ) + mat(k,769) = -( rxt(k,100) + het_rates(k,54) ) + mat(k,1293) = rxt(k,2) + 2.000_r8*rxt(k,3) + mat(k,782) = 2.000_r8*rxt(k,21) + mat(k,202) = rxt(k,27) + mat(k,481) = .330_r8*rxt(k,28) + rxt(k,29) + mat(k,409) = rxt(k,69) + mat(k,818) = rxt(k,73) + mat(k,10) = rxt(k,74) + mat(k,514) = -( het_rates(k,55) ) + mat(k,1291) = rxt(k,1) + mat(k,781) = rxt(k,22) + mat(k,479) = 1.440_r8*rxt(k,28) + mat(k,42) = -( rxt(k,68) + het_rates(k,56) ) + mat(k,276) = -( rxt(k,4) + het_rates(k,57) ) + mat(k,84) = -( rxt(k,79) + het_rates(k,58) ) + mat(k,408) = -( rxt(k,69) + het_rates(k,59) ) + mat(k,89) = -( rxt(k,70) + het_rates(k,60) ) + mat(k,93) = -( rxt(k,71) + het_rates(k,61) ) + mat(k,103) = -( rxt(k,72) + het_rates(k,62) ) + mat(k,820) = -( rxt(k,73) + het_rates(k,63) ) + mat(k,9) = -( rxt(k,74) + het_rates(k,64) ) + mat(k,416) = -( rxt(k,9) + het_rates(k,65) ) + mat(k,125) = 2.000_r8*rxt(k,337) + 2.000_r8*rxt(k,343) + 2.000_r8*rxt(k,346) & + + 2.000_r8*rxt(k,357) + mat(k,1028) = .500_r8*rxt(k,339) + mat(k,1185) = rxt(k,340) + mat(k,466) = rxt(k,341) + mat(k,270) = rxt(k,345) + rxt(k,348) + rxt(k,353) + mat(k,447) = rxt(k,347) + rxt(k,352) + rxt(k,358) + mat(k,176) = -( rxt(k,10) + rxt(k,11) + rxt(k,135) + het_rates(k,66) ) + mat(k,352) = -( rxt(k,75) + het_rates(k,67) ) + mat(k,269) = rxt(k,345) + rxt(k,348) + rxt(k,353) + mat(k,401) = -( rxt(k,76) + het_rates(k,68) ) + mat(k,446) = rxt(k,347) + rxt(k,352) + rxt(k,358) + mat(k,503) = -( rxt(k,34) + het_rates(k,69) ) + mat(k,157) = -( het_rates(k,70) ) + mat(k,429) = -( het_rates(k,71) ) + mat(k,377) = -( het_rates(k,72) ) + mat(k,240) = -( rxt(k,35) + het_rates(k,73) ) + mat(k,560) = -( rxt(k,36) + rxt(k,37) + het_rates(k,74) ) + mat(k,241) = .288_r8*rxt(k,35) + mat(k,142) = -( het_rates(k,75) ) + mat(k,283) = -( rxt(k,38) + rxt(k,292) + het_rates(k,76) ) + mat(k,715) = -( rxt(k,39) + het_rates(k,77) ) + mat(k,244) = .402_r8*rxt(k,35) + mat(k,213) = -( rxt(k,117) + het_rates(k,78) ) + mat(k,1248) = rxt(k,15) + mat(k,97) = -( rxt(k,12) + het_rates(k,79) ) + mat(k,124) = -( rxt(k,13) + rxt(k,14) + rxt(k,136) + rxt(k,337) + rxt(k,343) & + + rxt(k,346) + rxt(k,357) + het_rates(k,80) ) + mat(k,11) = -( het_rates(k,81) ) + mat(k,12) = -( het_rates(k,82) ) + mat(k,13) = -( het_rates(k,83) ) + mat(k,45) = -( het_rates(k,84) ) + mat(k,14) = -( rxt(k,338) + het_rates(k,85) ) + mat(k,15) = -( rxt(k,362) + het_rates(k,86) ) + mat(k,16) = -( rxt(k,361) + het_rates(k,87) ) + mat(k,1286) = -( rxt(k,15) + het_rates(k,88) ) + mat(k,129) = rxt(k,14) + mat(k,1053) = rxt(k,16) + .500_r8*rxt(k,339) + mat(k,1219) = rxt(k,17) + mat(k,219) = rxt(k,117) + mat(k,1048) = -( rxt(k,16) + rxt(k,339) + het_rates(k,89) ) + mat(k,417) = rxt(k,9) + mat(k,178) = rxt(k,11) + rxt(k,135) + mat(k,127) = rxt(k,13) + rxt(k,136) + mat(k,1214) = rxt(k,18) + mat(k,289) = rxt(k,38) + rxt(k,292) + mat(k,198) = rxt(k,40) + mat(k,472) = rxt(k,41) + mat(k,257) = .600_r8*rxt(k,42) + rxt(k,252) + mat(k,274) = rxt(k,48) + mat(k,452) = rxt(k,66) + mat(k,1217) = -( rxt(k,17) + rxt(k,18) + rxt(k,340) + het_rates(k,90) ) + mat(k,180) = rxt(k,10) + mat(k,128) = rxt(k,13) + rxt(k,14) + rxt(k,136) + mat(k,259) = .400_r8*rxt(k,42) + mat(k,275) = rxt(k,49) + mat(k,454) = rxt(k,67) + mat(k,194) = -( rxt(k,40) + het_rates(k,91) ) + mat(k,17) = -( het_rates(k,92) ) + mat(k,18) = -( het_rates(k,93) ) + end do + end subroutine linmat01 + subroutine linmat02( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k + do k = 1,avec_len + mat(k,19) = -( het_rates(k,94) ) + mat(k,20) = -( het_rates(k,95) ) + mat(k,21) = -( het_rates(k,96) ) + mat(k,886) = -( rxt(k,94) + het_rates(k,97) ) + mat(k,1297) = rxt(k,3) + mat(k,1008) = rxt(k,8) + mat(k,126) = rxt(k,14) + mat(k,1277) = rxt(k,15) + mat(k,1044) = rxt(k,16) + mat(k,1210) = rxt(k,18) + mat(k,485) = .180_r8*rxt(k,28) + mat(k,325) = rxt(k,30) + mat(k,964) = rxt(k,47) + mat(k,1235) = rxt(k,65) + mat(k,155) = rxt(k,77) + mat(k,606) = rxt(k,81) + rxt(k,329) + mat(k,424) = rxt(k,82) + mat(k,118) = rxt(k,83) + mat(k,1081) = rxt(k,88) + rxt(k,89) + mat(k,215) = rxt(k,117) + mat(k,237) = rxt(k,322) + mat(k,1011) = -( rxt(k,7) + rxt(k,8) + het_rates(k,98) ) + mat(k,889) = rxt(k,94) + mat(k,22) = -( het_rates(k,99) ) + mat(k,152) = -( rxt(k,77) + het_rates(k,100) ) + mat(k,160) = -( rxt(k,80) + het_rates(k,101) ) + mat(k,467) = -( rxt(k,41) + rxt(k,341) + het_rates(k,102) ) + mat(k,252) = -( rxt(k,42) + rxt(k,252) + het_rates(k,103) ) + mat(k,23) = -( het_rates(k,104) ) + mat(k,24) = -( het_rates(k,105) ) + mat(k,260) = -( rxt(k,43) + het_rates(k,106) ) + mat(k,206) = -( rxt(k,44) + het_rates(k,107) ) + mat(k,234) = -( rxt(k,322) + het_rates(k,108) ) + mat(k,161) = rxt(k,80) + mat(k,600) = rxt(k,81) + mat(k,25) = -( rxt(k,78) + het_rates(k,109) ) + mat(k,602) = -( rxt(k,81) + rxt(k,329) + het_rates(k,110) ) + mat(k,423) = rxt(k,82) + mat(k,235) = rxt(k,322) + mat(k,422) = -( rxt(k,82) + het_rates(k,111) ) + mat(k,117) = rxt(k,83) + mat(k,601) = rxt(k,329) + mat(k,116) = -( rxt(k,83) + het_rates(k,112) ) + mat(k,85) = rxt(k,79) + mat(k,26) = -( het_rates(k,113) ) + mat(k,27) = -( het_rates(k,114) ) + mat(k,28) = -( het_rates(k,115) ) + mat(k,29) = -( het_rates(k,116) ) + mat(k,30) = -( rxt(k,84) + het_rates(k,117) ) + mat(k,31) = -( rxt(k,85) + het_rates(k,118) ) + mat(k,32) = -( rxt(k,342) + het_rates(k,119) ) + mat(k,34) = -( het_rates(k,120) ) + mat(k,33) = rxt(k,342) + mat(k,35) = -( rxt(k,363) + het_rates(k,121) ) + mat(k,308) = -( het_rates(k,122) ) + mat(k,100) = -( rxt(k,45) + het_rates(k,123) ) + mat(k,369) = -( het_rates(k,126) ) + mat(k,389) = -( het_rates(k,127) ) + mat(k,695) = -( het_rates(k,128) ) + mat(k,362) = rxt(k,24) + mat(k,592) = rxt(k,25) + mat(k,505) = rxt(k,34) + mat(k,564) = 1.340_r8*rxt(k,36) + mat(k,714) = .300_r8*rxt(k,39) + mat(k,196) = rxt(k,40) + mat(k,254) = .600_r8*rxt(k,42) + rxt(k,252) + mat(k,208) = rxt(k,44) + mat(k,753) = -( het_rates(k,129) ) + mat(k,552) = rxt(k,23) + mat(k,363) = rxt(k,24) + mat(k,304) = rxt(k,26) + mat(k,480) = rxt(k,29) + mat(k,716) = .300_r8*rxt(k,39) + mat(k,255) = .400_r8*rxt(k,42) + mat(k,293) = rxt(k,59) + mat(k,170) = rxt(k,61) + mat(k,120) = -( rxt(k,245) + rxt(k,246) + het_rates(k,130) ) + mat(k,82) = rxt(k,31) + mat(k,328) = -( het_rates(k,131) ) + mat(k,943) = -( rxt(k,336) + het_rates(k,132) ) + mat(k,177) = rxt(k,11) + rxt(k,135) + mat(k,150) = rxt(k,19) + mat(k,191) = rxt(k,20) + mat(k,554) = rxt(k,23) + mat(k,594) = rxt(k,25) + mat(k,463) = 2.000_r8*rxt(k,32) + mat(k,339) = 2.000_r8*rxt(k,33) + mat(k,507) = rxt(k,34) + mat(k,246) = rxt(k,35) + mat(k,567) = 1.340_r8*rxt(k,36) + .660_r8*rxt(k,37) + mat(k,471) = rxt(k,41) + mat(k,265) = rxt(k,43) + mat(k,773) = rxt(k,100) + mat(k,123) = rxt(k,245) + rxt(k,246) + mat(k,626) = -( het_rates(k,133) ) + mat(k,649) = -( het_rates(k,134) ) + mat(k,668) = -( het_rates(k,135) ) + mat(k,563) = .660_r8*rxt(k,36) + mat(k,286) = rxt(k,38) + rxt(k,292) + mat(k,1086) = -( rxt(k,88) + rxt(k,89) + het_rates(k,136) ) + mat(k,1302) = rxt(k,1) + mat(k,1013) = rxt(k,7) + mat(k,98) = rxt(k,12) + mat(k,1172) = -( het_rates(k,137) ) + mat(k,1303) = rxt(k,2) + mat(k,281) = 2.000_r8*rxt(k,4) + mat(k,418) = rxt(k,9) + mat(k,179) = rxt(k,10) + mat(k,151) = rxt(k,19) + mat(k,192) = rxt(k,20) + mat(k,306) = rxt(k,26) + mat(k,204) = rxt(k,27) + mat(k,488) = .330_r8*rxt(k,28) + mat(k,83) = rxt(k,31) + mat(k,266) = rxt(k,43) + mat(k,210) = rxt(k,44) + mat(k,102) = rxt(k,45) + mat(k,358) = rxt(k,75) + mat(k,405) = rxt(k,76) + mat(k,1050) = .500_r8*rxt(k,339) + mat(k,342) = -( het_rates(k,138) ) + mat(k,492) = -( het_rates(k,139) ) + mat(k,578) = -( het_rates(k,140) ) + mat(k,1307) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,141) ) + mat(k,489) = .050_r8*rxt(k,28) + mat(k,86) = rxt(k,79) + mat(k,952) = rxt(k,336) + end do + end subroutine linmat02 + subroutine linmat( avec_len, mat, y, rxt, het_rates ) +!---------------------------------------------- +! ... linear matrix entries for implicit species +!---------------------------------------------- + use chem_mods, only : gas_pcnst, rxntot, nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) + real(r8), intent(inout) :: mat(veclen,nzcnt) + call linmat01( avec_len, mat, y, rxt, het_rates ) + call linmat02( avec_len, mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_factor.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_factor.F90 new file mode 100644 index 0000000000..40790de3b2 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_factor.F90 @@ -0,0 +1,4871 @@ + module mo_lu_factor + use chem_mods, only: veclen + private + public :: lu_fac + contains + subroutine lu_fac01( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1) = 1._r8 / lu(k,1) + lu(k,2) = 1._r8 / lu(k,2) + lu(k,3) = 1._r8 / lu(k,3) + lu(k,4) = 1._r8 / lu(k,4) + lu(k,5) = 1._r8 / lu(k,5) + lu(k,6) = 1._r8 / lu(k,6) + lu(k,7) = 1._r8 / lu(k,7) + lu(k,8) = 1._r8 / lu(k,8) + lu(k,9) = 1._r8 / lu(k,9) + lu(k,10) = lu(k,10) * lu(k,9) + lu(k,11) = 1._r8 / lu(k,11) + lu(k,12) = 1._r8 / lu(k,12) + lu(k,13) = 1._r8 / lu(k,13) + lu(k,14) = 1._r8 / lu(k,14) + lu(k,15) = 1._r8 / lu(k,15) + lu(k,16) = 1._r8 / lu(k,16) + lu(k,17) = 1._r8 / lu(k,17) + lu(k,18) = 1._r8 / lu(k,18) + lu(k,19) = 1._r8 / lu(k,19) + lu(k,20) = 1._r8 / lu(k,20) + lu(k,21) = 1._r8 / lu(k,21) + lu(k,22) = 1._r8 / lu(k,22) + lu(k,23) = 1._r8 / lu(k,23) + lu(k,24) = 1._r8 / lu(k,24) + lu(k,25) = 1._r8 / lu(k,25) + lu(k,26) = 1._r8 / lu(k,26) + lu(k,27) = 1._r8 / lu(k,27) + lu(k,28) = 1._r8 / lu(k,28) + lu(k,29) = 1._r8 / lu(k,29) + lu(k,30) = 1._r8 / lu(k,30) + lu(k,31) = 1._r8 / lu(k,31) + lu(k,32) = 1._r8 / lu(k,32) + lu(k,33) = lu(k,33) * lu(k,32) + lu(k,34) = 1._r8 / lu(k,34) + lu(k,35) = 1._r8 / lu(k,35) + lu(k,36) = 1._r8 / lu(k,36) + lu(k,37) = lu(k,37) * lu(k,36) + lu(k,38) = lu(k,38) * lu(k,36) + lu(k,1234) = lu(k,1234) - lu(k,37) * lu(k,1221) + lu(k,1243) = lu(k,1243) - lu(k,38) * lu(k,1221) + lu(k,39) = 1._r8 / lu(k,39) + lu(k,40) = lu(k,40) * lu(k,39) + lu(k,41) = lu(k,41) * lu(k,39) + lu(k,1135) = lu(k,1135) - lu(k,40) * lu(k,1092) + lu(k,1172) = lu(k,1172) - lu(k,41) * lu(k,1092) + lu(k,42) = 1._r8 / lu(k,42) + lu(k,43) = lu(k,43) * lu(k,42) + lu(k,44) = lu(k,44) * lu(k,42) + lu(k,1078) = lu(k,1078) - lu(k,43) * lu(k,1055) + lu(k,1086) = lu(k,1086) - lu(k,44) * lu(k,1055) + lu(k,45) = 1._r8 / lu(k,45) + lu(k,46) = lu(k,46) * lu(k,45) + lu(k,47) = lu(k,47) * lu(k,45) + lu(k,1172) = lu(k,1172) - lu(k,46) * lu(k,1093) + lu(k,1176) = lu(k,1176) - lu(k,47) * lu(k,1093) + lu(k,48) = 1._r8 / lu(k,48) + lu(k,49) = lu(k,49) * lu(k,48) + lu(k,50) = lu(k,50) * lu(k,48) + lu(k,1080) = lu(k,1080) - lu(k,49) * lu(k,1056) + lu(k,1086) = lu(k,1086) - lu(k,50) * lu(k,1056) + lu(k,51) = 1._r8 / lu(k,51) + lu(k,52) = lu(k,52) * lu(k,51) + lu(k,53) = lu(k,53) * lu(k,51) + lu(k,1078) = lu(k,1078) - lu(k,52) * lu(k,1057) + lu(k,1086) = lu(k,1086) - lu(k,53) * lu(k,1057) + end do + end subroutine lu_fac01 + subroutine lu_fac02( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,54) = 1._r8 / lu(k,54) + lu(k,55) = lu(k,55) * lu(k,54) + lu(k,56) = lu(k,56) * lu(k,54) + lu(k,1080) = lu(k,1080) - lu(k,55) * lu(k,1058) + lu(k,1086) = lu(k,1086) - lu(k,56) * lu(k,1058) + lu(k,57) = 1._r8 / lu(k,57) + lu(k,58) = lu(k,58) * lu(k,57) + lu(k,59) = lu(k,59) * lu(k,57) + lu(k,1080) = lu(k,1080) - lu(k,58) * lu(k,1059) + lu(k,1086) = lu(k,1086) - lu(k,59) * lu(k,1059) + lu(k,60) = 1._r8 / lu(k,60) + lu(k,61) = lu(k,61) * lu(k,60) + lu(k,62) = lu(k,62) * lu(k,60) + lu(k,1080) = lu(k,1080) - lu(k,61) * lu(k,1060) + lu(k,1086) = lu(k,1086) - lu(k,62) * lu(k,1060) + lu(k,63) = 1._r8 / lu(k,63) + lu(k,64) = lu(k,64) * lu(k,63) + lu(k,65) = lu(k,65) * lu(k,63) + lu(k,1080) = lu(k,1080) - lu(k,64) * lu(k,1061) + lu(k,1086) = lu(k,1086) - lu(k,65) * lu(k,1061) + lu(k,66) = 1._r8 / lu(k,66) + lu(k,67) = lu(k,67) * lu(k,66) + lu(k,68) = lu(k,68) * lu(k,66) + lu(k,1080) = lu(k,1080) - lu(k,67) * lu(k,1062) + lu(k,1086) = lu(k,1086) - lu(k,68) * lu(k,1062) + lu(k,69) = 1._r8 / lu(k,69) + lu(k,70) = lu(k,70) * lu(k,69) + lu(k,71) = lu(k,71) * lu(k,69) + lu(k,72) = lu(k,72) * lu(k,69) + lu(k,1135) = lu(k,1135) - lu(k,70) * lu(k,1094) + lu(k,1172) = lu(k,1172) - lu(k,71) * lu(k,1094) + lu(k,1176) = lu(k,1176) - lu(k,72) * lu(k,1094) + lu(k,73) = 1._r8 / lu(k,73) + lu(k,74) = lu(k,74) * lu(k,73) + lu(k,75) = lu(k,75) * lu(k,73) + lu(k,76) = lu(k,76) * lu(k,73) + lu(k,1078) = lu(k,1078) - lu(k,74) * lu(k,1063) + lu(k,1080) = lu(k,1080) - lu(k,75) * lu(k,1063) + lu(k,1086) = lu(k,1086) - lu(k,76) * lu(k,1063) + lu(k,77) = 1._r8 / lu(k,77) + lu(k,78) = lu(k,78) * lu(k,77) + lu(k,79) = lu(k,79) * lu(k,77) + lu(k,80) = lu(k,80) * lu(k,77) + lu(k,1165) = lu(k,1165) - lu(k,78) * lu(k,1095) + lu(k,1172) = lu(k,1172) - lu(k,79) * lu(k,1095) + lu(k,1176) = lu(k,1176) - lu(k,80) * lu(k,1095) + lu(k,81) = 1._r8 / lu(k,81) + lu(k,82) = lu(k,82) * lu(k,81) + lu(k,83) = lu(k,83) * lu(k,81) + lu(k,327) = lu(k,327) - lu(k,82) * lu(k,326) + lu(k,333) = - lu(k,83) * lu(k,326) + lu(k,899) = - lu(k,82) * lu(k,897) + lu(k,948) = lu(k,948) - lu(k,83) * lu(k,897) + lu(k,84) = 1._r8 / lu(k,84) + lu(k,85) = lu(k,85) * lu(k,84) + lu(k,86) = lu(k,86) * lu(k,84) + lu(k,116) = lu(k,116) - lu(k,85) * lu(k,115) + lu(k,119) = lu(k,119) - lu(k,86) * lu(k,115) + lu(k,1289) = lu(k,1289) - lu(k,85) * lu(k,1288) + lu(k,1307) = lu(k,1307) - lu(k,86) * lu(k,1288) + lu(k,87) = 1._r8 / lu(k,87) + lu(k,88) = lu(k,88) * lu(k,87) + lu(k,403) = lu(k,403) - lu(k,88) * lu(k,400) + lu(k,450) = lu(k,450) - lu(k,88) * lu(k,445) + lu(k,821) = lu(k,821) - lu(k,88) * lu(k,812) + lu(k,856) = lu(k,856) - lu(k,88) * lu(k,832) + lu(k,1234) = lu(k,1234) - lu(k,88) * lu(k,1222) + lu(k,89) = 1._r8 / lu(k,89) + lu(k,90) = lu(k,90) * lu(k,89) + lu(k,91) = lu(k,91) * lu(k,89) + lu(k,92) = lu(k,92) * lu(k,89) + lu(k,1080) = lu(k,1080) - lu(k,90) * lu(k,1064) + lu(k,1086) = lu(k,1086) - lu(k,91) * lu(k,1064) + lu(k,1087) = lu(k,1087) - lu(k,92) * lu(k,1064) + lu(k,1165) = lu(k,1165) - lu(k,90) * lu(k,1096) + lu(k,1171) = - lu(k,91) * lu(k,1096) + lu(k,1172) = lu(k,1172) - lu(k,92) * lu(k,1096) + lu(k,93) = 1._r8 / lu(k,93) + lu(k,94) = lu(k,94) * lu(k,93) + lu(k,95) = lu(k,95) * lu(k,93) + lu(k,96) = lu(k,96) * lu(k,93) + lu(k,1080) = lu(k,1080) - lu(k,94) * lu(k,1065) + lu(k,1086) = lu(k,1086) - lu(k,95) * lu(k,1065) + lu(k,1087) = lu(k,1087) - lu(k,96) * lu(k,1065) + lu(k,1165) = lu(k,1165) - lu(k,94) * lu(k,1097) + lu(k,1171) = lu(k,1171) - lu(k,95) * lu(k,1097) + lu(k,1172) = lu(k,1172) - lu(k,96) * lu(k,1097) + lu(k,97) = 1._r8 / lu(k,97) + lu(k,98) = lu(k,98) * lu(k,97) + lu(k,99) = lu(k,99) * lu(k,97) + lu(k,217) = - lu(k,98) * lu(k,212) + lu(k,219) = lu(k,219) - lu(k,99) * lu(k,212) + lu(k,1049) = - lu(k,98) * lu(k,1019) + lu(k,1053) = lu(k,1053) - lu(k,99) * lu(k,1019) + lu(k,1086) = lu(k,1086) - lu(k,98) * lu(k,1066) + lu(k,1090) = lu(k,1090) - lu(k,99) * lu(k,1066) + end do + end subroutine lu_fac02 + subroutine lu_fac03( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,100) = 1._r8 / lu(k,100) + lu(k,101) = lu(k,101) * lu(k,100) + lu(k,102) = lu(k,102) * lu(k,100) + lu(k,578) = lu(k,578) - lu(k,101) * lu(k,571) + lu(k,586) = - lu(k,102) * lu(k,571) + lu(k,929) = lu(k,929) - lu(k,101) * lu(k,898) + lu(k,948) = lu(k,948) - lu(k,102) * lu(k,898) + lu(k,1152) = lu(k,1152) - lu(k,101) * lu(k,1098) + lu(k,1172) = lu(k,1172) - lu(k,102) * lu(k,1098) + lu(k,103) = 1._r8 / lu(k,103) + lu(k,104) = lu(k,104) * lu(k,103) + lu(k,105) = lu(k,105) * lu(k,103) + lu(k,106) = lu(k,106) * lu(k,103) + lu(k,107) = lu(k,107) * lu(k,103) + lu(k,1080) = lu(k,1080) - lu(k,104) * lu(k,1067) + lu(k,1086) = lu(k,1086) - lu(k,105) * lu(k,1067) + lu(k,1087) = lu(k,1087) - lu(k,106) * lu(k,1067) + lu(k,1091) = lu(k,1091) - lu(k,107) * lu(k,1067) + lu(k,1165) = lu(k,1165) - lu(k,104) * lu(k,1099) + lu(k,1171) = lu(k,1171) - lu(k,105) * lu(k,1099) + lu(k,1172) = lu(k,1172) - lu(k,106) * lu(k,1099) + lu(k,1176) = lu(k,1176) - lu(k,107) * lu(k,1099) + lu(k,108) = 1._r8 / lu(k,108) + lu(k,109) = lu(k,109) * lu(k,108) + lu(k,110) = lu(k,110) * lu(k,108) + lu(k,353) = lu(k,353) - lu(k,109) * lu(k,351) + lu(k,355) = - lu(k,110) * lu(k,351) + lu(k,819) = - lu(k,109) * lu(k,813) + lu(k,821) = lu(k,821) - lu(k,110) * lu(k,813) + lu(k,961) = lu(k,961) - lu(k,109) * lu(k,953) + lu(k,963) = lu(k,963) - lu(k,110) * lu(k,953) + lu(k,1232) = lu(k,1232) - lu(k,109) * lu(k,1223) + lu(k,1234) = lu(k,1234) - lu(k,110) * lu(k,1223) + lu(k,111) = 1._r8 / lu(k,111) + lu(k,112) = lu(k,112) * lu(k,111) + lu(k,113) = lu(k,113) * lu(k,111) + lu(k,114) = lu(k,114) * lu(k,111) + lu(k,370) = lu(k,370) - lu(k,112) * lu(k,366) + lu(k,373) = lu(k,373) - lu(k,113) * lu(k,366) + lu(k,375) = - lu(k,114) * lu(k,366) + lu(k,744) = lu(k,744) - lu(k,112) * lu(k,730) + lu(k,759) = lu(k,759) - lu(k,113) * lu(k,730) + lu(k,763) = - lu(k,114) * lu(k,730) + lu(k,1150) = lu(k,1150) - lu(k,112) * lu(k,1100) + lu(k,1167) = lu(k,1167) - lu(k,113) * lu(k,1100) + lu(k,1172) = lu(k,1172) - lu(k,114) * lu(k,1100) + lu(k,116) = 1._r8 / lu(k,116) + lu(k,117) = lu(k,117) * lu(k,116) + lu(k,118) = lu(k,118) * lu(k,116) + lu(k,119) = lu(k,119) * lu(k,116) + lu(k,422) = lu(k,422) - lu(k,117) * lu(k,421) + lu(k,424) = lu(k,424) - lu(k,118) * lu(k,421) + lu(k,427) = - lu(k,119) * lu(k,421) + lu(k,1139) = lu(k,1139) - lu(k,117) * lu(k,1101) + lu(k,1166) = lu(k,1166) - lu(k,118) * lu(k,1101) + lu(k,1176) = lu(k,1176) - lu(k,119) * lu(k,1101) + lu(k,1290) = - lu(k,117) * lu(k,1289) + lu(k,1297) = lu(k,1297) - lu(k,118) * lu(k,1289) + lu(k,1307) = lu(k,1307) - lu(k,119) * lu(k,1289) + lu(k,120) = 1._r8 / lu(k,120) + lu(k,121) = lu(k,121) * lu(k,120) + lu(k,122) = lu(k,122) * lu(k,120) + lu(k,123) = lu(k,123) * lu(k,120) + lu(k,329) = - lu(k,121) * lu(k,327) + lu(k,330) = lu(k,330) - lu(k,122) * lu(k,327) + lu(k,331) = lu(k,331) - lu(k,123) * lu(k,327) + lu(k,921) = - lu(k,121) * lu(k,899) + lu(k,938) = lu(k,938) - lu(k,122) * lu(k,899) + lu(k,943) = lu(k,943) - lu(k,123) * lu(k,899) + lu(k,1257) = lu(k,1257) - lu(k,121) * lu(k,1246) + lu(k,1273) = lu(k,1273) - lu(k,122) * lu(k,1246) + lu(k,1278) = lu(k,1278) - lu(k,123) * lu(k,1246) + lu(k,124) = 1._r8 / lu(k,124) + lu(k,125) = lu(k,125) * lu(k,124) + lu(k,126) = lu(k,126) * lu(k,124) + lu(k,127) = lu(k,127) * lu(k,124) + lu(k,128) = lu(k,128) * lu(k,124) + lu(k,129) = lu(k,129) * lu(k,124) + lu(k,1028) = lu(k,1028) - lu(k,125) * lu(k,1020) + lu(k,1044) = lu(k,1044) - lu(k,126) * lu(k,1020) + lu(k,1048) = lu(k,1048) - lu(k,127) * lu(k,1020) + lu(k,1051) = lu(k,1051) - lu(k,128) * lu(k,1020) + lu(k,1053) = lu(k,1053) - lu(k,129) * lu(k,1020) + lu(k,1185) = lu(k,1185) - lu(k,125) * lu(k,1177) + lu(k,1210) = lu(k,1210) - lu(k,126) * lu(k,1177) + lu(k,1214) = lu(k,1214) - lu(k,127) * lu(k,1177) + lu(k,1217) = lu(k,1217) - lu(k,128) * lu(k,1177) + lu(k,1219) = lu(k,1219) - lu(k,129) * lu(k,1177) + lu(k,130) = 1._r8 / lu(k,130) + lu(k,131) = lu(k,131) * lu(k,130) + lu(k,132) = lu(k,132) * lu(k,130) + lu(k,133) = lu(k,133) * lu(k,130) + lu(k,134) = lu(k,134) * lu(k,130) + lu(k,135) = lu(k,135) * lu(k,130) + lu(k,841) = lu(k,841) - lu(k,131) * lu(k,833) + lu(k,855) = lu(k,855) - lu(k,132) * lu(k,833) + lu(k,856) = lu(k,856) - lu(k,133) * lu(k,833) + lu(k,863) = lu(k,863) - lu(k,134) * lu(k,833) + lu(k,867) = - lu(k,135) * lu(k,833) + lu(k,1134) = lu(k,1134) - lu(k,131) * lu(k,1102) + lu(k,1164) = lu(k,1164) - lu(k,132) * lu(k,1102) + lu(k,1165) = lu(k,1165) - lu(k,133) * lu(k,1102) + lu(k,1172) = lu(k,1172) - lu(k,134) * lu(k,1102) + lu(k,1176) = lu(k,1176) - lu(k,135) * lu(k,1102) + lu(k,136) = 1._r8 / lu(k,136) + lu(k,137) = lu(k,137) * lu(k,136) + lu(k,138) = lu(k,138) * lu(k,136) + lu(k,139) = lu(k,139) * lu(k,136) + lu(k,140) = lu(k,140) * lu(k,136) + lu(k,141) = lu(k,141) * lu(k,136) + lu(k,1138) = lu(k,1138) - lu(k,137) * lu(k,1103) + lu(k,1139) = lu(k,1139) - lu(k,138) * lu(k,1103) + lu(k,1167) = lu(k,1167) - lu(k,139) * lu(k,1103) + lu(k,1172) = lu(k,1172) - lu(k,140) * lu(k,1103) + lu(k,1173) = lu(k,1173) - lu(k,141) * lu(k,1103) + lu(k,1185) = lu(k,1185) - lu(k,137) * lu(k,1178) + lu(k,1186) = lu(k,1186) - lu(k,138) * lu(k,1178) + lu(k,1211) = lu(k,1211) - lu(k,139) * lu(k,1178) + lu(k,1216) = lu(k,1216) - lu(k,140) * lu(k,1178) + lu(k,1217) = lu(k,1217) - lu(k,141) * lu(k,1178) + end do + end subroutine lu_fac03 + subroutine lu_fac04( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,142) = 1._r8 / lu(k,142) + lu(k,143) = lu(k,143) * lu(k,142) + lu(k,144) = lu(k,144) * lu(k,142) + lu(k,145) = lu(k,145) * lu(k,142) + lu(k,146) = lu(k,146) * lu(k,142) + lu(k,649) = lu(k,649) - lu(k,143) * lu(k,641) + lu(k,650) = - lu(k,144) * lu(k,641) + lu(k,655) = lu(k,655) - lu(k,145) * lu(k,641) + lu(k,657) = - lu(k,146) * lu(k,641) + lu(k,932) = lu(k,932) - lu(k,143) * lu(k,900) + lu(k,933) = lu(k,933) - lu(k,144) * lu(k,900) + lu(k,943) = lu(k,943) - lu(k,145) * lu(k,900) + lu(k,948) = lu(k,948) - lu(k,146) * lu(k,900) + lu(k,1156) = lu(k,1156) - lu(k,143) * lu(k,1104) + lu(k,1157) = lu(k,1157) - lu(k,144) * lu(k,1104) + lu(k,1167) = lu(k,1167) - lu(k,145) * lu(k,1104) + lu(k,1172) = lu(k,1172) - lu(k,146) * lu(k,1104) + lu(k,147) = 1._r8 / lu(k,147) + lu(k,148) = lu(k,148) * lu(k,147) + lu(k,149) = lu(k,149) * lu(k,147) + lu(k,150) = lu(k,150) * lu(k,147) + lu(k,151) = lu(k,151) * lu(k,147) + lu(k,369) = lu(k,369) - lu(k,148) * lu(k,367) + lu(k,370) = lu(k,370) - lu(k,149) * lu(k,367) + lu(k,373) = lu(k,373) - lu(k,150) * lu(k,367) + lu(k,375) = lu(k,375) - lu(k,151) * lu(k,367) + lu(k,916) = lu(k,916) - lu(k,148) * lu(k,901) + lu(k,927) = - lu(k,149) * lu(k,901) + lu(k,943) = lu(k,943) - lu(k,150) * lu(k,901) + lu(k,948) = lu(k,948) - lu(k,151) * lu(k,901) + lu(k,1134) = lu(k,1134) - lu(k,148) * lu(k,1105) + lu(k,1150) = lu(k,1150) - lu(k,149) * lu(k,1105) + lu(k,1167) = lu(k,1167) - lu(k,150) * lu(k,1105) + lu(k,1172) = lu(k,1172) - lu(k,151) * lu(k,1105) + lu(k,152) = 1._r8 / lu(k,152) + lu(k,153) = lu(k,153) * lu(k,152) + lu(k,154) = lu(k,154) * lu(k,152) + lu(k,155) = lu(k,155) * lu(k,152) + lu(k,156) = lu(k,156) * lu(k,152) + lu(k,601) = lu(k,601) - lu(k,153) * lu(k,599) + lu(k,602) = lu(k,602) - lu(k,154) * lu(k,599) + lu(k,606) = lu(k,606) - lu(k,155) * lu(k,599) + lu(k,612) = lu(k,612) - lu(k,156) * lu(k,599) + lu(k,958) = lu(k,958) - lu(k,153) * lu(k,954) + lu(k,959) = lu(k,959) - lu(k,154) * lu(k,954) + lu(k,964) = lu(k,964) - lu(k,155) * lu(k,954) + lu(k,972) = lu(k,972) - lu(k,156) * lu(k,954) + lu(k,1226) = lu(k,1226) - lu(k,153) * lu(k,1224) + lu(k,1228) = lu(k,1228) - lu(k,154) * lu(k,1224) + lu(k,1235) = lu(k,1235) - lu(k,155) * lu(k,1224) + lu(k,1243) = lu(k,1243) - lu(k,156) * lu(k,1224) + lu(k,157) = 1._r8 / lu(k,157) + lu(k,158) = lu(k,158) * lu(k,157) + lu(k,159) = lu(k,159) * lu(k,157) + lu(k,469) = - lu(k,158) * lu(k,465) + lu(k,473) = lu(k,473) - lu(k,159) * lu(k,465) + lu(k,624) = - lu(k,158) * lu(k,615) + lu(k,637) = - lu(k,159) * lu(k,615) + lu(k,690) = lu(k,690) - lu(k,158) * lu(k,680) + lu(k,703) = lu(k,703) - lu(k,159) * lu(k,680) + lu(k,746) = lu(k,746) - lu(k,158) * lu(k,731) + lu(k,763) = lu(k,763) - lu(k,159) * lu(k,731) + lu(k,1152) = lu(k,1152) - lu(k,158) * lu(k,1106) + lu(k,1172) = lu(k,1172) - lu(k,159) * lu(k,1106) + lu(k,1196) = lu(k,1196) - lu(k,158) * lu(k,1179) + lu(k,1216) = lu(k,1216) - lu(k,159) * lu(k,1179) + lu(k,1264) = lu(k,1264) - lu(k,158) * lu(k,1247) + lu(k,1283) = lu(k,1283) - lu(k,159) * lu(k,1247) + lu(k,160) = 1._r8 / lu(k,160) + lu(k,161) = lu(k,161) * lu(k,160) + lu(k,162) = lu(k,162) * lu(k,160) + lu(k,163) = lu(k,163) * lu(k,160) + lu(k,164) = lu(k,164) * lu(k,160) + lu(k,165) = lu(k,165) * lu(k,160) + lu(k,166) = lu(k,166) * lu(k,160) + lu(k,167) = lu(k,167) * lu(k,160) + lu(k,869) = - lu(k,161) * lu(k,868) + lu(k,876) = - lu(k,162) * lu(k,868) + lu(k,878) = lu(k,878) - lu(k,163) * lu(k,868) + lu(k,880) = lu(k,880) - lu(k,164) * lu(k,868) + lu(k,881) = lu(k,881) - lu(k,165) * lu(k,868) + lu(k,886) = lu(k,886) - lu(k,166) * lu(k,868) + lu(k,892) = lu(k,892) - lu(k,167) * lu(k,868) + lu(k,1118) = lu(k,1118) - lu(k,161) * lu(k,1107) + lu(k,1139) = lu(k,1139) - lu(k,162) * lu(k,1107) + lu(k,1147) = lu(k,1147) - lu(k,163) * lu(k,1107) + lu(k,1154) = lu(k,1154) - lu(k,164) * lu(k,1107) + lu(k,1161) = lu(k,1161) - lu(k,165) * lu(k,1107) + lu(k,1166) = lu(k,1166) - lu(k,166) * lu(k,1107) + lu(k,1172) = lu(k,1172) - lu(k,167) * lu(k,1107) + lu(k,168) = 1._r8 / lu(k,168) + lu(k,169) = lu(k,169) * lu(k,168) + lu(k,170) = lu(k,170) * lu(k,168) + lu(k,171) = lu(k,171) * lu(k,168) + lu(k,172) = lu(k,172) * lu(k,168) + lu(k,173) = lu(k,173) * lu(k,168) + lu(k,174) = lu(k,174) * lu(k,168) + lu(k,175) = lu(k,175) * lu(k,168) + lu(k,846) = lu(k,846) - lu(k,169) * lu(k,834) + lu(k,851) = lu(k,851) - lu(k,170) * lu(k,834) + lu(k,855) = lu(k,855) - lu(k,171) * lu(k,834) + lu(k,856) = lu(k,856) - lu(k,172) * lu(k,834) + lu(k,858) = lu(k,858) - lu(k,173) * lu(k,834) + lu(k,863) = lu(k,863) - lu(k,174) * lu(k,834) + lu(k,867) = lu(k,867) - lu(k,175) * lu(k,834) + lu(k,1147) = lu(k,1147) - lu(k,169) * lu(k,1108) + lu(k,1160) = lu(k,1160) - lu(k,170) * lu(k,1108) + lu(k,1164) = lu(k,1164) - lu(k,171) * lu(k,1108) + lu(k,1165) = lu(k,1165) - lu(k,172) * lu(k,1108) + lu(k,1167) = lu(k,1167) - lu(k,173) * lu(k,1108) + lu(k,1172) = lu(k,1172) - lu(k,174) * lu(k,1108) + lu(k,1176) = lu(k,1176) - lu(k,175) * lu(k,1108) + lu(k,176) = 1._r8 / lu(k,176) + lu(k,177) = lu(k,177) * lu(k,176) + lu(k,178) = lu(k,178) * lu(k,176) + lu(k,179) = lu(k,179) * lu(k,176) + lu(k,180) = lu(k,180) * lu(k,176) + lu(k,181) = lu(k,181) * lu(k,176) + lu(k,943) = lu(k,943) - lu(k,177) * lu(k,902) + lu(k,946) = lu(k,946) - lu(k,178) * lu(k,902) + lu(k,948) = lu(k,948) - lu(k,179) * lu(k,902) + lu(k,949) = lu(k,949) - lu(k,180) * lu(k,902) + lu(k,952) = lu(k,952) - lu(k,181) * lu(k,902) + lu(k,1045) = lu(k,1045) - lu(k,177) * lu(k,1021) + lu(k,1048) = lu(k,1048) - lu(k,178) * lu(k,1021) + lu(k,1050) = lu(k,1050) - lu(k,179) * lu(k,1021) + lu(k,1051) = lu(k,1051) - lu(k,180) * lu(k,1021) + lu(k,1054) = - lu(k,181) * lu(k,1021) + lu(k,1167) = lu(k,1167) - lu(k,177) * lu(k,1109) + lu(k,1170) = lu(k,1170) - lu(k,178) * lu(k,1109) + lu(k,1172) = lu(k,1172) - lu(k,179) * lu(k,1109) + lu(k,1173) = lu(k,1173) - lu(k,180) * lu(k,1109) + lu(k,1176) = lu(k,1176) - lu(k,181) * lu(k,1109) + lu(k,182) = 1._r8 / lu(k,182) + lu(k,183) = lu(k,183) * lu(k,182) + lu(k,184) = lu(k,184) * lu(k,182) + lu(k,185) = lu(k,185) * lu(k,182) + lu(k,186) = lu(k,186) * lu(k,182) + lu(k,187) = lu(k,187) * lu(k,182) + lu(k,854) = lu(k,854) - lu(k,183) * lu(k,835) + lu(k,855) = lu(k,855) - lu(k,184) * lu(k,835) + lu(k,856) = lu(k,856) - lu(k,185) * lu(k,835) + lu(k,862) = - lu(k,186) * lu(k,835) + lu(k,863) = lu(k,863) - lu(k,187) * lu(k,835) + lu(k,1078) = lu(k,1078) - lu(k,183) * lu(k,1068) + lu(k,1079) = lu(k,1079) - lu(k,184) * lu(k,1068) + lu(k,1080) = lu(k,1080) - lu(k,185) * lu(k,1068) + lu(k,1086) = lu(k,1086) - lu(k,186) * lu(k,1068) + lu(k,1087) = lu(k,1087) - lu(k,187) * lu(k,1068) + lu(k,1163) = lu(k,1163) - lu(k,183) * lu(k,1110) + lu(k,1164) = lu(k,1164) - lu(k,184) * lu(k,1110) + lu(k,1165) = lu(k,1165) - lu(k,185) * lu(k,1110) + lu(k,1171) = lu(k,1171) - lu(k,186) * lu(k,1110) + lu(k,1172) = lu(k,1172) - lu(k,187) * lu(k,1110) + end do + end subroutine lu_fac04 + subroutine lu_fac05( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,188) = 1._r8 / lu(k,188) + lu(k,189) = lu(k,189) * lu(k,188) + lu(k,190) = lu(k,190) * lu(k,188) + lu(k,191) = lu(k,191) * lu(k,188) + lu(k,192) = lu(k,192) * lu(k,188) + lu(k,193) = lu(k,193) * lu(k,188) + lu(k,388) = lu(k,388) - lu(k,189) * lu(k,387) + lu(k,389) = lu(k,389) - lu(k,190) * lu(k,387) + lu(k,395) = lu(k,395) - lu(k,191) * lu(k,387) + lu(k,397) = - lu(k,192) * lu(k,387) + lu(k,399) = - lu(k,193) * lu(k,387) + lu(k,915) = - lu(k,189) * lu(k,903) + lu(k,918) = lu(k,918) - lu(k,190) * lu(k,903) + lu(k,943) = lu(k,943) - lu(k,191) * lu(k,903) + lu(k,948) = lu(k,948) - lu(k,192) * lu(k,903) + lu(k,952) = lu(k,952) - lu(k,193) * lu(k,903) + lu(k,1133) = lu(k,1133) - lu(k,189) * lu(k,1111) + lu(k,1135) = lu(k,1135) - lu(k,190) * lu(k,1111) + lu(k,1167) = lu(k,1167) - lu(k,191) * lu(k,1111) + lu(k,1172) = lu(k,1172) - lu(k,192) * lu(k,1111) + lu(k,1176) = lu(k,1176) - lu(k,193) * lu(k,1111) + lu(k,194) = 1._r8 / lu(k,194) + lu(k,195) = lu(k,195) * lu(k,194) + lu(k,196) = lu(k,196) * lu(k,194) + lu(k,197) = lu(k,197) * lu(k,194) + lu(k,198) = lu(k,198) * lu(k,194) + lu(k,199) = lu(k,199) * lu(k,194) + lu(k,532) = - lu(k,195) * lu(k,522) + lu(k,533) = - lu(k,196) * lu(k,522) + lu(k,536) = lu(k,536) - lu(k,197) * lu(k,522) + lu(k,542) = - lu(k,198) * lu(k,522) + lu(k,544) = lu(k,544) - lu(k,199) * lu(k,522) + lu(k,1153) = lu(k,1153) - lu(k,195) * lu(k,1112) + lu(k,1158) = lu(k,1158) - lu(k,196) * lu(k,1112) + lu(k,1162) = lu(k,1162) - lu(k,197) * lu(k,1112) + lu(k,1170) = lu(k,1170) - lu(k,198) * lu(k,1112) + lu(k,1172) = lu(k,1172) - lu(k,199) * lu(k,1112) + lu(k,1197) = lu(k,1197) - lu(k,195) * lu(k,1180) + lu(k,1202) = lu(k,1202) - lu(k,196) * lu(k,1180) + lu(k,1206) = lu(k,1206) - lu(k,197) * lu(k,1180) + lu(k,1214) = lu(k,1214) - lu(k,198) * lu(k,1180) + lu(k,1216) = lu(k,1216) - lu(k,199) * lu(k,1180) + lu(k,200) = 1._r8 / lu(k,200) + lu(k,201) = lu(k,201) * lu(k,200) + lu(k,202) = lu(k,202) * lu(k,200) + lu(k,203) = lu(k,203) * lu(k,200) + lu(k,204) = lu(k,204) * lu(k,200) + lu(k,205) = lu(k,205) * lu(k,200) + lu(k,753) = lu(k,753) - lu(k,201) * lu(k,732) + lu(k,754) = - lu(k,202) * lu(k,732) + lu(k,755) = lu(k,755) - lu(k,203) * lu(k,732) + lu(k,763) = lu(k,763) - lu(k,204) * lu(k,732) + lu(k,767) = - lu(k,205) * lu(k,732) + lu(k,936) = lu(k,936) - lu(k,201) * lu(k,904) + lu(k,937) = lu(k,937) - lu(k,202) * lu(k,904) + lu(k,938) = lu(k,938) - lu(k,203) * lu(k,904) + lu(k,948) = lu(k,948) - lu(k,204) * lu(k,904) + lu(k,952) = lu(k,952) - lu(k,205) * lu(k,904) + lu(k,1160) = lu(k,1160) - lu(k,201) * lu(k,1113) + lu(k,1161) = lu(k,1161) - lu(k,202) * lu(k,1113) + lu(k,1162) = lu(k,1162) - lu(k,203) * lu(k,1113) + lu(k,1172) = lu(k,1172) - lu(k,204) * lu(k,1113) + lu(k,1176) = lu(k,1176) - lu(k,205) * lu(k,1113) + lu(k,206) = 1._r8 / lu(k,206) + lu(k,207) = lu(k,207) * lu(k,206) + lu(k,208) = lu(k,208) * lu(k,206) + lu(k,209) = lu(k,209) * lu(k,206) + lu(k,210) = lu(k,210) * lu(k,206) + lu(k,211) = lu(k,211) * lu(k,206) + lu(k,492) = lu(k,492) - lu(k,207) * lu(k,490) + lu(k,495) = lu(k,495) - lu(k,208) * lu(k,490) + lu(k,497) = lu(k,497) - lu(k,209) * lu(k,490) + lu(k,500) = lu(k,500) - lu(k,210) * lu(k,490) + lu(k,502) = - lu(k,211) * lu(k,490) + lu(k,923) = lu(k,923) - lu(k,207) * lu(k,905) + lu(k,934) = lu(k,934) - lu(k,208) * lu(k,905) + lu(k,938) = lu(k,938) - lu(k,209) * lu(k,905) + lu(k,948) = lu(k,948) - lu(k,210) * lu(k,905) + lu(k,952) = lu(k,952) - lu(k,211) * lu(k,905) + lu(k,1145) = lu(k,1145) - lu(k,207) * lu(k,1114) + lu(k,1158) = lu(k,1158) - lu(k,208) * lu(k,1114) + lu(k,1162) = lu(k,1162) - lu(k,209) * lu(k,1114) + lu(k,1172) = lu(k,1172) - lu(k,210) * lu(k,1114) + lu(k,1176) = lu(k,1176) - lu(k,211) * lu(k,1114) + lu(k,213) = 1._r8 / lu(k,213) + lu(k,214) = lu(k,214) * lu(k,213) + lu(k,215) = lu(k,215) * lu(k,213) + lu(k,216) = lu(k,216) * lu(k,213) + lu(k,217) = lu(k,217) * lu(k,213) + lu(k,218) = lu(k,218) * lu(k,213) + lu(k,219) = lu(k,219) * lu(k,213) + lu(k,1039) = - lu(k,214) * lu(k,1022) + lu(k,1044) = lu(k,1044) - lu(k,215) * lu(k,1022) + lu(k,1048) = lu(k,1048) - lu(k,216) * lu(k,1022) + lu(k,1049) = lu(k,1049) - lu(k,217) * lu(k,1022) + lu(k,1050) = lu(k,1050) - lu(k,218) * lu(k,1022) + lu(k,1053) = lu(k,1053) - lu(k,219) * lu(k,1022) + lu(k,1161) = lu(k,1161) - lu(k,214) * lu(k,1115) + lu(k,1166) = lu(k,1166) - lu(k,215) * lu(k,1115) + lu(k,1170) = lu(k,1170) - lu(k,216) * lu(k,1115) + lu(k,1171) = lu(k,1171) - lu(k,217) * lu(k,1115) + lu(k,1172) = lu(k,1172) - lu(k,218) * lu(k,1115) + lu(k,1175) = lu(k,1175) - lu(k,219) * lu(k,1115) + lu(k,1272) = - lu(k,214) * lu(k,1248) + lu(k,1277) = lu(k,1277) - lu(k,215) * lu(k,1248) + lu(k,1281) = lu(k,1281) - lu(k,216) * lu(k,1248) + lu(k,1282) = - lu(k,217) * lu(k,1248) + lu(k,1283) = lu(k,1283) - lu(k,218) * lu(k,1248) + lu(k,1286) = lu(k,1286) - lu(k,219) * lu(k,1248) + lu(k,220) = 1._r8 / lu(k,220) + lu(k,221) = lu(k,221) * lu(k,220) + lu(k,222) = lu(k,222) * lu(k,220) + lu(k,223) = lu(k,223) * lu(k,220) + lu(k,224) = lu(k,224) * lu(k,220) + lu(k,225) = lu(k,225) * lu(k,220) + lu(k,226) = lu(k,226) * lu(k,220) + lu(k,840) = - lu(k,221) * lu(k,836) + lu(k,846) = lu(k,846) - lu(k,222) * lu(k,836) + lu(k,853) = lu(k,853) - lu(k,223) * lu(k,836) + lu(k,858) = lu(k,858) - lu(k,224) * lu(k,836) + lu(k,860) = lu(k,860) - lu(k,225) * lu(k,836) + lu(k,863) = lu(k,863) - lu(k,226) * lu(k,836) + lu(k,980) = - lu(k,221) * lu(k,975) + lu(k,989) = lu(k,989) - lu(k,222) * lu(k,975) + lu(k,1004) = lu(k,1004) - lu(k,223) * lu(k,975) + lu(k,1009) = lu(k,1009) - lu(k,224) * lu(k,975) + lu(k,1011) = lu(k,1011) - lu(k,225) * lu(k,975) + lu(k,1014) = lu(k,1014) - lu(k,226) * lu(k,975) + lu(k,1130) = lu(k,1130) - lu(k,221) * lu(k,1116) + lu(k,1147) = lu(k,1147) - lu(k,222) * lu(k,1116) + lu(k,1162) = lu(k,1162) - lu(k,223) * lu(k,1116) + lu(k,1167) = lu(k,1167) - lu(k,224) * lu(k,1116) + lu(k,1169) = lu(k,1169) - lu(k,225) * lu(k,1116) + lu(k,1172) = lu(k,1172) - lu(k,226) * lu(k,1116) + end do + end subroutine lu_fac05 + subroutine lu_fac06( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,227) = 1._r8 / lu(k,227) + lu(k,228) = lu(k,228) * lu(k,227) + lu(k,229) = lu(k,229) * lu(k,227) + lu(k,230) = lu(k,230) * lu(k,227) + lu(k,231) = lu(k,231) * lu(k,227) + lu(k,232) = lu(k,232) * lu(k,227) + lu(k,233) = lu(k,233) * lu(k,227) + lu(k,854) = lu(k,854) - lu(k,228) * lu(k,837) + lu(k,855) = lu(k,855) - lu(k,229) * lu(k,837) + lu(k,856) = lu(k,856) - lu(k,230) * lu(k,837) + lu(k,862) = lu(k,862) - lu(k,231) * lu(k,837) + lu(k,863) = lu(k,863) - lu(k,232) * lu(k,837) + lu(k,867) = lu(k,867) - lu(k,233) * lu(k,837) + lu(k,1078) = lu(k,1078) - lu(k,228) * lu(k,1069) + lu(k,1079) = lu(k,1079) - lu(k,229) * lu(k,1069) + lu(k,1080) = lu(k,1080) - lu(k,230) * lu(k,1069) + lu(k,1086) = lu(k,1086) - lu(k,231) * lu(k,1069) + lu(k,1087) = lu(k,1087) - lu(k,232) * lu(k,1069) + lu(k,1091) = lu(k,1091) - lu(k,233) * lu(k,1069) + lu(k,1163) = lu(k,1163) - lu(k,228) * lu(k,1117) + lu(k,1164) = lu(k,1164) - lu(k,229) * lu(k,1117) + lu(k,1165) = lu(k,1165) - lu(k,230) * lu(k,1117) + lu(k,1171) = lu(k,1171) - lu(k,231) * lu(k,1117) + lu(k,1172) = lu(k,1172) - lu(k,232) * lu(k,1117) + lu(k,1176) = lu(k,1176) - lu(k,233) * lu(k,1117) + lu(k,234) = 1._r8 / lu(k,234) + lu(k,235) = lu(k,235) * lu(k,234) + lu(k,236) = lu(k,236) * lu(k,234) + lu(k,237) = lu(k,237) * lu(k,234) + lu(k,238) = lu(k,238) * lu(k,234) + lu(k,239) = lu(k,239) * lu(k,234) + lu(k,602) = lu(k,602) - lu(k,235) * lu(k,600) + lu(k,603) = lu(k,603) - lu(k,236) * lu(k,600) + lu(k,606) = lu(k,606) - lu(k,237) * lu(k,600) + lu(k,609) = lu(k,609) - lu(k,238) * lu(k,600) + lu(k,611) = lu(k,611) - lu(k,239) * lu(k,600) + lu(k,880) = lu(k,880) - lu(k,235) * lu(k,869) + lu(k,881) = lu(k,881) - lu(k,236) * lu(k,869) + lu(k,886) = lu(k,886) - lu(k,237) * lu(k,869) + lu(k,889) = lu(k,889) - lu(k,238) * lu(k,869) + lu(k,892) = lu(k,892) - lu(k,239) * lu(k,869) + lu(k,996) = lu(k,996) - lu(k,235) * lu(k,976) + lu(k,1003) = lu(k,1003) - lu(k,236) * lu(k,976) + lu(k,1008) = lu(k,1008) - lu(k,237) * lu(k,976) + lu(k,1011) = lu(k,1011) - lu(k,238) * lu(k,976) + lu(k,1014) = lu(k,1014) - lu(k,239) * lu(k,976) + lu(k,1154) = lu(k,1154) - lu(k,235) * lu(k,1118) + lu(k,1161) = lu(k,1161) - lu(k,236) * lu(k,1118) + lu(k,1166) = lu(k,1166) - lu(k,237) * lu(k,1118) + lu(k,1169) = lu(k,1169) - lu(k,238) * lu(k,1118) + lu(k,1172) = lu(k,1172) - lu(k,239) * lu(k,1118) + lu(k,240) = 1._r8 / lu(k,240) + lu(k,241) = lu(k,241) * lu(k,240) + lu(k,242) = lu(k,242) * lu(k,240) + lu(k,243) = lu(k,243) * lu(k,240) + lu(k,244) = lu(k,244) * lu(k,240) + lu(k,245) = lu(k,245) * lu(k,240) + lu(k,246) = lu(k,246) * lu(k,240) + lu(k,247) = lu(k,247) * lu(k,240) + lu(k,623) = lu(k,623) - lu(k,241) * lu(k,616) + lu(k,624) = lu(k,624) - lu(k,242) * lu(k,616) + lu(k,626) = lu(k,626) - lu(k,243) * lu(k,616) + lu(k,630) = lu(k,630) - lu(k,244) * lu(k,616) + lu(k,632) = lu(k,632) - lu(k,245) * lu(k,616) + lu(k,634) = lu(k,634) - lu(k,246) * lu(k,616) + lu(k,637) = lu(k,637) - lu(k,247) * lu(k,616) + lu(k,928) = lu(k,928) - lu(k,241) * lu(k,906) + lu(k,929) = lu(k,929) - lu(k,242) * lu(k,906) + lu(k,931) = lu(k,931) - lu(k,243) * lu(k,906) + lu(k,935) = lu(k,935) - lu(k,244) * lu(k,906) + lu(k,938) = lu(k,938) - lu(k,245) * lu(k,906) + lu(k,943) = lu(k,943) - lu(k,246) * lu(k,906) + lu(k,948) = lu(k,948) - lu(k,247) * lu(k,906) + lu(k,1151) = lu(k,1151) - lu(k,241) * lu(k,1119) + lu(k,1152) = lu(k,1152) - lu(k,242) * lu(k,1119) + lu(k,1155) = lu(k,1155) - lu(k,243) * lu(k,1119) + lu(k,1159) = lu(k,1159) - lu(k,244) * lu(k,1119) + lu(k,1162) = lu(k,1162) - lu(k,245) * lu(k,1119) + lu(k,1167) = lu(k,1167) - lu(k,246) * lu(k,1119) + lu(k,1172) = lu(k,1172) - lu(k,247) * lu(k,1119) + lu(k,248) = 1._r8 / lu(k,248) + lu(k,249) = lu(k,249) * lu(k,248) + lu(k,250) = lu(k,250) * lu(k,248) + lu(k,251) = lu(k,251) * lu(k,248) + lu(k,372) = lu(k,372) - lu(k,249) * lu(k,368) + lu(k,373) = lu(k,373) - lu(k,250) * lu(k,368) + lu(k,375) = lu(k,375) - lu(k,251) * lu(k,368) + lu(k,497) = lu(k,497) - lu(k,249) * lu(k,491) + lu(k,498) = lu(k,498) - lu(k,250) * lu(k,491) + lu(k,500) = lu(k,500) - lu(k,251) * lu(k,491) + lu(k,582) = lu(k,582) - lu(k,249) * lu(k,572) + lu(k,584) = lu(k,584) - lu(k,250) * lu(k,572) + lu(k,586) = lu(k,586) - lu(k,251) * lu(k,572) + lu(k,632) = lu(k,632) - lu(k,249) * lu(k,617) + lu(k,634) = lu(k,634) - lu(k,250) * lu(k,617) + lu(k,637) = lu(k,637) - lu(k,251) * lu(k,617) + lu(k,653) = lu(k,653) - lu(k,249) * lu(k,642) + lu(k,655) = lu(k,655) - lu(k,250) * lu(k,642) + lu(k,657) = lu(k,657) - lu(k,251) * lu(k,642) + lu(k,755) = lu(k,755) - lu(k,249) * lu(k,733) + lu(k,759) = lu(k,759) - lu(k,250) * lu(k,733) + lu(k,763) = lu(k,763) - lu(k,251) * lu(k,733) + lu(k,1162) = lu(k,1162) - lu(k,249) * lu(k,1120) + lu(k,1167) = lu(k,1167) - lu(k,250) * lu(k,1120) + lu(k,1172) = lu(k,1172) - lu(k,251) * lu(k,1120) + lu(k,252) = 1._r8 / lu(k,252) + lu(k,253) = lu(k,253) * lu(k,252) + lu(k,254) = lu(k,254) * lu(k,252) + lu(k,255) = lu(k,255) * lu(k,252) + lu(k,256) = lu(k,256) * lu(k,252) + lu(k,257) = lu(k,257) * lu(k,252) + lu(k,258) = lu(k,258) * lu(k,252) + lu(k,259) = lu(k,259) * lu(k,252) + lu(k,684) = lu(k,684) - lu(k,253) * lu(k,681) + lu(k,695) = lu(k,695) - lu(k,254) * lu(k,681) + lu(k,697) = lu(k,697) - lu(k,255) * lu(k,681) + lu(k,698) = lu(k,698) - lu(k,256) * lu(k,681) + lu(k,702) = lu(k,702) - lu(k,257) * lu(k,681) + lu(k,703) = lu(k,703) - lu(k,258) * lu(k,681) + lu(k,704) = - lu(k,259) * lu(k,681) + lu(k,1026) = - lu(k,253) * lu(k,1023) + lu(k,1036) = lu(k,1036) - lu(k,254) * lu(k,1023) + lu(k,1038) = - lu(k,255) * lu(k,1023) + lu(k,1040) = - lu(k,256) * lu(k,1023) + lu(k,1048) = lu(k,1048) - lu(k,257) * lu(k,1023) + lu(k,1050) = lu(k,1050) - lu(k,258) * lu(k,1023) + lu(k,1051) = lu(k,1051) - lu(k,259) * lu(k,1023) + lu(k,1129) = lu(k,1129) - lu(k,253) * lu(k,1121) + lu(k,1158) = lu(k,1158) - lu(k,254) * lu(k,1121) + lu(k,1160) = lu(k,1160) - lu(k,255) * lu(k,1121) + lu(k,1162) = lu(k,1162) - lu(k,256) * lu(k,1121) + lu(k,1170) = lu(k,1170) - lu(k,257) * lu(k,1121) + lu(k,1172) = lu(k,1172) - lu(k,258) * lu(k,1121) + lu(k,1173) = lu(k,1173) - lu(k,259) * lu(k,1121) + lu(k,260) = 1._r8 / lu(k,260) + lu(k,261) = lu(k,261) * lu(k,260) + lu(k,262) = lu(k,262) * lu(k,260) + lu(k,263) = lu(k,263) * lu(k,260) + lu(k,264) = lu(k,264) * lu(k,260) + lu(k,265) = lu(k,265) * lu(k,260) + lu(k,266) = lu(k,266) * lu(k,260) + lu(k,267) = lu(k,267) * lu(k,260) + lu(k,342) = lu(k,342) - lu(k,261) * lu(k,341) + lu(k,343) = - lu(k,262) * lu(k,341) + lu(k,344) = lu(k,344) - lu(k,263) * lu(k,341) + lu(k,345) = lu(k,345) - lu(k,264) * lu(k,341) + lu(k,346) = lu(k,346) - lu(k,265) * lu(k,341) + lu(k,348) = - lu(k,266) * lu(k,341) + lu(k,350) = - lu(k,267) * lu(k,341) + lu(k,913) = lu(k,913) - lu(k,261) * lu(k,907) + lu(k,924) = - lu(k,262) * lu(k,907) + lu(k,927) = lu(k,927) - lu(k,263) * lu(k,907) + lu(k,938) = lu(k,938) - lu(k,264) * lu(k,907) + lu(k,943) = lu(k,943) - lu(k,265) * lu(k,907) + lu(k,948) = lu(k,948) - lu(k,266) * lu(k,907) + lu(k,952) = lu(k,952) - lu(k,267) * lu(k,907) + lu(k,1132) = lu(k,1132) - lu(k,261) * lu(k,1122) + lu(k,1146) = lu(k,1146) - lu(k,262) * lu(k,1122) + lu(k,1150) = lu(k,1150) - lu(k,263) * lu(k,1122) + lu(k,1162) = lu(k,1162) - lu(k,264) * lu(k,1122) + lu(k,1167) = lu(k,1167) - lu(k,265) * lu(k,1122) + lu(k,1172) = lu(k,1172) - lu(k,266) * lu(k,1122) + lu(k,1176) = lu(k,1176) - lu(k,267) * lu(k,1122) + lu(k,268) = 1._r8 / lu(k,268) + lu(k,269) = lu(k,269) * lu(k,268) + lu(k,270) = lu(k,270) * lu(k,268) + lu(k,271) = lu(k,271) * lu(k,268) + lu(k,272) = lu(k,272) * lu(k,268) + lu(k,273) = lu(k,273) * lu(k,268) + lu(k,274) = lu(k,274) * lu(k,268) + lu(k,275) = lu(k,275) * lu(k,268) + lu(k,872) = lu(k,872) - lu(k,269) * lu(k,870) + lu(k,875) = - lu(k,270) * lu(k,870) + lu(k,883) = lu(k,883) - lu(k,271) * lu(k,870) + lu(k,886) = lu(k,886) - lu(k,272) * lu(k,870) + lu(k,888) = lu(k,888) - lu(k,273) * lu(k,870) + lu(k,890) = lu(k,890) - lu(k,274) * lu(k,870) + lu(k,893) = lu(k,893) - lu(k,275) * lu(k,870) + lu(k,956) = lu(k,956) - lu(k,269) * lu(k,955) + lu(k,957) = - lu(k,270) * lu(k,955) + lu(k,961) = lu(k,961) - lu(k,271) * lu(k,955) + lu(k,964) = lu(k,964) - lu(k,272) * lu(k,955) + lu(k,966) = lu(k,966) - lu(k,273) * lu(k,955) + lu(k,968) = lu(k,968) - lu(k,274) * lu(k,955) + lu(k,971) = - lu(k,275) * lu(k,955) + lu(k,1027) = - lu(k,269) * lu(k,1024) + lu(k,1028) = lu(k,1028) - lu(k,270) * lu(k,1024) + lu(k,1041) = - lu(k,271) * lu(k,1024) + lu(k,1044) = lu(k,1044) - lu(k,272) * lu(k,1024) + lu(k,1046) = lu(k,1046) - lu(k,273) * lu(k,1024) + lu(k,1048) = lu(k,1048) - lu(k,274) * lu(k,1024) + lu(k,1051) = lu(k,1051) - lu(k,275) * lu(k,1024) + end do + end subroutine lu_fac06 + subroutine lu_fac07( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,276) = 1._r8 / lu(k,276) + lu(k,277) = lu(k,277) * lu(k,276) + lu(k,278) = lu(k,278) * lu(k,276) + lu(k,279) = lu(k,279) * lu(k,276) + lu(k,280) = lu(k,280) * lu(k,276) + lu(k,281) = lu(k,281) * lu(k,276) + lu(k,282) = lu(k,282) * lu(k,276) + lu(k,855) = lu(k,855) - lu(k,277) * lu(k,838) + lu(k,856) = lu(k,856) - lu(k,278) * lu(k,838) + lu(k,857) = - lu(k,279) * lu(k,838) + lu(k,858) = lu(k,858) - lu(k,280) * lu(k,838) + lu(k,863) = lu(k,863) - lu(k,281) * lu(k,838) + lu(k,867) = lu(k,867) - lu(k,282) * lu(k,838) + lu(k,884) = lu(k,884) - lu(k,277) * lu(k,871) + lu(k,885) = lu(k,885) - lu(k,278) * lu(k,871) + lu(k,886) = lu(k,886) - lu(k,279) * lu(k,871) + lu(k,887) = lu(k,887) - lu(k,280) * lu(k,871) + lu(k,892) = lu(k,892) - lu(k,281) * lu(k,871) + lu(k,896) = - lu(k,282) * lu(k,871) + lu(k,940) = lu(k,940) - lu(k,277) * lu(k,908) + lu(k,941) = lu(k,941) - lu(k,278) * lu(k,908) + lu(k,942) = lu(k,942) - lu(k,279) * lu(k,908) + lu(k,943) = lu(k,943) - lu(k,280) * lu(k,908) + lu(k,948) = lu(k,948) - lu(k,281) * lu(k,908) + lu(k,952) = lu(k,952) - lu(k,282) * lu(k,908) + lu(k,1164) = lu(k,1164) - lu(k,277) * lu(k,1123) + lu(k,1165) = lu(k,1165) - lu(k,278) * lu(k,1123) + lu(k,1166) = lu(k,1166) - lu(k,279) * lu(k,1123) + lu(k,1167) = lu(k,1167) - lu(k,280) * lu(k,1123) + lu(k,1172) = lu(k,1172) - lu(k,281) * lu(k,1123) + lu(k,1176) = lu(k,1176) - lu(k,282) * lu(k,1123) + lu(k,283) = 1._r8 / lu(k,283) + lu(k,284) = lu(k,284) * lu(k,283) + lu(k,285) = lu(k,285) * lu(k,283) + lu(k,286) = lu(k,286) * lu(k,283) + lu(k,287) = lu(k,287) * lu(k,283) + lu(k,288) = lu(k,288) * lu(k,283) + lu(k,289) = lu(k,289) * lu(k,283) + lu(k,290) = lu(k,290) * lu(k,283) + lu(k,291) = lu(k,291) * lu(k,283) + lu(k,664) = lu(k,664) - lu(k,284) * lu(k,661) + lu(k,665) = - lu(k,285) * lu(k,661) + lu(k,668) = lu(k,668) - lu(k,286) * lu(k,661) + lu(k,671) = lu(k,671) - lu(k,287) * lu(k,661) + lu(k,673) = lu(k,673) - lu(k,288) * lu(k,661) + lu(k,675) = lu(k,675) - lu(k,289) * lu(k,661) + lu(k,676) = lu(k,676) - lu(k,290) * lu(k,661) + lu(k,677) = lu(k,677) - lu(k,291) * lu(k,661) + lu(k,1026) = lu(k,1026) - lu(k,284) * lu(k,1025) + lu(k,1031) = - lu(k,285) * lu(k,1025) + lu(k,1035) = lu(k,1035) - lu(k,286) * lu(k,1025) + lu(k,1040) = lu(k,1040) - lu(k,287) * lu(k,1025) + lu(k,1045) = lu(k,1045) - lu(k,288) * lu(k,1025) + lu(k,1048) = lu(k,1048) - lu(k,289) * lu(k,1025) + lu(k,1050) = lu(k,1050) - lu(k,290) * lu(k,1025) + lu(k,1051) = lu(k,1051) - lu(k,291) * lu(k,1025) + lu(k,1129) = lu(k,1129) - lu(k,284) * lu(k,1124) + lu(k,1146) = lu(k,1146) - lu(k,285) * lu(k,1124) + lu(k,1157) = lu(k,1157) - lu(k,286) * lu(k,1124) + lu(k,1162) = lu(k,1162) - lu(k,287) * lu(k,1124) + lu(k,1167) = lu(k,1167) - lu(k,288) * lu(k,1124) + lu(k,1170) = lu(k,1170) - lu(k,289) * lu(k,1124) + lu(k,1172) = lu(k,1172) - lu(k,290) * lu(k,1124) + lu(k,1173) = lu(k,1173) - lu(k,291) * lu(k,1124) + lu(k,292) = 1._r8 / lu(k,292) + lu(k,293) = lu(k,293) * lu(k,292) + lu(k,294) = lu(k,294) * lu(k,292) + lu(k,295) = lu(k,295) * lu(k,292) + lu(k,296) = lu(k,296) * lu(k,292) + lu(k,297) = lu(k,297) * lu(k,292) + lu(k,298) = lu(k,298) * lu(k,292) + lu(k,299) = lu(k,299) * lu(k,292) + lu(k,300) = lu(k,300) * lu(k,292) + lu(k,851) = lu(k,851) - lu(k,293) * lu(k,839) + lu(k,854) = lu(k,854) - lu(k,294) * lu(k,839) + lu(k,855) = lu(k,855) - lu(k,295) * lu(k,839) + lu(k,856) = lu(k,856) - lu(k,296) * lu(k,839) + lu(k,858) = lu(k,858) - lu(k,297) * lu(k,839) + lu(k,862) = lu(k,862) - lu(k,298) * lu(k,839) + lu(k,863) = lu(k,863) - lu(k,299) * lu(k,839) + lu(k,867) = lu(k,867) - lu(k,300) * lu(k,839) + lu(k,1075) = lu(k,1075) - lu(k,293) * lu(k,1070) + lu(k,1078) = lu(k,1078) - lu(k,294) * lu(k,1070) + lu(k,1079) = lu(k,1079) - lu(k,295) * lu(k,1070) + lu(k,1080) = lu(k,1080) - lu(k,296) * lu(k,1070) + lu(k,1082) = lu(k,1082) - lu(k,297) * lu(k,1070) + lu(k,1086) = lu(k,1086) - lu(k,298) * lu(k,1070) + lu(k,1087) = lu(k,1087) - lu(k,299) * lu(k,1070) + lu(k,1091) = lu(k,1091) - lu(k,300) * lu(k,1070) + lu(k,1160) = lu(k,1160) - lu(k,293) * lu(k,1125) + lu(k,1163) = lu(k,1163) - lu(k,294) * lu(k,1125) + lu(k,1164) = lu(k,1164) - lu(k,295) * lu(k,1125) + lu(k,1165) = lu(k,1165) - lu(k,296) * lu(k,1125) + lu(k,1167) = lu(k,1167) - lu(k,297) * lu(k,1125) + lu(k,1171) = lu(k,1171) - lu(k,298) * lu(k,1125) + lu(k,1172) = lu(k,1172) - lu(k,299) * lu(k,1125) + lu(k,1176) = lu(k,1176) - lu(k,300) * lu(k,1125) + lu(k,301) = 1._r8 / lu(k,301) + lu(k,302) = lu(k,302) * lu(k,301) + lu(k,303) = lu(k,303) * lu(k,301) + lu(k,304) = lu(k,304) * lu(k,301) + lu(k,305) = lu(k,305) * lu(k,301) + lu(k,306) = lu(k,306) * lu(k,301) + lu(k,307) = lu(k,307) * lu(k,301) + lu(k,664) = lu(k,664) - lu(k,302) * lu(k,662) + lu(k,669) = lu(k,669) - lu(k,303) * lu(k,662) + lu(k,670) = lu(k,670) - lu(k,304) * lu(k,662) + lu(k,671) = lu(k,671) - lu(k,305) * lu(k,662) + lu(k,676) = lu(k,676) - lu(k,306) * lu(k,662) + lu(k,679) = - lu(k,307) * lu(k,662) + lu(k,684) = lu(k,684) - lu(k,302) * lu(k,682) + lu(k,695) = lu(k,695) - lu(k,303) * lu(k,682) + lu(k,697) = lu(k,697) - lu(k,304) * lu(k,682) + lu(k,698) = lu(k,698) - lu(k,305) * lu(k,682) + lu(k,703) = lu(k,703) - lu(k,306) * lu(k,682) + lu(k,706) = - lu(k,307) * lu(k,682) + lu(k,911) = lu(k,911) - lu(k,302) * lu(k,909) + lu(k,934) = lu(k,934) - lu(k,303) * lu(k,909) + lu(k,936) = lu(k,936) - lu(k,304) * lu(k,909) + lu(k,938) = lu(k,938) - lu(k,305) * lu(k,909) + lu(k,948) = lu(k,948) - lu(k,306) * lu(k,909) + lu(k,952) = lu(k,952) - lu(k,307) * lu(k,909) + lu(k,1129) = lu(k,1129) - lu(k,302) * lu(k,1126) + lu(k,1158) = lu(k,1158) - lu(k,303) * lu(k,1126) + lu(k,1160) = lu(k,1160) - lu(k,304) * lu(k,1126) + lu(k,1162) = lu(k,1162) - lu(k,305) * lu(k,1126) + lu(k,1172) = lu(k,1172) - lu(k,306) * lu(k,1126) + lu(k,1176) = lu(k,1176) - lu(k,307) * lu(k,1126) + lu(k,308) = 1._r8 / lu(k,308) + lu(k,309) = lu(k,309) * lu(k,308) + lu(k,310) = lu(k,310) * lu(k,308) + lu(k,311) = lu(k,311) * lu(k,308) + lu(k,312) = lu(k,312) * lu(k,308) + lu(k,313) = lu(k,313) * lu(k,308) + lu(k,314) = lu(k,314) * lu(k,308) + lu(k,315) = lu(k,315) * lu(k,308) + lu(k,316) = lu(k,316) * lu(k,308) + lu(k,317) = lu(k,317) * lu(k,308) + lu(k,981) = - lu(k,309) * lu(k,977) + lu(k,993) = lu(k,993) - lu(k,310) * lu(k,977) + lu(k,997) = - lu(k,311) * lu(k,977) + lu(k,1001) = lu(k,1001) - lu(k,312) * lu(k,977) + lu(k,1008) = lu(k,1008) - lu(k,313) * lu(k,977) + lu(k,1011) = lu(k,1011) - lu(k,314) * lu(k,977) + lu(k,1012) = lu(k,1012) - lu(k,315) * lu(k,977) + lu(k,1014) = lu(k,1014) - lu(k,316) * lu(k,977) + lu(k,1015) = lu(k,1015) - lu(k,317) * lu(k,977) + lu(k,1133) = lu(k,1133) - lu(k,309) * lu(k,1127) + lu(k,1151) = lu(k,1151) - lu(k,310) * lu(k,1127) + lu(k,1155) = lu(k,1155) - lu(k,311) * lu(k,1127) + lu(k,1159) = lu(k,1159) - lu(k,312) * lu(k,1127) + lu(k,1166) = lu(k,1166) - lu(k,313) * lu(k,1127) + lu(k,1169) = lu(k,1169) - lu(k,314) * lu(k,1127) + lu(k,1170) = lu(k,1170) - lu(k,315) * lu(k,1127) + lu(k,1172) = lu(k,1172) - lu(k,316) * lu(k,1127) + lu(k,1173) = lu(k,1173) - lu(k,317) * lu(k,1127) + lu(k,1183) = - lu(k,309) * lu(k,1181) + lu(k,1195) = lu(k,1195) - lu(k,310) * lu(k,1181) + lu(k,1199) = lu(k,1199) - lu(k,311) * lu(k,1181) + lu(k,1203) = lu(k,1203) - lu(k,312) * lu(k,1181) + lu(k,1210) = lu(k,1210) - lu(k,313) * lu(k,1181) + lu(k,1213) = - lu(k,314) * lu(k,1181) + lu(k,1214) = lu(k,1214) - lu(k,315) * lu(k,1181) + lu(k,1216) = lu(k,1216) - lu(k,316) * lu(k,1181) + lu(k,1217) = lu(k,1217) - lu(k,317) * lu(k,1181) + end do + end subroutine lu_fac07 + subroutine lu_fac08( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,318) = 1._r8 / lu(k,318) + lu(k,319) = lu(k,319) * lu(k,318) + lu(k,320) = lu(k,320) * lu(k,318) + lu(k,321) = lu(k,321) * lu(k,318) + lu(k,322) = lu(k,322) * lu(k,318) + lu(k,524) = lu(k,524) - lu(k,319) * lu(k,523) + lu(k,534) = lu(k,534) - lu(k,320) * lu(k,523) + lu(k,544) = lu(k,544) - lu(k,321) * lu(k,523) + lu(k,547) = - lu(k,322) * lu(k,523) + lu(k,664) = lu(k,664) - lu(k,319) * lu(k,663) + lu(k,670) = lu(k,670) - lu(k,320) * lu(k,663) + lu(k,676) = lu(k,676) - lu(k,321) * lu(k,663) + lu(k,679) = lu(k,679) - lu(k,322) * lu(k,663) + lu(k,684) = lu(k,684) - lu(k,319) * lu(k,683) + lu(k,697) = lu(k,697) - lu(k,320) * lu(k,683) + lu(k,703) = lu(k,703) - lu(k,321) * lu(k,683) + lu(k,706) = lu(k,706) - lu(k,322) * lu(k,683) + lu(k,735) = lu(k,735) - lu(k,319) * lu(k,734) + lu(k,753) = lu(k,753) - lu(k,320) * lu(k,734) + lu(k,763) = lu(k,763) - lu(k,321) * lu(k,734) + lu(k,767) = lu(k,767) - lu(k,322) * lu(k,734) + lu(k,911) = lu(k,911) - lu(k,319) * lu(k,910) + lu(k,936) = lu(k,936) - lu(k,320) * lu(k,910) + lu(k,948) = lu(k,948) - lu(k,321) * lu(k,910) + lu(k,952) = lu(k,952) - lu(k,322) * lu(k,910) + lu(k,979) = lu(k,979) - lu(k,319) * lu(k,978) + lu(k,1002) = lu(k,1002) - lu(k,320) * lu(k,978) + lu(k,1014) = lu(k,1014) - lu(k,321) * lu(k,978) + lu(k,1018) = - lu(k,322) * lu(k,978) + lu(k,1129) = lu(k,1129) - lu(k,319) * lu(k,1128) + lu(k,1160) = lu(k,1160) - lu(k,320) * lu(k,1128) + lu(k,1172) = lu(k,1172) - lu(k,321) * lu(k,1128) + lu(k,1176) = lu(k,1176) - lu(k,322) * lu(k,1128) + lu(k,323) = 1._r8 / lu(k,323) + lu(k,324) = lu(k,324) * lu(k,323) + lu(k,325) = lu(k,325) * lu(k,323) + lu(k,337) = lu(k,337) - lu(k,324) * lu(k,335) + lu(k,338) = - lu(k,325) * lu(k,335) + lu(k,460) = lu(k,460) - lu(k,324) * lu(k,457) + lu(k,462) = - lu(k,325) * lu(k,457) + lu(k,478) = lu(k,478) - lu(k,324) * lu(k,476) + lu(k,485) = lu(k,485) - lu(k,325) * lu(k,476) + lu(k,510) = lu(k,510) - lu(k,324) * lu(k,509) + lu(k,511) = - lu(k,325) * lu(k,509) + lu(k,528) = lu(k,528) - lu(k,324) * lu(k,524) + lu(k,539) = - lu(k,325) * lu(k,524) + lu(k,577) = lu(k,577) - lu(k,324) * lu(k,573) + lu(k,583) = - lu(k,325) * lu(k,573) + lu(k,666) = - lu(k,324) * lu(k,664) + lu(k,672) = - lu(k,325) * lu(k,664) + lu(k,688) = lu(k,688) - lu(k,324) * lu(k,684) + lu(k,699) = - lu(k,325) * lu(k,684) + lu(k,708) = lu(k,708) - lu(k,324) * lu(k,707) + lu(k,721) = - lu(k,325) * lu(k,707) + lu(k,743) = lu(k,743) - lu(k,324) * lu(k,735) + lu(k,758) = - lu(k,325) * lu(k,735) + lu(k,925) = - lu(k,324) * lu(k,911) + lu(k,942) = lu(k,942) - lu(k,325) * lu(k,911) + lu(k,989) = lu(k,989) - lu(k,324) * lu(k,979) + lu(k,1008) = lu(k,1008) - lu(k,325) * lu(k,979) + lu(k,1032) = - lu(k,324) * lu(k,1026) + lu(k,1044) = lu(k,1044) - lu(k,325) * lu(k,1026) + lu(k,1147) = lu(k,1147) - lu(k,324) * lu(k,1129) + lu(k,1166) = lu(k,1166) - lu(k,325) * lu(k,1129) + lu(k,1261) = lu(k,1261) - lu(k,324) * lu(k,1249) + lu(k,1277) = lu(k,1277) - lu(k,325) * lu(k,1249) + lu(k,328) = 1._r8 / lu(k,328) + lu(k,329) = lu(k,329) * lu(k,328) + lu(k,330) = lu(k,330) * lu(k,328) + lu(k,331) = lu(k,331) * lu(k,328) + lu(k,332) = lu(k,332) * lu(k,328) + lu(k,333) = lu(k,333) * lu(k,328) + lu(k,334) = lu(k,334) * lu(k,328) + lu(k,844) = - lu(k,329) * lu(k,840) + lu(k,853) = lu(k,853) - lu(k,330) * lu(k,840) + lu(k,858) = lu(k,858) - lu(k,331) * lu(k,840) + lu(k,861) = - lu(k,332) * lu(k,840) + lu(k,863) = lu(k,863) - lu(k,333) * lu(k,840) + lu(k,866) = - lu(k,334) * lu(k,840) + lu(k,921) = lu(k,921) - lu(k,329) * lu(k,912) + lu(k,938) = lu(k,938) - lu(k,330) * lu(k,912) + lu(k,943) = lu(k,943) - lu(k,331) * lu(k,912) + lu(k,946) = lu(k,946) - lu(k,332) * lu(k,912) + lu(k,948) = lu(k,948) - lu(k,333) * lu(k,912) + lu(k,951) = lu(k,951) - lu(k,334) * lu(k,912) + lu(k,984) = - lu(k,329) * lu(k,980) + lu(k,1004) = lu(k,1004) - lu(k,330) * lu(k,980) + lu(k,1009) = lu(k,1009) - lu(k,331) * lu(k,980) + lu(k,1012) = lu(k,1012) - lu(k,332) * lu(k,980) + lu(k,1014) = lu(k,1014) - lu(k,333) * lu(k,980) + lu(k,1017) = lu(k,1017) - lu(k,334) * lu(k,980) + lu(k,1142) = lu(k,1142) - lu(k,329) * lu(k,1130) + lu(k,1162) = lu(k,1162) - lu(k,330) * lu(k,1130) + lu(k,1167) = lu(k,1167) - lu(k,331) * lu(k,1130) + lu(k,1170) = lu(k,1170) - lu(k,332) * lu(k,1130) + lu(k,1172) = lu(k,1172) - lu(k,333) * lu(k,1130) + lu(k,1175) = lu(k,1175) - lu(k,334) * lu(k,1130) + lu(k,1257) = lu(k,1257) - lu(k,329) * lu(k,1250) + lu(k,1273) = lu(k,1273) - lu(k,330) * lu(k,1250) + lu(k,1278) = lu(k,1278) - lu(k,331) * lu(k,1250) + lu(k,1281) = lu(k,1281) - lu(k,332) * lu(k,1250) + lu(k,1283) = lu(k,1283) - lu(k,333) * lu(k,1250) + lu(k,1286) = lu(k,1286) - lu(k,334) * lu(k,1250) + lu(k,336) = 1._r8 / lu(k,336) + lu(k,337) = lu(k,337) * lu(k,336) + lu(k,338) = lu(k,338) * lu(k,336) + lu(k,339) = lu(k,339) * lu(k,336) + lu(k,340) = lu(k,340) * lu(k,336) + lu(k,460) = lu(k,460) - lu(k,337) * lu(k,458) + lu(k,462) = lu(k,462) - lu(k,338) * lu(k,458) + lu(k,463) = lu(k,463) - lu(k,339) * lu(k,458) + lu(k,464) = lu(k,464) - lu(k,340) * lu(k,458) + lu(k,577) = lu(k,577) - lu(k,337) * lu(k,574) + lu(k,583) = lu(k,583) - lu(k,338) * lu(k,574) + lu(k,584) = lu(k,584) - lu(k,339) * lu(k,574) + lu(k,586) = lu(k,586) - lu(k,340) * lu(k,574) + lu(k,622) = - lu(k,337) * lu(k,618) + lu(k,633) = - lu(k,338) * lu(k,618) + lu(k,634) = lu(k,634) - lu(k,339) * lu(k,618) + lu(k,637) = lu(k,637) - lu(k,340) * lu(k,618) + lu(k,688) = lu(k,688) - lu(k,337) * lu(k,685) + lu(k,699) = lu(k,699) - lu(k,338) * lu(k,685) + lu(k,700) = lu(k,700) - lu(k,339) * lu(k,685) + lu(k,703) = lu(k,703) - lu(k,340) * lu(k,685) + lu(k,743) = lu(k,743) - lu(k,337) * lu(k,736) + lu(k,758) = lu(k,758) - lu(k,338) * lu(k,736) + lu(k,759) = lu(k,759) - lu(k,339) * lu(k,736) + lu(k,763) = lu(k,763) - lu(k,340) * lu(k,736) + lu(k,1147) = lu(k,1147) - lu(k,337) * lu(k,1131) + lu(k,1166) = lu(k,1166) - lu(k,338) * lu(k,1131) + lu(k,1167) = lu(k,1167) - lu(k,339) * lu(k,1131) + lu(k,1172) = lu(k,1172) - lu(k,340) * lu(k,1131) + lu(k,1192) = lu(k,1192) - lu(k,337) * lu(k,1182) + lu(k,1210) = lu(k,1210) - lu(k,338) * lu(k,1182) + lu(k,1211) = lu(k,1211) - lu(k,339) * lu(k,1182) + lu(k,1216) = lu(k,1216) - lu(k,340) * lu(k,1182) + lu(k,1261) = lu(k,1261) - lu(k,337) * lu(k,1251) + lu(k,1277) = lu(k,1277) - lu(k,338) * lu(k,1251) + lu(k,1278) = lu(k,1278) - lu(k,339) * lu(k,1251) + lu(k,1283) = lu(k,1283) - lu(k,340) * lu(k,1251) + lu(k,342) = 1._r8 / lu(k,342) + lu(k,343) = lu(k,343) * lu(k,342) + lu(k,344) = lu(k,344) * lu(k,342) + lu(k,345) = lu(k,345) * lu(k,342) + lu(k,346) = lu(k,346) * lu(k,342) + lu(k,347) = lu(k,347) * lu(k,342) + lu(k,348) = lu(k,348) * lu(k,342) + lu(k,349) = lu(k,349) * lu(k,342) + lu(k,350) = lu(k,350) * lu(k,342) + lu(k,527) = - lu(k,343) * lu(k,525) + lu(k,531) = lu(k,531) - lu(k,344) * lu(k,525) + lu(k,536) = lu(k,536) - lu(k,345) * lu(k,525) + lu(k,540) = lu(k,540) - lu(k,346) * lu(k,525) + lu(k,542) = lu(k,542) - lu(k,347) * lu(k,525) + lu(k,544) = lu(k,544) - lu(k,348) * lu(k,525) + lu(k,546) = - lu(k,349) * lu(k,525) + lu(k,547) = lu(k,547) - lu(k,350) * lu(k,525) + lu(k,924) = lu(k,924) - lu(k,343) * lu(k,913) + lu(k,927) = lu(k,927) - lu(k,344) * lu(k,913) + lu(k,938) = lu(k,938) - lu(k,345) * lu(k,913) + lu(k,943) = lu(k,943) - lu(k,346) * lu(k,913) + lu(k,946) = lu(k,946) - lu(k,347) * lu(k,913) + lu(k,948) = lu(k,948) - lu(k,348) * lu(k,913) + lu(k,951) = lu(k,951) - lu(k,349) * lu(k,913) + lu(k,952) = lu(k,952) - lu(k,350) * lu(k,913) + lu(k,1146) = lu(k,1146) - lu(k,343) * lu(k,1132) + lu(k,1150) = lu(k,1150) - lu(k,344) * lu(k,1132) + lu(k,1162) = lu(k,1162) - lu(k,345) * lu(k,1132) + lu(k,1167) = lu(k,1167) - lu(k,346) * lu(k,1132) + lu(k,1170) = lu(k,1170) - lu(k,347) * lu(k,1132) + lu(k,1172) = lu(k,1172) - lu(k,348) * lu(k,1132) + lu(k,1175) = lu(k,1175) - lu(k,349) * lu(k,1132) + lu(k,1176) = lu(k,1176) - lu(k,350) * lu(k,1132) + lu(k,1260) = lu(k,1260) - lu(k,343) * lu(k,1252) + lu(k,1262) = lu(k,1262) - lu(k,344) * lu(k,1252) + lu(k,1273) = lu(k,1273) - lu(k,345) * lu(k,1252) + lu(k,1278) = lu(k,1278) - lu(k,346) * lu(k,1252) + lu(k,1281) = lu(k,1281) - lu(k,347) * lu(k,1252) + lu(k,1283) = lu(k,1283) - lu(k,348) * lu(k,1252) + lu(k,1286) = lu(k,1286) - lu(k,349) * lu(k,1252) + lu(k,1287) = - lu(k,350) * lu(k,1252) + end do + end subroutine lu_fac08 + subroutine lu_fac09( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,352) = 1._r8 / lu(k,352) + lu(k,353) = lu(k,353) * lu(k,352) + lu(k,354) = lu(k,354) * lu(k,352) + lu(k,355) = lu(k,355) * lu(k,352) + lu(k,356) = lu(k,356) * lu(k,352) + lu(k,357) = lu(k,357) * lu(k,352) + lu(k,358) = lu(k,358) * lu(k,352) + lu(k,359) = lu(k,359) * lu(k,352) + lu(k,819) = lu(k,819) - lu(k,353) * lu(k,814) + lu(k,820) = lu(k,820) - lu(k,354) * lu(k,814) + lu(k,821) = lu(k,821) - lu(k,355) * lu(k,814) + lu(k,822) = lu(k,822) - lu(k,356) * lu(k,814) + lu(k,824) = - lu(k,357) * lu(k,814) + lu(k,828) = lu(k,828) - lu(k,358) * lu(k,814) + lu(k,831) = lu(k,831) - lu(k,359) * lu(k,814) + lu(k,883) = lu(k,883) - lu(k,353) * lu(k,872) + lu(k,884) = lu(k,884) - lu(k,354) * lu(k,872) + lu(k,885) = lu(k,885) - lu(k,355) * lu(k,872) + lu(k,886) = lu(k,886) - lu(k,356) * lu(k,872) + lu(k,888) = lu(k,888) - lu(k,357) * lu(k,872) + lu(k,892) = lu(k,892) - lu(k,358) * lu(k,872) + lu(k,896) = lu(k,896) - lu(k,359) * lu(k,872) + lu(k,939) = lu(k,939) - lu(k,353) * lu(k,914) + lu(k,940) = lu(k,940) - lu(k,354) * lu(k,914) + lu(k,941) = lu(k,941) - lu(k,355) * lu(k,914) + lu(k,942) = lu(k,942) - lu(k,356) * lu(k,914) + lu(k,944) = lu(k,944) - lu(k,357) * lu(k,914) + lu(k,948) = lu(k,948) - lu(k,358) * lu(k,914) + lu(k,952) = lu(k,952) - lu(k,359) * lu(k,914) + lu(k,961) = lu(k,961) - lu(k,353) * lu(k,956) + lu(k,962) = - lu(k,354) * lu(k,956) + lu(k,963) = lu(k,963) - lu(k,355) * lu(k,956) + lu(k,964) = lu(k,964) - lu(k,356) * lu(k,956) + lu(k,966) = lu(k,966) - lu(k,357) * lu(k,956) + lu(k,970) = lu(k,970) - lu(k,358) * lu(k,956) + lu(k,974) = - lu(k,359) * lu(k,956) + lu(k,1041) = lu(k,1041) - lu(k,353) * lu(k,1027) + lu(k,1042) = - lu(k,354) * lu(k,1027) + lu(k,1043) = - lu(k,355) * lu(k,1027) + lu(k,1044) = lu(k,1044) - lu(k,356) * lu(k,1027) + lu(k,1046) = lu(k,1046) - lu(k,357) * lu(k,1027) + lu(k,1050) = lu(k,1050) - lu(k,358) * lu(k,1027) + lu(k,1054) = lu(k,1054) - lu(k,359) * lu(k,1027) + lu(k,360) = 1._r8 / lu(k,360) + lu(k,361) = lu(k,361) * lu(k,360) + lu(k,362) = lu(k,362) * lu(k,360) + lu(k,363) = lu(k,363) * lu(k,360) + lu(k,364) = lu(k,364) * lu(k,360) + lu(k,365) = lu(k,365) * lu(k,360) + lu(k,390) = - lu(k,361) * lu(k,388) + lu(k,392) = - lu(k,362) * lu(k,388) + lu(k,393) = lu(k,393) - lu(k,363) * lu(k,388) + lu(k,397) = lu(k,397) - lu(k,364) * lu(k,388) + lu(k,399) = lu(k,399) - lu(k,365) * lu(k,388) + lu(k,741) = lu(k,741) - lu(k,361) * lu(k,737) + lu(k,751) = lu(k,751) - lu(k,362) * lu(k,737) + lu(k,753) = lu(k,753) - lu(k,363) * lu(k,737) + lu(k,763) = lu(k,763) - lu(k,364) * lu(k,737) + lu(k,767) = lu(k,767) - lu(k,365) * lu(k,737) + lu(k,923) = lu(k,923) - lu(k,361) * lu(k,915) + lu(k,934) = lu(k,934) - lu(k,362) * lu(k,915) + lu(k,936) = lu(k,936) - lu(k,363) * lu(k,915) + lu(k,948) = lu(k,948) - lu(k,364) * lu(k,915) + lu(k,952) = lu(k,952) - lu(k,365) * lu(k,915) + lu(k,987) = - lu(k,361) * lu(k,981) + lu(k,1000) = lu(k,1000) - lu(k,362) * lu(k,981) + lu(k,1002) = lu(k,1002) - lu(k,363) * lu(k,981) + lu(k,1014) = lu(k,1014) - lu(k,364) * lu(k,981) + lu(k,1018) = lu(k,1018) - lu(k,365) * lu(k,981) + lu(k,1145) = lu(k,1145) - lu(k,361) * lu(k,1133) + lu(k,1158) = lu(k,1158) - lu(k,362) * lu(k,1133) + lu(k,1160) = lu(k,1160) - lu(k,363) * lu(k,1133) + lu(k,1172) = lu(k,1172) - lu(k,364) * lu(k,1133) + lu(k,1176) = lu(k,1176) - lu(k,365) * lu(k,1133) + lu(k,1190) = - lu(k,361) * lu(k,1183) + lu(k,1202) = lu(k,1202) - lu(k,362) * lu(k,1183) + lu(k,1204) = - lu(k,363) * lu(k,1183) + lu(k,1216) = lu(k,1216) - lu(k,364) * lu(k,1183) + lu(k,1220) = - lu(k,365) * lu(k,1183) + lu(k,1259) = lu(k,1259) - lu(k,361) * lu(k,1253) + lu(k,1269) = lu(k,1269) - lu(k,362) * lu(k,1253) + lu(k,1271) = lu(k,1271) - lu(k,363) * lu(k,1253) + lu(k,1283) = lu(k,1283) - lu(k,364) * lu(k,1253) + lu(k,1287) = lu(k,1287) - lu(k,365) * lu(k,1253) + lu(k,369) = 1._r8 / lu(k,369) + lu(k,370) = lu(k,370) * lu(k,369) + lu(k,371) = lu(k,371) * lu(k,369) + lu(k,372) = lu(k,372) * lu(k,369) + lu(k,373) = lu(k,373) * lu(k,369) + lu(k,374) = lu(k,374) * lu(k,369) + lu(k,375) = lu(k,375) * lu(k,369) + lu(k,376) = lu(k,376) * lu(k,369) + lu(k,744) = lu(k,744) - lu(k,370) * lu(k,738) + lu(k,753) = lu(k,753) - lu(k,371) * lu(k,738) + lu(k,755) = lu(k,755) - lu(k,372) * lu(k,738) + lu(k,759) = lu(k,759) - lu(k,373) * lu(k,738) + lu(k,761) = lu(k,761) - lu(k,374) * lu(k,738) + lu(k,763) = lu(k,763) - lu(k,375) * lu(k,738) + lu(k,766) = lu(k,766) - lu(k,376) * lu(k,738) + lu(k,848) = - lu(k,370) * lu(k,841) + lu(k,851) = lu(k,851) - lu(k,371) * lu(k,841) + lu(k,853) = lu(k,853) - lu(k,372) * lu(k,841) + lu(k,858) = lu(k,858) - lu(k,373) * lu(k,841) + lu(k,861) = lu(k,861) - lu(k,374) * lu(k,841) + lu(k,863) = lu(k,863) - lu(k,375) * lu(k,841) + lu(k,866) = lu(k,866) - lu(k,376) * lu(k,841) + lu(k,927) = lu(k,927) - lu(k,370) * lu(k,916) + lu(k,936) = lu(k,936) - lu(k,371) * lu(k,916) + lu(k,938) = lu(k,938) - lu(k,372) * lu(k,916) + lu(k,943) = lu(k,943) - lu(k,373) * lu(k,916) + lu(k,946) = lu(k,946) - lu(k,374) * lu(k,916) + lu(k,948) = lu(k,948) - lu(k,375) * lu(k,916) + lu(k,951) = lu(k,951) - lu(k,376) * lu(k,916) + lu(k,1150) = lu(k,1150) - lu(k,370) * lu(k,1134) + lu(k,1160) = lu(k,1160) - lu(k,371) * lu(k,1134) + lu(k,1162) = lu(k,1162) - lu(k,372) * lu(k,1134) + lu(k,1167) = lu(k,1167) - lu(k,373) * lu(k,1134) + lu(k,1170) = lu(k,1170) - lu(k,374) * lu(k,1134) + lu(k,1172) = lu(k,1172) - lu(k,375) * lu(k,1134) + lu(k,1175) = lu(k,1175) - lu(k,376) * lu(k,1134) + lu(k,1262) = lu(k,1262) - lu(k,370) * lu(k,1254) + lu(k,1271) = lu(k,1271) - lu(k,371) * lu(k,1254) + lu(k,1273) = lu(k,1273) - lu(k,372) * lu(k,1254) + lu(k,1278) = lu(k,1278) - lu(k,373) * lu(k,1254) + lu(k,1281) = lu(k,1281) - lu(k,374) * lu(k,1254) + lu(k,1283) = lu(k,1283) - lu(k,375) * lu(k,1254) + lu(k,1286) = lu(k,1286) - lu(k,376) * lu(k,1254) + lu(k,377) = 1._r8 / lu(k,377) + lu(k,378) = lu(k,378) * lu(k,377) + lu(k,379) = lu(k,379) * lu(k,377) + lu(k,380) = lu(k,380) * lu(k,377) + lu(k,381) = lu(k,381) * lu(k,377) + lu(k,382) = lu(k,382) * lu(k,377) + lu(k,383) = lu(k,383) * lu(k,377) + lu(k,384) = lu(k,384) * lu(k,377) + lu(k,385) = lu(k,385) * lu(k,377) + lu(k,386) = lu(k,386) * lu(k,377) + lu(k,430) = - lu(k,378) * lu(k,428) + lu(k,433) = lu(k,433) - lu(k,379) * lu(k,428) + lu(k,436) = lu(k,436) - lu(k,380) * lu(k,428) + lu(k,438) = lu(k,438) - lu(k,381) * lu(k,428) + lu(k,439) = lu(k,439) - lu(k,382) * lu(k,428) + lu(k,441) = - lu(k,383) * lu(k,428) + lu(k,442) = lu(k,442) - lu(k,384) * lu(k,428) + lu(k,443) = lu(k,443) - lu(k,385) * lu(k,428) + lu(k,444) = - lu(k,386) * lu(k,428) + lu(k,922) = lu(k,922) - lu(k,378) * lu(k,917) + lu(k,928) = lu(k,928) - lu(k,379) * lu(k,917) + lu(k,935) = lu(k,935) - lu(k,380) * lu(k,917) + lu(k,938) = lu(k,938) - lu(k,381) * lu(k,917) + lu(k,943) = lu(k,943) - lu(k,382) * lu(k,917) + lu(k,946) = lu(k,946) - lu(k,383) * lu(k,917) + lu(k,948) = lu(k,948) - lu(k,384) * lu(k,917) + lu(k,949) = lu(k,949) - lu(k,385) * lu(k,917) + lu(k,951) = lu(k,951) - lu(k,386) * lu(k,917) + lu(k,1189) = lu(k,1189) - lu(k,378) * lu(k,1184) + lu(k,1195) = lu(k,1195) - lu(k,379) * lu(k,1184) + lu(k,1203) = lu(k,1203) - lu(k,380) * lu(k,1184) + lu(k,1206) = lu(k,1206) - lu(k,381) * lu(k,1184) + lu(k,1211) = lu(k,1211) - lu(k,382) * lu(k,1184) + lu(k,1214) = lu(k,1214) - lu(k,383) * lu(k,1184) + lu(k,1216) = lu(k,1216) - lu(k,384) * lu(k,1184) + lu(k,1217) = lu(k,1217) - lu(k,385) * lu(k,1184) + lu(k,1219) = lu(k,1219) - lu(k,386) * lu(k,1184) + lu(k,1258) = lu(k,1258) - lu(k,378) * lu(k,1255) + lu(k,1263) = lu(k,1263) - lu(k,379) * lu(k,1255) + lu(k,1270) = lu(k,1270) - lu(k,380) * lu(k,1255) + lu(k,1273) = lu(k,1273) - lu(k,381) * lu(k,1255) + lu(k,1278) = lu(k,1278) - lu(k,382) * lu(k,1255) + lu(k,1281) = lu(k,1281) - lu(k,383) * lu(k,1255) + lu(k,1283) = lu(k,1283) - lu(k,384) * lu(k,1255) + lu(k,1284) = lu(k,1284) - lu(k,385) * lu(k,1255) + lu(k,1286) = lu(k,1286) - lu(k,386) * lu(k,1255) + lu(k,389) = 1._r8 / lu(k,389) + lu(k,390) = lu(k,390) * lu(k,389) + lu(k,391) = lu(k,391) * lu(k,389) + lu(k,392) = lu(k,392) * lu(k,389) + lu(k,393) = lu(k,393) * lu(k,389) + lu(k,394) = lu(k,394) * lu(k,389) + lu(k,395) = lu(k,395) * lu(k,389) + lu(k,396) = lu(k,396) * lu(k,389) + lu(k,397) = lu(k,397) * lu(k,389) + lu(k,398) = lu(k,398) * lu(k,389) + lu(k,399) = lu(k,399) * lu(k,389) + lu(k,741) = lu(k,741) - lu(k,390) * lu(k,739) + lu(k,744) = lu(k,744) - lu(k,391) * lu(k,739) + lu(k,751) = lu(k,751) - lu(k,392) * lu(k,739) + lu(k,753) = lu(k,753) - lu(k,393) * lu(k,739) + lu(k,755) = lu(k,755) - lu(k,394) * lu(k,739) + lu(k,759) = lu(k,759) - lu(k,395) * lu(k,739) + lu(k,761) = lu(k,761) - lu(k,396) * lu(k,739) + lu(k,763) = lu(k,763) - lu(k,397) * lu(k,739) + lu(k,766) = lu(k,766) - lu(k,398) * lu(k,739) + lu(k,767) = lu(k,767) - lu(k,399) * lu(k,739) + lu(k,923) = lu(k,923) - lu(k,390) * lu(k,918) + lu(k,927) = lu(k,927) - lu(k,391) * lu(k,918) + lu(k,934) = lu(k,934) - lu(k,392) * lu(k,918) + lu(k,936) = lu(k,936) - lu(k,393) * lu(k,918) + lu(k,938) = lu(k,938) - lu(k,394) * lu(k,918) + lu(k,943) = lu(k,943) - lu(k,395) * lu(k,918) + lu(k,946) = lu(k,946) - lu(k,396) * lu(k,918) + lu(k,948) = lu(k,948) - lu(k,397) * lu(k,918) + lu(k,951) = lu(k,951) - lu(k,398) * lu(k,918) + lu(k,952) = lu(k,952) - lu(k,399) * lu(k,918) + lu(k,1145) = lu(k,1145) - lu(k,390) * lu(k,1135) + lu(k,1150) = lu(k,1150) - lu(k,391) * lu(k,1135) + lu(k,1158) = lu(k,1158) - lu(k,392) * lu(k,1135) + lu(k,1160) = lu(k,1160) - lu(k,393) * lu(k,1135) + lu(k,1162) = lu(k,1162) - lu(k,394) * lu(k,1135) + lu(k,1167) = lu(k,1167) - lu(k,395) * lu(k,1135) + lu(k,1170) = lu(k,1170) - lu(k,396) * lu(k,1135) + lu(k,1172) = lu(k,1172) - lu(k,397) * lu(k,1135) + lu(k,1175) = lu(k,1175) - lu(k,398) * lu(k,1135) + lu(k,1176) = lu(k,1176) - lu(k,399) * lu(k,1135) + lu(k,1259) = lu(k,1259) - lu(k,390) * lu(k,1256) + lu(k,1262) = lu(k,1262) - lu(k,391) * lu(k,1256) + lu(k,1269) = lu(k,1269) - lu(k,392) * lu(k,1256) + lu(k,1271) = lu(k,1271) - lu(k,393) * lu(k,1256) + lu(k,1273) = lu(k,1273) - lu(k,394) * lu(k,1256) + lu(k,1278) = lu(k,1278) - lu(k,395) * lu(k,1256) + lu(k,1281) = lu(k,1281) - lu(k,396) * lu(k,1256) + lu(k,1283) = lu(k,1283) - lu(k,397) * lu(k,1256) + lu(k,1286) = lu(k,1286) - lu(k,398) * lu(k,1256) + lu(k,1287) = lu(k,1287) - lu(k,399) * lu(k,1256) + end do + end subroutine lu_fac09 + subroutine lu_fac10( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,401) = 1._r8 / lu(k,401) + lu(k,402) = lu(k,402) * lu(k,401) + lu(k,403) = lu(k,403) * lu(k,401) + lu(k,404) = lu(k,404) * lu(k,401) + lu(k,405) = lu(k,405) * lu(k,401) + lu(k,406) = lu(k,406) * lu(k,401) + lu(k,407) = lu(k,407) * lu(k,401) + lu(k,449) = lu(k,449) - lu(k,402) * lu(k,446) + lu(k,450) = lu(k,450) - lu(k,403) * lu(k,446) + lu(k,451) = lu(k,451) - lu(k,404) * lu(k,446) + lu(k,453) = lu(k,453) - lu(k,405) * lu(k,446) + lu(k,455) = lu(k,455) - lu(k,406) * lu(k,446) + lu(k,456) = - lu(k,407) * lu(k,446) + lu(k,820) = lu(k,820) - lu(k,402) * lu(k,815) + lu(k,821) = lu(k,821) - lu(k,403) * lu(k,815) + lu(k,822) = lu(k,822) - lu(k,404) * lu(k,815) + lu(k,828) = lu(k,828) - lu(k,405) * lu(k,815) + lu(k,830) = lu(k,830) - lu(k,406) * lu(k,815) + lu(k,831) = lu(k,831) - lu(k,407) * lu(k,815) + lu(k,855) = lu(k,855) - lu(k,402) * lu(k,842) + lu(k,856) = lu(k,856) - lu(k,403) * lu(k,842) + lu(k,857) = lu(k,857) - lu(k,404) * lu(k,842) + lu(k,863) = lu(k,863) - lu(k,405) * lu(k,842) + lu(k,865) = lu(k,865) - lu(k,406) * lu(k,842) + lu(k,867) = lu(k,867) - lu(k,407) * lu(k,842) + lu(k,884) = lu(k,884) - lu(k,402) * lu(k,873) + lu(k,885) = lu(k,885) - lu(k,403) * lu(k,873) + lu(k,886) = lu(k,886) - lu(k,404) * lu(k,873) + lu(k,892) = lu(k,892) - lu(k,405) * lu(k,873) + lu(k,894) = lu(k,894) - lu(k,406) * lu(k,873) + lu(k,896) = lu(k,896) - lu(k,407) * lu(k,873) + lu(k,940) = lu(k,940) - lu(k,402) * lu(k,919) + lu(k,941) = lu(k,941) - lu(k,403) * lu(k,919) + lu(k,942) = lu(k,942) - lu(k,404) * lu(k,919) + lu(k,948) = lu(k,948) - lu(k,405) * lu(k,919) + lu(k,950) = lu(k,950) - lu(k,406) * lu(k,919) + lu(k,952) = lu(k,952) - lu(k,407) * lu(k,919) + lu(k,1164) = lu(k,1164) - lu(k,402) * lu(k,1136) + lu(k,1165) = lu(k,1165) - lu(k,403) * lu(k,1136) + lu(k,1166) = lu(k,1166) - lu(k,404) * lu(k,1136) + lu(k,1172) = lu(k,1172) - lu(k,405) * lu(k,1136) + lu(k,1174) = lu(k,1174) - lu(k,406) * lu(k,1136) + lu(k,1176) = lu(k,1176) - lu(k,407) * lu(k,1136) + lu(k,1233) = lu(k,1233) - lu(k,402) * lu(k,1225) + lu(k,1234) = lu(k,1234) - lu(k,403) * lu(k,1225) + lu(k,1235) = lu(k,1235) - lu(k,404) * lu(k,1225) + lu(k,1241) = lu(k,1241) - lu(k,405) * lu(k,1225) + lu(k,1243) = lu(k,1243) - lu(k,406) * lu(k,1225) + lu(k,1245) = - lu(k,407) * lu(k,1225) + lu(k,408) = 1._r8 / lu(k,408) + lu(k,409) = lu(k,409) * lu(k,408) + lu(k,410) = lu(k,410) * lu(k,408) + lu(k,411) = lu(k,411) * lu(k,408) + lu(k,412) = lu(k,412) * lu(k,408) + lu(k,413) = lu(k,413) * lu(k,408) + lu(k,414) = lu(k,414) * lu(k,408) + lu(k,415) = lu(k,415) * lu(k,408) + lu(k,782) = lu(k,782) - lu(k,409) * lu(k,778) + lu(k,784) = lu(k,784) - lu(k,410) * lu(k,778) + lu(k,787) = lu(k,787) - lu(k,411) * lu(k,778) + lu(k,789) = - lu(k,412) * lu(k,778) + lu(k,792) = - lu(k,413) * lu(k,778) + lu(k,793) = lu(k,793) - lu(k,414) * lu(k,778) + lu(k,795) = lu(k,795) - lu(k,415) * lu(k,778) + lu(k,798) = - lu(k,409) * lu(k,796) + lu(k,800) = lu(k,800) - lu(k,410) * lu(k,796) + lu(k,803) = - lu(k,411) * lu(k,796) + lu(k,805) = lu(k,805) - lu(k,412) * lu(k,796) + lu(k,808) = - lu(k,413) * lu(k,796) + lu(k,809) = - lu(k,414) * lu(k,796) + lu(k,811) = - lu(k,415) * lu(k,796) + lu(k,881) = lu(k,881) - lu(k,409) * lu(k,874) + lu(k,883) = lu(k,883) - lu(k,410) * lu(k,874) + lu(k,886) = lu(k,886) - lu(k,411) * lu(k,874) + lu(k,888) = lu(k,888) - lu(k,412) * lu(k,874) + lu(k,891) = - lu(k,413) * lu(k,874) + lu(k,892) = lu(k,892) - lu(k,414) * lu(k,874) + lu(k,896) = lu(k,896) - lu(k,415) * lu(k,874) + lu(k,937) = lu(k,937) - lu(k,409) * lu(k,920) + lu(k,939) = lu(k,939) - lu(k,410) * lu(k,920) + lu(k,942) = lu(k,942) - lu(k,411) * lu(k,920) + lu(k,944) = lu(k,944) - lu(k,412) * lu(k,920) + lu(k,947) = - lu(k,413) * lu(k,920) + lu(k,948) = lu(k,948) - lu(k,414) * lu(k,920) + lu(k,952) = lu(k,952) - lu(k,415) * lu(k,920) + lu(k,1076) = lu(k,1076) - lu(k,409) * lu(k,1071) + lu(k,1078) = lu(k,1078) - lu(k,410) * lu(k,1071) + lu(k,1081) = lu(k,1081) - lu(k,411) * lu(k,1071) + lu(k,1083) = lu(k,1083) - lu(k,412) * lu(k,1071) + lu(k,1086) = lu(k,1086) - lu(k,413) * lu(k,1071) + lu(k,1087) = lu(k,1087) - lu(k,414) * lu(k,1071) + lu(k,1091) = lu(k,1091) - lu(k,415) * lu(k,1071) + lu(k,1161) = lu(k,1161) - lu(k,409) * lu(k,1137) + lu(k,1163) = lu(k,1163) - lu(k,410) * lu(k,1137) + lu(k,1166) = lu(k,1166) - lu(k,411) * lu(k,1137) + lu(k,1168) = lu(k,1168) - lu(k,412) * lu(k,1137) + lu(k,1171) = lu(k,1171) - lu(k,413) * lu(k,1137) + lu(k,1172) = lu(k,1172) - lu(k,414) * lu(k,1137) + lu(k,1176) = lu(k,1176) - lu(k,415) * lu(k,1137) + lu(k,416) = 1._r8 / lu(k,416) + lu(k,417) = lu(k,417) * lu(k,416) + lu(k,418) = lu(k,418) * lu(k,416) + lu(k,419) = lu(k,419) * lu(k,416) + lu(k,420) = lu(k,420) * lu(k,416) + lu(k,452) = lu(k,452) - lu(k,417) * lu(k,447) + lu(k,453) = lu(k,453) - lu(k,418) * lu(k,447) + lu(k,454) = lu(k,454) - lu(k,419) * lu(k,447) + lu(k,456) = lu(k,456) - lu(k,420) * lu(k,447) + lu(k,472) = lu(k,472) - lu(k,417) * lu(k,466) + lu(k,473) = lu(k,473) - lu(k,418) * lu(k,466) + lu(k,474) = lu(k,474) - lu(k,419) * lu(k,466) + lu(k,475) = - lu(k,420) * lu(k,466) + lu(k,555) = - lu(k,417) * lu(k,548) + lu(k,556) = lu(k,556) - lu(k,418) * lu(k,548) + lu(k,557) = lu(k,557) - lu(k,419) * lu(k,548) + lu(k,558) = lu(k,558) - lu(k,420) * lu(k,548) + lu(k,595) = - lu(k,417) * lu(k,589) + lu(k,596) = lu(k,596) - lu(k,418) * lu(k,589) + lu(k,597) = lu(k,597) - lu(k,419) * lu(k,589) + lu(k,598) = lu(k,598) - lu(k,420) * lu(k,589) + lu(k,791) = - lu(k,417) * lu(k,779) + lu(k,793) = lu(k,793) - lu(k,418) * lu(k,779) + lu(k,794) = lu(k,794) - lu(k,419) * lu(k,779) + lu(k,795) = lu(k,795) - lu(k,420) * lu(k,779) + lu(k,826) = - lu(k,417) * lu(k,816) + lu(k,828) = lu(k,828) - lu(k,418) * lu(k,816) + lu(k,829) = - lu(k,419) * lu(k,816) + lu(k,831) = lu(k,831) - lu(k,420) * lu(k,816) + lu(k,890) = lu(k,890) - lu(k,417) * lu(k,875) + lu(k,892) = lu(k,892) - lu(k,418) * lu(k,875) + lu(k,893) = lu(k,893) - lu(k,419) * lu(k,875) + lu(k,896) = lu(k,896) - lu(k,420) * lu(k,875) + lu(k,968) = lu(k,968) - lu(k,417) * lu(k,957) + lu(k,970) = lu(k,970) - lu(k,418) * lu(k,957) + lu(k,971) = lu(k,971) - lu(k,419) * lu(k,957) + lu(k,974) = lu(k,974) - lu(k,420) * lu(k,957) + lu(k,1048) = lu(k,1048) - lu(k,417) * lu(k,1028) + lu(k,1050) = lu(k,1050) - lu(k,418) * lu(k,1028) + lu(k,1051) = lu(k,1051) - lu(k,419) * lu(k,1028) + lu(k,1054) = lu(k,1054) - lu(k,420) * lu(k,1028) + lu(k,1170) = lu(k,1170) - lu(k,417) * lu(k,1138) + lu(k,1172) = lu(k,1172) - lu(k,418) * lu(k,1138) + lu(k,1173) = lu(k,1173) - lu(k,419) * lu(k,1138) + lu(k,1176) = lu(k,1176) - lu(k,420) * lu(k,1138) + lu(k,1214) = lu(k,1214) - lu(k,417) * lu(k,1185) + lu(k,1216) = lu(k,1216) - lu(k,418) * lu(k,1185) + lu(k,1217) = lu(k,1217) - lu(k,419) * lu(k,1185) + lu(k,1220) = lu(k,1220) - lu(k,420) * lu(k,1185) + lu(k,422) = 1._r8 / lu(k,422) + lu(k,423) = lu(k,423) * lu(k,422) + lu(k,424) = lu(k,424) * lu(k,422) + lu(k,425) = lu(k,425) * lu(k,422) + lu(k,426) = lu(k,426) * lu(k,422) + lu(k,427) = lu(k,427) * lu(k,422) + lu(k,602) = lu(k,602) - lu(k,423) * lu(k,601) + lu(k,606) = lu(k,606) - lu(k,424) * lu(k,601) + lu(k,607) = - lu(k,425) * lu(k,601) + lu(k,611) = lu(k,611) - lu(k,426) * lu(k,601) + lu(k,614) = - lu(k,427) * lu(k,601) + lu(k,880) = lu(k,880) - lu(k,423) * lu(k,876) + lu(k,886) = lu(k,886) - lu(k,424) * lu(k,876) + lu(k,887) = lu(k,887) - lu(k,425) * lu(k,876) + lu(k,892) = lu(k,892) - lu(k,426) * lu(k,876) + lu(k,896) = lu(k,896) - lu(k,427) * lu(k,876) + lu(k,959) = lu(k,959) - lu(k,423) * lu(k,958) + lu(k,964) = lu(k,964) - lu(k,424) * lu(k,958) + lu(k,965) = lu(k,965) - lu(k,425) * lu(k,958) + lu(k,970) = lu(k,970) - lu(k,426) * lu(k,958) + lu(k,974) = lu(k,974) - lu(k,427) * lu(k,958) + lu(k,996) = lu(k,996) - lu(k,423) * lu(k,982) + lu(k,1008) = lu(k,1008) - lu(k,424) * lu(k,982) + lu(k,1009) = lu(k,1009) - lu(k,425) * lu(k,982) + lu(k,1014) = lu(k,1014) - lu(k,426) * lu(k,982) + lu(k,1018) = lu(k,1018) - lu(k,427) * lu(k,982) + lu(k,1034) = lu(k,1034) - lu(k,423) * lu(k,1029) + lu(k,1044) = lu(k,1044) - lu(k,424) * lu(k,1029) + lu(k,1045) = lu(k,1045) - lu(k,425) * lu(k,1029) + lu(k,1050) = lu(k,1050) - lu(k,426) * lu(k,1029) + lu(k,1054) = lu(k,1054) - lu(k,427) * lu(k,1029) + lu(k,1154) = lu(k,1154) - lu(k,423) * lu(k,1139) + lu(k,1166) = lu(k,1166) - lu(k,424) * lu(k,1139) + lu(k,1167) = lu(k,1167) - lu(k,425) * lu(k,1139) + lu(k,1172) = lu(k,1172) - lu(k,426) * lu(k,1139) + lu(k,1176) = lu(k,1176) - lu(k,427) * lu(k,1139) + lu(k,1198) = - lu(k,423) * lu(k,1186) + lu(k,1210) = lu(k,1210) - lu(k,424) * lu(k,1186) + lu(k,1211) = lu(k,1211) - lu(k,425) * lu(k,1186) + lu(k,1216) = lu(k,1216) - lu(k,426) * lu(k,1186) + lu(k,1220) = lu(k,1220) - lu(k,427) * lu(k,1186) + lu(k,1228) = lu(k,1228) - lu(k,423) * lu(k,1226) + lu(k,1235) = lu(k,1235) - lu(k,424) * lu(k,1226) + lu(k,1236) = lu(k,1236) - lu(k,425) * lu(k,1226) + lu(k,1241) = lu(k,1241) - lu(k,426) * lu(k,1226) + lu(k,1245) = lu(k,1245) - lu(k,427) * lu(k,1226) + lu(k,1292) = - lu(k,423) * lu(k,1290) + lu(k,1297) = lu(k,1297) - lu(k,424) * lu(k,1290) + lu(k,1298) = - lu(k,425) * lu(k,1290) + lu(k,1303) = lu(k,1303) - lu(k,426) * lu(k,1290) + lu(k,1307) = lu(k,1307) - lu(k,427) * lu(k,1290) + lu(k,429) = 1._r8 / lu(k,429) + lu(k,430) = lu(k,430) * lu(k,429) + lu(k,431) = lu(k,431) * lu(k,429) + lu(k,432) = lu(k,432) * lu(k,429) + lu(k,433) = lu(k,433) * lu(k,429) + lu(k,434) = lu(k,434) * lu(k,429) + lu(k,435) = lu(k,435) * lu(k,429) + lu(k,436) = lu(k,436) * lu(k,429) + lu(k,437) = lu(k,437) * lu(k,429) + lu(k,438) = lu(k,438) * lu(k,429) + lu(k,439) = lu(k,439) * lu(k,429) + lu(k,440) = lu(k,440) * lu(k,429) + lu(k,441) = lu(k,441) * lu(k,429) + lu(k,442) = lu(k,442) * lu(k,429) + lu(k,443) = lu(k,443) * lu(k,429) + lu(k,444) = lu(k,444) * lu(k,429) + lu(k,985) = - lu(k,430) * lu(k,983) + lu(k,989) = lu(k,989) - lu(k,431) * lu(k,983) + lu(k,991) = lu(k,991) - lu(k,432) * lu(k,983) + lu(k,993) = lu(k,993) - lu(k,433) * lu(k,983) + lu(k,997) = lu(k,997) - lu(k,434) * lu(k,983) + lu(k,1000) = lu(k,1000) - lu(k,435) * lu(k,983) + lu(k,1001) = lu(k,1001) - lu(k,436) * lu(k,983) + lu(k,1002) = lu(k,1002) - lu(k,437) * lu(k,983) + lu(k,1004) = lu(k,1004) - lu(k,438) * lu(k,983) + lu(k,1009) = lu(k,1009) - lu(k,439) * lu(k,983) + lu(k,1011) = lu(k,1011) - lu(k,440) * lu(k,983) + lu(k,1012) = lu(k,1012) - lu(k,441) * lu(k,983) + lu(k,1014) = lu(k,1014) - lu(k,442) * lu(k,983) + lu(k,1015) = lu(k,1015) - lu(k,443) * lu(k,983) + lu(k,1017) = lu(k,1017) - lu(k,444) * lu(k,983) + lu(k,1143) = lu(k,1143) - lu(k,430) * lu(k,1140) + lu(k,1147) = lu(k,1147) - lu(k,431) * lu(k,1140) + lu(k,1149) = lu(k,1149) - lu(k,432) * lu(k,1140) + lu(k,1151) = lu(k,1151) - lu(k,433) * lu(k,1140) + lu(k,1155) = lu(k,1155) - lu(k,434) * lu(k,1140) + lu(k,1158) = lu(k,1158) - lu(k,435) * lu(k,1140) + lu(k,1159) = lu(k,1159) - lu(k,436) * lu(k,1140) + lu(k,1160) = lu(k,1160) - lu(k,437) * lu(k,1140) + lu(k,1162) = lu(k,1162) - lu(k,438) * lu(k,1140) + lu(k,1167) = lu(k,1167) - lu(k,439) * lu(k,1140) + lu(k,1169) = lu(k,1169) - lu(k,440) * lu(k,1140) + lu(k,1170) = lu(k,1170) - lu(k,441) * lu(k,1140) + lu(k,1172) = lu(k,1172) - lu(k,442) * lu(k,1140) + lu(k,1173) = lu(k,1173) - lu(k,443) * lu(k,1140) + lu(k,1175) = lu(k,1175) - lu(k,444) * lu(k,1140) + lu(k,1189) = lu(k,1189) - lu(k,430) * lu(k,1187) + lu(k,1192) = lu(k,1192) - lu(k,431) * lu(k,1187) + lu(k,1193) = lu(k,1193) - lu(k,432) * lu(k,1187) + lu(k,1195) = lu(k,1195) - lu(k,433) * lu(k,1187) + lu(k,1199) = lu(k,1199) - lu(k,434) * lu(k,1187) + lu(k,1202) = lu(k,1202) - lu(k,435) * lu(k,1187) + lu(k,1203) = lu(k,1203) - lu(k,436) * lu(k,1187) + lu(k,1204) = lu(k,1204) - lu(k,437) * lu(k,1187) + lu(k,1206) = lu(k,1206) - lu(k,438) * lu(k,1187) + lu(k,1211) = lu(k,1211) - lu(k,439) * lu(k,1187) + lu(k,1213) = lu(k,1213) - lu(k,440) * lu(k,1187) + lu(k,1214) = lu(k,1214) - lu(k,441) * lu(k,1187) + lu(k,1216) = lu(k,1216) - lu(k,442) * lu(k,1187) + lu(k,1217) = lu(k,1217) - lu(k,443) * lu(k,1187) + lu(k,1219) = lu(k,1219) - lu(k,444) * lu(k,1187) + end do + end subroutine lu_fac10 + subroutine lu_fac11( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,448) = 1._r8 / lu(k,448) + lu(k,449) = lu(k,449) * lu(k,448) + lu(k,450) = lu(k,450) * lu(k,448) + lu(k,451) = lu(k,451) * lu(k,448) + lu(k,452) = lu(k,452) * lu(k,448) + lu(k,453) = lu(k,453) * lu(k,448) + lu(k,454) = lu(k,454) * lu(k,448) + lu(k,455) = lu(k,455) * lu(k,448) + lu(k,456) = lu(k,456) * lu(k,448) + lu(k,820) = lu(k,820) - lu(k,449) * lu(k,817) + lu(k,821) = lu(k,821) - lu(k,450) * lu(k,817) + lu(k,822) = lu(k,822) - lu(k,451) * lu(k,817) + lu(k,826) = lu(k,826) - lu(k,452) * lu(k,817) + lu(k,828) = lu(k,828) - lu(k,453) * lu(k,817) + lu(k,829) = lu(k,829) - lu(k,454) * lu(k,817) + lu(k,830) = lu(k,830) - lu(k,455) * lu(k,817) + lu(k,831) = lu(k,831) - lu(k,456) * lu(k,817) + lu(k,855) = lu(k,855) - lu(k,449) * lu(k,843) + lu(k,856) = lu(k,856) - lu(k,450) * lu(k,843) + lu(k,857) = lu(k,857) - lu(k,451) * lu(k,843) + lu(k,861) = lu(k,861) - lu(k,452) * lu(k,843) + lu(k,863) = lu(k,863) - lu(k,453) * lu(k,843) + lu(k,864) = lu(k,864) - lu(k,454) * lu(k,843) + lu(k,865) = lu(k,865) - lu(k,455) * lu(k,843) + lu(k,867) = lu(k,867) - lu(k,456) * lu(k,843) + lu(k,884) = lu(k,884) - lu(k,449) * lu(k,877) + lu(k,885) = lu(k,885) - lu(k,450) * lu(k,877) + lu(k,886) = lu(k,886) - lu(k,451) * lu(k,877) + lu(k,890) = lu(k,890) - lu(k,452) * lu(k,877) + lu(k,892) = lu(k,892) - lu(k,453) * lu(k,877) + lu(k,893) = lu(k,893) - lu(k,454) * lu(k,877) + lu(k,894) = lu(k,894) - lu(k,455) * lu(k,877) + lu(k,896) = lu(k,896) - lu(k,456) * lu(k,877) + lu(k,1042) = lu(k,1042) - lu(k,449) * lu(k,1030) + lu(k,1043) = lu(k,1043) - lu(k,450) * lu(k,1030) + lu(k,1044) = lu(k,1044) - lu(k,451) * lu(k,1030) + lu(k,1048) = lu(k,1048) - lu(k,452) * lu(k,1030) + lu(k,1050) = lu(k,1050) - lu(k,453) * lu(k,1030) + lu(k,1051) = lu(k,1051) - lu(k,454) * lu(k,1030) + lu(k,1052) = lu(k,1052) - lu(k,455) * lu(k,1030) + lu(k,1054) = lu(k,1054) - lu(k,456) * lu(k,1030) + lu(k,1164) = lu(k,1164) - lu(k,449) * lu(k,1141) + lu(k,1165) = lu(k,1165) - lu(k,450) * lu(k,1141) + lu(k,1166) = lu(k,1166) - lu(k,451) * lu(k,1141) + lu(k,1170) = lu(k,1170) - lu(k,452) * lu(k,1141) + lu(k,1172) = lu(k,1172) - lu(k,453) * lu(k,1141) + lu(k,1173) = lu(k,1173) - lu(k,454) * lu(k,1141) + lu(k,1174) = lu(k,1174) - lu(k,455) * lu(k,1141) + lu(k,1176) = lu(k,1176) - lu(k,456) * lu(k,1141) + lu(k,1233) = lu(k,1233) - lu(k,449) * lu(k,1227) + lu(k,1234) = lu(k,1234) - lu(k,450) * lu(k,1227) + lu(k,1235) = lu(k,1235) - lu(k,451) * lu(k,1227) + lu(k,1239) = lu(k,1239) - lu(k,452) * lu(k,1227) + lu(k,1241) = lu(k,1241) - lu(k,453) * lu(k,1227) + lu(k,1242) = - lu(k,454) * lu(k,1227) + lu(k,1243) = lu(k,1243) - lu(k,455) * lu(k,1227) + lu(k,1245) = lu(k,1245) - lu(k,456) * lu(k,1227) + lu(k,459) = 1._r8 / lu(k,459) + lu(k,460) = lu(k,460) * lu(k,459) + lu(k,461) = lu(k,461) * lu(k,459) + lu(k,462) = lu(k,462) * lu(k,459) + lu(k,463) = lu(k,463) * lu(k,459) + lu(k,464) = lu(k,464) * lu(k,459) + lu(k,577) = lu(k,577) - lu(k,460) * lu(k,575) + lu(k,582) = lu(k,582) - lu(k,461) * lu(k,575) + lu(k,583) = lu(k,583) - lu(k,462) * lu(k,575) + lu(k,584) = lu(k,584) - lu(k,463) * lu(k,575) + lu(k,586) = lu(k,586) - lu(k,464) * lu(k,575) + lu(k,622) = lu(k,622) - lu(k,460) * lu(k,619) + lu(k,632) = lu(k,632) - lu(k,461) * lu(k,619) + lu(k,633) = lu(k,633) - lu(k,462) * lu(k,619) + lu(k,634) = lu(k,634) - lu(k,463) * lu(k,619) + lu(k,637) = lu(k,637) - lu(k,464) * lu(k,619) + lu(k,646) = lu(k,646) - lu(k,460) * lu(k,643) + lu(k,653) = lu(k,653) - lu(k,461) * lu(k,643) + lu(k,654) = - lu(k,462) * lu(k,643) + lu(k,655) = lu(k,655) - lu(k,463) * lu(k,643) + lu(k,657) = lu(k,657) - lu(k,464) * lu(k,643) + lu(k,688) = lu(k,688) - lu(k,460) * lu(k,686) + lu(k,698) = lu(k,698) - lu(k,461) * lu(k,686) + lu(k,699) = lu(k,699) - lu(k,462) * lu(k,686) + lu(k,700) = lu(k,700) - lu(k,463) * lu(k,686) + lu(k,703) = lu(k,703) - lu(k,464) * lu(k,686) + lu(k,743) = lu(k,743) - lu(k,460) * lu(k,740) + lu(k,755) = lu(k,755) - lu(k,461) * lu(k,740) + lu(k,758) = lu(k,758) - lu(k,462) * lu(k,740) + lu(k,759) = lu(k,759) - lu(k,463) * lu(k,740) + lu(k,763) = lu(k,763) - lu(k,464) * lu(k,740) + lu(k,846) = lu(k,846) - lu(k,460) * lu(k,844) + lu(k,853) = lu(k,853) - lu(k,461) * lu(k,844) + lu(k,857) = lu(k,857) - lu(k,462) * lu(k,844) + lu(k,858) = lu(k,858) - lu(k,463) * lu(k,844) + lu(k,863) = lu(k,863) - lu(k,464) * lu(k,844) + lu(k,925) = lu(k,925) - lu(k,460) * lu(k,921) + lu(k,938) = lu(k,938) - lu(k,461) * lu(k,921) + lu(k,942) = lu(k,942) - lu(k,462) * lu(k,921) + lu(k,943) = lu(k,943) - lu(k,463) * lu(k,921) + lu(k,948) = lu(k,948) - lu(k,464) * lu(k,921) + lu(k,989) = lu(k,989) - lu(k,460) * lu(k,984) + lu(k,1004) = lu(k,1004) - lu(k,461) * lu(k,984) + lu(k,1008) = lu(k,1008) - lu(k,462) * lu(k,984) + lu(k,1009) = lu(k,1009) - lu(k,463) * lu(k,984) + lu(k,1014) = lu(k,1014) - lu(k,464) * lu(k,984) + lu(k,1147) = lu(k,1147) - lu(k,460) * lu(k,1142) + lu(k,1162) = lu(k,1162) - lu(k,461) * lu(k,1142) + lu(k,1166) = lu(k,1166) - lu(k,462) * lu(k,1142) + lu(k,1167) = lu(k,1167) - lu(k,463) * lu(k,1142) + lu(k,1172) = lu(k,1172) - lu(k,464) * lu(k,1142) + lu(k,1192) = lu(k,1192) - lu(k,460) * lu(k,1188) + lu(k,1206) = lu(k,1206) - lu(k,461) * lu(k,1188) + lu(k,1210) = lu(k,1210) - lu(k,462) * lu(k,1188) + lu(k,1211) = lu(k,1211) - lu(k,463) * lu(k,1188) + lu(k,1216) = lu(k,1216) - lu(k,464) * lu(k,1188) + lu(k,1261) = lu(k,1261) - lu(k,460) * lu(k,1257) + lu(k,1273) = lu(k,1273) - lu(k,461) * lu(k,1257) + lu(k,1277) = lu(k,1277) - lu(k,462) * lu(k,1257) + lu(k,1278) = lu(k,1278) - lu(k,463) * lu(k,1257) + lu(k,1283) = lu(k,1283) - lu(k,464) * lu(k,1257) + lu(k,467) = 1._r8 / lu(k,467) + lu(k,468) = lu(k,468) * lu(k,467) + lu(k,469) = lu(k,469) * lu(k,467) + lu(k,470) = lu(k,470) * lu(k,467) + lu(k,471) = lu(k,471) * lu(k,467) + lu(k,472) = lu(k,472) * lu(k,467) + lu(k,473) = lu(k,473) * lu(k,467) + lu(k,474) = lu(k,474) * lu(k,467) + lu(k,475) = lu(k,475) * lu(k,467) + lu(k,622) = lu(k,622) - lu(k,468) * lu(k,620) + lu(k,624) = lu(k,624) - lu(k,469) * lu(k,620) + lu(k,632) = lu(k,632) - lu(k,470) * lu(k,620) + lu(k,634) = lu(k,634) - lu(k,471) * lu(k,620) + lu(k,636) = lu(k,636) - lu(k,472) * lu(k,620) + lu(k,637) = lu(k,637) - lu(k,473) * lu(k,620) + lu(k,638) = lu(k,638) - lu(k,474) * lu(k,620) + lu(k,640) = - lu(k,475) * lu(k,620) + lu(k,646) = lu(k,646) - lu(k,468) * lu(k,644) + lu(k,647) = - lu(k,469) * lu(k,644) + lu(k,653) = lu(k,653) - lu(k,470) * lu(k,644) + lu(k,655) = lu(k,655) - lu(k,471) * lu(k,644) + lu(k,656) = lu(k,656) - lu(k,472) * lu(k,644) + lu(k,657) = lu(k,657) - lu(k,473) * lu(k,644) + lu(k,658) = lu(k,658) - lu(k,474) * lu(k,644) + lu(k,660) = - lu(k,475) * lu(k,644) + lu(k,925) = lu(k,925) - lu(k,468) * lu(k,922) + lu(k,929) = lu(k,929) - lu(k,469) * lu(k,922) + lu(k,938) = lu(k,938) - lu(k,470) * lu(k,922) + lu(k,943) = lu(k,943) - lu(k,471) * lu(k,922) + lu(k,946) = lu(k,946) - lu(k,472) * lu(k,922) + lu(k,948) = lu(k,948) - lu(k,473) * lu(k,922) + lu(k,949) = lu(k,949) - lu(k,474) * lu(k,922) + lu(k,952) = lu(k,952) - lu(k,475) * lu(k,922) + lu(k,989) = lu(k,989) - lu(k,468) * lu(k,985) + lu(k,994) = - lu(k,469) * lu(k,985) + lu(k,1004) = lu(k,1004) - lu(k,470) * lu(k,985) + lu(k,1009) = lu(k,1009) - lu(k,471) * lu(k,985) + lu(k,1012) = lu(k,1012) - lu(k,472) * lu(k,985) + lu(k,1014) = lu(k,1014) - lu(k,473) * lu(k,985) + lu(k,1015) = lu(k,1015) - lu(k,474) * lu(k,985) + lu(k,1018) = lu(k,1018) - lu(k,475) * lu(k,985) + lu(k,1147) = lu(k,1147) - lu(k,468) * lu(k,1143) + lu(k,1152) = lu(k,1152) - lu(k,469) * lu(k,1143) + lu(k,1162) = lu(k,1162) - lu(k,470) * lu(k,1143) + lu(k,1167) = lu(k,1167) - lu(k,471) * lu(k,1143) + lu(k,1170) = lu(k,1170) - lu(k,472) * lu(k,1143) + lu(k,1172) = lu(k,1172) - lu(k,473) * lu(k,1143) + lu(k,1173) = lu(k,1173) - lu(k,474) * lu(k,1143) + lu(k,1176) = lu(k,1176) - lu(k,475) * lu(k,1143) + lu(k,1192) = lu(k,1192) - lu(k,468) * lu(k,1189) + lu(k,1196) = lu(k,1196) - lu(k,469) * lu(k,1189) + lu(k,1206) = lu(k,1206) - lu(k,470) * lu(k,1189) + lu(k,1211) = lu(k,1211) - lu(k,471) * lu(k,1189) + lu(k,1214) = lu(k,1214) - lu(k,472) * lu(k,1189) + lu(k,1216) = lu(k,1216) - lu(k,473) * lu(k,1189) + lu(k,1217) = lu(k,1217) - lu(k,474) * lu(k,1189) + lu(k,1220) = lu(k,1220) - lu(k,475) * lu(k,1189) + lu(k,1261) = lu(k,1261) - lu(k,468) * lu(k,1258) + lu(k,1264) = lu(k,1264) - lu(k,469) * lu(k,1258) + lu(k,1273) = lu(k,1273) - lu(k,470) * lu(k,1258) + lu(k,1278) = lu(k,1278) - lu(k,471) * lu(k,1258) + lu(k,1281) = lu(k,1281) - lu(k,472) * lu(k,1258) + lu(k,1283) = lu(k,1283) - lu(k,473) * lu(k,1258) + lu(k,1284) = lu(k,1284) - lu(k,474) * lu(k,1258) + lu(k,1287) = lu(k,1287) - lu(k,475) * lu(k,1258) + lu(k,477) = 1._r8 / lu(k,477) + lu(k,478) = lu(k,478) * lu(k,477) + lu(k,479) = lu(k,479) * lu(k,477) + lu(k,480) = lu(k,480) * lu(k,477) + lu(k,481) = lu(k,481) * lu(k,477) + lu(k,482) = lu(k,482) * lu(k,477) + lu(k,483) = lu(k,483) * lu(k,477) + lu(k,484) = lu(k,484) * lu(k,477) + lu(k,485) = lu(k,485) * lu(k,477) + lu(k,486) = lu(k,486) * lu(k,477) + lu(k,487) = lu(k,487) * lu(k,477) + lu(k,488) = lu(k,488) * lu(k,477) + lu(k,489) = lu(k,489) * lu(k,477) + lu(k,528) = lu(k,528) - lu(k,478) * lu(k,526) + lu(k,529) = - lu(k,479) * lu(k,526) + lu(k,534) = lu(k,534) - lu(k,480) * lu(k,526) + lu(k,535) = - lu(k,481) * lu(k,526) + lu(k,536) = lu(k,536) - lu(k,482) * lu(k,526) + lu(k,537) = - lu(k,483) * lu(k,526) + lu(k,538) = - lu(k,484) * lu(k,526) + lu(k,539) = lu(k,539) - lu(k,485) * lu(k,526) + lu(k,540) = lu(k,540) - lu(k,486) * lu(k,526) + lu(k,543) = - lu(k,487) * lu(k,526) + lu(k,544) = lu(k,544) - lu(k,488) * lu(k,526) + lu(k,547) = lu(k,547) - lu(k,489) * lu(k,526) + lu(k,846) = lu(k,846) - lu(k,478) * lu(k,845) + lu(k,847) = lu(k,847) - lu(k,479) * lu(k,845) + lu(k,851) = lu(k,851) - lu(k,480) * lu(k,845) + lu(k,852) = lu(k,852) - lu(k,481) * lu(k,845) + lu(k,853) = lu(k,853) - lu(k,482) * lu(k,845) + lu(k,855) = lu(k,855) - lu(k,483) * lu(k,845) + lu(k,856) = lu(k,856) - lu(k,484) * lu(k,845) + lu(k,857) = lu(k,857) - lu(k,485) * lu(k,845) + lu(k,858) = lu(k,858) - lu(k,486) * lu(k,845) + lu(k,862) = lu(k,862) - lu(k,487) * lu(k,845) + lu(k,863) = lu(k,863) - lu(k,488) * lu(k,845) + lu(k,867) = lu(k,867) - lu(k,489) * lu(k,845) + lu(k,989) = lu(k,989) - lu(k,478) * lu(k,986) + lu(k,990) = - lu(k,479) * lu(k,986) + lu(k,1002) = lu(k,1002) - lu(k,480) * lu(k,986) + lu(k,1003) = lu(k,1003) - lu(k,481) * lu(k,986) + lu(k,1004) = lu(k,1004) - lu(k,482) * lu(k,986) + lu(k,1006) = - lu(k,483) * lu(k,986) + lu(k,1007) = lu(k,1007) - lu(k,484) * lu(k,986) + lu(k,1008) = lu(k,1008) - lu(k,485) * lu(k,986) + lu(k,1009) = lu(k,1009) - lu(k,486) * lu(k,986) + lu(k,1013) = lu(k,1013) - lu(k,487) * lu(k,986) + lu(k,1014) = lu(k,1014) - lu(k,488) * lu(k,986) + lu(k,1018) = lu(k,1018) - lu(k,489) * lu(k,986) + lu(k,1073) = - lu(k,478) * lu(k,1072) + lu(k,1074) = lu(k,1074) - lu(k,479) * lu(k,1072) + lu(k,1075) = lu(k,1075) - lu(k,480) * lu(k,1072) + lu(k,1076) = lu(k,1076) - lu(k,481) * lu(k,1072) + lu(k,1077) = lu(k,1077) - lu(k,482) * lu(k,1072) + lu(k,1079) = lu(k,1079) - lu(k,483) * lu(k,1072) + lu(k,1080) = lu(k,1080) - lu(k,484) * lu(k,1072) + lu(k,1081) = lu(k,1081) - lu(k,485) * lu(k,1072) + lu(k,1082) = lu(k,1082) - lu(k,486) * lu(k,1072) + lu(k,1086) = lu(k,1086) - lu(k,487) * lu(k,1072) + lu(k,1087) = lu(k,1087) - lu(k,488) * lu(k,1072) + lu(k,1091) = lu(k,1091) - lu(k,489) * lu(k,1072) + lu(k,1147) = lu(k,1147) - lu(k,478) * lu(k,1144) + lu(k,1148) = lu(k,1148) - lu(k,479) * lu(k,1144) + lu(k,1160) = lu(k,1160) - lu(k,480) * lu(k,1144) + lu(k,1161) = lu(k,1161) - lu(k,481) * lu(k,1144) + lu(k,1162) = lu(k,1162) - lu(k,482) * lu(k,1144) + lu(k,1164) = lu(k,1164) - lu(k,483) * lu(k,1144) + lu(k,1165) = lu(k,1165) - lu(k,484) * lu(k,1144) + lu(k,1166) = lu(k,1166) - lu(k,485) * lu(k,1144) + lu(k,1167) = lu(k,1167) - lu(k,486) * lu(k,1144) + lu(k,1171) = lu(k,1171) - lu(k,487) * lu(k,1144) + lu(k,1172) = lu(k,1172) - lu(k,488) * lu(k,1144) + lu(k,1176) = lu(k,1176) - lu(k,489) * lu(k,1144) + end do + end subroutine lu_fac11 + subroutine lu_fac12( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,492) = 1._r8 / lu(k,492) + lu(k,493) = lu(k,493) * lu(k,492) + lu(k,494) = lu(k,494) * lu(k,492) + lu(k,495) = lu(k,495) * lu(k,492) + lu(k,496) = lu(k,496) * lu(k,492) + lu(k,497) = lu(k,497) * lu(k,492) + lu(k,498) = lu(k,498) * lu(k,492) + lu(k,499) = lu(k,499) * lu(k,492) + lu(k,500) = lu(k,500) * lu(k,492) + lu(k,501) = lu(k,501) * lu(k,492) + lu(k,502) = lu(k,502) * lu(k,492) + lu(k,742) = lu(k,742) - lu(k,493) * lu(k,741) + lu(k,747) = lu(k,747) - lu(k,494) * lu(k,741) + lu(k,751) = lu(k,751) - lu(k,495) * lu(k,741) + lu(k,753) = lu(k,753) - lu(k,496) * lu(k,741) + lu(k,755) = lu(k,755) - lu(k,497) * lu(k,741) + lu(k,759) = lu(k,759) - lu(k,498) * lu(k,741) + lu(k,761) = lu(k,761) - lu(k,499) * lu(k,741) + lu(k,763) = lu(k,763) - lu(k,500) * lu(k,741) + lu(k,766) = lu(k,766) - lu(k,501) * lu(k,741) + lu(k,767) = lu(k,767) - lu(k,502) * lu(k,741) + lu(k,924) = lu(k,924) - lu(k,493) * lu(k,923) + lu(k,930) = - lu(k,494) * lu(k,923) + lu(k,934) = lu(k,934) - lu(k,495) * lu(k,923) + lu(k,936) = lu(k,936) - lu(k,496) * lu(k,923) + lu(k,938) = lu(k,938) - lu(k,497) * lu(k,923) + lu(k,943) = lu(k,943) - lu(k,498) * lu(k,923) + lu(k,946) = lu(k,946) - lu(k,499) * lu(k,923) + lu(k,948) = lu(k,948) - lu(k,500) * lu(k,923) + lu(k,951) = lu(k,951) - lu(k,501) * lu(k,923) + lu(k,952) = lu(k,952) - lu(k,502) * lu(k,923) + lu(k,988) = - lu(k,493) * lu(k,987) + lu(k,995) = lu(k,995) - lu(k,494) * lu(k,987) + lu(k,1000) = lu(k,1000) - lu(k,495) * lu(k,987) + lu(k,1002) = lu(k,1002) - lu(k,496) * lu(k,987) + lu(k,1004) = lu(k,1004) - lu(k,497) * lu(k,987) + lu(k,1009) = lu(k,1009) - lu(k,498) * lu(k,987) + lu(k,1012) = lu(k,1012) - lu(k,499) * lu(k,987) + lu(k,1014) = lu(k,1014) - lu(k,500) * lu(k,987) + lu(k,1017) = lu(k,1017) - lu(k,501) * lu(k,987) + lu(k,1018) = lu(k,1018) - lu(k,502) * lu(k,987) + lu(k,1146) = lu(k,1146) - lu(k,493) * lu(k,1145) + lu(k,1153) = lu(k,1153) - lu(k,494) * lu(k,1145) + lu(k,1158) = lu(k,1158) - lu(k,495) * lu(k,1145) + lu(k,1160) = lu(k,1160) - lu(k,496) * lu(k,1145) + lu(k,1162) = lu(k,1162) - lu(k,497) * lu(k,1145) + lu(k,1167) = lu(k,1167) - lu(k,498) * lu(k,1145) + lu(k,1170) = lu(k,1170) - lu(k,499) * lu(k,1145) + lu(k,1172) = lu(k,1172) - lu(k,500) * lu(k,1145) + lu(k,1175) = lu(k,1175) - lu(k,501) * lu(k,1145) + lu(k,1176) = lu(k,1176) - lu(k,502) * lu(k,1145) + lu(k,1191) = lu(k,1191) - lu(k,493) * lu(k,1190) + lu(k,1197) = lu(k,1197) - lu(k,494) * lu(k,1190) + lu(k,1202) = lu(k,1202) - lu(k,495) * lu(k,1190) + lu(k,1204) = lu(k,1204) - lu(k,496) * lu(k,1190) + lu(k,1206) = lu(k,1206) - lu(k,497) * lu(k,1190) + lu(k,1211) = lu(k,1211) - lu(k,498) * lu(k,1190) + lu(k,1214) = lu(k,1214) - lu(k,499) * lu(k,1190) + lu(k,1216) = lu(k,1216) - lu(k,500) * lu(k,1190) + lu(k,1219) = lu(k,1219) - lu(k,501) * lu(k,1190) + lu(k,1220) = lu(k,1220) - lu(k,502) * lu(k,1190) + lu(k,1260) = lu(k,1260) - lu(k,493) * lu(k,1259) + lu(k,1265) = lu(k,1265) - lu(k,494) * lu(k,1259) + lu(k,1269) = lu(k,1269) - lu(k,495) * lu(k,1259) + lu(k,1271) = lu(k,1271) - lu(k,496) * lu(k,1259) + lu(k,1273) = lu(k,1273) - lu(k,497) * lu(k,1259) + lu(k,1278) = lu(k,1278) - lu(k,498) * lu(k,1259) + lu(k,1281) = lu(k,1281) - lu(k,499) * lu(k,1259) + lu(k,1283) = lu(k,1283) - lu(k,500) * lu(k,1259) + lu(k,1286) = lu(k,1286) - lu(k,501) * lu(k,1259) + lu(k,1287) = lu(k,1287) - lu(k,502) * lu(k,1259) + lu(k,503) = 1._r8 / lu(k,503) + lu(k,504) = lu(k,504) * lu(k,503) + lu(k,505) = lu(k,505) * lu(k,503) + lu(k,506) = lu(k,506) * lu(k,503) + lu(k,507) = lu(k,507) * lu(k,503) + lu(k,508) = lu(k,508) * lu(k,503) + lu(k,532) = lu(k,532) - lu(k,504) * lu(k,527) + lu(k,533) = lu(k,533) - lu(k,505) * lu(k,527) + lu(k,536) = lu(k,536) - lu(k,506) * lu(k,527) + lu(k,540) = lu(k,540) - lu(k,507) * lu(k,527) + lu(k,544) = lu(k,544) - lu(k,508) * lu(k,527) + lu(k,579) = lu(k,579) - lu(k,504) * lu(k,576) + lu(k,580) = lu(k,580) - lu(k,505) * lu(k,576) + lu(k,582) = lu(k,582) - lu(k,506) * lu(k,576) + lu(k,584) = lu(k,584) - lu(k,507) * lu(k,576) + lu(k,586) = lu(k,586) - lu(k,508) * lu(k,576) + lu(k,625) = lu(k,625) - lu(k,504) * lu(k,621) + lu(k,629) = lu(k,629) - lu(k,505) * lu(k,621) + lu(k,632) = lu(k,632) - lu(k,506) * lu(k,621) + lu(k,634) = lu(k,634) - lu(k,507) * lu(k,621) + lu(k,637) = lu(k,637) - lu(k,508) * lu(k,621) + lu(k,648) = lu(k,648) - lu(k,504) * lu(k,645) + lu(k,651) = lu(k,651) - lu(k,505) * lu(k,645) + lu(k,653) = lu(k,653) - lu(k,506) * lu(k,645) + lu(k,655) = lu(k,655) - lu(k,507) * lu(k,645) + lu(k,657) = lu(k,657) - lu(k,508) * lu(k,645) + lu(k,667) = - lu(k,504) * lu(k,665) + lu(k,669) = lu(k,669) - lu(k,505) * lu(k,665) + lu(k,671) = lu(k,671) - lu(k,506) * lu(k,665) + lu(k,673) = lu(k,673) - lu(k,507) * lu(k,665) + lu(k,676) = lu(k,676) - lu(k,508) * lu(k,665) + lu(k,691) = lu(k,691) - lu(k,504) * lu(k,687) + lu(k,695) = lu(k,695) - lu(k,505) * lu(k,687) + lu(k,698) = lu(k,698) - lu(k,506) * lu(k,687) + lu(k,700) = lu(k,700) - lu(k,507) * lu(k,687) + lu(k,703) = lu(k,703) - lu(k,508) * lu(k,687) + lu(k,747) = lu(k,747) - lu(k,504) * lu(k,742) + lu(k,751) = lu(k,751) - lu(k,505) * lu(k,742) + lu(k,755) = lu(k,755) - lu(k,506) * lu(k,742) + lu(k,759) = lu(k,759) - lu(k,507) * lu(k,742) + lu(k,763) = lu(k,763) - lu(k,508) * lu(k,742) + lu(k,930) = lu(k,930) - lu(k,504) * lu(k,924) + lu(k,934) = lu(k,934) - lu(k,505) * lu(k,924) + lu(k,938) = lu(k,938) - lu(k,506) * lu(k,924) + lu(k,943) = lu(k,943) - lu(k,507) * lu(k,924) + lu(k,948) = lu(k,948) - lu(k,508) * lu(k,924) + lu(k,995) = lu(k,995) - lu(k,504) * lu(k,988) + lu(k,1000) = lu(k,1000) - lu(k,505) * lu(k,988) + lu(k,1004) = lu(k,1004) - lu(k,506) * lu(k,988) + lu(k,1009) = lu(k,1009) - lu(k,507) * lu(k,988) + lu(k,1014) = lu(k,1014) - lu(k,508) * lu(k,988) + lu(k,1033) = - lu(k,504) * lu(k,1031) + lu(k,1036) = lu(k,1036) - lu(k,505) * lu(k,1031) + lu(k,1040) = lu(k,1040) - lu(k,506) * lu(k,1031) + lu(k,1045) = lu(k,1045) - lu(k,507) * lu(k,1031) + lu(k,1050) = lu(k,1050) - lu(k,508) * lu(k,1031) + lu(k,1153) = lu(k,1153) - lu(k,504) * lu(k,1146) + lu(k,1158) = lu(k,1158) - lu(k,505) * lu(k,1146) + lu(k,1162) = lu(k,1162) - lu(k,506) * lu(k,1146) + lu(k,1167) = lu(k,1167) - lu(k,507) * lu(k,1146) + lu(k,1172) = lu(k,1172) - lu(k,508) * lu(k,1146) + lu(k,1197) = lu(k,1197) - lu(k,504) * lu(k,1191) + lu(k,1202) = lu(k,1202) - lu(k,505) * lu(k,1191) + lu(k,1206) = lu(k,1206) - lu(k,506) * lu(k,1191) + lu(k,1211) = lu(k,1211) - lu(k,507) * lu(k,1191) + lu(k,1216) = lu(k,1216) - lu(k,508) * lu(k,1191) + lu(k,1265) = lu(k,1265) - lu(k,504) * lu(k,1260) + lu(k,1269) = lu(k,1269) - lu(k,505) * lu(k,1260) + lu(k,1273) = lu(k,1273) - lu(k,506) * lu(k,1260) + lu(k,1278) = lu(k,1278) - lu(k,507) * lu(k,1260) + lu(k,1283) = lu(k,1283) - lu(k,508) * lu(k,1260) + lu(k,510) = 1._r8 / lu(k,510) + lu(k,511) = lu(k,511) * lu(k,510) + lu(k,512) = lu(k,512) * lu(k,510) + lu(k,513) = lu(k,513) * lu(k,510) + lu(k,539) = lu(k,539) - lu(k,511) * lu(k,528) + lu(k,540) = lu(k,540) - lu(k,512) * lu(k,528) + lu(k,544) = lu(k,544) - lu(k,513) * lu(k,528) + lu(k,553) = - lu(k,511) * lu(k,549) + lu(k,554) = lu(k,554) - lu(k,512) * lu(k,549) + lu(k,556) = lu(k,556) - lu(k,513) * lu(k,549) + lu(k,566) = - lu(k,511) * lu(k,559) + lu(k,567) = lu(k,567) - lu(k,512) * lu(k,559) + lu(k,569) = lu(k,569) - lu(k,513) * lu(k,559) + lu(k,583) = lu(k,583) - lu(k,511) * lu(k,577) + lu(k,584) = lu(k,584) - lu(k,512) * lu(k,577) + lu(k,586) = lu(k,586) - lu(k,513) * lu(k,577) + lu(k,593) = - lu(k,511) * lu(k,590) + lu(k,594) = lu(k,594) - lu(k,512) * lu(k,590) + lu(k,596) = lu(k,596) - lu(k,513) * lu(k,590) + lu(k,633) = lu(k,633) - lu(k,511) * lu(k,622) + lu(k,634) = lu(k,634) - lu(k,512) * lu(k,622) + lu(k,637) = lu(k,637) - lu(k,513) * lu(k,622) + lu(k,654) = lu(k,654) - lu(k,511) * lu(k,646) + lu(k,655) = lu(k,655) - lu(k,512) * lu(k,646) + lu(k,657) = lu(k,657) - lu(k,513) * lu(k,646) + lu(k,672) = lu(k,672) - lu(k,511) * lu(k,666) + lu(k,673) = lu(k,673) - lu(k,512) * lu(k,666) + lu(k,676) = lu(k,676) - lu(k,513) * lu(k,666) + lu(k,699) = lu(k,699) - lu(k,511) * lu(k,688) + lu(k,700) = lu(k,700) - lu(k,512) * lu(k,688) + lu(k,703) = lu(k,703) - lu(k,513) * lu(k,688) + lu(k,721) = lu(k,721) - lu(k,511) * lu(k,708) + lu(k,722) = lu(k,722) - lu(k,512) * lu(k,708) + lu(k,726) = lu(k,726) - lu(k,513) * lu(k,708) + lu(k,758) = lu(k,758) - lu(k,511) * lu(k,743) + lu(k,759) = lu(k,759) - lu(k,512) * lu(k,743) + lu(k,763) = lu(k,763) - lu(k,513) * lu(k,743) + lu(k,787) = lu(k,787) - lu(k,511) * lu(k,780) + lu(k,788) = lu(k,788) - lu(k,512) * lu(k,780) + lu(k,793) = lu(k,793) - lu(k,513) * lu(k,780) + lu(k,803) = lu(k,803) - lu(k,511) * lu(k,797) + lu(k,804) = lu(k,804) - lu(k,512) * lu(k,797) + lu(k,809) = lu(k,809) - lu(k,513) * lu(k,797) + lu(k,857) = lu(k,857) - lu(k,511) * lu(k,846) + lu(k,858) = lu(k,858) - lu(k,512) * lu(k,846) + lu(k,863) = lu(k,863) - lu(k,513) * lu(k,846) + lu(k,886) = lu(k,886) - lu(k,511) * lu(k,878) + lu(k,887) = lu(k,887) - lu(k,512) * lu(k,878) + lu(k,892) = lu(k,892) - lu(k,513) * lu(k,878) + lu(k,942) = lu(k,942) - lu(k,511) * lu(k,925) + lu(k,943) = lu(k,943) - lu(k,512) * lu(k,925) + lu(k,948) = lu(k,948) - lu(k,513) * lu(k,925) + lu(k,1008) = lu(k,1008) - lu(k,511) * lu(k,989) + lu(k,1009) = lu(k,1009) - lu(k,512) * lu(k,989) + lu(k,1014) = lu(k,1014) - lu(k,513) * lu(k,989) + lu(k,1044) = lu(k,1044) - lu(k,511) * lu(k,1032) + lu(k,1045) = lu(k,1045) - lu(k,512) * lu(k,1032) + lu(k,1050) = lu(k,1050) - lu(k,513) * lu(k,1032) + lu(k,1081) = lu(k,1081) - lu(k,511) * lu(k,1073) + lu(k,1082) = lu(k,1082) - lu(k,512) * lu(k,1073) + lu(k,1087) = lu(k,1087) - lu(k,513) * lu(k,1073) + lu(k,1166) = lu(k,1166) - lu(k,511) * lu(k,1147) + lu(k,1167) = lu(k,1167) - lu(k,512) * lu(k,1147) + lu(k,1172) = lu(k,1172) - lu(k,513) * lu(k,1147) + lu(k,1210) = lu(k,1210) - lu(k,511) * lu(k,1192) + lu(k,1211) = lu(k,1211) - lu(k,512) * lu(k,1192) + lu(k,1216) = lu(k,1216) - lu(k,513) * lu(k,1192) + lu(k,1277) = lu(k,1277) - lu(k,511) * lu(k,1261) + lu(k,1278) = lu(k,1278) - lu(k,512) * lu(k,1261) + lu(k,1283) = lu(k,1283) - lu(k,513) * lu(k,1261) + lu(k,514) = 1._r8 / lu(k,514) + lu(k,515) = lu(k,515) * lu(k,514) + lu(k,516) = lu(k,516) * lu(k,514) + lu(k,517) = lu(k,517) * lu(k,514) + lu(k,518) = lu(k,518) * lu(k,514) + lu(k,519) = lu(k,519) * lu(k,514) + lu(k,520) = lu(k,520) * lu(k,514) + lu(k,521) = lu(k,521) * lu(k,514) + lu(k,535) = lu(k,535) - lu(k,515) * lu(k,529) + lu(k,537) = lu(k,537) - lu(k,516) * lu(k,529) + lu(k,538) = lu(k,538) - lu(k,517) * lu(k,529) + lu(k,539) = lu(k,539) - lu(k,518) * lu(k,529) + lu(k,543) = lu(k,543) - lu(k,519) * lu(k,529) + lu(k,544) = lu(k,544) - lu(k,520) * lu(k,529) + lu(k,547) = lu(k,547) - lu(k,521) * lu(k,529) + lu(k,769) = lu(k,769) - lu(k,515) * lu(k,768) + lu(k,770) = - lu(k,516) * lu(k,768) + lu(k,771) = - lu(k,517) * lu(k,768) + lu(k,772) = lu(k,772) - lu(k,518) * lu(k,768) + lu(k,775) = - lu(k,519) * lu(k,768) + lu(k,776) = lu(k,776) - lu(k,520) * lu(k,768) + lu(k,777) = lu(k,777) - lu(k,521) * lu(k,768) + lu(k,782) = lu(k,782) - lu(k,515) * lu(k,781) + lu(k,785) = lu(k,785) - lu(k,516) * lu(k,781) + lu(k,786) = lu(k,786) - lu(k,517) * lu(k,781) + lu(k,787) = lu(k,787) - lu(k,518) * lu(k,781) + lu(k,792) = lu(k,792) - lu(k,519) * lu(k,781) + lu(k,793) = lu(k,793) - lu(k,520) * lu(k,781) + lu(k,795) = lu(k,795) - lu(k,521) * lu(k,781) + lu(k,852) = lu(k,852) - lu(k,515) * lu(k,847) + lu(k,855) = lu(k,855) - lu(k,516) * lu(k,847) + lu(k,856) = lu(k,856) - lu(k,517) * lu(k,847) + lu(k,857) = lu(k,857) - lu(k,518) * lu(k,847) + lu(k,862) = lu(k,862) - lu(k,519) * lu(k,847) + lu(k,863) = lu(k,863) - lu(k,520) * lu(k,847) + lu(k,867) = lu(k,867) - lu(k,521) * lu(k,847) + lu(k,881) = lu(k,881) - lu(k,515) * lu(k,879) + lu(k,884) = lu(k,884) - lu(k,516) * lu(k,879) + lu(k,885) = lu(k,885) - lu(k,517) * lu(k,879) + lu(k,886) = lu(k,886) - lu(k,518) * lu(k,879) + lu(k,891) = lu(k,891) - lu(k,519) * lu(k,879) + lu(k,892) = lu(k,892) - lu(k,520) * lu(k,879) + lu(k,896) = lu(k,896) - lu(k,521) * lu(k,879) + lu(k,937) = lu(k,937) - lu(k,515) * lu(k,926) + lu(k,940) = lu(k,940) - lu(k,516) * lu(k,926) + lu(k,941) = lu(k,941) - lu(k,517) * lu(k,926) + lu(k,942) = lu(k,942) - lu(k,518) * lu(k,926) + lu(k,947) = lu(k,947) - lu(k,519) * lu(k,926) + lu(k,948) = lu(k,948) - lu(k,520) * lu(k,926) + lu(k,952) = lu(k,952) - lu(k,521) * lu(k,926) + lu(k,1003) = lu(k,1003) - lu(k,515) * lu(k,990) + lu(k,1006) = lu(k,1006) - lu(k,516) * lu(k,990) + lu(k,1007) = lu(k,1007) - lu(k,517) * lu(k,990) + lu(k,1008) = lu(k,1008) - lu(k,518) * lu(k,990) + lu(k,1013) = lu(k,1013) - lu(k,519) * lu(k,990) + lu(k,1014) = lu(k,1014) - lu(k,520) * lu(k,990) + lu(k,1018) = lu(k,1018) - lu(k,521) * lu(k,990) + lu(k,1076) = lu(k,1076) - lu(k,515) * lu(k,1074) + lu(k,1079) = lu(k,1079) - lu(k,516) * lu(k,1074) + lu(k,1080) = lu(k,1080) - lu(k,517) * lu(k,1074) + lu(k,1081) = lu(k,1081) - lu(k,518) * lu(k,1074) + lu(k,1086) = lu(k,1086) - lu(k,519) * lu(k,1074) + lu(k,1087) = lu(k,1087) - lu(k,520) * lu(k,1074) + lu(k,1091) = lu(k,1091) - lu(k,521) * lu(k,1074) + lu(k,1161) = lu(k,1161) - lu(k,515) * lu(k,1148) + lu(k,1164) = lu(k,1164) - lu(k,516) * lu(k,1148) + lu(k,1165) = lu(k,1165) - lu(k,517) * lu(k,1148) + lu(k,1166) = lu(k,1166) - lu(k,518) * lu(k,1148) + lu(k,1171) = lu(k,1171) - lu(k,519) * lu(k,1148) + lu(k,1172) = lu(k,1172) - lu(k,520) * lu(k,1148) + lu(k,1176) = lu(k,1176) - lu(k,521) * lu(k,1148) + lu(k,1293) = lu(k,1293) - lu(k,515) * lu(k,1291) + lu(k,1295) = - lu(k,516) * lu(k,1291) + lu(k,1296) = - lu(k,517) * lu(k,1291) + lu(k,1297) = lu(k,1297) - lu(k,518) * lu(k,1291) + lu(k,1302) = lu(k,1302) - lu(k,519) * lu(k,1291) + lu(k,1303) = lu(k,1303) - lu(k,520) * lu(k,1291) + lu(k,1307) = lu(k,1307) - lu(k,521) * lu(k,1291) + lu(k,530) = 1._r8 / lu(k,530) + lu(k,531) = lu(k,531) * lu(k,530) + lu(k,532) = lu(k,532) * lu(k,530) + lu(k,533) = lu(k,533) * lu(k,530) + lu(k,534) = lu(k,534) * lu(k,530) + lu(k,535) = lu(k,535) * lu(k,530) + lu(k,536) = lu(k,536) * lu(k,530) + lu(k,537) = lu(k,537) * lu(k,530) + lu(k,538) = lu(k,538) * lu(k,530) + lu(k,539) = lu(k,539) * lu(k,530) + lu(k,540) = lu(k,540) * lu(k,530) + lu(k,541) = lu(k,541) * lu(k,530) + lu(k,542) = lu(k,542) * lu(k,530) + lu(k,543) = lu(k,543) * lu(k,530) + lu(k,544) = lu(k,544) * lu(k,530) + lu(k,545) = lu(k,545) * lu(k,530) + lu(k,546) = lu(k,546) * lu(k,530) + lu(k,547) = lu(k,547) * lu(k,530) + lu(k,710) = lu(k,710) - lu(k,531) * lu(k,709) + lu(k,711) = lu(k,711) - lu(k,532) * lu(k,709) + lu(k,714) = lu(k,714) - lu(k,533) * lu(k,709) + lu(k,716) = lu(k,716) - lu(k,534) * lu(k,709) + lu(k,717) = - lu(k,535) * lu(k,709) + lu(k,718) = lu(k,718) - lu(k,536) * lu(k,709) + lu(k,719) = - lu(k,537) * lu(k,709) + lu(k,720) = - lu(k,538) * lu(k,709) + lu(k,721) = lu(k,721) - lu(k,539) * lu(k,709) + lu(k,722) = lu(k,722) - lu(k,540) * lu(k,709) + lu(k,723) = lu(k,723) - lu(k,541) * lu(k,709) + lu(k,724) = - lu(k,542) * lu(k,709) + lu(k,725) = - lu(k,543) * lu(k,709) + lu(k,726) = lu(k,726) - lu(k,544) * lu(k,709) + lu(k,727) = - lu(k,545) * lu(k,709) + lu(k,728) = - lu(k,546) * lu(k,709) + lu(k,729) = - lu(k,547) * lu(k,709) + lu(k,992) = lu(k,992) - lu(k,531) * lu(k,991) + lu(k,995) = lu(k,995) - lu(k,532) * lu(k,991) + lu(k,1000) = lu(k,1000) - lu(k,533) * lu(k,991) + lu(k,1002) = lu(k,1002) - lu(k,534) * lu(k,991) + lu(k,1003) = lu(k,1003) - lu(k,535) * lu(k,991) + lu(k,1004) = lu(k,1004) - lu(k,536) * lu(k,991) + lu(k,1006) = lu(k,1006) - lu(k,537) * lu(k,991) + lu(k,1007) = lu(k,1007) - lu(k,538) * lu(k,991) + lu(k,1008) = lu(k,1008) - lu(k,539) * lu(k,991) + lu(k,1009) = lu(k,1009) - lu(k,540) * lu(k,991) + lu(k,1011) = lu(k,1011) - lu(k,541) * lu(k,991) + lu(k,1012) = lu(k,1012) - lu(k,542) * lu(k,991) + lu(k,1013) = lu(k,1013) - lu(k,543) * lu(k,991) + lu(k,1014) = lu(k,1014) - lu(k,544) * lu(k,991) + lu(k,1015) = lu(k,1015) - lu(k,545) * lu(k,991) + lu(k,1017) = lu(k,1017) - lu(k,546) * lu(k,991) + lu(k,1018) = lu(k,1018) - lu(k,547) * lu(k,991) + lu(k,1150) = lu(k,1150) - lu(k,531) * lu(k,1149) + lu(k,1153) = lu(k,1153) - lu(k,532) * lu(k,1149) + lu(k,1158) = lu(k,1158) - lu(k,533) * lu(k,1149) + lu(k,1160) = lu(k,1160) - lu(k,534) * lu(k,1149) + lu(k,1161) = lu(k,1161) - lu(k,535) * lu(k,1149) + lu(k,1162) = lu(k,1162) - lu(k,536) * lu(k,1149) + lu(k,1164) = lu(k,1164) - lu(k,537) * lu(k,1149) + lu(k,1165) = lu(k,1165) - lu(k,538) * lu(k,1149) + lu(k,1166) = lu(k,1166) - lu(k,539) * lu(k,1149) + lu(k,1167) = lu(k,1167) - lu(k,540) * lu(k,1149) + lu(k,1169) = lu(k,1169) - lu(k,541) * lu(k,1149) + lu(k,1170) = lu(k,1170) - lu(k,542) * lu(k,1149) + lu(k,1171) = lu(k,1171) - lu(k,543) * lu(k,1149) + lu(k,1172) = lu(k,1172) - lu(k,544) * lu(k,1149) + lu(k,1173) = lu(k,1173) - lu(k,545) * lu(k,1149) + lu(k,1175) = lu(k,1175) - lu(k,546) * lu(k,1149) + lu(k,1176) = lu(k,1176) - lu(k,547) * lu(k,1149) + lu(k,1194) = lu(k,1194) - lu(k,531) * lu(k,1193) + lu(k,1197) = lu(k,1197) - lu(k,532) * lu(k,1193) + lu(k,1202) = lu(k,1202) - lu(k,533) * lu(k,1193) + lu(k,1204) = lu(k,1204) - lu(k,534) * lu(k,1193) + lu(k,1205) = - lu(k,535) * lu(k,1193) + lu(k,1206) = lu(k,1206) - lu(k,536) * lu(k,1193) + lu(k,1208) = - lu(k,537) * lu(k,1193) + lu(k,1209) = - lu(k,538) * lu(k,1193) + lu(k,1210) = lu(k,1210) - lu(k,539) * lu(k,1193) + lu(k,1211) = lu(k,1211) - lu(k,540) * lu(k,1193) + lu(k,1213) = lu(k,1213) - lu(k,541) * lu(k,1193) + lu(k,1214) = lu(k,1214) - lu(k,542) * lu(k,1193) + lu(k,1215) = - lu(k,543) * lu(k,1193) + lu(k,1216) = lu(k,1216) - lu(k,544) * lu(k,1193) + lu(k,1217) = lu(k,1217) - lu(k,545) * lu(k,1193) + lu(k,1219) = lu(k,1219) - lu(k,546) * lu(k,1193) + lu(k,1220) = lu(k,1220) - lu(k,547) * lu(k,1193) + end do + end subroutine lu_fac12 + subroutine lu_fac13( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,550) = 1._r8 / lu(k,550) + lu(k,551) = lu(k,551) * lu(k,550) + lu(k,552) = lu(k,552) * lu(k,550) + lu(k,553) = lu(k,553) * lu(k,550) + lu(k,554) = lu(k,554) * lu(k,550) + lu(k,555) = lu(k,555) * lu(k,550) + lu(k,556) = lu(k,556) * lu(k,550) + lu(k,557) = lu(k,557) * lu(k,550) + lu(k,558) = lu(k,558) * lu(k,550) + lu(k,714) = lu(k,714) - lu(k,551) * lu(k,710) + lu(k,716) = lu(k,716) - lu(k,552) * lu(k,710) + lu(k,721) = lu(k,721) - lu(k,553) * lu(k,710) + lu(k,722) = lu(k,722) - lu(k,554) * lu(k,710) + lu(k,724) = lu(k,724) - lu(k,555) * lu(k,710) + lu(k,726) = lu(k,726) - lu(k,556) * lu(k,710) + lu(k,727) = lu(k,727) - lu(k,557) * lu(k,710) + lu(k,729) = lu(k,729) - lu(k,558) * lu(k,710) + lu(k,751) = lu(k,751) - lu(k,551) * lu(k,744) + lu(k,753) = lu(k,753) - lu(k,552) * lu(k,744) + lu(k,758) = lu(k,758) - lu(k,553) * lu(k,744) + lu(k,759) = lu(k,759) - lu(k,554) * lu(k,744) + lu(k,761) = lu(k,761) - lu(k,555) * lu(k,744) + lu(k,763) = lu(k,763) - lu(k,556) * lu(k,744) + lu(k,764) = - lu(k,557) * lu(k,744) + lu(k,767) = lu(k,767) - lu(k,558) * lu(k,744) + lu(k,849) = - lu(k,551) * lu(k,848) + lu(k,851) = lu(k,851) - lu(k,552) * lu(k,848) + lu(k,857) = lu(k,857) - lu(k,553) * lu(k,848) + lu(k,858) = lu(k,858) - lu(k,554) * lu(k,848) + lu(k,861) = lu(k,861) - lu(k,555) * lu(k,848) + lu(k,863) = lu(k,863) - lu(k,556) * lu(k,848) + lu(k,864) = lu(k,864) - lu(k,557) * lu(k,848) + lu(k,867) = lu(k,867) - lu(k,558) * lu(k,848) + lu(k,934) = lu(k,934) - lu(k,551) * lu(k,927) + lu(k,936) = lu(k,936) - lu(k,552) * lu(k,927) + lu(k,942) = lu(k,942) - lu(k,553) * lu(k,927) + lu(k,943) = lu(k,943) - lu(k,554) * lu(k,927) + lu(k,946) = lu(k,946) - lu(k,555) * lu(k,927) + lu(k,948) = lu(k,948) - lu(k,556) * lu(k,927) + lu(k,949) = lu(k,949) - lu(k,557) * lu(k,927) + lu(k,952) = lu(k,952) - lu(k,558) * lu(k,927) + lu(k,1000) = lu(k,1000) - lu(k,551) * lu(k,992) + lu(k,1002) = lu(k,1002) - lu(k,552) * lu(k,992) + lu(k,1008) = lu(k,1008) - lu(k,553) * lu(k,992) + lu(k,1009) = lu(k,1009) - lu(k,554) * lu(k,992) + lu(k,1012) = lu(k,1012) - lu(k,555) * lu(k,992) + lu(k,1014) = lu(k,1014) - lu(k,556) * lu(k,992) + lu(k,1015) = lu(k,1015) - lu(k,557) * lu(k,992) + lu(k,1018) = lu(k,1018) - lu(k,558) * lu(k,992) + lu(k,1158) = lu(k,1158) - lu(k,551) * lu(k,1150) + lu(k,1160) = lu(k,1160) - lu(k,552) * lu(k,1150) + lu(k,1166) = lu(k,1166) - lu(k,553) * lu(k,1150) + lu(k,1167) = lu(k,1167) - lu(k,554) * lu(k,1150) + lu(k,1170) = lu(k,1170) - lu(k,555) * lu(k,1150) + lu(k,1172) = lu(k,1172) - lu(k,556) * lu(k,1150) + lu(k,1173) = lu(k,1173) - lu(k,557) * lu(k,1150) + lu(k,1176) = lu(k,1176) - lu(k,558) * lu(k,1150) + lu(k,1202) = lu(k,1202) - lu(k,551) * lu(k,1194) + lu(k,1204) = lu(k,1204) - lu(k,552) * lu(k,1194) + lu(k,1210) = lu(k,1210) - lu(k,553) * lu(k,1194) + lu(k,1211) = lu(k,1211) - lu(k,554) * lu(k,1194) + lu(k,1214) = lu(k,1214) - lu(k,555) * lu(k,1194) + lu(k,1216) = lu(k,1216) - lu(k,556) * lu(k,1194) + lu(k,1217) = lu(k,1217) - lu(k,557) * lu(k,1194) + lu(k,1220) = lu(k,1220) - lu(k,558) * lu(k,1194) + lu(k,1269) = lu(k,1269) - lu(k,551) * lu(k,1262) + lu(k,1271) = lu(k,1271) - lu(k,552) * lu(k,1262) + lu(k,1277) = lu(k,1277) - lu(k,553) * lu(k,1262) + lu(k,1278) = lu(k,1278) - lu(k,554) * lu(k,1262) + lu(k,1281) = lu(k,1281) - lu(k,555) * lu(k,1262) + lu(k,1283) = lu(k,1283) - lu(k,556) * lu(k,1262) + lu(k,1284) = lu(k,1284) - lu(k,557) * lu(k,1262) + lu(k,1287) = lu(k,1287) - lu(k,558) * lu(k,1262) + lu(k,560) = 1._r8 / lu(k,560) + lu(k,561) = lu(k,561) * lu(k,560) + lu(k,562) = lu(k,562) * lu(k,560) + lu(k,563) = lu(k,563) * lu(k,560) + lu(k,564) = lu(k,564) * lu(k,560) + lu(k,565) = lu(k,565) * lu(k,560) + lu(k,566) = lu(k,566) * lu(k,560) + lu(k,567) = lu(k,567) * lu(k,560) + lu(k,568) = lu(k,568) * lu(k,560) + lu(k,569) = lu(k,569) * lu(k,560) + lu(k,570) = lu(k,570) * lu(k,560) + lu(k,625) = lu(k,625) - lu(k,561) * lu(k,623) + lu(k,627) = - lu(k,562) * lu(k,623) + lu(k,628) = - lu(k,563) * lu(k,623) + lu(k,629) = lu(k,629) - lu(k,564) * lu(k,623) + lu(k,632) = lu(k,632) - lu(k,565) * lu(k,623) + lu(k,633) = lu(k,633) - lu(k,566) * lu(k,623) + lu(k,634) = lu(k,634) - lu(k,567) * lu(k,623) + lu(k,635) = - lu(k,568) * lu(k,623) + lu(k,637) = lu(k,637) - lu(k,569) * lu(k,623) + lu(k,640) = lu(k,640) - lu(k,570) * lu(k,623) + lu(k,691) = lu(k,691) - lu(k,561) * lu(k,689) + lu(k,693) = lu(k,693) - lu(k,562) * lu(k,689) + lu(k,694) = lu(k,694) - lu(k,563) * lu(k,689) + lu(k,695) = lu(k,695) - lu(k,564) * lu(k,689) + lu(k,698) = lu(k,698) - lu(k,565) * lu(k,689) + lu(k,699) = lu(k,699) - lu(k,566) * lu(k,689) + lu(k,700) = lu(k,700) - lu(k,567) * lu(k,689) + lu(k,701) = lu(k,701) - lu(k,568) * lu(k,689) + lu(k,703) = lu(k,703) - lu(k,569) * lu(k,689) + lu(k,706) = lu(k,706) - lu(k,570) * lu(k,689) + lu(k,747) = lu(k,747) - lu(k,561) * lu(k,745) + lu(k,749) = lu(k,749) - lu(k,562) * lu(k,745) + lu(k,750) = lu(k,750) - lu(k,563) * lu(k,745) + lu(k,751) = lu(k,751) - lu(k,564) * lu(k,745) + lu(k,755) = lu(k,755) - lu(k,565) * lu(k,745) + lu(k,758) = lu(k,758) - lu(k,566) * lu(k,745) + lu(k,759) = lu(k,759) - lu(k,567) * lu(k,745) + lu(k,760) = - lu(k,568) * lu(k,745) + lu(k,763) = lu(k,763) - lu(k,569) * lu(k,745) + lu(k,767) = lu(k,767) - lu(k,570) * lu(k,745) + lu(k,930) = lu(k,930) - lu(k,561) * lu(k,928) + lu(k,932) = lu(k,932) - lu(k,562) * lu(k,928) + lu(k,933) = lu(k,933) - lu(k,563) * lu(k,928) + lu(k,934) = lu(k,934) - lu(k,564) * lu(k,928) + lu(k,938) = lu(k,938) - lu(k,565) * lu(k,928) + lu(k,942) = lu(k,942) - lu(k,566) * lu(k,928) + lu(k,943) = lu(k,943) - lu(k,567) * lu(k,928) + lu(k,945) = lu(k,945) - lu(k,568) * lu(k,928) + lu(k,948) = lu(k,948) - lu(k,569) * lu(k,928) + lu(k,952) = lu(k,952) - lu(k,570) * lu(k,928) + lu(k,995) = lu(k,995) - lu(k,561) * lu(k,993) + lu(k,998) = - lu(k,562) * lu(k,993) + lu(k,999) = - lu(k,563) * lu(k,993) + lu(k,1000) = lu(k,1000) - lu(k,564) * lu(k,993) + lu(k,1004) = lu(k,1004) - lu(k,565) * lu(k,993) + lu(k,1008) = lu(k,1008) - lu(k,566) * lu(k,993) + lu(k,1009) = lu(k,1009) - lu(k,567) * lu(k,993) + lu(k,1011) = lu(k,1011) - lu(k,568) * lu(k,993) + lu(k,1014) = lu(k,1014) - lu(k,569) * lu(k,993) + lu(k,1018) = lu(k,1018) - lu(k,570) * lu(k,993) + lu(k,1153) = lu(k,1153) - lu(k,561) * lu(k,1151) + lu(k,1156) = lu(k,1156) - lu(k,562) * lu(k,1151) + lu(k,1157) = lu(k,1157) - lu(k,563) * lu(k,1151) + lu(k,1158) = lu(k,1158) - lu(k,564) * lu(k,1151) + lu(k,1162) = lu(k,1162) - lu(k,565) * lu(k,1151) + lu(k,1166) = lu(k,1166) - lu(k,566) * lu(k,1151) + lu(k,1167) = lu(k,1167) - lu(k,567) * lu(k,1151) + lu(k,1169) = lu(k,1169) - lu(k,568) * lu(k,1151) + lu(k,1172) = lu(k,1172) - lu(k,569) * lu(k,1151) + lu(k,1176) = lu(k,1176) - lu(k,570) * lu(k,1151) + lu(k,1197) = lu(k,1197) - lu(k,561) * lu(k,1195) + lu(k,1200) = lu(k,1200) - lu(k,562) * lu(k,1195) + lu(k,1201) = lu(k,1201) - lu(k,563) * lu(k,1195) + lu(k,1202) = lu(k,1202) - lu(k,564) * lu(k,1195) + lu(k,1206) = lu(k,1206) - lu(k,565) * lu(k,1195) + lu(k,1210) = lu(k,1210) - lu(k,566) * lu(k,1195) + lu(k,1211) = lu(k,1211) - lu(k,567) * lu(k,1195) + lu(k,1213) = lu(k,1213) - lu(k,568) * lu(k,1195) + lu(k,1216) = lu(k,1216) - lu(k,569) * lu(k,1195) + lu(k,1220) = lu(k,1220) - lu(k,570) * lu(k,1195) + lu(k,1265) = lu(k,1265) - lu(k,561) * lu(k,1263) + lu(k,1267) = lu(k,1267) - lu(k,562) * lu(k,1263) + lu(k,1268) = lu(k,1268) - lu(k,563) * lu(k,1263) + lu(k,1269) = lu(k,1269) - lu(k,564) * lu(k,1263) + lu(k,1273) = lu(k,1273) - lu(k,565) * lu(k,1263) + lu(k,1277) = lu(k,1277) - lu(k,566) * lu(k,1263) + lu(k,1278) = lu(k,1278) - lu(k,567) * lu(k,1263) + lu(k,1280) = lu(k,1280) - lu(k,568) * lu(k,1263) + lu(k,1283) = lu(k,1283) - lu(k,569) * lu(k,1263) + lu(k,1287) = lu(k,1287) - lu(k,570) * lu(k,1263) + lu(k,578) = 1._r8 / lu(k,578) + lu(k,579) = lu(k,579) * lu(k,578) + lu(k,580) = lu(k,580) * lu(k,578) + lu(k,581) = lu(k,581) * lu(k,578) + lu(k,582) = lu(k,582) * lu(k,578) + lu(k,583) = lu(k,583) * lu(k,578) + lu(k,584) = lu(k,584) * lu(k,578) + lu(k,585) = lu(k,585) * lu(k,578) + lu(k,586) = lu(k,586) * lu(k,578) + lu(k,587) = lu(k,587) * lu(k,578) + lu(k,588) = lu(k,588) * lu(k,578) + lu(k,625) = lu(k,625) - lu(k,579) * lu(k,624) + lu(k,629) = lu(k,629) - lu(k,580) * lu(k,624) + lu(k,631) = lu(k,631) - lu(k,581) * lu(k,624) + lu(k,632) = lu(k,632) - lu(k,582) * lu(k,624) + lu(k,633) = lu(k,633) - lu(k,583) * lu(k,624) + lu(k,634) = lu(k,634) - lu(k,584) * lu(k,624) + lu(k,636) = lu(k,636) - lu(k,585) * lu(k,624) + lu(k,637) = lu(k,637) - lu(k,586) * lu(k,624) + lu(k,638) = lu(k,638) - lu(k,587) * lu(k,624) + lu(k,639) = lu(k,639) - lu(k,588) * lu(k,624) + lu(k,648) = lu(k,648) - lu(k,579) * lu(k,647) + lu(k,651) = lu(k,651) - lu(k,580) * lu(k,647) + lu(k,652) = lu(k,652) - lu(k,581) * lu(k,647) + lu(k,653) = lu(k,653) - lu(k,582) * lu(k,647) + lu(k,654) = lu(k,654) - lu(k,583) * lu(k,647) + lu(k,655) = lu(k,655) - lu(k,584) * lu(k,647) + lu(k,656) = lu(k,656) - lu(k,585) * lu(k,647) + lu(k,657) = lu(k,657) - lu(k,586) * lu(k,647) + lu(k,658) = lu(k,658) - lu(k,587) * lu(k,647) + lu(k,659) = lu(k,659) - lu(k,588) * lu(k,647) + lu(k,691) = lu(k,691) - lu(k,579) * lu(k,690) + lu(k,695) = lu(k,695) - lu(k,580) * lu(k,690) + lu(k,697) = lu(k,697) - lu(k,581) * lu(k,690) + lu(k,698) = lu(k,698) - lu(k,582) * lu(k,690) + lu(k,699) = lu(k,699) - lu(k,583) * lu(k,690) + lu(k,700) = lu(k,700) - lu(k,584) * lu(k,690) + lu(k,702) = lu(k,702) - lu(k,585) * lu(k,690) + lu(k,703) = lu(k,703) - lu(k,586) * lu(k,690) + lu(k,704) = lu(k,704) - lu(k,587) * lu(k,690) + lu(k,705) = lu(k,705) - lu(k,588) * lu(k,690) + lu(k,747) = lu(k,747) - lu(k,579) * lu(k,746) + lu(k,751) = lu(k,751) - lu(k,580) * lu(k,746) + lu(k,753) = lu(k,753) - lu(k,581) * lu(k,746) + lu(k,755) = lu(k,755) - lu(k,582) * lu(k,746) + lu(k,758) = lu(k,758) - lu(k,583) * lu(k,746) + lu(k,759) = lu(k,759) - lu(k,584) * lu(k,746) + lu(k,761) = lu(k,761) - lu(k,585) * lu(k,746) + lu(k,763) = lu(k,763) - lu(k,586) * lu(k,746) + lu(k,764) = lu(k,764) - lu(k,587) * lu(k,746) + lu(k,766) = lu(k,766) - lu(k,588) * lu(k,746) + lu(k,930) = lu(k,930) - lu(k,579) * lu(k,929) + lu(k,934) = lu(k,934) - lu(k,580) * lu(k,929) + lu(k,936) = lu(k,936) - lu(k,581) * lu(k,929) + lu(k,938) = lu(k,938) - lu(k,582) * lu(k,929) + lu(k,942) = lu(k,942) - lu(k,583) * lu(k,929) + lu(k,943) = lu(k,943) - lu(k,584) * lu(k,929) + lu(k,946) = lu(k,946) - lu(k,585) * lu(k,929) + lu(k,948) = lu(k,948) - lu(k,586) * lu(k,929) + lu(k,949) = lu(k,949) - lu(k,587) * lu(k,929) + lu(k,951) = lu(k,951) - lu(k,588) * lu(k,929) + lu(k,995) = lu(k,995) - lu(k,579) * lu(k,994) + lu(k,1000) = lu(k,1000) - lu(k,580) * lu(k,994) + lu(k,1002) = lu(k,1002) - lu(k,581) * lu(k,994) + lu(k,1004) = lu(k,1004) - lu(k,582) * lu(k,994) + lu(k,1008) = lu(k,1008) - lu(k,583) * lu(k,994) + lu(k,1009) = lu(k,1009) - lu(k,584) * lu(k,994) + lu(k,1012) = lu(k,1012) - lu(k,585) * lu(k,994) + lu(k,1014) = lu(k,1014) - lu(k,586) * lu(k,994) + lu(k,1015) = lu(k,1015) - lu(k,587) * lu(k,994) + lu(k,1017) = lu(k,1017) - lu(k,588) * lu(k,994) + lu(k,1153) = lu(k,1153) - lu(k,579) * lu(k,1152) + lu(k,1158) = lu(k,1158) - lu(k,580) * lu(k,1152) + lu(k,1160) = lu(k,1160) - lu(k,581) * lu(k,1152) + lu(k,1162) = lu(k,1162) - lu(k,582) * lu(k,1152) + lu(k,1166) = lu(k,1166) - lu(k,583) * lu(k,1152) + lu(k,1167) = lu(k,1167) - lu(k,584) * lu(k,1152) + lu(k,1170) = lu(k,1170) - lu(k,585) * lu(k,1152) + lu(k,1172) = lu(k,1172) - lu(k,586) * lu(k,1152) + lu(k,1173) = lu(k,1173) - lu(k,587) * lu(k,1152) + lu(k,1175) = lu(k,1175) - lu(k,588) * lu(k,1152) + lu(k,1197) = lu(k,1197) - lu(k,579) * lu(k,1196) + lu(k,1202) = lu(k,1202) - lu(k,580) * lu(k,1196) + lu(k,1204) = lu(k,1204) - lu(k,581) * lu(k,1196) + lu(k,1206) = lu(k,1206) - lu(k,582) * lu(k,1196) + lu(k,1210) = lu(k,1210) - lu(k,583) * lu(k,1196) + lu(k,1211) = lu(k,1211) - lu(k,584) * lu(k,1196) + lu(k,1214) = lu(k,1214) - lu(k,585) * lu(k,1196) + lu(k,1216) = lu(k,1216) - lu(k,586) * lu(k,1196) + lu(k,1217) = lu(k,1217) - lu(k,587) * lu(k,1196) + lu(k,1219) = lu(k,1219) - lu(k,588) * lu(k,1196) + lu(k,1265) = lu(k,1265) - lu(k,579) * lu(k,1264) + lu(k,1269) = lu(k,1269) - lu(k,580) * lu(k,1264) + lu(k,1271) = lu(k,1271) - lu(k,581) * lu(k,1264) + lu(k,1273) = lu(k,1273) - lu(k,582) * lu(k,1264) + lu(k,1277) = lu(k,1277) - lu(k,583) * lu(k,1264) + lu(k,1278) = lu(k,1278) - lu(k,584) * lu(k,1264) + lu(k,1281) = lu(k,1281) - lu(k,585) * lu(k,1264) + lu(k,1283) = lu(k,1283) - lu(k,586) * lu(k,1264) + lu(k,1284) = lu(k,1284) - lu(k,587) * lu(k,1264) + lu(k,1286) = lu(k,1286) - lu(k,588) * lu(k,1264) + lu(k,591) = 1._r8 / lu(k,591) + lu(k,592) = lu(k,592) * lu(k,591) + lu(k,593) = lu(k,593) * lu(k,591) + lu(k,594) = lu(k,594) * lu(k,591) + lu(k,595) = lu(k,595) * lu(k,591) + lu(k,596) = lu(k,596) * lu(k,591) + lu(k,597) = lu(k,597) * lu(k,591) + lu(k,598) = lu(k,598) * lu(k,591) + lu(k,629) = lu(k,629) - lu(k,592) * lu(k,625) + lu(k,633) = lu(k,633) - lu(k,593) * lu(k,625) + lu(k,634) = lu(k,634) - lu(k,594) * lu(k,625) + lu(k,636) = lu(k,636) - lu(k,595) * lu(k,625) + lu(k,637) = lu(k,637) - lu(k,596) * lu(k,625) + lu(k,638) = lu(k,638) - lu(k,597) * lu(k,625) + lu(k,640) = lu(k,640) - lu(k,598) * lu(k,625) + lu(k,651) = lu(k,651) - lu(k,592) * lu(k,648) + lu(k,654) = lu(k,654) - lu(k,593) * lu(k,648) + lu(k,655) = lu(k,655) - lu(k,594) * lu(k,648) + lu(k,656) = lu(k,656) - lu(k,595) * lu(k,648) + lu(k,657) = lu(k,657) - lu(k,596) * lu(k,648) + lu(k,658) = lu(k,658) - lu(k,597) * lu(k,648) + lu(k,660) = lu(k,660) - lu(k,598) * lu(k,648) + lu(k,669) = lu(k,669) - lu(k,592) * lu(k,667) + lu(k,672) = lu(k,672) - lu(k,593) * lu(k,667) + lu(k,673) = lu(k,673) - lu(k,594) * lu(k,667) + lu(k,675) = lu(k,675) - lu(k,595) * lu(k,667) + lu(k,676) = lu(k,676) - lu(k,596) * lu(k,667) + lu(k,677) = lu(k,677) - lu(k,597) * lu(k,667) + lu(k,679) = lu(k,679) - lu(k,598) * lu(k,667) + lu(k,695) = lu(k,695) - lu(k,592) * lu(k,691) + lu(k,699) = lu(k,699) - lu(k,593) * lu(k,691) + lu(k,700) = lu(k,700) - lu(k,594) * lu(k,691) + lu(k,702) = lu(k,702) - lu(k,595) * lu(k,691) + lu(k,703) = lu(k,703) - lu(k,596) * lu(k,691) + lu(k,704) = lu(k,704) - lu(k,597) * lu(k,691) + lu(k,706) = lu(k,706) - lu(k,598) * lu(k,691) + lu(k,714) = lu(k,714) - lu(k,592) * lu(k,711) + lu(k,721) = lu(k,721) - lu(k,593) * lu(k,711) + lu(k,722) = lu(k,722) - lu(k,594) * lu(k,711) + lu(k,724) = lu(k,724) - lu(k,595) * lu(k,711) + lu(k,726) = lu(k,726) - lu(k,596) * lu(k,711) + lu(k,727) = lu(k,727) - lu(k,597) * lu(k,711) + lu(k,729) = lu(k,729) - lu(k,598) * lu(k,711) + lu(k,751) = lu(k,751) - lu(k,592) * lu(k,747) + lu(k,758) = lu(k,758) - lu(k,593) * lu(k,747) + lu(k,759) = lu(k,759) - lu(k,594) * lu(k,747) + lu(k,761) = lu(k,761) - lu(k,595) * lu(k,747) + lu(k,763) = lu(k,763) - lu(k,596) * lu(k,747) + lu(k,764) = lu(k,764) - lu(k,597) * lu(k,747) + lu(k,767) = lu(k,767) - lu(k,598) * lu(k,747) + lu(k,934) = lu(k,934) - lu(k,592) * lu(k,930) + lu(k,942) = lu(k,942) - lu(k,593) * lu(k,930) + lu(k,943) = lu(k,943) - lu(k,594) * lu(k,930) + lu(k,946) = lu(k,946) - lu(k,595) * lu(k,930) + lu(k,948) = lu(k,948) - lu(k,596) * lu(k,930) + lu(k,949) = lu(k,949) - lu(k,597) * lu(k,930) + lu(k,952) = lu(k,952) - lu(k,598) * lu(k,930) + lu(k,1000) = lu(k,1000) - lu(k,592) * lu(k,995) + lu(k,1008) = lu(k,1008) - lu(k,593) * lu(k,995) + lu(k,1009) = lu(k,1009) - lu(k,594) * lu(k,995) + lu(k,1012) = lu(k,1012) - lu(k,595) * lu(k,995) + lu(k,1014) = lu(k,1014) - lu(k,596) * lu(k,995) + lu(k,1015) = lu(k,1015) - lu(k,597) * lu(k,995) + lu(k,1018) = lu(k,1018) - lu(k,598) * lu(k,995) + lu(k,1036) = lu(k,1036) - lu(k,592) * lu(k,1033) + lu(k,1044) = lu(k,1044) - lu(k,593) * lu(k,1033) + lu(k,1045) = lu(k,1045) - lu(k,594) * lu(k,1033) + lu(k,1048) = lu(k,1048) - lu(k,595) * lu(k,1033) + lu(k,1050) = lu(k,1050) - lu(k,596) * lu(k,1033) + lu(k,1051) = lu(k,1051) - lu(k,597) * lu(k,1033) + lu(k,1054) = lu(k,1054) - lu(k,598) * lu(k,1033) + lu(k,1158) = lu(k,1158) - lu(k,592) * lu(k,1153) + lu(k,1166) = lu(k,1166) - lu(k,593) * lu(k,1153) + lu(k,1167) = lu(k,1167) - lu(k,594) * lu(k,1153) + lu(k,1170) = lu(k,1170) - lu(k,595) * lu(k,1153) + lu(k,1172) = lu(k,1172) - lu(k,596) * lu(k,1153) + lu(k,1173) = lu(k,1173) - lu(k,597) * lu(k,1153) + lu(k,1176) = lu(k,1176) - lu(k,598) * lu(k,1153) + lu(k,1202) = lu(k,1202) - lu(k,592) * lu(k,1197) + lu(k,1210) = lu(k,1210) - lu(k,593) * lu(k,1197) + lu(k,1211) = lu(k,1211) - lu(k,594) * lu(k,1197) + lu(k,1214) = lu(k,1214) - lu(k,595) * lu(k,1197) + lu(k,1216) = lu(k,1216) - lu(k,596) * lu(k,1197) + lu(k,1217) = lu(k,1217) - lu(k,597) * lu(k,1197) + lu(k,1220) = lu(k,1220) - lu(k,598) * lu(k,1197) + lu(k,1269) = lu(k,1269) - lu(k,592) * lu(k,1265) + lu(k,1277) = lu(k,1277) - lu(k,593) * lu(k,1265) + lu(k,1278) = lu(k,1278) - lu(k,594) * lu(k,1265) + lu(k,1281) = lu(k,1281) - lu(k,595) * lu(k,1265) + lu(k,1283) = lu(k,1283) - lu(k,596) * lu(k,1265) + lu(k,1284) = lu(k,1284) - lu(k,597) * lu(k,1265) + lu(k,1287) = lu(k,1287) - lu(k,598) * lu(k,1265) + lu(k,602) = 1._r8 / lu(k,602) + lu(k,603) = lu(k,603) * lu(k,602) + lu(k,604) = lu(k,604) * lu(k,602) + lu(k,605) = lu(k,605) * lu(k,602) + lu(k,606) = lu(k,606) * lu(k,602) + lu(k,607) = lu(k,607) * lu(k,602) + lu(k,608) = lu(k,608) * lu(k,602) + lu(k,609) = lu(k,609) * lu(k,602) + lu(k,610) = lu(k,610) * lu(k,602) + lu(k,611) = lu(k,611) * lu(k,602) + lu(k,612) = lu(k,612) * lu(k,602) + lu(k,613) = lu(k,613) * lu(k,602) + lu(k,614) = lu(k,614) * lu(k,602) + lu(k,881) = lu(k,881) - lu(k,603) * lu(k,880) + lu(k,883) = lu(k,883) - lu(k,604) * lu(k,880) + lu(k,885) = lu(k,885) - lu(k,605) * lu(k,880) + lu(k,886) = lu(k,886) - lu(k,606) * lu(k,880) + lu(k,887) = lu(k,887) - lu(k,607) * lu(k,880) + lu(k,888) = lu(k,888) - lu(k,608) * lu(k,880) + lu(k,889) = lu(k,889) - lu(k,609) * lu(k,880) + lu(k,890) = lu(k,890) - lu(k,610) * lu(k,880) + lu(k,892) = lu(k,892) - lu(k,611) * lu(k,880) + lu(k,894) = lu(k,894) - lu(k,612) * lu(k,880) + lu(k,895) = lu(k,895) - lu(k,613) * lu(k,880) + lu(k,896) = lu(k,896) - lu(k,614) * lu(k,880) + lu(k,960) = - lu(k,603) * lu(k,959) + lu(k,961) = lu(k,961) - lu(k,604) * lu(k,959) + lu(k,963) = lu(k,963) - lu(k,605) * lu(k,959) + lu(k,964) = lu(k,964) - lu(k,606) * lu(k,959) + lu(k,965) = lu(k,965) - lu(k,607) * lu(k,959) + lu(k,966) = lu(k,966) - lu(k,608) * lu(k,959) + lu(k,967) = - lu(k,609) * lu(k,959) + lu(k,968) = lu(k,968) - lu(k,610) * lu(k,959) + lu(k,970) = lu(k,970) - lu(k,611) * lu(k,959) + lu(k,972) = lu(k,972) - lu(k,612) * lu(k,959) + lu(k,973) = lu(k,973) - lu(k,613) * lu(k,959) + lu(k,974) = lu(k,974) - lu(k,614) * lu(k,959) + lu(k,1003) = lu(k,1003) - lu(k,603) * lu(k,996) + lu(k,1005) = lu(k,1005) - lu(k,604) * lu(k,996) + lu(k,1007) = lu(k,1007) - lu(k,605) * lu(k,996) + lu(k,1008) = lu(k,1008) - lu(k,606) * lu(k,996) + lu(k,1009) = lu(k,1009) - lu(k,607) * lu(k,996) + lu(k,1010) = lu(k,1010) - lu(k,608) * lu(k,996) + lu(k,1011) = lu(k,1011) - lu(k,609) * lu(k,996) + lu(k,1012) = lu(k,1012) - lu(k,610) * lu(k,996) + lu(k,1014) = lu(k,1014) - lu(k,611) * lu(k,996) + lu(k,1016) = lu(k,1016) - lu(k,612) * lu(k,996) + lu(k,1017) = lu(k,1017) - lu(k,613) * lu(k,996) + lu(k,1018) = lu(k,1018) - lu(k,614) * lu(k,996) + lu(k,1039) = lu(k,1039) - lu(k,603) * lu(k,1034) + lu(k,1041) = lu(k,1041) - lu(k,604) * lu(k,1034) + lu(k,1043) = lu(k,1043) - lu(k,605) * lu(k,1034) + lu(k,1044) = lu(k,1044) - lu(k,606) * lu(k,1034) + lu(k,1045) = lu(k,1045) - lu(k,607) * lu(k,1034) + lu(k,1046) = lu(k,1046) - lu(k,608) * lu(k,1034) + lu(k,1047) = lu(k,1047) - lu(k,609) * lu(k,1034) + lu(k,1048) = lu(k,1048) - lu(k,610) * lu(k,1034) + lu(k,1050) = lu(k,1050) - lu(k,611) * lu(k,1034) + lu(k,1052) = lu(k,1052) - lu(k,612) * lu(k,1034) + lu(k,1053) = lu(k,1053) - lu(k,613) * lu(k,1034) + lu(k,1054) = lu(k,1054) - lu(k,614) * lu(k,1034) + lu(k,1161) = lu(k,1161) - lu(k,603) * lu(k,1154) + lu(k,1163) = lu(k,1163) - lu(k,604) * lu(k,1154) + lu(k,1165) = lu(k,1165) - lu(k,605) * lu(k,1154) + lu(k,1166) = lu(k,1166) - lu(k,606) * lu(k,1154) + lu(k,1167) = lu(k,1167) - lu(k,607) * lu(k,1154) + lu(k,1168) = lu(k,1168) - lu(k,608) * lu(k,1154) + lu(k,1169) = lu(k,1169) - lu(k,609) * lu(k,1154) + lu(k,1170) = lu(k,1170) - lu(k,610) * lu(k,1154) + lu(k,1172) = lu(k,1172) - lu(k,611) * lu(k,1154) + lu(k,1174) = lu(k,1174) - lu(k,612) * lu(k,1154) + lu(k,1175) = lu(k,1175) - lu(k,613) * lu(k,1154) + lu(k,1176) = lu(k,1176) - lu(k,614) * lu(k,1154) + lu(k,1205) = lu(k,1205) - lu(k,603) * lu(k,1198) + lu(k,1207) = - lu(k,604) * lu(k,1198) + lu(k,1209) = lu(k,1209) - lu(k,605) * lu(k,1198) + lu(k,1210) = lu(k,1210) - lu(k,606) * lu(k,1198) + lu(k,1211) = lu(k,1211) - lu(k,607) * lu(k,1198) + lu(k,1212) = - lu(k,608) * lu(k,1198) + lu(k,1213) = lu(k,1213) - lu(k,609) * lu(k,1198) + lu(k,1214) = lu(k,1214) - lu(k,610) * lu(k,1198) + lu(k,1216) = lu(k,1216) - lu(k,611) * lu(k,1198) + lu(k,1218) = - lu(k,612) * lu(k,1198) + lu(k,1219) = lu(k,1219) - lu(k,613) * lu(k,1198) + lu(k,1220) = lu(k,1220) - lu(k,614) * lu(k,1198) + lu(k,1230) = - lu(k,603) * lu(k,1228) + lu(k,1232) = lu(k,1232) - lu(k,604) * lu(k,1228) + lu(k,1234) = lu(k,1234) - lu(k,605) * lu(k,1228) + lu(k,1235) = lu(k,1235) - lu(k,606) * lu(k,1228) + lu(k,1236) = lu(k,1236) - lu(k,607) * lu(k,1228) + lu(k,1237) = lu(k,1237) - lu(k,608) * lu(k,1228) + lu(k,1238) = - lu(k,609) * lu(k,1228) + lu(k,1239) = lu(k,1239) - lu(k,610) * lu(k,1228) + lu(k,1241) = lu(k,1241) - lu(k,611) * lu(k,1228) + lu(k,1243) = lu(k,1243) - lu(k,612) * lu(k,1228) + lu(k,1244) = lu(k,1244) - lu(k,613) * lu(k,1228) + lu(k,1245) = lu(k,1245) - lu(k,614) * lu(k,1228) + lu(k,1293) = lu(k,1293) - lu(k,603) * lu(k,1292) + lu(k,1294) = - lu(k,604) * lu(k,1292) + lu(k,1296) = lu(k,1296) - lu(k,605) * lu(k,1292) + lu(k,1297) = lu(k,1297) - lu(k,606) * lu(k,1292) + lu(k,1298) = lu(k,1298) - lu(k,607) * lu(k,1292) + lu(k,1299) = - lu(k,608) * lu(k,1292) + lu(k,1300) = - lu(k,609) * lu(k,1292) + lu(k,1301) = - lu(k,610) * lu(k,1292) + lu(k,1303) = lu(k,1303) - lu(k,611) * lu(k,1292) + lu(k,1305) = - lu(k,612) * lu(k,1292) + lu(k,1306) = - lu(k,613) * lu(k,1292) + lu(k,1307) = lu(k,1307) - lu(k,614) * lu(k,1292) + end do + end subroutine lu_fac13 + subroutine lu_fac14( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,626) = 1._r8 / lu(k,626) + lu(k,627) = lu(k,627) * lu(k,626) + lu(k,628) = lu(k,628) * lu(k,626) + lu(k,629) = lu(k,629) * lu(k,626) + lu(k,630) = lu(k,630) * lu(k,626) + lu(k,631) = lu(k,631) * lu(k,626) + lu(k,632) = lu(k,632) * lu(k,626) + lu(k,633) = lu(k,633) * lu(k,626) + lu(k,634) = lu(k,634) * lu(k,626) + lu(k,635) = lu(k,635) * lu(k,626) + lu(k,636) = lu(k,636) * lu(k,626) + lu(k,637) = lu(k,637) * lu(k,626) + lu(k,638) = lu(k,638) * lu(k,626) + lu(k,639) = lu(k,639) * lu(k,626) + lu(k,640) = lu(k,640) * lu(k,626) + lu(k,693) = lu(k,693) - lu(k,627) * lu(k,692) + lu(k,694) = lu(k,694) - lu(k,628) * lu(k,692) + lu(k,695) = lu(k,695) - lu(k,629) * lu(k,692) + lu(k,696) = lu(k,696) - lu(k,630) * lu(k,692) + lu(k,697) = lu(k,697) - lu(k,631) * lu(k,692) + lu(k,698) = lu(k,698) - lu(k,632) * lu(k,692) + lu(k,699) = lu(k,699) - lu(k,633) * lu(k,692) + lu(k,700) = lu(k,700) - lu(k,634) * lu(k,692) + lu(k,701) = lu(k,701) - lu(k,635) * lu(k,692) + lu(k,702) = lu(k,702) - lu(k,636) * lu(k,692) + lu(k,703) = lu(k,703) - lu(k,637) * lu(k,692) + lu(k,704) = lu(k,704) - lu(k,638) * lu(k,692) + lu(k,705) = lu(k,705) - lu(k,639) * lu(k,692) + lu(k,706) = lu(k,706) - lu(k,640) * lu(k,692) + lu(k,749) = lu(k,749) - lu(k,627) * lu(k,748) + lu(k,750) = lu(k,750) - lu(k,628) * lu(k,748) + lu(k,751) = lu(k,751) - lu(k,629) * lu(k,748) + lu(k,752) = lu(k,752) - lu(k,630) * lu(k,748) + lu(k,753) = lu(k,753) - lu(k,631) * lu(k,748) + lu(k,755) = lu(k,755) - lu(k,632) * lu(k,748) + lu(k,758) = lu(k,758) - lu(k,633) * lu(k,748) + lu(k,759) = lu(k,759) - lu(k,634) * lu(k,748) + lu(k,760) = lu(k,760) - lu(k,635) * lu(k,748) + lu(k,761) = lu(k,761) - lu(k,636) * lu(k,748) + lu(k,763) = lu(k,763) - lu(k,637) * lu(k,748) + lu(k,764) = lu(k,764) - lu(k,638) * lu(k,748) + lu(k,766) = lu(k,766) - lu(k,639) * lu(k,748) + lu(k,767) = lu(k,767) - lu(k,640) * lu(k,748) + lu(k,932) = lu(k,932) - lu(k,627) * lu(k,931) + lu(k,933) = lu(k,933) - lu(k,628) * lu(k,931) + lu(k,934) = lu(k,934) - lu(k,629) * lu(k,931) + lu(k,935) = lu(k,935) - lu(k,630) * lu(k,931) + lu(k,936) = lu(k,936) - lu(k,631) * lu(k,931) + lu(k,938) = lu(k,938) - lu(k,632) * lu(k,931) + lu(k,942) = lu(k,942) - lu(k,633) * lu(k,931) + lu(k,943) = lu(k,943) - lu(k,634) * lu(k,931) + lu(k,945) = lu(k,945) - lu(k,635) * lu(k,931) + lu(k,946) = lu(k,946) - lu(k,636) * lu(k,931) + lu(k,948) = lu(k,948) - lu(k,637) * lu(k,931) + lu(k,949) = lu(k,949) - lu(k,638) * lu(k,931) + lu(k,951) = lu(k,951) - lu(k,639) * lu(k,931) + lu(k,952) = lu(k,952) - lu(k,640) * lu(k,931) + lu(k,998) = lu(k,998) - lu(k,627) * lu(k,997) + lu(k,999) = lu(k,999) - lu(k,628) * lu(k,997) + lu(k,1000) = lu(k,1000) - lu(k,629) * lu(k,997) + lu(k,1001) = lu(k,1001) - lu(k,630) * lu(k,997) + lu(k,1002) = lu(k,1002) - lu(k,631) * lu(k,997) + lu(k,1004) = lu(k,1004) - lu(k,632) * lu(k,997) + lu(k,1008) = lu(k,1008) - lu(k,633) * lu(k,997) + lu(k,1009) = lu(k,1009) - lu(k,634) * lu(k,997) + lu(k,1011) = lu(k,1011) - lu(k,635) * lu(k,997) + lu(k,1012) = lu(k,1012) - lu(k,636) * lu(k,997) + lu(k,1014) = lu(k,1014) - lu(k,637) * lu(k,997) + lu(k,1015) = lu(k,1015) - lu(k,638) * lu(k,997) + lu(k,1017) = lu(k,1017) - lu(k,639) * lu(k,997) + lu(k,1018) = lu(k,1018) - lu(k,640) * lu(k,997) + lu(k,1156) = lu(k,1156) - lu(k,627) * lu(k,1155) + lu(k,1157) = lu(k,1157) - lu(k,628) * lu(k,1155) + lu(k,1158) = lu(k,1158) - lu(k,629) * lu(k,1155) + lu(k,1159) = lu(k,1159) - lu(k,630) * lu(k,1155) + lu(k,1160) = lu(k,1160) - lu(k,631) * lu(k,1155) + lu(k,1162) = lu(k,1162) - lu(k,632) * lu(k,1155) + lu(k,1166) = lu(k,1166) - lu(k,633) * lu(k,1155) + lu(k,1167) = lu(k,1167) - lu(k,634) * lu(k,1155) + lu(k,1169) = lu(k,1169) - lu(k,635) * lu(k,1155) + lu(k,1170) = lu(k,1170) - lu(k,636) * lu(k,1155) + lu(k,1172) = lu(k,1172) - lu(k,637) * lu(k,1155) + lu(k,1173) = lu(k,1173) - lu(k,638) * lu(k,1155) + lu(k,1175) = lu(k,1175) - lu(k,639) * lu(k,1155) + lu(k,1176) = lu(k,1176) - lu(k,640) * lu(k,1155) + lu(k,1200) = lu(k,1200) - lu(k,627) * lu(k,1199) + lu(k,1201) = lu(k,1201) - lu(k,628) * lu(k,1199) + lu(k,1202) = lu(k,1202) - lu(k,629) * lu(k,1199) + lu(k,1203) = lu(k,1203) - lu(k,630) * lu(k,1199) + lu(k,1204) = lu(k,1204) - lu(k,631) * lu(k,1199) + lu(k,1206) = lu(k,1206) - lu(k,632) * lu(k,1199) + lu(k,1210) = lu(k,1210) - lu(k,633) * lu(k,1199) + lu(k,1211) = lu(k,1211) - lu(k,634) * lu(k,1199) + lu(k,1213) = lu(k,1213) - lu(k,635) * lu(k,1199) + lu(k,1214) = lu(k,1214) - lu(k,636) * lu(k,1199) + lu(k,1216) = lu(k,1216) - lu(k,637) * lu(k,1199) + lu(k,1217) = lu(k,1217) - lu(k,638) * lu(k,1199) + lu(k,1219) = lu(k,1219) - lu(k,639) * lu(k,1199) + lu(k,1220) = lu(k,1220) - lu(k,640) * lu(k,1199) + lu(k,1267) = lu(k,1267) - lu(k,627) * lu(k,1266) + lu(k,1268) = lu(k,1268) - lu(k,628) * lu(k,1266) + lu(k,1269) = lu(k,1269) - lu(k,629) * lu(k,1266) + lu(k,1270) = lu(k,1270) - lu(k,630) * lu(k,1266) + lu(k,1271) = lu(k,1271) - lu(k,631) * lu(k,1266) + lu(k,1273) = lu(k,1273) - lu(k,632) * lu(k,1266) + lu(k,1277) = lu(k,1277) - lu(k,633) * lu(k,1266) + lu(k,1278) = lu(k,1278) - lu(k,634) * lu(k,1266) + lu(k,1280) = lu(k,1280) - lu(k,635) * lu(k,1266) + lu(k,1281) = lu(k,1281) - lu(k,636) * lu(k,1266) + lu(k,1283) = lu(k,1283) - lu(k,637) * lu(k,1266) + lu(k,1284) = lu(k,1284) - lu(k,638) * lu(k,1266) + lu(k,1286) = lu(k,1286) - lu(k,639) * lu(k,1266) + lu(k,1287) = lu(k,1287) - lu(k,640) * lu(k,1266) + lu(k,649) = 1._r8 / lu(k,649) + lu(k,650) = lu(k,650) * lu(k,649) + lu(k,651) = lu(k,651) * lu(k,649) + lu(k,652) = lu(k,652) * lu(k,649) + lu(k,653) = lu(k,653) * lu(k,649) + lu(k,654) = lu(k,654) * lu(k,649) + lu(k,655) = lu(k,655) * lu(k,649) + lu(k,656) = lu(k,656) * lu(k,649) + lu(k,657) = lu(k,657) * lu(k,649) + lu(k,658) = lu(k,658) * lu(k,649) + lu(k,659) = lu(k,659) * lu(k,649) + lu(k,660) = lu(k,660) * lu(k,649) + lu(k,694) = lu(k,694) - lu(k,650) * lu(k,693) + lu(k,695) = lu(k,695) - lu(k,651) * lu(k,693) + lu(k,697) = lu(k,697) - lu(k,652) * lu(k,693) + lu(k,698) = lu(k,698) - lu(k,653) * lu(k,693) + lu(k,699) = lu(k,699) - lu(k,654) * lu(k,693) + lu(k,700) = lu(k,700) - lu(k,655) * lu(k,693) + lu(k,702) = lu(k,702) - lu(k,656) * lu(k,693) + lu(k,703) = lu(k,703) - lu(k,657) * lu(k,693) + lu(k,704) = lu(k,704) - lu(k,658) * lu(k,693) + lu(k,705) = lu(k,705) - lu(k,659) * lu(k,693) + lu(k,706) = lu(k,706) - lu(k,660) * lu(k,693) + lu(k,713) = - lu(k,650) * lu(k,712) + lu(k,714) = lu(k,714) - lu(k,651) * lu(k,712) + lu(k,716) = lu(k,716) - lu(k,652) * lu(k,712) + lu(k,718) = lu(k,718) - lu(k,653) * lu(k,712) + lu(k,721) = lu(k,721) - lu(k,654) * lu(k,712) + lu(k,722) = lu(k,722) - lu(k,655) * lu(k,712) + lu(k,724) = lu(k,724) - lu(k,656) * lu(k,712) + lu(k,726) = lu(k,726) - lu(k,657) * lu(k,712) + lu(k,727) = lu(k,727) - lu(k,658) * lu(k,712) + lu(k,728) = lu(k,728) - lu(k,659) * lu(k,712) + lu(k,729) = lu(k,729) - lu(k,660) * lu(k,712) + lu(k,750) = lu(k,750) - lu(k,650) * lu(k,749) + lu(k,751) = lu(k,751) - lu(k,651) * lu(k,749) + lu(k,753) = lu(k,753) - lu(k,652) * lu(k,749) + lu(k,755) = lu(k,755) - lu(k,653) * lu(k,749) + lu(k,758) = lu(k,758) - lu(k,654) * lu(k,749) + lu(k,759) = lu(k,759) - lu(k,655) * lu(k,749) + lu(k,761) = lu(k,761) - lu(k,656) * lu(k,749) + lu(k,763) = lu(k,763) - lu(k,657) * lu(k,749) + lu(k,764) = lu(k,764) - lu(k,658) * lu(k,749) + lu(k,766) = lu(k,766) - lu(k,659) * lu(k,749) + lu(k,767) = lu(k,767) - lu(k,660) * lu(k,749) + lu(k,933) = lu(k,933) - lu(k,650) * lu(k,932) + lu(k,934) = lu(k,934) - lu(k,651) * lu(k,932) + lu(k,936) = lu(k,936) - lu(k,652) * lu(k,932) + lu(k,938) = lu(k,938) - lu(k,653) * lu(k,932) + lu(k,942) = lu(k,942) - lu(k,654) * lu(k,932) + lu(k,943) = lu(k,943) - lu(k,655) * lu(k,932) + lu(k,946) = lu(k,946) - lu(k,656) * lu(k,932) + lu(k,948) = lu(k,948) - lu(k,657) * lu(k,932) + lu(k,949) = lu(k,949) - lu(k,658) * lu(k,932) + lu(k,951) = lu(k,951) - lu(k,659) * lu(k,932) + lu(k,952) = lu(k,952) - lu(k,660) * lu(k,932) + lu(k,999) = lu(k,999) - lu(k,650) * lu(k,998) + lu(k,1000) = lu(k,1000) - lu(k,651) * lu(k,998) + lu(k,1002) = lu(k,1002) - lu(k,652) * lu(k,998) + lu(k,1004) = lu(k,1004) - lu(k,653) * lu(k,998) + lu(k,1008) = lu(k,1008) - lu(k,654) * lu(k,998) + lu(k,1009) = lu(k,1009) - lu(k,655) * lu(k,998) + lu(k,1012) = lu(k,1012) - lu(k,656) * lu(k,998) + lu(k,1014) = lu(k,1014) - lu(k,657) * lu(k,998) + lu(k,1015) = lu(k,1015) - lu(k,658) * lu(k,998) + lu(k,1017) = lu(k,1017) - lu(k,659) * lu(k,998) + lu(k,1018) = lu(k,1018) - lu(k,660) * lu(k,998) + lu(k,1157) = lu(k,1157) - lu(k,650) * lu(k,1156) + lu(k,1158) = lu(k,1158) - lu(k,651) * lu(k,1156) + lu(k,1160) = lu(k,1160) - lu(k,652) * lu(k,1156) + lu(k,1162) = lu(k,1162) - lu(k,653) * lu(k,1156) + lu(k,1166) = lu(k,1166) - lu(k,654) * lu(k,1156) + lu(k,1167) = lu(k,1167) - lu(k,655) * lu(k,1156) + lu(k,1170) = lu(k,1170) - lu(k,656) * lu(k,1156) + lu(k,1172) = lu(k,1172) - lu(k,657) * lu(k,1156) + lu(k,1173) = lu(k,1173) - lu(k,658) * lu(k,1156) + lu(k,1175) = lu(k,1175) - lu(k,659) * lu(k,1156) + lu(k,1176) = lu(k,1176) - lu(k,660) * lu(k,1156) + lu(k,1201) = lu(k,1201) - lu(k,650) * lu(k,1200) + lu(k,1202) = lu(k,1202) - lu(k,651) * lu(k,1200) + lu(k,1204) = lu(k,1204) - lu(k,652) * lu(k,1200) + lu(k,1206) = lu(k,1206) - lu(k,653) * lu(k,1200) + lu(k,1210) = lu(k,1210) - lu(k,654) * lu(k,1200) + lu(k,1211) = lu(k,1211) - lu(k,655) * lu(k,1200) + lu(k,1214) = lu(k,1214) - lu(k,656) * lu(k,1200) + lu(k,1216) = lu(k,1216) - lu(k,657) * lu(k,1200) + lu(k,1217) = lu(k,1217) - lu(k,658) * lu(k,1200) + lu(k,1219) = lu(k,1219) - lu(k,659) * lu(k,1200) + lu(k,1220) = lu(k,1220) - lu(k,660) * lu(k,1200) + lu(k,1268) = lu(k,1268) - lu(k,650) * lu(k,1267) + lu(k,1269) = lu(k,1269) - lu(k,651) * lu(k,1267) + lu(k,1271) = lu(k,1271) - lu(k,652) * lu(k,1267) + lu(k,1273) = lu(k,1273) - lu(k,653) * lu(k,1267) + lu(k,1277) = lu(k,1277) - lu(k,654) * lu(k,1267) + lu(k,1278) = lu(k,1278) - lu(k,655) * lu(k,1267) + lu(k,1281) = lu(k,1281) - lu(k,656) * lu(k,1267) + lu(k,1283) = lu(k,1283) - lu(k,657) * lu(k,1267) + lu(k,1284) = lu(k,1284) - lu(k,658) * lu(k,1267) + lu(k,1286) = lu(k,1286) - lu(k,659) * lu(k,1267) + lu(k,1287) = lu(k,1287) - lu(k,660) * lu(k,1267) + lu(k,668) = 1._r8 / lu(k,668) + lu(k,669) = lu(k,669) * lu(k,668) + lu(k,670) = lu(k,670) * lu(k,668) + lu(k,671) = lu(k,671) * lu(k,668) + lu(k,672) = lu(k,672) * lu(k,668) + lu(k,673) = lu(k,673) * lu(k,668) + lu(k,674) = lu(k,674) * lu(k,668) + lu(k,675) = lu(k,675) * lu(k,668) + lu(k,676) = lu(k,676) * lu(k,668) + lu(k,677) = lu(k,677) * lu(k,668) + lu(k,678) = lu(k,678) * lu(k,668) + lu(k,679) = lu(k,679) * lu(k,668) + lu(k,695) = lu(k,695) - lu(k,669) * lu(k,694) + lu(k,697) = lu(k,697) - lu(k,670) * lu(k,694) + lu(k,698) = lu(k,698) - lu(k,671) * lu(k,694) + lu(k,699) = lu(k,699) - lu(k,672) * lu(k,694) + lu(k,700) = lu(k,700) - lu(k,673) * lu(k,694) + lu(k,701) = lu(k,701) - lu(k,674) * lu(k,694) + lu(k,702) = lu(k,702) - lu(k,675) * lu(k,694) + lu(k,703) = lu(k,703) - lu(k,676) * lu(k,694) + lu(k,704) = lu(k,704) - lu(k,677) * lu(k,694) + lu(k,705) = lu(k,705) - lu(k,678) * lu(k,694) + lu(k,706) = lu(k,706) - lu(k,679) * lu(k,694) + lu(k,714) = lu(k,714) - lu(k,669) * lu(k,713) + lu(k,716) = lu(k,716) - lu(k,670) * lu(k,713) + lu(k,718) = lu(k,718) - lu(k,671) * lu(k,713) + lu(k,721) = lu(k,721) - lu(k,672) * lu(k,713) + lu(k,722) = lu(k,722) - lu(k,673) * lu(k,713) + lu(k,723) = lu(k,723) - lu(k,674) * lu(k,713) + lu(k,724) = lu(k,724) - lu(k,675) * lu(k,713) + lu(k,726) = lu(k,726) - lu(k,676) * lu(k,713) + lu(k,727) = lu(k,727) - lu(k,677) * lu(k,713) + lu(k,728) = lu(k,728) - lu(k,678) * lu(k,713) + lu(k,729) = lu(k,729) - lu(k,679) * lu(k,713) + lu(k,751) = lu(k,751) - lu(k,669) * lu(k,750) + lu(k,753) = lu(k,753) - lu(k,670) * lu(k,750) + lu(k,755) = lu(k,755) - lu(k,671) * lu(k,750) + lu(k,758) = lu(k,758) - lu(k,672) * lu(k,750) + lu(k,759) = lu(k,759) - lu(k,673) * lu(k,750) + lu(k,760) = lu(k,760) - lu(k,674) * lu(k,750) + lu(k,761) = lu(k,761) - lu(k,675) * lu(k,750) + lu(k,763) = lu(k,763) - lu(k,676) * lu(k,750) + lu(k,764) = lu(k,764) - lu(k,677) * lu(k,750) + lu(k,766) = lu(k,766) - lu(k,678) * lu(k,750) + lu(k,767) = lu(k,767) - lu(k,679) * lu(k,750) + lu(k,934) = lu(k,934) - lu(k,669) * lu(k,933) + lu(k,936) = lu(k,936) - lu(k,670) * lu(k,933) + lu(k,938) = lu(k,938) - lu(k,671) * lu(k,933) + lu(k,942) = lu(k,942) - lu(k,672) * lu(k,933) + lu(k,943) = lu(k,943) - lu(k,673) * lu(k,933) + lu(k,945) = lu(k,945) - lu(k,674) * lu(k,933) + lu(k,946) = lu(k,946) - lu(k,675) * lu(k,933) + lu(k,948) = lu(k,948) - lu(k,676) * lu(k,933) + lu(k,949) = lu(k,949) - lu(k,677) * lu(k,933) + lu(k,951) = lu(k,951) - lu(k,678) * lu(k,933) + lu(k,952) = lu(k,952) - lu(k,679) * lu(k,933) + lu(k,1000) = lu(k,1000) - lu(k,669) * lu(k,999) + lu(k,1002) = lu(k,1002) - lu(k,670) * lu(k,999) + lu(k,1004) = lu(k,1004) - lu(k,671) * lu(k,999) + lu(k,1008) = lu(k,1008) - lu(k,672) * lu(k,999) + lu(k,1009) = lu(k,1009) - lu(k,673) * lu(k,999) + lu(k,1011) = lu(k,1011) - lu(k,674) * lu(k,999) + lu(k,1012) = lu(k,1012) - lu(k,675) * lu(k,999) + lu(k,1014) = lu(k,1014) - lu(k,676) * lu(k,999) + lu(k,1015) = lu(k,1015) - lu(k,677) * lu(k,999) + lu(k,1017) = lu(k,1017) - lu(k,678) * lu(k,999) + lu(k,1018) = lu(k,1018) - lu(k,679) * lu(k,999) + lu(k,1036) = lu(k,1036) - lu(k,669) * lu(k,1035) + lu(k,1038) = lu(k,1038) - lu(k,670) * lu(k,1035) + lu(k,1040) = lu(k,1040) - lu(k,671) * lu(k,1035) + lu(k,1044) = lu(k,1044) - lu(k,672) * lu(k,1035) + lu(k,1045) = lu(k,1045) - lu(k,673) * lu(k,1035) + lu(k,1047) = lu(k,1047) - lu(k,674) * lu(k,1035) + lu(k,1048) = lu(k,1048) - lu(k,675) * lu(k,1035) + lu(k,1050) = lu(k,1050) - lu(k,676) * lu(k,1035) + lu(k,1051) = lu(k,1051) - lu(k,677) * lu(k,1035) + lu(k,1053) = lu(k,1053) - lu(k,678) * lu(k,1035) + lu(k,1054) = lu(k,1054) - lu(k,679) * lu(k,1035) + lu(k,1158) = lu(k,1158) - lu(k,669) * lu(k,1157) + lu(k,1160) = lu(k,1160) - lu(k,670) * lu(k,1157) + lu(k,1162) = lu(k,1162) - lu(k,671) * lu(k,1157) + lu(k,1166) = lu(k,1166) - lu(k,672) * lu(k,1157) + lu(k,1167) = lu(k,1167) - lu(k,673) * lu(k,1157) + lu(k,1169) = lu(k,1169) - lu(k,674) * lu(k,1157) + lu(k,1170) = lu(k,1170) - lu(k,675) * lu(k,1157) + lu(k,1172) = lu(k,1172) - lu(k,676) * lu(k,1157) + lu(k,1173) = lu(k,1173) - lu(k,677) * lu(k,1157) + lu(k,1175) = lu(k,1175) - lu(k,678) * lu(k,1157) + lu(k,1176) = lu(k,1176) - lu(k,679) * lu(k,1157) + lu(k,1202) = lu(k,1202) - lu(k,669) * lu(k,1201) + lu(k,1204) = lu(k,1204) - lu(k,670) * lu(k,1201) + lu(k,1206) = lu(k,1206) - lu(k,671) * lu(k,1201) + lu(k,1210) = lu(k,1210) - lu(k,672) * lu(k,1201) + lu(k,1211) = lu(k,1211) - lu(k,673) * lu(k,1201) + lu(k,1213) = lu(k,1213) - lu(k,674) * lu(k,1201) + lu(k,1214) = lu(k,1214) - lu(k,675) * lu(k,1201) + lu(k,1216) = lu(k,1216) - lu(k,676) * lu(k,1201) + lu(k,1217) = lu(k,1217) - lu(k,677) * lu(k,1201) + lu(k,1219) = lu(k,1219) - lu(k,678) * lu(k,1201) + lu(k,1220) = lu(k,1220) - lu(k,679) * lu(k,1201) + lu(k,1269) = lu(k,1269) - lu(k,669) * lu(k,1268) + lu(k,1271) = lu(k,1271) - lu(k,670) * lu(k,1268) + lu(k,1273) = lu(k,1273) - lu(k,671) * lu(k,1268) + lu(k,1277) = lu(k,1277) - lu(k,672) * lu(k,1268) + lu(k,1278) = lu(k,1278) - lu(k,673) * lu(k,1268) + lu(k,1280) = lu(k,1280) - lu(k,674) * lu(k,1268) + lu(k,1281) = lu(k,1281) - lu(k,675) * lu(k,1268) + lu(k,1283) = lu(k,1283) - lu(k,676) * lu(k,1268) + lu(k,1284) = lu(k,1284) - lu(k,677) * lu(k,1268) + lu(k,1286) = lu(k,1286) - lu(k,678) * lu(k,1268) + lu(k,1287) = lu(k,1287) - lu(k,679) * lu(k,1268) + lu(k,695) = 1._r8 / lu(k,695) + lu(k,696) = lu(k,696) * lu(k,695) + lu(k,697) = lu(k,697) * lu(k,695) + lu(k,698) = lu(k,698) * lu(k,695) + lu(k,699) = lu(k,699) * lu(k,695) + lu(k,700) = lu(k,700) * lu(k,695) + lu(k,701) = lu(k,701) * lu(k,695) + lu(k,702) = lu(k,702) * lu(k,695) + lu(k,703) = lu(k,703) * lu(k,695) + lu(k,704) = lu(k,704) * lu(k,695) + lu(k,705) = lu(k,705) * lu(k,695) + lu(k,706) = lu(k,706) * lu(k,695) + lu(k,715) = lu(k,715) - lu(k,696) * lu(k,714) + lu(k,716) = lu(k,716) - lu(k,697) * lu(k,714) + lu(k,718) = lu(k,718) - lu(k,698) * lu(k,714) + lu(k,721) = lu(k,721) - lu(k,699) * lu(k,714) + lu(k,722) = lu(k,722) - lu(k,700) * lu(k,714) + lu(k,723) = lu(k,723) - lu(k,701) * lu(k,714) + lu(k,724) = lu(k,724) - lu(k,702) * lu(k,714) + lu(k,726) = lu(k,726) - lu(k,703) * lu(k,714) + lu(k,727) = lu(k,727) - lu(k,704) * lu(k,714) + lu(k,728) = lu(k,728) - lu(k,705) * lu(k,714) + lu(k,729) = lu(k,729) - lu(k,706) * lu(k,714) + lu(k,752) = lu(k,752) - lu(k,696) * lu(k,751) + lu(k,753) = lu(k,753) - lu(k,697) * lu(k,751) + lu(k,755) = lu(k,755) - lu(k,698) * lu(k,751) + lu(k,758) = lu(k,758) - lu(k,699) * lu(k,751) + lu(k,759) = lu(k,759) - lu(k,700) * lu(k,751) + lu(k,760) = lu(k,760) - lu(k,701) * lu(k,751) + lu(k,761) = lu(k,761) - lu(k,702) * lu(k,751) + lu(k,763) = lu(k,763) - lu(k,703) * lu(k,751) + lu(k,764) = lu(k,764) - lu(k,704) * lu(k,751) + lu(k,766) = lu(k,766) - lu(k,705) * lu(k,751) + lu(k,767) = lu(k,767) - lu(k,706) * lu(k,751) + lu(k,850) = - lu(k,696) * lu(k,849) + lu(k,851) = lu(k,851) - lu(k,697) * lu(k,849) + lu(k,853) = lu(k,853) - lu(k,698) * lu(k,849) + lu(k,857) = lu(k,857) - lu(k,699) * lu(k,849) + lu(k,858) = lu(k,858) - lu(k,700) * lu(k,849) + lu(k,860) = lu(k,860) - lu(k,701) * lu(k,849) + lu(k,861) = lu(k,861) - lu(k,702) * lu(k,849) + lu(k,863) = lu(k,863) - lu(k,703) * lu(k,849) + lu(k,864) = lu(k,864) - lu(k,704) * lu(k,849) + lu(k,866) = lu(k,866) - lu(k,705) * lu(k,849) + lu(k,867) = lu(k,867) - lu(k,706) * lu(k,849) + lu(k,935) = lu(k,935) - lu(k,696) * lu(k,934) + lu(k,936) = lu(k,936) - lu(k,697) * lu(k,934) + lu(k,938) = lu(k,938) - lu(k,698) * lu(k,934) + lu(k,942) = lu(k,942) - lu(k,699) * lu(k,934) + lu(k,943) = lu(k,943) - lu(k,700) * lu(k,934) + lu(k,945) = lu(k,945) - lu(k,701) * lu(k,934) + lu(k,946) = lu(k,946) - lu(k,702) * lu(k,934) + lu(k,948) = lu(k,948) - lu(k,703) * lu(k,934) + lu(k,949) = lu(k,949) - lu(k,704) * lu(k,934) + lu(k,951) = lu(k,951) - lu(k,705) * lu(k,934) + lu(k,952) = lu(k,952) - lu(k,706) * lu(k,934) + lu(k,1001) = lu(k,1001) - lu(k,696) * lu(k,1000) + lu(k,1002) = lu(k,1002) - lu(k,697) * lu(k,1000) + lu(k,1004) = lu(k,1004) - lu(k,698) * lu(k,1000) + lu(k,1008) = lu(k,1008) - lu(k,699) * lu(k,1000) + lu(k,1009) = lu(k,1009) - lu(k,700) * lu(k,1000) + lu(k,1011) = lu(k,1011) - lu(k,701) * lu(k,1000) + lu(k,1012) = lu(k,1012) - lu(k,702) * lu(k,1000) + lu(k,1014) = lu(k,1014) - lu(k,703) * lu(k,1000) + lu(k,1015) = lu(k,1015) - lu(k,704) * lu(k,1000) + lu(k,1017) = lu(k,1017) - lu(k,705) * lu(k,1000) + lu(k,1018) = lu(k,1018) - lu(k,706) * lu(k,1000) + lu(k,1037) = - lu(k,696) * lu(k,1036) + lu(k,1038) = lu(k,1038) - lu(k,697) * lu(k,1036) + lu(k,1040) = lu(k,1040) - lu(k,698) * lu(k,1036) + lu(k,1044) = lu(k,1044) - lu(k,699) * lu(k,1036) + lu(k,1045) = lu(k,1045) - lu(k,700) * lu(k,1036) + lu(k,1047) = lu(k,1047) - lu(k,701) * lu(k,1036) + lu(k,1048) = lu(k,1048) - lu(k,702) * lu(k,1036) + lu(k,1050) = lu(k,1050) - lu(k,703) * lu(k,1036) + lu(k,1051) = lu(k,1051) - lu(k,704) * lu(k,1036) + lu(k,1053) = lu(k,1053) - lu(k,705) * lu(k,1036) + lu(k,1054) = lu(k,1054) - lu(k,706) * lu(k,1036) + lu(k,1159) = lu(k,1159) - lu(k,696) * lu(k,1158) + lu(k,1160) = lu(k,1160) - lu(k,697) * lu(k,1158) + lu(k,1162) = lu(k,1162) - lu(k,698) * lu(k,1158) + lu(k,1166) = lu(k,1166) - lu(k,699) * lu(k,1158) + lu(k,1167) = lu(k,1167) - lu(k,700) * lu(k,1158) + lu(k,1169) = lu(k,1169) - lu(k,701) * lu(k,1158) + lu(k,1170) = lu(k,1170) - lu(k,702) * lu(k,1158) + lu(k,1172) = lu(k,1172) - lu(k,703) * lu(k,1158) + lu(k,1173) = lu(k,1173) - lu(k,704) * lu(k,1158) + lu(k,1175) = lu(k,1175) - lu(k,705) * lu(k,1158) + lu(k,1176) = lu(k,1176) - lu(k,706) * lu(k,1158) + lu(k,1203) = lu(k,1203) - lu(k,696) * lu(k,1202) + lu(k,1204) = lu(k,1204) - lu(k,697) * lu(k,1202) + lu(k,1206) = lu(k,1206) - lu(k,698) * lu(k,1202) + lu(k,1210) = lu(k,1210) - lu(k,699) * lu(k,1202) + lu(k,1211) = lu(k,1211) - lu(k,700) * lu(k,1202) + lu(k,1213) = lu(k,1213) - lu(k,701) * lu(k,1202) + lu(k,1214) = lu(k,1214) - lu(k,702) * lu(k,1202) + lu(k,1216) = lu(k,1216) - lu(k,703) * lu(k,1202) + lu(k,1217) = lu(k,1217) - lu(k,704) * lu(k,1202) + lu(k,1219) = lu(k,1219) - lu(k,705) * lu(k,1202) + lu(k,1220) = lu(k,1220) - lu(k,706) * lu(k,1202) + lu(k,1270) = lu(k,1270) - lu(k,696) * lu(k,1269) + lu(k,1271) = lu(k,1271) - lu(k,697) * lu(k,1269) + lu(k,1273) = lu(k,1273) - lu(k,698) * lu(k,1269) + lu(k,1277) = lu(k,1277) - lu(k,699) * lu(k,1269) + lu(k,1278) = lu(k,1278) - lu(k,700) * lu(k,1269) + lu(k,1280) = lu(k,1280) - lu(k,701) * lu(k,1269) + lu(k,1281) = lu(k,1281) - lu(k,702) * lu(k,1269) + lu(k,1283) = lu(k,1283) - lu(k,703) * lu(k,1269) + lu(k,1284) = lu(k,1284) - lu(k,704) * lu(k,1269) + lu(k,1286) = lu(k,1286) - lu(k,705) * lu(k,1269) + lu(k,1287) = lu(k,1287) - lu(k,706) * lu(k,1269) + end do + end subroutine lu_fac14 + subroutine lu_fac15( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,715) = 1._r8 / lu(k,715) + lu(k,716) = lu(k,716) * lu(k,715) + lu(k,717) = lu(k,717) * lu(k,715) + lu(k,718) = lu(k,718) * lu(k,715) + lu(k,719) = lu(k,719) * lu(k,715) + lu(k,720) = lu(k,720) * lu(k,715) + lu(k,721) = lu(k,721) * lu(k,715) + lu(k,722) = lu(k,722) * lu(k,715) + lu(k,723) = lu(k,723) * lu(k,715) + lu(k,724) = lu(k,724) * lu(k,715) + lu(k,725) = lu(k,725) * lu(k,715) + lu(k,726) = lu(k,726) * lu(k,715) + lu(k,727) = lu(k,727) * lu(k,715) + lu(k,728) = lu(k,728) * lu(k,715) + lu(k,729) = lu(k,729) * lu(k,715) + lu(k,753) = lu(k,753) - lu(k,716) * lu(k,752) + lu(k,754) = lu(k,754) - lu(k,717) * lu(k,752) + lu(k,755) = lu(k,755) - lu(k,718) * lu(k,752) + lu(k,756) = - lu(k,719) * lu(k,752) + lu(k,757) = lu(k,757) - lu(k,720) * lu(k,752) + lu(k,758) = lu(k,758) - lu(k,721) * lu(k,752) + lu(k,759) = lu(k,759) - lu(k,722) * lu(k,752) + lu(k,760) = lu(k,760) - lu(k,723) * lu(k,752) + lu(k,761) = lu(k,761) - lu(k,724) * lu(k,752) + lu(k,762) = - lu(k,725) * lu(k,752) + lu(k,763) = lu(k,763) - lu(k,726) * lu(k,752) + lu(k,764) = lu(k,764) - lu(k,727) * lu(k,752) + lu(k,766) = lu(k,766) - lu(k,728) * lu(k,752) + lu(k,767) = lu(k,767) - lu(k,729) * lu(k,752) + lu(k,851) = lu(k,851) - lu(k,716) * lu(k,850) + lu(k,852) = lu(k,852) - lu(k,717) * lu(k,850) + lu(k,853) = lu(k,853) - lu(k,718) * lu(k,850) + lu(k,855) = lu(k,855) - lu(k,719) * lu(k,850) + lu(k,856) = lu(k,856) - lu(k,720) * lu(k,850) + lu(k,857) = lu(k,857) - lu(k,721) * lu(k,850) + lu(k,858) = lu(k,858) - lu(k,722) * lu(k,850) + lu(k,860) = lu(k,860) - lu(k,723) * lu(k,850) + lu(k,861) = lu(k,861) - lu(k,724) * lu(k,850) + lu(k,862) = lu(k,862) - lu(k,725) * lu(k,850) + lu(k,863) = lu(k,863) - lu(k,726) * lu(k,850) + lu(k,864) = lu(k,864) - lu(k,727) * lu(k,850) + lu(k,866) = lu(k,866) - lu(k,728) * lu(k,850) + lu(k,867) = lu(k,867) - lu(k,729) * lu(k,850) + lu(k,936) = lu(k,936) - lu(k,716) * lu(k,935) + lu(k,937) = lu(k,937) - lu(k,717) * lu(k,935) + lu(k,938) = lu(k,938) - lu(k,718) * lu(k,935) + lu(k,940) = lu(k,940) - lu(k,719) * lu(k,935) + lu(k,941) = lu(k,941) - lu(k,720) * lu(k,935) + lu(k,942) = lu(k,942) - lu(k,721) * lu(k,935) + lu(k,943) = lu(k,943) - lu(k,722) * lu(k,935) + lu(k,945) = lu(k,945) - lu(k,723) * lu(k,935) + lu(k,946) = lu(k,946) - lu(k,724) * lu(k,935) + lu(k,947) = lu(k,947) - lu(k,725) * lu(k,935) + lu(k,948) = lu(k,948) - lu(k,726) * lu(k,935) + lu(k,949) = lu(k,949) - lu(k,727) * lu(k,935) + lu(k,951) = lu(k,951) - lu(k,728) * lu(k,935) + lu(k,952) = lu(k,952) - lu(k,729) * lu(k,935) + lu(k,1002) = lu(k,1002) - lu(k,716) * lu(k,1001) + lu(k,1003) = lu(k,1003) - lu(k,717) * lu(k,1001) + lu(k,1004) = lu(k,1004) - lu(k,718) * lu(k,1001) + lu(k,1006) = lu(k,1006) - lu(k,719) * lu(k,1001) + lu(k,1007) = lu(k,1007) - lu(k,720) * lu(k,1001) + lu(k,1008) = lu(k,1008) - lu(k,721) * lu(k,1001) + lu(k,1009) = lu(k,1009) - lu(k,722) * lu(k,1001) + lu(k,1011) = lu(k,1011) - lu(k,723) * lu(k,1001) + lu(k,1012) = lu(k,1012) - lu(k,724) * lu(k,1001) + lu(k,1013) = lu(k,1013) - lu(k,725) * lu(k,1001) + lu(k,1014) = lu(k,1014) - lu(k,726) * lu(k,1001) + lu(k,1015) = lu(k,1015) - lu(k,727) * lu(k,1001) + lu(k,1017) = lu(k,1017) - lu(k,728) * lu(k,1001) + lu(k,1018) = lu(k,1018) - lu(k,729) * lu(k,1001) + lu(k,1038) = lu(k,1038) - lu(k,716) * lu(k,1037) + lu(k,1039) = lu(k,1039) - lu(k,717) * lu(k,1037) + lu(k,1040) = lu(k,1040) - lu(k,718) * lu(k,1037) + lu(k,1042) = lu(k,1042) - lu(k,719) * lu(k,1037) + lu(k,1043) = lu(k,1043) - lu(k,720) * lu(k,1037) + lu(k,1044) = lu(k,1044) - lu(k,721) * lu(k,1037) + lu(k,1045) = lu(k,1045) - lu(k,722) * lu(k,1037) + lu(k,1047) = lu(k,1047) - lu(k,723) * lu(k,1037) + lu(k,1048) = lu(k,1048) - lu(k,724) * lu(k,1037) + lu(k,1049) = lu(k,1049) - lu(k,725) * lu(k,1037) + lu(k,1050) = lu(k,1050) - lu(k,726) * lu(k,1037) + lu(k,1051) = lu(k,1051) - lu(k,727) * lu(k,1037) + lu(k,1053) = lu(k,1053) - lu(k,728) * lu(k,1037) + lu(k,1054) = lu(k,1054) - lu(k,729) * lu(k,1037) + lu(k,1160) = lu(k,1160) - lu(k,716) * lu(k,1159) + lu(k,1161) = lu(k,1161) - lu(k,717) * lu(k,1159) + lu(k,1162) = lu(k,1162) - lu(k,718) * lu(k,1159) + lu(k,1164) = lu(k,1164) - lu(k,719) * lu(k,1159) + lu(k,1165) = lu(k,1165) - lu(k,720) * lu(k,1159) + lu(k,1166) = lu(k,1166) - lu(k,721) * lu(k,1159) + lu(k,1167) = lu(k,1167) - lu(k,722) * lu(k,1159) + lu(k,1169) = lu(k,1169) - lu(k,723) * lu(k,1159) + lu(k,1170) = lu(k,1170) - lu(k,724) * lu(k,1159) + lu(k,1171) = lu(k,1171) - lu(k,725) * lu(k,1159) + lu(k,1172) = lu(k,1172) - lu(k,726) * lu(k,1159) + lu(k,1173) = lu(k,1173) - lu(k,727) * lu(k,1159) + lu(k,1175) = lu(k,1175) - lu(k,728) * lu(k,1159) + lu(k,1176) = lu(k,1176) - lu(k,729) * lu(k,1159) + lu(k,1204) = lu(k,1204) - lu(k,716) * lu(k,1203) + lu(k,1205) = lu(k,1205) - lu(k,717) * lu(k,1203) + lu(k,1206) = lu(k,1206) - lu(k,718) * lu(k,1203) + lu(k,1208) = lu(k,1208) - lu(k,719) * lu(k,1203) + lu(k,1209) = lu(k,1209) - lu(k,720) * lu(k,1203) + lu(k,1210) = lu(k,1210) - lu(k,721) * lu(k,1203) + lu(k,1211) = lu(k,1211) - lu(k,722) * lu(k,1203) + lu(k,1213) = lu(k,1213) - lu(k,723) * lu(k,1203) + lu(k,1214) = lu(k,1214) - lu(k,724) * lu(k,1203) + lu(k,1215) = lu(k,1215) - lu(k,725) * lu(k,1203) + lu(k,1216) = lu(k,1216) - lu(k,726) * lu(k,1203) + lu(k,1217) = lu(k,1217) - lu(k,727) * lu(k,1203) + lu(k,1219) = lu(k,1219) - lu(k,728) * lu(k,1203) + lu(k,1220) = lu(k,1220) - lu(k,729) * lu(k,1203) + lu(k,1271) = lu(k,1271) - lu(k,716) * lu(k,1270) + lu(k,1272) = lu(k,1272) - lu(k,717) * lu(k,1270) + lu(k,1273) = lu(k,1273) - lu(k,718) * lu(k,1270) + lu(k,1275) = - lu(k,719) * lu(k,1270) + lu(k,1276) = lu(k,1276) - lu(k,720) * lu(k,1270) + lu(k,1277) = lu(k,1277) - lu(k,721) * lu(k,1270) + lu(k,1278) = lu(k,1278) - lu(k,722) * lu(k,1270) + lu(k,1280) = lu(k,1280) - lu(k,723) * lu(k,1270) + lu(k,1281) = lu(k,1281) - lu(k,724) * lu(k,1270) + lu(k,1282) = lu(k,1282) - lu(k,725) * lu(k,1270) + lu(k,1283) = lu(k,1283) - lu(k,726) * lu(k,1270) + lu(k,1284) = lu(k,1284) - lu(k,727) * lu(k,1270) + lu(k,1286) = lu(k,1286) - lu(k,728) * lu(k,1270) + lu(k,1287) = lu(k,1287) - lu(k,729) * lu(k,1270) + lu(k,753) = 1._r8 / lu(k,753) + lu(k,754) = lu(k,754) * lu(k,753) + lu(k,755) = lu(k,755) * lu(k,753) + lu(k,756) = lu(k,756) * lu(k,753) + lu(k,757) = lu(k,757) * lu(k,753) + lu(k,758) = lu(k,758) * lu(k,753) + lu(k,759) = lu(k,759) * lu(k,753) + lu(k,760) = lu(k,760) * lu(k,753) + lu(k,761) = lu(k,761) * lu(k,753) + lu(k,762) = lu(k,762) * lu(k,753) + lu(k,763) = lu(k,763) * lu(k,753) + lu(k,764) = lu(k,764) * lu(k,753) + lu(k,765) = lu(k,765) * lu(k,753) + lu(k,766) = lu(k,766) * lu(k,753) + lu(k,767) = lu(k,767) * lu(k,753) + lu(k,852) = lu(k,852) - lu(k,754) * lu(k,851) + lu(k,853) = lu(k,853) - lu(k,755) * lu(k,851) + lu(k,855) = lu(k,855) - lu(k,756) * lu(k,851) + lu(k,856) = lu(k,856) - lu(k,757) * lu(k,851) + lu(k,857) = lu(k,857) - lu(k,758) * lu(k,851) + lu(k,858) = lu(k,858) - lu(k,759) * lu(k,851) + lu(k,860) = lu(k,860) - lu(k,760) * lu(k,851) + lu(k,861) = lu(k,861) - lu(k,761) * lu(k,851) + lu(k,862) = lu(k,862) - lu(k,762) * lu(k,851) + lu(k,863) = lu(k,863) - lu(k,763) * lu(k,851) + lu(k,864) = lu(k,864) - lu(k,764) * lu(k,851) + lu(k,865) = lu(k,865) - lu(k,765) * lu(k,851) + lu(k,866) = lu(k,866) - lu(k,766) * lu(k,851) + lu(k,867) = lu(k,867) - lu(k,767) * lu(k,851) + lu(k,937) = lu(k,937) - lu(k,754) * lu(k,936) + lu(k,938) = lu(k,938) - lu(k,755) * lu(k,936) + lu(k,940) = lu(k,940) - lu(k,756) * lu(k,936) + lu(k,941) = lu(k,941) - lu(k,757) * lu(k,936) + lu(k,942) = lu(k,942) - lu(k,758) * lu(k,936) + lu(k,943) = lu(k,943) - lu(k,759) * lu(k,936) + lu(k,945) = lu(k,945) - lu(k,760) * lu(k,936) + lu(k,946) = lu(k,946) - lu(k,761) * lu(k,936) + lu(k,947) = lu(k,947) - lu(k,762) * lu(k,936) + lu(k,948) = lu(k,948) - lu(k,763) * lu(k,936) + lu(k,949) = lu(k,949) - lu(k,764) * lu(k,936) + lu(k,950) = lu(k,950) - lu(k,765) * lu(k,936) + lu(k,951) = lu(k,951) - lu(k,766) * lu(k,936) + lu(k,952) = lu(k,952) - lu(k,767) * lu(k,936) + lu(k,1003) = lu(k,1003) - lu(k,754) * lu(k,1002) + lu(k,1004) = lu(k,1004) - lu(k,755) * lu(k,1002) + lu(k,1006) = lu(k,1006) - lu(k,756) * lu(k,1002) + lu(k,1007) = lu(k,1007) - lu(k,757) * lu(k,1002) + lu(k,1008) = lu(k,1008) - lu(k,758) * lu(k,1002) + lu(k,1009) = lu(k,1009) - lu(k,759) * lu(k,1002) + lu(k,1011) = lu(k,1011) - lu(k,760) * lu(k,1002) + lu(k,1012) = lu(k,1012) - lu(k,761) * lu(k,1002) + lu(k,1013) = lu(k,1013) - lu(k,762) * lu(k,1002) + lu(k,1014) = lu(k,1014) - lu(k,763) * lu(k,1002) + lu(k,1015) = lu(k,1015) - lu(k,764) * lu(k,1002) + lu(k,1016) = lu(k,1016) - lu(k,765) * lu(k,1002) + lu(k,1017) = lu(k,1017) - lu(k,766) * lu(k,1002) + lu(k,1018) = lu(k,1018) - lu(k,767) * lu(k,1002) + lu(k,1039) = lu(k,1039) - lu(k,754) * lu(k,1038) + lu(k,1040) = lu(k,1040) - lu(k,755) * lu(k,1038) + lu(k,1042) = lu(k,1042) - lu(k,756) * lu(k,1038) + lu(k,1043) = lu(k,1043) - lu(k,757) * lu(k,1038) + lu(k,1044) = lu(k,1044) - lu(k,758) * lu(k,1038) + lu(k,1045) = lu(k,1045) - lu(k,759) * lu(k,1038) + lu(k,1047) = lu(k,1047) - lu(k,760) * lu(k,1038) + lu(k,1048) = lu(k,1048) - lu(k,761) * lu(k,1038) + lu(k,1049) = lu(k,1049) - lu(k,762) * lu(k,1038) + lu(k,1050) = lu(k,1050) - lu(k,763) * lu(k,1038) + lu(k,1051) = lu(k,1051) - lu(k,764) * lu(k,1038) + lu(k,1052) = lu(k,1052) - lu(k,765) * lu(k,1038) + lu(k,1053) = lu(k,1053) - lu(k,766) * lu(k,1038) + lu(k,1054) = lu(k,1054) - lu(k,767) * lu(k,1038) + lu(k,1076) = lu(k,1076) - lu(k,754) * lu(k,1075) + lu(k,1077) = lu(k,1077) - lu(k,755) * lu(k,1075) + lu(k,1079) = lu(k,1079) - lu(k,756) * lu(k,1075) + lu(k,1080) = lu(k,1080) - lu(k,757) * lu(k,1075) + lu(k,1081) = lu(k,1081) - lu(k,758) * lu(k,1075) + lu(k,1082) = lu(k,1082) - lu(k,759) * lu(k,1075) + lu(k,1084) = lu(k,1084) - lu(k,760) * lu(k,1075) + lu(k,1085) = - lu(k,761) * lu(k,1075) + lu(k,1086) = lu(k,1086) - lu(k,762) * lu(k,1075) + lu(k,1087) = lu(k,1087) - lu(k,763) * lu(k,1075) + lu(k,1088) = - lu(k,764) * lu(k,1075) + lu(k,1089) = lu(k,1089) - lu(k,765) * lu(k,1075) + lu(k,1090) = lu(k,1090) - lu(k,766) * lu(k,1075) + lu(k,1091) = lu(k,1091) - lu(k,767) * lu(k,1075) + lu(k,1161) = lu(k,1161) - lu(k,754) * lu(k,1160) + lu(k,1162) = lu(k,1162) - lu(k,755) * lu(k,1160) + lu(k,1164) = lu(k,1164) - lu(k,756) * lu(k,1160) + lu(k,1165) = lu(k,1165) - lu(k,757) * lu(k,1160) + lu(k,1166) = lu(k,1166) - lu(k,758) * lu(k,1160) + lu(k,1167) = lu(k,1167) - lu(k,759) * lu(k,1160) + lu(k,1169) = lu(k,1169) - lu(k,760) * lu(k,1160) + lu(k,1170) = lu(k,1170) - lu(k,761) * lu(k,1160) + lu(k,1171) = lu(k,1171) - lu(k,762) * lu(k,1160) + lu(k,1172) = lu(k,1172) - lu(k,763) * lu(k,1160) + lu(k,1173) = lu(k,1173) - lu(k,764) * lu(k,1160) + lu(k,1174) = lu(k,1174) - lu(k,765) * lu(k,1160) + lu(k,1175) = lu(k,1175) - lu(k,766) * lu(k,1160) + lu(k,1176) = lu(k,1176) - lu(k,767) * lu(k,1160) + lu(k,1205) = lu(k,1205) - lu(k,754) * lu(k,1204) + lu(k,1206) = lu(k,1206) - lu(k,755) * lu(k,1204) + lu(k,1208) = lu(k,1208) - lu(k,756) * lu(k,1204) + lu(k,1209) = lu(k,1209) - lu(k,757) * lu(k,1204) + lu(k,1210) = lu(k,1210) - lu(k,758) * lu(k,1204) + lu(k,1211) = lu(k,1211) - lu(k,759) * lu(k,1204) + lu(k,1213) = lu(k,1213) - lu(k,760) * lu(k,1204) + lu(k,1214) = lu(k,1214) - lu(k,761) * lu(k,1204) + lu(k,1215) = lu(k,1215) - lu(k,762) * lu(k,1204) + lu(k,1216) = lu(k,1216) - lu(k,763) * lu(k,1204) + lu(k,1217) = lu(k,1217) - lu(k,764) * lu(k,1204) + lu(k,1218) = lu(k,1218) - lu(k,765) * lu(k,1204) + lu(k,1219) = lu(k,1219) - lu(k,766) * lu(k,1204) + lu(k,1220) = lu(k,1220) - lu(k,767) * lu(k,1204) + lu(k,1230) = lu(k,1230) - lu(k,754) * lu(k,1229) + lu(k,1231) = lu(k,1231) - lu(k,755) * lu(k,1229) + lu(k,1233) = lu(k,1233) - lu(k,756) * lu(k,1229) + lu(k,1234) = lu(k,1234) - lu(k,757) * lu(k,1229) + lu(k,1235) = lu(k,1235) - lu(k,758) * lu(k,1229) + lu(k,1236) = lu(k,1236) - lu(k,759) * lu(k,1229) + lu(k,1238) = lu(k,1238) - lu(k,760) * lu(k,1229) + lu(k,1239) = lu(k,1239) - lu(k,761) * lu(k,1229) + lu(k,1240) = - lu(k,762) * lu(k,1229) + lu(k,1241) = lu(k,1241) - lu(k,763) * lu(k,1229) + lu(k,1242) = lu(k,1242) - lu(k,764) * lu(k,1229) + lu(k,1243) = lu(k,1243) - lu(k,765) * lu(k,1229) + lu(k,1244) = lu(k,1244) - lu(k,766) * lu(k,1229) + lu(k,1245) = lu(k,1245) - lu(k,767) * lu(k,1229) + lu(k,1272) = lu(k,1272) - lu(k,754) * lu(k,1271) + lu(k,1273) = lu(k,1273) - lu(k,755) * lu(k,1271) + lu(k,1275) = lu(k,1275) - lu(k,756) * lu(k,1271) + lu(k,1276) = lu(k,1276) - lu(k,757) * lu(k,1271) + lu(k,1277) = lu(k,1277) - lu(k,758) * lu(k,1271) + lu(k,1278) = lu(k,1278) - lu(k,759) * lu(k,1271) + lu(k,1280) = lu(k,1280) - lu(k,760) * lu(k,1271) + lu(k,1281) = lu(k,1281) - lu(k,761) * lu(k,1271) + lu(k,1282) = lu(k,1282) - lu(k,762) * lu(k,1271) + lu(k,1283) = lu(k,1283) - lu(k,763) * lu(k,1271) + lu(k,1284) = lu(k,1284) - lu(k,764) * lu(k,1271) + lu(k,1285) = lu(k,1285) - lu(k,765) * lu(k,1271) + lu(k,1286) = lu(k,1286) - lu(k,766) * lu(k,1271) + lu(k,1287) = lu(k,1287) - lu(k,767) * lu(k,1271) + lu(k,769) = 1._r8 / lu(k,769) + lu(k,770) = lu(k,770) * lu(k,769) + lu(k,771) = lu(k,771) * lu(k,769) + lu(k,772) = lu(k,772) * lu(k,769) + lu(k,773) = lu(k,773) * lu(k,769) + lu(k,774) = lu(k,774) * lu(k,769) + lu(k,775) = lu(k,775) * lu(k,769) + lu(k,776) = lu(k,776) * lu(k,769) + lu(k,777) = lu(k,777) * lu(k,769) + lu(k,785) = lu(k,785) - lu(k,770) * lu(k,782) + lu(k,786) = lu(k,786) - lu(k,771) * lu(k,782) + lu(k,787) = lu(k,787) - lu(k,772) * lu(k,782) + lu(k,788) = lu(k,788) - lu(k,773) * lu(k,782) + lu(k,790) = - lu(k,774) * lu(k,782) + lu(k,792) = lu(k,792) - lu(k,775) * lu(k,782) + lu(k,793) = lu(k,793) - lu(k,776) * lu(k,782) + lu(k,795) = lu(k,795) - lu(k,777) * lu(k,782) + lu(k,801) = - lu(k,770) * lu(k,798) + lu(k,802) = - lu(k,771) * lu(k,798) + lu(k,803) = lu(k,803) - lu(k,772) * lu(k,798) + lu(k,804) = lu(k,804) - lu(k,773) * lu(k,798) + lu(k,806) = lu(k,806) - lu(k,774) * lu(k,798) + lu(k,808) = lu(k,808) - lu(k,775) * lu(k,798) + lu(k,809) = lu(k,809) - lu(k,776) * lu(k,798) + lu(k,811) = lu(k,811) - lu(k,777) * lu(k,798) + lu(k,820) = lu(k,820) - lu(k,770) * lu(k,818) + lu(k,821) = lu(k,821) - lu(k,771) * lu(k,818) + lu(k,822) = lu(k,822) - lu(k,772) * lu(k,818) + lu(k,823) = - lu(k,773) * lu(k,818) + lu(k,825) = - lu(k,774) * lu(k,818) + lu(k,827) = lu(k,827) - lu(k,775) * lu(k,818) + lu(k,828) = lu(k,828) - lu(k,776) * lu(k,818) + lu(k,831) = lu(k,831) - lu(k,777) * lu(k,818) + lu(k,855) = lu(k,855) - lu(k,770) * lu(k,852) + lu(k,856) = lu(k,856) - lu(k,771) * lu(k,852) + lu(k,857) = lu(k,857) - lu(k,772) * lu(k,852) + lu(k,858) = lu(k,858) - lu(k,773) * lu(k,852) + lu(k,860) = lu(k,860) - lu(k,774) * lu(k,852) + lu(k,862) = lu(k,862) - lu(k,775) * lu(k,852) + lu(k,863) = lu(k,863) - lu(k,776) * lu(k,852) + lu(k,867) = lu(k,867) - lu(k,777) * lu(k,852) + lu(k,884) = lu(k,884) - lu(k,770) * lu(k,881) + lu(k,885) = lu(k,885) - lu(k,771) * lu(k,881) + lu(k,886) = lu(k,886) - lu(k,772) * lu(k,881) + lu(k,887) = lu(k,887) - lu(k,773) * lu(k,881) + lu(k,889) = lu(k,889) - lu(k,774) * lu(k,881) + lu(k,891) = lu(k,891) - lu(k,775) * lu(k,881) + lu(k,892) = lu(k,892) - lu(k,776) * lu(k,881) + lu(k,896) = lu(k,896) - lu(k,777) * lu(k,881) + lu(k,940) = lu(k,940) - lu(k,770) * lu(k,937) + lu(k,941) = lu(k,941) - lu(k,771) * lu(k,937) + lu(k,942) = lu(k,942) - lu(k,772) * lu(k,937) + lu(k,943) = lu(k,943) - lu(k,773) * lu(k,937) + lu(k,945) = lu(k,945) - lu(k,774) * lu(k,937) + lu(k,947) = lu(k,947) - lu(k,775) * lu(k,937) + lu(k,948) = lu(k,948) - lu(k,776) * lu(k,937) + lu(k,952) = lu(k,952) - lu(k,777) * lu(k,937) + lu(k,962) = lu(k,962) - lu(k,770) * lu(k,960) + lu(k,963) = lu(k,963) - lu(k,771) * lu(k,960) + lu(k,964) = lu(k,964) - lu(k,772) * lu(k,960) + lu(k,965) = lu(k,965) - lu(k,773) * lu(k,960) + lu(k,967) = lu(k,967) - lu(k,774) * lu(k,960) + lu(k,969) = - lu(k,775) * lu(k,960) + lu(k,970) = lu(k,970) - lu(k,776) * lu(k,960) + lu(k,974) = lu(k,974) - lu(k,777) * lu(k,960) + lu(k,1006) = lu(k,1006) - lu(k,770) * lu(k,1003) + lu(k,1007) = lu(k,1007) - lu(k,771) * lu(k,1003) + lu(k,1008) = lu(k,1008) - lu(k,772) * lu(k,1003) + lu(k,1009) = lu(k,1009) - lu(k,773) * lu(k,1003) + lu(k,1011) = lu(k,1011) - lu(k,774) * lu(k,1003) + lu(k,1013) = lu(k,1013) - lu(k,775) * lu(k,1003) + lu(k,1014) = lu(k,1014) - lu(k,776) * lu(k,1003) + lu(k,1018) = lu(k,1018) - lu(k,777) * lu(k,1003) + lu(k,1042) = lu(k,1042) - lu(k,770) * lu(k,1039) + lu(k,1043) = lu(k,1043) - lu(k,771) * lu(k,1039) + lu(k,1044) = lu(k,1044) - lu(k,772) * lu(k,1039) + lu(k,1045) = lu(k,1045) - lu(k,773) * lu(k,1039) + lu(k,1047) = lu(k,1047) - lu(k,774) * lu(k,1039) + lu(k,1049) = lu(k,1049) - lu(k,775) * lu(k,1039) + lu(k,1050) = lu(k,1050) - lu(k,776) * lu(k,1039) + lu(k,1054) = lu(k,1054) - lu(k,777) * lu(k,1039) + lu(k,1079) = lu(k,1079) - lu(k,770) * lu(k,1076) + lu(k,1080) = lu(k,1080) - lu(k,771) * lu(k,1076) + lu(k,1081) = lu(k,1081) - lu(k,772) * lu(k,1076) + lu(k,1082) = lu(k,1082) - lu(k,773) * lu(k,1076) + lu(k,1084) = lu(k,1084) - lu(k,774) * lu(k,1076) + lu(k,1086) = lu(k,1086) - lu(k,775) * lu(k,1076) + lu(k,1087) = lu(k,1087) - lu(k,776) * lu(k,1076) + lu(k,1091) = lu(k,1091) - lu(k,777) * lu(k,1076) + lu(k,1164) = lu(k,1164) - lu(k,770) * lu(k,1161) + lu(k,1165) = lu(k,1165) - lu(k,771) * lu(k,1161) + lu(k,1166) = lu(k,1166) - lu(k,772) * lu(k,1161) + lu(k,1167) = lu(k,1167) - lu(k,773) * lu(k,1161) + lu(k,1169) = lu(k,1169) - lu(k,774) * lu(k,1161) + lu(k,1171) = lu(k,1171) - lu(k,775) * lu(k,1161) + lu(k,1172) = lu(k,1172) - lu(k,776) * lu(k,1161) + lu(k,1176) = lu(k,1176) - lu(k,777) * lu(k,1161) + lu(k,1208) = lu(k,1208) - lu(k,770) * lu(k,1205) + lu(k,1209) = lu(k,1209) - lu(k,771) * lu(k,1205) + lu(k,1210) = lu(k,1210) - lu(k,772) * lu(k,1205) + lu(k,1211) = lu(k,1211) - lu(k,773) * lu(k,1205) + lu(k,1213) = lu(k,1213) - lu(k,774) * lu(k,1205) + lu(k,1215) = lu(k,1215) - lu(k,775) * lu(k,1205) + lu(k,1216) = lu(k,1216) - lu(k,776) * lu(k,1205) + lu(k,1220) = lu(k,1220) - lu(k,777) * lu(k,1205) + lu(k,1233) = lu(k,1233) - lu(k,770) * lu(k,1230) + lu(k,1234) = lu(k,1234) - lu(k,771) * lu(k,1230) + lu(k,1235) = lu(k,1235) - lu(k,772) * lu(k,1230) + lu(k,1236) = lu(k,1236) - lu(k,773) * lu(k,1230) + lu(k,1238) = lu(k,1238) - lu(k,774) * lu(k,1230) + lu(k,1240) = lu(k,1240) - lu(k,775) * lu(k,1230) + lu(k,1241) = lu(k,1241) - lu(k,776) * lu(k,1230) + lu(k,1245) = lu(k,1245) - lu(k,777) * lu(k,1230) + lu(k,1275) = lu(k,1275) - lu(k,770) * lu(k,1272) + lu(k,1276) = lu(k,1276) - lu(k,771) * lu(k,1272) + lu(k,1277) = lu(k,1277) - lu(k,772) * lu(k,1272) + lu(k,1278) = lu(k,1278) - lu(k,773) * lu(k,1272) + lu(k,1280) = lu(k,1280) - lu(k,774) * lu(k,1272) + lu(k,1282) = lu(k,1282) - lu(k,775) * lu(k,1272) + lu(k,1283) = lu(k,1283) - lu(k,776) * lu(k,1272) + lu(k,1287) = lu(k,1287) - lu(k,777) * lu(k,1272) + lu(k,1295) = lu(k,1295) - lu(k,770) * lu(k,1293) + lu(k,1296) = lu(k,1296) - lu(k,771) * lu(k,1293) + lu(k,1297) = lu(k,1297) - lu(k,772) * lu(k,1293) + lu(k,1298) = lu(k,1298) - lu(k,773) * lu(k,1293) + lu(k,1300) = lu(k,1300) - lu(k,774) * lu(k,1293) + lu(k,1302) = lu(k,1302) - lu(k,775) * lu(k,1293) + lu(k,1303) = lu(k,1303) - lu(k,776) * lu(k,1293) + lu(k,1307) = lu(k,1307) - lu(k,777) * lu(k,1293) + end do + end subroutine lu_fac15 + subroutine lu_fac16( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,783) = 1._r8 / lu(k,783) + lu(k,784) = lu(k,784) * lu(k,783) + lu(k,785) = lu(k,785) * lu(k,783) + lu(k,786) = lu(k,786) * lu(k,783) + lu(k,787) = lu(k,787) * lu(k,783) + lu(k,788) = lu(k,788) * lu(k,783) + lu(k,789) = lu(k,789) * lu(k,783) + lu(k,790) = lu(k,790) * lu(k,783) + lu(k,791) = lu(k,791) * lu(k,783) + lu(k,792) = lu(k,792) * lu(k,783) + lu(k,793) = lu(k,793) * lu(k,783) + lu(k,794) = lu(k,794) * lu(k,783) + lu(k,795) = lu(k,795) * lu(k,783) + lu(k,800) = lu(k,800) - lu(k,784) * lu(k,799) + lu(k,801) = lu(k,801) - lu(k,785) * lu(k,799) + lu(k,802) = lu(k,802) - lu(k,786) * lu(k,799) + lu(k,803) = lu(k,803) - lu(k,787) * lu(k,799) + lu(k,804) = lu(k,804) - lu(k,788) * lu(k,799) + lu(k,805) = lu(k,805) - lu(k,789) * lu(k,799) + lu(k,806) = lu(k,806) - lu(k,790) * lu(k,799) + lu(k,807) = - lu(k,791) * lu(k,799) + lu(k,808) = lu(k,808) - lu(k,792) * lu(k,799) + lu(k,809) = lu(k,809) - lu(k,793) * lu(k,799) + lu(k,810) = - lu(k,794) * lu(k,799) + lu(k,811) = lu(k,811) - lu(k,795) * lu(k,799) + lu(k,854) = lu(k,854) - lu(k,784) * lu(k,853) + lu(k,855) = lu(k,855) - lu(k,785) * lu(k,853) + lu(k,856) = lu(k,856) - lu(k,786) * lu(k,853) + lu(k,857) = lu(k,857) - lu(k,787) * lu(k,853) + lu(k,858) = lu(k,858) - lu(k,788) * lu(k,853) + lu(k,859) = - lu(k,789) * lu(k,853) + lu(k,860) = lu(k,860) - lu(k,790) * lu(k,853) + lu(k,861) = lu(k,861) - lu(k,791) * lu(k,853) + lu(k,862) = lu(k,862) - lu(k,792) * lu(k,853) + lu(k,863) = lu(k,863) - lu(k,793) * lu(k,853) + lu(k,864) = lu(k,864) - lu(k,794) * lu(k,853) + lu(k,867) = lu(k,867) - lu(k,795) * lu(k,853) + lu(k,883) = lu(k,883) - lu(k,784) * lu(k,882) + lu(k,884) = lu(k,884) - lu(k,785) * lu(k,882) + lu(k,885) = lu(k,885) - lu(k,786) * lu(k,882) + lu(k,886) = lu(k,886) - lu(k,787) * lu(k,882) + lu(k,887) = lu(k,887) - lu(k,788) * lu(k,882) + lu(k,888) = lu(k,888) - lu(k,789) * lu(k,882) + lu(k,889) = lu(k,889) - lu(k,790) * lu(k,882) + lu(k,890) = lu(k,890) - lu(k,791) * lu(k,882) + lu(k,891) = lu(k,891) - lu(k,792) * lu(k,882) + lu(k,892) = lu(k,892) - lu(k,793) * lu(k,882) + lu(k,893) = lu(k,893) - lu(k,794) * lu(k,882) + lu(k,896) = lu(k,896) - lu(k,795) * lu(k,882) + lu(k,939) = lu(k,939) - lu(k,784) * lu(k,938) + lu(k,940) = lu(k,940) - lu(k,785) * lu(k,938) + lu(k,941) = lu(k,941) - lu(k,786) * lu(k,938) + lu(k,942) = lu(k,942) - lu(k,787) * lu(k,938) + lu(k,943) = lu(k,943) - lu(k,788) * lu(k,938) + lu(k,944) = lu(k,944) - lu(k,789) * lu(k,938) + lu(k,945) = lu(k,945) - lu(k,790) * lu(k,938) + lu(k,946) = lu(k,946) - lu(k,791) * lu(k,938) + lu(k,947) = lu(k,947) - lu(k,792) * lu(k,938) + lu(k,948) = lu(k,948) - lu(k,793) * lu(k,938) + lu(k,949) = lu(k,949) - lu(k,794) * lu(k,938) + lu(k,952) = lu(k,952) - lu(k,795) * lu(k,938) + lu(k,1005) = lu(k,1005) - lu(k,784) * lu(k,1004) + lu(k,1006) = lu(k,1006) - lu(k,785) * lu(k,1004) + lu(k,1007) = lu(k,1007) - lu(k,786) * lu(k,1004) + lu(k,1008) = lu(k,1008) - lu(k,787) * lu(k,1004) + lu(k,1009) = lu(k,1009) - lu(k,788) * lu(k,1004) + lu(k,1010) = lu(k,1010) - lu(k,789) * lu(k,1004) + lu(k,1011) = lu(k,1011) - lu(k,790) * lu(k,1004) + lu(k,1012) = lu(k,1012) - lu(k,791) * lu(k,1004) + lu(k,1013) = lu(k,1013) - lu(k,792) * lu(k,1004) + lu(k,1014) = lu(k,1014) - lu(k,793) * lu(k,1004) + lu(k,1015) = lu(k,1015) - lu(k,794) * lu(k,1004) + lu(k,1018) = lu(k,1018) - lu(k,795) * lu(k,1004) + lu(k,1041) = lu(k,1041) - lu(k,784) * lu(k,1040) + lu(k,1042) = lu(k,1042) - lu(k,785) * lu(k,1040) + lu(k,1043) = lu(k,1043) - lu(k,786) * lu(k,1040) + lu(k,1044) = lu(k,1044) - lu(k,787) * lu(k,1040) + lu(k,1045) = lu(k,1045) - lu(k,788) * lu(k,1040) + lu(k,1046) = lu(k,1046) - lu(k,789) * lu(k,1040) + lu(k,1047) = lu(k,1047) - lu(k,790) * lu(k,1040) + lu(k,1048) = lu(k,1048) - lu(k,791) * lu(k,1040) + lu(k,1049) = lu(k,1049) - lu(k,792) * lu(k,1040) + lu(k,1050) = lu(k,1050) - lu(k,793) * lu(k,1040) + lu(k,1051) = lu(k,1051) - lu(k,794) * lu(k,1040) + lu(k,1054) = lu(k,1054) - lu(k,795) * lu(k,1040) + lu(k,1078) = lu(k,1078) - lu(k,784) * lu(k,1077) + lu(k,1079) = lu(k,1079) - lu(k,785) * lu(k,1077) + lu(k,1080) = lu(k,1080) - lu(k,786) * lu(k,1077) + lu(k,1081) = lu(k,1081) - lu(k,787) * lu(k,1077) + lu(k,1082) = lu(k,1082) - lu(k,788) * lu(k,1077) + lu(k,1083) = lu(k,1083) - lu(k,789) * lu(k,1077) + lu(k,1084) = lu(k,1084) - lu(k,790) * lu(k,1077) + lu(k,1085) = lu(k,1085) - lu(k,791) * lu(k,1077) + lu(k,1086) = lu(k,1086) - lu(k,792) * lu(k,1077) + lu(k,1087) = lu(k,1087) - lu(k,793) * lu(k,1077) + lu(k,1088) = lu(k,1088) - lu(k,794) * lu(k,1077) + lu(k,1091) = lu(k,1091) - lu(k,795) * lu(k,1077) + lu(k,1163) = lu(k,1163) - lu(k,784) * lu(k,1162) + lu(k,1164) = lu(k,1164) - lu(k,785) * lu(k,1162) + lu(k,1165) = lu(k,1165) - lu(k,786) * lu(k,1162) + lu(k,1166) = lu(k,1166) - lu(k,787) * lu(k,1162) + lu(k,1167) = lu(k,1167) - lu(k,788) * lu(k,1162) + lu(k,1168) = lu(k,1168) - lu(k,789) * lu(k,1162) + lu(k,1169) = lu(k,1169) - lu(k,790) * lu(k,1162) + lu(k,1170) = lu(k,1170) - lu(k,791) * lu(k,1162) + lu(k,1171) = lu(k,1171) - lu(k,792) * lu(k,1162) + lu(k,1172) = lu(k,1172) - lu(k,793) * lu(k,1162) + lu(k,1173) = lu(k,1173) - lu(k,794) * lu(k,1162) + lu(k,1176) = lu(k,1176) - lu(k,795) * lu(k,1162) + lu(k,1207) = lu(k,1207) - lu(k,784) * lu(k,1206) + lu(k,1208) = lu(k,1208) - lu(k,785) * lu(k,1206) + lu(k,1209) = lu(k,1209) - lu(k,786) * lu(k,1206) + lu(k,1210) = lu(k,1210) - lu(k,787) * lu(k,1206) + lu(k,1211) = lu(k,1211) - lu(k,788) * lu(k,1206) + lu(k,1212) = lu(k,1212) - lu(k,789) * lu(k,1206) + lu(k,1213) = lu(k,1213) - lu(k,790) * lu(k,1206) + lu(k,1214) = lu(k,1214) - lu(k,791) * lu(k,1206) + lu(k,1215) = lu(k,1215) - lu(k,792) * lu(k,1206) + lu(k,1216) = lu(k,1216) - lu(k,793) * lu(k,1206) + lu(k,1217) = lu(k,1217) - lu(k,794) * lu(k,1206) + lu(k,1220) = lu(k,1220) - lu(k,795) * lu(k,1206) + lu(k,1232) = lu(k,1232) - lu(k,784) * lu(k,1231) + lu(k,1233) = lu(k,1233) - lu(k,785) * lu(k,1231) + lu(k,1234) = lu(k,1234) - lu(k,786) * lu(k,1231) + lu(k,1235) = lu(k,1235) - lu(k,787) * lu(k,1231) + lu(k,1236) = lu(k,1236) - lu(k,788) * lu(k,1231) + lu(k,1237) = lu(k,1237) - lu(k,789) * lu(k,1231) + lu(k,1238) = lu(k,1238) - lu(k,790) * lu(k,1231) + lu(k,1239) = lu(k,1239) - lu(k,791) * lu(k,1231) + lu(k,1240) = lu(k,1240) - lu(k,792) * lu(k,1231) + lu(k,1241) = lu(k,1241) - lu(k,793) * lu(k,1231) + lu(k,1242) = lu(k,1242) - lu(k,794) * lu(k,1231) + lu(k,1245) = lu(k,1245) - lu(k,795) * lu(k,1231) + lu(k,1274) = lu(k,1274) - lu(k,784) * lu(k,1273) + lu(k,1275) = lu(k,1275) - lu(k,785) * lu(k,1273) + lu(k,1276) = lu(k,1276) - lu(k,786) * lu(k,1273) + lu(k,1277) = lu(k,1277) - lu(k,787) * lu(k,1273) + lu(k,1278) = lu(k,1278) - lu(k,788) * lu(k,1273) + lu(k,1279) = lu(k,1279) - lu(k,789) * lu(k,1273) + lu(k,1280) = lu(k,1280) - lu(k,790) * lu(k,1273) + lu(k,1281) = lu(k,1281) - lu(k,791) * lu(k,1273) + lu(k,1282) = lu(k,1282) - lu(k,792) * lu(k,1273) + lu(k,1283) = lu(k,1283) - lu(k,793) * lu(k,1273) + lu(k,1284) = lu(k,1284) - lu(k,794) * lu(k,1273) + lu(k,1287) = lu(k,1287) - lu(k,795) * lu(k,1273) + lu(k,800) = 1._r8 / lu(k,800) + lu(k,801) = lu(k,801) * lu(k,800) + lu(k,802) = lu(k,802) * lu(k,800) + lu(k,803) = lu(k,803) * lu(k,800) + lu(k,804) = lu(k,804) * lu(k,800) + lu(k,805) = lu(k,805) * lu(k,800) + lu(k,806) = lu(k,806) * lu(k,800) + lu(k,807) = lu(k,807) * lu(k,800) + lu(k,808) = lu(k,808) * lu(k,800) + lu(k,809) = lu(k,809) * lu(k,800) + lu(k,810) = lu(k,810) * lu(k,800) + lu(k,811) = lu(k,811) * lu(k,800) + lu(k,820) = lu(k,820) - lu(k,801) * lu(k,819) + lu(k,821) = lu(k,821) - lu(k,802) * lu(k,819) + lu(k,822) = lu(k,822) - lu(k,803) * lu(k,819) + lu(k,823) = lu(k,823) - lu(k,804) * lu(k,819) + lu(k,824) = lu(k,824) - lu(k,805) * lu(k,819) + lu(k,825) = lu(k,825) - lu(k,806) * lu(k,819) + lu(k,826) = lu(k,826) - lu(k,807) * lu(k,819) + lu(k,827) = lu(k,827) - lu(k,808) * lu(k,819) + lu(k,828) = lu(k,828) - lu(k,809) * lu(k,819) + lu(k,829) = lu(k,829) - lu(k,810) * lu(k,819) + lu(k,831) = lu(k,831) - lu(k,811) * lu(k,819) + lu(k,855) = lu(k,855) - lu(k,801) * lu(k,854) + lu(k,856) = lu(k,856) - lu(k,802) * lu(k,854) + lu(k,857) = lu(k,857) - lu(k,803) * lu(k,854) + lu(k,858) = lu(k,858) - lu(k,804) * lu(k,854) + lu(k,859) = lu(k,859) - lu(k,805) * lu(k,854) + lu(k,860) = lu(k,860) - lu(k,806) * lu(k,854) + lu(k,861) = lu(k,861) - lu(k,807) * lu(k,854) + lu(k,862) = lu(k,862) - lu(k,808) * lu(k,854) + lu(k,863) = lu(k,863) - lu(k,809) * lu(k,854) + lu(k,864) = lu(k,864) - lu(k,810) * lu(k,854) + lu(k,867) = lu(k,867) - lu(k,811) * lu(k,854) + lu(k,884) = lu(k,884) - lu(k,801) * lu(k,883) + lu(k,885) = lu(k,885) - lu(k,802) * lu(k,883) + lu(k,886) = lu(k,886) - lu(k,803) * lu(k,883) + lu(k,887) = lu(k,887) - lu(k,804) * lu(k,883) + lu(k,888) = lu(k,888) - lu(k,805) * lu(k,883) + lu(k,889) = lu(k,889) - lu(k,806) * lu(k,883) + lu(k,890) = lu(k,890) - lu(k,807) * lu(k,883) + lu(k,891) = lu(k,891) - lu(k,808) * lu(k,883) + lu(k,892) = lu(k,892) - lu(k,809) * lu(k,883) + lu(k,893) = lu(k,893) - lu(k,810) * lu(k,883) + lu(k,896) = lu(k,896) - lu(k,811) * lu(k,883) + lu(k,940) = lu(k,940) - lu(k,801) * lu(k,939) + lu(k,941) = lu(k,941) - lu(k,802) * lu(k,939) + lu(k,942) = lu(k,942) - lu(k,803) * lu(k,939) + lu(k,943) = lu(k,943) - lu(k,804) * lu(k,939) + lu(k,944) = lu(k,944) - lu(k,805) * lu(k,939) + lu(k,945) = lu(k,945) - lu(k,806) * lu(k,939) + lu(k,946) = lu(k,946) - lu(k,807) * lu(k,939) + lu(k,947) = lu(k,947) - lu(k,808) * lu(k,939) + lu(k,948) = lu(k,948) - lu(k,809) * lu(k,939) + lu(k,949) = lu(k,949) - lu(k,810) * lu(k,939) + lu(k,952) = lu(k,952) - lu(k,811) * lu(k,939) + lu(k,962) = lu(k,962) - lu(k,801) * lu(k,961) + lu(k,963) = lu(k,963) - lu(k,802) * lu(k,961) + lu(k,964) = lu(k,964) - lu(k,803) * lu(k,961) + lu(k,965) = lu(k,965) - lu(k,804) * lu(k,961) + lu(k,966) = lu(k,966) - lu(k,805) * lu(k,961) + lu(k,967) = lu(k,967) - lu(k,806) * lu(k,961) + lu(k,968) = lu(k,968) - lu(k,807) * lu(k,961) + lu(k,969) = lu(k,969) - lu(k,808) * lu(k,961) + lu(k,970) = lu(k,970) - lu(k,809) * lu(k,961) + lu(k,971) = lu(k,971) - lu(k,810) * lu(k,961) + lu(k,974) = lu(k,974) - lu(k,811) * lu(k,961) + lu(k,1006) = lu(k,1006) - lu(k,801) * lu(k,1005) + lu(k,1007) = lu(k,1007) - lu(k,802) * lu(k,1005) + lu(k,1008) = lu(k,1008) - lu(k,803) * lu(k,1005) + lu(k,1009) = lu(k,1009) - lu(k,804) * lu(k,1005) + lu(k,1010) = lu(k,1010) - lu(k,805) * lu(k,1005) + lu(k,1011) = lu(k,1011) - lu(k,806) * lu(k,1005) + lu(k,1012) = lu(k,1012) - lu(k,807) * lu(k,1005) + lu(k,1013) = lu(k,1013) - lu(k,808) * lu(k,1005) + lu(k,1014) = lu(k,1014) - lu(k,809) * lu(k,1005) + lu(k,1015) = lu(k,1015) - lu(k,810) * lu(k,1005) + lu(k,1018) = lu(k,1018) - lu(k,811) * lu(k,1005) + lu(k,1042) = lu(k,1042) - lu(k,801) * lu(k,1041) + lu(k,1043) = lu(k,1043) - lu(k,802) * lu(k,1041) + lu(k,1044) = lu(k,1044) - lu(k,803) * lu(k,1041) + lu(k,1045) = lu(k,1045) - lu(k,804) * lu(k,1041) + lu(k,1046) = lu(k,1046) - lu(k,805) * lu(k,1041) + lu(k,1047) = lu(k,1047) - lu(k,806) * lu(k,1041) + lu(k,1048) = lu(k,1048) - lu(k,807) * lu(k,1041) + lu(k,1049) = lu(k,1049) - lu(k,808) * lu(k,1041) + lu(k,1050) = lu(k,1050) - lu(k,809) * lu(k,1041) + lu(k,1051) = lu(k,1051) - lu(k,810) * lu(k,1041) + lu(k,1054) = lu(k,1054) - lu(k,811) * lu(k,1041) + lu(k,1079) = lu(k,1079) - lu(k,801) * lu(k,1078) + lu(k,1080) = lu(k,1080) - lu(k,802) * lu(k,1078) + lu(k,1081) = lu(k,1081) - lu(k,803) * lu(k,1078) + lu(k,1082) = lu(k,1082) - lu(k,804) * lu(k,1078) + lu(k,1083) = lu(k,1083) - lu(k,805) * lu(k,1078) + lu(k,1084) = lu(k,1084) - lu(k,806) * lu(k,1078) + lu(k,1085) = lu(k,1085) - lu(k,807) * lu(k,1078) + lu(k,1086) = lu(k,1086) - lu(k,808) * lu(k,1078) + lu(k,1087) = lu(k,1087) - lu(k,809) * lu(k,1078) + lu(k,1088) = lu(k,1088) - lu(k,810) * lu(k,1078) + lu(k,1091) = lu(k,1091) - lu(k,811) * lu(k,1078) + lu(k,1164) = lu(k,1164) - lu(k,801) * lu(k,1163) + lu(k,1165) = lu(k,1165) - lu(k,802) * lu(k,1163) + lu(k,1166) = lu(k,1166) - lu(k,803) * lu(k,1163) + lu(k,1167) = lu(k,1167) - lu(k,804) * lu(k,1163) + lu(k,1168) = lu(k,1168) - lu(k,805) * lu(k,1163) + lu(k,1169) = lu(k,1169) - lu(k,806) * lu(k,1163) + lu(k,1170) = lu(k,1170) - lu(k,807) * lu(k,1163) + lu(k,1171) = lu(k,1171) - lu(k,808) * lu(k,1163) + lu(k,1172) = lu(k,1172) - lu(k,809) * lu(k,1163) + lu(k,1173) = lu(k,1173) - lu(k,810) * lu(k,1163) + lu(k,1176) = lu(k,1176) - lu(k,811) * lu(k,1163) + lu(k,1208) = lu(k,1208) - lu(k,801) * lu(k,1207) + lu(k,1209) = lu(k,1209) - lu(k,802) * lu(k,1207) + lu(k,1210) = lu(k,1210) - lu(k,803) * lu(k,1207) + lu(k,1211) = lu(k,1211) - lu(k,804) * lu(k,1207) + lu(k,1212) = lu(k,1212) - lu(k,805) * lu(k,1207) + lu(k,1213) = lu(k,1213) - lu(k,806) * lu(k,1207) + lu(k,1214) = lu(k,1214) - lu(k,807) * lu(k,1207) + lu(k,1215) = lu(k,1215) - lu(k,808) * lu(k,1207) + lu(k,1216) = lu(k,1216) - lu(k,809) * lu(k,1207) + lu(k,1217) = lu(k,1217) - lu(k,810) * lu(k,1207) + lu(k,1220) = lu(k,1220) - lu(k,811) * lu(k,1207) + lu(k,1233) = lu(k,1233) - lu(k,801) * lu(k,1232) + lu(k,1234) = lu(k,1234) - lu(k,802) * lu(k,1232) + lu(k,1235) = lu(k,1235) - lu(k,803) * lu(k,1232) + lu(k,1236) = lu(k,1236) - lu(k,804) * lu(k,1232) + lu(k,1237) = lu(k,1237) - lu(k,805) * lu(k,1232) + lu(k,1238) = lu(k,1238) - lu(k,806) * lu(k,1232) + lu(k,1239) = lu(k,1239) - lu(k,807) * lu(k,1232) + lu(k,1240) = lu(k,1240) - lu(k,808) * lu(k,1232) + lu(k,1241) = lu(k,1241) - lu(k,809) * lu(k,1232) + lu(k,1242) = lu(k,1242) - lu(k,810) * lu(k,1232) + lu(k,1245) = lu(k,1245) - lu(k,811) * lu(k,1232) + lu(k,1275) = lu(k,1275) - lu(k,801) * lu(k,1274) + lu(k,1276) = lu(k,1276) - lu(k,802) * lu(k,1274) + lu(k,1277) = lu(k,1277) - lu(k,803) * lu(k,1274) + lu(k,1278) = lu(k,1278) - lu(k,804) * lu(k,1274) + lu(k,1279) = lu(k,1279) - lu(k,805) * lu(k,1274) + lu(k,1280) = lu(k,1280) - lu(k,806) * lu(k,1274) + lu(k,1281) = lu(k,1281) - lu(k,807) * lu(k,1274) + lu(k,1282) = lu(k,1282) - lu(k,808) * lu(k,1274) + lu(k,1283) = lu(k,1283) - lu(k,809) * lu(k,1274) + lu(k,1284) = lu(k,1284) - lu(k,810) * lu(k,1274) + lu(k,1287) = lu(k,1287) - lu(k,811) * lu(k,1274) + lu(k,1295) = lu(k,1295) - lu(k,801) * lu(k,1294) + lu(k,1296) = lu(k,1296) - lu(k,802) * lu(k,1294) + lu(k,1297) = lu(k,1297) - lu(k,803) * lu(k,1294) + lu(k,1298) = lu(k,1298) - lu(k,804) * lu(k,1294) + lu(k,1299) = lu(k,1299) - lu(k,805) * lu(k,1294) + lu(k,1300) = lu(k,1300) - lu(k,806) * lu(k,1294) + lu(k,1301) = lu(k,1301) - lu(k,807) * lu(k,1294) + lu(k,1302) = lu(k,1302) - lu(k,808) * lu(k,1294) + lu(k,1303) = lu(k,1303) - lu(k,809) * lu(k,1294) + lu(k,1304) = - lu(k,810) * lu(k,1294) + lu(k,1307) = lu(k,1307) - lu(k,811) * lu(k,1294) + lu(k,820) = 1._r8 / lu(k,820) + lu(k,821) = lu(k,821) * lu(k,820) + lu(k,822) = lu(k,822) * lu(k,820) + lu(k,823) = lu(k,823) * lu(k,820) + lu(k,824) = lu(k,824) * lu(k,820) + lu(k,825) = lu(k,825) * lu(k,820) + lu(k,826) = lu(k,826) * lu(k,820) + lu(k,827) = lu(k,827) * lu(k,820) + lu(k,828) = lu(k,828) * lu(k,820) + lu(k,829) = lu(k,829) * lu(k,820) + lu(k,830) = lu(k,830) * lu(k,820) + lu(k,831) = lu(k,831) * lu(k,820) + lu(k,856) = lu(k,856) - lu(k,821) * lu(k,855) + lu(k,857) = lu(k,857) - lu(k,822) * lu(k,855) + lu(k,858) = lu(k,858) - lu(k,823) * lu(k,855) + lu(k,859) = lu(k,859) - lu(k,824) * lu(k,855) + lu(k,860) = lu(k,860) - lu(k,825) * lu(k,855) + lu(k,861) = lu(k,861) - lu(k,826) * lu(k,855) + lu(k,862) = lu(k,862) - lu(k,827) * lu(k,855) + lu(k,863) = lu(k,863) - lu(k,828) * lu(k,855) + lu(k,864) = lu(k,864) - lu(k,829) * lu(k,855) + lu(k,865) = lu(k,865) - lu(k,830) * lu(k,855) + lu(k,867) = lu(k,867) - lu(k,831) * lu(k,855) + lu(k,885) = lu(k,885) - lu(k,821) * lu(k,884) + lu(k,886) = lu(k,886) - lu(k,822) * lu(k,884) + lu(k,887) = lu(k,887) - lu(k,823) * lu(k,884) + lu(k,888) = lu(k,888) - lu(k,824) * lu(k,884) + lu(k,889) = lu(k,889) - lu(k,825) * lu(k,884) + lu(k,890) = lu(k,890) - lu(k,826) * lu(k,884) + lu(k,891) = lu(k,891) - lu(k,827) * lu(k,884) + lu(k,892) = lu(k,892) - lu(k,828) * lu(k,884) + lu(k,893) = lu(k,893) - lu(k,829) * lu(k,884) + lu(k,894) = lu(k,894) - lu(k,830) * lu(k,884) + lu(k,896) = lu(k,896) - lu(k,831) * lu(k,884) + lu(k,941) = lu(k,941) - lu(k,821) * lu(k,940) + lu(k,942) = lu(k,942) - lu(k,822) * lu(k,940) + lu(k,943) = lu(k,943) - lu(k,823) * lu(k,940) + lu(k,944) = lu(k,944) - lu(k,824) * lu(k,940) + lu(k,945) = lu(k,945) - lu(k,825) * lu(k,940) + lu(k,946) = lu(k,946) - lu(k,826) * lu(k,940) + lu(k,947) = lu(k,947) - lu(k,827) * lu(k,940) + lu(k,948) = lu(k,948) - lu(k,828) * lu(k,940) + lu(k,949) = lu(k,949) - lu(k,829) * lu(k,940) + lu(k,950) = lu(k,950) - lu(k,830) * lu(k,940) + lu(k,952) = lu(k,952) - lu(k,831) * lu(k,940) + lu(k,963) = lu(k,963) - lu(k,821) * lu(k,962) + lu(k,964) = lu(k,964) - lu(k,822) * lu(k,962) + lu(k,965) = lu(k,965) - lu(k,823) * lu(k,962) + lu(k,966) = lu(k,966) - lu(k,824) * lu(k,962) + lu(k,967) = lu(k,967) - lu(k,825) * lu(k,962) + lu(k,968) = lu(k,968) - lu(k,826) * lu(k,962) + lu(k,969) = lu(k,969) - lu(k,827) * lu(k,962) + lu(k,970) = lu(k,970) - lu(k,828) * lu(k,962) + lu(k,971) = lu(k,971) - lu(k,829) * lu(k,962) + lu(k,972) = lu(k,972) - lu(k,830) * lu(k,962) + lu(k,974) = lu(k,974) - lu(k,831) * lu(k,962) + lu(k,1007) = lu(k,1007) - lu(k,821) * lu(k,1006) + lu(k,1008) = lu(k,1008) - lu(k,822) * lu(k,1006) + lu(k,1009) = lu(k,1009) - lu(k,823) * lu(k,1006) + lu(k,1010) = lu(k,1010) - lu(k,824) * lu(k,1006) + lu(k,1011) = lu(k,1011) - lu(k,825) * lu(k,1006) + lu(k,1012) = lu(k,1012) - lu(k,826) * lu(k,1006) + lu(k,1013) = lu(k,1013) - lu(k,827) * lu(k,1006) + lu(k,1014) = lu(k,1014) - lu(k,828) * lu(k,1006) + lu(k,1015) = lu(k,1015) - lu(k,829) * lu(k,1006) + lu(k,1016) = lu(k,1016) - lu(k,830) * lu(k,1006) + lu(k,1018) = lu(k,1018) - lu(k,831) * lu(k,1006) + lu(k,1043) = lu(k,1043) - lu(k,821) * lu(k,1042) + lu(k,1044) = lu(k,1044) - lu(k,822) * lu(k,1042) + lu(k,1045) = lu(k,1045) - lu(k,823) * lu(k,1042) + lu(k,1046) = lu(k,1046) - lu(k,824) * lu(k,1042) + lu(k,1047) = lu(k,1047) - lu(k,825) * lu(k,1042) + lu(k,1048) = lu(k,1048) - lu(k,826) * lu(k,1042) + lu(k,1049) = lu(k,1049) - lu(k,827) * lu(k,1042) + lu(k,1050) = lu(k,1050) - lu(k,828) * lu(k,1042) + lu(k,1051) = lu(k,1051) - lu(k,829) * lu(k,1042) + lu(k,1052) = lu(k,1052) - lu(k,830) * lu(k,1042) + lu(k,1054) = lu(k,1054) - lu(k,831) * lu(k,1042) + lu(k,1080) = lu(k,1080) - lu(k,821) * lu(k,1079) + lu(k,1081) = lu(k,1081) - lu(k,822) * lu(k,1079) + lu(k,1082) = lu(k,1082) - lu(k,823) * lu(k,1079) + lu(k,1083) = lu(k,1083) - lu(k,824) * lu(k,1079) + lu(k,1084) = lu(k,1084) - lu(k,825) * lu(k,1079) + lu(k,1085) = lu(k,1085) - lu(k,826) * lu(k,1079) + lu(k,1086) = lu(k,1086) - lu(k,827) * lu(k,1079) + lu(k,1087) = lu(k,1087) - lu(k,828) * lu(k,1079) + lu(k,1088) = lu(k,1088) - lu(k,829) * lu(k,1079) + lu(k,1089) = lu(k,1089) - lu(k,830) * lu(k,1079) + lu(k,1091) = lu(k,1091) - lu(k,831) * lu(k,1079) + lu(k,1165) = lu(k,1165) - lu(k,821) * lu(k,1164) + lu(k,1166) = lu(k,1166) - lu(k,822) * lu(k,1164) + lu(k,1167) = lu(k,1167) - lu(k,823) * lu(k,1164) + lu(k,1168) = lu(k,1168) - lu(k,824) * lu(k,1164) + lu(k,1169) = lu(k,1169) - lu(k,825) * lu(k,1164) + lu(k,1170) = lu(k,1170) - lu(k,826) * lu(k,1164) + lu(k,1171) = lu(k,1171) - lu(k,827) * lu(k,1164) + lu(k,1172) = lu(k,1172) - lu(k,828) * lu(k,1164) + lu(k,1173) = lu(k,1173) - lu(k,829) * lu(k,1164) + lu(k,1174) = lu(k,1174) - lu(k,830) * lu(k,1164) + lu(k,1176) = lu(k,1176) - lu(k,831) * lu(k,1164) + lu(k,1209) = lu(k,1209) - lu(k,821) * lu(k,1208) + lu(k,1210) = lu(k,1210) - lu(k,822) * lu(k,1208) + lu(k,1211) = lu(k,1211) - lu(k,823) * lu(k,1208) + lu(k,1212) = lu(k,1212) - lu(k,824) * lu(k,1208) + lu(k,1213) = lu(k,1213) - lu(k,825) * lu(k,1208) + lu(k,1214) = lu(k,1214) - lu(k,826) * lu(k,1208) + lu(k,1215) = lu(k,1215) - lu(k,827) * lu(k,1208) + lu(k,1216) = lu(k,1216) - lu(k,828) * lu(k,1208) + lu(k,1217) = lu(k,1217) - lu(k,829) * lu(k,1208) + lu(k,1218) = lu(k,1218) - lu(k,830) * lu(k,1208) + lu(k,1220) = lu(k,1220) - lu(k,831) * lu(k,1208) + lu(k,1234) = lu(k,1234) - lu(k,821) * lu(k,1233) + lu(k,1235) = lu(k,1235) - lu(k,822) * lu(k,1233) + lu(k,1236) = lu(k,1236) - lu(k,823) * lu(k,1233) + lu(k,1237) = lu(k,1237) - lu(k,824) * lu(k,1233) + lu(k,1238) = lu(k,1238) - lu(k,825) * lu(k,1233) + lu(k,1239) = lu(k,1239) - lu(k,826) * lu(k,1233) + lu(k,1240) = lu(k,1240) - lu(k,827) * lu(k,1233) + lu(k,1241) = lu(k,1241) - lu(k,828) * lu(k,1233) + lu(k,1242) = lu(k,1242) - lu(k,829) * lu(k,1233) + lu(k,1243) = lu(k,1243) - lu(k,830) * lu(k,1233) + lu(k,1245) = lu(k,1245) - lu(k,831) * lu(k,1233) + lu(k,1276) = lu(k,1276) - lu(k,821) * lu(k,1275) + lu(k,1277) = lu(k,1277) - lu(k,822) * lu(k,1275) + lu(k,1278) = lu(k,1278) - lu(k,823) * lu(k,1275) + lu(k,1279) = lu(k,1279) - lu(k,824) * lu(k,1275) + lu(k,1280) = lu(k,1280) - lu(k,825) * lu(k,1275) + lu(k,1281) = lu(k,1281) - lu(k,826) * lu(k,1275) + lu(k,1282) = lu(k,1282) - lu(k,827) * lu(k,1275) + lu(k,1283) = lu(k,1283) - lu(k,828) * lu(k,1275) + lu(k,1284) = lu(k,1284) - lu(k,829) * lu(k,1275) + lu(k,1285) = lu(k,1285) - lu(k,830) * lu(k,1275) + lu(k,1287) = lu(k,1287) - lu(k,831) * lu(k,1275) + lu(k,1296) = lu(k,1296) - lu(k,821) * lu(k,1295) + lu(k,1297) = lu(k,1297) - lu(k,822) * lu(k,1295) + lu(k,1298) = lu(k,1298) - lu(k,823) * lu(k,1295) + lu(k,1299) = lu(k,1299) - lu(k,824) * lu(k,1295) + lu(k,1300) = lu(k,1300) - lu(k,825) * lu(k,1295) + lu(k,1301) = lu(k,1301) - lu(k,826) * lu(k,1295) + lu(k,1302) = lu(k,1302) - lu(k,827) * lu(k,1295) + lu(k,1303) = lu(k,1303) - lu(k,828) * lu(k,1295) + lu(k,1304) = lu(k,1304) - lu(k,829) * lu(k,1295) + lu(k,1305) = lu(k,1305) - lu(k,830) * lu(k,1295) + lu(k,1307) = lu(k,1307) - lu(k,831) * lu(k,1295) + lu(k,856) = 1._r8 / lu(k,856) + lu(k,857) = lu(k,857) * lu(k,856) + lu(k,858) = lu(k,858) * lu(k,856) + lu(k,859) = lu(k,859) * lu(k,856) + lu(k,860) = lu(k,860) * lu(k,856) + lu(k,861) = lu(k,861) * lu(k,856) + lu(k,862) = lu(k,862) * lu(k,856) + lu(k,863) = lu(k,863) * lu(k,856) + lu(k,864) = lu(k,864) * lu(k,856) + lu(k,865) = lu(k,865) * lu(k,856) + lu(k,866) = lu(k,866) * lu(k,856) + lu(k,867) = lu(k,867) * lu(k,856) + lu(k,886) = lu(k,886) - lu(k,857) * lu(k,885) + lu(k,887) = lu(k,887) - lu(k,858) * lu(k,885) + lu(k,888) = lu(k,888) - lu(k,859) * lu(k,885) + lu(k,889) = lu(k,889) - lu(k,860) * lu(k,885) + lu(k,890) = lu(k,890) - lu(k,861) * lu(k,885) + lu(k,891) = lu(k,891) - lu(k,862) * lu(k,885) + lu(k,892) = lu(k,892) - lu(k,863) * lu(k,885) + lu(k,893) = lu(k,893) - lu(k,864) * lu(k,885) + lu(k,894) = lu(k,894) - lu(k,865) * lu(k,885) + lu(k,895) = lu(k,895) - lu(k,866) * lu(k,885) + lu(k,896) = lu(k,896) - lu(k,867) * lu(k,885) + lu(k,942) = lu(k,942) - lu(k,857) * lu(k,941) + lu(k,943) = lu(k,943) - lu(k,858) * lu(k,941) + lu(k,944) = lu(k,944) - lu(k,859) * lu(k,941) + lu(k,945) = lu(k,945) - lu(k,860) * lu(k,941) + lu(k,946) = lu(k,946) - lu(k,861) * lu(k,941) + lu(k,947) = lu(k,947) - lu(k,862) * lu(k,941) + lu(k,948) = lu(k,948) - lu(k,863) * lu(k,941) + lu(k,949) = lu(k,949) - lu(k,864) * lu(k,941) + lu(k,950) = lu(k,950) - lu(k,865) * lu(k,941) + lu(k,951) = lu(k,951) - lu(k,866) * lu(k,941) + lu(k,952) = lu(k,952) - lu(k,867) * lu(k,941) + lu(k,964) = lu(k,964) - lu(k,857) * lu(k,963) + lu(k,965) = lu(k,965) - lu(k,858) * lu(k,963) + lu(k,966) = lu(k,966) - lu(k,859) * lu(k,963) + lu(k,967) = lu(k,967) - lu(k,860) * lu(k,963) + lu(k,968) = lu(k,968) - lu(k,861) * lu(k,963) + lu(k,969) = lu(k,969) - lu(k,862) * lu(k,963) + lu(k,970) = lu(k,970) - lu(k,863) * lu(k,963) + lu(k,971) = lu(k,971) - lu(k,864) * lu(k,963) + lu(k,972) = lu(k,972) - lu(k,865) * lu(k,963) + lu(k,973) = lu(k,973) - lu(k,866) * lu(k,963) + lu(k,974) = lu(k,974) - lu(k,867) * lu(k,963) + lu(k,1008) = lu(k,1008) - lu(k,857) * lu(k,1007) + lu(k,1009) = lu(k,1009) - lu(k,858) * lu(k,1007) + lu(k,1010) = lu(k,1010) - lu(k,859) * lu(k,1007) + lu(k,1011) = lu(k,1011) - lu(k,860) * lu(k,1007) + lu(k,1012) = lu(k,1012) - lu(k,861) * lu(k,1007) + lu(k,1013) = lu(k,1013) - lu(k,862) * lu(k,1007) + lu(k,1014) = lu(k,1014) - lu(k,863) * lu(k,1007) + lu(k,1015) = lu(k,1015) - lu(k,864) * lu(k,1007) + lu(k,1016) = lu(k,1016) - lu(k,865) * lu(k,1007) + lu(k,1017) = lu(k,1017) - lu(k,866) * lu(k,1007) + lu(k,1018) = lu(k,1018) - lu(k,867) * lu(k,1007) + lu(k,1044) = lu(k,1044) - lu(k,857) * lu(k,1043) + lu(k,1045) = lu(k,1045) - lu(k,858) * lu(k,1043) + lu(k,1046) = lu(k,1046) - lu(k,859) * lu(k,1043) + lu(k,1047) = lu(k,1047) - lu(k,860) * lu(k,1043) + lu(k,1048) = lu(k,1048) - lu(k,861) * lu(k,1043) + lu(k,1049) = lu(k,1049) - lu(k,862) * lu(k,1043) + lu(k,1050) = lu(k,1050) - lu(k,863) * lu(k,1043) + lu(k,1051) = lu(k,1051) - lu(k,864) * lu(k,1043) + lu(k,1052) = lu(k,1052) - lu(k,865) * lu(k,1043) + lu(k,1053) = lu(k,1053) - lu(k,866) * lu(k,1043) + lu(k,1054) = lu(k,1054) - lu(k,867) * lu(k,1043) + lu(k,1081) = lu(k,1081) - lu(k,857) * lu(k,1080) + lu(k,1082) = lu(k,1082) - lu(k,858) * lu(k,1080) + lu(k,1083) = lu(k,1083) - lu(k,859) * lu(k,1080) + lu(k,1084) = lu(k,1084) - lu(k,860) * lu(k,1080) + lu(k,1085) = lu(k,1085) - lu(k,861) * lu(k,1080) + lu(k,1086) = lu(k,1086) - lu(k,862) * lu(k,1080) + lu(k,1087) = lu(k,1087) - lu(k,863) * lu(k,1080) + lu(k,1088) = lu(k,1088) - lu(k,864) * lu(k,1080) + lu(k,1089) = lu(k,1089) - lu(k,865) * lu(k,1080) + lu(k,1090) = lu(k,1090) - lu(k,866) * lu(k,1080) + lu(k,1091) = lu(k,1091) - lu(k,867) * lu(k,1080) + lu(k,1166) = lu(k,1166) - lu(k,857) * lu(k,1165) + lu(k,1167) = lu(k,1167) - lu(k,858) * lu(k,1165) + lu(k,1168) = lu(k,1168) - lu(k,859) * lu(k,1165) + lu(k,1169) = lu(k,1169) - lu(k,860) * lu(k,1165) + lu(k,1170) = lu(k,1170) - lu(k,861) * lu(k,1165) + lu(k,1171) = lu(k,1171) - lu(k,862) * lu(k,1165) + lu(k,1172) = lu(k,1172) - lu(k,863) * lu(k,1165) + lu(k,1173) = lu(k,1173) - lu(k,864) * lu(k,1165) + lu(k,1174) = lu(k,1174) - lu(k,865) * lu(k,1165) + lu(k,1175) = lu(k,1175) - lu(k,866) * lu(k,1165) + lu(k,1176) = lu(k,1176) - lu(k,867) * lu(k,1165) + lu(k,1210) = lu(k,1210) - lu(k,857) * lu(k,1209) + lu(k,1211) = lu(k,1211) - lu(k,858) * lu(k,1209) + lu(k,1212) = lu(k,1212) - lu(k,859) * lu(k,1209) + lu(k,1213) = lu(k,1213) - lu(k,860) * lu(k,1209) + lu(k,1214) = lu(k,1214) - lu(k,861) * lu(k,1209) + lu(k,1215) = lu(k,1215) - lu(k,862) * lu(k,1209) + lu(k,1216) = lu(k,1216) - lu(k,863) * lu(k,1209) + lu(k,1217) = lu(k,1217) - lu(k,864) * lu(k,1209) + lu(k,1218) = lu(k,1218) - lu(k,865) * lu(k,1209) + lu(k,1219) = lu(k,1219) - lu(k,866) * lu(k,1209) + lu(k,1220) = lu(k,1220) - lu(k,867) * lu(k,1209) + lu(k,1235) = lu(k,1235) - lu(k,857) * lu(k,1234) + lu(k,1236) = lu(k,1236) - lu(k,858) * lu(k,1234) + lu(k,1237) = lu(k,1237) - lu(k,859) * lu(k,1234) + lu(k,1238) = lu(k,1238) - lu(k,860) * lu(k,1234) + lu(k,1239) = lu(k,1239) - lu(k,861) * lu(k,1234) + lu(k,1240) = lu(k,1240) - lu(k,862) * lu(k,1234) + lu(k,1241) = lu(k,1241) - lu(k,863) * lu(k,1234) + lu(k,1242) = lu(k,1242) - lu(k,864) * lu(k,1234) + lu(k,1243) = lu(k,1243) - lu(k,865) * lu(k,1234) + lu(k,1244) = lu(k,1244) - lu(k,866) * lu(k,1234) + lu(k,1245) = lu(k,1245) - lu(k,867) * lu(k,1234) + lu(k,1277) = lu(k,1277) - lu(k,857) * lu(k,1276) + lu(k,1278) = lu(k,1278) - lu(k,858) * lu(k,1276) + lu(k,1279) = lu(k,1279) - lu(k,859) * lu(k,1276) + lu(k,1280) = lu(k,1280) - lu(k,860) * lu(k,1276) + lu(k,1281) = lu(k,1281) - lu(k,861) * lu(k,1276) + lu(k,1282) = lu(k,1282) - lu(k,862) * lu(k,1276) + lu(k,1283) = lu(k,1283) - lu(k,863) * lu(k,1276) + lu(k,1284) = lu(k,1284) - lu(k,864) * lu(k,1276) + lu(k,1285) = lu(k,1285) - lu(k,865) * lu(k,1276) + lu(k,1286) = lu(k,1286) - lu(k,866) * lu(k,1276) + lu(k,1287) = lu(k,1287) - lu(k,867) * lu(k,1276) + lu(k,1297) = lu(k,1297) - lu(k,857) * lu(k,1296) + lu(k,1298) = lu(k,1298) - lu(k,858) * lu(k,1296) + lu(k,1299) = lu(k,1299) - lu(k,859) * lu(k,1296) + lu(k,1300) = lu(k,1300) - lu(k,860) * lu(k,1296) + lu(k,1301) = lu(k,1301) - lu(k,861) * lu(k,1296) + lu(k,1302) = lu(k,1302) - lu(k,862) * lu(k,1296) + lu(k,1303) = lu(k,1303) - lu(k,863) * lu(k,1296) + lu(k,1304) = lu(k,1304) - lu(k,864) * lu(k,1296) + lu(k,1305) = lu(k,1305) - lu(k,865) * lu(k,1296) + lu(k,1306) = lu(k,1306) - lu(k,866) * lu(k,1296) + lu(k,1307) = lu(k,1307) - lu(k,867) * lu(k,1296) + end do + end subroutine lu_fac16 + subroutine lu_fac17( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,886) = 1._r8 / lu(k,886) + lu(k,887) = lu(k,887) * lu(k,886) + lu(k,888) = lu(k,888) * lu(k,886) + lu(k,889) = lu(k,889) * lu(k,886) + lu(k,890) = lu(k,890) * lu(k,886) + lu(k,891) = lu(k,891) * lu(k,886) + lu(k,892) = lu(k,892) * lu(k,886) + lu(k,893) = lu(k,893) * lu(k,886) + lu(k,894) = lu(k,894) * lu(k,886) + lu(k,895) = lu(k,895) * lu(k,886) + lu(k,896) = lu(k,896) * lu(k,886) + lu(k,943) = lu(k,943) - lu(k,887) * lu(k,942) + lu(k,944) = lu(k,944) - lu(k,888) * lu(k,942) + lu(k,945) = lu(k,945) - lu(k,889) * lu(k,942) + lu(k,946) = lu(k,946) - lu(k,890) * lu(k,942) + lu(k,947) = lu(k,947) - lu(k,891) * lu(k,942) + lu(k,948) = lu(k,948) - lu(k,892) * lu(k,942) + lu(k,949) = lu(k,949) - lu(k,893) * lu(k,942) + lu(k,950) = lu(k,950) - lu(k,894) * lu(k,942) + lu(k,951) = lu(k,951) - lu(k,895) * lu(k,942) + lu(k,952) = lu(k,952) - lu(k,896) * lu(k,942) + lu(k,965) = lu(k,965) - lu(k,887) * lu(k,964) + lu(k,966) = lu(k,966) - lu(k,888) * lu(k,964) + lu(k,967) = lu(k,967) - lu(k,889) * lu(k,964) + lu(k,968) = lu(k,968) - lu(k,890) * lu(k,964) + lu(k,969) = lu(k,969) - lu(k,891) * lu(k,964) + lu(k,970) = lu(k,970) - lu(k,892) * lu(k,964) + lu(k,971) = lu(k,971) - lu(k,893) * lu(k,964) + lu(k,972) = lu(k,972) - lu(k,894) * lu(k,964) + lu(k,973) = lu(k,973) - lu(k,895) * lu(k,964) + lu(k,974) = lu(k,974) - lu(k,896) * lu(k,964) + lu(k,1009) = lu(k,1009) - lu(k,887) * lu(k,1008) + lu(k,1010) = lu(k,1010) - lu(k,888) * lu(k,1008) + lu(k,1011) = lu(k,1011) - lu(k,889) * lu(k,1008) + lu(k,1012) = lu(k,1012) - lu(k,890) * lu(k,1008) + lu(k,1013) = lu(k,1013) - lu(k,891) * lu(k,1008) + lu(k,1014) = lu(k,1014) - lu(k,892) * lu(k,1008) + lu(k,1015) = lu(k,1015) - lu(k,893) * lu(k,1008) + lu(k,1016) = lu(k,1016) - lu(k,894) * lu(k,1008) + lu(k,1017) = lu(k,1017) - lu(k,895) * lu(k,1008) + lu(k,1018) = lu(k,1018) - lu(k,896) * lu(k,1008) + lu(k,1045) = lu(k,1045) - lu(k,887) * lu(k,1044) + lu(k,1046) = lu(k,1046) - lu(k,888) * lu(k,1044) + lu(k,1047) = lu(k,1047) - lu(k,889) * lu(k,1044) + lu(k,1048) = lu(k,1048) - lu(k,890) * lu(k,1044) + lu(k,1049) = lu(k,1049) - lu(k,891) * lu(k,1044) + lu(k,1050) = lu(k,1050) - lu(k,892) * lu(k,1044) + lu(k,1051) = lu(k,1051) - lu(k,893) * lu(k,1044) + lu(k,1052) = lu(k,1052) - lu(k,894) * lu(k,1044) + lu(k,1053) = lu(k,1053) - lu(k,895) * lu(k,1044) + lu(k,1054) = lu(k,1054) - lu(k,896) * lu(k,1044) + lu(k,1082) = lu(k,1082) - lu(k,887) * lu(k,1081) + lu(k,1083) = lu(k,1083) - lu(k,888) * lu(k,1081) + lu(k,1084) = lu(k,1084) - lu(k,889) * lu(k,1081) + lu(k,1085) = lu(k,1085) - lu(k,890) * lu(k,1081) + lu(k,1086) = lu(k,1086) - lu(k,891) * lu(k,1081) + lu(k,1087) = lu(k,1087) - lu(k,892) * lu(k,1081) + lu(k,1088) = lu(k,1088) - lu(k,893) * lu(k,1081) + lu(k,1089) = lu(k,1089) - lu(k,894) * lu(k,1081) + lu(k,1090) = lu(k,1090) - lu(k,895) * lu(k,1081) + lu(k,1091) = lu(k,1091) - lu(k,896) * lu(k,1081) + lu(k,1167) = lu(k,1167) - lu(k,887) * lu(k,1166) + lu(k,1168) = lu(k,1168) - lu(k,888) * lu(k,1166) + lu(k,1169) = lu(k,1169) - lu(k,889) * lu(k,1166) + lu(k,1170) = lu(k,1170) - lu(k,890) * lu(k,1166) + lu(k,1171) = lu(k,1171) - lu(k,891) * lu(k,1166) + lu(k,1172) = lu(k,1172) - lu(k,892) * lu(k,1166) + lu(k,1173) = lu(k,1173) - lu(k,893) * lu(k,1166) + lu(k,1174) = lu(k,1174) - lu(k,894) * lu(k,1166) + lu(k,1175) = lu(k,1175) - lu(k,895) * lu(k,1166) + lu(k,1176) = lu(k,1176) - lu(k,896) * lu(k,1166) + lu(k,1211) = lu(k,1211) - lu(k,887) * lu(k,1210) + lu(k,1212) = lu(k,1212) - lu(k,888) * lu(k,1210) + lu(k,1213) = lu(k,1213) - lu(k,889) * lu(k,1210) + lu(k,1214) = lu(k,1214) - lu(k,890) * lu(k,1210) + lu(k,1215) = lu(k,1215) - lu(k,891) * lu(k,1210) + lu(k,1216) = lu(k,1216) - lu(k,892) * lu(k,1210) + lu(k,1217) = lu(k,1217) - lu(k,893) * lu(k,1210) + lu(k,1218) = lu(k,1218) - lu(k,894) * lu(k,1210) + lu(k,1219) = lu(k,1219) - lu(k,895) * lu(k,1210) + lu(k,1220) = lu(k,1220) - lu(k,896) * lu(k,1210) + lu(k,1236) = lu(k,1236) - lu(k,887) * lu(k,1235) + lu(k,1237) = lu(k,1237) - lu(k,888) * lu(k,1235) + lu(k,1238) = lu(k,1238) - lu(k,889) * lu(k,1235) + lu(k,1239) = lu(k,1239) - lu(k,890) * lu(k,1235) + lu(k,1240) = lu(k,1240) - lu(k,891) * lu(k,1235) + lu(k,1241) = lu(k,1241) - lu(k,892) * lu(k,1235) + lu(k,1242) = lu(k,1242) - lu(k,893) * lu(k,1235) + lu(k,1243) = lu(k,1243) - lu(k,894) * lu(k,1235) + lu(k,1244) = lu(k,1244) - lu(k,895) * lu(k,1235) + lu(k,1245) = lu(k,1245) - lu(k,896) * lu(k,1235) + lu(k,1278) = lu(k,1278) - lu(k,887) * lu(k,1277) + lu(k,1279) = lu(k,1279) - lu(k,888) * lu(k,1277) + lu(k,1280) = lu(k,1280) - lu(k,889) * lu(k,1277) + lu(k,1281) = lu(k,1281) - lu(k,890) * lu(k,1277) + lu(k,1282) = lu(k,1282) - lu(k,891) * lu(k,1277) + lu(k,1283) = lu(k,1283) - lu(k,892) * lu(k,1277) + lu(k,1284) = lu(k,1284) - lu(k,893) * lu(k,1277) + lu(k,1285) = lu(k,1285) - lu(k,894) * lu(k,1277) + lu(k,1286) = lu(k,1286) - lu(k,895) * lu(k,1277) + lu(k,1287) = lu(k,1287) - lu(k,896) * lu(k,1277) + lu(k,1298) = lu(k,1298) - lu(k,887) * lu(k,1297) + lu(k,1299) = lu(k,1299) - lu(k,888) * lu(k,1297) + lu(k,1300) = lu(k,1300) - lu(k,889) * lu(k,1297) + lu(k,1301) = lu(k,1301) - lu(k,890) * lu(k,1297) + lu(k,1302) = lu(k,1302) - lu(k,891) * lu(k,1297) + lu(k,1303) = lu(k,1303) - lu(k,892) * lu(k,1297) + lu(k,1304) = lu(k,1304) - lu(k,893) * lu(k,1297) + lu(k,1305) = lu(k,1305) - lu(k,894) * lu(k,1297) + lu(k,1306) = lu(k,1306) - lu(k,895) * lu(k,1297) + lu(k,1307) = lu(k,1307) - lu(k,896) * lu(k,1297) + lu(k,943) = 1._r8 / lu(k,943) + lu(k,944) = lu(k,944) * lu(k,943) + lu(k,945) = lu(k,945) * lu(k,943) + lu(k,946) = lu(k,946) * lu(k,943) + lu(k,947) = lu(k,947) * lu(k,943) + lu(k,948) = lu(k,948) * lu(k,943) + lu(k,949) = lu(k,949) * lu(k,943) + lu(k,950) = lu(k,950) * lu(k,943) + lu(k,951) = lu(k,951) * lu(k,943) + lu(k,952) = lu(k,952) * lu(k,943) + lu(k,966) = lu(k,966) - lu(k,944) * lu(k,965) + lu(k,967) = lu(k,967) - lu(k,945) * lu(k,965) + lu(k,968) = lu(k,968) - lu(k,946) * lu(k,965) + lu(k,969) = lu(k,969) - lu(k,947) * lu(k,965) + lu(k,970) = lu(k,970) - lu(k,948) * lu(k,965) + lu(k,971) = lu(k,971) - lu(k,949) * lu(k,965) + lu(k,972) = lu(k,972) - lu(k,950) * lu(k,965) + lu(k,973) = lu(k,973) - lu(k,951) * lu(k,965) + lu(k,974) = lu(k,974) - lu(k,952) * lu(k,965) + lu(k,1010) = lu(k,1010) - lu(k,944) * lu(k,1009) + lu(k,1011) = lu(k,1011) - lu(k,945) * lu(k,1009) + lu(k,1012) = lu(k,1012) - lu(k,946) * lu(k,1009) + lu(k,1013) = lu(k,1013) - lu(k,947) * lu(k,1009) + lu(k,1014) = lu(k,1014) - lu(k,948) * lu(k,1009) + lu(k,1015) = lu(k,1015) - lu(k,949) * lu(k,1009) + lu(k,1016) = lu(k,1016) - lu(k,950) * lu(k,1009) + lu(k,1017) = lu(k,1017) - lu(k,951) * lu(k,1009) + lu(k,1018) = lu(k,1018) - lu(k,952) * lu(k,1009) + lu(k,1046) = lu(k,1046) - lu(k,944) * lu(k,1045) + lu(k,1047) = lu(k,1047) - lu(k,945) * lu(k,1045) + lu(k,1048) = lu(k,1048) - lu(k,946) * lu(k,1045) + lu(k,1049) = lu(k,1049) - lu(k,947) * lu(k,1045) + lu(k,1050) = lu(k,1050) - lu(k,948) * lu(k,1045) + lu(k,1051) = lu(k,1051) - lu(k,949) * lu(k,1045) + lu(k,1052) = lu(k,1052) - lu(k,950) * lu(k,1045) + lu(k,1053) = lu(k,1053) - lu(k,951) * lu(k,1045) + lu(k,1054) = lu(k,1054) - lu(k,952) * lu(k,1045) + lu(k,1083) = lu(k,1083) - lu(k,944) * lu(k,1082) + lu(k,1084) = lu(k,1084) - lu(k,945) * lu(k,1082) + lu(k,1085) = lu(k,1085) - lu(k,946) * lu(k,1082) + lu(k,1086) = lu(k,1086) - lu(k,947) * lu(k,1082) + lu(k,1087) = lu(k,1087) - lu(k,948) * lu(k,1082) + lu(k,1088) = lu(k,1088) - lu(k,949) * lu(k,1082) + lu(k,1089) = lu(k,1089) - lu(k,950) * lu(k,1082) + lu(k,1090) = lu(k,1090) - lu(k,951) * lu(k,1082) + lu(k,1091) = lu(k,1091) - lu(k,952) * lu(k,1082) + lu(k,1168) = lu(k,1168) - lu(k,944) * lu(k,1167) + lu(k,1169) = lu(k,1169) - lu(k,945) * lu(k,1167) + lu(k,1170) = lu(k,1170) - lu(k,946) * lu(k,1167) + lu(k,1171) = lu(k,1171) - lu(k,947) * lu(k,1167) + lu(k,1172) = lu(k,1172) - lu(k,948) * lu(k,1167) + lu(k,1173) = lu(k,1173) - lu(k,949) * lu(k,1167) + lu(k,1174) = lu(k,1174) - lu(k,950) * lu(k,1167) + lu(k,1175) = lu(k,1175) - lu(k,951) * lu(k,1167) + lu(k,1176) = lu(k,1176) - lu(k,952) * lu(k,1167) + lu(k,1212) = lu(k,1212) - lu(k,944) * lu(k,1211) + lu(k,1213) = lu(k,1213) - lu(k,945) * lu(k,1211) + lu(k,1214) = lu(k,1214) - lu(k,946) * lu(k,1211) + lu(k,1215) = lu(k,1215) - lu(k,947) * lu(k,1211) + lu(k,1216) = lu(k,1216) - lu(k,948) * lu(k,1211) + lu(k,1217) = lu(k,1217) - lu(k,949) * lu(k,1211) + lu(k,1218) = lu(k,1218) - lu(k,950) * lu(k,1211) + lu(k,1219) = lu(k,1219) - lu(k,951) * lu(k,1211) + lu(k,1220) = lu(k,1220) - lu(k,952) * lu(k,1211) + lu(k,1237) = lu(k,1237) - lu(k,944) * lu(k,1236) + lu(k,1238) = lu(k,1238) - lu(k,945) * lu(k,1236) + lu(k,1239) = lu(k,1239) - lu(k,946) * lu(k,1236) + lu(k,1240) = lu(k,1240) - lu(k,947) * lu(k,1236) + lu(k,1241) = lu(k,1241) - lu(k,948) * lu(k,1236) + lu(k,1242) = lu(k,1242) - lu(k,949) * lu(k,1236) + lu(k,1243) = lu(k,1243) - lu(k,950) * lu(k,1236) + lu(k,1244) = lu(k,1244) - lu(k,951) * lu(k,1236) + lu(k,1245) = lu(k,1245) - lu(k,952) * lu(k,1236) + lu(k,1279) = lu(k,1279) - lu(k,944) * lu(k,1278) + lu(k,1280) = lu(k,1280) - lu(k,945) * lu(k,1278) + lu(k,1281) = lu(k,1281) - lu(k,946) * lu(k,1278) + lu(k,1282) = lu(k,1282) - lu(k,947) * lu(k,1278) + lu(k,1283) = lu(k,1283) - lu(k,948) * lu(k,1278) + lu(k,1284) = lu(k,1284) - lu(k,949) * lu(k,1278) + lu(k,1285) = lu(k,1285) - lu(k,950) * lu(k,1278) + lu(k,1286) = lu(k,1286) - lu(k,951) * lu(k,1278) + lu(k,1287) = lu(k,1287) - lu(k,952) * lu(k,1278) + lu(k,1299) = lu(k,1299) - lu(k,944) * lu(k,1298) + lu(k,1300) = lu(k,1300) - lu(k,945) * lu(k,1298) + lu(k,1301) = lu(k,1301) - lu(k,946) * lu(k,1298) + lu(k,1302) = lu(k,1302) - lu(k,947) * lu(k,1298) + lu(k,1303) = lu(k,1303) - lu(k,948) * lu(k,1298) + lu(k,1304) = lu(k,1304) - lu(k,949) * lu(k,1298) + lu(k,1305) = lu(k,1305) - lu(k,950) * lu(k,1298) + lu(k,1306) = lu(k,1306) - lu(k,951) * lu(k,1298) + lu(k,1307) = lu(k,1307) - lu(k,952) * lu(k,1298) + lu(k,966) = 1._r8 / lu(k,966) + lu(k,967) = lu(k,967) * lu(k,966) + lu(k,968) = lu(k,968) * lu(k,966) + lu(k,969) = lu(k,969) * lu(k,966) + lu(k,970) = lu(k,970) * lu(k,966) + lu(k,971) = lu(k,971) * lu(k,966) + lu(k,972) = lu(k,972) * lu(k,966) + lu(k,973) = lu(k,973) * lu(k,966) + lu(k,974) = lu(k,974) * lu(k,966) + lu(k,1011) = lu(k,1011) - lu(k,967) * lu(k,1010) + lu(k,1012) = lu(k,1012) - lu(k,968) * lu(k,1010) + lu(k,1013) = lu(k,1013) - lu(k,969) * lu(k,1010) + lu(k,1014) = lu(k,1014) - lu(k,970) * lu(k,1010) + lu(k,1015) = lu(k,1015) - lu(k,971) * lu(k,1010) + lu(k,1016) = lu(k,1016) - lu(k,972) * lu(k,1010) + lu(k,1017) = lu(k,1017) - lu(k,973) * lu(k,1010) + lu(k,1018) = lu(k,1018) - lu(k,974) * lu(k,1010) + lu(k,1047) = lu(k,1047) - lu(k,967) * lu(k,1046) + lu(k,1048) = lu(k,1048) - lu(k,968) * lu(k,1046) + lu(k,1049) = lu(k,1049) - lu(k,969) * lu(k,1046) + lu(k,1050) = lu(k,1050) - lu(k,970) * lu(k,1046) + lu(k,1051) = lu(k,1051) - lu(k,971) * lu(k,1046) + lu(k,1052) = lu(k,1052) - lu(k,972) * lu(k,1046) + lu(k,1053) = lu(k,1053) - lu(k,973) * lu(k,1046) + lu(k,1054) = lu(k,1054) - lu(k,974) * lu(k,1046) + lu(k,1084) = lu(k,1084) - lu(k,967) * lu(k,1083) + lu(k,1085) = lu(k,1085) - lu(k,968) * lu(k,1083) + lu(k,1086) = lu(k,1086) - lu(k,969) * lu(k,1083) + lu(k,1087) = lu(k,1087) - lu(k,970) * lu(k,1083) + lu(k,1088) = lu(k,1088) - lu(k,971) * lu(k,1083) + lu(k,1089) = lu(k,1089) - lu(k,972) * lu(k,1083) + lu(k,1090) = lu(k,1090) - lu(k,973) * lu(k,1083) + lu(k,1091) = lu(k,1091) - lu(k,974) * lu(k,1083) + lu(k,1169) = lu(k,1169) - lu(k,967) * lu(k,1168) + lu(k,1170) = lu(k,1170) - lu(k,968) * lu(k,1168) + lu(k,1171) = lu(k,1171) - lu(k,969) * lu(k,1168) + lu(k,1172) = lu(k,1172) - lu(k,970) * lu(k,1168) + lu(k,1173) = lu(k,1173) - lu(k,971) * lu(k,1168) + lu(k,1174) = lu(k,1174) - lu(k,972) * lu(k,1168) + lu(k,1175) = lu(k,1175) - lu(k,973) * lu(k,1168) + lu(k,1176) = lu(k,1176) - lu(k,974) * lu(k,1168) + lu(k,1213) = lu(k,1213) - lu(k,967) * lu(k,1212) + lu(k,1214) = lu(k,1214) - lu(k,968) * lu(k,1212) + lu(k,1215) = lu(k,1215) - lu(k,969) * lu(k,1212) + lu(k,1216) = lu(k,1216) - lu(k,970) * lu(k,1212) + lu(k,1217) = lu(k,1217) - lu(k,971) * lu(k,1212) + lu(k,1218) = lu(k,1218) - lu(k,972) * lu(k,1212) + lu(k,1219) = lu(k,1219) - lu(k,973) * lu(k,1212) + lu(k,1220) = lu(k,1220) - lu(k,974) * lu(k,1212) + lu(k,1238) = lu(k,1238) - lu(k,967) * lu(k,1237) + lu(k,1239) = lu(k,1239) - lu(k,968) * lu(k,1237) + lu(k,1240) = lu(k,1240) - lu(k,969) * lu(k,1237) + lu(k,1241) = lu(k,1241) - lu(k,970) * lu(k,1237) + lu(k,1242) = lu(k,1242) - lu(k,971) * lu(k,1237) + lu(k,1243) = lu(k,1243) - lu(k,972) * lu(k,1237) + lu(k,1244) = lu(k,1244) - lu(k,973) * lu(k,1237) + lu(k,1245) = lu(k,1245) - lu(k,974) * lu(k,1237) + lu(k,1280) = lu(k,1280) - lu(k,967) * lu(k,1279) + lu(k,1281) = lu(k,1281) - lu(k,968) * lu(k,1279) + lu(k,1282) = lu(k,1282) - lu(k,969) * lu(k,1279) + lu(k,1283) = lu(k,1283) - lu(k,970) * lu(k,1279) + lu(k,1284) = lu(k,1284) - lu(k,971) * lu(k,1279) + lu(k,1285) = lu(k,1285) - lu(k,972) * lu(k,1279) + lu(k,1286) = lu(k,1286) - lu(k,973) * lu(k,1279) + lu(k,1287) = lu(k,1287) - lu(k,974) * lu(k,1279) + lu(k,1300) = lu(k,1300) - lu(k,967) * lu(k,1299) + lu(k,1301) = lu(k,1301) - lu(k,968) * lu(k,1299) + lu(k,1302) = lu(k,1302) - lu(k,969) * lu(k,1299) + lu(k,1303) = lu(k,1303) - lu(k,970) * lu(k,1299) + lu(k,1304) = lu(k,1304) - lu(k,971) * lu(k,1299) + lu(k,1305) = lu(k,1305) - lu(k,972) * lu(k,1299) + lu(k,1306) = lu(k,1306) - lu(k,973) * lu(k,1299) + lu(k,1307) = lu(k,1307) - lu(k,974) * lu(k,1299) + lu(k,1011) = 1._r8 / lu(k,1011) + lu(k,1012) = lu(k,1012) * lu(k,1011) + lu(k,1013) = lu(k,1013) * lu(k,1011) + lu(k,1014) = lu(k,1014) * lu(k,1011) + lu(k,1015) = lu(k,1015) * lu(k,1011) + lu(k,1016) = lu(k,1016) * lu(k,1011) + lu(k,1017) = lu(k,1017) * lu(k,1011) + lu(k,1018) = lu(k,1018) * lu(k,1011) + lu(k,1048) = lu(k,1048) - lu(k,1012) * lu(k,1047) + lu(k,1049) = lu(k,1049) - lu(k,1013) * lu(k,1047) + lu(k,1050) = lu(k,1050) - lu(k,1014) * lu(k,1047) + lu(k,1051) = lu(k,1051) - lu(k,1015) * lu(k,1047) + lu(k,1052) = lu(k,1052) - lu(k,1016) * lu(k,1047) + lu(k,1053) = lu(k,1053) - lu(k,1017) * lu(k,1047) + lu(k,1054) = lu(k,1054) - lu(k,1018) * lu(k,1047) + lu(k,1085) = lu(k,1085) - lu(k,1012) * lu(k,1084) + lu(k,1086) = lu(k,1086) - lu(k,1013) * lu(k,1084) + lu(k,1087) = lu(k,1087) - lu(k,1014) * lu(k,1084) + lu(k,1088) = lu(k,1088) - lu(k,1015) * lu(k,1084) + lu(k,1089) = lu(k,1089) - lu(k,1016) * lu(k,1084) + lu(k,1090) = lu(k,1090) - lu(k,1017) * lu(k,1084) + lu(k,1091) = lu(k,1091) - lu(k,1018) * lu(k,1084) + lu(k,1170) = lu(k,1170) - lu(k,1012) * lu(k,1169) + lu(k,1171) = lu(k,1171) - lu(k,1013) * lu(k,1169) + lu(k,1172) = lu(k,1172) - lu(k,1014) * lu(k,1169) + lu(k,1173) = lu(k,1173) - lu(k,1015) * lu(k,1169) + lu(k,1174) = lu(k,1174) - lu(k,1016) * lu(k,1169) + lu(k,1175) = lu(k,1175) - lu(k,1017) * lu(k,1169) + lu(k,1176) = lu(k,1176) - lu(k,1018) * lu(k,1169) + lu(k,1214) = lu(k,1214) - lu(k,1012) * lu(k,1213) + lu(k,1215) = lu(k,1215) - lu(k,1013) * lu(k,1213) + lu(k,1216) = lu(k,1216) - lu(k,1014) * lu(k,1213) + lu(k,1217) = lu(k,1217) - lu(k,1015) * lu(k,1213) + lu(k,1218) = lu(k,1218) - lu(k,1016) * lu(k,1213) + lu(k,1219) = lu(k,1219) - lu(k,1017) * lu(k,1213) + lu(k,1220) = lu(k,1220) - lu(k,1018) * lu(k,1213) + lu(k,1239) = lu(k,1239) - lu(k,1012) * lu(k,1238) + lu(k,1240) = lu(k,1240) - lu(k,1013) * lu(k,1238) + lu(k,1241) = lu(k,1241) - lu(k,1014) * lu(k,1238) + lu(k,1242) = lu(k,1242) - lu(k,1015) * lu(k,1238) + lu(k,1243) = lu(k,1243) - lu(k,1016) * lu(k,1238) + lu(k,1244) = lu(k,1244) - lu(k,1017) * lu(k,1238) + lu(k,1245) = lu(k,1245) - lu(k,1018) * lu(k,1238) + lu(k,1281) = lu(k,1281) - lu(k,1012) * lu(k,1280) + lu(k,1282) = lu(k,1282) - lu(k,1013) * lu(k,1280) + lu(k,1283) = lu(k,1283) - lu(k,1014) * lu(k,1280) + lu(k,1284) = lu(k,1284) - lu(k,1015) * lu(k,1280) + lu(k,1285) = lu(k,1285) - lu(k,1016) * lu(k,1280) + lu(k,1286) = lu(k,1286) - lu(k,1017) * lu(k,1280) + lu(k,1287) = lu(k,1287) - lu(k,1018) * lu(k,1280) + lu(k,1301) = lu(k,1301) - lu(k,1012) * lu(k,1300) + lu(k,1302) = lu(k,1302) - lu(k,1013) * lu(k,1300) + lu(k,1303) = lu(k,1303) - lu(k,1014) * lu(k,1300) + lu(k,1304) = lu(k,1304) - lu(k,1015) * lu(k,1300) + lu(k,1305) = lu(k,1305) - lu(k,1016) * lu(k,1300) + lu(k,1306) = lu(k,1306) - lu(k,1017) * lu(k,1300) + lu(k,1307) = lu(k,1307) - lu(k,1018) * lu(k,1300) + lu(k,1048) = 1._r8 / lu(k,1048) + lu(k,1049) = lu(k,1049) * lu(k,1048) + lu(k,1050) = lu(k,1050) * lu(k,1048) + lu(k,1051) = lu(k,1051) * lu(k,1048) + lu(k,1052) = lu(k,1052) * lu(k,1048) + lu(k,1053) = lu(k,1053) * lu(k,1048) + lu(k,1054) = lu(k,1054) * lu(k,1048) + lu(k,1086) = lu(k,1086) - lu(k,1049) * lu(k,1085) + lu(k,1087) = lu(k,1087) - lu(k,1050) * lu(k,1085) + lu(k,1088) = lu(k,1088) - lu(k,1051) * lu(k,1085) + lu(k,1089) = lu(k,1089) - lu(k,1052) * lu(k,1085) + lu(k,1090) = lu(k,1090) - lu(k,1053) * lu(k,1085) + lu(k,1091) = lu(k,1091) - lu(k,1054) * lu(k,1085) + lu(k,1171) = lu(k,1171) - lu(k,1049) * lu(k,1170) + lu(k,1172) = lu(k,1172) - lu(k,1050) * lu(k,1170) + lu(k,1173) = lu(k,1173) - lu(k,1051) * lu(k,1170) + lu(k,1174) = lu(k,1174) - lu(k,1052) * lu(k,1170) + lu(k,1175) = lu(k,1175) - lu(k,1053) * lu(k,1170) + lu(k,1176) = lu(k,1176) - lu(k,1054) * lu(k,1170) + lu(k,1215) = lu(k,1215) - lu(k,1049) * lu(k,1214) + lu(k,1216) = lu(k,1216) - lu(k,1050) * lu(k,1214) + lu(k,1217) = lu(k,1217) - lu(k,1051) * lu(k,1214) + lu(k,1218) = lu(k,1218) - lu(k,1052) * lu(k,1214) + lu(k,1219) = lu(k,1219) - lu(k,1053) * lu(k,1214) + lu(k,1220) = lu(k,1220) - lu(k,1054) * lu(k,1214) + lu(k,1240) = lu(k,1240) - lu(k,1049) * lu(k,1239) + lu(k,1241) = lu(k,1241) - lu(k,1050) * lu(k,1239) + lu(k,1242) = lu(k,1242) - lu(k,1051) * lu(k,1239) + lu(k,1243) = lu(k,1243) - lu(k,1052) * lu(k,1239) + lu(k,1244) = lu(k,1244) - lu(k,1053) * lu(k,1239) + lu(k,1245) = lu(k,1245) - lu(k,1054) * lu(k,1239) + lu(k,1282) = lu(k,1282) - lu(k,1049) * lu(k,1281) + lu(k,1283) = lu(k,1283) - lu(k,1050) * lu(k,1281) + lu(k,1284) = lu(k,1284) - lu(k,1051) * lu(k,1281) + lu(k,1285) = lu(k,1285) - lu(k,1052) * lu(k,1281) + lu(k,1286) = lu(k,1286) - lu(k,1053) * lu(k,1281) + lu(k,1287) = lu(k,1287) - lu(k,1054) * lu(k,1281) + lu(k,1302) = lu(k,1302) - lu(k,1049) * lu(k,1301) + lu(k,1303) = lu(k,1303) - lu(k,1050) * lu(k,1301) + lu(k,1304) = lu(k,1304) - lu(k,1051) * lu(k,1301) + lu(k,1305) = lu(k,1305) - lu(k,1052) * lu(k,1301) + lu(k,1306) = lu(k,1306) - lu(k,1053) * lu(k,1301) + lu(k,1307) = lu(k,1307) - lu(k,1054) * lu(k,1301) + lu(k,1086) = 1._r8 / lu(k,1086) + lu(k,1087) = lu(k,1087) * lu(k,1086) + lu(k,1088) = lu(k,1088) * lu(k,1086) + lu(k,1089) = lu(k,1089) * lu(k,1086) + lu(k,1090) = lu(k,1090) * lu(k,1086) + lu(k,1091) = lu(k,1091) * lu(k,1086) + lu(k,1172) = lu(k,1172) - lu(k,1087) * lu(k,1171) + lu(k,1173) = lu(k,1173) - lu(k,1088) * lu(k,1171) + lu(k,1174) = lu(k,1174) - lu(k,1089) * lu(k,1171) + lu(k,1175) = lu(k,1175) - lu(k,1090) * lu(k,1171) + lu(k,1176) = lu(k,1176) - lu(k,1091) * lu(k,1171) + lu(k,1216) = lu(k,1216) - lu(k,1087) * lu(k,1215) + lu(k,1217) = lu(k,1217) - lu(k,1088) * lu(k,1215) + lu(k,1218) = lu(k,1218) - lu(k,1089) * lu(k,1215) + lu(k,1219) = lu(k,1219) - lu(k,1090) * lu(k,1215) + lu(k,1220) = lu(k,1220) - lu(k,1091) * lu(k,1215) + lu(k,1241) = lu(k,1241) - lu(k,1087) * lu(k,1240) + lu(k,1242) = lu(k,1242) - lu(k,1088) * lu(k,1240) + lu(k,1243) = lu(k,1243) - lu(k,1089) * lu(k,1240) + lu(k,1244) = lu(k,1244) - lu(k,1090) * lu(k,1240) + lu(k,1245) = lu(k,1245) - lu(k,1091) * lu(k,1240) + lu(k,1283) = lu(k,1283) - lu(k,1087) * lu(k,1282) + lu(k,1284) = lu(k,1284) - lu(k,1088) * lu(k,1282) + lu(k,1285) = lu(k,1285) - lu(k,1089) * lu(k,1282) + lu(k,1286) = lu(k,1286) - lu(k,1090) * lu(k,1282) + lu(k,1287) = lu(k,1287) - lu(k,1091) * lu(k,1282) + lu(k,1303) = lu(k,1303) - lu(k,1087) * lu(k,1302) + lu(k,1304) = lu(k,1304) - lu(k,1088) * lu(k,1302) + lu(k,1305) = lu(k,1305) - lu(k,1089) * lu(k,1302) + lu(k,1306) = lu(k,1306) - lu(k,1090) * lu(k,1302) + lu(k,1307) = lu(k,1307) - lu(k,1091) * lu(k,1302) + end do + end subroutine lu_fac17 + subroutine lu_fac18( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) +!----------------------------------------------------------------------- +! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + lu(k,1172) = 1._r8 / lu(k,1172) + lu(k,1173) = lu(k,1173) * lu(k,1172) + lu(k,1174) = lu(k,1174) * lu(k,1172) + lu(k,1175) = lu(k,1175) * lu(k,1172) + lu(k,1176) = lu(k,1176) * lu(k,1172) + lu(k,1217) = lu(k,1217) - lu(k,1173) * lu(k,1216) + lu(k,1218) = lu(k,1218) - lu(k,1174) * lu(k,1216) + lu(k,1219) = lu(k,1219) - lu(k,1175) * lu(k,1216) + lu(k,1220) = lu(k,1220) - lu(k,1176) * lu(k,1216) + lu(k,1242) = lu(k,1242) - lu(k,1173) * lu(k,1241) + lu(k,1243) = lu(k,1243) - lu(k,1174) * lu(k,1241) + lu(k,1244) = lu(k,1244) - lu(k,1175) * lu(k,1241) + lu(k,1245) = lu(k,1245) - lu(k,1176) * lu(k,1241) + lu(k,1284) = lu(k,1284) - lu(k,1173) * lu(k,1283) + lu(k,1285) = lu(k,1285) - lu(k,1174) * lu(k,1283) + lu(k,1286) = lu(k,1286) - lu(k,1175) * lu(k,1283) + lu(k,1287) = lu(k,1287) - lu(k,1176) * lu(k,1283) + lu(k,1304) = lu(k,1304) - lu(k,1173) * lu(k,1303) + lu(k,1305) = lu(k,1305) - lu(k,1174) * lu(k,1303) + lu(k,1306) = lu(k,1306) - lu(k,1175) * lu(k,1303) + lu(k,1307) = lu(k,1307) - lu(k,1176) * lu(k,1303) + lu(k,1217) = 1._r8 / lu(k,1217) + lu(k,1218) = lu(k,1218) * lu(k,1217) + lu(k,1219) = lu(k,1219) * lu(k,1217) + lu(k,1220) = lu(k,1220) * lu(k,1217) + lu(k,1243) = lu(k,1243) - lu(k,1218) * lu(k,1242) + lu(k,1244) = lu(k,1244) - lu(k,1219) * lu(k,1242) + lu(k,1245) = lu(k,1245) - lu(k,1220) * lu(k,1242) + lu(k,1285) = lu(k,1285) - lu(k,1218) * lu(k,1284) + lu(k,1286) = lu(k,1286) - lu(k,1219) * lu(k,1284) + lu(k,1287) = lu(k,1287) - lu(k,1220) * lu(k,1284) + lu(k,1305) = lu(k,1305) - lu(k,1218) * lu(k,1304) + lu(k,1306) = lu(k,1306) - lu(k,1219) * lu(k,1304) + lu(k,1307) = lu(k,1307) - lu(k,1220) * lu(k,1304) + lu(k,1243) = 1._r8 / lu(k,1243) + lu(k,1244) = lu(k,1244) * lu(k,1243) + lu(k,1245) = lu(k,1245) * lu(k,1243) + lu(k,1286) = lu(k,1286) - lu(k,1244) * lu(k,1285) + lu(k,1287) = lu(k,1287) - lu(k,1245) * lu(k,1285) + lu(k,1306) = lu(k,1306) - lu(k,1244) * lu(k,1305) + lu(k,1307) = lu(k,1307) - lu(k,1245) * lu(k,1305) + lu(k,1286) = 1._r8 / lu(k,1286) + lu(k,1287) = lu(k,1287) * lu(k,1286) + lu(k,1307) = lu(k,1307) - lu(k,1287) * lu(k,1306) + lu(k,1307) = 1._r8 / lu(k,1307) + end do + end subroutine lu_fac18 + subroutine lu_fac( avec_len, lu ) + use chem_mods, only : nzcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!----------------------------------------------------------------------- +! ... dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(inout) :: lu(veclen,nzcnt) + call lu_fac01( avec_len, lu ) + call lu_fac02( avec_len, lu ) + call lu_fac03( avec_len, lu ) + call lu_fac04( avec_len, lu ) + call lu_fac05( avec_len, lu ) + call lu_fac06( avec_len, lu ) + call lu_fac07( avec_len, lu ) + call lu_fac08( avec_len, lu ) + call lu_fac09( avec_len, lu ) + call lu_fac10( avec_len, lu ) + call lu_fac11( avec_len, lu ) + call lu_fac12( avec_len, lu ) + call lu_fac13( avec_len, lu ) + call lu_fac14( avec_len, lu ) + call lu_fac15( avec_len, lu ) + call lu_fac16( avec_len, lu ) + call lu_fac17( avec_len, lu ) + call lu_fac18( avec_len, lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_solve.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_solve.F90 new file mode 100644 index 0000000000..fa84d27128 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_lu_solve.F90 @@ -0,0 +1,1495 @@ + module mo_lu_solve + use chem_mods, only: veclen + private + public :: lu_slv + contains + subroutine lu_slv01( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,124) = b(k,124) - lu(k,10) * b(k,9) + b(k,32) = b(k,32) - lu(k,33) * b(k,31) + b(k,128) = b(k,128) - lu(k,37) * b(k,34) + b(k,137) = b(k,137) - lu(k,38) * b(k,34) + b(k,98) = b(k,98) - lu(k,40) * b(k,35) + b(k,135) = b(k,135) - lu(k,41) * b(k,35) + b(k,126) = b(k,126) - lu(k,43) * b(k,36) + b(k,134) = b(k,134) - lu(k,44) * b(k,36) + b(k,135) = b(k,135) - lu(k,46) * b(k,37) + b(k,139) = b(k,139) - lu(k,47) * b(k,37) + b(k,128) = b(k,128) - lu(k,49) * b(k,38) + b(k,134) = b(k,134) - lu(k,50) * b(k,38) + b(k,126) = b(k,126) - lu(k,52) * b(k,39) + b(k,134) = b(k,134) - lu(k,53) * b(k,39) + b(k,128) = b(k,128) - lu(k,55) * b(k,40) + b(k,134) = b(k,134) - lu(k,56) * b(k,40) + b(k,128) = b(k,128) - lu(k,58) * b(k,41) + b(k,134) = b(k,134) - lu(k,59) * b(k,41) + b(k,128) = b(k,128) - lu(k,61) * b(k,42) + b(k,134) = b(k,134) - lu(k,62) * b(k,42) + b(k,128) = b(k,128) - lu(k,64) * b(k,43) + b(k,134) = b(k,134) - lu(k,65) * b(k,43) + b(k,128) = b(k,128) - lu(k,67) * b(k,44) + b(k,134) = b(k,134) - lu(k,68) * b(k,44) + b(k,98) = b(k,98) - lu(k,70) * b(k,45) + b(k,135) = b(k,135) - lu(k,71) * b(k,45) + b(k,139) = b(k,139) - lu(k,72) * b(k,45) + b(k,126) = b(k,126) - lu(k,74) * b(k,46) + b(k,128) = b(k,128) - lu(k,75) * b(k,46) + b(k,134) = b(k,134) - lu(k,76) * b(k,46) + b(k,128) = b(k,128) - lu(k,78) * b(k,47) + b(k,135) = b(k,135) - lu(k,79) * b(k,47) + b(k,139) = b(k,139) - lu(k,80) * b(k,47) + b(k,59) = b(k,59) - lu(k,82) * b(k,48) + b(k,135) = b(k,135) - lu(k,83) * b(k,48) + b(k,58) = b(k,58) - lu(k,85) * b(k,49) + b(k,139) = b(k,139) - lu(k,86) * b(k,49) + b(k,128) = b(k,128) - lu(k,88) * b(k,50) + b(k,128) = b(k,128) - lu(k,90) * b(k,51) + b(k,134) = b(k,134) - lu(k,91) * b(k,51) + b(k,135) = b(k,135) - lu(k,92) * b(k,51) + b(k,128) = b(k,128) - lu(k,94) * b(k,52) + b(k,134) = b(k,134) - lu(k,95) * b(k,52) + b(k,135) = b(k,135) - lu(k,96) * b(k,52) + b(k,134) = b(k,134) - lu(k,98) * b(k,53) + b(k,138) = b(k,138) - lu(k,99) * b(k,53) + b(k,115) = b(k,115) - lu(k,101) * b(k,54) + b(k,135) = b(k,135) - lu(k,102) * b(k,54) + b(k,128) = b(k,128) - lu(k,104) * b(k,55) + b(k,134) = b(k,134) - lu(k,105) * b(k,55) + b(k,135) = b(k,135) - lu(k,106) * b(k,55) + b(k,139) = b(k,139) - lu(k,107) * b(k,55) + b(k,126) = b(k,126) - lu(k,109) * b(k,56) + b(k,128) = b(k,128) - lu(k,110) * b(k,56) + b(k,113) = b(k,113) - lu(k,112) * b(k,57) + b(k,130) = b(k,130) - lu(k,113) * b(k,57) + b(k,135) = b(k,135) - lu(k,114) * b(k,57) + b(k,102) = b(k,102) - lu(k,117) * b(k,58) + b(k,129) = b(k,129) - lu(k,118) * b(k,58) + b(k,139) = b(k,139) - lu(k,119) * b(k,58) + b(k,105) = b(k,105) - lu(k,121) * b(k,59) + b(k,125) = b(k,125) - lu(k,122) * b(k,59) + b(k,130) = b(k,130) - lu(k,123) * b(k,59) + b(k,101) = b(k,101) - lu(k,125) * b(k,60) + b(k,129) = b(k,129) - lu(k,126) * b(k,60) + b(k,133) = b(k,133) - lu(k,127) * b(k,60) + b(k,136) = b(k,136) - lu(k,128) * b(k,60) + b(k,138) = b(k,138) - lu(k,129) * b(k,60) + b(k,96) = b(k,96) - lu(k,131) * b(k,61) + b(k,127) = b(k,127) - lu(k,132) * b(k,61) + b(k,128) = b(k,128) - lu(k,133) * b(k,61) + b(k,135) = b(k,135) - lu(k,134) * b(k,61) + b(k,139) = b(k,139) - lu(k,135) * b(k,61) + b(k,101) = b(k,101) - lu(k,137) * b(k,62) + b(k,102) = b(k,102) - lu(k,138) * b(k,62) + b(k,130) = b(k,130) - lu(k,139) * b(k,62) + b(k,135) = b(k,135) - lu(k,140) * b(k,62) + b(k,136) = b(k,136) - lu(k,141) * b(k,62) + b(k,119) = b(k,119) - lu(k,143) * b(k,63) + b(k,120) = b(k,120) - lu(k,144) * b(k,63) + b(k,130) = b(k,130) - lu(k,145) * b(k,63) + b(k,135) = b(k,135) - lu(k,146) * b(k,63) + b(k,96) = b(k,96) - lu(k,148) * b(k,64) + b(k,113) = b(k,113) - lu(k,149) * b(k,64) + b(k,130) = b(k,130) - lu(k,150) * b(k,64) + b(k,135) = b(k,135) - lu(k,151) * b(k,64) + b(k,102) = b(k,102) - lu(k,153) * b(k,65) + b(k,117) = b(k,117) - lu(k,154) * b(k,65) + b(k,129) = b(k,129) - lu(k,155) * b(k,65) + b(k,137) = b(k,137) - lu(k,156) * b(k,65) + b(k,115) = b(k,115) - lu(k,158) * b(k,66) + b(k,135) = b(k,135) - lu(k,159) * b(k,66) + b(k,78) = b(k,78) - lu(k,161) * b(k,67) + b(k,102) = b(k,102) - lu(k,162) * b(k,67) + b(k,110) = b(k,110) - lu(k,163) * b(k,67) + b(k,117) = b(k,117) - lu(k,164) * b(k,67) + b(k,124) = b(k,124) - lu(k,165) * b(k,67) + b(k,129) = b(k,129) - lu(k,166) * b(k,67) + b(k,135) = b(k,135) - lu(k,167) * b(k,67) + b(k,110) = b(k,110) - lu(k,169) * b(k,68) + b(k,123) = b(k,123) - lu(k,170) * b(k,68) + b(k,127) = b(k,127) - lu(k,171) * b(k,68) + b(k,128) = b(k,128) - lu(k,172) * b(k,68) + b(k,130) = b(k,130) - lu(k,173) * b(k,68) + b(k,135) = b(k,135) - lu(k,174) * b(k,68) + b(k,139) = b(k,139) - lu(k,175) * b(k,68) + b(k,130) = b(k,130) - lu(k,177) * b(k,69) + b(k,133) = b(k,133) - lu(k,178) * b(k,69) + b(k,135) = b(k,135) - lu(k,179) * b(k,69) + b(k,136) = b(k,136) - lu(k,180) * b(k,69) + b(k,139) = b(k,139) - lu(k,181) * b(k,69) + b(k,126) = b(k,126) - lu(k,183) * b(k,70) + b(k,127) = b(k,127) - lu(k,184) * b(k,70) + b(k,128) = b(k,128) - lu(k,185) * b(k,70) + b(k,134) = b(k,134) - lu(k,186) * b(k,70) + b(k,135) = b(k,135) - lu(k,187) * b(k,70) + b(k,95) = b(k,95) - lu(k,189) * b(k,71) + b(k,98) = b(k,98) - lu(k,190) * b(k,71) + b(k,130) = b(k,130) - lu(k,191) * b(k,71) + b(k,135) = b(k,135) - lu(k,192) * b(k,71) + b(k,139) = b(k,139) - lu(k,193) * b(k,71) + b(k,116) = b(k,116) - lu(k,195) * b(k,72) + b(k,121) = b(k,121) - lu(k,196) * b(k,72) + b(k,125) = b(k,125) - lu(k,197) * b(k,72) + b(k,133) = b(k,133) - lu(k,198) * b(k,72) + b(k,135) = b(k,135) - lu(k,199) * b(k,72) + b(k,123) = b(k,123) - lu(k,201) * b(k,73) + b(k,124) = b(k,124) - lu(k,202) * b(k,73) + b(k,125) = b(k,125) - lu(k,203) * b(k,73) + b(k,135) = b(k,135) - lu(k,204) * b(k,73) + b(k,139) = b(k,139) - lu(k,205) * b(k,73) + b(k,108) = b(k,108) - lu(k,207) * b(k,74) + b(k,121) = b(k,121) - lu(k,208) * b(k,74) + b(k,125) = b(k,125) - lu(k,209) * b(k,74) + b(k,135) = b(k,135) - lu(k,210) * b(k,74) + b(k,139) = b(k,139) - lu(k,211) * b(k,74) + b(k,124) = b(k,124) - lu(k,214) * b(k,75) + b(k,129) = b(k,129) - lu(k,215) * b(k,75) + b(k,133) = b(k,133) - lu(k,216) * b(k,75) + b(k,134) = b(k,134) - lu(k,217) * b(k,75) + b(k,135) = b(k,135) - lu(k,218) * b(k,75) + b(k,138) = b(k,138) - lu(k,219) * b(k,75) + b(k,91) = b(k,91) - lu(k,221) * b(k,76) + b(k,110) = b(k,110) - lu(k,222) * b(k,76) + b(k,125) = b(k,125) - lu(k,223) * b(k,76) + b(k,130) = b(k,130) - lu(k,224) * b(k,76) + b(k,132) = b(k,132) - lu(k,225) * b(k,76) + b(k,135) = b(k,135) - lu(k,226) * b(k,76) + b(k,126) = b(k,126) - lu(k,228) * b(k,77) + b(k,127) = b(k,127) - lu(k,229) * b(k,77) + b(k,128) = b(k,128) - lu(k,230) * b(k,77) + b(k,134) = b(k,134) - lu(k,231) * b(k,77) + b(k,135) = b(k,135) - lu(k,232) * b(k,77) + b(k,139) = b(k,139) - lu(k,233) * b(k,77) + b(k,117) = b(k,117) - lu(k,235) * b(k,78) + b(k,124) = b(k,124) - lu(k,236) * b(k,78) + b(k,129) = b(k,129) - lu(k,237) * b(k,78) + b(k,132) = b(k,132) - lu(k,238) * b(k,78) + b(k,135) = b(k,135) - lu(k,239) * b(k,78) + b(k,114) = b(k,114) - lu(k,241) * b(k,79) + b(k,115) = b(k,115) - lu(k,242) * b(k,79) + b(k,118) = b(k,118) - lu(k,243) * b(k,79) + b(k,122) = b(k,122) - lu(k,244) * b(k,79) + b(k,125) = b(k,125) - lu(k,245) * b(k,79) + b(k,130) = b(k,130) - lu(k,246) * b(k,79) + b(k,135) = b(k,135) - lu(k,247) * b(k,79) + b(k,125) = b(k,125) - lu(k,249) * b(k,80) + b(k,130) = b(k,130) - lu(k,250) * b(k,80) + b(k,135) = b(k,135) - lu(k,251) * b(k,80) + b(k,90) = b(k,90) - lu(k,253) * b(k,81) + b(k,121) = b(k,121) - lu(k,254) * b(k,81) + b(k,123) = b(k,123) - lu(k,255) * b(k,81) + b(k,125) = b(k,125) - lu(k,256) * b(k,81) + b(k,133) = b(k,133) - lu(k,257) * b(k,81) + b(k,135) = b(k,135) - lu(k,258) * b(k,81) + b(k,136) = b(k,136) - lu(k,259) * b(k,81) + b(k,93) = b(k,93) - lu(k,261) * b(k,82) + b(k,109) = b(k,109) - lu(k,262) * b(k,82) + b(k,113) = b(k,113) - lu(k,263) * b(k,82) + b(k,125) = b(k,125) - lu(k,264) * b(k,82) + b(k,130) = b(k,130) - lu(k,265) * b(k,82) + b(k,135) = b(k,135) - lu(k,266) * b(k,82) + b(k,139) = b(k,139) - lu(k,267) * b(k,82) + b(k,94) = b(k,94) - lu(k,269) * b(k,83) + b(k,101) = b(k,101) - lu(k,270) * b(k,83) + b(k,126) = b(k,126) - lu(k,271) * b(k,83) + b(k,129) = b(k,129) - lu(k,272) * b(k,83) + b(k,131) = b(k,131) - lu(k,273) * b(k,83) + b(k,133) = b(k,133) - lu(k,274) * b(k,83) + b(k,136) = b(k,136) - lu(k,275) * b(k,83) + b(k,127) = b(k,127) - lu(k,277) * b(k,84) + b(k,128) = b(k,128) - lu(k,278) * b(k,84) + b(k,129) = b(k,129) - lu(k,279) * b(k,84) + b(k,130) = b(k,130) - lu(k,280) * b(k,84) + b(k,135) = b(k,135) - lu(k,281) * b(k,84) + b(k,139) = b(k,139) - lu(k,282) * b(k,84) + b(k,90) = b(k,90) - lu(k,284) * b(k,85) + b(k,109) = b(k,109) - lu(k,285) * b(k,85) + b(k,120) = b(k,120) - lu(k,286) * b(k,85) + b(k,125) = b(k,125) - lu(k,287) * b(k,85) + b(k,130) = b(k,130) - lu(k,288) * b(k,85) + b(k,133) = b(k,133) - lu(k,289) * b(k,85) + b(k,135) = b(k,135) - lu(k,290) * b(k,85) + b(k,136) = b(k,136) - lu(k,291) * b(k,85) + end do + end subroutine lu_slv01 + subroutine lu_slv02( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,123) = b(k,123) - lu(k,293) * b(k,86) + b(k,126) = b(k,126) - lu(k,294) * b(k,86) + b(k,127) = b(k,127) - lu(k,295) * b(k,86) + b(k,128) = b(k,128) - lu(k,296) * b(k,86) + b(k,130) = b(k,130) - lu(k,297) * b(k,86) + b(k,134) = b(k,134) - lu(k,298) * b(k,86) + b(k,135) = b(k,135) - lu(k,299) * b(k,86) + b(k,139) = b(k,139) - lu(k,300) * b(k,86) + b(k,90) = b(k,90) - lu(k,302) * b(k,87) + b(k,121) = b(k,121) - lu(k,303) * b(k,87) + b(k,123) = b(k,123) - lu(k,304) * b(k,87) + b(k,125) = b(k,125) - lu(k,305) * b(k,87) + b(k,135) = b(k,135) - lu(k,306) * b(k,87) + b(k,139) = b(k,139) - lu(k,307) * b(k,87) + b(k,95) = b(k,95) - lu(k,309) * b(k,88) + b(k,114) = b(k,114) - lu(k,310) * b(k,88) + b(k,118) = b(k,118) - lu(k,311) * b(k,88) + b(k,122) = b(k,122) - lu(k,312) * b(k,88) + b(k,129) = b(k,129) - lu(k,313) * b(k,88) + b(k,132) = b(k,132) - lu(k,314) * b(k,88) + b(k,133) = b(k,133) - lu(k,315) * b(k,88) + b(k,135) = b(k,135) - lu(k,316) * b(k,88) + b(k,136) = b(k,136) - lu(k,317) * b(k,88) + b(k,90) = b(k,90) - lu(k,319) * b(k,89) + b(k,123) = b(k,123) - lu(k,320) * b(k,89) + b(k,135) = b(k,135) - lu(k,321) * b(k,89) + b(k,139) = b(k,139) - lu(k,322) * b(k,89) + b(k,110) = b(k,110) - lu(k,324) * b(k,90) + b(k,129) = b(k,129) - lu(k,325) * b(k,90) + b(k,105) = b(k,105) - lu(k,329) * b(k,91) + b(k,125) = b(k,125) - lu(k,330) * b(k,91) + b(k,130) = b(k,130) - lu(k,331) * b(k,91) + b(k,133) = b(k,133) - lu(k,332) * b(k,91) + b(k,135) = b(k,135) - lu(k,333) * b(k,91) + b(k,138) = b(k,138) - lu(k,334) * b(k,91) + b(k,110) = b(k,110) - lu(k,337) * b(k,92) + b(k,129) = b(k,129) - lu(k,338) * b(k,92) + b(k,130) = b(k,130) - lu(k,339) * b(k,92) + b(k,135) = b(k,135) - lu(k,340) * b(k,92) + b(k,109) = b(k,109) - lu(k,343) * b(k,93) + b(k,113) = b(k,113) - lu(k,344) * b(k,93) + b(k,125) = b(k,125) - lu(k,345) * b(k,93) + b(k,130) = b(k,130) - lu(k,346) * b(k,93) + b(k,133) = b(k,133) - lu(k,347) * b(k,93) + b(k,135) = b(k,135) - lu(k,348) * b(k,93) + b(k,138) = b(k,138) - lu(k,349) * b(k,93) + b(k,139) = b(k,139) - lu(k,350) * b(k,93) + b(k,126) = b(k,126) - lu(k,353) * b(k,94) + b(k,127) = b(k,127) - lu(k,354) * b(k,94) + b(k,128) = b(k,128) - lu(k,355) * b(k,94) + b(k,129) = b(k,129) - lu(k,356) * b(k,94) + b(k,131) = b(k,131) - lu(k,357) * b(k,94) + b(k,135) = b(k,135) - lu(k,358) * b(k,94) + b(k,139) = b(k,139) - lu(k,359) * b(k,94) + b(k,108) = b(k,108) - lu(k,361) * b(k,95) + b(k,121) = b(k,121) - lu(k,362) * b(k,95) + b(k,123) = b(k,123) - lu(k,363) * b(k,95) + b(k,135) = b(k,135) - lu(k,364) * b(k,95) + b(k,139) = b(k,139) - lu(k,365) * b(k,95) + b(k,113) = b(k,113) - lu(k,370) * b(k,96) + b(k,123) = b(k,123) - lu(k,371) * b(k,96) + b(k,125) = b(k,125) - lu(k,372) * b(k,96) + b(k,130) = b(k,130) - lu(k,373) * b(k,96) + b(k,133) = b(k,133) - lu(k,374) * b(k,96) + b(k,135) = b(k,135) - lu(k,375) * b(k,96) + b(k,138) = b(k,138) - lu(k,376) * b(k,96) + b(k,106) = b(k,106) - lu(k,378) * b(k,97) + b(k,114) = b(k,114) - lu(k,379) * b(k,97) + b(k,122) = b(k,122) - lu(k,380) * b(k,97) + b(k,125) = b(k,125) - lu(k,381) * b(k,97) + b(k,130) = b(k,130) - lu(k,382) * b(k,97) + b(k,133) = b(k,133) - lu(k,383) * b(k,97) + b(k,135) = b(k,135) - lu(k,384) * b(k,97) + b(k,136) = b(k,136) - lu(k,385) * b(k,97) + b(k,138) = b(k,138) - lu(k,386) * b(k,97) + b(k,108) = b(k,108) - lu(k,390) * b(k,98) + b(k,113) = b(k,113) - lu(k,391) * b(k,98) + b(k,121) = b(k,121) - lu(k,392) * b(k,98) + b(k,123) = b(k,123) - lu(k,393) * b(k,98) + b(k,125) = b(k,125) - lu(k,394) * b(k,98) + b(k,130) = b(k,130) - lu(k,395) * b(k,98) + b(k,133) = b(k,133) - lu(k,396) * b(k,98) + b(k,135) = b(k,135) - lu(k,397) * b(k,98) + b(k,138) = b(k,138) - lu(k,398) * b(k,98) + b(k,139) = b(k,139) - lu(k,399) * b(k,98) + b(k,127) = b(k,127) - lu(k,402) * b(k,99) + b(k,128) = b(k,128) - lu(k,403) * b(k,99) + b(k,129) = b(k,129) - lu(k,404) * b(k,99) + b(k,135) = b(k,135) - lu(k,405) * b(k,99) + b(k,137) = b(k,137) - lu(k,406) * b(k,99) + b(k,139) = b(k,139) - lu(k,407) * b(k,99) + b(k,124) = b(k,124) - lu(k,409) * b(k,100) + b(k,126) = b(k,126) - lu(k,410) * b(k,100) + b(k,129) = b(k,129) - lu(k,411) * b(k,100) + b(k,131) = b(k,131) - lu(k,412) * b(k,100) + b(k,134) = b(k,134) - lu(k,413) * b(k,100) + b(k,135) = b(k,135) - lu(k,414) * b(k,100) + b(k,139) = b(k,139) - lu(k,415) * b(k,100) + b(k,133) = b(k,133) - lu(k,417) * b(k,101) + b(k,135) = b(k,135) - lu(k,418) * b(k,101) + b(k,136) = b(k,136) - lu(k,419) * b(k,101) + b(k,139) = b(k,139) - lu(k,420) * b(k,101) + b(k,117) = b(k,117) - lu(k,423) * b(k,102) + b(k,129) = b(k,129) - lu(k,424) * b(k,102) + b(k,130) = b(k,130) - lu(k,425) * b(k,102) + b(k,135) = b(k,135) - lu(k,426) * b(k,102) + b(k,139) = b(k,139) - lu(k,427) * b(k,102) + b(k,106) = b(k,106) - lu(k,430) * b(k,103) + b(k,110) = b(k,110) - lu(k,431) * b(k,103) + b(k,112) = b(k,112) - lu(k,432) * b(k,103) + b(k,114) = b(k,114) - lu(k,433) * b(k,103) + b(k,118) = b(k,118) - lu(k,434) * b(k,103) + b(k,121) = b(k,121) - lu(k,435) * b(k,103) + b(k,122) = b(k,122) - lu(k,436) * b(k,103) + b(k,123) = b(k,123) - lu(k,437) * b(k,103) + b(k,125) = b(k,125) - lu(k,438) * b(k,103) + b(k,130) = b(k,130) - lu(k,439) * b(k,103) + b(k,132) = b(k,132) - lu(k,440) * b(k,103) + b(k,133) = b(k,133) - lu(k,441) * b(k,103) + b(k,135) = b(k,135) - lu(k,442) * b(k,103) + b(k,136) = b(k,136) - lu(k,443) * b(k,103) + b(k,138) = b(k,138) - lu(k,444) * b(k,103) + b(k,127) = b(k,127) - lu(k,449) * b(k,104) + b(k,128) = b(k,128) - lu(k,450) * b(k,104) + b(k,129) = b(k,129) - lu(k,451) * b(k,104) + b(k,133) = b(k,133) - lu(k,452) * b(k,104) + b(k,135) = b(k,135) - lu(k,453) * b(k,104) + b(k,136) = b(k,136) - lu(k,454) * b(k,104) + b(k,137) = b(k,137) - lu(k,455) * b(k,104) + b(k,139) = b(k,139) - lu(k,456) * b(k,104) + b(k,110) = b(k,110) - lu(k,460) * b(k,105) + b(k,125) = b(k,125) - lu(k,461) * b(k,105) + b(k,129) = b(k,129) - lu(k,462) * b(k,105) + b(k,130) = b(k,130) - lu(k,463) * b(k,105) + b(k,135) = b(k,135) - lu(k,464) * b(k,105) + b(k,110) = b(k,110) - lu(k,468) * b(k,106) + b(k,115) = b(k,115) - lu(k,469) * b(k,106) + b(k,125) = b(k,125) - lu(k,470) * b(k,106) + b(k,130) = b(k,130) - lu(k,471) * b(k,106) + b(k,133) = b(k,133) - lu(k,472) * b(k,106) + b(k,135) = b(k,135) - lu(k,473) * b(k,106) + b(k,136) = b(k,136) - lu(k,474) * b(k,106) + b(k,139) = b(k,139) - lu(k,475) * b(k,106) + b(k,110) = b(k,110) - lu(k,478) * b(k,107) + b(k,111) = b(k,111) - lu(k,479) * b(k,107) + b(k,123) = b(k,123) - lu(k,480) * b(k,107) + b(k,124) = b(k,124) - lu(k,481) * b(k,107) + b(k,125) = b(k,125) - lu(k,482) * b(k,107) + b(k,127) = b(k,127) - lu(k,483) * b(k,107) + b(k,128) = b(k,128) - lu(k,484) * b(k,107) + b(k,129) = b(k,129) - lu(k,485) * b(k,107) + b(k,130) = b(k,130) - lu(k,486) * b(k,107) + b(k,134) = b(k,134) - lu(k,487) * b(k,107) + b(k,135) = b(k,135) - lu(k,488) * b(k,107) + b(k,139) = b(k,139) - lu(k,489) * b(k,107) + b(k,109) = b(k,109) - lu(k,493) * b(k,108) + b(k,116) = b(k,116) - lu(k,494) * b(k,108) + b(k,121) = b(k,121) - lu(k,495) * b(k,108) + b(k,123) = b(k,123) - lu(k,496) * b(k,108) + b(k,125) = b(k,125) - lu(k,497) * b(k,108) + b(k,130) = b(k,130) - lu(k,498) * b(k,108) + b(k,133) = b(k,133) - lu(k,499) * b(k,108) + b(k,135) = b(k,135) - lu(k,500) * b(k,108) + b(k,138) = b(k,138) - lu(k,501) * b(k,108) + b(k,139) = b(k,139) - lu(k,502) * b(k,108) + b(k,116) = b(k,116) - lu(k,504) * b(k,109) + b(k,121) = b(k,121) - lu(k,505) * b(k,109) + b(k,125) = b(k,125) - lu(k,506) * b(k,109) + b(k,130) = b(k,130) - lu(k,507) * b(k,109) + b(k,135) = b(k,135) - lu(k,508) * b(k,109) + b(k,129) = b(k,129) - lu(k,511) * b(k,110) + b(k,130) = b(k,130) - lu(k,512) * b(k,110) + b(k,135) = b(k,135) - lu(k,513) * b(k,110) + b(k,124) = b(k,124) - lu(k,515) * b(k,111) + b(k,127) = b(k,127) - lu(k,516) * b(k,111) + b(k,128) = b(k,128) - lu(k,517) * b(k,111) + b(k,129) = b(k,129) - lu(k,518) * b(k,111) + b(k,134) = b(k,134) - lu(k,519) * b(k,111) + b(k,135) = b(k,135) - lu(k,520) * b(k,111) + b(k,139) = b(k,139) - lu(k,521) * b(k,111) + b(k,113) = b(k,113) - lu(k,531) * b(k,112) + b(k,116) = b(k,116) - lu(k,532) * b(k,112) + b(k,121) = b(k,121) - lu(k,533) * b(k,112) + b(k,123) = b(k,123) - lu(k,534) * b(k,112) + b(k,124) = b(k,124) - lu(k,535) * b(k,112) + b(k,125) = b(k,125) - lu(k,536) * b(k,112) + b(k,127) = b(k,127) - lu(k,537) * b(k,112) + b(k,128) = b(k,128) - lu(k,538) * b(k,112) + b(k,129) = b(k,129) - lu(k,539) * b(k,112) + b(k,130) = b(k,130) - lu(k,540) * b(k,112) + b(k,132) = b(k,132) - lu(k,541) * b(k,112) + b(k,133) = b(k,133) - lu(k,542) * b(k,112) + b(k,134) = b(k,134) - lu(k,543) * b(k,112) + b(k,135) = b(k,135) - lu(k,544) * b(k,112) + b(k,136) = b(k,136) - lu(k,545) * b(k,112) + b(k,138) = b(k,138) - lu(k,546) * b(k,112) + b(k,139) = b(k,139) - lu(k,547) * b(k,112) + b(k,121) = b(k,121) - lu(k,551) * b(k,113) + b(k,123) = b(k,123) - lu(k,552) * b(k,113) + b(k,129) = b(k,129) - lu(k,553) * b(k,113) + b(k,130) = b(k,130) - lu(k,554) * b(k,113) + b(k,133) = b(k,133) - lu(k,555) * b(k,113) + b(k,135) = b(k,135) - lu(k,556) * b(k,113) + b(k,136) = b(k,136) - lu(k,557) * b(k,113) + b(k,139) = b(k,139) - lu(k,558) * b(k,113) + end do + end subroutine lu_slv02 + subroutine lu_slv03( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,116) = b(k,116) - lu(k,561) * b(k,114) + b(k,119) = b(k,119) - lu(k,562) * b(k,114) + b(k,120) = b(k,120) - lu(k,563) * b(k,114) + b(k,121) = b(k,121) - lu(k,564) * b(k,114) + b(k,125) = b(k,125) - lu(k,565) * b(k,114) + b(k,129) = b(k,129) - lu(k,566) * b(k,114) + b(k,130) = b(k,130) - lu(k,567) * b(k,114) + b(k,132) = b(k,132) - lu(k,568) * b(k,114) + b(k,135) = b(k,135) - lu(k,569) * b(k,114) + b(k,139) = b(k,139) - lu(k,570) * b(k,114) + b(k,116) = b(k,116) - lu(k,579) * b(k,115) + b(k,121) = b(k,121) - lu(k,580) * b(k,115) + b(k,123) = b(k,123) - lu(k,581) * b(k,115) + b(k,125) = b(k,125) - lu(k,582) * b(k,115) + b(k,129) = b(k,129) - lu(k,583) * b(k,115) + b(k,130) = b(k,130) - lu(k,584) * b(k,115) + b(k,133) = b(k,133) - lu(k,585) * b(k,115) + b(k,135) = b(k,135) - lu(k,586) * b(k,115) + b(k,136) = b(k,136) - lu(k,587) * b(k,115) + b(k,138) = b(k,138) - lu(k,588) * b(k,115) + b(k,121) = b(k,121) - lu(k,592) * b(k,116) + b(k,129) = b(k,129) - lu(k,593) * b(k,116) + b(k,130) = b(k,130) - lu(k,594) * b(k,116) + b(k,133) = b(k,133) - lu(k,595) * b(k,116) + b(k,135) = b(k,135) - lu(k,596) * b(k,116) + b(k,136) = b(k,136) - lu(k,597) * b(k,116) + b(k,139) = b(k,139) - lu(k,598) * b(k,116) + b(k,124) = b(k,124) - lu(k,603) * b(k,117) + b(k,126) = b(k,126) - lu(k,604) * b(k,117) + b(k,128) = b(k,128) - lu(k,605) * b(k,117) + b(k,129) = b(k,129) - lu(k,606) * b(k,117) + b(k,130) = b(k,130) - lu(k,607) * b(k,117) + b(k,131) = b(k,131) - lu(k,608) * b(k,117) + b(k,132) = b(k,132) - lu(k,609) * b(k,117) + b(k,133) = b(k,133) - lu(k,610) * b(k,117) + b(k,135) = b(k,135) - lu(k,611) * b(k,117) + b(k,137) = b(k,137) - lu(k,612) * b(k,117) + b(k,138) = b(k,138) - lu(k,613) * b(k,117) + b(k,139) = b(k,139) - lu(k,614) * b(k,117) + b(k,119) = b(k,119) - lu(k,627) * b(k,118) + b(k,120) = b(k,120) - lu(k,628) * b(k,118) + b(k,121) = b(k,121) - lu(k,629) * b(k,118) + b(k,122) = b(k,122) - lu(k,630) * b(k,118) + b(k,123) = b(k,123) - lu(k,631) * b(k,118) + b(k,125) = b(k,125) - lu(k,632) * b(k,118) + b(k,129) = b(k,129) - lu(k,633) * b(k,118) + b(k,130) = b(k,130) - lu(k,634) * b(k,118) + b(k,132) = b(k,132) - lu(k,635) * b(k,118) + b(k,133) = b(k,133) - lu(k,636) * b(k,118) + b(k,135) = b(k,135) - lu(k,637) * b(k,118) + b(k,136) = b(k,136) - lu(k,638) * b(k,118) + b(k,138) = b(k,138) - lu(k,639) * b(k,118) + b(k,139) = b(k,139) - lu(k,640) * b(k,118) + b(k,120) = b(k,120) - lu(k,650) * b(k,119) + b(k,121) = b(k,121) - lu(k,651) * b(k,119) + b(k,123) = b(k,123) - lu(k,652) * b(k,119) + b(k,125) = b(k,125) - lu(k,653) * b(k,119) + b(k,129) = b(k,129) - lu(k,654) * b(k,119) + b(k,130) = b(k,130) - lu(k,655) * b(k,119) + b(k,133) = b(k,133) - lu(k,656) * b(k,119) + b(k,135) = b(k,135) - lu(k,657) * b(k,119) + b(k,136) = b(k,136) - lu(k,658) * b(k,119) + b(k,138) = b(k,138) - lu(k,659) * b(k,119) + b(k,139) = b(k,139) - lu(k,660) * b(k,119) + b(k,121) = b(k,121) - lu(k,669) * b(k,120) + b(k,123) = b(k,123) - lu(k,670) * b(k,120) + b(k,125) = b(k,125) - lu(k,671) * b(k,120) + b(k,129) = b(k,129) - lu(k,672) * b(k,120) + b(k,130) = b(k,130) - lu(k,673) * b(k,120) + b(k,132) = b(k,132) - lu(k,674) * b(k,120) + b(k,133) = b(k,133) - lu(k,675) * b(k,120) + b(k,135) = b(k,135) - lu(k,676) * b(k,120) + b(k,136) = b(k,136) - lu(k,677) * b(k,120) + b(k,138) = b(k,138) - lu(k,678) * b(k,120) + b(k,139) = b(k,139) - lu(k,679) * b(k,120) + b(k,122) = b(k,122) - lu(k,696) * b(k,121) + b(k,123) = b(k,123) - lu(k,697) * b(k,121) + b(k,125) = b(k,125) - lu(k,698) * b(k,121) + b(k,129) = b(k,129) - lu(k,699) * b(k,121) + b(k,130) = b(k,130) - lu(k,700) * b(k,121) + b(k,132) = b(k,132) - lu(k,701) * b(k,121) + b(k,133) = b(k,133) - lu(k,702) * b(k,121) + b(k,135) = b(k,135) - lu(k,703) * b(k,121) + b(k,136) = b(k,136) - lu(k,704) * b(k,121) + b(k,138) = b(k,138) - lu(k,705) * b(k,121) + b(k,139) = b(k,139) - lu(k,706) * b(k,121) + b(k,123) = b(k,123) - lu(k,716) * b(k,122) + b(k,124) = b(k,124) - lu(k,717) * b(k,122) + b(k,125) = b(k,125) - lu(k,718) * b(k,122) + b(k,127) = b(k,127) - lu(k,719) * b(k,122) + b(k,128) = b(k,128) - lu(k,720) * b(k,122) + b(k,129) = b(k,129) - lu(k,721) * b(k,122) + b(k,130) = b(k,130) - lu(k,722) * b(k,122) + b(k,132) = b(k,132) - lu(k,723) * b(k,122) + b(k,133) = b(k,133) - lu(k,724) * b(k,122) + b(k,134) = b(k,134) - lu(k,725) * b(k,122) + b(k,135) = b(k,135) - lu(k,726) * b(k,122) + b(k,136) = b(k,136) - lu(k,727) * b(k,122) + b(k,138) = b(k,138) - lu(k,728) * b(k,122) + b(k,139) = b(k,139) - lu(k,729) * b(k,122) + b(k,124) = b(k,124) - lu(k,754) * b(k,123) + b(k,125) = b(k,125) - lu(k,755) * b(k,123) + b(k,127) = b(k,127) - lu(k,756) * b(k,123) + b(k,128) = b(k,128) - lu(k,757) * b(k,123) + b(k,129) = b(k,129) - lu(k,758) * b(k,123) + b(k,130) = b(k,130) - lu(k,759) * b(k,123) + b(k,132) = b(k,132) - lu(k,760) * b(k,123) + b(k,133) = b(k,133) - lu(k,761) * b(k,123) + b(k,134) = b(k,134) - lu(k,762) * b(k,123) + b(k,135) = b(k,135) - lu(k,763) * b(k,123) + b(k,136) = b(k,136) - lu(k,764) * b(k,123) + b(k,137) = b(k,137) - lu(k,765) * b(k,123) + b(k,138) = b(k,138) - lu(k,766) * b(k,123) + b(k,139) = b(k,139) - lu(k,767) * b(k,123) + b(k,127) = b(k,127) - lu(k,770) * b(k,124) + b(k,128) = b(k,128) - lu(k,771) * b(k,124) + b(k,129) = b(k,129) - lu(k,772) * b(k,124) + b(k,130) = b(k,130) - lu(k,773) * b(k,124) + b(k,132) = b(k,132) - lu(k,774) * b(k,124) + b(k,134) = b(k,134) - lu(k,775) * b(k,124) + b(k,135) = b(k,135) - lu(k,776) * b(k,124) + b(k,139) = b(k,139) - lu(k,777) * b(k,124) + b(k,126) = b(k,126) - lu(k,784) * b(k,125) + b(k,127) = b(k,127) - lu(k,785) * b(k,125) + b(k,128) = b(k,128) - lu(k,786) * b(k,125) + b(k,129) = b(k,129) - lu(k,787) * b(k,125) + b(k,130) = b(k,130) - lu(k,788) * b(k,125) + b(k,131) = b(k,131) - lu(k,789) * b(k,125) + b(k,132) = b(k,132) - lu(k,790) * b(k,125) + b(k,133) = b(k,133) - lu(k,791) * b(k,125) + b(k,134) = b(k,134) - lu(k,792) * b(k,125) + b(k,135) = b(k,135) - lu(k,793) * b(k,125) + b(k,136) = b(k,136) - lu(k,794) * b(k,125) + b(k,139) = b(k,139) - lu(k,795) * b(k,125) + b(k,127) = b(k,127) - lu(k,801) * b(k,126) + b(k,128) = b(k,128) - lu(k,802) * b(k,126) + b(k,129) = b(k,129) - lu(k,803) * b(k,126) + b(k,130) = b(k,130) - lu(k,804) * b(k,126) + b(k,131) = b(k,131) - lu(k,805) * b(k,126) + b(k,132) = b(k,132) - lu(k,806) * b(k,126) + b(k,133) = b(k,133) - lu(k,807) * b(k,126) + b(k,134) = b(k,134) - lu(k,808) * b(k,126) + b(k,135) = b(k,135) - lu(k,809) * b(k,126) + b(k,136) = b(k,136) - lu(k,810) * b(k,126) + b(k,139) = b(k,139) - lu(k,811) * b(k,126) + b(k,128) = b(k,128) - lu(k,821) * b(k,127) + b(k,129) = b(k,129) - lu(k,822) * b(k,127) + b(k,130) = b(k,130) - lu(k,823) * b(k,127) + b(k,131) = b(k,131) - lu(k,824) * b(k,127) + b(k,132) = b(k,132) - lu(k,825) * b(k,127) + b(k,133) = b(k,133) - lu(k,826) * b(k,127) + b(k,134) = b(k,134) - lu(k,827) * b(k,127) + b(k,135) = b(k,135) - lu(k,828) * b(k,127) + b(k,136) = b(k,136) - lu(k,829) * b(k,127) + b(k,137) = b(k,137) - lu(k,830) * b(k,127) + b(k,139) = b(k,139) - lu(k,831) * b(k,127) + b(k,129) = b(k,129) - lu(k,857) * b(k,128) + b(k,130) = b(k,130) - lu(k,858) * b(k,128) + b(k,131) = b(k,131) - lu(k,859) * b(k,128) + b(k,132) = b(k,132) - lu(k,860) * b(k,128) + b(k,133) = b(k,133) - lu(k,861) * b(k,128) + b(k,134) = b(k,134) - lu(k,862) * b(k,128) + b(k,135) = b(k,135) - lu(k,863) * b(k,128) + b(k,136) = b(k,136) - lu(k,864) * b(k,128) + b(k,137) = b(k,137) - lu(k,865) * b(k,128) + b(k,138) = b(k,138) - lu(k,866) * b(k,128) + b(k,139) = b(k,139) - lu(k,867) * b(k,128) + b(k,130) = b(k,130) - lu(k,887) * b(k,129) + b(k,131) = b(k,131) - lu(k,888) * b(k,129) + b(k,132) = b(k,132) - lu(k,889) * b(k,129) + b(k,133) = b(k,133) - lu(k,890) * b(k,129) + b(k,134) = b(k,134) - lu(k,891) * b(k,129) + b(k,135) = b(k,135) - lu(k,892) * b(k,129) + b(k,136) = b(k,136) - lu(k,893) * b(k,129) + b(k,137) = b(k,137) - lu(k,894) * b(k,129) + b(k,138) = b(k,138) - lu(k,895) * b(k,129) + b(k,139) = b(k,139) - lu(k,896) * b(k,129) + b(k,131) = b(k,131) - lu(k,944) * b(k,130) + b(k,132) = b(k,132) - lu(k,945) * b(k,130) + b(k,133) = b(k,133) - lu(k,946) * b(k,130) + b(k,134) = b(k,134) - lu(k,947) * b(k,130) + b(k,135) = b(k,135) - lu(k,948) * b(k,130) + b(k,136) = b(k,136) - lu(k,949) * b(k,130) + b(k,137) = b(k,137) - lu(k,950) * b(k,130) + b(k,138) = b(k,138) - lu(k,951) * b(k,130) + b(k,139) = b(k,139) - lu(k,952) * b(k,130) + b(k,132) = b(k,132) - lu(k,967) * b(k,131) + b(k,133) = b(k,133) - lu(k,968) * b(k,131) + b(k,134) = b(k,134) - lu(k,969) * b(k,131) + b(k,135) = b(k,135) - lu(k,970) * b(k,131) + b(k,136) = b(k,136) - lu(k,971) * b(k,131) + b(k,137) = b(k,137) - lu(k,972) * b(k,131) + b(k,138) = b(k,138) - lu(k,973) * b(k,131) + b(k,139) = b(k,139) - lu(k,974) * b(k,131) + b(k,133) = b(k,133) - lu(k,1012) * b(k,132) + b(k,134) = b(k,134) - lu(k,1013) * b(k,132) + b(k,135) = b(k,135) - lu(k,1014) * b(k,132) + b(k,136) = b(k,136) - lu(k,1015) * b(k,132) + b(k,137) = b(k,137) - lu(k,1016) * b(k,132) + b(k,138) = b(k,138) - lu(k,1017) * b(k,132) + b(k,139) = b(k,139) - lu(k,1018) * b(k,132) + end do + end subroutine lu_slv03 + subroutine lu_slv04( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,134) = b(k,134) - lu(k,1049) * b(k,133) + b(k,135) = b(k,135) - lu(k,1050) * b(k,133) + b(k,136) = b(k,136) - lu(k,1051) * b(k,133) + b(k,137) = b(k,137) - lu(k,1052) * b(k,133) + b(k,138) = b(k,138) - lu(k,1053) * b(k,133) + b(k,139) = b(k,139) - lu(k,1054) * b(k,133) + b(k,135) = b(k,135) - lu(k,1087) * b(k,134) + b(k,136) = b(k,136) - lu(k,1088) * b(k,134) + b(k,137) = b(k,137) - lu(k,1089) * b(k,134) + b(k,138) = b(k,138) - lu(k,1090) * b(k,134) + b(k,139) = b(k,139) - lu(k,1091) * b(k,134) + b(k,136) = b(k,136) - lu(k,1173) * b(k,135) + b(k,137) = b(k,137) - lu(k,1174) * b(k,135) + b(k,138) = b(k,138) - lu(k,1175) * b(k,135) + b(k,139) = b(k,139) - lu(k,1176) * b(k,135) + b(k,137) = b(k,137) - lu(k,1218) * b(k,136) + b(k,138) = b(k,138) - lu(k,1219) * b(k,136) + b(k,139) = b(k,139) - lu(k,1220) * b(k,136) + b(k,138) = b(k,138) - lu(k,1244) * b(k,137) + b(k,139) = b(k,139) - lu(k,1245) * b(k,137) + b(k,139) = b(k,139) - lu(k,1287) * b(k,138) + end do + end subroutine lu_slv04 + subroutine lu_slv05( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,139) = b(k,139) * lu(k,1307) + b(k,138) = b(k,138) - lu(k,1306) * b(k,139) + b(k,137) = b(k,137) - lu(k,1305) * b(k,139) + b(k,136) = b(k,136) - lu(k,1304) * b(k,139) + b(k,135) = b(k,135) - lu(k,1303) * b(k,139) + b(k,134) = b(k,134) - lu(k,1302) * b(k,139) + b(k,133) = b(k,133) - lu(k,1301) * b(k,139) + b(k,132) = b(k,132) - lu(k,1300) * b(k,139) + b(k,131) = b(k,131) - lu(k,1299) * b(k,139) + b(k,130) = b(k,130) - lu(k,1298) * b(k,139) + b(k,129) = b(k,129) - lu(k,1297) * b(k,139) + b(k,128) = b(k,128) - lu(k,1296) * b(k,139) + b(k,127) = b(k,127) - lu(k,1295) * b(k,139) + b(k,126) = b(k,126) - lu(k,1294) * b(k,139) + b(k,124) = b(k,124) - lu(k,1293) * b(k,139) + b(k,117) = b(k,117) - lu(k,1292) * b(k,139) + b(k,111) = b(k,111) - lu(k,1291) * b(k,139) + b(k,102) = b(k,102) - lu(k,1290) * b(k,139) + b(k,58) = b(k,58) - lu(k,1289) * b(k,139) + b(k,49) = b(k,49) - lu(k,1288) * b(k,139) + b(k,138) = b(k,138) * lu(k,1286) + b(k,137) = b(k,137) - lu(k,1285) * b(k,138) + b(k,136) = b(k,136) - lu(k,1284) * b(k,138) + b(k,135) = b(k,135) - lu(k,1283) * b(k,138) + b(k,134) = b(k,134) - lu(k,1282) * b(k,138) + b(k,133) = b(k,133) - lu(k,1281) * b(k,138) + b(k,132) = b(k,132) - lu(k,1280) * b(k,138) + b(k,131) = b(k,131) - lu(k,1279) * b(k,138) + b(k,130) = b(k,130) - lu(k,1278) * b(k,138) + b(k,129) = b(k,129) - lu(k,1277) * b(k,138) + b(k,128) = b(k,128) - lu(k,1276) * b(k,138) + b(k,127) = b(k,127) - lu(k,1275) * b(k,138) + b(k,126) = b(k,126) - lu(k,1274) * b(k,138) + b(k,125) = b(k,125) - lu(k,1273) * b(k,138) + b(k,124) = b(k,124) - lu(k,1272) * b(k,138) + b(k,123) = b(k,123) - lu(k,1271) * b(k,138) + b(k,122) = b(k,122) - lu(k,1270) * b(k,138) + b(k,121) = b(k,121) - lu(k,1269) * b(k,138) + b(k,120) = b(k,120) - lu(k,1268) * b(k,138) + b(k,119) = b(k,119) - lu(k,1267) * b(k,138) + b(k,118) = b(k,118) - lu(k,1266) * b(k,138) + b(k,116) = b(k,116) - lu(k,1265) * b(k,138) + b(k,115) = b(k,115) - lu(k,1264) * b(k,138) + b(k,114) = b(k,114) - lu(k,1263) * b(k,138) + b(k,113) = b(k,113) - lu(k,1262) * b(k,138) + b(k,110) = b(k,110) - lu(k,1261) * b(k,138) + b(k,109) = b(k,109) - lu(k,1260) * b(k,138) + b(k,108) = b(k,108) - lu(k,1259) * b(k,138) + b(k,106) = b(k,106) - lu(k,1258) * b(k,138) + b(k,105) = b(k,105) - lu(k,1257) * b(k,138) + b(k,98) = b(k,98) - lu(k,1256) * b(k,138) + b(k,97) = b(k,97) - lu(k,1255) * b(k,138) + b(k,96) = b(k,96) - lu(k,1254) * b(k,138) + b(k,95) = b(k,95) - lu(k,1253) * b(k,138) + b(k,93) = b(k,93) - lu(k,1252) * b(k,138) + b(k,92) = b(k,92) - lu(k,1251) * b(k,138) + b(k,91) = b(k,91) - lu(k,1250) * b(k,138) + b(k,90) = b(k,90) - lu(k,1249) * b(k,138) + b(k,75) = b(k,75) - lu(k,1248) * b(k,138) + b(k,66) = b(k,66) - lu(k,1247) * b(k,138) + b(k,59) = b(k,59) - lu(k,1246) * b(k,138) + b(k,137) = b(k,137) * lu(k,1243) + b(k,136) = b(k,136) - lu(k,1242) * b(k,137) + b(k,135) = b(k,135) - lu(k,1241) * b(k,137) + b(k,134) = b(k,134) - lu(k,1240) * b(k,137) + b(k,133) = b(k,133) - lu(k,1239) * b(k,137) + b(k,132) = b(k,132) - lu(k,1238) * b(k,137) + b(k,131) = b(k,131) - lu(k,1237) * b(k,137) + b(k,130) = b(k,130) - lu(k,1236) * b(k,137) + b(k,129) = b(k,129) - lu(k,1235) * b(k,137) + b(k,128) = b(k,128) - lu(k,1234) * b(k,137) + b(k,127) = b(k,127) - lu(k,1233) * b(k,137) + b(k,126) = b(k,126) - lu(k,1232) * b(k,137) + b(k,125) = b(k,125) - lu(k,1231) * b(k,137) + b(k,124) = b(k,124) - lu(k,1230) * b(k,137) + b(k,123) = b(k,123) - lu(k,1229) * b(k,137) + b(k,117) = b(k,117) - lu(k,1228) * b(k,137) + b(k,104) = b(k,104) - lu(k,1227) * b(k,137) + b(k,102) = b(k,102) - lu(k,1226) * b(k,137) + b(k,99) = b(k,99) - lu(k,1225) * b(k,137) + b(k,65) = b(k,65) - lu(k,1224) * b(k,137) + b(k,56) = b(k,56) - lu(k,1223) * b(k,137) + b(k,50) = b(k,50) - lu(k,1222) * b(k,137) + b(k,34) = b(k,34) - lu(k,1221) * b(k,137) + b(k,136) = b(k,136) * lu(k,1217) + b(k,135) = b(k,135) - lu(k,1216) * b(k,136) + b(k,134) = b(k,134) - lu(k,1215) * b(k,136) + b(k,133) = b(k,133) - lu(k,1214) * b(k,136) + b(k,132) = b(k,132) - lu(k,1213) * b(k,136) + b(k,131) = b(k,131) - lu(k,1212) * b(k,136) + b(k,130) = b(k,130) - lu(k,1211) * b(k,136) + b(k,129) = b(k,129) - lu(k,1210) * b(k,136) + b(k,128) = b(k,128) - lu(k,1209) * b(k,136) + b(k,127) = b(k,127) - lu(k,1208) * b(k,136) + b(k,126) = b(k,126) - lu(k,1207) * b(k,136) + b(k,125) = b(k,125) - lu(k,1206) * b(k,136) + b(k,124) = b(k,124) - lu(k,1205) * b(k,136) + b(k,123) = b(k,123) - lu(k,1204) * b(k,136) + b(k,122) = b(k,122) - lu(k,1203) * b(k,136) + b(k,121) = b(k,121) - lu(k,1202) * b(k,136) + b(k,120) = b(k,120) - lu(k,1201) * b(k,136) + b(k,119) = b(k,119) - lu(k,1200) * b(k,136) + b(k,118) = b(k,118) - lu(k,1199) * b(k,136) + b(k,117) = b(k,117) - lu(k,1198) * b(k,136) + b(k,116) = b(k,116) - lu(k,1197) * b(k,136) + b(k,115) = b(k,115) - lu(k,1196) * b(k,136) + b(k,114) = b(k,114) - lu(k,1195) * b(k,136) + b(k,113) = b(k,113) - lu(k,1194) * b(k,136) + b(k,112) = b(k,112) - lu(k,1193) * b(k,136) + b(k,110) = b(k,110) - lu(k,1192) * b(k,136) + b(k,109) = b(k,109) - lu(k,1191) * b(k,136) + b(k,108) = b(k,108) - lu(k,1190) * b(k,136) + b(k,106) = b(k,106) - lu(k,1189) * b(k,136) + b(k,105) = b(k,105) - lu(k,1188) * b(k,136) + b(k,103) = b(k,103) - lu(k,1187) * b(k,136) + b(k,102) = b(k,102) - lu(k,1186) * b(k,136) + b(k,101) = b(k,101) - lu(k,1185) * b(k,136) + b(k,97) = b(k,97) - lu(k,1184) * b(k,136) + b(k,95) = b(k,95) - lu(k,1183) * b(k,136) + b(k,92) = b(k,92) - lu(k,1182) * b(k,136) + b(k,88) = b(k,88) - lu(k,1181) * b(k,136) + b(k,72) = b(k,72) - lu(k,1180) * b(k,136) + b(k,66) = b(k,66) - lu(k,1179) * b(k,136) + b(k,62) = b(k,62) - lu(k,1178) * b(k,136) + b(k,60) = b(k,60) - lu(k,1177) * b(k,136) + b(k,135) = b(k,135) * lu(k,1172) + b(k,134) = b(k,134) - lu(k,1171) * b(k,135) + b(k,133) = b(k,133) - lu(k,1170) * b(k,135) + b(k,132) = b(k,132) - lu(k,1169) * b(k,135) + b(k,131) = b(k,131) - lu(k,1168) * b(k,135) + b(k,130) = b(k,130) - lu(k,1167) * b(k,135) + b(k,129) = b(k,129) - lu(k,1166) * b(k,135) + b(k,128) = b(k,128) - lu(k,1165) * b(k,135) + b(k,127) = b(k,127) - lu(k,1164) * b(k,135) + b(k,126) = b(k,126) - lu(k,1163) * b(k,135) + b(k,125) = b(k,125) - lu(k,1162) * b(k,135) + b(k,124) = b(k,124) - lu(k,1161) * b(k,135) + b(k,123) = b(k,123) - lu(k,1160) * b(k,135) + b(k,122) = b(k,122) - lu(k,1159) * b(k,135) + b(k,121) = b(k,121) - lu(k,1158) * b(k,135) + b(k,120) = b(k,120) - lu(k,1157) * b(k,135) + b(k,119) = b(k,119) - lu(k,1156) * b(k,135) + b(k,118) = b(k,118) - lu(k,1155) * b(k,135) + b(k,117) = b(k,117) - lu(k,1154) * b(k,135) + b(k,116) = b(k,116) - lu(k,1153) * b(k,135) + b(k,115) = b(k,115) - lu(k,1152) * b(k,135) + b(k,114) = b(k,114) - lu(k,1151) * b(k,135) + b(k,113) = b(k,113) - lu(k,1150) * b(k,135) + b(k,112) = b(k,112) - lu(k,1149) * b(k,135) + b(k,111) = b(k,111) - lu(k,1148) * b(k,135) + b(k,110) = b(k,110) - lu(k,1147) * b(k,135) + b(k,109) = b(k,109) - lu(k,1146) * b(k,135) + b(k,108) = b(k,108) - lu(k,1145) * b(k,135) + b(k,107) = b(k,107) - lu(k,1144) * b(k,135) + b(k,106) = b(k,106) - lu(k,1143) * b(k,135) + b(k,105) = b(k,105) - lu(k,1142) * b(k,135) + b(k,104) = b(k,104) - lu(k,1141) * b(k,135) + b(k,103) = b(k,103) - lu(k,1140) * b(k,135) + b(k,102) = b(k,102) - lu(k,1139) * b(k,135) + b(k,101) = b(k,101) - lu(k,1138) * b(k,135) + b(k,100) = b(k,100) - lu(k,1137) * b(k,135) + b(k,99) = b(k,99) - lu(k,1136) * b(k,135) + b(k,98) = b(k,98) - lu(k,1135) * b(k,135) + b(k,96) = b(k,96) - lu(k,1134) * b(k,135) + b(k,95) = b(k,95) - lu(k,1133) * b(k,135) + b(k,93) = b(k,93) - lu(k,1132) * b(k,135) + b(k,92) = b(k,92) - lu(k,1131) * b(k,135) + b(k,91) = b(k,91) - lu(k,1130) * b(k,135) + b(k,90) = b(k,90) - lu(k,1129) * b(k,135) + b(k,89) = b(k,89) - lu(k,1128) * b(k,135) + b(k,88) = b(k,88) - lu(k,1127) * b(k,135) + b(k,87) = b(k,87) - lu(k,1126) * b(k,135) + b(k,86) = b(k,86) - lu(k,1125) * b(k,135) + b(k,85) = b(k,85) - lu(k,1124) * b(k,135) + b(k,84) = b(k,84) - lu(k,1123) * b(k,135) + b(k,82) = b(k,82) - lu(k,1122) * b(k,135) + b(k,81) = b(k,81) - lu(k,1121) * b(k,135) + b(k,80) = b(k,80) - lu(k,1120) * b(k,135) + b(k,79) = b(k,79) - lu(k,1119) * b(k,135) + b(k,78) = b(k,78) - lu(k,1118) * b(k,135) + b(k,77) = b(k,77) - lu(k,1117) * b(k,135) + b(k,76) = b(k,76) - lu(k,1116) * b(k,135) + b(k,75) = b(k,75) - lu(k,1115) * b(k,135) + b(k,74) = b(k,74) - lu(k,1114) * b(k,135) + b(k,73) = b(k,73) - lu(k,1113) * b(k,135) + b(k,72) = b(k,72) - lu(k,1112) * b(k,135) + b(k,71) = b(k,71) - lu(k,1111) * b(k,135) + b(k,70) = b(k,70) - lu(k,1110) * b(k,135) + b(k,69) = b(k,69) - lu(k,1109) * b(k,135) + b(k,68) = b(k,68) - lu(k,1108) * b(k,135) + b(k,67) = b(k,67) - lu(k,1107) * b(k,135) + b(k,66) = b(k,66) - lu(k,1106) * b(k,135) + b(k,64) = b(k,64) - lu(k,1105) * b(k,135) + b(k,63) = b(k,63) - lu(k,1104) * b(k,135) + b(k,62) = b(k,62) - lu(k,1103) * b(k,135) + b(k,61) = b(k,61) - lu(k,1102) * b(k,135) + b(k,58) = b(k,58) - lu(k,1101) * b(k,135) + b(k,57) = b(k,57) - lu(k,1100) * b(k,135) + b(k,55) = b(k,55) - lu(k,1099) * b(k,135) + b(k,54) = b(k,54) - lu(k,1098) * b(k,135) + b(k,52) = b(k,52) - lu(k,1097) * b(k,135) + b(k,51) = b(k,51) - lu(k,1096) * b(k,135) + b(k,47) = b(k,47) - lu(k,1095) * b(k,135) + b(k,45) = b(k,45) - lu(k,1094) * b(k,135) + b(k,37) = b(k,37) - lu(k,1093) * b(k,135) + b(k,35) = b(k,35) - lu(k,1092) * b(k,135) + end do + end subroutine lu_slv05 + subroutine lu_slv06( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,134) = b(k,134) * lu(k,1086) + b(k,133) = b(k,133) - lu(k,1085) * b(k,134) + b(k,132) = b(k,132) - lu(k,1084) * b(k,134) + b(k,131) = b(k,131) - lu(k,1083) * b(k,134) + b(k,130) = b(k,130) - lu(k,1082) * b(k,134) + b(k,129) = b(k,129) - lu(k,1081) * b(k,134) + b(k,128) = b(k,128) - lu(k,1080) * b(k,134) + b(k,127) = b(k,127) - lu(k,1079) * b(k,134) + b(k,126) = b(k,126) - lu(k,1078) * b(k,134) + b(k,125) = b(k,125) - lu(k,1077) * b(k,134) + b(k,124) = b(k,124) - lu(k,1076) * b(k,134) + b(k,123) = b(k,123) - lu(k,1075) * b(k,134) + b(k,111) = b(k,111) - lu(k,1074) * b(k,134) + b(k,110) = b(k,110) - lu(k,1073) * b(k,134) + b(k,107) = b(k,107) - lu(k,1072) * b(k,134) + b(k,100) = b(k,100) - lu(k,1071) * b(k,134) + b(k,86) = b(k,86) - lu(k,1070) * b(k,134) + b(k,77) = b(k,77) - lu(k,1069) * b(k,134) + b(k,70) = b(k,70) - lu(k,1068) * b(k,134) + b(k,55) = b(k,55) - lu(k,1067) * b(k,134) + b(k,53) = b(k,53) - lu(k,1066) * b(k,134) + b(k,52) = b(k,52) - lu(k,1065) * b(k,134) + b(k,51) = b(k,51) - lu(k,1064) * b(k,134) + b(k,46) = b(k,46) - lu(k,1063) * b(k,134) + b(k,44) = b(k,44) - lu(k,1062) * b(k,134) + b(k,43) = b(k,43) - lu(k,1061) * b(k,134) + b(k,42) = b(k,42) - lu(k,1060) * b(k,134) + b(k,41) = b(k,41) - lu(k,1059) * b(k,134) + b(k,40) = b(k,40) - lu(k,1058) * b(k,134) + b(k,39) = b(k,39) - lu(k,1057) * b(k,134) + b(k,38) = b(k,38) - lu(k,1056) * b(k,134) + b(k,36) = b(k,36) - lu(k,1055) * b(k,134) + b(k,133) = b(k,133) * lu(k,1048) + b(k,132) = b(k,132) - lu(k,1047) * b(k,133) + b(k,131) = b(k,131) - lu(k,1046) * b(k,133) + b(k,130) = b(k,130) - lu(k,1045) * b(k,133) + b(k,129) = b(k,129) - lu(k,1044) * b(k,133) + b(k,128) = b(k,128) - lu(k,1043) * b(k,133) + b(k,127) = b(k,127) - lu(k,1042) * b(k,133) + b(k,126) = b(k,126) - lu(k,1041) * b(k,133) + b(k,125) = b(k,125) - lu(k,1040) * b(k,133) + b(k,124) = b(k,124) - lu(k,1039) * b(k,133) + b(k,123) = b(k,123) - lu(k,1038) * b(k,133) + b(k,122) = b(k,122) - lu(k,1037) * b(k,133) + b(k,121) = b(k,121) - lu(k,1036) * b(k,133) + b(k,120) = b(k,120) - lu(k,1035) * b(k,133) + b(k,117) = b(k,117) - lu(k,1034) * b(k,133) + b(k,116) = b(k,116) - lu(k,1033) * b(k,133) + b(k,110) = b(k,110) - lu(k,1032) * b(k,133) + b(k,109) = b(k,109) - lu(k,1031) * b(k,133) + b(k,104) = b(k,104) - lu(k,1030) * b(k,133) + b(k,102) = b(k,102) - lu(k,1029) * b(k,133) + b(k,101) = b(k,101) - lu(k,1028) * b(k,133) + b(k,94) = b(k,94) - lu(k,1027) * b(k,133) + b(k,90) = b(k,90) - lu(k,1026) * b(k,133) + b(k,85) = b(k,85) - lu(k,1025) * b(k,133) + b(k,83) = b(k,83) - lu(k,1024) * b(k,133) + b(k,81) = b(k,81) - lu(k,1023) * b(k,133) + b(k,75) = b(k,75) - lu(k,1022) * b(k,133) + b(k,69) = b(k,69) - lu(k,1021) * b(k,133) + b(k,60) = b(k,60) - lu(k,1020) * b(k,133) + b(k,53) = b(k,53) - lu(k,1019) * b(k,133) + b(k,132) = b(k,132) * lu(k,1011) + b(k,131) = b(k,131) - lu(k,1010) * b(k,132) + b(k,130) = b(k,130) - lu(k,1009) * b(k,132) + b(k,129) = b(k,129) - lu(k,1008) * b(k,132) + b(k,128) = b(k,128) - lu(k,1007) * b(k,132) + b(k,127) = b(k,127) - lu(k,1006) * b(k,132) + b(k,126) = b(k,126) - lu(k,1005) * b(k,132) + b(k,125) = b(k,125) - lu(k,1004) * b(k,132) + b(k,124) = b(k,124) - lu(k,1003) * b(k,132) + b(k,123) = b(k,123) - lu(k,1002) * b(k,132) + b(k,122) = b(k,122) - lu(k,1001) * b(k,132) + b(k,121) = b(k,121) - lu(k,1000) * b(k,132) + b(k,120) = b(k,120) - lu(k,999) * b(k,132) + b(k,119) = b(k,119) - lu(k,998) * b(k,132) + b(k,118) = b(k,118) - lu(k,997) * b(k,132) + b(k,117) = b(k,117) - lu(k,996) * b(k,132) + b(k,116) = b(k,116) - lu(k,995) * b(k,132) + b(k,115) = b(k,115) - lu(k,994) * b(k,132) + b(k,114) = b(k,114) - lu(k,993) * b(k,132) + b(k,113) = b(k,113) - lu(k,992) * b(k,132) + b(k,112) = b(k,112) - lu(k,991) * b(k,132) + b(k,111) = b(k,111) - lu(k,990) * b(k,132) + b(k,110) = b(k,110) - lu(k,989) * b(k,132) + b(k,109) = b(k,109) - lu(k,988) * b(k,132) + b(k,108) = b(k,108) - lu(k,987) * b(k,132) + b(k,107) = b(k,107) - lu(k,986) * b(k,132) + b(k,106) = b(k,106) - lu(k,985) * b(k,132) + b(k,105) = b(k,105) - lu(k,984) * b(k,132) + b(k,103) = b(k,103) - lu(k,983) * b(k,132) + b(k,102) = b(k,102) - lu(k,982) * b(k,132) + b(k,95) = b(k,95) - lu(k,981) * b(k,132) + b(k,91) = b(k,91) - lu(k,980) * b(k,132) + b(k,90) = b(k,90) - lu(k,979) * b(k,132) + b(k,89) = b(k,89) - lu(k,978) * b(k,132) + b(k,88) = b(k,88) - lu(k,977) * b(k,132) + b(k,78) = b(k,78) - lu(k,976) * b(k,132) + b(k,76) = b(k,76) - lu(k,975) * b(k,132) + b(k,131) = b(k,131) * lu(k,966) + b(k,130) = b(k,130) - lu(k,965) * b(k,131) + b(k,129) = b(k,129) - lu(k,964) * b(k,131) + b(k,128) = b(k,128) - lu(k,963) * b(k,131) + b(k,127) = b(k,127) - lu(k,962) * b(k,131) + b(k,126) = b(k,126) - lu(k,961) * b(k,131) + b(k,124) = b(k,124) - lu(k,960) * b(k,131) + b(k,117) = b(k,117) - lu(k,959) * b(k,131) + b(k,102) = b(k,102) - lu(k,958) * b(k,131) + b(k,101) = b(k,101) - lu(k,957) * b(k,131) + b(k,94) = b(k,94) - lu(k,956) * b(k,131) + b(k,83) = b(k,83) - lu(k,955) * b(k,131) + b(k,65) = b(k,65) - lu(k,954) * b(k,131) + b(k,56) = b(k,56) - lu(k,953) * b(k,131) + b(k,130) = b(k,130) * lu(k,943) + b(k,129) = b(k,129) - lu(k,942) * b(k,130) + b(k,128) = b(k,128) - lu(k,941) * b(k,130) + b(k,127) = b(k,127) - lu(k,940) * b(k,130) + b(k,126) = b(k,126) - lu(k,939) * b(k,130) + b(k,125) = b(k,125) - lu(k,938) * b(k,130) + b(k,124) = b(k,124) - lu(k,937) * b(k,130) + b(k,123) = b(k,123) - lu(k,936) * b(k,130) + b(k,122) = b(k,122) - lu(k,935) * b(k,130) + b(k,121) = b(k,121) - lu(k,934) * b(k,130) + b(k,120) = b(k,120) - lu(k,933) * b(k,130) + b(k,119) = b(k,119) - lu(k,932) * b(k,130) + b(k,118) = b(k,118) - lu(k,931) * b(k,130) + b(k,116) = b(k,116) - lu(k,930) * b(k,130) + b(k,115) = b(k,115) - lu(k,929) * b(k,130) + b(k,114) = b(k,114) - lu(k,928) * b(k,130) + b(k,113) = b(k,113) - lu(k,927) * b(k,130) + b(k,111) = b(k,111) - lu(k,926) * b(k,130) + b(k,110) = b(k,110) - lu(k,925) * b(k,130) + b(k,109) = b(k,109) - lu(k,924) * b(k,130) + b(k,108) = b(k,108) - lu(k,923) * b(k,130) + b(k,106) = b(k,106) - lu(k,922) * b(k,130) + b(k,105) = b(k,105) - lu(k,921) * b(k,130) + b(k,100) = b(k,100) - lu(k,920) * b(k,130) + b(k,99) = b(k,99) - lu(k,919) * b(k,130) + b(k,98) = b(k,98) - lu(k,918) * b(k,130) + b(k,97) = b(k,97) - lu(k,917) * b(k,130) + b(k,96) = b(k,96) - lu(k,916) * b(k,130) + b(k,95) = b(k,95) - lu(k,915) * b(k,130) + b(k,94) = b(k,94) - lu(k,914) * b(k,130) + b(k,93) = b(k,93) - lu(k,913) * b(k,130) + b(k,91) = b(k,91) - lu(k,912) * b(k,130) + b(k,90) = b(k,90) - lu(k,911) * b(k,130) + b(k,89) = b(k,89) - lu(k,910) * b(k,130) + b(k,87) = b(k,87) - lu(k,909) * b(k,130) + b(k,84) = b(k,84) - lu(k,908) * b(k,130) + b(k,82) = b(k,82) - lu(k,907) * b(k,130) + b(k,79) = b(k,79) - lu(k,906) * b(k,130) + b(k,74) = b(k,74) - lu(k,905) * b(k,130) + b(k,73) = b(k,73) - lu(k,904) * b(k,130) + b(k,71) = b(k,71) - lu(k,903) * b(k,130) + b(k,69) = b(k,69) - lu(k,902) * b(k,130) + b(k,64) = b(k,64) - lu(k,901) * b(k,130) + b(k,63) = b(k,63) - lu(k,900) * b(k,130) + b(k,59) = b(k,59) - lu(k,899) * b(k,130) + b(k,54) = b(k,54) - lu(k,898) * b(k,130) + b(k,48) = b(k,48) - lu(k,897) * b(k,130) + b(k,129) = b(k,129) * lu(k,886) + b(k,128) = b(k,128) - lu(k,885) * b(k,129) + b(k,127) = b(k,127) - lu(k,884) * b(k,129) + b(k,126) = b(k,126) - lu(k,883) * b(k,129) + b(k,125) = b(k,125) - lu(k,882) * b(k,129) + b(k,124) = b(k,124) - lu(k,881) * b(k,129) + b(k,117) = b(k,117) - lu(k,880) * b(k,129) + b(k,111) = b(k,111) - lu(k,879) * b(k,129) + b(k,110) = b(k,110) - lu(k,878) * b(k,129) + b(k,104) = b(k,104) - lu(k,877) * b(k,129) + b(k,102) = b(k,102) - lu(k,876) * b(k,129) + b(k,101) = b(k,101) - lu(k,875) * b(k,129) + b(k,100) = b(k,100) - lu(k,874) * b(k,129) + b(k,99) = b(k,99) - lu(k,873) * b(k,129) + b(k,94) = b(k,94) - lu(k,872) * b(k,129) + b(k,84) = b(k,84) - lu(k,871) * b(k,129) + b(k,83) = b(k,83) - lu(k,870) * b(k,129) + b(k,78) = b(k,78) - lu(k,869) * b(k,129) + b(k,67) = b(k,67) - lu(k,868) * b(k,129) + b(k,128) = b(k,128) * lu(k,856) + b(k,127) = b(k,127) - lu(k,855) * b(k,128) + b(k,126) = b(k,126) - lu(k,854) * b(k,128) + b(k,125) = b(k,125) - lu(k,853) * b(k,128) + b(k,124) = b(k,124) - lu(k,852) * b(k,128) + b(k,123) = b(k,123) - lu(k,851) * b(k,128) + b(k,122) = b(k,122) - lu(k,850) * b(k,128) + b(k,121) = b(k,121) - lu(k,849) * b(k,128) + b(k,113) = b(k,113) - lu(k,848) * b(k,128) + b(k,111) = b(k,111) - lu(k,847) * b(k,128) + b(k,110) = b(k,110) - lu(k,846) * b(k,128) + b(k,107) = b(k,107) - lu(k,845) * b(k,128) + b(k,105) = b(k,105) - lu(k,844) * b(k,128) + b(k,104) = b(k,104) - lu(k,843) * b(k,128) + b(k,99) = b(k,99) - lu(k,842) * b(k,128) + b(k,96) = b(k,96) - lu(k,841) * b(k,128) + b(k,91) = b(k,91) - lu(k,840) * b(k,128) + b(k,86) = b(k,86) - lu(k,839) * b(k,128) + b(k,84) = b(k,84) - lu(k,838) * b(k,128) + b(k,77) = b(k,77) - lu(k,837) * b(k,128) + b(k,76) = b(k,76) - lu(k,836) * b(k,128) + b(k,70) = b(k,70) - lu(k,835) * b(k,128) + b(k,68) = b(k,68) - lu(k,834) * b(k,128) + b(k,61) = b(k,61) - lu(k,833) * b(k,128) + b(k,50) = b(k,50) - lu(k,832) * b(k,128) + end do + end subroutine lu_slv06 + subroutine lu_slv07( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,127) = b(k,127) * lu(k,820) + b(k,126) = b(k,126) - lu(k,819) * b(k,127) + b(k,124) = b(k,124) - lu(k,818) * b(k,127) + b(k,104) = b(k,104) - lu(k,817) * b(k,127) + b(k,101) = b(k,101) - lu(k,816) * b(k,127) + b(k,99) = b(k,99) - lu(k,815) * b(k,127) + b(k,94) = b(k,94) - lu(k,814) * b(k,127) + b(k,56) = b(k,56) - lu(k,813) * b(k,127) + b(k,50) = b(k,50) - lu(k,812) * b(k,127) + b(k,126) = b(k,126) * lu(k,800) + b(k,125) = b(k,125) - lu(k,799) * b(k,126) + b(k,124) = b(k,124) - lu(k,798) * b(k,126) + b(k,110) = b(k,110) - lu(k,797) * b(k,126) + b(k,100) = b(k,100) - lu(k,796) * b(k,126) + b(k,125) = b(k,125) * lu(k,783) + b(k,124) = b(k,124) - lu(k,782) * b(k,125) + b(k,111) = b(k,111) - lu(k,781) * b(k,125) + b(k,110) = b(k,110) - lu(k,780) * b(k,125) + b(k,101) = b(k,101) - lu(k,779) * b(k,125) + b(k,100) = b(k,100) - lu(k,778) * b(k,125) + b(k,124) = b(k,124) * lu(k,769) + b(k,111) = b(k,111) - lu(k,768) * b(k,124) + b(k,123) = b(k,123) * lu(k,753) + b(k,122) = b(k,122) - lu(k,752) * b(k,123) + b(k,121) = b(k,121) - lu(k,751) * b(k,123) + b(k,120) = b(k,120) - lu(k,750) * b(k,123) + b(k,119) = b(k,119) - lu(k,749) * b(k,123) + b(k,118) = b(k,118) - lu(k,748) * b(k,123) + b(k,116) = b(k,116) - lu(k,747) * b(k,123) + b(k,115) = b(k,115) - lu(k,746) * b(k,123) + b(k,114) = b(k,114) - lu(k,745) * b(k,123) + b(k,113) = b(k,113) - lu(k,744) * b(k,123) + b(k,110) = b(k,110) - lu(k,743) * b(k,123) + b(k,109) = b(k,109) - lu(k,742) * b(k,123) + b(k,108) = b(k,108) - lu(k,741) * b(k,123) + b(k,105) = b(k,105) - lu(k,740) * b(k,123) + b(k,98) = b(k,98) - lu(k,739) * b(k,123) + b(k,96) = b(k,96) - lu(k,738) * b(k,123) + b(k,95) = b(k,95) - lu(k,737) * b(k,123) + b(k,92) = b(k,92) - lu(k,736) * b(k,123) + b(k,90) = b(k,90) - lu(k,735) * b(k,123) + b(k,89) = b(k,89) - lu(k,734) * b(k,123) + b(k,80) = b(k,80) - lu(k,733) * b(k,123) + b(k,73) = b(k,73) - lu(k,732) * b(k,123) + b(k,66) = b(k,66) - lu(k,731) * b(k,123) + b(k,57) = b(k,57) - lu(k,730) * b(k,123) + b(k,122) = b(k,122) * lu(k,715) + b(k,121) = b(k,121) - lu(k,714) * b(k,122) + b(k,120) = b(k,120) - lu(k,713) * b(k,122) + b(k,119) = b(k,119) - lu(k,712) * b(k,122) + b(k,116) = b(k,116) - lu(k,711) * b(k,122) + b(k,113) = b(k,113) - lu(k,710) * b(k,122) + b(k,112) = b(k,112) - lu(k,709) * b(k,122) + b(k,110) = b(k,110) - lu(k,708) * b(k,122) + b(k,90) = b(k,90) - lu(k,707) * b(k,122) + b(k,121) = b(k,121) * lu(k,695) + b(k,120) = b(k,120) - lu(k,694) * b(k,121) + b(k,119) = b(k,119) - lu(k,693) * b(k,121) + b(k,118) = b(k,118) - lu(k,692) * b(k,121) + b(k,116) = b(k,116) - lu(k,691) * b(k,121) + b(k,115) = b(k,115) - lu(k,690) * b(k,121) + b(k,114) = b(k,114) - lu(k,689) * b(k,121) + b(k,110) = b(k,110) - lu(k,688) * b(k,121) + b(k,109) = b(k,109) - lu(k,687) * b(k,121) + b(k,105) = b(k,105) - lu(k,686) * b(k,121) + b(k,92) = b(k,92) - lu(k,685) * b(k,121) + b(k,90) = b(k,90) - lu(k,684) * b(k,121) + b(k,89) = b(k,89) - lu(k,683) * b(k,121) + b(k,87) = b(k,87) - lu(k,682) * b(k,121) + b(k,81) = b(k,81) - lu(k,681) * b(k,121) + b(k,66) = b(k,66) - lu(k,680) * b(k,121) + b(k,120) = b(k,120) * lu(k,668) + b(k,116) = b(k,116) - lu(k,667) * b(k,120) + b(k,110) = b(k,110) - lu(k,666) * b(k,120) + b(k,109) = b(k,109) - lu(k,665) * b(k,120) + b(k,90) = b(k,90) - lu(k,664) * b(k,120) + b(k,89) = b(k,89) - lu(k,663) * b(k,120) + b(k,87) = b(k,87) - lu(k,662) * b(k,120) + b(k,85) = b(k,85) - lu(k,661) * b(k,120) + b(k,119) = b(k,119) * lu(k,649) + b(k,116) = b(k,116) - lu(k,648) * b(k,119) + b(k,115) = b(k,115) - lu(k,647) * b(k,119) + b(k,110) = b(k,110) - lu(k,646) * b(k,119) + b(k,109) = b(k,109) - lu(k,645) * b(k,119) + b(k,106) = b(k,106) - lu(k,644) * b(k,119) + b(k,105) = b(k,105) - lu(k,643) * b(k,119) + b(k,80) = b(k,80) - lu(k,642) * b(k,119) + b(k,63) = b(k,63) - lu(k,641) * b(k,119) + b(k,118) = b(k,118) * lu(k,626) + b(k,116) = b(k,116) - lu(k,625) * b(k,118) + b(k,115) = b(k,115) - lu(k,624) * b(k,118) + b(k,114) = b(k,114) - lu(k,623) * b(k,118) + b(k,110) = b(k,110) - lu(k,622) * b(k,118) + b(k,109) = b(k,109) - lu(k,621) * b(k,118) + b(k,106) = b(k,106) - lu(k,620) * b(k,118) + b(k,105) = b(k,105) - lu(k,619) * b(k,118) + b(k,92) = b(k,92) - lu(k,618) * b(k,118) + b(k,80) = b(k,80) - lu(k,617) * b(k,118) + b(k,79) = b(k,79) - lu(k,616) * b(k,118) + b(k,66) = b(k,66) - lu(k,615) * b(k,118) + b(k,117) = b(k,117) * lu(k,602) + b(k,102) = b(k,102) - lu(k,601) * b(k,117) + b(k,78) = b(k,78) - lu(k,600) * b(k,117) + b(k,65) = b(k,65) - lu(k,599) * b(k,117) + b(k,116) = b(k,116) * lu(k,591) + b(k,110) = b(k,110) - lu(k,590) * b(k,116) + b(k,101) = b(k,101) - lu(k,589) * b(k,116) + b(k,115) = b(k,115) * lu(k,578) + b(k,110) = b(k,110) - lu(k,577) * b(k,115) + b(k,109) = b(k,109) - lu(k,576) * b(k,115) + b(k,105) = b(k,105) - lu(k,575) * b(k,115) + b(k,92) = b(k,92) - lu(k,574) * b(k,115) + b(k,90) = b(k,90) - lu(k,573) * b(k,115) + b(k,80) = b(k,80) - lu(k,572) * b(k,115) + b(k,54) = b(k,54) - lu(k,571) * b(k,115) + b(k,114) = b(k,114) * lu(k,560) + b(k,110) = b(k,110) - lu(k,559) * b(k,114) + b(k,113) = b(k,113) * lu(k,550) + b(k,110) = b(k,110) - lu(k,549) * b(k,113) + b(k,101) = b(k,101) - lu(k,548) * b(k,113) + b(k,112) = b(k,112) * lu(k,530) + b(k,111) = b(k,111) - lu(k,529) * b(k,112) + b(k,110) = b(k,110) - lu(k,528) * b(k,112) + b(k,109) = b(k,109) - lu(k,527) * b(k,112) + b(k,107) = b(k,107) - lu(k,526) * b(k,112) + b(k,93) = b(k,93) - lu(k,525) * b(k,112) + b(k,90) = b(k,90) - lu(k,524) * b(k,112) + b(k,89) = b(k,89) - lu(k,523) * b(k,112) + b(k,72) = b(k,72) - lu(k,522) * b(k,112) + b(k,111) = b(k,111) * lu(k,514) + b(k,110) = b(k,110) * lu(k,510) + b(k,90) = b(k,90) - lu(k,509) * b(k,110) + b(k,109) = b(k,109) * lu(k,503) + b(k,108) = b(k,108) * lu(k,492) + b(k,80) = b(k,80) - lu(k,491) * b(k,108) + b(k,74) = b(k,74) - lu(k,490) * b(k,108) + b(k,107) = b(k,107) * lu(k,477) + b(k,90) = b(k,90) - lu(k,476) * b(k,107) + b(k,106) = b(k,106) * lu(k,467) + b(k,101) = b(k,101) - lu(k,466) * b(k,106) + b(k,66) = b(k,66) - lu(k,465) * b(k,106) + b(k,105) = b(k,105) * lu(k,459) + b(k,92) = b(k,92) - lu(k,458) * b(k,105) + b(k,90) = b(k,90) - lu(k,457) * b(k,105) + b(k,104) = b(k,104) * lu(k,448) + b(k,101) = b(k,101) - lu(k,447) * b(k,104) + b(k,99) = b(k,99) - lu(k,446) * b(k,104) + b(k,50) = b(k,50) - lu(k,445) * b(k,104) + b(k,103) = b(k,103) * lu(k,429) + b(k,97) = b(k,97) - lu(k,428) * b(k,103) + b(k,102) = b(k,102) * lu(k,422) + b(k,58) = b(k,58) - lu(k,421) * b(k,102) + b(k,101) = b(k,101) * lu(k,416) + b(k,100) = b(k,100) * lu(k,408) + b(k,99) = b(k,99) * lu(k,401) + b(k,50) = b(k,50) - lu(k,400) * b(k,99) + b(k,98) = b(k,98) * lu(k,389) + b(k,95) = b(k,95) - lu(k,388) * b(k,98) + b(k,71) = b(k,71) - lu(k,387) * b(k,98) + b(k,97) = b(k,97) * lu(k,377) + b(k,96) = b(k,96) * lu(k,369) + b(k,80) = b(k,80) - lu(k,368) * b(k,96) + b(k,64) = b(k,64) - lu(k,367) * b(k,96) + b(k,57) = b(k,57) - lu(k,366) * b(k,96) + b(k,95) = b(k,95) * lu(k,360) + b(k,94) = b(k,94) * lu(k,352) + b(k,56) = b(k,56) - lu(k,351) * b(k,94) + b(k,93) = b(k,93) * lu(k,342) + b(k,82) = b(k,82) - lu(k,341) * b(k,93) + b(k,92) = b(k,92) * lu(k,336) + b(k,90) = b(k,90) - lu(k,335) * b(k,92) + b(k,91) = b(k,91) * lu(k,328) + b(k,59) = b(k,59) - lu(k,327) * b(k,91) + b(k,48) = b(k,48) - lu(k,326) * b(k,91) + b(k,90) = b(k,90) * lu(k,323) + b(k,89) = b(k,89) * lu(k,318) + b(k,88) = b(k,88) * lu(k,308) + b(k,87) = b(k,87) * lu(k,301) + b(k,86) = b(k,86) * lu(k,292) + b(k,85) = b(k,85) * lu(k,283) + b(k,84) = b(k,84) * lu(k,276) + b(k,83) = b(k,83) * lu(k,268) + b(k,82) = b(k,82) * lu(k,260) + b(k,81) = b(k,81) * lu(k,252) + b(k,80) = b(k,80) * lu(k,248) + b(k,79) = b(k,79) * lu(k,240) + b(k,78) = b(k,78) * lu(k,234) + b(k,77) = b(k,77) * lu(k,227) + b(k,76) = b(k,76) * lu(k,220) + b(k,75) = b(k,75) * lu(k,213) + b(k,53) = b(k,53) - lu(k,212) * b(k,75) + b(k,74) = b(k,74) * lu(k,206) + b(k,73) = b(k,73) * lu(k,200) + b(k,72) = b(k,72) * lu(k,194) + b(k,71) = b(k,71) * lu(k,188) + b(k,70) = b(k,70) * lu(k,182) + b(k,69) = b(k,69) * lu(k,176) + b(k,68) = b(k,68) * lu(k,168) + b(k,67) = b(k,67) * lu(k,160) + b(k,66) = b(k,66) * lu(k,157) + b(k,65) = b(k,65) * lu(k,152) + end do + end subroutine lu_slv07 + subroutine lu_slv08( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) +!----------------------------------------------------------------------- +! ... Local variables +!----------------------------------------------------------------------- + integer :: k +!----------------------------------------------------------------------- +! ... solve L * y = b +!----------------------------------------------------------------------- + do k = 1,avec_len + b(k,64) = b(k,64) * lu(k,147) + b(k,63) = b(k,63) * lu(k,142) + b(k,62) = b(k,62) * lu(k,136) + b(k,61) = b(k,61) * lu(k,130) + b(k,60) = b(k,60) * lu(k,124) + b(k,59) = b(k,59) * lu(k,120) + b(k,58) = b(k,58) * lu(k,116) + b(k,49) = b(k,49) - lu(k,115) * b(k,58) + b(k,57) = b(k,57) * lu(k,111) + b(k,56) = b(k,56) * lu(k,108) + b(k,55) = b(k,55) * lu(k,103) + b(k,54) = b(k,54) * lu(k,100) + b(k,53) = b(k,53) * lu(k,97) + b(k,52) = b(k,52) * lu(k,93) + b(k,51) = b(k,51) * lu(k,89) + b(k,50) = b(k,50) * lu(k,87) + b(k,49) = b(k,49) * lu(k,84) + b(k,48) = b(k,48) * lu(k,81) + b(k,47) = b(k,47) * lu(k,77) + b(k,46) = b(k,46) * lu(k,73) + b(k,45) = b(k,45) * lu(k,69) + b(k,44) = b(k,44) * lu(k,66) + b(k,43) = b(k,43) * lu(k,63) + b(k,42) = b(k,42) * lu(k,60) + b(k,41) = b(k,41) * lu(k,57) + b(k,40) = b(k,40) * lu(k,54) + b(k,39) = b(k,39) * lu(k,51) + b(k,38) = b(k,38) * lu(k,48) + b(k,37) = b(k,37) * lu(k,45) + b(k,36) = b(k,36) * lu(k,42) + b(k,35) = b(k,35) * lu(k,39) + b(k,34) = b(k,34) * lu(k,36) + b(k,33) = b(k,33) * lu(k,35) + b(k,32) = b(k,32) * lu(k,34) + b(k,31) = b(k,31) * lu(k,32) + b(k,30) = b(k,30) * lu(k,31) + b(k,29) = b(k,29) * lu(k,30) + b(k,28) = b(k,28) * lu(k,29) + b(k,27) = b(k,27) * lu(k,28) + b(k,26) = b(k,26) * lu(k,27) + b(k,25) = b(k,25) * lu(k,26) + b(k,24) = b(k,24) * lu(k,25) + b(k,23) = b(k,23) * lu(k,24) + b(k,22) = b(k,22) * lu(k,23) + b(k,21) = b(k,21) * lu(k,22) + b(k,20) = b(k,20) * lu(k,21) + b(k,19) = b(k,19) * lu(k,20) + b(k,18) = b(k,18) * lu(k,19) + b(k,17) = b(k,17) * lu(k,18) + b(k,16) = b(k,16) * lu(k,17) + b(k,15) = b(k,15) * lu(k,16) + b(k,14) = b(k,14) * lu(k,15) + b(k,13) = b(k,13) * lu(k,14) + b(k,12) = b(k,12) * lu(k,13) + b(k,11) = b(k,11) * lu(k,12) + b(k,10) = b(k,10) * lu(k,11) + b(k,9) = b(k,9) * lu(k,9) + b(k,8) = b(k,8) * lu(k,8) + b(k,7) = b(k,7) * lu(k,7) + b(k,6) = b(k,6) * lu(k,6) + b(k,5) = b(k,5) * lu(k,5) + b(k,4) = b(k,4) * lu(k,4) + b(k,3) = b(k,3) * lu(k,3) + b(k,2) = b(k,2) * lu(k,2) + b(k,1) = b(k,1) * lu(k,1) + end do + end subroutine lu_slv08 + subroutine lu_slv( avec_len, lu, b ) + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : clscnt4, nzcnt + implicit none +!----------------------------------------------------------------------- +! ... Dummy args +!----------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: lu(veclen,max(1,nzcnt)) + real(r8), intent(inout) :: b(veclen,clscnt4) + call lu_slv01( avec_len, lu, b ) + call lu_slv02( avec_len, lu, b ) + call lu_slv03( avec_len, lu, b ) + call lu_slv04( avec_len, lu, b ) + call lu_slv05( avec_len, lu, b ) + call lu_slv06( avec_len, lu, b ) + call lu_slv07( avec_len, lu, b ) + call lu_slv08( avec_len, lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_nln_matrix.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_nln_matrix.F90 new file mode 100644 index 0000000000..388e9b1dad --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_nln_matrix.F90 @@ -0,0 +1,2217 @@ + module mo_nln_matrix + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only: veclen + private + public :: nlnmat + contains + subroutine nlnmat01( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,39) = -(rxt(k,293)*y(k,137)) + mat(k,1092) = -rxt(k,293)*y(k,3) + mat(k,800) = -(rxt(k,173)*y(k,25) + rxt(k,174)*y(k,132) + rxt(k,175)*y(k,98)) + mat(k,784) = -rxt(k,173)*y(k,4) + mat(k,939) = -rxt(k,174)*y(k,4) + mat(k,1005) = -rxt(k,175)*y(k,4) + mat(k,961) = 4.000_r8*rxt(k,176)*y(k,6) + (rxt(k,177)+rxt(k,178))*y(k,41) & + + rxt(k,181)*y(k,88) + rxt(k,184)*y(k,97) + rxt(k,325)*y(k,110) & + + rxt(k,185)*y(k,137) + mat(k,74) = rxt(k,163)*y(k,136) + mat(k,52) = rxt(k,189)*y(k,136) + mat(k,228) = 2.000_r8*rxt(k,194)*y(k,38) + 2.000_r8*rxt(k,206)*y(k,136) & + + 2.000_r8*rxt(k,195)*y(k,137) + mat(k,294) = rxt(k,196)*y(k,38) + rxt(k,207)*y(k,136) + rxt(k,197)*y(k,137) + mat(k,183) = 3.000_r8*rxt(k,201)*y(k,38) + 3.000_r8*rxt(k,190)*y(k,136) & + + 3.000_r8*rxt(k,202)*y(k,137) + mat(k,854) = 2.000_r8*rxt(k,194)*y(k,24) + rxt(k,196)*y(k,26) & + + 3.000_r8*rxt(k,201)*y(k,37) + mat(k,1232) = (rxt(k,177)+rxt(k,178))*y(k,6) + mat(k,43) = 2.000_r8*rxt(k,191)*y(k,136) + mat(k,410) = rxt(k,186)*y(k,97) + rxt(k,192)*y(k,136) + rxt(k,187)*y(k,137) + mat(k,1274) = rxt(k,181)*y(k,6) + mat(k,883) = rxt(k,184)*y(k,6) + rxt(k,186)*y(k,59) + mat(k,604) = rxt(k,325)*y(k,6) + mat(k,1078) = rxt(k,163)*y(k,17) + rxt(k,189)*y(k,18) + 2.000_r8*rxt(k,206) & + *y(k,24) + rxt(k,207)*y(k,26) + 3.000_r8*rxt(k,190)*y(k,37) & + + 2.000_r8*rxt(k,191)*y(k,56) + rxt(k,192)*y(k,59) + mat(k,1163) = rxt(k,185)*y(k,6) + 2.000_r8*rxt(k,195)*y(k,24) + rxt(k,197) & + *y(k,26) + 3.000_r8*rxt(k,202)*y(k,37) + rxt(k,187)*y(k,59) + mat(k,953) = rxt(k,179)*y(k,41) + mat(k,1223) = rxt(k,179)*y(k,6) + mat(k,813) = (rxt(k,351)+rxt(k,356))*y(k,67) + mat(k,351) = (rxt(k,351)+rxt(k,356))*y(k,63) + mat(k,966) = -(4._r8*rxt(k,176)*y(k,6) + (rxt(k,177) + rxt(k,178) + rxt(k,179) & + ) * y(k,41) + rxt(k,180)*y(k,132) + rxt(k,181)*y(k,88) + rxt(k,182) & + *y(k,89) + rxt(k,184)*y(k,97) + rxt(k,185)*y(k,137) + rxt(k,325) & + *y(k,110)) + mat(k,1237) = -(rxt(k,177) + rxt(k,178) + rxt(k,179)) * y(k,6) + mat(k,944) = -rxt(k,180)*y(k,6) + mat(k,1279) = -rxt(k,181)*y(k,6) + mat(k,1046) = -rxt(k,182)*y(k,6) + mat(k,888) = -rxt(k,184)*y(k,6) + mat(k,1168) = -rxt(k,185)*y(k,6) + mat(k,608) = -rxt(k,325)*y(k,6) + mat(k,805) = rxt(k,175)*y(k,98) + mat(k,273) = rxt(k,183)*y(k,97) + mat(k,412) = rxt(k,193)*y(k,136) + mat(k,357) = rxt(k,188)*y(k,97) + mat(k,888) = mat(k,888) + rxt(k,183)*y(k,7) + rxt(k,188)*y(k,67) + mat(k,1010) = rxt(k,175)*y(k,4) + mat(k,1083) = rxt(k,193)*y(k,59) + mat(k,268) = -(rxt(k,183)*y(k,97)) + mat(k,870) = -rxt(k,183)*y(k,7) + mat(k,955) = rxt(k,182)*y(k,89) + mat(k,1024) = rxt(k,182)*y(k,6) + mat(k,220) = -(rxt(k,225)*y(k,38) + rxt(k,226)*y(k,98) + rxt(k,250)*y(k,137)) + mat(k,836) = -rxt(k,225)*y(k,9) + mat(k,975) = -rxt(k,226)*y(k,9) + mat(k,1116) = -rxt(k,250)*y(k,9) + mat(k,111) = -(rxt(k,231)*y(k,137)) + mat(k,1100) = -rxt(k,231)*y(k,10) + mat(k,366) = .800_r8*rxt(k,227)*y(k,126) + .200_r8*rxt(k,228)*y(k,129) + mat(k,730) = .200_r8*rxt(k,228)*y(k,126) + mat(k,147) = -(rxt(k,232)*y(k,137)) + mat(k,1105) = -rxt(k,232)*y(k,11) + mat(k,367) = rxt(k,229)*y(k,132) + mat(k,901) = rxt(k,229)*y(k,126) + mat(k,130) = -(rxt(k,233)*y(k,38) + rxt(k,234)*y(k,137)) + mat(k,833) = -rxt(k,233)*y(k,12) + mat(k,1102) = -rxt(k,234)*y(k,12) + mat(k,530) = -(rxt(k,253)*y(k,90) + rxt(k,254)*y(k,98) + rxt(k,271)*y(k,137)) + mat(k,1193) = -rxt(k,253)*y(k,13) + mat(k,991) = -rxt(k,254)*y(k,13) + mat(k,1149) = -rxt(k,271)*y(k,13) + mat(k,432) = .130_r8*rxt(k,304)*y(k,98) + mat(k,991) = mat(k,991) + .130_r8*rxt(k,304)*y(k,71) + mat(k,188) = -(rxt(k,258)*y(k,137)) + mat(k,1111) = -rxt(k,258)*y(k,14) + mat(k,387) = rxt(k,256)*y(k,132) + mat(k,903) = rxt(k,256)*y(k,127) + mat(k,69) = -(rxt(k,259)*y(k,137)) + mat(k,1094) = -rxt(k,259)*y(k,15) + mat(k,48) = -(rxt(k,162)*y(k,136)) + mat(k,1056) = -rxt(k,162)*y(k,16) + mat(k,73) = -(rxt(k,163)*y(k,136)) + mat(k,1063) = -rxt(k,163)*y(k,17) + mat(k,51) = -(rxt(k,189)*y(k,136)) + mat(k,1057) = -rxt(k,189)*y(k,18) + mat(k,54) = -(rxt(k,164)*y(k,136)) + mat(k,1058) = -rxt(k,164)*y(k,19) + mat(k,57) = -(rxt(k,165)*y(k,136)) + mat(k,1059) = -rxt(k,165)*y(k,20) + mat(k,60) = -(rxt(k,166)*y(k,136)) + mat(k,1060) = -rxt(k,166)*y(k,21) + mat(k,63) = -(rxt(k,167)*y(k,136)) + mat(k,1061) = -rxt(k,167)*y(k,22) + mat(k,66) = -(rxt(k,168)*y(k,136)) + mat(k,1062) = -rxt(k,168)*y(k,23) + mat(k,227) = -(rxt(k,194)*y(k,38) + rxt(k,195)*y(k,137) + rxt(k,206)*y(k,136)) + mat(k,837) = -rxt(k,194)*y(k,24) + mat(k,1117) = -rxt(k,195)*y(k,24) + mat(k,1069) = -rxt(k,206)*y(k,24) + mat(k,783) = -(rxt(k,137)*y(k,38) + rxt(k,173)*y(k,4) + rxt(k,211)*y(k,90) & + + rxt(k,212)*y(k,97) + rxt(k,213)*y(k,137)) + mat(k,853) = -rxt(k,137)*y(k,25) + mat(k,799) = -rxt(k,173)*y(k,25) + mat(k,1206) = -rxt(k,211)*y(k,25) + mat(k,882) = -rxt(k,212)*y(k,25) + mat(k,1162) = -rxt(k,213)*y(k,25) + mat(k,223) = rxt(k,226)*y(k,98) + mat(k,536) = .500_r8*rxt(k,254)*y(k,98) + mat(k,305) = .500_r8*rxt(k,242)*y(k,137) + mat(k,249) = rxt(k,218)*y(k,137) + mat(k,203) = .300_r8*rxt(k,219)*y(k,137) + mat(k,482) = (rxt(k,222)+rxt(k,223))*y(k,136) + mat(k,1231) = rxt(k,144)*y(k,129) + mat(k,461) = .800_r8*rxt(k,247)*y(k,137) + mat(k,438) = .910_r8*rxt(k,304)*y(k,98) + mat(k,381) = .072_r8*rxt(k,297)*y(k,88) + .072_r8*rxt(k,298)*y(k,90) & + + .206_r8*rxt(k,296)*y(k,132) + mat(k,565) = .120_r8*rxt(k,279)*y(k,98) + mat(k,287) = .500_r8*rxt(k,288)*y(k,137) + mat(k,718) = .600_r8*rxt(k,289)*y(k,98) + mat(k,1273) = .072_r8*rxt(k,297)*y(k,72) + rxt(k,217)*y(k,129) & + + .500_r8*rxt(k,244)*y(k,131) + .550_r8*rxt(k,302)*y(k,133) & + + .250_r8*rxt(k,277)*y(k,134) + rxt(k,286)*y(k,135) + rxt(k,265) & + *y(k,138) + rxt(k,269)*y(k,139) + .250_r8*rxt(k,312)*y(k,140) + mat(k,1206) = mat(k,1206) + .072_r8*rxt(k,298)*y(k,72) + .600_r8*rxt(k,303) & + *y(k,133) + .250_r8*rxt(k,276)*y(k,134) + rxt(k,287)*y(k,135) + mat(k,1004) = rxt(k,226)*y(k,9) + .500_r8*rxt(k,254)*y(k,13) & + + .910_r8*rxt(k,304)*y(k,71) + .120_r8*rxt(k,279)*y(k,74) & + + .600_r8*rxt(k,289)*y(k,77) + mat(k,256) = rxt(k,249)*y(k,137) + mat(k,372) = .700_r8*rxt(k,228)*y(k,129) + mat(k,394) = rxt(k,255)*y(k,129) + mat(k,698) = rxt(k,238)*y(k,129) + .600_r8*rxt(k,299)*y(k,133) & + + .250_r8*rxt(k,273)*y(k,134) + rxt(k,282)*y(k,135) & + + .250_r8*rxt(k,309)*y(k,140) + mat(k,755) = rxt(k,144)*y(k,41) + rxt(k,217)*y(k,88) + .700_r8*rxt(k,228) & + *y(k,126) + rxt(k,255)*y(k,127) + rxt(k,238)*y(k,128) + ( & + + 4.000_r8*rxt(k,214)+2.000_r8*rxt(k,215))*y(k,129) & + + 1.200_r8*rxt(k,300)*y(k,133) + .880_r8*rxt(k,274)*y(k,134) & + + 2.000_r8*rxt(k,283)*y(k,135) + .800_r8*rxt(k,267)*y(k,139) & + + .800_r8*rxt(k,310)*y(k,140) + mat(k,330) = .500_r8*rxt(k,244)*y(k,88) + mat(k,938) = .206_r8*rxt(k,296)*y(k,72) + .450_r8*rxt(k,284)*y(k,135) & + + .150_r8*rxt(k,268)*y(k,139) + mat(k,632) = .550_r8*rxt(k,302)*y(k,88) + .600_r8*rxt(k,303)*y(k,90) & + + .600_r8*rxt(k,299)*y(k,128) + 1.200_r8*rxt(k,300)*y(k,129) + mat(k,653) = .250_r8*rxt(k,277)*y(k,88) + .250_r8*rxt(k,276)*y(k,90) & + + .250_r8*rxt(k,273)*y(k,128) + .880_r8*rxt(k,274)*y(k,129) + mat(k,671) = rxt(k,286)*y(k,88) + rxt(k,287)*y(k,90) + rxt(k,282)*y(k,128) & + + 2.000_r8*rxt(k,283)*y(k,129) + .450_r8*rxt(k,284)*y(k,132) & + + 4.000_r8*rxt(k,285)*y(k,135) + mat(k,1077) = (rxt(k,222)+rxt(k,223))*y(k,36) + mat(k,1162) = mat(k,1162) + .500_r8*rxt(k,242)*y(k,33) + rxt(k,218)*y(k,34) & + + .300_r8*rxt(k,219)*y(k,35) + .800_r8*rxt(k,247)*y(k,52) & + + .500_r8*rxt(k,288)*y(k,76) + rxt(k,249)*y(k,103) + mat(k,345) = rxt(k,265)*y(k,88) + mat(k,497) = rxt(k,269)*y(k,88) + .800_r8*rxt(k,267)*y(k,129) & + + .150_r8*rxt(k,268)*y(k,132) + mat(k,582) = .250_r8*rxt(k,312)*y(k,88) + .250_r8*rxt(k,309)*y(k,128) & + + .800_r8*rxt(k,310)*y(k,129) + mat(k,292) = -(rxt(k,196)*y(k,38) + rxt(k,197)*y(k,137) + rxt(k,207)*y(k,136)) + mat(k,839) = -rxt(k,196)*y(k,26) + mat(k,1125) = -rxt(k,197)*y(k,26) + mat(k,1070) = -rxt(k,207)*y(k,26) + mat(k,77) = -(rxt(k,198)*y(k,137)) + mat(k,1095) = -rxt(k,198)*y(k,27) + mat(k,550) = -(rxt(k,235)*y(k,90) + rxt(k,236)*y(k,137)) + mat(k,1194) = -rxt(k,235)*y(k,28) + mat(k,1150) = -rxt(k,236)*y(k,28) + mat(k,112) = rxt(k,231)*y(k,137) + mat(k,149) = .500_r8*rxt(k,232)*y(k,137) + mat(k,531) = .500_r8*rxt(k,254)*y(k,98) + mat(k,710) = .100_r8*rxt(k,289)*y(k,98) + mat(k,1262) = rxt(k,230)*y(k,126) + .270_r8*rxt(k,257)*y(k,127) + rxt(k,265) & + *y(k,138) + mat(k,992) = .500_r8*rxt(k,254)*y(k,13) + .100_r8*rxt(k,289)*y(k,77) + mat(k,370) = rxt(k,230)*y(k,88) + 3.200_r8*rxt(k,227)*y(k,126) & + + .800_r8*rxt(k,228)*y(k,129) + mat(k,391) = .270_r8*rxt(k,257)*y(k,88) + mat(k,744) = .800_r8*rxt(k,228)*y(k,126) + mat(k,1150) = mat(k,1150) + rxt(k,231)*y(k,10) + .500_r8*rxt(k,232)*y(k,11) + mat(k,344) = rxt(k,265)*y(k,88) + mat(k,168) = -(rxt(k,199)*y(k,38) + rxt(k,200)*y(k,137)) + mat(k,834) = -rxt(k,199)*y(k,29) + mat(k,1108) = -rxt(k,200)*y(k,29) + mat(k,360) = -(rxt(k,272)*y(k,137)) + mat(k,1133) = -rxt(k,272)*y(k,30) + mat(k,1253) = .820_r8*rxt(k,257)*y(k,127) + mat(k,309) = .100_r8*rxt(k,317)*y(k,137) + mat(k,388) = .820_r8*rxt(k,257)*y(k,88) + .820_r8*rxt(k,255)*y(k,129) + mat(k,737) = .820_r8*rxt(k,255)*y(k,127) + mat(k,1133) = mat(k,1133) + .100_r8*rxt(k,317)*y(k,122) + mat(k,591) = -(rxt(k,260)*y(k,90) + rxt(k,261)*y(k,137)) + mat(k,1197) = -rxt(k,260)*y(k,31) + mat(k,1153) = -rxt(k,261)*y(k,31) + mat(k,504) = rxt(k,262)*y(k,137) + mat(k,561) = .880_r8*rxt(k,279)*y(k,98) + mat(k,711) = .500_r8*rxt(k,289)*y(k,98) + mat(k,1265) = .020_r8*rxt(k,302)*y(k,133) + .250_r8*rxt(k,277)*y(k,134) & + + .250_r8*rxt(k,312)*y(k,140) + mat(k,1197) = mat(k,1197) + .250_r8*rxt(k,276)*y(k,134) + .250_r8*rxt(k,313) & + *y(k,140) + mat(k,195) = rxt(k,263)*y(k,137) + mat(k,995) = .880_r8*rxt(k,279)*y(k,74) + .500_r8*rxt(k,289)*y(k,77) + mat(k,691) = .250_r8*rxt(k,273)*y(k,134) + .250_r8*rxt(k,309)*y(k,140) + mat(k,747) = .240_r8*rxt(k,274)*y(k,134) + .500_r8*rxt(k,267)*y(k,139) & + + .100_r8*rxt(k,310)*y(k,140) + mat(k,625) = .020_r8*rxt(k,302)*y(k,88) + mat(k,648) = .250_r8*rxt(k,277)*y(k,88) + .250_r8*rxt(k,276)*y(k,90) & + + .250_r8*rxt(k,273)*y(k,128) + .240_r8*rxt(k,274)*y(k,129) + mat(k,1153) = mat(k,1153) + rxt(k,262)*y(k,69) + rxt(k,263)*y(k,91) + mat(k,494) = .500_r8*rxt(k,267)*y(k,129) + mat(k,579) = .250_r8*rxt(k,312)*y(k,88) + .250_r8*rxt(k,313)*y(k,90) & + + .250_r8*rxt(k,309)*y(k,128) + .100_r8*rxt(k,310)*y(k,129) + end do + end subroutine nlnmat01 + subroutine nlnmat02( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,318) = -(rxt(k,241)*y(k,137)) + mat(k,1128) = -rxt(k,241)*y(k,32) + mat(k,523) = .120_r8*rxt(k,254)*y(k,98) + mat(k,978) = .120_r8*rxt(k,254)*y(k,13) + mat(k,683) = .100_r8*rxt(k,238)*y(k,129) + .150_r8*rxt(k,239)*y(k,132) + mat(k,734) = .100_r8*rxt(k,238)*y(k,128) + mat(k,910) = .150_r8*rxt(k,239)*y(k,128) + .150_r8*rxt(k,284)*y(k,135) + mat(k,663) = .150_r8*rxt(k,284)*y(k,132) + mat(k,301) = -(rxt(k,242)*y(k,137)) + mat(k,1126) = -rxt(k,242)*y(k,33) + mat(k,682) = .400_r8*rxt(k,239)*y(k,132) + mat(k,909) = .400_r8*rxt(k,239)*y(k,128) + .400_r8*rxt(k,284)*y(k,135) + mat(k,662) = .400_r8*rxt(k,284)*y(k,132) + mat(k,248) = -(rxt(k,218)*y(k,137)) + mat(k,1120) = -rxt(k,218)*y(k,34) + mat(k,368) = .300_r8*rxt(k,228)*y(k,129) + mat(k,733) = .300_r8*rxt(k,228)*y(k,126) + 2.000_r8*rxt(k,215)*y(k,129) & + + .250_r8*rxt(k,300)*y(k,133) + .250_r8*rxt(k,274)*y(k,134) & + + .500_r8*rxt(k,267)*y(k,139) + .300_r8*rxt(k,310)*y(k,140) + mat(k,617) = .250_r8*rxt(k,300)*y(k,129) + mat(k,642) = .250_r8*rxt(k,274)*y(k,129) + mat(k,491) = .500_r8*rxt(k,267)*y(k,129) + mat(k,572) = .300_r8*rxt(k,310)*y(k,129) + mat(k,200) = -(rxt(k,219)*y(k,137)) + mat(k,1113) = -rxt(k,219)*y(k,35) + mat(k,732) = rxt(k,216)*y(k,132) + mat(k,904) = rxt(k,216)*y(k,129) + mat(k,477) = -(rxt(k,138)*y(k,38) + rxt(k,220)*y(k,137) + (rxt(k,221) & + + rxt(k,222) + rxt(k,223)) * y(k,136)) + mat(k,845) = -rxt(k,138)*y(k,36) + mat(k,1144) = -rxt(k,220)*y(k,36) + mat(k,1072) = -(rxt(k,221) + rxt(k,222) + rxt(k,223)) * y(k,36) + mat(k,526) = .100_r8*rxt(k,254)*y(k,98) + mat(k,986) = .100_r8*rxt(k,254)*y(k,13) + mat(k,182) = -(rxt(k,190)*y(k,136) + rxt(k,201)*y(k,38) + rxt(k,202)*y(k,137)) + mat(k,1068) = -rxt(k,190)*y(k,37) + mat(k,835) = -rxt(k,201)*y(k,37) + mat(k,1110) = -rxt(k,202)*y(k,37) + mat(k,856) = -(rxt(k,137)*y(k,25) + rxt(k,138)*y(k,36) + rxt(k,139)*y(k,55) & + + rxt(k,140)*y(k,57) + (rxt(k,141) + rxt(k,142)) * y(k,132) & + + rxt(k,143)*y(k,98) + rxt(k,150)*y(k,42) + rxt(k,159)*y(k,68) & + + rxt(k,194)*y(k,24) + rxt(k,196)*y(k,26) + rxt(k,199)*y(k,29) & + + rxt(k,201)*y(k,37) + rxt(k,233)*y(k,12)) + mat(k,786) = -rxt(k,137)*y(k,38) + mat(k,484) = -rxt(k,138)*y(k,38) + mat(k,517) = -rxt(k,139)*y(k,38) + mat(k,278) = -rxt(k,140)*y(k,38) + mat(k,941) = -(rxt(k,141) + rxt(k,142)) * y(k,38) + mat(k,1007) = -rxt(k,143)*y(k,38) + mat(k,450) = -rxt(k,150)*y(k,38) + mat(k,403) = -rxt(k,159)*y(k,38) + mat(k,230) = -rxt(k,194)*y(k,38) + mat(k,296) = -rxt(k,196)*y(k,38) + mat(k,172) = -rxt(k,199)*y(k,38) + mat(k,185) = -rxt(k,201)*y(k,38) + mat(k,133) = -rxt(k,233)*y(k,38) + mat(k,963) = rxt(k,178)*y(k,41) + mat(k,49) = 4.000_r8*rxt(k,162)*y(k,136) + mat(k,75) = rxt(k,163)*y(k,136) + mat(k,55) = 3.000_r8*rxt(k,164)*y(k,136) + mat(k,58) = 3.000_r8*rxt(k,165)*y(k,136) + mat(k,61) = 2.000_r8*rxt(k,166)*y(k,136) + mat(k,64) = rxt(k,167)*y(k,136) + mat(k,67) = 2.000_r8*rxt(k,168)*y(k,136) + mat(k,78) = 3.000_r8*rxt(k,198)*y(k,137) + mat(k,172) = mat(k,172) + rxt(k,200)*y(k,137) + mat(k,1234) = rxt(k,178)*y(k,6) + (4.000_r8*rxt(k,145)+2.000_r8*rxt(k,147)) & + *y(k,41) + rxt(k,149)*y(k,88) + rxt(k,154)*y(k,97) + rxt(k,326) & + *y(k,110) + rxt(k,144)*y(k,129) + rxt(k,155)*y(k,137) + mat(k,90) = 2.000_r8*rxt(k,208)*y(k,136) + 2.000_r8*rxt(k,203)*y(k,137) + mat(k,94) = rxt(k,209)*y(k,136) + rxt(k,204)*y(k,137) + mat(k,104) = rxt(k,210)*y(k,136) + rxt(k,205)*y(k,137) + mat(k,821) = rxt(k,157)*y(k,97) + rxt(k,169)*y(k,136) + rxt(k,158)*y(k,137) + mat(k,1276) = rxt(k,149)*y(k,41) + mat(k,885) = rxt(k,154)*y(k,41) + rxt(k,157)*y(k,63) + mat(k,605) = rxt(k,326)*y(k,41) + mat(k,757) = rxt(k,144)*y(k,41) + mat(k,1080) = 4.000_r8*rxt(k,162)*y(k,16) + rxt(k,163)*y(k,17) & + + 3.000_r8*rxt(k,164)*y(k,19) + 3.000_r8*rxt(k,165)*y(k,20) & + + 2.000_r8*rxt(k,166)*y(k,21) + rxt(k,167)*y(k,22) & + + 2.000_r8*rxt(k,168)*y(k,23) + 2.000_r8*rxt(k,208)*y(k,60) & + + rxt(k,209)*y(k,61) + rxt(k,210)*y(k,62) + rxt(k,169)*y(k,63) + mat(k,1165) = 3.000_r8*rxt(k,198)*y(k,27) + rxt(k,200)*y(k,29) + rxt(k,155) & + *y(k,41) + 2.000_r8*rxt(k,203)*y(k,60) + rxt(k,204)*y(k,61) & + + rxt(k,205)*y(k,62) + rxt(k,158)*y(k,63) + mat(k,832) = rxt(k,150)*y(k,42) + mat(k,1222) = 2.000_r8*rxt(k,146)*y(k,41) + mat(k,445) = rxt(k,150)*y(k,38) + (rxt(k,349)+rxt(k,354)+rxt(k,359))*y(k,63) + mat(k,812) = (rxt(k,349)+rxt(k,354)+rxt(k,359))*y(k,42) + (rxt(k,344) & + +rxt(k,350)+rxt(k,355))*y(k,68) + mat(k,400) = (rxt(k,344)+rxt(k,350)+rxt(k,355))*y(k,63) + mat(k,1221) = 2.000_r8*rxt(k,171)*y(k,41) + mat(k,1243) = -(rxt(k,144)*y(k,129) + (4._r8*rxt(k,145) + 4._r8*rxt(k,146) & + + 4._r8*rxt(k,147) + 4._r8*rxt(k,171)) * y(k,41) + rxt(k,148) & + *y(k,132) + rxt(k,149)*y(k,88) + rxt(k,151)*y(k,89) + rxt(k,154) & + *y(k,97) + (rxt(k,155) + rxt(k,156)) * y(k,137) + (rxt(k,177) & + + rxt(k,178) + rxt(k,179)) * y(k,6) + rxt(k,326)*y(k,110)) + mat(k,765) = -rxt(k,144)*y(k,41) + mat(k,950) = -rxt(k,148)*y(k,41) + mat(k,1285) = -rxt(k,149)*y(k,41) + mat(k,1052) = -rxt(k,151)*y(k,41) + mat(k,894) = -rxt(k,154)*y(k,41) + mat(k,1174) = -(rxt(k,155) + rxt(k,156)) * y(k,41) + mat(k,972) = -(rxt(k,177) + rxt(k,178) + rxt(k,179)) * y(k,41) + mat(k,612) = -rxt(k,326)*y(k,41) + mat(k,865) = rxt(k,159)*y(k,68) + rxt(k,143)*y(k,98) + rxt(k,142)*y(k,132) + mat(k,455) = rxt(k,152)*y(k,97) + mat(k,830) = rxt(k,170)*y(k,136) + mat(k,406) = rxt(k,159)*y(k,38) + rxt(k,160)*y(k,97) + rxt(k,161)*y(k,137) + mat(k,894) = mat(k,894) + rxt(k,152)*y(k,42) + rxt(k,160)*y(k,68) + mat(k,1016) = rxt(k,143)*y(k,38) + mat(k,156) = rxt(k,331)*y(k,110) + mat(k,612) = mat(k,612) + rxt(k,331)*y(k,100) + mat(k,950) = mat(k,950) + rxt(k,142)*y(k,38) + mat(k,1089) = rxt(k,170)*y(k,63) + mat(k,1174) = mat(k,1174) + rxt(k,161)*y(k,68) + mat(k,448) = -(rxt(k,150)*y(k,38) + rxt(k,152)*y(k,97) + rxt(k,153)*y(k,137) & + + (rxt(k,349) + rxt(k,354) + rxt(k,359)) * y(k,63)) + mat(k,843) = -rxt(k,150)*y(k,42) + mat(k,877) = -rxt(k,152)*y(k,42) + mat(k,1141) = -rxt(k,153)*y(k,42) + mat(k,817) = -(rxt(k,349) + rxt(k,354) + rxt(k,359)) * y(k,42) + mat(k,1227) = rxt(k,151)*y(k,89) + mat(k,1030) = rxt(k,151)*y(k,41) + mat(k,510) = -(rxt(k,224)*y(k,137)) + mat(k,1147) = -rxt(k,224)*y(k,44) + mat(k,797) = rxt(k,173)*y(k,25) + mat(k,222) = .630_r8*rxt(k,226)*y(k,98) + mat(k,528) = .560_r8*rxt(k,254)*y(k,98) + mat(k,780) = rxt(k,173)*y(k,4) + rxt(k,137)*y(k,38) + rxt(k,211)*y(k,90) & + + rxt(k,212)*y(k,97) + rxt(k,213)*y(k,137) + mat(k,169) = rxt(k,199)*y(k,38) + mat(k,590) = rxt(k,260)*y(k,90) + rxt(k,261)*y(k,137) + mat(k,846) = rxt(k,137)*y(k,25) + rxt(k,199)*y(k,29) + mat(k,337) = rxt(k,248)*y(k,137) + mat(k,431) = .620_r8*rxt(k,304)*y(k,98) + mat(k,559) = .650_r8*rxt(k,279)*y(k,98) + mat(k,708) = .560_r8*rxt(k,289)*y(k,98) + mat(k,1261) = .220_r8*rxt(k,277)*y(k,134) + .250_r8*rxt(k,312)*y(k,140) + mat(k,1192) = rxt(k,211)*y(k,25) + rxt(k,260)*y(k,31) + .220_r8*rxt(k,276) & + *y(k,134) + .500_r8*rxt(k,313)*y(k,140) + mat(k,878) = rxt(k,212)*y(k,25) + rxt(k,320)*y(k,101) + mat(k,989) = .630_r8*rxt(k,226)*y(k,9) + .560_r8*rxt(k,254)*y(k,13) & + + .620_r8*rxt(k,304)*y(k,71) + .650_r8*rxt(k,279)*y(k,74) & + + .560_r8*rxt(k,289)*y(k,77) + mat(k,163) = rxt(k,320)*y(k,97) + rxt(k,321)*y(k,137) + mat(k,688) = .220_r8*rxt(k,273)*y(k,134) + .250_r8*rxt(k,309)*y(k,140) + mat(k,743) = .110_r8*rxt(k,274)*y(k,134) + .200_r8*rxt(k,310)*y(k,140) + mat(k,646) = .220_r8*rxt(k,277)*y(k,88) + .220_r8*rxt(k,276)*y(k,90) & + + .220_r8*rxt(k,273)*y(k,128) + .110_r8*rxt(k,274)*y(k,129) + mat(k,1147) = mat(k,1147) + rxt(k,213)*y(k,25) + rxt(k,261)*y(k,31) & + + rxt(k,248)*y(k,53) + rxt(k,321)*y(k,101) + mat(k,577) = .250_r8*rxt(k,312)*y(k,88) + .500_r8*rxt(k,313)*y(k,90) & + + .250_r8*rxt(k,309)*y(k,128) + .200_r8*rxt(k,310)*y(k,129) + mat(k,524) = .200_r8*rxt(k,254)*y(k,98) + mat(k,319) = rxt(k,241)*y(k,137) + mat(k,302) = .500_r8*rxt(k,242)*y(k,137) + mat(k,509) = rxt(k,224)*y(k,137) + mat(k,457) = .800_r8*rxt(k,247)*y(k,137) + mat(k,335) = rxt(k,248)*y(k,137) + mat(k,284) = .500_r8*rxt(k,288)*y(k,137) + mat(k,707) = .100_r8*rxt(k,289)*y(k,98) + mat(k,1249) = rxt(k,240)*y(k,128) + mat(k,979) = .200_r8*rxt(k,254)*y(k,13) + .100_r8*rxt(k,289)*y(k,77) + mat(k,684) = rxt(k,240)*y(k,88) + 4.000_r8*rxt(k,237)*y(k,128) & + + .900_r8*rxt(k,238)*y(k,129) + 2.000_r8*rxt(k,282)*y(k,135) & + + rxt(k,309)*y(k,140) + mat(k,735) = .900_r8*rxt(k,238)*y(k,128) + rxt(k,283)*y(k,135) + mat(k,911) = .450_r8*rxt(k,284)*y(k,135) + mat(k,664) = 2.000_r8*rxt(k,282)*y(k,128) + rxt(k,283)*y(k,129) & + + .450_r8*rxt(k,284)*y(k,132) + 4.000_r8*rxt(k,285)*y(k,135) + mat(k,1129) = rxt(k,241)*y(k,32) + .500_r8*rxt(k,242)*y(k,33) + rxt(k,224) & + *y(k,44) + .800_r8*rxt(k,247)*y(k,52) + rxt(k,248)*y(k,53) & + + .500_r8*rxt(k,288)*y(k,76) + mat(k,573) = rxt(k,309)*y(k,128) + mat(k,136) = -(rxt(k,318)*y(k,90) + (rxt(k,319) + rxt(k,333)) * y(k,137)) + mat(k,1178) = -rxt(k,318)*y(k,46) + mat(k,1103) = -(rxt(k,319) + rxt(k,333)) * y(k,46) + mat(k,326) = rxt(k,243)*y(k,132) + mat(k,897) = rxt(k,243)*y(k,131) + mat(k,459) = -(rxt(k,247)*y(k,137)) + mat(k,1142) = -rxt(k,247)*y(k,52) + mat(k,1257) = .020_r8*rxt(k,302)*y(k,133) + .530_r8*rxt(k,277)*y(k,134) & + + .250_r8*rxt(k,312)*y(k,140) + mat(k,1188) = .530_r8*rxt(k,276)*y(k,134) + .250_r8*rxt(k,313)*y(k,140) + mat(k,686) = .530_r8*rxt(k,273)*y(k,134) + .250_r8*rxt(k,309)*y(k,140) + mat(k,740) = .260_r8*rxt(k,274)*y(k,134) + .100_r8*rxt(k,310)*y(k,140) + mat(k,619) = .020_r8*rxt(k,302)*y(k,88) + mat(k,643) = .530_r8*rxt(k,277)*y(k,88) + .530_r8*rxt(k,276)*y(k,90) & + + .530_r8*rxt(k,273)*y(k,128) + .260_r8*rxt(k,274)*y(k,129) + mat(k,575) = .250_r8*rxt(k,312)*y(k,88) + .250_r8*rxt(k,313)*y(k,90) & + + .250_r8*rxt(k,309)*y(k,128) + .100_r8*rxt(k,310)*y(k,129) + mat(k,336) = -(rxt(k,248)*y(k,137)) + mat(k,1131) = -rxt(k,248)*y(k,53) + mat(k,458) = .200_r8*rxt(k,247)*y(k,137) + mat(k,1251) = .020_r8*rxt(k,302)*y(k,133) + .250_r8*rxt(k,312)*y(k,140) + mat(k,1182) = .250_r8*rxt(k,313)*y(k,140) + mat(k,685) = .250_r8*rxt(k,309)*y(k,140) + mat(k,736) = .100_r8*rxt(k,310)*y(k,140) + mat(k,618) = .020_r8*rxt(k,302)*y(k,88) + mat(k,1131) = mat(k,1131) + .200_r8*rxt(k,247)*y(k,52) + mat(k,574) = .250_r8*rxt(k,312)*y(k,88) + .250_r8*rxt(k,313)*y(k,90) & + + .250_r8*rxt(k,309)*y(k,128) + .100_r8*rxt(k,310)*y(k,129) + end do + end subroutine nlnmat02 + subroutine nlnmat03( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,769) = -((rxt(k,97) + rxt(k,98) + rxt(k,99)) * y(k,132) + rxt(k,103) & + *y(k,98)) + mat(k,937) = -(rxt(k,97) + rxt(k,98) + rxt(k,99)) * y(k,54) + mat(k,1003) = -rxt(k,103)*y(k,54) + mat(k,782) = rxt(k,213)*y(k,137) + mat(k,481) = rxt(k,222)*y(k,136) + mat(k,852) = rxt(k,139)*y(k,55) + mat(k,515) = rxt(k,139)*y(k,38) + rxt(k,95)*y(k,97) + rxt(k,86)*y(k,136) & + + rxt(k,104)*y(k,137) + mat(k,409) = rxt(k,193)*y(k,136) + mat(k,818) = rxt(k,170)*y(k,136) + mat(k,214) = rxt(k,125)*y(k,137) + mat(k,881) = rxt(k,95)*y(k,55) + rxt(k,107)*y(k,137) + mat(k,165) = rxt(k,321)*y(k,137) + mat(k,236) = rxt(k,327)*y(k,137) + mat(k,603) = rxt(k,332)*y(k,137) + mat(k,1076) = rxt(k,222)*y(k,36) + rxt(k,86)*y(k,55) + rxt(k,193)*y(k,59) & + + rxt(k,170)*y(k,63) + mat(k,1161) = rxt(k,213)*y(k,25) + rxt(k,104)*y(k,55) + rxt(k,125)*y(k,78) & + + rxt(k,107)*y(k,97) + rxt(k,321)*y(k,101) + rxt(k,327)*y(k,108) & + + rxt(k,332)*y(k,110) + mat(k,514) = -(rxt(k,86)*y(k,136) + rxt(k,95)*y(k,97) + rxt(k,104)*y(k,137) & + + rxt(k,139)*y(k,38)) + mat(k,1074) = -rxt(k,86)*y(k,55) + mat(k,879) = -rxt(k,95)*y(k,55) + mat(k,1148) = -rxt(k,104)*y(k,55) + mat(k,847) = -rxt(k,139)*y(k,55) + mat(k,479) = rxt(k,223)*y(k,136) + mat(k,768) = rxt(k,97)*y(k,132) + mat(k,926) = rxt(k,97)*y(k,54) + mat(k,1074) = mat(k,1074) + rxt(k,223)*y(k,36) + mat(k,42) = -(rxt(k,191)*y(k,136)) + mat(k,1055) = -rxt(k,191)*y(k,56) + mat(k,276) = -(rxt(k,96)*y(k,97) + rxt(k,105)*y(k,137) + rxt(k,140)*y(k,38)) + mat(k,871) = -rxt(k,96)*y(k,57) + mat(k,1123) = -rxt(k,105)*y(k,57) + mat(k,838) = -rxt(k,140)*y(k,57) + mat(k,908) = 2.000_r8*rxt(k,111)*y(k,132) + mat(k,1123) = mat(k,1123) + 2.000_r8*rxt(k,110)*y(k,137) + mat(k,115) = rxt(k,334)*y(k,141) + mat(k,1288) = rxt(k,334)*y(k,112) + mat(k,408) = -(rxt(k,186)*y(k,97) + rxt(k,187)*y(k,137) + (rxt(k,192) & + + rxt(k,193)) * y(k,136)) + mat(k,874) = -rxt(k,186)*y(k,59) + mat(k,1137) = -rxt(k,187)*y(k,59) + mat(k,1071) = -(rxt(k,192) + rxt(k,193)) * y(k,59) + mat(k,796) = rxt(k,173)*y(k,25) + rxt(k,174)*y(k,132) + mat(k,778) = rxt(k,173)*y(k,4) + mat(k,920) = rxt(k,174)*y(k,4) + mat(k,89) = -(rxt(k,203)*y(k,137) + rxt(k,208)*y(k,136)) + mat(k,1096) = -rxt(k,203)*y(k,60) + mat(k,1064) = -rxt(k,208)*y(k,60) + mat(k,93) = -(rxt(k,204)*y(k,137) + rxt(k,209)*y(k,136)) + mat(k,1097) = -rxt(k,204)*y(k,61) + mat(k,1065) = -rxt(k,209)*y(k,61) + mat(k,103) = -(rxt(k,205)*y(k,137) + rxt(k,210)*y(k,136)) + mat(k,1099) = -rxt(k,205)*y(k,62) + mat(k,1067) = -rxt(k,210)*y(k,62) + mat(k,820) = -(rxt(k,157)*y(k,97) + rxt(k,158)*y(k,137) + (rxt(k,169) & + + rxt(k,170)) * y(k,136) + (rxt(k,344) + rxt(k,350) + rxt(k,355) & + ) * y(k,68) + (rxt(k,349) + rxt(k,354) + rxt(k,359)) * y(k,42) & + + (rxt(k,351) + rxt(k,356)) * y(k,67)) + mat(k,884) = -rxt(k,157)*y(k,63) + mat(k,1164) = -rxt(k,158)*y(k,63) + mat(k,1079) = -(rxt(k,169) + rxt(k,170)) * y(k,63) + mat(k,402) = -(rxt(k,344) + rxt(k,350) + rxt(k,355)) * y(k,63) + mat(k,449) = -(rxt(k,349) + rxt(k,354) + rxt(k,359)) * y(k,63) + mat(k,354) = -(rxt(k,351) + rxt(k,356)) * y(k,63) + mat(k,132) = rxt(k,233)*y(k,38) + mat(k,229) = rxt(k,194)*y(k,38) + mat(k,785) = rxt(k,137)*y(k,38) + mat(k,295) = rxt(k,196)*y(k,38) + mat(k,171) = 2.000_r8*rxt(k,199)*y(k,38) + mat(k,483) = rxt(k,138)*y(k,38) + mat(k,184) = rxt(k,201)*y(k,38) + mat(k,855) = rxt(k,233)*y(k,12) + rxt(k,194)*y(k,24) + rxt(k,137)*y(k,25) & + + rxt(k,196)*y(k,26) + 2.000_r8*rxt(k,199)*y(k,29) + rxt(k,138) & + *y(k,36) + rxt(k,201)*y(k,37) + rxt(k,139)*y(k,55) + rxt(k,140) & + *y(k,57) + rxt(k,159)*y(k,68) + rxt(k,141)*y(k,132) + mat(k,1233) = rxt(k,156)*y(k,137) + mat(k,516) = rxt(k,139)*y(k,38) + mat(k,277) = rxt(k,140)*y(k,38) + mat(k,402) = mat(k,402) + rxt(k,159)*y(k,38) + mat(k,940) = rxt(k,141)*y(k,38) + mat(k,1164) = mat(k,1164) + rxt(k,156)*y(k,41) + mat(k,416) = -(rxt(k,134)*y(k,137)) + mat(k,1138) = -rxt(k,134)*y(k,65) + mat(k,779) = rxt(k,211)*y(k,90) + mat(k,548) = rxt(k,235)*y(k,90) + mat(k,589) = rxt(k,260)*y(k,90) + mat(k,447) = (rxt(k,349)+rxt(k,354)+rxt(k,359))*y(k,63) + mat(k,137) = rxt(k,318)*y(k,90) + mat(k,816) = (rxt(k,349)+rxt(k,354)+rxt(k,359))*y(k,42) + mat(k,1028) = rxt(k,133)*y(k,137) + mat(k,1185) = rxt(k,211)*y(k,25) + rxt(k,235)*y(k,28) + rxt(k,260)*y(k,31) & + + rxt(k,318)*y(k,46) + mat(k,1138) = mat(k,1138) + rxt(k,133)*y(k,89) + mat(k,176) = -(rxt(k,112)*y(k,137)) + mat(k,1109) = -rxt(k,112)*y(k,66) + mat(k,1021) = rxt(k,131)*y(k,132) + mat(k,902) = rxt(k,131)*y(k,89) + mat(k,352) = -(rxt(k,188)*y(k,97) + (rxt(k,351) + rxt(k,356)) * y(k,63)) + mat(k,872) = -rxt(k,188)*y(k,67) + mat(k,814) = -(rxt(k,351) + rxt(k,356)) * y(k,67) + mat(k,956) = rxt(k,180)*y(k,132) + mat(k,914) = rxt(k,180)*y(k,6) + mat(k,401) = -(rxt(k,159)*y(k,38) + rxt(k,160)*y(k,97) + rxt(k,161)*y(k,137) & + + (rxt(k,344) + rxt(k,350) + rxt(k,355)) * y(k,63)) + mat(k,842) = -rxt(k,159)*y(k,68) + mat(k,873) = -rxt(k,160)*y(k,68) + mat(k,1136) = -rxt(k,161)*y(k,68) + mat(k,815) = -(rxt(k,344) + rxt(k,350) + rxt(k,355)) * y(k,68) + mat(k,1225) = rxt(k,148)*y(k,132) + mat(k,446) = rxt(k,153)*y(k,137) + mat(k,919) = rxt(k,148)*y(k,41) + mat(k,1136) = mat(k,1136) + rxt(k,153)*y(k,42) + mat(k,503) = -(rxt(k,262)*y(k,137)) + mat(k,1146) = -rxt(k,262)*y(k,69) + mat(k,285) = .500_r8*rxt(k,288)*y(k,137) + mat(k,1260) = .020_r8*rxt(k,302)*y(k,133) + .220_r8*rxt(k,277)*y(k,134) & + + .250_r8*rxt(k,312)*y(k,140) + mat(k,1191) = .220_r8*rxt(k,276)*y(k,134) + .250_r8*rxt(k,313)*y(k,140) + mat(k,262) = .500_r8*rxt(k,266)*y(k,137) + mat(k,687) = .220_r8*rxt(k,273)*y(k,134) + .250_r8*rxt(k,309)*y(k,140) + mat(k,742) = .230_r8*rxt(k,274)*y(k,134) + .200_r8*rxt(k,267)*y(k,139) & + + .100_r8*rxt(k,310)*y(k,140) + mat(k,621) = .020_r8*rxt(k,302)*y(k,88) + mat(k,645) = .220_r8*rxt(k,277)*y(k,88) + .220_r8*rxt(k,276)*y(k,90) & + + .220_r8*rxt(k,273)*y(k,128) + .230_r8*rxt(k,274)*y(k,129) + mat(k,1146) = mat(k,1146) + .500_r8*rxt(k,288)*y(k,76) + .500_r8*rxt(k,266) & + *y(k,106) + mat(k,493) = .200_r8*rxt(k,267)*y(k,129) + mat(k,576) = .250_r8*rxt(k,312)*y(k,88) + .250_r8*rxt(k,313)*y(k,90) & + + .250_r8*rxt(k,309)*y(k,128) + .100_r8*rxt(k,310)*y(k,129) + mat(k,157) = -(rxt(k,294)*y(k,137)) + mat(k,1106) = -rxt(k,294)*y(k,70) + mat(k,1247) = .330_r8*rxt(k,302)*y(k,133) + mat(k,1179) = rxt(k,307)*y(k,102) + .400_r8*rxt(k,303)*y(k,133) + mat(k,465) = rxt(k,307)*y(k,90) + rxt(k,308)*y(k,137) + mat(k,680) = .400_r8*rxt(k,299)*y(k,133) + mat(k,731) = .300_r8*rxt(k,300)*y(k,133) + mat(k,615) = .330_r8*rxt(k,302)*y(k,88) + .400_r8*rxt(k,303)*y(k,90) & + + .400_r8*rxt(k,299)*y(k,128) + .300_r8*rxt(k,300)*y(k,129) + mat(k,1106) = mat(k,1106) + rxt(k,308)*y(k,102) + mat(k,429) = -(rxt(k,295)*y(k,90) + rxt(k,304)*y(k,98) + rxt(k,305)*y(k,137)) + mat(k,1187) = -rxt(k,295)*y(k,71) + mat(k,983) = -rxt(k,304)*y(k,71) + mat(k,1140) = -rxt(k,305)*y(k,71) + mat(k,377) = -(rxt(k,296)*y(k,132) + rxt(k,297)*y(k,88) + rxt(k,298)*y(k,90)) + mat(k,917) = -rxt(k,296)*y(k,72) + mat(k,1255) = -rxt(k,297)*y(k,72) + mat(k,1184) = -rxt(k,298)*y(k,72) + mat(k,428) = rxt(k,295)*y(k,90) + mat(k,1184) = mat(k,1184) + rxt(k,295)*y(k,71) + mat(k,240) = -(rxt(k,306)*y(k,137)) + mat(k,1119) = -rxt(k,306)*y(k,73) + mat(k,906) = rxt(k,301)*y(k,133) + mat(k,616) = rxt(k,301)*y(k,132) + mat(k,560) = -(rxt(k,279)*y(k,98) + rxt(k,280)*y(k,137)) + mat(k,993) = -rxt(k,279)*y(k,74) + mat(k,1151) = -rxt(k,280)*y(k,74) + mat(k,433) = .300_r8*rxt(k,304)*y(k,98) + mat(k,379) = .167_r8*rxt(k,297)*y(k,88) + .167_r8*rxt(k,298)*y(k,90) & + + .167_r8*rxt(k,296)*y(k,132) + mat(k,1263) = .167_r8*rxt(k,297)*y(k,72) + .230_r8*rxt(k,302)*y(k,133) + mat(k,1195) = .167_r8*rxt(k,298)*y(k,72) + .250_r8*rxt(k,303)*y(k,133) + mat(k,993) = mat(k,993) + .300_r8*rxt(k,304)*y(k,71) + 1.122_r8*rxt(k,316) & + *y(k,122) + mat(k,310) = 1.122_r8*rxt(k,316)*y(k,98) + mat(k,689) = .250_r8*rxt(k,299)*y(k,133) + mat(k,745) = .190_r8*rxt(k,300)*y(k,133) + mat(k,928) = .167_r8*rxt(k,296)*y(k,72) + mat(k,623) = .230_r8*rxt(k,302)*y(k,88) + .250_r8*rxt(k,303)*y(k,90) & + + .250_r8*rxt(k,299)*y(k,128) + .190_r8*rxt(k,300)*y(k,129) + mat(k,142) = -(rxt(k,281)*y(k,137)) + mat(k,1104) = -rxt(k,281)*y(k,75) + mat(k,900) = rxt(k,275)*y(k,134) + mat(k,641) = rxt(k,275)*y(k,132) + mat(k,283) = -(rxt(k,288)*y(k,137)) + mat(k,1124) = -rxt(k,288)*y(k,76) + mat(k,1025) = rxt(k,291)*y(k,135) + mat(k,661) = rxt(k,291)*y(k,89) + mat(k,715) = -(rxt(k,289)*y(k,98) + rxt(k,290)*y(k,137)) + mat(k,1001) = -rxt(k,289)*y(k,77) + mat(k,1159) = -rxt(k,290)*y(k,77) + mat(k,436) = .200_r8*rxt(k,304)*y(k,98) + mat(k,380) = .039_r8*rxt(k,297)*y(k,88) + .039_r8*rxt(k,298)*y(k,90) & + + .039_r8*rxt(k,296)*y(k,132) + mat(k,1270) = .039_r8*rxt(k,297)*y(k,72) + .320_r8*rxt(k,302)*y(k,133) + mat(k,1203) = .039_r8*rxt(k,298)*y(k,72) + .350_r8*rxt(k,303)*y(k,133) + mat(k,1001) = mat(k,1001) + .200_r8*rxt(k,304)*y(k,71) + .442_r8*rxt(k,316) & + *y(k,122) + mat(k,312) = .442_r8*rxt(k,316)*y(k,98) + mat(k,696) = .350_r8*rxt(k,299)*y(k,133) + mat(k,752) = .260_r8*rxt(k,300)*y(k,133) + mat(k,935) = .039_r8*rxt(k,296)*y(k,72) + mat(k,630) = .320_r8*rxt(k,302)*y(k,88) + .350_r8*rxt(k,303)*y(k,90) & + + .350_r8*rxt(k,299)*y(k,128) + .260_r8*rxt(k,300)*y(k,129) + mat(k,213) = -(rxt(k,113)*y(k,88) + (rxt(k,114) + rxt(k,115) + rxt(k,116) & + ) * y(k,89) + rxt(k,125)*y(k,137)) + mat(k,1248) = -rxt(k,113)*y(k,78) + mat(k,1022) = -(rxt(k,114) + rxt(k,115) + rxt(k,116)) * y(k,78) + mat(k,1115) = -rxt(k,125)*y(k,78) + mat(k,97) = -((rxt(k,129) + rxt(k,130)) * y(k,136)) + mat(k,1066) = -(rxt(k,129) + rxt(k,130)) * y(k,79) + mat(k,212) = rxt(k,114)*y(k,89) + mat(k,1019) = rxt(k,114)*y(k,78) + end do + end subroutine nlnmat03 + subroutine nlnmat04( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,1020) = rxt(k,132)*y(k,90) + mat(k,1177) = rxt(k,132)*y(k,89) + mat(k,45) = -(rxt(k,335)*y(k,137)) + mat(k,1093) = -rxt(k,335)*y(k,84) + mat(k,1286) = -(rxt(k,113)*y(k,78) + rxt(k,122)*y(k,90) + rxt(k,126)*y(k,132) & + + rxt(k,127)*y(k,98) + rxt(k,128)*y(k,97) + rxt(k,149)*y(k,41) & + + rxt(k,181)*y(k,6) + rxt(k,217)*y(k,129) + rxt(k,230)*y(k,126) & + + rxt(k,240)*y(k,128) + rxt(k,244)*y(k,131) + rxt(k,257) & + *y(k,127) + rxt(k,265)*y(k,138) + rxt(k,269)*y(k,139) + (rxt(k,277) & + + rxt(k,278)) * y(k,134) + rxt(k,286)*y(k,135) + rxt(k,297) & + *y(k,72) + rxt(k,302)*y(k,133) + rxt(k,312)*y(k,140)) + mat(k,219) = -rxt(k,113)*y(k,88) + mat(k,1219) = -rxt(k,122)*y(k,88) + mat(k,951) = -rxt(k,126)*y(k,88) + mat(k,1017) = -rxt(k,127)*y(k,88) + mat(k,895) = -rxt(k,128)*y(k,88) + mat(k,1244) = -rxt(k,149)*y(k,88) + mat(k,973) = -rxt(k,181)*y(k,88) + mat(k,766) = -rxt(k,217)*y(k,88) + mat(k,376) = -rxt(k,230)*y(k,88) + mat(k,705) = -rxt(k,240)*y(k,88) + mat(k,334) = -rxt(k,244)*y(k,88) + mat(k,398) = -rxt(k,257)*y(k,88) + mat(k,349) = -rxt(k,265)*y(k,88) + mat(k,501) = -rxt(k,269)*y(k,88) + mat(k,659) = -(rxt(k,277) + rxt(k,278)) * y(k,88) + mat(k,678) = -rxt(k,286)*y(k,88) + mat(k,386) = -rxt(k,297)*y(k,88) + mat(k,639) = -rxt(k,302)*y(k,88) + mat(k,588) = -rxt(k,312)*y(k,88) + mat(k,219) = mat(k,219) + 2.000_r8*rxt(k,115)*y(k,89) + rxt(k,125)*y(k,137) + mat(k,99) = 2.000_r8*rxt(k,129)*y(k,136) + mat(k,1053) = 2.000_r8*rxt(k,115)*y(k,78) + rxt(k,118)*y(k,97) + rxt(k,328) & + *y(k,110) + mat(k,895) = mat(k,895) + rxt(k,118)*y(k,89) + mat(k,613) = rxt(k,328)*y(k,89) + mat(k,1090) = 2.000_r8*rxt(k,129)*y(k,79) + mat(k,1175) = rxt(k,125)*y(k,78) + mat(k,1048) = -((rxt(k,114) + rxt(k,115) + rxt(k,116)) * y(k,78) + (rxt(k,118) & + + rxt(k,120)) * y(k,97) + rxt(k,119)*y(k,98) + rxt(k,131) & + *y(k,132) + rxt(k,132)*y(k,90) + rxt(k,133)*y(k,137) + rxt(k,151) & + *y(k,41) + rxt(k,182)*y(k,6) + rxt(k,251)*y(k,128) + rxt(k,291) & + *y(k,135) + rxt(k,328)*y(k,110)) + mat(k,216) = -(rxt(k,114) + rxt(k,115) + rxt(k,116)) * y(k,89) + mat(k,890) = -(rxt(k,118) + rxt(k,120)) * y(k,89) + mat(k,1012) = -rxt(k,119)*y(k,89) + mat(k,946) = -rxt(k,131)*y(k,89) + mat(k,1214) = -rxt(k,132)*y(k,89) + mat(k,1170) = -rxt(k,133)*y(k,89) + mat(k,1239) = -rxt(k,151)*y(k,89) + mat(k,968) = -rxt(k,182)*y(k,89) + mat(k,702) = -rxt(k,251)*y(k,89) + mat(k,675) = -rxt(k,291)*y(k,89) + mat(k,610) = -rxt(k,328)*y(k,89) + mat(k,968) = mat(k,968) + rxt(k,181)*y(k,88) + mat(k,1239) = mat(k,1239) + rxt(k,149)*y(k,88) + mat(k,178) = rxt(k,112)*y(k,137) + mat(k,383) = 1.206_r8*rxt(k,297)*y(k,88) + 1.206_r8*rxt(k,298)*y(k,90) & + + .206_r8*rxt(k,296)*y(k,132) + mat(k,1281) = rxt(k,181)*y(k,6) + rxt(k,149)*y(k,41) + 1.206_r8*rxt(k,297) & + *y(k,72) + 2.000_r8*rxt(k,122)*y(k,90) + rxt(k,128)*y(k,97) & + + rxt(k,127)*y(k,98) + rxt(k,230)*y(k,126) + rxt(k,257)*y(k,127) & + + rxt(k,240)*y(k,128) + rxt(k,217)*y(k,129) + rxt(k,244) & + *y(k,131) + rxt(k,126)*y(k,132) + .920_r8*rxt(k,302)*y(k,133) & + + rxt(k,277)*y(k,134) + rxt(k,286)*y(k,135) + rxt(k,265) & + *y(k,138) + rxt(k,269)*y(k,139) + rxt(k,312)*y(k,140) + mat(k,1214) = mat(k,1214) + 1.206_r8*rxt(k,298)*y(k,72) + 2.000_r8*rxt(k,122) & + *y(k,88) + rxt(k,123)*y(k,97) + rxt(k,307)*y(k,102) + rxt(k,315) & + *y(k,122) + rxt(k,121)*y(k,132) + rxt(k,303)*y(k,133) & + + rxt(k,276)*y(k,134) + rxt(k,287)*y(k,135) + rxt(k,124) & + *y(k,137) + rxt(k,313)*y(k,140) + mat(k,198) = rxt(k,263)*y(k,137) + mat(k,890) = mat(k,890) + rxt(k,128)*y(k,88) + rxt(k,123)*y(k,90) + mat(k,1012) = mat(k,1012) + rxt(k,127)*y(k,88) + mat(k,472) = rxt(k,307)*y(k,90) + .400_r8*rxt(k,308)*y(k,137) + mat(k,315) = rxt(k,315)*y(k,90) + mat(k,374) = rxt(k,230)*y(k,88) + mat(k,396) = rxt(k,257)*y(k,88) + mat(k,702) = mat(k,702) + rxt(k,240)*y(k,88) + mat(k,761) = rxt(k,217)*y(k,88) + mat(k,332) = rxt(k,244)*y(k,88) + mat(k,946) = mat(k,946) + .206_r8*rxt(k,296)*y(k,72) + rxt(k,126)*y(k,88) & + + rxt(k,121)*y(k,90) + mat(k,636) = .920_r8*rxt(k,302)*y(k,88) + rxt(k,303)*y(k,90) + mat(k,656) = rxt(k,277)*y(k,88) + rxt(k,276)*y(k,90) + mat(k,675) = mat(k,675) + rxt(k,286)*y(k,88) + rxt(k,287)*y(k,90) + mat(k,1170) = mat(k,1170) + rxt(k,112)*y(k,66) + rxt(k,124)*y(k,90) & + + rxt(k,263)*y(k,91) + .400_r8*rxt(k,308)*y(k,102) + mat(k,347) = rxt(k,265)*y(k,88) + mat(k,499) = rxt(k,269)*y(k,88) + mat(k,585) = rxt(k,312)*y(k,88) + rxt(k,313)*y(k,90) + mat(k,1217) = -(rxt(k,121)*y(k,132) + rxt(k,122)*y(k,88) + rxt(k,123)*y(k,97) & + + rxt(k,124)*y(k,137) + rxt(k,132)*y(k,89) + rxt(k,211)*y(k,25) & + + rxt(k,235)*y(k,28) + rxt(k,253)*y(k,13) + rxt(k,260)*y(k,31) & + + rxt(k,276)*y(k,134) + rxt(k,287)*y(k,135) + rxt(k,295)*y(k,71) & + + rxt(k,298)*y(k,72) + rxt(k,303)*y(k,133) + rxt(k,307)*y(k,102) & + + rxt(k,313)*y(k,140) + rxt(k,315)*y(k,122) + rxt(k,318)*y(k,46)) + mat(k,949) = -rxt(k,121)*y(k,90) + mat(k,1284) = -rxt(k,122)*y(k,90) + mat(k,893) = -rxt(k,123)*y(k,90) + mat(k,1173) = -rxt(k,124)*y(k,90) + mat(k,1051) = -rxt(k,132)*y(k,90) + mat(k,794) = -rxt(k,211)*y(k,90) + mat(k,557) = -rxt(k,235)*y(k,90) + mat(k,545) = -rxt(k,253)*y(k,90) + mat(k,597) = -rxt(k,260)*y(k,90) + mat(k,658) = -rxt(k,276)*y(k,90) + mat(k,677) = -rxt(k,287)*y(k,90) + mat(k,443) = -rxt(k,295)*y(k,90) + mat(k,385) = -rxt(k,298)*y(k,90) + mat(k,638) = -rxt(k,303)*y(k,90) + mat(k,474) = -rxt(k,307)*y(k,90) + mat(k,587) = -rxt(k,313)*y(k,90) + mat(k,317) = -rxt(k,315)*y(k,90) + mat(k,141) = -rxt(k,318)*y(k,90) + mat(k,275) = rxt(k,183)*y(k,97) + mat(k,864) = rxt(k,150)*y(k,42) + mat(k,454) = rxt(k,150)*y(k,38) + rxt(k,152)*y(k,97) + rxt(k,153)*y(k,137) + mat(k,419) = rxt(k,134)*y(k,137) + mat(k,291) = .500_r8*rxt(k,288)*y(k,137) + mat(k,1051) = mat(k,1051) + rxt(k,120)*y(k,97) + rxt(k,119)*y(k,98) + mat(k,893) = mat(k,893) + rxt(k,183)*y(k,7) + rxt(k,152)*y(k,42) + rxt(k,120) & + *y(k,89) + mat(k,1015) = rxt(k,119)*y(k,89) + mat(k,259) = rxt(k,249)*y(k,137) + mat(k,1173) = mat(k,1173) + rxt(k,153)*y(k,42) + rxt(k,134)*y(k,65) & + + .500_r8*rxt(k,288)*y(k,76) + rxt(k,249)*y(k,103) + mat(k,194) = -(rxt(k,263)*y(k,137)) + mat(k,1112) = -rxt(k,263)*y(k,91) + mat(k,522) = rxt(k,253)*y(k,90) + mat(k,1180) = rxt(k,253)*y(k,13) + mat(k,886) = -(rxt(k,92)*y(k,98) + 4._r8*rxt(k,93)*y(k,97) + rxt(k,95) & + *y(k,55) + rxt(k,96)*y(k,57) + rxt(k,101)*y(k,132) + rxt(k,107) & + *y(k,137) + (rxt(k,118) + rxt(k,120)) * y(k,89) + rxt(k,123) & + *y(k,90) + rxt(k,128)*y(k,88) + rxt(k,152)*y(k,42) + rxt(k,154) & + *y(k,41) + rxt(k,157)*y(k,63) + rxt(k,160)*y(k,68) + rxt(k,183) & + *y(k,7) + rxt(k,184)*y(k,6) + rxt(k,186)*y(k,59) + rxt(k,188) & + *y(k,67) + rxt(k,212)*y(k,25) + rxt(k,320)*y(k,101)) + mat(k,1008) = -rxt(k,92)*y(k,97) + mat(k,518) = -rxt(k,95)*y(k,97) + mat(k,279) = -rxt(k,96)*y(k,97) + mat(k,942) = -rxt(k,101)*y(k,97) + mat(k,1166) = -rxt(k,107)*y(k,97) + mat(k,1044) = -(rxt(k,118) + rxt(k,120)) * y(k,97) + mat(k,1210) = -rxt(k,123)*y(k,97) + mat(k,1277) = -rxt(k,128)*y(k,97) + mat(k,451) = -rxt(k,152)*y(k,97) + mat(k,1235) = -rxt(k,154)*y(k,97) + mat(k,822) = -rxt(k,157)*y(k,97) + mat(k,404) = -rxt(k,160)*y(k,97) + mat(k,272) = -rxt(k,183)*y(k,97) + mat(k,964) = -rxt(k,184)*y(k,97) + mat(k,411) = -rxt(k,186)*y(k,97) + mat(k,356) = -rxt(k,188)*y(k,97) + mat(k,787) = -rxt(k,212)*y(k,97) + mat(k,166) = -rxt(k,320)*y(k,97) + mat(k,772) = rxt(k,99)*y(k,132) + mat(k,215) = rxt(k,113)*y(k,88) + rxt(k,114)*y(k,89) + mat(k,1277) = mat(k,1277) + rxt(k,113)*y(k,78) + mat(k,1044) = mat(k,1044) + rxt(k,114)*y(k,78) + mat(k,1008) = mat(k,1008) + .765_r8*rxt(k,316)*y(k,122) + 2.000_r8*rxt(k,91) & + *y(k,136) + mat(k,313) = .765_r8*rxt(k,316)*y(k,98) + mat(k,942) = mat(k,942) + rxt(k,99)*y(k,54) + mat(k,1081) = 2.000_r8*rxt(k,91)*y(k,98) + mat(k,1166) = mat(k,1166) + 2.000_r8*rxt(k,109)*y(k,137) + mat(k,1011) = -((rxt(k,90) + rxt(k,91)) * y(k,136) + rxt(k,92)*y(k,97) & + + rxt(k,102)*y(k,132) + rxt(k,103)*y(k,54) + rxt(k,108)*y(k,137) & + + rxt(k,119)*y(k,89) + rxt(k,127)*y(k,88) + rxt(k,143)*y(k,38) & + + rxt(k,175)*y(k,4) + rxt(k,226)*y(k,9) + rxt(k,254)*y(k,13) & + + rxt(k,279)*y(k,74) + rxt(k,289)*y(k,77) + rxt(k,304)*y(k,71) & + + rxt(k,316)*y(k,122) + rxt(k,324)*y(k,108) + rxt(k,330) & + *y(k,110)) + mat(k,1084) = -(rxt(k,90) + rxt(k,91)) * y(k,98) + mat(k,889) = -rxt(k,92)*y(k,98) + mat(k,945) = -rxt(k,102)*y(k,98) + mat(k,774) = -rxt(k,103)*y(k,98) + mat(k,1169) = -rxt(k,108)*y(k,98) + mat(k,1047) = -rxt(k,119)*y(k,98) + mat(k,1280) = -rxt(k,127)*y(k,98) + mat(k,860) = -rxt(k,143)*y(k,98) + mat(k,806) = -rxt(k,175)*y(k,98) + mat(k,225) = -rxt(k,226)*y(k,98) + mat(k,541) = -rxt(k,254)*y(k,98) + mat(k,568) = -rxt(k,279)*y(k,98) + mat(k,723) = -rxt(k,289)*y(k,98) + mat(k,440) = -rxt(k,304)*y(k,98) + mat(k,314) = -rxt(k,316)*y(k,98) + mat(k,238) = -rxt(k,324)*y(k,98) + mat(k,609) = -rxt(k,330)*y(k,98) + mat(k,701) = .150_r8*rxt(k,239)*y(k,132) + mat(k,945) = mat(k,945) + .150_r8*rxt(k,239)*y(k,128) + .150_r8*rxt(k,284) & + *y(k,135) + mat(k,674) = .150_r8*rxt(k,284)*y(k,132) + mat(k,152) = -(rxt(k,331)*y(k,110)) + mat(k,599) = -rxt(k,331)*y(k,100) + mat(k,954) = rxt(k,177)*y(k,41) + mat(k,1224) = rxt(k,177)*y(k,6) + 2.000_r8*rxt(k,147)*y(k,41) + mat(k,160) = -(rxt(k,320)*y(k,97) + rxt(k,321)*y(k,137)) + mat(k,868) = -rxt(k,320)*y(k,101) + mat(k,1107) = -rxt(k,321)*y(k,101) + mat(k,467) = -(rxt(k,307)*y(k,90) + rxt(k,308)*y(k,137)) + mat(k,1189) = -rxt(k,307)*y(k,102) + mat(k,1143) = -rxt(k,308)*y(k,102) + mat(k,378) = .794_r8*rxt(k,297)*y(k,88) + .794_r8*rxt(k,298)*y(k,90) & + + .794_r8*rxt(k,296)*y(k,132) + mat(k,1258) = .794_r8*rxt(k,297)*y(k,72) + .080_r8*rxt(k,302)*y(k,133) & + + .800_r8*rxt(k,278)*y(k,134) + mat(k,1189) = mat(k,1189) + .794_r8*rxt(k,298)*y(k,72) + mat(k,922) = .794_r8*rxt(k,296)*y(k,72) + mat(k,620) = .080_r8*rxt(k,302)*y(k,88) + mat(k,644) = .800_r8*rxt(k,278)*y(k,88) + end do + end subroutine nlnmat04 + subroutine nlnmat05( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,252) = -(rxt(k,249)*y(k,137)) + mat(k,1121) = -rxt(k,249)*y(k,103) + mat(k,1023) = rxt(k,251)*y(k,128) + mat(k,681) = rxt(k,251)*y(k,89) + mat(k,260) = -(rxt(k,266)*y(k,137)) + mat(k,1122) = -rxt(k,266)*y(k,106) + mat(k,907) = rxt(k,264)*y(k,138) + mat(k,341) = rxt(k,264)*y(k,132) + mat(k,206) = -(rxt(k,270)*y(k,137)) + mat(k,1114) = -rxt(k,270)*y(k,107) + mat(k,905) = .850_r8*rxt(k,268)*y(k,139) + mat(k,490) = .850_r8*rxt(k,268)*y(k,132) + mat(k,234) = -(rxt(k,324)*y(k,98) + rxt(k,327)*y(k,137)) + mat(k,976) = -rxt(k,324)*y(k,108) + mat(k,1118) = -rxt(k,327)*y(k,108) + mat(k,602) = -(rxt(k,325)*y(k,6) + rxt(k,326)*y(k,41) + rxt(k,328)*y(k,89) & + + rxt(k,330)*y(k,98) + rxt(k,331)*y(k,100) + rxt(k,332)*y(k,137)) + mat(k,959) = -rxt(k,325)*y(k,110) + mat(k,1228) = -rxt(k,326)*y(k,110) + mat(k,1034) = -rxt(k,328)*y(k,110) + mat(k,996) = -rxt(k,330)*y(k,110) + mat(k,154) = -rxt(k,331)*y(k,110) + mat(k,1154) = -rxt(k,332)*y(k,110) + mat(k,880) = rxt(k,320)*y(k,101) + mat(k,996) = mat(k,996) + rxt(k,324)*y(k,108) + mat(k,164) = rxt(k,320)*y(k,97) + mat(k,235) = rxt(k,324)*y(k,98) + rxt(k,327)*y(k,137) + mat(k,1154) = mat(k,1154) + rxt(k,327)*y(k,108) + mat(k,422) = -(rxt(k,323)*y(k,137)) + mat(k,1139) = -rxt(k,323)*y(k,111) + mat(k,958) = rxt(k,325)*y(k,110) + mat(k,1226) = rxt(k,326)*y(k,110) + mat(k,138) = rxt(k,318)*y(k,90) + (rxt(k,319)+.500_r8*rxt(k,333))*y(k,137) + mat(k,1029) = rxt(k,328)*y(k,110) + mat(k,1186) = rxt(k,318)*y(k,46) + mat(k,982) = rxt(k,330)*y(k,110) + mat(k,153) = rxt(k,331)*y(k,110) + mat(k,162) = rxt(k,321)*y(k,137) + mat(k,601) = rxt(k,325)*y(k,6) + rxt(k,326)*y(k,41) + rxt(k,328)*y(k,89) & + + rxt(k,330)*y(k,98) + rxt(k,331)*y(k,100) + rxt(k,332)*y(k,137) + mat(k,1139) = mat(k,1139) + (rxt(k,319)+.500_r8*rxt(k,333))*y(k,46) & + + rxt(k,321)*y(k,101) + rxt(k,332)*y(k,110) + mat(k,116) = -(rxt(k,334)*y(k,141)) + mat(k,1289) = -rxt(k,334)*y(k,112) + mat(k,421) = rxt(k,323)*y(k,137) + mat(k,1101) = rxt(k,323)*y(k,111) + mat(k,308) = -(rxt(k,315)*y(k,90) + rxt(k,316)*y(k,98) + rxt(k,317)*y(k,137)) + mat(k,1181) = -rxt(k,315)*y(k,122) + mat(k,977) = -rxt(k,316)*y(k,122) + mat(k,1127) = -rxt(k,317)*y(k,122) + mat(k,100) = -(rxt(k,314)*y(k,137)) + mat(k,1098) = -rxt(k,314)*y(k,123) + mat(k,898) = rxt(k,311)*y(k,140) + mat(k,571) = rxt(k,311)*y(k,132) + mat(k,369) = -(4._r8*rxt(k,227)*y(k,126) + rxt(k,228)*y(k,129) + rxt(k,229) & + *y(k,132) + rxt(k,230)*y(k,88)) + mat(k,738) = -rxt(k,228)*y(k,126) + mat(k,916) = -rxt(k,229)*y(k,126) + mat(k,1254) = -rxt(k,230)*y(k,126) + mat(k,148) = .500_r8*rxt(k,232)*y(k,137) + mat(k,131) = rxt(k,233)*y(k,38) + rxt(k,234)*y(k,137) + mat(k,841) = rxt(k,233)*y(k,12) + mat(k,1134) = .500_r8*rxt(k,232)*y(k,11) + rxt(k,234)*y(k,12) + mat(k,389) = -(rxt(k,255)*y(k,129) + rxt(k,256)*y(k,132) + rxt(k,257)*y(k,88)) + mat(k,739) = -rxt(k,255)*y(k,127) + mat(k,918) = -rxt(k,256)*y(k,127) + mat(k,1256) = -rxt(k,257)*y(k,127) + mat(k,40) = 1.670_r8*rxt(k,293)*y(k,137) + mat(k,190) = rxt(k,258)*y(k,137) + mat(k,70) = rxt(k,259)*y(k,137) + mat(k,1135) = 1.670_r8*rxt(k,293)*y(k,3) + rxt(k,258)*y(k,14) + rxt(k,259) & + *y(k,15) + mat(k,695) = -(4._r8*rxt(k,237)*y(k,128) + rxt(k,238)*y(k,129) + rxt(k,239) & + *y(k,132) + rxt(k,240)*y(k,88) + rxt(k,251)*y(k,89) + rxt(k,273) & + *y(k,134) + rxt(k,299)*y(k,133) + rxt(k,309)*y(k,140)) + mat(k,751) = -rxt(k,238)*y(k,128) + mat(k,934) = -rxt(k,239)*y(k,128) + mat(k,1269) = -rxt(k,240)*y(k,128) + mat(k,1036) = -rxt(k,251)*y(k,128) + mat(k,651) = -rxt(k,273)*y(k,128) + mat(k,629) = -rxt(k,299)*y(k,128) + mat(k,580) = -rxt(k,309)*y(k,128) + mat(k,551) = rxt(k,235)*y(k,90) + rxt(k,236)*y(k,137) + mat(k,592) = rxt(k,260)*y(k,90) + rxt(k,261)*y(k,137) + mat(k,303) = .500_r8*rxt(k,242)*y(k,137) + mat(k,435) = .080_r8*rxt(k,304)*y(k,98) + mat(k,564) = .100_r8*rxt(k,279)*y(k,98) + mat(k,714) = .280_r8*rxt(k,289)*y(k,98) + mat(k,1269) = mat(k,1269) + .530_r8*rxt(k,277)*y(k,134) + rxt(k,286)*y(k,135) & + + rxt(k,269)*y(k,139) + mat(k,1202) = rxt(k,235)*y(k,28) + rxt(k,260)*y(k,31) + .530_r8*rxt(k,276) & + *y(k,134) + rxt(k,287)*y(k,135) + mat(k,1000) = .080_r8*rxt(k,304)*y(k,71) + .100_r8*rxt(k,279)*y(k,74) & + + .280_r8*rxt(k,289)*y(k,77) + mat(k,695) = mat(k,695) + .530_r8*rxt(k,273)*y(k,134) + mat(k,751) = mat(k,751) + .260_r8*rxt(k,274)*y(k,134) + rxt(k,283)*y(k,135) & + + .300_r8*rxt(k,267)*y(k,139) + mat(k,934) = mat(k,934) + .450_r8*rxt(k,284)*y(k,135) + .150_r8*rxt(k,268) & + *y(k,139) + mat(k,651) = mat(k,651) + .530_r8*rxt(k,277)*y(k,88) + .530_r8*rxt(k,276) & + *y(k,90) + .530_r8*rxt(k,273)*y(k,128) + .260_r8*rxt(k,274) & + *y(k,129) + mat(k,669) = rxt(k,286)*y(k,88) + rxt(k,287)*y(k,90) + rxt(k,283)*y(k,129) & + + .450_r8*rxt(k,284)*y(k,132) + 4.000_r8*rxt(k,285)*y(k,135) + mat(k,1158) = rxt(k,236)*y(k,28) + rxt(k,261)*y(k,31) + .500_r8*rxt(k,242) & + *y(k,33) + mat(k,495) = rxt(k,269)*y(k,88) + .300_r8*rxt(k,267)*y(k,129) & + + .150_r8*rxt(k,268)*y(k,132) + mat(k,753) = -(rxt(k,144)*y(k,41) + (4._r8*rxt(k,214) + 4._r8*rxt(k,215) & + ) * y(k,129) + rxt(k,216)*y(k,132) + rxt(k,217)*y(k,88) & + + rxt(k,228)*y(k,126) + rxt(k,238)*y(k,128) + rxt(k,255) & + *y(k,127) + rxt(k,267)*y(k,139) + rxt(k,274)*y(k,134) + rxt(k,283) & + *y(k,135) + rxt(k,300)*y(k,133) + rxt(k,310)*y(k,140)) + mat(k,1229) = -rxt(k,144)*y(k,129) + mat(k,936) = -rxt(k,216)*y(k,129) + mat(k,1271) = -rxt(k,217)*y(k,129) + mat(k,371) = -rxt(k,228)*y(k,129) + mat(k,697) = -rxt(k,238)*y(k,129) + mat(k,393) = -rxt(k,255)*y(k,129) + mat(k,496) = -rxt(k,267)*y(k,129) + mat(k,652) = -rxt(k,274)*y(k,129) + mat(k,670) = -rxt(k,283)*y(k,129) + mat(k,631) = -rxt(k,300)*y(k,129) + mat(k,581) = -rxt(k,310)*y(k,129) + mat(k,534) = .280_r8*rxt(k,254)*y(k,98) + mat(k,320) = rxt(k,241)*y(k,137) + mat(k,201) = .700_r8*rxt(k,219)*y(k,137) + mat(k,480) = rxt(k,138)*y(k,38) + rxt(k,221)*y(k,136) + rxt(k,220)*y(k,137) + mat(k,851) = rxt(k,138)*y(k,36) + mat(k,437) = .050_r8*rxt(k,304)*y(k,98) + mat(k,1271) = mat(k,1271) + rxt(k,240)*y(k,128) + mat(k,1002) = .280_r8*rxt(k,254)*y(k,13) + .050_r8*rxt(k,304)*y(k,71) + mat(k,697) = mat(k,697) + rxt(k,240)*y(k,88) + 4.000_r8*rxt(k,237)*y(k,128) & + + .900_r8*rxt(k,238)*y(k,129) + .450_r8*rxt(k,239)*y(k,132) & + + rxt(k,299)*y(k,133) + rxt(k,273)*y(k,134) + rxt(k,282) & + *y(k,135) + rxt(k,309)*y(k,140) + mat(k,753) = mat(k,753) + .900_r8*rxt(k,238)*y(k,128) + mat(k,936) = mat(k,936) + .450_r8*rxt(k,239)*y(k,128) + mat(k,631) = mat(k,631) + rxt(k,299)*y(k,128) + mat(k,652) = mat(k,652) + rxt(k,273)*y(k,128) + mat(k,670) = mat(k,670) + rxt(k,282)*y(k,128) + mat(k,1075) = rxt(k,221)*y(k,36) + mat(k,1160) = rxt(k,241)*y(k,32) + .700_r8*rxt(k,219)*y(k,35) + rxt(k,220) & + *y(k,36) + mat(k,581) = mat(k,581) + rxt(k,309)*y(k,128) + mat(k,1246) = .750_r8*rxt(k,244)*y(k,131) + mat(k,327) = .750_r8*rxt(k,244)*y(k,88) + mat(k,328) = -(rxt(k,243)*y(k,132) + rxt(k,244)*y(k,88)) + mat(k,912) = -rxt(k,243)*y(k,131) + mat(k,1250) = -rxt(k,244)*y(k,131) + mat(k,221) = rxt(k,250)*y(k,137) + mat(k,1130) = rxt(k,250)*y(k,9) + mat(k,943) = -((rxt(k,97) + rxt(k,98) + rxt(k,99)) * y(k,54) + rxt(k,101) & + *y(k,97) + rxt(k,102)*y(k,98) + rxt(k,106)*y(k,137) & + + 4._r8*rxt(k,111)*y(k,132) + rxt(k,121)*y(k,90) + rxt(k,126) & + *y(k,88) + rxt(k,131)*y(k,89) + (rxt(k,141) + rxt(k,142) & + ) * y(k,38) + rxt(k,148)*y(k,41) + rxt(k,174)*y(k,4) + rxt(k,180) & + *y(k,6) + rxt(k,216)*y(k,129) + rxt(k,229)*y(k,126) + rxt(k,239) & + *y(k,128) + rxt(k,243)*y(k,131) + rxt(k,256)*y(k,127) + rxt(k,264) & + *y(k,138) + rxt(k,268)*y(k,139) + rxt(k,275)*y(k,134) + rxt(k,284) & + *y(k,135) + rxt(k,296)*y(k,72) + rxt(k,301)*y(k,133) + rxt(k,311) & + *y(k,140)) + mat(k,773) = -(rxt(k,97) + rxt(k,98) + rxt(k,99)) * y(k,132) + mat(k,887) = -rxt(k,101)*y(k,132) + mat(k,1009) = -rxt(k,102)*y(k,132) + mat(k,1167) = -rxt(k,106)*y(k,132) + mat(k,1211) = -rxt(k,121)*y(k,132) + mat(k,1278) = -rxt(k,126)*y(k,132) + mat(k,1045) = -rxt(k,131)*y(k,132) + mat(k,858) = -(rxt(k,141) + rxt(k,142)) * y(k,132) + mat(k,1236) = -rxt(k,148)*y(k,132) + mat(k,804) = -rxt(k,174)*y(k,132) + mat(k,965) = -rxt(k,180)*y(k,132) + mat(k,759) = -rxt(k,216)*y(k,132) + mat(k,373) = -rxt(k,229)*y(k,132) + mat(k,700) = -rxt(k,239)*y(k,132) + mat(k,331) = -rxt(k,243)*y(k,132) + mat(k,395) = -rxt(k,256)*y(k,132) + mat(k,346) = -rxt(k,264)*y(k,132) + mat(k,498) = -rxt(k,268)*y(k,132) + mat(k,655) = -rxt(k,275)*y(k,132) + mat(k,673) = -rxt(k,284)*y(k,132) + mat(k,382) = -rxt(k,296)*y(k,132) + mat(k,634) = -rxt(k,301)*y(k,132) + mat(k,584) = -rxt(k,311)*y(k,132) + mat(k,804) = mat(k,804) + rxt(k,173)*y(k,25) + mat(k,965) = mat(k,965) + rxt(k,185)*y(k,137) + mat(k,224) = .130_r8*rxt(k,226)*y(k,98) + mat(k,113) = rxt(k,231)*y(k,137) + mat(k,540) = .280_r8*rxt(k,254)*y(k,98) + mat(k,788) = rxt(k,173)*y(k,4) + rxt(k,137)*y(k,38) + rxt(k,211)*y(k,90) & + + rxt(k,212)*y(k,97) + mat(k,297) = rxt(k,196)*y(k,38) + rxt(k,197)*y(k,137) + mat(k,173) = rxt(k,199)*y(k,38) + rxt(k,200)*y(k,137) + mat(k,250) = rxt(k,218)*y(k,137) + mat(k,486) = rxt(k,222)*y(k,136) + mat(k,858) = mat(k,858) + rxt(k,137)*y(k,25) + rxt(k,196)*y(k,26) & + + rxt(k,199)*y(k,29) + rxt(k,140)*y(k,57) + mat(k,1236) = mat(k,1236) + rxt(k,144)*y(k,129) + rxt(k,155)*y(k,137) + mat(k,512) = rxt(k,224)*y(k,137) + mat(k,139) = .500_r8*rxt(k,333)*y(k,137) + mat(k,463) = rxt(k,247)*y(k,137) + mat(k,339) = rxt(k,248)*y(k,137) + mat(k,280) = rxt(k,140)*y(k,38) + rxt(k,96)*y(k,97) + rxt(k,105)*y(k,137) + mat(k,507) = rxt(k,262)*y(k,137) + mat(k,439) = .370_r8*rxt(k,304)*y(k,98) + mat(k,382) = mat(k,382) + .794_r8*rxt(k,297)*y(k,88) + .794_r8*rxt(k,298) & + *y(k,90) + mat(k,567) = .140_r8*rxt(k,279)*y(k,98) + mat(k,145) = .200_r8*rxt(k,281)*y(k,137) + mat(k,288) = .500_r8*rxt(k,288)*y(k,137) + mat(k,722) = .280_r8*rxt(k,289)*y(k,98) + mat(k,1278) = mat(k,1278) + .794_r8*rxt(k,297)*y(k,72) + rxt(k,230)*y(k,126) & + + rxt(k,257)*y(k,127) + rxt(k,217)*y(k,129) + .250_r8*rxt(k,244) & + *y(k,131) + .920_r8*rxt(k,302)*y(k,133) + .470_r8*rxt(k,277) & + *y(k,134) + rxt(k,265)*y(k,138) + rxt(k,312)*y(k,140) + mat(k,1211) = mat(k,1211) + rxt(k,211)*y(k,25) + .794_r8*rxt(k,298)*y(k,72) & + + rxt(k,307)*y(k,102) + rxt(k,303)*y(k,133) + .470_r8*rxt(k,276) & + *y(k,134) + rxt(k,124)*y(k,137) + rxt(k,313)*y(k,140) + mat(k,887) = mat(k,887) + rxt(k,212)*y(k,25) + rxt(k,96)*y(k,57) + mat(k,1009) = mat(k,1009) + .130_r8*rxt(k,226)*y(k,9) + .280_r8*rxt(k,254) & + *y(k,13) + .370_r8*rxt(k,304)*y(k,71) + .140_r8*rxt(k,279) & + *y(k,74) + .280_r8*rxt(k,289)*y(k,77) + rxt(k,108)*y(k,137) + mat(k,471) = rxt(k,307)*y(k,90) + rxt(k,308)*y(k,137) + mat(k,425) = rxt(k,323)*y(k,137) + mat(k,373) = mat(k,373) + rxt(k,230)*y(k,88) + 2.400_r8*rxt(k,227)*y(k,126) & + + rxt(k,228)*y(k,129) + mat(k,395) = mat(k,395) + rxt(k,257)*y(k,88) + rxt(k,255)*y(k,129) + mat(k,700) = mat(k,700) + .900_r8*rxt(k,238)*y(k,129) + rxt(k,299)*y(k,133) & + + .470_r8*rxt(k,273)*y(k,134) + rxt(k,309)*y(k,140) + mat(k,759) = mat(k,759) + rxt(k,144)*y(k,41) + rxt(k,217)*y(k,88) & + + rxt(k,228)*y(k,126) + rxt(k,255)*y(k,127) + .900_r8*rxt(k,238) & + *y(k,128) + 4.000_r8*rxt(k,214)*y(k,129) + rxt(k,300)*y(k,133) & + + .730_r8*rxt(k,274)*y(k,134) + rxt(k,283)*y(k,135) & + + .300_r8*rxt(k,267)*y(k,139) + .800_r8*rxt(k,310)*y(k,140) + mat(k,331) = mat(k,331) + .250_r8*rxt(k,244)*y(k,88) + mat(k,634) = mat(k,634) + .920_r8*rxt(k,302)*y(k,88) + rxt(k,303)*y(k,90) & + + rxt(k,299)*y(k,128) + rxt(k,300)*y(k,129) + mat(k,655) = mat(k,655) + .470_r8*rxt(k,277)*y(k,88) + .470_r8*rxt(k,276) & + *y(k,90) + .470_r8*rxt(k,273)*y(k,128) + .730_r8*rxt(k,274) & + *y(k,129) + mat(k,673) = mat(k,673) + rxt(k,283)*y(k,129) + mat(k,1082) = rxt(k,222)*y(k,36) + mat(k,1167) = mat(k,1167) + rxt(k,185)*y(k,6) + rxt(k,231)*y(k,10) & + + rxt(k,197)*y(k,26) + rxt(k,200)*y(k,29) + rxt(k,218)*y(k,34) & + + rxt(k,155)*y(k,41) + rxt(k,224)*y(k,44) + .500_r8*rxt(k,333) & + *y(k,46) + rxt(k,247)*y(k,52) + rxt(k,248)*y(k,53) + rxt(k,105) & + *y(k,57) + rxt(k,262)*y(k,69) + .200_r8*rxt(k,281)*y(k,75) & + + .500_r8*rxt(k,288)*y(k,76) + rxt(k,124)*y(k,90) + rxt(k,108) & + *y(k,98) + rxt(k,308)*y(k,102) + rxt(k,323)*y(k,111) + mat(k,346) = mat(k,346) + rxt(k,265)*y(k,88) + mat(k,498) = mat(k,498) + .300_r8*rxt(k,267)*y(k,129) + mat(k,584) = mat(k,584) + rxt(k,312)*y(k,88) + rxt(k,313)*y(k,90) & + + rxt(k,309)*y(k,128) + .800_r8*rxt(k,310)*y(k,129) + end do + end subroutine nlnmat05 + subroutine nlnmat06( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,626) = -(rxt(k,299)*y(k,128) + rxt(k,300)*y(k,129) + rxt(k,301) & + *y(k,132) + rxt(k,302)*y(k,88) + rxt(k,303)*y(k,90)) + mat(k,692) = -rxt(k,299)*y(k,133) + mat(k,748) = -rxt(k,300)*y(k,133) + mat(k,931) = -rxt(k,301)*y(k,133) + mat(k,1266) = -rxt(k,302)*y(k,133) + mat(k,1199) = -rxt(k,303)*y(k,133) + mat(k,434) = rxt(k,305)*y(k,137) + mat(k,243) = .200_r8*rxt(k,306)*y(k,137) + mat(k,1199) = mat(k,1199) + 1.700_r8*rxt(k,315)*y(k,122) + mat(k,311) = 1.700_r8*rxt(k,315)*y(k,90) + 1.640_r8*rxt(k,317)*y(k,137) + mat(k,1155) = rxt(k,305)*y(k,71) + .200_r8*rxt(k,306)*y(k,73) & + + 1.640_r8*rxt(k,317)*y(k,122) + mat(k,649) = -(rxt(k,273)*y(k,128) + rxt(k,274)*y(k,129) + rxt(k,275) & + *y(k,132) + rxt(k,276)*y(k,90) + (rxt(k,277) + rxt(k,278) & + ) * y(k,88)) + mat(k,693) = -rxt(k,273)*y(k,134) + mat(k,749) = -rxt(k,274)*y(k,134) + mat(k,932) = -rxt(k,275)*y(k,134) + mat(k,1200) = -rxt(k,276)*y(k,134) + mat(k,1267) = -(rxt(k,277) + rxt(k,278)) * y(k,134) + mat(k,562) = .500_r8*rxt(k,280)*y(k,137) + mat(k,143) = .200_r8*rxt(k,281)*y(k,137) + mat(k,712) = rxt(k,290)*y(k,137) + mat(k,1156) = .500_r8*rxt(k,280)*y(k,74) + .200_r8*rxt(k,281)*y(k,75) & + + rxt(k,290)*y(k,77) + mat(k,668) = -(rxt(k,282)*y(k,128) + rxt(k,283)*y(k,129) + rxt(k,284) & + *y(k,132) + 4._r8*rxt(k,285)*y(k,135) + rxt(k,286)*y(k,88) & + + rxt(k,287)*y(k,90) + rxt(k,291)*y(k,89)) + mat(k,694) = -rxt(k,282)*y(k,135) + mat(k,750) = -rxt(k,283)*y(k,135) + mat(k,933) = -rxt(k,284)*y(k,135) + mat(k,1268) = -rxt(k,286)*y(k,135) + mat(k,1201) = -rxt(k,287)*y(k,135) + mat(k,1035) = -rxt(k,291)*y(k,135) + mat(k,563) = .500_r8*rxt(k,280)*y(k,137) + mat(k,144) = .500_r8*rxt(k,281)*y(k,137) + mat(k,1157) = .500_r8*rxt(k,280)*y(k,74) + .500_r8*rxt(k,281)*y(k,75) + mat(k,1086) = -(rxt(k,86)*y(k,55) + rxt(k,87)*y(k,141) + (rxt(k,90) + rxt(k,91) & + ) * y(k,98) + (rxt(k,129) + rxt(k,130)) * y(k,79) + rxt(k,162) & + *y(k,16) + rxt(k,163)*y(k,17) + rxt(k,164)*y(k,19) + rxt(k,165) & + *y(k,20) + rxt(k,166)*y(k,21) + rxt(k,167)*y(k,22) + rxt(k,168) & + *y(k,23) + (rxt(k,169) + rxt(k,170)) * y(k,63) + rxt(k,189) & + *y(k,18) + rxt(k,190)*y(k,37) + rxt(k,191)*y(k,56) + (rxt(k,192) & + + rxt(k,193)) * y(k,59) + rxt(k,206)*y(k,24) + rxt(k,207) & + *y(k,26) + rxt(k,208)*y(k,60) + rxt(k,209)*y(k,61) + rxt(k,210) & + *y(k,62) + (rxt(k,221) + rxt(k,222) + rxt(k,223)) * y(k,36)) + mat(k,519) = -rxt(k,86)*y(k,136) + mat(k,1302) = -rxt(k,87)*y(k,136) + mat(k,1013) = -(rxt(k,90) + rxt(k,91)) * y(k,136) + mat(k,98) = -(rxt(k,129) + rxt(k,130)) * y(k,136) + mat(k,50) = -rxt(k,162)*y(k,136) + mat(k,76) = -rxt(k,163)*y(k,136) + mat(k,56) = -rxt(k,164)*y(k,136) + mat(k,59) = -rxt(k,165)*y(k,136) + mat(k,62) = -rxt(k,166)*y(k,136) + mat(k,65) = -rxt(k,167)*y(k,136) + mat(k,68) = -rxt(k,168)*y(k,136) + mat(k,827) = -(rxt(k,169) + rxt(k,170)) * y(k,136) + mat(k,53) = -rxt(k,189)*y(k,136) + mat(k,186) = -rxt(k,190)*y(k,136) + mat(k,44) = -rxt(k,191)*y(k,136) + mat(k,413) = -(rxt(k,192) + rxt(k,193)) * y(k,136) + mat(k,231) = -rxt(k,206)*y(k,136) + mat(k,298) = -rxt(k,207)*y(k,136) + mat(k,91) = -rxt(k,208)*y(k,136) + mat(k,95) = -rxt(k,209)*y(k,136) + mat(k,105) = -rxt(k,210)*y(k,136) + mat(k,487) = -(rxt(k,221) + rxt(k,222) + rxt(k,223)) * y(k,136) + mat(k,1172) = -(rxt(k,104)*y(k,55) + rxt(k,105)*y(k,57) + rxt(k,106)*y(k,132) & + + rxt(k,107)*y(k,97) + rxt(k,108)*y(k,98) + (4._r8*rxt(k,109) & + + 4._r8*rxt(k,110)) * y(k,137) + rxt(k,112)*y(k,66) + rxt(k,124) & + *y(k,90) + rxt(k,125)*y(k,78) + rxt(k,133)*y(k,89) + rxt(k,134) & + *y(k,65) + rxt(k,153)*y(k,42) + (rxt(k,155) + rxt(k,156) & + ) * y(k,41) + rxt(k,158)*y(k,63) + rxt(k,161)*y(k,68) + rxt(k,185) & + *y(k,6) + rxt(k,187)*y(k,59) + rxt(k,195)*y(k,24) + rxt(k,197) & + *y(k,26) + rxt(k,198)*y(k,27) + rxt(k,200)*y(k,29) + rxt(k,202) & + *y(k,37) + rxt(k,203)*y(k,60) + rxt(k,204)*y(k,61) + rxt(k,205) & + *y(k,62) + rxt(k,213)*y(k,25) + rxt(k,218)*y(k,34) + rxt(k,219) & + *y(k,35) + rxt(k,220)*y(k,36) + rxt(k,224)*y(k,44) + rxt(k,231) & + *y(k,10) + rxt(k,232)*y(k,11) + rxt(k,234)*y(k,12) + rxt(k,236) & + *y(k,28) + rxt(k,241)*y(k,32) + rxt(k,242)*y(k,33) + rxt(k,247) & + *y(k,52) + rxt(k,248)*y(k,53) + rxt(k,249)*y(k,103) + rxt(k,250) & + *y(k,9) + rxt(k,258)*y(k,14) + rxt(k,259)*y(k,15) + rxt(k,261) & + *y(k,31) + rxt(k,262)*y(k,69) + rxt(k,263)*y(k,91) + rxt(k,266) & + *y(k,106) + rxt(k,270)*y(k,107) + rxt(k,271)*y(k,13) + rxt(k,272) & + *y(k,30) + rxt(k,280)*y(k,74) + rxt(k,281)*y(k,75) + rxt(k,288) & + *y(k,76) + rxt(k,290)*y(k,77) + rxt(k,293)*y(k,3) + rxt(k,294) & + *y(k,70) + rxt(k,305)*y(k,71) + rxt(k,306)*y(k,73) + rxt(k,308) & + *y(k,102) + rxt(k,314)*y(k,123) + rxt(k,317)*y(k,122) + (rxt(k,319) & + + rxt(k,333)) * y(k,46) + rxt(k,321)*y(k,101) + rxt(k,323) & + *y(k,111) + rxt(k,327)*y(k,108) + rxt(k,332)*y(k,110) + rxt(k,335) & + *y(k,84)) + mat(k,520) = -rxt(k,104)*y(k,137) + mat(k,281) = -rxt(k,105)*y(k,137) + mat(k,948) = -rxt(k,106)*y(k,137) + mat(k,892) = -rxt(k,107)*y(k,137) + mat(k,1014) = -rxt(k,108)*y(k,137) + mat(k,179) = -rxt(k,112)*y(k,137) + mat(k,1216) = -rxt(k,124)*y(k,137) + mat(k,218) = -rxt(k,125)*y(k,137) + mat(k,1050) = -rxt(k,133)*y(k,137) + mat(k,418) = -rxt(k,134)*y(k,137) + mat(k,453) = -rxt(k,153)*y(k,137) + mat(k,1241) = -(rxt(k,155) + rxt(k,156)) * y(k,137) + mat(k,828) = -rxt(k,158)*y(k,137) + mat(k,405) = -rxt(k,161)*y(k,137) + mat(k,970) = -rxt(k,185)*y(k,137) + mat(k,414) = -rxt(k,187)*y(k,137) + mat(k,232) = -rxt(k,195)*y(k,137) + mat(k,299) = -rxt(k,197)*y(k,137) + mat(k,79) = -rxt(k,198)*y(k,137) + mat(k,174) = -rxt(k,200)*y(k,137) + mat(k,187) = -rxt(k,202)*y(k,137) + mat(k,92) = -rxt(k,203)*y(k,137) + mat(k,96) = -rxt(k,204)*y(k,137) + mat(k,106) = -rxt(k,205)*y(k,137) + mat(k,793) = -rxt(k,213)*y(k,137) + mat(k,251) = -rxt(k,218)*y(k,137) + mat(k,204) = -rxt(k,219)*y(k,137) + mat(k,488) = -rxt(k,220)*y(k,137) + mat(k,513) = -rxt(k,224)*y(k,137) + mat(k,114) = -rxt(k,231)*y(k,137) + mat(k,151) = -rxt(k,232)*y(k,137) + mat(k,134) = -rxt(k,234)*y(k,137) + mat(k,556) = -rxt(k,236)*y(k,137) + mat(k,321) = -rxt(k,241)*y(k,137) + mat(k,306) = -rxt(k,242)*y(k,137) + mat(k,464) = -rxt(k,247)*y(k,137) + mat(k,340) = -rxt(k,248)*y(k,137) + mat(k,258) = -rxt(k,249)*y(k,137) + mat(k,226) = -rxt(k,250)*y(k,137) + mat(k,192) = -rxt(k,258)*y(k,137) + mat(k,71) = -rxt(k,259)*y(k,137) + mat(k,596) = -rxt(k,261)*y(k,137) + mat(k,508) = -rxt(k,262)*y(k,137) + mat(k,199) = -rxt(k,263)*y(k,137) + mat(k,266) = -rxt(k,266)*y(k,137) + mat(k,210) = -rxt(k,270)*y(k,137) + mat(k,544) = -rxt(k,271)*y(k,137) + mat(k,364) = -rxt(k,272)*y(k,137) + mat(k,569) = -rxt(k,280)*y(k,137) + mat(k,146) = -rxt(k,281)*y(k,137) + mat(k,290) = -rxt(k,288)*y(k,137) + mat(k,726) = -rxt(k,290)*y(k,137) + mat(k,41) = -rxt(k,293)*y(k,137) + mat(k,159) = -rxt(k,294)*y(k,137) + mat(k,442) = -rxt(k,305)*y(k,137) + mat(k,247) = -rxt(k,306)*y(k,137) + mat(k,473) = -rxt(k,308)*y(k,137) + mat(k,102) = -rxt(k,314)*y(k,137) + mat(k,316) = -rxt(k,317)*y(k,137) + mat(k,140) = -(rxt(k,319) + rxt(k,333)) * y(k,137) + mat(k,167) = -rxt(k,321)*y(k,137) + mat(k,426) = -rxt(k,323)*y(k,137) + mat(k,239) = -rxt(k,327)*y(k,137) + mat(k,611) = -rxt(k,332)*y(k,137) + mat(k,46) = -rxt(k,335)*y(k,137) + mat(k,226) = mat(k,226) + .130_r8*rxt(k,226)*y(k,98) + mat(k,151) = mat(k,151) + .500_r8*rxt(k,232)*y(k,137) + mat(k,544) = mat(k,544) + .360_r8*rxt(k,254)*y(k,98) + mat(k,793) = mat(k,793) + rxt(k,212)*y(k,97) + mat(k,204) = mat(k,204) + .300_r8*rxt(k,219)*y(k,137) + mat(k,488) = mat(k,488) + rxt(k,221)*y(k,136) + mat(k,863) = rxt(k,142)*y(k,132) + mat(k,776) = rxt(k,103)*y(k,98) + 2.000_r8*rxt(k,98)*y(k,132) + mat(k,520) = mat(k,520) + rxt(k,95)*y(k,97) + rxt(k,86)*y(k,136) + mat(k,281) = mat(k,281) + rxt(k,96)*y(k,97) + mat(k,414) = mat(k,414) + rxt(k,186)*y(k,97) + rxt(k,192)*y(k,136) + mat(k,828) = mat(k,828) + rxt(k,157)*y(k,97) + rxt(k,169)*y(k,136) + mat(k,358) = rxt(k,188)*y(k,97) + mat(k,405) = mat(k,405) + rxt(k,160)*y(k,97) + mat(k,442) = mat(k,442) + .320_r8*rxt(k,304)*y(k,98) + mat(k,384) = .206_r8*rxt(k,296)*y(k,132) + mat(k,569) = mat(k,569) + .240_r8*rxt(k,279)*y(k,98) + mat(k,146) = mat(k,146) + .100_r8*rxt(k,281)*y(k,137) + mat(k,726) = mat(k,726) + .360_r8*rxt(k,289)*y(k,98) + mat(k,1283) = rxt(k,126)*y(k,132) + mat(k,1216) = mat(k,1216) + rxt(k,121)*y(k,132) + mat(k,892) = mat(k,892) + rxt(k,212)*y(k,25) + rxt(k,95)*y(k,55) + rxt(k,96) & + *y(k,57) + rxt(k,186)*y(k,59) + rxt(k,157)*y(k,63) + rxt(k,188) & + *y(k,67) + rxt(k,160)*y(k,68) + rxt(k,101)*y(k,132) + mat(k,1014) = mat(k,1014) + .130_r8*rxt(k,226)*y(k,9) + .360_r8*rxt(k,254) & + *y(k,13) + rxt(k,103)*y(k,54) + .320_r8*rxt(k,304)*y(k,71) & + + .240_r8*rxt(k,279)*y(k,74) + .360_r8*rxt(k,289)*y(k,77) & + + 1.156_r8*rxt(k,316)*y(k,122) + rxt(k,102)*y(k,132) + mat(k,266) = mat(k,266) + .500_r8*rxt(k,266)*y(k,137) + mat(k,316) = mat(k,316) + 1.156_r8*rxt(k,316)*y(k,98) + mat(k,102) = mat(k,102) + .500_r8*rxt(k,314)*y(k,137) + mat(k,703) = .450_r8*rxt(k,239)*y(k,132) + mat(k,948) = mat(k,948) + rxt(k,142)*y(k,38) + 2.000_r8*rxt(k,98)*y(k,54) & + + .206_r8*rxt(k,296)*y(k,72) + rxt(k,126)*y(k,88) + rxt(k,121) & + *y(k,90) + rxt(k,101)*y(k,97) + rxt(k,102)*y(k,98) & + + .450_r8*rxt(k,239)*y(k,128) + .450_r8*rxt(k,284)*y(k,135) & + + .150_r8*rxt(k,268)*y(k,139) + mat(k,676) = .450_r8*rxt(k,284)*y(k,132) + mat(k,1087) = rxt(k,221)*y(k,36) + rxt(k,86)*y(k,55) + rxt(k,192)*y(k,59) & + + rxt(k,169)*y(k,63) + 2.000_r8*rxt(k,87)*y(k,141) + mat(k,1172) = mat(k,1172) + .500_r8*rxt(k,232)*y(k,11) + .300_r8*rxt(k,219) & + *y(k,35) + .100_r8*rxt(k,281)*y(k,75) + .500_r8*rxt(k,266) & + *y(k,106) + .500_r8*rxt(k,314)*y(k,123) + mat(k,500) = .150_r8*rxt(k,268)*y(k,132) + mat(k,1303) = 2.000_r8*rxt(k,87)*y(k,136) + end do + end subroutine nlnmat06 + subroutine nlnmat07( avec_len, mat, y, rxt ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k,342) = -(rxt(k,264)*y(k,132) + rxt(k,265)*y(k,88)) + mat(k,913) = -rxt(k,264)*y(k,138) + mat(k,1252) = -rxt(k,265)*y(k,138) + mat(k,525) = rxt(k,271)*y(k,137) + mat(k,261) = .500_r8*rxt(k,266)*y(k,137) + mat(k,1132) = rxt(k,271)*y(k,13) + .500_r8*rxt(k,266)*y(k,106) + mat(k,492) = -(rxt(k,267)*y(k,129) + rxt(k,268)*y(k,132) + rxt(k,269)*y(k,88)) + mat(k,741) = -rxt(k,267)*y(k,139) + mat(k,923) = -rxt(k,268)*y(k,139) + mat(k,1259) = -rxt(k,269)*y(k,139) + mat(k,361) = rxt(k,272)*y(k,137) + mat(k,207) = rxt(k,270)*y(k,137) + mat(k,1145) = rxt(k,272)*y(k,30) + rxt(k,270)*y(k,107) + mat(k,578) = -(rxt(k,309)*y(k,128) + rxt(k,310)*y(k,129) + rxt(k,311) & + *y(k,132) + rxt(k,312)*y(k,88) + rxt(k,313)*y(k,90)) + mat(k,690) = -rxt(k,309)*y(k,140) + mat(k,746) = -rxt(k,310)*y(k,140) + mat(k,929) = -rxt(k,311)*y(k,140) + mat(k,1264) = -rxt(k,312)*y(k,140) + mat(k,1196) = -rxt(k,313)*y(k,140) + mat(k,158) = rxt(k,294)*y(k,137) + mat(k,242) = .800_r8*rxt(k,306)*y(k,137) + mat(k,101) = .500_r8*rxt(k,314)*y(k,137) + mat(k,1152) = rxt(k,294)*y(k,70) + .800_r8*rxt(k,306)*y(k,73) & + + .500_r8*rxt(k,314)*y(k,123) + mat(k,1307) = -(rxt(k,87)*y(k,136) + rxt(k,334)*y(k,112)) + mat(k,1091) = -rxt(k,87)*y(k,141) + mat(k,119) = -rxt(k,334)*y(k,141) + mat(k,135) = rxt(k,234)*y(k,137) + mat(k,193) = rxt(k,258)*y(k,137) + mat(k,72) = rxt(k,259)*y(k,137) + mat(k,233) = rxt(k,195)*y(k,137) + mat(k,795) = rxt(k,213)*y(k,137) + mat(k,300) = rxt(k,197)*y(k,137) + mat(k,80) = rxt(k,198)*y(k,137) + mat(k,558) = rxt(k,236)*y(k,137) + mat(k,175) = rxt(k,200)*y(k,137) + mat(k,365) = rxt(k,272)*y(k,137) + mat(k,598) = rxt(k,261)*y(k,137) + mat(k,322) = rxt(k,241)*y(k,137) + mat(k,307) = rxt(k,242)*y(k,137) + mat(k,205) = rxt(k,219)*y(k,137) + mat(k,489) = rxt(k,220)*y(k,137) + mat(k,777) = rxt(k,99)*y(k,132) + mat(k,521) = rxt(k,104)*y(k,137) + mat(k,282) = rxt(k,105)*y(k,137) + mat(k,415) = rxt(k,187)*y(k,137) + mat(k,107) = rxt(k,205)*y(k,137) + mat(k,831) = (rxt(k,351)+rxt(k,356))*y(k,67) + (rxt(k,344)+rxt(k,350) & + +rxt(k,355))*y(k,68) + rxt(k,158)*y(k,137) + mat(k,420) = rxt(k,134)*y(k,137) + mat(k,181) = rxt(k,112)*y(k,137) + mat(k,359) = (rxt(k,351)+rxt(k,356))*y(k,63) + mat(k,407) = (rxt(k,344)+rxt(k,350)+rxt(k,355))*y(k,63) + rxt(k,161)*y(k,137) + mat(k,570) = .500_r8*rxt(k,280)*y(k,137) + mat(k,47) = rxt(k,335)*y(k,137) + mat(k,267) = rxt(k,266)*y(k,137) + mat(k,211) = rxt(k,270)*y(k,137) + mat(k,952) = rxt(k,99)*y(k,54) + rxt(k,106)*y(k,137) + mat(k,1176) = rxt(k,234)*y(k,12) + rxt(k,258)*y(k,14) + rxt(k,259)*y(k,15) & + + rxt(k,195)*y(k,24) + rxt(k,213)*y(k,25) + rxt(k,197)*y(k,26) & + + rxt(k,198)*y(k,27) + rxt(k,236)*y(k,28) + rxt(k,200)*y(k,29) & + + rxt(k,272)*y(k,30) + rxt(k,261)*y(k,31) + rxt(k,241)*y(k,32) & + + rxt(k,242)*y(k,33) + rxt(k,219)*y(k,35) + rxt(k,220)*y(k,36) & + + rxt(k,104)*y(k,55) + rxt(k,105)*y(k,57) + rxt(k,187)*y(k,59) & + + rxt(k,205)*y(k,62) + rxt(k,158)*y(k,63) + rxt(k,134)*y(k,65) & + + rxt(k,112)*y(k,66) + rxt(k,161)*y(k,68) + .500_r8*rxt(k,280) & + *y(k,74) + rxt(k,335)*y(k,84) + rxt(k,266)*y(k,106) + rxt(k,270) & + *y(k,107) + rxt(k,106)*y(k,132) + 2.000_r8*rxt(k,109)*y(k,137) + end do + end subroutine nlnmat07 + subroutine nlnmat_finit( avec_len, mat, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: dti(veclen) + real(r8), intent(in) :: lmat(veclen,nzcnt) + real(r8), intent(inout) :: mat(veclen,nzcnt) +!---------------------------------------------- +! ... local variables +!---------------------------------------------- + integer :: k +!---------------------------------------------- +! ... complete matrix entries implicit species +!---------------------------------------------- + do k = 1,avec_len + mat(k, 1) = lmat(k, 1) + mat(k, 2) = lmat(k, 2) + mat(k, 3) = lmat(k, 3) + mat(k, 4) = lmat(k, 4) + mat(k, 5) = lmat(k, 5) + mat(k, 6) = lmat(k, 6) + mat(k, 7) = lmat(k, 7) + mat(k, 8) = lmat(k, 8) + mat(k, 9) = lmat(k, 9) + mat(k, 10) = lmat(k, 10) + mat(k, 11) = lmat(k, 11) + mat(k, 12) = lmat(k, 12) + mat(k, 13) = lmat(k, 13) + mat(k, 14) = lmat(k, 14) + mat(k, 15) = lmat(k, 15) + mat(k, 16) = lmat(k, 16) + mat(k, 17) = lmat(k, 17) + mat(k, 18) = lmat(k, 18) + mat(k, 19) = lmat(k, 19) + mat(k, 20) = lmat(k, 20) + mat(k, 21) = lmat(k, 21) + mat(k, 22) = lmat(k, 22) + mat(k, 23) = lmat(k, 23) + mat(k, 24) = lmat(k, 24) + mat(k, 25) = lmat(k, 25) + mat(k, 26) = lmat(k, 26) + mat(k, 27) = lmat(k, 27) + mat(k, 28) = lmat(k, 28) + mat(k, 29) = lmat(k, 29) + mat(k, 30) = lmat(k, 30) + mat(k, 31) = lmat(k, 31) + mat(k, 32) = lmat(k, 32) + mat(k, 33) = lmat(k, 33) + mat(k, 34) = lmat(k, 34) + mat(k, 35) = lmat(k, 35) + mat(k, 36) = lmat(k, 36) + mat(k, 37) = lmat(k, 37) + mat(k, 38) = lmat(k, 38) + mat(k, 39) = mat(k, 39) + lmat(k, 39) + mat(k, 42) = mat(k, 42) + lmat(k, 42) + mat(k, 43) = mat(k, 43) + lmat(k, 43) + mat(k, 45) = mat(k, 45) + lmat(k, 45) + mat(k, 48) = mat(k, 48) + lmat(k, 48) + mat(k, 49) = mat(k, 49) + lmat(k, 49) + mat(k, 51) = mat(k, 51) + lmat(k, 51) + mat(k, 52) = mat(k, 52) + lmat(k, 52) + mat(k, 54) = mat(k, 54) + lmat(k, 54) + mat(k, 55) = mat(k, 55) + lmat(k, 55) + mat(k, 57) = mat(k, 57) + lmat(k, 57) + mat(k, 58) = mat(k, 58) + lmat(k, 58) + mat(k, 60) = mat(k, 60) + lmat(k, 60) + mat(k, 61) = mat(k, 61) + lmat(k, 61) + mat(k, 63) = mat(k, 63) + lmat(k, 63) + mat(k, 64) = mat(k, 64) + lmat(k, 64) + mat(k, 66) = mat(k, 66) + lmat(k, 66) + mat(k, 67) = mat(k, 67) + lmat(k, 67) + mat(k, 69) = mat(k, 69) + lmat(k, 69) + mat(k, 73) = mat(k, 73) + lmat(k, 73) + mat(k, 74) = mat(k, 74) + lmat(k, 74) + mat(k, 75) = mat(k, 75) + lmat(k, 75) + mat(k, 77) = mat(k, 77) + lmat(k, 77) + mat(k, 78) = mat(k, 78) + lmat(k, 78) + mat(k, 81) = lmat(k, 81) + mat(k, 82) = lmat(k, 82) + mat(k, 83) = lmat(k, 83) + mat(k, 84) = lmat(k, 84) + mat(k, 85) = lmat(k, 85) + mat(k, 86) = lmat(k, 86) + mat(k, 87) = lmat(k, 87) + mat(k, 88) = lmat(k, 88) + mat(k, 89) = mat(k, 89) + lmat(k, 89) + mat(k, 90) = mat(k, 90) + lmat(k, 90) + mat(k, 93) = mat(k, 93) + lmat(k, 93) + mat(k, 94) = mat(k, 94) + lmat(k, 94) + mat(k, 97) = mat(k, 97) + lmat(k, 97) + mat(k, 98) = mat(k, 98) + lmat(k, 98) + mat(k, 100) = mat(k, 100) + lmat(k, 100) + mat(k, 102) = mat(k, 102) + lmat(k, 102) + mat(k, 103) = mat(k, 103) + lmat(k, 103) + mat(k, 104) = mat(k, 104) + lmat(k, 104) + mat(k, 108) = lmat(k, 108) + mat(k, 109) = lmat(k, 109) + mat(k, 110) = lmat(k, 110) + mat(k, 111) = mat(k, 111) + lmat(k, 111) + mat(k, 116) = mat(k, 116) + lmat(k, 116) + mat(k, 117) = lmat(k, 117) + mat(k, 118) = lmat(k, 118) + mat(k, 120) = lmat(k, 120) + mat(k, 121) = lmat(k, 121) + mat(k, 122) = lmat(k, 122) + mat(k, 123) = lmat(k, 123) + mat(k, 124) = lmat(k, 124) + mat(k, 125) = lmat(k, 125) + mat(k, 126) = lmat(k, 126) + mat(k, 127) = lmat(k, 127) + mat(k, 128) = lmat(k, 128) + mat(k, 129) = lmat(k, 129) + mat(k, 130) = mat(k, 130) + lmat(k, 130) + mat(k, 136) = mat(k, 136) + lmat(k, 136) + mat(k, 142) = mat(k, 142) + lmat(k, 142) + mat(k, 147) = mat(k, 147) + lmat(k, 147) + mat(k, 149) = mat(k, 149) + lmat(k, 149) + mat(k, 150) = lmat(k, 150) + mat(k, 151) = mat(k, 151) + lmat(k, 151) + mat(k, 152) = mat(k, 152) + lmat(k, 152) + mat(k, 155) = lmat(k, 155) + mat(k, 156) = mat(k, 156) + lmat(k, 156) + mat(k, 157) = mat(k, 157) + lmat(k, 157) + mat(k, 160) = mat(k, 160) + lmat(k, 160) + mat(k, 161) = lmat(k, 161) + mat(k, 163) = mat(k, 163) + lmat(k, 163) + mat(k, 168) = mat(k, 168) + lmat(k, 168) + mat(k, 170) = lmat(k, 170) + mat(k, 172) = mat(k, 172) + lmat(k, 172) + mat(k, 176) = mat(k, 176) + lmat(k, 176) + mat(k, 177) = lmat(k, 177) + mat(k, 178) = mat(k, 178) + lmat(k, 178) + mat(k, 179) = mat(k, 179) + lmat(k, 179) + mat(k, 180) = lmat(k, 180) + mat(k, 182) = mat(k, 182) + lmat(k, 182) + mat(k, 183) = mat(k, 183) + lmat(k, 183) + mat(k, 188) = mat(k, 188) + lmat(k, 188) + mat(k, 189) = lmat(k, 189) + mat(k, 191) = lmat(k, 191) + mat(k, 192) = mat(k, 192) + lmat(k, 192) + mat(k, 194) = mat(k, 194) + lmat(k, 194) + mat(k, 196) = lmat(k, 196) + mat(k, 197) = lmat(k, 197) + mat(k, 198) = mat(k, 198) + lmat(k, 198) + mat(k, 200) = mat(k, 200) + lmat(k, 200) + mat(k, 202) = lmat(k, 202) + mat(k, 203) = mat(k, 203) + lmat(k, 203) + mat(k, 204) = mat(k, 204) + lmat(k, 204) + mat(k, 206) = mat(k, 206) + lmat(k, 206) + mat(k, 208) = lmat(k, 208) + mat(k, 209) = lmat(k, 209) + mat(k, 210) = mat(k, 210) + lmat(k, 210) + mat(k, 213) = mat(k, 213) + lmat(k, 213) + mat(k, 215) = mat(k, 215) + lmat(k, 215) + mat(k, 219) = mat(k, 219) + lmat(k, 219) + mat(k, 220) = mat(k, 220) + lmat(k, 220) + mat(k, 227) = mat(k, 227) + lmat(k, 227) + mat(k, 228) = mat(k, 228) + lmat(k, 228) + mat(k, 234) = mat(k, 234) + lmat(k, 234) + mat(k, 235) = mat(k, 235) + lmat(k, 235) + mat(k, 237) = lmat(k, 237) + mat(k, 240) = mat(k, 240) + lmat(k, 240) + mat(k, 241) = lmat(k, 241) + mat(k, 244) = lmat(k, 244) + mat(k, 245) = lmat(k, 245) + mat(k, 246) = lmat(k, 246) + mat(k, 248) = mat(k, 248) + lmat(k, 248) + mat(k, 252) = mat(k, 252) + lmat(k, 252) + mat(k, 253) = lmat(k, 253) + mat(k, 254) = lmat(k, 254) + mat(k, 255) = lmat(k, 255) + mat(k, 257) = lmat(k, 257) + mat(k, 259) = mat(k, 259) + lmat(k, 259) + mat(k, 260) = mat(k, 260) + lmat(k, 260) + mat(k, 263) = lmat(k, 263) + mat(k, 264) = lmat(k, 264) + mat(k, 265) = lmat(k, 265) + mat(k, 266) = mat(k, 266) + lmat(k, 266) + mat(k, 268) = mat(k, 268) + lmat(k, 268) + mat(k, 269) = lmat(k, 269) + mat(k, 270) = lmat(k, 270) + mat(k, 271) = lmat(k, 271) + mat(k, 273) = mat(k, 273) + lmat(k, 273) + mat(k, 274) = lmat(k, 274) + mat(k, 275) = mat(k, 275) + lmat(k, 275) + mat(k, 276) = mat(k, 276) + lmat(k, 276) + mat(k, 281) = mat(k, 281) + lmat(k, 281) + mat(k, 283) = mat(k, 283) + lmat(k, 283) + mat(k, 286) = lmat(k, 286) + mat(k, 289) = lmat(k, 289) + mat(k, 292) = mat(k, 292) + lmat(k, 292) + mat(k, 293) = lmat(k, 293) + mat(k, 294) = mat(k, 294) + lmat(k, 294) + mat(k, 301) = mat(k, 301) + lmat(k, 301) + mat(k, 302) = mat(k, 302) + lmat(k, 302) + mat(k, 304) = lmat(k, 304) + mat(k, 306) = mat(k, 306) + lmat(k, 306) + mat(k, 308) = mat(k, 308) + lmat(k, 308) + mat(k, 318) = mat(k, 318) + lmat(k, 318) + mat(k, 323) = lmat(k, 323) + mat(k, 324) = lmat(k, 324) + mat(k, 325) = lmat(k, 325) + mat(k, 328) = mat(k, 328) + lmat(k, 328) + mat(k, 336) = mat(k, 336) + lmat(k, 336) + mat(k, 337) = mat(k, 337) + lmat(k, 337) + mat(k, 339) = mat(k, 339) + lmat(k, 339) + mat(k, 342) = mat(k, 342) + lmat(k, 342) + mat(k, 352) = mat(k, 352) + lmat(k, 352) + mat(k, 353) = lmat(k, 353) + mat(k, 358) = mat(k, 358) + lmat(k, 358) + mat(k, 360) = mat(k, 360) + lmat(k, 360) + mat(k, 362) = lmat(k, 362) + mat(k, 363) = lmat(k, 363) + mat(k, 369) = mat(k, 369) + lmat(k, 369) + mat(k, 377) = mat(k, 377) + lmat(k, 377) + mat(k, 389) = mat(k, 389) + lmat(k, 389) + mat(k, 401) = mat(k, 401) + lmat(k, 401) + mat(k, 403) = mat(k, 403) + lmat(k, 403) + mat(k, 405) = mat(k, 405) + lmat(k, 405) + mat(k, 408) = mat(k, 408) + lmat(k, 408) + mat(k, 409) = mat(k, 409) + lmat(k, 409) + mat(k, 410) = mat(k, 410) + lmat(k, 410) + mat(k, 416) = mat(k, 416) + lmat(k, 416) + mat(k, 417) = lmat(k, 417) + mat(k, 418) = mat(k, 418) + lmat(k, 418) + mat(k, 422) = mat(k, 422) + lmat(k, 422) + mat(k, 423) = lmat(k, 423) + mat(k, 424) = lmat(k, 424) + mat(k, 429) = mat(k, 429) + lmat(k, 429) + mat(k, 446) = mat(k, 446) + lmat(k, 446) + mat(k, 447) = mat(k, 447) + lmat(k, 447) + mat(k, 448) = mat(k, 448) + lmat(k, 448) + mat(k, 450) = mat(k, 450) + lmat(k, 450) + mat(k, 452) = lmat(k, 452) + mat(k, 454) = mat(k, 454) + lmat(k, 454) + mat(k, 455) = mat(k, 455) + lmat(k, 455) + mat(k, 459) = mat(k, 459) + lmat(k, 459) + mat(k, 460) = lmat(k, 460) + mat(k, 461) = mat(k, 461) + lmat(k, 461) + mat(k, 463) = mat(k, 463) + lmat(k, 463) + mat(k, 466) = lmat(k, 466) + mat(k, 467) = mat(k, 467) + lmat(k, 467) + mat(k, 468) = lmat(k, 468) + mat(k, 470) = lmat(k, 470) + mat(k, 471) = mat(k, 471) + lmat(k, 471) + mat(k, 472) = mat(k, 472) + lmat(k, 472) + mat(k, 476) = lmat(k, 476) + mat(k, 477) = mat(k, 477) + lmat(k, 477) + mat(k, 478) = lmat(k, 478) + mat(k, 479) = mat(k, 479) + lmat(k, 479) + mat(k, 480) = mat(k, 480) + lmat(k, 480) + mat(k, 481) = mat(k, 481) + lmat(k, 481) + mat(k, 482) = mat(k, 482) + lmat(k, 482) + mat(k, 485) = lmat(k, 485) + mat(k, 488) = mat(k, 488) + lmat(k, 488) + mat(k, 489) = mat(k, 489) + lmat(k, 489) + mat(k, 492) = mat(k, 492) + lmat(k, 492) + mat(k, 503) = mat(k, 503) + lmat(k, 503) + mat(k, 505) = lmat(k, 505) + mat(k, 506) = lmat(k, 506) + mat(k, 507) = mat(k, 507) + lmat(k, 507) + mat(k, 510) = mat(k, 510) + lmat(k, 510) + mat(k, 514) = mat(k, 514) + lmat(k, 514) + mat(k, 530) = mat(k, 530) + lmat(k, 530) + mat(k, 549) = lmat(k, 549) + mat(k, 550) = mat(k, 550) + lmat(k, 550) + mat(k, 552) = lmat(k, 552) + mat(k, 554) = lmat(k, 554) + mat(k, 559) = mat(k, 559) + lmat(k, 559) + mat(k, 560) = mat(k, 560) + lmat(k, 560) + mat(k, 563) = mat(k, 563) + lmat(k, 563) + mat(k, 564) = mat(k, 564) + lmat(k, 564) + mat(k, 565) = mat(k, 565) + lmat(k, 565) + mat(k, 567) = mat(k, 567) + lmat(k, 567) + mat(k, 578) = mat(k, 578) + lmat(k, 578) + mat(k, 590) = mat(k, 590) + lmat(k, 590) + mat(k, 591) = mat(k, 591) + lmat(k, 591) + mat(k, 592) = mat(k, 592) + lmat(k, 592) + mat(k, 594) = lmat(k, 594) + mat(k, 600) = lmat(k, 600) + mat(k, 601) = mat(k, 601) + lmat(k, 601) + mat(k, 602) = mat(k, 602) + lmat(k, 602) + mat(k, 606) = lmat(k, 606) + mat(k, 626) = mat(k, 626) + lmat(k, 626) + mat(k, 649) = mat(k, 649) + lmat(k, 649) + mat(k, 668) = mat(k, 668) + lmat(k, 668) + mat(k, 695) = mat(k, 695) + lmat(k, 695) + mat(k, 708) = mat(k, 708) + lmat(k, 708) + mat(k, 709) = lmat(k, 709) + mat(k, 714) = mat(k, 714) + lmat(k, 714) + mat(k, 715) = mat(k, 715) + lmat(k, 715) + mat(k, 716) = lmat(k, 716) + mat(k, 753) = mat(k, 753) + lmat(k, 753) + mat(k, 769) = mat(k, 769) + lmat(k, 769) + mat(k, 773) = mat(k, 773) + lmat(k, 773) + mat(k, 780) = mat(k, 780) + lmat(k, 780) + mat(k, 781) = lmat(k, 781) + mat(k, 782) = mat(k, 782) + lmat(k, 782) + mat(k, 783) = mat(k, 783) + lmat(k, 783) + mat(k, 800) = mat(k, 800) + lmat(k, 800) + mat(k, 818) = mat(k, 818) + lmat(k, 818) + mat(k, 820) = mat(k, 820) + lmat(k, 820) + mat(k, 821) = mat(k, 821) + lmat(k, 821) + mat(k, 856) = mat(k, 856) + lmat(k, 856) + mat(k, 886) = mat(k, 886) + lmat(k, 886) + mat(k, 889) = mat(k, 889) + lmat(k, 889) + mat(k, 943) = mat(k, 943) + lmat(k, 943) + mat(k, 952) = mat(k, 952) + lmat(k, 952) + mat(k, 961) = mat(k, 961) + lmat(k, 961) + mat(k, 964) = mat(k, 964) + lmat(k, 964) + mat(k, 966) = mat(k, 966) + lmat(k, 966) + mat(k,1008) = mat(k,1008) + lmat(k,1008) + mat(k,1011) = mat(k,1011) + lmat(k,1011) + mat(k,1013) = mat(k,1013) + lmat(k,1013) + mat(k,1028) = mat(k,1028) + lmat(k,1028) + mat(k,1044) = mat(k,1044) + lmat(k,1044) + mat(k,1048) = mat(k,1048) + lmat(k,1048) + mat(k,1050) = mat(k,1050) + lmat(k,1050) + mat(k,1053) = mat(k,1053) + lmat(k,1053) + mat(k,1081) = mat(k,1081) + lmat(k,1081) + mat(k,1086) = mat(k,1086) + lmat(k,1086) + mat(k,1172) = mat(k,1172) + lmat(k,1172) + mat(k,1185) = mat(k,1185) + lmat(k,1185) + mat(k,1210) = mat(k,1210) + lmat(k,1210) + mat(k,1214) = mat(k,1214) + lmat(k,1214) + mat(k,1217) = mat(k,1217) + lmat(k,1217) + mat(k,1219) = mat(k,1219) + lmat(k,1219) + mat(k,1234) = mat(k,1234) + lmat(k,1234) + mat(k,1235) = mat(k,1235) + lmat(k,1235) + mat(k,1243) = mat(k,1243) + lmat(k,1243) + mat(k,1248) = mat(k,1248) + lmat(k,1248) + mat(k,1277) = mat(k,1277) + lmat(k,1277) + mat(k,1286) = mat(k,1286) + lmat(k,1286) + mat(k,1291) = lmat(k,1291) + mat(k,1293) = lmat(k,1293) + mat(k,1297) = lmat(k,1297) + mat(k,1302) = mat(k,1302) + lmat(k,1302) + mat(k,1303) = mat(k,1303) + lmat(k,1303) + mat(k,1307) = mat(k,1307) + lmat(k,1307) + mat(k, 217) = 0._r8 + mat(k, 329) = 0._r8 + mat(k, 333) = 0._r8 + mat(k, 338) = 0._r8 + mat(k, 343) = 0._r8 + mat(k, 348) = 0._r8 + mat(k, 350) = 0._r8 + mat(k, 355) = 0._r8 + mat(k, 375) = 0._r8 + mat(k, 390) = 0._r8 + mat(k, 392) = 0._r8 + mat(k, 397) = 0._r8 + mat(k, 399) = 0._r8 + mat(k, 427) = 0._r8 + mat(k, 430) = 0._r8 + mat(k, 441) = 0._r8 + mat(k, 444) = 0._r8 + mat(k, 456) = 0._r8 + mat(k, 462) = 0._r8 + mat(k, 469) = 0._r8 + mat(k, 475) = 0._r8 + mat(k, 502) = 0._r8 + mat(k, 511) = 0._r8 + mat(k, 527) = 0._r8 + mat(k, 529) = 0._r8 + mat(k, 532) = 0._r8 + mat(k, 533) = 0._r8 + mat(k, 535) = 0._r8 + mat(k, 537) = 0._r8 + mat(k, 538) = 0._r8 + mat(k, 539) = 0._r8 + mat(k, 542) = 0._r8 + mat(k, 543) = 0._r8 + mat(k, 546) = 0._r8 + mat(k, 547) = 0._r8 + mat(k, 553) = 0._r8 + mat(k, 555) = 0._r8 + mat(k, 566) = 0._r8 + mat(k, 583) = 0._r8 + mat(k, 586) = 0._r8 + mat(k, 593) = 0._r8 + mat(k, 595) = 0._r8 + mat(k, 607) = 0._r8 + mat(k, 614) = 0._r8 + mat(k, 622) = 0._r8 + mat(k, 624) = 0._r8 + mat(k, 627) = 0._r8 + mat(k, 628) = 0._r8 + mat(k, 633) = 0._r8 + mat(k, 635) = 0._r8 + mat(k, 637) = 0._r8 + mat(k, 640) = 0._r8 + mat(k, 647) = 0._r8 + mat(k, 650) = 0._r8 + mat(k, 654) = 0._r8 + mat(k, 657) = 0._r8 + mat(k, 660) = 0._r8 + mat(k, 665) = 0._r8 + mat(k, 666) = 0._r8 + mat(k, 667) = 0._r8 + mat(k, 672) = 0._r8 + mat(k, 679) = 0._r8 + mat(k, 699) = 0._r8 + mat(k, 704) = 0._r8 + mat(k, 706) = 0._r8 + mat(k, 713) = 0._r8 + mat(k, 717) = 0._r8 + mat(k, 719) = 0._r8 + mat(k, 720) = 0._r8 + mat(k, 721) = 0._r8 + mat(k, 724) = 0._r8 + mat(k, 725) = 0._r8 + mat(k, 727) = 0._r8 + mat(k, 728) = 0._r8 + mat(k, 729) = 0._r8 + mat(k, 754) = 0._r8 + mat(k, 756) = 0._r8 + mat(k, 758) = 0._r8 + mat(k, 760) = 0._r8 + mat(k, 762) = 0._r8 + mat(k, 763) = 0._r8 + mat(k, 764) = 0._r8 + mat(k, 767) = 0._r8 + mat(k, 770) = 0._r8 + mat(k, 771) = 0._r8 + mat(k, 775) = 0._r8 + mat(k, 789) = 0._r8 + mat(k, 790) = 0._r8 + mat(k, 791) = 0._r8 + mat(k, 792) = 0._r8 + mat(k, 798) = 0._r8 + mat(k, 801) = 0._r8 + mat(k, 802) = 0._r8 + mat(k, 803) = 0._r8 + mat(k, 807) = 0._r8 + mat(k, 808) = 0._r8 + mat(k, 809) = 0._r8 + mat(k, 810) = 0._r8 + mat(k, 811) = 0._r8 + mat(k, 819) = 0._r8 + mat(k, 823) = 0._r8 + mat(k, 824) = 0._r8 + mat(k, 825) = 0._r8 + mat(k, 826) = 0._r8 + mat(k, 829) = 0._r8 + mat(k, 840) = 0._r8 + mat(k, 844) = 0._r8 + mat(k, 848) = 0._r8 + mat(k, 849) = 0._r8 + mat(k, 850) = 0._r8 + mat(k, 857) = 0._r8 + mat(k, 859) = 0._r8 + mat(k, 861) = 0._r8 + mat(k, 862) = 0._r8 + mat(k, 866) = 0._r8 + mat(k, 867) = 0._r8 + mat(k, 869) = 0._r8 + mat(k, 875) = 0._r8 + mat(k, 876) = 0._r8 + mat(k, 891) = 0._r8 + mat(k, 896) = 0._r8 + mat(k, 899) = 0._r8 + mat(k, 915) = 0._r8 + mat(k, 921) = 0._r8 + mat(k, 924) = 0._r8 + mat(k, 925) = 0._r8 + mat(k, 927) = 0._r8 + mat(k, 930) = 0._r8 + mat(k, 947) = 0._r8 + mat(k, 957) = 0._r8 + mat(k, 960) = 0._r8 + mat(k, 962) = 0._r8 + mat(k, 967) = 0._r8 + mat(k, 969) = 0._r8 + mat(k, 971) = 0._r8 + mat(k, 974) = 0._r8 + mat(k, 980) = 0._r8 + mat(k, 981) = 0._r8 + mat(k, 984) = 0._r8 + mat(k, 985) = 0._r8 + mat(k, 987) = 0._r8 + mat(k, 988) = 0._r8 + mat(k, 990) = 0._r8 + mat(k, 994) = 0._r8 + mat(k, 997) = 0._r8 + mat(k, 998) = 0._r8 + mat(k, 999) = 0._r8 + mat(k,1006) = 0._r8 + mat(k,1018) = 0._r8 + mat(k,1026) = 0._r8 + mat(k,1027) = 0._r8 + mat(k,1031) = 0._r8 + mat(k,1032) = 0._r8 + mat(k,1033) = 0._r8 + mat(k,1037) = 0._r8 + mat(k,1038) = 0._r8 + mat(k,1039) = 0._r8 + mat(k,1040) = 0._r8 + mat(k,1041) = 0._r8 + mat(k,1042) = 0._r8 + mat(k,1043) = 0._r8 + mat(k,1049) = 0._r8 + mat(k,1054) = 0._r8 + mat(k,1073) = 0._r8 + mat(k,1085) = 0._r8 + mat(k,1088) = 0._r8 + mat(k,1171) = 0._r8 + mat(k,1183) = 0._r8 + mat(k,1190) = 0._r8 + mat(k,1198) = 0._r8 + mat(k,1204) = 0._r8 + mat(k,1205) = 0._r8 + mat(k,1207) = 0._r8 + mat(k,1208) = 0._r8 + mat(k,1209) = 0._r8 + mat(k,1212) = 0._r8 + mat(k,1213) = 0._r8 + mat(k,1215) = 0._r8 + mat(k,1218) = 0._r8 + mat(k,1220) = 0._r8 + mat(k,1230) = 0._r8 + mat(k,1238) = 0._r8 + mat(k,1240) = 0._r8 + mat(k,1242) = 0._r8 + mat(k,1245) = 0._r8 + mat(k,1272) = 0._r8 + mat(k,1275) = 0._r8 + mat(k,1282) = 0._r8 + mat(k,1287) = 0._r8 + mat(k,1290) = 0._r8 + mat(k,1292) = 0._r8 + mat(k,1294) = 0._r8 + mat(k,1295) = 0._r8 + mat(k,1296) = 0._r8 + mat(k,1298) = 0._r8 + mat(k,1299) = 0._r8 + mat(k,1300) = 0._r8 + mat(k,1301) = 0._r8 + mat(k,1304) = 0._r8 + mat(k,1305) = 0._r8 + mat(k,1306) = 0._r8 + mat(k, 1) = mat(k, 1) - dti(k) + mat(k, 2) = mat(k, 2) - dti(k) + mat(k, 3) = mat(k, 3) - dti(k) + mat(k, 4) = mat(k, 4) - dti(k) + mat(k, 5) = mat(k, 5) - dti(k) + mat(k, 6) = mat(k, 6) - dti(k) + mat(k, 7) = mat(k, 7) - dti(k) + mat(k, 8) = mat(k, 8) - dti(k) + mat(k, 9) = mat(k, 9) - dti(k) + mat(k, 11) = mat(k, 11) - dti(k) + mat(k, 12) = mat(k, 12) - dti(k) + mat(k, 13) = mat(k, 13) - dti(k) + mat(k, 14) = mat(k, 14) - dti(k) + mat(k, 15) = mat(k, 15) - dti(k) + mat(k, 16) = mat(k, 16) - dti(k) + mat(k, 17) = mat(k, 17) - dti(k) + mat(k, 18) = mat(k, 18) - dti(k) + mat(k, 19) = mat(k, 19) - dti(k) + mat(k, 20) = mat(k, 20) - dti(k) + mat(k, 21) = mat(k, 21) - dti(k) + mat(k, 22) = mat(k, 22) - dti(k) + mat(k, 23) = mat(k, 23) - dti(k) + mat(k, 24) = mat(k, 24) - dti(k) + mat(k, 25) = mat(k, 25) - dti(k) + mat(k, 26) = mat(k, 26) - dti(k) + mat(k, 27) = mat(k, 27) - dti(k) + mat(k, 28) = mat(k, 28) - dti(k) + mat(k, 29) = mat(k, 29) - dti(k) + mat(k, 30) = mat(k, 30) - dti(k) + mat(k, 31) = mat(k, 31) - dti(k) + mat(k, 32) = mat(k, 32) - dti(k) + mat(k, 34) = mat(k, 34) - dti(k) + mat(k, 35) = mat(k, 35) - dti(k) + mat(k, 36) = mat(k, 36) - dti(k) + mat(k, 39) = mat(k, 39) - dti(k) + mat(k, 42) = mat(k, 42) - dti(k) + mat(k, 45) = mat(k, 45) - dti(k) + mat(k, 48) = mat(k, 48) - dti(k) + mat(k, 51) = mat(k, 51) - dti(k) + mat(k, 54) = mat(k, 54) - dti(k) + mat(k, 57) = mat(k, 57) - dti(k) + mat(k, 60) = mat(k, 60) - dti(k) + mat(k, 63) = mat(k, 63) - dti(k) + mat(k, 66) = mat(k, 66) - dti(k) + mat(k, 69) = mat(k, 69) - dti(k) + mat(k, 73) = mat(k, 73) - dti(k) + mat(k, 77) = mat(k, 77) - dti(k) + mat(k, 81) = mat(k, 81) - dti(k) + mat(k, 84) = mat(k, 84) - dti(k) + mat(k, 87) = mat(k, 87) - dti(k) + mat(k, 89) = mat(k, 89) - dti(k) + mat(k, 93) = mat(k, 93) - dti(k) + mat(k, 97) = mat(k, 97) - dti(k) + mat(k, 100) = mat(k, 100) - dti(k) + mat(k, 103) = mat(k, 103) - dti(k) + mat(k, 108) = mat(k, 108) - dti(k) + mat(k, 111) = mat(k, 111) - dti(k) + mat(k, 116) = mat(k, 116) - dti(k) + mat(k, 120) = mat(k, 120) - dti(k) + mat(k, 124) = mat(k, 124) - dti(k) + mat(k, 130) = mat(k, 130) - dti(k) + mat(k, 136) = mat(k, 136) - dti(k) + mat(k, 142) = mat(k, 142) - dti(k) + mat(k, 147) = mat(k, 147) - dti(k) + mat(k, 152) = mat(k, 152) - dti(k) + mat(k, 157) = mat(k, 157) - dti(k) + mat(k, 160) = mat(k, 160) - dti(k) + mat(k, 168) = mat(k, 168) - dti(k) + mat(k, 176) = mat(k, 176) - dti(k) + mat(k, 182) = mat(k, 182) - dti(k) + mat(k, 188) = mat(k, 188) - dti(k) + mat(k, 194) = mat(k, 194) - dti(k) + mat(k, 200) = mat(k, 200) - dti(k) + mat(k, 206) = mat(k, 206) - dti(k) + mat(k, 213) = mat(k, 213) - dti(k) + mat(k, 220) = mat(k, 220) - dti(k) + mat(k, 227) = mat(k, 227) - dti(k) + mat(k, 234) = mat(k, 234) - dti(k) + mat(k, 240) = mat(k, 240) - dti(k) + mat(k, 248) = mat(k, 248) - dti(k) + mat(k, 252) = mat(k, 252) - dti(k) + mat(k, 260) = mat(k, 260) - dti(k) + mat(k, 268) = mat(k, 268) - dti(k) + mat(k, 276) = mat(k, 276) - dti(k) + mat(k, 283) = mat(k, 283) - dti(k) + mat(k, 292) = mat(k, 292) - dti(k) + mat(k, 301) = mat(k, 301) - dti(k) + mat(k, 308) = mat(k, 308) - dti(k) + mat(k, 318) = mat(k, 318) - dti(k) + mat(k, 323) = mat(k, 323) - dti(k) + mat(k, 328) = mat(k, 328) - dti(k) + mat(k, 336) = mat(k, 336) - dti(k) + mat(k, 342) = mat(k, 342) - dti(k) + mat(k, 352) = mat(k, 352) - dti(k) + mat(k, 360) = mat(k, 360) - dti(k) + mat(k, 369) = mat(k, 369) - dti(k) + mat(k, 377) = mat(k, 377) - dti(k) + mat(k, 389) = mat(k, 389) - dti(k) + mat(k, 401) = mat(k, 401) - dti(k) + mat(k, 408) = mat(k, 408) - dti(k) + mat(k, 416) = mat(k, 416) - dti(k) + mat(k, 422) = mat(k, 422) - dti(k) + mat(k, 429) = mat(k, 429) - dti(k) + mat(k, 448) = mat(k, 448) - dti(k) + mat(k, 459) = mat(k, 459) - dti(k) + mat(k, 467) = mat(k, 467) - dti(k) + mat(k, 477) = mat(k, 477) - dti(k) + mat(k, 492) = mat(k, 492) - dti(k) + mat(k, 503) = mat(k, 503) - dti(k) + mat(k, 510) = mat(k, 510) - dti(k) + mat(k, 514) = mat(k, 514) - dti(k) + mat(k, 530) = mat(k, 530) - dti(k) + mat(k, 550) = mat(k, 550) - dti(k) + mat(k, 560) = mat(k, 560) - dti(k) + mat(k, 578) = mat(k, 578) - dti(k) + mat(k, 591) = mat(k, 591) - dti(k) + mat(k, 602) = mat(k, 602) - dti(k) + mat(k, 626) = mat(k, 626) - dti(k) + mat(k, 649) = mat(k, 649) - dti(k) + mat(k, 668) = mat(k, 668) - dti(k) + mat(k, 695) = mat(k, 695) - dti(k) + mat(k, 715) = mat(k, 715) - dti(k) + mat(k, 753) = mat(k, 753) - dti(k) + mat(k, 769) = mat(k, 769) - dti(k) + mat(k, 783) = mat(k, 783) - dti(k) + mat(k, 800) = mat(k, 800) - dti(k) + mat(k, 820) = mat(k, 820) - dti(k) + mat(k, 856) = mat(k, 856) - dti(k) + mat(k, 886) = mat(k, 886) - dti(k) + mat(k, 943) = mat(k, 943) - dti(k) + mat(k, 966) = mat(k, 966) - dti(k) + mat(k,1011) = mat(k,1011) - dti(k) + mat(k,1048) = mat(k,1048) - dti(k) + mat(k,1086) = mat(k,1086) - dti(k) + mat(k,1172) = mat(k,1172) - dti(k) + mat(k,1217) = mat(k,1217) - dti(k) + mat(k,1243) = mat(k,1243) - dti(k) + mat(k,1286) = mat(k,1286) - dti(k) + mat(k,1307) = mat(k,1307) - dti(k) + end do + end subroutine nlnmat_finit + subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) + use chem_mods, only : gas_pcnst, rxntot, nzcnt + implicit none +!---------------------------------------------- +! ... dummy arguments +!---------------------------------------------- + integer, intent(in) :: avec_len + real(r8), intent(in) :: dti(veclen) + real(r8), intent(in) :: lmat(veclen,nzcnt) + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(inout) :: mat(veclen,nzcnt) + call nlnmat01( avec_len, mat, y, rxt ) + call nlnmat02( avec_len, mat, y, rxt ) + call nlnmat03( avec_len, mat, y, rxt ) + call nlnmat04( avec_len, mat, y, rxt ) + call nlnmat05( avec_len, mat, y, rxt ) + call nlnmat06( avec_len, mat, y, rxt ) + call nlnmat07( avec_len, mat, y, rxt ) + call nlnmat_finit( avec_len, mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_phtadj.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_phtadj.F90 new file mode 100644 index 0000000000..6698bf2f2b --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_phtadj.F90 @@ -0,0 +1,27 @@ + module mo_phtadj + private + public :: phtadj + contains + subroutine phtadj( p_rate, inv, m, ncol, nlev ) + use chem_mods, only : nfs, phtcnt + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none +!-------------------------------------------------------------------- +! ... dummy arguments +!-------------------------------------------------------------------- + integer, intent(in) :: ncol, nlev + real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs)) + real(r8), intent(in) :: m(ncol,nlev) + real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt)) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k + real(r8) :: im(ncol,nlev) + do k = 1,nlev + im(:ncol,k) = 1._r8 / m(:ncol,k) + p_rate(:,k, 5) = p_rate(:,k, 5) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 6) = p_rate(:,k, 6) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_prod_loss.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_prod_loss.F90 new file mode 100644 index 0000000000..66d3674640 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_prod_loss.F90 @@ -0,0 +1,778 @@ + module mo_prod_loss + use shr_kind_mod, only : r8 => shr_kind_r8 + use chem_mods, only : veclen + private + public :: exp_prod_loss + public :: imp_prod_loss + contains + subroutine exp_prod_loss( ofl, ofu, prod, loss, y, & + rxt, het_rates, chnkpnts ) + use chem_mods, only : gas_pcnst,rxntot,clscnt1 + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: ofl, ofu, chnkpnts + real(r8), dimension(chnkpnts,max(1,clscnt1)), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(chnkpnts,gas_pcnst) + real(r8), intent(in) :: rxt(chnkpnts,rxntot) + real(r8), intent(in) :: het_rates(chnkpnts,gas_pcnst) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k +!-------------------------------------------------------------------- +! ... loss and production for Explicit method +!-------------------------------------------------------------------- + do k = ofl,ofu + loss(k,1) = ( + het_rates(k,124))* y(k,124) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,125))* y(k,125) + prod(k,2) = 0._r8 + end do + end subroutine exp_prod_loss + subroutine imp_prod_loss( avec_len, prod, loss, y, & + rxt, het_rates ) + use chem_mods, only : gas_pcnst,rxntot,clscnt4 + implicit none +!-------------------------------------------------------------------- +! ... dummy args +!-------------------------------------------------------------------- + integer, intent(in) :: avec_len + real(r8), dimension(veclen,clscnt4), intent(out) :: & + prod, & + loss + real(r8), intent(in) :: y(veclen,gas_pcnst) + real(r8), intent(in) :: rxt(veclen,rxntot) + real(r8), intent(in) :: het_rates(veclen,gas_pcnst) +!-------------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------------- + integer :: k +!-------------------------------------------------------------------- +! ... loss and production for Implicit method +!-------------------------------------------------------------------- + do k = 1,avec_len + loss(k,1) = ( + het_rates(k,1))* y(k,1) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,2))* y(k,2) + prod(k,2) = 0._r8 + loss(k,35) = (rxt(k,293)* y(k,137) + het_rates(k,3))* y(k,3) + prod(k,35) = 0._r8 + loss(k,126) = (rxt(k,173)* y(k,25) +rxt(k,175)* y(k,98) +rxt(k,174)* y(k,132) & + + het_rates(k,4))* y(k,4) + prod(k,126) = (rxt(k,47) +2.000_r8*rxt(k,176)*y(k,6) +rxt(k,177)*y(k,41) + & + rxt(k,178)*y(k,41) +rxt(k,181)*y(k,88) +rxt(k,184)*y(k,97) + & + rxt(k,185)*y(k,137) +rxt(k,325)*y(k,110))*y(k,6) & + + (rxt(k,163)*y(k,17) +rxt(k,189)*y(k,18) + & + 3.000_r8*rxt(k,190)*y(k,37) +2.000_r8*rxt(k,191)*y(k,56) + & + rxt(k,192)*y(k,59) +2.000_r8*rxt(k,206)*y(k,24) +rxt(k,207)*y(k,26)) & + *y(k,136) + (rxt(k,187)*y(k,59) +2.000_r8*rxt(k,195)*y(k,24) + & + rxt(k,197)*y(k,26) +3.000_r8*rxt(k,202)*y(k,37))*y(k,137) & + + (2.000_r8*rxt(k,194)*y(k,24) +rxt(k,196)*y(k,26) + & + 3.000_r8*rxt(k,201)*y(k,37))*y(k,38) + (rxt(k,69) + & + rxt(k,186)*y(k,97))*y(k,59) +rxt(k,46)*y(k,5) +rxt(k,49)*y(k,7) & + +rxt(k,51)*y(k,17) +rxt(k,52)*y(k,18) +2.000_r8*rxt(k,58)*y(k,24) & + +rxt(k,59)*y(k,26) +3.000_r8*rxt(k,62)*y(k,37) +2.000_r8*rxt(k,68) & + *y(k,56) +rxt(k,75)*y(k,67) + loss(k,56) = ( + rxt(k,46) + het_rates(k,5))* y(k,5) + prod(k,56) = (rxt(k,351)*y(k,67) +rxt(k,356)*y(k,67))*y(k,63) & + +rxt(k,179)*y(k,41)*y(k,6) + loss(k,131) = (2._r8*rxt(k,176)* y(k,6) + (rxt(k,177) +rxt(k,178) + & + rxt(k,179))* y(k,41) +rxt(k,181)* y(k,88) +rxt(k,182)* y(k,89) & + +rxt(k,184)* y(k,97) +rxt(k,325)* y(k,110) +rxt(k,180)* y(k,132) & + +rxt(k,185)* y(k,137) + rxt(k,47) + het_rates(k,6))* y(k,6) + prod(k,131) = (rxt(k,48) +rxt(k,183)*y(k,97))*y(k,7) +rxt(k,175)*y(k,98) & + *y(k,4) +rxt(k,193)*y(k,136)*y(k,59) +rxt(k,188)*y(k,97)*y(k,67) + loss(k,83) = (rxt(k,183)* y(k,97) + rxt(k,48) + rxt(k,49) + rxt(k,345) & + + rxt(k,348) + rxt(k,353) + het_rates(k,7))* y(k,7) + prod(k,83) =rxt(k,182)*y(k,89)*y(k,6) + loss(k,3) = ( + het_rates(k,8))* y(k,8) + prod(k,3) = 0._r8 + loss(k,76) = (rxt(k,225)* y(k,38) +rxt(k,226)* y(k,98) +rxt(k,250)* y(k,137) & + + het_rates(k,9))* y(k,9) + prod(k,76) = 0._r8 + loss(k,57) = (rxt(k,231)* y(k,137) + het_rates(k,10))* y(k,10) + prod(k,57) = (.400_r8*rxt(k,227)*y(k,126) +.200_r8*rxt(k,228)*y(k,129)) & + *y(k,126) + loss(k,64) = (rxt(k,232)* y(k,137) + rxt(k,19) + het_rates(k,11))* y(k,11) + prod(k,64) =rxt(k,229)*y(k,132)*y(k,126) + loss(k,61) = (rxt(k,233)* y(k,38) +rxt(k,234)* y(k,137) + het_rates(k,12)) & + * y(k,12) + prod(k,61) = 0._r8 + loss(k,112) = (rxt(k,253)* y(k,90) +rxt(k,254)* y(k,98) +rxt(k,271)* y(k,137) & + + het_rates(k,13))* y(k,13) + prod(k,112) =.130_r8*rxt(k,304)*y(k,98)*y(k,71) +.700_r8*rxt(k,39)*y(k,77) + loss(k,71) = (rxt(k,258)* y(k,137) + rxt(k,20) + het_rates(k,14))* y(k,14) + prod(k,71) =rxt(k,256)*y(k,132)*y(k,127) + loss(k,45) = (rxt(k,259)* y(k,137) + het_rates(k,15))* y(k,15) + prod(k,45) = 0._r8 + loss(k,38) = (rxt(k,162)* y(k,136) + rxt(k,50) + het_rates(k,16))* y(k,16) + prod(k,38) = 0._r8 + loss(k,46) = (rxt(k,163)* y(k,136) + rxt(k,51) + het_rates(k,17))* y(k,17) + prod(k,46) = 0._r8 + loss(k,39) = (rxt(k,189)* y(k,136) + rxt(k,52) + het_rates(k,18))* y(k,18) + prod(k,39) = 0._r8 + loss(k,40) = (rxt(k,164)* y(k,136) + rxt(k,53) + het_rates(k,19))* y(k,19) + prod(k,40) = 0._r8 + loss(k,41) = (rxt(k,165)* y(k,136) + rxt(k,54) + het_rates(k,20))* y(k,20) + prod(k,41) = 0._r8 + loss(k,42) = (rxt(k,166)* y(k,136) + rxt(k,55) + het_rates(k,21))* y(k,21) + prod(k,42) = 0._r8 + loss(k,43) = (rxt(k,167)* y(k,136) + rxt(k,56) + het_rates(k,22))* y(k,22) + prod(k,43) = 0._r8 + loss(k,44) = (rxt(k,168)* y(k,136) + rxt(k,57) + het_rates(k,23))* y(k,23) + prod(k,44) = 0._r8 + loss(k,77) = (rxt(k,194)* y(k,38) +rxt(k,206)* y(k,136) +rxt(k,195)* y(k,137) & + + rxt(k,58) + het_rates(k,24))* y(k,24) + prod(k,77) = 0._r8 + loss(k,125) = (rxt(k,173)* y(k,4) +rxt(k,137)* y(k,38) +rxt(k,211)* y(k,90) & + +rxt(k,212)* y(k,97) +rxt(k,213)* y(k,137) + rxt(k,21) + rxt(k,22) & + + het_rates(k,25))* y(k,25) + prod(k,125) = (rxt(k,144)*y(k,41) +2.000_r8*rxt(k,214)*y(k,129) + & + rxt(k,215)*y(k,129) +rxt(k,217)*y(k,88) + & + .700_r8*rxt(k,228)*y(k,126) +rxt(k,238)*y(k,128) + & + rxt(k,255)*y(k,127) +.800_r8*rxt(k,267)*y(k,139) + & + .880_r8*rxt(k,274)*y(k,134) +2.000_r8*rxt(k,283)*y(k,135) + & + 1.200_r8*rxt(k,300)*y(k,133) +.800_r8*rxt(k,310)*y(k,140))*y(k,129) & + + (.500_r8*rxt(k,244)*y(k,131) +rxt(k,265)*y(k,138) + & + rxt(k,269)*y(k,139) +.250_r8*rxt(k,277)*y(k,134) + & + rxt(k,286)*y(k,135) +.072_r8*rxt(k,297)*y(k,72) + & + .550_r8*rxt(k,302)*y(k,133) +.250_r8*rxt(k,312)*y(k,140))*y(k,88) & + + (rxt(k,218)*y(k,34) +.300_r8*rxt(k,219)*y(k,35) + & + .500_r8*rxt(k,242)*y(k,33) +.800_r8*rxt(k,247)*y(k,52) + & + rxt(k,249)*y(k,103) +.500_r8*rxt(k,288)*y(k,76))*y(k,137) & + + (rxt(k,226)*y(k,9) +.500_r8*rxt(k,254)*y(k,13) + & + .120_r8*rxt(k,279)*y(k,74) +.600_r8*rxt(k,289)*y(k,77) + & + .910_r8*rxt(k,304)*y(k,71))*y(k,98) + (.250_r8*rxt(k,276)*y(k,134) + & + rxt(k,287)*y(k,135) +.072_r8*rxt(k,298)*y(k,72) + & + .600_r8*rxt(k,303)*y(k,133))*y(k,90) + (.250_r8*rxt(k,273)*y(k,134) + & + rxt(k,282)*y(k,135) +.600_r8*rxt(k,299)*y(k,133) + & + .250_r8*rxt(k,309)*y(k,140))*y(k,128) + (.180_r8*rxt(k,28) + & + rxt(k,222)*y(k,136) +rxt(k,223)*y(k,136))*y(k,36) & + + (.150_r8*rxt(k,268)*y(k,139) +.450_r8*rxt(k,284)*y(k,135) + & + .206_r8*rxt(k,296)*y(k,72))*y(k,132) +rxt(k,27)*y(k,35) +rxt(k,32) & + *y(k,52) +rxt(k,34)*y(k,69) +.690_r8*rxt(k,35)*y(k,73) & + +1.340_r8*rxt(k,36)*y(k,74) +rxt(k,40)*y(k,91) +rxt(k,41)*y(k,102) & + +rxt(k,43)*y(k,106) +rxt(k,44)*y(k,107) +2.000_r8*rxt(k,245) & + *y(k,130) +2.000_r8*rxt(k,285)*y(k,135)*y(k,135) + loss(k,86) = (rxt(k,196)* y(k,38) +rxt(k,207)* y(k,136) +rxt(k,197)* y(k,137) & + + rxt(k,59) + het_rates(k,26))* y(k,26) + prod(k,86) = 0._r8 + loss(k,47) = (rxt(k,198)* y(k,137) + rxt(k,60) + het_rates(k,27))* y(k,27) + prod(k,47) = 0._r8 + loss(k,113) = (rxt(k,235)* y(k,90) +rxt(k,236)* y(k,137) + rxt(k,23) & + + het_rates(k,28))* y(k,28) + prod(k,113) = (rxt(k,230)*y(k,126) +.270_r8*rxt(k,257)*y(k,127) + & + rxt(k,265)*y(k,138))*y(k,88) + (rxt(k,19) + & + .500_r8*rxt(k,232)*y(k,137))*y(k,11) + (.500_r8*rxt(k,254)*y(k,13) + & + .100_r8*rxt(k,289)*y(k,77))*y(k,98) + (1.600_r8*rxt(k,227)*y(k,126) + & + .800_r8*rxt(k,228)*y(k,129))*y(k,126) +rxt(k,231)*y(k,137)*y(k,10) & + +rxt(k,43)*y(k,106) + loss(k,68) = (rxt(k,199)* y(k,38) +rxt(k,200)* y(k,137) + rxt(k,61) & + + het_rates(k,29))* y(k,29) + prod(k,68) = 0._r8 + loss(k,95) = (rxt(k,272)* y(k,137) + rxt(k,24) + het_rates(k,30))* y(k,30) + prod(k,95) = (.820_r8*rxt(k,255)*y(k,129) +.820_r8*rxt(k,257)*y(k,88)) & + *y(k,127) +.820_r8*rxt(k,20)*y(k,14) +.100_r8*rxt(k,317)*y(k,137) & + *y(k,122) + loss(k,116) = (rxt(k,260)* y(k,90) +rxt(k,261)* y(k,137) + rxt(k,25) & + + het_rates(k,31))* y(k,31) + prod(k,116) = (.250_r8*rxt(k,273)*y(k,128) +.240_r8*rxt(k,274)*y(k,129) + & + .250_r8*rxt(k,276)*y(k,90) +.250_r8*rxt(k,277)*y(k,88))*y(k,134) & + + (.250_r8*rxt(k,309)*y(k,128) +.100_r8*rxt(k,310)*y(k,129) + & + .250_r8*rxt(k,312)*y(k,88) +.250_r8*rxt(k,313)*y(k,90))*y(k,140) & + + (.880_r8*rxt(k,279)*y(k,74) +.500_r8*rxt(k,289)*y(k,77))*y(k,98) & + + (rxt(k,262)*y(k,69) +rxt(k,263)*y(k,91))*y(k,137) & + +.020_r8*rxt(k,302)*y(k,133)*y(k,88) +.500_r8*rxt(k,267)*y(k,139) & + *y(k,129) + loss(k,89) = (rxt(k,241)* y(k,137) + het_rates(k,32))* y(k,32) + prod(k,89) = (.100_r8*rxt(k,238)*y(k,129) +.150_r8*rxt(k,239)*y(k,132)) & + *y(k,128) +.120_r8*rxt(k,254)*y(k,98)*y(k,13) & + +.150_r8*rxt(k,284)*y(k,135)*y(k,132) + loss(k,87) = (rxt(k,242)* y(k,137) + rxt(k,26) + het_rates(k,33))* y(k,33) + prod(k,87) = (.400_r8*rxt(k,239)*y(k,128) +.400_r8*rxt(k,284)*y(k,135)) & + *y(k,132) + loss(k,80) = (rxt(k,218)* y(k,137) + het_rates(k,34))* y(k,34) + prod(k,80) = (rxt(k,215)*y(k,129) +.300_r8*rxt(k,228)*y(k,126) + & + .500_r8*rxt(k,267)*y(k,139) +.250_r8*rxt(k,274)*y(k,134) + & + .250_r8*rxt(k,300)*y(k,133) +.300_r8*rxt(k,310)*y(k,140))*y(k,129) + loss(k,73) = (rxt(k,219)* y(k,137) + rxt(k,27) + het_rates(k,35))* y(k,35) + prod(k,73) =rxt(k,216)*y(k,132)*y(k,129) + loss(k,107) = (rxt(k,138)* y(k,38) + (rxt(k,221) +rxt(k,222) +rxt(k,223)) & + * y(k,136) +rxt(k,220)* y(k,137) + rxt(k,28) + rxt(k,29) & + + het_rates(k,36))* y(k,36) + prod(k,107) =.100_r8*rxt(k,254)*y(k,98)*y(k,13) + loss(k,70) = (rxt(k,201)* y(k,38) +rxt(k,190)* y(k,136) +rxt(k,202)* y(k,137) & + + rxt(k,62) + het_rates(k,37))* y(k,37) + prod(k,70) = 0._r8 + loss(k,128) = (rxt(k,233)* y(k,12) +rxt(k,194)* y(k,24) +rxt(k,137)* y(k,25) & + +rxt(k,196)* y(k,26) +rxt(k,199)* y(k,29) +rxt(k,138)* y(k,36) & + +rxt(k,201)* y(k,37) +rxt(k,150)* y(k,42) +rxt(k,139)* y(k,55) & + +rxt(k,140)* y(k,57) +rxt(k,159)* y(k,68) +rxt(k,143)* y(k,98) & + + (rxt(k,141) +rxt(k,142))* y(k,132) + het_rates(k,38))* y(k,38) + prod(k,128) = (4.000_r8*rxt(k,162)*y(k,16) +rxt(k,163)*y(k,17) + & + 3.000_r8*rxt(k,164)*y(k,19) +3.000_r8*rxt(k,165)*y(k,20) + & + 2.000_r8*rxt(k,166)*y(k,21) +rxt(k,167)*y(k,22) + & + 2.000_r8*rxt(k,168)*y(k,23) +rxt(k,169)*y(k,63) + & + 2.000_r8*rxt(k,208)*y(k,60) +rxt(k,209)*y(k,61) +rxt(k,210)*y(k,62)) & + *y(k,136) + (rxt(k,65) +rxt(k,144)*y(k,129) + & + 2.000_r8*rxt(k,145)*y(k,41) +rxt(k,147)*y(k,41) +rxt(k,149)*y(k,88) + & + rxt(k,154)*y(k,97) +rxt(k,155)*y(k,137) +rxt(k,178)*y(k,6) + & + rxt(k,326)*y(k,110))*y(k,41) + (rxt(k,158)*y(k,63) + & + 3.000_r8*rxt(k,198)*y(k,27) +rxt(k,200)*y(k,29) + & + 2.000_r8*rxt(k,203)*y(k,60) +rxt(k,204)*y(k,61) +rxt(k,205)*y(k,62)) & + *y(k,137) + (rxt(k,73) +rxt(k,157)*y(k,97))*y(k,63) +rxt(k,46)*y(k,5) & + +4.000_r8*rxt(k,50)*y(k,16) +rxt(k,51)*y(k,17) +3.000_r8*rxt(k,53) & + *y(k,19) +3.000_r8*rxt(k,54)*y(k,20) +2.000_r8*rxt(k,55)*y(k,21) & + +rxt(k,56)*y(k,22) +2.000_r8*rxt(k,57)*y(k,23) +3.000_r8*rxt(k,60) & + *y(k,27) +rxt(k,61)*y(k,29) +2.000_r8*rxt(k,63)*y(k,39) & + +2.000_r8*rxt(k,64)*y(k,40) +rxt(k,67)*y(k,42) +rxt(k,70)*y(k,60) & + +rxt(k,71)*y(k,61) +rxt(k,72)*y(k,62) +rxt(k,76)*y(k,68) + loss(k,50) = ( + rxt(k,63) + het_rates(k,39))* y(k,39) + prod(k,50) = (rxt(k,344)*y(k,68) +rxt(k,349)*y(k,42) +rxt(k,350)*y(k,68) + & + rxt(k,354)*y(k,42) +rxt(k,355)*y(k,68) +rxt(k,359)*y(k,42))*y(k,63) & + +rxt(k,150)*y(k,42)*y(k,38) +rxt(k,146)*y(k,41)*y(k,41) + loss(k,34) = ( + rxt(k,64) + rxt(k,172) + het_rates(k,40))* y(k,40) + prod(k,34) =rxt(k,171)*y(k,41)*y(k,41) + loss(k,137) = ((rxt(k,177) +rxt(k,178) +rxt(k,179))* y(k,6) & + + 2._r8*(rxt(k,145) +rxt(k,146) +rxt(k,147) +rxt(k,171))* y(k,41) & + +rxt(k,149)* y(k,88) +rxt(k,151)* y(k,89) +rxt(k,154)* y(k,97) & + +rxt(k,326)* y(k,110) +rxt(k,144)* y(k,129) +rxt(k,148)* y(k,132) & + + (rxt(k,155) +rxt(k,156))* y(k,137) + rxt(k,65) + het_rates(k,41)) & + * y(k,41) + prod(k,137) = (rxt(k,142)*y(k,132) +rxt(k,143)*y(k,98) +rxt(k,159)*y(k,68)) & + *y(k,38) + (rxt(k,66) +rxt(k,152)*y(k,97))*y(k,42) & + + (rxt(k,160)*y(k,97) +rxt(k,161)*y(k,137))*y(k,68) + (rxt(k,77) + & + rxt(k,331)*y(k,110))*y(k,100) +2.000_r8*rxt(k,172)*y(k,40) & + +rxt(k,170)*y(k,136)*y(k,63) + loss(k,104) = (rxt(k,150)* y(k,38) + (rxt(k,349) +rxt(k,354) +rxt(k,359)) & + * y(k,63) +rxt(k,152)* y(k,97) +rxt(k,153)* y(k,137) + rxt(k,66) & + + rxt(k,67) + rxt(k,347) + rxt(k,352) + rxt(k,358) & + + het_rates(k,42))* y(k,42) + prod(k,104) =rxt(k,151)*y(k,89)*y(k,41) + loss(k,4) = ( + het_rates(k,43))* y(k,43) + prod(k,4) = 0._r8 + loss(k,110) = (rxt(k,224)* y(k,137) + het_rates(k,44))* y(k,44) + prod(k,110) = (rxt(k,21) +rxt(k,22) +rxt(k,137)*y(k,38) +rxt(k,173)*y(k,4) + & + rxt(k,211)*y(k,90) +rxt(k,212)*y(k,97) +rxt(k,213)*y(k,137))*y(k,25) & + + (.630_r8*rxt(k,226)*y(k,9) +.560_r8*rxt(k,254)*y(k,13) + & + .650_r8*rxt(k,279)*y(k,74) +.560_r8*rxt(k,289)*y(k,77) + & + .620_r8*rxt(k,304)*y(k,71))*y(k,98) + (.220_r8*rxt(k,273)*y(k,128) + & + .110_r8*rxt(k,274)*y(k,129) +.220_r8*rxt(k,276)*y(k,90) + & + .220_r8*rxt(k,277)*y(k,88))*y(k,134) + (.250_r8*rxt(k,309)*y(k,128) + & + .200_r8*rxt(k,310)*y(k,129) +.250_r8*rxt(k,312)*y(k,88) + & + .500_r8*rxt(k,313)*y(k,90))*y(k,140) + (rxt(k,25) + & + rxt(k,260)*y(k,90) +rxt(k,261)*y(k,137))*y(k,31) + (rxt(k,80) + & + rxt(k,320)*y(k,97) +rxt(k,321)*y(k,137))*y(k,101) & + + (2.000_r8*rxt(k,33) +rxt(k,248)*y(k,137))*y(k,53) +rxt(k,23) & + *y(k,28) +rxt(k,199)*y(k,38)*y(k,29) +.380_r8*rxt(k,28)*y(k,36) & + +rxt(k,30)*y(k,45) +rxt(k,32)*y(k,52) +1.340_r8*rxt(k,37)*y(k,74) & + +.700_r8*rxt(k,39)*y(k,77) +rxt(k,41)*y(k,102) + loss(k,90) = ( + rxt(k,30) + het_rates(k,45))* y(k,45) + prod(k,90) = (rxt(k,224)*y(k,44) +rxt(k,241)*y(k,32) + & + .500_r8*rxt(k,242)*y(k,33) +.800_r8*rxt(k,247)*y(k,52) + & + rxt(k,248)*y(k,53) +.500_r8*rxt(k,288)*y(k,76))*y(k,137) & + + (2.000_r8*rxt(k,237)*y(k,128) +.900_r8*rxt(k,238)*y(k,129) + & + rxt(k,240)*y(k,88) +2.000_r8*rxt(k,282)*y(k,135) + & + rxt(k,309)*y(k,140))*y(k,128) + (rxt(k,283)*y(k,129) + & + .450_r8*rxt(k,284)*y(k,132) +2.000_r8*rxt(k,285)*y(k,135))*y(k,135) & + + (.200_r8*rxt(k,254)*y(k,13) +.100_r8*rxt(k,289)*y(k,77))*y(k,98) & + +rxt(k,26)*y(k,33) +.440_r8*rxt(k,28)*y(k,36) +.400_r8*rxt(k,42) & + *y(k,103) + loss(k,62) = (rxt(k,318)* y(k,90) + (rxt(k,319) +rxt(k,333))* y(k,137) & + + het_rates(k,46))* y(k,46) + prod(k,62) = 0._r8 + loss(k,5) = ( + het_rates(k,47))* y(k,47) + prod(k,5) = 0._r8 + loss(k,6) = ( + het_rates(k,48))* y(k,48) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,49))* y(k,49) + prod(k,7) = 0._r8 + loss(k,8) = ( + rxt(k,360) + het_rates(k,50))* y(k,50) + prod(k,8) = 0._r8 + loss(k,48) = ( + rxt(k,31) + het_rates(k,51))* y(k,51) + prod(k,48) =rxt(k,243)*y(k,132)*y(k,131) + loss(k,105) = (rxt(k,247)* y(k,137) + rxt(k,32) + het_rates(k,52))* y(k,52) + prod(k,105) = (.530_r8*rxt(k,273)*y(k,128) +.260_r8*rxt(k,274)*y(k,129) + & + .530_r8*rxt(k,276)*y(k,90) +.530_r8*rxt(k,277)*y(k,88))*y(k,134) & + + (.250_r8*rxt(k,309)*y(k,128) +.100_r8*rxt(k,310)*y(k,129) + & + .250_r8*rxt(k,312)*y(k,88) +.250_r8*rxt(k,313)*y(k,90))*y(k,140) & + +.020_r8*rxt(k,302)*y(k,133)*y(k,88) +rxt(k,246)*y(k,130) + loss(k,92) = (rxt(k,248)* y(k,137) + rxt(k,33) + het_rates(k,53))* y(k,53) + prod(k,92) = (.250_r8*rxt(k,309)*y(k,128) +.100_r8*rxt(k,310)*y(k,129) + & + .250_r8*rxt(k,312)*y(k,88) +.250_r8*rxt(k,313)*y(k,90))*y(k,140) & + +.200_r8*rxt(k,247)*y(k,137)*y(k,52) +.020_r8*rxt(k,302)*y(k,133) & + *y(k,88) + loss(k,124) = (rxt(k,103)* y(k,98) + (rxt(k,97) +rxt(k,98) +rxt(k,99)) & + * y(k,132) + rxt(k,100) + het_rates(k,54))* y(k,54) + prod(k,124) = (rxt(k,104)*y(k,55) +rxt(k,107)*y(k,97) +rxt(k,125)*y(k,78) + & + rxt(k,213)*y(k,25) +rxt(k,321)*y(k,101) +rxt(k,327)*y(k,108) + & + rxt(k,332)*y(k,110))*y(k,137) + (rxt(k,86)*y(k,55) + & + rxt(k,170)*y(k,63) +rxt(k,193)*y(k,59) +rxt(k,222)*y(k,36))*y(k,136) & + + (.330_r8*rxt(k,28) +rxt(k,29))*y(k,36) + (rxt(k,95)*y(k,97) + & + rxt(k,139)*y(k,38))*y(k,55) + (rxt(k,2) +2.000_r8*rxt(k,3))*y(k,141) & + +2.000_r8*rxt(k,21)*y(k,25) +rxt(k,27)*y(k,35) +rxt(k,69)*y(k,59) & + +rxt(k,73)*y(k,63) +rxt(k,74)*y(k,64) + loss(k,111) = (rxt(k,139)* y(k,38) +rxt(k,95)* y(k,97) +rxt(k,86)* y(k,136) & + +rxt(k,104)* y(k,137) + het_rates(k,55))* y(k,55) + prod(k,111) = (1.440_r8*rxt(k,28) +rxt(k,223)*y(k,136))*y(k,36) +rxt(k,22) & + *y(k,25) +rxt(k,97)*y(k,132)*y(k,54) +rxt(k,1)*y(k,141) + loss(k,36) = (rxt(k,191)* y(k,136) + rxt(k,68) + het_rates(k,56))* y(k,56) + prod(k,36) = 0._r8 + loss(k,84) = (rxt(k,140)* y(k,38) +rxt(k,96)* y(k,97) +rxt(k,105)* y(k,137) & + + rxt(k,4) + het_rates(k,57))* y(k,57) + prod(k,84) =rxt(k,111)*y(k,132)*y(k,132) +rxt(k,110)*y(k,137)*y(k,137) + loss(k,49) = ( + rxt(k,79) + het_rates(k,58))* y(k,58) + prod(k,49) =rxt(k,334)*y(k,141)*y(k,112) + loss(k,100) = (rxt(k,186)* y(k,97) + (rxt(k,192) +rxt(k,193))* y(k,136) & + +rxt(k,187)* y(k,137) + rxt(k,69) + het_rates(k,59))* y(k,59) + prod(k,100) = (rxt(k,173)*y(k,25) +rxt(k,174)*y(k,132))*y(k,4) + loss(k,51) = (rxt(k,208)* y(k,136) +rxt(k,203)* y(k,137) + rxt(k,70) & + + het_rates(k,60))* y(k,60) + prod(k,51) = 0._r8 + loss(k,52) = (rxt(k,209)* y(k,136) +rxt(k,204)* y(k,137) + rxt(k,71) & + + het_rates(k,61))* y(k,61) + prod(k,52) = 0._r8 + loss(k,55) = (rxt(k,210)* y(k,136) +rxt(k,205)* y(k,137) + rxt(k,72) & + + het_rates(k,62))* y(k,62) + prod(k,55) = 0._r8 + loss(k,127) = ((rxt(k,349) +rxt(k,354) +rxt(k,359))* y(k,42) + (rxt(k,351) + & + rxt(k,356))* y(k,67) + (rxt(k,344) +rxt(k,350) +rxt(k,355))* y(k,68) & + +rxt(k,157)* y(k,97) + (rxt(k,169) +rxt(k,170))* y(k,136) & + +rxt(k,158)* y(k,137) + rxt(k,73) + het_rates(k,63))* y(k,63) + prod(k,127) = (rxt(k,137)*y(k,25) +rxt(k,138)*y(k,36) +rxt(k,139)*y(k,55) + & + rxt(k,140)*y(k,57) +rxt(k,141)*y(k,132) +rxt(k,159)*y(k,68) + & + rxt(k,194)*y(k,24) +rxt(k,196)*y(k,26) +2.000_r8*rxt(k,199)*y(k,29) + & + rxt(k,201)*y(k,37) +rxt(k,233)*y(k,12))*y(k,38) +rxt(k,156)*y(k,137) & + *y(k,41) + loss(k,9) = ( + rxt(k,74) + het_rates(k,64))* y(k,64) + prod(k,9) = 0._r8 + loss(k,101) = (rxt(k,134)* y(k,137) + rxt(k,9) + het_rates(k,65))* y(k,65) + prod(k,101) = (rxt(k,347) +rxt(k,352) +rxt(k,358) +rxt(k,349)*y(k,63) + & + rxt(k,354)*y(k,63) +rxt(k,359)*y(k,63))*y(k,42) + (rxt(k,340) + & + rxt(k,211)*y(k,25) +rxt(k,235)*y(k,28) +rxt(k,260)*y(k,31) + & + rxt(k,318)*y(k,46))*y(k,90) + (2.000_r8*rxt(k,337) + & + 2.000_r8*rxt(k,343) +2.000_r8*rxt(k,346) +2.000_r8*rxt(k,357)) & + *y(k,80) + (rxt(k,345) +rxt(k,348) +rxt(k,353))*y(k,7) & + + (.500_r8*rxt(k,339) +rxt(k,133)*y(k,137))*y(k,89) +rxt(k,341) & + *y(k,102) + loss(k,69) = (rxt(k,112)* y(k,137) + rxt(k,10) + rxt(k,11) + rxt(k,135) & + + het_rates(k,66))* y(k,66) + prod(k,69) =rxt(k,131)*y(k,132)*y(k,89) + loss(k,94) = ((rxt(k,351) +rxt(k,356))* y(k,63) +rxt(k,188)* y(k,97) & + + rxt(k,75) + het_rates(k,67))* y(k,67) + prod(k,94) = (rxt(k,345) +rxt(k,348) +rxt(k,353))*y(k,7) +rxt(k,180)*y(k,132) & + *y(k,6) + loss(k,99) = (rxt(k,159)* y(k,38) + (rxt(k,344) +rxt(k,350) +rxt(k,355)) & + * y(k,63) +rxt(k,160)* y(k,97) +rxt(k,161)* y(k,137) + rxt(k,76) & + + het_rates(k,68))* y(k,68) + prod(k,99) = (rxt(k,347) +rxt(k,352) +rxt(k,358) +rxt(k,153)*y(k,137)) & + *y(k,42) +rxt(k,148)*y(k,132)*y(k,41) + loss(k,109) = (rxt(k,262)* y(k,137) + rxt(k,34) + het_rates(k,69))* y(k,69) + prod(k,109) = (.220_r8*rxt(k,273)*y(k,128) +.230_r8*rxt(k,274)*y(k,129) + & + .220_r8*rxt(k,276)*y(k,90) +.220_r8*rxt(k,277)*y(k,88))*y(k,134) & + + (.250_r8*rxt(k,309)*y(k,128) +.100_r8*rxt(k,310)*y(k,129) + & + .250_r8*rxt(k,312)*y(k,88) +.250_r8*rxt(k,313)*y(k,90))*y(k,140) & + + (.500_r8*rxt(k,266)*y(k,106) +.500_r8*rxt(k,288)*y(k,76))*y(k,137) & + +.020_r8*rxt(k,302)*y(k,133)*y(k,88) +.200_r8*rxt(k,267)*y(k,139) & + *y(k,129) + loss(k,66) = (rxt(k,294)* y(k,137) + het_rates(k,70))* y(k,70) + prod(k,66) = (.400_r8*rxt(k,299)*y(k,128) +.300_r8*rxt(k,300)*y(k,129) + & + .330_r8*rxt(k,302)*y(k,88) +.400_r8*rxt(k,303)*y(k,90))*y(k,133) & + + (rxt(k,307)*y(k,90) +rxt(k,308)*y(k,137))*y(k,102) + loss(k,103) = (rxt(k,295)* y(k,90) +rxt(k,304)* y(k,98) +rxt(k,305)* y(k,137) & + + het_rates(k,71))* y(k,71) + prod(k,103) = 0._r8 + loss(k,97) = (rxt(k,297)* y(k,88) +rxt(k,298)* y(k,90) +rxt(k,296)* y(k,132) & + + het_rates(k,72))* y(k,72) + prod(k,97) =rxt(k,295)*y(k,90)*y(k,71) + loss(k,79) = (rxt(k,306)* y(k,137) + rxt(k,35) + het_rates(k,73))* y(k,73) + prod(k,79) =rxt(k,301)*y(k,133)*y(k,132) + loss(k,114) = (rxt(k,279)* y(k,98) +rxt(k,280)* y(k,137) + rxt(k,36) & + + rxt(k,37) + het_rates(k,74))* y(k,74) + prod(k,114) = (.250_r8*rxt(k,299)*y(k,128) +.190_r8*rxt(k,300)*y(k,129) + & + .230_r8*rxt(k,302)*y(k,88) +.250_r8*rxt(k,303)*y(k,90))*y(k,133) & + + (.167_r8*rxt(k,296)*y(k,132) +.167_r8*rxt(k,297)*y(k,88) + & + .167_r8*rxt(k,298)*y(k,90))*y(k,72) + (.300_r8*rxt(k,304)*y(k,71) + & + 1.122_r8*rxt(k,316)*y(k,122))*y(k,98) +.288_r8*rxt(k,35)*y(k,73) + loss(k,63) = (rxt(k,281)* y(k,137) + het_rates(k,75))* y(k,75) + prod(k,63) =rxt(k,275)*y(k,134)*y(k,132) + loss(k,85) = (rxt(k,288)* y(k,137) + rxt(k,38) + rxt(k,292) & + + het_rates(k,76))* y(k,76) + prod(k,85) =rxt(k,291)*y(k,135)*y(k,89) + loss(k,122) = (rxt(k,289)* y(k,98) +rxt(k,290)* y(k,137) + rxt(k,39) & + + het_rates(k,77))* y(k,77) + prod(k,122) = (.350_r8*rxt(k,299)*y(k,128) +.260_r8*rxt(k,300)*y(k,129) + & + .320_r8*rxt(k,302)*y(k,88) +.350_r8*rxt(k,303)*y(k,90))*y(k,133) & + + (.039_r8*rxt(k,296)*y(k,132) +.039_r8*rxt(k,297)*y(k,88) + & + .039_r8*rxt(k,298)*y(k,90))*y(k,72) + (.200_r8*rxt(k,304)*y(k,71) + & + .442_r8*rxt(k,316)*y(k,122))*y(k,98) +.402_r8*rxt(k,35)*y(k,73) + loss(k,75) = (rxt(k,113)* y(k,88) + (rxt(k,114) +rxt(k,115) +rxt(k,116)) & + * y(k,89) +rxt(k,125)* y(k,137) + rxt(k,117) + het_rates(k,78)) & + * y(k,78) + prod(k,75) =rxt(k,15)*y(k,88) + loss(k,53) = ((rxt(k,129) +rxt(k,130))* y(k,136) + rxt(k,12) & + + het_rates(k,79))* y(k,79) + prod(k,53) =rxt(k,114)*y(k,89)*y(k,78) + loss(k,60) = ( + rxt(k,13) + rxt(k,14) + rxt(k,136) + rxt(k,337) + rxt(k,343) & + + rxt(k,346) + rxt(k,357) + het_rates(k,80))* y(k,80) + prod(k,60) =rxt(k,132)*y(k,90)*y(k,89) + loss(k,10) = ( + het_rates(k,81))* y(k,81) + prod(k,10) = 0._r8 + loss(k,11) = ( + het_rates(k,82))* y(k,82) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,83))* y(k,83) + prod(k,12) = 0._r8 + loss(k,37) = (rxt(k,335)* y(k,137) + het_rates(k,84))* y(k,84) + prod(k,37) = 0._r8 + loss(k,13) = ( + rxt(k,338) + het_rates(k,85))* y(k,85) + prod(k,13) = 0._r8 + loss(k,14) = ( + rxt(k,362) + het_rates(k,86))* y(k,86) + prod(k,14) = 0._r8 + loss(k,15) = ( + rxt(k,361) + het_rates(k,87))* y(k,87) + prod(k,15) = 0._r8 + loss(k,138) = (rxt(k,181)* y(k,6) +rxt(k,149)* y(k,41) +rxt(k,297)* y(k,72) & + +rxt(k,113)* y(k,78) +rxt(k,122)* y(k,90) +rxt(k,128)* y(k,97) & + +rxt(k,127)* y(k,98) +rxt(k,230)* y(k,126) +rxt(k,257)* y(k,127) & + +rxt(k,240)* y(k,128) +rxt(k,217)* y(k,129) +rxt(k,244)* y(k,131) & + +rxt(k,126)* y(k,132) +rxt(k,302)* y(k,133) + (rxt(k,277) + & + rxt(k,278))* y(k,134) +rxt(k,286)* y(k,135) +rxt(k,265)* y(k,138) & + +rxt(k,269)* y(k,139) +rxt(k,312)* y(k,140) + rxt(k,15) & + + het_rates(k,88))* y(k,88) + prod(k,138) = (rxt(k,16) +.500_r8*rxt(k,339) +2.000_r8*rxt(k,115)*y(k,78) + & + rxt(k,118)*y(k,97) +rxt(k,328)*y(k,110))*y(k,89) + (rxt(k,117) + & + rxt(k,125)*y(k,137))*y(k,78) +2.000_r8*rxt(k,129)*y(k,136)*y(k,79) & + +rxt(k,14)*y(k,80) +rxt(k,17)*y(k,90) + loss(k,133) = (rxt(k,182)* y(k,6) +rxt(k,151)* y(k,41) + (rxt(k,114) + & + rxt(k,115) +rxt(k,116))* y(k,78) +rxt(k,132)* y(k,90) + (rxt(k,118) + & + rxt(k,120))* y(k,97) +rxt(k,119)* y(k,98) +rxt(k,328)* y(k,110) & + +rxt(k,251)* y(k,128) +rxt(k,131)* y(k,132) +rxt(k,291)* y(k,135) & + +rxt(k,133)* y(k,137) + rxt(k,16) + rxt(k,339) + het_rates(k,89)) & + * y(k,89) + prod(k,133) = (2.000_r8*rxt(k,122)*y(k,90) +rxt(k,126)*y(k,132) + & + rxt(k,127)*y(k,98) +rxt(k,128)*y(k,97) +rxt(k,149)*y(k,41) + & + rxt(k,181)*y(k,6) +rxt(k,217)*y(k,129) +rxt(k,230)*y(k,126) + & + rxt(k,240)*y(k,128) +rxt(k,244)*y(k,131) +rxt(k,257)*y(k,127) + & + rxt(k,265)*y(k,138) +rxt(k,269)*y(k,139) +rxt(k,277)*y(k,134) + & + rxt(k,286)*y(k,135) +1.206_r8*rxt(k,297)*y(k,72) + & + .920_r8*rxt(k,302)*y(k,133) +rxt(k,312)*y(k,140))*y(k,88) & + + (rxt(k,18) +rxt(k,121)*y(k,132) +rxt(k,123)*y(k,97) + & + rxt(k,124)*y(k,137) +rxt(k,276)*y(k,134) +rxt(k,287)*y(k,135) + & + 1.206_r8*rxt(k,298)*y(k,72) +rxt(k,303)*y(k,133) + & + rxt(k,307)*y(k,102) +rxt(k,313)*y(k,140) +rxt(k,315)*y(k,122)) & + *y(k,90) + (rxt(k,11) +rxt(k,135) +rxt(k,112)*y(k,137))*y(k,66) & + + (rxt(k,38) +rxt(k,292))*y(k,76) + (rxt(k,13) +rxt(k,136))*y(k,80) & + + (rxt(k,40) +rxt(k,263)*y(k,137))*y(k,91) + (rxt(k,41) + & + .400_r8*rxt(k,308)*y(k,137))*y(k,102) + (.600_r8*rxt(k,42) + & + rxt(k,252))*y(k,103) +rxt(k,48)*y(k,7) +rxt(k,66)*y(k,42) +rxt(k,9) & + *y(k,65) +.206_r8*rxt(k,296)*y(k,132)*y(k,72) + loss(k,136) = (rxt(k,253)* y(k,13) +rxt(k,211)* y(k,25) +rxt(k,235)* y(k,28) & + +rxt(k,260)* y(k,31) +rxt(k,318)* y(k,46) +rxt(k,295)* y(k,71) & + +rxt(k,298)* y(k,72) +rxt(k,122)* y(k,88) +rxt(k,132)* y(k,89) & + +rxt(k,123)* y(k,97) +rxt(k,307)* y(k,102) +rxt(k,315)* y(k,122) & + +rxt(k,121)* y(k,132) +rxt(k,303)* y(k,133) +rxt(k,276)* y(k,134) & + +rxt(k,287)* y(k,135) +rxt(k,124)* y(k,137) +rxt(k,313)* y(k,140) & + + rxt(k,17) + rxt(k,18) + rxt(k,340) + het_rates(k,90))* y(k,90) + prod(k,136) = (rxt(k,67) +rxt(k,150)*y(k,38) +rxt(k,152)*y(k,97) + & + rxt(k,153)*y(k,137))*y(k,42) + (rxt(k,13) +rxt(k,14) +rxt(k,136)) & + *y(k,80) + (rxt(k,134)*y(k,65) +rxt(k,249)*y(k,103) + & + .500_r8*rxt(k,288)*y(k,76))*y(k,137) + (rxt(k,49) + & + rxt(k,183)*y(k,97))*y(k,7) + (rxt(k,119)*y(k,98) +rxt(k,120)*y(k,97)) & + *y(k,89) +rxt(k,10)*y(k,66) +.400_r8*rxt(k,42)*y(k,103) + loss(k,72) = (rxt(k,263)* y(k,137) + rxt(k,40) + het_rates(k,91))* y(k,91) + prod(k,72) =rxt(k,253)*y(k,90)*y(k,13) + loss(k,16) = ( + het_rates(k,92))* y(k,92) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,93))* y(k,93) + prod(k,17) = 0._r8 + loss(k,18) = ( + het_rates(k,94))* y(k,94) + prod(k,18) = 0._r8 + loss(k,19) = ( + het_rates(k,95))* y(k,95) + prod(k,19) = 0._r8 + loss(k,20) = ( + het_rates(k,96))* y(k,96) + prod(k,20) = 0._r8 + loss(k,129) = (rxt(k,184)* y(k,6) +rxt(k,183)* y(k,7) +rxt(k,212)* y(k,25) & + +rxt(k,154)* y(k,41) +rxt(k,152)* y(k,42) +rxt(k,95)* y(k,55) & + +rxt(k,96)* y(k,57) +rxt(k,186)* y(k,59) +rxt(k,157)* y(k,63) & + +rxt(k,188)* y(k,67) +rxt(k,160)* y(k,68) +rxt(k,128)* y(k,88) & + + (rxt(k,118) +rxt(k,120))* y(k,89) +rxt(k,123)* y(k,90) & + + 2._r8*rxt(k,93)* y(k,97) +rxt(k,92)* y(k,98) +rxt(k,320)* y(k,101) & + +rxt(k,101)* y(k,132) +rxt(k,107)* y(k,137) + rxt(k,94) & + + het_rates(k,97))* y(k,97) + prod(k,129) = (rxt(k,117) +rxt(k,113)*y(k,88) +rxt(k,114)*y(k,89))*y(k,78) & + + (rxt(k,8) +2.000_r8*rxt(k,91)*y(k,136) + & + .765_r8*rxt(k,316)*y(k,122))*y(k,98) + (rxt(k,81) +rxt(k,329)) & + *y(k,110) + (rxt(k,88) +rxt(k,89))*y(k,136) +rxt(k,47)*y(k,6) & + +.180_r8*rxt(k,28)*y(k,36) +rxt(k,65)*y(k,41) +rxt(k,30)*y(k,45) & + +rxt(k,99)*y(k,132)*y(k,54) +rxt(k,14)*y(k,80) +rxt(k,15)*y(k,88) & + +rxt(k,16)*y(k,89) +rxt(k,18)*y(k,90) +rxt(k,77)*y(k,100) & + +rxt(k,322)*y(k,108) +rxt(k,82)*y(k,111) +rxt(k,83)*y(k,112) & + +rxt(k,109)*y(k,137)*y(k,137) +rxt(k,3)*y(k,141) + loss(k,132) = (rxt(k,175)* y(k,4) +rxt(k,226)* y(k,9) +rxt(k,254)* y(k,13) & + +rxt(k,143)* y(k,38) +rxt(k,103)* y(k,54) +rxt(k,304)* y(k,71) & + +rxt(k,279)* y(k,74) +rxt(k,289)* y(k,77) +rxt(k,127)* y(k,88) & + +rxt(k,119)* y(k,89) +rxt(k,92)* y(k,97) +rxt(k,324)* y(k,108) & + +rxt(k,330)* y(k,110) +rxt(k,316)* y(k,122) +rxt(k,102)* y(k,132) & + + (rxt(k,90) +rxt(k,91))* y(k,136) +rxt(k,108)* y(k,137) + rxt(k,7) & + + rxt(k,8) + het_rates(k,98))* y(k,98) + prod(k,132) = (.150_r8*rxt(k,239)*y(k,128) +.150_r8*rxt(k,284)*y(k,135)) & + *y(k,132) +rxt(k,94)*y(k,97) + loss(k,21) = ( + het_rates(k,99))* y(k,99) + prod(k,21) = 0._r8 + loss(k,65) = (rxt(k,331)* y(k,110) + rxt(k,77) + het_rates(k,100))* y(k,100) + prod(k,65) = (rxt(k,147)*y(k,41) +rxt(k,177)*y(k,6))*y(k,41) + loss(k,67) = (rxt(k,320)* y(k,97) +rxt(k,321)* y(k,137) + rxt(k,80) & + + het_rates(k,101))* y(k,101) + prod(k,67) = 0._r8 + loss(k,106) = (rxt(k,307)* y(k,90) +rxt(k,308)* y(k,137) + rxt(k,41) & + + rxt(k,341) + het_rates(k,102))* y(k,102) + prod(k,106) = (.794_r8*rxt(k,296)*y(k,132) +.794_r8*rxt(k,297)*y(k,88) + & + .794_r8*rxt(k,298)*y(k,90))*y(k,72) + (.800_r8*rxt(k,278)*y(k,134) + & + .080_r8*rxt(k,302)*y(k,133))*y(k,88) + loss(k,81) = (rxt(k,249)* y(k,137) + rxt(k,42) + rxt(k,252) & + + het_rates(k,103))* y(k,103) + prod(k,81) =rxt(k,251)*y(k,128)*y(k,89) + loss(k,22) = ( + het_rates(k,104))* y(k,104) + prod(k,22) = 0._r8 + loss(k,23) = ( + het_rates(k,105))* y(k,105) + prod(k,23) = 0._r8 + loss(k,82) = (rxt(k,266)* y(k,137) + rxt(k,43) + het_rates(k,106))* y(k,106) + prod(k,82) =rxt(k,264)*y(k,138)*y(k,132) + loss(k,74) = (rxt(k,270)* y(k,137) + rxt(k,44) + het_rates(k,107))* y(k,107) + prod(k,74) =.850_r8*rxt(k,268)*y(k,139)*y(k,132) + loss(k,78) = (rxt(k,324)* y(k,98) +rxt(k,327)* y(k,137) + rxt(k,322) & + + het_rates(k,108))* y(k,108) + prod(k,78) =rxt(k,80)*y(k,101) +rxt(k,81)*y(k,110) + loss(k,24) = ( + rxt(k,78) + het_rates(k,109))* y(k,109) + prod(k,24) = 0._r8 + loss(k,117) = (rxt(k,325)* y(k,6) +rxt(k,326)* y(k,41) +rxt(k,328)* y(k,89) & + +rxt(k,330)* y(k,98) +rxt(k,331)* y(k,100) +rxt(k,332)* y(k,137) & + + rxt(k,81) + rxt(k,329) + het_rates(k,110))* y(k,110) + prod(k,117) = (rxt(k,322) +rxt(k,324)*y(k,98) +rxt(k,327)*y(k,137))*y(k,108) & + +rxt(k,320)*y(k,101)*y(k,97) +rxt(k,82)*y(k,111) + loss(k,102) = (rxt(k,323)* y(k,137) + rxt(k,82) + het_rates(k,111))* y(k,111) + prod(k,102) = (rxt(k,329) +rxt(k,325)*y(k,6) +rxt(k,326)*y(k,41) + & + rxt(k,328)*y(k,89) +rxt(k,330)*y(k,98) +rxt(k,331)*y(k,100) + & + rxt(k,332)*y(k,137))*y(k,110) + (rxt(k,318)*y(k,90) + & + rxt(k,319)*y(k,137) +.500_r8*rxt(k,333)*y(k,137))*y(k,46) & + +rxt(k,321)*y(k,137)*y(k,101) +rxt(k,83)*y(k,112) + loss(k,58) = (rxt(k,334)* y(k,141) + rxt(k,83) + het_rates(k,112))* y(k,112) + prod(k,58) =rxt(k,79)*y(k,58) +rxt(k,323)*y(k,137)*y(k,111) + loss(k,25) = ( + het_rates(k,113))* y(k,113) + prod(k,25) = 0._r8 + loss(k,26) = ( + het_rates(k,114))* y(k,114) + prod(k,26) = 0._r8 + loss(k,27) = ( + het_rates(k,115))* y(k,115) + prod(k,27) = 0._r8 + loss(k,28) = ( + het_rates(k,116))* y(k,116) + prod(k,28) = 0._r8 + loss(k,29) = ( + rxt(k,84) + het_rates(k,117))* y(k,117) + prod(k,29) = 0._r8 + loss(k,30) = ( + rxt(k,85) + het_rates(k,118))* y(k,118) + prod(k,30) = 0._r8 + loss(k,31) = ( + rxt(k,342) + het_rates(k,119))* y(k,119) + prod(k,31) = 0._r8 + loss(k,32) = ( + het_rates(k,120))* y(k,120) + prod(k,32) =rxt(k,342)*y(k,119) + loss(k,33) = ( + rxt(k,363) + het_rates(k,121))* y(k,121) + prod(k,33) = 0._r8 + loss(k,88) = (rxt(k,315)* y(k,90) +rxt(k,316)* y(k,98) +rxt(k,317)* y(k,137) & + + het_rates(k,122))* y(k,122) + prod(k,88) = 0._r8 + loss(k,54) = (rxt(k,314)* y(k,137) + rxt(k,45) + het_rates(k,123))* y(k,123) + prod(k,54) =rxt(k,311)*y(k,140)*y(k,132) + loss(k,96) = (rxt(k,230)* y(k,88) + 2._r8*rxt(k,227)* y(k,126) +rxt(k,228) & + * y(k,129) +rxt(k,229)* y(k,132) + het_rates(k,126))* y(k,126) + prod(k,96) = (rxt(k,233)*y(k,38) +rxt(k,234)*y(k,137))*y(k,12) & + +.500_r8*rxt(k,232)*y(k,137)*y(k,11) + loss(k,98) = (rxt(k,257)* y(k,88) +rxt(k,255)* y(k,129) +rxt(k,256)* y(k,132) & + + het_rates(k,127))* y(k,127) + prod(k,98) = (rxt(k,258)*y(k,14) +rxt(k,259)*y(k,15) + & + 1.670_r8*rxt(k,293)*y(k,3))*y(k,137) + loss(k,121) = (rxt(k,240)* y(k,88) +rxt(k,251)* y(k,89) + 2._r8*rxt(k,237) & + * y(k,128) +rxt(k,238)* y(k,129) +rxt(k,239)* y(k,132) +rxt(k,299) & + * y(k,133) +rxt(k,273)* y(k,134) +rxt(k,309)* y(k,140) & + + het_rates(k,128))* y(k,128) + prod(k,121) = (rxt(k,283)*y(k,129) +.450_r8*rxt(k,284)*y(k,132) + & + 2.000_r8*rxt(k,285)*y(k,135) +rxt(k,286)*y(k,88) +rxt(k,287)*y(k,90)) & + *y(k,135) + (.530_r8*rxt(k,273)*y(k,128) + & + .260_r8*rxt(k,274)*y(k,129) +.530_r8*rxt(k,276)*y(k,90) + & + .530_r8*rxt(k,277)*y(k,88))*y(k,134) + (rxt(k,25) + & + rxt(k,260)*y(k,90) +rxt(k,261)*y(k,137))*y(k,31) & + + (.100_r8*rxt(k,279)*y(k,74) +.280_r8*rxt(k,289)*y(k,77) + & + .080_r8*rxt(k,304)*y(k,71))*y(k,98) + (.300_r8*rxt(k,267)*y(k,129) + & + .150_r8*rxt(k,268)*y(k,132) +rxt(k,269)*y(k,88))*y(k,139) & + + (rxt(k,235)*y(k,90) +rxt(k,236)*y(k,137))*y(k,28) & + + (.600_r8*rxt(k,42) +rxt(k,252))*y(k,103) +rxt(k,24)*y(k,30) & + +.500_r8*rxt(k,242)*y(k,137)*y(k,33) +rxt(k,34)*y(k,69) & + +1.340_r8*rxt(k,36)*y(k,74) +.300_r8*rxt(k,39)*y(k,77) +rxt(k,40) & + *y(k,91) +rxt(k,44)*y(k,107) + loss(k,123) = (rxt(k,144)* y(k,41) +rxt(k,217)* y(k,88) +rxt(k,228)* y(k,126) & + +rxt(k,255)* y(k,127) +rxt(k,238)* y(k,128) + 2._r8*(rxt(k,214) + & + rxt(k,215))* y(k,129) +rxt(k,216)* y(k,132) +rxt(k,300)* y(k,133) & + +rxt(k,274)* y(k,134) +rxt(k,283)* y(k,135) +rxt(k,267)* y(k,139) & + +rxt(k,310)* y(k,140) + het_rates(k,129))* y(k,129) + prod(k,123) = (2.000_r8*rxt(k,237)*y(k,128) +.900_r8*rxt(k,238)*y(k,129) + & + .450_r8*rxt(k,239)*y(k,132) +rxt(k,240)*y(k,88) + & + rxt(k,273)*y(k,134) +rxt(k,282)*y(k,135) +rxt(k,299)*y(k,133) + & + rxt(k,309)*y(k,140))*y(k,128) + (rxt(k,29) +rxt(k,138)*y(k,38) + & + rxt(k,220)*y(k,137) +rxt(k,221)*y(k,136))*y(k,36) & + + (.280_r8*rxt(k,254)*y(k,13) +.050_r8*rxt(k,304)*y(k,71))*y(k,98) & + + (.700_r8*rxt(k,219)*y(k,35) +rxt(k,241)*y(k,32))*y(k,137) & + +rxt(k,59)*y(k,26) +rxt(k,23)*y(k,28) +rxt(k,61)*y(k,29) +rxt(k,24) & + *y(k,30) +rxt(k,26)*y(k,33) +.300_r8*rxt(k,39)*y(k,77) & + +.400_r8*rxt(k,42)*y(k,103) + loss(k,59) = ( + rxt(k,245) + rxt(k,246) + het_rates(k,130))* y(k,130) + prod(k,59) =rxt(k,31)*y(k,51) +.750_r8*rxt(k,244)*y(k,131)*y(k,88) + loss(k,91) = (rxt(k,244)* y(k,88) +rxt(k,243)* y(k,132) + het_rates(k,131)) & + * y(k,131) + prod(k,91) =rxt(k,250)*y(k,137)*y(k,9) + loss(k,130) = (rxt(k,174)* y(k,4) +rxt(k,180)* y(k,6) + (rxt(k,141) + & + rxt(k,142))* y(k,38) +rxt(k,148)* y(k,41) + (rxt(k,97) +rxt(k,98) + & + rxt(k,99))* y(k,54) +rxt(k,296)* y(k,72) +rxt(k,126)* y(k,88) & + +rxt(k,131)* y(k,89) +rxt(k,121)* y(k,90) +rxt(k,101)* y(k,97) & + +rxt(k,102)* y(k,98) +rxt(k,229)* y(k,126) +rxt(k,256)* y(k,127) & + +rxt(k,239)* y(k,128) +rxt(k,216)* y(k,129) +rxt(k,243)* y(k,131) & + + 2._r8*rxt(k,111)* y(k,132) +rxt(k,301)* y(k,133) +rxt(k,275) & + * y(k,134) +rxt(k,284)* y(k,135) +rxt(k,106)* y(k,137) +rxt(k,264) & + * y(k,138) +rxt(k,268)* y(k,139) +rxt(k,311)* y(k,140) + rxt(k,336) & + + het_rates(k,132))* y(k,132) + prod(k,130) = (rxt(k,105)*y(k,57) +rxt(k,108)*y(k,98) +rxt(k,124)*y(k,90) + & + rxt(k,155)*y(k,41) +rxt(k,185)*y(k,6) +rxt(k,197)*y(k,26) + & + rxt(k,200)*y(k,29) +rxt(k,218)*y(k,34) +rxt(k,224)*y(k,44) + & + rxt(k,231)*y(k,10) +rxt(k,247)*y(k,52) +rxt(k,248)*y(k,53) + & + rxt(k,262)*y(k,69) +.200_r8*rxt(k,281)*y(k,75) + & + .500_r8*rxt(k,288)*y(k,76) +rxt(k,308)*y(k,102) + & + rxt(k,323)*y(k,111) +.500_r8*rxt(k,333)*y(k,46))*y(k,137) & + + (rxt(k,144)*y(k,41) +2.000_r8*rxt(k,214)*y(k,129) + & + rxt(k,217)*y(k,88) +rxt(k,228)*y(k,126) + & + .900_r8*rxt(k,238)*y(k,128) +rxt(k,255)*y(k,127) + & + .300_r8*rxt(k,267)*y(k,139) +.730_r8*rxt(k,274)*y(k,134) + & + rxt(k,283)*y(k,135) +rxt(k,300)*y(k,133) + & + .800_r8*rxt(k,310)*y(k,140))*y(k,129) + (rxt(k,230)*y(k,126) + & + .250_r8*rxt(k,244)*y(k,131) +rxt(k,257)*y(k,127) + & + rxt(k,265)*y(k,138) +.470_r8*rxt(k,277)*y(k,134) + & + .794_r8*rxt(k,297)*y(k,72) +.920_r8*rxt(k,302)*y(k,133) + & + rxt(k,312)*y(k,140))*y(k,88) + (rxt(k,211)*y(k,25) + & + .470_r8*rxt(k,276)*y(k,134) +.794_r8*rxt(k,298)*y(k,72) + & + rxt(k,303)*y(k,133) +rxt(k,307)*y(k,102) +rxt(k,313)*y(k,140)) & + *y(k,90) + (.130_r8*rxt(k,226)*y(k,9) +.280_r8*rxt(k,254)*y(k,13) + & + .140_r8*rxt(k,279)*y(k,74) +.280_r8*rxt(k,289)*y(k,77) + & + .370_r8*rxt(k,304)*y(k,71))*y(k,98) + (rxt(k,137)*y(k,25) + & + rxt(k,140)*y(k,57) +rxt(k,196)*y(k,26) +rxt(k,199)*y(k,29))*y(k,38) & + + (.470_r8*rxt(k,273)*y(k,134) +rxt(k,299)*y(k,133) + & + rxt(k,309)*y(k,140))*y(k,128) + (rxt(k,173)*y(k,4) + & + rxt(k,212)*y(k,97))*y(k,25) + (rxt(k,11) +rxt(k,135))*y(k,66) & + + (1.340_r8*rxt(k,36) +.660_r8*rxt(k,37))*y(k,74) + (rxt(k,245) + & + rxt(k,246))*y(k,130) +rxt(k,19)*y(k,11) +rxt(k,20)*y(k,14) +rxt(k,23) & + *y(k,28) +rxt(k,25)*y(k,31) +rxt(k,222)*y(k,136)*y(k,36) & + +2.000_r8*rxt(k,32)*y(k,52) +2.000_r8*rxt(k,33)*y(k,53) +rxt(k,100) & + *y(k,54) +rxt(k,96)*y(k,97)*y(k,57) +rxt(k,34)*y(k,69) +rxt(k,35) & + *y(k,73) +rxt(k,41)*y(k,102) +rxt(k,43)*y(k,106) & + +1.200_r8*rxt(k,227)*y(k,126)*y(k,126) + loss(k,118) = (rxt(k,302)* y(k,88) +rxt(k,303)* y(k,90) +rxt(k,299)* y(k,128) & + +rxt(k,300)* y(k,129) +rxt(k,301)* y(k,132) + het_rates(k,133)) & + * y(k,133) + prod(k,118) = (rxt(k,305)*y(k,71) +.200_r8*rxt(k,306)*y(k,73) + & + 1.640_r8*rxt(k,317)*y(k,122))*y(k,137) +1.700_r8*rxt(k,315)*y(k,122) & + *y(k,90) + loss(k,119) = ((rxt(k,277) +rxt(k,278))* y(k,88) +rxt(k,276)* y(k,90) & + +rxt(k,273)* y(k,128) +rxt(k,274)* y(k,129) +rxt(k,275)* y(k,132) & + + het_rates(k,134))* y(k,134) + prod(k,119) = (.500_r8*rxt(k,280)*y(k,74) +.200_r8*rxt(k,281)*y(k,75) + & + rxt(k,290)*y(k,77))*y(k,137) + loss(k,120) = (rxt(k,286)* y(k,88) +rxt(k,291)* y(k,89) +rxt(k,287)* y(k,90) & + +rxt(k,282)* y(k,128) +rxt(k,283)* y(k,129) +rxt(k,284)* y(k,132) & + + 2._r8*rxt(k,285)* y(k,135) + het_rates(k,135))* y(k,135) + prod(k,120) = (.660_r8*rxt(k,36) +.500_r8*rxt(k,280)*y(k,137))*y(k,74) & + + (rxt(k,38) +rxt(k,292))*y(k,76) +.500_r8*rxt(k,281)*y(k,137) & + *y(k,75) + loss(k,134) = (rxt(k,162)* y(k,16) +rxt(k,163)* y(k,17) +rxt(k,189)* y(k,18) & + +rxt(k,164)* y(k,19) +rxt(k,165)* y(k,20) +rxt(k,166)* y(k,21) & + +rxt(k,167)* y(k,22) +rxt(k,168)* y(k,23) +rxt(k,206)* y(k,24) & + +rxt(k,207)* y(k,26) + (rxt(k,221) +rxt(k,222) +rxt(k,223))* y(k,36) & + +rxt(k,190)* y(k,37) +rxt(k,86)* y(k,55) +rxt(k,191)* y(k,56) & + + (rxt(k,192) +rxt(k,193))* y(k,59) +rxt(k,208)* y(k,60) +rxt(k,209) & + * y(k,61) +rxt(k,210)* y(k,62) + (rxt(k,169) +rxt(k,170))* y(k,63) & + + (rxt(k,129) +rxt(k,130))* y(k,79) + (rxt(k,90) +rxt(k,91)) & + * y(k,98) +rxt(k,87)* y(k,141) + rxt(k,88) + rxt(k,89) & + + het_rates(k,136))* y(k,136) + prod(k,134) =rxt(k,12)*y(k,79) +rxt(k,7)*y(k,98) +rxt(k,1)*y(k,141) + loss(k,135) = (rxt(k,293)* y(k,3) +rxt(k,185)* y(k,6) +rxt(k,250)* y(k,9) & + +rxt(k,231)* y(k,10) +rxt(k,232)* y(k,11) +rxt(k,234)* y(k,12) & + +rxt(k,271)* y(k,13) +rxt(k,258)* y(k,14) +rxt(k,259)* y(k,15) & + +rxt(k,195)* y(k,24) +rxt(k,213)* y(k,25) +rxt(k,197)* y(k,26) & + +rxt(k,198)* y(k,27) +rxt(k,236)* y(k,28) +rxt(k,200)* y(k,29) & + +rxt(k,272)* y(k,30) +rxt(k,261)* y(k,31) +rxt(k,241)* y(k,32) & + +rxt(k,242)* y(k,33) +rxt(k,218)* y(k,34) +rxt(k,219)* y(k,35) & + +rxt(k,220)* y(k,36) +rxt(k,202)* y(k,37) + (rxt(k,155) +rxt(k,156)) & + * y(k,41) +rxt(k,153)* y(k,42) +rxt(k,224)* y(k,44) + (rxt(k,319) + & + rxt(k,333))* y(k,46) +rxt(k,247)* y(k,52) +rxt(k,248)* y(k,53) & + +rxt(k,104)* y(k,55) +rxt(k,105)* y(k,57) +rxt(k,187)* y(k,59) & + +rxt(k,203)* y(k,60) +rxt(k,204)* y(k,61) +rxt(k,205)* y(k,62) & + +rxt(k,158)* y(k,63) +rxt(k,134)* y(k,65) +rxt(k,112)* y(k,66) & + +rxt(k,161)* y(k,68) +rxt(k,262)* y(k,69) +rxt(k,294)* y(k,70) & + +rxt(k,305)* y(k,71) +rxt(k,306)* y(k,73) +rxt(k,280)* y(k,74) & + +rxt(k,281)* y(k,75) +rxt(k,288)* y(k,76) +rxt(k,290)* y(k,77) & + +rxt(k,125)* y(k,78) +rxt(k,335)* y(k,84) +rxt(k,133)* y(k,89) & + +rxt(k,124)* y(k,90) +rxt(k,263)* y(k,91) +rxt(k,107)* y(k,97) & + +rxt(k,108)* y(k,98) +rxt(k,321)* y(k,101) +rxt(k,308)* y(k,102) & + +rxt(k,249)* y(k,103) +rxt(k,266)* y(k,106) +rxt(k,270)* y(k,107) & + +rxt(k,327)* y(k,108) +rxt(k,332)* y(k,110) +rxt(k,323)* y(k,111) & + +rxt(k,317)* y(k,122) +rxt(k,314)* y(k,123) +rxt(k,106)* y(k,132) & + + 2._r8*(rxt(k,109) +rxt(k,110))* y(k,137) + het_rates(k,137)) & + * y(k,137) + prod(k,135) = (2.000_r8*rxt(k,98)*y(k,54) +rxt(k,101)*y(k,97) + & + rxt(k,102)*y(k,98) +rxt(k,121)*y(k,90) +rxt(k,126)*y(k,88) + & + rxt(k,142)*y(k,38) +.450_r8*rxt(k,239)*y(k,128) + & + .150_r8*rxt(k,268)*y(k,139) +.450_r8*rxt(k,284)*y(k,135) + & + .206_r8*rxt(k,296)*y(k,72))*y(k,132) + (rxt(k,95)*y(k,55) + & + rxt(k,96)*y(k,57) +rxt(k,157)*y(k,63) +rxt(k,160)*y(k,68) + & + rxt(k,186)*y(k,59) +rxt(k,188)*y(k,67) +rxt(k,212)*y(k,25))*y(k,97) & + + (rxt(k,103)*y(k,54) +.130_r8*rxt(k,226)*y(k,9) + & + .360_r8*rxt(k,254)*y(k,13) +.240_r8*rxt(k,279)*y(k,74) + & + .360_r8*rxt(k,289)*y(k,77) +.320_r8*rxt(k,304)*y(k,71) + & + 1.156_r8*rxt(k,316)*y(k,122))*y(k,98) + (rxt(k,86)*y(k,55) + & + 2.000_r8*rxt(k,87)*y(k,141) +rxt(k,169)*y(k,63) +rxt(k,192)*y(k,59) + & + rxt(k,221)*y(k,36))*y(k,136) + (.300_r8*rxt(k,219)*y(k,35) + & + .500_r8*rxt(k,232)*y(k,11) +.500_r8*rxt(k,266)*y(k,106) + & + .100_r8*rxt(k,281)*y(k,75) +.500_r8*rxt(k,314)*y(k,123))*y(k,137) & + +rxt(k,19)*y(k,11) +rxt(k,20)*y(k,14) +rxt(k,26)*y(k,33) +rxt(k,27) & + *y(k,35) +.330_r8*rxt(k,28)*y(k,36) +rxt(k,31)*y(k,51) & + +2.000_r8*rxt(k,4)*y(k,57) +rxt(k,9)*y(k,65) +rxt(k,10)*y(k,66) & + +rxt(k,75)*y(k,67) +rxt(k,76)*y(k,68) +.500_r8*rxt(k,339)*y(k,89) & + +rxt(k,43)*y(k,106) +rxt(k,44)*y(k,107) +rxt(k,45)*y(k,123) & + +rxt(k,2)*y(k,141) + loss(k,93) = (rxt(k,265)* y(k,88) +rxt(k,264)* y(k,132) + het_rates(k,138)) & + * y(k,138) + prod(k,93) = (.500_r8*rxt(k,266)*y(k,106) +rxt(k,271)*y(k,13))*y(k,137) + loss(k,108) = (rxt(k,269)* y(k,88) +rxt(k,267)* y(k,129) +rxt(k,268) & + * y(k,132) + het_rates(k,139))* y(k,139) + prod(k,108) = (rxt(k,270)*y(k,107) +rxt(k,272)*y(k,30))*y(k,137) + loss(k,115) = (rxt(k,312)* y(k,88) +rxt(k,313)* y(k,90) +rxt(k,309)* y(k,128) & + +rxt(k,310)* y(k,129) +rxt(k,311)* y(k,132) + het_rates(k,140)) & + * y(k,140) + prod(k,115) = (rxt(k,294)*y(k,70) +.800_r8*rxt(k,306)*y(k,73) + & + .500_r8*rxt(k,314)*y(k,123))*y(k,137) + loss(k,139) = (rxt(k,334)* y(k,112) +rxt(k,87)* y(k,136) + rxt(k,1) & + + rxt(k,2) + rxt(k,3) + het_rates(k,141))* y(k,141) + prod(k,139) = (rxt(k,104)*y(k,55) +rxt(k,105)*y(k,57) +rxt(k,106)*y(k,132) + & + rxt(k,109)*y(k,137) +rxt(k,112)*y(k,66) +rxt(k,134)*y(k,65) + & + rxt(k,158)*y(k,63) +rxt(k,161)*y(k,68) +rxt(k,187)*y(k,59) + & + rxt(k,195)*y(k,24) +rxt(k,197)*y(k,26) +rxt(k,198)*y(k,27) + & + rxt(k,200)*y(k,29) +rxt(k,205)*y(k,62) +rxt(k,213)*y(k,25) + & + rxt(k,219)*y(k,35) +rxt(k,220)*y(k,36) +rxt(k,234)*y(k,12) + & + rxt(k,236)*y(k,28) +rxt(k,241)*y(k,32) +rxt(k,242)*y(k,33) + & + rxt(k,258)*y(k,14) +rxt(k,259)*y(k,15) +rxt(k,261)*y(k,31) + & + rxt(k,266)*y(k,106) +rxt(k,270)*y(k,107) +rxt(k,272)*y(k,30) + & + .500_r8*rxt(k,280)*y(k,74) +rxt(k,335)*y(k,84))*y(k,137) & + + (rxt(k,344)*y(k,68) +rxt(k,350)*y(k,68) +rxt(k,351)*y(k,67) + & + rxt(k,355)*y(k,68) +rxt(k,356)*y(k,67))*y(k,63) + (rxt(k,336) + & + rxt(k,99)*y(k,54))*y(k,132) +.050_r8*rxt(k,28)*y(k,36) +rxt(k,79) & + *y(k,58) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..e9e70b0ea6 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_rxt_rates_conv.F90 @@ -0,0 +1,375 @@ +module mo_rxt_rates_conv + use shr_kind_mod, only : r8 => shr_kind_r8 + implicit none + private + public :: set_rates +contains + subroutine set_rates( rxt_rates, sol, ncol ) + real(r8), intent(inout) :: rxt_rates(:,:,:) + real(r8), intent(in) :: sol(:,:,:) + integer, intent(in) :: ncol + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 141) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 141) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 141) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 57) ! rate_const*H2O2 + ! rate_const*O2 + ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 98) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 98) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 65) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 66) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 66) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 79) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 80) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 80) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 88) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 89) ! rate_const*NO2 + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 90) ! rate_const*NO3 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 90) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 11) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 14) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 25) ! rate_const*CH2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 25) ! rate_const*CH2O + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 28) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 30) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 31) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 33) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 35) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 36) ! rate_const*CH4 + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 36) ! rate_const*CH4 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 45) ! rate_const*CO2 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 51) ! rate_const*EOOH + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 52) ! rate_const*GLYALD + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 53) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 69) ! rate_const*HYAC + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 73) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 74) ! rate_const*MACR + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 74) ! rate_const*MACR + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 76) ! rate_const*MPAN + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 77) ! rate_const*MVK + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 91) ! rate_const*NOA + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 102) ! rate_const*ONITR + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 103) ! rate_const*PAN + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 106) ! rate_const*POOH + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 107) ! rate_const*ROOH + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 123) ! rate_const*XOOH + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 5) ! rate_const*BRCL + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 6) ! rate_const*BRO + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 7) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 7) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 16) ! rate_const*CCL4 + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 17) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 18) ! rate_const*CF3BR + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 19) ! rate_const*CFC11 + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 20) ! rate_const*CFC113 + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 21) ! rate_const*CFC114 + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 22) ! rate_const*CFC115 + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 23) ! rate_const*CFC12 + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 24) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 26) ! rate_const*CH3BR + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 27) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 29) ! rate_const*CH3CL + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 37) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 39) ! rate_const*CL2 + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 40) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 41) ! rate_const*CLO + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 42) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 42) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 56) ! rate_const*H2402 + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 59) ! rate_const*HBR + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 60) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 61) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 62) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 63) ! rate_const*HCL + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 64) ! rate_const*HF + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 67) ! rate_const*HOBR + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 68) ! rate_const*HOCL + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 100) ! rate_const*OCLO + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 109) ! rate_const*SF6 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 58) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 101) ! rate_const*OCS + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 110) ! rate_const*SO + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 111) ! rate_const*SO2 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 112) ! rate_const*SO3 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 117) ! rate_const*soa_a1 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 118) ! rate_const*soa_a2 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 136)*sol(:ncol,:, 55) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 136)*sol(:ncol,:, 141) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 136) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 136) ! rate_const*O2*O1D + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 136)*sol(:ncol,:, 98) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 136)*sol(:ncol,:, 98) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 97)*sol(:ncol,:, 98) ! rate_const*O*O3 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 97)*sol(:ncol,:, 97) ! rate_const*M*O*O + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 97) ! rate_const*O2*M*O + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 55)*sol(:ncol,:, 97) ! rate_const*H2*O + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 57)*sol(:ncol,:, 97) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 54)*sol(:ncol,:, 132) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 54)*sol(:ncol,:, 132) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 54)*sol(:ncol,:, 132) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 54) ! rate_const*O2*M*H + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 132)*sol(:ncol,:, 97) ! rate_const*HO2*O + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 132)*sol(:ncol,:, 98) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 54)*sol(:ncol,:, 98) ! rate_const*H*O3 + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 137)*sol(:ncol,:, 55) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 137)*sol(:ncol,:, 57) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 137)*sol(:ncol,:, 132) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 137)*sol(:ncol,:, 97) ! rate_const*OH*O + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 137)*sol(:ncol,:, 98) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 137)*sol(:ncol,:, 137) ! rate_const*OH*OH + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 137)*sol(:ncol,:, 137) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 132)*sol(:ncol,:, 132) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 66)*sol(:ncol,:, 137) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 78)*sol(:ncol,:, 88) ! rate_const*N*NO + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 78)*sol(:ncol,:, 89) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 78)*sol(:ncol,:, 89) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 78)*sol(:ncol,:, 89) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 78) ! rate_const*O2*N + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 89)*sol(:ncol,:, 97) ! rate_const*NO2*O + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 89)*sol(:ncol,:, 98) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 89)*sol(:ncol,:, 97) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 90)*sol(:ncol,:, 132) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 90)*sol(:ncol,:, 88) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 90)*sol(:ncol,:, 97) ! rate_const*NO3*O + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 90)*sol(:ncol,:, 137) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 78)*sol(:ncol,:, 137) ! rate_const*N*OH + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 88)*sol(:ncol,:, 132) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 88)*sol(:ncol,:, 98) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 88)*sol(:ncol,:, 97) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 136)*sol(:ncol,:, 79) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 136)*sol(:ncol,:, 79) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 89)*sol(:ncol,:, 132) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 89)*sol(:ncol,:, 90) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 89)*sol(:ncol,:, 137) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 65)*sol(:ncol,:, 137) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 66) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 80) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 38)*sol(:ncol,:, 25) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 38)*sol(:ncol,:, 36) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 38)*sol(:ncol,:, 55) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 38)*sol(:ncol,:, 57) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 38)*sol(:ncol,:, 132) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 38)*sol(:ncol,:, 132) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 38)*sol(:ncol,:, 98) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 41)*sol(:ncol,:, 129) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 41)*sol(:ncol,:, 41) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 41)*sol(:ncol,:, 41) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 41)*sol(:ncol,:, 41) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 41)*sol(:ncol,:, 132) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 41)*sol(:ncol,:, 88) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 42)*sol(:ncol,:, 38) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 41)*sol(:ncol,:, 89) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 42)*sol(:ncol,:, 97) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 42)*sol(:ncol,:, 137) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 41)*sol(:ncol,:, 97) ! rate_const*CLO*O + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 41)*sol(:ncol,:, 137) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 41)*sol(:ncol,:, 137) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 63)*sol(:ncol,:, 97) ! rate_const*HCL*O + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 63)*sol(:ncol,:, 137) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 68)*sol(:ncol,:, 38) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 68)*sol(:ncol,:, 97) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 68)*sol(:ncol,:, 137) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 136)*sol(:ncol,:, 16) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 136)*sol(:ncol,:, 17) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 136)*sol(:ncol,:, 19) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 136)*sol(:ncol,:, 20) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 136)*sol(:ncol,:, 21) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 136)*sol(:ncol,:, 22) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 136)*sol(:ncol,:, 23) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 136)*sol(:ncol,:, 63) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 136)*sol(:ncol,:, 63) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 41)*sol(:ncol,:, 41) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 40) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 4)*sol(:ncol,:, 25) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 4)*sol(:ncol,:, 132) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 4)*sol(:ncol,:, 98) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 6)*sol(:ncol,:, 6) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 6)*sol(:ncol,:, 41) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 6)*sol(:ncol,:, 41) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 6)*sol(:ncol,:, 41) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 6)*sol(:ncol,:, 132) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 6)*sol(:ncol,:, 88) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 6)*sol(:ncol,:, 89) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 7)*sol(:ncol,:, 97) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 6)*sol(:ncol,:, 97) ! rate_const*BRO*O + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 6)*sol(:ncol,:, 137) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 59)*sol(:ncol,:, 97) ! rate_const*HBR*O + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 59)*sol(:ncol,:, 137) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 67)*sol(:ncol,:, 97) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 136)*sol(:ncol,:, 18) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 136)*sol(:ncol,:, 37) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 136)*sol(:ncol,:, 56) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 136)*sol(:ncol,:, 59) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 136)*sol(:ncol,:, 59) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 24)*sol(:ncol,:, 38) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 24)*sol(:ncol,:, 137) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 26)*sol(:ncol,:, 38) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 26)*sol(:ncol,:, 137) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 27)*sol(:ncol,:, 137) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 29)*sol(:ncol,:, 38) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 29)*sol(:ncol,:, 137) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 37)*sol(:ncol,:, 38) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 37)*sol(:ncol,:, 137) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 60)*sol(:ncol,:, 137) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 61)*sol(:ncol,:, 137) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 62)*sol(:ncol,:, 137) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 136)*sol(:ncol,:, 24) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 136)*sol(:ncol,:, 26) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 136)*sol(:ncol,:, 60) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 136)*sol(:ncol,:, 61) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 136)*sol(:ncol,:, 62) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 25)*sol(:ncol,:, 90) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 25)*sol(:ncol,:, 97) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 25)*sol(:ncol,:, 137) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 129)*sol(:ncol,:, 129) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 129)*sol(:ncol,:, 129) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 129)*sol(:ncol,:, 132) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 129)*sol(:ncol,:, 88) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 34)*sol(:ncol,:, 137) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 35)*sol(:ncol,:, 137) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 36)*sol(:ncol,:, 137) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 136)*sol(:ncol,:, 36) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 136)*sol(:ncol,:, 36) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 136)*sol(:ncol,:, 36) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 44)*sol(:ncol,:, 137) ! rate_const*CO*OH + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 9)*sol(:ncol,:, 38) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 9)*sol(:ncol,:, 98) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 126)*sol(:ncol,:, 126) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 126)*sol(:ncol,:, 129) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 126)*sol(:ncol,:, 132) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 126)*sol(:ncol,:, 88) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 10)*sol(:ncol,:, 137) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 11)*sol(:ncol,:, 137) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 12)*sol(:ncol,:, 38) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 12)*sol(:ncol,:, 137) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 28)*sol(:ncol,:, 90) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 28)*sol(:ncol,:, 137) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 128)*sol(:ncol,:, 128) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 128)*sol(:ncol,:, 129) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 128)*sol(:ncol,:, 132) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 128)*sol(:ncol,:, 88) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 32)*sol(:ncol,:, 137) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 33)*sol(:ncol,:, 137) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 131)*sol(:ncol,:, 132) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 131)*sol(:ncol,:, 88) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 130) ! rate_const*EO + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 130) ! rate_const*O2*EO + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 52)*sol(:ncol,:, 137) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 53)*sol(:ncol,:, 137) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 103)*sol(:ncol,:, 137) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 9)*sol(:ncol,:, 137) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 128)*sol(:ncol,:, 89) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 103) ! rate_const*M*PAN + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 13)*sol(:ncol,:, 90) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 13)*sol(:ncol,:, 98) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 127)*sol(:ncol,:, 129) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 127)*sol(:ncol,:, 132) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 127)*sol(:ncol,:, 88) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 14)*sol(:ncol,:, 137) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 15)*sol(:ncol,:, 137) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 31)*sol(:ncol,:, 90) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 31)*sol(:ncol,:, 137) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 69)*sol(:ncol,:, 137) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 91)*sol(:ncol,:, 137) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 138)*sol(:ncol,:, 132) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 138)*sol(:ncol,:, 88) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 106)*sol(:ncol,:, 137) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 139)*sol(:ncol,:, 129) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 139)*sol(:ncol,:, 132) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 139)*sol(:ncol,:, 88) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 107)*sol(:ncol,:, 137) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 13)*sol(:ncol,:, 137) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 30)*sol(:ncol,:, 137) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 134)*sol(:ncol,:, 128) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 134)*sol(:ncol,:, 129) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 134)*sol(:ncol,:, 132) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 134)*sol(:ncol,:, 90) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 134)*sol(:ncol,:, 88) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 134)*sol(:ncol,:, 88) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 74)*sol(:ncol,:, 98) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 74)*sol(:ncol,:, 137) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 75)*sol(:ncol,:, 137) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 135)*sol(:ncol,:, 128) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 135)*sol(:ncol,:, 129) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 135)*sol(:ncol,:, 132) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 135)*sol(:ncol,:, 135) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 135)*sol(:ncol,:, 88) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 135)*sol(:ncol,:, 90) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 76)*sol(:ncol,:, 137) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 77)*sol(:ncol,:, 98) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 77)*sol(:ncol,:, 137) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 135)*sol(:ncol,:, 89) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 76) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 3)*sol(:ncol,:, 137) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 70)*sol(:ncol,:, 137) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 71)*sol(:ncol,:, 90) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 72)*sol(:ncol,:, 132) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 72)*sol(:ncol,:, 88) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 72)*sol(:ncol,:, 90) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 133)*sol(:ncol,:, 128) ! rate_const*ISOPO2*CH3CO3 + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 133)*sol(:ncol,:, 129) ! rate_const*ISOPO2*CH3O2 + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 133)*sol(:ncol,:, 132) ! rate_const*ISOPO2*HO2 + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 133)*sol(:ncol,:, 88) ! rate_const*ISOPO2*NO + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 133)*sol(:ncol,:, 90) ! rate_const*ISOPO2*NO3 + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 71)*sol(:ncol,:, 98) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 71)*sol(:ncol,:, 137) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 73)*sol(:ncol,:, 137) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 102)*sol(:ncol,:, 90) ! rate_const*ONITR*NO3 + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 102)*sol(:ncol,:, 137) ! rate_const*ONITR*OH + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 140)*sol(:ncol,:, 128) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 140)*sol(:ncol,:, 129) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 140)*sol(:ncol,:, 132) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 140)*sol(:ncol,:, 88) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 140)*sol(:ncol,:, 90) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 123)*sol(:ncol,:, 137) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 122)*sol(:ncol,:, 90) ! rate_const*TERP*NO3 + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 122)*sol(:ncol,:, 98) ! rate_const*TERP*O3 + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 122)*sol(:ncol,:, 137) ! rate_const*TERP*OH + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 46)*sol(:ncol,:, 90) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 46)*sol(:ncol,:, 137) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 101)*sol(:ncol,:, 97) ! rate_const*OCS*O + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 101)*sol(:ncol,:, 137) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 108) ! rate_const*O2*S + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 111)*sol(:ncol,:, 137) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 108)*sol(:ncol,:, 98) ! rate_const*S*O3 + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 110)*sol(:ncol,:, 6) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 110)*sol(:ncol,:, 41) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 108)*sol(:ncol,:, 137) ! rate_const*S*OH + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 110)*sol(:ncol,:, 89) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 110) ! rate_const*O2*SO + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 110)*sol(:ncol,:, 98) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 110)*sol(:ncol,:, 100) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 110)*sol(:ncol,:, 137) ! rate_const*SO*OH + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 46)*sol(:ncol,:, 137) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 112)*sol(:ncol,:, 141) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 84)*sol(:ncol,:, 137) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 132) ! rate_const*HO2 + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 80) ! rate_const*N2O5 + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 85) ! rate_const*NH4 + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 89) ! rate_const*NO2 + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 90) ! rate_const*NO3 + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 102) ! rate_const*ONITR + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 119) ! rate_const*SOAE + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 80) ! rate_const*N2O5 + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 68)*sol(:ncol,:, 63) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 7) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 80) ! rate_const*N2O5 + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 42) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 7) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 42)*sol(:ncol,:, 63) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 68)*sol(:ncol,:, 63) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 67)*sol(:ncol,:, 63) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 42) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 7) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 42)*sol(:ncol,:, 63) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 68)*sol(:ncol,:, 63) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 67)*sol(:ncol,:, 63) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 80) ! rate_const*N2O5 + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 42) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 42)*sol(:ncol,:, 63) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 50) ! rate_const*E90 + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 87) ! rate_const*NH_50 + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 86) ! rate_const*NH_5 + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 121) ! rate_const*ST80_25 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_setrxt.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_setrxt.F90 new file mode 100644 index 0000000000..781067fcc2 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_setrxt.F90 @@ -0,0 +1,454 @@ + + module mo_setrxt + + use shr_kind_mod, only : r8 => shr_kind_r8 + + private + public :: setrxt + public :: setrxt_hrates + + contains + + subroutine setrxt( rate, temp, m, ncol ) + + use ppgrid, only : pcols, pver + + + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol*pver) + real(r8), intent(inout) :: rate(ncol*pver,max(1,rxntot)) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + integer :: offset + real(r8) :: itemp(ncol*pver) + real(r8) :: exp_fac(ncol*pver) + real(r8) :: ko(ncol*pver) + real(r8) :: kinf(ncol*pver) + + rate(:,86) = 1.2e-10_r8 + rate(:,90) = 1.2e-10_r8 + rate(:,91) = 1.2e-10_r8 + rate(:,97) = 6.9e-12_r8 + rate(:,98) = 7.2e-11_r8 + rate(:,99) = 1.6e-12_r8 + rate(:,105) = 1.8e-12_r8 + rate(:,109) = 1.8e-12_r8 + rate(:,121) = 3.5e-12_r8 + rate(:,123) = 1.3e-11_r8 + rate(:,124) = 2.2e-11_r8 + rate(:,125) = 5e-11_r8 + rate(:,160) = 1.7e-13_r8 + rate(:,162) = 2.607e-10_r8 + rate(:,163) = 9.75e-11_r8 + rate(:,164) = 2.07e-10_r8 + rate(:,165) = 2.088e-10_r8 + rate(:,166) = 1.17e-10_r8 + rate(:,167) = 4.644e-11_r8 + rate(:,168) = 1.204e-10_r8 + rate(:,169) = 9.9e-11_r8 + rate(:,170) = 3.3e-12_r8 + rate(:,189) = 4.5e-11_r8 + rate(:,190) = 4.62e-10_r8 + rate(:,191) = 1.2e-10_r8 + rate(:,192) = 9e-11_r8 + rate(:,193) = 3e-11_r8 + rate(:,206) = 2.57e-10_r8 + rate(:,207) = 1.8e-10_r8 + rate(:,208) = 1.794e-10_r8 + rate(:,209) = 1.3e-10_r8 + rate(:,210) = 7.65e-11_r8 + rate(:,221) = 1.31e-10_r8 + rate(:,222) = 3.5e-11_r8 + rate(:,223) = 9e-12_r8 + rate(:,227) = 6.8e-14_r8 + rate(:,228) = 2e-13_r8 + rate(:,242) = 1e-12_r8 + rate(:,246) = 1e-14_r8 + rate(:,247) = 1e-11_r8 + rate(:,248) = 1.15e-11_r8 + rate(:,249) = 4e-14_r8 + rate(:,262) = 3e-12_r8 + rate(:,263) = 6.7e-13_r8 + rate(:,273) = 1.4e-11_r8 + rate(:,276) = 2.4e-12_r8 + rate(:,287) = 5e-12_r8 + rate(:,293) = 3.5e-12_r8 + rate(:,298) = 2.4e-12_r8 + rate(:,299) = 1.4e-11_r8 + rate(:,303) = 2.4e-12_r8 + rate(:,308) = 4.5e-11_r8 + rate(:,313) = 2.4e-12_r8 + rate(:,322) = 2.3e-12_r8 + rate(:,324) = 1.2e-11_r8 + rate(:,325) = 5.7e-11_r8 + rate(:,326) = 2.8e-11_r8 + rate(:,327) = 6.6e-11_r8 + rate(:,328) = 1.4e-11_r8 + rate(:,331) = 1.9e-12_r8 + rate(:,338) = 6.34e-08_r8 + rate(:,342) = 1.157e-05_r8 + rate(:,360) = 1.29e-07_r8 + rate(:,361) = 2.31e-07_r8 + rate(:,362) = 2.31e-06_r8 + rate(:,363) = 4.63e-07_r8 + + do n = 1,pver + offset = (n-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,n) + end do + + rate(:,87) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,88) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:,89) = 3.3e-11_r8 * exp( 55._r8 * itemp(:) ) + rate(:,92) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,95) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + exp_fac(:) = exp( -2000._r8 * itemp(:) ) + rate(:,96) = 1.4e-12_r8 * exp_fac(:) + rate(:,304) = 1.05e-14_r8 * exp_fac(:) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,101) = 3e-11_r8 * exp_fac(:) + rate(:,187) = 5.5e-12_r8 * exp_fac(:) + rate(:,219) = 3.8e-12_r8 * exp_fac(:) + rate(:,232) = 3.8e-12_r8 * exp_fac(:) + rate(:,258) = 3.8e-12_r8 * exp_fac(:) + rate(:,266) = 3.8e-12_r8 * exp_fac(:) + rate(:,270) = 3.8e-12_r8 * exp_fac(:) + rate(:,281) = 2.3e-11_r8 * exp_fac(:) + rate(:,306) = 1.52e-11_r8 * exp_fac(:) + rate(:,314) = 1.52e-12_r8 * exp_fac(:) + rate(:,102) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,103) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,104) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,106) = 4.8e-11_r8 * exp_fac(:) + rate(:,185) = 1.7e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 180._r8 * itemp(:) ) + rate(:,107) = 1.8e-11_r8 * exp_fac(:) + rate(:,244) = 4.2e-12_r8 * exp_fac(:) + rate(:,257) = 4.2e-12_r8 * exp_fac(:) + rate(:,265) = 4.2e-12_r8 * exp_fac(:) + rate(:,302) = 4.4e-12_r8 * exp_fac(:) + rate(:,108) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,112) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) + rate(:,113) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,114) = 2.9e-12_r8 * exp_fac(:) + rate(:,115) = 1.45e-12_r8 * exp_fac(:) + rate(:,116) = 1.45e-12_r8 * exp_fac(:) + rate(:,117) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:,118) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,119) = 1.2e-13_r8 * exp_fac(:) + rate(:,145) = 3e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,122) = 1.7e-11_r8 * exp_fac(:) + rate(:,213) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,126) = 3.44e-12_r8 * exp_fac(:) + rate(:,178) = 2.3e-12_r8 * exp_fac(:) + rate(:,181) = 8.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,127) = 3e-12_r8 * exp_fac(:) + rate(:,186) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,129) = 7.26e-11_r8 * exp_fac(:) + rate(:,130) = 4.64e-11_r8 * exp_fac(:) + rate(:,137) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,138) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,139) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,140) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,141) = 1.4e-11_r8 * exp_fac(:) + rate(:,155) = 7.4e-12_r8 * exp_fac(:) + rate(:,240) = 8.1e-12_r8 * exp_fac(:) + rate(:,142) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,143) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,144) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,146) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,147) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,148) = 2.6e-12_r8 * exp_fac(:) + rate(:,149) = 6.4e-12_r8 * exp_fac(:) + rate(:,179) = 4.1e-13_r8 * exp_fac(:) + rate(:,150) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,152) = 3.6e-12_r8 * exp_fac(:) + rate(:,195) = 2e-12_r8 * exp_fac(:) + rate(:,153) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,154) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,156) = 6e-13_r8 * exp_fac(:) + rate(:,176) = 1.5e-12_r8 * exp_fac(:) + rate(:,184) = 1.9e-11_r8 * exp_fac(:) + rate(:,157) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,158) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,159) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + rate(:,161) = 3e-12_r8 * exp( -500._r8 * itemp(:) ) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,173) = 1.7e-11_r8 * exp_fac(:) + rate(:,194) = 6.3e-12_r8 * exp_fac(:) + rate(:,174) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,175) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,177) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + rate(:,180) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,183) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,188) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,196) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,197) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + exp_fac(:) = exp( -1520._r8 * itemp(:) ) + rate(:,198) = 1.64e-12_r8 * exp_fac(:) + rate(:,289) = 8.5e-16_r8 * exp_fac(:) + exp_fac(:) = exp( -1100._r8 * itemp(:) ) + rate(:,199) = 2.03e-11_r8 * exp_fac(:) + rate(:,330) = 3.4e-12_r8 * exp_fac(:) + rate(:,200) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,201) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,202) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,203) = 1.25e-12_r8 * exp_fac(:) + rate(:,212) = 3.4e-11_r8 * exp_fac(:) + rate(:,204) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,205) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,211) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,214) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) + rate(:,215) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) + rate(:,216) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + exp_fac(:) = exp( 300._r8 * itemp(:) ) + rate(:,217) = 2.8e-12_r8 * exp_fac(:) + rate(:,269) = 2.9e-12_r8 * exp_fac(:) + rate(:,218) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) + rate(:,220) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + rate(:,226) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + exp_fac(:) = exp( 700._r8 * itemp(:) ) + rate(:,229) = 7.5e-13_r8 * exp_fac(:) + rate(:,243) = 7.5e-13_r8 * exp_fac(:) + rate(:,256) = 7.5e-13_r8 * exp_fac(:) + rate(:,264) = 7.5e-13_r8 * exp_fac(:) + rate(:,268) = 8.6e-13_r8 * exp_fac(:) + rate(:,275) = 8e-13_r8 * exp_fac(:) + rate(:,296) = 8e-13_r8 * exp_fac(:) + rate(:,301) = 8e-13_r8 * exp_fac(:) + rate(:,311) = 8e-13_r8 * exp_fac(:) + rate(:,230) = 2.6e-12_r8 * exp( 365._r8 * itemp(:) ) + rate(:,231) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,233) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,234) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + exp_fac(:) = exp( -1900._r8 * itemp(:) ) + rate(:,235) = 1.4e-12_r8 * exp_fac(:) + rate(:,254) = 6.5e-15_r8 * exp_fac(:) + rate(:,236) = 4.63e-12_r8 * exp( 350._r8 * itemp(:) ) + exp_fac(:) = exp( 500._r8 * itemp(:) ) + rate(:,237) = 2.9e-12_r8 * exp_fac(:) + rate(:,238) = 2e-12_r8 * exp_fac(:) + rate(:,267) = 7.1e-13_r8 * exp_fac(:) + rate(:,283) = 2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 1040._r8 * itemp(:) ) + rate(:,239) = 4.3e-13_r8 * exp_fac(:) + rate(:,284) = 4.3e-13_r8 * exp_fac(:) + rate(:,241) = 3.15e-14_r8 * exp( 920._r8 * itemp(:) ) + rate(:,245) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,253) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,255) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,259) = 9.19e-12_r8 * exp( -630._r8 * itemp(:) ) + exp_fac(:) = exp( -1860._r8 * itemp(:) ) + rate(:,260) = 1.4e-12_r8 * exp_fac(:) + rate(:,307) = 1.4e-12_r8 * exp_fac(:) + rate(:,261) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + exp_fac(:) = exp( 400._r8 * itemp(:) ) + rate(:,274) = 5e-13_r8 * exp_fac(:) + rate(:,300) = 5e-13_r8 * exp_fac(:) + rate(:,310) = 5e-13_r8 * exp_fac(:) + exp_fac(:) = exp( 360._r8 * itemp(:) ) + rate(:,277) = 2.7e-12_r8 * exp_fac(:) + rate(:,278) = 1.3e-13_r8 * exp_fac(:) + rate(:,280) = 9.6e-12_r8 * exp_fac(:) + rate(:,286) = 5.3e-12_r8 * exp_fac(:) + rate(:,297) = 2.7e-12_r8 * exp_fac(:) + rate(:,312) = 2.7e-12_r8 * exp_fac(:) + rate(:,279) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) + exp_fac(:) = exp( 530._r8 * itemp(:) ) + rate(:,282) = 4.6e-12_r8 * exp_fac(:) + rate(:,285) = 2.3e-12_r8 * exp_fac(:) + rate(:,290) = 4.13e-12_r8 * exp( 452._r8 * itemp(:) ) + rate(:,294) = 1.86e-11_r8 * exp( 175._r8 * itemp(:) ) + rate(:,295) = 3.03e-12_r8 * exp( -446._r8 * itemp(:) ) + rate(:,305) = 2.54e-11_r8 * exp( 410._r8 * itemp(:) ) + rate(:,309) = 1.3e-12_r8 * exp( 640._r8 * itemp(:) ) + rate(:,315) = 1.2e-12_r8 * exp( 490._r8 * itemp(:) ) + rate(:,316) = 6.3e-16_r8 * exp( -580._r8 * itemp(:) ) + rate(:,317) = 1.2e-11_r8 * exp( 440._r8 * itemp(:) ) + rate(:,318) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,319) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,320) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,321) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,329) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,332) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) + rate(:,335) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + + itemp(:) = 300._r8 * itemp(:) + + n = ncol*pver + + ko(:) = 5.3e-32_r8 * itemp(:)**1.8_r8 + kinf(:) = 9.5e-11_r8 * itemp(:)**(-0.4_r8) + call jpl( rate(:,100), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,110), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.5e-31_r8 * itemp(:)**1.8_r8 + kinf(:) = 2.2e-11_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,120), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,128), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.9e-31_r8 * itemp(:)**3.4_r8 + kinf(:) = 4e-12_r8 * itemp(:)**0.3_r8 + call jpl( rate(:,131), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.4e-30_r8 * itemp(:)**3._r8 + kinf(:) = 1.6e-12_r8 * itemp(:)**(-0.1_r8) + call jpl( rate(:,132), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,133), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-31_r8 * itemp(:)**3.4_r8 + kinf(:) = 1.5e-11_r8 * itemp(:)**1.9_r8 + call jpl( rate(:,151), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.9e-32_r8 * itemp(:)**3.6_r8 + kinf(:) = 3.7e-12_r8 * itemp(:)**1.6_r8 + call jpl( rate(:,171), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.2e-31_r8 * itemp(:)**3.2_r8 + kinf(:) = 6.9e-12_r8 * itemp(:)**2.9_r8 + call jpl( rate(:,182), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.6e-29_r8 * itemp(:)**3.3_r8 + kinf(:) = 3.1e-10_r8 * itemp(:) + call jpl( rate(:,225), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8.6e-29_r8 * itemp(:)**3.1_r8 + kinf(:) = 9e-12_r8 * itemp(:)**0.85_r8 + call jpl( rate(:,250), m, 0.48_r8, ko, kinf, n ) + + ko(:) = 7.3e-29_r8 * itemp(:)**4.1_r8 + kinf(:) = 9.5e-12_r8 * itemp(:)**1.6_r8 + call jpl( rate(:,251), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,271), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,288), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 9.7e-29_r8 * itemp(:)**5.6_r8 + kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 + call jpl( rate(:,291), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 2.9e-31_r8 * itemp(:)**4.1_r8 + kinf(:) = 1.7e-12_r8 * itemp(:)**(-0.2_r8) + call jpl( rate(:,323), m, 0.6_r8, ko, kinf, n ) + + end subroutine setrxt + + + subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + + use ppgrid, only : pcols, pver + + + use chem_mods, only : rxntot + use mo_jpl, only : jpl + + implicit none + +!------------------------------------------------------- +! ... dummy arguments +!------------------------------------------------------- + integer, intent(in) :: ncol + integer, intent(in) :: kbot + real(r8), intent(in) :: temp(pcols,pver) + real(r8), intent(in) :: m(ncol*pver) + real(r8), intent(inout) :: rate(ncol*pver,max(1,rxntot)) + +!------------------------------------------------------- +! ... local variables +!------------------------------------------------------- + integer :: n + integer :: offset + integer :: k + real(r8) :: itemp(ncol*kbot) + real(r8) :: exp_fac(ncol*kbot) + real(r8) :: ko(ncol*kbot) + real(r8) :: kinf(ncol*kbot) + real(r8) :: wrk(ncol*kbot) + + n = ncol*kbot + + rate(:n,97) = 6.9e-12_r8 + + do k = 1,kbot + offset = (k-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,k) + end do + + rate(:n,88) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:n,92) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,101) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,102) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,103) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,106) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,107) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,108) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,113) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,117) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:n,118) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,126) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) + rate(:n,127) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) + + itemp(:) = 300._r8 * itemp(:) + + ko(:) = 5.3e-32_r8 * itemp(:)**1.8_r8 + kinf(:) = 9.5e-11_r8 * itemp(:)**(-0.4_r8) + call jpl( wrk, m, 0.6_r8, ko, kinf, n ) + rate(:n,100) = wrk(:) + + + + + + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_trop_strat_mam5_ts4/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_mam5_ts4/mo_sim_dat.F90 new file mode 100644 index 0000000000..b70148648c --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_ts4/mo_sim_dat.F90 @@ -0,0 +1,572 @@ + + module mo_sim_dat + + private + public :: set_sim_dat + + contains + + subroutine set_sim_dat + + use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass + use chem_mods, only : diag_map + use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map + use chem_mods, only : pht_alias_lst, pht_alias_mult + use chem_mods, only : extfrc_lst, inv_lst, slvd_lst + use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot + use cam_abortutils,only : endrun + use mo_tracname, only : solsym + use chem_mods, only : frc_from_dataset + use chem_mods, only : is_scalar, is_vector + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only : iulog + + implicit none + +!-------------------------------------------------------------- +! ... local variables +!-------------------------------------------------------------- + integer :: ios + + is_scalar = .false. + is_vector = .true. + + clscnt(:) = (/ 2, 0, 0, 139, 0 /) + + cls_rxt_cnt(:,1) = (/ 3, 0, 0, 2 /) + cls_rxt_cnt(:,4) = (/ 2, 117, 244, 139 /) + + solsym(:141) = (/ 'bc_a1 ','bc_a4 ','BIGALK ','BR ','BRCL ', & + 'BRO ','BRONO2 ','BRY ','C2H4 ','C2H5OH ', & + 'C2H5OOH ','C2H6 ','C3H6 ','C3H7OOH ','C3H8 ', & + 'CCL4 ','CF2CLBR ','CF3BR ','CFC11 ','CFC113 ', & + 'CFC114 ','CFC115 ','CFC12 ','CH2BR2 ','CH2O ', & + 'CH3BR ','CH3CCL3 ','CH3CHO ','CH3CL ','CH3COCH3 ', & + 'CH3COCHO ','CH3COOH ','CH3COOOH ','CH3OH ','CH3OOH ', & + 'CH4 ','CHBR3 ','CL ','CL2 ','CL2O2 ', & + 'CLO ','CLONO2 ','CLY ','CO ','CO2 ', & + 'DMS ','dst_a1 ','dst_a2 ','dst_a3 ','E90 ', & + 'EOOH ','GLYALD ','GLYOXAL ','H ','H2 ', & + 'H2402 ','H2O2 ','H2SO4 ','HBR ','HCFC141B ', & + 'HCFC142B ','HCFC22 ','HCL ','HF ','HNO3 ', & + 'HO2NO2 ','HOBR ','HOCL ','HYAC ','HYDRALD ', & + 'ISOP ','ISOPNO3 ','ISOPOOH ','MACR ','MACROOH ', & + 'MPAN ','MVK ','N ','N2O ','N2O5 ', & + 'ncl_a1 ','ncl_a2 ','ncl_a3 ','NH3 ','NH4 ', & + 'NH_5 ','NH_50 ','NO ','NO2 ','NO3 ', & + 'NOA ','num_a1 ','num_a2 ','num_a3 ','num_a4 ', & + 'num_a5 ','O ','O3 ','O3S ','OCLO ', & + 'OCS ','ONITR ','PAN ','pom_a1 ','pom_a4 ', & + 'POOH ','ROOH ','S ','SF6 ','SO ', & + 'SO2 ','SO3 ','so4_a1 ','so4_a2 ','so4_a3 ', & + 'so4_a5 ','soa_a1 ','soa_a2 ','SOAE ','SOAG ', & + 'ST80_25 ','TERP ','XOOH ','NHDEP ','NDEP ', & + 'C2H5O2 ','C3H7O2 ','CH3CO3 ','CH3O2 ','EO ', & + 'EO2 ','HO2 ','ISOPO2 ','MACRO2 ','MCO3 ', & + 'O1D ','OH ','PO2 ','RO2 ','XO2 ', & + 'H2O ' /) + + adv_mass(:141) = (/ 12.011000_r8, 12.011000_r8, 72.143800_r8, 79.904000_r8, 115.356700_r8, & + 95.903400_r8, 141.908940_r8, 99.716850_r8, 28.051600_r8, 46.065800_r8, & + 62.065200_r8, 30.066400_r8, 42.077400_r8, 76.091000_r8, 44.092200_r8, & + 153.821800_r8, 165.364506_r8, 148.910210_r8, 137.367503_r8, 187.375310_r8, & + 170.921013_r8, 154.466716_r8, 120.913206_r8, 173.833800_r8, 30.025200_r8, & + 94.937200_r8, 133.402300_r8, 44.051000_r8, 50.485900_r8, 58.076800_r8, & + 72.061400_r8, 60.050400_r8, 76.049800_r8, 32.040000_r8, 48.039400_r8, & + 16.040600_r8, 252.730400_r8, 35.452700_r8, 70.905400_r8, 102.904200_r8, & + 51.452100_r8, 97.457640_r8, 100.916850_r8, 28.010400_r8, 44.009800_r8, & + 62.132400_r8, 135.064039_r8, 135.064039_r8, 135.064039_r8, 28.010400_r8, & + 78.064600_r8, 60.050400_r8, 58.035600_r8, 1.007400_r8, 2.014800_r8, & + 259.823613_r8, 34.013600_r8, 98.078400_r8, 80.911400_r8, 116.948003_r8, & + 100.493706_r8, 86.467906_r8, 36.460100_r8, 20.005803_r8, 63.012340_r8, & + 79.011740_r8, 96.910800_r8, 52.459500_r8, 74.076200_r8, 100.113000_r8, & + 68.114200_r8, 162.117940_r8, 118.127200_r8, 70.087800_r8, 120.100800_r8, & + 147.084740_r8, 70.087800_r8, 14.006740_r8, 44.012880_r8, 108.010480_r8, & + 58.442468_r8, 58.442468_r8, 58.442468_r8, 17.028940_r8, 18.036340_r8, & + 28.010400_r8, 28.010400_r8, 30.006140_r8, 46.005540_r8, 62.004940_r8, & + 119.074340_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, & + 1.007400_r8, 15.999400_r8, 47.998200_r8, 47.998200_r8, 67.451500_r8, & + 60.076400_r8, 133.100140_r8, 121.047940_r8, 12.011000_r8, 12.011000_r8, & + 92.090400_r8, 90.075600_r8, 32.066000_r8, 146.056419_r8, 48.065400_r8, & + 64.064800_r8, 80.064200_r8, 115.107340_r8, 115.107340_r8, 115.107340_r8, & + 115.107340_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 28.010400_r8, 136.228400_r8, 150.126000_r8, 14.006740_r8, 14.006740_r8, & + 61.057800_r8, 75.083600_r8, 75.042400_r8, 47.032000_r8, 61.057800_r8, & + 77.057200_r8, 33.006200_r8, 117.119800_r8, 119.093400_r8, 101.079200_r8, & + 15.999400_r8, 17.006800_r8, 91.083000_r8, 89.068200_r8, 149.118600_r8, & + 18.014200_r8 /) + + crb_mass(:141) = (/ 12.011000_r8, 12.011000_r8, 60.055000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 36.033000_r8, 36.033000_r8, 36.033000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, 36.033000_r8, & + 36.033000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 24.022000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, & + 24.022000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_r8, & + 24.022000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 36.033000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 36.033000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 48.044000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, & + 36.033000_r8, 36.033000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 120.110000_r8, 60.055000_r8, 0.000000_r8, 0.000000_r8, & + 24.022000_r8, 36.033000_r8, 24.022000_r8, 12.011000_r8, 24.022000_r8, & + 24.022000_r8, 0.000000_r8, 60.055000_r8, 48.044000_r8, 48.044000_r8, & + 0.000000_r8, 0.000000_r8, 36.033000_r8, 36.033000_r8, 60.055000_r8, & + 0.000000_r8 /) + + fix_mass(: 3) = (/ 0.00000000_r8, 31.9988000_r8, 28.0134800_r8 /) + + clsmap(: 2,1) = (/ 124, 125 /) + clsmap(:139,4) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, & + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, & + 121, 122, 123, 126, 127, 128, 129, 130, 131, 132, & + 133, 134, 135, 136, 137, 138, 139, 140, 141 /) + + permute(:139,4) = (/ 1, 2, 35, 126, 56, 131, 83, 3, 76, 57, & + 64, 61, 112, 71, 45, 38, 46, 39, 40, 41, & + 42, 43, 44, 77, 125, 86, 47, 113, 68, 95, & + 116, 89, 87, 80, 73, 107, 70, 128, 50, 34, & + 137, 104, 4, 110, 90, 62, 5, 6, 7, 8, & + 48, 105, 92, 124, 111, 36, 84, 49, 100, 51, & + 52, 55, 127, 9, 101, 69, 94, 99, 109, 66, & + 103, 97, 79, 114, 63, 85, 122, 75, 53, 60, & + 10, 11, 12, 37, 13, 14, 15, 138, 133, 136, & + 72, 16, 17, 18, 19, 20, 129, 132, 21, 65, & + 67, 106, 81, 22, 23, 82, 74, 78, 24, 117, & + 102, 58, 25, 26, 27, 28, 29, 30, 31, 32, & + 33, 88, 54, 96, 98, 121, 123, 59, 91, 130, & + 118, 119, 120, 134, 135, 93, 108, 115, 139 /) + + diag_map(:139) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 11, & + 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, & + 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, & + 32, 34, 35, 36, 39, 42, 45, 48, 51, 54, & + 57, 60, 63, 66, 69, 73, 77, 81, 84, 87, & + 89, 93, 97, 100, 103, 108, 111, 116, 120, 124, & + 130, 136, 142, 147, 152, 157, 160, 168, 176, 182, & + 188, 194, 200, 206, 213, 220, 227, 234, 240, 248, & + 252, 260, 268, 276, 283, 292, 301, 308, 318, 323, & + 328, 336, 342, 352, 360, 369, 377, 389, 401, 408, & + 416, 422, 429, 448, 459, 467, 477, 492, 503, 510, & + 514, 530, 550, 560, 578, 591, 602, 626, 649, 668, & + 695, 715, 753, 769, 783, 800, 820, 856, 886, 943, & + 966,1011,1048,1086,1172,1217,1243,1286,1307 /) + + extfrc_lst(: 9) = (/ 'NO2 ','so4_a2 ','SO2 ','so4_a1 ','num_a2 ', & + 'num_a1 ','bc_a4 ','num_a4 ','NO ' /) + + frc_from_dataset(: 9) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .false. /) + + inv_lst(: 3) = (/ 'M ', 'O2 ', 'N2 ' /) + + slvd_lst(: 15) = (/ 'C2H5O2 ', 'C3H7O2 ', 'CH3CO3 ', 'CH3O2 ', 'EO ', & + 'EO2 ', 'HO2 ', 'ISOPO2 ', 'MACRO2 ', 'MCO3 ', & + 'O1D ', 'OH ', 'PO2 ', 'RO2 ', 'XO2 ' /) + + if( allocated( rxt_tag_lst ) ) then + deallocate( rxt_tag_lst ) + end if + allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios + call endrun + end if + if( allocated( rxt_tag_map ) ) then + deallocate( rxt_tag_map ) + end if + allocate( rxt_tag_map(rxt_tag_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios + call endrun + end if + rxt_tag_lst( 1: 200) = (/ 'jh2o_b ', 'jh2o_a ', & + 'jh2o_c ', 'jh2o2 ', & + 'jo2_a ', 'jo2_b ', & + 'jo3_a ', 'jo3_b ', & + 'jhno3 ', 'jho2no2_a ', & + 'jho2no2_b ', 'jn2o ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jno ', 'jno2 ', & + 'jno3_b ', 'jno3_a ', & + 'jc2h5ooh ', 'jc3h7ooh ', & + 'jch2o_a ', 'jch2o_b ', & + 'jch3cho ', 'jacet ', & + 'jmgly ', 'jch3co3h ', & + 'jch3ooh ', 'jch4_b ', & + 'jch4_a ', 'jco2 ', & + 'jeooh ', 'jglyald ', & + 'jglyoxal ', 'jhyac ', & + 'jisopooh ', 'jmacr_a ', & + 'jmacr_b ', 'jmpan ', & + 'jmvk ', 'jnoa ', & + 'jonitr ', 'jpan ', & + 'jpooh ', 'jrooh ', & + 'jxooh ', 'jbrcl ', & + 'jbro ', 'jbrono2_b ', & + 'jbrono2_a ', 'jccl4 ', & + 'jcf2clbr ', 'jcf3br ', & + 'jcfcl3 ', 'jcfc113 ', & + 'jcfc114 ', 'jcfc115 ', & + 'jcf2cl2 ', 'jch2br2 ', & + 'jch3br ', 'jch3ccl3 ', & + 'jch3cl ', 'jchbr3 ', & + 'jcl2 ', 'jcl2o2 ', & + 'jclo ', 'jclono2_b ', & + 'jclono2_a ', 'jh2402 ', & + 'jhbr ', 'jhcfc141b ', & + 'jhcfc142b ', 'jhcfc22 ', & + 'jhcl ', 'jhf ', & + 'jhobr ', 'jhocl ', & + 'joclo ', 'jsf6 ', & + 'jh2so4 ', 'jocs ', & + 'jso ', 'jso2 ', & + 'jso3 ', 'jsoa_a1 ', & + 'jsoa_a2 ', 'O1D_H2 ', & + 'O1D_H2O ', 'O1D_N2 ', & + 'O1D_O2ab ', 'O1D_O3 ', & + 'O1D_O3a ', 'O_O3 ', & + 'usr_O_O ', 'usr_O_O2 ', & + 'H2_O ', 'H2O2_O ', & + 'H_HO2 ', 'H_HO2a ', & + 'H_HO2b ', 'H_O2 ', & + 'HO2_O ', 'HO2_O3 ', & + 'H_O3 ', 'OH_H2 ', & + 'OH_H2O2 ', 'OH_HO2 ', & + 'OH_O ', 'OH_O3 ', & + 'OH_OH ', 'OH_OH_M ', & + 'usr_HO2_HO2 ', 'HO2NO2_OH ', & + 'N_NO ', 'N_NO2a ', & + 'N_NO2b ', 'N_NO2c ', & + 'N_O2 ', 'NO2_O ', & + 'NO2_O3 ', 'NO2_O_M ', & + 'NO3_HO2 ', 'NO3_NO ', & + 'NO3_O ', 'NO3_OH ', & + 'N_OH ', 'NO_HO2 ', & + 'NO_O3 ', 'NO_O_M ', & + 'O1D_N2Oa ', 'O1D_N2Ob ', & + 'tag_NO2_HO2 ', 'tag_NO2_NO3 ', & + 'tag_NO2_OH ', 'usr_HNO3_OH ', & + 'usr_HO2NO2_M ', 'usr_N2O5_M ', & + 'CL_CH2O ', 'CL_CH4 ', & + 'CL_H2 ', 'CL_H2O2 ', & + 'CL_HO2a ', 'CL_HO2b ', & + 'CL_O3 ', 'CLO_CH3O2 ', & + 'CLO_CLOa ', 'CLO_CLOb ', & + 'CLO_CLOc ', 'CLO_HO2 ', & + 'CLO_NO ', 'CLONO2_CL ', & + 'CLO_NO2_M ', 'CLONO2_O ', & + 'CLONO2_OH ', 'CLO_O ', & + 'CLO_OHa ', 'CLO_OHb ', & + 'HCL_O ', 'HCL_OH ', & + 'HOCL_CL ', 'HOCL_O ', & + 'HOCL_OH ', 'O1D_CCL4 ', & + 'O1D_CF2CLBR ', 'O1D_CFC11 ', & + 'O1D_CFC113 ', 'O1D_CFC114 ', & + 'O1D_CFC115 ', 'O1D_CFC12 ', & + 'O1D_HCLa ', 'O1D_HCLb ', & + 'tag_CLO_CLO_M ', 'usr_CL2O2_M ', & + 'BR_CH2O ', 'BR_HO2 ', & + 'BR_O3 ', 'BRO_BRO ', & + 'BRO_CLOa ', 'BRO_CLOb ', & + 'BRO_CLOc ', 'BRO_HO2 ', & + 'BRO_NO ', 'BRO_NO2_M ', & + 'BRONO2_O ', 'BRO_O ', & + 'BRO_OH ', 'HBR_O ', & + 'HBR_OH ', 'HOBR_O ', & + 'O1D_CF3BR ', 'O1D_CHBR3 ', & + 'O1D_H2402 ', 'O1D_HBRa ', & + 'O1D_HBRb ', 'CH2BR2_CL ', & + 'CH2BR2_OH ', 'CH3BR_CL ', & + 'CH3BR_OH ', 'CH3CCL3_OH ', & + 'CH3CL_CL ', 'CH3CL_OH ' /) + rxt_tag_lst( 201: 363) = (/ 'CHBR3_CL ', 'CHBR3_OH ', & + 'HCFC141B_OH ', 'HCFC142B_OH ', & + 'HCFC22_OH ', 'O1D_CH2BR2 ', & + 'O1D_CH3BR ', 'O1D_HCFC141B ', & + 'O1D_HCFC142B ', 'O1D_HCFC22 ', & + 'CH2O_NO3 ', 'CH2O_O ', & + 'CH2O_OH ', 'CH3O2_CH3O2a ', & + 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & + 'CH3O2_NO ', 'CH3OH_OH ', & + 'CH3OOH_OH ', 'CH4_OH ', & + 'O1D_CH4a ', 'O1D_CH4b ', & + 'O1D_CH4c ', 'usr_CO_OH ', & + 'C2H4_CL_M ', 'C2H4_O3 ', & + 'C2H5O2_C2H5O2 ', 'C2H5O2_CH3O2 ', & + 'C2H5O2_HO2 ', 'C2H5O2_NO ', & + 'C2H5OH_OH ', 'C2H5OOH_OH ', & + 'C2H6_CL ', 'C2H6_OH ', & + 'CH3CHO_NO3 ', 'CH3CHO_OH ', & + 'CH3CO3_CH3CO3 ', 'CH3CO3_CH3O2 ', & + 'CH3CO3_HO2 ', 'CH3CO3_NO ', & + 'CH3COOH_OH ', 'CH3COOOH_OH ', & + 'EO2_HO2 ', 'EO2_NO ', & + 'EO_M ', 'EO_O2 ', & + 'GLYALD_OH ', 'GLYOXAL_OH ', & + 'PAN_OH ', 'tag_C2H4_OH ', & + 'tag_CH3CO3_NO2 ', 'usr_PAN_M ', & + 'C3H6_NO3 ', 'C3H6_O3 ', & + 'C3H7O2_CH3O2 ', 'C3H7O2_HO2 ', & + 'C3H7O2_NO ', 'C3H7OOH_OH ', & + 'C3H8_OH ', 'CH3COCHO_NO3 ', & + 'CH3COCHO_OH ', 'HYAC_OH ', & + 'NOA_OH ', 'PO2_HO2 ', & + 'PO2_NO ', 'POOH_OH ', & + 'RO2_CH3O2 ', 'RO2_HO2 ', & + 'RO2_NO ', 'ROOH_OH ', & + 'tag_C3H6_OH ', 'usr_CH3COCH3_OH ', & + 'MACRO2_CH3CO3 ', 'MACRO2_CH3O2 ', & + 'MACRO2_HO2 ', 'MACRO2_NO3 ', & + 'MACRO2_NOa ', 'MACRO2_NOb ', & + 'MACR_O3 ', 'MACR_OH ', & + 'MACROOH_OH ', 'MCO3_CH3CO3 ', & + 'MCO3_CH3O2 ', 'MCO3_HO2 ', & + 'MCO3_MCO3 ', 'MCO3_NO ', & + 'MCO3_NO3 ', 'MPAN_OH_M ', & + 'MVK_O3 ', 'MVK_OH ', & + 'tag_MCO3_NO2 ', 'usr_MPAN_M ', & + 'BIGALK_OH ', 'HYDRALD_OH ', & + 'ISOP_NO3 ', 'ISOPNO3_HO2 ', & + 'ISOPNO3_NO ', 'ISOPNO3_NO3 ', & + 'ISOPO2_CH3CO3 ', 'ISOPO2_CH3O2 ', & + 'ISOPO2_HO2 ', 'ISOPO2_NO ', & + 'ISOPO2_NO3 ', 'ISOP_O3 ', & + 'ISOP_OH ', 'ISOPOOH_OH ', & + 'ONITR_NO3 ', 'ONITR_OH ', & + 'XO2_CH3CO3 ', 'XO2_CH3O2 ', & + 'XO2_HO2 ', 'XO2_NO ', & + 'XO2_NO3 ', 'XOOH_OH ', & + 'TERP_NO3 ', 'TERP_O3 ', & + 'TERP_OH ', 'DMS_NO3 ', & + 'DMS_OHa ', 'OCS_O ', & + 'OCS_OH ', 'S_O2 ', & + 'SO2_OH_M ', 'S_O3 ', & + 'SO_BRO ', 'SO_CLO ', & + 'S_OH ', 'SO_NO2 ', & + 'SO_O2 ', 'SO_O3 ', & + 'SO_OCLO ', 'SO_OH ', & + 'usr_DMS_OH ', 'usr_SO3_H2O ', & + 'NH3_OH ', 'usr_HO2_aer ', & + 'usr_N2O5_aer ', 'usr_NH4_strat_tau ', & + 'usr_NO2_aer ', 'usr_NO3_aer ', & + 'usr_ONITR_aer ', 'SOAE_tau ', & + 'het1 ', 'het10 ', & + 'het11 ', 'het12 ', & + 'het13 ', 'het14 ', & + 'het15 ', 'het16 ', & + 'het17 ', 'het2 ', & + 'het3 ', 'het4 ', & + 'het5 ', 'het6 ', & + 'het7 ', 'het8 ', & + 'het9 ', 'E90_tau ', & + 'NH_50_tau ', 'NH_5_tau ', & + 'ST80_25_tau ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, & + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, & + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, & + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, & + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, & + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, & + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, & + 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, & + 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, & + 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, & + 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, & + 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, & + 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, & + 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, & + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, & + 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, & + 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, & + 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, & + 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, & + 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, & + 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, & + 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, & + 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, & + 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, & + 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, & + 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, & + 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, & + 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, & + 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, & + 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, & + 351, 352, 353, 354, 355, 356, 357, 358, 359, 360, & + 361, 362, 363 /) + if( allocated( pht_alias_lst ) ) then + deallocate( pht_alias_lst ) + end if + allocate( pht_alias_lst(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios + call endrun + end if + if( allocated( pht_alias_mult ) ) then + deallocate( pht_alias_mult ) + end if + allocate( pht_alias_mult(phtcnt,2),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios + call endrun + end if + pht_alias_lst(:,1) = (/ ' ', ' ', ' ', ' ', & + 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', 'jch3ooh ', 'jch3ooh ', & + ' ', ' ', ' ', ' ', & + ' ', 'jh2o2 ', ' ', ' ', & + ' ', ' ', 'jch3ooh ', ' ', & + 'jmgly ', ' ', 'jch3ooh ', ' ', & + ' ', 'jpan ', ' ', 'jch2o_a ', & + 'jch3cho ', ' ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', 'jno2 ', & + 'jno2 ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 0.28_r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, .0004_r8, .0004_r8 /) + allocate( cph_enthalpy(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_enthalpy; error = ',ios + call endrun + end if + allocate( cph_rid(enthalpy_cnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate cph_rid; error = ',ios + call endrun + end if + cph_rid(:) = (/ 88, 92, 93, 94, 97, & + 100, 101, 102, 103, 106, & + 107, 108, 111, 113, 117, & + 118, 126, 127 /) + cph_enthalpy(:) = (/ 189.810000_r8, 392.190000_r8, 493.580000_r8, 101.390000_r8, 232.590000_r8, & + 203.400000_r8, 226.580000_r8, 120.100000_r8, 194.710000_r8, 293.620000_r8, & + 67.670000_r8, 165.300000_r8, 165.510000_r8, 313.750000_r8, 133.750000_r8, & + 193.020000_r8, 34.470000_r8, 199.170000_r8 /) + allocate( num_rnts(rxntot-phtcnt),stat=ios ) + if( ios /= 0 ) then + write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios + call endrun + end if + num_rnts(:) = (/ 2, 2, 2, 2, 2, 2, 2, 3, 3, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 3, 2, 2, 3, 3, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 3, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & + 2, 2, 2, 2, 3, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 3, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, & + 1, 1, 1, 2, 2, 2, 1, 1, 2, 2, & + 2, 1, 1, 2, 1, 1, 1, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_trop_strat_mam5_vbs/chem_mech.doc b/src/chemistry/pp_trop_strat_mam5_vbs/chem_mech.doc new file mode 100644 index 0000000000..19fdd8488d --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/chem_mech.doc @@ -0,0 +1,1832 @@ + + + Solution species + ( 1) ALKNIT (C5H11ONO2) + ( 2) ALKOOH (C5H12O2) + ( 3) AOA_NH (CO) + ( 4) bc_a1 (C) + ( 5) bc_a4 (C) + ( 6) BCARY (C15H24) + ( 7) BENZENE (C6H6) + ( 8) BENZOOH (C6H8O5) + ( 9) BEPOMUC (C6H6O3) + ( 10) BIGALD (C5H6O2) + ( 11) BIGALD1 (C4H4O2) + ( 12) BIGALD2 (C5H6O2) + ( 13) BIGALD3 (C5H6O2) + ( 14) BIGALD4 (C6H8O2) + ( 15) BIGALK (C5H12) + ( 16) BIGENE (C4H8) + ( 17) BR (Br) + ( 18) BRCL (BrCl) + ( 19) BRO (BrO) + ( 20) BRONO2 (BrONO2) + ( 21) BRY + ( 22) BZALD (C7H6O) + ( 23) BZOOH (C7H8O2) + ( 24) C2H2 + ( 25) C2H4 + ( 26) C2H5OH + ( 27) C2H5OOH + ( 28) C2H6 + ( 29) C3H6 + ( 30) C3H7OOH + ( 31) C3H8 + ( 32) C6H5OOH (C6H5OOH) + ( 33) CCL4 (CCl4) + ( 34) CF2CLBR (CF2ClBr) + ( 35) CF3BR (CF3Br) + ( 36) CFC11 (CFCl3) + ( 37) CFC113 (CCl2FCClF2) + ( 38) CFC114 (CClF2CClF2) + ( 39) CFC115 (CClF2CF3) + ( 40) CFC12 (CF2Cl2) + ( 41) CH2BR2 (CH2Br2) + ( 42) CH2O + ( 43) CH3BR (CH3Br) + ( 44) CH3CCL3 (CH3CCl3) + ( 45) CH3CHO + ( 46) CH3CL (CH3Cl) + ( 47) CH3CN + ( 48) CH3COCH3 + ( 49) CH3COCHO + ( 50) CH3COOH + ( 51) CH3COOOH + ( 52) CH3OH + ( 53) CH3OOH + ( 54) CH4 + ( 55) CHBR3 (CHBr3) + ( 56) CL (Cl) + ( 57) CL2 (Cl2) + ( 58) CL2O2 (Cl2O2) + ( 59) CLO (ClO) + ( 60) CLONO2 (ClONO2) + ( 61) CLY + ( 62) CO + ( 63) CO2 + ( 64) COF2 + ( 65) COFCL (COFCl) + ( 66) CRESOL (C7H8O) + ( 67) DMS (CH3SCH3) + ( 68) dst_a1 (AlSiO5) + ( 69) dst_a2 (AlSiO5) + ( 70) dst_a3 (AlSiO5) + ( 71) E90 (CO) + ( 72) EOOH (HOCH2CH2OOH) + ( 73) F + ( 74) GLYALD (HOCH2CHO) + ( 75) GLYOXAL (C2H2O2) + ( 76) H + ( 77) H2 + ( 78) H2402 (CBrF2CBrF2) + ( 79) H2O2 + ( 80) H2SO4 (H2SO4) + ( 81) HBR (HBr) + ( 82) HCFC141B (CH3CCl2F) + ( 83) HCFC142B (CH3CClF2) + ( 84) HCFC22 (CHF2Cl) + ( 85) HCL (HCl) + ( 86) HCN + ( 87) HCOOH + ( 88) HF + ( 89) HNO3 + ( 90) HO2NO2 + ( 91) HOBR (HOBr) + ( 92) HOCL (HOCl) + ( 93) HONITR (C4H9NO4) + ( 94) HPALD (HOOCH2CCH3CHCHO) + ( 95) HYAC (CH3COCH2OH) + ( 96) HYDRALD (HOCH2CCH3CHCHO) + ( 97) IEPOX (C5H10O3) + ( 98) ISOP (C5H8) + ( 99) ISOPNITA (C5H9NO4) + (100) ISOPNITB (C5H9NO4) + (101) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + (102) ISOPNOOH (C5H9NO5) + (103) ISOPOOH (HOCH2COOHCH3CHCH2) + (104) IVOC (C13H28) + (105) MACR (CH2CCH3CHO) + (106) MACROOH (CH3COCHOOHCH2OH) + (107) MEK (C4H8O) + (108) MEKOOH (C4H8O3) + (109) MPAN (CH2CCH3CO3NO2) + (110) MTERP (C10H16) + (111) MVK (CH2CHCOCH3) + (112) N + (113) N2O + (114) N2O5 + (115) NC4CH2OH (C5H9NO4) + (116) NC4CHO (C5H7NO4) + (117) ncl_a1 (NaCl) + (118) ncl_a2 (NaCl) + (119) ncl_a3 (NaCl) + (120) NH3 + (121) NH4 + (122) NH_5 (CO) + (123) NH_50 (CO) + (124) NO + (125) NO2 + (126) NO3 + (127) NOA (CH3COCH2ONO2) + (128) NTERPOOH (C10H17NO5) + (129) num_a1 (H) + (130) num_a2 (H) + (131) num_a3 (H) + (132) num_a4 (H) + (133) num_a5 (H) + (134) O + (135) O3 + (136) O3S (O3) + (137) OCLO (OClO) + (138) OCS (OCS) + (139) ONITR (C4H7NO4) + (140) PAN (CH3CO3NO2) + (141) PBZNIT (C7H5O3NO2) + (142) PHENO (C6H5O) + (143) PHENOL (C6H5OH) + (144) PHENOOH (C6H8O6) + (145) pom_a1 (C) + (146) pom_a4 (C) + (147) POOH (C3H6OHOOH) + (148) ROOH (CH3COCH2OOH) + (149) S (S) + (150) SF6 + (151) SO (SO) + (152) SO2 + (153) SO3 (SO3) + (154) so4_a1 (NH4HSO4) + (155) so4_a2 (NH4HSO4) + (156) so4_a3 (NH4HSO4) + (157) so4_a5 (NH4HSO4) + (158) soa1_a1 (C15H38O2) + (159) soa1_a2 (C15H38O2) + (160) soa2_a1 (C15H38O2) + (161) soa2_a2 (C15H38O2) + (162) soa3_a1 (C15H38O2) + (163) soa3_a2 (C15H38O2) + (164) soa4_a1 (C15H38O2) + (165) soa4_a2 (C15H38O2) + (166) soa5_a1 (C15H38O2) + (167) soa5_a2 (C15H38O2) + (168) SOAG0 (C15H38O2) + (169) SOAG1 (C15H38O2) + (170) SOAG2 (C15H38O2) + (171) SOAG3 (C15H38O2) + (172) SOAG4 (C15H38O2) + (173) ST80_25 (CO) + (174) SVOC (C22H46) + (175) TEPOMUC (C7H8O3) + (176) TERP2OOH (C10H16O4) + (177) TERPNIT (C10H17NO4) + (178) TERPOOH (C10H18O3) + (179) TERPROD1 (C10H16O2) + (180) TERPROD2 (C9H14O2) + (181) TOLOOH (C7H10O5) + (182) TOLUENE (C7H8) + (183) XOOH (HOCH2COOHCH3CHOHCHO) + (184) XYLENES (C8H10) + (185) XYLENOOH (C8H12O5) + (186) XYLOL (C8H10O) + (187) XYLOLOOH (C8H12O6) + (188) NHDEP (N) + (189) NDEP (N) + (190) ACBZO2 (C7H5O3) + (191) ALKO2 (C5H11O2) + (192) BCARYO2VBS (C15H25O3) + (193) BENZO2 (C6H7O5) + (194) BENZO2VBS (C6H7O5) + (195) BZOO (C7H7O2) + (196) C2H5O2 + (197) C3H7O2 + (198) C6H5O2 + (199) CH3CO3 + (200) CH3O2 + (201) DICARBO2 (C5H5O4) + (202) ENEO2 (C4H9O3) + (203) EO (HOCH2CH2O) + (204) EO2 (HOCH2CH2O2) + (205) HO2 + (206) HOCH2OO + (207) ISOPAO2 (HOC5H8O2) + (208) ISOPBO2 (HOC5H8O2) + (209) ISOPO2VBS (C5H9O3) + (210) IVOCO2VBS (C13H29O3) + (211) MACRO2 (CH3COCHO2CH2OH) + (212) MALO2 (C4H3O4) + (213) MCO3 (CH2CCH3CO3) + (214) MDIALO2 (C4H5O4) + (215) MEKO2 (C4H7O3) + (216) MTERPO2VBS (C10H17O3) + (217) NTERPO2 (C10H16NO5) + (218) O1D (O) + (219) OH + (220) PHENO2 (C6H7O6) + (221) PO2 (C3H6OHO2) + (222) RO2 (CH3COCH2O2) + (223) TERP2O2 (C10H15O4) + (224) TERPO2 (C10H17O3) + (225) TOLO2 (C7H9O5) + (226) TOLUO2VBS (C7H9O5) + (227) XO2 (HOCH2COOCH3CHOHCHO) + (228) XYLENO2 (C8H11O5) + (229) XYLEO2VBS (C8H11O5) + (230) XYLOLO2 (C8H11O6) + (231) 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) ALKNIT + ( 2) ALKOOH + ( 3) AOA_NH + ( 4) bc_a1 + ( 5) bc_a4 + ( 6) BCARY + ( 7) BENZENE + ( 8) BENZOOH + ( 9) BEPOMUC + ( 10) BIGALD + ( 11) BIGALD1 + ( 12) BIGALD2 + ( 13) BIGALD3 + ( 14) BIGALD4 + ( 15) BIGALK + ( 16) BIGENE + ( 17) BR + ( 18) BRCL + ( 19) BRO + ( 20) BRONO2 + ( 21) BRY + ( 22) BZALD + ( 23) BZOOH + ( 24) C2H2 + ( 25) C2H4 + ( 26) C2H5OH + ( 27) C2H5OOH + ( 28) C2H6 + ( 29) C3H6 + ( 30) C3H7OOH + ( 31) C3H8 + ( 32) C6H5OOH + ( 33) CCL4 + ( 34) CF2CLBR + ( 35) CF3BR + ( 36) CFC11 + ( 37) CFC113 + ( 38) CFC114 + ( 39) CFC115 + ( 40) CFC12 + ( 41) CH2BR2 + ( 42) CH2O + ( 43) CH3BR + ( 44) CH3CCL3 + ( 45) CH3CHO + ( 46) CH3CL + ( 47) CH3CN + ( 48) CH3COCH3 + ( 49) CH3COCHO + ( 50) CH3COOH + ( 51) CH3COOOH + ( 52) CH3OH + ( 53) CH3OOH + ( 54) CH4 + ( 55) CHBR3 + ( 56) CL + ( 57) CL2 + ( 58) CL2O2 + ( 59) CLO + ( 60) CLONO2 + ( 61) CLY + ( 62) CO + ( 63) CO2 + ( 64) COF2 + ( 65) COFCL + ( 66) CRESOL + ( 67) DMS + ( 68) dst_a1 + ( 69) dst_a2 + ( 70) dst_a3 + ( 71) E90 + ( 72) EOOH + ( 73) F + ( 74) GLYALD + ( 75) GLYOXAL + ( 76) H + ( 77) H2 + ( 78) H2402 + ( 79) H2O2 + ( 80) H2SO4 + ( 81) HBR + ( 82) HCFC141B + ( 83) HCFC142B + ( 84) HCFC22 + ( 85) HCL + ( 86) HCN + ( 87) HCOOH + ( 88) HF + ( 89) HNO3 + ( 90) HO2NO2 + ( 91) HOBR + ( 92) HOCL + ( 93) HONITR + ( 94) HPALD + ( 95) HYAC + ( 96) HYDRALD + ( 97) IEPOX + ( 98) ISOP + ( 99) ISOPNITA + (100) ISOPNITB + (101) ISOPNO3 + (102) ISOPNOOH + (103) ISOPOOH + (104) IVOC + (105) MACR + (106) MACROOH + (107) MEK + (108) MEKOOH + (109) MPAN + (110) MTERP + (111) MVK + (112) N + (113) N2O + (114) N2O5 + (115) NC4CH2OH + (116) NC4CHO + (117) ncl_a1 + (118) ncl_a2 + (119) ncl_a3 + (120) NH3 + (121) NH4 + (122) NH_5 + (123) NH_50 + (124) NO + (125) NO2 + (126) NO3 + (127) NOA + (128) NTERPOOH + (129) num_a1 + (130) num_a2 + (131) num_a3 + (132) num_a4 + (133) num_a5 + (134) O + (135) O3 + (136) O3S + (137) OCLO + (138) OCS + (139) ONITR + (140) PAN + (141) PBZNIT + (142) PHENO + (143) PHENOL + (144) PHENOOH + (145) pom_a1 + (146) pom_a4 + (147) POOH + (148) ROOH + (149) S + (150) SF6 + (151) SO + (152) SO2 + (153) SO3 + (154) so4_a1 + (155) so4_a2 + (156) so4_a3 + (157) so4_a5 + (158) soa1_a1 + (159) soa1_a2 + (160) soa2_a1 + (161) soa2_a2 + (162) soa3_a1 + (163) soa3_a2 + (164) soa4_a1 + (165) soa4_a2 + (166) soa5_a1 + (167) soa5_a2 + (168) SOAG0 + (169) SOAG1 + (170) SOAG2 + (171) SOAG3 + (172) SOAG4 + (173) ST80_25 + (174) SVOC + (175) TEPOMUC + (176) TERP2OOH + (177) TERPNIT + (178) TERPOOH + (179) TERPROD1 + (180) TERPROD2 + (181) TOLOOH + (182) TOLUENE + (183) XOOH + (184) XYLENES + (185) XYLENOOH + (186) XYLOL + (187) XYLOLOOH + (188) ACBZO2 + (189) ALKO2 + (190) BCARYO2VBS + (191) BENZO2 + (192) BENZO2VBS + (193) BZOO + (194) C2H5O2 + (195) C3H7O2 + (196) C6H5O2 + (197) CH3CO3 + (198) CH3O2 + (199) DICARBO2 + (200) ENEO2 + (201) EO + (202) EO2 + (203) HO2 + (204) HOCH2OO + (205) ISOPAO2 + (206) ISOPBO2 + (207) ISOPO2VBS + (208) IVOCO2VBS + (209) MACRO2 + (210) MALO2 + (211) MCO3 + (212) MDIALO2 + (213) MEKO2 + (214) MTERPO2VBS + (215) NTERPO2 + (216) O1D + (217) OH + (218) PHENO2 + (219) PO2 + (220) RO2 + (221) TERP2O2 + (222) TERPO2 + (223) TOLO2 + (224) TOLUO2VBS + (225) XO2 + (226) XYLENO2 + (227) XYLEO2VBS + (228) XYLOLO2 + (229) 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) + jalknit ( 19) ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 rate = ** User defined ** ( 19) + + 0.8*MEK + jalkooh ( 20) ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 rate = ** User defined ** ( 20) + + 0.8*MEK + OH + jbenzooh ( 21) BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 rate = ** User defined ** ( 21) + jbepomuc ( 22) BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO rate = ** User defined ** ( 22) + jbigald ( 23) BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 rate = ** User defined ** ( 23) + + 0.18*CH3COCHO + jbigald1 ( 24) BIGALD1 + hv -> 0.6*MALO2 + HO2 rate = ** User defined ** ( 24) + jbigald2 ( 25) BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 rate = ** User defined ** ( 25) + jbigald3 ( 26) BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 rate = ** User defined ** ( 26) + jbigald4 ( 27) BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 rate = ** User defined ** ( 27) + jbzooh ( 28) BZOOH + hv -> BZALD + OH + HO2 rate = ** User defined ** ( 28) + jc2h5ooh ( 29) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 29) + jc3h7ooh ( 30) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 30) + jc6h5ooh ( 31) C6H5OOH + hv -> PHENO + OH rate = ** User defined ** ( 31) + jch2o_b ( 32) CH2O + hv -> CO + H2 rate = ** User defined ** ( 32) + jch2o_a ( 33) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 33) + jch3cho ( 34) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 34) + jacet ( 35) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 35) + jmgly ( 36) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 36) + jch3co3h ( 37) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 37) + jch3ooh ( 38) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 38) + jch4_b ( 39) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 39) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jch4_a ( 40) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 40) + jco2 ( 41) CO2 + hv -> CO + O rate = ** User defined ** ( 41) + jeooh ( 42) EOOH + hv -> EO + OH rate = ** User defined ** ( 42) + jglyald ( 43) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 43) + jglyoxal ( 44) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 44) + jhonitr ( 45) HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO rate = ** User defined ** ( 45) + + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + + 0.17*CH3COCH3 + jhpald ( 46) HPALD + hv -> BIGALD3 + OH + HO2 rate = ** User defined ** ( 46) + jhyac ( 47) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 47) + jisopnooh ( 48) ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH rate = ** User defined ** ( 48) + jisopooh ( 49) ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + CH2O + HO2 rate = ** User defined ** ( 49) + jmacr_a ( 50) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 50) + jmacr_b ( 51) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 51) + jmek ( 52) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 52) + jmekooh ( 53) MEKOOH + hv -> OH + CH3CO3 + CH3CHO rate = ** User defined ** ( 53) + jmpan ( 54) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 54) + jmvk ( 55) MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 rate = ** User defined ** ( 55) + jnc4cho ( 56) NC4CHO + hv -> BIGALD3 + NO2 + HO2 rate = ** User defined ** ( 56) + jnoa ( 57) NOA + hv -> NO2 + CH2O + CH3CO3 rate = ** User defined ** ( 57) + jnterpooh ( 58) NTERPOOH + hv -> TERPROD1 + NO2 + OH rate = ** User defined ** ( 58) + jonitr ( 59) ONITR + hv -> NO2 rate = ** User defined ** ( 59) + jpan ( 60) PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 rate = ** User defined ** ( 60) + jphenooh ( 61) PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL rate = ** User defined ** ( 61) + jpooh ( 62) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 62) + jrooh ( 63) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 63) + jtepomuc ( 64) TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO rate = ** User defined ** ( 64) + jterp2ooh ( 65) TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 rate = ** User defined ** ( 65) + + TERPROD2 + HO2 + 0.25*GLYALD + jterpnit ( 66) TERPNIT + hv -> TERPROD1 + NO2 + HO2 rate = ** User defined ** ( 66) + jterpooh ( 67) TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH rate = ** User defined ** ( 67) + jterprd1 ( 68) TERPROD1 + hv -> HO2 + CO + TERPROD2 rate = ** User defined ** ( 68) + jterprd2 ( 69) TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 rate = ** User defined ** ( 69) + + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO + jtolooh ( 70) TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = ** User defined ** ( 70) + + 0.2*BIGALD2 + 0.2*BIGALD3 + jxooh ( 71) XOOH + hv -> OH rate = ** User defined ** ( 71) + jxylenooh ( 72) XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = ** User defined ** ( 72) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + jxylolooh ( 73) XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 rate = ** User defined ** ( 73) + jbrcl ( 74) BRCL + hv -> BR + CL rate = ** User defined ** ( 74) + jbro ( 75) BRO + hv -> BR + O rate = ** User defined ** ( 75) + jbrono2_b ( 76) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 76) + jbrono2_a ( 77) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 77) + jccl4 ( 78) CCL4 + hv -> 4*CL rate = ** User defined ** ( 78) + jcf2clbr ( 79) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 79) + jcf3br ( 80) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 80) + jcfcl3 ( 81) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 81) + jcfc113 ( 82) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 82) + jcfc114 ( 83) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 83) + jcfc115 ( 84) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 84) + jcf2cl2 ( 85) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 85) + jch2br2 ( 86) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 86) + jch3br ( 87) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 87) + jch3ccl3 ( 88) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 88) + jch3cl ( 89) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 89) + jchbr3 ( 90) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 90) + jcl2 ( 91) CL2 + hv -> 2*CL rate = ** User defined ** ( 91) + jcl2o2 ( 92) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 92) + jclo ( 93) CLO + hv -> CL + O rate = ** User defined ** ( 93) + jclono2_a ( 94) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 94) + jclono2_b ( 95) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 95) + jcof2 ( 96) COF2 + hv -> 2*F rate = ** User defined ** ( 96) + jcofcl ( 97) COFCL + hv -> F + CL rate = ** User defined ** ( 97) + jh2402 ( 98) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 98) + jhbr ( 99) HBR + hv -> BR + H rate = ** User defined ** ( 99) + jhcfc141b (100) HCFC141B + hv -> CL + COFCL rate = ** User defined ** (100) + jhcfc142b (101) HCFC142B + hv -> CL + COF2 rate = ** User defined ** (101) + jhcfc22 (102) HCFC22 + hv -> CL + COF2 rate = ** User defined ** (102) + jhcl (103) HCL + hv -> H + CL rate = ** User defined ** (103) + jhf (104) HF + hv -> H + F rate = ** User defined ** (104) + jhobr (105) HOBR + hv -> BR + OH rate = ** User defined ** (105) + jhocl (106) HOCL + hv -> OH + CL rate = ** User defined ** (106) + joclo (107) OCLO + hv -> O + CLO rate = ** User defined ** (107) + jsf6 (108) SF6 + hv -> {sink} rate = ** User defined ** (108) + jh2so4 (109) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** (109) + jocs (110) OCS + hv -> S + CO rate = ** User defined ** (110) + jso (111) SO + hv -> S + O rate = ** User defined ** (111) + jso2 (112) SO2 + hv -> SO + O rate = ** User defined ** (112) + jso3 (113) SO3 + hv -> SO2 + O rate = ** User defined ** (113) + jsoa1_a1 (114) soa1_a1 + hv -> (No products) rate = ** User defined ** (114) + jsoa1_a2 (115) soa1_a2 + hv -> (No products) rate = ** User defined ** (115) + jsoa2_a1 (116) soa2_a1 + hv -> (No products) rate = ** User defined ** (116) + jsoa2_a2 (117) soa2_a2 + hv -> (No products) rate = ** User defined ** (117) + jsoa3_a1 (118) soa3_a1 + hv -> (No products) rate = ** User defined ** (118) + jsoa3_a2 (119) soa3_a2 + hv -> (No products) rate = ** User defined ** (119) + jsoa4_a1 (120) soa4_a1 + hv -> (No products) rate = ** User defined ** (120) + jsoa4_a2 (121) soa4_a2 + hv -> (No products) rate = ** User defined ** (121) + jsoa5_a1 (122) soa5_a1 + hv -> (No products) rate = ** User defined ** (122) + jsoa5_a2 (123) soa5_a2 + hv -> (No products) rate = ** User defined ** (123) + + Reactions + E90_tau ( 1) E90 -> (No products) rate = 1.29E-07 (124) + O1D_H2 ( 2) O1D + H2 -> H + OH rate = 1.20E-10 (125) + O1D_H2O ( 3) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (126) + O1D_N2 ( 4) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (127) + O1D_O2ab ( 5) O1D + O2 -> O + O2 rate = 3.30E-11*exp( 55./t) (128) + O1D_O3 ( 6) O1D + O3 -> O2 + O2 rate = 1.20E-10 (129) + O_O3 ( 7) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (130) + usr_O_O ( 8) O + O + M -> O2 + M rate = ** User defined ** (131) + usr_O_O2 ( 9) O + O2 + M -> O3 + M rate = ** User defined ** (132) + H2_O ( 10) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (133) + H2O2_O ( 11) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (134) + H_HO2 ( 12) H + HO2 -> H2 + O2 rate = 6.90E-12 (135) + H_HO2a ( 13) H + HO2 -> 2*OH rate = 7.20E-11 (136) + H_HO2b ( 14) H + HO2 -> H2O + O rate = 1.60E-12 (137) + H_O2 ( 15) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (138) + 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) (139) + HO2_O3 ( 17) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (140) + H_O3 ( 18) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (141) + OH_H2 ( 19) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (142) + OH_H2O2 ( 20) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (143) + OH_HO2 ( 21) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (144) + OH_O ( 22) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (145) + OH_O3 ( 23) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (146) + OH_OH ( 24) OH + OH -> H2O + O rate = 1.80E-12 (147) + OH_OH_M ( 25) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (148) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 ( 26) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (149) + HO2NO2_OH ( 27) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (150) + N_NO ( 28) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (151) + N_NO2a ( 29) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (152) + N_NO2b ( 30) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (153) + N_NO2c ( 31) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (154) + N_O2 ( 32) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (155) + NO2_O ( 33) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (156) + NO2_O3 ( 34) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (157) + NO2_O_M ( 35) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (158) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 ( 36) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (159) + NO3_NO ( 37) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (160) + NO3_O ( 38) NO3 + O -> NO2 + O2 rate = 1.30E-11 (161) + NO3_OH ( 39) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (162) + N_OH ( 40) N + OH -> NO + H rate = 5.00E-11 (163) + NO_HO2 ( 41) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (164) + NO_O3 ( 42) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (165) + NO_O_M ( 43) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (166) + ki=3.00E-11 + f=0.60 + O1D_N2Oa ( 44) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (167) + O1D_N2Ob ( 45) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (168) + tag_NO2_HO2 ( 46) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (169) + 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 (170) + 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 (171) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 49) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (172) + usr_HO2NO2_M ( 50) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (173) + usr_N2O5_M ( 51) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (174) + CL_CH2O ( 52) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (175) + CL_CH4 ( 53) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (176) + CL_H2 ( 54) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (177) + CL_H2O2 ( 55) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (178) + CL_HO2a ( 56) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (179) + CL_HO2b ( 57) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (180) + CL_O3 ( 58) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (181) + CLO_CH3O2 ( 59) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (182) + CLO_CLOa ( 60) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (183) + CLO_CLOb ( 61) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (184) + CLO_CLOc ( 62) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (185) + CLO_HO2 ( 63) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (186) + CLO_NO ( 64) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (187) + CLONO2_CL ( 65) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (188) + CLO_NO2_M ( 66) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (189) + 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) (190) + CLONO2_OH ( 68) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (191) + CLO_O ( 69) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (192) + CLO_OHa ( 70) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (193) + CLO_OHb ( 71) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (194) + HCL_O ( 72) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (195) + HCL_OH ( 73) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (196) + HOCL_CL ( 74) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (197) + HOCL_O ( 75) HOCL + O -> CLO + OH rate = 1.70E-13 (198) + HOCL_OH ( 76) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (199) + O1D_CCL4 ( 77) O1D + CCL4 -> 4*CL rate = 2.61E-10 (200) + O1D_CF2CLBR ( 78) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (201) + O1D_CFC11 ( 79) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (202) + O1D_CFC113 ( 80) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (203) + O1D_CFC114 ( 81) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (204) + O1D_CFC115 ( 82) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (205) + O1D_CFC12 ( 83) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (206) + O1D_HCLa ( 84) O1D + HCL -> CL + OH rate = 9.90E-11 (207) + O1D_HCLb ( 85) O1D + HCL -> CLO + H rate = 3.30E-12 (208) + tag_CLO_CLO_M ( 86) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (209) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M ( 87) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (210) + BR_CH2O ( 88) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (211) + BR_HO2 ( 89) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (212) + BR_O3 ( 90) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (213) + BRO_BRO ( 91) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (214) + BRO_CLOa ( 92) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (215) + BRO_CLOb ( 93) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (216) + BRO_CLOc ( 94) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (217) + BRO_HO2 ( 95) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (218) + BRO_NO ( 96) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (219) + BRO_NO2_M ( 97) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (220) + 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) (221) + BRO_O ( 99) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (222) + BRO_OH (100) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (223) + HBR_O (101) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (224) + HBR_OH (102) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (225) + HOBR_O (103) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (226) + O1D_CF3BR (104) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (227) + O1D_CHBR3 (105) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (228) + O1D_H2402 (106) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (229) + O1D_HBRa (107) O1D + HBR -> BR + OH rate = 9.00E-11 (230) + O1D_HBRb (108) O1D + HBR -> BRO + H rate = 3.00E-11 (231) + F_CH4 (109) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (232) + F_H2 (110) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (233) + F_H2O (111) F + H2O -> HF + OH rate = 1.40E-11 (234) + F_HNO3 (112) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (235) + O1D_COF2 (113) O1D + COF2 -> 2*F rate = 2.14E-11 (236) + O1D_COFCL (114) O1D + COFCL -> F + CL rate = 1.90E-10 (237) + CH2BR2_CL (115) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (238) + CH2BR2_OH (116) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (239) + CH3BR_CL (117) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (240) + CH3BR_OH (118) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (241) + CH3CCL3_OH (119) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (242) + CH3CL_CL (120) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (243) + CH3CL_OH (121) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (244) + CHBR3_CL (122) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (245) + CHBR3_OH (123) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (246) + HCFC141B_OH (124) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (247) + HCFC142B_OH (125) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (248) + HCFC22_OH (126) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (249) + O1D_CH2BR2 (127) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (250) + O1D_CH3BR (128) O1D + CH3BR -> BR rate = 1.80E-10 (251) + O1D_HCFC141B (129) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (252) + O1D_HCFC142B (130) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (253) + O1D_HCFC22 (131) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (254) + CH2O_HO2 (132) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) (255) + CH2O_NO3 (133) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (256) + CH2O_O (134) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (257) + CH2O_OH (135) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (258) + CH3O2_CH3O2a (136) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (259) + CH3O2_CH3O2b (137) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (260) + CH3O2_HO2 (138) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (261) + CH3O2_NO (139) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (262) + CH3OH_OH (140) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (263) + CH3OOH_OH (141) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (264) + CH4_OH (142) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (265) + HCN_OH (143) HCN + OH + M -> HO2 + M troe : ko=6.10E-33*(300/t)**1.50 (266) + ki=9.80E-15*(300/t)**-4.60 + f=0.80 + HCOOH_OH (144) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (267) + HOCH2OO_HO2 (145) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (268) + HOCH2OO_M (146) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (269) + HOCH2OO_NO (147) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (270) + O1D_CH4a (148) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (271) + O1D_CH4b (149) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (272) + O1D_CH4c (150) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (273) + O1D_HCN (151) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (274) + usr_CO_OH (152) CO + OH -> CO2 + HO2 rate = ** User defined ** (275) + C2H2_CL_M (153) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (276) + ki=2.20E-10*(300/t)**0.70 + f=0.60 + C2H2_OH_M (154) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (277) + + 0.35*CO + M ki=8.30E-13*(300/t)**-2.00 + f=0.60 + C2H4_CL_M (155) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (278) + ki=3.10E-10*(300/t) + f=0.60 + C2H4_O3 (156) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (279) + C2H5O2_C2H5O2 (157) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (280) + C2H5O2_CH3O2 (158) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (281) + + 0.2*C2H5OH + C2H5O2_HO2 (159) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (282) + C2H5O2_NO (160) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (283) + C2H5OH_OH (161) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (284) + C2H5OOH_OH (162) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (285) + C2H6_CL (163) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (286) + C2H6_OH (164) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (287) + CH3CHO_NO3 (165) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (288) + CH3CHO_OH (166) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (289) + CH3CN_OH (167) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (290) + CH3CO3_CH3CO3 (168) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (291) + CH3CO3_CH3O2 (169) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (292) + + 0.1*CH3COOH + CH3CO3_HO2 (170) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (293) + + 0.45*CH3O2 + CH3CO3_NO (171) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (294) + CH3COOH_OH (172) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 3.15E-14*exp( 920./t) (295) + CH3COOOH_OH (173) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (296) + EO2_HO2 (174) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (297) + EO2_NO (175) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (298) + EO_M (176) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (299) + EO_O2 (177) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (300) + GLYALD_OH (178) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (301) + GLYOXAL_OH (179) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (302) + PAN_OH (180) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (303) + tag_C2H4_OH (181) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (304) + ki=9.00E-12*(300/t)**0.85 + f=0.48 + tag_CH3CO3_NO2 (182) CH3CO3 + NO2 + M -> PAN + M troe : ko=7.30E-29*(300/t)**4.10 (305) + ki=9.50E-12*(300/t)**1.60 + f=0.60 + usr_PAN_M (183) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (306) + C3H6_NO3 (184) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (307) + C3H6_O3 (185) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (308) + + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + + 0.36*OH + C3H7O2_CH3O2 (186) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (309) + C3H7O2_HO2 (187) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (310) + C3H7O2_NO (188) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (311) + C3H7OOH_OH (189) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (312) + C3H8_OH (190) C3H8 + OH -> C3H7O2 + H2O rate = 9.19E-12*exp( -630./t) (313) + CH3COCHO_NO3 (191) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (314) + CH3COCHO_OH (192) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (315) + HYAC_OH (193) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (316) + NOA_OH (194) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (317) + PO2_HO2 (195) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (318) + PO2_NO (196) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (319) + POOH_OH (197) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (320) + RO2_CH3O2 (198) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (321) + + 0.5*CH3COCHO + 0.5*CH3OH + RO2_HO2 (199) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (322) + RO2_NO (200) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (323) + ROOH_OH (201) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (324) + tag_C3H6_OH (202) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (325) + ki=3.00E-11 + f=0.50 + usr_CH3COCH3_OH (203) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (326) + BIGENE_NO3 (204) BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 rate = 3.50E-13 (327) + BIGENE_OH (205) BIGENE + OH -> ENEO2 rate = 5.40E-11 (328) + ENEO2_NO (206) ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 rate = 4.80E-12*exp( 120./t) (329) + ENEO2_NOb (207) ENEO2 + NO -> HONITR rate = 5.10E-14*exp( 693./t) (330) + HONITR_OH (208) HONITR + OH -> ONITR + HO2 rate = 2.00E-12 (331) + MACRO2_CH3CO3 (209) MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 rate = 1.40E-11 (332) + + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + + 0.53*CH3CO3 + MACRO2_CH3O2 (210) MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO rate = 5.00E-13*exp( 400./t) (333) + + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + + 0.23*HYAC + MACRO2_HO2 (211) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (334) + MACRO2_NO3 (212) MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO rate = 2.40E-12 (335) + + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 + MACRO2_NOa (213) MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD rate = 2.70E-12*exp( 360./t) (336) + + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO + MACRO2_NOb (214) MACRO2 + NO -> HONITR rate = 1.30E-13*exp( 360./t) (337) + MACR_O3 (215) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (338) + + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 + MACR_OH (216) MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 rate = 9.60E-12*exp( 360./t) (339) + MACROOH_OH (217) MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 rate = 2.30E-11*exp( 200./t) (340) + MCO3_CH3CO3 (218) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (341) + MCO3_CH3O2 (219) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (342) + MCO3_HO2 (220) MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH rate = 4.30E-13*exp( 1040./t) (343) + + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 + MCO3_MCO3 (221) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (344) + MCO3_NO (222) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (345) + MCO3_NO3 (223) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (346) + MEKO2_HO2 (224) MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 rate = 7.50E-13*exp( 700./t) (347) + MEKO2_NO (225) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (348) + MEK_OH (226) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (349) + MEKOOH_OH (227) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (350) + MPAN_OH_M (228) 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 (351) + + M + 0.5*NDEP ki=3.00E-11 + f=0.50 + MVK_O3 (229) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (352) + + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH + MVK_OH (230) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (353) + tag_MCO3_NO2 (231) MCO3 + NO2 + M -> MPAN + M troe : ko=9.70E-29*(300/t)**5.60 (354) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + usr_MPAN_M (232) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (355) + ALKNIT_OH (233) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (356) + ALKO2_HO2 (234) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (357) + ALKO2_NO (235) ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK rate = 6.70E-12 (358) + + NO2 + ALKO2_NOb (236) ALKO2 + NO -> ALKNIT rate = 5.40E-14*exp( 870./t) (359) + ALKOOH_OH (237) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (360) + BIGALK_OH (238) BIGALK + OH -> ALKO2 rate = 3.50E-12 (361) + HPALD_OH (239) HPALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (362) + HYDRALD_OH (240) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (363) + IEPOX_OH (241) IEPOX + OH -> XO2 rate = 1.30E-11 (364) + ISOPAO2_CH3CO3 (242) ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 rate = 1.40E-11 (365) + ISOPAO2_CH3O2 (243) ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR rate = 5.00E-13*exp( 400./t) (366) + + 0.44*MVK + ISOPAO2_HO2 (244) ISOPAO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (367) + ISOPAO2_NO (245) ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK rate = 4.40E-12*exp( 180./t) (368) + + 0.92*CH2O + 0.92*HO2 + ISOPAO2_NO3 (246) ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 rate = 2.40E-12 (369) + ISOPBO2_CH3CO3 (247) ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 rate = 1.40E-11 (370) + ISOPBO2_CH3O2 (248) ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD rate = 5.00E-13*exp( 400./t) (371) + ISOPBO2_HO2 (249) ISOPBO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (372) + ISOPBO2_M (250) ISOPBO2 -> HPALD + HO2 rate = 1.60E+09*exp( -8300./t) (373) + ISOPBO2_NO (251) ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 rate = 4.40E-12*exp( 180./t) (374) + + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + + 0.05*HYAC + ISOPBO2_NO3 (252) ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL rate = 2.40E-12 (375) + + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC + ISOPNITA_OH (253) ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O rate = 4.00E-11 (376) + + 0.3*HONITR + 0.3*HO2 + ISOPNITB_OH (254) ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR rate = 4.00E-11 (377) + ISOP_NO3 (255) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (378) + ISOPNO3_CH3CO3 (256) ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 rate = 1.40E-11 (379) + ISOPNO3_CH3O2 (257) ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH rate = 5.00E-13*exp( 400./t) (380) + + 0.2*NC4CH2OH + ISOPNO3_HO2 (258) ISOPNO3 + HO2 -> ISOPNOOH rate = 8.00E-13*exp( 700./t) (381) + ISOPNO3_NO (259) ISOPNO3 + NO -> NC4CHO + NO2 + HO2 rate = 2.70E-12*exp( 360./t) (382) + ISOPNO3_NO3 (260) ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 rate = 2.40E-12 (383) + ISOPNOOH_OH (261) ISOPNOOH + OH -> NOA + HO2 rate = 4.00E-11 (384) + ISOP_O3 (262) ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH rate = 1.05E-14*exp( -2000./t) (385) + + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + + 0.05*CH3O2 + ISOP_OH (263) ISOP + OH -> 0.6*ISOPAO2 + 0.4*ISOPBO2 rate = 2.54E-11*exp( 410./t) (386) + ISOPOOH_OH (264) ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH rate = 1.52E-11*exp( 200./t) (387) + NC4CH2OH_OH (265) NC4CH2OH + OH -> GLYALD + NOA + HO2 rate = 7.00E-11 (388) + NC4CHO_OH (266) NC4CHO + OH -> GLYOXAL + NOA + HO2 rate = 1.00E-10 (389) + XO2_CH3CO3 (267) XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (390) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 + XO2_CH3O2 (268) XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO rate = 5.00E-13*exp( 400./t) (391) + + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD + XO2_HO2 (269) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (392) + XO2_NO (270) XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL rate = 2.70E-12*exp( 360./t) (393) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + XO2_NO3 (271) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (394) + + 0.25*CH3COCHO + 0.25*GLYALD + XOOH_OH (272) XOOH + OH -> 0.5*XO2 + 0.5*OH rate = 1.52E-12*exp( 200./t) (395) + ACBZO2_HO2 (273) ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH rate = 4.30E-13*exp( 1040./t) (396) + ACBZO2_NO (274) ACBZO2 + NO -> C6H5O2 + NO2 rate = 7.50E-12*exp( 290./t) (397) + BENZENE_OH (275) BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 rate = 2.30E-12*exp( -193./t) (398) + BENZO2_HO2 (276) BENZO2 + HO2 -> BENZOOH rate = 7.50E-13*exp( 700./t) (399) + BENZO2_NO (277) BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 rate = 2.60E-12*exp( 365./t) (400) + BENZOOH_OH (278) BENZOOH + OH -> BENZO2 rate = 3.80E-12*exp( 200./t) (401) + BZALD_OH (279) BZALD + OH -> ACBZO2 rate = 5.90E-12*exp( 225./t) (402) + BZOO_HO2 (280) BZOO + HO2 -> BZOOH rate = 7.50E-13*exp( 700./t) (403) + BZOOH_OH (281) BZOOH + OH -> BZOO rate = 3.80E-12*exp( 200./t) (404) + BZOO_NO (282) BZOO + NO -> BZALD + NO2 + HO2 rate = 2.60E-12*exp( 365./t) (405) + C6H5O2_HO2 (283) C6H5O2 + HO2 -> C6H5OOH rate = 7.50E-13*exp( 700./t) (406) + C6H5O2_NO (284) C6H5O2 + NO -> PHENO + NO2 rate = 2.60E-12*exp( 365./t) (407) + C6H5OOH_OH (285) C6H5OOH + OH -> C6H5O2 rate = 3.80E-12*exp( 200./t) (408) + CRESOL_OH (286) CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO rate = 4.70E-11 (409) + DICARBO2_HO2 (287) DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO rate = 4.30E-13*exp( 1040./t) (410) + + 0.33*CH3O2 + DICARBO2_NO (288) DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO rate = 7.50E-12*exp( 290./t) (411) + + 0.83*CH3O2 + DICARBO2_NO2 (289) DICARBO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (412) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MALO2_HO2 (290) MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO rate = 4.30E-13*exp( 1040./t) (413) + MALO2_NO (291) MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 rate = 7.50E-12*exp( 290./t) (414) + MALO2_NO2 (292) MALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (415) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MDIALO2_HO2 (293) MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO rate = 4.30E-13*exp( 1040./t) (416) + + 0.07*CH3O2 + 0.07*GLYOXAL + MDIALO2_NO (294) MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO rate = 7.50E-12*exp( 290./t) (417) + + 0.17*CH3O2 + 0.17*GLYOXAL + MDIALO2_NO2 (295) MDIALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (418) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + PHENO2_HO2 (296) PHENO2 + HO2 -> PHENOOH rate = 7.50E-13*exp( 700./t) (419) + PHENO2_NO (297) PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 rate = 2.60E-12*exp( 365./t) (420) + PHENOL_OH (298) PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO rate = 4.70E-13*exp( 1220./t) (421) + PHENO_NO2 (299) PHENO + NO2 -> NDEP rate = 2.10E-12 (422) + PHENO_O3 (300) PHENO + O3 -> C6H5O2 rate = 2.80E-13 (423) + PHENOOH_OH (301) PHENOOH + OH -> PHENO2 rate = 3.80E-12*exp( 200./t) (424) + tag_ACBZO2_NO2 (302) ACBZO2 + NO2 + M -> PBZNIT + M troe : ko=9.70E-29*(300/t)**5.60 (425) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + TOLO2_HO2 (303) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (426) + TOLO2_NO (304) TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = 2.60E-12*exp( 365./t) (427) + + 0.2*BIGALD2 + 0.2*BIGALD3 + TOLOOH_OH (305) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (428) + TOLUENE_OH (306) TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 rate = 1.70E-12*exp( 352./t) (429) + + 0.28*HO2 + usr_PBZNIT_M (307) PBZNIT + M -> ACBZO2 + NO2 + M rate = ** User defined ** (430) + XYLENES_OH (308) XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO rate = 1.70E-11 (431) + + 0.56*XYLENO2 + 0.38*HO2 + XYLENO2_HO2 (309) XYLENO2 + HO2 -> XYLENOOH rate = 7.50E-13*exp( 700./t) (432) + XYLENO2_NO (310) XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = 2.60E-12*exp( 365./t) (433) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + XYLENOOH_OH (311) XYLENOOH + OH -> XYLENO2 rate = 3.80E-12*exp( 200./t) (434) + XYLOLO2_HO2 (312) XYLOLO2 + HO2 -> XYLOLOOH rate = 7.50E-13*exp( 700./t) (435) + XYLOLO2_NO (313) XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO rate = 2.60E-12*exp( 365./t) (436) + XYLOL_OH (314) XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO rate = 8.40E-11 (437) + XYLOLOOH_OH (315) XYLOLOOH + OH -> XYLOLO2 rate = 3.80E-12*exp( 200./t) (438) + BCARY_NO3 (316) BCARY + NO3 -> NTERPO2 rate = 1.90E-11 (439) + BCARY_O3 (317) BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 1.20E-14 (440) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + BCARY_OH (318) BCARY + OH -> TERPO2 rate = 2.00E-10 (441) + MTERP_NO3 (319) MTERP + NO3 -> NTERPO2 rate = 1.20E-12*exp( 490./t) (442) + MTERP_O3 (320) MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 6.30E-16*exp( -580./t) (443) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + MTERP_OH (321) MTERP + OH -> TERPO2 rate = 1.20E-11*exp( 440./t) (444) + NTERPO2_CH3O2 (322) NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 rate = 2.00E-12*exp( 500./t) (445) + + 0.5*TERPROD1 + 0.5*NO2 + NTERPO2_HO2 (323) NTERPO2 + HO2 -> NTERPOOH rate = 7.50E-13*exp( 700./t) (446) + NTERPO2_NO (324) NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP rate = 4.20E-12*exp( 180./t) (447) + NTERPO2_NO3 (325) NTERPO2 + NO3 -> 2*NO2 + TERPROD1 rate = 2.40E-12 (448) + NTERPOOH_OH (326) NTERPOOH + OH -> NTERPO2 rate = 2.00E-11 (449) + TERP2O2_CH3O2 (327) TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (450) + + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + + 0.15*CH3COCH3 + TERP2O2_HO2 (328) TERP2O2 + HO2 -> TERP2OOH rate = 7.50E-13*exp( 700./t) (451) + TERP2O2_NO (329) TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 rate = 4.20E-12*exp( 180./t) (452) + + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + + 0.225*GLYALD + TERP2OOH_OH (330) TERP2OOH + OH -> TERP2O2 rate = 2.30E-11 (453) + TERPNIT_OH (331) TERPNIT + OH -> NO2 + TERPROD1 rate = 2.00E-11 (454) + TERPO2_CH3O2 (332) TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (455) + + 0.025*CH3COCH3 + TERPO2_HO2 (333) TERPO2 + HO2 -> TERPOOH rate = 7.50E-13*exp( 700./t) (456) + TERPO2_NO (334) TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 rate = 4.20E-12*exp( 180./t) (457) + + 0.8*TERPROD1 + 0.8*HO2 + TERPOOH_OH (335) TERPOOH + OH -> TERPO2 rate = 3.30E-11 (458) + TERPROD1_NO3 (336) TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP rate = 1.00E-12 (459) + TERPROD1_OH (337) TERPROD1 + OH -> TERP2O2 rate = 5.70E-11 (460) + TERPROD2_OH (338) TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 rate = 3.40E-11 (461) + + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO + DMS_NO3 (339) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (462) + DMS_OHa (340) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (463) + OCS_O (341) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (464) + OCS_OH (342) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (465) + S_O2 (343) S + O2 -> SO + O rate = 2.30E-12 (466) + SO2_OH_M (344) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (467) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + S_O3 (345) S + O3 -> SO + O2 rate = 1.20E-11 (468) + SO_BRO (346) SO + BRO -> SO2 + BR rate = 5.70E-11 (469) + SO_CLO (347) SO + CLO -> SO2 + CL rate = 2.80E-11 (470) + S_OH (348) S + OH -> SO + H rate = 6.60E-11 (471) + SO_NO2 (349) SO + NO2 -> SO2 + NO rate = 1.40E-11 (472) + SO_O2 (350) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (473) + SO_O3 (351) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (474) + SO_OCLO (352) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (475) + SO_OH (353) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (476) + usr_DMS_OH (354) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (477) + usr_SO3_H2O (355) SO3 + H2O -> H2SO4 rate = ** User defined ** (478) + NH3_OH (356) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (479) + usr_GLYOXAL_aer (357) GLYOXAL -> SOAG0 rate = ** User defined ** (480) + usr_HO2_aer (358) HO2 -> H2O rate = ** User defined ** (481) + usr_HONITR_aer (359) HONITR -> HNO3 rate = ** User defined ** (482) + usr_ISOPNITA_aer (360) ISOPNITA -> HNO3 rate = ** User defined ** (483) + usr_ISOPNITB_aer (361) ISOPNITB -> HNO3 rate = ** User defined ** (484) + usr_N2O5_aer (362) N2O5 -> 2*HNO3 rate = ** User defined ** (485) + usr_NC4CH2OH_aer (363) NC4CH2OH -> HNO3 rate = ** User defined ** (486) + usr_NC4CHO_aer (364) NC4CHO -> HNO3 rate = ** User defined ** (487) + usr_NH4_strat_ta (365) NH4 -> NHDEP rate = 6.34E-08 (488) + usr_NO2_aer (366) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (489) + usr_NO3_aer (367) NO3 -> HNO3 rate = ** User defined ** (490) + usr_NTERPOOH_aer (368) NTERPOOH -> HNO3 rate = ** User defined ** (491) + usr_ONITR_aer (369) ONITR -> HNO3 rate = ** User defined ** (492) + usr_TERPNIT_aer (370) TERPNIT -> HNO3 rate = ** User defined ** (493) + BCARY_NO3_vbs (371) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.90E-11 (494) + BCARYO2_HO2_vbs (372) BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 2.75E-13*exp( 1300./t) (495) + + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 + BCARYO2_NO_vbs (373) BCARYO2VBS + NO -> NO + 0.1279*SOAG0 + 0.1792*SOAG1 + 0.0676*SOAG2 rate = 2.70E-12*exp( 360./t) (496) + + 0.079*SOAG3 + 0.1254*SOAG4 + BCARY_O3_vbs (374) BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 1.20E-14 (497) + + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 + BCARY_OH_vbs (375) BCARY + OH -> BCARY + OH + BCARYO2VBS rate = 2.00E-10 (498) + BENZENE_OH_vbs (376) BENZENE + OH -> BENZENE + OH + BENZO2VBS rate = 2.30E-12*exp( -193./t) (499) + BENZO2_HO2_vbs (377) BENZO2VBS + HO2 -> HO2 + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 rate = 7.50E-13*exp( 700./t) (500) + + 0.0443*SOAG3 + 0.1621*SOAG4 + BENZO2_NO_vbs (378) BENZO2VBS + NO -> NO + 0.0097*SOAG0 + 0.0034*SOAG1 + 0.1579*SOAG2 rate = 2.60E-12*exp( 365./t) (501) + + 0.0059*SOAG3 + 0.0536*SOAG4 + ISOP_NO3_vbs (379) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 rate = 3.03E-12*exp( -446./t) (502) + ISOPO2_HO2_vbs (380) ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 rate = 2.12E-13*exp( 1300./t) (503) + + 0.0271*SOAG3 + 0.0474*SOAG4 + ISOPO2_NO_vbs (381) ISOPO2VBS + NO -> NO + 0.0003*SOAG0 + 0.0003*SOAG1 + 0.0073*SOAG2 rate = 2.70E-12*exp( 350./t) (504) + + 0.0057*SOAG3 + 0.0623*SOAG4 + ISOP_O3_vbs (382) ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 rate = 1.05E-14*exp( -2000./t) (505) + ISOP_OH_vbs (383) ISOP + OH -> ISOP + OH + ISOPO2VBS rate = 2.54E-11*exp( 410./t) (506) + IVOCO2_HO2_vbs (384) IVOCO2VBS + HO2 -> HO2 + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 rate = 7.50E-13*exp( 700./t) (507) + + 0.0076*SOAG3 + 0.0113*SOAG4 + IVOCO2_NO_vbs (385) IVOCO2VBS + NO -> NO + 0.1056*SOAG0 + 0.1026*SOAG1 + 0.0521*SOAG2 rate = 2.60E-12*exp( 365./t) (508) + + 0.0143*SOAG3 + 0.0166*SOAG4 + IVOC_OH_vbs (386) IVOC + OH -> OH + IVOCO2VBS rate = 1.34E-11 (509) + MTERP_NO3_vbs (387) MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.20E-12*exp( 490./t) (510) + MTERPO2_HO2_vbs (388) MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 2.60E-13*exp( 1300./t) (511) + + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 + MTERPO2_NO_vbs (389) MTERPO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (512) + + 0.0332*SOAG3 + 0.13*SOAG4 + MTERP_O3_vbs (390) MTERP + O3 -> MTERP + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 6.30E-16*exp( -580./t) (513) + + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 + MTERP_OH_vbs (391) MTERP + OH -> MTERP + OH + MTERPO2VBS rate = 1.20E-11*exp( 440./t) (514) + SVOC_OH (392) SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 rate = 1.34E-11 (515) + + 0.0085*SOAG3 + 0.0128*SOAG4 + TOLUENE_OH_vbs (393) TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS rate = 1.70E-12*exp( 352./t) (516) + TOLUO2_HO2_vbs (394) TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 rate = 7.50E-13*exp( 700./t) (517) + + 0.2157*SOAG3 + 0.0738*SOAG4 + TOLUO2_NO_vbs (395) TOLUO2VBS + NO -> NO + 0.0154*SOAG0 + 0.0452*SOAG1 + 0.0966*SOAG2 rate = 2.60E-12*exp( 365./t) (518) + + 0.0073*SOAG3 + 0.238*SOAG4 + XYLENES_OH_vbs (396) XYLENES + OH -> XYLENES + OH + XYLEO2VBS rate = 1.70E-11 (519) + XYLEO2_HO2_vbs (397) XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 rate = 7.50E-13*exp( 700./t) (520) + + 0.0512*SOAG3 + 0.1598*SOAG4 + XYLEO2_NO_vbs (398) XYLEO2VBS + NO -> NO + 0.0063*SOAG0 + 0.0237*SOAG1 + 0.0025*SOAG2 rate = 2.60E-12*exp( 365./t) (521) + + 0.011*SOAG3 + 0.1185*SOAG4 + het1 (399) N2O5 -> 2*HNO3 rate = ** User defined ** (522) + het10 (400) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (523) + het11 (401) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (524) + het12 (402) N2O5 -> 2*HNO3 rate = ** User defined ** (525) + het13 (403) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (526) + het14 (404) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (527) + het15 (405) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (528) + het16 (406) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (529) + het17 (407) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (530) + het2 (408) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (531) + het3 (409) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (532) + het4 (410) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (533) + het5 (411) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (534) + het6 (412) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (535) + het7 (413) N2O5 -> 2*HNO3 rate = ** User defined ** (536) + het8 (414) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (537) + het9 (415) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (538) + NH_50_tau (416) NH_50 -> (No products) rate = 2.31E-07 (539) + NH_5_tau (417) NH_5 -> (No products) rate = 2.31E-06 (540) + ST80_25_tau (418) ST80_25 -> (No products) rate = 4.63E-07 (541) + +Extraneous prod/loss species + ( 1) num_a1 (dataset) + ( 2) num_a2 (dataset) + ( 3) so4_a1 (dataset) + ( 4) so4_a2 (dataset) + ( 5) so4_a5 (dataset) + ( 6) num_a4 (dataset) + ( 7) num_a5 (dataset) + ( 8) SO2 (dataset) + ( 9) NO2 (dataset) + (10) pom_a4 (dataset) + (11) bc_a4 (dataset) + (12) CO (dataset) + (13) SVOC (dataset) + (14) AOA_NH + (15) NO + (16) N + + + Equation Report + + d(ALKNIT)/dt = r236*ALKO2*NO + - j19*ALKNIT - r233*OH*ALKNIT + d(ALKOOH)/dt = r234*ALKO2*HO2 + - j20*ALKOOH - r237*OH*ALKOOH + d(AOA_NH)/dt = 0 + d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(BCARY)/dt = - r316*NO3*BCARY - r317*O3*BCARY - r318*OH*BCARY + d(BENZENE)/dt = - r275*OH*BENZENE + d(BENZOOH)/dt = r276*BENZO2*HO2 + - j21*BENZOOH - r278*OH*BENZOOH + d(BEPOMUC)/dt = .12*r275*BENZENE*OH + - j22*BEPOMUC + d(BIGALD)/dt = .1*r317*BCARY*O3 + .1*r320*MTERP*O3 + - j23*BIGALD + d(BIGALD1)/dt = .5*j21*BENZOOH + j22*BEPOMUC + .2*j70*TOLOOH + .06*j72*XYLENOOH + .5*r277*BENZO2*NO + + .2*r304*TOLO2*NO + .06*r310*XYLENO2*NO + - j24*BIGALD1 + d(BIGALD2)/dt = .2*j70*TOLOOH + .2*j72*XYLENOOH + .2*r304*TOLO2*NO + .2*r310*XYLENO2*NO + - j25*BIGALD2 + d(BIGALD3)/dt = j46*HPALD + j56*NC4CHO + .2*j70*TOLOOH + .15*j72*XYLENOOH + .2*r304*TOLO2*NO + + .15*r310*XYLENO2*NO + - j26*BIGALD3 + d(BIGALD4)/dt = .21*j72*XYLENOOH + .21*r310*XYLENO2*NO + - j27*BIGALD4 + d(BIGALK)/dt = .05*r317*BCARY*O3 + .05*r320*MTERP*O3 + - r238*OH*BIGALK + d(BIGENE)/dt = - r204*NO3*BIGENE - r205*OH*BIGENE + d(BR)/dt = j74*BRCL + j75*BRO + j77*BRONO2 + j79*CF2CLBR + j80*CF3BR + 2*j86*CH2BR2 + j87*CH3BR + + 3*j90*CHBR3 + 2*j98*H2402 + j99*HBR + j105*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*r115*CH2BR2*CL + + 2*r116*CH2BR2*OH + r117*CH3BR*CL + r118*CH3BR*OH + 3*r122*CHBR3*CL + 3*r123*CHBR3*OH + + 2*r127*O1D*CH2BR2 + r128*O1D*CH3BR + r346*SO*BRO + - r88*CH2O*BR - r89*HO2*BR - r90*O3*BR + d(BRCL)/dt = r94*BRO*CLO + r407*HOBR*HCL + r412*HOBR*HCL + - j74*BRCL + d(BRO)/dt = j76*BRONO2 + r90*BR*O3 + r98*BRONO2*O + r103*HOBR*O + r108*O1D*HBR + - j75*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 - r346*SO*BRO + d(BRONO2)/dt = r97*M*BRO*NO2 + - j76*BRONO2 - j77*BRONO2 - r401*BRONO2 - r404*BRONO2 - r409*BRONO2 - r98*O*BRONO2 + d(BRY)/dt = 0 + d(BZALD)/dt = j28*BZOOH + r282*BZOO*NO + - r279*OH*BZALD + d(BZOOH)/dt = r280*BZOO*HO2 + - j28*BZOOH - r281*OH*BZOOH + d(C2H2)/dt = - r153*M*CL*C2H2 - r154*M*OH*C2H2 + d(C2H4)/dt = - r155*M*CL*C2H4 - r156*O3*C2H4 - r181*M*OH*C2H4 + d(C2H5OH)/dt = .4*r157*C2H5O2*C2H5O2 + .2*r158*C2H5O2*CH3O2 + - r161*OH*C2H5OH + d(C2H5OOH)/dt = r159*C2H5O2*HO2 + - j29*C2H5OOH - r162*OH*C2H5OOH + d(C2H6)/dt = - r163*CL*C2H6 - r164*OH*C2H6 + d(C3H6)/dt = .7*j55*MVK + .13*r262*ISOP*O3 + - r184*NO3*C3H6 - r185*O3*C3H6 - r202*M*OH*C3H6 + d(C3H7OOH)/dt = r187*C3H7O2*HO2 + - j30*C3H7OOH - r189*OH*C3H7OOH + d(C3H8)/dt = - r190*OH*C3H8 + d(C6H5OOH)/dt = r283*C6H5O2*HO2 + - j31*C6H5OOH - r285*OH*C6H5OOH + d(CCL4)/dt = - j78*CCL4 - r77*O1D*CCL4 + d(CF2CLBR)/dt = - j79*CF2CLBR - r78*O1D*CF2CLBR + d(CF3BR)/dt = - j80*CF3BR - r104*O1D*CF3BR + d(CFC11)/dt = - j81*CFC11 - r79*O1D*CFC11 + d(CFC113)/dt = - j82*CFC113 - r80*O1D*CFC113 + d(CFC114)/dt = - j83*CFC114 - r81*O1D*CFC114 + d(CFC115)/dt = - j84*CFC115 - r82*O1D*CFC115 + d(CFC12)/dt = - j85*CFC12 - r83*O1D*CFC12 + d(CH2BR2)/dt = - j86*CH2BR2 - r115*CL*CH2BR2 - r116*OH*CH2BR2 - r127*O1D*CH2BR2 + d(CH2O)/dt = .1*j19*ALKNIT + .1*j20*ALKOOH + j38*CH3OOH + .18*j39*CH4 + j43*GLYALD + .33*j45*HONITR + + j47*HYAC + j49*ISOPOOH + 1.34*j50*MACR + j57*NOA + j62*POOH + j63*ROOH + .375*j65*TERP2OOH + + .4*j67*TERPOOH + .68*j69*TERPROD2 + r146*HOCH2OO + 2*r176*EO + r59*CLO*CH3O2 + + 2*r136*CH3O2*CH3O2 + r137*CH3O2*CH3O2 + r139*CH3O2*NO + r140*CH3OH*OH + .3*r141*CH3OOH*OH + + r149*O1D*CH4 + r150*O1D*CH4 + r156*C2H4*O3 + .7*r158*C2H5O2*CH3O2 + r169*CH3CO3*CH3O2 + + .5*r173*CH3COOOH*OH + .5*r175*EO2*NO + .8*r178*GLYALD*OH + r180*PAN*OH + .5*r185*C3H6*O3 + + r186*C3H7O2*CH3O2 + r196*PO2*NO + .8*r198*RO2*CH3O2 + .15*r199*RO2*HO2 + r200*RO2*NO + + .5*r204*BIGENE*NO3 + .5*r206*ENEO2*NO + .25*r209*MACRO2*CH3CO3 + .88*r210*MACRO2*CH3O2 + + .25*r212*MACRO2*NO3 + .25*r213*MACRO2*NO + .12*r215*MACR*O3 + r218*MCO3*CH3CO3 + + 2*r219*MCO3*CH3O2 + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + r222*MCO3*NO + r223*MCO3*NO3 + + .5*r228*M*MPAN*OH + .6*r229*MVK*O3 + .4*r233*ALKNIT*OH + .1*r235*ALKO2*NO + + r242*ISOPAO2*CH3CO3 + 1.5*r243*ISOPAO2*CH3O2 + .92*r245*ISOPAO2*NO + r246*ISOPAO2*NO3 + + .75*r248*ISOPBO2*CH3O2 + .3*r253*ISOPNITA*OH + .8*r257*ISOPNO3*CH3O2 + .91*r262*ISOP*O3 + + .25*r267*XO2*CH3CO3 + .8*r268*XO2*CH3O2 + .25*r270*XO2*NO + .34*r317*BCARY*O3 + + .34*r320*MTERP*O3 + .75*r322*NTERPO2*CH3O2 + .93*r327*TERP2O2*CH3O2 + .34*r329*TERP2O2*NO + + .95*r332*TERPO2*CH3O2 + .32*r334*TERPO2*NO + .68*r338*TERPROD2*OH + - j32*CH2O - j33*CH2O - r52*CL*CH2O - r88*BR*CH2O - r132*HO2*CH2O - r133*NO3*CH2O + - r134*O*CH2O - r135*OH*CH2O + d(CH3BR)/dt = - j87*CH3BR - r117*CL*CH3BR - r118*OH*CH3BR - r128*O1D*CH3BR + d(CH3CCL3)/dt = - j88*CH3CCL3 - r119*OH*CH3CCL3 + d(CH3CHO)/dt = .4*j19*ALKNIT + .4*j20*ALKOOH + j29*C2H5OOH + .33*j45*HONITR + j53*MEKOOH + j62*POOH + + 1.6*r157*C2H5O2*C2H5O2 + .8*r158*C2H5O2*CH3O2 + r160*C2H5O2*NO + r161*C2H5OH*OH + + .5*r162*C2H5OOH*OH + .5*r185*C3H6*O3 + .27*r188*C3H7O2*NO + r196*PO2*NO + r204*BIGENE*NO3 + + r206*ENEO2*NO + .2*r224*MEKO2*HO2 + r225*MEKO2*NO + .1*r229*MVK*O3 + .8*r233*ALKNIT*OH + + .4*r235*ALKO2*NO + - j34*CH3CHO - r165*NO3*CH3CHO - r166*OH*CH3CHO + d(CH3CL)/dt = - j89*CH3CL - r120*CL*CH3CL - r121*OH*CH3CL + d(CH3CN)/dt = - r167*OH*CH3CN + d(CH3COCH3)/dt = .25*j19*ALKNIT + .25*j20*ALKOOH + .82*j30*C3H7OOH + .17*j45*HONITR + .3*j65*TERP2OOH + + .05*j67*TERPOOH + .5*j69*TERPROD2 + .82*r186*C3H7O2*CH3O2 + .82*r188*C3H7O2*NO + + .5*r204*BIGENE*NO3 + .5*r206*ENEO2*NO + .8*r233*ALKNIT*OH + .25*r235*ALKO2*NO + + .52*r317*BCARY*O3 + .52*r320*MTERP*O3 + .15*r327*TERP2O2*CH3O2 + .27*r329*TERP2O2*NO + + .025*r332*TERPO2*CH3O2 + .04*r334*TERPO2*NO + .5*r338*TERPROD2*OH + - j35*CH3COCH3 - r203*OH*CH3COCH3 + d(CH3COCHO)/dt = .18*j23*BIGALD + j27*BIGALD4 + .4*j70*TOLOOH + .54*j72*XYLENOOH + .51*j73*XYLOLOOH + + r193*HYAC*OH + r194*NOA*OH + .5*r198*RO2*CH3O2 + .25*r209*MACRO2*CH3CO3 + + .24*r210*MACRO2*CH3O2 + .25*r212*MACRO2*NO3 + .25*r213*MACRO2*NO + .88*r215*MACR*O3 + + .5*r229*MVK*O3 + .05*r251*ISOPBO2*NO + .05*r252*ISOPBO2*NO3 + .25*r267*XO2*CH3CO3 + + .1*r268*XO2*CH3O2 + .25*r270*XO2*NO + .25*r271*XO2*NO3 + .07*r287*DICARBO2*HO2 + + .17*r288*DICARBO2*NO + .07*r293*MDIALO2*HO2 + .17*r294*MDIALO2*NO + .4*r304*TOLO2*NO + + .54*r310*XYLENO2*NO + .51*r313*XYLOLO2*NO + - j36*CH3COCHO - r191*NO3*CH3COCHO - r192*OH*CH3COCHO + d(CH3COOH)/dt = .1*r169*CH3CO3*CH3O2 + .15*r170*CH3CO3*HO2 + .12*r185*C3H6*O3 + .15*r220*MCO3*HO2 + - r172*OH*CH3COOH + d(CH3COOOH)/dt = .4*r170*CH3CO3*HO2 + .4*r220*MCO3*HO2 + - j37*CH3COOOH - r173*OH*CH3COOOH + d(CH3OH)/dt = r137*CH3O2*CH3O2 + .3*r158*C2H5O2*CH3O2 + .5*r198*RO2*CH3O2 + .25*r210*MACRO2*CH3O2 + + .25*r243*ISOPAO2*CH3O2 + .25*r248*ISOPBO2*CH3O2 + .2*r257*ISOPNO3*CH3O2 + .3*r268*XO2*CH3O2 + + .25*r322*NTERPO2*CH3O2 + .25*r327*TERP2O2*CH3O2 + .25*r332*TERPO2*CH3O2 + - r140*OH*CH3OH + d(CH3OOH)/dt = r138*CH3O2*HO2 + - j38*CH3OOH - r141*OH*CH3OOH + d(CH4)/dt = .1*r185*C3H6*O3 + - j39*CH4 - j40*CH4 - r53*CL*CH4 - r109*F*CH4 - r142*OH*CH4 - r148*O1D*CH4 - r149*O1D*CH4 + - r150*O1D*CH4 + d(CHBR3)/dt = - j90*CHBR3 - r105*O1D*CHBR3 - r122*CL*CHBR3 - r123*OH*CHBR3 + d(CL)/dt = j74*BRCL + 4*j78*CCL4 + j79*CF2CLBR + 2*j81*CFC11 + 2*j82*CFC113 + 2*j83*CFC114 + j84*CFC115 + + 2*j85*CFC12 + 3*j88*CH3CCL3 + j89*CH3CL + 2*j91*CL2 + 2*j92*CL2O2 + j93*CLO + j94*CLONO2 + + j97*COFCL + j100*HCFC141B + j101*HCFC142B + j102*HCFC22 + j103*HCL + j106*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 + 2*r79*O1D*CFC11 + 2*r80*O1D*CFC113 + 2*r81*O1D*CFC114 + + r82*O1D*CFC115 + 2*r83*O1D*CFC12 + r84*O1D*HCL + r93*BRO*CLO + r114*O1D*COFCL + + 3*r119*CH3CCL3*OH + r121*CH3CL*OH + r124*HCFC141B*OH + r125*HCFC142B*OH + r126*HCFC22*OH + + r129*O1D*HCFC141B + r130*O1D*HCFC142B + r131*O1D*HCFC22 + r347*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 - r115*CH2BR2*CL - r117*CH3BR*CL - r120*CH3CL*CL - r122*CHBR3*CL + - r163*C2H6*CL + d(CL2)/dt = r61*CLO*CLO + r65*CLONO2*CL + r400*HOCL*HCL + r405*CLONO2*HCL + r406*HOCL*HCL + r410*CLONO2*HCL + + r411*HOCL*HCL + r415*CLONO2*HCL + - j91*CL2 + d(CL2O2)/dt = r86*M*CLO*CLO + - j92*CL2O2 - r87*M*CL2O2 + d(CLO)/dt = j95*CLONO2 + j107*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 + r352*SO*OCLO + - j93*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 - r347*SO*CLO + d(CLONO2)/dt = r66*M*CLO*NO2 + - j94*CLONO2 - j95*CLONO2 - r403*CLONO2 - r408*CLONO2 - r414*CLONO2 - r65*CL*CLONO2 + - r67*O*CLONO2 - r68*OH*CLONO2 - r405*HCL*CLONO2 - r410*HCL*CLONO2 - r415*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = 1.5*j22*BEPOMUC + .45*j23*BIGALD + .6*j26*BIGALD3 + j27*BIGALD4 + j32*CH2O + j33*CH2O + + j34*CH3CHO + j36*CH3COCHO + .38*j39*CH4 + j41*CO2 + j43*GLYALD + 2*j44*GLYOXAL + + .33*j45*HONITR + 1.34*j51*MACR + .7*j55*MVK + 1.5*j64*TEPOMUC + .25*j65*TERP2OOH + j68*TERPROD1 + + 1.7*j69*TERPROD2 + j110*OCS + r52*CL*CH2O + r88*BR*CH2O + r120*CH3CL*CL + r133*CH2O*NO3 + + r134*CH2O*O + r135*CH2O*OH + .35*r154*M*C2H2*OH + .63*r156*C2H4*O3 + r179*GLYOXAL*OH + + .56*r185*C3H6*O3 + r191*CH3COCHO*NO3 + r192*CH3COCHO*OH + .22*r209*MACRO2*CH3CO3 + + .11*r210*MACRO2*CH3O2 + .22*r212*MACRO2*NO3 + .22*r213*MACRO2*NO + .65*r215*MACR*O3 + + .56*r229*MVK*O3 + .62*r262*ISOP*O3 + .25*r267*XO2*CH3CO3 + .2*r268*XO2*CH3O2 + .25*r270*XO2*NO + + .5*r271*XO2*NO3 + .07*r287*DICARBO2*HO2 + .17*r288*DICARBO2*NO + .16*r290*MALO2*HO2 + + .4*r291*MALO2*NO + .14*r293*MDIALO2*HO2 + .35*r294*MDIALO2*NO + .23*r317*BCARY*O3 + + .23*r320*MTERP*O3 + .125*r327*TERP2O2*CH3O2 + .225*r329*TERP2O2*NO + .7*r338*TERPROD2*OH + + r341*OCS*O + r342*OCS*OH + - r152*OH*CO + d(CO2)/dt = j37*CH3COOOH + .44*j39*CH4 + .4*j60*PAN + j65*TERP2OOH + .8*j69*TERPROD2 + r144*HCOOH*OH + + r152*CO*OH + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + r171*CH3CO3*NO + r172*CH3COOH*OH + + .5*r173*CH3COOOH*OH + .8*r178*GLYALD*OH + r179*GLYOXAL*OH + .2*r185*C3H6*O3 + + 2*r218*MCO3*CH3CO3 + r219*MCO3*CH3O2 + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + .5*r228*M*MPAN*OH + + .1*r229*MVK*O3 + r242*ISOPAO2*CH3CO3 + r267*XO2*CH3CO3 + .27*r317*BCARY*O3 + .27*r320*MTERP*O3 + + .5*r327*TERP2O2*CH3O2 + .9*r329*TERP2O2*NO + 1.8*r338*TERPROD2*OH + - j41*CO2 + d(COF2)/dt = j79*CF2CLBR + j80*CF3BR + j82*CFC113 + 2*j83*CFC114 + 2*j84*CFC115 + j85*CFC12 + 2*j98*H2402 + + j101*HCFC142B + j102*HCFC22 + r78*O1D*CF2CLBR + r80*O1D*CFC113 + 2*r81*O1D*CFC114 + + 2*r82*O1D*CFC115 + r83*O1D*CFC12 + r104*O1D*CF3BR + 2*r106*O1D*H2402 + r125*HCFC142B*OH + + r126*HCFC22*OH + r130*O1D*HCFC142B + r131*O1D*HCFC22 + - j96*COF2 - r113*O1D*COF2 + d(COFCL)/dt = j81*CFC11 + j82*CFC113 + j100*HCFC141B + r79*O1D*CFC11 + r80*O1D*CFC113 + r124*HCFC141B*OH + + r129*O1D*HCFC141B + - j97*COFCL - r114*O1D*COFCL + d(CRESOL)/dt = .18*r306*TOLUENE*OH + - r286*OH*CRESOL + d(DMS)/dt = - r339*NO3*DMS - r340*OH*DMS - r354*OH*DMS + d(dst_a1)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(E90)/dt = - r1*E90 + d(EOOH)/dt = r174*EO2*HO2 + - j42*EOOH + d(F)/dt = j80*CF3BR + j84*CFC115 + 2*j96*COF2 + j97*COFCL + j104*HF + r82*O1D*CFC115 + r104*O1D*CF3BR + + 2*r113*O1D*COF2 + r114*O1D*COFCL + - r109*CH4*F - r110*H2*F - r111*H2O*F - r112*HNO3*F + d(GLYALD)/dt = .33*j45*HONITR + .25*j65*TERP2OOH + r177*O2*EO + .53*r209*MACRO2*CH3CO3 + .26*r210*MACRO2*CH3O2 + + .53*r212*MACRO2*NO3 + .53*r213*MACRO2*NO + .05*r251*ISOPBO2*NO + .05*r252*ISOPBO2*NO3 + + .7*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH + r265*NC4CH2OH*OH + .25*r267*XO2*CH3CO3 + + .1*r268*XO2*CH3O2 + .25*r270*XO2*NO + .25*r271*XO2*NO3 + .125*r327*TERP2O2*CH3O2 + + .225*r329*TERP2O2*NO + - j43*GLYALD - r178*OH*GLYALD + d(GLYOXAL)/dt = j21*BENZOOH + .13*j23*BIGALD + .7*j61*PHENOOH + .6*j70*TOLOOH + .34*j72*XYLENOOH + + .17*j73*XYLOLOOH + .65*r154*M*C2H2*OH + .2*r178*GLYALD*OH + .05*r251*ISOPBO2*NO + + .05*r252*ISOPBO2*NO3 + r266*NC4CHO*OH + .25*r267*XO2*CH3CO3 + .1*r268*XO2*CH3O2 + + .25*r270*XO2*NO + .25*r271*XO2*NO3 + r277*BENZO2*NO + .16*r290*MALO2*HO2 + .4*r291*MALO2*NO + + .07*r293*MDIALO2*HO2 + .17*r294*MDIALO2*NO + .7*r297*PHENO2*NO + .6*r304*TOLO2*NO + + .34*r310*XYLENO2*NO + .17*r313*XYLOLO2*NO + - j44*GLYOXAL - r357*GLYOXAL - r179*OH*GLYOXAL + d(H)/dt = j2*H2O + 2*j3*H2O + 2*j33*CH2O + j38*CH3OOH + .33*j39*CH4 + j40*CH4 + j99*HBR + j103*HCL + + j104*HF + r2*O1D*H2 + r10*H2*O + r19*OH*H2 + r22*OH*O + r40*N*OH + r54*CL*H2 + r85*O1D*HCL + + r108*O1D*HBR + r110*F*H2 + r135*CH2O*OH + r149*O1D*CH4 + r342*OCS*OH + r348*S*OH + r353*SO*OH + - r15*O2*M*H - r12*HO2*H - r13*HO2*H - r14*HO2*H - r18*O3*H + d(H2)/dt = j1*H2O + j32*CH2O + 1.4400001*j39*CH4 + r12*H*HO2 + r150*O1D*CH4 + - r2*O1D*H2 - r10*O*H2 - r19*OH*H2 - r54*CL*H2 - r110*F*H2 + d(H2402)/dt = - j98*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 = r355*SO3*H2O + - j109*H2SO4 + d(HBR)/dt = r88*BR*CH2O + r89*BR*HO2 + - j99*HBR - r101*O*HBR - r102*OH*HBR - r107*O1D*HBR - r108*O1D*HBR + d(HCFC141B)/dt = - j100*HCFC141B - r124*OH*HCFC141B - r129*O1D*HCFC141B + d(HCFC142B)/dt = - j101*HCFC142B - r125*OH*HCFC142B - r130*O1D*HCFC142B + d(HCFC22)/dt = - j102*HCFC22 - r126*OH*HCFC22 - r131*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 + + r115*CH2BR2*CL + r117*CH3BR*CL + 2*r120*CH3CL*CL + r122*CHBR3*CL + r163*C2H6*CL + - j103*HCL - r72*O*HCL - r73*OH*HCL - r84*O1D*HCL - r85*O1D*HCL - r400*HOCL*HCL + - r405*CLONO2*HCL - r406*HOCL*HCL - r407*HOBR*HCL - r410*CLONO2*HCL - r411*HOCL*HCL + - r412*HOBR*HCL - r415*CLONO2*HCL + d(HCN)/dt = - r143*M*OH*HCN - r151*O1D*HCN + d(HCOOH)/dt = r145*HOCH2OO*HO2 + r147*HOCH2OO*NO + .35*r154*M*C2H2*OH + .37*r156*C2H4*O3 + .12*r185*C3H6*O3 + + .33*r215*MACR*O3 + .12*r229*MVK*O3 + .11*r262*ISOP*O3 + .05*r317*BCARY*O3 + .05*r320*MTERP*O3 + - r144*OH*HCOOH + d(HF)/dt = r109*F*CH4 + r110*F*H2 + r111*F*H2O + r112*F*HNO3 + - j104*HF + d(HNO3)/dt = r359*HONITR + r360*ISOPNITA + r361*ISOPNITB + 2*r362*N2O5 + r363*NC4CH2OH + r364*NC4CHO + + .5*r366*NO2 + r367*NO3 + r368*NTERPOOH + r369*ONITR + r370*TERPNIT + 2*r399*N2O5 + + r401*BRONO2 + 2*r402*N2O5 + r403*CLONO2 + r404*BRONO2 + r408*CLONO2 + r409*BRONO2 + + 2*r413*N2O5 + r414*CLONO2 + r48*M*NO2*OH + r133*CH2O*NO3 + r165*CH3CHO*NO3 + + r191*CH3COCHO*NO3 + r339*DMS*NO3 + r405*CLONO2*HCL + r410*CLONO2*HCL + r415*CLONO2*HCL + - j9*HNO3 - r49*OH*HNO3 - r112*F*HNO3 + d(HO2NO2)/dt = r46*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r50*M*HO2NO2 - r27*OH*HO2NO2 + d(HOBR)/dt = r401*BRONO2 + r404*BRONO2 + r409*BRONO2 + r95*BRO*HO2 + - j105*HOBR - r103*O*HOBR - r407*HCL*HOBR - r412*HCL*HOBR + d(HOCL)/dt = r403*CLONO2 + r408*CLONO2 + r414*CLONO2 + r63*CLO*HO2 + r68*CLONO2*OH + - j106*HOCL - r74*CL*HOCL - r75*O*HOCL - r76*OH*HOCL - r400*HCL*HOCL - r406*HCL*HOCL + - r411*HCL*HOCL + d(HONITR)/dt = r207*ENEO2*NO + r214*MACRO2*NO + .3*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH + - j45*HONITR - r359*HONITR - r208*OH*HONITR + d(HPALD)/dt = r250*ISOPBO2 + - j46*HPALD - r239*OH*HPALD + d(HYAC)/dt = .17*j45*HONITR + .5*r197*POOH*OH + .2*r198*RO2*CH3O2 + .22*r209*MACRO2*CH3CO3 + + .23*r210*MACRO2*CH3O2 + .22*r212*MACRO2*NO3 + .22*r213*MACRO2*NO + .5*r228*M*MPAN*OH + + .05*r251*ISOPBO2*NO + .05*r252*ISOPBO2*NO3 + .7*r253*ISOPNITA*OH + .5*r254*ISOPNITB*OH + + .25*r267*XO2*CH3CO3 + .1*r268*XO2*CH3O2 + .25*r270*XO2*NO + .25*r271*XO2*NO3 + - j47*HYAC - r193*OH*HYAC + d(HYDRALD)/dt = r247*ISOPBO2*CH3CO3 + .75*r248*ISOPBO2*CH3O2 + .87*r251*ISOPBO2*NO + .95*r252*ISOPBO2*NO3 + - r240*OH*HYDRALD + d(IEPOX)/dt = .6*r264*ISOPOOH*OH + - r241*OH*IEPOX + d(ISOP)/dt = - r255*NO3*ISOP - r262*O3*ISOP - r263*OH*ISOP + d(ISOPNITA)/dt = .08*r245*ISOPAO2*NO + - r360*ISOPNITA - r253*OH*ISOPNITA + d(ISOPNITB)/dt = .08*r251*ISOPBO2*NO + - r361*ISOPNITB - r254*OH*ISOPNITB + d(ISOPNO3)/dt = r255*ISOP*NO3 + - r256*CH3CO3*ISOPNO3 - r257*CH3O2*ISOPNO3 - r258*HO2*ISOPNO3 - r259*NO*ISOPNO3 + - r260*NO3*ISOPNO3 + d(ISOPNOOH)/dt = r258*ISOPNO3*HO2 + - j48*ISOPNOOH - r261*OH*ISOPNOOH + d(ISOPOOH)/dt = j48*ISOPNOOH + r244*ISOPAO2*HO2 + r249*ISOPBO2*HO2 + - j49*ISOPOOH - r264*OH*ISOPOOH + d(IVOC)/dt = - r386*OH*IVOC + d(MACR)/dt = .3*j49*ISOPOOH + .39*r242*ISOPAO2*CH3CO3 + .31*r243*ISOPAO2*CH3O2 + .36*r245*ISOPAO2*NO + + .4*r246*ISOPAO2*NO3 + .3*r262*ISOP*O3 + - j50*MACR - j51*MACR - r215*O3*MACR - r216*OH*MACR + d(MACROOH)/dt = r211*MACRO2*HO2 + - r217*OH*MACROOH + d(MEK)/dt = .8*j19*ALKNIT + .8*j20*ALKOOH + .8*r235*ALKO2*NO + - j52*MEK - r226*OH*MEK + d(MEKOOH)/dt = .8*r224*MEKO2*HO2 + - j53*MEKOOH - r227*OH*MEKOOH + d(MPAN)/dt = r231*M*MCO3*NO2 + - j54*MPAN - r232*M*MPAN - r228*M*OH*MPAN + d(MTERP)/dt = - r319*NO3*MTERP - r320*O3*MTERP - r321*OH*MTERP + d(MVK)/dt = .7*j49*ISOPOOH + .61*r242*ISOPAO2*CH3CO3 + .44*r243*ISOPAO2*CH3O2 + .56*r245*ISOPAO2*NO + + .6*r246*ISOPAO2*NO3 + .2*r262*ISOP*O3 + - j55*MVK - r229*O3*MVK - r230*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 - r362*N2O5 - r399*N2O5 - r402*N2O5 - r413*N2O5 + d(NC4CH2OH)/dt = .2*r257*ISOPNO3*CH3O2 + - r363*NC4CH2OH - r265*OH*NC4CH2OH + d(NC4CHO)/dt = r256*ISOPNO3*CH3CO3 + .8*r257*ISOPNO3*CH3O2 + r259*ISOPNO3*NO + r260*ISOPNO3*NO3 + - j56*NC4CHO - r364*NC4CHO - r266*OH*NC4CHO + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 + d(ncl_a3)/dt = 0 + d(NH3)/dt = - r356*OH*NH3 + d(NH4)/dt = - r365*NH4 + d(NH_5)/dt = - r417*NH_5 + d(NH_50)/dt = - r416*NH_50 + d(NO)/dt = j14*N2O5 + j16*NO2 + j17*NO3 + r32*O2*N + .5*r366*NO2 + 2*r30*N*NO2 + r33*NO2*O + r40*N*OH + + 2*r44*O1D*N2O + r349*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 - r139*CH3O2*NO - r147*HOCH2OO*NO - r160*C2H5O2*NO - r171*CH3CO3*NO - r175*EO2*NO + - r188*C3H7O2*NO - r196*PO2*NO - r200*RO2*NO - r206*ENEO2*NO - r207*ENEO2*NO - r213*MACRO2*NO + - r214*MACRO2*NO - r222*MCO3*NO - r225*MEKO2*NO - r235*ALKO2*NO - r236*ALKO2*NO - r245*ISOPAO2*NO + - r251*ISOPBO2*NO - r259*ISOPNO3*NO - r270*XO2*NO - r274*ACBZO2*NO - r277*BENZO2*NO + - r282*BZOO*NO - r284*C6H5O2*NO - r288*DICARBO2*NO - r291*MALO2*NO - r294*MDIALO2*NO + - r297*PHENO2*NO - r304*TOLO2*NO - r310*XYLENO2*NO - r313*XYLOLO2*NO - r324*NTERPO2*NO + - r329*TERP2O2*NO - r334*TERPO2*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j19*ALKNIT + j45*HONITR + j48*ISOPNOOH + j54*MPAN + + j56*NC4CHO + j57*NOA + j58*NTERPOOH + j59*ONITR + .6*j60*PAN + j66*TERPNIT + j76*BRONO2 + + j95*CLONO2 + r50*M*HO2NO2 + r51*M*N2O5 + r183*M*PAN + r232*M*MPAN + r307*M*PBZNIT + + 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 + r139*CH3O2*NO + r147*HOCH2OO*NO + r160*C2H5O2*NO + + r171*CH3CO3*NO + r175*EO2*NO + r188*C3H7O2*NO + r194*NOA*OH + r196*PO2*NO + r200*RO2*NO + + r204*BIGENE*NO3 + r206*ENEO2*NO + r212*MACRO2*NO3 + r213*MACRO2*NO + r222*MCO3*NO + + r223*MCO3*NO3 + r225*MEKO2*NO + r233*ALKNIT*OH + r235*ALKO2*NO + .92*r245*ISOPAO2*NO + + r246*ISOPAO2*NO3 + .92*r251*ISOPBO2*NO + r252*ISOPBO2*NO3 + .7*r253*ISOPNITA*OH + + r259*ISOPNO3*NO + r260*ISOPNO3*NO3 + r270*XO2*NO + r271*XO2*NO3 + r274*ACBZO2*NO + + r277*BENZO2*NO + r282*BZOO*NO + r284*C6H5O2*NO + r288*DICARBO2*NO + r291*MALO2*NO + + r294*MDIALO2*NO + r297*PHENO2*NO + r304*TOLO2*NO + r310*XYLENO2*NO + r313*XYLOLO2*NO + + .5*r322*NTERPO2*CH3O2 + 1.6*r324*NTERPO2*NO + 2*r325*NTERPO2*NO3 + .9*r329*TERP2O2*NO + + r331*TERPNIT*OH + .8*r334*TERPO2*NO + - j16*NO2 - r366*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 + - r182*M*CH3CO3*NO2 - r231*M*MCO3*NO2 - r289*M*DICARBO2*NO2 - r292*M*MALO2*NO2 + - r295*M*MDIALO2*NO2 - r299*PHENO*NO2 - r302*M*ACBZO2*NO2 - r349*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j60*PAN + j77*BRONO2 + j94*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 + r112*F*HNO3 + r180*PAN*OH + .5*r228*M*MPAN*OH + - j17*NO3 - j18*NO3 - r367*NO3 - r36*HO2*NO3 - r37*NO*NO3 - r38*O*NO3 - r39*OH*NO3 + - r47*M*NO2*NO3 - r133*CH2O*NO3 - r165*CH3CHO*NO3 - r184*C3H6*NO3 - r191*CH3COCHO*NO3 + - r204*BIGENE*NO3 - r212*MACRO2*NO3 - r223*MCO3*NO3 - r246*ISOPAO2*NO3 - r252*ISOPBO2*NO3 + - r255*ISOP*NO3 - r260*ISOPNO3*NO3 - r271*XO2*NO3 - r316*BCARY*NO3 - r319*MTERP*NO3 + - r325*NTERPO2*NO3 - r336*TERPROD1*NO3 - r339*DMS*NO3 + d(NOA)/dt = r184*C3H6*NO3 + .5*r254*ISOPNITB*OH + r261*ISOPNOOH*OH + r265*NC4CH2OH*OH + r266*NC4CHO*OH + - j57*NOA - r194*OH*NOA + d(NTERPOOH)/dt = r323*NTERPO2*HO2 + - j58*NTERPOOH - r368*NTERPOOH - r326*OH*NTERPOOH + 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*j39*CH4 + + j41*CO2 + j75*BRO + j93*CLO + j107*OCLO + j111*SO + j112*SO2 + j113*SO3 + r4*N2*O1D + + r5*O2*O1D + r32*O2*N + r343*O2*S + r350*O2*SO + r14*H*HO2 + r24*OH*OH + r28*N*NO + r29*N*NO2 + - 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 - r134*CH2O*O - r341*OCS*O + d(O3)/dt = r9*O2*M*O + .15*r170*CH3CO3*HO2 + .15*r220*MCO3*HO2 + - j7*O3 - j8*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 - r156*C2H4*O3 - r185*C3H6*O3 - r215*MACR*O3 - r229*MVK*O3 + - r262*ISOP*O3 - r300*PHENO*O3 - r317*BCARY*O3 - r320*MTERP*O3 - r345*S*O3 - r351*SO*O3 + d(O3S)/dt = 0 + d(OCLO)/dt = r62*CLO*CLO + r92*BRO*CLO + - j107*OCLO - r352*SO*OCLO + d(OCS)/dt = - j110*OCS - r341*O*OCS - r342*OH*OCS + d(ONITR)/dt = r208*HONITR*OH + .1*r329*TERP2O2*NO + - j59*ONITR - r369*ONITR + d(PAN)/dt = r182*M*CH3CO3*NO2 + - j60*PAN - r183*M*PAN - r180*OH*PAN + d(PBZNIT)/dt = r302*M*ACBZO2*NO2 + - r307*M*PBZNIT + d(PHENO)/dt = j31*C6H5OOH + r284*C6H5O2*NO + .07*r286*CRESOL*OH + .06*r298*PHENOL*OH + .07*r314*XYLOL*OH + - r299*NO2*PHENO - r300*O3*PHENO + d(PHENOL)/dt = .53*r275*BENZENE*OH + - r298*OH*PHENOL + d(PHENOOH)/dt = r296*PHENO2*HO2 + - j61*PHENOOH - r301*OH*PHENOOH + d(pom_a1)/dt = 0 + d(pom_a4)/dt = 0 + d(POOH)/dt = r195*PO2*HO2 + - j62*POOH - r197*OH*POOH + d(ROOH)/dt = .85*r199*RO2*HO2 + - j63*ROOH - r201*OH*ROOH + d(S)/dt = j110*OCS + j111*SO + - r343*O2*S - r345*O3*S - r348*OH*S + d(SF6)/dt = - j108*SF6 + d(SO)/dt = j112*SO2 + r343*O2*S + r341*OCS*O + r345*S*O3 + r348*S*OH + - j111*SO - r350*O2*SO - r346*BRO*SO - r347*CLO*SO - r349*NO2*SO - r351*O3*SO - r352*OCLO*SO + - r353*OH*SO + d(SO2)/dt = j113*SO3 + r350*O2*SO + r339*DMS*NO3 + r340*DMS*OH + r342*OCS*OH + r346*SO*BRO + r347*SO*CLO + + r349*SO*NO2 + r351*SO*O3 + r352*SO*OCLO + r353*SO*OH + .5*r354*DMS*OH + - j112*SO2 - r344*M*OH*SO2 + d(SO3)/dt = j109*H2SO4 + r344*M*SO2*OH + - j113*SO3 - r355*H2O*SO3 + d(so4_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(so4_a3)/dt = 0 + d(so4_a5)/dt = 0 + d(soa1_a1)/dt = - j114*soa1_a1 + d(soa1_a2)/dt = - j115*soa1_a2 + d(soa2_a1)/dt = - j116*soa2_a1 + d(soa2_a2)/dt = - j117*soa2_a2 + d(soa3_a1)/dt = - j118*soa3_a1 + d(soa3_a2)/dt = - j119*soa3_a2 + d(soa4_a1)/dt = - j120*soa4_a1 + d(soa4_a2)/dt = - j121*soa4_a2 + d(soa5_a1)/dt = - j122*soa5_a1 + d(soa5_a2)/dt = - j123*soa5_a2 + d(SOAG0)/dt = r357*GLYOXAL + .2202*r372*BCARYO2VBS*HO2 + .1279*r373*BCARYO2VBS*NO + .2202*r374*BCARY*O3 + + .0023*r377*BENZO2VBS*HO2 + .0097*r378*BENZO2VBS*NO + .0031*r380*ISOPO2VBS*HO2 + + .0003*r381*ISOPO2VBS*NO + .2381*r384*IVOCO2VBS*HO2 + .1056*r385*IVOCO2VBS*NO + + .0508*r388*MTERPO2VBS*HO2 + .0245*r389*MTERPO2VBS*NO + .0508*r390*MTERP*O3 + + .5931*r392*SVOC*OH + .1364*r394*TOLUO2VBS*HO2 + .0154*r395*TOLUO2VBS*NO + + .1677*r397*XYLEO2VBS*HO2 + .0063*r398*XYLEO2VBS*NO + d(SOAG1)/dt = .2067*r372*BCARYO2VBS*HO2 + .1792*r373*BCARYO2VBS*NO + .2067*r374*BCARY*O3 + + .0008*r377*BENZO2VBS*HO2 + .0034*r378*BENZO2VBS*NO + .0035*r380*ISOPO2VBS*HO2 + + .0003*r381*ISOPO2VBS*NO + .1308*r384*IVOCO2VBS*HO2 + .1026*r385*IVOCO2VBS*NO + + .1149*r388*MTERPO2VBS*HO2 + .0082*r389*MTERPO2VBS*NO + .1149*r390*MTERP*O3 + + .1534*r392*SVOC*OH + .0101*r394*TOLUO2VBS*HO2 + .0452*r395*TOLUO2VBS*NO + + .0174*r397*XYLEO2VBS*HO2 + .0237*r398*XYLEO2VBS*NO + d(SOAG2)/dt = .0653*r372*BCARYO2VBS*HO2 + .0676*r373*BCARYO2VBS*NO + .0653*r374*BCARY*O3 + + .0843*r377*BENZO2VBS*HO2 + .1579*r378*BENZO2VBS*NO + .0003*r380*ISOPO2VBS*HO2 + + .0073*r381*ISOPO2VBS*NO + .0348*r384*IVOCO2VBS*HO2 + .0521*r385*IVOCO2VBS*NO + + .0348*r388*MTERPO2VBS*HO2 + .0772*r389*MTERPO2VBS*NO + .0348*r390*MTERP*O3 + + .0459*r392*SVOC*OH + .0763*r394*TOLUO2VBS*HO2 + .0966*r395*TOLUO2VBS*NO + + .086*r397*XYLEO2VBS*HO2 + .0025*r398*XYLEO2VBS*NO + d(SOAG3)/dt = .17493*r371*BCARY*NO3 + .1284*r372*BCARYO2VBS*HO2 + .079*r373*BCARYO2VBS*NO + .1284*r374*BCARY*O3 + + .0443*r377*BENZO2VBS*HO2 + .0059*r378*BENZO2VBS*NO + .059024*r379*ISOP*NO3 + + .0271*r380*ISOPO2VBS*HO2 + .0057*r381*ISOPO2VBS*NO + .0033*r382*ISOP*O3 + + .0076*r384*IVOCO2VBS*HO2 + .0143*r385*IVOCO2VBS*NO + .17493*r387*MTERP*NO3 + + .0554*r388*MTERPO2VBS*HO2 + .0332*r389*MTERPO2VBS*NO + .0554*r390*MTERP*O3 + + .0085*r392*SVOC*OH + .2157*r394*TOLUO2VBS*HO2 + .0073*r395*TOLUO2VBS*NO + + .0512*r397*XYLEO2VBS*HO2 + .011*r398*XYLEO2VBS*NO + d(SOAG4)/dt = .59019*r371*BCARY*NO3 + .114*r372*BCARYO2VBS*HO2 + .1254*r373*BCARYO2VBS*NO + .114*r374*BCARY*O3 + + .1621*r377*BENZO2VBS*HO2 + .0536*r378*BENZO2VBS*NO + .025024*r379*ISOP*NO3 + + .0474*r380*ISOPO2VBS*HO2 + .0623*r381*ISOPO2VBS*NO + .0113*r384*IVOCO2VBS*HO2 + + .0166*r385*IVOCO2VBS*NO + .59019*r387*MTERP*NO3 + .1278*r388*MTERPO2VBS*HO2 + + .13*r389*MTERPO2VBS*NO + .1278*r390*MTERP*O3 + .0128*r392*SVOC*OH + .0738*r394*TOLUO2VBS*HO2 + + .238*r395*TOLUO2VBS*NO + .1598*r397*XYLEO2VBS*HO2 + .1185*r398*XYLEO2VBS*NO + d(ST80_25)/dt = - r418*ST80_25 + d(SVOC)/dt = - r392*OH*SVOC + d(TEPOMUC)/dt = .1*r306*TOLUENE*OH + .23*r308*XYLENES*OH + - j64*TEPOMUC + d(TERP2OOH)/dt = r328*TERP2O2*HO2 + - j65*TERP2OOH - r330*OH*TERP2OOH + d(TERPNIT)/dt = .5*r322*NTERPO2*CH3O2 + .2*r324*NTERPO2*NO + .2*r334*TERPO2*NO + - j66*TERPNIT - r370*TERPNIT - r331*OH*TERPNIT + d(TERPOOH)/dt = r333*TERPO2*HO2 + - j67*TERPOOH - r335*OH*TERPOOH + d(TERPROD1)/dt = j58*NTERPOOH + j66*TERPNIT + j67*TERPOOH + .33*r317*BCARY*O3 + .33*r320*MTERP*O3 + + .5*r322*NTERPO2*CH3O2 + .8*r324*NTERPO2*NO + r325*NTERPO2*NO3 + r331*TERPNIT*OH + + r332*TERPO2*CH3O2 + .8*r334*TERPO2*NO + - j68*TERPROD1 - r336*NO3*TERPROD1 - r337*OH*TERPROD1 + d(TERPROD2)/dt = j65*TERP2OOH + j68*TERPROD1 + .3*r317*BCARY*O3 + .3*r320*MTERP*O3 + r327*TERP2O2*CH3O2 + + .9*r329*TERP2O2*NO + - j69*TERPROD2 - r338*OH*TERPROD2 + d(TOLOOH)/dt = r303*TOLO2*HO2 + - j70*TOLOOH - r305*OH*TOLOOH + d(TOLUENE)/dt = - r306*OH*TOLUENE + d(XOOH)/dt = r269*XO2*HO2 + - j71*XOOH - r272*OH*XOOH + d(XYLENES)/dt = - r308*OH*XYLENES + d(XYLENOOH)/dt = r309*XYLENO2*HO2 + - j72*XYLENOOH - r311*OH*XYLENOOH + d(XYLOL)/dt = .15*r308*XYLENES*OH + - r314*OH*XYLOL + d(XYLOLOOH)/dt = r312*XYLOLO2*HO2 + - j73*XYLOLOOH - r315*OH*XYLOLOOH + d(NHDEP)/dt = r365*NH4 + r356*NH3*OH + d(NDEP)/dt = .5*r228*M*MPAN*OH + r289*M*DICARBO2*NO2 + r292*M*MALO2*NO2 + r295*M*MDIALO2*NO2 + r299*PHENO*NO2 + + .2*r324*NTERPO2*NO + .5*r336*TERPROD1*NO3 + d(ACBZO2)/dt = r307*M*PBZNIT + r279*BZALD*OH + - r273*HO2*ACBZO2 - r274*NO*ACBZO2 - r302*M*NO2*ACBZO2 + d(ALKO2)/dt = r237*ALKOOH*OH + r238*BIGALK*OH + - r234*HO2*ALKO2 - r235*NO*ALKO2 - r236*NO*ALKO2 + d(BCARYO2VBS)/dt = r375*BCARY*OH + - r372*HO2*BCARYO2VBS - r373*NO*BCARYO2VBS + d(BENZO2)/dt = .35*r275*BENZENE*OH + r278*BENZOOH*OH + - r276*HO2*BENZO2 - r277*NO*BENZO2 + d(BENZO2VBS)/dt = r376*BENZENE*OH + - r377*HO2*BENZO2VBS - r378*NO*BENZO2VBS + d(BZOO)/dt = r281*BZOOH*OH + .07*r306*TOLUENE*OH + .06*r308*XYLENES*OH + - r280*HO2*BZOO - r282*NO*BZOO + d(C2H5O2)/dt = j52*MEK + .5*r162*C2H5OOH*OH + r163*C2H6*CL + r164*C2H6*OH + - 2*r157*C2H5O2*C2H5O2 - r158*CH3O2*C2H5O2 - r159*HO2*C2H5O2 - r160*NO*C2H5O2 + d(C3H7O2)/dt = r189*C3H7OOH*OH + r190*C3H8*OH + - r186*CH3O2*C3H7O2 - r187*HO2*C3H7O2 - r188*NO*C3H7O2 + d(C6H5O2)/dt = .4*r273*ACBZO2*HO2 + r274*ACBZO2*NO + r285*C6H5OOH*OH + r300*PHENO*O3 + - r283*HO2*C6H5O2 - r284*NO*C6H5O2 + d(CH3CO3)/dt = .13*j23*BIGALD + j27*BIGALD4 + j35*CH3COCH3 + j36*CH3COCHO + .33*j45*HONITR + j47*HYAC + + 1.34*j50*MACR + j52*MEK + j53*MEKOOH + .3*j55*MVK + j57*NOA + .6*j60*PAN + j63*ROOH + + .5*j64*TEPOMUC + .65*j69*TERPROD2 + r183*M*PAN + r165*CH3CHO*NO3 + r166*CH3CHO*OH + + .5*r173*CH3COOOH*OH + r191*CH3COCHO*NO3 + r192*CH3COCHO*OH + .3*r198*RO2*CH3O2 + + .15*r199*RO2*HO2 + r200*RO2*NO + .53*r209*MACRO2*CH3CO3 + .26*r210*MACRO2*CH3O2 + + .53*r212*MACRO2*NO3 + .53*r213*MACRO2*NO + .1*r215*MACR*O3 + r219*MCO3*CH3O2 + + .45*r220*MCO3*HO2 + 2*r221*MCO3*MCO3 + r222*MCO3*NO + r223*MCO3*NO3 + .2*r224*MEKO2*HO2 + + r225*MEKO2*NO + .28*r229*MVK*O3 + .08*r262*ISOP*O3 + .06*r317*BCARY*O3 + .06*r320*MTERP*O3 + + .65*r338*TERPROD2*OH + - 2*r168*CH3CO3*CH3CO3 - r169*CH3O2*CH3CO3 - r170*HO2*CH3CO3 - r171*NO*CH3CO3 + - r182*M*NO2*CH3CO3 - r209*MACRO2*CH3CO3 - r242*ISOPAO2*CH3CO3 - r247*ISOPBO2*CH3CO3 + - r256*ISOPNO3*CH3CO3 - r267*XO2*CH3CO3 + d(CH3O2)/dt = j34*CH3CHO + j35*CH3COCH3 + j37*CH3COOOH + j40*CH4 + .3*j55*MVK + .4*j60*PAN + j87*CH3BR + + j89*CH3CL + r53*CL*CH4 + r109*F*CH4 + .7*r141*CH3OOH*OH + r142*CH4*OH + r148*O1D*CH4 + + 2*r168*CH3CO3*CH3CO3 + .9*r169*CH3CO3*CH3O2 + .45*r170*CH3CO3*HO2 + r171*CH3CO3*NO + + r172*CH3COOH*OH + .28*r185*C3H6*O3 + r209*MACRO2*CH3CO3 + r218*MCO3*CH3CO3 + + r242*ISOPAO2*CH3CO3 + r247*ISOPBO2*CH3CO3 + r256*ISOPNO3*CH3CO3 + .05*r262*ISOP*O3 + + r267*XO2*CH3CO3 + .33*r287*DICARBO2*HO2 + .83*r288*DICARBO2*NO + .07*r293*MDIALO2*HO2 + + .17*r294*MDIALO2*NO + - r59*CLO*CH3O2 - 2*r136*CH3O2*CH3O2 - 2*r137*CH3O2*CH3O2 - r138*HO2*CH3O2 - r139*NO*CH3O2 + - r158*C2H5O2*CH3O2 - r169*CH3CO3*CH3O2 - r186*C3H7O2*CH3O2 - r198*RO2*CH3O2 + - r210*MACRO2*CH3O2 - r219*MCO3*CH3O2 - r243*ISOPAO2*CH3O2 - r248*ISOPBO2*CH3O2 + - r257*ISOPNO3*CH3O2 - r268*XO2*CH3O2 - r322*NTERPO2*CH3O2 - r327*TERP2O2*CH3O2 + - r332*TERPO2*CH3O2 + d(DICARBO2)/dt = .6*j25*BIGALD2 + - r287*HO2*DICARBO2 - r288*NO*DICARBO2 - r289*M*NO2*DICARBO2 + d(ENEO2)/dt = r205*BIGENE*OH + - r206*NO*ENEO2 - r207*NO*ENEO2 + d(EO)/dt = j42*EOOH + .75*r175*EO2*NO + - r176*EO - r177*O2*EO + d(EO2)/dt = r181*M*C2H4*OH + - r174*HO2*EO2 - r175*NO*EO2 + d(HO2)/dt = j11*HO2NO2 + j19*ALKNIT + .9*j20*ALKOOH + j21*BENZOOH + 1.5*j22*BEPOMUC + .56*j23*BIGALD + + j24*BIGALD1 + .6*j25*BIGALD2 + .6*j26*BIGALD3 + j27*BIGALD4 + j28*BZOOH + j29*C2H5OOH + + j30*C3H7OOH + j34*CH3CHO + j36*CH3COCHO + 2*j43*GLYALD + 2*j44*GLYOXAL + .67*j45*HONITR + + j46*HPALD + j47*HYAC + j48*ISOPNOOH + j49*ISOPOOH + 1.34*j50*MACR + .66*j51*MACR + j56*NC4CHO + + j61*PHENOOH + j62*POOH + j64*TEPOMUC + j65*TERP2OOH + j66*TERPNIT + j67*TERPOOH + + j68*TERPROD1 + 1.2*j69*TERPROD2 + j70*TOLOOH + j72*XYLENOOH + j73*XYLOLOOH + r15*O2*M*H + + r50*M*HO2NO2 + r146*HOCH2OO + r176*EO + r177*O2*EO + r250*ISOPBO2 + 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 + r117*CH3BR*CL + r118*CH3BR*OH + r120*CH3CL*CL + r121*CH3CL*OH + r133*CH2O*NO3 + + r134*CH2O*O + 2*r136*CH3O2*CH3O2 + r139*CH3O2*NO + r140*CH3OH*OH + r143*M*HCN*OH + + r144*HCOOH*OH + r147*HOCH2OO*NO + r149*O1D*CH4 + r152*CO*OH + .35*r154*M*C2H2*OH + + .13*r156*C2H4*O3 + 1.2*r157*C2H5O2*C2H5O2 + r158*C2H5O2*CH3O2 + r160*C2H5O2*NO + r161*C2H5OH*OH + + r167*CH3CN*OH + .9*r169*CH3CO3*CH3O2 + .25*r175*EO2*NO + r178*GLYALD*OH + r179*GLYOXAL*OH + + .28*r185*C3H6*O3 + r186*C3H7O2*CH3O2 + r188*C3H7O2*NO + r193*HYAC*OH + r196*PO2*NO + + .3*r198*RO2*CH3O2 + r206*ENEO2*NO + r208*HONITR*OH + .47*r209*MACRO2*CH3CO3 + + .73*r210*MACRO2*CH3O2 + .47*r212*MACRO2*NO3 + .47*r213*MACRO2*NO + .14*r215*MACR*O3 + + .2*r217*MACROOH*OH + r219*MCO3*CH3O2 + .5*r228*M*MPAN*OH + .28*r229*MVK*O3 + r235*ALKO2*NO + + r242*ISOPAO2*CH3CO3 + r243*ISOPAO2*CH3O2 + .92*r245*ISOPAO2*NO + r246*ISOPAO2*NO3 + + r247*ISOPBO2*CH3CO3 + r248*ISOPBO2*CH3O2 + .92*r251*ISOPBO2*NO + r252*ISOPBO2*NO3 + + .3*r253*ISOPNITA*OH + r254*ISOPNITB*OH + r256*ISOPNO3*CH3CO3 + 1.2*r257*ISOPNO3*CH3O2 + + r259*ISOPNO3*NO + r260*ISOPNO3*NO3 + r261*ISOPNOOH*OH + .37*r262*ISOP*O3 + r265*NC4CH2OH*OH + + r266*NC4CHO*OH + r267*XO2*CH3CO3 + .8*r268*XO2*CH3O2 + r270*XO2*NO + r271*XO2*NO3 + + .65*r275*BENZENE*OH + r277*BENZO2*NO + r282*BZOO*NO + .73*r286*CRESOL*OH + + .07*r287*DICARBO2*HO2 + .17*r288*DICARBO2*NO + .16*r290*MALO2*HO2 + .4*r291*MALO2*NO + + .33*r293*MDIALO2*HO2 + .83*r294*MDIALO2*NO + r297*PHENO2*NO + .8*r298*PHENOL*OH + r304*TOLO2*NO + + .28*r306*TOLUENE*OH + .38*r308*XYLENES*OH + r310*XYLENO2*NO + r313*XYLOLO2*NO + + .63*r314*XYLOL*OH + .57*r317*BCARY*O3 + .57*r320*MTERP*O3 + .5*r322*NTERPO2*CH3O2 + + r327*TERP2O2*CH3O2 + .9*r329*TERP2O2*NO + r332*TERPO2*CH3O2 + .8*r334*TERPO2*NO + + .2*r338*TERPROD2*OH + r344*M*SO2*OH + .5*r354*DMS*OH + - r358*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 - r132*CH2O*HO2 - r138*CH3O2*HO2 - r145*HOCH2OO*HO2 + - r159*C2H5O2*HO2 - r170*CH3CO3*HO2 - r174*EO2*HO2 - r187*C3H7O2*HO2 - r195*PO2*HO2 + - r199*RO2*HO2 - r211*MACRO2*HO2 - r220*MCO3*HO2 - r224*MEKO2*HO2 - r234*ALKO2*HO2 + - r244*ISOPAO2*HO2 - r249*ISOPBO2*HO2 - r258*ISOPNO3*HO2 - r269*XO2*HO2 - r273*ACBZO2*HO2 + - r276*BENZO2*HO2 - r280*BZOO*HO2 - r283*C6H5O2*HO2 - r287*DICARBO2*HO2 - r290*MALO2*HO2 + - r293*MDIALO2*HO2 - r296*PHENO2*HO2 - r303*TOLO2*HO2 - r309*XYLENO2*HO2 - r312*XYLOLO2*HO2 + - r323*NTERPO2*HO2 - r328*TERP2O2*HO2 - r333*TERPO2*HO2 + d(HOCH2OO)/dt = r132*CH2O*HO2 + - r146*HOCH2OO - r145*HO2*HOCH2OO - r147*NO*HOCH2OO + d(ISOPAO2)/dt = .6*r263*ISOP*OH + - r242*CH3CO3*ISOPAO2 - r243*CH3O2*ISOPAO2 - r244*HO2*ISOPAO2 - r245*NO*ISOPAO2 + - r246*NO3*ISOPAO2 + d(ISOPBO2)/dt = .4*r263*ISOP*OH + - r250*ISOPBO2 - r247*CH3CO3*ISOPBO2 - r248*CH3O2*ISOPBO2 - r249*HO2*ISOPBO2 + - r251*NO*ISOPBO2 - r252*NO3*ISOPBO2 + d(ISOPO2VBS)/dt = r383*ISOP*OH + - r380*HO2*ISOPO2VBS - r381*NO*ISOPO2VBS + d(IVOCO2VBS)/dt = r386*IVOC*OH + - r384*HO2*IVOCO2VBS - r385*NO*IVOCO2VBS + d(MACRO2)/dt = .5*r216*MACR*OH + .2*r217*MACROOH*OH + r230*MVK*OH + - r209*CH3CO3*MACRO2 - r210*CH3O2*MACRO2 - r211*HO2*MACRO2 - r212*NO3*MACRO2 - r213*NO*MACRO2 + - r214*NO*MACRO2 + d(MALO2)/dt = .6*j24*BIGALD1 + - r290*HO2*MALO2 - r291*NO*MALO2 - r292*M*NO2*MALO2 + d(MCO3)/dt = .66*j50*MACR + j54*MPAN + r232*M*MPAN + .5*r216*MACR*OH + .5*r217*MACROOH*OH + - r218*CH3CO3*MCO3 - r219*CH3O2*MCO3 - r220*HO2*MCO3 - 2*r221*MCO3*MCO3 - r222*NO*MCO3 + - r223*NO3*MCO3 - r231*M*NO2*MCO3 + d(MDIALO2)/dt = .6*j26*BIGALD3 + - r293*HO2*MDIALO2 - r294*NO*MDIALO2 - r295*M*NO2*MDIALO2 + d(MEKO2)/dt = r226*MEK*OH + r227*MEKOOH*OH + - r224*HO2*MEKO2 - r225*NO*MEKO2 + d(MTERPO2VBS)/dt = r391*MTERP*OH + - r388*HO2*MTERPO2VBS - r389*NO*MTERPO2VBS + d(NTERPO2)/dt = r316*BCARY*NO3 + r319*MTERP*NO3 + r326*NTERPOOH*OH + .5*r336*TERPROD1*NO3 + - r322*CH3O2*NTERPO2 - r323*HO2*NTERPO2 - r324*NO*NTERPO2 - r325*NO3*NTERPO2 + d(O1D)/dt = j5*O2 + j1*H2O + j7*O3 + j12*N2O + - r4*N2*O1D - r5*O2*O1D - r2*H2*O1D - r3*H2O*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 - r113*COF2*O1D - r114*COFCL*O1D + - r127*CH2BR2*O1D - r128*CH3BR*O1D - r129*HCFC141B*O1D - r130*HCFC142B*O1D - r131*HCFC22*O1D + - r148*CH4*O1D - r149*CH4*O1D - r150*CH4*O1D - r151*HCN*O1D + d(OH)/dt = j2*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j20*ALKOOH + j21*BENZOOH + j28*BZOOH + j29*C2H5OOH + + j30*C3H7OOH + j31*C6H5OOH + j37*CH3COOOH + j38*CH3OOH + .33*j39*CH4 + j42*EOOH + j46*HPALD + + j49*ISOPOOH + j53*MEKOOH + j58*NTERPOOH + j61*PHENOOH + j62*POOH + j63*ROOH + j65*TERP2OOH + + j67*TERPOOH + j70*TOLOOH + j71*XOOH + j72*XYLENOOH + j73*XYLOLOOH + j105*HOBR + j106*HOCL + + .5*r366*NO2 + r2*O1D*H2 + 2*r3*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 + r111*F*H2O + r134*CH2O*O + + .3*r141*CH3OOH*OH + r148*O1D*CH4 + r151*O1D*HCN + .65*r154*M*C2H2*OH + .13*r156*C2H4*O3 + + .5*r162*C2H5OOH*OH + .45*r170*CH3CO3*HO2 + .36*r185*C3H6*O3 + .5*r197*POOH*OH + .15*r199*RO2*HO2 + + .24*r215*MACR*O3 + .1*r217*MACROOH*OH + .45*r220*MCO3*HO2 + .2*r224*MEKO2*HO2 + .36*r229*MVK*O3 + + .32*r262*ISOP*O3 + .6*r264*ISOPOOH*OH + .5*r272*XOOH*OH + .4*r273*ACBZO2*HO2 + + .4*r287*DICARBO2*HO2 + .4*r293*MDIALO2*HO2 + .63*r317*BCARY*O3 + .63*r320*MTERP*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 + - r116*CH2BR2*OH - r118*CH3BR*OH - r119*CH3CCL3*OH - r121*CH3CL*OH - r123*CHBR3*OH + - r124*HCFC141B*OH - r125*HCFC142B*OH - r126*HCFC22*OH - r135*CH2O*OH - r140*CH3OH*OH + - r141*CH3OOH*OH - r142*CH4*OH - r143*M*HCN*OH - r144*HCOOH*OH - r152*CO*OH - r154*M*C2H2*OH + - r161*C2H5OH*OH - r162*C2H5OOH*OH - r164*C2H6*OH - r166*CH3CHO*OH - r167*CH3CN*OH + - r172*CH3COOH*OH - r173*CH3COOOH*OH - r178*GLYALD*OH - r179*GLYOXAL*OH - r180*PAN*OH + - r181*M*C2H4*OH - r189*C3H7OOH*OH - r190*C3H8*OH - r192*CH3COCHO*OH - r193*HYAC*OH - r194*NOA*OH + - r197*POOH*OH - r201*ROOH*OH - r202*M*C3H6*OH - r203*CH3COCH3*OH - r205*BIGENE*OH + - r208*HONITR*OH - r216*MACR*OH - r217*MACROOH*OH - r226*MEK*OH - r227*MEKOOH*OH - r228*M*MPAN*OH + - r230*MVK*OH - r233*ALKNIT*OH - r237*ALKOOH*OH - r238*BIGALK*OH - r239*HPALD*OH + - r240*HYDRALD*OH - r241*IEPOX*OH - r253*ISOPNITA*OH - r254*ISOPNITB*OH - r261*ISOPNOOH*OH + - r263*ISOP*OH - r264*ISOPOOH*OH - r265*NC4CH2OH*OH - r266*NC4CHO*OH - r272*XOOH*OH + - r275*BENZENE*OH - r278*BENZOOH*OH - r279*BZALD*OH - r281*BZOOH*OH - r285*C6H5OOH*OH + - r286*CRESOL*OH - r298*PHENOL*OH - r301*PHENOOH*OH - r305*TOLOOH*OH - r306*TOLUENE*OH + - r308*XYLENES*OH - r311*XYLENOOH*OH - r314*XYLOL*OH - r315*XYLOLOOH*OH - r318*BCARY*OH + - r321*MTERP*OH - r326*NTERPOOH*OH - r330*TERP2OOH*OH - r331*TERPNIT*OH - r335*TERPOOH*OH + - r337*TERPROD1*OH - r338*TERPROD2*OH - r340*DMS*OH - r342*OCS*OH - r344*M*SO2*OH - r348*S*OH + - r353*SO*OH - r354*DMS*OH - r356*NH3*OH + d(PHENO2)/dt = .2*r286*CRESOL*OH + .14*r298*PHENOL*OH + r301*PHENOOH*OH + - r296*HO2*PHENO2 - r297*NO*PHENO2 + d(PO2)/dt = .5*r197*POOH*OH + r202*M*C3H6*OH + - r195*HO2*PO2 - r196*NO*PO2 + d(RO2)/dt = .15*j69*TERPROD2 + r201*ROOH*OH + r203*CH3COCH3*OH + .06*r317*BCARY*O3 + .06*r320*MTERP*O3 + + .15*r338*TERPROD2*OH + - r198*CH3O2*RO2 - r199*HO2*RO2 - r200*NO*RO2 + d(TERP2O2)/dt = r330*TERP2OOH*OH + .5*r336*TERPROD1*NO3 + r337*TERPROD1*OH + - r327*CH3O2*TERP2O2 - r328*HO2*TERP2O2 - r329*NO*TERP2O2 + d(TERPO2)/dt = r318*BCARY*OH + r321*MTERP*OH + r335*TERPOOH*OH + - r332*CH3O2*TERPO2 - r333*HO2*TERPO2 - r334*NO*TERPO2 + d(TOLO2)/dt = r305*TOLOOH*OH + .65*r306*TOLUENE*OH + - r303*HO2*TOLO2 - r304*NO*TOLO2 + d(TOLUO2VBS)/dt = r393*TOLUENE*OH + - r394*HO2*TOLUO2VBS - r395*NO*TOLUO2VBS + d(XO2)/dt = r239*HPALD*OH + r240*HYDRALD*OH + r241*IEPOX*OH + .4*r264*ISOPOOH*OH + .5*r272*XOOH*OH + - r267*CH3CO3*XO2 - r268*CH3O2*XO2 - r269*HO2*XO2 - r270*NO*XO2 - r271*NO3*XO2 + d(XYLENO2)/dt = .56*r308*XYLENES*OH + r311*XYLENOOH*OH + - r309*HO2*XYLENO2 - r310*NO*XYLENO2 + d(XYLEO2VBS)/dt = r396*XYLENES*OH + - r397*HO2*XYLEO2VBS - r398*NO*XYLEO2VBS + d(XYLOLO2)/dt = .3*r314*XYLOL*OH + r315*XYLOLOOH*OH + - r312*HO2*XYLOLO2 - r313*NO*XYLOLO2 + d(H2O)/dt = .05*j39*CH4 + j109*H2SO4 + r358*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 + + r116*CH2BR2*OH + r118*CH3BR*OH + r119*CH3CCL3*OH + r121*CH3CL*OH + r126*HCFC22*OH + + r135*CH2O*OH + r141*CH3OOH*OH + r142*CH4*OH + r144*HCOOH*OH + r164*C2H6*OH + r166*CH3CHO*OH + + r172*CH3COOH*OH + r173*CH3COOOH*OH + r189*C3H7OOH*OH + r190*C3H8*OH + r192*CH3COCHO*OH + + r197*POOH*OH + r201*ROOH*OH + r203*CH3COCH3*OH + .5*r216*MACR*OH + r356*NH3*OH + r400*HOCL*HCL + + r406*HOCL*HCL + r407*HOBR*HCL + r411*HOCL*HCL + r412*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r3*O1D*H2O - r111*F*H2O - r355*SO3*H2O diff --git a/src/chemistry/pp_trop_strat_mam5_vbs/chem_mech.in b/src/chemistry/pp_trop_strat_mam5_vbs/chem_mech.in new file mode 100644 index 0000000000..23ab67fcd7 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/chem_mech.in @@ -0,0 +1,1204 @@ +* Comments +* User-given Tag Description: TS1.2-simpleVBS +* Tag database identifier : MZ316_TS1.2_20221220 +* Tag created by : lke +* Tag created from branch : TS1.2 +* Tag created on : 2022-12-20 13:49:25.762835-07 +* Comments for this tag follow: +* lke : 2022-12-20 : TS1 with JPL19 updates, NOx-dependent VBS-SOA + + SPECIES + + Solution + ALKNIT -> C5H11ONO2, + ALKOOH -> C5H12O2, + AOA_NH -> CO, + bc_a1 -> C, + bc_a4 -> C, + BCARY -> C15H24, + BENZENE -> C6H6, + BENZOOH -> C6H8O5, + BEPOMUC -> C6H6O3, + BIGALD -> C5H6O2, + BIGALD1 -> C4H4O2, + BIGALD2 -> C5H6O2, + BIGALD3 -> C5H6O2, + BIGALD4 -> C6H8O2, + BIGALK -> C5H12, + BIGENE -> C4H8, + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + BZALD -> C7H6O, + BZOOH -> C7H8O2, + C2H2, + C2H4, + C2H5OH, + C2H5OOH, + C2H6, + C3H6, + C3H7OOH, + C3H8, + C6H5OOH -> C6H5OOH, + 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, + CH3CN, + CH3COCH3, + CH3COCHO, + CH3COOH, + CH3COOOH, + CH3OH, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + COF2, + COFCL -> COFCl, + CRESOL -> C7H8O, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + E90 -> CO, + EOOH -> HOCH2CH2OOH, + F, + GLYALD -> HOCH2CHO, + GLYOXAL -> C2H2O2, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HCN, + HCOOH, + HF, + HNO3, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + HONITR -> C4H9NO4, + HPALD -> HOOCH2CCH3CHCHO, + HYAC -> CH3COCH2OH, + HYDRALD -> HOCH2CCH3CHCHO, + IEPOX -> C5H10O3, + ISOP -> C5H8, + ISOPNITA -> C5H9NO4, + ISOPNITB -> C5H9NO4, + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, + ISOPNOOH -> C5H9NO5, + ISOPOOH -> HOCH2COOHCH3CHCH2, + IVOC -> C13H28, + MACR -> CH2CCH3CHO, + MACROOH -> CH3COCHOOHCH2OH, + MEK -> C4H8O, + MEKOOH -> C4H8O3, + MPAN -> CH2CCH3CO3NO2, + MTERP -> C10H16, + MVK -> CH2CHCOCH3, + N, + N2O, + N2O5, + NC4CH2OH -> C5H9NO4, + NC4CHO -> C5H7NO4, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + NH3, + NH4, + NH_5 -> CO, + NH_50 -> CO, + NO, + NO2, + NO3, + NOA -> CH3COCH2ONO2, + NTERPOOH -> C10H17NO5, + 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, + PBZNIT -> C7H5O3NO2, + PHENO -> C6H5O, + PHENOL -> C6H5OH, + PHENOOH -> C6H8O6, + 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, + soa1_a1 -> C15H38O2, + soa1_a2 -> C15H38O2, + soa2_a1 -> C15H38O2, + soa2_a2 -> C15H38O2, + soa3_a1 -> C15H38O2, + soa3_a2 -> C15H38O2, + soa4_a1 -> C15H38O2, + soa4_a2 -> C15H38O2, + soa5_a1 -> C15H38O2, + soa5_a2 -> C15H38O2, + SOAG0 -> C15H38O2, + SOAG1 -> C15H38O2, + SOAG2 -> C15H38O2, + SOAG3 -> C15H38O2, + SOAG4 -> C15H38O2, + ST80_25 -> CO, + SVOC -> C22H46, + TEPOMUC -> C7H8O3, + TERP2OOH -> C10H16O4, + TERPNIT -> C10H17NO4, + TERPOOH -> C10H18O3, + TERPROD1 -> C10H16O2, + TERPROD2 -> C9H14O2, + TOLOOH -> C7H10O5, + TOLUENE -> C7H8, + XOOH -> HOCH2COOHCH3CHOHCHO, + XYLENES -> C8H10, + XYLENOOH -> C8H12O5, + XYLOL -> C8H10O, + XYLOLOOH -> C8H12O6, + NHDEP -> N, + NDEP -> N, + ACBZO2 -> C7H5O3, + ALKO2 -> C5H11O2, + BCARYO2VBS -> C15H25O3, + BENZO2 -> C6H7O5, + BENZO2VBS -> C6H7O5, + BZOO -> C7H7O2, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2 -> C5H5O4, + ENEO2 -> C4H9O3, + EO -> HOCH2CH2O, + EO2 -> HOCH2CH2O2, + HO2, + HOCH2OO, + ISOPAO2 -> HOC5H8O2, + ISOPBO2 -> HOC5H8O2, + ISOPO2VBS -> C5H9O3, + IVOCO2VBS -> C13H29O3, + MACRO2 -> CH3COCHO2CH2OH, + MALO2 -> C4H3O4, + MCO3 -> CH2CCH3CO3, + MDIALO2 -> C4H5O4, + MEKO2 -> C4H7O3, + MTERPO2VBS -> C10H17O3, + NTERPO2 -> C10H16NO5, + O1D -> O, + OH, + PHENO2 -> C6H7O6, + PO2 -> C3H6OHO2, + RO2 -> CH3COCH2O2, + TERP2O2 -> C10H15O4, + TERPO2 -> C10H17O3, + TOLO2 -> C7H9O5, + TOLUO2VBS -> C7H9O5, + XO2 -> HOCH2COOCH3CHOHCHO, + XYLENO2 -> C8H11O5, + XYLEO2VBS -> C8H11O5, + XYLOLO2 -> C8H11O6, + H2O + + End Solution + + + Fixed + M, O2, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + ACBZO2, + ALKO2, + BCARYO2VBS, + BENZO2, + BENZO2VBS, + BZOO, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2, + ENEO2, + EO, + EO2, + HO2, + HOCH2OO, + ISOPAO2, + ISOPBO2, + ISOPO2VBS, + IVOCO2VBS, + MACRO2, + MALO2, + MCO3, + MDIALO2, + MEKO2, + MTERPO2VBS, + NTERPO2, + O1D, + OH, + PHENO2, + PO2, + RO2, + TERP2O2, + TERPO2, + TOLO2, + TOLUO2VBS, + XO2, + XYLENO2, + XYLEO2VBS, + XYLOLO2 + End Not-Transported + + END Species + + + Solution classes + Explicit + NHDEP + NDEP + End Explicit + + Implicit + ALKNIT + ALKOOH + AOA_NH + bc_a1 + bc_a4 + BCARY + BENZENE + BENZOOH + BEPOMUC + BIGALD + BIGALD1 + BIGALD2 + BIGALD3 + BIGALD4 + BIGALK + BIGENE + BR + BRCL + BRO + BRONO2 + BRY + BZALD + BZOOH + C2H2 + C2H4 + C2H5OH + C2H5OOH + C2H6 + C3H6 + C3H7OOH + C3H8 + C6H5OOH + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH2O + CH3BR + CH3CCL3 + CH3CHO + CH3CL + CH3CN + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CH4 + CHBR3 + CL + CL2 + CL2O2 + CLO + CLONO2 + CLY + CO + CO2 + COF2 + COFCL + CRESOL + DMS + dst_a1 + dst_a2 + dst_a3 + E90 + EOOH + F + GLYALD + GLYOXAL + H + H2 + H2402 + H2O2 + H2SO4 + HBR + HCFC141B + HCFC142B + HCFC22 + HCL + HCN + HCOOH + HF + HNO3 + HO2NO2 + HOBR + HOCL + HONITR + HPALD + HYAC + HYDRALD + IEPOX + ISOP + ISOPNITA + ISOPNITB + ISOPNO3 + ISOPNOOH + ISOPOOH + IVOC + MACR + MACROOH + MEK + MEKOOH + MPAN + MTERP + MVK + N + N2O + N2O5 + NC4CH2OH + NC4CHO + ncl_a1 + ncl_a2 + ncl_a3 + NH3 + NH4 + NH_5 + NH_50 + NO + NO2 + NO3 + NOA + NTERPOOH + num_a1 + num_a2 + num_a3 + num_a4 + num_a5 + O + O3 + O3S + OCLO + OCS + ONITR + PAN + PBZNIT + PHENO + PHENOL + PHENOOH + pom_a1 + pom_a4 + POOH + ROOH + S + SF6 + SO + SO2 + SO3 + so4_a1 + so4_a2 + so4_a3 + so4_a5 + soa1_a1 + soa1_a2 + soa2_a1 + soa2_a2 + soa3_a1 + soa3_a2 + soa4_a1 + soa4_a2 + soa5_a1 + soa5_a2 + SOAG0 + SOAG1 + SOAG2 + SOAG3 + SOAG4 + ST80_25 + SVOC + TEPOMUC + TERP2OOH + TERPNIT + TERPOOH + TERPROD1 + TERPROD2 + TOLOOH + TOLUENE + XOOH + XYLENES + XYLENOOH + XYLOL + XYLOLOOH + ACBZO2 + ALKO2 + BCARYO2VBS + BENZO2 + BENZO2VBS + BZOO + C2H5O2 + C3H7O2 + C6H5O2 + CH3CO3 + CH3O2 + DICARBO2 + ENEO2 + EO + EO2 + HO2 + HOCH2OO + ISOPAO2 + ISOPBO2 + ISOPO2VBS + IVOCO2VBS + MACRO2 + MALO2 + MCO3 + MDIALO2 + MEKO2 + MTERPO2VBS + NTERPO2 + O1D + OH + PHENO2 + PO2 + RO2 + TERP2O2 + TERPO2 + TOLO2 + TOLUO2VBS + XO2 + XYLENO2 + XYLEO2VBS + XYLOLO2 + 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 +********************************* +[jalknit->,jch3ooh] ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK +[jalkooh->,jch3ooh] ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 + 0.8*MEK + OH +[jbenzooh->,jch3ooh] BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 +[jbepomuc->,.10*jno2] BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO +[jbigald->,0.2*jno2] BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 + 0.18*CH3COCHO +[jbigald1->,.14*jno2] BIGALD1 + hv -> 0.6*MALO2 + HO2 +[jbigald2->,.20*jno2] BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 +[jbigald3->,.20*jno2] BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 +[jbigald4->,.006*jno2] BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 +[jbzooh->,jch3ooh] BZOOH + hv -> BZALD + OH + HO2 +[jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH +[jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 +[jc6h5ooh->,jch3ooh] C6H5OOH + hv -> PHENO + OH +[jch2o_b] CH2O + hv -> CO + H2 +[jch2o_a] CH2O + hv -> CO + 2*H +[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 +[jhonitr->,jch2o_a] HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + 0.17*CH3COCH3 +[jhpald->,.006*jno2] HPALD + hv -> BIGALD3 + OH + HO2 +[jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O +[jisopnooh->,jch3ooh] ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + 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 +[jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 +[jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO +[jmpan->,jpan] MPAN + hv -> MCO3 + NO2 +[jmvk] MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 +[jnc4cho->,jch2o_a] NC4CHO + hv -> BIGALD3 + NO2 + HO2 +[jnoa->,jch2o_a] NOA + hv -> NO2 + CH2O + CH3CO3 +[jnterpooh->,jch3ooh] NTERPOOH + hv -> TERPROD1 + NO2 + OH +[jonitr->,jch3cho] ONITR + hv -> NO2 +[jpan] PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 +[jphenooh->,jch3ooh] PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL +[jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH +[jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH +[jtepomuc->,.10*jno2] TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO +[jterp2ooh->,jch3ooh] TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 + TERPROD2 + HO2 + 0.25*GLYALD +[jterpnit->,jch3ooh] TERPNIT + hv -> TERPROD1 + NO2 + HO2 +[jterpooh->,jch3ooh] TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH +[jterprd1->,jch3cho] TERPROD1 + hv -> HO2 + CO + TERPROD2 +[jterprd2->,jch3cho] TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO +[jtolooh->,jch3ooh] TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 +[jxooh->,jch3ooh] XOOH + hv -> OH +[jxylenooh->,jch3ooh] XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 +[jxylolooh->,jch3ooh] XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 +********************************* +*** 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 -> 2*CL + COFCL +[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 +[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_a] CLONO2 + hv -> CL + NO3 +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jcof2] COF2 + hv -> 2*F +[jcofcl] COFCL + hv -> F + CL +[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 +********************************* +[jsoa1_a1->,.0004*jno2] soa1_a1 + hv -> +[jsoa1_a2->,.0004*jno2] soa1_a2 + hv -> +[jsoa2_a1->,.0004*jno2] soa2_a1 + hv -> +[jsoa2_a2->,.0004*jno2] soa2_a2 + hv -> +[jsoa3_a1->,.0004*jno2] soa3_a1 + hv -> +[jsoa3_a2->,.0004*jno2] soa3_a2 + hv -> +[jsoa4_a1->,.0004*jno2] soa4_a1 + hv -> +[jsoa4_a2->,.0004*jno2] soa4_a2 + hv -> +[jsoa5_a1->,.0004*jno2] soa5_a1 + hv -> +[jsoa5_a2->,.0004*jno2] soa5_a2 + hv -> + End Photolysis + + Reactions +********************************* +*** Not Assigned to a Section +********************************* +[E90_tau] E90 -> ; 1.29e-07 +********************************* +*** 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 +[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 -> 2*CL + COFCL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 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 +********************************* +*** odd-fluorine +********************************* +[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 +[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 +[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 +[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 +[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 +[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 +********************************* +*** 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 + COFCL ; 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 + COFCL ; 1.794e-10 +[O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.3e-10 +[O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.65e-11 +********************************* +*** C1 +********************************* +[CH2O_HO2] CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625 +[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 +[HCN_OH] HCN + OH + M -> HO2 + M ; 6.1e-33, 1.5, 9.8e-15, -4.6, 0.8 +[HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4e-13 +[HOCH2OO_HO2] HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 +[HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.4e+12, -7000 +[HOCH2OO_NO] HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265 +[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 +[O1D_HCN] O1D + HCN -> OH ; 1.08e-10, 105 +[usr_CO_OH] CO + OH -> CO2 + HO2 +********************************* +*** C2 +********************************* +[C2H2_CL_M] C2H2 + CL + M -> CL + M ; 5.2e-30, 2.4, 2.2e-10, 0.7, 0.6 +[C2H2_OH_M] C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 + 0.35*CO + M ; 5.5e-30, 0, 8.3e-13, -2, 0.6 +[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 +[CH3CN_OH] CH3CN + OH -> HO2 ; 7.8e-13, -1050 +[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 +********************************* +[BIGENE_NO3] BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 ; 3.5e-13 +[BIGENE_OH] BIGENE + OH -> ENEO2 ; 5.4e-11 +[ENEO2_NO] ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 ; 4.8e-12, 120 +[ENEO2_NOb] ENEO2 + NO -> HONITR ; 5.1e-14, 693 +[HONITR_OH] HONITR + OH -> ONITR + HO2 ; 2e-12 +[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 -> HONITR ; 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 +[MEKO2_HO2] MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 ; 7.5e-13, 700 +[MEKO2_NO] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180 +[MEK_OH] MEK + OH -> MEKO2 ; 2.3e-12, -170 +[MEKOOH_OH] MEKOOH + OH -> MEKO2 ; 3.8e-12, 200 +[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 +********************************* +[ALKNIT_OH] ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 ; 1.6e-12 +[ALKO2_HO2] ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700 +[ALKO2_NO] ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK + NO2 ; 6.7e-12 +[ALKO2_NOb] ALKO2 + NO -> ALKNIT ; 5.4e-14, 870 +[ALKOOH_OH] ALKOOH + OH -> ALKO2 ; 3.8e-12, 200 +[BIGALK_OH] BIGALK + OH -> ALKO2 ; 3.5e-12 +[HPALD_OH] HPALD + OH -> XO2 ; 1.86e-11, 175 +[HYDRALD_OH] HYDRALD + OH -> XO2 ; 1.86e-11, 175 +[IEPOX_OH] IEPOX + OH -> XO2 ; 1.3e-11 +[ISOPAO2_CH3CO3] ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 ; 1.4e-11 +[ISOPAO2_CH3O2] ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR + 0.44*MVK ; 5e-13, 400 +[ISOPAO2_HO2] ISOPAO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPAO2_NO] ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK + 0.92*CH2O + 0.92*HO2 ; 4.4e-12, 180 +[ISOPAO2_NO3] ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 ; 2.4e-12 +[ISOPBO2_CH3CO3] ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 ; 1.4e-11 +[ISOPBO2_CH3O2] ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD ; 5e-13, 400 +[ISOPBO2_HO2] ISOPBO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPBO2_M] ISOPBO2 -> HPALD + HO2 ; 1.6e+09, -8300 +[ISOPBO2_NO] ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 4.4e-12, 180 +[ISOPBO2_NO3] ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 2.4e-12 +[ISOPNITA_OH] ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O + 0.3*HONITR + 0.3*HO2 ; 4e-11 +[ISOPNITB_OH] ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR ; 4e-11 +[ISOP_NO3] ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446 +[ISOPNO3_CH3CO3] ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 ; 1.4e-11 +[ISOPNO3_CH3O2] ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH + 0.2*NC4CH2OH ; 5e-13, 400 +[ISOPNO3_HO2] ISOPNO3 + HO2 -> ISOPNOOH ; 8e-13, 700 +[ISOPNO3_NO] ISOPNO3 + NO -> NC4CHO + NO2 + HO2 ; 2.7e-12, 360 +[ISOPNO3_NO3] ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 ; 2.4e-12 +[ISOPNOOH_OH] ISOPNOOH + OH -> NOA + HO2 ; 4e-11 +[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 -> 0.6*ISOPAO2 + 0.4*ISOPBO2 ; 2.54e-11, 410 +[ISOPOOH_OH] ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH ; 1.52e-11, 200 +[NC4CH2OH_OH] NC4CH2OH + OH -> GLYALD + NOA + HO2 ; 7e-11 +[NC4CHO_OH] NC4CHO + OH -> GLYOXAL + NOA + HO2 ; 1e-10 +[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 +********************************* +*** C7 +********************************* +[ACBZO2_HO2] ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH ; 4.3e-13, 1040 +[ACBZO2_NO] ACBZO2 + NO -> C6H5O2 + NO2 ; 7.5e-12, 290 +[BENZENE_OH] BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 ; 2.3e-12, -193 +[BENZO2_HO2] BENZO2 + HO2 -> BENZOOH ; 7.5e-13, 700 +[BENZO2_NO] BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 ; 2.6e-12, 365 +[BENZOOH_OH] BENZOOH + OH -> BENZO2 ; 3.8e-12, 200 +[BZALD_OH] BZALD + OH -> ACBZO2 ; 5.9e-12, 225 +[BZOO_HO2] BZOO + HO2 -> BZOOH ; 7.5e-13, 700 +[BZOOH_OH] BZOOH + OH -> BZOO ; 3.8e-12, 200 +[BZOO_NO] BZOO + NO -> BZALD + NO2 + HO2 ; 2.6e-12, 365 +[C6H5O2_HO2] C6H5O2 + HO2 -> C6H5OOH ; 7.5e-13, 700 +[C6H5O2_NO] C6H5O2 + NO -> PHENO + NO2 ; 2.6e-12, 365 +[C6H5OOH_OH] C6H5OOH + OH -> C6H5O2 ; 3.8e-12, 200 +[CRESOL_OH] CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO ; 4.7e-11 +[DICARBO2_HO2] DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO + 0.33*CH3O2 ; 4.3e-13, 1040 +[DICARBO2_NO] DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO + 0.83*CH3O2 ; 7.5e-12, 290 +[DICARBO2_NO2] DICARBO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MALO2_HO2] MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO ; 4.3e-13, 1040 +[MALO2_NO] MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 ; 7.5e-12, 290 +[MALO2_NO2] MALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MDIALO2_HO2] MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO + 0.07*CH3O2 + 0.07*GLYOXAL ; 4.3e-13, 1040 +[MDIALO2_NO] MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO + 0.17*CH3O2 + 0.17*GLYOXAL ; 7.5e-12, 290 +[MDIALO2_NO2] MDIALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[PHENO2_HO2] PHENO2 + HO2 -> PHENOOH ; 7.5e-13, 700 +[PHENO2_NO] PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 ; 2.6e-12, 365 +[PHENOL_OH] PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO ; 4.7e-13, 1220 +[PHENO_NO2] PHENO + NO2 -> 1*NDEP ; 2.1e-12 +[PHENO_O3] PHENO + O3 -> C6H5O2 ; 2.8e-13 +[PHENOOH_OH] PHENOOH + OH -> PHENO2 ; 3.8e-12, 200 +[tag_ACBZO2_NO2] ACBZO2 + NO2 + M -> PBZNIT + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[TOLO2_HO2] TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700 +[TOLO2_NO] TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 ; 2.6e-12, 365 +[TOLOOH_OH] TOLOOH + OH -> TOLO2 ; 3.8e-12, 200 +[TOLUENE_OH] TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 + 0.28*HO2 ; 1.7e-12, 352 +[usr_PBZNIT_M] PBZNIT + M -> ACBZO2 + NO2 + M +[XYLENES_OH] XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO + 0.56*XYLENO2 + 0.38*HO2 ; 1.7e-11 +[XYLENO2_HO2] XYLENO2 + HO2 -> XYLENOOH ; 7.5e-13, 700 +[XYLENO2_NO] XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 ; 2.6e-12, 365 +[XYLENOOH_OH] XYLENOOH + OH -> XYLENO2 ; 3.8e-12, 200 +[XYLOLO2_HO2] XYLOLO2 + HO2 -> XYLOLOOH ; 7.5e-13, 700 +[XYLOLO2_NO] XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO ; 2.6e-12, 365 +[XYLOL_OH] XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO ; 8.4e-11 +[XYLOLOOH_OH] XYLOLOOH + OH -> XYLOLO2 ; 3.8e-12, 200 +********************************* +*** C10 +********************************* +[BCARY_NO3] BCARY + NO3 -> NTERPO2 ; 1.9e-11 +[BCARY_O3] BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 1.2e-14 +[BCARY_OH] BCARY + OH -> TERPO2 ; 2e-10 +[MTERP_NO3] MTERP + NO3 -> NTERPO2 ; 1.2e-12, 490 +[MTERP_O3] MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 6.3e-16, -580 +[MTERP_OH] MTERP + OH -> TERPO2 ; 1.2e-11, 440 +[NTERPO2_CH3O2] NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 + 0.5*TERPROD1 + 0.5*NO2 ; 2e-12, 500 +[NTERPO2_HO2] NTERPO2 + HO2 -> NTERPOOH ; 7.5e-13, 700 +[NTERPO2_NO] NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP ; 4.2e-12, 180 +[NTERPO2_NO3] NTERPO2 + NO3 -> 2*NO2 + TERPROD1 ; 2.4e-12 +[NTERPOOH_OH] NTERPOOH + OH -> NTERPO2 ; 2e-11 +[TERP2O2_CH3O2] TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + 0.15*CH3COCH3 ; 2e-12, 500 +[TERP2O2_HO2] TERP2O2 + HO2 -> TERP2OOH ; 7.5e-13, 700 +[TERP2O2_NO] TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + 0.225*GLYALD ; 4.2e-12, 180 +[TERP2OOH_OH] TERP2OOH + OH -> TERP2O2 ; 2.3e-11 +[TERPNIT_OH] TERPNIT + OH -> NO2 + TERPROD1 ; 2e-11 +[TERPO2_CH3O2] TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 + 0.025*CH3COCH3 ; 2e-12, 500 +[TERPO2_HO2] TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700 +[TERPO2_NO] TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 + 0.8*TERPROD1 + 0.8*HO2 ; 4.2e-12, 180 +[TERPOOH_OH] TERPOOH + OH -> TERPO2 ; 3.3e-11 +[TERPROD1_NO3] TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP ; 1e-12 +[TERPROD1_OH] TERPROD1 + OH -> TERP2O2 ; 5.7e-11 +[TERPROD2_OH] TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO ; 3.4e-11 +********************************* +*** 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_GLYOXAL_aer] GLYOXAL -> SOAG0 +[usr_HO2_aer] HO2 -> H2O +[usr_HONITR_aer] HONITR -> HNO3 +[usr_ISOPNITA_aer] ISOPNITA -> HNO3 +[usr_ISOPNITB_aer] ISOPNITB -> HNO3 +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NC4CH2OH_aer] NC4CH2OH -> HNO3 +[usr_NC4CHO_aer] NC4CHO -> 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_NTERPOOH_aer] NTERPOOH -> HNO3 +[usr_ONITR_aer] ONITR -> HNO3 +[usr_TERPNIT_aer] TERPNIT -> HNO3 +********************************* +*** SOA +********************************* +[BCARY_NO3_vbs] BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.9e-11 +[BCARYO2_HO2_vbs] BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 2.75e-13, 1300 +[BCARYO2_NO_vbs] BCARYO2VBS + NO -> NO + 0.1279*SOAG0 + 0.1792*SOAG1 + 0.0676*SOAG2 + 0.079*SOAG3 + 0.1254*SOAG4 ; 2.7e-12, 360 +[BCARY_O3_vbs] BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 1.2e-14 +[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + BCARYO2VBS ; 2e-10 +[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + BENZO2VBS ; 2.3e-12, -193 +[BENZO2_HO2_vbs] BENZO2VBS + HO2 -> HO2 + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 + 0.0443*SOAG3 + 0.1621*SOAG4 ; 7.5e-13, 700 +[BENZO2_NO_vbs] BENZO2VBS + NO -> NO + 0.0097*SOAG0 + 0.0034*SOAG1 + 0.1579*SOAG2 + 0.0059*SOAG3 + 0.0536*SOAG4 ; 2.6e-12, 365 +[ISOP_NO3_vbs] ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 ; 3.03e-12, -446 +[ISOPO2_HO2_vbs] ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 + 0.0271*SOAG3 + 0.0474*SOAG4 ; 2.12e-13, 1300 +[ISOPO2_NO_vbs] ISOPO2VBS + NO -> NO + 0.0003*SOAG0 + 0.0003*SOAG1 + 0.0073*SOAG2 + 0.0057*SOAG3 + 0.0623*SOAG4 ; 2.7e-12, 350 +[ISOP_O3_vbs] ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 ; 1.05e-14, -2000 +[ISOP_OH_vbs] ISOP + OH -> ISOP + OH + ISOPO2VBS ; 2.54e-11, 410 +[IVOCO2_HO2_vbs] IVOCO2VBS + HO2 -> HO2 + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 + 0.0076*SOAG3 + 0.0113*SOAG4 ; 7.5e-13, 700 +[IVOCO2_NO_vbs] IVOCO2VBS + NO -> NO + 0.1056*SOAG0 + 0.1026*SOAG1 + 0.0521*SOAG2 + 0.0143*SOAG3 + 0.0166*SOAG4 ; 2.6e-12, 365 +[IVOC_OH_vbs] IVOC + OH -> OH + IVOCO2VBS ; 1.34e-11 +[MTERP_NO3_vbs] MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.2e-12, 490 +[MTERPO2_HO2_vbs] MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 2.6e-13, 1300 +[MTERPO2_NO_vbs] MTERPO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 + 0.0332*SOAG3 + 0.13*SOAG4 ; 2.7e-12, 360 +[MTERP_O3_vbs] MTERP + O3 -> MTERP + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 6.3e-16, -580 +[MTERP_OH_vbs] MTERP + OH -> MTERP + OH + MTERPO2VBS ; 1.2e-11, 440 +[SVOC_OH] SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 + 0.0085*SOAG3 + 0.0128*SOAG4 ; 1.34e-11 +[TOLUENE_OH_vbs] TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS ; 1.7e-12, 352 +[TOLUO2_HO2_vbs] TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 + 0.2157*SOAG3 + 0.0738*SOAG4 ; 7.5e-13, 700 +[TOLUO2_NO_vbs] TOLUO2VBS + NO -> NO + 0.0154*SOAG0 + 0.0452*SOAG1 + 0.0966*SOAG2 + 0.0073*SOAG3 + 0.238*SOAG4 ; 2.6e-12, 365 +[XYLENES_OH_vbs] XYLENES + OH -> XYLENES + OH + XYLEO2VBS ; 1.7e-11 +[XYLEO2_HO2_vbs] XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 + 0.0512*SOAG3 + 0.1598*SOAG4 ; 7.5e-13, 700 +[XYLEO2_NO_vbs] XYLEO2VBS + NO -> NO + 0.0063*SOAG0 + 0.0237*SOAG1 + 0.0025*SOAG2 + 0.011*SOAG3 + 0.1185*SOAG4 ; 2.6e-12, 365 +********************************* +*** 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 +********************************* +[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 + num_a1 <- dataset + num_a2 <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + so4_a5 <- dataset + num_a4 <- dataset + num_a5 <- dataset + SO2 <- dataset + NO2 <- dataset + pom_a4 <- dataset + bc_a4 <- dataset + CO <- dataset + SVOC <- dataset + AOA_NH + NO + N + 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_vbs/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/chem_mods.F90 new file mode 100644 index 0000000000..27e935c7f1 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/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 = 123, & ! number of photolysis reactions + rxntot = 541, & ! number of total reactions + gascnt = 418, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 231, & ! number of "gas phase" species + nfs = 3, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 2287, & ! number of non-zero matrix entries + extcnt = 16, & ! 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 = 229, & ! 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 = 541, & + enthalpy_cnt = 18, & + nslvd = 41 + 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_vbs/m_rxt_id.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/m_rxt_id.F90 new file mode 100644 index 0000000000..46c4932def --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/m_rxt_id.F90 @@ -0,0 +1,544 @@ + 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_jalknit = 19 + integer, parameter :: rid_jalkooh = 20 + integer, parameter :: rid_jbenzooh = 21 + integer, parameter :: rid_jbepomuc = 22 + integer, parameter :: rid_jbigald = 23 + integer, parameter :: rid_jbigald1 = 24 + integer, parameter :: rid_jbigald2 = 25 + integer, parameter :: rid_jbigald3 = 26 + integer, parameter :: rid_jbigald4 = 27 + integer, parameter :: rid_jbzooh = 28 + integer, parameter :: rid_jc2h5ooh = 29 + integer, parameter :: rid_jc3h7ooh = 30 + integer, parameter :: rid_jc6h5ooh = 31 + integer, parameter :: rid_jch2o_b = 32 + integer, parameter :: rid_jch2o_a = 33 + integer, parameter :: rid_jch3cho = 34 + integer, parameter :: rid_jacet = 35 + integer, parameter :: rid_jmgly = 36 + integer, parameter :: rid_jch3co3h = 37 + integer, parameter :: rid_jch3ooh = 38 + integer, parameter :: rid_jch4_b = 39 + integer, parameter :: rid_jch4_a = 40 + integer, parameter :: rid_jco2 = 41 + integer, parameter :: rid_jeooh = 42 + integer, parameter :: rid_jglyald = 43 + integer, parameter :: rid_jglyoxal = 44 + integer, parameter :: rid_jhonitr = 45 + integer, parameter :: rid_jhpald = 46 + integer, parameter :: rid_jhyac = 47 + integer, parameter :: rid_jisopnooh = 48 + integer, parameter :: rid_jisopooh = 49 + integer, parameter :: rid_jmacr_a = 50 + integer, parameter :: rid_jmacr_b = 51 + integer, parameter :: rid_jmek = 52 + integer, parameter :: rid_jmekooh = 53 + integer, parameter :: rid_jmpan = 54 + integer, parameter :: rid_jmvk = 55 + integer, parameter :: rid_jnc4cho = 56 + integer, parameter :: rid_jnoa = 57 + integer, parameter :: rid_jnterpooh = 58 + integer, parameter :: rid_jonitr = 59 + integer, parameter :: rid_jpan = 60 + integer, parameter :: rid_jphenooh = 61 + integer, parameter :: rid_jpooh = 62 + integer, parameter :: rid_jrooh = 63 + integer, parameter :: rid_jtepomuc = 64 + integer, parameter :: rid_jterp2ooh = 65 + integer, parameter :: rid_jterpnit = 66 + integer, parameter :: rid_jterpooh = 67 + integer, parameter :: rid_jterprd1 = 68 + integer, parameter :: rid_jterprd2 = 69 + integer, parameter :: rid_jtolooh = 70 + integer, parameter :: rid_jxooh = 71 + integer, parameter :: rid_jxylenooh = 72 + integer, parameter :: rid_jxylolooh = 73 + integer, parameter :: rid_jbrcl = 74 + integer, parameter :: rid_jbro = 75 + integer, parameter :: rid_jbrono2_b = 76 + integer, parameter :: rid_jbrono2_a = 77 + integer, parameter :: rid_jccl4 = 78 + integer, parameter :: rid_jcf2clbr = 79 + integer, parameter :: rid_jcf3br = 80 + integer, parameter :: rid_jcfcl3 = 81 + integer, parameter :: rid_jcfc113 = 82 + integer, parameter :: rid_jcfc114 = 83 + integer, parameter :: rid_jcfc115 = 84 + integer, parameter :: rid_jcf2cl2 = 85 + integer, parameter :: rid_jch2br2 = 86 + integer, parameter :: rid_jch3br = 87 + integer, parameter :: rid_jch3ccl3 = 88 + integer, parameter :: rid_jch3cl = 89 + integer, parameter :: rid_jchbr3 = 90 + integer, parameter :: rid_jcl2 = 91 + integer, parameter :: rid_jcl2o2 = 92 + integer, parameter :: rid_jclo = 93 + integer, parameter :: rid_jclono2_a = 94 + integer, parameter :: rid_jclono2_b = 95 + integer, parameter :: rid_jcof2 = 96 + integer, parameter :: rid_jcofcl = 97 + integer, parameter :: rid_jh2402 = 98 + integer, parameter :: rid_jhbr = 99 + integer, parameter :: rid_jhcfc141b = 100 + integer, parameter :: rid_jhcfc142b = 101 + integer, parameter :: rid_jhcfc22 = 102 + integer, parameter :: rid_jhcl = 103 + integer, parameter :: rid_jhf = 104 + integer, parameter :: rid_jhobr = 105 + integer, parameter :: rid_jhocl = 106 + integer, parameter :: rid_joclo = 107 + integer, parameter :: rid_jsf6 = 108 + integer, parameter :: rid_jh2so4 = 109 + integer, parameter :: rid_jocs = 110 + integer, parameter :: rid_jso = 111 + integer, parameter :: rid_jso2 = 112 + integer, parameter :: rid_jso3 = 113 + integer, parameter :: rid_jsoa1_a1 = 114 + integer, parameter :: rid_jsoa1_a2 = 115 + integer, parameter :: rid_jsoa2_a1 = 116 + integer, parameter :: rid_jsoa2_a2 = 117 + integer, parameter :: rid_jsoa3_a1 = 118 + integer, parameter :: rid_jsoa3_a2 = 119 + integer, parameter :: rid_jsoa4_a1 = 120 + integer, parameter :: rid_jsoa4_a2 = 121 + integer, parameter :: rid_jsoa5_a1 = 122 + integer, parameter :: rid_jsoa5_a2 = 123 + integer, parameter :: rid_E90_tau = 124 + integer, parameter :: rid_O1D_H2 = 125 + integer, parameter :: rid_O1D_H2O = 126 + integer, parameter :: rid_O1D_N2 = 127 + integer, parameter :: rid_O1D_O2ab = 128 + integer, parameter :: rid_O1D_O3 = 129 + integer, parameter :: rid_O_O3 = 130 + integer, parameter :: rid_usr_O_O = 131 + integer, parameter :: rid_usr_O_O2 = 132 + integer, parameter :: rid_H2_O = 133 + integer, parameter :: rid_H2O2_O = 134 + integer, parameter :: rid_H_HO2 = 135 + integer, parameter :: rid_H_HO2a = 136 + integer, parameter :: rid_H_HO2b = 137 + integer, parameter :: rid_H_O2 = 138 + integer, parameter :: rid_HO2_O = 139 + integer, parameter :: rid_HO2_O3 = 140 + integer, parameter :: rid_H_O3 = 141 + integer, parameter :: rid_OH_H2 = 142 + integer, parameter :: rid_OH_H2O2 = 143 + integer, parameter :: rid_OH_HO2 = 144 + integer, parameter :: rid_OH_O = 145 + integer, parameter :: rid_OH_O3 = 146 + integer, parameter :: rid_OH_OH = 147 + integer, parameter :: rid_OH_OH_M = 148 + integer, parameter :: rid_usr_HO2_HO2 = 149 + integer, parameter :: rid_HO2NO2_OH = 150 + integer, parameter :: rid_N_NO = 151 + integer, parameter :: rid_N_NO2a = 152 + integer, parameter :: rid_N_NO2b = 153 + integer, parameter :: rid_N_NO2c = 154 + integer, parameter :: rid_N_O2 = 155 + integer, parameter :: rid_NO2_O = 156 + integer, parameter :: rid_NO2_O3 = 157 + integer, parameter :: rid_NO2_O_M = 158 + integer, parameter :: rid_NO3_HO2 = 159 + integer, parameter :: rid_NO3_NO = 160 + integer, parameter :: rid_NO3_O = 161 + integer, parameter :: rid_NO3_OH = 162 + integer, parameter :: rid_N_OH = 163 + integer, parameter :: rid_NO_HO2 = 164 + integer, parameter :: rid_NO_O3 = 165 + integer, parameter :: rid_NO_O_M = 166 + integer, parameter :: rid_O1D_N2Oa = 167 + integer, parameter :: rid_O1D_N2Ob = 168 + integer, parameter :: rid_tag_NO2_HO2 = 169 + integer, parameter :: rid_tag_NO2_NO3 = 170 + integer, parameter :: rid_tag_NO2_OH = 171 + integer, parameter :: rid_usr_HNO3_OH = 172 + integer, parameter :: rid_usr_HO2NO2_M = 173 + integer, parameter :: rid_usr_N2O5_M = 174 + integer, parameter :: rid_CL_CH2O = 175 + integer, parameter :: rid_CL_CH4 = 176 + integer, parameter :: rid_CL_H2 = 177 + integer, parameter :: rid_CL_H2O2 = 178 + integer, parameter :: rid_CL_HO2a = 179 + integer, parameter :: rid_CL_HO2b = 180 + integer, parameter :: rid_CL_O3 = 181 + integer, parameter :: rid_CLO_CH3O2 = 182 + integer, parameter :: rid_CLO_CLOa = 183 + integer, parameter :: rid_CLO_CLOb = 184 + integer, parameter :: rid_CLO_CLOc = 185 + integer, parameter :: rid_CLO_HO2 = 186 + integer, parameter :: rid_CLO_NO = 187 + integer, parameter :: rid_CLONO2_CL = 188 + integer, parameter :: rid_CLO_NO2_M = 189 + integer, parameter :: rid_CLONO2_O = 190 + integer, parameter :: rid_CLONO2_OH = 191 + integer, parameter :: rid_CLO_O = 192 + integer, parameter :: rid_CLO_OHa = 193 + integer, parameter :: rid_CLO_OHb = 194 + integer, parameter :: rid_HCL_O = 195 + integer, parameter :: rid_HCL_OH = 196 + integer, parameter :: rid_HOCL_CL = 197 + integer, parameter :: rid_HOCL_O = 198 + integer, parameter :: rid_HOCL_OH = 199 + integer, parameter :: rid_O1D_CCL4 = 200 + integer, parameter :: rid_O1D_CF2CLBR = 201 + integer, parameter :: rid_O1D_CFC11 = 202 + integer, parameter :: rid_O1D_CFC113 = 203 + integer, parameter :: rid_O1D_CFC114 = 204 + integer, parameter :: rid_O1D_CFC115 = 205 + integer, parameter :: rid_O1D_CFC12 = 206 + integer, parameter :: rid_O1D_HCLa = 207 + integer, parameter :: rid_O1D_HCLb = 208 + integer, parameter :: rid_tag_CLO_CLO_M = 209 + integer, parameter :: rid_usr_CL2O2_M = 210 + integer, parameter :: rid_BR_CH2O = 211 + integer, parameter :: rid_BR_HO2 = 212 + integer, parameter :: rid_BR_O3 = 213 + integer, parameter :: rid_BRO_BRO = 214 + integer, parameter :: rid_BRO_CLOa = 215 + integer, parameter :: rid_BRO_CLOb = 216 + integer, parameter :: rid_BRO_CLOc = 217 + integer, parameter :: rid_BRO_HO2 = 218 + integer, parameter :: rid_BRO_NO = 219 + integer, parameter :: rid_BRO_NO2_M = 220 + integer, parameter :: rid_BRONO2_O = 221 + integer, parameter :: rid_BRO_O = 222 + integer, parameter :: rid_BRO_OH = 223 + integer, parameter :: rid_HBR_O = 224 + integer, parameter :: rid_HBR_OH = 225 + integer, parameter :: rid_HOBR_O = 226 + integer, parameter :: rid_O1D_CF3BR = 227 + integer, parameter :: rid_O1D_CHBR3 = 228 + integer, parameter :: rid_O1D_H2402 = 229 + integer, parameter :: rid_O1D_HBRa = 230 + integer, parameter :: rid_O1D_HBRb = 231 + integer, parameter :: rid_F_CH4 = 232 + integer, parameter :: rid_F_H2 = 233 + integer, parameter :: rid_F_H2O = 234 + integer, parameter :: rid_F_HNO3 = 235 + integer, parameter :: rid_O1D_COF2 = 236 + integer, parameter :: rid_O1D_COFCL = 237 + integer, parameter :: rid_CH2BR2_CL = 238 + integer, parameter :: rid_CH2BR2_OH = 239 + integer, parameter :: rid_CH3BR_CL = 240 + integer, parameter :: rid_CH3BR_OH = 241 + integer, parameter :: rid_CH3CCL3_OH = 242 + integer, parameter :: rid_CH3CL_CL = 243 + integer, parameter :: rid_CH3CL_OH = 244 + integer, parameter :: rid_CHBR3_CL = 245 + integer, parameter :: rid_CHBR3_OH = 246 + integer, parameter :: rid_HCFC141B_OH = 247 + integer, parameter :: rid_HCFC142B_OH = 248 + integer, parameter :: rid_HCFC22_OH = 249 + integer, parameter :: rid_O1D_CH2BR2 = 250 + integer, parameter :: rid_O1D_CH3BR = 251 + integer, parameter :: rid_O1D_HCFC141B = 252 + integer, parameter :: rid_O1D_HCFC142B = 253 + integer, parameter :: rid_O1D_HCFC22 = 254 + integer, parameter :: rid_CH2O_HO2 = 255 + integer, parameter :: rid_CH2O_NO3 = 256 + integer, parameter :: rid_CH2O_O = 257 + integer, parameter :: rid_CH2O_OH = 258 + integer, parameter :: rid_CH3O2_CH3O2a = 259 + integer, parameter :: rid_CH3O2_CH3O2b = 260 + integer, parameter :: rid_CH3O2_HO2 = 261 + integer, parameter :: rid_CH3O2_NO = 262 + integer, parameter :: rid_CH3OH_OH = 263 + integer, parameter :: rid_CH3OOH_OH = 264 + integer, parameter :: rid_CH4_OH = 265 + integer, parameter :: rid_HCN_OH = 266 + integer, parameter :: rid_HCOOH_OH = 267 + integer, parameter :: rid_HOCH2OO_HO2 = 268 + integer, parameter :: rid_HOCH2OO_M = 269 + integer, parameter :: rid_HOCH2OO_NO = 270 + integer, parameter :: rid_O1D_CH4a = 271 + integer, parameter :: rid_O1D_CH4b = 272 + integer, parameter :: rid_O1D_CH4c = 273 + integer, parameter :: rid_O1D_HCN = 274 + integer, parameter :: rid_usr_CO_OH = 275 + integer, parameter :: rid_C2H2_CL_M = 276 + integer, parameter :: rid_C2H2_OH_M = 277 + integer, parameter :: rid_C2H4_CL_M = 278 + integer, parameter :: rid_C2H4_O3 = 279 + integer, parameter :: rid_C2H5O2_C2H5O2 = 280 + integer, parameter :: rid_C2H5O2_CH3O2 = 281 + integer, parameter :: rid_C2H5O2_HO2 = 282 + integer, parameter :: rid_C2H5O2_NO = 283 + integer, parameter :: rid_C2H5OH_OH = 284 + integer, parameter :: rid_C2H5OOH_OH = 285 + integer, parameter :: rid_C2H6_CL = 286 + integer, parameter :: rid_C2H6_OH = 287 + integer, parameter :: rid_CH3CHO_NO3 = 288 + integer, parameter :: rid_CH3CHO_OH = 289 + integer, parameter :: rid_CH3CN_OH = 290 + integer, parameter :: rid_CH3CO3_CH3CO3 = 291 + integer, parameter :: rid_CH3CO3_CH3O2 = 292 + integer, parameter :: rid_CH3CO3_HO2 = 293 + integer, parameter :: rid_CH3CO3_NO = 294 + integer, parameter :: rid_CH3COOH_OH = 295 + integer, parameter :: rid_CH3COOOH_OH = 296 + integer, parameter :: rid_EO2_HO2 = 297 + integer, parameter :: rid_EO2_NO = 298 + integer, parameter :: rid_EO_M = 299 + integer, parameter :: rid_EO_O2 = 300 + integer, parameter :: rid_GLYALD_OH = 301 + integer, parameter :: rid_GLYOXAL_OH = 302 + integer, parameter :: rid_PAN_OH = 303 + integer, parameter :: rid_tag_C2H4_OH = 304 + integer, parameter :: rid_tag_CH3CO3_NO2 = 305 + integer, parameter :: rid_usr_PAN_M = 306 + integer, parameter :: rid_C3H6_NO3 = 307 + integer, parameter :: rid_C3H6_O3 = 308 + integer, parameter :: rid_C3H7O2_CH3O2 = 309 + integer, parameter :: rid_C3H7O2_HO2 = 310 + integer, parameter :: rid_C3H7O2_NO = 311 + integer, parameter :: rid_C3H7OOH_OH = 312 + integer, parameter :: rid_C3H8_OH = 313 + integer, parameter :: rid_CH3COCHO_NO3 = 314 + integer, parameter :: rid_CH3COCHO_OH = 315 + integer, parameter :: rid_HYAC_OH = 316 + integer, parameter :: rid_NOA_OH = 317 + integer, parameter :: rid_PO2_HO2 = 318 + integer, parameter :: rid_PO2_NO = 319 + integer, parameter :: rid_POOH_OH = 320 + integer, parameter :: rid_RO2_CH3O2 = 321 + integer, parameter :: rid_RO2_HO2 = 322 + integer, parameter :: rid_RO2_NO = 323 + integer, parameter :: rid_ROOH_OH = 324 + integer, parameter :: rid_tag_C3H6_OH = 325 + integer, parameter :: rid_usr_CH3COCH3_OH = 326 + integer, parameter :: rid_BIGENE_NO3 = 327 + integer, parameter :: rid_BIGENE_OH = 328 + integer, parameter :: rid_ENEO2_NO = 329 + integer, parameter :: rid_ENEO2_NOb = 330 + integer, parameter :: rid_HONITR_OH = 331 + integer, parameter :: rid_MACRO2_CH3CO3 = 332 + integer, parameter :: rid_MACRO2_CH3O2 = 333 + integer, parameter :: rid_MACRO2_HO2 = 334 + integer, parameter :: rid_MACRO2_NO3 = 335 + integer, parameter :: rid_MACRO2_NOa = 336 + integer, parameter :: rid_MACRO2_NOb = 337 + integer, parameter :: rid_MACR_O3 = 338 + integer, parameter :: rid_MACR_OH = 339 + integer, parameter :: rid_MACROOH_OH = 340 + integer, parameter :: rid_MCO3_CH3CO3 = 341 + integer, parameter :: rid_MCO3_CH3O2 = 342 + integer, parameter :: rid_MCO3_HO2 = 343 + integer, parameter :: rid_MCO3_MCO3 = 344 + integer, parameter :: rid_MCO3_NO = 345 + integer, parameter :: rid_MCO3_NO3 = 346 + integer, parameter :: rid_MEKO2_HO2 = 347 + integer, parameter :: rid_MEKO2_NO = 348 + integer, parameter :: rid_MEK_OH = 349 + integer, parameter :: rid_MEKOOH_OH = 350 + integer, parameter :: rid_MPAN_OH_M = 351 + integer, parameter :: rid_MVK_O3 = 352 + integer, parameter :: rid_MVK_OH = 353 + integer, parameter :: rid_tag_MCO3_NO2 = 354 + integer, parameter :: rid_usr_MPAN_M = 355 + integer, parameter :: rid_ALKNIT_OH = 356 + integer, parameter :: rid_ALKO2_HO2 = 357 + integer, parameter :: rid_ALKO2_NO = 358 + integer, parameter :: rid_ALKO2_NOb = 359 + integer, parameter :: rid_ALKOOH_OH = 360 + integer, parameter :: rid_BIGALK_OH = 361 + integer, parameter :: rid_HPALD_OH = 362 + integer, parameter :: rid_HYDRALD_OH = 363 + integer, parameter :: rid_IEPOX_OH = 364 + integer, parameter :: rid_ISOPAO2_CH3CO3 = 365 + integer, parameter :: rid_ISOPAO2_CH3O2 = 366 + integer, parameter :: rid_ISOPAO2_HO2 = 367 + integer, parameter :: rid_ISOPAO2_NO = 368 + integer, parameter :: rid_ISOPAO2_NO3 = 369 + integer, parameter :: rid_ISOPBO2_CH3CO3 = 370 + integer, parameter :: rid_ISOPBO2_CH3O2 = 371 + integer, parameter :: rid_ISOPBO2_HO2 = 372 + integer, parameter :: rid_ISOPBO2_M = 373 + integer, parameter :: rid_ISOPBO2_NO = 374 + integer, parameter :: rid_ISOPBO2_NO3 = 375 + integer, parameter :: rid_ISOPNITA_OH = 376 + integer, parameter :: rid_ISOPNITB_OH = 377 + integer, parameter :: rid_ISOP_NO3 = 378 + integer, parameter :: rid_ISOPNO3_CH3CO3 = 379 + integer, parameter :: rid_ISOPNO3_CH3O2 = 380 + integer, parameter :: rid_ISOPNO3_HO2 = 381 + integer, parameter :: rid_ISOPNO3_NO = 382 + integer, parameter :: rid_ISOPNO3_NO3 = 383 + integer, parameter :: rid_ISOPNOOH_OH = 384 + integer, parameter :: rid_ISOP_O3 = 385 + integer, parameter :: rid_ISOP_OH = 386 + integer, parameter :: rid_ISOPOOH_OH = 387 + integer, parameter :: rid_NC4CH2OH_OH = 388 + integer, parameter :: rid_NC4CHO_OH = 389 + integer, parameter :: rid_XO2_CH3CO3 = 390 + integer, parameter :: rid_XO2_CH3O2 = 391 + integer, parameter :: rid_XO2_HO2 = 392 + integer, parameter :: rid_XO2_NO = 393 + integer, parameter :: rid_XO2_NO3 = 394 + integer, parameter :: rid_XOOH_OH = 395 + integer, parameter :: rid_ACBZO2_HO2 = 396 + integer, parameter :: rid_ACBZO2_NO = 397 + integer, parameter :: rid_BENZENE_OH = 398 + integer, parameter :: rid_BENZO2_HO2 = 399 + integer, parameter :: rid_BENZO2_NO = 400 + integer, parameter :: rid_BENZOOH_OH = 401 + integer, parameter :: rid_BZALD_OH = 402 + integer, parameter :: rid_BZOO_HO2 = 403 + integer, parameter :: rid_BZOOH_OH = 404 + integer, parameter :: rid_BZOO_NO = 405 + integer, parameter :: rid_C6H5O2_HO2 = 406 + integer, parameter :: rid_C6H5O2_NO = 407 + integer, parameter :: rid_C6H5OOH_OH = 408 + integer, parameter :: rid_CRESOL_OH = 409 + integer, parameter :: rid_DICARBO2_HO2 = 410 + integer, parameter :: rid_DICARBO2_NO = 411 + integer, parameter :: rid_DICARBO2_NO2 = 412 + integer, parameter :: rid_MALO2_HO2 = 413 + integer, parameter :: rid_MALO2_NO = 414 + integer, parameter :: rid_MALO2_NO2 = 415 + integer, parameter :: rid_MDIALO2_HO2 = 416 + integer, parameter :: rid_MDIALO2_NO = 417 + integer, parameter :: rid_MDIALO2_NO2 = 418 + integer, parameter :: rid_PHENO2_HO2 = 419 + integer, parameter :: rid_PHENO2_NO = 420 + integer, parameter :: rid_PHENOL_OH = 421 + integer, parameter :: rid_PHENO_NO2 = 422 + integer, parameter :: rid_PHENO_O3 = 423 + integer, parameter :: rid_PHENOOH_OH = 424 + integer, parameter :: rid_tag_ACBZO2_NO2 = 425 + integer, parameter :: rid_TOLO2_HO2 = 426 + integer, parameter :: rid_TOLO2_NO = 427 + integer, parameter :: rid_TOLOOH_OH = 428 + integer, parameter :: rid_TOLUENE_OH = 429 + integer, parameter :: rid_usr_PBZNIT_M = 430 + integer, parameter :: rid_XYLENES_OH = 431 + integer, parameter :: rid_XYLENO2_HO2 = 432 + integer, parameter :: rid_XYLENO2_NO = 433 + integer, parameter :: rid_XYLENOOH_OH = 434 + integer, parameter :: rid_XYLOLO2_HO2 = 435 + integer, parameter :: rid_XYLOLO2_NO = 436 + integer, parameter :: rid_XYLOL_OH = 437 + integer, parameter :: rid_XYLOLOOH_OH = 438 + integer, parameter :: rid_BCARY_NO3 = 439 + integer, parameter :: rid_BCARY_O3 = 440 + integer, parameter :: rid_BCARY_OH = 441 + integer, parameter :: rid_MTERP_NO3 = 442 + integer, parameter :: rid_MTERP_O3 = 443 + integer, parameter :: rid_MTERP_OH = 444 + integer, parameter :: rid_NTERPO2_CH3O2 = 445 + integer, parameter :: rid_NTERPO2_HO2 = 446 + integer, parameter :: rid_NTERPO2_NO = 447 + integer, parameter :: rid_NTERPO2_NO3 = 448 + integer, parameter :: rid_NTERPOOH_OH = 449 + integer, parameter :: rid_TERP2O2_CH3O2 = 450 + integer, parameter :: rid_TERP2O2_HO2 = 451 + integer, parameter :: rid_TERP2O2_NO = 452 + integer, parameter :: rid_TERP2OOH_OH = 453 + integer, parameter :: rid_TERPNIT_OH = 454 + integer, parameter :: rid_TERPO2_CH3O2 = 455 + integer, parameter :: rid_TERPO2_HO2 = 456 + integer, parameter :: rid_TERPO2_NO = 457 + integer, parameter :: rid_TERPOOH_OH = 458 + integer, parameter :: rid_TERPROD1_NO3 = 459 + integer, parameter :: rid_TERPROD1_OH = 460 + integer, parameter :: rid_TERPROD2_OH = 461 + integer, parameter :: rid_DMS_NO3 = 462 + integer, parameter :: rid_DMS_OHa = 463 + integer, parameter :: rid_OCS_O = 464 + integer, parameter :: rid_OCS_OH = 465 + integer, parameter :: rid_S_O2 = 466 + integer, parameter :: rid_SO2_OH_M = 467 + integer, parameter :: rid_S_O3 = 468 + integer, parameter :: rid_SO_BRO = 469 + integer, parameter :: rid_SO_CLO = 470 + integer, parameter :: rid_S_OH = 471 + integer, parameter :: rid_SO_NO2 = 472 + integer, parameter :: rid_SO_O2 = 473 + integer, parameter :: rid_SO_O3 = 474 + integer, parameter :: rid_SO_OCLO = 475 + integer, parameter :: rid_SO_OH = 476 + integer, parameter :: rid_usr_DMS_OH = 477 + integer, parameter :: rid_usr_SO3_H2O = 478 + integer, parameter :: rid_NH3_OH = 479 + integer, parameter :: rid_usr_GLYOXAL_aer = 480 + integer, parameter :: rid_usr_HO2_aer = 481 + integer, parameter :: rid_usr_HONITR_aer = 482 + integer, parameter :: rid_usr_ISOPNITA_aer = 483 + integer, parameter :: rid_usr_ISOPNITB_aer = 484 + integer, parameter :: rid_usr_N2O5_aer = 485 + integer, parameter :: rid_usr_NC4CH2OH_aer = 486 + integer, parameter :: rid_usr_NC4CHO_aer = 487 + integer, parameter :: rid_usr_NH4_strat_tau = 488 + integer, parameter :: rid_usr_NO2_aer = 489 + integer, parameter :: rid_usr_NO3_aer = 490 + integer, parameter :: rid_usr_NTERPOOH_aer = 491 + integer, parameter :: rid_usr_ONITR_aer = 492 + integer, parameter :: rid_usr_TERPNIT_aer = 493 + integer, parameter :: rid_BCARY_NO3_vbs = 494 + integer, parameter :: rid_BCARYO2_HO2_vbs = 495 + integer, parameter :: rid_BCARYO2_NO_vbs = 496 + integer, parameter :: rid_BCARY_O3_vbs = 497 + integer, parameter :: rid_BCARY_OH_vbs = 498 + integer, parameter :: rid_BENZENE_OH_vbs = 499 + integer, parameter :: rid_BENZO2_HO2_vbs = 500 + integer, parameter :: rid_BENZO2_NO_vbs = 501 + integer, parameter :: rid_ISOP_NO3_vbs = 502 + integer, parameter :: rid_ISOPO2_HO2_vbs = 503 + integer, parameter :: rid_ISOPO2_NO_vbs = 504 + integer, parameter :: rid_ISOP_O3_vbs = 505 + integer, parameter :: rid_ISOP_OH_vbs = 506 + integer, parameter :: rid_IVOCO2_HO2_vbs = 507 + integer, parameter :: rid_IVOCO2_NO_vbs = 508 + integer, parameter :: rid_IVOC_OH_vbs = 509 + integer, parameter :: rid_MTERP_NO3_vbs = 510 + integer, parameter :: rid_MTERPO2_HO2_vbs = 511 + integer, parameter :: rid_MTERPO2_NO_vbs = 512 + integer, parameter :: rid_MTERP_O3_vbs = 513 + integer, parameter :: rid_MTERP_OH_vbs = 514 + integer, parameter :: rid_SVOC_OH = 515 + integer, parameter :: rid_TOLUENE_OH_vbs = 516 + integer, parameter :: rid_TOLUO2_HO2_vbs = 517 + integer, parameter :: rid_TOLUO2_NO_vbs = 518 + integer, parameter :: rid_XYLENES_OH_vbs = 519 + integer, parameter :: rid_XYLEO2_HO2_vbs = 520 + integer, parameter :: rid_XYLEO2_NO_vbs = 521 + integer, parameter :: rid_het1 = 522 + integer, parameter :: rid_het10 = 523 + integer, parameter :: rid_het11 = 524 + integer, parameter :: rid_het12 = 525 + integer, parameter :: rid_het13 = 526 + integer, parameter :: rid_het14 = 527 + integer, parameter :: rid_het15 = 528 + integer, parameter :: rid_het16 = 529 + integer, parameter :: rid_het17 = 530 + integer, parameter :: rid_het2 = 531 + integer, parameter :: rid_het3 = 532 + integer, parameter :: rid_het4 = 533 + integer, parameter :: rid_het5 = 534 + integer, parameter :: rid_het6 = 535 + integer, parameter :: rid_het7 = 536 + integer, parameter :: rid_het8 = 537 + integer, parameter :: rid_het9 = 538 + integer, parameter :: rid_NH_50_tau = 539 + integer, parameter :: rid_NH_5_tau = 540 + integer, parameter :: rid_ST80_25_tau = 541 + end module m_rxt_id diff --git a/src/chemistry/pp_trop_strat_mam5_vbs/m_spc_id.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/m_spc_id.F90 new file mode 100644 index 0000000000..6f3bcd694d --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/m_spc_id.F90 @@ -0,0 +1,234 @@ + module m_spc_id + implicit none + integer, parameter :: id_ALKNIT = 1 + integer, parameter :: id_ALKOOH = 2 + integer, parameter :: id_AOA_NH = 3 + integer, parameter :: id_bc_a1 = 4 + integer, parameter :: id_bc_a4 = 5 + integer, parameter :: id_BCARY = 6 + integer, parameter :: id_BENZENE = 7 + integer, parameter :: id_BENZOOH = 8 + integer, parameter :: id_BEPOMUC = 9 + integer, parameter :: id_BIGALD = 10 + integer, parameter :: id_BIGALD1 = 11 + integer, parameter :: id_BIGALD2 = 12 + integer, parameter :: id_BIGALD3 = 13 + integer, parameter :: id_BIGALD4 = 14 + integer, parameter :: id_BIGALK = 15 + integer, parameter :: id_BIGENE = 16 + integer, parameter :: id_BR = 17 + integer, parameter :: id_BRCL = 18 + integer, parameter :: id_BRO = 19 + integer, parameter :: id_BRONO2 = 20 + integer, parameter :: id_BRY = 21 + integer, parameter :: id_BZALD = 22 + integer, parameter :: id_BZOOH = 23 + integer, parameter :: id_C2H2 = 24 + integer, parameter :: id_C2H4 = 25 + integer, parameter :: id_C2H5OH = 26 + integer, parameter :: id_C2H5OOH = 27 + integer, parameter :: id_C2H6 = 28 + integer, parameter :: id_C3H6 = 29 + integer, parameter :: id_C3H7OOH = 30 + integer, parameter :: id_C3H8 = 31 + integer, parameter :: id_C6H5OOH = 32 + integer, parameter :: id_CCL4 = 33 + integer, parameter :: id_CF2CLBR = 34 + integer, parameter :: id_CF3BR = 35 + integer, parameter :: id_CFC11 = 36 + integer, parameter :: id_CFC113 = 37 + integer, parameter :: id_CFC114 = 38 + integer, parameter :: id_CFC115 = 39 + integer, parameter :: id_CFC12 = 40 + integer, parameter :: id_CH2BR2 = 41 + integer, parameter :: id_CH2O = 42 + integer, parameter :: id_CH3BR = 43 + integer, parameter :: id_CH3CCL3 = 44 + integer, parameter :: id_CH3CHO = 45 + integer, parameter :: id_CH3CL = 46 + integer, parameter :: id_CH3CN = 47 + integer, parameter :: id_CH3COCH3 = 48 + integer, parameter :: id_CH3COCHO = 49 + integer, parameter :: id_CH3COOH = 50 + integer, parameter :: id_CH3COOOH = 51 + integer, parameter :: id_CH3OH = 52 + integer, parameter :: id_CH3OOH = 53 + integer, parameter :: id_CH4 = 54 + integer, parameter :: id_CHBR3 = 55 + integer, parameter :: id_CL = 56 + integer, parameter :: id_CL2 = 57 + integer, parameter :: id_CL2O2 = 58 + integer, parameter :: id_CLO = 59 + integer, parameter :: id_CLONO2 = 60 + integer, parameter :: id_CLY = 61 + integer, parameter :: id_CO = 62 + integer, parameter :: id_CO2 = 63 + integer, parameter :: id_COF2 = 64 + integer, parameter :: id_COFCL = 65 + integer, parameter :: id_CRESOL = 66 + integer, parameter :: id_DMS = 67 + integer, parameter :: id_dst_a1 = 68 + integer, parameter :: id_dst_a2 = 69 + integer, parameter :: id_dst_a3 = 70 + integer, parameter :: id_E90 = 71 + integer, parameter :: id_EOOH = 72 + integer, parameter :: id_F = 73 + integer, parameter :: id_GLYALD = 74 + integer, parameter :: id_GLYOXAL = 75 + integer, parameter :: id_H = 76 + integer, parameter :: id_H2 = 77 + integer, parameter :: id_H2402 = 78 + integer, parameter :: id_H2O2 = 79 + integer, parameter :: id_H2SO4 = 80 + integer, parameter :: id_HBR = 81 + integer, parameter :: id_HCFC141B = 82 + integer, parameter :: id_HCFC142B = 83 + integer, parameter :: id_HCFC22 = 84 + integer, parameter :: id_HCL = 85 + integer, parameter :: id_HCN = 86 + integer, parameter :: id_HCOOH = 87 + integer, parameter :: id_HF = 88 + integer, parameter :: id_HNO3 = 89 + integer, parameter :: id_HO2NO2 = 90 + integer, parameter :: id_HOBR = 91 + integer, parameter :: id_HOCL = 92 + integer, parameter :: id_HONITR = 93 + integer, parameter :: id_HPALD = 94 + integer, parameter :: id_HYAC = 95 + integer, parameter :: id_HYDRALD = 96 + integer, parameter :: id_IEPOX = 97 + integer, parameter :: id_ISOP = 98 + integer, parameter :: id_ISOPNITA = 99 + integer, parameter :: id_ISOPNITB = 100 + integer, parameter :: id_ISOPNO3 = 101 + integer, parameter :: id_ISOPNOOH = 102 + integer, parameter :: id_ISOPOOH = 103 + integer, parameter :: id_IVOC = 104 + integer, parameter :: id_MACR = 105 + integer, parameter :: id_MACROOH = 106 + integer, parameter :: id_MEK = 107 + integer, parameter :: id_MEKOOH = 108 + integer, parameter :: id_MPAN = 109 + integer, parameter :: id_MTERP = 110 + integer, parameter :: id_MVK = 111 + integer, parameter :: id_N = 112 + integer, parameter :: id_N2O = 113 + integer, parameter :: id_N2O5 = 114 + integer, parameter :: id_NC4CH2OH = 115 + integer, parameter :: id_NC4CHO = 116 + integer, parameter :: id_ncl_a1 = 117 + integer, parameter :: id_ncl_a2 = 118 + integer, parameter :: id_ncl_a3 = 119 + integer, parameter :: id_NH3 = 120 + integer, parameter :: id_NH4 = 121 + integer, parameter :: id_NH_5 = 122 + integer, parameter :: id_NH_50 = 123 + integer, parameter :: id_NO = 124 + integer, parameter :: id_NO2 = 125 + integer, parameter :: id_NO3 = 126 + integer, parameter :: id_NOA = 127 + integer, parameter :: id_NTERPOOH = 128 + integer, parameter :: id_num_a1 = 129 + integer, parameter :: id_num_a2 = 130 + integer, parameter :: id_num_a3 = 131 + integer, parameter :: id_num_a4 = 132 + integer, parameter :: id_num_a5 = 133 + integer, parameter :: id_O = 134 + integer, parameter :: id_O3 = 135 + integer, parameter :: id_O3S = 136 + integer, parameter :: id_OCLO = 137 + integer, parameter :: id_OCS = 138 + integer, parameter :: id_ONITR = 139 + integer, parameter :: id_PAN = 140 + integer, parameter :: id_PBZNIT = 141 + integer, parameter :: id_PHENO = 142 + integer, parameter :: id_PHENOL = 143 + integer, parameter :: id_PHENOOH = 144 + integer, parameter :: id_pom_a1 = 145 + integer, parameter :: id_pom_a4 = 146 + integer, parameter :: id_POOH = 147 + integer, parameter :: id_ROOH = 148 + integer, parameter :: id_S = 149 + integer, parameter :: id_SF6 = 150 + integer, parameter :: id_SO = 151 + integer, parameter :: id_SO2 = 152 + integer, parameter :: id_SO3 = 153 + integer, parameter :: id_so4_a1 = 154 + integer, parameter :: id_so4_a2 = 155 + integer, parameter :: id_so4_a3 = 156 + integer, parameter :: id_so4_a5 = 157 + integer, parameter :: id_soa1_a1 = 158 + integer, parameter :: id_soa1_a2 = 159 + integer, parameter :: id_soa2_a1 = 160 + integer, parameter :: id_soa2_a2 = 161 + integer, parameter :: id_soa3_a1 = 162 + integer, parameter :: id_soa3_a2 = 163 + integer, parameter :: id_soa4_a1 = 164 + integer, parameter :: id_soa4_a2 = 165 + integer, parameter :: id_soa5_a1 = 166 + integer, parameter :: id_soa5_a2 = 167 + integer, parameter :: id_SOAG0 = 168 + integer, parameter :: id_SOAG1 = 169 + integer, parameter :: id_SOAG2 = 170 + integer, parameter :: id_SOAG3 = 171 + integer, parameter :: id_SOAG4 = 172 + integer, parameter :: id_ST80_25 = 173 + integer, parameter :: id_SVOC = 174 + integer, parameter :: id_TEPOMUC = 175 + integer, parameter :: id_TERP2OOH = 176 + integer, parameter :: id_TERPNIT = 177 + integer, parameter :: id_TERPOOH = 178 + integer, parameter :: id_TERPROD1 = 179 + integer, parameter :: id_TERPROD2 = 180 + integer, parameter :: id_TOLOOH = 181 + integer, parameter :: id_TOLUENE = 182 + integer, parameter :: id_XOOH = 183 + integer, parameter :: id_XYLENES = 184 + integer, parameter :: id_XYLENOOH = 185 + integer, parameter :: id_XYLOL = 186 + integer, parameter :: id_XYLOLOOH = 187 + integer, parameter :: id_NHDEP = 188 + integer, parameter :: id_NDEP = 189 + integer, parameter :: id_ACBZO2 = 190 + integer, parameter :: id_ALKO2 = 191 + integer, parameter :: id_BCARYO2VBS = 192 + integer, parameter :: id_BENZO2 = 193 + integer, parameter :: id_BENZO2VBS = 194 + integer, parameter :: id_BZOO = 195 + integer, parameter :: id_C2H5O2 = 196 + integer, parameter :: id_C3H7O2 = 197 + integer, parameter :: id_C6H5O2 = 198 + integer, parameter :: id_CH3CO3 = 199 + integer, parameter :: id_CH3O2 = 200 + integer, parameter :: id_DICARBO2 = 201 + integer, parameter :: id_ENEO2 = 202 + integer, parameter :: id_EO = 203 + integer, parameter :: id_EO2 = 204 + integer, parameter :: id_HO2 = 205 + integer, parameter :: id_HOCH2OO = 206 + integer, parameter :: id_ISOPAO2 = 207 + integer, parameter :: id_ISOPBO2 = 208 + integer, parameter :: id_ISOPO2VBS = 209 + integer, parameter :: id_IVOCO2VBS = 210 + integer, parameter :: id_MACRO2 = 211 + integer, parameter :: id_MALO2 = 212 + integer, parameter :: id_MCO3 = 213 + integer, parameter :: id_MDIALO2 = 214 + integer, parameter :: id_MEKO2 = 215 + integer, parameter :: id_MTERPO2VBS = 216 + integer, parameter :: id_NTERPO2 = 217 + integer, parameter :: id_O1D = 218 + integer, parameter :: id_OH = 219 + integer, parameter :: id_PHENO2 = 220 + integer, parameter :: id_PO2 = 221 + integer, parameter :: id_RO2 = 222 + integer, parameter :: id_TERP2O2 = 223 + integer, parameter :: id_TERPO2 = 224 + integer, parameter :: id_TOLO2 = 225 + integer, parameter :: id_TOLUO2VBS = 226 + integer, parameter :: id_XO2 = 227 + integer, parameter :: id_XYLENO2 = 228 + integer, parameter :: id_XYLEO2VBS = 229 + integer, parameter :: id_XYLOLO2 = 230 + integer, parameter :: id_H2O = 231 + end module m_spc_id diff --git a/src/chemistry/pp_trop_strat_mam5_vbs/mo_adjrxt.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/mo_adjrxt.F90 new file mode 100644 index 0000000000..72c913307a --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/mo_adjrxt.F90 @@ -0,0 +1,429 @@ + 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(:,:, 127) = rate(:,:, 127) * inv(:,:, 3) + rate(:,:, 128) = rate(:,:, 128) * inv(:,:, 2) + rate(:,:, 131) = rate(:,:, 131) * inv(:,:, 1) + rate(:,:, 148) = rate(:,:, 148) * inv(:,:, 1) + rate(:,:, 155) = rate(:,:, 155) * inv(:,:, 2) + rate(:,:, 158) = rate(:,:, 158) * inv(:,:, 1) + rate(:,:, 166) = rate(:,:, 166) * inv(:,:, 1) + rate(:,:, 169) = rate(:,:, 169) * inv(:,:, 1) + rate(:,:, 170) = rate(:,:, 170) * inv(:,:, 1) + rate(:,:, 171) = rate(:,:, 171) * inv(:,:, 1) + rate(:,:, 173) = rate(:,:, 173) * inv(:,:, 1) + rate(:,:, 174) = rate(:,:, 174) * inv(:,:, 1) + rate(:,:, 189) = rate(:,:, 189) * inv(:,:, 1) + rate(:,:, 209) = rate(:,:, 209) * inv(:,:, 1) + rate(:,:, 210) = rate(:,:, 210) * inv(:,:, 1) + rate(:,:, 220) = rate(:,:, 220) * inv(:,:, 1) + rate(:,:, 266) = rate(:,:, 266) * inv(:,:, 1) + rate(:,:, 276) = rate(:,:, 276) * inv(:,:, 1) + rate(:,:, 277) = rate(:,:, 277) * inv(:,:, 1) + rate(:,:, 278) = rate(:,:, 278) * inv(:,:, 1) + rate(:,:, 300) = rate(:,:, 300) * inv(:,:, 2) + rate(:,:, 304) = rate(:,:, 304) * inv(:,:, 1) + rate(:,:, 305) = rate(:,:, 305) * inv(:,:, 1) + rate(:,:, 306) = rate(:,:, 306) * inv(:,:, 1) + rate(:,:, 325) = rate(:,:, 325) * inv(:,:, 1) + rate(:,:, 351) = rate(:,:, 351) * inv(:,:, 1) + rate(:,:, 354) = rate(:,:, 354) * inv(:,:, 1) + rate(:,:, 355) = rate(:,:, 355) * inv(:,:, 1) + rate(:,:, 412) = rate(:,:, 412) * inv(:,:, 1) + rate(:,:, 415) = rate(:,:, 415) * inv(:,:, 1) + rate(:,:, 418) = rate(:,:, 418) * inv(:,:, 1) + rate(:,:, 425) = rate(:,:, 425) * inv(:,:, 1) + rate(:,:, 430) = rate(:,:, 430) * inv(:,:, 1) + rate(:,:, 466) = rate(:,:, 466) * inv(:,:, 2) + rate(:,:, 467) = rate(:,:, 467) * inv(:,:, 1) + rate(:,:, 473) = rate(:,:, 473) * inv(:,:, 2) + rate(:,:, 132) = rate(:,:, 132) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 138) = rate(:,:, 138) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 125) = rate(:,:, 125) * m(:,:) + rate(:,:, 126) = rate(:,:, 126) * m(:,:) + rate(:,:, 129) = rate(:,:, 129) * m(:,:) + rate(:,:, 130) = rate(:,:, 130) * m(:,:) + rate(:,:, 131) = rate(:,:, 131) * m(:,:) + rate(:,:, 133) = rate(:,:, 133) * m(:,:) + rate(:,:, 134) = rate(:,:, 134) * m(:,:) + rate(:,:, 135) = rate(:,:, 135) * m(:,:) + rate(:,:, 136) = rate(:,:, 136) * m(:,:) + rate(:,:, 137) = rate(:,:, 137) * 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(:,:, 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(:,:, 172) = rate(:,:, 172) * 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(:,:, 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * 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(:,:, 252) = rate(:,:, 252) * 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(:,:, 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(:,:, 292) = rate(:,:, 292) * 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(:,:, 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(:,:, 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(:,:, 322) = rate(:,:, 322) * 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(:,:, 329) = rate(:,:, 329) * 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(:,:, 336) = rate(:,:, 336) * m(:,:) + rate(:,:, 337) = rate(:,:, 337) * m(:,:) + rate(:,:, 338) = rate(:,:, 338) * m(:,:) + rate(:,:, 339) = rate(:,:, 339) * m(:,:) + rate(:,:, 340) = rate(:,:, 340) * m(:,:) + rate(:,:, 341) = rate(:,:, 341) * m(:,:) + rate(:,:, 342) = rate(:,:, 342) * m(:,:) + rate(:,:, 343) = rate(:,:, 343) * m(:,:) + rate(:,:, 344) = rate(:,:, 344) * m(:,:) + rate(:,:, 345) = rate(:,:, 345) * m(:,:) + rate(:,:, 346) = rate(:,:, 346) * m(:,:) + rate(:,:, 347) = rate(:,:, 347) * m(:,:) + rate(:,:, 348) = rate(:,:, 348) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 352) = rate(:,:, 352) * m(:,:) + rate(:,:, 353) = rate(:,:, 353) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 357) = rate(:,:, 357) * m(:,:) + rate(:,:, 358) = rate(:,:, 358) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + rate(:,:, 360) = rate(:,:, 360) * m(:,:) + rate(:,:, 361) = rate(:,:, 361) * m(:,:) + rate(:,:, 362) = rate(:,:, 362) * m(:,:) + rate(:,:, 363) = rate(:,:, 363) * m(:,:) + rate(:,:, 364) = rate(:,:, 364) * m(:,:) + rate(:,:, 365) = rate(:,:, 365) * m(:,:) + rate(:,:, 366) = rate(:,:, 366) * m(:,:) + rate(:,:, 367) = rate(:,:, 367) * m(:,:) + rate(:,:, 368) = rate(:,:, 368) * m(:,:) + rate(:,:, 369) = rate(:,:, 369) * m(:,:) + rate(:,:, 370) = rate(:,:, 370) * m(:,:) + rate(:,:, 371) = rate(:,:, 371) * m(:,:) + rate(:,:, 372) = rate(:,:, 372) * m(:,:) + rate(:,:, 374) = rate(:,:, 374) * m(:,:) + rate(:,:, 375) = rate(:,:, 375) * m(:,:) + rate(:,:, 376) = rate(:,:, 376) * m(:,:) + rate(:,:, 377) = rate(:,:, 377) * m(:,:) + rate(:,:, 378) = rate(:,:, 378) * m(:,:) + rate(:,:, 379) = rate(:,:, 379) * m(:,:) + rate(:,:, 380) = rate(:,:, 380) * m(:,:) + rate(:,:, 381) = rate(:,:, 381) * m(:,:) + rate(:,:, 382) = rate(:,:, 382) * m(:,:) + rate(:,:, 383) = rate(:,:, 383) * m(:,:) + rate(:,:, 384) = rate(:,:, 384) * m(:,:) + rate(:,:, 385) = rate(:,:, 385) * m(:,:) + rate(:,:, 386) = rate(:,:, 386) * m(:,:) + rate(:,:, 387) = rate(:,:, 387) * m(:,:) + rate(:,:, 388) = rate(:,:, 388) * m(:,:) + rate(:,:, 389) = rate(:,:, 389) * m(:,:) + rate(:,:, 390) = rate(:,:, 390) * m(:,:) + rate(:,:, 391) = rate(:,:, 391) * m(:,:) + rate(:,:, 392) = rate(:,:, 392) * m(:,:) + rate(:,:, 393) = rate(:,:, 393) * m(:,:) + rate(:,:, 394) = rate(:,:, 394) * m(:,:) + rate(:,:, 395) = rate(:,:, 395) * m(:,:) + rate(:,:, 396) = rate(:,:, 396) * m(:,:) + rate(:,:, 397) = rate(:,:, 397) * m(:,:) + rate(:,:, 398) = rate(:,:, 398) * m(:,:) + rate(:,:, 399) = rate(:,:, 399) * m(:,:) + rate(:,:, 400) = rate(:,:, 400) * m(:,:) + rate(:,:, 401) = rate(:,:, 401) * m(:,:) + rate(:,:, 402) = rate(:,:, 402) * m(:,:) + rate(:,:, 403) = rate(:,:, 403) * m(:,:) + rate(:,:, 404) = rate(:,:, 404) * m(:,:) + rate(:,:, 405) = rate(:,:, 405) * m(:,:) + rate(:,:, 406) = rate(:,:, 406) * m(:,:) + rate(:,:, 407) = rate(:,:, 407) * m(:,:) + rate(:,:, 408) = rate(:,:, 408) * m(:,:) + rate(:,:, 409) = rate(:,:, 409) * m(:,:) + rate(:,:, 410) = rate(:,:, 410) * m(:,:) + rate(:,:, 411) = rate(:,:, 411) * m(:,:) + rate(:,:, 412) = rate(:,:, 412) * m(:,:) + rate(:,:, 413) = rate(:,:, 413) * m(:,:) + rate(:,:, 414) = rate(:,:, 414) * m(:,:) + rate(:,:, 415) = rate(:,:, 415) * m(:,:) + rate(:,:, 416) = rate(:,:, 416) * m(:,:) + rate(:,:, 417) = rate(:,:, 417) * m(:,:) + rate(:,:, 418) = rate(:,:, 418) * m(:,:) + rate(:,:, 419) = rate(:,:, 419) * m(:,:) + rate(:,:, 420) = rate(:,:, 420) * m(:,:) + rate(:,:, 421) = rate(:,:, 421) * m(:,:) + rate(:,:, 422) = rate(:,:, 422) * m(:,:) + rate(:,:, 423) = rate(:,:, 423) * m(:,:) + rate(:,:, 424) = rate(:,:, 424) * m(:,:) + rate(:,:, 425) = rate(:,:, 425) * m(:,:) + rate(:,:, 426) = rate(:,:, 426) * m(:,:) + rate(:,:, 427) = rate(:,:, 427) * m(:,:) + rate(:,:, 428) = rate(:,:, 428) * m(:,:) + rate(:,:, 429) = rate(:,:, 429) * m(:,:) + rate(:,:, 431) = rate(:,:, 431) * m(:,:) + rate(:,:, 432) = rate(:,:, 432) * m(:,:) + rate(:,:, 433) = rate(:,:, 433) * m(:,:) + rate(:,:, 434) = rate(:,:, 434) * m(:,:) + rate(:,:, 435) = rate(:,:, 435) * m(:,:) + rate(:,:, 436) = rate(:,:, 436) * m(:,:) + rate(:,:, 437) = rate(:,:, 437) * m(:,:) + rate(:,:, 438) = rate(:,:, 438) * m(:,:) + rate(:,:, 439) = rate(:,:, 439) * m(:,:) + rate(:,:, 440) = rate(:,:, 440) * m(:,:) + rate(:,:, 441) = rate(:,:, 441) * m(:,:) + rate(:,:, 442) = rate(:,:, 442) * m(:,:) + rate(:,:, 443) = rate(:,:, 443) * m(:,:) + rate(:,:, 444) = rate(:,:, 444) * m(:,:) + rate(:,:, 445) = rate(:,:, 445) * m(:,:) + rate(:,:, 446) = rate(:,:, 446) * m(:,:) + rate(:,:, 447) = rate(:,:, 447) * m(:,:) + rate(:,:, 448) = rate(:,:, 448) * m(:,:) + rate(:,:, 449) = rate(:,:, 449) * m(:,:) + rate(:,:, 450) = rate(:,:, 450) * m(:,:) + rate(:,:, 451) = rate(:,:, 451) * m(:,:) + rate(:,:, 452) = rate(:,:, 452) * m(:,:) + rate(:,:, 453) = rate(:,:, 453) * m(:,:) + rate(:,:, 454) = rate(:,:, 454) * m(:,:) + rate(:,:, 455) = rate(:,:, 455) * m(:,:) + rate(:,:, 456) = rate(:,:, 456) * m(:,:) + rate(:,:, 457) = rate(:,:, 457) * m(:,:) + rate(:,:, 458) = rate(:,:, 458) * m(:,:) + rate(:,:, 459) = rate(:,:, 459) * m(:,:) + rate(:,:, 460) = rate(:,:, 460) * m(:,:) + rate(:,:, 461) = rate(:,:, 461) * m(:,:) + rate(:,:, 462) = rate(:,:, 462) * m(:,:) + rate(:,:, 463) = rate(:,:, 463) * m(:,:) + rate(:,:, 464) = rate(:,:, 464) * m(:,:) + rate(:,:, 465) = rate(:,:, 465) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * m(:,:) + rate(:,:, 468) = rate(:,:, 468) * m(:,:) + rate(:,:, 469) = rate(:,:, 469) * m(:,:) + rate(:,:, 470) = rate(:,:, 470) * m(:,:) + rate(:,:, 471) = rate(:,:, 471) * m(:,:) + rate(:,:, 472) = rate(:,:, 472) * m(:,:) + rate(:,:, 474) = rate(:,:, 474) * m(:,:) + rate(:,:, 475) = rate(:,:, 475) * m(:,:) + rate(:,:, 476) = rate(:,:, 476) * m(:,:) + rate(:,:, 477) = rate(:,:, 477) * m(:,:) + rate(:,:, 478) = rate(:,:, 478) * m(:,:) + rate(:,:, 479) = rate(:,:, 479) * m(:,:) + rate(:,:, 494) = rate(:,:, 494) * m(:,:) + rate(:,:, 495) = rate(:,:, 495) * m(:,:) + rate(:,:, 496) = rate(:,:, 496) * m(:,:) + rate(:,:, 497) = rate(:,:, 497) * m(:,:) + rate(:,:, 498) = rate(:,:, 498) * m(:,:) + rate(:,:, 499) = rate(:,:, 499) * m(:,:) + rate(:,:, 500) = rate(:,:, 500) * m(:,:) + rate(:,:, 501) = rate(:,:, 501) * m(:,:) + rate(:,:, 502) = rate(:,:, 502) * m(:,:) + rate(:,:, 503) = rate(:,:, 503) * m(:,:) + rate(:,:, 504) = rate(:,:, 504) * m(:,:) + rate(:,:, 505) = rate(:,:, 505) * m(:,:) + rate(:,:, 506) = rate(:,:, 506) * m(:,:) + rate(:,:, 507) = rate(:,:, 507) * m(:,:) + rate(:,:, 508) = rate(:,:, 508) * m(:,:) + rate(:,:, 509) = rate(:,:, 509) * m(:,:) + rate(:,:, 510) = rate(:,:, 510) * m(:,:) + rate(:,:, 511) = rate(:,:, 511) * m(:,:) + rate(:,:, 512) = rate(:,:, 512) * m(:,:) + rate(:,:, 513) = rate(:,:, 513) * m(:,:) + rate(:,:, 514) = rate(:,:, 514) * m(:,:) + rate(:,:, 515) = rate(:,:, 515) * m(:,:) + rate(:,:, 516) = rate(:,:, 516) * m(:,:) + rate(:,:, 517) = rate(:,:, 517) * m(:,:) + rate(:,:, 518) = rate(:,:, 518) * m(:,:) + rate(:,:, 519) = rate(:,:, 519) * m(:,:) + rate(:,:, 520) = rate(:,:, 520) * m(:,:) + rate(:,:, 521) = rate(:,:, 521) * m(:,:) + rate(:,:, 523) = rate(:,:, 523) * m(:,:) + rate(:,:, 528) = rate(:,:, 528) * m(:,:) + rate(:,:, 529) = rate(:,:, 529) * m(:,:) + rate(:,:, 530) = rate(:,:, 530) * m(:,:) + rate(:,:, 533) = rate(:,:, 533) * m(:,:) + rate(:,:, 534) = rate(:,:, 534) * m(:,:) + rate(:,:, 535) = rate(:,:, 535) * m(:,:) + rate(:,:, 538) = rate(:,:, 538) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_trop_strat_mam5_vbs/mo_exp_sol.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/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_vbs/mo_imp_sol.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/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_vbs/mo_indprd.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/mo_indprd.F90 new file mode 100644 index 0000000000..70d5135f89 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/mo_indprd.F90 @@ -0,0 +1,263 @@ + 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(:,479)*y(:,219)*y(:,120) +rxt(:,488)*y(:,121) + prod(:,2) = (rxt(:,412)*y(:,201) +rxt(:,415)*y(:,212) +rxt(:,418)*y(:,214) + & + rxt(:,422)*y(:,142))*y(:,125) +.500_r8*rxt(:,351)*y(:,219)*y(:,109) & + +.200_r8*rxt(:,447)*y(:,217)*y(:,124) +.500_r8*rxt(:,459)*y(:,179) & + *y(:,126) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,153) = 0._r8 + prod(:,156) = 0._r8 + prod(:,1) = + extfrc(:,14) + prod(:,2) = 0._r8 + prod(:,3) = + extfrc(:,11) + prod(:,187) = 0._r8 + prod(:,72) = 0._r8 + prod(:,122) = 0._r8 + prod(:,73) = 0._r8 + prod(:,116) = 0._r8 + prod(:,129) = 0._r8 + prod(:,98) = 0._r8 + prod(:,147) = 0._r8 + prod(:,106) = 0._r8 + prod(:,85) = 0._r8 + prod(:,112) = 0._r8 + prod(:,211) = 0._r8 + prod(:,86) = 0._r8 + prod(:,226) = 0._r8 + prod(:,143) = 0._r8 + prod(:,4) = 0._r8 + prod(:,88) = 0._r8 + prod(:,109) = 0._r8 + prod(:,101) = 0._r8 + prod(:,142) = 0._r8 + prod(:,94) = 0._r8 + prod(:,110) = 0._r8 + prod(:,103) = 0._r8 + prod(:,188) = 0._r8 + prod(:,121) = 0._r8 + prod(:,59) = 0._r8 + prod(:,95) = 0._r8 + prod(:,56) = 0._r8 + prod(:,68) = 0._r8 + prod(:,69) = 0._r8 + prod(:,60) = 0._r8 + prod(:,70) = 0._r8 + prod(:,61) = 0._r8 + prod(:,71) = 0._r8 + prod(:,62) = 0._r8 + prod(:,131) = 0._r8 + prod(:,215) = 0._r8 + prod(:,148) = 0._r8 + prod(:,63) = 0._r8 + prod(:,192) = 0._r8 + prod(:,114) = 0._r8 + prod(:,57) = 0._r8 + prod(:,182) = 0._r8 + prod(:,202) = 0._r8 + prod(:,158) = 0._r8 + prod(:,150) = 0._r8 + prod(:,169) = 0._r8 + prod(:,128) = 0._r8 + prod(:,212) = 0._r8 + prod(:,117) = 0._r8 + prod(:,223) = 0._r8 + prod(:,75) = 0._r8 + prod(:,54) = 0._r8 + prod(:,218) = 0._r8 + prod(:,180) = 0._r8 + prod(:,5) = 0._r8 + prod(:,195) = + extfrc(:,12) + prod(:,170) = 0._r8 + prod(:,89) = 0._r8 + prod(:,91) = 0._r8 + prod(:,79) = 0._r8 + prod(:,99) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,9) = 0._r8 + prod(:,64) = 0._r8 + prod(:,177) = 0._r8 + prod(:,193) = 0._r8 + prod(:,186) = 0._r8 + prod(:,213) = 0._r8 + prod(:,210) = 0._r8 + prod(:,58) = 0._r8 + prod(:,149) = 0._r8 + prod(:,65) = 0._r8 + prod(:,171) = 0._r8 + prod(:,90) = 0._r8 + prod(:,92) = 0._r8 + prod(:,102) = 0._r8 + prod(:,225) = 0._r8 + prod(:,76) = 0._r8 + prod(:,183) = 0._r8 + prod(:,100) = 0._r8 + prod(:,214) = 0._r8 + prod(:,123) = 0._r8 + prod(:,167) = 0._r8 + prod(:,172) = 0._r8 + prod(:,198) = 0._r8 + prod(:,84) = 0._r8 + prod(:,197) = 0._r8 + prod(:,111) = 0._r8 + prod(:,66) = 0._r8 + prod(:,174) = 0._r8 + prod(:,146) = 0._r8 + prod(:,140) = 0._r8 + prod(:,200) = 0._r8 + prod(:,120) = 0._r8 + prod(:,163) = 0._r8 + prod(:,50) = 0._r8 + prod(:,201) = 0._r8 + prod(:,104) = 0._r8 + prod(:,136) = 0._r8 + prod(:,105) = 0._r8 + prod(:,145) = 0._r8 + prod(:,184) = 0._r8 + prod(:,207) = 0._r8 + prod(:,134) = + extfrc(:,16) + prod(:,77) = 0._r8 + prod(:,97) = 0._r8 + prod(:,115) = 0._r8 + prod(:,191) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,55) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) = 0._r8 + prod(:,221) = + extfrc(:,15) + prod(:,222) = + extfrc(:,9) + prod(:,219) = 0._r8 + prod(:,176) = 0._r8 + prod(:,118) = 0._r8 + prod(:,16) = + extfrc(:,1) + prod(:,17) = + extfrc(:,2) + prod(:,18) = 0._r8 + prod(:,19) = + extfrc(:,6) + prod(:,20) = + extfrc(:,7) + prod(:,227) = (rxt(:,5) +2.000_r8*rxt(:,6)) + prod(:,228) = 0._r8 + prod(:,21) = 0._r8 + prod(:,107) = 0._r8 + prod(:,113) = 0._r8 + prod(:,87) = 0._r8 + prod(:,139) = 0._r8 + prod(:,67) = 0._r8 + prod(:,130) = 0._r8 + prod(:,74) = 0._r8 + prod(:,108) = 0._r8 + prod(:,22) = 0._r8 + prod(:,23) = + extfrc(:,10) + prod(:,141) = 0._r8 + prod(:,119) = 0._r8 + prod(:,137) = 0._r8 + prod(:,24) = 0._r8 + prod(:,203) = 0._r8 + prod(:,175) = + extfrc(:,8) + prod(:,93) = 0._r8 + prod(:,25) = + extfrc(:,3) + prod(:,26) = + extfrc(:,4) + prod(:,27) = 0._r8 + prod(:,28) = + extfrc(:,5) + prod(:,29) = 0._r8 + prod(:,30) = 0._r8 + prod(:,31) = 0._r8 + prod(:,32) = 0._r8 + prod(:,33) = 0._r8 + prod(:,34) = 0._r8 + prod(:,35) = 0._r8 + prod(:,36) = 0._r8 + prod(:,37) = 0._r8 + prod(:,38) = 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(:,45) = + extfrc(:,13) + prod(:,80) = 0._r8 + prod(:,154) = 0._r8 + prod(:,151) = 0._r8 + prod(:,132) = 0._r8 + prod(:,185) = 0._r8 + prod(:,190) = 0._r8 + prod(:,155) = 0._r8 + prod(:,78) = 0._r8 + prod(:,81) = 0._r8 + prod(:,82) = 0._r8 + prod(:,159) = 0._r8 + prod(:,83) = 0._r8 + prod(:,124) = 0._r8 + prod(:,138) = 0._r8 + prod(:,179) = 0._r8 + prod(:,46) = 0._r8 + prod(:,133) = 0._r8 + prod(:,47) = 0._r8 + prod(:,125) = 0._r8 + prod(:,173) = 0._r8 + prod(:,168) = 0._r8 + prod(:,152) = 0._r8 + prod(:,209) = 0._r8 + prod(:,220) = 0._r8 + prod(:,165) = 0._r8 + prod(:,144) = 0._r8 + prod(:,96) = 0._r8 + prod(:,160) = 0._r8 + prod(:,224) = 0._r8 + prod(:,126) = 0._r8 + prod(:,204) = 0._r8 + prod(:,205) = 0._r8 + prod(:,48) = 0._r8 + prod(:,49) = 0._r8 + prod(:,206) = 0._r8 + prod(:,161) = 0._r8 + prod(:,208) = 0._r8 + prod(:,178) = 0._r8 + prod(:,157) = 0._r8 + prod(:,51) = 0._r8 + prod(:,189) = 0._r8 + prod(:,216) =rxt(:,5) + prod(:,217) = 0._r8 + prod(:,127) = 0._r8 + prod(:,166) = 0._r8 + prod(:,196) = 0._r8 + prod(:,194) = 0._r8 + prod(:,181) = 0._r8 + prod(:,162) = 0._r8 + prod(:,52) = 0._r8 + prod(:,199) = 0._r8 + prod(:,164) = 0._r8 + prod(:,53) = 0._r8 + prod(:,135) = 0._r8 + prod(:,229) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_trop_strat_mam5_vbs/mo_lin_matrix.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/mo_lin_matrix.F90 new file mode 100644 index 0000000000..eaaa3cf0ce --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/mo_lin_matrix.F90 @@ -0,0 +1,655 @@ + 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,634) = -( rxt(k,19) + het_rates(k,1) ) + mat(k,668) = -( rxt(k,20) + het_rates(k,2) ) + mat(k,1) = -( het_rates(k,3) ) + mat(k,2) = -( het_rates(k,4) ) + mat(k,3) = -( het_rates(k,5) ) + mat(k,1001) = -( het_rates(k,6) ) + mat(k,164) = -( het_rates(k,7) ) + mat(k,417) = -( rxt(k,21) + het_rates(k,8) ) + mat(k,170) = -( rxt(k,22) + het_rates(k,9) ) + mat(k,381) = -( rxt(k,23) + het_rates(k,10) ) + mat(k,462) = -( rxt(k,24) + het_rates(k,11) ) + mat(k,418) = .500_r8*rxt(k,21) + mat(k,171) = rxt(k,22) + mat(k,655) = .200_r8*rxt(k,70) + mat(k,693) = .060_r8*rxt(k,72) + mat(k,281) = -( rxt(k,25) + het_rates(k,12) ) + mat(k,654) = .200_r8*rxt(k,70) + mat(k,691) = .200_r8*rxt(k,72) + mat(k,592) = -( rxt(k,26) + het_rates(k,13) ) + mat(k,224) = rxt(k,46) + mat(k,1071) = rxt(k,56) + mat(k,656) = .200_r8*rxt(k,70) + mat(k,694) = .150_r8*rxt(k,72) + mat(k,322) = -( rxt(k,27) + het_rates(k,14) ) + mat(k,692) = .210_r8*rxt(k,72) + mat(k,228) = -( het_rates(k,15) ) + mat(k,351) = -( het_rates(k,16) ) + mat(k,1417) = -( het_rates(k,17) ) + mat(k,232) = rxt(k,74) + mat(k,2152) = rxt(k,75) + mat(k,560) = rxt(k,77) + mat(k,145) = rxt(k,79) + mat(k,151) = rxt(k,80) + mat(k,470) = 2.000_r8*rxt(k,86) + mat(k,597) = rxt(k,87) + mat(k,388) = 3.000_r8*rxt(k,90) + mat(k,109) = 2.000_r8*rxt(k,98) + mat(k,807) = rxt(k,99) + mat(k,781) = rxt(k,105) + mat(k,231) = -( rxt(k,74) + het_rates(k,18) ) + mat(k,2166) = -( rxt(k,75) + het_rates(k,19) ) + mat(k,564) = rxt(k,76) + mat(k,558) = -( rxt(k,76) + rxt(k,77) + rxt(k,524) + rxt(k,527) + rxt(k,532) & + + het_rates(k,20) ) + mat(k,4) = -( het_rates(k,21) ) + mat(k,237) = -( het_rates(k,22) ) + mat(k,337) = rxt(k,28) + mat(k,338) = -( rxt(k,28) + het_rates(k,23) ) + mat(k,293) = -( het_rates(k,24) ) + mat(k,550) = -( het_rates(k,25) ) + mat(k,263) = -( het_rates(k,26) ) + mat(k,343) = -( rxt(k,29) + het_rates(k,27) ) + mat(k,306) = -( het_rates(k,28) ) + mat(k,1026) = -( het_rates(k,29) ) + mat(k,1328) = .700_r8*rxt(k,55) + mat(k,411) = -( rxt(k,30) + het_rates(k,30) ) + mat(k,111) = -( het_rates(k,31) ) + mat(k,267) = -( rxt(k,31) + het_rates(k,32) ) + mat(k,101) = -( rxt(k,78) + het_rates(k,33) ) + mat(k,143) = -( rxt(k,79) + het_rates(k,34) ) + mat(k,148) = -( rxt(k,80) + het_rates(k,35) ) + mat(k,115) = -( rxt(k,81) + het_rates(k,36) ) + mat(k,153) = -( rxt(k,82) + het_rates(k,37) ) + mat(k,119) = -( rxt(k,83) + het_rates(k,38) ) + mat(k,158) = -( rxt(k,84) + het_rates(k,39) ) + mat(k,123) = -( rxt(k,85) + het_rates(k,40) ) + mat(k,469) = -( rxt(k,86) + het_rates(k,41) ) + mat(k,1487) = -( rxt(k,32) + rxt(k,33) + het_rates(k,42) ) + mat(k,640) = .100_r8*rxt(k,19) + mat(k,675) = .100_r8*rxt(k,20) + mat(k,458) = rxt(k,38) + mat(k,1435) = .180_r8*rxt(k,39) + mat(k,1100) = rxt(k,43) + mat(k,1159) = .330_r8*rxt(k,45) + mat(k,1145) = rxt(k,47) + mat(k,741) = rxt(k,49) + mat(k,1216) = 1.340_r8*rxt(k,50) + mat(k,862) = rxt(k,57) + mat(k,546) = rxt(k,62) + mat(k,402) = rxt(k,63) + mat(k,651) = .375_r8*rxt(k,65) + mat(k,480) = .400_r8*rxt(k,67) + mat(k,1065) = .680_r8*rxt(k,69) + mat(k,445) = rxt(k,269) + mat(k,273) = 2.000_r8*rxt(k,299) + mat(k,596) = -( rxt(k,87) + het_rates(k,43) ) + mat(k,127) = -( rxt(k,88) + het_rates(k,44) ) + mat(k,1087) = -( rxt(k,34) + het_rates(k,45) ) + mat(k,638) = .400_r8*rxt(k,19) + mat(k,673) = .400_r8*rxt(k,20) + mat(k,345) = rxt(k,29) + mat(k,1150) = .330_r8*rxt(k,45) + mat(k,319) = rxt(k,53) + mat(k,544) = rxt(k,62) + mat(k,367) = -( rxt(k,89) + het_rates(k,46) ) + mat(k,104) = -( het_rates(k,47) ) + mat(k,924) = -( rxt(k,35) + het_rates(k,48) ) + mat(k,637) = .250_r8*rxt(k,19) + mat(k,672) = .250_r8*rxt(k,20) + mat(k,413) = .820_r8*rxt(k,30) + mat(k,1149) = .170_r8*rxt(k,45) + mat(k,646) = .300_r8*rxt(k,65) + mat(k,478) = .050_r8*rxt(k,67) + mat(k,1060) = .500_r8*rxt(k,69) + mat(k,1223) = -( rxt(k,36) + het_rates(k,49) ) + mat(k,384) = .180_r8*rxt(k,23) + mat(k,324) = rxt(k,27) + mat(k,664) = .400_r8*rxt(k,70) + mat(k,702) = .540_r8*rxt(k,72) + mat(k,432) = .510_r8*rxt(k,73) + mat(k,686) = -( het_rates(k,50) ) + mat(k,612) = -( rxt(k,37) + het_rates(k,51) ) + mat(k,799) = -( het_rates(k,52) ) + mat(k,456) = -( rxt(k,38) + het_rates(k,53) ) + mat(k,1432) = -( rxt(k,39) + rxt(k,40) + het_rates(k,54) ) + mat(k,387) = -( rxt(k,90) + het_rates(k,55) ) + mat(k,2009) = -( het_rates(k,56) ) + mat(k,233) = rxt(k,74) + mat(k,103) = 4.000_r8*rxt(k,78) + mat(k,147) = rxt(k,79) + mat(k,118) = 2.000_r8*rxt(k,81) + mat(k,157) = 2.000_r8*rxt(k,82) + mat(k,122) = 2.000_r8*rxt(k,83) + mat(k,162) = rxt(k,84) + mat(k,126) = 2.000_r8*rxt(k,85) + mat(k,129) = 3.000_r8*rxt(k,88) + mat(k,371) = rxt(k,89) + mat(k,180) = 2.000_r8*rxt(k,91) + mat(k,97) = 2.000_r8*rxt(k,92) + mat(k,1725) = rxt(k,93) + mat(k,907) = rxt(k,94) + mat(k,251) = rxt(k,97) + mat(k,247) = rxt(k,100) + mat(k,257) = rxt(k,101) + mat(k,304) = rxt(k,102) + mat(k,2139) = rxt(k,103) + mat(k,818) = rxt(k,106) + mat(k,179) = -( rxt(k,91) + het_rates(k,57) ) + mat(k,95) = -( rxt(k,92) + rxt(k,210) + het_rates(k,58) ) + mat(k,1720) = -( rxt(k,93) + het_rates(k,59) ) + mat(k,904) = rxt(k,95) + mat(k,330) = rxt(k,107) + mat(k,96) = 2.000_r8*rxt(k,210) + mat(k,901) = -( rxt(k,94) + rxt(k,95) + rxt(k,526) + rxt(k,531) + rxt(k,537) & + + het_rates(k,60) ) + mat(k,5) = -( het_rates(k,61) ) + mat(k,1125) = -( het_rates(k,62) ) + mat(k,172) = 1.500_r8*rxt(k,22) + mat(k,383) = .450_r8*rxt(k,23) + mat(k,594) = .600_r8*rxt(k,26) + mat(k,323) = rxt(k,27) + mat(k,1481) = rxt(k,32) + rxt(k,33) + mat(k,1088) = rxt(k,34) + mat(k,1222) = rxt(k,36) + mat(k,1430) = .380_r8*rxt(k,39) + mat(k,804) = rxt(k,41) + mat(k,1099) = rxt(k,43) + mat(k,982) = 2.000_r8*rxt(k,44) + mat(k,1152) = .330_r8*rxt(k,45) + mat(k,1210) = 1.340_r8*rxt(k,51) + mat(k,1330) = .700_r8*rxt(k,55) + mat(k,202) = 1.500_r8*rxt(k,64) + mat(k,650) = .250_r8*rxt(k,65) + mat(k,975) = rxt(k,68) + mat(k,1062) = 1.700_r8*rxt(k,69) + mat(k,362) = rxt(k,110) + mat(k,803) = -( rxt(k,41) + het_rates(k,63) ) + mat(k,613) = rxt(k,37) + mat(k,1428) = .440_r8*rxt(k,39) + mat(k,527) = .400_r8*rxt(k,60) + mat(k,645) = rxt(k,65) + mat(k,1059) = .800_r8*rxt(k,69) + mat(k,240) = -( rxt(k,96) + het_rates(k,64) ) + mat(k,144) = rxt(k,79) + mat(k,149) = rxt(k,80) + mat(k,154) = rxt(k,82) + mat(k,120) = 2.000_r8*rxt(k,83) + mat(k,159) = 2.000_r8*rxt(k,84) + mat(k,124) = rxt(k,85) + mat(k,108) = 2.000_r8*rxt(k,98) + mat(k,252) = rxt(k,101) + mat(k,299) = rxt(k,102) + mat(k,248) = -( rxt(k,97) + het_rates(k,65) ) + mat(k,116) = rxt(k,81) + mat(k,155) = rxt(k,82) + mat(k,244) = rxt(k,100) + mat(k,196) = -( het_rates(k,66) ) + mat(k,284) = -( het_rates(k,67) ) + mat(k,6) = -( het_rates(k,68) ) + mat(k,7) = -( het_rates(k,69) ) + mat(k,8) = -( het_rates(k,70) ) + mat(k,9) = -( rxt(k,124) + het_rates(k,71) ) + mat(k,131) = -( rxt(k,42) + het_rates(k,72) ) + mat(k,866) = -( het_rates(k,73) ) + mat(k,150) = rxt(k,80) + mat(k,160) = rxt(k,84) + mat(k,241) = 2.000_r8*rxt(k,96) + mat(k,249) = rxt(k,97) + mat(k,291) = rxt(k,104) + mat(k,1098) = -( rxt(k,43) + het_rates(k,74) ) + mat(k,1151) = .330_r8*rxt(k,45) + mat(k,648) = .250_r8*rxt(k,65) + mat(k,272) = rxt(k,300) + 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,981) = -( rxt(k,44) + rxt(k,480) + het_rates(k,75) ) + mat(k,420) = rxt(k,21) + mat(k,382) = .130_r8*rxt(k,23) + mat(k,334) = .700_r8*rxt(k,61) + mat(k,662) = .600_r8*rxt(k,70) + mat(k,700) = .340_r8*rxt(k,72) + mat(k,431) = .170_r8*rxt(k,73) + mat(k,1447) = -( rxt(k,138) + het_rates(k,76) ) + mat(k,2271) = rxt(k,2) + 2.000_r8*rxt(k,3) + mat(k,1485) = 2.000_r8*rxt(k,33) + mat(k,457) = rxt(k,38) + mat(k,1433) = .330_r8*rxt(k,39) + rxt(k,40) + mat(k,808) = rxt(k,99) + mat(k,2129) = rxt(k,103) + mat(k,292) = rxt(k,104) + mat(k,1403) = -( het_rates(k,77) ) + mat(k,2268) = rxt(k,1) + mat(k,1482) = rxt(k,32) + mat(k,1431) = 1.440_r8*rxt(k,39) + mat(k,107) = -( rxt(k,98) + het_rates(k,78) ) + mat(k,605) = -( rxt(k,4) + het_rates(k,79) ) + mat(k,134) = -( rxt(k,109) + het_rates(k,80) ) + mat(k,806) = -( rxt(k,99) + het_rates(k,81) ) + mat(k,243) = -( rxt(k,100) + het_rates(k,82) ) + mat(k,253) = -( rxt(k,101) + het_rates(k,83) ) + mat(k,300) = -( rxt(k,102) + het_rates(k,84) ) + mat(k,2141) = -( rxt(k,103) + het_rates(k,85) ) + mat(k,181) = -( het_rates(k,86) ) + mat(k,931) = -( het_rates(k,87) ) + mat(k,290) = -( rxt(k,104) + het_rates(k,88) ) + mat(k,1465) = -( rxt(k,9) + het_rates(k,89) ) + mat(k,1158) = rxt(k,482) + mat(k,587) = rxt(k,483) + mat(k,539) = rxt(k,484) + mat(k,276) = 2.000_r8*rxt(k,485) + 2.000_r8*rxt(k,522) + 2.000_r8*rxt(k,525) & + + 2.000_r8*rxt(k,536) + mat(k,378) = rxt(k,486) + mat(k,1079) = rxt(k,487) + mat(k,1961) = .500_r8*rxt(k,489) + mat(k,1773) = rxt(k,490) + mat(k,396) = rxt(k,491) + mat(k,235) = rxt(k,492) + mat(k,621) = rxt(k,493) + mat(k,561) = rxt(k,524) + rxt(k,527) + rxt(k,532) + mat(k,902) = rxt(k,526) + rxt(k,531) + rxt(k,537) + mat(k,423) = -( rxt(k,10) + rxt(k,11) + rxt(k,173) + het_rates(k,90) ) + mat(k,780) = -( rxt(k,105) + het_rates(k,91) ) + mat(k,559) = rxt(k,524) + rxt(k,527) + rxt(k,532) + mat(k,815) = -( rxt(k,106) + het_rates(k,92) ) + mat(k,900) = rxt(k,526) + rxt(k,531) + rxt(k,537) + mat(k,1155) = -( rxt(k,45) + rxt(k,482) + het_rates(k,93) ) + mat(k,223) = -( rxt(k,46) + het_rates(k,94) ) + mat(k,1274) = rxt(k,373) + mat(k,1142) = -( rxt(k,47) + het_rates(k,95) ) + mat(k,1154) = .170_r8*rxt(k,45) + mat(k,348) = -( het_rates(k,96) ) + mat(k,137) = -( het_rates(k,97) ) + mat(k,836) = -( het_rates(k,98) ) + mat(k,583) = -( rxt(k,483) + het_rates(k,99) ) + mat(k,534) = -( rxt(k,484) + het_rates(k,100) ) + mat(k,1195) = -( het_rates(k,101) ) + mat(k,405) = -( rxt(k,48) + het_rates(k,102) ) + mat(k,737) = -( rxt(k,49) + het_rates(k,103) ) + mat(k,406) = rxt(k,48) + mat(k,76) = -( het_rates(k,104) ) + mat(k,1211) = -( rxt(k,50) + rxt(k,51) + het_rates(k,105) ) + mat(k,739) = .300_r8*rxt(k,49) + mat(k,312) = -( het_rates(k,106) ) + mat(k,508) = -( rxt(k,52) + het_rates(k,107) ) + mat(k,633) = .800_r8*rxt(k,19) + mat(k,667) = .800_r8*rxt(k,20) + mat(k,317) = -( rxt(k,53) + het_rates(k,108) ) + mat(k,574) = -( rxt(k,54) + rxt(k,355) + het_rates(k,109) ) + mat(k,950) = -( het_rates(k,110) ) + mat(k,1334) = -( rxt(k,55) + het_rates(k,111) ) + mat(k,740) = .700_r8*rxt(k,49) + mat(k,493) = -( rxt(k,155) + het_rates(k,112) ) + mat(k,1865) = rxt(k,15) + mat(k,185) = -( rxt(k,12) + het_rates(k,113) ) + mat(k,275) = -( rxt(k,13) + rxt(k,14) + rxt(k,174) + rxt(k,485) + rxt(k,522) & + + rxt(k,525) + rxt(k,536) + het_rates(k,114) ) + mat(k,375) = -( rxt(k,486) + het_rates(k,115) ) + mat(k,1075) = -( rxt(k,56) + rxt(k,487) + het_rates(k,116) ) + mat(k,10) = -( het_rates(k,117) ) + mat(k,11) = -( het_rates(k,118) ) + mat(k,12) = -( het_rates(k,119) ) + mat(k,98) = -( het_rates(k,120) ) + mat(k,13) = -( rxt(k,488) + het_rates(k,121) ) + mat(k,14) = -( rxt(k,540) + het_rates(k,122) ) + mat(k,15) = -( rxt(k,539) + het_rates(k,123) ) + mat(k,1924) = -( rxt(k,15) + het_rates(k,124) ) + mat(k,278) = rxt(k,14) + mat(k,1968) = rxt(k,16) + .500_r8*rxt(k,489) + mat(k,1780) = rxt(k,17) + mat(k,497) = rxt(k,155) + mat(k,1969) = -( rxt(k,16) + rxt(k,489) + het_rates(k,125) ) + mat(k,1471) = rxt(k,9) + mat(k,426) = rxt(k,11) + rxt(k,173) + mat(k,279) = rxt(k,13) + rxt(k,174) + mat(k,1781) = rxt(k,18) + mat(k,642) = rxt(k,19) + mat(k,1164) = rxt(k,45) + mat(k,409) = rxt(k,48) + mat(k,581) = rxt(k,54) + rxt(k,355) + mat(k,1084) = rxt(k,56) + mat(k,864) = rxt(k,57) + mat(k,398) = rxt(k,58) + mat(k,236) = rxt(k,59) + mat(k,533) = .600_r8*rxt(k,60) + rxt(k,306) + mat(k,623) = rxt(k,66) + mat(k,563) = rxt(k,76) + mat(k,906) = rxt(k,95) + mat(k,142) = rxt(k,430) + mat(k,1778) = -( rxt(k,17) + rxt(k,18) + rxt(k,490) + het_rates(k,126) ) + mat(k,425) = rxt(k,10) + mat(k,277) = rxt(k,13) + rxt(k,14) + rxt(k,174) + mat(k,531) = .400_r8*rxt(k,60) + mat(k,562) = rxt(k,77) + mat(k,905) = rxt(k,94) + mat(k,859) = -( rxt(k,57) + het_rates(k,127) ) + mat(k,393) = -( rxt(k,58) + rxt(k,491) + het_rates(k,128) ) + mat(k,16) = -( het_rates(k,129) ) + mat(k,17) = -( het_rates(k,130) ) + mat(k,18) = -( het_rates(k,131) ) + mat(k,19) = -( het_rates(k,132) ) + mat(k,20) = -( het_rates(k,133) ) + mat(k,2198) = -( rxt(k,132) + het_rates(k,134) ) + mat(k,2285) = rxt(k,3) + mat(k,2259) = rxt(k,8) + mat(k,280) = rxt(k,14) + mat(k,1930) = rxt(k,15) + mat(k,1974) = rxt(k,16) + mat(k,1786) = rxt(k,18) + mat(k,1443) = .180_r8*rxt(k,39) + mat(k,805) = rxt(k,41) + mat(k,2167) = rxt(k,75) + mat(k,1729) = rxt(k,93) + mat(k,331) = rxt(k,107) + mat(k,1244) = rxt(k,111) + rxt(k,473) + mat(k,857) = rxt(k,112) + mat(k,261) = rxt(k,113) + mat(k,1539) = rxt(k,127) + rxt(k,128) + mat(k,499) = rxt(k,155) + mat(k,517) = rxt(k,466) + mat(k,2260) = -( rxt(k,7) + rxt(k,8) + het_rates(k,135) ) + mat(k,2199) = rxt(k,132) + mat(k,21) = -( het_rates(k,136) ) + mat(k,327) = -( rxt(k,107) + het_rates(k,137) ) + mat(k,359) = -( rxt(k,110) + het_rates(k,138) ) + mat(k,234) = -( rxt(k,59) + rxt(k,492) + het_rates(k,139) ) + mat(k,526) = -( rxt(k,60) + rxt(k,306) + het_rates(k,140) ) + mat(k,140) = -( rxt(k,430) + het_rates(k,141) ) + mat(k,465) = -( het_rates(k,142) ) + mat(k,268) = rxt(k,31) + mat(k,174) = -( het_rates(k,143) ) + mat(k,332) = -( rxt(k,61) + het_rates(k,144) ) + mat(k,22) = -( het_rates(k,145) ) + mat(k,23) = -( het_rates(k,146) ) + mat(k,542) = -( rxt(k,62) + het_rates(k,147) ) + mat(k,399) = -( rxt(k,63) + het_rates(k,148) ) + mat(k,513) = -( rxt(k,466) + het_rates(k,149) ) + mat(k,360) = rxt(k,110) + mat(k,1232) = rxt(k,111) + mat(k,24) = -( rxt(k,108) + het_rates(k,150) ) + mat(k,1234) = -( rxt(k,111) + rxt(k,473) + het_rates(k,151) ) + mat(k,854) = rxt(k,112) + mat(k,514) = rxt(k,466) + mat(k,853) = -( rxt(k,112) + het_rates(k,152) ) + mat(k,260) = rxt(k,113) + mat(k,1233) = rxt(k,473) + mat(k,259) = -( rxt(k,113) + het_rates(k,153) ) + mat(k,135) = rxt(k,109) + mat(k,25) = -( het_rates(k,154) ) + mat(k,26) = -( het_rates(k,155) ) + mat(k,27) = -( het_rates(k,156) ) + mat(k,28) = -( het_rates(k,157) ) + mat(k,29) = -( rxt(k,114) + het_rates(k,158) ) + mat(k,30) = -( rxt(k,115) + het_rates(k,159) ) + mat(k,31) = -( rxt(k,116) + het_rates(k,160) ) + mat(k,32) = -( rxt(k,117) + het_rates(k,161) ) + mat(k,33) = -( rxt(k,118) + het_rates(k,162) ) + mat(k,34) = -( rxt(k,119) + het_rates(k,163) ) + mat(k,35) = -( rxt(k,120) + het_rates(k,164) ) + mat(k,36) = -( rxt(k,121) + het_rates(k,165) ) + mat(k,37) = -( rxt(k,122) + het_rates(k,166) ) + mat(k,38) = -( rxt(k,123) + het_rates(k,167) ) + mat(k,39) = -( het_rates(k,168) ) + mat(k,979) = rxt(k,480) + mat(k,40) = -( het_rates(k,169) ) + mat(k,41) = -( het_rates(k,170) ) + mat(k,42) = -( het_rates(k,171) ) + mat(k,43) = -( het_rates(k,172) ) + mat(k,44) = -( rxt(k,541) + het_rates(k,173) ) + mat(k,50) = -( het_rates(k,174) ) + mat(k,201) = -( rxt(k,64) + het_rates(k,175) ) + mat(k,644) = -( rxt(k,65) + het_rates(k,176) ) + mat(k,619) = -( rxt(k,66) + rxt(k,493) + het_rates(k,177) ) + mat(k,476) = -( rxt(k,67) + het_rates(k,178) ) + mat(k,971) = -( rxt(k,68) + het_rates(k,179) ) + mat(k,394) = rxt(k,58) + mat(k,620) = rxt(k,66) + mat(k,479) = rxt(k,67) + end do + end subroutine linmat02 + subroutine linmat03( 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,1061) = -( rxt(k,69) + het_rates(k,180) ) + mat(k,647) = rxt(k,65) + mat(k,973) = rxt(k,68) + mat(k,657) = -( rxt(k,70) + het_rates(k,181) ) + mat(k,189) = -( het_rates(k,182) ) + mat(k,205) = -( rxt(k,71) + het_rates(k,183) ) + mat(k,210) = -( het_rates(k,184) ) + mat(k,695) = -( rxt(k,72) + het_rates(k,185) ) + mat(k,218) = -( het_rates(k,186) ) + mat(k,429) = -( rxt(k,73) + het_rates(k,187) ) + mat(k,520) = -( het_rates(k,190) ) + mat(k,141) = rxt(k,430) + mat(k,889) = -( het_rates(k,191) ) + mat(k,56) = -( het_rates(k,192) ) + mat(k,485) = -( het_rates(k,193) ) + mat(k,62) = -( het_rates(k,194) ) + mat(k,437) = -( het_rates(k,195) ) + mat(k,825) = -( het_rates(k,196) ) + mat(k,510) = rxt(k,52) + mat(k,789) = -( het_rates(k,197) ) + mat(k,627) = -( het_rates(k,198) ) + mat(k,1388) = -( het_rates(k,199) ) + mat(k,385) = .130_r8*rxt(k,23) + mat(k,325) = rxt(k,27) + mat(k,926) = rxt(k,35) + mat(k,1224) = rxt(k,36) + mat(k,1157) = .330_r8*rxt(k,45) + mat(k,1144) = rxt(k,47) + mat(k,1215) = 1.340_r8*rxt(k,50) + mat(k,511) = rxt(k,52) + mat(k,320) = rxt(k,53) + mat(k,1336) = .300_r8*rxt(k,55) + mat(k,861) = rxt(k,57) + mat(k,528) = .600_r8*rxt(k,60) + rxt(k,306) + mat(k,401) = rxt(k,63) + mat(k,203) = .500_r8*rxt(k,64) + mat(k,1064) = .650_r8*rxt(k,69) + mat(k,1831) = -( het_rates(k,200) ) + mat(k,1093) = rxt(k,34) + mat(k,928) = rxt(k,35) + mat(k,617) = rxt(k,37) + mat(k,1439) = rxt(k,40) + mat(k,1342) = .300_r8*rxt(k,55) + mat(k,532) = .400_r8*rxt(k,60) + mat(k,600) = rxt(k,87) + mat(k,370) = rxt(k,89) + mat(k,761) = -( het_rates(k,201) ) + mat(k,282) = .600_r8*rxt(k,25) + mat(k,566) = -( het_rates(k,202) ) + mat(k,271) = -( rxt(k,299) + rxt(k,300) + het_rates(k,203) ) + mat(k,132) = rxt(k,42) + mat(k,708) = -( het_rates(k,204) ) + mat(k,2117) = -( rxt(k,481) + het_rates(k,205) ) + mat(k,427) = rxt(k,11) + rxt(k,173) + mat(k,643) = rxt(k,19) + mat(k,677) = .900_r8*rxt(k,20) + mat(k,422) = rxt(k,21) + mat(k,173) = 1.500_r8*rxt(k,22) + mat(k,386) = .560_r8*rxt(k,23) + mat(k,464) = rxt(k,24) + mat(k,283) = .600_r8*rxt(k,25) + mat(k,595) = .600_r8*rxt(k,26) + mat(k,326) = rxt(k,27) + mat(k,342) = rxt(k,28) + mat(k,347) = rxt(k,29) + mat(k,415) = rxt(k,30) + mat(k,1094) = rxt(k,34) + mat(k,1228) = rxt(k,36) + mat(k,1102) = 2.000_r8*rxt(k,43) + mat(k,984) = 2.000_r8*rxt(k,44) + mat(k,1165) = .670_r8*rxt(k,45) + mat(k,227) = rxt(k,46) + mat(k,1147) = rxt(k,47) + mat(k,410) = rxt(k,48) + mat(k,743) = rxt(k,49) + mat(k,1218) = 1.340_r8*rxt(k,50) + .660_r8*rxt(k,51) + mat(k,1085) = rxt(k,56) + mat(k,336) = rxt(k,61) + mat(k,548) = rxt(k,62) + mat(k,204) = rxt(k,64) + mat(k,653) = rxt(k,65) + mat(k,624) = rxt(k,66) + mat(k,482) = rxt(k,67) + mat(k,978) = rxt(k,68) + mat(k,1068) = 1.200_r8*rxt(k,69) + mat(k,666) = rxt(k,70) + mat(k,705) = rxt(k,72) + mat(k,434) = rxt(k,73) + mat(k,1455) = rxt(k,138) + mat(k,448) = rxt(k,269) + mat(k,274) = rxt(k,299) + rxt(k,300) + mat(k,1302) = rxt(k,373) + mat(k,443) = -( rxt(k,269) + het_rates(k,206) ) + mat(k,1258) = -( het_rates(k,207) ) + mat(k,1290) = -( rxt(k,373) + het_rates(k,208) ) + mat(k,68) = -( het_rates(k,209) ) + mat(k,74) = -( het_rates(k,210) ) + mat(k,1313) = -( het_rates(k,211) ) + mat(k,715) = -( het_rates(k,212) ) + mat(k,463) = .600_r8*rxt(k,24) + mat(k,1356) = -( het_rates(k,213) ) + mat(k,1214) = .660_r8*rxt(k,50) + mat(k,577) = rxt(k,54) + rxt(k,355) + mat(k,875) = -( het_rates(k,214) ) + mat(k,593) = .600_r8*rxt(k,26) + mat(k,679) = -( het_rates(k,215) ) + mat(k,82) = -( het_rates(k,216) ) + mat(k,1047) = -( het_rates(k,217) ) + mat(k,1528) = -( rxt(k,127) + rxt(k,128) + het_rates(k,218) ) + mat(k,2274) = rxt(k,1) + mat(k,2248) = rxt(k,7) + mat(k,186) = rxt(k,12) + mat(k,1693) = -( het_rates(k,219) ) + mat(k,2275) = rxt(k,2) + mat(k,606) = 2.000_r8*rxt(k,4) + mat(k,1468) = rxt(k,9) + mat(k,424) = rxt(k,10) + mat(k,676) = rxt(k,20) + mat(k,421) = rxt(k,21) + mat(k,341) = rxt(k,28) + mat(k,346) = rxt(k,29) + mat(k,414) = rxt(k,30) + mat(k,270) = rxt(k,31) + mat(k,616) = rxt(k,37) + mat(k,459) = rxt(k,38) + mat(k,1437) = .330_r8*rxt(k,39) + mat(k,133) = rxt(k,42) + mat(k,226) = rxt(k,46) + mat(k,742) = rxt(k,49) + mat(k,321) = rxt(k,53) + mat(k,397) = rxt(k,58) + mat(k,335) = rxt(k,61) + mat(k,547) = rxt(k,62) + mat(k,403) = rxt(k,63) + mat(k,652) = rxt(k,65) + mat(k,481) = rxt(k,67) + mat(k,665) = rxt(k,70) + mat(k,207) = rxt(k,71) + mat(k,704) = rxt(k,72) + mat(k,433) = rxt(k,73) + mat(k,782) = rxt(k,105) + mat(k,816) = rxt(k,106) + mat(k,1964) = .500_r8*rxt(k,489) + mat(k,450) = -( het_rates(k,220) ) + mat(k,770) = -( het_rates(k,221) ) + mat(k,1131) = -( het_rates(k,222) ) + mat(k,1063) = .150_r8*rxt(k,69) + mat(k,1111) = -( het_rates(k,223) ) + mat(k,914) = -( het_rates(k,224) ) + mat(k,726) = -( het_rates(k,225) ) + mat(k,88) = -( het_rates(k,226) ) + mat(k,1175) = -( het_rates(k,227) ) + mat(k,750) = -( het_rates(k,228) ) + mat(k,94) = -( het_rates(k,229) ) + mat(k,501) = -( het_rates(k,230) ) + mat(k,2287) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,231) ) + mat(k,1444) = .050_r8*rxt(k,39) + mat(k,136) = rxt(k,109) + mat(k,2122) = rxt(k,481) + end do + end subroutine linmat03 + 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 ) + call linmat03( avec_len, mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_strat_mam5_vbs/mo_lu_factor.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/mo_lu_factor.F90 new file mode 100644 index 0000000000..dafb120d81 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/mo_lu_factor.F90 @@ -0,0 +1,8015 @@ + 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) = 1._r8 / lu(k,10) + 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) = 1._r8 / lu(k,33) + 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) = 1._r8 / lu(k,37) + lu(k,38) = 1._r8 / lu(k,38) + lu(k,39) = 1._r8 / lu(k,39) + lu(k,40) = 1._r8 / lu(k,40) + lu(k,41) = 1._r8 / lu(k,41) + lu(k,42) = 1._r8 / lu(k,42) + lu(k,43) = 1._r8 / lu(k,43) + lu(k,44) = 1._r8 / lu(k,44) + lu(k,50) = 1._r8 / lu(k,50) + lu(k,56) = 1._r8 / lu(k,56) + lu(k,62) = 1._r8 / lu(k,62) + lu(k,68) = 1._r8 / lu(k,68) + lu(k,74) = 1._r8 / lu(k,74) + lu(k,76) = 1._r8 / lu(k,76) + lu(k,82) = 1._r8 / lu(k,82) + 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,88) = 1._r8 / lu(k,88) + lu(k,94) = 1._r8 / lu(k,94) + lu(k,95) = 1._r8 / lu(k,95) + lu(k,96) = lu(k,96) * lu(k,95) + lu(k,97) = lu(k,97) * lu(k,95) + lu(k,1720) = lu(k,1720) - lu(k,96) * lu(k,1706) + lu(k,1725) = lu(k,1725) - lu(k,97) * lu(k,1706) + lu(k,98) = 1._r8 / lu(k,98) + lu(k,99) = lu(k,99) * lu(k,98) + lu(k,100) = lu(k,100) * lu(k,98) + lu(k,1693) = lu(k,1693) - lu(k,99) * lu(k,1556) + lu(k,1705) = lu(k,1705) - lu(k,100) * lu(k,1556) + lu(k,101) = 1._r8 / lu(k,101) + lu(k,102) = lu(k,102) * lu(k,101) + lu(k,103) = lu(k,103) * lu(k,101) + lu(k,1528) = lu(k,1528) - lu(k,102) * lu(k,1501) + lu(k,1535) = lu(k,1535) - lu(k,103) * lu(k,1501) + lu(k,104) = 1._r8 / lu(k,104) + lu(k,105) = lu(k,105) * lu(k,104) + lu(k,106) = lu(k,106) * lu(k,104) + lu(k,1693) = lu(k,1693) - lu(k,105) * lu(k,1557) + lu(k,1700) = lu(k,1700) - lu(k,106) * lu(k,1557) + lu(k,107) = 1._r8 / lu(k,107) + lu(k,108) = lu(k,108) * lu(k,107) + lu(k,109) = lu(k,109) * lu(k,107) + lu(k,110) = lu(k,110) * lu(k,107) + lu(k,1512) = lu(k,1512) - lu(k,108) * lu(k,1502) + lu(k,1523) = lu(k,1523) - lu(k,109) * lu(k,1502) + lu(k,1528) = lu(k,1528) - lu(k,110) * lu(k,1502) + 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,1644) = lu(k,1644) - lu(k,112) * lu(k,1558) + lu(k,1693) = lu(k,1693) - lu(k,113) * lu(k,1558) + lu(k,1705) = lu(k,1705) - lu(k,114) * lu(k,1558) + lu(k,115) = 1._r8 / lu(k,115) + lu(k,116) = lu(k,116) * lu(k,115) + lu(k,117) = lu(k,117) * lu(k,115) + lu(k,118) = lu(k,118) * lu(k,115) + lu(k,1514) = lu(k,1514) - lu(k,116) * lu(k,1503) + lu(k,1528) = lu(k,1528) - lu(k,117) * lu(k,1503) + lu(k,1535) = lu(k,1535) - lu(k,118) * lu(k,1503) + lu(k,119) = 1._r8 / lu(k,119) + lu(k,120) = lu(k,120) * lu(k,119) + lu(k,121) = lu(k,121) * lu(k,119) + lu(k,122) = lu(k,122) * lu(k,119) + lu(k,1512) = lu(k,1512) - lu(k,120) * lu(k,1504) + lu(k,1528) = lu(k,1528) - lu(k,121) * lu(k,1504) + lu(k,1535) = lu(k,1535) - lu(k,122) * lu(k,1504) + lu(k,123) = 1._r8 / lu(k,123) + lu(k,124) = lu(k,124) * lu(k,123) + lu(k,125) = lu(k,125) * lu(k,123) + lu(k,126) = lu(k,126) * lu(k,123) + lu(k,1512) = lu(k,1512) - lu(k,124) * lu(k,1505) + lu(k,1528) = lu(k,1528) - lu(k,125) * lu(k,1505) + lu(k,1535) = lu(k,1535) - lu(k,126) * lu(k,1505) + lu(k,127) = 1._r8 / lu(k,127) + lu(k,128) = lu(k,128) * lu(k,127) + lu(k,129) = lu(k,129) * lu(k,127) + lu(k,130) = lu(k,130) * lu(k,127) + lu(k,1693) = lu(k,1693) - lu(k,128) * lu(k,1559) + lu(k,1699) = lu(k,1699) - lu(k,129) * lu(k,1559) + lu(k,1705) = lu(k,1705) - lu(k,130) * lu(k,1559) + lu(k,131) = 1._r8 / lu(k,131) + lu(k,132) = lu(k,132) * lu(k,131) + lu(k,133) = lu(k,133) * lu(k,131) + lu(k,707) = lu(k,707) - lu(k,132) * lu(k,706) + lu(k,711) = - lu(k,133) * lu(k,706) + lu(k,2031) = - lu(k,132) * lu(k,2028) + lu(k,2110) = lu(k,2110) - lu(k,133) * lu(k,2028) + lu(k,134) = 1._r8 / lu(k,134) + lu(k,135) = lu(k,135) * lu(k,134) + lu(k,136) = lu(k,136) * lu(k,134) + lu(k,259) = lu(k,259) - lu(k,135) * lu(k,258) + lu(k,262) = lu(k,262) - lu(k,136) * lu(k,258) + lu(k,2263) = lu(k,2263) - lu(k,135) * lu(k,2262) + lu(k,2287) = lu(k,2287) - lu(k,136) * lu(k,2262) + lu(k,137) = 1._r8 / lu(k,137) + lu(k,138) = lu(k,138) * lu(k,137) + lu(k,139) = lu(k,139) * lu(k,137) + lu(k,738) = lu(k,738) - lu(k,138) * lu(k,736) + lu(k,742) = lu(k,742) - lu(k,139) * lu(k,736) + lu(k,1675) = lu(k,1675) - lu(k,138) * lu(k,1560) + lu(k,1693) = lu(k,1693) - lu(k,139) * lu(k,1560) + lu(k,140) = 1._r8 / lu(k,140) + lu(k,141) = lu(k,141) * lu(k,140) + lu(k,142) = lu(k,142) * lu(k,140) + lu(k,520) = lu(k,520) - lu(k,141) * lu(k,519) + lu(k,524) = lu(k,524) - lu(k,142) * lu(k,519) + lu(k,1939) = lu(k,1939) - lu(k,141) * lu(k,1933) + lu(k,1969) = lu(k,1969) - lu(k,142) * lu(k,1933) + 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,143) = 1._r8 / lu(k,143) + lu(k,144) = lu(k,144) * lu(k,143) + lu(k,145) = lu(k,145) * lu(k,143) + lu(k,146) = lu(k,146) * lu(k,143) + lu(k,147) = lu(k,147) * lu(k,143) + lu(k,1512) = lu(k,1512) - lu(k,144) * lu(k,1506) + lu(k,1523) = lu(k,1523) - lu(k,145) * lu(k,1506) + lu(k,1528) = lu(k,1528) - lu(k,146) * lu(k,1506) + lu(k,1535) = lu(k,1535) - lu(k,147) * lu(k,1506) + lu(k,148) = 1._r8 / lu(k,148) + lu(k,149) = lu(k,149) * lu(k,148) + lu(k,150) = lu(k,150) * lu(k,148) + lu(k,151) = lu(k,151) * lu(k,148) + lu(k,152) = lu(k,152) * lu(k,148) + lu(k,1512) = lu(k,1512) - lu(k,149) * lu(k,1507) + lu(k,1521) = lu(k,1521) - lu(k,150) * lu(k,1507) + lu(k,1523) = lu(k,1523) - lu(k,151) * lu(k,1507) + lu(k,1528) = lu(k,1528) - lu(k,152) * lu(k,1507) + lu(k,153) = 1._r8 / lu(k,153) + lu(k,154) = lu(k,154) * lu(k,153) + lu(k,155) = lu(k,155) * lu(k,153) + lu(k,156) = lu(k,156) * lu(k,153) + lu(k,157) = lu(k,157) * lu(k,153) + lu(k,1512) = lu(k,1512) - lu(k,154) * lu(k,1508) + lu(k,1514) = lu(k,1514) - lu(k,155) * lu(k,1508) + lu(k,1528) = lu(k,1528) - lu(k,156) * lu(k,1508) + lu(k,1535) = lu(k,1535) - lu(k,157) * lu(k,1508) + lu(k,158) = 1._r8 / lu(k,158) + lu(k,159) = lu(k,159) * lu(k,158) + lu(k,160) = lu(k,160) * lu(k,158) + lu(k,161) = lu(k,161) * lu(k,158) + lu(k,162) = lu(k,162) * lu(k,158) + lu(k,1512) = lu(k,1512) - lu(k,159) * lu(k,1509) + lu(k,1521) = lu(k,1521) - lu(k,160) * lu(k,1509) + lu(k,1528) = lu(k,1528) - lu(k,161) * lu(k,1509) + lu(k,1535) = lu(k,1535) - lu(k,162) * lu(k,1509) + lu(k,164) = 1._r8 / lu(k,164) + lu(k,165) = lu(k,165) * lu(k,164) + lu(k,166) = lu(k,166) * lu(k,164) + lu(k,167) = lu(k,167) * lu(k,164) + lu(k,168) = lu(k,168) * lu(k,164) + lu(k,169) = lu(k,169) * lu(k,164) + lu(k,1562) = lu(k,1562) - lu(k,165) * lu(k,1561) + lu(k,1563) = lu(k,1563) - lu(k,166) * lu(k,1561) + lu(k,1611) = lu(k,1611) - lu(k,167) * lu(k,1561) + lu(k,1693) = lu(k,1693) - lu(k,168) * lu(k,1561) + lu(k,1700) = lu(k,1700) - lu(k,169) * lu(k,1561) + lu(k,170) = 1._r8 / lu(k,170) + lu(k,171) = lu(k,171) * lu(k,170) + lu(k,172) = lu(k,172) * lu(k,170) + lu(k,173) = lu(k,173) * lu(k,170) + lu(k,1607) = - lu(k,171) * lu(k,1562) + lu(k,1671) = lu(k,1671) - lu(k,172) * lu(k,1562) + lu(k,1700) = lu(k,1700) - lu(k,173) * lu(k,1562) + lu(k,174) = 1._r8 / lu(k,174) + lu(k,175) = lu(k,175) * lu(k,174) + lu(k,176) = lu(k,176) * lu(k,174) + lu(k,177) = lu(k,177) * lu(k,174) + lu(k,178) = lu(k,178) * lu(k,174) + lu(k,1605) = lu(k,1605) - lu(k,175) * lu(k,1563) + lu(k,1608) = lu(k,1608) - lu(k,176) * lu(k,1563) + lu(k,1693) = lu(k,1693) - lu(k,177) * lu(k,1563) + lu(k,1700) = lu(k,1700) - lu(k,178) * lu(k,1563) + lu(k,179) = 1._r8 / lu(k,179) + lu(k,180) = lu(k,180) * lu(k,179) + lu(k,818) = lu(k,818) - lu(k,180) * lu(k,814) + lu(k,907) = lu(k,907) - lu(k,180) * lu(k,899) + lu(k,1725) = lu(k,1725) - lu(k,180) * lu(k,1707) + lu(k,2009) = lu(k,2009) - lu(k,180) * lu(k,1977) + lu(k,2139) = lu(k,2139) - lu(k,180) * lu(k,2123) + lu(k,181) = 1._r8 / lu(k,181) + lu(k,182) = lu(k,182) * lu(k,181) + lu(k,183) = lu(k,183) * lu(k,181) + lu(k,184) = lu(k,184) * lu(k,181) + lu(k,1528) = lu(k,1528) - lu(k,182) * lu(k,1510) + lu(k,1529) = lu(k,1529) - lu(k,183) * lu(k,1510) + lu(k,1536) = lu(k,1536) - lu(k,184) * lu(k,1510) + lu(k,1692) = - lu(k,182) * lu(k,1564) + lu(k,1693) = lu(k,1693) - lu(k,183) * lu(k,1564) + lu(k,1700) = lu(k,1700) - lu(k,184) * lu(k,1564) + lu(k,185) = 1._r8 / lu(k,185) + lu(k,186) = lu(k,186) * lu(k,185) + lu(k,187) = lu(k,187) * lu(k,185) + lu(k,495) = - lu(k,186) * lu(k,492) + lu(k,497) = lu(k,497) - lu(k,187) * lu(k,492) + lu(k,1528) = lu(k,1528) - lu(k,186) * lu(k,1511) + lu(k,1533) = lu(k,1533) - lu(k,187) * lu(k,1511) + lu(k,1963) = - lu(k,186) * lu(k,1934) + lu(k,1968) = lu(k,1968) - lu(k,187) * lu(k,1934) + lu(k,189) = 1._r8 / lu(k,189) + lu(k,190) = lu(k,190) * lu(k,189) + lu(k,191) = lu(k,191) * lu(k,189) + lu(k,192) = lu(k,192) * lu(k,189) + lu(k,193) = lu(k,193) * lu(k,189) + lu(k,194) = lu(k,194) * lu(k,189) + lu(k,195) = lu(k,195) * lu(k,189) + lu(k,1566) = lu(k,1566) - lu(k,190) * lu(k,1565) + lu(k,1567) = lu(k,1567) - lu(k,191) * lu(k,1565) + lu(k,1604) = lu(k,1604) - lu(k,192) * lu(k,1565) + lu(k,1639) = lu(k,1639) - lu(k,193) * lu(k,1565) + lu(k,1693) = lu(k,1693) - lu(k,194) * lu(k,1565) + lu(k,1700) = lu(k,1700) - lu(k,195) * lu(k,1565) + 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,196) = 1._r8 / lu(k,196) + lu(k,197) = lu(k,197) * lu(k,196) + lu(k,198) = lu(k,198) * lu(k,196) + lu(k,199) = lu(k,199) * lu(k,196) + lu(k,200) = lu(k,200) * lu(k,196) + lu(k,1605) = lu(k,1605) - lu(k,197) * lu(k,1566) + lu(k,1608) = lu(k,1608) - lu(k,198) * lu(k,1566) + lu(k,1693) = lu(k,1693) - lu(k,199) * lu(k,1566) + lu(k,1700) = lu(k,1700) - lu(k,200) * lu(k,1566) + lu(k,201) = 1._r8 / lu(k,201) + lu(k,202) = lu(k,202) * lu(k,201) + lu(k,203) = lu(k,203) * lu(k,201) + lu(k,204) = lu(k,204) * lu(k,201) + lu(k,214) = - lu(k,202) * lu(k,209) + lu(k,215) = - lu(k,203) * lu(k,209) + lu(k,217) = lu(k,217) - lu(k,204) * lu(k,209) + lu(k,1671) = lu(k,1671) - lu(k,202) * lu(k,1567) + lu(k,1685) = lu(k,1685) - lu(k,203) * lu(k,1567) + lu(k,1700) = lu(k,1700) - lu(k,204) * lu(k,1567) + lu(k,205) = 1._r8 / lu(k,205) + lu(k,206) = lu(k,206) * lu(k,205) + lu(k,207) = lu(k,207) * lu(k,205) + lu(k,1175) = lu(k,1175) - lu(k,206) * lu(k,1168) + lu(k,1179) = - lu(k,207) * lu(k,1168) + lu(k,1675) = lu(k,1675) - lu(k,206) * lu(k,1568) + lu(k,1693) = lu(k,1693) - lu(k,207) * lu(k,1568) + lu(k,2093) = lu(k,2093) - lu(k,206) * lu(k,2029) + lu(k,2110) = lu(k,2110) - lu(k,207) * lu(k,2029) + lu(k,210) = 1._r8 / lu(k,210) + lu(k,211) = lu(k,211) * lu(k,210) + lu(k,212) = lu(k,212) * lu(k,210) + lu(k,213) = lu(k,213) * lu(k,210) + lu(k,214) = lu(k,214) * lu(k,210) + lu(k,215) = lu(k,215) * lu(k,210) + lu(k,216) = lu(k,216) * lu(k,210) + lu(k,217) = lu(k,217) * lu(k,210) + lu(k,1570) = lu(k,1570) - lu(k,211) * lu(k,1569) + lu(k,1604) = lu(k,1604) - lu(k,212) * lu(k,1569) + lu(k,1641) = lu(k,1641) - lu(k,213) * lu(k,1569) + lu(k,1671) = lu(k,1671) - lu(k,214) * lu(k,1569) + lu(k,1685) = lu(k,1685) - lu(k,215) * lu(k,1569) + lu(k,1693) = lu(k,1693) - lu(k,216) * lu(k,1569) + lu(k,1700) = lu(k,1700) - lu(k,217) * lu(k,1569) + lu(k,218) = 1._r8 / lu(k,218) + lu(k,219) = lu(k,219) * lu(k,218) + lu(k,220) = lu(k,220) * lu(k,218) + lu(k,221) = lu(k,221) * lu(k,218) + lu(k,222) = lu(k,222) * lu(k,218) + lu(k,1608) = lu(k,1608) - lu(k,219) * lu(k,1570) + lu(k,1613) = lu(k,1613) - lu(k,220) * lu(k,1570) + lu(k,1693) = lu(k,1693) - lu(k,221) * lu(k,1570) + lu(k,1700) = lu(k,1700) - lu(k,222) * lu(k,1570) + lu(k,223) = 1._r8 / lu(k,223) + lu(k,224) = lu(k,224) * lu(k,223) + lu(k,225) = lu(k,225) * lu(k,223) + lu(k,226) = lu(k,226) * lu(k,223) + lu(k,227) = lu(k,227) * lu(k,223) + lu(k,1277) = - lu(k,224) * lu(k,1274) + lu(k,1287) = - lu(k,225) * lu(k,1274) + lu(k,1297) = - lu(k,226) * lu(k,1274) + lu(k,1302) = lu(k,1302) - lu(k,227) * lu(k,1274) + lu(k,1624) = - lu(k,224) * lu(k,1571) + lu(k,1675) = lu(k,1675) - lu(k,225) * lu(k,1571) + lu(k,1693) = lu(k,1693) - lu(k,226) * lu(k,1571) + lu(k,1700) = lu(k,1700) - lu(k,227) * lu(k,1571) + lu(k,228) = 1._r8 / lu(k,228) + lu(k,229) = lu(k,229) * lu(k,228) + lu(k,230) = lu(k,230) * lu(k,228) + lu(k,946) = - lu(k,229) * lu(k,943) + lu(k,962) = lu(k,962) - lu(k,230) * lu(k,943) + lu(k,995) = - lu(k,229) * lu(k,992) + lu(k,1012) = lu(k,1012) - lu(k,230) * lu(k,992) + lu(k,1655) = lu(k,1655) - lu(k,229) * lu(k,1572) + lu(k,1693) = lu(k,1693) - lu(k,230) * lu(k,1572) + lu(k,2217) = - lu(k,229) * lu(k,2206) + lu(k,2249) = lu(k,2249) - lu(k,230) * lu(k,2206) + lu(k,231) = 1._r8 / lu(k,231) + lu(k,232) = lu(k,232) * lu(k,231) + lu(k,233) = lu(k,233) * lu(k,231) + lu(k,781) = lu(k,781) - lu(k,232) * lu(k,779) + lu(k,783) = - lu(k,233) * lu(k,779) + lu(k,1714) = lu(k,1714) - lu(k,232) * lu(k,1708) + lu(k,1725) = lu(k,1725) - lu(k,233) * lu(k,1708) + lu(k,2128) = - lu(k,232) * lu(k,2124) + lu(k,2139) = lu(k,2139) - lu(k,233) * lu(k,2124) + lu(k,2152) = lu(k,2152) - lu(k,232) * lu(k,2146) + lu(k,2163) = lu(k,2163) - lu(k,233) * lu(k,2146) + 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,1115) = - lu(k,235) * lu(k,1104) + lu(k,1120) = lu(k,1120) - lu(k,236) * lu(k,1104) + lu(k,1158) = lu(k,1158) - lu(k,235) * lu(k,1148) + lu(k,1164) = lu(k,1164) - lu(k,236) * lu(k,1148) + lu(k,1690) = lu(k,1690) - lu(k,235) * lu(k,1573) + lu(k,1698) = lu(k,1698) - lu(k,236) * lu(k,1573) + lu(k,1917) = - lu(k,235) * lu(k,1853) + lu(k,1925) = lu(k,1925) - lu(k,236) * lu(k,1853) + 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,237) = 1._r8 / lu(k,237) + lu(k,238) = lu(k,238) * lu(k,237) + lu(k,239) = lu(k,239) * lu(k,237) + lu(k,340) = - lu(k,238) * lu(k,337) + lu(k,341) = lu(k,341) - lu(k,239) * lu(k,337) + lu(k,438) = - lu(k,238) * lu(k,435) + lu(k,439) = - lu(k,239) * lu(k,435) + lu(k,1616) = lu(k,1616) - lu(k,238) * lu(k,1574) + lu(k,1693) = lu(k,1693) - lu(k,239) * lu(k,1574) + lu(k,1868) = lu(k,1868) - lu(k,238) * lu(k,1854) + lu(k,1920) = lu(k,1920) - lu(k,239) * lu(k,1854) + 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,254) = - lu(k,241) * lu(k,252) + lu(k,255) = lu(k,255) - lu(k,242) * lu(k,252) + lu(k,301) = - lu(k,241) * lu(k,299) + lu(k,302) = lu(k,302) - lu(k,242) * lu(k,299) + lu(k,1521) = lu(k,1521) - lu(k,241) * lu(k,1512) + lu(k,1528) = lu(k,1528) - lu(k,242) * lu(k,1512) + lu(k,1653) = - lu(k,241) * lu(k,1575) + lu(k,1692) = lu(k,1692) - lu(k,242) * lu(k,1575) + lu(k,243) = 1._r8 / lu(k,243) + lu(k,244) = lu(k,244) * lu(k,243) + lu(k,245) = lu(k,245) * lu(k,243) + lu(k,246) = lu(k,246) * lu(k,243) + lu(k,247) = lu(k,247) * lu(k,243) + lu(k,1514) = lu(k,1514) - lu(k,244) * lu(k,1513) + lu(k,1528) = lu(k,1528) - lu(k,245) * lu(k,1513) + lu(k,1529) = lu(k,1529) - lu(k,246) * lu(k,1513) + lu(k,1535) = lu(k,1535) - lu(k,247) * lu(k,1513) + lu(k,1577) = lu(k,1577) - lu(k,244) * lu(k,1576) + lu(k,1692) = lu(k,1692) - lu(k,245) * lu(k,1576) + lu(k,1693) = lu(k,1693) - lu(k,246) * lu(k,1576) + lu(k,1699) = lu(k,1699) - lu(k,247) * lu(k,1576) + 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,1521) = lu(k,1521) - lu(k,249) * lu(k,1514) + lu(k,1528) = lu(k,1528) - lu(k,250) * lu(k,1514) + lu(k,1535) = lu(k,1535) - lu(k,251) * lu(k,1514) + lu(k,1653) = lu(k,1653) - lu(k,249) * lu(k,1577) + lu(k,1692) = lu(k,1692) - lu(k,250) * lu(k,1577) + lu(k,1699) = lu(k,1699) - lu(k,251) * lu(k,1577) + lu(k,253) = 1._r8 / lu(k,253) + lu(k,254) = lu(k,254) * lu(k,253) + lu(k,255) = lu(k,255) * lu(k,253) + lu(k,256) = lu(k,256) * lu(k,253) + lu(k,257) = lu(k,257) * lu(k,253) + lu(k,1521) = lu(k,1521) - lu(k,254) * lu(k,1515) + lu(k,1528) = lu(k,1528) - lu(k,255) * lu(k,1515) + lu(k,1529) = lu(k,1529) - lu(k,256) * lu(k,1515) + lu(k,1535) = lu(k,1535) - lu(k,257) * lu(k,1515) + lu(k,1653) = lu(k,1653) - lu(k,254) * lu(k,1578) + lu(k,1692) = lu(k,1692) - lu(k,255) * lu(k,1578) + lu(k,1693) = lu(k,1693) - lu(k,256) * lu(k,1578) + lu(k,1699) = lu(k,1699) - lu(k,257) * lu(k,1578) + lu(k,259) = 1._r8 / lu(k,259) + lu(k,260) = lu(k,260) * lu(k,259) + lu(k,261) = lu(k,261) * lu(k,259) + lu(k,262) = lu(k,262) * lu(k,259) + lu(k,853) = lu(k,853) - lu(k,260) * lu(k,852) + lu(k,857) = lu(k,857) - lu(k,261) * lu(k,852) + lu(k,858) = - lu(k,262) * lu(k,852) + lu(k,1651) = lu(k,1651) - lu(k,260) * lu(k,1579) + lu(k,1703) = lu(k,1703) - lu(k,261) * lu(k,1579) + lu(k,1705) = lu(k,1705) - lu(k,262) * lu(k,1579) + lu(k,2265) = - lu(k,260) * lu(k,2263) + lu(k,2285) = lu(k,2285) - lu(k,261) * lu(k,2263) + lu(k,2287) = lu(k,2287) - lu(k,262) * lu(k,2263) + lu(k,263) = 1._r8 / lu(k,263) + lu(k,264) = lu(k,264) * lu(k,263) + lu(k,265) = lu(k,265) * lu(k,263) + lu(k,266) = lu(k,266) * lu(k,263) + lu(k,826) = lu(k,826) - lu(k,264) * lu(k,822) + lu(k,828) = - lu(k,265) * lu(k,822) + lu(k,832) = lu(k,832) - lu(k,266) * lu(k,822) + lu(k,1668) = lu(k,1668) - lu(k,264) * lu(k,1580) + lu(k,1693) = lu(k,1693) - lu(k,265) * lu(k,1580) + lu(k,1700) = lu(k,1700) - lu(k,266) * lu(k,1580) + lu(k,1807) = lu(k,1807) - lu(k,264) * lu(k,1789) + lu(k,1828) = - lu(k,265) * lu(k,1789) + lu(k,1835) = lu(k,1835) - lu(k,266) * lu(k,1789) + lu(k,267) = 1._r8 / lu(k,267) + lu(k,268) = lu(k,268) * lu(k,267) + lu(k,269) = lu(k,269) * lu(k,267) + lu(k,270) = lu(k,270) * lu(k,267) + lu(k,626) = lu(k,626) - lu(k,268) * lu(k,625) + lu(k,627) = lu(k,627) - lu(k,269) * lu(k,625) + lu(k,628) = - lu(k,270) * lu(k,625) + lu(k,1608) = lu(k,1608) - lu(k,268) * lu(k,1581) + lu(k,1629) = lu(k,1629) - lu(k,269) * lu(k,1581) + lu(k,1693) = lu(k,1693) - lu(k,270) * lu(k,1581) + lu(k,2049) = - lu(k,268) * lu(k,2030) + lu(k,2057) = lu(k,2057) - lu(k,269) * lu(k,2030) + lu(k,2110) = lu(k,2110) - lu(k,270) * lu(k,2030) + lu(k,271) = 1._r8 / lu(k,271) + lu(k,272) = lu(k,272) * lu(k,271) + lu(k,273) = lu(k,273) * lu(k,271) + lu(k,274) = lu(k,274) * lu(k,271) + lu(k,709) = - lu(k,272) * lu(k,707) + lu(k,710) = lu(k,710) - lu(k,273) * lu(k,707) + lu(k,714) = lu(k,714) - lu(k,274) * lu(k,707) + lu(k,1898) = lu(k,1898) - lu(k,272) * lu(k,1855) + lu(k,1918) = lu(k,1918) - lu(k,273) * lu(k,1855) + lu(k,1927) = lu(k,1927) - lu(k,274) * lu(k,1855) + lu(k,2088) = - lu(k,272) * lu(k,2031) + lu(k,2108) = lu(k,2108) - lu(k,273) * lu(k,2031) + lu(k,2117) = lu(k,2117) - lu(k,274) * lu(k,2031) + lu(k,275) = 1._r8 / lu(k,275) + lu(k,276) = lu(k,276) * lu(k,275) + lu(k,277) = lu(k,277) * lu(k,275) + lu(k,278) = lu(k,278) * lu(k,275) + lu(k,279) = lu(k,279) * lu(k,275) + lu(k,280) = lu(k,280) * lu(k,275) + lu(k,1773) = lu(k,1773) - lu(k,276) * lu(k,1734) + lu(k,1778) = lu(k,1778) - lu(k,277) * lu(k,1734) + lu(k,1780) = lu(k,1780) - lu(k,278) * lu(k,1734) + lu(k,1781) = lu(k,1781) - lu(k,279) * lu(k,1734) + lu(k,1786) = lu(k,1786) - lu(k,280) * lu(k,1734) + lu(k,1961) = lu(k,1961) - lu(k,276) * lu(k,1935) + lu(k,1966) = lu(k,1966) - lu(k,277) * lu(k,1935) + lu(k,1968) = lu(k,1968) - lu(k,278) * lu(k,1935) + lu(k,1969) = lu(k,1969) - lu(k,279) * lu(k,1935) + lu(k,1974) = lu(k,1974) - lu(k,280) * lu(k,1935) + 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,281) = 1._r8 / lu(k,281) + lu(k,282) = lu(k,282) * lu(k,281) + lu(k,283) = lu(k,283) * lu(k,281) + lu(k,660) = - lu(k,282) * lu(k,654) + lu(k,666) = lu(k,666) - lu(k,283) * lu(k,654) + lu(k,698) = - lu(k,282) * lu(k,691) + lu(k,705) = lu(k,705) - lu(k,283) * lu(k,691) + lu(k,727) = - lu(k,282) * lu(k,721) + lu(k,735) = lu(k,735) - lu(k,283) * lu(k,721) + lu(k,751) = - lu(k,282) * lu(k,744) + lu(k,760) = lu(k,760) - lu(k,283) * lu(k,744) + lu(k,1881) = lu(k,1881) - lu(k,282) * lu(k,1856) + lu(k,1927) = lu(k,1927) - lu(k,283) * lu(k,1856) + lu(k,284) = 1._r8 / lu(k,284) + lu(k,285) = lu(k,285) * lu(k,284) + lu(k,286) = lu(k,286) * lu(k,284) + lu(k,287) = lu(k,287) * lu(k,284) + lu(k,288) = lu(k,288) * lu(k,284) + lu(k,289) = lu(k,289) * lu(k,284) + lu(k,1651) = lu(k,1651) - lu(k,285) * lu(k,1582) + lu(k,1690) = lu(k,1690) - lu(k,286) * lu(k,1582) + lu(k,1693) = lu(k,1693) - lu(k,287) * lu(k,1582) + lu(k,1695) = lu(k,1695) - lu(k,288) * lu(k,1582) + lu(k,1700) = lu(k,1700) - lu(k,289) * lu(k,1582) + lu(k,1740) = lu(k,1740) - lu(k,285) * lu(k,1735) + lu(k,1773) = lu(k,1773) - lu(k,286) * lu(k,1735) + lu(k,1776) = lu(k,1776) - lu(k,287) * lu(k,1735) + lu(k,1778) = lu(k,1778) - lu(k,288) * lu(k,1735) + lu(k,1783) = lu(k,1783) - lu(k,289) * lu(k,1735) + lu(k,290) = 1._r8 / lu(k,290) + lu(k,291) = lu(k,291) * lu(k,290) + lu(k,292) = lu(k,292) * lu(k,290) + lu(k,866) = lu(k,866) - lu(k,291) * lu(k,865) + lu(k,869) = lu(k,869) - lu(k,292) * lu(k,865) + lu(k,1402) = lu(k,1402) - lu(k,291) * lu(k,1401) + lu(k,1405) = lu(k,1405) - lu(k,292) * lu(k,1401) + lu(k,1429) = lu(k,1429) - lu(k,291) * lu(k,1427) + lu(k,1433) = lu(k,1433) - lu(k,292) * lu(k,1427) + lu(k,1461) = lu(k,1461) - lu(k,291) * lu(k,1460) + lu(k,1464) = - lu(k,292) * lu(k,1460) + lu(k,2266) = lu(k,2266) - lu(k,291) * lu(k,2264) + lu(k,2271) = lu(k,2271) - lu(k,292) * lu(k,2264) + lu(k,293) = 1._r8 / lu(k,293) + lu(k,294) = lu(k,294) * lu(k,293) + lu(k,295) = lu(k,295) * lu(k,293) + lu(k,296) = lu(k,296) * lu(k,293) + lu(k,297) = lu(k,297) * lu(k,293) + lu(k,298) = lu(k,298) * lu(k,293) + lu(k,1659) = lu(k,1659) - lu(k,294) * lu(k,1583) + lu(k,1662) = lu(k,1662) - lu(k,295) * lu(k,1583) + lu(k,1671) = lu(k,1671) - lu(k,296) * lu(k,1583) + lu(k,1693) = lu(k,1693) - lu(k,297) * lu(k,1583) + lu(k,1700) = lu(k,1700) - lu(k,298) * lu(k,1583) + lu(k,1990) = - lu(k,294) * lu(k,1978) + lu(k,1991) = - lu(k,295) * lu(k,1978) + lu(k,1994) = lu(k,1994) - lu(k,296) * lu(k,1978) + lu(k,2003) = lu(k,2003) - lu(k,297) * lu(k,1978) + lu(k,2010) = lu(k,2010) - lu(k,298) * lu(k,1978) + lu(k,300) = 1._r8 / lu(k,300) + lu(k,301) = lu(k,301) * lu(k,300) + lu(k,302) = lu(k,302) * lu(k,300) + lu(k,303) = lu(k,303) * lu(k,300) + lu(k,304) = lu(k,304) * lu(k,300) + lu(k,305) = lu(k,305) * lu(k,300) + lu(k,1521) = lu(k,1521) - lu(k,301) * lu(k,1516) + lu(k,1528) = lu(k,1528) - lu(k,302) * lu(k,1516) + lu(k,1529) = lu(k,1529) - lu(k,303) * lu(k,1516) + lu(k,1535) = lu(k,1535) - lu(k,304) * lu(k,1516) + lu(k,1541) = lu(k,1541) - lu(k,305) * lu(k,1516) + lu(k,1653) = lu(k,1653) - lu(k,301) * lu(k,1584) + lu(k,1692) = lu(k,1692) - lu(k,302) * lu(k,1584) + lu(k,1693) = lu(k,1693) - lu(k,303) * lu(k,1584) + lu(k,1699) = lu(k,1699) - lu(k,304) * lu(k,1584) + lu(k,1705) = lu(k,1705) - lu(k,305) * lu(k,1584) + lu(k,306) = 1._r8 / lu(k,306) + lu(k,307) = lu(k,307) * lu(k,306) + lu(k,308) = lu(k,308) * lu(k,306) + lu(k,309) = lu(k,309) * lu(k,306) + lu(k,310) = lu(k,310) * lu(k,306) + lu(k,311) = lu(k,311) * lu(k,306) + lu(k,1649) = lu(k,1649) - lu(k,307) * lu(k,1585) + lu(k,1693) = lu(k,1693) - lu(k,308) * lu(k,1585) + lu(k,1699) = lu(k,1699) - lu(k,309) * lu(k,1585) + lu(k,1701) = lu(k,1701) - lu(k,310) * lu(k,1585) + lu(k,1705) = lu(k,1705) - lu(k,311) * lu(k,1585) + lu(k,1988) = lu(k,1988) - lu(k,307) * lu(k,1979) + lu(k,2003) = lu(k,2003) - lu(k,308) * lu(k,1979) + lu(k,2009) = lu(k,2009) - lu(k,309) * lu(k,1979) + lu(k,2011) = lu(k,2011) - lu(k,310) * lu(k,1979) + lu(k,2015) = - lu(k,311) * lu(k,1979) + lu(k,312) = 1._r8 / lu(k,312) + lu(k,313) = lu(k,313) * lu(k,312) + lu(k,314) = lu(k,314) * lu(k,312) + lu(k,315) = lu(k,315) * lu(k,312) + lu(k,316) = lu(k,316) * lu(k,312) + lu(k,1313) = lu(k,1313) - lu(k,313) * lu(k,1306) + lu(k,1314) = - lu(k,314) * lu(k,1306) + lu(k,1318) = - lu(k,315) * lu(k,1306) + lu(k,1323) = lu(k,1323) - lu(k,316) * lu(k,1306) + lu(k,1682) = lu(k,1682) - lu(k,313) * lu(k,1586) + lu(k,1684) = lu(k,1684) - lu(k,314) * lu(k,1586) + lu(k,1693) = lu(k,1693) - lu(k,315) * lu(k,1586) + lu(k,1700) = lu(k,1700) - lu(k,316) * lu(k,1586) + lu(k,2099) = lu(k,2099) - lu(k,313) * lu(k,2032) + lu(k,2101) = lu(k,2101) - lu(k,314) * lu(k,2032) + lu(k,2110) = lu(k,2110) - lu(k,315) * lu(k,2032) + lu(k,2117) = lu(k,2117) - lu(k,316) * lu(k,2032) + lu(k,317) = 1._r8 / lu(k,317) + lu(k,318) = lu(k,318) * lu(k,317) + lu(k,319) = lu(k,319) * lu(k,317) + lu(k,320) = lu(k,320) * lu(k,317) + lu(k,321) = lu(k,321) * lu(k,317) + lu(k,679) = lu(k,679) - lu(k,318) * lu(k,678) + lu(k,680) = lu(k,680) - lu(k,319) * lu(k,678) + lu(k,681) = lu(k,681) - lu(k,320) * lu(k,678) + lu(k,682) = lu(k,682) - lu(k,321) * lu(k,678) + lu(k,1634) = lu(k,1634) - lu(k,318) * lu(k,1587) + lu(k,1668) = lu(k,1668) - lu(k,319) * lu(k,1587) + lu(k,1685) = lu(k,1685) - lu(k,320) * lu(k,1587) + lu(k,1693) = lu(k,1693) - lu(k,321) * lu(k,1587) + lu(k,2061) = lu(k,2061) - lu(k,318) * lu(k,2033) + lu(k,2087) = lu(k,2087) - lu(k,319) * lu(k,2033) + lu(k,2102) = lu(k,2102) - lu(k,320) * lu(k,2033) + lu(k,2110) = lu(k,2110) - lu(k,321) * lu(k,2033) + lu(k,322) = 1._r8 / lu(k,322) + lu(k,323) = lu(k,323) * lu(k,322) + lu(k,324) = lu(k,324) * lu(k,322) + lu(k,325) = lu(k,325) * lu(k,322) + lu(k,326) = lu(k,326) * lu(k,322) + lu(k,701) = - lu(k,323) * lu(k,692) + lu(k,702) = lu(k,702) - lu(k,324) * lu(k,692) + lu(k,703) = - lu(k,325) * lu(k,692) + lu(k,705) = lu(k,705) - lu(k,326) * lu(k,692) + lu(k,754) = - lu(k,323) * lu(k,745) + lu(k,755) = lu(k,755) - lu(k,324) * lu(k,745) + lu(k,756) = - lu(k,325) * lu(k,745) + lu(k,760) = lu(k,760) - lu(k,326) * lu(k,745) + lu(k,1900) = lu(k,1900) - lu(k,323) * lu(k,1857) + lu(k,1907) = lu(k,1907) - lu(k,324) * lu(k,1857) + lu(k,1913) = lu(k,1913) - lu(k,325) * lu(k,1857) + lu(k,1927) = lu(k,1927) - lu(k,326) * lu(k,1857) + 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,327) = 1._r8 / lu(k,327) + lu(k,328) = lu(k,328) * lu(k,327) + lu(k,329) = lu(k,329) * lu(k,327) + lu(k,330) = lu(k,330) * lu(k,327) + lu(k,331) = lu(k,331) * lu(k,327) + lu(k,1233) = lu(k,1233) - lu(k,328) * lu(k,1231) + lu(k,1234) = lu(k,1234) - lu(k,329) * lu(k,1231) + lu(k,1238) = lu(k,1238) - lu(k,330) * lu(k,1231) + lu(k,1244) = lu(k,1244) - lu(k,331) * lu(k,1231) + lu(k,1711) = lu(k,1711) - lu(k,328) * lu(k,1709) + lu(k,1713) = lu(k,1713) - lu(k,329) * lu(k,1709) + lu(k,1720) = lu(k,1720) - lu(k,330) * lu(k,1709) + lu(k,1729) = lu(k,1729) - lu(k,331) * lu(k,1709) + lu(k,2150) = lu(k,2150) - lu(k,328) * lu(k,2147) + lu(k,2151) = lu(k,2151) - lu(k,329) * lu(k,2147) + lu(k,2158) = lu(k,2158) - lu(k,330) * lu(k,2147) + lu(k,2167) = lu(k,2167) - lu(k,331) * lu(k,2147) + lu(k,332) = 1._r8 / lu(k,332) + lu(k,333) = lu(k,333) * lu(k,332) + lu(k,334) = lu(k,334) * lu(k,332) + lu(k,335) = lu(k,335) * lu(k,332) + lu(k,336) = lu(k,336) * lu(k,332) + lu(k,450) = lu(k,450) - lu(k,333) * lu(k,449) + lu(k,451) = lu(k,451) - lu(k,334) * lu(k,449) + lu(k,452) = - lu(k,335) * lu(k,449) + lu(k,455) = lu(k,455) - lu(k,336) * lu(k,449) + lu(k,1605) = lu(k,1605) - lu(k,333) * lu(k,1588) + lu(k,1662) = lu(k,1662) - lu(k,334) * lu(k,1588) + lu(k,1693) = lu(k,1693) - lu(k,335) * lu(k,1588) + lu(k,1700) = lu(k,1700) - lu(k,336) * lu(k,1588) + lu(k,2046) = lu(k,2046) - lu(k,333) * lu(k,2034) + lu(k,2084) = lu(k,2084) - lu(k,334) * lu(k,2034) + lu(k,2110) = lu(k,2110) - lu(k,335) * lu(k,2034) + lu(k,2117) = lu(k,2117) - lu(k,336) * lu(k,2034) + lu(k,338) = 1._r8 / lu(k,338) + lu(k,339) = lu(k,339) * lu(k,338) + lu(k,340) = lu(k,340) * lu(k,338) + lu(k,341) = lu(k,341) * lu(k,338) + lu(k,342) = lu(k,342) * lu(k,338) + lu(k,437) = lu(k,437) - lu(k,339) * lu(k,436) + lu(k,438) = lu(k,438) - lu(k,340) * lu(k,436) + lu(k,439) = lu(k,439) - lu(k,341) * lu(k,436) + lu(k,442) = lu(k,442) - lu(k,342) * lu(k,436) + lu(k,1604) = lu(k,1604) - lu(k,339) * lu(k,1589) + lu(k,1616) = lu(k,1616) - lu(k,340) * lu(k,1589) + lu(k,1693) = lu(k,1693) - lu(k,341) * lu(k,1589) + lu(k,1700) = lu(k,1700) - lu(k,342) * lu(k,1589) + lu(k,2044) = lu(k,2044) - lu(k,339) * lu(k,2035) + lu(k,2053) = lu(k,2053) - lu(k,340) * lu(k,2035) + lu(k,2110) = lu(k,2110) - lu(k,341) * lu(k,2035) + lu(k,2117) = lu(k,2117) - lu(k,342) * lu(k,2035) + lu(k,343) = 1._r8 / lu(k,343) + lu(k,344) = lu(k,344) * lu(k,343) + lu(k,345) = lu(k,345) * lu(k,343) + lu(k,346) = lu(k,346) * lu(k,343) + lu(k,347) = lu(k,347) * lu(k,343) + lu(k,825) = lu(k,825) - lu(k,344) * lu(k,823) + lu(k,826) = lu(k,826) - lu(k,345) * lu(k,823) + lu(k,828) = lu(k,828) - lu(k,346) * lu(k,823) + lu(k,832) = lu(k,832) - lu(k,347) * lu(k,823) + lu(k,1649) = lu(k,1649) - lu(k,344) * lu(k,1590) + lu(k,1668) = lu(k,1668) - lu(k,345) * lu(k,1590) + lu(k,1693) = lu(k,1693) - lu(k,346) * lu(k,1590) + lu(k,1700) = lu(k,1700) - lu(k,347) * lu(k,1590) + lu(k,2076) = lu(k,2076) - lu(k,344) * lu(k,2036) + lu(k,2087) = lu(k,2087) - lu(k,345) * lu(k,2036) + lu(k,2110) = lu(k,2110) - lu(k,346) * lu(k,2036) + lu(k,2117) = lu(k,2117) - lu(k,347) * lu(k,2036) + lu(k,348) = 1._r8 / lu(k,348) + lu(k,349) = lu(k,349) * lu(k,348) + lu(k,350) = lu(k,350) * lu(k,348) + lu(k,1287) = lu(k,1287) - lu(k,349) * lu(k,1275) + lu(k,1297) = lu(k,1297) - lu(k,350) * lu(k,1275) + lu(k,1379) = lu(k,1379) - lu(k,349) * lu(k,1369) + lu(k,1392) = lu(k,1392) - lu(k,350) * lu(k,1369) + lu(k,1675) = lu(k,1675) - lu(k,349) * lu(k,1591) + lu(k,1693) = lu(k,1693) - lu(k,350) * lu(k,1591) + lu(k,1759) = lu(k,1759) - lu(k,349) * lu(k,1736) + lu(k,1776) = lu(k,1776) - lu(k,350) * lu(k,1736) + lu(k,1813) = lu(k,1813) - lu(k,349) * lu(k,1790) + lu(k,1828) = lu(k,1828) - lu(k,350) * lu(k,1790) + lu(k,1904) = lu(k,1904) - lu(k,349) * lu(k,1858) + lu(k,1920) = lu(k,1920) - lu(k,350) * lu(k,1858) + lu(k,351) = 1._r8 / lu(k,351) + lu(k,352) = lu(k,352) * lu(k,351) + lu(k,353) = lu(k,353) * lu(k,351) + lu(k,354) = lu(k,354) * lu(k,351) + lu(k,355) = lu(k,355) * lu(k,351) + lu(k,356) = lu(k,356) * lu(k,351) + lu(k,357) = lu(k,357) * lu(k,351) + lu(k,358) = lu(k,358) * lu(k,351) + lu(k,1621) = lu(k,1621) - lu(k,352) * lu(k,1592) + lu(k,1658) = lu(k,1658) - lu(k,353) * lu(k,1592) + lu(k,1668) = lu(k,1668) - lu(k,354) * lu(k,1592) + lu(k,1691) = lu(k,1691) - lu(k,355) * lu(k,1592) + lu(k,1693) = lu(k,1693) - lu(k,356) * lu(k,1592) + lu(k,1695) = lu(k,1695) - lu(k,357) * lu(k,1592) + lu(k,1698) = lu(k,1698) - lu(k,358) * lu(k,1592) + lu(k,1738) = - lu(k,352) * lu(k,1737) + lu(k,1742) = lu(k,1742) - lu(k,353) * lu(k,1737) + lu(k,1752) = lu(k,1752) - lu(k,354) * lu(k,1737) + lu(k,1774) = lu(k,1774) - lu(k,355) * lu(k,1737) + lu(k,1776) = lu(k,1776) - lu(k,356) * lu(k,1737) + lu(k,1778) = lu(k,1778) - lu(k,357) * lu(k,1737) + lu(k,1781) = lu(k,1781) - lu(k,358) * lu(k,1737) + lu(k,359) = 1._r8 / lu(k,359) + lu(k,360) = lu(k,360) * lu(k,359) + lu(k,361) = lu(k,361) * lu(k,359) + lu(k,362) = lu(k,362) * lu(k,359) + lu(k,363) = lu(k,363) * lu(k,359) + lu(k,364) = lu(k,364) * lu(k,359) + lu(k,365) = lu(k,365) * lu(k,359) + lu(k,366) = lu(k,366) * lu(k,359) + lu(k,1615) = lu(k,1615) - lu(k,360) * lu(k,1593) + lu(k,1651) = lu(k,1651) - lu(k,361) * lu(k,1593) + lu(k,1671) = lu(k,1671) - lu(k,362) * lu(k,1593) + lu(k,1679) = lu(k,1679) - lu(k,363) * lu(k,1593) + lu(k,1689) = lu(k,1689) - lu(k,364) * lu(k,1593) + lu(k,1693) = lu(k,1693) - lu(k,365) * lu(k,1593) + lu(k,1703) = lu(k,1703) - lu(k,366) * lu(k,1593) + lu(k,2171) = - lu(k,360) * lu(k,2170) + lu(k,2177) = - lu(k,361) * lu(k,2170) + lu(k,2179) = lu(k,2179) - lu(k,362) * lu(k,2170) + lu(k,2180) = lu(k,2180) - lu(k,363) * lu(k,2170) + lu(k,2184) = lu(k,2184) - lu(k,364) * lu(k,2170) + lu(k,2188) = lu(k,2188) - lu(k,365) * lu(k,2170) + lu(k,2198) = lu(k,2198) - lu(k,366) * lu(k,2170) + lu(k,367) = 1._r8 / lu(k,367) + lu(k,368) = lu(k,368) * lu(k,367) + lu(k,369) = lu(k,369) * lu(k,367) + lu(k,370) = lu(k,370) * lu(k,367) + lu(k,371) = lu(k,371) * lu(k,367) + lu(k,372) = lu(k,372) * lu(k,367) + lu(k,373) = lu(k,373) * lu(k,367) + lu(k,374) = lu(k,374) * lu(k,367) + lu(k,1671) = lu(k,1671) - lu(k,368) * lu(k,1594) + lu(k,1693) = lu(k,1693) - lu(k,369) * lu(k,1594) + lu(k,1696) = lu(k,1696) - lu(k,370) * lu(k,1594) + lu(k,1699) = lu(k,1699) - lu(k,371) * lu(k,1594) + lu(k,1700) = lu(k,1700) - lu(k,372) * lu(k,1594) + lu(k,1701) = lu(k,1701) - lu(k,373) * lu(k,1594) + lu(k,1705) = lu(k,1705) - lu(k,374) * lu(k,1594) + lu(k,1994) = lu(k,1994) - lu(k,368) * lu(k,1980) + lu(k,2003) = lu(k,2003) - lu(k,369) * lu(k,1980) + lu(k,2006) = lu(k,2006) - lu(k,370) * lu(k,1980) + lu(k,2009) = lu(k,2009) - lu(k,371) * lu(k,1980) + lu(k,2010) = lu(k,2010) - lu(k,372) * lu(k,1980) + lu(k,2011) = lu(k,2011) - lu(k,373) * lu(k,1980) + lu(k,2015) = lu(k,2015) - lu(k,374) * lu(k,1980) + 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,375) = 1._r8 / lu(k,375) + lu(k,376) = lu(k,376) * lu(k,375) + lu(k,377) = lu(k,377) * lu(k,375) + lu(k,378) = lu(k,378) * lu(k,375) + lu(k,379) = lu(k,379) * lu(k,375) + lu(k,380) = lu(k,380) * lu(k,375) + lu(k,1190) = - lu(k,376) * lu(k,1186) + lu(k,1192) = - lu(k,377) * lu(k,1186) + lu(k,1200) = - lu(k,378) * lu(k,1186) + lu(k,1202) = - lu(k,379) * lu(k,1186) + lu(k,1207) = lu(k,1207) - lu(k,380) * lu(k,1186) + lu(k,1652) = lu(k,1652) - lu(k,376) * lu(k,1595) + lu(k,1669) = lu(k,1669) - lu(k,377) * lu(k,1595) + lu(k,1690) = lu(k,1690) - lu(k,378) * lu(k,1595) + lu(k,1693) = lu(k,1693) - lu(k,379) * lu(k,1595) + lu(k,1700) = lu(k,1700) - lu(k,380) * lu(k,1595) + lu(k,1799) = - lu(k,376) * lu(k,1791) + lu(k,1808) = lu(k,1808) - lu(k,377) * lu(k,1791) + lu(k,1825) = - lu(k,378) * lu(k,1791) + lu(k,1828) = lu(k,1828) - lu(k,379) * lu(k,1791) + lu(k,1835) = lu(k,1835) - lu(k,380) * lu(k,1791) + lu(k,381) = 1._r8 / lu(k,381) + lu(k,382) = lu(k,382) * lu(k,381) + lu(k,383) = lu(k,383) * lu(k,381) + lu(k,384) = lu(k,384) * lu(k,381) + lu(k,385) = lu(k,385) * lu(k,381) + lu(k,386) = lu(k,386) * lu(k,381) + lu(k,952) = - lu(k,382) * lu(k,944) + lu(k,956) = lu(k,956) - lu(k,383) * lu(k,944) + lu(k,958) = - lu(k,384) * lu(k,944) + lu(k,959) = lu(k,959) - lu(k,385) * lu(k,944) + lu(k,967) = lu(k,967) - lu(k,386) * lu(k,944) + lu(k,1000) = - lu(k,382) * lu(k,993) + lu(k,1006) = lu(k,1006) - lu(k,383) * lu(k,993) + lu(k,1008) = - lu(k,384) * lu(k,993) + lu(k,1009) = lu(k,1009) - lu(k,385) * lu(k,993) + lu(k,1017) = lu(k,1017) - lu(k,386) * lu(k,993) + lu(k,2222) = - lu(k,382) * lu(k,2207) + lu(k,2230) = lu(k,2230) - lu(k,383) * lu(k,2207) + lu(k,2235) = lu(k,2235) - lu(k,384) * lu(k,2207) + lu(k,2242) = lu(k,2242) - lu(k,385) * lu(k,2207) + lu(k,2256) = lu(k,2256) - lu(k,386) * lu(k,2207) + lu(k,387) = 1._r8 / lu(k,387) + lu(k,388) = lu(k,388) * lu(k,387) + lu(k,389) = lu(k,389) * lu(k,387) + lu(k,390) = lu(k,390) * lu(k,387) + lu(k,391) = lu(k,391) * lu(k,387) + lu(k,392) = lu(k,392) * lu(k,387) + lu(k,1523) = lu(k,1523) - lu(k,388) * lu(k,1517) + lu(k,1528) = lu(k,1528) - lu(k,389) * lu(k,1517) + lu(k,1529) = lu(k,1529) - lu(k,390) * lu(k,1517) + lu(k,1535) = lu(k,1535) - lu(k,391) * lu(k,1517) + lu(k,1537) = lu(k,1537) - lu(k,392) * lu(k,1517) + lu(k,1687) = lu(k,1687) - lu(k,388) * lu(k,1596) + lu(k,1692) = lu(k,1692) - lu(k,389) * lu(k,1596) + lu(k,1693) = lu(k,1693) - lu(k,390) * lu(k,1596) + lu(k,1699) = lu(k,1699) - lu(k,391) * lu(k,1596) + lu(k,1701) = lu(k,1701) - lu(k,392) * lu(k,1596) + lu(k,1997) = lu(k,1997) - lu(k,388) * lu(k,1981) + lu(k,2002) = - lu(k,389) * lu(k,1981) + lu(k,2003) = lu(k,2003) - lu(k,390) * lu(k,1981) + lu(k,2009) = lu(k,2009) - lu(k,391) * lu(k,1981) + lu(k,2011) = lu(k,2011) - lu(k,392) * lu(k,1981) + lu(k,393) = 1._r8 / lu(k,393) + lu(k,394) = lu(k,394) * lu(k,393) + lu(k,395) = lu(k,395) * lu(k,393) + lu(k,396) = lu(k,396) * lu(k,393) + lu(k,397) = lu(k,397) * lu(k,393) + lu(k,398) = lu(k,398) * lu(k,393) + lu(k,1046) = lu(k,1046) - lu(k,394) * lu(k,1043) + lu(k,1047) = lu(k,1047) - lu(k,395) * lu(k,1043) + lu(k,1051) = - lu(k,396) * lu(k,1043) + lu(k,1053) = - lu(k,397) * lu(k,1043) + lu(k,1057) = lu(k,1057) - lu(k,398) * lu(k,1043) + lu(k,1661) = lu(k,1661) - lu(k,394) * lu(k,1597) + lu(k,1665) = lu(k,1665) - lu(k,395) * lu(k,1597) + lu(k,1690) = lu(k,1690) - lu(k,396) * lu(k,1597) + lu(k,1693) = lu(k,1693) - lu(k,397) * lu(k,1597) + lu(k,1698) = lu(k,1698) - lu(k,398) * lu(k,1597) + lu(k,2083) = - lu(k,394) * lu(k,2037) + lu(k,2085) = lu(k,2085) - lu(k,395) * lu(k,2037) + lu(k,2107) = - lu(k,396) * lu(k,2037) + lu(k,2110) = lu(k,2110) - lu(k,397) * lu(k,2037) + lu(k,2115) = lu(k,2115) - lu(k,398) * lu(k,2037) + lu(k,399) = 1._r8 / lu(k,399) + lu(k,400) = lu(k,400) * lu(k,399) + lu(k,401) = lu(k,401) * lu(k,399) + lu(k,402) = lu(k,402) * lu(k,399) + lu(k,403) = lu(k,403) * lu(k,399) + lu(k,404) = lu(k,404) * lu(k,399) + lu(k,1131) = lu(k,1131) - lu(k,400) * lu(k,1129) + lu(k,1134) = lu(k,1134) - lu(k,401) * lu(k,1129) + lu(k,1135) = lu(k,1135) - lu(k,402) * lu(k,1129) + lu(k,1136) = lu(k,1136) - lu(k,403) * lu(k,1129) + lu(k,1141) = - lu(k,404) * lu(k,1129) + lu(k,1672) = lu(k,1672) - lu(k,400) * lu(k,1598) + lu(k,1685) = lu(k,1685) - lu(k,401) * lu(k,1598) + lu(k,1691) = lu(k,1691) - lu(k,402) * lu(k,1598) + lu(k,1693) = lu(k,1693) - lu(k,403) * lu(k,1598) + lu(k,1705) = lu(k,1705) - lu(k,404) * lu(k,1598) + lu(k,2091) = lu(k,2091) - lu(k,400) * lu(k,2038) + lu(k,2102) = lu(k,2102) - lu(k,401) * lu(k,2038) + lu(k,2108) = lu(k,2108) - lu(k,402) * lu(k,2038) + lu(k,2110) = lu(k,2110) - lu(k,403) * lu(k,2038) + lu(k,2122) = lu(k,2122) - lu(k,404) * lu(k,2038) + lu(k,405) = 1._r8 / lu(k,405) + lu(k,406) = lu(k,406) * lu(k,405) + lu(k,407) = lu(k,407) * lu(k,405) + lu(k,408) = lu(k,408) * lu(k,405) + lu(k,409) = lu(k,409) * lu(k,405) + lu(k,410) = lu(k,410) * lu(k,405) + lu(k,1188) = - lu(k,406) * lu(k,1187) + lu(k,1190) = lu(k,1190) - lu(k,407) * lu(k,1187) + lu(k,1202) = lu(k,1202) - lu(k,408) * lu(k,1187) + lu(k,1206) = lu(k,1206) - lu(k,409) * lu(k,1187) + lu(k,1207) = lu(k,1207) - lu(k,410) * lu(k,1187) + lu(k,1640) = lu(k,1640) - lu(k,406) * lu(k,1599) + lu(k,1652) = lu(k,1652) - lu(k,407) * lu(k,1599) + lu(k,1693) = lu(k,1693) - lu(k,408) * lu(k,1599) + lu(k,1698) = lu(k,1698) - lu(k,409) * lu(k,1599) + lu(k,1700) = lu(k,1700) - lu(k,410) * lu(k,1599) + lu(k,2067) = lu(k,2067) - lu(k,406) * lu(k,2039) + lu(k,2077) = - lu(k,407) * lu(k,2039) + lu(k,2110) = lu(k,2110) - lu(k,408) * lu(k,2039) + lu(k,2115) = lu(k,2115) - lu(k,409) * lu(k,2039) + lu(k,2117) = lu(k,2117) - lu(k,410) * lu(k,2039) + 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,411) = 1._r8 / lu(k,411) + lu(k,412) = lu(k,412) * lu(k,411) + lu(k,413) = lu(k,413) * lu(k,411) + lu(k,414) = lu(k,414) * lu(k,411) + lu(k,415) = lu(k,415) * lu(k,411) + lu(k,416) = lu(k,416) * lu(k,411) + lu(k,789) = lu(k,789) - lu(k,412) * lu(k,788) + lu(k,790) = lu(k,790) - lu(k,413) * lu(k,788) + lu(k,793) = - lu(k,414) * lu(k,788) + lu(k,797) = lu(k,797) - lu(k,415) * lu(k,788) + lu(k,798) = - lu(k,416) * lu(k,788) + lu(k,1644) = lu(k,1644) - lu(k,412) * lu(k,1600) + lu(k,1658) = lu(k,1658) - lu(k,413) * lu(k,1600) + lu(k,1693) = lu(k,1693) - lu(k,414) * lu(k,1600) + lu(k,1700) = lu(k,1700) - lu(k,415) * lu(k,1600) + lu(k,1705) = lu(k,1705) - lu(k,416) * lu(k,1600) + lu(k,2072) = lu(k,2072) - lu(k,412) * lu(k,2040) + lu(k,2081) = - lu(k,413) * lu(k,2040) + lu(k,2110) = lu(k,2110) - lu(k,414) * lu(k,2040) + lu(k,2117) = lu(k,2117) - lu(k,415) * lu(k,2040) + lu(k,2122) = lu(k,2122) - lu(k,416) * lu(k,2040) + lu(k,417) = 1._r8 / lu(k,417) + lu(k,418) = lu(k,418) * lu(k,417) + lu(k,419) = lu(k,419) * lu(k,417) + lu(k,420) = lu(k,420) * lu(k,417) + lu(k,421) = lu(k,421) * lu(k,417) + lu(k,422) = lu(k,422) * lu(k,417) + lu(k,484) = lu(k,484) - lu(k,418) * lu(k,483) + lu(k,485) = lu(k,485) - lu(k,419) * lu(k,483) + lu(k,487) = lu(k,487) - lu(k,420) * lu(k,483) + lu(k,488) = - lu(k,421) * lu(k,483) + lu(k,491) = lu(k,491) - lu(k,422) * lu(k,483) + lu(k,1607) = lu(k,1607) - lu(k,418) * lu(k,1601) + lu(k,1611) = lu(k,1611) - lu(k,419) * lu(k,1601) + lu(k,1662) = lu(k,1662) - lu(k,420) * lu(k,1601) + lu(k,1693) = lu(k,1693) - lu(k,421) * lu(k,1601) + lu(k,1700) = lu(k,1700) - lu(k,422) * lu(k,1601) + lu(k,2048) = - lu(k,418) * lu(k,2041) + lu(k,2051) = lu(k,2051) - lu(k,419) * lu(k,2041) + lu(k,2084) = lu(k,2084) - lu(k,420) * lu(k,2041) + lu(k,2110) = lu(k,2110) - lu(k,421) * lu(k,2041) + lu(k,2117) = lu(k,2117) - lu(k,422) * lu(k,2041) + lu(k,423) = 1._r8 / lu(k,423) + lu(k,424) = lu(k,424) * lu(k,423) + lu(k,425) = lu(k,425) * lu(k,423) + lu(k,426) = lu(k,426) * lu(k,423) + lu(k,427) = lu(k,427) * lu(k,423) + lu(k,428) = lu(k,428) * lu(k,423) + lu(k,1693) = lu(k,1693) - lu(k,424) * lu(k,1602) + lu(k,1695) = lu(k,1695) - lu(k,425) * lu(k,1602) + lu(k,1698) = lu(k,1698) - lu(k,426) * lu(k,1602) + lu(k,1700) = lu(k,1700) - lu(k,427) * lu(k,1602) + lu(k,1705) = lu(k,1705) - lu(k,428) * lu(k,1602) + lu(k,1964) = lu(k,1964) - lu(k,424) * lu(k,1936) + lu(k,1966) = lu(k,1966) - lu(k,425) * lu(k,1936) + lu(k,1969) = lu(k,1969) - lu(k,426) * lu(k,1936) + lu(k,1971) = lu(k,1971) - lu(k,427) * lu(k,1936) + lu(k,1976) = - lu(k,428) * lu(k,1936) + lu(k,2110) = lu(k,2110) - lu(k,424) * lu(k,2042) + lu(k,2112) = lu(k,2112) - lu(k,425) * lu(k,2042) + lu(k,2115) = lu(k,2115) - lu(k,426) * lu(k,2042) + lu(k,2117) = lu(k,2117) - lu(k,427) * lu(k,2042) + lu(k,2122) = lu(k,2122) - lu(k,428) * lu(k,2042) + 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,501) = lu(k,501) - lu(k,430) * lu(k,500) + lu(k,502) = lu(k,502) - lu(k,431) * lu(k,500) + lu(k,503) = lu(k,503) - lu(k,432) * lu(k,500) + lu(k,504) = - lu(k,433) * lu(k,500) + lu(k,507) = lu(k,507) - lu(k,434) * lu(k,500) + lu(k,1613) = lu(k,1613) - lu(k,430) * lu(k,1603) + lu(k,1662) = lu(k,1662) - lu(k,431) * lu(k,1603) + lu(k,1678) = lu(k,1678) - lu(k,432) * lu(k,1603) + lu(k,1693) = lu(k,1693) - lu(k,433) * lu(k,1603) + lu(k,1700) = lu(k,1700) - lu(k,434) * lu(k,1603) + lu(k,2052) = lu(k,2052) - lu(k,430) * lu(k,2043) + lu(k,2084) = lu(k,2084) - lu(k,431) * lu(k,2043) + lu(k,2096) = lu(k,2096) - lu(k,432) * lu(k,2043) + lu(k,2110) = lu(k,2110) - lu(k,433) * lu(k,2043) + lu(k,2117) = lu(k,2117) - lu(k,434) * lu(k,2043) + lu(k,437) = 1._r8 / lu(k,437) + lu(k,438) = lu(k,438) * lu(k,437) + lu(k,439) = lu(k,439) * lu(k,437) + lu(k,440) = lu(k,440) * lu(k,437) + lu(k,441) = lu(k,441) * lu(k,437) + lu(k,442) = lu(k,442) * lu(k,437) + lu(k,1616) = lu(k,1616) - lu(k,438) * lu(k,1604) + lu(k,1693) = lu(k,1693) - lu(k,439) * lu(k,1604) + lu(k,1697) = lu(k,1697) - lu(k,440) * lu(k,1604) + lu(k,1698) = lu(k,1698) - lu(k,441) * lu(k,1604) + lu(k,1700) = lu(k,1700) - lu(k,442) * lu(k,1604) + lu(k,1868) = lu(k,1868) - lu(k,438) * lu(k,1859) + lu(k,1920) = lu(k,1920) - lu(k,439) * lu(k,1859) + lu(k,1924) = lu(k,1924) - lu(k,440) * lu(k,1859) + lu(k,1925) = lu(k,1925) - lu(k,441) * lu(k,1859) + lu(k,1927) = lu(k,1927) - lu(k,442) * lu(k,1859) + lu(k,2053) = lu(k,2053) - lu(k,438) * lu(k,2044) + lu(k,2110) = lu(k,2110) - lu(k,439) * lu(k,2044) + lu(k,2114) = lu(k,2114) - lu(k,440) * lu(k,2044) + lu(k,2115) = lu(k,2115) - lu(k,441) * lu(k,2044) + lu(k,2117) = lu(k,2117) - lu(k,442) * lu(k,2044) + lu(k,443) = 1._r8 / lu(k,443) + lu(k,444) = lu(k,444) * lu(k,443) + lu(k,445) = lu(k,445) * lu(k,443) + lu(k,446) = lu(k,446) * lu(k,443) + lu(k,447) = lu(k,447) * lu(k,443) + lu(k,448) = lu(k,448) * lu(k,443) + lu(k,1480) = - lu(k,444) * lu(k,1478) + lu(k,1487) = lu(k,1487) - lu(k,445) * lu(k,1478) + lu(k,1492) = - lu(k,446) * lu(k,1478) + lu(k,1493) = - lu(k,447) * lu(k,1478) + lu(k,1495) = lu(k,1495) - lu(k,448) * lu(k,1478) + lu(k,1891) = lu(k,1891) - lu(k,444) * lu(k,1860) + lu(k,1918) = lu(k,1918) - lu(k,445) * lu(k,1860) + lu(k,1924) = lu(k,1924) - lu(k,446) * lu(k,1860) + lu(k,1925) = lu(k,1925) - lu(k,447) * lu(k,1860) + lu(k,1927) = lu(k,1927) - lu(k,448) * lu(k,1860) + lu(k,2082) = lu(k,2082) - lu(k,444) * lu(k,2045) + lu(k,2108) = lu(k,2108) - lu(k,445) * lu(k,2045) + lu(k,2114) = lu(k,2114) - lu(k,446) * lu(k,2045) + lu(k,2115) = lu(k,2115) - lu(k,447) * lu(k,2045) + lu(k,2117) = lu(k,2117) - lu(k,448) * lu(k,2045) + lu(k,450) = 1._r8 / lu(k,450) + lu(k,451) = lu(k,451) * lu(k,450) + lu(k,452) = lu(k,452) * lu(k,450) + lu(k,453) = lu(k,453) * lu(k,450) + lu(k,454) = lu(k,454) * lu(k,450) + lu(k,455) = lu(k,455) * lu(k,450) + lu(k,1662) = lu(k,1662) - lu(k,451) * lu(k,1605) + lu(k,1693) = lu(k,1693) - lu(k,452) * lu(k,1605) + lu(k,1697) = lu(k,1697) - lu(k,453) * lu(k,1605) + lu(k,1698) = lu(k,1698) - lu(k,454) * lu(k,1605) + lu(k,1700) = lu(k,1700) - lu(k,455) * lu(k,1605) + lu(k,1893) = lu(k,1893) - lu(k,451) * lu(k,1861) + lu(k,1920) = lu(k,1920) - lu(k,452) * lu(k,1861) + lu(k,1924) = lu(k,1924) - lu(k,453) * lu(k,1861) + lu(k,1925) = lu(k,1925) - lu(k,454) * lu(k,1861) + lu(k,1927) = lu(k,1927) - lu(k,455) * lu(k,1861) + lu(k,2084) = lu(k,2084) - lu(k,451) * lu(k,2046) + lu(k,2110) = lu(k,2110) - lu(k,452) * lu(k,2046) + lu(k,2114) = lu(k,2114) - lu(k,453) * lu(k,2046) + lu(k,2115) = lu(k,2115) - lu(k,454) * lu(k,2046) + lu(k,2117) = lu(k,2117) - lu(k,455) * lu(k,2046) + 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,456) = 1._r8 / lu(k,456) + lu(k,457) = lu(k,457) * lu(k,456) + lu(k,458) = lu(k,458) * lu(k,456) + lu(k,459) = lu(k,459) * lu(k,456) + lu(k,460) = lu(k,460) * lu(k,456) + lu(k,461) = lu(k,461) * lu(k,456) + lu(k,1689) = lu(k,1689) - lu(k,457) * lu(k,1606) + lu(k,1691) = lu(k,1691) - lu(k,458) * lu(k,1606) + lu(k,1693) = lu(k,1693) - lu(k,459) * lu(k,1606) + lu(k,1696) = lu(k,1696) - lu(k,460) * lu(k,1606) + lu(k,1705) = lu(k,1705) - lu(k,461) * lu(k,1606) + lu(k,1824) = - lu(k,457) * lu(k,1792) + lu(k,1826) = lu(k,1826) - lu(k,458) * lu(k,1792) + lu(k,1828) = lu(k,1828) - lu(k,459) * lu(k,1792) + lu(k,1831) = lu(k,1831) - lu(k,460) * lu(k,1792) + lu(k,1840) = - lu(k,461) * lu(k,1792) + lu(k,2106) = lu(k,2106) - lu(k,457) * lu(k,2047) + lu(k,2108) = lu(k,2108) - lu(k,458) * lu(k,2047) + lu(k,2110) = lu(k,2110) - lu(k,459) * lu(k,2047) + lu(k,2113) = lu(k,2113) - lu(k,460) * lu(k,2047) + lu(k,2122) = lu(k,2122) - lu(k,461) * lu(k,2047) + lu(k,462) = 1._r8 / lu(k,462) + lu(k,463) = lu(k,463) * lu(k,462) + lu(k,464) = lu(k,464) * lu(k,462) + lu(k,486) = - lu(k,463) * lu(k,484) + lu(k,491) = lu(k,491) - lu(k,464) * lu(k,484) + lu(k,658) = - lu(k,463) * lu(k,655) + lu(k,666) = lu(k,666) - lu(k,464) * lu(k,655) + lu(k,696) = - lu(k,463) * lu(k,693) + lu(k,705) = lu(k,705) - lu(k,464) * lu(k,693) + lu(k,725) = - lu(k,463) * lu(k,722) + lu(k,735) = lu(k,735) - lu(k,464) * lu(k,722) + lu(k,749) = - lu(k,463) * lu(k,746) + lu(k,760) = lu(k,760) - lu(k,464) * lu(k,746) + lu(k,1638) = - lu(k,463) * lu(k,1607) + lu(k,1700) = lu(k,1700) - lu(k,464) * lu(k,1607) + lu(k,1878) = lu(k,1878) - lu(k,463) * lu(k,1862) + lu(k,1927) = lu(k,1927) - lu(k,464) * lu(k,1862) + lu(k,2065) = lu(k,2065) - lu(k,463) * lu(k,2048) + lu(k,2117) = lu(k,2117) - lu(k,464) * lu(k,2048) + lu(k,465) = 1._r8 / lu(k,465) + lu(k,466) = lu(k,466) * lu(k,465) + lu(k,467) = lu(k,467) * lu(k,465) + lu(k,468) = lu(k,468) * lu(k,465) + lu(k,627) = lu(k,627) - lu(k,466) * lu(k,626) + lu(k,630) = lu(k,630) - lu(k,467) * lu(k,626) + lu(k,632) = - lu(k,468) * lu(k,626) + lu(k,1629) = lu(k,1629) - lu(k,466) * lu(k,1608) + lu(k,1698) = lu(k,1698) - lu(k,467) * lu(k,1608) + lu(k,1704) = lu(k,1704) - lu(k,468) * lu(k,1608) + lu(k,1874) = lu(k,1874) - lu(k,466) * lu(k,1863) + lu(k,1925) = lu(k,1925) - lu(k,467) * lu(k,1863) + lu(k,1931) = lu(k,1931) - lu(k,468) * lu(k,1863) + lu(k,1943) = - lu(k,466) * lu(k,1937) + lu(k,1969) = lu(k,1969) - lu(k,467) * lu(k,1937) + lu(k,1975) = lu(k,1975) - lu(k,468) * lu(k,1937) + lu(k,2057) = lu(k,2057) - lu(k,466) * lu(k,2049) + lu(k,2115) = lu(k,2115) - lu(k,467) * lu(k,2049) + lu(k,2121) = lu(k,2121) - lu(k,468) * lu(k,2049) + lu(k,2211) = lu(k,2211) - lu(k,466) * lu(k,2208) + lu(k,2254) = lu(k,2254) - lu(k,467) * lu(k,2208) + lu(k,2260) = lu(k,2260) - lu(k,468) * lu(k,2208) + lu(k,469) = 1._r8 / lu(k,469) + lu(k,470) = lu(k,470) * lu(k,469) + lu(k,471) = lu(k,471) * lu(k,469) + lu(k,472) = lu(k,472) * lu(k,469) + lu(k,473) = lu(k,473) * lu(k,469) + lu(k,474) = lu(k,474) * lu(k,469) + lu(k,475) = lu(k,475) * lu(k,469) + lu(k,1523) = lu(k,1523) - lu(k,470) * lu(k,1518) + lu(k,1528) = lu(k,1528) - lu(k,471) * lu(k,1518) + lu(k,1529) = lu(k,1529) - lu(k,472) * lu(k,1518) + lu(k,1535) = lu(k,1535) - lu(k,473) * lu(k,1518) + lu(k,1537) = lu(k,1537) - lu(k,474) * lu(k,1518) + lu(k,1541) = lu(k,1541) - lu(k,475) * lu(k,1518) + lu(k,1687) = lu(k,1687) - lu(k,470) * lu(k,1609) + lu(k,1692) = lu(k,1692) - lu(k,471) * lu(k,1609) + lu(k,1693) = lu(k,1693) - lu(k,472) * lu(k,1609) + lu(k,1699) = lu(k,1699) - lu(k,473) * lu(k,1609) + lu(k,1701) = lu(k,1701) - lu(k,474) * lu(k,1609) + lu(k,1705) = lu(k,1705) - lu(k,475) * lu(k,1609) + lu(k,1997) = lu(k,1997) - lu(k,470) * lu(k,1982) + lu(k,2002) = lu(k,2002) - lu(k,471) * lu(k,1982) + lu(k,2003) = lu(k,2003) - lu(k,472) * lu(k,1982) + lu(k,2009) = lu(k,2009) - lu(k,473) * lu(k,1982) + lu(k,2011) = lu(k,2011) - lu(k,474) * lu(k,1982) + lu(k,2015) = lu(k,2015) - lu(k,475) * lu(k,1982) + lu(k,476) = 1._r8 / lu(k,476) + lu(k,477) = lu(k,477) * lu(k,476) + lu(k,478) = lu(k,478) * lu(k,476) + lu(k,479) = lu(k,479) * lu(k,476) + lu(k,480) = lu(k,480) * lu(k,476) + lu(k,481) = lu(k,481) * lu(k,476) + lu(k,482) = lu(k,482) * lu(k,476) + lu(k,914) = lu(k,914) - lu(k,477) * lu(k,911) + lu(k,915) = lu(k,915) - lu(k,478) * lu(k,911) + lu(k,916) = lu(k,916) - lu(k,479) * lu(k,911) + lu(k,918) = lu(k,918) - lu(k,480) * lu(k,911) + lu(k,919) = - lu(k,481) * lu(k,911) + lu(k,923) = lu(k,923) - lu(k,482) * lu(k,911) + lu(k,1657) = lu(k,1657) - lu(k,477) * lu(k,1610) + lu(k,1658) = lu(k,1658) - lu(k,478) * lu(k,1610) + lu(k,1661) = lu(k,1661) - lu(k,479) * lu(k,1610) + lu(k,1691) = lu(k,1691) - lu(k,480) * lu(k,1610) + lu(k,1693) = lu(k,1693) - lu(k,481) * lu(k,1610) + lu(k,1700) = lu(k,1700) - lu(k,482) * lu(k,1610) + lu(k,2080) = lu(k,2080) - lu(k,477) * lu(k,2050) + lu(k,2081) = lu(k,2081) - lu(k,478) * lu(k,2050) + lu(k,2083) = lu(k,2083) - lu(k,479) * lu(k,2050) + lu(k,2108) = lu(k,2108) - lu(k,480) * lu(k,2050) + lu(k,2110) = lu(k,2110) - lu(k,481) * lu(k,2050) + lu(k,2117) = lu(k,2117) - lu(k,482) * lu(k,2050) + lu(k,485) = 1._r8 / lu(k,485) + lu(k,486) = lu(k,486) * lu(k,485) + lu(k,487) = lu(k,487) * lu(k,485) + lu(k,488) = lu(k,488) * lu(k,485) + lu(k,489) = lu(k,489) * lu(k,485) + lu(k,490) = lu(k,490) * lu(k,485) + lu(k,491) = lu(k,491) * lu(k,485) + lu(k,1638) = lu(k,1638) - lu(k,486) * lu(k,1611) + lu(k,1662) = lu(k,1662) - lu(k,487) * lu(k,1611) + lu(k,1693) = lu(k,1693) - lu(k,488) * lu(k,1611) + lu(k,1697) = lu(k,1697) - lu(k,489) * lu(k,1611) + lu(k,1698) = lu(k,1698) - lu(k,490) * lu(k,1611) + lu(k,1700) = lu(k,1700) - lu(k,491) * lu(k,1611) + lu(k,1878) = lu(k,1878) - lu(k,486) * lu(k,1864) + lu(k,1893) = lu(k,1893) - lu(k,487) * lu(k,1864) + lu(k,1920) = lu(k,1920) - lu(k,488) * lu(k,1864) + lu(k,1924) = lu(k,1924) - lu(k,489) * lu(k,1864) + lu(k,1925) = lu(k,1925) - lu(k,490) * lu(k,1864) + lu(k,1927) = lu(k,1927) - lu(k,491) * lu(k,1864) + lu(k,2065) = lu(k,2065) - lu(k,486) * lu(k,2051) + lu(k,2084) = lu(k,2084) - lu(k,487) * lu(k,2051) + lu(k,2110) = lu(k,2110) - lu(k,488) * lu(k,2051) + lu(k,2114) = lu(k,2114) - lu(k,489) * lu(k,2051) + lu(k,2115) = lu(k,2115) - lu(k,490) * lu(k,2051) + lu(k,2117) = lu(k,2117) - lu(k,491) * lu(k,2051) + lu(k,493) = 1._r8 / lu(k,493) + lu(k,494) = lu(k,494) * lu(k,493) + lu(k,495) = lu(k,495) * lu(k,493) + lu(k,496) = lu(k,496) * lu(k,493) + lu(k,497) = lu(k,497) * lu(k,493) + lu(k,498) = lu(k,498) * lu(k,493) + lu(k,499) = lu(k,499) * lu(k,493) + lu(k,1689) = lu(k,1689) - lu(k,494) * lu(k,1612) + lu(k,1692) = lu(k,1692) - lu(k,495) * lu(k,1612) + lu(k,1693) = lu(k,1693) - lu(k,496) * lu(k,1612) + lu(k,1697) = lu(k,1697) - lu(k,497) * lu(k,1612) + lu(k,1698) = lu(k,1698) - lu(k,498) * lu(k,1612) + lu(k,1703) = lu(k,1703) - lu(k,499) * lu(k,1612) + lu(k,1916) = - lu(k,494) * lu(k,1865) + lu(k,1919) = - lu(k,495) * lu(k,1865) + lu(k,1920) = lu(k,1920) - lu(k,496) * lu(k,1865) + lu(k,1924) = lu(k,1924) - lu(k,497) * lu(k,1865) + lu(k,1925) = lu(k,1925) - lu(k,498) * lu(k,1865) + lu(k,1930) = lu(k,1930) - lu(k,499) * lu(k,1865) + lu(k,1960) = - lu(k,494) * lu(k,1938) + lu(k,1963) = lu(k,1963) - lu(k,495) * lu(k,1938) + lu(k,1964) = lu(k,1964) - lu(k,496) * lu(k,1938) + lu(k,1968) = lu(k,1968) - lu(k,497) * lu(k,1938) + lu(k,1969) = lu(k,1969) - lu(k,498) * lu(k,1938) + lu(k,1974) = lu(k,1974) - lu(k,499) * lu(k,1938) + 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,501) = 1._r8 / lu(k,501) + lu(k,502) = lu(k,502) * lu(k,501) + lu(k,503) = lu(k,503) * lu(k,501) + lu(k,504) = lu(k,504) * lu(k,501) + lu(k,505) = lu(k,505) * lu(k,501) + lu(k,506) = lu(k,506) * lu(k,501) + lu(k,507) = lu(k,507) * lu(k,501) + lu(k,1662) = lu(k,1662) - lu(k,502) * lu(k,1613) + lu(k,1678) = lu(k,1678) - lu(k,503) * lu(k,1613) + lu(k,1693) = lu(k,1693) - lu(k,504) * lu(k,1613) + lu(k,1697) = lu(k,1697) - lu(k,505) * lu(k,1613) + lu(k,1698) = lu(k,1698) - lu(k,506) * lu(k,1613) + lu(k,1700) = lu(k,1700) - lu(k,507) * lu(k,1613) + lu(k,1893) = lu(k,1893) - lu(k,502) * lu(k,1866) + lu(k,1907) = lu(k,1907) - lu(k,503) * lu(k,1866) + lu(k,1920) = lu(k,1920) - lu(k,504) * lu(k,1866) + lu(k,1924) = lu(k,1924) - lu(k,505) * lu(k,1866) + lu(k,1925) = lu(k,1925) - lu(k,506) * lu(k,1866) + lu(k,1927) = lu(k,1927) - lu(k,507) * lu(k,1866) + lu(k,2084) = lu(k,2084) - lu(k,502) * lu(k,2052) + lu(k,2096) = lu(k,2096) - lu(k,503) * lu(k,2052) + lu(k,2110) = lu(k,2110) - lu(k,504) * lu(k,2052) + lu(k,2114) = lu(k,2114) - lu(k,505) * lu(k,2052) + lu(k,2115) = lu(k,2115) - lu(k,506) * lu(k,2052) + lu(k,2117) = lu(k,2117) - lu(k,507) * lu(k,2052) + lu(k,508) = 1._r8 / lu(k,508) + lu(k,509) = lu(k,509) * lu(k,508) + lu(k,510) = lu(k,510) * lu(k,508) + lu(k,511) = lu(k,511) * lu(k,508) + lu(k,512) = lu(k,512) * lu(k,508) + lu(k,635) = - lu(k,509) * lu(k,633) + lu(k,636) = - lu(k,510) * lu(k,633) + lu(k,639) = - lu(k,511) * lu(k,633) + lu(k,641) = lu(k,641) - lu(k,512) * lu(k,633) + lu(k,669) = - lu(k,509) * lu(k,667) + lu(k,670) = - lu(k,510) * lu(k,667) + lu(k,674) = - lu(k,511) * lu(k,667) + lu(k,676) = lu(k,676) - lu(k,512) * lu(k,667) + lu(k,887) = - lu(k,509) * lu(k,884) + lu(k,888) = - lu(k,510) * lu(k,884) + lu(k,892) = - lu(k,511) * lu(k,884) + lu(k,894) = - lu(k,512) * lu(k,884) + lu(k,1634) = lu(k,1634) - lu(k,509) * lu(k,1614) + lu(k,1649) = lu(k,1649) - lu(k,510) * lu(k,1614) + lu(k,1685) = lu(k,1685) - lu(k,511) * lu(k,1614) + lu(k,1693) = lu(k,1693) - lu(k,512) * lu(k,1614) + lu(k,1876) = lu(k,1876) - lu(k,509) * lu(k,1867) + lu(k,1885) = lu(k,1885) - lu(k,510) * lu(k,1867) + lu(k,1913) = lu(k,1913) - lu(k,511) * lu(k,1867) + lu(k,1920) = lu(k,1920) - lu(k,512) * lu(k,1867) + lu(k,513) = 1._r8 / lu(k,513) + lu(k,514) = lu(k,514) * lu(k,513) + lu(k,515) = lu(k,515) * lu(k,513) + lu(k,516) = lu(k,516) * lu(k,513) + lu(k,517) = lu(k,517) * lu(k,513) + lu(k,518) = lu(k,518) * lu(k,513) + lu(k,1234) = lu(k,1234) - lu(k,514) * lu(k,1232) + lu(k,1236) = lu(k,1236) - lu(k,515) * lu(k,1232) + lu(k,1237) = lu(k,1237) - lu(k,516) * lu(k,1232) + lu(k,1244) = lu(k,1244) - lu(k,517) * lu(k,1232) + lu(k,1245) = lu(k,1245) - lu(k,518) * lu(k,1232) + lu(k,1679) = lu(k,1679) - lu(k,514) * lu(k,1615) + lu(k,1689) = lu(k,1689) - lu(k,515) * lu(k,1615) + lu(k,1693) = lu(k,1693) - lu(k,516) * lu(k,1615) + lu(k,1703) = lu(k,1703) - lu(k,517) * lu(k,1615) + lu(k,1704) = lu(k,1704) - lu(k,518) * lu(k,1615) + lu(k,2180) = lu(k,2180) - lu(k,514) * lu(k,2171) + lu(k,2184) = lu(k,2184) - lu(k,515) * lu(k,2171) + lu(k,2188) = lu(k,2188) - lu(k,516) * lu(k,2171) + lu(k,2198) = lu(k,2198) - lu(k,517) * lu(k,2171) + lu(k,2199) = lu(k,2199) - lu(k,518) * lu(k,2171) + lu(k,2236) = lu(k,2236) - lu(k,514) * lu(k,2209) + lu(k,2245) = lu(k,2245) - lu(k,515) * lu(k,2209) + lu(k,2249) = lu(k,2249) - lu(k,516) * lu(k,2209) + lu(k,2259) = lu(k,2259) - lu(k,517) * lu(k,2209) + lu(k,2260) = lu(k,2260) - lu(k,518) * lu(k,2209) + lu(k,520) = 1._r8 / lu(k,520) + lu(k,521) = lu(k,521) * lu(k,520) + lu(k,522) = lu(k,522) * lu(k,520) + lu(k,523) = lu(k,523) * lu(k,520) + lu(k,524) = lu(k,524) * lu(k,520) + lu(k,525) = lu(k,525) * lu(k,520) + lu(k,1629) = lu(k,1629) - lu(k,521) * lu(k,1616) + lu(k,1693) = lu(k,1693) - lu(k,522) * lu(k,1616) + lu(k,1697) = lu(k,1697) - lu(k,523) * lu(k,1616) + lu(k,1698) = lu(k,1698) - lu(k,524) * lu(k,1616) + lu(k,1700) = lu(k,1700) - lu(k,525) * lu(k,1616) + lu(k,1874) = lu(k,1874) - lu(k,521) * lu(k,1868) + lu(k,1920) = lu(k,1920) - lu(k,522) * lu(k,1868) + lu(k,1924) = lu(k,1924) - lu(k,523) * lu(k,1868) + lu(k,1925) = lu(k,1925) - lu(k,524) * lu(k,1868) + lu(k,1927) = lu(k,1927) - lu(k,525) * lu(k,1868) + lu(k,1943) = lu(k,1943) - lu(k,521) * lu(k,1939) + lu(k,1964) = lu(k,1964) - lu(k,522) * lu(k,1939) + lu(k,1968) = lu(k,1968) - lu(k,523) * lu(k,1939) + lu(k,1969) = lu(k,1969) - lu(k,524) * lu(k,1939) + lu(k,1971) = lu(k,1971) - lu(k,525) * lu(k,1939) + lu(k,2057) = lu(k,2057) - lu(k,521) * lu(k,2053) + lu(k,2110) = lu(k,2110) - lu(k,522) * lu(k,2053) + lu(k,2114) = lu(k,2114) - lu(k,523) * lu(k,2053) + lu(k,2115) = lu(k,2115) - lu(k,524) * lu(k,2053) + lu(k,2117) = lu(k,2117) - lu(k,525) * lu(k,2053) + lu(k,526) = 1._r8 / lu(k,526) + lu(k,527) = lu(k,527) * lu(k,526) + lu(k,528) = lu(k,528) * lu(k,526) + lu(k,529) = lu(k,529) * lu(k,526) + lu(k,530) = lu(k,530) * lu(k,526) + lu(k,531) = lu(k,531) * lu(k,526) + lu(k,532) = lu(k,532) * lu(k,526) + lu(k,533) = lu(k,533) * lu(k,526) + lu(k,1373) = lu(k,1373) - lu(k,527) * lu(k,1370) + lu(k,1388) = lu(k,1388) - lu(k,528) * lu(k,1370) + lu(k,1391) = lu(k,1391) - lu(k,529) * lu(k,1370) + lu(k,1392) = lu(k,1392) - lu(k,530) * lu(k,1370) + lu(k,1393) = - lu(k,531) * lu(k,1370) + lu(k,1394) = lu(k,1394) - lu(k,532) * lu(k,1370) + lu(k,1396) = lu(k,1396) - lu(k,533) * lu(k,1370) + lu(k,1646) = lu(k,1646) - lu(k,527) * lu(k,1617) + lu(k,1685) = lu(k,1685) - lu(k,528) * lu(k,1617) + lu(k,1691) = lu(k,1691) - lu(k,529) * lu(k,1617) + lu(k,1693) = lu(k,1693) - lu(k,530) * lu(k,1617) + lu(k,1695) = lu(k,1695) - lu(k,531) * lu(k,1617) + lu(k,1696) = lu(k,1696) - lu(k,532) * lu(k,1617) + lu(k,1698) = lu(k,1698) - lu(k,533) * lu(k,1617) + lu(k,1947) = - lu(k,527) * lu(k,1940) + lu(k,1957) = lu(k,1957) - lu(k,528) * lu(k,1940) + lu(k,1962) = - lu(k,529) * lu(k,1940) + lu(k,1964) = lu(k,1964) - lu(k,530) * lu(k,1940) + lu(k,1966) = lu(k,1966) - lu(k,531) * lu(k,1940) + lu(k,1967) = - lu(k,532) * lu(k,1940) + lu(k,1969) = lu(k,1969) - lu(k,533) * lu(k,1940) + lu(k,534) = 1._r8 / lu(k,534) + lu(k,535) = lu(k,535) * lu(k,534) + lu(k,536) = lu(k,536) * lu(k,534) + lu(k,537) = lu(k,537) * lu(k,534) + lu(k,538) = lu(k,538) * lu(k,534) + lu(k,539) = lu(k,539) * lu(k,534) + lu(k,540) = lu(k,540) * lu(k,534) + lu(k,541) = lu(k,541) * lu(k,534) + lu(k,1280) = - lu(k,535) * lu(k,1276) + lu(k,1283) = lu(k,1283) - lu(k,536) * lu(k,1276) + lu(k,1285) = lu(k,1285) - lu(k,537) * lu(k,1276) + lu(k,1286) = - lu(k,538) * lu(k,1276) + lu(k,1295) = - lu(k,539) * lu(k,1276) + lu(k,1297) = lu(k,1297) - lu(k,540) * lu(k,1276) + lu(k,1302) = lu(k,1302) - lu(k,541) * lu(k,1276) + lu(k,1652) = lu(k,1652) - lu(k,535) * lu(k,1618) + lu(k,1669) = lu(k,1669) - lu(k,536) * lu(k,1618) + lu(k,1673) = lu(k,1673) - lu(k,537) * lu(k,1618) + lu(k,1674) = lu(k,1674) - lu(k,538) * lu(k,1618) + lu(k,1690) = lu(k,1690) - lu(k,539) * lu(k,1618) + lu(k,1693) = lu(k,1693) - lu(k,540) * lu(k,1618) + lu(k,1700) = lu(k,1700) - lu(k,541) * lu(k,1618) + lu(k,1886) = - lu(k,535) * lu(k,1869) + lu(k,1898) = lu(k,1898) - lu(k,536) * lu(k,1869) + lu(k,1902) = lu(k,1902) - lu(k,537) * lu(k,1869) + lu(k,1903) = lu(k,1903) - lu(k,538) * lu(k,1869) + lu(k,1917) = lu(k,1917) - lu(k,539) * lu(k,1869) + lu(k,1920) = lu(k,1920) - lu(k,540) * lu(k,1869) + lu(k,1927) = lu(k,1927) - lu(k,541) * lu(k,1869) + 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,542) = 1._r8 / lu(k,542) + lu(k,543) = lu(k,543) * lu(k,542) + lu(k,544) = lu(k,544) * lu(k,542) + lu(k,545) = lu(k,545) * lu(k,542) + lu(k,546) = lu(k,546) * lu(k,542) + lu(k,547) = lu(k,547) * lu(k,542) + lu(k,548) = lu(k,548) * lu(k,542) + lu(k,549) = lu(k,549) * lu(k,542) + lu(k,770) = lu(k,770) - lu(k,543) * lu(k,769) + lu(k,771) = lu(k,771) - lu(k,544) * lu(k,769) + lu(k,772) = - lu(k,545) * lu(k,769) + lu(k,773) = lu(k,773) - lu(k,546) * lu(k,769) + lu(k,774) = - lu(k,547) * lu(k,769) + lu(k,777) = lu(k,777) - lu(k,548) * lu(k,769) + lu(k,778) = - lu(k,549) * lu(k,769) + lu(k,1643) = lu(k,1643) - lu(k,543) * lu(k,1619) + lu(k,1668) = lu(k,1668) - lu(k,544) * lu(k,1619) + lu(k,1673) = lu(k,1673) - lu(k,545) * lu(k,1619) + lu(k,1691) = lu(k,1691) - lu(k,546) * lu(k,1619) + lu(k,1693) = lu(k,1693) - lu(k,547) * lu(k,1619) + lu(k,1700) = lu(k,1700) - lu(k,548) * lu(k,1619) + lu(k,1705) = lu(k,1705) - lu(k,549) * lu(k,1619) + lu(k,2070) = lu(k,2070) - lu(k,543) * lu(k,2054) + lu(k,2087) = lu(k,2087) - lu(k,544) * lu(k,2054) + lu(k,2092) = - lu(k,545) * lu(k,2054) + lu(k,2108) = lu(k,2108) - lu(k,546) * lu(k,2054) + lu(k,2110) = lu(k,2110) - lu(k,547) * lu(k,2054) + lu(k,2117) = lu(k,2117) - lu(k,548) * lu(k,2054) + lu(k,2122) = lu(k,2122) - lu(k,549) * lu(k,2054) + 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,1637) = lu(k,1637) - lu(k,551) * lu(k,1620) + lu(k,1659) = lu(k,1659) - lu(k,552) * lu(k,1620) + lu(k,1671) = lu(k,1671) - lu(k,553) * lu(k,1620) + lu(k,1691) = lu(k,1691) - lu(k,554) * lu(k,1620) + lu(k,1693) = lu(k,1693) - lu(k,555) * lu(k,1620) + lu(k,1700) = lu(k,1700) - lu(k,556) * lu(k,1620) + lu(k,1704) = lu(k,1704) - lu(k,557) * lu(k,1620) + lu(k,1986) = - lu(k,551) * lu(k,1983) + lu(k,1990) = lu(k,1990) - lu(k,552) * lu(k,1983) + lu(k,1994) = lu(k,1994) - lu(k,553) * lu(k,1983) + lu(k,2001) = lu(k,2001) - lu(k,554) * lu(k,1983) + lu(k,2003) = lu(k,2003) - lu(k,555) * lu(k,1983) + lu(k,2010) = lu(k,2010) - lu(k,556) * lu(k,1983) + lu(k,2014) = lu(k,2014) - lu(k,557) * lu(k,1983) + lu(k,2213) = - lu(k,551) * lu(k,2210) + lu(k,2219) = lu(k,2219) - lu(k,552) * lu(k,2210) + lu(k,2230) = lu(k,2230) - lu(k,553) * lu(k,2210) + lu(k,2247) = lu(k,2247) - lu(k,554) * lu(k,2210) + lu(k,2249) = lu(k,2249) - lu(k,555) * lu(k,2210) + lu(k,2256) = lu(k,2256) - lu(k,556) * lu(k,2210) + lu(k,2260) = lu(k,2260) - lu(k,557) * lu(k,2210) + lu(k,558) = 1._r8 / lu(k,558) + lu(k,559) = lu(k,559) * lu(k,558) + lu(k,560) = lu(k,560) * lu(k,558) + lu(k,561) = lu(k,561) * lu(k,558) + lu(k,562) = lu(k,562) * lu(k,558) + lu(k,563) = lu(k,563) * lu(k,558) + lu(k,564) = lu(k,564) * lu(k,558) + lu(k,565) = lu(k,565) * lu(k,558) + lu(k,1946) = - lu(k,559) * lu(k,1941) + lu(k,1958) = - lu(k,560) * lu(k,1941) + lu(k,1961) = lu(k,1961) - lu(k,561) * lu(k,1941) + lu(k,1966) = lu(k,1966) - lu(k,562) * lu(k,1941) + lu(k,1969) = lu(k,1969) - lu(k,563) * lu(k,1941) + lu(k,1973) = lu(k,1973) - lu(k,564) * lu(k,1941) + lu(k,1974) = lu(k,1974) - lu(k,565) * lu(k,1941) + lu(k,2149) = lu(k,2149) - lu(k,559) * lu(k,2148) + lu(k,2152) = lu(k,2152) - lu(k,560) * lu(k,2148) + lu(k,2154) = - lu(k,561) * lu(k,2148) + lu(k,2159) = - lu(k,562) * lu(k,2148) + lu(k,2162) = lu(k,2162) - lu(k,563) * lu(k,2148) + lu(k,2166) = lu(k,2166) - lu(k,564) * lu(k,2148) + lu(k,2167) = lu(k,2167) - lu(k,565) * lu(k,2148) + lu(k,2174) = lu(k,2174) - lu(k,559) * lu(k,2172) + lu(k,2182) = lu(k,2182) - lu(k,560) * lu(k,2172) + lu(k,2185) = - lu(k,561) * lu(k,2172) + lu(k,2190) = lu(k,2190) - lu(k,562) * lu(k,2172) + lu(k,2193) = lu(k,2193) - lu(k,563) * lu(k,2172) + lu(k,2197) = lu(k,2197) - lu(k,564) * lu(k,2172) + lu(k,2198) = lu(k,2198) - lu(k,565) * lu(k,2172) + lu(k,566) = 1._r8 / lu(k,566) + lu(k,567) = lu(k,567) * lu(k,566) + lu(k,568) = lu(k,568) * lu(k,566) + lu(k,569) = lu(k,569) * lu(k,566) + lu(k,570) = lu(k,570) * lu(k,566) + lu(k,571) = lu(k,571) * lu(k,566) + lu(k,572) = lu(k,572) * lu(k,566) + lu(k,573) = lu(k,573) * lu(k,566) + lu(k,1658) = lu(k,1658) - lu(k,567) * lu(k,1621) + lu(k,1668) = lu(k,1668) - lu(k,568) * lu(k,1621) + lu(k,1674) = lu(k,1674) - lu(k,569) * lu(k,1621) + lu(k,1691) = lu(k,1691) - lu(k,570) * lu(k,1621) + lu(k,1697) = lu(k,1697) - lu(k,571) * lu(k,1621) + lu(k,1698) = lu(k,1698) - lu(k,572) * lu(k,1621) + lu(k,1700) = lu(k,1700) - lu(k,573) * lu(k,1621) + lu(k,1742) = lu(k,1742) - lu(k,567) * lu(k,1738) + lu(k,1752) = lu(k,1752) - lu(k,568) * lu(k,1738) + lu(k,1758) = - lu(k,569) * lu(k,1738) + lu(k,1774) = lu(k,1774) - lu(k,570) * lu(k,1738) + lu(k,1780) = lu(k,1780) - lu(k,571) * lu(k,1738) + lu(k,1781) = lu(k,1781) - lu(k,572) * lu(k,1738) + lu(k,1783) = lu(k,1783) - lu(k,573) * lu(k,1738) + lu(k,1890) = lu(k,1890) - lu(k,567) * lu(k,1870) + lu(k,1897) = lu(k,1897) - lu(k,568) * lu(k,1870) + lu(k,1903) = lu(k,1903) - lu(k,569) * lu(k,1870) + lu(k,1918) = lu(k,1918) - lu(k,570) * lu(k,1870) + lu(k,1924) = lu(k,1924) - lu(k,571) * lu(k,1870) + lu(k,1925) = lu(k,1925) - lu(k,572) * lu(k,1870) + lu(k,1927) = lu(k,1927) - lu(k,573) * lu(k,1870) + lu(k,574) = 1._r8 / lu(k,574) + lu(k,575) = lu(k,575) * lu(k,574) + lu(k,576) = lu(k,576) * lu(k,574) + lu(k,577) = lu(k,577) * lu(k,574) + lu(k,578) = lu(k,578) * lu(k,574) + lu(k,579) = lu(k,579) * lu(k,574) + lu(k,580) = lu(k,580) * lu(k,574) + lu(k,581) = lu(k,581) * lu(k,574) + lu(k,582) = lu(k,582) * lu(k,574) + lu(k,1352) = lu(k,1352) - lu(k,575) * lu(k,1349) + lu(k,1354) = - lu(k,576) * lu(k,1349) + lu(k,1356) = lu(k,1356) - lu(k,577) * lu(k,1349) + lu(k,1359) = lu(k,1359) - lu(k,578) * lu(k,1349) + lu(k,1360) = lu(k,1360) - lu(k,579) * lu(k,1349) + lu(k,1361) = lu(k,1361) - lu(k,580) * lu(k,1349) + lu(k,1364) = lu(k,1364) - lu(k,581) * lu(k,1349) + lu(k,1365) = lu(k,1365) - lu(k,582) * lu(k,1349) + lu(k,1646) = lu(k,1646) - lu(k,575) * lu(k,1622) + lu(k,1673) = lu(k,1673) - lu(k,576) * lu(k,1622) + lu(k,1684) = lu(k,1684) - lu(k,577) * lu(k,1622) + lu(k,1691) = lu(k,1691) - lu(k,578) * lu(k,1622) + lu(k,1693) = lu(k,1693) - lu(k,579) * lu(k,1622) + lu(k,1695) = lu(k,1695) - lu(k,580) * lu(k,1622) + lu(k,1698) = lu(k,1698) - lu(k,581) * lu(k,1622) + lu(k,1700) = lu(k,1700) - lu(k,582) * lu(k,1622) + lu(k,1947) = lu(k,1947) - lu(k,575) * lu(k,1942) + lu(k,1953) = - lu(k,576) * lu(k,1942) + lu(k,1956) = lu(k,1956) - lu(k,577) * lu(k,1942) + lu(k,1962) = lu(k,1962) - lu(k,578) * lu(k,1942) + lu(k,1964) = lu(k,1964) - lu(k,579) * lu(k,1942) + lu(k,1966) = lu(k,1966) - lu(k,580) * lu(k,1942) + lu(k,1969) = lu(k,1969) - lu(k,581) * lu(k,1942) + lu(k,1971) = lu(k,1971) - lu(k,582) * lu(k,1942) + 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,583) = 1._r8 / lu(k,583) + lu(k,584) = lu(k,584) * lu(k,583) + lu(k,585) = lu(k,585) * lu(k,583) + lu(k,586) = lu(k,586) * lu(k,583) + lu(k,587) = lu(k,587) * lu(k,583) + lu(k,588) = lu(k,588) * lu(k,583) + lu(k,589) = lu(k,589) * lu(k,583) + lu(k,590) = lu(k,590) * lu(k,583) + lu(k,591) = lu(k,591) * lu(k,583) + lu(k,1251) = - lu(k,584) * lu(k,1247) + lu(k,1253) = - lu(k,585) * lu(k,1247) + lu(k,1254) = - lu(k,586) * lu(k,1247) + lu(k,1263) = - lu(k,587) * lu(k,1247) + lu(k,1264) = lu(k,1264) - lu(k,588) * lu(k,1247) + lu(k,1265) = - lu(k,589) * lu(k,1247) + lu(k,1269) = lu(k,1269) - lu(k,590) * lu(k,1247) + lu(k,1270) = lu(k,1270) - lu(k,591) * lu(k,1247) + lu(k,1669) = lu(k,1669) - lu(k,584) * lu(k,1623) + lu(k,1673) = lu(k,1673) - lu(k,585) * lu(k,1623) + lu(k,1674) = lu(k,1674) - lu(k,586) * lu(k,1623) + lu(k,1690) = lu(k,1690) - lu(k,587) * lu(k,1623) + lu(k,1691) = lu(k,1691) - lu(k,588) * lu(k,1623) + lu(k,1693) = lu(k,1693) - lu(k,589) * lu(k,1623) + lu(k,1698) = lu(k,1698) - lu(k,590) * lu(k,1623) + lu(k,1700) = lu(k,1700) - lu(k,591) * lu(k,1623) + lu(k,1898) = lu(k,1898) - lu(k,584) * lu(k,1871) + lu(k,1902) = lu(k,1902) - lu(k,585) * lu(k,1871) + lu(k,1903) = lu(k,1903) - lu(k,586) * lu(k,1871) + lu(k,1917) = lu(k,1917) - lu(k,587) * lu(k,1871) + lu(k,1918) = lu(k,1918) - lu(k,588) * lu(k,1871) + lu(k,1920) = lu(k,1920) - lu(k,589) * lu(k,1871) + lu(k,1925) = lu(k,1925) - lu(k,590) * lu(k,1871) + lu(k,1927) = lu(k,1927) - lu(k,591) * lu(k,1871) + lu(k,592) = 1._r8 / lu(k,592) + lu(k,593) = lu(k,593) * lu(k,592) + lu(k,594) = lu(k,594) * lu(k,592) + lu(k,595) = lu(k,595) * lu(k,592) + lu(k,661) = - lu(k,593) * lu(k,656) + lu(k,663) = - lu(k,594) * lu(k,656) + lu(k,666) = lu(k,666) - lu(k,595) * lu(k,656) + lu(k,699) = - lu(k,593) * lu(k,694) + lu(k,701) = lu(k,701) - lu(k,594) * lu(k,694) + lu(k,705) = lu(k,705) - lu(k,595) * lu(k,694) + lu(k,728) = - lu(k,593) * lu(k,723) + lu(k,730) = - lu(k,594) * lu(k,723) + lu(k,735) = lu(k,735) - lu(k,595) * lu(k,723) + lu(k,752) = - lu(k,593) * lu(k,747) + lu(k,754) = lu(k,754) - lu(k,594) * lu(k,747) + lu(k,760) = lu(k,760) - lu(k,595) * lu(k,747) + lu(k,1073) = - lu(k,593) * lu(k,1071) + lu(k,1076) = - lu(k,594) * lu(k,1071) + lu(k,1085) = lu(k,1085) - lu(k,595) * lu(k,1071) + lu(k,1281) = - lu(k,593) * lu(k,1277) + lu(k,1284) = - lu(k,594) * lu(k,1277) + lu(k,1302) = lu(k,1302) - lu(k,595) * lu(k,1277) + lu(k,1654) = - lu(k,593) * lu(k,1624) + lu(k,1671) = lu(k,1671) - lu(k,594) * lu(k,1624) + lu(k,1700) = lu(k,1700) - lu(k,595) * lu(k,1624) + lu(k,1887) = lu(k,1887) - lu(k,593) * lu(k,1872) + lu(k,1900) = lu(k,1900) - lu(k,594) * lu(k,1872) + lu(k,1927) = lu(k,1927) - lu(k,595) * lu(k,1872) + lu(k,596) = 1._r8 / lu(k,596) + lu(k,597) = lu(k,597) * lu(k,596) + lu(k,598) = lu(k,598) * lu(k,596) + lu(k,599) = lu(k,599) * lu(k,596) + lu(k,600) = lu(k,600) * lu(k,596) + lu(k,601) = lu(k,601) * lu(k,596) + lu(k,602) = lu(k,602) * lu(k,596) + lu(k,603) = lu(k,603) * lu(k,596) + lu(k,604) = lu(k,604) * lu(k,596) + lu(k,1523) = lu(k,1523) - lu(k,597) * lu(k,1519) + lu(k,1528) = lu(k,1528) - lu(k,598) * lu(k,1519) + lu(k,1529) = lu(k,1529) - lu(k,599) * lu(k,1519) + lu(k,1532) = lu(k,1532) - lu(k,600) * lu(k,1519) + lu(k,1535) = lu(k,1535) - lu(k,601) * lu(k,1519) + lu(k,1536) = lu(k,1536) - lu(k,602) * lu(k,1519) + lu(k,1537) = lu(k,1537) - lu(k,603) * lu(k,1519) + lu(k,1541) = lu(k,1541) - lu(k,604) * lu(k,1519) + lu(k,1687) = lu(k,1687) - lu(k,597) * lu(k,1625) + lu(k,1692) = lu(k,1692) - lu(k,598) * lu(k,1625) + lu(k,1693) = lu(k,1693) - lu(k,599) * lu(k,1625) + lu(k,1696) = lu(k,1696) - lu(k,600) * lu(k,1625) + lu(k,1699) = lu(k,1699) - lu(k,601) * lu(k,1625) + lu(k,1700) = lu(k,1700) - lu(k,602) * lu(k,1625) + lu(k,1701) = lu(k,1701) - lu(k,603) * lu(k,1625) + lu(k,1705) = lu(k,1705) - lu(k,604) * lu(k,1625) + lu(k,1997) = lu(k,1997) - lu(k,597) * lu(k,1984) + lu(k,2002) = lu(k,2002) - lu(k,598) * lu(k,1984) + lu(k,2003) = lu(k,2003) - lu(k,599) * lu(k,1984) + lu(k,2006) = lu(k,2006) - lu(k,600) * lu(k,1984) + lu(k,2009) = lu(k,2009) - lu(k,601) * lu(k,1984) + lu(k,2010) = lu(k,2010) - lu(k,602) * lu(k,1984) + lu(k,2011) = lu(k,2011) - lu(k,603) * lu(k,1984) + lu(k,2015) = lu(k,2015) - lu(k,604) * lu(k,1984) + lu(k,605) = 1._r8 / lu(k,605) + lu(k,606) = lu(k,606) * lu(k,605) + lu(k,607) = lu(k,607) * lu(k,605) + lu(k,608) = lu(k,608) * lu(k,605) + lu(k,609) = lu(k,609) * lu(k,605) + lu(k,610) = lu(k,610) * lu(k,605) + lu(k,611) = lu(k,611) * lu(k,605) + lu(k,1693) = lu(k,1693) - lu(k,606) * lu(k,1626) + lu(k,1699) = lu(k,1699) - lu(k,607) * lu(k,1626) + lu(k,1700) = lu(k,1700) - lu(k,608) * lu(k,1626) + lu(k,1701) = lu(k,1701) - lu(k,609) * lu(k,1626) + lu(k,1703) = lu(k,1703) - lu(k,610) * lu(k,1626) + lu(k,1705) = lu(k,1705) - lu(k,611) * lu(k,1626) + lu(k,2003) = lu(k,2003) - lu(k,606) * lu(k,1985) + lu(k,2009) = lu(k,2009) - lu(k,607) * lu(k,1985) + lu(k,2010) = lu(k,2010) - lu(k,608) * lu(k,1985) + lu(k,2011) = lu(k,2011) - lu(k,609) * lu(k,1985) + lu(k,2013) = - lu(k,610) * lu(k,1985) + lu(k,2015) = lu(k,2015) - lu(k,611) * lu(k,1985) + lu(k,2110) = lu(k,2110) - lu(k,606) * lu(k,2055) + lu(k,2116) = lu(k,2116) - lu(k,607) * lu(k,2055) + lu(k,2117) = lu(k,2117) - lu(k,608) * lu(k,2055) + lu(k,2118) = lu(k,2118) - lu(k,609) * lu(k,2055) + lu(k,2120) = lu(k,2120) - lu(k,610) * lu(k,2055) + lu(k,2122) = lu(k,2122) - lu(k,611) * lu(k,2055) + lu(k,2188) = lu(k,2188) - lu(k,606) * lu(k,2173) + lu(k,2194) = lu(k,2194) - lu(k,607) * lu(k,2173) + lu(k,2195) = lu(k,2195) - lu(k,608) * lu(k,2173) + lu(k,2196) = lu(k,2196) - lu(k,609) * lu(k,2173) + lu(k,2198) = lu(k,2198) - lu(k,610) * lu(k,2173) + lu(k,2200) = - lu(k,611) * lu(k,2173) + lu(k,612) = 1._r8 / lu(k,612) + lu(k,613) = lu(k,613) * lu(k,612) + lu(k,614) = lu(k,614) * lu(k,612) + lu(k,615) = lu(k,615) * lu(k,612) + lu(k,616) = lu(k,616) * lu(k,612) + lu(k,617) = lu(k,617) * lu(k,612) + lu(k,618) = lu(k,618) * lu(k,612) + lu(k,1352) = lu(k,1352) - lu(k,613) * lu(k,1350) + lu(k,1357) = lu(k,1357) - lu(k,614) * lu(k,1350) + lu(k,1359) = lu(k,1359) - lu(k,615) * lu(k,1350) + lu(k,1360) = lu(k,1360) - lu(k,616) * lu(k,1350) + lu(k,1362) = lu(k,1362) - lu(k,617) * lu(k,1350) + lu(k,1368) = - lu(k,618) * lu(k,1350) + lu(k,1373) = lu(k,1373) - lu(k,613) * lu(k,1371) + lu(k,1388) = lu(k,1388) - lu(k,614) * lu(k,1371) + lu(k,1391) = lu(k,1391) - lu(k,615) * lu(k,1371) + lu(k,1392) = lu(k,1392) - lu(k,616) * lu(k,1371) + lu(k,1394) = lu(k,1394) - lu(k,617) * lu(k,1371) + lu(k,1400) = - lu(k,618) * lu(k,1371) + lu(k,1646) = lu(k,1646) - lu(k,613) * lu(k,1627) + lu(k,1685) = lu(k,1685) - lu(k,614) * lu(k,1627) + lu(k,1691) = lu(k,1691) - lu(k,615) * lu(k,1627) + lu(k,1693) = lu(k,1693) - lu(k,616) * lu(k,1627) + lu(k,1696) = lu(k,1696) - lu(k,617) * lu(k,1627) + lu(k,1705) = lu(k,1705) - lu(k,618) * lu(k,1627) + lu(k,2073) = lu(k,2073) - lu(k,613) * lu(k,2056) + lu(k,2102) = lu(k,2102) - lu(k,614) * lu(k,2056) + lu(k,2108) = lu(k,2108) - lu(k,615) * lu(k,2056) + lu(k,2110) = lu(k,2110) - lu(k,616) * lu(k,2056) + lu(k,2113) = lu(k,2113) - lu(k,617) * lu(k,2056) + lu(k,2122) = lu(k,2122) - lu(k,618) * lu(k,2056) + 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,619) = 1._r8 / lu(k,619) + lu(k,620) = lu(k,620) * lu(k,619) + lu(k,621) = lu(k,621) * lu(k,619) + lu(k,622) = lu(k,622) * lu(k,619) + lu(k,623) = lu(k,623) * lu(k,619) + lu(k,624) = lu(k,624) * lu(k,619) + lu(k,916) = lu(k,916) - lu(k,620) * lu(k,912) + lu(k,917) = - lu(k,621) * lu(k,912) + lu(k,919) = lu(k,919) - lu(k,622) * lu(k,912) + lu(k,922) = lu(k,922) - lu(k,623) * lu(k,912) + lu(k,923) = lu(k,923) - lu(k,624) * lu(k,912) + lu(k,1046) = lu(k,1046) - lu(k,620) * lu(k,1044) + lu(k,1051) = lu(k,1051) - lu(k,621) * lu(k,1044) + lu(k,1053) = lu(k,1053) - lu(k,622) * lu(k,1044) + lu(k,1057) = lu(k,1057) - lu(k,623) * lu(k,1044) + lu(k,1058) = lu(k,1058) - lu(k,624) * lu(k,1044) + lu(k,1661) = lu(k,1661) - lu(k,620) * lu(k,1628) + lu(k,1690) = lu(k,1690) - lu(k,621) * lu(k,1628) + lu(k,1693) = lu(k,1693) - lu(k,622) * lu(k,1628) + lu(k,1698) = lu(k,1698) - lu(k,623) * lu(k,1628) + lu(k,1700) = lu(k,1700) - lu(k,624) * lu(k,1628) + lu(k,1802) = lu(k,1802) - lu(k,620) * lu(k,1793) + lu(k,1825) = lu(k,1825) - lu(k,621) * lu(k,1793) + lu(k,1828) = lu(k,1828) - lu(k,622) * lu(k,1793) + lu(k,1833) = lu(k,1833) - lu(k,623) * lu(k,1793) + lu(k,1835) = lu(k,1835) - lu(k,624) * lu(k,1793) + lu(k,1892) = lu(k,1892) - lu(k,620) * lu(k,1873) + lu(k,1917) = lu(k,1917) - lu(k,621) * lu(k,1873) + lu(k,1920) = lu(k,1920) - lu(k,622) * lu(k,1873) + lu(k,1925) = lu(k,1925) - lu(k,623) * lu(k,1873) + lu(k,1927) = lu(k,1927) - lu(k,624) * lu(k,1873) + lu(k,627) = 1._r8 / lu(k,627) + lu(k,628) = lu(k,628) * lu(k,627) + lu(k,629) = lu(k,629) * lu(k,627) + lu(k,630) = lu(k,630) * lu(k,627) + lu(k,631) = lu(k,631) * lu(k,627) + lu(k,632) = lu(k,632) * lu(k,627) + lu(k,1693) = lu(k,1693) - lu(k,628) * lu(k,1629) + lu(k,1697) = lu(k,1697) - lu(k,629) * lu(k,1629) + lu(k,1698) = lu(k,1698) - lu(k,630) * lu(k,1629) + lu(k,1700) = lu(k,1700) - lu(k,631) * lu(k,1629) + lu(k,1704) = lu(k,1704) - lu(k,632) * lu(k,1629) + lu(k,1920) = lu(k,1920) - lu(k,628) * lu(k,1874) + lu(k,1924) = lu(k,1924) - lu(k,629) * lu(k,1874) + lu(k,1925) = lu(k,1925) - lu(k,630) * lu(k,1874) + lu(k,1927) = lu(k,1927) - lu(k,631) * lu(k,1874) + lu(k,1931) = lu(k,1931) - lu(k,632) * lu(k,1874) + lu(k,1964) = lu(k,1964) - lu(k,628) * lu(k,1943) + lu(k,1968) = lu(k,1968) - lu(k,629) * lu(k,1943) + lu(k,1969) = lu(k,1969) - lu(k,630) * lu(k,1943) + lu(k,1971) = lu(k,1971) - lu(k,631) * lu(k,1943) + lu(k,1975) = lu(k,1975) - lu(k,632) * lu(k,1943) + lu(k,2110) = lu(k,2110) - lu(k,628) * lu(k,2057) + lu(k,2114) = lu(k,2114) - lu(k,629) * lu(k,2057) + lu(k,2115) = lu(k,2115) - lu(k,630) * lu(k,2057) + lu(k,2117) = lu(k,2117) - lu(k,631) * lu(k,2057) + lu(k,2121) = lu(k,2121) - lu(k,632) * lu(k,2057) + lu(k,2249) = lu(k,2249) - lu(k,628) * lu(k,2211) + lu(k,2253) = lu(k,2253) - lu(k,629) * lu(k,2211) + lu(k,2254) = lu(k,2254) - lu(k,630) * lu(k,2211) + lu(k,2256) = lu(k,2256) - lu(k,631) * lu(k,2211) + lu(k,2260) = lu(k,2260) - lu(k,632) * lu(k,2211) + lu(k,634) = 1._r8 / lu(k,634) + lu(k,635) = lu(k,635) * lu(k,634) + lu(k,636) = lu(k,636) * lu(k,634) + lu(k,637) = lu(k,637) * lu(k,634) + lu(k,638) = lu(k,638) * lu(k,634) + lu(k,639) = lu(k,639) * lu(k,634) + lu(k,640) = lu(k,640) * lu(k,634) + lu(k,641) = lu(k,641) * lu(k,634) + lu(k,642) = lu(k,642) * lu(k,634) + lu(k,643) = lu(k,643) * lu(k,634) + lu(k,887) = lu(k,887) - lu(k,635) * lu(k,885) + lu(k,888) = lu(k,888) - lu(k,636) * lu(k,885) + lu(k,890) = lu(k,890) - lu(k,637) * lu(k,885) + lu(k,891) = lu(k,891) - lu(k,638) * lu(k,885) + lu(k,892) = lu(k,892) - lu(k,639) * lu(k,885) + lu(k,893) = lu(k,893) - lu(k,640) * lu(k,885) + lu(k,894) = lu(k,894) - lu(k,641) * lu(k,885) + lu(k,897) = lu(k,897) - lu(k,642) * lu(k,885) + lu(k,898) = lu(k,898) - lu(k,643) * lu(k,885) + lu(k,1634) = lu(k,1634) - lu(k,635) * lu(k,1630) + lu(k,1649) = lu(k,1649) - lu(k,636) * lu(k,1630) + lu(k,1658) = lu(k,1658) - lu(k,637) * lu(k,1630) + lu(k,1668) = lu(k,1668) - lu(k,638) * lu(k,1630) + lu(k,1685) = lu(k,1685) - lu(k,639) * lu(k,1630) + lu(k,1691) = lu(k,1691) - lu(k,640) * lu(k,1630) + lu(k,1693) = lu(k,1693) - lu(k,641) * lu(k,1630) + lu(k,1698) = lu(k,1698) - lu(k,642) * lu(k,1630) + lu(k,1700) = lu(k,1700) - lu(k,643) * lu(k,1630) + lu(k,1876) = lu(k,1876) - lu(k,635) * lu(k,1875) + lu(k,1885) = lu(k,1885) - lu(k,636) * lu(k,1875) + lu(k,1890) = lu(k,1890) - lu(k,637) * lu(k,1875) + lu(k,1897) = lu(k,1897) - lu(k,638) * lu(k,1875) + lu(k,1913) = lu(k,1913) - lu(k,639) * lu(k,1875) + lu(k,1918) = lu(k,1918) - lu(k,640) * lu(k,1875) + lu(k,1920) = lu(k,1920) - lu(k,641) * lu(k,1875) + lu(k,1925) = lu(k,1925) - lu(k,642) * lu(k,1875) + lu(k,1927) = lu(k,1927) - lu(k,643) * lu(k,1875) + lu(k,644) = 1._r8 / lu(k,644) + lu(k,645) = lu(k,645) * lu(k,644) + lu(k,646) = lu(k,646) * lu(k,644) + lu(k,647) = lu(k,647) * lu(k,644) + lu(k,648) = lu(k,648) * lu(k,644) + lu(k,649) = lu(k,649) * lu(k,644) + lu(k,650) = lu(k,650) * lu(k,644) + lu(k,651) = lu(k,651) * lu(k,644) + lu(k,652) = lu(k,652) * lu(k,644) + lu(k,653) = lu(k,653) * lu(k,644) + lu(k,1107) = lu(k,1107) - lu(k,645) * lu(k,1105) + lu(k,1108) = lu(k,1108) - lu(k,646) * lu(k,1105) + lu(k,1109) = lu(k,1109) - lu(k,647) * lu(k,1105) + lu(k,1110) = lu(k,1110) - lu(k,648) * lu(k,1105) + lu(k,1111) = lu(k,1111) - lu(k,649) * lu(k,1105) + lu(k,1112) = lu(k,1112) - lu(k,650) * lu(k,1105) + lu(k,1116) = lu(k,1116) - lu(k,651) * lu(k,1105) + lu(k,1117) = - lu(k,652) * lu(k,1105) + lu(k,1121) = lu(k,1121) - lu(k,653) * lu(k,1105) + lu(k,1646) = lu(k,1646) - lu(k,645) * lu(k,1631) + lu(k,1658) = lu(k,1658) - lu(k,646) * lu(k,1631) + lu(k,1666) = lu(k,1666) - lu(k,647) * lu(k,1631) + lu(k,1669) = lu(k,1669) - lu(k,648) * lu(k,1631) + lu(k,1670) = lu(k,1670) - lu(k,649) * lu(k,1631) + lu(k,1671) = lu(k,1671) - lu(k,650) * lu(k,1631) + lu(k,1691) = lu(k,1691) - lu(k,651) * lu(k,1631) + lu(k,1693) = lu(k,1693) - lu(k,652) * lu(k,1631) + lu(k,1700) = lu(k,1700) - lu(k,653) * lu(k,1631) + lu(k,2073) = lu(k,2073) - lu(k,645) * lu(k,2058) + lu(k,2081) = lu(k,2081) - lu(k,646) * lu(k,2058) + lu(k,2086) = - lu(k,647) * lu(k,2058) + lu(k,2088) = lu(k,2088) - lu(k,648) * lu(k,2058) + lu(k,2089) = lu(k,2089) - lu(k,649) * lu(k,2058) + lu(k,2090) = lu(k,2090) - lu(k,650) * lu(k,2058) + lu(k,2108) = lu(k,2108) - lu(k,651) * lu(k,2058) + lu(k,2110) = lu(k,2110) - lu(k,652) * lu(k,2058) + lu(k,2117) = lu(k,2117) - lu(k,653) * lu(k,2058) + lu(k,657) = 1._r8 / lu(k,657) + lu(k,658) = lu(k,658) * lu(k,657) + lu(k,659) = lu(k,659) * lu(k,657) + lu(k,660) = lu(k,660) * lu(k,657) + lu(k,661) = lu(k,661) * lu(k,657) + lu(k,662) = lu(k,662) * lu(k,657) + lu(k,663) = lu(k,663) * lu(k,657) + lu(k,664) = lu(k,664) * lu(k,657) + lu(k,665) = lu(k,665) * lu(k,657) + lu(k,666) = lu(k,666) * lu(k,657) + lu(k,725) = lu(k,725) - lu(k,658) * lu(k,724) + lu(k,726) = lu(k,726) - lu(k,659) * lu(k,724) + lu(k,727) = lu(k,727) - lu(k,660) * lu(k,724) + lu(k,728) = lu(k,728) - lu(k,661) * lu(k,724) + lu(k,729) = lu(k,729) - lu(k,662) * lu(k,724) + lu(k,730) = lu(k,730) - lu(k,663) * lu(k,724) + lu(k,731) = lu(k,731) - lu(k,664) * lu(k,724) + lu(k,732) = - lu(k,665) * lu(k,724) + lu(k,735) = lu(k,735) - lu(k,666) * lu(k,724) + lu(k,1638) = lu(k,1638) - lu(k,658) * lu(k,1632) + lu(k,1639) = lu(k,1639) - lu(k,659) * lu(k,1632) + lu(k,1642) = - lu(k,660) * lu(k,1632) + lu(k,1654) = lu(k,1654) - lu(k,661) * lu(k,1632) + lu(k,1662) = lu(k,1662) - lu(k,662) * lu(k,1632) + lu(k,1671) = lu(k,1671) - lu(k,663) * lu(k,1632) + lu(k,1678) = lu(k,1678) - lu(k,664) * lu(k,1632) + lu(k,1693) = lu(k,1693) - lu(k,665) * lu(k,1632) + lu(k,1700) = lu(k,1700) - lu(k,666) * lu(k,1632) + lu(k,2065) = lu(k,2065) - lu(k,658) * lu(k,2059) + lu(k,2066) = lu(k,2066) - lu(k,659) * lu(k,2059) + lu(k,2069) = lu(k,2069) - lu(k,660) * lu(k,2059) + lu(k,2078) = lu(k,2078) - lu(k,661) * lu(k,2059) + lu(k,2084) = lu(k,2084) - lu(k,662) * lu(k,2059) + lu(k,2090) = lu(k,2090) - lu(k,663) * lu(k,2059) + lu(k,2096) = lu(k,2096) - lu(k,664) * lu(k,2059) + lu(k,2110) = lu(k,2110) - lu(k,665) * lu(k,2059) + lu(k,2117) = lu(k,2117) - lu(k,666) * lu(k,2059) + 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,887) = lu(k,887) - lu(k,669) * lu(k,886) + lu(k,888) = lu(k,888) - lu(k,670) * lu(k,886) + lu(k,889) = lu(k,889) - lu(k,671) * lu(k,886) + lu(k,890) = lu(k,890) - lu(k,672) * lu(k,886) + lu(k,891) = lu(k,891) - lu(k,673) * lu(k,886) + lu(k,892) = lu(k,892) - lu(k,674) * lu(k,886) + lu(k,893) = lu(k,893) - lu(k,675) * lu(k,886) + lu(k,894) = lu(k,894) - lu(k,676) * lu(k,886) + lu(k,898) = lu(k,898) - lu(k,677) * lu(k,886) + lu(k,1634) = lu(k,1634) - lu(k,669) * lu(k,1633) + lu(k,1649) = lu(k,1649) - lu(k,670) * lu(k,1633) + lu(k,1655) = lu(k,1655) - lu(k,671) * lu(k,1633) + lu(k,1658) = lu(k,1658) - lu(k,672) * lu(k,1633) + lu(k,1668) = lu(k,1668) - lu(k,673) * lu(k,1633) + lu(k,1685) = lu(k,1685) - lu(k,674) * lu(k,1633) + lu(k,1691) = lu(k,1691) - lu(k,675) * lu(k,1633) + lu(k,1693) = lu(k,1693) - lu(k,676) * lu(k,1633) + lu(k,1700) = lu(k,1700) - lu(k,677) * lu(k,1633) + lu(k,2061) = lu(k,2061) - lu(k,669) * lu(k,2060) + lu(k,2076) = lu(k,2076) - lu(k,670) * lu(k,2060) + lu(k,2079) = lu(k,2079) - lu(k,671) * lu(k,2060) + lu(k,2081) = lu(k,2081) - lu(k,672) * lu(k,2060) + lu(k,2087) = lu(k,2087) - lu(k,673) * lu(k,2060) + lu(k,2102) = lu(k,2102) - lu(k,674) * lu(k,2060) + lu(k,2108) = lu(k,2108) - lu(k,675) * lu(k,2060) + lu(k,2110) = lu(k,2110) - lu(k,676) * lu(k,2060) + lu(k,2117) = lu(k,2117) - lu(k,677) * lu(k,2060) + 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,679) = 1._r8 / lu(k,679) + lu(k,680) = lu(k,680) * lu(k,679) + lu(k,681) = lu(k,681) * lu(k,679) + lu(k,682) = lu(k,682) * lu(k,679) + lu(k,683) = lu(k,683) * lu(k,679) + lu(k,684) = lu(k,684) * lu(k,679) + lu(k,685) = lu(k,685) * lu(k,679) + lu(k,891) = lu(k,891) - lu(k,680) * lu(k,887) + lu(k,892) = lu(k,892) - lu(k,681) * lu(k,887) + lu(k,894) = lu(k,894) - lu(k,682) * lu(k,887) + lu(k,896) = lu(k,896) - lu(k,683) * lu(k,887) + lu(k,897) = lu(k,897) - lu(k,684) * lu(k,887) + lu(k,898) = lu(k,898) - lu(k,685) * lu(k,887) + lu(k,1668) = lu(k,1668) - lu(k,680) * lu(k,1634) + lu(k,1685) = lu(k,1685) - lu(k,681) * lu(k,1634) + lu(k,1693) = lu(k,1693) - lu(k,682) * lu(k,1634) + lu(k,1697) = lu(k,1697) - lu(k,683) * lu(k,1634) + lu(k,1698) = lu(k,1698) - lu(k,684) * lu(k,1634) + lu(k,1700) = lu(k,1700) - lu(k,685) * lu(k,1634) + lu(k,1897) = lu(k,1897) - lu(k,680) * lu(k,1876) + lu(k,1913) = lu(k,1913) - lu(k,681) * lu(k,1876) + lu(k,1920) = lu(k,1920) - lu(k,682) * lu(k,1876) + lu(k,1924) = lu(k,1924) - lu(k,683) * lu(k,1876) + lu(k,1925) = lu(k,1925) - lu(k,684) * lu(k,1876) + lu(k,1927) = lu(k,1927) - lu(k,685) * lu(k,1876) + lu(k,2087) = lu(k,2087) - lu(k,680) * lu(k,2061) + lu(k,2102) = lu(k,2102) - lu(k,681) * lu(k,2061) + lu(k,2110) = lu(k,2110) - lu(k,682) * lu(k,2061) + lu(k,2114) = lu(k,2114) - lu(k,683) * lu(k,2061) + lu(k,2115) = lu(k,2115) - lu(k,684) * lu(k,2061) + lu(k,2117) = lu(k,2117) - lu(k,685) * lu(k,2061) + lu(k,686) = 1._r8 / lu(k,686) + lu(k,687) = lu(k,687) * lu(k,686) + lu(k,688) = lu(k,688) * lu(k,686) + lu(k,689) = lu(k,689) * lu(k,686) + lu(k,690) = lu(k,690) * lu(k,686) + lu(k,1023) = lu(k,1023) - lu(k,687) * lu(k,1021) + lu(k,1034) = lu(k,1034) - lu(k,688) * lu(k,1021) + lu(k,1036) = lu(k,1036) - lu(k,689) * lu(k,1021) + lu(k,1042) = - lu(k,690) * lu(k,1021) + lu(k,1352) = lu(k,1352) - lu(k,687) * lu(k,1351) + lu(k,1360) = lu(k,1360) - lu(k,688) * lu(k,1351) + lu(k,1362) = lu(k,1362) - lu(k,689) * lu(k,1351) + lu(k,1368) = lu(k,1368) - lu(k,690) * lu(k,1351) + lu(k,1373) = lu(k,1373) - lu(k,687) * lu(k,1372) + lu(k,1392) = lu(k,1392) - lu(k,688) * lu(k,1372) + lu(k,1394) = lu(k,1394) - lu(k,689) * lu(k,1372) + lu(k,1400) = lu(k,1400) - lu(k,690) * lu(k,1372) + lu(k,1646) = lu(k,1646) - lu(k,687) * lu(k,1635) + lu(k,1693) = lu(k,1693) - lu(k,688) * lu(k,1635) + lu(k,1696) = lu(k,1696) - lu(k,689) * lu(k,1635) + lu(k,1705) = lu(k,1705) - lu(k,690) * lu(k,1635) + lu(k,1797) = lu(k,1797) - lu(k,687) * lu(k,1794) + lu(k,1828) = lu(k,1828) - lu(k,688) * lu(k,1794) + lu(k,1831) = lu(k,1831) - lu(k,689) * lu(k,1794) + lu(k,1840) = lu(k,1840) - lu(k,690) * lu(k,1794) + lu(k,2073) = lu(k,2073) - lu(k,687) * lu(k,2062) + lu(k,2110) = lu(k,2110) - lu(k,688) * lu(k,2062) + lu(k,2113) = lu(k,2113) - lu(k,689) * lu(k,2062) + lu(k,2122) = lu(k,2122) - lu(k,690) * lu(k,2062) + lu(k,2214) = lu(k,2214) - lu(k,687) * lu(k,2212) + lu(k,2249) = lu(k,2249) - lu(k,688) * lu(k,2212) + lu(k,2252) = lu(k,2252) - lu(k,689) * lu(k,2212) + lu(k,2261) = - lu(k,690) * lu(k,2212) + 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,749) = lu(k,749) - lu(k,696) * lu(k,748) + lu(k,750) = lu(k,750) - lu(k,697) * lu(k,748) + lu(k,751) = lu(k,751) - lu(k,698) * lu(k,748) + lu(k,752) = lu(k,752) - lu(k,699) * lu(k,748) + lu(k,753) = lu(k,753) - lu(k,700) * lu(k,748) + lu(k,754) = lu(k,754) - lu(k,701) * lu(k,748) + lu(k,755) = lu(k,755) - lu(k,702) * lu(k,748) + lu(k,756) = lu(k,756) - lu(k,703) * lu(k,748) + lu(k,757) = - lu(k,704) * lu(k,748) + lu(k,760) = lu(k,760) - lu(k,705) * lu(k,748) + lu(k,1638) = lu(k,1638) - lu(k,696) * lu(k,1636) + lu(k,1641) = lu(k,1641) - lu(k,697) * lu(k,1636) + lu(k,1642) = lu(k,1642) - lu(k,698) * lu(k,1636) + lu(k,1654) = lu(k,1654) - lu(k,699) * lu(k,1636) + lu(k,1662) = lu(k,1662) - lu(k,700) * lu(k,1636) + lu(k,1671) = lu(k,1671) - lu(k,701) * lu(k,1636) + lu(k,1678) = lu(k,1678) - lu(k,702) * lu(k,1636) + lu(k,1685) = lu(k,1685) - lu(k,703) * lu(k,1636) + lu(k,1693) = lu(k,1693) - lu(k,704) * lu(k,1636) + lu(k,1700) = lu(k,1700) - lu(k,705) * lu(k,1636) + lu(k,2065) = lu(k,2065) - lu(k,696) * lu(k,2063) + lu(k,2068) = lu(k,2068) - lu(k,697) * lu(k,2063) + lu(k,2069) = lu(k,2069) - lu(k,698) * lu(k,2063) + lu(k,2078) = lu(k,2078) - lu(k,699) * lu(k,2063) + lu(k,2084) = lu(k,2084) - lu(k,700) * lu(k,2063) + lu(k,2090) = lu(k,2090) - lu(k,701) * lu(k,2063) + lu(k,2096) = lu(k,2096) - lu(k,702) * lu(k,2063) + lu(k,2102) = lu(k,2102) - lu(k,703) * lu(k,2063) + lu(k,2110) = lu(k,2110) - lu(k,704) * lu(k,2063) + lu(k,2117) = lu(k,2117) - lu(k,705) * lu(k,2063) + lu(k,708) = 1._r8 / lu(k,708) + lu(k,709) = lu(k,709) * lu(k,708) + lu(k,710) = lu(k,710) * lu(k,708) + lu(k,711) = lu(k,711) * lu(k,708) + lu(k,712) = lu(k,712) * lu(k,708) + lu(k,713) = lu(k,713) * lu(k,708) + lu(k,714) = lu(k,714) * lu(k,708) + lu(k,1669) = lu(k,1669) - lu(k,709) * lu(k,1637) + lu(k,1691) = lu(k,1691) - lu(k,710) * lu(k,1637) + lu(k,1693) = lu(k,1693) - lu(k,711) * lu(k,1637) + lu(k,1697) = lu(k,1697) - lu(k,712) * lu(k,1637) + lu(k,1698) = lu(k,1698) - lu(k,713) * lu(k,1637) + lu(k,1700) = lu(k,1700) - lu(k,714) * lu(k,1637) + lu(k,1898) = lu(k,1898) - lu(k,709) * lu(k,1877) + lu(k,1918) = lu(k,1918) - lu(k,710) * lu(k,1877) + lu(k,1920) = lu(k,1920) - lu(k,711) * lu(k,1877) + lu(k,1924) = lu(k,1924) - lu(k,712) * lu(k,1877) + lu(k,1925) = lu(k,1925) - lu(k,713) * lu(k,1877) + lu(k,1927) = lu(k,1927) - lu(k,714) * lu(k,1877) + lu(k,1993) = - lu(k,709) * lu(k,1986) + lu(k,2001) = lu(k,2001) - lu(k,710) * lu(k,1986) + lu(k,2003) = lu(k,2003) - lu(k,711) * lu(k,1986) + lu(k,2007) = - lu(k,712) * lu(k,1986) + lu(k,2008) = - lu(k,713) * lu(k,1986) + lu(k,2010) = lu(k,2010) - lu(k,714) * lu(k,1986) + lu(k,2088) = lu(k,2088) - lu(k,709) * lu(k,2064) + lu(k,2108) = lu(k,2108) - lu(k,710) * lu(k,2064) + lu(k,2110) = lu(k,2110) - lu(k,711) * lu(k,2064) + lu(k,2114) = lu(k,2114) - lu(k,712) * lu(k,2064) + lu(k,2115) = lu(k,2115) - lu(k,713) * lu(k,2064) + lu(k,2117) = lu(k,2117) - lu(k,714) * lu(k,2064) + lu(k,2228) = - lu(k,709) * lu(k,2213) + lu(k,2247) = lu(k,2247) - lu(k,710) * lu(k,2213) + lu(k,2249) = lu(k,2249) - lu(k,711) * lu(k,2213) + lu(k,2253) = lu(k,2253) - lu(k,712) * lu(k,2213) + lu(k,2254) = lu(k,2254) - lu(k,713) * lu(k,2213) + lu(k,2256) = lu(k,2256) - lu(k,714) * lu(k,2213) + 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,729) = lu(k,729) - lu(k,716) * lu(k,725) + lu(k,730) = lu(k,730) - lu(k,717) * lu(k,725) + lu(k,733) = lu(k,733) - lu(k,718) * lu(k,725) + lu(k,734) = lu(k,734) - lu(k,719) * lu(k,725) + lu(k,735) = lu(k,735) - lu(k,720) * lu(k,725) + lu(k,753) = lu(k,753) - lu(k,716) * lu(k,749) + lu(k,754) = lu(k,754) - lu(k,717) * lu(k,749) + lu(k,758) = lu(k,758) - lu(k,718) * lu(k,749) + lu(k,759) = lu(k,759) - lu(k,719) * lu(k,749) + lu(k,760) = lu(k,760) - lu(k,720) * lu(k,749) + lu(k,1662) = lu(k,1662) - lu(k,716) * lu(k,1638) + lu(k,1671) = lu(k,1671) - lu(k,717) * lu(k,1638) + lu(k,1697) = lu(k,1697) - lu(k,718) * lu(k,1638) + lu(k,1698) = lu(k,1698) - lu(k,719) * lu(k,1638) + lu(k,1700) = lu(k,1700) - lu(k,720) * lu(k,1638) + lu(k,1893) = lu(k,1893) - lu(k,716) * lu(k,1878) + lu(k,1900) = lu(k,1900) - lu(k,717) * lu(k,1878) + lu(k,1924) = lu(k,1924) - lu(k,718) * lu(k,1878) + lu(k,1925) = lu(k,1925) - lu(k,719) * lu(k,1878) + lu(k,1927) = lu(k,1927) - lu(k,720) * lu(k,1878) + lu(k,1951) = - lu(k,716) * lu(k,1944) + lu(k,1952) = - lu(k,717) * lu(k,1944) + lu(k,1968) = lu(k,1968) - lu(k,718) * lu(k,1944) + lu(k,1969) = lu(k,1969) - lu(k,719) * lu(k,1944) + lu(k,1971) = lu(k,1971) - lu(k,720) * lu(k,1944) + lu(k,2084) = lu(k,2084) - lu(k,716) * lu(k,2065) + lu(k,2090) = lu(k,2090) - lu(k,717) * lu(k,2065) + lu(k,2114) = lu(k,2114) - lu(k,718) * lu(k,2065) + lu(k,2115) = lu(k,2115) - lu(k,719) * lu(k,2065) + lu(k,2117) = lu(k,2117) - lu(k,720) * lu(k,2065) + lu(k,726) = 1._r8 / lu(k,726) + lu(k,727) = lu(k,727) * lu(k,726) + lu(k,728) = lu(k,728) * lu(k,726) + lu(k,729) = lu(k,729) * lu(k,726) + lu(k,730) = lu(k,730) * lu(k,726) + lu(k,731) = lu(k,731) * lu(k,726) + lu(k,732) = lu(k,732) * lu(k,726) + lu(k,733) = lu(k,733) * lu(k,726) + lu(k,734) = lu(k,734) * lu(k,726) + lu(k,735) = lu(k,735) * lu(k,726) + lu(k,1642) = lu(k,1642) - lu(k,727) * lu(k,1639) + lu(k,1654) = lu(k,1654) - lu(k,728) * lu(k,1639) + lu(k,1662) = lu(k,1662) - lu(k,729) * lu(k,1639) + lu(k,1671) = lu(k,1671) - lu(k,730) * lu(k,1639) + lu(k,1678) = lu(k,1678) - lu(k,731) * lu(k,1639) + lu(k,1693) = lu(k,1693) - lu(k,732) * lu(k,1639) + lu(k,1697) = lu(k,1697) - lu(k,733) * lu(k,1639) + lu(k,1698) = lu(k,1698) - lu(k,734) * lu(k,1639) + lu(k,1700) = lu(k,1700) - lu(k,735) * lu(k,1639) + lu(k,1881) = lu(k,1881) - lu(k,727) * lu(k,1879) + lu(k,1887) = lu(k,1887) - lu(k,728) * lu(k,1879) + lu(k,1893) = lu(k,1893) - lu(k,729) * lu(k,1879) + lu(k,1900) = lu(k,1900) - lu(k,730) * lu(k,1879) + lu(k,1907) = lu(k,1907) - lu(k,731) * lu(k,1879) + lu(k,1920) = lu(k,1920) - lu(k,732) * lu(k,1879) + lu(k,1924) = lu(k,1924) - lu(k,733) * lu(k,1879) + lu(k,1925) = lu(k,1925) - lu(k,734) * lu(k,1879) + lu(k,1927) = lu(k,1927) - lu(k,735) * lu(k,1879) + lu(k,2069) = lu(k,2069) - lu(k,727) * lu(k,2066) + lu(k,2078) = lu(k,2078) - lu(k,728) * lu(k,2066) + lu(k,2084) = lu(k,2084) - lu(k,729) * lu(k,2066) + lu(k,2090) = lu(k,2090) - lu(k,730) * lu(k,2066) + lu(k,2096) = lu(k,2096) - lu(k,731) * lu(k,2066) + lu(k,2110) = lu(k,2110) - lu(k,732) * lu(k,2066) + lu(k,2114) = lu(k,2114) - lu(k,733) * lu(k,2066) + lu(k,2115) = lu(k,2115) - lu(k,734) * lu(k,2066) + lu(k,2117) = lu(k,2117) - lu(k,735) * lu(k,2066) + 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,737) = 1._r8 / lu(k,737) + lu(k,738) = lu(k,738) * lu(k,737) + lu(k,739) = lu(k,739) * lu(k,737) + lu(k,740) = lu(k,740) * lu(k,737) + lu(k,741) = lu(k,741) * lu(k,737) + lu(k,742) = lu(k,742) * lu(k,737) + lu(k,743) = lu(k,743) * lu(k,737) + lu(k,1194) = - lu(k,738) * lu(k,1188) + lu(k,1196) = - lu(k,739) * lu(k,1188) + lu(k,1198) = - lu(k,740) * lu(k,1188) + lu(k,1201) = lu(k,1201) - lu(k,741) * lu(k,1188) + lu(k,1202) = lu(k,1202) - lu(k,742) * lu(k,1188) + lu(k,1207) = lu(k,1207) - lu(k,743) * lu(k,1188) + lu(k,1255) = - lu(k,738) * lu(k,1248) + lu(k,1256) = lu(k,1256) - lu(k,739) * lu(k,1248) + lu(k,1260) = lu(k,1260) - lu(k,740) * lu(k,1248) + lu(k,1264) = lu(k,1264) - lu(k,741) * lu(k,1248) + lu(k,1265) = lu(k,1265) - lu(k,742) * lu(k,1248) + lu(k,1270) = lu(k,1270) - lu(k,743) * lu(k,1248) + lu(k,1287) = lu(k,1287) - lu(k,738) * lu(k,1278) + lu(k,1288) = - lu(k,739) * lu(k,1278) + lu(k,1292) = - lu(k,740) * lu(k,1278) + lu(k,1296) = lu(k,1296) - lu(k,741) * lu(k,1278) + lu(k,1297) = lu(k,1297) - lu(k,742) * lu(k,1278) + lu(k,1302) = lu(k,1302) - lu(k,743) * lu(k,1278) + lu(k,1675) = lu(k,1675) - lu(k,738) * lu(k,1640) + lu(k,1677) = lu(k,1677) - lu(k,739) * lu(k,1640) + lu(k,1683) = lu(k,1683) - lu(k,740) * lu(k,1640) + lu(k,1691) = lu(k,1691) - lu(k,741) * lu(k,1640) + lu(k,1693) = lu(k,1693) - lu(k,742) * lu(k,1640) + lu(k,1700) = lu(k,1700) - lu(k,743) * lu(k,1640) + lu(k,2093) = lu(k,2093) - lu(k,738) * lu(k,2067) + lu(k,2095) = - lu(k,739) * lu(k,2067) + lu(k,2100) = - lu(k,740) * lu(k,2067) + lu(k,2108) = lu(k,2108) - lu(k,741) * lu(k,2067) + lu(k,2110) = lu(k,2110) - lu(k,742) * lu(k,2067) + lu(k,2117) = lu(k,2117) - lu(k,743) * lu(k,2067) + lu(k,750) = 1._r8 / lu(k,750) + lu(k,751) = lu(k,751) * lu(k,750) + lu(k,752) = lu(k,752) * lu(k,750) + lu(k,753) = lu(k,753) * lu(k,750) + lu(k,754) = lu(k,754) * lu(k,750) + lu(k,755) = lu(k,755) * lu(k,750) + lu(k,756) = lu(k,756) * lu(k,750) + lu(k,757) = lu(k,757) * lu(k,750) + lu(k,758) = lu(k,758) * lu(k,750) + lu(k,759) = lu(k,759) * lu(k,750) + lu(k,760) = lu(k,760) * lu(k,750) + lu(k,1642) = lu(k,1642) - lu(k,751) * lu(k,1641) + lu(k,1654) = lu(k,1654) - lu(k,752) * lu(k,1641) + lu(k,1662) = lu(k,1662) - lu(k,753) * lu(k,1641) + lu(k,1671) = lu(k,1671) - lu(k,754) * lu(k,1641) + lu(k,1678) = lu(k,1678) - lu(k,755) * lu(k,1641) + lu(k,1685) = lu(k,1685) - lu(k,756) * lu(k,1641) + lu(k,1693) = lu(k,1693) - lu(k,757) * lu(k,1641) + lu(k,1697) = lu(k,1697) - lu(k,758) * lu(k,1641) + lu(k,1698) = lu(k,1698) - lu(k,759) * lu(k,1641) + lu(k,1700) = lu(k,1700) - lu(k,760) * lu(k,1641) + lu(k,1881) = lu(k,1881) - lu(k,751) * lu(k,1880) + lu(k,1887) = lu(k,1887) - lu(k,752) * lu(k,1880) + lu(k,1893) = lu(k,1893) - lu(k,753) * lu(k,1880) + lu(k,1900) = lu(k,1900) - lu(k,754) * lu(k,1880) + lu(k,1907) = lu(k,1907) - lu(k,755) * lu(k,1880) + lu(k,1913) = lu(k,1913) - lu(k,756) * lu(k,1880) + lu(k,1920) = lu(k,1920) - lu(k,757) * lu(k,1880) + lu(k,1924) = lu(k,1924) - lu(k,758) * lu(k,1880) + lu(k,1925) = lu(k,1925) - lu(k,759) * lu(k,1880) + lu(k,1927) = lu(k,1927) - lu(k,760) * lu(k,1880) + lu(k,2069) = lu(k,2069) - lu(k,751) * lu(k,2068) + lu(k,2078) = lu(k,2078) - lu(k,752) * lu(k,2068) + lu(k,2084) = lu(k,2084) - lu(k,753) * lu(k,2068) + lu(k,2090) = lu(k,2090) - lu(k,754) * lu(k,2068) + lu(k,2096) = lu(k,2096) - lu(k,755) * lu(k,2068) + lu(k,2102) = lu(k,2102) - lu(k,756) * lu(k,2068) + lu(k,2110) = lu(k,2110) - lu(k,757) * lu(k,2068) + lu(k,2114) = lu(k,2114) - lu(k,758) * lu(k,2068) + lu(k,2115) = lu(k,2115) - lu(k,759) * lu(k,2068) + lu(k,2117) = lu(k,2117) - lu(k,760) * lu(k,2068) + lu(k,761) = 1._r8 / lu(k,761) + lu(k,762) = lu(k,762) * lu(k,761) + lu(k,763) = lu(k,763) * lu(k,761) + lu(k,764) = lu(k,764) * lu(k,761) + lu(k,765) = lu(k,765) * lu(k,761) + lu(k,766) = lu(k,766) * lu(k,761) + lu(k,767) = lu(k,767) * lu(k,761) + lu(k,768) = lu(k,768) * lu(k,761) + lu(k,1671) = lu(k,1671) - lu(k,762) * lu(k,1642) + lu(k,1678) = lu(k,1678) - lu(k,763) * lu(k,1642) + lu(k,1693) = lu(k,1693) - lu(k,764) * lu(k,1642) + lu(k,1696) = lu(k,1696) - lu(k,765) * lu(k,1642) + lu(k,1697) = lu(k,1697) - lu(k,766) * lu(k,1642) + lu(k,1698) = lu(k,1698) - lu(k,767) * lu(k,1642) + lu(k,1700) = lu(k,1700) - lu(k,768) * lu(k,1642) + lu(k,1900) = lu(k,1900) - lu(k,762) * lu(k,1881) + lu(k,1907) = lu(k,1907) - lu(k,763) * lu(k,1881) + lu(k,1920) = lu(k,1920) - lu(k,764) * lu(k,1881) + lu(k,1923) = lu(k,1923) - lu(k,765) * lu(k,1881) + lu(k,1924) = lu(k,1924) - lu(k,766) * lu(k,1881) + lu(k,1925) = lu(k,1925) - lu(k,767) * lu(k,1881) + lu(k,1927) = lu(k,1927) - lu(k,768) * lu(k,1881) + lu(k,1952) = lu(k,1952) - lu(k,762) * lu(k,1945) + lu(k,1954) = - lu(k,763) * lu(k,1945) + lu(k,1964) = lu(k,1964) - lu(k,764) * lu(k,1945) + lu(k,1967) = lu(k,1967) - lu(k,765) * lu(k,1945) + lu(k,1968) = lu(k,1968) - lu(k,766) * lu(k,1945) + lu(k,1969) = lu(k,1969) - lu(k,767) * lu(k,1945) + lu(k,1971) = lu(k,1971) - lu(k,768) * lu(k,1945) + lu(k,2090) = lu(k,2090) - lu(k,762) * lu(k,2069) + lu(k,2096) = lu(k,2096) - lu(k,763) * lu(k,2069) + lu(k,2110) = lu(k,2110) - lu(k,764) * lu(k,2069) + lu(k,2113) = lu(k,2113) - lu(k,765) * lu(k,2069) + lu(k,2114) = lu(k,2114) - lu(k,766) * lu(k,2069) + lu(k,2115) = lu(k,2115) - lu(k,767) * lu(k,2069) + lu(k,2117) = lu(k,2117) - lu(k,768) * lu(k,2069) + lu(k,770) = 1._r8 / lu(k,770) + lu(k,771) = lu(k,771) * lu(k,770) + lu(k,772) = lu(k,772) * lu(k,770) + lu(k,773) = lu(k,773) * lu(k,770) + lu(k,774) = lu(k,774) * lu(k,770) + lu(k,775) = lu(k,775) * lu(k,770) + lu(k,776) = lu(k,776) * lu(k,770) + lu(k,777) = lu(k,777) * lu(k,770) + lu(k,778) = lu(k,778) * lu(k,770) + lu(k,1027) = lu(k,1027) - lu(k,771) * lu(k,1022) + lu(k,1029) = - lu(k,772) * lu(k,1022) + lu(k,1033) = lu(k,1033) - lu(k,773) * lu(k,1022) + lu(k,1034) = lu(k,1034) - lu(k,774) * lu(k,1022) + lu(k,1037) = - lu(k,775) * lu(k,1022) + lu(k,1038) = - lu(k,776) * lu(k,1022) + lu(k,1039) = lu(k,1039) - lu(k,777) * lu(k,1022) + lu(k,1042) = lu(k,1042) - lu(k,778) * lu(k,1022) + lu(k,1668) = lu(k,1668) - lu(k,771) * lu(k,1643) + lu(k,1673) = lu(k,1673) - lu(k,772) * lu(k,1643) + lu(k,1691) = lu(k,1691) - lu(k,773) * lu(k,1643) + lu(k,1693) = lu(k,1693) - lu(k,774) * lu(k,1643) + lu(k,1697) = lu(k,1697) - lu(k,775) * lu(k,1643) + lu(k,1698) = lu(k,1698) - lu(k,776) * lu(k,1643) + lu(k,1700) = lu(k,1700) - lu(k,777) * lu(k,1643) + lu(k,1705) = lu(k,1705) - lu(k,778) * lu(k,1643) + lu(k,1897) = lu(k,1897) - lu(k,771) * lu(k,1882) + lu(k,1902) = lu(k,1902) - lu(k,772) * lu(k,1882) + lu(k,1918) = lu(k,1918) - lu(k,773) * lu(k,1882) + lu(k,1920) = lu(k,1920) - lu(k,774) * lu(k,1882) + lu(k,1924) = lu(k,1924) - lu(k,775) * lu(k,1882) + lu(k,1925) = lu(k,1925) - lu(k,776) * lu(k,1882) + lu(k,1927) = lu(k,1927) - lu(k,777) * lu(k,1882) + lu(k,1932) = - lu(k,778) * lu(k,1882) + lu(k,2087) = lu(k,2087) - lu(k,771) * lu(k,2070) + lu(k,2092) = lu(k,2092) - lu(k,772) * lu(k,2070) + lu(k,2108) = lu(k,2108) - lu(k,773) * lu(k,2070) + lu(k,2110) = lu(k,2110) - lu(k,774) * lu(k,2070) + lu(k,2114) = lu(k,2114) - lu(k,775) * lu(k,2070) + lu(k,2115) = lu(k,2115) - lu(k,776) * lu(k,2070) + lu(k,2117) = lu(k,2117) - lu(k,777) * lu(k,2070) + lu(k,2122) = lu(k,2122) - lu(k,778) * lu(k,2070) + lu(k,780) = 1._r8 / lu(k,780) + lu(k,781) = lu(k,781) * lu(k,780) + lu(k,782) = lu(k,782) * lu(k,780) + lu(k,783) = lu(k,783) * lu(k,780) + lu(k,784) = lu(k,784) * lu(k,780) + lu(k,785) = lu(k,785) * lu(k,780) + lu(k,786) = lu(k,786) * lu(k,780) + lu(k,787) = lu(k,787) * lu(k,780) + lu(k,1958) = lu(k,1958) - lu(k,781) * lu(k,1946) + lu(k,1964) = lu(k,1964) - lu(k,782) * lu(k,1946) + lu(k,1970) = - lu(k,783) * lu(k,1946) + lu(k,1972) = - lu(k,784) * lu(k,1946) + lu(k,1973) = lu(k,1973) - lu(k,785) * lu(k,1946) + lu(k,1974) = lu(k,1974) - lu(k,786) * lu(k,1946) + lu(k,1976) = lu(k,1976) - lu(k,787) * lu(k,1946) + lu(k,2104) = lu(k,2104) - lu(k,781) * lu(k,2071) + lu(k,2110) = lu(k,2110) - lu(k,782) * lu(k,2071) + lu(k,2116) = lu(k,2116) - lu(k,783) * lu(k,2071) + lu(k,2118) = lu(k,2118) - lu(k,784) * lu(k,2071) + lu(k,2119) = lu(k,2119) - lu(k,785) * lu(k,2071) + lu(k,2120) = lu(k,2120) - lu(k,786) * lu(k,2071) + lu(k,2122) = lu(k,2122) - lu(k,787) * lu(k,2071) + lu(k,2128) = lu(k,2128) - lu(k,781) * lu(k,2125) + lu(k,2133) = lu(k,2133) - lu(k,782) * lu(k,2125) + lu(k,2139) = lu(k,2139) - lu(k,783) * lu(k,2125) + lu(k,2141) = lu(k,2141) - lu(k,784) * lu(k,2125) + lu(k,2142) = - lu(k,785) * lu(k,2125) + lu(k,2143) = lu(k,2143) - lu(k,786) * lu(k,2125) + lu(k,2145) = lu(k,2145) - lu(k,787) * lu(k,2125) + lu(k,2152) = lu(k,2152) - lu(k,781) * lu(k,2149) + lu(k,2157) = lu(k,2157) - lu(k,782) * lu(k,2149) + lu(k,2163) = lu(k,2163) - lu(k,783) * lu(k,2149) + lu(k,2165) = - lu(k,784) * lu(k,2149) + lu(k,2166) = lu(k,2166) - lu(k,785) * lu(k,2149) + lu(k,2167) = lu(k,2167) - lu(k,786) * lu(k,2149) + lu(k,2169) = - lu(k,787) * lu(k,2149) + lu(k,2182) = lu(k,2182) - lu(k,781) * lu(k,2174) + lu(k,2188) = lu(k,2188) - lu(k,782) * lu(k,2174) + lu(k,2194) = lu(k,2194) - lu(k,783) * lu(k,2174) + lu(k,2196) = lu(k,2196) - lu(k,784) * lu(k,2174) + lu(k,2197) = lu(k,2197) - lu(k,785) * lu(k,2174) + lu(k,2198) = lu(k,2198) - lu(k,786) * lu(k,2174) + lu(k,2200) = lu(k,2200) - lu(k,787) * lu(k,2174) + 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,789) = 1._r8 / lu(k,789) + lu(k,790) = lu(k,790) * lu(k,789) + lu(k,791) = lu(k,791) * lu(k,789) + lu(k,792) = lu(k,792) * lu(k,789) + lu(k,793) = lu(k,793) * lu(k,789) + lu(k,794) = lu(k,794) * lu(k,789) + lu(k,795) = lu(k,795) * lu(k,789) + lu(k,796) = lu(k,796) * lu(k,789) + lu(k,797) = lu(k,797) * lu(k,789) + lu(k,798) = lu(k,798) * lu(k,789) + lu(k,1658) = lu(k,1658) - lu(k,790) * lu(k,1644) + lu(k,1668) = lu(k,1668) - lu(k,791) * lu(k,1644) + lu(k,1691) = lu(k,1691) - lu(k,792) * lu(k,1644) + lu(k,1693) = lu(k,1693) - lu(k,793) * lu(k,1644) + lu(k,1696) = lu(k,1696) - lu(k,794) * lu(k,1644) + lu(k,1697) = lu(k,1697) - lu(k,795) * lu(k,1644) + lu(k,1698) = lu(k,1698) - lu(k,796) * lu(k,1644) + lu(k,1700) = lu(k,1700) - lu(k,797) * lu(k,1644) + lu(k,1705) = lu(k,1705) - lu(k,798) * lu(k,1644) + lu(k,1801) = lu(k,1801) - lu(k,790) * lu(k,1795) + lu(k,1807) = lu(k,1807) - lu(k,791) * lu(k,1795) + lu(k,1826) = lu(k,1826) - lu(k,792) * lu(k,1795) + lu(k,1828) = lu(k,1828) - lu(k,793) * lu(k,1795) + lu(k,1831) = lu(k,1831) - lu(k,794) * lu(k,1795) + lu(k,1832) = lu(k,1832) - lu(k,795) * lu(k,1795) + lu(k,1833) = lu(k,1833) - lu(k,796) * lu(k,1795) + lu(k,1835) = lu(k,1835) - lu(k,797) * lu(k,1795) + lu(k,1840) = lu(k,1840) - lu(k,798) * lu(k,1795) + lu(k,1890) = lu(k,1890) - lu(k,790) * lu(k,1883) + lu(k,1897) = lu(k,1897) - lu(k,791) * lu(k,1883) + lu(k,1918) = lu(k,1918) - lu(k,792) * lu(k,1883) + lu(k,1920) = lu(k,1920) - lu(k,793) * lu(k,1883) + lu(k,1923) = lu(k,1923) - lu(k,794) * lu(k,1883) + lu(k,1924) = lu(k,1924) - lu(k,795) * lu(k,1883) + lu(k,1925) = lu(k,1925) - lu(k,796) * lu(k,1883) + lu(k,1927) = lu(k,1927) - lu(k,797) * lu(k,1883) + lu(k,1932) = lu(k,1932) - lu(k,798) * lu(k,1883) + lu(k,2081) = lu(k,2081) - lu(k,790) * lu(k,2072) + lu(k,2087) = lu(k,2087) - lu(k,791) * lu(k,2072) + lu(k,2108) = lu(k,2108) - lu(k,792) * lu(k,2072) + lu(k,2110) = lu(k,2110) - lu(k,793) * lu(k,2072) + lu(k,2113) = lu(k,2113) - lu(k,794) * lu(k,2072) + lu(k,2114) = lu(k,2114) - lu(k,795) * lu(k,2072) + lu(k,2115) = lu(k,2115) - lu(k,796) * lu(k,2072) + lu(k,2117) = lu(k,2117) - lu(k,797) * lu(k,2072) + lu(k,2122) = lu(k,2122) - lu(k,798) * lu(k,2072) + lu(k,799) = 1._r8 / lu(k,799) + lu(k,800) = lu(k,800) * lu(k,799) + lu(k,801) = lu(k,801) * lu(k,799) + lu(k,802) = lu(k,802) * lu(k,799) + lu(k,827) = lu(k,827) - lu(k,800) * lu(k,824) + lu(k,828) = lu(k,828) - lu(k,801) * lu(k,824) + lu(k,832) = lu(k,832) - lu(k,802) * lu(k,824) + lu(k,918) = lu(k,918) - lu(k,800) * lu(k,913) + lu(k,919) = lu(k,919) - lu(k,801) * lu(k,913) + lu(k,923) = lu(k,923) - lu(k,802) * lu(k,913) + lu(k,1052) = lu(k,1052) - lu(k,800) * lu(k,1045) + lu(k,1053) = lu(k,1053) - lu(k,801) * lu(k,1045) + lu(k,1058) = lu(k,1058) - lu(k,802) * lu(k,1045) + lu(k,1116) = lu(k,1116) - lu(k,800) * lu(k,1106) + lu(k,1117) = lu(k,1117) - lu(k,801) * lu(k,1106) + lu(k,1121) = lu(k,1121) - lu(k,802) * lu(k,1106) + lu(k,1135) = lu(k,1135) - lu(k,800) * lu(k,1130) + lu(k,1136) = lu(k,1136) - lu(k,801) * lu(k,1130) + lu(k,1140) = lu(k,1140) - lu(k,802) * lu(k,1130) + lu(k,1178) = lu(k,1178) - lu(k,800) * lu(k,1169) + lu(k,1179) = lu(k,1179) - lu(k,801) * lu(k,1169) + lu(k,1184) = lu(k,1184) - lu(k,802) * lu(k,1169) + lu(k,1201) = lu(k,1201) - lu(k,800) * lu(k,1189) + lu(k,1202) = lu(k,1202) - lu(k,801) * lu(k,1189) + lu(k,1207) = lu(k,1207) - lu(k,802) * lu(k,1189) + lu(k,1264) = lu(k,1264) - lu(k,800) * lu(k,1249) + lu(k,1265) = lu(k,1265) - lu(k,801) * lu(k,1249) + lu(k,1270) = lu(k,1270) - lu(k,802) * lu(k,1249) + lu(k,1296) = lu(k,1296) - lu(k,800) * lu(k,1279) + lu(k,1297) = lu(k,1297) - lu(k,801) * lu(k,1279) + lu(k,1302) = lu(k,1302) - lu(k,802) * lu(k,1279) + lu(k,1317) = lu(k,1317) - lu(k,800) * lu(k,1307) + lu(k,1318) = lu(k,1318) - lu(k,801) * lu(k,1307) + lu(k,1323) = lu(k,1323) - lu(k,802) * lu(k,1307) + lu(k,1691) = lu(k,1691) - lu(k,800) * lu(k,1645) + lu(k,1693) = lu(k,1693) - lu(k,801) * lu(k,1645) + lu(k,1700) = lu(k,1700) - lu(k,802) * lu(k,1645) + lu(k,1826) = lu(k,1826) - lu(k,800) * lu(k,1796) + lu(k,1828) = lu(k,1828) - lu(k,801) * lu(k,1796) + lu(k,1835) = lu(k,1835) - lu(k,802) * lu(k,1796) + lu(k,803) = 1._r8 / lu(k,803) + lu(k,804) = lu(k,804) * lu(k,803) + lu(k,805) = lu(k,805) * lu(k,803) + lu(k,932) = - lu(k,804) * lu(k,930) + lu(k,935) = - lu(k,805) * lu(k,930) + lu(k,956) = lu(k,956) - lu(k,804) * lu(k,945) + lu(k,968) = - lu(k,805) * lu(k,945) + lu(k,982) = lu(k,982) - lu(k,804) * lu(k,980) + lu(k,985) = - lu(k,805) * lu(k,980) + lu(k,1006) = lu(k,1006) - lu(k,804) * lu(k,994) + lu(k,1018) = - lu(k,805) * lu(k,994) + lu(k,1028) = lu(k,1028) - lu(k,804) * lu(k,1023) + lu(k,1040) = - lu(k,805) * lu(k,1023) + lu(k,1062) = lu(k,1062) - lu(k,804) * lu(k,1059) + lu(k,1069) = - lu(k,805) * lu(k,1059) + lu(k,1099) = lu(k,1099) - lu(k,804) * lu(k,1096) + lu(k,1103) = - lu(k,805) * lu(k,1096) + lu(k,1112) = lu(k,1112) - lu(k,804) * lu(k,1107) + lu(k,1122) = - lu(k,805) * lu(k,1107) + lu(k,1125) = lu(k,1125) - lu(k,804) * lu(k,1124) + lu(k,1128) = - lu(k,805) * lu(k,1124) + lu(k,1173) = lu(k,1173) - lu(k,804) * lu(k,1170) + lu(k,1185) = - lu(k,805) * lu(k,1170) + lu(k,1252) = - lu(k,804) * lu(k,1250) + lu(k,1271) = - lu(k,805) * lu(k,1250) + lu(k,1330) = lu(k,1330) - lu(k,804) * lu(k,1326) + lu(k,1346) = - lu(k,805) * lu(k,1326) + lu(k,1353) = - lu(k,804) * lu(k,1352) + lu(k,1366) = - lu(k,805) * lu(k,1352) + lu(k,1377) = lu(k,1377) - lu(k,804) * lu(k,1373) + lu(k,1398) = - lu(k,805) * lu(k,1373) + lu(k,1430) = lu(k,1430) - lu(k,804) * lu(k,1428) + lu(k,1443) = lu(k,1443) - lu(k,805) * lu(k,1428) + lu(k,1671) = lu(k,1671) - lu(k,804) * lu(k,1646) + lu(k,1703) = lu(k,1703) - lu(k,805) * lu(k,1646) + lu(k,1810) = lu(k,1810) - lu(k,804) * lu(k,1797) + lu(k,1838) = - lu(k,805) * lu(k,1797) + lu(k,1900) = lu(k,1900) - lu(k,804) * lu(k,1884) + lu(k,1930) = lu(k,1930) - lu(k,805) * lu(k,1884) + lu(k,1952) = lu(k,1952) - lu(k,804) * lu(k,1947) + lu(k,1974) = lu(k,1974) - lu(k,805) * lu(k,1947) + lu(k,2090) = lu(k,2090) - lu(k,804) * lu(k,2073) + lu(k,2120) = lu(k,2120) - lu(k,805) * lu(k,2073) + lu(k,2230) = lu(k,2230) - lu(k,804) * lu(k,2214) + lu(k,2259) = lu(k,2259) - lu(k,805) * lu(k,2214) + lu(k,806) = 1._r8 / lu(k,806) + lu(k,807) = lu(k,807) * lu(k,806) + lu(k,808) = lu(k,808) * lu(k,806) + lu(k,809) = lu(k,809) * lu(k,806) + lu(k,810) = lu(k,810) * lu(k,806) + lu(k,811) = lu(k,811) * lu(k,806) + lu(k,812) = lu(k,812) * lu(k,806) + lu(k,813) = lu(k,813) * lu(k,806) + lu(k,1417) = lu(k,1417) - lu(k,807) * lu(k,1415) + lu(k,1418) = - lu(k,808) * lu(k,1415) + lu(k,1420) = - lu(k,809) * lu(k,1415) + lu(k,1421) = - lu(k,810) * lu(k,1415) + lu(k,1423) = lu(k,1423) - lu(k,811) * lu(k,1415) + lu(k,1424) = - lu(k,812) * lu(k,1415) + lu(k,1426) = - lu(k,813) * lu(k,1415) + lu(k,1483) = lu(k,1483) - lu(k,807) * lu(k,1479) + lu(k,1485) = lu(k,1485) - lu(k,808) * lu(k,1479) + lu(k,1488) = - lu(k,809) * lu(k,1479) + lu(k,1489) = lu(k,1489) - lu(k,810) * lu(k,1479) + lu(k,1497) = - lu(k,811) * lu(k,1479) + lu(k,1498) = lu(k,1498) - lu(k,812) * lu(k,1479) + lu(k,1500) = lu(k,1500) - lu(k,813) * lu(k,1479) + lu(k,1523) = lu(k,1523) - lu(k,807) * lu(k,1520) + lu(k,1525) = lu(k,1525) - lu(k,808) * lu(k,1520) + lu(k,1528) = lu(k,1528) - lu(k,809) * lu(k,1520) + lu(k,1529) = lu(k,1529) - lu(k,810) * lu(k,1520) + lu(k,1538) = lu(k,1538) - lu(k,811) * lu(k,1520) + lu(k,1539) = lu(k,1539) - lu(k,812) * lu(k,1520) + lu(k,1541) = lu(k,1541) - lu(k,813) * lu(k,1520) + lu(k,1687) = lu(k,1687) - lu(k,807) * lu(k,1647) + lu(k,1689) = lu(k,1689) - lu(k,808) * lu(k,1647) + lu(k,1692) = lu(k,1692) - lu(k,809) * lu(k,1647) + lu(k,1693) = lu(k,1693) - lu(k,810) * lu(k,1647) + lu(k,1702) = lu(k,1702) - lu(k,811) * lu(k,1647) + lu(k,1703) = lu(k,1703) - lu(k,812) * lu(k,1647) + lu(k,1705) = lu(k,1705) - lu(k,813) * lu(k,1647) + lu(k,2104) = lu(k,2104) - lu(k,807) * lu(k,2074) + lu(k,2106) = lu(k,2106) - lu(k,808) * lu(k,2074) + lu(k,2109) = - lu(k,809) * lu(k,2074) + lu(k,2110) = lu(k,2110) - lu(k,810) * lu(k,2074) + lu(k,2119) = lu(k,2119) - lu(k,811) * lu(k,2074) + lu(k,2120) = lu(k,2120) - lu(k,812) * lu(k,2074) + lu(k,2122) = lu(k,2122) - lu(k,813) * lu(k,2074) + lu(k,2182) = lu(k,2182) - lu(k,807) * lu(k,2175) + lu(k,2184) = lu(k,2184) - lu(k,808) * lu(k,2175) + lu(k,2187) = - lu(k,809) * lu(k,2175) + lu(k,2188) = lu(k,2188) - lu(k,810) * lu(k,2175) + lu(k,2197) = lu(k,2197) - lu(k,811) * lu(k,2175) + lu(k,2198) = lu(k,2198) - lu(k,812) * lu(k,2175) + lu(k,2200) = lu(k,2200) - lu(k,813) * lu(k,2175) + 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,815) = 1._r8 / lu(k,815) + lu(k,816) = lu(k,816) * lu(k,815) + lu(k,817) = lu(k,817) * lu(k,815) + lu(k,818) = lu(k,818) * lu(k,815) + lu(k,819) = lu(k,819) * lu(k,815) + lu(k,820) = lu(k,820) * lu(k,815) + lu(k,821) = lu(k,821) * lu(k,815) + lu(k,903) = lu(k,903) - lu(k,816) * lu(k,900) + lu(k,904) = lu(k,904) - lu(k,817) * lu(k,900) + lu(k,907) = lu(k,907) - lu(k,818) * lu(k,900) + lu(k,908) = lu(k,908) - lu(k,819) * lu(k,900) + lu(k,909) = lu(k,909) - lu(k,820) * lu(k,900) + lu(k,910) = - lu(k,821) * lu(k,900) + lu(k,1693) = lu(k,1693) - lu(k,816) * lu(k,1648) + lu(k,1694) = lu(k,1694) - lu(k,817) * lu(k,1648) + lu(k,1699) = lu(k,1699) - lu(k,818) * lu(k,1648) + lu(k,1701) = lu(k,1701) - lu(k,819) * lu(k,1648) + lu(k,1703) = lu(k,1703) - lu(k,820) * lu(k,1648) + lu(k,1705) = lu(k,1705) - lu(k,821) * lu(k,1648) + lu(k,1719) = lu(k,1719) - lu(k,816) * lu(k,1710) + lu(k,1720) = lu(k,1720) - lu(k,817) * lu(k,1710) + lu(k,1725) = lu(k,1725) - lu(k,818) * lu(k,1710) + lu(k,1727) = lu(k,1727) - lu(k,819) * lu(k,1710) + lu(k,1729) = lu(k,1729) - lu(k,820) * lu(k,1710) + lu(k,1731) = - lu(k,821) * lu(k,1710) + lu(k,2003) = lu(k,2003) - lu(k,816) * lu(k,1987) + lu(k,2004) = lu(k,2004) - lu(k,817) * lu(k,1987) + lu(k,2009) = lu(k,2009) - lu(k,818) * lu(k,1987) + lu(k,2011) = lu(k,2011) - lu(k,819) * lu(k,1987) + lu(k,2013) = lu(k,2013) - lu(k,820) * lu(k,1987) + lu(k,2015) = lu(k,2015) - lu(k,821) * lu(k,1987) + lu(k,2110) = lu(k,2110) - lu(k,816) * lu(k,2075) + lu(k,2111) = lu(k,2111) - lu(k,817) * lu(k,2075) + lu(k,2116) = lu(k,2116) - lu(k,818) * lu(k,2075) + lu(k,2118) = lu(k,2118) - lu(k,819) * lu(k,2075) + lu(k,2120) = lu(k,2120) - lu(k,820) * lu(k,2075) + lu(k,2122) = lu(k,2122) - lu(k,821) * lu(k,2075) + lu(k,2133) = lu(k,2133) - lu(k,816) * lu(k,2126) + lu(k,2134) = lu(k,2134) - lu(k,817) * lu(k,2126) + lu(k,2139) = lu(k,2139) - lu(k,818) * lu(k,2126) + lu(k,2141) = lu(k,2141) - lu(k,819) * lu(k,2126) + lu(k,2143) = lu(k,2143) - lu(k,820) * lu(k,2126) + lu(k,2145) = lu(k,2145) - lu(k,821) * lu(k,2126) + lu(k,2188) = lu(k,2188) - lu(k,816) * lu(k,2176) + lu(k,2189) = lu(k,2189) - lu(k,817) * lu(k,2176) + lu(k,2194) = lu(k,2194) - lu(k,818) * lu(k,2176) + lu(k,2196) = lu(k,2196) - lu(k,819) * lu(k,2176) + lu(k,2198) = lu(k,2198) - lu(k,820) * lu(k,2176) + lu(k,2200) = lu(k,2200) - lu(k,821) * lu(k,2176) + lu(k,825) = 1._r8 / lu(k,825) + lu(k,826) = lu(k,826) * lu(k,825) + lu(k,827) = lu(k,827) * lu(k,825) + lu(k,828) = lu(k,828) * lu(k,825) + lu(k,829) = lu(k,829) * lu(k,825) + lu(k,830) = lu(k,830) * lu(k,825) + lu(k,831) = lu(k,831) * lu(k,825) + lu(k,832) = lu(k,832) * lu(k,825) + lu(k,891) = lu(k,891) - lu(k,826) * lu(k,888) + lu(k,893) = lu(k,893) - lu(k,827) * lu(k,888) + lu(k,894) = lu(k,894) - lu(k,828) * lu(k,888) + lu(k,895) = - lu(k,829) * lu(k,888) + lu(k,896) = lu(k,896) - lu(k,830) * lu(k,888) + lu(k,897) = lu(k,897) - lu(k,831) * lu(k,888) + lu(k,898) = lu(k,898) - lu(k,832) * lu(k,888) + lu(k,1668) = lu(k,1668) - lu(k,826) * lu(k,1649) + lu(k,1691) = lu(k,1691) - lu(k,827) * lu(k,1649) + lu(k,1693) = lu(k,1693) - lu(k,828) * lu(k,1649) + lu(k,1696) = lu(k,1696) - lu(k,829) * lu(k,1649) + lu(k,1697) = lu(k,1697) - lu(k,830) * lu(k,1649) + lu(k,1698) = lu(k,1698) - lu(k,831) * lu(k,1649) + lu(k,1700) = lu(k,1700) - lu(k,832) * lu(k,1649) + lu(k,1807) = lu(k,1807) - lu(k,826) * lu(k,1798) + lu(k,1826) = lu(k,1826) - lu(k,827) * lu(k,1798) + lu(k,1828) = lu(k,1828) - lu(k,828) * lu(k,1798) + lu(k,1831) = lu(k,1831) - lu(k,829) * lu(k,1798) + lu(k,1832) = lu(k,1832) - lu(k,830) * lu(k,1798) + lu(k,1833) = lu(k,1833) - lu(k,831) * lu(k,1798) + lu(k,1835) = lu(k,1835) - lu(k,832) * lu(k,1798) + lu(k,1897) = lu(k,1897) - lu(k,826) * lu(k,1885) + lu(k,1918) = lu(k,1918) - lu(k,827) * lu(k,1885) + lu(k,1920) = lu(k,1920) - lu(k,828) * lu(k,1885) + lu(k,1923) = lu(k,1923) - lu(k,829) * lu(k,1885) + lu(k,1924) = lu(k,1924) - lu(k,830) * lu(k,1885) + lu(k,1925) = lu(k,1925) - lu(k,831) * lu(k,1885) + lu(k,1927) = lu(k,1927) - lu(k,832) * lu(k,1885) + lu(k,1992) = - lu(k,826) * lu(k,1988) + lu(k,2001) = lu(k,2001) - lu(k,827) * lu(k,1988) + lu(k,2003) = lu(k,2003) - lu(k,828) * lu(k,1988) + lu(k,2006) = lu(k,2006) - lu(k,829) * lu(k,1988) + lu(k,2007) = lu(k,2007) - lu(k,830) * lu(k,1988) + lu(k,2008) = lu(k,2008) - lu(k,831) * lu(k,1988) + lu(k,2010) = lu(k,2010) - lu(k,832) * lu(k,1988) + lu(k,2087) = lu(k,2087) - lu(k,826) * lu(k,2076) + lu(k,2108) = lu(k,2108) - lu(k,827) * lu(k,2076) + lu(k,2110) = lu(k,2110) - lu(k,828) * lu(k,2076) + lu(k,2113) = lu(k,2113) - lu(k,829) * lu(k,2076) + lu(k,2114) = lu(k,2114) - lu(k,830) * lu(k,2076) + lu(k,2115) = lu(k,2115) - lu(k,831) * lu(k,2076) + lu(k,2117) = lu(k,2117) - lu(k,832) * lu(k,2076) + lu(k,836) = 1._r8 / lu(k,836) + lu(k,837) = lu(k,837) * lu(k,836) + lu(k,838) = lu(k,838) * lu(k,836) + lu(k,839) = lu(k,839) * lu(k,836) + lu(k,840) = lu(k,840) * lu(k,836) + lu(k,841) = lu(k,841) * lu(k,836) + lu(k,842) = lu(k,842) * lu(k,836) + lu(k,843) = lu(k,843) * lu(k,836) + lu(k,844) = lu(k,844) * lu(k,836) + lu(k,845) = lu(k,845) * lu(k,836) + lu(k,846) = lu(k,846) * lu(k,836) + lu(k,847) = lu(k,847) * lu(k,836) + lu(k,848) = lu(k,848) * lu(k,836) + lu(k,849) = lu(k,849) * lu(k,836) + lu(k,850) = lu(k,850) * lu(k,836) + lu(k,851) = lu(k,851) * lu(k,836) + lu(k,1659) = lu(k,1659) - lu(k,837) * lu(k,1650) + lu(k,1664) = lu(k,1664) - lu(k,838) * lu(k,1650) + lu(k,1671) = lu(k,1671) - lu(k,839) * lu(k,1650) + lu(k,1676) = - lu(k,840) * lu(k,1650) + lu(k,1677) = lu(k,1677) - lu(k,841) * lu(k,1650) + lu(k,1680) = lu(k,1680) - lu(k,842) * lu(k,1650) + lu(k,1681) = lu(k,1681) - lu(k,843) * lu(k,1650) + lu(k,1683) = lu(k,1683) - lu(k,844) * lu(k,1650) + lu(k,1685) = lu(k,1685) - lu(k,845) * lu(k,1650) + lu(k,1691) = lu(k,1691) - lu(k,846) * lu(k,1650) + lu(k,1693) = lu(k,1693) - lu(k,847) * lu(k,1650) + lu(k,1695) = lu(k,1695) - lu(k,848) * lu(k,1650) + lu(k,1696) = lu(k,1696) - lu(k,849) * lu(k,1650) + lu(k,1700) = lu(k,1700) - lu(k,850) * lu(k,1650) + lu(k,1704) = lu(k,1704) - lu(k,851) * lu(k,1650) + lu(k,1743) = - lu(k,837) * lu(k,1739) + lu(k,1748) = lu(k,1748) - lu(k,838) * lu(k,1739) + lu(k,1755) = lu(k,1755) - lu(k,839) * lu(k,1739) + lu(k,1760) = lu(k,1760) - lu(k,840) * lu(k,1739) + lu(k,1761) = lu(k,1761) - lu(k,841) * lu(k,1739) + lu(k,1764) = lu(k,1764) - lu(k,842) * lu(k,1739) + lu(k,1765) = lu(k,1765) - lu(k,843) * lu(k,1739) + lu(k,1767) = lu(k,1767) - lu(k,844) * lu(k,1739) + lu(k,1769) = lu(k,1769) - lu(k,845) * lu(k,1739) + lu(k,1774) = lu(k,1774) - lu(k,846) * lu(k,1739) + lu(k,1776) = lu(k,1776) - lu(k,847) * lu(k,1739) + lu(k,1778) = lu(k,1778) - lu(k,848) * lu(k,1739) + lu(k,1779) = - lu(k,849) * lu(k,1739) + lu(k,1783) = lu(k,1783) - lu(k,850) * lu(k,1739) + lu(k,1787) = - lu(k,851) * lu(k,1739) + lu(k,2219) = lu(k,2219) - lu(k,837) * lu(k,2215) + lu(k,2224) = lu(k,2224) - lu(k,838) * lu(k,2215) + lu(k,2230) = lu(k,2230) - lu(k,839) * lu(k,2215) + lu(k,2233) = - lu(k,840) * lu(k,2215) + lu(k,2234) = lu(k,2234) - lu(k,841) * lu(k,2215) + lu(k,2237) = - lu(k,842) * lu(k,2215) + lu(k,2238) = - lu(k,843) * lu(k,2215) + lu(k,2240) = lu(k,2240) - lu(k,844) * lu(k,2215) + lu(k,2242) = lu(k,2242) - lu(k,845) * lu(k,2215) + lu(k,2247) = lu(k,2247) - lu(k,846) * lu(k,2215) + lu(k,2249) = lu(k,2249) - lu(k,847) * lu(k,2215) + lu(k,2251) = lu(k,2251) - lu(k,848) * lu(k,2215) + lu(k,2252) = lu(k,2252) - lu(k,849) * lu(k,2215) + lu(k,2256) = lu(k,2256) - lu(k,850) * lu(k,2215) + lu(k,2260) = lu(k,2260) - lu(k,851) * lu(k,2215) + lu(k,853) = 1._r8 / lu(k,853) + lu(k,854) = lu(k,854) * lu(k,853) + lu(k,855) = lu(k,855) * lu(k,853) + lu(k,856) = lu(k,856) * lu(k,853) + lu(k,857) = lu(k,857) * lu(k,853) + lu(k,858) = lu(k,858) * lu(k,853) + lu(k,1234) = lu(k,1234) - lu(k,854) * lu(k,1233) + lu(k,1237) = lu(k,1237) - lu(k,855) * lu(k,1233) + lu(k,1242) = - lu(k,856) * lu(k,1233) + lu(k,1244) = lu(k,1244) - lu(k,857) * lu(k,1233) + lu(k,1246) = - lu(k,858) * lu(k,1233) + lu(k,1679) = lu(k,1679) - lu(k,854) * lu(k,1651) + lu(k,1693) = lu(k,1693) - lu(k,855) * lu(k,1651) + lu(k,1700) = lu(k,1700) - lu(k,856) * lu(k,1651) + lu(k,1703) = lu(k,1703) - lu(k,857) * lu(k,1651) + lu(k,1705) = lu(k,1705) - lu(k,858) * lu(k,1651) + lu(k,1713) = lu(k,1713) - lu(k,854) * lu(k,1711) + lu(k,1719) = lu(k,1719) - lu(k,855) * lu(k,1711) + lu(k,1726) = lu(k,1726) - lu(k,856) * lu(k,1711) + lu(k,1729) = lu(k,1729) - lu(k,857) * lu(k,1711) + lu(k,1731) = lu(k,1731) - lu(k,858) * lu(k,1711) + lu(k,1763) = - lu(k,854) * lu(k,1740) + lu(k,1776) = lu(k,1776) - lu(k,855) * lu(k,1740) + lu(k,1783) = lu(k,1783) - lu(k,856) * lu(k,1740) + lu(k,1786) = lu(k,1786) - lu(k,857) * lu(k,1740) + lu(k,1788) = - lu(k,858) * lu(k,1740) + lu(k,1955) = lu(k,1955) - lu(k,854) * lu(k,1948) + lu(k,1964) = lu(k,1964) - lu(k,855) * lu(k,1948) + lu(k,1971) = lu(k,1971) - lu(k,856) * lu(k,1948) + lu(k,1974) = lu(k,1974) - lu(k,857) * lu(k,1948) + lu(k,1976) = lu(k,1976) - lu(k,858) * lu(k,1948) + lu(k,2151) = lu(k,2151) - lu(k,854) * lu(k,2150) + lu(k,2157) = lu(k,2157) - lu(k,855) * lu(k,2150) + lu(k,2164) = lu(k,2164) - lu(k,856) * lu(k,2150) + lu(k,2167) = lu(k,2167) - lu(k,857) * lu(k,2150) + lu(k,2169) = lu(k,2169) - lu(k,858) * lu(k,2150) + lu(k,2180) = lu(k,2180) - lu(k,854) * lu(k,2177) + lu(k,2188) = lu(k,2188) - lu(k,855) * lu(k,2177) + lu(k,2195) = lu(k,2195) - lu(k,856) * lu(k,2177) + lu(k,2198) = lu(k,2198) - lu(k,857) * lu(k,2177) + lu(k,2200) = lu(k,2200) - lu(k,858) * lu(k,2177) + lu(k,2236) = lu(k,2236) - lu(k,854) * lu(k,2216) + lu(k,2249) = lu(k,2249) - lu(k,855) * lu(k,2216) + lu(k,2256) = lu(k,2256) - lu(k,856) * lu(k,2216) + lu(k,2259) = lu(k,2259) - lu(k,857) * lu(k,2216) + lu(k,2261) = lu(k,2261) - lu(k,858) * lu(k,2216) + lu(k,2267) = - lu(k,854) * lu(k,2265) + lu(k,2275) = lu(k,2275) - lu(k,855) * lu(k,2265) + lu(k,2282) = - lu(k,856) * lu(k,2265) + lu(k,2285) = lu(k,2285) - lu(k,857) * lu(k,2265) + lu(k,2287) = lu(k,2287) - lu(k,858) * lu(k,2265) + end do + end subroutine lu_fac18 + subroutine lu_fac19( 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,859) = 1._r8 / lu(k,859) + lu(k,860) = lu(k,860) * lu(k,859) + lu(k,861) = lu(k,861) * lu(k,859) + lu(k,862) = lu(k,862) * lu(k,859) + lu(k,863) = lu(k,863) * lu(k,859) + lu(k,864) = lu(k,864) * lu(k,859) + lu(k,1030) = - lu(k,860) * lu(k,1024) + lu(k,1031) = - lu(k,861) * lu(k,1024) + lu(k,1033) = lu(k,1033) - lu(k,862) * lu(k,1024) + lu(k,1034) = lu(k,1034) - lu(k,863) * lu(k,1024) + lu(k,1038) = lu(k,1038) - lu(k,864) * lu(k,1024) + lu(k,1077) = - lu(k,860) * lu(k,1072) + lu(k,1078) = - lu(k,861) * lu(k,1072) + lu(k,1080) = - lu(k,862) * lu(k,1072) + lu(k,1081) = lu(k,1081) - lu(k,863) * lu(k,1072) + lu(k,1084) = lu(k,1084) - lu(k,864) * lu(k,1072) + lu(k,1197) = - lu(k,860) * lu(k,1190) + lu(k,1199) = lu(k,1199) - lu(k,861) * lu(k,1190) + lu(k,1201) = lu(k,1201) - lu(k,862) * lu(k,1190) + lu(k,1202) = lu(k,1202) - lu(k,863) * lu(k,1190) + lu(k,1206) = lu(k,1206) - lu(k,864) * lu(k,1190) + lu(k,1289) = lu(k,1289) - lu(k,860) * lu(k,1280) + lu(k,1294) = lu(k,1294) - lu(k,861) * lu(k,1280) + lu(k,1296) = lu(k,1296) - lu(k,862) * lu(k,1280) + lu(k,1297) = lu(k,1297) - lu(k,863) * lu(k,1280) + lu(k,1301) = lu(k,1301) - lu(k,864) * lu(k,1280) + lu(k,1678) = lu(k,1678) - lu(k,860) * lu(k,1652) + lu(k,1685) = lu(k,1685) - lu(k,861) * lu(k,1652) + lu(k,1691) = lu(k,1691) - lu(k,862) * lu(k,1652) + lu(k,1693) = lu(k,1693) - lu(k,863) * lu(k,1652) + lu(k,1698) = lu(k,1698) - lu(k,864) * lu(k,1652) + lu(k,1762) = lu(k,1762) - lu(k,860) * lu(k,1741) + lu(k,1769) = lu(k,1769) - lu(k,861) * lu(k,1741) + lu(k,1774) = lu(k,1774) - lu(k,862) * lu(k,1741) + lu(k,1776) = lu(k,1776) - lu(k,863) * lu(k,1741) + lu(k,1781) = lu(k,1781) - lu(k,864) * lu(k,1741) + lu(k,1816) = lu(k,1816) - lu(k,860) * lu(k,1799) + lu(k,1822) = lu(k,1822) - lu(k,861) * lu(k,1799) + lu(k,1826) = lu(k,1826) - lu(k,862) * lu(k,1799) + lu(k,1828) = lu(k,1828) - lu(k,863) * lu(k,1799) + lu(k,1833) = lu(k,1833) - lu(k,864) * lu(k,1799) + lu(k,1907) = lu(k,1907) - lu(k,860) * lu(k,1886) + lu(k,1913) = lu(k,1913) - lu(k,861) * lu(k,1886) + lu(k,1918) = lu(k,1918) - lu(k,862) * lu(k,1886) + lu(k,1920) = lu(k,1920) - lu(k,863) * lu(k,1886) + lu(k,1925) = lu(k,1925) - lu(k,864) * lu(k,1886) + lu(k,2096) = lu(k,2096) - lu(k,860) * lu(k,2077) + lu(k,2102) = lu(k,2102) - lu(k,861) * lu(k,2077) + lu(k,2108) = lu(k,2108) - lu(k,862) * lu(k,2077) + lu(k,2110) = lu(k,2110) - lu(k,863) * lu(k,2077) + lu(k,2115) = lu(k,2115) - lu(k,864) * lu(k,2077) + lu(k,866) = 1._r8 / lu(k,866) + lu(k,867) = lu(k,867) * lu(k,866) + lu(k,868) = lu(k,868) * lu(k,866) + lu(k,869) = lu(k,869) * lu(k,866) + lu(k,870) = lu(k,870) * lu(k,866) + lu(k,871) = lu(k,871) * lu(k,866) + lu(k,872) = lu(k,872) * lu(k,866) + lu(k,873) = lu(k,873) * lu(k,866) + lu(k,874) = lu(k,874) * lu(k,866) + lu(k,1403) = lu(k,1403) - lu(k,867) * lu(k,1402) + lu(k,1404) = - lu(k,868) * lu(k,1402) + lu(k,1405) = lu(k,1405) - lu(k,869) * lu(k,1402) + lu(k,1406) = - lu(k,870) * lu(k,1402) + lu(k,1408) = lu(k,1408) - lu(k,871) * lu(k,1402) + lu(k,1409) = - lu(k,872) * lu(k,1402) + lu(k,1410) = - lu(k,873) * lu(k,1402) + lu(k,1414) = lu(k,1414) - lu(k,874) * lu(k,1402) + lu(k,1431) = lu(k,1431) - lu(k,867) * lu(k,1429) + lu(k,1432) = lu(k,1432) - lu(k,868) * lu(k,1429) + lu(k,1433) = lu(k,1433) - lu(k,869) * lu(k,1429) + lu(k,1434) = - lu(k,870) * lu(k,1429) + lu(k,1437) = lu(k,1437) - lu(k,871) * lu(k,1429) + lu(k,1438) = - lu(k,872) * lu(k,1429) + lu(k,1439) = lu(k,1439) - lu(k,873) * lu(k,1429) + lu(k,1444) = lu(k,1444) - lu(k,874) * lu(k,1429) + lu(k,1462) = - lu(k,867) * lu(k,1461) + lu(k,1463) = - lu(k,868) * lu(k,1461) + lu(k,1464) = lu(k,1464) - lu(k,869) * lu(k,1461) + lu(k,1465) = lu(k,1465) - lu(k,870) * lu(k,1461) + lu(k,1468) = lu(k,1468) - lu(k,871) * lu(k,1461) + lu(k,1469) = lu(k,1469) - lu(k,872) * lu(k,1461) + lu(k,1470) = - lu(k,873) * lu(k,1461) + lu(k,1477) = lu(k,1477) - lu(k,874) * lu(k,1461) + lu(k,1522) = lu(k,1522) - lu(k,867) * lu(k,1521) + lu(k,1524) = lu(k,1524) - lu(k,868) * lu(k,1521) + lu(k,1525) = lu(k,1525) - lu(k,869) * lu(k,1521) + lu(k,1526) = - lu(k,870) * lu(k,1521) + lu(k,1529) = lu(k,1529) - lu(k,871) * lu(k,1521) + lu(k,1531) = - lu(k,872) * lu(k,1521) + lu(k,1532) = lu(k,1532) - lu(k,873) * lu(k,1521) + lu(k,1541) = lu(k,1541) - lu(k,874) * lu(k,1521) + lu(k,1686) = lu(k,1686) - lu(k,867) * lu(k,1653) + lu(k,1688) = lu(k,1688) - lu(k,868) * lu(k,1653) + lu(k,1689) = lu(k,1689) - lu(k,869) * lu(k,1653) + lu(k,1690) = lu(k,1690) - lu(k,870) * lu(k,1653) + lu(k,1693) = lu(k,1693) - lu(k,871) * lu(k,1653) + lu(k,1695) = lu(k,1695) - lu(k,872) * lu(k,1653) + lu(k,1696) = lu(k,1696) - lu(k,873) * lu(k,1653) + lu(k,1705) = lu(k,1705) - lu(k,874) * lu(k,1653) + lu(k,2268) = lu(k,2268) - lu(k,867) * lu(k,2266) + lu(k,2270) = - lu(k,868) * lu(k,2266) + lu(k,2271) = lu(k,2271) - lu(k,869) * lu(k,2266) + lu(k,2272) = - lu(k,870) * lu(k,2266) + lu(k,2275) = lu(k,2275) - lu(k,871) * lu(k,2266) + lu(k,2277) = - lu(k,872) * lu(k,2266) + lu(k,2278) = - lu(k,873) * lu(k,2266) + lu(k,2287) = lu(k,2287) - lu(k,874) * lu(k,2266) + lu(k,875) = 1._r8 / lu(k,875) + lu(k,876) = lu(k,876) * lu(k,875) + lu(k,877) = lu(k,877) * lu(k,875) + lu(k,878) = lu(k,878) * lu(k,875) + lu(k,879) = lu(k,879) * lu(k,875) + lu(k,880) = lu(k,880) * lu(k,875) + lu(k,881) = lu(k,881) * lu(k,875) + lu(k,882) = lu(k,882) * lu(k,875) + lu(k,883) = lu(k,883) * lu(k,875) + lu(k,1074) = lu(k,1074) - lu(k,876) * lu(k,1073) + lu(k,1076) = lu(k,1076) - lu(k,877) * lu(k,1073) + lu(k,1077) = lu(k,1077) - lu(k,878) * lu(k,1073) + lu(k,1081) = lu(k,1081) - lu(k,879) * lu(k,1073) + lu(k,1082) = - lu(k,880) * lu(k,1073) + lu(k,1083) = - lu(k,881) * lu(k,1073) + lu(k,1084) = lu(k,1084) - lu(k,882) * lu(k,1073) + lu(k,1085) = lu(k,1085) - lu(k,883) * lu(k,1073) + lu(k,1282) = lu(k,1282) - lu(k,876) * lu(k,1281) + lu(k,1284) = lu(k,1284) - lu(k,877) * lu(k,1281) + lu(k,1289) = lu(k,1289) - lu(k,878) * lu(k,1281) + lu(k,1297) = lu(k,1297) - lu(k,879) * lu(k,1281) + lu(k,1299) = lu(k,1299) - lu(k,880) * lu(k,1281) + lu(k,1300) = lu(k,1300) - lu(k,881) * lu(k,1281) + lu(k,1301) = lu(k,1301) - lu(k,882) * lu(k,1281) + lu(k,1302) = lu(k,1302) - lu(k,883) * lu(k,1281) + lu(k,1662) = lu(k,1662) - lu(k,876) * lu(k,1654) + lu(k,1671) = lu(k,1671) - lu(k,877) * lu(k,1654) + lu(k,1678) = lu(k,1678) - lu(k,878) * lu(k,1654) + lu(k,1693) = lu(k,1693) - lu(k,879) * lu(k,1654) + lu(k,1696) = lu(k,1696) - lu(k,880) * lu(k,1654) + lu(k,1697) = lu(k,1697) - lu(k,881) * lu(k,1654) + lu(k,1698) = lu(k,1698) - lu(k,882) * lu(k,1654) + lu(k,1700) = lu(k,1700) - lu(k,883) * lu(k,1654) + lu(k,1893) = lu(k,1893) - lu(k,876) * lu(k,1887) + lu(k,1900) = lu(k,1900) - lu(k,877) * lu(k,1887) + lu(k,1907) = lu(k,1907) - lu(k,878) * lu(k,1887) + lu(k,1920) = lu(k,1920) - lu(k,879) * lu(k,1887) + lu(k,1923) = lu(k,1923) - lu(k,880) * lu(k,1887) + lu(k,1924) = lu(k,1924) - lu(k,881) * lu(k,1887) + lu(k,1925) = lu(k,1925) - lu(k,882) * lu(k,1887) + lu(k,1927) = lu(k,1927) - lu(k,883) * lu(k,1887) + lu(k,1951) = lu(k,1951) - lu(k,876) * lu(k,1949) + lu(k,1952) = lu(k,1952) - lu(k,877) * lu(k,1949) + lu(k,1954) = lu(k,1954) - lu(k,878) * lu(k,1949) + lu(k,1964) = lu(k,1964) - lu(k,879) * lu(k,1949) + lu(k,1967) = lu(k,1967) - lu(k,880) * lu(k,1949) + lu(k,1968) = lu(k,1968) - lu(k,881) * lu(k,1949) + lu(k,1969) = lu(k,1969) - lu(k,882) * lu(k,1949) + lu(k,1971) = lu(k,1971) - lu(k,883) * lu(k,1949) + lu(k,2084) = lu(k,2084) - lu(k,876) * lu(k,2078) + lu(k,2090) = lu(k,2090) - lu(k,877) * lu(k,2078) + lu(k,2096) = lu(k,2096) - lu(k,878) * lu(k,2078) + lu(k,2110) = lu(k,2110) - lu(k,879) * lu(k,2078) + lu(k,2113) = lu(k,2113) - lu(k,880) * lu(k,2078) + lu(k,2114) = lu(k,2114) - lu(k,881) * lu(k,2078) + lu(k,2115) = lu(k,2115) - lu(k,882) * lu(k,2078) + lu(k,2117) = lu(k,2117) - lu(k,883) * lu(k,2078) + lu(k,889) = 1._r8 / lu(k,889) + lu(k,890) = lu(k,890) * lu(k,889) + lu(k,891) = lu(k,891) * lu(k,889) + lu(k,892) = lu(k,892) * lu(k,889) + lu(k,893) = lu(k,893) * lu(k,889) + lu(k,894) = lu(k,894) * lu(k,889) + lu(k,895) = lu(k,895) * lu(k,889) + lu(k,896) = lu(k,896) * lu(k,889) + lu(k,897) = lu(k,897) * lu(k,889) + lu(k,898) = lu(k,898) * lu(k,889) + lu(k,948) = lu(k,948) - lu(k,890) * lu(k,946) + lu(k,955) = - lu(k,891) * lu(k,946) + lu(k,959) = lu(k,959) - lu(k,892) * lu(k,946) + lu(k,961) = lu(k,961) - lu(k,893) * lu(k,946) + lu(k,962) = lu(k,962) - lu(k,894) * lu(k,946) + lu(k,964) = - lu(k,895) * lu(k,946) + lu(k,965) = - lu(k,896) * lu(k,946) + lu(k,966) = - lu(k,897) * lu(k,946) + lu(k,967) = lu(k,967) - lu(k,898) * lu(k,946) + lu(k,997) = lu(k,997) - lu(k,890) * lu(k,995) + lu(k,1004) = - lu(k,891) * lu(k,995) + lu(k,1009) = lu(k,1009) - lu(k,892) * lu(k,995) + lu(k,1011) = lu(k,1011) - lu(k,893) * lu(k,995) + lu(k,1012) = lu(k,1012) - lu(k,894) * lu(k,995) + lu(k,1014) = - lu(k,895) * lu(k,995) + lu(k,1015) = - lu(k,896) * lu(k,995) + lu(k,1016) = - lu(k,897) * lu(k,995) + lu(k,1017) = lu(k,1017) - lu(k,898) * lu(k,995) + lu(k,1658) = lu(k,1658) - lu(k,890) * lu(k,1655) + lu(k,1668) = lu(k,1668) - lu(k,891) * lu(k,1655) + lu(k,1685) = lu(k,1685) - lu(k,892) * lu(k,1655) + lu(k,1691) = lu(k,1691) - lu(k,893) * lu(k,1655) + lu(k,1693) = lu(k,1693) - lu(k,894) * lu(k,1655) + lu(k,1696) = lu(k,1696) - lu(k,895) * lu(k,1655) + lu(k,1697) = lu(k,1697) - lu(k,896) * lu(k,1655) + lu(k,1698) = lu(k,1698) - lu(k,897) * lu(k,1655) + lu(k,1700) = lu(k,1700) - lu(k,898) * lu(k,1655) + lu(k,1890) = lu(k,1890) - lu(k,890) * lu(k,1888) + lu(k,1897) = lu(k,1897) - lu(k,891) * lu(k,1888) + lu(k,1913) = lu(k,1913) - lu(k,892) * lu(k,1888) + lu(k,1918) = lu(k,1918) - lu(k,893) * lu(k,1888) + lu(k,1920) = lu(k,1920) - lu(k,894) * lu(k,1888) + lu(k,1923) = lu(k,1923) - lu(k,895) * lu(k,1888) + lu(k,1924) = lu(k,1924) - lu(k,896) * lu(k,1888) + lu(k,1925) = lu(k,1925) - lu(k,897) * lu(k,1888) + lu(k,1927) = lu(k,1927) - lu(k,898) * lu(k,1888) + lu(k,2081) = lu(k,2081) - lu(k,890) * lu(k,2079) + lu(k,2087) = lu(k,2087) - lu(k,891) * lu(k,2079) + lu(k,2102) = lu(k,2102) - lu(k,892) * lu(k,2079) + lu(k,2108) = lu(k,2108) - lu(k,893) * lu(k,2079) + lu(k,2110) = lu(k,2110) - lu(k,894) * lu(k,2079) + lu(k,2113) = lu(k,2113) - lu(k,895) * lu(k,2079) + lu(k,2114) = lu(k,2114) - lu(k,896) * lu(k,2079) + lu(k,2115) = lu(k,2115) - lu(k,897) * lu(k,2079) + lu(k,2117) = lu(k,2117) - lu(k,898) * lu(k,2079) + lu(k,2218) = lu(k,2218) - lu(k,890) * lu(k,2217) + lu(k,2227) = lu(k,2227) - lu(k,891) * lu(k,2217) + lu(k,2242) = lu(k,2242) - lu(k,892) * lu(k,2217) + lu(k,2247) = lu(k,2247) - lu(k,893) * lu(k,2217) + lu(k,2249) = lu(k,2249) - lu(k,894) * lu(k,2217) + lu(k,2252) = lu(k,2252) - lu(k,895) * lu(k,2217) + lu(k,2253) = lu(k,2253) - lu(k,896) * lu(k,2217) + lu(k,2254) = lu(k,2254) - lu(k,897) * lu(k,2217) + lu(k,2256) = lu(k,2256) - lu(k,898) * lu(k,2217) + end do + end subroutine lu_fac19 + subroutine lu_fac20( 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,901) = 1._r8 / lu(k,901) + lu(k,902) = lu(k,902) * lu(k,901) + lu(k,903) = lu(k,903) * lu(k,901) + lu(k,904) = lu(k,904) * lu(k,901) + lu(k,905) = lu(k,905) * lu(k,901) + lu(k,906) = lu(k,906) * lu(k,901) + lu(k,907) = lu(k,907) * lu(k,901) + lu(k,908) = lu(k,908) * lu(k,901) + lu(k,909) = lu(k,909) * lu(k,901) + lu(k,910) = lu(k,910) * lu(k,901) + lu(k,1690) = lu(k,1690) - lu(k,902) * lu(k,1656) + lu(k,1693) = lu(k,1693) - lu(k,903) * lu(k,1656) + lu(k,1694) = lu(k,1694) - lu(k,904) * lu(k,1656) + lu(k,1695) = lu(k,1695) - lu(k,905) * lu(k,1656) + lu(k,1698) = lu(k,1698) - lu(k,906) * lu(k,1656) + lu(k,1699) = lu(k,1699) - lu(k,907) * lu(k,1656) + lu(k,1701) = lu(k,1701) - lu(k,908) * lu(k,1656) + lu(k,1703) = lu(k,1703) - lu(k,909) * lu(k,1656) + lu(k,1705) = lu(k,1705) - lu(k,910) * lu(k,1656) + lu(k,1716) = - lu(k,902) * lu(k,1712) + lu(k,1719) = lu(k,1719) - lu(k,903) * lu(k,1712) + lu(k,1720) = lu(k,1720) - lu(k,904) * lu(k,1712) + lu(k,1721) = - lu(k,905) * lu(k,1712) + lu(k,1724) = lu(k,1724) - lu(k,906) * lu(k,1712) + lu(k,1725) = lu(k,1725) - lu(k,907) * lu(k,1712) + lu(k,1727) = lu(k,1727) - lu(k,908) * lu(k,1712) + lu(k,1729) = lu(k,1729) - lu(k,909) * lu(k,1712) + lu(k,1731) = lu(k,1731) - lu(k,910) * lu(k,1712) + lu(k,1961) = lu(k,1961) - lu(k,902) * lu(k,1950) + lu(k,1964) = lu(k,1964) - lu(k,903) * lu(k,1950) + lu(k,1965) = lu(k,1965) - lu(k,904) * lu(k,1950) + lu(k,1966) = lu(k,1966) - lu(k,905) * lu(k,1950) + lu(k,1969) = lu(k,1969) - lu(k,906) * lu(k,1950) + lu(k,1970) = lu(k,1970) - lu(k,907) * lu(k,1950) + lu(k,1972) = lu(k,1972) - lu(k,908) * lu(k,1950) + lu(k,1974) = lu(k,1974) - lu(k,909) * lu(k,1950) + lu(k,1976) = lu(k,1976) - lu(k,910) * lu(k,1950) + lu(k,2000) = - lu(k,902) * lu(k,1989) + lu(k,2003) = lu(k,2003) - lu(k,903) * lu(k,1989) + lu(k,2004) = lu(k,2004) - lu(k,904) * lu(k,1989) + lu(k,2005) = lu(k,2005) - lu(k,905) * lu(k,1989) + lu(k,2008) = lu(k,2008) - lu(k,906) * lu(k,1989) + lu(k,2009) = lu(k,2009) - lu(k,907) * lu(k,1989) + lu(k,2011) = lu(k,2011) - lu(k,908) * lu(k,1989) + lu(k,2013) = lu(k,2013) - lu(k,909) * lu(k,1989) + lu(k,2015) = lu(k,2015) - lu(k,910) * lu(k,1989) + lu(k,2130) = lu(k,2130) - lu(k,902) * lu(k,2127) + lu(k,2133) = lu(k,2133) - lu(k,903) * lu(k,2127) + lu(k,2134) = lu(k,2134) - lu(k,904) * lu(k,2127) + lu(k,2135) = - lu(k,905) * lu(k,2127) + lu(k,2138) = - lu(k,906) * lu(k,2127) + lu(k,2139) = lu(k,2139) - lu(k,907) * lu(k,2127) + lu(k,2141) = lu(k,2141) - lu(k,908) * lu(k,2127) + lu(k,2143) = lu(k,2143) - lu(k,909) * lu(k,2127) + lu(k,2145) = lu(k,2145) - lu(k,910) * lu(k,2127) + lu(k,2185) = lu(k,2185) - lu(k,902) * lu(k,2178) + lu(k,2188) = lu(k,2188) - lu(k,903) * lu(k,2178) + lu(k,2189) = lu(k,2189) - lu(k,904) * lu(k,2178) + lu(k,2190) = lu(k,2190) - lu(k,905) * lu(k,2178) + lu(k,2193) = lu(k,2193) - lu(k,906) * lu(k,2178) + lu(k,2194) = lu(k,2194) - lu(k,907) * lu(k,2178) + lu(k,2196) = lu(k,2196) - lu(k,908) * lu(k,2178) + lu(k,2198) = lu(k,2198) - lu(k,909) * lu(k,2178) + lu(k,2200) = lu(k,2200) - lu(k,910) * lu(k,2178) + lu(k,914) = 1._r8 / lu(k,914) + lu(k,915) = lu(k,915) * lu(k,914) + lu(k,916) = lu(k,916) * lu(k,914) + lu(k,917) = lu(k,917) * lu(k,914) + lu(k,918) = lu(k,918) * lu(k,914) + lu(k,919) = lu(k,919) * lu(k,914) + lu(k,920) = lu(k,920) * lu(k,914) + lu(k,921) = lu(k,921) * lu(k,914) + lu(k,922) = lu(k,922) * lu(k,914) + lu(k,923) = lu(k,923) * lu(k,914) + lu(k,948) = lu(k,948) - lu(k,915) * lu(k,947) + lu(k,951) = lu(k,951) - lu(k,916) * lu(k,947) + lu(k,960) = - lu(k,917) * lu(k,947) + lu(k,961) = lu(k,961) - lu(k,918) * lu(k,947) + lu(k,962) = lu(k,962) - lu(k,919) * lu(k,947) + lu(k,964) = lu(k,964) - lu(k,920) * lu(k,947) + lu(k,965) = lu(k,965) - lu(k,921) * lu(k,947) + lu(k,966) = lu(k,966) - lu(k,922) * lu(k,947) + lu(k,967) = lu(k,967) - lu(k,923) * lu(k,947) + lu(k,997) = lu(k,997) - lu(k,915) * lu(k,996) + lu(k,999) = lu(k,999) - lu(k,916) * lu(k,996) + lu(k,1010) = - lu(k,917) * lu(k,996) + lu(k,1011) = lu(k,1011) - lu(k,918) * lu(k,996) + lu(k,1012) = lu(k,1012) - lu(k,919) * lu(k,996) + lu(k,1014) = lu(k,1014) - lu(k,920) * lu(k,996) + lu(k,1015) = lu(k,1015) - lu(k,921) * lu(k,996) + lu(k,1016) = lu(k,1016) - lu(k,922) * lu(k,996) + lu(k,1017) = lu(k,1017) - lu(k,923) * lu(k,996) + lu(k,1658) = lu(k,1658) - lu(k,915) * lu(k,1657) + lu(k,1661) = lu(k,1661) - lu(k,916) * lu(k,1657) + lu(k,1690) = lu(k,1690) - lu(k,917) * lu(k,1657) + lu(k,1691) = lu(k,1691) - lu(k,918) * lu(k,1657) + lu(k,1693) = lu(k,1693) - lu(k,919) * lu(k,1657) + lu(k,1696) = lu(k,1696) - lu(k,920) * lu(k,1657) + lu(k,1697) = lu(k,1697) - lu(k,921) * lu(k,1657) + lu(k,1698) = lu(k,1698) - lu(k,922) * lu(k,1657) + lu(k,1700) = lu(k,1700) - lu(k,923) * lu(k,1657) + lu(k,1801) = lu(k,1801) - lu(k,915) * lu(k,1800) + lu(k,1802) = lu(k,1802) - lu(k,916) * lu(k,1800) + lu(k,1825) = lu(k,1825) - lu(k,917) * lu(k,1800) + lu(k,1826) = lu(k,1826) - lu(k,918) * lu(k,1800) + lu(k,1828) = lu(k,1828) - lu(k,919) * lu(k,1800) + lu(k,1831) = lu(k,1831) - lu(k,920) * lu(k,1800) + lu(k,1832) = lu(k,1832) - lu(k,921) * lu(k,1800) + lu(k,1833) = lu(k,1833) - lu(k,922) * lu(k,1800) + lu(k,1835) = lu(k,1835) - lu(k,923) * lu(k,1800) + lu(k,1890) = lu(k,1890) - lu(k,915) * lu(k,1889) + lu(k,1892) = lu(k,1892) - lu(k,916) * lu(k,1889) + lu(k,1917) = lu(k,1917) - lu(k,917) * lu(k,1889) + lu(k,1918) = lu(k,1918) - lu(k,918) * lu(k,1889) + lu(k,1920) = lu(k,1920) - lu(k,919) * lu(k,1889) + lu(k,1923) = lu(k,1923) - lu(k,920) * lu(k,1889) + lu(k,1924) = lu(k,1924) - lu(k,921) * lu(k,1889) + lu(k,1925) = lu(k,1925) - lu(k,922) * lu(k,1889) + lu(k,1927) = lu(k,1927) - lu(k,923) * lu(k,1889) + lu(k,2081) = lu(k,2081) - lu(k,915) * lu(k,2080) + lu(k,2083) = lu(k,2083) - lu(k,916) * lu(k,2080) + lu(k,2107) = lu(k,2107) - lu(k,917) * lu(k,2080) + lu(k,2108) = lu(k,2108) - lu(k,918) * lu(k,2080) + lu(k,2110) = lu(k,2110) - lu(k,919) * lu(k,2080) + lu(k,2113) = lu(k,2113) - lu(k,920) * lu(k,2080) + lu(k,2114) = lu(k,2114) - lu(k,921) * lu(k,2080) + lu(k,2115) = lu(k,2115) - lu(k,922) * lu(k,2080) + lu(k,2117) = lu(k,2117) - lu(k,923) * lu(k,2080) + lu(k,924) = 1._r8 / lu(k,924) + lu(k,925) = lu(k,925) * lu(k,924) + lu(k,926) = lu(k,926) * lu(k,924) + lu(k,927) = lu(k,927) * lu(k,924) + lu(k,928) = lu(k,928) * lu(k,924) + lu(k,929) = lu(k,929) * lu(k,924) + lu(k,957) = lu(k,957) - lu(k,925) * lu(k,948) + lu(k,959) = lu(k,959) - lu(k,926) * lu(k,948) + lu(k,962) = lu(k,962) - lu(k,927) * lu(k,948) + lu(k,964) = lu(k,964) - lu(k,928) * lu(k,948) + lu(k,970) = - lu(k,929) * lu(k,948) + lu(k,1007) = lu(k,1007) - lu(k,925) * lu(k,997) + lu(k,1009) = lu(k,1009) - lu(k,926) * lu(k,997) + lu(k,1012) = lu(k,1012) - lu(k,927) * lu(k,997) + lu(k,1014) = lu(k,1014) - lu(k,928) * lu(k,997) + lu(k,1020) = - lu(k,929) * lu(k,997) + lu(k,1063) = lu(k,1063) - lu(k,925) * lu(k,1060) + lu(k,1064) = lu(k,1064) - lu(k,926) * lu(k,1060) + lu(k,1066) = lu(k,1066) - lu(k,927) * lu(k,1060) + lu(k,1067) = - lu(k,928) * lu(k,1060) + lu(k,1070) = - lu(k,929) * lu(k,1060) + lu(k,1113) = - lu(k,925) * lu(k,1108) + lu(k,1114) = - lu(k,926) * lu(k,1108) + lu(k,1117) = lu(k,1117) - lu(k,927) * lu(k,1108) + lu(k,1118) = lu(k,1118) - lu(k,928) * lu(k,1108) + lu(k,1123) = - lu(k,929) * lu(k,1108) + lu(k,1153) = - lu(k,925) * lu(k,1149) + lu(k,1157) = lu(k,1157) - lu(k,926) * lu(k,1149) + lu(k,1160) = lu(k,1160) - lu(k,927) * lu(k,1149) + lu(k,1162) = - lu(k,928) * lu(k,1149) + lu(k,1167) = - lu(k,929) * lu(k,1149) + lu(k,1672) = lu(k,1672) - lu(k,925) * lu(k,1658) + lu(k,1685) = lu(k,1685) - lu(k,926) * lu(k,1658) + lu(k,1693) = lu(k,1693) - lu(k,927) * lu(k,1658) + lu(k,1696) = lu(k,1696) - lu(k,928) * lu(k,1658) + lu(k,1705) = lu(k,1705) - lu(k,929) * lu(k,1658) + lu(k,1756) = - lu(k,925) * lu(k,1742) + lu(k,1769) = lu(k,1769) - lu(k,926) * lu(k,1742) + lu(k,1776) = lu(k,1776) - lu(k,927) * lu(k,1742) + lu(k,1779) = lu(k,1779) - lu(k,928) * lu(k,1742) + lu(k,1788) = lu(k,1788) - lu(k,929) * lu(k,1742) + lu(k,1811) = lu(k,1811) - lu(k,925) * lu(k,1801) + lu(k,1822) = lu(k,1822) - lu(k,926) * lu(k,1801) + lu(k,1828) = lu(k,1828) - lu(k,927) * lu(k,1801) + lu(k,1831) = lu(k,1831) - lu(k,928) * lu(k,1801) + lu(k,1840) = lu(k,1840) - lu(k,929) * lu(k,1801) + lu(k,1901) = lu(k,1901) - lu(k,925) * lu(k,1890) + lu(k,1913) = lu(k,1913) - lu(k,926) * lu(k,1890) + lu(k,1920) = lu(k,1920) - lu(k,927) * lu(k,1890) + lu(k,1923) = lu(k,1923) - lu(k,928) * lu(k,1890) + lu(k,1932) = lu(k,1932) - lu(k,929) * lu(k,1890) + lu(k,2091) = lu(k,2091) - lu(k,925) * lu(k,2081) + lu(k,2102) = lu(k,2102) - lu(k,926) * lu(k,2081) + lu(k,2110) = lu(k,2110) - lu(k,927) * lu(k,2081) + lu(k,2113) = lu(k,2113) - lu(k,928) * lu(k,2081) + lu(k,2122) = lu(k,2122) - lu(k,929) * lu(k,2081) + lu(k,2231) = lu(k,2231) - lu(k,925) * lu(k,2218) + lu(k,2242) = lu(k,2242) - lu(k,926) * lu(k,2218) + lu(k,2249) = lu(k,2249) - lu(k,927) * lu(k,2218) + lu(k,2252) = lu(k,2252) - lu(k,928) * lu(k,2218) + lu(k,2261) = lu(k,2261) - lu(k,929) * lu(k,2218) + lu(k,931) = 1._r8 / lu(k,931) + lu(k,932) = lu(k,932) * lu(k,931) + lu(k,933) = lu(k,933) * lu(k,931) + lu(k,934) = lu(k,934) * lu(k,931) + lu(k,935) = lu(k,935) * lu(k,931) + lu(k,936) = lu(k,936) * lu(k,931) + lu(k,956) = lu(k,956) - lu(k,932) * lu(k,949) + lu(k,962) = lu(k,962) - lu(k,933) * lu(k,949) + lu(k,967) = lu(k,967) - lu(k,934) * lu(k,949) + lu(k,968) = lu(k,968) - lu(k,935) * lu(k,949) + lu(k,970) = lu(k,970) - lu(k,936) * lu(k,949) + lu(k,1006) = lu(k,1006) - lu(k,932) * lu(k,998) + lu(k,1012) = lu(k,1012) - lu(k,933) * lu(k,998) + lu(k,1017) = lu(k,1017) - lu(k,934) * lu(k,998) + lu(k,1018) = lu(k,1018) - lu(k,935) * lu(k,998) + lu(k,1020) = lu(k,1020) - lu(k,936) * lu(k,998) + lu(k,1028) = lu(k,1028) - lu(k,932) * lu(k,1025) + lu(k,1034) = lu(k,1034) - lu(k,933) * lu(k,1025) + lu(k,1039) = lu(k,1039) - lu(k,934) * lu(k,1025) + lu(k,1040) = lu(k,1040) - lu(k,935) * lu(k,1025) + lu(k,1042) = lu(k,1042) - lu(k,936) * lu(k,1025) + lu(k,1210) = lu(k,1210) - lu(k,932) * lu(k,1209) + lu(k,1217) = lu(k,1217) - lu(k,933) * lu(k,1209) + lu(k,1218) = lu(k,1218) - lu(k,934) * lu(k,1209) + lu(k,1219) = - lu(k,935) * lu(k,1209) + lu(k,1221) = lu(k,1221) - lu(k,936) * lu(k,1209) + lu(k,1330) = lu(k,1330) - lu(k,932) * lu(k,1327) + lu(k,1340) = lu(k,1340) - lu(k,933) * lu(k,1327) + lu(k,1345) = lu(k,1345) - lu(k,934) * lu(k,1327) + lu(k,1346) = lu(k,1346) - lu(k,935) * lu(k,1327) + lu(k,1348) = - lu(k,936) * lu(k,1327) + lu(k,1481) = lu(k,1481) - lu(k,932) * lu(k,1480) + lu(k,1489) = lu(k,1489) - lu(k,933) * lu(k,1480) + lu(k,1495) = lu(k,1495) - lu(k,934) * lu(k,1480) + lu(k,1498) = lu(k,1498) - lu(k,935) * lu(k,1480) + lu(k,1500) = lu(k,1500) - lu(k,936) * lu(k,1480) + lu(k,1671) = lu(k,1671) - lu(k,932) * lu(k,1659) + lu(k,1693) = lu(k,1693) - lu(k,933) * lu(k,1659) + lu(k,1700) = lu(k,1700) - lu(k,934) * lu(k,1659) + lu(k,1703) = lu(k,1703) - lu(k,935) * lu(k,1659) + lu(k,1705) = lu(k,1705) - lu(k,936) * lu(k,1659) + lu(k,1755) = lu(k,1755) - lu(k,932) * lu(k,1743) + lu(k,1776) = lu(k,1776) - lu(k,933) * lu(k,1743) + lu(k,1783) = lu(k,1783) - lu(k,934) * lu(k,1743) + lu(k,1786) = lu(k,1786) - lu(k,935) * lu(k,1743) + lu(k,1788) = lu(k,1788) - lu(k,936) * lu(k,1743) + lu(k,1900) = lu(k,1900) - lu(k,932) * lu(k,1891) + lu(k,1920) = lu(k,1920) - lu(k,933) * lu(k,1891) + lu(k,1927) = lu(k,1927) - lu(k,934) * lu(k,1891) + lu(k,1930) = lu(k,1930) - lu(k,935) * lu(k,1891) + lu(k,1932) = lu(k,1932) - lu(k,936) * lu(k,1891) + lu(k,1994) = lu(k,1994) - lu(k,932) * lu(k,1990) + lu(k,2003) = lu(k,2003) - lu(k,933) * lu(k,1990) + lu(k,2010) = lu(k,2010) - lu(k,934) * lu(k,1990) + lu(k,2013) = lu(k,2013) - lu(k,935) * lu(k,1990) + lu(k,2015) = lu(k,2015) - lu(k,936) * lu(k,1990) + lu(k,2090) = lu(k,2090) - lu(k,932) * lu(k,2082) + lu(k,2110) = lu(k,2110) - lu(k,933) * lu(k,2082) + lu(k,2117) = lu(k,2117) - lu(k,934) * lu(k,2082) + lu(k,2120) = lu(k,2120) - lu(k,935) * lu(k,2082) + lu(k,2122) = lu(k,2122) - lu(k,936) * lu(k,2082) + lu(k,2230) = lu(k,2230) - lu(k,932) * lu(k,2219) + lu(k,2249) = lu(k,2249) - lu(k,933) * lu(k,2219) + lu(k,2256) = lu(k,2256) - lu(k,934) * lu(k,2219) + lu(k,2259) = lu(k,2259) - lu(k,935) * lu(k,2219) + lu(k,2261) = lu(k,2261) - lu(k,936) * lu(k,2219) + end do + end subroutine lu_fac20 + subroutine lu_fac21( 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,950) = 1._r8 / lu(k,950) + lu(k,951) = lu(k,951) * lu(k,950) + lu(k,952) = lu(k,952) * lu(k,950) + lu(k,953) = lu(k,953) * lu(k,950) + lu(k,954) = lu(k,954) * lu(k,950) + lu(k,955) = lu(k,955) * lu(k,950) + lu(k,956) = lu(k,956) * lu(k,950) + lu(k,957) = lu(k,957) * lu(k,950) + lu(k,958) = lu(k,958) * lu(k,950) + lu(k,959) = lu(k,959) * lu(k,950) + lu(k,960) = lu(k,960) * lu(k,950) + lu(k,961) = lu(k,961) * lu(k,950) + lu(k,962) = lu(k,962) * lu(k,950) + lu(k,963) = lu(k,963) * lu(k,950) + lu(k,964) = lu(k,964) * lu(k,950) + lu(k,965) = lu(k,965) * lu(k,950) + lu(k,966) = lu(k,966) * lu(k,950) + lu(k,967) = lu(k,967) * lu(k,950) + lu(k,968) = lu(k,968) * lu(k,950) + lu(k,969) = lu(k,969) * lu(k,950) + lu(k,970) = lu(k,970) * lu(k,950) + lu(k,1661) = lu(k,1661) - lu(k,951) * lu(k,1660) + lu(k,1662) = lu(k,1662) - lu(k,952) * lu(k,1660) + lu(k,1665) = lu(k,1665) - lu(k,953) * lu(k,1660) + lu(k,1666) = lu(k,1666) - lu(k,954) * lu(k,1660) + lu(k,1668) = lu(k,1668) - lu(k,955) * lu(k,1660) + lu(k,1671) = lu(k,1671) - lu(k,956) * lu(k,1660) + lu(k,1672) = lu(k,1672) - lu(k,957) * lu(k,1660) + lu(k,1678) = lu(k,1678) - lu(k,958) * lu(k,1660) + lu(k,1685) = lu(k,1685) - lu(k,959) * lu(k,1660) + lu(k,1690) = lu(k,1690) - lu(k,960) * lu(k,1660) + lu(k,1691) = lu(k,1691) - lu(k,961) * lu(k,1660) + lu(k,1693) = lu(k,1693) - lu(k,962) * lu(k,1660) + lu(k,1695) = lu(k,1695) - lu(k,963) * lu(k,1660) + lu(k,1696) = lu(k,1696) - lu(k,964) * lu(k,1660) + lu(k,1697) = lu(k,1697) - lu(k,965) * lu(k,1660) + lu(k,1698) = lu(k,1698) - lu(k,966) * lu(k,1660) + lu(k,1700) = lu(k,1700) - lu(k,967) * lu(k,1660) + lu(k,1703) = lu(k,1703) - lu(k,968) * lu(k,1660) + lu(k,1704) = lu(k,1704) - lu(k,969) * lu(k,1660) + lu(k,1705) = lu(k,1705) - lu(k,970) * lu(k,1660) + lu(k,1745) = lu(k,1745) - lu(k,951) * lu(k,1744) + lu(k,1746) = lu(k,1746) - lu(k,952) * lu(k,1744) + lu(k,1749) = lu(k,1749) - lu(k,953) * lu(k,1744) + lu(k,1750) = - lu(k,954) * lu(k,1744) + lu(k,1752) = lu(k,1752) - lu(k,955) * lu(k,1744) + lu(k,1755) = lu(k,1755) - lu(k,956) * lu(k,1744) + lu(k,1756) = lu(k,1756) - lu(k,957) * lu(k,1744) + lu(k,1762) = lu(k,1762) - lu(k,958) * lu(k,1744) + lu(k,1769) = lu(k,1769) - lu(k,959) * lu(k,1744) + lu(k,1773) = lu(k,1773) - lu(k,960) * lu(k,1744) + lu(k,1774) = lu(k,1774) - lu(k,961) * lu(k,1744) + lu(k,1776) = lu(k,1776) - lu(k,962) * lu(k,1744) + lu(k,1778) = lu(k,1778) - lu(k,963) * lu(k,1744) + lu(k,1779) = lu(k,1779) - lu(k,964) * lu(k,1744) + lu(k,1780) = lu(k,1780) - lu(k,965) * lu(k,1744) + lu(k,1781) = lu(k,1781) - lu(k,966) * lu(k,1744) + lu(k,1783) = lu(k,1783) - lu(k,967) * lu(k,1744) + lu(k,1786) = lu(k,1786) - lu(k,968) * lu(k,1744) + lu(k,1787) = lu(k,1787) - lu(k,969) * lu(k,1744) + lu(k,1788) = lu(k,1788) - lu(k,970) * lu(k,1744) + lu(k,2221) = lu(k,2221) - lu(k,951) * lu(k,2220) + lu(k,2222) = lu(k,2222) - lu(k,952) * lu(k,2220) + lu(k,2225) = - lu(k,953) * lu(k,2220) + lu(k,2226) = lu(k,2226) - lu(k,954) * lu(k,2220) + lu(k,2227) = lu(k,2227) - lu(k,955) * lu(k,2220) + lu(k,2230) = lu(k,2230) - lu(k,956) * lu(k,2220) + lu(k,2231) = lu(k,2231) - lu(k,957) * lu(k,2220) + lu(k,2235) = lu(k,2235) - lu(k,958) * lu(k,2220) + lu(k,2242) = lu(k,2242) - lu(k,959) * lu(k,2220) + lu(k,2246) = - lu(k,960) * lu(k,2220) + lu(k,2247) = lu(k,2247) - lu(k,961) * lu(k,2220) + lu(k,2249) = lu(k,2249) - lu(k,962) * lu(k,2220) + lu(k,2251) = lu(k,2251) - lu(k,963) * lu(k,2220) + lu(k,2252) = lu(k,2252) - lu(k,964) * lu(k,2220) + lu(k,2253) = lu(k,2253) - lu(k,965) * lu(k,2220) + lu(k,2254) = lu(k,2254) - lu(k,966) * lu(k,2220) + lu(k,2256) = lu(k,2256) - lu(k,967) * lu(k,2220) + lu(k,2259) = lu(k,2259) - lu(k,968) * lu(k,2220) + lu(k,2260) = lu(k,2260) - lu(k,969) * lu(k,2220) + lu(k,2261) = lu(k,2261) - lu(k,970) * lu(k,2220) + lu(k,971) = 1._r8 / lu(k,971) + lu(k,972) = lu(k,972) * lu(k,971) + lu(k,973) = lu(k,973) * lu(k,971) + lu(k,974) = lu(k,974) * lu(k,971) + lu(k,975) = lu(k,975) * lu(k,971) + lu(k,976) = lu(k,976) * lu(k,971) + lu(k,977) = lu(k,977) * lu(k,971) + lu(k,978) = lu(k,978) * lu(k,971) + lu(k,1002) = lu(k,1002) - lu(k,972) * lu(k,999) + lu(k,1003) = lu(k,1003) - lu(k,973) * lu(k,999) + lu(k,1005) = - lu(k,974) * lu(k,999) + lu(k,1006) = lu(k,1006) - lu(k,975) * lu(k,999) + lu(k,1012) = lu(k,1012) - lu(k,976) * lu(k,999) + lu(k,1013) = lu(k,1013) - lu(k,977) * lu(k,999) + lu(k,1017) = lu(k,1017) - lu(k,978) * lu(k,999) + lu(k,1047) = lu(k,1047) - lu(k,972) * lu(k,1046) + lu(k,1048) = - lu(k,973) * lu(k,1046) + lu(k,1049) = - lu(k,974) * lu(k,1046) + lu(k,1050) = - lu(k,975) * lu(k,1046) + lu(k,1053) = lu(k,1053) - lu(k,976) * lu(k,1046) + lu(k,1054) = lu(k,1054) - lu(k,977) * lu(k,1046) + lu(k,1058) = lu(k,1058) - lu(k,978) * lu(k,1046) + lu(k,1665) = lu(k,1665) - lu(k,972) * lu(k,1661) + lu(k,1666) = lu(k,1666) - lu(k,973) * lu(k,1661) + lu(k,1670) = lu(k,1670) - lu(k,974) * lu(k,1661) + lu(k,1671) = lu(k,1671) - lu(k,975) * lu(k,1661) + lu(k,1693) = lu(k,1693) - lu(k,976) * lu(k,1661) + lu(k,1695) = lu(k,1695) - lu(k,977) * lu(k,1661) + lu(k,1700) = lu(k,1700) - lu(k,978) * lu(k,1661) + lu(k,1749) = lu(k,1749) - lu(k,972) * lu(k,1745) + lu(k,1750) = lu(k,1750) - lu(k,973) * lu(k,1745) + lu(k,1754) = lu(k,1754) - lu(k,974) * lu(k,1745) + lu(k,1755) = lu(k,1755) - lu(k,975) * lu(k,1745) + lu(k,1776) = lu(k,1776) - lu(k,976) * lu(k,1745) + lu(k,1778) = lu(k,1778) - lu(k,977) * lu(k,1745) + lu(k,1783) = lu(k,1783) - lu(k,978) * lu(k,1745) + lu(k,1804) = lu(k,1804) - lu(k,972) * lu(k,1802) + lu(k,1805) = lu(k,1805) - lu(k,973) * lu(k,1802) + lu(k,1809) = lu(k,1809) - lu(k,974) * lu(k,1802) + lu(k,1810) = lu(k,1810) - lu(k,975) * lu(k,1802) + lu(k,1828) = lu(k,1828) - lu(k,976) * lu(k,1802) + lu(k,1830) = - lu(k,977) * lu(k,1802) + lu(k,1835) = lu(k,1835) - lu(k,978) * lu(k,1802) + lu(k,1894) = lu(k,1894) - lu(k,972) * lu(k,1892) + lu(k,1895) = lu(k,1895) - lu(k,973) * lu(k,1892) + lu(k,1899) = lu(k,1899) - lu(k,974) * lu(k,1892) + lu(k,1900) = lu(k,1900) - lu(k,975) * lu(k,1892) + lu(k,1920) = lu(k,1920) - lu(k,976) * lu(k,1892) + lu(k,1922) = lu(k,1922) - lu(k,977) * lu(k,1892) + lu(k,1927) = lu(k,1927) - lu(k,978) * lu(k,1892) + lu(k,2085) = lu(k,2085) - lu(k,972) * lu(k,2083) + lu(k,2086) = lu(k,2086) - lu(k,973) * lu(k,2083) + lu(k,2089) = lu(k,2089) - lu(k,974) * lu(k,2083) + lu(k,2090) = lu(k,2090) - lu(k,975) * lu(k,2083) + lu(k,2110) = lu(k,2110) - lu(k,976) * lu(k,2083) + lu(k,2112) = lu(k,2112) - lu(k,977) * lu(k,2083) + lu(k,2117) = lu(k,2117) - lu(k,978) * lu(k,2083) + lu(k,2225) = lu(k,2225) - lu(k,972) * lu(k,2221) + lu(k,2226) = lu(k,2226) - lu(k,973) * lu(k,2221) + lu(k,2229) = - lu(k,974) * lu(k,2221) + lu(k,2230) = lu(k,2230) - lu(k,975) * lu(k,2221) + lu(k,2249) = lu(k,2249) - lu(k,976) * lu(k,2221) + lu(k,2251) = lu(k,2251) - lu(k,977) * lu(k,2221) + lu(k,2256) = lu(k,2256) - lu(k,978) * lu(k,2221) + lu(k,981) = 1._r8 / lu(k,981) + lu(k,982) = lu(k,982) * lu(k,981) + lu(k,983) = lu(k,983) * lu(k,981) + lu(k,984) = lu(k,984) * lu(k,981) + lu(k,985) = lu(k,985) * lu(k,981) + lu(k,1006) = lu(k,1006) - lu(k,982) * lu(k,1000) + lu(k,1012) = lu(k,1012) - lu(k,983) * lu(k,1000) + lu(k,1017) = lu(k,1017) - lu(k,984) * lu(k,1000) + lu(k,1018) = lu(k,1018) - lu(k,985) * lu(k,1000) + lu(k,1076) = lu(k,1076) - lu(k,982) * lu(k,1074) + lu(k,1081) = lu(k,1081) - lu(k,983) * lu(k,1074) + lu(k,1085) = lu(k,1085) - lu(k,984) * lu(k,1074) + lu(k,1086) = - lu(k,985) * lu(k,1074) + lu(k,1099) = lu(k,1099) - lu(k,982) * lu(k,1097) + lu(k,1101) = lu(k,1101) - lu(k,983) * lu(k,1097) + lu(k,1102) = lu(k,1102) - lu(k,984) * lu(k,1097) + lu(k,1103) = lu(k,1103) - lu(k,985) * lu(k,1097) + lu(k,1173) = lu(k,1173) - lu(k,982) * lu(k,1171) + lu(k,1179) = lu(k,1179) - lu(k,983) * lu(k,1171) + lu(k,1184) = lu(k,1184) - lu(k,984) * lu(k,1171) + lu(k,1185) = lu(k,1185) - lu(k,985) * lu(k,1171) + lu(k,1284) = lu(k,1284) - lu(k,982) * lu(k,1282) + lu(k,1297) = lu(k,1297) - lu(k,983) * lu(k,1282) + lu(k,1302) = lu(k,1302) - lu(k,984) * lu(k,1282) + lu(k,1303) = - lu(k,985) * lu(k,1282) + lu(k,1377) = lu(k,1377) - lu(k,982) * lu(k,1374) + lu(k,1392) = lu(k,1392) - lu(k,983) * lu(k,1374) + lu(k,1397) = lu(k,1397) - lu(k,984) * lu(k,1374) + lu(k,1398) = lu(k,1398) - lu(k,985) * lu(k,1374) + lu(k,1671) = lu(k,1671) - lu(k,982) * lu(k,1662) + lu(k,1693) = lu(k,1693) - lu(k,983) * lu(k,1662) + lu(k,1700) = lu(k,1700) - lu(k,984) * lu(k,1662) + lu(k,1703) = lu(k,1703) - lu(k,985) * lu(k,1662) + lu(k,1755) = lu(k,1755) - lu(k,982) * lu(k,1746) + lu(k,1776) = lu(k,1776) - lu(k,983) * lu(k,1746) + lu(k,1783) = lu(k,1783) - lu(k,984) * lu(k,1746) + lu(k,1786) = lu(k,1786) - lu(k,985) * lu(k,1746) + lu(k,1810) = lu(k,1810) - lu(k,982) * lu(k,1803) + lu(k,1828) = lu(k,1828) - lu(k,983) * lu(k,1803) + lu(k,1835) = lu(k,1835) - lu(k,984) * lu(k,1803) + lu(k,1838) = lu(k,1838) - lu(k,985) * lu(k,1803) + lu(k,1900) = lu(k,1900) - lu(k,982) * lu(k,1893) + lu(k,1920) = lu(k,1920) - lu(k,983) * lu(k,1893) + lu(k,1927) = lu(k,1927) - lu(k,984) * lu(k,1893) + lu(k,1930) = lu(k,1930) - lu(k,985) * lu(k,1893) + lu(k,1952) = lu(k,1952) - lu(k,982) * lu(k,1951) + lu(k,1964) = lu(k,1964) - lu(k,983) * lu(k,1951) + lu(k,1971) = lu(k,1971) - lu(k,984) * lu(k,1951) + lu(k,1974) = lu(k,1974) - lu(k,985) * lu(k,1951) + lu(k,1994) = lu(k,1994) - lu(k,982) * lu(k,1991) + lu(k,2003) = lu(k,2003) - lu(k,983) * lu(k,1991) + lu(k,2010) = lu(k,2010) - lu(k,984) * lu(k,1991) + lu(k,2013) = lu(k,2013) - lu(k,985) * lu(k,1991) + lu(k,2090) = lu(k,2090) - lu(k,982) * lu(k,2084) + lu(k,2110) = lu(k,2110) - lu(k,983) * lu(k,2084) + lu(k,2117) = lu(k,2117) - lu(k,984) * lu(k,2084) + lu(k,2120) = lu(k,2120) - lu(k,985) * lu(k,2084) + lu(k,2230) = lu(k,2230) - lu(k,982) * lu(k,2222) + lu(k,2249) = lu(k,2249) - lu(k,983) * lu(k,2222) + lu(k,2256) = lu(k,2256) - lu(k,984) * lu(k,2222) + lu(k,2259) = lu(k,2259) - lu(k,985) * lu(k,2222) + lu(k,1001) = 1._r8 / lu(k,1001) + lu(k,1002) = lu(k,1002) * lu(k,1001) + lu(k,1003) = lu(k,1003) * lu(k,1001) + lu(k,1004) = lu(k,1004) * lu(k,1001) + lu(k,1005) = lu(k,1005) * lu(k,1001) + lu(k,1006) = lu(k,1006) * lu(k,1001) + lu(k,1007) = lu(k,1007) * lu(k,1001) + lu(k,1008) = lu(k,1008) * lu(k,1001) + lu(k,1009) = lu(k,1009) * lu(k,1001) + lu(k,1010) = lu(k,1010) * lu(k,1001) + lu(k,1011) = lu(k,1011) * lu(k,1001) + lu(k,1012) = lu(k,1012) * lu(k,1001) + lu(k,1013) = lu(k,1013) * lu(k,1001) + lu(k,1014) = lu(k,1014) * lu(k,1001) + lu(k,1015) = lu(k,1015) * lu(k,1001) + lu(k,1016) = lu(k,1016) * lu(k,1001) + lu(k,1017) = lu(k,1017) * lu(k,1001) + lu(k,1018) = lu(k,1018) * lu(k,1001) + lu(k,1019) = lu(k,1019) * lu(k,1001) + lu(k,1020) = lu(k,1020) * lu(k,1001) + lu(k,1665) = lu(k,1665) - lu(k,1002) * lu(k,1663) + lu(k,1666) = lu(k,1666) - lu(k,1003) * lu(k,1663) + lu(k,1668) = lu(k,1668) - lu(k,1004) * lu(k,1663) + lu(k,1670) = lu(k,1670) - lu(k,1005) * lu(k,1663) + lu(k,1671) = lu(k,1671) - lu(k,1006) * lu(k,1663) + lu(k,1672) = lu(k,1672) - lu(k,1007) * lu(k,1663) + lu(k,1678) = lu(k,1678) - lu(k,1008) * lu(k,1663) + lu(k,1685) = lu(k,1685) - lu(k,1009) * lu(k,1663) + lu(k,1690) = lu(k,1690) - lu(k,1010) * lu(k,1663) + lu(k,1691) = lu(k,1691) - lu(k,1011) * lu(k,1663) + lu(k,1693) = lu(k,1693) - lu(k,1012) * lu(k,1663) + lu(k,1695) = lu(k,1695) - lu(k,1013) * lu(k,1663) + lu(k,1696) = lu(k,1696) - lu(k,1014) * lu(k,1663) + lu(k,1697) = lu(k,1697) - lu(k,1015) * lu(k,1663) + lu(k,1698) = lu(k,1698) - lu(k,1016) * lu(k,1663) + lu(k,1700) = lu(k,1700) - lu(k,1017) * lu(k,1663) + lu(k,1703) = lu(k,1703) - lu(k,1018) * lu(k,1663) + lu(k,1704) = lu(k,1704) - lu(k,1019) * lu(k,1663) + lu(k,1705) = lu(k,1705) - lu(k,1020) * lu(k,1663) + lu(k,1749) = lu(k,1749) - lu(k,1002) * lu(k,1747) + lu(k,1750) = lu(k,1750) - lu(k,1003) * lu(k,1747) + lu(k,1752) = lu(k,1752) - lu(k,1004) * lu(k,1747) + lu(k,1754) = lu(k,1754) - lu(k,1005) * lu(k,1747) + lu(k,1755) = lu(k,1755) - lu(k,1006) * lu(k,1747) + lu(k,1756) = lu(k,1756) - lu(k,1007) * lu(k,1747) + lu(k,1762) = lu(k,1762) - lu(k,1008) * lu(k,1747) + lu(k,1769) = lu(k,1769) - lu(k,1009) * lu(k,1747) + lu(k,1773) = lu(k,1773) - lu(k,1010) * lu(k,1747) + lu(k,1774) = lu(k,1774) - lu(k,1011) * lu(k,1747) + lu(k,1776) = lu(k,1776) - lu(k,1012) * lu(k,1747) + lu(k,1778) = lu(k,1778) - lu(k,1013) * lu(k,1747) + lu(k,1779) = lu(k,1779) - lu(k,1014) * lu(k,1747) + lu(k,1780) = lu(k,1780) - lu(k,1015) * lu(k,1747) + lu(k,1781) = lu(k,1781) - lu(k,1016) * lu(k,1747) + lu(k,1783) = lu(k,1783) - lu(k,1017) * lu(k,1747) + lu(k,1786) = lu(k,1786) - lu(k,1018) * lu(k,1747) + lu(k,1787) = lu(k,1787) - lu(k,1019) * lu(k,1747) + lu(k,1788) = lu(k,1788) - lu(k,1020) * lu(k,1747) + lu(k,2225) = lu(k,2225) - lu(k,1002) * lu(k,2223) + lu(k,2226) = lu(k,2226) - lu(k,1003) * lu(k,2223) + lu(k,2227) = lu(k,2227) - lu(k,1004) * lu(k,2223) + lu(k,2229) = lu(k,2229) - lu(k,1005) * lu(k,2223) + lu(k,2230) = lu(k,2230) - lu(k,1006) * lu(k,2223) + lu(k,2231) = lu(k,2231) - lu(k,1007) * lu(k,2223) + lu(k,2235) = lu(k,2235) - lu(k,1008) * lu(k,2223) + lu(k,2242) = lu(k,2242) - lu(k,1009) * lu(k,2223) + lu(k,2246) = lu(k,2246) - lu(k,1010) * lu(k,2223) + lu(k,2247) = lu(k,2247) - lu(k,1011) * lu(k,2223) + lu(k,2249) = lu(k,2249) - lu(k,1012) * lu(k,2223) + lu(k,2251) = lu(k,2251) - lu(k,1013) * lu(k,2223) + lu(k,2252) = lu(k,2252) - lu(k,1014) * lu(k,2223) + lu(k,2253) = lu(k,2253) - lu(k,1015) * lu(k,2223) + lu(k,2254) = lu(k,2254) - lu(k,1016) * lu(k,2223) + lu(k,2256) = lu(k,2256) - lu(k,1017) * lu(k,2223) + lu(k,2259) = lu(k,2259) - lu(k,1018) * lu(k,2223) + lu(k,2260) = lu(k,2260) - lu(k,1019) * lu(k,2223) + lu(k,2261) = lu(k,2261) - lu(k,1020) * lu(k,2223) + end do + end subroutine lu_fac21 + subroutine lu_fac22( 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,1026) = 1._r8 / lu(k,1026) + lu(k,1027) = lu(k,1027) * lu(k,1026) + lu(k,1028) = lu(k,1028) * lu(k,1026) + lu(k,1029) = lu(k,1029) * lu(k,1026) + lu(k,1030) = lu(k,1030) * lu(k,1026) + lu(k,1031) = lu(k,1031) * lu(k,1026) + lu(k,1032) = lu(k,1032) * lu(k,1026) + lu(k,1033) = lu(k,1033) * lu(k,1026) + lu(k,1034) = lu(k,1034) * lu(k,1026) + lu(k,1035) = lu(k,1035) * lu(k,1026) + lu(k,1036) = lu(k,1036) * lu(k,1026) + lu(k,1037) = lu(k,1037) * lu(k,1026) + lu(k,1038) = lu(k,1038) * lu(k,1026) + lu(k,1039) = lu(k,1039) * lu(k,1026) + lu(k,1040) = lu(k,1040) * lu(k,1026) + lu(k,1041) = lu(k,1041) * lu(k,1026) + lu(k,1042) = lu(k,1042) * lu(k,1026) + lu(k,1329) = lu(k,1329) - lu(k,1027) * lu(k,1328) + lu(k,1330) = lu(k,1330) - lu(k,1028) * lu(k,1328) + lu(k,1331) = - lu(k,1029) * lu(k,1328) + lu(k,1332) = lu(k,1332) - lu(k,1030) * lu(k,1328) + lu(k,1336) = lu(k,1336) - lu(k,1031) * lu(k,1328) + lu(k,1337) = - lu(k,1032) * lu(k,1328) + lu(k,1339) = lu(k,1339) - lu(k,1033) * lu(k,1328) + lu(k,1340) = lu(k,1340) - lu(k,1034) * lu(k,1328) + lu(k,1341) = - lu(k,1035) * lu(k,1328) + lu(k,1342) = lu(k,1342) - lu(k,1036) * lu(k,1328) + lu(k,1343) = - lu(k,1037) * lu(k,1328) + lu(k,1344) = - lu(k,1038) * lu(k,1328) + lu(k,1345) = lu(k,1345) - lu(k,1039) * lu(k,1328) + lu(k,1346) = lu(k,1346) - lu(k,1040) * lu(k,1328) + lu(k,1347) = lu(k,1347) - lu(k,1041) * lu(k,1328) + lu(k,1348) = lu(k,1348) - lu(k,1042) * lu(k,1328) + lu(k,1668) = lu(k,1668) - lu(k,1027) * lu(k,1664) + lu(k,1671) = lu(k,1671) - lu(k,1028) * lu(k,1664) + lu(k,1673) = lu(k,1673) - lu(k,1029) * lu(k,1664) + lu(k,1678) = lu(k,1678) - lu(k,1030) * lu(k,1664) + lu(k,1685) = lu(k,1685) - lu(k,1031) * lu(k,1664) + lu(k,1688) = lu(k,1688) - lu(k,1032) * lu(k,1664) + lu(k,1691) = lu(k,1691) - lu(k,1033) * lu(k,1664) + lu(k,1693) = lu(k,1693) - lu(k,1034) * lu(k,1664) + lu(k,1695) = lu(k,1695) - lu(k,1035) * lu(k,1664) + lu(k,1696) = lu(k,1696) - lu(k,1036) * lu(k,1664) + lu(k,1697) = lu(k,1697) - lu(k,1037) * lu(k,1664) + lu(k,1698) = lu(k,1698) - lu(k,1038) * lu(k,1664) + lu(k,1700) = lu(k,1700) - lu(k,1039) * lu(k,1664) + lu(k,1703) = lu(k,1703) - lu(k,1040) * lu(k,1664) + lu(k,1704) = lu(k,1704) - lu(k,1041) * lu(k,1664) + lu(k,1705) = lu(k,1705) - lu(k,1042) * lu(k,1664) + lu(k,1752) = lu(k,1752) - lu(k,1027) * lu(k,1748) + lu(k,1755) = lu(k,1755) - lu(k,1028) * lu(k,1748) + lu(k,1757) = lu(k,1757) - lu(k,1029) * lu(k,1748) + lu(k,1762) = lu(k,1762) - lu(k,1030) * lu(k,1748) + lu(k,1769) = lu(k,1769) - lu(k,1031) * lu(k,1748) + lu(k,1771) = - lu(k,1032) * lu(k,1748) + lu(k,1774) = lu(k,1774) - lu(k,1033) * lu(k,1748) + lu(k,1776) = lu(k,1776) - lu(k,1034) * lu(k,1748) + lu(k,1778) = lu(k,1778) - lu(k,1035) * lu(k,1748) + lu(k,1779) = lu(k,1779) - lu(k,1036) * lu(k,1748) + lu(k,1780) = lu(k,1780) - lu(k,1037) * lu(k,1748) + lu(k,1781) = lu(k,1781) - lu(k,1038) * lu(k,1748) + lu(k,1783) = lu(k,1783) - lu(k,1039) * lu(k,1748) + lu(k,1786) = lu(k,1786) - lu(k,1040) * lu(k,1748) + lu(k,1787) = lu(k,1787) - lu(k,1041) * lu(k,1748) + lu(k,1788) = lu(k,1788) - lu(k,1042) * lu(k,1748) + lu(k,2227) = lu(k,2227) - lu(k,1027) * lu(k,2224) + lu(k,2230) = lu(k,2230) - lu(k,1028) * lu(k,2224) + lu(k,2232) = - lu(k,1029) * lu(k,2224) + lu(k,2235) = lu(k,2235) - lu(k,1030) * lu(k,2224) + lu(k,2242) = lu(k,2242) - lu(k,1031) * lu(k,2224) + lu(k,2244) = lu(k,2244) - lu(k,1032) * lu(k,2224) + lu(k,2247) = lu(k,2247) - lu(k,1033) * lu(k,2224) + lu(k,2249) = lu(k,2249) - lu(k,1034) * lu(k,2224) + lu(k,2251) = lu(k,2251) - lu(k,1035) * lu(k,2224) + lu(k,2252) = lu(k,2252) - lu(k,1036) * lu(k,2224) + lu(k,2253) = lu(k,2253) - lu(k,1037) * lu(k,2224) + lu(k,2254) = lu(k,2254) - lu(k,1038) * lu(k,2224) + lu(k,2256) = lu(k,2256) - lu(k,1039) * lu(k,2224) + lu(k,2259) = lu(k,2259) - lu(k,1040) * lu(k,2224) + lu(k,2260) = lu(k,2260) - lu(k,1041) * lu(k,2224) + lu(k,2261) = lu(k,2261) - lu(k,1042) * lu(k,2224) + lu(k,1047) = 1._r8 / lu(k,1047) + lu(k,1048) = lu(k,1048) * lu(k,1047) + lu(k,1049) = lu(k,1049) * lu(k,1047) + lu(k,1050) = lu(k,1050) * lu(k,1047) + lu(k,1051) = lu(k,1051) * lu(k,1047) + lu(k,1052) = lu(k,1052) * lu(k,1047) + lu(k,1053) = lu(k,1053) * lu(k,1047) + lu(k,1054) = lu(k,1054) * lu(k,1047) + lu(k,1055) = lu(k,1055) * lu(k,1047) + lu(k,1056) = lu(k,1056) * lu(k,1047) + lu(k,1057) = lu(k,1057) * lu(k,1047) + lu(k,1058) = lu(k,1058) * lu(k,1047) + lu(k,1666) = lu(k,1666) - lu(k,1048) * lu(k,1665) + lu(k,1670) = lu(k,1670) - lu(k,1049) * lu(k,1665) + lu(k,1671) = lu(k,1671) - lu(k,1050) * lu(k,1665) + lu(k,1690) = lu(k,1690) - lu(k,1051) * lu(k,1665) + lu(k,1691) = lu(k,1691) - lu(k,1052) * lu(k,1665) + lu(k,1693) = lu(k,1693) - lu(k,1053) * lu(k,1665) + lu(k,1695) = lu(k,1695) - lu(k,1054) * lu(k,1665) + lu(k,1696) = lu(k,1696) - lu(k,1055) * lu(k,1665) + lu(k,1697) = lu(k,1697) - lu(k,1056) * lu(k,1665) + lu(k,1698) = lu(k,1698) - lu(k,1057) * lu(k,1665) + lu(k,1700) = lu(k,1700) - lu(k,1058) * lu(k,1665) + lu(k,1750) = lu(k,1750) - lu(k,1048) * lu(k,1749) + lu(k,1754) = lu(k,1754) - lu(k,1049) * lu(k,1749) + lu(k,1755) = lu(k,1755) - lu(k,1050) * lu(k,1749) + lu(k,1773) = lu(k,1773) - lu(k,1051) * lu(k,1749) + lu(k,1774) = lu(k,1774) - lu(k,1052) * lu(k,1749) + lu(k,1776) = lu(k,1776) - lu(k,1053) * lu(k,1749) + lu(k,1778) = lu(k,1778) - lu(k,1054) * lu(k,1749) + lu(k,1779) = lu(k,1779) - lu(k,1055) * lu(k,1749) + lu(k,1780) = lu(k,1780) - lu(k,1056) * lu(k,1749) + lu(k,1781) = lu(k,1781) - lu(k,1057) * lu(k,1749) + lu(k,1783) = lu(k,1783) - lu(k,1058) * lu(k,1749) + lu(k,1805) = lu(k,1805) - lu(k,1048) * lu(k,1804) + lu(k,1809) = lu(k,1809) - lu(k,1049) * lu(k,1804) + lu(k,1810) = lu(k,1810) - lu(k,1050) * lu(k,1804) + lu(k,1825) = lu(k,1825) - lu(k,1051) * lu(k,1804) + lu(k,1826) = lu(k,1826) - lu(k,1052) * lu(k,1804) + lu(k,1828) = lu(k,1828) - lu(k,1053) * lu(k,1804) + lu(k,1830) = lu(k,1830) - lu(k,1054) * lu(k,1804) + lu(k,1831) = lu(k,1831) - lu(k,1055) * lu(k,1804) + lu(k,1832) = lu(k,1832) - lu(k,1056) * lu(k,1804) + lu(k,1833) = lu(k,1833) - lu(k,1057) * lu(k,1804) + lu(k,1835) = lu(k,1835) - lu(k,1058) * lu(k,1804) + lu(k,1895) = lu(k,1895) - lu(k,1048) * lu(k,1894) + lu(k,1899) = lu(k,1899) - lu(k,1049) * lu(k,1894) + lu(k,1900) = lu(k,1900) - lu(k,1050) * lu(k,1894) + lu(k,1917) = lu(k,1917) - lu(k,1051) * lu(k,1894) + lu(k,1918) = lu(k,1918) - lu(k,1052) * lu(k,1894) + lu(k,1920) = lu(k,1920) - lu(k,1053) * lu(k,1894) + lu(k,1922) = lu(k,1922) - lu(k,1054) * lu(k,1894) + lu(k,1923) = lu(k,1923) - lu(k,1055) * lu(k,1894) + lu(k,1924) = lu(k,1924) - lu(k,1056) * lu(k,1894) + lu(k,1925) = lu(k,1925) - lu(k,1057) * lu(k,1894) + lu(k,1927) = lu(k,1927) - lu(k,1058) * lu(k,1894) + lu(k,2086) = lu(k,2086) - lu(k,1048) * lu(k,2085) + lu(k,2089) = lu(k,2089) - lu(k,1049) * lu(k,2085) + lu(k,2090) = lu(k,2090) - lu(k,1050) * lu(k,2085) + lu(k,2107) = lu(k,2107) - lu(k,1051) * lu(k,2085) + lu(k,2108) = lu(k,2108) - lu(k,1052) * lu(k,2085) + lu(k,2110) = lu(k,2110) - lu(k,1053) * lu(k,2085) + lu(k,2112) = lu(k,2112) - lu(k,1054) * lu(k,2085) + lu(k,2113) = lu(k,2113) - lu(k,1055) * lu(k,2085) + lu(k,2114) = lu(k,2114) - lu(k,1056) * lu(k,2085) + lu(k,2115) = lu(k,2115) - lu(k,1057) * lu(k,2085) + lu(k,2117) = lu(k,2117) - lu(k,1058) * lu(k,2085) + lu(k,2226) = lu(k,2226) - lu(k,1048) * lu(k,2225) + lu(k,2229) = lu(k,2229) - lu(k,1049) * lu(k,2225) + lu(k,2230) = lu(k,2230) - lu(k,1050) * lu(k,2225) + lu(k,2246) = lu(k,2246) - lu(k,1051) * lu(k,2225) + lu(k,2247) = lu(k,2247) - lu(k,1052) * lu(k,2225) + lu(k,2249) = lu(k,2249) - lu(k,1053) * lu(k,2225) + lu(k,2251) = lu(k,2251) - lu(k,1054) * lu(k,2225) + lu(k,2252) = lu(k,2252) - lu(k,1055) * lu(k,2225) + lu(k,2253) = lu(k,2253) - lu(k,1056) * lu(k,2225) + lu(k,2254) = lu(k,2254) - lu(k,1057) * lu(k,2225) + lu(k,2256) = lu(k,2256) - lu(k,1058) * lu(k,2225) + lu(k,1061) = 1._r8 / lu(k,1061) + lu(k,1062) = lu(k,1062) * lu(k,1061) + lu(k,1063) = lu(k,1063) * lu(k,1061) + lu(k,1064) = lu(k,1064) * lu(k,1061) + lu(k,1065) = lu(k,1065) * lu(k,1061) + lu(k,1066) = lu(k,1066) * lu(k,1061) + lu(k,1067) = lu(k,1067) * lu(k,1061) + lu(k,1068) = lu(k,1068) * lu(k,1061) + lu(k,1069) = lu(k,1069) * lu(k,1061) + lu(k,1070) = lu(k,1070) * lu(k,1061) + lu(k,1112) = lu(k,1112) - lu(k,1062) * lu(k,1109) + lu(k,1113) = lu(k,1113) - lu(k,1063) * lu(k,1109) + lu(k,1114) = lu(k,1114) - lu(k,1064) * lu(k,1109) + lu(k,1116) = lu(k,1116) - lu(k,1065) * lu(k,1109) + lu(k,1117) = lu(k,1117) - lu(k,1066) * lu(k,1109) + lu(k,1118) = lu(k,1118) - lu(k,1067) * lu(k,1109) + lu(k,1121) = lu(k,1121) - lu(k,1068) * lu(k,1109) + lu(k,1122) = lu(k,1122) - lu(k,1069) * lu(k,1109) + lu(k,1123) = lu(k,1123) - lu(k,1070) * lu(k,1109) + lu(k,1671) = lu(k,1671) - lu(k,1062) * lu(k,1666) + lu(k,1672) = lu(k,1672) - lu(k,1063) * lu(k,1666) + lu(k,1685) = lu(k,1685) - lu(k,1064) * lu(k,1666) + lu(k,1691) = lu(k,1691) - lu(k,1065) * lu(k,1666) + lu(k,1693) = lu(k,1693) - lu(k,1066) * lu(k,1666) + lu(k,1696) = lu(k,1696) - lu(k,1067) * lu(k,1666) + lu(k,1700) = lu(k,1700) - lu(k,1068) * lu(k,1666) + lu(k,1703) = lu(k,1703) - lu(k,1069) * lu(k,1666) + lu(k,1705) = lu(k,1705) - lu(k,1070) * lu(k,1666) + lu(k,1755) = lu(k,1755) - lu(k,1062) * lu(k,1750) + lu(k,1756) = lu(k,1756) - lu(k,1063) * lu(k,1750) + lu(k,1769) = lu(k,1769) - lu(k,1064) * lu(k,1750) + lu(k,1774) = lu(k,1774) - lu(k,1065) * lu(k,1750) + lu(k,1776) = lu(k,1776) - lu(k,1066) * lu(k,1750) + lu(k,1779) = lu(k,1779) - lu(k,1067) * lu(k,1750) + lu(k,1783) = lu(k,1783) - lu(k,1068) * lu(k,1750) + lu(k,1786) = lu(k,1786) - lu(k,1069) * lu(k,1750) + lu(k,1788) = lu(k,1788) - lu(k,1070) * lu(k,1750) + lu(k,1810) = lu(k,1810) - lu(k,1062) * lu(k,1805) + lu(k,1811) = lu(k,1811) - lu(k,1063) * lu(k,1805) + lu(k,1822) = lu(k,1822) - lu(k,1064) * lu(k,1805) + lu(k,1826) = lu(k,1826) - lu(k,1065) * lu(k,1805) + lu(k,1828) = lu(k,1828) - lu(k,1066) * lu(k,1805) + lu(k,1831) = lu(k,1831) - lu(k,1067) * lu(k,1805) + lu(k,1835) = lu(k,1835) - lu(k,1068) * lu(k,1805) + lu(k,1838) = lu(k,1838) - lu(k,1069) * lu(k,1805) + lu(k,1840) = lu(k,1840) - lu(k,1070) * lu(k,1805) + lu(k,1900) = lu(k,1900) - lu(k,1062) * lu(k,1895) + lu(k,1901) = lu(k,1901) - lu(k,1063) * lu(k,1895) + lu(k,1913) = lu(k,1913) - lu(k,1064) * lu(k,1895) + lu(k,1918) = lu(k,1918) - lu(k,1065) * lu(k,1895) + lu(k,1920) = lu(k,1920) - lu(k,1066) * lu(k,1895) + lu(k,1923) = lu(k,1923) - lu(k,1067) * lu(k,1895) + lu(k,1927) = lu(k,1927) - lu(k,1068) * lu(k,1895) + lu(k,1930) = lu(k,1930) - lu(k,1069) * lu(k,1895) + lu(k,1932) = lu(k,1932) - lu(k,1070) * lu(k,1895) + lu(k,2090) = lu(k,2090) - lu(k,1062) * lu(k,2086) + lu(k,2091) = lu(k,2091) - lu(k,1063) * lu(k,2086) + lu(k,2102) = lu(k,2102) - lu(k,1064) * lu(k,2086) + lu(k,2108) = lu(k,2108) - lu(k,1065) * lu(k,2086) + lu(k,2110) = lu(k,2110) - lu(k,1066) * lu(k,2086) + lu(k,2113) = lu(k,2113) - lu(k,1067) * lu(k,2086) + lu(k,2117) = lu(k,2117) - lu(k,1068) * lu(k,2086) + lu(k,2120) = lu(k,2120) - lu(k,1069) * lu(k,2086) + lu(k,2122) = lu(k,2122) - lu(k,1070) * lu(k,2086) + lu(k,2230) = lu(k,2230) - lu(k,1062) * lu(k,2226) + lu(k,2231) = lu(k,2231) - lu(k,1063) * lu(k,2226) + lu(k,2242) = lu(k,2242) - lu(k,1064) * lu(k,2226) + lu(k,2247) = lu(k,2247) - lu(k,1065) * lu(k,2226) + lu(k,2249) = lu(k,2249) - lu(k,1066) * lu(k,2226) + lu(k,2252) = lu(k,2252) - lu(k,1067) * lu(k,2226) + lu(k,2256) = lu(k,2256) - lu(k,1068) * lu(k,2226) + lu(k,2259) = lu(k,2259) - lu(k,1069) * lu(k,2226) + lu(k,2261) = lu(k,2261) - lu(k,1070) * lu(k,2226) + lu(k,1075) = 1._r8 / lu(k,1075) + lu(k,1076) = lu(k,1076) * lu(k,1075) + lu(k,1077) = lu(k,1077) * lu(k,1075) + lu(k,1078) = lu(k,1078) * lu(k,1075) + lu(k,1079) = lu(k,1079) * lu(k,1075) + lu(k,1080) = lu(k,1080) * lu(k,1075) + lu(k,1081) = lu(k,1081) * lu(k,1075) + lu(k,1082) = lu(k,1082) * lu(k,1075) + lu(k,1083) = lu(k,1083) * lu(k,1075) + lu(k,1084) = lu(k,1084) * lu(k,1075) + lu(k,1085) = lu(k,1085) * lu(k,1075) + lu(k,1086) = lu(k,1086) * lu(k,1075) + lu(k,1193) = - lu(k,1076) * lu(k,1191) + lu(k,1197) = lu(k,1197) - lu(k,1077) * lu(k,1191) + lu(k,1199) = lu(k,1199) - lu(k,1078) * lu(k,1191) + lu(k,1200) = lu(k,1200) - lu(k,1079) * lu(k,1191) + lu(k,1201) = lu(k,1201) - lu(k,1080) * lu(k,1191) + lu(k,1202) = lu(k,1202) - lu(k,1081) * lu(k,1191) + lu(k,1204) = lu(k,1204) - lu(k,1082) * lu(k,1191) + lu(k,1205) = lu(k,1205) - lu(k,1083) * lu(k,1191) + lu(k,1206) = lu(k,1206) - lu(k,1084) * lu(k,1191) + lu(k,1207) = lu(k,1207) - lu(k,1085) * lu(k,1191) + lu(k,1208) = - lu(k,1086) * lu(k,1191) + lu(k,1377) = lu(k,1377) - lu(k,1076) * lu(k,1375) + lu(k,1382) = lu(k,1382) - lu(k,1077) * lu(k,1375) + lu(k,1388) = lu(k,1388) - lu(k,1078) * lu(k,1375) + lu(k,1390) = - lu(k,1079) * lu(k,1375) + lu(k,1391) = lu(k,1391) - lu(k,1080) * lu(k,1375) + lu(k,1392) = lu(k,1392) - lu(k,1081) * lu(k,1375) + lu(k,1394) = lu(k,1394) - lu(k,1082) * lu(k,1375) + lu(k,1395) = lu(k,1395) - lu(k,1083) * lu(k,1375) + lu(k,1396) = lu(k,1396) - lu(k,1084) * lu(k,1375) + lu(k,1397) = lu(k,1397) - lu(k,1085) * lu(k,1375) + lu(k,1398) = lu(k,1398) - lu(k,1086) * lu(k,1375) + lu(k,1671) = lu(k,1671) - lu(k,1076) * lu(k,1667) + lu(k,1678) = lu(k,1678) - lu(k,1077) * lu(k,1667) + lu(k,1685) = lu(k,1685) - lu(k,1078) * lu(k,1667) + lu(k,1690) = lu(k,1690) - lu(k,1079) * lu(k,1667) + lu(k,1691) = lu(k,1691) - lu(k,1080) * lu(k,1667) + lu(k,1693) = lu(k,1693) - lu(k,1081) * lu(k,1667) + lu(k,1696) = lu(k,1696) - lu(k,1082) * lu(k,1667) + lu(k,1697) = lu(k,1697) - lu(k,1083) * lu(k,1667) + lu(k,1698) = lu(k,1698) - lu(k,1084) * lu(k,1667) + lu(k,1700) = lu(k,1700) - lu(k,1085) * lu(k,1667) + lu(k,1703) = lu(k,1703) - lu(k,1086) * lu(k,1667) + lu(k,1755) = lu(k,1755) - lu(k,1076) * lu(k,1751) + lu(k,1762) = lu(k,1762) - lu(k,1077) * lu(k,1751) + lu(k,1769) = lu(k,1769) - lu(k,1078) * lu(k,1751) + lu(k,1773) = lu(k,1773) - lu(k,1079) * lu(k,1751) + lu(k,1774) = lu(k,1774) - lu(k,1080) * lu(k,1751) + lu(k,1776) = lu(k,1776) - lu(k,1081) * lu(k,1751) + lu(k,1779) = lu(k,1779) - lu(k,1082) * lu(k,1751) + lu(k,1780) = lu(k,1780) - lu(k,1083) * lu(k,1751) + lu(k,1781) = lu(k,1781) - lu(k,1084) * lu(k,1751) + lu(k,1783) = lu(k,1783) - lu(k,1085) * lu(k,1751) + lu(k,1786) = lu(k,1786) - lu(k,1086) * lu(k,1751) + lu(k,1810) = lu(k,1810) - lu(k,1076) * lu(k,1806) + lu(k,1816) = lu(k,1816) - lu(k,1077) * lu(k,1806) + lu(k,1822) = lu(k,1822) - lu(k,1078) * lu(k,1806) + lu(k,1825) = lu(k,1825) - lu(k,1079) * lu(k,1806) + lu(k,1826) = lu(k,1826) - lu(k,1080) * lu(k,1806) + lu(k,1828) = lu(k,1828) - lu(k,1081) * lu(k,1806) + lu(k,1831) = lu(k,1831) - lu(k,1082) * lu(k,1806) + lu(k,1832) = lu(k,1832) - lu(k,1083) * lu(k,1806) + lu(k,1833) = lu(k,1833) - lu(k,1084) * lu(k,1806) + lu(k,1835) = lu(k,1835) - lu(k,1085) * lu(k,1806) + lu(k,1838) = lu(k,1838) - lu(k,1086) * lu(k,1806) + lu(k,1900) = lu(k,1900) - lu(k,1076) * lu(k,1896) + lu(k,1907) = lu(k,1907) - lu(k,1077) * lu(k,1896) + lu(k,1913) = lu(k,1913) - lu(k,1078) * lu(k,1896) + lu(k,1917) = lu(k,1917) - lu(k,1079) * lu(k,1896) + lu(k,1918) = lu(k,1918) - lu(k,1080) * lu(k,1896) + lu(k,1920) = lu(k,1920) - lu(k,1081) * lu(k,1896) + lu(k,1923) = lu(k,1923) - lu(k,1082) * lu(k,1896) + lu(k,1924) = lu(k,1924) - lu(k,1083) * lu(k,1896) + lu(k,1925) = lu(k,1925) - lu(k,1084) * lu(k,1896) + lu(k,1927) = lu(k,1927) - lu(k,1085) * lu(k,1896) + lu(k,1930) = lu(k,1930) - lu(k,1086) * lu(k,1896) + end do + end subroutine lu_fac22 + subroutine lu_fac23( 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,1087) = 1._r8 / lu(k,1087) + lu(k,1088) = lu(k,1088) * lu(k,1087) + lu(k,1089) = lu(k,1089) * lu(k,1087) + lu(k,1090) = lu(k,1090) * lu(k,1087) + lu(k,1091) = lu(k,1091) * lu(k,1087) + lu(k,1092) = lu(k,1092) * lu(k,1087) + lu(k,1093) = lu(k,1093) * lu(k,1087) + lu(k,1094) = lu(k,1094) * lu(k,1087) + lu(k,1095) = lu(k,1095) * lu(k,1087) + lu(k,1152) = lu(k,1152) - lu(k,1088) * lu(k,1150) + lu(k,1157) = lu(k,1157) - lu(k,1089) * lu(k,1150) + lu(k,1158) = lu(k,1158) - lu(k,1090) * lu(k,1150) + lu(k,1160) = lu(k,1160) - lu(k,1091) * lu(k,1150) + lu(k,1161) = - lu(k,1092) * lu(k,1150) + lu(k,1162) = lu(k,1162) - lu(k,1093) * lu(k,1150) + lu(k,1165) = lu(k,1165) - lu(k,1094) * lu(k,1150) + lu(k,1167) = lu(k,1167) - lu(k,1095) * lu(k,1150) + lu(k,1330) = lu(k,1330) - lu(k,1088) * lu(k,1329) + lu(k,1336) = lu(k,1336) - lu(k,1089) * lu(k,1329) + lu(k,1338) = - lu(k,1090) * lu(k,1329) + lu(k,1340) = lu(k,1340) - lu(k,1091) * lu(k,1329) + lu(k,1341) = lu(k,1341) - lu(k,1092) * lu(k,1329) + lu(k,1342) = lu(k,1342) - lu(k,1093) * lu(k,1329) + lu(k,1345) = lu(k,1345) - lu(k,1094) * lu(k,1329) + lu(k,1348) = lu(k,1348) - lu(k,1095) * lu(k,1329) + lu(k,1671) = lu(k,1671) - lu(k,1088) * lu(k,1668) + lu(k,1685) = lu(k,1685) - lu(k,1089) * lu(k,1668) + lu(k,1690) = lu(k,1690) - lu(k,1090) * lu(k,1668) + lu(k,1693) = lu(k,1693) - lu(k,1091) * lu(k,1668) + lu(k,1695) = lu(k,1695) - lu(k,1092) * lu(k,1668) + lu(k,1696) = lu(k,1696) - lu(k,1093) * lu(k,1668) + lu(k,1700) = lu(k,1700) - lu(k,1094) * lu(k,1668) + lu(k,1705) = lu(k,1705) - lu(k,1095) * lu(k,1668) + lu(k,1755) = lu(k,1755) - lu(k,1088) * lu(k,1752) + lu(k,1769) = lu(k,1769) - lu(k,1089) * lu(k,1752) + lu(k,1773) = lu(k,1773) - lu(k,1090) * lu(k,1752) + lu(k,1776) = lu(k,1776) - lu(k,1091) * lu(k,1752) + lu(k,1778) = lu(k,1778) - lu(k,1092) * lu(k,1752) + lu(k,1779) = lu(k,1779) - lu(k,1093) * lu(k,1752) + lu(k,1783) = lu(k,1783) - lu(k,1094) * lu(k,1752) + lu(k,1788) = lu(k,1788) - lu(k,1095) * lu(k,1752) + lu(k,1810) = lu(k,1810) - lu(k,1088) * lu(k,1807) + lu(k,1822) = lu(k,1822) - lu(k,1089) * lu(k,1807) + lu(k,1825) = lu(k,1825) - lu(k,1090) * lu(k,1807) + lu(k,1828) = lu(k,1828) - lu(k,1091) * lu(k,1807) + lu(k,1830) = lu(k,1830) - lu(k,1092) * lu(k,1807) + lu(k,1831) = lu(k,1831) - lu(k,1093) * lu(k,1807) + lu(k,1835) = lu(k,1835) - lu(k,1094) * lu(k,1807) + lu(k,1840) = lu(k,1840) - lu(k,1095) * lu(k,1807) + lu(k,1900) = lu(k,1900) - lu(k,1088) * lu(k,1897) + lu(k,1913) = lu(k,1913) - lu(k,1089) * lu(k,1897) + lu(k,1917) = lu(k,1917) - lu(k,1090) * lu(k,1897) + lu(k,1920) = lu(k,1920) - lu(k,1091) * lu(k,1897) + lu(k,1922) = lu(k,1922) - lu(k,1092) * lu(k,1897) + lu(k,1923) = lu(k,1923) - lu(k,1093) * lu(k,1897) + lu(k,1927) = lu(k,1927) - lu(k,1094) * lu(k,1897) + lu(k,1932) = lu(k,1932) - lu(k,1095) * lu(k,1897) + lu(k,1994) = lu(k,1994) - lu(k,1088) * lu(k,1992) + lu(k,1995) = - lu(k,1089) * lu(k,1992) + lu(k,2000) = lu(k,2000) - lu(k,1090) * lu(k,1992) + lu(k,2003) = lu(k,2003) - lu(k,1091) * lu(k,1992) + lu(k,2005) = lu(k,2005) - lu(k,1092) * lu(k,1992) + lu(k,2006) = lu(k,2006) - lu(k,1093) * lu(k,1992) + lu(k,2010) = lu(k,2010) - lu(k,1094) * lu(k,1992) + lu(k,2015) = lu(k,2015) - lu(k,1095) * lu(k,1992) + lu(k,2090) = lu(k,2090) - lu(k,1088) * lu(k,2087) + lu(k,2102) = lu(k,2102) - lu(k,1089) * lu(k,2087) + lu(k,2107) = lu(k,2107) - lu(k,1090) * lu(k,2087) + lu(k,2110) = lu(k,2110) - lu(k,1091) * lu(k,2087) + lu(k,2112) = lu(k,2112) - lu(k,1092) * lu(k,2087) + lu(k,2113) = lu(k,2113) - lu(k,1093) * lu(k,2087) + lu(k,2117) = lu(k,2117) - lu(k,1094) * lu(k,2087) + lu(k,2122) = lu(k,2122) - lu(k,1095) * lu(k,2087) + lu(k,2230) = lu(k,2230) - lu(k,1088) * lu(k,2227) + lu(k,2242) = lu(k,2242) - lu(k,1089) * lu(k,2227) + lu(k,2246) = lu(k,2246) - lu(k,1090) * lu(k,2227) + lu(k,2249) = lu(k,2249) - lu(k,1091) * lu(k,2227) + lu(k,2251) = lu(k,2251) - lu(k,1092) * lu(k,2227) + lu(k,2252) = lu(k,2252) - lu(k,1093) * lu(k,2227) + lu(k,2256) = lu(k,2256) - lu(k,1094) * lu(k,2227) + lu(k,2261) = lu(k,2261) - lu(k,1095) * lu(k,2227) + lu(k,1098) = 1._r8 / lu(k,1098) + lu(k,1099) = lu(k,1099) * lu(k,1098) + lu(k,1100) = lu(k,1100) * lu(k,1098) + lu(k,1101) = lu(k,1101) * lu(k,1098) + lu(k,1102) = lu(k,1102) * lu(k,1098) + lu(k,1103) = lu(k,1103) * lu(k,1098) + lu(k,1112) = lu(k,1112) - lu(k,1099) * lu(k,1110) + lu(k,1116) = lu(k,1116) - lu(k,1100) * lu(k,1110) + lu(k,1117) = lu(k,1117) - lu(k,1101) * lu(k,1110) + lu(k,1121) = lu(k,1121) - lu(k,1102) * lu(k,1110) + lu(k,1122) = lu(k,1122) - lu(k,1103) * lu(k,1110) + lu(k,1152) = lu(k,1152) - lu(k,1099) * lu(k,1151) + lu(k,1159) = lu(k,1159) - lu(k,1100) * lu(k,1151) + lu(k,1160) = lu(k,1160) - lu(k,1101) * lu(k,1151) + lu(k,1165) = lu(k,1165) - lu(k,1102) * lu(k,1151) + lu(k,1166) = - lu(k,1103) * lu(k,1151) + lu(k,1173) = lu(k,1173) - lu(k,1099) * lu(k,1172) + lu(k,1178) = lu(k,1178) - lu(k,1100) * lu(k,1172) + lu(k,1179) = lu(k,1179) - lu(k,1101) * lu(k,1172) + lu(k,1184) = lu(k,1184) - lu(k,1102) * lu(k,1172) + lu(k,1185) = lu(k,1185) - lu(k,1103) * lu(k,1172) + lu(k,1193) = lu(k,1193) - lu(k,1099) * lu(k,1192) + lu(k,1201) = lu(k,1201) - lu(k,1100) * lu(k,1192) + lu(k,1202) = lu(k,1202) - lu(k,1101) * lu(k,1192) + lu(k,1207) = lu(k,1207) - lu(k,1102) * lu(k,1192) + lu(k,1208) = lu(k,1208) - lu(k,1103) * lu(k,1192) + lu(k,1252) = lu(k,1252) - lu(k,1099) * lu(k,1251) + lu(k,1264) = lu(k,1264) - lu(k,1100) * lu(k,1251) + lu(k,1265) = lu(k,1265) - lu(k,1101) * lu(k,1251) + lu(k,1270) = lu(k,1270) - lu(k,1102) * lu(k,1251) + lu(k,1271) = lu(k,1271) - lu(k,1103) * lu(k,1251) + lu(k,1284) = lu(k,1284) - lu(k,1099) * lu(k,1283) + lu(k,1296) = lu(k,1296) - lu(k,1100) * lu(k,1283) + lu(k,1297) = lu(k,1297) - lu(k,1101) * lu(k,1283) + lu(k,1302) = lu(k,1302) - lu(k,1102) * lu(k,1283) + lu(k,1303) = lu(k,1303) - lu(k,1103) * lu(k,1283) + lu(k,1309) = lu(k,1309) - lu(k,1099) * lu(k,1308) + lu(k,1317) = lu(k,1317) - lu(k,1100) * lu(k,1308) + lu(k,1318) = lu(k,1318) - lu(k,1101) * lu(k,1308) + lu(k,1323) = lu(k,1323) - lu(k,1102) * lu(k,1308) + lu(k,1324) = - lu(k,1103) * lu(k,1308) + lu(k,1377) = lu(k,1377) - lu(k,1099) * lu(k,1376) + lu(k,1391) = lu(k,1391) - lu(k,1100) * lu(k,1376) + lu(k,1392) = lu(k,1392) - lu(k,1101) * lu(k,1376) + lu(k,1397) = lu(k,1397) - lu(k,1102) * lu(k,1376) + lu(k,1398) = lu(k,1398) - lu(k,1103) * lu(k,1376) + lu(k,1671) = lu(k,1671) - lu(k,1099) * lu(k,1669) + lu(k,1691) = lu(k,1691) - lu(k,1100) * lu(k,1669) + lu(k,1693) = lu(k,1693) - lu(k,1101) * lu(k,1669) + lu(k,1700) = lu(k,1700) - lu(k,1102) * lu(k,1669) + lu(k,1703) = lu(k,1703) - lu(k,1103) * lu(k,1669) + lu(k,1755) = lu(k,1755) - lu(k,1099) * lu(k,1753) + lu(k,1774) = lu(k,1774) - lu(k,1100) * lu(k,1753) + lu(k,1776) = lu(k,1776) - lu(k,1101) * lu(k,1753) + lu(k,1783) = lu(k,1783) - lu(k,1102) * lu(k,1753) + lu(k,1786) = lu(k,1786) - lu(k,1103) * lu(k,1753) + lu(k,1810) = lu(k,1810) - lu(k,1099) * lu(k,1808) + lu(k,1826) = lu(k,1826) - lu(k,1100) * lu(k,1808) + lu(k,1828) = lu(k,1828) - lu(k,1101) * lu(k,1808) + lu(k,1835) = lu(k,1835) - lu(k,1102) * lu(k,1808) + lu(k,1838) = lu(k,1838) - lu(k,1103) * lu(k,1808) + lu(k,1900) = lu(k,1900) - lu(k,1099) * lu(k,1898) + lu(k,1918) = lu(k,1918) - lu(k,1100) * lu(k,1898) + lu(k,1920) = lu(k,1920) - lu(k,1101) * lu(k,1898) + lu(k,1927) = lu(k,1927) - lu(k,1102) * lu(k,1898) + lu(k,1930) = lu(k,1930) - lu(k,1103) * lu(k,1898) + lu(k,1994) = lu(k,1994) - lu(k,1099) * lu(k,1993) + lu(k,2001) = lu(k,2001) - lu(k,1100) * lu(k,1993) + lu(k,2003) = lu(k,2003) - lu(k,1101) * lu(k,1993) + lu(k,2010) = lu(k,2010) - lu(k,1102) * lu(k,1993) + lu(k,2013) = lu(k,2013) - lu(k,1103) * lu(k,1993) + lu(k,2090) = lu(k,2090) - lu(k,1099) * lu(k,2088) + lu(k,2108) = lu(k,2108) - lu(k,1100) * lu(k,2088) + lu(k,2110) = lu(k,2110) - lu(k,1101) * lu(k,2088) + lu(k,2117) = lu(k,2117) - lu(k,1102) * lu(k,2088) + lu(k,2120) = lu(k,2120) - lu(k,1103) * lu(k,2088) + lu(k,2230) = lu(k,2230) - lu(k,1099) * lu(k,2228) + lu(k,2247) = lu(k,2247) - lu(k,1100) * lu(k,2228) + lu(k,2249) = lu(k,2249) - lu(k,1101) * lu(k,2228) + lu(k,2256) = lu(k,2256) - lu(k,1102) * lu(k,2228) + lu(k,2259) = lu(k,2259) - lu(k,1103) * lu(k,2228) + lu(k,1111) = 1._r8 / lu(k,1111) + lu(k,1112) = lu(k,1112) * lu(k,1111) + lu(k,1113) = lu(k,1113) * lu(k,1111) + lu(k,1114) = lu(k,1114) * lu(k,1111) + lu(k,1115) = lu(k,1115) * lu(k,1111) + lu(k,1116) = lu(k,1116) * lu(k,1111) + lu(k,1117) = lu(k,1117) * lu(k,1111) + lu(k,1118) = lu(k,1118) * lu(k,1111) + lu(k,1119) = lu(k,1119) * lu(k,1111) + lu(k,1120) = lu(k,1120) * lu(k,1111) + lu(k,1121) = lu(k,1121) * lu(k,1111) + lu(k,1122) = lu(k,1122) * lu(k,1111) + lu(k,1123) = lu(k,1123) * lu(k,1111) + lu(k,1671) = lu(k,1671) - lu(k,1112) * lu(k,1670) + lu(k,1672) = lu(k,1672) - lu(k,1113) * lu(k,1670) + lu(k,1685) = lu(k,1685) - lu(k,1114) * lu(k,1670) + lu(k,1690) = lu(k,1690) - lu(k,1115) * lu(k,1670) + lu(k,1691) = lu(k,1691) - lu(k,1116) * lu(k,1670) + lu(k,1693) = lu(k,1693) - lu(k,1117) * lu(k,1670) + lu(k,1696) = lu(k,1696) - lu(k,1118) * lu(k,1670) + lu(k,1697) = lu(k,1697) - lu(k,1119) * lu(k,1670) + lu(k,1698) = lu(k,1698) - lu(k,1120) * lu(k,1670) + lu(k,1700) = lu(k,1700) - lu(k,1121) * lu(k,1670) + lu(k,1703) = lu(k,1703) - lu(k,1122) * lu(k,1670) + lu(k,1705) = lu(k,1705) - lu(k,1123) * lu(k,1670) + lu(k,1755) = lu(k,1755) - lu(k,1112) * lu(k,1754) + lu(k,1756) = lu(k,1756) - lu(k,1113) * lu(k,1754) + lu(k,1769) = lu(k,1769) - lu(k,1114) * lu(k,1754) + lu(k,1773) = lu(k,1773) - lu(k,1115) * lu(k,1754) + lu(k,1774) = lu(k,1774) - lu(k,1116) * lu(k,1754) + lu(k,1776) = lu(k,1776) - lu(k,1117) * lu(k,1754) + lu(k,1779) = lu(k,1779) - lu(k,1118) * lu(k,1754) + lu(k,1780) = lu(k,1780) - lu(k,1119) * lu(k,1754) + lu(k,1781) = lu(k,1781) - lu(k,1120) * lu(k,1754) + lu(k,1783) = lu(k,1783) - lu(k,1121) * lu(k,1754) + lu(k,1786) = lu(k,1786) - lu(k,1122) * lu(k,1754) + lu(k,1788) = lu(k,1788) - lu(k,1123) * lu(k,1754) + lu(k,1810) = lu(k,1810) - lu(k,1112) * lu(k,1809) + lu(k,1811) = lu(k,1811) - lu(k,1113) * lu(k,1809) + lu(k,1822) = lu(k,1822) - lu(k,1114) * lu(k,1809) + lu(k,1825) = lu(k,1825) - lu(k,1115) * lu(k,1809) + lu(k,1826) = lu(k,1826) - lu(k,1116) * lu(k,1809) + lu(k,1828) = lu(k,1828) - lu(k,1117) * lu(k,1809) + lu(k,1831) = lu(k,1831) - lu(k,1118) * lu(k,1809) + lu(k,1832) = lu(k,1832) - lu(k,1119) * lu(k,1809) + lu(k,1833) = lu(k,1833) - lu(k,1120) * lu(k,1809) + lu(k,1835) = lu(k,1835) - lu(k,1121) * lu(k,1809) + lu(k,1838) = lu(k,1838) - lu(k,1122) * lu(k,1809) + lu(k,1840) = lu(k,1840) - lu(k,1123) * lu(k,1809) + lu(k,1900) = lu(k,1900) - lu(k,1112) * lu(k,1899) + lu(k,1901) = lu(k,1901) - lu(k,1113) * lu(k,1899) + lu(k,1913) = lu(k,1913) - lu(k,1114) * lu(k,1899) + lu(k,1917) = lu(k,1917) - lu(k,1115) * lu(k,1899) + lu(k,1918) = lu(k,1918) - lu(k,1116) * lu(k,1899) + lu(k,1920) = lu(k,1920) - lu(k,1117) * lu(k,1899) + lu(k,1923) = lu(k,1923) - lu(k,1118) * lu(k,1899) + lu(k,1924) = lu(k,1924) - lu(k,1119) * lu(k,1899) + lu(k,1925) = lu(k,1925) - lu(k,1120) * lu(k,1899) + lu(k,1927) = lu(k,1927) - lu(k,1121) * lu(k,1899) + lu(k,1930) = lu(k,1930) - lu(k,1122) * lu(k,1899) + lu(k,1932) = lu(k,1932) - lu(k,1123) * lu(k,1899) + lu(k,2090) = lu(k,2090) - lu(k,1112) * lu(k,2089) + lu(k,2091) = lu(k,2091) - lu(k,1113) * lu(k,2089) + lu(k,2102) = lu(k,2102) - lu(k,1114) * lu(k,2089) + lu(k,2107) = lu(k,2107) - lu(k,1115) * lu(k,2089) + lu(k,2108) = lu(k,2108) - lu(k,1116) * lu(k,2089) + lu(k,2110) = lu(k,2110) - lu(k,1117) * lu(k,2089) + lu(k,2113) = lu(k,2113) - lu(k,1118) * lu(k,2089) + lu(k,2114) = lu(k,2114) - lu(k,1119) * lu(k,2089) + lu(k,2115) = lu(k,2115) - lu(k,1120) * lu(k,2089) + lu(k,2117) = lu(k,2117) - lu(k,1121) * lu(k,2089) + lu(k,2120) = lu(k,2120) - lu(k,1122) * lu(k,2089) + lu(k,2122) = lu(k,2122) - lu(k,1123) * lu(k,2089) + lu(k,2230) = lu(k,2230) - lu(k,1112) * lu(k,2229) + lu(k,2231) = lu(k,2231) - lu(k,1113) * lu(k,2229) + lu(k,2242) = lu(k,2242) - lu(k,1114) * lu(k,2229) + lu(k,2246) = lu(k,2246) - lu(k,1115) * lu(k,2229) + lu(k,2247) = lu(k,2247) - lu(k,1116) * lu(k,2229) + lu(k,2249) = lu(k,2249) - lu(k,1117) * lu(k,2229) + lu(k,2252) = lu(k,2252) - lu(k,1118) * lu(k,2229) + lu(k,2253) = lu(k,2253) - lu(k,1119) * lu(k,2229) + lu(k,2254) = lu(k,2254) - lu(k,1120) * lu(k,2229) + lu(k,2256) = lu(k,2256) - lu(k,1121) * lu(k,2229) + lu(k,2259) = lu(k,2259) - lu(k,1122) * lu(k,2229) + lu(k,2261) = lu(k,2261) - lu(k,1123) * lu(k,2229) + lu(k,1125) = 1._r8 / lu(k,1125) + lu(k,1126) = lu(k,1126) * lu(k,1125) + lu(k,1127) = lu(k,1127) * lu(k,1125) + lu(k,1128) = lu(k,1128) * lu(k,1125) + lu(k,1160) = lu(k,1160) - lu(k,1126) * lu(k,1152) + lu(k,1165) = lu(k,1165) - lu(k,1127) * lu(k,1152) + lu(k,1166) = lu(k,1166) - lu(k,1128) * lu(k,1152) + lu(k,1179) = lu(k,1179) - lu(k,1126) * lu(k,1173) + lu(k,1184) = lu(k,1184) - lu(k,1127) * lu(k,1173) + lu(k,1185) = lu(k,1185) - lu(k,1128) * lu(k,1173) + lu(k,1202) = lu(k,1202) - lu(k,1126) * lu(k,1193) + lu(k,1207) = lu(k,1207) - lu(k,1127) * lu(k,1193) + lu(k,1208) = lu(k,1208) - lu(k,1128) * lu(k,1193) + lu(k,1217) = lu(k,1217) - lu(k,1126) * lu(k,1210) + lu(k,1218) = lu(k,1218) - lu(k,1127) * lu(k,1210) + lu(k,1219) = lu(k,1219) - lu(k,1128) * lu(k,1210) + lu(k,1226) = lu(k,1226) - lu(k,1126) * lu(k,1222) + lu(k,1228) = lu(k,1228) - lu(k,1127) * lu(k,1222) + lu(k,1229) = - lu(k,1128) * lu(k,1222) + lu(k,1265) = lu(k,1265) - lu(k,1126) * lu(k,1252) + lu(k,1270) = lu(k,1270) - lu(k,1127) * lu(k,1252) + lu(k,1271) = lu(k,1271) - lu(k,1128) * lu(k,1252) + lu(k,1297) = lu(k,1297) - lu(k,1126) * lu(k,1284) + lu(k,1302) = lu(k,1302) - lu(k,1127) * lu(k,1284) + lu(k,1303) = lu(k,1303) - lu(k,1128) * lu(k,1284) + lu(k,1318) = lu(k,1318) - lu(k,1126) * lu(k,1309) + lu(k,1323) = lu(k,1323) - lu(k,1127) * lu(k,1309) + lu(k,1324) = lu(k,1324) - lu(k,1128) * lu(k,1309) + lu(k,1340) = lu(k,1340) - lu(k,1126) * lu(k,1330) + lu(k,1345) = lu(k,1345) - lu(k,1127) * lu(k,1330) + lu(k,1346) = lu(k,1346) - lu(k,1128) * lu(k,1330) + lu(k,1360) = lu(k,1360) - lu(k,1126) * lu(k,1353) + lu(k,1365) = lu(k,1365) - lu(k,1127) * lu(k,1353) + lu(k,1366) = lu(k,1366) - lu(k,1128) * lu(k,1353) + lu(k,1392) = lu(k,1392) - lu(k,1126) * lu(k,1377) + lu(k,1397) = lu(k,1397) - lu(k,1127) * lu(k,1377) + lu(k,1398) = lu(k,1398) - lu(k,1128) * lu(k,1377) + lu(k,1421) = lu(k,1421) - lu(k,1126) * lu(k,1416) + lu(k,1422) = lu(k,1422) - lu(k,1127) * lu(k,1416) + lu(k,1424) = lu(k,1424) - lu(k,1128) * lu(k,1416) + lu(k,1437) = lu(k,1437) - lu(k,1126) * lu(k,1430) + lu(k,1441) = lu(k,1441) - lu(k,1127) * lu(k,1430) + lu(k,1443) = lu(k,1443) - lu(k,1128) * lu(k,1430) + lu(k,1489) = lu(k,1489) - lu(k,1126) * lu(k,1481) + lu(k,1495) = lu(k,1495) - lu(k,1127) * lu(k,1481) + lu(k,1498) = lu(k,1498) - lu(k,1128) * lu(k,1481) + lu(k,1693) = lu(k,1693) - lu(k,1126) * lu(k,1671) + lu(k,1700) = lu(k,1700) - lu(k,1127) * lu(k,1671) + lu(k,1703) = lu(k,1703) - lu(k,1128) * lu(k,1671) + lu(k,1776) = lu(k,1776) - lu(k,1126) * lu(k,1755) + lu(k,1783) = lu(k,1783) - lu(k,1127) * lu(k,1755) + lu(k,1786) = lu(k,1786) - lu(k,1128) * lu(k,1755) + lu(k,1828) = lu(k,1828) - lu(k,1126) * lu(k,1810) + lu(k,1835) = lu(k,1835) - lu(k,1127) * lu(k,1810) + lu(k,1838) = lu(k,1838) - lu(k,1128) * lu(k,1810) + lu(k,1920) = lu(k,1920) - lu(k,1126) * lu(k,1900) + lu(k,1927) = lu(k,1927) - lu(k,1127) * lu(k,1900) + lu(k,1930) = lu(k,1930) - lu(k,1128) * lu(k,1900) + lu(k,1964) = lu(k,1964) - lu(k,1126) * lu(k,1952) + lu(k,1971) = lu(k,1971) - lu(k,1127) * lu(k,1952) + lu(k,1974) = lu(k,1974) - lu(k,1128) * lu(k,1952) + lu(k,2003) = lu(k,2003) - lu(k,1126) * lu(k,1994) + lu(k,2010) = lu(k,2010) - lu(k,1127) * lu(k,1994) + lu(k,2013) = lu(k,2013) - lu(k,1128) * lu(k,1994) + lu(k,2110) = lu(k,2110) - lu(k,1126) * lu(k,2090) + lu(k,2117) = lu(k,2117) - lu(k,1127) * lu(k,2090) + lu(k,2120) = lu(k,2120) - lu(k,1128) * lu(k,2090) + lu(k,2188) = lu(k,2188) - lu(k,1126) * lu(k,2179) + lu(k,2195) = lu(k,2195) - lu(k,1127) * lu(k,2179) + lu(k,2198) = lu(k,2198) - lu(k,1128) * lu(k,2179) + lu(k,2249) = lu(k,2249) - lu(k,1126) * lu(k,2230) + lu(k,2256) = lu(k,2256) - lu(k,1127) * lu(k,2230) + lu(k,2259) = lu(k,2259) - lu(k,1128) * lu(k,2230) + lu(k,1131) = 1._r8 / lu(k,1131) + lu(k,1132) = lu(k,1132) * lu(k,1131) + lu(k,1133) = lu(k,1133) * lu(k,1131) + lu(k,1134) = lu(k,1134) * lu(k,1131) + lu(k,1135) = lu(k,1135) * lu(k,1131) + lu(k,1136) = lu(k,1136) * lu(k,1131) + lu(k,1137) = lu(k,1137) * lu(k,1131) + lu(k,1138) = lu(k,1138) * lu(k,1131) + lu(k,1139) = lu(k,1139) * lu(k,1131) + lu(k,1140) = lu(k,1140) * lu(k,1131) + lu(k,1141) = lu(k,1141) * lu(k,1131) + lu(k,1154) = lu(k,1154) - lu(k,1132) * lu(k,1153) + lu(k,1156) = - lu(k,1133) * lu(k,1153) + lu(k,1157) = lu(k,1157) - lu(k,1134) * lu(k,1153) + lu(k,1159) = lu(k,1159) - lu(k,1135) * lu(k,1153) + lu(k,1160) = lu(k,1160) - lu(k,1136) * lu(k,1153) + lu(k,1162) = lu(k,1162) - lu(k,1137) * lu(k,1153) + lu(k,1163) = - lu(k,1138) * lu(k,1153) + lu(k,1164) = lu(k,1164) - lu(k,1139) * lu(k,1153) + lu(k,1165) = lu(k,1165) - lu(k,1140) * lu(k,1153) + lu(k,1167) = lu(k,1167) - lu(k,1141) * lu(k,1153) + lu(k,1673) = lu(k,1673) - lu(k,1132) * lu(k,1672) + lu(k,1678) = lu(k,1678) - lu(k,1133) * lu(k,1672) + lu(k,1685) = lu(k,1685) - lu(k,1134) * lu(k,1672) + lu(k,1691) = lu(k,1691) - lu(k,1135) * lu(k,1672) + lu(k,1693) = lu(k,1693) - lu(k,1136) * lu(k,1672) + lu(k,1696) = lu(k,1696) - lu(k,1137) * lu(k,1672) + lu(k,1697) = lu(k,1697) - lu(k,1138) * lu(k,1672) + lu(k,1698) = lu(k,1698) - lu(k,1139) * lu(k,1672) + lu(k,1700) = lu(k,1700) - lu(k,1140) * lu(k,1672) + lu(k,1705) = lu(k,1705) - lu(k,1141) * lu(k,1672) + lu(k,1757) = lu(k,1757) - lu(k,1132) * lu(k,1756) + lu(k,1762) = lu(k,1762) - lu(k,1133) * lu(k,1756) + lu(k,1769) = lu(k,1769) - lu(k,1134) * lu(k,1756) + lu(k,1774) = lu(k,1774) - lu(k,1135) * lu(k,1756) + lu(k,1776) = lu(k,1776) - lu(k,1136) * lu(k,1756) + lu(k,1779) = lu(k,1779) - lu(k,1137) * lu(k,1756) + lu(k,1780) = lu(k,1780) - lu(k,1138) * lu(k,1756) + lu(k,1781) = lu(k,1781) - lu(k,1139) * lu(k,1756) + lu(k,1783) = lu(k,1783) - lu(k,1140) * lu(k,1756) + lu(k,1788) = lu(k,1788) - lu(k,1141) * lu(k,1756) + lu(k,1812) = lu(k,1812) - lu(k,1132) * lu(k,1811) + lu(k,1816) = lu(k,1816) - lu(k,1133) * lu(k,1811) + lu(k,1822) = lu(k,1822) - lu(k,1134) * lu(k,1811) + lu(k,1826) = lu(k,1826) - lu(k,1135) * lu(k,1811) + lu(k,1828) = lu(k,1828) - lu(k,1136) * lu(k,1811) + lu(k,1831) = lu(k,1831) - lu(k,1137) * lu(k,1811) + lu(k,1832) = lu(k,1832) - lu(k,1138) * lu(k,1811) + lu(k,1833) = lu(k,1833) - lu(k,1139) * lu(k,1811) + lu(k,1835) = lu(k,1835) - lu(k,1140) * lu(k,1811) + lu(k,1840) = lu(k,1840) - lu(k,1141) * lu(k,1811) + lu(k,1902) = lu(k,1902) - lu(k,1132) * lu(k,1901) + lu(k,1907) = lu(k,1907) - lu(k,1133) * lu(k,1901) + lu(k,1913) = lu(k,1913) - lu(k,1134) * lu(k,1901) + lu(k,1918) = lu(k,1918) - lu(k,1135) * lu(k,1901) + lu(k,1920) = lu(k,1920) - lu(k,1136) * lu(k,1901) + lu(k,1923) = lu(k,1923) - lu(k,1137) * lu(k,1901) + lu(k,1924) = lu(k,1924) - lu(k,1138) * lu(k,1901) + lu(k,1925) = lu(k,1925) - lu(k,1139) * lu(k,1901) + lu(k,1927) = lu(k,1927) - lu(k,1140) * lu(k,1901) + lu(k,1932) = lu(k,1932) - lu(k,1141) * lu(k,1901) + lu(k,2092) = lu(k,2092) - lu(k,1132) * lu(k,2091) + lu(k,2096) = lu(k,2096) - lu(k,1133) * lu(k,2091) + lu(k,2102) = lu(k,2102) - lu(k,1134) * lu(k,2091) + lu(k,2108) = lu(k,2108) - lu(k,1135) * lu(k,2091) + lu(k,2110) = lu(k,2110) - lu(k,1136) * lu(k,2091) + lu(k,2113) = lu(k,2113) - lu(k,1137) * lu(k,2091) + lu(k,2114) = lu(k,2114) - lu(k,1138) * lu(k,2091) + lu(k,2115) = lu(k,2115) - lu(k,1139) * lu(k,2091) + lu(k,2117) = lu(k,2117) - lu(k,1140) * lu(k,2091) + lu(k,2122) = lu(k,2122) - lu(k,1141) * lu(k,2091) + lu(k,2232) = lu(k,2232) - lu(k,1132) * lu(k,2231) + lu(k,2235) = lu(k,2235) - lu(k,1133) * lu(k,2231) + lu(k,2242) = lu(k,2242) - lu(k,1134) * lu(k,2231) + lu(k,2247) = lu(k,2247) - lu(k,1135) * lu(k,2231) + lu(k,2249) = lu(k,2249) - lu(k,1136) * lu(k,2231) + lu(k,2252) = lu(k,2252) - lu(k,1137) * lu(k,2231) + lu(k,2253) = lu(k,2253) - lu(k,1138) * lu(k,2231) + lu(k,2254) = lu(k,2254) - lu(k,1139) * lu(k,2231) + lu(k,2256) = lu(k,2256) - lu(k,1140) * lu(k,2231) + lu(k,2261) = lu(k,2261) - lu(k,1141) * lu(k,2231) + end do + end subroutine lu_fac23 + subroutine lu_fac24( 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,1142) = 1._r8 / lu(k,1142) + lu(k,1143) = lu(k,1143) * lu(k,1142) + lu(k,1144) = lu(k,1144) * lu(k,1142) + lu(k,1145) = lu(k,1145) * lu(k,1142) + lu(k,1146) = lu(k,1146) * lu(k,1142) + lu(k,1147) = lu(k,1147) * lu(k,1142) + lu(k,1156) = lu(k,1156) - lu(k,1143) * lu(k,1154) + lu(k,1157) = lu(k,1157) - lu(k,1144) * lu(k,1154) + lu(k,1159) = lu(k,1159) - lu(k,1145) * lu(k,1154) + lu(k,1160) = lu(k,1160) - lu(k,1146) * lu(k,1154) + lu(k,1165) = lu(k,1165) - lu(k,1147) * lu(k,1154) + lu(k,1176) = lu(k,1176) - lu(k,1143) * lu(k,1174) + lu(k,1177) = lu(k,1177) - lu(k,1144) * lu(k,1174) + lu(k,1178) = lu(k,1178) - lu(k,1145) * lu(k,1174) + lu(k,1179) = lu(k,1179) - lu(k,1146) * lu(k,1174) + lu(k,1184) = lu(k,1184) - lu(k,1147) * lu(k,1174) + lu(k,1257) = - lu(k,1143) * lu(k,1253) + lu(k,1262) = lu(k,1262) - lu(k,1144) * lu(k,1253) + lu(k,1264) = lu(k,1264) - lu(k,1145) * lu(k,1253) + lu(k,1265) = lu(k,1265) - lu(k,1146) * lu(k,1253) + lu(k,1270) = lu(k,1270) - lu(k,1147) * lu(k,1253) + lu(k,1289) = lu(k,1289) - lu(k,1143) * lu(k,1285) + lu(k,1294) = lu(k,1294) - lu(k,1144) * lu(k,1285) + lu(k,1296) = lu(k,1296) - lu(k,1145) * lu(k,1285) + lu(k,1297) = lu(k,1297) - lu(k,1146) * lu(k,1285) + lu(k,1302) = lu(k,1302) - lu(k,1147) * lu(k,1285) + lu(k,1312) = lu(k,1312) - lu(k,1143) * lu(k,1310) + lu(k,1315) = lu(k,1315) - lu(k,1144) * lu(k,1310) + lu(k,1317) = lu(k,1317) - lu(k,1145) * lu(k,1310) + lu(k,1318) = lu(k,1318) - lu(k,1146) * lu(k,1310) + lu(k,1323) = lu(k,1323) - lu(k,1147) * lu(k,1310) + lu(k,1332) = lu(k,1332) - lu(k,1143) * lu(k,1331) + lu(k,1336) = lu(k,1336) - lu(k,1144) * lu(k,1331) + lu(k,1339) = lu(k,1339) - lu(k,1145) * lu(k,1331) + lu(k,1340) = lu(k,1340) - lu(k,1146) * lu(k,1331) + lu(k,1345) = lu(k,1345) - lu(k,1147) * lu(k,1331) + lu(k,1355) = - lu(k,1143) * lu(k,1354) + lu(k,1357) = lu(k,1357) - lu(k,1144) * lu(k,1354) + lu(k,1359) = lu(k,1359) - lu(k,1145) * lu(k,1354) + lu(k,1360) = lu(k,1360) - lu(k,1146) * lu(k,1354) + lu(k,1365) = lu(k,1365) - lu(k,1147) * lu(k,1354) + lu(k,1382) = lu(k,1382) - lu(k,1143) * lu(k,1378) + lu(k,1388) = lu(k,1388) - lu(k,1144) * lu(k,1378) + lu(k,1391) = lu(k,1391) - lu(k,1145) * lu(k,1378) + lu(k,1392) = lu(k,1392) - lu(k,1146) * lu(k,1378) + lu(k,1397) = lu(k,1397) - lu(k,1147) * lu(k,1378) + lu(k,1678) = lu(k,1678) - lu(k,1143) * lu(k,1673) + lu(k,1685) = lu(k,1685) - lu(k,1144) * lu(k,1673) + lu(k,1691) = lu(k,1691) - lu(k,1145) * lu(k,1673) + lu(k,1693) = lu(k,1693) - lu(k,1146) * lu(k,1673) + lu(k,1700) = lu(k,1700) - lu(k,1147) * lu(k,1673) + lu(k,1762) = lu(k,1762) - lu(k,1143) * lu(k,1757) + lu(k,1769) = lu(k,1769) - lu(k,1144) * lu(k,1757) + lu(k,1774) = lu(k,1774) - lu(k,1145) * lu(k,1757) + lu(k,1776) = lu(k,1776) - lu(k,1146) * lu(k,1757) + lu(k,1783) = lu(k,1783) - lu(k,1147) * lu(k,1757) + lu(k,1816) = lu(k,1816) - lu(k,1143) * lu(k,1812) + lu(k,1822) = lu(k,1822) - lu(k,1144) * lu(k,1812) + lu(k,1826) = lu(k,1826) - lu(k,1145) * lu(k,1812) + lu(k,1828) = lu(k,1828) - lu(k,1146) * lu(k,1812) + lu(k,1835) = lu(k,1835) - lu(k,1147) * lu(k,1812) + lu(k,1907) = lu(k,1907) - lu(k,1143) * lu(k,1902) + lu(k,1913) = lu(k,1913) - lu(k,1144) * lu(k,1902) + lu(k,1918) = lu(k,1918) - lu(k,1145) * lu(k,1902) + lu(k,1920) = lu(k,1920) - lu(k,1146) * lu(k,1902) + lu(k,1927) = lu(k,1927) - lu(k,1147) * lu(k,1902) + lu(k,1954) = lu(k,1954) - lu(k,1143) * lu(k,1953) + lu(k,1957) = lu(k,1957) - lu(k,1144) * lu(k,1953) + lu(k,1962) = lu(k,1962) - lu(k,1145) * lu(k,1953) + lu(k,1964) = lu(k,1964) - lu(k,1146) * lu(k,1953) + lu(k,1971) = lu(k,1971) - lu(k,1147) * lu(k,1953) + lu(k,2096) = lu(k,2096) - lu(k,1143) * lu(k,2092) + lu(k,2102) = lu(k,2102) - lu(k,1144) * lu(k,2092) + lu(k,2108) = lu(k,2108) - lu(k,1145) * lu(k,2092) + lu(k,2110) = lu(k,2110) - lu(k,1146) * lu(k,2092) + lu(k,2117) = lu(k,2117) - lu(k,1147) * lu(k,2092) + lu(k,2235) = lu(k,2235) - lu(k,1143) * lu(k,2232) + lu(k,2242) = lu(k,2242) - lu(k,1144) * lu(k,2232) + lu(k,2247) = lu(k,2247) - lu(k,1145) * lu(k,2232) + lu(k,2249) = lu(k,2249) - lu(k,1146) * lu(k,2232) + lu(k,2256) = lu(k,2256) - lu(k,1147) * lu(k,2232) + lu(k,1155) = 1._r8 / lu(k,1155) + lu(k,1156) = lu(k,1156) * lu(k,1155) + lu(k,1157) = lu(k,1157) * lu(k,1155) + lu(k,1158) = lu(k,1158) * lu(k,1155) + lu(k,1159) = lu(k,1159) * lu(k,1155) + lu(k,1160) = lu(k,1160) * lu(k,1155) + lu(k,1161) = lu(k,1161) * lu(k,1155) + lu(k,1162) = lu(k,1162) * lu(k,1155) + lu(k,1163) = lu(k,1163) * lu(k,1155) + lu(k,1164) = lu(k,1164) * lu(k,1155) + lu(k,1165) = lu(k,1165) * lu(k,1155) + lu(k,1166) = lu(k,1166) * lu(k,1155) + lu(k,1167) = lu(k,1167) * lu(k,1155) + lu(k,1257) = lu(k,1257) - lu(k,1156) * lu(k,1254) + lu(k,1262) = lu(k,1262) - lu(k,1157) * lu(k,1254) + lu(k,1263) = lu(k,1263) - lu(k,1158) * lu(k,1254) + lu(k,1264) = lu(k,1264) - lu(k,1159) * lu(k,1254) + lu(k,1265) = lu(k,1265) - lu(k,1160) * lu(k,1254) + lu(k,1266) = lu(k,1266) - lu(k,1161) * lu(k,1254) + lu(k,1267) = lu(k,1267) - lu(k,1162) * lu(k,1254) + lu(k,1268) = lu(k,1268) - lu(k,1163) * lu(k,1254) + lu(k,1269) = lu(k,1269) - lu(k,1164) * lu(k,1254) + lu(k,1270) = lu(k,1270) - lu(k,1165) * lu(k,1254) + lu(k,1271) = lu(k,1271) - lu(k,1166) * lu(k,1254) + lu(k,1273) = - lu(k,1167) * lu(k,1254) + lu(k,1289) = lu(k,1289) - lu(k,1156) * lu(k,1286) + lu(k,1294) = lu(k,1294) - lu(k,1157) * lu(k,1286) + lu(k,1295) = lu(k,1295) - lu(k,1158) * lu(k,1286) + lu(k,1296) = lu(k,1296) - lu(k,1159) * lu(k,1286) + lu(k,1297) = lu(k,1297) - lu(k,1160) * lu(k,1286) + lu(k,1298) = lu(k,1298) - lu(k,1161) * lu(k,1286) + lu(k,1299) = lu(k,1299) - lu(k,1162) * lu(k,1286) + lu(k,1300) = lu(k,1300) - lu(k,1163) * lu(k,1286) + lu(k,1301) = lu(k,1301) - lu(k,1164) * lu(k,1286) + lu(k,1302) = lu(k,1302) - lu(k,1165) * lu(k,1286) + lu(k,1303) = lu(k,1303) - lu(k,1166) * lu(k,1286) + lu(k,1305) = - lu(k,1167) * lu(k,1286) + lu(k,1312) = lu(k,1312) - lu(k,1156) * lu(k,1311) + lu(k,1315) = lu(k,1315) - lu(k,1157) * lu(k,1311) + lu(k,1316) = - lu(k,1158) * lu(k,1311) + lu(k,1317) = lu(k,1317) - lu(k,1159) * lu(k,1311) + lu(k,1318) = lu(k,1318) - lu(k,1160) * lu(k,1311) + lu(k,1319) = lu(k,1319) - lu(k,1161) * lu(k,1311) + lu(k,1320) = lu(k,1320) - lu(k,1162) * lu(k,1311) + lu(k,1321) = lu(k,1321) - lu(k,1163) * lu(k,1311) + lu(k,1322) = lu(k,1322) - lu(k,1164) * lu(k,1311) + lu(k,1323) = lu(k,1323) - lu(k,1165) * lu(k,1311) + lu(k,1324) = lu(k,1324) - lu(k,1166) * lu(k,1311) + lu(k,1325) = - lu(k,1167) * lu(k,1311) + lu(k,1678) = lu(k,1678) - lu(k,1156) * lu(k,1674) + lu(k,1685) = lu(k,1685) - lu(k,1157) * lu(k,1674) + lu(k,1690) = lu(k,1690) - lu(k,1158) * lu(k,1674) + lu(k,1691) = lu(k,1691) - lu(k,1159) * lu(k,1674) + lu(k,1693) = lu(k,1693) - lu(k,1160) * lu(k,1674) + lu(k,1695) = lu(k,1695) - lu(k,1161) * lu(k,1674) + lu(k,1696) = lu(k,1696) - lu(k,1162) * lu(k,1674) + lu(k,1697) = lu(k,1697) - lu(k,1163) * lu(k,1674) + lu(k,1698) = lu(k,1698) - lu(k,1164) * lu(k,1674) + lu(k,1700) = lu(k,1700) - lu(k,1165) * lu(k,1674) + lu(k,1703) = lu(k,1703) - lu(k,1166) * lu(k,1674) + lu(k,1705) = lu(k,1705) - lu(k,1167) * lu(k,1674) + lu(k,1762) = lu(k,1762) - lu(k,1156) * lu(k,1758) + lu(k,1769) = lu(k,1769) - lu(k,1157) * lu(k,1758) + lu(k,1773) = lu(k,1773) - lu(k,1158) * lu(k,1758) + lu(k,1774) = lu(k,1774) - lu(k,1159) * lu(k,1758) + lu(k,1776) = lu(k,1776) - lu(k,1160) * lu(k,1758) + lu(k,1778) = lu(k,1778) - lu(k,1161) * lu(k,1758) + lu(k,1779) = lu(k,1779) - lu(k,1162) * lu(k,1758) + lu(k,1780) = lu(k,1780) - lu(k,1163) * lu(k,1758) + lu(k,1781) = lu(k,1781) - lu(k,1164) * lu(k,1758) + lu(k,1783) = lu(k,1783) - lu(k,1165) * lu(k,1758) + lu(k,1786) = lu(k,1786) - lu(k,1166) * lu(k,1758) + lu(k,1788) = lu(k,1788) - lu(k,1167) * lu(k,1758) + lu(k,1907) = lu(k,1907) - lu(k,1156) * lu(k,1903) + lu(k,1913) = lu(k,1913) - lu(k,1157) * lu(k,1903) + lu(k,1917) = lu(k,1917) - lu(k,1158) * lu(k,1903) + lu(k,1918) = lu(k,1918) - lu(k,1159) * lu(k,1903) + lu(k,1920) = lu(k,1920) - lu(k,1160) * lu(k,1903) + lu(k,1922) = lu(k,1922) - lu(k,1161) * lu(k,1903) + lu(k,1923) = lu(k,1923) - lu(k,1162) * lu(k,1903) + lu(k,1924) = lu(k,1924) - lu(k,1163) * lu(k,1903) + lu(k,1925) = lu(k,1925) - lu(k,1164) * lu(k,1903) + lu(k,1927) = lu(k,1927) - lu(k,1165) * lu(k,1903) + lu(k,1930) = lu(k,1930) - lu(k,1166) * lu(k,1903) + lu(k,1932) = lu(k,1932) - lu(k,1167) * lu(k,1903) + lu(k,1175) = 1._r8 / lu(k,1175) + lu(k,1176) = lu(k,1176) * lu(k,1175) + lu(k,1177) = lu(k,1177) * lu(k,1175) + lu(k,1178) = lu(k,1178) * lu(k,1175) + lu(k,1179) = lu(k,1179) * lu(k,1175) + lu(k,1180) = lu(k,1180) * lu(k,1175) + lu(k,1181) = lu(k,1181) * lu(k,1175) + lu(k,1182) = lu(k,1182) * lu(k,1175) + lu(k,1183) = lu(k,1183) * lu(k,1175) + lu(k,1184) = lu(k,1184) * lu(k,1175) + lu(k,1185) = lu(k,1185) * lu(k,1175) + lu(k,1197) = lu(k,1197) - lu(k,1176) * lu(k,1194) + lu(k,1199) = lu(k,1199) - lu(k,1177) * lu(k,1194) + lu(k,1201) = lu(k,1201) - lu(k,1178) * lu(k,1194) + lu(k,1202) = lu(k,1202) - lu(k,1179) * lu(k,1194) + lu(k,1203) = lu(k,1203) - lu(k,1180) * lu(k,1194) + lu(k,1204) = lu(k,1204) - lu(k,1181) * lu(k,1194) + lu(k,1205) = lu(k,1205) - lu(k,1182) * lu(k,1194) + lu(k,1206) = lu(k,1206) - lu(k,1183) * lu(k,1194) + lu(k,1207) = lu(k,1207) - lu(k,1184) * lu(k,1194) + lu(k,1208) = lu(k,1208) - lu(k,1185) * lu(k,1194) + lu(k,1257) = lu(k,1257) - lu(k,1176) * lu(k,1255) + lu(k,1262) = lu(k,1262) - lu(k,1177) * lu(k,1255) + lu(k,1264) = lu(k,1264) - lu(k,1178) * lu(k,1255) + lu(k,1265) = lu(k,1265) - lu(k,1179) * lu(k,1255) + lu(k,1266) = lu(k,1266) - lu(k,1180) * lu(k,1255) + lu(k,1267) = lu(k,1267) - lu(k,1181) * lu(k,1255) + lu(k,1268) = lu(k,1268) - lu(k,1182) * lu(k,1255) + lu(k,1269) = lu(k,1269) - lu(k,1183) * lu(k,1255) + lu(k,1270) = lu(k,1270) - lu(k,1184) * lu(k,1255) + lu(k,1271) = lu(k,1271) - lu(k,1185) * lu(k,1255) + lu(k,1289) = lu(k,1289) - lu(k,1176) * lu(k,1287) + lu(k,1294) = lu(k,1294) - lu(k,1177) * lu(k,1287) + lu(k,1296) = lu(k,1296) - lu(k,1178) * lu(k,1287) + lu(k,1297) = lu(k,1297) - lu(k,1179) * lu(k,1287) + lu(k,1298) = lu(k,1298) - lu(k,1180) * lu(k,1287) + lu(k,1299) = lu(k,1299) - lu(k,1181) * lu(k,1287) + lu(k,1300) = lu(k,1300) - lu(k,1182) * lu(k,1287) + lu(k,1301) = lu(k,1301) - lu(k,1183) * lu(k,1287) + lu(k,1302) = lu(k,1302) - lu(k,1184) * lu(k,1287) + lu(k,1303) = lu(k,1303) - lu(k,1185) * lu(k,1287) + lu(k,1382) = lu(k,1382) - lu(k,1176) * lu(k,1379) + lu(k,1388) = lu(k,1388) - lu(k,1177) * lu(k,1379) + lu(k,1391) = lu(k,1391) - lu(k,1178) * lu(k,1379) + lu(k,1392) = lu(k,1392) - lu(k,1179) * lu(k,1379) + lu(k,1393) = lu(k,1393) - lu(k,1180) * lu(k,1379) + lu(k,1394) = lu(k,1394) - lu(k,1181) * lu(k,1379) + lu(k,1395) = lu(k,1395) - lu(k,1182) * lu(k,1379) + lu(k,1396) = lu(k,1396) - lu(k,1183) * lu(k,1379) + lu(k,1397) = lu(k,1397) - lu(k,1184) * lu(k,1379) + lu(k,1398) = lu(k,1398) - lu(k,1185) * lu(k,1379) + lu(k,1678) = lu(k,1678) - lu(k,1176) * lu(k,1675) + lu(k,1685) = lu(k,1685) - lu(k,1177) * lu(k,1675) + lu(k,1691) = lu(k,1691) - lu(k,1178) * lu(k,1675) + lu(k,1693) = lu(k,1693) - lu(k,1179) * lu(k,1675) + lu(k,1695) = lu(k,1695) - lu(k,1180) * lu(k,1675) + lu(k,1696) = lu(k,1696) - lu(k,1181) * lu(k,1675) + lu(k,1697) = lu(k,1697) - lu(k,1182) * lu(k,1675) + lu(k,1698) = lu(k,1698) - lu(k,1183) * lu(k,1675) + lu(k,1700) = lu(k,1700) - lu(k,1184) * lu(k,1675) + lu(k,1703) = lu(k,1703) - lu(k,1185) * lu(k,1675) + lu(k,1762) = lu(k,1762) - lu(k,1176) * lu(k,1759) + lu(k,1769) = lu(k,1769) - lu(k,1177) * lu(k,1759) + lu(k,1774) = lu(k,1774) - lu(k,1178) * lu(k,1759) + lu(k,1776) = lu(k,1776) - lu(k,1179) * lu(k,1759) + lu(k,1778) = lu(k,1778) - lu(k,1180) * lu(k,1759) + lu(k,1779) = lu(k,1779) - lu(k,1181) * lu(k,1759) + lu(k,1780) = lu(k,1780) - lu(k,1182) * lu(k,1759) + lu(k,1781) = lu(k,1781) - lu(k,1183) * lu(k,1759) + lu(k,1783) = lu(k,1783) - lu(k,1184) * lu(k,1759) + lu(k,1786) = lu(k,1786) - lu(k,1185) * lu(k,1759) + lu(k,1816) = lu(k,1816) - lu(k,1176) * lu(k,1813) + lu(k,1822) = lu(k,1822) - lu(k,1177) * lu(k,1813) + lu(k,1826) = lu(k,1826) - lu(k,1178) * lu(k,1813) + lu(k,1828) = lu(k,1828) - lu(k,1179) * lu(k,1813) + lu(k,1830) = lu(k,1830) - lu(k,1180) * lu(k,1813) + lu(k,1831) = lu(k,1831) - lu(k,1181) * lu(k,1813) + lu(k,1832) = lu(k,1832) - lu(k,1182) * lu(k,1813) + lu(k,1833) = lu(k,1833) - lu(k,1183) * lu(k,1813) + lu(k,1835) = lu(k,1835) - lu(k,1184) * lu(k,1813) + lu(k,1838) = lu(k,1838) - lu(k,1185) * lu(k,1813) + lu(k,1907) = lu(k,1907) - lu(k,1176) * lu(k,1904) + lu(k,1913) = lu(k,1913) - lu(k,1177) * lu(k,1904) + lu(k,1918) = lu(k,1918) - lu(k,1178) * lu(k,1904) + lu(k,1920) = lu(k,1920) - lu(k,1179) * lu(k,1904) + lu(k,1922) = lu(k,1922) - lu(k,1180) * lu(k,1904) + lu(k,1923) = lu(k,1923) - lu(k,1181) * lu(k,1904) + lu(k,1924) = lu(k,1924) - lu(k,1182) * lu(k,1904) + lu(k,1925) = lu(k,1925) - lu(k,1183) * lu(k,1904) + lu(k,1927) = lu(k,1927) - lu(k,1184) * lu(k,1904) + lu(k,1930) = lu(k,1930) - lu(k,1185) * lu(k,1904) + lu(k,2096) = lu(k,2096) - lu(k,1176) * lu(k,2093) + lu(k,2102) = lu(k,2102) - lu(k,1177) * lu(k,2093) + lu(k,2108) = lu(k,2108) - lu(k,1178) * lu(k,2093) + lu(k,2110) = lu(k,2110) - lu(k,1179) * lu(k,2093) + lu(k,2112) = lu(k,2112) - lu(k,1180) * lu(k,2093) + lu(k,2113) = lu(k,2113) - lu(k,1181) * lu(k,2093) + lu(k,2114) = lu(k,2114) - lu(k,1182) * lu(k,2093) + lu(k,2115) = lu(k,2115) - lu(k,1183) * lu(k,2093) + lu(k,2117) = lu(k,2117) - lu(k,1184) * lu(k,2093) + lu(k,2120) = lu(k,2120) - lu(k,1185) * lu(k,2093) + lu(k,1195) = 1._r8 / lu(k,1195) + lu(k,1196) = lu(k,1196) * lu(k,1195) + lu(k,1197) = lu(k,1197) * lu(k,1195) + lu(k,1198) = lu(k,1198) * lu(k,1195) + lu(k,1199) = lu(k,1199) * lu(k,1195) + lu(k,1200) = lu(k,1200) * lu(k,1195) + lu(k,1201) = lu(k,1201) * lu(k,1195) + lu(k,1202) = lu(k,1202) * lu(k,1195) + lu(k,1203) = lu(k,1203) * lu(k,1195) + lu(k,1204) = lu(k,1204) * lu(k,1195) + lu(k,1205) = lu(k,1205) * lu(k,1195) + lu(k,1206) = lu(k,1206) * lu(k,1195) + lu(k,1207) = lu(k,1207) * lu(k,1195) + lu(k,1208) = lu(k,1208) * lu(k,1195) + lu(k,1381) = lu(k,1381) - lu(k,1196) * lu(k,1380) + lu(k,1382) = lu(k,1382) - lu(k,1197) * lu(k,1380) + lu(k,1386) = lu(k,1386) - lu(k,1198) * lu(k,1380) + lu(k,1388) = lu(k,1388) - lu(k,1199) * lu(k,1380) + lu(k,1390) = lu(k,1390) - lu(k,1200) * lu(k,1380) + lu(k,1391) = lu(k,1391) - lu(k,1201) * lu(k,1380) + lu(k,1392) = lu(k,1392) - lu(k,1202) * lu(k,1380) + lu(k,1393) = lu(k,1393) - lu(k,1203) * lu(k,1380) + lu(k,1394) = lu(k,1394) - lu(k,1204) * lu(k,1380) + lu(k,1395) = lu(k,1395) - lu(k,1205) * lu(k,1380) + lu(k,1396) = lu(k,1396) - lu(k,1206) * lu(k,1380) + lu(k,1397) = lu(k,1397) - lu(k,1207) * lu(k,1380) + lu(k,1398) = lu(k,1398) - lu(k,1208) * lu(k,1380) + lu(k,1677) = lu(k,1677) - lu(k,1196) * lu(k,1676) + lu(k,1678) = lu(k,1678) - lu(k,1197) * lu(k,1676) + lu(k,1683) = lu(k,1683) - lu(k,1198) * lu(k,1676) + lu(k,1685) = lu(k,1685) - lu(k,1199) * lu(k,1676) + lu(k,1690) = lu(k,1690) - lu(k,1200) * lu(k,1676) + lu(k,1691) = lu(k,1691) - lu(k,1201) * lu(k,1676) + lu(k,1693) = lu(k,1693) - lu(k,1202) * lu(k,1676) + lu(k,1695) = lu(k,1695) - lu(k,1203) * lu(k,1676) + lu(k,1696) = lu(k,1696) - lu(k,1204) * lu(k,1676) + lu(k,1697) = lu(k,1697) - lu(k,1205) * lu(k,1676) + lu(k,1698) = lu(k,1698) - lu(k,1206) * lu(k,1676) + lu(k,1700) = lu(k,1700) - lu(k,1207) * lu(k,1676) + lu(k,1703) = lu(k,1703) - lu(k,1208) * lu(k,1676) + lu(k,1761) = lu(k,1761) - lu(k,1196) * lu(k,1760) + lu(k,1762) = lu(k,1762) - lu(k,1197) * lu(k,1760) + lu(k,1767) = lu(k,1767) - lu(k,1198) * lu(k,1760) + lu(k,1769) = lu(k,1769) - lu(k,1199) * lu(k,1760) + lu(k,1773) = lu(k,1773) - lu(k,1200) * lu(k,1760) + lu(k,1774) = lu(k,1774) - lu(k,1201) * lu(k,1760) + lu(k,1776) = lu(k,1776) - lu(k,1202) * lu(k,1760) + lu(k,1778) = lu(k,1778) - lu(k,1203) * lu(k,1760) + lu(k,1779) = lu(k,1779) - lu(k,1204) * lu(k,1760) + lu(k,1780) = lu(k,1780) - lu(k,1205) * lu(k,1760) + lu(k,1781) = lu(k,1781) - lu(k,1206) * lu(k,1760) + lu(k,1783) = lu(k,1783) - lu(k,1207) * lu(k,1760) + lu(k,1786) = lu(k,1786) - lu(k,1208) * lu(k,1760) + lu(k,1815) = lu(k,1815) - lu(k,1196) * lu(k,1814) + lu(k,1816) = lu(k,1816) - lu(k,1197) * lu(k,1814) + lu(k,1820) = lu(k,1820) - lu(k,1198) * lu(k,1814) + lu(k,1822) = lu(k,1822) - lu(k,1199) * lu(k,1814) + lu(k,1825) = lu(k,1825) - lu(k,1200) * lu(k,1814) + lu(k,1826) = lu(k,1826) - lu(k,1201) * lu(k,1814) + lu(k,1828) = lu(k,1828) - lu(k,1202) * lu(k,1814) + lu(k,1830) = lu(k,1830) - lu(k,1203) * lu(k,1814) + lu(k,1831) = lu(k,1831) - lu(k,1204) * lu(k,1814) + lu(k,1832) = lu(k,1832) - lu(k,1205) * lu(k,1814) + lu(k,1833) = lu(k,1833) - lu(k,1206) * lu(k,1814) + lu(k,1835) = lu(k,1835) - lu(k,1207) * lu(k,1814) + lu(k,1838) = lu(k,1838) - lu(k,1208) * lu(k,1814) + lu(k,1906) = lu(k,1906) - lu(k,1196) * lu(k,1905) + lu(k,1907) = lu(k,1907) - lu(k,1197) * lu(k,1905) + lu(k,1911) = lu(k,1911) - lu(k,1198) * lu(k,1905) + lu(k,1913) = lu(k,1913) - lu(k,1199) * lu(k,1905) + lu(k,1917) = lu(k,1917) - lu(k,1200) * lu(k,1905) + lu(k,1918) = lu(k,1918) - lu(k,1201) * lu(k,1905) + lu(k,1920) = lu(k,1920) - lu(k,1202) * lu(k,1905) + lu(k,1922) = lu(k,1922) - lu(k,1203) * lu(k,1905) + lu(k,1923) = lu(k,1923) - lu(k,1204) * lu(k,1905) + lu(k,1924) = lu(k,1924) - lu(k,1205) * lu(k,1905) + lu(k,1925) = lu(k,1925) - lu(k,1206) * lu(k,1905) + lu(k,1927) = lu(k,1927) - lu(k,1207) * lu(k,1905) + lu(k,1930) = lu(k,1930) - lu(k,1208) * lu(k,1905) + lu(k,2095) = lu(k,2095) - lu(k,1196) * lu(k,2094) + lu(k,2096) = lu(k,2096) - lu(k,1197) * lu(k,2094) + lu(k,2100) = lu(k,2100) - lu(k,1198) * lu(k,2094) + lu(k,2102) = lu(k,2102) - lu(k,1199) * lu(k,2094) + lu(k,2107) = lu(k,2107) - lu(k,1200) * lu(k,2094) + lu(k,2108) = lu(k,2108) - lu(k,1201) * lu(k,2094) + lu(k,2110) = lu(k,2110) - lu(k,1202) * lu(k,2094) + lu(k,2112) = lu(k,2112) - lu(k,1203) * lu(k,2094) + lu(k,2113) = lu(k,2113) - lu(k,1204) * lu(k,2094) + lu(k,2114) = lu(k,2114) - lu(k,1205) * lu(k,2094) + lu(k,2115) = lu(k,2115) - lu(k,1206) * lu(k,2094) + lu(k,2117) = lu(k,2117) - lu(k,1207) * lu(k,2094) + lu(k,2120) = lu(k,2120) - lu(k,1208) * lu(k,2094) + lu(k,2234) = lu(k,2234) - lu(k,1196) * lu(k,2233) + lu(k,2235) = lu(k,2235) - lu(k,1197) * lu(k,2233) + lu(k,2240) = lu(k,2240) - lu(k,1198) * lu(k,2233) + lu(k,2242) = lu(k,2242) - lu(k,1199) * lu(k,2233) + lu(k,2246) = lu(k,2246) - lu(k,1200) * lu(k,2233) + lu(k,2247) = lu(k,2247) - lu(k,1201) * lu(k,2233) + lu(k,2249) = lu(k,2249) - lu(k,1202) * lu(k,2233) + lu(k,2251) = lu(k,2251) - lu(k,1203) * lu(k,2233) + lu(k,2252) = lu(k,2252) - lu(k,1204) * lu(k,2233) + lu(k,2253) = lu(k,2253) - lu(k,1205) * lu(k,2233) + lu(k,2254) = lu(k,2254) - lu(k,1206) * lu(k,2233) + lu(k,2256) = lu(k,2256) - lu(k,1207) * lu(k,2233) + lu(k,2259) = lu(k,2259) - lu(k,1208) * lu(k,2233) + lu(k,1211) = 1._r8 / lu(k,1211) + lu(k,1212) = lu(k,1212) * lu(k,1211) + lu(k,1213) = lu(k,1213) * lu(k,1211) + lu(k,1214) = lu(k,1214) * lu(k,1211) + lu(k,1215) = lu(k,1215) * lu(k,1211) + lu(k,1216) = lu(k,1216) * lu(k,1211) + lu(k,1217) = lu(k,1217) * lu(k,1211) + lu(k,1218) = lu(k,1218) * lu(k,1211) + lu(k,1219) = lu(k,1219) * lu(k,1211) + lu(k,1220) = lu(k,1220) * lu(k,1211) + lu(k,1221) = lu(k,1221) * lu(k,1211) + lu(k,1257) = lu(k,1257) - lu(k,1212) * lu(k,1256) + lu(k,1259) = - lu(k,1213) * lu(k,1256) + lu(k,1261) = - lu(k,1214) * lu(k,1256) + lu(k,1262) = lu(k,1262) - lu(k,1215) * lu(k,1256) + lu(k,1264) = lu(k,1264) - lu(k,1216) * lu(k,1256) + lu(k,1265) = lu(k,1265) - lu(k,1217) * lu(k,1256) + lu(k,1270) = lu(k,1270) - lu(k,1218) * lu(k,1256) + lu(k,1271) = lu(k,1271) - lu(k,1219) * lu(k,1256) + lu(k,1272) = - lu(k,1220) * lu(k,1256) + lu(k,1273) = lu(k,1273) - lu(k,1221) * lu(k,1256) + lu(k,1289) = lu(k,1289) - lu(k,1212) * lu(k,1288) + lu(k,1291) = - lu(k,1213) * lu(k,1288) + lu(k,1293) = - lu(k,1214) * lu(k,1288) + lu(k,1294) = lu(k,1294) - lu(k,1215) * lu(k,1288) + lu(k,1296) = lu(k,1296) - lu(k,1216) * lu(k,1288) + lu(k,1297) = lu(k,1297) - lu(k,1217) * lu(k,1288) + lu(k,1302) = lu(k,1302) - lu(k,1218) * lu(k,1288) + lu(k,1303) = lu(k,1303) - lu(k,1219) * lu(k,1288) + lu(k,1304) = - lu(k,1220) * lu(k,1288) + lu(k,1305) = lu(k,1305) - lu(k,1221) * lu(k,1288) + lu(k,1382) = lu(k,1382) - lu(k,1212) * lu(k,1381) + lu(k,1385) = lu(k,1385) - lu(k,1213) * lu(k,1381) + lu(k,1387) = lu(k,1387) - lu(k,1214) * lu(k,1381) + lu(k,1388) = lu(k,1388) - lu(k,1215) * lu(k,1381) + lu(k,1391) = lu(k,1391) - lu(k,1216) * lu(k,1381) + lu(k,1392) = lu(k,1392) - lu(k,1217) * lu(k,1381) + lu(k,1397) = lu(k,1397) - lu(k,1218) * lu(k,1381) + lu(k,1398) = lu(k,1398) - lu(k,1219) * lu(k,1381) + lu(k,1399) = lu(k,1399) - lu(k,1220) * lu(k,1381) + lu(k,1400) = lu(k,1400) - lu(k,1221) * lu(k,1381) + lu(k,1678) = lu(k,1678) - lu(k,1212) * lu(k,1677) + lu(k,1682) = lu(k,1682) - lu(k,1213) * lu(k,1677) + lu(k,1684) = lu(k,1684) - lu(k,1214) * lu(k,1677) + lu(k,1685) = lu(k,1685) - lu(k,1215) * lu(k,1677) + lu(k,1691) = lu(k,1691) - lu(k,1216) * lu(k,1677) + lu(k,1693) = lu(k,1693) - lu(k,1217) * lu(k,1677) + lu(k,1700) = lu(k,1700) - lu(k,1218) * lu(k,1677) + lu(k,1703) = lu(k,1703) - lu(k,1219) * lu(k,1677) + lu(k,1704) = lu(k,1704) - lu(k,1220) * lu(k,1677) + lu(k,1705) = lu(k,1705) - lu(k,1221) * lu(k,1677) + lu(k,1762) = lu(k,1762) - lu(k,1212) * lu(k,1761) + lu(k,1766) = lu(k,1766) - lu(k,1213) * lu(k,1761) + lu(k,1768) = lu(k,1768) - lu(k,1214) * lu(k,1761) + lu(k,1769) = lu(k,1769) - lu(k,1215) * lu(k,1761) + lu(k,1774) = lu(k,1774) - lu(k,1216) * lu(k,1761) + lu(k,1776) = lu(k,1776) - lu(k,1217) * lu(k,1761) + lu(k,1783) = lu(k,1783) - lu(k,1218) * lu(k,1761) + lu(k,1786) = lu(k,1786) - lu(k,1219) * lu(k,1761) + lu(k,1787) = lu(k,1787) - lu(k,1220) * lu(k,1761) + lu(k,1788) = lu(k,1788) - lu(k,1221) * lu(k,1761) + lu(k,1816) = lu(k,1816) - lu(k,1212) * lu(k,1815) + lu(k,1819) = lu(k,1819) - lu(k,1213) * lu(k,1815) + lu(k,1821) = lu(k,1821) - lu(k,1214) * lu(k,1815) + lu(k,1822) = lu(k,1822) - lu(k,1215) * lu(k,1815) + lu(k,1826) = lu(k,1826) - lu(k,1216) * lu(k,1815) + lu(k,1828) = lu(k,1828) - lu(k,1217) * lu(k,1815) + lu(k,1835) = lu(k,1835) - lu(k,1218) * lu(k,1815) + lu(k,1838) = lu(k,1838) - lu(k,1219) * lu(k,1815) + lu(k,1839) = - lu(k,1220) * lu(k,1815) + lu(k,1840) = lu(k,1840) - lu(k,1221) * lu(k,1815) + lu(k,1907) = lu(k,1907) - lu(k,1212) * lu(k,1906) + lu(k,1910) = lu(k,1910) - lu(k,1213) * lu(k,1906) + lu(k,1912) = lu(k,1912) - lu(k,1214) * lu(k,1906) + lu(k,1913) = lu(k,1913) - lu(k,1215) * lu(k,1906) + lu(k,1918) = lu(k,1918) - lu(k,1216) * lu(k,1906) + lu(k,1920) = lu(k,1920) - lu(k,1217) * lu(k,1906) + lu(k,1927) = lu(k,1927) - lu(k,1218) * lu(k,1906) + lu(k,1930) = lu(k,1930) - lu(k,1219) * lu(k,1906) + lu(k,1931) = lu(k,1931) - lu(k,1220) * lu(k,1906) + lu(k,1932) = lu(k,1932) - lu(k,1221) * lu(k,1906) + lu(k,2096) = lu(k,2096) - lu(k,1212) * lu(k,2095) + lu(k,2099) = lu(k,2099) - lu(k,1213) * lu(k,2095) + lu(k,2101) = lu(k,2101) - lu(k,1214) * lu(k,2095) + lu(k,2102) = lu(k,2102) - lu(k,1215) * lu(k,2095) + lu(k,2108) = lu(k,2108) - lu(k,1216) * lu(k,2095) + lu(k,2110) = lu(k,2110) - lu(k,1217) * lu(k,2095) + lu(k,2117) = lu(k,2117) - lu(k,1218) * lu(k,2095) + lu(k,2120) = lu(k,2120) - lu(k,1219) * lu(k,2095) + lu(k,2121) = lu(k,2121) - lu(k,1220) * lu(k,2095) + lu(k,2122) = lu(k,2122) - lu(k,1221) * lu(k,2095) + lu(k,2235) = lu(k,2235) - lu(k,1212) * lu(k,2234) + lu(k,2239) = - lu(k,1213) * lu(k,2234) + lu(k,2241) = - lu(k,1214) * lu(k,2234) + lu(k,2242) = lu(k,2242) - lu(k,1215) * lu(k,2234) + lu(k,2247) = lu(k,2247) - lu(k,1216) * lu(k,2234) + lu(k,2249) = lu(k,2249) - lu(k,1217) * lu(k,2234) + lu(k,2256) = lu(k,2256) - lu(k,1218) * lu(k,2234) + lu(k,2259) = lu(k,2259) - lu(k,1219) * lu(k,2234) + lu(k,2260) = lu(k,2260) - lu(k,1220) * lu(k,2234) + lu(k,2261) = lu(k,2261) - lu(k,1221) * lu(k,2234) + end do + end subroutine lu_fac24 + subroutine lu_fac25( 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,1223) = 1._r8 / lu(k,1223) + lu(k,1224) = lu(k,1224) * lu(k,1223) + lu(k,1225) = lu(k,1225) * lu(k,1223) + lu(k,1226) = lu(k,1226) * lu(k,1223) + lu(k,1227) = lu(k,1227) * lu(k,1223) + lu(k,1228) = lu(k,1228) * lu(k,1223) + lu(k,1229) = lu(k,1229) * lu(k,1223) + lu(k,1230) = lu(k,1230) * lu(k,1223) + lu(k,1262) = lu(k,1262) - lu(k,1224) * lu(k,1257) + lu(k,1263) = lu(k,1263) - lu(k,1225) * lu(k,1257) + lu(k,1265) = lu(k,1265) - lu(k,1226) * lu(k,1257) + lu(k,1266) = lu(k,1266) - lu(k,1227) * lu(k,1257) + lu(k,1270) = lu(k,1270) - lu(k,1228) * lu(k,1257) + lu(k,1271) = lu(k,1271) - lu(k,1229) * lu(k,1257) + lu(k,1273) = lu(k,1273) - lu(k,1230) * lu(k,1257) + lu(k,1294) = lu(k,1294) - lu(k,1224) * lu(k,1289) + lu(k,1295) = lu(k,1295) - lu(k,1225) * lu(k,1289) + lu(k,1297) = lu(k,1297) - lu(k,1226) * lu(k,1289) + lu(k,1298) = lu(k,1298) - lu(k,1227) * lu(k,1289) + lu(k,1302) = lu(k,1302) - lu(k,1228) * lu(k,1289) + lu(k,1303) = lu(k,1303) - lu(k,1229) * lu(k,1289) + lu(k,1305) = lu(k,1305) - lu(k,1230) * lu(k,1289) + lu(k,1315) = lu(k,1315) - lu(k,1224) * lu(k,1312) + lu(k,1316) = lu(k,1316) - lu(k,1225) * lu(k,1312) + lu(k,1318) = lu(k,1318) - lu(k,1226) * lu(k,1312) + lu(k,1319) = lu(k,1319) - lu(k,1227) * lu(k,1312) + lu(k,1323) = lu(k,1323) - lu(k,1228) * lu(k,1312) + lu(k,1324) = lu(k,1324) - lu(k,1229) * lu(k,1312) + lu(k,1325) = lu(k,1325) - lu(k,1230) * lu(k,1312) + lu(k,1336) = lu(k,1336) - lu(k,1224) * lu(k,1332) + lu(k,1338) = lu(k,1338) - lu(k,1225) * lu(k,1332) + lu(k,1340) = lu(k,1340) - lu(k,1226) * lu(k,1332) + lu(k,1341) = lu(k,1341) - lu(k,1227) * lu(k,1332) + lu(k,1345) = lu(k,1345) - lu(k,1228) * lu(k,1332) + lu(k,1346) = lu(k,1346) - lu(k,1229) * lu(k,1332) + lu(k,1348) = lu(k,1348) - lu(k,1230) * lu(k,1332) + lu(k,1357) = lu(k,1357) - lu(k,1224) * lu(k,1355) + lu(k,1358) = - lu(k,1225) * lu(k,1355) + lu(k,1360) = lu(k,1360) - lu(k,1226) * lu(k,1355) + lu(k,1361) = lu(k,1361) - lu(k,1227) * lu(k,1355) + lu(k,1365) = lu(k,1365) - lu(k,1228) * lu(k,1355) + lu(k,1366) = lu(k,1366) - lu(k,1229) * lu(k,1355) + lu(k,1368) = lu(k,1368) - lu(k,1230) * lu(k,1355) + lu(k,1388) = lu(k,1388) - lu(k,1224) * lu(k,1382) + lu(k,1390) = lu(k,1390) - lu(k,1225) * lu(k,1382) + lu(k,1392) = lu(k,1392) - lu(k,1226) * lu(k,1382) + lu(k,1393) = lu(k,1393) - lu(k,1227) * lu(k,1382) + lu(k,1397) = lu(k,1397) - lu(k,1228) * lu(k,1382) + lu(k,1398) = lu(k,1398) - lu(k,1229) * lu(k,1382) + lu(k,1400) = lu(k,1400) - lu(k,1230) * lu(k,1382) + lu(k,1685) = lu(k,1685) - lu(k,1224) * lu(k,1678) + lu(k,1690) = lu(k,1690) - lu(k,1225) * lu(k,1678) + lu(k,1693) = lu(k,1693) - lu(k,1226) * lu(k,1678) + lu(k,1695) = lu(k,1695) - lu(k,1227) * lu(k,1678) + lu(k,1700) = lu(k,1700) - lu(k,1228) * lu(k,1678) + lu(k,1703) = lu(k,1703) - lu(k,1229) * lu(k,1678) + lu(k,1705) = lu(k,1705) - lu(k,1230) * lu(k,1678) + lu(k,1769) = lu(k,1769) - lu(k,1224) * lu(k,1762) + lu(k,1773) = lu(k,1773) - lu(k,1225) * lu(k,1762) + lu(k,1776) = lu(k,1776) - lu(k,1226) * lu(k,1762) + lu(k,1778) = lu(k,1778) - lu(k,1227) * lu(k,1762) + lu(k,1783) = lu(k,1783) - lu(k,1228) * lu(k,1762) + lu(k,1786) = lu(k,1786) - lu(k,1229) * lu(k,1762) + lu(k,1788) = lu(k,1788) - lu(k,1230) * lu(k,1762) + lu(k,1822) = lu(k,1822) - lu(k,1224) * lu(k,1816) + lu(k,1825) = lu(k,1825) - lu(k,1225) * lu(k,1816) + lu(k,1828) = lu(k,1828) - lu(k,1226) * lu(k,1816) + lu(k,1830) = lu(k,1830) - lu(k,1227) * lu(k,1816) + lu(k,1835) = lu(k,1835) - lu(k,1228) * lu(k,1816) + lu(k,1838) = lu(k,1838) - lu(k,1229) * lu(k,1816) + lu(k,1840) = lu(k,1840) - lu(k,1230) * lu(k,1816) + lu(k,1913) = lu(k,1913) - lu(k,1224) * lu(k,1907) + lu(k,1917) = lu(k,1917) - lu(k,1225) * lu(k,1907) + lu(k,1920) = lu(k,1920) - lu(k,1226) * lu(k,1907) + lu(k,1922) = lu(k,1922) - lu(k,1227) * lu(k,1907) + lu(k,1927) = lu(k,1927) - lu(k,1228) * lu(k,1907) + lu(k,1930) = lu(k,1930) - lu(k,1229) * lu(k,1907) + lu(k,1932) = lu(k,1932) - lu(k,1230) * lu(k,1907) + lu(k,1957) = lu(k,1957) - lu(k,1224) * lu(k,1954) + lu(k,1961) = lu(k,1961) - lu(k,1225) * lu(k,1954) + lu(k,1964) = lu(k,1964) - lu(k,1226) * lu(k,1954) + lu(k,1966) = lu(k,1966) - lu(k,1227) * lu(k,1954) + lu(k,1971) = lu(k,1971) - lu(k,1228) * lu(k,1954) + lu(k,1974) = lu(k,1974) - lu(k,1229) * lu(k,1954) + lu(k,1976) = lu(k,1976) - lu(k,1230) * lu(k,1954) + lu(k,2102) = lu(k,2102) - lu(k,1224) * lu(k,2096) + lu(k,2107) = lu(k,2107) - lu(k,1225) * lu(k,2096) + lu(k,2110) = lu(k,2110) - lu(k,1226) * lu(k,2096) + lu(k,2112) = lu(k,2112) - lu(k,1227) * lu(k,2096) + lu(k,2117) = lu(k,2117) - lu(k,1228) * lu(k,2096) + lu(k,2120) = lu(k,2120) - lu(k,1229) * lu(k,2096) + lu(k,2122) = lu(k,2122) - lu(k,1230) * lu(k,2096) + lu(k,2242) = lu(k,2242) - lu(k,1224) * lu(k,2235) + lu(k,2246) = lu(k,2246) - lu(k,1225) * lu(k,2235) + lu(k,2249) = lu(k,2249) - lu(k,1226) * lu(k,2235) + lu(k,2251) = lu(k,2251) - lu(k,1227) * lu(k,2235) + lu(k,2256) = lu(k,2256) - lu(k,1228) * lu(k,2235) + lu(k,2259) = lu(k,2259) - lu(k,1229) * lu(k,2235) + lu(k,2261) = lu(k,2261) - lu(k,1230) * lu(k,2235) + lu(k,1234) = 1._r8 / lu(k,1234) + lu(k,1235) = lu(k,1235) * lu(k,1234) + lu(k,1236) = lu(k,1236) * lu(k,1234) + lu(k,1237) = lu(k,1237) * lu(k,1234) + lu(k,1238) = lu(k,1238) * lu(k,1234) + lu(k,1239) = lu(k,1239) * lu(k,1234) + lu(k,1240) = lu(k,1240) * lu(k,1234) + lu(k,1241) = lu(k,1241) * lu(k,1234) + lu(k,1242) = lu(k,1242) * lu(k,1234) + lu(k,1243) = lu(k,1243) * lu(k,1234) + lu(k,1244) = lu(k,1244) * lu(k,1234) + lu(k,1245) = lu(k,1245) * lu(k,1234) + lu(k,1246) = lu(k,1246) * lu(k,1234) + lu(k,1687) = lu(k,1687) - lu(k,1235) * lu(k,1679) + lu(k,1689) = lu(k,1689) - lu(k,1236) * lu(k,1679) + lu(k,1693) = lu(k,1693) - lu(k,1237) * lu(k,1679) + lu(k,1694) = lu(k,1694) - lu(k,1238) * lu(k,1679) + lu(k,1697) = lu(k,1697) - lu(k,1239) * lu(k,1679) + lu(k,1698) = lu(k,1698) - lu(k,1240) * lu(k,1679) + lu(k,1699) = lu(k,1699) - lu(k,1241) * lu(k,1679) + lu(k,1700) = lu(k,1700) - lu(k,1242) * lu(k,1679) + lu(k,1702) = lu(k,1702) - lu(k,1243) * lu(k,1679) + lu(k,1703) = lu(k,1703) - lu(k,1244) * lu(k,1679) + lu(k,1704) = lu(k,1704) - lu(k,1245) * lu(k,1679) + lu(k,1705) = lu(k,1705) - lu(k,1246) * lu(k,1679) + lu(k,1714) = lu(k,1714) - lu(k,1235) * lu(k,1713) + lu(k,1715) = - lu(k,1236) * lu(k,1713) + lu(k,1719) = lu(k,1719) - lu(k,1237) * lu(k,1713) + lu(k,1720) = lu(k,1720) - lu(k,1238) * lu(k,1713) + lu(k,1723) = lu(k,1723) - lu(k,1239) * lu(k,1713) + lu(k,1724) = lu(k,1724) - lu(k,1240) * lu(k,1713) + lu(k,1725) = lu(k,1725) - lu(k,1241) * lu(k,1713) + lu(k,1726) = lu(k,1726) - lu(k,1242) * lu(k,1713) + lu(k,1728) = lu(k,1728) - lu(k,1243) * lu(k,1713) + lu(k,1729) = lu(k,1729) - lu(k,1244) * lu(k,1713) + lu(k,1730) = - lu(k,1245) * lu(k,1713) + lu(k,1731) = lu(k,1731) - lu(k,1246) * lu(k,1713) + lu(k,1770) = - lu(k,1235) * lu(k,1763) + lu(k,1772) = - lu(k,1236) * lu(k,1763) + lu(k,1776) = lu(k,1776) - lu(k,1237) * lu(k,1763) + lu(k,1777) = - lu(k,1238) * lu(k,1763) + lu(k,1780) = lu(k,1780) - lu(k,1239) * lu(k,1763) + lu(k,1781) = lu(k,1781) - lu(k,1240) * lu(k,1763) + lu(k,1782) = - lu(k,1241) * lu(k,1763) + lu(k,1783) = lu(k,1783) - lu(k,1242) * lu(k,1763) + lu(k,1785) = - lu(k,1243) * lu(k,1763) + lu(k,1786) = lu(k,1786) - lu(k,1244) * lu(k,1763) + lu(k,1787) = lu(k,1787) - lu(k,1245) * lu(k,1763) + lu(k,1788) = lu(k,1788) - lu(k,1246) * lu(k,1763) + lu(k,1958) = lu(k,1958) - lu(k,1235) * lu(k,1955) + lu(k,1960) = lu(k,1960) - lu(k,1236) * lu(k,1955) + lu(k,1964) = lu(k,1964) - lu(k,1237) * lu(k,1955) + lu(k,1965) = lu(k,1965) - lu(k,1238) * lu(k,1955) + lu(k,1968) = lu(k,1968) - lu(k,1239) * lu(k,1955) + lu(k,1969) = lu(k,1969) - lu(k,1240) * lu(k,1955) + lu(k,1970) = lu(k,1970) - lu(k,1241) * lu(k,1955) + lu(k,1971) = lu(k,1971) - lu(k,1242) * lu(k,1955) + lu(k,1973) = lu(k,1973) - lu(k,1243) * lu(k,1955) + lu(k,1974) = lu(k,1974) - lu(k,1244) * lu(k,1955) + lu(k,1975) = lu(k,1975) - lu(k,1245) * lu(k,1955) + lu(k,1976) = lu(k,1976) - lu(k,1246) * lu(k,1955) + lu(k,2152) = lu(k,2152) - lu(k,1235) * lu(k,2151) + lu(k,2153) = - lu(k,1236) * lu(k,2151) + lu(k,2157) = lu(k,2157) - lu(k,1237) * lu(k,2151) + lu(k,2158) = lu(k,2158) - lu(k,1238) * lu(k,2151) + lu(k,2161) = lu(k,2161) - lu(k,1239) * lu(k,2151) + lu(k,2162) = lu(k,2162) - lu(k,1240) * lu(k,2151) + lu(k,2163) = lu(k,2163) - lu(k,1241) * lu(k,2151) + lu(k,2164) = lu(k,2164) - lu(k,1242) * lu(k,2151) + lu(k,2166) = lu(k,2166) - lu(k,1243) * lu(k,2151) + lu(k,2167) = lu(k,2167) - lu(k,1244) * lu(k,2151) + lu(k,2168) = - lu(k,1245) * lu(k,2151) + lu(k,2169) = lu(k,2169) - lu(k,1246) * lu(k,2151) + lu(k,2182) = lu(k,2182) - lu(k,1235) * lu(k,2180) + lu(k,2184) = lu(k,2184) - lu(k,1236) * lu(k,2180) + lu(k,2188) = lu(k,2188) - lu(k,1237) * lu(k,2180) + lu(k,2189) = lu(k,2189) - lu(k,1238) * lu(k,2180) + lu(k,2192) = lu(k,2192) - lu(k,1239) * lu(k,2180) + lu(k,2193) = lu(k,2193) - lu(k,1240) * lu(k,2180) + lu(k,2194) = lu(k,2194) - lu(k,1241) * lu(k,2180) + lu(k,2195) = lu(k,2195) - lu(k,1242) * lu(k,2180) + lu(k,2197) = lu(k,2197) - lu(k,1243) * lu(k,2180) + lu(k,2198) = lu(k,2198) - lu(k,1244) * lu(k,2180) + lu(k,2199) = lu(k,2199) - lu(k,1245) * lu(k,2180) + lu(k,2200) = lu(k,2200) - lu(k,1246) * lu(k,2180) + lu(k,2243) = lu(k,2243) - lu(k,1235) * lu(k,2236) + lu(k,2245) = lu(k,2245) - lu(k,1236) * lu(k,2236) + lu(k,2249) = lu(k,2249) - lu(k,1237) * lu(k,2236) + lu(k,2250) = lu(k,2250) - lu(k,1238) * lu(k,2236) + lu(k,2253) = lu(k,2253) - lu(k,1239) * lu(k,2236) + lu(k,2254) = lu(k,2254) - lu(k,1240) * lu(k,2236) + lu(k,2255) = lu(k,2255) - lu(k,1241) * lu(k,2236) + lu(k,2256) = lu(k,2256) - lu(k,1242) * lu(k,2236) + lu(k,2258) = lu(k,2258) - lu(k,1243) * lu(k,2236) + lu(k,2259) = lu(k,2259) - lu(k,1244) * lu(k,2236) + lu(k,2260) = lu(k,2260) - lu(k,1245) * lu(k,2236) + lu(k,2261) = lu(k,2261) - lu(k,1246) * lu(k,2236) + lu(k,2269) = - lu(k,1235) * lu(k,2267) + lu(k,2271) = lu(k,2271) - lu(k,1236) * lu(k,2267) + lu(k,2275) = lu(k,2275) - lu(k,1237) * lu(k,2267) + lu(k,2276) = - lu(k,1238) * lu(k,2267) + lu(k,2279) = - lu(k,1239) * lu(k,2267) + lu(k,2280) = - lu(k,1240) * lu(k,2267) + lu(k,2281) = - lu(k,1241) * lu(k,2267) + lu(k,2282) = lu(k,2282) - lu(k,1242) * lu(k,2267) + lu(k,2284) = - lu(k,1243) * lu(k,2267) + lu(k,2285) = lu(k,2285) - lu(k,1244) * lu(k,2267) + lu(k,2286) = - lu(k,1245) * lu(k,2267) + lu(k,2287) = lu(k,2287) - lu(k,1246) * lu(k,2267) + lu(k,1258) = 1._r8 / lu(k,1258) + lu(k,1259) = lu(k,1259) * lu(k,1258) + lu(k,1260) = lu(k,1260) * lu(k,1258) + lu(k,1261) = lu(k,1261) * lu(k,1258) + lu(k,1262) = lu(k,1262) * lu(k,1258) + lu(k,1263) = lu(k,1263) * lu(k,1258) + lu(k,1264) = lu(k,1264) * lu(k,1258) + lu(k,1265) = lu(k,1265) * lu(k,1258) + lu(k,1266) = lu(k,1266) * lu(k,1258) + lu(k,1267) = lu(k,1267) * lu(k,1258) + lu(k,1268) = lu(k,1268) * lu(k,1258) + lu(k,1269) = lu(k,1269) * lu(k,1258) + lu(k,1270) = lu(k,1270) * lu(k,1258) + lu(k,1271) = lu(k,1271) * lu(k,1258) + lu(k,1272) = lu(k,1272) * lu(k,1258) + lu(k,1273) = lu(k,1273) * lu(k,1258) + lu(k,1385) = lu(k,1385) - lu(k,1259) * lu(k,1383) + lu(k,1386) = lu(k,1386) - lu(k,1260) * lu(k,1383) + lu(k,1387) = lu(k,1387) - lu(k,1261) * lu(k,1383) + lu(k,1388) = lu(k,1388) - lu(k,1262) * lu(k,1383) + lu(k,1390) = lu(k,1390) - lu(k,1263) * lu(k,1383) + lu(k,1391) = lu(k,1391) - lu(k,1264) * lu(k,1383) + lu(k,1392) = lu(k,1392) - lu(k,1265) * lu(k,1383) + lu(k,1393) = lu(k,1393) - lu(k,1266) * lu(k,1383) + lu(k,1394) = lu(k,1394) - lu(k,1267) * lu(k,1383) + lu(k,1395) = lu(k,1395) - lu(k,1268) * lu(k,1383) + lu(k,1396) = lu(k,1396) - lu(k,1269) * lu(k,1383) + lu(k,1397) = lu(k,1397) - lu(k,1270) * lu(k,1383) + lu(k,1398) = lu(k,1398) - lu(k,1271) * lu(k,1383) + lu(k,1399) = lu(k,1399) - lu(k,1272) * lu(k,1383) + lu(k,1400) = lu(k,1400) - lu(k,1273) * lu(k,1383) + lu(k,1682) = lu(k,1682) - lu(k,1259) * lu(k,1680) + lu(k,1683) = lu(k,1683) - lu(k,1260) * lu(k,1680) + lu(k,1684) = lu(k,1684) - lu(k,1261) * lu(k,1680) + lu(k,1685) = lu(k,1685) - lu(k,1262) * lu(k,1680) + lu(k,1690) = lu(k,1690) - lu(k,1263) * lu(k,1680) + lu(k,1691) = lu(k,1691) - lu(k,1264) * lu(k,1680) + lu(k,1693) = lu(k,1693) - lu(k,1265) * lu(k,1680) + lu(k,1695) = lu(k,1695) - lu(k,1266) * lu(k,1680) + lu(k,1696) = lu(k,1696) - lu(k,1267) * lu(k,1680) + lu(k,1697) = lu(k,1697) - lu(k,1268) * lu(k,1680) + lu(k,1698) = lu(k,1698) - lu(k,1269) * lu(k,1680) + lu(k,1700) = lu(k,1700) - lu(k,1270) * lu(k,1680) + lu(k,1703) = lu(k,1703) - lu(k,1271) * lu(k,1680) + lu(k,1704) = lu(k,1704) - lu(k,1272) * lu(k,1680) + lu(k,1705) = lu(k,1705) - lu(k,1273) * lu(k,1680) + lu(k,1766) = lu(k,1766) - lu(k,1259) * lu(k,1764) + lu(k,1767) = lu(k,1767) - lu(k,1260) * lu(k,1764) + lu(k,1768) = lu(k,1768) - lu(k,1261) * lu(k,1764) + lu(k,1769) = lu(k,1769) - lu(k,1262) * lu(k,1764) + lu(k,1773) = lu(k,1773) - lu(k,1263) * lu(k,1764) + lu(k,1774) = lu(k,1774) - lu(k,1264) * lu(k,1764) + lu(k,1776) = lu(k,1776) - lu(k,1265) * lu(k,1764) + lu(k,1778) = lu(k,1778) - lu(k,1266) * lu(k,1764) + lu(k,1779) = lu(k,1779) - lu(k,1267) * lu(k,1764) + lu(k,1780) = lu(k,1780) - lu(k,1268) * lu(k,1764) + lu(k,1781) = lu(k,1781) - lu(k,1269) * lu(k,1764) + lu(k,1783) = lu(k,1783) - lu(k,1270) * lu(k,1764) + lu(k,1786) = lu(k,1786) - lu(k,1271) * lu(k,1764) + lu(k,1787) = lu(k,1787) - lu(k,1272) * lu(k,1764) + lu(k,1788) = lu(k,1788) - lu(k,1273) * lu(k,1764) + lu(k,1819) = lu(k,1819) - lu(k,1259) * lu(k,1817) + lu(k,1820) = lu(k,1820) - lu(k,1260) * lu(k,1817) + lu(k,1821) = lu(k,1821) - lu(k,1261) * lu(k,1817) + lu(k,1822) = lu(k,1822) - lu(k,1262) * lu(k,1817) + lu(k,1825) = lu(k,1825) - lu(k,1263) * lu(k,1817) + lu(k,1826) = lu(k,1826) - lu(k,1264) * lu(k,1817) + lu(k,1828) = lu(k,1828) - lu(k,1265) * lu(k,1817) + lu(k,1830) = lu(k,1830) - lu(k,1266) * lu(k,1817) + lu(k,1831) = lu(k,1831) - lu(k,1267) * lu(k,1817) + lu(k,1832) = lu(k,1832) - lu(k,1268) * lu(k,1817) + lu(k,1833) = lu(k,1833) - lu(k,1269) * lu(k,1817) + lu(k,1835) = lu(k,1835) - lu(k,1270) * lu(k,1817) + lu(k,1838) = lu(k,1838) - lu(k,1271) * lu(k,1817) + lu(k,1839) = lu(k,1839) - lu(k,1272) * lu(k,1817) + lu(k,1840) = lu(k,1840) - lu(k,1273) * lu(k,1817) + lu(k,1910) = lu(k,1910) - lu(k,1259) * lu(k,1908) + lu(k,1911) = lu(k,1911) - lu(k,1260) * lu(k,1908) + lu(k,1912) = lu(k,1912) - lu(k,1261) * lu(k,1908) + lu(k,1913) = lu(k,1913) - lu(k,1262) * lu(k,1908) + lu(k,1917) = lu(k,1917) - lu(k,1263) * lu(k,1908) + lu(k,1918) = lu(k,1918) - lu(k,1264) * lu(k,1908) + lu(k,1920) = lu(k,1920) - lu(k,1265) * lu(k,1908) + lu(k,1922) = lu(k,1922) - lu(k,1266) * lu(k,1908) + lu(k,1923) = lu(k,1923) - lu(k,1267) * lu(k,1908) + lu(k,1924) = lu(k,1924) - lu(k,1268) * lu(k,1908) + lu(k,1925) = lu(k,1925) - lu(k,1269) * lu(k,1908) + lu(k,1927) = lu(k,1927) - lu(k,1270) * lu(k,1908) + lu(k,1930) = lu(k,1930) - lu(k,1271) * lu(k,1908) + lu(k,1931) = lu(k,1931) - lu(k,1272) * lu(k,1908) + lu(k,1932) = lu(k,1932) - lu(k,1273) * lu(k,1908) + lu(k,2099) = lu(k,2099) - lu(k,1259) * lu(k,2097) + lu(k,2100) = lu(k,2100) - lu(k,1260) * lu(k,2097) + lu(k,2101) = lu(k,2101) - lu(k,1261) * lu(k,2097) + lu(k,2102) = lu(k,2102) - lu(k,1262) * lu(k,2097) + lu(k,2107) = lu(k,2107) - lu(k,1263) * lu(k,2097) + lu(k,2108) = lu(k,2108) - lu(k,1264) * lu(k,2097) + lu(k,2110) = lu(k,2110) - lu(k,1265) * lu(k,2097) + lu(k,2112) = lu(k,2112) - lu(k,1266) * lu(k,2097) + lu(k,2113) = lu(k,2113) - lu(k,1267) * lu(k,2097) + lu(k,2114) = lu(k,2114) - lu(k,1268) * lu(k,2097) + lu(k,2115) = lu(k,2115) - lu(k,1269) * lu(k,2097) + lu(k,2117) = lu(k,2117) - lu(k,1270) * lu(k,2097) + lu(k,2120) = lu(k,2120) - lu(k,1271) * lu(k,2097) + lu(k,2121) = lu(k,2121) - lu(k,1272) * lu(k,2097) + lu(k,2122) = lu(k,2122) - lu(k,1273) * lu(k,2097) + lu(k,2239) = lu(k,2239) - lu(k,1259) * lu(k,2237) + lu(k,2240) = lu(k,2240) - lu(k,1260) * lu(k,2237) + lu(k,2241) = lu(k,2241) - lu(k,1261) * lu(k,2237) + lu(k,2242) = lu(k,2242) - lu(k,1262) * lu(k,2237) + lu(k,2246) = lu(k,2246) - lu(k,1263) * lu(k,2237) + lu(k,2247) = lu(k,2247) - lu(k,1264) * lu(k,2237) + lu(k,2249) = lu(k,2249) - lu(k,1265) * lu(k,2237) + lu(k,2251) = lu(k,2251) - lu(k,1266) * lu(k,2237) + lu(k,2252) = lu(k,2252) - lu(k,1267) * lu(k,2237) + lu(k,2253) = lu(k,2253) - lu(k,1268) * lu(k,2237) + lu(k,2254) = lu(k,2254) - lu(k,1269) * lu(k,2237) + lu(k,2256) = lu(k,2256) - lu(k,1270) * lu(k,2237) + lu(k,2259) = lu(k,2259) - lu(k,1271) * lu(k,2237) + lu(k,2260) = lu(k,2260) - lu(k,1272) * lu(k,2237) + lu(k,2261) = lu(k,2261) - lu(k,1273) * lu(k,2237) + end do + end subroutine lu_fac25 + subroutine lu_fac26( 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,1290) = 1._r8 / lu(k,1290) + lu(k,1291) = lu(k,1291) * lu(k,1290) + lu(k,1292) = lu(k,1292) * lu(k,1290) + lu(k,1293) = lu(k,1293) * lu(k,1290) + lu(k,1294) = lu(k,1294) * lu(k,1290) + lu(k,1295) = lu(k,1295) * lu(k,1290) + lu(k,1296) = lu(k,1296) * lu(k,1290) + lu(k,1297) = lu(k,1297) * lu(k,1290) + lu(k,1298) = lu(k,1298) * lu(k,1290) + lu(k,1299) = lu(k,1299) * lu(k,1290) + lu(k,1300) = lu(k,1300) * lu(k,1290) + lu(k,1301) = lu(k,1301) * lu(k,1290) + lu(k,1302) = lu(k,1302) * lu(k,1290) + lu(k,1303) = lu(k,1303) * lu(k,1290) + lu(k,1304) = lu(k,1304) * lu(k,1290) + lu(k,1305) = lu(k,1305) * lu(k,1290) + lu(k,1385) = lu(k,1385) - lu(k,1291) * lu(k,1384) + lu(k,1386) = lu(k,1386) - lu(k,1292) * lu(k,1384) + lu(k,1387) = lu(k,1387) - lu(k,1293) * lu(k,1384) + lu(k,1388) = lu(k,1388) - lu(k,1294) * lu(k,1384) + lu(k,1390) = lu(k,1390) - lu(k,1295) * lu(k,1384) + lu(k,1391) = lu(k,1391) - lu(k,1296) * lu(k,1384) + lu(k,1392) = lu(k,1392) - lu(k,1297) * lu(k,1384) + lu(k,1393) = lu(k,1393) - lu(k,1298) * lu(k,1384) + lu(k,1394) = lu(k,1394) - lu(k,1299) * lu(k,1384) + lu(k,1395) = lu(k,1395) - lu(k,1300) * lu(k,1384) + lu(k,1396) = lu(k,1396) - lu(k,1301) * lu(k,1384) + lu(k,1397) = lu(k,1397) - lu(k,1302) * lu(k,1384) + lu(k,1398) = lu(k,1398) - lu(k,1303) * lu(k,1384) + lu(k,1399) = lu(k,1399) - lu(k,1304) * lu(k,1384) + lu(k,1400) = lu(k,1400) - lu(k,1305) * lu(k,1384) + lu(k,1682) = lu(k,1682) - lu(k,1291) * lu(k,1681) + lu(k,1683) = lu(k,1683) - lu(k,1292) * lu(k,1681) + lu(k,1684) = lu(k,1684) - lu(k,1293) * lu(k,1681) + lu(k,1685) = lu(k,1685) - lu(k,1294) * lu(k,1681) + lu(k,1690) = lu(k,1690) - lu(k,1295) * lu(k,1681) + lu(k,1691) = lu(k,1691) - lu(k,1296) * lu(k,1681) + lu(k,1693) = lu(k,1693) - lu(k,1297) * lu(k,1681) + lu(k,1695) = lu(k,1695) - lu(k,1298) * lu(k,1681) + lu(k,1696) = lu(k,1696) - lu(k,1299) * lu(k,1681) + lu(k,1697) = lu(k,1697) - lu(k,1300) * lu(k,1681) + lu(k,1698) = lu(k,1698) - lu(k,1301) * lu(k,1681) + lu(k,1700) = lu(k,1700) - lu(k,1302) * lu(k,1681) + lu(k,1703) = lu(k,1703) - lu(k,1303) * lu(k,1681) + lu(k,1704) = lu(k,1704) - lu(k,1304) * lu(k,1681) + lu(k,1705) = lu(k,1705) - lu(k,1305) * lu(k,1681) + lu(k,1766) = lu(k,1766) - lu(k,1291) * lu(k,1765) + lu(k,1767) = lu(k,1767) - lu(k,1292) * lu(k,1765) + lu(k,1768) = lu(k,1768) - lu(k,1293) * lu(k,1765) + lu(k,1769) = lu(k,1769) - lu(k,1294) * lu(k,1765) + lu(k,1773) = lu(k,1773) - lu(k,1295) * lu(k,1765) + lu(k,1774) = lu(k,1774) - lu(k,1296) * lu(k,1765) + lu(k,1776) = lu(k,1776) - lu(k,1297) * lu(k,1765) + lu(k,1778) = lu(k,1778) - lu(k,1298) * lu(k,1765) + lu(k,1779) = lu(k,1779) - lu(k,1299) * lu(k,1765) + lu(k,1780) = lu(k,1780) - lu(k,1300) * lu(k,1765) + lu(k,1781) = lu(k,1781) - lu(k,1301) * lu(k,1765) + lu(k,1783) = lu(k,1783) - lu(k,1302) * lu(k,1765) + lu(k,1786) = lu(k,1786) - lu(k,1303) * lu(k,1765) + lu(k,1787) = lu(k,1787) - lu(k,1304) * lu(k,1765) + lu(k,1788) = lu(k,1788) - lu(k,1305) * lu(k,1765) + lu(k,1819) = lu(k,1819) - lu(k,1291) * lu(k,1818) + lu(k,1820) = lu(k,1820) - lu(k,1292) * lu(k,1818) + lu(k,1821) = lu(k,1821) - lu(k,1293) * lu(k,1818) + lu(k,1822) = lu(k,1822) - lu(k,1294) * lu(k,1818) + lu(k,1825) = lu(k,1825) - lu(k,1295) * lu(k,1818) + lu(k,1826) = lu(k,1826) - lu(k,1296) * lu(k,1818) + lu(k,1828) = lu(k,1828) - lu(k,1297) * lu(k,1818) + lu(k,1830) = lu(k,1830) - lu(k,1298) * lu(k,1818) + lu(k,1831) = lu(k,1831) - lu(k,1299) * lu(k,1818) + lu(k,1832) = lu(k,1832) - lu(k,1300) * lu(k,1818) + lu(k,1833) = lu(k,1833) - lu(k,1301) * lu(k,1818) + lu(k,1835) = lu(k,1835) - lu(k,1302) * lu(k,1818) + lu(k,1838) = lu(k,1838) - lu(k,1303) * lu(k,1818) + lu(k,1839) = lu(k,1839) - lu(k,1304) * lu(k,1818) + lu(k,1840) = lu(k,1840) - lu(k,1305) * lu(k,1818) + lu(k,1910) = lu(k,1910) - lu(k,1291) * lu(k,1909) + lu(k,1911) = lu(k,1911) - lu(k,1292) * lu(k,1909) + lu(k,1912) = lu(k,1912) - lu(k,1293) * lu(k,1909) + lu(k,1913) = lu(k,1913) - lu(k,1294) * lu(k,1909) + lu(k,1917) = lu(k,1917) - lu(k,1295) * lu(k,1909) + lu(k,1918) = lu(k,1918) - lu(k,1296) * lu(k,1909) + lu(k,1920) = lu(k,1920) - lu(k,1297) * lu(k,1909) + lu(k,1922) = lu(k,1922) - lu(k,1298) * lu(k,1909) + lu(k,1923) = lu(k,1923) - lu(k,1299) * lu(k,1909) + lu(k,1924) = lu(k,1924) - lu(k,1300) * lu(k,1909) + lu(k,1925) = lu(k,1925) - lu(k,1301) * lu(k,1909) + lu(k,1927) = lu(k,1927) - lu(k,1302) * lu(k,1909) + lu(k,1930) = lu(k,1930) - lu(k,1303) * lu(k,1909) + lu(k,1931) = lu(k,1931) - lu(k,1304) * lu(k,1909) + lu(k,1932) = lu(k,1932) - lu(k,1305) * lu(k,1909) + lu(k,2099) = lu(k,2099) - lu(k,1291) * lu(k,2098) + lu(k,2100) = lu(k,2100) - lu(k,1292) * lu(k,2098) + lu(k,2101) = lu(k,2101) - lu(k,1293) * lu(k,2098) + lu(k,2102) = lu(k,2102) - lu(k,1294) * lu(k,2098) + lu(k,2107) = lu(k,2107) - lu(k,1295) * lu(k,2098) + lu(k,2108) = lu(k,2108) - lu(k,1296) * lu(k,2098) + lu(k,2110) = lu(k,2110) - lu(k,1297) * lu(k,2098) + lu(k,2112) = lu(k,2112) - lu(k,1298) * lu(k,2098) + lu(k,2113) = lu(k,2113) - lu(k,1299) * lu(k,2098) + lu(k,2114) = lu(k,2114) - lu(k,1300) * lu(k,2098) + lu(k,2115) = lu(k,2115) - lu(k,1301) * lu(k,2098) + lu(k,2117) = lu(k,2117) - lu(k,1302) * lu(k,2098) + lu(k,2120) = lu(k,2120) - lu(k,1303) * lu(k,2098) + lu(k,2121) = lu(k,2121) - lu(k,1304) * lu(k,2098) + lu(k,2122) = lu(k,2122) - lu(k,1305) * lu(k,2098) + lu(k,2239) = lu(k,2239) - lu(k,1291) * lu(k,2238) + lu(k,2240) = lu(k,2240) - lu(k,1292) * lu(k,2238) + lu(k,2241) = lu(k,2241) - lu(k,1293) * lu(k,2238) + lu(k,2242) = lu(k,2242) - lu(k,1294) * lu(k,2238) + lu(k,2246) = lu(k,2246) - lu(k,1295) * lu(k,2238) + lu(k,2247) = lu(k,2247) - lu(k,1296) * lu(k,2238) + lu(k,2249) = lu(k,2249) - lu(k,1297) * lu(k,2238) + lu(k,2251) = lu(k,2251) - lu(k,1298) * lu(k,2238) + lu(k,2252) = lu(k,2252) - lu(k,1299) * lu(k,2238) + lu(k,2253) = lu(k,2253) - lu(k,1300) * lu(k,2238) + lu(k,2254) = lu(k,2254) - lu(k,1301) * lu(k,2238) + lu(k,2256) = lu(k,2256) - lu(k,1302) * lu(k,2238) + lu(k,2259) = lu(k,2259) - lu(k,1303) * lu(k,2238) + lu(k,2260) = lu(k,2260) - lu(k,1304) * lu(k,2238) + lu(k,2261) = lu(k,2261) - lu(k,1305) * lu(k,2238) + lu(k,1313) = 1._r8 / lu(k,1313) + lu(k,1314) = lu(k,1314) * lu(k,1313) + lu(k,1315) = lu(k,1315) * lu(k,1313) + lu(k,1316) = lu(k,1316) * lu(k,1313) + lu(k,1317) = lu(k,1317) * lu(k,1313) + lu(k,1318) = lu(k,1318) * lu(k,1313) + lu(k,1319) = lu(k,1319) * lu(k,1313) + lu(k,1320) = lu(k,1320) * lu(k,1313) + lu(k,1321) = lu(k,1321) * lu(k,1313) + lu(k,1322) = lu(k,1322) * lu(k,1313) + lu(k,1323) = lu(k,1323) * lu(k,1313) + lu(k,1324) = lu(k,1324) * lu(k,1313) + lu(k,1325) = lu(k,1325) * lu(k,1313) + lu(k,1335) = - lu(k,1314) * lu(k,1333) + lu(k,1336) = lu(k,1336) - lu(k,1315) * lu(k,1333) + lu(k,1338) = lu(k,1338) - lu(k,1316) * lu(k,1333) + lu(k,1339) = lu(k,1339) - lu(k,1317) * lu(k,1333) + lu(k,1340) = lu(k,1340) - lu(k,1318) * lu(k,1333) + lu(k,1341) = lu(k,1341) - lu(k,1319) * lu(k,1333) + lu(k,1342) = lu(k,1342) - lu(k,1320) * lu(k,1333) + lu(k,1343) = lu(k,1343) - lu(k,1321) * lu(k,1333) + lu(k,1344) = lu(k,1344) - lu(k,1322) * lu(k,1333) + lu(k,1345) = lu(k,1345) - lu(k,1323) * lu(k,1333) + lu(k,1346) = lu(k,1346) - lu(k,1324) * lu(k,1333) + lu(k,1348) = lu(k,1348) - lu(k,1325) * lu(k,1333) + lu(k,1387) = lu(k,1387) - lu(k,1314) * lu(k,1385) + lu(k,1388) = lu(k,1388) - lu(k,1315) * lu(k,1385) + lu(k,1390) = lu(k,1390) - lu(k,1316) * lu(k,1385) + lu(k,1391) = lu(k,1391) - lu(k,1317) * lu(k,1385) + lu(k,1392) = lu(k,1392) - lu(k,1318) * lu(k,1385) + lu(k,1393) = lu(k,1393) - lu(k,1319) * lu(k,1385) + lu(k,1394) = lu(k,1394) - lu(k,1320) * lu(k,1385) + lu(k,1395) = lu(k,1395) - lu(k,1321) * lu(k,1385) + lu(k,1396) = lu(k,1396) - lu(k,1322) * lu(k,1385) + lu(k,1397) = lu(k,1397) - lu(k,1323) * lu(k,1385) + lu(k,1398) = lu(k,1398) - lu(k,1324) * lu(k,1385) + lu(k,1400) = lu(k,1400) - lu(k,1325) * lu(k,1385) + lu(k,1684) = lu(k,1684) - lu(k,1314) * lu(k,1682) + lu(k,1685) = lu(k,1685) - lu(k,1315) * lu(k,1682) + lu(k,1690) = lu(k,1690) - lu(k,1316) * lu(k,1682) + lu(k,1691) = lu(k,1691) - lu(k,1317) * lu(k,1682) + lu(k,1693) = lu(k,1693) - lu(k,1318) * lu(k,1682) + lu(k,1695) = lu(k,1695) - lu(k,1319) * lu(k,1682) + lu(k,1696) = lu(k,1696) - lu(k,1320) * lu(k,1682) + lu(k,1697) = lu(k,1697) - lu(k,1321) * lu(k,1682) + lu(k,1698) = lu(k,1698) - lu(k,1322) * lu(k,1682) + lu(k,1700) = lu(k,1700) - lu(k,1323) * lu(k,1682) + lu(k,1703) = lu(k,1703) - lu(k,1324) * lu(k,1682) + lu(k,1705) = lu(k,1705) - lu(k,1325) * lu(k,1682) + lu(k,1768) = lu(k,1768) - lu(k,1314) * lu(k,1766) + lu(k,1769) = lu(k,1769) - lu(k,1315) * lu(k,1766) + lu(k,1773) = lu(k,1773) - lu(k,1316) * lu(k,1766) + lu(k,1774) = lu(k,1774) - lu(k,1317) * lu(k,1766) + lu(k,1776) = lu(k,1776) - lu(k,1318) * lu(k,1766) + lu(k,1778) = lu(k,1778) - lu(k,1319) * lu(k,1766) + lu(k,1779) = lu(k,1779) - lu(k,1320) * lu(k,1766) + lu(k,1780) = lu(k,1780) - lu(k,1321) * lu(k,1766) + lu(k,1781) = lu(k,1781) - lu(k,1322) * lu(k,1766) + lu(k,1783) = lu(k,1783) - lu(k,1323) * lu(k,1766) + lu(k,1786) = lu(k,1786) - lu(k,1324) * lu(k,1766) + lu(k,1788) = lu(k,1788) - lu(k,1325) * lu(k,1766) + lu(k,1821) = lu(k,1821) - lu(k,1314) * lu(k,1819) + lu(k,1822) = lu(k,1822) - lu(k,1315) * lu(k,1819) + lu(k,1825) = lu(k,1825) - lu(k,1316) * lu(k,1819) + lu(k,1826) = lu(k,1826) - lu(k,1317) * lu(k,1819) + lu(k,1828) = lu(k,1828) - lu(k,1318) * lu(k,1819) + lu(k,1830) = lu(k,1830) - lu(k,1319) * lu(k,1819) + lu(k,1831) = lu(k,1831) - lu(k,1320) * lu(k,1819) + lu(k,1832) = lu(k,1832) - lu(k,1321) * lu(k,1819) + lu(k,1833) = lu(k,1833) - lu(k,1322) * lu(k,1819) + lu(k,1835) = lu(k,1835) - lu(k,1323) * lu(k,1819) + lu(k,1838) = lu(k,1838) - lu(k,1324) * lu(k,1819) + lu(k,1840) = lu(k,1840) - lu(k,1325) * lu(k,1819) + lu(k,1912) = lu(k,1912) - lu(k,1314) * lu(k,1910) + lu(k,1913) = lu(k,1913) - lu(k,1315) * lu(k,1910) + lu(k,1917) = lu(k,1917) - lu(k,1316) * lu(k,1910) + lu(k,1918) = lu(k,1918) - lu(k,1317) * lu(k,1910) + lu(k,1920) = lu(k,1920) - lu(k,1318) * lu(k,1910) + lu(k,1922) = lu(k,1922) - lu(k,1319) * lu(k,1910) + lu(k,1923) = lu(k,1923) - lu(k,1320) * lu(k,1910) + lu(k,1924) = lu(k,1924) - lu(k,1321) * lu(k,1910) + lu(k,1925) = lu(k,1925) - lu(k,1322) * lu(k,1910) + lu(k,1927) = lu(k,1927) - lu(k,1323) * lu(k,1910) + lu(k,1930) = lu(k,1930) - lu(k,1324) * lu(k,1910) + lu(k,1932) = lu(k,1932) - lu(k,1325) * lu(k,1910) + lu(k,2101) = lu(k,2101) - lu(k,1314) * lu(k,2099) + lu(k,2102) = lu(k,2102) - lu(k,1315) * lu(k,2099) + lu(k,2107) = lu(k,2107) - lu(k,1316) * lu(k,2099) + lu(k,2108) = lu(k,2108) - lu(k,1317) * lu(k,2099) + lu(k,2110) = lu(k,2110) - lu(k,1318) * lu(k,2099) + lu(k,2112) = lu(k,2112) - lu(k,1319) * lu(k,2099) + lu(k,2113) = lu(k,2113) - lu(k,1320) * lu(k,2099) + lu(k,2114) = lu(k,2114) - lu(k,1321) * lu(k,2099) + lu(k,2115) = lu(k,2115) - lu(k,1322) * lu(k,2099) + lu(k,2117) = lu(k,2117) - lu(k,1323) * lu(k,2099) + lu(k,2120) = lu(k,2120) - lu(k,1324) * lu(k,2099) + lu(k,2122) = lu(k,2122) - lu(k,1325) * lu(k,2099) + lu(k,2241) = lu(k,2241) - lu(k,1314) * lu(k,2239) + lu(k,2242) = lu(k,2242) - lu(k,1315) * lu(k,2239) + lu(k,2246) = lu(k,2246) - lu(k,1316) * lu(k,2239) + lu(k,2247) = lu(k,2247) - lu(k,1317) * lu(k,2239) + lu(k,2249) = lu(k,2249) - lu(k,1318) * lu(k,2239) + lu(k,2251) = lu(k,2251) - lu(k,1319) * lu(k,2239) + lu(k,2252) = lu(k,2252) - lu(k,1320) * lu(k,2239) + lu(k,2253) = lu(k,2253) - lu(k,1321) * lu(k,2239) + lu(k,2254) = lu(k,2254) - lu(k,1322) * lu(k,2239) + lu(k,2256) = lu(k,2256) - lu(k,1323) * lu(k,2239) + lu(k,2259) = lu(k,2259) - lu(k,1324) * lu(k,2239) + lu(k,2261) = lu(k,2261) - lu(k,1325) * lu(k,2239) + lu(k,1334) = 1._r8 / lu(k,1334) + lu(k,1335) = lu(k,1335) * lu(k,1334) + lu(k,1336) = lu(k,1336) * lu(k,1334) + lu(k,1337) = lu(k,1337) * lu(k,1334) + lu(k,1338) = lu(k,1338) * lu(k,1334) + lu(k,1339) = lu(k,1339) * lu(k,1334) + lu(k,1340) = lu(k,1340) * lu(k,1334) + lu(k,1341) = lu(k,1341) * lu(k,1334) + lu(k,1342) = lu(k,1342) * lu(k,1334) + lu(k,1343) = lu(k,1343) * lu(k,1334) + lu(k,1344) = lu(k,1344) * lu(k,1334) + lu(k,1345) = lu(k,1345) * lu(k,1334) + lu(k,1346) = lu(k,1346) * lu(k,1334) + lu(k,1347) = lu(k,1347) * lu(k,1334) + lu(k,1348) = lu(k,1348) * lu(k,1334) + lu(k,1387) = lu(k,1387) - lu(k,1335) * lu(k,1386) + lu(k,1388) = lu(k,1388) - lu(k,1336) * lu(k,1386) + lu(k,1389) = - lu(k,1337) * lu(k,1386) + lu(k,1390) = lu(k,1390) - lu(k,1338) * lu(k,1386) + lu(k,1391) = lu(k,1391) - lu(k,1339) * lu(k,1386) + lu(k,1392) = lu(k,1392) - lu(k,1340) * lu(k,1386) + lu(k,1393) = lu(k,1393) - lu(k,1341) * lu(k,1386) + lu(k,1394) = lu(k,1394) - lu(k,1342) * lu(k,1386) + lu(k,1395) = lu(k,1395) - lu(k,1343) * lu(k,1386) + lu(k,1396) = lu(k,1396) - lu(k,1344) * lu(k,1386) + lu(k,1397) = lu(k,1397) - lu(k,1345) * lu(k,1386) + lu(k,1398) = lu(k,1398) - lu(k,1346) * lu(k,1386) + lu(k,1399) = lu(k,1399) - lu(k,1347) * lu(k,1386) + lu(k,1400) = lu(k,1400) - lu(k,1348) * lu(k,1386) + lu(k,1684) = lu(k,1684) - lu(k,1335) * lu(k,1683) + lu(k,1685) = lu(k,1685) - lu(k,1336) * lu(k,1683) + lu(k,1688) = lu(k,1688) - lu(k,1337) * lu(k,1683) + lu(k,1690) = lu(k,1690) - lu(k,1338) * lu(k,1683) + lu(k,1691) = lu(k,1691) - lu(k,1339) * lu(k,1683) + lu(k,1693) = lu(k,1693) - lu(k,1340) * lu(k,1683) + lu(k,1695) = lu(k,1695) - lu(k,1341) * lu(k,1683) + lu(k,1696) = lu(k,1696) - lu(k,1342) * lu(k,1683) + lu(k,1697) = lu(k,1697) - lu(k,1343) * lu(k,1683) + lu(k,1698) = lu(k,1698) - lu(k,1344) * lu(k,1683) + lu(k,1700) = lu(k,1700) - lu(k,1345) * lu(k,1683) + lu(k,1703) = lu(k,1703) - lu(k,1346) * lu(k,1683) + lu(k,1704) = lu(k,1704) - lu(k,1347) * lu(k,1683) + lu(k,1705) = lu(k,1705) - lu(k,1348) * lu(k,1683) + lu(k,1768) = lu(k,1768) - lu(k,1335) * lu(k,1767) + lu(k,1769) = lu(k,1769) - lu(k,1336) * lu(k,1767) + lu(k,1771) = lu(k,1771) - lu(k,1337) * lu(k,1767) + lu(k,1773) = lu(k,1773) - lu(k,1338) * lu(k,1767) + lu(k,1774) = lu(k,1774) - lu(k,1339) * lu(k,1767) + lu(k,1776) = lu(k,1776) - lu(k,1340) * lu(k,1767) + lu(k,1778) = lu(k,1778) - lu(k,1341) * lu(k,1767) + lu(k,1779) = lu(k,1779) - lu(k,1342) * lu(k,1767) + lu(k,1780) = lu(k,1780) - lu(k,1343) * lu(k,1767) + lu(k,1781) = lu(k,1781) - lu(k,1344) * lu(k,1767) + lu(k,1783) = lu(k,1783) - lu(k,1345) * lu(k,1767) + lu(k,1786) = lu(k,1786) - lu(k,1346) * lu(k,1767) + lu(k,1787) = lu(k,1787) - lu(k,1347) * lu(k,1767) + lu(k,1788) = lu(k,1788) - lu(k,1348) * lu(k,1767) + lu(k,1821) = lu(k,1821) - lu(k,1335) * lu(k,1820) + lu(k,1822) = lu(k,1822) - lu(k,1336) * lu(k,1820) + lu(k,1823) = - lu(k,1337) * lu(k,1820) + lu(k,1825) = lu(k,1825) - lu(k,1338) * lu(k,1820) + lu(k,1826) = lu(k,1826) - lu(k,1339) * lu(k,1820) + lu(k,1828) = lu(k,1828) - lu(k,1340) * lu(k,1820) + lu(k,1830) = lu(k,1830) - lu(k,1341) * lu(k,1820) + lu(k,1831) = lu(k,1831) - lu(k,1342) * lu(k,1820) + lu(k,1832) = lu(k,1832) - lu(k,1343) * lu(k,1820) + lu(k,1833) = lu(k,1833) - lu(k,1344) * lu(k,1820) + lu(k,1835) = lu(k,1835) - lu(k,1345) * lu(k,1820) + lu(k,1838) = lu(k,1838) - lu(k,1346) * lu(k,1820) + lu(k,1839) = lu(k,1839) - lu(k,1347) * lu(k,1820) + lu(k,1840) = lu(k,1840) - lu(k,1348) * lu(k,1820) + lu(k,1912) = lu(k,1912) - lu(k,1335) * lu(k,1911) + lu(k,1913) = lu(k,1913) - lu(k,1336) * lu(k,1911) + lu(k,1915) = - lu(k,1337) * lu(k,1911) + lu(k,1917) = lu(k,1917) - lu(k,1338) * lu(k,1911) + lu(k,1918) = lu(k,1918) - lu(k,1339) * lu(k,1911) + lu(k,1920) = lu(k,1920) - lu(k,1340) * lu(k,1911) + lu(k,1922) = lu(k,1922) - lu(k,1341) * lu(k,1911) + lu(k,1923) = lu(k,1923) - lu(k,1342) * lu(k,1911) + lu(k,1924) = lu(k,1924) - lu(k,1343) * lu(k,1911) + lu(k,1925) = lu(k,1925) - lu(k,1344) * lu(k,1911) + lu(k,1927) = lu(k,1927) - lu(k,1345) * lu(k,1911) + lu(k,1930) = lu(k,1930) - lu(k,1346) * lu(k,1911) + lu(k,1931) = lu(k,1931) - lu(k,1347) * lu(k,1911) + lu(k,1932) = lu(k,1932) - lu(k,1348) * lu(k,1911) + lu(k,2101) = lu(k,2101) - lu(k,1335) * lu(k,2100) + lu(k,2102) = lu(k,2102) - lu(k,1336) * lu(k,2100) + lu(k,2105) = - lu(k,1337) * lu(k,2100) + lu(k,2107) = lu(k,2107) - lu(k,1338) * lu(k,2100) + lu(k,2108) = lu(k,2108) - lu(k,1339) * lu(k,2100) + lu(k,2110) = lu(k,2110) - lu(k,1340) * lu(k,2100) + lu(k,2112) = lu(k,2112) - lu(k,1341) * lu(k,2100) + lu(k,2113) = lu(k,2113) - lu(k,1342) * lu(k,2100) + lu(k,2114) = lu(k,2114) - lu(k,1343) * lu(k,2100) + lu(k,2115) = lu(k,2115) - lu(k,1344) * lu(k,2100) + lu(k,2117) = lu(k,2117) - lu(k,1345) * lu(k,2100) + lu(k,2120) = lu(k,2120) - lu(k,1346) * lu(k,2100) + lu(k,2121) = lu(k,2121) - lu(k,1347) * lu(k,2100) + lu(k,2122) = lu(k,2122) - lu(k,1348) * lu(k,2100) + lu(k,2241) = lu(k,2241) - lu(k,1335) * lu(k,2240) + lu(k,2242) = lu(k,2242) - lu(k,1336) * lu(k,2240) + lu(k,2244) = lu(k,2244) - lu(k,1337) * lu(k,2240) + lu(k,2246) = lu(k,2246) - lu(k,1338) * lu(k,2240) + lu(k,2247) = lu(k,2247) - lu(k,1339) * lu(k,2240) + lu(k,2249) = lu(k,2249) - lu(k,1340) * lu(k,2240) + lu(k,2251) = lu(k,2251) - lu(k,1341) * lu(k,2240) + lu(k,2252) = lu(k,2252) - lu(k,1342) * lu(k,2240) + lu(k,2253) = lu(k,2253) - lu(k,1343) * lu(k,2240) + lu(k,2254) = lu(k,2254) - lu(k,1344) * lu(k,2240) + lu(k,2256) = lu(k,2256) - lu(k,1345) * lu(k,2240) + lu(k,2259) = lu(k,2259) - lu(k,1346) * lu(k,2240) + lu(k,2260) = lu(k,2260) - lu(k,1347) * lu(k,2240) + lu(k,2261) = lu(k,2261) - lu(k,1348) * lu(k,2240) + lu(k,1356) = 1._r8 / lu(k,1356) + lu(k,1357) = lu(k,1357) * lu(k,1356) + lu(k,1358) = lu(k,1358) * lu(k,1356) + lu(k,1359) = lu(k,1359) * lu(k,1356) + lu(k,1360) = lu(k,1360) * lu(k,1356) + lu(k,1361) = lu(k,1361) * lu(k,1356) + lu(k,1362) = lu(k,1362) * lu(k,1356) + lu(k,1363) = lu(k,1363) * lu(k,1356) + lu(k,1364) = lu(k,1364) * lu(k,1356) + lu(k,1365) = lu(k,1365) * lu(k,1356) + lu(k,1366) = lu(k,1366) * lu(k,1356) + lu(k,1367) = lu(k,1367) * lu(k,1356) + lu(k,1368) = lu(k,1368) * lu(k,1356) + lu(k,1388) = lu(k,1388) - lu(k,1357) * lu(k,1387) + lu(k,1390) = lu(k,1390) - lu(k,1358) * lu(k,1387) + lu(k,1391) = lu(k,1391) - lu(k,1359) * lu(k,1387) + lu(k,1392) = lu(k,1392) - lu(k,1360) * lu(k,1387) + lu(k,1393) = lu(k,1393) - lu(k,1361) * lu(k,1387) + lu(k,1394) = lu(k,1394) - lu(k,1362) * lu(k,1387) + lu(k,1395) = lu(k,1395) - lu(k,1363) * lu(k,1387) + lu(k,1396) = lu(k,1396) - lu(k,1364) * lu(k,1387) + lu(k,1397) = lu(k,1397) - lu(k,1365) * lu(k,1387) + lu(k,1398) = lu(k,1398) - lu(k,1366) * lu(k,1387) + lu(k,1399) = lu(k,1399) - lu(k,1367) * lu(k,1387) + lu(k,1400) = lu(k,1400) - lu(k,1368) * lu(k,1387) + lu(k,1685) = lu(k,1685) - lu(k,1357) * lu(k,1684) + lu(k,1690) = lu(k,1690) - lu(k,1358) * lu(k,1684) + lu(k,1691) = lu(k,1691) - lu(k,1359) * lu(k,1684) + lu(k,1693) = lu(k,1693) - lu(k,1360) * lu(k,1684) + lu(k,1695) = lu(k,1695) - lu(k,1361) * lu(k,1684) + lu(k,1696) = lu(k,1696) - lu(k,1362) * lu(k,1684) + lu(k,1697) = lu(k,1697) - lu(k,1363) * lu(k,1684) + lu(k,1698) = lu(k,1698) - lu(k,1364) * lu(k,1684) + lu(k,1700) = lu(k,1700) - lu(k,1365) * lu(k,1684) + lu(k,1703) = lu(k,1703) - lu(k,1366) * lu(k,1684) + lu(k,1704) = lu(k,1704) - lu(k,1367) * lu(k,1684) + lu(k,1705) = lu(k,1705) - lu(k,1368) * lu(k,1684) + lu(k,1769) = lu(k,1769) - lu(k,1357) * lu(k,1768) + lu(k,1773) = lu(k,1773) - lu(k,1358) * lu(k,1768) + lu(k,1774) = lu(k,1774) - lu(k,1359) * lu(k,1768) + lu(k,1776) = lu(k,1776) - lu(k,1360) * lu(k,1768) + lu(k,1778) = lu(k,1778) - lu(k,1361) * lu(k,1768) + lu(k,1779) = lu(k,1779) - lu(k,1362) * lu(k,1768) + lu(k,1780) = lu(k,1780) - lu(k,1363) * lu(k,1768) + lu(k,1781) = lu(k,1781) - lu(k,1364) * lu(k,1768) + lu(k,1783) = lu(k,1783) - lu(k,1365) * lu(k,1768) + lu(k,1786) = lu(k,1786) - lu(k,1366) * lu(k,1768) + lu(k,1787) = lu(k,1787) - lu(k,1367) * lu(k,1768) + lu(k,1788) = lu(k,1788) - lu(k,1368) * lu(k,1768) + lu(k,1822) = lu(k,1822) - lu(k,1357) * lu(k,1821) + lu(k,1825) = lu(k,1825) - lu(k,1358) * lu(k,1821) + lu(k,1826) = lu(k,1826) - lu(k,1359) * lu(k,1821) + lu(k,1828) = lu(k,1828) - lu(k,1360) * lu(k,1821) + lu(k,1830) = lu(k,1830) - lu(k,1361) * lu(k,1821) + lu(k,1831) = lu(k,1831) - lu(k,1362) * lu(k,1821) + lu(k,1832) = lu(k,1832) - lu(k,1363) * lu(k,1821) + lu(k,1833) = lu(k,1833) - lu(k,1364) * lu(k,1821) + lu(k,1835) = lu(k,1835) - lu(k,1365) * lu(k,1821) + lu(k,1838) = lu(k,1838) - lu(k,1366) * lu(k,1821) + lu(k,1839) = lu(k,1839) - lu(k,1367) * lu(k,1821) + lu(k,1840) = lu(k,1840) - lu(k,1368) * lu(k,1821) + lu(k,1913) = lu(k,1913) - lu(k,1357) * lu(k,1912) + lu(k,1917) = lu(k,1917) - lu(k,1358) * lu(k,1912) + lu(k,1918) = lu(k,1918) - lu(k,1359) * lu(k,1912) + lu(k,1920) = lu(k,1920) - lu(k,1360) * lu(k,1912) + lu(k,1922) = lu(k,1922) - lu(k,1361) * lu(k,1912) + lu(k,1923) = lu(k,1923) - lu(k,1362) * lu(k,1912) + lu(k,1924) = lu(k,1924) - lu(k,1363) * lu(k,1912) + lu(k,1925) = lu(k,1925) - lu(k,1364) * lu(k,1912) + lu(k,1927) = lu(k,1927) - lu(k,1365) * lu(k,1912) + lu(k,1930) = lu(k,1930) - lu(k,1366) * lu(k,1912) + lu(k,1931) = lu(k,1931) - lu(k,1367) * lu(k,1912) + lu(k,1932) = lu(k,1932) - lu(k,1368) * lu(k,1912) + lu(k,1957) = lu(k,1957) - lu(k,1357) * lu(k,1956) + lu(k,1961) = lu(k,1961) - lu(k,1358) * lu(k,1956) + lu(k,1962) = lu(k,1962) - lu(k,1359) * lu(k,1956) + lu(k,1964) = lu(k,1964) - lu(k,1360) * lu(k,1956) + lu(k,1966) = lu(k,1966) - lu(k,1361) * lu(k,1956) + lu(k,1967) = lu(k,1967) - lu(k,1362) * lu(k,1956) + lu(k,1968) = lu(k,1968) - lu(k,1363) * lu(k,1956) + lu(k,1969) = lu(k,1969) - lu(k,1364) * lu(k,1956) + lu(k,1971) = lu(k,1971) - lu(k,1365) * lu(k,1956) + lu(k,1974) = lu(k,1974) - lu(k,1366) * lu(k,1956) + lu(k,1975) = lu(k,1975) - lu(k,1367) * lu(k,1956) + lu(k,1976) = lu(k,1976) - lu(k,1368) * lu(k,1956) + lu(k,2102) = lu(k,2102) - lu(k,1357) * lu(k,2101) + lu(k,2107) = lu(k,2107) - lu(k,1358) * lu(k,2101) + lu(k,2108) = lu(k,2108) - lu(k,1359) * lu(k,2101) + lu(k,2110) = lu(k,2110) - lu(k,1360) * lu(k,2101) + lu(k,2112) = lu(k,2112) - lu(k,1361) * lu(k,2101) + lu(k,2113) = lu(k,2113) - lu(k,1362) * lu(k,2101) + lu(k,2114) = lu(k,2114) - lu(k,1363) * lu(k,2101) + lu(k,2115) = lu(k,2115) - lu(k,1364) * lu(k,2101) + lu(k,2117) = lu(k,2117) - lu(k,1365) * lu(k,2101) + lu(k,2120) = lu(k,2120) - lu(k,1366) * lu(k,2101) + lu(k,2121) = lu(k,2121) - lu(k,1367) * lu(k,2101) + lu(k,2122) = lu(k,2122) - lu(k,1368) * lu(k,2101) + lu(k,2242) = lu(k,2242) - lu(k,1357) * lu(k,2241) + lu(k,2246) = lu(k,2246) - lu(k,1358) * lu(k,2241) + lu(k,2247) = lu(k,2247) - lu(k,1359) * lu(k,2241) + lu(k,2249) = lu(k,2249) - lu(k,1360) * lu(k,2241) + lu(k,2251) = lu(k,2251) - lu(k,1361) * lu(k,2241) + lu(k,2252) = lu(k,2252) - lu(k,1362) * lu(k,2241) + lu(k,2253) = lu(k,2253) - lu(k,1363) * lu(k,2241) + lu(k,2254) = lu(k,2254) - lu(k,1364) * lu(k,2241) + lu(k,2256) = lu(k,2256) - lu(k,1365) * lu(k,2241) + lu(k,2259) = lu(k,2259) - lu(k,1366) * lu(k,2241) + lu(k,2260) = lu(k,2260) - lu(k,1367) * lu(k,2241) + lu(k,2261) = lu(k,2261) - lu(k,1368) * lu(k,2241) + end do + end subroutine lu_fac26 + subroutine lu_fac27( 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,1388) = 1._r8 / lu(k,1388) + lu(k,1389) = lu(k,1389) * lu(k,1388) + lu(k,1390) = lu(k,1390) * lu(k,1388) + lu(k,1391) = lu(k,1391) * lu(k,1388) + lu(k,1392) = lu(k,1392) * lu(k,1388) + lu(k,1393) = lu(k,1393) * lu(k,1388) + lu(k,1394) = lu(k,1394) * lu(k,1388) + lu(k,1395) = lu(k,1395) * lu(k,1388) + lu(k,1396) = lu(k,1396) * lu(k,1388) + lu(k,1397) = lu(k,1397) * lu(k,1388) + lu(k,1398) = lu(k,1398) * lu(k,1388) + lu(k,1399) = lu(k,1399) * lu(k,1388) + lu(k,1400) = lu(k,1400) * lu(k,1388) + lu(k,1688) = lu(k,1688) - lu(k,1389) * lu(k,1685) + lu(k,1690) = lu(k,1690) - lu(k,1390) * lu(k,1685) + lu(k,1691) = lu(k,1691) - lu(k,1391) * lu(k,1685) + lu(k,1693) = lu(k,1693) - lu(k,1392) * lu(k,1685) + lu(k,1695) = lu(k,1695) - lu(k,1393) * lu(k,1685) + lu(k,1696) = lu(k,1696) - lu(k,1394) * lu(k,1685) + lu(k,1697) = lu(k,1697) - lu(k,1395) * lu(k,1685) + lu(k,1698) = lu(k,1698) - lu(k,1396) * lu(k,1685) + lu(k,1700) = lu(k,1700) - lu(k,1397) * lu(k,1685) + lu(k,1703) = lu(k,1703) - lu(k,1398) * lu(k,1685) + lu(k,1704) = lu(k,1704) - lu(k,1399) * lu(k,1685) + lu(k,1705) = lu(k,1705) - lu(k,1400) * lu(k,1685) + lu(k,1771) = lu(k,1771) - lu(k,1389) * lu(k,1769) + lu(k,1773) = lu(k,1773) - lu(k,1390) * lu(k,1769) + lu(k,1774) = lu(k,1774) - lu(k,1391) * lu(k,1769) + lu(k,1776) = lu(k,1776) - lu(k,1392) * lu(k,1769) + lu(k,1778) = lu(k,1778) - lu(k,1393) * lu(k,1769) + lu(k,1779) = lu(k,1779) - lu(k,1394) * lu(k,1769) + lu(k,1780) = lu(k,1780) - lu(k,1395) * lu(k,1769) + lu(k,1781) = lu(k,1781) - lu(k,1396) * lu(k,1769) + lu(k,1783) = lu(k,1783) - lu(k,1397) * lu(k,1769) + lu(k,1786) = lu(k,1786) - lu(k,1398) * lu(k,1769) + lu(k,1787) = lu(k,1787) - lu(k,1399) * lu(k,1769) + lu(k,1788) = lu(k,1788) - lu(k,1400) * lu(k,1769) + lu(k,1823) = lu(k,1823) - lu(k,1389) * lu(k,1822) + lu(k,1825) = lu(k,1825) - lu(k,1390) * lu(k,1822) + lu(k,1826) = lu(k,1826) - lu(k,1391) * lu(k,1822) + lu(k,1828) = lu(k,1828) - lu(k,1392) * lu(k,1822) + lu(k,1830) = lu(k,1830) - lu(k,1393) * lu(k,1822) + lu(k,1831) = lu(k,1831) - lu(k,1394) * lu(k,1822) + lu(k,1832) = lu(k,1832) - lu(k,1395) * lu(k,1822) + lu(k,1833) = lu(k,1833) - lu(k,1396) * lu(k,1822) + lu(k,1835) = lu(k,1835) - lu(k,1397) * lu(k,1822) + lu(k,1838) = lu(k,1838) - lu(k,1398) * lu(k,1822) + lu(k,1839) = lu(k,1839) - lu(k,1399) * lu(k,1822) + lu(k,1840) = lu(k,1840) - lu(k,1400) * lu(k,1822) + lu(k,1915) = lu(k,1915) - lu(k,1389) * lu(k,1913) + lu(k,1917) = lu(k,1917) - lu(k,1390) * lu(k,1913) + lu(k,1918) = lu(k,1918) - lu(k,1391) * lu(k,1913) + lu(k,1920) = lu(k,1920) - lu(k,1392) * lu(k,1913) + lu(k,1922) = lu(k,1922) - lu(k,1393) * lu(k,1913) + lu(k,1923) = lu(k,1923) - lu(k,1394) * lu(k,1913) + lu(k,1924) = lu(k,1924) - lu(k,1395) * lu(k,1913) + lu(k,1925) = lu(k,1925) - lu(k,1396) * lu(k,1913) + lu(k,1927) = lu(k,1927) - lu(k,1397) * lu(k,1913) + lu(k,1930) = lu(k,1930) - lu(k,1398) * lu(k,1913) + lu(k,1931) = lu(k,1931) - lu(k,1399) * lu(k,1913) + lu(k,1932) = lu(k,1932) - lu(k,1400) * lu(k,1913) + lu(k,1959) = - lu(k,1389) * lu(k,1957) + lu(k,1961) = lu(k,1961) - lu(k,1390) * lu(k,1957) + lu(k,1962) = lu(k,1962) - lu(k,1391) * lu(k,1957) + lu(k,1964) = lu(k,1964) - lu(k,1392) * lu(k,1957) + lu(k,1966) = lu(k,1966) - lu(k,1393) * lu(k,1957) + lu(k,1967) = lu(k,1967) - lu(k,1394) * lu(k,1957) + lu(k,1968) = lu(k,1968) - lu(k,1395) * lu(k,1957) + lu(k,1969) = lu(k,1969) - lu(k,1396) * lu(k,1957) + lu(k,1971) = lu(k,1971) - lu(k,1397) * lu(k,1957) + lu(k,1974) = lu(k,1974) - lu(k,1398) * lu(k,1957) + lu(k,1975) = lu(k,1975) - lu(k,1399) * lu(k,1957) + lu(k,1976) = lu(k,1976) - lu(k,1400) * lu(k,1957) + lu(k,1998) = lu(k,1998) - lu(k,1389) * lu(k,1995) + lu(k,2000) = lu(k,2000) - lu(k,1390) * lu(k,1995) + lu(k,2001) = lu(k,2001) - lu(k,1391) * lu(k,1995) + lu(k,2003) = lu(k,2003) - lu(k,1392) * lu(k,1995) + lu(k,2005) = lu(k,2005) - lu(k,1393) * lu(k,1995) + lu(k,2006) = lu(k,2006) - lu(k,1394) * lu(k,1995) + lu(k,2007) = lu(k,2007) - lu(k,1395) * lu(k,1995) + lu(k,2008) = lu(k,2008) - lu(k,1396) * lu(k,1995) + lu(k,2010) = lu(k,2010) - lu(k,1397) * lu(k,1995) + lu(k,2013) = lu(k,2013) - lu(k,1398) * lu(k,1995) + lu(k,2014) = lu(k,2014) - lu(k,1399) * lu(k,1995) + lu(k,2015) = lu(k,2015) - lu(k,1400) * lu(k,1995) + lu(k,2105) = lu(k,2105) - lu(k,1389) * lu(k,2102) + lu(k,2107) = lu(k,2107) - lu(k,1390) * lu(k,2102) + lu(k,2108) = lu(k,2108) - lu(k,1391) * lu(k,2102) + lu(k,2110) = lu(k,2110) - lu(k,1392) * lu(k,2102) + lu(k,2112) = lu(k,2112) - lu(k,1393) * lu(k,2102) + lu(k,2113) = lu(k,2113) - lu(k,1394) * lu(k,2102) + lu(k,2114) = lu(k,2114) - lu(k,1395) * lu(k,2102) + lu(k,2115) = lu(k,2115) - lu(k,1396) * lu(k,2102) + lu(k,2117) = lu(k,2117) - lu(k,1397) * lu(k,2102) + lu(k,2120) = lu(k,2120) - lu(k,1398) * lu(k,2102) + lu(k,2121) = lu(k,2121) - lu(k,1399) * lu(k,2102) + lu(k,2122) = lu(k,2122) - lu(k,1400) * lu(k,2102) + lu(k,2244) = lu(k,2244) - lu(k,1389) * lu(k,2242) + lu(k,2246) = lu(k,2246) - lu(k,1390) * lu(k,2242) + lu(k,2247) = lu(k,2247) - lu(k,1391) * lu(k,2242) + lu(k,2249) = lu(k,2249) - lu(k,1392) * lu(k,2242) + lu(k,2251) = lu(k,2251) - lu(k,1393) * lu(k,2242) + lu(k,2252) = lu(k,2252) - lu(k,1394) * lu(k,2242) + lu(k,2253) = lu(k,2253) - lu(k,1395) * lu(k,2242) + lu(k,2254) = lu(k,2254) - lu(k,1396) * lu(k,2242) + lu(k,2256) = lu(k,2256) - lu(k,1397) * lu(k,2242) + lu(k,2259) = lu(k,2259) - lu(k,1398) * lu(k,2242) + lu(k,2260) = lu(k,2260) - lu(k,1399) * lu(k,2242) + lu(k,2261) = lu(k,2261) - lu(k,1400) * lu(k,2242) + lu(k,1403) = 1._r8 / lu(k,1403) + lu(k,1404) = lu(k,1404) * lu(k,1403) + lu(k,1405) = lu(k,1405) * lu(k,1403) + lu(k,1406) = lu(k,1406) * lu(k,1403) + lu(k,1407) = lu(k,1407) * lu(k,1403) + lu(k,1408) = lu(k,1408) * lu(k,1403) + lu(k,1409) = lu(k,1409) * lu(k,1403) + lu(k,1410) = lu(k,1410) * lu(k,1403) + lu(k,1411) = lu(k,1411) * lu(k,1403) + lu(k,1412) = lu(k,1412) * lu(k,1403) + lu(k,1413) = lu(k,1413) * lu(k,1403) + lu(k,1414) = lu(k,1414) * lu(k,1403) + lu(k,1432) = lu(k,1432) - lu(k,1404) * lu(k,1431) + lu(k,1433) = lu(k,1433) - lu(k,1405) * lu(k,1431) + lu(k,1434) = lu(k,1434) - lu(k,1406) * lu(k,1431) + lu(k,1436) = lu(k,1436) - lu(k,1407) * lu(k,1431) + lu(k,1437) = lu(k,1437) - lu(k,1408) * lu(k,1431) + lu(k,1438) = lu(k,1438) - lu(k,1409) * lu(k,1431) + lu(k,1439) = lu(k,1439) - lu(k,1410) * lu(k,1431) + lu(k,1440) = lu(k,1440) - lu(k,1411) * lu(k,1431) + lu(k,1442) = lu(k,1442) - lu(k,1412) * lu(k,1431) + lu(k,1443) = lu(k,1443) - lu(k,1413) * lu(k,1431) + lu(k,1444) = lu(k,1444) - lu(k,1414) * lu(k,1431) + lu(k,1446) = - lu(k,1404) * lu(k,1445) + lu(k,1447) = lu(k,1447) - lu(k,1405) * lu(k,1445) + lu(k,1448) = - lu(k,1406) * lu(k,1445) + lu(k,1450) = - lu(k,1407) * lu(k,1445) + lu(k,1451) = lu(k,1451) - lu(k,1408) * lu(k,1445) + lu(k,1452) = - lu(k,1409) * lu(k,1445) + lu(k,1453) = - lu(k,1410) * lu(k,1445) + lu(k,1454) = - lu(k,1411) * lu(k,1445) + lu(k,1456) = - lu(k,1412) * lu(k,1445) + lu(k,1457) = lu(k,1457) - lu(k,1413) * lu(k,1445) + lu(k,1459) = lu(k,1459) - lu(k,1414) * lu(k,1445) + lu(k,1463) = lu(k,1463) - lu(k,1404) * lu(k,1462) + lu(k,1464) = lu(k,1464) - lu(k,1405) * lu(k,1462) + lu(k,1465) = lu(k,1465) - lu(k,1406) * lu(k,1462) + lu(k,1467) = - lu(k,1407) * lu(k,1462) + lu(k,1468) = lu(k,1468) - lu(k,1408) * lu(k,1462) + lu(k,1469) = lu(k,1469) - lu(k,1409) * lu(k,1462) + lu(k,1470) = lu(k,1470) - lu(k,1410) * lu(k,1462) + lu(k,1472) = - lu(k,1411) * lu(k,1462) + lu(k,1474) = - lu(k,1412) * lu(k,1462) + lu(k,1475) = - lu(k,1413) * lu(k,1462) + lu(k,1477) = lu(k,1477) - lu(k,1414) * lu(k,1462) + lu(k,1484) = - lu(k,1404) * lu(k,1482) + lu(k,1485) = lu(k,1485) - lu(k,1405) * lu(k,1482) + lu(k,1486) = lu(k,1486) - lu(k,1406) * lu(k,1482) + lu(k,1488) = lu(k,1488) - lu(k,1407) * lu(k,1482) + lu(k,1489) = lu(k,1489) - lu(k,1408) * lu(k,1482) + lu(k,1490) = lu(k,1490) - lu(k,1409) * lu(k,1482) + lu(k,1491) = - lu(k,1410) * lu(k,1482) + lu(k,1494) = lu(k,1494) - lu(k,1411) * lu(k,1482) + lu(k,1496) = lu(k,1496) - lu(k,1412) * lu(k,1482) + lu(k,1498) = lu(k,1498) - lu(k,1413) * lu(k,1482) + lu(k,1500) = lu(k,1500) - lu(k,1414) * lu(k,1482) + lu(k,1524) = lu(k,1524) - lu(k,1404) * lu(k,1522) + lu(k,1525) = lu(k,1525) - lu(k,1405) * lu(k,1522) + lu(k,1526) = lu(k,1526) - lu(k,1406) * lu(k,1522) + lu(k,1528) = lu(k,1528) - lu(k,1407) * lu(k,1522) + lu(k,1529) = lu(k,1529) - lu(k,1408) * lu(k,1522) + lu(k,1531) = lu(k,1531) - lu(k,1409) * lu(k,1522) + lu(k,1532) = lu(k,1532) - lu(k,1410) * lu(k,1522) + lu(k,1535) = lu(k,1535) - lu(k,1411) * lu(k,1522) + lu(k,1537) = lu(k,1537) - lu(k,1412) * lu(k,1522) + lu(k,1539) = lu(k,1539) - lu(k,1413) * lu(k,1522) + lu(k,1541) = lu(k,1541) - lu(k,1414) * lu(k,1522) + lu(k,1688) = lu(k,1688) - lu(k,1404) * lu(k,1686) + lu(k,1689) = lu(k,1689) - lu(k,1405) * lu(k,1686) + lu(k,1690) = lu(k,1690) - lu(k,1406) * lu(k,1686) + lu(k,1692) = lu(k,1692) - lu(k,1407) * lu(k,1686) + lu(k,1693) = lu(k,1693) - lu(k,1408) * lu(k,1686) + lu(k,1695) = lu(k,1695) - lu(k,1409) * lu(k,1686) + lu(k,1696) = lu(k,1696) - lu(k,1410) * lu(k,1686) + lu(k,1699) = lu(k,1699) - lu(k,1411) * lu(k,1686) + lu(k,1701) = lu(k,1701) - lu(k,1412) * lu(k,1686) + lu(k,1703) = lu(k,1703) - lu(k,1413) * lu(k,1686) + lu(k,1705) = lu(k,1705) - lu(k,1414) * lu(k,1686) + lu(k,1998) = lu(k,1998) - lu(k,1404) * lu(k,1996) + lu(k,1999) = lu(k,1999) - lu(k,1405) * lu(k,1996) + lu(k,2000) = lu(k,2000) - lu(k,1406) * lu(k,1996) + lu(k,2002) = lu(k,2002) - lu(k,1407) * lu(k,1996) + lu(k,2003) = lu(k,2003) - lu(k,1408) * lu(k,1996) + lu(k,2005) = lu(k,2005) - lu(k,1409) * lu(k,1996) + lu(k,2006) = lu(k,2006) - lu(k,1410) * lu(k,1996) + lu(k,2009) = lu(k,2009) - lu(k,1411) * lu(k,1996) + lu(k,2011) = lu(k,2011) - lu(k,1412) * lu(k,1996) + lu(k,2013) = lu(k,2013) - lu(k,1413) * lu(k,1996) + lu(k,2015) = lu(k,2015) - lu(k,1414) * lu(k,1996) + lu(k,2105) = lu(k,2105) - lu(k,1404) * lu(k,2103) + lu(k,2106) = lu(k,2106) - lu(k,1405) * lu(k,2103) + lu(k,2107) = lu(k,2107) - lu(k,1406) * lu(k,2103) + lu(k,2109) = lu(k,2109) - lu(k,1407) * lu(k,2103) + lu(k,2110) = lu(k,2110) - lu(k,1408) * lu(k,2103) + lu(k,2112) = lu(k,2112) - lu(k,1409) * lu(k,2103) + lu(k,2113) = lu(k,2113) - lu(k,1410) * lu(k,2103) + lu(k,2116) = lu(k,2116) - lu(k,1411) * lu(k,2103) + lu(k,2118) = lu(k,2118) - lu(k,1412) * lu(k,2103) + lu(k,2120) = lu(k,2120) - lu(k,1413) * lu(k,2103) + lu(k,2122) = lu(k,2122) - lu(k,1414) * lu(k,2103) + lu(k,2183) = - lu(k,1404) * lu(k,2181) + lu(k,2184) = lu(k,2184) - lu(k,1405) * lu(k,2181) + lu(k,2185) = lu(k,2185) - lu(k,1406) * lu(k,2181) + lu(k,2187) = lu(k,2187) - lu(k,1407) * lu(k,2181) + lu(k,2188) = lu(k,2188) - lu(k,1408) * lu(k,2181) + lu(k,2190) = lu(k,2190) - lu(k,1409) * lu(k,2181) + lu(k,2191) = - lu(k,1410) * lu(k,2181) + lu(k,2194) = lu(k,2194) - lu(k,1411) * lu(k,2181) + lu(k,2196) = lu(k,2196) - lu(k,1412) * lu(k,2181) + lu(k,2198) = lu(k,2198) - lu(k,1413) * lu(k,2181) + lu(k,2200) = lu(k,2200) - lu(k,1414) * lu(k,2181) + lu(k,2270) = lu(k,2270) - lu(k,1404) * lu(k,2268) + lu(k,2271) = lu(k,2271) - lu(k,1405) * lu(k,2268) + lu(k,2272) = lu(k,2272) - lu(k,1406) * lu(k,2268) + lu(k,2274) = lu(k,2274) - lu(k,1407) * lu(k,2268) + lu(k,2275) = lu(k,2275) - lu(k,1408) * lu(k,2268) + lu(k,2277) = lu(k,2277) - lu(k,1409) * lu(k,2268) + lu(k,2278) = lu(k,2278) - lu(k,1410) * lu(k,2268) + lu(k,2281) = lu(k,2281) - lu(k,1411) * lu(k,2268) + lu(k,2283) = - lu(k,1412) * lu(k,2268) + lu(k,2285) = lu(k,2285) - lu(k,1413) * lu(k,2268) + lu(k,2287) = lu(k,2287) - lu(k,1414) * lu(k,2268) + lu(k,1417) = 1._r8 / lu(k,1417) + lu(k,1418) = lu(k,1418) * lu(k,1417) + lu(k,1419) = lu(k,1419) * lu(k,1417) + lu(k,1420) = lu(k,1420) * lu(k,1417) + lu(k,1421) = lu(k,1421) * lu(k,1417) + lu(k,1422) = lu(k,1422) * lu(k,1417) + lu(k,1423) = lu(k,1423) * lu(k,1417) + lu(k,1424) = lu(k,1424) * lu(k,1417) + lu(k,1425) = lu(k,1425) * lu(k,1417) + lu(k,1426) = lu(k,1426) * lu(k,1417) + lu(k,1485) = lu(k,1485) - lu(k,1418) * lu(k,1483) + lu(k,1487) = lu(k,1487) - lu(k,1419) * lu(k,1483) + lu(k,1488) = lu(k,1488) - lu(k,1420) * lu(k,1483) + lu(k,1489) = lu(k,1489) - lu(k,1421) * lu(k,1483) + lu(k,1495) = lu(k,1495) - lu(k,1422) * lu(k,1483) + lu(k,1497) = lu(k,1497) - lu(k,1423) * lu(k,1483) + lu(k,1498) = lu(k,1498) - lu(k,1424) * lu(k,1483) + lu(k,1499) = - lu(k,1425) * lu(k,1483) + lu(k,1500) = lu(k,1500) - lu(k,1426) * lu(k,1483) + lu(k,1525) = lu(k,1525) - lu(k,1418) * lu(k,1523) + lu(k,1527) = lu(k,1527) - lu(k,1419) * lu(k,1523) + lu(k,1528) = lu(k,1528) - lu(k,1420) * lu(k,1523) + lu(k,1529) = lu(k,1529) - lu(k,1421) * lu(k,1523) + lu(k,1536) = lu(k,1536) - lu(k,1422) * lu(k,1523) + lu(k,1538) = lu(k,1538) - lu(k,1423) * lu(k,1523) + lu(k,1539) = lu(k,1539) - lu(k,1424) * lu(k,1523) + lu(k,1540) = lu(k,1540) - lu(k,1425) * lu(k,1523) + lu(k,1541) = lu(k,1541) - lu(k,1426) * lu(k,1523) + lu(k,1689) = lu(k,1689) - lu(k,1418) * lu(k,1687) + lu(k,1691) = lu(k,1691) - lu(k,1419) * lu(k,1687) + lu(k,1692) = lu(k,1692) - lu(k,1420) * lu(k,1687) + lu(k,1693) = lu(k,1693) - lu(k,1421) * lu(k,1687) + lu(k,1700) = lu(k,1700) - lu(k,1422) * lu(k,1687) + lu(k,1702) = lu(k,1702) - lu(k,1423) * lu(k,1687) + lu(k,1703) = lu(k,1703) - lu(k,1424) * lu(k,1687) + lu(k,1704) = lu(k,1704) - lu(k,1425) * lu(k,1687) + lu(k,1705) = lu(k,1705) - lu(k,1426) * lu(k,1687) + lu(k,1715) = lu(k,1715) - lu(k,1418) * lu(k,1714) + lu(k,1717) = lu(k,1717) - lu(k,1419) * lu(k,1714) + lu(k,1718) = - lu(k,1420) * lu(k,1714) + lu(k,1719) = lu(k,1719) - lu(k,1421) * lu(k,1714) + lu(k,1726) = lu(k,1726) - lu(k,1422) * lu(k,1714) + lu(k,1728) = lu(k,1728) - lu(k,1423) * lu(k,1714) + lu(k,1729) = lu(k,1729) - lu(k,1424) * lu(k,1714) + lu(k,1730) = lu(k,1730) - lu(k,1425) * lu(k,1714) + lu(k,1731) = lu(k,1731) - lu(k,1426) * lu(k,1714) + lu(k,1772) = lu(k,1772) - lu(k,1418) * lu(k,1770) + lu(k,1774) = lu(k,1774) - lu(k,1419) * lu(k,1770) + lu(k,1775) = - lu(k,1420) * lu(k,1770) + lu(k,1776) = lu(k,1776) - lu(k,1421) * lu(k,1770) + lu(k,1783) = lu(k,1783) - lu(k,1422) * lu(k,1770) + lu(k,1785) = lu(k,1785) - lu(k,1423) * lu(k,1770) + lu(k,1786) = lu(k,1786) - lu(k,1424) * lu(k,1770) + lu(k,1787) = lu(k,1787) - lu(k,1425) * lu(k,1770) + lu(k,1788) = lu(k,1788) - lu(k,1426) * lu(k,1770) + lu(k,1916) = lu(k,1916) - lu(k,1418) * lu(k,1914) + lu(k,1918) = lu(k,1918) - lu(k,1419) * lu(k,1914) + lu(k,1919) = lu(k,1919) - lu(k,1420) * lu(k,1914) + lu(k,1920) = lu(k,1920) - lu(k,1421) * lu(k,1914) + lu(k,1927) = lu(k,1927) - lu(k,1422) * lu(k,1914) + lu(k,1929) = lu(k,1929) - lu(k,1423) * lu(k,1914) + lu(k,1930) = lu(k,1930) - lu(k,1424) * lu(k,1914) + lu(k,1931) = lu(k,1931) - lu(k,1425) * lu(k,1914) + lu(k,1932) = lu(k,1932) - lu(k,1426) * lu(k,1914) + lu(k,1960) = lu(k,1960) - lu(k,1418) * lu(k,1958) + lu(k,1962) = lu(k,1962) - lu(k,1419) * lu(k,1958) + lu(k,1963) = lu(k,1963) - lu(k,1420) * lu(k,1958) + lu(k,1964) = lu(k,1964) - lu(k,1421) * lu(k,1958) + lu(k,1971) = lu(k,1971) - lu(k,1422) * lu(k,1958) + lu(k,1973) = lu(k,1973) - lu(k,1423) * lu(k,1958) + lu(k,1974) = lu(k,1974) - lu(k,1424) * lu(k,1958) + lu(k,1975) = lu(k,1975) - lu(k,1425) * lu(k,1958) + lu(k,1976) = lu(k,1976) - lu(k,1426) * lu(k,1958) + lu(k,1999) = lu(k,1999) - lu(k,1418) * lu(k,1997) + lu(k,2001) = lu(k,2001) - lu(k,1419) * lu(k,1997) + lu(k,2002) = lu(k,2002) - lu(k,1420) * lu(k,1997) + lu(k,2003) = lu(k,2003) - lu(k,1421) * lu(k,1997) + lu(k,2010) = lu(k,2010) - lu(k,1422) * lu(k,1997) + lu(k,2012) = - lu(k,1423) * lu(k,1997) + lu(k,2013) = lu(k,2013) - lu(k,1424) * lu(k,1997) + lu(k,2014) = lu(k,2014) - lu(k,1425) * lu(k,1997) + lu(k,2015) = lu(k,2015) - lu(k,1426) * lu(k,1997) + lu(k,2106) = lu(k,2106) - lu(k,1418) * lu(k,2104) + lu(k,2108) = lu(k,2108) - lu(k,1419) * lu(k,2104) + lu(k,2109) = lu(k,2109) - lu(k,1420) * lu(k,2104) + lu(k,2110) = lu(k,2110) - lu(k,1421) * lu(k,2104) + lu(k,2117) = lu(k,2117) - lu(k,1422) * lu(k,2104) + lu(k,2119) = lu(k,2119) - lu(k,1423) * lu(k,2104) + lu(k,2120) = lu(k,2120) - lu(k,1424) * lu(k,2104) + lu(k,2121) = lu(k,2121) - lu(k,1425) * lu(k,2104) + lu(k,2122) = lu(k,2122) - lu(k,1426) * lu(k,2104) + lu(k,2129) = lu(k,2129) - lu(k,1418) * lu(k,2128) + lu(k,2131) = - lu(k,1419) * lu(k,2128) + lu(k,2132) = lu(k,2132) - lu(k,1420) * lu(k,2128) + lu(k,2133) = lu(k,2133) - lu(k,1421) * lu(k,2128) + lu(k,2140) = - lu(k,1422) * lu(k,2128) + lu(k,2142) = lu(k,2142) - lu(k,1423) * lu(k,2128) + lu(k,2143) = lu(k,2143) - lu(k,1424) * lu(k,2128) + lu(k,2144) = - lu(k,1425) * lu(k,2128) + lu(k,2145) = lu(k,2145) - lu(k,1426) * lu(k,2128) + lu(k,2153) = lu(k,2153) - lu(k,1418) * lu(k,2152) + lu(k,2155) = - lu(k,1419) * lu(k,2152) + lu(k,2156) = - lu(k,1420) * lu(k,2152) + lu(k,2157) = lu(k,2157) - lu(k,1421) * lu(k,2152) + lu(k,2164) = lu(k,2164) - lu(k,1422) * lu(k,2152) + lu(k,2166) = lu(k,2166) - lu(k,1423) * lu(k,2152) + lu(k,2167) = lu(k,2167) - lu(k,1424) * lu(k,2152) + lu(k,2168) = lu(k,2168) - lu(k,1425) * lu(k,2152) + lu(k,2169) = lu(k,2169) - lu(k,1426) * lu(k,2152) + lu(k,2184) = lu(k,2184) - lu(k,1418) * lu(k,2182) + lu(k,2186) = lu(k,2186) - lu(k,1419) * lu(k,2182) + lu(k,2187) = lu(k,2187) - lu(k,1420) * lu(k,2182) + lu(k,2188) = lu(k,2188) - lu(k,1421) * lu(k,2182) + lu(k,2195) = lu(k,2195) - lu(k,1422) * lu(k,2182) + lu(k,2197) = lu(k,2197) - lu(k,1423) * lu(k,2182) + lu(k,2198) = lu(k,2198) - lu(k,1424) * lu(k,2182) + lu(k,2199) = lu(k,2199) - lu(k,1425) * lu(k,2182) + lu(k,2200) = lu(k,2200) - lu(k,1426) * lu(k,2182) + lu(k,2245) = lu(k,2245) - lu(k,1418) * lu(k,2243) + lu(k,2247) = lu(k,2247) - lu(k,1419) * lu(k,2243) + lu(k,2248) = lu(k,2248) - lu(k,1420) * lu(k,2243) + lu(k,2249) = lu(k,2249) - lu(k,1421) * lu(k,2243) + lu(k,2256) = lu(k,2256) - lu(k,1422) * lu(k,2243) + lu(k,2258) = lu(k,2258) - lu(k,1423) * lu(k,2243) + lu(k,2259) = lu(k,2259) - lu(k,1424) * lu(k,2243) + lu(k,2260) = lu(k,2260) - lu(k,1425) * lu(k,2243) + lu(k,2261) = lu(k,2261) - lu(k,1426) * lu(k,2243) + lu(k,2271) = lu(k,2271) - lu(k,1418) * lu(k,2269) + lu(k,2273) = - lu(k,1419) * lu(k,2269) + lu(k,2274) = lu(k,2274) - lu(k,1420) * lu(k,2269) + lu(k,2275) = lu(k,2275) - lu(k,1421) * lu(k,2269) + lu(k,2282) = lu(k,2282) - lu(k,1422) * lu(k,2269) + lu(k,2284) = lu(k,2284) - lu(k,1423) * lu(k,2269) + lu(k,2285) = lu(k,2285) - lu(k,1424) * lu(k,2269) + lu(k,2286) = lu(k,2286) - lu(k,1425) * lu(k,2269) + lu(k,2287) = lu(k,2287) - lu(k,1426) * lu(k,2269) + end do + end subroutine lu_fac27 + subroutine lu_fac28( 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,1432) = 1._r8 / lu(k,1432) + lu(k,1433) = lu(k,1433) * lu(k,1432) + lu(k,1434) = lu(k,1434) * lu(k,1432) + lu(k,1435) = lu(k,1435) * lu(k,1432) + lu(k,1436) = lu(k,1436) * lu(k,1432) + lu(k,1437) = lu(k,1437) * lu(k,1432) + lu(k,1438) = lu(k,1438) * lu(k,1432) + lu(k,1439) = lu(k,1439) * lu(k,1432) + lu(k,1440) = lu(k,1440) * lu(k,1432) + lu(k,1441) = lu(k,1441) * lu(k,1432) + lu(k,1442) = lu(k,1442) * lu(k,1432) + lu(k,1443) = lu(k,1443) * lu(k,1432) + lu(k,1444) = lu(k,1444) * lu(k,1432) + lu(k,1447) = lu(k,1447) - lu(k,1433) * lu(k,1446) + lu(k,1448) = lu(k,1448) - lu(k,1434) * lu(k,1446) + lu(k,1449) = - lu(k,1435) * lu(k,1446) + lu(k,1450) = lu(k,1450) - lu(k,1436) * lu(k,1446) + lu(k,1451) = lu(k,1451) - lu(k,1437) * lu(k,1446) + lu(k,1452) = lu(k,1452) - lu(k,1438) * lu(k,1446) + lu(k,1453) = lu(k,1453) - lu(k,1439) * lu(k,1446) + lu(k,1454) = lu(k,1454) - lu(k,1440) * lu(k,1446) + lu(k,1455) = lu(k,1455) - lu(k,1441) * lu(k,1446) + lu(k,1456) = lu(k,1456) - lu(k,1442) * lu(k,1446) + lu(k,1457) = lu(k,1457) - lu(k,1443) * lu(k,1446) + lu(k,1459) = lu(k,1459) - lu(k,1444) * lu(k,1446) + lu(k,1464) = lu(k,1464) - lu(k,1433) * lu(k,1463) + lu(k,1465) = lu(k,1465) - lu(k,1434) * lu(k,1463) + lu(k,1466) = - lu(k,1435) * lu(k,1463) + lu(k,1467) = lu(k,1467) - lu(k,1436) * lu(k,1463) + lu(k,1468) = lu(k,1468) - lu(k,1437) * lu(k,1463) + lu(k,1469) = lu(k,1469) - lu(k,1438) * lu(k,1463) + lu(k,1470) = lu(k,1470) - lu(k,1439) * lu(k,1463) + lu(k,1472) = lu(k,1472) - lu(k,1440) * lu(k,1463) + lu(k,1473) = - lu(k,1441) * lu(k,1463) + lu(k,1474) = lu(k,1474) - lu(k,1442) * lu(k,1463) + lu(k,1475) = lu(k,1475) - lu(k,1443) * lu(k,1463) + lu(k,1477) = lu(k,1477) - lu(k,1444) * lu(k,1463) + lu(k,1485) = lu(k,1485) - lu(k,1433) * lu(k,1484) + lu(k,1486) = lu(k,1486) - lu(k,1434) * lu(k,1484) + lu(k,1487) = lu(k,1487) - lu(k,1435) * lu(k,1484) + lu(k,1488) = lu(k,1488) - lu(k,1436) * lu(k,1484) + lu(k,1489) = lu(k,1489) - lu(k,1437) * lu(k,1484) + lu(k,1490) = lu(k,1490) - lu(k,1438) * lu(k,1484) + lu(k,1491) = lu(k,1491) - lu(k,1439) * lu(k,1484) + lu(k,1494) = lu(k,1494) - lu(k,1440) * lu(k,1484) + lu(k,1495) = lu(k,1495) - lu(k,1441) * lu(k,1484) + lu(k,1496) = lu(k,1496) - lu(k,1442) * lu(k,1484) + lu(k,1498) = lu(k,1498) - lu(k,1443) * lu(k,1484) + lu(k,1500) = lu(k,1500) - lu(k,1444) * lu(k,1484) + lu(k,1525) = lu(k,1525) - lu(k,1433) * lu(k,1524) + lu(k,1526) = lu(k,1526) - lu(k,1434) * lu(k,1524) + lu(k,1527) = lu(k,1527) - lu(k,1435) * lu(k,1524) + lu(k,1528) = lu(k,1528) - lu(k,1436) * lu(k,1524) + lu(k,1529) = lu(k,1529) - lu(k,1437) * lu(k,1524) + lu(k,1531) = lu(k,1531) - lu(k,1438) * lu(k,1524) + lu(k,1532) = lu(k,1532) - lu(k,1439) * lu(k,1524) + lu(k,1535) = lu(k,1535) - lu(k,1440) * lu(k,1524) + lu(k,1536) = lu(k,1536) - lu(k,1441) * lu(k,1524) + lu(k,1537) = lu(k,1537) - lu(k,1442) * lu(k,1524) + lu(k,1539) = lu(k,1539) - lu(k,1443) * lu(k,1524) + lu(k,1541) = lu(k,1541) - lu(k,1444) * lu(k,1524) + lu(k,1689) = lu(k,1689) - lu(k,1433) * lu(k,1688) + lu(k,1690) = lu(k,1690) - lu(k,1434) * lu(k,1688) + lu(k,1691) = lu(k,1691) - lu(k,1435) * lu(k,1688) + lu(k,1692) = lu(k,1692) - lu(k,1436) * lu(k,1688) + lu(k,1693) = lu(k,1693) - lu(k,1437) * lu(k,1688) + lu(k,1695) = lu(k,1695) - lu(k,1438) * lu(k,1688) + lu(k,1696) = lu(k,1696) - lu(k,1439) * lu(k,1688) + lu(k,1699) = lu(k,1699) - lu(k,1440) * lu(k,1688) + lu(k,1700) = lu(k,1700) - lu(k,1441) * lu(k,1688) + lu(k,1701) = lu(k,1701) - lu(k,1442) * lu(k,1688) + lu(k,1703) = lu(k,1703) - lu(k,1443) * lu(k,1688) + lu(k,1705) = lu(k,1705) - lu(k,1444) * lu(k,1688) + lu(k,1772) = lu(k,1772) - lu(k,1433) * lu(k,1771) + lu(k,1773) = lu(k,1773) - lu(k,1434) * lu(k,1771) + lu(k,1774) = lu(k,1774) - lu(k,1435) * lu(k,1771) + lu(k,1775) = lu(k,1775) - lu(k,1436) * lu(k,1771) + lu(k,1776) = lu(k,1776) - lu(k,1437) * lu(k,1771) + lu(k,1778) = lu(k,1778) - lu(k,1438) * lu(k,1771) + lu(k,1779) = lu(k,1779) - lu(k,1439) * lu(k,1771) + lu(k,1782) = lu(k,1782) - lu(k,1440) * lu(k,1771) + lu(k,1783) = lu(k,1783) - lu(k,1441) * lu(k,1771) + lu(k,1784) = - lu(k,1442) * lu(k,1771) + lu(k,1786) = lu(k,1786) - lu(k,1443) * lu(k,1771) + lu(k,1788) = lu(k,1788) - lu(k,1444) * lu(k,1771) + lu(k,1824) = lu(k,1824) - lu(k,1433) * lu(k,1823) + lu(k,1825) = lu(k,1825) - lu(k,1434) * lu(k,1823) + lu(k,1826) = lu(k,1826) - lu(k,1435) * lu(k,1823) + lu(k,1827) = - lu(k,1436) * lu(k,1823) + lu(k,1828) = lu(k,1828) - lu(k,1437) * lu(k,1823) + lu(k,1830) = lu(k,1830) - lu(k,1438) * lu(k,1823) + lu(k,1831) = lu(k,1831) - lu(k,1439) * lu(k,1823) + lu(k,1834) = lu(k,1834) - lu(k,1440) * lu(k,1823) + lu(k,1835) = lu(k,1835) - lu(k,1441) * lu(k,1823) + lu(k,1836) = - lu(k,1442) * lu(k,1823) + lu(k,1838) = lu(k,1838) - lu(k,1443) * lu(k,1823) + lu(k,1840) = lu(k,1840) - lu(k,1444) * lu(k,1823) + lu(k,1916) = lu(k,1916) - lu(k,1433) * lu(k,1915) + lu(k,1917) = lu(k,1917) - lu(k,1434) * lu(k,1915) + lu(k,1918) = lu(k,1918) - lu(k,1435) * lu(k,1915) + lu(k,1919) = lu(k,1919) - lu(k,1436) * lu(k,1915) + lu(k,1920) = lu(k,1920) - lu(k,1437) * lu(k,1915) + lu(k,1922) = lu(k,1922) - lu(k,1438) * lu(k,1915) + lu(k,1923) = lu(k,1923) - lu(k,1439) * lu(k,1915) + lu(k,1926) = lu(k,1926) - lu(k,1440) * lu(k,1915) + lu(k,1927) = lu(k,1927) - lu(k,1441) * lu(k,1915) + lu(k,1928) = - lu(k,1442) * lu(k,1915) + lu(k,1930) = lu(k,1930) - lu(k,1443) * lu(k,1915) + lu(k,1932) = lu(k,1932) - lu(k,1444) * lu(k,1915) + lu(k,1960) = lu(k,1960) - lu(k,1433) * lu(k,1959) + lu(k,1961) = lu(k,1961) - lu(k,1434) * lu(k,1959) + lu(k,1962) = lu(k,1962) - lu(k,1435) * lu(k,1959) + lu(k,1963) = lu(k,1963) - lu(k,1436) * lu(k,1959) + lu(k,1964) = lu(k,1964) - lu(k,1437) * lu(k,1959) + lu(k,1966) = lu(k,1966) - lu(k,1438) * lu(k,1959) + lu(k,1967) = lu(k,1967) - lu(k,1439) * lu(k,1959) + lu(k,1970) = lu(k,1970) - lu(k,1440) * lu(k,1959) + lu(k,1971) = lu(k,1971) - lu(k,1441) * lu(k,1959) + lu(k,1972) = lu(k,1972) - lu(k,1442) * lu(k,1959) + lu(k,1974) = lu(k,1974) - lu(k,1443) * lu(k,1959) + lu(k,1976) = lu(k,1976) - lu(k,1444) * lu(k,1959) + lu(k,1999) = lu(k,1999) - lu(k,1433) * lu(k,1998) + lu(k,2000) = lu(k,2000) - lu(k,1434) * lu(k,1998) + lu(k,2001) = lu(k,2001) - lu(k,1435) * lu(k,1998) + lu(k,2002) = lu(k,2002) - lu(k,1436) * lu(k,1998) + lu(k,2003) = lu(k,2003) - lu(k,1437) * lu(k,1998) + lu(k,2005) = lu(k,2005) - lu(k,1438) * lu(k,1998) + lu(k,2006) = lu(k,2006) - lu(k,1439) * lu(k,1998) + lu(k,2009) = lu(k,2009) - lu(k,1440) * lu(k,1998) + lu(k,2010) = lu(k,2010) - lu(k,1441) * lu(k,1998) + lu(k,2011) = lu(k,2011) - lu(k,1442) * lu(k,1998) + lu(k,2013) = lu(k,2013) - lu(k,1443) * lu(k,1998) + lu(k,2015) = lu(k,2015) - lu(k,1444) * lu(k,1998) + lu(k,2106) = lu(k,2106) - lu(k,1433) * lu(k,2105) + lu(k,2107) = lu(k,2107) - lu(k,1434) * lu(k,2105) + lu(k,2108) = lu(k,2108) - lu(k,1435) * lu(k,2105) + lu(k,2109) = lu(k,2109) - lu(k,1436) * lu(k,2105) + lu(k,2110) = lu(k,2110) - lu(k,1437) * lu(k,2105) + lu(k,2112) = lu(k,2112) - lu(k,1438) * lu(k,2105) + lu(k,2113) = lu(k,2113) - lu(k,1439) * lu(k,2105) + lu(k,2116) = lu(k,2116) - lu(k,1440) * lu(k,2105) + lu(k,2117) = lu(k,2117) - lu(k,1441) * lu(k,2105) + lu(k,2118) = lu(k,2118) - lu(k,1442) * lu(k,2105) + lu(k,2120) = lu(k,2120) - lu(k,1443) * lu(k,2105) + lu(k,2122) = lu(k,2122) - lu(k,1444) * lu(k,2105) + lu(k,2184) = lu(k,2184) - lu(k,1433) * lu(k,2183) + lu(k,2185) = lu(k,2185) - lu(k,1434) * lu(k,2183) + lu(k,2186) = lu(k,2186) - lu(k,1435) * lu(k,2183) + lu(k,2187) = lu(k,2187) - lu(k,1436) * lu(k,2183) + lu(k,2188) = lu(k,2188) - lu(k,1437) * lu(k,2183) + lu(k,2190) = lu(k,2190) - lu(k,1438) * lu(k,2183) + lu(k,2191) = lu(k,2191) - lu(k,1439) * lu(k,2183) + lu(k,2194) = lu(k,2194) - lu(k,1440) * lu(k,2183) + lu(k,2195) = lu(k,2195) - lu(k,1441) * lu(k,2183) + lu(k,2196) = lu(k,2196) - lu(k,1442) * lu(k,2183) + lu(k,2198) = lu(k,2198) - lu(k,1443) * lu(k,2183) + lu(k,2200) = lu(k,2200) - lu(k,1444) * lu(k,2183) + lu(k,2245) = lu(k,2245) - lu(k,1433) * lu(k,2244) + lu(k,2246) = lu(k,2246) - lu(k,1434) * lu(k,2244) + lu(k,2247) = lu(k,2247) - lu(k,1435) * lu(k,2244) + lu(k,2248) = lu(k,2248) - lu(k,1436) * lu(k,2244) + lu(k,2249) = lu(k,2249) - lu(k,1437) * lu(k,2244) + lu(k,2251) = lu(k,2251) - lu(k,1438) * lu(k,2244) + lu(k,2252) = lu(k,2252) - lu(k,1439) * lu(k,2244) + lu(k,2255) = lu(k,2255) - lu(k,1440) * lu(k,2244) + lu(k,2256) = lu(k,2256) - lu(k,1441) * lu(k,2244) + lu(k,2257) = - lu(k,1442) * lu(k,2244) + lu(k,2259) = lu(k,2259) - lu(k,1443) * lu(k,2244) + lu(k,2261) = lu(k,2261) - lu(k,1444) * lu(k,2244) + lu(k,2271) = lu(k,2271) - lu(k,1433) * lu(k,2270) + lu(k,2272) = lu(k,2272) - lu(k,1434) * lu(k,2270) + lu(k,2273) = lu(k,2273) - lu(k,1435) * lu(k,2270) + lu(k,2274) = lu(k,2274) - lu(k,1436) * lu(k,2270) + lu(k,2275) = lu(k,2275) - lu(k,1437) * lu(k,2270) + lu(k,2277) = lu(k,2277) - lu(k,1438) * lu(k,2270) + lu(k,2278) = lu(k,2278) - lu(k,1439) * lu(k,2270) + lu(k,2281) = lu(k,2281) - lu(k,1440) * lu(k,2270) + lu(k,2282) = lu(k,2282) - lu(k,1441) * lu(k,2270) + lu(k,2283) = lu(k,2283) - lu(k,1442) * lu(k,2270) + lu(k,2285) = lu(k,2285) - lu(k,1443) * lu(k,2270) + lu(k,2287) = lu(k,2287) - lu(k,1444) * lu(k,2270) + lu(k,1447) = 1._r8 / lu(k,1447) + lu(k,1448) = lu(k,1448) * lu(k,1447) + lu(k,1449) = lu(k,1449) * lu(k,1447) + lu(k,1450) = lu(k,1450) * lu(k,1447) + lu(k,1451) = lu(k,1451) * lu(k,1447) + lu(k,1452) = lu(k,1452) * lu(k,1447) + lu(k,1453) = lu(k,1453) * lu(k,1447) + lu(k,1454) = lu(k,1454) * lu(k,1447) + lu(k,1455) = lu(k,1455) * lu(k,1447) + lu(k,1456) = lu(k,1456) * lu(k,1447) + lu(k,1457) = lu(k,1457) * lu(k,1447) + lu(k,1458) = lu(k,1458) * lu(k,1447) + lu(k,1459) = lu(k,1459) * lu(k,1447) + lu(k,1465) = lu(k,1465) - lu(k,1448) * lu(k,1464) + lu(k,1466) = lu(k,1466) - lu(k,1449) * lu(k,1464) + lu(k,1467) = lu(k,1467) - lu(k,1450) * lu(k,1464) + lu(k,1468) = lu(k,1468) - lu(k,1451) * lu(k,1464) + lu(k,1469) = lu(k,1469) - lu(k,1452) * lu(k,1464) + lu(k,1470) = lu(k,1470) - lu(k,1453) * lu(k,1464) + lu(k,1472) = lu(k,1472) - lu(k,1454) * lu(k,1464) + lu(k,1473) = lu(k,1473) - lu(k,1455) * lu(k,1464) + lu(k,1474) = lu(k,1474) - lu(k,1456) * lu(k,1464) + lu(k,1475) = lu(k,1475) - lu(k,1457) * lu(k,1464) + lu(k,1476) = - lu(k,1458) * lu(k,1464) + lu(k,1477) = lu(k,1477) - lu(k,1459) * lu(k,1464) + lu(k,1486) = lu(k,1486) - lu(k,1448) * lu(k,1485) + lu(k,1487) = lu(k,1487) - lu(k,1449) * lu(k,1485) + lu(k,1488) = lu(k,1488) - lu(k,1450) * lu(k,1485) + lu(k,1489) = lu(k,1489) - lu(k,1451) * lu(k,1485) + lu(k,1490) = lu(k,1490) - lu(k,1452) * lu(k,1485) + lu(k,1491) = lu(k,1491) - lu(k,1453) * lu(k,1485) + lu(k,1494) = lu(k,1494) - lu(k,1454) * lu(k,1485) + lu(k,1495) = lu(k,1495) - lu(k,1455) * lu(k,1485) + lu(k,1496) = lu(k,1496) - lu(k,1456) * lu(k,1485) + lu(k,1498) = lu(k,1498) - lu(k,1457) * lu(k,1485) + lu(k,1499) = lu(k,1499) - lu(k,1458) * lu(k,1485) + lu(k,1500) = lu(k,1500) - lu(k,1459) * lu(k,1485) + lu(k,1526) = lu(k,1526) - lu(k,1448) * lu(k,1525) + lu(k,1527) = lu(k,1527) - lu(k,1449) * lu(k,1525) + lu(k,1528) = lu(k,1528) - lu(k,1450) * lu(k,1525) + lu(k,1529) = lu(k,1529) - lu(k,1451) * lu(k,1525) + lu(k,1531) = lu(k,1531) - lu(k,1452) * lu(k,1525) + lu(k,1532) = lu(k,1532) - lu(k,1453) * lu(k,1525) + lu(k,1535) = lu(k,1535) - lu(k,1454) * lu(k,1525) + lu(k,1536) = lu(k,1536) - lu(k,1455) * lu(k,1525) + lu(k,1537) = lu(k,1537) - lu(k,1456) * lu(k,1525) + lu(k,1539) = lu(k,1539) - lu(k,1457) * lu(k,1525) + lu(k,1540) = lu(k,1540) - lu(k,1458) * lu(k,1525) + lu(k,1541) = lu(k,1541) - lu(k,1459) * lu(k,1525) + lu(k,1690) = lu(k,1690) - lu(k,1448) * lu(k,1689) + lu(k,1691) = lu(k,1691) - lu(k,1449) * lu(k,1689) + lu(k,1692) = lu(k,1692) - lu(k,1450) * lu(k,1689) + lu(k,1693) = lu(k,1693) - lu(k,1451) * lu(k,1689) + lu(k,1695) = lu(k,1695) - lu(k,1452) * lu(k,1689) + lu(k,1696) = lu(k,1696) - lu(k,1453) * lu(k,1689) + lu(k,1699) = lu(k,1699) - lu(k,1454) * lu(k,1689) + lu(k,1700) = lu(k,1700) - lu(k,1455) * lu(k,1689) + lu(k,1701) = lu(k,1701) - lu(k,1456) * lu(k,1689) + lu(k,1703) = lu(k,1703) - lu(k,1457) * lu(k,1689) + lu(k,1704) = lu(k,1704) - lu(k,1458) * lu(k,1689) + lu(k,1705) = lu(k,1705) - lu(k,1459) * lu(k,1689) + lu(k,1716) = lu(k,1716) - lu(k,1448) * lu(k,1715) + lu(k,1717) = lu(k,1717) - lu(k,1449) * lu(k,1715) + lu(k,1718) = lu(k,1718) - lu(k,1450) * lu(k,1715) + lu(k,1719) = lu(k,1719) - lu(k,1451) * lu(k,1715) + lu(k,1721) = lu(k,1721) - lu(k,1452) * lu(k,1715) + lu(k,1722) = lu(k,1722) - lu(k,1453) * lu(k,1715) + lu(k,1725) = lu(k,1725) - lu(k,1454) * lu(k,1715) + lu(k,1726) = lu(k,1726) - lu(k,1455) * lu(k,1715) + lu(k,1727) = lu(k,1727) - lu(k,1456) * lu(k,1715) + lu(k,1729) = lu(k,1729) - lu(k,1457) * lu(k,1715) + lu(k,1730) = lu(k,1730) - lu(k,1458) * lu(k,1715) + lu(k,1731) = lu(k,1731) - lu(k,1459) * lu(k,1715) + lu(k,1773) = lu(k,1773) - lu(k,1448) * lu(k,1772) + lu(k,1774) = lu(k,1774) - lu(k,1449) * lu(k,1772) + lu(k,1775) = lu(k,1775) - lu(k,1450) * lu(k,1772) + lu(k,1776) = lu(k,1776) - lu(k,1451) * lu(k,1772) + lu(k,1778) = lu(k,1778) - lu(k,1452) * lu(k,1772) + lu(k,1779) = lu(k,1779) - lu(k,1453) * lu(k,1772) + lu(k,1782) = lu(k,1782) - lu(k,1454) * lu(k,1772) + lu(k,1783) = lu(k,1783) - lu(k,1455) * lu(k,1772) + lu(k,1784) = lu(k,1784) - lu(k,1456) * lu(k,1772) + lu(k,1786) = lu(k,1786) - lu(k,1457) * lu(k,1772) + lu(k,1787) = lu(k,1787) - lu(k,1458) * lu(k,1772) + lu(k,1788) = lu(k,1788) - lu(k,1459) * lu(k,1772) + lu(k,1825) = lu(k,1825) - lu(k,1448) * lu(k,1824) + lu(k,1826) = lu(k,1826) - lu(k,1449) * lu(k,1824) + lu(k,1827) = lu(k,1827) - lu(k,1450) * lu(k,1824) + lu(k,1828) = lu(k,1828) - lu(k,1451) * lu(k,1824) + lu(k,1830) = lu(k,1830) - lu(k,1452) * lu(k,1824) + lu(k,1831) = lu(k,1831) - lu(k,1453) * lu(k,1824) + lu(k,1834) = lu(k,1834) - lu(k,1454) * lu(k,1824) + lu(k,1835) = lu(k,1835) - lu(k,1455) * lu(k,1824) + lu(k,1836) = lu(k,1836) - lu(k,1456) * lu(k,1824) + lu(k,1838) = lu(k,1838) - lu(k,1457) * lu(k,1824) + lu(k,1839) = lu(k,1839) - lu(k,1458) * lu(k,1824) + lu(k,1840) = lu(k,1840) - lu(k,1459) * lu(k,1824) + lu(k,1917) = lu(k,1917) - lu(k,1448) * lu(k,1916) + lu(k,1918) = lu(k,1918) - lu(k,1449) * lu(k,1916) + lu(k,1919) = lu(k,1919) - lu(k,1450) * lu(k,1916) + lu(k,1920) = lu(k,1920) - lu(k,1451) * lu(k,1916) + lu(k,1922) = lu(k,1922) - lu(k,1452) * lu(k,1916) + lu(k,1923) = lu(k,1923) - lu(k,1453) * lu(k,1916) + lu(k,1926) = lu(k,1926) - lu(k,1454) * lu(k,1916) + lu(k,1927) = lu(k,1927) - lu(k,1455) * lu(k,1916) + lu(k,1928) = lu(k,1928) - lu(k,1456) * lu(k,1916) + lu(k,1930) = lu(k,1930) - lu(k,1457) * lu(k,1916) + lu(k,1931) = lu(k,1931) - lu(k,1458) * lu(k,1916) + lu(k,1932) = lu(k,1932) - lu(k,1459) * lu(k,1916) + lu(k,1961) = lu(k,1961) - lu(k,1448) * lu(k,1960) + lu(k,1962) = lu(k,1962) - lu(k,1449) * lu(k,1960) + lu(k,1963) = lu(k,1963) - lu(k,1450) * lu(k,1960) + lu(k,1964) = lu(k,1964) - lu(k,1451) * lu(k,1960) + lu(k,1966) = lu(k,1966) - lu(k,1452) * lu(k,1960) + lu(k,1967) = lu(k,1967) - lu(k,1453) * lu(k,1960) + lu(k,1970) = lu(k,1970) - lu(k,1454) * lu(k,1960) + lu(k,1971) = lu(k,1971) - lu(k,1455) * lu(k,1960) + lu(k,1972) = lu(k,1972) - lu(k,1456) * lu(k,1960) + lu(k,1974) = lu(k,1974) - lu(k,1457) * lu(k,1960) + lu(k,1975) = lu(k,1975) - lu(k,1458) * lu(k,1960) + lu(k,1976) = lu(k,1976) - lu(k,1459) * lu(k,1960) + lu(k,2000) = lu(k,2000) - lu(k,1448) * lu(k,1999) + lu(k,2001) = lu(k,2001) - lu(k,1449) * lu(k,1999) + lu(k,2002) = lu(k,2002) - lu(k,1450) * lu(k,1999) + lu(k,2003) = lu(k,2003) - lu(k,1451) * lu(k,1999) + lu(k,2005) = lu(k,2005) - lu(k,1452) * lu(k,1999) + lu(k,2006) = lu(k,2006) - lu(k,1453) * lu(k,1999) + lu(k,2009) = lu(k,2009) - lu(k,1454) * lu(k,1999) + lu(k,2010) = lu(k,2010) - lu(k,1455) * lu(k,1999) + lu(k,2011) = lu(k,2011) - lu(k,1456) * lu(k,1999) + lu(k,2013) = lu(k,2013) - lu(k,1457) * lu(k,1999) + lu(k,2014) = lu(k,2014) - lu(k,1458) * lu(k,1999) + lu(k,2015) = lu(k,2015) - lu(k,1459) * lu(k,1999) + lu(k,2107) = lu(k,2107) - lu(k,1448) * lu(k,2106) + lu(k,2108) = lu(k,2108) - lu(k,1449) * lu(k,2106) + lu(k,2109) = lu(k,2109) - lu(k,1450) * lu(k,2106) + lu(k,2110) = lu(k,2110) - lu(k,1451) * lu(k,2106) + lu(k,2112) = lu(k,2112) - lu(k,1452) * lu(k,2106) + lu(k,2113) = lu(k,2113) - lu(k,1453) * lu(k,2106) + lu(k,2116) = lu(k,2116) - lu(k,1454) * lu(k,2106) + lu(k,2117) = lu(k,2117) - lu(k,1455) * lu(k,2106) + lu(k,2118) = lu(k,2118) - lu(k,1456) * lu(k,2106) + lu(k,2120) = lu(k,2120) - lu(k,1457) * lu(k,2106) + lu(k,2121) = lu(k,2121) - lu(k,1458) * lu(k,2106) + lu(k,2122) = lu(k,2122) - lu(k,1459) * lu(k,2106) + lu(k,2130) = lu(k,2130) - lu(k,1448) * lu(k,2129) + lu(k,2131) = lu(k,2131) - lu(k,1449) * lu(k,2129) + lu(k,2132) = lu(k,2132) - lu(k,1450) * lu(k,2129) + lu(k,2133) = lu(k,2133) - lu(k,1451) * lu(k,2129) + lu(k,2135) = lu(k,2135) - lu(k,1452) * lu(k,2129) + lu(k,2136) = - lu(k,1453) * lu(k,2129) + lu(k,2139) = lu(k,2139) - lu(k,1454) * lu(k,2129) + lu(k,2140) = lu(k,2140) - lu(k,1455) * lu(k,2129) + lu(k,2141) = lu(k,2141) - lu(k,1456) * lu(k,2129) + lu(k,2143) = lu(k,2143) - lu(k,1457) * lu(k,2129) + lu(k,2144) = lu(k,2144) - lu(k,1458) * lu(k,2129) + lu(k,2145) = lu(k,2145) - lu(k,1459) * lu(k,2129) + lu(k,2154) = lu(k,2154) - lu(k,1448) * lu(k,2153) + lu(k,2155) = lu(k,2155) - lu(k,1449) * lu(k,2153) + lu(k,2156) = lu(k,2156) - lu(k,1450) * lu(k,2153) + lu(k,2157) = lu(k,2157) - lu(k,1451) * lu(k,2153) + lu(k,2159) = lu(k,2159) - lu(k,1452) * lu(k,2153) + lu(k,2160) = - lu(k,1453) * lu(k,2153) + lu(k,2163) = lu(k,2163) - lu(k,1454) * lu(k,2153) + lu(k,2164) = lu(k,2164) - lu(k,1455) * lu(k,2153) + lu(k,2165) = lu(k,2165) - lu(k,1456) * lu(k,2153) + lu(k,2167) = lu(k,2167) - lu(k,1457) * lu(k,2153) + lu(k,2168) = lu(k,2168) - lu(k,1458) * lu(k,2153) + lu(k,2169) = lu(k,2169) - lu(k,1459) * lu(k,2153) + lu(k,2185) = lu(k,2185) - lu(k,1448) * lu(k,2184) + lu(k,2186) = lu(k,2186) - lu(k,1449) * lu(k,2184) + lu(k,2187) = lu(k,2187) - lu(k,1450) * lu(k,2184) + lu(k,2188) = lu(k,2188) - lu(k,1451) * lu(k,2184) + lu(k,2190) = lu(k,2190) - lu(k,1452) * lu(k,2184) + lu(k,2191) = lu(k,2191) - lu(k,1453) * lu(k,2184) + lu(k,2194) = lu(k,2194) - lu(k,1454) * lu(k,2184) + lu(k,2195) = lu(k,2195) - lu(k,1455) * lu(k,2184) + lu(k,2196) = lu(k,2196) - lu(k,1456) * lu(k,2184) + lu(k,2198) = lu(k,2198) - lu(k,1457) * lu(k,2184) + lu(k,2199) = lu(k,2199) - lu(k,1458) * lu(k,2184) + lu(k,2200) = lu(k,2200) - lu(k,1459) * lu(k,2184) + lu(k,2246) = lu(k,2246) - lu(k,1448) * lu(k,2245) + lu(k,2247) = lu(k,2247) - lu(k,1449) * lu(k,2245) + lu(k,2248) = lu(k,2248) - lu(k,1450) * lu(k,2245) + lu(k,2249) = lu(k,2249) - lu(k,1451) * lu(k,2245) + lu(k,2251) = lu(k,2251) - lu(k,1452) * lu(k,2245) + lu(k,2252) = lu(k,2252) - lu(k,1453) * lu(k,2245) + lu(k,2255) = lu(k,2255) - lu(k,1454) * lu(k,2245) + lu(k,2256) = lu(k,2256) - lu(k,1455) * lu(k,2245) + lu(k,2257) = lu(k,2257) - lu(k,1456) * lu(k,2245) + lu(k,2259) = lu(k,2259) - lu(k,1457) * lu(k,2245) + lu(k,2260) = lu(k,2260) - lu(k,1458) * lu(k,2245) + lu(k,2261) = lu(k,2261) - lu(k,1459) * lu(k,2245) + lu(k,2272) = lu(k,2272) - lu(k,1448) * lu(k,2271) + lu(k,2273) = lu(k,2273) - lu(k,1449) * lu(k,2271) + lu(k,2274) = lu(k,2274) - lu(k,1450) * lu(k,2271) + lu(k,2275) = lu(k,2275) - lu(k,1451) * lu(k,2271) + lu(k,2277) = lu(k,2277) - lu(k,1452) * lu(k,2271) + lu(k,2278) = lu(k,2278) - lu(k,1453) * lu(k,2271) + lu(k,2281) = lu(k,2281) - lu(k,1454) * lu(k,2271) + lu(k,2282) = lu(k,2282) - lu(k,1455) * lu(k,2271) + lu(k,2283) = lu(k,2283) - lu(k,1456) * lu(k,2271) + lu(k,2285) = lu(k,2285) - lu(k,1457) * lu(k,2271) + lu(k,2286) = lu(k,2286) - lu(k,1458) * lu(k,2271) + lu(k,2287) = lu(k,2287) - lu(k,1459) * lu(k,2271) + lu(k,1465) = 1._r8 / lu(k,1465) + lu(k,1466) = lu(k,1466) * lu(k,1465) + lu(k,1467) = lu(k,1467) * lu(k,1465) + lu(k,1468) = lu(k,1468) * lu(k,1465) + lu(k,1469) = lu(k,1469) * lu(k,1465) + lu(k,1470) = lu(k,1470) * lu(k,1465) + lu(k,1471) = lu(k,1471) * lu(k,1465) + lu(k,1472) = lu(k,1472) * lu(k,1465) + lu(k,1473) = lu(k,1473) * lu(k,1465) + lu(k,1474) = lu(k,1474) * lu(k,1465) + lu(k,1475) = lu(k,1475) * lu(k,1465) + lu(k,1476) = lu(k,1476) * lu(k,1465) + lu(k,1477) = lu(k,1477) * lu(k,1465) + lu(k,1487) = lu(k,1487) - lu(k,1466) * lu(k,1486) + lu(k,1488) = lu(k,1488) - lu(k,1467) * lu(k,1486) + lu(k,1489) = lu(k,1489) - lu(k,1468) * lu(k,1486) + lu(k,1490) = lu(k,1490) - lu(k,1469) * lu(k,1486) + lu(k,1491) = lu(k,1491) - lu(k,1470) * lu(k,1486) + lu(k,1493) = lu(k,1493) - lu(k,1471) * lu(k,1486) + lu(k,1494) = lu(k,1494) - lu(k,1472) * lu(k,1486) + lu(k,1495) = lu(k,1495) - lu(k,1473) * lu(k,1486) + lu(k,1496) = lu(k,1496) - lu(k,1474) * lu(k,1486) + lu(k,1498) = lu(k,1498) - lu(k,1475) * lu(k,1486) + lu(k,1499) = lu(k,1499) - lu(k,1476) * lu(k,1486) + lu(k,1500) = lu(k,1500) - lu(k,1477) * lu(k,1486) + lu(k,1527) = lu(k,1527) - lu(k,1466) * lu(k,1526) + lu(k,1528) = lu(k,1528) - lu(k,1467) * lu(k,1526) + lu(k,1529) = lu(k,1529) - lu(k,1468) * lu(k,1526) + lu(k,1531) = lu(k,1531) - lu(k,1469) * lu(k,1526) + lu(k,1532) = lu(k,1532) - lu(k,1470) * lu(k,1526) + lu(k,1534) = - lu(k,1471) * lu(k,1526) + lu(k,1535) = lu(k,1535) - lu(k,1472) * lu(k,1526) + lu(k,1536) = lu(k,1536) - lu(k,1473) * lu(k,1526) + lu(k,1537) = lu(k,1537) - lu(k,1474) * lu(k,1526) + lu(k,1539) = lu(k,1539) - lu(k,1475) * lu(k,1526) + lu(k,1540) = lu(k,1540) - lu(k,1476) * lu(k,1526) + lu(k,1541) = lu(k,1541) - lu(k,1477) * lu(k,1526) + lu(k,1691) = lu(k,1691) - lu(k,1466) * lu(k,1690) + lu(k,1692) = lu(k,1692) - lu(k,1467) * lu(k,1690) + lu(k,1693) = lu(k,1693) - lu(k,1468) * lu(k,1690) + lu(k,1695) = lu(k,1695) - lu(k,1469) * lu(k,1690) + lu(k,1696) = lu(k,1696) - lu(k,1470) * lu(k,1690) + lu(k,1698) = lu(k,1698) - lu(k,1471) * lu(k,1690) + lu(k,1699) = lu(k,1699) - lu(k,1472) * lu(k,1690) + lu(k,1700) = lu(k,1700) - lu(k,1473) * lu(k,1690) + lu(k,1701) = lu(k,1701) - lu(k,1474) * lu(k,1690) + lu(k,1703) = lu(k,1703) - lu(k,1475) * lu(k,1690) + lu(k,1704) = lu(k,1704) - lu(k,1476) * lu(k,1690) + lu(k,1705) = lu(k,1705) - lu(k,1477) * lu(k,1690) + lu(k,1717) = lu(k,1717) - lu(k,1466) * lu(k,1716) + lu(k,1718) = lu(k,1718) - lu(k,1467) * lu(k,1716) + lu(k,1719) = lu(k,1719) - lu(k,1468) * lu(k,1716) + lu(k,1721) = lu(k,1721) - lu(k,1469) * lu(k,1716) + lu(k,1722) = lu(k,1722) - lu(k,1470) * lu(k,1716) + lu(k,1724) = lu(k,1724) - lu(k,1471) * lu(k,1716) + lu(k,1725) = lu(k,1725) - lu(k,1472) * lu(k,1716) + lu(k,1726) = lu(k,1726) - lu(k,1473) * lu(k,1716) + lu(k,1727) = lu(k,1727) - lu(k,1474) * lu(k,1716) + lu(k,1729) = lu(k,1729) - lu(k,1475) * lu(k,1716) + lu(k,1730) = lu(k,1730) - lu(k,1476) * lu(k,1716) + lu(k,1731) = lu(k,1731) - lu(k,1477) * lu(k,1716) + lu(k,1774) = lu(k,1774) - lu(k,1466) * lu(k,1773) + lu(k,1775) = lu(k,1775) - lu(k,1467) * lu(k,1773) + lu(k,1776) = lu(k,1776) - lu(k,1468) * lu(k,1773) + lu(k,1778) = lu(k,1778) - lu(k,1469) * lu(k,1773) + lu(k,1779) = lu(k,1779) - lu(k,1470) * lu(k,1773) + lu(k,1781) = lu(k,1781) - lu(k,1471) * lu(k,1773) + lu(k,1782) = lu(k,1782) - lu(k,1472) * lu(k,1773) + lu(k,1783) = lu(k,1783) - lu(k,1473) * lu(k,1773) + lu(k,1784) = lu(k,1784) - lu(k,1474) * lu(k,1773) + lu(k,1786) = lu(k,1786) - lu(k,1475) * lu(k,1773) + lu(k,1787) = lu(k,1787) - lu(k,1476) * lu(k,1773) + lu(k,1788) = lu(k,1788) - lu(k,1477) * lu(k,1773) + lu(k,1826) = lu(k,1826) - lu(k,1466) * lu(k,1825) + lu(k,1827) = lu(k,1827) - lu(k,1467) * lu(k,1825) + lu(k,1828) = lu(k,1828) - lu(k,1468) * lu(k,1825) + lu(k,1830) = lu(k,1830) - lu(k,1469) * lu(k,1825) + lu(k,1831) = lu(k,1831) - lu(k,1470) * lu(k,1825) + lu(k,1833) = lu(k,1833) - lu(k,1471) * lu(k,1825) + lu(k,1834) = lu(k,1834) - lu(k,1472) * lu(k,1825) + lu(k,1835) = lu(k,1835) - lu(k,1473) * lu(k,1825) + lu(k,1836) = lu(k,1836) - lu(k,1474) * lu(k,1825) + lu(k,1838) = lu(k,1838) - lu(k,1475) * lu(k,1825) + lu(k,1839) = lu(k,1839) - lu(k,1476) * lu(k,1825) + lu(k,1840) = lu(k,1840) - lu(k,1477) * lu(k,1825) + lu(k,1918) = lu(k,1918) - lu(k,1466) * lu(k,1917) + lu(k,1919) = lu(k,1919) - lu(k,1467) * lu(k,1917) + lu(k,1920) = lu(k,1920) - lu(k,1468) * lu(k,1917) + lu(k,1922) = lu(k,1922) - lu(k,1469) * lu(k,1917) + lu(k,1923) = lu(k,1923) - lu(k,1470) * lu(k,1917) + lu(k,1925) = lu(k,1925) - lu(k,1471) * lu(k,1917) + lu(k,1926) = lu(k,1926) - lu(k,1472) * lu(k,1917) + lu(k,1927) = lu(k,1927) - lu(k,1473) * lu(k,1917) + lu(k,1928) = lu(k,1928) - lu(k,1474) * lu(k,1917) + lu(k,1930) = lu(k,1930) - lu(k,1475) * lu(k,1917) + lu(k,1931) = lu(k,1931) - lu(k,1476) * lu(k,1917) + lu(k,1932) = lu(k,1932) - lu(k,1477) * lu(k,1917) + lu(k,1962) = lu(k,1962) - lu(k,1466) * lu(k,1961) + lu(k,1963) = lu(k,1963) - lu(k,1467) * lu(k,1961) + lu(k,1964) = lu(k,1964) - lu(k,1468) * lu(k,1961) + lu(k,1966) = lu(k,1966) - lu(k,1469) * lu(k,1961) + lu(k,1967) = lu(k,1967) - lu(k,1470) * lu(k,1961) + lu(k,1969) = lu(k,1969) - lu(k,1471) * lu(k,1961) + lu(k,1970) = lu(k,1970) - lu(k,1472) * lu(k,1961) + lu(k,1971) = lu(k,1971) - lu(k,1473) * lu(k,1961) + lu(k,1972) = lu(k,1972) - lu(k,1474) * lu(k,1961) + lu(k,1974) = lu(k,1974) - lu(k,1475) * lu(k,1961) + lu(k,1975) = lu(k,1975) - lu(k,1476) * lu(k,1961) + lu(k,1976) = lu(k,1976) - lu(k,1477) * lu(k,1961) + lu(k,2001) = lu(k,2001) - lu(k,1466) * lu(k,2000) + lu(k,2002) = lu(k,2002) - lu(k,1467) * lu(k,2000) + lu(k,2003) = lu(k,2003) - lu(k,1468) * lu(k,2000) + lu(k,2005) = lu(k,2005) - lu(k,1469) * lu(k,2000) + lu(k,2006) = lu(k,2006) - lu(k,1470) * lu(k,2000) + lu(k,2008) = lu(k,2008) - lu(k,1471) * lu(k,2000) + lu(k,2009) = lu(k,2009) - lu(k,1472) * lu(k,2000) + lu(k,2010) = lu(k,2010) - lu(k,1473) * lu(k,2000) + lu(k,2011) = lu(k,2011) - lu(k,1474) * lu(k,2000) + lu(k,2013) = lu(k,2013) - lu(k,1475) * lu(k,2000) + lu(k,2014) = lu(k,2014) - lu(k,1476) * lu(k,2000) + lu(k,2015) = lu(k,2015) - lu(k,1477) * lu(k,2000) + lu(k,2108) = lu(k,2108) - lu(k,1466) * lu(k,2107) + lu(k,2109) = lu(k,2109) - lu(k,1467) * lu(k,2107) + lu(k,2110) = lu(k,2110) - lu(k,1468) * lu(k,2107) + lu(k,2112) = lu(k,2112) - lu(k,1469) * lu(k,2107) + lu(k,2113) = lu(k,2113) - lu(k,1470) * lu(k,2107) + lu(k,2115) = lu(k,2115) - lu(k,1471) * lu(k,2107) + lu(k,2116) = lu(k,2116) - lu(k,1472) * lu(k,2107) + lu(k,2117) = lu(k,2117) - lu(k,1473) * lu(k,2107) + lu(k,2118) = lu(k,2118) - lu(k,1474) * lu(k,2107) + lu(k,2120) = lu(k,2120) - lu(k,1475) * lu(k,2107) + lu(k,2121) = lu(k,2121) - lu(k,1476) * lu(k,2107) + lu(k,2122) = lu(k,2122) - lu(k,1477) * lu(k,2107) + lu(k,2131) = lu(k,2131) - lu(k,1466) * lu(k,2130) + lu(k,2132) = lu(k,2132) - lu(k,1467) * lu(k,2130) + lu(k,2133) = lu(k,2133) - lu(k,1468) * lu(k,2130) + lu(k,2135) = lu(k,2135) - lu(k,1469) * lu(k,2130) + lu(k,2136) = lu(k,2136) - lu(k,1470) * lu(k,2130) + lu(k,2138) = lu(k,2138) - lu(k,1471) * lu(k,2130) + lu(k,2139) = lu(k,2139) - lu(k,1472) * lu(k,2130) + lu(k,2140) = lu(k,2140) - lu(k,1473) * lu(k,2130) + lu(k,2141) = lu(k,2141) - lu(k,1474) * lu(k,2130) + lu(k,2143) = lu(k,2143) - lu(k,1475) * lu(k,2130) + lu(k,2144) = lu(k,2144) - lu(k,1476) * lu(k,2130) + lu(k,2145) = lu(k,2145) - lu(k,1477) * lu(k,2130) + lu(k,2155) = lu(k,2155) - lu(k,1466) * lu(k,2154) + lu(k,2156) = lu(k,2156) - lu(k,1467) * lu(k,2154) + lu(k,2157) = lu(k,2157) - lu(k,1468) * lu(k,2154) + lu(k,2159) = lu(k,2159) - lu(k,1469) * lu(k,2154) + lu(k,2160) = lu(k,2160) - lu(k,1470) * lu(k,2154) + lu(k,2162) = lu(k,2162) - lu(k,1471) * lu(k,2154) + lu(k,2163) = lu(k,2163) - lu(k,1472) * lu(k,2154) + lu(k,2164) = lu(k,2164) - lu(k,1473) * lu(k,2154) + lu(k,2165) = lu(k,2165) - lu(k,1474) * lu(k,2154) + lu(k,2167) = lu(k,2167) - lu(k,1475) * lu(k,2154) + lu(k,2168) = lu(k,2168) - lu(k,1476) * lu(k,2154) + lu(k,2169) = lu(k,2169) - lu(k,1477) * lu(k,2154) + lu(k,2186) = lu(k,2186) - lu(k,1466) * lu(k,2185) + lu(k,2187) = lu(k,2187) - lu(k,1467) * lu(k,2185) + lu(k,2188) = lu(k,2188) - lu(k,1468) * lu(k,2185) + lu(k,2190) = lu(k,2190) - lu(k,1469) * lu(k,2185) + lu(k,2191) = lu(k,2191) - lu(k,1470) * lu(k,2185) + lu(k,2193) = lu(k,2193) - lu(k,1471) * lu(k,2185) + lu(k,2194) = lu(k,2194) - lu(k,1472) * lu(k,2185) + lu(k,2195) = lu(k,2195) - lu(k,1473) * lu(k,2185) + lu(k,2196) = lu(k,2196) - lu(k,1474) * lu(k,2185) + lu(k,2198) = lu(k,2198) - lu(k,1475) * lu(k,2185) + lu(k,2199) = lu(k,2199) - lu(k,1476) * lu(k,2185) + lu(k,2200) = lu(k,2200) - lu(k,1477) * lu(k,2185) + lu(k,2247) = lu(k,2247) - lu(k,1466) * lu(k,2246) + lu(k,2248) = lu(k,2248) - lu(k,1467) * lu(k,2246) + lu(k,2249) = lu(k,2249) - lu(k,1468) * lu(k,2246) + lu(k,2251) = lu(k,2251) - lu(k,1469) * lu(k,2246) + lu(k,2252) = lu(k,2252) - lu(k,1470) * lu(k,2246) + lu(k,2254) = lu(k,2254) - lu(k,1471) * lu(k,2246) + lu(k,2255) = lu(k,2255) - lu(k,1472) * lu(k,2246) + lu(k,2256) = lu(k,2256) - lu(k,1473) * lu(k,2246) + lu(k,2257) = lu(k,2257) - lu(k,1474) * lu(k,2246) + lu(k,2259) = lu(k,2259) - lu(k,1475) * lu(k,2246) + lu(k,2260) = lu(k,2260) - lu(k,1476) * lu(k,2246) + lu(k,2261) = lu(k,2261) - lu(k,1477) * lu(k,2246) + lu(k,2273) = lu(k,2273) - lu(k,1466) * lu(k,2272) + lu(k,2274) = lu(k,2274) - lu(k,1467) * lu(k,2272) + lu(k,2275) = lu(k,2275) - lu(k,1468) * lu(k,2272) + lu(k,2277) = lu(k,2277) - lu(k,1469) * lu(k,2272) + lu(k,2278) = lu(k,2278) - lu(k,1470) * lu(k,2272) + lu(k,2280) = lu(k,2280) - lu(k,1471) * lu(k,2272) + lu(k,2281) = lu(k,2281) - lu(k,1472) * lu(k,2272) + lu(k,2282) = lu(k,2282) - lu(k,1473) * lu(k,2272) + lu(k,2283) = lu(k,2283) - lu(k,1474) * lu(k,2272) + lu(k,2285) = lu(k,2285) - lu(k,1475) * lu(k,2272) + lu(k,2286) = lu(k,2286) - lu(k,1476) * lu(k,2272) + lu(k,2287) = lu(k,2287) - lu(k,1477) * lu(k,2272) + end do + end subroutine lu_fac28 + subroutine lu_fac29( 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,1487) = 1._r8 / lu(k,1487) + lu(k,1488) = lu(k,1488) * lu(k,1487) + lu(k,1489) = lu(k,1489) * lu(k,1487) + lu(k,1490) = lu(k,1490) * lu(k,1487) + lu(k,1491) = lu(k,1491) * lu(k,1487) + lu(k,1492) = lu(k,1492) * lu(k,1487) + lu(k,1493) = lu(k,1493) * lu(k,1487) + lu(k,1494) = lu(k,1494) * lu(k,1487) + lu(k,1495) = lu(k,1495) * lu(k,1487) + lu(k,1496) = lu(k,1496) * lu(k,1487) + lu(k,1497) = lu(k,1497) * lu(k,1487) + lu(k,1498) = lu(k,1498) * lu(k,1487) + lu(k,1499) = lu(k,1499) * lu(k,1487) + lu(k,1500) = lu(k,1500) * lu(k,1487) + lu(k,1528) = lu(k,1528) - lu(k,1488) * lu(k,1527) + lu(k,1529) = lu(k,1529) - lu(k,1489) * lu(k,1527) + lu(k,1531) = lu(k,1531) - lu(k,1490) * lu(k,1527) + lu(k,1532) = lu(k,1532) - lu(k,1491) * lu(k,1527) + lu(k,1533) = lu(k,1533) - lu(k,1492) * lu(k,1527) + lu(k,1534) = lu(k,1534) - lu(k,1493) * lu(k,1527) + lu(k,1535) = lu(k,1535) - lu(k,1494) * lu(k,1527) + lu(k,1536) = lu(k,1536) - lu(k,1495) * lu(k,1527) + lu(k,1537) = lu(k,1537) - lu(k,1496) * lu(k,1527) + lu(k,1538) = lu(k,1538) - lu(k,1497) * lu(k,1527) + lu(k,1539) = lu(k,1539) - lu(k,1498) * lu(k,1527) + lu(k,1540) = lu(k,1540) - lu(k,1499) * lu(k,1527) + lu(k,1541) = lu(k,1541) - lu(k,1500) * lu(k,1527) + lu(k,1692) = lu(k,1692) - lu(k,1488) * lu(k,1691) + lu(k,1693) = lu(k,1693) - lu(k,1489) * lu(k,1691) + lu(k,1695) = lu(k,1695) - lu(k,1490) * lu(k,1691) + lu(k,1696) = lu(k,1696) - lu(k,1491) * lu(k,1691) + lu(k,1697) = lu(k,1697) - lu(k,1492) * lu(k,1691) + lu(k,1698) = lu(k,1698) - lu(k,1493) * lu(k,1691) + lu(k,1699) = lu(k,1699) - lu(k,1494) * lu(k,1691) + lu(k,1700) = lu(k,1700) - lu(k,1495) * lu(k,1691) + lu(k,1701) = lu(k,1701) - lu(k,1496) * lu(k,1691) + lu(k,1702) = lu(k,1702) - lu(k,1497) * lu(k,1691) + lu(k,1703) = lu(k,1703) - lu(k,1498) * lu(k,1691) + lu(k,1704) = lu(k,1704) - lu(k,1499) * lu(k,1691) + lu(k,1705) = lu(k,1705) - lu(k,1500) * lu(k,1691) + lu(k,1718) = lu(k,1718) - lu(k,1488) * lu(k,1717) + lu(k,1719) = lu(k,1719) - lu(k,1489) * lu(k,1717) + lu(k,1721) = lu(k,1721) - lu(k,1490) * lu(k,1717) + lu(k,1722) = lu(k,1722) - lu(k,1491) * lu(k,1717) + lu(k,1723) = lu(k,1723) - lu(k,1492) * lu(k,1717) + lu(k,1724) = lu(k,1724) - lu(k,1493) * lu(k,1717) + lu(k,1725) = lu(k,1725) - lu(k,1494) * lu(k,1717) + lu(k,1726) = lu(k,1726) - lu(k,1495) * lu(k,1717) + lu(k,1727) = lu(k,1727) - lu(k,1496) * lu(k,1717) + lu(k,1728) = lu(k,1728) - lu(k,1497) * lu(k,1717) + lu(k,1729) = lu(k,1729) - lu(k,1498) * lu(k,1717) + lu(k,1730) = lu(k,1730) - lu(k,1499) * lu(k,1717) + lu(k,1731) = lu(k,1731) - lu(k,1500) * lu(k,1717) + lu(k,1775) = lu(k,1775) - lu(k,1488) * lu(k,1774) + lu(k,1776) = lu(k,1776) - lu(k,1489) * lu(k,1774) + lu(k,1778) = lu(k,1778) - lu(k,1490) * lu(k,1774) + lu(k,1779) = lu(k,1779) - lu(k,1491) * lu(k,1774) + lu(k,1780) = lu(k,1780) - lu(k,1492) * lu(k,1774) + lu(k,1781) = lu(k,1781) - lu(k,1493) * lu(k,1774) + lu(k,1782) = lu(k,1782) - lu(k,1494) * lu(k,1774) + lu(k,1783) = lu(k,1783) - lu(k,1495) * lu(k,1774) + lu(k,1784) = lu(k,1784) - lu(k,1496) * lu(k,1774) + lu(k,1785) = lu(k,1785) - lu(k,1497) * lu(k,1774) + lu(k,1786) = lu(k,1786) - lu(k,1498) * lu(k,1774) + lu(k,1787) = lu(k,1787) - lu(k,1499) * lu(k,1774) + lu(k,1788) = lu(k,1788) - lu(k,1500) * lu(k,1774) + lu(k,1827) = lu(k,1827) - lu(k,1488) * lu(k,1826) + lu(k,1828) = lu(k,1828) - lu(k,1489) * lu(k,1826) + lu(k,1830) = lu(k,1830) - lu(k,1490) * lu(k,1826) + lu(k,1831) = lu(k,1831) - lu(k,1491) * lu(k,1826) + lu(k,1832) = lu(k,1832) - lu(k,1492) * lu(k,1826) + lu(k,1833) = lu(k,1833) - lu(k,1493) * lu(k,1826) + lu(k,1834) = lu(k,1834) - lu(k,1494) * lu(k,1826) + lu(k,1835) = lu(k,1835) - lu(k,1495) * lu(k,1826) + lu(k,1836) = lu(k,1836) - lu(k,1496) * lu(k,1826) + lu(k,1837) = - lu(k,1497) * lu(k,1826) + lu(k,1838) = lu(k,1838) - lu(k,1498) * lu(k,1826) + lu(k,1839) = lu(k,1839) - lu(k,1499) * lu(k,1826) + lu(k,1840) = lu(k,1840) - lu(k,1500) * lu(k,1826) + lu(k,1919) = lu(k,1919) - lu(k,1488) * lu(k,1918) + lu(k,1920) = lu(k,1920) - lu(k,1489) * lu(k,1918) + lu(k,1922) = lu(k,1922) - lu(k,1490) * lu(k,1918) + lu(k,1923) = lu(k,1923) - lu(k,1491) * lu(k,1918) + lu(k,1924) = lu(k,1924) - lu(k,1492) * lu(k,1918) + lu(k,1925) = lu(k,1925) - lu(k,1493) * lu(k,1918) + lu(k,1926) = lu(k,1926) - lu(k,1494) * lu(k,1918) + lu(k,1927) = lu(k,1927) - lu(k,1495) * lu(k,1918) + lu(k,1928) = lu(k,1928) - lu(k,1496) * lu(k,1918) + lu(k,1929) = lu(k,1929) - lu(k,1497) * lu(k,1918) + lu(k,1930) = lu(k,1930) - lu(k,1498) * lu(k,1918) + lu(k,1931) = lu(k,1931) - lu(k,1499) * lu(k,1918) + lu(k,1932) = lu(k,1932) - lu(k,1500) * lu(k,1918) + lu(k,1963) = lu(k,1963) - lu(k,1488) * lu(k,1962) + lu(k,1964) = lu(k,1964) - lu(k,1489) * lu(k,1962) + lu(k,1966) = lu(k,1966) - lu(k,1490) * lu(k,1962) + lu(k,1967) = lu(k,1967) - lu(k,1491) * lu(k,1962) + lu(k,1968) = lu(k,1968) - lu(k,1492) * lu(k,1962) + lu(k,1969) = lu(k,1969) - lu(k,1493) * lu(k,1962) + lu(k,1970) = lu(k,1970) - lu(k,1494) * lu(k,1962) + lu(k,1971) = lu(k,1971) - lu(k,1495) * lu(k,1962) + lu(k,1972) = lu(k,1972) - lu(k,1496) * lu(k,1962) + lu(k,1973) = lu(k,1973) - lu(k,1497) * lu(k,1962) + lu(k,1974) = lu(k,1974) - lu(k,1498) * lu(k,1962) + lu(k,1975) = lu(k,1975) - lu(k,1499) * lu(k,1962) + lu(k,1976) = lu(k,1976) - lu(k,1500) * lu(k,1962) + lu(k,2002) = lu(k,2002) - lu(k,1488) * lu(k,2001) + lu(k,2003) = lu(k,2003) - lu(k,1489) * lu(k,2001) + lu(k,2005) = lu(k,2005) - lu(k,1490) * lu(k,2001) + lu(k,2006) = lu(k,2006) - lu(k,1491) * lu(k,2001) + lu(k,2007) = lu(k,2007) - lu(k,1492) * lu(k,2001) + lu(k,2008) = lu(k,2008) - lu(k,1493) * lu(k,2001) + lu(k,2009) = lu(k,2009) - lu(k,1494) * lu(k,2001) + lu(k,2010) = lu(k,2010) - lu(k,1495) * lu(k,2001) + lu(k,2011) = lu(k,2011) - lu(k,1496) * lu(k,2001) + lu(k,2012) = lu(k,2012) - lu(k,1497) * lu(k,2001) + lu(k,2013) = lu(k,2013) - lu(k,1498) * lu(k,2001) + lu(k,2014) = lu(k,2014) - lu(k,1499) * lu(k,2001) + lu(k,2015) = lu(k,2015) - lu(k,1500) * lu(k,2001) + lu(k,2109) = lu(k,2109) - lu(k,1488) * lu(k,2108) + lu(k,2110) = lu(k,2110) - lu(k,1489) * lu(k,2108) + lu(k,2112) = lu(k,2112) - lu(k,1490) * lu(k,2108) + lu(k,2113) = lu(k,2113) - lu(k,1491) * lu(k,2108) + lu(k,2114) = lu(k,2114) - lu(k,1492) * lu(k,2108) + lu(k,2115) = lu(k,2115) - lu(k,1493) * lu(k,2108) + lu(k,2116) = lu(k,2116) - lu(k,1494) * lu(k,2108) + lu(k,2117) = lu(k,2117) - lu(k,1495) * lu(k,2108) + lu(k,2118) = lu(k,2118) - lu(k,1496) * lu(k,2108) + lu(k,2119) = lu(k,2119) - lu(k,1497) * lu(k,2108) + lu(k,2120) = lu(k,2120) - lu(k,1498) * lu(k,2108) + lu(k,2121) = lu(k,2121) - lu(k,1499) * lu(k,2108) + lu(k,2122) = lu(k,2122) - lu(k,1500) * lu(k,2108) + lu(k,2132) = lu(k,2132) - lu(k,1488) * lu(k,2131) + lu(k,2133) = lu(k,2133) - lu(k,1489) * lu(k,2131) + lu(k,2135) = lu(k,2135) - lu(k,1490) * lu(k,2131) + lu(k,2136) = lu(k,2136) - lu(k,1491) * lu(k,2131) + lu(k,2137) = - lu(k,1492) * lu(k,2131) + lu(k,2138) = lu(k,2138) - lu(k,1493) * lu(k,2131) + lu(k,2139) = lu(k,2139) - lu(k,1494) * lu(k,2131) + lu(k,2140) = lu(k,2140) - lu(k,1495) * lu(k,2131) + lu(k,2141) = lu(k,2141) - lu(k,1496) * lu(k,2131) + lu(k,2142) = lu(k,2142) - lu(k,1497) * lu(k,2131) + lu(k,2143) = lu(k,2143) - lu(k,1498) * lu(k,2131) + lu(k,2144) = lu(k,2144) - lu(k,1499) * lu(k,2131) + lu(k,2145) = lu(k,2145) - lu(k,1500) * lu(k,2131) + lu(k,2156) = lu(k,2156) - lu(k,1488) * lu(k,2155) + lu(k,2157) = lu(k,2157) - lu(k,1489) * lu(k,2155) + lu(k,2159) = lu(k,2159) - lu(k,1490) * lu(k,2155) + lu(k,2160) = lu(k,2160) - lu(k,1491) * lu(k,2155) + lu(k,2161) = lu(k,2161) - lu(k,1492) * lu(k,2155) + lu(k,2162) = lu(k,2162) - lu(k,1493) * lu(k,2155) + lu(k,2163) = lu(k,2163) - lu(k,1494) * lu(k,2155) + lu(k,2164) = lu(k,2164) - lu(k,1495) * lu(k,2155) + lu(k,2165) = lu(k,2165) - lu(k,1496) * lu(k,2155) + lu(k,2166) = lu(k,2166) - lu(k,1497) * lu(k,2155) + lu(k,2167) = lu(k,2167) - lu(k,1498) * lu(k,2155) + lu(k,2168) = lu(k,2168) - lu(k,1499) * lu(k,2155) + lu(k,2169) = lu(k,2169) - lu(k,1500) * lu(k,2155) + lu(k,2187) = lu(k,2187) - lu(k,1488) * lu(k,2186) + lu(k,2188) = lu(k,2188) - lu(k,1489) * lu(k,2186) + lu(k,2190) = lu(k,2190) - lu(k,1490) * lu(k,2186) + lu(k,2191) = lu(k,2191) - lu(k,1491) * lu(k,2186) + lu(k,2192) = lu(k,2192) - lu(k,1492) * lu(k,2186) + lu(k,2193) = lu(k,2193) - lu(k,1493) * lu(k,2186) + lu(k,2194) = lu(k,2194) - lu(k,1494) * lu(k,2186) + lu(k,2195) = lu(k,2195) - lu(k,1495) * lu(k,2186) + lu(k,2196) = lu(k,2196) - lu(k,1496) * lu(k,2186) + lu(k,2197) = lu(k,2197) - lu(k,1497) * lu(k,2186) + lu(k,2198) = lu(k,2198) - lu(k,1498) * lu(k,2186) + lu(k,2199) = lu(k,2199) - lu(k,1499) * lu(k,2186) + lu(k,2200) = lu(k,2200) - lu(k,1500) * lu(k,2186) + lu(k,2248) = lu(k,2248) - lu(k,1488) * lu(k,2247) + lu(k,2249) = lu(k,2249) - lu(k,1489) * lu(k,2247) + lu(k,2251) = lu(k,2251) - lu(k,1490) * lu(k,2247) + lu(k,2252) = lu(k,2252) - lu(k,1491) * lu(k,2247) + lu(k,2253) = lu(k,2253) - lu(k,1492) * lu(k,2247) + lu(k,2254) = lu(k,2254) - lu(k,1493) * lu(k,2247) + lu(k,2255) = lu(k,2255) - lu(k,1494) * lu(k,2247) + lu(k,2256) = lu(k,2256) - lu(k,1495) * lu(k,2247) + lu(k,2257) = lu(k,2257) - lu(k,1496) * lu(k,2247) + lu(k,2258) = lu(k,2258) - lu(k,1497) * lu(k,2247) + lu(k,2259) = lu(k,2259) - lu(k,1498) * lu(k,2247) + lu(k,2260) = lu(k,2260) - lu(k,1499) * lu(k,2247) + lu(k,2261) = lu(k,2261) - lu(k,1500) * lu(k,2247) + lu(k,2274) = lu(k,2274) - lu(k,1488) * lu(k,2273) + lu(k,2275) = lu(k,2275) - lu(k,1489) * lu(k,2273) + lu(k,2277) = lu(k,2277) - lu(k,1490) * lu(k,2273) + lu(k,2278) = lu(k,2278) - lu(k,1491) * lu(k,2273) + lu(k,2279) = lu(k,2279) - lu(k,1492) * lu(k,2273) + lu(k,2280) = lu(k,2280) - lu(k,1493) * lu(k,2273) + lu(k,2281) = lu(k,2281) - lu(k,1494) * lu(k,2273) + lu(k,2282) = lu(k,2282) - lu(k,1495) * lu(k,2273) + lu(k,2283) = lu(k,2283) - lu(k,1496) * lu(k,2273) + lu(k,2284) = lu(k,2284) - lu(k,1497) * lu(k,2273) + lu(k,2285) = lu(k,2285) - lu(k,1498) * lu(k,2273) + lu(k,2286) = lu(k,2286) - lu(k,1499) * lu(k,2273) + lu(k,2287) = lu(k,2287) - lu(k,1500) * lu(k,2273) + lu(k,1528) = 1._r8 / lu(k,1528) + lu(k,1529) = lu(k,1529) * lu(k,1528) + lu(k,1530) = lu(k,1530) * lu(k,1528) + lu(k,1531) = lu(k,1531) * lu(k,1528) + lu(k,1532) = lu(k,1532) * lu(k,1528) + lu(k,1533) = lu(k,1533) * lu(k,1528) + lu(k,1534) = lu(k,1534) * lu(k,1528) + lu(k,1535) = lu(k,1535) * lu(k,1528) + lu(k,1536) = lu(k,1536) * lu(k,1528) + lu(k,1537) = lu(k,1537) * lu(k,1528) + lu(k,1538) = lu(k,1538) * lu(k,1528) + lu(k,1539) = lu(k,1539) * lu(k,1528) + lu(k,1540) = lu(k,1540) * lu(k,1528) + lu(k,1541) = lu(k,1541) * lu(k,1528) + lu(k,1693) = lu(k,1693) - lu(k,1529) * lu(k,1692) + lu(k,1694) = lu(k,1694) - lu(k,1530) * lu(k,1692) + lu(k,1695) = lu(k,1695) - lu(k,1531) * lu(k,1692) + lu(k,1696) = lu(k,1696) - lu(k,1532) * lu(k,1692) + lu(k,1697) = lu(k,1697) - lu(k,1533) * lu(k,1692) + lu(k,1698) = lu(k,1698) - lu(k,1534) * lu(k,1692) + lu(k,1699) = lu(k,1699) - lu(k,1535) * lu(k,1692) + lu(k,1700) = lu(k,1700) - lu(k,1536) * lu(k,1692) + lu(k,1701) = lu(k,1701) - lu(k,1537) * lu(k,1692) + lu(k,1702) = lu(k,1702) - lu(k,1538) * lu(k,1692) + lu(k,1703) = lu(k,1703) - lu(k,1539) * lu(k,1692) + lu(k,1704) = lu(k,1704) - lu(k,1540) * lu(k,1692) + lu(k,1705) = lu(k,1705) - lu(k,1541) * lu(k,1692) + lu(k,1719) = lu(k,1719) - lu(k,1529) * lu(k,1718) + lu(k,1720) = lu(k,1720) - lu(k,1530) * lu(k,1718) + lu(k,1721) = lu(k,1721) - lu(k,1531) * lu(k,1718) + lu(k,1722) = lu(k,1722) - lu(k,1532) * lu(k,1718) + lu(k,1723) = lu(k,1723) - lu(k,1533) * lu(k,1718) + lu(k,1724) = lu(k,1724) - lu(k,1534) * lu(k,1718) + lu(k,1725) = lu(k,1725) - lu(k,1535) * lu(k,1718) + lu(k,1726) = lu(k,1726) - lu(k,1536) * lu(k,1718) + lu(k,1727) = lu(k,1727) - lu(k,1537) * lu(k,1718) + lu(k,1728) = lu(k,1728) - lu(k,1538) * lu(k,1718) + lu(k,1729) = lu(k,1729) - lu(k,1539) * lu(k,1718) + lu(k,1730) = lu(k,1730) - lu(k,1540) * lu(k,1718) + lu(k,1731) = lu(k,1731) - lu(k,1541) * lu(k,1718) + lu(k,1776) = lu(k,1776) - lu(k,1529) * lu(k,1775) + lu(k,1777) = lu(k,1777) - lu(k,1530) * lu(k,1775) + lu(k,1778) = lu(k,1778) - lu(k,1531) * lu(k,1775) + lu(k,1779) = lu(k,1779) - lu(k,1532) * lu(k,1775) + lu(k,1780) = lu(k,1780) - lu(k,1533) * lu(k,1775) + lu(k,1781) = lu(k,1781) - lu(k,1534) * lu(k,1775) + lu(k,1782) = lu(k,1782) - lu(k,1535) * lu(k,1775) + lu(k,1783) = lu(k,1783) - lu(k,1536) * lu(k,1775) + lu(k,1784) = lu(k,1784) - lu(k,1537) * lu(k,1775) + lu(k,1785) = lu(k,1785) - lu(k,1538) * lu(k,1775) + lu(k,1786) = lu(k,1786) - lu(k,1539) * lu(k,1775) + lu(k,1787) = lu(k,1787) - lu(k,1540) * lu(k,1775) + lu(k,1788) = lu(k,1788) - lu(k,1541) * lu(k,1775) + lu(k,1828) = lu(k,1828) - lu(k,1529) * lu(k,1827) + lu(k,1829) = lu(k,1829) - lu(k,1530) * lu(k,1827) + lu(k,1830) = lu(k,1830) - lu(k,1531) * lu(k,1827) + lu(k,1831) = lu(k,1831) - lu(k,1532) * lu(k,1827) + lu(k,1832) = lu(k,1832) - lu(k,1533) * lu(k,1827) + lu(k,1833) = lu(k,1833) - lu(k,1534) * lu(k,1827) + lu(k,1834) = lu(k,1834) - lu(k,1535) * lu(k,1827) + lu(k,1835) = lu(k,1835) - lu(k,1536) * lu(k,1827) + lu(k,1836) = lu(k,1836) - lu(k,1537) * lu(k,1827) + lu(k,1837) = lu(k,1837) - lu(k,1538) * lu(k,1827) + lu(k,1838) = lu(k,1838) - lu(k,1539) * lu(k,1827) + lu(k,1839) = lu(k,1839) - lu(k,1540) * lu(k,1827) + lu(k,1840) = lu(k,1840) - lu(k,1541) * lu(k,1827) + lu(k,1920) = lu(k,1920) - lu(k,1529) * lu(k,1919) + lu(k,1921) = lu(k,1921) - lu(k,1530) * lu(k,1919) + lu(k,1922) = lu(k,1922) - lu(k,1531) * lu(k,1919) + lu(k,1923) = lu(k,1923) - lu(k,1532) * lu(k,1919) + lu(k,1924) = lu(k,1924) - lu(k,1533) * lu(k,1919) + lu(k,1925) = lu(k,1925) - lu(k,1534) * lu(k,1919) + lu(k,1926) = lu(k,1926) - lu(k,1535) * lu(k,1919) + lu(k,1927) = lu(k,1927) - lu(k,1536) * lu(k,1919) + lu(k,1928) = lu(k,1928) - lu(k,1537) * lu(k,1919) + lu(k,1929) = lu(k,1929) - lu(k,1538) * lu(k,1919) + lu(k,1930) = lu(k,1930) - lu(k,1539) * lu(k,1919) + lu(k,1931) = lu(k,1931) - lu(k,1540) * lu(k,1919) + lu(k,1932) = lu(k,1932) - lu(k,1541) * lu(k,1919) + lu(k,1964) = lu(k,1964) - lu(k,1529) * lu(k,1963) + lu(k,1965) = lu(k,1965) - lu(k,1530) * lu(k,1963) + lu(k,1966) = lu(k,1966) - lu(k,1531) * lu(k,1963) + lu(k,1967) = lu(k,1967) - lu(k,1532) * lu(k,1963) + lu(k,1968) = lu(k,1968) - lu(k,1533) * lu(k,1963) + lu(k,1969) = lu(k,1969) - lu(k,1534) * lu(k,1963) + lu(k,1970) = lu(k,1970) - lu(k,1535) * lu(k,1963) + lu(k,1971) = lu(k,1971) - lu(k,1536) * lu(k,1963) + lu(k,1972) = lu(k,1972) - lu(k,1537) * lu(k,1963) + lu(k,1973) = lu(k,1973) - lu(k,1538) * lu(k,1963) + lu(k,1974) = lu(k,1974) - lu(k,1539) * lu(k,1963) + lu(k,1975) = lu(k,1975) - lu(k,1540) * lu(k,1963) + lu(k,1976) = lu(k,1976) - lu(k,1541) * lu(k,1963) + lu(k,2003) = lu(k,2003) - lu(k,1529) * lu(k,2002) + lu(k,2004) = lu(k,2004) - lu(k,1530) * lu(k,2002) + lu(k,2005) = lu(k,2005) - lu(k,1531) * lu(k,2002) + lu(k,2006) = lu(k,2006) - lu(k,1532) * lu(k,2002) + lu(k,2007) = lu(k,2007) - lu(k,1533) * lu(k,2002) + lu(k,2008) = lu(k,2008) - lu(k,1534) * lu(k,2002) + lu(k,2009) = lu(k,2009) - lu(k,1535) * lu(k,2002) + lu(k,2010) = lu(k,2010) - lu(k,1536) * lu(k,2002) + lu(k,2011) = lu(k,2011) - lu(k,1537) * lu(k,2002) + lu(k,2012) = lu(k,2012) - lu(k,1538) * lu(k,2002) + lu(k,2013) = lu(k,2013) - lu(k,1539) * lu(k,2002) + lu(k,2014) = lu(k,2014) - lu(k,1540) * lu(k,2002) + lu(k,2015) = lu(k,2015) - lu(k,1541) * lu(k,2002) + lu(k,2110) = lu(k,2110) - lu(k,1529) * lu(k,2109) + lu(k,2111) = lu(k,2111) - lu(k,1530) * lu(k,2109) + lu(k,2112) = lu(k,2112) - lu(k,1531) * lu(k,2109) + lu(k,2113) = lu(k,2113) - lu(k,1532) * lu(k,2109) + lu(k,2114) = lu(k,2114) - lu(k,1533) * lu(k,2109) + lu(k,2115) = lu(k,2115) - lu(k,1534) * lu(k,2109) + lu(k,2116) = lu(k,2116) - lu(k,1535) * lu(k,2109) + lu(k,2117) = lu(k,2117) - lu(k,1536) * lu(k,2109) + lu(k,2118) = lu(k,2118) - lu(k,1537) * lu(k,2109) + lu(k,2119) = lu(k,2119) - lu(k,1538) * lu(k,2109) + lu(k,2120) = lu(k,2120) - lu(k,1539) * lu(k,2109) + lu(k,2121) = lu(k,2121) - lu(k,1540) * lu(k,2109) + lu(k,2122) = lu(k,2122) - lu(k,1541) * lu(k,2109) + lu(k,2133) = lu(k,2133) - lu(k,1529) * lu(k,2132) + lu(k,2134) = lu(k,2134) - lu(k,1530) * lu(k,2132) + lu(k,2135) = lu(k,2135) - lu(k,1531) * lu(k,2132) + lu(k,2136) = lu(k,2136) - lu(k,1532) * lu(k,2132) + lu(k,2137) = lu(k,2137) - lu(k,1533) * lu(k,2132) + lu(k,2138) = lu(k,2138) - lu(k,1534) * lu(k,2132) + lu(k,2139) = lu(k,2139) - lu(k,1535) * lu(k,2132) + lu(k,2140) = lu(k,2140) - lu(k,1536) * lu(k,2132) + lu(k,2141) = lu(k,2141) - lu(k,1537) * lu(k,2132) + lu(k,2142) = lu(k,2142) - lu(k,1538) * lu(k,2132) + lu(k,2143) = lu(k,2143) - lu(k,1539) * lu(k,2132) + lu(k,2144) = lu(k,2144) - lu(k,1540) * lu(k,2132) + lu(k,2145) = lu(k,2145) - lu(k,1541) * lu(k,2132) + lu(k,2157) = lu(k,2157) - lu(k,1529) * lu(k,2156) + lu(k,2158) = lu(k,2158) - lu(k,1530) * lu(k,2156) + lu(k,2159) = lu(k,2159) - lu(k,1531) * lu(k,2156) + lu(k,2160) = lu(k,2160) - lu(k,1532) * lu(k,2156) + lu(k,2161) = lu(k,2161) - lu(k,1533) * lu(k,2156) + lu(k,2162) = lu(k,2162) - lu(k,1534) * lu(k,2156) + lu(k,2163) = lu(k,2163) - lu(k,1535) * lu(k,2156) + lu(k,2164) = lu(k,2164) - lu(k,1536) * lu(k,2156) + lu(k,2165) = lu(k,2165) - lu(k,1537) * lu(k,2156) + lu(k,2166) = lu(k,2166) - lu(k,1538) * lu(k,2156) + lu(k,2167) = lu(k,2167) - lu(k,1539) * lu(k,2156) + lu(k,2168) = lu(k,2168) - lu(k,1540) * lu(k,2156) + lu(k,2169) = lu(k,2169) - lu(k,1541) * lu(k,2156) + lu(k,2188) = lu(k,2188) - lu(k,1529) * lu(k,2187) + lu(k,2189) = lu(k,2189) - lu(k,1530) * lu(k,2187) + lu(k,2190) = lu(k,2190) - lu(k,1531) * lu(k,2187) + lu(k,2191) = lu(k,2191) - lu(k,1532) * lu(k,2187) + lu(k,2192) = lu(k,2192) - lu(k,1533) * lu(k,2187) + lu(k,2193) = lu(k,2193) - lu(k,1534) * lu(k,2187) + lu(k,2194) = lu(k,2194) - lu(k,1535) * lu(k,2187) + lu(k,2195) = lu(k,2195) - lu(k,1536) * lu(k,2187) + lu(k,2196) = lu(k,2196) - lu(k,1537) * lu(k,2187) + lu(k,2197) = lu(k,2197) - lu(k,1538) * lu(k,2187) + lu(k,2198) = lu(k,2198) - lu(k,1539) * lu(k,2187) + lu(k,2199) = lu(k,2199) - lu(k,1540) * lu(k,2187) + lu(k,2200) = lu(k,2200) - lu(k,1541) * lu(k,2187) + lu(k,2249) = lu(k,2249) - lu(k,1529) * lu(k,2248) + lu(k,2250) = lu(k,2250) - lu(k,1530) * lu(k,2248) + lu(k,2251) = lu(k,2251) - lu(k,1531) * lu(k,2248) + lu(k,2252) = lu(k,2252) - lu(k,1532) * lu(k,2248) + lu(k,2253) = lu(k,2253) - lu(k,1533) * lu(k,2248) + lu(k,2254) = lu(k,2254) - lu(k,1534) * lu(k,2248) + lu(k,2255) = lu(k,2255) - lu(k,1535) * lu(k,2248) + lu(k,2256) = lu(k,2256) - lu(k,1536) * lu(k,2248) + lu(k,2257) = lu(k,2257) - lu(k,1537) * lu(k,2248) + lu(k,2258) = lu(k,2258) - lu(k,1538) * lu(k,2248) + lu(k,2259) = lu(k,2259) - lu(k,1539) * lu(k,2248) + lu(k,2260) = lu(k,2260) - lu(k,1540) * lu(k,2248) + lu(k,2261) = lu(k,2261) - lu(k,1541) * lu(k,2248) + lu(k,2275) = lu(k,2275) - lu(k,1529) * lu(k,2274) + lu(k,2276) = lu(k,2276) - lu(k,1530) * lu(k,2274) + lu(k,2277) = lu(k,2277) - lu(k,1531) * lu(k,2274) + lu(k,2278) = lu(k,2278) - lu(k,1532) * lu(k,2274) + lu(k,2279) = lu(k,2279) - lu(k,1533) * lu(k,2274) + lu(k,2280) = lu(k,2280) - lu(k,1534) * lu(k,2274) + lu(k,2281) = lu(k,2281) - lu(k,1535) * lu(k,2274) + lu(k,2282) = lu(k,2282) - lu(k,1536) * lu(k,2274) + lu(k,2283) = lu(k,2283) - lu(k,1537) * lu(k,2274) + lu(k,2284) = lu(k,2284) - lu(k,1538) * lu(k,2274) + lu(k,2285) = lu(k,2285) - lu(k,1539) * lu(k,2274) + lu(k,2286) = lu(k,2286) - lu(k,1540) * lu(k,2274) + lu(k,2287) = lu(k,2287) - lu(k,1541) * lu(k,2274) + lu(k,1693) = 1._r8 / lu(k,1693) + lu(k,1694) = lu(k,1694) * lu(k,1693) + lu(k,1695) = lu(k,1695) * lu(k,1693) + lu(k,1696) = lu(k,1696) * lu(k,1693) + lu(k,1697) = lu(k,1697) * lu(k,1693) + lu(k,1698) = lu(k,1698) * lu(k,1693) + lu(k,1699) = lu(k,1699) * lu(k,1693) + lu(k,1700) = lu(k,1700) * lu(k,1693) + lu(k,1701) = lu(k,1701) * lu(k,1693) + lu(k,1702) = lu(k,1702) * lu(k,1693) + lu(k,1703) = lu(k,1703) * lu(k,1693) + lu(k,1704) = lu(k,1704) * lu(k,1693) + lu(k,1705) = lu(k,1705) * lu(k,1693) + lu(k,1720) = lu(k,1720) - lu(k,1694) * lu(k,1719) + lu(k,1721) = lu(k,1721) - lu(k,1695) * lu(k,1719) + lu(k,1722) = lu(k,1722) - lu(k,1696) * lu(k,1719) + lu(k,1723) = lu(k,1723) - lu(k,1697) * lu(k,1719) + lu(k,1724) = lu(k,1724) - lu(k,1698) * lu(k,1719) + lu(k,1725) = lu(k,1725) - lu(k,1699) * lu(k,1719) + lu(k,1726) = lu(k,1726) - lu(k,1700) * lu(k,1719) + lu(k,1727) = lu(k,1727) - lu(k,1701) * lu(k,1719) + lu(k,1728) = lu(k,1728) - lu(k,1702) * lu(k,1719) + lu(k,1729) = lu(k,1729) - lu(k,1703) * lu(k,1719) + lu(k,1730) = lu(k,1730) - lu(k,1704) * lu(k,1719) + lu(k,1731) = lu(k,1731) - lu(k,1705) * lu(k,1719) + lu(k,1777) = lu(k,1777) - lu(k,1694) * lu(k,1776) + lu(k,1778) = lu(k,1778) - lu(k,1695) * lu(k,1776) + lu(k,1779) = lu(k,1779) - lu(k,1696) * lu(k,1776) + lu(k,1780) = lu(k,1780) - lu(k,1697) * lu(k,1776) + lu(k,1781) = lu(k,1781) - lu(k,1698) * lu(k,1776) + lu(k,1782) = lu(k,1782) - lu(k,1699) * lu(k,1776) + lu(k,1783) = lu(k,1783) - lu(k,1700) * lu(k,1776) + lu(k,1784) = lu(k,1784) - lu(k,1701) * lu(k,1776) + lu(k,1785) = lu(k,1785) - lu(k,1702) * lu(k,1776) + lu(k,1786) = lu(k,1786) - lu(k,1703) * lu(k,1776) + lu(k,1787) = lu(k,1787) - lu(k,1704) * lu(k,1776) + lu(k,1788) = lu(k,1788) - lu(k,1705) * lu(k,1776) + lu(k,1829) = lu(k,1829) - lu(k,1694) * lu(k,1828) + lu(k,1830) = lu(k,1830) - lu(k,1695) * lu(k,1828) + lu(k,1831) = lu(k,1831) - lu(k,1696) * lu(k,1828) + lu(k,1832) = lu(k,1832) - lu(k,1697) * lu(k,1828) + lu(k,1833) = lu(k,1833) - lu(k,1698) * lu(k,1828) + lu(k,1834) = lu(k,1834) - lu(k,1699) * lu(k,1828) + lu(k,1835) = lu(k,1835) - lu(k,1700) * lu(k,1828) + lu(k,1836) = lu(k,1836) - lu(k,1701) * lu(k,1828) + lu(k,1837) = lu(k,1837) - lu(k,1702) * lu(k,1828) + lu(k,1838) = lu(k,1838) - lu(k,1703) * lu(k,1828) + lu(k,1839) = lu(k,1839) - lu(k,1704) * lu(k,1828) + lu(k,1840) = lu(k,1840) - lu(k,1705) * lu(k,1828) + lu(k,1921) = lu(k,1921) - lu(k,1694) * lu(k,1920) + lu(k,1922) = lu(k,1922) - lu(k,1695) * lu(k,1920) + lu(k,1923) = lu(k,1923) - lu(k,1696) * lu(k,1920) + lu(k,1924) = lu(k,1924) - lu(k,1697) * lu(k,1920) + lu(k,1925) = lu(k,1925) - lu(k,1698) * lu(k,1920) + lu(k,1926) = lu(k,1926) - lu(k,1699) * lu(k,1920) + lu(k,1927) = lu(k,1927) - lu(k,1700) * lu(k,1920) + lu(k,1928) = lu(k,1928) - lu(k,1701) * lu(k,1920) + lu(k,1929) = lu(k,1929) - lu(k,1702) * lu(k,1920) + lu(k,1930) = lu(k,1930) - lu(k,1703) * lu(k,1920) + lu(k,1931) = lu(k,1931) - lu(k,1704) * lu(k,1920) + lu(k,1932) = lu(k,1932) - lu(k,1705) * lu(k,1920) + lu(k,1965) = lu(k,1965) - lu(k,1694) * lu(k,1964) + lu(k,1966) = lu(k,1966) - lu(k,1695) * lu(k,1964) + lu(k,1967) = lu(k,1967) - lu(k,1696) * lu(k,1964) + lu(k,1968) = lu(k,1968) - lu(k,1697) * lu(k,1964) + lu(k,1969) = lu(k,1969) - lu(k,1698) * lu(k,1964) + lu(k,1970) = lu(k,1970) - lu(k,1699) * lu(k,1964) + lu(k,1971) = lu(k,1971) - lu(k,1700) * lu(k,1964) + lu(k,1972) = lu(k,1972) - lu(k,1701) * lu(k,1964) + lu(k,1973) = lu(k,1973) - lu(k,1702) * lu(k,1964) + lu(k,1974) = lu(k,1974) - lu(k,1703) * lu(k,1964) + lu(k,1975) = lu(k,1975) - lu(k,1704) * lu(k,1964) + lu(k,1976) = lu(k,1976) - lu(k,1705) * lu(k,1964) + lu(k,2004) = lu(k,2004) - lu(k,1694) * lu(k,2003) + lu(k,2005) = lu(k,2005) - lu(k,1695) * lu(k,2003) + lu(k,2006) = lu(k,2006) - lu(k,1696) * lu(k,2003) + lu(k,2007) = lu(k,2007) - lu(k,1697) * lu(k,2003) + lu(k,2008) = lu(k,2008) - lu(k,1698) * lu(k,2003) + lu(k,2009) = lu(k,2009) - lu(k,1699) * lu(k,2003) + lu(k,2010) = lu(k,2010) - lu(k,1700) * lu(k,2003) + lu(k,2011) = lu(k,2011) - lu(k,1701) * lu(k,2003) + lu(k,2012) = lu(k,2012) - lu(k,1702) * lu(k,2003) + lu(k,2013) = lu(k,2013) - lu(k,1703) * lu(k,2003) + lu(k,2014) = lu(k,2014) - lu(k,1704) * lu(k,2003) + lu(k,2015) = lu(k,2015) - lu(k,1705) * lu(k,2003) + lu(k,2111) = lu(k,2111) - lu(k,1694) * lu(k,2110) + lu(k,2112) = lu(k,2112) - lu(k,1695) * lu(k,2110) + lu(k,2113) = lu(k,2113) - lu(k,1696) * lu(k,2110) + lu(k,2114) = lu(k,2114) - lu(k,1697) * lu(k,2110) + lu(k,2115) = lu(k,2115) - lu(k,1698) * lu(k,2110) + lu(k,2116) = lu(k,2116) - lu(k,1699) * lu(k,2110) + lu(k,2117) = lu(k,2117) - lu(k,1700) * lu(k,2110) + lu(k,2118) = lu(k,2118) - lu(k,1701) * lu(k,2110) + lu(k,2119) = lu(k,2119) - lu(k,1702) * lu(k,2110) + lu(k,2120) = lu(k,2120) - lu(k,1703) * lu(k,2110) + lu(k,2121) = lu(k,2121) - lu(k,1704) * lu(k,2110) + lu(k,2122) = lu(k,2122) - lu(k,1705) * lu(k,2110) + lu(k,2134) = lu(k,2134) - lu(k,1694) * lu(k,2133) + lu(k,2135) = lu(k,2135) - lu(k,1695) * lu(k,2133) + lu(k,2136) = lu(k,2136) - lu(k,1696) * lu(k,2133) + lu(k,2137) = lu(k,2137) - lu(k,1697) * lu(k,2133) + lu(k,2138) = lu(k,2138) - lu(k,1698) * lu(k,2133) + lu(k,2139) = lu(k,2139) - lu(k,1699) * lu(k,2133) + lu(k,2140) = lu(k,2140) - lu(k,1700) * lu(k,2133) + lu(k,2141) = lu(k,2141) - lu(k,1701) * lu(k,2133) + lu(k,2142) = lu(k,2142) - lu(k,1702) * lu(k,2133) + lu(k,2143) = lu(k,2143) - lu(k,1703) * lu(k,2133) + lu(k,2144) = lu(k,2144) - lu(k,1704) * lu(k,2133) + lu(k,2145) = lu(k,2145) - lu(k,1705) * lu(k,2133) + lu(k,2158) = lu(k,2158) - lu(k,1694) * lu(k,2157) + lu(k,2159) = lu(k,2159) - lu(k,1695) * lu(k,2157) + lu(k,2160) = lu(k,2160) - lu(k,1696) * lu(k,2157) + lu(k,2161) = lu(k,2161) - lu(k,1697) * lu(k,2157) + lu(k,2162) = lu(k,2162) - lu(k,1698) * lu(k,2157) + lu(k,2163) = lu(k,2163) - lu(k,1699) * lu(k,2157) + lu(k,2164) = lu(k,2164) - lu(k,1700) * lu(k,2157) + lu(k,2165) = lu(k,2165) - lu(k,1701) * lu(k,2157) + lu(k,2166) = lu(k,2166) - lu(k,1702) * lu(k,2157) + lu(k,2167) = lu(k,2167) - lu(k,1703) * lu(k,2157) + lu(k,2168) = lu(k,2168) - lu(k,1704) * lu(k,2157) + lu(k,2169) = lu(k,2169) - lu(k,1705) * lu(k,2157) + lu(k,2189) = lu(k,2189) - lu(k,1694) * lu(k,2188) + lu(k,2190) = lu(k,2190) - lu(k,1695) * lu(k,2188) + lu(k,2191) = lu(k,2191) - lu(k,1696) * lu(k,2188) + lu(k,2192) = lu(k,2192) - lu(k,1697) * lu(k,2188) + lu(k,2193) = lu(k,2193) - lu(k,1698) * lu(k,2188) + lu(k,2194) = lu(k,2194) - lu(k,1699) * lu(k,2188) + lu(k,2195) = lu(k,2195) - lu(k,1700) * lu(k,2188) + lu(k,2196) = lu(k,2196) - lu(k,1701) * lu(k,2188) + lu(k,2197) = lu(k,2197) - lu(k,1702) * lu(k,2188) + lu(k,2198) = lu(k,2198) - lu(k,1703) * lu(k,2188) + lu(k,2199) = lu(k,2199) - lu(k,1704) * lu(k,2188) + lu(k,2200) = lu(k,2200) - lu(k,1705) * lu(k,2188) + lu(k,2250) = lu(k,2250) - lu(k,1694) * lu(k,2249) + lu(k,2251) = lu(k,2251) - lu(k,1695) * lu(k,2249) + lu(k,2252) = lu(k,2252) - lu(k,1696) * lu(k,2249) + lu(k,2253) = lu(k,2253) - lu(k,1697) * lu(k,2249) + lu(k,2254) = lu(k,2254) - lu(k,1698) * lu(k,2249) + lu(k,2255) = lu(k,2255) - lu(k,1699) * lu(k,2249) + lu(k,2256) = lu(k,2256) - lu(k,1700) * lu(k,2249) + lu(k,2257) = lu(k,2257) - lu(k,1701) * lu(k,2249) + lu(k,2258) = lu(k,2258) - lu(k,1702) * lu(k,2249) + lu(k,2259) = lu(k,2259) - lu(k,1703) * lu(k,2249) + lu(k,2260) = lu(k,2260) - lu(k,1704) * lu(k,2249) + lu(k,2261) = lu(k,2261) - lu(k,1705) * lu(k,2249) + lu(k,2276) = lu(k,2276) - lu(k,1694) * lu(k,2275) + lu(k,2277) = lu(k,2277) - lu(k,1695) * lu(k,2275) + lu(k,2278) = lu(k,2278) - lu(k,1696) * lu(k,2275) + lu(k,2279) = lu(k,2279) - lu(k,1697) * lu(k,2275) + lu(k,2280) = lu(k,2280) - lu(k,1698) * lu(k,2275) + lu(k,2281) = lu(k,2281) - lu(k,1699) * lu(k,2275) + lu(k,2282) = lu(k,2282) - lu(k,1700) * lu(k,2275) + lu(k,2283) = lu(k,2283) - lu(k,1701) * lu(k,2275) + lu(k,2284) = lu(k,2284) - lu(k,1702) * lu(k,2275) + lu(k,2285) = lu(k,2285) - lu(k,1703) * lu(k,2275) + lu(k,2286) = lu(k,2286) - lu(k,1704) * lu(k,2275) + lu(k,2287) = lu(k,2287) - lu(k,1705) * lu(k,2275) + lu(k,1720) = 1._r8 / lu(k,1720) + lu(k,1721) = lu(k,1721) * lu(k,1720) + lu(k,1722) = lu(k,1722) * lu(k,1720) + lu(k,1723) = lu(k,1723) * lu(k,1720) + lu(k,1724) = lu(k,1724) * lu(k,1720) + lu(k,1725) = lu(k,1725) * lu(k,1720) + lu(k,1726) = lu(k,1726) * lu(k,1720) + lu(k,1727) = lu(k,1727) * lu(k,1720) + lu(k,1728) = lu(k,1728) * lu(k,1720) + lu(k,1729) = lu(k,1729) * lu(k,1720) + lu(k,1730) = lu(k,1730) * lu(k,1720) + lu(k,1731) = lu(k,1731) * lu(k,1720) + lu(k,1778) = lu(k,1778) - lu(k,1721) * lu(k,1777) + lu(k,1779) = lu(k,1779) - lu(k,1722) * lu(k,1777) + lu(k,1780) = lu(k,1780) - lu(k,1723) * lu(k,1777) + lu(k,1781) = lu(k,1781) - lu(k,1724) * lu(k,1777) + lu(k,1782) = lu(k,1782) - lu(k,1725) * lu(k,1777) + lu(k,1783) = lu(k,1783) - lu(k,1726) * lu(k,1777) + lu(k,1784) = lu(k,1784) - lu(k,1727) * lu(k,1777) + lu(k,1785) = lu(k,1785) - lu(k,1728) * lu(k,1777) + lu(k,1786) = lu(k,1786) - lu(k,1729) * lu(k,1777) + lu(k,1787) = lu(k,1787) - lu(k,1730) * lu(k,1777) + lu(k,1788) = lu(k,1788) - lu(k,1731) * lu(k,1777) + lu(k,1830) = lu(k,1830) - lu(k,1721) * lu(k,1829) + lu(k,1831) = lu(k,1831) - lu(k,1722) * lu(k,1829) + lu(k,1832) = lu(k,1832) - lu(k,1723) * lu(k,1829) + lu(k,1833) = lu(k,1833) - lu(k,1724) * lu(k,1829) + lu(k,1834) = lu(k,1834) - lu(k,1725) * lu(k,1829) + lu(k,1835) = lu(k,1835) - lu(k,1726) * lu(k,1829) + lu(k,1836) = lu(k,1836) - lu(k,1727) * lu(k,1829) + lu(k,1837) = lu(k,1837) - lu(k,1728) * lu(k,1829) + lu(k,1838) = lu(k,1838) - lu(k,1729) * lu(k,1829) + lu(k,1839) = lu(k,1839) - lu(k,1730) * lu(k,1829) + lu(k,1840) = lu(k,1840) - lu(k,1731) * lu(k,1829) + lu(k,1922) = lu(k,1922) - lu(k,1721) * lu(k,1921) + lu(k,1923) = lu(k,1923) - lu(k,1722) * lu(k,1921) + lu(k,1924) = lu(k,1924) - lu(k,1723) * lu(k,1921) + lu(k,1925) = lu(k,1925) - lu(k,1724) * lu(k,1921) + lu(k,1926) = lu(k,1926) - lu(k,1725) * lu(k,1921) + lu(k,1927) = lu(k,1927) - lu(k,1726) * lu(k,1921) + lu(k,1928) = lu(k,1928) - lu(k,1727) * lu(k,1921) + lu(k,1929) = lu(k,1929) - lu(k,1728) * lu(k,1921) + lu(k,1930) = lu(k,1930) - lu(k,1729) * lu(k,1921) + lu(k,1931) = lu(k,1931) - lu(k,1730) * lu(k,1921) + lu(k,1932) = lu(k,1932) - lu(k,1731) * lu(k,1921) + lu(k,1966) = lu(k,1966) - lu(k,1721) * lu(k,1965) + lu(k,1967) = lu(k,1967) - lu(k,1722) * lu(k,1965) + lu(k,1968) = lu(k,1968) - lu(k,1723) * lu(k,1965) + lu(k,1969) = lu(k,1969) - lu(k,1724) * lu(k,1965) + lu(k,1970) = lu(k,1970) - lu(k,1725) * lu(k,1965) + lu(k,1971) = lu(k,1971) - lu(k,1726) * lu(k,1965) + lu(k,1972) = lu(k,1972) - lu(k,1727) * lu(k,1965) + lu(k,1973) = lu(k,1973) - lu(k,1728) * lu(k,1965) + lu(k,1974) = lu(k,1974) - lu(k,1729) * lu(k,1965) + lu(k,1975) = lu(k,1975) - lu(k,1730) * lu(k,1965) + lu(k,1976) = lu(k,1976) - lu(k,1731) * lu(k,1965) + lu(k,2005) = lu(k,2005) - lu(k,1721) * lu(k,2004) + lu(k,2006) = lu(k,2006) - lu(k,1722) * lu(k,2004) + lu(k,2007) = lu(k,2007) - lu(k,1723) * lu(k,2004) + lu(k,2008) = lu(k,2008) - lu(k,1724) * lu(k,2004) + lu(k,2009) = lu(k,2009) - lu(k,1725) * lu(k,2004) + lu(k,2010) = lu(k,2010) - lu(k,1726) * lu(k,2004) + lu(k,2011) = lu(k,2011) - lu(k,1727) * lu(k,2004) + lu(k,2012) = lu(k,2012) - lu(k,1728) * lu(k,2004) + lu(k,2013) = lu(k,2013) - lu(k,1729) * lu(k,2004) + lu(k,2014) = lu(k,2014) - lu(k,1730) * lu(k,2004) + lu(k,2015) = lu(k,2015) - lu(k,1731) * lu(k,2004) + lu(k,2112) = lu(k,2112) - lu(k,1721) * lu(k,2111) + lu(k,2113) = lu(k,2113) - lu(k,1722) * lu(k,2111) + lu(k,2114) = lu(k,2114) - lu(k,1723) * lu(k,2111) + lu(k,2115) = lu(k,2115) - lu(k,1724) * lu(k,2111) + lu(k,2116) = lu(k,2116) - lu(k,1725) * lu(k,2111) + lu(k,2117) = lu(k,2117) - lu(k,1726) * lu(k,2111) + lu(k,2118) = lu(k,2118) - lu(k,1727) * lu(k,2111) + lu(k,2119) = lu(k,2119) - lu(k,1728) * lu(k,2111) + lu(k,2120) = lu(k,2120) - lu(k,1729) * lu(k,2111) + lu(k,2121) = lu(k,2121) - lu(k,1730) * lu(k,2111) + lu(k,2122) = lu(k,2122) - lu(k,1731) * lu(k,2111) + lu(k,2135) = lu(k,2135) - lu(k,1721) * lu(k,2134) + lu(k,2136) = lu(k,2136) - lu(k,1722) * lu(k,2134) + lu(k,2137) = lu(k,2137) - lu(k,1723) * lu(k,2134) + lu(k,2138) = lu(k,2138) - lu(k,1724) * lu(k,2134) + lu(k,2139) = lu(k,2139) - lu(k,1725) * lu(k,2134) + lu(k,2140) = lu(k,2140) - lu(k,1726) * lu(k,2134) + lu(k,2141) = lu(k,2141) - lu(k,1727) * lu(k,2134) + lu(k,2142) = lu(k,2142) - lu(k,1728) * lu(k,2134) + lu(k,2143) = lu(k,2143) - lu(k,1729) * lu(k,2134) + lu(k,2144) = lu(k,2144) - lu(k,1730) * lu(k,2134) + lu(k,2145) = lu(k,2145) - lu(k,1731) * lu(k,2134) + lu(k,2159) = lu(k,2159) - lu(k,1721) * lu(k,2158) + lu(k,2160) = lu(k,2160) - lu(k,1722) * lu(k,2158) + lu(k,2161) = lu(k,2161) - lu(k,1723) * lu(k,2158) + lu(k,2162) = lu(k,2162) - lu(k,1724) * lu(k,2158) + lu(k,2163) = lu(k,2163) - lu(k,1725) * lu(k,2158) + lu(k,2164) = lu(k,2164) - lu(k,1726) * lu(k,2158) + lu(k,2165) = lu(k,2165) - lu(k,1727) * lu(k,2158) + lu(k,2166) = lu(k,2166) - lu(k,1728) * lu(k,2158) + lu(k,2167) = lu(k,2167) - lu(k,1729) * lu(k,2158) + lu(k,2168) = lu(k,2168) - lu(k,1730) * lu(k,2158) + lu(k,2169) = lu(k,2169) - lu(k,1731) * lu(k,2158) + lu(k,2190) = lu(k,2190) - lu(k,1721) * lu(k,2189) + lu(k,2191) = lu(k,2191) - lu(k,1722) * lu(k,2189) + lu(k,2192) = lu(k,2192) - lu(k,1723) * lu(k,2189) + lu(k,2193) = lu(k,2193) - lu(k,1724) * lu(k,2189) + lu(k,2194) = lu(k,2194) - lu(k,1725) * lu(k,2189) + lu(k,2195) = lu(k,2195) - lu(k,1726) * lu(k,2189) + lu(k,2196) = lu(k,2196) - lu(k,1727) * lu(k,2189) + lu(k,2197) = lu(k,2197) - lu(k,1728) * lu(k,2189) + lu(k,2198) = lu(k,2198) - lu(k,1729) * lu(k,2189) + lu(k,2199) = lu(k,2199) - lu(k,1730) * lu(k,2189) + lu(k,2200) = lu(k,2200) - lu(k,1731) * lu(k,2189) + lu(k,2251) = lu(k,2251) - lu(k,1721) * lu(k,2250) + lu(k,2252) = lu(k,2252) - lu(k,1722) * lu(k,2250) + lu(k,2253) = lu(k,2253) - lu(k,1723) * lu(k,2250) + lu(k,2254) = lu(k,2254) - lu(k,1724) * lu(k,2250) + lu(k,2255) = lu(k,2255) - lu(k,1725) * lu(k,2250) + lu(k,2256) = lu(k,2256) - lu(k,1726) * lu(k,2250) + lu(k,2257) = lu(k,2257) - lu(k,1727) * lu(k,2250) + lu(k,2258) = lu(k,2258) - lu(k,1728) * lu(k,2250) + lu(k,2259) = lu(k,2259) - lu(k,1729) * lu(k,2250) + lu(k,2260) = lu(k,2260) - lu(k,1730) * lu(k,2250) + lu(k,2261) = lu(k,2261) - lu(k,1731) * lu(k,2250) + lu(k,2277) = lu(k,2277) - lu(k,1721) * lu(k,2276) + lu(k,2278) = lu(k,2278) - lu(k,1722) * lu(k,2276) + lu(k,2279) = lu(k,2279) - lu(k,1723) * lu(k,2276) + lu(k,2280) = lu(k,2280) - lu(k,1724) * lu(k,2276) + lu(k,2281) = lu(k,2281) - lu(k,1725) * lu(k,2276) + lu(k,2282) = lu(k,2282) - lu(k,1726) * lu(k,2276) + lu(k,2283) = lu(k,2283) - lu(k,1727) * lu(k,2276) + lu(k,2284) = lu(k,2284) - lu(k,1728) * lu(k,2276) + lu(k,2285) = lu(k,2285) - lu(k,1729) * lu(k,2276) + lu(k,2286) = lu(k,2286) - lu(k,1730) * lu(k,2276) + lu(k,2287) = lu(k,2287) - lu(k,1731) * lu(k,2276) + end do + end subroutine lu_fac29 + subroutine lu_fac30( 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,1778) = 1._r8 / lu(k,1778) + lu(k,1779) = lu(k,1779) * lu(k,1778) + lu(k,1780) = lu(k,1780) * lu(k,1778) + lu(k,1781) = lu(k,1781) * lu(k,1778) + lu(k,1782) = lu(k,1782) * lu(k,1778) + lu(k,1783) = lu(k,1783) * lu(k,1778) + lu(k,1784) = lu(k,1784) * lu(k,1778) + lu(k,1785) = lu(k,1785) * lu(k,1778) + lu(k,1786) = lu(k,1786) * lu(k,1778) + lu(k,1787) = lu(k,1787) * lu(k,1778) + lu(k,1788) = lu(k,1788) * lu(k,1778) + lu(k,1831) = lu(k,1831) - lu(k,1779) * lu(k,1830) + lu(k,1832) = lu(k,1832) - lu(k,1780) * lu(k,1830) + lu(k,1833) = lu(k,1833) - lu(k,1781) * lu(k,1830) + lu(k,1834) = lu(k,1834) - lu(k,1782) * lu(k,1830) + lu(k,1835) = lu(k,1835) - lu(k,1783) * lu(k,1830) + lu(k,1836) = lu(k,1836) - lu(k,1784) * lu(k,1830) + lu(k,1837) = lu(k,1837) - lu(k,1785) * lu(k,1830) + lu(k,1838) = lu(k,1838) - lu(k,1786) * lu(k,1830) + lu(k,1839) = lu(k,1839) - lu(k,1787) * lu(k,1830) + lu(k,1840) = lu(k,1840) - lu(k,1788) * lu(k,1830) + lu(k,1923) = lu(k,1923) - lu(k,1779) * lu(k,1922) + lu(k,1924) = lu(k,1924) - lu(k,1780) * lu(k,1922) + lu(k,1925) = lu(k,1925) - lu(k,1781) * lu(k,1922) + lu(k,1926) = lu(k,1926) - lu(k,1782) * lu(k,1922) + lu(k,1927) = lu(k,1927) - lu(k,1783) * lu(k,1922) + lu(k,1928) = lu(k,1928) - lu(k,1784) * lu(k,1922) + lu(k,1929) = lu(k,1929) - lu(k,1785) * lu(k,1922) + lu(k,1930) = lu(k,1930) - lu(k,1786) * lu(k,1922) + lu(k,1931) = lu(k,1931) - lu(k,1787) * lu(k,1922) + lu(k,1932) = lu(k,1932) - lu(k,1788) * lu(k,1922) + lu(k,1967) = lu(k,1967) - lu(k,1779) * lu(k,1966) + lu(k,1968) = lu(k,1968) - lu(k,1780) * lu(k,1966) + lu(k,1969) = lu(k,1969) - lu(k,1781) * lu(k,1966) + lu(k,1970) = lu(k,1970) - lu(k,1782) * lu(k,1966) + lu(k,1971) = lu(k,1971) - lu(k,1783) * lu(k,1966) + lu(k,1972) = lu(k,1972) - lu(k,1784) * lu(k,1966) + lu(k,1973) = lu(k,1973) - lu(k,1785) * lu(k,1966) + lu(k,1974) = lu(k,1974) - lu(k,1786) * lu(k,1966) + lu(k,1975) = lu(k,1975) - lu(k,1787) * lu(k,1966) + lu(k,1976) = lu(k,1976) - lu(k,1788) * lu(k,1966) + lu(k,2006) = lu(k,2006) - lu(k,1779) * lu(k,2005) + lu(k,2007) = lu(k,2007) - lu(k,1780) * lu(k,2005) + lu(k,2008) = lu(k,2008) - lu(k,1781) * lu(k,2005) + lu(k,2009) = lu(k,2009) - lu(k,1782) * lu(k,2005) + lu(k,2010) = lu(k,2010) - lu(k,1783) * lu(k,2005) + lu(k,2011) = lu(k,2011) - lu(k,1784) * lu(k,2005) + lu(k,2012) = lu(k,2012) - lu(k,1785) * lu(k,2005) + lu(k,2013) = lu(k,2013) - lu(k,1786) * lu(k,2005) + lu(k,2014) = lu(k,2014) - lu(k,1787) * lu(k,2005) + lu(k,2015) = lu(k,2015) - lu(k,1788) * lu(k,2005) + lu(k,2113) = lu(k,2113) - lu(k,1779) * lu(k,2112) + lu(k,2114) = lu(k,2114) - lu(k,1780) * lu(k,2112) + lu(k,2115) = lu(k,2115) - lu(k,1781) * lu(k,2112) + lu(k,2116) = lu(k,2116) - lu(k,1782) * lu(k,2112) + lu(k,2117) = lu(k,2117) - lu(k,1783) * lu(k,2112) + lu(k,2118) = lu(k,2118) - lu(k,1784) * lu(k,2112) + lu(k,2119) = lu(k,2119) - lu(k,1785) * lu(k,2112) + lu(k,2120) = lu(k,2120) - lu(k,1786) * lu(k,2112) + lu(k,2121) = lu(k,2121) - lu(k,1787) * lu(k,2112) + lu(k,2122) = lu(k,2122) - lu(k,1788) * lu(k,2112) + lu(k,2136) = lu(k,2136) - lu(k,1779) * lu(k,2135) + lu(k,2137) = lu(k,2137) - lu(k,1780) * lu(k,2135) + lu(k,2138) = lu(k,2138) - lu(k,1781) * lu(k,2135) + lu(k,2139) = lu(k,2139) - lu(k,1782) * lu(k,2135) + lu(k,2140) = lu(k,2140) - lu(k,1783) * lu(k,2135) + lu(k,2141) = lu(k,2141) - lu(k,1784) * lu(k,2135) + lu(k,2142) = lu(k,2142) - lu(k,1785) * lu(k,2135) + lu(k,2143) = lu(k,2143) - lu(k,1786) * lu(k,2135) + lu(k,2144) = lu(k,2144) - lu(k,1787) * lu(k,2135) + lu(k,2145) = lu(k,2145) - lu(k,1788) * lu(k,2135) + lu(k,2160) = lu(k,2160) - lu(k,1779) * lu(k,2159) + lu(k,2161) = lu(k,2161) - lu(k,1780) * lu(k,2159) + lu(k,2162) = lu(k,2162) - lu(k,1781) * lu(k,2159) + lu(k,2163) = lu(k,2163) - lu(k,1782) * lu(k,2159) + lu(k,2164) = lu(k,2164) - lu(k,1783) * lu(k,2159) + lu(k,2165) = lu(k,2165) - lu(k,1784) * lu(k,2159) + lu(k,2166) = lu(k,2166) - lu(k,1785) * lu(k,2159) + lu(k,2167) = lu(k,2167) - lu(k,1786) * lu(k,2159) + lu(k,2168) = lu(k,2168) - lu(k,1787) * lu(k,2159) + lu(k,2169) = lu(k,2169) - lu(k,1788) * lu(k,2159) + lu(k,2191) = lu(k,2191) - lu(k,1779) * lu(k,2190) + lu(k,2192) = lu(k,2192) - lu(k,1780) * lu(k,2190) + lu(k,2193) = lu(k,2193) - lu(k,1781) * lu(k,2190) + lu(k,2194) = lu(k,2194) - lu(k,1782) * lu(k,2190) + lu(k,2195) = lu(k,2195) - lu(k,1783) * lu(k,2190) + lu(k,2196) = lu(k,2196) - lu(k,1784) * lu(k,2190) + lu(k,2197) = lu(k,2197) - lu(k,1785) * lu(k,2190) + lu(k,2198) = lu(k,2198) - lu(k,1786) * lu(k,2190) + lu(k,2199) = lu(k,2199) - lu(k,1787) * lu(k,2190) + lu(k,2200) = lu(k,2200) - lu(k,1788) * lu(k,2190) + lu(k,2252) = lu(k,2252) - lu(k,1779) * lu(k,2251) + lu(k,2253) = lu(k,2253) - lu(k,1780) * lu(k,2251) + lu(k,2254) = lu(k,2254) - lu(k,1781) * lu(k,2251) + lu(k,2255) = lu(k,2255) - lu(k,1782) * lu(k,2251) + lu(k,2256) = lu(k,2256) - lu(k,1783) * lu(k,2251) + lu(k,2257) = lu(k,2257) - lu(k,1784) * lu(k,2251) + lu(k,2258) = lu(k,2258) - lu(k,1785) * lu(k,2251) + lu(k,2259) = lu(k,2259) - lu(k,1786) * lu(k,2251) + lu(k,2260) = lu(k,2260) - lu(k,1787) * lu(k,2251) + lu(k,2261) = lu(k,2261) - lu(k,1788) * lu(k,2251) + lu(k,2278) = lu(k,2278) - lu(k,1779) * lu(k,2277) + lu(k,2279) = lu(k,2279) - lu(k,1780) * lu(k,2277) + lu(k,2280) = lu(k,2280) - lu(k,1781) * lu(k,2277) + lu(k,2281) = lu(k,2281) - lu(k,1782) * lu(k,2277) + lu(k,2282) = lu(k,2282) - lu(k,1783) * lu(k,2277) + lu(k,2283) = lu(k,2283) - lu(k,1784) * lu(k,2277) + lu(k,2284) = lu(k,2284) - lu(k,1785) * lu(k,2277) + lu(k,2285) = lu(k,2285) - lu(k,1786) * lu(k,2277) + lu(k,2286) = lu(k,2286) - lu(k,1787) * lu(k,2277) + lu(k,2287) = lu(k,2287) - lu(k,1788) * lu(k,2277) + lu(k,1831) = 1._r8 / lu(k,1831) + lu(k,1832) = lu(k,1832) * lu(k,1831) + lu(k,1833) = lu(k,1833) * lu(k,1831) + lu(k,1834) = lu(k,1834) * lu(k,1831) + lu(k,1835) = lu(k,1835) * lu(k,1831) + lu(k,1836) = lu(k,1836) * lu(k,1831) + lu(k,1837) = lu(k,1837) * lu(k,1831) + lu(k,1838) = lu(k,1838) * lu(k,1831) + lu(k,1839) = lu(k,1839) * lu(k,1831) + lu(k,1840) = lu(k,1840) * lu(k,1831) + lu(k,1924) = lu(k,1924) - lu(k,1832) * lu(k,1923) + lu(k,1925) = lu(k,1925) - lu(k,1833) * lu(k,1923) + lu(k,1926) = lu(k,1926) - lu(k,1834) * lu(k,1923) + lu(k,1927) = lu(k,1927) - lu(k,1835) * lu(k,1923) + lu(k,1928) = lu(k,1928) - lu(k,1836) * lu(k,1923) + lu(k,1929) = lu(k,1929) - lu(k,1837) * lu(k,1923) + lu(k,1930) = lu(k,1930) - lu(k,1838) * lu(k,1923) + lu(k,1931) = lu(k,1931) - lu(k,1839) * lu(k,1923) + lu(k,1932) = lu(k,1932) - lu(k,1840) * lu(k,1923) + lu(k,1968) = lu(k,1968) - lu(k,1832) * lu(k,1967) + lu(k,1969) = lu(k,1969) - lu(k,1833) * lu(k,1967) + lu(k,1970) = lu(k,1970) - lu(k,1834) * lu(k,1967) + lu(k,1971) = lu(k,1971) - lu(k,1835) * lu(k,1967) + lu(k,1972) = lu(k,1972) - lu(k,1836) * lu(k,1967) + lu(k,1973) = lu(k,1973) - lu(k,1837) * lu(k,1967) + lu(k,1974) = lu(k,1974) - lu(k,1838) * lu(k,1967) + lu(k,1975) = lu(k,1975) - lu(k,1839) * lu(k,1967) + lu(k,1976) = lu(k,1976) - lu(k,1840) * lu(k,1967) + lu(k,2007) = lu(k,2007) - lu(k,1832) * lu(k,2006) + lu(k,2008) = lu(k,2008) - lu(k,1833) * lu(k,2006) + lu(k,2009) = lu(k,2009) - lu(k,1834) * lu(k,2006) + lu(k,2010) = lu(k,2010) - lu(k,1835) * lu(k,2006) + lu(k,2011) = lu(k,2011) - lu(k,1836) * lu(k,2006) + lu(k,2012) = lu(k,2012) - lu(k,1837) * lu(k,2006) + lu(k,2013) = lu(k,2013) - lu(k,1838) * lu(k,2006) + lu(k,2014) = lu(k,2014) - lu(k,1839) * lu(k,2006) + lu(k,2015) = lu(k,2015) - lu(k,1840) * lu(k,2006) + lu(k,2114) = lu(k,2114) - lu(k,1832) * lu(k,2113) + lu(k,2115) = lu(k,2115) - lu(k,1833) * lu(k,2113) + lu(k,2116) = lu(k,2116) - lu(k,1834) * lu(k,2113) + lu(k,2117) = lu(k,2117) - lu(k,1835) * lu(k,2113) + lu(k,2118) = lu(k,2118) - lu(k,1836) * lu(k,2113) + lu(k,2119) = lu(k,2119) - lu(k,1837) * lu(k,2113) + lu(k,2120) = lu(k,2120) - lu(k,1838) * lu(k,2113) + lu(k,2121) = lu(k,2121) - lu(k,1839) * lu(k,2113) + lu(k,2122) = lu(k,2122) - lu(k,1840) * lu(k,2113) + lu(k,2137) = lu(k,2137) - lu(k,1832) * lu(k,2136) + lu(k,2138) = lu(k,2138) - lu(k,1833) * lu(k,2136) + lu(k,2139) = lu(k,2139) - lu(k,1834) * lu(k,2136) + lu(k,2140) = lu(k,2140) - lu(k,1835) * lu(k,2136) + lu(k,2141) = lu(k,2141) - lu(k,1836) * lu(k,2136) + lu(k,2142) = lu(k,2142) - lu(k,1837) * lu(k,2136) + lu(k,2143) = lu(k,2143) - lu(k,1838) * lu(k,2136) + lu(k,2144) = lu(k,2144) - lu(k,1839) * lu(k,2136) + lu(k,2145) = lu(k,2145) - lu(k,1840) * lu(k,2136) + lu(k,2161) = lu(k,2161) - lu(k,1832) * lu(k,2160) + lu(k,2162) = lu(k,2162) - lu(k,1833) * lu(k,2160) + lu(k,2163) = lu(k,2163) - lu(k,1834) * lu(k,2160) + lu(k,2164) = lu(k,2164) - lu(k,1835) * lu(k,2160) + lu(k,2165) = lu(k,2165) - lu(k,1836) * lu(k,2160) + lu(k,2166) = lu(k,2166) - lu(k,1837) * lu(k,2160) + lu(k,2167) = lu(k,2167) - lu(k,1838) * lu(k,2160) + lu(k,2168) = lu(k,2168) - lu(k,1839) * lu(k,2160) + lu(k,2169) = lu(k,2169) - lu(k,1840) * lu(k,2160) + lu(k,2192) = lu(k,2192) - lu(k,1832) * lu(k,2191) + lu(k,2193) = lu(k,2193) - lu(k,1833) * lu(k,2191) + lu(k,2194) = lu(k,2194) - lu(k,1834) * lu(k,2191) + lu(k,2195) = lu(k,2195) - lu(k,1835) * lu(k,2191) + lu(k,2196) = lu(k,2196) - lu(k,1836) * lu(k,2191) + lu(k,2197) = lu(k,2197) - lu(k,1837) * lu(k,2191) + lu(k,2198) = lu(k,2198) - lu(k,1838) * lu(k,2191) + lu(k,2199) = lu(k,2199) - lu(k,1839) * lu(k,2191) + lu(k,2200) = lu(k,2200) - lu(k,1840) * lu(k,2191) + lu(k,2253) = lu(k,2253) - lu(k,1832) * lu(k,2252) + lu(k,2254) = lu(k,2254) - lu(k,1833) * lu(k,2252) + lu(k,2255) = lu(k,2255) - lu(k,1834) * lu(k,2252) + lu(k,2256) = lu(k,2256) - lu(k,1835) * lu(k,2252) + lu(k,2257) = lu(k,2257) - lu(k,1836) * lu(k,2252) + lu(k,2258) = lu(k,2258) - lu(k,1837) * lu(k,2252) + lu(k,2259) = lu(k,2259) - lu(k,1838) * lu(k,2252) + lu(k,2260) = lu(k,2260) - lu(k,1839) * lu(k,2252) + lu(k,2261) = lu(k,2261) - lu(k,1840) * lu(k,2252) + lu(k,2279) = lu(k,2279) - lu(k,1832) * lu(k,2278) + lu(k,2280) = lu(k,2280) - lu(k,1833) * lu(k,2278) + lu(k,2281) = lu(k,2281) - lu(k,1834) * lu(k,2278) + lu(k,2282) = lu(k,2282) - lu(k,1835) * lu(k,2278) + lu(k,2283) = lu(k,2283) - lu(k,1836) * lu(k,2278) + lu(k,2284) = lu(k,2284) - lu(k,1837) * lu(k,2278) + lu(k,2285) = lu(k,2285) - lu(k,1838) * lu(k,2278) + lu(k,2286) = lu(k,2286) - lu(k,1839) * lu(k,2278) + lu(k,2287) = lu(k,2287) - lu(k,1840) * lu(k,2278) + lu(k,1924) = 1._r8 / lu(k,1924) + lu(k,1925) = lu(k,1925) * lu(k,1924) + lu(k,1926) = lu(k,1926) * lu(k,1924) + lu(k,1927) = lu(k,1927) * lu(k,1924) + lu(k,1928) = lu(k,1928) * lu(k,1924) + lu(k,1929) = lu(k,1929) * lu(k,1924) + lu(k,1930) = lu(k,1930) * lu(k,1924) + lu(k,1931) = lu(k,1931) * lu(k,1924) + lu(k,1932) = lu(k,1932) * lu(k,1924) + lu(k,1969) = lu(k,1969) - lu(k,1925) * lu(k,1968) + lu(k,1970) = lu(k,1970) - lu(k,1926) * lu(k,1968) + lu(k,1971) = lu(k,1971) - lu(k,1927) * lu(k,1968) + lu(k,1972) = lu(k,1972) - lu(k,1928) * lu(k,1968) + lu(k,1973) = lu(k,1973) - lu(k,1929) * lu(k,1968) + lu(k,1974) = lu(k,1974) - lu(k,1930) * lu(k,1968) + lu(k,1975) = lu(k,1975) - lu(k,1931) * lu(k,1968) + lu(k,1976) = lu(k,1976) - lu(k,1932) * lu(k,1968) + lu(k,2008) = lu(k,2008) - lu(k,1925) * lu(k,2007) + lu(k,2009) = lu(k,2009) - lu(k,1926) * lu(k,2007) + lu(k,2010) = lu(k,2010) - lu(k,1927) * lu(k,2007) + lu(k,2011) = lu(k,2011) - lu(k,1928) * lu(k,2007) + lu(k,2012) = lu(k,2012) - lu(k,1929) * lu(k,2007) + lu(k,2013) = lu(k,2013) - lu(k,1930) * lu(k,2007) + lu(k,2014) = lu(k,2014) - lu(k,1931) * lu(k,2007) + lu(k,2015) = lu(k,2015) - lu(k,1932) * lu(k,2007) + lu(k,2115) = lu(k,2115) - lu(k,1925) * lu(k,2114) + lu(k,2116) = lu(k,2116) - lu(k,1926) * lu(k,2114) + lu(k,2117) = lu(k,2117) - lu(k,1927) * lu(k,2114) + lu(k,2118) = lu(k,2118) - lu(k,1928) * lu(k,2114) + lu(k,2119) = lu(k,2119) - lu(k,1929) * lu(k,2114) + lu(k,2120) = lu(k,2120) - lu(k,1930) * lu(k,2114) + lu(k,2121) = lu(k,2121) - lu(k,1931) * lu(k,2114) + lu(k,2122) = lu(k,2122) - lu(k,1932) * lu(k,2114) + lu(k,2138) = lu(k,2138) - lu(k,1925) * lu(k,2137) + lu(k,2139) = lu(k,2139) - lu(k,1926) * lu(k,2137) + lu(k,2140) = lu(k,2140) - lu(k,1927) * lu(k,2137) + lu(k,2141) = lu(k,2141) - lu(k,1928) * lu(k,2137) + lu(k,2142) = lu(k,2142) - lu(k,1929) * lu(k,2137) + lu(k,2143) = lu(k,2143) - lu(k,1930) * lu(k,2137) + lu(k,2144) = lu(k,2144) - lu(k,1931) * lu(k,2137) + lu(k,2145) = lu(k,2145) - lu(k,1932) * lu(k,2137) + lu(k,2162) = lu(k,2162) - lu(k,1925) * lu(k,2161) + lu(k,2163) = lu(k,2163) - lu(k,1926) * lu(k,2161) + lu(k,2164) = lu(k,2164) - lu(k,1927) * lu(k,2161) + lu(k,2165) = lu(k,2165) - lu(k,1928) * lu(k,2161) + lu(k,2166) = lu(k,2166) - lu(k,1929) * lu(k,2161) + lu(k,2167) = lu(k,2167) - lu(k,1930) * lu(k,2161) + lu(k,2168) = lu(k,2168) - lu(k,1931) * lu(k,2161) + lu(k,2169) = lu(k,2169) - lu(k,1932) * lu(k,2161) + lu(k,2193) = lu(k,2193) - lu(k,1925) * lu(k,2192) + lu(k,2194) = lu(k,2194) - lu(k,1926) * lu(k,2192) + lu(k,2195) = lu(k,2195) - lu(k,1927) * lu(k,2192) + lu(k,2196) = lu(k,2196) - lu(k,1928) * lu(k,2192) + lu(k,2197) = lu(k,2197) - lu(k,1929) * lu(k,2192) + lu(k,2198) = lu(k,2198) - lu(k,1930) * lu(k,2192) + lu(k,2199) = lu(k,2199) - lu(k,1931) * lu(k,2192) + lu(k,2200) = lu(k,2200) - lu(k,1932) * lu(k,2192) + lu(k,2254) = lu(k,2254) - lu(k,1925) * lu(k,2253) + lu(k,2255) = lu(k,2255) - lu(k,1926) * lu(k,2253) + lu(k,2256) = lu(k,2256) - lu(k,1927) * lu(k,2253) + lu(k,2257) = lu(k,2257) - lu(k,1928) * lu(k,2253) + lu(k,2258) = lu(k,2258) - lu(k,1929) * lu(k,2253) + lu(k,2259) = lu(k,2259) - lu(k,1930) * lu(k,2253) + lu(k,2260) = lu(k,2260) - lu(k,1931) * lu(k,2253) + lu(k,2261) = lu(k,2261) - lu(k,1932) * lu(k,2253) + lu(k,2280) = lu(k,2280) - lu(k,1925) * lu(k,2279) + lu(k,2281) = lu(k,2281) - lu(k,1926) * lu(k,2279) + lu(k,2282) = lu(k,2282) - lu(k,1927) * lu(k,2279) + lu(k,2283) = lu(k,2283) - lu(k,1928) * lu(k,2279) + lu(k,2284) = lu(k,2284) - lu(k,1929) * lu(k,2279) + lu(k,2285) = lu(k,2285) - lu(k,1930) * lu(k,2279) + lu(k,2286) = lu(k,2286) - lu(k,1931) * lu(k,2279) + lu(k,2287) = lu(k,2287) - lu(k,1932) * lu(k,2279) + lu(k,1969) = 1._r8 / lu(k,1969) + lu(k,1970) = lu(k,1970) * lu(k,1969) + lu(k,1971) = lu(k,1971) * lu(k,1969) + lu(k,1972) = lu(k,1972) * lu(k,1969) + lu(k,1973) = lu(k,1973) * lu(k,1969) + lu(k,1974) = lu(k,1974) * lu(k,1969) + lu(k,1975) = lu(k,1975) * lu(k,1969) + lu(k,1976) = lu(k,1976) * lu(k,1969) + lu(k,2009) = lu(k,2009) - lu(k,1970) * lu(k,2008) + lu(k,2010) = lu(k,2010) - lu(k,1971) * lu(k,2008) + lu(k,2011) = lu(k,2011) - lu(k,1972) * lu(k,2008) + lu(k,2012) = lu(k,2012) - lu(k,1973) * lu(k,2008) + lu(k,2013) = lu(k,2013) - lu(k,1974) * lu(k,2008) + lu(k,2014) = lu(k,2014) - lu(k,1975) * lu(k,2008) + lu(k,2015) = lu(k,2015) - lu(k,1976) * lu(k,2008) + lu(k,2116) = lu(k,2116) - lu(k,1970) * lu(k,2115) + lu(k,2117) = lu(k,2117) - lu(k,1971) * lu(k,2115) + lu(k,2118) = lu(k,2118) - lu(k,1972) * lu(k,2115) + lu(k,2119) = lu(k,2119) - lu(k,1973) * lu(k,2115) + lu(k,2120) = lu(k,2120) - lu(k,1974) * lu(k,2115) + lu(k,2121) = lu(k,2121) - lu(k,1975) * lu(k,2115) + lu(k,2122) = lu(k,2122) - lu(k,1976) * lu(k,2115) + lu(k,2139) = lu(k,2139) - lu(k,1970) * lu(k,2138) + lu(k,2140) = lu(k,2140) - lu(k,1971) * lu(k,2138) + lu(k,2141) = lu(k,2141) - lu(k,1972) * lu(k,2138) + lu(k,2142) = lu(k,2142) - lu(k,1973) * lu(k,2138) + lu(k,2143) = lu(k,2143) - lu(k,1974) * lu(k,2138) + lu(k,2144) = lu(k,2144) - lu(k,1975) * lu(k,2138) + lu(k,2145) = lu(k,2145) - lu(k,1976) * lu(k,2138) + lu(k,2163) = lu(k,2163) - lu(k,1970) * lu(k,2162) + lu(k,2164) = lu(k,2164) - lu(k,1971) * lu(k,2162) + lu(k,2165) = lu(k,2165) - lu(k,1972) * lu(k,2162) + lu(k,2166) = lu(k,2166) - lu(k,1973) * lu(k,2162) + lu(k,2167) = lu(k,2167) - lu(k,1974) * lu(k,2162) + lu(k,2168) = lu(k,2168) - lu(k,1975) * lu(k,2162) + lu(k,2169) = lu(k,2169) - lu(k,1976) * lu(k,2162) + lu(k,2194) = lu(k,2194) - lu(k,1970) * lu(k,2193) + lu(k,2195) = lu(k,2195) - lu(k,1971) * lu(k,2193) + lu(k,2196) = lu(k,2196) - lu(k,1972) * lu(k,2193) + lu(k,2197) = lu(k,2197) - lu(k,1973) * lu(k,2193) + lu(k,2198) = lu(k,2198) - lu(k,1974) * lu(k,2193) + lu(k,2199) = lu(k,2199) - lu(k,1975) * lu(k,2193) + lu(k,2200) = lu(k,2200) - lu(k,1976) * lu(k,2193) + lu(k,2255) = lu(k,2255) - lu(k,1970) * lu(k,2254) + lu(k,2256) = lu(k,2256) - lu(k,1971) * lu(k,2254) + lu(k,2257) = lu(k,2257) - lu(k,1972) * lu(k,2254) + lu(k,2258) = lu(k,2258) - lu(k,1973) * lu(k,2254) + lu(k,2259) = lu(k,2259) - lu(k,1974) * lu(k,2254) + lu(k,2260) = lu(k,2260) - lu(k,1975) * lu(k,2254) + lu(k,2261) = lu(k,2261) - lu(k,1976) * lu(k,2254) + lu(k,2281) = lu(k,2281) - lu(k,1970) * lu(k,2280) + lu(k,2282) = lu(k,2282) - lu(k,1971) * lu(k,2280) + lu(k,2283) = lu(k,2283) - lu(k,1972) * lu(k,2280) + lu(k,2284) = lu(k,2284) - lu(k,1973) * lu(k,2280) + lu(k,2285) = lu(k,2285) - lu(k,1974) * lu(k,2280) + lu(k,2286) = lu(k,2286) - lu(k,1975) * lu(k,2280) + lu(k,2287) = lu(k,2287) - lu(k,1976) * lu(k,2280) + lu(k,2009) = 1._r8 / lu(k,2009) + lu(k,2010) = lu(k,2010) * lu(k,2009) + lu(k,2011) = lu(k,2011) * lu(k,2009) + lu(k,2012) = lu(k,2012) * lu(k,2009) + lu(k,2013) = lu(k,2013) * lu(k,2009) + lu(k,2014) = lu(k,2014) * lu(k,2009) + lu(k,2015) = lu(k,2015) * lu(k,2009) + lu(k,2117) = lu(k,2117) - lu(k,2010) * lu(k,2116) + lu(k,2118) = lu(k,2118) - lu(k,2011) * lu(k,2116) + lu(k,2119) = lu(k,2119) - lu(k,2012) * lu(k,2116) + lu(k,2120) = lu(k,2120) - lu(k,2013) * lu(k,2116) + lu(k,2121) = lu(k,2121) - lu(k,2014) * lu(k,2116) + lu(k,2122) = lu(k,2122) - lu(k,2015) * lu(k,2116) + lu(k,2140) = lu(k,2140) - lu(k,2010) * lu(k,2139) + lu(k,2141) = lu(k,2141) - lu(k,2011) * lu(k,2139) + lu(k,2142) = lu(k,2142) - lu(k,2012) * lu(k,2139) + lu(k,2143) = lu(k,2143) - lu(k,2013) * lu(k,2139) + lu(k,2144) = lu(k,2144) - lu(k,2014) * lu(k,2139) + lu(k,2145) = lu(k,2145) - lu(k,2015) * lu(k,2139) + lu(k,2164) = lu(k,2164) - lu(k,2010) * lu(k,2163) + lu(k,2165) = lu(k,2165) - lu(k,2011) * lu(k,2163) + lu(k,2166) = lu(k,2166) - lu(k,2012) * lu(k,2163) + lu(k,2167) = lu(k,2167) - lu(k,2013) * lu(k,2163) + lu(k,2168) = lu(k,2168) - lu(k,2014) * lu(k,2163) + lu(k,2169) = lu(k,2169) - lu(k,2015) * lu(k,2163) + lu(k,2195) = lu(k,2195) - lu(k,2010) * lu(k,2194) + lu(k,2196) = lu(k,2196) - lu(k,2011) * lu(k,2194) + lu(k,2197) = lu(k,2197) - lu(k,2012) * lu(k,2194) + lu(k,2198) = lu(k,2198) - lu(k,2013) * lu(k,2194) + lu(k,2199) = lu(k,2199) - lu(k,2014) * lu(k,2194) + lu(k,2200) = lu(k,2200) - lu(k,2015) * lu(k,2194) + lu(k,2256) = lu(k,2256) - lu(k,2010) * lu(k,2255) + lu(k,2257) = lu(k,2257) - lu(k,2011) * lu(k,2255) + lu(k,2258) = lu(k,2258) - lu(k,2012) * lu(k,2255) + lu(k,2259) = lu(k,2259) - lu(k,2013) * lu(k,2255) + lu(k,2260) = lu(k,2260) - lu(k,2014) * lu(k,2255) + lu(k,2261) = lu(k,2261) - lu(k,2015) * lu(k,2255) + lu(k,2282) = lu(k,2282) - lu(k,2010) * lu(k,2281) + lu(k,2283) = lu(k,2283) - lu(k,2011) * lu(k,2281) + lu(k,2284) = lu(k,2284) - lu(k,2012) * lu(k,2281) + lu(k,2285) = lu(k,2285) - lu(k,2013) * lu(k,2281) + lu(k,2286) = lu(k,2286) - lu(k,2014) * lu(k,2281) + lu(k,2287) = lu(k,2287) - lu(k,2015) * lu(k,2281) + lu(k,2117) = 1._r8 / lu(k,2117) + lu(k,2118) = lu(k,2118) * lu(k,2117) + lu(k,2119) = lu(k,2119) * lu(k,2117) + lu(k,2120) = lu(k,2120) * lu(k,2117) + lu(k,2121) = lu(k,2121) * lu(k,2117) + lu(k,2122) = lu(k,2122) * lu(k,2117) + lu(k,2141) = lu(k,2141) - lu(k,2118) * lu(k,2140) + lu(k,2142) = lu(k,2142) - lu(k,2119) * lu(k,2140) + lu(k,2143) = lu(k,2143) - lu(k,2120) * lu(k,2140) + lu(k,2144) = lu(k,2144) - lu(k,2121) * lu(k,2140) + lu(k,2145) = lu(k,2145) - lu(k,2122) * lu(k,2140) + lu(k,2165) = lu(k,2165) - lu(k,2118) * lu(k,2164) + lu(k,2166) = lu(k,2166) - lu(k,2119) * lu(k,2164) + lu(k,2167) = lu(k,2167) - lu(k,2120) * lu(k,2164) + lu(k,2168) = lu(k,2168) - lu(k,2121) * lu(k,2164) + lu(k,2169) = lu(k,2169) - lu(k,2122) * lu(k,2164) + lu(k,2196) = lu(k,2196) - lu(k,2118) * lu(k,2195) + lu(k,2197) = lu(k,2197) - lu(k,2119) * lu(k,2195) + lu(k,2198) = lu(k,2198) - lu(k,2120) * lu(k,2195) + lu(k,2199) = lu(k,2199) - lu(k,2121) * lu(k,2195) + lu(k,2200) = lu(k,2200) - lu(k,2122) * lu(k,2195) + lu(k,2257) = lu(k,2257) - lu(k,2118) * lu(k,2256) + lu(k,2258) = lu(k,2258) - lu(k,2119) * lu(k,2256) + lu(k,2259) = lu(k,2259) - lu(k,2120) * lu(k,2256) + lu(k,2260) = lu(k,2260) - lu(k,2121) * lu(k,2256) + lu(k,2261) = lu(k,2261) - lu(k,2122) * lu(k,2256) + lu(k,2283) = lu(k,2283) - lu(k,2118) * lu(k,2282) + lu(k,2284) = lu(k,2284) - lu(k,2119) * lu(k,2282) + lu(k,2285) = lu(k,2285) - lu(k,2120) * lu(k,2282) + lu(k,2286) = lu(k,2286) - lu(k,2121) * lu(k,2282) + lu(k,2287) = lu(k,2287) - lu(k,2122) * lu(k,2282) + end do + end subroutine lu_fac30 + subroutine lu_fac31( 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,2141) = 1._r8 / lu(k,2141) + lu(k,2142) = lu(k,2142) * lu(k,2141) + lu(k,2143) = lu(k,2143) * lu(k,2141) + lu(k,2144) = lu(k,2144) * lu(k,2141) + lu(k,2145) = lu(k,2145) * lu(k,2141) + lu(k,2166) = lu(k,2166) - lu(k,2142) * lu(k,2165) + lu(k,2167) = lu(k,2167) - lu(k,2143) * lu(k,2165) + lu(k,2168) = lu(k,2168) - lu(k,2144) * lu(k,2165) + lu(k,2169) = lu(k,2169) - lu(k,2145) * lu(k,2165) + lu(k,2197) = lu(k,2197) - lu(k,2142) * lu(k,2196) + lu(k,2198) = lu(k,2198) - lu(k,2143) * lu(k,2196) + lu(k,2199) = lu(k,2199) - lu(k,2144) * lu(k,2196) + lu(k,2200) = lu(k,2200) - lu(k,2145) * lu(k,2196) + lu(k,2258) = lu(k,2258) - lu(k,2142) * lu(k,2257) + lu(k,2259) = lu(k,2259) - lu(k,2143) * lu(k,2257) + lu(k,2260) = lu(k,2260) - lu(k,2144) * lu(k,2257) + lu(k,2261) = lu(k,2261) - lu(k,2145) * lu(k,2257) + lu(k,2284) = lu(k,2284) - lu(k,2142) * lu(k,2283) + lu(k,2285) = lu(k,2285) - lu(k,2143) * lu(k,2283) + lu(k,2286) = lu(k,2286) - lu(k,2144) * lu(k,2283) + lu(k,2287) = lu(k,2287) - lu(k,2145) * lu(k,2283) + lu(k,2166) = 1._r8 / lu(k,2166) + lu(k,2167) = lu(k,2167) * lu(k,2166) + lu(k,2168) = lu(k,2168) * lu(k,2166) + lu(k,2169) = lu(k,2169) * lu(k,2166) + lu(k,2198) = lu(k,2198) - lu(k,2167) * lu(k,2197) + lu(k,2199) = lu(k,2199) - lu(k,2168) * lu(k,2197) + lu(k,2200) = lu(k,2200) - lu(k,2169) * lu(k,2197) + lu(k,2259) = lu(k,2259) - lu(k,2167) * lu(k,2258) + lu(k,2260) = lu(k,2260) - lu(k,2168) * lu(k,2258) + lu(k,2261) = lu(k,2261) - lu(k,2169) * lu(k,2258) + lu(k,2285) = lu(k,2285) - lu(k,2167) * lu(k,2284) + lu(k,2286) = lu(k,2286) - lu(k,2168) * lu(k,2284) + lu(k,2287) = lu(k,2287) - lu(k,2169) * lu(k,2284) + lu(k,2198) = 1._r8 / lu(k,2198) + lu(k,2199) = lu(k,2199) * lu(k,2198) + lu(k,2200) = lu(k,2200) * lu(k,2198) + lu(k,2260) = lu(k,2260) - lu(k,2199) * lu(k,2259) + lu(k,2261) = lu(k,2261) - lu(k,2200) * lu(k,2259) + lu(k,2286) = lu(k,2286) - lu(k,2199) * lu(k,2285) + lu(k,2287) = lu(k,2287) - lu(k,2200) * lu(k,2285) + lu(k,2260) = 1._r8 / lu(k,2260) + lu(k,2261) = lu(k,2261) * lu(k,2260) + lu(k,2287) = lu(k,2287) - lu(k,2261) * lu(k,2286) + lu(k,2287) = 1._r8 / lu(k,2287) + end do + end subroutine lu_fac31 + 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 ) + call lu_fac19( avec_len, lu ) + call lu_fac20( avec_len, lu ) + call lu_fac21( avec_len, lu ) + call lu_fac22( avec_len, lu ) + call lu_fac23( avec_len, lu ) + call lu_fac24( avec_len, lu ) + call lu_fac25( avec_len, lu ) + call lu_fac26( avec_len, lu ) + call lu_fac27( avec_len, lu ) + call lu_fac28( avec_len, lu ) + call lu_fac29( avec_len, lu ) + call lu_fac30( avec_len, lu ) + call lu_fac31( avec_len, lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_trop_strat_mam5_vbs/mo_lu_solve.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/mo_lu_solve.F90 new file mode 100644 index 0000000000..9678469ecf --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/mo_lu_solve.F90 @@ -0,0 +1,2559 @@ + 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,218) = b(k,218) - lu(k,96) * b(k,54) + b(k,223) = b(k,223) - lu(k,97) * b(k,54) + b(k,217) = b(k,217) - lu(k,99) * b(k,55) + b(k,229) = b(k,229) - lu(k,100) * b(k,55) + b(k,216) = b(k,216) - lu(k,102) * b(k,56) + b(k,223) = b(k,223) - lu(k,103) * b(k,56) + b(k,217) = b(k,217) - lu(k,105) * b(k,57) + b(k,224) = b(k,224) - lu(k,106) * b(k,57) + b(k,89) = b(k,89) - lu(k,108) * b(k,58) + b(k,211) = b(k,211) - lu(k,109) * b(k,58) + b(k,216) = b(k,216) - lu(k,110) * b(k,58) + b(k,168) = b(k,168) - lu(k,112) * b(k,59) + b(k,217) = b(k,217) - lu(k,113) * b(k,59) + b(k,229) = b(k,229) - lu(k,114) * b(k,59) + b(k,91) = b(k,91) - lu(k,116) * b(k,60) + b(k,216) = b(k,216) - lu(k,117) * b(k,60) + b(k,223) = b(k,223) - lu(k,118) * b(k,60) + b(k,89) = b(k,89) - lu(k,120) * b(k,61) + b(k,216) = b(k,216) - lu(k,121) * b(k,61) + b(k,223) = b(k,223) - lu(k,122) * b(k,61) + b(k,89) = b(k,89) - lu(k,124) * b(k,62) + b(k,216) = b(k,216) - lu(k,125) * b(k,62) + b(k,223) = b(k,223) - lu(k,126) * b(k,62) + b(k,217) = b(k,217) - lu(k,128) * b(k,63) + b(k,223) = b(k,223) - lu(k,129) * b(k,63) + b(k,229) = b(k,229) - lu(k,130) * b(k,63) + b(k,96) = b(k,96) - lu(k,132) * b(k,64) + b(k,217) = b(k,217) - lu(k,133) * b(k,64) + b(k,93) = b(k,93) - lu(k,135) * b(k,65) + b(k,229) = b(k,229) - lu(k,136) * b(k,65) + b(k,199) = b(k,199) - lu(k,138) * b(k,66) + b(k,217) = b(k,217) - lu(k,139) * b(k,66) + b(k,138) = b(k,138) - lu(k,141) * b(k,67) + b(k,222) = b(k,222) - lu(k,142) * b(k,67) + b(k,89) = b(k,89) - lu(k,144) * b(k,68) + b(k,211) = b(k,211) - lu(k,145) * b(k,68) + b(k,216) = b(k,216) - lu(k,146) * b(k,68) + b(k,223) = b(k,223) - lu(k,147) * b(k,68) + b(k,89) = b(k,89) - lu(k,149) * b(k,69) + b(k,177) = b(k,177) - lu(k,150) * b(k,69) + b(k,211) = b(k,211) - lu(k,151) * b(k,69) + b(k,216) = b(k,216) - lu(k,152) * b(k,69) + b(k,89) = b(k,89) - lu(k,154) * b(k,70) + b(k,91) = b(k,91) - lu(k,155) * b(k,70) + b(k,216) = b(k,216) - lu(k,156) * b(k,70) + b(k,223) = b(k,223) - lu(k,157) * b(k,70) + b(k,89) = b(k,89) - lu(k,159) * b(k,71) + b(k,177) = b(k,177) - lu(k,160) * b(k,71) + b(k,216) = b(k,216) - lu(k,161) * b(k,71) + b(k,223) = b(k,223) - lu(k,162) * b(k,71) + b(k,73) = b(k,73) - lu(k,165) * b(k,72) + b(k,74) = b(k,74) - lu(k,166) * b(k,72) + b(k,133) = b(k,133) - lu(k,167) * b(k,72) + b(k,217) = b(k,217) - lu(k,168) * b(k,72) + b(k,224) = b(k,224) - lu(k,169) * b(k,72) + b(k,129) = b(k,129) - lu(k,171) * b(k,73) + b(k,195) = b(k,195) - lu(k,172) * b(k,73) + b(k,224) = b(k,224) - lu(k,173) * b(k,73) + b(k,127) = b(k,127) - lu(k,175) * b(k,74) + b(k,130) = b(k,130) - lu(k,176) * b(k,74) + b(k,217) = b(k,217) - lu(k,177) * b(k,74) + b(k,224) = b(k,224) - lu(k,178) * b(k,74) + b(k,223) = b(k,223) - lu(k,180) * b(k,75) + b(k,216) = b(k,216) - lu(k,182) * b(k,76) + b(k,217) = b(k,217) - lu(k,183) * b(k,76) + b(k,224) = b(k,224) - lu(k,184) * b(k,76) + b(k,216) = b(k,216) - lu(k,186) * b(k,77) + b(k,221) = b(k,221) - lu(k,187) * b(k,77) + b(k,79) = b(k,79) - lu(k,190) * b(k,78) + b(k,80) = b(k,80) - lu(k,191) * b(k,78) + b(k,125) = b(k,125) - lu(k,192) * b(k,78) + b(k,162) = b(k,162) - lu(k,193) * b(k,78) + b(k,217) = b(k,217) - lu(k,194) * b(k,78) + b(k,224) = b(k,224) - lu(k,195) * b(k,78) + b(k,127) = b(k,127) - lu(k,197) * b(k,79) + b(k,130) = b(k,130) - lu(k,198) * b(k,79) + b(k,217) = b(k,217) - lu(k,199) * b(k,79) + b(k,224) = b(k,224) - lu(k,200) * b(k,79) + b(k,195) = b(k,195) - lu(k,202) * b(k,80) + b(k,209) = b(k,209) - lu(k,203) * b(k,80) + b(k,224) = b(k,224) - lu(k,204) * b(k,80) + b(k,199) = b(k,199) - lu(k,206) * b(k,81) + b(k,217) = b(k,217) - lu(k,207) * b(k,81) + b(k,83) = b(k,83) - lu(k,211) * b(k,82) + b(k,125) = b(k,125) - lu(k,212) * b(k,82) + b(k,164) = b(k,164) - lu(k,213) * b(k,82) + b(k,195) = b(k,195) - lu(k,214) * b(k,82) + b(k,209) = b(k,209) - lu(k,215) * b(k,82) + b(k,217) = b(k,217) - lu(k,216) * b(k,82) + b(k,224) = b(k,224) - lu(k,217) * b(k,82) + b(k,130) = b(k,130) - lu(k,219) * b(k,83) + b(k,135) = b(k,135) - lu(k,220) * b(k,83) + b(k,217) = b(k,217) - lu(k,221) * b(k,83) + b(k,224) = b(k,224) - lu(k,222) * b(k,83) + b(k,147) = b(k,147) - lu(k,224) * b(k,84) + b(k,199) = b(k,199) - lu(k,225) * b(k,84) + b(k,217) = b(k,217) - lu(k,226) * b(k,84) + b(k,224) = b(k,224) - lu(k,227) * b(k,84) + b(k,179) = b(k,179) - lu(k,229) * b(k,85) + b(k,217) = b(k,217) - lu(k,230) * b(k,85) + b(k,211) = b(k,211) - lu(k,232) * b(k,86) + b(k,223) = b(k,223) - lu(k,233) * b(k,86) + b(k,214) = b(k,214) - lu(k,235) * b(k,87) + b(k,222) = b(k,222) - lu(k,236) * b(k,87) + b(k,138) = b(k,138) - lu(k,238) * b(k,88) + b(k,217) = b(k,217) - lu(k,239) * b(k,88) + b(k,177) = b(k,177) - lu(k,241) * b(k,89) + b(k,216) = b(k,216) - lu(k,242) * b(k,89) + b(k,91) = b(k,91) - lu(k,244) * b(k,90) + b(k,216) = b(k,216) - lu(k,245) * b(k,90) + b(k,217) = b(k,217) - lu(k,246) * b(k,90) + b(k,223) = b(k,223) - lu(k,247) * b(k,90) + b(k,177) = b(k,177) - lu(k,249) * b(k,91) + b(k,216) = b(k,216) - lu(k,250) * b(k,91) + b(k,223) = b(k,223) - lu(k,251) * b(k,91) + b(k,177) = b(k,177) - lu(k,254) * b(k,92) + b(k,216) = b(k,216) - lu(k,255) * b(k,92) + b(k,217) = b(k,217) - lu(k,256) * b(k,92) + b(k,223) = b(k,223) - lu(k,257) * b(k,92) + b(k,175) = b(k,175) - lu(k,260) * b(k,93) + b(k,227) = b(k,227) - lu(k,261) * b(k,93) + b(k,229) = b(k,229) - lu(k,262) * b(k,93) + b(k,192) = b(k,192) - lu(k,264) * b(k,94) + b(k,217) = b(k,217) - lu(k,265) * b(k,94) + b(k,224) = b(k,224) - lu(k,266) * b(k,94) + b(k,130) = b(k,130) - lu(k,268) * b(k,95) + b(k,152) = b(k,152) - lu(k,269) * b(k,95) + b(k,217) = b(k,217) - lu(k,270) * b(k,95) + b(k,193) = b(k,193) - lu(k,272) * b(k,96) + b(k,215) = b(k,215) - lu(k,273) * b(k,96) + b(k,224) = b(k,224) - lu(k,274) * b(k,96) + b(k,214) = b(k,214) - lu(k,276) * b(k,97) + b(k,219) = b(k,219) - lu(k,277) * b(k,97) + b(k,221) = b(k,221) - lu(k,278) * b(k,97) + b(k,222) = b(k,222) - lu(k,279) * b(k,97) + b(k,227) = b(k,227) - lu(k,280) * b(k,97) + b(k,165) = b(k,165) - lu(k,282) * b(k,98) + b(k,224) = b(k,224) - lu(k,283) * b(k,98) + b(k,175) = b(k,175) - lu(k,285) * b(k,99) + b(k,214) = b(k,214) - lu(k,286) * b(k,99) + b(k,217) = b(k,217) - lu(k,287) * b(k,99) + b(k,219) = b(k,219) - lu(k,288) * b(k,99) + b(k,224) = b(k,224) - lu(k,289) * b(k,99) + b(k,177) = b(k,177) - lu(k,291) * b(k,100) + b(k,213) = b(k,213) - lu(k,292) * b(k,100) + b(k,183) = b(k,183) - lu(k,294) * b(k,101) + b(k,186) = b(k,186) - lu(k,295) * b(k,101) + b(k,195) = b(k,195) - lu(k,296) * b(k,101) + b(k,217) = b(k,217) - lu(k,297) * b(k,101) + b(k,224) = b(k,224) - lu(k,298) * b(k,101) + b(k,177) = b(k,177) - lu(k,301) * b(k,102) + b(k,216) = b(k,216) - lu(k,302) * b(k,102) + b(k,217) = b(k,217) - lu(k,303) * b(k,102) + b(k,223) = b(k,223) - lu(k,304) * b(k,102) + b(k,229) = b(k,229) - lu(k,305) * b(k,102) + b(k,173) = b(k,173) - lu(k,307) * b(k,103) + b(k,217) = b(k,217) - lu(k,308) * b(k,103) + b(k,223) = b(k,223) - lu(k,309) * b(k,103) + b(k,225) = b(k,225) - lu(k,310) * b(k,103) + b(k,229) = b(k,229) - lu(k,311) * b(k,103) + b(k,206) = b(k,206) - lu(k,313) * b(k,104) + b(k,208) = b(k,208) - lu(k,314) * b(k,104) + b(k,217) = b(k,217) - lu(k,315) * b(k,104) + b(k,224) = b(k,224) - lu(k,316) * b(k,104) + b(k,157) = b(k,157) - lu(k,318) * b(k,105) + b(k,192) = b(k,192) - lu(k,319) * b(k,105) + b(k,209) = b(k,209) - lu(k,320) * b(k,105) + b(k,217) = b(k,217) - lu(k,321) * b(k,105) + b(k,195) = b(k,195) - lu(k,323) * b(k,106) + b(k,202) = b(k,202) - lu(k,324) * b(k,106) + b(k,209) = b(k,209) - lu(k,325) * b(k,106) + b(k,224) = b(k,224) - lu(k,326) * b(k,106) + b(k,175) = b(k,175) - lu(k,328) * b(k,107) + b(k,203) = b(k,203) - lu(k,329) * b(k,107) + b(k,218) = b(k,218) - lu(k,330) * b(k,107) + b(k,227) = b(k,227) - lu(k,331) * b(k,107) + b(k,127) = b(k,127) - lu(k,333) * b(k,108) + b(k,186) = b(k,186) - lu(k,334) * b(k,108) + b(k,217) = b(k,217) - lu(k,335) * b(k,108) + b(k,224) = b(k,224) - lu(k,336) * b(k,108) + b(k,125) = b(k,125) - lu(k,339) * b(k,109) + b(k,138) = b(k,138) - lu(k,340) * b(k,109) + b(k,217) = b(k,217) - lu(k,341) * b(k,109) + b(k,224) = b(k,224) - lu(k,342) * b(k,109) + b(k,173) = b(k,173) - lu(k,344) * b(k,110) + b(k,192) = b(k,192) - lu(k,345) * b(k,110) + b(k,217) = b(k,217) - lu(k,346) * b(k,110) + b(k,224) = b(k,224) - lu(k,347) * b(k,110) + b(k,199) = b(k,199) - lu(k,349) * b(k,111) + b(k,217) = b(k,217) - lu(k,350) * b(k,111) + b(k,144) = b(k,144) - lu(k,352) * b(k,112) + b(k,182) = b(k,182) - lu(k,353) * b(k,112) + b(k,192) = b(k,192) - lu(k,354) * b(k,112) + b(k,215) = b(k,215) - lu(k,355) * b(k,112) + b(k,217) = b(k,217) - lu(k,356) * b(k,112) + b(k,219) = b(k,219) - lu(k,357) * b(k,112) + b(k,222) = b(k,222) - lu(k,358) * b(k,112) + b(k,137) = b(k,137) - lu(k,360) * b(k,113) + b(k,175) = b(k,175) - lu(k,361) * b(k,113) + b(k,195) = b(k,195) - lu(k,362) * b(k,113) + b(k,203) = b(k,203) - lu(k,363) * b(k,113) + b(k,213) = b(k,213) - lu(k,364) * b(k,113) + b(k,217) = b(k,217) - lu(k,365) * b(k,113) + b(k,227) = b(k,227) - lu(k,366) * b(k,113) + 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,195) = b(k,195) - lu(k,368) * b(k,114) + b(k,217) = b(k,217) - lu(k,369) * b(k,114) + b(k,220) = b(k,220) - lu(k,370) * b(k,114) + b(k,223) = b(k,223) - lu(k,371) * b(k,114) + b(k,224) = b(k,224) - lu(k,372) * b(k,114) + b(k,225) = b(k,225) - lu(k,373) * b(k,114) + b(k,229) = b(k,229) - lu(k,374) * b(k,114) + b(k,176) = b(k,176) - lu(k,376) * b(k,115) + b(k,193) = b(k,193) - lu(k,377) * b(k,115) + b(k,214) = b(k,214) - lu(k,378) * b(k,115) + b(k,217) = b(k,217) - lu(k,379) * b(k,115) + b(k,224) = b(k,224) - lu(k,380) * b(k,115) + b(k,186) = b(k,186) - lu(k,382) * b(k,116) + b(k,195) = b(k,195) - lu(k,383) * b(k,116) + b(k,202) = b(k,202) - lu(k,384) * b(k,116) + b(k,209) = b(k,209) - lu(k,385) * b(k,116) + b(k,224) = b(k,224) - lu(k,386) * b(k,116) + b(k,211) = b(k,211) - lu(k,388) * b(k,117) + b(k,216) = b(k,216) - lu(k,389) * b(k,117) + b(k,217) = b(k,217) - lu(k,390) * b(k,117) + b(k,223) = b(k,223) - lu(k,391) * b(k,117) + b(k,225) = b(k,225) - lu(k,392) * b(k,117) + b(k,185) = b(k,185) - lu(k,394) * b(k,118) + b(k,189) = b(k,189) - lu(k,395) * b(k,118) + b(k,214) = b(k,214) - lu(k,396) * b(k,118) + b(k,217) = b(k,217) - lu(k,397) * b(k,118) + b(k,222) = b(k,222) - lu(k,398) * b(k,118) + b(k,196) = b(k,196) - lu(k,400) * b(k,119) + b(k,209) = b(k,209) - lu(k,401) * b(k,119) + b(k,215) = b(k,215) - lu(k,402) * b(k,119) + b(k,217) = b(k,217) - lu(k,403) * b(k,119) + b(k,229) = b(k,229) - lu(k,404) * b(k,119) + b(k,163) = b(k,163) - lu(k,406) * b(k,120) + b(k,176) = b(k,176) - lu(k,407) * b(k,120) + b(k,217) = b(k,217) - lu(k,408) * b(k,120) + b(k,222) = b(k,222) - lu(k,409) * b(k,120) + b(k,224) = b(k,224) - lu(k,410) * b(k,120) + b(k,168) = b(k,168) - lu(k,412) * b(k,121) + b(k,182) = b(k,182) - lu(k,413) * b(k,121) + b(k,217) = b(k,217) - lu(k,414) * b(k,121) + b(k,224) = b(k,224) - lu(k,415) * b(k,121) + b(k,229) = b(k,229) - lu(k,416) * b(k,121) + b(k,129) = b(k,129) - lu(k,418) * b(k,122) + b(k,133) = b(k,133) - lu(k,419) * b(k,122) + b(k,186) = b(k,186) - lu(k,420) * b(k,122) + b(k,217) = b(k,217) - lu(k,421) * b(k,122) + b(k,224) = b(k,224) - lu(k,422) * b(k,122) + b(k,217) = b(k,217) - lu(k,424) * b(k,123) + b(k,219) = b(k,219) - lu(k,425) * b(k,123) + b(k,222) = b(k,222) - lu(k,426) * b(k,123) + b(k,224) = b(k,224) - lu(k,427) * b(k,123) + b(k,229) = b(k,229) - lu(k,428) * b(k,123) + b(k,135) = b(k,135) - lu(k,430) * b(k,124) + b(k,186) = b(k,186) - lu(k,431) * b(k,124) + b(k,202) = b(k,202) - lu(k,432) * b(k,124) + b(k,217) = b(k,217) - lu(k,433) * b(k,124) + b(k,224) = b(k,224) - lu(k,434) * b(k,124) + b(k,138) = b(k,138) - lu(k,438) * b(k,125) + b(k,217) = b(k,217) - lu(k,439) * b(k,125) + b(k,221) = b(k,221) - lu(k,440) * b(k,125) + b(k,222) = b(k,222) - lu(k,441) * b(k,125) + b(k,224) = b(k,224) - lu(k,442) * b(k,125) + b(k,183) = b(k,183) - lu(k,444) * b(k,126) + b(k,215) = b(k,215) - lu(k,445) * b(k,126) + b(k,221) = b(k,221) - lu(k,446) * b(k,126) + b(k,222) = b(k,222) - lu(k,447) * b(k,126) + b(k,224) = b(k,224) - lu(k,448) * b(k,126) + b(k,186) = b(k,186) - lu(k,451) * b(k,127) + b(k,217) = b(k,217) - lu(k,452) * b(k,127) + b(k,221) = b(k,221) - lu(k,453) * b(k,127) + b(k,222) = b(k,222) - lu(k,454) * b(k,127) + b(k,224) = b(k,224) - lu(k,455) * b(k,127) + b(k,213) = b(k,213) - lu(k,457) * b(k,128) + b(k,215) = b(k,215) - lu(k,458) * b(k,128) + b(k,217) = b(k,217) - lu(k,459) * b(k,128) + b(k,220) = b(k,220) - lu(k,460) * b(k,128) + b(k,229) = b(k,229) - lu(k,461) * b(k,128) + b(k,161) = b(k,161) - lu(k,463) * b(k,129) + b(k,224) = b(k,224) - lu(k,464) * b(k,129) + b(k,152) = b(k,152) - lu(k,466) * b(k,130) + b(k,222) = b(k,222) - lu(k,467) * b(k,130) + b(k,228) = b(k,228) - lu(k,468) * b(k,130) + b(k,211) = b(k,211) - lu(k,470) * b(k,131) + b(k,216) = b(k,216) - lu(k,471) * b(k,131) + b(k,217) = b(k,217) - lu(k,472) * b(k,131) + b(k,223) = b(k,223) - lu(k,473) * b(k,131) + b(k,225) = b(k,225) - lu(k,474) * b(k,131) + b(k,229) = b(k,229) - lu(k,475) * b(k,131) + b(k,181) = b(k,181) - lu(k,477) * b(k,132) + b(k,182) = b(k,182) - lu(k,478) * b(k,132) + b(k,185) = b(k,185) - lu(k,479) * b(k,132) + b(k,215) = b(k,215) - lu(k,480) * b(k,132) + b(k,217) = b(k,217) - lu(k,481) * b(k,132) + b(k,224) = b(k,224) - lu(k,482) * b(k,132) + b(k,161) = b(k,161) - lu(k,486) * b(k,133) + b(k,186) = b(k,186) - lu(k,487) * b(k,133) + b(k,217) = b(k,217) - lu(k,488) * b(k,133) + b(k,221) = b(k,221) - lu(k,489) * b(k,133) + b(k,222) = b(k,222) - lu(k,490) * b(k,133) + b(k,224) = b(k,224) - lu(k,491) * b(k,133) + b(k,213) = b(k,213) - lu(k,494) * b(k,134) + b(k,216) = b(k,216) - lu(k,495) * b(k,134) + b(k,217) = b(k,217) - lu(k,496) * b(k,134) + b(k,221) = b(k,221) - lu(k,497) * b(k,134) + b(k,222) = b(k,222) - lu(k,498) * b(k,134) + b(k,227) = b(k,227) - lu(k,499) * b(k,134) + b(k,186) = b(k,186) - lu(k,502) * b(k,135) + b(k,202) = b(k,202) - lu(k,503) * b(k,135) + b(k,217) = b(k,217) - lu(k,504) * b(k,135) + b(k,221) = b(k,221) - lu(k,505) * b(k,135) + b(k,222) = b(k,222) - lu(k,506) * b(k,135) + b(k,224) = b(k,224) - lu(k,507) * b(k,135) + b(k,157) = b(k,157) - lu(k,509) * b(k,136) + b(k,173) = b(k,173) - lu(k,510) * b(k,136) + b(k,209) = b(k,209) - lu(k,511) * b(k,136) + b(k,217) = b(k,217) - lu(k,512) * b(k,136) + b(k,203) = b(k,203) - lu(k,514) * b(k,137) + b(k,213) = b(k,213) - lu(k,515) * b(k,137) + b(k,217) = b(k,217) - lu(k,516) * b(k,137) + b(k,227) = b(k,227) - lu(k,517) * b(k,137) + b(k,228) = b(k,228) - lu(k,518) * b(k,137) + b(k,152) = b(k,152) - lu(k,521) * b(k,138) + b(k,217) = b(k,217) - lu(k,522) * b(k,138) + b(k,221) = b(k,221) - lu(k,523) * b(k,138) + b(k,222) = b(k,222) - lu(k,524) * b(k,138) + b(k,224) = b(k,224) - lu(k,525) * b(k,138) + b(k,170) = b(k,170) - lu(k,527) * b(k,139) + b(k,209) = b(k,209) - lu(k,528) * b(k,139) + b(k,215) = b(k,215) - lu(k,529) * b(k,139) + b(k,217) = b(k,217) - lu(k,530) * b(k,139) + b(k,219) = b(k,219) - lu(k,531) * b(k,139) + b(k,220) = b(k,220) - lu(k,532) * b(k,139) + b(k,222) = b(k,222) - lu(k,533) * b(k,139) + b(k,176) = b(k,176) - lu(k,535) * b(k,140) + b(k,193) = b(k,193) - lu(k,536) * b(k,140) + b(k,197) = b(k,197) - lu(k,537) * b(k,140) + b(k,198) = b(k,198) - lu(k,538) * b(k,140) + b(k,214) = b(k,214) - lu(k,539) * b(k,140) + b(k,217) = b(k,217) - lu(k,540) * b(k,140) + b(k,224) = b(k,224) - lu(k,541) * b(k,140) + b(k,166) = b(k,166) - lu(k,543) * b(k,141) + b(k,192) = b(k,192) - lu(k,544) * b(k,141) + b(k,197) = b(k,197) - lu(k,545) * b(k,141) + b(k,215) = b(k,215) - lu(k,546) * b(k,141) + b(k,217) = b(k,217) - lu(k,547) * b(k,141) + b(k,224) = b(k,224) - lu(k,548) * b(k,141) + b(k,229) = b(k,229) - lu(k,549) * b(k,141) + b(k,160) = b(k,160) - lu(k,551) * b(k,142) + b(k,183) = b(k,183) - lu(k,552) * b(k,142) + b(k,195) = b(k,195) - lu(k,553) * b(k,142) + b(k,215) = b(k,215) - lu(k,554) * b(k,142) + b(k,217) = b(k,217) - lu(k,555) * b(k,142) + b(k,224) = b(k,224) - lu(k,556) * b(k,142) + b(k,228) = b(k,228) - lu(k,557) * b(k,142) + b(k,167) = b(k,167) - lu(k,559) * b(k,143) + b(k,211) = b(k,211) - lu(k,560) * b(k,143) + b(k,214) = b(k,214) - lu(k,561) * b(k,143) + b(k,219) = b(k,219) - lu(k,562) * b(k,143) + b(k,222) = b(k,222) - lu(k,563) * b(k,143) + b(k,226) = b(k,226) - lu(k,564) * b(k,143) + b(k,227) = b(k,227) - lu(k,565) * b(k,143) + b(k,182) = b(k,182) - lu(k,567) * b(k,144) + b(k,192) = b(k,192) - lu(k,568) * b(k,144) + b(k,198) = b(k,198) - lu(k,569) * b(k,144) + b(k,215) = b(k,215) - lu(k,570) * b(k,144) + b(k,221) = b(k,221) - lu(k,571) * b(k,144) + b(k,222) = b(k,222) - lu(k,572) * b(k,144) + b(k,224) = b(k,224) - lu(k,573) * b(k,144) + b(k,170) = b(k,170) - lu(k,575) * b(k,145) + b(k,197) = b(k,197) - lu(k,576) * b(k,145) + b(k,208) = b(k,208) - lu(k,577) * b(k,145) + b(k,215) = b(k,215) - lu(k,578) * b(k,145) + b(k,217) = b(k,217) - lu(k,579) * b(k,145) + b(k,219) = b(k,219) - lu(k,580) * b(k,145) + b(k,222) = b(k,222) - lu(k,581) * b(k,145) + b(k,224) = b(k,224) - lu(k,582) * b(k,145) + b(k,193) = b(k,193) - lu(k,584) * b(k,146) + b(k,197) = b(k,197) - lu(k,585) * b(k,146) + b(k,198) = b(k,198) - lu(k,586) * b(k,146) + b(k,214) = b(k,214) - lu(k,587) * b(k,146) + b(k,215) = b(k,215) - lu(k,588) * b(k,146) + b(k,217) = b(k,217) - lu(k,589) * b(k,146) + b(k,222) = b(k,222) - lu(k,590) * b(k,146) + b(k,224) = b(k,224) - lu(k,591) * b(k,146) + b(k,178) = b(k,178) - lu(k,593) * b(k,147) + b(k,195) = b(k,195) - lu(k,594) * b(k,147) + b(k,224) = b(k,224) - lu(k,595) * b(k,147) + b(k,211) = b(k,211) - lu(k,597) * b(k,148) + b(k,216) = b(k,216) - lu(k,598) * b(k,148) + b(k,217) = b(k,217) - lu(k,599) * b(k,148) + b(k,220) = b(k,220) - lu(k,600) * b(k,148) + b(k,223) = b(k,223) - lu(k,601) * b(k,148) + b(k,224) = b(k,224) - lu(k,602) * b(k,148) + b(k,225) = b(k,225) - lu(k,603) * b(k,148) + b(k,229) = b(k,229) - lu(k,604) * b(k,148) + b(k,217) = b(k,217) - lu(k,606) * b(k,149) + b(k,223) = b(k,223) - lu(k,607) * b(k,149) + b(k,224) = b(k,224) - lu(k,608) * b(k,149) + b(k,225) = b(k,225) - lu(k,609) * b(k,149) + b(k,227) = b(k,227) - lu(k,610) * b(k,149) + b(k,229) = b(k,229) - lu(k,611) * b(k,149) + 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,170) = b(k,170) - lu(k,613) * b(k,150) + b(k,209) = b(k,209) - lu(k,614) * b(k,150) + b(k,215) = b(k,215) - lu(k,615) * b(k,150) + b(k,217) = b(k,217) - lu(k,616) * b(k,150) + b(k,220) = b(k,220) - lu(k,617) * b(k,150) + b(k,229) = b(k,229) - lu(k,618) * b(k,150) + b(k,185) = b(k,185) - lu(k,620) * b(k,151) + b(k,214) = b(k,214) - lu(k,621) * b(k,151) + b(k,217) = b(k,217) - lu(k,622) * b(k,151) + b(k,222) = b(k,222) - lu(k,623) * b(k,151) + b(k,224) = b(k,224) - lu(k,624) * b(k,151) + b(k,217) = b(k,217) - lu(k,628) * b(k,152) + b(k,221) = b(k,221) - lu(k,629) * b(k,152) + b(k,222) = b(k,222) - lu(k,630) * b(k,152) + b(k,224) = b(k,224) - lu(k,631) * b(k,152) + b(k,228) = b(k,228) - lu(k,632) * b(k,152) + b(k,157) = b(k,157) - lu(k,635) * b(k,153) + b(k,173) = b(k,173) - lu(k,636) * b(k,153) + b(k,182) = b(k,182) - lu(k,637) * b(k,153) + b(k,192) = b(k,192) - lu(k,638) * b(k,153) + b(k,209) = b(k,209) - lu(k,639) * b(k,153) + b(k,215) = b(k,215) - lu(k,640) * b(k,153) + b(k,217) = b(k,217) - lu(k,641) * b(k,153) + b(k,222) = b(k,222) - lu(k,642) * b(k,153) + b(k,224) = b(k,224) - lu(k,643) * b(k,153) + b(k,170) = b(k,170) - lu(k,645) * b(k,154) + b(k,182) = b(k,182) - lu(k,646) * b(k,154) + b(k,190) = b(k,190) - lu(k,647) * b(k,154) + b(k,193) = b(k,193) - lu(k,648) * b(k,154) + b(k,194) = b(k,194) - lu(k,649) * b(k,154) + b(k,195) = b(k,195) - lu(k,650) * b(k,154) + b(k,215) = b(k,215) - lu(k,651) * b(k,154) + b(k,217) = b(k,217) - lu(k,652) * b(k,154) + b(k,224) = b(k,224) - lu(k,653) * b(k,154) + b(k,161) = b(k,161) - lu(k,658) * b(k,155) + b(k,162) = b(k,162) - lu(k,659) * b(k,155) + b(k,165) = b(k,165) - lu(k,660) * b(k,155) + b(k,178) = b(k,178) - lu(k,661) * b(k,155) + b(k,186) = b(k,186) - lu(k,662) * b(k,155) + b(k,195) = b(k,195) - lu(k,663) * b(k,155) + b(k,202) = b(k,202) - lu(k,664) * b(k,155) + b(k,217) = b(k,217) - lu(k,665) * b(k,155) + b(k,224) = b(k,224) - lu(k,666) * b(k,155) + b(k,157) = b(k,157) - lu(k,669) * b(k,156) + b(k,173) = b(k,173) - lu(k,670) * b(k,156) + b(k,179) = b(k,179) - lu(k,671) * b(k,156) + b(k,182) = b(k,182) - lu(k,672) * b(k,156) + b(k,192) = b(k,192) - lu(k,673) * b(k,156) + b(k,209) = b(k,209) - lu(k,674) * b(k,156) + b(k,215) = b(k,215) - lu(k,675) * b(k,156) + b(k,217) = b(k,217) - lu(k,676) * b(k,156) + b(k,224) = b(k,224) - lu(k,677) * b(k,156) + b(k,192) = b(k,192) - lu(k,680) * b(k,157) + b(k,209) = b(k,209) - lu(k,681) * b(k,157) + b(k,217) = b(k,217) - lu(k,682) * b(k,157) + b(k,221) = b(k,221) - lu(k,683) * b(k,157) + b(k,222) = b(k,222) - lu(k,684) * b(k,157) + b(k,224) = b(k,224) - lu(k,685) * b(k,157) + b(k,170) = b(k,170) - lu(k,687) * b(k,158) + b(k,217) = b(k,217) - lu(k,688) * b(k,158) + b(k,220) = b(k,220) - lu(k,689) * b(k,158) + b(k,229) = b(k,229) - lu(k,690) * b(k,158) + b(k,161) = b(k,161) - lu(k,696) * b(k,159) + b(k,164) = b(k,164) - lu(k,697) * b(k,159) + b(k,165) = b(k,165) - lu(k,698) * b(k,159) + b(k,178) = b(k,178) - lu(k,699) * b(k,159) + b(k,186) = b(k,186) - lu(k,700) * b(k,159) + b(k,195) = b(k,195) - lu(k,701) * b(k,159) + b(k,202) = b(k,202) - lu(k,702) * b(k,159) + b(k,209) = b(k,209) - lu(k,703) * b(k,159) + b(k,217) = b(k,217) - lu(k,704) * b(k,159) + b(k,224) = b(k,224) - lu(k,705) * b(k,159) + b(k,193) = b(k,193) - lu(k,709) * b(k,160) + b(k,215) = b(k,215) - lu(k,710) * b(k,160) + b(k,217) = b(k,217) - lu(k,711) * b(k,160) + b(k,221) = b(k,221) - lu(k,712) * b(k,160) + b(k,222) = b(k,222) - lu(k,713) * b(k,160) + b(k,224) = b(k,224) - lu(k,714) * b(k,160) + b(k,186) = b(k,186) - lu(k,716) * b(k,161) + b(k,195) = b(k,195) - lu(k,717) * b(k,161) + b(k,221) = b(k,221) - lu(k,718) * b(k,161) + b(k,222) = b(k,222) - lu(k,719) * b(k,161) + b(k,224) = b(k,224) - lu(k,720) * b(k,161) + b(k,165) = b(k,165) - lu(k,727) * b(k,162) + b(k,178) = b(k,178) - lu(k,728) * b(k,162) + b(k,186) = b(k,186) - lu(k,729) * b(k,162) + b(k,195) = b(k,195) - lu(k,730) * b(k,162) + b(k,202) = b(k,202) - lu(k,731) * b(k,162) + b(k,217) = b(k,217) - lu(k,732) * b(k,162) + b(k,221) = b(k,221) - lu(k,733) * b(k,162) + b(k,222) = b(k,222) - lu(k,734) * b(k,162) + b(k,224) = b(k,224) - lu(k,735) * b(k,162) + b(k,199) = b(k,199) - lu(k,738) * b(k,163) + b(k,201) = b(k,201) - lu(k,739) * b(k,163) + b(k,207) = b(k,207) - lu(k,740) * b(k,163) + b(k,215) = b(k,215) - lu(k,741) * b(k,163) + b(k,217) = b(k,217) - lu(k,742) * b(k,163) + b(k,224) = b(k,224) - lu(k,743) * b(k,163) + b(k,165) = b(k,165) - lu(k,751) * b(k,164) + b(k,178) = b(k,178) - lu(k,752) * b(k,164) + b(k,186) = b(k,186) - lu(k,753) * b(k,164) + b(k,195) = b(k,195) - lu(k,754) * b(k,164) + b(k,202) = b(k,202) - lu(k,755) * b(k,164) + b(k,209) = b(k,209) - lu(k,756) * b(k,164) + b(k,217) = b(k,217) - lu(k,757) * b(k,164) + b(k,221) = b(k,221) - lu(k,758) * b(k,164) + b(k,222) = b(k,222) - lu(k,759) * b(k,164) + b(k,224) = b(k,224) - lu(k,760) * b(k,164) + b(k,195) = b(k,195) - lu(k,762) * b(k,165) + b(k,202) = b(k,202) - lu(k,763) * b(k,165) + b(k,217) = b(k,217) - lu(k,764) * b(k,165) + b(k,220) = b(k,220) - lu(k,765) * b(k,165) + b(k,221) = b(k,221) - lu(k,766) * b(k,165) + b(k,222) = b(k,222) - lu(k,767) * b(k,165) + b(k,224) = b(k,224) - lu(k,768) * b(k,165) + b(k,192) = b(k,192) - lu(k,771) * b(k,166) + b(k,197) = b(k,197) - lu(k,772) * b(k,166) + b(k,215) = b(k,215) - lu(k,773) * b(k,166) + b(k,217) = b(k,217) - lu(k,774) * b(k,166) + b(k,221) = b(k,221) - lu(k,775) * b(k,166) + b(k,222) = b(k,222) - lu(k,776) * b(k,166) + b(k,224) = b(k,224) - lu(k,777) * b(k,166) + b(k,229) = b(k,229) - lu(k,778) * b(k,166) + b(k,211) = b(k,211) - lu(k,781) * b(k,167) + b(k,217) = b(k,217) - lu(k,782) * b(k,167) + b(k,223) = b(k,223) - lu(k,783) * b(k,167) + b(k,225) = b(k,225) - lu(k,784) * b(k,167) + b(k,226) = b(k,226) - lu(k,785) * b(k,167) + b(k,227) = b(k,227) - lu(k,786) * b(k,167) + b(k,229) = b(k,229) - lu(k,787) * b(k,167) + b(k,182) = b(k,182) - lu(k,790) * b(k,168) + b(k,192) = b(k,192) - lu(k,791) * b(k,168) + b(k,215) = b(k,215) - lu(k,792) * b(k,168) + b(k,217) = b(k,217) - lu(k,793) * b(k,168) + b(k,220) = b(k,220) - lu(k,794) * b(k,168) + b(k,221) = b(k,221) - lu(k,795) * b(k,168) + b(k,222) = b(k,222) - lu(k,796) * b(k,168) + b(k,224) = b(k,224) - lu(k,797) * b(k,168) + b(k,229) = b(k,229) - lu(k,798) * b(k,168) + b(k,215) = b(k,215) - lu(k,800) * b(k,169) + b(k,217) = b(k,217) - lu(k,801) * b(k,169) + b(k,224) = b(k,224) - lu(k,802) * b(k,169) + b(k,195) = b(k,195) - lu(k,804) * b(k,170) + b(k,227) = b(k,227) - lu(k,805) * b(k,170) + b(k,211) = b(k,211) - lu(k,807) * b(k,171) + b(k,213) = b(k,213) - lu(k,808) * b(k,171) + b(k,216) = b(k,216) - lu(k,809) * b(k,171) + b(k,217) = b(k,217) - lu(k,810) * b(k,171) + b(k,226) = b(k,226) - lu(k,811) * b(k,171) + b(k,227) = b(k,227) - lu(k,812) * b(k,171) + b(k,229) = b(k,229) - lu(k,813) * b(k,171) + b(k,217) = b(k,217) - lu(k,816) * b(k,172) + b(k,218) = b(k,218) - lu(k,817) * b(k,172) + b(k,223) = b(k,223) - lu(k,818) * b(k,172) + b(k,225) = b(k,225) - lu(k,819) * b(k,172) + b(k,227) = b(k,227) - lu(k,820) * b(k,172) + b(k,229) = b(k,229) - lu(k,821) * b(k,172) + b(k,192) = b(k,192) - lu(k,826) * b(k,173) + b(k,215) = b(k,215) - lu(k,827) * b(k,173) + b(k,217) = b(k,217) - lu(k,828) * b(k,173) + b(k,220) = b(k,220) - lu(k,829) * b(k,173) + b(k,221) = b(k,221) - lu(k,830) * b(k,173) + b(k,222) = b(k,222) - lu(k,831) * b(k,173) + b(k,224) = b(k,224) - lu(k,832) * b(k,173) + b(k,183) = b(k,183) - lu(k,837) * b(k,174) + b(k,188) = b(k,188) - lu(k,838) * b(k,174) + b(k,195) = b(k,195) - lu(k,839) * b(k,174) + b(k,200) = b(k,200) - lu(k,840) * b(k,174) + b(k,201) = b(k,201) - lu(k,841) * b(k,174) + b(k,204) = b(k,204) - lu(k,842) * b(k,174) + b(k,205) = b(k,205) - lu(k,843) * b(k,174) + b(k,207) = b(k,207) - lu(k,844) * b(k,174) + b(k,209) = b(k,209) - lu(k,845) * b(k,174) + b(k,215) = b(k,215) - lu(k,846) * b(k,174) + b(k,217) = b(k,217) - lu(k,847) * b(k,174) + b(k,219) = b(k,219) - lu(k,848) * b(k,174) + b(k,220) = b(k,220) - lu(k,849) * b(k,174) + b(k,224) = b(k,224) - lu(k,850) * b(k,174) + b(k,228) = b(k,228) - lu(k,851) * b(k,174) + b(k,203) = b(k,203) - lu(k,854) * b(k,175) + b(k,217) = b(k,217) - lu(k,855) * b(k,175) + b(k,224) = b(k,224) - lu(k,856) * b(k,175) + b(k,227) = b(k,227) - lu(k,857) * b(k,175) + b(k,229) = b(k,229) - lu(k,858) * b(k,175) + b(k,202) = b(k,202) - lu(k,860) * b(k,176) + b(k,209) = b(k,209) - lu(k,861) * b(k,176) + b(k,215) = b(k,215) - lu(k,862) * b(k,176) + b(k,217) = b(k,217) - lu(k,863) * b(k,176) + b(k,222) = b(k,222) - lu(k,864) * b(k,176) + b(k,210) = b(k,210) - lu(k,867) * b(k,177) + b(k,212) = b(k,212) - lu(k,868) * b(k,177) + b(k,213) = b(k,213) - lu(k,869) * b(k,177) + b(k,214) = b(k,214) - lu(k,870) * b(k,177) + b(k,217) = b(k,217) - lu(k,871) * b(k,177) + b(k,219) = b(k,219) - lu(k,872) * b(k,177) + b(k,220) = b(k,220) - lu(k,873) * b(k,177) + b(k,229) = b(k,229) - lu(k,874) * b(k,177) + b(k,186) = b(k,186) - lu(k,876) * b(k,178) + b(k,195) = b(k,195) - lu(k,877) * b(k,178) + b(k,202) = b(k,202) - lu(k,878) * b(k,178) + b(k,217) = b(k,217) - lu(k,879) * b(k,178) + b(k,220) = b(k,220) - lu(k,880) * b(k,178) + b(k,221) = b(k,221) - lu(k,881) * b(k,178) + b(k,222) = b(k,222) - lu(k,882) * b(k,178) + b(k,224) = b(k,224) - lu(k,883) * b(k,178) + 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,182) = b(k,182) - lu(k,890) * b(k,179) + b(k,192) = b(k,192) - lu(k,891) * b(k,179) + b(k,209) = b(k,209) - lu(k,892) * b(k,179) + b(k,215) = b(k,215) - lu(k,893) * b(k,179) + b(k,217) = b(k,217) - lu(k,894) * b(k,179) + b(k,220) = b(k,220) - lu(k,895) * b(k,179) + b(k,221) = b(k,221) - lu(k,896) * b(k,179) + b(k,222) = b(k,222) - lu(k,897) * b(k,179) + b(k,224) = b(k,224) - lu(k,898) * b(k,179) + b(k,214) = b(k,214) - lu(k,902) * b(k,180) + b(k,217) = b(k,217) - lu(k,903) * b(k,180) + b(k,218) = b(k,218) - lu(k,904) * b(k,180) + b(k,219) = b(k,219) - lu(k,905) * b(k,180) + b(k,222) = b(k,222) - lu(k,906) * b(k,180) + b(k,223) = b(k,223) - lu(k,907) * b(k,180) + b(k,225) = b(k,225) - lu(k,908) * b(k,180) + b(k,227) = b(k,227) - lu(k,909) * b(k,180) + b(k,229) = b(k,229) - lu(k,910) * b(k,180) + b(k,182) = b(k,182) - lu(k,915) * b(k,181) + b(k,185) = b(k,185) - lu(k,916) * b(k,181) + b(k,214) = b(k,214) - lu(k,917) * b(k,181) + b(k,215) = b(k,215) - lu(k,918) * b(k,181) + b(k,217) = b(k,217) - lu(k,919) * b(k,181) + b(k,220) = b(k,220) - lu(k,920) * b(k,181) + b(k,221) = b(k,221) - lu(k,921) * b(k,181) + b(k,222) = b(k,222) - lu(k,922) * b(k,181) + b(k,224) = b(k,224) - lu(k,923) * b(k,181) + b(k,196) = b(k,196) - lu(k,925) * b(k,182) + b(k,209) = b(k,209) - lu(k,926) * b(k,182) + b(k,217) = b(k,217) - lu(k,927) * b(k,182) + b(k,220) = b(k,220) - lu(k,928) * b(k,182) + b(k,229) = b(k,229) - lu(k,929) * b(k,182) + b(k,195) = b(k,195) - lu(k,932) * b(k,183) + b(k,217) = b(k,217) - lu(k,933) * b(k,183) + b(k,224) = b(k,224) - lu(k,934) * b(k,183) + b(k,227) = b(k,227) - lu(k,935) * b(k,183) + b(k,229) = b(k,229) - lu(k,936) * b(k,183) + b(k,185) = b(k,185) - lu(k,951) * b(k,184) + b(k,186) = b(k,186) - lu(k,952) * b(k,184) + b(k,189) = b(k,189) - lu(k,953) * b(k,184) + b(k,190) = b(k,190) - lu(k,954) * b(k,184) + b(k,192) = b(k,192) - lu(k,955) * b(k,184) + b(k,195) = b(k,195) - lu(k,956) * b(k,184) + b(k,196) = b(k,196) - lu(k,957) * b(k,184) + b(k,202) = b(k,202) - lu(k,958) * b(k,184) + b(k,209) = b(k,209) - lu(k,959) * b(k,184) + b(k,214) = b(k,214) - lu(k,960) * b(k,184) + b(k,215) = b(k,215) - lu(k,961) * b(k,184) + b(k,217) = b(k,217) - lu(k,962) * b(k,184) + b(k,219) = b(k,219) - lu(k,963) * b(k,184) + b(k,220) = b(k,220) - lu(k,964) * b(k,184) + b(k,221) = b(k,221) - lu(k,965) * b(k,184) + b(k,222) = b(k,222) - lu(k,966) * b(k,184) + b(k,224) = b(k,224) - lu(k,967) * b(k,184) + b(k,227) = b(k,227) - lu(k,968) * b(k,184) + b(k,228) = b(k,228) - lu(k,969) * b(k,184) + b(k,229) = b(k,229) - lu(k,970) * b(k,184) + b(k,189) = b(k,189) - lu(k,972) * b(k,185) + b(k,190) = b(k,190) - lu(k,973) * b(k,185) + b(k,194) = b(k,194) - lu(k,974) * b(k,185) + b(k,195) = b(k,195) - lu(k,975) * b(k,185) + b(k,217) = b(k,217) - lu(k,976) * b(k,185) + b(k,219) = b(k,219) - lu(k,977) * b(k,185) + b(k,224) = b(k,224) - lu(k,978) * b(k,185) + b(k,195) = b(k,195) - lu(k,982) * b(k,186) + b(k,217) = b(k,217) - lu(k,983) * b(k,186) + b(k,224) = b(k,224) - lu(k,984) * b(k,186) + b(k,227) = b(k,227) - lu(k,985) * b(k,186) + b(k,189) = b(k,189) - lu(k,1002) * b(k,187) + b(k,190) = b(k,190) - lu(k,1003) * b(k,187) + b(k,192) = b(k,192) - lu(k,1004) * b(k,187) + b(k,194) = b(k,194) - lu(k,1005) * b(k,187) + b(k,195) = b(k,195) - lu(k,1006) * b(k,187) + b(k,196) = b(k,196) - lu(k,1007) * b(k,187) + b(k,202) = b(k,202) - lu(k,1008) * b(k,187) + b(k,209) = b(k,209) - lu(k,1009) * b(k,187) + b(k,214) = b(k,214) - lu(k,1010) * b(k,187) + b(k,215) = b(k,215) - lu(k,1011) * b(k,187) + b(k,217) = b(k,217) - lu(k,1012) * b(k,187) + b(k,219) = b(k,219) - lu(k,1013) * b(k,187) + b(k,220) = b(k,220) - lu(k,1014) * b(k,187) + b(k,221) = b(k,221) - lu(k,1015) * b(k,187) + b(k,222) = b(k,222) - lu(k,1016) * b(k,187) + b(k,224) = b(k,224) - lu(k,1017) * b(k,187) + b(k,227) = b(k,227) - lu(k,1018) * b(k,187) + b(k,228) = b(k,228) - lu(k,1019) * b(k,187) + b(k,229) = b(k,229) - lu(k,1020) * b(k,187) + b(k,192) = b(k,192) - lu(k,1027) * b(k,188) + b(k,195) = b(k,195) - lu(k,1028) * b(k,188) + b(k,197) = b(k,197) - lu(k,1029) * b(k,188) + b(k,202) = b(k,202) - lu(k,1030) * b(k,188) + b(k,209) = b(k,209) - lu(k,1031) * b(k,188) + b(k,212) = b(k,212) - lu(k,1032) * b(k,188) + b(k,215) = b(k,215) - lu(k,1033) * b(k,188) + b(k,217) = b(k,217) - lu(k,1034) * b(k,188) + b(k,219) = b(k,219) - lu(k,1035) * b(k,188) + b(k,220) = b(k,220) - lu(k,1036) * b(k,188) + b(k,221) = b(k,221) - lu(k,1037) * b(k,188) + b(k,222) = b(k,222) - lu(k,1038) * b(k,188) + b(k,224) = b(k,224) - lu(k,1039) * b(k,188) + b(k,227) = b(k,227) - lu(k,1040) * b(k,188) + b(k,228) = b(k,228) - lu(k,1041) * b(k,188) + b(k,229) = b(k,229) - lu(k,1042) * b(k,188) + b(k,190) = b(k,190) - lu(k,1048) * b(k,189) + b(k,194) = b(k,194) - lu(k,1049) * b(k,189) + b(k,195) = b(k,195) - lu(k,1050) * b(k,189) + b(k,214) = b(k,214) - lu(k,1051) * b(k,189) + b(k,215) = b(k,215) - lu(k,1052) * b(k,189) + b(k,217) = b(k,217) - lu(k,1053) * b(k,189) + b(k,219) = b(k,219) - lu(k,1054) * b(k,189) + b(k,220) = b(k,220) - lu(k,1055) * b(k,189) + b(k,221) = b(k,221) - lu(k,1056) * b(k,189) + b(k,222) = b(k,222) - lu(k,1057) * b(k,189) + b(k,224) = b(k,224) - lu(k,1058) * b(k,189) + b(k,195) = b(k,195) - lu(k,1062) * b(k,190) + b(k,196) = b(k,196) - lu(k,1063) * b(k,190) + b(k,209) = b(k,209) - lu(k,1064) * b(k,190) + b(k,215) = b(k,215) - lu(k,1065) * b(k,190) + b(k,217) = b(k,217) - lu(k,1066) * b(k,190) + b(k,220) = b(k,220) - lu(k,1067) * b(k,190) + b(k,224) = b(k,224) - lu(k,1068) * b(k,190) + b(k,227) = b(k,227) - lu(k,1069) * b(k,190) + b(k,229) = b(k,229) - lu(k,1070) * b(k,190) + b(k,195) = b(k,195) - lu(k,1076) * b(k,191) + b(k,202) = b(k,202) - lu(k,1077) * b(k,191) + b(k,209) = b(k,209) - lu(k,1078) * b(k,191) + b(k,214) = b(k,214) - lu(k,1079) * b(k,191) + b(k,215) = b(k,215) - lu(k,1080) * b(k,191) + b(k,217) = b(k,217) - lu(k,1081) * b(k,191) + b(k,220) = b(k,220) - lu(k,1082) * b(k,191) + b(k,221) = b(k,221) - lu(k,1083) * b(k,191) + b(k,222) = b(k,222) - lu(k,1084) * b(k,191) + b(k,224) = b(k,224) - lu(k,1085) * b(k,191) + b(k,227) = b(k,227) - lu(k,1086) * b(k,191) + b(k,195) = b(k,195) - lu(k,1088) * b(k,192) + b(k,209) = b(k,209) - lu(k,1089) * b(k,192) + b(k,214) = b(k,214) - lu(k,1090) * b(k,192) + b(k,217) = b(k,217) - lu(k,1091) * b(k,192) + b(k,219) = b(k,219) - lu(k,1092) * b(k,192) + b(k,220) = b(k,220) - lu(k,1093) * b(k,192) + b(k,224) = b(k,224) - lu(k,1094) * b(k,192) + b(k,229) = b(k,229) - lu(k,1095) * b(k,192) + b(k,195) = b(k,195) - lu(k,1099) * b(k,193) + b(k,215) = b(k,215) - lu(k,1100) * b(k,193) + b(k,217) = b(k,217) - lu(k,1101) * b(k,193) + b(k,224) = b(k,224) - lu(k,1102) * b(k,193) + b(k,227) = b(k,227) - lu(k,1103) * b(k,193) + b(k,195) = b(k,195) - lu(k,1112) * b(k,194) + b(k,196) = b(k,196) - lu(k,1113) * b(k,194) + b(k,209) = b(k,209) - lu(k,1114) * b(k,194) + b(k,214) = b(k,214) - lu(k,1115) * b(k,194) + b(k,215) = b(k,215) - lu(k,1116) * b(k,194) + b(k,217) = b(k,217) - lu(k,1117) * b(k,194) + b(k,220) = b(k,220) - lu(k,1118) * b(k,194) + b(k,221) = b(k,221) - lu(k,1119) * b(k,194) + b(k,222) = b(k,222) - lu(k,1120) * b(k,194) + b(k,224) = b(k,224) - lu(k,1121) * b(k,194) + b(k,227) = b(k,227) - lu(k,1122) * b(k,194) + b(k,229) = b(k,229) - lu(k,1123) * b(k,194) + b(k,217) = b(k,217) - lu(k,1126) * b(k,195) + b(k,224) = b(k,224) - lu(k,1127) * b(k,195) + b(k,227) = b(k,227) - lu(k,1128) * b(k,195) + b(k,197) = b(k,197) - lu(k,1132) * b(k,196) + b(k,202) = b(k,202) - lu(k,1133) * b(k,196) + b(k,209) = b(k,209) - lu(k,1134) * b(k,196) + b(k,215) = b(k,215) - lu(k,1135) * b(k,196) + b(k,217) = b(k,217) - lu(k,1136) * b(k,196) + b(k,220) = b(k,220) - lu(k,1137) * b(k,196) + b(k,221) = b(k,221) - lu(k,1138) * b(k,196) + b(k,222) = b(k,222) - lu(k,1139) * b(k,196) + b(k,224) = b(k,224) - lu(k,1140) * b(k,196) + b(k,229) = b(k,229) - lu(k,1141) * b(k,196) + b(k,202) = b(k,202) - lu(k,1143) * b(k,197) + b(k,209) = b(k,209) - lu(k,1144) * b(k,197) + b(k,215) = b(k,215) - lu(k,1145) * b(k,197) + b(k,217) = b(k,217) - lu(k,1146) * b(k,197) + b(k,224) = b(k,224) - lu(k,1147) * b(k,197) + b(k,202) = b(k,202) - lu(k,1156) * b(k,198) + b(k,209) = b(k,209) - lu(k,1157) * b(k,198) + b(k,214) = b(k,214) - lu(k,1158) * b(k,198) + b(k,215) = b(k,215) - lu(k,1159) * b(k,198) + b(k,217) = b(k,217) - lu(k,1160) * b(k,198) + b(k,219) = b(k,219) - lu(k,1161) * b(k,198) + b(k,220) = b(k,220) - lu(k,1162) * b(k,198) + b(k,221) = b(k,221) - lu(k,1163) * b(k,198) + b(k,222) = b(k,222) - lu(k,1164) * b(k,198) + b(k,224) = b(k,224) - lu(k,1165) * b(k,198) + b(k,227) = b(k,227) - lu(k,1166) * b(k,198) + b(k,229) = b(k,229) - lu(k,1167) * b(k,198) + b(k,202) = b(k,202) - lu(k,1176) * b(k,199) + b(k,209) = b(k,209) - lu(k,1177) * b(k,199) + b(k,215) = b(k,215) - lu(k,1178) * b(k,199) + b(k,217) = b(k,217) - lu(k,1179) * b(k,199) + b(k,219) = b(k,219) - lu(k,1180) * b(k,199) + b(k,220) = b(k,220) - lu(k,1181) * b(k,199) + b(k,221) = b(k,221) - lu(k,1182) * b(k,199) + b(k,222) = b(k,222) - lu(k,1183) * b(k,199) + b(k,224) = b(k,224) - lu(k,1184) * b(k,199) + b(k,227) = b(k,227) - lu(k,1185) * b(k,199) + b(k,201) = b(k,201) - lu(k,1196) * b(k,200) + b(k,202) = b(k,202) - lu(k,1197) * b(k,200) + b(k,207) = b(k,207) - lu(k,1198) * b(k,200) + b(k,209) = b(k,209) - lu(k,1199) * b(k,200) + b(k,214) = b(k,214) - lu(k,1200) * b(k,200) + b(k,215) = b(k,215) - lu(k,1201) * b(k,200) + b(k,217) = b(k,217) - lu(k,1202) * b(k,200) + b(k,219) = b(k,219) - lu(k,1203) * b(k,200) + b(k,220) = b(k,220) - lu(k,1204) * b(k,200) + b(k,221) = b(k,221) - lu(k,1205) * b(k,200) + b(k,222) = b(k,222) - lu(k,1206) * b(k,200) + b(k,224) = b(k,224) - lu(k,1207) * b(k,200) + b(k,227) = b(k,227) - lu(k,1208) * b(k,200) + 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 + b(k,202) = b(k,202) - lu(k,1212) * b(k,201) + b(k,206) = b(k,206) - lu(k,1213) * b(k,201) + b(k,208) = b(k,208) - lu(k,1214) * b(k,201) + b(k,209) = b(k,209) - lu(k,1215) * b(k,201) + b(k,215) = b(k,215) - lu(k,1216) * b(k,201) + b(k,217) = b(k,217) - lu(k,1217) * b(k,201) + b(k,224) = b(k,224) - lu(k,1218) * b(k,201) + b(k,227) = b(k,227) - lu(k,1219) * b(k,201) + b(k,228) = b(k,228) - lu(k,1220) * b(k,201) + b(k,229) = b(k,229) - lu(k,1221) * b(k,201) + b(k,209) = b(k,209) - lu(k,1224) * b(k,202) + b(k,214) = b(k,214) - lu(k,1225) * b(k,202) + b(k,217) = b(k,217) - lu(k,1226) * b(k,202) + b(k,219) = b(k,219) - lu(k,1227) * b(k,202) + b(k,224) = b(k,224) - lu(k,1228) * b(k,202) + b(k,227) = b(k,227) - lu(k,1229) * b(k,202) + b(k,229) = b(k,229) - lu(k,1230) * b(k,202) + b(k,211) = b(k,211) - lu(k,1235) * b(k,203) + b(k,213) = b(k,213) - lu(k,1236) * b(k,203) + b(k,217) = b(k,217) - lu(k,1237) * b(k,203) + b(k,218) = b(k,218) - lu(k,1238) * b(k,203) + b(k,221) = b(k,221) - lu(k,1239) * b(k,203) + b(k,222) = b(k,222) - lu(k,1240) * b(k,203) + b(k,223) = b(k,223) - lu(k,1241) * b(k,203) + b(k,224) = b(k,224) - lu(k,1242) * b(k,203) + b(k,226) = b(k,226) - lu(k,1243) * b(k,203) + b(k,227) = b(k,227) - lu(k,1244) * b(k,203) + b(k,228) = b(k,228) - lu(k,1245) * b(k,203) + b(k,229) = b(k,229) - lu(k,1246) * b(k,203) + b(k,206) = b(k,206) - lu(k,1259) * b(k,204) + b(k,207) = b(k,207) - lu(k,1260) * b(k,204) + b(k,208) = b(k,208) - lu(k,1261) * b(k,204) + b(k,209) = b(k,209) - lu(k,1262) * b(k,204) + b(k,214) = b(k,214) - lu(k,1263) * b(k,204) + b(k,215) = b(k,215) - lu(k,1264) * b(k,204) + b(k,217) = b(k,217) - lu(k,1265) * b(k,204) + b(k,219) = b(k,219) - lu(k,1266) * b(k,204) + b(k,220) = b(k,220) - lu(k,1267) * b(k,204) + b(k,221) = b(k,221) - lu(k,1268) * b(k,204) + b(k,222) = b(k,222) - lu(k,1269) * b(k,204) + b(k,224) = b(k,224) - lu(k,1270) * b(k,204) + b(k,227) = b(k,227) - lu(k,1271) * b(k,204) + b(k,228) = b(k,228) - lu(k,1272) * b(k,204) + b(k,229) = b(k,229) - lu(k,1273) * b(k,204) + b(k,206) = b(k,206) - lu(k,1291) * b(k,205) + b(k,207) = b(k,207) - lu(k,1292) * b(k,205) + b(k,208) = b(k,208) - lu(k,1293) * b(k,205) + b(k,209) = b(k,209) - lu(k,1294) * b(k,205) + b(k,214) = b(k,214) - lu(k,1295) * b(k,205) + b(k,215) = b(k,215) - lu(k,1296) * b(k,205) + b(k,217) = b(k,217) - lu(k,1297) * b(k,205) + b(k,219) = b(k,219) - lu(k,1298) * b(k,205) + b(k,220) = b(k,220) - lu(k,1299) * b(k,205) + b(k,221) = b(k,221) - lu(k,1300) * b(k,205) + b(k,222) = b(k,222) - lu(k,1301) * b(k,205) + b(k,224) = b(k,224) - lu(k,1302) * b(k,205) + b(k,227) = b(k,227) - lu(k,1303) * b(k,205) + b(k,228) = b(k,228) - lu(k,1304) * b(k,205) + b(k,229) = b(k,229) - lu(k,1305) * b(k,205) + b(k,208) = b(k,208) - lu(k,1314) * b(k,206) + b(k,209) = b(k,209) - lu(k,1315) * b(k,206) + b(k,214) = b(k,214) - lu(k,1316) * b(k,206) + b(k,215) = b(k,215) - lu(k,1317) * b(k,206) + b(k,217) = b(k,217) - lu(k,1318) * b(k,206) + b(k,219) = b(k,219) - lu(k,1319) * b(k,206) + b(k,220) = b(k,220) - lu(k,1320) * b(k,206) + b(k,221) = b(k,221) - lu(k,1321) * b(k,206) + b(k,222) = b(k,222) - lu(k,1322) * b(k,206) + b(k,224) = b(k,224) - lu(k,1323) * b(k,206) + b(k,227) = b(k,227) - lu(k,1324) * b(k,206) + b(k,229) = b(k,229) - lu(k,1325) * b(k,206) + b(k,208) = b(k,208) - lu(k,1335) * b(k,207) + b(k,209) = b(k,209) - lu(k,1336) * b(k,207) + b(k,212) = b(k,212) - lu(k,1337) * b(k,207) + b(k,214) = b(k,214) - lu(k,1338) * b(k,207) + b(k,215) = b(k,215) - lu(k,1339) * b(k,207) + b(k,217) = b(k,217) - lu(k,1340) * b(k,207) + b(k,219) = b(k,219) - lu(k,1341) * b(k,207) + b(k,220) = b(k,220) - lu(k,1342) * b(k,207) + b(k,221) = b(k,221) - lu(k,1343) * b(k,207) + b(k,222) = b(k,222) - lu(k,1344) * b(k,207) + b(k,224) = b(k,224) - lu(k,1345) * b(k,207) + b(k,227) = b(k,227) - lu(k,1346) * b(k,207) + b(k,228) = b(k,228) - lu(k,1347) * b(k,207) + b(k,229) = b(k,229) - lu(k,1348) * b(k,207) + b(k,209) = b(k,209) - lu(k,1357) * b(k,208) + b(k,214) = b(k,214) - lu(k,1358) * b(k,208) + b(k,215) = b(k,215) - lu(k,1359) * b(k,208) + b(k,217) = b(k,217) - lu(k,1360) * b(k,208) + b(k,219) = b(k,219) - lu(k,1361) * b(k,208) + b(k,220) = b(k,220) - lu(k,1362) * b(k,208) + b(k,221) = b(k,221) - lu(k,1363) * b(k,208) + b(k,222) = b(k,222) - lu(k,1364) * b(k,208) + b(k,224) = b(k,224) - lu(k,1365) * b(k,208) + b(k,227) = b(k,227) - lu(k,1366) * b(k,208) + b(k,228) = b(k,228) - lu(k,1367) * b(k,208) + b(k,229) = b(k,229) - lu(k,1368) * b(k,208) + b(k,212) = b(k,212) - lu(k,1389) * b(k,209) + b(k,214) = b(k,214) - lu(k,1390) * b(k,209) + b(k,215) = b(k,215) - lu(k,1391) * b(k,209) + b(k,217) = b(k,217) - lu(k,1392) * b(k,209) + b(k,219) = b(k,219) - lu(k,1393) * b(k,209) + b(k,220) = b(k,220) - lu(k,1394) * b(k,209) + b(k,221) = b(k,221) - lu(k,1395) * b(k,209) + b(k,222) = b(k,222) - lu(k,1396) * b(k,209) + b(k,224) = b(k,224) - lu(k,1397) * b(k,209) + b(k,227) = b(k,227) - lu(k,1398) * b(k,209) + b(k,228) = b(k,228) - lu(k,1399) * b(k,209) + b(k,229) = b(k,229) - lu(k,1400) * b(k,209) + b(k,212) = b(k,212) - lu(k,1404) * b(k,210) + b(k,213) = b(k,213) - lu(k,1405) * b(k,210) + b(k,214) = b(k,214) - lu(k,1406) * b(k,210) + b(k,216) = b(k,216) - lu(k,1407) * b(k,210) + b(k,217) = b(k,217) - lu(k,1408) * b(k,210) + b(k,219) = b(k,219) - lu(k,1409) * b(k,210) + b(k,220) = b(k,220) - lu(k,1410) * b(k,210) + b(k,223) = b(k,223) - lu(k,1411) * b(k,210) + b(k,225) = b(k,225) - lu(k,1412) * b(k,210) + b(k,227) = b(k,227) - lu(k,1413) * b(k,210) + b(k,229) = b(k,229) - lu(k,1414) * b(k,210) + b(k,213) = b(k,213) - lu(k,1418) * b(k,211) + b(k,215) = b(k,215) - lu(k,1419) * b(k,211) + b(k,216) = b(k,216) - lu(k,1420) * b(k,211) + b(k,217) = b(k,217) - lu(k,1421) * b(k,211) + b(k,224) = b(k,224) - lu(k,1422) * b(k,211) + b(k,226) = b(k,226) - lu(k,1423) * b(k,211) + b(k,227) = b(k,227) - lu(k,1424) * b(k,211) + b(k,228) = b(k,228) - lu(k,1425) * b(k,211) + b(k,229) = b(k,229) - lu(k,1426) * b(k,211) + b(k,213) = b(k,213) - lu(k,1433) * b(k,212) + b(k,214) = b(k,214) - lu(k,1434) * b(k,212) + b(k,215) = b(k,215) - lu(k,1435) * b(k,212) + b(k,216) = b(k,216) - lu(k,1436) * b(k,212) + b(k,217) = b(k,217) - lu(k,1437) * b(k,212) + b(k,219) = b(k,219) - lu(k,1438) * b(k,212) + b(k,220) = b(k,220) - lu(k,1439) * b(k,212) + b(k,223) = b(k,223) - lu(k,1440) * b(k,212) + b(k,224) = b(k,224) - lu(k,1441) * b(k,212) + b(k,225) = b(k,225) - lu(k,1442) * b(k,212) + b(k,227) = b(k,227) - lu(k,1443) * b(k,212) + b(k,229) = b(k,229) - lu(k,1444) * b(k,212) + b(k,214) = b(k,214) - lu(k,1448) * b(k,213) + b(k,215) = b(k,215) - lu(k,1449) * b(k,213) + b(k,216) = b(k,216) - lu(k,1450) * b(k,213) + b(k,217) = b(k,217) - lu(k,1451) * b(k,213) + b(k,219) = b(k,219) - lu(k,1452) * b(k,213) + b(k,220) = b(k,220) - lu(k,1453) * b(k,213) + b(k,223) = b(k,223) - lu(k,1454) * b(k,213) + b(k,224) = b(k,224) - lu(k,1455) * b(k,213) + b(k,225) = b(k,225) - lu(k,1456) * b(k,213) + b(k,227) = b(k,227) - lu(k,1457) * b(k,213) + b(k,228) = b(k,228) - lu(k,1458) * b(k,213) + b(k,229) = b(k,229) - lu(k,1459) * b(k,213) + b(k,215) = b(k,215) - lu(k,1466) * b(k,214) + b(k,216) = b(k,216) - lu(k,1467) * b(k,214) + b(k,217) = b(k,217) - lu(k,1468) * b(k,214) + b(k,219) = b(k,219) - lu(k,1469) * b(k,214) + b(k,220) = b(k,220) - lu(k,1470) * b(k,214) + b(k,222) = b(k,222) - lu(k,1471) * b(k,214) + b(k,223) = b(k,223) - lu(k,1472) * b(k,214) + b(k,224) = b(k,224) - lu(k,1473) * b(k,214) + b(k,225) = b(k,225) - lu(k,1474) * b(k,214) + b(k,227) = b(k,227) - lu(k,1475) * b(k,214) + b(k,228) = b(k,228) - lu(k,1476) * b(k,214) + b(k,229) = b(k,229) - lu(k,1477) * b(k,214) + b(k,216) = b(k,216) - lu(k,1488) * b(k,215) + b(k,217) = b(k,217) - lu(k,1489) * b(k,215) + b(k,219) = b(k,219) - lu(k,1490) * b(k,215) + b(k,220) = b(k,220) - lu(k,1491) * b(k,215) + b(k,221) = b(k,221) - lu(k,1492) * b(k,215) + b(k,222) = b(k,222) - lu(k,1493) * b(k,215) + b(k,223) = b(k,223) - lu(k,1494) * b(k,215) + b(k,224) = b(k,224) - lu(k,1495) * b(k,215) + b(k,225) = b(k,225) - lu(k,1496) * b(k,215) + b(k,226) = b(k,226) - lu(k,1497) * b(k,215) + b(k,227) = b(k,227) - lu(k,1498) * b(k,215) + b(k,228) = b(k,228) - lu(k,1499) * b(k,215) + b(k,229) = b(k,229) - lu(k,1500) * b(k,215) + b(k,217) = b(k,217) - lu(k,1529) * b(k,216) + b(k,218) = b(k,218) - lu(k,1530) * b(k,216) + b(k,219) = b(k,219) - lu(k,1531) * b(k,216) + b(k,220) = b(k,220) - lu(k,1532) * b(k,216) + b(k,221) = b(k,221) - lu(k,1533) * b(k,216) + b(k,222) = b(k,222) - lu(k,1534) * b(k,216) + b(k,223) = b(k,223) - lu(k,1535) * b(k,216) + b(k,224) = b(k,224) - lu(k,1536) * b(k,216) + b(k,225) = b(k,225) - lu(k,1537) * b(k,216) + b(k,226) = b(k,226) - lu(k,1538) * b(k,216) + b(k,227) = b(k,227) - lu(k,1539) * b(k,216) + b(k,228) = b(k,228) - lu(k,1540) * b(k,216) + b(k,229) = b(k,229) - lu(k,1541) * b(k,216) + b(k,218) = b(k,218) - lu(k,1694) * b(k,217) + b(k,219) = b(k,219) - lu(k,1695) * b(k,217) + b(k,220) = b(k,220) - lu(k,1696) * b(k,217) + b(k,221) = b(k,221) - lu(k,1697) * b(k,217) + b(k,222) = b(k,222) - lu(k,1698) * b(k,217) + b(k,223) = b(k,223) - lu(k,1699) * b(k,217) + b(k,224) = b(k,224) - lu(k,1700) * b(k,217) + b(k,225) = b(k,225) - lu(k,1701) * b(k,217) + b(k,226) = b(k,226) - lu(k,1702) * b(k,217) + b(k,227) = b(k,227) - lu(k,1703) * b(k,217) + b(k,228) = b(k,228) - lu(k,1704) * b(k,217) + b(k,229) = b(k,229) - lu(k,1705) * b(k,217) + 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,219) = b(k,219) - lu(k,1721) * b(k,218) + b(k,220) = b(k,220) - lu(k,1722) * b(k,218) + b(k,221) = b(k,221) - lu(k,1723) * b(k,218) + b(k,222) = b(k,222) - lu(k,1724) * b(k,218) + b(k,223) = b(k,223) - lu(k,1725) * b(k,218) + b(k,224) = b(k,224) - lu(k,1726) * b(k,218) + b(k,225) = b(k,225) - lu(k,1727) * b(k,218) + b(k,226) = b(k,226) - lu(k,1728) * b(k,218) + b(k,227) = b(k,227) - lu(k,1729) * b(k,218) + b(k,228) = b(k,228) - lu(k,1730) * b(k,218) + b(k,229) = b(k,229) - lu(k,1731) * b(k,218) + b(k,220) = b(k,220) - lu(k,1779) * b(k,219) + b(k,221) = b(k,221) - lu(k,1780) * b(k,219) + b(k,222) = b(k,222) - lu(k,1781) * b(k,219) + b(k,223) = b(k,223) - lu(k,1782) * b(k,219) + b(k,224) = b(k,224) - lu(k,1783) * b(k,219) + b(k,225) = b(k,225) - lu(k,1784) * b(k,219) + b(k,226) = b(k,226) - lu(k,1785) * b(k,219) + b(k,227) = b(k,227) - lu(k,1786) * b(k,219) + b(k,228) = b(k,228) - lu(k,1787) * b(k,219) + b(k,229) = b(k,229) - lu(k,1788) * b(k,219) + b(k,221) = b(k,221) - lu(k,1832) * b(k,220) + b(k,222) = b(k,222) - lu(k,1833) * b(k,220) + b(k,223) = b(k,223) - lu(k,1834) * b(k,220) + b(k,224) = b(k,224) - lu(k,1835) * b(k,220) + b(k,225) = b(k,225) - lu(k,1836) * b(k,220) + b(k,226) = b(k,226) - lu(k,1837) * b(k,220) + b(k,227) = b(k,227) - lu(k,1838) * b(k,220) + b(k,228) = b(k,228) - lu(k,1839) * b(k,220) + b(k,229) = b(k,229) - lu(k,1840) * b(k,220) + b(k,222) = b(k,222) - lu(k,1925) * b(k,221) + b(k,223) = b(k,223) - lu(k,1926) * b(k,221) + b(k,224) = b(k,224) - lu(k,1927) * b(k,221) + b(k,225) = b(k,225) - lu(k,1928) * b(k,221) + b(k,226) = b(k,226) - lu(k,1929) * b(k,221) + b(k,227) = b(k,227) - lu(k,1930) * b(k,221) + b(k,228) = b(k,228) - lu(k,1931) * b(k,221) + b(k,229) = b(k,229) - lu(k,1932) * b(k,221) + b(k,223) = b(k,223) - lu(k,1970) * b(k,222) + b(k,224) = b(k,224) - lu(k,1971) * b(k,222) + b(k,225) = b(k,225) - lu(k,1972) * b(k,222) + b(k,226) = b(k,226) - lu(k,1973) * b(k,222) + b(k,227) = b(k,227) - lu(k,1974) * b(k,222) + b(k,228) = b(k,228) - lu(k,1975) * b(k,222) + b(k,229) = b(k,229) - lu(k,1976) * b(k,222) + b(k,224) = b(k,224) - lu(k,2010) * b(k,223) + b(k,225) = b(k,225) - lu(k,2011) * b(k,223) + b(k,226) = b(k,226) - lu(k,2012) * b(k,223) + b(k,227) = b(k,227) - lu(k,2013) * b(k,223) + b(k,228) = b(k,228) - lu(k,2014) * b(k,223) + b(k,229) = b(k,229) - lu(k,2015) * b(k,223) + b(k,225) = b(k,225) - lu(k,2118) * b(k,224) + b(k,226) = b(k,226) - lu(k,2119) * b(k,224) + b(k,227) = b(k,227) - lu(k,2120) * b(k,224) + b(k,228) = b(k,228) - lu(k,2121) * b(k,224) + b(k,229) = b(k,229) - lu(k,2122) * b(k,224) + b(k,226) = b(k,226) - lu(k,2142) * b(k,225) + b(k,227) = b(k,227) - lu(k,2143) * b(k,225) + b(k,228) = b(k,228) - lu(k,2144) * b(k,225) + b(k,229) = b(k,229) - lu(k,2145) * b(k,225) + b(k,227) = b(k,227) - lu(k,2167) * b(k,226) + b(k,228) = b(k,228) - lu(k,2168) * b(k,226) + b(k,229) = b(k,229) - lu(k,2169) * b(k,226) + b(k,228) = b(k,228) - lu(k,2199) * b(k,227) + b(k,229) = b(k,229) - lu(k,2200) * b(k,227) + b(k,229) = b(k,229) - lu(k,2261) * b(k,228) + 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 +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,229) = b(k,229) * lu(k,2287) + b(k,228) = b(k,228) - lu(k,2286) * b(k,229) + b(k,227) = b(k,227) - lu(k,2285) * b(k,229) + b(k,226) = b(k,226) - lu(k,2284) * b(k,229) + b(k,225) = b(k,225) - lu(k,2283) * b(k,229) + b(k,224) = b(k,224) - lu(k,2282) * b(k,229) + b(k,223) = b(k,223) - lu(k,2281) * b(k,229) + b(k,222) = b(k,222) - lu(k,2280) * b(k,229) + b(k,221) = b(k,221) - lu(k,2279) * b(k,229) + b(k,220) = b(k,220) - lu(k,2278) * b(k,229) + b(k,219) = b(k,219) - lu(k,2277) * b(k,229) + b(k,218) = b(k,218) - lu(k,2276) * b(k,229) + b(k,217) = b(k,217) - lu(k,2275) * b(k,229) + b(k,216) = b(k,216) - lu(k,2274) * b(k,229) + b(k,215) = b(k,215) - lu(k,2273) * b(k,229) + b(k,214) = b(k,214) - lu(k,2272) * b(k,229) + b(k,213) = b(k,213) - lu(k,2271) * b(k,229) + b(k,212) = b(k,212) - lu(k,2270) * b(k,229) + b(k,211) = b(k,211) - lu(k,2269) * b(k,229) + b(k,210) = b(k,210) - lu(k,2268) * b(k,229) + b(k,203) = b(k,203) - lu(k,2267) * b(k,229) + b(k,177) = b(k,177) - lu(k,2266) * b(k,229) + b(k,175) = b(k,175) - lu(k,2265) * b(k,229) + b(k,100) = b(k,100) - lu(k,2264) * b(k,229) + b(k,93) = b(k,93) - lu(k,2263) * b(k,229) + b(k,65) = b(k,65) - lu(k,2262) * b(k,229) + b(k,228) = b(k,228) * lu(k,2260) + b(k,227) = b(k,227) - lu(k,2259) * b(k,228) + b(k,226) = b(k,226) - lu(k,2258) * b(k,228) + b(k,225) = b(k,225) - lu(k,2257) * b(k,228) + b(k,224) = b(k,224) - lu(k,2256) * b(k,228) + b(k,223) = b(k,223) - lu(k,2255) * b(k,228) + b(k,222) = b(k,222) - lu(k,2254) * b(k,228) + b(k,221) = b(k,221) - lu(k,2253) * b(k,228) + b(k,220) = b(k,220) - lu(k,2252) * b(k,228) + b(k,219) = b(k,219) - lu(k,2251) * b(k,228) + b(k,218) = b(k,218) - lu(k,2250) * b(k,228) + b(k,217) = b(k,217) - lu(k,2249) * b(k,228) + b(k,216) = b(k,216) - lu(k,2248) * b(k,228) + b(k,215) = b(k,215) - lu(k,2247) * b(k,228) + b(k,214) = b(k,214) - lu(k,2246) * b(k,228) + b(k,213) = b(k,213) - lu(k,2245) * b(k,228) + b(k,212) = b(k,212) - lu(k,2244) * b(k,228) + b(k,211) = b(k,211) - lu(k,2243) * b(k,228) + b(k,209) = b(k,209) - lu(k,2242) * b(k,228) + b(k,208) = b(k,208) - lu(k,2241) * b(k,228) + b(k,207) = b(k,207) - lu(k,2240) * b(k,228) + b(k,206) = b(k,206) - lu(k,2239) * b(k,228) + b(k,205) = b(k,205) - lu(k,2238) * b(k,228) + b(k,204) = b(k,204) - lu(k,2237) * b(k,228) + b(k,203) = b(k,203) - lu(k,2236) * b(k,228) + b(k,202) = b(k,202) - lu(k,2235) * b(k,228) + b(k,201) = b(k,201) - lu(k,2234) * b(k,228) + b(k,200) = b(k,200) - lu(k,2233) * b(k,228) + b(k,197) = b(k,197) - lu(k,2232) * b(k,228) + b(k,196) = b(k,196) - lu(k,2231) * b(k,228) + b(k,195) = b(k,195) - lu(k,2230) * b(k,228) + b(k,194) = b(k,194) - lu(k,2229) * b(k,228) + b(k,193) = b(k,193) - lu(k,2228) * b(k,228) + b(k,192) = b(k,192) - lu(k,2227) * b(k,228) + b(k,190) = b(k,190) - lu(k,2226) * b(k,228) + b(k,189) = b(k,189) - lu(k,2225) * b(k,228) + b(k,188) = b(k,188) - lu(k,2224) * b(k,228) + b(k,187) = b(k,187) - lu(k,2223) * b(k,228) + b(k,186) = b(k,186) - lu(k,2222) * b(k,228) + b(k,185) = b(k,185) - lu(k,2221) * b(k,228) + b(k,184) = b(k,184) - lu(k,2220) * b(k,228) + b(k,183) = b(k,183) - lu(k,2219) * b(k,228) + b(k,182) = b(k,182) - lu(k,2218) * b(k,228) + b(k,179) = b(k,179) - lu(k,2217) * b(k,228) + b(k,175) = b(k,175) - lu(k,2216) * b(k,228) + b(k,174) = b(k,174) - lu(k,2215) * b(k,228) + b(k,170) = b(k,170) - lu(k,2214) * b(k,228) + b(k,160) = b(k,160) - lu(k,2213) * b(k,228) + b(k,158) = b(k,158) - lu(k,2212) * b(k,228) + b(k,152) = b(k,152) - lu(k,2211) * b(k,228) + b(k,142) = b(k,142) - lu(k,2210) * b(k,228) + b(k,137) = b(k,137) - lu(k,2209) * b(k,228) + b(k,130) = b(k,130) - lu(k,2208) * b(k,228) + b(k,116) = b(k,116) - lu(k,2207) * b(k,228) + b(k,85) = b(k,85) - lu(k,2206) * b(k,228) + b(k,43) = b(k,43) - lu(k,2205) * b(k,228) + b(k,42) = b(k,42) - lu(k,2204) * b(k,228) + b(k,41) = b(k,41) - lu(k,2203) * b(k,228) + b(k,40) = b(k,40) - lu(k,2202) * b(k,228) + b(k,39) = b(k,39) - lu(k,2201) * b(k,228) + b(k,227) = b(k,227) * lu(k,2198) + b(k,226) = b(k,226) - lu(k,2197) * b(k,227) + b(k,225) = b(k,225) - lu(k,2196) * b(k,227) + b(k,224) = b(k,224) - lu(k,2195) * b(k,227) + b(k,223) = b(k,223) - lu(k,2194) * b(k,227) + b(k,222) = b(k,222) - lu(k,2193) * b(k,227) + b(k,221) = b(k,221) - lu(k,2192) * b(k,227) + b(k,220) = b(k,220) - lu(k,2191) * b(k,227) + b(k,219) = b(k,219) - lu(k,2190) * b(k,227) + b(k,218) = b(k,218) - lu(k,2189) * b(k,227) + b(k,217) = b(k,217) - lu(k,2188) * b(k,227) + b(k,216) = b(k,216) - lu(k,2187) * b(k,227) + b(k,215) = b(k,215) - lu(k,2186) * b(k,227) + b(k,214) = b(k,214) - lu(k,2185) * b(k,227) + b(k,213) = b(k,213) - lu(k,2184) * b(k,227) + b(k,212) = b(k,212) - lu(k,2183) * b(k,227) + b(k,211) = b(k,211) - lu(k,2182) * b(k,227) + b(k,210) = b(k,210) - lu(k,2181) * b(k,227) + b(k,203) = b(k,203) - lu(k,2180) * b(k,227) + b(k,195) = b(k,195) - lu(k,2179) * b(k,227) + b(k,180) = b(k,180) - lu(k,2178) * b(k,227) + b(k,175) = b(k,175) - lu(k,2177) * b(k,227) + b(k,172) = b(k,172) - lu(k,2176) * b(k,227) + b(k,171) = b(k,171) - lu(k,2175) * b(k,227) + b(k,167) = b(k,167) - lu(k,2174) * b(k,227) + b(k,149) = b(k,149) - lu(k,2173) * b(k,227) + b(k,143) = b(k,143) - lu(k,2172) * b(k,227) + b(k,137) = b(k,137) - lu(k,2171) * b(k,227) + b(k,113) = b(k,113) - lu(k,2170) * b(k,227) + b(k,226) = b(k,226) * lu(k,2166) + b(k,225) = b(k,225) - lu(k,2165) * b(k,226) + b(k,224) = b(k,224) - lu(k,2164) * b(k,226) + b(k,223) = b(k,223) - lu(k,2163) * b(k,226) + b(k,222) = b(k,222) - lu(k,2162) * b(k,226) + b(k,221) = b(k,221) - lu(k,2161) * b(k,226) + b(k,220) = b(k,220) - lu(k,2160) * b(k,226) + b(k,219) = b(k,219) - lu(k,2159) * b(k,226) + b(k,218) = b(k,218) - lu(k,2158) * b(k,226) + b(k,217) = b(k,217) - lu(k,2157) * b(k,226) + b(k,216) = b(k,216) - lu(k,2156) * b(k,226) + b(k,215) = b(k,215) - lu(k,2155) * b(k,226) + b(k,214) = b(k,214) - lu(k,2154) * b(k,226) + b(k,213) = b(k,213) - lu(k,2153) * b(k,226) + b(k,211) = b(k,211) - lu(k,2152) * b(k,226) + b(k,203) = b(k,203) - lu(k,2151) * b(k,226) + b(k,175) = b(k,175) - lu(k,2150) * b(k,226) + b(k,167) = b(k,167) - lu(k,2149) * b(k,226) + b(k,143) = b(k,143) - lu(k,2148) * b(k,226) + b(k,107) = b(k,107) - lu(k,2147) * b(k,226) + b(k,86) = b(k,86) - lu(k,2146) * b(k,226) + b(k,225) = b(k,225) * lu(k,2141) + b(k,224) = b(k,224) - lu(k,2140) * b(k,225) + b(k,223) = b(k,223) - lu(k,2139) * b(k,225) + b(k,222) = b(k,222) - lu(k,2138) * b(k,225) + b(k,221) = b(k,221) - lu(k,2137) * b(k,225) + b(k,220) = b(k,220) - lu(k,2136) * b(k,225) + b(k,219) = b(k,219) - lu(k,2135) * b(k,225) + b(k,218) = b(k,218) - lu(k,2134) * b(k,225) + b(k,217) = b(k,217) - lu(k,2133) * b(k,225) + b(k,216) = b(k,216) - lu(k,2132) * b(k,225) + b(k,215) = b(k,215) - lu(k,2131) * b(k,225) + b(k,214) = b(k,214) - lu(k,2130) * b(k,225) + b(k,213) = b(k,213) - lu(k,2129) * b(k,225) + b(k,211) = b(k,211) - lu(k,2128) * b(k,225) + b(k,180) = b(k,180) - lu(k,2127) * b(k,225) + b(k,172) = b(k,172) - lu(k,2126) * b(k,225) + b(k,167) = b(k,167) - lu(k,2125) * b(k,225) + b(k,86) = b(k,86) - lu(k,2124) * b(k,225) + b(k,75) = b(k,75) - lu(k,2123) * b(k,225) + b(k,224) = b(k,224) * lu(k,2117) + b(k,223) = b(k,223) - lu(k,2116) * b(k,224) + b(k,222) = b(k,222) - lu(k,2115) * b(k,224) + b(k,221) = b(k,221) - lu(k,2114) * b(k,224) + b(k,220) = b(k,220) - lu(k,2113) * b(k,224) + b(k,219) = b(k,219) - lu(k,2112) * b(k,224) + b(k,218) = b(k,218) - lu(k,2111) * b(k,224) + b(k,217) = b(k,217) - lu(k,2110) * b(k,224) + b(k,216) = b(k,216) - lu(k,2109) * b(k,224) + b(k,215) = b(k,215) - lu(k,2108) * b(k,224) + b(k,214) = b(k,214) - lu(k,2107) * b(k,224) + b(k,213) = b(k,213) - lu(k,2106) * b(k,224) + b(k,212) = b(k,212) - lu(k,2105) * b(k,224) + b(k,211) = b(k,211) - lu(k,2104) * b(k,224) + b(k,210) = b(k,210) - lu(k,2103) * b(k,224) + b(k,209) = b(k,209) - lu(k,2102) * b(k,224) + b(k,208) = b(k,208) - lu(k,2101) * b(k,224) + b(k,207) = b(k,207) - lu(k,2100) * b(k,224) + b(k,206) = b(k,206) - lu(k,2099) * b(k,224) + b(k,205) = b(k,205) - lu(k,2098) * b(k,224) + b(k,204) = b(k,204) - lu(k,2097) * b(k,224) + b(k,202) = b(k,202) - lu(k,2096) * b(k,224) + b(k,201) = b(k,201) - lu(k,2095) * b(k,224) + b(k,200) = b(k,200) - lu(k,2094) * b(k,224) + b(k,199) = b(k,199) - lu(k,2093) * b(k,224) + b(k,197) = b(k,197) - lu(k,2092) * b(k,224) + b(k,196) = b(k,196) - lu(k,2091) * b(k,224) + b(k,195) = b(k,195) - lu(k,2090) * b(k,224) + b(k,194) = b(k,194) - lu(k,2089) * b(k,224) + b(k,193) = b(k,193) - lu(k,2088) * b(k,224) + b(k,192) = b(k,192) - lu(k,2087) * b(k,224) + b(k,190) = b(k,190) - lu(k,2086) * b(k,224) + b(k,189) = b(k,189) - lu(k,2085) * b(k,224) + b(k,186) = b(k,186) - lu(k,2084) * b(k,224) + b(k,185) = b(k,185) - lu(k,2083) * b(k,224) + b(k,183) = b(k,183) - lu(k,2082) * b(k,224) + b(k,182) = b(k,182) - lu(k,2081) * b(k,224) + b(k,181) = b(k,181) - lu(k,2080) * b(k,224) + b(k,179) = b(k,179) - lu(k,2079) * b(k,224) + b(k,178) = b(k,178) - lu(k,2078) * b(k,224) + b(k,176) = b(k,176) - lu(k,2077) * b(k,224) + b(k,173) = b(k,173) - lu(k,2076) * b(k,224) + b(k,172) = b(k,172) - lu(k,2075) * b(k,224) + b(k,171) = b(k,171) - lu(k,2074) * b(k,224) + b(k,170) = b(k,170) - lu(k,2073) * b(k,224) + b(k,168) = b(k,168) - lu(k,2072) * b(k,224) + b(k,167) = b(k,167) - lu(k,2071) * b(k,224) + b(k,166) = b(k,166) - lu(k,2070) * b(k,224) + b(k,165) = b(k,165) - lu(k,2069) * b(k,224) + b(k,164) = b(k,164) - lu(k,2068) * b(k,224) + b(k,163) = b(k,163) - lu(k,2067) * b(k,224) + b(k,162) = b(k,162) - lu(k,2066) * b(k,224) + b(k,161) = b(k,161) - lu(k,2065) * b(k,224) + b(k,160) = b(k,160) - lu(k,2064) * b(k,224) + b(k,159) = b(k,159) - lu(k,2063) * b(k,224) + b(k,158) = b(k,158) - lu(k,2062) * b(k,224) + b(k,157) = b(k,157) - lu(k,2061) * b(k,224) + b(k,156) = b(k,156) - lu(k,2060) * b(k,224) + b(k,155) = b(k,155) - lu(k,2059) * b(k,224) + b(k,154) = b(k,154) - lu(k,2058) * b(k,224) + b(k,152) = b(k,152) - lu(k,2057) * b(k,224) + b(k,150) = b(k,150) - lu(k,2056) * b(k,224) + b(k,149) = b(k,149) - lu(k,2055) * b(k,224) + b(k,141) = b(k,141) - lu(k,2054) * b(k,224) + b(k,138) = b(k,138) - lu(k,2053) * b(k,224) + b(k,135) = b(k,135) - lu(k,2052) * b(k,224) + b(k,133) = b(k,133) - lu(k,2051) * b(k,224) + b(k,132) = b(k,132) - lu(k,2050) * b(k,224) + b(k,130) = b(k,130) - lu(k,2049) * b(k,224) + b(k,129) = b(k,129) - lu(k,2048) * b(k,224) + b(k,128) = b(k,128) - lu(k,2047) * b(k,224) + b(k,127) = b(k,127) - lu(k,2046) * b(k,224) + b(k,126) = b(k,126) - lu(k,2045) * b(k,224) + b(k,125) = b(k,125) - lu(k,2044) * b(k,224) + b(k,124) = b(k,124) - lu(k,2043) * b(k,224) + b(k,123) = b(k,123) - lu(k,2042) * b(k,224) + b(k,122) = b(k,122) - lu(k,2041) * b(k,224) + b(k,121) = b(k,121) - lu(k,2040) * b(k,224) + b(k,120) = b(k,120) - lu(k,2039) * b(k,224) + b(k,119) = b(k,119) - lu(k,2038) * b(k,224) + b(k,118) = b(k,118) - lu(k,2037) * b(k,224) + b(k,110) = b(k,110) - lu(k,2036) * b(k,224) + b(k,109) = b(k,109) - lu(k,2035) * b(k,224) + b(k,108) = b(k,108) - lu(k,2034) * b(k,224) + b(k,105) = b(k,105) - lu(k,2033) * b(k,224) + b(k,104) = b(k,104) - lu(k,2032) * b(k,224) + b(k,96) = b(k,96) - lu(k,2031) * b(k,224) + b(k,95) = b(k,95) - lu(k,2030) * b(k,224) + b(k,81) = b(k,81) - lu(k,2029) * b(k,224) + b(k,64) = b(k,64) - lu(k,2028) * b(k,224) + b(k,53) = b(k,53) - lu(k,2027) * b(k,224) + b(k,52) = b(k,52) - lu(k,2026) * b(k,224) + b(k,51) = b(k,51) - lu(k,2025) * b(k,224) + b(k,49) = b(k,49) - lu(k,2024) * b(k,224) + b(k,48) = b(k,48) - lu(k,2023) * b(k,224) + b(k,47) = b(k,47) - lu(k,2022) * b(k,224) + b(k,46) = b(k,46) - lu(k,2021) * b(k,224) + b(k,43) = b(k,43) - lu(k,2020) * b(k,224) + b(k,42) = b(k,42) - lu(k,2019) * b(k,224) + b(k,41) = b(k,41) - lu(k,2018) * b(k,224) + b(k,40) = b(k,40) - lu(k,2017) * b(k,224) + b(k,39) = b(k,39) - lu(k,2016) * b(k,224) + 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,223) = b(k,223) * lu(k,2009) + b(k,222) = b(k,222) - lu(k,2008) * b(k,223) + b(k,221) = b(k,221) - lu(k,2007) * b(k,223) + b(k,220) = b(k,220) - lu(k,2006) * b(k,223) + b(k,219) = b(k,219) - lu(k,2005) * b(k,223) + b(k,218) = b(k,218) - lu(k,2004) * b(k,223) + b(k,217) = b(k,217) - lu(k,2003) * b(k,223) + b(k,216) = b(k,216) - lu(k,2002) * b(k,223) + b(k,215) = b(k,215) - lu(k,2001) * b(k,223) + b(k,214) = b(k,214) - lu(k,2000) * b(k,223) + b(k,213) = b(k,213) - lu(k,1999) * b(k,223) + b(k,212) = b(k,212) - lu(k,1998) * b(k,223) + b(k,211) = b(k,211) - lu(k,1997) * b(k,223) + b(k,210) = b(k,210) - lu(k,1996) * b(k,223) + b(k,209) = b(k,209) - lu(k,1995) * b(k,223) + b(k,195) = b(k,195) - lu(k,1994) * b(k,223) + b(k,193) = b(k,193) - lu(k,1993) * b(k,223) + b(k,192) = b(k,192) - lu(k,1992) * b(k,223) + b(k,186) = b(k,186) - lu(k,1991) * b(k,223) + b(k,183) = b(k,183) - lu(k,1990) * b(k,223) + b(k,180) = b(k,180) - lu(k,1989) * b(k,223) + b(k,173) = b(k,173) - lu(k,1988) * b(k,223) + b(k,172) = b(k,172) - lu(k,1987) * b(k,223) + b(k,160) = b(k,160) - lu(k,1986) * b(k,223) + b(k,149) = b(k,149) - lu(k,1985) * b(k,223) + b(k,148) = b(k,148) - lu(k,1984) * b(k,223) + b(k,142) = b(k,142) - lu(k,1983) * b(k,223) + b(k,131) = b(k,131) - lu(k,1982) * b(k,223) + b(k,117) = b(k,117) - lu(k,1981) * b(k,223) + b(k,114) = b(k,114) - lu(k,1980) * b(k,223) + b(k,103) = b(k,103) - lu(k,1979) * b(k,223) + b(k,101) = b(k,101) - lu(k,1978) * b(k,223) + b(k,75) = b(k,75) - lu(k,1977) * b(k,223) + b(k,222) = b(k,222) * lu(k,1969) + b(k,221) = b(k,221) - lu(k,1968) * b(k,222) + b(k,220) = b(k,220) - lu(k,1967) * b(k,222) + b(k,219) = b(k,219) - lu(k,1966) * b(k,222) + b(k,218) = b(k,218) - lu(k,1965) * b(k,222) + b(k,217) = b(k,217) - lu(k,1964) * b(k,222) + b(k,216) = b(k,216) - lu(k,1963) * b(k,222) + b(k,215) = b(k,215) - lu(k,1962) * b(k,222) + b(k,214) = b(k,214) - lu(k,1961) * b(k,222) + b(k,213) = b(k,213) - lu(k,1960) * b(k,222) + b(k,212) = b(k,212) - lu(k,1959) * b(k,222) + b(k,211) = b(k,211) - lu(k,1958) * b(k,222) + b(k,209) = b(k,209) - lu(k,1957) * b(k,222) + b(k,208) = b(k,208) - lu(k,1956) * b(k,222) + b(k,203) = b(k,203) - lu(k,1955) * b(k,222) + b(k,202) = b(k,202) - lu(k,1954) * b(k,222) + b(k,197) = b(k,197) - lu(k,1953) * b(k,222) + b(k,195) = b(k,195) - lu(k,1952) * b(k,222) + b(k,186) = b(k,186) - lu(k,1951) * b(k,222) + b(k,180) = b(k,180) - lu(k,1950) * b(k,222) + b(k,178) = b(k,178) - lu(k,1949) * b(k,222) + b(k,175) = b(k,175) - lu(k,1948) * b(k,222) + b(k,170) = b(k,170) - lu(k,1947) * b(k,222) + b(k,167) = b(k,167) - lu(k,1946) * b(k,222) + b(k,165) = b(k,165) - lu(k,1945) * b(k,222) + b(k,161) = b(k,161) - lu(k,1944) * b(k,222) + b(k,152) = b(k,152) - lu(k,1943) * b(k,222) + b(k,145) = b(k,145) - lu(k,1942) * b(k,222) + b(k,143) = b(k,143) - lu(k,1941) * b(k,222) + b(k,139) = b(k,139) - lu(k,1940) * b(k,222) + b(k,138) = b(k,138) - lu(k,1939) * b(k,222) + b(k,134) = b(k,134) - lu(k,1938) * b(k,222) + b(k,130) = b(k,130) - lu(k,1937) * b(k,222) + b(k,123) = b(k,123) - lu(k,1936) * b(k,222) + b(k,97) = b(k,97) - lu(k,1935) * b(k,222) + b(k,77) = b(k,77) - lu(k,1934) * b(k,222) + b(k,67) = b(k,67) - lu(k,1933) * b(k,222) + b(k,221) = b(k,221) * lu(k,1924) + b(k,220) = b(k,220) - lu(k,1923) * b(k,221) + b(k,219) = b(k,219) - lu(k,1922) * b(k,221) + b(k,218) = b(k,218) - lu(k,1921) * b(k,221) + b(k,217) = b(k,217) - lu(k,1920) * b(k,221) + b(k,216) = b(k,216) - lu(k,1919) * b(k,221) + b(k,215) = b(k,215) - lu(k,1918) * b(k,221) + b(k,214) = b(k,214) - lu(k,1917) * b(k,221) + b(k,213) = b(k,213) - lu(k,1916) * b(k,221) + b(k,212) = b(k,212) - lu(k,1915) * b(k,221) + b(k,211) = b(k,211) - lu(k,1914) * b(k,221) + b(k,209) = b(k,209) - lu(k,1913) * b(k,221) + b(k,208) = b(k,208) - lu(k,1912) * b(k,221) + b(k,207) = b(k,207) - lu(k,1911) * b(k,221) + b(k,206) = b(k,206) - lu(k,1910) * b(k,221) + b(k,205) = b(k,205) - lu(k,1909) * b(k,221) + b(k,204) = b(k,204) - lu(k,1908) * b(k,221) + b(k,202) = b(k,202) - lu(k,1907) * b(k,221) + b(k,201) = b(k,201) - lu(k,1906) * b(k,221) + b(k,200) = b(k,200) - lu(k,1905) * b(k,221) + b(k,199) = b(k,199) - lu(k,1904) * b(k,221) + b(k,198) = b(k,198) - lu(k,1903) * b(k,221) + b(k,197) = b(k,197) - lu(k,1902) * b(k,221) + b(k,196) = b(k,196) - lu(k,1901) * b(k,221) + b(k,195) = b(k,195) - lu(k,1900) * b(k,221) + b(k,194) = b(k,194) - lu(k,1899) * b(k,221) + b(k,193) = b(k,193) - lu(k,1898) * b(k,221) + b(k,192) = b(k,192) - lu(k,1897) * b(k,221) + b(k,191) = b(k,191) - lu(k,1896) * b(k,221) + b(k,190) = b(k,190) - lu(k,1895) * b(k,221) + b(k,189) = b(k,189) - lu(k,1894) * b(k,221) + b(k,186) = b(k,186) - lu(k,1893) * b(k,221) + b(k,185) = b(k,185) - lu(k,1892) * b(k,221) + b(k,183) = b(k,183) - lu(k,1891) * b(k,221) + b(k,182) = b(k,182) - lu(k,1890) * b(k,221) + b(k,181) = b(k,181) - lu(k,1889) * b(k,221) + b(k,179) = b(k,179) - lu(k,1888) * b(k,221) + b(k,178) = b(k,178) - lu(k,1887) * b(k,221) + b(k,176) = b(k,176) - lu(k,1886) * b(k,221) + b(k,173) = b(k,173) - lu(k,1885) * b(k,221) + b(k,170) = b(k,170) - lu(k,1884) * b(k,221) + b(k,168) = b(k,168) - lu(k,1883) * b(k,221) + b(k,166) = b(k,166) - lu(k,1882) * b(k,221) + b(k,165) = b(k,165) - lu(k,1881) * b(k,221) + b(k,164) = b(k,164) - lu(k,1880) * b(k,221) + b(k,162) = b(k,162) - lu(k,1879) * b(k,221) + b(k,161) = b(k,161) - lu(k,1878) * b(k,221) + b(k,160) = b(k,160) - lu(k,1877) * b(k,221) + b(k,157) = b(k,157) - lu(k,1876) * b(k,221) + b(k,153) = b(k,153) - lu(k,1875) * b(k,221) + b(k,152) = b(k,152) - lu(k,1874) * b(k,221) + b(k,151) = b(k,151) - lu(k,1873) * b(k,221) + b(k,147) = b(k,147) - lu(k,1872) * b(k,221) + b(k,146) = b(k,146) - lu(k,1871) * b(k,221) + b(k,144) = b(k,144) - lu(k,1870) * b(k,221) + b(k,140) = b(k,140) - lu(k,1869) * b(k,221) + b(k,138) = b(k,138) - lu(k,1868) * b(k,221) + b(k,136) = b(k,136) - lu(k,1867) * b(k,221) + b(k,135) = b(k,135) - lu(k,1866) * b(k,221) + b(k,134) = b(k,134) - lu(k,1865) * b(k,221) + b(k,133) = b(k,133) - lu(k,1864) * b(k,221) + b(k,130) = b(k,130) - lu(k,1863) * b(k,221) + b(k,129) = b(k,129) - lu(k,1862) * b(k,221) + b(k,127) = b(k,127) - lu(k,1861) * b(k,221) + b(k,126) = b(k,126) - lu(k,1860) * b(k,221) + b(k,125) = b(k,125) - lu(k,1859) * b(k,221) + b(k,111) = b(k,111) - lu(k,1858) * b(k,221) + b(k,106) = b(k,106) - lu(k,1857) * b(k,221) + b(k,98) = b(k,98) - lu(k,1856) * b(k,221) + b(k,96) = b(k,96) - lu(k,1855) * b(k,221) + b(k,88) = b(k,88) - lu(k,1854) * b(k,221) + b(k,87) = b(k,87) - lu(k,1853) * b(k,221) + b(k,53) = b(k,53) - lu(k,1852) * b(k,221) + b(k,52) = b(k,52) - lu(k,1851) * b(k,221) + b(k,51) = b(k,51) - lu(k,1850) * b(k,221) + b(k,49) = b(k,49) - lu(k,1849) * b(k,221) + b(k,48) = b(k,48) - lu(k,1848) * b(k,221) + b(k,47) = b(k,47) - lu(k,1847) * b(k,221) + b(k,46) = b(k,46) - lu(k,1846) * b(k,221) + b(k,43) = b(k,43) - lu(k,1845) * b(k,221) + b(k,42) = b(k,42) - lu(k,1844) * b(k,221) + b(k,41) = b(k,41) - lu(k,1843) * b(k,221) + b(k,40) = b(k,40) - lu(k,1842) * b(k,221) + b(k,39) = b(k,39) - lu(k,1841) * b(k,221) + b(k,220) = b(k,220) * lu(k,1831) + b(k,219) = b(k,219) - lu(k,1830) * b(k,220) + b(k,218) = b(k,218) - lu(k,1829) * b(k,220) + b(k,217) = b(k,217) - lu(k,1828) * b(k,220) + b(k,216) = b(k,216) - lu(k,1827) * b(k,220) + b(k,215) = b(k,215) - lu(k,1826) * b(k,220) + b(k,214) = b(k,214) - lu(k,1825) * b(k,220) + b(k,213) = b(k,213) - lu(k,1824) * b(k,220) + b(k,212) = b(k,212) - lu(k,1823) * b(k,220) + b(k,209) = b(k,209) - lu(k,1822) * b(k,220) + b(k,208) = b(k,208) - lu(k,1821) * b(k,220) + b(k,207) = b(k,207) - lu(k,1820) * b(k,220) + b(k,206) = b(k,206) - lu(k,1819) * b(k,220) + b(k,205) = b(k,205) - lu(k,1818) * b(k,220) + b(k,204) = b(k,204) - lu(k,1817) * b(k,220) + b(k,202) = b(k,202) - lu(k,1816) * b(k,220) + b(k,201) = b(k,201) - lu(k,1815) * b(k,220) + b(k,200) = b(k,200) - lu(k,1814) * b(k,220) + b(k,199) = b(k,199) - lu(k,1813) * b(k,220) + b(k,197) = b(k,197) - lu(k,1812) * b(k,220) + b(k,196) = b(k,196) - lu(k,1811) * b(k,220) + b(k,195) = b(k,195) - lu(k,1810) * b(k,220) + b(k,194) = b(k,194) - lu(k,1809) * b(k,220) + b(k,193) = b(k,193) - lu(k,1808) * b(k,220) + b(k,192) = b(k,192) - lu(k,1807) * b(k,220) + b(k,191) = b(k,191) - lu(k,1806) * b(k,220) + b(k,190) = b(k,190) - lu(k,1805) * b(k,220) + b(k,189) = b(k,189) - lu(k,1804) * b(k,220) + b(k,186) = b(k,186) - lu(k,1803) * b(k,220) + b(k,185) = b(k,185) - lu(k,1802) * b(k,220) + b(k,182) = b(k,182) - lu(k,1801) * b(k,220) + b(k,181) = b(k,181) - lu(k,1800) * b(k,220) + b(k,176) = b(k,176) - lu(k,1799) * b(k,220) + b(k,173) = b(k,173) - lu(k,1798) * b(k,220) + b(k,170) = b(k,170) - lu(k,1797) * b(k,220) + b(k,169) = b(k,169) - lu(k,1796) * b(k,220) + b(k,168) = b(k,168) - lu(k,1795) * b(k,220) + b(k,158) = b(k,158) - lu(k,1794) * b(k,220) + b(k,151) = b(k,151) - lu(k,1793) * b(k,220) + b(k,128) = b(k,128) - lu(k,1792) * b(k,220) + b(k,115) = b(k,115) - lu(k,1791) * b(k,220) + b(k,111) = b(k,111) - lu(k,1790) * b(k,220) + b(k,94) = b(k,94) - lu(k,1789) * b(k,220) + b(k,219) = b(k,219) * lu(k,1778) + b(k,218) = b(k,218) - lu(k,1777) * b(k,219) + b(k,217) = b(k,217) - lu(k,1776) * b(k,219) + b(k,216) = b(k,216) - lu(k,1775) * b(k,219) + b(k,215) = b(k,215) - lu(k,1774) * b(k,219) + b(k,214) = b(k,214) - lu(k,1773) * b(k,219) + b(k,213) = b(k,213) - lu(k,1772) * b(k,219) + b(k,212) = b(k,212) - lu(k,1771) * b(k,219) + b(k,211) = b(k,211) - lu(k,1770) * b(k,219) + b(k,209) = b(k,209) - lu(k,1769) * b(k,219) + b(k,208) = b(k,208) - lu(k,1768) * b(k,219) + b(k,207) = b(k,207) - lu(k,1767) * b(k,219) + b(k,206) = b(k,206) - lu(k,1766) * b(k,219) + b(k,205) = b(k,205) - lu(k,1765) * b(k,219) + b(k,204) = b(k,204) - lu(k,1764) * b(k,219) + b(k,203) = b(k,203) - lu(k,1763) * b(k,219) + b(k,202) = b(k,202) - lu(k,1762) * b(k,219) + b(k,201) = b(k,201) - lu(k,1761) * b(k,219) + b(k,200) = b(k,200) - lu(k,1760) * b(k,219) + b(k,199) = b(k,199) - lu(k,1759) * b(k,219) + b(k,198) = b(k,198) - lu(k,1758) * b(k,219) + b(k,197) = b(k,197) - lu(k,1757) * b(k,219) + b(k,196) = b(k,196) - lu(k,1756) * b(k,219) + b(k,195) = b(k,195) - lu(k,1755) * b(k,219) + b(k,194) = b(k,194) - lu(k,1754) * b(k,219) + b(k,193) = b(k,193) - lu(k,1753) * b(k,219) + b(k,192) = b(k,192) - lu(k,1752) * b(k,219) + b(k,191) = b(k,191) - lu(k,1751) * b(k,219) + b(k,190) = b(k,190) - lu(k,1750) * b(k,219) + b(k,189) = b(k,189) - lu(k,1749) * b(k,219) + b(k,188) = b(k,188) - lu(k,1748) * b(k,219) + b(k,187) = b(k,187) - lu(k,1747) * b(k,219) + b(k,186) = b(k,186) - lu(k,1746) * b(k,219) + b(k,185) = b(k,185) - lu(k,1745) * b(k,219) + b(k,184) = b(k,184) - lu(k,1744) * b(k,219) + b(k,183) = b(k,183) - lu(k,1743) * b(k,219) + b(k,182) = b(k,182) - lu(k,1742) * b(k,219) + b(k,176) = b(k,176) - lu(k,1741) * b(k,219) + b(k,175) = b(k,175) - lu(k,1740) * b(k,219) + b(k,174) = b(k,174) - lu(k,1739) * b(k,219) + b(k,144) = b(k,144) - lu(k,1738) * b(k,219) + b(k,112) = b(k,112) - lu(k,1737) * b(k,219) + b(k,111) = b(k,111) - lu(k,1736) * b(k,219) + b(k,99) = b(k,99) - lu(k,1735) * b(k,219) + b(k,97) = b(k,97) - lu(k,1734) * b(k,219) + b(k,43) = b(k,43) - lu(k,1733) * b(k,219) + b(k,42) = b(k,42) - lu(k,1732) * b(k,219) + end do + end subroutine lu_slv08 + subroutine lu_slv09( 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,218) = b(k,218) * lu(k,1720) + b(k,217) = b(k,217) - lu(k,1719) * b(k,218) + b(k,216) = b(k,216) - lu(k,1718) * b(k,218) + b(k,215) = b(k,215) - lu(k,1717) * b(k,218) + b(k,214) = b(k,214) - lu(k,1716) * b(k,218) + b(k,213) = b(k,213) - lu(k,1715) * b(k,218) + b(k,211) = b(k,211) - lu(k,1714) * b(k,218) + b(k,203) = b(k,203) - lu(k,1713) * b(k,218) + b(k,180) = b(k,180) - lu(k,1712) * b(k,218) + b(k,175) = b(k,175) - lu(k,1711) * b(k,218) + b(k,172) = b(k,172) - lu(k,1710) * b(k,218) + b(k,107) = b(k,107) - lu(k,1709) * b(k,218) + b(k,86) = b(k,86) - lu(k,1708) * b(k,218) + b(k,75) = b(k,75) - lu(k,1707) * b(k,218) + b(k,54) = b(k,54) - lu(k,1706) * b(k,218) + b(k,217) = b(k,217) * lu(k,1693) + b(k,216) = b(k,216) - lu(k,1692) * b(k,217) + b(k,215) = b(k,215) - lu(k,1691) * b(k,217) + b(k,214) = b(k,214) - lu(k,1690) * b(k,217) + b(k,213) = b(k,213) - lu(k,1689) * b(k,217) + b(k,212) = b(k,212) - lu(k,1688) * b(k,217) + b(k,211) = b(k,211) - lu(k,1687) * b(k,217) + b(k,210) = b(k,210) - lu(k,1686) * b(k,217) + b(k,209) = b(k,209) - lu(k,1685) * b(k,217) + b(k,208) = b(k,208) - lu(k,1684) * b(k,217) + b(k,207) = b(k,207) - lu(k,1683) * b(k,217) + b(k,206) = b(k,206) - lu(k,1682) * b(k,217) + b(k,205) = b(k,205) - lu(k,1681) * b(k,217) + b(k,204) = b(k,204) - lu(k,1680) * b(k,217) + b(k,203) = b(k,203) - lu(k,1679) * b(k,217) + b(k,202) = b(k,202) - lu(k,1678) * b(k,217) + b(k,201) = b(k,201) - lu(k,1677) * b(k,217) + b(k,200) = b(k,200) - lu(k,1676) * b(k,217) + b(k,199) = b(k,199) - lu(k,1675) * b(k,217) + b(k,198) = b(k,198) - lu(k,1674) * b(k,217) + b(k,197) = b(k,197) - lu(k,1673) * b(k,217) + b(k,196) = b(k,196) - lu(k,1672) * b(k,217) + b(k,195) = b(k,195) - lu(k,1671) * b(k,217) + b(k,194) = b(k,194) - lu(k,1670) * b(k,217) + b(k,193) = b(k,193) - lu(k,1669) * b(k,217) + b(k,192) = b(k,192) - lu(k,1668) * b(k,217) + b(k,191) = b(k,191) - lu(k,1667) * b(k,217) + b(k,190) = b(k,190) - lu(k,1666) * b(k,217) + b(k,189) = b(k,189) - lu(k,1665) * b(k,217) + b(k,188) = b(k,188) - lu(k,1664) * b(k,217) + b(k,187) = b(k,187) - lu(k,1663) * b(k,217) + b(k,186) = b(k,186) - lu(k,1662) * b(k,217) + b(k,185) = b(k,185) - lu(k,1661) * b(k,217) + b(k,184) = b(k,184) - lu(k,1660) * b(k,217) + b(k,183) = b(k,183) - lu(k,1659) * b(k,217) + b(k,182) = b(k,182) - lu(k,1658) * b(k,217) + b(k,181) = b(k,181) - lu(k,1657) * b(k,217) + b(k,180) = b(k,180) - lu(k,1656) * b(k,217) + b(k,179) = b(k,179) - lu(k,1655) * b(k,217) + b(k,178) = b(k,178) - lu(k,1654) * b(k,217) + b(k,177) = b(k,177) - lu(k,1653) * b(k,217) + b(k,176) = b(k,176) - lu(k,1652) * b(k,217) + b(k,175) = b(k,175) - lu(k,1651) * b(k,217) + b(k,174) = b(k,174) - lu(k,1650) * b(k,217) + b(k,173) = b(k,173) - lu(k,1649) * b(k,217) + b(k,172) = b(k,172) - lu(k,1648) * b(k,217) + b(k,171) = b(k,171) - lu(k,1647) * b(k,217) + b(k,170) = b(k,170) - lu(k,1646) * b(k,217) + b(k,169) = b(k,169) - lu(k,1645) * b(k,217) + b(k,168) = b(k,168) - lu(k,1644) * b(k,217) + b(k,166) = b(k,166) - lu(k,1643) * b(k,217) + b(k,165) = b(k,165) - lu(k,1642) * b(k,217) + b(k,164) = b(k,164) - lu(k,1641) * b(k,217) + b(k,163) = b(k,163) - lu(k,1640) * b(k,217) + b(k,162) = b(k,162) - lu(k,1639) * b(k,217) + b(k,161) = b(k,161) - lu(k,1638) * b(k,217) + b(k,160) = b(k,160) - lu(k,1637) * b(k,217) + b(k,159) = b(k,159) - lu(k,1636) * b(k,217) + b(k,158) = b(k,158) - lu(k,1635) * b(k,217) + b(k,157) = b(k,157) - lu(k,1634) * b(k,217) + b(k,156) = b(k,156) - lu(k,1633) * b(k,217) + b(k,155) = b(k,155) - lu(k,1632) * b(k,217) + b(k,154) = b(k,154) - lu(k,1631) * b(k,217) + b(k,153) = b(k,153) - lu(k,1630) * b(k,217) + b(k,152) = b(k,152) - lu(k,1629) * b(k,217) + b(k,151) = b(k,151) - lu(k,1628) * b(k,217) + b(k,150) = b(k,150) - lu(k,1627) * b(k,217) + b(k,149) = b(k,149) - lu(k,1626) * b(k,217) + b(k,148) = b(k,148) - lu(k,1625) * b(k,217) + b(k,147) = b(k,147) - lu(k,1624) * b(k,217) + b(k,146) = b(k,146) - lu(k,1623) * b(k,217) + b(k,145) = b(k,145) - lu(k,1622) * b(k,217) + b(k,144) = b(k,144) - lu(k,1621) * b(k,217) + b(k,142) = b(k,142) - lu(k,1620) * b(k,217) + b(k,141) = b(k,141) - lu(k,1619) * b(k,217) + b(k,140) = b(k,140) - lu(k,1618) * b(k,217) + b(k,139) = b(k,139) - lu(k,1617) * b(k,217) + b(k,138) = b(k,138) - lu(k,1616) * b(k,217) + b(k,137) = b(k,137) - lu(k,1615) * b(k,217) + b(k,136) = b(k,136) - lu(k,1614) * b(k,217) + b(k,135) = b(k,135) - lu(k,1613) * b(k,217) + b(k,134) = b(k,134) - lu(k,1612) * b(k,217) + b(k,133) = b(k,133) - lu(k,1611) * b(k,217) + b(k,132) = b(k,132) - lu(k,1610) * b(k,217) + b(k,131) = b(k,131) - lu(k,1609) * b(k,217) + b(k,130) = b(k,130) - lu(k,1608) * b(k,217) + b(k,129) = b(k,129) - lu(k,1607) * b(k,217) + b(k,128) = b(k,128) - lu(k,1606) * b(k,217) + b(k,127) = b(k,127) - lu(k,1605) * b(k,217) + b(k,125) = b(k,125) - lu(k,1604) * b(k,217) + b(k,124) = b(k,124) - lu(k,1603) * b(k,217) + b(k,123) = b(k,123) - lu(k,1602) * b(k,217) + b(k,122) = b(k,122) - lu(k,1601) * b(k,217) + b(k,121) = b(k,121) - lu(k,1600) * b(k,217) + b(k,120) = b(k,120) - lu(k,1599) * b(k,217) + b(k,119) = b(k,119) - lu(k,1598) * b(k,217) + b(k,118) = b(k,118) - lu(k,1597) * b(k,217) + b(k,117) = b(k,117) - lu(k,1596) * b(k,217) + b(k,115) = b(k,115) - lu(k,1595) * b(k,217) + b(k,114) = b(k,114) - lu(k,1594) * b(k,217) + b(k,113) = b(k,113) - lu(k,1593) * b(k,217) + b(k,112) = b(k,112) - lu(k,1592) * b(k,217) + b(k,111) = b(k,111) - lu(k,1591) * b(k,217) + b(k,110) = b(k,110) - lu(k,1590) * b(k,217) + b(k,109) = b(k,109) - lu(k,1589) * b(k,217) + b(k,108) = b(k,108) - lu(k,1588) * b(k,217) + b(k,105) = b(k,105) - lu(k,1587) * b(k,217) + b(k,104) = b(k,104) - lu(k,1586) * b(k,217) + b(k,103) = b(k,103) - lu(k,1585) * b(k,217) + b(k,102) = b(k,102) - lu(k,1584) * b(k,217) + b(k,101) = b(k,101) - lu(k,1583) * b(k,217) + b(k,99) = b(k,99) - lu(k,1582) * b(k,217) + b(k,95) = b(k,95) - lu(k,1581) * b(k,217) + b(k,94) = b(k,94) - lu(k,1580) * b(k,217) + b(k,93) = b(k,93) - lu(k,1579) * b(k,217) + b(k,92) = b(k,92) - lu(k,1578) * b(k,217) + b(k,91) = b(k,91) - lu(k,1577) * b(k,217) + b(k,90) = b(k,90) - lu(k,1576) * b(k,217) + b(k,89) = b(k,89) - lu(k,1575) * b(k,217) + b(k,88) = b(k,88) - lu(k,1574) * b(k,217) + b(k,87) = b(k,87) - lu(k,1573) * b(k,217) + b(k,85) = b(k,85) - lu(k,1572) * b(k,217) + b(k,84) = b(k,84) - lu(k,1571) * b(k,217) + b(k,83) = b(k,83) - lu(k,1570) * b(k,217) + b(k,82) = b(k,82) - lu(k,1569) * b(k,217) + b(k,81) = b(k,81) - lu(k,1568) * b(k,217) + b(k,80) = b(k,80) - lu(k,1567) * b(k,217) + b(k,79) = b(k,79) - lu(k,1566) * b(k,217) + b(k,78) = b(k,78) - lu(k,1565) * b(k,217) + b(k,76) = b(k,76) - lu(k,1564) * b(k,217) + b(k,74) = b(k,74) - lu(k,1563) * b(k,217) + b(k,73) = b(k,73) - lu(k,1562) * b(k,217) + b(k,72) = b(k,72) - lu(k,1561) * b(k,217) + b(k,66) = b(k,66) - lu(k,1560) * b(k,217) + b(k,63) = b(k,63) - lu(k,1559) * b(k,217) + b(k,59) = b(k,59) - lu(k,1558) * b(k,217) + b(k,57) = b(k,57) - lu(k,1557) * b(k,217) + b(k,55) = b(k,55) - lu(k,1556) * b(k,217) + b(k,53) = b(k,53) - lu(k,1555) * b(k,217) + b(k,52) = b(k,52) - lu(k,1554) * b(k,217) + b(k,51) = b(k,51) - lu(k,1553) * b(k,217) + b(k,50) = b(k,50) - lu(k,1552) * b(k,217) + b(k,49) = b(k,49) - lu(k,1551) * b(k,217) + b(k,48) = b(k,48) - lu(k,1550) * b(k,217) + b(k,47) = b(k,47) - lu(k,1549) * b(k,217) + b(k,46) = b(k,46) - lu(k,1548) * b(k,217) + b(k,45) = b(k,45) - lu(k,1547) * b(k,217) + b(k,43) = b(k,43) - lu(k,1546) * b(k,217) + b(k,42) = b(k,42) - lu(k,1545) * b(k,217) + b(k,41) = b(k,41) - lu(k,1544) * b(k,217) + b(k,40) = b(k,40) - lu(k,1543) * b(k,217) + b(k,39) = b(k,39) - lu(k,1542) * b(k,217) + b(k,216) = b(k,216) * lu(k,1528) + b(k,215) = b(k,215) - lu(k,1527) * b(k,216) + b(k,214) = b(k,214) - lu(k,1526) * b(k,216) + b(k,213) = b(k,213) - lu(k,1525) * b(k,216) + b(k,212) = b(k,212) - lu(k,1524) * b(k,216) + b(k,211) = b(k,211) - lu(k,1523) * b(k,216) + b(k,210) = b(k,210) - lu(k,1522) * b(k,216) + b(k,177) = b(k,177) - lu(k,1521) * b(k,216) + b(k,171) = b(k,171) - lu(k,1520) * b(k,216) + b(k,148) = b(k,148) - lu(k,1519) * b(k,216) + b(k,131) = b(k,131) - lu(k,1518) * b(k,216) + b(k,117) = b(k,117) - lu(k,1517) * b(k,216) + b(k,102) = b(k,102) - lu(k,1516) * b(k,216) + b(k,92) = b(k,92) - lu(k,1515) * b(k,216) + b(k,91) = b(k,91) - lu(k,1514) * b(k,216) + b(k,90) = b(k,90) - lu(k,1513) * b(k,216) + b(k,89) = b(k,89) - lu(k,1512) * b(k,216) + b(k,77) = b(k,77) - lu(k,1511) * b(k,216) + b(k,76) = b(k,76) - lu(k,1510) * b(k,216) + b(k,71) = b(k,71) - lu(k,1509) * b(k,216) + b(k,70) = b(k,70) - lu(k,1508) * b(k,216) + b(k,69) = b(k,69) - lu(k,1507) * b(k,216) + b(k,68) = b(k,68) - lu(k,1506) * b(k,216) + b(k,62) = b(k,62) - lu(k,1505) * b(k,216) + b(k,61) = b(k,61) - lu(k,1504) * b(k,216) + b(k,60) = b(k,60) - lu(k,1503) * b(k,216) + b(k,58) = b(k,58) - lu(k,1502) * b(k,216) + b(k,56) = b(k,56) - lu(k,1501) * b(k,216) + b(k,215) = b(k,215) * lu(k,1487) + b(k,214) = b(k,214) - lu(k,1486) * b(k,215) + b(k,213) = b(k,213) - lu(k,1485) * b(k,215) + b(k,212) = b(k,212) - lu(k,1484) * b(k,215) + b(k,211) = b(k,211) - lu(k,1483) * b(k,215) + b(k,210) = b(k,210) - lu(k,1482) * b(k,215) + b(k,195) = b(k,195) - lu(k,1481) * b(k,215) + b(k,183) = b(k,183) - lu(k,1480) * b(k,215) + b(k,171) = b(k,171) - lu(k,1479) * b(k,215) + b(k,126) = b(k,126) - lu(k,1478) * b(k,215) + end do + end subroutine lu_slv09 + subroutine lu_slv10( 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,214) = b(k,214) * lu(k,1465) + b(k,213) = b(k,213) - lu(k,1464) * b(k,214) + b(k,212) = b(k,212) - lu(k,1463) * b(k,214) + b(k,210) = b(k,210) - lu(k,1462) * b(k,214) + b(k,177) = b(k,177) - lu(k,1461) * b(k,214) + b(k,100) = b(k,100) - lu(k,1460) * b(k,214) + b(k,213) = b(k,213) * lu(k,1447) + b(k,212) = b(k,212) - lu(k,1446) * b(k,213) + b(k,210) = b(k,210) - lu(k,1445) * b(k,213) + b(k,212) = b(k,212) * lu(k,1432) + b(k,210) = b(k,210) - lu(k,1431) * b(k,212) + b(k,195) = b(k,195) - lu(k,1430) * b(k,212) + b(k,177) = b(k,177) - lu(k,1429) * b(k,212) + b(k,170) = b(k,170) - lu(k,1428) * b(k,212) + b(k,100) = b(k,100) - lu(k,1427) * b(k,212) + b(k,211) = b(k,211) * lu(k,1417) + b(k,195) = b(k,195) - lu(k,1416) * b(k,211) + b(k,171) = b(k,171) - lu(k,1415) * b(k,211) + b(k,210) = b(k,210) * lu(k,1403) + b(k,177) = b(k,177) - lu(k,1402) * b(k,210) + b(k,100) = b(k,100) - lu(k,1401) * b(k,210) + b(k,209) = b(k,209) * lu(k,1388) + b(k,208) = b(k,208) - lu(k,1387) * b(k,209) + b(k,207) = b(k,207) - lu(k,1386) * b(k,209) + b(k,206) = b(k,206) - lu(k,1385) * b(k,209) + b(k,205) = b(k,205) - lu(k,1384) * b(k,209) + b(k,204) = b(k,204) - lu(k,1383) * b(k,209) + b(k,202) = b(k,202) - lu(k,1382) * b(k,209) + b(k,201) = b(k,201) - lu(k,1381) * b(k,209) + b(k,200) = b(k,200) - lu(k,1380) * b(k,209) + b(k,199) = b(k,199) - lu(k,1379) * b(k,209) + b(k,197) = b(k,197) - lu(k,1378) * b(k,209) + b(k,195) = b(k,195) - lu(k,1377) * b(k,209) + b(k,193) = b(k,193) - lu(k,1376) * b(k,209) + b(k,191) = b(k,191) - lu(k,1375) * b(k,209) + b(k,186) = b(k,186) - lu(k,1374) * b(k,209) + b(k,170) = b(k,170) - lu(k,1373) * b(k,209) + b(k,158) = b(k,158) - lu(k,1372) * b(k,209) + b(k,150) = b(k,150) - lu(k,1371) * b(k,209) + b(k,139) = b(k,139) - lu(k,1370) * b(k,209) + b(k,111) = b(k,111) - lu(k,1369) * b(k,209) + b(k,208) = b(k,208) * lu(k,1356) + b(k,202) = b(k,202) - lu(k,1355) * b(k,208) + b(k,197) = b(k,197) - lu(k,1354) * b(k,208) + b(k,195) = b(k,195) - lu(k,1353) * b(k,208) + b(k,170) = b(k,170) - lu(k,1352) * b(k,208) + b(k,158) = b(k,158) - lu(k,1351) * b(k,208) + b(k,150) = b(k,150) - lu(k,1350) * b(k,208) + b(k,145) = b(k,145) - lu(k,1349) * b(k,208) + b(k,207) = b(k,207) * lu(k,1334) + b(k,206) = b(k,206) - lu(k,1333) * b(k,207) + b(k,202) = b(k,202) - lu(k,1332) * b(k,207) + b(k,197) = b(k,197) - lu(k,1331) * b(k,207) + b(k,195) = b(k,195) - lu(k,1330) * b(k,207) + b(k,192) = b(k,192) - lu(k,1329) * b(k,207) + b(k,188) = b(k,188) - lu(k,1328) * b(k,207) + b(k,183) = b(k,183) - lu(k,1327) * b(k,207) + b(k,170) = b(k,170) - lu(k,1326) * b(k,207) + b(k,206) = b(k,206) * lu(k,1313) + b(k,202) = b(k,202) - lu(k,1312) * b(k,206) + b(k,198) = b(k,198) - lu(k,1311) * b(k,206) + b(k,197) = b(k,197) - lu(k,1310) * b(k,206) + b(k,195) = b(k,195) - lu(k,1309) * b(k,206) + b(k,193) = b(k,193) - lu(k,1308) * b(k,206) + b(k,169) = b(k,169) - lu(k,1307) * b(k,206) + b(k,104) = b(k,104) - lu(k,1306) * b(k,206) + b(k,205) = b(k,205) * lu(k,1290) + b(k,202) = b(k,202) - lu(k,1289) * b(k,205) + b(k,201) = b(k,201) - lu(k,1288) * b(k,205) + b(k,199) = b(k,199) - lu(k,1287) * b(k,205) + b(k,198) = b(k,198) - lu(k,1286) * b(k,205) + b(k,197) = b(k,197) - lu(k,1285) * b(k,205) + b(k,195) = b(k,195) - lu(k,1284) * b(k,205) + b(k,193) = b(k,193) - lu(k,1283) * b(k,205) + b(k,186) = b(k,186) - lu(k,1282) * b(k,205) + b(k,178) = b(k,178) - lu(k,1281) * b(k,205) + b(k,176) = b(k,176) - lu(k,1280) * b(k,205) + b(k,169) = b(k,169) - lu(k,1279) * b(k,205) + b(k,163) = b(k,163) - lu(k,1278) * b(k,205) + b(k,147) = b(k,147) - lu(k,1277) * b(k,205) + b(k,140) = b(k,140) - lu(k,1276) * b(k,205) + b(k,111) = b(k,111) - lu(k,1275) * b(k,205) + b(k,84) = b(k,84) - lu(k,1274) * b(k,205) + b(k,204) = b(k,204) * lu(k,1258) + b(k,202) = b(k,202) - lu(k,1257) * b(k,204) + b(k,201) = b(k,201) - lu(k,1256) * b(k,204) + b(k,199) = b(k,199) - lu(k,1255) * b(k,204) + b(k,198) = b(k,198) - lu(k,1254) * b(k,204) + b(k,197) = b(k,197) - lu(k,1253) * b(k,204) + b(k,195) = b(k,195) - lu(k,1252) * b(k,204) + b(k,193) = b(k,193) - lu(k,1251) * b(k,204) + b(k,170) = b(k,170) - lu(k,1250) * b(k,204) + b(k,169) = b(k,169) - lu(k,1249) * b(k,204) + b(k,163) = b(k,163) - lu(k,1248) * b(k,204) + b(k,146) = b(k,146) - lu(k,1247) * b(k,204) + b(k,203) = b(k,203) * lu(k,1234) + b(k,175) = b(k,175) - lu(k,1233) * b(k,203) + b(k,137) = b(k,137) - lu(k,1232) * b(k,203) + b(k,107) = b(k,107) - lu(k,1231) * b(k,203) + b(k,202) = b(k,202) * lu(k,1223) + b(k,195) = b(k,195) - lu(k,1222) * b(k,202) + b(k,201) = b(k,201) * lu(k,1211) + b(k,195) = b(k,195) - lu(k,1210) * b(k,201) + b(k,183) = b(k,183) - lu(k,1209) * b(k,201) + b(k,200) = b(k,200) * lu(k,1195) + b(k,199) = b(k,199) - lu(k,1194) * b(k,200) + b(k,195) = b(k,195) - lu(k,1193) * b(k,200) + b(k,193) = b(k,193) - lu(k,1192) * b(k,200) + b(k,191) = b(k,191) - lu(k,1191) * b(k,200) + b(k,176) = b(k,176) - lu(k,1190) * b(k,200) + b(k,169) = b(k,169) - lu(k,1189) * b(k,200) + b(k,163) = b(k,163) - lu(k,1188) * b(k,200) + b(k,120) = b(k,120) - lu(k,1187) * b(k,200) + b(k,115) = b(k,115) - lu(k,1186) * b(k,200) + b(k,199) = b(k,199) * lu(k,1175) + b(k,197) = b(k,197) - lu(k,1174) * b(k,199) + b(k,195) = b(k,195) - lu(k,1173) * b(k,199) + b(k,193) = b(k,193) - lu(k,1172) * b(k,199) + b(k,186) = b(k,186) - lu(k,1171) * b(k,199) + b(k,170) = b(k,170) - lu(k,1170) * b(k,199) + b(k,169) = b(k,169) - lu(k,1169) * b(k,199) + b(k,81) = b(k,81) - lu(k,1168) * b(k,199) + b(k,198) = b(k,198) * lu(k,1155) + b(k,197) = b(k,197) - lu(k,1154) * b(k,198) + b(k,196) = b(k,196) - lu(k,1153) * b(k,198) + b(k,195) = b(k,195) - lu(k,1152) * b(k,198) + b(k,193) = b(k,193) - lu(k,1151) * b(k,198) + b(k,192) = b(k,192) - lu(k,1150) * b(k,198) + b(k,182) = b(k,182) - lu(k,1149) * b(k,198) + b(k,87) = b(k,87) - lu(k,1148) * b(k,198) + b(k,197) = b(k,197) * lu(k,1142) + b(k,196) = b(k,196) * lu(k,1131) + b(k,169) = b(k,169) - lu(k,1130) * b(k,196) + b(k,119) = b(k,119) - lu(k,1129) * b(k,196) + b(k,195) = b(k,195) * lu(k,1125) + b(k,170) = b(k,170) - lu(k,1124) * b(k,195) + b(k,194) = b(k,194) * lu(k,1111) + b(k,193) = b(k,193) - lu(k,1110) * b(k,194) + b(k,190) = b(k,190) - lu(k,1109) * b(k,194) + b(k,182) = b(k,182) - lu(k,1108) * b(k,194) + b(k,170) = b(k,170) - lu(k,1107) * b(k,194) + b(k,169) = b(k,169) - lu(k,1106) * b(k,194) + b(k,154) = b(k,154) - lu(k,1105) * b(k,194) + b(k,87) = b(k,87) - lu(k,1104) * b(k,194) + b(k,193) = b(k,193) * lu(k,1098) + b(k,186) = b(k,186) - lu(k,1097) * b(k,193) + b(k,170) = b(k,170) - lu(k,1096) * b(k,193) + b(k,192) = b(k,192) * lu(k,1087) + b(k,191) = b(k,191) * lu(k,1075) + b(k,186) = b(k,186) - lu(k,1074) * b(k,191) + b(k,178) = b(k,178) - lu(k,1073) * b(k,191) + b(k,176) = b(k,176) - lu(k,1072) * b(k,191) + b(k,147) = b(k,147) - lu(k,1071) * b(k,191) + b(k,190) = b(k,190) * lu(k,1061) + b(k,182) = b(k,182) - lu(k,1060) * b(k,190) + b(k,170) = b(k,170) - lu(k,1059) * b(k,190) + b(k,189) = b(k,189) * lu(k,1047) + b(k,185) = b(k,185) - lu(k,1046) * b(k,189) + b(k,169) = b(k,169) - lu(k,1045) * b(k,189) + b(k,151) = b(k,151) - lu(k,1044) * b(k,189) + b(k,118) = b(k,118) - lu(k,1043) * b(k,189) + b(k,188) = b(k,188) * lu(k,1026) + b(k,183) = b(k,183) - lu(k,1025) * b(k,188) + b(k,176) = b(k,176) - lu(k,1024) * b(k,188) + b(k,170) = b(k,170) - lu(k,1023) * b(k,188) + b(k,166) = b(k,166) - lu(k,1022) * b(k,188) + b(k,158) = b(k,158) - lu(k,1021) * b(k,188) + b(k,187) = b(k,187) * lu(k,1001) + b(k,186) = b(k,186) - lu(k,1000) * b(k,187) + b(k,185) = b(k,185) - lu(k,999) * b(k,187) + b(k,183) = b(k,183) - lu(k,998) * b(k,187) + b(k,182) = b(k,182) - lu(k,997) * b(k,187) + b(k,181) = b(k,181) - lu(k,996) * b(k,187) + b(k,179) = b(k,179) - lu(k,995) * b(k,187) + b(k,170) = b(k,170) - lu(k,994) * b(k,187) + b(k,116) = b(k,116) - lu(k,993) * b(k,187) + b(k,85) = b(k,85) - lu(k,992) * b(k,187) + b(k,46) = b(k,46) - lu(k,991) * b(k,187) + b(k,43) = b(k,43) - lu(k,990) * b(k,187) + b(k,42) = b(k,42) - lu(k,989) * b(k,187) + b(k,41) = b(k,41) - lu(k,988) * b(k,187) + b(k,40) = b(k,40) - lu(k,987) * b(k,187) + b(k,39) = b(k,39) - lu(k,986) * b(k,187) + b(k,186) = b(k,186) * lu(k,981) + b(k,170) = b(k,170) - lu(k,980) * b(k,186) + b(k,39) = b(k,39) - lu(k,979) * b(k,186) + b(k,185) = b(k,185) * lu(k,971) + b(k,184) = b(k,184) * lu(k,950) + b(k,183) = b(k,183) - lu(k,949) * b(k,184) + b(k,182) = b(k,182) - lu(k,948) * b(k,184) + b(k,181) = b(k,181) - lu(k,947) * b(k,184) + b(k,179) = b(k,179) - lu(k,946) * b(k,184) + b(k,170) = b(k,170) - lu(k,945) * b(k,184) + b(k,116) = b(k,116) - lu(k,944) * b(k,184) + b(k,85) = b(k,85) - lu(k,943) * b(k,184) + b(k,51) = b(k,51) - lu(k,942) * b(k,184) + b(k,43) = b(k,43) - lu(k,941) * b(k,184) + b(k,42) = b(k,42) - lu(k,940) * b(k,184) + b(k,41) = b(k,41) - lu(k,939) * b(k,184) + b(k,40) = b(k,40) - lu(k,938) * b(k,184) + b(k,39) = b(k,39) - lu(k,937) * b(k,184) + end do + end subroutine lu_slv10 + subroutine lu_slv11( 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,183) = b(k,183) * lu(k,931) + b(k,170) = b(k,170) - lu(k,930) * b(k,183) + b(k,182) = b(k,182) * lu(k,924) + b(k,181) = b(k,181) * lu(k,914) + b(k,169) = b(k,169) - lu(k,913) * b(k,181) + b(k,151) = b(k,151) - lu(k,912) * b(k,181) + b(k,132) = b(k,132) - lu(k,911) * b(k,181) + b(k,180) = b(k,180) * lu(k,901) + b(k,172) = b(k,172) - lu(k,900) * b(k,180) + b(k,75) = b(k,75) - lu(k,899) * b(k,180) + b(k,179) = b(k,179) * lu(k,889) + b(k,173) = b(k,173) - lu(k,888) * b(k,179) + b(k,157) = b(k,157) - lu(k,887) * b(k,179) + b(k,156) = b(k,156) - lu(k,886) * b(k,179) + b(k,153) = b(k,153) - lu(k,885) * b(k,179) + b(k,136) = b(k,136) - lu(k,884) * b(k,179) + b(k,178) = b(k,178) * lu(k,875) + b(k,177) = b(k,177) * lu(k,866) + b(k,100) = b(k,100) - lu(k,865) * b(k,177) + b(k,176) = b(k,176) * lu(k,859) + b(k,175) = b(k,175) * lu(k,853) + b(k,93) = b(k,93) - lu(k,852) * b(k,175) + b(k,174) = b(k,174) * lu(k,836) + b(k,48) = b(k,48) - lu(k,835) * b(k,174) + b(k,43) = b(k,43) - lu(k,834) * b(k,174) + b(k,42) = b(k,42) - lu(k,833) * b(k,174) + b(k,173) = b(k,173) * lu(k,825) + b(k,169) = b(k,169) - lu(k,824) * b(k,173) + b(k,110) = b(k,110) - lu(k,823) * b(k,173) + b(k,94) = b(k,94) - lu(k,822) * b(k,173) + b(k,172) = b(k,172) * lu(k,815) + b(k,75) = b(k,75) - lu(k,814) * b(k,172) + b(k,171) = b(k,171) * lu(k,806) + b(k,170) = b(k,170) * lu(k,803) + b(k,169) = b(k,169) * lu(k,799) + b(k,168) = b(k,168) * lu(k,789) + b(k,121) = b(k,121) - lu(k,788) * b(k,168) + b(k,167) = b(k,167) * lu(k,780) + b(k,86) = b(k,86) - lu(k,779) * b(k,167) + b(k,166) = b(k,166) * lu(k,770) + b(k,141) = b(k,141) - lu(k,769) * b(k,166) + b(k,165) = b(k,165) * lu(k,761) + b(k,164) = b(k,164) * lu(k,750) + b(k,161) = b(k,161) - lu(k,749) * b(k,164) + b(k,159) = b(k,159) - lu(k,748) * b(k,164) + b(k,147) = b(k,147) - lu(k,747) * b(k,164) + b(k,129) = b(k,129) - lu(k,746) * b(k,164) + b(k,106) = b(k,106) - lu(k,745) * b(k,164) + b(k,98) = b(k,98) - lu(k,744) * b(k,164) + b(k,163) = b(k,163) * lu(k,737) + b(k,66) = b(k,66) - lu(k,736) * b(k,163) + b(k,162) = b(k,162) * lu(k,726) + b(k,161) = b(k,161) - lu(k,725) * b(k,162) + b(k,155) = b(k,155) - lu(k,724) * b(k,162) + b(k,147) = b(k,147) - lu(k,723) * b(k,162) + b(k,129) = b(k,129) - lu(k,722) * b(k,162) + b(k,98) = b(k,98) - lu(k,721) * b(k,162) + b(k,161) = b(k,161) * lu(k,715) + b(k,160) = b(k,160) * lu(k,708) + b(k,96) = b(k,96) - lu(k,707) * b(k,160) + b(k,64) = b(k,64) - lu(k,706) * b(k,160) + b(k,159) = b(k,159) * lu(k,695) + b(k,147) = b(k,147) - lu(k,694) * b(k,159) + b(k,129) = b(k,129) - lu(k,693) * b(k,159) + b(k,106) = b(k,106) - lu(k,692) * b(k,159) + b(k,98) = b(k,98) - lu(k,691) * b(k,159) + b(k,158) = b(k,158) * lu(k,686) + b(k,157) = b(k,157) * lu(k,679) + b(k,105) = b(k,105) - lu(k,678) * b(k,157) + b(k,156) = b(k,156) * lu(k,668) + b(k,136) = b(k,136) - lu(k,667) * b(k,156) + b(k,155) = b(k,155) * lu(k,657) + b(k,147) = b(k,147) - lu(k,656) * b(k,155) + b(k,129) = b(k,129) - lu(k,655) * b(k,155) + b(k,98) = b(k,98) - lu(k,654) * b(k,155) + b(k,154) = b(k,154) * lu(k,644) + b(k,153) = b(k,153) * lu(k,634) + b(k,136) = b(k,136) - lu(k,633) * b(k,153) + b(k,152) = b(k,152) * lu(k,627) + b(k,130) = b(k,130) - lu(k,626) * b(k,152) + b(k,95) = b(k,95) - lu(k,625) * b(k,152) + b(k,151) = b(k,151) * lu(k,619) + b(k,150) = b(k,150) * lu(k,612) + b(k,149) = b(k,149) * lu(k,605) + b(k,148) = b(k,148) * lu(k,596) + b(k,147) = b(k,147) * lu(k,592) + b(k,146) = b(k,146) * lu(k,583) + b(k,145) = b(k,145) * lu(k,574) + b(k,144) = b(k,144) * lu(k,566) + b(k,143) = b(k,143) * lu(k,558) + b(k,142) = b(k,142) * lu(k,550) + b(k,141) = b(k,141) * lu(k,542) + b(k,140) = b(k,140) * lu(k,534) + b(k,139) = b(k,139) * lu(k,526) + b(k,138) = b(k,138) * lu(k,520) + b(k,67) = b(k,67) - lu(k,519) * b(k,138) + b(k,137) = b(k,137) * lu(k,513) + b(k,136) = b(k,136) * lu(k,508) + b(k,135) = b(k,135) * lu(k,501) + b(k,124) = b(k,124) - lu(k,500) * b(k,135) + b(k,134) = b(k,134) * lu(k,493) + b(k,77) = b(k,77) - lu(k,492) * b(k,134) + b(k,133) = b(k,133) * lu(k,485) + b(k,129) = b(k,129) - lu(k,484) * b(k,133) + b(k,122) = b(k,122) - lu(k,483) * b(k,133) + b(k,132) = b(k,132) * lu(k,476) + b(k,131) = b(k,131) * lu(k,469) + b(k,130) = b(k,130) * lu(k,465) + b(k,129) = b(k,129) * lu(k,462) + b(k,128) = b(k,128) * lu(k,456) + b(k,127) = b(k,127) * lu(k,450) + b(k,108) = b(k,108) - lu(k,449) * b(k,127) + b(k,126) = b(k,126) * lu(k,443) + b(k,125) = b(k,125) * lu(k,437) + b(k,109) = b(k,109) - lu(k,436) * b(k,125) + b(k,88) = b(k,88) - lu(k,435) * b(k,125) + b(k,124) = b(k,124) * lu(k,429) + b(k,123) = b(k,123) * lu(k,423) + b(k,122) = b(k,122) * lu(k,417) + b(k,121) = b(k,121) * lu(k,411) + b(k,120) = b(k,120) * lu(k,405) + b(k,119) = b(k,119) * lu(k,399) + b(k,118) = b(k,118) * lu(k,393) + b(k,117) = b(k,117) * lu(k,387) + b(k,116) = b(k,116) * lu(k,381) + b(k,115) = b(k,115) * lu(k,375) + b(k,114) = b(k,114) * lu(k,367) + b(k,113) = b(k,113) * lu(k,359) + b(k,112) = b(k,112) * lu(k,351) + b(k,111) = b(k,111) * lu(k,348) + b(k,110) = b(k,110) * lu(k,343) + b(k,109) = b(k,109) * lu(k,338) + b(k,88) = b(k,88) - lu(k,337) * b(k,109) + b(k,108) = b(k,108) * lu(k,332) + b(k,107) = b(k,107) * lu(k,327) + b(k,106) = b(k,106) * lu(k,322) + b(k,105) = b(k,105) * lu(k,317) + b(k,104) = b(k,104) * lu(k,312) + b(k,103) = b(k,103) * lu(k,306) + b(k,102) = b(k,102) * lu(k,300) + b(k,89) = b(k,89) - lu(k,299) * b(k,102) + b(k,101) = b(k,101) * lu(k,293) + b(k,100) = b(k,100) * lu(k,290) + b(k,99) = b(k,99) * lu(k,284) + b(k,98) = b(k,98) * lu(k,281) + b(k,97) = b(k,97) * lu(k,275) + b(k,96) = b(k,96) * lu(k,271) + b(k,95) = b(k,95) * lu(k,267) + b(k,94) = b(k,94) * lu(k,263) + b(k,93) = b(k,93) * lu(k,259) + b(k,65) = b(k,65) - lu(k,258) * b(k,93) + b(k,92) = b(k,92) * lu(k,253) + b(k,89) = b(k,89) - lu(k,252) * b(k,92) + b(k,91) = b(k,91) * lu(k,248) + b(k,90) = b(k,90) * lu(k,243) + b(k,89) = b(k,89) * lu(k,240) + b(k,88) = b(k,88) * lu(k,237) + b(k,87) = b(k,87) * lu(k,234) + b(k,86) = b(k,86) * lu(k,231) + b(k,85) = b(k,85) * lu(k,228) + b(k,84) = b(k,84) * lu(k,223) + b(k,83) = b(k,83) * lu(k,218) + b(k,82) = b(k,82) * lu(k,210) + b(k,80) = b(k,80) - lu(k,209) * b(k,82) + b(k,53) = b(k,53) - lu(k,208) * b(k,82) + b(k,81) = b(k,81) * lu(k,205) + b(k,80) = b(k,80) * lu(k,201) + b(k,79) = b(k,79) * lu(k,196) + b(k,78) = b(k,78) * lu(k,189) + b(k,52) = b(k,52) - lu(k,188) * b(k,78) + b(k,77) = b(k,77) * lu(k,185) + b(k,76) = b(k,76) * lu(k,181) + b(k,75) = b(k,75) * lu(k,179) + b(k,74) = b(k,74) * lu(k,174) + b(k,73) = b(k,73) * lu(k,170) + b(k,72) = b(k,72) * lu(k,164) + b(k,47) = b(k,47) - lu(k,163) * b(k,72) + b(k,71) = b(k,71) * lu(k,158) + b(k,70) = b(k,70) * lu(k,153) + b(k,69) = b(k,69) * lu(k,148) + b(k,68) = b(k,68) * lu(k,143) + b(k,67) = b(k,67) * lu(k,140) + b(k,66) = b(k,66) * lu(k,137) + b(k,65) = b(k,65) * lu(k,134) + b(k,64) = b(k,64) * lu(k,131) + b(k,63) = b(k,63) * lu(k,127) + b(k,62) = b(k,62) * lu(k,123) + b(k,61) = b(k,61) * lu(k,119) + b(k,60) = b(k,60) * lu(k,115) + b(k,59) = b(k,59) * lu(k,111) + b(k,58) = b(k,58) * lu(k,107) + b(k,57) = b(k,57) * lu(k,104) + b(k,56) = b(k,56) * lu(k,101) + b(k,55) = b(k,55) * lu(k,98) + b(k,54) = b(k,54) * lu(k,95) + b(k,53) = b(k,53) * lu(k,94) + b(k,43) = b(k,43) - lu(k,93) * b(k,53) + b(k,42) = b(k,42) - lu(k,92) * b(k,53) + b(k,41) = b(k,41) - lu(k,91) * b(k,53) + b(k,40) = b(k,40) - lu(k,90) * b(k,53) + b(k,39) = b(k,39) - lu(k,89) * b(k,53) + end do + end subroutine lu_slv11 + subroutine lu_slv12( 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,52) = b(k,52) * lu(k,88) + b(k,43) = b(k,43) - lu(k,87) * b(k,52) + b(k,42) = b(k,42) - lu(k,86) * b(k,52) + b(k,41) = b(k,41) - lu(k,85) * b(k,52) + b(k,40) = b(k,40) - lu(k,84) * b(k,52) + b(k,39) = b(k,39) - lu(k,83) * b(k,52) + b(k,51) = b(k,51) * lu(k,82) + b(k,43) = b(k,43) - lu(k,81) * b(k,51) + b(k,42) = b(k,42) - lu(k,80) * b(k,51) + b(k,41) = b(k,41) - lu(k,79) * b(k,51) + b(k,40) = b(k,40) - lu(k,78) * b(k,51) + b(k,39) = b(k,39) - lu(k,77) * b(k,51) + b(k,50) = b(k,50) * lu(k,76) + b(k,49) = b(k,49) - lu(k,75) * b(k,50) + b(k,49) = b(k,49) * lu(k,74) + b(k,43) = b(k,43) - lu(k,73) * b(k,49) + b(k,42) = b(k,42) - lu(k,72) * b(k,49) + b(k,41) = b(k,41) - lu(k,71) * b(k,49) + b(k,40) = b(k,40) - lu(k,70) * b(k,49) + b(k,39) = b(k,39) - lu(k,69) * b(k,49) + b(k,48) = b(k,48) * lu(k,68) + b(k,43) = b(k,43) - lu(k,67) * b(k,48) + b(k,42) = b(k,42) - lu(k,66) * b(k,48) + b(k,41) = b(k,41) - lu(k,65) * b(k,48) + b(k,40) = b(k,40) - lu(k,64) * b(k,48) + b(k,39) = b(k,39) - lu(k,63) * b(k,48) + b(k,47) = b(k,47) * lu(k,62) + b(k,43) = b(k,43) - lu(k,61) * b(k,47) + b(k,42) = b(k,42) - lu(k,60) * b(k,47) + b(k,41) = b(k,41) - lu(k,59) * b(k,47) + b(k,40) = b(k,40) - lu(k,58) * b(k,47) + b(k,39) = b(k,39) - lu(k,57) * b(k,47) + b(k,46) = b(k,46) * lu(k,56) + b(k,43) = b(k,43) - lu(k,55) * b(k,46) + b(k,42) = b(k,42) - lu(k,54) * b(k,46) + b(k,41) = b(k,41) - lu(k,53) * b(k,46) + b(k,40) = b(k,40) - lu(k,52) * b(k,46) + b(k,39) = b(k,39) - lu(k,51) * b(k,46) + b(k,45) = b(k,45) * lu(k,50) + b(k,43) = b(k,43) - lu(k,49) * b(k,45) + b(k,42) = b(k,42) - lu(k,48) * b(k,45) + b(k,41) = b(k,41) - lu(k,47) * b(k,45) + b(k,40) = b(k,40) - lu(k,46) * b(k,45) + b(k,39) = b(k,39) - lu(k,45) * b(k,45) + b(k,44) = b(k,44) * lu(k,44) + b(k,43) = b(k,43) * lu(k,43) + b(k,42) = b(k,42) * lu(k,42) + b(k,41) = b(k,41) * lu(k,41) + b(k,40) = b(k,40) * lu(k,40) + b(k,39) = b(k,39) * lu(k,39) + b(k,38) = b(k,38) * lu(k,38) + b(k,37) = b(k,37) * lu(k,37) + b(k,36) = b(k,36) * lu(k,36) + b(k,35) = b(k,35) * lu(k,35) + b(k,34) = b(k,34) * lu(k,34) + b(k,33) = b(k,33) * lu(k,33) + b(k,32) = b(k,32) * lu(k,32) + b(k,31) = b(k,31) * lu(k,31) + b(k,30) = b(k,30) * lu(k,30) + b(k,29) = b(k,29) * lu(k,29) + b(k,28) = b(k,28) * lu(k,28) + b(k,27) = b(k,27) * lu(k,27) + b(k,26) = b(k,26) * lu(k,26) + b(k,25) = b(k,25) * lu(k,25) + b(k,24) = b(k,24) * lu(k,24) + b(k,23) = b(k,23) * lu(k,23) + b(k,22) = b(k,22) * lu(k,22) + b(k,21) = b(k,21) * lu(k,21) + b(k,20) = b(k,20) * lu(k,20) + b(k,19) = b(k,19) * lu(k,19) + b(k,18) = b(k,18) * lu(k,18) + b(k,17) = b(k,17) * lu(k,17) + b(k,16) = b(k,16) * lu(k,16) + b(k,15) = b(k,15) * lu(k,15) + b(k,14) = b(k,14) * lu(k,14) + b(k,13) = b(k,13) * lu(k,13) + b(k,12) = b(k,12) * lu(k,12) + b(k,11) = b(k,11) * lu(k,11) + b(k,10) = b(k,10) * lu(k,10) + 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_slv12 + 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 ) + call lu_slv09( avec_len, lu, b ) + call lu_slv10( avec_len, lu, b ) + call lu_slv11( avec_len, lu, b ) + call lu_slv12( avec_len, lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_trop_strat_mam5_vbs/mo_nln_matrix.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/mo_nln_matrix.F90 new file mode 100644 index 0000000000..af8ea47ddf --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/mo_nln_matrix.F90 @@ -0,0 +1,3697 @@ + 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,634) = -(rxt(k,356)*y(k,219)) + mat(k,1630) = -rxt(k,356)*y(k,1) + mat(k,1875) = rxt(k,359)*y(k,191) + mat(k,885) = rxt(k,359)*y(k,124) + mat(k,668) = -(rxt(k,360)*y(k,219)) + mat(k,1633) = -rxt(k,360)*y(k,2) + mat(k,886) = rxt(k,357)*y(k,205) + mat(k,2060) = rxt(k,357)*y(k,191) + mat(k,1001) = -(rxt(k,439)*y(k,126) + rxt(k,440)*y(k,135) + rxt(k,441) & + *y(k,219)) + mat(k,1747) = -rxt(k,439)*y(k,6) + mat(k,2223) = -rxt(k,440)*y(k,6) + mat(k,1663) = -rxt(k,441)*y(k,6) + mat(k,164) = -(rxt(k,398)*y(k,219)) + mat(k,1561) = -rxt(k,398)*y(k,7) + mat(k,417) = -(rxt(k,401)*y(k,219)) + mat(k,1601) = -rxt(k,401)*y(k,8) + mat(k,483) = rxt(k,399)*y(k,205) + mat(k,2041) = rxt(k,399)*y(k,193) + mat(k,165) = .120_r8*rxt(k,398)*y(k,219) + mat(k,1562) = .120_r8*rxt(k,398)*y(k,7) + mat(k,993) = .100_r8*rxt(k,440)*y(k,135) + mat(k,944) = .100_r8*rxt(k,443)*y(k,135) + mat(k,2207) = .100_r8*rxt(k,440)*y(k,6) + .100_r8*rxt(k,443)*y(k,110) + mat(k,1862) = .500_r8*rxt(k,400)*y(k,193) + .200_r8*rxt(k,427)*y(k,225) & + + .060_r8*rxt(k,433)*y(k,228) + mat(k,484) = .500_r8*rxt(k,400)*y(k,124) + mat(k,722) = .200_r8*rxt(k,427)*y(k,124) + mat(k,746) = .060_r8*rxt(k,433)*y(k,124) + mat(k,1856) = .200_r8*rxt(k,427)*y(k,225) + .200_r8*rxt(k,433)*y(k,228) + mat(k,721) = .200_r8*rxt(k,427)*y(k,124) + mat(k,744) = .200_r8*rxt(k,433)*y(k,124) + mat(k,1872) = .200_r8*rxt(k,427)*y(k,225) + .150_r8*rxt(k,433)*y(k,228) + mat(k,723) = .200_r8*rxt(k,427)*y(k,124) + mat(k,747) = .150_r8*rxt(k,433)*y(k,124) + mat(k,1857) = .210_r8*rxt(k,433)*y(k,228) + mat(k,745) = .210_r8*rxt(k,433)*y(k,124) + mat(k,228) = -(rxt(k,361)*y(k,219)) + mat(k,1572) = -rxt(k,361)*y(k,15) + mat(k,992) = .050_r8*rxt(k,440)*y(k,135) + mat(k,943) = .050_r8*rxt(k,443)*y(k,135) + mat(k,2206) = .050_r8*rxt(k,440)*y(k,6) + .050_r8*rxt(k,443)*y(k,110) + mat(k,351) = -(rxt(k,327)*y(k,126) + rxt(k,328)*y(k,219)) + mat(k,1737) = -rxt(k,327)*y(k,16) + mat(k,1592) = -rxt(k,328)*y(k,16) + mat(k,1417) = -(rxt(k,211)*y(k,42) + rxt(k,212)*y(k,205) + rxt(k,213) & + *y(k,135)) + mat(k,1483) = -rxt(k,211)*y(k,17) + mat(k,2104) = -rxt(k,212)*y(k,17) + mat(k,2243) = -rxt(k,213)*y(k,17) + mat(k,2152) = 4.000_r8*rxt(k,214)*y(k,19) + (rxt(k,215)+rxt(k,216))*y(k,59) & + + rxt(k,219)*y(k,124) + rxt(k,222)*y(k,134) + rxt(k,469) & + *y(k,151) + rxt(k,223)*y(k,219) + mat(k,145) = rxt(k,201)*y(k,218) + mat(k,151) = rxt(k,227)*y(k,218) + mat(k,470) = 2.000_r8*rxt(k,238)*y(k,56) + 2.000_r8*rxt(k,250)*y(k,218) & + + 2.000_r8*rxt(k,239)*y(k,219) + mat(k,597) = rxt(k,240)*y(k,56) + rxt(k,251)*y(k,218) + rxt(k,241)*y(k,219) + mat(k,388) = 3.000_r8*rxt(k,245)*y(k,56) + 3.000_r8*rxt(k,228)*y(k,218) & + + 3.000_r8*rxt(k,246)*y(k,219) + mat(k,1997) = 2.000_r8*rxt(k,238)*y(k,41) + rxt(k,240)*y(k,43) & + + 3.000_r8*rxt(k,245)*y(k,55) + mat(k,1714) = (rxt(k,215)+rxt(k,216))*y(k,19) + mat(k,109) = 2.000_r8*rxt(k,229)*y(k,218) + mat(k,807) = rxt(k,224)*y(k,134) + rxt(k,230)*y(k,218) + rxt(k,225)*y(k,219) + mat(k,1914) = rxt(k,219)*y(k,19) + mat(k,2182) = rxt(k,222)*y(k,19) + rxt(k,224)*y(k,81) + mat(k,1235) = rxt(k,469)*y(k,19) + mat(k,1523) = rxt(k,201)*y(k,34) + rxt(k,227)*y(k,35) + 2.000_r8*rxt(k,250) & + *y(k,41) + rxt(k,251)*y(k,43) + 3.000_r8*rxt(k,228)*y(k,55) & + + 2.000_r8*rxt(k,229)*y(k,78) + rxt(k,230)*y(k,81) + mat(k,1687) = rxt(k,223)*y(k,19) + 2.000_r8*rxt(k,239)*y(k,41) + rxt(k,241) & + *y(k,43) + 3.000_r8*rxt(k,246)*y(k,55) + rxt(k,225)*y(k,81) + mat(k,2146) = rxt(k,217)*y(k,59) + mat(k,1708) = rxt(k,217)*y(k,19) + mat(k,2124) = (rxt(k,530)+rxt(k,535))*y(k,91) + mat(k,779) = (rxt(k,530)+rxt(k,535))*y(k,85) + mat(k,2166) = -(4._r8*rxt(k,214)*y(k,19) + (rxt(k,215) + rxt(k,216) + rxt(k,217) & + ) * y(k,59) + rxt(k,218)*y(k,205) + rxt(k,219)*y(k,124) & + + rxt(k,220)*y(k,125) + rxt(k,222)*y(k,134) + rxt(k,223) & + *y(k,219) + rxt(k,469)*y(k,151)) + mat(k,1728) = -(rxt(k,215) + rxt(k,216) + rxt(k,217)) * y(k,19) + mat(k,2119) = -rxt(k,218)*y(k,19) + mat(k,1929) = -rxt(k,219)*y(k,19) + mat(k,1973) = -rxt(k,220)*y(k,19) + mat(k,2197) = -rxt(k,222)*y(k,19) + mat(k,1702) = -rxt(k,223)*y(k,19) + mat(k,1243) = -rxt(k,469)*y(k,19) + mat(k,1423) = rxt(k,213)*y(k,135) + mat(k,564) = rxt(k,221)*y(k,134) + mat(k,811) = rxt(k,231)*y(k,218) + mat(k,785) = rxt(k,226)*y(k,134) + mat(k,2197) = mat(k,2197) + rxt(k,221)*y(k,20) + rxt(k,226)*y(k,91) + mat(k,2258) = rxt(k,213)*y(k,17) + mat(k,1538) = rxt(k,231)*y(k,81) + mat(k,558) = -(rxt(k,221)*y(k,134)) + mat(k,2172) = -rxt(k,221)*y(k,20) + mat(k,2148) = rxt(k,220)*y(k,125) + mat(k,1941) = rxt(k,220)*y(k,19) + mat(k,237) = -(rxt(k,402)*y(k,219)) + mat(k,1574) = -rxt(k,402)*y(k,22) + mat(k,1854) = rxt(k,405)*y(k,195) + mat(k,435) = rxt(k,405)*y(k,124) + mat(k,338) = -(rxt(k,404)*y(k,219)) + mat(k,1589) = -rxt(k,404)*y(k,23) + mat(k,436) = rxt(k,403)*y(k,205) + mat(k,2035) = rxt(k,403)*y(k,195) + mat(k,293) = -(rxt(k,276)*y(k,56) + rxt(k,277)*y(k,219)) + mat(k,1978) = -rxt(k,276)*y(k,24) + mat(k,1583) = -rxt(k,277)*y(k,24) + mat(k,550) = -(rxt(k,278)*y(k,56) + rxt(k,279)*y(k,135) + rxt(k,304)*y(k,219)) + mat(k,1983) = -rxt(k,278)*y(k,25) + mat(k,2210) = -rxt(k,279)*y(k,25) + mat(k,1620) = -rxt(k,304)*y(k,25) + mat(k,263) = -(rxt(k,284)*y(k,219)) + mat(k,1580) = -rxt(k,284)*y(k,26) + mat(k,822) = .800_r8*rxt(k,280)*y(k,196) + .200_r8*rxt(k,281)*y(k,200) + mat(k,1789) = .200_r8*rxt(k,281)*y(k,196) + mat(k,343) = -(rxt(k,285)*y(k,219)) + mat(k,1590) = -rxt(k,285)*y(k,27) + mat(k,823) = rxt(k,282)*y(k,205) + mat(k,2036) = rxt(k,282)*y(k,196) + mat(k,306) = -(rxt(k,286)*y(k,56) + rxt(k,287)*y(k,219)) + mat(k,1979) = -rxt(k,286)*y(k,28) + mat(k,1585) = -rxt(k,287)*y(k,28) + mat(k,1026) = -(rxt(k,307)*y(k,126) + rxt(k,308)*y(k,135) + rxt(k,325) & + *y(k,219)) + mat(k,1748) = -rxt(k,307)*y(k,29) + mat(k,2224) = -rxt(k,308)*y(k,29) + mat(k,1664) = -rxt(k,325)*y(k,29) + mat(k,838) = .130_r8*rxt(k,385)*y(k,135) + mat(k,2224) = mat(k,2224) + .130_r8*rxt(k,385)*y(k,98) + mat(k,411) = -(rxt(k,312)*y(k,219)) + mat(k,1600) = -rxt(k,312)*y(k,30) + mat(k,788) = rxt(k,310)*y(k,205) + mat(k,2040) = rxt(k,310)*y(k,197) + mat(k,111) = -(rxt(k,313)*y(k,219)) + mat(k,1558) = -rxt(k,313)*y(k,31) + mat(k,267) = -(rxt(k,408)*y(k,219)) + mat(k,1581) = -rxt(k,408)*y(k,32) + mat(k,625) = rxt(k,406)*y(k,205) + mat(k,2030) = rxt(k,406)*y(k,198) + mat(k,101) = -(rxt(k,200)*y(k,218)) + mat(k,1501) = -rxt(k,200)*y(k,33) + mat(k,143) = -(rxt(k,201)*y(k,218)) + mat(k,1506) = -rxt(k,201)*y(k,34) + mat(k,148) = -(rxt(k,227)*y(k,218)) + mat(k,1507) = -rxt(k,227)*y(k,35) + mat(k,115) = -(rxt(k,202)*y(k,218)) + mat(k,1503) = -rxt(k,202)*y(k,36) + mat(k,153) = -(rxt(k,203)*y(k,218)) + mat(k,1508) = -rxt(k,203)*y(k,37) + mat(k,119) = -(rxt(k,204)*y(k,218)) + mat(k,1504) = -rxt(k,204)*y(k,38) + mat(k,158) = -(rxt(k,205)*y(k,218)) + mat(k,1509) = -rxt(k,205)*y(k,39) + mat(k,123) = -(rxt(k,206)*y(k,218)) + mat(k,1505) = -rxt(k,206)*y(k,40) + mat(k,469) = -(rxt(k,238)*y(k,56) + rxt(k,239)*y(k,219) + rxt(k,250)*y(k,218)) + mat(k,1982) = -rxt(k,238)*y(k,41) + mat(k,1609) = -rxt(k,239)*y(k,41) + mat(k,1518) = -rxt(k,250)*y(k,41) + mat(k,1487) = -(rxt(k,175)*y(k,56) + rxt(k,211)*y(k,17) + rxt(k,255)*y(k,205) & + + rxt(k,256)*y(k,126) + rxt(k,257)*y(k,134) + rxt(k,258) & + *y(k,219)) + mat(k,2001) = -rxt(k,175)*y(k,42) + mat(k,1419) = -rxt(k,211)*y(k,42) + mat(k,2108) = -rxt(k,255)*y(k,42) + mat(k,1774) = -rxt(k,256)*y(k,42) + mat(k,2186) = -rxt(k,257)*y(k,42) + mat(k,1691) = -rxt(k,258)*y(k,42) + mat(k,640) = .400_r8*rxt(k,356)*y(k,219) + mat(k,1011) = .340_r8*rxt(k,440)*y(k,135) + mat(k,355) = .500_r8*rxt(k,327)*y(k,126) + mat(k,554) = rxt(k,279)*y(k,135) + mat(k,1033) = .500_r8*rxt(k,308)*y(k,135) + mat(k,615) = .500_r8*rxt(k,296)*y(k,219) + mat(k,800) = rxt(k,263)*y(k,219) + mat(k,458) = .300_r8*rxt(k,264)*y(k,219) + mat(k,1435) = (rxt(k,272)+rxt(k,273))*y(k,218) + mat(k,1717) = rxt(k,182)*y(k,200) + mat(k,1100) = .800_r8*rxt(k,301)*y(k,219) + mat(k,846) = .910_r8*rxt(k,385)*y(k,135) + mat(k,588) = .300_r8*rxt(k,376)*y(k,219) + mat(k,1201) = .800_r8*rxt(k,380)*y(k,200) + mat(k,1216) = .120_r8*rxt(k,338)*y(k,135) + mat(k,578) = .500_r8*rxt(k,351)*y(k,219) + mat(k,961) = .340_r8*rxt(k,443)*y(k,135) + mat(k,1339) = .600_r8*rxt(k,352)*y(k,135) + mat(k,1918) = .100_r8*rxt(k,358)*y(k,191) + rxt(k,262)*y(k,200) & + + .500_r8*rxt(k,329)*y(k,202) + .500_r8*rxt(k,298)*y(k,204) & + + .920_r8*rxt(k,368)*y(k,207) + .250_r8*rxt(k,336)*y(k,211) & + + rxt(k,345)*y(k,213) + rxt(k,319)*y(k,221) + rxt(k,323) & + *y(k,222) + .340_r8*rxt(k,452)*y(k,223) + .320_r8*rxt(k,457) & + *y(k,224) + .250_r8*rxt(k,393)*y(k,227) + mat(k,1774) = mat(k,1774) + .500_r8*rxt(k,327)*y(k,16) + rxt(k,369)*y(k,207) & + + .250_r8*rxt(k,335)*y(k,211) + rxt(k,346)*y(k,213) + mat(k,2247) = .340_r8*rxt(k,440)*y(k,6) + rxt(k,279)*y(k,25) & + + .500_r8*rxt(k,308)*y(k,29) + .910_r8*rxt(k,385)*y(k,98) & + + .120_r8*rxt(k,338)*y(k,105) + .340_r8*rxt(k,443)*y(k,110) & + + .600_r8*rxt(k,352)*y(k,111) + mat(k,529) = rxt(k,303)*y(k,219) + mat(k,1065) = .680_r8*rxt(k,461)*y(k,219) + mat(k,893) = .100_r8*rxt(k,358)*y(k,124) + mat(k,827) = .700_r8*rxt(k,281)*y(k,200) + mat(k,792) = rxt(k,309)*y(k,200) + mat(k,1391) = rxt(k,292)*y(k,200) + rxt(k,365)*y(k,207) + .250_r8*rxt(k,332) & + *y(k,211) + rxt(k,341)*y(k,213) + .250_r8*rxt(k,390)*y(k,227) + mat(k,1826) = rxt(k,182)*y(k,59) + .800_r8*rxt(k,380)*y(k,101) + rxt(k,262) & + *y(k,124) + .700_r8*rxt(k,281)*y(k,196) + rxt(k,309)*y(k,197) & + + rxt(k,292)*y(k,199) + (4.000_r8*rxt(k,259)+2.000_r8*rxt(k,260)) & + *y(k,200) + 1.500_r8*rxt(k,366)*y(k,207) + .750_r8*rxt(k,371) & + *y(k,208) + .880_r8*rxt(k,333)*y(k,211) + 2.000_r8*rxt(k,342) & + *y(k,213) + .750_r8*rxt(k,445)*y(k,217) + .800_r8*rxt(k,321) & + *y(k,222) + .930_r8*rxt(k,450)*y(k,223) + .950_r8*rxt(k,455) & + *y(k,224) + .800_r8*rxt(k,391)*y(k,227) + mat(k,570) = .500_r8*rxt(k,329)*y(k,124) + mat(k,710) = .500_r8*rxt(k,298)*y(k,124) + mat(k,2108) = mat(k,2108) + .450_r8*rxt(k,343)*y(k,213) + .150_r8*rxt(k,322) & + *y(k,222) + mat(k,1264) = .920_r8*rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126) + rxt(k,365) & + *y(k,199) + 1.500_r8*rxt(k,366)*y(k,200) + mat(k,1296) = .750_r8*rxt(k,371)*y(k,200) + mat(k,1317) = .250_r8*rxt(k,336)*y(k,124) + .250_r8*rxt(k,335)*y(k,126) & + + .250_r8*rxt(k,332)*y(k,199) + .880_r8*rxt(k,333)*y(k,200) + mat(k,1359) = rxt(k,345)*y(k,124) + rxt(k,346)*y(k,126) + rxt(k,341)*y(k,199) & + + 2.000_r8*rxt(k,342)*y(k,200) + .450_r8*rxt(k,343)*y(k,205) & + + 4.000_r8*rxt(k,344)*y(k,213) + mat(k,1052) = .750_r8*rxt(k,445)*y(k,200) + mat(k,1527) = (rxt(k,272)+rxt(k,273))*y(k,54) + mat(k,1691) = mat(k,1691) + .400_r8*rxt(k,356)*y(k,1) + .500_r8*rxt(k,296) & + *y(k,51) + rxt(k,263)*y(k,52) + .300_r8*rxt(k,264)*y(k,53) & + + .800_r8*rxt(k,301)*y(k,74) + .300_r8*rxt(k,376)*y(k,99) & + + .500_r8*rxt(k,351)*y(k,109) + rxt(k,303)*y(k,140) & + + .680_r8*rxt(k,461)*y(k,180) + mat(k,773) = rxt(k,319)*y(k,124) + mat(k,1135) = rxt(k,323)*y(k,124) + .800_r8*rxt(k,321)*y(k,200) & + + .150_r8*rxt(k,322)*y(k,205) + mat(k,1116) = .340_r8*rxt(k,452)*y(k,124) + .930_r8*rxt(k,450)*y(k,200) + mat(k,918) = .320_r8*rxt(k,457)*y(k,124) + .950_r8*rxt(k,455)*y(k,200) + mat(k,1178) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,390)*y(k,199) & + + .800_r8*rxt(k,391)*y(k,200) + 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,596) = -(rxt(k,240)*y(k,56) + rxt(k,241)*y(k,219) + rxt(k,251)*y(k,218)) + mat(k,1984) = -rxt(k,240)*y(k,43) + mat(k,1625) = -rxt(k,241)*y(k,43) + mat(k,1519) = -rxt(k,251)*y(k,43) + mat(k,127) = -(rxt(k,242)*y(k,219)) + mat(k,1559) = -rxt(k,242)*y(k,44) + mat(k,1087) = -(rxt(k,288)*y(k,126) + rxt(k,289)*y(k,219)) + mat(k,1752) = -rxt(k,288)*y(k,45) + mat(k,1668) = -rxt(k,289)*y(k,45) + mat(k,638) = .800_r8*rxt(k,356)*y(k,219) + mat(k,354) = rxt(k,327)*y(k,126) + mat(k,264) = rxt(k,284)*y(k,219) + mat(k,345) = .500_r8*rxt(k,285)*y(k,219) + mat(k,1027) = .500_r8*rxt(k,308)*y(k,135) + mat(k,1329) = .100_r8*rxt(k,352)*y(k,135) + mat(k,1897) = .400_r8*rxt(k,358)*y(k,191) + rxt(k,283)*y(k,196) & + + .270_r8*rxt(k,311)*y(k,197) + rxt(k,329)*y(k,202) + rxt(k,348) & + *y(k,215) + rxt(k,319)*y(k,221) + mat(k,1752) = mat(k,1752) + rxt(k,327)*y(k,16) + mat(k,2227) = .500_r8*rxt(k,308)*y(k,29) + .100_r8*rxt(k,352)*y(k,111) + mat(k,891) = .400_r8*rxt(k,358)*y(k,124) + mat(k,826) = rxt(k,283)*y(k,124) + 3.200_r8*rxt(k,280)*y(k,196) & + + .800_r8*rxt(k,281)*y(k,200) + mat(k,791) = .270_r8*rxt(k,311)*y(k,124) + mat(k,1807) = .800_r8*rxt(k,281)*y(k,196) + mat(k,568) = rxt(k,329)*y(k,124) + mat(k,2087) = .200_r8*rxt(k,347)*y(k,215) + mat(k,680) = rxt(k,348)*y(k,124) + .200_r8*rxt(k,347)*y(k,205) + mat(k,1668) = mat(k,1668) + .800_r8*rxt(k,356)*y(k,1) + rxt(k,284)*y(k,26) & + + .500_r8*rxt(k,285)*y(k,27) + mat(k,771) = rxt(k,319)*y(k,124) + mat(k,367) = -(rxt(k,243)*y(k,56) + rxt(k,244)*y(k,219)) + mat(k,1980) = -rxt(k,243)*y(k,46) + mat(k,1594) = -rxt(k,244)*y(k,46) + mat(k,104) = -(rxt(k,290)*y(k,219)) + mat(k,1557) = -rxt(k,290)*y(k,47) + mat(k,924) = -(rxt(k,326)*y(k,219)) + mat(k,1658) = -rxt(k,326)*y(k,48) + mat(k,637) = .800_r8*rxt(k,356)*y(k,219) + mat(k,997) = .520_r8*rxt(k,440)*y(k,135) + mat(k,353) = .500_r8*rxt(k,327)*y(k,126) + mat(k,948) = .520_r8*rxt(k,443)*y(k,135) + mat(k,1890) = .250_r8*rxt(k,358)*y(k,191) + .820_r8*rxt(k,311)*y(k,197) & + + .500_r8*rxt(k,329)*y(k,202) + .270_r8*rxt(k,452)*y(k,223) & + + .040_r8*rxt(k,457)*y(k,224) + mat(k,1742) = .500_r8*rxt(k,327)*y(k,16) + mat(k,2218) = .520_r8*rxt(k,440)*y(k,6) + .520_r8*rxt(k,443)*y(k,110) + mat(k,1060) = .500_r8*rxt(k,461)*y(k,219) + mat(k,890) = .250_r8*rxt(k,358)*y(k,124) + mat(k,790) = .820_r8*rxt(k,311)*y(k,124) + .820_r8*rxt(k,309)*y(k,200) + mat(k,1801) = .820_r8*rxt(k,309)*y(k,197) + .150_r8*rxt(k,450)*y(k,223) & + + .025_r8*rxt(k,455)*y(k,224) + mat(k,567) = .500_r8*rxt(k,329)*y(k,124) + mat(k,1658) = mat(k,1658) + .800_r8*rxt(k,356)*y(k,1) + .500_r8*rxt(k,461) & + *y(k,180) + mat(k,1108) = .270_r8*rxt(k,452)*y(k,124) + .150_r8*rxt(k,450)*y(k,200) + mat(k,915) = .040_r8*rxt(k,457)*y(k,124) + .025_r8*rxt(k,455)*y(k,200) + mat(k,1223) = -(rxt(k,314)*y(k,126) + rxt(k,315)*y(k,219)) + mat(k,1762) = -rxt(k,314)*y(k,49) + mat(k,1678) = -rxt(k,315)*y(k,49) + mat(k,1143) = rxt(k,316)*y(k,219) + mat(k,1212) = .880_r8*rxt(k,338)*y(k,135) + mat(k,1332) = .500_r8*rxt(k,352)*y(k,135) + mat(k,1907) = .170_r8*rxt(k,411)*y(k,201) + .050_r8*rxt(k,374)*y(k,208) & + + .250_r8*rxt(k,336)*y(k,211) + .170_r8*rxt(k,417)*y(k,214) & + + .400_r8*rxt(k,427)*y(k,225) + .250_r8*rxt(k,393)*y(k,227) & + + .540_r8*rxt(k,433)*y(k,228) + .510_r8*rxt(k,436)*y(k,230) + mat(k,1762) = mat(k,1762) + .050_r8*rxt(k,375)*y(k,208) + .250_r8*rxt(k,335) & + *y(k,211) + .250_r8*rxt(k,394)*y(k,227) + mat(k,860) = rxt(k,317)*y(k,219) + mat(k,2235) = .880_r8*rxt(k,338)*y(k,105) + .500_r8*rxt(k,352)*y(k,111) + mat(k,1382) = .250_r8*rxt(k,332)*y(k,211) + .250_r8*rxt(k,390)*y(k,227) + mat(k,1816) = .240_r8*rxt(k,333)*y(k,211) + .500_r8*rxt(k,321)*y(k,222) & + + .100_r8*rxt(k,391)*y(k,227) + mat(k,763) = .170_r8*rxt(k,411)*y(k,124) + .070_r8*rxt(k,410)*y(k,205) + mat(k,2096) = .070_r8*rxt(k,410)*y(k,201) + .070_r8*rxt(k,416)*y(k,214) + mat(k,1289) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) + mat(k,1312) = .250_r8*rxt(k,336)*y(k,124) + .250_r8*rxt(k,335)*y(k,126) & + + .250_r8*rxt(k,332)*y(k,199) + .240_r8*rxt(k,333)*y(k,200) + mat(k,878) = .170_r8*rxt(k,417)*y(k,124) + .070_r8*rxt(k,416)*y(k,205) + mat(k,1678) = mat(k,1678) + rxt(k,316)*y(k,95) + rxt(k,317)*y(k,127) + mat(k,1133) = .500_r8*rxt(k,321)*y(k,200) + mat(k,731) = .400_r8*rxt(k,427)*y(k,124) + mat(k,1176) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + + .250_r8*rxt(k,390)*y(k,199) + .100_r8*rxt(k,391)*y(k,200) + mat(k,755) = .540_r8*rxt(k,433)*y(k,124) + mat(k,503) = .510_r8*rxt(k,436)*y(k,124) + mat(k,686) = -(rxt(k,295)*y(k,219)) + mat(k,1635) = -rxt(k,295)*y(k,50) + mat(k,1021) = .120_r8*rxt(k,308)*y(k,135) + mat(k,2212) = .120_r8*rxt(k,308)*y(k,29) + mat(k,1372) = .100_r8*rxt(k,292)*y(k,200) + .150_r8*rxt(k,293)*y(k,205) + mat(k,1794) = .100_r8*rxt(k,292)*y(k,199) + mat(k,2062) = .150_r8*rxt(k,293)*y(k,199) + .150_r8*rxt(k,343)*y(k,213) + mat(k,1351) = .150_r8*rxt(k,343)*y(k,205) + mat(k,612) = -(rxt(k,296)*y(k,219)) + mat(k,1627) = -rxt(k,296)*y(k,51) + mat(k,1371) = .400_r8*rxt(k,293)*y(k,205) + mat(k,2056) = .400_r8*rxt(k,293)*y(k,199) + .400_r8*rxt(k,343)*y(k,213) + mat(k,1350) = .400_r8*rxt(k,343)*y(k,205) + mat(k,799) = -(rxt(k,263)*y(k,219)) + mat(k,1645) = -rxt(k,263)*y(k,52) + mat(k,1189) = .200_r8*rxt(k,380)*y(k,200) + mat(k,824) = .300_r8*rxt(k,281)*y(k,200) + mat(k,1796) = .200_r8*rxt(k,380)*y(k,101) + .300_r8*rxt(k,281)*y(k,196) & + + 2.000_r8*rxt(k,260)*y(k,200) + .250_r8*rxt(k,366)*y(k,207) & + + .250_r8*rxt(k,371)*y(k,208) + .250_r8*rxt(k,333)*y(k,211) & + + .250_r8*rxt(k,445)*y(k,217) + .500_r8*rxt(k,321)*y(k,222) & + + .250_r8*rxt(k,450)*y(k,223) + .250_r8*rxt(k,455)*y(k,224) & + + .300_r8*rxt(k,391)*y(k,227) + mat(k,1249) = .250_r8*rxt(k,366)*y(k,200) + mat(k,1279) = .250_r8*rxt(k,371)*y(k,200) + mat(k,1307) = .250_r8*rxt(k,333)*y(k,200) + mat(k,1045) = .250_r8*rxt(k,445)*y(k,200) + mat(k,1130) = .500_r8*rxt(k,321)*y(k,200) + mat(k,1106) = .250_r8*rxt(k,450)*y(k,200) + mat(k,913) = .250_r8*rxt(k,455)*y(k,200) + mat(k,1169) = .300_r8*rxt(k,391)*y(k,200) + mat(k,456) = -(rxt(k,264)*y(k,219)) + mat(k,1606) = -rxt(k,264)*y(k,53) + mat(k,1792) = rxt(k,261)*y(k,205) + mat(k,2047) = rxt(k,261)*y(k,200) + mat(k,1432) = -(rxt(k,176)*y(k,56) + rxt(k,232)*y(k,73) + rxt(k,265)*y(k,219) & + + (rxt(k,271) + rxt(k,272) + rxt(k,273)) * y(k,218)) + mat(k,1998) = -rxt(k,176)*y(k,54) + mat(k,868) = -rxt(k,232)*y(k,54) + mat(k,1688) = -rxt(k,265)*y(k,54) + mat(k,1524) = -(rxt(k,271) + rxt(k,272) + rxt(k,273)) * y(k,54) + mat(k,1032) = .100_r8*rxt(k,308)*y(k,135) + mat(k,2244) = .100_r8*rxt(k,308)*y(k,29) + mat(k,387) = -(rxt(k,228)*y(k,218) + rxt(k,245)*y(k,56) + rxt(k,246)*y(k,219)) + mat(k,1517) = -rxt(k,228)*y(k,55) + mat(k,1981) = -rxt(k,245)*y(k,55) + mat(k,1596) = -rxt(k,246)*y(k,55) + mat(k,2009) = -(rxt(k,175)*y(k,42) + rxt(k,176)*y(k,54) + rxt(k,177)*y(k,77) & + + rxt(k,178)*y(k,79) + (rxt(k,179) + rxt(k,180)) * y(k,205) & + + rxt(k,181)*y(k,135) + rxt(k,188)*y(k,60) + rxt(k,197)*y(k,92) & + + rxt(k,238)*y(k,41) + rxt(k,240)*y(k,43) + rxt(k,243)*y(k,46) & + + rxt(k,245)*y(k,55) + rxt(k,286)*y(k,28)) + mat(k,1494) = -rxt(k,175)*y(k,56) + mat(k,1440) = -rxt(k,176)*y(k,56) + mat(k,1411) = -rxt(k,177)*y(k,56) + mat(k,607) = -rxt(k,178)*y(k,56) + mat(k,2116) = -(rxt(k,179) + rxt(k,180)) * y(k,56) + mat(k,2255) = -rxt(k,181)*y(k,56) + mat(k,907) = -rxt(k,188)*y(k,56) + mat(k,818) = -rxt(k,197)*y(k,56) + mat(k,473) = -rxt(k,238)*y(k,56) + mat(k,601) = -rxt(k,240)*y(k,56) + mat(k,371) = -rxt(k,243)*y(k,56) + mat(k,391) = -rxt(k,245)*y(k,56) + mat(k,309) = -rxt(k,286)*y(k,56) + mat(k,2163) = rxt(k,216)*y(k,59) + mat(k,103) = 4.000_r8*rxt(k,200)*y(k,218) + mat(k,147) = rxt(k,201)*y(k,218) + mat(k,118) = 2.000_r8*rxt(k,202)*y(k,218) + mat(k,157) = 2.000_r8*rxt(k,203)*y(k,218) + mat(k,122) = 2.000_r8*rxt(k,204)*y(k,218) + mat(k,162) = rxt(k,205)*y(k,218) + mat(k,126) = 2.000_r8*rxt(k,206)*y(k,218) + mat(k,129) = 3.000_r8*rxt(k,242)*y(k,219) + mat(k,371) = mat(k,371) + rxt(k,244)*y(k,219) + mat(k,1725) = rxt(k,216)*y(k,19) + (4.000_r8*rxt(k,183)+2.000_r8*rxt(k,185)) & + *y(k,59) + rxt(k,187)*y(k,124) + rxt(k,192)*y(k,134) & + + rxt(k,470)*y(k,151) + rxt(k,182)*y(k,200) + rxt(k,193) & + *y(k,219) + mat(k,251) = rxt(k,237)*y(k,218) + mat(k,247) = rxt(k,252)*y(k,218) + rxt(k,247)*y(k,219) + mat(k,257) = rxt(k,253)*y(k,218) + rxt(k,248)*y(k,219) + mat(k,304) = rxt(k,254)*y(k,218) + rxt(k,249)*y(k,219) + mat(k,2139) = rxt(k,195)*y(k,134) + rxt(k,207)*y(k,218) + rxt(k,196)*y(k,219) + mat(k,1926) = rxt(k,187)*y(k,59) + mat(k,2194) = rxt(k,192)*y(k,59) + rxt(k,195)*y(k,85) + mat(k,1241) = rxt(k,470)*y(k,59) + mat(k,1834) = rxt(k,182)*y(k,59) + mat(k,1535) = 4.000_r8*rxt(k,200)*y(k,33) + rxt(k,201)*y(k,34) & + + 2.000_r8*rxt(k,202)*y(k,36) + 2.000_r8*rxt(k,203)*y(k,37) & + + 2.000_r8*rxt(k,204)*y(k,38) + rxt(k,205)*y(k,39) & + + 2.000_r8*rxt(k,206)*y(k,40) + rxt(k,237)*y(k,65) + rxt(k,252) & + *y(k,82) + rxt(k,253)*y(k,83) + rxt(k,254)*y(k,84) + rxt(k,207) & + *y(k,85) + mat(k,1699) = 3.000_r8*rxt(k,242)*y(k,44) + rxt(k,244)*y(k,46) + rxt(k,193) & + *y(k,59) + rxt(k,247)*y(k,82) + rxt(k,248)*y(k,83) + rxt(k,249) & + *y(k,84) + rxt(k,196)*y(k,85) + mat(k,1977) = rxt(k,188)*y(k,60) + mat(k,1707) = 2.000_r8*rxt(k,184)*y(k,59) + mat(k,899) = rxt(k,188)*y(k,56) + (rxt(k,528)+rxt(k,533)+rxt(k,538))*y(k,85) + mat(k,2123) = (rxt(k,528)+rxt(k,533)+rxt(k,538))*y(k,60) + (rxt(k,523) & + +rxt(k,529)+rxt(k,534))*y(k,92) + mat(k,814) = (rxt(k,523)+rxt(k,529)+rxt(k,534))*y(k,85) + mat(k,1706) = 2.000_r8*rxt(k,209)*y(k,59) + mat(k,1720) = -(rxt(k,182)*y(k,200) + (4._r8*rxt(k,183) + 4._r8*rxt(k,184) & + + 4._r8*rxt(k,185) + 4._r8*rxt(k,209)) * y(k,59) + rxt(k,186) & + *y(k,205) + rxt(k,187)*y(k,124) + rxt(k,189)*y(k,125) + rxt(k,192) & + *y(k,134) + (rxt(k,193) + rxt(k,194)) * y(k,219) + (rxt(k,215) & + + rxt(k,216) + rxt(k,217)) * y(k,19) + rxt(k,470)*y(k,151)) + mat(k,1829) = -rxt(k,182)*y(k,59) + mat(k,2111) = -rxt(k,186)*y(k,59) + mat(k,1921) = -rxt(k,187)*y(k,59) + mat(k,1965) = -rxt(k,189)*y(k,59) + mat(k,2189) = -rxt(k,192)*y(k,59) + mat(k,1694) = -(rxt(k,193) + rxt(k,194)) * y(k,59) + mat(k,2158) = -(rxt(k,215) + rxt(k,216) + rxt(k,217)) * y(k,59) + mat(k,1238) = -rxt(k,470)*y(k,59) + mat(k,2004) = rxt(k,197)*y(k,92) + rxt(k,181)*y(k,135) + rxt(k,180)*y(k,205) + mat(k,904) = rxt(k,190)*y(k,134) + mat(k,2134) = rxt(k,208)*y(k,218) + mat(k,817) = rxt(k,197)*y(k,56) + rxt(k,198)*y(k,134) + rxt(k,199)*y(k,219) + mat(k,2189) = mat(k,2189) + rxt(k,190)*y(k,60) + rxt(k,198)*y(k,92) + mat(k,2250) = rxt(k,181)*y(k,56) + mat(k,330) = rxt(k,475)*y(k,151) + mat(k,1238) = mat(k,1238) + rxt(k,475)*y(k,137) + mat(k,2111) = mat(k,2111) + rxt(k,180)*y(k,56) + mat(k,1530) = rxt(k,208)*y(k,85) + mat(k,1694) = mat(k,1694) + rxt(k,199)*y(k,92) + 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,901) = -(rxt(k,188)*y(k,56) + rxt(k,190)*y(k,134) + rxt(k,191)*y(k,219) & + + (rxt(k,528) + rxt(k,533) + rxt(k,538)) * y(k,85)) + mat(k,1989) = -rxt(k,188)*y(k,60) + mat(k,2178) = -rxt(k,190)*y(k,60) + mat(k,1656) = -rxt(k,191)*y(k,60) + mat(k,2127) = -(rxt(k,528) + rxt(k,533) + rxt(k,538)) * y(k,60) + mat(k,1712) = rxt(k,189)*y(k,125) + mat(k,1950) = rxt(k,189)*y(k,59) + mat(k,1125) = -(rxt(k,275)*y(k,219)) + mat(k,1671) = -rxt(k,275)*y(k,62) + mat(k,1006) = .230_r8*rxt(k,440)*y(k,135) + mat(k,1416) = rxt(k,211)*y(k,42) + mat(k,296) = .350_r8*rxt(k,277)*y(k,219) + mat(k,553) = .630_r8*rxt(k,279)*y(k,135) + mat(k,1028) = .560_r8*rxt(k,308)*y(k,135) + mat(k,1481) = rxt(k,211)*y(k,17) + rxt(k,175)*y(k,56) + rxt(k,256)*y(k,126) & + + rxt(k,257)*y(k,134) + rxt(k,258)*y(k,219) + mat(k,368) = rxt(k,243)*y(k,56) + mat(k,1222) = rxt(k,314)*y(k,126) + rxt(k,315)*y(k,219) + mat(k,1994) = rxt(k,175)*y(k,42) + rxt(k,243)*y(k,46) + mat(k,982) = rxt(k,302)*y(k,219) + mat(k,839) = .620_r8*rxt(k,385)*y(k,135) + mat(k,1210) = .650_r8*rxt(k,338)*y(k,135) + mat(k,956) = .230_r8*rxt(k,443)*y(k,135) + mat(k,1330) = .560_r8*rxt(k,352)*y(k,135) + mat(k,1900) = .170_r8*rxt(k,411)*y(k,201) + .220_r8*rxt(k,336)*y(k,211) & + + .400_r8*rxt(k,414)*y(k,212) + .350_r8*rxt(k,417)*y(k,214) & + + .225_r8*rxt(k,452)*y(k,223) + .250_r8*rxt(k,393)*y(k,227) + mat(k,1755) = rxt(k,256)*y(k,42) + rxt(k,314)*y(k,49) + .220_r8*rxt(k,335) & + *y(k,211) + .500_r8*rxt(k,394)*y(k,227) + mat(k,2179) = rxt(k,257)*y(k,42) + rxt(k,464)*y(k,138) + mat(k,2230) = .230_r8*rxt(k,440)*y(k,6) + .630_r8*rxt(k,279)*y(k,25) & + + .560_r8*rxt(k,308)*y(k,29) + .620_r8*rxt(k,385)*y(k,98) & + + .650_r8*rxt(k,338)*y(k,105) + .230_r8*rxt(k,443)*y(k,110) & + + .560_r8*rxt(k,352)*y(k,111) + mat(k,362) = rxt(k,464)*y(k,134) + rxt(k,465)*y(k,219) + mat(k,1062) = .700_r8*rxt(k,461)*y(k,219) + mat(k,1377) = .220_r8*rxt(k,332)*y(k,211) + .250_r8*rxt(k,390)*y(k,227) + mat(k,1810) = .110_r8*rxt(k,333)*y(k,211) + .125_r8*rxt(k,450)*y(k,223) & + + .200_r8*rxt(k,391)*y(k,227) + mat(k,762) = .170_r8*rxt(k,411)*y(k,124) + .070_r8*rxt(k,410)*y(k,205) + mat(k,2090) = .070_r8*rxt(k,410)*y(k,201) + .160_r8*rxt(k,413)*y(k,212) & + + .140_r8*rxt(k,416)*y(k,214) + mat(k,1309) = .220_r8*rxt(k,336)*y(k,124) + .220_r8*rxt(k,335)*y(k,126) & + + .220_r8*rxt(k,332)*y(k,199) + .110_r8*rxt(k,333)*y(k,200) + mat(k,717) = .400_r8*rxt(k,414)*y(k,124) + .160_r8*rxt(k,413)*y(k,205) + mat(k,877) = .350_r8*rxt(k,417)*y(k,124) + .140_r8*rxt(k,416)*y(k,205) + mat(k,1671) = mat(k,1671) + .350_r8*rxt(k,277)*y(k,24) + rxt(k,258)*y(k,42) & + + rxt(k,315)*y(k,49) + rxt(k,302)*y(k,75) + rxt(k,465)*y(k,138) & + + .700_r8*rxt(k,461)*y(k,180) + mat(k,1112) = .225_r8*rxt(k,452)*y(k,124) + .125_r8*rxt(k,450)*y(k,200) + mat(k,1173) = .250_r8*rxt(k,393)*y(k,124) + .500_r8*rxt(k,394)*y(k,126) & + + .250_r8*rxt(k,390)*y(k,199) + .200_r8*rxt(k,391)*y(k,200) + mat(k,994) = .270_r8*rxt(k,440)*y(k,135) + mat(k,1023) = .200_r8*rxt(k,308)*y(k,135) + mat(k,687) = rxt(k,295)*y(k,219) + mat(k,613) = .500_r8*rxt(k,296)*y(k,219) + mat(k,1124) = rxt(k,275)*y(k,219) + mat(k,1096) = .800_r8*rxt(k,301)*y(k,219) + mat(k,980) = rxt(k,302)*y(k,219) + mat(k,930) = rxt(k,267)*y(k,219) + mat(k,575) = .500_r8*rxt(k,351)*y(k,219) + mat(k,945) = .270_r8*rxt(k,443)*y(k,135) + mat(k,1326) = .100_r8*rxt(k,352)*y(k,135) + mat(k,1884) = rxt(k,294)*y(k,199) + .900_r8*rxt(k,452)*y(k,223) + mat(k,2214) = .270_r8*rxt(k,440)*y(k,6) + .200_r8*rxt(k,308)*y(k,29) & + + .270_r8*rxt(k,443)*y(k,110) + .100_r8*rxt(k,352)*y(k,111) + mat(k,1059) = 1.800_r8*rxt(k,461)*y(k,219) + mat(k,1373) = rxt(k,294)*y(k,124) + 4.000_r8*rxt(k,291)*y(k,199) & + + .900_r8*rxt(k,292)*y(k,200) + rxt(k,365)*y(k,207) & + + 2.000_r8*rxt(k,341)*y(k,213) + rxt(k,390)*y(k,227) + mat(k,1797) = .900_r8*rxt(k,292)*y(k,199) + rxt(k,342)*y(k,213) & + + .500_r8*rxt(k,450)*y(k,223) + mat(k,2073) = .450_r8*rxt(k,343)*y(k,213) + mat(k,1250) = rxt(k,365)*y(k,199) + mat(k,1352) = 2.000_r8*rxt(k,341)*y(k,199) + rxt(k,342)*y(k,200) & + + .450_r8*rxt(k,343)*y(k,205) + 4.000_r8*rxt(k,344)*y(k,213) + mat(k,1646) = rxt(k,295)*y(k,50) + .500_r8*rxt(k,296)*y(k,51) + rxt(k,275) & + *y(k,62) + .800_r8*rxt(k,301)*y(k,74) + rxt(k,302)*y(k,75) & + + rxt(k,267)*y(k,87) + .500_r8*rxt(k,351)*y(k,109) & + + 1.800_r8*rxt(k,461)*y(k,180) + mat(k,1107) = .900_r8*rxt(k,452)*y(k,124) + .500_r8*rxt(k,450)*y(k,200) + mat(k,1170) = rxt(k,390)*y(k,199) + mat(k,240) = -(rxt(k,236)*y(k,218)) + mat(k,1512) = -rxt(k,236)*y(k,64) + mat(k,144) = rxt(k,201)*y(k,218) + mat(k,149) = rxt(k,227)*y(k,218) + mat(k,154) = rxt(k,203)*y(k,218) + mat(k,120) = 2.000_r8*rxt(k,204)*y(k,218) + mat(k,159) = 2.000_r8*rxt(k,205)*y(k,218) + mat(k,124) = rxt(k,206)*y(k,218) + mat(k,108) = 2.000_r8*rxt(k,229)*y(k,218) + mat(k,252) = rxt(k,253)*y(k,218) + rxt(k,248)*y(k,219) + mat(k,299) = rxt(k,254)*y(k,218) + rxt(k,249)*y(k,219) + mat(k,1512) = mat(k,1512) + rxt(k,201)*y(k,34) + rxt(k,227)*y(k,35) & + + rxt(k,203)*y(k,37) + 2.000_r8*rxt(k,204)*y(k,38) & + + 2.000_r8*rxt(k,205)*y(k,39) + rxt(k,206)*y(k,40) & + + 2.000_r8*rxt(k,229)*y(k,78) + rxt(k,253)*y(k,83) + rxt(k,254) & + *y(k,84) + mat(k,1575) = rxt(k,248)*y(k,83) + rxt(k,249)*y(k,84) + mat(k,248) = -(rxt(k,237)*y(k,218)) + mat(k,1514) = -rxt(k,237)*y(k,65) + mat(k,116) = rxt(k,202)*y(k,218) + mat(k,155) = rxt(k,203)*y(k,218) + mat(k,244) = rxt(k,252)*y(k,218) + rxt(k,247)*y(k,219) + mat(k,1514) = mat(k,1514) + rxt(k,202)*y(k,36) + rxt(k,203)*y(k,37) & + + rxt(k,252)*y(k,82) + mat(k,1577) = rxt(k,247)*y(k,82) + mat(k,196) = -(rxt(k,409)*y(k,219)) + mat(k,1566) = -rxt(k,409)*y(k,66) + mat(k,190) = .180_r8*rxt(k,429)*y(k,219) + mat(k,1566) = mat(k,1566) + .180_r8*rxt(k,429)*y(k,182) + mat(k,284) = -(rxt(k,462)*y(k,126) + (rxt(k,463) + rxt(k,477)) * y(k,219)) + mat(k,1735) = -rxt(k,462)*y(k,67) + mat(k,1582) = -(rxt(k,463) + rxt(k,477)) * y(k,67) + mat(k,706) = rxt(k,297)*y(k,205) + mat(k,2028) = rxt(k,297)*y(k,204) + mat(k,866) = -(rxt(k,232)*y(k,54) + rxt(k,233)*y(k,77) + rxt(k,234)*y(k,231) & + + rxt(k,235)*y(k,89)) + mat(k,1429) = -rxt(k,232)*y(k,73) + mat(k,1402) = -rxt(k,233)*y(k,73) + mat(k,2266) = -rxt(k,234)*y(k,73) + mat(k,1461) = -rxt(k,235)*y(k,73) + mat(k,150) = rxt(k,227)*y(k,218) + mat(k,160) = rxt(k,205)*y(k,218) + mat(k,241) = 2.000_r8*rxt(k,236)*y(k,218) + mat(k,249) = rxt(k,237)*y(k,218) + mat(k,1521) = rxt(k,227)*y(k,35) + rxt(k,205)*y(k,39) + 2.000_r8*rxt(k,236) & + *y(k,64) + rxt(k,237)*y(k,65) + mat(k,1098) = -(rxt(k,301)*y(k,219)) + mat(k,1669) = -rxt(k,301)*y(k,74) + mat(k,584) = .700_r8*rxt(k,376)*y(k,219) + mat(k,536) = .500_r8*rxt(k,377)*y(k,219) + mat(k,377) = rxt(k,388)*y(k,219) + mat(k,1898) = .050_r8*rxt(k,374)*y(k,208) + .530_r8*rxt(k,336)*y(k,211) & + + .225_r8*rxt(k,452)*y(k,223) + .250_r8*rxt(k,393)*y(k,227) + mat(k,1753) = .050_r8*rxt(k,375)*y(k,208) + .530_r8*rxt(k,335)*y(k,211) & + + .250_r8*rxt(k,394)*y(k,227) + mat(k,1376) = .530_r8*rxt(k,332)*y(k,211) + .250_r8*rxt(k,390)*y(k,227) + mat(k,1808) = .260_r8*rxt(k,333)*y(k,211) + .125_r8*rxt(k,450)*y(k,223) & + + .100_r8*rxt(k,391)*y(k,227) + mat(k,1283) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) + mat(k,1308) = .530_r8*rxt(k,336)*y(k,124) + .530_r8*rxt(k,335)*y(k,126) & + + .530_r8*rxt(k,332)*y(k,199) + .260_r8*rxt(k,333)*y(k,200) + mat(k,1669) = mat(k,1669) + .700_r8*rxt(k,376)*y(k,99) + .500_r8*rxt(k,377) & + *y(k,100) + rxt(k,388)*y(k,115) + mat(k,1110) = .225_r8*rxt(k,452)*y(k,124) + .125_r8*rxt(k,450)*y(k,200) + mat(k,1172) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + + .250_r8*rxt(k,390)*y(k,199) + .100_r8*rxt(k,391)*y(k,200) + mat(k,981) = -(rxt(k,302)*y(k,219)) + mat(k,1662) = -rxt(k,302)*y(k,75) + mat(k,295) = .650_r8*rxt(k,277)*y(k,219) + mat(k,1097) = .200_r8*rxt(k,301)*y(k,219) + mat(k,1074) = rxt(k,389)*y(k,219) + mat(k,1893) = rxt(k,400)*y(k,193) + .050_r8*rxt(k,374)*y(k,208) & + + .400_r8*rxt(k,414)*y(k,212) + .170_r8*rxt(k,417)*y(k,214) & + + .700_r8*rxt(k,420)*y(k,220) + .600_r8*rxt(k,427)*y(k,225) & + + .250_r8*rxt(k,393)*y(k,227) + .340_r8*rxt(k,433)*y(k,228) & + + .170_r8*rxt(k,436)*y(k,230) + mat(k,1746) = .050_r8*rxt(k,375)*y(k,208) + .250_r8*rxt(k,394)*y(k,227) + mat(k,487) = rxt(k,400)*y(k,124) + mat(k,1374) = .250_r8*rxt(k,390)*y(k,227) + mat(k,1803) = .100_r8*rxt(k,391)*y(k,227) + mat(k,2084) = .160_r8*rxt(k,413)*y(k,212) + .070_r8*rxt(k,416)*y(k,214) + mat(k,1282) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) + mat(k,716) = .400_r8*rxt(k,414)*y(k,124) + .160_r8*rxt(k,413)*y(k,205) + mat(k,876) = .170_r8*rxt(k,417)*y(k,124) + .070_r8*rxt(k,416)*y(k,205) + mat(k,1662) = mat(k,1662) + .650_r8*rxt(k,277)*y(k,24) + .200_r8*rxt(k,301) & + *y(k,74) + rxt(k,389)*y(k,116) + mat(k,451) = .700_r8*rxt(k,420)*y(k,124) + mat(k,729) = .600_r8*rxt(k,427)*y(k,124) + mat(k,1171) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + + .250_r8*rxt(k,390)*y(k,199) + .100_r8*rxt(k,391)*y(k,200) + mat(k,753) = .340_r8*rxt(k,433)*y(k,124) + mat(k,502) = .170_r8*rxt(k,436)*y(k,124) + mat(k,1447) = -((rxt(k,135) + rxt(k,136) + rxt(k,137)) * y(k,205) + rxt(k,141) & + *y(k,135)) + mat(k,2106) = -(rxt(k,135) + rxt(k,136) + rxt(k,137)) * y(k,76) + mat(k,2245) = -rxt(k,141)*y(k,76) + mat(k,1485) = rxt(k,258)*y(k,219) + mat(k,1433) = rxt(k,272)*y(k,218) + mat(k,1999) = rxt(k,177)*y(k,77) + mat(k,869) = rxt(k,233)*y(k,77) + mat(k,1405) = rxt(k,177)*y(k,56) + rxt(k,233)*y(k,73) + rxt(k,133)*y(k,134) & + + rxt(k,125)*y(k,218) + rxt(k,142)*y(k,219) + mat(k,808) = rxt(k,231)*y(k,218) + mat(k,2129) = rxt(k,208)*y(k,218) + mat(k,494) = rxt(k,163)*y(k,219) + mat(k,2184) = rxt(k,133)*y(k,77) + rxt(k,145)*y(k,219) + mat(k,364) = rxt(k,465)*y(k,219) + mat(k,515) = rxt(k,471)*y(k,219) + mat(k,1236) = rxt(k,476)*y(k,219) + mat(k,1525) = rxt(k,272)*y(k,54) + rxt(k,125)*y(k,77) + rxt(k,231)*y(k,81) & + + rxt(k,208)*y(k,85) + mat(k,1689) = rxt(k,258)*y(k,42) + rxt(k,142)*y(k,77) + rxt(k,163)*y(k,112) & + + rxt(k,145)*y(k,134) + rxt(k,465)*y(k,138) + rxt(k,471) & + *y(k,149) + rxt(k,476)*y(k,151) + mat(k,1403) = -(rxt(k,125)*y(k,218) + rxt(k,133)*y(k,134) + rxt(k,142) & + *y(k,219) + rxt(k,177)*y(k,56) + rxt(k,233)*y(k,73)) + mat(k,1522) = -rxt(k,125)*y(k,77) + mat(k,2181) = -rxt(k,133)*y(k,77) + mat(k,1686) = -rxt(k,142)*y(k,77) + mat(k,1996) = -rxt(k,177)*y(k,77) + mat(k,867) = -rxt(k,233)*y(k,77) + mat(k,1431) = rxt(k,273)*y(k,218) + mat(k,1445) = rxt(k,135)*y(k,205) + mat(k,2103) = rxt(k,135)*y(k,76) + mat(k,1522) = mat(k,1522) + rxt(k,273)*y(k,54) + 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,107) = -(rxt(k,229)*y(k,218)) + mat(k,1502) = -rxt(k,229)*y(k,78) + mat(k,605) = -(rxt(k,134)*y(k,134) + rxt(k,143)*y(k,219) + rxt(k,178)*y(k,56)) + mat(k,2173) = -rxt(k,134)*y(k,79) + mat(k,1626) = -rxt(k,143)*y(k,79) + mat(k,1985) = -rxt(k,178)*y(k,79) + mat(k,2055) = 2.000_r8*rxt(k,149)*y(k,205) + mat(k,1626) = mat(k,1626) + 2.000_r8*rxt(k,148)*y(k,219) + mat(k,258) = rxt(k,478)*y(k,231) + mat(k,2262) = rxt(k,478)*y(k,153) + mat(k,806) = -(rxt(k,224)*y(k,134) + rxt(k,225)*y(k,219) + (rxt(k,230) & + + rxt(k,231)) * y(k,218)) + mat(k,2175) = -rxt(k,224)*y(k,81) + mat(k,1647) = -rxt(k,225)*y(k,81) + mat(k,1520) = -(rxt(k,230) + rxt(k,231)) * y(k,81) + mat(k,1415) = rxt(k,211)*y(k,42) + rxt(k,212)*y(k,205) + mat(k,1479) = rxt(k,211)*y(k,17) + mat(k,2074) = rxt(k,212)*y(k,17) + mat(k,243) = -(rxt(k,247)*y(k,219) + rxt(k,252)*y(k,218)) + mat(k,1576) = -rxt(k,247)*y(k,82) + mat(k,1513) = -rxt(k,252)*y(k,82) + mat(k,253) = -(rxt(k,248)*y(k,219) + rxt(k,253)*y(k,218)) + mat(k,1578) = -rxt(k,248)*y(k,83) + mat(k,1515) = -rxt(k,253)*y(k,83) + mat(k,300) = -(rxt(k,249)*y(k,219) + rxt(k,254)*y(k,218)) + mat(k,1584) = -rxt(k,249)*y(k,84) + mat(k,1516) = -rxt(k,254)*y(k,84) + mat(k,2141) = -(rxt(k,195)*y(k,134) + rxt(k,196)*y(k,219) + (rxt(k,207) & + + rxt(k,208)) * y(k,218) + (rxt(k,523) + rxt(k,529) + rxt(k,534) & + ) * y(k,92) + (rxt(k,528) + rxt(k,533) + rxt(k,538)) * y(k,60) & + + (rxt(k,530) + rxt(k,535)) * y(k,91)) + mat(k,2196) = -rxt(k,195)*y(k,85) + mat(k,1701) = -rxt(k,196)*y(k,85) + mat(k,1537) = -(rxt(k,207) + rxt(k,208)) * y(k,85) + mat(k,819) = -(rxt(k,523) + rxt(k,529) + rxt(k,534)) * y(k,85) + mat(k,908) = -(rxt(k,528) + rxt(k,533) + rxt(k,538)) * y(k,85) + mat(k,784) = -(rxt(k,530) + rxt(k,535)) * y(k,85) + mat(k,310) = rxt(k,286)*y(k,56) + mat(k,474) = rxt(k,238)*y(k,56) + mat(k,1496) = rxt(k,175)*y(k,56) + mat(k,603) = rxt(k,240)*y(k,56) + mat(k,373) = 2.000_r8*rxt(k,243)*y(k,56) + mat(k,1442) = rxt(k,176)*y(k,56) + mat(k,392) = rxt(k,245)*y(k,56) + mat(k,2011) = rxt(k,286)*y(k,28) + rxt(k,238)*y(k,41) + rxt(k,175)*y(k,42) & + + rxt(k,240)*y(k,43) + 2.000_r8*rxt(k,243)*y(k,46) + rxt(k,176) & + *y(k,54) + rxt(k,245)*y(k,55) + rxt(k,177)*y(k,77) + rxt(k,178) & + *y(k,79) + rxt(k,197)*y(k,92) + rxt(k,179)*y(k,205) + mat(k,1727) = rxt(k,194)*y(k,219) + mat(k,1412) = rxt(k,177)*y(k,56) + mat(k,609) = rxt(k,178)*y(k,56) + mat(k,819) = mat(k,819) + rxt(k,197)*y(k,56) + mat(k,2118) = rxt(k,179)*y(k,56) + mat(k,1701) = mat(k,1701) + rxt(k,194)*y(k,59) + mat(k,181) = -(rxt(k,266)*y(k,219) + rxt(k,274)*y(k,218)) + mat(k,1564) = -rxt(k,266)*y(k,86) + mat(k,1510) = -rxt(k,274)*y(k,86) + mat(k,931) = -(rxt(k,267)*y(k,219)) + mat(k,1659) = -rxt(k,267)*y(k,87) + mat(k,998) = .050_r8*rxt(k,440)*y(k,135) + mat(k,294) = .350_r8*rxt(k,277)*y(k,219) + mat(k,552) = .370_r8*rxt(k,279)*y(k,135) + mat(k,1025) = .120_r8*rxt(k,308)*y(k,135) + mat(k,837) = .110_r8*rxt(k,385)*y(k,135) + mat(k,1209) = .330_r8*rxt(k,338)*y(k,135) + mat(k,949) = .050_r8*rxt(k,443)*y(k,135) + mat(k,1327) = .120_r8*rxt(k,352)*y(k,135) + mat(k,1891) = rxt(k,270)*y(k,206) + mat(k,2219) = .050_r8*rxt(k,440)*y(k,6) + .370_r8*rxt(k,279)*y(k,25) & + + .120_r8*rxt(k,308)*y(k,29) + .110_r8*rxt(k,385)*y(k,98) & + + .330_r8*rxt(k,338)*y(k,105) + .050_r8*rxt(k,443)*y(k,110) & + + .120_r8*rxt(k,352)*y(k,111) + mat(k,2082) = rxt(k,268)*y(k,206) + mat(k,444) = rxt(k,270)*y(k,124) + rxt(k,268)*y(k,205) + mat(k,1659) = mat(k,1659) + .350_r8*rxt(k,277)*y(k,24) + mat(k,1427) = rxt(k,232)*y(k,73) + mat(k,865) = rxt(k,232)*y(k,54) + rxt(k,233)*y(k,77) + rxt(k,235)*y(k,89) & + + rxt(k,234)*y(k,231) + mat(k,1401) = rxt(k,233)*y(k,73) + mat(k,1460) = rxt(k,235)*y(k,73) + mat(k,2264) = rxt(k,234)*y(k,73) + mat(k,1465) = -(rxt(k,172)*y(k,219) + rxt(k,235)*y(k,73)) + mat(k,1690) = -rxt(k,172)*y(k,89) + mat(k,870) = -rxt(k,235)*y(k,89) + mat(k,1486) = rxt(k,256)*y(k,126) + mat(k,1090) = rxt(k,288)*y(k,126) + mat(k,1225) = rxt(k,314)*y(k,126) + mat(k,902) = (rxt(k,528)+rxt(k,533)+rxt(k,538))*y(k,85) + mat(k,286) = rxt(k,462)*y(k,126) + mat(k,2130) = (rxt(k,528)+rxt(k,533)+rxt(k,538))*y(k,60) + mat(k,1961) = rxt(k,171)*y(k,219) + mat(k,1773) = rxt(k,256)*y(k,42) + rxt(k,288)*y(k,45) + rxt(k,314)*y(k,49) & + + rxt(k,462)*y(k,67) + mat(k,1690) = mat(k,1690) + rxt(k,171)*y(k,125) + mat(k,423) = -(rxt(k,150)*y(k,219)) + mat(k,1602) = -rxt(k,150)*y(k,90) + mat(k,1936) = rxt(k,169)*y(k,205) + mat(k,2042) = rxt(k,169)*y(k,125) + mat(k,780) = -(rxt(k,226)*y(k,134) + (rxt(k,530) + rxt(k,535)) * y(k,85)) + mat(k,2174) = -rxt(k,226)*y(k,91) + mat(k,2125) = -(rxt(k,530) + rxt(k,535)) * y(k,91) + mat(k,2149) = rxt(k,218)*y(k,205) + mat(k,2071) = rxt(k,218)*y(k,19) + mat(k,815) = -(rxt(k,197)*y(k,56) + rxt(k,198)*y(k,134) + rxt(k,199)*y(k,219) & + + (rxt(k,523) + rxt(k,529) + rxt(k,534)) * y(k,85)) + mat(k,1987) = -rxt(k,197)*y(k,92) + mat(k,2176) = -rxt(k,198)*y(k,92) + mat(k,1648) = -rxt(k,199)*y(k,92) + mat(k,2126) = -(rxt(k,523) + rxt(k,529) + rxt(k,534)) * y(k,92) + mat(k,1710) = rxt(k,186)*y(k,205) + mat(k,900) = rxt(k,191)*y(k,219) + mat(k,2075) = rxt(k,186)*y(k,59) + mat(k,1648) = mat(k,1648) + rxt(k,191)*y(k,60) + mat(k,1155) = -(rxt(k,331)*y(k,219)) + mat(k,1674) = -rxt(k,331)*y(k,93) + mat(k,586) = .300_r8*rxt(k,376)*y(k,219) + mat(k,538) = .500_r8*rxt(k,377)*y(k,219) + mat(k,1903) = rxt(k,330)*y(k,202) + rxt(k,337)*y(k,211) + mat(k,569) = rxt(k,330)*y(k,124) + mat(k,1311) = rxt(k,337)*y(k,124) + mat(k,1674) = mat(k,1674) + .300_r8*rxt(k,376)*y(k,99) + .500_r8*rxt(k,377) & + *y(k,100) + mat(k,223) = -(rxt(k,362)*y(k,219)) + mat(k,1571) = -rxt(k,362)*y(k,94) + mat(k,1142) = -(rxt(k,316)*y(k,219)) + mat(k,1673) = -rxt(k,316)*y(k,95) + mat(k,585) = .700_r8*rxt(k,376)*y(k,219) + mat(k,537) = .500_r8*rxt(k,377)*y(k,219) + mat(k,576) = .500_r8*rxt(k,351)*y(k,219) + mat(k,1902) = .050_r8*rxt(k,374)*y(k,208) + .220_r8*rxt(k,336)*y(k,211) & + + .250_r8*rxt(k,393)*y(k,227) + mat(k,1757) = .050_r8*rxt(k,375)*y(k,208) + .220_r8*rxt(k,335)*y(k,211) & + + .250_r8*rxt(k,394)*y(k,227) + mat(k,545) = .500_r8*rxt(k,320)*y(k,219) + mat(k,1378) = .220_r8*rxt(k,332)*y(k,211) + .250_r8*rxt(k,390)*y(k,227) + mat(k,1812) = .230_r8*rxt(k,333)*y(k,211) + .200_r8*rxt(k,321)*y(k,222) & + + .100_r8*rxt(k,391)*y(k,227) + mat(k,1285) = .050_r8*rxt(k,374)*y(k,124) + .050_r8*rxt(k,375)*y(k,126) + mat(k,1310) = .220_r8*rxt(k,336)*y(k,124) + .220_r8*rxt(k,335)*y(k,126) & + + .220_r8*rxt(k,332)*y(k,199) + .230_r8*rxt(k,333)*y(k,200) + mat(k,1673) = mat(k,1673) + .700_r8*rxt(k,376)*y(k,99) + .500_r8*rxt(k,377) & + *y(k,100) + .500_r8*rxt(k,351)*y(k,109) + .500_r8*rxt(k,320) & + *y(k,147) + mat(k,1132) = .200_r8*rxt(k,321)*y(k,200) + mat(k,1174) = .250_r8*rxt(k,393)*y(k,124) + .250_r8*rxt(k,394)*y(k,126) & + + .250_r8*rxt(k,390)*y(k,199) + .100_r8*rxt(k,391)*y(k,200) + mat(k,348) = -(rxt(k,363)*y(k,219)) + mat(k,1591) = -rxt(k,363)*y(k,96) + mat(k,1858) = .870_r8*rxt(k,374)*y(k,208) + mat(k,1736) = .950_r8*rxt(k,375)*y(k,208) + mat(k,1369) = rxt(k,370)*y(k,208) + mat(k,1790) = .750_r8*rxt(k,371)*y(k,208) + mat(k,1275) = .870_r8*rxt(k,374)*y(k,124) + .950_r8*rxt(k,375)*y(k,126) & + + rxt(k,370)*y(k,199) + .750_r8*rxt(k,371)*y(k,200) + mat(k,137) = -(rxt(k,364)*y(k,219)) + mat(k,1560) = -rxt(k,364)*y(k,97) + mat(k,736) = .600_r8*rxt(k,387)*y(k,219) + mat(k,1560) = mat(k,1560) + .600_r8*rxt(k,387)*y(k,103) + mat(k,836) = -(rxt(k,378)*y(k,126) + rxt(k,385)*y(k,135) + rxt(k,386) & + *y(k,219)) + mat(k,1739) = -rxt(k,378)*y(k,98) + mat(k,2215) = -rxt(k,385)*y(k,98) + mat(k,1650) = -rxt(k,386)*y(k,98) + mat(k,583) = -(rxt(k,376)*y(k,219)) + mat(k,1623) = -rxt(k,376)*y(k,99) + mat(k,1871) = .080_r8*rxt(k,368)*y(k,207) + mat(k,1247) = .080_r8*rxt(k,368)*y(k,124) + mat(k,534) = -(rxt(k,377)*y(k,219)) + mat(k,1618) = -rxt(k,377)*y(k,100) + mat(k,1869) = .080_r8*rxt(k,374)*y(k,208) + mat(k,1276) = .080_r8*rxt(k,374)*y(k,124) + mat(k,1195) = -(rxt(k,379)*y(k,199) + rxt(k,380)*y(k,200) + rxt(k,381) & + *y(k,205) + rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126)) + mat(k,1380) = -rxt(k,379)*y(k,101) + mat(k,1814) = -rxt(k,380)*y(k,101) + mat(k,2094) = -rxt(k,381)*y(k,101) + mat(k,1905) = -rxt(k,382)*y(k,101) + mat(k,1760) = -rxt(k,383)*y(k,101) + mat(k,840) = rxt(k,378)*y(k,126) + mat(k,1760) = mat(k,1760) + rxt(k,378)*y(k,98) + mat(k,405) = -(rxt(k,384)*y(k,219)) + mat(k,1599) = -rxt(k,384)*y(k,102) + mat(k,1187) = rxt(k,381)*y(k,205) + mat(k,2039) = rxt(k,381)*y(k,101) + mat(k,737) = -(rxt(k,387)*y(k,219)) + mat(k,1640) = -rxt(k,387)*y(k,103) + mat(k,2067) = rxt(k,367)*y(k,207) + rxt(k,372)*y(k,208) + mat(k,1248) = rxt(k,367)*y(k,205) + mat(k,1278) = rxt(k,372)*y(k,205) + mat(k,76) = -(rxt(k,509)*y(k,219)) + mat(k,1552) = -rxt(k,509)*y(k,104) + mat(k,1211) = -(rxt(k,338)*y(k,135) + rxt(k,339)*y(k,219)) + mat(k,2234) = -rxt(k,338)*y(k,105) + mat(k,1677) = -rxt(k,339)*y(k,105) + mat(k,841) = .300_r8*rxt(k,385)*y(k,135) + mat(k,1906) = .360_r8*rxt(k,368)*y(k,207) + mat(k,1761) = .400_r8*rxt(k,369)*y(k,207) + mat(k,2234) = mat(k,2234) + .300_r8*rxt(k,385)*y(k,98) + mat(k,1381) = .390_r8*rxt(k,365)*y(k,207) + mat(k,1815) = .310_r8*rxt(k,366)*y(k,207) + mat(k,1256) = .360_r8*rxt(k,368)*y(k,124) + .400_r8*rxt(k,369)*y(k,126) & + + .390_r8*rxt(k,365)*y(k,199) + .310_r8*rxt(k,366)*y(k,200) + 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,312) = -(rxt(k,340)*y(k,219)) + mat(k,1586) = -rxt(k,340)*y(k,106) + mat(k,2032) = rxt(k,334)*y(k,211) + mat(k,1306) = rxt(k,334)*y(k,205) + mat(k,508) = -(rxt(k,349)*y(k,219)) + mat(k,1614) = -rxt(k,349)*y(k,107) + mat(k,1867) = .800_r8*rxt(k,358)*y(k,191) + mat(k,884) = .800_r8*rxt(k,358)*y(k,124) + mat(k,317) = -(rxt(k,350)*y(k,219)) + mat(k,1587) = -rxt(k,350)*y(k,108) + mat(k,2033) = .800_r8*rxt(k,347)*y(k,215) + mat(k,678) = .800_r8*rxt(k,347)*y(k,205) + mat(k,574) = -(rxt(k,351)*y(k,219)) + mat(k,1622) = -rxt(k,351)*y(k,109) + mat(k,1942) = rxt(k,354)*y(k,213) + mat(k,1349) = rxt(k,354)*y(k,125) + mat(k,950) = -(rxt(k,442)*y(k,126) + rxt(k,443)*y(k,135) + rxt(k,444) & + *y(k,219)) + mat(k,1744) = -rxt(k,442)*y(k,110) + mat(k,2220) = -rxt(k,443)*y(k,110) + mat(k,1660) = -rxt(k,444)*y(k,110) + mat(k,1334) = -(rxt(k,352)*y(k,135) + rxt(k,353)*y(k,219)) + mat(k,2240) = -rxt(k,352)*y(k,111) + mat(k,1683) = -rxt(k,353)*y(k,111) + mat(k,844) = .200_r8*rxt(k,385)*y(k,135) + mat(k,1911) = .560_r8*rxt(k,368)*y(k,207) + mat(k,1767) = .600_r8*rxt(k,369)*y(k,207) + mat(k,2240) = mat(k,2240) + .200_r8*rxt(k,385)*y(k,98) + mat(k,1386) = .610_r8*rxt(k,365)*y(k,207) + mat(k,1820) = .440_r8*rxt(k,366)*y(k,207) + mat(k,1260) = .560_r8*rxt(k,368)*y(k,124) + .600_r8*rxt(k,369)*y(k,126) & + + .610_r8*rxt(k,365)*y(k,199) + .440_r8*rxt(k,366)*y(k,200) + mat(k,493) = -(rxt(k,151)*y(k,124) + (rxt(k,152) + rxt(k,153) + rxt(k,154) & + ) * y(k,125) + rxt(k,163)*y(k,219)) + mat(k,1865) = -rxt(k,151)*y(k,112) + mat(k,1938) = -(rxt(k,152) + rxt(k,153) + rxt(k,154)) * y(k,112) + mat(k,1612) = -rxt(k,163)*y(k,112) + mat(k,185) = -((rxt(k,167) + rxt(k,168)) * y(k,218)) + mat(k,1511) = -(rxt(k,167) + rxt(k,168)) * y(k,113) + mat(k,492) = rxt(k,152)*y(k,125) + mat(k,1934) = rxt(k,152)*y(k,112) + mat(k,1935) = rxt(k,170)*y(k,126) + mat(k,1734) = rxt(k,170)*y(k,125) + mat(k,375) = -(rxt(k,388)*y(k,219)) + mat(k,1595) = -rxt(k,388)*y(k,115) + mat(k,1186) = .200_r8*rxt(k,380)*y(k,200) + mat(k,1791) = .200_r8*rxt(k,380)*y(k,101) + mat(k,1075) = -(rxt(k,389)*y(k,219)) + mat(k,1667) = -rxt(k,389)*y(k,116) + mat(k,1191) = rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126) + rxt(k,379)*y(k,199) & + + .800_r8*rxt(k,380)*y(k,200) + mat(k,1896) = rxt(k,382)*y(k,101) + mat(k,1751) = rxt(k,383)*y(k,101) + mat(k,1375) = rxt(k,379)*y(k,101) + mat(k,1806) = .800_r8*rxt(k,380)*y(k,101) + mat(k,98) = -(rxt(k,479)*y(k,219)) + mat(k,1556) = -rxt(k,479)*y(k,120) + mat(k,1924) = -(rxt(k,151)*y(k,112) + rxt(k,160)*y(k,126) + rxt(k,164) & + *y(k,205) + rxt(k,165)*y(k,135) + rxt(k,166)*y(k,134) + rxt(k,187) & + *y(k,59) + rxt(k,219)*y(k,19) + rxt(k,262)*y(k,200) + rxt(k,270) & + *y(k,206) + rxt(k,283)*y(k,196) + rxt(k,294)*y(k,199) + rxt(k,298) & + *y(k,204) + rxt(k,311)*y(k,197) + rxt(k,319)*y(k,221) + rxt(k,323) & + *y(k,222) + (rxt(k,329) + rxt(k,330)) * y(k,202) + (rxt(k,336) & + + rxt(k,337)) * y(k,211) + rxt(k,345)*y(k,213) + rxt(k,348) & + *y(k,215) + (rxt(k,358) + rxt(k,359)) * y(k,191) + rxt(k,368) & + *y(k,207) + rxt(k,374)*y(k,208) + rxt(k,382)*y(k,101) + rxt(k,393) & + *y(k,227) + rxt(k,397)*y(k,190) + rxt(k,400)*y(k,193) + rxt(k,405) & + *y(k,195) + rxt(k,407)*y(k,198) + rxt(k,411)*y(k,201) + rxt(k,414) & + *y(k,212) + rxt(k,417)*y(k,214) + rxt(k,420)*y(k,220) + rxt(k,427) & + *y(k,225) + rxt(k,433)*y(k,228) + rxt(k,436)*y(k,230) + rxt(k,447) & + *y(k,217) + rxt(k,452)*y(k,223) + rxt(k,457)*y(k,224)) + mat(k,497) = -rxt(k,151)*y(k,124) + mat(k,1780) = -rxt(k,160)*y(k,124) + mat(k,2114) = -rxt(k,164)*y(k,124) + mat(k,2253) = -rxt(k,165)*y(k,124) + mat(k,2192) = -rxt(k,166)*y(k,124) + mat(k,1723) = -rxt(k,187)*y(k,124) + mat(k,2161) = -rxt(k,219)*y(k,124) + mat(k,1832) = -rxt(k,262)*y(k,124) + mat(k,446) = -rxt(k,270)*y(k,124) + mat(k,830) = -rxt(k,283)*y(k,124) + mat(k,1395) = -rxt(k,294)*y(k,124) + mat(k,712) = -rxt(k,298)*y(k,124) + mat(k,795) = -rxt(k,311)*y(k,124) + mat(k,775) = -rxt(k,319)*y(k,124) + mat(k,1138) = -rxt(k,323)*y(k,124) + mat(k,571) = -(rxt(k,329) + rxt(k,330)) * y(k,124) + mat(k,1321) = -(rxt(k,336) + rxt(k,337)) * y(k,124) + mat(k,1363) = -rxt(k,345)*y(k,124) + mat(k,683) = -rxt(k,348)*y(k,124) + mat(k,896) = -(rxt(k,358) + rxt(k,359)) * y(k,124) + mat(k,1268) = -rxt(k,368)*y(k,124) + mat(k,1300) = -rxt(k,374)*y(k,124) + mat(k,1205) = -rxt(k,382)*y(k,124) + mat(k,1182) = -rxt(k,393)*y(k,124) + mat(k,523) = -rxt(k,397)*y(k,124) + mat(k,489) = -rxt(k,400)*y(k,124) + mat(k,440) = -rxt(k,405)*y(k,124) + mat(k,629) = -rxt(k,407)*y(k,124) + mat(k,766) = -rxt(k,411)*y(k,124) + mat(k,718) = -rxt(k,414)*y(k,124) + mat(k,881) = -rxt(k,417)*y(k,124) + mat(k,453) = -rxt(k,420)*y(k,124) + mat(k,733) = -rxt(k,427)*y(k,124) + mat(k,758) = -rxt(k,433)*y(k,124) + mat(k,505) = -rxt(k,436)*y(k,124) + mat(k,1056) = -rxt(k,447)*y(k,124) + mat(k,1119) = -rxt(k,452)*y(k,124) + mat(k,921) = -rxt(k,457)*y(k,124) + mat(k,497) = mat(k,497) + 2.000_r8*rxt(k,153)*y(k,125) + rxt(k,163)*y(k,219) + mat(k,187) = 2.000_r8*rxt(k,167)*y(k,218) + mat(k,1968) = 2.000_r8*rxt(k,153)*y(k,112) + rxt(k,156)*y(k,134) + rxt(k,472) & + *y(k,151) + mat(k,2192) = mat(k,2192) + rxt(k,156)*y(k,125) + mat(k,1239) = rxt(k,472)*y(k,125) + mat(k,1533) = 2.000_r8*rxt(k,167)*y(k,113) + mat(k,1697) = rxt(k,163)*y(k,112) + mat(k,1969) = -((rxt(k,152) + rxt(k,153) + rxt(k,154)) * y(k,112) + (rxt(k,156) & + + rxt(k,158)) * y(k,134) + rxt(k,157)*y(k,135) + rxt(k,169) & + *y(k,205) + rxt(k,170)*y(k,126) + rxt(k,171)*y(k,219) + rxt(k,189) & + *y(k,59) + rxt(k,220)*y(k,19) + rxt(k,305)*y(k,199) + rxt(k,354) & + *y(k,213) + rxt(k,412)*y(k,201) + rxt(k,415)*y(k,212) + rxt(k,418) & + *y(k,214) + rxt(k,422)*y(k,142) + rxt(k,425)*y(k,190) + rxt(k,472) & + *y(k,151)) + mat(k,498) = -(rxt(k,152) + rxt(k,153) + rxt(k,154)) * y(k,125) + mat(k,2193) = -(rxt(k,156) + rxt(k,158)) * y(k,125) + mat(k,2254) = -rxt(k,157)*y(k,125) + mat(k,2115) = -rxt(k,169)*y(k,125) + mat(k,1781) = -rxt(k,170)*y(k,125) + mat(k,1698) = -rxt(k,171)*y(k,125) + mat(k,1724) = -rxt(k,189)*y(k,125) + mat(k,2162) = -rxt(k,220)*y(k,125) + mat(k,1396) = -rxt(k,305)*y(k,125) + mat(k,1364) = -rxt(k,354)*y(k,125) + mat(k,767) = -rxt(k,412)*y(k,125) + mat(k,719) = -rxt(k,415)*y(k,125) + mat(k,882) = -rxt(k,418)*y(k,125) + mat(k,467) = -rxt(k,422)*y(k,125) + mat(k,524) = -rxt(k,425)*y(k,125) + mat(k,1240) = -rxt(k,472)*y(k,125) + mat(k,642) = rxt(k,356)*y(k,219) + mat(k,358) = rxt(k,327)*y(k,126) + mat(k,2162) = mat(k,2162) + rxt(k,219)*y(k,124) + mat(k,1724) = mat(k,1724) + rxt(k,187)*y(k,124) + mat(k,426) = rxt(k,150)*y(k,219) + mat(k,590) = .700_r8*rxt(k,376)*y(k,219) + mat(k,1206) = rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126) + mat(k,1925) = rxt(k,219)*y(k,19) + rxt(k,187)*y(k,59) + rxt(k,382)*y(k,101) & + + 2.000_r8*rxt(k,160)*y(k,126) + rxt(k,166)*y(k,134) & + + rxt(k,165)*y(k,135) + rxt(k,397)*y(k,190) + rxt(k,358) & + *y(k,191) + rxt(k,400)*y(k,193) + rxt(k,405)*y(k,195) & + + rxt(k,283)*y(k,196) + rxt(k,311)*y(k,197) + rxt(k,407) & + *y(k,198) + rxt(k,294)*y(k,199) + rxt(k,262)*y(k,200) & + + rxt(k,411)*y(k,201) + rxt(k,329)*y(k,202) + rxt(k,298) & + *y(k,204) + rxt(k,164)*y(k,205) + rxt(k,270)*y(k,206) & + + .920_r8*rxt(k,368)*y(k,207) + .920_r8*rxt(k,374)*y(k,208) & + + rxt(k,336)*y(k,211) + rxt(k,414)*y(k,212) + rxt(k,345) & + *y(k,213) + rxt(k,417)*y(k,214) + rxt(k,348)*y(k,215) & + + 1.600_r8*rxt(k,447)*y(k,217) + rxt(k,420)*y(k,220) & + + rxt(k,319)*y(k,221) + rxt(k,323)*y(k,222) + .900_r8*rxt(k,452) & + *y(k,223) + .800_r8*rxt(k,457)*y(k,224) + rxt(k,427)*y(k,225) & + + rxt(k,393)*y(k,227) + rxt(k,433)*y(k,228) + rxt(k,436) & + *y(k,230) + mat(k,1781) = mat(k,1781) + rxt(k,327)*y(k,16) + rxt(k,383)*y(k,101) & + + 2.000_r8*rxt(k,160)*y(k,124) + rxt(k,161)*y(k,134) & + + rxt(k,159)*y(k,205) + rxt(k,369)*y(k,207) + rxt(k,375) & + *y(k,208) + rxt(k,335)*y(k,211) + rxt(k,346)*y(k,213) & + + 2.000_r8*rxt(k,448)*y(k,217) + rxt(k,162)*y(k,219) & + + rxt(k,394)*y(k,227) + mat(k,864) = rxt(k,317)*y(k,219) + mat(k,2193) = mat(k,2193) + rxt(k,166)*y(k,124) + rxt(k,161)*y(k,126) + mat(k,2254) = mat(k,2254) + rxt(k,165)*y(k,124) + mat(k,623) = rxt(k,454)*y(k,219) + mat(k,524) = mat(k,524) + rxt(k,397)*y(k,124) + mat(k,897) = rxt(k,358)*y(k,124) + mat(k,490) = rxt(k,400)*y(k,124) + mat(k,441) = rxt(k,405)*y(k,124) + mat(k,831) = rxt(k,283)*y(k,124) + mat(k,796) = rxt(k,311)*y(k,124) + mat(k,630) = rxt(k,407)*y(k,124) + mat(k,1396) = mat(k,1396) + rxt(k,294)*y(k,124) + mat(k,1833) = rxt(k,262)*y(k,124) + .500_r8*rxt(k,445)*y(k,217) + mat(k,767) = mat(k,767) + rxt(k,411)*y(k,124) + mat(k,572) = rxt(k,329)*y(k,124) + mat(k,713) = rxt(k,298)*y(k,124) + mat(k,2115) = mat(k,2115) + rxt(k,164)*y(k,124) + rxt(k,159)*y(k,126) + mat(k,447) = rxt(k,270)*y(k,124) + mat(k,1269) = .920_r8*rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126) + mat(k,1301) = .920_r8*rxt(k,374)*y(k,124) + rxt(k,375)*y(k,126) + mat(k,1322) = rxt(k,336)*y(k,124) + rxt(k,335)*y(k,126) + mat(k,719) = mat(k,719) + rxt(k,414)*y(k,124) + mat(k,1364) = mat(k,1364) + rxt(k,345)*y(k,124) + rxt(k,346)*y(k,126) + mat(k,882) = mat(k,882) + rxt(k,417)*y(k,124) + mat(k,684) = rxt(k,348)*y(k,124) + mat(k,1057) = 1.600_r8*rxt(k,447)*y(k,124) + 2.000_r8*rxt(k,448)*y(k,126) & + + .500_r8*rxt(k,445)*y(k,200) + mat(k,1698) = mat(k,1698) + rxt(k,356)*y(k,1) + rxt(k,150)*y(k,90) & + + .700_r8*rxt(k,376)*y(k,99) + rxt(k,162)*y(k,126) + rxt(k,317) & + *y(k,127) + rxt(k,454)*y(k,177) + mat(k,454) = rxt(k,420)*y(k,124) + mat(k,776) = rxt(k,319)*y(k,124) + mat(k,1139) = rxt(k,323)*y(k,124) + mat(k,1120) = .900_r8*rxt(k,452)*y(k,124) + mat(k,922) = .800_r8*rxt(k,457)*y(k,124) + mat(k,734) = rxt(k,427)*y(k,124) + mat(k,1183) = rxt(k,393)*y(k,124) + rxt(k,394)*y(k,126) + mat(k,759) = rxt(k,433)*y(k,124) + mat(k,506) = rxt(k,436)*y(k,124) + 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,1778) = -(rxt(k,159)*y(k,205) + rxt(k,160)*y(k,124) + rxt(k,161) & + *y(k,134) + rxt(k,162)*y(k,219) + rxt(k,170)*y(k,125) + rxt(k,256) & + *y(k,42) + rxt(k,288)*y(k,45) + rxt(k,307)*y(k,29) + rxt(k,314) & + *y(k,49) + rxt(k,327)*y(k,16) + rxt(k,335)*y(k,211) + rxt(k,346) & + *y(k,213) + rxt(k,369)*y(k,207) + rxt(k,375)*y(k,208) + rxt(k,378) & + *y(k,98) + rxt(k,383)*y(k,101) + rxt(k,394)*y(k,227) + rxt(k,439) & + *y(k,6) + rxt(k,442)*y(k,110) + rxt(k,448)*y(k,217) + rxt(k,459) & + *y(k,179) + rxt(k,462)*y(k,67)) + mat(k,2112) = -rxt(k,159)*y(k,126) + mat(k,1922) = -rxt(k,160)*y(k,126) + mat(k,2190) = -rxt(k,161)*y(k,126) + mat(k,1695) = -rxt(k,162)*y(k,126) + mat(k,1966) = -rxt(k,170)*y(k,126) + mat(k,1490) = -rxt(k,256)*y(k,126) + mat(k,1092) = -rxt(k,288)*y(k,126) + mat(k,1035) = -rxt(k,307)*y(k,126) + mat(k,1227) = -rxt(k,314)*y(k,126) + mat(k,357) = -rxt(k,327)*y(k,126) + mat(k,1319) = -rxt(k,335)*y(k,126) + mat(k,1361) = -rxt(k,346)*y(k,126) + mat(k,1266) = -rxt(k,369)*y(k,126) + mat(k,1298) = -rxt(k,375)*y(k,126) + mat(k,848) = -rxt(k,378)*y(k,126) + mat(k,1203) = -rxt(k,383)*y(k,126) + mat(k,1180) = -rxt(k,394)*y(k,126) + mat(k,1013) = -rxt(k,439)*y(k,126) + mat(k,963) = -rxt(k,442)*y(k,126) + mat(k,1054) = -rxt(k,448)*y(k,126) + mat(k,977) = -rxt(k,459)*y(k,126) + mat(k,288) = -rxt(k,462)*y(k,126) + mat(k,562) = rxt(k,221)*y(k,134) + mat(k,2005) = rxt(k,188)*y(k,60) + mat(k,905) = rxt(k,188)*y(k,56) + rxt(k,190)*y(k,134) + rxt(k,191)*y(k,219) + mat(k,872) = rxt(k,235)*y(k,89) + mat(k,1469) = rxt(k,235)*y(k,73) + rxt(k,172)*y(k,219) + mat(k,580) = .500_r8*rxt(k,351)*y(k,219) + mat(k,1966) = mat(k,1966) + rxt(k,158)*y(k,134) + rxt(k,157)*y(k,135) + mat(k,2190) = mat(k,2190) + rxt(k,221)*y(k,20) + rxt(k,190)*y(k,60) & + + rxt(k,158)*y(k,125) + mat(k,2251) = rxt(k,157)*y(k,125) + mat(k,531) = rxt(k,303)*y(k,219) + mat(k,1695) = mat(k,1695) + rxt(k,191)*y(k,60) + rxt(k,172)*y(k,89) & + + .500_r8*rxt(k,351)*y(k,109) + rxt(k,303)*y(k,140) + mat(k,859) = -(rxt(k,317)*y(k,219)) + mat(k,1652) = -rxt(k,317)*y(k,127) + mat(k,1024) = rxt(k,307)*y(k,126) + mat(k,535) = .500_r8*rxt(k,377)*y(k,219) + mat(k,407) = rxt(k,384)*y(k,219) + mat(k,376) = rxt(k,388)*y(k,219) + mat(k,1072) = rxt(k,389)*y(k,219) + mat(k,1741) = rxt(k,307)*y(k,29) + mat(k,1652) = mat(k,1652) + .500_r8*rxt(k,377)*y(k,100) + rxt(k,384)*y(k,102) & + + rxt(k,388)*y(k,115) + rxt(k,389)*y(k,116) + mat(k,393) = -(rxt(k,449)*y(k,219)) + mat(k,1597) = -rxt(k,449)*y(k,128) + mat(k,2037) = rxt(k,446)*y(k,217) + mat(k,1043) = rxt(k,446)*y(k,205) + mat(k,2198) = -(rxt(k,130)*y(k,135) + 4._r8*rxt(k,131)*y(k,134) + rxt(k,133) & + *y(k,77) + rxt(k,134)*y(k,79) + rxt(k,139)*y(k,205) + rxt(k,145) & + *y(k,219) + (rxt(k,156) + rxt(k,158)) * y(k,125) + rxt(k,161) & + *y(k,126) + rxt(k,166)*y(k,124) + rxt(k,190)*y(k,60) + rxt(k,192) & + *y(k,59) + rxt(k,195)*y(k,85) + rxt(k,198)*y(k,92) + rxt(k,221) & + *y(k,20) + rxt(k,222)*y(k,19) + rxt(k,224)*y(k,81) + rxt(k,226) & + *y(k,91) + rxt(k,257)*y(k,42) + rxt(k,464)*y(k,138)) + mat(k,2259) = -rxt(k,130)*y(k,134) + mat(k,1413) = -rxt(k,133)*y(k,134) + mat(k,610) = -rxt(k,134)*y(k,134) + mat(k,2120) = -rxt(k,139)*y(k,134) + mat(k,1703) = -rxt(k,145)*y(k,134) + mat(k,1974) = -(rxt(k,156) + rxt(k,158)) * y(k,134) + mat(k,1786) = -rxt(k,161)*y(k,134) + mat(k,1930) = -rxt(k,166)*y(k,134) + mat(k,909) = -rxt(k,190)*y(k,134) + mat(k,1729) = -rxt(k,192)*y(k,134) + mat(k,2143) = -rxt(k,195)*y(k,134) + mat(k,820) = -rxt(k,198)*y(k,134) + mat(k,565) = -rxt(k,221)*y(k,134) + mat(k,2167) = -rxt(k,222)*y(k,134) + mat(k,812) = -rxt(k,224)*y(k,134) + mat(k,786) = -rxt(k,226)*y(k,134) + mat(k,1498) = -rxt(k,257)*y(k,134) + mat(k,366) = -rxt(k,464)*y(k,134) + mat(k,1457) = rxt(k,137)*y(k,205) + mat(k,499) = rxt(k,151)*y(k,124) + rxt(k,152)*y(k,125) + mat(k,1930) = mat(k,1930) + rxt(k,151)*y(k,112) + mat(k,1974) = mat(k,1974) + rxt(k,152)*y(k,112) + mat(k,2120) = mat(k,2120) + rxt(k,137)*y(k,76) + mat(k,1703) = mat(k,1703) + 2.000_r8*rxt(k,147)*y(k,219) + mat(k,2260) = -(rxt(k,129)*y(k,218) + rxt(k,130)*y(k,134) + rxt(k,140) & + *y(k,205) + rxt(k,141)*y(k,76) + rxt(k,146)*y(k,219) + rxt(k,157) & + *y(k,125) + rxt(k,165)*y(k,124) + rxt(k,181)*y(k,56) + rxt(k,213) & + *y(k,17) + rxt(k,279)*y(k,25) + rxt(k,308)*y(k,29) + rxt(k,338) & + *y(k,105) + rxt(k,352)*y(k,111) + rxt(k,385)*y(k,98) + rxt(k,423) & + *y(k,142) + rxt(k,440)*y(k,6) + rxt(k,443)*y(k,110) + rxt(k,468) & + *y(k,149) + rxt(k,474)*y(k,151)) + mat(k,1540) = -rxt(k,129)*y(k,135) + mat(k,2199) = -rxt(k,130)*y(k,135) + mat(k,2121) = -rxt(k,140)*y(k,135) + mat(k,1458) = -rxt(k,141)*y(k,135) + mat(k,1704) = -rxt(k,146)*y(k,135) + mat(k,1975) = -rxt(k,157)*y(k,135) + mat(k,1931) = -rxt(k,165)*y(k,135) + mat(k,2014) = -rxt(k,181)*y(k,135) + mat(k,1425) = -rxt(k,213)*y(k,135) + mat(k,557) = -rxt(k,279)*y(k,135) + mat(k,1041) = -rxt(k,308)*y(k,135) + mat(k,1220) = -rxt(k,338)*y(k,135) + mat(k,1347) = -rxt(k,352)*y(k,135) + mat(k,851) = -rxt(k,385)*y(k,135) + mat(k,468) = -rxt(k,423)*y(k,135) + mat(k,1019) = -rxt(k,440)*y(k,135) + mat(k,969) = -rxt(k,443)*y(k,135) + mat(k,518) = -rxt(k,468)*y(k,135) + mat(k,1245) = -rxt(k,474)*y(k,135) + mat(k,1399) = .150_r8*rxt(k,293)*y(k,205) + mat(k,2121) = mat(k,2121) + .150_r8*rxt(k,293)*y(k,199) + .150_r8*rxt(k,343) & + *y(k,213) + mat(k,1367) = .150_r8*rxt(k,343)*y(k,205) + mat(k,327) = -(rxt(k,475)*y(k,151)) + mat(k,1231) = -rxt(k,475)*y(k,137) + mat(k,2147) = rxt(k,215)*y(k,59) + mat(k,1709) = rxt(k,215)*y(k,19) + 2.000_r8*rxt(k,185)*y(k,59) + mat(k,359) = -(rxt(k,464)*y(k,134) + rxt(k,465)*y(k,219)) + mat(k,2170) = -rxt(k,464)*y(k,138) + mat(k,1593) = -rxt(k,465)*y(k,138) + mat(k,1148) = rxt(k,331)*y(k,219) + mat(k,1853) = .100_r8*rxt(k,452)*y(k,223) + mat(k,1573) = rxt(k,331)*y(k,93) + mat(k,1104) = .100_r8*rxt(k,452)*y(k,124) + mat(k,526) = -(rxt(k,303)*y(k,219)) + mat(k,1617) = -rxt(k,303)*y(k,140) + mat(k,1940) = rxt(k,305)*y(k,199) + mat(k,1370) = rxt(k,305)*y(k,125) + mat(k,1933) = rxt(k,425)*y(k,190) + mat(k,519) = rxt(k,425)*y(k,125) + mat(k,465) = -(rxt(k,422)*y(k,125) + rxt(k,423)*y(k,135)) + mat(k,1937) = -rxt(k,422)*y(k,142) + mat(k,2208) = -rxt(k,423)*y(k,142) + mat(k,198) = .070_r8*rxt(k,409)*y(k,219) + mat(k,1863) = rxt(k,407)*y(k,198) + mat(k,176) = .060_r8*rxt(k,421)*y(k,219) + mat(k,219) = .070_r8*rxt(k,437)*y(k,219) + mat(k,626) = rxt(k,407)*y(k,124) + mat(k,1608) = .070_r8*rxt(k,409)*y(k,66) + .060_r8*rxt(k,421)*y(k,143) & + + .070_r8*rxt(k,437)*y(k,186) + mat(k,174) = -(rxt(k,421)*y(k,219)) + mat(k,1563) = -rxt(k,421)*y(k,143) + mat(k,166) = .530_r8*rxt(k,398)*y(k,219) + mat(k,1563) = mat(k,1563) + .530_r8*rxt(k,398)*y(k,7) + mat(k,332) = -(rxt(k,424)*y(k,219)) + mat(k,1588) = -rxt(k,424)*y(k,144) + mat(k,2034) = rxt(k,419)*y(k,220) + mat(k,449) = rxt(k,419)*y(k,205) + mat(k,542) = -(rxt(k,320)*y(k,219)) + mat(k,1619) = -rxt(k,320)*y(k,147) + mat(k,2054) = rxt(k,318)*y(k,221) + mat(k,769) = rxt(k,318)*y(k,205) + mat(k,399) = -(rxt(k,324)*y(k,219)) + mat(k,1598) = -rxt(k,324)*y(k,148) + mat(k,2038) = .850_r8*rxt(k,322)*y(k,222) + mat(k,1129) = .850_r8*rxt(k,322)*y(k,205) + mat(k,513) = -(rxt(k,468)*y(k,135) + rxt(k,471)*y(k,219)) + mat(k,2209) = -rxt(k,468)*y(k,149) + mat(k,1615) = -rxt(k,471)*y(k,149) + mat(k,1234) = -(rxt(k,469)*y(k,19) + rxt(k,470)*y(k,59) + rxt(k,472)*y(k,125) & + + rxt(k,474)*y(k,135) + rxt(k,475)*y(k,137) + rxt(k,476) & + *y(k,219)) + mat(k,2151) = -rxt(k,469)*y(k,151) + mat(k,1713) = -rxt(k,470)*y(k,151) + mat(k,1955) = -rxt(k,472)*y(k,151) + mat(k,2236) = -rxt(k,474)*y(k,151) + mat(k,329) = -rxt(k,475)*y(k,151) + mat(k,1679) = -rxt(k,476)*y(k,151) + mat(k,2180) = rxt(k,464)*y(k,138) + mat(k,2236) = mat(k,2236) + rxt(k,468)*y(k,149) + mat(k,363) = rxt(k,464)*y(k,134) + mat(k,514) = rxt(k,468)*y(k,135) + rxt(k,471)*y(k,219) + mat(k,1679) = mat(k,1679) + rxt(k,471)*y(k,149) + mat(k,853) = -(rxt(k,467)*y(k,219)) + mat(k,1651) = -rxt(k,467)*y(k,152) + mat(k,2150) = rxt(k,469)*y(k,151) + mat(k,1711) = rxt(k,470)*y(k,151) + mat(k,285) = rxt(k,462)*y(k,126) + (rxt(k,463)+.500_r8*rxt(k,477))*y(k,219) + mat(k,1948) = rxt(k,472)*y(k,151) + mat(k,1740) = rxt(k,462)*y(k,67) + mat(k,2216) = rxt(k,474)*y(k,151) + mat(k,328) = rxt(k,475)*y(k,151) + mat(k,361) = rxt(k,465)*y(k,219) + mat(k,1233) = rxt(k,469)*y(k,19) + rxt(k,470)*y(k,59) + rxt(k,472)*y(k,125) & + + rxt(k,474)*y(k,135) + rxt(k,475)*y(k,137) + rxt(k,476) & + *y(k,219) + mat(k,1651) = mat(k,1651) + (rxt(k,463)+.500_r8*rxt(k,477))*y(k,67) & + + rxt(k,465)*y(k,138) + rxt(k,476)*y(k,151) + mat(k,259) = -(rxt(k,478)*y(k,231)) + mat(k,2263) = -rxt(k,478)*y(k,153) + mat(k,852) = rxt(k,467)*y(k,219) + mat(k,1579) = rxt(k,467)*y(k,152) + mat(k,986) = .2202005_r8*rxt(k,497)*y(k,135) + mat(k,937) = .0508005_r8*rxt(k,513)*y(k,135) + mat(k,1841) = .1279005_r8*rxt(k,496)*y(k,192) + .0097005_r8*rxt(k,501) & + *y(k,194) + .0003005_r8*rxt(k,504)*y(k,209) & + + .1056005_r8*rxt(k,508)*y(k,210) + .0245005_r8*rxt(k,512) & + *y(k,216) + .0154005_r8*rxt(k,518)*y(k,226) & + + .0063005_r8*rxt(k,521)*y(k,229) + mat(k,2201) = .2202005_r8*rxt(k,497)*y(k,6) + .0508005_r8*rxt(k,513)*y(k,110) + mat(k,45) = .5931005_r8*rxt(k,515)*y(k,219) + mat(k,51) = .1279005_r8*rxt(k,496)*y(k,124) + .2202005_r8*rxt(k,495)*y(k,205) + mat(k,57) = .0097005_r8*rxt(k,501)*y(k,124) + .0023005_r8*rxt(k,500)*y(k,205) + mat(k,2016) = .2202005_r8*rxt(k,495)*y(k,192) + .0023005_r8*rxt(k,500) & + *y(k,194) + .0031005_r8*rxt(k,503)*y(k,209) & + + .2381005_r8*rxt(k,507)*y(k,210) + .0508005_r8*rxt(k,511) & + *y(k,216) + .1364005_r8*rxt(k,517)*y(k,226) & + + .1677005_r8*rxt(k,520)*y(k,229) + mat(k,63) = .0003005_r8*rxt(k,504)*y(k,124) + .0031005_r8*rxt(k,503)*y(k,205) + mat(k,69) = .1056005_r8*rxt(k,508)*y(k,124) + .2381005_r8*rxt(k,507)*y(k,205) + mat(k,77) = .0245005_r8*rxt(k,512)*y(k,124) + .0508005_r8*rxt(k,511)*y(k,205) + mat(k,1542) = .5931005_r8*rxt(k,515)*y(k,174) + mat(k,83) = .0154005_r8*rxt(k,518)*y(k,124) + .1364005_r8*rxt(k,517)*y(k,205) + mat(k,89) = .0063005_r8*rxt(k,521)*y(k,124) + .1677005_r8*rxt(k,520)*y(k,205) + 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,987) = .2067005_r8*rxt(k,497)*y(k,135) + mat(k,938) = .1149005_r8*rxt(k,513)*y(k,135) + mat(k,1842) = .1792005_r8*rxt(k,496)*y(k,192) + .0034005_r8*rxt(k,501) & + *y(k,194) + .0003005_r8*rxt(k,504)*y(k,209) & + + .1026005_r8*rxt(k,508)*y(k,210) + .0082005_r8*rxt(k,512) & + *y(k,216) + .0452005_r8*rxt(k,518)*y(k,226) & + + .0237005_r8*rxt(k,521)*y(k,229) + mat(k,2202) = .2067005_r8*rxt(k,497)*y(k,6) + .1149005_r8*rxt(k,513)*y(k,110) + mat(k,46) = .1534005_r8*rxt(k,515)*y(k,219) + mat(k,52) = .1792005_r8*rxt(k,496)*y(k,124) + .2067005_r8*rxt(k,495)*y(k,205) + mat(k,58) = .0034005_r8*rxt(k,501)*y(k,124) + .0008005_r8*rxt(k,500)*y(k,205) + mat(k,2017) = .2067005_r8*rxt(k,495)*y(k,192) + .0008005_r8*rxt(k,500) & + *y(k,194) + .0035005_r8*rxt(k,503)*y(k,209) & + + .1308005_r8*rxt(k,507)*y(k,210) + .1149005_r8*rxt(k,511) & + *y(k,216) + .0101005_r8*rxt(k,517)*y(k,226) & + + .0174005_r8*rxt(k,520)*y(k,229) + mat(k,64) = .0003005_r8*rxt(k,504)*y(k,124) + .0035005_r8*rxt(k,503)*y(k,205) + mat(k,70) = .1026005_r8*rxt(k,508)*y(k,124) + .1308005_r8*rxt(k,507)*y(k,205) + mat(k,78) = .0082005_r8*rxt(k,512)*y(k,124) + .1149005_r8*rxt(k,511)*y(k,205) + mat(k,1543) = .1534005_r8*rxt(k,515)*y(k,174) + mat(k,84) = .0452005_r8*rxt(k,518)*y(k,124) + .0101005_r8*rxt(k,517)*y(k,205) + mat(k,90) = .0237005_r8*rxt(k,521)*y(k,124) + .0174005_r8*rxt(k,520)*y(k,205) + mat(k,988) = .0653005_r8*rxt(k,497)*y(k,135) + mat(k,939) = .0348005_r8*rxt(k,513)*y(k,135) + mat(k,1843) = .0676005_r8*rxt(k,496)*y(k,192) + .1579005_r8*rxt(k,501) & + *y(k,194) + .0073005_r8*rxt(k,504)*y(k,209) & + + .0521005_r8*rxt(k,508)*y(k,210) + .0772005_r8*rxt(k,512) & + *y(k,216) + .0966005_r8*rxt(k,518)*y(k,226) & + + .0025005_r8*rxt(k,521)*y(k,229) + mat(k,2203) = .0653005_r8*rxt(k,497)*y(k,6) + .0348005_r8*rxt(k,513)*y(k,110) + mat(k,47) = .0459005_r8*rxt(k,515)*y(k,219) + mat(k,53) = .0676005_r8*rxt(k,496)*y(k,124) + .0653005_r8*rxt(k,495)*y(k,205) + mat(k,59) = .1579005_r8*rxt(k,501)*y(k,124) + .0843005_r8*rxt(k,500)*y(k,205) + mat(k,2018) = .0653005_r8*rxt(k,495)*y(k,192) + .0843005_r8*rxt(k,500) & + *y(k,194) + .0003005_r8*rxt(k,503)*y(k,209) & + + .0348005_r8*rxt(k,507)*y(k,210) + .0348005_r8*rxt(k,511) & + *y(k,216) + .0763005_r8*rxt(k,517)*y(k,226) + .086_r8*rxt(k,520) & + *y(k,229) + mat(k,65) = .0073005_r8*rxt(k,504)*y(k,124) + .0003005_r8*rxt(k,503)*y(k,205) + mat(k,71) = .0521005_r8*rxt(k,508)*y(k,124) + .0348005_r8*rxt(k,507)*y(k,205) + mat(k,79) = .0772005_r8*rxt(k,512)*y(k,124) + .0348005_r8*rxt(k,511)*y(k,205) + mat(k,1544) = .0459005_r8*rxt(k,515)*y(k,174) + mat(k,85) = .0966005_r8*rxt(k,518)*y(k,124) + .0763005_r8*rxt(k,517)*y(k,205) + mat(k,91) = .0025005_r8*rxt(k,521)*y(k,124) + .086_r8*rxt(k,520)*y(k,205) + mat(k,989) = .1749305_r8*rxt(k,494)*y(k,126) + .1284005_r8*rxt(k,497) & + *y(k,135) + mat(k,833) = .0590245_r8*rxt(k,502)*y(k,126) + .0033005_r8*rxt(k,505) & + *y(k,135) + mat(k,940) = .1749305_r8*rxt(k,510)*y(k,126) + .0554005_r8*rxt(k,513) & + *y(k,135) + mat(k,1844) = .079_r8*rxt(k,496)*y(k,192) + .0059005_r8*rxt(k,501)*y(k,194) & + + .0057005_r8*rxt(k,504)*y(k,209) + .0143005_r8*rxt(k,508) & + *y(k,210) + .0332005_r8*rxt(k,512)*y(k,216) & + + .0073005_r8*rxt(k,518)*y(k,226) + .011_r8*rxt(k,521)*y(k,229) + mat(k,1732) = .1749305_r8*rxt(k,494)*y(k,6) + .0590245_r8*rxt(k,502)*y(k,98) & + + .1749305_r8*rxt(k,510)*y(k,110) + mat(k,2204) = .1284005_r8*rxt(k,497)*y(k,6) + .0033005_r8*rxt(k,505)*y(k,98) & + + .0554005_r8*rxt(k,513)*y(k,110) + mat(k,48) = .0085005_r8*rxt(k,515)*y(k,219) + mat(k,54) = .079_r8*rxt(k,496)*y(k,124) + .1284005_r8*rxt(k,495)*y(k,205) + mat(k,60) = .0059005_r8*rxt(k,501)*y(k,124) + .0443005_r8*rxt(k,500)*y(k,205) + mat(k,2019) = .1284005_r8*rxt(k,495)*y(k,192) + .0443005_r8*rxt(k,500) & + *y(k,194) + .0271005_r8*rxt(k,503)*y(k,209) & + + .0076005_r8*rxt(k,507)*y(k,210) + .0554005_r8*rxt(k,511) & + *y(k,216) + .2157005_r8*rxt(k,517)*y(k,226) & + + .0512005_r8*rxt(k,520)*y(k,229) + mat(k,66) = .0057005_r8*rxt(k,504)*y(k,124) + .0271005_r8*rxt(k,503)*y(k,205) + mat(k,72) = .0143005_r8*rxt(k,508)*y(k,124) + .0076005_r8*rxt(k,507)*y(k,205) + mat(k,80) = .0332005_r8*rxt(k,512)*y(k,124) + .0554005_r8*rxt(k,511)*y(k,205) + mat(k,1545) = .0085005_r8*rxt(k,515)*y(k,174) + mat(k,86) = .0073005_r8*rxt(k,518)*y(k,124) + .2157005_r8*rxt(k,517)*y(k,205) + mat(k,92) = .011_r8*rxt(k,521)*y(k,124) + .0512005_r8*rxt(k,520)*y(k,205) + mat(k,990) = .5901905_r8*rxt(k,494)*y(k,126) + .114_r8*rxt(k,497)*y(k,135) + mat(k,834) = .0250245_r8*rxt(k,502)*y(k,126) + mat(k,941) = .5901905_r8*rxt(k,510)*y(k,126) + .1278005_r8*rxt(k,513) & + *y(k,135) + mat(k,1845) = .1254005_r8*rxt(k,496)*y(k,192) + .0536005_r8*rxt(k,501) & + *y(k,194) + .0623005_r8*rxt(k,504)*y(k,209) & + + .0166005_r8*rxt(k,508)*y(k,210) + .130_r8*rxt(k,512)*y(k,216) & + + .238_r8*rxt(k,518)*y(k,226) + .1185005_r8*rxt(k,521)*y(k,229) + mat(k,1733) = .5901905_r8*rxt(k,494)*y(k,6) + .0250245_r8*rxt(k,502)*y(k,98) & + + .5901905_r8*rxt(k,510)*y(k,110) + mat(k,2205) = .114_r8*rxt(k,497)*y(k,6) + .1278005_r8*rxt(k,513)*y(k,110) + mat(k,49) = .0128005_r8*rxt(k,515)*y(k,219) + mat(k,55) = .1254005_r8*rxt(k,496)*y(k,124) + .114_r8*rxt(k,495)*y(k,205) + mat(k,61) = .0536005_r8*rxt(k,501)*y(k,124) + .1621005_r8*rxt(k,500)*y(k,205) + mat(k,2020) = .114_r8*rxt(k,495)*y(k,192) + .1621005_r8*rxt(k,500)*y(k,194) & + + .0474005_r8*rxt(k,503)*y(k,209) + .0113005_r8*rxt(k,507) & + *y(k,210) + .1278005_r8*rxt(k,511)*y(k,216) & + + .0738005_r8*rxt(k,517)*y(k,226) + .1598005_r8*rxt(k,520) & + *y(k,229) + mat(k,67) = .0623005_r8*rxt(k,504)*y(k,124) + .0474005_r8*rxt(k,503)*y(k,205) + mat(k,73) = .0166005_r8*rxt(k,508)*y(k,124) + .0113005_r8*rxt(k,507)*y(k,205) + mat(k,81) = .130_r8*rxt(k,512)*y(k,124) + .1278005_r8*rxt(k,511)*y(k,205) + mat(k,1546) = .0128005_r8*rxt(k,515)*y(k,174) + mat(k,87) = .238_r8*rxt(k,518)*y(k,124) + .0738005_r8*rxt(k,517)*y(k,205) + mat(k,93) = .1185005_r8*rxt(k,521)*y(k,124) + .1598005_r8*rxt(k,520)*y(k,205) + mat(k,50) = -(rxt(k,515)*y(k,219)) + mat(k,1547) = -rxt(k,515)*y(k,174) + mat(k,191) = .100_r8*rxt(k,429)*y(k,219) + mat(k,209) = .230_r8*rxt(k,431)*y(k,219) + mat(k,1567) = .100_r8*rxt(k,429)*y(k,182) + .230_r8*rxt(k,431)*y(k,184) + mat(k,644) = -(rxt(k,453)*y(k,219)) + mat(k,1631) = -rxt(k,453)*y(k,176) + mat(k,2058) = rxt(k,451)*y(k,223) + mat(k,1105) = rxt(k,451)*y(k,205) + mat(k,619) = -(rxt(k,454)*y(k,219)) + mat(k,1628) = -rxt(k,454)*y(k,177) + mat(k,1873) = .200_r8*rxt(k,447)*y(k,217) + .200_r8*rxt(k,457)*y(k,224) + mat(k,1793) = .500_r8*rxt(k,445)*y(k,217) + mat(k,1044) = .200_r8*rxt(k,447)*y(k,124) + .500_r8*rxt(k,445)*y(k,200) + mat(k,912) = .200_r8*rxt(k,457)*y(k,124) + mat(k,476) = -(rxt(k,458)*y(k,219)) + mat(k,1610) = -rxt(k,458)*y(k,178) + mat(k,2050) = rxt(k,456)*y(k,224) + mat(k,911) = rxt(k,456)*y(k,205) + mat(k,971) = -(rxt(k,459)*y(k,126) + rxt(k,460)*y(k,219)) + mat(k,1745) = -rxt(k,459)*y(k,179) + mat(k,1661) = -rxt(k,460)*y(k,179) + mat(k,999) = .330_r8*rxt(k,440)*y(k,135) + mat(k,951) = .330_r8*rxt(k,443)*y(k,135) + mat(k,1892) = .800_r8*rxt(k,447)*y(k,217) + .800_r8*rxt(k,457)*y(k,224) + mat(k,1745) = mat(k,1745) + rxt(k,448)*y(k,217) + mat(k,2221) = .330_r8*rxt(k,440)*y(k,6) + .330_r8*rxt(k,443)*y(k,110) + mat(k,620) = rxt(k,454)*y(k,219) + mat(k,1802) = .500_r8*rxt(k,445)*y(k,217) + rxt(k,455)*y(k,224) + mat(k,1046) = .800_r8*rxt(k,447)*y(k,124) + rxt(k,448)*y(k,126) & + + .500_r8*rxt(k,445)*y(k,200) + mat(k,1661) = mat(k,1661) + rxt(k,454)*y(k,177) + mat(k,916) = .800_r8*rxt(k,457)*y(k,124) + rxt(k,455)*y(k,200) + mat(k,1061) = -(rxt(k,461)*y(k,219)) + mat(k,1666) = -rxt(k,461)*y(k,180) + mat(k,1003) = .300_r8*rxt(k,440)*y(k,135) + mat(k,954) = .300_r8*rxt(k,443)*y(k,135) + mat(k,1895) = .900_r8*rxt(k,452)*y(k,223) + mat(k,2226) = .300_r8*rxt(k,440)*y(k,6) + .300_r8*rxt(k,443)*y(k,110) + mat(k,1805) = rxt(k,450)*y(k,223) + mat(k,1109) = .900_r8*rxt(k,452)*y(k,124) + rxt(k,450)*y(k,200) + mat(k,657) = -(rxt(k,428)*y(k,219)) + mat(k,1632) = -rxt(k,428)*y(k,181) + mat(k,2059) = rxt(k,426)*y(k,225) + mat(k,724) = rxt(k,426)*y(k,205) + mat(k,189) = -(rxt(k,429)*y(k,219)) + mat(k,1565) = -rxt(k,429)*y(k,182) + mat(k,205) = -(rxt(k,395)*y(k,219)) + mat(k,1568) = -rxt(k,395)*y(k,183) + mat(k,2029) = rxt(k,392)*y(k,227) + mat(k,1168) = rxt(k,392)*y(k,205) + mat(k,210) = -(rxt(k,431)*y(k,219)) + mat(k,1569) = -rxt(k,431)*y(k,184) + mat(k,695) = -(rxt(k,434)*y(k,219)) + mat(k,1636) = -rxt(k,434)*y(k,185) + mat(k,2063) = rxt(k,432)*y(k,228) + mat(k,748) = rxt(k,432)*y(k,205) + mat(k,218) = -(rxt(k,437)*y(k,219)) + mat(k,1570) = -rxt(k,437)*y(k,186) + mat(k,211) = .150_r8*rxt(k,431)*y(k,219) + mat(k,1570) = mat(k,1570) + .150_r8*rxt(k,431)*y(k,184) + mat(k,429) = -(rxt(k,438)*y(k,219)) + mat(k,1603) = -rxt(k,438)*y(k,187) + mat(k,2043) = rxt(k,435)*y(k,230) + mat(k,500) = rxt(k,435)*y(k,205) + mat(k,520) = -(rxt(k,396)*y(k,205) + rxt(k,397)*y(k,124) + rxt(k,425) & + *y(k,125)) + mat(k,2053) = -rxt(k,396)*y(k,190) + mat(k,1868) = -rxt(k,397)*y(k,190) + mat(k,1939) = -rxt(k,425)*y(k,190) + mat(k,238) = rxt(k,402)*y(k,219) + mat(k,1616) = rxt(k,402)*y(k,22) + mat(k,889) = -(rxt(k,357)*y(k,205) + (rxt(k,358) + rxt(k,359)) * y(k,124)) + mat(k,2079) = -rxt(k,357)*y(k,191) + mat(k,1888) = -(rxt(k,358) + rxt(k,359)) * y(k,191) + mat(k,671) = rxt(k,360)*y(k,219) + mat(k,229) = rxt(k,361)*y(k,219) + mat(k,1655) = rxt(k,360)*y(k,2) + rxt(k,361)*y(k,15) + mat(k,56) = -(rxt(k,495)*y(k,205) + rxt(k,496)*y(k,124)) + mat(k,2021) = -rxt(k,495)*y(k,192) + mat(k,1846) = -rxt(k,496)*y(k,192) + mat(k,991) = rxt(k,498)*y(k,219) + mat(k,1548) = rxt(k,498)*y(k,6) + mat(k,485) = -(rxt(k,399)*y(k,205) + rxt(k,400)*y(k,124)) + mat(k,2051) = -rxt(k,399)*y(k,193) + mat(k,1864) = -rxt(k,400)*y(k,193) + mat(k,167) = .350_r8*rxt(k,398)*y(k,219) + mat(k,419) = rxt(k,401)*y(k,219) + mat(k,1611) = .350_r8*rxt(k,398)*y(k,7) + rxt(k,401)*y(k,8) + mat(k,62) = -(rxt(k,500)*y(k,205) + rxt(k,501)*y(k,124)) + mat(k,2022) = -rxt(k,500)*y(k,194) + mat(k,1847) = -rxt(k,501)*y(k,194) + mat(k,163) = rxt(k,499)*y(k,219) + mat(k,1549) = rxt(k,499)*y(k,7) + mat(k,437) = -(rxt(k,403)*y(k,205) + rxt(k,405)*y(k,124)) + mat(k,2044) = -rxt(k,403)*y(k,195) + mat(k,1859) = -rxt(k,405)*y(k,195) + mat(k,339) = rxt(k,404)*y(k,219) + mat(k,192) = .070_r8*rxt(k,429)*y(k,219) + mat(k,212) = .060_r8*rxt(k,431)*y(k,219) + mat(k,1604) = rxt(k,404)*y(k,23) + .070_r8*rxt(k,429)*y(k,182) & + + .060_r8*rxt(k,431)*y(k,184) + mat(k,825) = -(4._r8*rxt(k,280)*y(k,196) + rxt(k,281)*y(k,200) + rxt(k,282) & + *y(k,205) + rxt(k,283)*y(k,124)) + mat(k,1798) = -rxt(k,281)*y(k,196) + mat(k,2076) = -rxt(k,282)*y(k,196) + mat(k,1885) = -rxt(k,283)*y(k,196) + mat(k,344) = .500_r8*rxt(k,285)*y(k,219) + mat(k,307) = rxt(k,286)*y(k,56) + rxt(k,287)*y(k,219) + mat(k,1988) = rxt(k,286)*y(k,28) + mat(k,1649) = .500_r8*rxt(k,285)*y(k,27) + rxt(k,287)*y(k,28) + end do + end subroutine nlnmat07 + subroutine nlnmat08( 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,789) = -(rxt(k,309)*y(k,200) + rxt(k,310)*y(k,205) + rxt(k,311) & + *y(k,124)) + mat(k,1795) = -rxt(k,309)*y(k,197) + mat(k,2072) = -rxt(k,310)*y(k,197) + mat(k,1883) = -rxt(k,311)*y(k,197) + mat(k,412) = rxt(k,312)*y(k,219) + mat(k,112) = rxt(k,313)*y(k,219) + mat(k,1644) = rxt(k,312)*y(k,30) + rxt(k,313)*y(k,31) + mat(k,627) = -(rxt(k,406)*y(k,205) + rxt(k,407)*y(k,124)) + mat(k,2057) = -rxt(k,406)*y(k,198) + mat(k,1874) = -rxt(k,407)*y(k,198) + mat(k,269) = rxt(k,408)*y(k,219) + mat(k,1874) = mat(k,1874) + rxt(k,397)*y(k,190) + mat(k,2211) = rxt(k,423)*y(k,142) + mat(k,466) = rxt(k,423)*y(k,135) + mat(k,521) = rxt(k,397)*y(k,124) + .400_r8*rxt(k,396)*y(k,205) + mat(k,2057) = mat(k,2057) + .400_r8*rxt(k,396)*y(k,190) + mat(k,1629) = rxt(k,408)*y(k,32) + mat(k,1388) = -(4._r8*rxt(k,291)*y(k,199) + rxt(k,292)*y(k,200) + rxt(k,293) & + *y(k,205) + rxt(k,294)*y(k,124) + rxt(k,305)*y(k,125) + rxt(k,332) & + *y(k,211) + rxt(k,365)*y(k,207) + rxt(k,370)*y(k,208) + rxt(k,379) & + *y(k,101) + rxt(k,390)*y(k,227)) + mat(k,1822) = -rxt(k,292)*y(k,199) + mat(k,2102) = -rxt(k,293)*y(k,199) + mat(k,1913) = -rxt(k,294)*y(k,199) + mat(k,1957) = -rxt(k,305)*y(k,199) + mat(k,1315) = -rxt(k,332)*y(k,199) + mat(k,1262) = -rxt(k,365)*y(k,199) + mat(k,1294) = -rxt(k,370)*y(k,199) + mat(k,1199) = -rxt(k,379)*y(k,199) + mat(k,1177) = -rxt(k,390)*y(k,199) + mat(k,1009) = .060_r8*rxt(k,440)*y(k,135) + mat(k,1089) = rxt(k,288)*y(k,126) + rxt(k,289)*y(k,219) + mat(k,1224) = rxt(k,314)*y(k,126) + rxt(k,315)*y(k,219) + mat(k,614) = .500_r8*rxt(k,296)*y(k,219) + mat(k,845) = .080_r8*rxt(k,385)*y(k,135) + mat(k,1215) = .100_r8*rxt(k,338)*y(k,135) + mat(k,959) = .060_r8*rxt(k,443)*y(k,135) + mat(k,1336) = .280_r8*rxt(k,352)*y(k,135) + mat(k,1913) = mat(k,1913) + .530_r8*rxt(k,336)*y(k,211) + rxt(k,345)*y(k,213) & + + rxt(k,348)*y(k,215) + rxt(k,323)*y(k,222) + mat(k,1769) = rxt(k,288)*y(k,45) + rxt(k,314)*y(k,49) + .530_r8*rxt(k,335) & + *y(k,211) + rxt(k,346)*y(k,213) + mat(k,2242) = .060_r8*rxt(k,440)*y(k,6) + .080_r8*rxt(k,385)*y(k,98) & + + .100_r8*rxt(k,338)*y(k,105) + .060_r8*rxt(k,443)*y(k,110) & + + .280_r8*rxt(k,352)*y(k,111) + mat(k,1064) = .650_r8*rxt(k,461)*y(k,219) + mat(k,1388) = mat(k,1388) + .530_r8*rxt(k,332)*y(k,211) + mat(k,1822) = mat(k,1822) + .260_r8*rxt(k,333)*y(k,211) + rxt(k,342)*y(k,213) & + + .300_r8*rxt(k,321)*y(k,222) + mat(k,2102) = mat(k,2102) + .450_r8*rxt(k,343)*y(k,213) + .200_r8*rxt(k,347) & + *y(k,215) + .150_r8*rxt(k,322)*y(k,222) + mat(k,1315) = mat(k,1315) + .530_r8*rxt(k,336)*y(k,124) + .530_r8*rxt(k,335) & + *y(k,126) + .530_r8*rxt(k,332)*y(k,199) + .260_r8*rxt(k,333) & + *y(k,200) + mat(k,1357) = rxt(k,345)*y(k,124) + rxt(k,346)*y(k,126) + rxt(k,342)*y(k,200) & + + .450_r8*rxt(k,343)*y(k,205) + 4.000_r8*rxt(k,344)*y(k,213) + mat(k,681) = rxt(k,348)*y(k,124) + .200_r8*rxt(k,347)*y(k,205) + mat(k,1685) = rxt(k,289)*y(k,45) + rxt(k,315)*y(k,49) + .500_r8*rxt(k,296) & + *y(k,51) + .650_r8*rxt(k,461)*y(k,180) + mat(k,1134) = rxt(k,323)*y(k,124) + .300_r8*rxt(k,321)*y(k,200) & + + .150_r8*rxt(k,322)*y(k,205) + mat(k,1831) = -(rxt(k,182)*y(k,59) + (4._r8*rxt(k,259) + 4._r8*rxt(k,260) & + ) * y(k,200) + rxt(k,261)*y(k,205) + rxt(k,262)*y(k,124) & + + rxt(k,281)*y(k,196) + rxt(k,292)*y(k,199) + rxt(k,309) & + *y(k,197) + rxt(k,321)*y(k,222) + rxt(k,333)*y(k,211) + rxt(k,342) & + *y(k,213) + rxt(k,366)*y(k,207) + rxt(k,371)*y(k,208) + rxt(k,380) & + *y(k,101) + rxt(k,391)*y(k,227) + rxt(k,445)*y(k,217) + rxt(k,450) & + *y(k,223) + rxt(k,455)*y(k,224)) + mat(k,1722) = -rxt(k,182)*y(k,200) + mat(k,2113) = -rxt(k,261)*y(k,200) + mat(k,1923) = -rxt(k,262)*y(k,200) + mat(k,829) = -rxt(k,281)*y(k,200) + mat(k,1394) = -rxt(k,292)*y(k,200) + mat(k,794) = -rxt(k,309)*y(k,200) + mat(k,1137) = -rxt(k,321)*y(k,200) + mat(k,1320) = -rxt(k,333)*y(k,200) + mat(k,1362) = -rxt(k,342)*y(k,200) + mat(k,1267) = -rxt(k,366)*y(k,200) + mat(k,1299) = -rxt(k,371)*y(k,200) + mat(k,1204) = -rxt(k,380)*y(k,200) + mat(k,1181) = -rxt(k,391)*y(k,200) + mat(k,1055) = -rxt(k,445)*y(k,200) + mat(k,1118) = -rxt(k,450)*y(k,200) + mat(k,920) = -rxt(k,455)*y(k,200) + mat(k,1036) = .280_r8*rxt(k,308)*y(k,135) + mat(k,689) = rxt(k,295)*y(k,219) + mat(k,460) = .700_r8*rxt(k,264)*y(k,219) + mat(k,1439) = rxt(k,176)*y(k,56) + rxt(k,232)*y(k,73) + rxt(k,271)*y(k,218) & + + rxt(k,265)*y(k,219) + mat(k,2006) = rxt(k,176)*y(k,54) + mat(k,873) = rxt(k,232)*y(k,54) + mat(k,849) = .050_r8*rxt(k,385)*y(k,135) + mat(k,1204) = mat(k,1204) + rxt(k,379)*y(k,199) + mat(k,1923) = mat(k,1923) + rxt(k,294)*y(k,199) + .830_r8*rxt(k,411)*y(k,201) & + + .170_r8*rxt(k,417)*y(k,214) + mat(k,2252) = .280_r8*rxt(k,308)*y(k,29) + .050_r8*rxt(k,385)*y(k,98) + mat(k,1394) = mat(k,1394) + rxt(k,379)*y(k,101) + rxt(k,294)*y(k,124) & + + 4.000_r8*rxt(k,291)*y(k,199) + .900_r8*rxt(k,292)*y(k,200) & + + .450_r8*rxt(k,293)*y(k,205) + rxt(k,365)*y(k,207) + rxt(k,370) & + *y(k,208) + rxt(k,332)*y(k,211) + rxt(k,341)*y(k,213) & + + rxt(k,390)*y(k,227) + mat(k,1831) = mat(k,1831) + .900_r8*rxt(k,292)*y(k,199) + mat(k,765) = .830_r8*rxt(k,411)*y(k,124) + .330_r8*rxt(k,410)*y(k,205) + mat(k,2113) = mat(k,2113) + .450_r8*rxt(k,293)*y(k,199) + .330_r8*rxt(k,410) & + *y(k,201) + .070_r8*rxt(k,416)*y(k,214) + mat(k,1267) = mat(k,1267) + rxt(k,365)*y(k,199) + mat(k,1299) = mat(k,1299) + rxt(k,370)*y(k,199) + mat(k,1320) = mat(k,1320) + rxt(k,332)*y(k,199) + mat(k,1362) = mat(k,1362) + rxt(k,341)*y(k,199) + mat(k,880) = .170_r8*rxt(k,417)*y(k,124) + .070_r8*rxt(k,416)*y(k,205) + mat(k,1532) = rxt(k,271)*y(k,54) + mat(k,1696) = rxt(k,295)*y(k,50) + .700_r8*rxt(k,264)*y(k,53) + rxt(k,265) & + *y(k,54) + mat(k,1181) = mat(k,1181) + rxt(k,390)*y(k,199) + mat(k,761) = -(rxt(k,410)*y(k,205) + rxt(k,411)*y(k,124) + rxt(k,412) & + *y(k,125)) + mat(k,2069) = -rxt(k,410)*y(k,201) + mat(k,1881) = -rxt(k,411)*y(k,201) + mat(k,1945) = -rxt(k,412)*y(k,201) + mat(k,566) = -((rxt(k,329) + rxt(k,330)) * y(k,124)) + mat(k,1870) = -(rxt(k,329) + rxt(k,330)) * y(k,202) + mat(k,352) = rxt(k,328)*y(k,219) + mat(k,1621) = rxt(k,328)*y(k,16) + mat(k,1855) = .750_r8*rxt(k,298)*y(k,204) + mat(k,707) = .750_r8*rxt(k,298)*y(k,124) + mat(k,708) = -(rxt(k,297)*y(k,205) + rxt(k,298)*y(k,124)) + mat(k,2064) = -rxt(k,297)*y(k,204) + mat(k,1877) = -rxt(k,298)*y(k,204) + mat(k,551) = rxt(k,304)*y(k,219) + mat(k,1637) = rxt(k,304)*y(k,25) + mat(k,2117) = -((rxt(k,135) + rxt(k,136) + rxt(k,137)) * y(k,76) + rxt(k,139) & + *y(k,134) + rxt(k,140)*y(k,135) + rxt(k,144)*y(k,219) & + + 4._r8*rxt(k,149)*y(k,205) + rxt(k,159)*y(k,126) + rxt(k,164) & + *y(k,124) + rxt(k,169)*y(k,125) + (rxt(k,179) + rxt(k,180) & + ) * y(k,56) + rxt(k,186)*y(k,59) + rxt(k,212)*y(k,17) + rxt(k,218) & + *y(k,19) + rxt(k,255)*y(k,42) + rxt(k,261)*y(k,200) + rxt(k,268) & + *y(k,206) + rxt(k,282)*y(k,196) + rxt(k,293)*y(k,199) + rxt(k,297) & + *y(k,204) + rxt(k,310)*y(k,197) + rxt(k,318)*y(k,221) + rxt(k,322) & + *y(k,222) + rxt(k,334)*y(k,211) + rxt(k,343)*y(k,213) + rxt(k,347) & + *y(k,215) + rxt(k,357)*y(k,191) + rxt(k,367)*y(k,207) + rxt(k,372) & + *y(k,208) + rxt(k,381)*y(k,101) + rxt(k,392)*y(k,227) + rxt(k,396) & + *y(k,190) + rxt(k,399)*y(k,193) + rxt(k,403)*y(k,195) + rxt(k,406) & + *y(k,198) + rxt(k,410)*y(k,201) + rxt(k,413)*y(k,212) + rxt(k,416) & + *y(k,214) + rxt(k,419)*y(k,220) + rxt(k,426)*y(k,225) + rxt(k,432) & + *y(k,228) + rxt(k,435)*y(k,230) + rxt(k,446)*y(k,217) + rxt(k,451) & + *y(k,223) + rxt(k,456)*y(k,224)) + mat(k,1455) = -(rxt(k,135) + rxt(k,136) + rxt(k,137)) * y(k,205) + mat(k,2195) = -rxt(k,139)*y(k,205) + mat(k,2256) = -rxt(k,140)*y(k,205) + mat(k,1700) = -rxt(k,144)*y(k,205) + mat(k,1783) = -rxt(k,159)*y(k,205) + mat(k,1927) = -rxt(k,164)*y(k,205) + mat(k,1971) = -rxt(k,169)*y(k,205) + mat(k,2010) = -(rxt(k,179) + rxt(k,180)) * y(k,205) + mat(k,1726) = -rxt(k,186)*y(k,205) + mat(k,1422) = -rxt(k,212)*y(k,205) + mat(k,2164) = -rxt(k,218)*y(k,205) + mat(k,1495) = -rxt(k,255)*y(k,205) + mat(k,1835) = -rxt(k,261)*y(k,205) + mat(k,448) = -rxt(k,268)*y(k,205) + mat(k,832) = -rxt(k,282)*y(k,205) + mat(k,1397) = -rxt(k,293)*y(k,205) + mat(k,714) = -rxt(k,297)*y(k,205) + mat(k,797) = -rxt(k,310)*y(k,205) + mat(k,777) = -rxt(k,318)*y(k,205) + mat(k,1140) = -rxt(k,322)*y(k,205) + mat(k,1323) = -rxt(k,334)*y(k,205) + mat(k,1365) = -rxt(k,343)*y(k,205) + mat(k,685) = -rxt(k,347)*y(k,205) + mat(k,898) = -rxt(k,357)*y(k,205) + mat(k,1270) = -rxt(k,367)*y(k,205) + mat(k,1302) = -rxt(k,372)*y(k,205) + mat(k,1207) = -rxt(k,381)*y(k,205) + mat(k,1184) = -rxt(k,392)*y(k,205) + mat(k,525) = -rxt(k,396)*y(k,205) + mat(k,491) = -rxt(k,399)*y(k,205) + mat(k,442) = -rxt(k,403)*y(k,205) + mat(k,631) = -rxt(k,406)*y(k,205) + mat(k,768) = -rxt(k,410)*y(k,205) + mat(k,720) = -rxt(k,413)*y(k,205) + mat(k,883) = -rxt(k,416)*y(k,205) + mat(k,455) = -rxt(k,419)*y(k,205) + mat(k,735) = -rxt(k,426)*y(k,205) + mat(k,760) = -rxt(k,432)*y(k,205) + mat(k,507) = -rxt(k,435)*y(k,205) + mat(k,1058) = -rxt(k,446)*y(k,205) + mat(k,1121) = -rxt(k,451)*y(k,205) + mat(k,923) = -rxt(k,456)*y(k,205) + mat(k,1017) = .570_r8*rxt(k,440)*y(k,135) + mat(k,169) = .650_r8*rxt(k,398)*y(k,219) + mat(k,1422) = mat(k,1422) + rxt(k,211)*y(k,42) + mat(k,2164) = mat(k,2164) + rxt(k,223)*y(k,219) + mat(k,298) = .350_r8*rxt(k,277)*y(k,219) + mat(k,556) = .130_r8*rxt(k,279)*y(k,135) + mat(k,266) = rxt(k,284)*y(k,219) + mat(k,1039) = .280_r8*rxt(k,308)*y(k,135) + mat(k,1495) = mat(k,1495) + rxt(k,211)*y(k,17) + rxt(k,175)*y(k,56) & + + rxt(k,256)*y(k,126) + rxt(k,257)*y(k,134) + mat(k,602) = rxt(k,240)*y(k,56) + rxt(k,241)*y(k,219) + mat(k,372) = rxt(k,243)*y(k,56) + rxt(k,244)*y(k,219) + mat(k,106) = rxt(k,290)*y(k,219) + mat(k,802) = rxt(k,263)*y(k,219) + mat(k,1441) = rxt(k,272)*y(k,218) + mat(k,2010) = mat(k,2010) + rxt(k,175)*y(k,42) + rxt(k,240)*y(k,43) & + + rxt(k,243)*y(k,46) + rxt(k,178)*y(k,79) + mat(k,1726) = mat(k,1726) + rxt(k,182)*y(k,200) + rxt(k,193)*y(k,219) + mat(k,1127) = rxt(k,275)*y(k,219) + mat(k,200) = .730_r8*rxt(k,409)*y(k,219) + mat(k,289) = .500_r8*rxt(k,477)*y(k,219) + mat(k,1102) = rxt(k,301)*y(k,219) + mat(k,984) = rxt(k,302)*y(k,219) + mat(k,608) = rxt(k,178)*y(k,56) + rxt(k,134)*y(k,134) + rxt(k,143)*y(k,219) + mat(k,184) = rxt(k,266)*y(k,219) + mat(k,934) = rxt(k,267)*y(k,219) + mat(k,1165) = rxt(k,331)*y(k,219) + mat(k,1147) = rxt(k,316)*y(k,219) + mat(k,850) = .370_r8*rxt(k,385)*y(k,135) + mat(k,591) = .300_r8*rxt(k,376)*y(k,219) + mat(k,541) = rxt(k,377)*y(k,219) + mat(k,1207) = mat(k,1207) + rxt(k,382)*y(k,124) + rxt(k,383)*y(k,126) & + + rxt(k,379)*y(k,199) + 1.200_r8*rxt(k,380)*y(k,200) + mat(k,410) = rxt(k,384)*y(k,219) + mat(k,1218) = .140_r8*rxt(k,338)*y(k,135) + mat(k,316) = .200_r8*rxt(k,340)*y(k,219) + mat(k,582) = .500_r8*rxt(k,351)*y(k,219) + mat(k,967) = .570_r8*rxt(k,443)*y(k,135) + mat(k,1345) = .280_r8*rxt(k,352)*y(k,135) + mat(k,380) = rxt(k,388)*y(k,219) + mat(k,1085) = rxt(k,389)*y(k,219) + mat(k,1927) = mat(k,1927) + rxt(k,382)*y(k,101) + rxt(k,358)*y(k,191) & + + rxt(k,400)*y(k,193) + rxt(k,405)*y(k,195) + rxt(k,283) & + *y(k,196) + rxt(k,311)*y(k,197) + rxt(k,262)*y(k,200) & + + .170_r8*rxt(k,411)*y(k,201) + rxt(k,329)*y(k,202) & + + .250_r8*rxt(k,298)*y(k,204) + rxt(k,270)*y(k,206) & + + .920_r8*rxt(k,368)*y(k,207) + .920_r8*rxt(k,374)*y(k,208) & + + .470_r8*rxt(k,336)*y(k,211) + .400_r8*rxt(k,414)*y(k,212) & + + .830_r8*rxt(k,417)*y(k,214) + rxt(k,420)*y(k,220) + rxt(k,319) & + *y(k,221) + .900_r8*rxt(k,452)*y(k,223) + .800_r8*rxt(k,457) & + *y(k,224) + rxt(k,427)*y(k,225) + rxt(k,393)*y(k,227) & + + rxt(k,433)*y(k,228) + rxt(k,436)*y(k,230) + mat(k,1783) = mat(k,1783) + rxt(k,256)*y(k,42) + rxt(k,383)*y(k,101) & + + rxt(k,369)*y(k,207) + rxt(k,375)*y(k,208) + .470_r8*rxt(k,335) & + *y(k,211) + rxt(k,162)*y(k,219) + rxt(k,394)*y(k,227) + mat(k,2195) = mat(k,2195) + rxt(k,257)*y(k,42) + rxt(k,134)*y(k,79) + mat(k,2256) = mat(k,2256) + .570_r8*rxt(k,440)*y(k,6) + .130_r8*rxt(k,279) & + *y(k,25) + .280_r8*rxt(k,308)*y(k,29) + .370_r8*rxt(k,385) & + *y(k,98) + .140_r8*rxt(k,338)*y(k,105) + .570_r8*rxt(k,443) & + *y(k,110) + .280_r8*rxt(k,352)*y(k,111) + rxt(k,146)*y(k,219) + mat(k,178) = .800_r8*rxt(k,421)*y(k,219) + mat(k,856) = rxt(k,467)*y(k,219) + mat(k,1068) = .200_r8*rxt(k,461)*y(k,219) + mat(k,195) = .280_r8*rxt(k,429)*y(k,219) + mat(k,217) = .380_r8*rxt(k,431)*y(k,219) + mat(k,222) = .630_r8*rxt(k,437)*y(k,219) + mat(k,898) = mat(k,898) + rxt(k,358)*y(k,124) + mat(k,491) = mat(k,491) + rxt(k,400)*y(k,124) + mat(k,442) = mat(k,442) + rxt(k,405)*y(k,124) + mat(k,832) = mat(k,832) + rxt(k,283)*y(k,124) + 2.400_r8*rxt(k,280)*y(k,196) & + + rxt(k,281)*y(k,200) + mat(k,797) = mat(k,797) + rxt(k,311)*y(k,124) + rxt(k,309)*y(k,200) + mat(k,1397) = mat(k,1397) + rxt(k,379)*y(k,101) + .900_r8*rxt(k,292)*y(k,200) & + + rxt(k,365)*y(k,207) + rxt(k,370)*y(k,208) + .470_r8*rxt(k,332) & + *y(k,211) + rxt(k,390)*y(k,227) + mat(k,1835) = mat(k,1835) + rxt(k,182)*y(k,59) + 1.200_r8*rxt(k,380)*y(k,101) & + + rxt(k,262)*y(k,124) + rxt(k,281)*y(k,196) + rxt(k,309) & + *y(k,197) + .900_r8*rxt(k,292)*y(k,199) + 4.000_r8*rxt(k,259) & + *y(k,200) + rxt(k,366)*y(k,207) + rxt(k,371)*y(k,208) & + + .730_r8*rxt(k,333)*y(k,211) + rxt(k,342)*y(k,213) & + + .500_r8*rxt(k,445)*y(k,217) + .300_r8*rxt(k,321)*y(k,222) & + + rxt(k,450)*y(k,223) + rxt(k,455)*y(k,224) + .800_r8*rxt(k,391) & + *y(k,227) + mat(k,768) = mat(k,768) + .170_r8*rxt(k,411)*y(k,124) + .070_r8*rxt(k,410) & + *y(k,205) + mat(k,573) = rxt(k,329)*y(k,124) + mat(k,714) = mat(k,714) + .250_r8*rxt(k,298)*y(k,124) + mat(k,2117) = mat(k,2117) + .070_r8*rxt(k,410)*y(k,201) + .160_r8*rxt(k,413) & + *y(k,212) + .330_r8*rxt(k,416)*y(k,214) + mat(k,448) = mat(k,448) + rxt(k,270)*y(k,124) + mat(k,1270) = mat(k,1270) + .920_r8*rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126) & + + rxt(k,365)*y(k,199) + rxt(k,366)*y(k,200) + mat(k,1302) = mat(k,1302) + .920_r8*rxt(k,374)*y(k,124) + rxt(k,375)*y(k,126) & + + rxt(k,370)*y(k,199) + rxt(k,371)*y(k,200) + mat(k,1323) = mat(k,1323) + .470_r8*rxt(k,336)*y(k,124) + .470_r8*rxt(k,335) & + *y(k,126) + .470_r8*rxt(k,332)*y(k,199) + .730_r8*rxt(k,333) & + *y(k,200) + mat(k,720) = mat(k,720) + .400_r8*rxt(k,414)*y(k,124) + .160_r8*rxt(k,413) & + *y(k,205) + mat(k,1365) = mat(k,1365) + rxt(k,342)*y(k,200) + mat(k,883) = mat(k,883) + .830_r8*rxt(k,417)*y(k,124) + .330_r8*rxt(k,416) & + *y(k,205) + mat(k,1058) = mat(k,1058) + .500_r8*rxt(k,445)*y(k,200) + mat(k,1536) = rxt(k,272)*y(k,54) + mat(k,1700) = mat(k,1700) + .650_r8*rxt(k,398)*y(k,7) + rxt(k,223)*y(k,19) & + + .350_r8*rxt(k,277)*y(k,24) + rxt(k,284)*y(k,26) + rxt(k,241) & + *y(k,43) + rxt(k,244)*y(k,46) + rxt(k,290)*y(k,47) + rxt(k,263) & + *y(k,52) + rxt(k,193)*y(k,59) + rxt(k,275)*y(k,62) & + + .730_r8*rxt(k,409)*y(k,66) + .500_r8*rxt(k,477)*y(k,67) & + + rxt(k,301)*y(k,74) + rxt(k,302)*y(k,75) + rxt(k,143)*y(k,79) & + + rxt(k,266)*y(k,86) + rxt(k,267)*y(k,87) + rxt(k,331)*y(k,93) & + + rxt(k,316)*y(k,95) + .300_r8*rxt(k,376)*y(k,99) + rxt(k,377) & + *y(k,100) + rxt(k,384)*y(k,102) + .200_r8*rxt(k,340)*y(k,106) & + + .500_r8*rxt(k,351)*y(k,109) + rxt(k,388)*y(k,115) + rxt(k,389) & + *y(k,116) + rxt(k,162)*y(k,126) + rxt(k,146)*y(k,135) & + + .800_r8*rxt(k,421)*y(k,143) + rxt(k,467)*y(k,152) & + + .200_r8*rxt(k,461)*y(k,180) + .280_r8*rxt(k,429)*y(k,182) & + + .380_r8*rxt(k,431)*y(k,184) + .630_r8*rxt(k,437)*y(k,186) + mat(k,455) = mat(k,455) + rxt(k,420)*y(k,124) + mat(k,777) = mat(k,777) + rxt(k,319)*y(k,124) + mat(k,1140) = mat(k,1140) + .300_r8*rxt(k,321)*y(k,200) + mat(k,1121) = mat(k,1121) + .900_r8*rxt(k,452)*y(k,124) + rxt(k,450)*y(k,200) + mat(k,923) = mat(k,923) + .800_r8*rxt(k,457)*y(k,124) + rxt(k,455)*y(k,200) + mat(k,735) = mat(k,735) + rxt(k,427)*y(k,124) + mat(k,1184) = mat(k,1184) + rxt(k,393)*y(k,124) + rxt(k,394)*y(k,126) & + + rxt(k,390)*y(k,199) + .800_r8*rxt(k,391)*y(k,200) + mat(k,760) = mat(k,760) + rxt(k,433)*y(k,124) + mat(k,507) = mat(k,507) + rxt(k,436)*y(k,124) + end do + end subroutine nlnmat08 + subroutine nlnmat09( 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,443) = -(rxt(k,268)*y(k,205) + rxt(k,270)*y(k,124)) + mat(k,2045) = -rxt(k,268)*y(k,206) + mat(k,1860) = -rxt(k,270)*y(k,206) + mat(k,1478) = rxt(k,255)*y(k,205) + mat(k,2045) = mat(k,2045) + rxt(k,255)*y(k,42) + mat(k,1258) = -(rxt(k,365)*y(k,199) + rxt(k,366)*y(k,200) + rxt(k,367) & + *y(k,205) + rxt(k,368)*y(k,124) + rxt(k,369)*y(k,126)) + mat(k,1383) = -rxt(k,365)*y(k,207) + mat(k,1817) = -rxt(k,366)*y(k,207) + mat(k,2097) = -rxt(k,367)*y(k,207) + mat(k,1908) = -rxt(k,368)*y(k,207) + mat(k,1764) = -rxt(k,369)*y(k,207) + mat(k,842) = .600_r8*rxt(k,386)*y(k,219) + mat(k,1680) = .600_r8*rxt(k,386)*y(k,98) + mat(k,1290) = -(rxt(k,370)*y(k,199) + rxt(k,371)*y(k,200) + rxt(k,372) & + *y(k,205) + rxt(k,374)*y(k,124) + rxt(k,375)*y(k,126)) + mat(k,1384) = -rxt(k,370)*y(k,208) + mat(k,1818) = -rxt(k,371)*y(k,208) + mat(k,2098) = -rxt(k,372)*y(k,208) + mat(k,1909) = -rxt(k,374)*y(k,208) + mat(k,1765) = -rxt(k,375)*y(k,208) + mat(k,843) = .400_r8*rxt(k,386)*y(k,219) + mat(k,1681) = .400_r8*rxt(k,386)*y(k,98) + mat(k,68) = -(rxt(k,503)*y(k,205) + rxt(k,504)*y(k,124)) + mat(k,2023) = -rxt(k,503)*y(k,209) + mat(k,1848) = -rxt(k,504)*y(k,209) + mat(k,835) = rxt(k,506)*y(k,219) + mat(k,1550) = rxt(k,506)*y(k,98) + mat(k,74) = -(rxt(k,507)*y(k,205) + rxt(k,508)*y(k,124)) + mat(k,2024) = -rxt(k,507)*y(k,210) + mat(k,1849) = -rxt(k,508)*y(k,210) + mat(k,75) = rxt(k,509)*y(k,219) + mat(k,1551) = rxt(k,509)*y(k,104) + mat(k,1313) = -(rxt(k,332)*y(k,199) + rxt(k,333)*y(k,200) + rxt(k,334) & + *y(k,205) + rxt(k,335)*y(k,126) + (rxt(k,336) + rxt(k,337) & + ) * y(k,124)) + mat(k,1385) = -rxt(k,332)*y(k,211) + mat(k,1819) = -rxt(k,333)*y(k,211) + mat(k,2099) = -rxt(k,334)*y(k,211) + mat(k,1766) = -rxt(k,335)*y(k,211) + mat(k,1910) = -(rxt(k,336) + rxt(k,337)) * y(k,211) + mat(k,1213) = .500_r8*rxt(k,339)*y(k,219) + mat(k,313) = .200_r8*rxt(k,340)*y(k,219) + mat(k,1333) = rxt(k,353)*y(k,219) + mat(k,1682) = .500_r8*rxt(k,339)*y(k,105) + .200_r8*rxt(k,340)*y(k,106) & + + rxt(k,353)*y(k,111) + mat(k,715) = -(rxt(k,413)*y(k,205) + rxt(k,414)*y(k,124) + rxt(k,415) & + *y(k,125)) + mat(k,2065) = -rxt(k,413)*y(k,212) + mat(k,1878) = -rxt(k,414)*y(k,212) + mat(k,1944) = -rxt(k,415)*y(k,212) + mat(k,1356) = -(rxt(k,341)*y(k,199) + rxt(k,342)*y(k,200) + rxt(k,343) & + *y(k,205) + 4._r8*rxt(k,344)*y(k,213) + rxt(k,345)*y(k,124) & + + rxt(k,346)*y(k,126) + rxt(k,354)*y(k,125)) + mat(k,1387) = -rxt(k,341)*y(k,213) + mat(k,1821) = -rxt(k,342)*y(k,213) + mat(k,2101) = -rxt(k,343)*y(k,213) + mat(k,1912) = -rxt(k,345)*y(k,213) + mat(k,1768) = -rxt(k,346)*y(k,213) + mat(k,1956) = -rxt(k,354)*y(k,213) + mat(k,1214) = .500_r8*rxt(k,339)*y(k,219) + mat(k,314) = .500_r8*rxt(k,340)*y(k,219) + mat(k,1684) = .500_r8*rxt(k,339)*y(k,105) + .500_r8*rxt(k,340)*y(k,106) + mat(k,875) = -(rxt(k,416)*y(k,205) + rxt(k,417)*y(k,124) + rxt(k,418) & + *y(k,125)) + mat(k,2078) = -rxt(k,416)*y(k,214) + mat(k,1887) = -rxt(k,417)*y(k,214) + mat(k,1949) = -rxt(k,418)*y(k,214) + mat(k,679) = -(rxt(k,347)*y(k,205) + rxt(k,348)*y(k,124)) + mat(k,2061) = -rxt(k,347)*y(k,215) + mat(k,1876) = -rxt(k,348)*y(k,215) + mat(k,509) = rxt(k,349)*y(k,219) + mat(k,318) = rxt(k,350)*y(k,219) + mat(k,1634) = rxt(k,349)*y(k,107) + rxt(k,350)*y(k,108) + mat(k,82) = -(rxt(k,511)*y(k,205) + rxt(k,512)*y(k,124)) + mat(k,2025) = -rxt(k,511)*y(k,216) + mat(k,1850) = -rxt(k,512)*y(k,216) + mat(k,942) = rxt(k,514)*y(k,219) + mat(k,1553) = rxt(k,514)*y(k,110) + mat(k,1047) = -(rxt(k,445)*y(k,200) + rxt(k,446)*y(k,205) + rxt(k,447) & + *y(k,124) + rxt(k,448)*y(k,126)) + mat(k,1804) = -rxt(k,445)*y(k,217) + mat(k,2085) = -rxt(k,446)*y(k,217) + mat(k,1894) = -rxt(k,447)*y(k,217) + mat(k,1749) = -rxt(k,448)*y(k,217) + mat(k,1002) = rxt(k,439)*y(k,126) + mat(k,953) = rxt(k,442)*y(k,126) + mat(k,1749) = mat(k,1749) + rxt(k,439)*y(k,6) + rxt(k,442)*y(k,110) & + + .500_r8*rxt(k,459)*y(k,179) + mat(k,395) = rxt(k,449)*y(k,219) + mat(k,972) = .500_r8*rxt(k,459)*y(k,126) + mat(k,1665) = rxt(k,449)*y(k,128) + mat(k,1528) = -(rxt(k,125)*y(k,77) + rxt(k,126)*y(k,231) + rxt(k,129) & + *y(k,135) + (rxt(k,167) + rxt(k,168)) * y(k,113) + rxt(k,200) & + *y(k,33) + rxt(k,201)*y(k,34) + rxt(k,202)*y(k,36) + rxt(k,203) & + *y(k,37) + rxt(k,204)*y(k,38) + rxt(k,205)*y(k,39) + rxt(k,206) & + *y(k,40) + (rxt(k,207) + rxt(k,208)) * y(k,85) + rxt(k,227) & + *y(k,35) + rxt(k,228)*y(k,55) + rxt(k,229)*y(k,78) + (rxt(k,230) & + + rxt(k,231)) * y(k,81) + rxt(k,236)*y(k,64) + rxt(k,237) & + *y(k,65) + rxt(k,250)*y(k,41) + rxt(k,251)*y(k,43) + rxt(k,252) & + *y(k,82) + rxt(k,253)*y(k,83) + rxt(k,254)*y(k,84) + (rxt(k,271) & + + rxt(k,272) + rxt(k,273)) * y(k,54) + rxt(k,274)*y(k,86)) + mat(k,1407) = -rxt(k,125)*y(k,218) + mat(k,2274) = -rxt(k,126)*y(k,218) + mat(k,2248) = -rxt(k,129)*y(k,218) + mat(k,186) = -(rxt(k,167) + rxt(k,168)) * y(k,218) + mat(k,102) = -rxt(k,200)*y(k,218) + mat(k,146) = -rxt(k,201)*y(k,218) + mat(k,117) = -rxt(k,202)*y(k,218) + mat(k,156) = -rxt(k,203)*y(k,218) + mat(k,121) = -rxt(k,204)*y(k,218) + mat(k,161) = -rxt(k,205)*y(k,218) + mat(k,125) = -rxt(k,206)*y(k,218) + mat(k,2132) = -(rxt(k,207) + rxt(k,208)) * y(k,218) + mat(k,152) = -rxt(k,227)*y(k,218) + mat(k,389) = -rxt(k,228)*y(k,218) + mat(k,110) = -rxt(k,229)*y(k,218) + mat(k,809) = -(rxt(k,230) + rxt(k,231)) * y(k,218) + mat(k,242) = -rxt(k,236)*y(k,218) + mat(k,250) = -rxt(k,237)*y(k,218) + mat(k,471) = -rxt(k,250)*y(k,218) + mat(k,598) = -rxt(k,251)*y(k,218) + mat(k,245) = -rxt(k,252)*y(k,218) + mat(k,255) = -rxt(k,253)*y(k,218) + mat(k,302) = -rxt(k,254)*y(k,218) + mat(k,1436) = -(rxt(k,271) + rxt(k,272) + rxt(k,273)) * y(k,218) + mat(k,182) = -rxt(k,274)*y(k,218) + mat(k,1693) = -(rxt(k,142)*y(k,77) + rxt(k,143)*y(k,79) + rxt(k,144)*y(k,205) & + + rxt(k,145)*y(k,134) + rxt(k,146)*y(k,135) + (4._r8*rxt(k,147) & + + 4._r8*rxt(k,148)) * y(k,219) + rxt(k,150)*y(k,90) + rxt(k,162) & + *y(k,126) + rxt(k,163)*y(k,112) + rxt(k,171)*y(k,125) + rxt(k,172) & + *y(k,89) + rxt(k,191)*y(k,60) + (rxt(k,193) + rxt(k,194) & + ) * y(k,59) + rxt(k,196)*y(k,85) + rxt(k,199)*y(k,92) + rxt(k,223) & + *y(k,19) + rxt(k,225)*y(k,81) + rxt(k,239)*y(k,41) + rxt(k,241) & + *y(k,43) + rxt(k,242)*y(k,44) + rxt(k,244)*y(k,46) + rxt(k,246) & + *y(k,55) + rxt(k,247)*y(k,82) + rxt(k,248)*y(k,83) + rxt(k,249) & + *y(k,84) + rxt(k,258)*y(k,42) + rxt(k,263)*y(k,52) + rxt(k,264) & + *y(k,53) + rxt(k,265)*y(k,54) + rxt(k,266)*y(k,86) + rxt(k,267) & + *y(k,87) + rxt(k,275)*y(k,62) + rxt(k,277)*y(k,24) + rxt(k,284) & + *y(k,26) + rxt(k,285)*y(k,27) + rxt(k,287)*y(k,28) + rxt(k,289) & + *y(k,45) + rxt(k,290)*y(k,47) + rxt(k,295)*y(k,50) + rxt(k,296) & + *y(k,51) + rxt(k,301)*y(k,74) + rxt(k,302)*y(k,75) + rxt(k,303) & + *y(k,140) + rxt(k,304)*y(k,25) + rxt(k,312)*y(k,30) + rxt(k,313) & + *y(k,31) + rxt(k,315)*y(k,49) + rxt(k,316)*y(k,95) + rxt(k,317) & + *y(k,127) + rxt(k,320)*y(k,147) + rxt(k,324)*y(k,148) + rxt(k,325) & + *y(k,29) + rxt(k,326)*y(k,48) + rxt(k,328)*y(k,16) + rxt(k,331) & + *y(k,93) + rxt(k,339)*y(k,105) + rxt(k,340)*y(k,106) + rxt(k,349) & + *y(k,107) + rxt(k,350)*y(k,108) + rxt(k,351)*y(k,109) + rxt(k,353) & + *y(k,111) + rxt(k,356)*y(k,1) + rxt(k,360)*y(k,2) + rxt(k,361) & + *y(k,15) + rxt(k,362)*y(k,94) + rxt(k,363)*y(k,96) + rxt(k,364) & + *y(k,97) + rxt(k,376)*y(k,99) + rxt(k,377)*y(k,100) + rxt(k,384) & + *y(k,102) + rxt(k,386)*y(k,98) + rxt(k,387)*y(k,103) + rxt(k,388) & + *y(k,115) + rxt(k,389)*y(k,116) + rxt(k,395)*y(k,183) + rxt(k,398) & + *y(k,7) + rxt(k,401)*y(k,8) + rxt(k,402)*y(k,22) + rxt(k,404) & + *y(k,23) + rxt(k,408)*y(k,32) + rxt(k,409)*y(k,66) + rxt(k,421) & + *y(k,143) + rxt(k,424)*y(k,144) + rxt(k,428)*y(k,181) + rxt(k,429) & + *y(k,182) + rxt(k,431)*y(k,184) + rxt(k,434)*y(k,185) + rxt(k,437) & + *y(k,186) + rxt(k,438)*y(k,187) + rxt(k,441)*y(k,6) + rxt(k,444) & + *y(k,110) + rxt(k,449)*y(k,128) + rxt(k,453)*y(k,176) + rxt(k,454) & + *y(k,177) + rxt(k,458)*y(k,178) + rxt(k,460)*y(k,179) + rxt(k,461) & + *y(k,180) + (rxt(k,463) + rxt(k,477)) * y(k,67) + rxt(k,465) & + *y(k,138) + rxt(k,467)*y(k,152) + rxt(k,471)*y(k,149) + rxt(k,476) & + *y(k,151) + rxt(k,479)*y(k,120)) + mat(k,1408) = -rxt(k,142)*y(k,219) + mat(k,606) = -rxt(k,143)*y(k,219) + mat(k,2110) = -rxt(k,144)*y(k,219) + mat(k,2188) = -rxt(k,145)*y(k,219) + mat(k,2249) = -rxt(k,146)*y(k,219) + mat(k,424) = -rxt(k,150)*y(k,219) + mat(k,1776) = -rxt(k,162)*y(k,219) + mat(k,496) = -rxt(k,163)*y(k,219) + mat(k,1964) = -rxt(k,171)*y(k,219) + mat(k,1468) = -rxt(k,172)*y(k,219) + mat(k,903) = -rxt(k,191)*y(k,219) + mat(k,1719) = -(rxt(k,193) + rxt(k,194)) * y(k,219) + mat(k,2133) = -rxt(k,196)*y(k,219) + mat(k,816) = -rxt(k,199)*y(k,219) + mat(k,2157) = -rxt(k,223)*y(k,219) + mat(k,810) = -rxt(k,225)*y(k,219) + mat(k,472) = -rxt(k,239)*y(k,219) + mat(k,599) = -rxt(k,241)*y(k,219) + mat(k,128) = -rxt(k,242)*y(k,219) + mat(k,369) = -rxt(k,244)*y(k,219) + mat(k,390) = -rxt(k,246)*y(k,219) + mat(k,246) = -rxt(k,247)*y(k,219) + mat(k,256) = -rxt(k,248)*y(k,219) + mat(k,303) = -rxt(k,249)*y(k,219) + mat(k,1489) = -rxt(k,258)*y(k,219) + mat(k,801) = -rxt(k,263)*y(k,219) + mat(k,459) = -rxt(k,264)*y(k,219) + mat(k,1437) = -rxt(k,265)*y(k,219) + mat(k,183) = -rxt(k,266)*y(k,219) + mat(k,933) = -rxt(k,267)*y(k,219) + mat(k,1126) = -rxt(k,275)*y(k,219) + mat(k,297) = -rxt(k,277)*y(k,219) + mat(k,265) = -rxt(k,284)*y(k,219) + mat(k,346) = -rxt(k,285)*y(k,219) + mat(k,308) = -rxt(k,287)*y(k,219) + mat(k,1091) = -rxt(k,289)*y(k,219) + mat(k,105) = -rxt(k,290)*y(k,219) + mat(k,688) = -rxt(k,295)*y(k,219) + mat(k,616) = -rxt(k,296)*y(k,219) + mat(k,1101) = -rxt(k,301)*y(k,219) + mat(k,983) = -rxt(k,302)*y(k,219) + mat(k,530) = -rxt(k,303)*y(k,219) + mat(k,555) = -rxt(k,304)*y(k,219) + mat(k,414) = -rxt(k,312)*y(k,219) + mat(k,113) = -rxt(k,313)*y(k,219) + mat(k,1226) = -rxt(k,315)*y(k,219) + mat(k,1146) = -rxt(k,316)*y(k,219) + mat(k,863) = -rxt(k,317)*y(k,219) + mat(k,547) = -rxt(k,320)*y(k,219) + mat(k,403) = -rxt(k,324)*y(k,219) + mat(k,1034) = -rxt(k,325)*y(k,219) + mat(k,927) = -rxt(k,326)*y(k,219) + mat(k,356) = -rxt(k,328)*y(k,219) + mat(k,1160) = -rxt(k,331)*y(k,219) + mat(k,1217) = -rxt(k,339)*y(k,219) + mat(k,315) = -rxt(k,340)*y(k,219) + mat(k,512) = -rxt(k,349)*y(k,219) + mat(k,321) = -rxt(k,350)*y(k,219) + mat(k,579) = -rxt(k,351)*y(k,219) + mat(k,1340) = -rxt(k,353)*y(k,219) + mat(k,641) = -rxt(k,356)*y(k,219) + mat(k,676) = -rxt(k,360)*y(k,219) + mat(k,230) = -rxt(k,361)*y(k,219) + mat(k,226) = -rxt(k,362)*y(k,219) + mat(k,350) = -rxt(k,363)*y(k,219) + mat(k,139) = -rxt(k,364)*y(k,219) + mat(k,589) = -rxt(k,376)*y(k,219) + mat(k,540) = -rxt(k,377)*y(k,219) + mat(k,408) = -rxt(k,384)*y(k,219) + mat(k,847) = -rxt(k,386)*y(k,219) + mat(k,742) = -rxt(k,387)*y(k,219) + mat(k,379) = -rxt(k,388)*y(k,219) + mat(k,1081) = -rxt(k,389)*y(k,219) + mat(k,207) = -rxt(k,395)*y(k,219) + mat(k,168) = -rxt(k,398)*y(k,219) + mat(k,421) = -rxt(k,401)*y(k,219) + mat(k,239) = -rxt(k,402)*y(k,219) + mat(k,341) = -rxt(k,404)*y(k,219) + mat(k,270) = -rxt(k,408)*y(k,219) + mat(k,199) = -rxt(k,409)*y(k,219) + mat(k,177) = -rxt(k,421)*y(k,219) + mat(k,335) = -rxt(k,424)*y(k,219) + mat(k,665) = -rxt(k,428)*y(k,219) + mat(k,194) = -rxt(k,429)*y(k,219) + mat(k,216) = -rxt(k,431)*y(k,219) + mat(k,704) = -rxt(k,434)*y(k,219) + mat(k,221) = -rxt(k,437)*y(k,219) + mat(k,433) = -rxt(k,438)*y(k,219) + mat(k,1012) = -rxt(k,441)*y(k,219) + mat(k,962) = -rxt(k,444)*y(k,219) + mat(k,397) = -rxt(k,449)*y(k,219) + mat(k,652) = -rxt(k,453)*y(k,219) + mat(k,622) = -rxt(k,454)*y(k,219) + mat(k,481) = -rxt(k,458)*y(k,219) + mat(k,976) = -rxt(k,460)*y(k,219) + mat(k,1066) = -rxt(k,461)*y(k,219) + mat(k,287) = -(rxt(k,463) + rxt(k,477)) * y(k,219) + mat(k,365) = -rxt(k,465)*y(k,219) + mat(k,855) = -rxt(k,467)*y(k,219) + mat(k,516) = -rxt(k,471)*y(k,219) + mat(k,1237) = -rxt(k,476)*y(k,219) + mat(k,99) = -rxt(k,479)*y(k,219) + mat(k,1012) = mat(k,1012) + .630_r8*rxt(k,440)*y(k,135) + mat(k,297) = mat(k,297) + .650_r8*rxt(k,277)*y(k,219) + mat(k,555) = mat(k,555) + .130_r8*rxt(k,279)*y(k,135) + mat(k,346) = mat(k,346) + .500_r8*rxt(k,285)*y(k,219) + mat(k,1034) = mat(k,1034) + .360_r8*rxt(k,308)*y(k,135) + mat(k,1489) = mat(k,1489) + rxt(k,257)*y(k,134) + mat(k,459) = mat(k,459) + .300_r8*rxt(k,264)*y(k,219) + mat(k,1437) = mat(k,1437) + rxt(k,271)*y(k,218) + mat(k,2003) = rxt(k,180)*y(k,205) + mat(k,871) = rxt(k,234)*y(k,231) + mat(k,1451) = rxt(k,141)*y(k,135) + 2.000_r8*rxt(k,136)*y(k,205) + mat(k,1408) = mat(k,1408) + rxt(k,133)*y(k,134) + rxt(k,125)*y(k,218) + mat(k,606) = mat(k,606) + rxt(k,134)*y(k,134) + mat(k,810) = mat(k,810) + rxt(k,224)*y(k,134) + rxt(k,230)*y(k,218) + mat(k,2133) = mat(k,2133) + rxt(k,195)*y(k,134) + rxt(k,207)*y(k,218) + mat(k,183) = mat(k,183) + rxt(k,274)*y(k,218) + mat(k,782) = rxt(k,226)*y(k,134) + mat(k,816) = mat(k,816) + rxt(k,198)*y(k,134) + mat(k,847) = mat(k,847) + .320_r8*rxt(k,385)*y(k,135) + mat(k,742) = mat(k,742) + .600_r8*rxt(k,387)*y(k,219) + mat(k,1217) = mat(k,1217) + .240_r8*rxt(k,338)*y(k,135) + mat(k,315) = mat(k,315) + .100_r8*rxt(k,340)*y(k,219) + mat(k,962) = mat(k,962) + .630_r8*rxt(k,443)*y(k,135) + mat(k,1340) = mat(k,1340) + .360_r8*rxt(k,352)*y(k,135) + mat(k,1920) = rxt(k,164)*y(k,205) + mat(k,1776) = mat(k,1776) + rxt(k,159)*y(k,205) + mat(k,2188) = mat(k,2188) + rxt(k,257)*y(k,42) + rxt(k,133)*y(k,77) & + + rxt(k,134)*y(k,79) + rxt(k,224)*y(k,81) + rxt(k,195)*y(k,85) & + + rxt(k,226)*y(k,91) + rxt(k,198)*y(k,92) + rxt(k,139)*y(k,205) + mat(k,2249) = mat(k,2249) + .630_r8*rxt(k,440)*y(k,6) + .130_r8*rxt(k,279) & + *y(k,25) + .360_r8*rxt(k,308)*y(k,29) + rxt(k,141)*y(k,76) & + + .320_r8*rxt(k,385)*y(k,98) + .240_r8*rxt(k,338)*y(k,105) & + + .630_r8*rxt(k,443)*y(k,110) + .360_r8*rxt(k,352)*y(k,111) & + + rxt(k,140)*y(k,205) + mat(k,547) = mat(k,547) + .500_r8*rxt(k,320)*y(k,219) + mat(k,207) = mat(k,207) + .500_r8*rxt(k,395)*y(k,219) + mat(k,522) = .400_r8*rxt(k,396)*y(k,205) + mat(k,1392) = .450_r8*rxt(k,293)*y(k,205) + mat(k,764) = .400_r8*rxt(k,410)*y(k,205) + mat(k,2110) = mat(k,2110) + rxt(k,180)*y(k,56) + 2.000_r8*rxt(k,136)*y(k,76) & + + rxt(k,164)*y(k,124) + rxt(k,159)*y(k,126) + rxt(k,139) & + *y(k,134) + rxt(k,140)*y(k,135) + .400_r8*rxt(k,396)*y(k,190) & + + .450_r8*rxt(k,293)*y(k,199) + .400_r8*rxt(k,410)*y(k,201) & + + .450_r8*rxt(k,343)*y(k,213) + .400_r8*rxt(k,416)*y(k,214) & + + .200_r8*rxt(k,347)*y(k,215) + .150_r8*rxt(k,322)*y(k,222) + mat(k,1360) = .450_r8*rxt(k,343)*y(k,205) + mat(k,879) = .400_r8*rxt(k,416)*y(k,205) + mat(k,682) = .200_r8*rxt(k,347)*y(k,205) + mat(k,1529) = rxt(k,271)*y(k,54) + rxt(k,125)*y(k,77) + rxt(k,230)*y(k,81) & + + rxt(k,207)*y(k,85) + rxt(k,274)*y(k,86) + 2.000_r8*rxt(k,126) & + *y(k,231) + mat(k,1693) = mat(k,1693) + .650_r8*rxt(k,277)*y(k,24) + .500_r8*rxt(k,285) & + *y(k,27) + .300_r8*rxt(k,264)*y(k,53) + .600_r8*rxt(k,387) & + *y(k,103) + .100_r8*rxt(k,340)*y(k,106) + .500_r8*rxt(k,320) & + *y(k,147) + .500_r8*rxt(k,395)*y(k,183) + mat(k,1136) = .150_r8*rxt(k,322)*y(k,205) + mat(k,2275) = rxt(k,234)*y(k,73) + 2.000_r8*rxt(k,126)*y(k,218) + end do + end subroutine nlnmat09 + subroutine nlnmat10( 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,450) = -(rxt(k,419)*y(k,205) + rxt(k,420)*y(k,124)) + mat(k,2046) = -rxt(k,419)*y(k,220) + mat(k,1861) = -rxt(k,420)*y(k,220) + mat(k,197) = .200_r8*rxt(k,409)*y(k,219) + mat(k,175) = .140_r8*rxt(k,421)*y(k,219) + mat(k,333) = rxt(k,424)*y(k,219) + mat(k,1605) = .200_r8*rxt(k,409)*y(k,66) + .140_r8*rxt(k,421)*y(k,143) & + + rxt(k,424)*y(k,144) + mat(k,770) = -(rxt(k,318)*y(k,205) + rxt(k,319)*y(k,124)) + mat(k,2070) = -rxt(k,318)*y(k,221) + mat(k,1882) = -rxt(k,319)*y(k,221) + mat(k,1022) = rxt(k,325)*y(k,219) + mat(k,543) = .500_r8*rxt(k,320)*y(k,219) + mat(k,1643) = rxt(k,325)*y(k,29) + .500_r8*rxt(k,320)*y(k,147) + mat(k,1131) = -(rxt(k,321)*y(k,200) + rxt(k,322)*y(k,205) + rxt(k,323) & + *y(k,124)) + mat(k,1811) = -rxt(k,321)*y(k,222) + mat(k,2091) = -rxt(k,322)*y(k,222) + mat(k,1901) = -rxt(k,323)*y(k,222) + mat(k,1007) = .060_r8*rxt(k,440)*y(k,135) + mat(k,925) = rxt(k,326)*y(k,219) + mat(k,957) = .060_r8*rxt(k,443)*y(k,135) + mat(k,2231) = .060_r8*rxt(k,440)*y(k,6) + .060_r8*rxt(k,443)*y(k,110) + mat(k,400) = rxt(k,324)*y(k,219) + mat(k,1063) = .150_r8*rxt(k,461)*y(k,219) + mat(k,1672) = rxt(k,326)*y(k,48) + rxt(k,324)*y(k,148) + .150_r8*rxt(k,461) & + *y(k,180) + mat(k,1111) = -(rxt(k,450)*y(k,200) + rxt(k,451)*y(k,205) + rxt(k,452) & + *y(k,124)) + mat(k,1809) = -rxt(k,450)*y(k,223) + mat(k,2089) = -rxt(k,451)*y(k,223) + mat(k,1899) = -rxt(k,452)*y(k,223) + mat(k,1754) = .500_r8*rxt(k,459)*y(k,179) + mat(k,649) = rxt(k,453)*y(k,219) + mat(k,974) = .500_r8*rxt(k,459)*y(k,126) + rxt(k,460)*y(k,219) + mat(k,1670) = rxt(k,453)*y(k,176) + rxt(k,460)*y(k,179) + mat(k,914) = -(rxt(k,455)*y(k,200) + rxt(k,456)*y(k,205) + rxt(k,457) & + *y(k,124)) + mat(k,1800) = -rxt(k,455)*y(k,224) + mat(k,2080) = -rxt(k,456)*y(k,224) + mat(k,1889) = -rxt(k,457)*y(k,224) + mat(k,996) = rxt(k,441)*y(k,219) + mat(k,947) = rxt(k,444)*y(k,219) + mat(k,477) = rxt(k,458)*y(k,219) + mat(k,1657) = rxt(k,441)*y(k,6) + rxt(k,444)*y(k,110) + rxt(k,458)*y(k,178) + mat(k,726) = -(rxt(k,426)*y(k,205) + rxt(k,427)*y(k,124)) + mat(k,2066) = -rxt(k,426)*y(k,225) + mat(k,1879) = -rxt(k,427)*y(k,225) + mat(k,659) = rxt(k,428)*y(k,219) + mat(k,193) = .650_r8*rxt(k,429)*y(k,219) + mat(k,1639) = rxt(k,428)*y(k,181) + .650_r8*rxt(k,429)*y(k,182) + mat(k,88) = -(rxt(k,517)*y(k,205) + rxt(k,518)*y(k,124)) + mat(k,2026) = -rxt(k,517)*y(k,226) + mat(k,1851) = -rxt(k,518)*y(k,226) + mat(k,188) = rxt(k,516)*y(k,219) + mat(k,1554) = rxt(k,516)*y(k,182) + mat(k,1175) = -(rxt(k,390)*y(k,199) + rxt(k,391)*y(k,200) + rxt(k,392) & + *y(k,205) + rxt(k,393)*y(k,124) + rxt(k,394)*y(k,126)) + mat(k,1379) = -rxt(k,390)*y(k,227) + mat(k,1813) = -rxt(k,391)*y(k,227) + mat(k,2093) = -rxt(k,392)*y(k,227) + mat(k,1904) = -rxt(k,393)*y(k,227) + mat(k,1759) = -rxt(k,394)*y(k,227) + mat(k,225) = rxt(k,362)*y(k,219) + mat(k,349) = rxt(k,363)*y(k,219) + mat(k,138) = rxt(k,364)*y(k,219) + mat(k,738) = .400_r8*rxt(k,387)*y(k,219) + mat(k,206) = .500_r8*rxt(k,395)*y(k,219) + mat(k,1675) = rxt(k,362)*y(k,94) + rxt(k,363)*y(k,96) + rxt(k,364)*y(k,97) & + + .400_r8*rxt(k,387)*y(k,103) + .500_r8*rxt(k,395)*y(k,183) + mat(k,750) = -(rxt(k,432)*y(k,205) + rxt(k,433)*y(k,124)) + mat(k,2068) = -rxt(k,432)*y(k,228) + mat(k,1880) = -rxt(k,433)*y(k,228) + mat(k,213) = .560_r8*rxt(k,431)*y(k,219) + mat(k,697) = rxt(k,434)*y(k,219) + mat(k,1641) = .560_r8*rxt(k,431)*y(k,184) + rxt(k,434)*y(k,185) + mat(k,94) = -(rxt(k,520)*y(k,205) + rxt(k,521)*y(k,124)) + mat(k,2027) = -rxt(k,520)*y(k,229) + mat(k,1852) = -rxt(k,521)*y(k,229) + mat(k,208) = rxt(k,519)*y(k,219) + mat(k,1555) = rxt(k,519)*y(k,184) + mat(k,501) = -(rxt(k,435)*y(k,205) + rxt(k,436)*y(k,124)) + mat(k,2052) = -rxt(k,435)*y(k,230) + mat(k,1866) = -rxt(k,436)*y(k,230) + mat(k,220) = .300_r8*rxt(k,437)*y(k,219) + mat(k,430) = rxt(k,438)*y(k,219) + mat(k,1613) = .300_r8*rxt(k,437)*y(k,186) + rxt(k,438)*y(k,187) + mat(k,2287) = -(rxt(k,126)*y(k,218) + rxt(k,234)*y(k,73) + rxt(k,478) & + *y(k,153)) + mat(k,1541) = -rxt(k,126)*y(k,231) + mat(k,874) = -rxt(k,234)*y(k,231) + mat(k,262) = -rxt(k,478)*y(k,231) + mat(k,311) = rxt(k,287)*y(k,219) + mat(k,416) = rxt(k,312)*y(k,219) + mat(k,114) = rxt(k,313)*y(k,219) + mat(k,475) = rxt(k,239)*y(k,219) + mat(k,1500) = rxt(k,258)*y(k,219) + mat(k,604) = rxt(k,241)*y(k,219) + mat(k,130) = rxt(k,242)*y(k,219) + mat(k,1095) = rxt(k,289)*y(k,219) + mat(k,374) = rxt(k,244)*y(k,219) + mat(k,929) = rxt(k,326)*y(k,219) + mat(k,1230) = rxt(k,315)*y(k,219) + mat(k,690) = rxt(k,295)*y(k,219) + mat(k,618) = rxt(k,296)*y(k,219) + mat(k,461) = rxt(k,264)*y(k,219) + mat(k,1444) = rxt(k,265)*y(k,219) + mat(k,1459) = rxt(k,137)*y(k,205) + mat(k,1414) = rxt(k,142)*y(k,219) + mat(k,611) = rxt(k,143)*y(k,219) + mat(k,813) = rxt(k,225)*y(k,219) + mat(k,305) = rxt(k,249)*y(k,219) + mat(k,2145) = (rxt(k,530)+rxt(k,535))*y(k,91) + (rxt(k,523)+rxt(k,529) & + +rxt(k,534))*y(k,92) + rxt(k,196)*y(k,219) + mat(k,936) = rxt(k,267)*y(k,219) + mat(k,1477) = rxt(k,172)*y(k,219) + mat(k,428) = rxt(k,150)*y(k,219) + mat(k,787) = (rxt(k,530)+rxt(k,535))*y(k,85) + mat(k,821) = (rxt(k,523)+rxt(k,529)+rxt(k,534))*y(k,85) + rxt(k,199)*y(k,219) + mat(k,1221) = .500_r8*rxt(k,339)*y(k,219) + mat(k,100) = rxt(k,479)*y(k,219) + mat(k,549) = rxt(k,320)*y(k,219) + mat(k,404) = rxt(k,324)*y(k,219) + mat(k,2122) = rxt(k,137)*y(k,76) + rxt(k,144)*y(k,219) + mat(k,1705) = rxt(k,287)*y(k,28) + rxt(k,312)*y(k,30) + rxt(k,313)*y(k,31) & + + rxt(k,239)*y(k,41) + rxt(k,258)*y(k,42) + rxt(k,241)*y(k,43) & + + rxt(k,242)*y(k,44) + rxt(k,289)*y(k,45) + rxt(k,244)*y(k,46) & + + rxt(k,326)*y(k,48) + rxt(k,315)*y(k,49) + rxt(k,295)*y(k,50) & + + rxt(k,296)*y(k,51) + rxt(k,264)*y(k,53) + rxt(k,265)*y(k,54) & + + rxt(k,142)*y(k,77) + rxt(k,143)*y(k,79) + rxt(k,225)*y(k,81) & + + rxt(k,249)*y(k,84) + rxt(k,196)*y(k,85) + rxt(k,267)*y(k,87) & + + rxt(k,172)*y(k,89) + rxt(k,150)*y(k,90) + rxt(k,199)*y(k,92) & + + .500_r8*rxt(k,339)*y(k,105) + rxt(k,479)*y(k,120) + rxt(k,320) & + *y(k,147) + rxt(k,324)*y(k,148) + rxt(k,144)*y(k,205) & + + 2.000_r8*rxt(k,147)*y(k,219) + end do + end subroutine nlnmat10 + 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) = lmat(k, 39) + mat(k, 40) = lmat(k, 40) + mat(k, 41) = lmat(k, 41) + mat(k, 42) = lmat(k, 42) + mat(k, 43) = lmat(k, 43) + mat(k, 44) = lmat(k, 44) + mat(k, 50) = mat(k, 50) + lmat(k, 50) + mat(k, 56) = mat(k, 56) + lmat(k, 56) + mat(k, 62) = mat(k, 62) + lmat(k, 62) + mat(k, 68) = mat(k, 68) + lmat(k, 68) + mat(k, 74) = mat(k, 74) + lmat(k, 74) + mat(k, 76) = mat(k, 76) + lmat(k, 76) + mat(k, 82) = mat(k, 82) + lmat(k, 82) + mat(k, 88) = mat(k, 88) + lmat(k, 88) + mat(k, 94) = mat(k, 94) + lmat(k, 94) + mat(k, 95) = lmat(k, 95) + mat(k, 96) = lmat(k, 96) + mat(k, 97) = lmat(k, 97) + mat(k, 98) = mat(k, 98) + lmat(k, 98) + mat(k, 101) = mat(k, 101) + lmat(k, 101) + mat(k, 103) = mat(k, 103) + lmat(k, 103) + mat(k, 104) = mat(k, 104) + lmat(k, 104) + mat(k, 107) = mat(k, 107) + lmat(k, 107) + mat(k, 108) = mat(k, 108) + lmat(k, 108) + mat(k, 109) = mat(k, 109) + lmat(k, 109) + mat(k, 111) = mat(k, 111) + lmat(k, 111) + mat(k, 115) = mat(k, 115) + lmat(k, 115) + mat(k, 116) = mat(k, 116) + lmat(k, 116) + mat(k, 118) = mat(k, 118) + lmat(k, 118) + mat(k, 119) = mat(k, 119) + lmat(k, 119) + mat(k, 120) = mat(k, 120) + lmat(k, 120) + mat(k, 122) = mat(k, 122) + lmat(k, 122) + mat(k, 123) = mat(k, 123) + lmat(k, 123) + mat(k, 124) = mat(k, 124) + lmat(k, 124) + mat(k, 126) = mat(k, 126) + lmat(k, 126) + mat(k, 127) = mat(k, 127) + lmat(k, 127) + mat(k, 129) = mat(k, 129) + lmat(k, 129) + mat(k, 131) = lmat(k, 131) + mat(k, 132) = lmat(k, 132) + mat(k, 133) = lmat(k, 133) + mat(k, 134) = lmat(k, 134) + mat(k, 135) = lmat(k, 135) + mat(k, 136) = lmat(k, 136) + mat(k, 137) = mat(k, 137) + lmat(k, 137) + mat(k, 140) = lmat(k, 140) + mat(k, 141) = lmat(k, 141) + mat(k, 142) = lmat(k, 142) + mat(k, 143) = mat(k, 143) + lmat(k, 143) + mat(k, 144) = mat(k, 144) + lmat(k, 144) + mat(k, 145) = mat(k, 145) + lmat(k, 145) + mat(k, 147) = mat(k, 147) + lmat(k, 147) + mat(k, 148) = mat(k, 148) + lmat(k, 148) + mat(k, 149) = mat(k, 149) + lmat(k, 149) + mat(k, 150) = mat(k, 150) + lmat(k, 150) + mat(k, 151) = mat(k, 151) + lmat(k, 151) + mat(k, 153) = mat(k, 153) + lmat(k, 153) + mat(k, 154) = mat(k, 154) + lmat(k, 154) + mat(k, 155) = mat(k, 155) + lmat(k, 155) + mat(k, 157) = mat(k, 157) + lmat(k, 157) + mat(k, 158) = mat(k, 158) + lmat(k, 158) + mat(k, 159) = mat(k, 159) + lmat(k, 159) + mat(k, 160) = mat(k, 160) + lmat(k, 160) + mat(k, 162) = mat(k, 162) + lmat(k, 162) + mat(k, 164) = mat(k, 164) + lmat(k, 164) + mat(k, 170) = lmat(k, 170) + mat(k, 171) = lmat(k, 171) + mat(k, 172) = lmat(k, 172) + mat(k, 173) = lmat(k, 173) + mat(k, 174) = mat(k, 174) + lmat(k, 174) + mat(k, 179) = lmat(k, 179) + mat(k, 180) = lmat(k, 180) + mat(k, 181) = mat(k, 181) + lmat(k, 181) + mat(k, 185) = mat(k, 185) + lmat(k, 185) + mat(k, 186) = mat(k, 186) + lmat(k, 186) + mat(k, 189) = mat(k, 189) + lmat(k, 189) + mat(k, 196) = mat(k, 196) + lmat(k, 196) + mat(k, 201) = lmat(k, 201) + mat(k, 202) = lmat(k, 202) + mat(k, 203) = lmat(k, 203) + mat(k, 204) = lmat(k, 204) + mat(k, 205) = mat(k, 205) + lmat(k, 205) + mat(k, 207) = mat(k, 207) + lmat(k, 207) + mat(k, 210) = mat(k, 210) + lmat(k, 210) + mat(k, 218) = mat(k, 218) + lmat(k, 218) + mat(k, 223) = mat(k, 223) + lmat(k, 223) + mat(k, 224) = lmat(k, 224) + mat(k, 226) = mat(k, 226) + lmat(k, 226) + mat(k, 227) = lmat(k, 227) + mat(k, 228) = mat(k, 228) + lmat(k, 228) + mat(k, 231) = lmat(k, 231) + mat(k, 232) = lmat(k, 232) + mat(k, 233) = lmat(k, 233) + mat(k, 234) = lmat(k, 234) + mat(k, 235) = lmat(k, 235) + mat(k, 236) = lmat(k, 236) + mat(k, 237) = mat(k, 237) + lmat(k, 237) + mat(k, 240) = mat(k, 240) + lmat(k, 240) + mat(k, 241) = mat(k, 241) + lmat(k, 241) + mat(k, 243) = mat(k, 243) + lmat(k, 243) + mat(k, 244) = mat(k, 244) + lmat(k, 244) + mat(k, 247) = mat(k, 247) + lmat(k, 247) + mat(k, 248) = mat(k, 248) + lmat(k, 248) + mat(k, 249) = mat(k, 249) + lmat(k, 249) + mat(k, 251) = mat(k, 251) + lmat(k, 251) + mat(k, 252) = mat(k, 252) + lmat(k, 252) + mat(k, 253) = mat(k, 253) + lmat(k, 253) + mat(k, 257) = mat(k, 257) + lmat(k, 257) + mat(k, 259) = mat(k, 259) + lmat(k, 259) + mat(k, 260) = lmat(k, 260) + mat(k, 261) = lmat(k, 261) + mat(k, 263) = mat(k, 263) + lmat(k, 263) + mat(k, 267) = mat(k, 267) + lmat(k, 267) + mat(k, 268) = lmat(k, 268) + mat(k, 270) = mat(k, 270) + lmat(k, 270) + mat(k, 271) = lmat(k, 271) + mat(k, 272) = lmat(k, 272) + mat(k, 273) = lmat(k, 273) + mat(k, 274) = lmat(k, 274) + mat(k, 275) = lmat(k, 275) + mat(k, 276) = lmat(k, 276) + mat(k, 277) = lmat(k, 277) + mat(k, 278) = lmat(k, 278) + mat(k, 279) = lmat(k, 279) + mat(k, 280) = lmat(k, 280) + mat(k, 281) = lmat(k, 281) + mat(k, 282) = lmat(k, 282) + mat(k, 283) = lmat(k, 283) + mat(k, 284) = mat(k, 284) + lmat(k, 284) + mat(k, 290) = lmat(k, 290) + mat(k, 291) = lmat(k, 291) + mat(k, 292) = lmat(k, 292) + mat(k, 293) = mat(k, 293) + lmat(k, 293) + mat(k, 299) = mat(k, 299) + lmat(k, 299) + mat(k, 300) = mat(k, 300) + lmat(k, 300) + mat(k, 304) = mat(k, 304) + lmat(k, 304) + mat(k, 306) = mat(k, 306) + lmat(k, 306) + mat(k, 312) = mat(k, 312) + lmat(k, 312) + mat(k, 317) = mat(k, 317) + lmat(k, 317) + mat(k, 319) = lmat(k, 319) + mat(k, 320) = lmat(k, 320) + mat(k, 321) = mat(k, 321) + lmat(k, 321) + mat(k, 322) = lmat(k, 322) + mat(k, 323) = lmat(k, 323) + mat(k, 324) = lmat(k, 324) + mat(k, 325) = lmat(k, 325) + mat(k, 326) = lmat(k, 326) + mat(k, 327) = mat(k, 327) + lmat(k, 327) + mat(k, 330) = mat(k, 330) + lmat(k, 330) + mat(k, 331) = lmat(k, 331) + mat(k, 332) = mat(k, 332) + lmat(k, 332) + mat(k, 334) = lmat(k, 334) + mat(k, 335) = mat(k, 335) + lmat(k, 335) + mat(k, 336) = lmat(k, 336) + mat(k, 337) = lmat(k, 337) + mat(k, 338) = mat(k, 338) + lmat(k, 338) + mat(k, 341) = mat(k, 341) + lmat(k, 341) + mat(k, 342) = lmat(k, 342) + mat(k, 343) = mat(k, 343) + lmat(k, 343) + mat(k, 345) = mat(k, 345) + lmat(k, 345) + mat(k, 346) = mat(k, 346) + lmat(k, 346) + mat(k, 347) = lmat(k, 347) + mat(k, 348) = mat(k, 348) + lmat(k, 348) + mat(k, 351) = mat(k, 351) + lmat(k, 351) + mat(k, 359) = mat(k, 359) + lmat(k, 359) + mat(k, 360) = lmat(k, 360) + mat(k, 362) = mat(k, 362) + lmat(k, 362) + mat(k, 367) = mat(k, 367) + lmat(k, 367) + mat(k, 370) = lmat(k, 370) + mat(k, 371) = mat(k, 371) + lmat(k, 371) + mat(k, 375) = mat(k, 375) + lmat(k, 375) + mat(k, 378) = lmat(k, 378) + mat(k, 381) = lmat(k, 381) + mat(k, 382) = lmat(k, 382) + mat(k, 383) = lmat(k, 383) + mat(k, 384) = lmat(k, 384) + mat(k, 385) = lmat(k, 385) + mat(k, 386) = lmat(k, 386) + mat(k, 387) = mat(k, 387) + lmat(k, 387) + mat(k, 388) = mat(k, 388) + lmat(k, 388) + mat(k, 393) = mat(k, 393) + lmat(k, 393) + mat(k, 394) = lmat(k, 394) + mat(k, 396) = lmat(k, 396) + mat(k, 397) = mat(k, 397) + lmat(k, 397) + mat(k, 398) = lmat(k, 398) + mat(k, 399) = mat(k, 399) + lmat(k, 399) + mat(k, 401) = lmat(k, 401) + mat(k, 402) = lmat(k, 402) + mat(k, 403) = mat(k, 403) + lmat(k, 403) + mat(k, 405) = mat(k, 405) + lmat(k, 405) + mat(k, 406) = lmat(k, 406) + mat(k, 409) = lmat(k, 409) + mat(k, 410) = mat(k, 410) + lmat(k, 410) + mat(k, 411) = mat(k, 411) + lmat(k, 411) + mat(k, 413) = lmat(k, 413) + mat(k, 414) = mat(k, 414) + lmat(k, 414) + mat(k, 415) = lmat(k, 415) + mat(k, 417) = mat(k, 417) + lmat(k, 417) + mat(k, 418) = lmat(k, 418) + mat(k, 420) = lmat(k, 420) + mat(k, 421) = mat(k, 421) + lmat(k, 421) + mat(k, 422) = lmat(k, 422) + mat(k, 423) = mat(k, 423) + lmat(k, 423) + mat(k, 424) = mat(k, 424) + lmat(k, 424) + mat(k, 425) = lmat(k, 425) + mat(k, 426) = mat(k, 426) + lmat(k, 426) + mat(k, 427) = lmat(k, 427) + mat(k, 429) = mat(k, 429) + lmat(k, 429) + mat(k, 431) = lmat(k, 431) + mat(k, 432) = lmat(k, 432) + mat(k, 433) = mat(k, 433) + lmat(k, 433) + mat(k, 434) = lmat(k, 434) + mat(k, 437) = mat(k, 437) + lmat(k, 437) + mat(k, 443) = mat(k, 443) + lmat(k, 443) + mat(k, 445) = lmat(k, 445) + mat(k, 448) = mat(k, 448) + lmat(k, 448) + mat(k, 450) = mat(k, 450) + lmat(k, 450) + mat(k, 456) = mat(k, 456) + lmat(k, 456) + mat(k, 457) = lmat(k, 457) + mat(k, 458) = mat(k, 458) + lmat(k, 458) + mat(k, 459) = mat(k, 459) + lmat(k, 459) + mat(k, 462) = lmat(k, 462) + mat(k, 463) = lmat(k, 463) + mat(k, 464) = lmat(k, 464) + mat(k, 465) = mat(k, 465) + lmat(k, 465) + mat(k, 469) = mat(k, 469) + lmat(k, 469) + mat(k, 470) = mat(k, 470) + lmat(k, 470) + mat(k, 476) = mat(k, 476) + lmat(k, 476) + mat(k, 478) = lmat(k, 478) + mat(k, 479) = lmat(k, 479) + mat(k, 480) = lmat(k, 480) + mat(k, 481) = mat(k, 481) + lmat(k, 481) + mat(k, 482) = lmat(k, 482) + mat(k, 485) = mat(k, 485) + lmat(k, 485) + mat(k, 493) = mat(k, 493) + lmat(k, 493) + mat(k, 497) = mat(k, 497) + lmat(k, 497) + mat(k, 499) = mat(k, 499) + lmat(k, 499) + mat(k, 501) = mat(k, 501) + lmat(k, 501) + mat(k, 508) = mat(k, 508) + lmat(k, 508) + mat(k, 510) = lmat(k, 510) + mat(k, 511) = lmat(k, 511) + mat(k, 513) = mat(k, 513) + lmat(k, 513) + mat(k, 514) = mat(k, 514) + lmat(k, 514) + mat(k, 517) = lmat(k, 517) + mat(k, 520) = mat(k, 520) + lmat(k, 520) + mat(k, 526) = mat(k, 526) + lmat(k, 526) + mat(k, 527) = lmat(k, 527) + mat(k, 528) = lmat(k, 528) + mat(k, 531) = mat(k, 531) + lmat(k, 531) + mat(k, 532) = lmat(k, 532) + mat(k, 533) = lmat(k, 533) + mat(k, 534) = mat(k, 534) + lmat(k, 534) + mat(k, 539) = lmat(k, 539) + mat(k, 542) = mat(k, 542) + lmat(k, 542) + mat(k, 544) = lmat(k, 544) + mat(k, 546) = lmat(k, 546) + mat(k, 547) = mat(k, 547) + lmat(k, 547) + mat(k, 548) = lmat(k, 548) + mat(k, 550) = mat(k, 550) + lmat(k, 550) + mat(k, 558) = mat(k, 558) + lmat(k, 558) + mat(k, 559) = lmat(k, 559) + mat(k, 560) = lmat(k, 560) + mat(k, 561) = lmat(k, 561) + mat(k, 562) = mat(k, 562) + lmat(k, 562) + mat(k, 563) = lmat(k, 563) + mat(k, 564) = mat(k, 564) + lmat(k, 564) + mat(k, 566) = mat(k, 566) + lmat(k, 566) + mat(k, 574) = mat(k, 574) + lmat(k, 574) + mat(k, 577) = lmat(k, 577) + mat(k, 581) = lmat(k, 581) + mat(k, 583) = mat(k, 583) + lmat(k, 583) + mat(k, 587) = lmat(k, 587) + mat(k, 592) = lmat(k, 592) + mat(k, 593) = lmat(k, 593) + mat(k, 594) = lmat(k, 594) + mat(k, 595) = lmat(k, 595) + mat(k, 596) = mat(k, 596) + lmat(k, 596) + mat(k, 597) = mat(k, 597) + lmat(k, 597) + mat(k, 600) = lmat(k, 600) + mat(k, 605) = mat(k, 605) + lmat(k, 605) + mat(k, 606) = mat(k, 606) + lmat(k, 606) + mat(k, 612) = mat(k, 612) + lmat(k, 612) + mat(k, 613) = mat(k, 613) + lmat(k, 613) + mat(k, 616) = mat(k, 616) + lmat(k, 616) + mat(k, 617) = lmat(k, 617) + mat(k, 619) = mat(k, 619) + lmat(k, 619) + mat(k, 620) = mat(k, 620) + lmat(k, 620) + mat(k, 621) = lmat(k, 621) + mat(k, 623) = mat(k, 623) + lmat(k, 623) + mat(k, 624) = lmat(k, 624) + mat(k, 627) = mat(k, 627) + lmat(k, 627) + mat(k, 633) = lmat(k, 633) + mat(k, 634) = mat(k, 634) + lmat(k, 634) + mat(k, 637) = mat(k, 637) + lmat(k, 637) + mat(k, 638) = mat(k, 638) + lmat(k, 638) + mat(k, 640) = mat(k, 640) + lmat(k, 640) + mat(k, 642) = mat(k, 642) + lmat(k, 642) + mat(k, 643) = lmat(k, 643) + mat(k, 644) = mat(k, 644) + lmat(k, 644) + mat(k, 645) = lmat(k, 645) + mat(k, 646) = lmat(k, 646) + mat(k, 647) = lmat(k, 647) + mat(k, 648) = lmat(k, 648) + mat(k, 650) = lmat(k, 650) + mat(k, 651) = lmat(k, 651) + mat(k, 652) = mat(k, 652) + lmat(k, 652) + mat(k, 653) = lmat(k, 653) + mat(k, 654) = lmat(k, 654) + mat(k, 655) = lmat(k, 655) + mat(k, 656) = lmat(k, 656) + mat(k, 657) = mat(k, 657) + lmat(k, 657) + mat(k, 662) = lmat(k, 662) + mat(k, 664) = lmat(k, 664) + mat(k, 665) = mat(k, 665) + lmat(k, 665) + mat(k, 666) = lmat(k, 666) + mat(k, 667) = lmat(k, 667) + mat(k, 668) = mat(k, 668) + lmat(k, 668) + mat(k, 672) = lmat(k, 672) + mat(k, 673) = lmat(k, 673) + mat(k, 675) = lmat(k, 675) + mat(k, 676) = mat(k, 676) + lmat(k, 676) + mat(k, 677) = lmat(k, 677) + mat(k, 679) = mat(k, 679) + lmat(k, 679) + mat(k, 686) = mat(k, 686) + lmat(k, 686) + mat(k, 691) = lmat(k, 691) + mat(k, 692) = lmat(k, 692) + mat(k, 693) = lmat(k, 693) + mat(k, 694) = lmat(k, 694) + mat(k, 695) = mat(k, 695) + lmat(k, 695) + mat(k, 700) = lmat(k, 700) + mat(k, 702) = lmat(k, 702) + mat(k, 704) = mat(k, 704) + lmat(k, 704) + mat(k, 705) = lmat(k, 705) + mat(k, 708) = mat(k, 708) + lmat(k, 708) + mat(k, 715) = mat(k, 715) + lmat(k, 715) + mat(k, 726) = mat(k, 726) + lmat(k, 726) + mat(k, 737) = mat(k, 737) + lmat(k, 737) + mat(k, 739) = lmat(k, 739) + mat(k, 740) = lmat(k, 740) + mat(k, 741) = lmat(k, 741) + mat(k, 742) = mat(k, 742) + lmat(k, 742) + mat(k, 743) = lmat(k, 743) + mat(k, 750) = mat(k, 750) + lmat(k, 750) + mat(k, 761) = mat(k, 761) + lmat(k, 761) + mat(k, 770) = mat(k, 770) + lmat(k, 770) + 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, 789) = mat(k, 789) + lmat(k, 789) + mat(k, 799) = mat(k, 799) + lmat(k, 799) + mat(k, 803) = lmat(k, 803) + mat(k, 804) = lmat(k, 804) + mat(k, 805) = lmat(k, 805) + mat(k, 806) = mat(k, 806) + lmat(k, 806) + mat(k, 807) = mat(k, 807) + lmat(k, 807) + mat(k, 808) = mat(k, 808) + lmat(k, 808) + mat(k, 815) = mat(k, 815) + lmat(k, 815) + mat(k, 816) = mat(k, 816) + lmat(k, 816) + mat(k, 818) = mat(k, 818) + lmat(k, 818) + mat(k, 825) = mat(k, 825) + lmat(k, 825) + mat(k, 836) = mat(k, 836) + lmat(k, 836) + mat(k, 853) = mat(k, 853) + lmat(k, 853) + mat(k, 854) = lmat(k, 854) + mat(k, 857) = lmat(k, 857) + mat(k, 859) = mat(k, 859) + lmat(k, 859) + mat(k, 861) = lmat(k, 861) + mat(k, 862) = lmat(k, 862) + mat(k, 864) = mat(k, 864) + lmat(k, 864) + mat(k, 866) = mat(k, 866) + lmat(k, 866) + mat(k, 875) = mat(k, 875) + lmat(k, 875) + mat(k, 889) = mat(k, 889) + lmat(k, 889) + mat(k, 900) = mat(k, 900) + lmat(k, 900) + mat(k, 901) = mat(k, 901) + lmat(k, 901) + mat(k, 902) = mat(k, 902) + lmat(k, 902) + mat(k, 904) = mat(k, 904) + lmat(k, 904) + mat(k, 905) = mat(k, 905) + lmat(k, 905) + mat(k, 906) = lmat(k, 906) + mat(k, 907) = mat(k, 907) + lmat(k, 907) + mat(k, 914) = mat(k, 914) + lmat(k, 914) + mat(k, 924) = mat(k, 924) + lmat(k, 924) + mat(k, 926) = lmat(k, 926) + mat(k, 928) = lmat(k, 928) + mat(k, 931) = mat(k, 931) + lmat(k, 931) + mat(k, 950) = mat(k, 950) + lmat(k, 950) + mat(k, 971) = mat(k, 971) + lmat(k, 971) + mat(k, 973) = lmat(k, 973) + mat(k, 975) = lmat(k, 975) + mat(k, 978) = lmat(k, 978) + mat(k, 979) = lmat(k, 979) + mat(k, 981) = mat(k, 981) + lmat(k, 981) + mat(k, 982) = mat(k, 982) + lmat(k, 982) + mat(k, 984) = mat(k, 984) + lmat(k, 984) + mat(k,1001) = mat(k,1001) + lmat(k,1001) + mat(k,1026) = mat(k,1026) + lmat(k,1026) + mat(k,1047) = mat(k,1047) + lmat(k,1047) + mat(k,1059) = mat(k,1059) + lmat(k,1059) + mat(k,1060) = mat(k,1060) + lmat(k,1060) + mat(k,1061) = mat(k,1061) + lmat(k,1061) + mat(k,1062) = mat(k,1062) + lmat(k,1062) + mat(k,1063) = mat(k,1063) + lmat(k,1063) + mat(k,1064) = mat(k,1064) + lmat(k,1064) + mat(k,1065) = mat(k,1065) + lmat(k,1065) + mat(k,1068) = mat(k,1068) + lmat(k,1068) + mat(k,1071) = lmat(k,1071) + mat(k,1075) = mat(k,1075) + lmat(k,1075) + mat(k,1079) = lmat(k,1079) + mat(k,1084) = lmat(k,1084) + mat(k,1085) = mat(k,1085) + lmat(k,1085) + mat(k,1087) = mat(k,1087) + lmat(k,1087) + mat(k,1088) = lmat(k,1088) + mat(k,1093) = lmat(k,1093) + mat(k,1094) = lmat(k,1094) + mat(k,1098) = mat(k,1098) + lmat(k,1098) + mat(k,1099) = lmat(k,1099) + mat(k,1100) = mat(k,1100) + lmat(k,1100) + mat(k,1102) = mat(k,1102) + lmat(k,1102) + mat(k,1111) = mat(k,1111) + lmat(k,1111) + mat(k,1125) = mat(k,1125) + lmat(k,1125) + mat(k,1131) = mat(k,1131) + lmat(k,1131) + mat(k,1142) = mat(k,1142) + lmat(k,1142) + mat(k,1144) = lmat(k,1144) + mat(k,1145) = lmat(k,1145) + mat(k,1147) = mat(k,1147) + lmat(k,1147) + mat(k,1149) = lmat(k,1149) + mat(k,1150) = lmat(k,1150) + mat(k,1151) = lmat(k,1151) + mat(k,1152) = lmat(k,1152) + mat(k,1154) = lmat(k,1154) + mat(k,1155) = mat(k,1155) + lmat(k,1155) + mat(k,1157) = lmat(k,1157) + mat(k,1158) = lmat(k,1158) + mat(k,1159) = lmat(k,1159) + mat(k,1164) = lmat(k,1164) + mat(k,1165) = mat(k,1165) + lmat(k,1165) + mat(k,1175) = mat(k,1175) + lmat(k,1175) + mat(k,1195) = mat(k,1195) + lmat(k,1195) + mat(k,1210) = mat(k,1210) + lmat(k,1210) + mat(k,1211) = mat(k,1211) + lmat(k,1211) + mat(k,1214) = mat(k,1214) + lmat(k,1214) + mat(k,1215) = mat(k,1215) + lmat(k,1215) + mat(k,1216) = mat(k,1216) + lmat(k,1216) + mat(k,1218) = mat(k,1218) + lmat(k,1218) + mat(k,1222) = mat(k,1222) + lmat(k,1222) + mat(k,1223) = mat(k,1223) + lmat(k,1223) + mat(k,1224) = mat(k,1224) + lmat(k,1224) + mat(k,1228) = lmat(k,1228) + mat(k,1232) = lmat(k,1232) + mat(k,1233) = mat(k,1233) + lmat(k,1233) + mat(k,1234) = mat(k,1234) + lmat(k,1234) + mat(k,1244) = lmat(k,1244) + mat(k,1258) = mat(k,1258) + lmat(k,1258) + mat(k,1274) = lmat(k,1274) + mat(k,1290) = mat(k,1290) + lmat(k,1290) + mat(k,1302) = mat(k,1302) + lmat(k,1302) + mat(k,1313) = mat(k,1313) + lmat(k,1313) + mat(k,1328) = lmat(k,1328) + mat(k,1330) = mat(k,1330) + lmat(k,1330) + mat(k,1334) = mat(k,1334) + lmat(k,1334) + mat(k,1336) = mat(k,1336) + lmat(k,1336) + mat(k,1342) = lmat(k,1342) + mat(k,1356) = mat(k,1356) + lmat(k,1356) + mat(k,1388) = mat(k,1388) + lmat(k,1388) + mat(k,1403) = mat(k,1403) + lmat(k,1403) + mat(k,1417) = mat(k,1417) + lmat(k,1417) + mat(k,1428) = lmat(k,1428) + mat(k,1430) = lmat(k,1430) + mat(k,1431) = mat(k,1431) + lmat(k,1431) + mat(k,1432) = mat(k,1432) + lmat(k,1432) + mat(k,1433) = mat(k,1433) + lmat(k,1433) + mat(k,1435) = mat(k,1435) + lmat(k,1435) + mat(k,1437) = mat(k,1437) + lmat(k,1437) + mat(k,1439) = mat(k,1439) + lmat(k,1439) + mat(k,1443) = lmat(k,1443) + mat(k,1444) = mat(k,1444) + lmat(k,1444) + mat(k,1447) = mat(k,1447) + lmat(k,1447) + mat(k,1455) = mat(k,1455) + lmat(k,1455) + mat(k,1465) = mat(k,1465) + lmat(k,1465) + mat(k,1468) = mat(k,1468) + lmat(k,1468) + mat(k,1471) = lmat(k,1471) + mat(k,1481) = mat(k,1481) + lmat(k,1481) + mat(k,1482) = lmat(k,1482) + mat(k,1485) = mat(k,1485) + lmat(k,1485) + mat(k,1487) = mat(k,1487) + lmat(k,1487) + mat(k,1528) = mat(k,1528) + lmat(k,1528) + mat(k,1539) = lmat(k,1539) + mat(k,1693) = mat(k,1693) + lmat(k,1693) + mat(k,1720) = mat(k,1720) + lmat(k,1720) + mat(k,1725) = mat(k,1725) + lmat(k,1725) + mat(k,1729) = mat(k,1729) + lmat(k,1729) + mat(k,1773) = mat(k,1773) + lmat(k,1773) + mat(k,1778) = mat(k,1778) + lmat(k,1778) + mat(k,1780) = mat(k,1780) + lmat(k,1780) + mat(k,1781) = mat(k,1781) + lmat(k,1781) + mat(k,1786) = mat(k,1786) + lmat(k,1786) + mat(k,1831) = mat(k,1831) + lmat(k,1831) + mat(k,1865) = mat(k,1865) + lmat(k,1865) + mat(k,1924) = mat(k,1924) + lmat(k,1924) + mat(k,1930) = mat(k,1930) + lmat(k,1930) + mat(k,1961) = mat(k,1961) + lmat(k,1961) + mat(k,1964) = mat(k,1964) + lmat(k,1964) + mat(k,1968) = mat(k,1968) + lmat(k,1968) + mat(k,1969) = mat(k,1969) + lmat(k,1969) + mat(k,1974) = mat(k,1974) + lmat(k,1974) + mat(k,2009) = mat(k,2009) + lmat(k,2009) + mat(k,2117) = mat(k,2117) + lmat(k,2117) + mat(k,2122) = mat(k,2122) + lmat(k,2122) + mat(k,2129) = mat(k,2129) + lmat(k,2129) + mat(k,2139) = mat(k,2139) + lmat(k,2139) + mat(k,2141) = mat(k,2141) + lmat(k,2141) + mat(k,2152) = mat(k,2152) + lmat(k,2152) + mat(k,2166) = mat(k,2166) + lmat(k,2166) + mat(k,2167) = mat(k,2167) + lmat(k,2167) + mat(k,2198) = mat(k,2198) + lmat(k,2198) + mat(k,2199) = mat(k,2199) + lmat(k,2199) + mat(k,2248) = mat(k,2248) + lmat(k,2248) + mat(k,2259) = mat(k,2259) + lmat(k,2259) + mat(k,2260) = mat(k,2260) + lmat(k,2260) + mat(k,2268) = lmat(k,2268) + mat(k,2271) = lmat(k,2271) + mat(k,2274) = mat(k,2274) + lmat(k,2274) + mat(k,2275) = mat(k,2275) + lmat(k,2275) + mat(k,2285) = lmat(k,2285) + mat(k,2287) = mat(k,2287) + lmat(k,2287) + mat(k, 214) = 0._r8 + mat(k, 215) = 0._r8 + mat(k, 254) = 0._r8 + mat(k, 301) = 0._r8 + mat(k, 340) = 0._r8 + mat(k, 438) = 0._r8 + mat(k, 439) = 0._r8 + mat(k, 452) = 0._r8 + mat(k, 486) = 0._r8 + mat(k, 488) = 0._r8 + mat(k, 495) = 0._r8 + mat(k, 504) = 0._r8 + mat(k, 628) = 0._r8 + mat(k, 632) = 0._r8 + mat(k, 635) = 0._r8 + mat(k, 636) = 0._r8 + mat(k, 639) = 0._r8 + mat(k, 658) = 0._r8 + mat(k, 660) = 0._r8 + mat(k, 661) = 0._r8 + mat(k, 663) = 0._r8 + mat(k, 669) = 0._r8 + mat(k, 670) = 0._r8 + mat(k, 674) = 0._r8 + mat(k, 696) = 0._r8 + mat(k, 698) = 0._r8 + mat(k, 699) = 0._r8 + mat(k, 701) = 0._r8 + mat(k, 703) = 0._r8 + mat(k, 709) = 0._r8 + mat(k, 711) = 0._r8 + mat(k, 725) = 0._r8 + mat(k, 727) = 0._r8 + mat(k, 728) = 0._r8 + mat(k, 730) = 0._r8 + mat(k, 732) = 0._r8 + mat(k, 749) = 0._r8 + mat(k, 751) = 0._r8 + mat(k, 752) = 0._r8 + mat(k, 754) = 0._r8 + mat(k, 756) = 0._r8 + mat(k, 757) = 0._r8 + mat(k, 772) = 0._r8 + mat(k, 774) = 0._r8 + mat(k, 778) = 0._r8 + mat(k, 783) = 0._r8 + mat(k, 793) = 0._r8 + mat(k, 798) = 0._r8 + mat(k, 828) = 0._r8 + mat(k, 858) = 0._r8 + mat(k, 887) = 0._r8 + mat(k, 888) = 0._r8 + mat(k, 892) = 0._r8 + mat(k, 894) = 0._r8 + mat(k, 895) = 0._r8 + mat(k, 910) = 0._r8 + mat(k, 917) = 0._r8 + mat(k, 919) = 0._r8 + mat(k, 932) = 0._r8 + mat(k, 935) = 0._r8 + mat(k, 946) = 0._r8 + mat(k, 952) = 0._r8 + mat(k, 955) = 0._r8 + mat(k, 958) = 0._r8 + mat(k, 960) = 0._r8 + mat(k, 964) = 0._r8 + mat(k, 965) = 0._r8 + mat(k, 966) = 0._r8 + mat(k, 968) = 0._r8 + mat(k, 970) = 0._r8 + mat(k, 985) = 0._r8 + mat(k, 995) = 0._r8 + mat(k,1000) = 0._r8 + mat(k,1004) = 0._r8 + mat(k,1005) = 0._r8 + mat(k,1008) = 0._r8 + mat(k,1010) = 0._r8 + mat(k,1014) = 0._r8 + mat(k,1015) = 0._r8 + mat(k,1016) = 0._r8 + mat(k,1018) = 0._r8 + mat(k,1020) = 0._r8 + mat(k,1029) = 0._r8 + mat(k,1030) = 0._r8 + mat(k,1031) = 0._r8 + mat(k,1037) = 0._r8 + mat(k,1038) = 0._r8 + mat(k,1040) = 0._r8 + mat(k,1042) = 0._r8 + mat(k,1048) = 0._r8 + mat(k,1049) = 0._r8 + mat(k,1050) = 0._r8 + mat(k,1051) = 0._r8 + mat(k,1053) = 0._r8 + mat(k,1067) = 0._r8 + mat(k,1069) = 0._r8 + mat(k,1070) = 0._r8 + mat(k,1073) = 0._r8 + mat(k,1076) = 0._r8 + mat(k,1077) = 0._r8 + mat(k,1078) = 0._r8 + mat(k,1080) = 0._r8 + mat(k,1082) = 0._r8 + mat(k,1083) = 0._r8 + mat(k,1086) = 0._r8 + mat(k,1103) = 0._r8 + mat(k,1113) = 0._r8 + mat(k,1114) = 0._r8 + mat(k,1115) = 0._r8 + mat(k,1117) = 0._r8 + mat(k,1122) = 0._r8 + mat(k,1123) = 0._r8 + mat(k,1128) = 0._r8 + mat(k,1141) = 0._r8 + mat(k,1153) = 0._r8 + mat(k,1156) = 0._r8 + mat(k,1161) = 0._r8 + mat(k,1162) = 0._r8 + mat(k,1163) = 0._r8 + mat(k,1166) = 0._r8 + mat(k,1167) = 0._r8 + mat(k,1179) = 0._r8 + mat(k,1185) = 0._r8 + mat(k,1188) = 0._r8 + mat(k,1190) = 0._r8 + mat(k,1192) = 0._r8 + mat(k,1193) = 0._r8 + mat(k,1194) = 0._r8 + mat(k,1196) = 0._r8 + mat(k,1197) = 0._r8 + mat(k,1198) = 0._r8 + mat(k,1200) = 0._r8 + mat(k,1202) = 0._r8 + mat(k,1208) = 0._r8 + mat(k,1219) = 0._r8 + mat(k,1229) = 0._r8 + mat(k,1242) = 0._r8 + mat(k,1246) = 0._r8 + mat(k,1251) = 0._r8 + mat(k,1252) = 0._r8 + mat(k,1253) = 0._r8 + mat(k,1254) = 0._r8 + mat(k,1255) = 0._r8 + mat(k,1257) = 0._r8 + mat(k,1259) = 0._r8 + mat(k,1261) = 0._r8 + mat(k,1263) = 0._r8 + mat(k,1265) = 0._r8 + mat(k,1271) = 0._r8 + mat(k,1272) = 0._r8 + mat(k,1273) = 0._r8 + mat(k,1277) = 0._r8 + mat(k,1280) = 0._r8 + mat(k,1281) = 0._r8 + mat(k,1284) = 0._r8 + mat(k,1286) = 0._r8 + mat(k,1287) = 0._r8 + mat(k,1288) = 0._r8 + mat(k,1291) = 0._r8 + mat(k,1292) = 0._r8 + mat(k,1293) = 0._r8 + mat(k,1295) = 0._r8 + mat(k,1297) = 0._r8 + mat(k,1303) = 0._r8 + mat(k,1304) = 0._r8 + mat(k,1305) = 0._r8 + mat(k,1314) = 0._r8 + mat(k,1316) = 0._r8 + mat(k,1318) = 0._r8 + mat(k,1324) = 0._r8 + mat(k,1325) = 0._r8 + mat(k,1331) = 0._r8 + mat(k,1335) = 0._r8 + mat(k,1337) = 0._r8 + mat(k,1338) = 0._r8 + mat(k,1341) = 0._r8 + mat(k,1343) = 0._r8 + mat(k,1344) = 0._r8 + mat(k,1346) = 0._r8 + mat(k,1348) = 0._r8 + mat(k,1353) = 0._r8 + mat(k,1354) = 0._r8 + mat(k,1355) = 0._r8 + mat(k,1358) = 0._r8 + mat(k,1366) = 0._r8 + mat(k,1368) = 0._r8 + mat(k,1389) = 0._r8 + mat(k,1390) = 0._r8 + mat(k,1393) = 0._r8 + mat(k,1398) = 0._r8 + mat(k,1400) = 0._r8 + mat(k,1404) = 0._r8 + mat(k,1406) = 0._r8 + mat(k,1409) = 0._r8 + mat(k,1410) = 0._r8 + mat(k,1418) = 0._r8 + mat(k,1420) = 0._r8 + mat(k,1421) = 0._r8 + mat(k,1424) = 0._r8 + mat(k,1426) = 0._r8 + mat(k,1434) = 0._r8 + mat(k,1438) = 0._r8 + mat(k,1446) = 0._r8 + mat(k,1448) = 0._r8 + mat(k,1449) = 0._r8 + mat(k,1450) = 0._r8 + mat(k,1452) = 0._r8 + mat(k,1453) = 0._r8 + mat(k,1454) = 0._r8 + mat(k,1456) = 0._r8 + mat(k,1462) = 0._r8 + mat(k,1463) = 0._r8 + mat(k,1464) = 0._r8 + mat(k,1466) = 0._r8 + mat(k,1467) = 0._r8 + mat(k,1470) = 0._r8 + mat(k,1472) = 0._r8 + mat(k,1473) = 0._r8 + mat(k,1474) = 0._r8 + mat(k,1475) = 0._r8 + mat(k,1476) = 0._r8 + mat(k,1480) = 0._r8 + mat(k,1484) = 0._r8 + mat(k,1488) = 0._r8 + mat(k,1491) = 0._r8 + mat(k,1492) = 0._r8 + mat(k,1493) = 0._r8 + mat(k,1497) = 0._r8 + mat(k,1499) = 0._r8 + mat(k,1526) = 0._r8 + mat(k,1531) = 0._r8 + mat(k,1534) = 0._r8 + mat(k,1607) = 0._r8 + mat(k,1624) = 0._r8 + mat(k,1638) = 0._r8 + mat(k,1642) = 0._r8 + mat(k,1653) = 0._r8 + mat(k,1654) = 0._r8 + mat(k,1676) = 0._r8 + mat(k,1692) = 0._r8 + mat(k,1715) = 0._r8 + mat(k,1716) = 0._r8 + mat(k,1718) = 0._r8 + mat(k,1721) = 0._r8 + mat(k,1730) = 0._r8 + mat(k,1731) = 0._r8 + mat(k,1738) = 0._r8 + mat(k,1743) = 0._r8 + mat(k,1750) = 0._r8 + mat(k,1756) = 0._r8 + mat(k,1758) = 0._r8 + mat(k,1763) = 0._r8 + mat(k,1770) = 0._r8 + mat(k,1771) = 0._r8 + mat(k,1772) = 0._r8 + mat(k,1775) = 0._r8 + mat(k,1777) = 0._r8 + mat(k,1779) = 0._r8 + mat(k,1782) = 0._r8 + mat(k,1784) = 0._r8 + mat(k,1785) = 0._r8 + mat(k,1787) = 0._r8 + mat(k,1788) = 0._r8 + mat(k,1799) = 0._r8 + mat(k,1823) = 0._r8 + mat(k,1824) = 0._r8 + mat(k,1825) = 0._r8 + mat(k,1827) = 0._r8 + mat(k,1828) = 0._r8 + mat(k,1830) = 0._r8 + mat(k,1836) = 0._r8 + mat(k,1837) = 0._r8 + mat(k,1838) = 0._r8 + mat(k,1839) = 0._r8 + mat(k,1840) = 0._r8 + mat(k,1886) = 0._r8 + mat(k,1915) = 0._r8 + mat(k,1916) = 0._r8 + mat(k,1917) = 0._r8 + mat(k,1919) = 0._r8 + mat(k,1928) = 0._r8 + mat(k,1932) = 0._r8 + mat(k,1943) = 0._r8 + mat(k,1946) = 0._r8 + mat(k,1947) = 0._r8 + mat(k,1951) = 0._r8 + mat(k,1952) = 0._r8 + mat(k,1953) = 0._r8 + mat(k,1954) = 0._r8 + mat(k,1958) = 0._r8 + mat(k,1959) = 0._r8 + mat(k,1960) = 0._r8 + mat(k,1962) = 0._r8 + mat(k,1963) = 0._r8 + mat(k,1967) = 0._r8 + mat(k,1970) = 0._r8 + mat(k,1972) = 0._r8 + mat(k,1976) = 0._r8 + mat(k,1986) = 0._r8 + mat(k,1990) = 0._r8 + mat(k,1991) = 0._r8 + mat(k,1992) = 0._r8 + mat(k,1993) = 0._r8 + mat(k,1995) = 0._r8 + mat(k,2000) = 0._r8 + mat(k,2002) = 0._r8 + mat(k,2007) = 0._r8 + mat(k,2008) = 0._r8 + mat(k,2012) = 0._r8 + mat(k,2013) = 0._r8 + mat(k,2015) = 0._r8 + mat(k,2031) = 0._r8 + mat(k,2048) = 0._r8 + mat(k,2049) = 0._r8 + mat(k,2077) = 0._r8 + mat(k,2081) = 0._r8 + mat(k,2083) = 0._r8 + mat(k,2086) = 0._r8 + mat(k,2088) = 0._r8 + mat(k,2092) = 0._r8 + mat(k,2095) = 0._r8 + mat(k,2100) = 0._r8 + mat(k,2105) = 0._r8 + mat(k,2107) = 0._r8 + mat(k,2109) = 0._r8 + mat(k,2128) = 0._r8 + mat(k,2131) = 0._r8 + mat(k,2135) = 0._r8 + mat(k,2136) = 0._r8 + mat(k,2137) = 0._r8 + mat(k,2138) = 0._r8 + mat(k,2140) = 0._r8 + mat(k,2142) = 0._r8 + mat(k,2144) = 0._r8 + mat(k,2153) = 0._r8 + mat(k,2154) = 0._r8 + mat(k,2155) = 0._r8 + mat(k,2156) = 0._r8 + mat(k,2159) = 0._r8 + mat(k,2160) = 0._r8 + mat(k,2165) = 0._r8 + mat(k,2168) = 0._r8 + mat(k,2169) = 0._r8 + mat(k,2171) = 0._r8 + mat(k,2177) = 0._r8 + mat(k,2183) = 0._r8 + mat(k,2185) = 0._r8 + mat(k,2187) = 0._r8 + mat(k,2191) = 0._r8 + mat(k,2200) = 0._r8 + mat(k,2213) = 0._r8 + mat(k,2217) = 0._r8 + mat(k,2222) = 0._r8 + mat(k,2225) = 0._r8 + mat(k,2228) = 0._r8 + mat(k,2229) = 0._r8 + mat(k,2232) = 0._r8 + mat(k,2233) = 0._r8 + mat(k,2237) = 0._r8 + mat(k,2238) = 0._r8 + mat(k,2239) = 0._r8 + mat(k,2241) = 0._r8 + mat(k,2246) = 0._r8 + mat(k,2257) = 0._r8 + mat(k,2261) = 0._r8 + mat(k,2265) = 0._r8 + mat(k,2267) = 0._r8 + mat(k,2269) = 0._r8 + mat(k,2270) = 0._r8 + mat(k,2272) = 0._r8 + mat(k,2273) = 0._r8 + mat(k,2276) = 0._r8 + mat(k,2277) = 0._r8 + mat(k,2278) = 0._r8 + mat(k,2279) = 0._r8 + mat(k,2280) = 0._r8 + mat(k,2281) = 0._r8 + mat(k,2282) = 0._r8 + mat(k,2283) = 0._r8 + mat(k,2284) = 0._r8 + mat(k,2286) = 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, 10) = mat(k, 10) - 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, 33) = mat(k, 33) - 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, 37) = mat(k, 37) - dti(k) + mat(k, 38) = mat(k, 38) - dti(k) + mat(k, 39) = mat(k, 39) - dti(k) + mat(k, 40) = mat(k, 40) - dti(k) + mat(k, 41) = mat(k, 41) - dti(k) + mat(k, 42) = mat(k, 42) - dti(k) + mat(k, 43) = mat(k, 43) - dti(k) + mat(k, 44) = mat(k, 44) - dti(k) + mat(k, 50) = mat(k, 50) - dti(k) + mat(k, 56) = mat(k, 56) - dti(k) + mat(k, 62) = mat(k, 62) - dti(k) + mat(k, 68) = mat(k, 68) - dti(k) + mat(k, 74) = mat(k, 74) - dti(k) + mat(k, 76) = mat(k, 76) - dti(k) + mat(k, 82) = mat(k, 82) - dti(k) + mat(k, 88) = mat(k, 88) - dti(k) + mat(k, 94) = mat(k, 94) - dti(k) + mat(k, 95) = mat(k, 95) - dti(k) + mat(k, 98) = mat(k, 98) - dti(k) + mat(k, 101) = mat(k, 101) - dti(k) + mat(k, 104) = mat(k, 104) - dti(k) + mat(k, 107) = mat(k, 107) - dti(k) + mat(k, 111) = mat(k, 111) - dti(k) + mat(k, 115) = mat(k, 115) - dti(k) + mat(k, 119) = mat(k, 119) - dti(k) + mat(k, 123) = mat(k, 123) - dti(k) + mat(k, 127) = mat(k, 127) - dti(k) + mat(k, 131) = mat(k, 131) - dti(k) + mat(k, 134) = mat(k, 134) - dti(k) + mat(k, 137) = mat(k, 137) - dti(k) + mat(k, 140) = mat(k, 140) - dti(k) + mat(k, 143) = mat(k, 143) - dti(k) + mat(k, 148) = mat(k, 148) - dti(k) + mat(k, 153) = mat(k, 153) - dti(k) + mat(k, 158) = mat(k, 158) - dti(k) + mat(k, 164) = mat(k, 164) - dti(k) + mat(k, 170) = mat(k, 170) - dti(k) + mat(k, 174) = mat(k, 174) - dti(k) + mat(k, 179) = mat(k, 179) - dti(k) + mat(k, 181) = mat(k, 181) - dti(k) + mat(k, 185) = mat(k, 185) - dti(k) + mat(k, 189) = mat(k, 189) - dti(k) + mat(k, 196) = mat(k, 196) - dti(k) + mat(k, 201) = mat(k, 201) - dti(k) + mat(k, 205) = mat(k, 205) - dti(k) + mat(k, 210) = mat(k, 210) - dti(k) + mat(k, 218) = mat(k, 218) - dti(k) + mat(k, 223) = mat(k, 223) - dti(k) + mat(k, 228) = mat(k, 228) - dti(k) + mat(k, 231) = mat(k, 231) - dti(k) + mat(k, 234) = mat(k, 234) - dti(k) + mat(k, 237) = mat(k, 237) - dti(k) + mat(k, 240) = mat(k, 240) - dti(k) + mat(k, 243) = mat(k, 243) - dti(k) + mat(k, 248) = mat(k, 248) - dti(k) + mat(k, 253) = mat(k, 253) - dti(k) + mat(k, 259) = mat(k, 259) - dti(k) + mat(k, 263) = mat(k, 263) - dti(k) + mat(k, 267) = mat(k, 267) - dti(k) + mat(k, 271) = mat(k, 271) - dti(k) + mat(k, 275) = mat(k, 275) - dti(k) + mat(k, 281) = mat(k, 281) - dti(k) + mat(k, 284) = mat(k, 284) - dti(k) + mat(k, 290) = mat(k, 290) - dti(k) + mat(k, 293) = mat(k, 293) - dti(k) + mat(k, 300) = mat(k, 300) - dti(k) + mat(k, 306) = mat(k, 306) - dti(k) + mat(k, 312) = mat(k, 312) - dti(k) + mat(k, 317) = mat(k, 317) - dti(k) + mat(k, 322) = mat(k, 322) - dti(k) + mat(k, 327) = mat(k, 327) - dti(k) + mat(k, 332) = mat(k, 332) - dti(k) + mat(k, 338) = mat(k, 338) - dti(k) + mat(k, 343) = mat(k, 343) - dti(k) + mat(k, 348) = mat(k, 348) - dti(k) + mat(k, 351) = mat(k, 351) - dti(k) + mat(k, 359) = mat(k, 359) - dti(k) + mat(k, 367) = mat(k, 367) - dti(k) + mat(k, 375) = mat(k, 375) - dti(k) + mat(k, 381) = mat(k, 381) - dti(k) + mat(k, 387) = mat(k, 387) - dti(k) + mat(k, 393) = mat(k, 393) - dti(k) + mat(k, 399) = mat(k, 399) - dti(k) + mat(k, 405) = mat(k, 405) - dti(k) + mat(k, 411) = mat(k, 411) - dti(k) + mat(k, 417) = mat(k, 417) - dti(k) + mat(k, 423) = mat(k, 423) - dti(k) + mat(k, 429) = mat(k, 429) - dti(k) + mat(k, 437) = mat(k, 437) - dti(k) + mat(k, 443) = mat(k, 443) - dti(k) + mat(k, 450) = mat(k, 450) - dti(k) + mat(k, 456) = mat(k, 456) - dti(k) + mat(k, 462) = mat(k, 462) - dti(k) + mat(k, 465) = mat(k, 465) - dti(k) + mat(k, 469) = mat(k, 469) - dti(k) + mat(k, 476) = mat(k, 476) - dti(k) + mat(k, 485) = mat(k, 485) - dti(k) + mat(k, 493) = mat(k, 493) - dti(k) + mat(k, 501) = mat(k, 501) - dti(k) + mat(k, 508) = mat(k, 508) - dti(k) + mat(k, 513) = mat(k, 513) - dti(k) + mat(k, 520) = mat(k, 520) - dti(k) + mat(k, 526) = mat(k, 526) - dti(k) + mat(k, 534) = mat(k, 534) - dti(k) + mat(k, 542) = mat(k, 542) - dti(k) + mat(k, 550) = mat(k, 550) - dti(k) + mat(k, 558) = mat(k, 558) - dti(k) + mat(k, 566) = mat(k, 566) - dti(k) + mat(k, 574) = mat(k, 574) - dti(k) + mat(k, 583) = mat(k, 583) - dti(k) + mat(k, 592) = mat(k, 592) - dti(k) + mat(k, 596) = mat(k, 596) - dti(k) + mat(k, 605) = mat(k, 605) - dti(k) + mat(k, 612) = mat(k, 612) - dti(k) + mat(k, 619) = mat(k, 619) - dti(k) + mat(k, 627) = mat(k, 627) - dti(k) + mat(k, 634) = mat(k, 634) - dti(k) + mat(k, 644) = mat(k, 644) - dti(k) + mat(k, 657) = mat(k, 657) - dti(k) + mat(k, 668) = mat(k, 668) - dti(k) + mat(k, 679) = mat(k, 679) - dti(k) + mat(k, 686) = mat(k, 686) - dti(k) + mat(k, 695) = mat(k, 695) - dti(k) + mat(k, 708) = mat(k, 708) - dti(k) + mat(k, 715) = mat(k, 715) - dti(k) + mat(k, 726) = mat(k, 726) - dti(k) + mat(k, 737) = mat(k, 737) - dti(k) + mat(k, 750) = mat(k, 750) - dti(k) + mat(k, 761) = mat(k, 761) - dti(k) + mat(k, 770) = mat(k, 770) - dti(k) + mat(k, 780) = mat(k, 780) - dti(k) + mat(k, 789) = mat(k, 789) - dti(k) + mat(k, 799) = mat(k, 799) - dti(k) + mat(k, 803) = mat(k, 803) - dti(k) + mat(k, 806) = mat(k, 806) - dti(k) + mat(k, 815) = mat(k, 815) - dti(k) + mat(k, 825) = mat(k, 825) - dti(k) + mat(k, 836) = mat(k, 836) - dti(k) + mat(k, 853) = mat(k, 853) - dti(k) + mat(k, 859) = mat(k, 859) - dti(k) + mat(k, 866) = mat(k, 866) - dti(k) + mat(k, 875) = mat(k, 875) - dti(k) + mat(k, 889) = mat(k, 889) - dti(k) + mat(k, 901) = mat(k, 901) - dti(k) + mat(k, 914) = mat(k, 914) - dti(k) + mat(k, 924) = mat(k, 924) - dti(k) + mat(k, 931) = mat(k, 931) - dti(k) + mat(k, 950) = mat(k, 950) - dti(k) + mat(k, 971) = mat(k, 971) - dti(k) + mat(k, 981) = mat(k, 981) - dti(k) + mat(k,1001) = mat(k,1001) - dti(k) + mat(k,1026) = mat(k,1026) - dti(k) + mat(k,1047) = mat(k,1047) - dti(k) + mat(k,1061) = mat(k,1061) - dti(k) + mat(k,1075) = mat(k,1075) - dti(k) + mat(k,1087) = mat(k,1087) - dti(k) + mat(k,1098) = mat(k,1098) - dti(k) + mat(k,1111) = mat(k,1111) - dti(k) + mat(k,1125) = mat(k,1125) - dti(k) + mat(k,1131) = mat(k,1131) - dti(k) + mat(k,1142) = mat(k,1142) - dti(k) + mat(k,1155) = mat(k,1155) - dti(k) + mat(k,1175) = mat(k,1175) - dti(k) + mat(k,1195) = mat(k,1195) - dti(k) + mat(k,1211) = mat(k,1211) - dti(k) + mat(k,1223) = mat(k,1223) - dti(k) + mat(k,1234) = mat(k,1234) - dti(k) + mat(k,1258) = mat(k,1258) - dti(k) + mat(k,1290) = mat(k,1290) - dti(k) + mat(k,1313) = mat(k,1313) - dti(k) + mat(k,1334) = mat(k,1334) - dti(k) + mat(k,1356) = mat(k,1356) - dti(k) + mat(k,1388) = mat(k,1388) - dti(k) + mat(k,1403) = mat(k,1403) - dti(k) + mat(k,1417) = mat(k,1417) - dti(k) + mat(k,1432) = mat(k,1432) - dti(k) + mat(k,1447) = mat(k,1447) - dti(k) + mat(k,1465) = mat(k,1465) - dti(k) + mat(k,1487) = mat(k,1487) - dti(k) + mat(k,1528) = mat(k,1528) - dti(k) + mat(k,1693) = mat(k,1693) - dti(k) + mat(k,1720) = mat(k,1720) - dti(k) + mat(k,1778) = mat(k,1778) - dti(k) + mat(k,1831) = mat(k,1831) - dti(k) + mat(k,1924) = mat(k,1924) - dti(k) + mat(k,1969) = mat(k,1969) - dti(k) + mat(k,2009) = mat(k,2009) - dti(k) + mat(k,2117) = mat(k,2117) - dti(k) + mat(k,2141) = mat(k,2141) - dti(k) + mat(k,2166) = mat(k,2166) - dti(k) + mat(k,2198) = mat(k,2198) - dti(k) + mat(k,2260) = mat(k,2260) - dti(k) + mat(k,2287) = mat(k,2287) - 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 nlnmat08( avec_len, mat, y, rxt ) + call nlnmat09( avec_len, mat, y, rxt ) + call nlnmat10( 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_vbs/mo_phtadj.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/mo_phtadj.F90 new file mode 100644 index 0000000000..6698bf2f2b --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/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_vbs/mo_prod_loss.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/mo_prod_loss.F90 new file mode 100644 index 0000000000..a2848c670f --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/mo_prod_loss.F90 @@ -0,0 +1,1250 @@ + 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,188))* y(k,188) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,189))* y(k,189) + 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,153) = (rxt(k,356)* y(k,219) + rxt(k,19) + het_rates(k,1))* y(k,1) + prod(k,153) =rxt(k,359)*y(k,191)*y(k,124) + loss(k,156) = (rxt(k,360)* y(k,219) + rxt(k,20) + het_rates(k,2))* y(k,2) + prod(k,156) =rxt(k,357)*y(k,205)*y(k,191) + loss(k,1) = ( + het_rates(k,3))* y(k,3) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,4))* y(k,4) + prod(k,2) = 0._r8 + loss(k,3) = ( + het_rates(k,5))* y(k,5) + prod(k,3) = 0._r8 + loss(k,187) = (rxt(k,439)* y(k,126) +rxt(k,440)* y(k,135) +rxt(k,441) & + * y(k,219) + het_rates(k,6))* y(k,6) + prod(k,187) = 0._r8 + loss(k,72) = (rxt(k,398)* y(k,219) + het_rates(k,7))* y(k,7) + prod(k,72) = 0._r8 + loss(k,122) = (rxt(k,401)* y(k,219) + rxt(k,21) + het_rates(k,8))* y(k,8) + prod(k,122) =rxt(k,399)*y(k,205)*y(k,193) + loss(k,73) = ( + rxt(k,22) + het_rates(k,9))* y(k,9) + prod(k,73) =.120_r8*rxt(k,398)*y(k,219)*y(k,7) + loss(k,116) = ( + rxt(k,23) + het_rates(k,10))* y(k,10) + prod(k,116) = (.100_r8*rxt(k,440)*y(k,6) +.100_r8*rxt(k,443)*y(k,110)) & + *y(k,135) + loss(k,129) = ( + rxt(k,24) + het_rates(k,11))* y(k,11) + prod(k,129) = (.500_r8*rxt(k,400)*y(k,193) +.200_r8*rxt(k,427)*y(k,225) + & + .060_r8*rxt(k,433)*y(k,228))*y(k,124) +.500_r8*rxt(k,21)*y(k,8) & + +rxt(k,22)*y(k,9) +.200_r8*rxt(k,70)*y(k,181) +.060_r8*rxt(k,72) & + *y(k,185) + loss(k,98) = ( + rxt(k,25) + het_rates(k,12))* y(k,12) + prod(k,98) = (.200_r8*rxt(k,427)*y(k,225) +.200_r8*rxt(k,433)*y(k,228)) & + *y(k,124) +.200_r8*rxt(k,70)*y(k,181) +.200_r8*rxt(k,72)*y(k,185) + loss(k,147) = ( + rxt(k,26) + het_rates(k,13))* y(k,13) + prod(k,147) = (.200_r8*rxt(k,427)*y(k,225) +.150_r8*rxt(k,433)*y(k,228)) & + *y(k,124) +rxt(k,46)*y(k,94) +rxt(k,56)*y(k,116) +.200_r8*rxt(k,70) & + *y(k,181) +.150_r8*rxt(k,72)*y(k,185) + loss(k,106) = ( + rxt(k,27) + het_rates(k,14))* y(k,14) + prod(k,106) =.210_r8*rxt(k,433)*y(k,228)*y(k,124) +.210_r8*rxt(k,72)*y(k,185) + loss(k,85) = (rxt(k,361)* y(k,219) + het_rates(k,15))* y(k,15) + prod(k,85) = (.050_r8*rxt(k,440)*y(k,6) +.050_r8*rxt(k,443)*y(k,110)) & + *y(k,135) + loss(k,112) = (rxt(k,327)* y(k,126) +rxt(k,328)* y(k,219) + het_rates(k,16)) & + * y(k,16) + prod(k,112) = 0._r8 + loss(k,211) = (rxt(k,211)* y(k,42) +rxt(k,213)* y(k,135) +rxt(k,212) & + * y(k,205) + het_rates(k,17))* y(k,17) + prod(k,211) = (rxt(k,75) +2.000_r8*rxt(k,214)*y(k,19) +rxt(k,215)*y(k,59) + & + rxt(k,216)*y(k,59) +rxt(k,219)*y(k,124) +rxt(k,222)*y(k,134) + & + rxt(k,223)*y(k,219) +rxt(k,469)*y(k,151))*y(k,19) & + + (rxt(k,201)*y(k,34) +rxt(k,227)*y(k,35) + & + 3.000_r8*rxt(k,228)*y(k,55) +2.000_r8*rxt(k,229)*y(k,78) + & + rxt(k,230)*y(k,81) +2.000_r8*rxt(k,250)*y(k,41) +rxt(k,251)*y(k,43)) & + *y(k,218) + (rxt(k,225)*y(k,81) +2.000_r8*rxt(k,239)*y(k,41) + & + rxt(k,241)*y(k,43) +3.000_r8*rxt(k,246)*y(k,55))*y(k,219) & + + (2.000_r8*rxt(k,238)*y(k,41) +rxt(k,240)*y(k,43) + & + 3.000_r8*rxt(k,245)*y(k,55))*y(k,56) + (rxt(k,99) + & + rxt(k,224)*y(k,134))*y(k,81) +rxt(k,74)*y(k,18) +rxt(k,77)*y(k,20) & + +rxt(k,79)*y(k,34) +rxt(k,80)*y(k,35) +2.000_r8*rxt(k,86)*y(k,41) & + +rxt(k,87)*y(k,43) +3.000_r8*rxt(k,90)*y(k,55) +2.000_r8*rxt(k,98) & + *y(k,78) +rxt(k,105)*y(k,91) + loss(k,86) = ( + rxt(k,74) + het_rates(k,18))* y(k,18) + prod(k,86) = (rxt(k,530)*y(k,91) +rxt(k,535)*y(k,91))*y(k,85) & + +rxt(k,217)*y(k,59)*y(k,19) + loss(k,226) = (2._r8*rxt(k,214)* y(k,19) + (rxt(k,215) +rxt(k,216) + & + rxt(k,217))* y(k,59) +rxt(k,219)* y(k,124) +rxt(k,220)* y(k,125) & + +rxt(k,222)* y(k,134) +rxt(k,469)* y(k,151) +rxt(k,218)* y(k,205) & + +rxt(k,223)* y(k,219) + rxt(k,75) + het_rates(k,19))* y(k,19) + prod(k,226) = (rxt(k,76) +rxt(k,221)*y(k,134))*y(k,20) +rxt(k,213)*y(k,135) & + *y(k,17) +rxt(k,231)*y(k,218)*y(k,81) +rxt(k,226)*y(k,134)*y(k,91) + loss(k,143) = (rxt(k,221)* y(k,134) + rxt(k,76) + rxt(k,77) + rxt(k,524) & + + rxt(k,527) + rxt(k,532) + het_rates(k,20))* y(k,20) + prod(k,143) =rxt(k,220)*y(k,125)*y(k,19) + loss(k,4) = ( + het_rates(k,21))* y(k,21) + prod(k,4) = 0._r8 + loss(k,88) = (rxt(k,402)* y(k,219) + het_rates(k,22))* y(k,22) + prod(k,88) =rxt(k,28)*y(k,23) +rxt(k,405)*y(k,195)*y(k,124) + loss(k,109) = (rxt(k,404)* y(k,219) + rxt(k,28) + het_rates(k,23))* y(k,23) + prod(k,109) =rxt(k,403)*y(k,205)*y(k,195) + loss(k,101) = (rxt(k,276)* y(k,56) +rxt(k,277)* y(k,219) + het_rates(k,24)) & + * y(k,24) + prod(k,101) = 0._r8 + loss(k,142) = (rxt(k,278)* y(k,56) +rxt(k,279)* y(k,135) +rxt(k,304) & + * y(k,219) + het_rates(k,25))* y(k,25) + prod(k,142) = 0._r8 + loss(k,94) = (rxt(k,284)* y(k,219) + het_rates(k,26))* y(k,26) + prod(k,94) = (.400_r8*rxt(k,280)*y(k,196) +.200_r8*rxt(k,281)*y(k,200)) & + *y(k,196) + loss(k,110) = (rxt(k,285)* y(k,219) + rxt(k,29) + het_rates(k,27))* y(k,27) + prod(k,110) =rxt(k,282)*y(k,205)*y(k,196) + loss(k,103) = (rxt(k,286)* y(k,56) +rxt(k,287)* y(k,219) + het_rates(k,28)) & + * y(k,28) + prod(k,103) = 0._r8 + loss(k,188) = (rxt(k,307)* y(k,126) +rxt(k,308)* y(k,135) +rxt(k,325) & + * y(k,219) + het_rates(k,29))* y(k,29) + prod(k,188) =.130_r8*rxt(k,385)*y(k,135)*y(k,98) +.700_r8*rxt(k,55)*y(k,111) + loss(k,121) = (rxt(k,312)* y(k,219) + rxt(k,30) + het_rates(k,30))* y(k,30) + prod(k,121) =rxt(k,310)*y(k,205)*y(k,197) + loss(k,59) = (rxt(k,313)* y(k,219) + het_rates(k,31))* y(k,31) + prod(k,59) = 0._r8 + loss(k,95) = (rxt(k,408)* y(k,219) + rxt(k,31) + het_rates(k,32))* y(k,32) + prod(k,95) =rxt(k,406)*y(k,205)*y(k,198) + loss(k,56) = (rxt(k,200)* y(k,218) + rxt(k,78) + het_rates(k,33))* y(k,33) + prod(k,56) = 0._r8 + loss(k,68) = (rxt(k,201)* y(k,218) + rxt(k,79) + het_rates(k,34))* y(k,34) + prod(k,68) = 0._r8 + loss(k,69) = (rxt(k,227)* y(k,218) + rxt(k,80) + het_rates(k,35))* y(k,35) + prod(k,69) = 0._r8 + loss(k,60) = (rxt(k,202)* y(k,218) + rxt(k,81) + het_rates(k,36))* y(k,36) + prod(k,60) = 0._r8 + loss(k,70) = (rxt(k,203)* y(k,218) + rxt(k,82) + het_rates(k,37))* y(k,37) + prod(k,70) = 0._r8 + loss(k,61) = (rxt(k,204)* y(k,218) + rxt(k,83) + het_rates(k,38))* y(k,38) + prod(k,61) = 0._r8 + loss(k,71) = (rxt(k,205)* y(k,218) + rxt(k,84) + het_rates(k,39))* y(k,39) + prod(k,71) = 0._r8 + loss(k,62) = (rxt(k,206)* y(k,218) + rxt(k,85) + het_rates(k,40))* y(k,40) + prod(k,62) = 0._r8 + loss(k,131) = (rxt(k,238)* y(k,56) +rxt(k,250)* y(k,218) +rxt(k,239) & + * y(k,219) + rxt(k,86) + het_rates(k,41))* y(k,41) + prod(k,131) = 0._r8 + loss(k,215) = (rxt(k,211)* y(k,17) +rxt(k,175)* y(k,56) +rxt(k,256)* y(k,126) & + +rxt(k,257)* y(k,134) +rxt(k,255)* y(k,205) +rxt(k,258)* y(k,219) & + + rxt(k,32) + rxt(k,33) + het_rates(k,42))* y(k,42) + prod(k,215) = (rxt(k,182)*y(k,59) +2.000_r8*rxt(k,259)*y(k,200) + & + rxt(k,260)*y(k,200) +rxt(k,262)*y(k,124) + & + .700_r8*rxt(k,281)*y(k,196) +rxt(k,292)*y(k,199) + & + rxt(k,309)*y(k,197) +.800_r8*rxt(k,321)*y(k,222) + & + .880_r8*rxt(k,333)*y(k,211) +2.000_r8*rxt(k,342)*y(k,213) + & + 1.500_r8*rxt(k,366)*y(k,207) +.750_r8*rxt(k,371)*y(k,208) + & + .800_r8*rxt(k,380)*y(k,101) +.800_r8*rxt(k,391)*y(k,227) + & + .750_r8*rxt(k,445)*y(k,217) +.930_r8*rxt(k,450)*y(k,223) + & + .950_r8*rxt(k,455)*y(k,224))*y(k,200) & + + (.500_r8*rxt(k,298)*y(k,204) +rxt(k,319)*y(k,221) + & + rxt(k,323)*y(k,222) +.500_r8*rxt(k,329)*y(k,202) + & + .250_r8*rxt(k,336)*y(k,211) +rxt(k,345)*y(k,213) + & + .100_r8*rxt(k,358)*y(k,191) +.920_r8*rxt(k,368)*y(k,207) + & + .250_r8*rxt(k,393)*y(k,227) +.340_r8*rxt(k,452)*y(k,223) + & + .320_r8*rxt(k,457)*y(k,224))*y(k,124) + (rxt(k,263)*y(k,52) + & + .300_r8*rxt(k,264)*y(k,53) +.500_r8*rxt(k,296)*y(k,51) + & + .800_r8*rxt(k,301)*y(k,74) +rxt(k,303)*y(k,140) + & + .500_r8*rxt(k,351)*y(k,109) +.400_r8*rxt(k,356)*y(k,1) + & + .300_r8*rxt(k,376)*y(k,99) +.680_r8*rxt(k,461)*y(k,180))*y(k,219) & + + (rxt(k,279)*y(k,25) +.500_r8*rxt(k,308)*y(k,29) + & + .120_r8*rxt(k,338)*y(k,105) +.600_r8*rxt(k,352)*y(k,111) + & + .910_r8*rxt(k,385)*y(k,98) +.340_r8*rxt(k,440)*y(k,6) + & + .340_r8*rxt(k,443)*y(k,110))*y(k,135) + (.500_r8*rxt(k,327)*y(k,16) + & + .250_r8*rxt(k,335)*y(k,211) +rxt(k,346)*y(k,213) + & + rxt(k,369)*y(k,207))*y(k,126) + (.250_r8*rxt(k,332)*y(k,211) + & + rxt(k,341)*y(k,213) +rxt(k,365)*y(k,207) + & + .250_r8*rxt(k,390)*y(k,227))*y(k,199) + (.180_r8*rxt(k,39) + & + rxt(k,272)*y(k,218) +rxt(k,273)*y(k,218))*y(k,54) & + + (.150_r8*rxt(k,322)*y(k,222) +.450_r8*rxt(k,343)*y(k,213)) & + *y(k,205) +.100_r8*rxt(k,19)*y(k,1) +.100_r8*rxt(k,20)*y(k,2) & + +rxt(k,38)*y(k,53) +rxt(k,43)*y(k,74) +.330_r8*rxt(k,45)*y(k,93) & + +rxt(k,47)*y(k,95) +rxt(k,49)*y(k,103) +1.340_r8*rxt(k,50)*y(k,105) & + +rxt(k,57)*y(k,127) +rxt(k,62)*y(k,147) +rxt(k,63)*y(k,148) & + +.375_r8*rxt(k,65)*y(k,176) +.400_r8*rxt(k,67)*y(k,178) & + +.680_r8*rxt(k,69)*y(k,180) +2.000_r8*rxt(k,299)*y(k,203) & + +rxt(k,269)*y(k,206) +2.000_r8*rxt(k,344)*y(k,213)*y(k,213) + loss(k,148) = (rxt(k,240)* y(k,56) +rxt(k,251)* y(k,218) +rxt(k,241) & + * y(k,219) + rxt(k,87) + het_rates(k,43))* y(k,43) + prod(k,148) = 0._r8 + loss(k,63) = (rxt(k,242)* y(k,219) + rxt(k,88) + het_rates(k,44))* y(k,44) + prod(k,63) = 0._r8 + loss(k,192) = (rxt(k,288)* y(k,126) +rxt(k,289)* y(k,219) + rxt(k,34) & + + het_rates(k,45))* y(k,45) + prod(k,192) = (rxt(k,283)*y(k,196) +.270_r8*rxt(k,311)*y(k,197) + & + rxt(k,319)*y(k,221) +rxt(k,329)*y(k,202) +rxt(k,348)*y(k,215) + & + .400_r8*rxt(k,358)*y(k,191))*y(k,124) + (rxt(k,284)*y(k,26) + & + .500_r8*rxt(k,285)*y(k,27) +.800_r8*rxt(k,356)*y(k,1))*y(k,219) & + + (.500_r8*rxt(k,308)*y(k,29) +.100_r8*rxt(k,352)*y(k,111))*y(k,135) & + + (1.600_r8*rxt(k,280)*y(k,196) +.800_r8*rxt(k,281)*y(k,200)) & + *y(k,196) +.400_r8*rxt(k,19)*y(k,1) +.400_r8*rxt(k,20)*y(k,2) & + +rxt(k,327)*y(k,126)*y(k,16) +rxt(k,29)*y(k,27) +.330_r8*rxt(k,45) & + *y(k,93) +rxt(k,53)*y(k,108) +rxt(k,62)*y(k,147) & + +.200_r8*rxt(k,347)*y(k,215)*y(k,205) + loss(k,114) = (rxt(k,243)* y(k,56) +rxt(k,244)* y(k,219) + rxt(k,89) & + + het_rates(k,46))* y(k,46) + prod(k,114) = 0._r8 + loss(k,57) = (rxt(k,290)* y(k,219) + het_rates(k,47))* y(k,47) + prod(k,57) = 0._r8 + loss(k,182) = (rxt(k,326)* y(k,219) + rxt(k,35) + het_rates(k,48))* y(k,48) + prod(k,182) = (.820_r8*rxt(k,311)*y(k,197) +.500_r8*rxt(k,329)*y(k,202) + & + .250_r8*rxt(k,358)*y(k,191) +.270_r8*rxt(k,452)*y(k,223) + & + .040_r8*rxt(k,457)*y(k,224))*y(k,124) & + + (.820_r8*rxt(k,309)*y(k,197) +.150_r8*rxt(k,450)*y(k,223) + & + .025_r8*rxt(k,455)*y(k,224))*y(k,200) + (.250_r8*rxt(k,19) + & + .800_r8*rxt(k,356)*y(k,219))*y(k,1) + (.520_r8*rxt(k,440)*y(k,6) + & + .520_r8*rxt(k,443)*y(k,110))*y(k,135) + (.500_r8*rxt(k,69) + & + .500_r8*rxt(k,461)*y(k,219))*y(k,180) +.250_r8*rxt(k,20)*y(k,2) & + +.500_r8*rxt(k,327)*y(k,126)*y(k,16) +.820_r8*rxt(k,30)*y(k,30) & + +.170_r8*rxt(k,45)*y(k,93) +.300_r8*rxt(k,65)*y(k,176) & + +.050_r8*rxt(k,67)*y(k,178) + loss(k,202) = (rxt(k,314)* y(k,126) +rxt(k,315)* y(k,219) + rxt(k,36) & + + het_rates(k,49))* y(k,49) + prod(k,202) = (.250_r8*rxt(k,336)*y(k,211) +.050_r8*rxt(k,374)*y(k,208) + & + .250_r8*rxt(k,393)*y(k,227) +.170_r8*rxt(k,411)*y(k,201) + & + .170_r8*rxt(k,417)*y(k,214) +.400_r8*rxt(k,427)*y(k,225) + & + .540_r8*rxt(k,433)*y(k,228) +.510_r8*rxt(k,436)*y(k,230))*y(k,124) & + + (.250_r8*rxt(k,335)*y(k,211) +.050_r8*rxt(k,375)*y(k,208) + & + .250_r8*rxt(k,394)*y(k,227))*y(k,126) & + + (.500_r8*rxt(k,321)*y(k,222) +.240_r8*rxt(k,333)*y(k,211) + & + .100_r8*rxt(k,391)*y(k,227))*y(k,200) & + + (.880_r8*rxt(k,338)*y(k,105) +.500_r8*rxt(k,352)*y(k,111)) & + *y(k,135) + (.250_r8*rxt(k,332)*y(k,211) + & + .250_r8*rxt(k,390)*y(k,227))*y(k,199) & + + (.070_r8*rxt(k,410)*y(k,201) +.070_r8*rxt(k,416)*y(k,214)) & + *y(k,205) + (rxt(k,316)*y(k,95) +rxt(k,317)*y(k,127))*y(k,219) & + +.180_r8*rxt(k,23)*y(k,10) +rxt(k,27)*y(k,14) +.400_r8*rxt(k,70) & + *y(k,181) +.540_r8*rxt(k,72)*y(k,185) +.510_r8*rxt(k,73)*y(k,187) + loss(k,158) = (rxt(k,295)* y(k,219) + het_rates(k,50))* y(k,50) + prod(k,158) = (.100_r8*rxt(k,292)*y(k,200) +.150_r8*rxt(k,293)*y(k,205)) & + *y(k,199) +.120_r8*rxt(k,308)*y(k,135)*y(k,29) & + +.150_r8*rxt(k,343)*y(k,213)*y(k,205) + loss(k,150) = (rxt(k,296)* y(k,219) + rxt(k,37) + het_rates(k,51))* y(k,51) + prod(k,150) = (.400_r8*rxt(k,293)*y(k,199) +.400_r8*rxt(k,343)*y(k,213)) & + *y(k,205) + loss(k,169) = (rxt(k,263)* y(k,219) + het_rates(k,52))* y(k,52) + prod(k,169) = (rxt(k,260)*y(k,200) +.300_r8*rxt(k,281)*y(k,196) + & + .500_r8*rxt(k,321)*y(k,222) +.250_r8*rxt(k,333)*y(k,211) + & + .250_r8*rxt(k,366)*y(k,207) +.250_r8*rxt(k,371)*y(k,208) + & + .200_r8*rxt(k,380)*y(k,101) +.300_r8*rxt(k,391)*y(k,227) + & + .250_r8*rxt(k,445)*y(k,217) +.250_r8*rxt(k,450)*y(k,223) + & + .250_r8*rxt(k,455)*y(k,224))*y(k,200) + loss(k,128) = (rxt(k,264)* y(k,219) + rxt(k,38) + het_rates(k,53))* y(k,53) + prod(k,128) =rxt(k,261)*y(k,205)*y(k,200) + loss(k,212) = (rxt(k,176)* y(k,56) +rxt(k,232)* y(k,73) + (rxt(k,271) + & + rxt(k,272) +rxt(k,273))* y(k,218) +rxt(k,265)* y(k,219) + rxt(k,39) & + + rxt(k,40) + het_rates(k,54))* y(k,54) + prod(k,212) =.100_r8*rxt(k,308)*y(k,135)*y(k,29) + loss(k,117) = (rxt(k,245)* y(k,56) +rxt(k,228)* y(k,218) +rxt(k,246) & + * y(k,219) + rxt(k,90) + het_rates(k,55))* y(k,55) + prod(k,117) = 0._r8 + loss(k,223) = (rxt(k,286)* y(k,28) +rxt(k,238)* y(k,41) +rxt(k,175)* y(k,42) & + +rxt(k,240)* y(k,43) +rxt(k,243)* y(k,46) +rxt(k,176)* y(k,54) & + +rxt(k,245)* y(k,55) +rxt(k,188)* y(k,60) +rxt(k,177)* y(k,77) & + +rxt(k,178)* y(k,79) +rxt(k,197)* y(k,92) +rxt(k,181)* y(k,135) & + + (rxt(k,179) +rxt(k,180))* y(k,205) + het_rates(k,56))* y(k,56) + prod(k,223) = (4.000_r8*rxt(k,200)*y(k,33) +rxt(k,201)*y(k,34) + & + 2.000_r8*rxt(k,202)*y(k,36) +2.000_r8*rxt(k,203)*y(k,37) + & + 2.000_r8*rxt(k,204)*y(k,38) +rxt(k,205)*y(k,39) + & + 2.000_r8*rxt(k,206)*y(k,40) +rxt(k,207)*y(k,85) +rxt(k,237)*y(k,65) + & + rxt(k,252)*y(k,82) +rxt(k,253)*y(k,83) +rxt(k,254)*y(k,84))*y(k,218) & + + (rxt(k,93) +rxt(k,182)*y(k,200) +2.000_r8*rxt(k,183)*y(k,59) + & + rxt(k,185)*y(k,59) +rxt(k,187)*y(k,124) +rxt(k,192)*y(k,134) + & + rxt(k,193)*y(k,219) +rxt(k,216)*y(k,19) +rxt(k,470)*y(k,151))*y(k,59) & + + (rxt(k,196)*y(k,85) +3.000_r8*rxt(k,242)*y(k,44) + & + rxt(k,244)*y(k,46) +rxt(k,247)*y(k,82) +rxt(k,248)*y(k,83) + & + rxt(k,249)*y(k,84))*y(k,219) + (rxt(k,103) +rxt(k,195)*y(k,134)) & + *y(k,85) +rxt(k,74)*y(k,18) +4.000_r8*rxt(k,78)*y(k,33) +rxt(k,79) & + *y(k,34) +2.000_r8*rxt(k,81)*y(k,36) +2.000_r8*rxt(k,82)*y(k,37) & + +2.000_r8*rxt(k,83)*y(k,38) +rxt(k,84)*y(k,39) +2.000_r8*rxt(k,85) & + *y(k,40) +3.000_r8*rxt(k,88)*y(k,44) +rxt(k,89)*y(k,46) & + +2.000_r8*rxt(k,91)*y(k,57) +2.000_r8*rxt(k,92)*y(k,58) +rxt(k,94) & + *y(k,60) +rxt(k,97)*y(k,65) +rxt(k,100)*y(k,82) +rxt(k,101)*y(k,83) & + +rxt(k,102)*y(k,84) +rxt(k,106)*y(k,92) + loss(k,75) = ( + rxt(k,91) + het_rates(k,57))* y(k,57) + prod(k,75) = (rxt(k,523)*y(k,92) +rxt(k,528)*y(k,60) +rxt(k,529)*y(k,92) + & + rxt(k,533)*y(k,60) +rxt(k,534)*y(k,92) +rxt(k,538)*y(k,60))*y(k,85) & + +rxt(k,188)*y(k,60)*y(k,56) +rxt(k,184)*y(k,59)*y(k,59) + loss(k,54) = ( + rxt(k,92) + rxt(k,210) + het_rates(k,58))* y(k,58) + prod(k,54) =rxt(k,209)*y(k,59)*y(k,59) + loss(k,218) = ((rxt(k,215) +rxt(k,216) +rxt(k,217))* y(k,19) & + + 2._r8*(rxt(k,183) +rxt(k,184) +rxt(k,185) +rxt(k,209))* y(k,59) & + +rxt(k,187)* y(k,124) +rxt(k,189)* y(k,125) +rxt(k,192)* y(k,134) & + +rxt(k,470)* y(k,151) +rxt(k,182)* y(k,200) +rxt(k,186)* y(k,205) & + + (rxt(k,193) +rxt(k,194))* y(k,219) + rxt(k,93) + het_rates(k,59)) & + * y(k,59) + prod(k,218) = (rxt(k,180)*y(k,205) +rxt(k,181)*y(k,135) +rxt(k,197)*y(k,92)) & + *y(k,56) + (rxt(k,95) +rxt(k,190)*y(k,134))*y(k,60) & + + (rxt(k,198)*y(k,134) +rxt(k,199)*y(k,219))*y(k,92) + (rxt(k,107) + & + rxt(k,475)*y(k,151))*y(k,137) +2.000_r8*rxt(k,210)*y(k,58) & + +rxt(k,208)*y(k,218)*y(k,85) + loss(k,180) = (rxt(k,188)* y(k,56) + (rxt(k,528) +rxt(k,533) +rxt(k,538)) & + * y(k,85) +rxt(k,190)* y(k,134) +rxt(k,191)* y(k,219) + rxt(k,94) & + + rxt(k,95) + rxt(k,526) + rxt(k,531) + rxt(k,537) & + + het_rates(k,60))* y(k,60) + prod(k,180) =rxt(k,189)*y(k,125)*y(k,59) + loss(k,5) = ( + het_rates(k,61))* y(k,61) + prod(k,5) = 0._r8 + loss(k,195) = (rxt(k,275)* y(k,219) + het_rates(k,62))* y(k,62) + prod(k,195) = (rxt(k,32) +rxt(k,33) +rxt(k,175)*y(k,56) +rxt(k,211)*y(k,17) + & + rxt(k,256)*y(k,126) +rxt(k,257)*y(k,134) +rxt(k,258)*y(k,219)) & + *y(k,42) + (.630_r8*rxt(k,279)*y(k,25) +.560_r8*rxt(k,308)*y(k,29) + & + .650_r8*rxt(k,338)*y(k,105) +.560_r8*rxt(k,352)*y(k,111) + & + .620_r8*rxt(k,385)*y(k,98) +.230_r8*rxt(k,440)*y(k,6) + & + .230_r8*rxt(k,443)*y(k,110))*y(k,135) & + + (.220_r8*rxt(k,336)*y(k,211) +.250_r8*rxt(k,393)*y(k,227) + & + .170_r8*rxt(k,411)*y(k,201) +.400_r8*rxt(k,414)*y(k,212) + & + .350_r8*rxt(k,417)*y(k,214) +.225_r8*rxt(k,452)*y(k,223))*y(k,124) & + + (.350_r8*rxt(k,277)*y(k,24) +rxt(k,302)*y(k,75) + & + rxt(k,315)*y(k,49) +.700_r8*rxt(k,461)*y(k,180) +rxt(k,465)*y(k,138)) & + *y(k,219) + (rxt(k,314)*y(k,49) +.220_r8*rxt(k,335)*y(k,211) + & + .500_r8*rxt(k,394)*y(k,227))*y(k,126) & + + (.110_r8*rxt(k,333)*y(k,211) +.200_r8*rxt(k,391)*y(k,227) + & + .125_r8*rxt(k,450)*y(k,223))*y(k,200) & + + (.070_r8*rxt(k,410)*y(k,201) +.160_r8*rxt(k,413)*y(k,212) + & + .140_r8*rxt(k,416)*y(k,214))*y(k,205) + (rxt(k,110) + & + rxt(k,464)*y(k,134))*y(k,138) + (.220_r8*rxt(k,332)*y(k,211) + & + .250_r8*rxt(k,390)*y(k,227))*y(k,199) +1.500_r8*rxt(k,22)*y(k,9) & + +.450_r8*rxt(k,23)*y(k,10) +.600_r8*rxt(k,26)*y(k,13) +rxt(k,27) & + *y(k,14) +rxt(k,34)*y(k,45) +rxt(k,243)*y(k,56)*y(k,46) +rxt(k,36) & + *y(k,49) +.380_r8*rxt(k,39)*y(k,54) +rxt(k,41)*y(k,63) +rxt(k,43) & + *y(k,74) +2.000_r8*rxt(k,44)*y(k,75) +.330_r8*rxt(k,45)*y(k,93) & + +1.340_r8*rxt(k,51)*y(k,105) +.700_r8*rxt(k,55)*y(k,111) & + +1.500_r8*rxt(k,64)*y(k,175) +.250_r8*rxt(k,65)*y(k,176) +rxt(k,68) & + *y(k,179) +1.700_r8*rxt(k,69)*y(k,180) + loss(k,170) = ( + rxt(k,41) + het_rates(k,63))* y(k,63) + prod(k,170) = (rxt(k,267)*y(k,87) +rxt(k,275)*y(k,62) +rxt(k,295)*y(k,50) + & + .500_r8*rxt(k,296)*y(k,51) +.800_r8*rxt(k,301)*y(k,74) + & + rxt(k,302)*y(k,75) +.500_r8*rxt(k,351)*y(k,109) + & + 1.800_r8*rxt(k,461)*y(k,180))*y(k,219) & + + (2.000_r8*rxt(k,291)*y(k,199) +.900_r8*rxt(k,292)*y(k,200) + & + rxt(k,294)*y(k,124) +2.000_r8*rxt(k,341)*y(k,213) + & + rxt(k,365)*y(k,207) +rxt(k,390)*y(k,227))*y(k,199) & + + (.200_r8*rxt(k,308)*y(k,29) +.100_r8*rxt(k,352)*y(k,111) + & + .270_r8*rxt(k,440)*y(k,6) +.270_r8*rxt(k,443)*y(k,110))*y(k,135) & + + (rxt(k,342)*y(k,200) +.450_r8*rxt(k,343)*y(k,205) + & + 2.000_r8*rxt(k,344)*y(k,213))*y(k,213) & + + (.500_r8*rxt(k,450)*y(k,200) +.900_r8*rxt(k,452)*y(k,124)) & + *y(k,223) +rxt(k,37)*y(k,51) +.440_r8*rxt(k,39)*y(k,54) & + +.400_r8*rxt(k,60)*y(k,140) +rxt(k,65)*y(k,176) +.800_r8*rxt(k,69) & + *y(k,180) + loss(k,89) = (rxt(k,236)* y(k,218) + rxt(k,96) + het_rates(k,64))* y(k,64) + prod(k,89) = (rxt(k,201)*y(k,34) +rxt(k,203)*y(k,37) + & + 2.000_r8*rxt(k,204)*y(k,38) +2.000_r8*rxt(k,205)*y(k,39) + & + rxt(k,206)*y(k,40) +rxt(k,227)*y(k,35) +2.000_r8*rxt(k,229)*y(k,78) + & + rxt(k,253)*y(k,83) +rxt(k,254)*y(k,84))*y(k,218) + (rxt(k,101) + & + rxt(k,248)*y(k,219))*y(k,83) + (rxt(k,102) +rxt(k,249)*y(k,219)) & + *y(k,84) +rxt(k,79)*y(k,34) +rxt(k,80)*y(k,35) +rxt(k,82)*y(k,37) & + +2.000_r8*rxt(k,83)*y(k,38) +2.000_r8*rxt(k,84)*y(k,39) +rxt(k,85) & + *y(k,40) +2.000_r8*rxt(k,98)*y(k,78) + loss(k,91) = (rxt(k,237)* y(k,218) + rxt(k,97) + het_rates(k,65))* y(k,65) + prod(k,91) = (rxt(k,100) +rxt(k,247)*y(k,219) +rxt(k,252)*y(k,218))*y(k,82) & + + (rxt(k,81) +rxt(k,202)*y(k,218))*y(k,36) + (rxt(k,82) + & + rxt(k,203)*y(k,218))*y(k,37) + loss(k,79) = (rxt(k,409)* y(k,219) + het_rates(k,66))* y(k,66) + prod(k,79) =.180_r8*rxt(k,429)*y(k,219)*y(k,182) + loss(k,99) = (rxt(k,462)* y(k,126) + (rxt(k,463) +rxt(k,477))* y(k,219) & + + het_rates(k,67))* y(k,67) + prod(k,99) = 0._r8 + loss(k,6) = ( + het_rates(k,68))* y(k,68) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,69))* y(k,69) + prod(k,7) = 0._r8 + loss(k,8) = ( + het_rates(k,70))* y(k,70) + prod(k,8) = 0._r8 + loss(k,9) = ( + rxt(k,124) + het_rates(k,71))* y(k,71) + prod(k,9) = 0._r8 + loss(k,64) = ( + rxt(k,42) + het_rates(k,72))* y(k,72) + prod(k,64) =rxt(k,297)*y(k,205)*y(k,204) + loss(k,177) = (rxt(k,232)* y(k,54) +rxt(k,233)* y(k,77) +rxt(k,235)* y(k,89) & + +rxt(k,234)* y(k,231) + het_rates(k,73))* y(k,73) + prod(k,177) = (rxt(k,205)*y(k,39) +rxt(k,227)*y(k,35) + & + 2.000_r8*rxt(k,236)*y(k,64) +rxt(k,237)*y(k,65))*y(k,218) +rxt(k,80) & + *y(k,35) +rxt(k,84)*y(k,39) +2.000_r8*rxt(k,96)*y(k,64) +rxt(k,97) & + *y(k,65) +rxt(k,104)*y(k,88) + loss(k,193) = (rxt(k,301)* y(k,219) + rxt(k,43) + het_rates(k,74))* y(k,74) + prod(k,193) = (.530_r8*rxt(k,336)*y(k,211) +.050_r8*rxt(k,374)*y(k,208) + & + .250_r8*rxt(k,393)*y(k,227) +.225_r8*rxt(k,452)*y(k,223))*y(k,124) & + + (.530_r8*rxt(k,335)*y(k,211) +.050_r8*rxt(k,375)*y(k,208) + & + .250_r8*rxt(k,394)*y(k,227))*y(k,126) & + + (.260_r8*rxt(k,333)*y(k,211) +.100_r8*rxt(k,391)*y(k,227) + & + .125_r8*rxt(k,450)*y(k,223))*y(k,200) + (.700_r8*rxt(k,376)*y(k,99) + & + .500_r8*rxt(k,377)*y(k,100) +rxt(k,388)*y(k,115))*y(k,219) & + + (.530_r8*rxt(k,332)*y(k,211) +.250_r8*rxt(k,390)*y(k,227)) & + *y(k,199) +.330_r8*rxt(k,45)*y(k,93) +.250_r8*rxt(k,65)*y(k,176) & + +rxt(k,300)*y(k,203) + loss(k,186) = (rxt(k,302)* y(k,219) + rxt(k,44) + rxt(k,480) & + + het_rates(k,75))* y(k,75) + prod(k,186) = (.050_r8*rxt(k,374)*y(k,208) +.250_r8*rxt(k,393)*y(k,227) + & + rxt(k,400)*y(k,193) +.400_r8*rxt(k,414)*y(k,212) + & + .170_r8*rxt(k,417)*y(k,214) +.700_r8*rxt(k,420)*y(k,220) + & + .600_r8*rxt(k,427)*y(k,225) +.340_r8*rxt(k,433)*y(k,228) + & + .170_r8*rxt(k,436)*y(k,230))*y(k,124) + (.650_r8*rxt(k,277)*y(k,24) + & + .200_r8*rxt(k,301)*y(k,74) +rxt(k,389)*y(k,116))*y(k,219) & + + (.250_r8*rxt(k,390)*y(k,199) +.100_r8*rxt(k,391)*y(k,200) + & + .250_r8*rxt(k,394)*y(k,126))*y(k,227) & + + (.160_r8*rxt(k,413)*y(k,212) +.070_r8*rxt(k,416)*y(k,214)) & + *y(k,205) +rxt(k,21)*y(k,8) +.130_r8*rxt(k,23)*y(k,10) & + +.050_r8*rxt(k,375)*y(k,208)*y(k,126) +.700_r8*rxt(k,61)*y(k,144) & + +.600_r8*rxt(k,70)*y(k,181) +.340_r8*rxt(k,72)*y(k,185) & + +.170_r8*rxt(k,73)*y(k,187) + loss(k,213) = (rxt(k,141)* y(k,135) + (rxt(k,135) +rxt(k,136) +rxt(k,137)) & + * y(k,205) + rxt(k,138) + het_rates(k,76))* y(k,76) + prod(k,213) = (rxt(k,142)*y(k,77) +rxt(k,145)*y(k,134) +rxt(k,163)*y(k,112) + & + rxt(k,258)*y(k,42) +rxt(k,465)*y(k,138) +rxt(k,471)*y(k,149) + & + rxt(k,476)*y(k,151))*y(k,219) + (rxt(k,125)*y(k,218) + & + rxt(k,133)*y(k,134) +rxt(k,177)*y(k,56) +rxt(k,233)*y(k,73))*y(k,77) & + + (.330_r8*rxt(k,39) +rxt(k,40) +rxt(k,272)*y(k,218))*y(k,54) & + + (rxt(k,99) +rxt(k,231)*y(k,218))*y(k,81) + (rxt(k,103) + & + rxt(k,208)*y(k,218))*y(k,85) + (rxt(k,2) +2.000_r8*rxt(k,3))*y(k,231) & + +2.000_r8*rxt(k,33)*y(k,42) +rxt(k,38)*y(k,53) +rxt(k,104)*y(k,88) + loss(k,210) = (rxt(k,177)* y(k,56) +rxt(k,233)* y(k,73) +rxt(k,133)* y(k,134) & + +rxt(k,125)* y(k,218) +rxt(k,142)* y(k,219) + het_rates(k,77)) & + * y(k,77) + prod(k,210) = (1.440_r8*rxt(k,39) +rxt(k,273)*y(k,218))*y(k,54) +rxt(k,32) & + *y(k,42) +rxt(k,135)*y(k,205)*y(k,76) +rxt(k,1)*y(k,231) + loss(k,58) = (rxt(k,229)* y(k,218) + rxt(k,98) + het_rates(k,78))* y(k,78) + prod(k,58) = 0._r8 + loss(k,149) = (rxt(k,178)* y(k,56) +rxt(k,134)* y(k,134) +rxt(k,143) & + * y(k,219) + rxt(k,4) + het_rates(k,79))* y(k,79) + prod(k,149) =rxt(k,149)*y(k,205)*y(k,205) +rxt(k,148)*y(k,219)*y(k,219) + loss(k,65) = ( + rxt(k,109) + het_rates(k,80))* y(k,80) + prod(k,65) =rxt(k,478)*y(k,231)*y(k,153) + loss(k,171) = (rxt(k,224)* y(k,134) + (rxt(k,230) +rxt(k,231))* y(k,218) & + +rxt(k,225)* y(k,219) + rxt(k,99) + het_rates(k,81))* y(k,81) + prod(k,171) = (rxt(k,211)*y(k,42) +rxt(k,212)*y(k,205))*y(k,17) + loss(k,90) = (rxt(k,252)* y(k,218) +rxt(k,247)* y(k,219) + rxt(k,100) & + + het_rates(k,82))* y(k,82) + prod(k,90) = 0._r8 + loss(k,92) = (rxt(k,253)* y(k,218) +rxt(k,248)* y(k,219) + rxt(k,101) & + + het_rates(k,83))* y(k,83) + prod(k,92) = 0._r8 + loss(k,102) = (rxt(k,254)* y(k,218) +rxt(k,249)* y(k,219) + rxt(k,102) & + + het_rates(k,84))* y(k,84) + prod(k,102) = 0._r8 + loss(k,225) = ((rxt(k,528) +rxt(k,533) +rxt(k,538))* y(k,60) + (rxt(k,530) + & + rxt(k,535))* y(k,91) + (rxt(k,523) +rxt(k,529) +rxt(k,534))* y(k,92) & + +rxt(k,195)* y(k,134) + (rxt(k,207) +rxt(k,208))* y(k,218) & + +rxt(k,196)* y(k,219) + rxt(k,103) + het_rates(k,85))* y(k,85) + prod(k,225) = (rxt(k,175)*y(k,42) +rxt(k,176)*y(k,54) +rxt(k,177)*y(k,77) + & + rxt(k,178)*y(k,79) +rxt(k,179)*y(k,205) +rxt(k,197)*y(k,92) + & + rxt(k,238)*y(k,41) +rxt(k,240)*y(k,43) +2.000_r8*rxt(k,243)*y(k,46) + & + rxt(k,245)*y(k,55) +rxt(k,286)*y(k,28))*y(k,56) +rxt(k,194)*y(k,219) & + *y(k,59) + loss(k,76) = (rxt(k,274)* y(k,218) +rxt(k,266)* y(k,219) + het_rates(k,86)) & + * y(k,86) + prod(k,76) = 0._r8 + loss(k,183) = (rxt(k,267)* y(k,219) + het_rates(k,87))* y(k,87) + prod(k,183) = (.370_r8*rxt(k,279)*y(k,25) +.120_r8*rxt(k,308)*y(k,29) + & + .330_r8*rxt(k,338)*y(k,105) +.120_r8*rxt(k,352)*y(k,111) + & + .110_r8*rxt(k,385)*y(k,98) +.050_r8*rxt(k,440)*y(k,6) + & + .050_r8*rxt(k,443)*y(k,110))*y(k,135) + (rxt(k,268)*y(k,205) + & + rxt(k,270)*y(k,124))*y(k,206) +.350_r8*rxt(k,277)*y(k,219)*y(k,24) + loss(k,100) = ( + rxt(k,104) + het_rates(k,88))* y(k,88) + prod(k,100) = (rxt(k,232)*y(k,54) +rxt(k,233)*y(k,77) +rxt(k,234)*y(k,231) + & + rxt(k,235)*y(k,89))*y(k,73) + loss(k,214) = (rxt(k,235)* y(k,73) +rxt(k,172)* y(k,219) + rxt(k,9) & + + het_rates(k,89))* y(k,89) + prod(k,214) = (rxt(k,526) +rxt(k,531) +rxt(k,537) +rxt(k,528)*y(k,85) + & + rxt(k,533)*y(k,85) +rxt(k,538)*y(k,85))*y(k,60) + (rxt(k,490) + & + rxt(k,256)*y(k,42) +rxt(k,288)*y(k,45) +rxt(k,314)*y(k,49) + & + rxt(k,462)*y(k,67))*y(k,126) + (2.000_r8*rxt(k,485) + & + 2.000_r8*rxt(k,522) +2.000_r8*rxt(k,525) +2.000_r8*rxt(k,536)) & + *y(k,114) + (rxt(k,524) +rxt(k,527) +rxt(k,532))*y(k,20) & + + (.500_r8*rxt(k,489) +rxt(k,171)*y(k,219))*y(k,125) +rxt(k,482) & + *y(k,93) +rxt(k,483)*y(k,99) +rxt(k,484)*y(k,100) +rxt(k,486) & + *y(k,115) +rxt(k,487)*y(k,116) +rxt(k,491)*y(k,128) +rxt(k,492) & + *y(k,139) +rxt(k,493)*y(k,177) + loss(k,123) = (rxt(k,150)* y(k,219) + rxt(k,10) + rxt(k,11) + rxt(k,173) & + + het_rates(k,90))* y(k,90) + prod(k,123) =rxt(k,169)*y(k,205)*y(k,125) + loss(k,167) = ((rxt(k,530) +rxt(k,535))* y(k,85) +rxt(k,226)* y(k,134) & + + rxt(k,105) + het_rates(k,91))* y(k,91) + prod(k,167) = (rxt(k,524) +rxt(k,527) +rxt(k,532))*y(k,20) & + +rxt(k,218)*y(k,205)*y(k,19) + loss(k,172) = (rxt(k,197)* y(k,56) + (rxt(k,523) +rxt(k,529) +rxt(k,534)) & + * y(k,85) +rxt(k,198)* y(k,134) +rxt(k,199)* y(k,219) + rxt(k,106) & + + het_rates(k,92))* y(k,92) + prod(k,172) = (rxt(k,526) +rxt(k,531) +rxt(k,537) +rxt(k,191)*y(k,219)) & + *y(k,60) +rxt(k,186)*y(k,205)*y(k,59) + loss(k,198) = (rxt(k,331)* y(k,219) + rxt(k,45) + rxt(k,482) & + + het_rates(k,93))* y(k,93) + prod(k,198) = (rxt(k,330)*y(k,202) +rxt(k,337)*y(k,211))*y(k,124) & + + (.300_r8*rxt(k,376)*y(k,99) +.500_r8*rxt(k,377)*y(k,100))*y(k,219) + loss(k,84) = (rxt(k,362)* y(k,219) + rxt(k,46) + het_rates(k,94))* y(k,94) + prod(k,84) =rxt(k,373)*y(k,208) + loss(k,197) = (rxt(k,316)* y(k,219) + rxt(k,47) + het_rates(k,95))* y(k,95) + prod(k,197) = (.220_r8*rxt(k,332)*y(k,199) +.230_r8*rxt(k,333)*y(k,200) + & + .220_r8*rxt(k,335)*y(k,126) +.220_r8*rxt(k,336)*y(k,124))*y(k,211) & + + (.500_r8*rxt(k,320)*y(k,147) +.500_r8*rxt(k,351)*y(k,109) + & + .700_r8*rxt(k,376)*y(k,99) +.500_r8*rxt(k,377)*y(k,100))*y(k,219) & + + (.250_r8*rxt(k,390)*y(k,199) +.100_r8*rxt(k,391)*y(k,200) + & + .250_r8*rxt(k,393)*y(k,124) +.250_r8*rxt(k,394)*y(k,126))*y(k,227) & + + (.050_r8*rxt(k,374)*y(k,124) +.050_r8*rxt(k,375)*y(k,126)) & + *y(k,208) +.170_r8*rxt(k,45)*y(k,93) +.200_r8*rxt(k,321)*y(k,222) & + *y(k,200) + loss(k,111) = (rxt(k,363)* y(k,219) + het_rates(k,96))* y(k,96) + prod(k,111) = (rxt(k,370)*y(k,199) +.750_r8*rxt(k,371)*y(k,200) + & + .870_r8*rxt(k,374)*y(k,124) +.950_r8*rxt(k,375)*y(k,126))*y(k,208) + loss(k,66) = (rxt(k,364)* y(k,219) + het_rates(k,97))* y(k,97) + prod(k,66) =.600_r8*rxt(k,387)*y(k,219)*y(k,103) + loss(k,174) = (rxt(k,378)* y(k,126) +rxt(k,385)* y(k,135) +rxt(k,386) & + * y(k,219) + het_rates(k,98))* y(k,98) + prod(k,174) = 0._r8 + loss(k,146) = (rxt(k,376)* y(k,219) + rxt(k,483) + het_rates(k,99))* y(k,99) + prod(k,146) =.080_r8*rxt(k,368)*y(k,207)*y(k,124) + loss(k,140) = (rxt(k,377)* y(k,219) + rxt(k,484) + het_rates(k,100)) & + * y(k,100) + prod(k,140) =.080_r8*rxt(k,374)*y(k,208)*y(k,124) + loss(k,200) = (rxt(k,382)* y(k,124) +rxt(k,383)* y(k,126) +rxt(k,379) & + * y(k,199) +rxt(k,380)* y(k,200) +rxt(k,381)* y(k,205) & + + het_rates(k,101))* y(k,101) + prod(k,200) =rxt(k,378)*y(k,126)*y(k,98) + loss(k,120) = (rxt(k,384)* y(k,219) + rxt(k,48) + het_rates(k,102))* y(k,102) + prod(k,120) =rxt(k,381)*y(k,205)*y(k,101) + loss(k,163) = (rxt(k,387)* y(k,219) + rxt(k,49) + het_rates(k,103))* y(k,103) + prod(k,163) = (rxt(k,367)*y(k,207) +rxt(k,372)*y(k,208))*y(k,205) +rxt(k,48) & + *y(k,102) + loss(k,50) = (rxt(k,509)* y(k,219) + het_rates(k,104))* y(k,104) + prod(k,50) = 0._r8 + loss(k,201) = (rxt(k,338)* y(k,135) +rxt(k,339)* y(k,219) + rxt(k,50) & + + rxt(k,51) + het_rates(k,105))* y(k,105) + prod(k,201) = (.390_r8*rxt(k,365)*y(k,199) +.310_r8*rxt(k,366)*y(k,200) + & + .360_r8*rxt(k,368)*y(k,124) +.400_r8*rxt(k,369)*y(k,126))*y(k,207) & + +.300_r8*rxt(k,385)*y(k,135)*y(k,98) +.300_r8*rxt(k,49)*y(k,103) + loss(k,104) = (rxt(k,340)* y(k,219) + het_rates(k,106))* y(k,106) + prod(k,104) =rxt(k,334)*y(k,211)*y(k,205) + loss(k,136) = (rxt(k,349)* y(k,219) + rxt(k,52) + het_rates(k,107))* y(k,107) + prod(k,136) =.800_r8*rxt(k,19)*y(k,1) +.800_r8*rxt(k,20)*y(k,2) & + +.800_r8*rxt(k,358)*y(k,191)*y(k,124) + loss(k,105) = (rxt(k,350)* y(k,219) + rxt(k,53) + het_rates(k,108))* y(k,108) + prod(k,105) =.800_r8*rxt(k,347)*y(k,215)*y(k,205) + loss(k,145) = (rxt(k,351)* y(k,219) + rxt(k,54) + rxt(k,355) & + + het_rates(k,109))* y(k,109) + prod(k,145) =rxt(k,354)*y(k,213)*y(k,125) + loss(k,184) = (rxt(k,442)* y(k,126) +rxt(k,443)* y(k,135) +rxt(k,444) & + * y(k,219) + het_rates(k,110))* y(k,110) + prod(k,184) = 0._r8 + loss(k,207) = (rxt(k,352)* y(k,135) +rxt(k,353)* y(k,219) + rxt(k,55) & + + het_rates(k,111))* y(k,111) + prod(k,207) = (.610_r8*rxt(k,365)*y(k,199) +.440_r8*rxt(k,366)*y(k,200) + & + .560_r8*rxt(k,368)*y(k,124) +.600_r8*rxt(k,369)*y(k,126))*y(k,207) & + +.200_r8*rxt(k,385)*y(k,135)*y(k,98) +.700_r8*rxt(k,49)*y(k,103) + loss(k,134) = (rxt(k,151)* y(k,124) + (rxt(k,152) +rxt(k,153) +rxt(k,154)) & + * y(k,125) +rxt(k,163)* y(k,219) + rxt(k,155) + het_rates(k,112)) & + * y(k,112) + prod(k,134) =rxt(k,15)*y(k,124) + loss(k,77) = ((rxt(k,167) +rxt(k,168))* y(k,218) + rxt(k,12) & + + het_rates(k,113))* y(k,113) + prod(k,77) =rxt(k,152)*y(k,125)*y(k,112) + loss(k,97) = ( + rxt(k,13) + rxt(k,14) + rxt(k,174) + rxt(k,485) + rxt(k,522) & + + rxt(k,525) + rxt(k,536) + het_rates(k,114))* y(k,114) + prod(k,97) =rxt(k,170)*y(k,126)*y(k,125) + loss(k,115) = (rxt(k,388)* y(k,219) + rxt(k,486) + het_rates(k,115)) & + * y(k,115) + prod(k,115) =.200_r8*rxt(k,380)*y(k,200)*y(k,101) + loss(k,191) = (rxt(k,389)* y(k,219) + rxt(k,56) + rxt(k,487) & + + het_rates(k,116))* y(k,116) + prod(k,191) = (rxt(k,379)*y(k,199) +.800_r8*rxt(k,380)*y(k,200) + & + rxt(k,382)*y(k,124) +rxt(k,383)*y(k,126))*y(k,101) + loss(k,10) = ( + het_rates(k,117))* y(k,117) + prod(k,10) = 0._r8 + loss(k,11) = ( + het_rates(k,118))* y(k,118) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,119))* y(k,119) + prod(k,12) = 0._r8 + loss(k,55) = (rxt(k,479)* y(k,219) + het_rates(k,120))* y(k,120) + prod(k,55) = 0._r8 + loss(k,13) = ( + rxt(k,488) + het_rates(k,121))* y(k,121) + prod(k,13) = 0._r8 + loss(k,14) = ( + rxt(k,540) + het_rates(k,122))* y(k,122) + prod(k,14) = 0._r8 + loss(k,15) = ( + rxt(k,539) + het_rates(k,123))* y(k,123) + prod(k,15) = 0._r8 + loss(k,221) = (rxt(k,219)* y(k,19) +rxt(k,187)* y(k,59) +rxt(k,382)* y(k,101) & + +rxt(k,151)* y(k,112) +rxt(k,160)* y(k,126) +rxt(k,166)* y(k,134) & + +rxt(k,165)* y(k,135) +rxt(k,397)* y(k,190) + (rxt(k,358) + & + rxt(k,359))* y(k,191) +rxt(k,400)* y(k,193) +rxt(k,405)* y(k,195) & + +rxt(k,283)* y(k,196) +rxt(k,311)* y(k,197) +rxt(k,407)* y(k,198) & + +rxt(k,294)* y(k,199) +rxt(k,262)* y(k,200) +rxt(k,411)* y(k,201) & + + (rxt(k,329) +rxt(k,330))* y(k,202) +rxt(k,298)* y(k,204) & + +rxt(k,164)* y(k,205) +rxt(k,270)* y(k,206) +rxt(k,368)* y(k,207) & + +rxt(k,374)* y(k,208) + (rxt(k,336) +rxt(k,337))* y(k,211) & + +rxt(k,414)* y(k,212) +rxt(k,345)* y(k,213) +rxt(k,417)* y(k,214) & + +rxt(k,348)* y(k,215) +rxt(k,447)* y(k,217) +rxt(k,420)* y(k,220) & + +rxt(k,319)* y(k,221) +rxt(k,323)* y(k,222) +rxt(k,452)* y(k,223) & + +rxt(k,457)* y(k,224) +rxt(k,427)* y(k,225) +rxt(k,393)* y(k,227) & + +rxt(k,433)* y(k,228) +rxt(k,436)* y(k,230) + rxt(k,15) & + + het_rates(k,124))* y(k,124) + prod(k,221) = (rxt(k,16) +.500_r8*rxt(k,489) +2.000_r8*rxt(k,153)*y(k,112) + & + rxt(k,156)*y(k,134) +rxt(k,472)*y(k,151))*y(k,125) + (rxt(k,155) + & + rxt(k,163)*y(k,219))*y(k,112) +2.000_r8*rxt(k,167)*y(k,218)*y(k,113) & + +rxt(k,14)*y(k,114) +rxt(k,17)*y(k,126) + loss(k,222) = (rxt(k,220)* y(k,19) +rxt(k,189)* y(k,59) + (rxt(k,152) + & + rxt(k,153) +rxt(k,154))* y(k,112) +rxt(k,170)* y(k,126) & + + (rxt(k,156) +rxt(k,158))* y(k,134) +rxt(k,157)* y(k,135) & + +rxt(k,422)* y(k,142) +rxt(k,472)* y(k,151) +rxt(k,425)* y(k,190) & + +rxt(k,305)* y(k,199) +rxt(k,412)* y(k,201) +rxt(k,169)* y(k,205) & + +rxt(k,415)* y(k,212) +rxt(k,354)* y(k,213) +rxt(k,418)* y(k,214) & + +rxt(k,171)* y(k,219) + rxt(k,16) + rxt(k,489) + het_rates(k,125)) & + * y(k,125) + prod(k,222) = (2.000_r8*rxt(k,160)*y(k,126) +rxt(k,164)*y(k,205) + & + rxt(k,165)*y(k,135) +rxt(k,166)*y(k,134) +rxt(k,187)*y(k,59) + & + rxt(k,219)*y(k,19) +rxt(k,262)*y(k,200) +rxt(k,270)*y(k,206) + & + rxt(k,283)*y(k,196) +rxt(k,294)*y(k,199) +rxt(k,298)*y(k,204) + & + rxt(k,311)*y(k,197) +rxt(k,319)*y(k,221) +rxt(k,323)*y(k,222) + & + rxt(k,329)*y(k,202) +rxt(k,336)*y(k,211) +rxt(k,345)*y(k,213) + & + rxt(k,348)*y(k,215) +rxt(k,358)*y(k,191) + & + .920_r8*rxt(k,368)*y(k,207) +.920_r8*rxt(k,374)*y(k,208) + & + rxt(k,382)*y(k,101) +rxt(k,393)*y(k,227) +rxt(k,397)*y(k,190) + & + rxt(k,400)*y(k,193) +rxt(k,405)*y(k,195) +rxt(k,407)*y(k,198) + & + rxt(k,411)*y(k,201) +rxt(k,414)*y(k,212) +rxt(k,417)*y(k,214) + & + rxt(k,420)*y(k,220) +rxt(k,427)*y(k,225) +rxt(k,433)*y(k,228) + & + rxt(k,436)*y(k,230) +1.600_r8*rxt(k,447)*y(k,217) + & + .900_r8*rxt(k,452)*y(k,223) +.800_r8*rxt(k,457)*y(k,224))*y(k,124) & + + (rxt(k,18) +rxt(k,159)*y(k,205) +rxt(k,161)*y(k,134) + & + rxt(k,162)*y(k,219) +rxt(k,327)*y(k,16) +rxt(k,335)*y(k,211) + & + rxt(k,346)*y(k,213) +rxt(k,369)*y(k,207) +rxt(k,375)*y(k,208) + & + rxt(k,383)*y(k,101) +rxt(k,394)*y(k,227) + & + 2.000_r8*rxt(k,448)*y(k,217))*y(k,126) + (rxt(k,150)*y(k,90) + & + rxt(k,317)*y(k,127) +rxt(k,356)*y(k,1) +.700_r8*rxt(k,376)*y(k,99) + & + rxt(k,454)*y(k,177))*y(k,219) + (rxt(k,11) +rxt(k,173))*y(k,90) & + + (rxt(k,54) +rxt(k,355))*y(k,109) + (rxt(k,13) +rxt(k,174)) & + *y(k,114) + (.600_r8*rxt(k,60) +rxt(k,306))*y(k,140) +rxt(k,19) & + *y(k,1) +rxt(k,76)*y(k,20) +rxt(k,95)*y(k,60) +rxt(k,9)*y(k,89) & + +rxt(k,45)*y(k,93) +rxt(k,48)*y(k,102) +rxt(k,56)*y(k,116) & + +rxt(k,57)*y(k,127) +rxt(k,58)*y(k,128) +rxt(k,59)*y(k,139) & + +rxt(k,430)*y(k,141) +rxt(k,66)*y(k,177) & + +.500_r8*rxt(k,445)*y(k,217)*y(k,200) + loss(k,219) = (rxt(k,439)* y(k,6) +rxt(k,327)* y(k,16) +rxt(k,307)* y(k,29) & + +rxt(k,256)* y(k,42) +rxt(k,288)* y(k,45) +rxt(k,314)* y(k,49) & + +rxt(k,462)* y(k,67) +rxt(k,378)* y(k,98) +rxt(k,383)* y(k,101) & + +rxt(k,442)* y(k,110) +rxt(k,160)* y(k,124) +rxt(k,170)* y(k,125) & + +rxt(k,161)* y(k,134) +rxt(k,459)* y(k,179) +rxt(k,159)* y(k,205) & + +rxt(k,369)* y(k,207) +rxt(k,375)* y(k,208) +rxt(k,335)* y(k,211) & + +rxt(k,346)* y(k,213) +rxt(k,448)* y(k,217) +rxt(k,162)* y(k,219) & + +rxt(k,394)* y(k,227) + rxt(k,17) + rxt(k,18) + rxt(k,490) & + + het_rates(k,126))* y(k,126) + prod(k,219) = (rxt(k,94) +rxt(k,188)*y(k,56) +rxt(k,190)*y(k,134) + & + rxt(k,191)*y(k,219))*y(k,60) + (rxt(k,13) +rxt(k,14) +rxt(k,174)) & + *y(k,114) + (rxt(k,172)*y(k,89) +rxt(k,303)*y(k,140) + & + .500_r8*rxt(k,351)*y(k,109))*y(k,219) + (rxt(k,77) + & + rxt(k,221)*y(k,134))*y(k,20) + (rxt(k,157)*y(k,135) + & + rxt(k,158)*y(k,134))*y(k,125) +rxt(k,235)*y(k,89)*y(k,73) +rxt(k,10) & + *y(k,90) +.400_r8*rxt(k,60)*y(k,140) + loss(k,176) = (rxt(k,317)* y(k,219) + rxt(k,57) + het_rates(k,127))* y(k,127) + prod(k,176) = (.500_r8*rxt(k,377)*y(k,100) +rxt(k,384)*y(k,102) + & + rxt(k,388)*y(k,115) +rxt(k,389)*y(k,116))*y(k,219) & + +rxt(k,307)*y(k,126)*y(k,29) + loss(k,118) = (rxt(k,449)* y(k,219) + rxt(k,58) + rxt(k,491) & + + het_rates(k,128))* y(k,128) + prod(k,118) =rxt(k,446)*y(k,217)*y(k,205) + loss(k,16) = ( + het_rates(k,129))* y(k,129) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,130))* y(k,130) + prod(k,17) = 0._r8 + loss(k,18) = ( + het_rates(k,131))* y(k,131) + prod(k,18) = 0._r8 + loss(k,19) = ( + het_rates(k,132))* y(k,132) + prod(k,19) = 0._r8 + loss(k,20) = ( + het_rates(k,133))* y(k,133) + prod(k,20) = 0._r8 + loss(k,227) = (rxt(k,222)* y(k,19) +rxt(k,221)* y(k,20) +rxt(k,257)* y(k,42) & + +rxt(k,192)* y(k,59) +rxt(k,190)* y(k,60) +rxt(k,133)* y(k,77) & + +rxt(k,134)* y(k,79) +rxt(k,224)* y(k,81) +rxt(k,195)* y(k,85) & + +rxt(k,226)* y(k,91) +rxt(k,198)* y(k,92) +rxt(k,166)* y(k,124) & + + (rxt(k,156) +rxt(k,158))* y(k,125) +rxt(k,161)* y(k,126) & + + 2._r8*rxt(k,131)* y(k,134) +rxt(k,130)* y(k,135) +rxt(k,464) & + * y(k,138) +rxt(k,139)* y(k,205) +rxt(k,145)* y(k,219) + rxt(k,132) & + + het_rates(k,134))* y(k,134) + prod(k,227) = (rxt(k,155) +rxt(k,151)*y(k,124) +rxt(k,152)*y(k,125))*y(k,112) & + + (rxt(k,111) +rxt(k,473))*y(k,151) + (rxt(k,127) +rxt(k,128)) & + *y(k,218) +rxt(k,75)*y(k,19) +.180_r8*rxt(k,39)*y(k,54) +rxt(k,93) & + *y(k,59) +rxt(k,41)*y(k,63) +rxt(k,137)*y(k,205)*y(k,76) +rxt(k,14) & + *y(k,114) +rxt(k,15)*y(k,124) +rxt(k,16)*y(k,125) +rxt(k,18)*y(k,126) & + +rxt(k,8)*y(k,135) +rxt(k,107)*y(k,137) +rxt(k,466)*y(k,149) & + +rxt(k,112)*y(k,152) +rxt(k,113)*y(k,153) +rxt(k,147)*y(k,219) & + *y(k,219) +rxt(k,3)*y(k,231) + loss(k,228) = (rxt(k,440)* y(k,6) +rxt(k,213)* y(k,17) +rxt(k,279)* y(k,25) & + +rxt(k,308)* y(k,29) +rxt(k,181)* y(k,56) +rxt(k,141)* y(k,76) & + +rxt(k,385)* y(k,98) +rxt(k,338)* y(k,105) +rxt(k,443)* y(k,110) & + +rxt(k,352)* y(k,111) +rxt(k,165)* y(k,124) +rxt(k,157)* y(k,125) & + +rxt(k,130)* y(k,134) +rxt(k,423)* y(k,142) +rxt(k,468)* y(k,149) & + +rxt(k,474)* y(k,151) +rxt(k,140)* y(k,205) +rxt(k,129)* y(k,218) & + +rxt(k,146)* y(k,219) + rxt(k,7) + rxt(k,8) + het_rates(k,135)) & + * y(k,135) + prod(k,228) = (.150_r8*rxt(k,293)*y(k,199) +.150_r8*rxt(k,343)*y(k,213)) & + *y(k,205) +rxt(k,132)*y(k,134) + loss(k,21) = ( + het_rates(k,136))* y(k,136) + prod(k,21) = 0._r8 + loss(k,107) = (rxt(k,475)* y(k,151) + rxt(k,107) + het_rates(k,137)) & + * y(k,137) + prod(k,107) = (rxt(k,185)*y(k,59) +rxt(k,215)*y(k,19))*y(k,59) + loss(k,113) = (rxt(k,464)* y(k,134) +rxt(k,465)* y(k,219) + rxt(k,110) & + + het_rates(k,138))* y(k,138) + prod(k,113) = 0._r8 + loss(k,87) = ( + rxt(k,59) + rxt(k,492) + het_rates(k,139))* y(k,139) + prod(k,87) =rxt(k,331)*y(k,219)*y(k,93) +.100_r8*rxt(k,452)*y(k,223)*y(k,124) + loss(k,139) = (rxt(k,303)* y(k,219) + rxt(k,60) + rxt(k,306) & + + het_rates(k,140))* y(k,140) + prod(k,139) =rxt(k,305)*y(k,199)*y(k,125) + loss(k,67) = ( + rxt(k,430) + het_rates(k,141))* y(k,141) + prod(k,67) =rxt(k,425)*y(k,190)*y(k,125) + loss(k,130) = (rxt(k,422)* y(k,125) +rxt(k,423)* y(k,135) + het_rates(k,142)) & + * y(k,142) + prod(k,130) = (.070_r8*rxt(k,409)*y(k,66) +.060_r8*rxt(k,421)*y(k,143) + & + .070_r8*rxt(k,437)*y(k,186))*y(k,219) +rxt(k,31)*y(k,32) & + +rxt(k,407)*y(k,198)*y(k,124) + loss(k,74) = (rxt(k,421)* y(k,219) + het_rates(k,143))* y(k,143) + prod(k,74) =.530_r8*rxt(k,398)*y(k,219)*y(k,7) + loss(k,108) = (rxt(k,424)* y(k,219) + rxt(k,61) + het_rates(k,144))* y(k,144) + prod(k,108) =rxt(k,419)*y(k,220)*y(k,205) + loss(k,22) = ( + het_rates(k,145))* y(k,145) + prod(k,22) = 0._r8 + loss(k,23) = ( + het_rates(k,146))* y(k,146) + prod(k,23) = 0._r8 + loss(k,141) = (rxt(k,320)* y(k,219) + rxt(k,62) + het_rates(k,147))* y(k,147) + prod(k,141) =rxt(k,318)*y(k,221)*y(k,205) + loss(k,119) = (rxt(k,324)* y(k,219) + rxt(k,63) + het_rates(k,148))* y(k,148) + prod(k,119) =.850_r8*rxt(k,322)*y(k,222)*y(k,205) + loss(k,137) = (rxt(k,468)* y(k,135) +rxt(k,471)* y(k,219) + rxt(k,466) & + + het_rates(k,149))* y(k,149) + prod(k,137) =rxt(k,110)*y(k,138) +rxt(k,111)*y(k,151) + loss(k,24) = ( + rxt(k,108) + het_rates(k,150))* y(k,150) + prod(k,24) = 0._r8 + loss(k,203) = (rxt(k,469)* y(k,19) +rxt(k,470)* y(k,59) +rxt(k,472)* y(k,125) & + +rxt(k,474)* y(k,135) +rxt(k,475)* y(k,137) +rxt(k,476)* y(k,219) & + + rxt(k,111) + rxt(k,473) + het_rates(k,151))* y(k,151) + prod(k,203) = (rxt(k,466) +rxt(k,468)*y(k,135) +rxt(k,471)*y(k,219))*y(k,149) & + +rxt(k,464)*y(k,138)*y(k,134) +rxt(k,112)*y(k,152) + loss(k,175) = (rxt(k,467)* y(k,219) + rxt(k,112) + het_rates(k,152)) & + * y(k,152) + prod(k,175) = (rxt(k,473) +rxt(k,469)*y(k,19) +rxt(k,470)*y(k,59) + & + rxt(k,472)*y(k,125) +rxt(k,474)*y(k,135) +rxt(k,475)*y(k,137) + & + rxt(k,476)*y(k,219))*y(k,151) + (rxt(k,462)*y(k,126) + & + rxt(k,463)*y(k,219) +.500_r8*rxt(k,477)*y(k,219))*y(k,67) & + +rxt(k,465)*y(k,219)*y(k,138) +rxt(k,113)*y(k,153) + loss(k,93) = (rxt(k,478)* y(k,231) + rxt(k,113) + het_rates(k,153))* y(k,153) + prod(k,93) =rxt(k,109)*y(k,80) +rxt(k,467)*y(k,219)*y(k,152) + loss(k,25) = ( + het_rates(k,154))* y(k,154) + prod(k,25) = 0._r8 + loss(k,26) = ( + het_rates(k,155))* y(k,155) + prod(k,26) = 0._r8 + loss(k,27) = ( + het_rates(k,156))* y(k,156) + prod(k,27) = 0._r8 + loss(k,28) = ( + het_rates(k,157))* y(k,157) + prod(k,28) = 0._r8 + loss(k,29) = ( + rxt(k,114) + het_rates(k,158))* y(k,158) + prod(k,29) = 0._r8 + loss(k,30) = ( + rxt(k,115) + het_rates(k,159))* y(k,159) + prod(k,30) = 0._r8 + loss(k,31) = ( + rxt(k,116) + het_rates(k,160))* y(k,160) + prod(k,31) = 0._r8 + loss(k,32) = ( + rxt(k,117) + het_rates(k,161))* y(k,161) + prod(k,32) = 0._r8 + loss(k,33) = ( + rxt(k,118) + het_rates(k,162))* y(k,162) + prod(k,33) = 0._r8 + loss(k,34) = ( + rxt(k,119) + het_rates(k,163))* y(k,163) + prod(k,34) = 0._r8 + loss(k,35) = ( + rxt(k,120) + het_rates(k,164))* y(k,164) + prod(k,35) = 0._r8 + loss(k,36) = ( + rxt(k,121) + het_rates(k,165))* y(k,165) + prod(k,36) = 0._r8 + loss(k,37) = ( + rxt(k,122) + het_rates(k,166))* y(k,166) + prod(k,37) = 0._r8 + loss(k,38) = ( + rxt(k,123) + het_rates(k,167))* y(k,167) + prod(k,38) = 0._r8 + loss(k,39) = ( + het_rates(k,168))* y(k,168) + prod(k,39) = (.1279005_r8*rxt(k,496)*y(k,192) + & + .0097005_r8*rxt(k,501)*y(k,194) +.0003005_r8*rxt(k,504)*y(k,209) + & + .1056005_r8*rxt(k,508)*y(k,210) +.0245005_r8*rxt(k,512)*y(k,216) + & + .0154005_r8*rxt(k,518)*y(k,226) +.0063005_r8*rxt(k,521)*y(k,229)) & + *y(k,124) + (.2202005_r8*rxt(k,495)*y(k,192) + & + .0023005_r8*rxt(k,500)*y(k,194) +.0031005_r8*rxt(k,503)*y(k,209) + & + .2381005_r8*rxt(k,507)*y(k,210) +.0508005_r8*rxt(k,511)*y(k,216) + & + .1364005_r8*rxt(k,517)*y(k,226) +.1677005_r8*rxt(k,520)*y(k,229)) & + *y(k,205) + (.2202005_r8*rxt(k,497)*y(k,6) + & + .0508005_r8*rxt(k,513)*y(k,110))*y(k,135) +rxt(k,480)*y(k,75) & + +.5931005_r8*rxt(k,515)*y(k,219)*y(k,174) + loss(k,40) = ( + het_rates(k,169))* y(k,169) + prod(k,40) = (.1792005_r8*rxt(k,496)*y(k,192) + & + .0034005_r8*rxt(k,501)*y(k,194) +.0003005_r8*rxt(k,504)*y(k,209) + & + .1026005_r8*rxt(k,508)*y(k,210) +.0082005_r8*rxt(k,512)*y(k,216) + & + .0452005_r8*rxt(k,518)*y(k,226) +.0237005_r8*rxt(k,521)*y(k,229)) & + *y(k,124) + (.2067005_r8*rxt(k,495)*y(k,192) + & + .0008005_r8*rxt(k,500)*y(k,194) +.0035005_r8*rxt(k,503)*y(k,209) + & + .1308005_r8*rxt(k,507)*y(k,210) +.1149005_r8*rxt(k,511)*y(k,216) + & + .0101005_r8*rxt(k,517)*y(k,226) +.0174005_r8*rxt(k,520)*y(k,229)) & + *y(k,205) + (.2067005_r8*rxt(k,497)*y(k,6) + & + .1149005_r8*rxt(k,513)*y(k,110))*y(k,135) & + +.1534005_r8*rxt(k,515)*y(k,219)*y(k,174) + loss(k,41) = ( + het_rates(k,170))* y(k,170) + prod(k,41) = (.0676005_r8*rxt(k,496)*y(k,192) + & + .1579005_r8*rxt(k,501)*y(k,194) +.0073005_r8*rxt(k,504)*y(k,209) + & + .0521005_r8*rxt(k,508)*y(k,210) +.0772005_r8*rxt(k,512)*y(k,216) + & + .0966005_r8*rxt(k,518)*y(k,226) +.0025005_r8*rxt(k,521)*y(k,229)) & + *y(k,124) + (.0653005_r8*rxt(k,495)*y(k,192) + & + .0843005_r8*rxt(k,500)*y(k,194) +.0003005_r8*rxt(k,503)*y(k,209) + & + .0348005_r8*rxt(k,507)*y(k,210) +.0348005_r8*rxt(k,511)*y(k,216) + & + .0763005_r8*rxt(k,517)*y(k,226) +.086_r8*rxt(k,520)*y(k,229)) & + *y(k,205) + (.0653005_r8*rxt(k,497)*y(k,6) + & + .0348005_r8*rxt(k,513)*y(k,110))*y(k,135) & + +.0459005_r8*rxt(k,515)*y(k,219)*y(k,174) + loss(k,42) = ( + het_rates(k,171))* y(k,171) + prod(k,42) = (.079_r8*rxt(k,496)*y(k,192) +.0059005_r8*rxt(k,501)*y(k,194) + & + .0057005_r8*rxt(k,504)*y(k,209) +.0143005_r8*rxt(k,508)*y(k,210) + & + .0332005_r8*rxt(k,512)*y(k,216) +.0073005_r8*rxt(k,518)*y(k,226) + & + .011_r8*rxt(k,521)*y(k,229))*y(k,124) & + + (.1284005_r8*rxt(k,495)*y(k,192) + & + .0443005_r8*rxt(k,500)*y(k,194) +.0271005_r8*rxt(k,503)*y(k,209) + & + .0076005_r8*rxt(k,507)*y(k,210) +.0554005_r8*rxt(k,511)*y(k,216) + & + .2157005_r8*rxt(k,517)*y(k,226) +.0512005_r8*rxt(k,520)*y(k,229)) & + *y(k,205) + (.1749305_r8*rxt(k,494)*y(k,6) + & + .0590245_r8*rxt(k,502)*y(k,98) +.1749305_r8*rxt(k,510)*y(k,110)) & + *y(k,126) + (.1284005_r8*rxt(k,497)*y(k,6) + & + .0033005_r8*rxt(k,505)*y(k,98) +.0554005_r8*rxt(k,513)*y(k,110)) & + *y(k,135) +.0085005_r8*rxt(k,515)*y(k,219)*y(k,174) + loss(k,43) = ( + het_rates(k,172))* y(k,172) + prod(k,43) = (.1254005_r8*rxt(k,496)*y(k,192) + & + .0536005_r8*rxt(k,501)*y(k,194) +.0623005_r8*rxt(k,504)*y(k,209) + & + .0166005_r8*rxt(k,508)*y(k,210) +.130_r8*rxt(k,512)*y(k,216) + & + .238_r8*rxt(k,518)*y(k,226) +.1185005_r8*rxt(k,521)*y(k,229)) & + *y(k,124) + (.114_r8*rxt(k,495)*y(k,192) + & + .1621005_r8*rxt(k,500)*y(k,194) +.0474005_r8*rxt(k,503)*y(k,209) + & + .0113005_r8*rxt(k,507)*y(k,210) +.1278005_r8*rxt(k,511)*y(k,216) + & + .0738005_r8*rxt(k,517)*y(k,226) +.1598005_r8*rxt(k,520)*y(k,229)) & + *y(k,205) + (.5901905_r8*rxt(k,494)*y(k,6) + & + .0250245_r8*rxt(k,502)*y(k,98) +.5901905_r8*rxt(k,510)*y(k,110)) & + *y(k,126) + (.114_r8*rxt(k,497)*y(k,6) + & + .1278005_r8*rxt(k,513)*y(k,110))*y(k,135) & + +.0128005_r8*rxt(k,515)*y(k,219)*y(k,174) + loss(k,44) = ( + rxt(k,541) + het_rates(k,173))* y(k,173) + prod(k,44) = 0._r8 + loss(k,45) = (rxt(k,515)* y(k,219) + het_rates(k,174))* y(k,174) + prod(k,45) = 0._r8 + loss(k,80) = ( + rxt(k,64) + het_rates(k,175))* y(k,175) + prod(k,80) = (.100_r8*rxt(k,429)*y(k,182) +.230_r8*rxt(k,431)*y(k,184)) & + *y(k,219) + loss(k,154) = (rxt(k,453)* y(k,219) + rxt(k,65) + het_rates(k,176))* y(k,176) + prod(k,154) =rxt(k,451)*y(k,223)*y(k,205) + loss(k,151) = (rxt(k,454)* y(k,219) + rxt(k,66) + rxt(k,493) & + + het_rates(k,177))* y(k,177) + prod(k,151) = (.200_r8*rxt(k,447)*y(k,217) +.200_r8*rxt(k,457)*y(k,224)) & + *y(k,124) +.500_r8*rxt(k,445)*y(k,217)*y(k,200) + loss(k,132) = (rxt(k,458)* y(k,219) + rxt(k,67) + het_rates(k,178))* y(k,178) + prod(k,132) =rxt(k,456)*y(k,224)*y(k,205) + loss(k,185) = (rxt(k,459)* y(k,126) +rxt(k,460)* y(k,219) + rxt(k,68) & + + het_rates(k,179))* y(k,179) + prod(k,185) = (.500_r8*rxt(k,445)*y(k,200) +.800_r8*rxt(k,447)*y(k,124) + & + rxt(k,448)*y(k,126))*y(k,217) + (.330_r8*rxt(k,440)*y(k,6) + & + .330_r8*rxt(k,443)*y(k,110))*y(k,135) + (rxt(k,66) + & + rxt(k,454)*y(k,219))*y(k,177) + (rxt(k,455)*y(k,200) + & + .800_r8*rxt(k,457)*y(k,124))*y(k,224) +rxt(k,58)*y(k,128) +rxt(k,67) & + *y(k,178) + loss(k,190) = (rxt(k,461)* y(k,219) + rxt(k,69) + het_rates(k,180))* y(k,180) + prod(k,190) = (.300_r8*rxt(k,440)*y(k,6) +.300_r8*rxt(k,443)*y(k,110)) & + *y(k,135) + (rxt(k,450)*y(k,200) +.900_r8*rxt(k,452)*y(k,124)) & + *y(k,223) +rxt(k,65)*y(k,176) +rxt(k,68)*y(k,179) + loss(k,155) = (rxt(k,428)* y(k,219) + rxt(k,70) + het_rates(k,181))* y(k,181) + prod(k,155) =rxt(k,426)*y(k,225)*y(k,205) + loss(k,78) = (rxt(k,429)* y(k,219) + het_rates(k,182))* y(k,182) + prod(k,78) = 0._r8 + loss(k,81) = (rxt(k,395)* y(k,219) + rxt(k,71) + het_rates(k,183))* y(k,183) + prod(k,81) =rxt(k,392)*y(k,227)*y(k,205) + loss(k,82) = (rxt(k,431)* y(k,219) + het_rates(k,184))* y(k,184) + prod(k,82) = 0._r8 + loss(k,159) = (rxt(k,434)* y(k,219) + rxt(k,72) + het_rates(k,185))* y(k,185) + prod(k,159) =rxt(k,432)*y(k,228)*y(k,205) + loss(k,83) = (rxt(k,437)* y(k,219) + het_rates(k,186))* y(k,186) + prod(k,83) =.150_r8*rxt(k,431)*y(k,219)*y(k,184) + loss(k,124) = (rxt(k,438)* y(k,219) + rxt(k,73) + het_rates(k,187))* y(k,187) + prod(k,124) =rxt(k,435)*y(k,230)*y(k,205) + loss(k,138) = (rxt(k,397)* y(k,124) +rxt(k,425)* y(k,125) +rxt(k,396) & + * y(k,205) + het_rates(k,190))* y(k,190) + prod(k,138) =rxt(k,402)*y(k,219)*y(k,22) +rxt(k,430)*y(k,141) + loss(k,179) = ((rxt(k,358) +rxt(k,359))* y(k,124) +rxt(k,357)* y(k,205) & + + het_rates(k,191))* y(k,191) + prod(k,179) = (rxt(k,360)*y(k,2) +rxt(k,361)*y(k,15))*y(k,219) + loss(k,46) = (rxt(k,496)* y(k,124) +rxt(k,495)* y(k,205) + het_rates(k,192)) & + * y(k,192) + prod(k,46) =rxt(k,498)*y(k,219)*y(k,6) + loss(k,133) = (rxt(k,400)* y(k,124) +rxt(k,399)* y(k,205) + het_rates(k,193)) & + * y(k,193) + prod(k,133) = (.350_r8*rxt(k,398)*y(k,7) +rxt(k,401)*y(k,8))*y(k,219) + loss(k,47) = (rxt(k,501)* y(k,124) +rxt(k,500)* y(k,205) + het_rates(k,194)) & + * y(k,194) + prod(k,47) =rxt(k,499)*y(k,219)*y(k,7) + loss(k,125) = (rxt(k,405)* y(k,124) +rxt(k,403)* y(k,205) + het_rates(k,195)) & + * y(k,195) + prod(k,125) = (rxt(k,404)*y(k,23) +.070_r8*rxt(k,429)*y(k,182) + & + .060_r8*rxt(k,431)*y(k,184))*y(k,219) + loss(k,173) = (rxt(k,283)* y(k,124) + 2._r8*rxt(k,280)* y(k,196) +rxt(k,281) & + * y(k,200) +rxt(k,282)* y(k,205) + het_rates(k,196))* y(k,196) + prod(k,173) = (rxt(k,286)*y(k,56) +rxt(k,287)*y(k,219))*y(k,28) & + +.500_r8*rxt(k,285)*y(k,219)*y(k,27) +rxt(k,52)*y(k,107) + loss(k,168) = (rxt(k,311)* y(k,124) +rxt(k,309)* y(k,200) +rxt(k,310) & + * y(k,205) + het_rates(k,197))* y(k,197) + prod(k,168) = (rxt(k,312)*y(k,30) +rxt(k,313)*y(k,31))*y(k,219) + loss(k,152) = (rxt(k,407)* y(k,124) +rxt(k,406)* y(k,205) + het_rates(k,198)) & + * y(k,198) + prod(k,152) = (.400_r8*rxt(k,396)*y(k,205) +rxt(k,397)*y(k,124))*y(k,190) & + +rxt(k,408)*y(k,219)*y(k,32) +rxt(k,423)*y(k,142)*y(k,135) + loss(k,209) = (rxt(k,379)* y(k,101) +rxt(k,294)* y(k,124) +rxt(k,305) & + * y(k,125) + 2._r8*rxt(k,291)* y(k,199) +rxt(k,292)* y(k,200) & + +rxt(k,293)* y(k,205) +rxt(k,365)* y(k,207) +rxt(k,370)* y(k,208) & + +rxt(k,332)* y(k,211) +rxt(k,390)* y(k,227) + het_rates(k,199)) & + * y(k,199) + prod(k,209) = (.100_r8*rxt(k,338)*y(k,105) +.280_r8*rxt(k,352)*y(k,111) + & + .080_r8*rxt(k,385)*y(k,98) +.060_r8*rxt(k,440)*y(k,6) + & + .060_r8*rxt(k,443)*y(k,110))*y(k,135) + (rxt(k,342)*y(k,200) + & + .450_r8*rxt(k,343)*y(k,205) +2.000_r8*rxt(k,344)*y(k,213) + & + rxt(k,345)*y(k,124) +rxt(k,346)*y(k,126))*y(k,213) & + + (.530_r8*rxt(k,332)*y(k,199) +.260_r8*rxt(k,333)*y(k,200) + & + .530_r8*rxt(k,335)*y(k,126) +.530_r8*rxt(k,336)*y(k,124))*y(k,211) & + + (rxt(k,289)*y(k,45) +.500_r8*rxt(k,296)*y(k,51) + & + rxt(k,315)*y(k,49) +.650_r8*rxt(k,461)*y(k,180))*y(k,219) & + + (.300_r8*rxt(k,321)*y(k,200) +.150_r8*rxt(k,322)*y(k,205) + & + rxt(k,323)*y(k,124))*y(k,222) + (rxt(k,36) +rxt(k,314)*y(k,126)) & + *y(k,49) + (.600_r8*rxt(k,60) +rxt(k,306))*y(k,140) & + + (.200_r8*rxt(k,347)*y(k,205) +rxt(k,348)*y(k,124))*y(k,215) & + +.130_r8*rxt(k,23)*y(k,10) +rxt(k,27)*y(k,14) +rxt(k,288)*y(k,126) & + *y(k,45) +rxt(k,35)*y(k,48) +.330_r8*rxt(k,45)*y(k,93) +rxt(k,47) & + *y(k,95) +1.340_r8*rxt(k,50)*y(k,105) +rxt(k,52)*y(k,107) +rxt(k,53) & + *y(k,108) +.300_r8*rxt(k,55)*y(k,111) +rxt(k,57)*y(k,127) +rxt(k,63) & + *y(k,148) +.500_r8*rxt(k,64)*y(k,175) +.650_r8*rxt(k,69)*y(k,180) + loss(k,220) = (rxt(k,182)* y(k,59) +rxt(k,380)* y(k,101) +rxt(k,262) & + * y(k,124) +rxt(k,281)* y(k,196) +rxt(k,309)* y(k,197) +rxt(k,292) & + * y(k,199) + 2._r8*(rxt(k,259) +rxt(k,260))* y(k,200) +rxt(k,261) & + * y(k,205) +rxt(k,366)* y(k,207) +rxt(k,371)* y(k,208) +rxt(k,333) & + * y(k,211) +rxt(k,342)* y(k,213) +rxt(k,445)* y(k,217) +rxt(k,321) & + * y(k,222) +rxt(k,450)* y(k,223) +rxt(k,455)* y(k,224) +rxt(k,391) & + * y(k,227) + het_rates(k,200))* y(k,200) + prod(k,220) = (2.000_r8*rxt(k,291)*y(k,199) +.900_r8*rxt(k,292)*y(k,200) + & + .450_r8*rxt(k,293)*y(k,205) +rxt(k,294)*y(k,124) + & + rxt(k,332)*y(k,211) +rxt(k,341)*y(k,213) +rxt(k,365)*y(k,207) + & + rxt(k,370)*y(k,208) +rxt(k,379)*y(k,101) +rxt(k,390)*y(k,227)) & + *y(k,199) + (rxt(k,40) +rxt(k,176)*y(k,56) +rxt(k,232)*y(k,73) + & + rxt(k,265)*y(k,219) +rxt(k,271)*y(k,218))*y(k,54) & + + (.830_r8*rxt(k,411)*y(k,201) +.170_r8*rxt(k,417)*y(k,214)) & + *y(k,124) + (.280_r8*rxt(k,308)*y(k,29) +.050_r8*rxt(k,385)*y(k,98)) & + *y(k,135) + (.330_r8*rxt(k,410)*y(k,201) + & + .070_r8*rxt(k,416)*y(k,214))*y(k,205) + (.700_r8*rxt(k,264)*y(k,53) + & + rxt(k,295)*y(k,50))*y(k,219) +rxt(k,87)*y(k,43) +rxt(k,34)*y(k,45) & + +rxt(k,89)*y(k,46) +rxt(k,35)*y(k,48) +rxt(k,37)*y(k,51) & + +.300_r8*rxt(k,55)*y(k,111) +.400_r8*rxt(k,60)*y(k,140) + loss(k,165) = (rxt(k,411)* y(k,124) +rxt(k,412)* y(k,125) +rxt(k,410) & + * y(k,205) + het_rates(k,201))* y(k,201) + prod(k,165) =.600_r8*rxt(k,25)*y(k,12) + loss(k,144) = ((rxt(k,329) +rxt(k,330))* y(k,124) + het_rates(k,202)) & + * y(k,202) + prod(k,144) =rxt(k,328)*y(k,219)*y(k,16) + loss(k,96) = ( + rxt(k,299) + rxt(k,300) + het_rates(k,203))* y(k,203) + prod(k,96) =rxt(k,42)*y(k,72) +.750_r8*rxt(k,298)*y(k,204)*y(k,124) + loss(k,160) = (rxt(k,298)* y(k,124) +rxt(k,297)* y(k,205) + het_rates(k,204)) & + * y(k,204) + prod(k,160) =rxt(k,304)*y(k,219)*y(k,25) + loss(k,224) = (rxt(k,212)* y(k,17) +rxt(k,218)* y(k,19) +rxt(k,255)* y(k,42) & + + (rxt(k,179) +rxt(k,180))* y(k,56) +rxt(k,186)* y(k,59) & + + (rxt(k,135) +rxt(k,136) +rxt(k,137))* y(k,76) +rxt(k,381) & + * y(k,101) +rxt(k,164)* y(k,124) +rxt(k,169)* y(k,125) +rxt(k,159) & + * y(k,126) +rxt(k,139)* y(k,134) +rxt(k,140)* y(k,135) +rxt(k,396) & + * y(k,190) +rxt(k,357)* y(k,191) +rxt(k,399)* y(k,193) +rxt(k,403) & + * y(k,195) +rxt(k,282)* y(k,196) +rxt(k,310)* y(k,197) +rxt(k,406) & + * y(k,198) +rxt(k,293)* y(k,199) +rxt(k,261)* y(k,200) +rxt(k,410) & + * y(k,201) +rxt(k,297)* y(k,204) + 2._r8*rxt(k,149)* y(k,205) & + +rxt(k,268)* y(k,206) +rxt(k,367)* y(k,207) +rxt(k,372)* y(k,208) & + +rxt(k,334)* y(k,211) +rxt(k,413)* y(k,212) +rxt(k,343)* y(k,213) & + +rxt(k,416)* y(k,214) +rxt(k,347)* y(k,215) +rxt(k,446)* y(k,217) & + +rxt(k,144)* y(k,219) +rxt(k,419)* y(k,220) +rxt(k,318)* y(k,221) & + +rxt(k,322)* y(k,222) +rxt(k,451)* y(k,223) +rxt(k,456)* y(k,224) & + +rxt(k,426)* y(k,225) +rxt(k,392)* y(k,227) +rxt(k,432)* y(k,228) & + +rxt(k,435)* y(k,230) + rxt(k,481) + het_rates(k,205))* y(k,205) + prod(k,224) = (rxt(k,143)*y(k,79) +rxt(k,146)*y(k,135) +rxt(k,162)*y(k,126) + & + rxt(k,193)*y(k,59) +rxt(k,223)*y(k,19) +rxt(k,241)*y(k,43) + & + rxt(k,244)*y(k,46) +rxt(k,263)*y(k,52) +rxt(k,266)*y(k,86) + & + rxt(k,267)*y(k,87) +rxt(k,275)*y(k,62) +.350_r8*rxt(k,277)*y(k,24) + & + rxt(k,284)*y(k,26) +rxt(k,290)*y(k,47) +rxt(k,301)*y(k,74) + & + rxt(k,302)*y(k,75) +rxt(k,316)*y(k,95) +rxt(k,331)*y(k,93) + & + .200_r8*rxt(k,340)*y(k,106) +.500_r8*rxt(k,351)*y(k,109) + & + .300_r8*rxt(k,376)*y(k,99) +rxt(k,377)*y(k,100) + & + rxt(k,384)*y(k,102) +rxt(k,388)*y(k,115) +rxt(k,389)*y(k,116) + & + .650_r8*rxt(k,398)*y(k,7) +.730_r8*rxt(k,409)*y(k,66) + & + .800_r8*rxt(k,421)*y(k,143) +.280_r8*rxt(k,429)*y(k,182) + & + .380_r8*rxt(k,431)*y(k,184) +.630_r8*rxt(k,437)*y(k,186) + & + .200_r8*rxt(k,461)*y(k,180) +rxt(k,467)*y(k,152) + & + .500_r8*rxt(k,477)*y(k,67))*y(k,219) + (rxt(k,262)*y(k,200) + & + rxt(k,270)*y(k,206) +rxt(k,283)*y(k,196) + & + .250_r8*rxt(k,298)*y(k,204) +rxt(k,311)*y(k,197) + & + rxt(k,319)*y(k,221) +rxt(k,329)*y(k,202) + & + .470_r8*rxt(k,336)*y(k,211) +rxt(k,358)*y(k,191) + & + .920_r8*rxt(k,368)*y(k,207) +.920_r8*rxt(k,374)*y(k,208) + & + rxt(k,382)*y(k,101) +rxt(k,393)*y(k,227) +rxt(k,400)*y(k,193) + & + rxt(k,405)*y(k,195) +.170_r8*rxt(k,411)*y(k,201) + & + .400_r8*rxt(k,414)*y(k,212) +.830_r8*rxt(k,417)*y(k,214) + & + rxt(k,420)*y(k,220) +rxt(k,427)*y(k,225) +rxt(k,433)*y(k,228) + & + rxt(k,436)*y(k,230) +.900_r8*rxt(k,452)*y(k,223) + & + .800_r8*rxt(k,457)*y(k,224))*y(k,124) + (rxt(k,182)*y(k,59) + & + 2.000_r8*rxt(k,259)*y(k,200) +rxt(k,281)*y(k,196) + & + .900_r8*rxt(k,292)*y(k,199) +rxt(k,309)*y(k,197) + & + .300_r8*rxt(k,321)*y(k,222) +.730_r8*rxt(k,333)*y(k,211) + & + rxt(k,342)*y(k,213) +rxt(k,366)*y(k,207) +rxt(k,371)*y(k,208) + & + 1.200_r8*rxt(k,380)*y(k,101) +.800_r8*rxt(k,391)*y(k,227) + & + .500_r8*rxt(k,445)*y(k,217) +rxt(k,450)*y(k,223) + & + rxt(k,455)*y(k,224))*y(k,200) + (.130_r8*rxt(k,279)*y(k,25) + & + .280_r8*rxt(k,308)*y(k,29) +.140_r8*rxt(k,338)*y(k,105) + & + .280_r8*rxt(k,352)*y(k,111) +.370_r8*rxt(k,385)*y(k,98) + & + .570_r8*rxt(k,440)*y(k,6) +.570_r8*rxt(k,443)*y(k,110))*y(k,135) & + + (rxt(k,256)*y(k,42) +.470_r8*rxt(k,335)*y(k,211) + & + rxt(k,369)*y(k,207) +rxt(k,375)*y(k,208) +rxt(k,383)*y(k,101) + & + rxt(k,394)*y(k,227))*y(k,126) + (.470_r8*rxt(k,332)*y(k,211) + & + rxt(k,365)*y(k,207) +rxt(k,370)*y(k,208) +rxt(k,379)*y(k,101) + & + rxt(k,390)*y(k,227))*y(k,199) + (rxt(k,175)*y(k,42) + & + rxt(k,178)*y(k,79) +rxt(k,240)*y(k,43) +rxt(k,243)*y(k,46))*y(k,56) & + + (.070_r8*rxt(k,410)*y(k,201) +.160_r8*rxt(k,413)*y(k,212) + & + .330_r8*rxt(k,416)*y(k,214))*y(k,205) + (rxt(k,211)*y(k,17) + & + rxt(k,257)*y(k,134))*y(k,42) + (rxt(k,11) +rxt(k,173))*y(k,90) & + + (1.340_r8*rxt(k,50) +.660_r8*rxt(k,51))*y(k,105) + (rxt(k,299) + & + rxt(k,300))*y(k,203) +rxt(k,19)*y(k,1) +.900_r8*rxt(k,20)*y(k,2) & + +rxt(k,21)*y(k,8) +1.500_r8*rxt(k,22)*y(k,9) +.560_r8*rxt(k,23) & + *y(k,10) +rxt(k,24)*y(k,11) +.600_r8*rxt(k,25)*y(k,12) & + +.600_r8*rxt(k,26)*y(k,13) +rxt(k,27)*y(k,14) +rxt(k,28)*y(k,23) & + +rxt(k,29)*y(k,27) +rxt(k,30)*y(k,30) +rxt(k,34)*y(k,45) +rxt(k,36) & + *y(k,49) +rxt(k,272)*y(k,218)*y(k,54) +2.000_r8*rxt(k,43)*y(k,74) & + +2.000_r8*rxt(k,44)*y(k,75) +rxt(k,138)*y(k,76) +rxt(k,134)*y(k,134) & + *y(k,79) +.670_r8*rxt(k,45)*y(k,93) +rxt(k,46)*y(k,94) +rxt(k,47) & + *y(k,95) +rxt(k,48)*y(k,102) +rxt(k,49)*y(k,103) +rxt(k,56)*y(k,116) & + +rxt(k,61)*y(k,144) +rxt(k,62)*y(k,147) +rxt(k,64)*y(k,175) & + +rxt(k,65)*y(k,176) +rxt(k,66)*y(k,177) +rxt(k,67)*y(k,178) & + +rxt(k,68)*y(k,179) +1.200_r8*rxt(k,69)*y(k,180) +rxt(k,70)*y(k,181) & + +rxt(k,72)*y(k,185) +rxt(k,73)*y(k,187) & + +1.200_r8*rxt(k,280)*y(k,196)*y(k,196) +rxt(k,269)*y(k,206) & + +rxt(k,373)*y(k,208) + loss(k,126) = (rxt(k,270)* y(k,124) +rxt(k,268)* y(k,205) + rxt(k,269) & + + het_rates(k,206))* y(k,206) + prod(k,126) =rxt(k,255)*y(k,205)*y(k,42) + loss(k,204) = (rxt(k,368)* y(k,124) +rxt(k,369)* y(k,126) +rxt(k,365) & + * y(k,199) +rxt(k,366)* y(k,200) +rxt(k,367)* y(k,205) & + + het_rates(k,207))* y(k,207) + prod(k,204) =.600_r8*rxt(k,386)*y(k,219)*y(k,98) + loss(k,205) = (rxt(k,374)* y(k,124) +rxt(k,375)* y(k,126) +rxt(k,370) & + * y(k,199) +rxt(k,371)* y(k,200) +rxt(k,372)* y(k,205) + rxt(k,373) & + + het_rates(k,208))* y(k,208) + prod(k,205) =.400_r8*rxt(k,386)*y(k,219)*y(k,98) + loss(k,48) = (rxt(k,504)* y(k,124) +rxt(k,503)* y(k,205) + het_rates(k,209)) & + * y(k,209) + prod(k,48) =rxt(k,506)*y(k,219)*y(k,98) + loss(k,49) = (rxt(k,508)* y(k,124) +rxt(k,507)* y(k,205) + het_rates(k,210)) & + * y(k,210) + prod(k,49) =rxt(k,509)*y(k,219)*y(k,104) + loss(k,206) = ((rxt(k,336) +rxt(k,337))* y(k,124) +rxt(k,335)* y(k,126) & + +rxt(k,332)* y(k,199) +rxt(k,333)* y(k,200) +rxt(k,334)* y(k,205) & + + het_rates(k,211))* y(k,211) + prod(k,206) = (.500_r8*rxt(k,339)*y(k,105) +.200_r8*rxt(k,340)*y(k,106) + & + rxt(k,353)*y(k,111))*y(k,219) + loss(k,161) = (rxt(k,414)* y(k,124) +rxt(k,415)* y(k,125) +rxt(k,413) & + * y(k,205) + het_rates(k,212))* y(k,212) + prod(k,161) =.600_r8*rxt(k,24)*y(k,11) + loss(k,208) = (rxt(k,345)* y(k,124) +rxt(k,354)* y(k,125) +rxt(k,346) & + * y(k,126) +rxt(k,341)* y(k,199) +rxt(k,342)* y(k,200) +rxt(k,343) & + * y(k,205) + 2._r8*rxt(k,344)* y(k,213) + het_rates(k,213))* y(k,213) + prod(k,208) = (.660_r8*rxt(k,50) +.500_r8*rxt(k,339)*y(k,219))*y(k,105) & + + (rxt(k,54) +rxt(k,355))*y(k,109) +.500_r8*rxt(k,340)*y(k,219) & + *y(k,106) + loss(k,178) = (rxt(k,417)* y(k,124) +rxt(k,418)* y(k,125) +rxt(k,416) & + * y(k,205) + het_rates(k,214))* y(k,214) + prod(k,178) =.600_r8*rxt(k,26)*y(k,13) + loss(k,157) = (rxt(k,348)* y(k,124) +rxt(k,347)* y(k,205) + het_rates(k,215)) & + * y(k,215) + prod(k,157) = (rxt(k,349)*y(k,107) +rxt(k,350)*y(k,108))*y(k,219) + loss(k,51) = (rxt(k,512)* y(k,124) +rxt(k,511)* y(k,205) + het_rates(k,216)) & + * y(k,216) + prod(k,51) =rxt(k,514)*y(k,219)*y(k,110) + loss(k,189) = (rxt(k,447)* y(k,124) +rxt(k,448)* y(k,126) +rxt(k,445) & + * y(k,200) +rxt(k,446)* y(k,205) + het_rates(k,217))* y(k,217) + prod(k,189) = (rxt(k,439)*y(k,6) +rxt(k,442)*y(k,110) + & + .500_r8*rxt(k,459)*y(k,179))*y(k,126) +rxt(k,449)*y(k,219)*y(k,128) + loss(k,216) = (rxt(k,200)* y(k,33) +rxt(k,201)* y(k,34) +rxt(k,227)* y(k,35) & + +rxt(k,202)* y(k,36) +rxt(k,203)* y(k,37) +rxt(k,204)* y(k,38) & + +rxt(k,205)* y(k,39) +rxt(k,206)* y(k,40) +rxt(k,250)* y(k,41) & + +rxt(k,251)* y(k,43) + (rxt(k,271) +rxt(k,272) +rxt(k,273))* y(k,54) & + +rxt(k,228)* y(k,55) +rxt(k,236)* y(k,64) +rxt(k,237)* y(k,65) & + +rxt(k,125)* y(k,77) +rxt(k,229)* y(k,78) + (rxt(k,230) +rxt(k,231)) & + * y(k,81) +rxt(k,252)* y(k,82) +rxt(k,253)* y(k,83) +rxt(k,254) & + * y(k,84) + (rxt(k,207) +rxt(k,208))* y(k,85) +rxt(k,274)* y(k,86) & + + (rxt(k,167) +rxt(k,168))* y(k,113) +rxt(k,129)* y(k,135) & + +rxt(k,126)* y(k,231) + rxt(k,127) + rxt(k,128) + het_rates(k,218)) & + * y(k,218) + prod(k,216) =rxt(k,12)*y(k,113) +rxt(k,7)*y(k,135) +rxt(k,1)*y(k,231) + loss(k,217) = (rxt(k,356)* y(k,1) +rxt(k,360)* y(k,2) +rxt(k,441)* y(k,6) & + +rxt(k,398)* y(k,7) +rxt(k,401)* y(k,8) +rxt(k,361)* y(k,15) & + +rxt(k,328)* y(k,16) +rxt(k,223)* y(k,19) +rxt(k,402)* y(k,22) & + +rxt(k,404)* y(k,23) +rxt(k,277)* y(k,24) +rxt(k,304)* y(k,25) & + +rxt(k,284)* y(k,26) +rxt(k,285)* y(k,27) +rxt(k,287)* y(k,28) & + +rxt(k,325)* y(k,29) +rxt(k,312)* y(k,30) +rxt(k,313)* y(k,31) & + +rxt(k,408)* y(k,32) +rxt(k,239)* y(k,41) +rxt(k,258)* y(k,42) & + +rxt(k,241)* y(k,43) +rxt(k,242)* y(k,44) +rxt(k,289)* y(k,45) & + +rxt(k,244)* y(k,46) +rxt(k,290)* y(k,47) +rxt(k,326)* y(k,48) & + +rxt(k,315)* y(k,49) +rxt(k,295)* y(k,50) +rxt(k,296)* y(k,51) & + +rxt(k,263)* y(k,52) +rxt(k,264)* y(k,53) +rxt(k,265)* y(k,54) & + +rxt(k,246)* y(k,55) + (rxt(k,193) +rxt(k,194))* y(k,59) +rxt(k,191) & + * y(k,60) +rxt(k,275)* y(k,62) +rxt(k,409)* y(k,66) + (rxt(k,463) + & + rxt(k,477))* y(k,67) +rxt(k,301)* y(k,74) +rxt(k,302)* y(k,75) & + +rxt(k,142)* y(k,77) +rxt(k,143)* y(k,79) +rxt(k,225)* y(k,81) & + +rxt(k,247)* y(k,82) +rxt(k,248)* y(k,83) +rxt(k,249)* y(k,84) & + +rxt(k,196)* y(k,85) +rxt(k,266)* y(k,86) +rxt(k,267)* y(k,87) & + +rxt(k,172)* y(k,89) +rxt(k,150)* y(k,90) +rxt(k,199)* y(k,92) & + +rxt(k,331)* y(k,93) +rxt(k,362)* y(k,94) +rxt(k,316)* y(k,95) & + +rxt(k,363)* y(k,96) +rxt(k,364)* y(k,97) +rxt(k,386)* y(k,98) & + +rxt(k,376)* y(k,99) +rxt(k,377)* y(k,100) +rxt(k,384)* y(k,102) & + +rxt(k,387)* y(k,103) +rxt(k,339)* y(k,105) +rxt(k,340)* y(k,106) & + +rxt(k,349)* y(k,107) +rxt(k,350)* y(k,108) +rxt(k,351)* y(k,109) & + +rxt(k,444)* y(k,110) +rxt(k,353)* y(k,111) +rxt(k,163)* y(k,112) & + +rxt(k,388)* y(k,115) +rxt(k,389)* y(k,116) +rxt(k,479)* y(k,120) & + +rxt(k,171)* y(k,125) +rxt(k,162)* y(k,126) +rxt(k,317)* y(k,127) & + +rxt(k,449)* y(k,128) +rxt(k,145)* y(k,134) +rxt(k,146)* y(k,135) & + +rxt(k,465)* y(k,138) +rxt(k,303)* y(k,140) +rxt(k,421)* y(k,143) & + +rxt(k,424)* y(k,144) +rxt(k,320)* y(k,147) +rxt(k,324)* y(k,148) & + +rxt(k,471)* y(k,149) +rxt(k,476)* y(k,151) +rxt(k,467)* y(k,152) & + +rxt(k,453)* y(k,176) +rxt(k,454)* y(k,177) +rxt(k,458)* y(k,178) & + +rxt(k,460)* y(k,179) +rxt(k,461)* y(k,180) +rxt(k,428)* y(k,181) & + +rxt(k,429)* y(k,182) +rxt(k,395)* y(k,183) +rxt(k,431)* y(k,184) & + +rxt(k,434)* y(k,185) +rxt(k,437)* y(k,186) +rxt(k,438)* y(k,187) & + +rxt(k,144)* y(k,205) + 2._r8*(rxt(k,147) +rxt(k,148))* y(k,219) & + + het_rates(k,219))* y(k,219) + prod(k,217) = (2.000_r8*rxt(k,136)*y(k,76) +rxt(k,139)*y(k,134) + & + rxt(k,140)*y(k,135) +rxt(k,159)*y(k,126) +rxt(k,164)*y(k,124) + & + rxt(k,180)*y(k,56) +.450_r8*rxt(k,293)*y(k,199) + & + .150_r8*rxt(k,322)*y(k,222) +.450_r8*rxt(k,343)*y(k,213) + & + .200_r8*rxt(k,347)*y(k,215) +.400_r8*rxt(k,396)*y(k,190) + & + .400_r8*rxt(k,410)*y(k,201) +.400_r8*rxt(k,416)*y(k,214))*y(k,205) & + + (rxt(k,141)*y(k,76) +.130_r8*rxt(k,279)*y(k,25) + & + .360_r8*rxt(k,308)*y(k,29) +.240_r8*rxt(k,338)*y(k,105) + & + .360_r8*rxt(k,352)*y(k,111) +.320_r8*rxt(k,385)*y(k,98) + & + .630_r8*rxt(k,440)*y(k,6) +.630_r8*rxt(k,443)*y(k,110))*y(k,135) & + + (rxt(k,133)*y(k,77) +rxt(k,134)*y(k,79) +rxt(k,195)*y(k,85) + & + rxt(k,198)*y(k,92) +rxt(k,224)*y(k,81) +rxt(k,226)*y(k,91) + & + rxt(k,257)*y(k,42))*y(k,134) + (.300_r8*rxt(k,264)*y(k,53) + & + .650_r8*rxt(k,277)*y(k,24) +.500_r8*rxt(k,285)*y(k,27) + & + .500_r8*rxt(k,320)*y(k,147) +.100_r8*rxt(k,340)*y(k,106) + & + .600_r8*rxt(k,387)*y(k,103) +.500_r8*rxt(k,395)*y(k,183))*y(k,219) & + + (rxt(k,125)*y(k,77) +2.000_r8*rxt(k,126)*y(k,231) + & + rxt(k,207)*y(k,85) +rxt(k,230)*y(k,81) +rxt(k,271)*y(k,54) + & + rxt(k,274)*y(k,86))*y(k,218) + (rxt(k,2) +rxt(k,234)*y(k,73)) & + *y(k,231) +rxt(k,20)*y(k,2) +rxt(k,21)*y(k,8) +rxt(k,28)*y(k,23) & + +rxt(k,29)*y(k,27) +rxt(k,30)*y(k,30) +rxt(k,31)*y(k,32) +rxt(k,37) & + *y(k,51) +rxt(k,38)*y(k,53) +.330_r8*rxt(k,39)*y(k,54) +rxt(k,42) & + *y(k,72) +2.000_r8*rxt(k,4)*y(k,79) +rxt(k,9)*y(k,89) +rxt(k,10) & + *y(k,90) +rxt(k,105)*y(k,91) +rxt(k,106)*y(k,92) +rxt(k,46)*y(k,94) & + +rxt(k,49)*y(k,103) +rxt(k,53)*y(k,108) +.500_r8*rxt(k,489)*y(k,125) & + +rxt(k,58)*y(k,128) +rxt(k,61)*y(k,144) +rxt(k,62)*y(k,147) & + +rxt(k,63)*y(k,148) +rxt(k,65)*y(k,176) +rxt(k,67)*y(k,178) & + +rxt(k,70)*y(k,181) +rxt(k,71)*y(k,183) +rxt(k,72)*y(k,185) & + +rxt(k,73)*y(k,187) + loss(k,127) = (rxt(k,420)* y(k,124) +rxt(k,419)* y(k,205) + het_rates(k,220)) & + * y(k,220) + prod(k,127) = (.200_r8*rxt(k,409)*y(k,66) +.140_r8*rxt(k,421)*y(k,143) + & + rxt(k,424)*y(k,144))*y(k,219) + loss(k,166) = (rxt(k,319)* y(k,124) +rxt(k,318)* y(k,205) + het_rates(k,221)) & + * y(k,221) + prod(k,166) = (.500_r8*rxt(k,320)*y(k,147) +rxt(k,325)*y(k,29))*y(k,219) + loss(k,196) = (rxt(k,323)* y(k,124) +rxt(k,321)* y(k,200) +rxt(k,322) & + * y(k,205) + het_rates(k,222))* y(k,222) + prod(k,196) = (rxt(k,324)*y(k,148) +rxt(k,326)*y(k,48) + & + .150_r8*rxt(k,461)*y(k,180))*y(k,219) + (.060_r8*rxt(k,440)*y(k,6) + & + .060_r8*rxt(k,443)*y(k,110))*y(k,135) +.150_r8*rxt(k,69)*y(k,180) + loss(k,194) = (rxt(k,452)* y(k,124) +rxt(k,450)* y(k,200) +rxt(k,451) & + * y(k,205) + het_rates(k,223))* y(k,223) + prod(k,194) = (.500_r8*rxt(k,459)*y(k,126) +rxt(k,460)*y(k,219))*y(k,179) & + +rxt(k,453)*y(k,219)*y(k,176) + loss(k,181) = (rxt(k,457)* y(k,124) +rxt(k,455)* y(k,200) +rxt(k,456) & + * y(k,205) + het_rates(k,224))* y(k,224) + prod(k,181) = (rxt(k,441)*y(k,6) +rxt(k,444)*y(k,110) +rxt(k,458)*y(k,178)) & + *y(k,219) + loss(k,162) = (rxt(k,427)* y(k,124) +rxt(k,426)* y(k,205) + het_rates(k,225)) & + * y(k,225) + prod(k,162) = (rxt(k,428)*y(k,181) +.650_r8*rxt(k,429)*y(k,182))*y(k,219) + loss(k,52) = (rxt(k,518)* y(k,124) +rxt(k,517)* y(k,205) + het_rates(k,226)) & + * y(k,226) + prod(k,52) =rxt(k,516)*y(k,219)*y(k,182) + loss(k,199) = (rxt(k,393)* y(k,124) +rxt(k,394)* y(k,126) +rxt(k,390) & + * y(k,199) +rxt(k,391)* y(k,200) +rxt(k,392)* y(k,205) & + + het_rates(k,227))* y(k,227) + prod(k,199) = (rxt(k,362)*y(k,94) +rxt(k,363)*y(k,96) +rxt(k,364)*y(k,97) + & + .400_r8*rxt(k,387)*y(k,103) +.500_r8*rxt(k,395)*y(k,183))*y(k,219) + loss(k,164) = (rxt(k,433)* y(k,124) +rxt(k,432)* y(k,205) + het_rates(k,228)) & + * y(k,228) + prod(k,164) = (.560_r8*rxt(k,431)*y(k,184) +rxt(k,434)*y(k,185))*y(k,219) + loss(k,53) = (rxt(k,521)* y(k,124) +rxt(k,520)* y(k,205) + het_rates(k,229)) & + * y(k,229) + prod(k,53) =rxt(k,519)*y(k,219)*y(k,184) + loss(k,135) = (rxt(k,436)* y(k,124) +rxt(k,435)* y(k,205) + het_rates(k,230)) & + * y(k,230) + prod(k,135) = (.300_r8*rxt(k,437)*y(k,186) +rxt(k,438)*y(k,187))*y(k,219) + loss(k,229) = (rxt(k,234)* y(k,73) +rxt(k,478)* y(k,153) +rxt(k,126) & + * y(k,218) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,231)) & + * y(k,231) + prod(k,229) = (rxt(k,142)*y(k,77) +rxt(k,143)*y(k,79) +rxt(k,144)*y(k,205) + & + rxt(k,147)*y(k,219) +rxt(k,150)*y(k,90) +rxt(k,172)*y(k,89) + & + rxt(k,196)*y(k,85) +rxt(k,199)*y(k,92) +rxt(k,225)*y(k,81) + & + rxt(k,239)*y(k,41) +rxt(k,241)*y(k,43) +rxt(k,242)*y(k,44) + & + rxt(k,244)*y(k,46) +rxt(k,249)*y(k,84) +rxt(k,258)*y(k,42) + & + rxt(k,264)*y(k,53) +rxt(k,265)*y(k,54) +rxt(k,267)*y(k,87) + & + rxt(k,287)*y(k,28) +rxt(k,289)*y(k,45) +rxt(k,295)*y(k,50) + & + rxt(k,296)*y(k,51) +rxt(k,312)*y(k,30) +rxt(k,313)*y(k,31) + & + rxt(k,315)*y(k,49) +rxt(k,320)*y(k,147) +rxt(k,324)*y(k,148) + & + rxt(k,326)*y(k,48) +.500_r8*rxt(k,339)*y(k,105) +rxt(k,479)*y(k,120)) & + *y(k,219) + (rxt(k,523)*y(k,92) +rxt(k,529)*y(k,92) + & + rxt(k,530)*y(k,91) +rxt(k,534)*y(k,92) +rxt(k,535)*y(k,91))*y(k,85) & + + (rxt(k,481) +rxt(k,137)*y(k,76))*y(k,205) +.050_r8*rxt(k,39) & + *y(k,54) +rxt(k,109)*y(k,80) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_trop_strat_mam5_vbs/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..4a5f4c3eed --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/mo_rxt_rates_conv.F90 @@ -0,0 +1,553 @@ +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,:, 231) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 231) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 231) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 79) ! rate_const*H2O2 + ! rate_const*O2 + ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 135) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 135) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 89) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 90) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 90) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 113) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 124) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 125) ! rate_const*NO2 + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 126) ! rate_const*NO3 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 126) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 1) ! rate_const*ALKNIT + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 2) ! rate_const*ALKOOH + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 8) ! rate_const*BENZOOH + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 9) ! rate_const*BEPOMUC + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 10) ! rate_const*BIGALD + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 11) ! rate_const*BIGALD1 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 12) ! rate_const*BIGALD2 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 13) ! rate_const*BIGALD3 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 14) ! rate_const*BIGALD4 + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 23) ! rate_const*BZOOH + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 27) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 30) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 32) ! rate_const*C6H5OOH + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 42) ! rate_const*CH2O + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 42) ! rate_const*CH2O + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 45) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 48) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 49) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 51) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 53) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 54) ! rate_const*CH4 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 54) ! rate_const*CH4 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 63) ! rate_const*CO2 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 72) ! rate_const*EOOH + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 74) ! rate_const*GLYALD + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 75) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 93) ! rate_const*HONITR + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 94) ! rate_const*HPALD + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 95) ! rate_const*HYAC + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 102) ! rate_const*ISOPNOOH + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 103) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 105) ! rate_const*MACR + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 105) ! rate_const*MACR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 107) ! rate_const*MEK + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 108) ! rate_const*MEKOOH + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 109) ! rate_const*MPAN + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 111) ! rate_const*MVK + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 116) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 127) ! rate_const*NOA + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 128) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 139) ! rate_const*ONITR + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 140) ! rate_const*PAN + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 144) ! rate_const*PHENOOH + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 147) ! rate_const*POOH + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 148) ! rate_const*ROOH + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 175) ! rate_const*TEPOMUC + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 176) ! rate_const*TERP2OOH + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 177) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 178) ! rate_const*TERPOOH + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 179) ! rate_const*TERPROD1 + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 180) ! rate_const*TERPROD2 + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 181) ! rate_const*TOLOOH + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 183) ! rate_const*XOOH + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 185) ! rate_const*XYLENOOH + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 187) ! rate_const*XYLOLOOH + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 18) ! rate_const*BRCL + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 19) ! rate_const*BRO + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 33) ! rate_const*CCL4 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 34) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 35) ! rate_const*CF3BR + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 36) ! rate_const*CFC11 + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 37) ! rate_const*CFC113 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 38) ! rate_const*CFC114 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 39) ! rate_const*CFC115 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 40) ! rate_const*CFC12 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 41) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 43) ! rate_const*CH3BR + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 44) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 46) ! rate_const*CH3CL + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 55) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 57) ! rate_const*CL2 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 58) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 59) ! rate_const*CLO + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 64) ! rate_const*COF2 + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 65) ! rate_const*COFCL + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 78) ! rate_const*H2402 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 81) ! rate_const*HBR + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 82) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 83) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 84) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 85) ! rate_const*HCL + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 88) ! rate_const*HF + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 91) ! rate_const*HOBR + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 92) ! rate_const*HOCL + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 137) ! rate_const*OCLO + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 150) ! rate_const*SF6 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 80) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 138) ! rate_const*OCS + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 151) ! rate_const*SO + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 152) ! rate_const*SO2 + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 153) ! rate_const*SO3 + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 158) ! rate_const*soa1_a1 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 159) ! rate_const*soa1_a2 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 160) ! rate_const*soa2_a1 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 161) ! rate_const*soa2_a2 + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 162) ! rate_const*soa3_a1 + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 163) ! rate_const*soa3_a2 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 164) ! rate_const*soa4_a1 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 165) ! rate_const*soa4_a2 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 166) ! rate_const*soa5_a1 + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 167) ! rate_const*soa5_a2 + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 71) ! rate_const*E90 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 218)*sol(:ncol,:, 77) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 218)*sol(:ncol,:, 231) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 218) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 218) ! rate_const*O2*O1D + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 218)*sol(:ncol,:, 135) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 134)*sol(:ncol,:, 135) ! rate_const*O*O3 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 134)*sol(:ncol,:, 134) ! rate_const*M*O*O + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 134) ! rate_const*O2*M*O + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 77)*sol(:ncol,:, 134) ! rate_const*H2*O + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 79)*sol(:ncol,:, 134) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 76)*sol(:ncol,:, 205) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 76)*sol(:ncol,:, 205) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 76)*sol(:ncol,:, 205) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 76) ! rate_const*O2*M*H + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 205)*sol(:ncol,:, 134) ! rate_const*HO2*O + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 205)*sol(:ncol,:, 135) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 76)*sol(:ncol,:, 135) ! rate_const*H*O3 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 219)*sol(:ncol,:, 77) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 219)*sol(:ncol,:, 79) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 219)*sol(:ncol,:, 205) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 219)*sol(:ncol,:, 134) ! rate_const*OH*O + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 219)*sol(:ncol,:, 135) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 219)*sol(:ncol,:, 219) ! rate_const*OH*OH + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 219)*sol(:ncol,:, 219) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 205)*sol(:ncol,:, 205) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 90)*sol(:ncol,:, 219) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 112)*sol(:ncol,:, 124) ! rate_const*N*NO + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 112) ! rate_const*O2*N + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 125)*sol(:ncol,:, 134) ! rate_const*NO2*O + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 125)*sol(:ncol,:, 135) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 125)*sol(:ncol,:, 134) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 126)*sol(:ncol,:, 205) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 126)*sol(:ncol,:, 124) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 126)*sol(:ncol,:, 134) ! rate_const*NO3*O + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 126)*sol(:ncol,:, 219) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 112)*sol(:ncol,:, 219) ! rate_const*N*OH + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 124)*sol(:ncol,:, 205) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 124)*sol(:ncol,:, 135) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 124)*sol(:ncol,:, 134) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 218)*sol(:ncol,:, 113) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 218)*sol(:ncol,:, 113) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 125)*sol(:ncol,:, 205) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 125)*sol(:ncol,:, 126) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 125)*sol(:ncol,:, 219) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 89)*sol(:ncol,:, 219) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 90) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 114) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 56)*sol(:ncol,:, 42) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 56)*sol(:ncol,:, 54) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 56)*sol(:ncol,:, 77) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 56)*sol(:ncol,:, 79) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 56)*sol(:ncol,:, 205) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 56)*sol(:ncol,:, 205) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 56)*sol(:ncol,:, 135) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 59)*sol(:ncol,:, 200) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 59)*sol(:ncol,:, 205) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 59)*sol(:ncol,:, 124) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 60)*sol(:ncol,:, 56) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 59)*sol(:ncol,:, 125) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 60)*sol(:ncol,:, 134) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 60)*sol(:ncol,:, 219) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 59)*sol(:ncol,:, 134) ! rate_const*CLO*O + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 59)*sol(:ncol,:, 219) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 59)*sol(:ncol,:, 219) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 85)*sol(:ncol,:, 134) ! rate_const*HCL*O + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 85)*sol(:ncol,:, 219) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 92)*sol(:ncol,:, 56) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 92)*sol(:ncol,:, 134) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 92)*sol(:ncol,:, 219) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 218)*sol(:ncol,:, 33) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 218)*sol(:ncol,:, 34) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 218)*sol(:ncol,:, 36) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 218)*sol(:ncol,:, 37) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 218)*sol(:ncol,:, 38) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 218)*sol(:ncol,:, 39) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 218)*sol(:ncol,:, 40) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 218)*sol(:ncol,:, 85) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 218)*sol(:ncol,:, 85) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 58) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 17)*sol(:ncol,:, 42) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 17)*sol(:ncol,:, 205) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 17)*sol(:ncol,:, 135) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 19)*sol(:ncol,:, 19) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 19)*sol(:ncol,:, 205) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 19)*sol(:ncol,:, 124) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 19)*sol(:ncol,:, 125) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 20)*sol(:ncol,:, 134) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 19)*sol(:ncol,:, 134) ! rate_const*BRO*O + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 19)*sol(:ncol,:, 219) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 81)*sol(:ncol,:, 134) ! rate_const*HBR*O + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 81)*sol(:ncol,:, 219) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 91)*sol(:ncol,:, 134) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 218)*sol(:ncol,:, 35) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 218)*sol(:ncol,:, 55) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 218)*sol(:ncol,:, 78) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 218)*sol(:ncol,:, 81) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 218)*sol(:ncol,:, 81) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 73)*sol(:ncol,:, 54) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 73)*sol(:ncol,:, 77) ! rate_const*F*H2 + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 73)*sol(:ncol,:, 231) ! rate_const*F*H2O + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 73)*sol(:ncol,:, 89) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 218)*sol(:ncol,:, 64) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 218)*sol(:ncol,:, 65) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 41)*sol(:ncol,:, 56) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 41)*sol(:ncol,:, 219) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 43)*sol(:ncol,:, 56) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 43)*sol(:ncol,:, 219) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 44)*sol(:ncol,:, 219) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 46)*sol(:ncol,:, 56) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 46)*sol(:ncol,:, 219) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 55)*sol(:ncol,:, 56) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 55)*sol(:ncol,:, 219) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 82)*sol(:ncol,:, 219) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 83)*sol(:ncol,:, 219) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 84)*sol(:ncol,:, 219) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 218)*sol(:ncol,:, 41) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 218)*sol(:ncol,:, 43) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 218)*sol(:ncol,:, 82) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 218)*sol(:ncol,:, 83) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 218)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 42)*sol(:ncol,:, 205) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 42)*sol(:ncol,:, 126) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 42)*sol(:ncol,:, 134) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 42)*sol(:ncol,:, 219) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 200)*sol(:ncol,:, 200) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 200)*sol(:ncol,:, 200) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 200)*sol(:ncol,:, 205) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 200)*sol(:ncol,:, 124) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 52)*sol(:ncol,:, 219) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 53)*sol(:ncol,:, 219) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 54)*sol(:ncol,:, 219) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 86)*sol(:ncol,:, 219) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 87)*sol(:ncol,:, 219) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 206)*sol(:ncol,:, 205) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 206) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 206)*sol(:ncol,:, 124) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 218)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 218)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 218)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 218)*sol(:ncol,:, 86) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 62)*sol(:ncol,:, 219) ! rate_const*CO*OH + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 24)*sol(:ncol,:, 56) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 24)*sol(:ncol,:, 219) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 25)*sol(:ncol,:, 56) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 25)*sol(:ncol,:, 135) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 196)*sol(:ncol,:, 196) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 196)*sol(:ncol,:, 200) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 196)*sol(:ncol,:, 205) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 196)*sol(:ncol,:, 124) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 26)*sol(:ncol,:, 219) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 27)*sol(:ncol,:, 219) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 28)*sol(:ncol,:, 56) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 28)*sol(:ncol,:, 219) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 45)*sol(:ncol,:, 126) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 45)*sol(:ncol,:, 219) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 47)*sol(:ncol,:, 219) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 199)*sol(:ncol,:, 199) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 199)*sol(:ncol,:, 200) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 199)*sol(:ncol,:, 205) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 199)*sol(:ncol,:, 124) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 50)*sol(:ncol,:, 219) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 51)*sol(:ncol,:, 219) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 204)*sol(:ncol,:, 205) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 204)*sol(:ncol,:, 124) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 203) ! rate_const*EO + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 203) ! rate_const*O2*EO + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 74)*sol(:ncol,:, 219) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 75)*sol(:ncol,:, 219) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 140)*sol(:ncol,:, 219) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 25)*sol(:ncol,:, 219) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 199)*sol(:ncol,:, 125) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 140) ! rate_const*M*PAN + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 29)*sol(:ncol,:, 126) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 29)*sol(:ncol,:, 135) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 197)*sol(:ncol,:, 200) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 197)*sol(:ncol,:, 205) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 197)*sol(:ncol,:, 124) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 30)*sol(:ncol,:, 219) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 31)*sol(:ncol,:, 219) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 49)*sol(:ncol,:, 126) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 49)*sol(:ncol,:, 219) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 95)*sol(:ncol,:, 219) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 127)*sol(:ncol,:, 219) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 221)*sol(:ncol,:, 205) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 221)*sol(:ncol,:, 124) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 147)*sol(:ncol,:, 219) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 222)*sol(:ncol,:, 200) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 222)*sol(:ncol,:, 205) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 222)*sol(:ncol,:, 124) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 148)*sol(:ncol,:, 219) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 29)*sol(:ncol,:, 219) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 48)*sol(:ncol,:, 219) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 16)*sol(:ncol,:, 126) ! rate_const*BIGENE*NO3 + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 16)*sol(:ncol,:, 219) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 202)*sol(:ncol,:, 124) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 202)*sol(:ncol,:, 124) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 93)*sol(:ncol,:, 219) ! rate_const*HONITR*OH + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 211)*sol(:ncol,:, 199) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 211)*sol(:ncol,:, 200) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 211)*sol(:ncol,:, 205) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 211)*sol(:ncol,:, 126) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 211)*sol(:ncol,:, 124) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 211)*sol(:ncol,:, 124) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 105)*sol(:ncol,:, 135) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 105)*sol(:ncol,:, 219) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 106)*sol(:ncol,:, 219) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 213)*sol(:ncol,:, 199) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 213)*sol(:ncol,:, 200) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 213)*sol(:ncol,:, 205) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 213)*sol(:ncol,:, 213) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 213)*sol(:ncol,:, 124) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 213)*sol(:ncol,:, 126) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 215)*sol(:ncol,:, 205) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 215)*sol(:ncol,:, 124) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 107)*sol(:ncol,:, 219) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 108)*sol(:ncol,:, 219) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 109)*sol(:ncol,:, 219) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 111)*sol(:ncol,:, 135) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 111)*sol(:ncol,:, 219) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 213)*sol(:ncol,:, 125) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 109) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 1)*sol(:ncol,:, 219) ! rate_const*ALKNIT*OH + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 191)*sol(:ncol,:, 205) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 191)*sol(:ncol,:, 124) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 191)*sol(:ncol,:, 124) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 2)*sol(:ncol,:, 219) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 15)*sol(:ncol,:, 219) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 94)*sol(:ncol,:, 219) ! rate_const*HPALD*OH + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 96)*sol(:ncol,:, 219) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 97)*sol(:ncol,:, 219) ! rate_const*IEPOX*OH + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 207)*sol(:ncol,:, 199) ! rate_const*ISOPAO2*CH3CO3 + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 207)*sol(:ncol,:, 200) ! rate_const*ISOPAO2*CH3O2 + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 207)*sol(:ncol,:, 205) ! rate_const*ISOPAO2*HO2 + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 207)*sol(:ncol,:, 124) ! rate_const*ISOPAO2*NO + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 207)*sol(:ncol,:, 126) ! rate_const*ISOPAO2*NO3 + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 208)*sol(:ncol,:, 199) ! rate_const*ISOPBO2*CH3CO3 + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 208)*sol(:ncol,:, 200) ! rate_const*ISOPBO2*CH3O2 + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 208)*sol(:ncol,:, 205) ! rate_const*ISOPBO2*HO2 + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 208) ! rate_const*ISOPBO2 + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 208)*sol(:ncol,:, 124) ! rate_const*ISOPBO2*NO + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 208)*sol(:ncol,:, 126) ! rate_const*ISOPBO2*NO3 + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 99)*sol(:ncol,:, 219) ! rate_const*ISOPNITA*OH + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 100)*sol(:ncol,:, 219) ! rate_const*ISOPNITB*OH + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 98)*sol(:ncol,:, 126) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 101)*sol(:ncol,:, 199) ! rate_const*ISOPNO3*CH3CO3 + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 101)*sol(:ncol,:, 200) ! rate_const*ISOPNO3*CH3O2 + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 101)*sol(:ncol,:, 205) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 101)*sol(:ncol,:, 124) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 101)*sol(:ncol,:, 126) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 102)*sol(:ncol,:, 219) ! rate_const*ISOPNOOH*OH + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 98)*sol(:ncol,:, 135) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 98)*sol(:ncol,:, 219) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 103)*sol(:ncol,:, 219) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 115)*sol(:ncol,:, 219) ! rate_const*NC4CH2OH*OH + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 116)*sol(:ncol,:, 219) ! rate_const*NC4CHO*OH + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 227)*sol(:ncol,:, 199) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 227)*sol(:ncol,:, 200) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 227)*sol(:ncol,:, 205) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 227)*sol(:ncol,:, 124) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 227)*sol(:ncol,:, 126) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 183)*sol(:ncol,:, 219) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 190)*sol(:ncol,:, 205) ! rate_const*ACBZO2*HO2 + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 190)*sol(:ncol,:, 124) ! rate_const*ACBZO2*NO + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 7)*sol(:ncol,:, 219) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 193)*sol(:ncol,:, 205) ! rate_const*BENZO2*HO2 + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 193)*sol(:ncol,:, 124) ! rate_const*BENZO2*NO + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 8)*sol(:ncol,:, 219) ! rate_const*BENZOOH*OH + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 22)*sol(:ncol,:, 219) ! rate_const*BZALD*OH + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 195)*sol(:ncol,:, 205) ! rate_const*BZOO*HO2 + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 23)*sol(:ncol,:, 219) ! rate_const*BZOOH*OH + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 195)*sol(:ncol,:, 124) ! rate_const*BZOO*NO + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 198)*sol(:ncol,:, 205) ! rate_const*C6H5O2*HO2 + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 198)*sol(:ncol,:, 124) ! rate_const*C6H5O2*NO + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 32)*sol(:ncol,:, 219) ! rate_const*C6H5OOH*OH + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 66)*sol(:ncol,:, 219) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 201)*sol(:ncol,:, 205) ! rate_const*DICARBO2*HO2 + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 201)*sol(:ncol,:, 124) ! rate_const*DICARBO2*NO + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 201)*sol(:ncol,:, 125) ! rate_const*M*DICARBO2*NO2 + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 212)*sol(:ncol,:, 205) ! rate_const*MALO2*HO2 + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 212)*sol(:ncol,:, 124) ! rate_const*MALO2*NO + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 212)*sol(:ncol,:, 125) ! rate_const*M*MALO2*NO2 + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 214)*sol(:ncol,:, 205) ! rate_const*MDIALO2*HO2 + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 214)*sol(:ncol,:, 124) ! rate_const*MDIALO2*NO + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 214)*sol(:ncol,:, 125) ! rate_const*M*MDIALO2*NO2 + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 220)*sol(:ncol,:, 205) ! rate_const*PHENO2*HO2 + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 220)*sol(:ncol,:, 124) ! rate_const*PHENO2*NO + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 143)*sol(:ncol,:, 219) ! rate_const*PHENOL*OH + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 142)*sol(:ncol,:, 125) ! rate_const*PHENO*NO2 + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 142)*sol(:ncol,:, 135) ! rate_const*PHENO*O3 + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 144)*sol(:ncol,:, 219) ! rate_const*PHENOOH*OH + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 190)*sol(:ncol,:, 125) ! rate_const*M*ACBZO2*NO2 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 225)*sol(:ncol,:, 205) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 225)*sol(:ncol,:, 124) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 181)*sol(:ncol,:, 219) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 182)*sol(:ncol,:, 219) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 141) ! rate_const*M*PBZNIT + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 184)*sol(:ncol,:, 219) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 228)*sol(:ncol,:, 205) ! rate_const*XYLENO2*HO2 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 228)*sol(:ncol,:, 124) ! rate_const*XYLENO2*NO + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 185)*sol(:ncol,:, 219) ! rate_const*XYLENOOH*OH + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 230)*sol(:ncol,:, 205) ! rate_const*XYLOLO2*HO2 + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 230)*sol(:ncol,:, 124) ! rate_const*XYLOLO2*NO + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 186)*sol(:ncol,:, 219) ! rate_const*XYLOL*OH + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 187)*sol(:ncol,:, 219) ! rate_const*XYLOLOOH*OH + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 6)*sol(:ncol,:, 126) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 6)*sol(:ncol,:, 135) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 6)*sol(:ncol,:, 219) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 110)*sol(:ncol,:, 126) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 110)*sol(:ncol,:, 135) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 110)*sol(:ncol,:, 219) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 217)*sol(:ncol,:, 200) ! rate_const*NTERPO2*CH3O2 + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 217)*sol(:ncol,:, 205) ! rate_const*NTERPO2*HO2 + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 217)*sol(:ncol,:, 124) ! rate_const*NTERPO2*NO + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 217)*sol(:ncol,:, 126) ! rate_const*NTERPO2*NO3 + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 128)*sol(:ncol,:, 219) ! rate_const*NTERPOOH*OH + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 223)*sol(:ncol,:, 200) ! rate_const*TERP2O2*CH3O2 + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 223)*sol(:ncol,:, 205) ! rate_const*TERP2O2*HO2 + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 223)*sol(:ncol,:, 124) ! rate_const*TERP2O2*NO + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 176)*sol(:ncol,:, 219) ! rate_const*TERP2OOH*OH + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 177)*sol(:ncol,:, 219) ! rate_const*TERPNIT*OH + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 224)*sol(:ncol,:, 200) ! rate_const*TERPO2*CH3O2 + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 224)*sol(:ncol,:, 205) ! rate_const*TERPO2*HO2 + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 224)*sol(:ncol,:, 124) ! rate_const*TERPO2*NO + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 178)*sol(:ncol,:, 219) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 179)*sol(:ncol,:, 126) ! rate_const*TERPROD1*NO3 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 179)*sol(:ncol,:, 219) ! rate_const*TERPROD1*OH + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 180)*sol(:ncol,:, 219) ! rate_const*TERPROD2*OH + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 67)*sol(:ncol,:, 126) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 67)*sol(:ncol,:, 219) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 138)*sol(:ncol,:, 134) ! rate_const*OCS*O + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 138)*sol(:ncol,:, 219) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 149) ! rate_const*O2*S + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 152)*sol(:ncol,:, 219) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 149)*sol(:ncol,:, 135) ! rate_const*S*O3 + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 151)*sol(:ncol,:, 19) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 151)*sol(:ncol,:, 59) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 149)*sol(:ncol,:, 219) ! rate_const*S*OH + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 151)*sol(:ncol,:, 125) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 151) ! rate_const*O2*SO + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 151)*sol(:ncol,:, 135) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 151)*sol(:ncol,:, 137) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 151)*sol(:ncol,:, 219) ! rate_const*SO*OH + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 67)*sol(:ncol,:, 219) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 153)*sol(:ncol,:, 231) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 120)*sol(:ncol,:, 219) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 75) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 205) ! rate_const*HO2 + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 93) ! rate_const*HONITR + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 99) ! rate_const*ISOPNITA + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 100) ! rate_const*ISOPNITB + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 115) ! rate_const*NC4CH2OH + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 116) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 121) ! rate_const*NH4 + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 125) ! rate_const*NO2 + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 126) ! rate_const*NO3 + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 128) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 139) ! rate_const*ONITR + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 177) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 6)*sol(:ncol,:, 126) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 192)*sol(:ncol,:, 205) ! rate_const*BCARYO2VBS*HO2 + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 192)*sol(:ncol,:, 124) ! rate_const*BCARYO2VBS*NO + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 6)*sol(:ncol,:, 135) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 6)*sol(:ncol,:, 219) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 7)*sol(:ncol,:, 219) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 194)*sol(:ncol,:, 205) ! rate_const*BENZO2VBS*HO2 + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 194)*sol(:ncol,:, 124) ! rate_const*BENZO2VBS*NO + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 98)*sol(:ncol,:, 126) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 209)*sol(:ncol,:, 205) ! rate_const*ISOPO2VBS*HO2 + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 209)*sol(:ncol,:, 124) ! rate_const*ISOPO2VBS*NO + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 98)*sol(:ncol,:, 135) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 98)*sol(:ncol,:, 219) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 210)*sol(:ncol,:, 205) ! rate_const*IVOCO2VBS*HO2 + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 210)*sol(:ncol,:, 124) ! rate_const*IVOCO2VBS*NO + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 104)*sol(:ncol,:, 219) ! rate_const*IVOC*OH + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 110)*sol(:ncol,:, 126) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 216)*sol(:ncol,:, 205) ! rate_const*MTERPO2VBS*HO2 + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 216)*sol(:ncol,:, 124) ! rate_const*MTERPO2VBS*NO + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 110)*sol(:ncol,:, 135) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 110)*sol(:ncol,:, 219) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 174)*sol(:ncol,:, 219) ! rate_const*SVOC*OH + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 182)*sol(:ncol,:, 219) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 226)*sol(:ncol,:, 205) ! rate_const*TOLUO2VBS*HO2 + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 226)*sol(:ncol,:, 124) ! rate_const*TOLUO2VBS*NO + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 184)*sol(:ncol,:, 219) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 229)*sol(:ncol,:, 205) ! rate_const*XYLEO2VBS*HO2 + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 229)*sol(:ncol,:, 124) ! rate_const*XYLEO2VBS*NO + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 91)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 91)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 123) ! rate_const*NH_50 + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 122) ! rate_const*NH_5 + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 173) ! rate_const*ST80_25 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_strat_mam5_vbs/mo_setrxt.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/mo_setrxt.F90 new file mode 100644 index 0000000000..959d5cb5d3 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/mo_setrxt.F90 @@ -0,0 +1,700 @@ + + 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(:,124) = 1.29e-07_r8 + rate(:,125) = 1.2e-10_r8 + rate(:,129) = 1.2e-10_r8 + rate(:,135) = 6.9e-12_r8 + rate(:,136) = 7.2e-11_r8 + rate(:,137) = 1.6e-12_r8 + rate(:,143) = 1.8e-12_r8 + rate(:,147) = 1.8e-12_r8 + rate(:,159) = 3.5e-12_r8 + rate(:,161) = 1.3e-11_r8 + rate(:,162) = 2.2e-11_r8 + rate(:,163) = 5e-11_r8 + rate(:,198) = 1.7e-13_r8 + rate(:,200) = 2.607e-10_r8 + rate(:,201) = 9.75e-11_r8 + rate(:,202) = 2.07e-10_r8 + rate(:,203) = 2.088e-10_r8 + rate(:,204) = 1.17e-10_r8 + rate(:,205) = 4.644e-11_r8 + rate(:,206) = 1.204e-10_r8 + rate(:,207) = 9.9e-11_r8 + rate(:,208) = 3.3e-12_r8 + rate(:,227) = 4.5e-11_r8 + rate(:,228) = 4.62e-10_r8 + rate(:,229) = 1.2e-10_r8 + rate(:,230) = 9e-11_r8 + rate(:,231) = 3e-11_r8 + rate(:,236) = 2.14e-11_r8 + rate(:,237) = 1.9e-10_r8 + rate(:,250) = 2.57e-10_r8 + rate(:,251) = 1.8e-10_r8 + rate(:,252) = 1.794e-10_r8 + rate(:,253) = 1.3e-10_r8 + rate(:,254) = 7.65e-11_r8 + rate(:,267) = 4e-13_r8 + rate(:,271) = 1.31e-10_r8 + rate(:,272) = 3.5e-11_r8 + rate(:,273) = 9e-12_r8 + rate(:,280) = 6.8e-14_r8 + rate(:,281) = 2e-13_r8 + rate(:,296) = 1e-12_r8 + rate(:,300) = 1e-14_r8 + rate(:,301) = 1e-11_r8 + rate(:,302) = 1.15e-11_r8 + rate(:,303) = 4e-14_r8 + rate(:,316) = 3e-12_r8 + rate(:,317) = 6.7e-13_r8 + rate(:,327) = 3.5e-13_r8 + rate(:,328) = 5.4e-11_r8 + rate(:,331) = 2e-12_r8 + rate(:,332) = 1.4e-11_r8 + rate(:,335) = 2.4e-12_r8 + rate(:,346) = 5e-12_r8 + rate(:,356) = 1.6e-12_r8 + rate(:,358) = 6.7e-12_r8 + rate(:,361) = 3.5e-12_r8 + rate(:,364) = 1.3e-11_r8 + rate(:,365) = 1.4e-11_r8 + rate(:,369) = 2.4e-12_r8 + rate(:,370) = 1.4e-11_r8 + rate(:,375) = 2.4e-12_r8 + rate(:,376) = 4e-11_r8 + rate(:,377) = 4e-11_r8 + rate(:,379) = 1.4e-11_r8 + rate(:,383) = 2.4e-12_r8 + rate(:,384) = 4e-11_r8 + rate(:,388) = 7e-11_r8 + rate(:,389) = 1e-10_r8 + rate(:,394) = 2.4e-12_r8 + rate(:,409) = 4.7e-11_r8 + rate(:,422) = 2.1e-12_r8 + rate(:,423) = 2.8e-13_r8 + rate(:,431) = 1.7e-11_r8 + rate(:,437) = 8.4e-11_r8 + rate(:,439) = 1.9e-11_r8 + rate(:,440) = 1.2e-14_r8 + rate(:,441) = 2e-10_r8 + rate(:,448) = 2.4e-12_r8 + rate(:,449) = 2e-11_r8 + rate(:,453) = 2.3e-11_r8 + rate(:,454) = 2e-11_r8 + rate(:,458) = 3.3e-11_r8 + rate(:,459) = 1e-12_r8 + rate(:,460) = 5.7e-11_r8 + rate(:,461) = 3.4e-11_r8 + rate(:,466) = 2.3e-12_r8 + rate(:,468) = 1.2e-11_r8 + rate(:,469) = 5.7e-11_r8 + rate(:,470) = 2.8e-11_r8 + rate(:,471) = 6.6e-11_r8 + rate(:,472) = 1.4e-11_r8 + rate(:,475) = 1.9e-12_r8 + rate(:,488) = 6.34e-08_r8 + rate(:,494) = 1.9e-11_r8 + rate(:,497) = 1.2e-14_r8 + rate(:,498) = 2e-10_r8 + rate(:,509) = 1.34e-11_r8 + rate(:,515) = 1.34e-11_r8 + rate(:,519) = 1.7e-11_r8 + rate(:,539) = 2.31e-07_r8 + rate(:,540) = 2.31e-06_r8 + rate(:,541) = 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(:,126) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,127) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:,128) = 3.3e-11_r8 * exp( 55._r8 * itemp(:) ) + rate(:,130) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,133) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + exp_fac(:) = exp( -2000._r8 * itemp(:) ) + rate(:,134) = 1.4e-12_r8 * exp_fac(:) + rate(:,385) = 1.05e-14_r8 * exp_fac(:) + rate(:,505) = 1.05e-14_r8 * exp_fac(:) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,139) = 3e-11_r8 * exp_fac(:) + rate(:,225) = 5.5e-12_r8 * exp_fac(:) + rate(:,264) = 3.8e-12_r8 * exp_fac(:) + rate(:,285) = 3.8e-12_r8 * exp_fac(:) + rate(:,312) = 3.8e-12_r8 * exp_fac(:) + rate(:,320) = 3.8e-12_r8 * exp_fac(:) + rate(:,324) = 3.8e-12_r8 * exp_fac(:) + rate(:,340) = 2.3e-11_r8 * exp_fac(:) + rate(:,350) = 3.8e-12_r8 * exp_fac(:) + rate(:,360) = 3.8e-12_r8 * exp_fac(:) + rate(:,387) = 1.52e-11_r8 * exp_fac(:) + rate(:,395) = 1.52e-12_r8 * exp_fac(:) + rate(:,401) = 3.8e-12_r8 * exp_fac(:) + rate(:,404) = 3.8e-12_r8 * exp_fac(:) + rate(:,408) = 3.8e-12_r8 * exp_fac(:) + rate(:,424) = 3.8e-12_r8 * exp_fac(:) + rate(:,428) = 3.8e-12_r8 * exp_fac(:) + rate(:,434) = 3.8e-12_r8 * exp_fac(:) + rate(:,438) = 3.8e-12_r8 * exp_fac(:) + rate(:,140) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,141) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,142) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,144) = 4.8e-11_r8 * exp_fac(:) + rate(:,223) = 1.7e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 180._r8 * itemp(:) ) + rate(:,145) = 1.8e-11_r8 * exp_fac(:) + rate(:,298) = 4.2e-12_r8 * exp_fac(:) + rate(:,311) = 4.2e-12_r8 * exp_fac(:) + rate(:,319) = 4.2e-12_r8 * exp_fac(:) + rate(:,348) = 4.2e-12_r8 * exp_fac(:) + rate(:,368) = 4.4e-12_r8 * exp_fac(:) + rate(:,374) = 4.4e-12_r8 * exp_fac(:) + rate(:,447) = 4.2e-12_r8 * exp_fac(:) + rate(:,452) = 4.2e-12_r8 * exp_fac(:) + rate(:,457) = 4.2e-12_r8 * exp_fac(:) + rate(:,146) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,150) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) + rate(:,151) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,152) = 2.9e-12_r8 * exp_fac(:) + rate(:,153) = 1.45e-12_r8 * exp_fac(:) + rate(:,154) = 1.45e-12_r8 * exp_fac(:) + rate(:,155) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:,156) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,157) = 1.2e-13_r8 * exp_fac(:) + rate(:,183) = 3e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,160) = 1.7e-11_r8 * exp_fac(:) + rate(:,258) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,164) = 3.44e-12_r8 * exp_fac(:) + rate(:,216) = 2.3e-12_r8 * exp_fac(:) + rate(:,219) = 8.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,165) = 3e-12_r8 * exp_fac(:) + rate(:,224) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,167) = 7.26e-11_r8 * exp_fac(:) + rate(:,168) = 4.64e-11_r8 * exp_fac(:) + rate(:,175) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,176) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,177) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,178) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,179) = 1.4e-11_r8 * exp_fac(:) + rate(:,193) = 7.4e-12_r8 * exp_fac(:) + rate(:,294) = 8.1e-12_r8 * exp_fac(:) + rate(:,180) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,181) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,182) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,184) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,185) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,186) = 2.6e-12_r8 * exp_fac(:) + rate(:,187) = 6.4e-12_r8 * exp_fac(:) + rate(:,217) = 4.1e-13_r8 * exp_fac(:) + rate(:,397) = 7.5e-12_r8 * exp_fac(:) + rate(:,411) = 7.5e-12_r8 * exp_fac(:) + rate(:,414) = 7.5e-12_r8 * exp_fac(:) + rate(:,417) = 7.5e-12_r8 * exp_fac(:) + rate(:,188) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,190) = 3.6e-12_r8 * exp_fac(:) + rate(:,239) = 2e-12_r8 * exp_fac(:) + rate(:,191) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,192) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,194) = 6e-13_r8 * exp_fac(:) + rate(:,214) = 1.5e-12_r8 * exp_fac(:) + rate(:,222) = 1.9e-11_r8 * exp_fac(:) + rate(:,195) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,196) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,197) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + exp_fac(:) = exp( -500._r8 * itemp(:) ) + rate(:,199) = 3e-12_r8 * exp_fac(:) + rate(:,233) = 1.4e-10_r8 * exp_fac(:) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,211) = 1.7e-11_r8 * exp_fac(:) + rate(:,238) = 6.3e-12_r8 * exp_fac(:) + rate(:,212) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,213) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,215) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + rate(:,218) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,221) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,226) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,232) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) + exp_fac(:) = exp( 0._r8 * itemp(:) ) + rate(:,234) = 1.4e-11_r8 * exp_fac(:) + rate(:,236) = 2.14e-11_r8 * exp_fac(:) + rate(:,237) = 1.9e-10_r8 * exp_fac(:) + rate(:,250) = 2.57e-10_r8 * exp_fac(:) + rate(:,251) = 1.8e-10_r8 * exp_fac(:) + rate(:,252) = 1.794e-10_r8 * exp_fac(:) + rate(:,253) = 1.3e-10_r8 * exp_fac(:) + rate(:,254) = 7.65e-11_r8 * exp_fac(:) + rate(:,267) = 4e-13_r8 * exp_fac(:) + rate(:,271) = 1.31e-10_r8 * exp_fac(:) + rate(:,272) = 3.5e-11_r8 * exp_fac(:) + rate(:,273) = 9e-12_r8 * exp_fac(:) + rate(:,280) = 6.8e-14_r8 * exp_fac(:) + rate(:,281) = 2e-13_r8 * exp_fac(:) + rate(:,296) = 1e-12_r8 * exp_fac(:) + rate(:,300) = 1e-14_r8 * exp_fac(:) + rate(:,301) = 1e-11_r8 * exp_fac(:) + rate(:,302) = 1.15e-11_r8 * exp_fac(:) + rate(:,303) = 4e-14_r8 * exp_fac(:) + rate(:,316) = 3e-12_r8 * exp_fac(:) + rate(:,317) = 6.7e-13_r8 * exp_fac(:) + rate(:,327) = 3.5e-13_r8 * exp_fac(:) + rate(:,328) = 5.4e-11_r8 * exp_fac(:) + rate(:,331) = 2e-12_r8 * exp_fac(:) + rate(:,332) = 1.4e-11_r8 * exp_fac(:) + rate(:,335) = 2.4e-12_r8 * exp_fac(:) + rate(:,346) = 5e-12_r8 * exp_fac(:) + rate(:,356) = 1.6e-12_r8 * exp_fac(:) + rate(:,358) = 6.7e-12_r8 * exp_fac(:) + rate(:,361) = 3.5e-12_r8 * exp_fac(:) + rate(:,364) = 1.3e-11_r8 * exp_fac(:) + rate(:,365) = 1.4e-11_r8 * exp_fac(:) + rate(:,369) = 2.4e-12_r8 * exp_fac(:) + rate(:,370) = 1.4e-11_r8 * exp_fac(:) + rate(:,375) = 2.4e-12_r8 * exp_fac(:) + rate(:,376) = 4e-11_r8 * exp_fac(:) + rate(:,377) = 4e-11_r8 * exp_fac(:) + rate(:,379) = 1.4e-11_r8 * exp_fac(:) + rate(:,383) = 2.4e-12_r8 * exp_fac(:) + rate(:,384) = 4e-11_r8 * exp_fac(:) + rate(:,388) = 7e-11_r8 * exp_fac(:) + rate(:,389) = 1e-10_r8 * exp_fac(:) + rate(:,394) = 2.4e-12_r8 * exp_fac(:) + rate(:,409) = 4.7e-11_r8 * exp_fac(:) + rate(:,422) = 2.1e-12_r8 * exp_fac(:) + rate(:,423) = 2.8e-13_r8 * exp_fac(:) + rate(:,431) = 1.7e-11_r8 * exp_fac(:) + rate(:,437) = 8.4e-11_r8 * exp_fac(:) + rate(:,439) = 1.9e-11_r8 * exp_fac(:) + rate(:,440) = 1.2e-14_r8 * exp_fac(:) + rate(:,441) = 2e-10_r8 * exp_fac(:) + rate(:,448) = 2.4e-12_r8 * exp_fac(:) + rate(:,449) = 2e-11_r8 * exp_fac(:) + rate(:,453) = 2.3e-11_r8 * exp_fac(:) + rate(:,454) = 2e-11_r8 * exp_fac(:) + rate(:,458) = 3.3e-11_r8 * exp_fac(:) + rate(:,459) = 1e-12_r8 * exp_fac(:) + rate(:,460) = 5.7e-11_r8 * exp_fac(:) + rate(:,461) = 3.4e-11_r8 * exp_fac(:) + rate(:,466) = 2.3e-12_r8 * exp_fac(:) + rate(:,468) = 1.2e-11_r8 * exp_fac(:) + rate(:,469) = 5.7e-11_r8 * exp_fac(:) + rate(:,470) = 2.8e-11_r8 * exp_fac(:) + rate(:,471) = 6.6e-11_r8 * exp_fac(:) + rate(:,472) = 1.4e-11_r8 * exp_fac(:) + rate(:,475) = 1.9e-12_r8 * exp_fac(:) + rate(:,488) = 6.34e-08_r8 * exp_fac(:) + rate(:,494) = 1.9e-11_r8 * exp_fac(:) + rate(:,497) = 1.2e-14_r8 * exp_fac(:) + rate(:,498) = 2e-10_r8 * exp_fac(:) + rate(:,509) = 1.34e-11_r8 * exp_fac(:) + rate(:,515) = 1.34e-11_r8 * exp_fac(:) + rate(:,519) = 1.7e-11_r8 * exp_fac(:) + rate(:,539) = 2.31e-07_r8 * exp_fac(:) + rate(:,540) = 2.31e-06_r8 * exp_fac(:) + rate(:,541) = 4.63e-07_r8 * exp_fac(:) + exp_fac(:) = exp( 400._r8 * itemp(:) ) + rate(:,235) = 6e-12_r8 * exp_fac(:) + rate(:,333) = 5e-13_r8 * exp_fac(:) + rate(:,366) = 5e-13_r8 * exp_fac(:) + rate(:,371) = 5e-13_r8 * exp_fac(:) + rate(:,380) = 5e-13_r8 * exp_fac(:) + rate(:,391) = 5e-13_r8 * exp_fac(:) + rate(:,240) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,241) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + exp_fac(:) = exp( -1520._r8 * itemp(:) ) + rate(:,242) = 1.64e-12_r8 * exp_fac(:) + rate(:,352) = 8.5e-16_r8 * exp_fac(:) + exp_fac(:) = exp( -1100._r8 * itemp(:) ) + rate(:,243) = 2.03e-11_r8 * exp_fac(:) + rate(:,474) = 3.4e-12_r8 * exp_fac(:) + rate(:,244) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,245) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,246) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,247) = 1.25e-12_r8 * exp_fac(:) + rate(:,257) = 3.4e-11_r8 * exp_fac(:) + rate(:,248) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,249) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,255) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) + rate(:,256) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,259) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) + rate(:,260) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) + rate(:,261) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + exp_fac(:) = exp( 300._r8 * itemp(:) ) + rate(:,262) = 2.8e-12_r8 * exp_fac(:) + rate(:,323) = 2.9e-12_r8 * exp_fac(:) + rate(:,263) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) + rate(:,265) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + exp_fac(:) = exp( 700._r8 * itemp(:) ) + rate(:,268) = 7.5e-13_r8 * exp_fac(:) + rate(:,282) = 7.5e-13_r8 * exp_fac(:) + rate(:,297) = 7.5e-13_r8 * exp_fac(:) + rate(:,310) = 7.5e-13_r8 * exp_fac(:) + rate(:,318) = 7.5e-13_r8 * exp_fac(:) + rate(:,322) = 8.6e-13_r8 * exp_fac(:) + rate(:,334) = 8e-13_r8 * exp_fac(:) + rate(:,347) = 7.5e-13_r8 * exp_fac(:) + rate(:,357) = 7.5e-13_r8 * exp_fac(:) + rate(:,367) = 8e-13_r8 * exp_fac(:) + rate(:,372) = 8e-13_r8 * exp_fac(:) + rate(:,381) = 8e-13_r8 * exp_fac(:) + rate(:,392) = 8e-13_r8 * exp_fac(:) + rate(:,399) = 7.5e-13_r8 * exp_fac(:) + rate(:,403) = 7.5e-13_r8 * exp_fac(:) + rate(:,406) = 7.5e-13_r8 * exp_fac(:) + rate(:,419) = 7.5e-13_r8 * exp_fac(:) + rate(:,426) = 7.5e-13_r8 * exp_fac(:) + rate(:,432) = 7.5e-13_r8 * exp_fac(:) + rate(:,435) = 7.5e-13_r8 * exp_fac(:) + rate(:,446) = 7.5e-13_r8 * exp_fac(:) + rate(:,451) = 7.5e-13_r8 * exp_fac(:) + rate(:,456) = 7.5e-13_r8 * exp_fac(:) + rate(:,500) = 7.5e-13_r8 * exp_fac(:) + rate(:,507) = 7.5e-13_r8 * exp_fac(:) + rate(:,517) = 7.5e-13_r8 * exp_fac(:) + rate(:,520) = 7.5e-13_r8 * exp_fac(:) + rate(:,269) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) + rate(:,270) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) + rate(:,274) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) + rate(:,279) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + exp_fac(:) = exp( 365._r8 * itemp(:) ) + rate(:,283) = 2.6e-12_r8 * exp_fac(:) + rate(:,400) = 2.6e-12_r8 * exp_fac(:) + rate(:,405) = 2.6e-12_r8 * exp_fac(:) + rate(:,407) = 2.6e-12_r8 * exp_fac(:) + rate(:,420) = 2.6e-12_r8 * exp_fac(:) + rate(:,427) = 2.6e-12_r8 * exp_fac(:) + rate(:,433) = 2.6e-12_r8 * exp_fac(:) + rate(:,436) = 2.6e-12_r8 * exp_fac(:) + rate(:,501) = 2.6e-12_r8 * exp_fac(:) + rate(:,508) = 2.6e-12_r8 * exp_fac(:) + rate(:,518) = 2.6e-12_r8 * exp_fac(:) + rate(:,521) = 2.6e-12_r8 * exp_fac(:) + rate(:,284) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,286) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,287) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + exp_fac(:) = exp( -1900._r8 * itemp(:) ) + rate(:,288) = 1.4e-12_r8 * exp_fac(:) + rate(:,308) = 6.5e-15_r8 * exp_fac(:) + exp_fac(:) = exp( 350._r8 * itemp(:) ) + rate(:,289) = 4.63e-12_r8 * exp_fac(:) + rate(:,504) = 2.7e-12_r8 * exp_fac(:) + rate(:,290) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) + exp_fac(:) = exp( 500._r8 * itemp(:) ) + rate(:,291) = 2.9e-12_r8 * exp_fac(:) + rate(:,292) = 2e-12_r8 * exp_fac(:) + rate(:,321) = 7.1e-13_r8 * exp_fac(:) + rate(:,342) = 2e-12_r8 * exp_fac(:) + rate(:,445) = 2e-12_r8 * exp_fac(:) + rate(:,450) = 2e-12_r8 * exp_fac(:) + rate(:,455) = 2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 1040._r8 * itemp(:) ) + rate(:,293) = 4.3e-13_r8 * exp_fac(:) + rate(:,343) = 4.3e-13_r8 * exp_fac(:) + rate(:,396) = 4.3e-13_r8 * exp_fac(:) + rate(:,410) = 4.3e-13_r8 * exp_fac(:) + rate(:,413) = 4.3e-13_r8 * exp_fac(:) + rate(:,416) = 4.3e-13_r8 * exp_fac(:) + rate(:,295) = 3.15e-14_r8 * exp( 920._r8 * itemp(:) ) + rate(:,299) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,307) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,309) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,313) = 9.19e-12_r8 * exp( -630._r8 * itemp(:) ) + rate(:,314) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) + rate(:,315) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + rate(:,329) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) + rate(:,330) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) + exp_fac(:) = exp( 360._r8 * itemp(:) ) + rate(:,336) = 2.7e-12_r8 * exp_fac(:) + rate(:,337) = 1.3e-13_r8 * exp_fac(:) + rate(:,339) = 9.6e-12_r8 * exp_fac(:) + rate(:,345) = 5.3e-12_r8 * exp_fac(:) + rate(:,382) = 2.7e-12_r8 * exp_fac(:) + rate(:,393) = 2.7e-12_r8 * exp_fac(:) + rate(:,496) = 2.7e-12_r8 * exp_fac(:) + rate(:,512) = 2.7e-12_r8 * exp_fac(:) + rate(:,338) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) + exp_fac(:) = exp( 530._r8 * itemp(:) ) + rate(:,341) = 4.6e-12_r8 * exp_fac(:) + rate(:,344) = 2.3e-12_r8 * exp_fac(:) + rate(:,349) = 2.3e-12_r8 * exp( -170._r8 * itemp(:) ) + rate(:,353) = 4.13e-12_r8 * exp( 452._r8 * itemp(:) ) + rate(:,359) = 5.4e-14_r8 * exp( 870._r8 * itemp(:) ) + exp_fac(:) = exp( 175._r8 * itemp(:) ) + rate(:,362) = 1.86e-11_r8 * exp_fac(:) + rate(:,363) = 1.86e-11_r8 * exp_fac(:) + rate(:,373) = 1.6e+09_r8 * exp( -8300._r8 * itemp(:) ) + exp_fac(:) = exp( -446._r8 * itemp(:) ) + rate(:,378) = 3.03e-12_r8 * exp_fac(:) + rate(:,502) = 3.03e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 410._r8 * itemp(:) ) + rate(:,386) = 2.54e-11_r8 * exp_fac(:) + rate(:,506) = 2.54e-11_r8 * exp_fac(:) + rate(:,390) = 1.3e-12_r8 * exp( 640._r8 * itemp(:) ) + exp_fac(:) = exp( -193._r8 * itemp(:) ) + rate(:,398) = 2.3e-12_r8 * exp_fac(:) + rate(:,499) = 2.3e-12_r8 * exp_fac(:) + rate(:,402) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) + rate(:,421) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) + exp_fac(:) = exp( 352._r8 * itemp(:) ) + rate(:,429) = 1.7e-12_r8 * exp_fac(:) + rate(:,516) = 1.7e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 490._r8 * itemp(:) ) + rate(:,442) = 1.2e-12_r8 * exp_fac(:) + rate(:,510) = 1.2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -580._r8 * itemp(:) ) + rate(:,443) = 6.3e-16_r8 * exp_fac(:) + rate(:,513) = 6.3e-16_r8 * exp_fac(:) + exp_fac(:) = exp( 440._r8 * itemp(:) ) + rate(:,444) = 1.2e-11_r8 * exp_fac(:) + rate(:,514) = 1.2e-11_r8 * exp_fac(:) + rate(:,462) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,463) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,464) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,465) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,473) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,476) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) + rate(:,479) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + exp_fac(:) = exp( 1300._r8 * itemp(:) ) + rate(:,495) = 2.75e-13_r8 * exp_fac(:) + rate(:,503) = 2.12e-13_r8 * exp_fac(:) + rate(:,511) = 2.6e-13_r8 * exp_fac(:) + + 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(:,138), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,148), 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(:,158), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,166), 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(:,169), 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(:,170), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,171), 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(:,189), 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(:,209), 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(:,220), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.1e-33_r8 * itemp(:)**1.5_r8 + kinf(:) = 9.8e-15_r8 * itemp(:)**(-4.6_r8) + call jpl( rate(:,266), m, 0.8_r8, ko, kinf, n ) + + ko(:) = 5.2e-30_r8 * itemp(:)**2.4_r8 + kinf(:) = 2.2e-10_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,276), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.5e-30_r8 + kinf(:) = 8.3e-13_r8 * itemp(:)**(-2._r8) + call jpl( rate(:,277), 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(:,278), 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(:,304), 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(:,305), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,325), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,351), 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(:,354), m, 0.6_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(:,412), m, 0.6_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(:,415), m, 0.6_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(:,418), m, 0.6_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(:,425), 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(:,467), 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,135) = 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,127) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:n,130) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,139) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,140) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,141) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,144) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,145) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,146) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,151) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,155) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:n,156) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,164) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) + rate(:n,165) = 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,138) = wrk(:) + + + + + + + + + + + + + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_trop_strat_mam5_vbs/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_mam5_vbs/mo_sim_dat.F90 new file mode 100644 index 0000000000..8def9fb8ae --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbs/mo_sim_dat.F90 @@ -0,0 +1,818 @@ + + 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, 229, 0 /) + + cls_rxt_cnt(:,1) = (/ 9, 0, 0, 2 /) + cls_rxt_cnt(:,4) = (/ 2, 165, 374, 229 /) + + solsym(:231) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','bc_a1 ','bc_a4 ', & + 'BCARY ','BENZENE ','BENZOOH ','BEPOMUC ','BIGALD ', & + 'BIGALD1 ','BIGALD2 ','BIGALD3 ','BIGALD4 ','BIGALK ', & + 'BIGENE ','BR ','BRCL ','BRO ','BRONO2 ', & + 'BRY ','BZALD ','BZOOH ','C2H2 ','C2H4 ', & + 'C2H5OH ','C2H5OOH ','C2H6 ','C3H6 ','C3H7OOH ', & + 'C3H8 ','C6H5OOH ','CCL4 ','CF2CLBR ','CF3BR ', & + 'CFC11 ','CFC113 ','CFC114 ','CFC115 ','CFC12 ', & + 'CH2BR2 ','CH2O ','CH3BR ','CH3CCL3 ','CH3CHO ', & + 'CH3CL ','CH3CN ','CH3COCH3 ','CH3COCHO ','CH3COOH ', & + 'CH3COOOH ','CH3OH ','CH3OOH ','CH4 ','CHBR3 ', & + 'CL ','CL2 ','CL2O2 ','CLO ','CLONO2 ', & + 'CLY ','CO ','CO2 ','COF2 ','COFCL ', & + 'CRESOL ','DMS ','dst_a1 ','dst_a2 ','dst_a3 ', & + 'E90 ','EOOH ','F ','GLYALD ','GLYOXAL ', & + 'H ','H2 ','H2402 ','H2O2 ','H2SO4 ', & + 'HBR ','HCFC141B ','HCFC142B ','HCFC22 ','HCL ', & + 'HCN ','HCOOH ','HF ','HNO3 ','HO2NO2 ', & + 'HOBR ','HOCL ','HONITR ','HPALD ','HYAC ', & + 'HYDRALD ','IEPOX ','ISOP ','ISOPNITA ','ISOPNITB ', & + 'ISOPNO3 ','ISOPNOOH ','ISOPOOH ','IVOC ','MACR ', & + 'MACROOH ','MEK ','MEKOOH ','MPAN ','MTERP ', & + 'MVK ','N ','N2O ','N2O5 ','NC4CH2OH ', & + 'NC4CHO ','ncl_a1 ','ncl_a2 ','ncl_a3 ','NH3 ', & + 'NH4 ','NH_5 ','NH_50 ','NO ','NO2 ', & + 'NO3 ','NOA ','NTERPOOH ','num_a1 ','num_a2 ', & + 'num_a3 ','num_a4 ','num_a5 ','O ','O3 ', & + 'O3S ','OCLO ','OCS ','ONITR ','PAN ', & + 'PBZNIT ','PHENO ','PHENOL ','PHENOOH ','pom_a1 ', & + 'pom_a4 ','POOH ','ROOH ','S ','SF6 ', & + 'SO ','SO2 ','SO3 ','so4_a1 ','so4_a2 ', & + 'so4_a3 ','so4_a5 ','soa1_a1 ','soa1_a2 ','soa2_a1 ', & + 'soa2_a2 ','soa3_a1 ','soa3_a2 ','soa4_a1 ','soa4_a2 ', & + 'soa5_a1 ','soa5_a2 ','SOAG0 ','SOAG1 ','SOAG2 ', & + 'SOAG3 ','SOAG4 ','ST80_25 ','SVOC ','TEPOMUC ', & + 'TERP2OOH ','TERPNIT ','TERPOOH ','TERPROD1 ','TERPROD2 ', & + 'TOLOOH ','TOLUENE ','XOOH ','XYLENES ','XYLENOOH ', & + 'XYLOL ','XYLOLOOH ','NHDEP ','NDEP ','ACBZO2 ', & + 'ALKO2 ','BCARYO2VBS ','BENZO2 ','BENZO2VBS ','BZOO ', & + 'C2H5O2 ','C3H7O2 ','C6H5O2 ','CH3CO3 ','CH3O2 ', & + 'DICARBO2 ','ENEO2 ','EO ','EO2 ','HO2 ', & + 'HOCH2OO ','ISOPAO2 ','ISOPBO2 ','ISOPO2VBS ','IVOCO2VBS ', & + 'MACRO2 ','MALO2 ','MCO3 ','MDIALO2 ','MEKO2 ', & + 'MTERPO2VBS ','NTERPO2 ','O1D ','OH ','PHENO2 ', & + 'PO2 ','RO2 ','TERP2O2 ','TERPO2 ','TOLO2 ', & + 'TOLUO2VBS ','XO2 ','XYLENO2 ','XYLEO2VBS ','XYLOLO2 ', & + 'H2O ' /) + + adv_mass(:231) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 12.011000_r8, 12.011000_r8, & + 204.342600_r8, 78.110400_r8, 160.122200_r8, 126.108600_r8, 98.098200_r8, & + 84.072400_r8, 98.098200_r8, 98.098200_r8, 112.124000_r8, 72.143800_r8, & + 56.103200_r8, 79.904000_r8, 115.356700_r8, 95.903400_r8, 141.908940_r8, & + 99.716850_r8, 106.120800_r8, 124.135000_r8, 26.036800_r8, 28.051600_r8, & + 46.065800_r8, 62.065200_r8, 30.066400_r8, 42.077400_r8, 76.091000_r8, & + 44.092200_r8, 110.109200_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, 41.050940_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, 66.007206_r8, 82.461503_r8, & + 108.135600_r8, 62.132400_r8, 135.064039_r8, 135.064039_r8, 135.064039_r8, & + 28.010400_r8, 78.064600_r8, 18.998403_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, & + 27.025140_r8, 46.024600_r8, 20.005803_r8, 63.012340_r8, 79.011740_r8, & + 96.910800_r8, 52.459500_r8, 135.114940_r8, 116.112400_r8, 74.076200_r8, & + 100.113000_r8, 118.127200_r8, 68.114200_r8, 147.125940_r8, 147.125940_r8, & + 162.117940_r8, 163.125340_r8, 118.127200_r8, 184.350200_r8, 70.087800_r8, & + 120.100800_r8, 72.102600_r8, 104.101400_r8, 147.084740_r8, 136.228400_r8, & + 70.087800_r8, 14.006740_r8, 44.012880_r8, 108.010480_r8, 147.125940_r8, & + 145.111140_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, 231.239540_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, & + 183.117740_r8, 93.102400_r8, 94.109800_r8, 176.121600_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, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 28.010400_r8, 310.582400_r8, 140.134400_r8, & + 200.226000_r8, 215.240140_r8, 186.241400_r8, 168.227200_r8, 154.201400_r8, & + 174.148000_r8, 92.136200_r8, 150.126000_r8, 106.162000_r8, 188.173800_r8, & + 122.161400_r8, 204.173200_r8, 14.006740_r8, 14.006740_r8, 137.112200_r8, & + 103.135200_r8, 253.348200_r8, 159.114800_r8, 159.114800_r8, 123.127600_r8, & + 61.057800_r8, 75.083600_r8, 109.101800_r8, 75.042400_r8, 47.032000_r8, & + 129.089600_r8, 105.108800_r8, 61.057800_r8, 77.057200_r8, 33.006200_r8, & + 63.031400_r8, 117.119800_r8, 117.119800_r8, 117.119800_r8, 233.355800_r8, & + 119.093400_r8, 115.063800_r8, 101.079200_r8, 117.078600_r8, 103.094000_r8, & + 185.234000_r8, 230.232140_r8, 15.999400_r8, 17.006800_r8, 175.114200_r8, & + 91.083000_r8, 89.068200_r8, 199.218600_r8, 185.234000_r8, 173.140600_r8, & + 173.140600_r8, 149.118600_r8, 187.166400_r8, 187.166400_r8, 203.165800_r8, & + 18.014200_r8 /) + + crb_mass(:231) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, 60.055000_r8, & + 48.044000_r8, 60.055000_r8, 60.055000_r8, 72.066000_r8, 60.055000_r8, & + 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 84.077000_r8, 84.077000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 36.033000_r8, 36.033000_r8, & + 36.033000_r8, 72.066000_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, 24.022000_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, 12.011000_r8, 12.011000_r8, & + 84.077000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 24.022000_r8, 0.000000_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, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 48.044000_r8, 60.055000_r8, 36.033000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 156.143000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 120.110000_r8, & + 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 60.055000_r8, & + 60.055000_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, 120.110000_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, & + 84.077000_r8, 72.066000_r8, 72.066000_r8, 72.066000_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, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 12.011000_r8, 264.242000_r8, 84.077000_r8, & + 120.110000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, 108.099000_r8, & + 84.077000_r8, 84.077000_r8, 60.055000_r8, 96.088000_r8, 96.088000_r8, & + 96.088000_r8, 96.088000_r8, 0.000000_r8, 0.000000_r8, 84.077000_r8, & + 60.055000_r8, 180.165000_r8, 72.066000_r8, 72.066000_r8, 84.077000_r8, & + 24.022000_r8, 36.033000_r8, 72.066000_r8, 24.022000_r8, 12.011000_r8, & + 60.055000_r8, 48.044000_r8, 24.022000_r8, 24.022000_r8, 0.000000_r8, & + 12.011000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 156.143000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 120.110000_r8, 120.110000_r8, 0.000000_r8, 0.000000_r8, 72.066000_r8, & + 36.033000_r8, 36.033000_r8, 120.110000_r8, 120.110000_r8, 84.077000_r8, & + 84.077000_r8, 60.055000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, & + 0.000000_r8 /) + + fix_mass(: 3) = (/ 0.00000000_r8, 31.9988000_r8, 28.0134800_r8 /) + + clsmap(: 2,1) = (/ 188, 189 /) + clsmap(:229,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, 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, 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 /) + + permute(:229,4) = (/ 153, 156, 1, 2, 3, 187, 72, 122, 73, 116, & + 129, 98, 147, 106, 85, 112, 211, 86, 226, 143, & + 4, 88, 109, 101, 142, 94, 110, 103, 188, 121, & + 59, 95, 56, 68, 69, 60, 70, 61, 71, 62, & + 131, 215, 148, 63, 192, 114, 57, 182, 202, 158, & + 150, 169, 128, 212, 117, 223, 75, 54, 218, 180, & + 5, 195, 170, 89, 91, 79, 99, 6, 7, 8, & + 9, 64, 177, 193, 186, 213, 210, 58, 149, 65, & + 171, 90, 92, 102, 225, 76, 183, 100, 214, 123, & + 167, 172, 198, 84, 197, 111, 66, 174, 146, 140, & + 200, 120, 163, 50, 201, 104, 136, 105, 145, 184, & + 207, 134, 77, 97, 115, 191, 10, 11, 12, 55, & + 13, 14, 15, 221, 222, 219, 176, 118, 16, 17, & + 18, 19, 20, 227, 228, 21, 107, 113, 87, 139, & + 67, 130, 74, 108, 22, 23, 141, 119, 137, 24, & + 203, 175, 93, 25, 26, 27, 28, 29, 30, 31, & + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, & + 42, 43, 44, 45, 80, 154, 151, 132, 185, 190, & + 155, 78, 81, 82, 159, 83, 124, 138, 179, 46, & + 133, 47, 125, 173, 168, 152, 209, 220, 165, 144, & + 96, 160, 224, 126, 204, 205, 48, 49, 206, 161, & + 208, 178, 157, 51, 189, 216, 217, 127, 166, 196, & + 194, 181, 162, 52, 199, 164, 53, 135, 229 /) + + diag_map(:229) = (/ 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, 50, 56, 62, 68, 74, 76, & + 82, 88, 94, 95, 98, 101, 104, 107, 111, 115, & + 119, 123, 127, 131, 134, 137, 140, 143, 148, 153, & + 158, 164, 170, 174, 179, 181, 185, 189, 196, 201, & + 205, 210, 218, 223, 228, 231, 234, 237, 240, 243, & + 248, 253, 259, 263, 267, 271, 275, 281, 284, 290, & + 293, 300, 306, 312, 317, 322, 327, 332, 338, 343, & + 348, 351, 359, 367, 375, 381, 387, 393, 399, 405, & + 411, 417, 423, 429, 437, 443, 450, 456, 462, 465, & + 469, 476, 485, 493, 501, 508, 513, 520, 526, 534, & + 542, 550, 558, 566, 574, 583, 592, 596, 605, 612, & + 619, 627, 634, 644, 657, 668, 679, 686, 695, 708, & + 715, 726, 737, 750, 761, 770, 780, 789, 799, 803, & + 806, 815, 825, 836, 853, 859, 866, 875, 889, 901, & + 914, 924, 931, 950, 971, 981,1001,1026,1047,1061, & + 1075,1087,1098,1111,1125,1131,1142,1155,1175,1195, & + 1211,1223,1234,1258,1290,1313,1334,1356,1388,1403, & + 1417,1432,1447,1465,1487,1528,1693,1720,1778,1831, & + 1924,1969,2009,2117,2141,2166,2198,2260,2287 /) + + extfrc_lst(: 16) = (/ 'num_a1 ','num_a2 ','so4_a1 ','so4_a2 ','so4_a5 ', & + 'num_a4 ','num_a5 ','SO2 ','NO2 ','pom_a4 ', & + 'bc_a4 ','CO ','SVOC ','AOA_NH ','NO ', & + 'N ' /) + + frc_from_dataset(: 16) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .false., .false., & + .false. /) + + inv_lst(: 3) = (/ 'M ', 'O2 ', 'N2 ' /) + + slvd_lst(: 41) = (/ 'ACBZO2 ', 'ALKO2 ', 'BCARYO2VBS ', 'BENZO2 ', 'BENZO2VBS ', & + 'BZOO ', 'C2H5O2 ', 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', & + 'CH3O2 ', 'DICARBO2 ', 'ENEO2 ', 'EO ', 'EO2 ', & + 'HO2 ', 'HOCH2OO ', 'ISOPAO2 ', 'ISOPBO2 ', 'ISOPO2VBS ', & + 'IVOCO2VBS ', 'MACRO2 ', 'MALO2 ', 'MCO3 ', 'MDIALO2 ', & + 'MEKO2 ', 'MTERPO2VBS ', 'NTERPO2 ', 'O1D ', 'OH ', & + 'PHENO2 ', 'PO2 ', 'RO2 ', 'TERP2O2 ', 'TERPO2 ', & + 'TOLO2 ', 'TOLUO2VBS ', 'XO2 ', 'XYLENO2 ', 'XYLEO2VBS ', & + 'XYLOLO2 ' /) + + 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 ', & + 'jalknit ', 'jalkooh ', & + 'jbenzooh ', 'jbepomuc ', & + 'jbigald ', 'jbigald1 ', & + 'jbigald2 ', 'jbigald3 ', & + 'jbigald4 ', 'jbzooh ', & + 'jc2h5ooh ', 'jc3h7ooh ', & + 'jc6h5ooh ', 'jch2o_b ', & + 'jch2o_a ', 'jch3cho ', & + 'jacet ', 'jmgly ', & + 'jch3co3h ', 'jch3ooh ', & + 'jch4_b ', 'jch4_a ', & + 'jco2 ', 'jeooh ', & + 'jglyald ', 'jglyoxal ', & + 'jhonitr ', 'jhpald ', & + 'jhyac ', 'jisopnooh ', & + 'jisopooh ', 'jmacr_a ', & + 'jmacr_b ', 'jmek ', & + 'jmekooh ', 'jmpan ', & + 'jmvk ', 'jnc4cho ', & + 'jnoa ', 'jnterpooh ', & + 'jonitr ', 'jpan ', & + 'jphenooh ', 'jpooh ', & + 'jrooh ', 'jtepomuc ', & + 'jterp2ooh ', 'jterpnit ', & + 'jterpooh ', 'jterprd1 ', & + 'jterprd2 ', 'jtolooh ', & + 'jxooh ', 'jxylenooh ', & + 'jxylolooh ', 'jbrcl ', & + 'jbro ', 'jbrono2_b ', & + 'jbrono2_a ', 'jccl4 ', & + 'jcf2clbr ', 'jcf3br ', & + 'jcfcl3 ', 'jcfc113 ', & + 'jcfc114 ', 'jcfc115 ', & + 'jcf2cl2 ', 'jch2br2 ', & + 'jch3br ', 'jch3ccl3 ', & + 'jch3cl ', 'jchbr3 ', & + 'jcl2 ', 'jcl2o2 ', & + 'jclo ', 'jclono2_a ', & + 'jclono2_b ', 'jcof2 ', & + 'jcofcl ', 'jh2402 ', & + 'jhbr ', 'jhcfc141b ', & + 'jhcfc142b ', 'jhcfc22 ', & + 'jhcl ', 'jhf ', & + 'jhobr ', 'jhocl ', & + 'joclo ', 'jsf6 ', & + 'jh2so4 ', 'jocs ', & + 'jso ', 'jso2 ', & + 'jso3 ', 'jsoa1_a1 ', & + 'jsoa1_a2 ', 'jsoa2_a1 ', & + 'jsoa2_a2 ', 'jsoa3_a1 ', & + 'jsoa3_a2 ', 'jsoa4_a1 ', & + 'jsoa4_a2 ', 'jsoa5_a1 ', & + 'jsoa5_a2 ', 'E90_tau ', & + 'O1D_H2 ', 'O1D_H2O ', & + 'O1D_N2 ', 'O1D_O2ab ', & + 'O1D_O3 ', '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 ' /) + rxt_tag_lst( 201: 400) = (/ '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 ', 'F_CH4 ', & + 'F_H2 ', 'F_H2O ', & + 'F_HNO3 ', 'O1D_COF2 ', & + 'O1D_COFCL ', 'CH2BR2_CL ', & + 'CH2BR2_OH ', 'CH3BR_CL ', & + 'CH3BR_OH ', 'CH3CCL3_OH ', & + 'CH3CL_CL ', 'CH3CL_OH ', & + 'CHBR3_CL ', 'CHBR3_OH ', & + 'HCFC141B_OH ', 'HCFC142B_OH ', & + 'HCFC22_OH ', 'O1D_CH2BR2 ', & + 'O1D_CH3BR ', 'O1D_HCFC141B ', & + 'O1D_HCFC142B ', 'O1D_HCFC22 ', & + 'CH2O_HO2 ', 'CH2O_NO3 ', & + 'CH2O_O ', 'CH2O_OH ', & + 'CH3O2_CH3O2a ', 'CH3O2_CH3O2b ', & + 'CH3O2_HO2 ', 'CH3O2_NO ', & + 'CH3OH_OH ', 'CH3OOH_OH ', & + 'CH4_OH ', 'HCN_OH ', & + 'HCOOH_OH ', 'HOCH2OO_HO2 ', & + 'HOCH2OO_M ', 'HOCH2OO_NO ', & + 'O1D_CH4a ', 'O1D_CH4b ', & + 'O1D_CH4c ', 'O1D_HCN ', & + 'usr_CO_OH ', 'C2H2_CL_M ', & + 'C2H2_OH_M ', '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 ', 'CH3CN_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 ', & + 'BIGENE_NO3 ', 'BIGENE_OH ', & + 'ENEO2_NO ', 'ENEO2_NOb ', & + 'HONITR_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 ', & + 'MEKO2_HO2 ', 'MEKO2_NO ', & + 'MEK_OH ', 'MEKOOH_OH ', & + 'MPAN_OH_M ', 'MVK_O3 ', & + 'MVK_OH ', 'tag_MCO3_NO2 ', & + 'usr_MPAN_M ', 'ALKNIT_OH ', & + 'ALKO2_HO2 ', 'ALKO2_NO ', & + 'ALKO2_NOb ', 'ALKOOH_OH ', & + 'BIGALK_OH ', 'HPALD_OH ', & + 'HYDRALD_OH ', 'IEPOX_OH ', & + 'ISOPAO2_CH3CO3 ', 'ISOPAO2_CH3O2 ', & + 'ISOPAO2_HO2 ', 'ISOPAO2_NO ', & + 'ISOPAO2_NO3 ', 'ISOPBO2_CH3CO3 ', & + 'ISOPBO2_CH3O2 ', 'ISOPBO2_HO2 ', & + 'ISOPBO2_M ', 'ISOPBO2_NO ', & + 'ISOPBO2_NO3 ', 'ISOPNITA_OH ', & + 'ISOPNITB_OH ', 'ISOP_NO3 ', & + 'ISOPNO3_CH3CO3 ', 'ISOPNO3_CH3O2 ', & + 'ISOPNO3_HO2 ', 'ISOPNO3_NO ', & + 'ISOPNO3_NO3 ', 'ISOPNOOH_OH ', & + 'ISOP_O3 ', 'ISOP_OH ', & + 'ISOPOOH_OH ', 'NC4CH2OH_OH ', & + 'NC4CHO_OH ', 'XO2_CH3CO3 ', & + 'XO2_CH3O2 ', 'XO2_HO2 ', & + 'XO2_NO ', 'XO2_NO3 ', & + 'XOOH_OH ', 'ACBZO2_HO2 ', & + 'ACBZO2_NO ', 'BENZENE_OH ', & + 'BENZO2_HO2 ', 'BENZO2_NO ' /) + rxt_tag_lst( 401: 541) = (/ 'BENZOOH_OH ', 'BZALD_OH ', & + 'BZOO_HO2 ', 'BZOOH_OH ', & + 'BZOO_NO ', 'C6H5O2_HO2 ', & + 'C6H5O2_NO ', 'C6H5OOH_OH ', & + 'CRESOL_OH ', 'DICARBO2_HO2 ', & + 'DICARBO2_NO ', 'DICARBO2_NO2 ', & + 'MALO2_HO2 ', 'MALO2_NO ', & + 'MALO2_NO2 ', 'MDIALO2_HO2 ', & + 'MDIALO2_NO ', 'MDIALO2_NO2 ', & + 'PHENO2_HO2 ', 'PHENO2_NO ', & + 'PHENOL_OH ', 'PHENO_NO2 ', & + 'PHENO_O3 ', 'PHENOOH_OH ', & + 'tag_ACBZO2_NO2 ', 'TOLO2_HO2 ', & + 'TOLO2_NO ', 'TOLOOH_OH ', & + 'TOLUENE_OH ', 'usr_PBZNIT_M ', & + 'XYLENES_OH ', 'XYLENO2_HO2 ', & + 'XYLENO2_NO ', 'XYLENOOH_OH ', & + 'XYLOLO2_HO2 ', 'XYLOLO2_NO ', & + 'XYLOL_OH ', 'XYLOLOOH_OH ', & + 'BCARY_NO3 ', 'BCARY_O3 ', & + 'BCARY_OH ', 'MTERP_NO3 ', & + 'MTERP_O3 ', 'MTERP_OH ', & + 'NTERPO2_CH3O2 ', 'NTERPO2_HO2 ', & + 'NTERPO2_NO ', 'NTERPO2_NO3 ', & + 'NTERPOOH_OH ', 'TERP2O2_CH3O2 ', & + 'TERP2O2_HO2 ', 'TERP2O2_NO ', & + 'TERP2OOH_OH ', 'TERPNIT_OH ', & + 'TERPO2_CH3O2 ', 'TERPO2_HO2 ', & + 'TERPO2_NO ', 'TERPOOH_OH ', & + 'TERPROD1_NO3 ', 'TERPROD1_OH ', & + 'TERPROD2_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_GLYOXAL_aer ', & + 'usr_HO2_aer ', 'usr_HONITR_aer ', & + 'usr_ISOPNITA_aer ', 'usr_ISOPNITB_aer ', & + 'usr_N2O5_aer ', 'usr_NC4CH2OH_aer ', & + 'usr_NC4CHO_aer ', 'usr_NH4_strat_tau ', & + 'usr_NO2_aer ', 'usr_NO3_aer ', & + 'usr_NTERPOOH_aer ', 'usr_ONITR_aer ', & + 'usr_TERPNIT_aer ', 'BCARY_NO3_vbs ', & + 'BCARYO2_HO2_vbs ', 'BCARYO2_NO_vbs ', & + 'BCARY_O3_vbs ', 'BCARY_OH_vbs ', & + 'BENZENE_OH_vbs ', 'BENZO2_HO2_vbs ', & + 'BENZO2_NO_vbs ', 'ISOP_NO3_vbs ', & + 'ISOPO2_HO2_vbs ', 'ISOPO2_NO_vbs ', & + 'ISOP_O3_vbs ', 'ISOP_OH_vbs ', & + 'IVOCO2_HO2_vbs ', 'IVOCO2_NO_vbs ', & + 'IVOC_OH_vbs ', 'MTERP_NO3_vbs ', & + 'MTERPO2_HO2_vbs ', 'MTERPO2_NO_vbs ', & + 'MTERP_O3_vbs ', 'MTERP_OH_vbs ', & + 'SVOC_OH ', 'TOLUENE_OH_vbs ', & + 'TOLUO2_HO2_vbs ', 'TOLUO2_NO_vbs ', & + 'XYLENES_OH_vbs ', 'XYLEO2_HO2_vbs ', & + 'XYLEO2_NO_vbs ', 'het1 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ', & + 'het8 ', 'het9 ', & + '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, 364, 365, 366, 367, 368, 369, 370, & + 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, & + 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, & + 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, & + 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, & + 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, & + 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, & + 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, & + 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, & + 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, & + 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, & + 471, 472, 473, 474, 475, 476, 477, 478, 479, 480, & + 481, 482, 483, 484, 485, 486, 487, 488, 489, 490, & + 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, & + 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, & + 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, & + 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, & + 531, 532, 533, 534, 535, 536, 537, 538, 539, 540, & + 541 /) + 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 ', & + 'jch3ooh ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', ' ', & + ' ', ' ', ' ', ' ', & + 'jh2o2 ', ' ', ' ', ' ', & + ' ', 'jch3ooh ', ' ', 'jmgly ', & + 'jch2o_a ', 'jno2 ', ' ', 'jch3ooh ', & + 'jch3ooh ', ' ', ' ', 'jacet ', & + 'jch3ooh ', 'jpan ', ' ', 'jch2o_a ', & + 'jch2o_a ', 'jch3ooh ', 'jch3cho ', ' ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jno2 ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3cho ', & + 'jch3cho ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', '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, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 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, .10_r8, 0.2_r8, .14_r8, .20_r8, & + .20_r8, .006_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, & + .006_r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, .10_r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 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, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_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(:) = (/ 127, 130, 131, 132, 135, & + 138, 139, 140, 141, 144, & + 145, 146, 149, 151, 155, & + 156, 164, 165 /) + 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(:) = (/ 1, 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, 2, & + 2, 2, 3, 2, 2, 1, 2, 2, 2, 2, & + 2, 2, 3, 3, 3, 2, 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, 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, 1, & + 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, 3, 2, 2, 3, 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, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 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, 1, 2, & + 1, 1, 1, 1, 2, 2, 2, 1, 1, 2, & + 2, 2, 1, 1, 2, 1, 1, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_trop_strat_mam5_vbsext/chem_mech.doc b/src/chemistry/pp_trop_strat_mam5_vbsext/chem_mech.doc new file mode 100644 index 0000000000..f870c73440 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/chem_mech.doc @@ -0,0 +1,1963 @@ + + + Solution species + ( 1) ALKNIT (C5H11ONO2) + ( 2) ALKOOH (C5H12O2) + ( 3) AOA_NH (CO) + ( 4) bc_a1 (C) + ( 5) bc_a4 (C) + ( 6) BCARY (C15H24) + ( 7) BCARYO2VBS (C15H25O3) + ( 8) BENZENE (C6H6) + ( 9) BENZO2VBS (C6H7O5) + ( 10) BENZOOH (C6H8O5) + ( 11) BEPOMUC (C6H6O3) + ( 12) BIGALD (C5H6O2) + ( 13) BIGALD1 (C4H4O2) + ( 14) BIGALD2 (C5H6O2) + ( 15) BIGALD3 (C5H6O2) + ( 16) BIGALD4 (C6H8O2) + ( 17) BIGALK (C5H12) + ( 18) BIGENE (C4H8) + ( 19) BR (Br) + ( 20) BRCL (BrCl) + ( 21) BRO (BrO) + ( 22) BRONO2 (BrONO2) + ( 23) BRY + ( 24) BZALD (C7H6O) + ( 25) BZOOH (C7H8O2) + ( 26) C2H2 + ( 27) C2H4 + ( 28) C2H5OH + ( 29) C2H5OOH + ( 30) C2H6 + ( 31) C3H6 + ( 32) C3H7OOH + ( 33) C3H8 + ( 34) C6H5OOH (C6H5OOH) + ( 35) CCL4 (CCl4) + ( 36) CF2CLBR (CF2ClBr) + ( 37) CF3BR (CF3Br) + ( 38) CFC11 (CFCl3) + ( 39) CFC113 (CCl2FCClF2) + ( 40) CFC114 (CClF2CClF2) + ( 41) CFC115 (CClF2CF3) + ( 42) CFC12 (CF2Cl2) + ( 43) CH2BR2 (CH2Br2) + ( 44) CH2O + ( 45) CH3BR (CH3Br) + ( 46) CH3CCL3 (CH3CCl3) + ( 47) CH3CHO + ( 48) CH3CL (CH3Cl) + ( 49) CH3CN + ( 50) CH3COCH3 + ( 51) CH3COCHO + ( 52) CH3COOH + ( 53) CH3COOOH + ( 54) CH3OH + ( 55) CH3OOH + ( 56) CH4 + ( 57) CHBR3 (CHBr3) + ( 58) CL (Cl) + ( 59) CL2 (Cl2) + ( 60) CL2O2 (Cl2O2) + ( 61) CLO (ClO) + ( 62) CLONO2 (ClONO2) + ( 63) CLY + ( 64) CO + ( 65) CO2 + ( 66) COF2 + ( 67) COFCL (COFCl) + ( 68) CRESOL (C7H8O) + ( 69) DMS (CH3SCH3) + ( 70) dst_a1 (AlSiO5) + ( 71) dst_a2 (AlSiO5) + ( 72) dst_a3 (AlSiO5) + ( 73) E90 (CO) + ( 74) EOOH (HOCH2CH2OOH) + ( 75) F + ( 76) GLYALD (HOCH2CHO) + ( 77) GLYOXAL (C2H2O2) + ( 78) H + ( 79) H2 + ( 80) H2402 (CBrF2CBrF2) + ( 81) H2O2 + ( 82) H2SO4 (H2SO4) + ( 83) HBR (HBr) + ( 84) HCFC141B (CH3CCl2F) + ( 85) HCFC142B (CH3CClF2) + ( 86) HCFC22 (CHF2Cl) + ( 87) HCL (HCl) + ( 88) HCN + ( 89) HCOOH + ( 90) HF + ( 91) HNO3 + ( 92) HO2NO2 + ( 93) HOBR (HOBr) + ( 94) HOCL (HOCl) + ( 95) HONITR (C4H9NO4) + ( 96) HPALD (HOOCH2CCH3CHCHO) + ( 97) HYAC (CH3COCH2OH) + ( 98) HYDRALD (HOCH2CCH3CHCHO) + ( 99) IEPOX (C5H10O3) + (100) ISOP (C5H8) + (101) ISOPNITA (C5H9NO4) + (102) ISOPNITB (C5H9NO4) + (103) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + (104) ISOPNOOH (C5H9NO5) + (105) ISOPO2VBS (C5H9O3) + (106) ISOPOOH (HOCH2COOHCH3CHCH2) + (107) IVOCbb (C13H28) + (108) IVOCbbO2VBS (C13H29O3) + (109) IVOCff (C13H28) + (110) IVOCffO2VBS (C13H29O3) + (111) MACR (CH2CCH3CHO) + (112) MACROOH (CH3COCHOOHCH2OH) + (113) MEK (C4H8O) + (114) MEKOOH (C4H8O3) + (115) MPAN (CH2CCH3CO3NO2) + (116) MTERP (C10H16) + (117) MTERPO2VBS (C10H17O3) + (118) MVK (CH2CHCOCH3) + (119) N + (120) N2O + (121) N2O5 + (122) NC4CH2OH (C5H9NO4) + (123) NC4CHO (C5H7NO4) + (124) ncl_a1 (NaCl) + (125) ncl_a2 (NaCl) + (126) ncl_a3 (NaCl) + (127) NH3 + (128) NH4 + (129) NO + (130) NO2 + (131) NO3 + (132) NOA (CH3COCH2ONO2) + (133) NTERPOOH (C10H17NO5) + (134) num_a1 (H) + (135) num_a2 (H) + (136) num_a3 (H) + (137) num_a4 (H) + (138) num_a5 (H) + (139) O + (140) O3 + (141) O3S (O3) + (142) OCLO (OClO) + (143) OCS (OCS) + (144) ONITR (C4H7NO4) + (145) PAN (CH3CO3NO2) + (146) PBZNIT (C7H5O3NO2) + (147) PHENO (C6H5O) + (148) PHENOL (C6H5OH) + (149) PHENOOH (C6H8O6) + (150) pombb1_a1 (C) + (151) pombb1_a4 (C) + (152) pomff1_a1 (C) + (153) pomff1_a4 (C) + (154) POOH (C3H6OHOOH) + (155) ROOH (CH3COCH2OOH) + (156) S (S) + (157) SF6 + (158) SO (SO) + (159) SO2 + (160) SO3 (SO3) + (161) so4_a1 (NH4HSO4) + (162) so4_a2 (NH4HSO4) + (163) so4_a3 (NH4HSO4) + (164) so4_a5 (NH4HSO4) + (165) soabb1_a1 (C15H38O2) + (166) soabb1_a2 (C15H38O2) + (167) soabb2_a1 (C15H38O2) + (168) soabb2_a2 (C15H38O2) + (169) soabb3_a1 (C15H38O2) + (170) soabb3_a2 (C15H38O2) + (171) soabb4_a1 (C15H38O2) + (172) soabb4_a2 (C15H38O2) + (173) soabb5_a1 (C15H38O2) + (174) soabb5_a2 (C15H38O2) + (175) soabg1_a1 (C15H38O2) + (176) soabg1_a2 (C15H38O2) + (177) soabg2_a1 (C15H38O2) + (178) soabg2_a2 (C15H38O2) + (179) soabg3_a1 (C15H38O2) + (180) soabg3_a2 (C15H38O2) + (181) soabg4_a1 (C15H38O2) + (182) soabg4_a2 (C15H38O2) + (183) soabg5_a1 (C15H38O2) + (184) soabg5_a2 (C15H38O2) + (185) soaff1_a1 (C15H38O2) + (186) soaff1_a2 (C15H38O2) + (187) soaff2_a1 (C15H38O2) + (188) soaff2_a2 (C15H38O2) + (189) soaff3_a1 (C15H38O2) + (190) soaff3_a2 (C15H38O2) + (191) soaff4_a1 (C15H38O2) + (192) soaff4_a2 (C15H38O2) + (193) soaff5_a1 (C15H38O2) + (194) soaff5_a2 (C15H38O2) + (195) SOAGbb0 (C15H38O2) + (196) SOAGbb1 (C15H38O2) + (197) SOAGbb2 (C15H38O2) + (198) SOAGbb3 (C15H38O2) + (199) SOAGbb4 (C15H38O2) + (200) SOAGbg0 (C15H38O2) + (201) SOAGbg1 (C15H38O2) + (202) SOAGbg2 (C15H38O2) + (203) SOAGbg3 (C15H38O2) + (204) SOAGbg4 (C15H38O2) + (205) SOAGff0 (C15H38O2) + (206) SOAGff1 (C15H38O2) + (207) SOAGff2 (C15H38O2) + (208) SOAGff3 (C15H38O2) + (209) SOAGff4 (C15H38O2) + (210) SVOCbb (C22H46) + (211) SVOCff (C22H46) + (212) TEPOMUC (C7H8O3) + (213) TERP2OOH (C10H16O4) + (214) TERPNIT (C10H17NO4) + (215) TERPOOH (C10H18O3) + (216) TERPROD1 (C10H16O2) + (217) TERPROD2 (C9H14O2) + (218) TOLOOH (C7H10O5) + (219) TOLUENE (C7H8) + (220) TOLUO2VBS (C7H9O5) + (221) XOOH (HOCH2COOHCH3CHOHCHO) + (222) XYLENES (C8H10) + (223) XYLENOOH (C8H12O5) + (224) XYLEO2VBS (C8H11O5) + (225) XYLOL (C8H10O) + (226) XYLOLOOH (C8H12O6) + (227) NHDEP (N) + (228) NDEP (N) + (229) ACBZO2 (C7H5O3) + (230) ALKO2 (C5H11O2) + (231) BENZO2 (C6H7O5) + (232) BZOO (C7H7O2) + (233) C2H5O2 + (234) C3H7O2 + (235) C6H5O2 + (236) CH3CO3 + (237) CH3O2 + (238) DICARBO2 (C5H5O4) + (239) ENEO2 (C4H9O3) + (240) EO (HOCH2CH2O) + (241) EO2 (HOCH2CH2O2) + (242) HO2 + (243) HOCH2OO + (244) ISOPAO2 (HOC5H8O2) + (245) ISOPBO2 (HOC5H8O2) + (246) MACRO2 (CH3COCHO2CH2OH) + (247) MALO2 (C4H3O4) + (248) MCO3 (CH2CCH3CO3) + (249) MDIALO2 (C4H5O4) + (250) MEKO2 (C4H7O3) + (251) NTERPO2 (C10H16NO5) + (252) O1D (O) + (253) OH + (254) PHENO2 (C6H7O6) + (255) PO2 (C3H6OHO2) + (256) RO2 (CH3COCH2O2) + (257) TERP2O2 (C10H15O4) + (258) TERPO2 (C10H17O3) + (259) TOLO2 (C7H9O5) + (260) XO2 (HOCH2COOCH3CHOHCHO) + (261) XYLENO2 (C8H11O5) + (262) XYLOLO2 (C8H11O6) + (263) 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) ALKNIT + ( 2) ALKOOH + ( 3) AOA_NH + ( 4) bc_a1 + ( 5) bc_a4 + ( 6) BCARY + ( 7) BCARYO2VBS + ( 8) BENZENE + ( 9) BENZO2VBS + ( 10) BENZOOH + ( 11) BEPOMUC + ( 12) BIGALD + ( 13) BIGALD1 + ( 14) BIGALD2 + ( 15) BIGALD3 + ( 16) BIGALD4 + ( 17) BIGALK + ( 18) BIGENE + ( 19) BR + ( 20) BRCL + ( 21) BRO + ( 22) BRONO2 + ( 23) BRY + ( 24) BZALD + ( 25) BZOOH + ( 26) C2H2 + ( 27) C2H4 + ( 28) C2H5OH + ( 29) C2H5OOH + ( 30) C2H6 + ( 31) C3H6 + ( 32) C3H7OOH + ( 33) C3H8 + ( 34) C6H5OOH + ( 35) CCL4 + ( 36) CF2CLBR + ( 37) CF3BR + ( 38) CFC11 + ( 39) CFC113 + ( 40) CFC114 + ( 41) CFC115 + ( 42) CFC12 + ( 43) CH2BR2 + ( 44) CH2O + ( 45) CH3BR + ( 46) CH3CCL3 + ( 47) CH3CHO + ( 48) CH3CL + ( 49) CH3CN + ( 50) CH3COCH3 + ( 51) CH3COCHO + ( 52) CH3COOH + ( 53) CH3COOOH + ( 54) CH3OH + ( 55) CH3OOH + ( 56) CH4 + ( 57) CHBR3 + ( 58) CL + ( 59) CL2 + ( 60) CL2O2 + ( 61) CLO + ( 62) CLONO2 + ( 63) CLY + ( 64) CO + ( 65) CO2 + ( 66) COF2 + ( 67) COFCL + ( 68) CRESOL + ( 69) DMS + ( 70) dst_a1 + ( 71) dst_a2 + ( 72) dst_a3 + ( 73) E90 + ( 74) EOOH + ( 75) F + ( 76) GLYALD + ( 77) GLYOXAL + ( 78) H + ( 79) H2 + ( 80) H2402 + ( 81) H2O2 + ( 82) H2SO4 + ( 83) HBR + ( 84) HCFC141B + ( 85) HCFC142B + ( 86) HCFC22 + ( 87) HCL + ( 88) HCN + ( 89) HCOOH + ( 90) HF + ( 91) HNO3 + ( 92) HO2NO2 + ( 93) HOBR + ( 94) HOCL + ( 95) HONITR + ( 96) HPALD + ( 97) HYAC + ( 98) HYDRALD + ( 99) IEPOX + (100) ISOP + (101) ISOPNITA + (102) ISOPNITB + (103) ISOPNO3 + (104) ISOPNOOH + (105) ISOPO2VBS + (106) ISOPOOH + (107) IVOCbb + (108) IVOCbbO2VBS + (109) IVOCff + (110) IVOCffO2VBS + (111) MACR + (112) MACROOH + (113) MEK + (114) MEKOOH + (115) MPAN + (116) MTERP + (117) MTERPO2VBS + (118) MVK + (119) N + (120) N2O + (121) N2O5 + (122) NC4CH2OH + (123) NC4CHO + (124) ncl_a1 + (125) ncl_a2 + (126) ncl_a3 + (127) NH3 + (128) NH4 + (129) NO + (130) NO2 + (131) NO3 + (132) NOA + (133) NTERPOOH + (134) num_a1 + (135) num_a2 + (136) num_a3 + (137) num_a4 + (138) num_a5 + (139) O + (140) O3 + (141) O3S + (142) OCLO + (143) OCS + (144) ONITR + (145) PAN + (146) PBZNIT + (147) PHENO + (148) PHENOL + (149) PHENOOH + (150) pombb1_a1 + (151) pombb1_a4 + (152) pomff1_a1 + (153) pomff1_a4 + (154) POOH + (155) ROOH + (156) S + (157) SF6 + (158) SO + (159) SO2 + (160) SO3 + (161) so4_a1 + (162) so4_a2 + (163) so4_a3 + (164) so4_a5 + (165) soabb1_a1 + (166) soabb1_a2 + (167) soabb2_a1 + (168) soabb2_a2 + (169) soabb3_a1 + (170) soabb3_a2 + (171) soabb4_a1 + (172) soabb4_a2 + (173) soabb5_a1 + (174) soabb5_a2 + (175) soabg1_a1 + (176) soabg1_a2 + (177) soabg2_a1 + (178) soabg2_a2 + (179) soabg3_a1 + (180) soabg3_a2 + (181) soabg4_a1 + (182) soabg4_a2 + (183) soabg5_a1 + (184) soabg5_a2 + (185) soaff1_a1 + (186) soaff1_a2 + (187) soaff2_a1 + (188) soaff2_a2 + (189) soaff3_a1 + (190) soaff3_a2 + (191) soaff4_a1 + (192) soaff4_a2 + (193) soaff5_a1 + (194) soaff5_a2 + (195) SOAGbb0 + (196) SOAGbb1 + (197) SOAGbb2 + (198) SOAGbb3 + (199) SOAGbb4 + (200) SOAGbg0 + (201) SOAGbg1 + (202) SOAGbg2 + (203) SOAGbg3 + (204) SOAGbg4 + (205) SOAGff0 + (206) SOAGff1 + (207) SOAGff2 + (208) SOAGff3 + (209) SOAGff4 + (210) SVOCbb + (211) SVOCff + (212) TEPOMUC + (213) TERP2OOH + (214) TERPNIT + (215) TERPOOH + (216) TERPROD1 + (217) TERPROD2 + (218) TOLOOH + (219) TOLUENE + (220) TOLUO2VBS + (221) XOOH + (222) XYLENES + (223) XYLENOOH + (224) XYLEO2VBS + (225) XYLOL + (226) XYLOLOOH + (227) ACBZO2 + (228) ALKO2 + (229) BENZO2 + (230) BZOO + (231) C2H5O2 + (232) C3H7O2 + (233) C6H5O2 + (234) CH3CO3 + (235) CH3O2 + (236) DICARBO2 + (237) ENEO2 + (238) EO + (239) EO2 + (240) HO2 + (241) HOCH2OO + (242) ISOPAO2 + (243) ISOPBO2 + (244) MACRO2 + (245) MALO2 + (246) MCO3 + (247) MDIALO2 + (248) MEKO2 + (249) NTERPO2 + (250) O1D + (251) OH + (252) PHENO2 + (253) PO2 + (254) RO2 + (255) TERP2O2 + (256) TERPO2 + (257) TOLO2 + (258) XO2 + (259) XYLENO2 + (260) XYLOLO2 + (261) 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_b ( 13) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 13) + jn2o5_a ( 14) N2O5 + hv -> NO2 + 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) + jalknit ( 19) ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 rate = ** User defined ** ( 19) + + 0.8*MEK + jalkooh ( 20) ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 rate = ** User defined ** ( 20) + + 0.8*MEK + OH + jbenzooh ( 21) BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 rate = ** User defined ** ( 21) + jbepomuc ( 22) BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO rate = ** User defined ** ( 22) + jbigald ( 23) BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 rate = ** User defined ** ( 23) + + 0.18*CH3COCHO + jbigald1 ( 24) BIGALD1 + hv -> 0.6*MALO2 + HO2 rate = ** User defined ** ( 24) + jbigald2 ( 25) BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 rate = ** User defined ** ( 25) + jbigald3 ( 26) BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 rate = ** User defined ** ( 26) + jbigald4 ( 27) BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 rate = ** User defined ** ( 27) + jbzooh ( 28) BZOOH + hv -> BZALD + OH + HO2 rate = ** User defined ** ( 28) + jc2h5ooh ( 29) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 29) + jc3h7ooh ( 30) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 30) + jc6h5ooh ( 31) C6H5OOH + hv -> PHENO + OH rate = ** User defined ** ( 31) + jch2o_b ( 32) CH2O + hv -> CO + H2 rate = ** User defined ** ( 32) + jch2o_a ( 33) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 33) + jch3cho ( 34) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 34) + jacet ( 35) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 35) + jmgly ( 36) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 36) + jch3co3h ( 37) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 37) + jch3ooh ( 38) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 38) + jch4_b ( 39) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 39) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jch4_a ( 40) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 40) + jco2 ( 41) CO2 + hv -> CO + O rate = ** User defined ** ( 41) + jeooh ( 42) EOOH + hv -> EO + OH rate = ** User defined ** ( 42) + jglyald ( 43) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 43) + jglyoxal ( 44) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 44) + jhonitr ( 45) HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO rate = ** User defined ** ( 45) + + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + + 0.17*CH3COCH3 + jhpald ( 46) HPALD + hv -> BIGALD3 + OH + HO2 rate = ** User defined ** ( 46) + jhyac ( 47) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 47) + jisopnooh ( 48) ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH rate = ** User defined ** ( 48) + jisopooh ( 49) ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + CH2O + HO2 rate = ** User defined ** ( 49) + jmacr_b ( 50) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 50) + jmacr_a ( 51) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 51) + jmek ( 52) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 52) + jmekooh ( 53) MEKOOH + hv -> OH + CH3CO3 + CH3CHO rate = ** User defined ** ( 53) + jmpan ( 54) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 54) + jmvk ( 55) MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 rate = ** User defined ** ( 55) + jnc4cho ( 56) NC4CHO + hv -> BIGALD3 + NO2 + HO2 rate = ** User defined ** ( 56) + jnoa ( 57) NOA + hv -> NO2 + CH2O + CH3CO3 rate = ** User defined ** ( 57) + jnterpooh ( 58) NTERPOOH + hv -> TERPROD1 + NO2 + OH rate = ** User defined ** ( 58) + jonitr ( 59) ONITR + hv -> NO2 rate = ** User defined ** ( 59) + jpan ( 60) PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 rate = ** User defined ** ( 60) + jphenooh ( 61) PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL rate = ** User defined ** ( 61) + jpooh ( 62) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 62) + jrooh ( 63) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 63) + jtepomuc ( 64) TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO rate = ** User defined ** ( 64) + jterp2ooh ( 65) TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 rate = ** User defined ** ( 65) + + TERPROD2 + HO2 + 0.25*GLYALD + jterpnit ( 66) TERPNIT + hv -> TERPROD1 + NO2 + HO2 rate = ** User defined ** ( 66) + jterpooh ( 67) TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH rate = ** User defined ** ( 67) + jterprd1 ( 68) TERPROD1 + hv -> HO2 + CO + TERPROD2 rate = ** User defined ** ( 68) + jterprd2 ( 69) TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 rate = ** User defined ** ( 69) + + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO + jtolooh ( 70) TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = ** User defined ** ( 70) + + 0.2*BIGALD2 + 0.2*BIGALD3 + jxooh ( 71) XOOH + hv -> OH rate = ** User defined ** ( 71) + jxylenooh ( 72) XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = ** User defined ** ( 72) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + jxylolooh ( 73) XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 rate = ** User defined ** ( 73) + jbrcl ( 74) BRCL + hv -> BR + CL rate = ** User defined ** ( 74) + jbro ( 75) BRO + hv -> BR + O rate = ** User defined ** ( 75) + jbrono2_b ( 76) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 76) + jbrono2_a ( 77) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 77) + jccl4 ( 78) CCL4 + hv -> 4*CL rate = ** User defined ** ( 78) + jcf2clbr ( 79) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 79) + jcf3br ( 80) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 80) + jcfcl3 ( 81) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 81) + jcfc113 ( 82) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 82) + jcfc114 ( 83) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 83) + jcfc115 ( 84) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 84) + jcf2cl2 ( 85) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 85) + jch2br2 ( 86) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 86) + jch3br ( 87) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 87) + jch3ccl3 ( 88) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 88) + jch3cl ( 89) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 89) + jchbr3 ( 90) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 90) + jcl2 ( 91) CL2 + hv -> 2*CL rate = ** User defined ** ( 91) + jcl2o2 ( 92) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 92) + jclo ( 93) CLO + hv -> CL + O rate = ** User defined ** ( 93) + jclono2_b ( 94) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 94) + jclono2_a ( 95) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 95) + jcof2 ( 96) COF2 + hv -> 2*F rate = ** User defined ** ( 96) + jcofcl ( 97) COFCL + hv -> F + CL rate = ** User defined ** ( 97) + jh2402 ( 98) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 98) + jhbr ( 99) HBR + hv -> BR + H rate = ** User defined ** ( 99) + jhcfc141b (100) HCFC141B + hv -> CL + COFCL rate = ** User defined ** (100) + jhcfc142b (101) HCFC142B + hv -> CL + COF2 rate = ** User defined ** (101) + jhcfc22 (102) HCFC22 + hv -> CL + COF2 rate = ** User defined ** (102) + jhcl (103) HCL + hv -> H + CL rate = ** User defined ** (103) + jhf (104) HF + hv -> H + F rate = ** User defined ** (104) + jhobr (105) HOBR + hv -> BR + OH rate = ** User defined ** (105) + jhocl (106) HOCL + hv -> OH + CL rate = ** User defined ** (106) + joclo (107) OCLO + hv -> O + CLO rate = ** User defined ** (107) + jsf6 (108) SF6 + hv -> {sink} rate = ** User defined ** (108) + jh2so4 (109) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** (109) + jocs (110) OCS + hv -> S + CO rate = ** User defined ** (110) + jso (111) SO + hv -> S + O rate = ** User defined ** (111) + jso2 (112) SO2 + hv -> SO + O rate = ** User defined ** (112) + jso3 (113) SO3 + hv -> SO2 + O rate = ** User defined ** (113) + jsoabb1_a1 (114) soabb1_a1 + hv -> (No products) rate = ** User defined ** (114) + jsoabb1_a2 (115) soabb1_a2 + hv -> (No products) rate = ** User defined ** (115) + jsoabb2_a1 (116) soabb2_a1 + hv -> (No products) rate = ** User defined ** (116) + jsoabb2_a2 (117) soabb2_a2 + hv -> (No products) rate = ** User defined ** (117) + jsoabb3_a1 (118) soabb3_a1 + hv -> (No products) rate = ** User defined ** (118) + jsoabb3_a2 (119) soabb3_a2 + hv -> (No products) rate = ** User defined ** (119) + jsoabb4_a1 (120) soabb4_a1 + hv -> (No products) rate = ** User defined ** (120) + jsoabb4_a2 (121) soabb4_a2 + hv -> (No products) rate = ** User defined ** (121) + jsoabb5_a1 (122) soabb5_a1 + hv -> (No products) rate = ** User defined ** (122) + jsoabb5_a2 (123) soabb5_a2 + hv -> (No products) rate = ** User defined ** (123) + jsoabg1_a1 (124) soabg1_a1 + hv -> (No products) rate = ** User defined ** (124) + jsoabg1_a2 (125) soabg1_a2 + hv -> (No products) rate = ** User defined ** (125) + jsoabg2_a1 (126) soabg2_a1 + hv -> (No products) rate = ** User defined ** (126) + jsoabg2_a2 (127) soabg2_a2 + hv -> (No products) rate = ** User defined ** (127) + jsoabg3_a1 (128) soabg3_a1 + hv -> (No products) rate = ** User defined ** (128) + jsoabg3_a2 (129) soabg3_a2 + hv -> (No products) rate = ** User defined ** (129) + jsoabg4_a1 (130) soabg4_a1 + hv -> (No products) rate = ** User defined ** (130) + jsoabg4_a2 (131) soabg4_a2 + hv -> (No products) rate = ** User defined ** (131) + jsoabg5_a1 (132) soabg5_a1 + hv -> (No products) rate = ** User defined ** (132) + jsoabg5_a2 (133) soabg5_a2 + hv -> (No products) rate = ** User defined ** (133) + jsoaff1_a1 (134) soaff1_a1 + hv -> (No products) rate = ** User defined ** (134) + jsoaff1_a2 (135) soaff1_a2 + hv -> (No products) rate = ** User defined ** (135) + jsoaff2_a1 (136) soaff2_a1 + hv -> (No products) rate = ** User defined ** (136) + jsoaff2_a2 (137) soaff2_a2 + hv -> (No products) rate = ** User defined ** (137) + jsoaff3_a1 (138) soaff3_a1 + hv -> (No products) rate = ** User defined ** (138) + jsoaff3_a2 (139) soaff3_a2 + hv -> (No products) rate = ** User defined ** (139) + jsoaff4_a1 (140) soaff4_a1 + hv -> (No products) rate = ** User defined ** (140) + jsoaff4_a2 (141) soaff4_a2 + hv -> (No products) rate = ** User defined ** (141) + jsoaff5_a1 (142) soaff5_a1 + hv -> (No products) rate = ** User defined ** (142) + jsoaff5_a2 (143) soaff5_a2 + hv -> (No products) rate = ** User defined ** (143) + + Reactions + O1D_H2 ( 1) O1D + H2 -> H + OH rate = 1.20E-10 (144) + O1D_H2O ( 2) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (145) + O1D_N2 ( 3) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (146) + O1D_O2ab ( 4) O1D + O2 -> O + O2 rate = 3.30E-11*exp( 55./t) (147) + O1D_O3 ( 5) O1D + O3 -> O2 + O2 rate = 1.20E-10 (148) + O_O3 ( 6) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (149) + usr_O_O ( 7) O + O + M -> O2 + M rate = ** User defined ** (150) + usr_O_O2 ( 8) O + O2 + M -> O3 + M rate = ** User defined ** (151) + H2_O ( 9) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (152) + H2O2_O ( 10) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (153) + H_HO2 ( 11) H + HO2 -> H2 + O2 rate = 6.90E-12 (154) + H_HO2a ( 12) H + HO2 -> 2*OH rate = 7.20E-11 (155) + H_HO2b ( 13) H + HO2 -> H2O + O rate = 1.60E-12 (156) + H_O2 ( 14) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (157) + ki=9.50E-11*(300/t)**-0.40 + f=0.60 + HO2_O ( 15) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (158) + HO2_O3 ( 16) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (159) + H_O3 ( 17) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (160) + OH_H2 ( 18) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (161) + OH_H2O2 ( 19) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (162) + OH_HO2 ( 20) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (163) + OH_O ( 21) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (164) + OH_O3 ( 22) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (165) + OH_OH ( 23) OH + OH -> H2O + O rate = 1.80E-12 (166) + OH_OH_M ( 24) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (167) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 ( 25) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (168) + HO2NO2_OH ( 26) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (169) + N_NO ( 27) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (170) + N_NO2a ( 28) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (171) + N_NO2b ( 29) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (172) + N_NO2c ( 30) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (173) + N_O2 ( 31) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (174) + NO2_O ( 32) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (175) + NO2_O3 ( 33) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (176) + NO2_O_M ( 34) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (177) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 ( 35) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (178) + NO3_NO ( 36) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (179) + NO3_O ( 37) NO3 + O -> NO2 + O2 rate = 1.30E-11 (180) + NO3_OH ( 38) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (181) + N_OH ( 39) N + OH -> NO + H rate = 5.00E-11 (182) + NO_HO2 ( 40) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (183) + NO_O3 ( 41) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (184) + NO_O_M ( 42) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (185) + ki=3.00E-11 + f=0.60 + O1D_N2Oa ( 43) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (186) + O1D_N2Ob ( 44) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (187) + tag_NO2_HO2 ( 45) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (188) + ki=4.00E-12*(300/t)**0.30 + f=0.60 + tag_NO2_NO3 ( 46) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (189) + ki=1.60E-12*(300/t)**-0.10 + f=0.60 + tag_NO2_OH ( 47) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (190) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 48) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (191) + usr_HO2NO2_M ( 49) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (192) + usr_N2O5_M ( 50) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (193) + CL_CH2O ( 51) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (194) + CL_CH4 ( 52) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (195) + CL_H2 ( 53) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (196) + CL_H2O2 ( 54) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (197) + CL_HO2a ( 55) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (198) + CL_HO2b ( 56) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (199) + CL_O3 ( 57) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (200) + CLO_CH3O2 ( 58) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (201) + CLO_CLOa ( 59) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (202) + CLO_CLOb ( 60) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (203) + CLO_CLOc ( 61) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (204) + CLO_HO2 ( 62) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (205) + CLO_NO ( 63) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (206) + CLONO2_CL ( 64) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (207) + CLO_NO2_M ( 65) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (208) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLONO2_O ( 66) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (209) + CLONO2_OH ( 67) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (210) + CLO_O ( 68) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (211) + CLO_OHa ( 69) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (212) + CLO_OHb ( 70) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (213) + HCL_O ( 71) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (214) + HCL_OH ( 72) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (215) + HOCL_CL ( 73) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (216) + HOCL_O ( 74) HOCL + O -> CLO + OH rate = 1.70E-13 (217) + HOCL_OH ( 75) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (218) + O1D_CCL4 ( 76) O1D + CCL4 -> 4*CL rate = 2.61E-10 (219) + O1D_CF2CLBR ( 77) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (220) + O1D_CFC11 ( 78) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (221) + O1D_CFC113 ( 79) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (222) + O1D_CFC114 ( 80) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (223) + O1D_CFC115 ( 81) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (224) + O1D_CFC12 ( 82) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (225) + O1D_HCLa ( 83) O1D + HCL -> CL + OH rate = 9.90E-11 (226) + O1D_HCLb ( 84) O1D + HCL -> CLO + H rate = 3.30E-12 (227) + tag_CLO_CLO_M ( 85) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (228) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M ( 86) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (229) + BR_CH2O ( 87) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (230) + BR_HO2 ( 88) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (231) + BR_O3 ( 89) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (232) + BRO_BRO ( 90) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (233) + BRO_CLOa ( 91) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (234) + BRO_CLOb ( 92) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (235) + BRO_CLOc ( 93) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (236) + BRO_HO2 ( 94) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (237) + BRO_NO ( 95) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (238) + BRO_NO2_M ( 96) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (239) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRONO2_O ( 97) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (240) + BRO_O ( 98) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (241) + BRO_OH ( 99) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (242) + HBR_O (100) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (243) + HBR_OH (101) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (244) + HOBR_O (102) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (245) + O1D_CF3BR (103) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (246) + O1D_CHBR3 (104) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (247) + O1D_H2402 (105) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (248) + O1D_HBRa (106) O1D + HBR -> BR + OH rate = 9.00E-11 (249) + O1D_HBRb (107) O1D + HBR -> BRO + H rate = 3.00E-11 (250) + F_CH4 (108) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (251) + F_H2 (109) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (252) + F_H2O (110) F + H2O -> HF + OH rate = 1.40E-11 (253) + F_HNO3 (111) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (254) + O1D_COF2 (112) O1D + COF2 -> 2*F rate = 2.14E-11 (255) + O1D_COFCL (113) O1D + COFCL -> F + CL rate = 1.90E-10 (256) + CH2BR2_CL (114) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (257) + CH2BR2_OH (115) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (258) + CH3BR_CL (116) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (259) + CH3BR_OH (117) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (260) + CH3CCL3_OH (118) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (261) + CH3CL_CL (119) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1110./t) (262) + CH3CL_OH (120) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (263) + CHBR3_CL (121) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (264) + CHBR3_OH (122) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (265) + HCFC141B_OH (123) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (266) + HCFC142B_OH (124) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (267) + HCFC22_OH (125) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (268) + O1D_CH2BR2 (126) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (269) + O1D_CH3BR (127) O1D + CH3BR -> BR rate = 1.80E-10 (270) + O1D_HCFC141B (128) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (271) + O1D_HCFC142B (129) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (272) + O1D_HCFC22 (130) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (273) + CH2O_HO2 (131) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) (274) + CH2O_NO3 (132) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (275) + CH2O_O (133) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (276) + CH2O_OH (134) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (277) + CH3O2_CH3O2a (135) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (278) + CH3O2_CH3O2b (136) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (279) + CH3O2_HO2 (137) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (280) + CH3O2_NO (138) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (281) + CH3OH_OH (139) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (282) + CH3OOH_OH (140) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (283) + CH4_OH (141) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (284) + HCN_OH (142) HCN + OH + M -> HO2 + M troe : ko=6.10E-33*(300/t)**1.50 (285) + ki=9.80E-15*(300/t)**-4.60 + f=0.80 + HCOOH_OH (143) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (286) + HOCH2OO_HO2 (144) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (287) + HOCH2OO_M (145) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (288) + HOCH2OO_NO (146) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (289) + O1D_CH4a (147) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (290) + O1D_CH4b (148) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (291) + O1D_CH4c (149) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (292) + O1D_HCN (150) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (293) + usr_CO_OH (151) CO + OH -> CO2 + HO2 rate = ** User defined ** (294) + C2H2_CL_M (152) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (295) + ki=2.20E-10*(300/t)**0.70 + f=0.60 + C2H2_OH_M (153) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (296) + + 0.35*CO + M ki=8.30E-13*(300/t)**-2.00 + f=0.60 + C2H4_CL_M (154) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (297) + ki=3.10E-10*(300/t) + f=0.60 + C2H4_O3 (155) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (298) + C2H5O2_C2H5O2 (156) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (299) + C2H5O2_CH3O2 (157) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (300) + + 0.2*C2H5OH + C2H5O2_HO2 (158) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (301) + C2H5O2_NO (159) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (302) + C2H5OH_OH (160) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (303) + C2H5OOH_OH (161) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (304) + C2H6_CL (162) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (305) + C2H6_OH (163) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (306) + CH3CHO_NO3 (164) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (307) + CH3CHO_OH (165) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (308) + CH3CN_OH (166) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (309) + CH3CO3_CH3CO3 (167) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (310) + CH3CO3_CH3O2 (168) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (311) + + 0.1*CH3COOH + CH3CO3_HO2 (169) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (312) + + 0.45*CH3O2 + CH3CO3_NO (170) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (313) + CH3COOH_OH (171) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 3.15E-14*exp( 920./t) (314) + CH3COOOH_OH (172) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (315) + EO2_HO2 (173) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (316) + EO2_NO (174) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (317) + EO_M (175) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (318) + EO_O2 (176) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (319) + GLYALD_OH (177) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (320) + GLYOXAL_OH (178) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (321) + PAN_OH (179) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (322) + tag_C2H4_OH (180) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (323) + ki=9.00E-12*(300/t)**0.85 + f=0.48 + tag_CH3CO3_NO2 (181) CH3CO3 + NO2 + M -> PAN + M troe : ko=7.30E-29*(300/t)**4.10 (324) + ki=9.50E-12*(300/t)**1.60 + f=0.60 + usr_PAN_M (182) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (325) + C3H6_NO3 (183) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (326) + C3H6_O3 (184) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (327) + + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + + 0.36*OH + C3H7O2_CH3O2 (185) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (328) + C3H7O2_HO2 (186) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (329) + C3H7O2_NO (187) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (330) + C3H7OOH_OH (188) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (331) + C3H8_OH (189) C3H8 + OH -> C3H7O2 + H2O rate = 9.19E-12*exp( -630./t) (332) + CH3COCHO_NO3 (190) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (333) + CH3COCHO_OH (191) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (334) + HYAC_OH (192) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (335) + NOA_OH (193) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (336) + PO2_HO2 (194) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (337) + PO2_NO (195) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (338) + POOH_OH (196) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (339) + RO2_CH3O2 (197) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (340) + + 0.5*CH3COCHO + 0.5*CH3OH + RO2_HO2 (198) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (341) + RO2_NO (199) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (342) + ROOH_OH (200) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (343) + tag_C3H6_OH (201) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (344) + ki=3.00E-11 + f=0.50 + usr_CH3COCH3_OH (202) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (345) + BIGENE_NO3 (203) BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 rate = 3.50E-13 (346) + BIGENE_OH (204) BIGENE + OH -> ENEO2 rate = 5.40E-11 (347) + ENEO2_NO (205) ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 rate = 4.80E-12*exp( 120./t) (348) + ENEO2_NOb (206) ENEO2 + NO -> HONITR rate = 5.10E-14*exp( 693./t) (349) + HONITR_OH (207) HONITR + OH -> ONITR + HO2 rate = 2.00E-12 (350) + MACRO2_CH3CO3 (208) MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 rate = 1.40E-11 (351) + + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + + 0.53*CH3CO3 + MACRO2_CH3O2 (209) MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO rate = 5.00E-13*exp( 400./t) (352) + + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + + 0.23*HYAC + MACRO2_HO2 (210) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (353) + MACRO2_NO3 (211) MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO rate = 2.40E-12 (354) + + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 + MACRO2_NOa (212) MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD rate = 2.70E-12*exp( 360./t) (355) + + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO + MACRO2_NOb (213) MACRO2 + NO -> HONITR rate = 1.30E-13*exp( 360./t) (356) + MACR_O3 (214) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (357) + + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 + MACR_OH (215) MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 rate = 9.60E-12*exp( 360./t) (358) + MACROOH_OH (216) MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 rate = 2.30E-11*exp( 200./t) (359) + MCO3_CH3CO3 (217) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (360) + MCO3_CH3O2 (218) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (361) + MCO3_HO2 (219) MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH rate = 4.30E-13*exp( 1040./t) (362) + + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 + MCO3_MCO3 (220) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (363) + MCO3_NO (221) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (364) + MCO3_NO3 (222) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (365) + MEKO2_HO2 (223) MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 rate = 7.50E-13*exp( 700./t) (366) + MEKO2_NO (224) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (367) + MEK_OH (225) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (368) + MEKOOH_OH (226) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (369) + MPAN_OH_M (227) 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 (370) + + M + 0.5*NDEP ki=3.00E-11 + f=0.50 + MVK_O3 (228) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (371) + + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH + MVK_OH (229) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (372) + usr_MCO3_NO2 (230) MCO3 + NO2 + M -> MPAN + M rate = ** User defined ** (373) + usr_MPAN_M (231) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (374) + ALKNIT_OH (232) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (375) + ALKO2_HO2 (233) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (376) + ALKO2_NO (234) ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK rate = 6.70E-12 (377) + + NO2 + ALKO2_NOb (235) ALKO2 + NO -> ALKNIT rate = 5.40E-14*exp( 870./t) (378) + ALKOOH_OH (236) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (379) + BIGALK_OH (237) BIGALK + OH -> ALKO2 rate = 3.50E-12 (380) + HPALD_OH (238) HPALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (381) + HYDRALD_OH (239) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (382) + IEPOX_OH (240) IEPOX + OH -> XO2 rate = 1.30E-11 (383) + ISOPAO2_CH3CO3 (241) ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 rate = 1.40E-11 (384) + ISOPAO2_CH3O2 (242) ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR rate = 5.00E-13*exp( 400./t) (385) + + 0.44*MVK + ISOPAO2_HO2 (243) ISOPAO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (386) + ISOPAO2_NO (244) ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK rate = 4.40E-12*exp( 180./t) (387) + + 0.92*CH2O + 0.92*HO2 + ISOPAO2_NO3 (245) ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 rate = 2.40E-12 (388) + ISOPBO2_CH3CO3 (246) ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 rate = 1.40E-11 (389) + ISOPBO2_CH3O2 (247) ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD rate = 5.00E-13*exp( 400./t) (390) + ISOPBO2_HO2 (248) ISOPBO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (391) + ISOPBO2_M (249) ISOPBO2 -> HPALD + HO2 rate = 1.60E+09*exp( -8300./t) (392) + ISOPBO2_NO (250) ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 rate = 4.40E-12*exp( 180./t) (393) + + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + + 0.05*HYAC + ISOPBO2_NO3 (251) ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL rate = 2.40E-12 (394) + + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC + ISOPNITA_OH (252) ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O rate = 4.00E-11 (395) + + 0.3*HONITR + 0.3*HO2 + ISOPNITB_OH (253) ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR rate = 4.00E-11 (396) + ISOP_NO3 (254) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (397) + ISOPNO3_CH3CO3 (255) ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 rate = 1.40E-11 (398) + ISOPNO3_CH3O2 (256) ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH rate = 5.00E-13*exp( 400./t) (399) + + 0.2*NC4CH2OH + ISOPNO3_HO2 (257) ISOPNO3 + HO2 -> ISOPNOOH rate = 8.00E-13*exp( 700./t) (400) + ISOPNO3_NO (258) ISOPNO3 + NO -> NC4CHO + NO2 + HO2 rate = 2.70E-12*exp( 360./t) (401) + ISOPNO3_NO3 (259) ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 rate = 2.40E-12 (402) + ISOPNOOH_OH (260) ISOPNOOH + OH -> NOA + HO2 rate = 4.00E-11 (403) + ISOP_O3 (261) ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH rate = 1.05E-14*exp( -2000./t) (404) + + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + + 0.05*CH3O2 + ISOP_OH (262) ISOP + OH -> 0.6*ISOPAO2 + 0.4*ISOPBO2 rate = 2.54E-11*exp( 410./t) (405) + ISOPOOH_OH (263) ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH rate = 1.52E-11*exp( 200./t) (406) + NC4CH2OH_OH (264) NC4CH2OH + OH -> GLYALD + NOA + HO2 rate = 7.00E-11 (407) + NC4CHO_OH (265) NC4CHO + OH -> GLYOXAL + NOA + HO2 rate = 1.00E-10 (408) + XO2_CH3CO3 (266) XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (409) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 + XO2_CH3O2 (267) XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO rate = 5.00E-13*exp( 400./t) (410) + + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD + XO2_HO2 (268) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (411) + XO2_NO (269) XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL rate = 2.70E-12*exp( 360./t) (412) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + XO2_NO3 (270) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (413) + + 0.25*CH3COCHO + 0.25*GLYALD + XOOH_OH (271) XOOH + OH -> 0.5*XO2 + 0.5*OH rate = 1.52E-12*exp( 200./t) (414) + ACBZO2_HO2 (272) ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH rate = 4.30E-13*exp( 1040./t) (415) + ACBZO2_NO (273) ACBZO2 + NO -> C6H5O2 + NO2 rate = 7.50E-12*exp( 290./t) (416) + BENZENE_OH (274) BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 rate = 2.30E-12*exp( -193./t) (417) + BENZO2_HO2 (275) BENZO2 + HO2 -> BENZOOH rate = 7.50E-13*exp( 700./t) (418) + BENZO2_NO (276) BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 rate = 2.60E-12*exp( 365./t) (419) + BENZOOH_OH (277) BENZOOH + OH -> BENZO2 rate = 3.80E-12*exp( 200./t) (420) + BZALD_OH (278) BZALD + OH -> ACBZO2 rate = 5.90E-12*exp( 225./t) (421) + BZOO_HO2 (279) BZOO + HO2 -> BZOOH rate = 7.50E-13*exp( 700./t) (422) + BZOOH_OH (280) BZOOH + OH -> BZOO rate = 3.80E-12*exp( 200./t) (423) + BZOO_NO (281) BZOO + NO -> BZALD + NO2 + HO2 rate = 2.60E-12*exp( 365./t) (424) + C6H5O2_HO2 (282) C6H5O2 + HO2 -> C6H5OOH rate = 7.50E-13*exp( 700./t) (425) + C6H5O2_NO (283) C6H5O2 + NO -> PHENO + NO2 rate = 2.60E-12*exp( 365./t) (426) + C6H5OOH_OH (284) C6H5OOH + OH -> C6H5O2 rate = 3.80E-12*exp( 200./t) (427) + CRESOL_OH (285) CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO rate = 4.70E-11 (428) + DICARBO2_HO2 (286) DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO rate = 4.30E-13*exp( 1040./t) (429) + + 0.33*CH3O2 + DICARBO2_NO (287) DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO rate = 7.50E-12*exp( 290./t) (430) + + 0.83*CH3O2 + DICARBO2_NO2 (288) DICARBO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (431) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MALO2_HO2 (289) MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO rate = 4.30E-13*exp( 1040./t) (432) + MALO2_NO (290) MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 rate = 7.50E-12*exp( 290./t) (433) + MALO2_NO2 (291) MALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (434) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MDIALO2_HO2 (292) MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO rate = 4.30E-13*exp( 1040./t) (435) + + 0.07*CH3O2 + 0.07*GLYOXAL + MDIALO2_NO (293) MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO rate = 7.50E-12*exp( 290./t) (436) + + 0.17*CH3O2 + 0.17*GLYOXAL + MDIALO2_NO2 (294) MDIALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (437) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + PHENO2_HO2 (295) PHENO2 + HO2 -> PHENOOH rate = 7.50E-13*exp( 700./t) (438) + PHENO2_NO (296) PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 rate = 2.60E-12*exp( 365./t) (439) + PHENOL_OH (297) PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO rate = 4.70E-13*exp( 1220./t) (440) + PHENO_NO2 (298) PHENO + NO2 -> NDEP rate = 2.10E-12 (441) + PHENO_O3 (299) PHENO + O3 -> C6H5O2 rate = 2.80E-13 (442) + PHENOOH_OH (300) PHENOOH + OH -> PHENO2 rate = 3.80E-12*exp( 200./t) (443) + tag_ACBZO2_NO2 (301) ACBZO2 + NO2 + M -> PBZNIT + M troe : ko=9.70E-29*(300/t)**5.60 (444) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + TOLO2_HO2 (302) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (445) + TOLO2_NO (303) TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = 2.60E-12*exp( 365./t) (446) + + 0.2*BIGALD2 + 0.2*BIGALD3 + TOLOOH_OH (304) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (447) + TOLUENE_OH (305) TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 rate = 1.70E-12*exp( 352./t) (448) + + 0.28*HO2 + usr_PBZNIT_M (306) PBZNIT + M -> ACBZO2 + NO2 + M rate = ** User defined ** (449) + XYLENES_OH (307) XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO rate = 1.70E-11 (450) + + 0.56*XYLENO2 + 0.38*HO2 + XYLENO2_HO2 (308) XYLENO2 + HO2 -> XYLENOOH rate = 7.50E-13*exp( 700./t) (451) + XYLENO2_NO (309) XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = 2.60E-12*exp( 365./t) (452) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + XYLENOOH_OH (310) XYLENOOH + OH -> XYLENO2 rate = 3.80E-12*exp( 200./t) (453) + XYLOLO2_HO2 (311) XYLOLO2 + HO2 -> XYLOLOOH rate = 7.50E-13*exp( 700./t) (454) + XYLOLO2_NO (312) XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO rate = 2.60E-12*exp( 365./t) (455) + XYLOL_OH (313) XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO rate = 8.40E-11 (456) + XYLOLOOH_OH (314) XYLOLOOH + OH -> XYLOLO2 rate = 3.80E-12*exp( 200./t) (457) + BCARY_NO3 (315) BCARY + NO3 -> NTERPO2 rate = 1.90E-11 (458) + BCARY_O3 (316) BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 1.20E-14 (459) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + BCARY_OH (317) BCARY + OH -> TERPO2 rate = 2.00E-10 (460) + MTERP_NO3 (318) MTERP + NO3 -> NTERPO2 rate = 1.20E-12*exp( 490./t) (461) + MTERP_O3 (319) MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 6.30E-16*exp( -580./t) (462) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + MTERP_OH (320) MTERP + OH -> TERPO2 rate = 1.20E-11*exp( 440./t) (463) + NTERPO2_CH3O2 (321) NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 rate = 2.00E-12*exp( 500./t) (464) + + 0.5*TERPROD1 + 0.5*NO2 + NTERPO2_HO2 (322) NTERPO2 + HO2 -> NTERPOOH rate = 7.50E-13*exp( 700./t) (465) + NTERPO2_NO (323) NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP rate = 4.20E-12*exp( 180./t) (466) + NTERPO2_NO3 (324) NTERPO2 + NO3 -> 2*NO2 + TERPROD1 rate = 2.40E-12 (467) + NTERPOOH_OH (325) NTERPOOH + OH -> NTERPO2 rate = 2.00E-11 (468) + TERP2O2_CH3O2 (326) TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (469) + + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + + 0.15*CH3COCH3 + TERP2O2_HO2 (327) TERP2O2 + HO2 -> TERP2OOH rate = 7.50E-13*exp( 700./t) (470) + TERP2O2_NO (328) TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 rate = 4.20E-12*exp( 180./t) (471) + + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + + 0.225*GLYALD + TERP2OOH_OH (329) TERP2OOH + OH -> TERP2O2 rate = 2.30E-11 (472) + TERPNIT_OH (330) TERPNIT + OH -> NO2 + TERPROD1 rate = 2.00E-11 (473) + TERPO2_CH3O2 (331) TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (474) + + 0.025*CH3COCH3 + TERPO2_HO2 (332) TERPO2 + HO2 -> TERPOOH rate = 7.50E-13*exp( 700./t) (475) + TERPO2_NO (333) TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 rate = 4.20E-12*exp( 180./t) (476) + + 0.8*TERPROD1 + 0.8*HO2 + TERPOOH_OH (334) TERPOOH + OH -> TERPO2 rate = 3.30E-11 (477) + TERPROD1_NO3 (335) TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP rate = 1.00E-12 (478) + TERPROD1_OH (336) TERPROD1 + OH -> TERP2O2 rate = 5.70E-11 (479) + TERPROD2_OH (337) TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 rate = 3.40E-11 (480) + + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO + DMS_NO3 (338) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (481) + DMS_OHa (339) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (482) + OCS_O (340) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (483) + OCS_OH (341) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (484) + S_O2 (342) S + O2 -> SO + O rate = 2.30E-12 (485) + SO2_OH_M (343) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (486) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + S_O3 (344) S + O3 -> SO + O2 rate = 1.20E-11 (487) + SO_BRO (345) SO + BRO -> SO2 + BR rate = 5.70E-11 (488) + SO_CLO (346) SO + CLO -> SO2 + CL rate = 2.80E-11 (489) + S_OH (347) S + OH -> SO + H rate = 6.60E-11 (490) + SO_NO2 (348) SO + NO2 -> SO2 + NO rate = 1.40E-11 (491) + SO_O2 (349) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (492) + SO_O3 (350) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (493) + SO_OCLO (351) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (494) + SO_OH (352) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (495) + usr_DMS_OH (353) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (496) + usr_SO3_H2O (354) SO3 + H2O -> H2SO4 rate = ** User defined ** (497) + NH3_OH (355) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (498) + usr_HO2_aer (356) HO2 -> 0.5*H2O2 rate = ** User defined ** (499) + usr_HONITR_aer (357) HONITR -> HNO3 rate = ** User defined ** (500) + usr_ISOPNITA_aer (358) ISOPNITA -> HNO3 rate = ** User defined ** (501) + usr_ISOPNITB_aer (359) ISOPNITB -> HNO3 rate = ** User defined ** (502) + usr_N2O5_aer (360) N2O5 -> 2*HNO3 rate = ** User defined ** (503) + usr_NC4CH2OH_aer (361) NC4CH2OH -> HNO3 rate = ** User defined ** (504) + usr_NC4CHO_aer (362) NC4CHO -> HNO3 rate = ** User defined ** (505) + usr_NH4_strat_ta (363) NH4 -> NHDEP rate = 6.34E-08 (506) + usr_NO2_aer (364) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (507) + usr_NO3_aer (365) NO3 -> HNO3 rate = ** User defined ** (508) + usr_NTERPOOH_aer (366) NTERPOOH -> HNO3 rate = ** User defined ** (509) + usr_ONITR_aer (367) ONITR -> HNO3 rate = ** User defined ** (510) + usr_TERPNIT_aer (368) TERPNIT -> HNO3 rate = ** User defined ** (511) + BCARY_NO3_vbs (369) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 rate = 1.90E-11 (512) + BCARYO2_HO2_vbs (370) BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 rate = 2.75E-13*exp( 1300./t) (513) + + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + + 0.114*SOAGbg4 + BCARYO2_NO_vbs (371) BCARYO2VBS + NO -> NO + 0.1279*SOAGbg0 + 0.1792*SOAGbg1 rate = 2.70E-12*exp( 360./t) (514) + + 0.0676*SOAGbg2 + 0.079*SOAGbg3 + + 0.1254*SOAGbg4 + BCARY_O3_vbs (372) BCARY + O3 -> BCARY + O3 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 rate = 1.20E-14 (515) + + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 + BCARY_OH_vbs (373) BCARY + OH -> BCARY + OH + BCARYO2VBS rate = 2.00E-10 (516) + BENZENE_OH_vbs (374) BENZENE + OH -> BENZENE + OH + BENZO2VBS rate = 2.30E-12*exp( -193./t) (517) + BENZO2_HO2_vbs (375) BENZO2VBS + HO2 -> HO2 + 0.0023*SOAGff0 + 0.0008*SOAGff1 rate = 7.50E-13*exp( 700./t) (518) + + 0.0843*SOAGff2 + 0.0443*SOAGff3 + + 0.1621*SOAGff4 + BENZO2_NO_vbs (376) BENZO2VBS + NO -> NO + 0.0097*SOAGff0 + 0.0034*SOAGff1 rate = 2.60E-12*exp( 365./t) (519) + + 0.1579*SOAGff2 + 0.0059*SOAGff3 + + 0.0536*SOAGff4 + ISOP_NO3_vbs (377) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAGbg3 + 0.025024*SOAGbg4 rate = 3.03E-12*exp( -446./t) (520) + ISOPO2_HO2_vbs (378) ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAGbg0 + 0.0035*SOAGbg1 rate = 2.12E-13*exp( 1300./t) (521) + + 0.0003*SOAGbg2 + 0.0271*SOAGbg3 + + 0.0474*SOAGbg4 + ISOPO2_NO_vbs (379) ISOPO2VBS + NO -> NO + 0.0003*SOAGbg0 + 0.0003*SOAGbg1 rate = 2.70E-12*exp( 350./t) (522) + + 0.0073*SOAGbg2 + 0.0057*SOAGbg3 + + 0.0623*SOAGbg4 + ISOP_O3_vbs (380) ISOP + O3 -> ISOP + O3 + 0.0033*SOAGbg3 rate = 1.05E-14*exp( -2000./t) (523) + ISOP_OH_vbs (381) ISOP + OH -> ISOP + OH + ISOPO2VBS rate = 2.54E-11*exp( 410./t) (524) + IVOCbbO2_HO2_vbs (382) IVOCbbO2VBS + HO2 -> HO2 + 0.2381*SOAGbb0 + 0.1308*SOAGbb1 rate = 7.50E-13*exp( 700./t) (525) + + 0.0348*SOAGbb2 + 0.0076*SOAGbb3 + + 0.0113*SOAGbb4 + IVOCbbO2_NO_vbs (383) IVOCbbO2VBS + NO -> NO + 0.1056*SOAGbb0 + 0.1026*SOAGbb1 rate = 2.60E-12*exp( 365./t) (526) + + 0.0521*SOAGbb2 + 0.0143*SOAGbb3 + + 0.0166*SOAGbb4 + IVOCbb_OH_vbs (384) IVOCbb + OH -> OH + IVOCbbO2VBS rate = 1.34E-11 (527) + IVOCffO2_HO2_vbs (385) IVOCffO2VBS + HO2 -> HO2 + 0.2381*SOAGff0 + 0.1308*SOAGff1 rate = 7.50E-13*exp( 700./t) (528) + + 0.0348*SOAGff2 + 0.0076*SOAGff3 + + 0.0113*SOAGff4 + IVOCffO2_NO_vbs (386) IVOCffO2VBS + NO -> NO + 0.1056*SOAGff0 + 0.1026*SOAGff1 rate = 2.60E-12*exp( 365./t) (529) + + 0.0521*SOAGff2 + 0.0143*SOAGff3 + + 0.0166*SOAGff4 + IVOCff_OH_vbs (387) IVOCff + OH -> OH + IVOCffO2VBS rate = 1.34E-11 (530) + MTERP_NO3_vbs (388) MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 rate = 1.20E-12*exp( 490./t) (531) + MTERPO2_HO2_vbs (389) MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 rate = 2.60E-13*exp( 1300./t) (532) + + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + + 0.1278*SOAGbg4 + MTERPO2_NO_vbs (390) MTERPO2VBS + NO -> NO + 0.0245*SOAGbg0 + 0.0082*SOAGbg1 rate = 2.70E-12*exp( 360./t) (533) + + 0.0772*SOAGbg2 + 0.0332*SOAGbg3 + 0.13*SOAGbg4 + MTERP_O3_vbs (391) MTERP + O3 -> MTERP + O3 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 rate = 6.30E-16*exp( -580./t) (534) + + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 + MTERP_OH_vbs (392) MTERP + OH -> MTERP + OH + MTERPO2VBS rate = 1.20E-11*exp( 440./t) (535) + SVOCbb_OH (393) SVOCbb + OH -> OH + 0.5931*SOAGbb0 + 0.1534*SOAGbb1 rate = 1.34E-11 (536) + + 0.0459*SOAGbb2 + 0.0085*SOAGbb3 + 0.0128*SOAGbb4 + SVOCff_OH (394) SVOCff + OH -> OH + 0.5931*SOAGff0 + 0.1534*SOAGff1 rate = 1.34E-11 (537) + + 0.0459*SOAGff2 + 0.0085*SOAGff3 + 0.0128*SOAGff4 + TOLUENE_OH_vbs (395) TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS rate = 1.70E-12*exp( 352./t) (538) + TOLUO2_HO2_vbs (396) TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAGff0 + 0.0101*SOAGff1 rate = 7.50E-13*exp( 700./t) (539) + + 0.0763*SOAGff2 + 0.2157*SOAGff3 + + 0.0738*SOAGff4 + TOLUO2_NO_vbs (397) TOLUO2VBS + NO -> NO + 0.0154*SOAGff0 + 0.0452*SOAGff1 rate = 2.60E-12*exp( 365./t) (540) + + 0.0966*SOAGff2 + 0.0073*SOAGff3 + 0.238*SOAGff4 + usr_GLYOXAL_aer (398) GLYOXAL -> SOAGbg0 rate = ** User defined ** (541) + XYLENES_OH_vbs (399) XYLENES + OH -> XYLENES + OH + XYLEO2VBS rate = 1.70E-11 (542) + XYLEO2_HO2_vbs (400) XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAGff0 + 0.0174*SOAGff1 rate = 7.50E-13*exp( 700./t) (543) + + 0.086*SOAGff2 + 0.0512*SOAGff3 + + 0.1598*SOAGff4 + XYLEO2_NO_vbs (401) XYLEO2VBS + NO -> NO + 0.0063*SOAGff0 + 0.0237*SOAGff1 rate = 2.60E-12*exp( 365./t) (544) + + 0.0025*SOAGff2 + 0.011*SOAGff3 + 0.1185*SOAGff4 + het1 (402) N2O5 -> 2*HNO3 rate = ** User defined ** (545) + het10 (403) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (546) + het11 (404) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (547) + het12 (405) N2O5 -> 2*HNO3 rate = ** User defined ** (548) + het13 (406) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (549) + het14 (407) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (550) + het15 (408) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (551) + het16 (409) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (552) + het17 (410) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (553) + het2 (411) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (554) + het3 (412) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (555) + het4 (413) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (556) + het5 (414) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (557) + het6 (415) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (558) + het7 (416) N2O5 -> 2*HNO3 rate = ** User defined ** (559) + het8 (417) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (560) + het9 (418) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (561) + E90_tau (419) E90 -> {sink} rate = 1.29E-07 (562) + +Extraneous prod/loss species + ( 1) bc_a1 (dataset) + ( 2) bc_a4 (dataset) + ( 3) CO (dataset) + ( 4) NO (dataset) + ( 5) NO2 (dataset) + ( 6) num_a1 (dataset) + ( 7) num_a2 (dataset) + ( 8) num_a4 (dataset) + ( 9) num_a5 (dataset) + (10) SO2 (dataset) + (11) so4_a1 (dataset) + (12) so4_a2 (dataset) + (13) so4_a5 (dataset) + (14) SVOCbb (dataset) + (15) SVOCff (dataset) + (16) pomff1_a4 (dataset) + (17) pombb1_a4 (dataset) + (18) AOA_NH + (19) N + (20) OH + + + Equation Report + + d(ALKNIT)/dt = r235*ALKO2*NO + - j19*ALKNIT - r232*OH*ALKNIT + d(ALKOOH)/dt = r233*ALKO2*HO2 + - j20*ALKOOH - r236*OH*ALKOOH + d(AOA_NH)/dt = 0 + d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(BCARY)/dt = - r315*NO3*BCARY - r316*O3*BCARY - r317*OH*BCARY + d(BCARYO2VBS)/dt = r373*BCARY*OH + - r370*HO2*BCARYO2VBS - r371*NO*BCARYO2VBS + d(BENZENE)/dt = - r274*OH*BENZENE + d(BENZO2VBS)/dt = r374*BENZENE*OH + - r375*HO2*BENZO2VBS - r376*NO*BENZO2VBS + d(BENZOOH)/dt = r275*BENZO2*HO2 + - j21*BENZOOH - r277*OH*BENZOOH + d(BEPOMUC)/dt = .12*r274*BENZENE*OH + - j22*BEPOMUC + d(BIGALD)/dt = .1*r316*BCARY*O3 + .1*r319*MTERP*O3 + - j23*BIGALD + d(BIGALD1)/dt = .5*j21*BENZOOH + j22*BEPOMUC + .2*j70*TOLOOH + .06*j72*XYLENOOH + .5*r276*BENZO2*NO + + .2*r303*TOLO2*NO + .06*r309*XYLENO2*NO + - j24*BIGALD1 + d(BIGALD2)/dt = .2*j70*TOLOOH + .2*j72*XYLENOOH + .2*r303*TOLO2*NO + .2*r309*XYLENO2*NO + - j25*BIGALD2 + d(BIGALD3)/dt = j46*HPALD + j56*NC4CHO + .2*j70*TOLOOH + .15*j72*XYLENOOH + .2*r303*TOLO2*NO + + .15*r309*XYLENO2*NO + - j26*BIGALD3 + d(BIGALD4)/dt = .21*j72*XYLENOOH + .21*r309*XYLENO2*NO + - j27*BIGALD4 + d(BIGALK)/dt = .05*r316*BCARY*O3 + .05*r319*MTERP*O3 + - r237*OH*BIGALK + d(BIGENE)/dt = - r203*NO3*BIGENE - r204*OH*BIGENE + d(BR)/dt = j74*BRCL + j75*BRO + j77*BRONO2 + j79*CF2CLBR + j80*CF3BR + 2*j86*CH2BR2 + j87*CH3BR + + 3*j90*CHBR3 + 2*j98*H2402 + j99*HBR + j105*HOBR + r77*O1D*CF2CLBR + 2*r90*BRO*BRO + + r91*BRO*CLO + r92*BRO*CLO + r95*BRO*NO + r98*BRO*O + r99*BRO*OH + r100*HBR*O + r101*HBR*OH + + r103*O1D*CF3BR + 3*r104*O1D*CHBR3 + 2*r105*O1D*H2402 + r106*O1D*HBR + 2*r114*CH2BR2*CL + + 2*r115*CH2BR2*OH + r116*CH3BR*CL + r117*CH3BR*OH + 3*r121*CHBR3*CL + 3*r122*CHBR3*OH + + 2*r126*O1D*CH2BR2 + r127*O1D*CH3BR + r345*SO*BRO + - r87*CH2O*BR - r88*HO2*BR - r89*O3*BR + d(BRCL)/dt = r93*BRO*CLO + r410*HOBR*HCL + r415*HOBR*HCL + - j74*BRCL + d(BRO)/dt = j76*BRONO2 + r89*BR*O3 + r97*BRONO2*O + r102*HOBR*O + r107*O1D*HBR + - j75*BRO - 2*r90*BRO*BRO - r91*CLO*BRO - r92*CLO*BRO - r93*CLO*BRO - r94*HO2*BRO - r95*NO*BRO + - r96*M*NO2*BRO - r98*O*BRO - r99*OH*BRO - r345*SO*BRO + d(BRONO2)/dt = r96*M*BRO*NO2 + - j76*BRONO2 - j77*BRONO2 - r404*BRONO2 - r407*BRONO2 - r412*BRONO2 - r97*O*BRONO2 + d(BRY)/dt = 0 + d(BZALD)/dt = j28*BZOOH + r281*BZOO*NO + - r278*OH*BZALD + d(BZOOH)/dt = r279*BZOO*HO2 + - j28*BZOOH - r280*OH*BZOOH + d(C2H2)/dt = - r152*M*CL*C2H2 - r153*M*OH*C2H2 + d(C2H4)/dt = - r154*M*CL*C2H4 - r155*O3*C2H4 - r180*M*OH*C2H4 + d(C2H5OH)/dt = .4*r156*C2H5O2*C2H5O2 + .2*r157*C2H5O2*CH3O2 + - r160*OH*C2H5OH + d(C2H5OOH)/dt = r158*C2H5O2*HO2 + - j29*C2H5OOH - r161*OH*C2H5OOH + d(C2H6)/dt = - r162*CL*C2H6 - r163*OH*C2H6 + d(C3H6)/dt = .7*j55*MVK + .13*r261*ISOP*O3 + - r183*NO3*C3H6 - r184*O3*C3H6 - r201*M*OH*C3H6 + d(C3H7OOH)/dt = r186*C3H7O2*HO2 + - j30*C3H7OOH - r188*OH*C3H7OOH + d(C3H8)/dt = - r189*OH*C3H8 + d(C6H5OOH)/dt = r282*C6H5O2*HO2 + - j31*C6H5OOH - r284*OH*C6H5OOH + d(CCL4)/dt = - j78*CCL4 - r76*O1D*CCL4 + d(CF2CLBR)/dt = - j79*CF2CLBR - r77*O1D*CF2CLBR + d(CF3BR)/dt = - j80*CF3BR - r103*O1D*CF3BR + d(CFC11)/dt = - j81*CFC11 - r78*O1D*CFC11 + d(CFC113)/dt = - j82*CFC113 - r79*O1D*CFC113 + d(CFC114)/dt = - j83*CFC114 - r80*O1D*CFC114 + d(CFC115)/dt = - j84*CFC115 - r81*O1D*CFC115 + d(CFC12)/dt = - j85*CFC12 - r82*O1D*CFC12 + d(CH2BR2)/dt = - j86*CH2BR2 - r114*CL*CH2BR2 - r115*OH*CH2BR2 - r126*O1D*CH2BR2 + d(CH2O)/dt = .1*j19*ALKNIT + .1*j20*ALKOOH + j38*CH3OOH + .18*j39*CH4 + j43*GLYALD + .33*j45*HONITR + + j47*HYAC + j49*ISOPOOH + 1.34*j51*MACR + j57*NOA + j62*POOH + j63*ROOH + .375*j65*TERP2OOH + + .4*j67*TERPOOH + .68*j69*TERPROD2 + r145*HOCH2OO + 2*r175*EO + r58*CLO*CH3O2 + + 2*r135*CH3O2*CH3O2 + r136*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + .3*r140*CH3OOH*OH + + r148*O1D*CH4 + r149*O1D*CH4 + r155*C2H4*O3 + .7*r157*C2H5O2*CH3O2 + r168*CH3CO3*CH3O2 + + .5*r172*CH3COOOH*OH + .5*r174*EO2*NO + .8*r177*GLYALD*OH + r179*PAN*OH + .5*r184*C3H6*O3 + + r185*C3H7O2*CH3O2 + r195*PO2*NO + .8*r197*RO2*CH3O2 + .15*r198*RO2*HO2 + r199*RO2*NO + + .5*r203*BIGENE*NO3 + .5*r205*ENEO2*NO + .25*r208*MACRO2*CH3CO3 + .88*r209*MACRO2*CH3O2 + + .25*r211*MACRO2*NO3 + .25*r212*MACRO2*NO + .12*r214*MACR*O3 + r217*MCO3*CH3CO3 + + 2*r218*MCO3*CH3O2 + .45*r219*MCO3*HO2 + 2*r220*MCO3*MCO3 + r221*MCO3*NO + r222*MCO3*NO3 + + .5*r227*M*MPAN*OH + .6*r228*MVK*O3 + .4*r232*ALKNIT*OH + .1*r234*ALKO2*NO + + r241*ISOPAO2*CH3CO3 + 1.5*r242*ISOPAO2*CH3O2 + .92*r244*ISOPAO2*NO + r245*ISOPAO2*NO3 + + .75*r247*ISOPBO2*CH3O2 + .3*r252*ISOPNITA*OH + .8*r256*ISOPNO3*CH3O2 + .91*r261*ISOP*O3 + + .25*r266*XO2*CH3CO3 + .8*r267*XO2*CH3O2 + .25*r269*XO2*NO + .34*r316*BCARY*O3 + + .34*r319*MTERP*O3 + .75*r321*NTERPO2*CH3O2 + .93*r326*TERP2O2*CH3O2 + .34*r328*TERP2O2*NO + + .95*r331*TERPO2*CH3O2 + .32*r333*TERPO2*NO + .68*r337*TERPROD2*OH + - j32*CH2O - j33*CH2O - r51*CL*CH2O - r87*BR*CH2O - r131*HO2*CH2O - r132*NO3*CH2O + - r133*O*CH2O - r134*OH*CH2O + d(CH3BR)/dt = - j87*CH3BR - r116*CL*CH3BR - r117*OH*CH3BR - r127*O1D*CH3BR + d(CH3CCL3)/dt = - j88*CH3CCL3 - r118*OH*CH3CCL3 + d(CH3CHO)/dt = .4*j19*ALKNIT + .4*j20*ALKOOH + j29*C2H5OOH + .33*j45*HONITR + j53*MEKOOH + j62*POOH + + 1.6*r156*C2H5O2*C2H5O2 + .8*r157*C2H5O2*CH3O2 + r159*C2H5O2*NO + r160*C2H5OH*OH + + .5*r161*C2H5OOH*OH + .5*r184*C3H6*O3 + .27*r187*C3H7O2*NO + r195*PO2*NO + r203*BIGENE*NO3 + + r205*ENEO2*NO + .2*r223*MEKO2*HO2 + r224*MEKO2*NO + .1*r228*MVK*O3 + .8*r232*ALKNIT*OH + + .4*r234*ALKO2*NO + - j34*CH3CHO - r164*NO3*CH3CHO - r165*OH*CH3CHO + d(CH3CL)/dt = - j89*CH3CL - r119*CL*CH3CL - r120*OH*CH3CL + d(CH3CN)/dt = - r166*OH*CH3CN + d(CH3COCH3)/dt = .25*j19*ALKNIT + .25*j20*ALKOOH + .82*j30*C3H7OOH + .17*j45*HONITR + .3*j65*TERP2OOH + + .05*j67*TERPOOH + .5*j69*TERPROD2 + .82*r185*C3H7O2*CH3O2 + .82*r187*C3H7O2*NO + + .5*r203*BIGENE*NO3 + .5*r205*ENEO2*NO + .8*r232*ALKNIT*OH + .25*r234*ALKO2*NO + + .52*r316*BCARY*O3 + .52*r319*MTERP*O3 + .15*r326*TERP2O2*CH3O2 + .27*r328*TERP2O2*NO + + .025*r331*TERPO2*CH3O2 + .04*r333*TERPO2*NO + .5*r337*TERPROD2*OH + - j35*CH3COCH3 - r202*OH*CH3COCH3 + d(CH3COCHO)/dt = .18*j23*BIGALD + j27*BIGALD4 + .4*j70*TOLOOH + .54*j72*XYLENOOH + .51*j73*XYLOLOOH + + r192*HYAC*OH + r193*NOA*OH + .5*r197*RO2*CH3O2 + .25*r208*MACRO2*CH3CO3 + + .24*r209*MACRO2*CH3O2 + .25*r211*MACRO2*NO3 + .25*r212*MACRO2*NO + .88*r214*MACR*O3 + + .5*r228*MVK*O3 + .05*r250*ISOPBO2*NO + .05*r251*ISOPBO2*NO3 + .25*r266*XO2*CH3CO3 + + .1*r267*XO2*CH3O2 + .25*r269*XO2*NO + .25*r270*XO2*NO3 + .07*r286*DICARBO2*HO2 + + .17*r287*DICARBO2*NO + .07*r292*MDIALO2*HO2 + .17*r293*MDIALO2*NO + .4*r303*TOLO2*NO + + .54*r309*XYLENO2*NO + .51*r312*XYLOLO2*NO + - j36*CH3COCHO - r190*NO3*CH3COCHO - r191*OH*CH3COCHO + d(CH3COOH)/dt = .1*r168*CH3CO3*CH3O2 + .15*r169*CH3CO3*HO2 + .12*r184*C3H6*O3 + .15*r219*MCO3*HO2 + - r171*OH*CH3COOH + d(CH3COOOH)/dt = .4*r169*CH3CO3*HO2 + .4*r219*MCO3*HO2 + - j37*CH3COOOH - r172*OH*CH3COOOH + d(CH3OH)/dt = r136*CH3O2*CH3O2 + .3*r157*C2H5O2*CH3O2 + .5*r197*RO2*CH3O2 + .25*r209*MACRO2*CH3O2 + + .25*r242*ISOPAO2*CH3O2 + .25*r247*ISOPBO2*CH3O2 + .2*r256*ISOPNO3*CH3O2 + .3*r267*XO2*CH3O2 + + .25*r321*NTERPO2*CH3O2 + .25*r326*TERP2O2*CH3O2 + .25*r331*TERPO2*CH3O2 + - r139*OH*CH3OH + d(CH3OOH)/dt = r137*CH3O2*HO2 + - j38*CH3OOH - r140*OH*CH3OOH + d(CH4)/dt = .1*r184*C3H6*O3 + - j39*CH4 - j40*CH4 - r52*CL*CH4 - r108*F*CH4 - r141*OH*CH4 - r147*O1D*CH4 - r148*O1D*CH4 + - r149*O1D*CH4 + d(CHBR3)/dt = - j90*CHBR3 - r104*O1D*CHBR3 - r121*CL*CHBR3 - r122*OH*CHBR3 + d(CL)/dt = j74*BRCL + 4*j78*CCL4 + j79*CF2CLBR + 2*j81*CFC11 + 2*j82*CFC113 + 2*j83*CFC114 + j84*CFC115 + + 2*j85*CFC12 + 3*j88*CH3CCL3 + j89*CH3CL + 2*j91*CL2 + 2*j92*CL2O2 + j93*CLO + j95*CLONO2 + + j97*COFCL + j100*HCFC141B + j101*HCFC142B + j102*HCFC22 + j103*HCL + j106*HOCL + r58*CLO*CH3O2 + + 2*r59*CLO*CLO + r61*CLO*CLO + r63*CLO*NO + r68*CLO*O + r69*CLO*OH + r71*HCL*O + r72*HCL*OH + + 4*r76*O1D*CCL4 + r77*O1D*CF2CLBR + 2*r78*O1D*CFC11 + 2*r79*O1D*CFC113 + 2*r80*O1D*CFC114 + + r81*O1D*CFC115 + 2*r82*O1D*CFC12 + r83*O1D*HCL + r92*BRO*CLO + r113*O1D*COFCL + + 3*r118*CH3CCL3*OH + r120*CH3CL*OH + r123*HCFC141B*OH + r124*HCFC142B*OH + r125*HCFC22*OH + + r128*O1D*HCFC141B + r129*O1D*HCFC142B + r130*O1D*HCFC22 + r346*SO*CLO + - r51*CH2O*CL - r52*CH4*CL - r53*H2*CL - r54*H2O2*CL - r55*HO2*CL - r56*HO2*CL - r57*O3*CL + - r64*CLONO2*CL - r73*HOCL*CL - r114*CH2BR2*CL - r116*CH3BR*CL - r119*CH3CL*CL - r121*CHBR3*CL + - r162*C2H6*CL + d(CL2)/dt = r60*CLO*CLO + r64*CLONO2*CL + r403*HOCL*HCL + r408*CLONO2*HCL + r409*HOCL*HCL + r413*CLONO2*HCL + + r414*HOCL*HCL + r418*CLONO2*HCL + - j91*CL2 + d(CL2O2)/dt = r85*M*CLO*CLO + - j92*CL2O2 - r86*M*CL2O2 + d(CLO)/dt = j94*CLONO2 + j107*OCLO + r86*M*CL2O2 + r86*M*CL2O2 + r56*CL*HO2 + r57*CL*O3 + r66*CLONO2*O + + r73*HOCL*CL + r74*HOCL*O + r75*HOCL*OH + r84*O1D*HCL + r351*SO*OCLO + - j93*CLO - r58*CH3O2*CLO - 2*r59*CLO*CLO - 2*r60*CLO*CLO - 2*r61*CLO*CLO - r62*HO2*CLO + - r63*NO*CLO - r65*M*NO2*CLO - r68*O*CLO - r69*OH*CLO - r70*OH*CLO - 2*r85*M*CLO*CLO + - r91*BRO*CLO - r92*BRO*CLO - r93*BRO*CLO - r346*SO*CLO + d(CLONO2)/dt = r65*M*CLO*NO2 + - j94*CLONO2 - j95*CLONO2 - r406*CLONO2 - r411*CLONO2 - r417*CLONO2 - r64*CL*CLONO2 + - r66*O*CLONO2 - r67*OH*CLONO2 - r408*HCL*CLONO2 - r413*HCL*CLONO2 - r418*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = 1.5*j22*BEPOMUC + .45*j23*BIGALD + .6*j26*BIGALD3 + j27*BIGALD4 + j32*CH2O + j33*CH2O + + j34*CH3CHO + j36*CH3COCHO + .38*j39*CH4 + j41*CO2 + j43*GLYALD + 2*j44*GLYOXAL + + .33*j45*HONITR + 1.34*j50*MACR + .7*j55*MVK + 1.5*j64*TEPOMUC + .25*j65*TERP2OOH + j68*TERPROD1 + + 1.7*j69*TERPROD2 + j110*OCS + r51*CL*CH2O + r87*BR*CH2O + r119*CH3CL*CL + r132*CH2O*NO3 + + r133*CH2O*O + r134*CH2O*OH + .35*r153*M*C2H2*OH + .63*r155*C2H4*O3 + r178*GLYOXAL*OH + + .56*r184*C3H6*O3 + r190*CH3COCHO*NO3 + r191*CH3COCHO*OH + .22*r208*MACRO2*CH3CO3 + + .11*r209*MACRO2*CH3O2 + .22*r211*MACRO2*NO3 + .22*r212*MACRO2*NO + .65*r214*MACR*O3 + + .56*r228*MVK*O3 + .62*r261*ISOP*O3 + .25*r266*XO2*CH3CO3 + .2*r267*XO2*CH3O2 + .25*r269*XO2*NO + + .5*r270*XO2*NO3 + .07*r286*DICARBO2*HO2 + .17*r287*DICARBO2*NO + .16*r289*MALO2*HO2 + + .4*r290*MALO2*NO + .14*r292*MDIALO2*HO2 + .35*r293*MDIALO2*NO + .23*r316*BCARY*O3 + + .23*r319*MTERP*O3 + .125*r326*TERP2O2*CH3O2 + .225*r328*TERP2O2*NO + .7*r337*TERPROD2*OH + + r340*OCS*O + r341*OCS*OH + - r151*OH*CO + d(CO2)/dt = j37*CH3COOOH + .44*j39*CH4 + .4*j60*PAN + j65*TERP2OOH + .8*j69*TERPROD2 + r143*HCOOH*OH + + r151*CO*OH + 2*r167*CH3CO3*CH3CO3 + .9*r168*CH3CO3*CH3O2 + r170*CH3CO3*NO + r171*CH3COOH*OH + + .5*r172*CH3COOOH*OH + .8*r177*GLYALD*OH + r178*GLYOXAL*OH + .2*r184*C3H6*O3 + + 2*r217*MCO3*CH3CO3 + r218*MCO3*CH3O2 + .45*r219*MCO3*HO2 + 2*r220*MCO3*MCO3 + .5*r227*M*MPAN*OH + + .1*r228*MVK*O3 + r241*ISOPAO2*CH3CO3 + r266*XO2*CH3CO3 + .27*r316*BCARY*O3 + .27*r319*MTERP*O3 + + .5*r326*TERP2O2*CH3O2 + .9*r328*TERP2O2*NO + 1.8*r337*TERPROD2*OH + - j41*CO2 + d(COF2)/dt = j79*CF2CLBR + j80*CF3BR + j82*CFC113 + 2*j83*CFC114 + 2*j84*CFC115 + j85*CFC12 + 2*j98*H2402 + + j101*HCFC142B + j102*HCFC22 + r77*O1D*CF2CLBR + r79*O1D*CFC113 + 2*r80*O1D*CFC114 + + 2*r81*O1D*CFC115 + r82*O1D*CFC12 + r103*O1D*CF3BR + 2*r105*O1D*H2402 + r124*HCFC142B*OH + + r125*HCFC22*OH + r129*O1D*HCFC142B + r130*O1D*HCFC22 + - j96*COF2 - r112*O1D*COF2 + d(COFCL)/dt = j81*CFC11 + j82*CFC113 + j100*HCFC141B + r78*O1D*CFC11 + r79*O1D*CFC113 + r123*HCFC141B*OH + + r128*O1D*HCFC141B + - j97*COFCL - r113*O1D*COFCL + d(CRESOL)/dt = .18*r305*TOLUENE*OH + - r285*OH*CRESOL + d(DMS)/dt = - r338*NO3*DMS - r339*OH*DMS - r353*OH*DMS + d(dst_a1)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(E90)/dt = - r419*E90 + d(EOOH)/dt = r173*EO2*HO2 + - j42*EOOH + d(F)/dt = j80*CF3BR + j84*CFC115 + 2*j96*COF2 + j97*COFCL + j104*HF + r81*O1D*CFC115 + r103*O1D*CF3BR + + 2*r112*O1D*COF2 + r113*O1D*COFCL + - r108*CH4*F - r109*H2*F - r110*H2O*F - r111*HNO3*F + d(GLYALD)/dt = .33*j45*HONITR + .25*j65*TERP2OOH + r176*O2*EO + .53*r208*MACRO2*CH3CO3 + .26*r209*MACRO2*CH3O2 + + .53*r211*MACRO2*NO3 + .53*r212*MACRO2*NO + .05*r250*ISOPBO2*NO + .05*r251*ISOPBO2*NO3 + + .7*r252*ISOPNITA*OH + .5*r253*ISOPNITB*OH + r264*NC4CH2OH*OH + .25*r266*XO2*CH3CO3 + + .1*r267*XO2*CH3O2 + .25*r269*XO2*NO + .25*r270*XO2*NO3 + .125*r326*TERP2O2*CH3O2 + + .225*r328*TERP2O2*NO + - j43*GLYALD - r177*OH*GLYALD + d(GLYOXAL)/dt = j21*BENZOOH + .13*j23*BIGALD + .7*j61*PHENOOH + .6*j70*TOLOOH + .34*j72*XYLENOOH + + .17*j73*XYLOLOOH + .65*r153*M*C2H2*OH + .2*r177*GLYALD*OH + .05*r250*ISOPBO2*NO + + .05*r251*ISOPBO2*NO3 + r265*NC4CHO*OH + .25*r266*XO2*CH3CO3 + .1*r267*XO2*CH3O2 + + .25*r269*XO2*NO + .25*r270*XO2*NO3 + r276*BENZO2*NO + .16*r289*MALO2*HO2 + .4*r290*MALO2*NO + + .07*r292*MDIALO2*HO2 + .17*r293*MDIALO2*NO + .7*r296*PHENO2*NO + .6*r303*TOLO2*NO + + .34*r309*XYLENO2*NO + .17*r312*XYLOLO2*NO + - j44*GLYOXAL - r398*GLYOXAL - r178*OH*GLYOXAL + d(H)/dt = j2*H2O + 2*j3*H2O + 2*j33*CH2O + j38*CH3OOH + .33*j39*CH4 + j40*CH4 + j99*HBR + j103*HCL + + j104*HF + r1*O1D*H2 + r9*H2*O + r18*OH*H2 + r21*OH*O + r39*N*OH + r53*CL*H2 + r84*O1D*HCL + + r107*O1D*HBR + r109*F*H2 + r134*CH2O*OH + r148*O1D*CH4 + r341*OCS*OH + r347*S*OH + r352*SO*OH + - r14*O2*M*H - r11*HO2*H - r12*HO2*H - r13*HO2*H - r17*O3*H + d(H2)/dt = j1*H2O + j32*CH2O + 1.4400001*j39*CH4 + r11*H*HO2 + r149*O1D*CH4 + - r1*O1D*H2 - r9*O*H2 - r18*OH*H2 - r53*CL*H2 - r109*F*H2 + d(H2402)/dt = - j98*H2402 - r105*O1D*H2402 + d(H2O2)/dt = .5*r356*HO2 + r24*M*OH*OH + r25*HO2*HO2 + - j4*H2O2 - r10*O*H2O2 - r19*OH*H2O2 - r54*CL*H2O2 + d(H2SO4)/dt = r354*SO3*H2O + - j109*H2SO4 + d(HBR)/dt = r87*BR*CH2O + r88*BR*HO2 + - j99*HBR - r100*O*HBR - r101*OH*HBR - r106*O1D*HBR - r107*O1D*HBR + d(HCFC141B)/dt = - j100*HCFC141B - r123*OH*HCFC141B - r128*O1D*HCFC141B + d(HCFC142B)/dt = - j101*HCFC142B - r124*OH*HCFC142B - r129*O1D*HCFC142B + d(HCFC22)/dt = - j102*HCFC22 - r125*OH*HCFC22 - r130*O1D*HCFC22 + d(HCL)/dt = r51*CL*CH2O + r52*CL*CH4 + r53*CL*H2 + r54*CL*H2O2 + r55*CL*HO2 + r70*CLO*OH + r73*HOCL*CL + + r114*CH2BR2*CL + r116*CH3BR*CL + 2*r119*CH3CL*CL + r121*CHBR3*CL + r162*C2H6*CL + - j103*HCL - r71*O*HCL - r72*OH*HCL - r83*O1D*HCL - r84*O1D*HCL - r403*HOCL*HCL + - r408*CLONO2*HCL - r409*HOCL*HCL - r410*HOBR*HCL - r413*CLONO2*HCL - r414*HOCL*HCL + - r415*HOBR*HCL - r418*CLONO2*HCL + d(HCN)/dt = - r142*M*OH*HCN - r150*O1D*HCN + d(HCOOH)/dt = r144*HOCH2OO*HO2 + r146*HOCH2OO*NO + .35*r153*M*C2H2*OH + .37*r155*C2H4*O3 + .12*r184*C3H6*O3 + + .33*r214*MACR*O3 + .12*r228*MVK*O3 + .11*r261*ISOP*O3 + .05*r316*BCARY*O3 + .05*r319*MTERP*O3 + - r143*OH*HCOOH + d(HF)/dt = r108*F*CH4 + r109*F*H2 + r110*F*H2O + r111*F*HNO3 + - j104*HF + d(HNO3)/dt = r357*HONITR + r358*ISOPNITA + r359*ISOPNITB + 2*r360*N2O5 + r361*NC4CH2OH + r362*NC4CHO + + .5*r364*NO2 + r365*NO3 + r366*NTERPOOH + r367*ONITR + r368*TERPNIT + 2*r402*N2O5 + + r404*BRONO2 + 2*r405*N2O5 + r406*CLONO2 + r407*BRONO2 + r411*CLONO2 + r412*BRONO2 + + 2*r416*N2O5 + r417*CLONO2 + r47*M*NO2*OH + r132*CH2O*NO3 + r164*CH3CHO*NO3 + + r190*CH3COCHO*NO3 + r338*DMS*NO3 + r408*CLONO2*HCL + r413*CLONO2*HCL + r418*CLONO2*HCL + - j9*HNO3 - r48*OH*HNO3 - r111*F*HNO3 + d(HO2NO2)/dt = r45*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r49*M*HO2NO2 - r26*OH*HO2NO2 + d(HOBR)/dt = r404*BRONO2 + r407*BRONO2 + r412*BRONO2 + r94*BRO*HO2 + - j105*HOBR - r102*O*HOBR - r410*HCL*HOBR - r415*HCL*HOBR + d(HOCL)/dt = r406*CLONO2 + r411*CLONO2 + r417*CLONO2 + r62*CLO*HO2 + r67*CLONO2*OH + - j106*HOCL - r73*CL*HOCL - r74*O*HOCL - r75*OH*HOCL - r403*HCL*HOCL - r409*HCL*HOCL + - r414*HCL*HOCL + d(HONITR)/dt = r206*ENEO2*NO + r213*MACRO2*NO + .3*r252*ISOPNITA*OH + .5*r253*ISOPNITB*OH + - j45*HONITR - r357*HONITR - r207*OH*HONITR + d(HPALD)/dt = r249*ISOPBO2 + - j46*HPALD - r238*OH*HPALD + d(HYAC)/dt = .17*j45*HONITR + .5*r196*POOH*OH + .2*r197*RO2*CH3O2 + .22*r208*MACRO2*CH3CO3 + + .23*r209*MACRO2*CH3O2 + .22*r211*MACRO2*NO3 + .22*r212*MACRO2*NO + .5*r227*M*MPAN*OH + + .05*r250*ISOPBO2*NO + .05*r251*ISOPBO2*NO3 + .7*r252*ISOPNITA*OH + .5*r253*ISOPNITB*OH + + .25*r266*XO2*CH3CO3 + .1*r267*XO2*CH3O2 + .25*r269*XO2*NO + .25*r270*XO2*NO3 + - j47*HYAC - r192*OH*HYAC + d(HYDRALD)/dt = r246*ISOPBO2*CH3CO3 + .75*r247*ISOPBO2*CH3O2 + .87*r250*ISOPBO2*NO + .95*r251*ISOPBO2*NO3 + - r239*OH*HYDRALD + d(IEPOX)/dt = .6*r263*ISOPOOH*OH + - r240*OH*IEPOX + d(ISOP)/dt = - r254*NO3*ISOP - r261*O3*ISOP - r262*OH*ISOP + d(ISOPNITA)/dt = .08*r244*ISOPAO2*NO + - r358*ISOPNITA - r252*OH*ISOPNITA + d(ISOPNITB)/dt = .08*r250*ISOPBO2*NO + - r359*ISOPNITB - r253*OH*ISOPNITB + d(ISOPNO3)/dt = r254*ISOP*NO3 + - r255*CH3CO3*ISOPNO3 - r256*CH3O2*ISOPNO3 - r257*HO2*ISOPNO3 - r258*NO*ISOPNO3 + - r259*NO3*ISOPNO3 + d(ISOPNOOH)/dt = r257*ISOPNO3*HO2 + - j48*ISOPNOOH - r260*OH*ISOPNOOH + d(ISOPO2VBS)/dt = r381*ISOP*OH + - r378*HO2*ISOPO2VBS - r379*NO*ISOPO2VBS + d(ISOPOOH)/dt = j48*ISOPNOOH + r243*ISOPAO2*HO2 + r248*ISOPBO2*HO2 + - j49*ISOPOOH - r263*OH*ISOPOOH + d(IVOCbb)/dt = - r384*OH*IVOCbb + d(IVOCbbO2VBS)/dt = r384*IVOCbb*OH + - r382*HO2*IVOCbbO2VBS - r383*NO*IVOCbbO2VBS + d(IVOCff)/dt = - r387*OH*IVOCff + d(IVOCffO2VBS)/dt = r387*IVOCff*OH + - r385*HO2*IVOCffO2VBS - r386*NO*IVOCffO2VBS + d(MACR)/dt = .3*j49*ISOPOOH + .39*r241*ISOPAO2*CH3CO3 + .31*r242*ISOPAO2*CH3O2 + .36*r244*ISOPAO2*NO + + .4*r245*ISOPAO2*NO3 + .3*r261*ISOP*O3 + - j50*MACR - j51*MACR - r214*O3*MACR - r215*OH*MACR + d(MACROOH)/dt = r210*MACRO2*HO2 + - r216*OH*MACROOH + d(MEK)/dt = .8*j19*ALKNIT + .8*j20*ALKOOH + .8*r234*ALKO2*NO + - j52*MEK - r225*OH*MEK + d(MEKOOH)/dt = .8*r223*MEKO2*HO2 + - j53*MEKOOH - r226*OH*MEKOOH + d(MPAN)/dt = r230*M*MCO3*NO2 + - j54*MPAN - r231*M*MPAN - r227*M*OH*MPAN + d(MTERP)/dt = - r318*NO3*MTERP - r319*O3*MTERP - r320*OH*MTERP + d(MTERPO2VBS)/dt = r392*MTERP*OH + - r389*HO2*MTERPO2VBS - r390*NO*MTERPO2VBS + d(MVK)/dt = .7*j49*ISOPOOH + .61*r241*ISOPAO2*CH3CO3 + .44*r242*ISOPAO2*CH3O2 + .56*r244*ISOPAO2*NO + + .6*r245*ISOPAO2*NO3 + .2*r261*ISOP*O3 + - j55*MVK - r228*O3*MVK - r229*OH*MVK + d(N)/dt = j15*NO + - r31*O2*N - r27*NO*N - r28*NO2*N - r29*NO2*N - r30*NO2*N - r39*OH*N + d(N2O)/dt = r28*N*NO2 + - j12*N2O - r43*O1D*N2O - r44*O1D*N2O + d(N2O5)/dt = r46*M*NO2*NO3 + - j13*N2O5 - j14*N2O5 - r50*M*N2O5 - r360*N2O5 - r402*N2O5 - r405*N2O5 - r416*N2O5 + d(NC4CH2OH)/dt = .2*r256*ISOPNO3*CH3O2 + - r361*NC4CH2OH - r264*OH*NC4CH2OH + d(NC4CHO)/dt = r255*ISOPNO3*CH3CO3 + .8*r256*ISOPNO3*CH3O2 + r258*ISOPNO3*NO + r259*ISOPNO3*NO3 + - j56*NC4CHO - r362*NC4CHO - r265*OH*NC4CHO + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 + d(ncl_a3)/dt = 0 + d(NH3)/dt = - r355*OH*NH3 + d(NH4)/dt = - r363*NH4 + d(NO)/dt = j13*N2O5 + j16*NO2 + j17*NO3 + r31*O2*N + .5*r364*NO2 + 2*r29*N*NO2 + r32*NO2*O + r39*N*OH + + 2*r43*O1D*N2O + r348*SO*NO2 + - j15*NO - r27*N*NO - r36*NO3*NO - r40*HO2*NO - r41*O3*NO - r42*M*O*NO - r63*CLO*NO + - r95*BRO*NO - r138*CH3O2*NO - r146*HOCH2OO*NO - r159*C2H5O2*NO - r170*CH3CO3*NO - r174*EO2*NO + - r187*C3H7O2*NO - r195*PO2*NO - r199*RO2*NO - r205*ENEO2*NO - r206*ENEO2*NO - r212*MACRO2*NO + - r213*MACRO2*NO - r221*MCO3*NO - r224*MEKO2*NO - r234*ALKO2*NO - r235*ALKO2*NO - r244*ISOPAO2*NO + - r250*ISOPBO2*NO - r258*ISOPNO3*NO - r269*XO2*NO - r273*ACBZO2*NO - r276*BENZO2*NO + - r281*BZOO*NO - r283*C6H5O2*NO - r287*DICARBO2*NO - r290*MALO2*NO - r293*MDIALO2*NO + - r296*PHENO2*NO - r303*TOLO2*NO - r309*XYLENO2*NO - r312*XYLOLO2*NO - r323*NTERPO2*NO + - r328*TERP2O2*NO - r333*TERPO2*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j14*N2O5 + j18*NO3 + j19*ALKNIT + j45*HONITR + j48*ISOPNOOH + j54*MPAN + + j56*NC4CHO + j57*NOA + j58*NTERPOOH + j59*ONITR + .6*j60*PAN + j66*TERPNIT + j76*BRONO2 + + j94*CLONO2 + r49*M*HO2NO2 + r50*M*N2O5 + r182*M*PAN + r231*M*MPAN + r306*M*PBZNIT + + r26*HO2NO2*OH + r35*NO3*HO2 + 2*r36*NO3*NO + r37*NO3*O + r38*NO3*OH + r40*NO*HO2 + r41*NO*O3 + + r42*M*NO*O + r63*CLO*NO + r95*BRO*NO + r138*CH3O2*NO + r146*HOCH2OO*NO + r159*C2H5O2*NO + + r170*CH3CO3*NO + r174*EO2*NO + r187*C3H7O2*NO + r193*NOA*OH + r195*PO2*NO + r199*RO2*NO + + r203*BIGENE*NO3 + r205*ENEO2*NO + r211*MACRO2*NO3 + r212*MACRO2*NO + r221*MCO3*NO + + r222*MCO3*NO3 + r224*MEKO2*NO + r232*ALKNIT*OH + r234*ALKO2*NO + .92*r244*ISOPAO2*NO + + r245*ISOPAO2*NO3 + .92*r250*ISOPBO2*NO + r251*ISOPBO2*NO3 + .7*r252*ISOPNITA*OH + + r258*ISOPNO3*NO + r259*ISOPNO3*NO3 + r269*XO2*NO + r270*XO2*NO3 + r273*ACBZO2*NO + + r276*BENZO2*NO + r281*BZOO*NO + r283*C6H5O2*NO + r287*DICARBO2*NO + r290*MALO2*NO + + r293*MDIALO2*NO + r296*PHENO2*NO + r303*TOLO2*NO + r309*XYLENO2*NO + r312*XYLOLO2*NO + + .5*r321*NTERPO2*CH3O2 + 1.6*r323*NTERPO2*NO + 2*r324*NTERPO2*NO3 + .9*r328*TERP2O2*NO + + r330*TERPNIT*OH + .8*r333*TERPO2*NO + - j16*NO2 - r364*NO2 - r28*N*NO2 - r29*N*NO2 - r30*N*NO2 - r32*O*NO2 - r33*O3*NO2 + - r34*M*O*NO2 - r45*M*HO2*NO2 - r46*M*NO3*NO2 - r47*M*OH*NO2 - r65*M*CLO*NO2 - r96*M*BRO*NO2 + - r181*M*CH3CO3*NO2 - r230*M*MCO3*NO2 - r288*M*DICARBO2*NO2 - r291*M*MALO2*NO2 + - r294*M*MDIALO2*NO2 - r298*PHENO*NO2 - r301*M*ACBZO2*NO2 - r348*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j60*PAN + j77*BRONO2 + j95*CLONO2 + r50*M*N2O5 + + r33*NO2*O3 + r34*M*NO2*O + r48*HNO3*OH + r64*CLONO2*CL + r66*CLONO2*O + r67*CLONO2*OH + + r97*BRONO2*O + r111*F*HNO3 + r179*PAN*OH + .5*r227*M*MPAN*OH + - j17*NO3 - j18*NO3 - r365*NO3 - r35*HO2*NO3 - r36*NO*NO3 - r37*O*NO3 - r38*OH*NO3 + - r46*M*NO2*NO3 - r132*CH2O*NO3 - r164*CH3CHO*NO3 - r183*C3H6*NO3 - r190*CH3COCHO*NO3 + - r203*BIGENE*NO3 - r211*MACRO2*NO3 - r222*MCO3*NO3 - r245*ISOPAO2*NO3 - r251*ISOPBO2*NO3 + - r254*ISOP*NO3 - r259*ISOPNO3*NO3 - r270*XO2*NO3 - r315*BCARY*NO3 - r318*MTERP*NO3 + - r324*NTERPO2*NO3 - r335*TERPROD1*NO3 - r338*DMS*NO3 + d(NOA)/dt = r183*C3H6*NO3 + .5*r253*ISOPNITB*OH + r260*ISOPNOOH*OH + r264*NC4CH2OH*OH + r265*NC4CHO*OH + - j57*NOA - r193*OH*NOA + d(NTERPOOH)/dt = r322*NTERPO2*HO2 + - j58*NTERPOOH - r366*NTERPOOH - r325*OH*NTERPOOH + 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 + j13*N2O5 + j15*NO + j16*NO2 + j18*NO3 + .18*j39*CH4 + + j41*CO2 + j75*BRO + j93*CLO + j107*OCLO + j111*SO + j112*SO2 + j113*SO3 + r3*N2*O1D + + r4*O2*O1D + r31*O2*N + r342*O2*S + r349*O2*SO + r13*H*HO2 + r23*OH*OH + r27*N*NO + r28*N*NO2 + - r8*O2*M*O - r6*O3*O - 2*r7*M*O*O - r9*H2*O - r10*H2O2*O - r15*HO2*O - r21*OH*O - r32*NO2*O + - r34*M*NO2*O - r37*NO3*O - r42*M*NO*O - r66*CLONO2*O - r68*CLO*O - r71*HCL*O - r74*HOCL*O + - r97*BRONO2*O - r98*BRO*O - r100*HBR*O - r102*HOBR*O - r133*CH2O*O - r340*OCS*O + d(O3)/dt = r8*O2*M*O + .15*r169*CH3CO3*HO2 + .15*r219*MCO3*HO2 + - j7*O3 - j8*O3 - r5*O1D*O3 - r6*O*O3 - r16*HO2*O3 - r17*H*O3 - r22*OH*O3 - r33*NO2*O3 + - r41*NO*O3 - r57*CL*O3 - r89*BR*O3 - r155*C2H4*O3 - r184*C3H6*O3 - r214*MACR*O3 - r228*MVK*O3 + - r261*ISOP*O3 - r299*PHENO*O3 - r316*BCARY*O3 - r319*MTERP*O3 - r344*S*O3 - r350*SO*O3 + d(O3S)/dt = 0 + d(OCLO)/dt = r61*CLO*CLO + r91*BRO*CLO + - j107*OCLO - r351*SO*OCLO + d(OCS)/dt = - j110*OCS - r340*O*OCS - r341*OH*OCS + d(ONITR)/dt = r207*HONITR*OH + .1*r328*TERP2O2*NO + - j59*ONITR - r367*ONITR + d(PAN)/dt = r181*M*CH3CO3*NO2 + - j60*PAN - r182*M*PAN - r179*OH*PAN + d(PBZNIT)/dt = r301*M*ACBZO2*NO2 + - r306*M*PBZNIT + d(PHENO)/dt = j31*C6H5OOH + r283*C6H5O2*NO + .07*r285*CRESOL*OH + .06*r297*PHENOL*OH + .07*r313*XYLOL*OH + - r298*NO2*PHENO - r299*O3*PHENO + d(PHENOL)/dt = .53*r274*BENZENE*OH + - r297*OH*PHENOL + d(PHENOOH)/dt = r295*PHENO2*HO2 + - j61*PHENOOH - r300*OH*PHENOOH + d(pombb1_a1)/dt = 0 + d(pombb1_a4)/dt = 0 + d(pomff1_a1)/dt = 0 + d(pomff1_a4)/dt = 0 + d(POOH)/dt = r194*PO2*HO2 + - j62*POOH - r196*OH*POOH + d(ROOH)/dt = .85*r198*RO2*HO2 + - j63*ROOH - r200*OH*ROOH + d(S)/dt = j110*OCS + j111*SO + - r342*O2*S - r344*O3*S - r347*OH*S + d(SF6)/dt = - j108*SF6 + d(SO)/dt = j112*SO2 + r342*O2*S + r340*OCS*O + r344*S*O3 + r347*S*OH + - j111*SO - r349*O2*SO - r345*BRO*SO - r346*CLO*SO - r348*NO2*SO - r350*O3*SO - r351*OCLO*SO + - r352*OH*SO + d(SO2)/dt = j113*SO3 + r349*O2*SO + r338*DMS*NO3 + r339*DMS*OH + r341*OCS*OH + r345*SO*BRO + r346*SO*CLO + + r348*SO*NO2 + r350*SO*O3 + r351*SO*OCLO + r352*SO*OH + .5*r353*DMS*OH + - j112*SO2 - r343*M*OH*SO2 + d(SO3)/dt = j109*H2SO4 + r343*M*SO2*OH + - j113*SO3 - r354*H2O*SO3 + d(so4_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(so4_a3)/dt = 0 + d(so4_a5)/dt = 0 + d(soabb1_a1)/dt = - j114*soabb1_a1 + d(soabb1_a2)/dt = - j115*soabb1_a2 + d(soabb2_a1)/dt = - j116*soabb2_a1 + d(soabb2_a2)/dt = - j117*soabb2_a2 + d(soabb3_a1)/dt = - j118*soabb3_a1 + d(soabb3_a2)/dt = - j119*soabb3_a2 + d(soabb4_a1)/dt = - j120*soabb4_a1 + d(soabb4_a2)/dt = - j121*soabb4_a2 + d(soabb5_a1)/dt = - j122*soabb5_a1 + d(soabb5_a2)/dt = - j123*soabb5_a2 + d(soabg1_a1)/dt = - j124*soabg1_a1 + d(soabg1_a2)/dt = - j125*soabg1_a2 + d(soabg2_a1)/dt = - j126*soabg2_a1 + d(soabg2_a2)/dt = - j127*soabg2_a2 + d(soabg3_a1)/dt = - j128*soabg3_a1 + d(soabg3_a2)/dt = - j129*soabg3_a2 + d(soabg4_a1)/dt = - j130*soabg4_a1 + d(soabg4_a2)/dt = - j131*soabg4_a2 + d(soabg5_a1)/dt = - j132*soabg5_a1 + d(soabg5_a2)/dt = - j133*soabg5_a2 + d(soaff1_a1)/dt = - j134*soaff1_a1 + d(soaff1_a2)/dt = - j135*soaff1_a2 + d(soaff2_a1)/dt = - j136*soaff2_a1 + d(soaff2_a2)/dt = - j137*soaff2_a2 + d(soaff3_a1)/dt = - j138*soaff3_a1 + d(soaff3_a2)/dt = - j139*soaff3_a2 + d(soaff4_a1)/dt = - j140*soaff4_a1 + d(soaff4_a2)/dt = - j141*soaff4_a2 + d(soaff5_a1)/dt = - j142*soaff5_a1 + d(soaff5_a2)/dt = - j143*soaff5_a2 + d(SOAGbb0)/dt = .2381*r382*IVOCbbO2VBS*HO2 + .1056*r383*IVOCbbO2VBS*NO + .5931*r393*SVOCbb*OH + d(SOAGbb1)/dt = .1308*r382*IVOCbbO2VBS*HO2 + .1026*r383*IVOCbbO2VBS*NO + .1534*r393*SVOCbb*OH + d(SOAGbb2)/dt = .0348*r382*IVOCbbO2VBS*HO2 + .0521*r383*IVOCbbO2VBS*NO + .0459*r393*SVOCbb*OH + d(SOAGbb3)/dt = .0076*r382*IVOCbbO2VBS*HO2 + .0143*r383*IVOCbbO2VBS*NO + .0085*r393*SVOCbb*OH + d(SOAGbb4)/dt = .0113*r382*IVOCbbO2VBS*HO2 + .0166*r383*IVOCbbO2VBS*NO + .0128*r393*SVOCbb*OH + d(SOAGbg0)/dt = r398*GLYOXAL + .2202*r370*BCARYO2VBS*HO2 + .1279*r371*BCARYO2VBS*NO + .2202*r372*BCARY*O3 + + .0031*r378*ISOPO2VBS*HO2 + .0003*r379*ISOPO2VBS*NO + .0508*r389*MTERPO2VBS*HO2 + + .0245*r390*MTERPO2VBS*NO + .0508*r391*MTERP*O3 + d(SOAGbg1)/dt = .2067*r370*BCARYO2VBS*HO2 + .1792*r371*BCARYO2VBS*NO + .2067*r372*BCARY*O3 + + .0035*r378*ISOPO2VBS*HO2 + .0003*r379*ISOPO2VBS*NO + .1149*r389*MTERPO2VBS*HO2 + + .0082*r390*MTERPO2VBS*NO + .1149*r391*MTERP*O3 + d(SOAGbg2)/dt = .0653*r370*BCARYO2VBS*HO2 + .0676*r371*BCARYO2VBS*NO + .0653*r372*BCARY*O3 + + .0003*r378*ISOPO2VBS*HO2 + .0073*r379*ISOPO2VBS*NO + .0348*r389*MTERPO2VBS*HO2 + + .0772*r390*MTERPO2VBS*NO + .0348*r391*MTERP*O3 + d(SOAGbg3)/dt = .17493*r369*BCARY*NO3 + .1284*r370*BCARYO2VBS*HO2 + .079*r371*BCARYO2VBS*NO + + .1284*r372*BCARY*O3 + .059024*r377*ISOP*NO3 + .0271*r378*ISOPO2VBS*HO2 + + .0057*r379*ISOPO2VBS*NO + .0033*r380*ISOP*O3 + .17493*r388*MTERP*NO3 + + .0554*r389*MTERPO2VBS*HO2 + .0332*r390*MTERPO2VBS*NO + .0554*r391*MTERP*O3 + d(SOAGbg4)/dt = .59019*r369*BCARY*NO3 + .114*r370*BCARYO2VBS*HO2 + .1254*r371*BCARYO2VBS*NO + + .114*r372*BCARY*O3 + .025024*r377*ISOP*NO3 + .0474*r378*ISOPO2VBS*HO2 + + .0623*r379*ISOPO2VBS*NO + .59019*r388*MTERP*NO3 + .1278*r389*MTERPO2VBS*HO2 + + .13*r390*MTERPO2VBS*NO + .1278*r391*MTERP*O3 + d(SOAGff0)/dt = .0023*r375*BENZO2VBS*HO2 + .0097*r376*BENZO2VBS*NO + .2381*r385*IVOCffO2VBS*HO2 + + .1056*r386*IVOCffO2VBS*NO + .5931*r394*SVOCff*OH + .1364*r396*TOLUO2VBS*HO2 + + .0154*r397*TOLUO2VBS*NO + .1677*r400*XYLEO2VBS*HO2 + .0063*r401*XYLEO2VBS*NO + d(SOAGff1)/dt = .0008*r375*BENZO2VBS*HO2 + .0034*r376*BENZO2VBS*NO + .1308*r385*IVOCffO2VBS*HO2 + + .1026*r386*IVOCffO2VBS*NO + .1534*r394*SVOCff*OH + .0101*r396*TOLUO2VBS*HO2 + + .0452*r397*TOLUO2VBS*NO + .0174*r400*XYLEO2VBS*HO2 + .0237*r401*XYLEO2VBS*NO + d(SOAGff2)/dt = .0843*r375*BENZO2VBS*HO2 + .1579*r376*BENZO2VBS*NO + .0348*r385*IVOCffO2VBS*HO2 + + .0521*r386*IVOCffO2VBS*NO + .0459*r394*SVOCff*OH + .0763*r396*TOLUO2VBS*HO2 + + .0966*r397*TOLUO2VBS*NO + .086*r400*XYLEO2VBS*HO2 + .0025*r401*XYLEO2VBS*NO + d(SOAGff3)/dt = .0443*r375*BENZO2VBS*HO2 + .0059*r376*BENZO2VBS*NO + .0076*r385*IVOCffO2VBS*HO2 + + .0143*r386*IVOCffO2VBS*NO + .0085*r394*SVOCff*OH + .2157*r396*TOLUO2VBS*HO2 + + .0073*r397*TOLUO2VBS*NO + .0512*r400*XYLEO2VBS*HO2 + .011*r401*XYLEO2VBS*NO + d(SOAGff4)/dt = .1621*r375*BENZO2VBS*HO2 + .0536*r376*BENZO2VBS*NO + .0113*r385*IVOCffO2VBS*HO2 + + .0166*r386*IVOCffO2VBS*NO + .0128*r394*SVOCff*OH + .0738*r396*TOLUO2VBS*HO2 + + .238*r397*TOLUO2VBS*NO + .1598*r400*XYLEO2VBS*HO2 + .1185*r401*XYLEO2VBS*NO + d(SVOCbb)/dt = - r393*OH*SVOCbb + d(SVOCff)/dt = - r394*OH*SVOCff + d(TEPOMUC)/dt = .1*r305*TOLUENE*OH + .23*r307*XYLENES*OH + - j64*TEPOMUC + d(TERP2OOH)/dt = r327*TERP2O2*HO2 + - j65*TERP2OOH - r329*OH*TERP2OOH + d(TERPNIT)/dt = .5*r321*NTERPO2*CH3O2 + .2*r323*NTERPO2*NO + .2*r333*TERPO2*NO + - j66*TERPNIT - r368*TERPNIT - r330*OH*TERPNIT + d(TERPOOH)/dt = r332*TERPO2*HO2 + - j67*TERPOOH - r334*OH*TERPOOH + d(TERPROD1)/dt = j58*NTERPOOH + j66*TERPNIT + j67*TERPOOH + .33*r316*BCARY*O3 + .33*r319*MTERP*O3 + + .5*r321*NTERPO2*CH3O2 + .8*r323*NTERPO2*NO + r324*NTERPO2*NO3 + r330*TERPNIT*OH + + r331*TERPO2*CH3O2 + .8*r333*TERPO2*NO + - j68*TERPROD1 - r335*NO3*TERPROD1 - r336*OH*TERPROD1 + d(TERPROD2)/dt = j65*TERP2OOH + j68*TERPROD1 + .3*r316*BCARY*O3 + .3*r319*MTERP*O3 + r326*TERP2O2*CH3O2 + + .9*r328*TERP2O2*NO + - j69*TERPROD2 - r337*OH*TERPROD2 + d(TOLOOH)/dt = r302*TOLO2*HO2 + - j70*TOLOOH - r304*OH*TOLOOH + d(TOLUENE)/dt = - r305*OH*TOLUENE + d(TOLUO2VBS)/dt = r395*TOLUENE*OH + - r396*HO2*TOLUO2VBS - r397*NO*TOLUO2VBS + d(XOOH)/dt = r268*XO2*HO2 + - j71*XOOH - r271*OH*XOOH + d(XYLENES)/dt = - r307*OH*XYLENES + d(XYLENOOH)/dt = r308*XYLENO2*HO2 + - j72*XYLENOOH - r310*OH*XYLENOOH + d(XYLEO2VBS)/dt = r399*XYLENES*OH + - r400*HO2*XYLEO2VBS - r401*NO*XYLEO2VBS + d(XYLOL)/dt = .15*r307*XYLENES*OH + - r313*OH*XYLOL + d(XYLOLOOH)/dt = r311*XYLOLO2*HO2 + - j73*XYLOLOOH - r314*OH*XYLOLOOH + d(NHDEP)/dt = r363*NH4 + r355*NH3*OH + d(NDEP)/dt = .5*r227*M*MPAN*OH + r288*M*DICARBO2*NO2 + r291*M*MALO2*NO2 + r294*M*MDIALO2*NO2 + r298*PHENO*NO2 + + .2*r323*NTERPO2*NO + .5*r335*TERPROD1*NO3 + d(ACBZO2)/dt = r306*M*PBZNIT + r278*BZALD*OH + - r272*HO2*ACBZO2 - r273*NO*ACBZO2 - r301*M*NO2*ACBZO2 + d(ALKO2)/dt = r236*ALKOOH*OH + r237*BIGALK*OH + - r233*HO2*ALKO2 - r234*NO*ALKO2 - r235*NO*ALKO2 + d(BENZO2)/dt = .35*r274*BENZENE*OH + r277*BENZOOH*OH + - r275*HO2*BENZO2 - r276*NO*BENZO2 + d(BZOO)/dt = r280*BZOOH*OH + .07*r305*TOLUENE*OH + .06*r307*XYLENES*OH + - r279*HO2*BZOO - r281*NO*BZOO + d(C2H5O2)/dt = j52*MEK + .5*r161*C2H5OOH*OH + r162*C2H6*CL + r163*C2H6*OH + - 2*r156*C2H5O2*C2H5O2 - r157*CH3O2*C2H5O2 - r158*HO2*C2H5O2 - r159*NO*C2H5O2 + d(C3H7O2)/dt = r188*C3H7OOH*OH + r189*C3H8*OH + - r185*CH3O2*C3H7O2 - r186*HO2*C3H7O2 - r187*NO*C3H7O2 + d(C6H5O2)/dt = .4*r272*ACBZO2*HO2 + r273*ACBZO2*NO + r284*C6H5OOH*OH + r299*PHENO*O3 + - r282*HO2*C6H5O2 - r283*NO*C6H5O2 + d(CH3CO3)/dt = .13*j23*BIGALD + j27*BIGALD4 + j35*CH3COCH3 + j36*CH3COCHO + .33*j45*HONITR + j47*HYAC + + 1.34*j51*MACR + j52*MEK + j53*MEKOOH + .3*j55*MVK + j57*NOA + .6*j60*PAN + j63*ROOH + + .5*j64*TEPOMUC + .65*j69*TERPROD2 + r182*M*PAN + r164*CH3CHO*NO3 + r165*CH3CHO*OH + + .5*r172*CH3COOOH*OH + r190*CH3COCHO*NO3 + r191*CH3COCHO*OH + .3*r197*RO2*CH3O2 + + .15*r198*RO2*HO2 + r199*RO2*NO + .53*r208*MACRO2*CH3CO3 + .26*r209*MACRO2*CH3O2 + + .53*r211*MACRO2*NO3 + .53*r212*MACRO2*NO + .1*r214*MACR*O3 + r218*MCO3*CH3O2 + + .45*r219*MCO3*HO2 + 2*r220*MCO3*MCO3 + r221*MCO3*NO + r222*MCO3*NO3 + .2*r223*MEKO2*HO2 + + r224*MEKO2*NO + .28*r228*MVK*O3 + .08*r261*ISOP*O3 + .06*r316*BCARY*O3 + .06*r319*MTERP*O3 + + .65*r337*TERPROD2*OH + - 2*r167*CH3CO3*CH3CO3 - r168*CH3O2*CH3CO3 - r169*HO2*CH3CO3 - r170*NO*CH3CO3 + - r181*M*NO2*CH3CO3 - r208*MACRO2*CH3CO3 - r241*ISOPAO2*CH3CO3 - r246*ISOPBO2*CH3CO3 + - r255*ISOPNO3*CH3CO3 - r266*XO2*CH3CO3 + d(CH3O2)/dt = j34*CH3CHO + j35*CH3COCH3 + j37*CH3COOOH + j40*CH4 + .3*j55*MVK + .4*j60*PAN + j87*CH3BR + + j89*CH3CL + r52*CL*CH4 + r108*F*CH4 + .7*r140*CH3OOH*OH + r141*CH4*OH + r147*O1D*CH4 + + 2*r167*CH3CO3*CH3CO3 + .9*r168*CH3CO3*CH3O2 + .45*r169*CH3CO3*HO2 + r170*CH3CO3*NO + + r171*CH3COOH*OH + .28*r184*C3H6*O3 + r208*MACRO2*CH3CO3 + r217*MCO3*CH3CO3 + + r241*ISOPAO2*CH3CO3 + r246*ISOPBO2*CH3CO3 + r255*ISOPNO3*CH3CO3 + .05*r261*ISOP*O3 + + r266*XO2*CH3CO3 + .33*r286*DICARBO2*HO2 + .83*r287*DICARBO2*NO + .07*r292*MDIALO2*HO2 + + .17*r293*MDIALO2*NO + - r58*CLO*CH3O2 - 2*r135*CH3O2*CH3O2 - 2*r136*CH3O2*CH3O2 - r137*HO2*CH3O2 - r138*NO*CH3O2 + - r157*C2H5O2*CH3O2 - r168*CH3CO3*CH3O2 - r185*C3H7O2*CH3O2 - r197*RO2*CH3O2 + - r209*MACRO2*CH3O2 - r218*MCO3*CH3O2 - r242*ISOPAO2*CH3O2 - r247*ISOPBO2*CH3O2 + - r256*ISOPNO3*CH3O2 - r267*XO2*CH3O2 - r321*NTERPO2*CH3O2 - r326*TERP2O2*CH3O2 + - r331*TERPO2*CH3O2 + d(DICARBO2)/dt = .6*j25*BIGALD2 + - r286*HO2*DICARBO2 - r287*NO*DICARBO2 - r288*M*NO2*DICARBO2 + d(ENEO2)/dt = r204*BIGENE*OH + - r205*NO*ENEO2 - r206*NO*ENEO2 + d(EO)/dt = j42*EOOH + .75*r174*EO2*NO + - r175*EO - r176*O2*EO + d(EO2)/dt = r180*M*C2H4*OH + - r173*HO2*EO2 - r174*NO*EO2 + d(HO2)/dt = j11*HO2NO2 + j19*ALKNIT + .9*j20*ALKOOH + j21*BENZOOH + 1.5*j22*BEPOMUC + .56*j23*BIGALD + + j24*BIGALD1 + .6*j25*BIGALD2 + .6*j26*BIGALD3 + j27*BIGALD4 + j28*BZOOH + j29*C2H5OOH + + j30*C3H7OOH + j34*CH3CHO + j36*CH3COCHO + 2*j43*GLYALD + 2*j44*GLYOXAL + .67*j45*HONITR + + j46*HPALD + j47*HYAC + j48*ISOPNOOH + j49*ISOPOOH + .66*j50*MACR + 1.34*j51*MACR + j56*NC4CHO + + j61*PHENOOH + j62*POOH + j64*TEPOMUC + j65*TERP2OOH + j66*TERPNIT + j67*TERPOOH + + j68*TERPROD1 + 1.2*j69*TERPROD2 + j70*TOLOOH + j72*XYLENOOH + j73*XYLOLOOH + r14*O2*M*H + + r49*M*HO2NO2 + r145*HOCH2OO + r175*EO + r176*O2*EO + r249*ISOPBO2 + r10*H2O2*O + r19*OH*H2O2 + + r22*OH*O3 + r38*NO3*OH + r51*CL*CH2O + r54*CL*H2O2 + r58*CLO*CH3O2 + r69*CLO*OH + r87*BR*CH2O + + r99*BRO*OH + r116*CH3BR*CL + r117*CH3BR*OH + r119*CH3CL*CL + r120*CH3CL*OH + r132*CH2O*NO3 + + r133*CH2O*O + 2*r135*CH3O2*CH3O2 + r138*CH3O2*NO + r139*CH3OH*OH + r142*M*HCN*OH + + r143*HCOOH*OH + r146*HOCH2OO*NO + r148*O1D*CH4 + r151*CO*OH + .35*r153*M*C2H2*OH + + .13*r155*C2H4*O3 + 1.2*r156*C2H5O2*C2H5O2 + r157*C2H5O2*CH3O2 + r159*C2H5O2*NO + r160*C2H5OH*OH + + r166*CH3CN*OH + .9*r168*CH3CO3*CH3O2 + .25*r174*EO2*NO + r177*GLYALD*OH + r178*GLYOXAL*OH + + .28*r184*C3H6*O3 + r185*C3H7O2*CH3O2 + r187*C3H7O2*NO + r192*HYAC*OH + r195*PO2*NO + + .3*r197*RO2*CH3O2 + r205*ENEO2*NO + r207*HONITR*OH + .47*r208*MACRO2*CH3CO3 + + .73*r209*MACRO2*CH3O2 + .47*r211*MACRO2*NO3 + .47*r212*MACRO2*NO + .14*r214*MACR*O3 + + .2*r216*MACROOH*OH + r218*MCO3*CH3O2 + .5*r227*M*MPAN*OH + .28*r228*MVK*O3 + r234*ALKO2*NO + + r241*ISOPAO2*CH3CO3 + r242*ISOPAO2*CH3O2 + .92*r244*ISOPAO2*NO + r245*ISOPAO2*NO3 + + r246*ISOPBO2*CH3CO3 + r247*ISOPBO2*CH3O2 + .92*r250*ISOPBO2*NO + r251*ISOPBO2*NO3 + + .3*r252*ISOPNITA*OH + r253*ISOPNITB*OH + r255*ISOPNO3*CH3CO3 + 1.2*r256*ISOPNO3*CH3O2 + + r258*ISOPNO3*NO + r259*ISOPNO3*NO3 + r260*ISOPNOOH*OH + .37*r261*ISOP*O3 + r264*NC4CH2OH*OH + + r265*NC4CHO*OH + r266*XO2*CH3CO3 + .8*r267*XO2*CH3O2 + r269*XO2*NO + r270*XO2*NO3 + + .65*r274*BENZENE*OH + r276*BENZO2*NO + r281*BZOO*NO + .73*r285*CRESOL*OH + + .07*r286*DICARBO2*HO2 + .17*r287*DICARBO2*NO + .16*r289*MALO2*HO2 + .4*r290*MALO2*NO + + .33*r292*MDIALO2*HO2 + .83*r293*MDIALO2*NO + r296*PHENO2*NO + .8*r297*PHENOL*OH + r303*TOLO2*NO + + .28*r305*TOLUENE*OH + .38*r307*XYLENES*OH + r309*XYLENO2*NO + r312*XYLOLO2*NO + + .63*r313*XYLOL*OH + .57*r316*BCARY*O3 + .57*r319*MTERP*O3 + .5*r321*NTERPO2*CH3O2 + + r326*TERP2O2*CH3O2 + .9*r328*TERP2O2*NO + r331*TERPO2*CH3O2 + .8*r333*TERPO2*NO + + .2*r337*TERPROD2*OH + r343*M*SO2*OH + .5*r353*DMS*OH + - r356*HO2 - r11*H*HO2 - r12*H*HO2 - r13*H*HO2 - r15*O*HO2 - r16*O3*HO2 - r20*OH*HO2 + - 2*r25*HO2*HO2 - r35*NO3*HO2 - r40*NO*HO2 - r45*M*NO2*HO2 - r55*CL*HO2 - r56*CL*HO2 + - r62*CLO*HO2 - r88*BR*HO2 - r94*BRO*HO2 - r131*CH2O*HO2 - r137*CH3O2*HO2 - r144*HOCH2OO*HO2 + - r158*C2H5O2*HO2 - r169*CH3CO3*HO2 - r173*EO2*HO2 - r186*C3H7O2*HO2 - r194*PO2*HO2 + - r198*RO2*HO2 - r210*MACRO2*HO2 - r219*MCO3*HO2 - r223*MEKO2*HO2 - r233*ALKO2*HO2 + - r243*ISOPAO2*HO2 - r248*ISOPBO2*HO2 - r257*ISOPNO3*HO2 - r268*XO2*HO2 - r272*ACBZO2*HO2 + - r275*BENZO2*HO2 - r279*BZOO*HO2 - r282*C6H5O2*HO2 - r286*DICARBO2*HO2 - r289*MALO2*HO2 + - r292*MDIALO2*HO2 - r295*PHENO2*HO2 - r302*TOLO2*HO2 - r308*XYLENO2*HO2 - r311*XYLOLO2*HO2 + - r322*NTERPO2*HO2 - r327*TERP2O2*HO2 - r332*TERPO2*HO2 + d(HOCH2OO)/dt = r131*CH2O*HO2 + - r145*HOCH2OO - r144*HO2*HOCH2OO - r146*NO*HOCH2OO + d(ISOPAO2)/dt = .6*r262*ISOP*OH + - r241*CH3CO3*ISOPAO2 - r242*CH3O2*ISOPAO2 - r243*HO2*ISOPAO2 - r244*NO*ISOPAO2 + - r245*NO3*ISOPAO2 + d(ISOPBO2)/dt = .4*r262*ISOP*OH + - r249*ISOPBO2 - r246*CH3CO3*ISOPBO2 - r247*CH3O2*ISOPBO2 - r248*HO2*ISOPBO2 + - r250*NO*ISOPBO2 - r251*NO3*ISOPBO2 + d(MACRO2)/dt = .5*r215*MACR*OH + .2*r216*MACROOH*OH + r229*MVK*OH + - r208*CH3CO3*MACRO2 - r209*CH3O2*MACRO2 - r210*HO2*MACRO2 - r211*NO3*MACRO2 - r212*NO*MACRO2 + - r213*NO*MACRO2 + d(MALO2)/dt = .6*j24*BIGALD1 + - r289*HO2*MALO2 - r290*NO*MALO2 - r291*M*NO2*MALO2 + d(MCO3)/dt = .66*j51*MACR + j54*MPAN + r231*M*MPAN + .5*r215*MACR*OH + .5*r216*MACROOH*OH + - r217*CH3CO3*MCO3 - r218*CH3O2*MCO3 - r219*HO2*MCO3 - 2*r220*MCO3*MCO3 - r221*NO*MCO3 + - r222*NO3*MCO3 - r230*M*NO2*MCO3 + d(MDIALO2)/dt = .6*j26*BIGALD3 + - r292*HO2*MDIALO2 - r293*NO*MDIALO2 - r294*M*NO2*MDIALO2 + d(MEKO2)/dt = r225*MEK*OH + r226*MEKOOH*OH + - r223*HO2*MEKO2 - r224*NO*MEKO2 + d(NTERPO2)/dt = r315*BCARY*NO3 + r318*MTERP*NO3 + r325*NTERPOOH*OH + .5*r335*TERPROD1*NO3 + - r321*CH3O2*NTERPO2 - r322*HO2*NTERPO2 - r323*NO*NTERPO2 - r324*NO3*NTERPO2 + 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 - r43*N2O*O1D - r44*N2O*O1D + - r76*CCL4*O1D - r77*CF2CLBR*O1D - r78*CFC11*O1D - r79*CFC113*O1D - r80*CFC114*O1D + - r81*CFC115*O1D - r82*CFC12*O1D - r83*HCL*O1D - r84*HCL*O1D - r103*CF3BR*O1D - r104*CHBR3*O1D + - r105*H2402*O1D - r106*HBR*O1D - r107*HBR*O1D - r112*COF2*O1D - r113*COFCL*O1D + - r126*CH2BR2*O1D - r127*CH3BR*O1D - r128*HCFC141B*O1D - r129*HCFC142B*O1D - r130*HCFC22*O1D + - r147*CH4*O1D - r148*CH4*O1D - r149*CH4*O1D - r150*HCN*O1D + d(OH)/dt = j2*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j20*ALKOOH + j21*BENZOOH + j28*BZOOH + j29*C2H5OOH + + j30*C3H7OOH + j31*C6H5OOH + j37*CH3COOOH + j38*CH3OOH + .33*j39*CH4 + j42*EOOH + j46*HPALD + + j49*ISOPOOH + j53*MEKOOH + j58*NTERPOOH + j61*PHENOOH + j62*POOH + j63*ROOH + j65*TERP2OOH + + j67*TERPOOH + j70*TOLOOH + j71*XOOH + j72*XYLENOOH + j73*XYLOLOOH + j105*HOBR + j106*HOCL + + .5*r364*NO2 + r1*O1D*H2 + 2*r2*O1D*H2O + r9*H2*O + r10*H2O2*O + 2*r12*H*HO2 + r15*HO2*O + + r16*HO2*O3 + r17*H*O3 + r35*NO3*HO2 + r40*NO*HO2 + r56*CL*HO2 + r71*HCL*O + r74*HOCL*O + + r83*O1D*HCL + r100*HBR*O + r102*HOBR*O + r106*O1D*HBR + r110*F*H2O + r133*CH2O*O + + .3*r140*CH3OOH*OH + r147*O1D*CH4 + r150*O1D*HCN + .65*r153*M*C2H2*OH + .13*r155*C2H4*O3 + + .5*r161*C2H5OOH*OH + .45*r169*CH3CO3*HO2 + .36*r184*C3H6*O3 + .5*r196*POOH*OH + .15*r198*RO2*HO2 + + .24*r214*MACR*O3 + .1*r216*MACROOH*OH + .45*r219*MCO3*HO2 + .2*r223*MEKO2*HO2 + .36*r228*MVK*O3 + + .32*r261*ISOP*O3 + .6*r263*ISOPOOH*OH + .5*r271*XOOH*OH + .4*r272*ACBZO2*HO2 + + .4*r286*DICARBO2*HO2 + .4*r292*MDIALO2*HO2 + .63*r316*BCARY*O3 + .63*r319*MTERP*O3 + - r18*H2*OH - r19*H2O2*OH - r20*HO2*OH - r21*O*OH - r22*O3*OH - 2*r23*OH*OH - 2*r24*M*OH*OH + - r26*HO2NO2*OH - r38*NO3*OH - r39*N*OH - r47*M*NO2*OH - r48*HNO3*OH - r67*CLONO2*OH + - r69*CLO*OH - r70*CLO*OH - r72*HCL*OH - r75*HOCL*OH - r99*BRO*OH - r101*HBR*OH - r115*CH2BR2*OH + - r117*CH3BR*OH - r118*CH3CCL3*OH - r120*CH3CL*OH - r122*CHBR3*OH - r123*HCFC141B*OH + - r124*HCFC142B*OH - r125*HCFC22*OH - r134*CH2O*OH - r139*CH3OH*OH - r140*CH3OOH*OH - r141*CH4*OH + - r142*M*HCN*OH - r143*HCOOH*OH - r151*CO*OH - r153*M*C2H2*OH - r160*C2H5OH*OH - r161*C2H5OOH*OH + - r163*C2H6*OH - r165*CH3CHO*OH - r166*CH3CN*OH - r171*CH3COOH*OH - r172*CH3COOOH*OH + - r177*GLYALD*OH - r178*GLYOXAL*OH - r179*PAN*OH - r180*M*C2H4*OH - r188*C3H7OOH*OH + - r189*C3H8*OH - r191*CH3COCHO*OH - r192*HYAC*OH - r193*NOA*OH - r196*POOH*OH - r200*ROOH*OH + - r201*M*C3H6*OH - r202*CH3COCH3*OH - r204*BIGENE*OH - r207*HONITR*OH - r215*MACR*OH + - r216*MACROOH*OH - r225*MEK*OH - r226*MEKOOH*OH - r227*M*MPAN*OH - r229*MVK*OH - r232*ALKNIT*OH + - r236*ALKOOH*OH - r237*BIGALK*OH - r238*HPALD*OH - r239*HYDRALD*OH - r240*IEPOX*OH + - r252*ISOPNITA*OH - r253*ISOPNITB*OH - r260*ISOPNOOH*OH - r262*ISOP*OH - r263*ISOPOOH*OH + - r264*NC4CH2OH*OH - r265*NC4CHO*OH - r271*XOOH*OH - r274*BENZENE*OH - r277*BENZOOH*OH + - r278*BZALD*OH - r280*BZOOH*OH - r284*C6H5OOH*OH - r285*CRESOL*OH - r297*PHENOL*OH + - r300*PHENOOH*OH - r304*TOLOOH*OH - r305*TOLUENE*OH - r307*XYLENES*OH - r310*XYLENOOH*OH + - r313*XYLOL*OH - r314*XYLOLOOH*OH - r317*BCARY*OH - r320*MTERP*OH - r325*NTERPOOH*OH + - r329*TERP2OOH*OH - r330*TERPNIT*OH - r334*TERPOOH*OH - r336*TERPROD1*OH - r337*TERPROD2*OH + - r339*DMS*OH - r341*OCS*OH - r343*M*SO2*OH - r347*S*OH - r352*SO*OH - r353*DMS*OH - r355*NH3*OH + d(PHENO2)/dt = .2*r285*CRESOL*OH + .14*r297*PHENOL*OH + r300*PHENOOH*OH + - r295*HO2*PHENO2 - r296*NO*PHENO2 + d(PO2)/dt = .5*r196*POOH*OH + r201*M*C3H6*OH + - r194*HO2*PO2 - r195*NO*PO2 + d(RO2)/dt = .15*j69*TERPROD2 + r200*ROOH*OH + r202*CH3COCH3*OH + .06*r316*BCARY*O3 + .06*r319*MTERP*O3 + + .15*r337*TERPROD2*OH + - r197*CH3O2*RO2 - r198*HO2*RO2 - r199*NO*RO2 + d(TERP2O2)/dt = r329*TERP2OOH*OH + .5*r335*TERPROD1*NO3 + r336*TERPROD1*OH + - r326*CH3O2*TERP2O2 - r327*HO2*TERP2O2 - r328*NO*TERP2O2 + d(TERPO2)/dt = r317*BCARY*OH + r320*MTERP*OH + r334*TERPOOH*OH + - r331*CH3O2*TERPO2 - r332*HO2*TERPO2 - r333*NO*TERPO2 + d(TOLO2)/dt = r304*TOLOOH*OH + .65*r305*TOLUENE*OH + - r302*HO2*TOLO2 - r303*NO*TOLO2 + d(XO2)/dt = r238*HPALD*OH + r239*HYDRALD*OH + r240*IEPOX*OH + .4*r263*ISOPOOH*OH + .5*r271*XOOH*OH + - r266*CH3CO3*XO2 - r267*CH3O2*XO2 - r268*HO2*XO2 - r269*NO*XO2 - r270*NO3*XO2 + d(XYLENO2)/dt = .56*r307*XYLENES*OH + r310*XYLENOOH*OH + - r308*HO2*XYLENO2 - r309*NO*XYLENO2 + d(XYLOLO2)/dt = .3*r313*XYLOL*OH + r314*XYLOLOOH*OH + - r311*HO2*XYLOLO2 - r312*NO*XYLOLO2 + d(H2O)/dt = .05*j39*CH4 + j109*H2SO4 + r13*H*HO2 + r18*OH*H2 + r19*OH*H2O2 + r20*OH*HO2 + r23*OH*OH + + r26*HO2NO2*OH + r48*HNO3*OH + r72*HCL*OH + r75*HOCL*OH + r101*HBR*OH + r115*CH2BR2*OH + + r117*CH3BR*OH + r118*CH3CCL3*OH + r120*CH3CL*OH + r125*HCFC22*OH + r134*CH2O*OH + + r140*CH3OOH*OH + r141*CH4*OH + r143*HCOOH*OH + r163*C2H6*OH + r165*CH3CHO*OH + r171*CH3COOH*OH + + r172*CH3COOOH*OH + r188*C3H7OOH*OH + r189*C3H8*OH + r191*CH3COCHO*OH + r196*POOH*OH + + r200*ROOH*OH + r202*CH3COCH3*OH + .5*r215*MACR*OH + r355*NH3*OH + r403*HOCL*HCL + + r409*HOCL*HCL + r410*HOBR*HCL + r414*HOCL*HCL + r415*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r2*O1D*H2O - r110*F*H2O - r354*SO3*H2O diff --git a/src/chemistry/pp_trop_strat_mam5_vbsext/chem_mech.in b/src/chemistry/pp_trop_strat_mam5_vbsext/chem_mech.in new file mode 100644 index 0000000000..c3c2697897 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/chem_mech.in @@ -0,0 +1,1283 @@ +* Comments +* User-given Tag Description: TS1.2_fullVBS +* Tag database identifier : MZ323_TS1_fullVBS_20221220 +* Tag created by : lke +* Tag created from branch : TS1-fullVBS +* Tag created on : 2022-12-20 16:49:31.65266-07 +* Comments for this tag follow: +* lke : 2022-12-20 : TS1 with JPL19 updates, NOx-dependent VBS-SOA, tracking SOA source type (ff,bb,bg) + + SPECIES + + Solution + ALKNIT -> C5H11ONO2, + ALKOOH -> C5H12O2, + AOA_NH -> CO, + bc_a1 -> C, + bc_a4 -> C, + BCARY -> C15H24, + BCARYO2VBS -> C15H25O3, + BENZENE -> C6H6, + BENZO2VBS -> C6H7O5, + BENZOOH -> C6H8O5, + BEPOMUC -> C6H6O3, + BIGALD -> C5H6O2, + BIGALD1 -> C4H4O2, + BIGALD2 -> C5H6O2, + BIGALD3 -> C5H6O2, + BIGALD4 -> C6H8O2, + BIGALK -> C5H12, + BIGENE -> C4H8, + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + BZALD -> C7H6O, + BZOOH -> C7H8O2, + C2H2, + C2H4, + C2H5OH, + C2H5OOH, + C2H6, + C3H6, + C3H7OOH, + C3H8, + C6H5OOH -> C6H5OOH, + 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, + CH3CN, + CH3COCH3, + CH3COCHO, + CH3COOH, + CH3COOOH, + CH3OH, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + COF2, + COFCL -> COFCl, + CRESOL -> C7H8O, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + E90 -> CO, + EOOH -> HOCH2CH2OOH, + F, + GLYALD -> HOCH2CHO, + GLYOXAL -> C2H2O2, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HCN, + HCOOH, + HF, + HNO3, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + HONITR -> C4H9NO4, + HPALD -> HOOCH2CCH3CHCHO, + HYAC -> CH3COCH2OH, + HYDRALD -> HOCH2CCH3CHCHO, + IEPOX -> C5H10O3, + ISOP -> C5H8, + ISOPNITA -> C5H9NO4, + ISOPNITB -> C5H9NO4, + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, + ISOPNOOH -> C5H9NO5, + ISOPO2VBS -> C5H9O3, + ISOPOOH -> HOCH2COOHCH3CHCH2, + IVOCbb -> C13H28, + IVOCbbO2VBS -> C13H29O3, + IVOCff -> C13H28, + IVOCffO2VBS -> C13H29O3, + MACR -> CH2CCH3CHO, + MACROOH -> CH3COCHOOHCH2OH, + MEK -> C4H8O, + MEKOOH -> C4H8O3, + MPAN -> CH2CCH3CO3NO2, + MTERP -> C10H16, + MTERPO2VBS -> C10H17O3, + MVK -> CH2CHCOCH3, + N, + N2O, + N2O5, + NC4CH2OH -> C5H9NO4, + NC4CHO -> C5H7NO4, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + NH3, + NH4, + NO, + NO2, + NO3, + NOA -> CH3COCH2ONO2, + NTERPOOH -> C10H17NO5, + 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, + PBZNIT -> C7H5O3NO2, + PHENO -> C6H5O, + PHENOL -> C6H5OH, + PHENOOH -> C6H8O6, + pombb1_a1 -> C, + pombb1_a4 -> C, + pomff1_a1 -> C, + pomff1_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, + soabb1_a1 -> C15H38O2, + soabb1_a2 -> C15H38O2, + soabb2_a1 -> C15H38O2, + soabb2_a2 -> C15H38O2, + soabb3_a1 -> C15H38O2, + soabb3_a2 -> C15H38O2, + soabb4_a1 -> C15H38O2, + soabb4_a2 -> C15H38O2, + soabb5_a1 -> C15H38O2, + soabb5_a2 -> C15H38O2, + soabg1_a1 -> C15H38O2, + soabg1_a2 -> C15H38O2, + soabg2_a1 -> C15H38O2, + soabg2_a2 -> C15H38O2, + soabg3_a1 -> C15H38O2, + soabg3_a2 -> C15H38O2, + soabg4_a1 -> C15H38O2, + soabg4_a2 -> C15H38O2, + soabg5_a1 -> C15H38O2, + soabg5_a2 -> C15H38O2, + soaff1_a1 -> C15H38O2, + soaff1_a2 -> C15H38O2, + soaff2_a1 -> C15H38O2, + soaff2_a2 -> C15H38O2, + soaff3_a1 -> C15H38O2, + soaff3_a2 -> C15H38O2, + soaff4_a1 -> C15H38O2, + soaff4_a2 -> C15H38O2, + soaff5_a1 -> C15H38O2, + soaff5_a2 -> C15H38O2, + SOAGbb0 -> C15H38O2, + SOAGbb1 -> C15H38O2, + SOAGbb2 -> C15H38O2, + SOAGbb3 -> C15H38O2, + SOAGbb4 -> C15H38O2, + SOAGbg0 -> C15H38O2, + SOAGbg1 -> C15H38O2, + SOAGbg2 -> C15H38O2, + SOAGbg3 -> C15H38O2, + SOAGbg4 -> C15H38O2, + SOAGff0 -> C15H38O2, + SOAGff1 -> C15H38O2, + SOAGff2 -> C15H38O2, + SOAGff3 -> C15H38O2, + SOAGff4 -> C15H38O2, + SVOCbb -> C22H46, + SVOCff -> C22H46, + TEPOMUC -> C7H8O3, + TERP2OOH -> C10H16O4, + TERPNIT -> C10H17NO4, + TERPOOH -> C10H18O3, + TERPROD1 -> C10H16O2, + TERPROD2 -> C9H14O2, + TOLOOH -> C7H10O5, + TOLUENE -> C7H8, + TOLUO2VBS -> C7H9O5, + XOOH -> HOCH2COOHCH3CHOHCHO, + XYLENES -> C8H10, + XYLENOOH -> C8H12O5, + XYLEO2VBS -> C8H11O5, + XYLOL -> C8H10O, + XYLOLOOH -> C8H12O6, + NHDEP -> N, + NDEP -> N, + ACBZO2 -> C7H5O3, + ALKO2 -> C5H11O2, + BENZO2 -> C6H7O5, + BZOO -> C7H7O2, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2 -> C5H5O4, + ENEO2 -> C4H9O3, + EO -> HOCH2CH2O, + EO2 -> HOCH2CH2O2, + HO2, + HOCH2OO, + ISOPAO2 -> HOC5H8O2, + ISOPBO2 -> HOC5H8O2, + MACRO2 -> CH3COCHO2CH2OH, + MALO2 -> C4H3O4, + MCO3 -> CH2CCH3CO3, + MDIALO2 -> C4H5O4, + MEKO2 -> C4H7O3, + NTERPO2 -> C10H16NO5, + O1D -> O, + OH, + PHENO2 -> C6H7O6, + PO2 -> C3H6OHO2, + RO2 -> CH3COCH2O2, + TERP2O2 -> C10H15O4, + TERPO2 -> C10H17O3, + TOLO2 -> C7H9O5, + XO2 -> HOCH2COOCH3CHOHCHO, + XYLENO2 -> C8H11O5, + XYLOLO2 -> C8H11O6, + H2O + + End Solution + + + Fixed + M, O2, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + ACBZO2, + ALKO2, + BENZO2, + BZOO, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2, + ENEO2, + EO, + EO2, + HO2, + HOCH2OO, + ISOPAO2, + ISOPBO2, + MACRO2, + MALO2, + MCO3, + MDIALO2, + MEKO2, + NTERPO2, + O1D, + OH, + PHENO2, + PO2, + RO2, + TERP2O2, + TERPO2, + TOLO2, + XO2, + XYLENO2, + XYLOLO2 + End Not-Transported + + END Species + + + Solution classes + Explicit + NHDEP + NDEP + End Explicit + + Implicit + ALKNIT + ALKOOH + AOA_NH + bc_a1 + bc_a4 + BCARY + BCARYO2VBS + BENZENE + BENZO2VBS + BENZOOH + BEPOMUC + BIGALD + BIGALD1 + BIGALD2 + BIGALD3 + BIGALD4 + BIGALK + BIGENE + BR + BRCL + BRO + BRONO2 + BRY + BZALD + BZOOH + C2H2 + C2H4 + C2H5OH + C2H5OOH + C2H6 + C3H6 + C3H7OOH + C3H8 + C6H5OOH + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH2O + CH3BR + CH3CCL3 + CH3CHO + CH3CL + CH3CN + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CH4 + CHBR3 + CL + CL2 + CL2O2 + CLO + CLONO2 + CLY + CO + CO2 + COF2 + COFCL + CRESOL + DMS + dst_a1 + dst_a2 + dst_a3 + E90 + EOOH + F + GLYALD + GLYOXAL + H + H2 + H2402 + H2O2 + H2SO4 + HBR + HCFC141B + HCFC142B + HCFC22 + HCL + HCN + HCOOH + HF + HNO3 + HO2NO2 + HOBR + HOCL + HONITR + HPALD + HYAC + HYDRALD + IEPOX + ISOP + ISOPNITA + ISOPNITB + ISOPNO3 + ISOPNOOH + ISOPO2VBS + ISOPOOH + IVOCbb + IVOCbbO2VBS + IVOCff + IVOCffO2VBS + MACR + MACROOH + MEK + MEKOOH + MPAN + MTERP + MTERPO2VBS + MVK + N + N2O + N2O5 + NC4CH2OH + NC4CHO + ncl_a1 + ncl_a2 + ncl_a3 + NH3 + NH4 + NO + NO2 + NO3 + NOA + NTERPOOH + num_a1 + num_a2 + num_a3 + num_a4 + num_a5 + O + O3 + O3S + OCLO + OCS + ONITR + PAN + PBZNIT + PHENO + PHENOL + PHENOOH + pombb1_a1 + pombb1_a4 + pomff1_a1 + pomff1_a4 + POOH + ROOH + S + SF6 + SO + SO2 + SO3 + so4_a1 + so4_a2 + so4_a3 + so4_a5 + soabb1_a1 + soabb1_a2 + soabb2_a1 + soabb2_a2 + soabb3_a1 + soabb3_a2 + soabb4_a1 + soabb4_a2 + soabb5_a1 + soabb5_a2 + soabg1_a1 + soabg1_a2 + soabg2_a1 + soabg2_a2 + soabg3_a1 + soabg3_a2 + soabg4_a1 + soabg4_a2 + soabg5_a1 + soabg5_a2 + soaff1_a1 + soaff1_a2 + soaff2_a1 + soaff2_a2 + soaff3_a1 + soaff3_a2 + soaff4_a1 + soaff4_a2 + soaff5_a1 + soaff5_a2 + SOAGbb0 + SOAGbb1 + SOAGbb2 + SOAGbb3 + SOAGbb4 + SOAGbg0 + SOAGbg1 + SOAGbg2 + SOAGbg3 + SOAGbg4 + SOAGff0 + SOAGff1 + SOAGff2 + SOAGff3 + SOAGff4 + SVOCbb + SVOCff + TEPOMUC + TERP2OOH + TERPNIT + TERPOOH + TERPROD1 + TERPROD2 + TOLOOH + TOLUENE + TOLUO2VBS + XOOH + XYLENES + XYLENOOH + XYLEO2VBS + XYLOL + XYLOLOOH + ACBZO2 + ALKO2 + BENZO2 + BZOO + C2H5O2 + C3H7O2 + C6H5O2 + CH3CO3 + CH3O2 + DICARBO2 + ENEO2 + EO + EO2 + HO2 + HOCH2OO + ISOPAO2 + ISOPBO2 + MACRO2 + MALO2 + MCO3 + MDIALO2 + MEKO2 + NTERPO2 + O1D + OH + PHENO2 + PO2 + RO2 + TERP2O2 + TERPO2 + TOLO2 + XO2 + XYLENO2 + XYLOLO2 + 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_b] N2O5 + hv -> NO + O + NO3 +[jn2o5_a] N2O5 + hv -> NO2 + 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 +********************************* +[jalknit->,jch3ooh] ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK +[jalkooh->,jch3ooh] ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 + 0.8*MEK + OH +[jbenzooh->,jch3ooh] BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 +[jbepomuc->,.10*jno2] BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO +[jbigald->,0.2*jno2] BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 + 0.18*CH3COCHO +[jbigald1->,.14*jno2] BIGALD1 + hv -> 0.6*MALO2 + HO2 +[jbigald2->,.20*jno2] BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 +[jbigald3->,.20*jno2] BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 +[jbigald4->,.006*jno2] BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 +[jbzooh->,jch3ooh] BZOOH + hv -> BZALD + OH + HO2 +[jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH +[jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 +[jc6h5ooh->,jch3ooh] C6H5OOH + hv -> PHENO + OH +[jch2o_b] CH2O + hv -> CO + H2 +[jch2o_a] CH2O + hv -> CO + 2*H +[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 +[jhonitr->,jch2o_a] HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + 0.17*CH3COCH3 +[jhpald->,.006*jno2] HPALD + hv -> BIGALD3 + OH + HO2 +[jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O +[jisopnooh->,jch3ooh] ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + CH2O + HO2 +[jmacr_b] MACR + hv -> 0.66*HO2 + 1.34*CO +[jmacr_a] MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 +[jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 +[jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO +[jmpan->,jpan] MPAN + hv -> MCO3 + NO2 +[jmvk] MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 +[jnc4cho->,jch2o_a] NC4CHO + hv -> BIGALD3 + NO2 + HO2 +[jnoa->,jch2o_a] NOA + hv -> NO2 + CH2O + CH3CO3 +[jnterpooh->,jch3ooh] NTERPOOH + hv -> TERPROD1 + NO2 + OH +[jonitr->,jch3cho] ONITR + hv -> NO2 +[jpan] PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 +[jphenooh->,jch3ooh] PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL +[jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH +[jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH +[jtepomuc->,.10*jno2] TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO +[jterp2ooh->,jch3ooh] TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 + TERPROD2 + HO2 + 0.25*GLYALD +[jterpnit->,jch3ooh] TERPNIT + hv -> TERPROD1 + NO2 + HO2 +[jterpooh->,jch3ooh] TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH +[jterprd1->,jch3cho] TERPROD1 + hv -> HO2 + CO + TERPROD2 +[jterprd2->,jch3cho] TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO +[jtolooh->,jch3ooh] TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 +[jxooh->,jch3ooh] XOOH + hv -> OH +[jxylenooh->,jch3ooh] XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 +[jxylolooh->,jch3ooh] XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 +********************************* +*** 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 -> 2*CL + COFCL +[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 +[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 +[jcof2] COF2 + hv -> 2*F +[jcofcl] COFCL + hv -> F + CL +[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 +********************************* +[jsoabb1_a1->,.0004*jno2] soabb1_a1 + hv -> +[jsoabb1_a2->,.0004*jno2] soabb1_a2 + hv -> +[jsoabb2_a1->,.0004*jno2] soabb2_a1 + hv -> +[jsoabb2_a2->,.0004*jno2] soabb2_a2 + hv -> +[jsoabb3_a1->,.0004*jno2] soabb3_a1 + hv -> +[jsoabb3_a2->,.0004*jno2] soabb3_a2 + hv -> +[jsoabb4_a1->,.0004*jno2] soabb4_a1 + hv -> +[jsoabb4_a2->,.0004*jno2] soabb4_a2 + hv -> +[jsoabb5_a1->,.0004*jno2] soabb5_a1 + hv -> +[jsoabb5_a2->,.0004*jno2] soabb5_a2 + hv -> +[jsoabg1_a1->,.0004*jno2] soabg1_a1 + hv -> +[jsoabg1_a2->,.0004*jno2] soabg1_a2 + hv -> +[jsoabg2_a1->,.0004*jno2] soabg2_a1 + hv -> +[jsoabg2_a2->,.0004*jno2] soabg2_a2 + hv -> +[jsoabg3_a1->,.0004*jno2] soabg3_a1 + hv -> +[jsoabg3_a2->,.0004*jno2] soabg3_a2 + hv -> +[jsoabg4_a1->,.0004*jno2] soabg4_a1 + hv -> +[jsoabg4_a2->,.0004*jno2] soabg4_a2 + hv -> +[jsoabg5_a1->,.0004*jno2] soabg5_a1 + hv -> +[jsoabg5_a2->,.0004*jno2] soabg5_a2 + hv -> +[jsoaff1_a1->,.0004*jno2] soaff1_a1 + hv -> +[jsoaff1_a2->,.0004*jno2] soaff1_a2 + hv -> +[jsoaff2_a1->,.0004*jno2] soaff2_a1 + hv -> +[jsoaff2_a2->,.0004*jno2] soaff2_a2 + hv -> +[jsoaff3_a1->,.0004*jno2] soaff3_a1 + hv -> +[jsoaff3_a2->,.0004*jno2] soaff3_a2 + hv -> +[jsoaff4_a1->,.0004*jno2] soaff4_a1 + hv -> +[jsoaff4_a2->,.0004*jno2] soaff4_a2 + hv -> +[jsoaff5_a1->,.0004*jno2] soaff5_a1 + hv -> +[jsoaff5_a2->,.0004*jno2] soaff5_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 +[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 -> 2*CL + COFCL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 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 +********************************* +*** odd-fluorine +********************************* +[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 +[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 +[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 +[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 +[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 +[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 +********************************* +*** 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, -1110 +[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 + COFCL ; 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 + COFCL ; 1.794e-10 +[O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.3e-10 +[O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.65e-11 +********************************* +*** C1 +********************************* +[CH2O_HO2] CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625 +[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 +[HCN_OH] HCN + OH + M -> HO2 + M ; 6.1e-33, 1.5, 9.8e-15, -4.6, 0.8 +[HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4e-13 +[HOCH2OO_HO2] HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 +[HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.4e+12, -7000 +[HOCH2OO_NO] HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265 +[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 +[O1D_HCN] O1D + HCN -> OH ; 1.08e-10, 105 +[usr_CO_OH] CO + OH -> CO2 + HO2 +********************************* +*** C2 +********************************* +[C2H2_CL_M] C2H2 + CL + M -> CL + M ; 5.2e-30, 2.4, 2.2e-10, 0.7, 0.6 +[C2H2_OH_M] C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 + 0.35*CO + M ; 5.5e-30, 0, 8.3e-13, -2, 0.6 +[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 +[CH3CN_OH] CH3CN + OH -> HO2 ; 7.8e-13, -1050 +[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 +********************************* +[BIGENE_NO3] BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 ; 3.5e-13 +[BIGENE_OH] BIGENE + OH -> ENEO2 ; 5.4e-11 +[ENEO2_NO] ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 ; 4.8e-12, 120 +[ENEO2_NOb] ENEO2 + NO -> HONITR ; 5.1e-14, 693 +[HONITR_OH] HONITR + OH -> ONITR + HO2 ; 2e-12 +[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 -> HONITR ; 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 +[MEKO2_HO2] MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 ; 7.5e-13, 700 +[MEKO2_NO] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180 +[MEK_OH] MEK + OH -> MEKO2 ; 2.3e-12, -170 +[MEKOOH_OH] MEKOOH + OH -> MEKO2 ; 3.8e-12, 200 +[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 +[usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M +[usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M +********************************* +*** C5 +********************************* +[ALKNIT_OH] ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 ; 1.6e-12 +[ALKO2_HO2] ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700 +[ALKO2_NO] ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK + NO2 ; 6.7e-12 +[ALKO2_NOb] ALKO2 + NO -> ALKNIT ; 5.4e-14, 870 +[ALKOOH_OH] ALKOOH + OH -> ALKO2 ; 3.8e-12, 200 +[BIGALK_OH] BIGALK + OH -> ALKO2 ; 3.5e-12 +[HPALD_OH] HPALD + OH -> XO2 ; 1.86e-11, 175 +[HYDRALD_OH] HYDRALD + OH -> XO2 ; 1.86e-11, 175 +[IEPOX_OH] IEPOX + OH -> XO2 ; 1.3e-11 +[ISOPAO2_CH3CO3] ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 ; 1.4e-11 +[ISOPAO2_CH3O2] ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR + 0.44*MVK ; 5e-13, 400 +[ISOPAO2_HO2] ISOPAO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPAO2_NO] ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK + 0.92*CH2O + 0.92*HO2 ; 4.4e-12, 180 +[ISOPAO2_NO3] ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 ; 2.4e-12 +[ISOPBO2_CH3CO3] ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 ; 1.4e-11 +[ISOPBO2_CH3O2] ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD ; 5e-13, 400 +[ISOPBO2_HO2] ISOPBO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPBO2_M] ISOPBO2 -> HPALD + HO2 ; 1.6e+09, -8300 +[ISOPBO2_NO] ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 4.4e-12, 180 +[ISOPBO2_NO3] ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 2.4e-12 +[ISOPNITA_OH] ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O + 0.3*HONITR + 0.3*HO2 ; 4e-11 +[ISOPNITB_OH] ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR ; 4e-11 +[ISOP_NO3] ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446 +[ISOPNO3_CH3CO3] ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 ; 1.4e-11 +[ISOPNO3_CH3O2] ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH + 0.2*NC4CH2OH ; 5e-13, 400 +[ISOPNO3_HO2] ISOPNO3 + HO2 -> ISOPNOOH ; 8e-13, 700 +[ISOPNO3_NO] ISOPNO3 + NO -> NC4CHO + NO2 + HO2 ; 2.7e-12, 360 +[ISOPNO3_NO3] ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 ; 2.4e-12 +[ISOPNOOH_OH] ISOPNOOH + OH -> NOA + HO2 ; 4e-11 +[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 -> 0.6*ISOPAO2 + 0.4*ISOPBO2 ; 2.54e-11, 410 +[ISOPOOH_OH] ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH ; 1.52e-11, 200 +[NC4CH2OH_OH] NC4CH2OH + OH -> GLYALD + NOA + HO2 ; 7e-11 +[NC4CHO_OH] NC4CHO + OH -> GLYOXAL + NOA + HO2 ; 1e-10 +[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 +********************************* +*** C7 +********************************* +[ACBZO2_HO2] ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH ; 4.3e-13, 1040 +[ACBZO2_NO] ACBZO2 + NO -> C6H5O2 + NO2 ; 7.5e-12, 290 +[BENZENE_OH] BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 ; 2.3e-12, -193 +[BENZO2_HO2] BENZO2 + HO2 -> BENZOOH ; 7.5e-13, 700 +[BENZO2_NO] BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 ; 2.6e-12, 365 +[BENZOOH_OH] BENZOOH + OH -> BENZO2 ; 3.8e-12, 200 +[BZALD_OH] BZALD + OH -> ACBZO2 ; 5.9e-12, 225 +[BZOO_HO2] BZOO + HO2 -> BZOOH ; 7.5e-13, 700 +[BZOOH_OH] BZOOH + OH -> BZOO ; 3.8e-12, 200 +[BZOO_NO] BZOO + NO -> BZALD + NO2 + HO2 ; 2.6e-12, 365 +[C6H5O2_HO2] C6H5O2 + HO2 -> C6H5OOH ; 7.5e-13, 700 +[C6H5O2_NO] C6H5O2 + NO -> PHENO + NO2 ; 2.6e-12, 365 +[C6H5OOH_OH] C6H5OOH + OH -> C6H5O2 ; 3.8e-12, 200 +[CRESOL_OH] CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO ; 4.7e-11 +[DICARBO2_HO2] DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO + 0.33*CH3O2 ; 4.3e-13, 1040 +[DICARBO2_NO] DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO + 0.83*CH3O2 ; 7.5e-12, 290 +[DICARBO2_NO2] DICARBO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MALO2_HO2] MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO ; 4.3e-13, 1040 +[MALO2_NO] MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 ; 7.5e-12, 290 +[MALO2_NO2] MALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MDIALO2_HO2] MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO + 0.07*CH3O2 + 0.07*GLYOXAL ; 4.3e-13, 1040 +[MDIALO2_NO] MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO + 0.17*CH3O2 + 0.17*GLYOXAL ; 7.5e-12, 290 +[MDIALO2_NO2] MDIALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[PHENO2_HO2] PHENO2 + HO2 -> PHENOOH ; 7.5e-13, 700 +[PHENO2_NO] PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 ; 2.6e-12, 365 +[PHENOL_OH] PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO ; 4.7e-13, 1220 +[PHENO_NO2] PHENO + NO2 -> 1*NDEP ; 2.1e-12 +[PHENO_O3] PHENO + O3 -> C6H5O2 ; 2.8e-13 +[PHENOOH_OH] PHENOOH + OH -> PHENO2 ; 3.8e-12, 200 +[tag_ACBZO2_NO2] ACBZO2 + NO2 + M -> PBZNIT + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[TOLO2_HO2] TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700 +[TOLO2_NO] TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 ; 2.6e-12, 365 +[TOLOOH_OH] TOLOOH + OH -> TOLO2 ; 3.8e-12, 200 +[TOLUENE_OH] TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 + 0.28*HO2 ; 1.7e-12, 352 +[usr_PBZNIT_M] PBZNIT + M -> ACBZO2 + NO2 + M +[XYLENES_OH] XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO + 0.56*XYLENO2 + 0.38*HO2 ; 1.7e-11 +[XYLENO2_HO2] XYLENO2 + HO2 -> XYLENOOH ; 7.5e-13, 700 +[XYLENO2_NO] XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 ; 2.6e-12, 365 +[XYLENOOH_OH] XYLENOOH + OH -> XYLENO2 ; 3.8e-12, 200 +[XYLOLO2_HO2] XYLOLO2 + HO2 -> XYLOLOOH ; 7.5e-13, 700 +[XYLOLO2_NO] XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO ; 2.6e-12, 365 +[XYLOL_OH] XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO ; 8.4e-11 +[XYLOLOOH_OH] XYLOLOOH + OH -> XYLOLO2 ; 3.8e-12, 200 +********************************* +*** C10 +********************************* +[BCARY_NO3] BCARY + NO3 -> NTERPO2 ; 1.9e-11 +[BCARY_O3] BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 1.2e-14 +[BCARY_OH] BCARY + OH -> TERPO2 ; 2e-10 +[MTERP_NO3] MTERP + NO3 -> NTERPO2 ; 1.2e-12, 490 +[MTERP_O3] MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 6.3e-16, -580 +[MTERP_OH] MTERP + OH -> TERPO2 ; 1.2e-11, 440 +[NTERPO2_CH3O2] NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 + 0.5*TERPROD1 + 0.5*NO2 ; 2e-12, 500 +[NTERPO2_HO2] NTERPO2 + HO2 -> NTERPOOH ; 7.5e-13, 700 +[NTERPO2_NO] NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP ; 4.2e-12, 180 +[NTERPO2_NO3] NTERPO2 + NO3 -> 2*NO2 + TERPROD1 ; 2.4e-12 +[NTERPOOH_OH] NTERPOOH + OH -> NTERPO2 ; 2e-11 +[TERP2O2_CH3O2] TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + 0.15*CH3COCH3 ; 2e-12, 500 +[TERP2O2_HO2] TERP2O2 + HO2 -> TERP2OOH ; 7.5e-13, 700 +[TERP2O2_NO] TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + 0.225*GLYALD ; 4.2e-12, 180 +[TERP2OOH_OH] TERP2OOH + OH -> TERP2O2 ; 2.3e-11 +[TERPNIT_OH] TERPNIT + OH -> NO2 + TERPROD1 ; 2e-11 +[TERPO2_CH3O2] TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 + 0.025*CH3COCH3 ; 2e-12, 500 +[TERPO2_HO2] TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700 +[TERPO2_NO] TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 + 0.8*TERPROD1 + 0.8*HO2 ; 4.2e-12, 180 +[TERPOOH_OH] TERPOOH + OH -> TERPO2 ; 3.3e-11 +[TERPROD1_NO3] TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP ; 1e-12 +[TERPROD1_OH] TERPROD1 + OH -> TERP2O2 ; 5.7e-11 +[TERPROD2_OH] TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO ; 3.4e-11 +********************************* +*** 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 -> 0.5*H2O2 +[usr_HONITR_aer] HONITR -> HNO3 +[usr_ISOPNITA_aer] ISOPNITA -> HNO3 +[usr_ISOPNITB_aer] ISOPNITB -> HNO3 +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NC4CH2OH_aer] NC4CH2OH -> HNO3 +[usr_NC4CHO_aer] NC4CHO -> 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_NTERPOOH_aer] NTERPOOH -> HNO3 +[usr_ONITR_aer] ONITR -> HNO3 +[usr_TERPNIT_aer] TERPNIT -> HNO3 +********************************* +*** SOA +********************************* +[BCARY_NO3_vbs] BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 ; 1.9e-11 +[BCARYO2_HO2_vbs] BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 ; 2.75e-13, 1300 +[BCARYO2_NO_vbs] BCARYO2VBS + NO -> NO + 0.1279*SOAGbg0 + 0.1792*SOAGbg1 + 0.0676*SOAGbg2 + 0.079*SOAGbg3 + 0.1254*SOAGbg4 ; 2.7e-12, 360 +[BCARY_O3_vbs] BCARY + O3 -> BCARY + O3 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 ; 1.2e-14 +[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + BCARYO2VBS ; 2e-10 +[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + BENZO2VBS ; 2.3e-12, -193 +[BENZO2_HO2_vbs] BENZO2VBS + HO2 -> HO2 + 0.0023*SOAGff0 + 0.0008*SOAGff1 + 0.0843*SOAGff2 + 0.0443*SOAGff3 + 0.1621*SOAGff4 ; 7.5e-13, 700 +[BENZO2_NO_vbs] BENZO2VBS + NO -> NO + 0.0097*SOAGff0 + 0.0034*SOAGff1 + 0.1579*SOAGff2 + 0.0059*SOAGff3 + 0.0536*SOAGff4 ; 2.6e-12, 365 +[ISOP_NO3_vbs] ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAGbg3 + 0.025024*SOAGbg4 ; 3.03e-12, -446 +[ISOPO2_HO2_vbs] ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAGbg0 + 0.0035*SOAGbg1 + 0.0003*SOAGbg2 + 0.0271*SOAGbg3 + 0.0474*SOAGbg4 ; 2.12e-13, 1300 +[ISOPO2_NO_vbs] ISOPO2VBS + NO -> NO + 0.0003*SOAGbg0 + 0.0003*SOAGbg1 + 0.0073*SOAGbg2 + 0.0057*SOAGbg3 + 0.0623*SOAGbg4 ; 2.7e-12, 350 +[ISOP_O3_vbs] ISOP + O3 -> ISOP + O3 + 0.0033*SOAGbg3 ; 1.05e-14, -2000 +[ISOP_OH_vbs] ISOP + OH -> ISOP + OH + ISOPO2VBS ; 2.54e-11, 410 +[IVOCbbO2_HO2_vbs] IVOCbbO2VBS + HO2 -> HO2 + 0.2381*SOAGbb0 + 0.1308*SOAGbb1 + 0.0348*SOAGbb2 + 0.0076*SOAGbb3 + 0.0113*SOAGbb4 ; 7.5e-13, 700 +[IVOCbbO2_NO_vbs] IVOCbbO2VBS + NO -> NO + 0.1056*SOAGbb0 + 0.1026*SOAGbb1 + 0.0521*SOAGbb2 + 0.0143*SOAGbb3 + 0.0166*SOAGbb4 ; 2.6e-12, 365 +[IVOCbb_OH_vbs] IVOCbb + OH -> OH + IVOCbbO2VBS ; 1.34e-11 +[IVOCffO2_HO2_vbs] IVOCffO2VBS + HO2 -> HO2 + 0.2381*SOAGff0 + 0.1308*SOAGff1 + 0.0348*SOAGff2 + 0.0076*SOAGff3 + 0.0113*SOAGff4 ; 7.5e-13, 700 +[IVOCffO2_NO_vbs] IVOCffO2VBS + NO -> NO + 0.1056*SOAGff0 + 0.1026*SOAGff1 + 0.0521*SOAGff2 + 0.0143*SOAGff3 + 0.0166*SOAGff4 ; 2.6e-12, 365 +[IVOCff_OH_vbs] IVOCff + OH -> OH + IVOCffO2VBS ; 1.34e-11 +[MTERP_NO3_vbs] MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 ; 1.2e-12, 490 +[MTERPO2_HO2_vbs] MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 ; 2.6e-13, 1300 +[MTERPO2_NO_vbs] MTERPO2VBS + NO -> NO + 0.0245*SOAGbg0 + 0.0082*SOAGbg1 + 0.0772*SOAGbg2 + 0.0332*SOAGbg3 + 0.13*SOAGbg4 ; 2.7e-12, 360 +[MTERP_O3_vbs] MTERP + O3 -> MTERP + O3 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 ; 6.3e-16, -580 +[MTERP_OH_vbs] MTERP + OH -> MTERP + OH + MTERPO2VBS ; 1.2e-11, 440 +[SVOCbb_OH] SVOCbb + OH -> OH + 0.5931*SOAGbb0 + 0.1534*SOAGbb1 + 0.0459*SOAGbb2 + 0.0085*SOAGbb3 + 0.0128*SOAGbb4 ; 1.34e-11 +[SVOCff_OH] SVOCff + OH -> OH + 0.5931*SOAGff0 + 0.1534*SOAGff1 + 0.0459*SOAGff2 + 0.0085*SOAGff3 + 0.0128*SOAGff4 ; 1.34e-11 +[TOLUENE_OH_vbs] TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS ; 1.7e-12, 352 +[TOLUO2_HO2_vbs] TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAGff0 + 0.0101*SOAGff1 + 0.0763*SOAGff2 + 0.2157*SOAGff3 + 0.0738*SOAGff4 ; 7.5e-13, 700 +[TOLUO2_NO_vbs] TOLUO2VBS + NO -> NO + 0.0154*SOAGff0 + 0.0452*SOAGff1 + 0.0966*SOAGff2 + 0.0073*SOAGff3 + 0.238*SOAGff4 ; 2.6e-12, 365 +[usr_GLYOXAL_aer] GLYOXAL -> SOAGbg0 +[XYLENES_OH_vbs] XYLENES + OH -> XYLENES + OH + XYLEO2VBS ; 1.7e-11 +[XYLEO2_HO2_vbs] XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAGff0 + 0.0174*SOAGff1 + 0.086*SOAGff2 + 0.0512*SOAGff3 + 0.1598*SOAGff4 ; 7.5e-13, 700 +[XYLEO2_NO_vbs] XYLEO2VBS + NO -> NO + 0.0063*SOAGff0 + 0.0237*SOAGff1 + 0.0025*SOAGff2 + 0.011*SOAGff3 + 0.1185*SOAGff4 ; 2.6e-12, 365 +********************************* +*** 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 + End Reactions + + Ext Forcing + bc_a1 <- dataset + bc_a4 <- dataset + CO <- dataset + NO <- dataset + NO2 <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset + num_a5 <- dataset + SO2 <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + so4_a5 <- dataset + SVOCbb <- dataset + SVOCff <- dataset + pomff1_a4 <- dataset + pombb1_a4 <- dataset + AOA_NH + N + OH + 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_vbsext/chem_mods.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/chem_mods.F90 new file mode 100644 index 0000000000..efb5aeeabc --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/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 = 143, & ! number of photolysis reactions + rxntot = 562, & ! number of total reactions + gascnt = 419, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 263, & ! number of "gas phase" species + nfs = 3, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 2365, & ! number of non-zero matrix entries + extcnt = 20, & ! 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 = 261, & ! 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 = 562, & + enthalpy_cnt = 18, & + nslvd = 34 + 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_vbsext/m_rxt_id.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/m_rxt_id.F90 new file mode 100644 index 0000000000..dab363e8f7 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/m_rxt_id.F90 @@ -0,0 +1,565 @@ + 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_b = 13 + integer, parameter :: rid_jn2o5_a = 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_jalknit = 19 + integer, parameter :: rid_jalkooh = 20 + integer, parameter :: rid_jbenzooh = 21 + integer, parameter :: rid_jbepomuc = 22 + integer, parameter :: rid_jbigald = 23 + integer, parameter :: rid_jbigald1 = 24 + integer, parameter :: rid_jbigald2 = 25 + integer, parameter :: rid_jbigald3 = 26 + integer, parameter :: rid_jbigald4 = 27 + integer, parameter :: rid_jbzooh = 28 + integer, parameter :: rid_jc2h5ooh = 29 + integer, parameter :: rid_jc3h7ooh = 30 + integer, parameter :: rid_jc6h5ooh = 31 + integer, parameter :: rid_jch2o_b = 32 + integer, parameter :: rid_jch2o_a = 33 + integer, parameter :: rid_jch3cho = 34 + integer, parameter :: rid_jacet = 35 + integer, parameter :: rid_jmgly = 36 + integer, parameter :: rid_jch3co3h = 37 + integer, parameter :: rid_jch3ooh = 38 + integer, parameter :: rid_jch4_b = 39 + integer, parameter :: rid_jch4_a = 40 + integer, parameter :: rid_jco2 = 41 + integer, parameter :: rid_jeooh = 42 + integer, parameter :: rid_jglyald = 43 + integer, parameter :: rid_jglyoxal = 44 + integer, parameter :: rid_jhonitr = 45 + integer, parameter :: rid_jhpald = 46 + integer, parameter :: rid_jhyac = 47 + integer, parameter :: rid_jisopnooh = 48 + integer, parameter :: rid_jisopooh = 49 + integer, parameter :: rid_jmacr_b = 50 + integer, parameter :: rid_jmacr_a = 51 + integer, parameter :: rid_jmek = 52 + integer, parameter :: rid_jmekooh = 53 + integer, parameter :: rid_jmpan = 54 + integer, parameter :: rid_jmvk = 55 + integer, parameter :: rid_jnc4cho = 56 + integer, parameter :: rid_jnoa = 57 + integer, parameter :: rid_jnterpooh = 58 + integer, parameter :: rid_jonitr = 59 + integer, parameter :: rid_jpan = 60 + integer, parameter :: rid_jphenooh = 61 + integer, parameter :: rid_jpooh = 62 + integer, parameter :: rid_jrooh = 63 + integer, parameter :: rid_jtepomuc = 64 + integer, parameter :: rid_jterp2ooh = 65 + integer, parameter :: rid_jterpnit = 66 + integer, parameter :: rid_jterpooh = 67 + integer, parameter :: rid_jterprd1 = 68 + integer, parameter :: rid_jterprd2 = 69 + integer, parameter :: rid_jtolooh = 70 + integer, parameter :: rid_jxooh = 71 + integer, parameter :: rid_jxylenooh = 72 + integer, parameter :: rid_jxylolooh = 73 + integer, parameter :: rid_jbrcl = 74 + integer, parameter :: rid_jbro = 75 + integer, parameter :: rid_jbrono2_b = 76 + integer, parameter :: rid_jbrono2_a = 77 + integer, parameter :: rid_jccl4 = 78 + integer, parameter :: rid_jcf2clbr = 79 + integer, parameter :: rid_jcf3br = 80 + integer, parameter :: rid_jcfcl3 = 81 + integer, parameter :: rid_jcfc113 = 82 + integer, parameter :: rid_jcfc114 = 83 + integer, parameter :: rid_jcfc115 = 84 + integer, parameter :: rid_jcf2cl2 = 85 + integer, parameter :: rid_jch2br2 = 86 + integer, parameter :: rid_jch3br = 87 + integer, parameter :: rid_jch3ccl3 = 88 + integer, parameter :: rid_jch3cl = 89 + integer, parameter :: rid_jchbr3 = 90 + integer, parameter :: rid_jcl2 = 91 + integer, parameter :: rid_jcl2o2 = 92 + integer, parameter :: rid_jclo = 93 + integer, parameter :: rid_jclono2_b = 94 + integer, parameter :: rid_jclono2_a = 95 + integer, parameter :: rid_jcof2 = 96 + integer, parameter :: rid_jcofcl = 97 + integer, parameter :: rid_jh2402 = 98 + integer, parameter :: rid_jhbr = 99 + integer, parameter :: rid_jhcfc141b = 100 + integer, parameter :: rid_jhcfc142b = 101 + integer, parameter :: rid_jhcfc22 = 102 + integer, parameter :: rid_jhcl = 103 + integer, parameter :: rid_jhf = 104 + integer, parameter :: rid_jhobr = 105 + integer, parameter :: rid_jhocl = 106 + integer, parameter :: rid_joclo = 107 + integer, parameter :: rid_jsf6 = 108 + integer, parameter :: rid_jh2so4 = 109 + integer, parameter :: rid_jocs = 110 + integer, parameter :: rid_jso = 111 + integer, parameter :: rid_jso2 = 112 + integer, parameter :: rid_jso3 = 113 + integer, parameter :: rid_jsoabb1_a1 = 114 + integer, parameter :: rid_jsoabb1_a2 = 115 + integer, parameter :: rid_jsoabb2_a1 = 116 + integer, parameter :: rid_jsoabb2_a2 = 117 + integer, parameter :: rid_jsoabb3_a1 = 118 + integer, parameter :: rid_jsoabb3_a2 = 119 + integer, parameter :: rid_jsoabb4_a1 = 120 + integer, parameter :: rid_jsoabb4_a2 = 121 + integer, parameter :: rid_jsoabb5_a1 = 122 + integer, parameter :: rid_jsoabb5_a2 = 123 + integer, parameter :: rid_jsoabg1_a1 = 124 + integer, parameter :: rid_jsoabg1_a2 = 125 + integer, parameter :: rid_jsoabg2_a1 = 126 + integer, parameter :: rid_jsoabg2_a2 = 127 + integer, parameter :: rid_jsoabg3_a1 = 128 + integer, parameter :: rid_jsoabg3_a2 = 129 + integer, parameter :: rid_jsoabg4_a1 = 130 + integer, parameter :: rid_jsoabg4_a2 = 131 + integer, parameter :: rid_jsoabg5_a1 = 132 + integer, parameter :: rid_jsoabg5_a2 = 133 + integer, parameter :: rid_jsoaff1_a1 = 134 + integer, parameter :: rid_jsoaff1_a2 = 135 + integer, parameter :: rid_jsoaff2_a1 = 136 + integer, parameter :: rid_jsoaff2_a2 = 137 + integer, parameter :: rid_jsoaff3_a1 = 138 + integer, parameter :: rid_jsoaff3_a2 = 139 + integer, parameter :: rid_jsoaff4_a1 = 140 + integer, parameter :: rid_jsoaff4_a2 = 141 + integer, parameter :: rid_jsoaff5_a1 = 142 + integer, parameter :: rid_jsoaff5_a2 = 143 + integer, parameter :: rid_O1D_H2 = 144 + integer, parameter :: rid_O1D_H2O = 145 + integer, parameter :: rid_O1D_N2 = 146 + integer, parameter :: rid_O1D_O2ab = 147 + integer, parameter :: rid_O1D_O3 = 148 + integer, parameter :: rid_O_O3 = 149 + integer, parameter :: rid_usr_O_O = 150 + integer, parameter :: rid_usr_O_O2 = 151 + integer, parameter :: rid_H2_O = 152 + integer, parameter :: rid_H2O2_O = 153 + integer, parameter :: rid_H_HO2 = 154 + integer, parameter :: rid_H_HO2a = 155 + integer, parameter :: rid_H_HO2b = 156 + integer, parameter :: rid_H_O2 = 157 + integer, parameter :: rid_HO2_O = 158 + integer, parameter :: rid_HO2_O3 = 159 + integer, parameter :: rid_H_O3 = 160 + integer, parameter :: rid_OH_H2 = 161 + integer, parameter :: rid_OH_H2O2 = 162 + integer, parameter :: rid_OH_HO2 = 163 + integer, parameter :: rid_OH_O = 164 + integer, parameter :: rid_OH_O3 = 165 + integer, parameter :: rid_OH_OH = 166 + integer, parameter :: rid_OH_OH_M = 167 + integer, parameter :: rid_usr_HO2_HO2 = 168 + integer, parameter :: rid_HO2NO2_OH = 169 + integer, parameter :: rid_N_NO = 170 + integer, parameter :: rid_N_NO2a = 171 + integer, parameter :: rid_N_NO2b = 172 + integer, parameter :: rid_N_NO2c = 173 + integer, parameter :: rid_N_O2 = 174 + integer, parameter :: rid_NO2_O = 175 + integer, parameter :: rid_NO2_O3 = 176 + integer, parameter :: rid_NO2_O_M = 177 + integer, parameter :: rid_NO3_HO2 = 178 + integer, parameter :: rid_NO3_NO = 179 + integer, parameter :: rid_NO3_O = 180 + integer, parameter :: rid_NO3_OH = 181 + integer, parameter :: rid_N_OH = 182 + integer, parameter :: rid_NO_HO2 = 183 + integer, parameter :: rid_NO_O3 = 184 + integer, parameter :: rid_NO_O_M = 185 + integer, parameter :: rid_O1D_N2Oa = 186 + integer, parameter :: rid_O1D_N2Ob = 187 + integer, parameter :: rid_tag_NO2_HO2 = 188 + integer, parameter :: rid_tag_NO2_NO3 = 189 + integer, parameter :: rid_tag_NO2_OH = 190 + integer, parameter :: rid_usr_HNO3_OH = 191 + integer, parameter :: rid_usr_HO2NO2_M = 192 + integer, parameter :: rid_usr_N2O5_M = 193 + integer, parameter :: rid_CL_CH2O = 194 + integer, parameter :: rid_CL_CH4 = 195 + integer, parameter :: rid_CL_H2 = 196 + integer, parameter :: rid_CL_H2O2 = 197 + integer, parameter :: rid_CL_HO2a = 198 + integer, parameter :: rid_CL_HO2b = 199 + integer, parameter :: rid_CL_O3 = 200 + integer, parameter :: rid_CLO_CH3O2 = 201 + integer, parameter :: rid_CLO_CLOa = 202 + integer, parameter :: rid_CLO_CLOb = 203 + integer, parameter :: rid_CLO_CLOc = 204 + integer, parameter :: rid_CLO_HO2 = 205 + integer, parameter :: rid_CLO_NO = 206 + integer, parameter :: rid_CLONO2_CL = 207 + integer, parameter :: rid_CLO_NO2_M = 208 + integer, parameter :: rid_CLONO2_O = 209 + integer, parameter :: rid_CLONO2_OH = 210 + integer, parameter :: rid_CLO_O = 211 + integer, parameter :: rid_CLO_OHa = 212 + integer, parameter :: rid_CLO_OHb = 213 + integer, parameter :: rid_HCL_O = 214 + integer, parameter :: rid_HCL_OH = 215 + integer, parameter :: rid_HOCL_CL = 216 + integer, parameter :: rid_HOCL_O = 217 + integer, parameter :: rid_HOCL_OH = 218 + integer, parameter :: rid_O1D_CCL4 = 219 + integer, parameter :: rid_O1D_CF2CLBR = 220 + integer, parameter :: rid_O1D_CFC11 = 221 + integer, parameter :: rid_O1D_CFC113 = 222 + integer, parameter :: rid_O1D_CFC114 = 223 + integer, parameter :: rid_O1D_CFC115 = 224 + integer, parameter :: rid_O1D_CFC12 = 225 + integer, parameter :: rid_O1D_HCLa = 226 + integer, parameter :: rid_O1D_HCLb = 227 + integer, parameter :: rid_tag_CLO_CLO_M = 228 + integer, parameter :: rid_usr_CL2O2_M = 229 + integer, parameter :: rid_BR_CH2O = 230 + integer, parameter :: rid_BR_HO2 = 231 + integer, parameter :: rid_BR_O3 = 232 + integer, parameter :: rid_BRO_BRO = 233 + integer, parameter :: rid_BRO_CLOa = 234 + integer, parameter :: rid_BRO_CLOb = 235 + integer, parameter :: rid_BRO_CLOc = 236 + integer, parameter :: rid_BRO_HO2 = 237 + integer, parameter :: rid_BRO_NO = 238 + integer, parameter :: rid_BRO_NO2_M = 239 + integer, parameter :: rid_BRONO2_O = 240 + integer, parameter :: rid_BRO_O = 241 + integer, parameter :: rid_BRO_OH = 242 + integer, parameter :: rid_HBR_O = 243 + integer, parameter :: rid_HBR_OH = 244 + integer, parameter :: rid_HOBR_O = 245 + integer, parameter :: rid_O1D_CF3BR = 246 + integer, parameter :: rid_O1D_CHBR3 = 247 + integer, parameter :: rid_O1D_H2402 = 248 + integer, parameter :: rid_O1D_HBRa = 249 + integer, parameter :: rid_O1D_HBRb = 250 + integer, parameter :: rid_F_CH4 = 251 + integer, parameter :: rid_F_H2 = 252 + integer, parameter :: rid_F_H2O = 253 + integer, parameter :: rid_F_HNO3 = 254 + integer, parameter :: rid_O1D_COF2 = 255 + integer, parameter :: rid_O1D_COFCL = 256 + integer, parameter :: rid_CH2BR2_CL = 257 + integer, parameter :: rid_CH2BR2_OH = 258 + integer, parameter :: rid_CH3BR_CL = 259 + integer, parameter :: rid_CH3BR_OH = 260 + integer, parameter :: rid_CH3CCL3_OH = 261 + integer, parameter :: rid_CH3CL_CL = 262 + integer, parameter :: rid_CH3CL_OH = 263 + integer, parameter :: rid_CHBR3_CL = 264 + integer, parameter :: rid_CHBR3_OH = 265 + integer, parameter :: rid_HCFC141B_OH = 266 + integer, parameter :: rid_HCFC142B_OH = 267 + integer, parameter :: rid_HCFC22_OH = 268 + integer, parameter :: rid_O1D_CH2BR2 = 269 + integer, parameter :: rid_O1D_CH3BR = 270 + integer, parameter :: rid_O1D_HCFC141B = 271 + integer, parameter :: rid_O1D_HCFC142B = 272 + integer, parameter :: rid_O1D_HCFC22 = 273 + integer, parameter :: rid_CH2O_HO2 = 274 + integer, parameter :: rid_CH2O_NO3 = 275 + integer, parameter :: rid_CH2O_O = 276 + integer, parameter :: rid_CH2O_OH = 277 + integer, parameter :: rid_CH3O2_CH3O2a = 278 + integer, parameter :: rid_CH3O2_CH3O2b = 279 + integer, parameter :: rid_CH3O2_HO2 = 280 + integer, parameter :: rid_CH3O2_NO = 281 + integer, parameter :: rid_CH3OH_OH = 282 + integer, parameter :: rid_CH3OOH_OH = 283 + integer, parameter :: rid_CH4_OH = 284 + integer, parameter :: rid_HCN_OH = 285 + integer, parameter :: rid_HCOOH_OH = 286 + integer, parameter :: rid_HOCH2OO_HO2 = 287 + integer, parameter :: rid_HOCH2OO_M = 288 + integer, parameter :: rid_HOCH2OO_NO = 289 + integer, parameter :: rid_O1D_CH4a = 290 + integer, parameter :: rid_O1D_CH4b = 291 + integer, parameter :: rid_O1D_CH4c = 292 + integer, parameter :: rid_O1D_HCN = 293 + integer, parameter :: rid_usr_CO_OH = 294 + integer, parameter :: rid_C2H2_CL_M = 295 + integer, parameter :: rid_C2H2_OH_M = 296 + integer, parameter :: rid_C2H4_CL_M = 297 + integer, parameter :: rid_C2H4_O3 = 298 + integer, parameter :: rid_C2H5O2_C2H5O2 = 299 + integer, parameter :: rid_C2H5O2_CH3O2 = 300 + integer, parameter :: rid_C2H5O2_HO2 = 301 + integer, parameter :: rid_C2H5O2_NO = 302 + integer, parameter :: rid_C2H5OH_OH = 303 + integer, parameter :: rid_C2H5OOH_OH = 304 + integer, parameter :: rid_C2H6_CL = 305 + integer, parameter :: rid_C2H6_OH = 306 + integer, parameter :: rid_CH3CHO_NO3 = 307 + integer, parameter :: rid_CH3CHO_OH = 308 + integer, parameter :: rid_CH3CN_OH = 309 + integer, parameter :: rid_CH3CO3_CH3CO3 = 310 + integer, parameter :: rid_CH3CO3_CH3O2 = 311 + integer, parameter :: rid_CH3CO3_HO2 = 312 + integer, parameter :: rid_CH3CO3_NO = 313 + integer, parameter :: rid_CH3COOH_OH = 314 + integer, parameter :: rid_CH3COOOH_OH = 315 + integer, parameter :: rid_EO2_HO2 = 316 + integer, parameter :: rid_EO2_NO = 317 + integer, parameter :: rid_EO_M = 318 + integer, parameter :: rid_EO_O2 = 319 + integer, parameter :: rid_GLYALD_OH = 320 + integer, parameter :: rid_GLYOXAL_OH = 321 + integer, parameter :: rid_PAN_OH = 322 + integer, parameter :: rid_tag_C2H4_OH = 323 + integer, parameter :: rid_tag_CH3CO3_NO2 = 324 + integer, parameter :: rid_usr_PAN_M = 325 + integer, parameter :: rid_C3H6_NO3 = 326 + integer, parameter :: rid_C3H6_O3 = 327 + integer, parameter :: rid_C3H7O2_CH3O2 = 328 + integer, parameter :: rid_C3H7O2_HO2 = 329 + integer, parameter :: rid_C3H7O2_NO = 330 + integer, parameter :: rid_C3H7OOH_OH = 331 + integer, parameter :: rid_C3H8_OH = 332 + integer, parameter :: rid_CH3COCHO_NO3 = 333 + integer, parameter :: rid_CH3COCHO_OH = 334 + integer, parameter :: rid_HYAC_OH = 335 + integer, parameter :: rid_NOA_OH = 336 + integer, parameter :: rid_PO2_HO2 = 337 + integer, parameter :: rid_PO2_NO = 338 + integer, parameter :: rid_POOH_OH = 339 + integer, parameter :: rid_RO2_CH3O2 = 340 + integer, parameter :: rid_RO2_HO2 = 341 + integer, parameter :: rid_RO2_NO = 342 + integer, parameter :: rid_ROOH_OH = 343 + integer, parameter :: rid_tag_C3H6_OH = 344 + integer, parameter :: rid_usr_CH3COCH3_OH = 345 + integer, parameter :: rid_BIGENE_NO3 = 346 + integer, parameter :: rid_BIGENE_OH = 347 + integer, parameter :: rid_ENEO2_NO = 348 + integer, parameter :: rid_ENEO2_NOb = 349 + integer, parameter :: rid_HONITR_OH = 350 + integer, parameter :: rid_MACRO2_CH3CO3 = 351 + integer, parameter :: rid_MACRO2_CH3O2 = 352 + integer, parameter :: rid_MACRO2_HO2 = 353 + integer, parameter :: rid_MACRO2_NO3 = 354 + integer, parameter :: rid_MACRO2_NOa = 355 + integer, parameter :: rid_MACRO2_NOb = 356 + integer, parameter :: rid_MACR_O3 = 357 + integer, parameter :: rid_MACR_OH = 358 + integer, parameter :: rid_MACROOH_OH = 359 + integer, parameter :: rid_MCO3_CH3CO3 = 360 + integer, parameter :: rid_MCO3_CH3O2 = 361 + integer, parameter :: rid_MCO3_HO2 = 362 + integer, parameter :: rid_MCO3_MCO3 = 363 + integer, parameter :: rid_MCO3_NO = 364 + integer, parameter :: rid_MCO3_NO3 = 365 + integer, parameter :: rid_MEKO2_HO2 = 366 + integer, parameter :: rid_MEKO2_NO = 367 + integer, parameter :: rid_MEK_OH = 368 + integer, parameter :: rid_MEKOOH_OH = 369 + integer, parameter :: rid_MPAN_OH_M = 370 + integer, parameter :: rid_MVK_O3 = 371 + integer, parameter :: rid_MVK_OH = 372 + integer, parameter :: rid_usr_MCO3_NO2 = 373 + integer, parameter :: rid_usr_MPAN_M = 374 + integer, parameter :: rid_ALKNIT_OH = 375 + integer, parameter :: rid_ALKO2_HO2 = 376 + integer, parameter :: rid_ALKO2_NO = 377 + integer, parameter :: rid_ALKO2_NOb = 378 + integer, parameter :: rid_ALKOOH_OH = 379 + integer, parameter :: rid_BIGALK_OH = 380 + integer, parameter :: rid_HPALD_OH = 381 + integer, parameter :: rid_HYDRALD_OH = 382 + integer, parameter :: rid_IEPOX_OH = 383 + integer, parameter :: rid_ISOPAO2_CH3CO3 = 384 + integer, parameter :: rid_ISOPAO2_CH3O2 = 385 + integer, parameter :: rid_ISOPAO2_HO2 = 386 + integer, parameter :: rid_ISOPAO2_NO = 387 + integer, parameter :: rid_ISOPAO2_NO3 = 388 + integer, parameter :: rid_ISOPBO2_CH3CO3 = 389 + integer, parameter :: rid_ISOPBO2_CH3O2 = 390 + integer, parameter :: rid_ISOPBO2_HO2 = 391 + integer, parameter :: rid_ISOPBO2_M = 392 + integer, parameter :: rid_ISOPBO2_NO = 393 + integer, parameter :: rid_ISOPBO2_NO3 = 394 + integer, parameter :: rid_ISOPNITA_OH = 395 + integer, parameter :: rid_ISOPNITB_OH = 396 + integer, parameter :: rid_ISOP_NO3 = 397 + integer, parameter :: rid_ISOPNO3_CH3CO3 = 398 + integer, parameter :: rid_ISOPNO3_CH3O2 = 399 + integer, parameter :: rid_ISOPNO3_HO2 = 400 + integer, parameter :: rid_ISOPNO3_NO = 401 + integer, parameter :: rid_ISOPNO3_NO3 = 402 + integer, parameter :: rid_ISOPNOOH_OH = 403 + integer, parameter :: rid_ISOP_O3 = 404 + integer, parameter :: rid_ISOP_OH = 405 + integer, parameter :: rid_ISOPOOH_OH = 406 + integer, parameter :: rid_NC4CH2OH_OH = 407 + integer, parameter :: rid_NC4CHO_OH = 408 + integer, parameter :: rid_XO2_CH3CO3 = 409 + integer, parameter :: rid_XO2_CH3O2 = 410 + integer, parameter :: rid_XO2_HO2 = 411 + integer, parameter :: rid_XO2_NO = 412 + integer, parameter :: rid_XO2_NO3 = 413 + integer, parameter :: rid_XOOH_OH = 414 + integer, parameter :: rid_ACBZO2_HO2 = 415 + integer, parameter :: rid_ACBZO2_NO = 416 + integer, parameter :: rid_BENZENE_OH = 417 + integer, parameter :: rid_BENZO2_HO2 = 418 + integer, parameter :: rid_BENZO2_NO = 419 + integer, parameter :: rid_BENZOOH_OH = 420 + integer, parameter :: rid_BZALD_OH = 421 + integer, parameter :: rid_BZOO_HO2 = 422 + integer, parameter :: rid_BZOOH_OH = 423 + integer, parameter :: rid_BZOO_NO = 424 + integer, parameter :: rid_C6H5O2_HO2 = 425 + integer, parameter :: rid_C6H5O2_NO = 426 + integer, parameter :: rid_C6H5OOH_OH = 427 + integer, parameter :: rid_CRESOL_OH = 428 + integer, parameter :: rid_DICARBO2_HO2 = 429 + integer, parameter :: rid_DICARBO2_NO = 430 + integer, parameter :: rid_DICARBO2_NO2 = 431 + integer, parameter :: rid_MALO2_HO2 = 432 + integer, parameter :: rid_MALO2_NO = 433 + integer, parameter :: rid_MALO2_NO2 = 434 + integer, parameter :: rid_MDIALO2_HO2 = 435 + integer, parameter :: rid_MDIALO2_NO = 436 + integer, parameter :: rid_MDIALO2_NO2 = 437 + integer, parameter :: rid_PHENO2_HO2 = 438 + integer, parameter :: rid_PHENO2_NO = 439 + integer, parameter :: rid_PHENOL_OH = 440 + integer, parameter :: rid_PHENO_NO2 = 441 + integer, parameter :: rid_PHENO_O3 = 442 + integer, parameter :: rid_PHENOOH_OH = 443 + integer, parameter :: rid_tag_ACBZO2_NO2 = 444 + integer, parameter :: rid_TOLO2_HO2 = 445 + integer, parameter :: rid_TOLO2_NO = 446 + integer, parameter :: rid_TOLOOH_OH = 447 + integer, parameter :: rid_TOLUENE_OH = 448 + integer, parameter :: rid_usr_PBZNIT_M = 449 + integer, parameter :: rid_XYLENES_OH = 450 + integer, parameter :: rid_XYLENO2_HO2 = 451 + integer, parameter :: rid_XYLENO2_NO = 452 + integer, parameter :: rid_XYLENOOH_OH = 453 + integer, parameter :: rid_XYLOLO2_HO2 = 454 + integer, parameter :: rid_XYLOLO2_NO = 455 + integer, parameter :: rid_XYLOL_OH = 456 + integer, parameter :: rid_XYLOLOOH_OH = 457 + integer, parameter :: rid_BCARY_NO3 = 458 + integer, parameter :: rid_BCARY_O3 = 459 + integer, parameter :: rid_BCARY_OH = 460 + integer, parameter :: rid_MTERP_NO3 = 461 + integer, parameter :: rid_MTERP_O3 = 462 + integer, parameter :: rid_MTERP_OH = 463 + integer, parameter :: rid_NTERPO2_CH3O2 = 464 + integer, parameter :: rid_NTERPO2_HO2 = 465 + integer, parameter :: rid_NTERPO2_NO = 466 + integer, parameter :: rid_NTERPO2_NO3 = 467 + integer, parameter :: rid_NTERPOOH_OH = 468 + integer, parameter :: rid_TERP2O2_CH3O2 = 469 + integer, parameter :: rid_TERP2O2_HO2 = 470 + integer, parameter :: rid_TERP2O2_NO = 471 + integer, parameter :: rid_TERP2OOH_OH = 472 + integer, parameter :: rid_TERPNIT_OH = 473 + integer, parameter :: rid_TERPO2_CH3O2 = 474 + integer, parameter :: rid_TERPO2_HO2 = 475 + integer, parameter :: rid_TERPO2_NO = 476 + integer, parameter :: rid_TERPOOH_OH = 477 + integer, parameter :: rid_TERPROD1_NO3 = 478 + integer, parameter :: rid_TERPROD1_OH = 479 + integer, parameter :: rid_TERPROD2_OH = 480 + integer, parameter :: rid_DMS_NO3 = 481 + integer, parameter :: rid_DMS_OHa = 482 + integer, parameter :: rid_OCS_O = 483 + integer, parameter :: rid_OCS_OH = 484 + integer, parameter :: rid_S_O2 = 485 + integer, parameter :: rid_SO2_OH_M = 486 + integer, parameter :: rid_S_O3 = 487 + integer, parameter :: rid_SO_BRO = 488 + integer, parameter :: rid_SO_CLO = 489 + integer, parameter :: rid_S_OH = 490 + integer, parameter :: rid_SO_NO2 = 491 + integer, parameter :: rid_SO_O2 = 492 + integer, parameter :: rid_SO_O3 = 493 + integer, parameter :: rid_SO_OCLO = 494 + integer, parameter :: rid_SO_OH = 495 + integer, parameter :: rid_usr_DMS_OH = 496 + integer, parameter :: rid_usr_SO3_H2O = 497 + integer, parameter :: rid_NH3_OH = 498 + integer, parameter :: rid_usr_HO2_aer = 499 + integer, parameter :: rid_usr_HONITR_aer = 500 + integer, parameter :: rid_usr_ISOPNITA_aer = 501 + integer, parameter :: rid_usr_ISOPNITB_aer = 502 + integer, parameter :: rid_usr_N2O5_aer = 503 + integer, parameter :: rid_usr_NC4CH2OH_aer = 504 + integer, parameter :: rid_usr_NC4CHO_aer = 505 + integer, parameter :: rid_usr_NH4_strat_tau = 506 + integer, parameter :: rid_usr_NO2_aer = 507 + integer, parameter :: rid_usr_NO3_aer = 508 + integer, parameter :: rid_usr_NTERPOOH_aer = 509 + integer, parameter :: rid_usr_ONITR_aer = 510 + integer, parameter :: rid_usr_TERPNIT_aer = 511 + integer, parameter :: rid_BCARY_NO3_vbs = 512 + integer, parameter :: rid_BCARYO2_HO2_vbs = 513 + integer, parameter :: rid_BCARYO2_NO_vbs = 514 + integer, parameter :: rid_BCARY_O3_vbs = 515 + integer, parameter :: rid_BCARY_OH_vbs = 516 + integer, parameter :: rid_BENZENE_OH_vbs = 517 + integer, parameter :: rid_BENZO2_HO2_vbs = 518 + integer, parameter :: rid_BENZO2_NO_vbs = 519 + integer, parameter :: rid_ISOP_NO3_vbs = 520 + integer, parameter :: rid_ISOPO2_HO2_vbs = 521 + integer, parameter :: rid_ISOPO2_NO_vbs = 522 + integer, parameter :: rid_ISOP_O3_vbs = 523 + integer, parameter :: rid_ISOP_OH_vbs = 524 + integer, parameter :: rid_IVOCbbO2_HO2_vbs = 525 + integer, parameter :: rid_IVOCbbO2_NO_vbs = 526 + integer, parameter :: rid_IVOCbb_OH_vbs = 527 + integer, parameter :: rid_IVOCffO2_HO2_vbs = 528 + integer, parameter :: rid_IVOCffO2_NO_vbs = 529 + integer, parameter :: rid_IVOCff_OH_vbs = 530 + integer, parameter :: rid_MTERP_NO3_vbs = 531 + integer, parameter :: rid_MTERPO2_HO2_vbs = 532 + integer, parameter :: rid_MTERPO2_NO_vbs = 533 + integer, parameter :: rid_MTERP_O3_vbs = 534 + integer, parameter :: rid_MTERP_OH_vbs = 535 + integer, parameter :: rid_SVOCbb_OH = 536 + integer, parameter :: rid_SVOCff_OH = 537 + integer, parameter :: rid_TOLUENE_OH_vbs = 538 + integer, parameter :: rid_TOLUO2_HO2_vbs = 539 + integer, parameter :: rid_TOLUO2_NO_vbs = 540 + integer, parameter :: rid_usr_GLYOXAL_aer = 541 + integer, parameter :: rid_XYLENES_OH_vbs = 542 + integer, parameter :: rid_XYLEO2_HO2_vbs = 543 + integer, parameter :: rid_XYLEO2_NO_vbs = 544 + integer, parameter :: rid_het1 = 545 + integer, parameter :: rid_het10 = 546 + integer, parameter :: rid_het11 = 547 + integer, parameter :: rid_het12 = 548 + integer, parameter :: rid_het13 = 549 + integer, parameter :: rid_het14 = 550 + integer, parameter :: rid_het15 = 551 + integer, parameter :: rid_het16 = 552 + integer, parameter :: rid_het17 = 553 + integer, parameter :: rid_het2 = 554 + integer, parameter :: rid_het3 = 555 + integer, parameter :: rid_het4 = 556 + integer, parameter :: rid_het5 = 557 + integer, parameter :: rid_het6 = 558 + integer, parameter :: rid_het7 = 559 + integer, parameter :: rid_het8 = 560 + integer, parameter :: rid_het9 = 561 + integer, parameter :: rid_E90_tau = 562 + end module m_rxt_id diff --git a/src/chemistry/pp_trop_strat_mam5_vbsext/m_spc_id.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/m_spc_id.F90 new file mode 100644 index 0000000000..1dd1e376b5 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/m_spc_id.F90 @@ -0,0 +1,266 @@ + module m_spc_id + implicit none + integer, parameter :: id_ALKNIT = 1 + integer, parameter :: id_ALKOOH = 2 + integer, parameter :: id_AOA_NH = 3 + integer, parameter :: id_bc_a1 = 4 + integer, parameter :: id_bc_a4 = 5 + integer, parameter :: id_BCARY = 6 + integer, parameter :: id_BCARYO2VBS = 7 + integer, parameter :: id_BENZENE = 8 + integer, parameter :: id_BENZO2VBS = 9 + integer, parameter :: id_BENZOOH = 10 + integer, parameter :: id_BEPOMUC = 11 + integer, parameter :: id_BIGALD = 12 + integer, parameter :: id_BIGALD1 = 13 + integer, parameter :: id_BIGALD2 = 14 + integer, parameter :: id_BIGALD3 = 15 + integer, parameter :: id_BIGALD4 = 16 + integer, parameter :: id_BIGALK = 17 + integer, parameter :: id_BIGENE = 18 + integer, parameter :: id_BR = 19 + integer, parameter :: id_BRCL = 20 + integer, parameter :: id_BRO = 21 + integer, parameter :: id_BRONO2 = 22 + integer, parameter :: id_BRY = 23 + integer, parameter :: id_BZALD = 24 + integer, parameter :: id_BZOOH = 25 + integer, parameter :: id_C2H2 = 26 + integer, parameter :: id_C2H4 = 27 + integer, parameter :: id_C2H5OH = 28 + integer, parameter :: id_C2H5OOH = 29 + integer, parameter :: id_C2H6 = 30 + integer, parameter :: id_C3H6 = 31 + integer, parameter :: id_C3H7OOH = 32 + integer, parameter :: id_C3H8 = 33 + integer, parameter :: id_C6H5OOH = 34 + integer, parameter :: id_CCL4 = 35 + integer, parameter :: id_CF2CLBR = 36 + integer, parameter :: id_CF3BR = 37 + integer, parameter :: id_CFC11 = 38 + integer, parameter :: id_CFC113 = 39 + integer, parameter :: id_CFC114 = 40 + integer, parameter :: id_CFC115 = 41 + integer, parameter :: id_CFC12 = 42 + integer, parameter :: id_CH2BR2 = 43 + integer, parameter :: id_CH2O = 44 + integer, parameter :: id_CH3BR = 45 + integer, parameter :: id_CH3CCL3 = 46 + integer, parameter :: id_CH3CHO = 47 + integer, parameter :: id_CH3CL = 48 + integer, parameter :: id_CH3CN = 49 + integer, parameter :: id_CH3COCH3 = 50 + integer, parameter :: id_CH3COCHO = 51 + integer, parameter :: id_CH3COOH = 52 + integer, parameter :: id_CH3COOOH = 53 + integer, parameter :: id_CH3OH = 54 + integer, parameter :: id_CH3OOH = 55 + integer, parameter :: id_CH4 = 56 + integer, parameter :: id_CHBR3 = 57 + integer, parameter :: id_CL = 58 + integer, parameter :: id_CL2 = 59 + integer, parameter :: id_CL2O2 = 60 + integer, parameter :: id_CLO = 61 + integer, parameter :: id_CLONO2 = 62 + integer, parameter :: id_CLY = 63 + integer, parameter :: id_CO = 64 + integer, parameter :: id_CO2 = 65 + integer, parameter :: id_COF2 = 66 + integer, parameter :: id_COFCL = 67 + integer, parameter :: id_CRESOL = 68 + integer, parameter :: id_DMS = 69 + integer, parameter :: id_dst_a1 = 70 + integer, parameter :: id_dst_a2 = 71 + integer, parameter :: id_dst_a3 = 72 + integer, parameter :: id_E90 = 73 + integer, parameter :: id_EOOH = 74 + integer, parameter :: id_F = 75 + integer, parameter :: id_GLYALD = 76 + integer, parameter :: id_GLYOXAL = 77 + integer, parameter :: id_H = 78 + integer, parameter :: id_H2 = 79 + integer, parameter :: id_H2402 = 80 + integer, parameter :: id_H2O2 = 81 + integer, parameter :: id_H2SO4 = 82 + integer, parameter :: id_HBR = 83 + integer, parameter :: id_HCFC141B = 84 + integer, parameter :: id_HCFC142B = 85 + integer, parameter :: id_HCFC22 = 86 + integer, parameter :: id_HCL = 87 + integer, parameter :: id_HCN = 88 + integer, parameter :: id_HCOOH = 89 + integer, parameter :: id_HF = 90 + integer, parameter :: id_HNO3 = 91 + integer, parameter :: id_HO2NO2 = 92 + integer, parameter :: id_HOBR = 93 + integer, parameter :: id_HOCL = 94 + integer, parameter :: id_HONITR = 95 + integer, parameter :: id_HPALD = 96 + integer, parameter :: id_HYAC = 97 + integer, parameter :: id_HYDRALD = 98 + integer, parameter :: id_IEPOX = 99 + integer, parameter :: id_ISOP = 100 + integer, parameter :: id_ISOPNITA = 101 + integer, parameter :: id_ISOPNITB = 102 + integer, parameter :: id_ISOPNO3 = 103 + integer, parameter :: id_ISOPNOOH = 104 + integer, parameter :: id_ISOPO2VBS = 105 + integer, parameter :: id_ISOPOOH = 106 + integer, parameter :: id_IVOCbb = 107 + integer, parameter :: id_IVOCbbO2VBS = 108 + integer, parameter :: id_IVOCff = 109 + integer, parameter :: id_IVOCffO2VBS = 110 + integer, parameter :: id_MACR = 111 + integer, parameter :: id_MACROOH = 112 + integer, parameter :: id_MEK = 113 + integer, parameter :: id_MEKOOH = 114 + integer, parameter :: id_MPAN = 115 + integer, parameter :: id_MTERP = 116 + integer, parameter :: id_MTERPO2VBS = 117 + integer, parameter :: id_MVK = 118 + integer, parameter :: id_N = 119 + integer, parameter :: id_N2O = 120 + integer, parameter :: id_N2O5 = 121 + integer, parameter :: id_NC4CH2OH = 122 + integer, parameter :: id_NC4CHO = 123 + integer, parameter :: id_ncl_a1 = 124 + integer, parameter :: id_ncl_a2 = 125 + integer, parameter :: id_ncl_a3 = 126 + integer, parameter :: id_NH3 = 127 + integer, parameter :: id_NH4 = 128 + integer, parameter :: id_NO = 129 + integer, parameter :: id_NO2 = 130 + integer, parameter :: id_NO3 = 131 + integer, parameter :: id_NOA = 132 + integer, parameter :: id_NTERPOOH = 133 + integer, parameter :: id_num_a1 = 134 + integer, parameter :: id_num_a2 = 135 + integer, parameter :: id_num_a3 = 136 + integer, parameter :: id_num_a4 = 137 + integer, parameter :: id_num_a5 = 138 + integer, parameter :: id_O = 139 + integer, parameter :: id_O3 = 140 + integer, parameter :: id_O3S = 141 + integer, parameter :: id_OCLO = 142 + integer, parameter :: id_OCS = 143 + integer, parameter :: id_ONITR = 144 + integer, parameter :: id_PAN = 145 + integer, parameter :: id_PBZNIT = 146 + integer, parameter :: id_PHENO = 147 + integer, parameter :: id_PHENOL = 148 + integer, parameter :: id_PHENOOH = 149 + integer, parameter :: id_pombb1_a1 = 150 + integer, parameter :: id_pombb1_a4 = 151 + integer, parameter :: id_pomff1_a1 = 152 + integer, parameter :: id_pomff1_a4 = 153 + integer, parameter :: id_POOH = 154 + integer, parameter :: id_ROOH = 155 + integer, parameter :: id_S = 156 + integer, parameter :: id_SF6 = 157 + integer, parameter :: id_SO = 158 + integer, parameter :: id_SO2 = 159 + integer, parameter :: id_SO3 = 160 + integer, parameter :: id_so4_a1 = 161 + integer, parameter :: id_so4_a2 = 162 + integer, parameter :: id_so4_a3 = 163 + integer, parameter :: id_so4_a5 = 164 + integer, parameter :: id_soabb1_a1 = 165 + integer, parameter :: id_soabb1_a2 = 166 + integer, parameter :: id_soabb2_a1 = 167 + integer, parameter :: id_soabb2_a2 = 168 + integer, parameter :: id_soabb3_a1 = 169 + integer, parameter :: id_soabb3_a2 = 170 + integer, parameter :: id_soabb4_a1 = 171 + integer, parameter :: id_soabb4_a2 = 172 + integer, parameter :: id_soabb5_a1 = 173 + integer, parameter :: id_soabb5_a2 = 174 + integer, parameter :: id_soabg1_a1 = 175 + integer, parameter :: id_soabg1_a2 = 176 + integer, parameter :: id_soabg2_a1 = 177 + integer, parameter :: id_soabg2_a2 = 178 + integer, parameter :: id_soabg3_a1 = 179 + integer, parameter :: id_soabg3_a2 = 180 + integer, parameter :: id_soabg4_a1 = 181 + integer, parameter :: id_soabg4_a2 = 182 + integer, parameter :: id_soabg5_a1 = 183 + integer, parameter :: id_soabg5_a2 = 184 + integer, parameter :: id_soaff1_a1 = 185 + integer, parameter :: id_soaff1_a2 = 186 + integer, parameter :: id_soaff2_a1 = 187 + integer, parameter :: id_soaff2_a2 = 188 + integer, parameter :: id_soaff3_a1 = 189 + integer, parameter :: id_soaff3_a2 = 190 + integer, parameter :: id_soaff4_a1 = 191 + integer, parameter :: id_soaff4_a2 = 192 + integer, parameter :: id_soaff5_a1 = 193 + integer, parameter :: id_soaff5_a2 = 194 + integer, parameter :: id_SOAGbb0 = 195 + integer, parameter :: id_SOAGbb1 = 196 + integer, parameter :: id_SOAGbb2 = 197 + integer, parameter :: id_SOAGbb3 = 198 + integer, parameter :: id_SOAGbb4 = 199 + integer, parameter :: id_SOAGbg0 = 200 + integer, parameter :: id_SOAGbg1 = 201 + integer, parameter :: id_SOAGbg2 = 202 + integer, parameter :: id_SOAGbg3 = 203 + integer, parameter :: id_SOAGbg4 = 204 + integer, parameter :: id_SOAGff0 = 205 + integer, parameter :: id_SOAGff1 = 206 + integer, parameter :: id_SOAGff2 = 207 + integer, parameter :: id_SOAGff3 = 208 + integer, parameter :: id_SOAGff4 = 209 + integer, parameter :: id_SVOCbb = 210 + integer, parameter :: id_SVOCff = 211 + integer, parameter :: id_TEPOMUC = 212 + integer, parameter :: id_TERP2OOH = 213 + integer, parameter :: id_TERPNIT = 214 + integer, parameter :: id_TERPOOH = 215 + integer, parameter :: id_TERPROD1 = 216 + integer, parameter :: id_TERPROD2 = 217 + integer, parameter :: id_TOLOOH = 218 + integer, parameter :: id_TOLUENE = 219 + integer, parameter :: id_TOLUO2VBS = 220 + integer, parameter :: id_XOOH = 221 + integer, parameter :: id_XYLENES = 222 + integer, parameter :: id_XYLENOOH = 223 + integer, parameter :: id_XYLEO2VBS = 224 + integer, parameter :: id_XYLOL = 225 + integer, parameter :: id_XYLOLOOH = 226 + integer, parameter :: id_NHDEP = 227 + integer, parameter :: id_NDEP = 228 + integer, parameter :: id_ACBZO2 = 229 + integer, parameter :: id_ALKO2 = 230 + integer, parameter :: id_BENZO2 = 231 + integer, parameter :: id_BZOO = 232 + integer, parameter :: id_C2H5O2 = 233 + integer, parameter :: id_C3H7O2 = 234 + integer, parameter :: id_C6H5O2 = 235 + integer, parameter :: id_CH3CO3 = 236 + integer, parameter :: id_CH3O2 = 237 + integer, parameter :: id_DICARBO2 = 238 + integer, parameter :: id_ENEO2 = 239 + integer, parameter :: id_EO = 240 + integer, parameter :: id_EO2 = 241 + integer, parameter :: id_HO2 = 242 + integer, parameter :: id_HOCH2OO = 243 + integer, parameter :: id_ISOPAO2 = 244 + integer, parameter :: id_ISOPBO2 = 245 + integer, parameter :: id_MACRO2 = 246 + integer, parameter :: id_MALO2 = 247 + integer, parameter :: id_MCO3 = 248 + integer, parameter :: id_MDIALO2 = 249 + integer, parameter :: id_MEKO2 = 250 + integer, parameter :: id_NTERPO2 = 251 + integer, parameter :: id_O1D = 252 + integer, parameter :: id_OH = 253 + integer, parameter :: id_PHENO2 = 254 + integer, parameter :: id_PO2 = 255 + integer, parameter :: id_RO2 = 256 + integer, parameter :: id_TERP2O2 = 257 + integer, parameter :: id_TERPO2 = 258 + integer, parameter :: id_TOLO2 = 259 + integer, parameter :: id_XO2 = 260 + integer, parameter :: id_XYLENO2 = 261 + integer, parameter :: id_XYLOLO2 = 262 + integer, parameter :: id_H2O = 263 + end module m_spc_id diff --git a/src/chemistry/pp_trop_strat_mam5_vbsext/mo_adjrxt.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_adjrxt.F90 new file mode 100644 index 0000000000..c6eb47be1d --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_adjrxt.F90 @@ -0,0 +1,433 @@ + 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(:,:, 146) = rate(:,:, 146) * inv(:,:, 3) + rate(:,:, 147) = rate(:,:, 147) * inv(:,:, 2) + rate(:,:, 150) = rate(:,:, 150) * inv(:,:, 1) + rate(:,:, 167) = rate(:,:, 167) * inv(:,:, 1) + rate(:,:, 174) = rate(:,:, 174) * inv(:,:, 2) + rate(:,:, 177) = rate(:,:, 177) * inv(:,:, 1) + rate(:,:, 185) = rate(:,:, 185) * inv(:,:, 1) + rate(:,:, 188) = rate(:,:, 188) * inv(:,:, 1) + rate(:,:, 189) = rate(:,:, 189) * inv(:,:, 1) + rate(:,:, 190) = rate(:,:, 190) * inv(:,:, 1) + rate(:,:, 192) = rate(:,:, 192) * inv(:,:, 1) + rate(:,:, 193) = rate(:,:, 193) * inv(:,:, 1) + rate(:,:, 208) = rate(:,:, 208) * inv(:,:, 1) + rate(:,:, 228) = rate(:,:, 228) * inv(:,:, 1) + rate(:,:, 229) = rate(:,:, 229) * inv(:,:, 1) + rate(:,:, 239) = rate(:,:, 239) * inv(:,:, 1) + rate(:,:, 285) = rate(:,:, 285) * inv(:,:, 1) + rate(:,:, 295) = rate(:,:, 295) * inv(:,:, 1) + rate(:,:, 296) = rate(:,:, 296) * inv(:,:, 1) + rate(:,:, 297) = rate(:,:, 297) * inv(:,:, 1) + rate(:,:, 319) = rate(:,:, 319) * inv(:,:, 2) + rate(:,:, 323) = rate(:,:, 323) * inv(:,:, 1) + rate(:,:, 324) = rate(:,:, 324) * inv(:,:, 1) + rate(:,:, 325) = rate(:,:, 325) * inv(:,:, 1) + rate(:,:, 344) = rate(:,:, 344) * inv(:,:, 1) + rate(:,:, 370) = rate(:,:, 370) * inv(:,:, 1) + rate(:,:, 373) = rate(:,:, 373) * inv(:,:, 1) + rate(:,:, 374) = rate(:,:, 374) * inv(:,:, 1) + rate(:,:, 431) = rate(:,:, 431) * inv(:,:, 1) + rate(:,:, 434) = rate(:,:, 434) * inv(:,:, 1) + rate(:,:, 437) = rate(:,:, 437) * inv(:,:, 1) + rate(:,:, 444) = rate(:,:, 444) * inv(:,:, 1) + rate(:,:, 449) = rate(:,:, 449) * inv(:,:, 1) + rate(:,:, 485) = rate(:,:, 485) * inv(:,:, 2) + rate(:,:, 486) = rate(:,:, 486) * inv(:,:, 1) + rate(:,:, 492) = rate(:,:, 492) * inv(:,:, 2) + rate(:,:, 151) = rate(:,:, 151) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 157) = rate(:,:, 157) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 144) = rate(:,:, 144) * m(:,:) + rate(:,:, 145) = rate(:,:, 145) * m(:,:) + rate(:,:, 148) = rate(:,:, 148) * m(:,:) + rate(:,:, 149) = rate(:,:, 149) * m(:,:) + rate(:,:, 150) = rate(:,:, 150) * 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(:,:, 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(:,:, 172) = rate(:,:, 172) * m(:,:) + rate(:,:, 173) = rate(:,:, 173) * 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(:,:, 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(:,:, 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * 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(:,:, 252) = rate(:,:, 252) * 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(:,:, 289) = rate(:,:, 289) * m(:,:) + rate(:,:, 290) = rate(:,:, 290) * m(:,:) + rate(:,:, 291) = rate(:,:, 291) * m(:,:) + rate(:,:, 292) = rate(:,:, 292) * 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(:,:, 320) = rate(:,:, 320) * m(:,:) + rate(:,:, 321) = rate(:,:, 321) * m(:,:) + rate(:,:, 322) = rate(:,:, 322) * m(:,:) + rate(:,:, 323) = rate(:,:, 323) * m(:,:) + rate(:,:, 324) = rate(:,:, 324) * m(:,:) + rate(:,:, 326) = rate(:,:, 326) * m(:,:) + rate(:,:, 327) = rate(:,:, 327) * m(:,:) + rate(:,:, 328) = rate(:,:, 328) * m(:,:) + rate(:,:, 329) = rate(:,:, 329) * 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(:,:, 336) = rate(:,:, 336) * m(:,:) + rate(:,:, 337) = rate(:,:, 337) * m(:,:) + rate(:,:, 338) = rate(:,:, 338) * m(:,:) + rate(:,:, 339) = rate(:,:, 339) * m(:,:) + rate(:,:, 340) = rate(:,:, 340) * m(:,:) + rate(:,:, 341) = rate(:,:, 341) * m(:,:) + rate(:,:, 342) = rate(:,:, 342) * m(:,:) + rate(:,:, 343) = rate(:,:, 343) * m(:,:) + rate(:,:, 344) = rate(:,:, 344) * m(:,:) + rate(:,:, 345) = rate(:,:, 345) * m(:,:) + rate(:,:, 346) = rate(:,:, 346) * m(:,:) + rate(:,:, 347) = rate(:,:, 347) * m(:,:) + rate(:,:, 348) = rate(:,:, 348) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 352) = rate(:,:, 352) * m(:,:) + rate(:,:, 353) = rate(:,:, 353) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 357) = rate(:,:, 357) * m(:,:) + rate(:,:, 358) = rate(:,:, 358) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + rate(:,:, 360) = rate(:,:, 360) * m(:,:) + rate(:,:, 361) = rate(:,:, 361) * m(:,:) + rate(:,:, 362) = rate(:,:, 362) * m(:,:) + rate(:,:, 363) = rate(:,:, 363) * m(:,:) + rate(:,:, 364) = rate(:,:, 364) * m(:,:) + rate(:,:, 365) = rate(:,:, 365) * m(:,:) + rate(:,:, 366) = rate(:,:, 366) * m(:,:) + rate(:,:, 367) = rate(:,:, 367) * m(:,:) + rate(:,:, 368) = rate(:,:, 368) * m(:,:) + rate(:,:, 369) = rate(:,:, 369) * m(:,:) + rate(:,:, 370) = rate(:,:, 370) * m(:,:) + rate(:,:, 371) = rate(:,:, 371) * m(:,:) + rate(:,:, 372) = rate(:,:, 372) * m(:,:) + rate(:,:, 373) = rate(:,:, 373) * m(:,:) + rate(:,:, 375) = rate(:,:, 375) * m(:,:) + rate(:,:, 376) = rate(:,:, 376) * m(:,:) + rate(:,:, 377) = rate(:,:, 377) * m(:,:) + rate(:,:, 378) = rate(:,:, 378) * m(:,:) + rate(:,:, 379) = rate(:,:, 379) * m(:,:) + rate(:,:, 380) = rate(:,:, 380) * m(:,:) + rate(:,:, 381) = rate(:,:, 381) * m(:,:) + rate(:,:, 382) = rate(:,:, 382) * m(:,:) + rate(:,:, 383) = rate(:,:, 383) * m(:,:) + rate(:,:, 384) = rate(:,:, 384) * m(:,:) + rate(:,:, 385) = rate(:,:, 385) * m(:,:) + rate(:,:, 386) = rate(:,:, 386) * m(:,:) + rate(:,:, 387) = rate(:,:, 387) * m(:,:) + rate(:,:, 388) = rate(:,:, 388) * m(:,:) + rate(:,:, 389) = rate(:,:, 389) * m(:,:) + rate(:,:, 390) = rate(:,:, 390) * m(:,:) + rate(:,:, 391) = rate(:,:, 391) * m(:,:) + rate(:,:, 393) = rate(:,:, 393) * m(:,:) + rate(:,:, 394) = rate(:,:, 394) * m(:,:) + rate(:,:, 395) = rate(:,:, 395) * m(:,:) + rate(:,:, 396) = rate(:,:, 396) * m(:,:) + rate(:,:, 397) = rate(:,:, 397) * m(:,:) + rate(:,:, 398) = rate(:,:, 398) * m(:,:) + rate(:,:, 399) = rate(:,:, 399) * m(:,:) + rate(:,:, 400) = rate(:,:, 400) * m(:,:) + rate(:,:, 401) = rate(:,:, 401) * m(:,:) + rate(:,:, 402) = rate(:,:, 402) * m(:,:) + rate(:,:, 403) = rate(:,:, 403) * m(:,:) + rate(:,:, 404) = rate(:,:, 404) * m(:,:) + rate(:,:, 405) = rate(:,:, 405) * m(:,:) + rate(:,:, 406) = rate(:,:, 406) * m(:,:) + rate(:,:, 407) = rate(:,:, 407) * m(:,:) + rate(:,:, 408) = rate(:,:, 408) * m(:,:) + rate(:,:, 409) = rate(:,:, 409) * m(:,:) + rate(:,:, 410) = rate(:,:, 410) * m(:,:) + rate(:,:, 411) = rate(:,:, 411) * m(:,:) + rate(:,:, 412) = rate(:,:, 412) * m(:,:) + rate(:,:, 413) = rate(:,:, 413) * m(:,:) + rate(:,:, 414) = rate(:,:, 414) * m(:,:) + rate(:,:, 415) = rate(:,:, 415) * m(:,:) + rate(:,:, 416) = rate(:,:, 416) * m(:,:) + rate(:,:, 417) = rate(:,:, 417) * m(:,:) + rate(:,:, 418) = rate(:,:, 418) * m(:,:) + rate(:,:, 419) = rate(:,:, 419) * m(:,:) + rate(:,:, 420) = rate(:,:, 420) * m(:,:) + rate(:,:, 421) = rate(:,:, 421) * m(:,:) + rate(:,:, 422) = rate(:,:, 422) * m(:,:) + rate(:,:, 423) = rate(:,:, 423) * m(:,:) + rate(:,:, 424) = rate(:,:, 424) * m(:,:) + rate(:,:, 425) = rate(:,:, 425) * m(:,:) + rate(:,:, 426) = rate(:,:, 426) * m(:,:) + rate(:,:, 427) = rate(:,:, 427) * m(:,:) + rate(:,:, 428) = rate(:,:, 428) * m(:,:) + rate(:,:, 429) = rate(:,:, 429) * m(:,:) + rate(:,:, 430) = rate(:,:, 430) * m(:,:) + rate(:,:, 431) = rate(:,:, 431) * m(:,:) + rate(:,:, 432) = rate(:,:, 432) * m(:,:) + rate(:,:, 433) = rate(:,:, 433) * m(:,:) + rate(:,:, 434) = rate(:,:, 434) * m(:,:) + rate(:,:, 435) = rate(:,:, 435) * m(:,:) + rate(:,:, 436) = rate(:,:, 436) * m(:,:) + rate(:,:, 437) = rate(:,:, 437) * m(:,:) + rate(:,:, 438) = rate(:,:, 438) * m(:,:) + rate(:,:, 439) = rate(:,:, 439) * m(:,:) + rate(:,:, 440) = rate(:,:, 440) * m(:,:) + rate(:,:, 441) = rate(:,:, 441) * m(:,:) + rate(:,:, 442) = rate(:,:, 442) * m(:,:) + rate(:,:, 443) = rate(:,:, 443) * m(:,:) + rate(:,:, 444) = rate(:,:, 444) * m(:,:) + rate(:,:, 445) = rate(:,:, 445) * m(:,:) + rate(:,:, 446) = rate(:,:, 446) * m(:,:) + rate(:,:, 447) = rate(:,:, 447) * m(:,:) + rate(:,:, 448) = rate(:,:, 448) * m(:,:) + rate(:,:, 450) = rate(:,:, 450) * m(:,:) + rate(:,:, 451) = rate(:,:, 451) * m(:,:) + rate(:,:, 452) = rate(:,:, 452) * m(:,:) + rate(:,:, 453) = rate(:,:, 453) * m(:,:) + rate(:,:, 454) = rate(:,:, 454) * m(:,:) + rate(:,:, 455) = rate(:,:, 455) * m(:,:) + rate(:,:, 456) = rate(:,:, 456) * m(:,:) + rate(:,:, 457) = rate(:,:, 457) * m(:,:) + rate(:,:, 458) = rate(:,:, 458) * m(:,:) + rate(:,:, 459) = rate(:,:, 459) * m(:,:) + rate(:,:, 460) = rate(:,:, 460) * m(:,:) + rate(:,:, 461) = rate(:,:, 461) * m(:,:) + rate(:,:, 462) = rate(:,:, 462) * m(:,:) + rate(:,:, 463) = rate(:,:, 463) * m(:,:) + rate(:,:, 464) = rate(:,:, 464) * m(:,:) + rate(:,:, 465) = rate(:,:, 465) * m(:,:) + rate(:,:, 466) = rate(:,:, 466) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * m(:,:) + rate(:,:, 468) = rate(:,:, 468) * m(:,:) + rate(:,:, 469) = rate(:,:, 469) * m(:,:) + rate(:,:, 470) = rate(:,:, 470) * m(:,:) + rate(:,:, 471) = rate(:,:, 471) * m(:,:) + rate(:,:, 472) = rate(:,:, 472) * m(:,:) + rate(:,:, 473) = rate(:,:, 473) * m(:,:) + rate(:,:, 474) = rate(:,:, 474) * m(:,:) + rate(:,:, 475) = rate(:,:, 475) * m(:,:) + rate(:,:, 476) = rate(:,:, 476) * m(:,:) + rate(:,:, 477) = rate(:,:, 477) * m(:,:) + rate(:,:, 478) = rate(:,:, 478) * m(:,:) + rate(:,:, 479) = rate(:,:, 479) * m(:,:) + rate(:,:, 480) = rate(:,:, 480) * m(:,:) + rate(:,:, 481) = rate(:,:, 481) * m(:,:) + rate(:,:, 482) = rate(:,:, 482) * m(:,:) + rate(:,:, 483) = rate(:,:, 483) * m(:,:) + rate(:,:, 484) = rate(:,:, 484) * m(:,:) + rate(:,:, 486) = rate(:,:, 486) * m(:,:) + rate(:,:, 487) = rate(:,:, 487) * m(:,:) + rate(:,:, 488) = rate(:,:, 488) * m(:,:) + rate(:,:, 489) = rate(:,:, 489) * m(:,:) + rate(:,:, 490) = rate(:,:, 490) * m(:,:) + rate(:,:, 491) = rate(:,:, 491) * m(:,:) + rate(:,:, 493) = rate(:,:, 493) * m(:,:) + rate(:,:, 494) = rate(:,:, 494) * m(:,:) + rate(:,:, 495) = rate(:,:, 495) * m(:,:) + rate(:,:, 496) = rate(:,:, 496) * m(:,:) + rate(:,:, 497) = rate(:,:, 497) * m(:,:) + rate(:,:, 498) = rate(:,:, 498) * m(:,:) + rate(:,:, 512) = rate(:,:, 512) * m(:,:) + rate(:,:, 513) = rate(:,:, 513) * m(:,:) + rate(:,:, 514) = rate(:,:, 514) * m(:,:) + rate(:,:, 515) = rate(:,:, 515) * m(:,:) + rate(:,:, 516) = rate(:,:, 516) * m(:,:) + rate(:,:, 517) = rate(:,:, 517) * m(:,:) + rate(:,:, 518) = rate(:,:, 518) * m(:,:) + rate(:,:, 519) = rate(:,:, 519) * m(:,:) + rate(:,:, 520) = rate(:,:, 520) * m(:,:) + rate(:,:, 521) = rate(:,:, 521) * m(:,:) + rate(:,:, 522) = rate(:,:, 522) * m(:,:) + rate(:,:, 523) = rate(:,:, 523) * m(:,:) + rate(:,:, 524) = rate(:,:, 524) * m(:,:) + rate(:,:, 525) = rate(:,:, 525) * m(:,:) + rate(:,:, 526) = rate(:,:, 526) * m(:,:) + rate(:,:, 527) = rate(:,:, 527) * m(:,:) + rate(:,:, 528) = rate(:,:, 528) * m(:,:) + rate(:,:, 529) = rate(:,:, 529) * m(:,:) + rate(:,:, 530) = rate(:,:, 530) * m(:,:) + rate(:,:, 531) = rate(:,:, 531) * m(:,:) + rate(:,:, 532) = rate(:,:, 532) * m(:,:) + rate(:,:, 533) = rate(:,:, 533) * m(:,:) + rate(:,:, 534) = rate(:,:, 534) * m(:,:) + rate(:,:, 535) = rate(:,:, 535) * m(:,:) + rate(:,:, 536) = rate(:,:, 536) * m(:,:) + rate(:,:, 537) = rate(:,:, 537) * m(:,:) + rate(:,:, 538) = rate(:,:, 538) * m(:,:) + rate(:,:, 539) = rate(:,:, 539) * m(:,:) + rate(:,:, 540) = rate(:,:, 540) * m(:,:) + rate(:,:, 542) = rate(:,:, 542) * m(:,:) + rate(:,:, 543) = rate(:,:, 543) * m(:,:) + rate(:,:, 544) = rate(:,:, 544) * m(:,:) + rate(:,:, 546) = rate(:,:, 546) * m(:,:) + rate(:,:, 551) = rate(:,:, 551) * m(:,:) + rate(:,:, 552) = rate(:,:, 552) * m(:,:) + rate(:,:, 553) = rate(:,:, 553) * m(:,:) + rate(:,:, 556) = rate(:,:, 556) * m(:,:) + rate(:,:, 557) = rate(:,:, 557) * m(:,:) + rate(:,:, 558) = rate(:,:, 558) * m(:,:) + rate(:,:, 561) = rate(:,:, 561) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_trop_strat_mam5_vbsext/mo_exp_sol.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/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_vbsext/mo_imp_sol.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/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_vbsext/mo_indprd.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_indprd.F90 new file mode 100644 index 0000000000..673c1e4e35 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_indprd.F90 @@ -0,0 +1,295 @@ + 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(:,498)*y(:,253)*y(:,127) +rxt(:,506)*y(:,128) + prod(:,2) = (rxt(:,431)*y(:,238) +rxt(:,434)*y(:,247) +rxt(:,437)*y(:,249) + & + rxt(:,441)*y(:,147))*y(:,130) +.500_r8*rxt(:,370)*y(:,253)*y(:,115) & + +.200_r8*rxt(:,466)*y(:,251)*y(:,129) +.500_r8*rxt(:,478)*y(:,216) & + *y(:,131) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,186) = 0._r8 + prod(:,185) = 0._r8 + prod(:,1) = + extfrc(:,18) + prod(:,2) = + extfrc(:,1) + prod(:,3) = + extfrc(:,2) + prod(:,217) = 0._r8 + prod(:,71) = 0._r8 + prod(:,104) = 0._r8 + prod(:,81) = 0._r8 + prod(:,156) = 0._r8 + prod(:,105) = 0._r8 + prod(:,149) = 0._r8 + prod(:,161) = 0._r8 + prod(:,129) = 0._r8 + prod(:,180) = 0._r8 + prod(:,136) = 0._r8 + prod(:,116) = 0._r8 + prod(:,144) = 0._r8 + prod(:,243) = 0._r8 + prod(:,118) = 0._r8 + prod(:,252) = 0._r8 + prod(:,172) = 0._r8 + prod(:,4) = 0._r8 + prod(:,119) = 0._r8 + prod(:,139) = 0._r8 + prod(:,130) = 0._r8 + prod(:,175) = 0._r8 + prod(:,126) = 0._r8 + prod(:,140) = 0._r8 + prod(:,131) = 0._r8 + prod(:,219) = 0._r8 + prod(:,150) = 0._r8 + prod(:,91) = 0._r8 + prod(:,127) = 0._r8 + prod(:,87) = 0._r8 + prod(:,98) = 0._r8 + prod(:,99) = 0._r8 + prod(:,92) = 0._r8 + prod(:,100) = 0._r8 + prod(:,93) = 0._r8 + prod(:,101) = 0._r8 + prod(:,94) = 0._r8 + prod(:,162) = 0._r8 + prod(:,247) = 0._r8 + prod(:,178) = 0._r8 + prod(:,95) = 0._r8 + prod(:,221) = 0._r8 + prod(:,145) = 0._r8 + prod(:,88) = 0._r8 + prod(:,214) = 0._r8 + prod(:,234) = 0._r8 + prod(:,190) = 0._r8 + prod(:,179) = 0._r8 + prod(:,200) = 0._r8 + prod(:,153) = 0._r8 + prod(:,244) = 0._r8 + prod(:,154) = 0._r8 + prod(:,257) = 0._r8 + prod(:,107) = 0._r8 + prod(:,89) = 0._r8 + prod(:,260) = 0._r8 + prod(:,213) = 0._r8 + prod(:,5) = 0._r8 + prod(:,225) = + extfrc(:,3) + prod(:,205) = 0._r8 + prod(:,121) = 0._r8 + prod(:,123) = 0._r8 + prod(:,111) = 0._r8 + prod(:,135) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,9) = 0._r8 + prod(:,102) = 0._r8 + prod(:,209) = 0._r8 + prod(:,222) = 0._r8 + prod(:,216) = 0._r8 + prod(:,246) = 0._r8 + prod(:,242) = 0._r8 + prod(:,90) = 0._r8 + prod(:,181) = 0._r8 + prod(:,103) = 0._r8 + prod(:,202) = 0._r8 + prod(:,122) = 0._r8 + prod(:,124) = 0._r8 + prod(:,132) = 0._r8 + prod(:,255) = 0._r8 + prod(:,109) = 0._r8 + prod(:,215) = 0._r8 + prod(:,133) = 0._r8 + prod(:,245) = 0._r8 + prod(:,151) = 0._r8 + prod(:,199) = 0._r8 + prod(:,203) = 0._r8 + prod(:,226) = 0._r8 + prod(:,120) = 0._r8 + prod(:,227) = 0._r8 + prod(:,141) = 0._r8 + prod(:,96) = 0._r8 + prod(:,206) = 0._r8 + prod(:,177) = 0._r8 + prod(:,174) = 0._r8 + prod(:,232) = 0._r8 + prod(:,148) = 0._r8 + prod(:,72) = 0._r8 + prod(:,195) = 0._r8 + prod(:,65) = 0._r8 + prod(:,64) = 0._r8 + prod(:,80) = 0._r8 + prod(:,79) = 0._r8 + prod(:,233) = 0._r8 + prod(:,142) = 0._r8 + prod(:,168) = 0._r8 + prod(:,143) = 0._r8 + prod(:,182) = 0._r8 + prod(:,211) = 0._r8 + prod(:,73) = 0._r8 + prod(:,239) = 0._r8 + prod(:,165) = + extfrc(:,19) + prod(:,108) = 0._r8 + prod(:,134) = 0._r8 + prod(:,155) = 0._r8 + prod(:,220) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,86) = 0._r8 + prod(:,13) = 0._r8 + prod(:,253) = + extfrc(:,4) + prod(:,248) = + extfrc(:,5) + prod(:,256) = 0._r8 + prod(:,207) = 0._r8 + prod(:,152) = 0._r8 + prod(:,14) = + extfrc(:,6) + prod(:,15) = + extfrc(:,7) + prod(:,16) = 0._r8 + prod(:,17) = + extfrc(:,8) + prod(:,18) = + extfrc(:,9) + prod(:,249) = (rxt(:,5) +2.000_r8*rxt(:,6)) + prod(:,258) = 0._r8 + prod(:,19) = 0._r8 + prod(:,137) = 0._r8 + prod(:,146) = 0._r8 + prod(:,117) = 0._r8 + prod(:,171) = 0._r8 + prod(:,97) = 0._r8 + prod(:,164) = 0._r8 + prod(:,106) = 0._r8 + prod(:,138) = 0._r8 + prod(:,20) = 0._r8 + prod(:,21) = + extfrc(:,17) + prod(:,22) = 0._r8 + prod(:,23) = + extfrc(:,16) + prod(:,173) = 0._r8 + prod(:,147) = 0._r8 + prod(:,169) = 0._r8 + prod(:,24) = 0._r8 + prod(:,235) = 0._r8 + prod(:,208) = + extfrc(:,10) + prod(:,125) = 0._r8 + prod(:,25) = + extfrc(:,11) + prod(:,26) = + extfrc(:,12) + prod(:,27) = 0._r8 + prod(:,28) = + extfrc(:,13) + prod(:,29) = 0._r8 + prod(:,30) = 0._r8 + prod(:,31) = 0._r8 + prod(:,32) = 0._r8 + prod(:,33) = 0._r8 + prod(:,34) = 0._r8 + prod(:,35) = 0._r8 + prod(:,36) = 0._r8 + prod(:,37) = 0._r8 + prod(:,38) = 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(:,45) = 0._r8 + prod(:,46) = 0._r8 + prod(:,47) = 0._r8 + prod(:,48) = 0._r8 + prod(:,49) = 0._r8 + prod(:,50) = 0._r8 + prod(:,51) = 0._r8 + prod(:,52) = 0._r8 + prod(:,53) = 0._r8 + prod(:,54) = 0._r8 + prod(:,55) = 0._r8 + prod(:,56) = 0._r8 + prod(:,57) = 0._r8 + prod(:,58) = 0._r8 + prod(:,59) = 0._r8 + prod(:,60) = 0._r8 + prod(:,61) = 0._r8 + prod(:,62) = 0._r8 + prod(:,63) = 0._r8 + prod(:,66) = 0._r8 + prod(:,67) = 0._r8 + prod(:,68) = 0._r8 + prod(:,69) = 0._r8 + prod(:,70) = 0._r8 + prod(:,74) = 0._r8 + prod(:,75) = 0._r8 + prod(:,76) = 0._r8 + prod(:,77) = 0._r8 + prod(:,78) = 0._r8 + prod(:,82) = + extfrc(:,14) + prod(:,83) = + extfrc(:,15) + prod(:,112) = 0._r8 + prod(:,188) = 0._r8 + prod(:,183) = 0._r8 + prod(:,163) = 0._r8 + prod(:,218) = 0._r8 + prod(:,224) = 0._r8 + prod(:,189) = 0._r8 + prod(:,110) = 0._r8 + prod(:,84) = 0._r8 + prod(:,113) = 0._r8 + prod(:,114) = 0._r8 + prod(:,191) = 0._r8 + prod(:,85) = 0._r8 + prod(:,115) = 0._r8 + prod(:,157) = 0._r8 + prod(:,170) = 0._r8 + prod(:,212) = 0._r8 + prod(:,166) = 0._r8 + prod(:,158) = 0._r8 + prod(:,204) = 0._r8 + prod(:,201) = 0._r8 + prod(:,184) = 0._r8 + prod(:,241) = 0._r8 + prod(:,254) = 0._r8 + prod(:,197) = 0._r8 + prod(:,176) = 0._r8 + prod(:,128) = 0._r8 + prod(:,192) = 0._r8 + prod(:,259) = 0._r8 + prod(:,159) = 0._r8 + prod(:,236) = 0._r8 + prod(:,237) = 0._r8 + prod(:,238) = 0._r8 + prod(:,193) = 0._r8 + prod(:,240) = 0._r8 + prod(:,210) = 0._r8 + prod(:,187) = 0._r8 + prod(:,223) = 0._r8 + prod(:,250) =rxt(:,5) + prod(:,251) = + extfrc(:,20) + prod(:,160) = 0._r8 + prod(:,198) = 0._r8 + prod(:,230) = 0._r8 + prod(:,228) = 0._r8 + prod(:,229) = 0._r8 + prod(:,194) = 0._r8 + prod(:,231) = 0._r8 + prod(:,196) = 0._r8 + prod(:,167) = 0._r8 + prod(:,261) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_trop_strat_mam5_vbsext/mo_lin_matrix.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_lin_matrix.F90 new file mode 100644 index 0000000000..a65be33042 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_lin_matrix.F90 @@ -0,0 +1,687 @@ + 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,688) = -( rxt(k,19) + het_rates(k,1) ) + mat(k,677) = -( rxt(k,20) + het_rates(k,2) ) + mat(k,1) = -( het_rates(k,3) ) + mat(k,2) = -( het_rates(k,4) ) + mat(k,3) = -( het_rates(k,5) ) + mat(k,1015) = -( het_rates(k,6) ) + mat(k,82) = -( het_rates(k,7) ) + mat(k,207) = -( het_rates(k,8) ) + mat(k,113) = -( het_rates(k,9) ) + mat(k,472) = -( rxt(k,21) + het_rates(k,10) ) + mat(k,213) = -( rxt(k,22) + het_rates(k,11) ) + mat(k,430) = -( rxt(k,23) + het_rates(k,12) ) + mat(k,505) = -( rxt(k,24) + het_rates(k,13) ) + mat(k,473) = .500_r8*rxt(k,21) + mat(k,214) = rxt(k,22) + mat(k,717) = .200_r8*rxt(k,70) + mat(k,736) = .060_r8*rxt(k,72) + mat(k,318) = -( rxt(k,25) + het_rates(k,14) ) + mat(k,716) = .200_r8*rxt(k,70) + mat(k,734) = .200_r8*rxt(k,72) + mat(k,642) = -( rxt(k,26) + het_rates(k,15) ) + mat(k,279) = rxt(k,46) + mat(k,1065) = rxt(k,56) + mat(k,718) = .200_r8*rxt(k,70) + mat(k,737) = .150_r8*rxt(k,72) + mat(k,355) = -( rxt(k,27) + het_rates(k,16) ) + mat(k,735) = .210_r8*rxt(k,72) + mat(k,266) = -( het_rates(k,17) ) + mat(k,394) = -( het_rates(k,18) ) + mat(k,1462) = -( het_rates(k,19) ) + mat(k,273) = rxt(k,74) + mat(k,1840) = rxt(k,75) + mat(k,579) = rxt(k,77) + mat(k,182) = rxt(k,79) + mat(k,188) = rxt(k,80) + mat(k,509) = 2.000_r8*rxt(k,86) + mat(k,627) = rxt(k,87) + mat(k,461) = 3.000_r8*rxt(k,90) + mat(k,152) = 2.000_r8*rxt(k,98) + mat(k,847) = rxt(k,99) + mat(k,824) = rxt(k,105) + mat(k,272) = -( rxt(k,74) + het_rates(k,20) ) + mat(k,1848) = -( rxt(k,75) + het_rates(k,21) ) + mat(k,583) = rxt(k,76) + mat(k,577) = -( rxt(k,76) + rxt(k,77) + rxt(k,547) + rxt(k,550) + rxt(k,555) & + + het_rates(k,22) ) + mat(k,4) = -( het_rates(k,23) ) + mat(k,275) = -( het_rates(k,24) ) + mat(k,370) = rxt(k,28) + mat(k,371) = -( rxt(k,28) + het_rates(k,25) ) + mat(k,321) = -( het_rates(k,26) ) + mat(k,601) = -( het_rates(k,27) ) + mat(k,306) = -( het_rates(k,28) ) + mat(k,376) = -( rxt(k,29) + het_rates(k,29) ) + mat(k,327) = -( het_rates(k,30) ) + mat(k,1048) = -( het_rates(k,31) ) + mat(k,1373) = .700_r8*rxt(k,55) + mat(k,436) = -( rxt(k,30) + het_rates(k,32) ) + mat(k,154) = -( het_rates(k,33) ) + mat(k,310) = -( rxt(k,31) + het_rates(k,34) ) + mat(k,141) = -( rxt(k,78) + het_rates(k,35) ) + mat(k,180) = -( rxt(k,79) + het_rates(k,36) ) + mat(k,185) = -( rxt(k,80) + het_rates(k,37) ) + mat(k,158) = -( rxt(k,81) + het_rates(k,38) ) + mat(k,190) = -( rxt(k,82) + het_rates(k,39) ) + mat(k,162) = -( rxt(k,83) + het_rates(k,40) ) + mat(k,195) = -( rxt(k,84) + het_rates(k,41) ) + mat(k,166) = -( rxt(k,85) + het_rates(k,42) ) + mat(k,508) = -( rxt(k,86) + het_rates(k,43) ) + mat(k,1532) = -( rxt(k,32) + rxt(k,33) + het_rates(k,44) ) + mat(k,694) = .100_r8*rxt(k,19) + mat(k,684) = .100_r8*rxt(k,20) + mat(k,456) = rxt(k,38) + mat(k,1480) = .180_r8*rxt(k,39) + mat(k,1094) = rxt(k,43) + mat(k,1141) = .330_r8*rxt(k,45) + mat(k,1152) = rxt(k,47) + mat(k,784) = rxt(k,49) + mat(k,1258) = 1.340_r8*rxt(k,51) + mat(k,898) = rxt(k,57) + mat(k,589) = rxt(k,62) + mat(k,421) = rxt(k,63) + mat(k,713) = .375_r8*rxt(k,65) + mat(k,519) = .400_r8*rxt(k,67) + mat(k,1120) = .680_r8*rxt(k,69) + mat(k,494) = rxt(k,288) + mat(k,316) = 2.000_r8*rxt(k,318) + mat(k,626) = -( rxt(k,87) + het_rates(k,45) ) + mat(k,170) = -( rxt(k,88) + het_rates(k,46) ) + mat(k,1081) = -( rxt(k,34) + het_rates(k,47) ) + mat(k,692) = .400_r8*rxt(k,19) + mat(k,682) = .400_r8*rxt(k,20) + mat(k,378) = rxt(k,29) + mat(k,1133) = .330_r8*rxt(k,45) + mat(k,391) = rxt(k,53) + mat(k,587) = rxt(k,62) + mat(k,402) = -( rxt(k,89) + het_rates(k,48) ) + mat(k,144) = -( het_rates(k,49) ) + mat(k,982) = -( rxt(k,35) + het_rates(k,50) ) + mat(k,691) = .250_r8*rxt(k,19) + mat(k,681) = .250_r8*rxt(k,20) + mat(k,438) = .820_r8*rxt(k,30) + mat(k,1132) = .170_r8*rxt(k,45) + mat(k,708) = .300_r8*rxt(k,65) + mat(k,516) = .050_r8*rxt(k,67) + mat(k,1115) = .500_r8*rxt(k,69) + mat(k,1265) = -( rxt(k,36) + het_rates(k,51) ) + mat(k,433) = .180_r8*rxt(k,23) + mat(k,357) = rxt(k,27) + mat(k,726) = .400_r8*rxt(k,70) + mat(k,745) = .540_r8*rxt(k,72) + mat(k,481) = .510_r8*rxt(k,73) + mat(k,729) = -( het_rates(k,52) ) + mat(k,635) = -( rxt(k,37) + het_rates(k,53) ) + mat(k,831) = -( het_rates(k,54) ) + mat(k,454) = -( rxt(k,38) + het_rates(k,55) ) + mat(k,1477) = -( rxt(k,39) + rxt(k,40) + het_rates(k,56) ) + mat(k,460) = -( rxt(k,90) + het_rates(k,57) ) + mat(k,2129) = -( het_rates(k,58) ) + mat(k,274) = rxt(k,74) + mat(k,143) = 4.000_r8*rxt(k,78) + mat(k,184) = rxt(k,79) + mat(k,161) = 2.000_r8*rxt(k,81) + mat(k,194) = 2.000_r8*rxt(k,82) + mat(k,165) = 2.000_r8*rxt(k,83) + mat(k,199) = rxt(k,84) + mat(k,169) = 2.000_r8*rxt(k,85) + mat(k,172) = 3.000_r8*rxt(k,88) + mat(k,407) = rxt(k,89) + mat(k,223) = 2.000_r8*rxt(k,91) + mat(k,148) = 2.000_r8*rxt(k,92) + mat(k,2335) = rxt(k,93) + mat(k,979) = rxt(k,95) + mat(k,294) = rxt(k,97) + mat(k,290) = rxt(k,100) + mat(k,300) = rxt(k,101) + mat(k,338) = rxt(k,102) + mat(k,2031) = rxt(k,103) + mat(k,859) = rxt(k,106) + mat(k,222) = -( rxt(k,91) + het_rates(k,59) ) + mat(k,147) = -( rxt(k,92) + rxt(k,229) + het_rates(k,60) ) + mat(k,2338) = -( rxt(k,93) + het_rates(k,61) ) + mat(k,980) = rxt(k,94) + mat(k,364) = rxt(k,107) + mat(k,149) = 2.000_r8*rxt(k,229) + mat(k,972) = -( rxt(k,94) + rxt(k,95) + rxt(k,549) + rxt(k,554) + rxt(k,560) & + + het_rates(k,62) ) + mat(k,5) = -( het_rates(k,63) ) + mat(k,1127) = -( het_rates(k,64) ) + mat(k,215) = 1.500_r8*rxt(k,22) + mat(k,432) = .450_r8*rxt(k,23) + mat(k,644) = .600_r8*rxt(k,26) + mat(k,356) = rxt(k,27) + mat(k,1526) = rxt(k,32) + rxt(k,33) + mat(k,1082) = rxt(k,34) + mat(k,1264) = rxt(k,36) + mat(k,1475) = .380_r8*rxt(k,39) + mat(k,874) = rxt(k,41) + mat(k,1093) = rxt(k,43) + mat(k,998) = 2.000_r8*rxt(k,44) + mat(k,1135) = .330_r8*rxt(k,45) + mat(k,1252) = 1.340_r8*rxt(k,50) + mat(k,1375) = .700_r8*rxt(k,55) + mat(k,245) = 1.500_r8*rxt(k,64) + mat(k,711) = .250_r8*rxt(k,65) + mat(k,1038) = rxt(k,68) + mat(k,1117) = 1.700_r8*rxt(k,69) + mat(k,413) = rxt(k,110) + mat(k,873) = -( rxt(k,41) + het_rates(k,65) ) + mat(k,636) = rxt(k,37) + mat(k,1473) = .440_r8*rxt(k,39) + mat(k,570) = .400_r8*rxt(k,60) + mat(k,707) = rxt(k,65) + mat(k,1114) = .800_r8*rxt(k,69) + mat(k,283) = -( rxt(k,96) + het_rates(k,66) ) + mat(k,181) = rxt(k,79) + mat(k,186) = rxt(k,80) + mat(k,191) = rxt(k,82) + mat(k,163) = 2.000_r8*rxt(k,83) + mat(k,196) = 2.000_r8*rxt(k,84) + mat(k,167) = rxt(k,85) + mat(k,151) = 2.000_r8*rxt(k,98) + mat(k,295) = rxt(k,101) + mat(k,333) = rxt(k,102) + mat(k,291) = -( rxt(k,97) + het_rates(k,67) ) + mat(k,159) = rxt(k,81) + mat(k,192) = rxt(k,82) + mat(k,287) = rxt(k,100) + mat(k,239) = -( het_rates(k,68) ) + mat(k,349) = -( het_rates(k,69) ) + mat(k,6) = -( het_rates(k,70) ) + mat(k,7) = -( het_rates(k,71) ) + mat(k,8) = -( het_rates(k,72) ) + mat(k,9) = -( rxt(k,562) + het_rates(k,73) ) + mat(k,200) = -( rxt(k,42) + het_rates(k,74) ) + mat(k,909) = -( het_rates(k,75) ) + mat(k,187) = rxt(k,80) + mat(k,197) = rxt(k,84) + mat(k,284) = 2.000_r8*rxt(k,96) + mat(k,292) = rxt(k,97) + mat(k,341) = rxt(k,104) + 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,1092) = -( rxt(k,43) + het_rates(k,76) ) + mat(k,1134) = .330_r8*rxt(k,45) + mat(k,709) = .250_r8*rxt(k,65) + mat(k,315) = rxt(k,319) + mat(k,997) = -( rxt(k,44) + rxt(k,541) + het_rates(k,77) ) + mat(k,475) = rxt(k,21) + mat(k,431) = .130_r8*rxt(k,23) + mat(k,367) = .700_r8*rxt(k,61) + mat(k,724) = .600_r8*rxt(k,70) + mat(k,743) = .340_r8*rxt(k,72) + mat(k,480) = .170_r8*rxt(k,73) + mat(k,1510) = -( rxt(k,157) + het_rates(k,78) ) + mat(k,2350) = rxt(k,2) + 2.000_r8*rxt(k,3) + mat(k,1531) = 2.000_r8*rxt(k,33) + mat(k,455) = rxt(k,38) + mat(k,1479) = .330_r8*rxt(k,39) + rxt(k,40) + mat(k,848) = rxt(k,99) + mat(k,2020) = rxt(k,103) + mat(k,342) = rxt(k,104) + mat(k,1448) = -( het_rates(k,79) ) + mat(k,2346) = rxt(k,1) + mat(k,1527) = rxt(k,32) + mat(k,1476) = 1.440_r8*rxt(k,39) + mat(k,150) = -( rxt(k,98) + het_rates(k,80) ) + mat(k,646) = -( rxt(k,4) + het_rates(k,81) ) + mat(k,2247) = .500_r8*rxt(k,499) + mat(k,203) = -( rxt(k,109) + het_rates(k,82) ) + mat(k,846) = -( rxt(k,99) + het_rates(k,83) ) + mat(k,286) = -( rxt(k,100) + het_rates(k,84) ) + mat(k,296) = -( rxt(k,101) + het_rates(k,85) ) + mat(k,334) = -( rxt(k,102) + het_rates(k,86) ) + mat(k,2029) = -( rxt(k,103) + het_rates(k,87) ) + mat(k,227) = -( het_rates(k,88) ) + mat(k,989) = -( het_rates(k,89) ) + mat(k,340) = -( rxt(k,104) + het_rates(k,90) ) + mat(k,1494) = -( rxt(k,9) + het_rates(k,91) ) + mat(k,1140) = rxt(k,500) + mat(k,621) = rxt(k,501) + mat(k,598) = rxt(k,502) + mat(k,344) = 2.000_r8*rxt(k,503) + 2.000_r8*rxt(k,545) + 2.000_r8*rxt(k,548) & + + 2.000_r8*rxt(k,559) + mat(k,469) = rxt(k,504) + mat(k,1073) = rxt(k,505) + mat(k,1573) = .500_r8*rxt(k,507) + mat(k,2078) = rxt(k,508) + mat(k,451) = rxt(k,509) + mat(k,270) = rxt(k,510) + mat(k,664) = rxt(k,511) + mat(k,580) = rxt(k,547) + rxt(k,550) + rxt(k,555) + mat(k,973) = rxt(k,549) + rxt(k,554) + rxt(k,560) + mat(k,442) = -( rxt(k,10) + rxt(k,11) + rxt(k,192) + het_rates(k,92) ) + mat(k,823) = -( rxt(k,105) + het_rates(k,93) ) + mat(k,578) = rxt(k,547) + rxt(k,550) + rxt(k,555) + mat(k,855) = -( rxt(k,106) + het_rates(k,94) ) + mat(k,971) = rxt(k,549) + rxt(k,554) + rxt(k,560) + mat(k,1136) = -( rxt(k,45) + rxt(k,500) + het_rates(k,95) ) + mat(k,278) = -( rxt(k,46) + het_rates(k,96) ) + mat(k,1317) = rxt(k,392) + mat(k,1149) = -( rxt(k,47) + het_rates(k,97) ) + mat(k,1137) = .170_r8*rxt(k,45) + mat(k,381) = -( het_rates(k,98) ) + mat(k,174) = -( het_rates(k,99) ) + mat(k,879) = -( het_rates(k,100) ) + mat(k,617) = -( rxt(k,501) + het_rates(k,101) ) + mat(k,593) = -( rxt(k,502) + het_rates(k,102) ) + mat(k,1237) = -( het_rates(k,103) ) + mat(k,424) = -( rxt(k,48) + het_rates(k,104) ) + mat(k,88) = -( het_rates(k,105) ) + mat(k,780) = -( rxt(k,49) + het_rates(k,106) ) + mat(k,425) = rxt(k,48) + mat(k,71) = -( het_rates(k,107) ) + mat(k,69) = -( het_rates(k,108) ) + mat(k,107) = -( het_rates(k,109) ) + mat(k,105) = -( het_rates(k,110) ) + mat(k,1253) = -( rxt(k,50) + rxt(k,51) + het_rates(k,111) ) + mat(k,782) = .300_r8*rxt(k,49) + mat(k,384) = -( het_rates(k,112) ) + mat(k,551) = -( rxt(k,52) + het_rates(k,113) ) + mat(k,687) = .800_r8*rxt(k,19) + mat(k,676) = .800_r8*rxt(k,20) + mat(k,389) = -( rxt(k,53) + het_rates(k,114) ) + mat(k,653) = -( rxt(k,54) + rxt(k,374) + het_rates(k,115) ) + mat(k,936) = -( het_rates(k,116) ) + mat(k,94) = -( het_rates(k,117) ) + mat(k,1379) = -( rxt(k,55) + het_rates(k,118) ) + mat(k,783) = .700_r8*rxt(k,49) + mat(k,527) = -( rxt(k,174) + het_rates(k,119) ) + mat(k,1892) = rxt(k,15) + mat(k,224) = -( rxt(k,12) + het_rates(k,120) ) + mat(k,343) = -( rxt(k,13) + rxt(k,14) + rxt(k,193) + rxt(k,503) + rxt(k,545) & + + rxt(k,548) + rxt(k,559) + het_rates(k,121) ) + mat(k,466) = -( rxt(k,504) + het_rates(k,122) ) + mat(k,1069) = -( rxt(k,56) + rxt(k,505) + het_rates(k,123) ) + mat(k,10) = -( het_rates(k,124) ) + mat(k,11) = -( het_rates(k,125) ) + mat(k,12) = -( het_rates(k,126) ) + mat(k,138) = -( het_rates(k,127) ) + mat(k,13) = -( rxt(k,506) + het_rates(k,128) ) + mat(k,1952) = -( rxt(k,15) + het_rates(k,129) ) + mat(k,347) = rxt(k,13) + mat(k,1581) = rxt(k,16) + .500_r8*rxt(k,507) + mat(k,2086) = rxt(k,17) + mat(k,533) = rxt(k,174) + mat(k,1576) = -( rxt(k,16) + rxt(k,507) + het_rates(k,130) ) + mat(k,1497) = rxt(k,9) + mat(k,443) = rxt(k,11) + rxt(k,192) + mat(k,345) = rxt(k,14) + rxt(k,193) + mat(k,2081) = rxt(k,18) + mat(k,695) = rxt(k,19) + mat(k,1142) = rxt(k,45) + mat(k,427) = rxt(k,48) + mat(k,658) = rxt(k,54) + rxt(k,374) + mat(k,1075) = rxt(k,56) + mat(k,899) = rxt(k,57) + mat(k,452) = rxt(k,58) + mat(k,271) = rxt(k,59) + mat(k,573) = .600_r8*rxt(k,60) + rxt(k,325) + mat(k,665) = rxt(k,66) + mat(k,581) = rxt(k,76) + mat(k,974) = rxt(k,94) + mat(k,179) = rxt(k,449) + mat(k,2089) = -( rxt(k,17) + rxt(k,18) + rxt(k,508) + het_rates(k,131) ) + mat(k,445) = rxt(k,10) + mat(k,348) = rxt(k,13) + rxt(k,14) + rxt(k,193) + mat(k,576) = .400_r8*rxt(k,60) + mat(k,584) = rxt(k,77) + mat(k,978) = rxt(k,95) + mat(k,895) = -( rxt(k,57) + het_rates(k,132) ) + mat(k,448) = -( rxt(k,58) + rxt(k,509) + het_rates(k,133) ) + mat(k,14) = -( het_rates(k,134) ) + mat(k,15) = -( het_rates(k,135) ) + mat(k,16) = -( het_rates(k,136) ) + mat(k,17) = -( het_rates(k,137) ) + mat(k,18) = -( het_rates(k,138) ) + mat(k,1608) = -( rxt(k,151) + het_rates(k,139) ) + mat(k,2353) = rxt(k,3) + mat(k,2183) = rxt(k,8) + mat(k,346) = rxt(k,13) + mat(k,1948) = rxt(k,15) + mat(k,1577) = rxt(k,16) + mat(k,2082) = rxt(k,18) + mat(k,1481) = .180_r8*rxt(k,39) + mat(k,875) = rxt(k,41) + mat(k,1845) = rxt(k,75) + mat(k,2327) = rxt(k,93) + mat(k,363) = rxt(k,107) + mat(k,1280) = rxt(k,111) + rxt(k,492) + mat(k,904) = rxt(k,112) + mat(k,304) = rxt(k,113) + mat(k,1649) = rxt(k,146) + rxt(k,147) + mat(k,530) = rxt(k,174) + mat(k,559) = rxt(k,485) + mat(k,2192) = -( rxt(k,7) + rxt(k,8) + het_rates(k,140) ) + mat(k,1617) = rxt(k,151) + mat(k,19) = -( het_rates(k,141) ) + mat(k,360) = -( rxt(k,107) + het_rates(k,142) ) + mat(k,410) = -( rxt(k,110) + het_rates(k,143) ) + mat(k,269) = -( rxt(k,59) + rxt(k,510) + het_rates(k,144) ) + mat(k,569) = -( rxt(k,60) + rxt(k,325) + het_rates(k,145) ) + mat(k,177) = -( rxt(k,449) + het_rates(k,146) ) + mat(k,522) = -( het_rates(k,147) ) + mat(k,311) = rxt(k,31) + mat(k,217) = -( het_rates(k,148) ) + mat(k,365) = -( rxt(k,61) + het_rates(k,149) ) + mat(k,20) = -( het_rates(k,150) ) + mat(k,21) = -( het_rates(k,151) ) + mat(k,22) = -( het_rates(k,152) ) + mat(k,23) = -( het_rates(k,153) ) + mat(k,585) = -( rxt(k,62) + het_rates(k,154) ) + mat(k,418) = -( rxt(k,63) + het_rates(k,155) ) + mat(k,556) = -( rxt(k,485) + het_rates(k,156) ) + mat(k,411) = rxt(k,110) + mat(k,1274) = rxt(k,111) + mat(k,24) = -( rxt(k,108) + het_rates(k,157) ) + mat(k,1276) = -( rxt(k,111) + rxt(k,492) + het_rates(k,158) ) + mat(k,903) = rxt(k,112) + mat(k,557) = rxt(k,485) + mat(k,902) = -( rxt(k,112) + het_rates(k,159) ) + mat(k,303) = rxt(k,113) + mat(k,1275) = rxt(k,492) + mat(k,302) = -( rxt(k,113) + het_rates(k,160) ) + mat(k,204) = rxt(k,109) + mat(k,25) = -( het_rates(k,161) ) + mat(k,26) = -( het_rates(k,162) ) + mat(k,27) = -( het_rates(k,163) ) + mat(k,28) = -( het_rates(k,164) ) + mat(k,29) = -( rxt(k,114) + het_rates(k,165) ) + mat(k,30) = -( rxt(k,115) + het_rates(k,166) ) + mat(k,31) = -( rxt(k,116) + het_rates(k,167) ) + mat(k,32) = -( rxt(k,117) + het_rates(k,168) ) + mat(k,33) = -( rxt(k,118) + het_rates(k,169) ) + mat(k,34) = -( rxt(k,119) + het_rates(k,170) ) + mat(k,35) = -( rxt(k,120) + het_rates(k,171) ) + mat(k,36) = -( rxt(k,121) + het_rates(k,172) ) + mat(k,37) = -( rxt(k,122) + het_rates(k,173) ) + mat(k,38) = -( rxt(k,123) + het_rates(k,174) ) + mat(k,39) = -( rxt(k,124) + het_rates(k,175) ) + mat(k,40) = -( rxt(k,125) + het_rates(k,176) ) + mat(k,41) = -( rxt(k,126) + het_rates(k,177) ) + mat(k,42) = -( rxt(k,127) + het_rates(k,178) ) + mat(k,43) = -( rxt(k,128) + het_rates(k,179) ) + end do + end subroutine linmat02 + subroutine linmat03( 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,44) = -( rxt(k,129) + het_rates(k,180) ) + mat(k,45) = -( rxt(k,130) + het_rates(k,181) ) + mat(k,46) = -( rxt(k,131) + het_rates(k,182) ) + mat(k,47) = -( rxt(k,132) + het_rates(k,183) ) + mat(k,48) = -( rxt(k,133) + het_rates(k,184) ) + mat(k,49) = -( rxt(k,134) + het_rates(k,185) ) + mat(k,50) = -( rxt(k,135) + het_rates(k,186) ) + mat(k,51) = -( rxt(k,136) + het_rates(k,187) ) + mat(k,52) = -( rxt(k,137) + het_rates(k,188) ) + mat(k,53) = -( rxt(k,138) + het_rates(k,189) ) + mat(k,54) = -( rxt(k,139) + het_rates(k,190) ) + mat(k,55) = -( rxt(k,140) + het_rates(k,191) ) + mat(k,56) = -( rxt(k,141) + het_rates(k,192) ) + mat(k,57) = -( rxt(k,142) + het_rates(k,193) ) + mat(k,58) = -( rxt(k,143) + het_rates(k,194) ) + mat(k,59) = -( het_rates(k,195) ) + mat(k,60) = -( het_rates(k,196) ) + mat(k,61) = -( het_rates(k,197) ) + mat(k,62) = -( het_rates(k,198) ) + mat(k,63) = -( het_rates(k,199) ) + mat(k,72) = -( het_rates(k,200) ) + mat(k,995) = rxt(k,541) + mat(k,73) = -( het_rates(k,201) ) + mat(k,74) = -( het_rates(k,202) ) + mat(k,75) = -( het_rates(k,203) ) + mat(k,76) = -( het_rates(k,204) ) + mat(k,95) = -( het_rates(k,205) ) + mat(k,96) = -( het_rates(k,206) ) + mat(k,97) = -( het_rates(k,207) ) + mat(k,98) = -( het_rates(k,208) ) + mat(k,99) = -( het_rates(k,209) ) + mat(k,119) = -( het_rates(k,210) ) + mat(k,125) = -( het_rates(k,211) ) + mat(k,244) = -( rxt(k,64) + het_rates(k,212) ) + mat(k,706) = -( rxt(k,65) + het_rates(k,213) ) + mat(k,662) = -( rxt(k,66) + rxt(k,511) + het_rates(k,214) ) + mat(k,515) = -( rxt(k,67) + het_rates(k,215) ) + mat(k,1035) = -( rxt(k,68) + het_rates(k,216) ) + mat(k,449) = rxt(k,58) + mat(k,663) = rxt(k,66) + mat(k,517) = rxt(k,67) + mat(k,1116) = -( rxt(k,69) + het_rates(k,217) ) + mat(k,710) = rxt(k,65) + mat(k,1037) = rxt(k,68) + mat(k,719) = -( rxt(k,70) + het_rates(k,218) ) + mat(k,232) = -( het_rates(k,219) ) + mat(k,131) = -( het_rates(k,220) ) + mat(k,248) = -( rxt(k,71) + het_rates(k,221) ) + mat(k,253) = -( het_rates(k,222) ) + mat(k,738) = -( rxt(k,72) + het_rates(k,223) ) + mat(k,137) = -( het_rates(k,224) ) + mat(k,261) = -( het_rates(k,225) ) + mat(k,478) = -( rxt(k,73) + het_rates(k,226) ) + mat(k,563) = -( het_rates(k,229) ) + mat(k,178) = rxt(k,449) + mat(k,960) = -( het_rates(k,230) ) + mat(k,536) = -( het_rates(k,231) ) + mat(k,486) = -( het_rates(k,232) ) + mat(k,865) = -( het_rates(k,233) ) + mat(k,553) = rxt(k,52) + mat(k,836) = -( het_rates(k,234) ) + mat(k,670) = -( het_rates(k,235) ) + mat(k,1433) = -( het_rates(k,236) ) + mat(k,434) = .130_r8*rxt(k,23) + mat(k,358) = rxt(k,27) + mat(k,984) = rxt(k,35) + mat(k,1266) = rxt(k,36) + mat(k,1139) = .330_r8*rxt(k,45) + mat(k,1151) = rxt(k,47) + mat(k,1257) = 1.340_r8*rxt(k,51) + mat(k,554) = rxt(k,52) + mat(k,392) = rxt(k,53) + mat(k,1381) = .300_r8*rxt(k,55) + mat(k,897) = rxt(k,57) + mat(k,571) = .600_r8*rxt(k,60) + rxt(k,325) + mat(k,420) = rxt(k,63) + mat(k,246) = .500_r8*rxt(k,64) + mat(k,1119) = .650_r8*rxt(k,69) + mat(k,2005) = -( het_rates(k,237) ) + mat(k,1086) = rxt(k,34) + mat(k,986) = rxt(k,35) + mat(k,640) = rxt(k,37) + mat(k,1484) = rxt(k,40) + mat(k,1389) = .300_r8*rxt(k,55) + mat(k,575) = .400_r8*rxt(k,60) + mat(k,630) = rxt(k,87) + mat(k,405) = rxt(k,89) + mat(k,804) = -( het_rates(k,238) ) + mat(k,319) = .600_r8*rxt(k,25) + mat(k,609) = -( het_rates(k,239) ) + mat(k,314) = -( rxt(k,318) + rxt(k,319) + het_rates(k,240) ) + mat(k,201) = rxt(k,42) + mat(k,751) = -( het_rates(k,241) ) + mat(k,2311) = -( rxt(k,499) + het_rates(k,242) ) + mat(k,446) = rxt(k,11) + rxt(k,192) + mat(k,697) = rxt(k,19) + mat(k,686) = .900_r8*rxt(k,20) + mat(k,477) = rxt(k,21) + mat(k,216) = 1.500_r8*rxt(k,22) + mat(k,435) = .560_r8*rxt(k,23) + mat(k,507) = rxt(k,24) + mat(k,320) = .600_r8*rxt(k,25) + mat(k,645) = .600_r8*rxt(k,26) + mat(k,359) = rxt(k,27) + mat(k,375) = rxt(k,28) + mat(k,380) = rxt(k,29) + mat(k,440) = rxt(k,30) + mat(k,1088) = rxt(k,34) + mat(k,1271) = rxt(k,36) + mat(k,1097) = 2.000_r8*rxt(k,43) + mat(k,1001) = 2.000_r8*rxt(k,44) + mat(k,1147) = .670_r8*rxt(k,45) + mat(k,282) = rxt(k,46) + mat(k,1154) = rxt(k,47) + mat(k,429) = rxt(k,48) + mat(k,786) = rxt(k,49) + mat(k,1262) = .660_r8*rxt(k,50) + 1.340_r8*rxt(k,51) + mat(k,1080) = rxt(k,56) + mat(k,369) = rxt(k,61) + mat(k,591) = rxt(k,62) + mat(k,247) = rxt(k,64) + mat(k,715) = rxt(k,65) + mat(k,667) = rxt(k,66) + mat(k,521) = rxt(k,67) + mat(k,1042) = rxt(k,68) + mat(k,1124) = 1.200_r8*rxt(k,69) + mat(k,728) = rxt(k,70) + mat(k,748) = rxt(k,72) + mat(k,483) = rxt(k,73) + mat(k,1521) = rxt(k,157) + mat(k,497) = rxt(k,288) + mat(k,317) = rxt(k,318) + rxt(k,319) + mat(k,1348) = rxt(k,392) + mat(k,492) = -( rxt(k,288) + het_rates(k,243) ) + mat(k,1301) = -( het_rates(k,244) ) + mat(k,1334) = -( rxt(k,392) + het_rates(k,245) ) + mat(k,1358) = -( het_rates(k,246) ) + mat(k,758) = -( het_rates(k,247) ) + mat(k,506) = .600_r8*rxt(k,24) + mat(k,1401) = -( het_rates(k,248) ) + mat(k,1256) = .660_r8*rxt(k,51) + mat(k,656) = rxt(k,54) + rxt(k,374) + mat(k,918) = -( het_rates(k,249) ) + mat(k,643) = .600_r8*rxt(k,26) + mat(k,699) = -( het_rates(k,250) ) + mat(k,1102) = -( het_rates(k,251) ) + mat(k,1650) = -( rxt(k,146) + rxt(k,147) + het_rates(k,252) ) + mat(k,2354) = rxt(k,1) + mat(k,2184) = rxt(k,7) + mat(k,225) = rxt(k,12) + mat(k,1823) = -( het_rates(k,253) ) + mat(k,2355) = rxt(k,2) + mat(k,648) = 2.000_r8*rxt(k,4) + mat(k,1500) = rxt(k,9) + mat(k,444) = rxt(k,10) + mat(k,685) = rxt(k,20) + mat(k,476) = rxt(k,21) + mat(k,374) = rxt(k,28) + mat(k,379) = rxt(k,29) + mat(k,439) = rxt(k,30) + mat(k,313) = rxt(k,31) + mat(k,639) = rxt(k,37) + mat(k,457) = rxt(k,38) + mat(k,1483) = .330_r8*rxt(k,39) + mat(k,202) = rxt(k,42) + mat(k,281) = rxt(k,46) + mat(k,785) = rxt(k,49) + mat(k,393) = rxt(k,53) + mat(k,453) = rxt(k,58) + mat(k,368) = rxt(k,61) + mat(k,590) = rxt(k,62) + mat(k,422) = rxt(k,63) + mat(k,714) = rxt(k,65) + mat(k,520) = rxt(k,67) + mat(k,727) = rxt(k,70) + mat(k,250) = rxt(k,71) + mat(k,747) = rxt(k,72) + mat(k,482) = rxt(k,73) + mat(k,826) = rxt(k,105) + mat(k,857) = rxt(k,106) + mat(k,1579) = .500_r8*rxt(k,507) + mat(k,499) = -( het_rates(k,254) ) + mat(k,813) = -( het_rates(k,255) ) + mat(k,1200) = -( het_rates(k,256) ) + mat(k,1118) = .150_r8*rxt(k,69) + mat(k,1163) = -( het_rates(k,257) ) + mat(k,1184) = -( het_rates(k,258) ) + mat(k,769) = -( het_rates(k,259) ) + mat(k,1217) = -( het_rates(k,260) ) + mat(k,793) = -( het_rates(k,261) ) + mat(k,544) = -( het_rates(k,262) ) + mat(k,2365) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,263) ) + mat(k,1489) = .050_r8*rxt(k,39) + mat(k,205) = rxt(k,109) + end do + end subroutine linmat03 + 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 ) + call linmat03( avec_len, mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_trop_strat_mam5_vbsext/mo_lu_factor.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_lu_factor.F90 new file mode 100644 index 0000000000..a7e3fe18bd --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_lu_factor.F90 @@ -0,0 +1,8095 @@ + 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) = 1._r8 / lu(k,10) + 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) = 1._r8 / lu(k,33) + 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) = 1._r8 / lu(k,37) + lu(k,38) = 1._r8 / lu(k,38) + lu(k,39) = 1._r8 / lu(k,39) + lu(k,40) = 1._r8 / lu(k,40) + lu(k,41) = 1._r8 / lu(k,41) + lu(k,42) = 1._r8 / lu(k,42) + lu(k,43) = 1._r8 / lu(k,43) + lu(k,44) = 1._r8 / lu(k,44) + lu(k,45) = 1._r8 / lu(k,45) + lu(k,46) = 1._r8 / lu(k,46) + lu(k,47) = 1._r8 / lu(k,47) + lu(k,48) = 1._r8 / lu(k,48) + lu(k,49) = 1._r8 / lu(k,49) + lu(k,50) = 1._r8 / lu(k,50) + lu(k,51) = 1._r8 / lu(k,51) + 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,52) = 1._r8 / lu(k,52) + lu(k,53) = 1._r8 / lu(k,53) + lu(k,54) = 1._r8 / lu(k,54) + lu(k,55) = 1._r8 / lu(k,55) + lu(k,56) = 1._r8 / lu(k,56) + lu(k,57) = 1._r8 / lu(k,57) + lu(k,58) = 1._r8 / lu(k,58) + lu(k,59) = 1._r8 / lu(k,59) + lu(k,60) = 1._r8 / lu(k,60) + lu(k,61) = 1._r8 / lu(k,61) + lu(k,62) = 1._r8 / lu(k,62) + lu(k,63) = 1._r8 / lu(k,63) + lu(k,69) = 1._r8 / lu(k,69) + lu(k,71) = 1._r8 / lu(k,71) + lu(k,72) = 1._r8 / lu(k,72) + lu(k,73) = 1._r8 / lu(k,73) + lu(k,74) = 1._r8 / lu(k,74) + lu(k,75) = 1._r8 / lu(k,75) + lu(k,76) = 1._r8 / lu(k,76) + lu(k,82) = 1._r8 / lu(k,82) + lu(k,88) = 1._r8 / lu(k,88) + lu(k,94) = 1._r8 / lu(k,94) + lu(k,95) = 1._r8 / lu(k,95) + lu(k,96) = 1._r8 / lu(k,96) + lu(k,97) = 1._r8 / lu(k,97) + lu(k,98) = 1._r8 / lu(k,98) + lu(k,99) = 1._r8 / lu(k,99) + lu(k,105) = 1._r8 / lu(k,105) + lu(k,107) = 1._r8 / lu(k,107) + lu(k,113) = 1._r8 / lu(k,113) + lu(k,119) = 1._r8 / lu(k,119) + lu(k,125) = 1._r8 / lu(k,125) + lu(k,131) = 1._r8 / lu(k,131) + lu(k,137) = 1._r8 / lu(k,137) + lu(k,138) = 1._r8 / lu(k,138) + lu(k,139) = lu(k,139) * lu(k,138) + lu(k,140) = lu(k,140) * lu(k,138) + lu(k,1823) = lu(k,1823) - lu(k,139) * lu(k,1684) + lu(k,1833) = lu(k,1833) - lu(k,140) * lu(k,1684) + lu(k,141) = 1._r8 / lu(k,141) + lu(k,142) = lu(k,142) * lu(k,141) + lu(k,143) = lu(k,143) * lu(k,141) + lu(k,1650) = lu(k,1650) - lu(k,142) * lu(k,1621) + lu(k,1657) = lu(k,1657) - lu(k,143) * lu(k,1621) + lu(k,144) = 1._r8 / lu(k,144) + lu(k,145) = lu(k,145) * lu(k,144) + lu(k,146) = lu(k,146) * lu(k,144) + lu(k,1823) = lu(k,1823) - lu(k,145) * lu(k,1685) + lu(k,1831) = lu(k,1831) - lu(k,146) * lu(k,1685) + 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,2335) = lu(k,2335) - lu(k,148) * lu(k,2314) + lu(k,2338) = lu(k,2338) - lu(k,149) * lu(k,2314) + lu(k,150) = 1._r8 / lu(k,150) + lu(k,151) = lu(k,151) * lu(k,150) + lu(k,152) = lu(k,152) * lu(k,150) + lu(k,153) = lu(k,153) * lu(k,150) + lu(k,1632) = lu(k,1632) - lu(k,151) * lu(k,1622) + lu(k,1643) = lu(k,1643) - lu(k,152) * lu(k,1622) + lu(k,1650) = lu(k,1650) - lu(k,153) * lu(k,1622) + lu(k,154) = 1._r8 / lu(k,154) + lu(k,155) = lu(k,155) * lu(k,154) + lu(k,156) = lu(k,156) * lu(k,154) + lu(k,157) = lu(k,157) * lu(k,154) + lu(k,1773) = lu(k,1773) - lu(k,155) * lu(k,1686) + lu(k,1823) = lu(k,1823) - lu(k,156) * lu(k,1686) + lu(k,1833) = lu(k,1833) - lu(k,157) * lu(k,1686) + 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,158) = 1._r8 / lu(k,158) + lu(k,159) = lu(k,159) * lu(k,158) + lu(k,160) = lu(k,160) * lu(k,158) + lu(k,161) = lu(k,161) * lu(k,158) + lu(k,1634) = lu(k,1634) - lu(k,159) * lu(k,1623) + lu(k,1650) = lu(k,1650) - lu(k,160) * lu(k,1623) + lu(k,1657) = lu(k,1657) - lu(k,161) * lu(k,1623) + lu(k,162) = 1._r8 / lu(k,162) + lu(k,163) = lu(k,163) * lu(k,162) + lu(k,164) = lu(k,164) * lu(k,162) + lu(k,165) = lu(k,165) * lu(k,162) + lu(k,1632) = lu(k,1632) - lu(k,163) * lu(k,1624) + lu(k,1650) = lu(k,1650) - lu(k,164) * lu(k,1624) + lu(k,1657) = lu(k,1657) - lu(k,165) * lu(k,1624) + lu(k,166) = 1._r8 / lu(k,166) + lu(k,167) = lu(k,167) * lu(k,166) + lu(k,168) = lu(k,168) * lu(k,166) + lu(k,169) = lu(k,169) * lu(k,166) + lu(k,1632) = lu(k,1632) - lu(k,167) * lu(k,1625) + lu(k,1650) = lu(k,1650) - lu(k,168) * lu(k,1625) + lu(k,1657) = lu(k,1657) - lu(k,169) * lu(k,1625) + lu(k,170) = 1._r8 / lu(k,170) + lu(k,171) = lu(k,171) * lu(k,170) + lu(k,172) = lu(k,172) * lu(k,170) + lu(k,173) = lu(k,173) * lu(k,170) + lu(k,1823) = lu(k,1823) - lu(k,171) * lu(k,1687) + lu(k,1829) = lu(k,1829) - lu(k,172) * lu(k,1687) + lu(k,1833) = lu(k,1833) - lu(k,173) * lu(k,1687) + lu(k,174) = 1._r8 / lu(k,174) + lu(k,175) = lu(k,175) * lu(k,174) + lu(k,176) = lu(k,176) * lu(k,174) + lu(k,781) = lu(k,781) - lu(k,175) * lu(k,779) + lu(k,785) = lu(k,785) - lu(k,176) * lu(k,779) + lu(k,1803) = lu(k,1803) - lu(k,175) * lu(k,1688) + lu(k,1823) = lu(k,1823) - lu(k,176) * lu(k,1688) + lu(k,177) = 1._r8 / lu(k,177) + lu(k,178) = lu(k,178) * lu(k,177) + lu(k,179) = lu(k,179) * lu(k,177) + lu(k,563) = lu(k,563) - lu(k,178) * lu(k,562) + lu(k,565) = lu(k,565) - lu(k,179) * lu(k,562) + lu(k,1552) = lu(k,1552) - lu(k,178) * lu(k,1546) + lu(k,1576) = lu(k,1576) - lu(k,179) * lu(k,1546) + lu(k,180) = 1._r8 / lu(k,180) + lu(k,181) = lu(k,181) * lu(k,180) + lu(k,182) = lu(k,182) * lu(k,180) + lu(k,183) = lu(k,183) * lu(k,180) + lu(k,184) = lu(k,184) * lu(k,180) + lu(k,1632) = lu(k,1632) - lu(k,181) * lu(k,1626) + lu(k,1643) = lu(k,1643) - lu(k,182) * lu(k,1626) + lu(k,1650) = lu(k,1650) - lu(k,183) * lu(k,1626) + lu(k,1657) = lu(k,1657) - lu(k,184) * lu(k,1626) + lu(k,185) = 1._r8 / lu(k,185) + lu(k,186) = lu(k,186) * lu(k,185) + lu(k,187) = lu(k,187) * lu(k,185) + lu(k,188) = lu(k,188) * lu(k,185) + lu(k,189) = lu(k,189) * lu(k,185) + lu(k,1632) = lu(k,1632) - lu(k,186) * lu(k,1627) + lu(k,1641) = lu(k,1641) - lu(k,187) * lu(k,1627) + lu(k,1643) = lu(k,1643) - lu(k,188) * lu(k,1627) + lu(k,1650) = lu(k,1650) - lu(k,189) * lu(k,1627) + lu(k,190) = 1._r8 / lu(k,190) + lu(k,191) = lu(k,191) * lu(k,190) + lu(k,192) = lu(k,192) * lu(k,190) + lu(k,193) = lu(k,193) * lu(k,190) + lu(k,194) = lu(k,194) * lu(k,190) + lu(k,1632) = lu(k,1632) - lu(k,191) * lu(k,1628) + lu(k,1634) = lu(k,1634) - lu(k,192) * lu(k,1628) + lu(k,1650) = lu(k,1650) - lu(k,193) * lu(k,1628) + lu(k,1657) = lu(k,1657) - lu(k,194) * lu(k,1628) + lu(k,195) = 1._r8 / lu(k,195) + lu(k,196) = lu(k,196) * lu(k,195) + lu(k,197) = lu(k,197) * lu(k,195) + lu(k,198) = lu(k,198) * lu(k,195) + lu(k,199) = lu(k,199) * lu(k,195) + lu(k,1632) = lu(k,1632) - lu(k,196) * lu(k,1629) + lu(k,1641) = lu(k,1641) - lu(k,197) * lu(k,1629) + lu(k,1650) = lu(k,1650) - lu(k,198) * lu(k,1629) + lu(k,1657) = lu(k,1657) - lu(k,199) * lu(k,1629) + 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,750) = lu(k,750) - lu(k,201) * lu(k,749) + lu(k,755) = - lu(k,202) * lu(k,749) + lu(k,2222) = - lu(k,201) * lu(k,2219) + lu(k,2303) = lu(k,2303) - lu(k,202) * lu(k,2219) + lu(k,203) = 1._r8 / lu(k,203) + lu(k,204) = lu(k,204) * lu(k,203) + lu(k,205) = lu(k,205) * lu(k,203) + lu(k,302) = lu(k,302) - lu(k,204) * lu(k,301) + lu(k,305) = lu(k,305) - lu(k,205) * lu(k,301) + lu(k,2341) = lu(k,2341) - lu(k,204) * lu(k,2340) + lu(k,2365) = lu(k,2365) - lu(k,205) * lu(k,2340) + lu(k,207) = 1._r8 / lu(k,207) + lu(k,208) = lu(k,208) * lu(k,207) + lu(k,209) = lu(k,209) * lu(k,207) + lu(k,210) = lu(k,210) * lu(k,207) + lu(k,211) = lu(k,211) * lu(k,207) + lu(k,212) = lu(k,212) * lu(k,207) + lu(k,1690) = lu(k,1690) - lu(k,208) * lu(k,1689) + lu(k,1691) = lu(k,1691) - lu(k,209) * lu(k,1689) + lu(k,1740) = lu(k,1740) - lu(k,210) * lu(k,1689) + lu(k,1823) = lu(k,1823) - lu(k,211) * lu(k,1689) + lu(k,1831) = lu(k,1831) - lu(k,212) * lu(k,1689) + 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,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,1735) = - lu(k,214) * lu(k,1690) + lu(k,1797) = lu(k,1797) - lu(k,215) * lu(k,1690) + lu(k,1831) = lu(k,1831) - lu(k,216) * lu(k,1690) + lu(k,217) = 1._r8 / lu(k,217) + lu(k,218) = lu(k,218) * lu(k,217) + lu(k,219) = lu(k,219) * lu(k,217) + lu(k,220) = lu(k,220) * lu(k,217) + lu(k,221) = lu(k,221) * lu(k,217) + lu(k,1734) = lu(k,1734) - lu(k,218) * lu(k,1691) + lu(k,1738) = lu(k,1738) - lu(k,219) * lu(k,1691) + lu(k,1823) = lu(k,1823) - lu(k,220) * lu(k,1691) + lu(k,1831) = lu(k,1831) - lu(k,221) * lu(k,1691) + lu(k,222) = 1._r8 / lu(k,222) + lu(k,223) = lu(k,223) * lu(k,222) + lu(k,859) = lu(k,859) - lu(k,223) * lu(k,854) + lu(k,979) = lu(k,979) - lu(k,223) * lu(k,970) + lu(k,2031) = lu(k,2031) - lu(k,223) * lu(k,2013) + lu(k,2129) = lu(k,2129) - lu(k,223) * lu(k,2095) + lu(k,2335) = lu(k,2335) - lu(k,223) * lu(k,2315) + lu(k,224) = 1._r8 / lu(k,224) + lu(k,225) = lu(k,225) * lu(k,224) + lu(k,226) = lu(k,226) * lu(k,224) + lu(k,531) = - lu(k,225) * lu(k,526) + lu(k,533) = lu(k,533) - lu(k,226) * lu(k,526) + lu(k,1578) = - lu(k,225) * lu(k,1547) + lu(k,1581) = lu(k,1581) - lu(k,226) * lu(k,1547) + lu(k,1650) = lu(k,1650) - lu(k,225) * lu(k,1630) + lu(k,1653) = lu(k,1653) - lu(k,226) * lu(k,1630) + 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,1650) = lu(k,1650) - lu(k,228) * lu(k,1631) + lu(k,1651) = lu(k,1651) - lu(k,229) * lu(k,1631) + lu(k,1659) = lu(k,1659) - lu(k,230) * lu(k,1631) + lu(k,1822) = - lu(k,228) * lu(k,1692) + lu(k,1823) = lu(k,1823) - lu(k,229) * lu(k,1692) + lu(k,1831) = lu(k,1831) - lu(k,230) * lu(k,1692) + lu(k,232) = 1._r8 / lu(k,232) + lu(k,233) = lu(k,233) * lu(k,232) + lu(k,234) = lu(k,234) * lu(k,232) + lu(k,235) = lu(k,235) * lu(k,232) + lu(k,236) = lu(k,236) * lu(k,232) + lu(k,237) = lu(k,237) * lu(k,232) + lu(k,238) = lu(k,238) * lu(k,232) + lu(k,1694) = lu(k,1694) - lu(k,233) * lu(k,1693) + lu(k,1695) = lu(k,1695) - lu(k,234) * lu(k,1693) + lu(k,1733) = lu(k,1733) - lu(k,235) * lu(k,1693) + lu(k,1767) = lu(k,1767) - lu(k,236) * lu(k,1693) + lu(k,1823) = lu(k,1823) - lu(k,237) * lu(k,1693) + lu(k,1831) = lu(k,1831) - lu(k,238) * lu(k,1693) + lu(k,239) = 1._r8 / lu(k,239) + lu(k,240) = lu(k,240) * lu(k,239) + lu(k,241) = lu(k,241) * lu(k,239) + lu(k,242) = lu(k,242) * lu(k,239) + lu(k,243) = lu(k,243) * lu(k,239) + lu(k,1734) = lu(k,1734) - lu(k,240) * lu(k,1694) + lu(k,1738) = lu(k,1738) - lu(k,241) * lu(k,1694) + lu(k,1823) = lu(k,1823) - lu(k,242) * lu(k,1694) + lu(k,1831) = lu(k,1831) - lu(k,243) * lu(k,1694) + lu(k,244) = 1._r8 / lu(k,244) + lu(k,245) = lu(k,245) * lu(k,244) + lu(k,246) = lu(k,246) * lu(k,244) + lu(k,247) = lu(k,247) * lu(k,244) + lu(k,257) = - lu(k,245) * lu(k,252) + lu(k,258) = - lu(k,246) * lu(k,252) + lu(k,260) = lu(k,260) - lu(k,247) * lu(k,252) + lu(k,1797) = lu(k,1797) - lu(k,245) * lu(k,1695) + lu(k,1813) = lu(k,1813) - lu(k,246) * lu(k,1695) + lu(k,1831) = lu(k,1831) - lu(k,247) * lu(k,1695) + 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,1217) = lu(k,1217) - lu(k,249) * lu(k,1210) + lu(k,1223) = - lu(k,250) * lu(k,1210) + lu(k,1803) = lu(k,1803) - lu(k,249) * lu(k,1696) + lu(k,1823) = lu(k,1823) - lu(k,250) * lu(k,1696) + lu(k,2284) = lu(k,2284) - lu(k,249) * lu(k,2220) + lu(k,2303) = lu(k,2303) - lu(k,250) * lu(k,2220) + lu(k,253) = 1._r8 / lu(k,253) + lu(k,254) = lu(k,254) * lu(k,253) + lu(k,255) = lu(k,255) * lu(k,253) + lu(k,256) = lu(k,256) * lu(k,253) + lu(k,257) = lu(k,257) * lu(k,253) + lu(k,258) = lu(k,258) * lu(k,253) + lu(k,259) = lu(k,259) * lu(k,253) + lu(k,260) = lu(k,260) * lu(k,253) + lu(k,1698) = lu(k,1698) - lu(k,254) * lu(k,1697) + lu(k,1733) = lu(k,1733) - lu(k,255) * lu(k,1697) + lu(k,1769) = lu(k,1769) - lu(k,256) * lu(k,1697) + lu(k,1797) = lu(k,1797) - lu(k,257) * lu(k,1697) + lu(k,1813) = lu(k,1813) - lu(k,258) * lu(k,1697) + lu(k,1823) = lu(k,1823) - lu(k,259) * lu(k,1697) + lu(k,1831) = lu(k,1831) - lu(k,260) * lu(k,1697) + 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,261) = 1._r8 / lu(k,261) + lu(k,262) = lu(k,262) * lu(k,261) + lu(k,263) = lu(k,263) * lu(k,261) + lu(k,264) = lu(k,264) * lu(k,261) + lu(k,265) = lu(k,265) * lu(k,261) + lu(k,1738) = lu(k,1738) - lu(k,262) * lu(k,1698) + lu(k,1741) = lu(k,1741) - lu(k,263) * lu(k,1698) + lu(k,1823) = lu(k,1823) - lu(k,264) * lu(k,1698) + lu(k,1831) = lu(k,1831) - lu(k,265) * lu(k,1698) + lu(k,266) = 1._r8 / lu(k,266) + lu(k,267) = lu(k,267) * lu(k,266) + lu(k,268) = lu(k,268) * lu(k,266) + lu(k,937) = - lu(k,267) * lu(k,933) + lu(k,951) = lu(k,951) - lu(k,268) * lu(k,933) + lu(k,1011) = - lu(k,267) * lu(k,1008) + lu(k,1028) = lu(k,1028) - lu(k,268) * lu(k,1008) + lu(k,1784) = lu(k,1784) - lu(k,267) * lu(k,1699) + lu(k,1823) = lu(k,1823) - lu(k,268) * lu(k,1699) + lu(k,2151) = - lu(k,267) * lu(k,2139) + lu(k,2185) = lu(k,2185) - lu(k,268) * lu(k,2139) + lu(k,269) = 1._r8 / lu(k,269) + lu(k,270) = lu(k,270) * lu(k,269) + lu(k,271) = lu(k,271) * lu(k,269) + lu(k,1140) = lu(k,1140) - lu(k,270) * lu(k,1131) + lu(k,1142) = lu(k,1142) - lu(k,271) * lu(k,1131) + lu(k,1166) = - lu(k,270) * lu(k,1155) + lu(k,1168) = lu(k,1168) - lu(k,271) * lu(k,1155) + lu(k,1817) = lu(k,1817) - lu(k,270) * lu(k,1700) + lu(k,1820) = lu(k,1820) - lu(k,271) * lu(k,1700) + lu(k,1944) = - lu(k,270) * lu(k,1881) + lu(k,1947) = lu(k,1947) - lu(k,271) * lu(k,1881) + lu(k,272) = 1._r8 / lu(k,272) + lu(k,273) = lu(k,273) * lu(k,272) + lu(k,274) = lu(k,274) * lu(k,272) + lu(k,824) = lu(k,824) - lu(k,273) * lu(k,822) + lu(k,829) = - lu(k,274) * lu(k,822) + lu(k,1840) = lu(k,1840) - lu(k,273) * lu(k,1834) + lu(k,1853) = lu(k,1853) - lu(k,274) * lu(k,1834) + lu(k,2018) = - lu(k,273) * lu(k,2014) + lu(k,2031) = lu(k,2031) - lu(k,274) * lu(k,2014) + lu(k,2322) = lu(k,2322) - lu(k,273) * lu(k,2316) + lu(k,2335) = lu(k,2335) - lu(k,274) * lu(k,2316) + lu(k,275) = 1._r8 / lu(k,275) + lu(k,276) = lu(k,276) * lu(k,275) + lu(k,277) = lu(k,277) * lu(k,275) + lu(k,373) = - lu(k,276) * lu(k,370) + lu(k,374) = lu(k,374) - lu(k,277) * lu(k,370) + lu(k,487) = - lu(k,276) * lu(k,484) + lu(k,489) = - lu(k,277) * lu(k,484) + lu(k,1744) = lu(k,1744) - lu(k,276) * lu(k,1701) + lu(k,1823) = lu(k,1823) - lu(k,277) * lu(k,1701) + lu(k,1896) = lu(k,1896) - lu(k,276) * lu(k,1882) + lu(k,1950) = lu(k,1950) - lu(k,277) * lu(k,1882) + lu(k,278) = 1._r8 / lu(k,278) + lu(k,279) = lu(k,279) * lu(k,278) + lu(k,280) = lu(k,280) * lu(k,278) + lu(k,281) = lu(k,281) * lu(k,278) + lu(k,282) = lu(k,282) * lu(k,278) + lu(k,1320) = - lu(k,279) * lu(k,1317) + lu(k,1331) = - lu(k,280) * lu(k,1317) + lu(k,1343) = - lu(k,281) * lu(k,1317) + lu(k,1348) = lu(k,1348) - lu(k,282) * lu(k,1317) + lu(k,1753) = - lu(k,279) * lu(k,1702) + lu(k,1803) = lu(k,1803) - lu(k,280) * lu(k,1702) + lu(k,1823) = lu(k,1823) - lu(k,281) * lu(k,1702) + lu(k,1831) = lu(k,1831) - lu(k,282) * lu(k,1702) + 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,297) = - lu(k,284) * lu(k,295) + lu(k,298) = lu(k,298) - lu(k,285) * lu(k,295) + lu(k,335) = - lu(k,284) * lu(k,333) + lu(k,336) = lu(k,336) - lu(k,285) * lu(k,333) + lu(k,1641) = lu(k,1641) - lu(k,284) * lu(k,1632) + lu(k,1650) = lu(k,1650) - lu(k,285) * lu(k,1632) + lu(k,1781) = - lu(k,284) * lu(k,1703) + lu(k,1822) = lu(k,1822) - lu(k,285) * lu(k,1703) + lu(k,286) = 1._r8 / lu(k,286) + lu(k,287) = lu(k,287) * lu(k,286) + lu(k,288) = lu(k,288) * lu(k,286) + lu(k,289) = lu(k,289) * lu(k,286) + lu(k,290) = lu(k,290) * lu(k,286) + lu(k,1634) = lu(k,1634) - lu(k,287) * lu(k,1633) + lu(k,1650) = lu(k,1650) - lu(k,288) * lu(k,1633) + lu(k,1651) = lu(k,1651) - lu(k,289) * lu(k,1633) + lu(k,1657) = lu(k,1657) - lu(k,290) * lu(k,1633) + lu(k,1705) = lu(k,1705) - lu(k,287) * lu(k,1704) + lu(k,1822) = lu(k,1822) - lu(k,288) * lu(k,1704) + lu(k,1823) = lu(k,1823) - lu(k,289) * lu(k,1704) + lu(k,1829) = lu(k,1829) - lu(k,290) * lu(k,1704) + lu(k,291) = 1._r8 / lu(k,291) + lu(k,292) = lu(k,292) * lu(k,291) + lu(k,293) = lu(k,293) * lu(k,291) + lu(k,294) = lu(k,294) * lu(k,291) + lu(k,1641) = lu(k,1641) - lu(k,292) * lu(k,1634) + lu(k,1650) = lu(k,1650) - lu(k,293) * lu(k,1634) + lu(k,1657) = lu(k,1657) - lu(k,294) * lu(k,1634) + lu(k,1781) = lu(k,1781) - lu(k,292) * lu(k,1705) + lu(k,1822) = lu(k,1822) - lu(k,293) * lu(k,1705) + lu(k,1829) = lu(k,1829) - lu(k,294) * lu(k,1705) + 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,296) = 1._r8 / lu(k,296) + lu(k,297) = lu(k,297) * lu(k,296) + lu(k,298) = lu(k,298) * lu(k,296) + lu(k,299) = lu(k,299) * lu(k,296) + lu(k,300) = lu(k,300) * lu(k,296) + lu(k,1641) = lu(k,1641) - lu(k,297) * lu(k,1635) + lu(k,1650) = lu(k,1650) - lu(k,298) * lu(k,1635) + lu(k,1651) = lu(k,1651) - lu(k,299) * lu(k,1635) + lu(k,1657) = lu(k,1657) - lu(k,300) * lu(k,1635) + lu(k,1781) = lu(k,1781) - lu(k,297) * lu(k,1706) + lu(k,1822) = lu(k,1822) - lu(k,298) * lu(k,1706) + lu(k,1823) = lu(k,1823) - lu(k,299) * lu(k,1706) + lu(k,1829) = lu(k,1829) - lu(k,300) * lu(k,1706) + lu(k,302) = 1._r8 / lu(k,302) + lu(k,303) = lu(k,303) * lu(k,302) + lu(k,304) = lu(k,304) * lu(k,302) + lu(k,305) = lu(k,305) * lu(k,302) + lu(k,902) = lu(k,902) - lu(k,303) * lu(k,901) + lu(k,904) = lu(k,904) - lu(k,304) * lu(k,901) + lu(k,907) = - lu(k,305) * lu(k,901) + lu(k,1780) = lu(k,1780) - lu(k,303) * lu(k,1707) + lu(k,1821) = lu(k,1821) - lu(k,304) * lu(k,1707) + lu(k,1833) = lu(k,1833) - lu(k,305) * lu(k,1707) + lu(k,2343) = - lu(k,303) * lu(k,2341) + lu(k,2353) = lu(k,2353) - lu(k,304) * lu(k,2341) + lu(k,2365) = lu(k,2365) - lu(k,305) * lu(k,2341) + lu(k,306) = 1._r8 / lu(k,306) + lu(k,307) = lu(k,307) * lu(k,306) + lu(k,308) = lu(k,308) * lu(k,306) + lu(k,309) = lu(k,309) * lu(k,306) + lu(k,866) = lu(k,866) - lu(k,307) * lu(k,862) + lu(k,869) = - lu(k,308) * lu(k,862) + lu(k,872) = lu(k,872) - lu(k,309) * lu(k,862) + lu(k,1793) = lu(k,1793) - lu(k,307) * lu(k,1708) + lu(k,1823) = lu(k,1823) - lu(k,308) * lu(k,1708) + lu(k,1831) = lu(k,1831) - lu(k,309) * lu(k,1708) + lu(k,1976) = lu(k,1976) - lu(k,307) * lu(k,1961) + lu(k,2002) = - lu(k,308) * lu(k,1961) + lu(k,2010) = lu(k,2010) - lu(k,309) * lu(k,1961) + lu(k,310) = 1._r8 / lu(k,310) + lu(k,311) = lu(k,311) * lu(k,310) + lu(k,312) = lu(k,312) * lu(k,310) + lu(k,313) = lu(k,313) * lu(k,310) + lu(k,669) = lu(k,669) - lu(k,311) * lu(k,668) + lu(k,670) = lu(k,670) - lu(k,312) * lu(k,668) + lu(k,672) = - lu(k,313) * lu(k,668) + lu(k,1738) = lu(k,1738) - lu(k,311) * lu(k,1709) + lu(k,1757) = lu(k,1757) - lu(k,312) * lu(k,1709) + lu(k,1823) = lu(k,1823) - lu(k,313) * lu(k,1709) + lu(k,2241) = - lu(k,311) * lu(k,2221) + lu(k,2248) = lu(k,2248) - lu(k,312) * lu(k,2221) + lu(k,2303) = lu(k,2303) - lu(k,313) * lu(k,2221) + lu(k,314) = 1._r8 / lu(k,314) + lu(k,315) = lu(k,315) * lu(k,314) + lu(k,316) = lu(k,316) * lu(k,314) + lu(k,317) = lu(k,317) * lu(k,314) + lu(k,752) = - lu(k,315) * lu(k,750) + lu(k,753) = lu(k,753) - lu(k,316) * lu(k,750) + lu(k,757) = lu(k,757) - lu(k,317) * lu(k,750) + lu(k,1923) = lu(k,1923) - lu(k,315) * lu(k,1883) + lu(k,1946) = lu(k,1946) - lu(k,316) * lu(k,1883) + lu(k,1958) = lu(k,1958) - lu(k,317) * lu(k,1883) + lu(k,2276) = - lu(k,315) * lu(k,2222) + lu(k,2299) = lu(k,2299) - lu(k,316) * lu(k,2222) + lu(k,2311) = lu(k,2311) - lu(k,317) * lu(k,2222) + 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,722) = - lu(k,319) * lu(k,716) + lu(k,728) = lu(k,728) - lu(k,320) * lu(k,716) + lu(k,741) = - lu(k,319) * lu(k,734) + lu(k,748) = lu(k,748) - lu(k,320) * lu(k,734) + lu(k,770) = - lu(k,319) * lu(k,764) + lu(k,778) = lu(k,778) - lu(k,320) * lu(k,764) + lu(k,794) = - lu(k,319) * lu(k,787) + lu(k,803) = lu(k,803) - lu(k,320) * lu(k,787) + lu(k,1909) = lu(k,1909) - lu(k,319) * lu(k,1884) + lu(k,1958) = lu(k,1958) - lu(k,320) * lu(k,1884) + lu(k,321) = 1._r8 / lu(k,321) + lu(k,322) = lu(k,322) * lu(k,321) + lu(k,323) = lu(k,323) * lu(k,321) + lu(k,324) = lu(k,324) * lu(k,321) + lu(k,325) = lu(k,325) * lu(k,321) + lu(k,326) = lu(k,326) * lu(k,321) + lu(k,1787) = lu(k,1787) - lu(k,322) * lu(k,1710) + lu(k,1788) = lu(k,1788) - lu(k,323) * lu(k,1710) + lu(k,1797) = lu(k,1797) - lu(k,324) * lu(k,1710) + lu(k,1823) = lu(k,1823) - lu(k,325) * lu(k,1710) + lu(k,1831) = lu(k,1831) - lu(k,326) * lu(k,1710) + lu(k,2108) = - lu(k,322) * lu(k,2096) + lu(k,2109) = - lu(k,323) * lu(k,2096) + lu(k,2112) = lu(k,2112) - lu(k,324) * lu(k,2096) + lu(k,2123) = lu(k,2123) - lu(k,325) * lu(k,2096) + lu(k,2131) = lu(k,2131) - lu(k,326) * lu(k,2096) + lu(k,327) = 1._r8 / lu(k,327) + lu(k,328) = lu(k,328) * lu(k,327) + lu(k,329) = lu(k,329) * lu(k,327) + lu(k,330) = lu(k,330) * lu(k,327) + lu(k,331) = lu(k,331) * lu(k,327) + lu(k,332) = lu(k,332) * lu(k,327) + lu(k,1776) = lu(k,1776) - lu(k,328) * lu(k,1711) + lu(k,1823) = lu(k,1823) - lu(k,329) * lu(k,1711) + lu(k,1827) = lu(k,1827) - lu(k,330) * lu(k,1711) + lu(k,1829) = lu(k,1829) - lu(k,331) * lu(k,1711) + lu(k,1833) = lu(k,1833) - lu(k,332) * lu(k,1711) + lu(k,2106) = lu(k,2106) - lu(k,328) * lu(k,2097) + lu(k,2123) = lu(k,2123) - lu(k,329) * lu(k,2097) + lu(k,2127) = lu(k,2127) - lu(k,330) * lu(k,2097) + lu(k,2129) = lu(k,2129) - lu(k,331) * lu(k,2097) + lu(k,2133) = - lu(k,332) * lu(k,2097) + 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,334) = 1._r8 / lu(k,334) + lu(k,335) = lu(k,335) * lu(k,334) + lu(k,336) = lu(k,336) * lu(k,334) + lu(k,337) = lu(k,337) * lu(k,334) + lu(k,338) = lu(k,338) * lu(k,334) + lu(k,339) = lu(k,339) * lu(k,334) + lu(k,1641) = lu(k,1641) - lu(k,335) * lu(k,1636) + lu(k,1650) = lu(k,1650) - lu(k,336) * lu(k,1636) + lu(k,1651) = lu(k,1651) - lu(k,337) * lu(k,1636) + lu(k,1657) = lu(k,1657) - lu(k,338) * lu(k,1636) + lu(k,1661) = lu(k,1661) - lu(k,339) * lu(k,1636) + lu(k,1781) = lu(k,1781) - lu(k,335) * lu(k,1712) + lu(k,1822) = lu(k,1822) - lu(k,336) * lu(k,1712) + lu(k,1823) = lu(k,1823) - lu(k,337) * lu(k,1712) + lu(k,1829) = lu(k,1829) - lu(k,338) * lu(k,1712) + lu(k,1833) = lu(k,1833) - lu(k,339) * lu(k,1712) + lu(k,340) = 1._r8 / lu(k,340) + lu(k,341) = lu(k,341) * lu(k,340) + lu(k,342) = lu(k,342) * lu(k,340) + lu(k,909) = lu(k,909) - lu(k,341) * lu(k,908) + lu(k,913) = lu(k,913) - lu(k,342) * lu(k,908) + lu(k,1447) = lu(k,1447) - lu(k,341) * lu(k,1446) + lu(k,1451) = lu(k,1451) - lu(k,342) * lu(k,1446) + lu(k,1474) = lu(k,1474) - lu(k,341) * lu(k,1472) + lu(k,1479) = lu(k,1479) - lu(k,342) * lu(k,1472) + lu(k,1491) = lu(k,1491) - lu(k,341) * lu(k,1490) + lu(k,1495) = - lu(k,342) * lu(k,1490) + lu(k,2344) = lu(k,2344) - lu(k,341) * lu(k,2342) + lu(k,2350) = lu(k,2350) - lu(k,342) * lu(k,2342) + lu(k,343) = 1._r8 / lu(k,343) + lu(k,344) = lu(k,344) * lu(k,343) + lu(k,345) = lu(k,345) * lu(k,343) + lu(k,346) = lu(k,346) * lu(k,343) + lu(k,347) = lu(k,347) * lu(k,343) + lu(k,348) = lu(k,348) * lu(k,343) + lu(k,1573) = lu(k,1573) - lu(k,344) * lu(k,1548) + lu(k,1576) = lu(k,1576) - lu(k,345) * lu(k,1548) + lu(k,1577) = lu(k,1577) - lu(k,346) * lu(k,1548) + lu(k,1581) = lu(k,1581) - lu(k,347) * lu(k,1548) + lu(k,1584) = lu(k,1584) - lu(k,348) * lu(k,1548) + lu(k,2078) = lu(k,2078) - lu(k,344) * lu(k,2038) + lu(k,2081) = lu(k,2081) - lu(k,345) * lu(k,2038) + lu(k,2082) = lu(k,2082) - lu(k,346) * lu(k,2038) + lu(k,2086) = lu(k,2086) - lu(k,347) * lu(k,2038) + lu(k,2089) = lu(k,2089) - lu(k,348) * lu(k,2038) + lu(k,349) = 1._r8 / lu(k,349) + lu(k,350) = lu(k,350) * lu(k,349) + lu(k,351) = lu(k,351) * lu(k,349) + lu(k,352) = lu(k,352) * lu(k,349) + lu(k,353) = lu(k,353) * lu(k,349) + lu(k,354) = lu(k,354) * lu(k,349) + lu(k,1780) = lu(k,1780) - lu(k,350) * lu(k,1713) + lu(k,1817) = lu(k,1817) - lu(k,351) * lu(k,1713) + lu(k,1823) = lu(k,1823) - lu(k,352) * lu(k,1713) + lu(k,1828) = lu(k,1828) - lu(k,353) * lu(k,1713) + lu(k,1831) = lu(k,1831) - lu(k,354) * lu(k,1713) + lu(k,2045) = lu(k,2045) - lu(k,350) * lu(k,2039) + lu(k,2078) = lu(k,2078) - lu(k,351) * lu(k,2039) + lu(k,2084) = lu(k,2084) - lu(k,352) * lu(k,2039) + lu(k,2089) = lu(k,2089) - lu(k,353) * lu(k,2039) + lu(k,2092) = lu(k,2092) - lu(k,354) * lu(k,2039) + lu(k,355) = 1._r8 / lu(k,355) + lu(k,356) = lu(k,356) * lu(k,355) + lu(k,357) = lu(k,357) * lu(k,355) + lu(k,358) = lu(k,358) * lu(k,355) + lu(k,359) = lu(k,359) * lu(k,355) + lu(k,744) = - lu(k,356) * lu(k,735) + lu(k,745) = lu(k,745) - lu(k,357) * lu(k,735) + lu(k,746) = - lu(k,358) * lu(k,735) + lu(k,748) = lu(k,748) - lu(k,359) * lu(k,735) + lu(k,797) = - lu(k,356) * lu(k,788) + lu(k,798) = lu(k,798) - lu(k,357) * lu(k,788) + lu(k,799) = - lu(k,358) * lu(k,788) + lu(k,803) = lu(k,803) - lu(k,359) * lu(k,788) + lu(k,1926) = lu(k,1926) - lu(k,356) * lu(k,1885) + lu(k,1935) = lu(k,1935) - lu(k,357) * lu(k,1885) + lu(k,1941) = lu(k,1941) - lu(k,358) * lu(k,1885) + lu(k,1958) = lu(k,1958) - lu(k,359) * lu(k,1885) + 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,1275) = lu(k,1275) - lu(k,361) * lu(k,1273) + lu(k,1276) = lu(k,1276) - lu(k,362) * lu(k,1273) + lu(k,1280) = lu(k,1280) - lu(k,363) * lu(k,1273) + lu(k,1287) = lu(k,1287) - lu(k,364) * lu(k,1273) + lu(k,1838) = lu(k,1838) - lu(k,361) * lu(k,1835) + lu(k,1839) = lu(k,1839) - lu(k,362) * lu(k,1835) + lu(k,1845) = lu(k,1845) - lu(k,363) * lu(k,1835) + lu(k,1856) = lu(k,1856) - lu(k,364) * lu(k,1835) + lu(k,2319) = lu(k,2319) - lu(k,361) * lu(k,2317) + lu(k,2321) = lu(k,2321) - lu(k,362) * lu(k,2317) + lu(k,2327) = lu(k,2327) - lu(k,363) * lu(k,2317) + lu(k,2338) = lu(k,2338) - lu(k,364) * lu(k,2317) + lu(k,365) = 1._r8 / lu(k,365) + lu(k,366) = lu(k,366) * lu(k,365) + lu(k,367) = lu(k,367) * lu(k,365) + lu(k,368) = lu(k,368) * lu(k,365) + lu(k,369) = lu(k,369) * lu(k,365) + lu(k,499) = lu(k,499) - lu(k,366) * lu(k,498) + lu(k,500) = lu(k,500) - lu(k,367) * lu(k,498) + lu(k,502) = - lu(k,368) * lu(k,498) + lu(k,504) = lu(k,504) - lu(k,369) * lu(k,498) + lu(k,1734) = lu(k,1734) - lu(k,366) * lu(k,1714) + lu(k,1788) = lu(k,1788) - lu(k,367) * lu(k,1714) + lu(k,1823) = lu(k,1823) - lu(k,368) * lu(k,1714) + lu(k,1831) = lu(k,1831) - lu(k,369) * lu(k,1714) + lu(k,2238) = lu(k,2238) - lu(k,366) * lu(k,2223) + lu(k,2273) = lu(k,2273) - lu(k,367) * lu(k,2223) + lu(k,2303) = lu(k,2303) - lu(k,368) * lu(k,2223) + lu(k,2311) = lu(k,2311) - lu(k,369) * lu(k,2223) + lu(k,371) = 1._r8 / lu(k,371) + lu(k,372) = lu(k,372) * lu(k,371) + lu(k,373) = lu(k,373) * lu(k,371) + lu(k,374) = lu(k,374) * lu(k,371) + lu(k,375) = lu(k,375) * lu(k,371) + lu(k,486) = lu(k,486) - lu(k,372) * lu(k,485) + lu(k,487) = lu(k,487) - lu(k,373) * lu(k,485) + lu(k,489) = lu(k,489) - lu(k,374) * lu(k,485) + lu(k,491) = lu(k,491) - lu(k,375) * lu(k,485) + lu(k,1733) = lu(k,1733) - lu(k,372) * lu(k,1715) + lu(k,1744) = lu(k,1744) - lu(k,373) * lu(k,1715) + lu(k,1823) = lu(k,1823) - lu(k,374) * lu(k,1715) + lu(k,1831) = lu(k,1831) - lu(k,375) * lu(k,1715) + lu(k,2236) = lu(k,2236) - lu(k,372) * lu(k,2224) + lu(k,2244) = lu(k,2244) - lu(k,373) * lu(k,2224) + lu(k,2303) = lu(k,2303) - lu(k,374) * lu(k,2224) + lu(k,2311) = lu(k,2311) - lu(k,375) * lu(k,2224) + lu(k,376) = 1._r8 / lu(k,376) + lu(k,377) = lu(k,377) * lu(k,376) + lu(k,378) = lu(k,378) * lu(k,376) + lu(k,379) = lu(k,379) * lu(k,376) + lu(k,380) = lu(k,380) * lu(k,376) + lu(k,865) = lu(k,865) - lu(k,377) * lu(k,863) + lu(k,866) = lu(k,866) - lu(k,378) * lu(k,863) + lu(k,869) = lu(k,869) - lu(k,379) * lu(k,863) + lu(k,872) = lu(k,872) - lu(k,380) * lu(k,863) + lu(k,1776) = lu(k,1776) - lu(k,377) * lu(k,1716) + lu(k,1793) = lu(k,1793) - lu(k,378) * lu(k,1716) + lu(k,1823) = lu(k,1823) - lu(k,379) * lu(k,1716) + lu(k,1831) = lu(k,1831) - lu(k,380) * lu(k,1716) + lu(k,2266) = lu(k,2266) - lu(k,377) * lu(k,2225) + lu(k,2275) = lu(k,2275) - lu(k,378) * lu(k,2225) + lu(k,2303) = lu(k,2303) - lu(k,379) * lu(k,2225) + lu(k,2311) = lu(k,2311) - lu(k,380) * lu(k,2225) + 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,381) = 1._r8 / lu(k,381) + lu(k,382) = lu(k,382) * lu(k,381) + lu(k,383) = lu(k,383) * lu(k,381) + lu(k,1331) = lu(k,1331) - lu(k,382) * lu(k,1318) + lu(k,1343) = lu(k,1343) - lu(k,383) * lu(k,1318) + lu(k,1424) = lu(k,1424) - lu(k,382) * lu(k,1414) + lu(k,1439) = lu(k,1439) - lu(k,383) * lu(k,1414) + lu(k,1803) = lu(k,1803) - lu(k,382) * lu(k,1717) + lu(k,1823) = lu(k,1823) - lu(k,383) * lu(k,1717) + lu(k,1932) = lu(k,1932) - lu(k,382) * lu(k,1886) + lu(k,1950) = lu(k,1950) - lu(k,383) * lu(k,1886) + lu(k,1985) = lu(k,1985) - lu(k,382) * lu(k,1962) + lu(k,2002) = lu(k,2002) - lu(k,383) * lu(k,1962) + lu(k,2065) = lu(k,2065) - lu(k,382) * lu(k,2040) + lu(k,2084) = lu(k,2084) - lu(k,383) * lu(k,2040) + lu(k,384) = 1._r8 / lu(k,384) + lu(k,385) = lu(k,385) * lu(k,384) + lu(k,386) = lu(k,386) * lu(k,384) + lu(k,387) = lu(k,387) * lu(k,384) + lu(k,388) = lu(k,388) * lu(k,384) + lu(k,1358) = lu(k,1358) - lu(k,385) * lu(k,1350) + lu(k,1359) = - lu(k,386) * lu(k,1350) + lu(k,1365) = - lu(k,387) * lu(k,1350) + lu(k,1369) = lu(k,1369) - lu(k,388) * lu(k,1350) + lu(k,1810) = lu(k,1810) - lu(k,385) * lu(k,1718) + lu(k,1812) = lu(k,1812) - lu(k,386) * lu(k,1718) + lu(k,1823) = lu(k,1823) - lu(k,387) * lu(k,1718) + lu(k,1831) = lu(k,1831) - lu(k,388) * lu(k,1718) + lu(k,2290) = lu(k,2290) - lu(k,385) * lu(k,2226) + lu(k,2292) = lu(k,2292) - lu(k,386) * lu(k,2226) + lu(k,2303) = lu(k,2303) - lu(k,387) * lu(k,2226) + lu(k,2311) = lu(k,2311) - lu(k,388) * lu(k,2226) + 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,699) = lu(k,699) - lu(k,390) * lu(k,698) + lu(k,700) = lu(k,700) - lu(k,391) * lu(k,698) + lu(k,701) = lu(k,701) - lu(k,392) * lu(k,698) + lu(k,703) = lu(k,703) - lu(k,393) * lu(k,698) + lu(k,1760) = lu(k,1760) - lu(k,390) * lu(k,1719) + lu(k,1793) = lu(k,1793) - lu(k,391) * lu(k,1719) + lu(k,1813) = lu(k,1813) - lu(k,392) * lu(k,1719) + lu(k,1823) = lu(k,1823) - lu(k,393) * lu(k,1719) + lu(k,2250) = lu(k,2250) - lu(k,390) * lu(k,2227) + lu(k,2275) = lu(k,2275) - lu(k,391) * lu(k,2227) + lu(k,2293) = lu(k,2293) - lu(k,392) * lu(k,2227) + lu(k,2303) = lu(k,2303) - lu(k,393) * lu(k,2227) + lu(k,394) = 1._r8 / lu(k,394) + lu(k,395) = lu(k,395) * lu(k,394) + lu(k,396) = lu(k,396) * lu(k,394) + lu(k,397) = lu(k,397) * lu(k,394) + lu(k,398) = lu(k,398) * lu(k,394) + lu(k,399) = lu(k,399) * lu(k,394) + lu(k,400) = lu(k,400) * lu(k,394) + lu(k,401) = lu(k,401) * lu(k,394) + lu(k,1749) = lu(k,1749) - lu(k,395) * lu(k,1720) + lu(k,1786) = lu(k,1786) - lu(k,396) * lu(k,1720) + lu(k,1793) = lu(k,1793) - lu(k,397) * lu(k,1720) + lu(k,1819) = lu(k,1819) - lu(k,398) * lu(k,1720) + lu(k,1820) = lu(k,1820) - lu(k,399) * lu(k,1720) + lu(k,1823) = lu(k,1823) - lu(k,400) * lu(k,1720) + lu(k,1828) = lu(k,1828) - lu(k,401) * lu(k,1720) + lu(k,2042) = - lu(k,395) * lu(k,2041) + lu(k,2048) = lu(k,2048) - lu(k,396) * lu(k,2041) + lu(k,2055) = lu(k,2055) - lu(k,397) * lu(k,2041) + lu(k,2080) = lu(k,2080) - lu(k,398) * lu(k,2041) + lu(k,2081) = lu(k,2081) - lu(k,399) * lu(k,2041) + lu(k,2084) = lu(k,2084) - lu(k,400) * lu(k,2041) + lu(k,2089) = lu(k,2089) - lu(k,401) * lu(k,2041) + lu(k,402) = 1._r8 / lu(k,402) + lu(k,403) = lu(k,403) * lu(k,402) + lu(k,404) = lu(k,404) * lu(k,402) + lu(k,405) = lu(k,405) * lu(k,402) + lu(k,406) = lu(k,406) * lu(k,402) + lu(k,407) = lu(k,407) * lu(k,402) + lu(k,408) = lu(k,408) * lu(k,402) + lu(k,409) = lu(k,409) * lu(k,402) + lu(k,1797) = lu(k,1797) - lu(k,403) * lu(k,1721) + lu(k,1823) = lu(k,1823) - lu(k,404) * lu(k,1721) + lu(k,1826) = lu(k,1826) - lu(k,405) * lu(k,1721) + lu(k,1827) = lu(k,1827) - lu(k,406) * lu(k,1721) + lu(k,1829) = lu(k,1829) - lu(k,407) * lu(k,1721) + lu(k,1831) = lu(k,1831) - lu(k,408) * lu(k,1721) + lu(k,1833) = lu(k,1833) - lu(k,409) * lu(k,1721) + lu(k,2112) = lu(k,2112) - lu(k,403) * lu(k,2098) + lu(k,2123) = lu(k,2123) - lu(k,404) * lu(k,2098) + lu(k,2126) = lu(k,2126) - lu(k,405) * lu(k,2098) + lu(k,2127) = lu(k,2127) - lu(k,406) * lu(k,2098) + lu(k,2129) = lu(k,2129) - lu(k,407) * lu(k,2098) + lu(k,2131) = lu(k,2131) - lu(k,408) * lu(k,2098) + lu(k,2133) = lu(k,2133) - lu(k,409) * lu(k,2098) + lu(k,410) = 1._r8 / lu(k,410) + lu(k,411) = lu(k,411) * lu(k,410) + lu(k,412) = lu(k,412) * lu(k,410) + lu(k,413) = lu(k,413) * lu(k,410) + lu(k,414) = lu(k,414) * lu(k,410) + lu(k,415) = lu(k,415) * lu(k,410) + lu(k,416) = lu(k,416) * lu(k,410) + lu(k,417) = lu(k,417) * lu(k,410) + lu(k,1591) = - lu(k,411) * lu(k,1590) + lu(k,1597) = - lu(k,412) * lu(k,1590) + lu(k,1599) = lu(k,1599) - lu(k,413) * lu(k,1590) + lu(k,1600) = lu(k,1600) - lu(k,414) * lu(k,1590) + lu(k,1605) = lu(k,1605) - lu(k,415) * lu(k,1590) + lu(k,1608) = lu(k,1608) - lu(k,416) * lu(k,1590) + lu(k,1610) = lu(k,1610) - lu(k,417) * lu(k,1590) + lu(k,1743) = lu(k,1743) - lu(k,411) * lu(k,1722) + lu(k,1780) = lu(k,1780) - lu(k,412) * lu(k,1722) + lu(k,1797) = lu(k,1797) - lu(k,413) * lu(k,1722) + lu(k,1807) = lu(k,1807) - lu(k,414) * lu(k,1722) + lu(k,1818) = lu(k,1818) - lu(k,415) * lu(k,1722) + lu(k,1821) = lu(k,1821) - lu(k,416) * lu(k,1722) + lu(k,1823) = lu(k,1823) - lu(k,417) * lu(k,1722) + lu(k,418) = 1._r8 / lu(k,418) + lu(k,419) = lu(k,419) * lu(k,418) + lu(k,420) = lu(k,420) * lu(k,418) + lu(k,421) = lu(k,421) * lu(k,418) + lu(k,422) = lu(k,422) * lu(k,418) + lu(k,423) = lu(k,423) * lu(k,418) + lu(k,1200) = lu(k,1200) - lu(k,419) * lu(k,1197) + lu(k,1202) = lu(k,1202) - lu(k,420) * lu(k,1197) + lu(k,1203) = lu(k,1203) - lu(k,421) * lu(k,1197) + lu(k,1205) = lu(k,1205) - lu(k,422) * lu(k,1197) + lu(k,1209) = - lu(k,423) * lu(k,1197) + lu(k,1802) = lu(k,1802) - lu(k,419) * lu(k,1723) + lu(k,1813) = lu(k,1813) - lu(k,420) * lu(k,1723) + lu(k,1819) = lu(k,1819) - lu(k,421) * lu(k,1723) + lu(k,1823) = lu(k,1823) - lu(k,422) * lu(k,1723) + lu(k,1833) = lu(k,1833) - lu(k,423) * lu(k,1723) + lu(k,2283) = lu(k,2283) - lu(k,419) * lu(k,2228) + lu(k,2293) = lu(k,2293) - lu(k,420) * lu(k,2228) + lu(k,2299) = lu(k,2299) - lu(k,421) * lu(k,2228) + lu(k,2303) = lu(k,2303) - lu(k,422) * lu(k,2228) + lu(k,2313) = lu(k,2313) - lu(k,423) * lu(k,2228) + lu(k,424) = 1._r8 / lu(k,424) + lu(k,425) = lu(k,425) * lu(k,424) + lu(k,426) = lu(k,426) * lu(k,424) + lu(k,427) = lu(k,427) * lu(k,424) + lu(k,428) = lu(k,428) * lu(k,424) + lu(k,429) = lu(k,429) * lu(k,424) + lu(k,1230) = - lu(k,425) * lu(k,1228) + lu(k,1232) = - lu(k,426) * lu(k,1228) + lu(k,1244) = lu(k,1244) - lu(k,427) * lu(k,1228) + lu(k,1246) = - lu(k,428) * lu(k,1228) + lu(k,1250) = lu(k,1250) - lu(k,429) * lu(k,1228) + lu(k,1768) = lu(k,1768) - lu(k,425) * lu(k,1724) + lu(k,1779) = lu(k,1779) - lu(k,426) * lu(k,1724) + lu(k,1820) = lu(k,1820) - lu(k,427) * lu(k,1724) + lu(k,1823) = lu(k,1823) - lu(k,428) * lu(k,1724) + lu(k,1831) = lu(k,1831) - lu(k,429) * lu(k,1724) + lu(k,2258) = lu(k,2258) - lu(k,425) * lu(k,2229) + lu(k,2268) = - lu(k,426) * lu(k,2229) + lu(k,2300) = lu(k,2300) - lu(k,427) * lu(k,2229) + lu(k,2303) = lu(k,2303) - lu(k,428) * lu(k,2229) + lu(k,2311) = lu(k,2311) - lu(k,429) * lu(k,2229) + 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,430) = 1._r8 / lu(k,430) + lu(k,431) = lu(k,431) * lu(k,430) + lu(k,432) = lu(k,432) * lu(k,430) + lu(k,433) = lu(k,433) * lu(k,430) + lu(k,434) = lu(k,434) * lu(k,430) + lu(k,435) = lu(k,435) * lu(k,430) + lu(k,940) = - lu(k,431) * lu(k,934) + lu(k,944) = lu(k,944) - lu(k,432) * lu(k,934) + lu(k,947) = - lu(k,433) * lu(k,934) + lu(k,948) = lu(k,948) - lu(k,434) * lu(k,934) + lu(k,954) = lu(k,954) - lu(k,435) * lu(k,934) + lu(k,1014) = - lu(k,431) * lu(k,1009) + lu(k,1020) = lu(k,1020) - lu(k,432) * lu(k,1009) + lu(k,1023) = - lu(k,433) * lu(k,1009) + lu(k,1024) = lu(k,1024) - lu(k,434) * lu(k,1009) + lu(k,1033) = lu(k,1033) - lu(k,435) * lu(k,1009) + lu(k,2154) = - lu(k,431) * lu(k,2140) + lu(k,2162) = lu(k,2162) - lu(k,432) * lu(k,2140) + lu(k,2169) = lu(k,2169) - lu(k,433) * lu(k,2140) + lu(k,2176) = lu(k,2176) - lu(k,434) * lu(k,2140) + lu(k,2193) = lu(k,2193) - lu(k,435) * lu(k,2140) + lu(k,436) = 1._r8 / lu(k,436) + lu(k,437) = lu(k,437) * lu(k,436) + lu(k,438) = lu(k,438) * lu(k,436) + lu(k,439) = lu(k,439) * lu(k,436) + lu(k,440) = lu(k,440) * lu(k,436) + lu(k,441) = lu(k,441) * lu(k,436) + lu(k,836) = lu(k,836) - lu(k,437) * lu(k,835) + lu(k,837) = lu(k,837) - lu(k,438) * lu(k,835) + lu(k,841) = - lu(k,439) * lu(k,835) + lu(k,844) = lu(k,844) - lu(k,440) * lu(k,835) + lu(k,845) = - lu(k,441) * lu(k,835) + lu(k,1773) = lu(k,1773) - lu(k,437) * lu(k,1725) + lu(k,1786) = lu(k,1786) - lu(k,438) * lu(k,1725) + lu(k,1823) = lu(k,1823) - lu(k,439) * lu(k,1725) + lu(k,1831) = lu(k,1831) - lu(k,440) * lu(k,1725) + lu(k,1833) = lu(k,1833) - lu(k,441) * lu(k,1725) + lu(k,2263) = lu(k,2263) - lu(k,437) * lu(k,2230) + lu(k,2271) = - lu(k,438) * lu(k,2230) + lu(k,2303) = lu(k,2303) - lu(k,439) * lu(k,2230) + lu(k,2311) = lu(k,2311) - lu(k,440) * lu(k,2230) + lu(k,2313) = lu(k,2313) - lu(k,441) * lu(k,2230) + lu(k,442) = 1._r8 / lu(k,442) + lu(k,443) = lu(k,443) * lu(k,442) + lu(k,444) = lu(k,444) * lu(k,442) + lu(k,445) = lu(k,445) * lu(k,442) + lu(k,446) = lu(k,446) * lu(k,442) + lu(k,447) = lu(k,447) * lu(k,442) + lu(k,1576) = lu(k,1576) - lu(k,443) * lu(k,1549) + lu(k,1579) = lu(k,1579) - lu(k,444) * lu(k,1549) + lu(k,1584) = lu(k,1584) - lu(k,445) * lu(k,1549) + lu(k,1587) = lu(k,1587) - lu(k,446) * lu(k,1549) + lu(k,1589) = - lu(k,447) * lu(k,1549) + lu(k,1820) = lu(k,1820) - lu(k,443) * lu(k,1726) + lu(k,1823) = lu(k,1823) - lu(k,444) * lu(k,1726) + lu(k,1828) = lu(k,1828) - lu(k,445) * lu(k,1726) + lu(k,1831) = lu(k,1831) - lu(k,446) * lu(k,1726) + lu(k,1833) = lu(k,1833) - lu(k,447) * lu(k,1726) + lu(k,2300) = lu(k,2300) - lu(k,443) * lu(k,2231) + lu(k,2303) = lu(k,2303) - lu(k,444) * lu(k,2231) + lu(k,2308) = lu(k,2308) - lu(k,445) * lu(k,2231) + lu(k,2311) = lu(k,2311) - lu(k,446) * lu(k,2231) + lu(k,2313) = lu(k,2313) - lu(k,447) * lu(k,2231) + 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,1101) = lu(k,1101) - lu(k,449) * lu(k,1098) + lu(k,1102) = lu(k,1102) - lu(k,450) * lu(k,1098) + lu(k,1106) = - lu(k,451) * lu(k,1098) + lu(k,1108) = lu(k,1108) - lu(k,452) * lu(k,1098) + lu(k,1109) = - lu(k,453) * lu(k,1098) + lu(k,1790) = lu(k,1790) - lu(k,449) * lu(k,1727) + lu(k,1795) = lu(k,1795) - lu(k,450) * lu(k,1727) + lu(k,1817) = lu(k,1817) - lu(k,451) * lu(k,1727) + lu(k,1820) = lu(k,1820) - lu(k,452) * lu(k,1727) + lu(k,1823) = lu(k,1823) - lu(k,453) * lu(k,1727) + lu(k,2274) = - lu(k,449) * lu(k,2232) + lu(k,2277) = lu(k,2277) - lu(k,450) * lu(k,2232) + lu(k,2297) = - lu(k,451) * lu(k,2232) + lu(k,2300) = lu(k,2300) - lu(k,452) * lu(k,2232) + lu(k,2303) = lu(k,2303) - lu(k,453) * lu(k,2232) + lu(k,454) = 1._r8 / lu(k,454) + lu(k,455) = lu(k,455) * lu(k,454) + lu(k,456) = lu(k,456) * lu(k,454) + lu(k,457) = lu(k,457) * lu(k,454) + lu(k,458) = lu(k,458) * lu(k,454) + lu(k,459) = lu(k,459) * lu(k,454) + lu(k,1818) = lu(k,1818) - lu(k,455) * lu(k,1728) + lu(k,1819) = lu(k,1819) - lu(k,456) * lu(k,1728) + lu(k,1823) = lu(k,1823) - lu(k,457) * lu(k,1728) + lu(k,1826) = lu(k,1826) - lu(k,458) * lu(k,1728) + lu(k,1833) = lu(k,1833) - lu(k,459) * lu(k,1728) + lu(k,1997) = - lu(k,455) * lu(k,1963) + lu(k,1998) = lu(k,1998) - lu(k,456) * lu(k,1963) + lu(k,2002) = lu(k,2002) - lu(k,457) * lu(k,1963) + lu(k,2005) = lu(k,2005) - lu(k,458) * lu(k,1963) + lu(k,2012) = - lu(k,459) * lu(k,1963) + lu(k,2298) = lu(k,2298) - lu(k,455) * lu(k,2233) + lu(k,2299) = lu(k,2299) - lu(k,456) * lu(k,2233) + lu(k,2303) = lu(k,2303) - lu(k,457) * lu(k,2233) + lu(k,2306) = lu(k,2306) - lu(k,458) * lu(k,2233) + lu(k,2313) = lu(k,2313) - lu(k,459) * lu(k,2233) + lu(k,460) = 1._r8 / lu(k,460) + lu(k,461) = lu(k,461) * lu(k,460) + lu(k,462) = lu(k,462) * lu(k,460) + lu(k,463) = lu(k,463) * lu(k,460) + lu(k,464) = lu(k,464) * lu(k,460) + lu(k,465) = lu(k,465) * lu(k,460) + lu(k,1643) = lu(k,1643) - lu(k,461) * lu(k,1637) + lu(k,1650) = lu(k,1650) - lu(k,462) * lu(k,1637) + lu(k,1651) = lu(k,1651) - lu(k,463) * lu(k,1637) + lu(k,1655) = lu(k,1655) - lu(k,464) * lu(k,1637) + lu(k,1657) = lu(k,1657) - lu(k,465) * lu(k,1637) + lu(k,1815) = lu(k,1815) - lu(k,461) * lu(k,1729) + lu(k,1822) = lu(k,1822) - lu(k,462) * lu(k,1729) + lu(k,1823) = lu(k,1823) - lu(k,463) * lu(k,1729) + lu(k,1827) = lu(k,1827) - lu(k,464) * lu(k,1729) + lu(k,1829) = lu(k,1829) - lu(k,465) * lu(k,1729) + lu(k,2115) = lu(k,2115) - lu(k,461) * lu(k,2099) + lu(k,2122) = - lu(k,462) * lu(k,2099) + lu(k,2123) = lu(k,2123) - lu(k,463) * lu(k,2099) + lu(k,2127) = lu(k,2127) - lu(k,464) * lu(k,2099) + lu(k,2129) = lu(k,2129) - lu(k,465) * lu(k,2099) + 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,466) = 1._r8 / lu(k,466) + lu(k,467) = lu(k,467) * lu(k,466) + lu(k,468) = lu(k,468) * lu(k,466) + lu(k,469) = lu(k,469) * lu(k,466) + lu(k,470) = lu(k,470) * lu(k,466) + lu(k,471) = lu(k,471) * lu(k,466) + lu(k,1232) = lu(k,1232) - lu(k,467) * lu(k,1229) + lu(k,1234) = - lu(k,468) * lu(k,1229) + lu(k,1242) = - lu(k,469) * lu(k,1229) + lu(k,1246) = lu(k,1246) - lu(k,470) * lu(k,1229) + lu(k,1250) = lu(k,1250) - lu(k,471) * lu(k,1229) + lu(k,1779) = lu(k,1779) - lu(k,467) * lu(k,1730) + lu(k,1794) = lu(k,1794) - lu(k,468) * lu(k,1730) + lu(k,1817) = lu(k,1817) - lu(k,469) * lu(k,1730) + lu(k,1823) = lu(k,1823) - lu(k,470) * lu(k,1730) + lu(k,1831) = lu(k,1831) - lu(k,471) * lu(k,1730) + lu(k,1971) = - lu(k,467) * lu(k,1964) + lu(k,1977) = lu(k,1977) - lu(k,468) * lu(k,1964) + lu(k,1996) = - lu(k,469) * lu(k,1964) + lu(k,2002) = lu(k,2002) - lu(k,470) * lu(k,1964) + lu(k,2010) = lu(k,2010) - lu(k,471) * lu(k,1964) + lu(k,472) = 1._r8 / lu(k,472) + lu(k,473) = lu(k,473) * lu(k,472) + lu(k,474) = lu(k,474) * lu(k,472) + lu(k,475) = lu(k,475) * lu(k,472) + lu(k,476) = lu(k,476) * lu(k,472) + lu(k,477) = lu(k,477) * lu(k,472) + lu(k,535) = lu(k,535) - lu(k,473) * lu(k,534) + lu(k,536) = lu(k,536) - lu(k,474) * lu(k,534) + lu(k,538) = lu(k,538) - lu(k,475) * lu(k,534) + lu(k,540) = - lu(k,476) * lu(k,534) + lu(k,542) = lu(k,542) - lu(k,477) * lu(k,534) + lu(k,1735) = lu(k,1735) - lu(k,473) * lu(k,1731) + lu(k,1740) = lu(k,1740) - lu(k,474) * lu(k,1731) + lu(k,1788) = lu(k,1788) - lu(k,475) * lu(k,1731) + lu(k,1823) = lu(k,1823) - lu(k,476) * lu(k,1731) + lu(k,1831) = lu(k,1831) - lu(k,477) * lu(k,1731) + lu(k,2239) = - lu(k,473) * lu(k,2234) + lu(k,2242) = lu(k,2242) - lu(k,474) * lu(k,2234) + lu(k,2273) = lu(k,2273) - lu(k,475) * lu(k,2234) + lu(k,2303) = lu(k,2303) - lu(k,476) * lu(k,2234) + lu(k,2311) = lu(k,2311) - lu(k,477) * lu(k,2234) + lu(k,478) = 1._r8 / lu(k,478) + lu(k,479) = lu(k,479) * lu(k,478) + lu(k,480) = lu(k,480) * lu(k,478) + lu(k,481) = lu(k,481) * lu(k,478) + lu(k,482) = lu(k,482) * lu(k,478) + lu(k,483) = lu(k,483) * lu(k,478) + lu(k,544) = lu(k,544) - lu(k,479) * lu(k,543) + lu(k,545) = lu(k,545) - lu(k,480) * lu(k,543) + lu(k,546) = lu(k,546) - lu(k,481) * lu(k,543) + lu(k,548) = - lu(k,482) * lu(k,543) + lu(k,550) = lu(k,550) - lu(k,483) * lu(k,543) + lu(k,1741) = lu(k,1741) - lu(k,479) * lu(k,1732) + lu(k,1788) = lu(k,1788) - lu(k,480) * lu(k,1732) + lu(k,1806) = lu(k,1806) - lu(k,481) * lu(k,1732) + lu(k,1823) = lu(k,1823) - lu(k,482) * lu(k,1732) + lu(k,1831) = lu(k,1831) - lu(k,483) * lu(k,1732) + lu(k,2243) = lu(k,2243) - lu(k,479) * lu(k,2235) + lu(k,2273) = lu(k,2273) - lu(k,480) * lu(k,2235) + lu(k,2287) = lu(k,2287) - lu(k,481) * lu(k,2235) + lu(k,2303) = lu(k,2303) - lu(k,482) * lu(k,2235) + lu(k,2311) = lu(k,2311) - lu(k,483) * lu(k,2235) + lu(k,486) = 1._r8 / lu(k,486) + lu(k,487) = lu(k,487) * lu(k,486) + lu(k,488) = lu(k,488) * lu(k,486) + lu(k,489) = lu(k,489) * lu(k,486) + lu(k,490) = lu(k,490) * lu(k,486) + lu(k,491) = lu(k,491) * lu(k,486) + lu(k,1744) = lu(k,1744) - lu(k,487) * lu(k,1733) + lu(k,1820) = lu(k,1820) - lu(k,488) * lu(k,1733) + lu(k,1823) = lu(k,1823) - lu(k,489) * lu(k,1733) + lu(k,1825) = lu(k,1825) - lu(k,490) * lu(k,1733) + lu(k,1831) = lu(k,1831) - lu(k,491) * lu(k,1733) + lu(k,1896) = lu(k,1896) - lu(k,487) * lu(k,1887) + lu(k,1947) = lu(k,1947) - lu(k,488) * lu(k,1887) + lu(k,1950) = lu(k,1950) - lu(k,489) * lu(k,1887) + lu(k,1952) = lu(k,1952) - lu(k,490) * lu(k,1887) + lu(k,1958) = lu(k,1958) - lu(k,491) * lu(k,1887) + lu(k,2244) = lu(k,2244) - lu(k,487) * lu(k,2236) + lu(k,2300) = lu(k,2300) - lu(k,488) * lu(k,2236) + lu(k,2303) = lu(k,2303) - lu(k,489) * lu(k,2236) + lu(k,2305) = lu(k,2305) - lu(k,490) * lu(k,2236) + lu(k,2311) = lu(k,2311) - lu(k,491) * lu(k,2236) + 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,1525) = - lu(k,493) * lu(k,1523) + lu(k,1532) = lu(k,1532) - lu(k,494) * lu(k,1523) + lu(k,1533) = - lu(k,495) * lu(k,1523) + lu(k,1538) = - lu(k,496) * lu(k,1523) + lu(k,1544) = lu(k,1544) - lu(k,497) * lu(k,1523) + lu(k,1918) = lu(k,1918) - lu(k,493) * lu(k,1888) + lu(k,1946) = lu(k,1946) - lu(k,494) * lu(k,1888) + lu(k,1947) = lu(k,1947) - lu(k,495) * lu(k,1888) + lu(k,1952) = lu(k,1952) - lu(k,496) * lu(k,1888) + lu(k,1958) = lu(k,1958) - lu(k,497) * lu(k,1888) + lu(k,2272) = lu(k,2272) - lu(k,493) * lu(k,2237) + lu(k,2299) = lu(k,2299) - lu(k,494) * lu(k,2237) + lu(k,2300) = lu(k,2300) - lu(k,495) * lu(k,2237) + lu(k,2305) = lu(k,2305) - lu(k,496) * lu(k,2237) + lu(k,2311) = lu(k,2311) - lu(k,497) * lu(k,2237) + lu(k,499) = 1._r8 / lu(k,499) + lu(k,500) = lu(k,500) * lu(k,499) + lu(k,501) = lu(k,501) * lu(k,499) + lu(k,502) = lu(k,502) * lu(k,499) + lu(k,503) = lu(k,503) * lu(k,499) + lu(k,504) = lu(k,504) * lu(k,499) + lu(k,1788) = lu(k,1788) - lu(k,500) * lu(k,1734) + lu(k,1820) = lu(k,1820) - lu(k,501) * lu(k,1734) + lu(k,1823) = lu(k,1823) - lu(k,502) * lu(k,1734) + lu(k,1825) = lu(k,1825) - lu(k,503) * lu(k,1734) + lu(k,1831) = lu(k,1831) - lu(k,504) * lu(k,1734) + lu(k,1919) = lu(k,1919) - lu(k,500) * lu(k,1889) + lu(k,1947) = lu(k,1947) - lu(k,501) * lu(k,1889) + lu(k,1950) = lu(k,1950) - lu(k,502) * lu(k,1889) + lu(k,1952) = lu(k,1952) - lu(k,503) * lu(k,1889) + lu(k,1958) = lu(k,1958) - lu(k,504) * lu(k,1889) + lu(k,2273) = lu(k,2273) - lu(k,500) * lu(k,2238) + lu(k,2300) = lu(k,2300) - lu(k,501) * lu(k,2238) + lu(k,2303) = lu(k,2303) - lu(k,502) * lu(k,2238) + lu(k,2305) = lu(k,2305) - lu(k,503) * lu(k,2238) + lu(k,2311) = lu(k,2311) - lu(k,504) * lu(k,2238) + lu(k,505) = 1._r8 / lu(k,505) + lu(k,506) = lu(k,506) * lu(k,505) + lu(k,507) = lu(k,507) * lu(k,505) + lu(k,537) = - lu(k,506) * lu(k,535) + lu(k,542) = lu(k,542) - lu(k,507) * lu(k,535) + lu(k,720) = - lu(k,506) * lu(k,717) + lu(k,728) = lu(k,728) - lu(k,507) * lu(k,717) + lu(k,739) = - lu(k,506) * lu(k,736) + lu(k,748) = lu(k,748) - lu(k,507) * lu(k,736) + lu(k,768) = - lu(k,506) * lu(k,765) + lu(k,778) = lu(k,778) - lu(k,507) * lu(k,765) + lu(k,792) = - lu(k,506) * lu(k,789) + lu(k,803) = lu(k,803) - lu(k,507) * lu(k,789) + lu(k,1766) = - lu(k,506) * lu(k,1735) + lu(k,1831) = lu(k,1831) - lu(k,507) * lu(k,1735) + lu(k,1906) = lu(k,1906) - lu(k,506) * lu(k,1890) + lu(k,1958) = lu(k,1958) - lu(k,507) * lu(k,1890) + lu(k,2256) = lu(k,2256) - lu(k,506) * lu(k,2239) + lu(k,2311) = lu(k,2311) - lu(k,507) * lu(k,2239) + 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,508) = 1._r8 / lu(k,508) + lu(k,509) = lu(k,509) * lu(k,508) + lu(k,510) = lu(k,510) * lu(k,508) + lu(k,511) = lu(k,511) * lu(k,508) + lu(k,512) = lu(k,512) * lu(k,508) + lu(k,513) = lu(k,513) * lu(k,508) + lu(k,514) = lu(k,514) * lu(k,508) + lu(k,1643) = lu(k,1643) - lu(k,509) * lu(k,1638) + lu(k,1650) = lu(k,1650) - lu(k,510) * lu(k,1638) + lu(k,1651) = lu(k,1651) - lu(k,511) * lu(k,1638) + lu(k,1655) = lu(k,1655) - lu(k,512) * lu(k,1638) + lu(k,1657) = lu(k,1657) - lu(k,513) * lu(k,1638) + lu(k,1661) = lu(k,1661) - lu(k,514) * lu(k,1638) + lu(k,1815) = lu(k,1815) - lu(k,509) * lu(k,1736) + lu(k,1822) = lu(k,1822) - lu(k,510) * lu(k,1736) + lu(k,1823) = lu(k,1823) - lu(k,511) * lu(k,1736) + lu(k,1827) = lu(k,1827) - lu(k,512) * lu(k,1736) + lu(k,1829) = lu(k,1829) - lu(k,513) * lu(k,1736) + lu(k,1833) = lu(k,1833) - lu(k,514) * lu(k,1736) + lu(k,2115) = lu(k,2115) - lu(k,509) * lu(k,2100) + lu(k,2122) = lu(k,2122) - lu(k,510) * lu(k,2100) + lu(k,2123) = lu(k,2123) - lu(k,511) * lu(k,2100) + lu(k,2127) = lu(k,2127) - lu(k,512) * lu(k,2100) + lu(k,2129) = lu(k,2129) - lu(k,513) * lu(k,2100) + lu(k,2133) = lu(k,2133) - lu(k,514) * lu(k,2100) + lu(k,515) = 1._r8 / lu(k,515) + lu(k,516) = lu(k,516) * lu(k,515) + lu(k,517) = lu(k,517) * lu(k,515) + lu(k,518) = lu(k,518) * lu(k,515) + lu(k,519) = lu(k,519) * lu(k,515) + lu(k,520) = lu(k,520) * lu(k,515) + lu(k,521) = lu(k,521) * lu(k,515) + lu(k,1178) = lu(k,1178) - lu(k,516) * lu(k,1175) + lu(k,1179) = lu(k,1179) - lu(k,517) * lu(k,1175) + lu(k,1184) = lu(k,1184) - lu(k,518) * lu(k,1175) + lu(k,1188) = lu(k,1188) - lu(k,519) * lu(k,1175) + lu(k,1191) = - lu(k,520) * lu(k,1175) + lu(k,1195) = lu(k,1195) - lu(k,521) * lu(k,1175) + lu(k,1786) = lu(k,1786) - lu(k,516) * lu(k,1737) + lu(k,1790) = lu(k,1790) - lu(k,517) * lu(k,1737) + lu(k,1801) = lu(k,1801) - lu(k,518) * lu(k,1737) + lu(k,1819) = lu(k,1819) - lu(k,519) * lu(k,1737) + lu(k,1823) = lu(k,1823) - lu(k,520) * lu(k,1737) + lu(k,1831) = lu(k,1831) - lu(k,521) * lu(k,1737) + lu(k,2271) = lu(k,2271) - lu(k,516) * lu(k,2240) + lu(k,2274) = lu(k,2274) - lu(k,517) * lu(k,2240) + lu(k,2282) = lu(k,2282) - lu(k,518) * lu(k,2240) + lu(k,2299) = lu(k,2299) - lu(k,519) * lu(k,2240) + lu(k,2303) = lu(k,2303) - lu(k,520) * lu(k,2240) + lu(k,2311) = lu(k,2311) - lu(k,521) * lu(k,2240) + lu(k,522) = 1._r8 / lu(k,522) + lu(k,523) = lu(k,523) * lu(k,522) + lu(k,524) = lu(k,524) * lu(k,522) + lu(k,525) = lu(k,525) * lu(k,522) + lu(k,670) = lu(k,670) - lu(k,523) * lu(k,669) + lu(k,671) = lu(k,671) - lu(k,524) * lu(k,669) + lu(k,674) = - lu(k,525) * lu(k,669) + lu(k,1556) = - lu(k,523) * lu(k,1550) + lu(k,1576) = lu(k,1576) - lu(k,524) * lu(k,1550) + lu(k,1586) = lu(k,1586) - lu(k,525) * lu(k,1550) + lu(k,1757) = lu(k,1757) - lu(k,523) * lu(k,1738) + lu(k,1820) = lu(k,1820) - lu(k,524) * lu(k,1738) + lu(k,1830) = lu(k,1830) - lu(k,525) * lu(k,1738) + lu(k,1902) = lu(k,1902) - lu(k,523) * lu(k,1891) + lu(k,1947) = lu(k,1947) - lu(k,524) * lu(k,1891) + lu(k,1957) = lu(k,1957) - lu(k,525) * lu(k,1891) + lu(k,2144) = lu(k,2144) - lu(k,523) * lu(k,2141) + lu(k,2182) = lu(k,2182) - lu(k,524) * lu(k,2141) + lu(k,2192) = lu(k,2192) - lu(k,525) * lu(k,2141) + lu(k,2248) = lu(k,2248) - lu(k,523) * lu(k,2241) + lu(k,2300) = lu(k,2300) - lu(k,524) * lu(k,2241) + lu(k,2310) = lu(k,2310) - lu(k,525) * lu(k,2241) + lu(k,527) = 1._r8 / lu(k,527) + lu(k,528) = lu(k,528) * lu(k,527) + lu(k,529) = lu(k,529) * lu(k,527) + lu(k,530) = lu(k,530) * lu(k,527) + lu(k,531) = lu(k,531) * lu(k,527) + lu(k,532) = lu(k,532) * lu(k,527) + lu(k,533) = lu(k,533) * lu(k,527) + lu(k,1574) = - lu(k,528) * lu(k,1551) + lu(k,1576) = lu(k,1576) - lu(k,529) * lu(k,1551) + lu(k,1577) = lu(k,1577) - lu(k,530) * lu(k,1551) + lu(k,1578) = lu(k,1578) - lu(k,531) * lu(k,1551) + lu(k,1579) = lu(k,1579) - lu(k,532) * lu(k,1551) + lu(k,1581) = lu(k,1581) - lu(k,533) * lu(k,1551) + lu(k,1818) = lu(k,1818) - lu(k,528) * lu(k,1739) + lu(k,1820) = lu(k,1820) - lu(k,529) * lu(k,1739) + lu(k,1821) = lu(k,1821) - lu(k,530) * lu(k,1739) + lu(k,1822) = lu(k,1822) - lu(k,531) * lu(k,1739) + lu(k,1823) = lu(k,1823) - lu(k,532) * lu(k,1739) + lu(k,1825) = lu(k,1825) - lu(k,533) * lu(k,1739) + lu(k,1945) = - lu(k,528) * lu(k,1892) + lu(k,1947) = lu(k,1947) - lu(k,529) * lu(k,1892) + lu(k,1948) = lu(k,1948) - lu(k,530) * lu(k,1892) + lu(k,1949) = - lu(k,531) * lu(k,1892) + lu(k,1950) = lu(k,1950) - lu(k,532) * lu(k,1892) + lu(k,1952) = lu(k,1952) - lu(k,533) * lu(k,1892) + lu(k,536) = 1._r8 / lu(k,536) + lu(k,537) = lu(k,537) * lu(k,536) + lu(k,538) = lu(k,538) * lu(k,536) + lu(k,539) = lu(k,539) * lu(k,536) + lu(k,540) = lu(k,540) * lu(k,536) + lu(k,541) = lu(k,541) * lu(k,536) + lu(k,542) = lu(k,542) * lu(k,536) + lu(k,1766) = lu(k,1766) - lu(k,537) * lu(k,1740) + lu(k,1788) = lu(k,1788) - lu(k,538) * lu(k,1740) + lu(k,1820) = lu(k,1820) - lu(k,539) * lu(k,1740) + lu(k,1823) = lu(k,1823) - lu(k,540) * lu(k,1740) + lu(k,1825) = lu(k,1825) - lu(k,541) * lu(k,1740) + lu(k,1831) = lu(k,1831) - lu(k,542) * lu(k,1740) + lu(k,1906) = lu(k,1906) - lu(k,537) * lu(k,1893) + lu(k,1919) = lu(k,1919) - lu(k,538) * lu(k,1893) + lu(k,1947) = lu(k,1947) - lu(k,539) * lu(k,1893) + lu(k,1950) = lu(k,1950) - lu(k,540) * lu(k,1893) + lu(k,1952) = lu(k,1952) - lu(k,541) * lu(k,1893) + lu(k,1958) = lu(k,1958) - lu(k,542) * lu(k,1893) + lu(k,2256) = lu(k,2256) - lu(k,537) * lu(k,2242) + lu(k,2273) = lu(k,2273) - lu(k,538) * lu(k,2242) + lu(k,2300) = lu(k,2300) - lu(k,539) * lu(k,2242) + lu(k,2303) = lu(k,2303) - lu(k,540) * lu(k,2242) + lu(k,2305) = lu(k,2305) - lu(k,541) * lu(k,2242) + lu(k,2311) = lu(k,2311) - lu(k,542) * lu(k,2242) + lu(k,544) = 1._r8 / lu(k,544) + lu(k,545) = lu(k,545) * lu(k,544) + lu(k,546) = lu(k,546) * lu(k,544) + lu(k,547) = lu(k,547) * lu(k,544) + lu(k,548) = lu(k,548) * lu(k,544) + lu(k,549) = lu(k,549) * lu(k,544) + lu(k,550) = lu(k,550) * lu(k,544) + lu(k,1788) = lu(k,1788) - lu(k,545) * lu(k,1741) + lu(k,1806) = lu(k,1806) - lu(k,546) * lu(k,1741) + lu(k,1820) = lu(k,1820) - lu(k,547) * lu(k,1741) + lu(k,1823) = lu(k,1823) - lu(k,548) * lu(k,1741) + lu(k,1825) = lu(k,1825) - lu(k,549) * lu(k,1741) + lu(k,1831) = lu(k,1831) - lu(k,550) * lu(k,1741) + lu(k,1919) = lu(k,1919) - lu(k,545) * lu(k,1894) + lu(k,1935) = lu(k,1935) - lu(k,546) * lu(k,1894) + lu(k,1947) = lu(k,1947) - lu(k,547) * lu(k,1894) + lu(k,1950) = lu(k,1950) - lu(k,548) * lu(k,1894) + lu(k,1952) = lu(k,1952) - lu(k,549) * lu(k,1894) + lu(k,1958) = lu(k,1958) - lu(k,550) * lu(k,1894) + lu(k,2273) = lu(k,2273) - lu(k,545) * lu(k,2243) + lu(k,2287) = lu(k,2287) - lu(k,546) * lu(k,2243) + lu(k,2300) = lu(k,2300) - lu(k,547) * lu(k,2243) + lu(k,2303) = lu(k,2303) - lu(k,548) * lu(k,2243) + lu(k,2305) = lu(k,2305) - lu(k,549) * lu(k,2243) + lu(k,2311) = lu(k,2311) - lu(k,550) * lu(k,2243) + lu(k,551) = 1._r8 / lu(k,551) + lu(k,552) = lu(k,552) * lu(k,551) + lu(k,553) = lu(k,553) * lu(k,551) + lu(k,554) = lu(k,554) * lu(k,551) + lu(k,555) = lu(k,555) * lu(k,551) + lu(k,678) = - lu(k,552) * lu(k,676) + lu(k,679) = - lu(k,553) * lu(k,676) + lu(k,683) = - lu(k,554) * lu(k,676) + lu(k,685) = lu(k,685) - lu(k,555) * lu(k,676) + lu(k,689) = - lu(k,552) * lu(k,687) + lu(k,690) = - lu(k,553) * lu(k,687) + lu(k,693) = - lu(k,554) * lu(k,687) + lu(k,696) = lu(k,696) - lu(k,555) * lu(k,687) + lu(k,958) = - lu(k,552) * lu(k,955) + lu(k,959) = - lu(k,553) * lu(k,955) + lu(k,963) = - lu(k,554) * lu(k,955) + lu(k,966) = - lu(k,555) * lu(k,955) + lu(k,1760) = lu(k,1760) - lu(k,552) * lu(k,1742) + lu(k,1776) = lu(k,1776) - lu(k,553) * lu(k,1742) + lu(k,1813) = lu(k,1813) - lu(k,554) * lu(k,1742) + lu(k,1823) = lu(k,1823) - lu(k,555) * lu(k,1742) + lu(k,1904) = lu(k,1904) - lu(k,552) * lu(k,1895) + lu(k,1912) = lu(k,1912) - lu(k,553) * lu(k,1895) + lu(k,1941) = lu(k,1941) - lu(k,554) * lu(k,1895) + lu(k,1950) = lu(k,1950) - lu(k,555) * lu(k,1895) + 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,556) = 1._r8 / lu(k,556) + lu(k,557) = lu(k,557) * lu(k,556) + lu(k,558) = lu(k,558) * lu(k,556) + lu(k,559) = lu(k,559) * lu(k,556) + lu(k,560) = lu(k,560) * lu(k,556) + lu(k,561) = lu(k,561) * lu(k,556) + lu(k,1276) = lu(k,1276) - lu(k,557) * lu(k,1274) + lu(k,1278) = lu(k,1278) - lu(k,558) * lu(k,1274) + lu(k,1280) = lu(k,1280) - lu(k,559) * lu(k,1274) + lu(k,1281) = lu(k,1281) - lu(k,560) * lu(k,1274) + lu(k,1285) = lu(k,1285) - lu(k,561) * lu(k,1274) + lu(k,1600) = lu(k,1600) - lu(k,557) * lu(k,1591) + lu(k,1605) = lu(k,1605) - lu(k,558) * lu(k,1591) + lu(k,1608) = lu(k,1608) - lu(k,559) * lu(k,1591) + lu(k,1610) = lu(k,1610) - lu(k,560) * lu(k,1591) + lu(k,1617) = lu(k,1617) - lu(k,561) * lu(k,1591) + lu(k,1807) = lu(k,1807) - lu(k,557) * lu(k,1743) + lu(k,1818) = lu(k,1818) - lu(k,558) * lu(k,1743) + lu(k,1821) = lu(k,1821) - lu(k,559) * lu(k,1743) + lu(k,1823) = lu(k,1823) - lu(k,560) * lu(k,1743) + lu(k,1830) = lu(k,1830) - lu(k,561) * lu(k,1743) + lu(k,2170) = lu(k,2170) - lu(k,557) * lu(k,2142) + lu(k,2180) = lu(k,2180) - lu(k,558) * lu(k,2142) + lu(k,2183) = lu(k,2183) - lu(k,559) * lu(k,2142) + lu(k,2185) = lu(k,2185) - lu(k,560) * lu(k,2142) + lu(k,2192) = lu(k,2192) - lu(k,561) * lu(k,2142) + lu(k,563) = 1._r8 / lu(k,563) + lu(k,564) = lu(k,564) * lu(k,563) + lu(k,565) = lu(k,565) * lu(k,563) + lu(k,566) = lu(k,566) * lu(k,563) + lu(k,567) = lu(k,567) * lu(k,563) + lu(k,568) = lu(k,568) * lu(k,563) + lu(k,1556) = lu(k,1556) - lu(k,564) * lu(k,1552) + lu(k,1576) = lu(k,1576) - lu(k,565) * lu(k,1552) + lu(k,1579) = lu(k,1579) - lu(k,566) * lu(k,1552) + lu(k,1581) = lu(k,1581) - lu(k,567) * lu(k,1552) + lu(k,1587) = lu(k,1587) - lu(k,568) * lu(k,1552) + lu(k,1757) = lu(k,1757) - lu(k,564) * lu(k,1744) + lu(k,1820) = lu(k,1820) - lu(k,565) * lu(k,1744) + lu(k,1823) = lu(k,1823) - lu(k,566) * lu(k,1744) + lu(k,1825) = lu(k,1825) - lu(k,567) * lu(k,1744) + lu(k,1831) = lu(k,1831) - lu(k,568) * lu(k,1744) + lu(k,1902) = lu(k,1902) - lu(k,564) * lu(k,1896) + lu(k,1947) = lu(k,1947) - lu(k,565) * lu(k,1896) + lu(k,1950) = lu(k,1950) - lu(k,566) * lu(k,1896) + lu(k,1952) = lu(k,1952) - lu(k,567) * lu(k,1896) + lu(k,1958) = lu(k,1958) - lu(k,568) * lu(k,1896) + lu(k,2248) = lu(k,2248) - lu(k,564) * lu(k,2244) + lu(k,2300) = lu(k,2300) - lu(k,565) * lu(k,2244) + lu(k,2303) = lu(k,2303) - lu(k,566) * lu(k,2244) + lu(k,2305) = lu(k,2305) - lu(k,567) * lu(k,2244) + lu(k,2311) = lu(k,2311) - lu(k,568) * lu(k,2244) + lu(k,569) = 1._r8 / lu(k,569) + lu(k,570) = lu(k,570) * lu(k,569) + lu(k,571) = lu(k,571) * lu(k,569) + lu(k,572) = lu(k,572) * lu(k,569) + lu(k,573) = lu(k,573) * lu(k,569) + lu(k,574) = lu(k,574) * lu(k,569) + lu(k,575) = lu(k,575) * lu(k,569) + lu(k,576) = lu(k,576) * lu(k,569) + lu(k,1418) = lu(k,1418) - lu(k,570) * lu(k,1415) + lu(k,1433) = lu(k,1433) - lu(k,571) * lu(k,1415) + lu(k,1436) = lu(k,1436) - lu(k,572) * lu(k,1415) + lu(k,1437) = lu(k,1437) - lu(k,573) * lu(k,1415) + lu(k,1439) = lu(k,1439) - lu(k,574) * lu(k,1415) + lu(k,1441) = lu(k,1441) - lu(k,575) * lu(k,1415) + lu(k,1442) = - lu(k,576) * lu(k,1415) + lu(k,1560) = - lu(k,570) * lu(k,1553) + lu(k,1570) = lu(k,1570) - lu(k,571) * lu(k,1553) + lu(k,1575) = - lu(k,572) * lu(k,1553) + lu(k,1576) = lu(k,1576) - lu(k,573) * lu(k,1553) + lu(k,1579) = lu(k,1579) - lu(k,574) * lu(k,1553) + lu(k,1582) = - lu(k,575) * lu(k,1553) + lu(k,1584) = lu(k,1584) - lu(k,576) * lu(k,1553) + lu(k,1777) = lu(k,1777) - lu(k,570) * lu(k,1745) + lu(k,1813) = lu(k,1813) - lu(k,571) * lu(k,1745) + lu(k,1819) = lu(k,1819) - lu(k,572) * lu(k,1745) + lu(k,1820) = lu(k,1820) - lu(k,573) * lu(k,1745) + lu(k,1823) = lu(k,1823) - lu(k,574) * lu(k,1745) + lu(k,1826) = lu(k,1826) - lu(k,575) * lu(k,1745) + lu(k,1828) = lu(k,1828) - lu(k,576) * lu(k,1745) + lu(k,577) = 1._r8 / lu(k,577) + lu(k,578) = lu(k,578) * lu(k,577) + lu(k,579) = lu(k,579) * lu(k,577) + lu(k,580) = lu(k,580) * lu(k,577) + lu(k,581) = lu(k,581) * lu(k,577) + lu(k,582) = lu(k,582) * lu(k,577) + lu(k,583) = lu(k,583) * lu(k,577) + lu(k,584) = lu(k,584) * lu(k,577) + lu(k,1559) = - lu(k,578) * lu(k,1554) + lu(k,1571) = - lu(k,579) * lu(k,1554) + lu(k,1573) = lu(k,1573) - lu(k,580) * lu(k,1554) + lu(k,1576) = lu(k,1576) - lu(k,581) * lu(k,1554) + lu(k,1577) = lu(k,1577) - lu(k,582) * lu(k,1554) + lu(k,1580) = lu(k,1580) - lu(k,583) * lu(k,1554) + lu(k,1584) = lu(k,1584) - lu(k,584) * lu(k,1554) + lu(k,1594) = lu(k,1594) - lu(k,578) * lu(k,1592) + lu(k,1602) = lu(k,1602) - lu(k,579) * lu(k,1592) + lu(k,1604) = - lu(k,580) * lu(k,1592) + lu(k,1607) = lu(k,1607) - lu(k,581) * lu(k,1592) + lu(k,1608) = lu(k,1608) - lu(k,582) * lu(k,1592) + lu(k,1611) = lu(k,1611) - lu(k,583) * lu(k,1592) + lu(k,1615) = lu(k,1615) - lu(k,584) * lu(k,1592) + lu(k,1837) = lu(k,1837) - lu(k,578) * lu(k,1836) + lu(k,1840) = lu(k,1840) - lu(k,579) * lu(k,1836) + lu(k,1841) = - lu(k,580) * lu(k,1836) + lu(k,1844) = lu(k,1844) - lu(k,581) * lu(k,1836) + lu(k,1845) = lu(k,1845) - lu(k,582) * lu(k,1836) + lu(k,1848) = lu(k,1848) - lu(k,583) * lu(k,1836) + lu(k,1852) = - lu(k,584) * lu(k,1836) + lu(k,585) = 1._r8 / lu(k,585) + lu(k,586) = lu(k,586) * lu(k,585) + lu(k,587) = lu(k,587) * lu(k,585) + lu(k,588) = lu(k,588) * lu(k,585) + lu(k,589) = lu(k,589) * lu(k,585) + lu(k,590) = lu(k,590) * lu(k,585) + lu(k,591) = lu(k,591) * lu(k,585) + lu(k,592) = lu(k,592) * lu(k,585) + lu(k,813) = lu(k,813) - lu(k,586) * lu(k,812) + lu(k,814) = lu(k,814) - lu(k,587) * lu(k,812) + lu(k,815) = - lu(k,588) * lu(k,812) + lu(k,816) = lu(k,816) - lu(k,589) * lu(k,812) + lu(k,818) = - lu(k,590) * lu(k,812) + lu(k,820) = lu(k,820) - lu(k,591) * lu(k,812) + lu(k,821) = - lu(k,592) * lu(k,812) + lu(k,1771) = lu(k,1771) - lu(k,586) * lu(k,1746) + lu(k,1793) = lu(k,1793) - lu(k,587) * lu(k,1746) + lu(k,1799) = lu(k,1799) - lu(k,588) * lu(k,1746) + lu(k,1819) = lu(k,1819) - lu(k,589) * lu(k,1746) + lu(k,1823) = lu(k,1823) - lu(k,590) * lu(k,1746) + lu(k,1831) = lu(k,1831) - lu(k,591) * lu(k,1746) + lu(k,1833) = lu(k,1833) - lu(k,592) * lu(k,1746) + lu(k,2261) = lu(k,2261) - lu(k,586) * lu(k,2245) + lu(k,2275) = lu(k,2275) - lu(k,587) * lu(k,2245) + lu(k,2280) = - lu(k,588) * lu(k,2245) + lu(k,2299) = lu(k,2299) - lu(k,589) * lu(k,2245) + lu(k,2303) = lu(k,2303) - lu(k,590) * lu(k,2245) + lu(k,2311) = lu(k,2311) - lu(k,591) * lu(k,2245) + lu(k,2313) = lu(k,2313) - lu(k,592) * lu(k,2245) + lu(k,593) = 1._r8 / lu(k,593) + lu(k,594) = lu(k,594) * lu(k,593) + lu(k,595) = lu(k,595) * lu(k,593) + lu(k,596) = lu(k,596) * lu(k,593) + lu(k,597) = lu(k,597) * lu(k,593) + lu(k,598) = lu(k,598) * lu(k,593) + lu(k,599) = lu(k,599) * lu(k,593) + lu(k,600) = lu(k,600) * lu(k,593) + lu(k,1323) = - lu(k,594) * lu(k,1319) + lu(k,1326) = lu(k,1326) - lu(k,595) * lu(k,1319) + lu(k,1328) = - lu(k,596) * lu(k,1319) + lu(k,1329) = lu(k,1329) - lu(k,597) * lu(k,1319) + lu(k,1339) = - lu(k,598) * lu(k,1319) + lu(k,1343) = lu(k,1343) - lu(k,599) * lu(k,1319) + lu(k,1348) = lu(k,1348) - lu(k,600) * lu(k,1319) + lu(k,1779) = lu(k,1779) - lu(k,594) * lu(k,1747) + lu(k,1794) = lu(k,1794) - lu(k,595) * lu(k,1747) + lu(k,1798) = lu(k,1798) - lu(k,596) * lu(k,1747) + lu(k,1799) = lu(k,1799) - lu(k,597) * lu(k,1747) + lu(k,1817) = lu(k,1817) - lu(k,598) * lu(k,1747) + lu(k,1823) = lu(k,1823) - lu(k,599) * lu(k,1747) + lu(k,1831) = lu(k,1831) - lu(k,600) * lu(k,1747) + lu(k,1914) = - lu(k,594) * lu(k,1897) + lu(k,1923) = lu(k,1923) - lu(k,595) * lu(k,1897) + lu(k,1927) = lu(k,1927) - lu(k,596) * lu(k,1897) + lu(k,1928) = lu(k,1928) - lu(k,597) * lu(k,1897) + lu(k,1944) = lu(k,1944) - lu(k,598) * lu(k,1897) + lu(k,1950) = lu(k,1950) - lu(k,599) * lu(k,1897) + lu(k,1958) = lu(k,1958) - lu(k,600) * lu(k,1897) + 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,601) = 1._r8 / lu(k,601) + lu(k,602) = lu(k,602) * lu(k,601) + lu(k,603) = lu(k,603) * lu(k,601) + lu(k,604) = lu(k,604) * lu(k,601) + lu(k,605) = lu(k,605) * lu(k,601) + lu(k,606) = lu(k,606) * lu(k,601) + lu(k,607) = lu(k,607) * lu(k,601) + lu(k,608) = lu(k,608) * lu(k,601) + lu(k,1765) = lu(k,1765) - lu(k,602) * lu(k,1748) + lu(k,1787) = lu(k,1787) - lu(k,603) * lu(k,1748) + lu(k,1797) = lu(k,1797) - lu(k,604) * lu(k,1748) + lu(k,1819) = lu(k,1819) - lu(k,605) * lu(k,1748) + lu(k,1823) = lu(k,1823) - lu(k,606) * lu(k,1748) + lu(k,1830) = lu(k,1830) - lu(k,607) * lu(k,1748) + lu(k,1831) = lu(k,1831) - lu(k,608) * lu(k,1748) + lu(k,2104) = - lu(k,602) * lu(k,2101) + lu(k,2108) = lu(k,2108) - lu(k,603) * lu(k,2101) + lu(k,2112) = lu(k,2112) - lu(k,604) * lu(k,2101) + lu(k,2119) = lu(k,2119) - lu(k,605) * lu(k,2101) + lu(k,2123) = lu(k,2123) - lu(k,606) * lu(k,2101) + lu(k,2130) = lu(k,2130) - lu(k,607) * lu(k,2101) + lu(k,2131) = lu(k,2131) - lu(k,608) * lu(k,2101) + lu(k,2146) = - lu(k,602) * lu(k,2143) + lu(k,2153) = lu(k,2153) - lu(k,603) * lu(k,2143) + lu(k,2162) = lu(k,2162) - lu(k,604) * lu(k,2143) + lu(k,2181) = lu(k,2181) - lu(k,605) * lu(k,2143) + lu(k,2185) = lu(k,2185) - lu(k,606) * lu(k,2143) + lu(k,2192) = lu(k,2192) - lu(k,607) * lu(k,2143) + lu(k,2193) = lu(k,2193) - lu(k,608) * lu(k,2143) + lu(k,609) = 1._r8 / lu(k,609) + lu(k,610) = lu(k,610) * lu(k,609) + lu(k,611) = lu(k,611) * lu(k,609) + lu(k,612) = lu(k,612) * lu(k,609) + lu(k,613) = lu(k,613) * lu(k,609) + lu(k,614) = lu(k,614) * lu(k,609) + lu(k,615) = lu(k,615) * lu(k,609) + lu(k,616) = lu(k,616) * lu(k,609) + lu(k,1786) = lu(k,1786) - lu(k,610) * lu(k,1749) + lu(k,1793) = lu(k,1793) - lu(k,611) * lu(k,1749) + lu(k,1798) = lu(k,1798) - lu(k,612) * lu(k,1749) + lu(k,1819) = lu(k,1819) - lu(k,613) * lu(k,1749) + lu(k,1820) = lu(k,1820) - lu(k,614) * lu(k,1749) + lu(k,1825) = lu(k,1825) - lu(k,615) * lu(k,1749) + lu(k,1831) = lu(k,1831) - lu(k,616) * lu(k,1749) + lu(k,1917) = lu(k,1917) - lu(k,610) * lu(k,1898) + lu(k,1922) = lu(k,1922) - lu(k,611) * lu(k,1898) + lu(k,1927) = lu(k,1927) - lu(k,612) * lu(k,1898) + lu(k,1946) = lu(k,1946) - lu(k,613) * lu(k,1898) + lu(k,1947) = lu(k,1947) - lu(k,614) * lu(k,1898) + lu(k,1952) = lu(k,1952) - lu(k,615) * lu(k,1898) + lu(k,1958) = lu(k,1958) - lu(k,616) * lu(k,1898) + lu(k,2048) = lu(k,2048) - lu(k,610) * lu(k,2042) + lu(k,2055) = lu(k,2055) - lu(k,611) * lu(k,2042) + lu(k,2060) = - lu(k,612) * lu(k,2042) + lu(k,2080) = lu(k,2080) - lu(k,613) * lu(k,2042) + lu(k,2081) = lu(k,2081) - lu(k,614) * lu(k,2042) + lu(k,2086) = lu(k,2086) - lu(k,615) * lu(k,2042) + lu(k,2092) = lu(k,2092) - lu(k,616) * lu(k,2042) + lu(k,617) = 1._r8 / lu(k,617) + lu(k,618) = lu(k,618) * lu(k,617) + lu(k,619) = lu(k,619) * lu(k,617) + lu(k,620) = lu(k,620) * lu(k,617) + lu(k,621) = lu(k,621) * lu(k,617) + lu(k,622) = lu(k,622) * lu(k,617) + lu(k,623) = lu(k,623) * lu(k,617) + lu(k,624) = lu(k,624) * lu(k,617) + lu(k,625) = lu(k,625) * lu(k,617) + lu(k,1293) = - lu(k,618) * lu(k,1289) + lu(k,1295) = - lu(k,619) * lu(k,1289) + lu(k,1296) = - lu(k,620) * lu(k,1289) + lu(k,1306) = - lu(k,621) * lu(k,1289) + lu(k,1307) = lu(k,1307) - lu(k,622) * lu(k,1289) + lu(k,1308) = lu(k,1308) - lu(k,623) * lu(k,1289) + lu(k,1310) = - lu(k,624) * lu(k,1289) + lu(k,1315) = lu(k,1315) - lu(k,625) * lu(k,1289) + lu(k,1794) = lu(k,1794) - lu(k,618) * lu(k,1750) + lu(k,1798) = lu(k,1798) - lu(k,619) * lu(k,1750) + lu(k,1799) = lu(k,1799) - lu(k,620) * lu(k,1750) + lu(k,1817) = lu(k,1817) - lu(k,621) * lu(k,1750) + lu(k,1819) = lu(k,1819) - lu(k,622) * lu(k,1750) + lu(k,1820) = lu(k,1820) - lu(k,623) * lu(k,1750) + lu(k,1823) = lu(k,1823) - lu(k,624) * lu(k,1750) + lu(k,1831) = lu(k,1831) - lu(k,625) * lu(k,1750) + lu(k,1923) = lu(k,1923) - lu(k,618) * lu(k,1899) + lu(k,1927) = lu(k,1927) - lu(k,619) * lu(k,1899) + lu(k,1928) = lu(k,1928) - lu(k,620) * lu(k,1899) + lu(k,1944) = lu(k,1944) - lu(k,621) * lu(k,1899) + lu(k,1946) = lu(k,1946) - lu(k,622) * lu(k,1899) + lu(k,1947) = lu(k,1947) - lu(k,623) * lu(k,1899) + lu(k,1950) = lu(k,1950) - lu(k,624) * lu(k,1899) + lu(k,1958) = lu(k,1958) - lu(k,625) * lu(k,1899) + 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,1643) = lu(k,1643) - lu(k,627) * lu(k,1639) + lu(k,1650) = lu(k,1650) - lu(k,628) * lu(k,1639) + lu(k,1651) = lu(k,1651) - lu(k,629) * lu(k,1639) + lu(k,1654) = lu(k,1654) - lu(k,630) * lu(k,1639) + lu(k,1655) = lu(k,1655) - lu(k,631) * lu(k,1639) + lu(k,1657) = lu(k,1657) - lu(k,632) * lu(k,1639) + lu(k,1659) = lu(k,1659) - lu(k,633) * lu(k,1639) + lu(k,1661) = lu(k,1661) - lu(k,634) * lu(k,1639) + lu(k,1815) = lu(k,1815) - lu(k,627) * lu(k,1751) + lu(k,1822) = lu(k,1822) - lu(k,628) * lu(k,1751) + lu(k,1823) = lu(k,1823) - lu(k,629) * lu(k,1751) + lu(k,1826) = lu(k,1826) - lu(k,630) * lu(k,1751) + lu(k,1827) = lu(k,1827) - lu(k,631) * lu(k,1751) + lu(k,1829) = lu(k,1829) - lu(k,632) * lu(k,1751) + lu(k,1831) = lu(k,1831) - lu(k,633) * lu(k,1751) + lu(k,1833) = lu(k,1833) - lu(k,634) * lu(k,1751) + lu(k,2115) = lu(k,2115) - lu(k,627) * lu(k,2102) + lu(k,2122) = lu(k,2122) - lu(k,628) * lu(k,2102) + lu(k,2123) = lu(k,2123) - lu(k,629) * lu(k,2102) + lu(k,2126) = lu(k,2126) - lu(k,630) * lu(k,2102) + lu(k,2127) = lu(k,2127) - lu(k,631) * lu(k,2102) + lu(k,2129) = lu(k,2129) - lu(k,632) * lu(k,2102) + lu(k,2131) = lu(k,2131) - lu(k,633) * lu(k,2102) + lu(k,2133) = lu(k,2133) - lu(k,634) * lu(k,2102) + lu(k,635) = 1._r8 / lu(k,635) + lu(k,636) = lu(k,636) * lu(k,635) + lu(k,637) = lu(k,637) * lu(k,635) + lu(k,638) = lu(k,638) * lu(k,635) + lu(k,639) = lu(k,639) * lu(k,635) + lu(k,640) = lu(k,640) * lu(k,635) + lu(k,641) = lu(k,641) * lu(k,635) + lu(k,1397) = lu(k,1397) - lu(k,636) * lu(k,1394) + lu(k,1402) = lu(k,1402) - lu(k,637) * lu(k,1394) + lu(k,1404) = lu(k,1404) - lu(k,638) * lu(k,1394) + lu(k,1407) = lu(k,1407) - lu(k,639) * lu(k,1394) + lu(k,1409) = lu(k,1409) - lu(k,640) * lu(k,1394) + lu(k,1413) = - lu(k,641) * lu(k,1394) + lu(k,1418) = lu(k,1418) - lu(k,636) * lu(k,1416) + lu(k,1433) = lu(k,1433) - lu(k,637) * lu(k,1416) + lu(k,1436) = lu(k,1436) - lu(k,638) * lu(k,1416) + lu(k,1439) = lu(k,1439) - lu(k,639) * lu(k,1416) + lu(k,1441) = lu(k,1441) - lu(k,640) * lu(k,1416) + lu(k,1445) = - lu(k,641) * lu(k,1416) + lu(k,1777) = lu(k,1777) - lu(k,636) * lu(k,1752) + lu(k,1813) = lu(k,1813) - lu(k,637) * lu(k,1752) + lu(k,1819) = lu(k,1819) - lu(k,638) * lu(k,1752) + lu(k,1823) = lu(k,1823) - lu(k,639) * lu(k,1752) + lu(k,1826) = lu(k,1826) - lu(k,640) * lu(k,1752) + lu(k,1833) = lu(k,1833) - lu(k,641) * lu(k,1752) + lu(k,2267) = lu(k,2267) - lu(k,636) * lu(k,2246) + lu(k,2293) = lu(k,2293) - lu(k,637) * lu(k,2246) + lu(k,2299) = lu(k,2299) - lu(k,638) * lu(k,2246) + lu(k,2303) = lu(k,2303) - lu(k,639) * lu(k,2246) + lu(k,2306) = lu(k,2306) - lu(k,640) * lu(k,2246) + lu(k,2313) = lu(k,2313) - lu(k,641) * lu(k,2246) + 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,642) = 1._r8 / lu(k,642) + lu(k,643) = lu(k,643) * lu(k,642) + lu(k,644) = lu(k,644) * lu(k,642) + lu(k,645) = lu(k,645) * lu(k,642) + lu(k,723) = - lu(k,643) * lu(k,718) + lu(k,725) = - lu(k,644) * lu(k,718) + lu(k,728) = lu(k,728) - lu(k,645) * lu(k,718) + lu(k,742) = - lu(k,643) * lu(k,737) + lu(k,744) = lu(k,744) - lu(k,644) * lu(k,737) + lu(k,748) = lu(k,748) - lu(k,645) * lu(k,737) + lu(k,771) = - lu(k,643) * lu(k,766) + lu(k,773) = - lu(k,644) * lu(k,766) + lu(k,778) = lu(k,778) - lu(k,645) * lu(k,766) + lu(k,795) = - lu(k,643) * lu(k,790) + lu(k,797) = lu(k,797) - lu(k,644) * lu(k,790) + lu(k,803) = lu(k,803) - lu(k,645) * lu(k,790) + lu(k,1067) = - lu(k,643) * lu(k,1065) + lu(k,1070) = - lu(k,644) * lu(k,1065) + lu(k,1080) = lu(k,1080) - lu(k,645) * lu(k,1065) + lu(k,1324) = - lu(k,643) * lu(k,1320) + lu(k,1327) = - lu(k,644) * lu(k,1320) + lu(k,1348) = lu(k,1348) - lu(k,645) * lu(k,1320) + lu(k,1782) = - lu(k,643) * lu(k,1753) + lu(k,1797) = lu(k,1797) - lu(k,644) * lu(k,1753) + lu(k,1831) = lu(k,1831) - lu(k,645) * lu(k,1753) + lu(k,1915) = lu(k,1915) - lu(k,643) * lu(k,1900) + lu(k,1926) = lu(k,1926) - lu(k,644) * lu(k,1900) + lu(k,1958) = lu(k,1958) - lu(k,645) * lu(k,1900) + lu(k,646) = 1._r8 / lu(k,646) + lu(k,647) = lu(k,647) * lu(k,646) + lu(k,648) = lu(k,648) * lu(k,646) + lu(k,649) = lu(k,649) * lu(k,646) + lu(k,650) = lu(k,650) * lu(k,646) + lu(k,651) = lu(k,651) * lu(k,646) + lu(k,652) = lu(k,652) * lu(k,646) + lu(k,1608) = lu(k,1608) - lu(k,647) * lu(k,1593) + lu(k,1610) = lu(k,1610) - lu(k,648) * lu(k,1593) + lu(k,1614) = lu(k,1614) - lu(k,649) * lu(k,1593) + lu(k,1616) = lu(k,1616) - lu(k,650) * lu(k,1593) + lu(k,1618) = lu(k,1618) - lu(k,651) * lu(k,1593) + lu(k,1620) = - lu(k,652) * lu(k,1593) + lu(k,1821) = lu(k,1821) - lu(k,647) * lu(k,1754) + lu(k,1823) = lu(k,1823) - lu(k,648) * lu(k,1754) + lu(k,1827) = lu(k,1827) - lu(k,649) * lu(k,1754) + lu(k,1829) = lu(k,1829) - lu(k,650) * lu(k,1754) + lu(k,1831) = lu(k,1831) - lu(k,651) * lu(k,1754) + lu(k,1833) = lu(k,1833) - lu(k,652) * lu(k,1754) + lu(k,2121) = - lu(k,647) * lu(k,2103) + lu(k,2123) = lu(k,2123) - lu(k,648) * lu(k,2103) + lu(k,2127) = lu(k,2127) - lu(k,649) * lu(k,2103) + lu(k,2129) = lu(k,2129) - lu(k,650) * lu(k,2103) + lu(k,2131) = lu(k,2131) - lu(k,651) * lu(k,2103) + lu(k,2133) = lu(k,2133) - lu(k,652) * lu(k,2103) + lu(k,2301) = lu(k,2301) - lu(k,647) * lu(k,2247) + lu(k,2303) = lu(k,2303) - lu(k,648) * lu(k,2247) + lu(k,2307) = lu(k,2307) - lu(k,649) * lu(k,2247) + lu(k,2309) = lu(k,2309) - lu(k,650) * lu(k,2247) + lu(k,2311) = lu(k,2311) - lu(k,651) * lu(k,2247) + lu(k,2313) = lu(k,2313) - lu(k,652) * lu(k,2247) + lu(k,653) = 1._r8 / lu(k,653) + lu(k,654) = lu(k,654) * lu(k,653) + lu(k,655) = lu(k,655) * lu(k,653) + lu(k,656) = lu(k,656) * lu(k,653) + lu(k,657) = lu(k,657) * lu(k,653) + lu(k,658) = lu(k,658) * lu(k,653) + lu(k,659) = lu(k,659) * lu(k,653) + lu(k,660) = lu(k,660) * lu(k,653) + lu(k,661) = lu(k,661) * lu(k,653) + lu(k,1397) = lu(k,1397) - lu(k,654) * lu(k,1395) + lu(k,1399) = - lu(k,655) * lu(k,1395) + lu(k,1401) = lu(k,1401) - lu(k,656) * lu(k,1395) + lu(k,1404) = lu(k,1404) - lu(k,657) * lu(k,1395) + lu(k,1405) = lu(k,1405) - lu(k,658) * lu(k,1395) + lu(k,1407) = lu(k,1407) - lu(k,659) * lu(k,1395) + lu(k,1410) = lu(k,1410) - lu(k,660) * lu(k,1395) + lu(k,1412) = lu(k,1412) - lu(k,661) * lu(k,1395) + lu(k,1560) = lu(k,1560) - lu(k,654) * lu(k,1555) + lu(k,1566) = - lu(k,655) * lu(k,1555) + lu(k,1569) = lu(k,1569) - lu(k,656) * lu(k,1555) + lu(k,1575) = lu(k,1575) - lu(k,657) * lu(k,1555) + lu(k,1576) = lu(k,1576) - lu(k,658) * lu(k,1555) + lu(k,1579) = lu(k,1579) - lu(k,659) * lu(k,1555) + lu(k,1584) = lu(k,1584) - lu(k,660) * lu(k,1555) + lu(k,1587) = lu(k,1587) - lu(k,661) * lu(k,1555) + lu(k,1777) = lu(k,1777) - lu(k,654) * lu(k,1755) + lu(k,1799) = lu(k,1799) - lu(k,655) * lu(k,1755) + lu(k,1812) = lu(k,1812) - lu(k,656) * lu(k,1755) + lu(k,1819) = lu(k,1819) - lu(k,657) * lu(k,1755) + lu(k,1820) = lu(k,1820) - lu(k,658) * lu(k,1755) + lu(k,1823) = lu(k,1823) - lu(k,659) * lu(k,1755) + lu(k,1828) = lu(k,1828) - lu(k,660) * lu(k,1755) + lu(k,1831) = lu(k,1831) - lu(k,661) * lu(k,1755) + lu(k,662) = 1._r8 / lu(k,662) + lu(k,663) = lu(k,663) * lu(k,662) + lu(k,664) = lu(k,664) * lu(k,662) + lu(k,665) = lu(k,665) * lu(k,662) + lu(k,666) = lu(k,666) * lu(k,662) + lu(k,667) = lu(k,667) * lu(k,662) + lu(k,1101) = lu(k,1101) - lu(k,663) * lu(k,1099) + lu(k,1106) = lu(k,1106) - lu(k,664) * lu(k,1099) + lu(k,1108) = lu(k,1108) - lu(k,665) * lu(k,1099) + lu(k,1109) = lu(k,1109) - lu(k,666) * lu(k,1099) + lu(k,1113) = lu(k,1113) - lu(k,667) * lu(k,1099) + lu(k,1179) = lu(k,1179) - lu(k,663) * lu(k,1176) + lu(k,1187) = - lu(k,664) * lu(k,1176) + lu(k,1189) = lu(k,1189) - lu(k,665) * lu(k,1176) + lu(k,1191) = lu(k,1191) - lu(k,666) * lu(k,1176) + lu(k,1195) = lu(k,1195) - lu(k,667) * lu(k,1176) + lu(k,1790) = lu(k,1790) - lu(k,663) * lu(k,1756) + lu(k,1817) = lu(k,1817) - lu(k,664) * lu(k,1756) + lu(k,1820) = lu(k,1820) - lu(k,665) * lu(k,1756) + lu(k,1823) = lu(k,1823) - lu(k,666) * lu(k,1756) + lu(k,1831) = lu(k,1831) - lu(k,667) * lu(k,1756) + lu(k,1920) = lu(k,1920) - lu(k,663) * lu(k,1901) + lu(k,1944) = lu(k,1944) - lu(k,664) * lu(k,1901) + lu(k,1947) = lu(k,1947) - lu(k,665) * lu(k,1901) + lu(k,1950) = lu(k,1950) - lu(k,666) * lu(k,1901) + lu(k,1958) = lu(k,1958) - lu(k,667) * lu(k,1901) + lu(k,1974) = lu(k,1974) - lu(k,663) * lu(k,1965) + lu(k,1996) = lu(k,1996) - lu(k,664) * lu(k,1965) + lu(k,1999) = lu(k,1999) - lu(k,665) * lu(k,1965) + lu(k,2002) = lu(k,2002) - lu(k,666) * lu(k,1965) + lu(k,2010) = lu(k,2010) - lu(k,667) * lu(k,1965) + lu(k,670) = 1._r8 / lu(k,670) + lu(k,671) = lu(k,671) * lu(k,670) + lu(k,672) = lu(k,672) * lu(k,670) + lu(k,673) = lu(k,673) * lu(k,670) + lu(k,674) = lu(k,674) * lu(k,670) + lu(k,675) = lu(k,675) * lu(k,670) + lu(k,1576) = lu(k,1576) - lu(k,671) * lu(k,1556) + lu(k,1579) = lu(k,1579) - lu(k,672) * lu(k,1556) + lu(k,1581) = lu(k,1581) - lu(k,673) * lu(k,1556) + lu(k,1586) = lu(k,1586) - lu(k,674) * lu(k,1556) + lu(k,1587) = lu(k,1587) - lu(k,675) * lu(k,1556) + lu(k,1820) = lu(k,1820) - lu(k,671) * lu(k,1757) + lu(k,1823) = lu(k,1823) - lu(k,672) * lu(k,1757) + lu(k,1825) = lu(k,1825) - lu(k,673) * lu(k,1757) + lu(k,1830) = lu(k,1830) - lu(k,674) * lu(k,1757) + lu(k,1831) = lu(k,1831) - lu(k,675) * lu(k,1757) + lu(k,1947) = lu(k,1947) - lu(k,671) * lu(k,1902) + lu(k,1950) = lu(k,1950) - lu(k,672) * lu(k,1902) + lu(k,1952) = lu(k,1952) - lu(k,673) * lu(k,1902) + lu(k,1957) = lu(k,1957) - lu(k,674) * lu(k,1902) + lu(k,1958) = lu(k,1958) - lu(k,675) * lu(k,1902) + lu(k,2182) = lu(k,2182) - lu(k,671) * lu(k,2144) + lu(k,2185) = lu(k,2185) - lu(k,672) * lu(k,2144) + lu(k,2187) = lu(k,2187) - lu(k,673) * lu(k,2144) + lu(k,2192) = lu(k,2192) - lu(k,674) * lu(k,2144) + lu(k,2193) = lu(k,2193) - lu(k,675) * lu(k,2144) + lu(k,2300) = lu(k,2300) - lu(k,671) * lu(k,2248) + lu(k,2303) = lu(k,2303) - lu(k,672) * lu(k,2248) + lu(k,2305) = lu(k,2305) - lu(k,673) * lu(k,2248) + lu(k,2310) = lu(k,2310) - lu(k,674) * lu(k,2248) + lu(k,2311) = lu(k,2311) - lu(k,675) * lu(k,2248) + lu(k,677) = 1._r8 / lu(k,677) + lu(k,678) = lu(k,678) * lu(k,677) + lu(k,679) = lu(k,679) * lu(k,677) + lu(k,680) = lu(k,680) * lu(k,677) + lu(k,681) = lu(k,681) * lu(k,677) + lu(k,682) = lu(k,682) * lu(k,677) + lu(k,683) = lu(k,683) * lu(k,677) + lu(k,684) = lu(k,684) * lu(k,677) + lu(k,685) = lu(k,685) * lu(k,677) + lu(k,686) = lu(k,686) * lu(k,677) + lu(k,958) = lu(k,958) - lu(k,678) * lu(k,956) + lu(k,959) = lu(k,959) - lu(k,679) * lu(k,956) + lu(k,960) = lu(k,960) - lu(k,680) * lu(k,956) + lu(k,961) = lu(k,961) - lu(k,681) * lu(k,956) + lu(k,962) = lu(k,962) - lu(k,682) * lu(k,956) + lu(k,963) = lu(k,963) - lu(k,683) * lu(k,956) + lu(k,964) = lu(k,964) - lu(k,684) * lu(k,956) + lu(k,966) = lu(k,966) - lu(k,685) * lu(k,956) + lu(k,969) = lu(k,969) - lu(k,686) * lu(k,956) + lu(k,1760) = lu(k,1760) - lu(k,678) * lu(k,1758) + lu(k,1776) = lu(k,1776) - lu(k,679) * lu(k,1758) + lu(k,1784) = lu(k,1784) - lu(k,680) * lu(k,1758) + lu(k,1786) = lu(k,1786) - lu(k,681) * lu(k,1758) + lu(k,1793) = lu(k,1793) - lu(k,682) * lu(k,1758) + lu(k,1813) = lu(k,1813) - lu(k,683) * lu(k,1758) + lu(k,1819) = lu(k,1819) - lu(k,684) * lu(k,1758) + lu(k,1823) = lu(k,1823) - lu(k,685) * lu(k,1758) + lu(k,1831) = lu(k,1831) - lu(k,686) * lu(k,1758) + lu(k,2250) = lu(k,2250) - lu(k,678) * lu(k,2249) + lu(k,2266) = lu(k,2266) - lu(k,679) * lu(k,2249) + lu(k,2270) = lu(k,2270) - lu(k,680) * lu(k,2249) + lu(k,2271) = lu(k,2271) - lu(k,681) * lu(k,2249) + lu(k,2275) = lu(k,2275) - lu(k,682) * lu(k,2249) + lu(k,2293) = lu(k,2293) - lu(k,683) * lu(k,2249) + lu(k,2299) = lu(k,2299) - lu(k,684) * lu(k,2249) + lu(k,2303) = lu(k,2303) - lu(k,685) * lu(k,2249) + lu(k,2311) = lu(k,2311) - lu(k,686) * lu(k,2249) + 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,688) = 1._r8 / lu(k,688) + lu(k,689) = lu(k,689) * lu(k,688) + lu(k,690) = lu(k,690) * lu(k,688) + lu(k,691) = lu(k,691) * lu(k,688) + lu(k,692) = lu(k,692) * lu(k,688) + lu(k,693) = lu(k,693) * lu(k,688) + lu(k,694) = lu(k,694) * lu(k,688) + lu(k,695) = lu(k,695) * lu(k,688) + lu(k,696) = lu(k,696) * lu(k,688) + lu(k,697) = lu(k,697) * lu(k,688) + lu(k,958) = lu(k,958) - lu(k,689) * lu(k,957) + lu(k,959) = lu(k,959) - lu(k,690) * lu(k,957) + lu(k,961) = lu(k,961) - lu(k,691) * lu(k,957) + lu(k,962) = lu(k,962) - lu(k,692) * lu(k,957) + lu(k,963) = lu(k,963) - lu(k,693) * lu(k,957) + lu(k,964) = lu(k,964) - lu(k,694) * lu(k,957) + lu(k,965) = lu(k,965) - lu(k,695) * lu(k,957) + lu(k,966) = lu(k,966) - lu(k,696) * lu(k,957) + lu(k,969) = lu(k,969) - lu(k,697) * lu(k,957) + lu(k,1760) = lu(k,1760) - lu(k,689) * lu(k,1759) + lu(k,1776) = lu(k,1776) - lu(k,690) * lu(k,1759) + lu(k,1786) = lu(k,1786) - lu(k,691) * lu(k,1759) + lu(k,1793) = lu(k,1793) - lu(k,692) * lu(k,1759) + lu(k,1813) = lu(k,1813) - lu(k,693) * lu(k,1759) + lu(k,1819) = lu(k,1819) - lu(k,694) * lu(k,1759) + lu(k,1820) = lu(k,1820) - lu(k,695) * lu(k,1759) + lu(k,1823) = lu(k,1823) - lu(k,696) * lu(k,1759) + lu(k,1831) = lu(k,1831) - lu(k,697) * lu(k,1759) + lu(k,1904) = lu(k,1904) - lu(k,689) * lu(k,1903) + lu(k,1912) = lu(k,1912) - lu(k,690) * lu(k,1903) + lu(k,1917) = lu(k,1917) - lu(k,691) * lu(k,1903) + lu(k,1922) = lu(k,1922) - lu(k,692) * lu(k,1903) + lu(k,1941) = lu(k,1941) - lu(k,693) * lu(k,1903) + lu(k,1946) = lu(k,1946) - lu(k,694) * lu(k,1903) + lu(k,1947) = lu(k,1947) - lu(k,695) * lu(k,1903) + lu(k,1950) = lu(k,1950) - lu(k,696) * lu(k,1903) + lu(k,1958) = lu(k,1958) - lu(k,697) * lu(k,1903) + lu(k,699) = 1._r8 / lu(k,699) + lu(k,700) = lu(k,700) * lu(k,699) + lu(k,701) = lu(k,701) * lu(k,699) + lu(k,702) = lu(k,702) * lu(k,699) + lu(k,703) = lu(k,703) * lu(k,699) + lu(k,704) = lu(k,704) * lu(k,699) + lu(k,705) = lu(k,705) * lu(k,699) + lu(k,962) = lu(k,962) - lu(k,700) * lu(k,958) + lu(k,963) = lu(k,963) - lu(k,701) * lu(k,958) + lu(k,965) = lu(k,965) - lu(k,702) * lu(k,958) + lu(k,966) = lu(k,966) - lu(k,703) * lu(k,958) + lu(k,967) = lu(k,967) - lu(k,704) * lu(k,958) + lu(k,969) = lu(k,969) - lu(k,705) * lu(k,958) + lu(k,1793) = lu(k,1793) - lu(k,700) * lu(k,1760) + lu(k,1813) = lu(k,1813) - lu(k,701) * lu(k,1760) + lu(k,1820) = lu(k,1820) - lu(k,702) * lu(k,1760) + lu(k,1823) = lu(k,1823) - lu(k,703) * lu(k,1760) + lu(k,1825) = lu(k,1825) - lu(k,704) * lu(k,1760) + lu(k,1831) = lu(k,1831) - lu(k,705) * lu(k,1760) + lu(k,1922) = lu(k,1922) - lu(k,700) * lu(k,1904) + lu(k,1941) = lu(k,1941) - lu(k,701) * lu(k,1904) + lu(k,1947) = lu(k,1947) - lu(k,702) * lu(k,1904) + lu(k,1950) = lu(k,1950) - lu(k,703) * lu(k,1904) + lu(k,1952) = lu(k,1952) - lu(k,704) * lu(k,1904) + lu(k,1958) = lu(k,1958) - lu(k,705) * lu(k,1904) + lu(k,2275) = lu(k,2275) - lu(k,700) * lu(k,2250) + lu(k,2293) = lu(k,2293) - lu(k,701) * lu(k,2250) + lu(k,2300) = lu(k,2300) - lu(k,702) * lu(k,2250) + lu(k,2303) = lu(k,2303) - lu(k,703) * lu(k,2250) + lu(k,2305) = lu(k,2305) - lu(k,704) * lu(k,2250) + lu(k,2311) = lu(k,2311) - lu(k,705) * lu(k,2250) + lu(k,706) = 1._r8 / lu(k,706) + lu(k,707) = lu(k,707) * lu(k,706) + lu(k,708) = lu(k,708) * lu(k,706) + lu(k,709) = lu(k,709) * lu(k,706) + lu(k,710) = lu(k,710) * lu(k,706) + lu(k,711) = lu(k,711) * lu(k,706) + lu(k,712) = lu(k,712) * lu(k,706) + lu(k,713) = lu(k,713) * lu(k,706) + lu(k,714) = lu(k,714) * lu(k,706) + lu(k,715) = lu(k,715) * lu(k,706) + lu(k,1158) = lu(k,1158) - lu(k,707) * lu(k,1156) + lu(k,1159) = lu(k,1159) - lu(k,708) * lu(k,1156) + lu(k,1160) = lu(k,1160) - lu(k,709) * lu(k,1156) + lu(k,1161) = lu(k,1161) - lu(k,710) * lu(k,1156) + lu(k,1162) = lu(k,1162) - lu(k,711) * lu(k,1156) + lu(k,1163) = lu(k,1163) - lu(k,712) * lu(k,1156) + lu(k,1167) = lu(k,1167) - lu(k,713) * lu(k,1156) + lu(k,1170) = - lu(k,714) * lu(k,1156) + lu(k,1173) = lu(k,1173) - lu(k,715) * lu(k,1156) + lu(k,1777) = lu(k,1777) - lu(k,707) * lu(k,1761) + lu(k,1786) = lu(k,1786) - lu(k,708) * lu(k,1761) + lu(k,1794) = lu(k,1794) - lu(k,709) * lu(k,1761) + lu(k,1796) = lu(k,1796) - lu(k,710) * lu(k,1761) + lu(k,1797) = lu(k,1797) - lu(k,711) * lu(k,1761) + lu(k,1800) = lu(k,1800) - lu(k,712) * lu(k,1761) + lu(k,1819) = lu(k,1819) - lu(k,713) * lu(k,1761) + lu(k,1823) = lu(k,1823) - lu(k,714) * lu(k,1761) + lu(k,1831) = lu(k,1831) - lu(k,715) * lu(k,1761) + lu(k,2267) = lu(k,2267) - lu(k,707) * lu(k,2251) + lu(k,2271) = lu(k,2271) - lu(k,708) * lu(k,2251) + lu(k,2276) = lu(k,2276) - lu(k,709) * lu(k,2251) + lu(k,2278) = - lu(k,710) * lu(k,2251) + lu(k,2279) = lu(k,2279) - lu(k,711) * lu(k,2251) + lu(k,2281) = lu(k,2281) - lu(k,712) * lu(k,2251) + lu(k,2299) = lu(k,2299) - lu(k,713) * lu(k,2251) + lu(k,2303) = lu(k,2303) - lu(k,714) * lu(k,2251) + lu(k,2311) = lu(k,2311) - lu(k,715) * lu(k,2251) + lu(k,719) = 1._r8 / lu(k,719) + lu(k,720) = lu(k,720) * lu(k,719) + lu(k,721) = lu(k,721) * lu(k,719) + lu(k,722) = lu(k,722) * lu(k,719) + lu(k,723) = lu(k,723) * lu(k,719) + lu(k,724) = lu(k,724) * lu(k,719) + lu(k,725) = lu(k,725) * lu(k,719) + lu(k,726) = lu(k,726) * lu(k,719) + lu(k,727) = lu(k,727) * lu(k,719) + lu(k,728) = lu(k,728) * lu(k,719) + lu(k,768) = lu(k,768) - lu(k,720) * lu(k,767) + lu(k,769) = lu(k,769) - lu(k,721) * lu(k,767) + lu(k,770) = lu(k,770) - lu(k,722) * lu(k,767) + lu(k,771) = lu(k,771) - lu(k,723) * lu(k,767) + lu(k,772) = lu(k,772) - lu(k,724) * lu(k,767) + lu(k,773) = lu(k,773) - lu(k,725) * lu(k,767) + lu(k,774) = lu(k,774) - lu(k,726) * lu(k,767) + lu(k,776) = - lu(k,727) * lu(k,767) + lu(k,778) = lu(k,778) - lu(k,728) * lu(k,767) + lu(k,1766) = lu(k,1766) - lu(k,720) * lu(k,1762) + lu(k,1767) = lu(k,1767) - lu(k,721) * lu(k,1762) + lu(k,1770) = - lu(k,722) * lu(k,1762) + lu(k,1782) = lu(k,1782) - lu(k,723) * lu(k,1762) + lu(k,1788) = lu(k,1788) - lu(k,724) * lu(k,1762) + lu(k,1797) = lu(k,1797) - lu(k,725) * lu(k,1762) + lu(k,1806) = lu(k,1806) - lu(k,726) * lu(k,1762) + lu(k,1823) = lu(k,1823) - lu(k,727) * lu(k,1762) + lu(k,1831) = lu(k,1831) - lu(k,728) * lu(k,1762) + lu(k,2256) = lu(k,2256) - lu(k,720) * lu(k,2252) + lu(k,2257) = lu(k,2257) - lu(k,721) * lu(k,2252) + lu(k,2260) = lu(k,2260) - lu(k,722) * lu(k,2252) + lu(k,2269) = lu(k,2269) - lu(k,723) * lu(k,2252) + lu(k,2273) = lu(k,2273) - lu(k,724) * lu(k,2252) + lu(k,2279) = lu(k,2279) - lu(k,725) * lu(k,2252) + lu(k,2287) = lu(k,2287) - lu(k,726) * lu(k,2252) + lu(k,2303) = lu(k,2303) - lu(k,727) * lu(k,2252) + lu(k,2311) = lu(k,2311) - lu(k,728) * lu(k,2252) + lu(k,729) = 1._r8 / lu(k,729) + lu(k,730) = lu(k,730) * lu(k,729) + lu(k,731) = lu(k,731) * lu(k,729) + lu(k,732) = lu(k,732) * lu(k,729) + lu(k,733) = lu(k,733) * lu(k,729) + lu(k,1045) = lu(k,1045) - lu(k,730) * lu(k,1043) + lu(k,1058) = lu(k,1058) - lu(k,731) * lu(k,1043) + lu(k,1060) = lu(k,1060) - lu(k,732) * lu(k,1043) + lu(k,1064) = - lu(k,733) * lu(k,1043) + lu(k,1397) = lu(k,1397) - lu(k,730) * lu(k,1396) + lu(k,1407) = lu(k,1407) - lu(k,731) * lu(k,1396) + lu(k,1409) = lu(k,1409) - lu(k,732) * lu(k,1396) + lu(k,1413) = lu(k,1413) - lu(k,733) * lu(k,1396) + lu(k,1418) = lu(k,1418) - lu(k,730) * lu(k,1417) + lu(k,1439) = lu(k,1439) - lu(k,731) * lu(k,1417) + lu(k,1441) = lu(k,1441) - lu(k,732) * lu(k,1417) + lu(k,1445) = lu(k,1445) - lu(k,733) * lu(k,1417) + lu(k,1777) = lu(k,1777) - lu(k,730) * lu(k,1763) + lu(k,1823) = lu(k,1823) - lu(k,731) * lu(k,1763) + lu(k,1826) = lu(k,1826) - lu(k,732) * lu(k,1763) + lu(k,1833) = lu(k,1833) - lu(k,733) * lu(k,1763) + lu(k,1970) = lu(k,1970) - lu(k,730) * lu(k,1966) + lu(k,2002) = lu(k,2002) - lu(k,731) * lu(k,1966) + lu(k,2005) = lu(k,2005) - lu(k,732) * lu(k,1966) + lu(k,2012) = lu(k,2012) - lu(k,733) * lu(k,1966) + lu(k,2147) = lu(k,2147) - lu(k,730) * lu(k,2145) + lu(k,2185) = lu(k,2185) - lu(k,731) * lu(k,2145) + lu(k,2188) = lu(k,2188) - lu(k,732) * lu(k,2145) + lu(k,2195) = - lu(k,733) * lu(k,2145) + lu(k,2267) = lu(k,2267) - lu(k,730) * lu(k,2253) + lu(k,2303) = lu(k,2303) - lu(k,731) * lu(k,2253) + lu(k,2306) = lu(k,2306) - lu(k,732) * lu(k,2253) + lu(k,2313) = lu(k,2313) - lu(k,733) * lu(k,2253) + lu(k,738) = 1._r8 / lu(k,738) + lu(k,739) = lu(k,739) * lu(k,738) + lu(k,740) = lu(k,740) * lu(k,738) + lu(k,741) = lu(k,741) * lu(k,738) + lu(k,742) = lu(k,742) * lu(k,738) + lu(k,743) = lu(k,743) * lu(k,738) + lu(k,744) = lu(k,744) * lu(k,738) + lu(k,745) = lu(k,745) * lu(k,738) + lu(k,746) = lu(k,746) * lu(k,738) + lu(k,747) = lu(k,747) * lu(k,738) + lu(k,748) = lu(k,748) * lu(k,738) + lu(k,792) = lu(k,792) - lu(k,739) * lu(k,791) + lu(k,793) = lu(k,793) - lu(k,740) * lu(k,791) + lu(k,794) = lu(k,794) - lu(k,741) * lu(k,791) + lu(k,795) = lu(k,795) - lu(k,742) * lu(k,791) + lu(k,796) = lu(k,796) - lu(k,743) * lu(k,791) + lu(k,797) = lu(k,797) - lu(k,744) * lu(k,791) + lu(k,798) = lu(k,798) - lu(k,745) * lu(k,791) + lu(k,799) = lu(k,799) - lu(k,746) * lu(k,791) + lu(k,801) = - lu(k,747) * lu(k,791) + lu(k,803) = lu(k,803) - lu(k,748) * lu(k,791) + lu(k,1766) = lu(k,1766) - lu(k,739) * lu(k,1764) + lu(k,1769) = lu(k,1769) - lu(k,740) * lu(k,1764) + lu(k,1770) = lu(k,1770) - lu(k,741) * lu(k,1764) + lu(k,1782) = lu(k,1782) - lu(k,742) * lu(k,1764) + lu(k,1788) = lu(k,1788) - lu(k,743) * lu(k,1764) + lu(k,1797) = lu(k,1797) - lu(k,744) * lu(k,1764) + lu(k,1806) = lu(k,1806) - lu(k,745) * lu(k,1764) + lu(k,1813) = lu(k,1813) - lu(k,746) * lu(k,1764) + lu(k,1823) = lu(k,1823) - lu(k,747) * lu(k,1764) + lu(k,1831) = lu(k,1831) - lu(k,748) * lu(k,1764) + lu(k,2256) = lu(k,2256) - lu(k,739) * lu(k,2254) + lu(k,2259) = lu(k,2259) - lu(k,740) * lu(k,2254) + lu(k,2260) = lu(k,2260) - lu(k,741) * lu(k,2254) + lu(k,2269) = lu(k,2269) - lu(k,742) * lu(k,2254) + lu(k,2273) = lu(k,2273) - lu(k,743) * lu(k,2254) + lu(k,2279) = lu(k,2279) - lu(k,744) * lu(k,2254) + lu(k,2287) = lu(k,2287) - lu(k,745) * lu(k,2254) + lu(k,2293) = lu(k,2293) - lu(k,746) * lu(k,2254) + lu(k,2303) = lu(k,2303) - lu(k,747) * lu(k,2254) + lu(k,2311) = lu(k,2311) - lu(k,748) * lu(k,2254) + 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,751) = 1._r8 / lu(k,751) + lu(k,752) = lu(k,752) * lu(k,751) + lu(k,753) = lu(k,753) * lu(k,751) + lu(k,754) = lu(k,754) * lu(k,751) + lu(k,755) = lu(k,755) * lu(k,751) + lu(k,756) = lu(k,756) * lu(k,751) + lu(k,757) = lu(k,757) * lu(k,751) + lu(k,1794) = lu(k,1794) - lu(k,752) * lu(k,1765) + lu(k,1819) = lu(k,1819) - lu(k,753) * lu(k,1765) + lu(k,1820) = lu(k,1820) - lu(k,754) * lu(k,1765) + lu(k,1823) = lu(k,1823) - lu(k,755) * lu(k,1765) + lu(k,1825) = lu(k,1825) - lu(k,756) * lu(k,1765) + lu(k,1831) = lu(k,1831) - lu(k,757) * lu(k,1765) + lu(k,1923) = lu(k,1923) - lu(k,752) * lu(k,1905) + lu(k,1946) = lu(k,1946) - lu(k,753) * lu(k,1905) + lu(k,1947) = lu(k,1947) - lu(k,754) * lu(k,1905) + lu(k,1950) = lu(k,1950) - lu(k,755) * lu(k,1905) + lu(k,1952) = lu(k,1952) - lu(k,756) * lu(k,1905) + lu(k,1958) = lu(k,1958) - lu(k,757) * lu(k,1905) + lu(k,2111) = - lu(k,752) * lu(k,2104) + lu(k,2119) = lu(k,2119) - lu(k,753) * lu(k,2104) + lu(k,2120) = - lu(k,754) * lu(k,2104) + lu(k,2123) = lu(k,2123) - lu(k,755) * lu(k,2104) + lu(k,2125) = - lu(k,756) * lu(k,2104) + lu(k,2131) = lu(k,2131) - lu(k,757) * lu(k,2104) + lu(k,2159) = - lu(k,752) * lu(k,2146) + lu(k,2181) = lu(k,2181) - lu(k,753) * lu(k,2146) + lu(k,2182) = lu(k,2182) - lu(k,754) * lu(k,2146) + lu(k,2185) = lu(k,2185) - lu(k,755) * lu(k,2146) + lu(k,2187) = lu(k,2187) - lu(k,756) * lu(k,2146) + lu(k,2193) = lu(k,2193) - lu(k,757) * lu(k,2146) + lu(k,2276) = lu(k,2276) - lu(k,752) * lu(k,2255) + lu(k,2299) = lu(k,2299) - lu(k,753) * lu(k,2255) + lu(k,2300) = lu(k,2300) - lu(k,754) * lu(k,2255) + lu(k,2303) = lu(k,2303) - lu(k,755) * lu(k,2255) + lu(k,2305) = lu(k,2305) - lu(k,756) * lu(k,2255) + lu(k,2311) = lu(k,2311) - lu(k,757) * lu(k,2255) + lu(k,758) = 1._r8 / lu(k,758) + lu(k,759) = lu(k,759) * lu(k,758) + lu(k,760) = lu(k,760) * lu(k,758) + lu(k,761) = lu(k,761) * lu(k,758) + lu(k,762) = lu(k,762) * lu(k,758) + lu(k,763) = lu(k,763) * lu(k,758) + lu(k,772) = lu(k,772) - lu(k,759) * lu(k,768) + lu(k,773) = lu(k,773) - lu(k,760) * lu(k,768) + lu(k,775) = lu(k,775) - lu(k,761) * lu(k,768) + lu(k,777) = lu(k,777) - lu(k,762) * lu(k,768) + lu(k,778) = lu(k,778) - lu(k,763) * lu(k,768) + lu(k,796) = lu(k,796) - lu(k,759) * lu(k,792) + lu(k,797) = lu(k,797) - lu(k,760) * lu(k,792) + lu(k,800) = lu(k,800) - lu(k,761) * lu(k,792) + lu(k,802) = lu(k,802) - lu(k,762) * lu(k,792) + lu(k,803) = lu(k,803) - lu(k,763) * lu(k,792) + lu(k,1564) = - lu(k,759) * lu(k,1557) + lu(k,1565) = - lu(k,760) * lu(k,1557) + lu(k,1576) = lu(k,1576) - lu(k,761) * lu(k,1557) + lu(k,1581) = lu(k,1581) - lu(k,762) * lu(k,1557) + lu(k,1587) = lu(k,1587) - lu(k,763) * lu(k,1557) + lu(k,1788) = lu(k,1788) - lu(k,759) * lu(k,1766) + lu(k,1797) = lu(k,1797) - lu(k,760) * lu(k,1766) + lu(k,1820) = lu(k,1820) - lu(k,761) * lu(k,1766) + lu(k,1825) = lu(k,1825) - lu(k,762) * lu(k,1766) + lu(k,1831) = lu(k,1831) - lu(k,763) * lu(k,1766) + lu(k,1919) = lu(k,1919) - lu(k,759) * lu(k,1906) + lu(k,1926) = lu(k,1926) - lu(k,760) * lu(k,1906) + lu(k,1947) = lu(k,1947) - lu(k,761) * lu(k,1906) + lu(k,1952) = lu(k,1952) - lu(k,762) * lu(k,1906) + lu(k,1958) = lu(k,1958) - lu(k,763) * lu(k,1906) + lu(k,2273) = lu(k,2273) - lu(k,759) * lu(k,2256) + lu(k,2279) = lu(k,2279) - lu(k,760) * lu(k,2256) + lu(k,2300) = lu(k,2300) - lu(k,761) * lu(k,2256) + lu(k,2305) = lu(k,2305) - lu(k,762) * lu(k,2256) + lu(k,2311) = lu(k,2311) - lu(k,763) * lu(k,2256) + 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,778) = lu(k,778) * lu(k,769) + lu(k,1770) = lu(k,1770) - lu(k,770) * lu(k,1767) + lu(k,1782) = lu(k,1782) - lu(k,771) * lu(k,1767) + lu(k,1788) = lu(k,1788) - lu(k,772) * lu(k,1767) + lu(k,1797) = lu(k,1797) - lu(k,773) * lu(k,1767) + lu(k,1806) = lu(k,1806) - lu(k,774) * lu(k,1767) + lu(k,1820) = lu(k,1820) - lu(k,775) * lu(k,1767) + lu(k,1823) = lu(k,1823) - lu(k,776) * lu(k,1767) + lu(k,1825) = lu(k,1825) - lu(k,777) * lu(k,1767) + lu(k,1831) = lu(k,1831) - lu(k,778) * lu(k,1767) + lu(k,1909) = lu(k,1909) - lu(k,770) * lu(k,1907) + lu(k,1915) = lu(k,1915) - lu(k,771) * lu(k,1907) + lu(k,1919) = lu(k,1919) - lu(k,772) * lu(k,1907) + lu(k,1926) = lu(k,1926) - lu(k,773) * lu(k,1907) + lu(k,1935) = lu(k,1935) - lu(k,774) * lu(k,1907) + lu(k,1947) = lu(k,1947) - lu(k,775) * lu(k,1907) + lu(k,1950) = lu(k,1950) - lu(k,776) * lu(k,1907) + lu(k,1952) = lu(k,1952) - lu(k,777) * lu(k,1907) + lu(k,1958) = lu(k,1958) - lu(k,778) * lu(k,1907) + lu(k,2260) = lu(k,2260) - lu(k,770) * lu(k,2257) + lu(k,2269) = lu(k,2269) - lu(k,771) * lu(k,2257) + lu(k,2273) = lu(k,2273) - lu(k,772) * lu(k,2257) + lu(k,2279) = lu(k,2279) - lu(k,773) * lu(k,2257) + lu(k,2287) = lu(k,2287) - lu(k,774) * lu(k,2257) + lu(k,2300) = lu(k,2300) - lu(k,775) * lu(k,2257) + lu(k,2303) = lu(k,2303) - lu(k,776) * lu(k,2257) + lu(k,2305) = lu(k,2305) - lu(k,777) * lu(k,2257) + lu(k,2311) = lu(k,2311) - lu(k,778) * lu(k,2257) + lu(k,780) = 1._r8 / lu(k,780) + lu(k,781) = lu(k,781) * lu(k,780) + lu(k,782) = lu(k,782) * lu(k,780) + lu(k,783) = lu(k,783) * lu(k,780) + lu(k,784) = lu(k,784) * lu(k,780) + lu(k,785) = lu(k,785) * lu(k,780) + lu(k,786) = lu(k,786) * lu(k,780) + lu(k,1236) = - lu(k,781) * lu(k,1230) + lu(k,1238) = - lu(k,782) * lu(k,1230) + lu(k,1240) = - lu(k,783) * lu(k,1230) + lu(k,1243) = lu(k,1243) - lu(k,784) * lu(k,1230) + lu(k,1246) = lu(k,1246) - lu(k,785) * lu(k,1230) + lu(k,1250) = lu(k,1250) - lu(k,786) * lu(k,1230) + lu(k,1298) = - lu(k,781) * lu(k,1290) + lu(k,1299) = lu(k,1299) - lu(k,782) * lu(k,1290) + lu(k,1303) = lu(k,1303) - lu(k,783) * lu(k,1290) + lu(k,1307) = lu(k,1307) - lu(k,784) * lu(k,1290) + lu(k,1310) = lu(k,1310) - lu(k,785) * lu(k,1290) + lu(k,1315) = lu(k,1315) - lu(k,786) * lu(k,1290) + lu(k,1331) = lu(k,1331) - lu(k,781) * lu(k,1321) + lu(k,1332) = - lu(k,782) * lu(k,1321) + lu(k,1336) = - lu(k,783) * lu(k,1321) + lu(k,1340) = lu(k,1340) - lu(k,784) * lu(k,1321) + lu(k,1343) = lu(k,1343) - lu(k,785) * lu(k,1321) + lu(k,1348) = lu(k,1348) - lu(k,786) * lu(k,1321) + lu(k,1803) = lu(k,1803) - lu(k,781) * lu(k,1768) + lu(k,1805) = lu(k,1805) - lu(k,782) * lu(k,1768) + lu(k,1811) = lu(k,1811) - lu(k,783) * lu(k,1768) + lu(k,1819) = lu(k,1819) - lu(k,784) * lu(k,1768) + lu(k,1823) = lu(k,1823) - lu(k,785) * lu(k,1768) + lu(k,1831) = lu(k,1831) - lu(k,786) * lu(k,1768) + lu(k,2284) = lu(k,2284) - lu(k,781) * lu(k,2258) + lu(k,2286) = - lu(k,782) * lu(k,2258) + lu(k,2291) = - lu(k,783) * lu(k,2258) + lu(k,2299) = lu(k,2299) - lu(k,784) * lu(k,2258) + lu(k,2303) = lu(k,2303) - lu(k,785) * lu(k,2258) + lu(k,2311) = lu(k,2311) - lu(k,786) * lu(k,2258) + lu(k,793) = 1._r8 / lu(k,793) + lu(k,794) = lu(k,794) * lu(k,793) + lu(k,795) = lu(k,795) * lu(k,793) + lu(k,796) = lu(k,796) * lu(k,793) + lu(k,797) = lu(k,797) * lu(k,793) + lu(k,798) = lu(k,798) * lu(k,793) + lu(k,799) = lu(k,799) * lu(k,793) + lu(k,800) = lu(k,800) * lu(k,793) + lu(k,801) = lu(k,801) * lu(k,793) + lu(k,802) = lu(k,802) * lu(k,793) + lu(k,803) = lu(k,803) * lu(k,793) + lu(k,1770) = lu(k,1770) - lu(k,794) * lu(k,1769) + lu(k,1782) = lu(k,1782) - lu(k,795) * lu(k,1769) + lu(k,1788) = lu(k,1788) - lu(k,796) * lu(k,1769) + lu(k,1797) = lu(k,1797) - lu(k,797) * lu(k,1769) + lu(k,1806) = lu(k,1806) - lu(k,798) * lu(k,1769) + lu(k,1813) = lu(k,1813) - lu(k,799) * lu(k,1769) + lu(k,1820) = lu(k,1820) - lu(k,800) * lu(k,1769) + lu(k,1823) = lu(k,1823) - lu(k,801) * lu(k,1769) + lu(k,1825) = lu(k,1825) - lu(k,802) * lu(k,1769) + lu(k,1831) = lu(k,1831) - lu(k,803) * lu(k,1769) + lu(k,1909) = lu(k,1909) - lu(k,794) * lu(k,1908) + lu(k,1915) = lu(k,1915) - lu(k,795) * lu(k,1908) + lu(k,1919) = lu(k,1919) - lu(k,796) * lu(k,1908) + lu(k,1926) = lu(k,1926) - lu(k,797) * lu(k,1908) + lu(k,1935) = lu(k,1935) - lu(k,798) * lu(k,1908) + lu(k,1941) = lu(k,1941) - lu(k,799) * lu(k,1908) + lu(k,1947) = lu(k,1947) - lu(k,800) * lu(k,1908) + lu(k,1950) = lu(k,1950) - lu(k,801) * lu(k,1908) + lu(k,1952) = lu(k,1952) - lu(k,802) * lu(k,1908) + lu(k,1958) = lu(k,1958) - lu(k,803) * lu(k,1908) + lu(k,2260) = lu(k,2260) - lu(k,794) * lu(k,2259) + lu(k,2269) = lu(k,2269) - lu(k,795) * lu(k,2259) + lu(k,2273) = lu(k,2273) - lu(k,796) * lu(k,2259) + lu(k,2279) = lu(k,2279) - lu(k,797) * lu(k,2259) + lu(k,2287) = lu(k,2287) - lu(k,798) * lu(k,2259) + lu(k,2293) = lu(k,2293) - lu(k,799) * lu(k,2259) + lu(k,2300) = lu(k,2300) - lu(k,800) * lu(k,2259) + lu(k,2303) = lu(k,2303) - lu(k,801) * lu(k,2259) + lu(k,2305) = lu(k,2305) - lu(k,802) * lu(k,2259) + lu(k,2311) = lu(k,2311) - lu(k,803) * lu(k,2259) + 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,804) = 1._r8 / lu(k,804) + lu(k,805) = lu(k,805) * lu(k,804) + lu(k,806) = lu(k,806) * lu(k,804) + lu(k,807) = lu(k,807) * lu(k,804) + lu(k,808) = lu(k,808) * lu(k,804) + lu(k,809) = lu(k,809) * lu(k,804) + lu(k,810) = lu(k,810) * lu(k,804) + lu(k,811) = lu(k,811) * lu(k,804) + lu(k,1565) = lu(k,1565) - lu(k,805) * lu(k,1558) + lu(k,1567) = - lu(k,806) * lu(k,1558) + lu(k,1576) = lu(k,1576) - lu(k,807) * lu(k,1558) + lu(k,1579) = lu(k,1579) - lu(k,808) * lu(k,1558) + lu(k,1581) = lu(k,1581) - lu(k,809) * lu(k,1558) + lu(k,1582) = lu(k,1582) - lu(k,810) * lu(k,1558) + lu(k,1587) = lu(k,1587) - lu(k,811) * lu(k,1558) + lu(k,1797) = lu(k,1797) - lu(k,805) * lu(k,1770) + lu(k,1806) = lu(k,1806) - lu(k,806) * lu(k,1770) + lu(k,1820) = lu(k,1820) - lu(k,807) * lu(k,1770) + lu(k,1823) = lu(k,1823) - lu(k,808) * lu(k,1770) + lu(k,1825) = lu(k,1825) - lu(k,809) * lu(k,1770) + lu(k,1826) = lu(k,1826) - lu(k,810) * lu(k,1770) + lu(k,1831) = lu(k,1831) - lu(k,811) * lu(k,1770) + lu(k,1926) = lu(k,1926) - lu(k,805) * lu(k,1909) + lu(k,1935) = lu(k,1935) - lu(k,806) * lu(k,1909) + lu(k,1947) = lu(k,1947) - lu(k,807) * lu(k,1909) + lu(k,1950) = lu(k,1950) - lu(k,808) * lu(k,1909) + lu(k,1952) = lu(k,1952) - lu(k,809) * lu(k,1909) + lu(k,1953) = lu(k,1953) - lu(k,810) * lu(k,1909) + lu(k,1958) = lu(k,1958) - lu(k,811) * lu(k,1909) + lu(k,2279) = lu(k,2279) - lu(k,805) * lu(k,2260) + lu(k,2287) = lu(k,2287) - lu(k,806) * lu(k,2260) + lu(k,2300) = lu(k,2300) - lu(k,807) * lu(k,2260) + lu(k,2303) = lu(k,2303) - lu(k,808) * lu(k,2260) + lu(k,2305) = lu(k,2305) - lu(k,809) * lu(k,2260) + lu(k,2306) = lu(k,2306) - lu(k,810) * lu(k,2260) + lu(k,2311) = lu(k,2311) - lu(k,811) * lu(k,2260) + lu(k,813) = 1._r8 / lu(k,813) + lu(k,814) = lu(k,814) * lu(k,813) + lu(k,815) = lu(k,815) * lu(k,813) + lu(k,816) = lu(k,816) * lu(k,813) + lu(k,817) = lu(k,817) * lu(k,813) + lu(k,818) = lu(k,818) * lu(k,813) + lu(k,819) = lu(k,819) * lu(k,813) + lu(k,820) = lu(k,820) * lu(k,813) + lu(k,821) = lu(k,821) * lu(k,813) + lu(k,1049) = lu(k,1049) - lu(k,814) * lu(k,1044) + lu(k,1051) = - lu(k,815) * lu(k,1044) + lu(k,1055) = lu(k,1055) - lu(k,816) * lu(k,1044) + lu(k,1056) = - lu(k,817) * lu(k,1044) + lu(k,1058) = lu(k,1058) - lu(k,818) * lu(k,1044) + lu(k,1059) = - lu(k,819) * lu(k,1044) + lu(k,1063) = lu(k,1063) - lu(k,820) * lu(k,1044) + lu(k,1064) = lu(k,1064) - lu(k,821) * lu(k,1044) + lu(k,1793) = lu(k,1793) - lu(k,814) * lu(k,1771) + lu(k,1799) = lu(k,1799) - lu(k,815) * lu(k,1771) + lu(k,1819) = lu(k,1819) - lu(k,816) * lu(k,1771) + lu(k,1820) = lu(k,1820) - lu(k,817) * lu(k,1771) + lu(k,1823) = lu(k,1823) - lu(k,818) * lu(k,1771) + lu(k,1825) = lu(k,1825) - lu(k,819) * lu(k,1771) + lu(k,1831) = lu(k,1831) - lu(k,820) * lu(k,1771) + lu(k,1833) = lu(k,1833) - lu(k,821) * lu(k,1771) + lu(k,1922) = lu(k,1922) - lu(k,814) * lu(k,1910) + lu(k,1928) = lu(k,1928) - lu(k,815) * lu(k,1910) + lu(k,1946) = lu(k,1946) - lu(k,816) * lu(k,1910) + lu(k,1947) = lu(k,1947) - lu(k,817) * lu(k,1910) + lu(k,1950) = lu(k,1950) - lu(k,818) * lu(k,1910) + lu(k,1952) = lu(k,1952) - lu(k,819) * lu(k,1910) + lu(k,1958) = lu(k,1958) - lu(k,820) * lu(k,1910) + lu(k,1960) = - lu(k,821) * lu(k,1910) + lu(k,2275) = lu(k,2275) - lu(k,814) * lu(k,2261) + lu(k,2280) = lu(k,2280) - lu(k,815) * lu(k,2261) + lu(k,2299) = lu(k,2299) - lu(k,816) * lu(k,2261) + lu(k,2300) = lu(k,2300) - lu(k,817) * lu(k,2261) + lu(k,2303) = lu(k,2303) - lu(k,818) * lu(k,2261) + lu(k,2305) = lu(k,2305) - lu(k,819) * lu(k,2261) + lu(k,2311) = lu(k,2311) - lu(k,820) * lu(k,2261) + lu(k,2313) = lu(k,2313) - lu(k,821) * lu(k,2261) + lu(k,823) = 1._r8 / lu(k,823) + lu(k,824) = lu(k,824) * lu(k,823) + lu(k,825) = lu(k,825) * lu(k,823) + lu(k,826) = lu(k,826) * lu(k,823) + lu(k,827) = lu(k,827) * lu(k,823) + lu(k,828) = lu(k,828) * lu(k,823) + lu(k,829) = lu(k,829) * lu(k,823) + lu(k,830) = lu(k,830) * lu(k,823) + lu(k,1571) = lu(k,1571) - lu(k,824) * lu(k,1559) + lu(k,1577) = lu(k,1577) - lu(k,825) * lu(k,1559) + lu(k,1579) = lu(k,1579) - lu(k,826) * lu(k,1559) + lu(k,1580) = lu(k,1580) - lu(k,827) * lu(k,1559) + lu(k,1583) = - lu(k,828) * lu(k,1559) + lu(k,1585) = - lu(k,829) * lu(k,1559) + lu(k,1589) = lu(k,1589) - lu(k,830) * lu(k,1559) + lu(k,1602) = lu(k,1602) - lu(k,824) * lu(k,1594) + lu(k,1608) = lu(k,1608) - lu(k,825) * lu(k,1594) + lu(k,1610) = lu(k,1610) - lu(k,826) * lu(k,1594) + lu(k,1611) = lu(k,1611) - lu(k,827) * lu(k,1594) + lu(k,1614) = lu(k,1614) - lu(k,828) * lu(k,1594) + lu(k,1616) = lu(k,1616) - lu(k,829) * lu(k,1594) + lu(k,1620) = lu(k,1620) - lu(k,830) * lu(k,1594) + lu(k,1840) = lu(k,1840) - lu(k,824) * lu(k,1837) + lu(k,1845) = lu(k,1845) - lu(k,825) * lu(k,1837) + lu(k,1847) = lu(k,1847) - lu(k,826) * lu(k,1837) + lu(k,1848) = lu(k,1848) - lu(k,827) * lu(k,1837) + lu(k,1851) = - lu(k,828) * lu(k,1837) + lu(k,1853) = lu(k,1853) - lu(k,829) * lu(k,1837) + lu(k,1857) = - lu(k,830) * lu(k,1837) + lu(k,2018) = lu(k,2018) - lu(k,824) * lu(k,2015) + lu(k,2023) = lu(k,2023) - lu(k,825) * lu(k,2015) + lu(k,2025) = lu(k,2025) - lu(k,826) * lu(k,2015) + lu(k,2026) = - lu(k,827) * lu(k,2015) + lu(k,2029) = lu(k,2029) - lu(k,828) * lu(k,2015) + lu(k,2031) = lu(k,2031) - lu(k,829) * lu(k,2015) + lu(k,2035) = lu(k,2035) - lu(k,830) * lu(k,2015) + lu(k,2295) = lu(k,2295) - lu(k,824) * lu(k,2262) + lu(k,2301) = lu(k,2301) - lu(k,825) * lu(k,2262) + lu(k,2303) = lu(k,2303) - lu(k,826) * lu(k,2262) + lu(k,2304) = lu(k,2304) - lu(k,827) * lu(k,2262) + lu(k,2307) = lu(k,2307) - lu(k,828) * lu(k,2262) + lu(k,2309) = lu(k,2309) - lu(k,829) * lu(k,2262) + lu(k,2313) = lu(k,2313) - lu(k,830) * lu(k,2262) + lu(k,831) = 1._r8 / lu(k,831) + lu(k,832) = lu(k,832) * lu(k,831) + lu(k,833) = lu(k,833) * lu(k,831) + lu(k,834) = lu(k,834) * lu(k,831) + lu(k,867) = lu(k,867) - lu(k,832) * lu(k,864) + lu(k,869) = lu(k,869) - lu(k,833) * lu(k,864) + lu(k,872) = lu(k,872) - lu(k,834) * lu(k,864) + lu(k,1107) = lu(k,1107) - lu(k,832) * lu(k,1100) + lu(k,1109) = lu(k,1109) - lu(k,833) * lu(k,1100) + lu(k,1113) = lu(k,1113) - lu(k,834) * lu(k,1100) + lu(k,1167) = lu(k,1167) - lu(k,832) * lu(k,1157) + lu(k,1170) = lu(k,1170) - lu(k,833) * lu(k,1157) + lu(k,1173) = lu(k,1173) - lu(k,834) * lu(k,1157) + lu(k,1188) = lu(k,1188) - lu(k,832) * lu(k,1177) + lu(k,1191) = lu(k,1191) - lu(k,833) * lu(k,1177) + lu(k,1195) = lu(k,1195) - lu(k,834) * lu(k,1177) + lu(k,1203) = lu(k,1203) - lu(k,832) * lu(k,1198) + lu(k,1205) = lu(k,1205) - lu(k,833) * lu(k,1198) + lu(k,1208) = lu(k,1208) - lu(k,834) * lu(k,1198) + lu(k,1220) = lu(k,1220) - lu(k,832) * lu(k,1211) + lu(k,1223) = lu(k,1223) - lu(k,833) * lu(k,1211) + lu(k,1227) = lu(k,1227) - lu(k,834) * lu(k,1211) + lu(k,1243) = lu(k,1243) - lu(k,832) * lu(k,1231) + lu(k,1246) = lu(k,1246) - lu(k,833) * lu(k,1231) + lu(k,1250) = lu(k,1250) - lu(k,834) * lu(k,1231) + lu(k,1307) = lu(k,1307) - lu(k,832) * lu(k,1291) + lu(k,1310) = lu(k,1310) - lu(k,833) * lu(k,1291) + lu(k,1315) = lu(k,1315) - lu(k,834) * lu(k,1291) + lu(k,1340) = lu(k,1340) - lu(k,832) * lu(k,1322) + lu(k,1343) = lu(k,1343) - lu(k,833) * lu(k,1322) + lu(k,1348) = lu(k,1348) - lu(k,834) * lu(k,1322) + lu(k,1362) = lu(k,1362) - lu(k,832) * lu(k,1351) + lu(k,1365) = lu(k,1365) - lu(k,833) * lu(k,1351) + lu(k,1369) = lu(k,1369) - lu(k,834) * lu(k,1351) + lu(k,1819) = lu(k,1819) - lu(k,832) * lu(k,1772) + lu(k,1823) = lu(k,1823) - lu(k,833) * lu(k,1772) + lu(k,1831) = lu(k,1831) - lu(k,834) * lu(k,1772) + lu(k,1998) = lu(k,1998) - lu(k,832) * lu(k,1967) + lu(k,2002) = lu(k,2002) - lu(k,833) * lu(k,1967) + lu(k,2010) = lu(k,2010) - lu(k,834) * lu(k,1967) + lu(k,836) = 1._r8 / lu(k,836) + lu(k,837) = lu(k,837) * lu(k,836) + lu(k,838) = lu(k,838) * lu(k,836) + lu(k,839) = lu(k,839) * lu(k,836) + lu(k,840) = lu(k,840) * lu(k,836) + lu(k,841) = lu(k,841) * lu(k,836) + lu(k,842) = lu(k,842) * lu(k,836) + lu(k,843) = lu(k,843) * lu(k,836) + lu(k,844) = lu(k,844) * lu(k,836) + lu(k,845) = lu(k,845) * lu(k,836) + lu(k,1786) = lu(k,1786) - lu(k,837) * lu(k,1773) + lu(k,1793) = lu(k,1793) - lu(k,838) * lu(k,1773) + lu(k,1819) = lu(k,1819) - lu(k,839) * lu(k,1773) + lu(k,1820) = lu(k,1820) - lu(k,840) * lu(k,1773) + lu(k,1823) = lu(k,1823) - lu(k,841) * lu(k,1773) + lu(k,1825) = lu(k,1825) - lu(k,842) * lu(k,1773) + lu(k,1826) = lu(k,1826) - lu(k,843) * lu(k,1773) + lu(k,1831) = lu(k,1831) - lu(k,844) * lu(k,1773) + lu(k,1833) = lu(k,1833) - lu(k,845) * lu(k,1773) + lu(k,1917) = lu(k,1917) - lu(k,837) * lu(k,1911) + lu(k,1922) = lu(k,1922) - lu(k,838) * lu(k,1911) + lu(k,1946) = lu(k,1946) - lu(k,839) * lu(k,1911) + lu(k,1947) = lu(k,1947) - lu(k,840) * lu(k,1911) + lu(k,1950) = lu(k,1950) - lu(k,841) * lu(k,1911) + lu(k,1952) = lu(k,1952) - lu(k,842) * lu(k,1911) + lu(k,1953) = lu(k,1953) - lu(k,843) * lu(k,1911) + lu(k,1958) = lu(k,1958) - lu(k,844) * lu(k,1911) + lu(k,1960) = lu(k,1960) - lu(k,845) * lu(k,1911) + lu(k,1972) = lu(k,1972) - lu(k,837) * lu(k,1968) + lu(k,1976) = lu(k,1976) - lu(k,838) * lu(k,1968) + lu(k,1998) = lu(k,1998) - lu(k,839) * lu(k,1968) + lu(k,1999) = lu(k,1999) - lu(k,840) * lu(k,1968) + lu(k,2002) = lu(k,2002) - lu(k,841) * lu(k,1968) + lu(k,2004) = lu(k,2004) - lu(k,842) * lu(k,1968) + lu(k,2005) = lu(k,2005) - lu(k,843) * lu(k,1968) + lu(k,2010) = lu(k,2010) - lu(k,844) * lu(k,1968) + lu(k,2012) = lu(k,2012) - lu(k,845) * lu(k,1968) + lu(k,2271) = lu(k,2271) - lu(k,837) * lu(k,2263) + lu(k,2275) = lu(k,2275) - lu(k,838) * lu(k,2263) + lu(k,2299) = lu(k,2299) - lu(k,839) * lu(k,2263) + lu(k,2300) = lu(k,2300) - lu(k,840) * lu(k,2263) + lu(k,2303) = lu(k,2303) - lu(k,841) * lu(k,2263) + lu(k,2305) = lu(k,2305) - lu(k,842) * lu(k,2263) + lu(k,2306) = lu(k,2306) - lu(k,843) * lu(k,2263) + lu(k,2311) = lu(k,2311) - lu(k,844) * lu(k,2263) + lu(k,2313) = lu(k,2313) - lu(k,845) * lu(k,2263) + lu(k,846) = 1._r8 / lu(k,846) + lu(k,847) = lu(k,847) * lu(k,846) + lu(k,848) = lu(k,848) * lu(k,846) + lu(k,849) = lu(k,849) * lu(k,846) + lu(k,850) = lu(k,850) * lu(k,846) + lu(k,851) = lu(k,851) * lu(k,846) + lu(k,852) = lu(k,852) * lu(k,846) + lu(k,853) = lu(k,853) * lu(k,846) + lu(k,1462) = lu(k,1462) - lu(k,847) * lu(k,1460) + lu(k,1463) = - lu(k,848) * lu(k,1460) + lu(k,1465) = - lu(k,849) * lu(k,1460) + lu(k,1466) = - lu(k,850) * lu(k,1460) + lu(k,1467) = - lu(k,851) * lu(k,1460) + lu(k,1468) = lu(k,1468) - lu(k,852) * lu(k,1460) + lu(k,1471) = - lu(k,853) * lu(k,1460) + lu(k,1528) = lu(k,1528) - lu(k,847) * lu(k,1524) + lu(k,1531) = lu(k,1531) - lu(k,848) * lu(k,1524) + lu(k,1534) = lu(k,1534) - lu(k,849) * lu(k,1524) + lu(k,1535) = - lu(k,850) * lu(k,1524) + lu(k,1536) = lu(k,1536) - lu(k,851) * lu(k,1524) + lu(k,1537) = - lu(k,852) * lu(k,1524) + lu(k,1545) = lu(k,1545) - lu(k,853) * lu(k,1524) + lu(k,1602) = lu(k,1602) - lu(k,847) * lu(k,1595) + lu(k,1605) = lu(k,1605) - lu(k,848) * lu(k,1595) + lu(k,1608) = lu(k,1608) - lu(k,849) * lu(k,1595) + lu(k,1609) = - lu(k,850) * lu(k,1595) + lu(k,1610) = lu(k,1610) - lu(k,851) * lu(k,1595) + lu(k,1611) = lu(k,1611) - lu(k,852) * lu(k,1595) + lu(k,1620) = lu(k,1620) - lu(k,853) * lu(k,1595) + lu(k,1643) = lu(k,1643) - lu(k,847) * lu(k,1640) + lu(k,1646) = lu(k,1646) - lu(k,848) * lu(k,1640) + lu(k,1649) = lu(k,1649) - lu(k,849) * lu(k,1640) + lu(k,1650) = lu(k,1650) - lu(k,850) * lu(k,1640) + lu(k,1651) = lu(k,1651) - lu(k,851) * lu(k,1640) + lu(k,1652) = lu(k,1652) - lu(k,852) * lu(k,1640) + lu(k,1661) = lu(k,1661) - lu(k,853) * lu(k,1640) + lu(k,1815) = lu(k,1815) - lu(k,847) * lu(k,1774) + lu(k,1818) = lu(k,1818) - lu(k,848) * lu(k,1774) + lu(k,1821) = lu(k,1821) - lu(k,849) * lu(k,1774) + lu(k,1822) = lu(k,1822) - lu(k,850) * lu(k,1774) + lu(k,1823) = lu(k,1823) - lu(k,851) * lu(k,1774) + lu(k,1824) = lu(k,1824) - lu(k,852) * lu(k,1774) + lu(k,1833) = lu(k,1833) - lu(k,853) * lu(k,1774) + lu(k,2295) = lu(k,2295) - lu(k,847) * lu(k,2264) + lu(k,2298) = lu(k,2298) - lu(k,848) * lu(k,2264) + lu(k,2301) = lu(k,2301) - lu(k,849) * lu(k,2264) + lu(k,2302) = - lu(k,850) * lu(k,2264) + lu(k,2303) = lu(k,2303) - lu(k,851) * lu(k,2264) + lu(k,2304) = lu(k,2304) - lu(k,852) * lu(k,2264) + lu(k,2313) = lu(k,2313) - lu(k,853) * lu(k,2264) + 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,855) = 1._r8 / lu(k,855) + lu(k,856) = lu(k,856) * lu(k,855) + lu(k,857) = lu(k,857) * lu(k,855) + lu(k,858) = lu(k,858) * lu(k,855) + lu(k,859) = lu(k,859) * lu(k,855) + lu(k,860) = lu(k,860) * lu(k,855) + lu(k,861) = lu(k,861) * lu(k,855) + lu(k,975) = lu(k,975) - lu(k,856) * lu(k,971) + lu(k,976) = lu(k,976) - lu(k,857) * lu(k,971) + lu(k,977) = lu(k,977) - lu(k,858) * lu(k,971) + lu(k,979) = lu(k,979) - lu(k,859) * lu(k,971) + lu(k,980) = lu(k,980) - lu(k,860) * lu(k,971) + lu(k,981) = - lu(k,861) * lu(k,971) + lu(k,1608) = lu(k,1608) - lu(k,856) * lu(k,1596) + lu(k,1610) = lu(k,1610) - lu(k,857) * lu(k,1596) + lu(k,1614) = lu(k,1614) - lu(k,858) * lu(k,1596) + lu(k,1616) = lu(k,1616) - lu(k,859) * lu(k,1596) + lu(k,1619) = lu(k,1619) - lu(k,860) * lu(k,1596) + lu(k,1620) = lu(k,1620) - lu(k,861) * lu(k,1596) + lu(k,1821) = lu(k,1821) - lu(k,856) * lu(k,1775) + lu(k,1823) = lu(k,1823) - lu(k,857) * lu(k,1775) + lu(k,1827) = lu(k,1827) - lu(k,858) * lu(k,1775) + lu(k,1829) = lu(k,1829) - lu(k,859) * lu(k,1775) + lu(k,1832) = lu(k,1832) - lu(k,860) * lu(k,1775) + lu(k,1833) = lu(k,1833) - lu(k,861) * lu(k,1775) + lu(k,2023) = lu(k,2023) - lu(k,856) * lu(k,2016) + lu(k,2025) = lu(k,2025) - lu(k,857) * lu(k,2016) + lu(k,2029) = lu(k,2029) - lu(k,858) * lu(k,2016) + lu(k,2031) = lu(k,2031) - lu(k,859) * lu(k,2016) + lu(k,2034) = lu(k,2034) - lu(k,860) * lu(k,2016) + lu(k,2035) = lu(k,2035) - lu(k,861) * lu(k,2016) + lu(k,2121) = lu(k,2121) - lu(k,856) * lu(k,2105) + lu(k,2123) = lu(k,2123) - lu(k,857) * lu(k,2105) + lu(k,2127) = lu(k,2127) - lu(k,858) * lu(k,2105) + lu(k,2129) = lu(k,2129) - lu(k,859) * lu(k,2105) + lu(k,2132) = lu(k,2132) - lu(k,860) * lu(k,2105) + lu(k,2133) = lu(k,2133) - lu(k,861) * lu(k,2105) + lu(k,2301) = lu(k,2301) - lu(k,856) * lu(k,2265) + lu(k,2303) = lu(k,2303) - lu(k,857) * lu(k,2265) + lu(k,2307) = lu(k,2307) - lu(k,858) * lu(k,2265) + lu(k,2309) = lu(k,2309) - lu(k,859) * lu(k,2265) + lu(k,2312) = lu(k,2312) - lu(k,860) * lu(k,2265) + lu(k,2313) = lu(k,2313) - lu(k,861) * lu(k,2265) + lu(k,2327) = lu(k,2327) - lu(k,856) * lu(k,2318) + lu(k,2329) = lu(k,2329) - lu(k,857) * lu(k,2318) + lu(k,2333) = lu(k,2333) - lu(k,858) * lu(k,2318) + lu(k,2335) = lu(k,2335) - lu(k,859) * lu(k,2318) + lu(k,2338) = lu(k,2338) - lu(k,860) * lu(k,2318) + lu(k,2339) = - lu(k,861) * lu(k,2318) + lu(k,865) = 1._r8 / lu(k,865) + lu(k,866) = lu(k,866) * lu(k,865) + lu(k,867) = lu(k,867) * lu(k,865) + lu(k,868) = lu(k,868) * lu(k,865) + lu(k,869) = lu(k,869) * lu(k,865) + lu(k,870) = lu(k,870) * lu(k,865) + lu(k,871) = lu(k,871) * lu(k,865) + lu(k,872) = lu(k,872) * lu(k,865) + lu(k,962) = lu(k,962) - lu(k,866) * lu(k,959) + lu(k,964) = lu(k,964) - lu(k,867) * lu(k,959) + lu(k,965) = lu(k,965) - lu(k,868) * lu(k,959) + lu(k,966) = lu(k,966) - lu(k,869) * lu(k,959) + lu(k,967) = lu(k,967) - lu(k,870) * lu(k,959) + lu(k,968) = - lu(k,871) * lu(k,959) + lu(k,969) = lu(k,969) - lu(k,872) * lu(k,959) + lu(k,1793) = lu(k,1793) - lu(k,866) * lu(k,1776) + lu(k,1819) = lu(k,1819) - lu(k,867) * lu(k,1776) + lu(k,1820) = lu(k,1820) - lu(k,868) * lu(k,1776) + lu(k,1823) = lu(k,1823) - lu(k,869) * lu(k,1776) + lu(k,1825) = lu(k,1825) - lu(k,870) * lu(k,1776) + lu(k,1826) = lu(k,1826) - lu(k,871) * lu(k,1776) + lu(k,1831) = lu(k,1831) - lu(k,872) * lu(k,1776) + lu(k,1922) = lu(k,1922) - lu(k,866) * lu(k,1912) + lu(k,1946) = lu(k,1946) - lu(k,867) * lu(k,1912) + lu(k,1947) = lu(k,1947) - lu(k,868) * lu(k,1912) + lu(k,1950) = lu(k,1950) - lu(k,869) * lu(k,1912) + lu(k,1952) = lu(k,1952) - lu(k,870) * lu(k,1912) + lu(k,1953) = lu(k,1953) - lu(k,871) * lu(k,1912) + lu(k,1958) = lu(k,1958) - lu(k,872) * lu(k,1912) + lu(k,1976) = lu(k,1976) - lu(k,866) * lu(k,1969) + lu(k,1998) = lu(k,1998) - lu(k,867) * lu(k,1969) + lu(k,1999) = lu(k,1999) - lu(k,868) * lu(k,1969) + lu(k,2002) = lu(k,2002) - lu(k,869) * lu(k,1969) + lu(k,2004) = lu(k,2004) - lu(k,870) * lu(k,1969) + lu(k,2005) = lu(k,2005) - lu(k,871) * lu(k,1969) + lu(k,2010) = lu(k,2010) - lu(k,872) * lu(k,1969) + lu(k,2110) = - lu(k,866) * lu(k,2106) + lu(k,2119) = lu(k,2119) - lu(k,867) * lu(k,2106) + lu(k,2120) = lu(k,2120) - lu(k,868) * lu(k,2106) + lu(k,2123) = lu(k,2123) - lu(k,869) * lu(k,2106) + lu(k,2125) = lu(k,2125) - lu(k,870) * lu(k,2106) + lu(k,2126) = lu(k,2126) - lu(k,871) * lu(k,2106) + lu(k,2131) = lu(k,2131) - lu(k,872) * lu(k,2106) + lu(k,2275) = lu(k,2275) - lu(k,866) * lu(k,2266) + lu(k,2299) = lu(k,2299) - lu(k,867) * lu(k,2266) + lu(k,2300) = lu(k,2300) - lu(k,868) * lu(k,2266) + lu(k,2303) = lu(k,2303) - lu(k,869) * lu(k,2266) + lu(k,2305) = lu(k,2305) - lu(k,870) * lu(k,2266) + lu(k,2306) = lu(k,2306) - lu(k,871) * lu(k,2266) + lu(k,2311) = lu(k,2311) - lu(k,872) * lu(k,2266) + lu(k,873) = 1._r8 / lu(k,873) + lu(k,874) = lu(k,874) * lu(k,873) + lu(k,875) = lu(k,875) * lu(k,873) + lu(k,944) = lu(k,944) - lu(k,874) * lu(k,935) + lu(k,950) = - lu(k,875) * lu(k,935) + lu(k,990) = - lu(k,874) * lu(k,988) + lu(k,991) = - lu(k,875) * lu(k,988) + lu(k,998) = lu(k,998) - lu(k,874) * lu(k,996) + lu(k,999) = - lu(k,875) * lu(k,996) + lu(k,1020) = lu(k,1020) - lu(k,874) * lu(k,1010) + lu(k,1027) = - lu(k,875) * lu(k,1010) + lu(k,1050) = lu(k,1050) - lu(k,874) * lu(k,1045) + lu(k,1057) = - lu(k,875) * lu(k,1045) + lu(k,1093) = lu(k,1093) - lu(k,874) * lu(k,1090) + lu(k,1095) = - lu(k,875) * lu(k,1090) + lu(k,1117) = lu(k,1117) - lu(k,874) * lu(k,1114) + lu(k,1121) = - lu(k,875) * lu(k,1114) + lu(k,1127) = lu(k,1127) - lu(k,874) * lu(k,1126) + lu(k,1128) = - lu(k,875) * lu(k,1126) + lu(k,1162) = lu(k,1162) - lu(k,874) * lu(k,1158) + lu(k,1169) = - lu(k,875) * lu(k,1158) + lu(k,1215) = lu(k,1215) - lu(k,874) * lu(k,1212) + lu(k,1222) = - lu(k,875) * lu(k,1212) + lu(k,1294) = - lu(k,874) * lu(k,1292) + lu(k,1309) = - lu(k,875) * lu(k,1292) + lu(k,1375) = lu(k,1375) - lu(k,874) * lu(k,1371) + lu(k,1386) = - lu(k,875) * lu(k,1371) + lu(k,1398) = - lu(k,874) * lu(k,1397) + lu(k,1406) = - lu(k,875) * lu(k,1397) + lu(k,1422) = lu(k,1422) - lu(k,874) * lu(k,1418) + lu(k,1438) = - lu(k,875) * lu(k,1418) + lu(k,1475) = lu(k,1475) - lu(k,874) * lu(k,1473) + lu(k,1481) = lu(k,1481) - lu(k,875) * lu(k,1473) + lu(k,1565) = lu(k,1565) - lu(k,874) * lu(k,1560) + lu(k,1577) = lu(k,1577) - lu(k,875) * lu(k,1560) + lu(k,1797) = lu(k,1797) - lu(k,874) * lu(k,1777) + lu(k,1821) = lu(k,1821) - lu(k,875) * lu(k,1777) + lu(k,1926) = lu(k,1926) - lu(k,874) * lu(k,1913) + lu(k,1948) = lu(k,1948) - lu(k,875) * lu(k,1913) + lu(k,1980) = lu(k,1980) - lu(k,874) * lu(k,1970) + lu(k,2000) = - lu(k,875) * lu(k,1970) + lu(k,2162) = lu(k,2162) - lu(k,874) * lu(k,2147) + lu(k,2183) = lu(k,2183) - lu(k,875) * lu(k,2147) + lu(k,2279) = lu(k,2279) - lu(k,874) * lu(k,2267) + lu(k,2301) = lu(k,2301) - lu(k,875) * lu(k,2267) + lu(k,879) = 1._r8 / lu(k,879) + lu(k,880) = lu(k,880) * lu(k,879) + lu(k,881) = lu(k,881) * lu(k,879) + lu(k,882) = lu(k,882) * lu(k,879) + lu(k,883) = lu(k,883) * lu(k,879) + lu(k,884) = lu(k,884) * lu(k,879) + lu(k,885) = lu(k,885) * lu(k,879) + lu(k,886) = lu(k,886) * lu(k,879) + lu(k,887) = lu(k,887) * lu(k,879) + lu(k,888) = lu(k,888) * lu(k,879) + lu(k,889) = lu(k,889) * lu(k,879) + lu(k,890) = lu(k,890) * lu(k,879) + lu(k,891) = lu(k,891) * lu(k,879) + lu(k,892) = lu(k,892) * lu(k,879) + lu(k,893) = lu(k,893) * lu(k,879) + lu(k,894) = lu(k,894) * lu(k,879) + lu(k,1787) = lu(k,1787) - lu(k,880) * lu(k,1778) + lu(k,1791) = lu(k,1791) - lu(k,881) * lu(k,1778) + lu(k,1797) = lu(k,1797) - lu(k,882) * lu(k,1778) + lu(k,1804) = - lu(k,883) * lu(k,1778) + lu(k,1805) = lu(k,1805) - lu(k,884) * lu(k,1778) + lu(k,1808) = lu(k,1808) - lu(k,885) * lu(k,1778) + lu(k,1809) = lu(k,1809) - lu(k,886) * lu(k,1778) + lu(k,1811) = lu(k,1811) - lu(k,887) * lu(k,1778) + lu(k,1813) = lu(k,1813) - lu(k,888) * lu(k,1778) + lu(k,1819) = lu(k,1819) - lu(k,889) * lu(k,1778) + lu(k,1823) = lu(k,1823) - lu(k,890) * lu(k,1778) + lu(k,1826) = lu(k,1826) - lu(k,891) * lu(k,1778) + lu(k,1828) = lu(k,1828) - lu(k,892) * lu(k,1778) + lu(k,1830) = lu(k,1830) - lu(k,893) * lu(k,1778) + lu(k,1831) = lu(k,1831) - lu(k,894) * lu(k,1778) + lu(k,2049) = - lu(k,880) * lu(k,2043) + lu(k,2053) = lu(k,2053) - lu(k,881) * lu(k,2043) + lu(k,2059) = lu(k,2059) - lu(k,882) * lu(k,2043) + lu(k,2066) = lu(k,2066) - lu(k,883) * lu(k,2043) + lu(k,2067) = lu(k,2067) - lu(k,884) * lu(k,2043) + lu(k,2070) = lu(k,2070) - lu(k,885) * lu(k,2043) + lu(k,2071) = lu(k,2071) - lu(k,886) * lu(k,2043) + lu(k,2073) = lu(k,2073) - lu(k,887) * lu(k,2043) + lu(k,2075) = lu(k,2075) - lu(k,888) * lu(k,2043) + lu(k,2080) = lu(k,2080) - lu(k,889) * lu(k,2043) + lu(k,2084) = lu(k,2084) - lu(k,890) * lu(k,2043) + lu(k,2087) = - lu(k,891) * lu(k,2043) + lu(k,2089) = lu(k,2089) - lu(k,892) * lu(k,2043) + lu(k,2091) = - lu(k,893) * lu(k,2043) + lu(k,2092) = lu(k,2092) - lu(k,894) * lu(k,2043) + lu(k,2153) = lu(k,2153) - lu(k,880) * lu(k,2148) + lu(k,2157) = lu(k,2157) - lu(k,881) * lu(k,2148) + lu(k,2162) = lu(k,2162) - lu(k,882) * lu(k,2148) + lu(k,2167) = - lu(k,883) * lu(k,2148) + lu(k,2168) = lu(k,2168) - lu(k,884) * lu(k,2148) + lu(k,2171) = - lu(k,885) * lu(k,2148) + lu(k,2172) = - lu(k,886) * lu(k,2148) + lu(k,2174) = lu(k,2174) - lu(k,887) * lu(k,2148) + lu(k,2176) = lu(k,2176) - lu(k,888) * lu(k,2148) + lu(k,2181) = lu(k,2181) - lu(k,889) * lu(k,2148) + lu(k,2185) = lu(k,2185) - lu(k,890) * lu(k,2148) + lu(k,2188) = lu(k,2188) - lu(k,891) * lu(k,2148) + lu(k,2190) = lu(k,2190) - lu(k,892) * lu(k,2148) + lu(k,2192) = lu(k,2192) - lu(k,893) * lu(k,2148) + lu(k,2193) = lu(k,2193) - lu(k,894) * lu(k,2148) + end do + end subroutine lu_fac18 + subroutine lu_fac19( 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,895) = 1._r8 / lu(k,895) + lu(k,896) = lu(k,896) * lu(k,895) + lu(k,897) = lu(k,897) * lu(k,895) + lu(k,898) = lu(k,898) * lu(k,895) + lu(k,899) = lu(k,899) * lu(k,895) + lu(k,900) = lu(k,900) * lu(k,895) + lu(k,1052) = - lu(k,896) * lu(k,1046) + lu(k,1053) = - lu(k,897) * lu(k,1046) + lu(k,1055) = lu(k,1055) - lu(k,898) * lu(k,1046) + lu(k,1056) = lu(k,1056) - lu(k,899) * lu(k,1046) + lu(k,1058) = lu(k,1058) - lu(k,900) * lu(k,1046) + lu(k,1071) = - lu(k,896) * lu(k,1066) + lu(k,1072) = - lu(k,897) * lu(k,1066) + lu(k,1074) = - lu(k,898) * lu(k,1066) + lu(k,1075) = lu(k,1075) - lu(k,899) * lu(k,1066) + lu(k,1077) = lu(k,1077) - lu(k,900) * lu(k,1066) + lu(k,1239) = - lu(k,896) * lu(k,1232) + lu(k,1241) = lu(k,1241) - lu(k,897) * lu(k,1232) + lu(k,1243) = lu(k,1243) - lu(k,898) * lu(k,1232) + lu(k,1244) = lu(k,1244) - lu(k,899) * lu(k,1232) + lu(k,1246) = lu(k,1246) - lu(k,900) * lu(k,1232) + lu(k,1333) = lu(k,1333) - lu(k,896) * lu(k,1323) + lu(k,1338) = lu(k,1338) - lu(k,897) * lu(k,1323) + lu(k,1340) = lu(k,1340) - lu(k,898) * lu(k,1323) + lu(k,1341) = lu(k,1341) - lu(k,899) * lu(k,1323) + lu(k,1343) = lu(k,1343) - lu(k,900) * lu(k,1323) + lu(k,1806) = lu(k,1806) - lu(k,896) * lu(k,1779) + lu(k,1813) = lu(k,1813) - lu(k,897) * lu(k,1779) + lu(k,1819) = lu(k,1819) - lu(k,898) * lu(k,1779) + lu(k,1820) = lu(k,1820) - lu(k,899) * lu(k,1779) + lu(k,1823) = lu(k,1823) - lu(k,900) * lu(k,1779) + lu(k,1935) = lu(k,1935) - lu(k,896) * lu(k,1914) + lu(k,1941) = lu(k,1941) - lu(k,897) * lu(k,1914) + lu(k,1946) = lu(k,1946) - lu(k,898) * lu(k,1914) + lu(k,1947) = lu(k,1947) - lu(k,899) * lu(k,1914) + lu(k,1950) = lu(k,1950) - lu(k,900) * lu(k,1914) + lu(k,1988) = lu(k,1988) - lu(k,896) * lu(k,1971) + lu(k,1994) = lu(k,1994) - lu(k,897) * lu(k,1971) + lu(k,1998) = lu(k,1998) - lu(k,898) * lu(k,1971) + lu(k,1999) = lu(k,1999) - lu(k,899) * lu(k,1971) + lu(k,2002) = lu(k,2002) - lu(k,900) * lu(k,1971) + lu(k,2068) = lu(k,2068) - lu(k,896) * lu(k,2044) + lu(k,2075) = lu(k,2075) - lu(k,897) * lu(k,2044) + lu(k,2080) = lu(k,2080) - lu(k,898) * lu(k,2044) + lu(k,2081) = lu(k,2081) - lu(k,899) * lu(k,2044) + lu(k,2084) = lu(k,2084) - lu(k,900) * lu(k,2044) + lu(k,2287) = lu(k,2287) - lu(k,896) * lu(k,2268) + lu(k,2293) = lu(k,2293) - lu(k,897) * lu(k,2268) + lu(k,2299) = lu(k,2299) - lu(k,898) * lu(k,2268) + lu(k,2300) = lu(k,2300) - lu(k,899) * lu(k,2268) + lu(k,2303) = lu(k,2303) - lu(k,900) * lu(k,2268) + lu(k,902) = 1._r8 / lu(k,902) + lu(k,903) = lu(k,903) * lu(k,902) + lu(k,904) = lu(k,904) * lu(k,902) + lu(k,905) = lu(k,905) * lu(k,902) + lu(k,906) = lu(k,906) * lu(k,902) + lu(k,907) = lu(k,907) * lu(k,902) + lu(k,1276) = lu(k,1276) - lu(k,903) * lu(k,1275) + lu(k,1280) = lu(k,1280) - lu(k,904) * lu(k,1275) + lu(k,1281) = lu(k,1281) - lu(k,905) * lu(k,1275) + lu(k,1286) = - lu(k,906) * lu(k,1275) + lu(k,1288) = - lu(k,907) * lu(k,1275) + lu(k,1568) = lu(k,1568) - lu(k,903) * lu(k,1561) + lu(k,1577) = lu(k,1577) - lu(k,904) * lu(k,1561) + lu(k,1579) = lu(k,1579) - lu(k,905) * lu(k,1561) + lu(k,1587) = lu(k,1587) - lu(k,906) * lu(k,1561) + lu(k,1589) = lu(k,1589) - lu(k,907) * lu(k,1561) + lu(k,1600) = lu(k,1600) - lu(k,903) * lu(k,1597) + lu(k,1608) = lu(k,1608) - lu(k,904) * lu(k,1597) + lu(k,1610) = lu(k,1610) - lu(k,905) * lu(k,1597) + lu(k,1618) = lu(k,1618) - lu(k,906) * lu(k,1597) + lu(k,1620) = lu(k,1620) - lu(k,907) * lu(k,1597) + lu(k,1807) = lu(k,1807) - lu(k,903) * lu(k,1780) + lu(k,1821) = lu(k,1821) - lu(k,904) * lu(k,1780) + lu(k,1823) = lu(k,1823) - lu(k,905) * lu(k,1780) + lu(k,1831) = lu(k,1831) - lu(k,906) * lu(k,1780) + lu(k,1833) = lu(k,1833) - lu(k,907) * lu(k,1780) + lu(k,1839) = lu(k,1839) - lu(k,903) * lu(k,1838) + lu(k,1845) = lu(k,1845) - lu(k,904) * lu(k,1838) + lu(k,1847) = lu(k,1847) - lu(k,905) * lu(k,1838) + lu(k,1855) = lu(k,1855) - lu(k,906) * lu(k,1838) + lu(k,1857) = lu(k,1857) - lu(k,907) * lu(k,1838) + lu(k,2069) = - lu(k,903) * lu(k,2045) + lu(k,2082) = lu(k,2082) - lu(k,904) * lu(k,2045) + lu(k,2084) = lu(k,2084) - lu(k,905) * lu(k,2045) + lu(k,2092) = lu(k,2092) - lu(k,906) * lu(k,2045) + lu(k,2094) = - lu(k,907) * lu(k,2045) + lu(k,2170) = lu(k,2170) - lu(k,903) * lu(k,2149) + lu(k,2183) = lu(k,2183) - lu(k,904) * lu(k,2149) + lu(k,2185) = lu(k,2185) - lu(k,905) * lu(k,2149) + lu(k,2193) = lu(k,2193) - lu(k,906) * lu(k,2149) + lu(k,2195) = lu(k,2195) - lu(k,907) * lu(k,2149) + lu(k,2321) = lu(k,2321) - lu(k,903) * lu(k,2319) + lu(k,2327) = lu(k,2327) - lu(k,904) * lu(k,2319) + lu(k,2329) = lu(k,2329) - lu(k,905) * lu(k,2319) + lu(k,2337) = lu(k,2337) - lu(k,906) * lu(k,2319) + lu(k,2339) = lu(k,2339) - lu(k,907) * lu(k,2319) + lu(k,2345) = - lu(k,903) * lu(k,2343) + lu(k,2353) = lu(k,2353) - lu(k,904) * lu(k,2343) + lu(k,2355) = lu(k,2355) - lu(k,905) * lu(k,2343) + lu(k,2363) = - lu(k,906) * lu(k,2343) + lu(k,2365) = lu(k,2365) - lu(k,907) * lu(k,2343) + lu(k,909) = 1._r8 / lu(k,909) + lu(k,910) = lu(k,910) * lu(k,909) + lu(k,911) = lu(k,911) * lu(k,909) + lu(k,912) = lu(k,912) * lu(k,909) + lu(k,913) = lu(k,913) * lu(k,909) + lu(k,914) = lu(k,914) * lu(k,909) + lu(k,915) = lu(k,915) * lu(k,909) + lu(k,916) = lu(k,916) * lu(k,909) + lu(k,917) = lu(k,917) * lu(k,909) + lu(k,1448) = lu(k,1448) - lu(k,910) * lu(k,1447) + lu(k,1449) = - lu(k,911) * lu(k,1447) + lu(k,1450) = - lu(k,912) * lu(k,1447) + lu(k,1451) = lu(k,1451) - lu(k,913) * lu(k,1447) + lu(k,1454) = lu(k,1454) - lu(k,914) * lu(k,1447) + lu(k,1455) = - lu(k,915) * lu(k,1447) + lu(k,1457) = - lu(k,916) * lu(k,1447) + lu(k,1459) = lu(k,1459) - lu(k,917) * lu(k,1447) + lu(k,1476) = lu(k,1476) - lu(k,910) * lu(k,1474) + lu(k,1477) = lu(k,1477) - lu(k,911) * lu(k,1474) + lu(k,1478) = - lu(k,912) * lu(k,1474) + lu(k,1479) = lu(k,1479) - lu(k,913) * lu(k,1474) + lu(k,1483) = lu(k,1483) - lu(k,914) * lu(k,1474) + lu(k,1484) = lu(k,1484) - lu(k,915) * lu(k,1474) + lu(k,1486) = - lu(k,916) * lu(k,1474) + lu(k,1489) = lu(k,1489) - lu(k,917) * lu(k,1474) + lu(k,1492) = - lu(k,910) * lu(k,1491) + lu(k,1493) = - lu(k,911) * lu(k,1491) + lu(k,1494) = lu(k,1494) - lu(k,912) * lu(k,1491) + lu(k,1495) = lu(k,1495) - lu(k,913) * lu(k,1491) + lu(k,1500) = lu(k,1500) - lu(k,914) * lu(k,1491) + lu(k,1501) = - lu(k,915) * lu(k,1491) + lu(k,1503) = lu(k,1503) - lu(k,916) * lu(k,1491) + lu(k,1506) = lu(k,1506) - lu(k,917) * lu(k,1491) + lu(k,1642) = lu(k,1642) - lu(k,910) * lu(k,1641) + lu(k,1644) = lu(k,1644) - lu(k,911) * lu(k,1641) + lu(k,1645) = - lu(k,912) * lu(k,1641) + lu(k,1646) = lu(k,1646) - lu(k,913) * lu(k,1641) + lu(k,1651) = lu(k,1651) - lu(k,914) * lu(k,1641) + lu(k,1654) = lu(k,1654) - lu(k,915) * lu(k,1641) + lu(k,1656) = - lu(k,916) * lu(k,1641) + lu(k,1661) = lu(k,1661) - lu(k,917) * lu(k,1641) + lu(k,1814) = lu(k,1814) - lu(k,910) * lu(k,1781) + lu(k,1816) = lu(k,1816) - lu(k,911) * lu(k,1781) + lu(k,1817) = lu(k,1817) - lu(k,912) * lu(k,1781) + lu(k,1818) = lu(k,1818) - lu(k,913) * lu(k,1781) + lu(k,1823) = lu(k,1823) - lu(k,914) * lu(k,1781) + lu(k,1826) = lu(k,1826) - lu(k,915) * lu(k,1781) + lu(k,1828) = lu(k,1828) - lu(k,916) * lu(k,1781) + lu(k,1833) = lu(k,1833) - lu(k,917) * lu(k,1781) + lu(k,2346) = lu(k,2346) - lu(k,910) * lu(k,2344) + lu(k,2348) = - lu(k,911) * lu(k,2344) + lu(k,2349) = - lu(k,912) * lu(k,2344) + lu(k,2350) = lu(k,2350) - lu(k,913) * lu(k,2344) + lu(k,2355) = lu(k,2355) - lu(k,914) * lu(k,2344) + lu(k,2358) = - lu(k,915) * lu(k,2344) + lu(k,2360) = - lu(k,916) * lu(k,2344) + lu(k,2365) = lu(k,2365) - lu(k,917) * lu(k,2344) + lu(k,918) = 1._r8 / lu(k,918) + lu(k,919) = lu(k,919) * lu(k,918) + lu(k,920) = lu(k,920) * lu(k,918) + lu(k,921) = lu(k,921) * lu(k,918) + lu(k,922) = lu(k,922) * lu(k,918) + lu(k,923) = lu(k,923) * lu(k,918) + lu(k,924) = lu(k,924) * lu(k,918) + lu(k,925) = lu(k,925) * lu(k,918) + lu(k,926) = lu(k,926) * lu(k,918) + lu(k,1068) = lu(k,1068) - lu(k,919) * lu(k,1067) + lu(k,1070) = lu(k,1070) - lu(k,920) * lu(k,1067) + lu(k,1071) = lu(k,1071) - lu(k,921) * lu(k,1067) + lu(k,1075) = lu(k,1075) - lu(k,922) * lu(k,1067) + lu(k,1077) = lu(k,1077) - lu(k,923) * lu(k,1067) + lu(k,1078) = - lu(k,924) * lu(k,1067) + lu(k,1079) = - lu(k,925) * lu(k,1067) + lu(k,1080) = lu(k,1080) - lu(k,926) * lu(k,1067) + lu(k,1325) = lu(k,1325) - lu(k,919) * lu(k,1324) + lu(k,1327) = lu(k,1327) - lu(k,920) * lu(k,1324) + lu(k,1333) = lu(k,1333) - lu(k,921) * lu(k,1324) + lu(k,1341) = lu(k,1341) - lu(k,922) * lu(k,1324) + lu(k,1343) = lu(k,1343) - lu(k,923) * lu(k,1324) + lu(k,1344) = lu(k,1344) - lu(k,924) * lu(k,1324) + lu(k,1345) = lu(k,1345) - lu(k,925) * lu(k,1324) + lu(k,1348) = lu(k,1348) - lu(k,926) * lu(k,1324) + lu(k,1564) = lu(k,1564) - lu(k,919) * lu(k,1562) + lu(k,1565) = lu(k,1565) - lu(k,920) * lu(k,1562) + lu(k,1567) = lu(k,1567) - lu(k,921) * lu(k,1562) + lu(k,1576) = lu(k,1576) - lu(k,922) * lu(k,1562) + lu(k,1579) = lu(k,1579) - lu(k,923) * lu(k,1562) + lu(k,1581) = lu(k,1581) - lu(k,924) * lu(k,1562) + lu(k,1582) = lu(k,1582) - lu(k,925) * lu(k,1562) + lu(k,1587) = lu(k,1587) - lu(k,926) * lu(k,1562) + lu(k,1788) = lu(k,1788) - lu(k,919) * lu(k,1782) + lu(k,1797) = lu(k,1797) - lu(k,920) * lu(k,1782) + lu(k,1806) = lu(k,1806) - lu(k,921) * lu(k,1782) + lu(k,1820) = lu(k,1820) - lu(k,922) * lu(k,1782) + lu(k,1823) = lu(k,1823) - lu(k,923) * lu(k,1782) + lu(k,1825) = lu(k,1825) - lu(k,924) * lu(k,1782) + lu(k,1826) = lu(k,1826) - lu(k,925) * lu(k,1782) + lu(k,1831) = lu(k,1831) - lu(k,926) * lu(k,1782) + lu(k,1919) = lu(k,1919) - lu(k,919) * lu(k,1915) + lu(k,1926) = lu(k,1926) - lu(k,920) * lu(k,1915) + lu(k,1935) = lu(k,1935) - lu(k,921) * lu(k,1915) + lu(k,1947) = lu(k,1947) - lu(k,922) * lu(k,1915) + lu(k,1950) = lu(k,1950) - lu(k,923) * lu(k,1915) + lu(k,1952) = lu(k,1952) - lu(k,924) * lu(k,1915) + lu(k,1953) = lu(k,1953) - lu(k,925) * lu(k,1915) + lu(k,1958) = lu(k,1958) - lu(k,926) * lu(k,1915) + lu(k,2273) = lu(k,2273) - lu(k,919) * lu(k,2269) + lu(k,2279) = lu(k,2279) - lu(k,920) * lu(k,2269) + lu(k,2287) = lu(k,2287) - lu(k,921) * lu(k,2269) + lu(k,2300) = lu(k,2300) - lu(k,922) * lu(k,2269) + lu(k,2303) = lu(k,2303) - lu(k,923) * lu(k,2269) + lu(k,2305) = lu(k,2305) - lu(k,924) * lu(k,2269) + lu(k,2306) = lu(k,2306) - lu(k,925) * lu(k,2269) + lu(k,2311) = lu(k,2311) - lu(k,926) * lu(k,2269) + end do + end subroutine lu_fac19 + subroutine lu_fac20( 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,936) = 1._r8 / lu(k,936) + lu(k,937) = lu(k,937) * lu(k,936) + lu(k,938) = lu(k,938) * lu(k,936) + lu(k,939) = lu(k,939) * lu(k,936) + lu(k,940) = lu(k,940) * lu(k,936) + lu(k,941) = lu(k,941) * lu(k,936) + lu(k,942) = lu(k,942) * lu(k,936) + lu(k,943) = lu(k,943) * lu(k,936) + lu(k,944) = lu(k,944) * lu(k,936) + lu(k,945) = lu(k,945) * lu(k,936) + lu(k,946) = lu(k,946) * lu(k,936) + lu(k,947) = lu(k,947) * lu(k,936) + lu(k,948) = lu(k,948) * lu(k,936) + lu(k,949) = lu(k,949) * lu(k,936) + lu(k,950) = lu(k,950) * lu(k,936) + lu(k,951) = lu(k,951) * lu(k,936) + lu(k,952) = lu(k,952) * lu(k,936) + lu(k,953) = lu(k,953) * lu(k,936) + lu(k,954) = lu(k,954) * lu(k,936) + lu(k,1784) = lu(k,1784) - lu(k,937) * lu(k,1783) + lu(k,1786) = lu(k,1786) - lu(k,938) * lu(k,1783) + lu(k,1787) = lu(k,1787) - lu(k,939) * lu(k,1783) + lu(k,1788) = lu(k,1788) - lu(k,940) * lu(k,1783) + lu(k,1790) = lu(k,1790) - lu(k,941) * lu(k,1783) + lu(k,1795) = lu(k,1795) - lu(k,942) * lu(k,1783) + lu(k,1796) = lu(k,1796) - lu(k,943) * lu(k,1783) + lu(k,1797) = lu(k,1797) - lu(k,944) * lu(k,1783) + lu(k,1801) = lu(k,1801) - lu(k,945) * lu(k,1783) + lu(k,1802) = lu(k,1802) - lu(k,946) * lu(k,1783) + lu(k,1806) = lu(k,1806) - lu(k,947) * lu(k,1783) + lu(k,1813) = lu(k,1813) - lu(k,948) * lu(k,1783) + lu(k,1819) = lu(k,1819) - lu(k,949) * lu(k,1783) + lu(k,1821) = lu(k,1821) - lu(k,950) * lu(k,1783) + lu(k,1823) = lu(k,1823) - lu(k,951) * lu(k,1783) + lu(k,1828) = lu(k,1828) - lu(k,952) * lu(k,1783) + lu(k,1830) = lu(k,1830) - lu(k,953) * lu(k,1783) + lu(k,1831) = lu(k,1831) - lu(k,954) * lu(k,1783) + lu(k,2047) = - lu(k,937) * lu(k,2046) + lu(k,2048) = lu(k,2048) - lu(k,938) * lu(k,2046) + lu(k,2049) = lu(k,2049) - lu(k,939) * lu(k,2046) + lu(k,2050) = lu(k,2050) - lu(k,940) * lu(k,2046) + lu(k,2052) = lu(k,2052) - lu(k,941) * lu(k,2046) + lu(k,2057) = lu(k,2057) - lu(k,942) * lu(k,2046) + lu(k,2058) = - lu(k,943) * lu(k,2046) + lu(k,2059) = lu(k,2059) - lu(k,944) * lu(k,2046) + lu(k,2063) = - lu(k,945) * lu(k,2046) + lu(k,2064) = - lu(k,946) * lu(k,2046) + lu(k,2068) = lu(k,2068) - lu(k,947) * lu(k,2046) + lu(k,2075) = lu(k,2075) - lu(k,948) * lu(k,2046) + lu(k,2080) = lu(k,2080) - lu(k,949) * lu(k,2046) + lu(k,2082) = lu(k,2082) - lu(k,950) * lu(k,2046) + lu(k,2084) = lu(k,2084) - lu(k,951) * lu(k,2046) + lu(k,2089) = lu(k,2089) - lu(k,952) * lu(k,2046) + lu(k,2091) = lu(k,2091) - lu(k,953) * lu(k,2046) + lu(k,2092) = lu(k,2092) - lu(k,954) * lu(k,2046) + lu(k,2151) = lu(k,2151) - lu(k,937) * lu(k,2150) + lu(k,2152) = lu(k,2152) - lu(k,938) * lu(k,2150) + lu(k,2153) = lu(k,2153) - lu(k,939) * lu(k,2150) + lu(k,2154) = lu(k,2154) - lu(k,940) * lu(k,2150) + lu(k,2156) = lu(k,2156) - lu(k,941) * lu(k,2150) + lu(k,2160) = - lu(k,942) * lu(k,2150) + lu(k,2161) = lu(k,2161) - lu(k,943) * lu(k,2150) + lu(k,2162) = lu(k,2162) - lu(k,944) * lu(k,2150) + lu(k,2165) = - lu(k,945) * lu(k,2150) + lu(k,2166) = lu(k,2166) - lu(k,946) * lu(k,2150) + lu(k,2169) = lu(k,2169) - lu(k,947) * lu(k,2150) + lu(k,2176) = lu(k,2176) - lu(k,948) * lu(k,2150) + lu(k,2181) = lu(k,2181) - lu(k,949) * lu(k,2150) + lu(k,2183) = lu(k,2183) - lu(k,950) * lu(k,2150) + lu(k,2185) = lu(k,2185) - lu(k,951) * lu(k,2150) + lu(k,2190) = lu(k,2190) - lu(k,952) * lu(k,2150) + lu(k,2192) = lu(k,2192) - lu(k,953) * lu(k,2150) + lu(k,2193) = lu(k,2193) - lu(k,954) * lu(k,2150) + lu(k,960) = 1._r8 / lu(k,960) + lu(k,961) = lu(k,961) * lu(k,960) + lu(k,962) = lu(k,962) * lu(k,960) + lu(k,963) = lu(k,963) * lu(k,960) + lu(k,964) = lu(k,964) * lu(k,960) + lu(k,965) = lu(k,965) * lu(k,960) + lu(k,966) = lu(k,966) * lu(k,960) + lu(k,967) = lu(k,967) * lu(k,960) + lu(k,968) = lu(k,968) * lu(k,960) + lu(k,969) = lu(k,969) * lu(k,960) + lu(k,1012) = lu(k,1012) - lu(k,961) * lu(k,1011) + lu(k,1017) = - lu(k,962) * lu(k,1011) + lu(k,1024) = lu(k,1024) - lu(k,963) * lu(k,1011) + lu(k,1025) = lu(k,1025) - lu(k,964) * lu(k,1011) + lu(k,1026) = - lu(k,965) * lu(k,1011) + lu(k,1028) = lu(k,1028) - lu(k,966) * lu(k,1011) + lu(k,1029) = - lu(k,967) * lu(k,1011) + lu(k,1030) = - lu(k,968) * lu(k,1011) + lu(k,1033) = lu(k,1033) - lu(k,969) * lu(k,1011) + lu(k,1786) = lu(k,1786) - lu(k,961) * lu(k,1784) + lu(k,1793) = lu(k,1793) - lu(k,962) * lu(k,1784) + lu(k,1813) = lu(k,1813) - lu(k,963) * lu(k,1784) + lu(k,1819) = lu(k,1819) - lu(k,964) * lu(k,1784) + lu(k,1820) = lu(k,1820) - lu(k,965) * lu(k,1784) + lu(k,1823) = lu(k,1823) - lu(k,966) * lu(k,1784) + lu(k,1825) = lu(k,1825) - lu(k,967) * lu(k,1784) + lu(k,1826) = lu(k,1826) - lu(k,968) * lu(k,1784) + lu(k,1831) = lu(k,1831) - lu(k,969) * lu(k,1784) + lu(k,1917) = lu(k,1917) - lu(k,961) * lu(k,1916) + lu(k,1922) = lu(k,1922) - lu(k,962) * lu(k,1916) + lu(k,1941) = lu(k,1941) - lu(k,963) * lu(k,1916) + lu(k,1946) = lu(k,1946) - lu(k,964) * lu(k,1916) + lu(k,1947) = lu(k,1947) - lu(k,965) * lu(k,1916) + lu(k,1950) = lu(k,1950) - lu(k,966) * lu(k,1916) + lu(k,1952) = lu(k,1952) - lu(k,967) * lu(k,1916) + lu(k,1953) = lu(k,1953) - lu(k,968) * lu(k,1916) + lu(k,1958) = lu(k,1958) - lu(k,969) * lu(k,1916) + lu(k,2048) = lu(k,2048) - lu(k,961) * lu(k,2047) + lu(k,2055) = lu(k,2055) - lu(k,962) * lu(k,2047) + lu(k,2075) = lu(k,2075) - lu(k,963) * lu(k,2047) + lu(k,2080) = lu(k,2080) - lu(k,964) * lu(k,2047) + lu(k,2081) = lu(k,2081) - lu(k,965) * lu(k,2047) + lu(k,2084) = lu(k,2084) - lu(k,966) * lu(k,2047) + lu(k,2086) = lu(k,2086) - lu(k,967) * lu(k,2047) + lu(k,2087) = lu(k,2087) - lu(k,968) * lu(k,2047) + lu(k,2092) = lu(k,2092) - lu(k,969) * lu(k,2047) + lu(k,2152) = lu(k,2152) - lu(k,961) * lu(k,2151) + lu(k,2158) = lu(k,2158) - lu(k,962) * lu(k,2151) + lu(k,2176) = lu(k,2176) - lu(k,963) * lu(k,2151) + lu(k,2181) = lu(k,2181) - lu(k,964) * lu(k,2151) + lu(k,2182) = lu(k,2182) - lu(k,965) * lu(k,2151) + lu(k,2185) = lu(k,2185) - lu(k,966) * lu(k,2151) + lu(k,2187) = lu(k,2187) - lu(k,967) * lu(k,2151) + lu(k,2188) = lu(k,2188) - lu(k,968) * lu(k,2151) + lu(k,2193) = lu(k,2193) - lu(k,969) * lu(k,2151) + lu(k,2271) = lu(k,2271) - lu(k,961) * lu(k,2270) + lu(k,2275) = lu(k,2275) - lu(k,962) * lu(k,2270) + lu(k,2293) = lu(k,2293) - lu(k,963) * lu(k,2270) + lu(k,2299) = lu(k,2299) - lu(k,964) * lu(k,2270) + lu(k,2300) = lu(k,2300) - lu(k,965) * lu(k,2270) + lu(k,2303) = lu(k,2303) - lu(k,966) * lu(k,2270) + lu(k,2305) = lu(k,2305) - lu(k,967) * lu(k,2270) + lu(k,2306) = lu(k,2306) - lu(k,968) * lu(k,2270) + lu(k,2311) = lu(k,2311) - lu(k,969) * lu(k,2270) + lu(k,972) = 1._r8 / lu(k,972) + lu(k,973) = lu(k,973) * lu(k,972) + lu(k,974) = lu(k,974) * lu(k,972) + lu(k,975) = lu(k,975) * lu(k,972) + lu(k,976) = lu(k,976) * lu(k,972) + lu(k,977) = lu(k,977) * lu(k,972) + lu(k,978) = lu(k,978) * lu(k,972) + lu(k,979) = lu(k,979) * lu(k,972) + lu(k,980) = lu(k,980) * lu(k,972) + lu(k,981) = lu(k,981) * lu(k,972) + lu(k,1573) = lu(k,1573) - lu(k,973) * lu(k,1563) + lu(k,1576) = lu(k,1576) - lu(k,974) * lu(k,1563) + lu(k,1577) = lu(k,1577) - lu(k,975) * lu(k,1563) + lu(k,1579) = lu(k,1579) - lu(k,976) * lu(k,1563) + lu(k,1583) = lu(k,1583) - lu(k,977) * lu(k,1563) + lu(k,1584) = lu(k,1584) - lu(k,978) * lu(k,1563) + lu(k,1585) = lu(k,1585) - lu(k,979) * lu(k,1563) + lu(k,1588) = lu(k,1588) - lu(k,980) * lu(k,1563) + lu(k,1589) = lu(k,1589) - lu(k,981) * lu(k,1563) + lu(k,1604) = lu(k,1604) - lu(k,973) * lu(k,1598) + lu(k,1607) = lu(k,1607) - lu(k,974) * lu(k,1598) + lu(k,1608) = lu(k,1608) - lu(k,975) * lu(k,1598) + lu(k,1610) = lu(k,1610) - lu(k,976) * lu(k,1598) + lu(k,1614) = lu(k,1614) - lu(k,977) * lu(k,1598) + lu(k,1615) = lu(k,1615) - lu(k,978) * lu(k,1598) + lu(k,1616) = lu(k,1616) - lu(k,979) * lu(k,1598) + lu(k,1619) = lu(k,1619) - lu(k,980) * lu(k,1598) + lu(k,1620) = lu(k,1620) - lu(k,981) * lu(k,1598) + lu(k,1817) = lu(k,1817) - lu(k,973) * lu(k,1785) + lu(k,1820) = lu(k,1820) - lu(k,974) * lu(k,1785) + lu(k,1821) = lu(k,1821) - lu(k,975) * lu(k,1785) + lu(k,1823) = lu(k,1823) - lu(k,976) * lu(k,1785) + lu(k,1827) = lu(k,1827) - lu(k,977) * lu(k,1785) + lu(k,1828) = lu(k,1828) - lu(k,978) * lu(k,1785) + lu(k,1829) = lu(k,1829) - lu(k,979) * lu(k,1785) + lu(k,1832) = lu(k,1832) - lu(k,980) * lu(k,1785) + lu(k,1833) = lu(k,1833) - lu(k,981) * lu(k,1785) + lu(k,2019) = lu(k,2019) - lu(k,973) * lu(k,2017) + lu(k,2022) = - lu(k,974) * lu(k,2017) + lu(k,2023) = lu(k,2023) - lu(k,975) * lu(k,2017) + lu(k,2025) = lu(k,2025) - lu(k,976) * lu(k,2017) + lu(k,2029) = lu(k,2029) - lu(k,977) * lu(k,2017) + lu(k,2030) = - lu(k,978) * lu(k,2017) + lu(k,2031) = lu(k,2031) - lu(k,979) * lu(k,2017) + lu(k,2034) = lu(k,2034) - lu(k,980) * lu(k,2017) + lu(k,2035) = lu(k,2035) - lu(k,981) * lu(k,2017) + lu(k,2117) = - lu(k,973) * lu(k,2107) + lu(k,2120) = lu(k,2120) - lu(k,974) * lu(k,2107) + lu(k,2121) = lu(k,2121) - lu(k,975) * lu(k,2107) + lu(k,2123) = lu(k,2123) - lu(k,976) * lu(k,2107) + lu(k,2127) = lu(k,2127) - lu(k,977) * lu(k,2107) + lu(k,2128) = lu(k,2128) - lu(k,978) * lu(k,2107) + lu(k,2129) = lu(k,2129) - lu(k,979) * lu(k,2107) + lu(k,2132) = lu(k,2132) - lu(k,980) * lu(k,2107) + lu(k,2133) = lu(k,2133) - lu(k,981) * lu(k,2107) + lu(k,2323) = - lu(k,973) * lu(k,2320) + lu(k,2326) = lu(k,2326) - lu(k,974) * lu(k,2320) + lu(k,2327) = lu(k,2327) - lu(k,975) * lu(k,2320) + lu(k,2329) = lu(k,2329) - lu(k,976) * lu(k,2320) + lu(k,2333) = lu(k,2333) - lu(k,977) * lu(k,2320) + lu(k,2334) = - lu(k,978) * lu(k,2320) + lu(k,2335) = lu(k,2335) - lu(k,979) * lu(k,2320) + lu(k,2338) = lu(k,2338) - lu(k,980) * lu(k,2320) + lu(k,2339) = lu(k,2339) - lu(k,981) * lu(k,2320) + end do + end subroutine lu_fac20 + subroutine lu_fac21( 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,982) = 1._r8 / lu(k,982) + lu(k,983) = lu(k,983) * lu(k,982) + lu(k,984) = lu(k,984) * lu(k,982) + lu(k,985) = lu(k,985) * lu(k,982) + lu(k,986) = lu(k,986) * lu(k,982) + lu(k,987) = lu(k,987) * lu(k,982) + lu(k,1022) = lu(k,1022) - lu(k,983) * lu(k,1012) + lu(k,1024) = lu(k,1024) - lu(k,984) * lu(k,1012) + lu(k,1028) = lu(k,1028) - lu(k,985) * lu(k,1012) + lu(k,1030) = lu(k,1030) - lu(k,986) * lu(k,1012) + lu(k,1034) = - lu(k,987) * lu(k,1012) + lu(k,1118) = lu(k,1118) - lu(k,983) * lu(k,1115) + lu(k,1119) = lu(k,1119) - lu(k,984) * lu(k,1115) + lu(k,1122) = lu(k,1122) - lu(k,985) * lu(k,1115) + lu(k,1123) = - lu(k,986) * lu(k,1115) + lu(k,1125) = - lu(k,987) * lu(k,1115) + lu(k,1138) = - lu(k,983) * lu(k,1132) + lu(k,1139) = lu(k,1139) - lu(k,984) * lu(k,1132) + lu(k,1144) = lu(k,1144) - lu(k,985) * lu(k,1132) + lu(k,1145) = - lu(k,986) * lu(k,1132) + lu(k,1148) = - lu(k,987) * lu(k,1132) + lu(k,1164) = - lu(k,983) * lu(k,1159) + lu(k,1165) = - lu(k,984) * lu(k,1159) + lu(k,1170) = lu(k,1170) - lu(k,985) * lu(k,1159) + lu(k,1172) = lu(k,1172) - lu(k,986) * lu(k,1159) + lu(k,1174) = - lu(k,987) * lu(k,1159) + lu(k,1185) = - lu(k,983) * lu(k,1178) + lu(k,1186) = - lu(k,984) * lu(k,1178) + lu(k,1191) = lu(k,1191) - lu(k,985) * lu(k,1178) + lu(k,1193) = lu(k,1193) - lu(k,986) * lu(k,1178) + lu(k,1196) = - lu(k,987) * lu(k,1178) + lu(k,1802) = lu(k,1802) - lu(k,983) * lu(k,1786) + lu(k,1813) = lu(k,1813) - lu(k,984) * lu(k,1786) + lu(k,1823) = lu(k,1823) - lu(k,985) * lu(k,1786) + lu(k,1826) = lu(k,1826) - lu(k,986) * lu(k,1786) + lu(k,1833) = lu(k,1833) - lu(k,987) * lu(k,1786) + lu(k,1931) = lu(k,1931) - lu(k,983) * lu(k,1917) + lu(k,1941) = lu(k,1941) - lu(k,984) * lu(k,1917) + lu(k,1950) = lu(k,1950) - lu(k,985) * lu(k,1917) + lu(k,1953) = lu(k,1953) - lu(k,986) * lu(k,1917) + lu(k,1960) = lu(k,1960) - lu(k,987) * lu(k,1917) + lu(k,1984) = lu(k,1984) - lu(k,983) * lu(k,1972) + lu(k,1994) = lu(k,1994) - lu(k,984) * lu(k,1972) + lu(k,2002) = lu(k,2002) - lu(k,985) * lu(k,1972) + lu(k,2005) = lu(k,2005) - lu(k,986) * lu(k,1972) + lu(k,2012) = lu(k,2012) - lu(k,987) * lu(k,1972) + lu(k,2064) = lu(k,2064) - lu(k,983) * lu(k,2048) + lu(k,2075) = lu(k,2075) - lu(k,984) * lu(k,2048) + lu(k,2084) = lu(k,2084) - lu(k,985) * lu(k,2048) + lu(k,2087) = lu(k,2087) - lu(k,986) * lu(k,2048) + lu(k,2094) = lu(k,2094) - lu(k,987) * lu(k,2048) + lu(k,2166) = lu(k,2166) - lu(k,983) * lu(k,2152) + lu(k,2176) = lu(k,2176) - lu(k,984) * lu(k,2152) + lu(k,2185) = lu(k,2185) - lu(k,985) * lu(k,2152) + lu(k,2188) = lu(k,2188) - lu(k,986) * lu(k,2152) + lu(k,2195) = lu(k,2195) - lu(k,987) * lu(k,2152) + lu(k,2283) = lu(k,2283) - lu(k,983) * lu(k,2271) + lu(k,2293) = lu(k,2293) - lu(k,984) * lu(k,2271) + lu(k,2303) = lu(k,2303) - lu(k,985) * lu(k,2271) + lu(k,2306) = lu(k,2306) - lu(k,986) * lu(k,2271) + lu(k,2313) = lu(k,2313) - lu(k,987) * lu(k,2271) + lu(k,989) = 1._r8 / lu(k,989) + lu(k,990) = lu(k,990) * lu(k,989) + lu(k,991) = lu(k,991) * lu(k,989) + lu(k,992) = lu(k,992) * lu(k,989) + lu(k,993) = lu(k,993) * lu(k,989) + lu(k,994) = lu(k,994) * lu(k,989) + lu(k,1020) = lu(k,1020) - lu(k,990) * lu(k,1013) + lu(k,1027) = lu(k,1027) - lu(k,991) * lu(k,1013) + lu(k,1028) = lu(k,1028) - lu(k,992) * lu(k,1013) + lu(k,1033) = lu(k,1033) - lu(k,993) * lu(k,1013) + lu(k,1034) = lu(k,1034) - lu(k,994) * lu(k,1013) + lu(k,1050) = lu(k,1050) - lu(k,990) * lu(k,1047) + lu(k,1057) = lu(k,1057) - lu(k,991) * lu(k,1047) + lu(k,1058) = lu(k,1058) - lu(k,992) * lu(k,1047) + lu(k,1063) = lu(k,1063) - lu(k,993) * lu(k,1047) + lu(k,1064) = lu(k,1064) - lu(k,994) * lu(k,1047) + lu(k,1252) = lu(k,1252) - lu(k,990) * lu(k,1251) + lu(k,1259) = - lu(k,991) * lu(k,1251) + lu(k,1260) = lu(k,1260) - lu(k,992) * lu(k,1251) + lu(k,1262) = lu(k,1262) - lu(k,993) * lu(k,1251) + lu(k,1263) = lu(k,1263) - lu(k,994) * lu(k,1251) + lu(k,1375) = lu(k,1375) - lu(k,990) * lu(k,1372) + lu(k,1386) = lu(k,1386) - lu(k,991) * lu(k,1372) + lu(k,1387) = lu(k,1387) - lu(k,992) * lu(k,1372) + lu(k,1392) = lu(k,1392) - lu(k,993) * lu(k,1372) + lu(k,1393) = - lu(k,994) * lu(k,1372) + lu(k,1526) = lu(k,1526) - lu(k,990) * lu(k,1525) + lu(k,1534) = lu(k,1534) - lu(k,991) * lu(k,1525) + lu(k,1536) = lu(k,1536) - lu(k,992) * lu(k,1525) + lu(k,1544) = lu(k,1544) - lu(k,993) * lu(k,1525) + lu(k,1545) = lu(k,1545) - lu(k,994) * lu(k,1525) + lu(k,1797) = lu(k,1797) - lu(k,990) * lu(k,1787) + lu(k,1821) = lu(k,1821) - lu(k,991) * lu(k,1787) + lu(k,1823) = lu(k,1823) - lu(k,992) * lu(k,1787) + lu(k,1831) = lu(k,1831) - lu(k,993) * lu(k,1787) + lu(k,1833) = lu(k,1833) - lu(k,994) * lu(k,1787) + lu(k,1926) = lu(k,1926) - lu(k,990) * lu(k,1918) + lu(k,1948) = lu(k,1948) - lu(k,991) * lu(k,1918) + lu(k,1950) = lu(k,1950) - lu(k,992) * lu(k,1918) + lu(k,1958) = lu(k,1958) - lu(k,993) * lu(k,1918) + lu(k,1960) = lu(k,1960) - lu(k,994) * lu(k,1918) + lu(k,2059) = lu(k,2059) - lu(k,990) * lu(k,2049) + lu(k,2082) = lu(k,2082) - lu(k,991) * lu(k,2049) + lu(k,2084) = lu(k,2084) - lu(k,992) * lu(k,2049) + lu(k,2092) = lu(k,2092) - lu(k,993) * lu(k,2049) + lu(k,2094) = lu(k,2094) - lu(k,994) * lu(k,2049) + lu(k,2112) = lu(k,2112) - lu(k,990) * lu(k,2108) + lu(k,2121) = lu(k,2121) - lu(k,991) * lu(k,2108) + lu(k,2123) = lu(k,2123) - lu(k,992) * lu(k,2108) + lu(k,2131) = lu(k,2131) - lu(k,993) * lu(k,2108) + lu(k,2133) = lu(k,2133) - lu(k,994) * lu(k,2108) + lu(k,2162) = lu(k,2162) - lu(k,990) * lu(k,2153) + lu(k,2183) = lu(k,2183) - lu(k,991) * lu(k,2153) + lu(k,2185) = lu(k,2185) - lu(k,992) * lu(k,2153) + lu(k,2193) = lu(k,2193) - lu(k,993) * lu(k,2153) + lu(k,2195) = lu(k,2195) - lu(k,994) * lu(k,2153) + lu(k,2279) = lu(k,2279) - lu(k,990) * lu(k,2272) + lu(k,2301) = lu(k,2301) - lu(k,991) * lu(k,2272) + lu(k,2303) = lu(k,2303) - lu(k,992) * lu(k,2272) + lu(k,2311) = lu(k,2311) - lu(k,993) * lu(k,2272) + lu(k,2313) = lu(k,2313) - lu(k,994) * lu(k,2272) + lu(k,997) = 1._r8 / lu(k,997) + lu(k,998) = lu(k,998) * lu(k,997) + lu(k,999) = lu(k,999) * lu(k,997) + lu(k,1000) = lu(k,1000) * lu(k,997) + lu(k,1001) = lu(k,1001) * lu(k,997) + lu(k,1020) = lu(k,1020) - lu(k,998) * lu(k,1014) + lu(k,1027) = lu(k,1027) - lu(k,999) * lu(k,1014) + lu(k,1028) = lu(k,1028) - lu(k,1000) * lu(k,1014) + lu(k,1033) = lu(k,1033) - lu(k,1001) * lu(k,1014) + lu(k,1070) = lu(k,1070) - lu(k,998) * lu(k,1068) + lu(k,1076) = - lu(k,999) * lu(k,1068) + lu(k,1077) = lu(k,1077) - lu(k,1000) * lu(k,1068) + lu(k,1080) = lu(k,1080) - lu(k,1001) * lu(k,1068) + lu(k,1093) = lu(k,1093) - lu(k,998) * lu(k,1091) + lu(k,1095) = lu(k,1095) - lu(k,999) * lu(k,1091) + lu(k,1096) = lu(k,1096) - lu(k,1000) * lu(k,1091) + lu(k,1097) = lu(k,1097) - lu(k,1001) * lu(k,1091) + lu(k,1215) = lu(k,1215) - lu(k,998) * lu(k,1213) + lu(k,1222) = lu(k,1222) - lu(k,999) * lu(k,1213) + lu(k,1223) = lu(k,1223) - lu(k,1000) * lu(k,1213) + lu(k,1227) = lu(k,1227) - lu(k,1001) * lu(k,1213) + lu(k,1327) = lu(k,1327) - lu(k,998) * lu(k,1325) + lu(k,1342) = - lu(k,999) * lu(k,1325) + lu(k,1343) = lu(k,1343) - lu(k,1000) * lu(k,1325) + lu(k,1348) = lu(k,1348) - lu(k,1001) * lu(k,1325) + lu(k,1422) = lu(k,1422) - lu(k,998) * lu(k,1419) + lu(k,1438) = lu(k,1438) - lu(k,999) * lu(k,1419) + lu(k,1439) = lu(k,1439) - lu(k,1000) * lu(k,1419) + lu(k,1444) = lu(k,1444) - lu(k,1001) * lu(k,1419) + lu(k,1565) = lu(k,1565) - lu(k,998) * lu(k,1564) + lu(k,1577) = lu(k,1577) - lu(k,999) * lu(k,1564) + lu(k,1579) = lu(k,1579) - lu(k,1000) * lu(k,1564) + lu(k,1587) = lu(k,1587) - lu(k,1001) * lu(k,1564) + lu(k,1797) = lu(k,1797) - lu(k,998) * lu(k,1788) + lu(k,1821) = lu(k,1821) - lu(k,999) * lu(k,1788) + lu(k,1823) = lu(k,1823) - lu(k,1000) * lu(k,1788) + lu(k,1831) = lu(k,1831) - lu(k,1001) * lu(k,1788) + lu(k,1926) = lu(k,1926) - lu(k,998) * lu(k,1919) + lu(k,1948) = lu(k,1948) - lu(k,999) * lu(k,1919) + lu(k,1950) = lu(k,1950) - lu(k,1000) * lu(k,1919) + lu(k,1958) = lu(k,1958) - lu(k,1001) * lu(k,1919) + lu(k,1980) = lu(k,1980) - lu(k,998) * lu(k,1973) + lu(k,2000) = lu(k,2000) - lu(k,999) * lu(k,1973) + lu(k,2002) = lu(k,2002) - lu(k,1000) * lu(k,1973) + lu(k,2010) = lu(k,2010) - lu(k,1001) * lu(k,1973) + lu(k,2059) = lu(k,2059) - lu(k,998) * lu(k,2050) + lu(k,2082) = lu(k,2082) - lu(k,999) * lu(k,2050) + lu(k,2084) = lu(k,2084) - lu(k,1000) * lu(k,2050) + lu(k,2092) = lu(k,2092) - lu(k,1001) * lu(k,2050) + lu(k,2112) = lu(k,2112) - lu(k,998) * lu(k,2109) + lu(k,2121) = lu(k,2121) - lu(k,999) * lu(k,2109) + lu(k,2123) = lu(k,2123) - lu(k,1000) * lu(k,2109) + lu(k,2131) = lu(k,2131) - lu(k,1001) * lu(k,2109) + lu(k,2162) = lu(k,2162) - lu(k,998) * lu(k,2154) + lu(k,2183) = lu(k,2183) - lu(k,999) * lu(k,2154) + lu(k,2185) = lu(k,2185) - lu(k,1000) * lu(k,2154) + lu(k,2193) = lu(k,2193) - lu(k,1001) * lu(k,2154) + lu(k,2279) = lu(k,2279) - lu(k,998) * lu(k,2273) + lu(k,2301) = lu(k,2301) - lu(k,999) * lu(k,2273) + lu(k,2303) = lu(k,2303) - lu(k,1000) * lu(k,2273) + lu(k,2311) = lu(k,2311) - lu(k,1001) * lu(k,2273) + lu(k,1015) = 1._r8 / lu(k,1015) + lu(k,1016) = lu(k,1016) * lu(k,1015) + lu(k,1017) = lu(k,1017) * lu(k,1015) + lu(k,1018) = lu(k,1018) * lu(k,1015) + lu(k,1019) = lu(k,1019) * lu(k,1015) + lu(k,1020) = lu(k,1020) * lu(k,1015) + lu(k,1021) = lu(k,1021) * lu(k,1015) + lu(k,1022) = lu(k,1022) * lu(k,1015) + lu(k,1023) = lu(k,1023) * lu(k,1015) + lu(k,1024) = lu(k,1024) * lu(k,1015) + lu(k,1025) = lu(k,1025) * lu(k,1015) + lu(k,1026) = lu(k,1026) * lu(k,1015) + lu(k,1027) = lu(k,1027) * lu(k,1015) + lu(k,1028) = lu(k,1028) * lu(k,1015) + lu(k,1029) = lu(k,1029) * lu(k,1015) + lu(k,1030) = lu(k,1030) * lu(k,1015) + lu(k,1031) = lu(k,1031) * lu(k,1015) + lu(k,1032) = lu(k,1032) * lu(k,1015) + lu(k,1033) = lu(k,1033) * lu(k,1015) + lu(k,1034) = lu(k,1034) * lu(k,1015) + lu(k,1790) = lu(k,1790) - lu(k,1016) * lu(k,1789) + lu(k,1793) = lu(k,1793) - lu(k,1017) * lu(k,1789) + lu(k,1795) = lu(k,1795) - lu(k,1018) * lu(k,1789) + lu(k,1796) = lu(k,1796) - lu(k,1019) * lu(k,1789) + lu(k,1797) = lu(k,1797) - lu(k,1020) * lu(k,1789) + lu(k,1801) = lu(k,1801) - lu(k,1021) * lu(k,1789) + lu(k,1802) = lu(k,1802) - lu(k,1022) * lu(k,1789) + lu(k,1806) = lu(k,1806) - lu(k,1023) * lu(k,1789) + lu(k,1813) = lu(k,1813) - lu(k,1024) * lu(k,1789) + lu(k,1819) = lu(k,1819) - lu(k,1025) * lu(k,1789) + lu(k,1820) = lu(k,1820) - lu(k,1026) * lu(k,1789) + lu(k,1821) = lu(k,1821) - lu(k,1027) * lu(k,1789) + lu(k,1823) = lu(k,1823) - lu(k,1028) * lu(k,1789) + lu(k,1825) = lu(k,1825) - lu(k,1029) * lu(k,1789) + lu(k,1826) = lu(k,1826) - lu(k,1030) * lu(k,1789) + lu(k,1828) = lu(k,1828) - lu(k,1031) * lu(k,1789) + lu(k,1830) = lu(k,1830) - lu(k,1032) * lu(k,1789) + lu(k,1831) = lu(k,1831) - lu(k,1033) * lu(k,1789) + lu(k,1833) = lu(k,1833) - lu(k,1034) * lu(k,1789) + lu(k,2052) = lu(k,2052) - lu(k,1016) * lu(k,2051) + lu(k,2055) = lu(k,2055) - lu(k,1017) * lu(k,2051) + lu(k,2057) = lu(k,2057) - lu(k,1018) * lu(k,2051) + lu(k,2058) = lu(k,2058) - lu(k,1019) * lu(k,2051) + lu(k,2059) = lu(k,2059) - lu(k,1020) * lu(k,2051) + lu(k,2063) = lu(k,2063) - lu(k,1021) * lu(k,2051) + lu(k,2064) = lu(k,2064) - lu(k,1022) * lu(k,2051) + lu(k,2068) = lu(k,2068) - lu(k,1023) * lu(k,2051) + lu(k,2075) = lu(k,2075) - lu(k,1024) * lu(k,2051) + lu(k,2080) = lu(k,2080) - lu(k,1025) * lu(k,2051) + lu(k,2081) = lu(k,2081) - lu(k,1026) * lu(k,2051) + lu(k,2082) = lu(k,2082) - lu(k,1027) * lu(k,2051) + lu(k,2084) = lu(k,2084) - lu(k,1028) * lu(k,2051) + lu(k,2086) = lu(k,2086) - lu(k,1029) * lu(k,2051) + lu(k,2087) = lu(k,2087) - lu(k,1030) * lu(k,2051) + lu(k,2089) = lu(k,2089) - lu(k,1031) * lu(k,2051) + lu(k,2091) = lu(k,2091) - lu(k,1032) * lu(k,2051) + lu(k,2092) = lu(k,2092) - lu(k,1033) * lu(k,2051) + lu(k,2094) = lu(k,2094) - lu(k,1034) * lu(k,2051) + lu(k,2156) = lu(k,2156) - lu(k,1016) * lu(k,2155) + lu(k,2158) = lu(k,2158) - lu(k,1017) * lu(k,2155) + lu(k,2160) = lu(k,2160) - lu(k,1018) * lu(k,2155) + lu(k,2161) = lu(k,2161) - lu(k,1019) * lu(k,2155) + lu(k,2162) = lu(k,2162) - lu(k,1020) * lu(k,2155) + lu(k,2165) = lu(k,2165) - lu(k,1021) * lu(k,2155) + lu(k,2166) = lu(k,2166) - lu(k,1022) * lu(k,2155) + lu(k,2169) = lu(k,2169) - lu(k,1023) * lu(k,2155) + lu(k,2176) = lu(k,2176) - lu(k,1024) * lu(k,2155) + lu(k,2181) = lu(k,2181) - lu(k,1025) * lu(k,2155) + lu(k,2182) = lu(k,2182) - lu(k,1026) * lu(k,2155) + lu(k,2183) = lu(k,2183) - lu(k,1027) * lu(k,2155) + lu(k,2185) = lu(k,2185) - lu(k,1028) * lu(k,2155) + lu(k,2187) = lu(k,2187) - lu(k,1029) * lu(k,2155) + lu(k,2188) = lu(k,2188) - lu(k,1030) * lu(k,2155) + lu(k,2190) = lu(k,2190) - lu(k,1031) * lu(k,2155) + lu(k,2192) = lu(k,2192) - lu(k,1032) * lu(k,2155) + lu(k,2193) = lu(k,2193) - lu(k,1033) * lu(k,2155) + lu(k,2195) = lu(k,2195) - lu(k,1034) * lu(k,2155) + end do + end subroutine lu_fac21 + subroutine lu_fac22( 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,1035) = 1._r8 / lu(k,1035) + lu(k,1036) = lu(k,1036) * lu(k,1035) + lu(k,1037) = lu(k,1037) * lu(k,1035) + lu(k,1038) = lu(k,1038) * lu(k,1035) + lu(k,1039) = lu(k,1039) * lu(k,1035) + lu(k,1040) = lu(k,1040) * lu(k,1035) + lu(k,1041) = lu(k,1041) * lu(k,1035) + lu(k,1042) = lu(k,1042) * lu(k,1035) + lu(k,1102) = lu(k,1102) - lu(k,1036) * lu(k,1101) + lu(k,1103) = - lu(k,1037) * lu(k,1101) + lu(k,1104) = - lu(k,1038) * lu(k,1101) + lu(k,1105) = - lu(k,1039) * lu(k,1101) + lu(k,1109) = lu(k,1109) - lu(k,1040) * lu(k,1101) + lu(k,1112) = lu(k,1112) - lu(k,1041) * lu(k,1101) + lu(k,1113) = lu(k,1113) - lu(k,1042) * lu(k,1101) + lu(k,1180) = - lu(k,1036) * lu(k,1179) + lu(k,1181) = - lu(k,1037) * lu(k,1179) + lu(k,1182) = - lu(k,1038) * lu(k,1179) + lu(k,1183) = - lu(k,1039) * lu(k,1179) + lu(k,1191) = lu(k,1191) - lu(k,1040) * lu(k,1179) + lu(k,1194) = - lu(k,1041) * lu(k,1179) + lu(k,1195) = lu(k,1195) - lu(k,1042) * lu(k,1179) + lu(k,1795) = lu(k,1795) - lu(k,1036) * lu(k,1790) + lu(k,1796) = lu(k,1796) - lu(k,1037) * lu(k,1790) + lu(k,1797) = lu(k,1797) - lu(k,1038) * lu(k,1790) + lu(k,1800) = lu(k,1800) - lu(k,1039) * lu(k,1790) + lu(k,1823) = lu(k,1823) - lu(k,1040) * lu(k,1790) + lu(k,1828) = lu(k,1828) - lu(k,1041) * lu(k,1790) + lu(k,1831) = lu(k,1831) - lu(k,1042) * lu(k,1790) + lu(k,1924) = lu(k,1924) - lu(k,1036) * lu(k,1920) + lu(k,1925) = lu(k,1925) - lu(k,1037) * lu(k,1920) + lu(k,1926) = lu(k,1926) - lu(k,1038) * lu(k,1920) + lu(k,1929) = lu(k,1929) - lu(k,1039) * lu(k,1920) + lu(k,1950) = lu(k,1950) - lu(k,1040) * lu(k,1920) + lu(k,1955) = lu(k,1955) - lu(k,1041) * lu(k,1920) + lu(k,1958) = lu(k,1958) - lu(k,1042) * lu(k,1920) + lu(k,1978) = lu(k,1978) - lu(k,1036) * lu(k,1974) + lu(k,1979) = lu(k,1979) - lu(k,1037) * lu(k,1974) + lu(k,1980) = lu(k,1980) - lu(k,1038) * lu(k,1974) + lu(k,1982) = lu(k,1982) - lu(k,1039) * lu(k,1974) + lu(k,2002) = lu(k,2002) - lu(k,1040) * lu(k,1974) + lu(k,2007) = - lu(k,1041) * lu(k,1974) + lu(k,2010) = lu(k,2010) - lu(k,1042) * lu(k,1974) + lu(k,2057) = lu(k,2057) - lu(k,1036) * lu(k,2052) + lu(k,2058) = lu(k,2058) - lu(k,1037) * lu(k,2052) + lu(k,2059) = lu(k,2059) - lu(k,1038) * lu(k,2052) + lu(k,2062) = lu(k,2062) - lu(k,1039) * lu(k,2052) + lu(k,2084) = lu(k,2084) - lu(k,1040) * lu(k,2052) + lu(k,2089) = lu(k,2089) - lu(k,1041) * lu(k,2052) + lu(k,2092) = lu(k,2092) - lu(k,1042) * lu(k,2052) + lu(k,2160) = lu(k,2160) - lu(k,1036) * lu(k,2156) + lu(k,2161) = lu(k,2161) - lu(k,1037) * lu(k,2156) + lu(k,2162) = lu(k,2162) - lu(k,1038) * lu(k,2156) + lu(k,2164) = - lu(k,1039) * lu(k,2156) + lu(k,2185) = lu(k,2185) - lu(k,1040) * lu(k,2156) + lu(k,2190) = lu(k,2190) - lu(k,1041) * lu(k,2156) + lu(k,2193) = lu(k,2193) - lu(k,1042) * lu(k,2156) + lu(k,2277) = lu(k,2277) - lu(k,1036) * lu(k,2274) + lu(k,2278) = lu(k,2278) - lu(k,1037) * lu(k,2274) + lu(k,2279) = lu(k,2279) - lu(k,1038) * lu(k,2274) + lu(k,2281) = lu(k,2281) - lu(k,1039) * lu(k,2274) + lu(k,2303) = lu(k,2303) - lu(k,1040) * lu(k,2274) + lu(k,2308) = lu(k,2308) - lu(k,1041) * lu(k,2274) + lu(k,2311) = lu(k,2311) - lu(k,1042) * lu(k,2274) + 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,1055) = lu(k,1055) * lu(k,1048) + lu(k,1056) = lu(k,1056) * lu(k,1048) + lu(k,1057) = lu(k,1057) * lu(k,1048) + lu(k,1058) = lu(k,1058) * lu(k,1048) + lu(k,1059) = lu(k,1059) * lu(k,1048) + lu(k,1060) = lu(k,1060) * lu(k,1048) + lu(k,1061) = lu(k,1061) * lu(k,1048) + lu(k,1062) = lu(k,1062) * lu(k,1048) + lu(k,1063) = lu(k,1063) * lu(k,1048) + lu(k,1064) = lu(k,1064) * lu(k,1048) + lu(k,1374) = lu(k,1374) - lu(k,1049) * lu(k,1373) + lu(k,1375) = lu(k,1375) - lu(k,1050) * lu(k,1373) + lu(k,1376) = - lu(k,1051) * lu(k,1373) + lu(k,1377) = lu(k,1377) - lu(k,1052) * lu(k,1373) + lu(k,1381) = lu(k,1381) - lu(k,1053) * lu(k,1373) + lu(k,1382) = - lu(k,1054) * lu(k,1373) + lu(k,1384) = lu(k,1384) - lu(k,1055) * lu(k,1373) + lu(k,1385) = - lu(k,1056) * lu(k,1373) + lu(k,1386) = lu(k,1386) - lu(k,1057) * lu(k,1373) + lu(k,1387) = lu(k,1387) - lu(k,1058) * lu(k,1373) + lu(k,1388) = - lu(k,1059) * lu(k,1373) + lu(k,1389) = lu(k,1389) - lu(k,1060) * lu(k,1373) + lu(k,1390) = - lu(k,1061) * lu(k,1373) + lu(k,1391) = lu(k,1391) - lu(k,1062) * lu(k,1373) + lu(k,1392) = lu(k,1392) - lu(k,1063) * lu(k,1373) + lu(k,1393) = lu(k,1393) - lu(k,1064) * lu(k,1373) + lu(k,1793) = lu(k,1793) - lu(k,1049) * lu(k,1791) + lu(k,1797) = lu(k,1797) - lu(k,1050) * lu(k,1791) + lu(k,1799) = lu(k,1799) - lu(k,1051) * lu(k,1791) + lu(k,1806) = lu(k,1806) - lu(k,1052) * lu(k,1791) + lu(k,1813) = lu(k,1813) - lu(k,1053) * lu(k,1791) + lu(k,1816) = lu(k,1816) - lu(k,1054) * lu(k,1791) + lu(k,1819) = lu(k,1819) - lu(k,1055) * lu(k,1791) + lu(k,1820) = lu(k,1820) - lu(k,1056) * lu(k,1791) + lu(k,1821) = lu(k,1821) - lu(k,1057) * lu(k,1791) + lu(k,1823) = lu(k,1823) - lu(k,1058) * lu(k,1791) + lu(k,1825) = lu(k,1825) - lu(k,1059) * lu(k,1791) + lu(k,1826) = lu(k,1826) - lu(k,1060) * lu(k,1791) + lu(k,1828) = lu(k,1828) - lu(k,1061) * lu(k,1791) + lu(k,1830) = lu(k,1830) - lu(k,1062) * lu(k,1791) + lu(k,1831) = lu(k,1831) - lu(k,1063) * lu(k,1791) + lu(k,1833) = lu(k,1833) - lu(k,1064) * lu(k,1791) + lu(k,2055) = lu(k,2055) - lu(k,1049) * lu(k,2053) + lu(k,2059) = lu(k,2059) - lu(k,1050) * lu(k,2053) + lu(k,2061) = lu(k,2061) - lu(k,1051) * lu(k,2053) + lu(k,2068) = lu(k,2068) - lu(k,1052) * lu(k,2053) + lu(k,2075) = lu(k,2075) - lu(k,1053) * lu(k,2053) + lu(k,2077) = - lu(k,1054) * lu(k,2053) + lu(k,2080) = lu(k,2080) - lu(k,1055) * lu(k,2053) + lu(k,2081) = lu(k,2081) - lu(k,1056) * lu(k,2053) + lu(k,2082) = lu(k,2082) - lu(k,1057) * lu(k,2053) + lu(k,2084) = lu(k,2084) - lu(k,1058) * lu(k,2053) + lu(k,2086) = lu(k,2086) - lu(k,1059) * lu(k,2053) + lu(k,2087) = lu(k,2087) - lu(k,1060) * lu(k,2053) + lu(k,2089) = lu(k,2089) - lu(k,1061) * lu(k,2053) + lu(k,2091) = lu(k,2091) - lu(k,1062) * lu(k,2053) + lu(k,2092) = lu(k,2092) - lu(k,1063) * lu(k,2053) + lu(k,2094) = lu(k,2094) - lu(k,1064) * lu(k,2053) + lu(k,2158) = lu(k,2158) - lu(k,1049) * lu(k,2157) + lu(k,2162) = lu(k,2162) - lu(k,1050) * lu(k,2157) + lu(k,2163) = - lu(k,1051) * lu(k,2157) + lu(k,2169) = lu(k,2169) - lu(k,1052) * lu(k,2157) + lu(k,2176) = lu(k,2176) - lu(k,1053) * lu(k,2157) + lu(k,2178) = lu(k,2178) - lu(k,1054) * lu(k,2157) + lu(k,2181) = lu(k,2181) - lu(k,1055) * lu(k,2157) + lu(k,2182) = lu(k,2182) - lu(k,1056) * lu(k,2157) + lu(k,2183) = lu(k,2183) - lu(k,1057) * lu(k,2157) + lu(k,2185) = lu(k,2185) - lu(k,1058) * lu(k,2157) + lu(k,2187) = lu(k,2187) - lu(k,1059) * lu(k,2157) + lu(k,2188) = lu(k,2188) - lu(k,1060) * lu(k,2157) + lu(k,2190) = lu(k,2190) - lu(k,1061) * lu(k,2157) + lu(k,2192) = lu(k,2192) - lu(k,1062) * lu(k,2157) + lu(k,2193) = lu(k,2193) - lu(k,1063) * lu(k,2157) + lu(k,2195) = lu(k,2195) - lu(k,1064) * lu(k,2157) + lu(k,1069) = 1._r8 / lu(k,1069) + lu(k,1070) = lu(k,1070) * lu(k,1069) + lu(k,1071) = lu(k,1071) * lu(k,1069) + lu(k,1072) = lu(k,1072) * lu(k,1069) + lu(k,1073) = lu(k,1073) * lu(k,1069) + lu(k,1074) = lu(k,1074) * lu(k,1069) + lu(k,1075) = lu(k,1075) * lu(k,1069) + lu(k,1076) = lu(k,1076) * lu(k,1069) + lu(k,1077) = lu(k,1077) * lu(k,1069) + lu(k,1078) = lu(k,1078) * lu(k,1069) + lu(k,1079) = lu(k,1079) * lu(k,1069) + lu(k,1080) = lu(k,1080) * lu(k,1069) + lu(k,1235) = - lu(k,1070) * lu(k,1233) + lu(k,1239) = lu(k,1239) - lu(k,1071) * lu(k,1233) + lu(k,1241) = lu(k,1241) - lu(k,1072) * lu(k,1233) + lu(k,1242) = lu(k,1242) - lu(k,1073) * lu(k,1233) + lu(k,1243) = lu(k,1243) - lu(k,1074) * lu(k,1233) + lu(k,1244) = lu(k,1244) - lu(k,1075) * lu(k,1233) + lu(k,1245) = - lu(k,1076) * lu(k,1233) + lu(k,1246) = lu(k,1246) - lu(k,1077) * lu(k,1233) + lu(k,1247) = lu(k,1247) - lu(k,1078) * lu(k,1233) + lu(k,1248) = lu(k,1248) - lu(k,1079) * lu(k,1233) + lu(k,1250) = lu(k,1250) - lu(k,1080) * lu(k,1233) + lu(k,1422) = lu(k,1422) - lu(k,1070) * lu(k,1420) + lu(k,1427) = lu(k,1427) - lu(k,1071) * lu(k,1420) + lu(k,1433) = lu(k,1433) - lu(k,1072) * lu(k,1420) + lu(k,1435) = - lu(k,1073) * lu(k,1420) + lu(k,1436) = lu(k,1436) - lu(k,1074) * lu(k,1420) + lu(k,1437) = lu(k,1437) - lu(k,1075) * lu(k,1420) + lu(k,1438) = lu(k,1438) - lu(k,1076) * lu(k,1420) + lu(k,1439) = lu(k,1439) - lu(k,1077) * lu(k,1420) + lu(k,1440) = lu(k,1440) - lu(k,1078) * lu(k,1420) + lu(k,1441) = lu(k,1441) - lu(k,1079) * lu(k,1420) + lu(k,1444) = lu(k,1444) - lu(k,1080) * lu(k,1420) + lu(k,1797) = lu(k,1797) - lu(k,1070) * lu(k,1792) + lu(k,1806) = lu(k,1806) - lu(k,1071) * lu(k,1792) + lu(k,1813) = lu(k,1813) - lu(k,1072) * lu(k,1792) + lu(k,1817) = lu(k,1817) - lu(k,1073) * lu(k,1792) + lu(k,1819) = lu(k,1819) - lu(k,1074) * lu(k,1792) + lu(k,1820) = lu(k,1820) - lu(k,1075) * lu(k,1792) + lu(k,1821) = lu(k,1821) - lu(k,1076) * lu(k,1792) + lu(k,1823) = lu(k,1823) - lu(k,1077) * lu(k,1792) + lu(k,1825) = lu(k,1825) - lu(k,1078) * lu(k,1792) + lu(k,1826) = lu(k,1826) - lu(k,1079) * lu(k,1792) + lu(k,1831) = lu(k,1831) - lu(k,1080) * lu(k,1792) + lu(k,1926) = lu(k,1926) - lu(k,1070) * lu(k,1921) + lu(k,1935) = lu(k,1935) - lu(k,1071) * lu(k,1921) + lu(k,1941) = lu(k,1941) - lu(k,1072) * lu(k,1921) + lu(k,1944) = lu(k,1944) - lu(k,1073) * lu(k,1921) + lu(k,1946) = lu(k,1946) - lu(k,1074) * lu(k,1921) + lu(k,1947) = lu(k,1947) - lu(k,1075) * lu(k,1921) + lu(k,1948) = lu(k,1948) - lu(k,1076) * lu(k,1921) + lu(k,1950) = lu(k,1950) - lu(k,1077) * lu(k,1921) + lu(k,1952) = lu(k,1952) - lu(k,1078) * lu(k,1921) + lu(k,1953) = lu(k,1953) - lu(k,1079) * lu(k,1921) + lu(k,1958) = lu(k,1958) - lu(k,1080) * lu(k,1921) + lu(k,1980) = lu(k,1980) - lu(k,1070) * lu(k,1975) + lu(k,1988) = lu(k,1988) - lu(k,1071) * lu(k,1975) + lu(k,1994) = lu(k,1994) - lu(k,1072) * lu(k,1975) + lu(k,1996) = lu(k,1996) - lu(k,1073) * lu(k,1975) + lu(k,1998) = lu(k,1998) - lu(k,1074) * lu(k,1975) + lu(k,1999) = lu(k,1999) - lu(k,1075) * lu(k,1975) + lu(k,2000) = lu(k,2000) - lu(k,1076) * lu(k,1975) + lu(k,2002) = lu(k,2002) - lu(k,1077) * lu(k,1975) + lu(k,2004) = lu(k,2004) - lu(k,1078) * lu(k,1975) + lu(k,2005) = lu(k,2005) - lu(k,1079) * lu(k,1975) + lu(k,2010) = lu(k,2010) - lu(k,1080) * lu(k,1975) + lu(k,2059) = lu(k,2059) - lu(k,1070) * lu(k,2054) + lu(k,2068) = lu(k,2068) - lu(k,1071) * lu(k,2054) + lu(k,2075) = lu(k,2075) - lu(k,1072) * lu(k,2054) + lu(k,2078) = lu(k,2078) - lu(k,1073) * lu(k,2054) + lu(k,2080) = lu(k,2080) - lu(k,1074) * lu(k,2054) + lu(k,2081) = lu(k,2081) - lu(k,1075) * lu(k,2054) + lu(k,2082) = lu(k,2082) - lu(k,1076) * lu(k,2054) + lu(k,2084) = lu(k,2084) - lu(k,1077) * lu(k,2054) + lu(k,2086) = lu(k,2086) - lu(k,1078) * lu(k,2054) + lu(k,2087) = lu(k,2087) - lu(k,1079) * lu(k,2054) + lu(k,2092) = lu(k,2092) - lu(k,1080) * lu(k,2054) + end do + end subroutine lu_fac22 + subroutine lu_fac23( 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,1081) = 1._r8 / lu(k,1081) + lu(k,1082) = lu(k,1082) * lu(k,1081) + lu(k,1083) = lu(k,1083) * lu(k,1081) + lu(k,1084) = lu(k,1084) * lu(k,1081) + lu(k,1085) = lu(k,1085) * lu(k,1081) + lu(k,1086) = lu(k,1086) * lu(k,1081) + lu(k,1087) = lu(k,1087) * lu(k,1081) + lu(k,1088) = lu(k,1088) * lu(k,1081) + lu(k,1089) = lu(k,1089) * lu(k,1081) + lu(k,1135) = lu(k,1135) - lu(k,1082) * lu(k,1133) + lu(k,1139) = lu(k,1139) - lu(k,1083) * lu(k,1133) + lu(k,1140) = lu(k,1140) - lu(k,1084) * lu(k,1133) + lu(k,1144) = lu(k,1144) - lu(k,1085) * lu(k,1133) + lu(k,1145) = lu(k,1145) - lu(k,1086) * lu(k,1133) + lu(k,1146) = - lu(k,1087) * lu(k,1133) + lu(k,1147) = lu(k,1147) - lu(k,1088) * lu(k,1133) + lu(k,1148) = lu(k,1148) - lu(k,1089) * lu(k,1133) + lu(k,1375) = lu(k,1375) - lu(k,1082) * lu(k,1374) + lu(k,1381) = lu(k,1381) - lu(k,1083) * lu(k,1374) + lu(k,1383) = - lu(k,1084) * lu(k,1374) + lu(k,1387) = lu(k,1387) - lu(k,1085) * lu(k,1374) + lu(k,1389) = lu(k,1389) - lu(k,1086) * lu(k,1374) + lu(k,1390) = lu(k,1390) - lu(k,1087) * lu(k,1374) + lu(k,1392) = lu(k,1392) - lu(k,1088) * lu(k,1374) + lu(k,1393) = lu(k,1393) - lu(k,1089) * lu(k,1374) + lu(k,1797) = lu(k,1797) - lu(k,1082) * lu(k,1793) + lu(k,1813) = lu(k,1813) - lu(k,1083) * lu(k,1793) + lu(k,1817) = lu(k,1817) - lu(k,1084) * lu(k,1793) + lu(k,1823) = lu(k,1823) - lu(k,1085) * lu(k,1793) + lu(k,1826) = lu(k,1826) - lu(k,1086) * lu(k,1793) + lu(k,1828) = lu(k,1828) - lu(k,1087) * lu(k,1793) + lu(k,1831) = lu(k,1831) - lu(k,1088) * lu(k,1793) + lu(k,1833) = lu(k,1833) - lu(k,1089) * lu(k,1793) + lu(k,1926) = lu(k,1926) - lu(k,1082) * lu(k,1922) + lu(k,1941) = lu(k,1941) - lu(k,1083) * lu(k,1922) + lu(k,1944) = lu(k,1944) - lu(k,1084) * lu(k,1922) + lu(k,1950) = lu(k,1950) - lu(k,1085) * lu(k,1922) + lu(k,1953) = lu(k,1953) - lu(k,1086) * lu(k,1922) + lu(k,1955) = lu(k,1955) - lu(k,1087) * lu(k,1922) + lu(k,1958) = lu(k,1958) - lu(k,1088) * lu(k,1922) + lu(k,1960) = lu(k,1960) - lu(k,1089) * lu(k,1922) + lu(k,1980) = lu(k,1980) - lu(k,1082) * lu(k,1976) + lu(k,1994) = lu(k,1994) - lu(k,1083) * lu(k,1976) + lu(k,1996) = lu(k,1996) - lu(k,1084) * lu(k,1976) + lu(k,2002) = lu(k,2002) - lu(k,1085) * lu(k,1976) + lu(k,2005) = lu(k,2005) - lu(k,1086) * lu(k,1976) + lu(k,2007) = lu(k,2007) - lu(k,1087) * lu(k,1976) + lu(k,2010) = lu(k,2010) - lu(k,1088) * lu(k,1976) + lu(k,2012) = lu(k,2012) - lu(k,1089) * lu(k,1976) + lu(k,2059) = lu(k,2059) - lu(k,1082) * lu(k,2055) + lu(k,2075) = lu(k,2075) - lu(k,1083) * lu(k,2055) + lu(k,2078) = lu(k,2078) - lu(k,1084) * lu(k,2055) + lu(k,2084) = lu(k,2084) - lu(k,1085) * lu(k,2055) + lu(k,2087) = lu(k,2087) - lu(k,1086) * lu(k,2055) + lu(k,2089) = lu(k,2089) - lu(k,1087) * lu(k,2055) + lu(k,2092) = lu(k,2092) - lu(k,1088) * lu(k,2055) + lu(k,2094) = lu(k,2094) - lu(k,1089) * lu(k,2055) + lu(k,2112) = lu(k,2112) - lu(k,1082) * lu(k,2110) + lu(k,2113) = - lu(k,1083) * lu(k,2110) + lu(k,2117) = lu(k,2117) - lu(k,1084) * lu(k,2110) + lu(k,2123) = lu(k,2123) - lu(k,1085) * lu(k,2110) + lu(k,2126) = lu(k,2126) - lu(k,1086) * lu(k,2110) + lu(k,2128) = lu(k,2128) - lu(k,1087) * lu(k,2110) + lu(k,2131) = lu(k,2131) - lu(k,1088) * lu(k,2110) + lu(k,2133) = lu(k,2133) - lu(k,1089) * lu(k,2110) + lu(k,2162) = lu(k,2162) - lu(k,1082) * lu(k,2158) + lu(k,2176) = lu(k,2176) - lu(k,1083) * lu(k,2158) + lu(k,2179) = - lu(k,1084) * lu(k,2158) + lu(k,2185) = lu(k,2185) - lu(k,1085) * lu(k,2158) + lu(k,2188) = lu(k,2188) - lu(k,1086) * lu(k,2158) + lu(k,2190) = lu(k,2190) - lu(k,1087) * lu(k,2158) + lu(k,2193) = lu(k,2193) - lu(k,1088) * lu(k,2158) + lu(k,2195) = lu(k,2195) - lu(k,1089) * lu(k,2158) + lu(k,2279) = lu(k,2279) - lu(k,1082) * lu(k,2275) + lu(k,2293) = lu(k,2293) - lu(k,1083) * lu(k,2275) + lu(k,2297) = lu(k,2297) - lu(k,1084) * lu(k,2275) + lu(k,2303) = lu(k,2303) - lu(k,1085) * lu(k,2275) + lu(k,2306) = lu(k,2306) - lu(k,1086) * lu(k,2275) + lu(k,2308) = lu(k,2308) - lu(k,1087) * lu(k,2275) + lu(k,2311) = lu(k,2311) - lu(k,1088) * lu(k,2275) + lu(k,2313) = lu(k,2313) - lu(k,1089) * lu(k,2275) + lu(k,1092) = 1._r8 / lu(k,1092) + lu(k,1093) = lu(k,1093) * lu(k,1092) + lu(k,1094) = lu(k,1094) * lu(k,1092) + lu(k,1095) = lu(k,1095) * lu(k,1092) + lu(k,1096) = lu(k,1096) * lu(k,1092) + lu(k,1097) = lu(k,1097) * lu(k,1092) + lu(k,1135) = lu(k,1135) - lu(k,1093) * lu(k,1134) + lu(k,1141) = lu(k,1141) - lu(k,1094) * lu(k,1134) + lu(k,1143) = - lu(k,1095) * lu(k,1134) + lu(k,1144) = lu(k,1144) - lu(k,1096) * lu(k,1134) + lu(k,1147) = lu(k,1147) - lu(k,1097) * lu(k,1134) + lu(k,1162) = lu(k,1162) - lu(k,1093) * lu(k,1160) + lu(k,1167) = lu(k,1167) - lu(k,1094) * lu(k,1160) + lu(k,1169) = lu(k,1169) - lu(k,1095) * lu(k,1160) + lu(k,1170) = lu(k,1170) - lu(k,1096) * lu(k,1160) + lu(k,1173) = lu(k,1173) - lu(k,1097) * lu(k,1160) + lu(k,1215) = lu(k,1215) - lu(k,1093) * lu(k,1214) + lu(k,1220) = lu(k,1220) - lu(k,1094) * lu(k,1214) + lu(k,1222) = lu(k,1222) - lu(k,1095) * lu(k,1214) + lu(k,1223) = lu(k,1223) - lu(k,1096) * lu(k,1214) + lu(k,1227) = lu(k,1227) - lu(k,1097) * lu(k,1214) + lu(k,1235) = lu(k,1235) - lu(k,1093) * lu(k,1234) + lu(k,1243) = lu(k,1243) - lu(k,1094) * lu(k,1234) + lu(k,1245) = lu(k,1245) - lu(k,1095) * lu(k,1234) + lu(k,1246) = lu(k,1246) - lu(k,1096) * lu(k,1234) + lu(k,1250) = lu(k,1250) - lu(k,1097) * lu(k,1234) + lu(k,1294) = lu(k,1294) - lu(k,1093) * lu(k,1293) + lu(k,1307) = lu(k,1307) - lu(k,1094) * lu(k,1293) + lu(k,1309) = lu(k,1309) - lu(k,1095) * lu(k,1293) + lu(k,1310) = lu(k,1310) - lu(k,1096) * lu(k,1293) + lu(k,1315) = lu(k,1315) - lu(k,1097) * lu(k,1293) + lu(k,1327) = lu(k,1327) - lu(k,1093) * lu(k,1326) + lu(k,1340) = lu(k,1340) - lu(k,1094) * lu(k,1326) + lu(k,1342) = lu(k,1342) - lu(k,1095) * lu(k,1326) + lu(k,1343) = lu(k,1343) - lu(k,1096) * lu(k,1326) + lu(k,1348) = lu(k,1348) - lu(k,1097) * lu(k,1326) + lu(k,1353) = lu(k,1353) - lu(k,1093) * lu(k,1352) + lu(k,1362) = lu(k,1362) - lu(k,1094) * lu(k,1352) + lu(k,1364) = - lu(k,1095) * lu(k,1352) + lu(k,1365) = lu(k,1365) - lu(k,1096) * lu(k,1352) + lu(k,1369) = lu(k,1369) - lu(k,1097) * lu(k,1352) + lu(k,1422) = lu(k,1422) - lu(k,1093) * lu(k,1421) + lu(k,1436) = lu(k,1436) - lu(k,1094) * lu(k,1421) + lu(k,1438) = lu(k,1438) - lu(k,1095) * lu(k,1421) + lu(k,1439) = lu(k,1439) - lu(k,1096) * lu(k,1421) + lu(k,1444) = lu(k,1444) - lu(k,1097) * lu(k,1421) + lu(k,1797) = lu(k,1797) - lu(k,1093) * lu(k,1794) + lu(k,1819) = lu(k,1819) - lu(k,1094) * lu(k,1794) + lu(k,1821) = lu(k,1821) - lu(k,1095) * lu(k,1794) + lu(k,1823) = lu(k,1823) - lu(k,1096) * lu(k,1794) + lu(k,1831) = lu(k,1831) - lu(k,1097) * lu(k,1794) + lu(k,1926) = lu(k,1926) - lu(k,1093) * lu(k,1923) + lu(k,1946) = lu(k,1946) - lu(k,1094) * lu(k,1923) + lu(k,1948) = lu(k,1948) - lu(k,1095) * lu(k,1923) + lu(k,1950) = lu(k,1950) - lu(k,1096) * lu(k,1923) + lu(k,1958) = lu(k,1958) - lu(k,1097) * lu(k,1923) + lu(k,1980) = lu(k,1980) - lu(k,1093) * lu(k,1977) + lu(k,1998) = lu(k,1998) - lu(k,1094) * lu(k,1977) + lu(k,2000) = lu(k,2000) - lu(k,1095) * lu(k,1977) + lu(k,2002) = lu(k,2002) - lu(k,1096) * lu(k,1977) + lu(k,2010) = lu(k,2010) - lu(k,1097) * lu(k,1977) + lu(k,2059) = lu(k,2059) - lu(k,1093) * lu(k,2056) + lu(k,2080) = lu(k,2080) - lu(k,1094) * lu(k,2056) + lu(k,2082) = lu(k,2082) - lu(k,1095) * lu(k,2056) + lu(k,2084) = lu(k,2084) - lu(k,1096) * lu(k,2056) + lu(k,2092) = lu(k,2092) - lu(k,1097) * lu(k,2056) + lu(k,2112) = lu(k,2112) - lu(k,1093) * lu(k,2111) + lu(k,2119) = lu(k,2119) - lu(k,1094) * lu(k,2111) + lu(k,2121) = lu(k,2121) - lu(k,1095) * lu(k,2111) + lu(k,2123) = lu(k,2123) - lu(k,1096) * lu(k,2111) + lu(k,2131) = lu(k,2131) - lu(k,1097) * lu(k,2111) + lu(k,2162) = lu(k,2162) - lu(k,1093) * lu(k,2159) + lu(k,2181) = lu(k,2181) - lu(k,1094) * lu(k,2159) + lu(k,2183) = lu(k,2183) - lu(k,1095) * lu(k,2159) + lu(k,2185) = lu(k,2185) - lu(k,1096) * lu(k,2159) + lu(k,2193) = lu(k,2193) - lu(k,1097) * lu(k,2159) + lu(k,2279) = lu(k,2279) - lu(k,1093) * lu(k,2276) + lu(k,2299) = lu(k,2299) - lu(k,1094) * lu(k,2276) + lu(k,2301) = lu(k,2301) - lu(k,1095) * lu(k,2276) + lu(k,2303) = lu(k,2303) - lu(k,1096) * lu(k,2276) + lu(k,2311) = lu(k,2311) - lu(k,1097) * lu(k,2276) + lu(k,1102) = 1._r8 / lu(k,1102) + lu(k,1103) = lu(k,1103) * lu(k,1102) + lu(k,1104) = lu(k,1104) * lu(k,1102) + lu(k,1105) = lu(k,1105) * lu(k,1102) + lu(k,1106) = lu(k,1106) * lu(k,1102) + lu(k,1107) = lu(k,1107) * lu(k,1102) + lu(k,1108) = lu(k,1108) * lu(k,1102) + lu(k,1109) = lu(k,1109) * lu(k,1102) + lu(k,1110) = lu(k,1110) * lu(k,1102) + lu(k,1111) = lu(k,1111) * lu(k,1102) + lu(k,1112) = lu(k,1112) * lu(k,1102) + lu(k,1113) = lu(k,1113) * lu(k,1102) + lu(k,1181) = lu(k,1181) - lu(k,1103) * lu(k,1180) + lu(k,1182) = lu(k,1182) - lu(k,1104) * lu(k,1180) + lu(k,1183) = lu(k,1183) - lu(k,1105) * lu(k,1180) + lu(k,1187) = lu(k,1187) - lu(k,1106) * lu(k,1180) + lu(k,1188) = lu(k,1188) - lu(k,1107) * lu(k,1180) + lu(k,1189) = lu(k,1189) - lu(k,1108) * lu(k,1180) + lu(k,1191) = lu(k,1191) - lu(k,1109) * lu(k,1180) + lu(k,1192) = lu(k,1192) - lu(k,1110) * lu(k,1180) + lu(k,1193) = lu(k,1193) - lu(k,1111) * lu(k,1180) + lu(k,1194) = lu(k,1194) - lu(k,1112) * lu(k,1180) + lu(k,1195) = lu(k,1195) - lu(k,1113) * lu(k,1180) + lu(k,1796) = lu(k,1796) - lu(k,1103) * lu(k,1795) + lu(k,1797) = lu(k,1797) - lu(k,1104) * lu(k,1795) + lu(k,1800) = lu(k,1800) - lu(k,1105) * lu(k,1795) + lu(k,1817) = lu(k,1817) - lu(k,1106) * lu(k,1795) + lu(k,1819) = lu(k,1819) - lu(k,1107) * lu(k,1795) + lu(k,1820) = lu(k,1820) - lu(k,1108) * lu(k,1795) + lu(k,1823) = lu(k,1823) - lu(k,1109) * lu(k,1795) + lu(k,1825) = lu(k,1825) - lu(k,1110) * lu(k,1795) + lu(k,1826) = lu(k,1826) - lu(k,1111) * lu(k,1795) + lu(k,1828) = lu(k,1828) - lu(k,1112) * lu(k,1795) + lu(k,1831) = lu(k,1831) - lu(k,1113) * lu(k,1795) + lu(k,1925) = lu(k,1925) - lu(k,1103) * lu(k,1924) + lu(k,1926) = lu(k,1926) - lu(k,1104) * lu(k,1924) + lu(k,1929) = lu(k,1929) - lu(k,1105) * lu(k,1924) + lu(k,1944) = lu(k,1944) - lu(k,1106) * lu(k,1924) + lu(k,1946) = lu(k,1946) - lu(k,1107) * lu(k,1924) + lu(k,1947) = lu(k,1947) - lu(k,1108) * lu(k,1924) + lu(k,1950) = lu(k,1950) - lu(k,1109) * lu(k,1924) + lu(k,1952) = lu(k,1952) - lu(k,1110) * lu(k,1924) + lu(k,1953) = lu(k,1953) - lu(k,1111) * lu(k,1924) + lu(k,1955) = lu(k,1955) - lu(k,1112) * lu(k,1924) + lu(k,1958) = lu(k,1958) - lu(k,1113) * lu(k,1924) + lu(k,1979) = lu(k,1979) - lu(k,1103) * lu(k,1978) + lu(k,1980) = lu(k,1980) - lu(k,1104) * lu(k,1978) + lu(k,1982) = lu(k,1982) - lu(k,1105) * lu(k,1978) + lu(k,1996) = lu(k,1996) - lu(k,1106) * lu(k,1978) + lu(k,1998) = lu(k,1998) - lu(k,1107) * lu(k,1978) + lu(k,1999) = lu(k,1999) - lu(k,1108) * lu(k,1978) + lu(k,2002) = lu(k,2002) - lu(k,1109) * lu(k,1978) + lu(k,2004) = lu(k,2004) - lu(k,1110) * lu(k,1978) + lu(k,2005) = lu(k,2005) - lu(k,1111) * lu(k,1978) + lu(k,2007) = lu(k,2007) - lu(k,1112) * lu(k,1978) + lu(k,2010) = lu(k,2010) - lu(k,1113) * lu(k,1978) + lu(k,2058) = lu(k,2058) - lu(k,1103) * lu(k,2057) + lu(k,2059) = lu(k,2059) - lu(k,1104) * lu(k,2057) + lu(k,2062) = lu(k,2062) - lu(k,1105) * lu(k,2057) + lu(k,2078) = lu(k,2078) - lu(k,1106) * lu(k,2057) + lu(k,2080) = lu(k,2080) - lu(k,1107) * lu(k,2057) + lu(k,2081) = lu(k,2081) - lu(k,1108) * lu(k,2057) + lu(k,2084) = lu(k,2084) - lu(k,1109) * lu(k,2057) + lu(k,2086) = lu(k,2086) - lu(k,1110) * lu(k,2057) + lu(k,2087) = lu(k,2087) - lu(k,1111) * lu(k,2057) + lu(k,2089) = lu(k,2089) - lu(k,1112) * lu(k,2057) + lu(k,2092) = lu(k,2092) - lu(k,1113) * lu(k,2057) + lu(k,2161) = lu(k,2161) - lu(k,1103) * lu(k,2160) + lu(k,2162) = lu(k,2162) - lu(k,1104) * lu(k,2160) + lu(k,2164) = lu(k,2164) - lu(k,1105) * lu(k,2160) + lu(k,2179) = lu(k,2179) - lu(k,1106) * lu(k,2160) + lu(k,2181) = lu(k,2181) - lu(k,1107) * lu(k,2160) + lu(k,2182) = lu(k,2182) - lu(k,1108) * lu(k,2160) + lu(k,2185) = lu(k,2185) - lu(k,1109) * lu(k,2160) + lu(k,2187) = lu(k,2187) - lu(k,1110) * lu(k,2160) + lu(k,2188) = lu(k,2188) - lu(k,1111) * lu(k,2160) + lu(k,2190) = lu(k,2190) - lu(k,1112) * lu(k,2160) + lu(k,2193) = lu(k,2193) - lu(k,1113) * lu(k,2160) + lu(k,2278) = lu(k,2278) - lu(k,1103) * lu(k,2277) + lu(k,2279) = lu(k,2279) - lu(k,1104) * lu(k,2277) + lu(k,2281) = lu(k,2281) - lu(k,1105) * lu(k,2277) + lu(k,2297) = lu(k,2297) - lu(k,1106) * lu(k,2277) + lu(k,2299) = lu(k,2299) - lu(k,1107) * lu(k,2277) + lu(k,2300) = lu(k,2300) - lu(k,1108) * lu(k,2277) + lu(k,2303) = lu(k,2303) - lu(k,1109) * lu(k,2277) + lu(k,2305) = lu(k,2305) - lu(k,1110) * lu(k,2277) + lu(k,2306) = lu(k,2306) - lu(k,1111) * lu(k,2277) + lu(k,2308) = lu(k,2308) - lu(k,1112) * lu(k,2277) + lu(k,2311) = lu(k,2311) - lu(k,1113) * lu(k,2277) + lu(k,1116) = 1._r8 / lu(k,1116) + lu(k,1117) = lu(k,1117) * lu(k,1116) + lu(k,1118) = lu(k,1118) * lu(k,1116) + lu(k,1119) = lu(k,1119) * lu(k,1116) + lu(k,1120) = lu(k,1120) * lu(k,1116) + lu(k,1121) = lu(k,1121) * lu(k,1116) + lu(k,1122) = lu(k,1122) * lu(k,1116) + lu(k,1123) = lu(k,1123) * lu(k,1116) + lu(k,1124) = lu(k,1124) * lu(k,1116) + lu(k,1125) = lu(k,1125) * lu(k,1116) + lu(k,1162) = lu(k,1162) - lu(k,1117) * lu(k,1161) + lu(k,1164) = lu(k,1164) - lu(k,1118) * lu(k,1161) + lu(k,1165) = lu(k,1165) - lu(k,1119) * lu(k,1161) + lu(k,1167) = lu(k,1167) - lu(k,1120) * lu(k,1161) + lu(k,1169) = lu(k,1169) - lu(k,1121) * lu(k,1161) + lu(k,1170) = lu(k,1170) - lu(k,1122) * lu(k,1161) + lu(k,1172) = lu(k,1172) - lu(k,1123) * lu(k,1161) + lu(k,1173) = lu(k,1173) - lu(k,1124) * lu(k,1161) + lu(k,1174) = lu(k,1174) - lu(k,1125) * lu(k,1161) + lu(k,1182) = lu(k,1182) - lu(k,1117) * lu(k,1181) + lu(k,1185) = lu(k,1185) - lu(k,1118) * lu(k,1181) + lu(k,1186) = lu(k,1186) - lu(k,1119) * lu(k,1181) + lu(k,1188) = lu(k,1188) - lu(k,1120) * lu(k,1181) + lu(k,1190) = - lu(k,1121) * lu(k,1181) + lu(k,1191) = lu(k,1191) - lu(k,1122) * lu(k,1181) + lu(k,1193) = lu(k,1193) - lu(k,1123) * lu(k,1181) + lu(k,1195) = lu(k,1195) - lu(k,1124) * lu(k,1181) + lu(k,1196) = lu(k,1196) - lu(k,1125) * lu(k,1181) + lu(k,1797) = lu(k,1797) - lu(k,1117) * lu(k,1796) + lu(k,1802) = lu(k,1802) - lu(k,1118) * lu(k,1796) + lu(k,1813) = lu(k,1813) - lu(k,1119) * lu(k,1796) + lu(k,1819) = lu(k,1819) - lu(k,1120) * lu(k,1796) + lu(k,1821) = lu(k,1821) - lu(k,1121) * lu(k,1796) + lu(k,1823) = lu(k,1823) - lu(k,1122) * lu(k,1796) + lu(k,1826) = lu(k,1826) - lu(k,1123) * lu(k,1796) + lu(k,1831) = lu(k,1831) - lu(k,1124) * lu(k,1796) + lu(k,1833) = lu(k,1833) - lu(k,1125) * lu(k,1796) + lu(k,1926) = lu(k,1926) - lu(k,1117) * lu(k,1925) + lu(k,1931) = lu(k,1931) - lu(k,1118) * lu(k,1925) + lu(k,1941) = lu(k,1941) - lu(k,1119) * lu(k,1925) + lu(k,1946) = lu(k,1946) - lu(k,1120) * lu(k,1925) + lu(k,1948) = lu(k,1948) - lu(k,1121) * lu(k,1925) + lu(k,1950) = lu(k,1950) - lu(k,1122) * lu(k,1925) + lu(k,1953) = lu(k,1953) - lu(k,1123) * lu(k,1925) + lu(k,1958) = lu(k,1958) - lu(k,1124) * lu(k,1925) + lu(k,1960) = lu(k,1960) - lu(k,1125) * lu(k,1925) + lu(k,1980) = lu(k,1980) - lu(k,1117) * lu(k,1979) + lu(k,1984) = lu(k,1984) - lu(k,1118) * lu(k,1979) + lu(k,1994) = lu(k,1994) - lu(k,1119) * lu(k,1979) + lu(k,1998) = lu(k,1998) - lu(k,1120) * lu(k,1979) + lu(k,2000) = lu(k,2000) - lu(k,1121) * lu(k,1979) + lu(k,2002) = lu(k,2002) - lu(k,1122) * lu(k,1979) + lu(k,2005) = lu(k,2005) - lu(k,1123) * lu(k,1979) + lu(k,2010) = lu(k,2010) - lu(k,1124) * lu(k,1979) + lu(k,2012) = lu(k,2012) - lu(k,1125) * lu(k,1979) + lu(k,2059) = lu(k,2059) - lu(k,1117) * lu(k,2058) + lu(k,2064) = lu(k,2064) - lu(k,1118) * lu(k,2058) + lu(k,2075) = lu(k,2075) - lu(k,1119) * lu(k,2058) + lu(k,2080) = lu(k,2080) - lu(k,1120) * lu(k,2058) + lu(k,2082) = lu(k,2082) - lu(k,1121) * lu(k,2058) + lu(k,2084) = lu(k,2084) - lu(k,1122) * lu(k,2058) + lu(k,2087) = lu(k,2087) - lu(k,1123) * lu(k,2058) + lu(k,2092) = lu(k,2092) - lu(k,1124) * lu(k,2058) + lu(k,2094) = lu(k,2094) - lu(k,1125) * lu(k,2058) + lu(k,2162) = lu(k,2162) - lu(k,1117) * lu(k,2161) + lu(k,2166) = lu(k,2166) - lu(k,1118) * lu(k,2161) + lu(k,2176) = lu(k,2176) - lu(k,1119) * lu(k,2161) + lu(k,2181) = lu(k,2181) - lu(k,1120) * lu(k,2161) + lu(k,2183) = lu(k,2183) - lu(k,1121) * lu(k,2161) + lu(k,2185) = lu(k,2185) - lu(k,1122) * lu(k,2161) + lu(k,2188) = lu(k,2188) - lu(k,1123) * lu(k,2161) + lu(k,2193) = lu(k,2193) - lu(k,1124) * lu(k,2161) + lu(k,2195) = lu(k,2195) - lu(k,1125) * lu(k,2161) + lu(k,2279) = lu(k,2279) - lu(k,1117) * lu(k,2278) + lu(k,2283) = lu(k,2283) - lu(k,1118) * lu(k,2278) + lu(k,2293) = lu(k,2293) - lu(k,1119) * lu(k,2278) + lu(k,2299) = lu(k,2299) - lu(k,1120) * lu(k,2278) + lu(k,2301) = lu(k,2301) - lu(k,1121) * lu(k,2278) + lu(k,2303) = lu(k,2303) - lu(k,1122) * lu(k,2278) + lu(k,2306) = lu(k,2306) - lu(k,1123) * lu(k,2278) + lu(k,2311) = lu(k,2311) - lu(k,1124) * lu(k,2278) + lu(k,2313) = lu(k,2313) - lu(k,1125) * lu(k,2278) + lu(k,1127) = 1._r8 / lu(k,1127) + lu(k,1128) = lu(k,1128) * lu(k,1127) + lu(k,1129) = lu(k,1129) * lu(k,1127) + lu(k,1130) = lu(k,1130) * lu(k,1127) + lu(k,1143) = lu(k,1143) - lu(k,1128) * lu(k,1135) + lu(k,1144) = lu(k,1144) - lu(k,1129) * lu(k,1135) + lu(k,1147) = lu(k,1147) - lu(k,1130) * lu(k,1135) + lu(k,1169) = lu(k,1169) - lu(k,1128) * lu(k,1162) + lu(k,1170) = lu(k,1170) - lu(k,1129) * lu(k,1162) + lu(k,1173) = lu(k,1173) - lu(k,1130) * lu(k,1162) + lu(k,1190) = lu(k,1190) - lu(k,1128) * lu(k,1182) + lu(k,1191) = lu(k,1191) - lu(k,1129) * lu(k,1182) + lu(k,1195) = lu(k,1195) - lu(k,1130) * lu(k,1182) + lu(k,1222) = lu(k,1222) - lu(k,1128) * lu(k,1215) + lu(k,1223) = lu(k,1223) - lu(k,1129) * lu(k,1215) + lu(k,1227) = lu(k,1227) - lu(k,1130) * lu(k,1215) + lu(k,1245) = lu(k,1245) - lu(k,1128) * lu(k,1235) + lu(k,1246) = lu(k,1246) - lu(k,1129) * lu(k,1235) + lu(k,1250) = lu(k,1250) - lu(k,1130) * lu(k,1235) + lu(k,1259) = lu(k,1259) - lu(k,1128) * lu(k,1252) + lu(k,1260) = lu(k,1260) - lu(k,1129) * lu(k,1252) + lu(k,1262) = lu(k,1262) - lu(k,1130) * lu(k,1252) + lu(k,1268) = - lu(k,1128) * lu(k,1264) + lu(k,1269) = lu(k,1269) - lu(k,1129) * lu(k,1264) + lu(k,1271) = lu(k,1271) - lu(k,1130) * lu(k,1264) + lu(k,1309) = lu(k,1309) - lu(k,1128) * lu(k,1294) + lu(k,1310) = lu(k,1310) - lu(k,1129) * lu(k,1294) + lu(k,1315) = lu(k,1315) - lu(k,1130) * lu(k,1294) + lu(k,1342) = lu(k,1342) - lu(k,1128) * lu(k,1327) + lu(k,1343) = lu(k,1343) - lu(k,1129) * lu(k,1327) + lu(k,1348) = lu(k,1348) - lu(k,1130) * lu(k,1327) + lu(k,1364) = lu(k,1364) - lu(k,1128) * lu(k,1353) + lu(k,1365) = lu(k,1365) - lu(k,1129) * lu(k,1353) + lu(k,1369) = lu(k,1369) - lu(k,1130) * lu(k,1353) + lu(k,1386) = lu(k,1386) - lu(k,1128) * lu(k,1375) + lu(k,1387) = lu(k,1387) - lu(k,1129) * lu(k,1375) + lu(k,1392) = lu(k,1392) - lu(k,1130) * lu(k,1375) + lu(k,1406) = lu(k,1406) - lu(k,1128) * lu(k,1398) + lu(k,1407) = lu(k,1407) - lu(k,1129) * lu(k,1398) + lu(k,1412) = lu(k,1412) - lu(k,1130) * lu(k,1398) + lu(k,1438) = lu(k,1438) - lu(k,1128) * lu(k,1422) + lu(k,1439) = lu(k,1439) - lu(k,1129) * lu(k,1422) + lu(k,1444) = lu(k,1444) - lu(k,1130) * lu(k,1422) + lu(k,1465) = lu(k,1465) - lu(k,1128) * lu(k,1461) + lu(k,1467) = lu(k,1467) - lu(k,1129) * lu(k,1461) + lu(k,1470) = lu(k,1470) - lu(k,1130) * lu(k,1461) + lu(k,1481) = lu(k,1481) - lu(k,1128) * lu(k,1475) + lu(k,1483) = lu(k,1483) - lu(k,1129) * lu(k,1475) + lu(k,1488) = lu(k,1488) - lu(k,1130) * lu(k,1475) + lu(k,1534) = lu(k,1534) - lu(k,1128) * lu(k,1526) + lu(k,1536) = lu(k,1536) - lu(k,1129) * lu(k,1526) + lu(k,1544) = lu(k,1544) - lu(k,1130) * lu(k,1526) + lu(k,1577) = lu(k,1577) - lu(k,1128) * lu(k,1565) + lu(k,1579) = lu(k,1579) - lu(k,1129) * lu(k,1565) + lu(k,1587) = lu(k,1587) - lu(k,1130) * lu(k,1565) + lu(k,1608) = lu(k,1608) - lu(k,1128) * lu(k,1599) + lu(k,1610) = lu(k,1610) - lu(k,1129) * lu(k,1599) + lu(k,1618) = lu(k,1618) - lu(k,1130) * lu(k,1599) + lu(k,1821) = lu(k,1821) - lu(k,1128) * lu(k,1797) + lu(k,1823) = lu(k,1823) - lu(k,1129) * lu(k,1797) + lu(k,1831) = lu(k,1831) - lu(k,1130) * lu(k,1797) + lu(k,1948) = lu(k,1948) - lu(k,1128) * lu(k,1926) + lu(k,1950) = lu(k,1950) - lu(k,1129) * lu(k,1926) + lu(k,1958) = lu(k,1958) - lu(k,1130) * lu(k,1926) + lu(k,2000) = lu(k,2000) - lu(k,1128) * lu(k,1980) + lu(k,2002) = lu(k,2002) - lu(k,1129) * lu(k,1980) + lu(k,2010) = lu(k,2010) - lu(k,1130) * lu(k,1980) + lu(k,2082) = lu(k,2082) - lu(k,1128) * lu(k,2059) + lu(k,2084) = lu(k,2084) - lu(k,1129) * lu(k,2059) + lu(k,2092) = lu(k,2092) - lu(k,1130) * lu(k,2059) + lu(k,2121) = lu(k,2121) - lu(k,1128) * lu(k,2112) + lu(k,2123) = lu(k,2123) - lu(k,1129) * lu(k,2112) + lu(k,2131) = lu(k,2131) - lu(k,1130) * lu(k,2112) + lu(k,2183) = lu(k,2183) - lu(k,1128) * lu(k,2162) + lu(k,2185) = lu(k,2185) - lu(k,1129) * lu(k,2162) + lu(k,2193) = lu(k,2193) - lu(k,1130) * lu(k,2162) + lu(k,2301) = lu(k,2301) - lu(k,1128) * lu(k,2279) + lu(k,2303) = lu(k,2303) - lu(k,1129) * lu(k,2279) + lu(k,2311) = lu(k,2311) - lu(k,1130) * lu(k,2279) + lu(k,1136) = 1._r8 / lu(k,1136) + lu(k,1137) = lu(k,1137) * lu(k,1136) + lu(k,1138) = lu(k,1138) * lu(k,1136) + lu(k,1139) = lu(k,1139) * lu(k,1136) + lu(k,1140) = lu(k,1140) * lu(k,1136) + lu(k,1141) = lu(k,1141) * lu(k,1136) + lu(k,1142) = lu(k,1142) * lu(k,1136) + lu(k,1143) = lu(k,1143) * lu(k,1136) + lu(k,1144) = lu(k,1144) * lu(k,1136) + lu(k,1145) = lu(k,1145) * lu(k,1136) + lu(k,1146) = lu(k,1146) * lu(k,1136) + lu(k,1147) = lu(k,1147) * lu(k,1136) + lu(k,1148) = lu(k,1148) * lu(k,1136) + lu(k,1296) = lu(k,1296) - lu(k,1137) * lu(k,1295) + lu(k,1297) = - lu(k,1138) * lu(k,1295) + lu(k,1305) = lu(k,1305) - lu(k,1139) * lu(k,1295) + lu(k,1306) = lu(k,1306) - lu(k,1140) * lu(k,1295) + lu(k,1307) = lu(k,1307) - lu(k,1141) * lu(k,1295) + lu(k,1308) = lu(k,1308) - lu(k,1142) * lu(k,1295) + lu(k,1309) = lu(k,1309) - lu(k,1143) * lu(k,1295) + lu(k,1310) = lu(k,1310) - lu(k,1144) * lu(k,1295) + lu(k,1312) = lu(k,1312) - lu(k,1145) * lu(k,1295) + lu(k,1313) = lu(k,1313) - lu(k,1146) * lu(k,1295) + lu(k,1315) = lu(k,1315) - lu(k,1147) * lu(k,1295) + lu(k,1316) = - lu(k,1148) * lu(k,1295) + lu(k,1329) = lu(k,1329) - lu(k,1137) * lu(k,1328) + lu(k,1330) = - lu(k,1138) * lu(k,1328) + lu(k,1338) = lu(k,1338) - lu(k,1139) * lu(k,1328) + lu(k,1339) = lu(k,1339) - lu(k,1140) * lu(k,1328) + lu(k,1340) = lu(k,1340) - lu(k,1141) * lu(k,1328) + lu(k,1341) = lu(k,1341) - lu(k,1142) * lu(k,1328) + lu(k,1342) = lu(k,1342) - lu(k,1143) * lu(k,1328) + lu(k,1343) = lu(k,1343) - lu(k,1144) * lu(k,1328) + lu(k,1345) = lu(k,1345) - lu(k,1145) * lu(k,1328) + lu(k,1346) = lu(k,1346) - lu(k,1146) * lu(k,1328) + lu(k,1348) = lu(k,1348) - lu(k,1147) * lu(k,1328) + lu(k,1349) = - lu(k,1148) * lu(k,1328) + lu(k,1355) = lu(k,1355) - lu(k,1137) * lu(k,1354) + lu(k,1356) = - lu(k,1138) * lu(k,1354) + lu(k,1360) = lu(k,1360) - lu(k,1139) * lu(k,1354) + lu(k,1361) = - lu(k,1140) * lu(k,1354) + lu(k,1362) = lu(k,1362) - lu(k,1141) * lu(k,1354) + lu(k,1363) = lu(k,1363) - lu(k,1142) * lu(k,1354) + lu(k,1364) = lu(k,1364) - lu(k,1143) * lu(k,1354) + lu(k,1365) = lu(k,1365) - lu(k,1144) * lu(k,1354) + lu(k,1367) = lu(k,1367) - lu(k,1145) * lu(k,1354) + lu(k,1368) = lu(k,1368) - lu(k,1146) * lu(k,1354) + lu(k,1369) = lu(k,1369) - lu(k,1147) * lu(k,1354) + lu(k,1370) = - lu(k,1148) * lu(k,1354) + lu(k,1799) = lu(k,1799) - lu(k,1137) * lu(k,1798) + lu(k,1802) = lu(k,1802) - lu(k,1138) * lu(k,1798) + lu(k,1813) = lu(k,1813) - lu(k,1139) * lu(k,1798) + lu(k,1817) = lu(k,1817) - lu(k,1140) * lu(k,1798) + lu(k,1819) = lu(k,1819) - lu(k,1141) * lu(k,1798) + lu(k,1820) = lu(k,1820) - lu(k,1142) * lu(k,1798) + lu(k,1821) = lu(k,1821) - lu(k,1143) * lu(k,1798) + lu(k,1823) = lu(k,1823) - lu(k,1144) * lu(k,1798) + lu(k,1826) = lu(k,1826) - lu(k,1145) * lu(k,1798) + lu(k,1828) = lu(k,1828) - lu(k,1146) * lu(k,1798) + lu(k,1831) = lu(k,1831) - lu(k,1147) * lu(k,1798) + lu(k,1833) = lu(k,1833) - lu(k,1148) * lu(k,1798) + lu(k,1928) = lu(k,1928) - lu(k,1137) * lu(k,1927) + lu(k,1931) = lu(k,1931) - lu(k,1138) * lu(k,1927) + lu(k,1941) = lu(k,1941) - lu(k,1139) * lu(k,1927) + lu(k,1944) = lu(k,1944) - lu(k,1140) * lu(k,1927) + lu(k,1946) = lu(k,1946) - lu(k,1141) * lu(k,1927) + lu(k,1947) = lu(k,1947) - lu(k,1142) * lu(k,1927) + lu(k,1948) = lu(k,1948) - lu(k,1143) * lu(k,1927) + lu(k,1950) = lu(k,1950) - lu(k,1144) * lu(k,1927) + lu(k,1953) = lu(k,1953) - lu(k,1145) * lu(k,1927) + lu(k,1955) = lu(k,1955) - lu(k,1146) * lu(k,1927) + lu(k,1958) = lu(k,1958) - lu(k,1147) * lu(k,1927) + lu(k,1960) = lu(k,1960) - lu(k,1148) * lu(k,1927) + lu(k,2061) = lu(k,2061) - lu(k,1137) * lu(k,2060) + lu(k,2064) = lu(k,2064) - lu(k,1138) * lu(k,2060) + lu(k,2075) = lu(k,2075) - lu(k,1139) * lu(k,2060) + lu(k,2078) = lu(k,2078) - lu(k,1140) * lu(k,2060) + lu(k,2080) = lu(k,2080) - lu(k,1141) * lu(k,2060) + lu(k,2081) = lu(k,2081) - lu(k,1142) * lu(k,2060) + lu(k,2082) = lu(k,2082) - lu(k,1143) * lu(k,2060) + lu(k,2084) = lu(k,2084) - lu(k,1144) * lu(k,2060) + lu(k,2087) = lu(k,2087) - lu(k,1145) * lu(k,2060) + lu(k,2089) = lu(k,2089) - lu(k,1146) * lu(k,2060) + lu(k,2092) = lu(k,2092) - lu(k,1147) * lu(k,2060) + lu(k,2094) = lu(k,2094) - lu(k,1148) * lu(k,2060) + end do + end subroutine lu_fac23 + subroutine lu_fac24( 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,1149) = 1._r8 / lu(k,1149) + lu(k,1150) = lu(k,1150) * lu(k,1149) + lu(k,1151) = lu(k,1151) * lu(k,1149) + lu(k,1152) = lu(k,1152) * lu(k,1149) + lu(k,1153) = lu(k,1153) * lu(k,1149) + lu(k,1154) = lu(k,1154) * lu(k,1149) + lu(k,1201) = lu(k,1201) - lu(k,1150) * lu(k,1199) + lu(k,1202) = lu(k,1202) - lu(k,1151) * lu(k,1199) + lu(k,1203) = lu(k,1203) - lu(k,1152) * lu(k,1199) + lu(k,1205) = lu(k,1205) - lu(k,1153) * lu(k,1199) + lu(k,1208) = lu(k,1208) - lu(k,1154) * lu(k,1199) + lu(k,1218) = lu(k,1218) - lu(k,1150) * lu(k,1216) + lu(k,1219) = lu(k,1219) - lu(k,1151) * lu(k,1216) + lu(k,1220) = lu(k,1220) - lu(k,1152) * lu(k,1216) + lu(k,1223) = lu(k,1223) - lu(k,1153) * lu(k,1216) + lu(k,1227) = lu(k,1227) - lu(k,1154) * lu(k,1216) + lu(k,1300) = - lu(k,1150) * lu(k,1296) + lu(k,1305) = lu(k,1305) - lu(k,1151) * lu(k,1296) + lu(k,1307) = lu(k,1307) - lu(k,1152) * lu(k,1296) + lu(k,1310) = lu(k,1310) - lu(k,1153) * lu(k,1296) + lu(k,1315) = lu(k,1315) - lu(k,1154) * lu(k,1296) + lu(k,1333) = lu(k,1333) - lu(k,1150) * lu(k,1329) + lu(k,1338) = lu(k,1338) - lu(k,1151) * lu(k,1329) + lu(k,1340) = lu(k,1340) - lu(k,1152) * lu(k,1329) + lu(k,1343) = lu(k,1343) - lu(k,1153) * lu(k,1329) + lu(k,1348) = lu(k,1348) - lu(k,1154) * lu(k,1329) + lu(k,1357) = lu(k,1357) - lu(k,1150) * lu(k,1355) + lu(k,1360) = lu(k,1360) - lu(k,1151) * lu(k,1355) + lu(k,1362) = lu(k,1362) - lu(k,1152) * lu(k,1355) + lu(k,1365) = lu(k,1365) - lu(k,1153) * lu(k,1355) + lu(k,1369) = lu(k,1369) - lu(k,1154) * lu(k,1355) + lu(k,1377) = lu(k,1377) - lu(k,1150) * lu(k,1376) + lu(k,1381) = lu(k,1381) - lu(k,1151) * lu(k,1376) + lu(k,1384) = lu(k,1384) - lu(k,1152) * lu(k,1376) + lu(k,1387) = lu(k,1387) - lu(k,1153) * lu(k,1376) + lu(k,1392) = lu(k,1392) - lu(k,1154) * lu(k,1376) + lu(k,1400) = - lu(k,1150) * lu(k,1399) + lu(k,1402) = lu(k,1402) - lu(k,1151) * lu(k,1399) + lu(k,1404) = lu(k,1404) - lu(k,1152) * lu(k,1399) + lu(k,1407) = lu(k,1407) - lu(k,1153) * lu(k,1399) + lu(k,1412) = lu(k,1412) - lu(k,1154) * lu(k,1399) + lu(k,1427) = lu(k,1427) - lu(k,1150) * lu(k,1423) + lu(k,1433) = lu(k,1433) - lu(k,1151) * lu(k,1423) + lu(k,1436) = lu(k,1436) - lu(k,1152) * lu(k,1423) + lu(k,1439) = lu(k,1439) - lu(k,1153) * lu(k,1423) + lu(k,1444) = lu(k,1444) - lu(k,1154) * lu(k,1423) + lu(k,1567) = lu(k,1567) - lu(k,1150) * lu(k,1566) + lu(k,1570) = lu(k,1570) - lu(k,1151) * lu(k,1566) + lu(k,1575) = lu(k,1575) - lu(k,1152) * lu(k,1566) + lu(k,1579) = lu(k,1579) - lu(k,1153) * lu(k,1566) + lu(k,1587) = lu(k,1587) - lu(k,1154) * lu(k,1566) + lu(k,1806) = lu(k,1806) - lu(k,1150) * lu(k,1799) + lu(k,1813) = lu(k,1813) - lu(k,1151) * lu(k,1799) + lu(k,1819) = lu(k,1819) - lu(k,1152) * lu(k,1799) + lu(k,1823) = lu(k,1823) - lu(k,1153) * lu(k,1799) + lu(k,1831) = lu(k,1831) - lu(k,1154) * lu(k,1799) + lu(k,1935) = lu(k,1935) - lu(k,1150) * lu(k,1928) + lu(k,1941) = lu(k,1941) - lu(k,1151) * lu(k,1928) + lu(k,1946) = lu(k,1946) - lu(k,1152) * lu(k,1928) + lu(k,1950) = lu(k,1950) - lu(k,1153) * lu(k,1928) + lu(k,1958) = lu(k,1958) - lu(k,1154) * lu(k,1928) + lu(k,1988) = lu(k,1988) - lu(k,1150) * lu(k,1981) + lu(k,1994) = lu(k,1994) - lu(k,1151) * lu(k,1981) + lu(k,1998) = lu(k,1998) - lu(k,1152) * lu(k,1981) + lu(k,2002) = lu(k,2002) - lu(k,1153) * lu(k,1981) + lu(k,2010) = lu(k,2010) - lu(k,1154) * lu(k,1981) + lu(k,2068) = lu(k,2068) - lu(k,1150) * lu(k,2061) + lu(k,2075) = lu(k,2075) - lu(k,1151) * lu(k,2061) + lu(k,2080) = lu(k,2080) - lu(k,1152) * lu(k,2061) + lu(k,2084) = lu(k,2084) - lu(k,1153) * lu(k,2061) + lu(k,2092) = lu(k,2092) - lu(k,1154) * lu(k,2061) + lu(k,2169) = lu(k,2169) - lu(k,1150) * lu(k,2163) + lu(k,2176) = lu(k,2176) - lu(k,1151) * lu(k,2163) + lu(k,2181) = lu(k,2181) - lu(k,1152) * lu(k,2163) + lu(k,2185) = lu(k,2185) - lu(k,1153) * lu(k,2163) + lu(k,2193) = lu(k,2193) - lu(k,1154) * lu(k,2163) + lu(k,2287) = lu(k,2287) - lu(k,1150) * lu(k,2280) + lu(k,2293) = lu(k,2293) - lu(k,1151) * lu(k,2280) + lu(k,2299) = lu(k,2299) - lu(k,1152) * lu(k,2280) + lu(k,2303) = lu(k,2303) - lu(k,1153) * lu(k,2280) + lu(k,2311) = lu(k,2311) - lu(k,1154) * lu(k,2280) + lu(k,1163) = 1._r8 / lu(k,1163) + lu(k,1164) = lu(k,1164) * lu(k,1163) + lu(k,1165) = lu(k,1165) * lu(k,1163) + lu(k,1166) = lu(k,1166) * lu(k,1163) + lu(k,1167) = lu(k,1167) * lu(k,1163) + lu(k,1168) = lu(k,1168) * lu(k,1163) + lu(k,1169) = lu(k,1169) * lu(k,1163) + lu(k,1170) = lu(k,1170) * lu(k,1163) + lu(k,1171) = lu(k,1171) * lu(k,1163) + lu(k,1172) = lu(k,1172) * lu(k,1163) + lu(k,1173) = lu(k,1173) * lu(k,1163) + lu(k,1174) = lu(k,1174) * lu(k,1163) + lu(k,1185) = lu(k,1185) - lu(k,1164) * lu(k,1183) + lu(k,1186) = lu(k,1186) - lu(k,1165) * lu(k,1183) + lu(k,1187) = lu(k,1187) - lu(k,1166) * lu(k,1183) + lu(k,1188) = lu(k,1188) - lu(k,1167) * lu(k,1183) + lu(k,1189) = lu(k,1189) - lu(k,1168) * lu(k,1183) + lu(k,1190) = lu(k,1190) - lu(k,1169) * lu(k,1183) + lu(k,1191) = lu(k,1191) - lu(k,1170) * lu(k,1183) + lu(k,1192) = lu(k,1192) - lu(k,1171) * lu(k,1183) + lu(k,1193) = lu(k,1193) - lu(k,1172) * lu(k,1183) + lu(k,1195) = lu(k,1195) - lu(k,1173) * lu(k,1183) + lu(k,1196) = lu(k,1196) - lu(k,1174) * lu(k,1183) + lu(k,1802) = lu(k,1802) - lu(k,1164) * lu(k,1800) + lu(k,1813) = lu(k,1813) - lu(k,1165) * lu(k,1800) + lu(k,1817) = lu(k,1817) - lu(k,1166) * lu(k,1800) + lu(k,1819) = lu(k,1819) - lu(k,1167) * lu(k,1800) + lu(k,1820) = lu(k,1820) - lu(k,1168) * lu(k,1800) + lu(k,1821) = lu(k,1821) - lu(k,1169) * lu(k,1800) + lu(k,1823) = lu(k,1823) - lu(k,1170) * lu(k,1800) + lu(k,1825) = lu(k,1825) - lu(k,1171) * lu(k,1800) + lu(k,1826) = lu(k,1826) - lu(k,1172) * lu(k,1800) + lu(k,1831) = lu(k,1831) - lu(k,1173) * lu(k,1800) + lu(k,1833) = lu(k,1833) - lu(k,1174) * lu(k,1800) + lu(k,1931) = lu(k,1931) - lu(k,1164) * lu(k,1929) + lu(k,1941) = lu(k,1941) - lu(k,1165) * lu(k,1929) + lu(k,1944) = lu(k,1944) - lu(k,1166) * lu(k,1929) + lu(k,1946) = lu(k,1946) - lu(k,1167) * lu(k,1929) + lu(k,1947) = lu(k,1947) - lu(k,1168) * lu(k,1929) + lu(k,1948) = lu(k,1948) - lu(k,1169) * lu(k,1929) + lu(k,1950) = lu(k,1950) - lu(k,1170) * lu(k,1929) + lu(k,1952) = lu(k,1952) - lu(k,1171) * lu(k,1929) + lu(k,1953) = lu(k,1953) - lu(k,1172) * lu(k,1929) + lu(k,1958) = lu(k,1958) - lu(k,1173) * lu(k,1929) + lu(k,1960) = lu(k,1960) - lu(k,1174) * lu(k,1929) + lu(k,1984) = lu(k,1984) - lu(k,1164) * lu(k,1982) + lu(k,1994) = lu(k,1994) - lu(k,1165) * lu(k,1982) + lu(k,1996) = lu(k,1996) - lu(k,1166) * lu(k,1982) + lu(k,1998) = lu(k,1998) - lu(k,1167) * lu(k,1982) + lu(k,1999) = lu(k,1999) - lu(k,1168) * lu(k,1982) + lu(k,2000) = lu(k,2000) - lu(k,1169) * lu(k,1982) + lu(k,2002) = lu(k,2002) - lu(k,1170) * lu(k,1982) + lu(k,2004) = lu(k,2004) - lu(k,1171) * lu(k,1982) + lu(k,2005) = lu(k,2005) - lu(k,1172) * lu(k,1982) + lu(k,2010) = lu(k,2010) - lu(k,1173) * lu(k,1982) + lu(k,2012) = lu(k,2012) - lu(k,1174) * lu(k,1982) + lu(k,2064) = lu(k,2064) - lu(k,1164) * lu(k,2062) + lu(k,2075) = lu(k,2075) - lu(k,1165) * lu(k,2062) + lu(k,2078) = lu(k,2078) - lu(k,1166) * lu(k,2062) + lu(k,2080) = lu(k,2080) - lu(k,1167) * lu(k,2062) + lu(k,2081) = lu(k,2081) - lu(k,1168) * lu(k,2062) + lu(k,2082) = lu(k,2082) - lu(k,1169) * lu(k,2062) + lu(k,2084) = lu(k,2084) - lu(k,1170) * lu(k,2062) + lu(k,2086) = lu(k,2086) - lu(k,1171) * lu(k,2062) + lu(k,2087) = lu(k,2087) - lu(k,1172) * lu(k,2062) + lu(k,2092) = lu(k,2092) - lu(k,1173) * lu(k,2062) + lu(k,2094) = lu(k,2094) - lu(k,1174) * lu(k,2062) + lu(k,2166) = lu(k,2166) - lu(k,1164) * lu(k,2164) + lu(k,2176) = lu(k,2176) - lu(k,1165) * lu(k,2164) + lu(k,2179) = lu(k,2179) - lu(k,1166) * lu(k,2164) + lu(k,2181) = lu(k,2181) - lu(k,1167) * lu(k,2164) + lu(k,2182) = lu(k,2182) - lu(k,1168) * lu(k,2164) + lu(k,2183) = lu(k,2183) - lu(k,1169) * lu(k,2164) + lu(k,2185) = lu(k,2185) - lu(k,1170) * lu(k,2164) + lu(k,2187) = lu(k,2187) - lu(k,1171) * lu(k,2164) + lu(k,2188) = lu(k,2188) - lu(k,1172) * lu(k,2164) + lu(k,2193) = lu(k,2193) - lu(k,1173) * lu(k,2164) + lu(k,2195) = lu(k,2195) - lu(k,1174) * lu(k,2164) + lu(k,2283) = lu(k,2283) - lu(k,1164) * lu(k,2281) + lu(k,2293) = lu(k,2293) - lu(k,1165) * lu(k,2281) + lu(k,2297) = lu(k,2297) - lu(k,1166) * lu(k,2281) + lu(k,2299) = lu(k,2299) - lu(k,1167) * lu(k,2281) + lu(k,2300) = lu(k,2300) - lu(k,1168) * lu(k,2281) + lu(k,2301) = lu(k,2301) - lu(k,1169) * lu(k,2281) + lu(k,2303) = lu(k,2303) - lu(k,1170) * lu(k,2281) + lu(k,2305) = lu(k,2305) - lu(k,1171) * lu(k,2281) + lu(k,2306) = lu(k,2306) - lu(k,1172) * lu(k,2281) + lu(k,2311) = lu(k,2311) - lu(k,1173) * lu(k,2281) + lu(k,2313) = lu(k,2313) - lu(k,1174) * lu(k,2281) + lu(k,1184) = 1._r8 / lu(k,1184) + lu(k,1185) = lu(k,1185) * lu(k,1184) + lu(k,1186) = lu(k,1186) * lu(k,1184) + lu(k,1187) = lu(k,1187) * lu(k,1184) + lu(k,1188) = lu(k,1188) * lu(k,1184) + lu(k,1189) = lu(k,1189) * lu(k,1184) + lu(k,1190) = lu(k,1190) * lu(k,1184) + lu(k,1191) = lu(k,1191) * lu(k,1184) + lu(k,1192) = lu(k,1192) * lu(k,1184) + lu(k,1193) = lu(k,1193) * lu(k,1184) + lu(k,1194) = lu(k,1194) * lu(k,1184) + lu(k,1195) = lu(k,1195) * lu(k,1184) + lu(k,1196) = lu(k,1196) * lu(k,1184) + lu(k,1802) = lu(k,1802) - lu(k,1185) * lu(k,1801) + lu(k,1813) = lu(k,1813) - lu(k,1186) * lu(k,1801) + lu(k,1817) = lu(k,1817) - lu(k,1187) * lu(k,1801) + lu(k,1819) = lu(k,1819) - lu(k,1188) * lu(k,1801) + lu(k,1820) = lu(k,1820) - lu(k,1189) * lu(k,1801) + lu(k,1821) = lu(k,1821) - lu(k,1190) * lu(k,1801) + lu(k,1823) = lu(k,1823) - lu(k,1191) * lu(k,1801) + lu(k,1825) = lu(k,1825) - lu(k,1192) * lu(k,1801) + lu(k,1826) = lu(k,1826) - lu(k,1193) * lu(k,1801) + lu(k,1828) = lu(k,1828) - lu(k,1194) * lu(k,1801) + lu(k,1831) = lu(k,1831) - lu(k,1195) * lu(k,1801) + lu(k,1833) = lu(k,1833) - lu(k,1196) * lu(k,1801) + lu(k,1931) = lu(k,1931) - lu(k,1185) * lu(k,1930) + lu(k,1941) = lu(k,1941) - lu(k,1186) * lu(k,1930) + lu(k,1944) = lu(k,1944) - lu(k,1187) * lu(k,1930) + lu(k,1946) = lu(k,1946) - lu(k,1188) * lu(k,1930) + lu(k,1947) = lu(k,1947) - lu(k,1189) * lu(k,1930) + lu(k,1948) = lu(k,1948) - lu(k,1190) * lu(k,1930) + lu(k,1950) = lu(k,1950) - lu(k,1191) * lu(k,1930) + lu(k,1952) = lu(k,1952) - lu(k,1192) * lu(k,1930) + lu(k,1953) = lu(k,1953) - lu(k,1193) * lu(k,1930) + lu(k,1955) = lu(k,1955) - lu(k,1194) * lu(k,1930) + lu(k,1958) = lu(k,1958) - lu(k,1195) * lu(k,1930) + lu(k,1960) = lu(k,1960) - lu(k,1196) * lu(k,1930) + lu(k,1984) = lu(k,1984) - lu(k,1185) * lu(k,1983) + lu(k,1994) = lu(k,1994) - lu(k,1186) * lu(k,1983) + lu(k,1996) = lu(k,1996) - lu(k,1187) * lu(k,1983) + lu(k,1998) = lu(k,1998) - lu(k,1188) * lu(k,1983) + lu(k,1999) = lu(k,1999) - lu(k,1189) * lu(k,1983) + lu(k,2000) = lu(k,2000) - lu(k,1190) * lu(k,1983) + lu(k,2002) = lu(k,2002) - lu(k,1191) * lu(k,1983) + lu(k,2004) = lu(k,2004) - lu(k,1192) * lu(k,1983) + lu(k,2005) = lu(k,2005) - lu(k,1193) * lu(k,1983) + lu(k,2007) = lu(k,2007) - lu(k,1194) * lu(k,1983) + lu(k,2010) = lu(k,2010) - lu(k,1195) * lu(k,1983) + lu(k,2012) = lu(k,2012) - lu(k,1196) * lu(k,1983) + lu(k,2064) = lu(k,2064) - lu(k,1185) * lu(k,2063) + lu(k,2075) = lu(k,2075) - lu(k,1186) * lu(k,2063) + lu(k,2078) = lu(k,2078) - lu(k,1187) * lu(k,2063) + lu(k,2080) = lu(k,2080) - lu(k,1188) * lu(k,2063) + lu(k,2081) = lu(k,2081) - lu(k,1189) * lu(k,2063) + lu(k,2082) = lu(k,2082) - lu(k,1190) * lu(k,2063) + lu(k,2084) = lu(k,2084) - lu(k,1191) * lu(k,2063) + lu(k,2086) = lu(k,2086) - lu(k,1192) * lu(k,2063) + lu(k,2087) = lu(k,2087) - lu(k,1193) * lu(k,2063) + lu(k,2089) = lu(k,2089) - lu(k,1194) * lu(k,2063) + lu(k,2092) = lu(k,2092) - lu(k,1195) * lu(k,2063) + lu(k,2094) = lu(k,2094) - lu(k,1196) * lu(k,2063) + lu(k,2166) = lu(k,2166) - lu(k,1185) * lu(k,2165) + lu(k,2176) = lu(k,2176) - lu(k,1186) * lu(k,2165) + lu(k,2179) = lu(k,2179) - lu(k,1187) * lu(k,2165) + lu(k,2181) = lu(k,2181) - lu(k,1188) * lu(k,2165) + lu(k,2182) = lu(k,2182) - lu(k,1189) * lu(k,2165) + lu(k,2183) = lu(k,2183) - lu(k,1190) * lu(k,2165) + lu(k,2185) = lu(k,2185) - lu(k,1191) * lu(k,2165) + lu(k,2187) = lu(k,2187) - lu(k,1192) * lu(k,2165) + lu(k,2188) = lu(k,2188) - lu(k,1193) * lu(k,2165) + lu(k,2190) = lu(k,2190) - lu(k,1194) * lu(k,2165) + lu(k,2193) = lu(k,2193) - lu(k,1195) * lu(k,2165) + lu(k,2195) = lu(k,2195) - lu(k,1196) * lu(k,2165) + lu(k,2283) = lu(k,2283) - lu(k,1185) * lu(k,2282) + lu(k,2293) = lu(k,2293) - lu(k,1186) * lu(k,2282) + lu(k,2297) = lu(k,2297) - lu(k,1187) * lu(k,2282) + lu(k,2299) = lu(k,2299) - lu(k,1188) * lu(k,2282) + lu(k,2300) = lu(k,2300) - lu(k,1189) * lu(k,2282) + lu(k,2301) = lu(k,2301) - lu(k,1190) * lu(k,2282) + lu(k,2303) = lu(k,2303) - lu(k,1191) * lu(k,2282) + lu(k,2305) = lu(k,2305) - lu(k,1192) * lu(k,2282) + lu(k,2306) = lu(k,2306) - lu(k,1193) * lu(k,2282) + lu(k,2308) = lu(k,2308) - lu(k,1194) * lu(k,2282) + lu(k,2311) = lu(k,2311) - lu(k,1195) * lu(k,2282) + lu(k,2313) = lu(k,2313) - lu(k,1196) * lu(k,2282) + lu(k,1200) = 1._r8 / lu(k,1200) + lu(k,1201) = lu(k,1201) * lu(k,1200) + lu(k,1202) = lu(k,1202) * lu(k,1200) + lu(k,1203) = lu(k,1203) * lu(k,1200) + lu(k,1204) = lu(k,1204) * lu(k,1200) + lu(k,1205) = lu(k,1205) * lu(k,1200) + lu(k,1206) = lu(k,1206) * lu(k,1200) + lu(k,1207) = lu(k,1207) * lu(k,1200) + lu(k,1208) = lu(k,1208) * lu(k,1200) + lu(k,1209) = lu(k,1209) * lu(k,1200) + lu(k,1300) = lu(k,1300) - lu(k,1201) * lu(k,1297) + lu(k,1305) = lu(k,1305) - lu(k,1202) * lu(k,1297) + lu(k,1307) = lu(k,1307) - lu(k,1203) * lu(k,1297) + lu(k,1308) = lu(k,1308) - lu(k,1204) * lu(k,1297) + lu(k,1310) = lu(k,1310) - lu(k,1205) * lu(k,1297) + lu(k,1311) = lu(k,1311) - lu(k,1206) * lu(k,1297) + lu(k,1312) = lu(k,1312) - lu(k,1207) * lu(k,1297) + lu(k,1315) = lu(k,1315) - lu(k,1208) * lu(k,1297) + lu(k,1316) = lu(k,1316) - lu(k,1209) * lu(k,1297) + lu(k,1333) = lu(k,1333) - lu(k,1201) * lu(k,1330) + lu(k,1338) = lu(k,1338) - lu(k,1202) * lu(k,1330) + lu(k,1340) = lu(k,1340) - lu(k,1203) * lu(k,1330) + lu(k,1341) = lu(k,1341) - lu(k,1204) * lu(k,1330) + lu(k,1343) = lu(k,1343) - lu(k,1205) * lu(k,1330) + lu(k,1344) = lu(k,1344) - lu(k,1206) * lu(k,1330) + lu(k,1345) = lu(k,1345) - lu(k,1207) * lu(k,1330) + lu(k,1348) = lu(k,1348) - lu(k,1208) * lu(k,1330) + lu(k,1349) = lu(k,1349) - lu(k,1209) * lu(k,1330) + lu(k,1357) = lu(k,1357) - lu(k,1201) * lu(k,1356) + lu(k,1360) = lu(k,1360) - lu(k,1202) * lu(k,1356) + lu(k,1362) = lu(k,1362) - lu(k,1203) * lu(k,1356) + lu(k,1363) = lu(k,1363) - lu(k,1204) * lu(k,1356) + lu(k,1365) = lu(k,1365) - lu(k,1205) * lu(k,1356) + lu(k,1366) = lu(k,1366) - lu(k,1206) * lu(k,1356) + lu(k,1367) = lu(k,1367) - lu(k,1207) * lu(k,1356) + lu(k,1369) = lu(k,1369) - lu(k,1208) * lu(k,1356) + lu(k,1370) = lu(k,1370) - lu(k,1209) * lu(k,1356) + lu(k,1806) = lu(k,1806) - lu(k,1201) * lu(k,1802) + lu(k,1813) = lu(k,1813) - lu(k,1202) * lu(k,1802) + lu(k,1819) = lu(k,1819) - lu(k,1203) * lu(k,1802) + lu(k,1820) = lu(k,1820) - lu(k,1204) * lu(k,1802) + lu(k,1823) = lu(k,1823) - lu(k,1205) * lu(k,1802) + lu(k,1825) = lu(k,1825) - lu(k,1206) * lu(k,1802) + lu(k,1826) = lu(k,1826) - lu(k,1207) * lu(k,1802) + lu(k,1831) = lu(k,1831) - lu(k,1208) * lu(k,1802) + lu(k,1833) = lu(k,1833) - lu(k,1209) * lu(k,1802) + lu(k,1935) = lu(k,1935) - lu(k,1201) * lu(k,1931) + lu(k,1941) = lu(k,1941) - lu(k,1202) * lu(k,1931) + lu(k,1946) = lu(k,1946) - lu(k,1203) * lu(k,1931) + lu(k,1947) = lu(k,1947) - lu(k,1204) * lu(k,1931) + lu(k,1950) = lu(k,1950) - lu(k,1205) * lu(k,1931) + lu(k,1952) = lu(k,1952) - lu(k,1206) * lu(k,1931) + lu(k,1953) = lu(k,1953) - lu(k,1207) * lu(k,1931) + lu(k,1958) = lu(k,1958) - lu(k,1208) * lu(k,1931) + lu(k,1960) = lu(k,1960) - lu(k,1209) * lu(k,1931) + lu(k,1988) = lu(k,1988) - lu(k,1201) * lu(k,1984) + lu(k,1994) = lu(k,1994) - lu(k,1202) * lu(k,1984) + lu(k,1998) = lu(k,1998) - lu(k,1203) * lu(k,1984) + lu(k,1999) = lu(k,1999) - lu(k,1204) * lu(k,1984) + lu(k,2002) = lu(k,2002) - lu(k,1205) * lu(k,1984) + lu(k,2004) = lu(k,2004) - lu(k,1206) * lu(k,1984) + lu(k,2005) = lu(k,2005) - lu(k,1207) * lu(k,1984) + lu(k,2010) = lu(k,2010) - lu(k,1208) * lu(k,1984) + lu(k,2012) = lu(k,2012) - lu(k,1209) * lu(k,1984) + lu(k,2068) = lu(k,2068) - lu(k,1201) * lu(k,2064) + lu(k,2075) = lu(k,2075) - lu(k,1202) * lu(k,2064) + lu(k,2080) = lu(k,2080) - lu(k,1203) * lu(k,2064) + lu(k,2081) = lu(k,2081) - lu(k,1204) * lu(k,2064) + lu(k,2084) = lu(k,2084) - lu(k,1205) * lu(k,2064) + lu(k,2086) = lu(k,2086) - lu(k,1206) * lu(k,2064) + lu(k,2087) = lu(k,2087) - lu(k,1207) * lu(k,2064) + lu(k,2092) = lu(k,2092) - lu(k,1208) * lu(k,2064) + lu(k,2094) = lu(k,2094) - lu(k,1209) * lu(k,2064) + lu(k,2169) = lu(k,2169) - lu(k,1201) * lu(k,2166) + lu(k,2176) = lu(k,2176) - lu(k,1202) * lu(k,2166) + lu(k,2181) = lu(k,2181) - lu(k,1203) * lu(k,2166) + lu(k,2182) = lu(k,2182) - lu(k,1204) * lu(k,2166) + lu(k,2185) = lu(k,2185) - lu(k,1205) * lu(k,2166) + lu(k,2187) = lu(k,2187) - lu(k,1206) * lu(k,2166) + lu(k,2188) = lu(k,2188) - lu(k,1207) * lu(k,2166) + lu(k,2193) = lu(k,2193) - lu(k,1208) * lu(k,2166) + lu(k,2195) = lu(k,2195) - lu(k,1209) * lu(k,2166) + lu(k,2287) = lu(k,2287) - lu(k,1201) * lu(k,2283) + lu(k,2293) = lu(k,2293) - lu(k,1202) * lu(k,2283) + lu(k,2299) = lu(k,2299) - lu(k,1203) * lu(k,2283) + lu(k,2300) = lu(k,2300) - lu(k,1204) * lu(k,2283) + lu(k,2303) = lu(k,2303) - lu(k,1205) * lu(k,2283) + lu(k,2305) = lu(k,2305) - lu(k,1206) * lu(k,2283) + lu(k,2306) = lu(k,2306) - lu(k,1207) * lu(k,2283) + lu(k,2311) = lu(k,2311) - lu(k,1208) * lu(k,2283) + lu(k,2313) = lu(k,2313) - lu(k,1209) * lu(k,2283) + 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,1221) = lu(k,1221) * lu(k,1217) + lu(k,1222) = lu(k,1222) * lu(k,1217) + lu(k,1223) = lu(k,1223) * lu(k,1217) + lu(k,1224) = lu(k,1224) * lu(k,1217) + lu(k,1225) = lu(k,1225) * lu(k,1217) + lu(k,1226) = lu(k,1226) * lu(k,1217) + lu(k,1227) = lu(k,1227) * lu(k,1217) + lu(k,1239) = lu(k,1239) - lu(k,1218) * lu(k,1236) + lu(k,1241) = lu(k,1241) - lu(k,1219) * lu(k,1236) + lu(k,1243) = lu(k,1243) - lu(k,1220) * lu(k,1236) + lu(k,1244) = lu(k,1244) - lu(k,1221) * lu(k,1236) + lu(k,1245) = lu(k,1245) - lu(k,1222) * lu(k,1236) + lu(k,1246) = lu(k,1246) - lu(k,1223) * lu(k,1236) + lu(k,1247) = lu(k,1247) - lu(k,1224) * lu(k,1236) + lu(k,1248) = lu(k,1248) - lu(k,1225) * lu(k,1236) + lu(k,1249) = lu(k,1249) - lu(k,1226) * lu(k,1236) + lu(k,1250) = lu(k,1250) - lu(k,1227) * lu(k,1236) + lu(k,1300) = lu(k,1300) - lu(k,1218) * lu(k,1298) + lu(k,1305) = lu(k,1305) - lu(k,1219) * lu(k,1298) + lu(k,1307) = lu(k,1307) - lu(k,1220) * lu(k,1298) + lu(k,1308) = lu(k,1308) - lu(k,1221) * lu(k,1298) + lu(k,1309) = lu(k,1309) - lu(k,1222) * lu(k,1298) + lu(k,1310) = lu(k,1310) - lu(k,1223) * lu(k,1298) + lu(k,1311) = lu(k,1311) - lu(k,1224) * lu(k,1298) + lu(k,1312) = lu(k,1312) - lu(k,1225) * lu(k,1298) + lu(k,1313) = lu(k,1313) - lu(k,1226) * lu(k,1298) + lu(k,1315) = lu(k,1315) - lu(k,1227) * lu(k,1298) + lu(k,1333) = lu(k,1333) - lu(k,1218) * lu(k,1331) + lu(k,1338) = lu(k,1338) - lu(k,1219) * lu(k,1331) + lu(k,1340) = lu(k,1340) - lu(k,1220) * lu(k,1331) + lu(k,1341) = lu(k,1341) - lu(k,1221) * lu(k,1331) + lu(k,1342) = lu(k,1342) - lu(k,1222) * lu(k,1331) + lu(k,1343) = lu(k,1343) - lu(k,1223) * lu(k,1331) + lu(k,1344) = lu(k,1344) - lu(k,1224) * lu(k,1331) + lu(k,1345) = lu(k,1345) - lu(k,1225) * lu(k,1331) + lu(k,1346) = lu(k,1346) - lu(k,1226) * lu(k,1331) + lu(k,1348) = lu(k,1348) - lu(k,1227) * lu(k,1331) + lu(k,1427) = lu(k,1427) - lu(k,1218) * lu(k,1424) + lu(k,1433) = lu(k,1433) - lu(k,1219) * lu(k,1424) + lu(k,1436) = lu(k,1436) - lu(k,1220) * lu(k,1424) + lu(k,1437) = lu(k,1437) - lu(k,1221) * lu(k,1424) + lu(k,1438) = lu(k,1438) - lu(k,1222) * lu(k,1424) + lu(k,1439) = lu(k,1439) - lu(k,1223) * lu(k,1424) + lu(k,1440) = lu(k,1440) - lu(k,1224) * lu(k,1424) + lu(k,1441) = lu(k,1441) - lu(k,1225) * lu(k,1424) + lu(k,1442) = lu(k,1442) - lu(k,1226) * lu(k,1424) + lu(k,1444) = lu(k,1444) - lu(k,1227) * lu(k,1424) + lu(k,1806) = lu(k,1806) - lu(k,1218) * lu(k,1803) + lu(k,1813) = lu(k,1813) - lu(k,1219) * lu(k,1803) + lu(k,1819) = lu(k,1819) - lu(k,1220) * lu(k,1803) + lu(k,1820) = lu(k,1820) - lu(k,1221) * lu(k,1803) + lu(k,1821) = lu(k,1821) - lu(k,1222) * lu(k,1803) + lu(k,1823) = lu(k,1823) - lu(k,1223) * lu(k,1803) + lu(k,1825) = lu(k,1825) - lu(k,1224) * lu(k,1803) + lu(k,1826) = lu(k,1826) - lu(k,1225) * lu(k,1803) + lu(k,1828) = lu(k,1828) - lu(k,1226) * lu(k,1803) + lu(k,1831) = lu(k,1831) - lu(k,1227) * lu(k,1803) + lu(k,1935) = lu(k,1935) - lu(k,1218) * lu(k,1932) + lu(k,1941) = lu(k,1941) - lu(k,1219) * lu(k,1932) + lu(k,1946) = lu(k,1946) - lu(k,1220) * lu(k,1932) + lu(k,1947) = lu(k,1947) - lu(k,1221) * lu(k,1932) + lu(k,1948) = lu(k,1948) - lu(k,1222) * lu(k,1932) + lu(k,1950) = lu(k,1950) - lu(k,1223) * lu(k,1932) + lu(k,1952) = lu(k,1952) - lu(k,1224) * lu(k,1932) + lu(k,1953) = lu(k,1953) - lu(k,1225) * lu(k,1932) + lu(k,1955) = lu(k,1955) - lu(k,1226) * lu(k,1932) + lu(k,1958) = lu(k,1958) - lu(k,1227) * lu(k,1932) + lu(k,1988) = lu(k,1988) - lu(k,1218) * lu(k,1985) + lu(k,1994) = lu(k,1994) - lu(k,1219) * lu(k,1985) + lu(k,1998) = lu(k,1998) - lu(k,1220) * lu(k,1985) + lu(k,1999) = lu(k,1999) - lu(k,1221) * lu(k,1985) + lu(k,2000) = lu(k,2000) - lu(k,1222) * lu(k,1985) + lu(k,2002) = lu(k,2002) - lu(k,1223) * lu(k,1985) + lu(k,2004) = lu(k,2004) - lu(k,1224) * lu(k,1985) + lu(k,2005) = lu(k,2005) - lu(k,1225) * lu(k,1985) + lu(k,2007) = lu(k,2007) - lu(k,1226) * lu(k,1985) + lu(k,2010) = lu(k,2010) - lu(k,1227) * lu(k,1985) + lu(k,2068) = lu(k,2068) - lu(k,1218) * lu(k,2065) + lu(k,2075) = lu(k,2075) - lu(k,1219) * lu(k,2065) + lu(k,2080) = lu(k,2080) - lu(k,1220) * lu(k,2065) + lu(k,2081) = lu(k,2081) - lu(k,1221) * lu(k,2065) + lu(k,2082) = lu(k,2082) - lu(k,1222) * lu(k,2065) + lu(k,2084) = lu(k,2084) - lu(k,1223) * lu(k,2065) + lu(k,2086) = lu(k,2086) - lu(k,1224) * lu(k,2065) + lu(k,2087) = lu(k,2087) - lu(k,1225) * lu(k,2065) + lu(k,2089) = lu(k,2089) - lu(k,1226) * lu(k,2065) + lu(k,2092) = lu(k,2092) - lu(k,1227) * lu(k,2065) + lu(k,2287) = lu(k,2287) - lu(k,1218) * lu(k,2284) + lu(k,2293) = lu(k,2293) - lu(k,1219) * lu(k,2284) + lu(k,2299) = lu(k,2299) - lu(k,1220) * lu(k,2284) + lu(k,2300) = lu(k,2300) - lu(k,1221) * lu(k,2284) + lu(k,2301) = lu(k,2301) - lu(k,1222) * lu(k,2284) + lu(k,2303) = lu(k,2303) - lu(k,1223) * lu(k,2284) + lu(k,2305) = lu(k,2305) - lu(k,1224) * lu(k,2284) + lu(k,2306) = lu(k,2306) - lu(k,1225) * lu(k,2284) + lu(k,2308) = lu(k,2308) - lu(k,1226) * lu(k,2284) + lu(k,2311) = lu(k,2311) - lu(k,1227) * lu(k,2284) + end do + end subroutine lu_fac24 + subroutine lu_fac25( 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,1237) = 1._r8 / lu(k,1237) + lu(k,1238) = lu(k,1238) * lu(k,1237) + lu(k,1239) = lu(k,1239) * lu(k,1237) + lu(k,1240) = lu(k,1240) * lu(k,1237) + lu(k,1241) = lu(k,1241) * lu(k,1237) + lu(k,1242) = lu(k,1242) * lu(k,1237) + lu(k,1243) = lu(k,1243) * lu(k,1237) + lu(k,1244) = lu(k,1244) * lu(k,1237) + lu(k,1245) = lu(k,1245) * lu(k,1237) + lu(k,1246) = lu(k,1246) * lu(k,1237) + lu(k,1247) = lu(k,1247) * lu(k,1237) + lu(k,1248) = lu(k,1248) * lu(k,1237) + lu(k,1249) = lu(k,1249) * lu(k,1237) + lu(k,1250) = lu(k,1250) * lu(k,1237) + lu(k,1426) = lu(k,1426) - lu(k,1238) * lu(k,1425) + lu(k,1427) = lu(k,1427) - lu(k,1239) * lu(k,1425) + lu(k,1431) = lu(k,1431) - lu(k,1240) * lu(k,1425) + lu(k,1433) = lu(k,1433) - lu(k,1241) * lu(k,1425) + lu(k,1435) = lu(k,1435) - lu(k,1242) * lu(k,1425) + lu(k,1436) = lu(k,1436) - lu(k,1243) * lu(k,1425) + lu(k,1437) = lu(k,1437) - lu(k,1244) * lu(k,1425) + lu(k,1438) = lu(k,1438) - lu(k,1245) * lu(k,1425) + lu(k,1439) = lu(k,1439) - lu(k,1246) * lu(k,1425) + lu(k,1440) = lu(k,1440) - lu(k,1247) * lu(k,1425) + lu(k,1441) = lu(k,1441) - lu(k,1248) * lu(k,1425) + lu(k,1442) = lu(k,1442) - lu(k,1249) * lu(k,1425) + lu(k,1444) = lu(k,1444) - lu(k,1250) * lu(k,1425) + lu(k,1805) = lu(k,1805) - lu(k,1238) * lu(k,1804) + lu(k,1806) = lu(k,1806) - lu(k,1239) * lu(k,1804) + lu(k,1811) = lu(k,1811) - lu(k,1240) * lu(k,1804) + lu(k,1813) = lu(k,1813) - lu(k,1241) * lu(k,1804) + lu(k,1817) = lu(k,1817) - lu(k,1242) * lu(k,1804) + lu(k,1819) = lu(k,1819) - lu(k,1243) * lu(k,1804) + lu(k,1820) = lu(k,1820) - lu(k,1244) * lu(k,1804) + lu(k,1821) = lu(k,1821) - lu(k,1245) * lu(k,1804) + lu(k,1823) = lu(k,1823) - lu(k,1246) * lu(k,1804) + lu(k,1825) = lu(k,1825) - lu(k,1247) * lu(k,1804) + lu(k,1826) = lu(k,1826) - lu(k,1248) * lu(k,1804) + lu(k,1828) = lu(k,1828) - lu(k,1249) * lu(k,1804) + lu(k,1831) = lu(k,1831) - lu(k,1250) * lu(k,1804) + lu(k,1934) = lu(k,1934) - lu(k,1238) * lu(k,1933) + lu(k,1935) = lu(k,1935) - lu(k,1239) * lu(k,1933) + lu(k,1939) = lu(k,1939) - lu(k,1240) * lu(k,1933) + lu(k,1941) = lu(k,1941) - lu(k,1241) * lu(k,1933) + lu(k,1944) = lu(k,1944) - lu(k,1242) * lu(k,1933) + lu(k,1946) = lu(k,1946) - lu(k,1243) * lu(k,1933) + lu(k,1947) = lu(k,1947) - lu(k,1244) * lu(k,1933) + lu(k,1948) = lu(k,1948) - lu(k,1245) * lu(k,1933) + lu(k,1950) = lu(k,1950) - lu(k,1246) * lu(k,1933) + lu(k,1952) = lu(k,1952) - lu(k,1247) * lu(k,1933) + lu(k,1953) = lu(k,1953) - lu(k,1248) * lu(k,1933) + lu(k,1955) = lu(k,1955) - lu(k,1249) * lu(k,1933) + lu(k,1958) = lu(k,1958) - lu(k,1250) * lu(k,1933) + lu(k,1987) = lu(k,1987) - lu(k,1238) * lu(k,1986) + lu(k,1988) = lu(k,1988) - lu(k,1239) * lu(k,1986) + lu(k,1992) = lu(k,1992) - lu(k,1240) * lu(k,1986) + lu(k,1994) = lu(k,1994) - lu(k,1241) * lu(k,1986) + lu(k,1996) = lu(k,1996) - lu(k,1242) * lu(k,1986) + lu(k,1998) = lu(k,1998) - lu(k,1243) * lu(k,1986) + lu(k,1999) = lu(k,1999) - lu(k,1244) * lu(k,1986) + lu(k,2000) = lu(k,2000) - lu(k,1245) * lu(k,1986) + lu(k,2002) = lu(k,2002) - lu(k,1246) * lu(k,1986) + lu(k,2004) = lu(k,2004) - lu(k,1247) * lu(k,1986) + lu(k,2005) = lu(k,2005) - lu(k,1248) * lu(k,1986) + lu(k,2007) = lu(k,2007) - lu(k,1249) * lu(k,1986) + lu(k,2010) = lu(k,2010) - lu(k,1250) * lu(k,1986) + lu(k,2067) = lu(k,2067) - lu(k,1238) * lu(k,2066) + lu(k,2068) = lu(k,2068) - lu(k,1239) * lu(k,2066) + lu(k,2073) = lu(k,2073) - lu(k,1240) * lu(k,2066) + lu(k,2075) = lu(k,2075) - lu(k,1241) * lu(k,2066) + lu(k,2078) = lu(k,2078) - lu(k,1242) * lu(k,2066) + lu(k,2080) = lu(k,2080) - lu(k,1243) * lu(k,2066) + lu(k,2081) = lu(k,2081) - lu(k,1244) * lu(k,2066) + lu(k,2082) = lu(k,2082) - lu(k,1245) * lu(k,2066) + lu(k,2084) = lu(k,2084) - lu(k,1246) * lu(k,2066) + lu(k,2086) = lu(k,2086) - lu(k,1247) * lu(k,2066) + lu(k,2087) = lu(k,2087) - lu(k,1248) * lu(k,2066) + lu(k,2089) = lu(k,2089) - lu(k,1249) * lu(k,2066) + lu(k,2092) = lu(k,2092) - lu(k,1250) * lu(k,2066) + lu(k,2168) = lu(k,2168) - lu(k,1238) * lu(k,2167) + lu(k,2169) = lu(k,2169) - lu(k,1239) * lu(k,2167) + lu(k,2174) = lu(k,2174) - lu(k,1240) * lu(k,2167) + lu(k,2176) = lu(k,2176) - lu(k,1241) * lu(k,2167) + lu(k,2179) = lu(k,2179) - lu(k,1242) * lu(k,2167) + lu(k,2181) = lu(k,2181) - lu(k,1243) * lu(k,2167) + lu(k,2182) = lu(k,2182) - lu(k,1244) * lu(k,2167) + lu(k,2183) = lu(k,2183) - lu(k,1245) * lu(k,2167) + lu(k,2185) = lu(k,2185) - lu(k,1246) * lu(k,2167) + lu(k,2187) = lu(k,2187) - lu(k,1247) * lu(k,2167) + lu(k,2188) = lu(k,2188) - lu(k,1248) * lu(k,2167) + lu(k,2190) = lu(k,2190) - lu(k,1249) * lu(k,2167) + lu(k,2193) = lu(k,2193) - lu(k,1250) * lu(k,2167) + lu(k,2286) = lu(k,2286) - lu(k,1238) * lu(k,2285) + lu(k,2287) = lu(k,2287) - lu(k,1239) * lu(k,2285) + lu(k,2291) = lu(k,2291) - lu(k,1240) * lu(k,2285) + lu(k,2293) = lu(k,2293) - lu(k,1241) * lu(k,2285) + lu(k,2297) = lu(k,2297) - lu(k,1242) * lu(k,2285) + lu(k,2299) = lu(k,2299) - lu(k,1243) * lu(k,2285) + lu(k,2300) = lu(k,2300) - lu(k,1244) * lu(k,2285) + lu(k,2301) = lu(k,2301) - lu(k,1245) * lu(k,2285) + lu(k,2303) = lu(k,2303) - lu(k,1246) * lu(k,2285) + lu(k,2305) = lu(k,2305) - lu(k,1247) * lu(k,2285) + lu(k,2306) = lu(k,2306) - lu(k,1248) * lu(k,2285) + lu(k,2308) = lu(k,2308) - lu(k,1249) * lu(k,2285) + lu(k,2311) = lu(k,2311) - lu(k,1250) * lu(k,2285) + lu(k,1253) = 1._r8 / lu(k,1253) + lu(k,1254) = lu(k,1254) * lu(k,1253) + lu(k,1255) = lu(k,1255) * lu(k,1253) + lu(k,1256) = lu(k,1256) * lu(k,1253) + lu(k,1257) = lu(k,1257) * lu(k,1253) + lu(k,1258) = lu(k,1258) * lu(k,1253) + lu(k,1259) = lu(k,1259) * lu(k,1253) + lu(k,1260) = lu(k,1260) * lu(k,1253) + lu(k,1261) = lu(k,1261) * lu(k,1253) + lu(k,1262) = lu(k,1262) * lu(k,1253) + lu(k,1263) = lu(k,1263) * lu(k,1253) + lu(k,1300) = lu(k,1300) - lu(k,1254) * lu(k,1299) + lu(k,1302) = - lu(k,1255) * lu(k,1299) + lu(k,1304) = - lu(k,1256) * lu(k,1299) + lu(k,1305) = lu(k,1305) - lu(k,1257) * lu(k,1299) + lu(k,1307) = lu(k,1307) - lu(k,1258) * lu(k,1299) + lu(k,1309) = lu(k,1309) - lu(k,1259) * lu(k,1299) + lu(k,1310) = lu(k,1310) - lu(k,1260) * lu(k,1299) + lu(k,1314) = - lu(k,1261) * lu(k,1299) + lu(k,1315) = lu(k,1315) - lu(k,1262) * lu(k,1299) + lu(k,1316) = lu(k,1316) - lu(k,1263) * lu(k,1299) + lu(k,1333) = lu(k,1333) - lu(k,1254) * lu(k,1332) + lu(k,1335) = - lu(k,1255) * lu(k,1332) + lu(k,1337) = - lu(k,1256) * lu(k,1332) + lu(k,1338) = lu(k,1338) - lu(k,1257) * lu(k,1332) + lu(k,1340) = lu(k,1340) - lu(k,1258) * lu(k,1332) + lu(k,1342) = lu(k,1342) - lu(k,1259) * lu(k,1332) + lu(k,1343) = lu(k,1343) - lu(k,1260) * lu(k,1332) + lu(k,1347) = - lu(k,1261) * lu(k,1332) + lu(k,1348) = lu(k,1348) - lu(k,1262) * lu(k,1332) + lu(k,1349) = lu(k,1349) - lu(k,1263) * lu(k,1332) + lu(k,1427) = lu(k,1427) - lu(k,1254) * lu(k,1426) + lu(k,1430) = lu(k,1430) - lu(k,1255) * lu(k,1426) + lu(k,1432) = lu(k,1432) - lu(k,1256) * lu(k,1426) + lu(k,1433) = lu(k,1433) - lu(k,1257) * lu(k,1426) + lu(k,1436) = lu(k,1436) - lu(k,1258) * lu(k,1426) + lu(k,1438) = lu(k,1438) - lu(k,1259) * lu(k,1426) + lu(k,1439) = lu(k,1439) - lu(k,1260) * lu(k,1426) + lu(k,1443) = lu(k,1443) - lu(k,1261) * lu(k,1426) + lu(k,1444) = lu(k,1444) - lu(k,1262) * lu(k,1426) + lu(k,1445) = lu(k,1445) - lu(k,1263) * lu(k,1426) + lu(k,1806) = lu(k,1806) - lu(k,1254) * lu(k,1805) + lu(k,1810) = lu(k,1810) - lu(k,1255) * lu(k,1805) + lu(k,1812) = lu(k,1812) - lu(k,1256) * lu(k,1805) + lu(k,1813) = lu(k,1813) - lu(k,1257) * lu(k,1805) + lu(k,1819) = lu(k,1819) - lu(k,1258) * lu(k,1805) + lu(k,1821) = lu(k,1821) - lu(k,1259) * lu(k,1805) + lu(k,1823) = lu(k,1823) - lu(k,1260) * lu(k,1805) + lu(k,1830) = lu(k,1830) - lu(k,1261) * lu(k,1805) + lu(k,1831) = lu(k,1831) - lu(k,1262) * lu(k,1805) + lu(k,1833) = lu(k,1833) - lu(k,1263) * lu(k,1805) + lu(k,1935) = lu(k,1935) - lu(k,1254) * lu(k,1934) + lu(k,1938) = lu(k,1938) - lu(k,1255) * lu(k,1934) + lu(k,1940) = lu(k,1940) - lu(k,1256) * lu(k,1934) + lu(k,1941) = lu(k,1941) - lu(k,1257) * lu(k,1934) + lu(k,1946) = lu(k,1946) - lu(k,1258) * lu(k,1934) + lu(k,1948) = lu(k,1948) - lu(k,1259) * lu(k,1934) + lu(k,1950) = lu(k,1950) - lu(k,1260) * lu(k,1934) + lu(k,1957) = lu(k,1957) - lu(k,1261) * lu(k,1934) + lu(k,1958) = lu(k,1958) - lu(k,1262) * lu(k,1934) + lu(k,1960) = lu(k,1960) - lu(k,1263) * lu(k,1934) + lu(k,1988) = lu(k,1988) - lu(k,1254) * lu(k,1987) + lu(k,1991) = lu(k,1991) - lu(k,1255) * lu(k,1987) + lu(k,1993) = lu(k,1993) - lu(k,1256) * lu(k,1987) + lu(k,1994) = lu(k,1994) - lu(k,1257) * lu(k,1987) + lu(k,1998) = lu(k,1998) - lu(k,1258) * lu(k,1987) + lu(k,2000) = lu(k,2000) - lu(k,1259) * lu(k,1987) + lu(k,2002) = lu(k,2002) - lu(k,1260) * lu(k,1987) + lu(k,2009) = - lu(k,1261) * lu(k,1987) + lu(k,2010) = lu(k,2010) - lu(k,1262) * lu(k,1987) + lu(k,2012) = lu(k,2012) - lu(k,1263) * lu(k,1987) + lu(k,2068) = lu(k,2068) - lu(k,1254) * lu(k,2067) + lu(k,2072) = lu(k,2072) - lu(k,1255) * lu(k,2067) + lu(k,2074) = lu(k,2074) - lu(k,1256) * lu(k,2067) + lu(k,2075) = lu(k,2075) - lu(k,1257) * lu(k,2067) + lu(k,2080) = lu(k,2080) - lu(k,1258) * lu(k,2067) + lu(k,2082) = lu(k,2082) - lu(k,1259) * lu(k,2067) + lu(k,2084) = lu(k,2084) - lu(k,1260) * lu(k,2067) + lu(k,2091) = lu(k,2091) - lu(k,1261) * lu(k,2067) + lu(k,2092) = lu(k,2092) - lu(k,1262) * lu(k,2067) + lu(k,2094) = lu(k,2094) - lu(k,1263) * lu(k,2067) + lu(k,2169) = lu(k,2169) - lu(k,1254) * lu(k,2168) + lu(k,2173) = - lu(k,1255) * lu(k,2168) + lu(k,2175) = - lu(k,1256) * lu(k,2168) + lu(k,2176) = lu(k,2176) - lu(k,1257) * lu(k,2168) + lu(k,2181) = lu(k,2181) - lu(k,1258) * lu(k,2168) + lu(k,2183) = lu(k,2183) - lu(k,1259) * lu(k,2168) + lu(k,2185) = lu(k,2185) - lu(k,1260) * lu(k,2168) + lu(k,2192) = lu(k,2192) - lu(k,1261) * lu(k,2168) + lu(k,2193) = lu(k,2193) - lu(k,1262) * lu(k,2168) + lu(k,2195) = lu(k,2195) - lu(k,1263) * lu(k,2168) + lu(k,2287) = lu(k,2287) - lu(k,1254) * lu(k,2286) + lu(k,2290) = lu(k,2290) - lu(k,1255) * lu(k,2286) + lu(k,2292) = lu(k,2292) - lu(k,1256) * lu(k,2286) + lu(k,2293) = lu(k,2293) - lu(k,1257) * lu(k,2286) + lu(k,2299) = lu(k,2299) - lu(k,1258) * lu(k,2286) + lu(k,2301) = lu(k,2301) - lu(k,1259) * lu(k,2286) + lu(k,2303) = lu(k,2303) - lu(k,1260) * lu(k,2286) + lu(k,2310) = lu(k,2310) - lu(k,1261) * lu(k,2286) + lu(k,2311) = lu(k,2311) - lu(k,1262) * lu(k,2286) + lu(k,2313) = lu(k,2313) - lu(k,1263) * lu(k,2286) + lu(k,1265) = 1._r8 / lu(k,1265) + lu(k,1266) = lu(k,1266) * lu(k,1265) + lu(k,1267) = lu(k,1267) * lu(k,1265) + lu(k,1268) = lu(k,1268) * lu(k,1265) + lu(k,1269) = lu(k,1269) * lu(k,1265) + lu(k,1270) = lu(k,1270) * lu(k,1265) + lu(k,1271) = lu(k,1271) * lu(k,1265) + lu(k,1272) = lu(k,1272) * lu(k,1265) + lu(k,1305) = lu(k,1305) - lu(k,1266) * lu(k,1300) + lu(k,1306) = lu(k,1306) - lu(k,1267) * lu(k,1300) + lu(k,1309) = lu(k,1309) - lu(k,1268) * lu(k,1300) + lu(k,1310) = lu(k,1310) - lu(k,1269) * lu(k,1300) + lu(k,1313) = lu(k,1313) - lu(k,1270) * lu(k,1300) + lu(k,1315) = lu(k,1315) - lu(k,1271) * lu(k,1300) + lu(k,1316) = lu(k,1316) - lu(k,1272) * lu(k,1300) + lu(k,1338) = lu(k,1338) - lu(k,1266) * lu(k,1333) + lu(k,1339) = lu(k,1339) - lu(k,1267) * lu(k,1333) + lu(k,1342) = lu(k,1342) - lu(k,1268) * lu(k,1333) + lu(k,1343) = lu(k,1343) - lu(k,1269) * lu(k,1333) + lu(k,1346) = lu(k,1346) - lu(k,1270) * lu(k,1333) + lu(k,1348) = lu(k,1348) - lu(k,1271) * lu(k,1333) + lu(k,1349) = lu(k,1349) - lu(k,1272) * lu(k,1333) + lu(k,1360) = lu(k,1360) - lu(k,1266) * lu(k,1357) + lu(k,1361) = lu(k,1361) - lu(k,1267) * lu(k,1357) + lu(k,1364) = lu(k,1364) - lu(k,1268) * lu(k,1357) + lu(k,1365) = lu(k,1365) - lu(k,1269) * lu(k,1357) + lu(k,1368) = lu(k,1368) - lu(k,1270) * lu(k,1357) + lu(k,1369) = lu(k,1369) - lu(k,1271) * lu(k,1357) + lu(k,1370) = lu(k,1370) - lu(k,1272) * lu(k,1357) + lu(k,1381) = lu(k,1381) - lu(k,1266) * lu(k,1377) + lu(k,1383) = lu(k,1383) - lu(k,1267) * lu(k,1377) + lu(k,1386) = lu(k,1386) - lu(k,1268) * lu(k,1377) + lu(k,1387) = lu(k,1387) - lu(k,1269) * lu(k,1377) + lu(k,1390) = lu(k,1390) - lu(k,1270) * lu(k,1377) + lu(k,1392) = lu(k,1392) - lu(k,1271) * lu(k,1377) + lu(k,1393) = lu(k,1393) - lu(k,1272) * lu(k,1377) + lu(k,1402) = lu(k,1402) - lu(k,1266) * lu(k,1400) + lu(k,1403) = - lu(k,1267) * lu(k,1400) + lu(k,1406) = lu(k,1406) - lu(k,1268) * lu(k,1400) + lu(k,1407) = lu(k,1407) - lu(k,1269) * lu(k,1400) + lu(k,1410) = lu(k,1410) - lu(k,1270) * lu(k,1400) + lu(k,1412) = lu(k,1412) - lu(k,1271) * lu(k,1400) + lu(k,1413) = lu(k,1413) - lu(k,1272) * lu(k,1400) + lu(k,1433) = lu(k,1433) - lu(k,1266) * lu(k,1427) + lu(k,1435) = lu(k,1435) - lu(k,1267) * lu(k,1427) + lu(k,1438) = lu(k,1438) - lu(k,1268) * lu(k,1427) + lu(k,1439) = lu(k,1439) - lu(k,1269) * lu(k,1427) + lu(k,1442) = lu(k,1442) - lu(k,1270) * lu(k,1427) + lu(k,1444) = lu(k,1444) - lu(k,1271) * lu(k,1427) + lu(k,1445) = lu(k,1445) - lu(k,1272) * lu(k,1427) + lu(k,1570) = lu(k,1570) - lu(k,1266) * lu(k,1567) + lu(k,1573) = lu(k,1573) - lu(k,1267) * lu(k,1567) + lu(k,1577) = lu(k,1577) - lu(k,1268) * lu(k,1567) + lu(k,1579) = lu(k,1579) - lu(k,1269) * lu(k,1567) + lu(k,1584) = lu(k,1584) - lu(k,1270) * lu(k,1567) + lu(k,1587) = lu(k,1587) - lu(k,1271) * lu(k,1567) + lu(k,1589) = lu(k,1589) - lu(k,1272) * lu(k,1567) + lu(k,1813) = lu(k,1813) - lu(k,1266) * lu(k,1806) + lu(k,1817) = lu(k,1817) - lu(k,1267) * lu(k,1806) + lu(k,1821) = lu(k,1821) - lu(k,1268) * lu(k,1806) + lu(k,1823) = lu(k,1823) - lu(k,1269) * lu(k,1806) + lu(k,1828) = lu(k,1828) - lu(k,1270) * lu(k,1806) + lu(k,1831) = lu(k,1831) - lu(k,1271) * lu(k,1806) + lu(k,1833) = lu(k,1833) - lu(k,1272) * lu(k,1806) + lu(k,1941) = lu(k,1941) - lu(k,1266) * lu(k,1935) + lu(k,1944) = lu(k,1944) - lu(k,1267) * lu(k,1935) + lu(k,1948) = lu(k,1948) - lu(k,1268) * lu(k,1935) + lu(k,1950) = lu(k,1950) - lu(k,1269) * lu(k,1935) + lu(k,1955) = lu(k,1955) - lu(k,1270) * lu(k,1935) + lu(k,1958) = lu(k,1958) - lu(k,1271) * lu(k,1935) + lu(k,1960) = lu(k,1960) - lu(k,1272) * lu(k,1935) + lu(k,1994) = lu(k,1994) - lu(k,1266) * lu(k,1988) + lu(k,1996) = lu(k,1996) - lu(k,1267) * lu(k,1988) + lu(k,2000) = lu(k,2000) - lu(k,1268) * lu(k,1988) + lu(k,2002) = lu(k,2002) - lu(k,1269) * lu(k,1988) + lu(k,2007) = lu(k,2007) - lu(k,1270) * lu(k,1988) + lu(k,2010) = lu(k,2010) - lu(k,1271) * lu(k,1988) + lu(k,2012) = lu(k,2012) - lu(k,1272) * lu(k,1988) + lu(k,2075) = lu(k,2075) - lu(k,1266) * lu(k,2068) + lu(k,2078) = lu(k,2078) - lu(k,1267) * lu(k,2068) + lu(k,2082) = lu(k,2082) - lu(k,1268) * lu(k,2068) + lu(k,2084) = lu(k,2084) - lu(k,1269) * lu(k,2068) + lu(k,2089) = lu(k,2089) - lu(k,1270) * lu(k,2068) + lu(k,2092) = lu(k,2092) - lu(k,1271) * lu(k,2068) + lu(k,2094) = lu(k,2094) - lu(k,1272) * lu(k,2068) + lu(k,2176) = lu(k,2176) - lu(k,1266) * lu(k,2169) + lu(k,2179) = lu(k,2179) - lu(k,1267) * lu(k,2169) + lu(k,2183) = lu(k,2183) - lu(k,1268) * lu(k,2169) + lu(k,2185) = lu(k,2185) - lu(k,1269) * lu(k,2169) + lu(k,2190) = lu(k,2190) - lu(k,1270) * lu(k,2169) + lu(k,2193) = lu(k,2193) - lu(k,1271) * lu(k,2169) + lu(k,2195) = lu(k,2195) - lu(k,1272) * lu(k,2169) + lu(k,2293) = lu(k,2293) - lu(k,1266) * lu(k,2287) + lu(k,2297) = lu(k,2297) - lu(k,1267) * lu(k,2287) + lu(k,2301) = lu(k,2301) - lu(k,1268) * lu(k,2287) + lu(k,2303) = lu(k,2303) - lu(k,1269) * lu(k,2287) + lu(k,2308) = lu(k,2308) - lu(k,1270) * lu(k,2287) + lu(k,2311) = lu(k,2311) - lu(k,1271) * lu(k,2287) + lu(k,2313) = lu(k,2313) - lu(k,1272) * lu(k,2287) + lu(k,1276) = 1._r8 / lu(k,1276) + lu(k,1277) = lu(k,1277) * lu(k,1276) + lu(k,1278) = lu(k,1278) * lu(k,1276) + lu(k,1279) = lu(k,1279) * lu(k,1276) + lu(k,1280) = lu(k,1280) * lu(k,1276) + lu(k,1281) = lu(k,1281) * lu(k,1276) + lu(k,1282) = lu(k,1282) * lu(k,1276) + lu(k,1283) = lu(k,1283) * lu(k,1276) + lu(k,1284) = lu(k,1284) * lu(k,1276) + lu(k,1285) = lu(k,1285) * lu(k,1276) + lu(k,1286) = lu(k,1286) * lu(k,1276) + lu(k,1287) = lu(k,1287) * lu(k,1276) + lu(k,1288) = lu(k,1288) * lu(k,1276) + lu(k,1571) = lu(k,1571) - lu(k,1277) * lu(k,1568) + lu(k,1574) = lu(k,1574) - lu(k,1278) * lu(k,1568) + lu(k,1576) = lu(k,1576) - lu(k,1279) * lu(k,1568) + lu(k,1577) = lu(k,1577) - lu(k,1280) * lu(k,1568) + lu(k,1579) = lu(k,1579) - lu(k,1281) * lu(k,1568) + lu(k,1580) = lu(k,1580) - lu(k,1282) * lu(k,1568) + lu(k,1581) = lu(k,1581) - lu(k,1283) * lu(k,1568) + lu(k,1585) = lu(k,1585) - lu(k,1284) * lu(k,1568) + lu(k,1586) = lu(k,1586) - lu(k,1285) * lu(k,1568) + lu(k,1587) = lu(k,1587) - lu(k,1286) * lu(k,1568) + lu(k,1588) = lu(k,1588) - lu(k,1287) * lu(k,1568) + lu(k,1589) = lu(k,1589) - lu(k,1288) * lu(k,1568) + lu(k,1602) = lu(k,1602) - lu(k,1277) * lu(k,1600) + lu(k,1605) = lu(k,1605) - lu(k,1278) * lu(k,1600) + lu(k,1607) = lu(k,1607) - lu(k,1279) * lu(k,1600) + lu(k,1608) = lu(k,1608) - lu(k,1280) * lu(k,1600) + lu(k,1610) = lu(k,1610) - lu(k,1281) * lu(k,1600) + lu(k,1611) = lu(k,1611) - lu(k,1282) * lu(k,1600) + lu(k,1612) = lu(k,1612) - lu(k,1283) * lu(k,1600) + lu(k,1616) = lu(k,1616) - lu(k,1284) * lu(k,1600) + lu(k,1617) = lu(k,1617) - lu(k,1285) * lu(k,1600) + lu(k,1618) = lu(k,1618) - lu(k,1286) * lu(k,1600) + lu(k,1619) = lu(k,1619) - lu(k,1287) * lu(k,1600) + lu(k,1620) = lu(k,1620) - lu(k,1288) * lu(k,1600) + lu(k,1815) = lu(k,1815) - lu(k,1277) * lu(k,1807) + lu(k,1818) = lu(k,1818) - lu(k,1278) * lu(k,1807) + lu(k,1820) = lu(k,1820) - lu(k,1279) * lu(k,1807) + lu(k,1821) = lu(k,1821) - lu(k,1280) * lu(k,1807) + lu(k,1823) = lu(k,1823) - lu(k,1281) * lu(k,1807) + lu(k,1824) = lu(k,1824) - lu(k,1282) * lu(k,1807) + lu(k,1825) = lu(k,1825) - lu(k,1283) * lu(k,1807) + lu(k,1829) = lu(k,1829) - lu(k,1284) * lu(k,1807) + lu(k,1830) = lu(k,1830) - lu(k,1285) * lu(k,1807) + lu(k,1831) = lu(k,1831) - lu(k,1286) * lu(k,1807) + lu(k,1832) = lu(k,1832) - lu(k,1287) * lu(k,1807) + lu(k,1833) = lu(k,1833) - lu(k,1288) * lu(k,1807) + lu(k,1840) = lu(k,1840) - lu(k,1277) * lu(k,1839) + lu(k,1842) = - lu(k,1278) * lu(k,1839) + lu(k,1844) = lu(k,1844) - lu(k,1279) * lu(k,1839) + lu(k,1845) = lu(k,1845) - lu(k,1280) * lu(k,1839) + lu(k,1847) = lu(k,1847) - lu(k,1281) * lu(k,1839) + lu(k,1848) = lu(k,1848) - lu(k,1282) * lu(k,1839) + lu(k,1849) = lu(k,1849) - lu(k,1283) * lu(k,1839) + lu(k,1853) = lu(k,1853) - lu(k,1284) * lu(k,1839) + lu(k,1854) = - lu(k,1285) * lu(k,1839) + lu(k,1855) = lu(k,1855) - lu(k,1286) * lu(k,1839) + lu(k,1856) = lu(k,1856) - lu(k,1287) * lu(k,1839) + lu(k,1857) = lu(k,1857) - lu(k,1288) * lu(k,1839) + lu(k,2076) = - lu(k,1277) * lu(k,2069) + lu(k,2079) = - lu(k,1278) * lu(k,2069) + lu(k,2081) = lu(k,2081) - lu(k,1279) * lu(k,2069) + lu(k,2082) = lu(k,2082) - lu(k,1280) * lu(k,2069) + lu(k,2084) = lu(k,2084) - lu(k,1281) * lu(k,2069) + lu(k,2085) = - lu(k,1282) * lu(k,2069) + lu(k,2086) = lu(k,2086) - lu(k,1283) * lu(k,2069) + lu(k,2090) = - lu(k,1284) * lu(k,2069) + lu(k,2091) = lu(k,2091) - lu(k,1285) * lu(k,2069) + lu(k,2092) = lu(k,2092) - lu(k,1286) * lu(k,2069) + lu(k,2093) = - lu(k,1287) * lu(k,2069) + lu(k,2094) = lu(k,2094) - lu(k,1288) * lu(k,2069) + lu(k,2177) = lu(k,2177) - lu(k,1277) * lu(k,2170) + lu(k,2180) = lu(k,2180) - lu(k,1278) * lu(k,2170) + lu(k,2182) = lu(k,2182) - lu(k,1279) * lu(k,2170) + lu(k,2183) = lu(k,2183) - lu(k,1280) * lu(k,2170) + lu(k,2185) = lu(k,2185) - lu(k,1281) * lu(k,2170) + lu(k,2186) = lu(k,2186) - lu(k,1282) * lu(k,2170) + lu(k,2187) = lu(k,2187) - lu(k,1283) * lu(k,2170) + lu(k,2191) = lu(k,2191) - lu(k,1284) * lu(k,2170) + lu(k,2192) = lu(k,2192) - lu(k,1285) * lu(k,2170) + lu(k,2193) = lu(k,2193) - lu(k,1286) * lu(k,2170) + lu(k,2194) = lu(k,2194) - lu(k,1287) * lu(k,2170) + lu(k,2195) = lu(k,2195) - lu(k,1288) * lu(k,2170) + lu(k,2322) = lu(k,2322) - lu(k,1277) * lu(k,2321) + lu(k,2324) = - lu(k,1278) * lu(k,2321) + lu(k,2326) = lu(k,2326) - lu(k,1279) * lu(k,2321) + lu(k,2327) = lu(k,2327) - lu(k,1280) * lu(k,2321) + lu(k,2329) = lu(k,2329) - lu(k,1281) * lu(k,2321) + lu(k,2330) = lu(k,2330) - lu(k,1282) * lu(k,2321) + lu(k,2331) = lu(k,2331) - lu(k,1283) * lu(k,2321) + lu(k,2335) = lu(k,2335) - lu(k,1284) * lu(k,2321) + lu(k,2336) = - lu(k,1285) * lu(k,2321) + lu(k,2337) = lu(k,2337) - lu(k,1286) * lu(k,2321) + lu(k,2338) = lu(k,2338) - lu(k,1287) * lu(k,2321) + lu(k,2339) = lu(k,2339) - lu(k,1288) * lu(k,2321) + lu(k,2347) = - lu(k,1277) * lu(k,2345) + lu(k,2350) = lu(k,2350) - lu(k,1278) * lu(k,2345) + lu(k,2352) = - lu(k,1279) * lu(k,2345) + lu(k,2353) = lu(k,2353) - lu(k,1280) * lu(k,2345) + lu(k,2355) = lu(k,2355) - lu(k,1281) * lu(k,2345) + lu(k,2356) = - lu(k,1282) * lu(k,2345) + lu(k,2357) = - lu(k,1283) * lu(k,2345) + lu(k,2361) = - lu(k,1284) * lu(k,2345) + lu(k,2362) = - lu(k,1285) * lu(k,2345) + lu(k,2363) = lu(k,2363) - lu(k,1286) * lu(k,2345) + lu(k,2364) = - lu(k,1287) * lu(k,2345) + lu(k,2365) = lu(k,2365) - lu(k,1288) * lu(k,2345) + end do + end subroutine lu_fac25 + subroutine lu_fac26( 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,1301) = 1._r8 / lu(k,1301) + lu(k,1302) = lu(k,1302) * lu(k,1301) + lu(k,1303) = lu(k,1303) * lu(k,1301) + lu(k,1304) = lu(k,1304) * lu(k,1301) + lu(k,1305) = lu(k,1305) * lu(k,1301) + lu(k,1306) = lu(k,1306) * lu(k,1301) + lu(k,1307) = lu(k,1307) * lu(k,1301) + lu(k,1308) = lu(k,1308) * lu(k,1301) + lu(k,1309) = lu(k,1309) * lu(k,1301) + lu(k,1310) = lu(k,1310) * lu(k,1301) + lu(k,1311) = lu(k,1311) * lu(k,1301) + lu(k,1312) = lu(k,1312) * lu(k,1301) + lu(k,1313) = lu(k,1313) * lu(k,1301) + lu(k,1314) = lu(k,1314) * lu(k,1301) + lu(k,1315) = lu(k,1315) * lu(k,1301) + lu(k,1316) = lu(k,1316) * lu(k,1301) + lu(k,1430) = lu(k,1430) - lu(k,1302) * lu(k,1428) + lu(k,1431) = lu(k,1431) - lu(k,1303) * lu(k,1428) + lu(k,1432) = lu(k,1432) - lu(k,1304) * lu(k,1428) + lu(k,1433) = lu(k,1433) - lu(k,1305) * lu(k,1428) + lu(k,1435) = lu(k,1435) - lu(k,1306) * lu(k,1428) + lu(k,1436) = lu(k,1436) - lu(k,1307) * lu(k,1428) + lu(k,1437) = lu(k,1437) - lu(k,1308) * lu(k,1428) + lu(k,1438) = lu(k,1438) - lu(k,1309) * lu(k,1428) + lu(k,1439) = lu(k,1439) - lu(k,1310) * lu(k,1428) + lu(k,1440) = lu(k,1440) - lu(k,1311) * lu(k,1428) + lu(k,1441) = lu(k,1441) - lu(k,1312) * lu(k,1428) + lu(k,1442) = lu(k,1442) - lu(k,1313) * lu(k,1428) + lu(k,1443) = lu(k,1443) - lu(k,1314) * lu(k,1428) + lu(k,1444) = lu(k,1444) - lu(k,1315) * lu(k,1428) + lu(k,1445) = lu(k,1445) - lu(k,1316) * lu(k,1428) + lu(k,1810) = lu(k,1810) - lu(k,1302) * lu(k,1808) + lu(k,1811) = lu(k,1811) - lu(k,1303) * lu(k,1808) + lu(k,1812) = lu(k,1812) - lu(k,1304) * lu(k,1808) + lu(k,1813) = lu(k,1813) - lu(k,1305) * lu(k,1808) + lu(k,1817) = lu(k,1817) - lu(k,1306) * lu(k,1808) + lu(k,1819) = lu(k,1819) - lu(k,1307) * lu(k,1808) + lu(k,1820) = lu(k,1820) - lu(k,1308) * lu(k,1808) + lu(k,1821) = lu(k,1821) - lu(k,1309) * lu(k,1808) + lu(k,1823) = lu(k,1823) - lu(k,1310) * lu(k,1808) + lu(k,1825) = lu(k,1825) - lu(k,1311) * lu(k,1808) + lu(k,1826) = lu(k,1826) - lu(k,1312) * lu(k,1808) + lu(k,1828) = lu(k,1828) - lu(k,1313) * lu(k,1808) + lu(k,1830) = lu(k,1830) - lu(k,1314) * lu(k,1808) + lu(k,1831) = lu(k,1831) - lu(k,1315) * lu(k,1808) + lu(k,1833) = lu(k,1833) - lu(k,1316) * lu(k,1808) + lu(k,1938) = lu(k,1938) - lu(k,1302) * lu(k,1936) + lu(k,1939) = lu(k,1939) - lu(k,1303) * lu(k,1936) + lu(k,1940) = lu(k,1940) - lu(k,1304) * lu(k,1936) + lu(k,1941) = lu(k,1941) - lu(k,1305) * lu(k,1936) + lu(k,1944) = lu(k,1944) - lu(k,1306) * lu(k,1936) + lu(k,1946) = lu(k,1946) - lu(k,1307) * lu(k,1936) + lu(k,1947) = lu(k,1947) - lu(k,1308) * lu(k,1936) + lu(k,1948) = lu(k,1948) - lu(k,1309) * lu(k,1936) + lu(k,1950) = lu(k,1950) - lu(k,1310) * lu(k,1936) + lu(k,1952) = lu(k,1952) - lu(k,1311) * lu(k,1936) + lu(k,1953) = lu(k,1953) - lu(k,1312) * lu(k,1936) + lu(k,1955) = lu(k,1955) - lu(k,1313) * lu(k,1936) + lu(k,1957) = lu(k,1957) - lu(k,1314) * lu(k,1936) + lu(k,1958) = lu(k,1958) - lu(k,1315) * lu(k,1936) + lu(k,1960) = lu(k,1960) - lu(k,1316) * lu(k,1936) + lu(k,1991) = lu(k,1991) - lu(k,1302) * lu(k,1989) + lu(k,1992) = lu(k,1992) - lu(k,1303) * lu(k,1989) + lu(k,1993) = lu(k,1993) - lu(k,1304) * lu(k,1989) + lu(k,1994) = lu(k,1994) - lu(k,1305) * lu(k,1989) + lu(k,1996) = lu(k,1996) - lu(k,1306) * lu(k,1989) + lu(k,1998) = lu(k,1998) - lu(k,1307) * lu(k,1989) + lu(k,1999) = lu(k,1999) - lu(k,1308) * lu(k,1989) + lu(k,2000) = lu(k,2000) - lu(k,1309) * lu(k,1989) + lu(k,2002) = lu(k,2002) - lu(k,1310) * lu(k,1989) + lu(k,2004) = lu(k,2004) - lu(k,1311) * lu(k,1989) + lu(k,2005) = lu(k,2005) - lu(k,1312) * lu(k,1989) + lu(k,2007) = lu(k,2007) - lu(k,1313) * lu(k,1989) + lu(k,2009) = lu(k,2009) - lu(k,1314) * lu(k,1989) + lu(k,2010) = lu(k,2010) - lu(k,1315) * lu(k,1989) + lu(k,2012) = lu(k,2012) - lu(k,1316) * lu(k,1989) + lu(k,2072) = lu(k,2072) - lu(k,1302) * lu(k,2070) + lu(k,2073) = lu(k,2073) - lu(k,1303) * lu(k,2070) + lu(k,2074) = lu(k,2074) - lu(k,1304) * lu(k,2070) + lu(k,2075) = lu(k,2075) - lu(k,1305) * lu(k,2070) + lu(k,2078) = lu(k,2078) - lu(k,1306) * lu(k,2070) + lu(k,2080) = lu(k,2080) - lu(k,1307) * lu(k,2070) + lu(k,2081) = lu(k,2081) - lu(k,1308) * lu(k,2070) + lu(k,2082) = lu(k,2082) - lu(k,1309) * lu(k,2070) + lu(k,2084) = lu(k,2084) - lu(k,1310) * lu(k,2070) + lu(k,2086) = lu(k,2086) - lu(k,1311) * lu(k,2070) + lu(k,2087) = lu(k,2087) - lu(k,1312) * lu(k,2070) + lu(k,2089) = lu(k,2089) - lu(k,1313) * lu(k,2070) + lu(k,2091) = lu(k,2091) - lu(k,1314) * lu(k,2070) + lu(k,2092) = lu(k,2092) - lu(k,1315) * lu(k,2070) + lu(k,2094) = lu(k,2094) - lu(k,1316) * lu(k,2070) + lu(k,2173) = lu(k,2173) - lu(k,1302) * lu(k,2171) + lu(k,2174) = lu(k,2174) - lu(k,1303) * lu(k,2171) + lu(k,2175) = lu(k,2175) - lu(k,1304) * lu(k,2171) + lu(k,2176) = lu(k,2176) - lu(k,1305) * lu(k,2171) + lu(k,2179) = lu(k,2179) - lu(k,1306) * lu(k,2171) + lu(k,2181) = lu(k,2181) - lu(k,1307) * lu(k,2171) + lu(k,2182) = lu(k,2182) - lu(k,1308) * lu(k,2171) + lu(k,2183) = lu(k,2183) - lu(k,1309) * lu(k,2171) + lu(k,2185) = lu(k,2185) - lu(k,1310) * lu(k,2171) + lu(k,2187) = lu(k,2187) - lu(k,1311) * lu(k,2171) + lu(k,2188) = lu(k,2188) - lu(k,1312) * lu(k,2171) + lu(k,2190) = lu(k,2190) - lu(k,1313) * lu(k,2171) + lu(k,2192) = lu(k,2192) - lu(k,1314) * lu(k,2171) + lu(k,2193) = lu(k,2193) - lu(k,1315) * lu(k,2171) + lu(k,2195) = lu(k,2195) - lu(k,1316) * lu(k,2171) + lu(k,2290) = lu(k,2290) - lu(k,1302) * lu(k,2288) + lu(k,2291) = lu(k,2291) - lu(k,1303) * lu(k,2288) + lu(k,2292) = lu(k,2292) - lu(k,1304) * lu(k,2288) + lu(k,2293) = lu(k,2293) - lu(k,1305) * lu(k,2288) + lu(k,2297) = lu(k,2297) - lu(k,1306) * lu(k,2288) + lu(k,2299) = lu(k,2299) - lu(k,1307) * lu(k,2288) + lu(k,2300) = lu(k,2300) - lu(k,1308) * lu(k,2288) + lu(k,2301) = lu(k,2301) - lu(k,1309) * lu(k,2288) + lu(k,2303) = lu(k,2303) - lu(k,1310) * lu(k,2288) + lu(k,2305) = lu(k,2305) - lu(k,1311) * lu(k,2288) + lu(k,2306) = lu(k,2306) - lu(k,1312) * lu(k,2288) + lu(k,2308) = lu(k,2308) - lu(k,1313) * lu(k,2288) + lu(k,2310) = lu(k,2310) - lu(k,1314) * lu(k,2288) + lu(k,2311) = lu(k,2311) - lu(k,1315) * lu(k,2288) + lu(k,2313) = lu(k,2313) - lu(k,1316) * lu(k,2288) + lu(k,1334) = 1._r8 / lu(k,1334) + lu(k,1335) = lu(k,1335) * lu(k,1334) + lu(k,1336) = lu(k,1336) * lu(k,1334) + lu(k,1337) = lu(k,1337) * lu(k,1334) + lu(k,1338) = lu(k,1338) * lu(k,1334) + lu(k,1339) = lu(k,1339) * lu(k,1334) + lu(k,1340) = lu(k,1340) * lu(k,1334) + lu(k,1341) = lu(k,1341) * lu(k,1334) + lu(k,1342) = lu(k,1342) * lu(k,1334) + lu(k,1343) = lu(k,1343) * lu(k,1334) + lu(k,1344) = lu(k,1344) * lu(k,1334) + lu(k,1345) = lu(k,1345) * lu(k,1334) + lu(k,1346) = lu(k,1346) * lu(k,1334) + lu(k,1347) = lu(k,1347) * lu(k,1334) + lu(k,1348) = lu(k,1348) * lu(k,1334) + lu(k,1349) = lu(k,1349) * lu(k,1334) + lu(k,1430) = lu(k,1430) - lu(k,1335) * lu(k,1429) + lu(k,1431) = lu(k,1431) - lu(k,1336) * lu(k,1429) + lu(k,1432) = lu(k,1432) - lu(k,1337) * lu(k,1429) + lu(k,1433) = lu(k,1433) - lu(k,1338) * lu(k,1429) + lu(k,1435) = lu(k,1435) - lu(k,1339) * lu(k,1429) + lu(k,1436) = lu(k,1436) - lu(k,1340) * lu(k,1429) + lu(k,1437) = lu(k,1437) - lu(k,1341) * lu(k,1429) + lu(k,1438) = lu(k,1438) - lu(k,1342) * lu(k,1429) + lu(k,1439) = lu(k,1439) - lu(k,1343) * lu(k,1429) + lu(k,1440) = lu(k,1440) - lu(k,1344) * lu(k,1429) + lu(k,1441) = lu(k,1441) - lu(k,1345) * lu(k,1429) + lu(k,1442) = lu(k,1442) - lu(k,1346) * lu(k,1429) + lu(k,1443) = lu(k,1443) - lu(k,1347) * lu(k,1429) + lu(k,1444) = lu(k,1444) - lu(k,1348) * lu(k,1429) + lu(k,1445) = lu(k,1445) - lu(k,1349) * lu(k,1429) + lu(k,1810) = lu(k,1810) - lu(k,1335) * lu(k,1809) + lu(k,1811) = lu(k,1811) - lu(k,1336) * lu(k,1809) + lu(k,1812) = lu(k,1812) - lu(k,1337) * lu(k,1809) + lu(k,1813) = lu(k,1813) - lu(k,1338) * lu(k,1809) + lu(k,1817) = lu(k,1817) - lu(k,1339) * lu(k,1809) + lu(k,1819) = lu(k,1819) - lu(k,1340) * lu(k,1809) + lu(k,1820) = lu(k,1820) - lu(k,1341) * lu(k,1809) + lu(k,1821) = lu(k,1821) - lu(k,1342) * lu(k,1809) + lu(k,1823) = lu(k,1823) - lu(k,1343) * lu(k,1809) + lu(k,1825) = lu(k,1825) - lu(k,1344) * lu(k,1809) + lu(k,1826) = lu(k,1826) - lu(k,1345) * lu(k,1809) + lu(k,1828) = lu(k,1828) - lu(k,1346) * lu(k,1809) + lu(k,1830) = lu(k,1830) - lu(k,1347) * lu(k,1809) + lu(k,1831) = lu(k,1831) - lu(k,1348) * lu(k,1809) + lu(k,1833) = lu(k,1833) - lu(k,1349) * lu(k,1809) + lu(k,1938) = lu(k,1938) - lu(k,1335) * lu(k,1937) + lu(k,1939) = lu(k,1939) - lu(k,1336) * lu(k,1937) + lu(k,1940) = lu(k,1940) - lu(k,1337) * lu(k,1937) + lu(k,1941) = lu(k,1941) - lu(k,1338) * lu(k,1937) + lu(k,1944) = lu(k,1944) - lu(k,1339) * lu(k,1937) + lu(k,1946) = lu(k,1946) - lu(k,1340) * lu(k,1937) + lu(k,1947) = lu(k,1947) - lu(k,1341) * lu(k,1937) + lu(k,1948) = lu(k,1948) - lu(k,1342) * lu(k,1937) + lu(k,1950) = lu(k,1950) - lu(k,1343) * lu(k,1937) + lu(k,1952) = lu(k,1952) - lu(k,1344) * lu(k,1937) + lu(k,1953) = lu(k,1953) - lu(k,1345) * lu(k,1937) + lu(k,1955) = lu(k,1955) - lu(k,1346) * lu(k,1937) + lu(k,1957) = lu(k,1957) - lu(k,1347) * lu(k,1937) + lu(k,1958) = lu(k,1958) - lu(k,1348) * lu(k,1937) + lu(k,1960) = lu(k,1960) - lu(k,1349) * lu(k,1937) + lu(k,1991) = lu(k,1991) - lu(k,1335) * lu(k,1990) + lu(k,1992) = lu(k,1992) - lu(k,1336) * lu(k,1990) + lu(k,1993) = lu(k,1993) - lu(k,1337) * lu(k,1990) + lu(k,1994) = lu(k,1994) - lu(k,1338) * lu(k,1990) + lu(k,1996) = lu(k,1996) - lu(k,1339) * lu(k,1990) + lu(k,1998) = lu(k,1998) - lu(k,1340) * lu(k,1990) + lu(k,1999) = lu(k,1999) - lu(k,1341) * lu(k,1990) + lu(k,2000) = lu(k,2000) - lu(k,1342) * lu(k,1990) + lu(k,2002) = lu(k,2002) - lu(k,1343) * lu(k,1990) + lu(k,2004) = lu(k,2004) - lu(k,1344) * lu(k,1990) + lu(k,2005) = lu(k,2005) - lu(k,1345) * lu(k,1990) + lu(k,2007) = lu(k,2007) - lu(k,1346) * lu(k,1990) + lu(k,2009) = lu(k,2009) - lu(k,1347) * lu(k,1990) + lu(k,2010) = lu(k,2010) - lu(k,1348) * lu(k,1990) + lu(k,2012) = lu(k,2012) - lu(k,1349) * lu(k,1990) + lu(k,2072) = lu(k,2072) - lu(k,1335) * lu(k,2071) + lu(k,2073) = lu(k,2073) - lu(k,1336) * lu(k,2071) + lu(k,2074) = lu(k,2074) - lu(k,1337) * lu(k,2071) + lu(k,2075) = lu(k,2075) - lu(k,1338) * lu(k,2071) + lu(k,2078) = lu(k,2078) - lu(k,1339) * lu(k,2071) + lu(k,2080) = lu(k,2080) - lu(k,1340) * lu(k,2071) + lu(k,2081) = lu(k,2081) - lu(k,1341) * lu(k,2071) + lu(k,2082) = lu(k,2082) - lu(k,1342) * lu(k,2071) + lu(k,2084) = lu(k,2084) - lu(k,1343) * lu(k,2071) + lu(k,2086) = lu(k,2086) - lu(k,1344) * lu(k,2071) + lu(k,2087) = lu(k,2087) - lu(k,1345) * lu(k,2071) + lu(k,2089) = lu(k,2089) - lu(k,1346) * lu(k,2071) + lu(k,2091) = lu(k,2091) - lu(k,1347) * lu(k,2071) + lu(k,2092) = lu(k,2092) - lu(k,1348) * lu(k,2071) + lu(k,2094) = lu(k,2094) - lu(k,1349) * lu(k,2071) + lu(k,2173) = lu(k,2173) - lu(k,1335) * lu(k,2172) + lu(k,2174) = lu(k,2174) - lu(k,1336) * lu(k,2172) + lu(k,2175) = lu(k,2175) - lu(k,1337) * lu(k,2172) + lu(k,2176) = lu(k,2176) - lu(k,1338) * lu(k,2172) + lu(k,2179) = lu(k,2179) - lu(k,1339) * lu(k,2172) + lu(k,2181) = lu(k,2181) - lu(k,1340) * lu(k,2172) + lu(k,2182) = lu(k,2182) - lu(k,1341) * lu(k,2172) + lu(k,2183) = lu(k,2183) - lu(k,1342) * lu(k,2172) + lu(k,2185) = lu(k,2185) - lu(k,1343) * lu(k,2172) + lu(k,2187) = lu(k,2187) - lu(k,1344) * lu(k,2172) + lu(k,2188) = lu(k,2188) - lu(k,1345) * lu(k,2172) + lu(k,2190) = lu(k,2190) - lu(k,1346) * lu(k,2172) + lu(k,2192) = lu(k,2192) - lu(k,1347) * lu(k,2172) + lu(k,2193) = lu(k,2193) - lu(k,1348) * lu(k,2172) + lu(k,2195) = lu(k,2195) - lu(k,1349) * lu(k,2172) + lu(k,2290) = lu(k,2290) - lu(k,1335) * lu(k,2289) + lu(k,2291) = lu(k,2291) - lu(k,1336) * lu(k,2289) + lu(k,2292) = lu(k,2292) - lu(k,1337) * lu(k,2289) + lu(k,2293) = lu(k,2293) - lu(k,1338) * lu(k,2289) + lu(k,2297) = lu(k,2297) - lu(k,1339) * lu(k,2289) + lu(k,2299) = lu(k,2299) - lu(k,1340) * lu(k,2289) + lu(k,2300) = lu(k,2300) - lu(k,1341) * lu(k,2289) + lu(k,2301) = lu(k,2301) - lu(k,1342) * lu(k,2289) + lu(k,2303) = lu(k,2303) - lu(k,1343) * lu(k,2289) + lu(k,2305) = lu(k,2305) - lu(k,1344) * lu(k,2289) + lu(k,2306) = lu(k,2306) - lu(k,1345) * lu(k,2289) + lu(k,2308) = lu(k,2308) - lu(k,1346) * lu(k,2289) + lu(k,2310) = lu(k,2310) - lu(k,1347) * lu(k,2289) + lu(k,2311) = lu(k,2311) - lu(k,1348) * lu(k,2289) + lu(k,2313) = lu(k,2313) - lu(k,1349) * lu(k,2289) + lu(k,1358) = 1._r8 / lu(k,1358) + lu(k,1359) = lu(k,1359) * lu(k,1358) + lu(k,1360) = lu(k,1360) * lu(k,1358) + lu(k,1361) = lu(k,1361) * lu(k,1358) + lu(k,1362) = lu(k,1362) * lu(k,1358) + lu(k,1363) = lu(k,1363) * lu(k,1358) + lu(k,1364) = lu(k,1364) * lu(k,1358) + lu(k,1365) = lu(k,1365) * lu(k,1358) + lu(k,1366) = lu(k,1366) * lu(k,1358) + lu(k,1367) = lu(k,1367) * lu(k,1358) + lu(k,1368) = lu(k,1368) * lu(k,1358) + lu(k,1369) = lu(k,1369) * lu(k,1358) + lu(k,1370) = lu(k,1370) * lu(k,1358) + lu(k,1380) = - lu(k,1359) * lu(k,1378) + lu(k,1381) = lu(k,1381) - lu(k,1360) * lu(k,1378) + lu(k,1383) = lu(k,1383) - lu(k,1361) * lu(k,1378) + lu(k,1384) = lu(k,1384) - lu(k,1362) * lu(k,1378) + lu(k,1385) = lu(k,1385) - lu(k,1363) * lu(k,1378) + lu(k,1386) = lu(k,1386) - lu(k,1364) * lu(k,1378) + lu(k,1387) = lu(k,1387) - lu(k,1365) * lu(k,1378) + lu(k,1388) = lu(k,1388) - lu(k,1366) * lu(k,1378) + lu(k,1389) = lu(k,1389) - lu(k,1367) * lu(k,1378) + lu(k,1390) = lu(k,1390) - lu(k,1368) * lu(k,1378) + lu(k,1392) = lu(k,1392) - lu(k,1369) * lu(k,1378) + lu(k,1393) = lu(k,1393) - lu(k,1370) * lu(k,1378) + lu(k,1432) = lu(k,1432) - lu(k,1359) * lu(k,1430) + lu(k,1433) = lu(k,1433) - lu(k,1360) * lu(k,1430) + lu(k,1435) = lu(k,1435) - lu(k,1361) * lu(k,1430) + lu(k,1436) = lu(k,1436) - lu(k,1362) * lu(k,1430) + lu(k,1437) = lu(k,1437) - lu(k,1363) * lu(k,1430) + lu(k,1438) = lu(k,1438) - lu(k,1364) * lu(k,1430) + lu(k,1439) = lu(k,1439) - lu(k,1365) * lu(k,1430) + lu(k,1440) = lu(k,1440) - lu(k,1366) * lu(k,1430) + lu(k,1441) = lu(k,1441) - lu(k,1367) * lu(k,1430) + lu(k,1442) = lu(k,1442) - lu(k,1368) * lu(k,1430) + lu(k,1444) = lu(k,1444) - lu(k,1369) * lu(k,1430) + lu(k,1445) = lu(k,1445) - lu(k,1370) * lu(k,1430) + lu(k,1812) = lu(k,1812) - lu(k,1359) * lu(k,1810) + lu(k,1813) = lu(k,1813) - lu(k,1360) * lu(k,1810) + lu(k,1817) = lu(k,1817) - lu(k,1361) * lu(k,1810) + lu(k,1819) = lu(k,1819) - lu(k,1362) * lu(k,1810) + lu(k,1820) = lu(k,1820) - lu(k,1363) * lu(k,1810) + lu(k,1821) = lu(k,1821) - lu(k,1364) * lu(k,1810) + lu(k,1823) = lu(k,1823) - lu(k,1365) * lu(k,1810) + lu(k,1825) = lu(k,1825) - lu(k,1366) * lu(k,1810) + lu(k,1826) = lu(k,1826) - lu(k,1367) * lu(k,1810) + lu(k,1828) = lu(k,1828) - lu(k,1368) * lu(k,1810) + lu(k,1831) = lu(k,1831) - lu(k,1369) * lu(k,1810) + lu(k,1833) = lu(k,1833) - lu(k,1370) * lu(k,1810) + lu(k,1940) = lu(k,1940) - lu(k,1359) * lu(k,1938) + lu(k,1941) = lu(k,1941) - lu(k,1360) * lu(k,1938) + lu(k,1944) = lu(k,1944) - lu(k,1361) * lu(k,1938) + lu(k,1946) = lu(k,1946) - lu(k,1362) * lu(k,1938) + lu(k,1947) = lu(k,1947) - lu(k,1363) * lu(k,1938) + lu(k,1948) = lu(k,1948) - lu(k,1364) * lu(k,1938) + lu(k,1950) = lu(k,1950) - lu(k,1365) * lu(k,1938) + lu(k,1952) = lu(k,1952) - lu(k,1366) * lu(k,1938) + lu(k,1953) = lu(k,1953) - lu(k,1367) * lu(k,1938) + lu(k,1955) = lu(k,1955) - lu(k,1368) * lu(k,1938) + lu(k,1958) = lu(k,1958) - lu(k,1369) * lu(k,1938) + lu(k,1960) = lu(k,1960) - lu(k,1370) * lu(k,1938) + lu(k,1993) = lu(k,1993) - lu(k,1359) * lu(k,1991) + lu(k,1994) = lu(k,1994) - lu(k,1360) * lu(k,1991) + lu(k,1996) = lu(k,1996) - lu(k,1361) * lu(k,1991) + lu(k,1998) = lu(k,1998) - lu(k,1362) * lu(k,1991) + lu(k,1999) = lu(k,1999) - lu(k,1363) * lu(k,1991) + lu(k,2000) = lu(k,2000) - lu(k,1364) * lu(k,1991) + lu(k,2002) = lu(k,2002) - lu(k,1365) * lu(k,1991) + lu(k,2004) = lu(k,2004) - lu(k,1366) * lu(k,1991) + lu(k,2005) = lu(k,2005) - lu(k,1367) * lu(k,1991) + lu(k,2007) = lu(k,2007) - lu(k,1368) * lu(k,1991) + lu(k,2010) = lu(k,2010) - lu(k,1369) * lu(k,1991) + lu(k,2012) = lu(k,2012) - lu(k,1370) * lu(k,1991) + lu(k,2074) = lu(k,2074) - lu(k,1359) * lu(k,2072) + lu(k,2075) = lu(k,2075) - lu(k,1360) * lu(k,2072) + lu(k,2078) = lu(k,2078) - lu(k,1361) * lu(k,2072) + lu(k,2080) = lu(k,2080) - lu(k,1362) * lu(k,2072) + lu(k,2081) = lu(k,2081) - lu(k,1363) * lu(k,2072) + lu(k,2082) = lu(k,2082) - lu(k,1364) * lu(k,2072) + lu(k,2084) = lu(k,2084) - lu(k,1365) * lu(k,2072) + lu(k,2086) = lu(k,2086) - lu(k,1366) * lu(k,2072) + lu(k,2087) = lu(k,2087) - lu(k,1367) * lu(k,2072) + lu(k,2089) = lu(k,2089) - lu(k,1368) * lu(k,2072) + lu(k,2092) = lu(k,2092) - lu(k,1369) * lu(k,2072) + lu(k,2094) = lu(k,2094) - lu(k,1370) * lu(k,2072) + lu(k,2175) = lu(k,2175) - lu(k,1359) * lu(k,2173) + lu(k,2176) = lu(k,2176) - lu(k,1360) * lu(k,2173) + lu(k,2179) = lu(k,2179) - lu(k,1361) * lu(k,2173) + lu(k,2181) = lu(k,2181) - lu(k,1362) * lu(k,2173) + lu(k,2182) = lu(k,2182) - lu(k,1363) * lu(k,2173) + lu(k,2183) = lu(k,2183) - lu(k,1364) * lu(k,2173) + lu(k,2185) = lu(k,2185) - lu(k,1365) * lu(k,2173) + lu(k,2187) = lu(k,2187) - lu(k,1366) * lu(k,2173) + lu(k,2188) = lu(k,2188) - lu(k,1367) * lu(k,2173) + lu(k,2190) = lu(k,2190) - lu(k,1368) * lu(k,2173) + lu(k,2193) = lu(k,2193) - lu(k,1369) * lu(k,2173) + lu(k,2195) = lu(k,2195) - lu(k,1370) * lu(k,2173) + lu(k,2292) = lu(k,2292) - lu(k,1359) * lu(k,2290) + lu(k,2293) = lu(k,2293) - lu(k,1360) * lu(k,2290) + lu(k,2297) = lu(k,2297) - lu(k,1361) * lu(k,2290) + lu(k,2299) = lu(k,2299) - lu(k,1362) * lu(k,2290) + lu(k,2300) = lu(k,2300) - lu(k,1363) * lu(k,2290) + lu(k,2301) = lu(k,2301) - lu(k,1364) * lu(k,2290) + lu(k,2303) = lu(k,2303) - lu(k,1365) * lu(k,2290) + lu(k,2305) = lu(k,2305) - lu(k,1366) * lu(k,2290) + lu(k,2306) = lu(k,2306) - lu(k,1367) * lu(k,2290) + lu(k,2308) = lu(k,2308) - lu(k,1368) * lu(k,2290) + lu(k,2311) = lu(k,2311) - lu(k,1369) * lu(k,2290) + lu(k,2313) = lu(k,2313) - lu(k,1370) * lu(k,2290) + lu(k,1379) = 1._r8 / lu(k,1379) + lu(k,1380) = lu(k,1380) * lu(k,1379) + lu(k,1381) = lu(k,1381) * lu(k,1379) + lu(k,1382) = lu(k,1382) * lu(k,1379) + lu(k,1383) = lu(k,1383) * lu(k,1379) + lu(k,1384) = lu(k,1384) * lu(k,1379) + lu(k,1385) = lu(k,1385) * lu(k,1379) + lu(k,1386) = lu(k,1386) * lu(k,1379) + lu(k,1387) = lu(k,1387) * lu(k,1379) + lu(k,1388) = lu(k,1388) * lu(k,1379) + lu(k,1389) = lu(k,1389) * lu(k,1379) + lu(k,1390) = lu(k,1390) * lu(k,1379) + lu(k,1391) = lu(k,1391) * lu(k,1379) + lu(k,1392) = lu(k,1392) * lu(k,1379) + lu(k,1393) = lu(k,1393) * lu(k,1379) + lu(k,1432) = lu(k,1432) - lu(k,1380) * lu(k,1431) + lu(k,1433) = lu(k,1433) - lu(k,1381) * lu(k,1431) + lu(k,1434) = - lu(k,1382) * lu(k,1431) + lu(k,1435) = lu(k,1435) - lu(k,1383) * lu(k,1431) + lu(k,1436) = lu(k,1436) - lu(k,1384) * lu(k,1431) + lu(k,1437) = lu(k,1437) - lu(k,1385) * lu(k,1431) + lu(k,1438) = lu(k,1438) - lu(k,1386) * lu(k,1431) + lu(k,1439) = lu(k,1439) - lu(k,1387) * lu(k,1431) + lu(k,1440) = lu(k,1440) - lu(k,1388) * lu(k,1431) + lu(k,1441) = lu(k,1441) - lu(k,1389) * lu(k,1431) + lu(k,1442) = lu(k,1442) - lu(k,1390) * lu(k,1431) + lu(k,1443) = lu(k,1443) - lu(k,1391) * lu(k,1431) + lu(k,1444) = lu(k,1444) - lu(k,1392) * lu(k,1431) + lu(k,1445) = lu(k,1445) - lu(k,1393) * lu(k,1431) + lu(k,1812) = lu(k,1812) - lu(k,1380) * lu(k,1811) + lu(k,1813) = lu(k,1813) - lu(k,1381) * lu(k,1811) + lu(k,1816) = lu(k,1816) - lu(k,1382) * lu(k,1811) + lu(k,1817) = lu(k,1817) - lu(k,1383) * lu(k,1811) + lu(k,1819) = lu(k,1819) - lu(k,1384) * lu(k,1811) + lu(k,1820) = lu(k,1820) - lu(k,1385) * lu(k,1811) + lu(k,1821) = lu(k,1821) - lu(k,1386) * lu(k,1811) + lu(k,1823) = lu(k,1823) - lu(k,1387) * lu(k,1811) + lu(k,1825) = lu(k,1825) - lu(k,1388) * lu(k,1811) + lu(k,1826) = lu(k,1826) - lu(k,1389) * lu(k,1811) + lu(k,1828) = lu(k,1828) - lu(k,1390) * lu(k,1811) + lu(k,1830) = lu(k,1830) - lu(k,1391) * lu(k,1811) + lu(k,1831) = lu(k,1831) - lu(k,1392) * lu(k,1811) + lu(k,1833) = lu(k,1833) - lu(k,1393) * lu(k,1811) + lu(k,1940) = lu(k,1940) - lu(k,1380) * lu(k,1939) + lu(k,1941) = lu(k,1941) - lu(k,1381) * lu(k,1939) + lu(k,1943) = - lu(k,1382) * lu(k,1939) + lu(k,1944) = lu(k,1944) - lu(k,1383) * lu(k,1939) + lu(k,1946) = lu(k,1946) - lu(k,1384) * lu(k,1939) + lu(k,1947) = lu(k,1947) - lu(k,1385) * lu(k,1939) + lu(k,1948) = lu(k,1948) - lu(k,1386) * lu(k,1939) + lu(k,1950) = lu(k,1950) - lu(k,1387) * lu(k,1939) + lu(k,1952) = lu(k,1952) - lu(k,1388) * lu(k,1939) + lu(k,1953) = lu(k,1953) - lu(k,1389) * lu(k,1939) + lu(k,1955) = lu(k,1955) - lu(k,1390) * lu(k,1939) + lu(k,1957) = lu(k,1957) - lu(k,1391) * lu(k,1939) + lu(k,1958) = lu(k,1958) - lu(k,1392) * lu(k,1939) + lu(k,1960) = lu(k,1960) - lu(k,1393) * lu(k,1939) + lu(k,1993) = lu(k,1993) - lu(k,1380) * lu(k,1992) + lu(k,1994) = lu(k,1994) - lu(k,1381) * lu(k,1992) + lu(k,1995) = - lu(k,1382) * lu(k,1992) + lu(k,1996) = lu(k,1996) - lu(k,1383) * lu(k,1992) + lu(k,1998) = lu(k,1998) - lu(k,1384) * lu(k,1992) + lu(k,1999) = lu(k,1999) - lu(k,1385) * lu(k,1992) + lu(k,2000) = lu(k,2000) - lu(k,1386) * lu(k,1992) + lu(k,2002) = lu(k,2002) - lu(k,1387) * lu(k,1992) + lu(k,2004) = lu(k,2004) - lu(k,1388) * lu(k,1992) + lu(k,2005) = lu(k,2005) - lu(k,1389) * lu(k,1992) + lu(k,2007) = lu(k,2007) - lu(k,1390) * lu(k,1992) + lu(k,2009) = lu(k,2009) - lu(k,1391) * lu(k,1992) + lu(k,2010) = lu(k,2010) - lu(k,1392) * lu(k,1992) + lu(k,2012) = lu(k,2012) - lu(k,1393) * lu(k,1992) + lu(k,2074) = lu(k,2074) - lu(k,1380) * lu(k,2073) + lu(k,2075) = lu(k,2075) - lu(k,1381) * lu(k,2073) + lu(k,2077) = lu(k,2077) - lu(k,1382) * lu(k,2073) + lu(k,2078) = lu(k,2078) - lu(k,1383) * lu(k,2073) + lu(k,2080) = lu(k,2080) - lu(k,1384) * lu(k,2073) + lu(k,2081) = lu(k,2081) - lu(k,1385) * lu(k,2073) + lu(k,2082) = lu(k,2082) - lu(k,1386) * lu(k,2073) + lu(k,2084) = lu(k,2084) - lu(k,1387) * lu(k,2073) + lu(k,2086) = lu(k,2086) - lu(k,1388) * lu(k,2073) + lu(k,2087) = lu(k,2087) - lu(k,1389) * lu(k,2073) + lu(k,2089) = lu(k,2089) - lu(k,1390) * lu(k,2073) + lu(k,2091) = lu(k,2091) - lu(k,1391) * lu(k,2073) + lu(k,2092) = lu(k,2092) - lu(k,1392) * lu(k,2073) + lu(k,2094) = lu(k,2094) - lu(k,1393) * lu(k,2073) + lu(k,2175) = lu(k,2175) - lu(k,1380) * lu(k,2174) + lu(k,2176) = lu(k,2176) - lu(k,1381) * lu(k,2174) + lu(k,2178) = lu(k,2178) - lu(k,1382) * lu(k,2174) + lu(k,2179) = lu(k,2179) - lu(k,1383) * lu(k,2174) + lu(k,2181) = lu(k,2181) - lu(k,1384) * lu(k,2174) + lu(k,2182) = lu(k,2182) - lu(k,1385) * lu(k,2174) + lu(k,2183) = lu(k,2183) - lu(k,1386) * lu(k,2174) + lu(k,2185) = lu(k,2185) - lu(k,1387) * lu(k,2174) + lu(k,2187) = lu(k,2187) - lu(k,1388) * lu(k,2174) + lu(k,2188) = lu(k,2188) - lu(k,1389) * lu(k,2174) + lu(k,2190) = lu(k,2190) - lu(k,1390) * lu(k,2174) + lu(k,2192) = lu(k,2192) - lu(k,1391) * lu(k,2174) + lu(k,2193) = lu(k,2193) - lu(k,1392) * lu(k,2174) + lu(k,2195) = lu(k,2195) - lu(k,1393) * lu(k,2174) + lu(k,2292) = lu(k,2292) - lu(k,1380) * lu(k,2291) + lu(k,2293) = lu(k,2293) - lu(k,1381) * lu(k,2291) + lu(k,2296) = - lu(k,1382) * lu(k,2291) + lu(k,2297) = lu(k,2297) - lu(k,1383) * lu(k,2291) + lu(k,2299) = lu(k,2299) - lu(k,1384) * lu(k,2291) + lu(k,2300) = lu(k,2300) - lu(k,1385) * lu(k,2291) + lu(k,2301) = lu(k,2301) - lu(k,1386) * lu(k,2291) + lu(k,2303) = lu(k,2303) - lu(k,1387) * lu(k,2291) + lu(k,2305) = lu(k,2305) - lu(k,1388) * lu(k,2291) + lu(k,2306) = lu(k,2306) - lu(k,1389) * lu(k,2291) + lu(k,2308) = lu(k,2308) - lu(k,1390) * lu(k,2291) + lu(k,2310) = lu(k,2310) - lu(k,1391) * lu(k,2291) + lu(k,2311) = lu(k,2311) - lu(k,1392) * lu(k,2291) + lu(k,2313) = lu(k,2313) - lu(k,1393) * lu(k,2291) + end do + end subroutine lu_fac26 + subroutine lu_fac27( 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,1401) = 1._r8 / lu(k,1401) + lu(k,1402) = lu(k,1402) * lu(k,1401) + lu(k,1403) = lu(k,1403) * lu(k,1401) + lu(k,1404) = lu(k,1404) * lu(k,1401) + lu(k,1405) = lu(k,1405) * lu(k,1401) + lu(k,1406) = lu(k,1406) * lu(k,1401) + lu(k,1407) = lu(k,1407) * lu(k,1401) + lu(k,1408) = lu(k,1408) * lu(k,1401) + lu(k,1409) = lu(k,1409) * lu(k,1401) + lu(k,1410) = lu(k,1410) * lu(k,1401) + lu(k,1411) = lu(k,1411) * lu(k,1401) + lu(k,1412) = lu(k,1412) * lu(k,1401) + lu(k,1413) = lu(k,1413) * lu(k,1401) + lu(k,1433) = lu(k,1433) - lu(k,1402) * lu(k,1432) + lu(k,1435) = lu(k,1435) - lu(k,1403) * lu(k,1432) + lu(k,1436) = lu(k,1436) - lu(k,1404) * lu(k,1432) + lu(k,1437) = lu(k,1437) - lu(k,1405) * lu(k,1432) + lu(k,1438) = lu(k,1438) - lu(k,1406) * lu(k,1432) + lu(k,1439) = lu(k,1439) - lu(k,1407) * lu(k,1432) + lu(k,1440) = lu(k,1440) - lu(k,1408) * lu(k,1432) + lu(k,1441) = lu(k,1441) - lu(k,1409) * lu(k,1432) + lu(k,1442) = lu(k,1442) - lu(k,1410) * lu(k,1432) + lu(k,1443) = lu(k,1443) - lu(k,1411) * lu(k,1432) + lu(k,1444) = lu(k,1444) - lu(k,1412) * lu(k,1432) + lu(k,1445) = lu(k,1445) - lu(k,1413) * lu(k,1432) + lu(k,1570) = lu(k,1570) - lu(k,1402) * lu(k,1569) + lu(k,1573) = lu(k,1573) - lu(k,1403) * lu(k,1569) + lu(k,1575) = lu(k,1575) - lu(k,1404) * lu(k,1569) + lu(k,1576) = lu(k,1576) - lu(k,1405) * lu(k,1569) + lu(k,1577) = lu(k,1577) - lu(k,1406) * lu(k,1569) + lu(k,1579) = lu(k,1579) - lu(k,1407) * lu(k,1569) + lu(k,1581) = lu(k,1581) - lu(k,1408) * lu(k,1569) + lu(k,1582) = lu(k,1582) - lu(k,1409) * lu(k,1569) + lu(k,1584) = lu(k,1584) - lu(k,1410) * lu(k,1569) + lu(k,1586) = lu(k,1586) - lu(k,1411) * lu(k,1569) + lu(k,1587) = lu(k,1587) - lu(k,1412) * lu(k,1569) + lu(k,1589) = lu(k,1589) - lu(k,1413) * lu(k,1569) + lu(k,1813) = lu(k,1813) - lu(k,1402) * lu(k,1812) + lu(k,1817) = lu(k,1817) - lu(k,1403) * lu(k,1812) + lu(k,1819) = lu(k,1819) - lu(k,1404) * lu(k,1812) + lu(k,1820) = lu(k,1820) - lu(k,1405) * lu(k,1812) + lu(k,1821) = lu(k,1821) - lu(k,1406) * lu(k,1812) + lu(k,1823) = lu(k,1823) - lu(k,1407) * lu(k,1812) + lu(k,1825) = lu(k,1825) - lu(k,1408) * lu(k,1812) + lu(k,1826) = lu(k,1826) - lu(k,1409) * lu(k,1812) + lu(k,1828) = lu(k,1828) - lu(k,1410) * lu(k,1812) + lu(k,1830) = lu(k,1830) - lu(k,1411) * lu(k,1812) + lu(k,1831) = lu(k,1831) - lu(k,1412) * lu(k,1812) + lu(k,1833) = lu(k,1833) - lu(k,1413) * lu(k,1812) + lu(k,1941) = lu(k,1941) - lu(k,1402) * lu(k,1940) + lu(k,1944) = lu(k,1944) - lu(k,1403) * lu(k,1940) + lu(k,1946) = lu(k,1946) - lu(k,1404) * lu(k,1940) + lu(k,1947) = lu(k,1947) - lu(k,1405) * lu(k,1940) + lu(k,1948) = lu(k,1948) - lu(k,1406) * lu(k,1940) + lu(k,1950) = lu(k,1950) - lu(k,1407) * lu(k,1940) + lu(k,1952) = lu(k,1952) - lu(k,1408) * lu(k,1940) + lu(k,1953) = lu(k,1953) - lu(k,1409) * lu(k,1940) + lu(k,1955) = lu(k,1955) - lu(k,1410) * lu(k,1940) + lu(k,1957) = lu(k,1957) - lu(k,1411) * lu(k,1940) + lu(k,1958) = lu(k,1958) - lu(k,1412) * lu(k,1940) + lu(k,1960) = lu(k,1960) - lu(k,1413) * lu(k,1940) + lu(k,1994) = lu(k,1994) - lu(k,1402) * lu(k,1993) + lu(k,1996) = lu(k,1996) - lu(k,1403) * lu(k,1993) + lu(k,1998) = lu(k,1998) - lu(k,1404) * lu(k,1993) + lu(k,1999) = lu(k,1999) - lu(k,1405) * lu(k,1993) + lu(k,2000) = lu(k,2000) - lu(k,1406) * lu(k,1993) + lu(k,2002) = lu(k,2002) - lu(k,1407) * lu(k,1993) + lu(k,2004) = lu(k,2004) - lu(k,1408) * lu(k,1993) + lu(k,2005) = lu(k,2005) - lu(k,1409) * lu(k,1993) + lu(k,2007) = lu(k,2007) - lu(k,1410) * lu(k,1993) + lu(k,2009) = lu(k,2009) - lu(k,1411) * lu(k,1993) + lu(k,2010) = lu(k,2010) - lu(k,1412) * lu(k,1993) + lu(k,2012) = lu(k,2012) - lu(k,1413) * lu(k,1993) + lu(k,2075) = lu(k,2075) - lu(k,1402) * lu(k,2074) + lu(k,2078) = lu(k,2078) - lu(k,1403) * lu(k,2074) + lu(k,2080) = lu(k,2080) - lu(k,1404) * lu(k,2074) + lu(k,2081) = lu(k,2081) - lu(k,1405) * lu(k,2074) + lu(k,2082) = lu(k,2082) - lu(k,1406) * lu(k,2074) + lu(k,2084) = lu(k,2084) - lu(k,1407) * lu(k,2074) + lu(k,2086) = lu(k,2086) - lu(k,1408) * lu(k,2074) + lu(k,2087) = lu(k,2087) - lu(k,1409) * lu(k,2074) + lu(k,2089) = lu(k,2089) - lu(k,1410) * lu(k,2074) + lu(k,2091) = lu(k,2091) - lu(k,1411) * lu(k,2074) + lu(k,2092) = lu(k,2092) - lu(k,1412) * lu(k,2074) + lu(k,2094) = lu(k,2094) - lu(k,1413) * lu(k,2074) + lu(k,2176) = lu(k,2176) - lu(k,1402) * lu(k,2175) + lu(k,2179) = lu(k,2179) - lu(k,1403) * lu(k,2175) + lu(k,2181) = lu(k,2181) - lu(k,1404) * lu(k,2175) + lu(k,2182) = lu(k,2182) - lu(k,1405) * lu(k,2175) + lu(k,2183) = lu(k,2183) - lu(k,1406) * lu(k,2175) + lu(k,2185) = lu(k,2185) - lu(k,1407) * lu(k,2175) + lu(k,2187) = lu(k,2187) - lu(k,1408) * lu(k,2175) + lu(k,2188) = lu(k,2188) - lu(k,1409) * lu(k,2175) + lu(k,2190) = lu(k,2190) - lu(k,1410) * lu(k,2175) + lu(k,2192) = lu(k,2192) - lu(k,1411) * lu(k,2175) + lu(k,2193) = lu(k,2193) - lu(k,1412) * lu(k,2175) + lu(k,2195) = lu(k,2195) - lu(k,1413) * lu(k,2175) + lu(k,2293) = lu(k,2293) - lu(k,1402) * lu(k,2292) + lu(k,2297) = lu(k,2297) - lu(k,1403) * lu(k,2292) + lu(k,2299) = lu(k,2299) - lu(k,1404) * lu(k,2292) + lu(k,2300) = lu(k,2300) - lu(k,1405) * lu(k,2292) + lu(k,2301) = lu(k,2301) - lu(k,1406) * lu(k,2292) + lu(k,2303) = lu(k,2303) - lu(k,1407) * lu(k,2292) + lu(k,2305) = lu(k,2305) - lu(k,1408) * lu(k,2292) + lu(k,2306) = lu(k,2306) - lu(k,1409) * lu(k,2292) + lu(k,2308) = lu(k,2308) - lu(k,1410) * lu(k,2292) + lu(k,2310) = lu(k,2310) - lu(k,1411) * lu(k,2292) + lu(k,2311) = lu(k,2311) - lu(k,1412) * lu(k,2292) + lu(k,2313) = lu(k,2313) - lu(k,1413) * lu(k,2292) + lu(k,1433) = 1._r8 / lu(k,1433) + lu(k,1434) = lu(k,1434) * lu(k,1433) + lu(k,1435) = lu(k,1435) * lu(k,1433) + lu(k,1436) = lu(k,1436) * lu(k,1433) + lu(k,1437) = lu(k,1437) * lu(k,1433) + lu(k,1438) = lu(k,1438) * lu(k,1433) + lu(k,1439) = lu(k,1439) * lu(k,1433) + lu(k,1440) = lu(k,1440) * lu(k,1433) + lu(k,1441) = lu(k,1441) * lu(k,1433) + lu(k,1442) = lu(k,1442) * lu(k,1433) + lu(k,1443) = lu(k,1443) * lu(k,1433) + lu(k,1444) = lu(k,1444) * lu(k,1433) + lu(k,1445) = lu(k,1445) * lu(k,1433) + lu(k,1572) = - lu(k,1434) * lu(k,1570) + lu(k,1573) = lu(k,1573) - lu(k,1435) * lu(k,1570) + lu(k,1575) = lu(k,1575) - lu(k,1436) * lu(k,1570) + lu(k,1576) = lu(k,1576) - lu(k,1437) * lu(k,1570) + lu(k,1577) = lu(k,1577) - lu(k,1438) * lu(k,1570) + lu(k,1579) = lu(k,1579) - lu(k,1439) * lu(k,1570) + lu(k,1581) = lu(k,1581) - lu(k,1440) * lu(k,1570) + lu(k,1582) = lu(k,1582) - lu(k,1441) * lu(k,1570) + lu(k,1584) = lu(k,1584) - lu(k,1442) * lu(k,1570) + lu(k,1586) = lu(k,1586) - lu(k,1443) * lu(k,1570) + lu(k,1587) = lu(k,1587) - lu(k,1444) * lu(k,1570) + lu(k,1589) = lu(k,1589) - lu(k,1445) * lu(k,1570) + lu(k,1816) = lu(k,1816) - lu(k,1434) * lu(k,1813) + lu(k,1817) = lu(k,1817) - lu(k,1435) * lu(k,1813) + lu(k,1819) = lu(k,1819) - lu(k,1436) * lu(k,1813) + lu(k,1820) = lu(k,1820) - lu(k,1437) * lu(k,1813) + lu(k,1821) = lu(k,1821) - lu(k,1438) * lu(k,1813) + lu(k,1823) = lu(k,1823) - lu(k,1439) * lu(k,1813) + lu(k,1825) = lu(k,1825) - lu(k,1440) * lu(k,1813) + lu(k,1826) = lu(k,1826) - lu(k,1441) * lu(k,1813) + lu(k,1828) = lu(k,1828) - lu(k,1442) * lu(k,1813) + lu(k,1830) = lu(k,1830) - lu(k,1443) * lu(k,1813) + lu(k,1831) = lu(k,1831) - lu(k,1444) * lu(k,1813) + lu(k,1833) = lu(k,1833) - lu(k,1445) * lu(k,1813) + lu(k,1943) = lu(k,1943) - lu(k,1434) * lu(k,1941) + lu(k,1944) = lu(k,1944) - lu(k,1435) * lu(k,1941) + lu(k,1946) = lu(k,1946) - lu(k,1436) * lu(k,1941) + lu(k,1947) = lu(k,1947) - lu(k,1437) * lu(k,1941) + lu(k,1948) = lu(k,1948) - lu(k,1438) * lu(k,1941) + lu(k,1950) = lu(k,1950) - lu(k,1439) * lu(k,1941) + lu(k,1952) = lu(k,1952) - lu(k,1440) * lu(k,1941) + lu(k,1953) = lu(k,1953) - lu(k,1441) * lu(k,1941) + lu(k,1955) = lu(k,1955) - lu(k,1442) * lu(k,1941) + lu(k,1957) = lu(k,1957) - lu(k,1443) * lu(k,1941) + lu(k,1958) = lu(k,1958) - lu(k,1444) * lu(k,1941) + lu(k,1960) = lu(k,1960) - lu(k,1445) * lu(k,1941) + lu(k,1995) = lu(k,1995) - lu(k,1434) * lu(k,1994) + lu(k,1996) = lu(k,1996) - lu(k,1435) * lu(k,1994) + lu(k,1998) = lu(k,1998) - lu(k,1436) * lu(k,1994) + lu(k,1999) = lu(k,1999) - lu(k,1437) * lu(k,1994) + lu(k,2000) = lu(k,2000) - lu(k,1438) * lu(k,1994) + lu(k,2002) = lu(k,2002) - lu(k,1439) * lu(k,1994) + lu(k,2004) = lu(k,2004) - lu(k,1440) * lu(k,1994) + lu(k,2005) = lu(k,2005) - lu(k,1441) * lu(k,1994) + lu(k,2007) = lu(k,2007) - lu(k,1442) * lu(k,1994) + lu(k,2009) = lu(k,2009) - lu(k,1443) * lu(k,1994) + lu(k,2010) = lu(k,2010) - lu(k,1444) * lu(k,1994) + lu(k,2012) = lu(k,2012) - lu(k,1445) * lu(k,1994) + lu(k,2077) = lu(k,2077) - lu(k,1434) * lu(k,2075) + lu(k,2078) = lu(k,2078) - lu(k,1435) * lu(k,2075) + lu(k,2080) = lu(k,2080) - lu(k,1436) * lu(k,2075) + lu(k,2081) = lu(k,2081) - lu(k,1437) * lu(k,2075) + lu(k,2082) = lu(k,2082) - lu(k,1438) * lu(k,2075) + lu(k,2084) = lu(k,2084) - lu(k,1439) * lu(k,2075) + lu(k,2086) = lu(k,2086) - lu(k,1440) * lu(k,2075) + lu(k,2087) = lu(k,2087) - lu(k,1441) * lu(k,2075) + lu(k,2089) = lu(k,2089) - lu(k,1442) * lu(k,2075) + lu(k,2091) = lu(k,2091) - lu(k,1443) * lu(k,2075) + lu(k,2092) = lu(k,2092) - lu(k,1444) * lu(k,2075) + lu(k,2094) = lu(k,2094) - lu(k,1445) * lu(k,2075) + lu(k,2116) = lu(k,2116) - lu(k,1434) * lu(k,2113) + lu(k,2117) = lu(k,2117) - lu(k,1435) * lu(k,2113) + lu(k,2119) = lu(k,2119) - lu(k,1436) * lu(k,2113) + lu(k,2120) = lu(k,2120) - lu(k,1437) * lu(k,2113) + lu(k,2121) = lu(k,2121) - lu(k,1438) * lu(k,2113) + lu(k,2123) = lu(k,2123) - lu(k,1439) * lu(k,2113) + lu(k,2125) = lu(k,2125) - lu(k,1440) * lu(k,2113) + lu(k,2126) = lu(k,2126) - lu(k,1441) * lu(k,2113) + lu(k,2128) = lu(k,2128) - lu(k,1442) * lu(k,2113) + lu(k,2130) = lu(k,2130) - lu(k,1443) * lu(k,2113) + lu(k,2131) = lu(k,2131) - lu(k,1444) * lu(k,2113) + lu(k,2133) = lu(k,2133) - lu(k,1445) * lu(k,2113) + lu(k,2178) = lu(k,2178) - lu(k,1434) * lu(k,2176) + lu(k,2179) = lu(k,2179) - lu(k,1435) * lu(k,2176) + lu(k,2181) = lu(k,2181) - lu(k,1436) * lu(k,2176) + lu(k,2182) = lu(k,2182) - lu(k,1437) * lu(k,2176) + lu(k,2183) = lu(k,2183) - lu(k,1438) * lu(k,2176) + lu(k,2185) = lu(k,2185) - lu(k,1439) * lu(k,2176) + lu(k,2187) = lu(k,2187) - lu(k,1440) * lu(k,2176) + lu(k,2188) = lu(k,2188) - lu(k,1441) * lu(k,2176) + lu(k,2190) = lu(k,2190) - lu(k,1442) * lu(k,2176) + lu(k,2192) = lu(k,2192) - lu(k,1443) * lu(k,2176) + lu(k,2193) = lu(k,2193) - lu(k,1444) * lu(k,2176) + lu(k,2195) = lu(k,2195) - lu(k,1445) * lu(k,2176) + lu(k,2296) = lu(k,2296) - lu(k,1434) * lu(k,2293) + lu(k,2297) = lu(k,2297) - lu(k,1435) * lu(k,2293) + lu(k,2299) = lu(k,2299) - lu(k,1436) * lu(k,2293) + lu(k,2300) = lu(k,2300) - lu(k,1437) * lu(k,2293) + lu(k,2301) = lu(k,2301) - lu(k,1438) * lu(k,2293) + lu(k,2303) = lu(k,2303) - lu(k,1439) * lu(k,2293) + lu(k,2305) = lu(k,2305) - lu(k,1440) * lu(k,2293) + lu(k,2306) = lu(k,2306) - lu(k,1441) * lu(k,2293) + lu(k,2308) = lu(k,2308) - lu(k,1442) * lu(k,2293) + lu(k,2310) = lu(k,2310) - lu(k,1443) * lu(k,2293) + lu(k,2311) = lu(k,2311) - lu(k,1444) * lu(k,2293) + lu(k,2313) = lu(k,2313) - lu(k,1445) * lu(k,2293) + lu(k,1448) = 1._r8 / lu(k,1448) + lu(k,1449) = lu(k,1449) * lu(k,1448) + lu(k,1450) = lu(k,1450) * lu(k,1448) + lu(k,1451) = lu(k,1451) * lu(k,1448) + lu(k,1452) = lu(k,1452) * lu(k,1448) + lu(k,1453) = lu(k,1453) * lu(k,1448) + lu(k,1454) = lu(k,1454) * lu(k,1448) + lu(k,1455) = lu(k,1455) * lu(k,1448) + lu(k,1456) = lu(k,1456) * lu(k,1448) + lu(k,1457) = lu(k,1457) * lu(k,1448) + lu(k,1458) = lu(k,1458) * lu(k,1448) + lu(k,1459) = lu(k,1459) * lu(k,1448) + lu(k,1477) = lu(k,1477) - lu(k,1449) * lu(k,1476) + lu(k,1478) = lu(k,1478) - lu(k,1450) * lu(k,1476) + lu(k,1479) = lu(k,1479) - lu(k,1451) * lu(k,1476) + lu(k,1481) = lu(k,1481) - lu(k,1452) * lu(k,1476) + lu(k,1482) = lu(k,1482) - lu(k,1453) * lu(k,1476) + lu(k,1483) = lu(k,1483) - lu(k,1454) * lu(k,1476) + lu(k,1484) = lu(k,1484) - lu(k,1455) * lu(k,1476) + lu(k,1485) = lu(k,1485) - lu(k,1456) * lu(k,1476) + lu(k,1486) = lu(k,1486) - lu(k,1457) * lu(k,1476) + lu(k,1487) = lu(k,1487) - lu(k,1458) * lu(k,1476) + lu(k,1489) = lu(k,1489) - lu(k,1459) * lu(k,1476) + lu(k,1493) = lu(k,1493) - lu(k,1449) * lu(k,1492) + lu(k,1494) = lu(k,1494) - lu(k,1450) * lu(k,1492) + lu(k,1495) = lu(k,1495) - lu(k,1451) * lu(k,1492) + lu(k,1498) = - lu(k,1452) * lu(k,1492) + lu(k,1499) = - lu(k,1453) * lu(k,1492) + lu(k,1500) = lu(k,1500) - lu(k,1454) * lu(k,1492) + lu(k,1501) = lu(k,1501) - lu(k,1455) * lu(k,1492) + lu(k,1502) = - lu(k,1456) * lu(k,1492) + lu(k,1503) = lu(k,1503) - lu(k,1457) * lu(k,1492) + lu(k,1504) = - lu(k,1458) * lu(k,1492) + lu(k,1506) = lu(k,1506) - lu(k,1459) * lu(k,1492) + lu(k,1508) = - lu(k,1449) * lu(k,1507) + lu(k,1509) = - lu(k,1450) * lu(k,1507) + lu(k,1510) = lu(k,1510) - lu(k,1451) * lu(k,1507) + lu(k,1513) = lu(k,1513) - lu(k,1452) * lu(k,1507) + lu(k,1514) = - lu(k,1453) * lu(k,1507) + lu(k,1515) = lu(k,1515) - lu(k,1454) * lu(k,1507) + lu(k,1516) = - lu(k,1455) * lu(k,1507) + lu(k,1517) = - lu(k,1456) * lu(k,1507) + lu(k,1518) = - lu(k,1457) * lu(k,1507) + lu(k,1519) = - lu(k,1458) * lu(k,1507) + lu(k,1522) = lu(k,1522) - lu(k,1459) * lu(k,1507) + lu(k,1529) = - lu(k,1449) * lu(k,1527) + lu(k,1530) = lu(k,1530) - lu(k,1450) * lu(k,1527) + lu(k,1531) = lu(k,1531) - lu(k,1451) * lu(k,1527) + lu(k,1534) = lu(k,1534) - lu(k,1452) * lu(k,1527) + lu(k,1535) = lu(k,1535) - lu(k,1453) * lu(k,1527) + lu(k,1536) = lu(k,1536) - lu(k,1454) * lu(k,1527) + lu(k,1539) = - lu(k,1455) * lu(k,1527) + lu(k,1540) = lu(k,1540) - lu(k,1456) * lu(k,1527) + lu(k,1541) = lu(k,1541) - lu(k,1457) * lu(k,1527) + lu(k,1542) = lu(k,1542) - lu(k,1458) * lu(k,1527) + lu(k,1545) = lu(k,1545) - lu(k,1459) * lu(k,1527) + lu(k,1603) = - lu(k,1449) * lu(k,1601) + lu(k,1604) = lu(k,1604) - lu(k,1450) * lu(k,1601) + lu(k,1605) = lu(k,1605) - lu(k,1451) * lu(k,1601) + lu(k,1608) = lu(k,1608) - lu(k,1452) * lu(k,1601) + lu(k,1609) = lu(k,1609) - lu(k,1453) * lu(k,1601) + lu(k,1610) = lu(k,1610) - lu(k,1454) * lu(k,1601) + lu(k,1613) = - lu(k,1455) * lu(k,1601) + lu(k,1614) = lu(k,1614) - lu(k,1456) * lu(k,1601) + lu(k,1615) = lu(k,1615) - lu(k,1457) * lu(k,1601) + lu(k,1616) = lu(k,1616) - lu(k,1458) * lu(k,1601) + lu(k,1620) = lu(k,1620) - lu(k,1459) * lu(k,1601) + lu(k,1644) = lu(k,1644) - lu(k,1449) * lu(k,1642) + lu(k,1645) = lu(k,1645) - lu(k,1450) * lu(k,1642) + lu(k,1646) = lu(k,1646) - lu(k,1451) * lu(k,1642) + lu(k,1649) = lu(k,1649) - lu(k,1452) * lu(k,1642) + lu(k,1650) = lu(k,1650) - lu(k,1453) * lu(k,1642) + lu(k,1651) = lu(k,1651) - lu(k,1454) * lu(k,1642) + lu(k,1654) = lu(k,1654) - lu(k,1455) * lu(k,1642) + lu(k,1655) = lu(k,1655) - lu(k,1456) * lu(k,1642) + lu(k,1656) = lu(k,1656) - lu(k,1457) * lu(k,1642) + lu(k,1657) = lu(k,1657) - lu(k,1458) * lu(k,1642) + lu(k,1661) = lu(k,1661) - lu(k,1459) * lu(k,1642) + lu(k,1816) = lu(k,1816) - lu(k,1449) * lu(k,1814) + lu(k,1817) = lu(k,1817) - lu(k,1450) * lu(k,1814) + lu(k,1818) = lu(k,1818) - lu(k,1451) * lu(k,1814) + lu(k,1821) = lu(k,1821) - lu(k,1452) * lu(k,1814) + lu(k,1822) = lu(k,1822) - lu(k,1453) * lu(k,1814) + lu(k,1823) = lu(k,1823) - lu(k,1454) * lu(k,1814) + lu(k,1826) = lu(k,1826) - lu(k,1455) * lu(k,1814) + lu(k,1827) = lu(k,1827) - lu(k,1456) * lu(k,1814) + lu(k,1828) = lu(k,1828) - lu(k,1457) * lu(k,1814) + lu(k,1829) = lu(k,1829) - lu(k,1458) * lu(k,1814) + lu(k,1833) = lu(k,1833) - lu(k,1459) * lu(k,1814) + lu(k,2116) = lu(k,2116) - lu(k,1449) * lu(k,2114) + lu(k,2117) = lu(k,2117) - lu(k,1450) * lu(k,2114) + lu(k,2118) = lu(k,2118) - lu(k,1451) * lu(k,2114) + lu(k,2121) = lu(k,2121) - lu(k,1452) * lu(k,2114) + lu(k,2122) = lu(k,2122) - lu(k,1453) * lu(k,2114) + lu(k,2123) = lu(k,2123) - lu(k,1454) * lu(k,2114) + lu(k,2126) = lu(k,2126) - lu(k,1455) * lu(k,2114) + lu(k,2127) = lu(k,2127) - lu(k,1456) * lu(k,2114) + lu(k,2128) = lu(k,2128) - lu(k,1457) * lu(k,2114) + lu(k,2129) = lu(k,2129) - lu(k,1458) * lu(k,2114) + lu(k,2133) = lu(k,2133) - lu(k,1459) * lu(k,2114) + lu(k,2296) = lu(k,2296) - lu(k,1449) * lu(k,2294) + lu(k,2297) = lu(k,2297) - lu(k,1450) * lu(k,2294) + lu(k,2298) = lu(k,2298) - lu(k,1451) * lu(k,2294) + lu(k,2301) = lu(k,2301) - lu(k,1452) * lu(k,2294) + lu(k,2302) = lu(k,2302) - lu(k,1453) * lu(k,2294) + lu(k,2303) = lu(k,2303) - lu(k,1454) * lu(k,2294) + lu(k,2306) = lu(k,2306) - lu(k,1455) * lu(k,2294) + lu(k,2307) = lu(k,2307) - lu(k,1456) * lu(k,2294) + lu(k,2308) = lu(k,2308) - lu(k,1457) * lu(k,2294) + lu(k,2309) = lu(k,2309) - lu(k,1458) * lu(k,2294) + lu(k,2313) = lu(k,2313) - lu(k,1459) * lu(k,2294) + lu(k,2348) = lu(k,2348) - lu(k,1449) * lu(k,2346) + lu(k,2349) = lu(k,2349) - lu(k,1450) * lu(k,2346) + lu(k,2350) = lu(k,2350) - lu(k,1451) * lu(k,2346) + lu(k,2353) = lu(k,2353) - lu(k,1452) * lu(k,2346) + lu(k,2354) = lu(k,2354) - lu(k,1453) * lu(k,2346) + lu(k,2355) = lu(k,2355) - lu(k,1454) * lu(k,2346) + lu(k,2358) = lu(k,2358) - lu(k,1455) * lu(k,2346) + lu(k,2359) = - lu(k,1456) * lu(k,2346) + lu(k,2360) = lu(k,2360) - lu(k,1457) * lu(k,2346) + lu(k,2361) = lu(k,2361) - lu(k,1458) * lu(k,2346) + lu(k,2365) = lu(k,2365) - lu(k,1459) * lu(k,2346) + end do + end subroutine lu_fac27 + subroutine lu_fac28( 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,1462) = 1._r8 / lu(k,1462) + lu(k,1463) = lu(k,1463) * lu(k,1462) + lu(k,1464) = lu(k,1464) * lu(k,1462) + lu(k,1465) = lu(k,1465) * lu(k,1462) + lu(k,1466) = lu(k,1466) * lu(k,1462) + lu(k,1467) = lu(k,1467) * lu(k,1462) + lu(k,1468) = lu(k,1468) * lu(k,1462) + lu(k,1469) = lu(k,1469) * lu(k,1462) + lu(k,1470) = lu(k,1470) * lu(k,1462) + lu(k,1471) = lu(k,1471) * lu(k,1462) + lu(k,1531) = lu(k,1531) - lu(k,1463) * lu(k,1528) + lu(k,1532) = lu(k,1532) - lu(k,1464) * lu(k,1528) + lu(k,1534) = lu(k,1534) - lu(k,1465) * lu(k,1528) + lu(k,1535) = lu(k,1535) - lu(k,1466) * lu(k,1528) + lu(k,1536) = lu(k,1536) - lu(k,1467) * lu(k,1528) + lu(k,1537) = lu(k,1537) - lu(k,1468) * lu(k,1528) + lu(k,1543) = - lu(k,1469) * lu(k,1528) + lu(k,1544) = lu(k,1544) - lu(k,1470) * lu(k,1528) + lu(k,1545) = lu(k,1545) - lu(k,1471) * lu(k,1528) + lu(k,1574) = lu(k,1574) - lu(k,1463) * lu(k,1571) + lu(k,1575) = lu(k,1575) - lu(k,1464) * lu(k,1571) + lu(k,1577) = lu(k,1577) - lu(k,1465) * lu(k,1571) + lu(k,1578) = lu(k,1578) - lu(k,1466) * lu(k,1571) + lu(k,1579) = lu(k,1579) - lu(k,1467) * lu(k,1571) + lu(k,1580) = lu(k,1580) - lu(k,1468) * lu(k,1571) + lu(k,1586) = lu(k,1586) - lu(k,1469) * lu(k,1571) + lu(k,1587) = lu(k,1587) - lu(k,1470) * lu(k,1571) + lu(k,1589) = lu(k,1589) - lu(k,1471) * lu(k,1571) + lu(k,1605) = lu(k,1605) - lu(k,1463) * lu(k,1602) + lu(k,1606) = lu(k,1606) - lu(k,1464) * lu(k,1602) + lu(k,1608) = lu(k,1608) - lu(k,1465) * lu(k,1602) + lu(k,1609) = lu(k,1609) - lu(k,1466) * lu(k,1602) + lu(k,1610) = lu(k,1610) - lu(k,1467) * lu(k,1602) + lu(k,1611) = lu(k,1611) - lu(k,1468) * lu(k,1602) + lu(k,1617) = lu(k,1617) - lu(k,1469) * lu(k,1602) + lu(k,1618) = lu(k,1618) - lu(k,1470) * lu(k,1602) + lu(k,1620) = lu(k,1620) - lu(k,1471) * lu(k,1602) + lu(k,1646) = lu(k,1646) - lu(k,1463) * lu(k,1643) + lu(k,1647) = lu(k,1647) - lu(k,1464) * lu(k,1643) + lu(k,1649) = lu(k,1649) - lu(k,1465) * lu(k,1643) + lu(k,1650) = lu(k,1650) - lu(k,1466) * lu(k,1643) + lu(k,1651) = lu(k,1651) - lu(k,1467) * lu(k,1643) + lu(k,1652) = lu(k,1652) - lu(k,1468) * lu(k,1643) + lu(k,1658) = lu(k,1658) - lu(k,1469) * lu(k,1643) + lu(k,1659) = lu(k,1659) - lu(k,1470) * lu(k,1643) + lu(k,1661) = lu(k,1661) - lu(k,1471) * lu(k,1643) + lu(k,1818) = lu(k,1818) - lu(k,1463) * lu(k,1815) + lu(k,1819) = lu(k,1819) - lu(k,1464) * lu(k,1815) + lu(k,1821) = lu(k,1821) - lu(k,1465) * lu(k,1815) + lu(k,1822) = lu(k,1822) - lu(k,1466) * lu(k,1815) + lu(k,1823) = lu(k,1823) - lu(k,1467) * lu(k,1815) + lu(k,1824) = lu(k,1824) - lu(k,1468) * lu(k,1815) + lu(k,1830) = lu(k,1830) - lu(k,1469) * lu(k,1815) + lu(k,1831) = lu(k,1831) - lu(k,1470) * lu(k,1815) + lu(k,1833) = lu(k,1833) - lu(k,1471) * lu(k,1815) + lu(k,1842) = lu(k,1842) - lu(k,1463) * lu(k,1840) + lu(k,1843) = - lu(k,1464) * lu(k,1840) + lu(k,1845) = lu(k,1845) - lu(k,1465) * lu(k,1840) + lu(k,1846) = - lu(k,1466) * lu(k,1840) + lu(k,1847) = lu(k,1847) - lu(k,1467) * lu(k,1840) + lu(k,1848) = lu(k,1848) - lu(k,1468) * lu(k,1840) + lu(k,1854) = lu(k,1854) - lu(k,1469) * lu(k,1840) + lu(k,1855) = lu(k,1855) - lu(k,1470) * lu(k,1840) + lu(k,1857) = lu(k,1857) - lu(k,1471) * lu(k,1840) + lu(k,1945) = lu(k,1945) - lu(k,1463) * lu(k,1942) + lu(k,1946) = lu(k,1946) - lu(k,1464) * lu(k,1942) + lu(k,1948) = lu(k,1948) - lu(k,1465) * lu(k,1942) + lu(k,1949) = lu(k,1949) - lu(k,1466) * lu(k,1942) + lu(k,1950) = lu(k,1950) - lu(k,1467) * lu(k,1942) + lu(k,1951) = lu(k,1951) - lu(k,1468) * lu(k,1942) + lu(k,1957) = lu(k,1957) - lu(k,1469) * lu(k,1942) + lu(k,1958) = lu(k,1958) - lu(k,1470) * lu(k,1942) + lu(k,1960) = lu(k,1960) - lu(k,1471) * lu(k,1942) + lu(k,2020) = lu(k,2020) - lu(k,1463) * lu(k,2018) + lu(k,2021) = - lu(k,1464) * lu(k,2018) + lu(k,2023) = lu(k,2023) - lu(k,1465) * lu(k,2018) + lu(k,2024) = lu(k,2024) - lu(k,1466) * lu(k,2018) + lu(k,2025) = lu(k,2025) - lu(k,1467) * lu(k,2018) + lu(k,2026) = lu(k,2026) - lu(k,1468) * lu(k,2018) + lu(k,2032) = - lu(k,1469) * lu(k,2018) + lu(k,2033) = - lu(k,1470) * lu(k,2018) + lu(k,2035) = lu(k,2035) - lu(k,1471) * lu(k,2018) + lu(k,2079) = lu(k,2079) - lu(k,1463) * lu(k,2076) + lu(k,2080) = lu(k,2080) - lu(k,1464) * lu(k,2076) + lu(k,2082) = lu(k,2082) - lu(k,1465) * lu(k,2076) + lu(k,2083) = - lu(k,1466) * lu(k,2076) + lu(k,2084) = lu(k,2084) - lu(k,1467) * lu(k,2076) + lu(k,2085) = lu(k,2085) - lu(k,1468) * lu(k,2076) + lu(k,2091) = lu(k,2091) - lu(k,1469) * lu(k,2076) + lu(k,2092) = lu(k,2092) - lu(k,1470) * lu(k,2076) + lu(k,2094) = lu(k,2094) - lu(k,1471) * lu(k,2076) + lu(k,2118) = lu(k,2118) - lu(k,1463) * lu(k,2115) + lu(k,2119) = lu(k,2119) - lu(k,1464) * lu(k,2115) + lu(k,2121) = lu(k,2121) - lu(k,1465) * lu(k,2115) + lu(k,2122) = lu(k,2122) - lu(k,1466) * lu(k,2115) + lu(k,2123) = lu(k,2123) - lu(k,1467) * lu(k,2115) + lu(k,2124) = - lu(k,1468) * lu(k,2115) + lu(k,2130) = lu(k,2130) - lu(k,1469) * lu(k,2115) + lu(k,2131) = lu(k,2131) - lu(k,1470) * lu(k,2115) + lu(k,2133) = lu(k,2133) - lu(k,1471) * lu(k,2115) + lu(k,2180) = lu(k,2180) - lu(k,1463) * lu(k,2177) + lu(k,2181) = lu(k,2181) - lu(k,1464) * lu(k,2177) + lu(k,2183) = lu(k,2183) - lu(k,1465) * lu(k,2177) + lu(k,2184) = lu(k,2184) - lu(k,1466) * lu(k,2177) + lu(k,2185) = lu(k,2185) - lu(k,1467) * lu(k,2177) + lu(k,2186) = lu(k,2186) - lu(k,1468) * lu(k,2177) + lu(k,2192) = lu(k,2192) - lu(k,1469) * lu(k,2177) + lu(k,2193) = lu(k,2193) - lu(k,1470) * lu(k,2177) + lu(k,2195) = lu(k,2195) - lu(k,1471) * lu(k,2177) + lu(k,2298) = lu(k,2298) - lu(k,1463) * lu(k,2295) + lu(k,2299) = lu(k,2299) - lu(k,1464) * lu(k,2295) + lu(k,2301) = lu(k,2301) - lu(k,1465) * lu(k,2295) + lu(k,2302) = lu(k,2302) - lu(k,1466) * lu(k,2295) + lu(k,2303) = lu(k,2303) - lu(k,1467) * lu(k,2295) + lu(k,2304) = lu(k,2304) - lu(k,1468) * lu(k,2295) + lu(k,2310) = lu(k,2310) - lu(k,1469) * lu(k,2295) + lu(k,2311) = lu(k,2311) - lu(k,1470) * lu(k,2295) + lu(k,2313) = lu(k,2313) - lu(k,1471) * lu(k,2295) + lu(k,2324) = lu(k,2324) - lu(k,1463) * lu(k,2322) + lu(k,2325) = lu(k,2325) - lu(k,1464) * lu(k,2322) + lu(k,2327) = lu(k,2327) - lu(k,1465) * lu(k,2322) + lu(k,2328) = - lu(k,1466) * lu(k,2322) + lu(k,2329) = lu(k,2329) - lu(k,1467) * lu(k,2322) + lu(k,2330) = lu(k,2330) - lu(k,1468) * lu(k,2322) + lu(k,2336) = lu(k,2336) - lu(k,1469) * lu(k,2322) + lu(k,2337) = lu(k,2337) - lu(k,1470) * lu(k,2322) + lu(k,2339) = lu(k,2339) - lu(k,1471) * lu(k,2322) + lu(k,2350) = lu(k,2350) - lu(k,1463) * lu(k,2347) + lu(k,2351) = - lu(k,1464) * lu(k,2347) + lu(k,2353) = lu(k,2353) - lu(k,1465) * lu(k,2347) + lu(k,2354) = lu(k,2354) - lu(k,1466) * lu(k,2347) + lu(k,2355) = lu(k,2355) - lu(k,1467) * lu(k,2347) + lu(k,2356) = lu(k,2356) - lu(k,1468) * lu(k,2347) + lu(k,2362) = lu(k,2362) - lu(k,1469) * lu(k,2347) + lu(k,2363) = lu(k,2363) - lu(k,1470) * lu(k,2347) + lu(k,2365) = lu(k,2365) - lu(k,1471) * lu(k,2347) + lu(k,1477) = 1._r8 / lu(k,1477) + lu(k,1478) = lu(k,1478) * lu(k,1477) + lu(k,1479) = lu(k,1479) * lu(k,1477) + lu(k,1480) = lu(k,1480) * lu(k,1477) + lu(k,1481) = lu(k,1481) * lu(k,1477) + lu(k,1482) = lu(k,1482) * lu(k,1477) + lu(k,1483) = lu(k,1483) * lu(k,1477) + lu(k,1484) = lu(k,1484) * lu(k,1477) + lu(k,1485) = lu(k,1485) * lu(k,1477) + lu(k,1486) = lu(k,1486) * lu(k,1477) + lu(k,1487) = lu(k,1487) * lu(k,1477) + lu(k,1488) = lu(k,1488) * lu(k,1477) + lu(k,1489) = lu(k,1489) * lu(k,1477) + lu(k,1494) = lu(k,1494) - lu(k,1478) * lu(k,1493) + lu(k,1495) = lu(k,1495) - lu(k,1479) * lu(k,1493) + lu(k,1496) = - lu(k,1480) * lu(k,1493) + lu(k,1498) = lu(k,1498) - lu(k,1481) * lu(k,1493) + lu(k,1499) = lu(k,1499) - lu(k,1482) * lu(k,1493) + lu(k,1500) = lu(k,1500) - lu(k,1483) * lu(k,1493) + lu(k,1501) = lu(k,1501) - lu(k,1484) * lu(k,1493) + lu(k,1502) = lu(k,1502) - lu(k,1485) * lu(k,1493) + lu(k,1503) = lu(k,1503) - lu(k,1486) * lu(k,1493) + lu(k,1504) = lu(k,1504) - lu(k,1487) * lu(k,1493) + lu(k,1505) = - lu(k,1488) * lu(k,1493) + lu(k,1506) = lu(k,1506) - lu(k,1489) * lu(k,1493) + lu(k,1509) = lu(k,1509) - lu(k,1478) * lu(k,1508) + lu(k,1510) = lu(k,1510) - lu(k,1479) * lu(k,1508) + lu(k,1511) = - lu(k,1480) * lu(k,1508) + lu(k,1513) = lu(k,1513) - lu(k,1481) * lu(k,1508) + lu(k,1514) = lu(k,1514) - lu(k,1482) * lu(k,1508) + lu(k,1515) = lu(k,1515) - lu(k,1483) * lu(k,1508) + lu(k,1516) = lu(k,1516) - lu(k,1484) * lu(k,1508) + lu(k,1517) = lu(k,1517) - lu(k,1485) * lu(k,1508) + lu(k,1518) = lu(k,1518) - lu(k,1486) * lu(k,1508) + lu(k,1519) = lu(k,1519) - lu(k,1487) * lu(k,1508) + lu(k,1521) = lu(k,1521) - lu(k,1488) * lu(k,1508) + lu(k,1522) = lu(k,1522) - lu(k,1489) * lu(k,1508) + lu(k,1530) = lu(k,1530) - lu(k,1478) * lu(k,1529) + lu(k,1531) = lu(k,1531) - lu(k,1479) * lu(k,1529) + lu(k,1532) = lu(k,1532) - lu(k,1480) * lu(k,1529) + lu(k,1534) = lu(k,1534) - lu(k,1481) * lu(k,1529) + lu(k,1535) = lu(k,1535) - lu(k,1482) * lu(k,1529) + lu(k,1536) = lu(k,1536) - lu(k,1483) * lu(k,1529) + lu(k,1539) = lu(k,1539) - lu(k,1484) * lu(k,1529) + lu(k,1540) = lu(k,1540) - lu(k,1485) * lu(k,1529) + lu(k,1541) = lu(k,1541) - lu(k,1486) * lu(k,1529) + lu(k,1542) = lu(k,1542) - lu(k,1487) * lu(k,1529) + lu(k,1544) = lu(k,1544) - lu(k,1488) * lu(k,1529) + lu(k,1545) = lu(k,1545) - lu(k,1489) * lu(k,1529) + lu(k,1573) = lu(k,1573) - lu(k,1478) * lu(k,1572) + lu(k,1574) = lu(k,1574) - lu(k,1479) * lu(k,1572) + lu(k,1575) = lu(k,1575) - lu(k,1480) * lu(k,1572) + lu(k,1577) = lu(k,1577) - lu(k,1481) * lu(k,1572) + lu(k,1578) = lu(k,1578) - lu(k,1482) * lu(k,1572) + lu(k,1579) = lu(k,1579) - lu(k,1483) * lu(k,1572) + lu(k,1582) = lu(k,1582) - lu(k,1484) * lu(k,1572) + lu(k,1583) = lu(k,1583) - lu(k,1485) * lu(k,1572) + lu(k,1584) = lu(k,1584) - lu(k,1486) * lu(k,1572) + lu(k,1585) = lu(k,1585) - lu(k,1487) * lu(k,1572) + lu(k,1587) = lu(k,1587) - lu(k,1488) * lu(k,1572) + lu(k,1589) = lu(k,1589) - lu(k,1489) * lu(k,1572) + lu(k,1604) = lu(k,1604) - lu(k,1478) * lu(k,1603) + lu(k,1605) = lu(k,1605) - lu(k,1479) * lu(k,1603) + lu(k,1606) = lu(k,1606) - lu(k,1480) * lu(k,1603) + lu(k,1608) = lu(k,1608) - lu(k,1481) * lu(k,1603) + lu(k,1609) = lu(k,1609) - lu(k,1482) * lu(k,1603) + lu(k,1610) = lu(k,1610) - lu(k,1483) * lu(k,1603) + lu(k,1613) = lu(k,1613) - lu(k,1484) * lu(k,1603) + lu(k,1614) = lu(k,1614) - lu(k,1485) * lu(k,1603) + lu(k,1615) = lu(k,1615) - lu(k,1486) * lu(k,1603) + lu(k,1616) = lu(k,1616) - lu(k,1487) * lu(k,1603) + lu(k,1618) = lu(k,1618) - lu(k,1488) * lu(k,1603) + lu(k,1620) = lu(k,1620) - lu(k,1489) * lu(k,1603) + lu(k,1645) = lu(k,1645) - lu(k,1478) * lu(k,1644) + lu(k,1646) = lu(k,1646) - lu(k,1479) * lu(k,1644) + lu(k,1647) = lu(k,1647) - lu(k,1480) * lu(k,1644) + lu(k,1649) = lu(k,1649) - lu(k,1481) * lu(k,1644) + lu(k,1650) = lu(k,1650) - lu(k,1482) * lu(k,1644) + lu(k,1651) = lu(k,1651) - lu(k,1483) * lu(k,1644) + lu(k,1654) = lu(k,1654) - lu(k,1484) * lu(k,1644) + lu(k,1655) = lu(k,1655) - lu(k,1485) * lu(k,1644) + lu(k,1656) = lu(k,1656) - lu(k,1486) * lu(k,1644) + lu(k,1657) = lu(k,1657) - lu(k,1487) * lu(k,1644) + lu(k,1659) = lu(k,1659) - lu(k,1488) * lu(k,1644) + lu(k,1661) = lu(k,1661) - lu(k,1489) * lu(k,1644) + lu(k,1817) = lu(k,1817) - lu(k,1478) * lu(k,1816) + lu(k,1818) = lu(k,1818) - lu(k,1479) * lu(k,1816) + lu(k,1819) = lu(k,1819) - lu(k,1480) * lu(k,1816) + lu(k,1821) = lu(k,1821) - lu(k,1481) * lu(k,1816) + lu(k,1822) = lu(k,1822) - lu(k,1482) * lu(k,1816) + lu(k,1823) = lu(k,1823) - lu(k,1483) * lu(k,1816) + lu(k,1826) = lu(k,1826) - lu(k,1484) * lu(k,1816) + lu(k,1827) = lu(k,1827) - lu(k,1485) * lu(k,1816) + lu(k,1828) = lu(k,1828) - lu(k,1486) * lu(k,1816) + lu(k,1829) = lu(k,1829) - lu(k,1487) * lu(k,1816) + lu(k,1831) = lu(k,1831) - lu(k,1488) * lu(k,1816) + lu(k,1833) = lu(k,1833) - lu(k,1489) * lu(k,1816) + lu(k,1944) = lu(k,1944) - lu(k,1478) * lu(k,1943) + lu(k,1945) = lu(k,1945) - lu(k,1479) * lu(k,1943) + lu(k,1946) = lu(k,1946) - lu(k,1480) * lu(k,1943) + lu(k,1948) = lu(k,1948) - lu(k,1481) * lu(k,1943) + lu(k,1949) = lu(k,1949) - lu(k,1482) * lu(k,1943) + lu(k,1950) = lu(k,1950) - lu(k,1483) * lu(k,1943) + lu(k,1953) = lu(k,1953) - lu(k,1484) * lu(k,1943) + lu(k,1954) = - lu(k,1485) * lu(k,1943) + lu(k,1955) = lu(k,1955) - lu(k,1486) * lu(k,1943) + lu(k,1956) = lu(k,1956) - lu(k,1487) * lu(k,1943) + lu(k,1958) = lu(k,1958) - lu(k,1488) * lu(k,1943) + lu(k,1960) = lu(k,1960) - lu(k,1489) * lu(k,1943) + lu(k,1996) = lu(k,1996) - lu(k,1478) * lu(k,1995) + lu(k,1997) = lu(k,1997) - lu(k,1479) * lu(k,1995) + lu(k,1998) = lu(k,1998) - lu(k,1480) * lu(k,1995) + lu(k,2000) = lu(k,2000) - lu(k,1481) * lu(k,1995) + lu(k,2001) = - lu(k,1482) * lu(k,1995) + lu(k,2002) = lu(k,2002) - lu(k,1483) * lu(k,1995) + lu(k,2005) = lu(k,2005) - lu(k,1484) * lu(k,1995) + lu(k,2006) = - lu(k,1485) * lu(k,1995) + lu(k,2007) = lu(k,2007) - lu(k,1486) * lu(k,1995) + lu(k,2008) = lu(k,2008) - lu(k,1487) * lu(k,1995) + lu(k,2010) = lu(k,2010) - lu(k,1488) * lu(k,1995) + lu(k,2012) = lu(k,2012) - lu(k,1489) * lu(k,1995) + lu(k,2078) = lu(k,2078) - lu(k,1478) * lu(k,2077) + lu(k,2079) = lu(k,2079) - lu(k,1479) * lu(k,2077) + lu(k,2080) = lu(k,2080) - lu(k,1480) * lu(k,2077) + lu(k,2082) = lu(k,2082) - lu(k,1481) * lu(k,2077) + lu(k,2083) = lu(k,2083) - lu(k,1482) * lu(k,2077) + lu(k,2084) = lu(k,2084) - lu(k,1483) * lu(k,2077) + lu(k,2087) = lu(k,2087) - lu(k,1484) * lu(k,2077) + lu(k,2088) = - lu(k,1485) * lu(k,2077) + lu(k,2089) = lu(k,2089) - lu(k,1486) * lu(k,2077) + lu(k,2090) = lu(k,2090) - lu(k,1487) * lu(k,2077) + lu(k,2092) = lu(k,2092) - lu(k,1488) * lu(k,2077) + lu(k,2094) = lu(k,2094) - lu(k,1489) * lu(k,2077) + lu(k,2117) = lu(k,2117) - lu(k,1478) * lu(k,2116) + lu(k,2118) = lu(k,2118) - lu(k,1479) * lu(k,2116) + lu(k,2119) = lu(k,2119) - lu(k,1480) * lu(k,2116) + lu(k,2121) = lu(k,2121) - lu(k,1481) * lu(k,2116) + lu(k,2122) = lu(k,2122) - lu(k,1482) * lu(k,2116) + lu(k,2123) = lu(k,2123) - lu(k,1483) * lu(k,2116) + lu(k,2126) = lu(k,2126) - lu(k,1484) * lu(k,2116) + lu(k,2127) = lu(k,2127) - lu(k,1485) * lu(k,2116) + lu(k,2128) = lu(k,2128) - lu(k,1486) * lu(k,2116) + lu(k,2129) = lu(k,2129) - lu(k,1487) * lu(k,2116) + lu(k,2131) = lu(k,2131) - lu(k,1488) * lu(k,2116) + lu(k,2133) = lu(k,2133) - lu(k,1489) * lu(k,2116) + lu(k,2179) = lu(k,2179) - lu(k,1478) * lu(k,2178) + lu(k,2180) = lu(k,2180) - lu(k,1479) * lu(k,2178) + lu(k,2181) = lu(k,2181) - lu(k,1480) * lu(k,2178) + lu(k,2183) = lu(k,2183) - lu(k,1481) * lu(k,2178) + lu(k,2184) = lu(k,2184) - lu(k,1482) * lu(k,2178) + lu(k,2185) = lu(k,2185) - lu(k,1483) * lu(k,2178) + lu(k,2188) = lu(k,2188) - lu(k,1484) * lu(k,2178) + lu(k,2189) = - lu(k,1485) * lu(k,2178) + lu(k,2190) = lu(k,2190) - lu(k,1486) * lu(k,2178) + lu(k,2191) = lu(k,2191) - lu(k,1487) * lu(k,2178) + lu(k,2193) = lu(k,2193) - lu(k,1488) * lu(k,2178) + lu(k,2195) = lu(k,2195) - lu(k,1489) * lu(k,2178) + lu(k,2297) = lu(k,2297) - lu(k,1478) * lu(k,2296) + lu(k,2298) = lu(k,2298) - lu(k,1479) * lu(k,2296) + lu(k,2299) = lu(k,2299) - lu(k,1480) * lu(k,2296) + lu(k,2301) = lu(k,2301) - lu(k,1481) * lu(k,2296) + lu(k,2302) = lu(k,2302) - lu(k,1482) * lu(k,2296) + lu(k,2303) = lu(k,2303) - lu(k,1483) * lu(k,2296) + lu(k,2306) = lu(k,2306) - lu(k,1484) * lu(k,2296) + lu(k,2307) = lu(k,2307) - lu(k,1485) * lu(k,2296) + lu(k,2308) = lu(k,2308) - lu(k,1486) * lu(k,2296) + lu(k,2309) = lu(k,2309) - lu(k,1487) * lu(k,2296) + lu(k,2311) = lu(k,2311) - lu(k,1488) * lu(k,2296) + lu(k,2313) = lu(k,2313) - lu(k,1489) * lu(k,2296) + lu(k,2349) = lu(k,2349) - lu(k,1478) * lu(k,2348) + lu(k,2350) = lu(k,2350) - lu(k,1479) * lu(k,2348) + lu(k,2351) = lu(k,2351) - lu(k,1480) * lu(k,2348) + lu(k,2353) = lu(k,2353) - lu(k,1481) * lu(k,2348) + lu(k,2354) = lu(k,2354) - lu(k,1482) * lu(k,2348) + lu(k,2355) = lu(k,2355) - lu(k,1483) * lu(k,2348) + lu(k,2358) = lu(k,2358) - lu(k,1484) * lu(k,2348) + lu(k,2359) = lu(k,2359) - lu(k,1485) * lu(k,2348) + lu(k,2360) = lu(k,2360) - lu(k,1486) * lu(k,2348) + lu(k,2361) = lu(k,2361) - lu(k,1487) * lu(k,2348) + lu(k,2363) = lu(k,2363) - lu(k,1488) * lu(k,2348) + lu(k,2365) = lu(k,2365) - lu(k,1489) * lu(k,2348) + lu(k,1494) = 1._r8 / lu(k,1494) + lu(k,1495) = lu(k,1495) * lu(k,1494) + lu(k,1496) = lu(k,1496) * lu(k,1494) + lu(k,1497) = lu(k,1497) * lu(k,1494) + lu(k,1498) = lu(k,1498) * lu(k,1494) + lu(k,1499) = lu(k,1499) * lu(k,1494) + lu(k,1500) = lu(k,1500) * lu(k,1494) + lu(k,1501) = lu(k,1501) * lu(k,1494) + lu(k,1502) = lu(k,1502) * lu(k,1494) + lu(k,1503) = lu(k,1503) * lu(k,1494) + lu(k,1504) = lu(k,1504) * lu(k,1494) + lu(k,1505) = lu(k,1505) * lu(k,1494) + lu(k,1506) = lu(k,1506) * lu(k,1494) + lu(k,1510) = lu(k,1510) - lu(k,1495) * lu(k,1509) + lu(k,1511) = lu(k,1511) - lu(k,1496) * lu(k,1509) + lu(k,1512) = - lu(k,1497) * lu(k,1509) + lu(k,1513) = lu(k,1513) - lu(k,1498) * lu(k,1509) + lu(k,1514) = lu(k,1514) - lu(k,1499) * lu(k,1509) + lu(k,1515) = lu(k,1515) - lu(k,1500) * lu(k,1509) + lu(k,1516) = lu(k,1516) - lu(k,1501) * lu(k,1509) + lu(k,1517) = lu(k,1517) - lu(k,1502) * lu(k,1509) + lu(k,1518) = lu(k,1518) - lu(k,1503) * lu(k,1509) + lu(k,1519) = lu(k,1519) - lu(k,1504) * lu(k,1509) + lu(k,1521) = lu(k,1521) - lu(k,1505) * lu(k,1509) + lu(k,1522) = lu(k,1522) - lu(k,1506) * lu(k,1509) + lu(k,1531) = lu(k,1531) - lu(k,1495) * lu(k,1530) + lu(k,1532) = lu(k,1532) - lu(k,1496) * lu(k,1530) + lu(k,1533) = lu(k,1533) - lu(k,1497) * lu(k,1530) + lu(k,1534) = lu(k,1534) - lu(k,1498) * lu(k,1530) + lu(k,1535) = lu(k,1535) - lu(k,1499) * lu(k,1530) + lu(k,1536) = lu(k,1536) - lu(k,1500) * lu(k,1530) + lu(k,1539) = lu(k,1539) - lu(k,1501) * lu(k,1530) + lu(k,1540) = lu(k,1540) - lu(k,1502) * lu(k,1530) + lu(k,1541) = lu(k,1541) - lu(k,1503) * lu(k,1530) + lu(k,1542) = lu(k,1542) - lu(k,1504) * lu(k,1530) + lu(k,1544) = lu(k,1544) - lu(k,1505) * lu(k,1530) + lu(k,1545) = lu(k,1545) - lu(k,1506) * lu(k,1530) + lu(k,1574) = lu(k,1574) - lu(k,1495) * lu(k,1573) + lu(k,1575) = lu(k,1575) - lu(k,1496) * lu(k,1573) + lu(k,1576) = lu(k,1576) - lu(k,1497) * lu(k,1573) + lu(k,1577) = lu(k,1577) - lu(k,1498) * lu(k,1573) + lu(k,1578) = lu(k,1578) - lu(k,1499) * lu(k,1573) + lu(k,1579) = lu(k,1579) - lu(k,1500) * lu(k,1573) + lu(k,1582) = lu(k,1582) - lu(k,1501) * lu(k,1573) + lu(k,1583) = lu(k,1583) - lu(k,1502) * lu(k,1573) + lu(k,1584) = lu(k,1584) - lu(k,1503) * lu(k,1573) + lu(k,1585) = lu(k,1585) - lu(k,1504) * lu(k,1573) + lu(k,1587) = lu(k,1587) - lu(k,1505) * lu(k,1573) + lu(k,1589) = lu(k,1589) - lu(k,1506) * lu(k,1573) + lu(k,1605) = lu(k,1605) - lu(k,1495) * lu(k,1604) + lu(k,1606) = lu(k,1606) - lu(k,1496) * lu(k,1604) + lu(k,1607) = lu(k,1607) - lu(k,1497) * lu(k,1604) + lu(k,1608) = lu(k,1608) - lu(k,1498) * lu(k,1604) + lu(k,1609) = lu(k,1609) - lu(k,1499) * lu(k,1604) + lu(k,1610) = lu(k,1610) - lu(k,1500) * lu(k,1604) + lu(k,1613) = lu(k,1613) - lu(k,1501) * lu(k,1604) + lu(k,1614) = lu(k,1614) - lu(k,1502) * lu(k,1604) + lu(k,1615) = lu(k,1615) - lu(k,1503) * lu(k,1604) + lu(k,1616) = lu(k,1616) - lu(k,1504) * lu(k,1604) + lu(k,1618) = lu(k,1618) - lu(k,1505) * lu(k,1604) + lu(k,1620) = lu(k,1620) - lu(k,1506) * lu(k,1604) + lu(k,1646) = lu(k,1646) - lu(k,1495) * lu(k,1645) + lu(k,1647) = lu(k,1647) - lu(k,1496) * lu(k,1645) + lu(k,1648) = - lu(k,1497) * lu(k,1645) + lu(k,1649) = lu(k,1649) - lu(k,1498) * lu(k,1645) + lu(k,1650) = lu(k,1650) - lu(k,1499) * lu(k,1645) + lu(k,1651) = lu(k,1651) - lu(k,1500) * lu(k,1645) + lu(k,1654) = lu(k,1654) - lu(k,1501) * lu(k,1645) + lu(k,1655) = lu(k,1655) - lu(k,1502) * lu(k,1645) + lu(k,1656) = lu(k,1656) - lu(k,1503) * lu(k,1645) + lu(k,1657) = lu(k,1657) - lu(k,1504) * lu(k,1645) + lu(k,1659) = lu(k,1659) - lu(k,1505) * lu(k,1645) + lu(k,1661) = lu(k,1661) - lu(k,1506) * lu(k,1645) + lu(k,1818) = lu(k,1818) - lu(k,1495) * lu(k,1817) + lu(k,1819) = lu(k,1819) - lu(k,1496) * lu(k,1817) + lu(k,1820) = lu(k,1820) - lu(k,1497) * lu(k,1817) + lu(k,1821) = lu(k,1821) - lu(k,1498) * lu(k,1817) + lu(k,1822) = lu(k,1822) - lu(k,1499) * lu(k,1817) + lu(k,1823) = lu(k,1823) - lu(k,1500) * lu(k,1817) + lu(k,1826) = lu(k,1826) - lu(k,1501) * lu(k,1817) + lu(k,1827) = lu(k,1827) - lu(k,1502) * lu(k,1817) + lu(k,1828) = lu(k,1828) - lu(k,1503) * lu(k,1817) + lu(k,1829) = lu(k,1829) - lu(k,1504) * lu(k,1817) + lu(k,1831) = lu(k,1831) - lu(k,1505) * lu(k,1817) + lu(k,1833) = lu(k,1833) - lu(k,1506) * lu(k,1817) + lu(k,1842) = lu(k,1842) - lu(k,1495) * lu(k,1841) + lu(k,1843) = lu(k,1843) - lu(k,1496) * lu(k,1841) + lu(k,1844) = lu(k,1844) - lu(k,1497) * lu(k,1841) + lu(k,1845) = lu(k,1845) - lu(k,1498) * lu(k,1841) + lu(k,1846) = lu(k,1846) - lu(k,1499) * lu(k,1841) + lu(k,1847) = lu(k,1847) - lu(k,1500) * lu(k,1841) + lu(k,1850) = - lu(k,1501) * lu(k,1841) + lu(k,1851) = lu(k,1851) - lu(k,1502) * lu(k,1841) + lu(k,1852) = lu(k,1852) - lu(k,1503) * lu(k,1841) + lu(k,1853) = lu(k,1853) - lu(k,1504) * lu(k,1841) + lu(k,1855) = lu(k,1855) - lu(k,1505) * lu(k,1841) + lu(k,1857) = lu(k,1857) - lu(k,1506) * lu(k,1841) + lu(k,1945) = lu(k,1945) - lu(k,1495) * lu(k,1944) + lu(k,1946) = lu(k,1946) - lu(k,1496) * lu(k,1944) + lu(k,1947) = lu(k,1947) - lu(k,1497) * lu(k,1944) + lu(k,1948) = lu(k,1948) - lu(k,1498) * lu(k,1944) + lu(k,1949) = lu(k,1949) - lu(k,1499) * lu(k,1944) + lu(k,1950) = lu(k,1950) - lu(k,1500) * lu(k,1944) + lu(k,1953) = lu(k,1953) - lu(k,1501) * lu(k,1944) + lu(k,1954) = lu(k,1954) - lu(k,1502) * lu(k,1944) + lu(k,1955) = lu(k,1955) - lu(k,1503) * lu(k,1944) + lu(k,1956) = lu(k,1956) - lu(k,1504) * lu(k,1944) + lu(k,1958) = lu(k,1958) - lu(k,1505) * lu(k,1944) + lu(k,1960) = lu(k,1960) - lu(k,1506) * lu(k,1944) + lu(k,1997) = lu(k,1997) - lu(k,1495) * lu(k,1996) + lu(k,1998) = lu(k,1998) - lu(k,1496) * lu(k,1996) + lu(k,1999) = lu(k,1999) - lu(k,1497) * lu(k,1996) + lu(k,2000) = lu(k,2000) - lu(k,1498) * lu(k,1996) + lu(k,2001) = lu(k,2001) - lu(k,1499) * lu(k,1996) + lu(k,2002) = lu(k,2002) - lu(k,1500) * lu(k,1996) + lu(k,2005) = lu(k,2005) - lu(k,1501) * lu(k,1996) + lu(k,2006) = lu(k,2006) - lu(k,1502) * lu(k,1996) + lu(k,2007) = lu(k,2007) - lu(k,1503) * lu(k,1996) + lu(k,2008) = lu(k,2008) - lu(k,1504) * lu(k,1996) + lu(k,2010) = lu(k,2010) - lu(k,1505) * lu(k,1996) + lu(k,2012) = lu(k,2012) - lu(k,1506) * lu(k,1996) + lu(k,2020) = lu(k,2020) - lu(k,1495) * lu(k,2019) + lu(k,2021) = lu(k,2021) - lu(k,1496) * lu(k,2019) + lu(k,2022) = lu(k,2022) - lu(k,1497) * lu(k,2019) + lu(k,2023) = lu(k,2023) - lu(k,1498) * lu(k,2019) + lu(k,2024) = lu(k,2024) - lu(k,1499) * lu(k,2019) + lu(k,2025) = lu(k,2025) - lu(k,1500) * lu(k,2019) + lu(k,2028) = - lu(k,1501) * lu(k,2019) + lu(k,2029) = lu(k,2029) - lu(k,1502) * lu(k,2019) + lu(k,2030) = lu(k,2030) - lu(k,1503) * lu(k,2019) + lu(k,2031) = lu(k,2031) - lu(k,1504) * lu(k,2019) + lu(k,2033) = lu(k,2033) - lu(k,1505) * lu(k,2019) + lu(k,2035) = lu(k,2035) - lu(k,1506) * lu(k,2019) + lu(k,2079) = lu(k,2079) - lu(k,1495) * lu(k,2078) + lu(k,2080) = lu(k,2080) - lu(k,1496) * lu(k,2078) + lu(k,2081) = lu(k,2081) - lu(k,1497) * lu(k,2078) + lu(k,2082) = lu(k,2082) - lu(k,1498) * lu(k,2078) + lu(k,2083) = lu(k,2083) - lu(k,1499) * lu(k,2078) + lu(k,2084) = lu(k,2084) - lu(k,1500) * lu(k,2078) + lu(k,2087) = lu(k,2087) - lu(k,1501) * lu(k,2078) + lu(k,2088) = lu(k,2088) - lu(k,1502) * lu(k,2078) + lu(k,2089) = lu(k,2089) - lu(k,1503) * lu(k,2078) + lu(k,2090) = lu(k,2090) - lu(k,1504) * lu(k,2078) + lu(k,2092) = lu(k,2092) - lu(k,1505) * lu(k,2078) + lu(k,2094) = lu(k,2094) - lu(k,1506) * lu(k,2078) + lu(k,2118) = lu(k,2118) - lu(k,1495) * lu(k,2117) + lu(k,2119) = lu(k,2119) - lu(k,1496) * lu(k,2117) + lu(k,2120) = lu(k,2120) - lu(k,1497) * lu(k,2117) + lu(k,2121) = lu(k,2121) - lu(k,1498) * lu(k,2117) + lu(k,2122) = lu(k,2122) - lu(k,1499) * lu(k,2117) + lu(k,2123) = lu(k,2123) - lu(k,1500) * lu(k,2117) + lu(k,2126) = lu(k,2126) - lu(k,1501) * lu(k,2117) + lu(k,2127) = lu(k,2127) - lu(k,1502) * lu(k,2117) + lu(k,2128) = lu(k,2128) - lu(k,1503) * lu(k,2117) + lu(k,2129) = lu(k,2129) - lu(k,1504) * lu(k,2117) + lu(k,2131) = lu(k,2131) - lu(k,1505) * lu(k,2117) + lu(k,2133) = lu(k,2133) - lu(k,1506) * lu(k,2117) + lu(k,2180) = lu(k,2180) - lu(k,1495) * lu(k,2179) + lu(k,2181) = lu(k,2181) - lu(k,1496) * lu(k,2179) + lu(k,2182) = lu(k,2182) - lu(k,1497) * lu(k,2179) + lu(k,2183) = lu(k,2183) - lu(k,1498) * lu(k,2179) + lu(k,2184) = lu(k,2184) - lu(k,1499) * lu(k,2179) + lu(k,2185) = lu(k,2185) - lu(k,1500) * lu(k,2179) + lu(k,2188) = lu(k,2188) - lu(k,1501) * lu(k,2179) + lu(k,2189) = lu(k,2189) - lu(k,1502) * lu(k,2179) + lu(k,2190) = lu(k,2190) - lu(k,1503) * lu(k,2179) + lu(k,2191) = lu(k,2191) - lu(k,1504) * lu(k,2179) + lu(k,2193) = lu(k,2193) - lu(k,1505) * lu(k,2179) + lu(k,2195) = lu(k,2195) - lu(k,1506) * lu(k,2179) + lu(k,2298) = lu(k,2298) - lu(k,1495) * lu(k,2297) + lu(k,2299) = lu(k,2299) - lu(k,1496) * lu(k,2297) + lu(k,2300) = lu(k,2300) - lu(k,1497) * lu(k,2297) + lu(k,2301) = lu(k,2301) - lu(k,1498) * lu(k,2297) + lu(k,2302) = lu(k,2302) - lu(k,1499) * lu(k,2297) + lu(k,2303) = lu(k,2303) - lu(k,1500) * lu(k,2297) + lu(k,2306) = lu(k,2306) - lu(k,1501) * lu(k,2297) + lu(k,2307) = lu(k,2307) - lu(k,1502) * lu(k,2297) + lu(k,2308) = lu(k,2308) - lu(k,1503) * lu(k,2297) + lu(k,2309) = lu(k,2309) - lu(k,1504) * lu(k,2297) + lu(k,2311) = lu(k,2311) - lu(k,1505) * lu(k,2297) + lu(k,2313) = lu(k,2313) - lu(k,1506) * lu(k,2297) + lu(k,2324) = lu(k,2324) - lu(k,1495) * lu(k,2323) + lu(k,2325) = lu(k,2325) - lu(k,1496) * lu(k,2323) + lu(k,2326) = lu(k,2326) - lu(k,1497) * lu(k,2323) + lu(k,2327) = lu(k,2327) - lu(k,1498) * lu(k,2323) + lu(k,2328) = lu(k,2328) - lu(k,1499) * lu(k,2323) + lu(k,2329) = lu(k,2329) - lu(k,1500) * lu(k,2323) + lu(k,2332) = lu(k,2332) - lu(k,1501) * lu(k,2323) + lu(k,2333) = lu(k,2333) - lu(k,1502) * lu(k,2323) + lu(k,2334) = lu(k,2334) - lu(k,1503) * lu(k,2323) + lu(k,2335) = lu(k,2335) - lu(k,1504) * lu(k,2323) + lu(k,2337) = lu(k,2337) - lu(k,1505) * lu(k,2323) + lu(k,2339) = lu(k,2339) - lu(k,1506) * lu(k,2323) + lu(k,2350) = lu(k,2350) - lu(k,1495) * lu(k,2349) + lu(k,2351) = lu(k,2351) - lu(k,1496) * lu(k,2349) + lu(k,2352) = lu(k,2352) - lu(k,1497) * lu(k,2349) + lu(k,2353) = lu(k,2353) - lu(k,1498) * lu(k,2349) + lu(k,2354) = lu(k,2354) - lu(k,1499) * lu(k,2349) + lu(k,2355) = lu(k,2355) - lu(k,1500) * lu(k,2349) + lu(k,2358) = lu(k,2358) - lu(k,1501) * lu(k,2349) + lu(k,2359) = lu(k,2359) - lu(k,1502) * lu(k,2349) + lu(k,2360) = lu(k,2360) - lu(k,1503) * lu(k,2349) + lu(k,2361) = lu(k,2361) - lu(k,1504) * lu(k,2349) + lu(k,2363) = lu(k,2363) - lu(k,1505) * lu(k,2349) + lu(k,2365) = lu(k,2365) - lu(k,1506) * lu(k,2349) + end do + end subroutine lu_fac28 + subroutine lu_fac29( 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,1510) = 1._r8 / lu(k,1510) + lu(k,1511) = lu(k,1511) * lu(k,1510) + lu(k,1512) = lu(k,1512) * lu(k,1510) + lu(k,1513) = lu(k,1513) * lu(k,1510) + lu(k,1514) = lu(k,1514) * lu(k,1510) + lu(k,1515) = lu(k,1515) * lu(k,1510) + lu(k,1516) = lu(k,1516) * lu(k,1510) + lu(k,1517) = lu(k,1517) * lu(k,1510) + lu(k,1518) = lu(k,1518) * lu(k,1510) + lu(k,1519) = lu(k,1519) * lu(k,1510) + lu(k,1520) = lu(k,1520) * lu(k,1510) + lu(k,1521) = lu(k,1521) * lu(k,1510) + lu(k,1522) = lu(k,1522) * lu(k,1510) + lu(k,1532) = lu(k,1532) - lu(k,1511) * lu(k,1531) + lu(k,1533) = lu(k,1533) - lu(k,1512) * lu(k,1531) + lu(k,1534) = lu(k,1534) - lu(k,1513) * lu(k,1531) + lu(k,1535) = lu(k,1535) - lu(k,1514) * lu(k,1531) + lu(k,1536) = lu(k,1536) - lu(k,1515) * lu(k,1531) + lu(k,1539) = lu(k,1539) - lu(k,1516) * lu(k,1531) + lu(k,1540) = lu(k,1540) - lu(k,1517) * lu(k,1531) + lu(k,1541) = lu(k,1541) - lu(k,1518) * lu(k,1531) + lu(k,1542) = lu(k,1542) - lu(k,1519) * lu(k,1531) + lu(k,1543) = lu(k,1543) - lu(k,1520) * lu(k,1531) + lu(k,1544) = lu(k,1544) - lu(k,1521) * lu(k,1531) + lu(k,1545) = lu(k,1545) - lu(k,1522) * lu(k,1531) + lu(k,1575) = lu(k,1575) - lu(k,1511) * lu(k,1574) + lu(k,1576) = lu(k,1576) - lu(k,1512) * lu(k,1574) + lu(k,1577) = lu(k,1577) - lu(k,1513) * lu(k,1574) + lu(k,1578) = lu(k,1578) - lu(k,1514) * lu(k,1574) + lu(k,1579) = lu(k,1579) - lu(k,1515) * lu(k,1574) + lu(k,1582) = lu(k,1582) - lu(k,1516) * lu(k,1574) + lu(k,1583) = lu(k,1583) - lu(k,1517) * lu(k,1574) + lu(k,1584) = lu(k,1584) - lu(k,1518) * lu(k,1574) + lu(k,1585) = lu(k,1585) - lu(k,1519) * lu(k,1574) + lu(k,1586) = lu(k,1586) - lu(k,1520) * lu(k,1574) + lu(k,1587) = lu(k,1587) - lu(k,1521) * lu(k,1574) + lu(k,1589) = lu(k,1589) - lu(k,1522) * lu(k,1574) + lu(k,1606) = lu(k,1606) - lu(k,1511) * lu(k,1605) + lu(k,1607) = lu(k,1607) - lu(k,1512) * lu(k,1605) + lu(k,1608) = lu(k,1608) - lu(k,1513) * lu(k,1605) + lu(k,1609) = lu(k,1609) - lu(k,1514) * lu(k,1605) + lu(k,1610) = lu(k,1610) - lu(k,1515) * lu(k,1605) + lu(k,1613) = lu(k,1613) - lu(k,1516) * lu(k,1605) + lu(k,1614) = lu(k,1614) - lu(k,1517) * lu(k,1605) + lu(k,1615) = lu(k,1615) - lu(k,1518) * lu(k,1605) + lu(k,1616) = lu(k,1616) - lu(k,1519) * lu(k,1605) + lu(k,1617) = lu(k,1617) - lu(k,1520) * lu(k,1605) + lu(k,1618) = lu(k,1618) - lu(k,1521) * lu(k,1605) + lu(k,1620) = lu(k,1620) - lu(k,1522) * lu(k,1605) + lu(k,1647) = lu(k,1647) - lu(k,1511) * lu(k,1646) + lu(k,1648) = lu(k,1648) - lu(k,1512) * lu(k,1646) + lu(k,1649) = lu(k,1649) - lu(k,1513) * lu(k,1646) + lu(k,1650) = lu(k,1650) - lu(k,1514) * lu(k,1646) + lu(k,1651) = lu(k,1651) - lu(k,1515) * lu(k,1646) + lu(k,1654) = lu(k,1654) - lu(k,1516) * lu(k,1646) + lu(k,1655) = lu(k,1655) - lu(k,1517) * lu(k,1646) + lu(k,1656) = lu(k,1656) - lu(k,1518) * lu(k,1646) + lu(k,1657) = lu(k,1657) - lu(k,1519) * lu(k,1646) + lu(k,1658) = lu(k,1658) - lu(k,1520) * lu(k,1646) + lu(k,1659) = lu(k,1659) - lu(k,1521) * lu(k,1646) + lu(k,1661) = lu(k,1661) - lu(k,1522) * lu(k,1646) + lu(k,1819) = lu(k,1819) - lu(k,1511) * lu(k,1818) + lu(k,1820) = lu(k,1820) - lu(k,1512) * lu(k,1818) + lu(k,1821) = lu(k,1821) - lu(k,1513) * lu(k,1818) + lu(k,1822) = lu(k,1822) - lu(k,1514) * lu(k,1818) + lu(k,1823) = lu(k,1823) - lu(k,1515) * lu(k,1818) + lu(k,1826) = lu(k,1826) - lu(k,1516) * lu(k,1818) + lu(k,1827) = lu(k,1827) - lu(k,1517) * lu(k,1818) + lu(k,1828) = lu(k,1828) - lu(k,1518) * lu(k,1818) + lu(k,1829) = lu(k,1829) - lu(k,1519) * lu(k,1818) + lu(k,1830) = lu(k,1830) - lu(k,1520) * lu(k,1818) + lu(k,1831) = lu(k,1831) - lu(k,1521) * lu(k,1818) + lu(k,1833) = lu(k,1833) - lu(k,1522) * lu(k,1818) + lu(k,1843) = lu(k,1843) - lu(k,1511) * lu(k,1842) + lu(k,1844) = lu(k,1844) - lu(k,1512) * lu(k,1842) + lu(k,1845) = lu(k,1845) - lu(k,1513) * lu(k,1842) + lu(k,1846) = lu(k,1846) - lu(k,1514) * lu(k,1842) + lu(k,1847) = lu(k,1847) - lu(k,1515) * lu(k,1842) + lu(k,1850) = lu(k,1850) - lu(k,1516) * lu(k,1842) + lu(k,1851) = lu(k,1851) - lu(k,1517) * lu(k,1842) + lu(k,1852) = lu(k,1852) - lu(k,1518) * lu(k,1842) + lu(k,1853) = lu(k,1853) - lu(k,1519) * lu(k,1842) + lu(k,1854) = lu(k,1854) - lu(k,1520) * lu(k,1842) + lu(k,1855) = lu(k,1855) - lu(k,1521) * lu(k,1842) + lu(k,1857) = lu(k,1857) - lu(k,1522) * lu(k,1842) + lu(k,1946) = lu(k,1946) - lu(k,1511) * lu(k,1945) + lu(k,1947) = lu(k,1947) - lu(k,1512) * lu(k,1945) + lu(k,1948) = lu(k,1948) - lu(k,1513) * lu(k,1945) + lu(k,1949) = lu(k,1949) - lu(k,1514) * lu(k,1945) + lu(k,1950) = lu(k,1950) - lu(k,1515) * lu(k,1945) + lu(k,1953) = lu(k,1953) - lu(k,1516) * lu(k,1945) + lu(k,1954) = lu(k,1954) - lu(k,1517) * lu(k,1945) + lu(k,1955) = lu(k,1955) - lu(k,1518) * lu(k,1945) + lu(k,1956) = lu(k,1956) - lu(k,1519) * lu(k,1945) + lu(k,1957) = lu(k,1957) - lu(k,1520) * lu(k,1945) + lu(k,1958) = lu(k,1958) - lu(k,1521) * lu(k,1945) + lu(k,1960) = lu(k,1960) - lu(k,1522) * lu(k,1945) + lu(k,1998) = lu(k,1998) - lu(k,1511) * lu(k,1997) + lu(k,1999) = lu(k,1999) - lu(k,1512) * lu(k,1997) + lu(k,2000) = lu(k,2000) - lu(k,1513) * lu(k,1997) + lu(k,2001) = lu(k,2001) - lu(k,1514) * lu(k,1997) + lu(k,2002) = lu(k,2002) - lu(k,1515) * lu(k,1997) + lu(k,2005) = lu(k,2005) - lu(k,1516) * lu(k,1997) + lu(k,2006) = lu(k,2006) - lu(k,1517) * lu(k,1997) + lu(k,2007) = lu(k,2007) - lu(k,1518) * lu(k,1997) + lu(k,2008) = lu(k,2008) - lu(k,1519) * lu(k,1997) + lu(k,2009) = lu(k,2009) - lu(k,1520) * lu(k,1997) + lu(k,2010) = lu(k,2010) - lu(k,1521) * lu(k,1997) + lu(k,2012) = lu(k,2012) - lu(k,1522) * lu(k,1997) + lu(k,2021) = lu(k,2021) - lu(k,1511) * lu(k,2020) + lu(k,2022) = lu(k,2022) - lu(k,1512) * lu(k,2020) + lu(k,2023) = lu(k,2023) - lu(k,1513) * lu(k,2020) + lu(k,2024) = lu(k,2024) - lu(k,1514) * lu(k,2020) + lu(k,2025) = lu(k,2025) - lu(k,1515) * lu(k,2020) + lu(k,2028) = lu(k,2028) - lu(k,1516) * lu(k,2020) + lu(k,2029) = lu(k,2029) - lu(k,1517) * lu(k,2020) + lu(k,2030) = lu(k,2030) - lu(k,1518) * lu(k,2020) + lu(k,2031) = lu(k,2031) - lu(k,1519) * lu(k,2020) + lu(k,2032) = lu(k,2032) - lu(k,1520) * lu(k,2020) + lu(k,2033) = lu(k,2033) - lu(k,1521) * lu(k,2020) + lu(k,2035) = lu(k,2035) - lu(k,1522) * lu(k,2020) + lu(k,2080) = lu(k,2080) - lu(k,1511) * lu(k,2079) + lu(k,2081) = lu(k,2081) - lu(k,1512) * lu(k,2079) + lu(k,2082) = lu(k,2082) - lu(k,1513) * lu(k,2079) + lu(k,2083) = lu(k,2083) - lu(k,1514) * lu(k,2079) + lu(k,2084) = lu(k,2084) - lu(k,1515) * lu(k,2079) + lu(k,2087) = lu(k,2087) - lu(k,1516) * lu(k,2079) + lu(k,2088) = lu(k,2088) - lu(k,1517) * lu(k,2079) + lu(k,2089) = lu(k,2089) - lu(k,1518) * lu(k,2079) + lu(k,2090) = lu(k,2090) - lu(k,1519) * lu(k,2079) + lu(k,2091) = lu(k,2091) - lu(k,1520) * lu(k,2079) + lu(k,2092) = lu(k,2092) - lu(k,1521) * lu(k,2079) + lu(k,2094) = lu(k,2094) - lu(k,1522) * lu(k,2079) + lu(k,2119) = lu(k,2119) - lu(k,1511) * lu(k,2118) + lu(k,2120) = lu(k,2120) - lu(k,1512) * lu(k,2118) + lu(k,2121) = lu(k,2121) - lu(k,1513) * lu(k,2118) + lu(k,2122) = lu(k,2122) - lu(k,1514) * lu(k,2118) + lu(k,2123) = lu(k,2123) - lu(k,1515) * lu(k,2118) + lu(k,2126) = lu(k,2126) - lu(k,1516) * lu(k,2118) + lu(k,2127) = lu(k,2127) - lu(k,1517) * lu(k,2118) + lu(k,2128) = lu(k,2128) - lu(k,1518) * lu(k,2118) + lu(k,2129) = lu(k,2129) - lu(k,1519) * lu(k,2118) + lu(k,2130) = lu(k,2130) - lu(k,1520) * lu(k,2118) + lu(k,2131) = lu(k,2131) - lu(k,1521) * lu(k,2118) + lu(k,2133) = lu(k,2133) - lu(k,1522) * lu(k,2118) + lu(k,2181) = lu(k,2181) - lu(k,1511) * lu(k,2180) + lu(k,2182) = lu(k,2182) - lu(k,1512) * lu(k,2180) + lu(k,2183) = lu(k,2183) - lu(k,1513) * lu(k,2180) + lu(k,2184) = lu(k,2184) - lu(k,1514) * lu(k,2180) + lu(k,2185) = lu(k,2185) - lu(k,1515) * lu(k,2180) + lu(k,2188) = lu(k,2188) - lu(k,1516) * lu(k,2180) + lu(k,2189) = lu(k,2189) - lu(k,1517) * lu(k,2180) + lu(k,2190) = lu(k,2190) - lu(k,1518) * lu(k,2180) + lu(k,2191) = lu(k,2191) - lu(k,1519) * lu(k,2180) + lu(k,2192) = lu(k,2192) - lu(k,1520) * lu(k,2180) + lu(k,2193) = lu(k,2193) - lu(k,1521) * lu(k,2180) + lu(k,2195) = lu(k,2195) - lu(k,1522) * lu(k,2180) + lu(k,2299) = lu(k,2299) - lu(k,1511) * lu(k,2298) + lu(k,2300) = lu(k,2300) - lu(k,1512) * lu(k,2298) + lu(k,2301) = lu(k,2301) - lu(k,1513) * lu(k,2298) + lu(k,2302) = lu(k,2302) - lu(k,1514) * lu(k,2298) + lu(k,2303) = lu(k,2303) - lu(k,1515) * lu(k,2298) + lu(k,2306) = lu(k,2306) - lu(k,1516) * lu(k,2298) + lu(k,2307) = lu(k,2307) - lu(k,1517) * lu(k,2298) + lu(k,2308) = lu(k,2308) - lu(k,1518) * lu(k,2298) + lu(k,2309) = lu(k,2309) - lu(k,1519) * lu(k,2298) + lu(k,2310) = lu(k,2310) - lu(k,1520) * lu(k,2298) + lu(k,2311) = lu(k,2311) - lu(k,1521) * lu(k,2298) + lu(k,2313) = lu(k,2313) - lu(k,1522) * lu(k,2298) + lu(k,2325) = lu(k,2325) - lu(k,1511) * lu(k,2324) + lu(k,2326) = lu(k,2326) - lu(k,1512) * lu(k,2324) + lu(k,2327) = lu(k,2327) - lu(k,1513) * lu(k,2324) + lu(k,2328) = lu(k,2328) - lu(k,1514) * lu(k,2324) + lu(k,2329) = lu(k,2329) - lu(k,1515) * lu(k,2324) + lu(k,2332) = lu(k,2332) - lu(k,1516) * lu(k,2324) + lu(k,2333) = lu(k,2333) - lu(k,1517) * lu(k,2324) + lu(k,2334) = lu(k,2334) - lu(k,1518) * lu(k,2324) + lu(k,2335) = lu(k,2335) - lu(k,1519) * lu(k,2324) + lu(k,2336) = lu(k,2336) - lu(k,1520) * lu(k,2324) + lu(k,2337) = lu(k,2337) - lu(k,1521) * lu(k,2324) + lu(k,2339) = lu(k,2339) - lu(k,1522) * lu(k,2324) + lu(k,2351) = lu(k,2351) - lu(k,1511) * lu(k,2350) + lu(k,2352) = lu(k,2352) - lu(k,1512) * lu(k,2350) + lu(k,2353) = lu(k,2353) - lu(k,1513) * lu(k,2350) + lu(k,2354) = lu(k,2354) - lu(k,1514) * lu(k,2350) + lu(k,2355) = lu(k,2355) - lu(k,1515) * lu(k,2350) + lu(k,2358) = lu(k,2358) - lu(k,1516) * lu(k,2350) + lu(k,2359) = lu(k,2359) - lu(k,1517) * lu(k,2350) + lu(k,2360) = lu(k,2360) - lu(k,1518) * lu(k,2350) + lu(k,2361) = lu(k,2361) - lu(k,1519) * lu(k,2350) + lu(k,2362) = lu(k,2362) - lu(k,1520) * lu(k,2350) + lu(k,2363) = lu(k,2363) - lu(k,1521) * lu(k,2350) + lu(k,2365) = lu(k,2365) - lu(k,1522) * lu(k,2350) + lu(k,1532) = 1._r8 / lu(k,1532) + lu(k,1533) = lu(k,1533) * lu(k,1532) + lu(k,1534) = lu(k,1534) * lu(k,1532) + lu(k,1535) = lu(k,1535) * lu(k,1532) + lu(k,1536) = lu(k,1536) * lu(k,1532) + lu(k,1537) = lu(k,1537) * lu(k,1532) + lu(k,1538) = lu(k,1538) * lu(k,1532) + lu(k,1539) = lu(k,1539) * lu(k,1532) + lu(k,1540) = lu(k,1540) * lu(k,1532) + lu(k,1541) = lu(k,1541) * lu(k,1532) + lu(k,1542) = lu(k,1542) * lu(k,1532) + lu(k,1543) = lu(k,1543) * lu(k,1532) + lu(k,1544) = lu(k,1544) * lu(k,1532) + lu(k,1545) = lu(k,1545) * lu(k,1532) + lu(k,1576) = lu(k,1576) - lu(k,1533) * lu(k,1575) + lu(k,1577) = lu(k,1577) - lu(k,1534) * lu(k,1575) + lu(k,1578) = lu(k,1578) - lu(k,1535) * lu(k,1575) + lu(k,1579) = lu(k,1579) - lu(k,1536) * lu(k,1575) + lu(k,1580) = lu(k,1580) - lu(k,1537) * lu(k,1575) + lu(k,1581) = lu(k,1581) - lu(k,1538) * lu(k,1575) + lu(k,1582) = lu(k,1582) - lu(k,1539) * lu(k,1575) + lu(k,1583) = lu(k,1583) - lu(k,1540) * lu(k,1575) + lu(k,1584) = lu(k,1584) - lu(k,1541) * lu(k,1575) + lu(k,1585) = lu(k,1585) - lu(k,1542) * lu(k,1575) + lu(k,1586) = lu(k,1586) - lu(k,1543) * lu(k,1575) + lu(k,1587) = lu(k,1587) - lu(k,1544) * lu(k,1575) + lu(k,1589) = lu(k,1589) - lu(k,1545) * lu(k,1575) + lu(k,1607) = lu(k,1607) - lu(k,1533) * lu(k,1606) + lu(k,1608) = lu(k,1608) - lu(k,1534) * lu(k,1606) + lu(k,1609) = lu(k,1609) - lu(k,1535) * lu(k,1606) + lu(k,1610) = lu(k,1610) - lu(k,1536) * lu(k,1606) + lu(k,1611) = lu(k,1611) - lu(k,1537) * lu(k,1606) + lu(k,1612) = lu(k,1612) - lu(k,1538) * lu(k,1606) + lu(k,1613) = lu(k,1613) - lu(k,1539) * lu(k,1606) + lu(k,1614) = lu(k,1614) - lu(k,1540) * lu(k,1606) + lu(k,1615) = lu(k,1615) - lu(k,1541) * lu(k,1606) + lu(k,1616) = lu(k,1616) - lu(k,1542) * lu(k,1606) + lu(k,1617) = lu(k,1617) - lu(k,1543) * lu(k,1606) + lu(k,1618) = lu(k,1618) - lu(k,1544) * lu(k,1606) + lu(k,1620) = lu(k,1620) - lu(k,1545) * lu(k,1606) + lu(k,1648) = lu(k,1648) - lu(k,1533) * lu(k,1647) + lu(k,1649) = lu(k,1649) - lu(k,1534) * lu(k,1647) + lu(k,1650) = lu(k,1650) - lu(k,1535) * lu(k,1647) + lu(k,1651) = lu(k,1651) - lu(k,1536) * lu(k,1647) + lu(k,1652) = lu(k,1652) - lu(k,1537) * lu(k,1647) + lu(k,1653) = lu(k,1653) - lu(k,1538) * lu(k,1647) + lu(k,1654) = lu(k,1654) - lu(k,1539) * lu(k,1647) + lu(k,1655) = lu(k,1655) - lu(k,1540) * lu(k,1647) + lu(k,1656) = lu(k,1656) - lu(k,1541) * lu(k,1647) + lu(k,1657) = lu(k,1657) - lu(k,1542) * lu(k,1647) + lu(k,1658) = lu(k,1658) - lu(k,1543) * lu(k,1647) + lu(k,1659) = lu(k,1659) - lu(k,1544) * lu(k,1647) + lu(k,1661) = lu(k,1661) - lu(k,1545) * lu(k,1647) + lu(k,1820) = lu(k,1820) - lu(k,1533) * lu(k,1819) + lu(k,1821) = lu(k,1821) - lu(k,1534) * lu(k,1819) + lu(k,1822) = lu(k,1822) - lu(k,1535) * lu(k,1819) + lu(k,1823) = lu(k,1823) - lu(k,1536) * lu(k,1819) + lu(k,1824) = lu(k,1824) - lu(k,1537) * lu(k,1819) + lu(k,1825) = lu(k,1825) - lu(k,1538) * lu(k,1819) + lu(k,1826) = lu(k,1826) - lu(k,1539) * lu(k,1819) + lu(k,1827) = lu(k,1827) - lu(k,1540) * lu(k,1819) + lu(k,1828) = lu(k,1828) - lu(k,1541) * lu(k,1819) + lu(k,1829) = lu(k,1829) - lu(k,1542) * lu(k,1819) + lu(k,1830) = lu(k,1830) - lu(k,1543) * lu(k,1819) + lu(k,1831) = lu(k,1831) - lu(k,1544) * lu(k,1819) + lu(k,1833) = lu(k,1833) - lu(k,1545) * lu(k,1819) + lu(k,1844) = lu(k,1844) - lu(k,1533) * lu(k,1843) + lu(k,1845) = lu(k,1845) - lu(k,1534) * lu(k,1843) + lu(k,1846) = lu(k,1846) - lu(k,1535) * lu(k,1843) + lu(k,1847) = lu(k,1847) - lu(k,1536) * lu(k,1843) + lu(k,1848) = lu(k,1848) - lu(k,1537) * lu(k,1843) + lu(k,1849) = lu(k,1849) - lu(k,1538) * lu(k,1843) + lu(k,1850) = lu(k,1850) - lu(k,1539) * lu(k,1843) + lu(k,1851) = lu(k,1851) - lu(k,1540) * lu(k,1843) + lu(k,1852) = lu(k,1852) - lu(k,1541) * lu(k,1843) + lu(k,1853) = lu(k,1853) - lu(k,1542) * lu(k,1843) + lu(k,1854) = lu(k,1854) - lu(k,1543) * lu(k,1843) + lu(k,1855) = lu(k,1855) - lu(k,1544) * lu(k,1843) + lu(k,1857) = lu(k,1857) - lu(k,1545) * lu(k,1843) + lu(k,1947) = lu(k,1947) - lu(k,1533) * lu(k,1946) + lu(k,1948) = lu(k,1948) - lu(k,1534) * lu(k,1946) + lu(k,1949) = lu(k,1949) - lu(k,1535) * lu(k,1946) + lu(k,1950) = lu(k,1950) - lu(k,1536) * lu(k,1946) + lu(k,1951) = lu(k,1951) - lu(k,1537) * lu(k,1946) + lu(k,1952) = lu(k,1952) - lu(k,1538) * lu(k,1946) + lu(k,1953) = lu(k,1953) - lu(k,1539) * lu(k,1946) + lu(k,1954) = lu(k,1954) - lu(k,1540) * lu(k,1946) + lu(k,1955) = lu(k,1955) - lu(k,1541) * lu(k,1946) + lu(k,1956) = lu(k,1956) - lu(k,1542) * lu(k,1946) + lu(k,1957) = lu(k,1957) - lu(k,1543) * lu(k,1946) + lu(k,1958) = lu(k,1958) - lu(k,1544) * lu(k,1946) + lu(k,1960) = lu(k,1960) - lu(k,1545) * lu(k,1946) + lu(k,1999) = lu(k,1999) - lu(k,1533) * lu(k,1998) + lu(k,2000) = lu(k,2000) - lu(k,1534) * lu(k,1998) + lu(k,2001) = lu(k,2001) - lu(k,1535) * lu(k,1998) + lu(k,2002) = lu(k,2002) - lu(k,1536) * lu(k,1998) + lu(k,2003) = - lu(k,1537) * lu(k,1998) + lu(k,2004) = lu(k,2004) - lu(k,1538) * lu(k,1998) + lu(k,2005) = lu(k,2005) - lu(k,1539) * lu(k,1998) + lu(k,2006) = lu(k,2006) - lu(k,1540) * lu(k,1998) + lu(k,2007) = lu(k,2007) - lu(k,1541) * lu(k,1998) + lu(k,2008) = lu(k,2008) - lu(k,1542) * lu(k,1998) + lu(k,2009) = lu(k,2009) - lu(k,1543) * lu(k,1998) + lu(k,2010) = lu(k,2010) - lu(k,1544) * lu(k,1998) + lu(k,2012) = lu(k,2012) - lu(k,1545) * lu(k,1998) + lu(k,2022) = lu(k,2022) - lu(k,1533) * lu(k,2021) + lu(k,2023) = lu(k,2023) - lu(k,1534) * lu(k,2021) + lu(k,2024) = lu(k,2024) - lu(k,1535) * lu(k,2021) + lu(k,2025) = lu(k,2025) - lu(k,1536) * lu(k,2021) + lu(k,2026) = lu(k,2026) - lu(k,1537) * lu(k,2021) + lu(k,2027) = - lu(k,1538) * lu(k,2021) + lu(k,2028) = lu(k,2028) - lu(k,1539) * lu(k,2021) + lu(k,2029) = lu(k,2029) - lu(k,1540) * lu(k,2021) + lu(k,2030) = lu(k,2030) - lu(k,1541) * lu(k,2021) + lu(k,2031) = lu(k,2031) - lu(k,1542) * lu(k,2021) + lu(k,2032) = lu(k,2032) - lu(k,1543) * lu(k,2021) + lu(k,2033) = lu(k,2033) - lu(k,1544) * lu(k,2021) + lu(k,2035) = lu(k,2035) - lu(k,1545) * lu(k,2021) + lu(k,2081) = lu(k,2081) - lu(k,1533) * lu(k,2080) + lu(k,2082) = lu(k,2082) - lu(k,1534) * lu(k,2080) + lu(k,2083) = lu(k,2083) - lu(k,1535) * lu(k,2080) + lu(k,2084) = lu(k,2084) - lu(k,1536) * lu(k,2080) + lu(k,2085) = lu(k,2085) - lu(k,1537) * lu(k,2080) + lu(k,2086) = lu(k,2086) - lu(k,1538) * lu(k,2080) + lu(k,2087) = lu(k,2087) - lu(k,1539) * lu(k,2080) + lu(k,2088) = lu(k,2088) - lu(k,1540) * lu(k,2080) + lu(k,2089) = lu(k,2089) - lu(k,1541) * lu(k,2080) + lu(k,2090) = lu(k,2090) - lu(k,1542) * lu(k,2080) + lu(k,2091) = lu(k,2091) - lu(k,1543) * lu(k,2080) + lu(k,2092) = lu(k,2092) - lu(k,1544) * lu(k,2080) + lu(k,2094) = lu(k,2094) - lu(k,1545) * lu(k,2080) + lu(k,2120) = lu(k,2120) - lu(k,1533) * lu(k,2119) + lu(k,2121) = lu(k,2121) - lu(k,1534) * lu(k,2119) + lu(k,2122) = lu(k,2122) - lu(k,1535) * lu(k,2119) + lu(k,2123) = lu(k,2123) - lu(k,1536) * lu(k,2119) + lu(k,2124) = lu(k,2124) - lu(k,1537) * lu(k,2119) + lu(k,2125) = lu(k,2125) - lu(k,1538) * lu(k,2119) + lu(k,2126) = lu(k,2126) - lu(k,1539) * lu(k,2119) + lu(k,2127) = lu(k,2127) - lu(k,1540) * lu(k,2119) + lu(k,2128) = lu(k,2128) - lu(k,1541) * lu(k,2119) + lu(k,2129) = lu(k,2129) - lu(k,1542) * lu(k,2119) + lu(k,2130) = lu(k,2130) - lu(k,1543) * lu(k,2119) + lu(k,2131) = lu(k,2131) - lu(k,1544) * lu(k,2119) + lu(k,2133) = lu(k,2133) - lu(k,1545) * lu(k,2119) + lu(k,2182) = lu(k,2182) - lu(k,1533) * lu(k,2181) + lu(k,2183) = lu(k,2183) - lu(k,1534) * lu(k,2181) + lu(k,2184) = lu(k,2184) - lu(k,1535) * lu(k,2181) + lu(k,2185) = lu(k,2185) - lu(k,1536) * lu(k,2181) + lu(k,2186) = lu(k,2186) - lu(k,1537) * lu(k,2181) + lu(k,2187) = lu(k,2187) - lu(k,1538) * lu(k,2181) + lu(k,2188) = lu(k,2188) - lu(k,1539) * lu(k,2181) + lu(k,2189) = lu(k,2189) - lu(k,1540) * lu(k,2181) + lu(k,2190) = lu(k,2190) - lu(k,1541) * lu(k,2181) + lu(k,2191) = lu(k,2191) - lu(k,1542) * lu(k,2181) + lu(k,2192) = lu(k,2192) - lu(k,1543) * lu(k,2181) + lu(k,2193) = lu(k,2193) - lu(k,1544) * lu(k,2181) + lu(k,2195) = lu(k,2195) - lu(k,1545) * lu(k,2181) + lu(k,2300) = lu(k,2300) - lu(k,1533) * lu(k,2299) + lu(k,2301) = lu(k,2301) - lu(k,1534) * lu(k,2299) + lu(k,2302) = lu(k,2302) - lu(k,1535) * lu(k,2299) + lu(k,2303) = lu(k,2303) - lu(k,1536) * lu(k,2299) + lu(k,2304) = lu(k,2304) - lu(k,1537) * lu(k,2299) + lu(k,2305) = lu(k,2305) - lu(k,1538) * lu(k,2299) + lu(k,2306) = lu(k,2306) - lu(k,1539) * lu(k,2299) + lu(k,2307) = lu(k,2307) - lu(k,1540) * lu(k,2299) + lu(k,2308) = lu(k,2308) - lu(k,1541) * lu(k,2299) + lu(k,2309) = lu(k,2309) - lu(k,1542) * lu(k,2299) + lu(k,2310) = lu(k,2310) - lu(k,1543) * lu(k,2299) + lu(k,2311) = lu(k,2311) - lu(k,1544) * lu(k,2299) + lu(k,2313) = lu(k,2313) - lu(k,1545) * lu(k,2299) + lu(k,2326) = lu(k,2326) - lu(k,1533) * lu(k,2325) + lu(k,2327) = lu(k,2327) - lu(k,1534) * lu(k,2325) + lu(k,2328) = lu(k,2328) - lu(k,1535) * lu(k,2325) + lu(k,2329) = lu(k,2329) - lu(k,1536) * lu(k,2325) + lu(k,2330) = lu(k,2330) - lu(k,1537) * lu(k,2325) + lu(k,2331) = lu(k,2331) - lu(k,1538) * lu(k,2325) + lu(k,2332) = lu(k,2332) - lu(k,1539) * lu(k,2325) + lu(k,2333) = lu(k,2333) - lu(k,1540) * lu(k,2325) + lu(k,2334) = lu(k,2334) - lu(k,1541) * lu(k,2325) + lu(k,2335) = lu(k,2335) - lu(k,1542) * lu(k,2325) + lu(k,2336) = lu(k,2336) - lu(k,1543) * lu(k,2325) + lu(k,2337) = lu(k,2337) - lu(k,1544) * lu(k,2325) + lu(k,2339) = lu(k,2339) - lu(k,1545) * lu(k,2325) + lu(k,2352) = lu(k,2352) - lu(k,1533) * lu(k,2351) + lu(k,2353) = lu(k,2353) - lu(k,1534) * lu(k,2351) + lu(k,2354) = lu(k,2354) - lu(k,1535) * lu(k,2351) + lu(k,2355) = lu(k,2355) - lu(k,1536) * lu(k,2351) + lu(k,2356) = lu(k,2356) - lu(k,1537) * lu(k,2351) + lu(k,2357) = lu(k,2357) - lu(k,1538) * lu(k,2351) + lu(k,2358) = lu(k,2358) - lu(k,1539) * lu(k,2351) + lu(k,2359) = lu(k,2359) - lu(k,1540) * lu(k,2351) + lu(k,2360) = lu(k,2360) - lu(k,1541) * lu(k,2351) + lu(k,2361) = lu(k,2361) - lu(k,1542) * lu(k,2351) + lu(k,2362) = lu(k,2362) - lu(k,1543) * lu(k,2351) + lu(k,2363) = lu(k,2363) - lu(k,1544) * lu(k,2351) + lu(k,2365) = lu(k,2365) - lu(k,1545) * lu(k,2351) + lu(k,1576) = 1._r8 / lu(k,1576) + lu(k,1577) = lu(k,1577) * lu(k,1576) + lu(k,1578) = lu(k,1578) * lu(k,1576) + lu(k,1579) = lu(k,1579) * lu(k,1576) + lu(k,1580) = lu(k,1580) * lu(k,1576) + lu(k,1581) = lu(k,1581) * lu(k,1576) + lu(k,1582) = lu(k,1582) * lu(k,1576) + lu(k,1583) = lu(k,1583) * lu(k,1576) + lu(k,1584) = lu(k,1584) * lu(k,1576) + lu(k,1585) = lu(k,1585) * lu(k,1576) + lu(k,1586) = lu(k,1586) * lu(k,1576) + lu(k,1587) = lu(k,1587) * lu(k,1576) + lu(k,1588) = lu(k,1588) * lu(k,1576) + lu(k,1589) = lu(k,1589) * lu(k,1576) + lu(k,1608) = lu(k,1608) - lu(k,1577) * lu(k,1607) + lu(k,1609) = lu(k,1609) - lu(k,1578) * lu(k,1607) + lu(k,1610) = lu(k,1610) - lu(k,1579) * lu(k,1607) + lu(k,1611) = lu(k,1611) - lu(k,1580) * lu(k,1607) + lu(k,1612) = lu(k,1612) - lu(k,1581) * lu(k,1607) + lu(k,1613) = lu(k,1613) - lu(k,1582) * lu(k,1607) + lu(k,1614) = lu(k,1614) - lu(k,1583) * lu(k,1607) + lu(k,1615) = lu(k,1615) - lu(k,1584) * lu(k,1607) + lu(k,1616) = lu(k,1616) - lu(k,1585) * lu(k,1607) + lu(k,1617) = lu(k,1617) - lu(k,1586) * lu(k,1607) + lu(k,1618) = lu(k,1618) - lu(k,1587) * lu(k,1607) + lu(k,1619) = lu(k,1619) - lu(k,1588) * lu(k,1607) + lu(k,1620) = lu(k,1620) - lu(k,1589) * lu(k,1607) + lu(k,1649) = lu(k,1649) - lu(k,1577) * lu(k,1648) + lu(k,1650) = lu(k,1650) - lu(k,1578) * lu(k,1648) + lu(k,1651) = lu(k,1651) - lu(k,1579) * lu(k,1648) + lu(k,1652) = lu(k,1652) - lu(k,1580) * lu(k,1648) + lu(k,1653) = lu(k,1653) - lu(k,1581) * lu(k,1648) + lu(k,1654) = lu(k,1654) - lu(k,1582) * lu(k,1648) + lu(k,1655) = lu(k,1655) - lu(k,1583) * lu(k,1648) + lu(k,1656) = lu(k,1656) - lu(k,1584) * lu(k,1648) + lu(k,1657) = lu(k,1657) - lu(k,1585) * lu(k,1648) + lu(k,1658) = lu(k,1658) - lu(k,1586) * lu(k,1648) + lu(k,1659) = lu(k,1659) - lu(k,1587) * lu(k,1648) + lu(k,1660) = lu(k,1660) - lu(k,1588) * lu(k,1648) + lu(k,1661) = lu(k,1661) - lu(k,1589) * lu(k,1648) + lu(k,1821) = lu(k,1821) - lu(k,1577) * lu(k,1820) + lu(k,1822) = lu(k,1822) - lu(k,1578) * lu(k,1820) + lu(k,1823) = lu(k,1823) - lu(k,1579) * lu(k,1820) + lu(k,1824) = lu(k,1824) - lu(k,1580) * lu(k,1820) + lu(k,1825) = lu(k,1825) - lu(k,1581) * lu(k,1820) + lu(k,1826) = lu(k,1826) - lu(k,1582) * lu(k,1820) + lu(k,1827) = lu(k,1827) - lu(k,1583) * lu(k,1820) + lu(k,1828) = lu(k,1828) - lu(k,1584) * lu(k,1820) + lu(k,1829) = lu(k,1829) - lu(k,1585) * lu(k,1820) + lu(k,1830) = lu(k,1830) - lu(k,1586) * lu(k,1820) + lu(k,1831) = lu(k,1831) - lu(k,1587) * lu(k,1820) + lu(k,1832) = lu(k,1832) - lu(k,1588) * lu(k,1820) + lu(k,1833) = lu(k,1833) - lu(k,1589) * lu(k,1820) + lu(k,1845) = lu(k,1845) - lu(k,1577) * lu(k,1844) + lu(k,1846) = lu(k,1846) - lu(k,1578) * lu(k,1844) + lu(k,1847) = lu(k,1847) - lu(k,1579) * lu(k,1844) + lu(k,1848) = lu(k,1848) - lu(k,1580) * lu(k,1844) + lu(k,1849) = lu(k,1849) - lu(k,1581) * lu(k,1844) + lu(k,1850) = lu(k,1850) - lu(k,1582) * lu(k,1844) + lu(k,1851) = lu(k,1851) - lu(k,1583) * lu(k,1844) + lu(k,1852) = lu(k,1852) - lu(k,1584) * lu(k,1844) + lu(k,1853) = lu(k,1853) - lu(k,1585) * lu(k,1844) + lu(k,1854) = lu(k,1854) - lu(k,1586) * lu(k,1844) + lu(k,1855) = lu(k,1855) - lu(k,1587) * lu(k,1844) + lu(k,1856) = lu(k,1856) - lu(k,1588) * lu(k,1844) + lu(k,1857) = lu(k,1857) - lu(k,1589) * lu(k,1844) + lu(k,1948) = lu(k,1948) - lu(k,1577) * lu(k,1947) + lu(k,1949) = lu(k,1949) - lu(k,1578) * lu(k,1947) + lu(k,1950) = lu(k,1950) - lu(k,1579) * lu(k,1947) + lu(k,1951) = lu(k,1951) - lu(k,1580) * lu(k,1947) + lu(k,1952) = lu(k,1952) - lu(k,1581) * lu(k,1947) + lu(k,1953) = lu(k,1953) - lu(k,1582) * lu(k,1947) + lu(k,1954) = lu(k,1954) - lu(k,1583) * lu(k,1947) + lu(k,1955) = lu(k,1955) - lu(k,1584) * lu(k,1947) + lu(k,1956) = lu(k,1956) - lu(k,1585) * lu(k,1947) + lu(k,1957) = lu(k,1957) - lu(k,1586) * lu(k,1947) + lu(k,1958) = lu(k,1958) - lu(k,1587) * lu(k,1947) + lu(k,1959) = lu(k,1959) - lu(k,1588) * lu(k,1947) + lu(k,1960) = lu(k,1960) - lu(k,1589) * lu(k,1947) + lu(k,2000) = lu(k,2000) - lu(k,1577) * lu(k,1999) + lu(k,2001) = lu(k,2001) - lu(k,1578) * lu(k,1999) + lu(k,2002) = lu(k,2002) - lu(k,1579) * lu(k,1999) + lu(k,2003) = lu(k,2003) - lu(k,1580) * lu(k,1999) + lu(k,2004) = lu(k,2004) - lu(k,1581) * lu(k,1999) + lu(k,2005) = lu(k,2005) - lu(k,1582) * lu(k,1999) + lu(k,2006) = lu(k,2006) - lu(k,1583) * lu(k,1999) + lu(k,2007) = lu(k,2007) - lu(k,1584) * lu(k,1999) + lu(k,2008) = lu(k,2008) - lu(k,1585) * lu(k,1999) + lu(k,2009) = lu(k,2009) - lu(k,1586) * lu(k,1999) + lu(k,2010) = lu(k,2010) - lu(k,1587) * lu(k,1999) + lu(k,2011) = lu(k,2011) - lu(k,1588) * lu(k,1999) + lu(k,2012) = lu(k,2012) - lu(k,1589) * lu(k,1999) + lu(k,2023) = lu(k,2023) - lu(k,1577) * lu(k,2022) + lu(k,2024) = lu(k,2024) - lu(k,1578) * lu(k,2022) + lu(k,2025) = lu(k,2025) - lu(k,1579) * lu(k,2022) + lu(k,2026) = lu(k,2026) - lu(k,1580) * lu(k,2022) + lu(k,2027) = lu(k,2027) - lu(k,1581) * lu(k,2022) + lu(k,2028) = lu(k,2028) - lu(k,1582) * lu(k,2022) + lu(k,2029) = lu(k,2029) - lu(k,1583) * lu(k,2022) + lu(k,2030) = lu(k,2030) - lu(k,1584) * lu(k,2022) + lu(k,2031) = lu(k,2031) - lu(k,1585) * lu(k,2022) + lu(k,2032) = lu(k,2032) - lu(k,1586) * lu(k,2022) + lu(k,2033) = lu(k,2033) - lu(k,1587) * lu(k,2022) + lu(k,2034) = lu(k,2034) - lu(k,1588) * lu(k,2022) + lu(k,2035) = lu(k,2035) - lu(k,1589) * lu(k,2022) + lu(k,2082) = lu(k,2082) - lu(k,1577) * lu(k,2081) + lu(k,2083) = lu(k,2083) - lu(k,1578) * lu(k,2081) + lu(k,2084) = lu(k,2084) - lu(k,1579) * lu(k,2081) + lu(k,2085) = lu(k,2085) - lu(k,1580) * lu(k,2081) + lu(k,2086) = lu(k,2086) - lu(k,1581) * lu(k,2081) + lu(k,2087) = lu(k,2087) - lu(k,1582) * lu(k,2081) + lu(k,2088) = lu(k,2088) - lu(k,1583) * lu(k,2081) + lu(k,2089) = lu(k,2089) - lu(k,1584) * lu(k,2081) + lu(k,2090) = lu(k,2090) - lu(k,1585) * lu(k,2081) + lu(k,2091) = lu(k,2091) - lu(k,1586) * lu(k,2081) + lu(k,2092) = lu(k,2092) - lu(k,1587) * lu(k,2081) + lu(k,2093) = lu(k,2093) - lu(k,1588) * lu(k,2081) + lu(k,2094) = lu(k,2094) - lu(k,1589) * lu(k,2081) + lu(k,2121) = lu(k,2121) - lu(k,1577) * lu(k,2120) + lu(k,2122) = lu(k,2122) - lu(k,1578) * lu(k,2120) + lu(k,2123) = lu(k,2123) - lu(k,1579) * lu(k,2120) + lu(k,2124) = lu(k,2124) - lu(k,1580) * lu(k,2120) + lu(k,2125) = lu(k,2125) - lu(k,1581) * lu(k,2120) + lu(k,2126) = lu(k,2126) - lu(k,1582) * lu(k,2120) + lu(k,2127) = lu(k,2127) - lu(k,1583) * lu(k,2120) + lu(k,2128) = lu(k,2128) - lu(k,1584) * lu(k,2120) + lu(k,2129) = lu(k,2129) - lu(k,1585) * lu(k,2120) + lu(k,2130) = lu(k,2130) - lu(k,1586) * lu(k,2120) + lu(k,2131) = lu(k,2131) - lu(k,1587) * lu(k,2120) + lu(k,2132) = lu(k,2132) - lu(k,1588) * lu(k,2120) + lu(k,2133) = lu(k,2133) - lu(k,1589) * lu(k,2120) + lu(k,2183) = lu(k,2183) - lu(k,1577) * lu(k,2182) + lu(k,2184) = lu(k,2184) - lu(k,1578) * lu(k,2182) + lu(k,2185) = lu(k,2185) - lu(k,1579) * lu(k,2182) + lu(k,2186) = lu(k,2186) - lu(k,1580) * lu(k,2182) + lu(k,2187) = lu(k,2187) - lu(k,1581) * lu(k,2182) + lu(k,2188) = lu(k,2188) - lu(k,1582) * lu(k,2182) + lu(k,2189) = lu(k,2189) - lu(k,1583) * lu(k,2182) + lu(k,2190) = lu(k,2190) - lu(k,1584) * lu(k,2182) + lu(k,2191) = lu(k,2191) - lu(k,1585) * lu(k,2182) + lu(k,2192) = lu(k,2192) - lu(k,1586) * lu(k,2182) + lu(k,2193) = lu(k,2193) - lu(k,1587) * lu(k,2182) + lu(k,2194) = lu(k,2194) - lu(k,1588) * lu(k,2182) + lu(k,2195) = lu(k,2195) - lu(k,1589) * lu(k,2182) + lu(k,2301) = lu(k,2301) - lu(k,1577) * lu(k,2300) + lu(k,2302) = lu(k,2302) - lu(k,1578) * lu(k,2300) + lu(k,2303) = lu(k,2303) - lu(k,1579) * lu(k,2300) + lu(k,2304) = lu(k,2304) - lu(k,1580) * lu(k,2300) + lu(k,2305) = lu(k,2305) - lu(k,1581) * lu(k,2300) + lu(k,2306) = lu(k,2306) - lu(k,1582) * lu(k,2300) + lu(k,2307) = lu(k,2307) - lu(k,1583) * lu(k,2300) + lu(k,2308) = lu(k,2308) - lu(k,1584) * lu(k,2300) + lu(k,2309) = lu(k,2309) - lu(k,1585) * lu(k,2300) + lu(k,2310) = lu(k,2310) - lu(k,1586) * lu(k,2300) + lu(k,2311) = lu(k,2311) - lu(k,1587) * lu(k,2300) + lu(k,2312) = lu(k,2312) - lu(k,1588) * lu(k,2300) + lu(k,2313) = lu(k,2313) - lu(k,1589) * lu(k,2300) + lu(k,2327) = lu(k,2327) - lu(k,1577) * lu(k,2326) + lu(k,2328) = lu(k,2328) - lu(k,1578) * lu(k,2326) + lu(k,2329) = lu(k,2329) - lu(k,1579) * lu(k,2326) + lu(k,2330) = lu(k,2330) - lu(k,1580) * lu(k,2326) + lu(k,2331) = lu(k,2331) - lu(k,1581) * lu(k,2326) + lu(k,2332) = lu(k,2332) - lu(k,1582) * lu(k,2326) + lu(k,2333) = lu(k,2333) - lu(k,1583) * lu(k,2326) + lu(k,2334) = lu(k,2334) - lu(k,1584) * lu(k,2326) + lu(k,2335) = lu(k,2335) - lu(k,1585) * lu(k,2326) + lu(k,2336) = lu(k,2336) - lu(k,1586) * lu(k,2326) + lu(k,2337) = lu(k,2337) - lu(k,1587) * lu(k,2326) + lu(k,2338) = lu(k,2338) - lu(k,1588) * lu(k,2326) + lu(k,2339) = lu(k,2339) - lu(k,1589) * lu(k,2326) + lu(k,2353) = lu(k,2353) - lu(k,1577) * lu(k,2352) + lu(k,2354) = lu(k,2354) - lu(k,1578) * lu(k,2352) + lu(k,2355) = lu(k,2355) - lu(k,1579) * lu(k,2352) + lu(k,2356) = lu(k,2356) - lu(k,1580) * lu(k,2352) + lu(k,2357) = lu(k,2357) - lu(k,1581) * lu(k,2352) + lu(k,2358) = lu(k,2358) - lu(k,1582) * lu(k,2352) + lu(k,2359) = lu(k,2359) - lu(k,1583) * lu(k,2352) + lu(k,2360) = lu(k,2360) - lu(k,1584) * lu(k,2352) + lu(k,2361) = lu(k,2361) - lu(k,1585) * lu(k,2352) + lu(k,2362) = lu(k,2362) - lu(k,1586) * lu(k,2352) + lu(k,2363) = lu(k,2363) - lu(k,1587) * lu(k,2352) + lu(k,2364) = lu(k,2364) - lu(k,1588) * lu(k,2352) + lu(k,2365) = lu(k,2365) - lu(k,1589) * lu(k,2352) + lu(k,1608) = 1._r8 / lu(k,1608) + lu(k,1609) = lu(k,1609) * lu(k,1608) + lu(k,1610) = lu(k,1610) * lu(k,1608) + lu(k,1611) = lu(k,1611) * lu(k,1608) + lu(k,1612) = lu(k,1612) * lu(k,1608) + lu(k,1613) = lu(k,1613) * lu(k,1608) + lu(k,1614) = lu(k,1614) * lu(k,1608) + lu(k,1615) = lu(k,1615) * lu(k,1608) + lu(k,1616) = lu(k,1616) * lu(k,1608) + lu(k,1617) = lu(k,1617) * lu(k,1608) + lu(k,1618) = lu(k,1618) * lu(k,1608) + lu(k,1619) = lu(k,1619) * lu(k,1608) + lu(k,1620) = lu(k,1620) * lu(k,1608) + lu(k,1650) = lu(k,1650) - lu(k,1609) * lu(k,1649) + lu(k,1651) = lu(k,1651) - lu(k,1610) * lu(k,1649) + lu(k,1652) = lu(k,1652) - lu(k,1611) * lu(k,1649) + lu(k,1653) = lu(k,1653) - lu(k,1612) * lu(k,1649) + lu(k,1654) = lu(k,1654) - lu(k,1613) * lu(k,1649) + lu(k,1655) = lu(k,1655) - lu(k,1614) * lu(k,1649) + lu(k,1656) = lu(k,1656) - lu(k,1615) * lu(k,1649) + lu(k,1657) = lu(k,1657) - lu(k,1616) * lu(k,1649) + lu(k,1658) = lu(k,1658) - lu(k,1617) * lu(k,1649) + lu(k,1659) = lu(k,1659) - lu(k,1618) * lu(k,1649) + lu(k,1660) = lu(k,1660) - lu(k,1619) * lu(k,1649) + lu(k,1661) = lu(k,1661) - lu(k,1620) * lu(k,1649) + lu(k,1822) = lu(k,1822) - lu(k,1609) * lu(k,1821) + lu(k,1823) = lu(k,1823) - lu(k,1610) * lu(k,1821) + lu(k,1824) = lu(k,1824) - lu(k,1611) * lu(k,1821) + lu(k,1825) = lu(k,1825) - lu(k,1612) * lu(k,1821) + lu(k,1826) = lu(k,1826) - lu(k,1613) * lu(k,1821) + lu(k,1827) = lu(k,1827) - lu(k,1614) * lu(k,1821) + lu(k,1828) = lu(k,1828) - lu(k,1615) * lu(k,1821) + lu(k,1829) = lu(k,1829) - lu(k,1616) * lu(k,1821) + lu(k,1830) = lu(k,1830) - lu(k,1617) * lu(k,1821) + lu(k,1831) = lu(k,1831) - lu(k,1618) * lu(k,1821) + lu(k,1832) = lu(k,1832) - lu(k,1619) * lu(k,1821) + lu(k,1833) = lu(k,1833) - lu(k,1620) * lu(k,1821) + lu(k,1846) = lu(k,1846) - lu(k,1609) * lu(k,1845) + lu(k,1847) = lu(k,1847) - lu(k,1610) * lu(k,1845) + lu(k,1848) = lu(k,1848) - lu(k,1611) * lu(k,1845) + lu(k,1849) = lu(k,1849) - lu(k,1612) * lu(k,1845) + lu(k,1850) = lu(k,1850) - lu(k,1613) * lu(k,1845) + lu(k,1851) = lu(k,1851) - lu(k,1614) * lu(k,1845) + lu(k,1852) = lu(k,1852) - lu(k,1615) * lu(k,1845) + lu(k,1853) = lu(k,1853) - lu(k,1616) * lu(k,1845) + lu(k,1854) = lu(k,1854) - lu(k,1617) * lu(k,1845) + lu(k,1855) = lu(k,1855) - lu(k,1618) * lu(k,1845) + lu(k,1856) = lu(k,1856) - lu(k,1619) * lu(k,1845) + lu(k,1857) = lu(k,1857) - lu(k,1620) * lu(k,1845) + lu(k,1949) = lu(k,1949) - lu(k,1609) * lu(k,1948) + lu(k,1950) = lu(k,1950) - lu(k,1610) * lu(k,1948) + lu(k,1951) = lu(k,1951) - lu(k,1611) * lu(k,1948) + lu(k,1952) = lu(k,1952) - lu(k,1612) * lu(k,1948) + lu(k,1953) = lu(k,1953) - lu(k,1613) * lu(k,1948) + lu(k,1954) = lu(k,1954) - lu(k,1614) * lu(k,1948) + lu(k,1955) = lu(k,1955) - lu(k,1615) * lu(k,1948) + lu(k,1956) = lu(k,1956) - lu(k,1616) * lu(k,1948) + lu(k,1957) = lu(k,1957) - lu(k,1617) * lu(k,1948) + lu(k,1958) = lu(k,1958) - lu(k,1618) * lu(k,1948) + lu(k,1959) = lu(k,1959) - lu(k,1619) * lu(k,1948) + lu(k,1960) = lu(k,1960) - lu(k,1620) * lu(k,1948) + lu(k,2001) = lu(k,2001) - lu(k,1609) * lu(k,2000) + lu(k,2002) = lu(k,2002) - lu(k,1610) * lu(k,2000) + lu(k,2003) = lu(k,2003) - lu(k,1611) * lu(k,2000) + lu(k,2004) = lu(k,2004) - lu(k,1612) * lu(k,2000) + lu(k,2005) = lu(k,2005) - lu(k,1613) * lu(k,2000) + lu(k,2006) = lu(k,2006) - lu(k,1614) * lu(k,2000) + lu(k,2007) = lu(k,2007) - lu(k,1615) * lu(k,2000) + lu(k,2008) = lu(k,2008) - lu(k,1616) * lu(k,2000) + lu(k,2009) = lu(k,2009) - lu(k,1617) * lu(k,2000) + lu(k,2010) = lu(k,2010) - lu(k,1618) * lu(k,2000) + lu(k,2011) = lu(k,2011) - lu(k,1619) * lu(k,2000) + lu(k,2012) = lu(k,2012) - lu(k,1620) * lu(k,2000) + lu(k,2024) = lu(k,2024) - lu(k,1609) * lu(k,2023) + lu(k,2025) = lu(k,2025) - lu(k,1610) * lu(k,2023) + lu(k,2026) = lu(k,2026) - lu(k,1611) * lu(k,2023) + lu(k,2027) = lu(k,2027) - lu(k,1612) * lu(k,2023) + lu(k,2028) = lu(k,2028) - lu(k,1613) * lu(k,2023) + lu(k,2029) = lu(k,2029) - lu(k,1614) * lu(k,2023) + lu(k,2030) = lu(k,2030) - lu(k,1615) * lu(k,2023) + lu(k,2031) = lu(k,2031) - lu(k,1616) * lu(k,2023) + lu(k,2032) = lu(k,2032) - lu(k,1617) * lu(k,2023) + lu(k,2033) = lu(k,2033) - lu(k,1618) * lu(k,2023) + lu(k,2034) = lu(k,2034) - lu(k,1619) * lu(k,2023) + lu(k,2035) = lu(k,2035) - lu(k,1620) * lu(k,2023) + lu(k,2083) = lu(k,2083) - lu(k,1609) * lu(k,2082) + lu(k,2084) = lu(k,2084) - lu(k,1610) * lu(k,2082) + lu(k,2085) = lu(k,2085) - lu(k,1611) * lu(k,2082) + lu(k,2086) = lu(k,2086) - lu(k,1612) * lu(k,2082) + lu(k,2087) = lu(k,2087) - lu(k,1613) * lu(k,2082) + lu(k,2088) = lu(k,2088) - lu(k,1614) * lu(k,2082) + lu(k,2089) = lu(k,2089) - lu(k,1615) * lu(k,2082) + lu(k,2090) = lu(k,2090) - lu(k,1616) * lu(k,2082) + lu(k,2091) = lu(k,2091) - lu(k,1617) * lu(k,2082) + lu(k,2092) = lu(k,2092) - lu(k,1618) * lu(k,2082) + lu(k,2093) = lu(k,2093) - lu(k,1619) * lu(k,2082) + lu(k,2094) = lu(k,2094) - lu(k,1620) * lu(k,2082) + lu(k,2122) = lu(k,2122) - lu(k,1609) * lu(k,2121) + lu(k,2123) = lu(k,2123) - lu(k,1610) * lu(k,2121) + lu(k,2124) = lu(k,2124) - lu(k,1611) * lu(k,2121) + lu(k,2125) = lu(k,2125) - lu(k,1612) * lu(k,2121) + lu(k,2126) = lu(k,2126) - lu(k,1613) * lu(k,2121) + lu(k,2127) = lu(k,2127) - lu(k,1614) * lu(k,2121) + lu(k,2128) = lu(k,2128) - lu(k,1615) * lu(k,2121) + lu(k,2129) = lu(k,2129) - lu(k,1616) * lu(k,2121) + lu(k,2130) = lu(k,2130) - lu(k,1617) * lu(k,2121) + lu(k,2131) = lu(k,2131) - lu(k,1618) * lu(k,2121) + lu(k,2132) = lu(k,2132) - lu(k,1619) * lu(k,2121) + lu(k,2133) = lu(k,2133) - lu(k,1620) * lu(k,2121) + lu(k,2184) = lu(k,2184) - lu(k,1609) * lu(k,2183) + lu(k,2185) = lu(k,2185) - lu(k,1610) * lu(k,2183) + lu(k,2186) = lu(k,2186) - lu(k,1611) * lu(k,2183) + lu(k,2187) = lu(k,2187) - lu(k,1612) * lu(k,2183) + lu(k,2188) = lu(k,2188) - lu(k,1613) * lu(k,2183) + lu(k,2189) = lu(k,2189) - lu(k,1614) * lu(k,2183) + lu(k,2190) = lu(k,2190) - lu(k,1615) * lu(k,2183) + lu(k,2191) = lu(k,2191) - lu(k,1616) * lu(k,2183) + lu(k,2192) = lu(k,2192) - lu(k,1617) * lu(k,2183) + lu(k,2193) = lu(k,2193) - lu(k,1618) * lu(k,2183) + lu(k,2194) = lu(k,2194) - lu(k,1619) * lu(k,2183) + lu(k,2195) = lu(k,2195) - lu(k,1620) * lu(k,2183) + lu(k,2302) = lu(k,2302) - lu(k,1609) * lu(k,2301) + lu(k,2303) = lu(k,2303) - lu(k,1610) * lu(k,2301) + lu(k,2304) = lu(k,2304) - lu(k,1611) * lu(k,2301) + lu(k,2305) = lu(k,2305) - lu(k,1612) * lu(k,2301) + lu(k,2306) = lu(k,2306) - lu(k,1613) * lu(k,2301) + lu(k,2307) = lu(k,2307) - lu(k,1614) * lu(k,2301) + lu(k,2308) = lu(k,2308) - lu(k,1615) * lu(k,2301) + lu(k,2309) = lu(k,2309) - lu(k,1616) * lu(k,2301) + lu(k,2310) = lu(k,2310) - lu(k,1617) * lu(k,2301) + lu(k,2311) = lu(k,2311) - lu(k,1618) * lu(k,2301) + lu(k,2312) = lu(k,2312) - lu(k,1619) * lu(k,2301) + lu(k,2313) = lu(k,2313) - lu(k,1620) * lu(k,2301) + lu(k,2328) = lu(k,2328) - lu(k,1609) * lu(k,2327) + lu(k,2329) = lu(k,2329) - lu(k,1610) * lu(k,2327) + lu(k,2330) = lu(k,2330) - lu(k,1611) * lu(k,2327) + lu(k,2331) = lu(k,2331) - lu(k,1612) * lu(k,2327) + lu(k,2332) = lu(k,2332) - lu(k,1613) * lu(k,2327) + lu(k,2333) = lu(k,2333) - lu(k,1614) * lu(k,2327) + lu(k,2334) = lu(k,2334) - lu(k,1615) * lu(k,2327) + lu(k,2335) = lu(k,2335) - lu(k,1616) * lu(k,2327) + lu(k,2336) = lu(k,2336) - lu(k,1617) * lu(k,2327) + lu(k,2337) = lu(k,2337) - lu(k,1618) * lu(k,2327) + lu(k,2338) = lu(k,2338) - lu(k,1619) * lu(k,2327) + lu(k,2339) = lu(k,2339) - lu(k,1620) * lu(k,2327) + lu(k,2354) = lu(k,2354) - lu(k,1609) * lu(k,2353) + lu(k,2355) = lu(k,2355) - lu(k,1610) * lu(k,2353) + lu(k,2356) = lu(k,2356) - lu(k,1611) * lu(k,2353) + lu(k,2357) = lu(k,2357) - lu(k,1612) * lu(k,2353) + lu(k,2358) = lu(k,2358) - lu(k,1613) * lu(k,2353) + lu(k,2359) = lu(k,2359) - lu(k,1614) * lu(k,2353) + lu(k,2360) = lu(k,2360) - lu(k,1615) * lu(k,2353) + lu(k,2361) = lu(k,2361) - lu(k,1616) * lu(k,2353) + lu(k,2362) = lu(k,2362) - lu(k,1617) * lu(k,2353) + lu(k,2363) = lu(k,2363) - lu(k,1618) * lu(k,2353) + lu(k,2364) = lu(k,2364) - lu(k,1619) * lu(k,2353) + lu(k,2365) = lu(k,2365) - lu(k,1620) * lu(k,2353) + end do + end subroutine lu_fac29 + subroutine lu_fac30( 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,1650) = 1._r8 / lu(k,1650) + lu(k,1651) = lu(k,1651) * lu(k,1650) + lu(k,1652) = lu(k,1652) * lu(k,1650) + lu(k,1653) = lu(k,1653) * lu(k,1650) + lu(k,1654) = lu(k,1654) * lu(k,1650) + lu(k,1655) = lu(k,1655) * lu(k,1650) + lu(k,1656) = lu(k,1656) * lu(k,1650) + lu(k,1657) = lu(k,1657) * lu(k,1650) + lu(k,1658) = lu(k,1658) * lu(k,1650) + lu(k,1659) = lu(k,1659) * lu(k,1650) + lu(k,1660) = lu(k,1660) * lu(k,1650) + lu(k,1661) = lu(k,1661) * lu(k,1650) + lu(k,1823) = lu(k,1823) - lu(k,1651) * lu(k,1822) + lu(k,1824) = lu(k,1824) - lu(k,1652) * lu(k,1822) + lu(k,1825) = lu(k,1825) - lu(k,1653) * lu(k,1822) + lu(k,1826) = lu(k,1826) - lu(k,1654) * lu(k,1822) + lu(k,1827) = lu(k,1827) - lu(k,1655) * lu(k,1822) + lu(k,1828) = lu(k,1828) - lu(k,1656) * lu(k,1822) + lu(k,1829) = lu(k,1829) - lu(k,1657) * lu(k,1822) + lu(k,1830) = lu(k,1830) - lu(k,1658) * lu(k,1822) + lu(k,1831) = lu(k,1831) - lu(k,1659) * lu(k,1822) + lu(k,1832) = lu(k,1832) - lu(k,1660) * lu(k,1822) + lu(k,1833) = lu(k,1833) - lu(k,1661) * lu(k,1822) + lu(k,1847) = lu(k,1847) - lu(k,1651) * lu(k,1846) + lu(k,1848) = lu(k,1848) - lu(k,1652) * lu(k,1846) + lu(k,1849) = lu(k,1849) - lu(k,1653) * lu(k,1846) + lu(k,1850) = lu(k,1850) - lu(k,1654) * lu(k,1846) + lu(k,1851) = lu(k,1851) - lu(k,1655) * lu(k,1846) + lu(k,1852) = lu(k,1852) - lu(k,1656) * lu(k,1846) + lu(k,1853) = lu(k,1853) - lu(k,1657) * lu(k,1846) + lu(k,1854) = lu(k,1854) - lu(k,1658) * lu(k,1846) + lu(k,1855) = lu(k,1855) - lu(k,1659) * lu(k,1846) + lu(k,1856) = lu(k,1856) - lu(k,1660) * lu(k,1846) + lu(k,1857) = lu(k,1857) - lu(k,1661) * lu(k,1846) + lu(k,1950) = lu(k,1950) - lu(k,1651) * lu(k,1949) + lu(k,1951) = lu(k,1951) - lu(k,1652) * lu(k,1949) + lu(k,1952) = lu(k,1952) - lu(k,1653) * lu(k,1949) + lu(k,1953) = lu(k,1953) - lu(k,1654) * lu(k,1949) + lu(k,1954) = lu(k,1954) - lu(k,1655) * lu(k,1949) + lu(k,1955) = lu(k,1955) - lu(k,1656) * lu(k,1949) + lu(k,1956) = lu(k,1956) - lu(k,1657) * lu(k,1949) + lu(k,1957) = lu(k,1957) - lu(k,1658) * lu(k,1949) + lu(k,1958) = lu(k,1958) - lu(k,1659) * lu(k,1949) + lu(k,1959) = lu(k,1959) - lu(k,1660) * lu(k,1949) + lu(k,1960) = lu(k,1960) - lu(k,1661) * lu(k,1949) + lu(k,2002) = lu(k,2002) - lu(k,1651) * lu(k,2001) + lu(k,2003) = lu(k,2003) - lu(k,1652) * lu(k,2001) + lu(k,2004) = lu(k,2004) - lu(k,1653) * lu(k,2001) + lu(k,2005) = lu(k,2005) - lu(k,1654) * lu(k,2001) + lu(k,2006) = lu(k,2006) - lu(k,1655) * lu(k,2001) + lu(k,2007) = lu(k,2007) - lu(k,1656) * lu(k,2001) + lu(k,2008) = lu(k,2008) - lu(k,1657) * lu(k,2001) + lu(k,2009) = lu(k,2009) - lu(k,1658) * lu(k,2001) + lu(k,2010) = lu(k,2010) - lu(k,1659) * lu(k,2001) + lu(k,2011) = lu(k,2011) - lu(k,1660) * lu(k,2001) + lu(k,2012) = lu(k,2012) - lu(k,1661) * lu(k,2001) + lu(k,2025) = lu(k,2025) - lu(k,1651) * lu(k,2024) + lu(k,2026) = lu(k,2026) - lu(k,1652) * lu(k,2024) + lu(k,2027) = lu(k,2027) - lu(k,1653) * lu(k,2024) + lu(k,2028) = lu(k,2028) - lu(k,1654) * lu(k,2024) + lu(k,2029) = lu(k,2029) - lu(k,1655) * lu(k,2024) + lu(k,2030) = lu(k,2030) - lu(k,1656) * lu(k,2024) + lu(k,2031) = lu(k,2031) - lu(k,1657) * lu(k,2024) + lu(k,2032) = lu(k,2032) - lu(k,1658) * lu(k,2024) + lu(k,2033) = lu(k,2033) - lu(k,1659) * lu(k,2024) + lu(k,2034) = lu(k,2034) - lu(k,1660) * lu(k,2024) + lu(k,2035) = lu(k,2035) - lu(k,1661) * lu(k,2024) + lu(k,2084) = lu(k,2084) - lu(k,1651) * lu(k,2083) + lu(k,2085) = lu(k,2085) - lu(k,1652) * lu(k,2083) + lu(k,2086) = lu(k,2086) - lu(k,1653) * lu(k,2083) + lu(k,2087) = lu(k,2087) - lu(k,1654) * lu(k,2083) + lu(k,2088) = lu(k,2088) - lu(k,1655) * lu(k,2083) + lu(k,2089) = lu(k,2089) - lu(k,1656) * lu(k,2083) + lu(k,2090) = lu(k,2090) - lu(k,1657) * lu(k,2083) + lu(k,2091) = lu(k,2091) - lu(k,1658) * lu(k,2083) + lu(k,2092) = lu(k,2092) - lu(k,1659) * lu(k,2083) + lu(k,2093) = lu(k,2093) - lu(k,1660) * lu(k,2083) + lu(k,2094) = lu(k,2094) - lu(k,1661) * lu(k,2083) + lu(k,2123) = lu(k,2123) - lu(k,1651) * lu(k,2122) + lu(k,2124) = lu(k,2124) - lu(k,1652) * lu(k,2122) + lu(k,2125) = lu(k,2125) - lu(k,1653) * lu(k,2122) + lu(k,2126) = lu(k,2126) - lu(k,1654) * lu(k,2122) + lu(k,2127) = lu(k,2127) - lu(k,1655) * lu(k,2122) + lu(k,2128) = lu(k,2128) - lu(k,1656) * lu(k,2122) + lu(k,2129) = lu(k,2129) - lu(k,1657) * lu(k,2122) + lu(k,2130) = lu(k,2130) - lu(k,1658) * lu(k,2122) + lu(k,2131) = lu(k,2131) - lu(k,1659) * lu(k,2122) + lu(k,2132) = lu(k,2132) - lu(k,1660) * lu(k,2122) + lu(k,2133) = lu(k,2133) - lu(k,1661) * lu(k,2122) + lu(k,2185) = lu(k,2185) - lu(k,1651) * lu(k,2184) + lu(k,2186) = lu(k,2186) - lu(k,1652) * lu(k,2184) + lu(k,2187) = lu(k,2187) - lu(k,1653) * lu(k,2184) + lu(k,2188) = lu(k,2188) - lu(k,1654) * lu(k,2184) + lu(k,2189) = lu(k,2189) - lu(k,1655) * lu(k,2184) + lu(k,2190) = lu(k,2190) - lu(k,1656) * lu(k,2184) + lu(k,2191) = lu(k,2191) - lu(k,1657) * lu(k,2184) + lu(k,2192) = lu(k,2192) - lu(k,1658) * lu(k,2184) + lu(k,2193) = lu(k,2193) - lu(k,1659) * lu(k,2184) + lu(k,2194) = lu(k,2194) - lu(k,1660) * lu(k,2184) + lu(k,2195) = lu(k,2195) - lu(k,1661) * lu(k,2184) + lu(k,2303) = lu(k,2303) - lu(k,1651) * lu(k,2302) + lu(k,2304) = lu(k,2304) - lu(k,1652) * lu(k,2302) + lu(k,2305) = lu(k,2305) - lu(k,1653) * lu(k,2302) + lu(k,2306) = lu(k,2306) - lu(k,1654) * lu(k,2302) + lu(k,2307) = lu(k,2307) - lu(k,1655) * lu(k,2302) + lu(k,2308) = lu(k,2308) - lu(k,1656) * lu(k,2302) + lu(k,2309) = lu(k,2309) - lu(k,1657) * lu(k,2302) + lu(k,2310) = lu(k,2310) - lu(k,1658) * lu(k,2302) + lu(k,2311) = lu(k,2311) - lu(k,1659) * lu(k,2302) + lu(k,2312) = lu(k,2312) - lu(k,1660) * lu(k,2302) + lu(k,2313) = lu(k,2313) - lu(k,1661) * lu(k,2302) + lu(k,2329) = lu(k,2329) - lu(k,1651) * lu(k,2328) + lu(k,2330) = lu(k,2330) - lu(k,1652) * lu(k,2328) + lu(k,2331) = lu(k,2331) - lu(k,1653) * lu(k,2328) + lu(k,2332) = lu(k,2332) - lu(k,1654) * lu(k,2328) + lu(k,2333) = lu(k,2333) - lu(k,1655) * lu(k,2328) + lu(k,2334) = lu(k,2334) - lu(k,1656) * lu(k,2328) + lu(k,2335) = lu(k,2335) - lu(k,1657) * lu(k,2328) + lu(k,2336) = lu(k,2336) - lu(k,1658) * lu(k,2328) + lu(k,2337) = lu(k,2337) - lu(k,1659) * lu(k,2328) + lu(k,2338) = lu(k,2338) - lu(k,1660) * lu(k,2328) + lu(k,2339) = lu(k,2339) - lu(k,1661) * lu(k,2328) + lu(k,2355) = lu(k,2355) - lu(k,1651) * lu(k,2354) + lu(k,2356) = lu(k,2356) - lu(k,1652) * lu(k,2354) + lu(k,2357) = lu(k,2357) - lu(k,1653) * lu(k,2354) + lu(k,2358) = lu(k,2358) - lu(k,1654) * lu(k,2354) + lu(k,2359) = lu(k,2359) - lu(k,1655) * lu(k,2354) + lu(k,2360) = lu(k,2360) - lu(k,1656) * lu(k,2354) + lu(k,2361) = lu(k,2361) - lu(k,1657) * lu(k,2354) + lu(k,2362) = lu(k,2362) - lu(k,1658) * lu(k,2354) + lu(k,2363) = lu(k,2363) - lu(k,1659) * lu(k,2354) + lu(k,2364) = lu(k,2364) - lu(k,1660) * lu(k,2354) + lu(k,2365) = lu(k,2365) - lu(k,1661) * lu(k,2354) + lu(k,1823) = 1._r8 / lu(k,1823) + lu(k,1824) = lu(k,1824) * lu(k,1823) + lu(k,1825) = lu(k,1825) * lu(k,1823) + lu(k,1826) = lu(k,1826) * lu(k,1823) + lu(k,1827) = lu(k,1827) * lu(k,1823) + lu(k,1828) = lu(k,1828) * lu(k,1823) + lu(k,1829) = lu(k,1829) * lu(k,1823) + lu(k,1830) = lu(k,1830) * lu(k,1823) + lu(k,1831) = lu(k,1831) * lu(k,1823) + lu(k,1832) = lu(k,1832) * lu(k,1823) + lu(k,1833) = lu(k,1833) * lu(k,1823) + lu(k,1848) = lu(k,1848) - lu(k,1824) * lu(k,1847) + lu(k,1849) = lu(k,1849) - lu(k,1825) * lu(k,1847) + lu(k,1850) = lu(k,1850) - lu(k,1826) * lu(k,1847) + lu(k,1851) = lu(k,1851) - lu(k,1827) * lu(k,1847) + lu(k,1852) = lu(k,1852) - lu(k,1828) * lu(k,1847) + lu(k,1853) = lu(k,1853) - lu(k,1829) * lu(k,1847) + lu(k,1854) = lu(k,1854) - lu(k,1830) * lu(k,1847) + lu(k,1855) = lu(k,1855) - lu(k,1831) * lu(k,1847) + lu(k,1856) = lu(k,1856) - lu(k,1832) * lu(k,1847) + lu(k,1857) = lu(k,1857) - lu(k,1833) * lu(k,1847) + lu(k,1951) = lu(k,1951) - lu(k,1824) * lu(k,1950) + lu(k,1952) = lu(k,1952) - lu(k,1825) * lu(k,1950) + lu(k,1953) = lu(k,1953) - lu(k,1826) * lu(k,1950) + lu(k,1954) = lu(k,1954) - lu(k,1827) * lu(k,1950) + lu(k,1955) = lu(k,1955) - lu(k,1828) * lu(k,1950) + lu(k,1956) = lu(k,1956) - lu(k,1829) * lu(k,1950) + lu(k,1957) = lu(k,1957) - lu(k,1830) * lu(k,1950) + lu(k,1958) = lu(k,1958) - lu(k,1831) * lu(k,1950) + lu(k,1959) = lu(k,1959) - lu(k,1832) * lu(k,1950) + lu(k,1960) = lu(k,1960) - lu(k,1833) * lu(k,1950) + lu(k,2003) = lu(k,2003) - lu(k,1824) * lu(k,2002) + lu(k,2004) = lu(k,2004) - lu(k,1825) * lu(k,2002) + lu(k,2005) = lu(k,2005) - lu(k,1826) * lu(k,2002) + lu(k,2006) = lu(k,2006) - lu(k,1827) * lu(k,2002) + lu(k,2007) = lu(k,2007) - lu(k,1828) * lu(k,2002) + lu(k,2008) = lu(k,2008) - lu(k,1829) * lu(k,2002) + lu(k,2009) = lu(k,2009) - lu(k,1830) * lu(k,2002) + lu(k,2010) = lu(k,2010) - lu(k,1831) * lu(k,2002) + lu(k,2011) = lu(k,2011) - lu(k,1832) * lu(k,2002) + lu(k,2012) = lu(k,2012) - lu(k,1833) * lu(k,2002) + lu(k,2026) = lu(k,2026) - lu(k,1824) * lu(k,2025) + lu(k,2027) = lu(k,2027) - lu(k,1825) * lu(k,2025) + lu(k,2028) = lu(k,2028) - lu(k,1826) * lu(k,2025) + lu(k,2029) = lu(k,2029) - lu(k,1827) * lu(k,2025) + lu(k,2030) = lu(k,2030) - lu(k,1828) * lu(k,2025) + lu(k,2031) = lu(k,2031) - lu(k,1829) * lu(k,2025) + lu(k,2032) = lu(k,2032) - lu(k,1830) * lu(k,2025) + lu(k,2033) = lu(k,2033) - lu(k,1831) * lu(k,2025) + lu(k,2034) = lu(k,2034) - lu(k,1832) * lu(k,2025) + lu(k,2035) = lu(k,2035) - lu(k,1833) * lu(k,2025) + lu(k,2085) = lu(k,2085) - lu(k,1824) * lu(k,2084) + lu(k,2086) = lu(k,2086) - lu(k,1825) * lu(k,2084) + lu(k,2087) = lu(k,2087) - lu(k,1826) * lu(k,2084) + lu(k,2088) = lu(k,2088) - lu(k,1827) * lu(k,2084) + lu(k,2089) = lu(k,2089) - lu(k,1828) * lu(k,2084) + lu(k,2090) = lu(k,2090) - lu(k,1829) * lu(k,2084) + lu(k,2091) = lu(k,2091) - lu(k,1830) * lu(k,2084) + lu(k,2092) = lu(k,2092) - lu(k,1831) * lu(k,2084) + lu(k,2093) = lu(k,2093) - lu(k,1832) * lu(k,2084) + lu(k,2094) = lu(k,2094) - lu(k,1833) * lu(k,2084) + lu(k,2124) = lu(k,2124) - lu(k,1824) * lu(k,2123) + lu(k,2125) = lu(k,2125) - lu(k,1825) * lu(k,2123) + lu(k,2126) = lu(k,2126) - lu(k,1826) * lu(k,2123) + lu(k,2127) = lu(k,2127) - lu(k,1827) * lu(k,2123) + lu(k,2128) = lu(k,2128) - lu(k,1828) * lu(k,2123) + lu(k,2129) = lu(k,2129) - lu(k,1829) * lu(k,2123) + lu(k,2130) = lu(k,2130) - lu(k,1830) * lu(k,2123) + lu(k,2131) = lu(k,2131) - lu(k,1831) * lu(k,2123) + lu(k,2132) = lu(k,2132) - lu(k,1832) * lu(k,2123) + lu(k,2133) = lu(k,2133) - lu(k,1833) * lu(k,2123) + lu(k,2186) = lu(k,2186) - lu(k,1824) * lu(k,2185) + lu(k,2187) = lu(k,2187) - lu(k,1825) * lu(k,2185) + lu(k,2188) = lu(k,2188) - lu(k,1826) * lu(k,2185) + lu(k,2189) = lu(k,2189) - lu(k,1827) * lu(k,2185) + lu(k,2190) = lu(k,2190) - lu(k,1828) * lu(k,2185) + lu(k,2191) = lu(k,2191) - lu(k,1829) * lu(k,2185) + lu(k,2192) = lu(k,2192) - lu(k,1830) * lu(k,2185) + lu(k,2193) = lu(k,2193) - lu(k,1831) * lu(k,2185) + lu(k,2194) = lu(k,2194) - lu(k,1832) * lu(k,2185) + lu(k,2195) = lu(k,2195) - lu(k,1833) * lu(k,2185) + lu(k,2304) = lu(k,2304) - lu(k,1824) * lu(k,2303) + lu(k,2305) = lu(k,2305) - lu(k,1825) * lu(k,2303) + lu(k,2306) = lu(k,2306) - lu(k,1826) * lu(k,2303) + lu(k,2307) = lu(k,2307) - lu(k,1827) * lu(k,2303) + lu(k,2308) = lu(k,2308) - lu(k,1828) * lu(k,2303) + lu(k,2309) = lu(k,2309) - lu(k,1829) * lu(k,2303) + lu(k,2310) = lu(k,2310) - lu(k,1830) * lu(k,2303) + lu(k,2311) = lu(k,2311) - lu(k,1831) * lu(k,2303) + lu(k,2312) = lu(k,2312) - lu(k,1832) * lu(k,2303) + lu(k,2313) = lu(k,2313) - lu(k,1833) * lu(k,2303) + lu(k,2330) = lu(k,2330) - lu(k,1824) * lu(k,2329) + lu(k,2331) = lu(k,2331) - lu(k,1825) * lu(k,2329) + lu(k,2332) = lu(k,2332) - lu(k,1826) * lu(k,2329) + lu(k,2333) = lu(k,2333) - lu(k,1827) * lu(k,2329) + lu(k,2334) = lu(k,2334) - lu(k,1828) * lu(k,2329) + lu(k,2335) = lu(k,2335) - lu(k,1829) * lu(k,2329) + lu(k,2336) = lu(k,2336) - lu(k,1830) * lu(k,2329) + lu(k,2337) = lu(k,2337) - lu(k,1831) * lu(k,2329) + lu(k,2338) = lu(k,2338) - lu(k,1832) * lu(k,2329) + lu(k,2339) = lu(k,2339) - lu(k,1833) * lu(k,2329) + lu(k,2356) = lu(k,2356) - lu(k,1824) * lu(k,2355) + lu(k,2357) = lu(k,2357) - lu(k,1825) * lu(k,2355) + lu(k,2358) = lu(k,2358) - lu(k,1826) * lu(k,2355) + lu(k,2359) = lu(k,2359) - lu(k,1827) * lu(k,2355) + lu(k,2360) = lu(k,2360) - lu(k,1828) * lu(k,2355) + lu(k,2361) = lu(k,2361) - lu(k,1829) * lu(k,2355) + lu(k,2362) = lu(k,2362) - lu(k,1830) * lu(k,2355) + lu(k,2363) = lu(k,2363) - lu(k,1831) * lu(k,2355) + lu(k,2364) = lu(k,2364) - lu(k,1832) * lu(k,2355) + lu(k,2365) = lu(k,2365) - lu(k,1833) * lu(k,2355) + lu(k,1848) = 1._r8 / lu(k,1848) + lu(k,1849) = lu(k,1849) * lu(k,1848) + lu(k,1850) = lu(k,1850) * lu(k,1848) + lu(k,1851) = lu(k,1851) * lu(k,1848) + lu(k,1852) = lu(k,1852) * lu(k,1848) + lu(k,1853) = lu(k,1853) * lu(k,1848) + lu(k,1854) = lu(k,1854) * lu(k,1848) + lu(k,1855) = lu(k,1855) * lu(k,1848) + lu(k,1856) = lu(k,1856) * lu(k,1848) + lu(k,1857) = lu(k,1857) * lu(k,1848) + lu(k,1952) = lu(k,1952) - lu(k,1849) * lu(k,1951) + lu(k,1953) = lu(k,1953) - lu(k,1850) * lu(k,1951) + lu(k,1954) = lu(k,1954) - lu(k,1851) * lu(k,1951) + lu(k,1955) = lu(k,1955) - lu(k,1852) * lu(k,1951) + lu(k,1956) = lu(k,1956) - lu(k,1853) * lu(k,1951) + lu(k,1957) = lu(k,1957) - lu(k,1854) * lu(k,1951) + lu(k,1958) = lu(k,1958) - lu(k,1855) * lu(k,1951) + lu(k,1959) = lu(k,1959) - lu(k,1856) * lu(k,1951) + lu(k,1960) = lu(k,1960) - lu(k,1857) * lu(k,1951) + lu(k,2004) = lu(k,2004) - lu(k,1849) * lu(k,2003) + lu(k,2005) = lu(k,2005) - lu(k,1850) * lu(k,2003) + lu(k,2006) = lu(k,2006) - lu(k,1851) * lu(k,2003) + lu(k,2007) = lu(k,2007) - lu(k,1852) * lu(k,2003) + lu(k,2008) = lu(k,2008) - lu(k,1853) * lu(k,2003) + lu(k,2009) = lu(k,2009) - lu(k,1854) * lu(k,2003) + lu(k,2010) = lu(k,2010) - lu(k,1855) * lu(k,2003) + lu(k,2011) = lu(k,2011) - lu(k,1856) * lu(k,2003) + lu(k,2012) = lu(k,2012) - lu(k,1857) * lu(k,2003) + lu(k,2027) = lu(k,2027) - lu(k,1849) * lu(k,2026) + lu(k,2028) = lu(k,2028) - lu(k,1850) * lu(k,2026) + lu(k,2029) = lu(k,2029) - lu(k,1851) * lu(k,2026) + lu(k,2030) = lu(k,2030) - lu(k,1852) * lu(k,2026) + lu(k,2031) = lu(k,2031) - lu(k,1853) * lu(k,2026) + lu(k,2032) = lu(k,2032) - lu(k,1854) * lu(k,2026) + lu(k,2033) = lu(k,2033) - lu(k,1855) * lu(k,2026) + lu(k,2034) = lu(k,2034) - lu(k,1856) * lu(k,2026) + lu(k,2035) = lu(k,2035) - lu(k,1857) * lu(k,2026) + lu(k,2086) = lu(k,2086) - lu(k,1849) * lu(k,2085) + lu(k,2087) = lu(k,2087) - lu(k,1850) * lu(k,2085) + lu(k,2088) = lu(k,2088) - lu(k,1851) * lu(k,2085) + lu(k,2089) = lu(k,2089) - lu(k,1852) * lu(k,2085) + lu(k,2090) = lu(k,2090) - lu(k,1853) * lu(k,2085) + lu(k,2091) = lu(k,2091) - lu(k,1854) * lu(k,2085) + lu(k,2092) = lu(k,2092) - lu(k,1855) * lu(k,2085) + lu(k,2093) = lu(k,2093) - lu(k,1856) * lu(k,2085) + lu(k,2094) = lu(k,2094) - lu(k,1857) * lu(k,2085) + lu(k,2125) = lu(k,2125) - lu(k,1849) * lu(k,2124) + lu(k,2126) = lu(k,2126) - lu(k,1850) * lu(k,2124) + lu(k,2127) = lu(k,2127) - lu(k,1851) * lu(k,2124) + lu(k,2128) = lu(k,2128) - lu(k,1852) * lu(k,2124) + lu(k,2129) = lu(k,2129) - lu(k,1853) * lu(k,2124) + lu(k,2130) = lu(k,2130) - lu(k,1854) * lu(k,2124) + lu(k,2131) = lu(k,2131) - lu(k,1855) * lu(k,2124) + lu(k,2132) = lu(k,2132) - lu(k,1856) * lu(k,2124) + lu(k,2133) = lu(k,2133) - lu(k,1857) * lu(k,2124) + lu(k,2187) = lu(k,2187) - lu(k,1849) * lu(k,2186) + lu(k,2188) = lu(k,2188) - lu(k,1850) * lu(k,2186) + lu(k,2189) = lu(k,2189) - lu(k,1851) * lu(k,2186) + lu(k,2190) = lu(k,2190) - lu(k,1852) * lu(k,2186) + lu(k,2191) = lu(k,2191) - lu(k,1853) * lu(k,2186) + lu(k,2192) = lu(k,2192) - lu(k,1854) * lu(k,2186) + lu(k,2193) = lu(k,2193) - lu(k,1855) * lu(k,2186) + lu(k,2194) = lu(k,2194) - lu(k,1856) * lu(k,2186) + lu(k,2195) = lu(k,2195) - lu(k,1857) * lu(k,2186) + lu(k,2305) = lu(k,2305) - lu(k,1849) * lu(k,2304) + lu(k,2306) = lu(k,2306) - lu(k,1850) * lu(k,2304) + lu(k,2307) = lu(k,2307) - lu(k,1851) * lu(k,2304) + lu(k,2308) = lu(k,2308) - lu(k,1852) * lu(k,2304) + lu(k,2309) = lu(k,2309) - lu(k,1853) * lu(k,2304) + lu(k,2310) = lu(k,2310) - lu(k,1854) * lu(k,2304) + lu(k,2311) = lu(k,2311) - lu(k,1855) * lu(k,2304) + lu(k,2312) = lu(k,2312) - lu(k,1856) * lu(k,2304) + lu(k,2313) = lu(k,2313) - lu(k,1857) * lu(k,2304) + lu(k,2331) = lu(k,2331) - lu(k,1849) * lu(k,2330) + lu(k,2332) = lu(k,2332) - lu(k,1850) * lu(k,2330) + lu(k,2333) = lu(k,2333) - lu(k,1851) * lu(k,2330) + lu(k,2334) = lu(k,2334) - lu(k,1852) * lu(k,2330) + lu(k,2335) = lu(k,2335) - lu(k,1853) * lu(k,2330) + lu(k,2336) = lu(k,2336) - lu(k,1854) * lu(k,2330) + lu(k,2337) = lu(k,2337) - lu(k,1855) * lu(k,2330) + lu(k,2338) = lu(k,2338) - lu(k,1856) * lu(k,2330) + lu(k,2339) = lu(k,2339) - lu(k,1857) * lu(k,2330) + lu(k,2357) = lu(k,2357) - lu(k,1849) * lu(k,2356) + lu(k,2358) = lu(k,2358) - lu(k,1850) * lu(k,2356) + lu(k,2359) = lu(k,2359) - lu(k,1851) * lu(k,2356) + lu(k,2360) = lu(k,2360) - lu(k,1852) * lu(k,2356) + lu(k,2361) = lu(k,2361) - lu(k,1853) * lu(k,2356) + lu(k,2362) = lu(k,2362) - lu(k,1854) * lu(k,2356) + lu(k,2363) = lu(k,2363) - lu(k,1855) * lu(k,2356) + lu(k,2364) = lu(k,2364) - lu(k,1856) * lu(k,2356) + lu(k,2365) = lu(k,2365) - lu(k,1857) * lu(k,2356) + lu(k,1952) = 1._r8 / lu(k,1952) + lu(k,1953) = lu(k,1953) * lu(k,1952) + lu(k,1954) = lu(k,1954) * lu(k,1952) + lu(k,1955) = lu(k,1955) * lu(k,1952) + lu(k,1956) = lu(k,1956) * lu(k,1952) + lu(k,1957) = lu(k,1957) * lu(k,1952) + lu(k,1958) = lu(k,1958) * lu(k,1952) + lu(k,1959) = lu(k,1959) * lu(k,1952) + lu(k,1960) = lu(k,1960) * lu(k,1952) + lu(k,2005) = lu(k,2005) - lu(k,1953) * lu(k,2004) + lu(k,2006) = lu(k,2006) - lu(k,1954) * lu(k,2004) + lu(k,2007) = lu(k,2007) - lu(k,1955) * lu(k,2004) + lu(k,2008) = lu(k,2008) - lu(k,1956) * lu(k,2004) + lu(k,2009) = lu(k,2009) - lu(k,1957) * lu(k,2004) + lu(k,2010) = lu(k,2010) - lu(k,1958) * lu(k,2004) + lu(k,2011) = lu(k,2011) - lu(k,1959) * lu(k,2004) + lu(k,2012) = lu(k,2012) - lu(k,1960) * lu(k,2004) + lu(k,2028) = lu(k,2028) - lu(k,1953) * lu(k,2027) + lu(k,2029) = lu(k,2029) - lu(k,1954) * lu(k,2027) + lu(k,2030) = lu(k,2030) - lu(k,1955) * lu(k,2027) + lu(k,2031) = lu(k,2031) - lu(k,1956) * lu(k,2027) + lu(k,2032) = lu(k,2032) - lu(k,1957) * lu(k,2027) + lu(k,2033) = lu(k,2033) - lu(k,1958) * lu(k,2027) + lu(k,2034) = lu(k,2034) - lu(k,1959) * lu(k,2027) + lu(k,2035) = lu(k,2035) - lu(k,1960) * lu(k,2027) + lu(k,2087) = lu(k,2087) - lu(k,1953) * lu(k,2086) + lu(k,2088) = lu(k,2088) - lu(k,1954) * lu(k,2086) + lu(k,2089) = lu(k,2089) - lu(k,1955) * lu(k,2086) + lu(k,2090) = lu(k,2090) - lu(k,1956) * lu(k,2086) + lu(k,2091) = lu(k,2091) - lu(k,1957) * lu(k,2086) + lu(k,2092) = lu(k,2092) - lu(k,1958) * lu(k,2086) + lu(k,2093) = lu(k,2093) - lu(k,1959) * lu(k,2086) + lu(k,2094) = lu(k,2094) - lu(k,1960) * lu(k,2086) + lu(k,2126) = lu(k,2126) - lu(k,1953) * lu(k,2125) + lu(k,2127) = lu(k,2127) - lu(k,1954) * lu(k,2125) + lu(k,2128) = lu(k,2128) - lu(k,1955) * lu(k,2125) + lu(k,2129) = lu(k,2129) - lu(k,1956) * lu(k,2125) + lu(k,2130) = lu(k,2130) - lu(k,1957) * lu(k,2125) + lu(k,2131) = lu(k,2131) - lu(k,1958) * lu(k,2125) + lu(k,2132) = lu(k,2132) - lu(k,1959) * lu(k,2125) + lu(k,2133) = lu(k,2133) - lu(k,1960) * lu(k,2125) + lu(k,2188) = lu(k,2188) - lu(k,1953) * lu(k,2187) + lu(k,2189) = lu(k,2189) - lu(k,1954) * lu(k,2187) + lu(k,2190) = lu(k,2190) - lu(k,1955) * lu(k,2187) + lu(k,2191) = lu(k,2191) - lu(k,1956) * lu(k,2187) + lu(k,2192) = lu(k,2192) - lu(k,1957) * lu(k,2187) + lu(k,2193) = lu(k,2193) - lu(k,1958) * lu(k,2187) + lu(k,2194) = lu(k,2194) - lu(k,1959) * lu(k,2187) + lu(k,2195) = lu(k,2195) - lu(k,1960) * lu(k,2187) + lu(k,2306) = lu(k,2306) - lu(k,1953) * lu(k,2305) + lu(k,2307) = lu(k,2307) - lu(k,1954) * lu(k,2305) + lu(k,2308) = lu(k,2308) - lu(k,1955) * lu(k,2305) + lu(k,2309) = lu(k,2309) - lu(k,1956) * lu(k,2305) + lu(k,2310) = lu(k,2310) - lu(k,1957) * lu(k,2305) + lu(k,2311) = lu(k,2311) - lu(k,1958) * lu(k,2305) + lu(k,2312) = lu(k,2312) - lu(k,1959) * lu(k,2305) + lu(k,2313) = lu(k,2313) - lu(k,1960) * lu(k,2305) + lu(k,2332) = lu(k,2332) - lu(k,1953) * lu(k,2331) + lu(k,2333) = lu(k,2333) - lu(k,1954) * lu(k,2331) + lu(k,2334) = lu(k,2334) - lu(k,1955) * lu(k,2331) + lu(k,2335) = lu(k,2335) - lu(k,1956) * lu(k,2331) + lu(k,2336) = lu(k,2336) - lu(k,1957) * lu(k,2331) + lu(k,2337) = lu(k,2337) - lu(k,1958) * lu(k,2331) + lu(k,2338) = lu(k,2338) - lu(k,1959) * lu(k,2331) + lu(k,2339) = lu(k,2339) - lu(k,1960) * lu(k,2331) + lu(k,2358) = lu(k,2358) - lu(k,1953) * lu(k,2357) + lu(k,2359) = lu(k,2359) - lu(k,1954) * lu(k,2357) + lu(k,2360) = lu(k,2360) - lu(k,1955) * lu(k,2357) + lu(k,2361) = lu(k,2361) - lu(k,1956) * lu(k,2357) + lu(k,2362) = lu(k,2362) - lu(k,1957) * lu(k,2357) + lu(k,2363) = lu(k,2363) - lu(k,1958) * lu(k,2357) + lu(k,2364) = lu(k,2364) - lu(k,1959) * lu(k,2357) + lu(k,2365) = lu(k,2365) - lu(k,1960) * lu(k,2357) + lu(k,2005) = 1._r8 / lu(k,2005) + lu(k,2006) = lu(k,2006) * lu(k,2005) + lu(k,2007) = lu(k,2007) * lu(k,2005) + lu(k,2008) = lu(k,2008) * lu(k,2005) + lu(k,2009) = lu(k,2009) * lu(k,2005) + lu(k,2010) = lu(k,2010) * lu(k,2005) + lu(k,2011) = lu(k,2011) * lu(k,2005) + lu(k,2012) = lu(k,2012) * lu(k,2005) + lu(k,2029) = lu(k,2029) - lu(k,2006) * lu(k,2028) + lu(k,2030) = lu(k,2030) - lu(k,2007) * lu(k,2028) + lu(k,2031) = lu(k,2031) - lu(k,2008) * lu(k,2028) + lu(k,2032) = lu(k,2032) - lu(k,2009) * lu(k,2028) + lu(k,2033) = lu(k,2033) - lu(k,2010) * lu(k,2028) + lu(k,2034) = lu(k,2034) - lu(k,2011) * lu(k,2028) + lu(k,2035) = lu(k,2035) - lu(k,2012) * lu(k,2028) + lu(k,2088) = lu(k,2088) - lu(k,2006) * lu(k,2087) + lu(k,2089) = lu(k,2089) - lu(k,2007) * lu(k,2087) + lu(k,2090) = lu(k,2090) - lu(k,2008) * lu(k,2087) + lu(k,2091) = lu(k,2091) - lu(k,2009) * lu(k,2087) + lu(k,2092) = lu(k,2092) - lu(k,2010) * lu(k,2087) + lu(k,2093) = lu(k,2093) - lu(k,2011) * lu(k,2087) + lu(k,2094) = lu(k,2094) - lu(k,2012) * lu(k,2087) + lu(k,2127) = lu(k,2127) - lu(k,2006) * lu(k,2126) + lu(k,2128) = lu(k,2128) - lu(k,2007) * lu(k,2126) + lu(k,2129) = lu(k,2129) - lu(k,2008) * lu(k,2126) + lu(k,2130) = lu(k,2130) - lu(k,2009) * lu(k,2126) + lu(k,2131) = lu(k,2131) - lu(k,2010) * lu(k,2126) + lu(k,2132) = lu(k,2132) - lu(k,2011) * lu(k,2126) + lu(k,2133) = lu(k,2133) - lu(k,2012) * lu(k,2126) + lu(k,2189) = lu(k,2189) - lu(k,2006) * lu(k,2188) + lu(k,2190) = lu(k,2190) - lu(k,2007) * lu(k,2188) + lu(k,2191) = lu(k,2191) - lu(k,2008) * lu(k,2188) + lu(k,2192) = lu(k,2192) - lu(k,2009) * lu(k,2188) + lu(k,2193) = lu(k,2193) - lu(k,2010) * lu(k,2188) + lu(k,2194) = lu(k,2194) - lu(k,2011) * lu(k,2188) + lu(k,2195) = lu(k,2195) - lu(k,2012) * lu(k,2188) + lu(k,2307) = lu(k,2307) - lu(k,2006) * lu(k,2306) + lu(k,2308) = lu(k,2308) - lu(k,2007) * lu(k,2306) + lu(k,2309) = lu(k,2309) - lu(k,2008) * lu(k,2306) + lu(k,2310) = lu(k,2310) - lu(k,2009) * lu(k,2306) + lu(k,2311) = lu(k,2311) - lu(k,2010) * lu(k,2306) + lu(k,2312) = lu(k,2312) - lu(k,2011) * lu(k,2306) + lu(k,2313) = lu(k,2313) - lu(k,2012) * lu(k,2306) + lu(k,2333) = lu(k,2333) - lu(k,2006) * lu(k,2332) + lu(k,2334) = lu(k,2334) - lu(k,2007) * lu(k,2332) + lu(k,2335) = lu(k,2335) - lu(k,2008) * lu(k,2332) + lu(k,2336) = lu(k,2336) - lu(k,2009) * lu(k,2332) + lu(k,2337) = lu(k,2337) - lu(k,2010) * lu(k,2332) + lu(k,2338) = lu(k,2338) - lu(k,2011) * lu(k,2332) + lu(k,2339) = lu(k,2339) - lu(k,2012) * lu(k,2332) + lu(k,2359) = lu(k,2359) - lu(k,2006) * lu(k,2358) + lu(k,2360) = lu(k,2360) - lu(k,2007) * lu(k,2358) + lu(k,2361) = lu(k,2361) - lu(k,2008) * lu(k,2358) + lu(k,2362) = lu(k,2362) - lu(k,2009) * lu(k,2358) + lu(k,2363) = lu(k,2363) - lu(k,2010) * lu(k,2358) + lu(k,2364) = lu(k,2364) - lu(k,2011) * lu(k,2358) + lu(k,2365) = lu(k,2365) - lu(k,2012) * lu(k,2358) + lu(k,2029) = 1._r8 / lu(k,2029) + lu(k,2030) = lu(k,2030) * lu(k,2029) + lu(k,2031) = lu(k,2031) * lu(k,2029) + lu(k,2032) = lu(k,2032) * lu(k,2029) + lu(k,2033) = lu(k,2033) * lu(k,2029) + lu(k,2034) = lu(k,2034) * lu(k,2029) + lu(k,2035) = lu(k,2035) * lu(k,2029) + lu(k,2089) = lu(k,2089) - lu(k,2030) * lu(k,2088) + lu(k,2090) = lu(k,2090) - lu(k,2031) * lu(k,2088) + lu(k,2091) = lu(k,2091) - lu(k,2032) * lu(k,2088) + lu(k,2092) = lu(k,2092) - lu(k,2033) * lu(k,2088) + lu(k,2093) = lu(k,2093) - lu(k,2034) * lu(k,2088) + lu(k,2094) = lu(k,2094) - lu(k,2035) * lu(k,2088) + lu(k,2128) = lu(k,2128) - lu(k,2030) * lu(k,2127) + lu(k,2129) = lu(k,2129) - lu(k,2031) * lu(k,2127) + lu(k,2130) = lu(k,2130) - lu(k,2032) * lu(k,2127) + lu(k,2131) = lu(k,2131) - lu(k,2033) * lu(k,2127) + lu(k,2132) = lu(k,2132) - lu(k,2034) * lu(k,2127) + lu(k,2133) = lu(k,2133) - lu(k,2035) * lu(k,2127) + lu(k,2190) = lu(k,2190) - lu(k,2030) * lu(k,2189) + lu(k,2191) = lu(k,2191) - lu(k,2031) * lu(k,2189) + lu(k,2192) = lu(k,2192) - lu(k,2032) * lu(k,2189) + lu(k,2193) = lu(k,2193) - lu(k,2033) * lu(k,2189) + lu(k,2194) = lu(k,2194) - lu(k,2034) * lu(k,2189) + lu(k,2195) = lu(k,2195) - lu(k,2035) * lu(k,2189) + lu(k,2308) = lu(k,2308) - lu(k,2030) * lu(k,2307) + lu(k,2309) = lu(k,2309) - lu(k,2031) * lu(k,2307) + lu(k,2310) = lu(k,2310) - lu(k,2032) * lu(k,2307) + lu(k,2311) = lu(k,2311) - lu(k,2033) * lu(k,2307) + lu(k,2312) = lu(k,2312) - lu(k,2034) * lu(k,2307) + lu(k,2313) = lu(k,2313) - lu(k,2035) * lu(k,2307) + lu(k,2334) = lu(k,2334) - lu(k,2030) * lu(k,2333) + lu(k,2335) = lu(k,2335) - lu(k,2031) * lu(k,2333) + lu(k,2336) = lu(k,2336) - lu(k,2032) * lu(k,2333) + lu(k,2337) = lu(k,2337) - lu(k,2033) * lu(k,2333) + lu(k,2338) = lu(k,2338) - lu(k,2034) * lu(k,2333) + lu(k,2339) = lu(k,2339) - lu(k,2035) * lu(k,2333) + lu(k,2360) = lu(k,2360) - lu(k,2030) * lu(k,2359) + lu(k,2361) = lu(k,2361) - lu(k,2031) * lu(k,2359) + lu(k,2362) = lu(k,2362) - lu(k,2032) * lu(k,2359) + lu(k,2363) = lu(k,2363) - lu(k,2033) * lu(k,2359) + lu(k,2364) = lu(k,2364) - lu(k,2034) * lu(k,2359) + lu(k,2365) = lu(k,2365) - lu(k,2035) * lu(k,2359) + end do + end subroutine lu_fac30 + subroutine lu_fac31( 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,2089) = 1._r8 / lu(k,2089) + lu(k,2090) = lu(k,2090) * lu(k,2089) + lu(k,2091) = lu(k,2091) * lu(k,2089) + lu(k,2092) = lu(k,2092) * lu(k,2089) + lu(k,2093) = lu(k,2093) * lu(k,2089) + lu(k,2094) = lu(k,2094) * lu(k,2089) + lu(k,2129) = lu(k,2129) - lu(k,2090) * lu(k,2128) + lu(k,2130) = lu(k,2130) - lu(k,2091) * lu(k,2128) + lu(k,2131) = lu(k,2131) - lu(k,2092) * lu(k,2128) + lu(k,2132) = lu(k,2132) - lu(k,2093) * lu(k,2128) + lu(k,2133) = lu(k,2133) - lu(k,2094) * lu(k,2128) + lu(k,2191) = lu(k,2191) - lu(k,2090) * lu(k,2190) + lu(k,2192) = lu(k,2192) - lu(k,2091) * lu(k,2190) + lu(k,2193) = lu(k,2193) - lu(k,2092) * lu(k,2190) + lu(k,2194) = lu(k,2194) - lu(k,2093) * lu(k,2190) + lu(k,2195) = lu(k,2195) - lu(k,2094) * lu(k,2190) + lu(k,2309) = lu(k,2309) - lu(k,2090) * lu(k,2308) + lu(k,2310) = lu(k,2310) - lu(k,2091) * lu(k,2308) + lu(k,2311) = lu(k,2311) - lu(k,2092) * lu(k,2308) + lu(k,2312) = lu(k,2312) - lu(k,2093) * lu(k,2308) + lu(k,2313) = lu(k,2313) - lu(k,2094) * lu(k,2308) + lu(k,2335) = lu(k,2335) - lu(k,2090) * lu(k,2334) + lu(k,2336) = lu(k,2336) - lu(k,2091) * lu(k,2334) + lu(k,2337) = lu(k,2337) - lu(k,2092) * lu(k,2334) + lu(k,2338) = lu(k,2338) - lu(k,2093) * lu(k,2334) + lu(k,2339) = lu(k,2339) - lu(k,2094) * lu(k,2334) + lu(k,2361) = lu(k,2361) - lu(k,2090) * lu(k,2360) + lu(k,2362) = lu(k,2362) - lu(k,2091) * lu(k,2360) + lu(k,2363) = lu(k,2363) - lu(k,2092) * lu(k,2360) + lu(k,2364) = lu(k,2364) - lu(k,2093) * lu(k,2360) + lu(k,2365) = lu(k,2365) - lu(k,2094) * lu(k,2360) + lu(k,2129) = 1._r8 / lu(k,2129) + lu(k,2130) = lu(k,2130) * lu(k,2129) + lu(k,2131) = lu(k,2131) * lu(k,2129) + lu(k,2132) = lu(k,2132) * lu(k,2129) + lu(k,2133) = lu(k,2133) * lu(k,2129) + lu(k,2192) = lu(k,2192) - lu(k,2130) * lu(k,2191) + lu(k,2193) = lu(k,2193) - lu(k,2131) * lu(k,2191) + lu(k,2194) = lu(k,2194) - lu(k,2132) * lu(k,2191) + lu(k,2195) = lu(k,2195) - lu(k,2133) * lu(k,2191) + lu(k,2310) = lu(k,2310) - lu(k,2130) * lu(k,2309) + lu(k,2311) = lu(k,2311) - lu(k,2131) * lu(k,2309) + lu(k,2312) = lu(k,2312) - lu(k,2132) * lu(k,2309) + lu(k,2313) = lu(k,2313) - lu(k,2133) * lu(k,2309) + lu(k,2336) = lu(k,2336) - lu(k,2130) * lu(k,2335) + lu(k,2337) = lu(k,2337) - lu(k,2131) * lu(k,2335) + lu(k,2338) = lu(k,2338) - lu(k,2132) * lu(k,2335) + lu(k,2339) = lu(k,2339) - lu(k,2133) * lu(k,2335) + lu(k,2362) = lu(k,2362) - lu(k,2130) * lu(k,2361) + lu(k,2363) = lu(k,2363) - lu(k,2131) * lu(k,2361) + lu(k,2364) = lu(k,2364) - lu(k,2132) * lu(k,2361) + lu(k,2365) = lu(k,2365) - lu(k,2133) * lu(k,2361) + lu(k,2192) = 1._r8 / lu(k,2192) + lu(k,2193) = lu(k,2193) * lu(k,2192) + lu(k,2194) = lu(k,2194) * lu(k,2192) + lu(k,2195) = lu(k,2195) * lu(k,2192) + lu(k,2311) = lu(k,2311) - lu(k,2193) * lu(k,2310) + lu(k,2312) = lu(k,2312) - lu(k,2194) * lu(k,2310) + lu(k,2313) = lu(k,2313) - lu(k,2195) * lu(k,2310) + lu(k,2337) = lu(k,2337) - lu(k,2193) * lu(k,2336) + lu(k,2338) = lu(k,2338) - lu(k,2194) * lu(k,2336) + lu(k,2339) = lu(k,2339) - lu(k,2195) * lu(k,2336) + lu(k,2363) = lu(k,2363) - lu(k,2193) * lu(k,2362) + lu(k,2364) = lu(k,2364) - lu(k,2194) * lu(k,2362) + lu(k,2365) = lu(k,2365) - lu(k,2195) * lu(k,2362) + lu(k,2311) = 1._r8 / lu(k,2311) + lu(k,2312) = lu(k,2312) * lu(k,2311) + lu(k,2313) = lu(k,2313) * lu(k,2311) + lu(k,2338) = lu(k,2338) - lu(k,2312) * lu(k,2337) + lu(k,2339) = lu(k,2339) - lu(k,2313) * lu(k,2337) + lu(k,2364) = lu(k,2364) - lu(k,2312) * lu(k,2363) + lu(k,2365) = lu(k,2365) - lu(k,2313) * lu(k,2363) + lu(k,2338) = 1._r8 / lu(k,2338) + lu(k,2339) = lu(k,2339) * lu(k,2338) + lu(k,2365) = lu(k,2365) - lu(k,2339) * lu(k,2364) + lu(k,2365) = 1._r8 / lu(k,2365) + end do + end subroutine lu_fac31 + 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 ) + call lu_fac19( avec_len, lu ) + call lu_fac20( avec_len, lu ) + call lu_fac21( avec_len, lu ) + call lu_fac22( avec_len, lu ) + call lu_fac23( avec_len, lu ) + call lu_fac24( avec_len, lu ) + call lu_fac25( avec_len, lu ) + call lu_fac26( avec_len, lu ) + call lu_fac27( avec_len, lu ) + call lu_fac28( avec_len, lu ) + call lu_fac29( avec_len, lu ) + call lu_fac30( avec_len, lu ) + call lu_fac31( avec_len, lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_trop_strat_mam5_vbsext/mo_lu_solve.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_lu_solve.F90 new file mode 100644 index 0000000000..1eb5df2f6b --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_lu_solve.F90 @@ -0,0 +1,2637 @@ + 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,251) = b(k,251) - lu(k,139) * b(k,86) + b(k,261) = b(k,261) - lu(k,140) * b(k,86) + b(k,250) = b(k,250) - lu(k,142) * b(k,87) + b(k,257) = b(k,257) - lu(k,143) * b(k,87) + b(k,251) = b(k,251) - lu(k,145) * b(k,88) + b(k,259) = b(k,259) - lu(k,146) * b(k,88) + b(k,257) = b(k,257) - lu(k,148) * b(k,89) + b(k,260) = b(k,260) - lu(k,149) * b(k,89) + b(k,121) = b(k,121) - lu(k,151) * b(k,90) + b(k,243) = b(k,243) - lu(k,152) * b(k,90) + b(k,250) = b(k,250) - lu(k,153) * b(k,90) + b(k,201) = b(k,201) - lu(k,155) * b(k,91) + b(k,251) = b(k,251) - lu(k,156) * b(k,91) + b(k,261) = b(k,261) - lu(k,157) * b(k,91) + b(k,123) = b(k,123) - lu(k,159) * b(k,92) + b(k,250) = b(k,250) - lu(k,160) * b(k,92) + b(k,257) = b(k,257) - lu(k,161) * b(k,92) + b(k,121) = b(k,121) - lu(k,163) * b(k,93) + b(k,250) = b(k,250) - lu(k,164) * b(k,93) + b(k,257) = b(k,257) - lu(k,165) * b(k,93) + b(k,121) = b(k,121) - lu(k,167) * b(k,94) + b(k,250) = b(k,250) - lu(k,168) * b(k,94) + b(k,257) = b(k,257) - lu(k,169) * b(k,94) + b(k,251) = b(k,251) - lu(k,171) * b(k,95) + b(k,257) = b(k,257) - lu(k,172) * b(k,95) + b(k,261) = b(k,261) - lu(k,173) * b(k,95) + b(k,231) = b(k,231) - lu(k,175) * b(k,96) + b(k,251) = b(k,251) - lu(k,176) * b(k,96) + b(k,170) = b(k,170) - lu(k,178) * b(k,97) + b(k,248) = b(k,248) - lu(k,179) * b(k,97) + b(k,121) = b(k,121) - lu(k,181) * b(k,98) + b(k,243) = b(k,243) - lu(k,182) * b(k,98) + b(k,250) = b(k,250) - lu(k,183) * b(k,98) + b(k,257) = b(k,257) - lu(k,184) * b(k,98) + b(k,121) = b(k,121) - lu(k,186) * b(k,99) + b(k,209) = b(k,209) - lu(k,187) * b(k,99) + b(k,243) = b(k,243) - lu(k,188) * b(k,99) + b(k,250) = b(k,250) - lu(k,189) * b(k,99) + b(k,121) = b(k,121) - lu(k,191) * b(k,100) + b(k,123) = b(k,123) - lu(k,192) * b(k,100) + b(k,250) = b(k,250) - lu(k,193) * b(k,100) + b(k,257) = b(k,257) - lu(k,194) * b(k,100) + b(k,121) = b(k,121) - lu(k,196) * b(k,101) + b(k,209) = b(k,209) - lu(k,197) * b(k,101) + b(k,250) = b(k,250) - lu(k,198) * b(k,101) + b(k,257) = b(k,257) - lu(k,199) * b(k,101) + b(k,128) = b(k,128) - lu(k,201) * b(k,102) + b(k,251) = b(k,251) - lu(k,202) * b(k,102) + b(k,125) = b(k,125) - lu(k,204) * b(k,103) + b(k,261) = b(k,261) - lu(k,205) * b(k,103) + b(k,105) = b(k,105) - lu(k,208) * b(k,104) + b(k,106) = b(k,106) - lu(k,209) * b(k,104) + b(k,166) = b(k,166) - lu(k,210) * b(k,104) + b(k,251) = b(k,251) - lu(k,211) * b(k,104) + b(k,259) = b(k,259) - lu(k,212) * b(k,104) + b(k,161) = b(k,161) - lu(k,214) * b(k,105) + b(k,225) = b(k,225) - lu(k,215) * b(k,105) + b(k,259) = b(k,259) - lu(k,216) * b(k,105) + b(k,160) = b(k,160) - lu(k,218) * b(k,106) + b(k,164) = b(k,164) - lu(k,219) * b(k,106) + b(k,251) = b(k,251) - lu(k,220) * b(k,106) + b(k,259) = b(k,259) - lu(k,221) * b(k,106) + b(k,257) = b(k,257) - lu(k,223) * b(k,107) + b(k,250) = b(k,250) - lu(k,225) * b(k,108) + b(k,253) = b(k,253) - lu(k,226) * b(k,108) + b(k,250) = b(k,250) - lu(k,228) * b(k,109) + b(k,251) = b(k,251) - lu(k,229) * b(k,109) + b(k,259) = b(k,259) - lu(k,230) * b(k,109) + b(k,111) = b(k,111) - lu(k,233) * b(k,110) + b(k,112) = b(k,112) - lu(k,234) * b(k,110) + b(k,158) = b(k,158) - lu(k,235) * b(k,110) + b(k,194) = b(k,194) - lu(k,236) * b(k,110) + b(k,251) = b(k,251) - lu(k,237) * b(k,110) + b(k,259) = b(k,259) - lu(k,238) * b(k,110) + b(k,160) = b(k,160) - lu(k,240) * b(k,111) + b(k,164) = b(k,164) - lu(k,241) * b(k,111) + b(k,251) = b(k,251) - lu(k,242) * b(k,111) + b(k,259) = b(k,259) - lu(k,243) * b(k,111) + b(k,225) = b(k,225) - lu(k,245) * b(k,112) + b(k,241) = b(k,241) - lu(k,246) * b(k,112) + b(k,259) = b(k,259) - lu(k,247) * b(k,112) + b(k,231) = b(k,231) - lu(k,249) * b(k,113) + b(k,251) = b(k,251) - lu(k,250) * b(k,113) + b(k,115) = b(k,115) - lu(k,254) * b(k,114) + b(k,158) = b(k,158) - lu(k,255) * b(k,114) + b(k,196) = b(k,196) - lu(k,256) * b(k,114) + b(k,225) = b(k,225) - lu(k,257) * b(k,114) + b(k,241) = b(k,241) - lu(k,258) * b(k,114) + b(k,251) = b(k,251) - lu(k,259) * b(k,114) + b(k,259) = b(k,259) - lu(k,260) * b(k,114) + b(k,164) = b(k,164) - lu(k,262) * b(k,115) + b(k,167) = b(k,167) - lu(k,263) * b(k,115) + b(k,251) = b(k,251) - lu(k,264) * b(k,115) + b(k,259) = b(k,259) - lu(k,265) * b(k,115) + b(k,212) = b(k,212) - lu(k,267) * b(k,116) + b(k,251) = b(k,251) - lu(k,268) * b(k,116) + b(k,245) = b(k,245) - lu(k,270) * b(k,117) + b(k,248) = b(k,248) - lu(k,271) * b(k,117) + b(k,243) = b(k,243) - lu(k,273) * b(k,118) + b(k,257) = b(k,257) - lu(k,274) * b(k,118) + b(k,170) = b(k,170) - lu(k,276) * b(k,119) + b(k,251) = b(k,251) - lu(k,277) * b(k,119) + b(k,180) = b(k,180) - lu(k,279) * b(k,120) + b(k,231) = b(k,231) - lu(k,280) * b(k,120) + b(k,251) = b(k,251) - lu(k,281) * b(k,120) + b(k,259) = b(k,259) - lu(k,282) * b(k,120) + b(k,209) = b(k,209) - lu(k,284) * b(k,121) + b(k,250) = b(k,250) - lu(k,285) * b(k,121) + b(k,123) = b(k,123) - lu(k,287) * b(k,122) + b(k,250) = b(k,250) - lu(k,288) * b(k,122) + b(k,251) = b(k,251) - lu(k,289) * b(k,122) + b(k,257) = b(k,257) - lu(k,290) * b(k,122) + b(k,209) = b(k,209) - lu(k,292) * b(k,123) + b(k,250) = b(k,250) - lu(k,293) * b(k,123) + b(k,257) = b(k,257) - lu(k,294) * b(k,123) + b(k,209) = b(k,209) - lu(k,297) * b(k,124) + b(k,250) = b(k,250) - lu(k,298) * b(k,124) + b(k,251) = b(k,251) - lu(k,299) * b(k,124) + b(k,257) = b(k,257) - lu(k,300) * b(k,124) + b(k,208) = b(k,208) - lu(k,303) * b(k,125) + b(k,249) = b(k,249) - lu(k,304) * b(k,125) + b(k,261) = b(k,261) - lu(k,305) * b(k,125) + b(k,221) = b(k,221) - lu(k,307) * b(k,126) + b(k,251) = b(k,251) - lu(k,308) * b(k,126) + b(k,259) = b(k,259) - lu(k,309) * b(k,126) + b(k,164) = b(k,164) - lu(k,311) * b(k,127) + b(k,184) = b(k,184) - lu(k,312) * b(k,127) + b(k,251) = b(k,251) - lu(k,313) * b(k,127) + b(k,222) = b(k,222) - lu(k,315) * b(k,128) + b(k,247) = b(k,247) - lu(k,316) * b(k,128) + b(k,259) = b(k,259) - lu(k,317) * b(k,128) + b(k,197) = b(k,197) - lu(k,319) * b(k,129) + b(k,259) = b(k,259) - lu(k,320) * b(k,129) + b(k,215) = b(k,215) - lu(k,322) * b(k,130) + b(k,216) = b(k,216) - lu(k,323) * b(k,130) + b(k,225) = b(k,225) - lu(k,324) * b(k,130) + b(k,251) = b(k,251) - lu(k,325) * b(k,130) + b(k,259) = b(k,259) - lu(k,326) * b(k,130) + b(k,204) = b(k,204) - lu(k,328) * b(k,131) + b(k,251) = b(k,251) - lu(k,329) * b(k,131) + b(k,255) = b(k,255) - lu(k,330) * b(k,131) + b(k,257) = b(k,257) - lu(k,331) * b(k,131) + b(k,261) = b(k,261) - lu(k,332) * b(k,131) + b(k,209) = b(k,209) - lu(k,335) * b(k,132) + b(k,250) = b(k,250) - lu(k,336) * b(k,132) + b(k,251) = b(k,251) - lu(k,337) * b(k,132) + b(k,257) = b(k,257) - lu(k,338) * b(k,132) + b(k,261) = b(k,261) - lu(k,339) * b(k,132) + b(k,209) = b(k,209) - lu(k,341) * b(k,133) + b(k,246) = b(k,246) - lu(k,342) * b(k,133) + b(k,245) = b(k,245) - lu(k,344) * b(k,134) + b(k,248) = b(k,248) - lu(k,345) * b(k,134) + b(k,249) = b(k,249) - lu(k,346) * b(k,134) + b(k,253) = b(k,253) - lu(k,347) * b(k,134) + b(k,256) = b(k,256) - lu(k,348) * b(k,134) + b(k,208) = b(k,208) - lu(k,350) * b(k,135) + b(k,245) = b(k,245) - lu(k,351) * b(k,135) + b(k,251) = b(k,251) - lu(k,352) * b(k,135) + b(k,256) = b(k,256) - lu(k,353) * b(k,135) + b(k,259) = b(k,259) - lu(k,354) * b(k,135) + b(k,225) = b(k,225) - lu(k,356) * b(k,136) + b(k,234) = b(k,234) - lu(k,357) * b(k,136) + b(k,241) = b(k,241) - lu(k,358) * b(k,136) + b(k,259) = b(k,259) - lu(k,359) * b(k,136) + b(k,208) = b(k,208) - lu(k,361) * b(k,137) + b(k,235) = b(k,235) - lu(k,362) * b(k,137) + b(k,249) = b(k,249) - lu(k,363) * b(k,137) + b(k,260) = b(k,260) - lu(k,364) * b(k,137) + b(k,160) = b(k,160) - lu(k,366) * b(k,138) + b(k,216) = b(k,216) - lu(k,367) * b(k,138) + b(k,251) = b(k,251) - lu(k,368) * b(k,138) + b(k,259) = b(k,259) - lu(k,369) * b(k,138) + b(k,158) = b(k,158) - lu(k,372) * b(k,139) + b(k,170) = b(k,170) - lu(k,373) * b(k,139) + b(k,251) = b(k,251) - lu(k,374) * b(k,139) + b(k,259) = b(k,259) - lu(k,375) * b(k,139) + b(k,204) = b(k,204) - lu(k,377) * b(k,140) + b(k,221) = b(k,221) - lu(k,378) * b(k,140) + b(k,251) = b(k,251) - lu(k,379) * b(k,140) + b(k,259) = b(k,259) - lu(k,380) * b(k,140) + b(k,231) = b(k,231) - lu(k,382) * b(k,141) + b(k,251) = b(k,251) - lu(k,383) * b(k,141) + b(k,238) = b(k,238) - lu(k,385) * b(k,142) + b(k,240) = b(k,240) - lu(k,386) * b(k,142) + b(k,251) = b(k,251) - lu(k,387) * b(k,142) + b(k,259) = b(k,259) - lu(k,388) * b(k,142) + b(k,187) = b(k,187) - lu(k,390) * b(k,143) + b(k,221) = b(k,221) - lu(k,391) * b(k,143) + b(k,241) = b(k,241) - lu(k,392) * b(k,143) + b(k,251) = b(k,251) - lu(k,393) * b(k,143) + b(k,176) = b(k,176) - lu(k,395) * b(k,144) + b(k,214) = b(k,214) - lu(k,396) * b(k,144) + b(k,221) = b(k,221) - lu(k,397) * b(k,144) + b(k,247) = b(k,247) - lu(k,398) * b(k,144) + b(k,248) = b(k,248) - lu(k,399) * b(k,144) + b(k,251) = b(k,251) - lu(k,400) * b(k,144) + b(k,256) = b(k,256) - lu(k,401) * b(k,144) + b(k,225) = b(k,225) - lu(k,403) * b(k,145) + b(k,251) = b(k,251) - lu(k,404) * b(k,145) + b(k,254) = b(k,254) - lu(k,405) * b(k,145) + b(k,255) = b(k,255) - lu(k,406) * b(k,145) + b(k,257) = b(k,257) - lu(k,407) * b(k,145) + b(k,259) = b(k,259) - lu(k,408) * b(k,145) + b(k,261) = b(k,261) - lu(k,409) * b(k,145) + 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,169) = b(k,169) - lu(k,411) * b(k,146) + b(k,208) = b(k,208) - lu(k,412) * b(k,146) + b(k,225) = b(k,225) - lu(k,413) * b(k,146) + b(k,235) = b(k,235) - lu(k,414) * b(k,146) + b(k,246) = b(k,246) - lu(k,415) * b(k,146) + b(k,249) = b(k,249) - lu(k,416) * b(k,146) + b(k,251) = b(k,251) - lu(k,417) * b(k,146) + b(k,230) = b(k,230) - lu(k,419) * b(k,147) + b(k,241) = b(k,241) - lu(k,420) * b(k,147) + b(k,247) = b(k,247) - lu(k,421) * b(k,147) + b(k,251) = b(k,251) - lu(k,422) * b(k,147) + b(k,261) = b(k,261) - lu(k,423) * b(k,147) + b(k,195) = b(k,195) - lu(k,425) * b(k,148) + b(k,207) = b(k,207) - lu(k,426) * b(k,148) + b(k,248) = b(k,248) - lu(k,427) * b(k,148) + b(k,251) = b(k,251) - lu(k,428) * b(k,148) + b(k,259) = b(k,259) - lu(k,429) * b(k,148) + b(k,216) = b(k,216) - lu(k,431) * b(k,149) + b(k,225) = b(k,225) - lu(k,432) * b(k,149) + b(k,234) = b(k,234) - lu(k,433) * b(k,149) + b(k,241) = b(k,241) - lu(k,434) * b(k,149) + b(k,259) = b(k,259) - lu(k,435) * b(k,149) + b(k,201) = b(k,201) - lu(k,437) * b(k,150) + b(k,214) = b(k,214) - lu(k,438) * b(k,150) + b(k,251) = b(k,251) - lu(k,439) * b(k,150) + b(k,259) = b(k,259) - lu(k,440) * b(k,150) + b(k,261) = b(k,261) - lu(k,441) * b(k,150) + b(k,248) = b(k,248) - lu(k,443) * b(k,151) + b(k,251) = b(k,251) - lu(k,444) * b(k,151) + b(k,256) = b(k,256) - lu(k,445) * b(k,151) + b(k,259) = b(k,259) - lu(k,446) * b(k,151) + b(k,261) = b(k,261) - lu(k,447) * b(k,151) + b(k,218) = b(k,218) - lu(k,449) * b(k,152) + b(k,223) = b(k,223) - lu(k,450) * b(k,152) + b(k,245) = b(k,245) - lu(k,451) * b(k,152) + b(k,248) = b(k,248) - lu(k,452) * b(k,152) + b(k,251) = b(k,251) - lu(k,453) * b(k,152) + b(k,246) = b(k,246) - lu(k,455) * b(k,153) + b(k,247) = b(k,247) - lu(k,456) * b(k,153) + b(k,251) = b(k,251) - lu(k,457) * b(k,153) + b(k,254) = b(k,254) - lu(k,458) * b(k,153) + b(k,261) = b(k,261) - lu(k,459) * b(k,153) + b(k,243) = b(k,243) - lu(k,461) * b(k,154) + b(k,250) = b(k,250) - lu(k,462) * b(k,154) + b(k,251) = b(k,251) - lu(k,463) * b(k,154) + b(k,255) = b(k,255) - lu(k,464) * b(k,154) + b(k,257) = b(k,257) - lu(k,465) * b(k,154) + b(k,207) = b(k,207) - lu(k,467) * b(k,155) + b(k,222) = b(k,222) - lu(k,468) * b(k,155) + b(k,245) = b(k,245) - lu(k,469) * b(k,155) + b(k,251) = b(k,251) - lu(k,470) * b(k,155) + b(k,259) = b(k,259) - lu(k,471) * b(k,155) + b(k,161) = b(k,161) - lu(k,473) * b(k,156) + b(k,166) = b(k,166) - lu(k,474) * b(k,156) + b(k,216) = b(k,216) - lu(k,475) * b(k,156) + b(k,251) = b(k,251) - lu(k,476) * b(k,156) + b(k,259) = b(k,259) - lu(k,477) * b(k,156) + b(k,167) = b(k,167) - lu(k,479) * b(k,157) + b(k,216) = b(k,216) - lu(k,480) * b(k,157) + b(k,234) = b(k,234) - lu(k,481) * b(k,157) + b(k,251) = b(k,251) - lu(k,482) * b(k,157) + b(k,259) = b(k,259) - lu(k,483) * b(k,157) + b(k,170) = b(k,170) - lu(k,487) * b(k,158) + b(k,248) = b(k,248) - lu(k,488) * b(k,158) + b(k,251) = b(k,251) - lu(k,489) * b(k,158) + b(k,253) = b(k,253) - lu(k,490) * b(k,158) + b(k,259) = b(k,259) - lu(k,491) * b(k,158) + b(k,215) = b(k,215) - lu(k,493) * b(k,159) + b(k,247) = b(k,247) - lu(k,494) * b(k,159) + b(k,248) = b(k,248) - lu(k,495) * b(k,159) + b(k,253) = b(k,253) - lu(k,496) * b(k,159) + b(k,259) = b(k,259) - lu(k,497) * b(k,159) + b(k,216) = b(k,216) - lu(k,500) * b(k,160) + b(k,248) = b(k,248) - lu(k,501) * b(k,160) + b(k,251) = b(k,251) - lu(k,502) * b(k,160) + b(k,253) = b(k,253) - lu(k,503) * b(k,160) + b(k,259) = b(k,259) - lu(k,504) * b(k,160) + b(k,193) = b(k,193) - lu(k,506) * b(k,161) + b(k,259) = b(k,259) - lu(k,507) * b(k,161) + b(k,243) = b(k,243) - lu(k,509) * b(k,162) + b(k,250) = b(k,250) - lu(k,510) * b(k,162) + b(k,251) = b(k,251) - lu(k,511) * b(k,162) + b(k,255) = b(k,255) - lu(k,512) * b(k,162) + b(k,257) = b(k,257) - lu(k,513) * b(k,162) + b(k,261) = b(k,261) - lu(k,514) * b(k,162) + b(k,214) = b(k,214) - lu(k,516) * b(k,163) + b(k,218) = b(k,218) - lu(k,517) * b(k,163) + b(k,229) = b(k,229) - lu(k,518) * b(k,163) + b(k,247) = b(k,247) - lu(k,519) * b(k,163) + b(k,251) = b(k,251) - lu(k,520) * b(k,163) + b(k,259) = b(k,259) - lu(k,521) * b(k,163) + b(k,184) = b(k,184) - lu(k,523) * b(k,164) + b(k,248) = b(k,248) - lu(k,524) * b(k,164) + b(k,258) = b(k,258) - lu(k,525) * b(k,164) + b(k,246) = b(k,246) - lu(k,528) * b(k,165) + b(k,248) = b(k,248) - lu(k,529) * b(k,165) + b(k,249) = b(k,249) - lu(k,530) * b(k,165) + b(k,250) = b(k,250) - lu(k,531) * b(k,165) + b(k,251) = b(k,251) - lu(k,532) * b(k,165) + b(k,253) = b(k,253) - lu(k,533) * b(k,165) + b(k,193) = b(k,193) - lu(k,537) * b(k,166) + b(k,216) = b(k,216) - lu(k,538) * b(k,166) + b(k,248) = b(k,248) - lu(k,539) * b(k,166) + b(k,251) = b(k,251) - lu(k,540) * b(k,166) + b(k,253) = b(k,253) - lu(k,541) * b(k,166) + b(k,259) = b(k,259) - lu(k,542) * b(k,166) + b(k,216) = b(k,216) - lu(k,545) * b(k,167) + b(k,234) = b(k,234) - lu(k,546) * b(k,167) + b(k,248) = b(k,248) - lu(k,547) * b(k,167) + b(k,251) = b(k,251) - lu(k,548) * b(k,167) + b(k,253) = b(k,253) - lu(k,549) * b(k,167) + b(k,259) = b(k,259) - lu(k,550) * b(k,167) + b(k,187) = b(k,187) - lu(k,552) * b(k,168) + b(k,204) = b(k,204) - lu(k,553) * b(k,168) + b(k,241) = b(k,241) - lu(k,554) * b(k,168) + b(k,251) = b(k,251) - lu(k,555) * b(k,168) + b(k,235) = b(k,235) - lu(k,557) * b(k,169) + b(k,246) = b(k,246) - lu(k,558) * b(k,169) + b(k,249) = b(k,249) - lu(k,559) * b(k,169) + b(k,251) = b(k,251) - lu(k,560) * b(k,169) + b(k,258) = b(k,258) - lu(k,561) * b(k,169) + b(k,184) = b(k,184) - lu(k,564) * b(k,170) + b(k,248) = b(k,248) - lu(k,565) * b(k,170) + b(k,251) = b(k,251) - lu(k,566) * b(k,170) + b(k,253) = b(k,253) - lu(k,567) * b(k,170) + b(k,259) = b(k,259) - lu(k,568) * b(k,170) + b(k,205) = b(k,205) - lu(k,570) * b(k,171) + b(k,241) = b(k,241) - lu(k,571) * b(k,171) + b(k,247) = b(k,247) - lu(k,572) * b(k,171) + b(k,248) = b(k,248) - lu(k,573) * b(k,171) + b(k,251) = b(k,251) - lu(k,574) * b(k,171) + b(k,254) = b(k,254) - lu(k,575) * b(k,171) + b(k,256) = b(k,256) - lu(k,576) * b(k,171) + b(k,199) = b(k,199) - lu(k,578) * b(k,172) + b(k,243) = b(k,243) - lu(k,579) * b(k,172) + b(k,245) = b(k,245) - lu(k,580) * b(k,172) + b(k,248) = b(k,248) - lu(k,581) * b(k,172) + b(k,249) = b(k,249) - lu(k,582) * b(k,172) + b(k,252) = b(k,252) - lu(k,583) * b(k,172) + b(k,256) = b(k,256) - lu(k,584) * b(k,172) + b(k,198) = b(k,198) - lu(k,586) * b(k,173) + b(k,221) = b(k,221) - lu(k,587) * b(k,173) + b(k,227) = b(k,227) - lu(k,588) * b(k,173) + b(k,247) = b(k,247) - lu(k,589) * b(k,173) + b(k,251) = b(k,251) - lu(k,590) * b(k,173) + b(k,259) = b(k,259) - lu(k,591) * b(k,173) + b(k,261) = b(k,261) - lu(k,592) * b(k,173) + b(k,207) = b(k,207) - lu(k,594) * b(k,174) + b(k,222) = b(k,222) - lu(k,595) * b(k,174) + b(k,226) = b(k,226) - lu(k,596) * b(k,174) + b(k,227) = b(k,227) - lu(k,597) * b(k,174) + b(k,245) = b(k,245) - lu(k,598) * b(k,174) + b(k,251) = b(k,251) - lu(k,599) * b(k,174) + b(k,259) = b(k,259) - lu(k,600) * b(k,174) + b(k,192) = b(k,192) - lu(k,602) * b(k,175) + b(k,215) = b(k,215) - lu(k,603) * b(k,175) + b(k,225) = b(k,225) - lu(k,604) * b(k,175) + b(k,247) = b(k,247) - lu(k,605) * b(k,175) + b(k,251) = b(k,251) - lu(k,606) * b(k,175) + b(k,258) = b(k,258) - lu(k,607) * b(k,175) + b(k,259) = b(k,259) - lu(k,608) * b(k,175) + b(k,214) = b(k,214) - lu(k,610) * b(k,176) + b(k,221) = b(k,221) - lu(k,611) * b(k,176) + b(k,226) = b(k,226) - lu(k,612) * b(k,176) + b(k,247) = b(k,247) - lu(k,613) * b(k,176) + b(k,248) = b(k,248) - lu(k,614) * b(k,176) + b(k,253) = b(k,253) - lu(k,615) * b(k,176) + b(k,259) = b(k,259) - lu(k,616) * b(k,176) + b(k,222) = b(k,222) - lu(k,618) * b(k,177) + b(k,226) = b(k,226) - lu(k,619) * b(k,177) + b(k,227) = b(k,227) - lu(k,620) * b(k,177) + b(k,245) = b(k,245) - lu(k,621) * b(k,177) + b(k,247) = b(k,247) - lu(k,622) * b(k,177) + b(k,248) = b(k,248) - lu(k,623) * b(k,177) + b(k,251) = b(k,251) - lu(k,624) * b(k,177) + b(k,259) = b(k,259) - lu(k,625) * b(k,177) + b(k,243) = b(k,243) - lu(k,627) * b(k,178) + b(k,250) = b(k,250) - lu(k,628) * b(k,178) + b(k,251) = b(k,251) - lu(k,629) * b(k,178) + b(k,254) = b(k,254) - lu(k,630) * b(k,178) + b(k,255) = b(k,255) - lu(k,631) * b(k,178) + b(k,257) = b(k,257) - lu(k,632) * b(k,178) + b(k,259) = b(k,259) - lu(k,633) * b(k,178) + b(k,261) = b(k,261) - lu(k,634) * b(k,178) + b(k,205) = b(k,205) - lu(k,636) * b(k,179) + b(k,241) = b(k,241) - lu(k,637) * b(k,179) + b(k,247) = b(k,247) - lu(k,638) * b(k,179) + b(k,251) = b(k,251) - lu(k,639) * b(k,179) + b(k,254) = b(k,254) - lu(k,640) * b(k,179) + b(k,261) = b(k,261) - lu(k,641) * b(k,179) + b(k,210) = b(k,210) - lu(k,643) * b(k,180) + b(k,225) = b(k,225) - lu(k,644) * b(k,180) + b(k,259) = b(k,259) - lu(k,645) * b(k,180) + b(k,249) = b(k,249) - lu(k,647) * b(k,181) + b(k,251) = b(k,251) - lu(k,648) * b(k,181) + b(k,255) = b(k,255) - lu(k,649) * b(k,181) + b(k,257) = b(k,257) - lu(k,650) * b(k,181) + b(k,259) = b(k,259) - lu(k,651) * b(k,181) + b(k,261) = b(k,261) - lu(k,652) * b(k,181) + b(k,205) = b(k,205) - lu(k,654) * b(k,182) + b(k,227) = b(k,227) - lu(k,655) * b(k,182) + b(k,240) = b(k,240) - lu(k,656) * b(k,182) + b(k,247) = b(k,247) - lu(k,657) * b(k,182) + b(k,248) = b(k,248) - lu(k,658) * b(k,182) + b(k,251) = b(k,251) - lu(k,659) * b(k,182) + b(k,256) = b(k,256) - lu(k,660) * b(k,182) + b(k,259) = b(k,259) - lu(k,661) * b(k,182) + 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,218) = b(k,218) - lu(k,663) * b(k,183) + b(k,245) = b(k,245) - lu(k,664) * b(k,183) + b(k,248) = b(k,248) - lu(k,665) * b(k,183) + b(k,251) = b(k,251) - lu(k,666) * b(k,183) + b(k,259) = b(k,259) - lu(k,667) * b(k,183) + b(k,248) = b(k,248) - lu(k,671) * b(k,184) + b(k,251) = b(k,251) - lu(k,672) * b(k,184) + b(k,253) = b(k,253) - lu(k,673) * b(k,184) + b(k,258) = b(k,258) - lu(k,674) * b(k,184) + b(k,259) = b(k,259) - lu(k,675) * b(k,184) + b(k,187) = b(k,187) - lu(k,678) * b(k,185) + b(k,204) = b(k,204) - lu(k,679) * b(k,185) + b(k,212) = b(k,212) - lu(k,680) * b(k,185) + b(k,214) = b(k,214) - lu(k,681) * b(k,185) + b(k,221) = b(k,221) - lu(k,682) * b(k,185) + b(k,241) = b(k,241) - lu(k,683) * b(k,185) + b(k,247) = b(k,247) - lu(k,684) * b(k,185) + b(k,251) = b(k,251) - lu(k,685) * b(k,185) + b(k,259) = b(k,259) - lu(k,686) * b(k,185) + b(k,187) = b(k,187) - lu(k,689) * b(k,186) + b(k,204) = b(k,204) - lu(k,690) * b(k,186) + b(k,214) = b(k,214) - lu(k,691) * b(k,186) + b(k,221) = b(k,221) - lu(k,692) * b(k,186) + b(k,241) = b(k,241) - lu(k,693) * b(k,186) + b(k,247) = b(k,247) - lu(k,694) * b(k,186) + b(k,248) = b(k,248) - lu(k,695) * b(k,186) + b(k,251) = b(k,251) - lu(k,696) * b(k,186) + b(k,259) = b(k,259) - lu(k,697) * b(k,186) + b(k,221) = b(k,221) - lu(k,700) * b(k,187) + b(k,241) = b(k,241) - lu(k,701) * b(k,187) + b(k,248) = b(k,248) - lu(k,702) * b(k,187) + b(k,251) = b(k,251) - lu(k,703) * b(k,187) + b(k,253) = b(k,253) - lu(k,704) * b(k,187) + b(k,259) = b(k,259) - lu(k,705) * b(k,187) + b(k,205) = b(k,205) - lu(k,707) * b(k,188) + b(k,214) = b(k,214) - lu(k,708) * b(k,188) + b(k,222) = b(k,222) - lu(k,709) * b(k,188) + b(k,224) = b(k,224) - lu(k,710) * b(k,188) + b(k,225) = b(k,225) - lu(k,711) * b(k,188) + b(k,228) = b(k,228) - lu(k,712) * b(k,188) + b(k,247) = b(k,247) - lu(k,713) * b(k,188) + b(k,251) = b(k,251) - lu(k,714) * b(k,188) + b(k,259) = b(k,259) - lu(k,715) * b(k,188) + b(k,193) = b(k,193) - lu(k,720) * b(k,189) + b(k,194) = b(k,194) - lu(k,721) * b(k,189) + b(k,197) = b(k,197) - lu(k,722) * b(k,189) + b(k,210) = b(k,210) - lu(k,723) * b(k,189) + b(k,216) = b(k,216) - lu(k,724) * b(k,189) + b(k,225) = b(k,225) - lu(k,725) * b(k,189) + b(k,234) = b(k,234) - lu(k,726) * b(k,189) + b(k,251) = b(k,251) - lu(k,727) * b(k,189) + b(k,259) = b(k,259) - lu(k,728) * b(k,189) + b(k,205) = b(k,205) - lu(k,730) * b(k,190) + b(k,251) = b(k,251) - lu(k,731) * b(k,190) + b(k,254) = b(k,254) - lu(k,732) * b(k,190) + b(k,261) = b(k,261) - lu(k,733) * b(k,190) + b(k,193) = b(k,193) - lu(k,739) * b(k,191) + b(k,196) = b(k,196) - lu(k,740) * b(k,191) + b(k,197) = b(k,197) - lu(k,741) * b(k,191) + b(k,210) = b(k,210) - lu(k,742) * b(k,191) + b(k,216) = b(k,216) - lu(k,743) * b(k,191) + b(k,225) = b(k,225) - lu(k,744) * b(k,191) + b(k,234) = b(k,234) - lu(k,745) * b(k,191) + b(k,241) = b(k,241) - lu(k,746) * b(k,191) + b(k,251) = b(k,251) - lu(k,747) * b(k,191) + b(k,259) = b(k,259) - lu(k,748) * b(k,191) + b(k,222) = b(k,222) - lu(k,752) * b(k,192) + b(k,247) = b(k,247) - lu(k,753) * b(k,192) + b(k,248) = b(k,248) - lu(k,754) * b(k,192) + b(k,251) = b(k,251) - lu(k,755) * b(k,192) + b(k,253) = b(k,253) - lu(k,756) * b(k,192) + b(k,259) = b(k,259) - lu(k,757) * b(k,192) + b(k,216) = b(k,216) - lu(k,759) * b(k,193) + b(k,225) = b(k,225) - lu(k,760) * b(k,193) + b(k,248) = b(k,248) - lu(k,761) * b(k,193) + b(k,253) = b(k,253) - lu(k,762) * b(k,193) + b(k,259) = b(k,259) - lu(k,763) * b(k,193) + b(k,197) = b(k,197) - lu(k,770) * b(k,194) + b(k,210) = b(k,210) - lu(k,771) * b(k,194) + b(k,216) = b(k,216) - lu(k,772) * b(k,194) + b(k,225) = b(k,225) - lu(k,773) * b(k,194) + b(k,234) = b(k,234) - lu(k,774) * b(k,194) + b(k,248) = b(k,248) - lu(k,775) * b(k,194) + b(k,251) = b(k,251) - lu(k,776) * b(k,194) + b(k,253) = b(k,253) - lu(k,777) * b(k,194) + b(k,259) = b(k,259) - lu(k,778) * b(k,194) + b(k,231) = b(k,231) - lu(k,781) * b(k,195) + b(k,233) = b(k,233) - lu(k,782) * b(k,195) + b(k,239) = b(k,239) - lu(k,783) * b(k,195) + b(k,247) = b(k,247) - lu(k,784) * b(k,195) + b(k,251) = b(k,251) - lu(k,785) * b(k,195) + b(k,259) = b(k,259) - lu(k,786) * b(k,195) + b(k,197) = b(k,197) - lu(k,794) * b(k,196) + b(k,210) = b(k,210) - lu(k,795) * b(k,196) + b(k,216) = b(k,216) - lu(k,796) * b(k,196) + b(k,225) = b(k,225) - lu(k,797) * b(k,196) + b(k,234) = b(k,234) - lu(k,798) * b(k,196) + b(k,241) = b(k,241) - lu(k,799) * b(k,196) + b(k,248) = b(k,248) - lu(k,800) * b(k,196) + b(k,251) = b(k,251) - lu(k,801) * b(k,196) + b(k,253) = b(k,253) - lu(k,802) * b(k,196) + b(k,259) = b(k,259) - lu(k,803) * b(k,196) + b(k,225) = b(k,225) - lu(k,805) * b(k,197) + b(k,234) = b(k,234) - lu(k,806) * b(k,197) + b(k,248) = b(k,248) - lu(k,807) * b(k,197) + b(k,251) = b(k,251) - lu(k,808) * b(k,197) + b(k,253) = b(k,253) - lu(k,809) * b(k,197) + b(k,254) = b(k,254) - lu(k,810) * b(k,197) + b(k,259) = b(k,259) - lu(k,811) * b(k,197) + b(k,221) = b(k,221) - lu(k,814) * b(k,198) + b(k,227) = b(k,227) - lu(k,815) * b(k,198) + b(k,247) = b(k,247) - lu(k,816) * b(k,198) + b(k,248) = b(k,248) - lu(k,817) * b(k,198) + b(k,251) = b(k,251) - lu(k,818) * b(k,198) + b(k,253) = b(k,253) - lu(k,819) * b(k,198) + b(k,259) = b(k,259) - lu(k,820) * b(k,198) + b(k,261) = b(k,261) - lu(k,821) * b(k,198) + b(k,243) = b(k,243) - lu(k,824) * b(k,199) + b(k,249) = b(k,249) - lu(k,825) * b(k,199) + b(k,251) = b(k,251) - lu(k,826) * b(k,199) + b(k,252) = b(k,252) - lu(k,827) * b(k,199) + b(k,255) = b(k,255) - lu(k,828) * b(k,199) + b(k,257) = b(k,257) - lu(k,829) * b(k,199) + b(k,261) = b(k,261) - lu(k,830) * b(k,199) + b(k,247) = b(k,247) - lu(k,832) * b(k,200) + b(k,251) = b(k,251) - lu(k,833) * b(k,200) + b(k,259) = b(k,259) - lu(k,834) * b(k,200) + b(k,214) = b(k,214) - lu(k,837) * b(k,201) + b(k,221) = b(k,221) - lu(k,838) * b(k,201) + b(k,247) = b(k,247) - lu(k,839) * b(k,201) + b(k,248) = b(k,248) - lu(k,840) * b(k,201) + b(k,251) = b(k,251) - lu(k,841) * b(k,201) + b(k,253) = b(k,253) - lu(k,842) * b(k,201) + b(k,254) = b(k,254) - lu(k,843) * b(k,201) + b(k,259) = b(k,259) - lu(k,844) * b(k,201) + b(k,261) = b(k,261) - lu(k,845) * b(k,201) + b(k,243) = b(k,243) - lu(k,847) * b(k,202) + b(k,246) = b(k,246) - lu(k,848) * b(k,202) + b(k,249) = b(k,249) - lu(k,849) * b(k,202) + b(k,250) = b(k,250) - lu(k,850) * b(k,202) + b(k,251) = b(k,251) - lu(k,851) * b(k,202) + b(k,252) = b(k,252) - lu(k,852) * b(k,202) + b(k,261) = b(k,261) - lu(k,853) * b(k,202) + b(k,249) = b(k,249) - lu(k,856) * b(k,203) + b(k,251) = b(k,251) - lu(k,857) * b(k,203) + b(k,255) = b(k,255) - lu(k,858) * b(k,203) + b(k,257) = b(k,257) - lu(k,859) * b(k,203) + b(k,260) = b(k,260) - lu(k,860) * b(k,203) + b(k,261) = b(k,261) - lu(k,861) * b(k,203) + b(k,221) = b(k,221) - lu(k,866) * b(k,204) + b(k,247) = b(k,247) - lu(k,867) * b(k,204) + b(k,248) = b(k,248) - lu(k,868) * b(k,204) + b(k,251) = b(k,251) - lu(k,869) * b(k,204) + b(k,253) = b(k,253) - lu(k,870) * b(k,204) + b(k,254) = b(k,254) - lu(k,871) * b(k,204) + b(k,259) = b(k,259) - lu(k,872) * b(k,204) + b(k,225) = b(k,225) - lu(k,874) * b(k,205) + b(k,249) = b(k,249) - lu(k,875) * b(k,205) + b(k,215) = b(k,215) - lu(k,880) * b(k,206) + b(k,219) = b(k,219) - lu(k,881) * b(k,206) + b(k,225) = b(k,225) - lu(k,882) * b(k,206) + b(k,232) = b(k,232) - lu(k,883) * b(k,206) + b(k,233) = b(k,233) - lu(k,884) * b(k,206) + b(k,236) = b(k,236) - lu(k,885) * b(k,206) + b(k,237) = b(k,237) - lu(k,886) * b(k,206) + b(k,239) = b(k,239) - lu(k,887) * b(k,206) + b(k,241) = b(k,241) - lu(k,888) * b(k,206) + b(k,247) = b(k,247) - lu(k,889) * b(k,206) + b(k,251) = b(k,251) - lu(k,890) * b(k,206) + b(k,254) = b(k,254) - lu(k,891) * b(k,206) + b(k,256) = b(k,256) - lu(k,892) * b(k,206) + b(k,258) = b(k,258) - lu(k,893) * b(k,206) + b(k,259) = b(k,259) - lu(k,894) * b(k,206) + b(k,234) = b(k,234) - lu(k,896) * b(k,207) + b(k,241) = b(k,241) - lu(k,897) * b(k,207) + b(k,247) = b(k,247) - lu(k,898) * b(k,207) + b(k,248) = b(k,248) - lu(k,899) * b(k,207) + b(k,251) = b(k,251) - lu(k,900) * b(k,207) + b(k,235) = b(k,235) - lu(k,903) * b(k,208) + b(k,249) = b(k,249) - lu(k,904) * b(k,208) + b(k,251) = b(k,251) - lu(k,905) * b(k,208) + b(k,259) = b(k,259) - lu(k,906) * b(k,208) + b(k,261) = b(k,261) - lu(k,907) * b(k,208) + b(k,242) = b(k,242) - lu(k,910) * b(k,209) + b(k,244) = b(k,244) - lu(k,911) * b(k,209) + b(k,245) = b(k,245) - lu(k,912) * b(k,209) + b(k,246) = b(k,246) - lu(k,913) * b(k,209) + b(k,251) = b(k,251) - lu(k,914) * b(k,209) + b(k,254) = b(k,254) - lu(k,915) * b(k,209) + b(k,256) = b(k,256) - lu(k,916) * b(k,209) + b(k,261) = b(k,261) - lu(k,917) * b(k,209) + b(k,216) = b(k,216) - lu(k,919) * b(k,210) + b(k,225) = b(k,225) - lu(k,920) * b(k,210) + b(k,234) = b(k,234) - lu(k,921) * b(k,210) + b(k,248) = b(k,248) - lu(k,922) * b(k,210) + b(k,251) = b(k,251) - lu(k,923) * b(k,210) + b(k,253) = b(k,253) - lu(k,924) * b(k,210) + b(k,254) = b(k,254) - lu(k,925) * b(k,210) + b(k,259) = b(k,259) - lu(k,926) * b(k,210) + b(k,212) = b(k,212) - lu(k,937) * b(k,211) + b(k,214) = b(k,214) - lu(k,938) * b(k,211) + b(k,215) = b(k,215) - lu(k,939) * b(k,211) + b(k,216) = b(k,216) - lu(k,940) * b(k,211) + b(k,218) = b(k,218) - lu(k,941) * b(k,211) + b(k,223) = b(k,223) - lu(k,942) * b(k,211) + b(k,224) = b(k,224) - lu(k,943) * b(k,211) + b(k,225) = b(k,225) - lu(k,944) * b(k,211) + b(k,229) = b(k,229) - lu(k,945) * b(k,211) + b(k,230) = b(k,230) - lu(k,946) * b(k,211) + b(k,234) = b(k,234) - lu(k,947) * b(k,211) + b(k,241) = b(k,241) - lu(k,948) * b(k,211) + b(k,247) = b(k,247) - lu(k,949) * b(k,211) + b(k,249) = b(k,249) - lu(k,950) * b(k,211) + b(k,251) = b(k,251) - lu(k,951) * b(k,211) + b(k,256) = b(k,256) - lu(k,952) * b(k,211) + b(k,258) = b(k,258) - lu(k,953) * b(k,211) + b(k,259) = b(k,259) - lu(k,954) * b(k,211) + 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,214) = b(k,214) - lu(k,961) * b(k,212) + b(k,221) = b(k,221) - lu(k,962) * b(k,212) + b(k,241) = b(k,241) - lu(k,963) * b(k,212) + b(k,247) = b(k,247) - lu(k,964) * b(k,212) + b(k,248) = b(k,248) - lu(k,965) * b(k,212) + b(k,251) = b(k,251) - lu(k,966) * b(k,212) + b(k,253) = b(k,253) - lu(k,967) * b(k,212) + b(k,254) = b(k,254) - lu(k,968) * b(k,212) + b(k,259) = b(k,259) - lu(k,969) * b(k,212) + b(k,245) = b(k,245) - lu(k,973) * b(k,213) + b(k,248) = b(k,248) - lu(k,974) * b(k,213) + b(k,249) = b(k,249) - lu(k,975) * b(k,213) + b(k,251) = b(k,251) - lu(k,976) * b(k,213) + b(k,255) = b(k,255) - lu(k,977) * b(k,213) + b(k,256) = b(k,256) - lu(k,978) * b(k,213) + b(k,257) = b(k,257) - lu(k,979) * b(k,213) + b(k,260) = b(k,260) - lu(k,980) * b(k,213) + b(k,261) = b(k,261) - lu(k,981) * b(k,213) + b(k,230) = b(k,230) - lu(k,983) * b(k,214) + b(k,241) = b(k,241) - lu(k,984) * b(k,214) + b(k,251) = b(k,251) - lu(k,985) * b(k,214) + b(k,254) = b(k,254) - lu(k,986) * b(k,214) + b(k,261) = b(k,261) - lu(k,987) * b(k,214) + b(k,225) = b(k,225) - lu(k,990) * b(k,215) + b(k,249) = b(k,249) - lu(k,991) * b(k,215) + b(k,251) = b(k,251) - lu(k,992) * b(k,215) + b(k,259) = b(k,259) - lu(k,993) * b(k,215) + b(k,261) = b(k,261) - lu(k,994) * b(k,215) + b(k,225) = b(k,225) - lu(k,998) * b(k,216) + b(k,249) = b(k,249) - lu(k,999) * b(k,216) + b(k,251) = b(k,251) - lu(k,1000) * b(k,216) + b(k,259) = b(k,259) - lu(k,1001) * b(k,216) + b(k,218) = b(k,218) - lu(k,1016) * b(k,217) + b(k,221) = b(k,221) - lu(k,1017) * b(k,217) + b(k,223) = b(k,223) - lu(k,1018) * b(k,217) + b(k,224) = b(k,224) - lu(k,1019) * b(k,217) + b(k,225) = b(k,225) - lu(k,1020) * b(k,217) + b(k,229) = b(k,229) - lu(k,1021) * b(k,217) + b(k,230) = b(k,230) - lu(k,1022) * b(k,217) + b(k,234) = b(k,234) - lu(k,1023) * b(k,217) + b(k,241) = b(k,241) - lu(k,1024) * b(k,217) + b(k,247) = b(k,247) - lu(k,1025) * b(k,217) + b(k,248) = b(k,248) - lu(k,1026) * b(k,217) + b(k,249) = b(k,249) - lu(k,1027) * b(k,217) + b(k,251) = b(k,251) - lu(k,1028) * b(k,217) + b(k,253) = b(k,253) - lu(k,1029) * b(k,217) + b(k,254) = b(k,254) - lu(k,1030) * b(k,217) + b(k,256) = b(k,256) - lu(k,1031) * b(k,217) + b(k,258) = b(k,258) - lu(k,1032) * b(k,217) + b(k,259) = b(k,259) - lu(k,1033) * b(k,217) + b(k,261) = b(k,261) - lu(k,1034) * b(k,217) + b(k,223) = b(k,223) - lu(k,1036) * b(k,218) + b(k,224) = b(k,224) - lu(k,1037) * b(k,218) + b(k,225) = b(k,225) - lu(k,1038) * b(k,218) + b(k,228) = b(k,228) - lu(k,1039) * b(k,218) + b(k,251) = b(k,251) - lu(k,1040) * b(k,218) + b(k,256) = b(k,256) - lu(k,1041) * b(k,218) + b(k,259) = b(k,259) - lu(k,1042) * b(k,218) + b(k,221) = b(k,221) - lu(k,1049) * b(k,219) + b(k,225) = b(k,225) - lu(k,1050) * b(k,219) + b(k,227) = b(k,227) - lu(k,1051) * b(k,219) + b(k,234) = b(k,234) - lu(k,1052) * b(k,219) + b(k,241) = b(k,241) - lu(k,1053) * b(k,219) + b(k,244) = b(k,244) - lu(k,1054) * b(k,219) + b(k,247) = b(k,247) - lu(k,1055) * b(k,219) + b(k,248) = b(k,248) - lu(k,1056) * b(k,219) + b(k,249) = b(k,249) - lu(k,1057) * b(k,219) + b(k,251) = b(k,251) - lu(k,1058) * b(k,219) + b(k,253) = b(k,253) - lu(k,1059) * b(k,219) + b(k,254) = b(k,254) - lu(k,1060) * b(k,219) + b(k,256) = b(k,256) - lu(k,1061) * b(k,219) + b(k,258) = b(k,258) - lu(k,1062) * b(k,219) + b(k,259) = b(k,259) - lu(k,1063) * b(k,219) + b(k,261) = b(k,261) - lu(k,1064) * b(k,219) + b(k,225) = b(k,225) - lu(k,1070) * b(k,220) + b(k,234) = b(k,234) - lu(k,1071) * b(k,220) + b(k,241) = b(k,241) - lu(k,1072) * b(k,220) + b(k,245) = b(k,245) - lu(k,1073) * b(k,220) + b(k,247) = b(k,247) - lu(k,1074) * b(k,220) + b(k,248) = b(k,248) - lu(k,1075) * b(k,220) + b(k,249) = b(k,249) - lu(k,1076) * b(k,220) + b(k,251) = b(k,251) - lu(k,1077) * b(k,220) + b(k,253) = b(k,253) - lu(k,1078) * b(k,220) + b(k,254) = b(k,254) - lu(k,1079) * b(k,220) + b(k,259) = b(k,259) - lu(k,1080) * b(k,220) + b(k,225) = b(k,225) - lu(k,1082) * b(k,221) + b(k,241) = b(k,241) - lu(k,1083) * b(k,221) + b(k,245) = b(k,245) - lu(k,1084) * b(k,221) + b(k,251) = b(k,251) - lu(k,1085) * b(k,221) + b(k,254) = b(k,254) - lu(k,1086) * b(k,221) + b(k,256) = b(k,256) - lu(k,1087) * b(k,221) + b(k,259) = b(k,259) - lu(k,1088) * b(k,221) + b(k,261) = b(k,261) - lu(k,1089) * b(k,221) + b(k,225) = b(k,225) - lu(k,1093) * b(k,222) + b(k,247) = b(k,247) - lu(k,1094) * b(k,222) + b(k,249) = b(k,249) - lu(k,1095) * b(k,222) + b(k,251) = b(k,251) - lu(k,1096) * b(k,222) + b(k,259) = b(k,259) - lu(k,1097) * b(k,222) + b(k,224) = b(k,224) - lu(k,1103) * b(k,223) + b(k,225) = b(k,225) - lu(k,1104) * b(k,223) + b(k,228) = b(k,228) - lu(k,1105) * b(k,223) + b(k,245) = b(k,245) - lu(k,1106) * b(k,223) + b(k,247) = b(k,247) - lu(k,1107) * b(k,223) + b(k,248) = b(k,248) - lu(k,1108) * b(k,223) + b(k,251) = b(k,251) - lu(k,1109) * b(k,223) + b(k,253) = b(k,253) - lu(k,1110) * b(k,223) + b(k,254) = b(k,254) - lu(k,1111) * b(k,223) + b(k,256) = b(k,256) - lu(k,1112) * b(k,223) + b(k,259) = b(k,259) - lu(k,1113) * b(k,223) + b(k,225) = b(k,225) - lu(k,1117) * b(k,224) + b(k,230) = b(k,230) - lu(k,1118) * b(k,224) + b(k,241) = b(k,241) - lu(k,1119) * b(k,224) + b(k,247) = b(k,247) - lu(k,1120) * b(k,224) + b(k,249) = b(k,249) - lu(k,1121) * b(k,224) + b(k,251) = b(k,251) - lu(k,1122) * b(k,224) + b(k,254) = b(k,254) - lu(k,1123) * b(k,224) + b(k,259) = b(k,259) - lu(k,1124) * b(k,224) + b(k,261) = b(k,261) - lu(k,1125) * b(k,224) + b(k,249) = b(k,249) - lu(k,1128) * b(k,225) + b(k,251) = b(k,251) - lu(k,1129) * b(k,225) + b(k,259) = b(k,259) - lu(k,1130) * b(k,225) + b(k,227) = b(k,227) - lu(k,1137) * b(k,226) + b(k,230) = b(k,230) - lu(k,1138) * b(k,226) + b(k,241) = b(k,241) - lu(k,1139) * b(k,226) + b(k,245) = b(k,245) - lu(k,1140) * b(k,226) + b(k,247) = b(k,247) - lu(k,1141) * b(k,226) + b(k,248) = b(k,248) - lu(k,1142) * b(k,226) + b(k,249) = b(k,249) - lu(k,1143) * b(k,226) + b(k,251) = b(k,251) - lu(k,1144) * b(k,226) + b(k,254) = b(k,254) - lu(k,1145) * b(k,226) + b(k,256) = b(k,256) - lu(k,1146) * b(k,226) + b(k,259) = b(k,259) - lu(k,1147) * b(k,226) + b(k,261) = b(k,261) - lu(k,1148) * b(k,226) + b(k,234) = b(k,234) - lu(k,1150) * b(k,227) + b(k,241) = b(k,241) - lu(k,1151) * b(k,227) + b(k,247) = b(k,247) - lu(k,1152) * b(k,227) + b(k,251) = b(k,251) - lu(k,1153) * b(k,227) + b(k,259) = b(k,259) - lu(k,1154) * b(k,227) + b(k,230) = b(k,230) - lu(k,1164) * b(k,228) + b(k,241) = b(k,241) - lu(k,1165) * b(k,228) + b(k,245) = b(k,245) - lu(k,1166) * b(k,228) + b(k,247) = b(k,247) - lu(k,1167) * b(k,228) + b(k,248) = b(k,248) - lu(k,1168) * b(k,228) + b(k,249) = b(k,249) - lu(k,1169) * b(k,228) + b(k,251) = b(k,251) - lu(k,1170) * b(k,228) + b(k,253) = b(k,253) - lu(k,1171) * b(k,228) + b(k,254) = b(k,254) - lu(k,1172) * b(k,228) + b(k,259) = b(k,259) - lu(k,1173) * b(k,228) + b(k,261) = b(k,261) - lu(k,1174) * b(k,228) + b(k,230) = b(k,230) - lu(k,1185) * b(k,229) + b(k,241) = b(k,241) - lu(k,1186) * b(k,229) + b(k,245) = b(k,245) - lu(k,1187) * b(k,229) + b(k,247) = b(k,247) - lu(k,1188) * b(k,229) + b(k,248) = b(k,248) - lu(k,1189) * b(k,229) + b(k,249) = b(k,249) - lu(k,1190) * b(k,229) + b(k,251) = b(k,251) - lu(k,1191) * b(k,229) + b(k,253) = b(k,253) - lu(k,1192) * b(k,229) + b(k,254) = b(k,254) - lu(k,1193) * b(k,229) + b(k,256) = b(k,256) - lu(k,1194) * b(k,229) + b(k,259) = b(k,259) - lu(k,1195) * b(k,229) + b(k,261) = b(k,261) - lu(k,1196) * b(k,229) + b(k,234) = b(k,234) - lu(k,1201) * b(k,230) + b(k,241) = b(k,241) - lu(k,1202) * b(k,230) + b(k,247) = b(k,247) - lu(k,1203) * b(k,230) + b(k,248) = b(k,248) - lu(k,1204) * b(k,230) + b(k,251) = b(k,251) - lu(k,1205) * b(k,230) + b(k,253) = b(k,253) - lu(k,1206) * b(k,230) + b(k,254) = b(k,254) - lu(k,1207) * b(k,230) + b(k,259) = b(k,259) - lu(k,1208) * b(k,230) + b(k,261) = b(k,261) - lu(k,1209) * b(k,230) + b(k,234) = b(k,234) - lu(k,1218) * b(k,231) + b(k,241) = b(k,241) - lu(k,1219) * b(k,231) + b(k,247) = b(k,247) - lu(k,1220) * b(k,231) + b(k,248) = b(k,248) - lu(k,1221) * b(k,231) + b(k,249) = b(k,249) - lu(k,1222) * b(k,231) + b(k,251) = b(k,251) - lu(k,1223) * b(k,231) + b(k,253) = b(k,253) - lu(k,1224) * b(k,231) + b(k,254) = b(k,254) - lu(k,1225) * b(k,231) + b(k,256) = b(k,256) - lu(k,1226) * b(k,231) + b(k,259) = b(k,259) - lu(k,1227) * b(k,231) + b(k,233) = b(k,233) - lu(k,1238) * b(k,232) + b(k,234) = b(k,234) - lu(k,1239) * b(k,232) + b(k,239) = b(k,239) - lu(k,1240) * b(k,232) + b(k,241) = b(k,241) - lu(k,1241) * b(k,232) + b(k,245) = b(k,245) - lu(k,1242) * b(k,232) + b(k,247) = b(k,247) - lu(k,1243) * b(k,232) + b(k,248) = b(k,248) - lu(k,1244) * b(k,232) + b(k,249) = b(k,249) - lu(k,1245) * b(k,232) + b(k,251) = b(k,251) - lu(k,1246) * b(k,232) + b(k,253) = b(k,253) - lu(k,1247) * b(k,232) + b(k,254) = b(k,254) - lu(k,1248) * b(k,232) + b(k,256) = b(k,256) - lu(k,1249) * b(k,232) + b(k,259) = b(k,259) - lu(k,1250) * b(k,232) + b(k,234) = b(k,234) - lu(k,1254) * b(k,233) + b(k,238) = b(k,238) - lu(k,1255) * b(k,233) + b(k,240) = b(k,240) - lu(k,1256) * b(k,233) + b(k,241) = b(k,241) - lu(k,1257) * b(k,233) + b(k,247) = b(k,247) - lu(k,1258) * b(k,233) + b(k,249) = b(k,249) - lu(k,1259) * b(k,233) + b(k,251) = b(k,251) - lu(k,1260) * b(k,233) + b(k,258) = b(k,258) - lu(k,1261) * b(k,233) + b(k,259) = b(k,259) - lu(k,1262) * b(k,233) + b(k,261) = b(k,261) - lu(k,1263) * b(k,233) + 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 + b(k,241) = b(k,241) - lu(k,1266) * b(k,234) + b(k,245) = b(k,245) - lu(k,1267) * b(k,234) + b(k,249) = b(k,249) - lu(k,1268) * b(k,234) + b(k,251) = b(k,251) - lu(k,1269) * b(k,234) + b(k,256) = b(k,256) - lu(k,1270) * b(k,234) + b(k,259) = b(k,259) - lu(k,1271) * b(k,234) + b(k,261) = b(k,261) - lu(k,1272) * b(k,234) + b(k,243) = b(k,243) - lu(k,1277) * b(k,235) + b(k,246) = b(k,246) - lu(k,1278) * b(k,235) + b(k,248) = b(k,248) - lu(k,1279) * b(k,235) + b(k,249) = b(k,249) - lu(k,1280) * b(k,235) + b(k,251) = b(k,251) - lu(k,1281) * b(k,235) + b(k,252) = b(k,252) - lu(k,1282) * b(k,235) + b(k,253) = b(k,253) - lu(k,1283) * b(k,235) + b(k,257) = b(k,257) - lu(k,1284) * b(k,235) + b(k,258) = b(k,258) - lu(k,1285) * b(k,235) + b(k,259) = b(k,259) - lu(k,1286) * b(k,235) + b(k,260) = b(k,260) - lu(k,1287) * b(k,235) + b(k,261) = b(k,261) - lu(k,1288) * b(k,235) + b(k,238) = b(k,238) - lu(k,1302) * b(k,236) + b(k,239) = b(k,239) - lu(k,1303) * b(k,236) + b(k,240) = b(k,240) - lu(k,1304) * b(k,236) + b(k,241) = b(k,241) - lu(k,1305) * b(k,236) + b(k,245) = b(k,245) - lu(k,1306) * b(k,236) + b(k,247) = b(k,247) - lu(k,1307) * b(k,236) + b(k,248) = b(k,248) - lu(k,1308) * b(k,236) + b(k,249) = b(k,249) - lu(k,1309) * b(k,236) + b(k,251) = b(k,251) - lu(k,1310) * b(k,236) + b(k,253) = b(k,253) - lu(k,1311) * b(k,236) + b(k,254) = b(k,254) - lu(k,1312) * b(k,236) + b(k,256) = b(k,256) - lu(k,1313) * b(k,236) + b(k,258) = b(k,258) - lu(k,1314) * b(k,236) + b(k,259) = b(k,259) - lu(k,1315) * b(k,236) + b(k,261) = b(k,261) - lu(k,1316) * b(k,236) + b(k,238) = b(k,238) - lu(k,1335) * b(k,237) + b(k,239) = b(k,239) - lu(k,1336) * b(k,237) + b(k,240) = b(k,240) - lu(k,1337) * b(k,237) + b(k,241) = b(k,241) - lu(k,1338) * b(k,237) + b(k,245) = b(k,245) - lu(k,1339) * b(k,237) + b(k,247) = b(k,247) - lu(k,1340) * b(k,237) + b(k,248) = b(k,248) - lu(k,1341) * b(k,237) + b(k,249) = b(k,249) - lu(k,1342) * b(k,237) + b(k,251) = b(k,251) - lu(k,1343) * b(k,237) + b(k,253) = b(k,253) - lu(k,1344) * b(k,237) + b(k,254) = b(k,254) - lu(k,1345) * b(k,237) + b(k,256) = b(k,256) - lu(k,1346) * b(k,237) + b(k,258) = b(k,258) - lu(k,1347) * b(k,237) + b(k,259) = b(k,259) - lu(k,1348) * b(k,237) + b(k,261) = b(k,261) - lu(k,1349) * b(k,237) + b(k,240) = b(k,240) - lu(k,1359) * b(k,238) + b(k,241) = b(k,241) - lu(k,1360) * b(k,238) + b(k,245) = b(k,245) - lu(k,1361) * b(k,238) + b(k,247) = b(k,247) - lu(k,1362) * b(k,238) + b(k,248) = b(k,248) - lu(k,1363) * b(k,238) + b(k,249) = b(k,249) - lu(k,1364) * b(k,238) + b(k,251) = b(k,251) - lu(k,1365) * b(k,238) + b(k,253) = b(k,253) - lu(k,1366) * b(k,238) + b(k,254) = b(k,254) - lu(k,1367) * b(k,238) + b(k,256) = b(k,256) - lu(k,1368) * b(k,238) + b(k,259) = b(k,259) - lu(k,1369) * b(k,238) + b(k,261) = b(k,261) - lu(k,1370) * b(k,238) + b(k,240) = b(k,240) - lu(k,1380) * b(k,239) + b(k,241) = b(k,241) - lu(k,1381) * b(k,239) + b(k,244) = b(k,244) - lu(k,1382) * b(k,239) + b(k,245) = b(k,245) - lu(k,1383) * b(k,239) + b(k,247) = b(k,247) - lu(k,1384) * b(k,239) + b(k,248) = b(k,248) - lu(k,1385) * b(k,239) + b(k,249) = b(k,249) - lu(k,1386) * b(k,239) + b(k,251) = b(k,251) - lu(k,1387) * b(k,239) + b(k,253) = b(k,253) - lu(k,1388) * b(k,239) + b(k,254) = b(k,254) - lu(k,1389) * b(k,239) + b(k,256) = b(k,256) - lu(k,1390) * b(k,239) + b(k,258) = b(k,258) - lu(k,1391) * b(k,239) + b(k,259) = b(k,259) - lu(k,1392) * b(k,239) + b(k,261) = b(k,261) - lu(k,1393) * b(k,239) + b(k,241) = b(k,241) - lu(k,1402) * b(k,240) + b(k,245) = b(k,245) - lu(k,1403) * b(k,240) + b(k,247) = b(k,247) - lu(k,1404) * b(k,240) + b(k,248) = b(k,248) - lu(k,1405) * b(k,240) + b(k,249) = b(k,249) - lu(k,1406) * b(k,240) + b(k,251) = b(k,251) - lu(k,1407) * b(k,240) + b(k,253) = b(k,253) - lu(k,1408) * b(k,240) + b(k,254) = b(k,254) - lu(k,1409) * b(k,240) + b(k,256) = b(k,256) - lu(k,1410) * b(k,240) + b(k,258) = b(k,258) - lu(k,1411) * b(k,240) + b(k,259) = b(k,259) - lu(k,1412) * b(k,240) + b(k,261) = b(k,261) - lu(k,1413) * b(k,240) + b(k,244) = b(k,244) - lu(k,1434) * b(k,241) + b(k,245) = b(k,245) - lu(k,1435) * b(k,241) + b(k,247) = b(k,247) - lu(k,1436) * b(k,241) + b(k,248) = b(k,248) - lu(k,1437) * b(k,241) + b(k,249) = b(k,249) - lu(k,1438) * b(k,241) + b(k,251) = b(k,251) - lu(k,1439) * b(k,241) + b(k,253) = b(k,253) - lu(k,1440) * b(k,241) + b(k,254) = b(k,254) - lu(k,1441) * b(k,241) + b(k,256) = b(k,256) - lu(k,1442) * b(k,241) + b(k,258) = b(k,258) - lu(k,1443) * b(k,241) + b(k,259) = b(k,259) - lu(k,1444) * b(k,241) + b(k,261) = b(k,261) - lu(k,1445) * b(k,241) + b(k,244) = b(k,244) - lu(k,1449) * b(k,242) + b(k,245) = b(k,245) - lu(k,1450) * b(k,242) + b(k,246) = b(k,246) - lu(k,1451) * b(k,242) + b(k,249) = b(k,249) - lu(k,1452) * b(k,242) + b(k,250) = b(k,250) - lu(k,1453) * b(k,242) + b(k,251) = b(k,251) - lu(k,1454) * b(k,242) + b(k,254) = b(k,254) - lu(k,1455) * b(k,242) + b(k,255) = b(k,255) - lu(k,1456) * b(k,242) + b(k,256) = b(k,256) - lu(k,1457) * b(k,242) + b(k,257) = b(k,257) - lu(k,1458) * b(k,242) + b(k,261) = b(k,261) - lu(k,1459) * b(k,242) + b(k,246) = b(k,246) - lu(k,1463) * b(k,243) + b(k,247) = b(k,247) - lu(k,1464) * b(k,243) + b(k,249) = b(k,249) - lu(k,1465) * b(k,243) + b(k,250) = b(k,250) - lu(k,1466) * b(k,243) + b(k,251) = b(k,251) - lu(k,1467) * b(k,243) + b(k,252) = b(k,252) - lu(k,1468) * b(k,243) + b(k,258) = b(k,258) - lu(k,1469) * b(k,243) + b(k,259) = b(k,259) - lu(k,1470) * b(k,243) + b(k,261) = b(k,261) - lu(k,1471) * b(k,243) + b(k,245) = b(k,245) - lu(k,1478) * b(k,244) + b(k,246) = b(k,246) - lu(k,1479) * b(k,244) + b(k,247) = b(k,247) - lu(k,1480) * b(k,244) + b(k,249) = b(k,249) - lu(k,1481) * b(k,244) + b(k,250) = b(k,250) - lu(k,1482) * b(k,244) + b(k,251) = b(k,251) - lu(k,1483) * b(k,244) + b(k,254) = b(k,254) - lu(k,1484) * b(k,244) + b(k,255) = b(k,255) - lu(k,1485) * b(k,244) + b(k,256) = b(k,256) - lu(k,1486) * b(k,244) + b(k,257) = b(k,257) - lu(k,1487) * b(k,244) + b(k,259) = b(k,259) - lu(k,1488) * b(k,244) + b(k,261) = b(k,261) - lu(k,1489) * b(k,244) + b(k,246) = b(k,246) - lu(k,1495) * b(k,245) + b(k,247) = b(k,247) - lu(k,1496) * b(k,245) + b(k,248) = b(k,248) - lu(k,1497) * b(k,245) + b(k,249) = b(k,249) - lu(k,1498) * b(k,245) + b(k,250) = b(k,250) - lu(k,1499) * b(k,245) + b(k,251) = b(k,251) - lu(k,1500) * b(k,245) + b(k,254) = b(k,254) - lu(k,1501) * b(k,245) + b(k,255) = b(k,255) - lu(k,1502) * b(k,245) + b(k,256) = b(k,256) - lu(k,1503) * b(k,245) + b(k,257) = b(k,257) - lu(k,1504) * b(k,245) + b(k,259) = b(k,259) - lu(k,1505) * b(k,245) + b(k,261) = b(k,261) - lu(k,1506) * b(k,245) + b(k,247) = b(k,247) - lu(k,1511) * b(k,246) + b(k,248) = b(k,248) - lu(k,1512) * b(k,246) + b(k,249) = b(k,249) - lu(k,1513) * b(k,246) + b(k,250) = b(k,250) - lu(k,1514) * b(k,246) + b(k,251) = b(k,251) - lu(k,1515) * b(k,246) + b(k,254) = b(k,254) - lu(k,1516) * b(k,246) + b(k,255) = b(k,255) - lu(k,1517) * b(k,246) + b(k,256) = b(k,256) - lu(k,1518) * b(k,246) + b(k,257) = b(k,257) - lu(k,1519) * b(k,246) + b(k,258) = b(k,258) - lu(k,1520) * b(k,246) + b(k,259) = b(k,259) - lu(k,1521) * b(k,246) + b(k,261) = b(k,261) - lu(k,1522) * b(k,246) + b(k,248) = b(k,248) - lu(k,1533) * b(k,247) + b(k,249) = b(k,249) - lu(k,1534) * b(k,247) + b(k,250) = b(k,250) - lu(k,1535) * b(k,247) + b(k,251) = b(k,251) - lu(k,1536) * b(k,247) + b(k,252) = b(k,252) - lu(k,1537) * b(k,247) + b(k,253) = b(k,253) - lu(k,1538) * b(k,247) + b(k,254) = b(k,254) - lu(k,1539) * b(k,247) + b(k,255) = b(k,255) - lu(k,1540) * b(k,247) + b(k,256) = b(k,256) - lu(k,1541) * b(k,247) + b(k,257) = b(k,257) - lu(k,1542) * b(k,247) + b(k,258) = b(k,258) - lu(k,1543) * b(k,247) + b(k,259) = b(k,259) - lu(k,1544) * b(k,247) + b(k,261) = b(k,261) - lu(k,1545) * b(k,247) + b(k,249) = b(k,249) - lu(k,1577) * b(k,248) + b(k,250) = b(k,250) - lu(k,1578) * b(k,248) + b(k,251) = b(k,251) - lu(k,1579) * b(k,248) + b(k,252) = b(k,252) - lu(k,1580) * b(k,248) + b(k,253) = b(k,253) - lu(k,1581) * b(k,248) + b(k,254) = b(k,254) - lu(k,1582) * b(k,248) + b(k,255) = b(k,255) - lu(k,1583) * b(k,248) + b(k,256) = b(k,256) - lu(k,1584) * b(k,248) + b(k,257) = b(k,257) - lu(k,1585) * b(k,248) + b(k,258) = b(k,258) - lu(k,1586) * b(k,248) + b(k,259) = b(k,259) - lu(k,1587) * b(k,248) + b(k,260) = b(k,260) - lu(k,1588) * b(k,248) + b(k,261) = b(k,261) - lu(k,1589) * b(k,248) + b(k,250) = b(k,250) - lu(k,1609) * b(k,249) + b(k,251) = b(k,251) - lu(k,1610) * b(k,249) + b(k,252) = b(k,252) - lu(k,1611) * b(k,249) + b(k,253) = b(k,253) - lu(k,1612) * b(k,249) + b(k,254) = b(k,254) - lu(k,1613) * b(k,249) + b(k,255) = b(k,255) - lu(k,1614) * b(k,249) + b(k,256) = b(k,256) - lu(k,1615) * b(k,249) + b(k,257) = b(k,257) - lu(k,1616) * b(k,249) + b(k,258) = b(k,258) - lu(k,1617) * b(k,249) + b(k,259) = b(k,259) - lu(k,1618) * b(k,249) + b(k,260) = b(k,260) - lu(k,1619) * b(k,249) + b(k,261) = b(k,261) - lu(k,1620) * b(k,249) + b(k,251) = b(k,251) - lu(k,1651) * b(k,250) + b(k,252) = b(k,252) - lu(k,1652) * b(k,250) + b(k,253) = b(k,253) - lu(k,1653) * b(k,250) + b(k,254) = b(k,254) - lu(k,1654) * b(k,250) + b(k,255) = b(k,255) - lu(k,1655) * b(k,250) + b(k,256) = b(k,256) - lu(k,1656) * b(k,250) + b(k,257) = b(k,257) - lu(k,1657) * b(k,250) + b(k,258) = b(k,258) - lu(k,1658) * b(k,250) + b(k,259) = b(k,259) - lu(k,1659) * b(k,250) + b(k,260) = b(k,260) - lu(k,1660) * b(k,250) + b(k,261) = b(k,261) - lu(k,1661) * b(k,250) + 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,252) = b(k,252) - lu(k,1824) * b(k,251) + b(k,253) = b(k,253) - lu(k,1825) * b(k,251) + b(k,254) = b(k,254) - lu(k,1826) * b(k,251) + b(k,255) = b(k,255) - lu(k,1827) * b(k,251) + b(k,256) = b(k,256) - lu(k,1828) * b(k,251) + b(k,257) = b(k,257) - lu(k,1829) * b(k,251) + b(k,258) = b(k,258) - lu(k,1830) * b(k,251) + b(k,259) = b(k,259) - lu(k,1831) * b(k,251) + b(k,260) = b(k,260) - lu(k,1832) * b(k,251) + b(k,261) = b(k,261) - lu(k,1833) * b(k,251) + b(k,253) = b(k,253) - lu(k,1849) * b(k,252) + b(k,254) = b(k,254) - lu(k,1850) * b(k,252) + b(k,255) = b(k,255) - lu(k,1851) * b(k,252) + b(k,256) = b(k,256) - lu(k,1852) * b(k,252) + b(k,257) = b(k,257) - lu(k,1853) * b(k,252) + b(k,258) = b(k,258) - lu(k,1854) * b(k,252) + b(k,259) = b(k,259) - lu(k,1855) * b(k,252) + b(k,260) = b(k,260) - lu(k,1856) * b(k,252) + b(k,261) = b(k,261) - lu(k,1857) * b(k,252) + b(k,254) = b(k,254) - lu(k,1953) * b(k,253) + b(k,255) = b(k,255) - lu(k,1954) * b(k,253) + b(k,256) = b(k,256) - lu(k,1955) * b(k,253) + b(k,257) = b(k,257) - lu(k,1956) * b(k,253) + b(k,258) = b(k,258) - lu(k,1957) * b(k,253) + b(k,259) = b(k,259) - lu(k,1958) * b(k,253) + b(k,260) = b(k,260) - lu(k,1959) * b(k,253) + b(k,261) = b(k,261) - lu(k,1960) * b(k,253) + b(k,255) = b(k,255) - lu(k,2006) * b(k,254) + b(k,256) = b(k,256) - lu(k,2007) * b(k,254) + b(k,257) = b(k,257) - lu(k,2008) * b(k,254) + b(k,258) = b(k,258) - lu(k,2009) * b(k,254) + b(k,259) = b(k,259) - lu(k,2010) * b(k,254) + b(k,260) = b(k,260) - lu(k,2011) * b(k,254) + b(k,261) = b(k,261) - lu(k,2012) * b(k,254) + b(k,256) = b(k,256) - lu(k,2030) * b(k,255) + b(k,257) = b(k,257) - lu(k,2031) * b(k,255) + b(k,258) = b(k,258) - lu(k,2032) * b(k,255) + b(k,259) = b(k,259) - lu(k,2033) * b(k,255) + b(k,260) = b(k,260) - lu(k,2034) * b(k,255) + b(k,261) = b(k,261) - lu(k,2035) * b(k,255) + b(k,257) = b(k,257) - lu(k,2090) * b(k,256) + b(k,258) = b(k,258) - lu(k,2091) * b(k,256) + b(k,259) = b(k,259) - lu(k,2092) * b(k,256) + b(k,260) = b(k,260) - lu(k,2093) * b(k,256) + b(k,261) = b(k,261) - lu(k,2094) * b(k,256) + b(k,258) = b(k,258) - lu(k,2130) * b(k,257) + b(k,259) = b(k,259) - lu(k,2131) * b(k,257) + b(k,260) = b(k,260) - lu(k,2132) * b(k,257) + b(k,261) = b(k,261) - lu(k,2133) * b(k,257) + b(k,259) = b(k,259) - lu(k,2193) * b(k,258) + b(k,260) = b(k,260) - lu(k,2194) * b(k,258) + b(k,261) = b(k,261) - lu(k,2195) * b(k,258) + b(k,260) = b(k,260) - lu(k,2312) * b(k,259) + b(k,261) = b(k,261) - lu(k,2313) * b(k,259) + b(k,261) = b(k,261) - lu(k,2339) * b(k,260) + 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 +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,261) = b(k,261) * lu(k,2365) + b(k,260) = b(k,260) - lu(k,2364) * b(k,261) + b(k,259) = b(k,259) - lu(k,2363) * b(k,261) + b(k,258) = b(k,258) - lu(k,2362) * b(k,261) + b(k,257) = b(k,257) - lu(k,2361) * b(k,261) + b(k,256) = b(k,256) - lu(k,2360) * b(k,261) + b(k,255) = b(k,255) - lu(k,2359) * b(k,261) + b(k,254) = b(k,254) - lu(k,2358) * b(k,261) + b(k,253) = b(k,253) - lu(k,2357) * b(k,261) + b(k,252) = b(k,252) - lu(k,2356) * b(k,261) + b(k,251) = b(k,251) - lu(k,2355) * b(k,261) + b(k,250) = b(k,250) - lu(k,2354) * b(k,261) + b(k,249) = b(k,249) - lu(k,2353) * b(k,261) + b(k,248) = b(k,248) - lu(k,2352) * b(k,261) + b(k,247) = b(k,247) - lu(k,2351) * b(k,261) + b(k,246) = b(k,246) - lu(k,2350) * b(k,261) + b(k,245) = b(k,245) - lu(k,2349) * b(k,261) + b(k,244) = b(k,244) - lu(k,2348) * b(k,261) + b(k,243) = b(k,243) - lu(k,2347) * b(k,261) + b(k,242) = b(k,242) - lu(k,2346) * b(k,261) + b(k,235) = b(k,235) - lu(k,2345) * b(k,261) + b(k,209) = b(k,209) - lu(k,2344) * b(k,261) + b(k,208) = b(k,208) - lu(k,2343) * b(k,261) + b(k,133) = b(k,133) - lu(k,2342) * b(k,261) + b(k,125) = b(k,125) - lu(k,2341) * b(k,261) + b(k,103) = b(k,103) - lu(k,2340) * b(k,261) + b(k,260) = b(k,260) * lu(k,2338) + b(k,259) = b(k,259) - lu(k,2337) * b(k,260) + b(k,258) = b(k,258) - lu(k,2336) * b(k,260) + b(k,257) = b(k,257) - lu(k,2335) * b(k,260) + b(k,256) = b(k,256) - lu(k,2334) * b(k,260) + b(k,255) = b(k,255) - lu(k,2333) * b(k,260) + b(k,254) = b(k,254) - lu(k,2332) * b(k,260) + b(k,253) = b(k,253) - lu(k,2331) * b(k,260) + b(k,252) = b(k,252) - lu(k,2330) * b(k,260) + b(k,251) = b(k,251) - lu(k,2329) * b(k,260) + b(k,250) = b(k,250) - lu(k,2328) * b(k,260) + b(k,249) = b(k,249) - lu(k,2327) * b(k,260) + b(k,248) = b(k,248) - lu(k,2326) * b(k,260) + b(k,247) = b(k,247) - lu(k,2325) * b(k,260) + b(k,246) = b(k,246) - lu(k,2324) * b(k,260) + b(k,245) = b(k,245) - lu(k,2323) * b(k,260) + b(k,243) = b(k,243) - lu(k,2322) * b(k,260) + b(k,235) = b(k,235) - lu(k,2321) * b(k,260) + b(k,213) = b(k,213) - lu(k,2320) * b(k,260) + b(k,208) = b(k,208) - lu(k,2319) * b(k,260) + b(k,203) = b(k,203) - lu(k,2318) * b(k,260) + b(k,137) = b(k,137) - lu(k,2317) * b(k,260) + b(k,118) = b(k,118) - lu(k,2316) * b(k,260) + b(k,107) = b(k,107) - lu(k,2315) * b(k,260) + b(k,89) = b(k,89) - lu(k,2314) * b(k,260) + b(k,259) = b(k,259) * lu(k,2311) + b(k,258) = b(k,258) - lu(k,2310) * b(k,259) + b(k,257) = b(k,257) - lu(k,2309) * b(k,259) + b(k,256) = b(k,256) - lu(k,2308) * b(k,259) + b(k,255) = b(k,255) - lu(k,2307) * b(k,259) + b(k,254) = b(k,254) - lu(k,2306) * b(k,259) + b(k,253) = b(k,253) - lu(k,2305) * b(k,259) + b(k,252) = b(k,252) - lu(k,2304) * b(k,259) + b(k,251) = b(k,251) - lu(k,2303) * b(k,259) + b(k,250) = b(k,250) - lu(k,2302) * b(k,259) + b(k,249) = b(k,249) - lu(k,2301) * b(k,259) + b(k,248) = b(k,248) - lu(k,2300) * b(k,259) + b(k,247) = b(k,247) - lu(k,2299) * b(k,259) + b(k,246) = b(k,246) - lu(k,2298) * b(k,259) + b(k,245) = b(k,245) - lu(k,2297) * b(k,259) + b(k,244) = b(k,244) - lu(k,2296) * b(k,259) + b(k,243) = b(k,243) - lu(k,2295) * b(k,259) + b(k,242) = b(k,242) - lu(k,2294) * b(k,259) + b(k,241) = b(k,241) - lu(k,2293) * b(k,259) + b(k,240) = b(k,240) - lu(k,2292) * b(k,259) + b(k,239) = b(k,239) - lu(k,2291) * b(k,259) + b(k,238) = b(k,238) - lu(k,2290) * b(k,259) + b(k,237) = b(k,237) - lu(k,2289) * b(k,259) + b(k,236) = b(k,236) - lu(k,2288) * b(k,259) + b(k,234) = b(k,234) - lu(k,2287) * b(k,259) + b(k,233) = b(k,233) - lu(k,2286) * b(k,259) + b(k,232) = b(k,232) - lu(k,2285) * b(k,259) + b(k,231) = b(k,231) - lu(k,2284) * b(k,259) + b(k,230) = b(k,230) - lu(k,2283) * b(k,259) + b(k,229) = b(k,229) - lu(k,2282) * b(k,259) + b(k,228) = b(k,228) - lu(k,2281) * b(k,259) + b(k,227) = b(k,227) - lu(k,2280) * b(k,259) + b(k,225) = b(k,225) - lu(k,2279) * b(k,259) + b(k,224) = b(k,224) - lu(k,2278) * b(k,259) + b(k,223) = b(k,223) - lu(k,2277) * b(k,259) + b(k,222) = b(k,222) - lu(k,2276) * b(k,259) + b(k,221) = b(k,221) - lu(k,2275) * b(k,259) + b(k,218) = b(k,218) - lu(k,2274) * b(k,259) + b(k,216) = b(k,216) - lu(k,2273) * b(k,259) + b(k,215) = b(k,215) - lu(k,2272) * b(k,259) + b(k,214) = b(k,214) - lu(k,2271) * b(k,259) + b(k,212) = b(k,212) - lu(k,2270) * b(k,259) + b(k,210) = b(k,210) - lu(k,2269) * b(k,259) + b(k,207) = b(k,207) - lu(k,2268) * b(k,259) + b(k,205) = b(k,205) - lu(k,2267) * b(k,259) + b(k,204) = b(k,204) - lu(k,2266) * b(k,259) + b(k,203) = b(k,203) - lu(k,2265) * b(k,259) + b(k,202) = b(k,202) - lu(k,2264) * b(k,259) + b(k,201) = b(k,201) - lu(k,2263) * b(k,259) + b(k,199) = b(k,199) - lu(k,2262) * b(k,259) + b(k,198) = b(k,198) - lu(k,2261) * b(k,259) + b(k,197) = b(k,197) - lu(k,2260) * b(k,259) + b(k,196) = b(k,196) - lu(k,2259) * b(k,259) + b(k,195) = b(k,195) - lu(k,2258) * b(k,259) + b(k,194) = b(k,194) - lu(k,2257) * b(k,259) + b(k,193) = b(k,193) - lu(k,2256) * b(k,259) + b(k,192) = b(k,192) - lu(k,2255) * b(k,259) + b(k,191) = b(k,191) - lu(k,2254) * b(k,259) + b(k,190) = b(k,190) - lu(k,2253) * b(k,259) + b(k,189) = b(k,189) - lu(k,2252) * b(k,259) + b(k,188) = b(k,188) - lu(k,2251) * b(k,259) + b(k,187) = b(k,187) - lu(k,2250) * b(k,259) + b(k,185) = b(k,185) - lu(k,2249) * b(k,259) + b(k,184) = b(k,184) - lu(k,2248) * b(k,259) + b(k,181) = b(k,181) - lu(k,2247) * b(k,259) + b(k,179) = b(k,179) - lu(k,2246) * b(k,259) + b(k,173) = b(k,173) - lu(k,2245) * b(k,259) + b(k,170) = b(k,170) - lu(k,2244) * b(k,259) + b(k,167) = b(k,167) - lu(k,2243) * b(k,259) + b(k,166) = b(k,166) - lu(k,2242) * b(k,259) + b(k,164) = b(k,164) - lu(k,2241) * b(k,259) + b(k,163) = b(k,163) - lu(k,2240) * b(k,259) + b(k,161) = b(k,161) - lu(k,2239) * b(k,259) + b(k,160) = b(k,160) - lu(k,2238) * b(k,259) + b(k,159) = b(k,159) - lu(k,2237) * b(k,259) + b(k,158) = b(k,158) - lu(k,2236) * b(k,259) + b(k,157) = b(k,157) - lu(k,2235) * b(k,259) + b(k,156) = b(k,156) - lu(k,2234) * b(k,259) + b(k,153) = b(k,153) - lu(k,2233) * b(k,259) + b(k,152) = b(k,152) - lu(k,2232) * b(k,259) + b(k,151) = b(k,151) - lu(k,2231) * b(k,259) + b(k,150) = b(k,150) - lu(k,2230) * b(k,259) + b(k,148) = b(k,148) - lu(k,2229) * b(k,259) + b(k,147) = b(k,147) - lu(k,2228) * b(k,259) + b(k,143) = b(k,143) - lu(k,2227) * b(k,259) + b(k,142) = b(k,142) - lu(k,2226) * b(k,259) + b(k,140) = b(k,140) - lu(k,2225) * b(k,259) + b(k,139) = b(k,139) - lu(k,2224) * b(k,259) + b(k,138) = b(k,138) - lu(k,2223) * b(k,259) + b(k,128) = b(k,128) - lu(k,2222) * b(k,259) + b(k,127) = b(k,127) - lu(k,2221) * b(k,259) + b(k,113) = b(k,113) - lu(k,2220) * b(k,259) + b(k,102) = b(k,102) - lu(k,2219) * b(k,259) + b(k,85) = b(k,85) - lu(k,2218) * b(k,259) + b(k,84) = b(k,84) - lu(k,2217) * b(k,259) + b(k,81) = b(k,81) - lu(k,2216) * b(k,259) + b(k,79) = b(k,79) - lu(k,2215) * b(k,259) + b(k,78) = b(k,78) - lu(k,2214) * b(k,259) + b(k,77) = b(k,77) - lu(k,2213) * b(k,259) + b(k,76) = b(k,76) - lu(k,2212) * b(k,259) + b(k,75) = b(k,75) - lu(k,2211) * b(k,259) + b(k,74) = b(k,74) - lu(k,2210) * b(k,259) + b(k,73) = b(k,73) - lu(k,2209) * b(k,259) + b(k,72) = b(k,72) - lu(k,2208) * b(k,259) + b(k,71) = b(k,71) - lu(k,2207) * b(k,259) + b(k,70) = b(k,70) - lu(k,2206) * b(k,259) + b(k,69) = b(k,69) - lu(k,2205) * b(k,259) + b(k,68) = b(k,68) - lu(k,2204) * b(k,259) + b(k,67) = b(k,67) - lu(k,2203) * b(k,259) + b(k,66) = b(k,66) - lu(k,2202) * b(k,259) + b(k,64) = b(k,64) - lu(k,2201) * b(k,259) + b(k,63) = b(k,63) - lu(k,2200) * b(k,259) + b(k,62) = b(k,62) - lu(k,2199) * b(k,259) + b(k,61) = b(k,61) - lu(k,2198) * b(k,259) + b(k,60) = b(k,60) - lu(k,2197) * b(k,259) + b(k,59) = b(k,59) - lu(k,2196) * b(k,259) + b(k,258) = b(k,258) * lu(k,2192) + b(k,257) = b(k,257) - lu(k,2191) * b(k,258) + b(k,256) = b(k,256) - lu(k,2190) * b(k,258) + b(k,255) = b(k,255) - lu(k,2189) * b(k,258) + b(k,254) = b(k,254) - lu(k,2188) * b(k,258) + b(k,253) = b(k,253) - lu(k,2187) * b(k,258) + b(k,252) = b(k,252) - lu(k,2186) * b(k,258) + b(k,251) = b(k,251) - lu(k,2185) * b(k,258) + b(k,250) = b(k,250) - lu(k,2184) * b(k,258) + b(k,249) = b(k,249) - lu(k,2183) * b(k,258) + b(k,248) = b(k,248) - lu(k,2182) * b(k,258) + b(k,247) = b(k,247) - lu(k,2181) * b(k,258) + b(k,246) = b(k,246) - lu(k,2180) * b(k,258) + b(k,245) = b(k,245) - lu(k,2179) * b(k,258) + b(k,244) = b(k,244) - lu(k,2178) * b(k,258) + b(k,243) = b(k,243) - lu(k,2177) * b(k,258) + b(k,241) = b(k,241) - lu(k,2176) * b(k,258) + b(k,240) = b(k,240) - lu(k,2175) * b(k,258) + b(k,239) = b(k,239) - lu(k,2174) * b(k,258) + b(k,238) = b(k,238) - lu(k,2173) * b(k,258) + b(k,237) = b(k,237) - lu(k,2172) * b(k,258) + b(k,236) = b(k,236) - lu(k,2171) * b(k,258) + b(k,235) = b(k,235) - lu(k,2170) * b(k,258) + b(k,234) = b(k,234) - lu(k,2169) * b(k,258) + b(k,233) = b(k,233) - lu(k,2168) * b(k,258) + b(k,232) = b(k,232) - lu(k,2167) * b(k,258) + b(k,230) = b(k,230) - lu(k,2166) * b(k,258) + b(k,229) = b(k,229) - lu(k,2165) * b(k,258) + b(k,228) = b(k,228) - lu(k,2164) * b(k,258) + b(k,227) = b(k,227) - lu(k,2163) * b(k,258) + b(k,225) = b(k,225) - lu(k,2162) * b(k,258) + b(k,224) = b(k,224) - lu(k,2161) * b(k,258) + b(k,223) = b(k,223) - lu(k,2160) * b(k,258) + b(k,222) = b(k,222) - lu(k,2159) * b(k,258) + b(k,221) = b(k,221) - lu(k,2158) * b(k,258) + b(k,219) = b(k,219) - lu(k,2157) * b(k,258) + b(k,218) = b(k,218) - lu(k,2156) * b(k,258) + b(k,217) = b(k,217) - lu(k,2155) * b(k,258) + b(k,216) = b(k,216) - lu(k,2154) * b(k,258) + b(k,215) = b(k,215) - lu(k,2153) * b(k,258) + b(k,214) = b(k,214) - lu(k,2152) * b(k,258) + b(k,212) = b(k,212) - lu(k,2151) * b(k,258) + b(k,211) = b(k,211) - lu(k,2150) * b(k,258) + b(k,208) = b(k,208) - lu(k,2149) * b(k,258) + b(k,206) = b(k,206) - lu(k,2148) * b(k,258) + b(k,205) = b(k,205) - lu(k,2147) * b(k,258) + b(k,192) = b(k,192) - lu(k,2146) * b(k,258) + b(k,190) = b(k,190) - lu(k,2145) * b(k,258) + b(k,184) = b(k,184) - lu(k,2144) * b(k,258) + b(k,175) = b(k,175) - lu(k,2143) * b(k,258) + b(k,169) = b(k,169) - lu(k,2142) * b(k,258) + b(k,164) = b(k,164) - lu(k,2141) * b(k,258) + b(k,149) = b(k,149) - lu(k,2140) * b(k,258) + b(k,116) = b(k,116) - lu(k,2139) * b(k,258) + b(k,70) = b(k,70) - lu(k,2138) * b(k,258) + b(k,69) = b(k,69) - lu(k,2137) * b(k,258) + b(k,68) = b(k,68) - lu(k,2136) * b(k,258) + b(k,67) = b(k,67) - lu(k,2135) * b(k,258) + b(k,66) = b(k,66) - lu(k,2134) * b(k,258) + 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,257) = b(k,257) * lu(k,2129) + b(k,256) = b(k,256) - lu(k,2128) * b(k,257) + b(k,255) = b(k,255) - lu(k,2127) * b(k,257) + b(k,254) = b(k,254) - lu(k,2126) * b(k,257) + b(k,253) = b(k,253) - lu(k,2125) * b(k,257) + b(k,252) = b(k,252) - lu(k,2124) * b(k,257) + b(k,251) = b(k,251) - lu(k,2123) * b(k,257) + b(k,250) = b(k,250) - lu(k,2122) * b(k,257) + b(k,249) = b(k,249) - lu(k,2121) * b(k,257) + b(k,248) = b(k,248) - lu(k,2120) * b(k,257) + b(k,247) = b(k,247) - lu(k,2119) * b(k,257) + b(k,246) = b(k,246) - lu(k,2118) * b(k,257) + b(k,245) = b(k,245) - lu(k,2117) * b(k,257) + b(k,244) = b(k,244) - lu(k,2116) * b(k,257) + b(k,243) = b(k,243) - lu(k,2115) * b(k,257) + b(k,242) = b(k,242) - lu(k,2114) * b(k,257) + b(k,241) = b(k,241) - lu(k,2113) * b(k,257) + b(k,225) = b(k,225) - lu(k,2112) * b(k,257) + b(k,222) = b(k,222) - lu(k,2111) * b(k,257) + b(k,221) = b(k,221) - lu(k,2110) * b(k,257) + b(k,216) = b(k,216) - lu(k,2109) * b(k,257) + b(k,215) = b(k,215) - lu(k,2108) * b(k,257) + b(k,213) = b(k,213) - lu(k,2107) * b(k,257) + b(k,204) = b(k,204) - lu(k,2106) * b(k,257) + b(k,203) = b(k,203) - lu(k,2105) * b(k,257) + b(k,192) = b(k,192) - lu(k,2104) * b(k,257) + b(k,181) = b(k,181) - lu(k,2103) * b(k,257) + b(k,178) = b(k,178) - lu(k,2102) * b(k,257) + b(k,175) = b(k,175) - lu(k,2101) * b(k,257) + b(k,162) = b(k,162) - lu(k,2100) * b(k,257) + b(k,154) = b(k,154) - lu(k,2099) * b(k,257) + b(k,145) = b(k,145) - lu(k,2098) * b(k,257) + b(k,131) = b(k,131) - lu(k,2097) * b(k,257) + b(k,130) = b(k,130) - lu(k,2096) * b(k,257) + b(k,107) = b(k,107) - lu(k,2095) * b(k,257) + b(k,256) = b(k,256) * lu(k,2089) + b(k,255) = b(k,255) - lu(k,2088) * b(k,256) + b(k,254) = b(k,254) - lu(k,2087) * b(k,256) + b(k,253) = b(k,253) - lu(k,2086) * b(k,256) + b(k,252) = b(k,252) - lu(k,2085) * b(k,256) + b(k,251) = b(k,251) - lu(k,2084) * b(k,256) + b(k,250) = b(k,250) - lu(k,2083) * b(k,256) + b(k,249) = b(k,249) - lu(k,2082) * b(k,256) + b(k,248) = b(k,248) - lu(k,2081) * b(k,256) + b(k,247) = b(k,247) - lu(k,2080) * b(k,256) + b(k,246) = b(k,246) - lu(k,2079) * b(k,256) + b(k,245) = b(k,245) - lu(k,2078) * b(k,256) + b(k,244) = b(k,244) - lu(k,2077) * b(k,256) + b(k,243) = b(k,243) - lu(k,2076) * b(k,256) + b(k,241) = b(k,241) - lu(k,2075) * b(k,256) + b(k,240) = b(k,240) - lu(k,2074) * b(k,256) + b(k,239) = b(k,239) - lu(k,2073) * b(k,256) + b(k,238) = b(k,238) - lu(k,2072) * b(k,256) + b(k,237) = b(k,237) - lu(k,2071) * b(k,256) + b(k,236) = b(k,236) - lu(k,2070) * b(k,256) + b(k,235) = b(k,235) - lu(k,2069) * b(k,256) + b(k,234) = b(k,234) - lu(k,2068) * b(k,256) + b(k,233) = b(k,233) - lu(k,2067) * b(k,256) + b(k,232) = b(k,232) - lu(k,2066) * b(k,256) + b(k,231) = b(k,231) - lu(k,2065) * b(k,256) + b(k,230) = b(k,230) - lu(k,2064) * b(k,256) + b(k,229) = b(k,229) - lu(k,2063) * b(k,256) + b(k,228) = b(k,228) - lu(k,2062) * b(k,256) + b(k,227) = b(k,227) - lu(k,2061) * b(k,256) + b(k,226) = b(k,226) - lu(k,2060) * b(k,256) + b(k,225) = b(k,225) - lu(k,2059) * b(k,256) + b(k,224) = b(k,224) - lu(k,2058) * b(k,256) + b(k,223) = b(k,223) - lu(k,2057) * b(k,256) + b(k,222) = b(k,222) - lu(k,2056) * b(k,256) + b(k,221) = b(k,221) - lu(k,2055) * b(k,256) + b(k,220) = b(k,220) - lu(k,2054) * b(k,256) + b(k,219) = b(k,219) - lu(k,2053) * b(k,256) + b(k,218) = b(k,218) - lu(k,2052) * b(k,256) + b(k,217) = b(k,217) - lu(k,2051) * b(k,256) + b(k,216) = b(k,216) - lu(k,2050) * b(k,256) + b(k,215) = b(k,215) - lu(k,2049) * b(k,256) + b(k,214) = b(k,214) - lu(k,2048) * b(k,256) + b(k,212) = b(k,212) - lu(k,2047) * b(k,256) + b(k,211) = b(k,211) - lu(k,2046) * b(k,256) + b(k,208) = b(k,208) - lu(k,2045) * b(k,256) + b(k,207) = b(k,207) - lu(k,2044) * b(k,256) + b(k,206) = b(k,206) - lu(k,2043) * b(k,256) + b(k,176) = b(k,176) - lu(k,2042) * b(k,256) + b(k,144) = b(k,144) - lu(k,2041) * b(k,256) + b(k,141) = b(k,141) - lu(k,2040) * b(k,256) + b(k,135) = b(k,135) - lu(k,2039) * b(k,256) + b(k,134) = b(k,134) - lu(k,2038) * b(k,256) + b(k,70) = b(k,70) - lu(k,2037) * b(k,256) + b(k,69) = b(k,69) - lu(k,2036) * b(k,256) + b(k,255) = b(k,255) * lu(k,2029) + b(k,254) = b(k,254) - lu(k,2028) * b(k,255) + b(k,253) = b(k,253) - lu(k,2027) * b(k,255) + b(k,252) = b(k,252) - lu(k,2026) * b(k,255) + b(k,251) = b(k,251) - lu(k,2025) * b(k,255) + b(k,250) = b(k,250) - lu(k,2024) * b(k,255) + b(k,249) = b(k,249) - lu(k,2023) * b(k,255) + b(k,248) = b(k,248) - lu(k,2022) * b(k,255) + b(k,247) = b(k,247) - lu(k,2021) * b(k,255) + b(k,246) = b(k,246) - lu(k,2020) * b(k,255) + b(k,245) = b(k,245) - lu(k,2019) * b(k,255) + b(k,243) = b(k,243) - lu(k,2018) * b(k,255) + b(k,213) = b(k,213) - lu(k,2017) * b(k,255) + b(k,203) = b(k,203) - lu(k,2016) * b(k,255) + b(k,199) = b(k,199) - lu(k,2015) * b(k,255) + b(k,118) = b(k,118) - lu(k,2014) * b(k,255) + b(k,107) = b(k,107) - lu(k,2013) * b(k,255) + b(k,254) = b(k,254) * lu(k,2005) + b(k,253) = b(k,253) - lu(k,2004) * b(k,254) + b(k,252) = b(k,252) - lu(k,2003) * b(k,254) + b(k,251) = b(k,251) - lu(k,2002) * b(k,254) + b(k,250) = b(k,250) - lu(k,2001) * b(k,254) + b(k,249) = b(k,249) - lu(k,2000) * b(k,254) + b(k,248) = b(k,248) - lu(k,1999) * b(k,254) + b(k,247) = b(k,247) - lu(k,1998) * b(k,254) + b(k,246) = b(k,246) - lu(k,1997) * b(k,254) + b(k,245) = b(k,245) - lu(k,1996) * b(k,254) + b(k,244) = b(k,244) - lu(k,1995) * b(k,254) + b(k,241) = b(k,241) - lu(k,1994) * b(k,254) + b(k,240) = b(k,240) - lu(k,1993) * b(k,254) + b(k,239) = b(k,239) - lu(k,1992) * b(k,254) + b(k,238) = b(k,238) - lu(k,1991) * b(k,254) + b(k,237) = b(k,237) - lu(k,1990) * b(k,254) + b(k,236) = b(k,236) - lu(k,1989) * b(k,254) + b(k,234) = b(k,234) - lu(k,1988) * b(k,254) + b(k,233) = b(k,233) - lu(k,1987) * b(k,254) + b(k,232) = b(k,232) - lu(k,1986) * b(k,254) + b(k,231) = b(k,231) - lu(k,1985) * b(k,254) + b(k,230) = b(k,230) - lu(k,1984) * b(k,254) + b(k,229) = b(k,229) - lu(k,1983) * b(k,254) + b(k,228) = b(k,228) - lu(k,1982) * b(k,254) + b(k,227) = b(k,227) - lu(k,1981) * b(k,254) + b(k,225) = b(k,225) - lu(k,1980) * b(k,254) + b(k,224) = b(k,224) - lu(k,1979) * b(k,254) + b(k,223) = b(k,223) - lu(k,1978) * b(k,254) + b(k,222) = b(k,222) - lu(k,1977) * b(k,254) + b(k,221) = b(k,221) - lu(k,1976) * b(k,254) + b(k,220) = b(k,220) - lu(k,1975) * b(k,254) + b(k,218) = b(k,218) - lu(k,1974) * b(k,254) + b(k,216) = b(k,216) - lu(k,1973) * b(k,254) + b(k,214) = b(k,214) - lu(k,1972) * b(k,254) + b(k,207) = b(k,207) - lu(k,1971) * b(k,254) + b(k,205) = b(k,205) - lu(k,1970) * b(k,254) + b(k,204) = b(k,204) - lu(k,1969) * b(k,254) + b(k,201) = b(k,201) - lu(k,1968) * b(k,254) + b(k,200) = b(k,200) - lu(k,1967) * b(k,254) + b(k,190) = b(k,190) - lu(k,1966) * b(k,254) + b(k,183) = b(k,183) - lu(k,1965) * b(k,254) + b(k,155) = b(k,155) - lu(k,1964) * b(k,254) + b(k,153) = b(k,153) - lu(k,1963) * b(k,254) + b(k,141) = b(k,141) - lu(k,1962) * b(k,254) + b(k,126) = b(k,126) - lu(k,1961) * b(k,254) + b(k,253) = b(k,253) * lu(k,1952) + b(k,252) = b(k,252) - lu(k,1951) * b(k,253) + b(k,251) = b(k,251) - lu(k,1950) * b(k,253) + b(k,250) = b(k,250) - lu(k,1949) * b(k,253) + b(k,249) = b(k,249) - lu(k,1948) * b(k,253) + b(k,248) = b(k,248) - lu(k,1947) * b(k,253) + b(k,247) = b(k,247) - lu(k,1946) * b(k,253) + b(k,246) = b(k,246) - lu(k,1945) * b(k,253) + b(k,245) = b(k,245) - lu(k,1944) * b(k,253) + b(k,244) = b(k,244) - lu(k,1943) * b(k,253) + b(k,243) = b(k,243) - lu(k,1942) * b(k,253) + b(k,241) = b(k,241) - lu(k,1941) * b(k,253) + b(k,240) = b(k,240) - lu(k,1940) * b(k,253) + b(k,239) = b(k,239) - lu(k,1939) * b(k,253) + b(k,238) = b(k,238) - lu(k,1938) * b(k,253) + b(k,237) = b(k,237) - lu(k,1937) * b(k,253) + b(k,236) = b(k,236) - lu(k,1936) * b(k,253) + b(k,234) = b(k,234) - lu(k,1935) * b(k,253) + b(k,233) = b(k,233) - lu(k,1934) * b(k,253) + b(k,232) = b(k,232) - lu(k,1933) * b(k,253) + b(k,231) = b(k,231) - lu(k,1932) * b(k,253) + b(k,230) = b(k,230) - lu(k,1931) * b(k,253) + b(k,229) = b(k,229) - lu(k,1930) * b(k,253) + b(k,228) = b(k,228) - lu(k,1929) * b(k,253) + b(k,227) = b(k,227) - lu(k,1928) * b(k,253) + b(k,226) = b(k,226) - lu(k,1927) * b(k,253) + b(k,225) = b(k,225) - lu(k,1926) * b(k,253) + b(k,224) = b(k,224) - lu(k,1925) * b(k,253) + b(k,223) = b(k,223) - lu(k,1924) * b(k,253) + b(k,222) = b(k,222) - lu(k,1923) * b(k,253) + b(k,221) = b(k,221) - lu(k,1922) * b(k,253) + b(k,220) = b(k,220) - lu(k,1921) * b(k,253) + b(k,218) = b(k,218) - lu(k,1920) * b(k,253) + b(k,216) = b(k,216) - lu(k,1919) * b(k,253) + b(k,215) = b(k,215) - lu(k,1918) * b(k,253) + b(k,214) = b(k,214) - lu(k,1917) * b(k,253) + b(k,212) = b(k,212) - lu(k,1916) * b(k,253) + b(k,210) = b(k,210) - lu(k,1915) * b(k,253) + b(k,207) = b(k,207) - lu(k,1914) * b(k,253) + b(k,205) = b(k,205) - lu(k,1913) * b(k,253) + b(k,204) = b(k,204) - lu(k,1912) * b(k,253) + b(k,201) = b(k,201) - lu(k,1911) * b(k,253) + b(k,198) = b(k,198) - lu(k,1910) * b(k,253) + b(k,197) = b(k,197) - lu(k,1909) * b(k,253) + b(k,196) = b(k,196) - lu(k,1908) * b(k,253) + b(k,194) = b(k,194) - lu(k,1907) * b(k,253) + b(k,193) = b(k,193) - lu(k,1906) * b(k,253) + b(k,192) = b(k,192) - lu(k,1905) * b(k,253) + b(k,187) = b(k,187) - lu(k,1904) * b(k,253) + b(k,186) = b(k,186) - lu(k,1903) * b(k,253) + b(k,184) = b(k,184) - lu(k,1902) * b(k,253) + b(k,183) = b(k,183) - lu(k,1901) * b(k,253) + b(k,180) = b(k,180) - lu(k,1900) * b(k,253) + b(k,177) = b(k,177) - lu(k,1899) * b(k,253) + b(k,176) = b(k,176) - lu(k,1898) * b(k,253) + b(k,174) = b(k,174) - lu(k,1897) * b(k,253) + b(k,170) = b(k,170) - lu(k,1896) * b(k,253) + b(k,168) = b(k,168) - lu(k,1895) * b(k,253) + b(k,167) = b(k,167) - lu(k,1894) * b(k,253) + b(k,166) = b(k,166) - lu(k,1893) * b(k,253) + b(k,165) = b(k,165) - lu(k,1892) * b(k,253) + b(k,164) = b(k,164) - lu(k,1891) * b(k,253) + b(k,161) = b(k,161) - lu(k,1890) * b(k,253) + b(k,160) = b(k,160) - lu(k,1889) * b(k,253) + b(k,159) = b(k,159) - lu(k,1888) * b(k,253) + b(k,158) = b(k,158) - lu(k,1887) * b(k,253) + b(k,141) = b(k,141) - lu(k,1886) * b(k,253) + b(k,136) = b(k,136) - lu(k,1885) * b(k,253) + b(k,129) = b(k,129) - lu(k,1884) * b(k,253) + b(k,128) = b(k,128) - lu(k,1883) * b(k,253) + b(k,119) = b(k,119) - lu(k,1882) * b(k,253) + b(k,117) = b(k,117) - lu(k,1881) * b(k,253) + b(k,85) = b(k,85) - lu(k,1880) * b(k,253) + b(k,84) = b(k,84) - lu(k,1879) * b(k,253) + b(k,81) = b(k,81) - lu(k,1878) * b(k,253) + b(k,79) = b(k,79) - lu(k,1877) * b(k,253) + b(k,78) = b(k,78) - lu(k,1876) * b(k,253) + b(k,77) = b(k,77) - lu(k,1875) * b(k,253) + b(k,76) = b(k,76) - lu(k,1874) * b(k,253) + b(k,75) = b(k,75) - lu(k,1873) * b(k,253) + b(k,74) = b(k,74) - lu(k,1872) * b(k,253) + b(k,73) = b(k,73) - lu(k,1871) * b(k,253) + b(k,72) = b(k,72) - lu(k,1870) * b(k,253) + b(k,71) = b(k,71) - lu(k,1869) * b(k,253) + b(k,70) = b(k,70) - lu(k,1868) * b(k,253) + b(k,69) = b(k,69) - lu(k,1867) * b(k,253) + b(k,68) = b(k,68) - lu(k,1866) * b(k,253) + b(k,67) = b(k,67) - lu(k,1865) * b(k,253) + b(k,66) = b(k,66) - lu(k,1864) * b(k,253) + b(k,64) = b(k,64) - lu(k,1863) * b(k,253) + b(k,63) = b(k,63) - lu(k,1862) * b(k,253) + b(k,62) = b(k,62) - lu(k,1861) * b(k,253) + b(k,61) = b(k,61) - lu(k,1860) * b(k,253) + b(k,60) = b(k,60) - lu(k,1859) * b(k,253) + b(k,59) = b(k,59) - lu(k,1858) * b(k,253) + end do + end subroutine lu_slv08 + subroutine lu_slv09( 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,252) = b(k,252) * lu(k,1848) + b(k,251) = b(k,251) - lu(k,1847) * b(k,252) + b(k,250) = b(k,250) - lu(k,1846) * b(k,252) + b(k,249) = b(k,249) - lu(k,1845) * b(k,252) + b(k,248) = b(k,248) - lu(k,1844) * b(k,252) + b(k,247) = b(k,247) - lu(k,1843) * b(k,252) + b(k,246) = b(k,246) - lu(k,1842) * b(k,252) + b(k,245) = b(k,245) - lu(k,1841) * b(k,252) + b(k,243) = b(k,243) - lu(k,1840) * b(k,252) + b(k,235) = b(k,235) - lu(k,1839) * b(k,252) + b(k,208) = b(k,208) - lu(k,1838) * b(k,252) + b(k,199) = b(k,199) - lu(k,1837) * b(k,252) + b(k,172) = b(k,172) - lu(k,1836) * b(k,252) + b(k,137) = b(k,137) - lu(k,1835) * b(k,252) + b(k,118) = b(k,118) - lu(k,1834) * b(k,252) + b(k,251) = b(k,251) * lu(k,1823) + b(k,250) = b(k,250) - lu(k,1822) * b(k,251) + b(k,249) = b(k,249) - lu(k,1821) * b(k,251) + b(k,248) = b(k,248) - lu(k,1820) * b(k,251) + b(k,247) = b(k,247) - lu(k,1819) * b(k,251) + b(k,246) = b(k,246) - lu(k,1818) * b(k,251) + b(k,245) = b(k,245) - lu(k,1817) * b(k,251) + b(k,244) = b(k,244) - lu(k,1816) * b(k,251) + b(k,243) = b(k,243) - lu(k,1815) * b(k,251) + b(k,242) = b(k,242) - lu(k,1814) * b(k,251) + b(k,241) = b(k,241) - lu(k,1813) * b(k,251) + b(k,240) = b(k,240) - lu(k,1812) * b(k,251) + b(k,239) = b(k,239) - lu(k,1811) * b(k,251) + b(k,238) = b(k,238) - lu(k,1810) * b(k,251) + b(k,237) = b(k,237) - lu(k,1809) * b(k,251) + b(k,236) = b(k,236) - lu(k,1808) * b(k,251) + b(k,235) = b(k,235) - lu(k,1807) * b(k,251) + b(k,234) = b(k,234) - lu(k,1806) * b(k,251) + b(k,233) = b(k,233) - lu(k,1805) * b(k,251) + b(k,232) = b(k,232) - lu(k,1804) * b(k,251) + b(k,231) = b(k,231) - lu(k,1803) * b(k,251) + b(k,230) = b(k,230) - lu(k,1802) * b(k,251) + b(k,229) = b(k,229) - lu(k,1801) * b(k,251) + b(k,228) = b(k,228) - lu(k,1800) * b(k,251) + b(k,227) = b(k,227) - lu(k,1799) * b(k,251) + b(k,226) = b(k,226) - lu(k,1798) * b(k,251) + b(k,225) = b(k,225) - lu(k,1797) * b(k,251) + b(k,224) = b(k,224) - lu(k,1796) * b(k,251) + b(k,223) = b(k,223) - lu(k,1795) * b(k,251) + b(k,222) = b(k,222) - lu(k,1794) * b(k,251) + b(k,221) = b(k,221) - lu(k,1793) * b(k,251) + b(k,220) = b(k,220) - lu(k,1792) * b(k,251) + b(k,219) = b(k,219) - lu(k,1791) * b(k,251) + b(k,218) = b(k,218) - lu(k,1790) * b(k,251) + b(k,217) = b(k,217) - lu(k,1789) * b(k,251) + b(k,216) = b(k,216) - lu(k,1788) * b(k,251) + b(k,215) = b(k,215) - lu(k,1787) * b(k,251) + b(k,214) = b(k,214) - lu(k,1786) * b(k,251) + b(k,213) = b(k,213) - lu(k,1785) * b(k,251) + b(k,212) = b(k,212) - lu(k,1784) * b(k,251) + b(k,211) = b(k,211) - lu(k,1783) * b(k,251) + b(k,210) = b(k,210) - lu(k,1782) * b(k,251) + b(k,209) = b(k,209) - lu(k,1781) * b(k,251) + b(k,208) = b(k,208) - lu(k,1780) * b(k,251) + b(k,207) = b(k,207) - lu(k,1779) * b(k,251) + b(k,206) = b(k,206) - lu(k,1778) * b(k,251) + b(k,205) = b(k,205) - lu(k,1777) * b(k,251) + b(k,204) = b(k,204) - lu(k,1776) * b(k,251) + b(k,203) = b(k,203) - lu(k,1775) * b(k,251) + b(k,202) = b(k,202) - lu(k,1774) * b(k,251) + b(k,201) = b(k,201) - lu(k,1773) * b(k,251) + b(k,200) = b(k,200) - lu(k,1772) * b(k,251) + b(k,198) = b(k,198) - lu(k,1771) * b(k,251) + b(k,197) = b(k,197) - lu(k,1770) * b(k,251) + b(k,196) = b(k,196) - lu(k,1769) * b(k,251) + b(k,195) = b(k,195) - lu(k,1768) * b(k,251) + b(k,194) = b(k,194) - lu(k,1767) * b(k,251) + b(k,193) = b(k,193) - lu(k,1766) * b(k,251) + b(k,192) = b(k,192) - lu(k,1765) * b(k,251) + b(k,191) = b(k,191) - lu(k,1764) * b(k,251) + b(k,190) = b(k,190) - lu(k,1763) * b(k,251) + b(k,189) = b(k,189) - lu(k,1762) * b(k,251) + b(k,188) = b(k,188) - lu(k,1761) * b(k,251) + b(k,187) = b(k,187) - lu(k,1760) * b(k,251) + b(k,186) = b(k,186) - lu(k,1759) * b(k,251) + b(k,185) = b(k,185) - lu(k,1758) * b(k,251) + b(k,184) = b(k,184) - lu(k,1757) * b(k,251) + b(k,183) = b(k,183) - lu(k,1756) * b(k,251) + b(k,182) = b(k,182) - lu(k,1755) * b(k,251) + b(k,181) = b(k,181) - lu(k,1754) * b(k,251) + b(k,180) = b(k,180) - lu(k,1753) * b(k,251) + b(k,179) = b(k,179) - lu(k,1752) * b(k,251) + b(k,178) = b(k,178) - lu(k,1751) * b(k,251) + b(k,177) = b(k,177) - lu(k,1750) * b(k,251) + b(k,176) = b(k,176) - lu(k,1749) * b(k,251) + b(k,175) = b(k,175) - lu(k,1748) * b(k,251) + b(k,174) = b(k,174) - lu(k,1747) * b(k,251) + b(k,173) = b(k,173) - lu(k,1746) * b(k,251) + b(k,171) = b(k,171) - lu(k,1745) * b(k,251) + b(k,170) = b(k,170) - lu(k,1744) * b(k,251) + b(k,169) = b(k,169) - lu(k,1743) * b(k,251) + b(k,168) = b(k,168) - lu(k,1742) * b(k,251) + b(k,167) = b(k,167) - lu(k,1741) * b(k,251) + b(k,166) = b(k,166) - lu(k,1740) * b(k,251) + b(k,165) = b(k,165) - lu(k,1739) * b(k,251) + b(k,164) = b(k,164) - lu(k,1738) * b(k,251) + b(k,163) = b(k,163) - lu(k,1737) * b(k,251) + b(k,162) = b(k,162) - lu(k,1736) * b(k,251) + b(k,161) = b(k,161) - lu(k,1735) * b(k,251) + b(k,160) = b(k,160) - lu(k,1734) * b(k,251) + b(k,158) = b(k,158) - lu(k,1733) * b(k,251) + b(k,157) = b(k,157) - lu(k,1732) * b(k,251) + b(k,156) = b(k,156) - lu(k,1731) * b(k,251) + b(k,155) = b(k,155) - lu(k,1730) * b(k,251) + b(k,154) = b(k,154) - lu(k,1729) * b(k,251) + b(k,153) = b(k,153) - lu(k,1728) * b(k,251) + b(k,152) = b(k,152) - lu(k,1727) * b(k,251) + b(k,151) = b(k,151) - lu(k,1726) * b(k,251) + b(k,150) = b(k,150) - lu(k,1725) * b(k,251) + b(k,148) = b(k,148) - lu(k,1724) * b(k,251) + b(k,147) = b(k,147) - lu(k,1723) * b(k,251) + b(k,146) = b(k,146) - lu(k,1722) * b(k,251) + b(k,145) = b(k,145) - lu(k,1721) * b(k,251) + b(k,144) = b(k,144) - lu(k,1720) * b(k,251) + b(k,143) = b(k,143) - lu(k,1719) * b(k,251) + b(k,142) = b(k,142) - lu(k,1718) * b(k,251) + b(k,141) = b(k,141) - lu(k,1717) * b(k,251) + b(k,140) = b(k,140) - lu(k,1716) * b(k,251) + b(k,139) = b(k,139) - lu(k,1715) * b(k,251) + b(k,138) = b(k,138) - lu(k,1714) * b(k,251) + b(k,135) = b(k,135) - lu(k,1713) * b(k,251) + b(k,132) = b(k,132) - lu(k,1712) * b(k,251) + b(k,131) = b(k,131) - lu(k,1711) * b(k,251) + b(k,130) = b(k,130) - lu(k,1710) * b(k,251) + b(k,127) = b(k,127) - lu(k,1709) * b(k,251) + b(k,126) = b(k,126) - lu(k,1708) * b(k,251) + b(k,125) = b(k,125) - lu(k,1707) * b(k,251) + b(k,124) = b(k,124) - lu(k,1706) * b(k,251) + b(k,123) = b(k,123) - lu(k,1705) * b(k,251) + b(k,122) = b(k,122) - lu(k,1704) * b(k,251) + b(k,121) = b(k,121) - lu(k,1703) * b(k,251) + b(k,120) = b(k,120) - lu(k,1702) * b(k,251) + b(k,119) = b(k,119) - lu(k,1701) * b(k,251) + b(k,117) = b(k,117) - lu(k,1700) * b(k,251) + b(k,116) = b(k,116) - lu(k,1699) * b(k,251) + b(k,115) = b(k,115) - lu(k,1698) * b(k,251) + b(k,114) = b(k,114) - lu(k,1697) * b(k,251) + b(k,113) = b(k,113) - lu(k,1696) * b(k,251) + b(k,112) = b(k,112) - lu(k,1695) * b(k,251) + b(k,111) = b(k,111) - lu(k,1694) * b(k,251) + b(k,110) = b(k,110) - lu(k,1693) * b(k,251) + b(k,109) = b(k,109) - lu(k,1692) * b(k,251) + b(k,106) = b(k,106) - lu(k,1691) * b(k,251) + b(k,105) = b(k,105) - lu(k,1690) * b(k,251) + b(k,104) = b(k,104) - lu(k,1689) * b(k,251) + b(k,96) = b(k,96) - lu(k,1688) * b(k,251) + b(k,95) = b(k,95) - lu(k,1687) * b(k,251) + b(k,91) = b(k,91) - lu(k,1686) * b(k,251) + b(k,88) = b(k,88) - lu(k,1685) * b(k,251) + b(k,86) = b(k,86) - lu(k,1684) * b(k,251) + b(k,85) = b(k,85) - lu(k,1683) * b(k,251) + b(k,84) = b(k,84) - lu(k,1682) * b(k,251) + b(k,83) = b(k,83) - lu(k,1681) * b(k,251) + b(k,82) = b(k,82) - lu(k,1680) * b(k,251) + b(k,81) = b(k,81) - lu(k,1679) * b(k,251) + b(k,80) = b(k,80) - lu(k,1678) * b(k,251) + b(k,79) = b(k,79) - lu(k,1677) * b(k,251) + b(k,78) = b(k,78) - lu(k,1676) * b(k,251) + b(k,77) = b(k,77) - lu(k,1675) * b(k,251) + b(k,76) = b(k,76) - lu(k,1674) * b(k,251) + b(k,75) = b(k,75) - lu(k,1673) * b(k,251) + b(k,74) = b(k,74) - lu(k,1672) * b(k,251) + b(k,73) = b(k,73) - lu(k,1671) * b(k,251) + b(k,72) = b(k,72) - lu(k,1670) * b(k,251) + b(k,71) = b(k,71) - lu(k,1669) * b(k,251) + b(k,65) = b(k,65) - lu(k,1668) * b(k,251) + b(k,64) = b(k,64) - lu(k,1667) * b(k,251) + b(k,63) = b(k,63) - lu(k,1666) * b(k,251) + b(k,62) = b(k,62) - lu(k,1665) * b(k,251) + b(k,61) = b(k,61) - lu(k,1664) * b(k,251) + b(k,60) = b(k,60) - lu(k,1663) * b(k,251) + b(k,59) = b(k,59) - lu(k,1662) * b(k,251) + b(k,250) = b(k,250) * lu(k,1650) + b(k,249) = b(k,249) - lu(k,1649) * b(k,250) + b(k,248) = b(k,248) - lu(k,1648) * b(k,250) + b(k,247) = b(k,247) - lu(k,1647) * b(k,250) + b(k,246) = b(k,246) - lu(k,1646) * b(k,250) + b(k,245) = b(k,245) - lu(k,1645) * b(k,250) + b(k,244) = b(k,244) - lu(k,1644) * b(k,250) + b(k,243) = b(k,243) - lu(k,1643) * b(k,250) + b(k,242) = b(k,242) - lu(k,1642) * b(k,250) + b(k,209) = b(k,209) - lu(k,1641) * b(k,250) + b(k,202) = b(k,202) - lu(k,1640) * b(k,250) + b(k,178) = b(k,178) - lu(k,1639) * b(k,250) + b(k,162) = b(k,162) - lu(k,1638) * b(k,250) + b(k,154) = b(k,154) - lu(k,1637) * b(k,250) + b(k,132) = b(k,132) - lu(k,1636) * b(k,250) + b(k,124) = b(k,124) - lu(k,1635) * b(k,250) + b(k,123) = b(k,123) - lu(k,1634) * b(k,250) + b(k,122) = b(k,122) - lu(k,1633) * b(k,250) + b(k,121) = b(k,121) - lu(k,1632) * b(k,250) + b(k,109) = b(k,109) - lu(k,1631) * b(k,250) + b(k,108) = b(k,108) - lu(k,1630) * b(k,250) + b(k,101) = b(k,101) - lu(k,1629) * b(k,250) + b(k,100) = b(k,100) - lu(k,1628) * b(k,250) + b(k,99) = b(k,99) - lu(k,1627) * b(k,250) + b(k,98) = b(k,98) - lu(k,1626) * b(k,250) + b(k,94) = b(k,94) - lu(k,1625) * b(k,250) + b(k,93) = b(k,93) - lu(k,1624) * b(k,250) + b(k,92) = b(k,92) - lu(k,1623) * b(k,250) + b(k,90) = b(k,90) - lu(k,1622) * b(k,250) + b(k,87) = b(k,87) - lu(k,1621) * b(k,250) + end do + end subroutine lu_slv09 + subroutine lu_slv10( 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,249) = b(k,249) * lu(k,1608) + b(k,248) = b(k,248) - lu(k,1607) * b(k,249) + b(k,247) = b(k,247) - lu(k,1606) * b(k,249) + b(k,246) = b(k,246) - lu(k,1605) * b(k,249) + b(k,245) = b(k,245) - lu(k,1604) * b(k,249) + b(k,244) = b(k,244) - lu(k,1603) * b(k,249) + b(k,243) = b(k,243) - lu(k,1602) * b(k,249) + b(k,242) = b(k,242) - lu(k,1601) * b(k,249) + b(k,235) = b(k,235) - lu(k,1600) * b(k,249) + b(k,225) = b(k,225) - lu(k,1599) * b(k,249) + b(k,213) = b(k,213) - lu(k,1598) * b(k,249) + b(k,208) = b(k,208) - lu(k,1597) * b(k,249) + b(k,203) = b(k,203) - lu(k,1596) * b(k,249) + b(k,202) = b(k,202) - lu(k,1595) * b(k,249) + b(k,199) = b(k,199) - lu(k,1594) * b(k,249) + b(k,181) = b(k,181) - lu(k,1593) * b(k,249) + b(k,172) = b(k,172) - lu(k,1592) * b(k,249) + b(k,169) = b(k,169) - lu(k,1591) * b(k,249) + b(k,146) = b(k,146) - lu(k,1590) * b(k,249) + b(k,248) = b(k,248) * lu(k,1576) + b(k,247) = b(k,247) - lu(k,1575) * b(k,248) + b(k,246) = b(k,246) - lu(k,1574) * b(k,248) + b(k,245) = b(k,245) - lu(k,1573) * b(k,248) + b(k,244) = b(k,244) - lu(k,1572) * b(k,248) + b(k,243) = b(k,243) - lu(k,1571) * b(k,248) + b(k,241) = b(k,241) - lu(k,1570) * b(k,248) + b(k,240) = b(k,240) - lu(k,1569) * b(k,248) + b(k,235) = b(k,235) - lu(k,1568) * b(k,248) + b(k,234) = b(k,234) - lu(k,1567) * b(k,248) + b(k,227) = b(k,227) - lu(k,1566) * b(k,248) + b(k,225) = b(k,225) - lu(k,1565) * b(k,248) + b(k,216) = b(k,216) - lu(k,1564) * b(k,248) + b(k,213) = b(k,213) - lu(k,1563) * b(k,248) + b(k,210) = b(k,210) - lu(k,1562) * b(k,248) + b(k,208) = b(k,208) - lu(k,1561) * b(k,248) + b(k,205) = b(k,205) - lu(k,1560) * b(k,248) + b(k,199) = b(k,199) - lu(k,1559) * b(k,248) + b(k,197) = b(k,197) - lu(k,1558) * b(k,248) + b(k,193) = b(k,193) - lu(k,1557) * b(k,248) + b(k,184) = b(k,184) - lu(k,1556) * b(k,248) + b(k,182) = b(k,182) - lu(k,1555) * b(k,248) + b(k,172) = b(k,172) - lu(k,1554) * b(k,248) + b(k,171) = b(k,171) - lu(k,1553) * b(k,248) + b(k,170) = b(k,170) - lu(k,1552) * b(k,248) + b(k,165) = b(k,165) - lu(k,1551) * b(k,248) + b(k,164) = b(k,164) - lu(k,1550) * b(k,248) + b(k,151) = b(k,151) - lu(k,1549) * b(k,248) + b(k,134) = b(k,134) - lu(k,1548) * b(k,248) + b(k,108) = b(k,108) - lu(k,1547) * b(k,248) + b(k,97) = b(k,97) - lu(k,1546) * b(k,248) + b(k,247) = b(k,247) * lu(k,1532) + b(k,246) = b(k,246) - lu(k,1531) * b(k,247) + b(k,245) = b(k,245) - lu(k,1530) * b(k,247) + b(k,244) = b(k,244) - lu(k,1529) * b(k,247) + b(k,243) = b(k,243) - lu(k,1528) * b(k,247) + b(k,242) = b(k,242) - lu(k,1527) * b(k,247) + b(k,225) = b(k,225) - lu(k,1526) * b(k,247) + b(k,215) = b(k,215) - lu(k,1525) * b(k,247) + b(k,202) = b(k,202) - lu(k,1524) * b(k,247) + b(k,159) = b(k,159) - lu(k,1523) * b(k,247) + b(k,246) = b(k,246) * lu(k,1510) + b(k,245) = b(k,245) - lu(k,1509) * b(k,246) + b(k,244) = b(k,244) - lu(k,1508) * b(k,246) + b(k,242) = b(k,242) - lu(k,1507) * b(k,246) + b(k,245) = b(k,245) * lu(k,1494) + b(k,244) = b(k,244) - lu(k,1493) * b(k,245) + b(k,242) = b(k,242) - lu(k,1492) * b(k,245) + b(k,209) = b(k,209) - lu(k,1491) * b(k,245) + b(k,133) = b(k,133) - lu(k,1490) * b(k,245) + b(k,244) = b(k,244) * lu(k,1477) + b(k,242) = b(k,242) - lu(k,1476) * b(k,244) + b(k,225) = b(k,225) - lu(k,1475) * b(k,244) + b(k,209) = b(k,209) - lu(k,1474) * b(k,244) + b(k,205) = b(k,205) - lu(k,1473) * b(k,244) + b(k,133) = b(k,133) - lu(k,1472) * b(k,244) + b(k,243) = b(k,243) * lu(k,1462) + b(k,225) = b(k,225) - lu(k,1461) * b(k,243) + b(k,202) = b(k,202) - lu(k,1460) * b(k,243) + b(k,242) = b(k,242) * lu(k,1448) + b(k,209) = b(k,209) - lu(k,1447) * b(k,242) + b(k,133) = b(k,133) - lu(k,1446) * b(k,242) + b(k,241) = b(k,241) * lu(k,1433) + b(k,240) = b(k,240) - lu(k,1432) * b(k,241) + b(k,239) = b(k,239) - lu(k,1431) * b(k,241) + b(k,238) = b(k,238) - lu(k,1430) * b(k,241) + b(k,237) = b(k,237) - lu(k,1429) * b(k,241) + b(k,236) = b(k,236) - lu(k,1428) * b(k,241) + b(k,234) = b(k,234) - lu(k,1427) * b(k,241) + b(k,233) = b(k,233) - lu(k,1426) * b(k,241) + b(k,232) = b(k,232) - lu(k,1425) * b(k,241) + b(k,231) = b(k,231) - lu(k,1424) * b(k,241) + b(k,227) = b(k,227) - lu(k,1423) * b(k,241) + b(k,225) = b(k,225) - lu(k,1422) * b(k,241) + b(k,222) = b(k,222) - lu(k,1421) * b(k,241) + b(k,220) = b(k,220) - lu(k,1420) * b(k,241) + b(k,216) = b(k,216) - lu(k,1419) * b(k,241) + b(k,205) = b(k,205) - lu(k,1418) * b(k,241) + b(k,190) = b(k,190) - lu(k,1417) * b(k,241) + b(k,179) = b(k,179) - lu(k,1416) * b(k,241) + b(k,171) = b(k,171) - lu(k,1415) * b(k,241) + b(k,141) = b(k,141) - lu(k,1414) * b(k,241) + b(k,240) = b(k,240) * lu(k,1401) + b(k,234) = b(k,234) - lu(k,1400) * b(k,240) + b(k,227) = b(k,227) - lu(k,1399) * b(k,240) + b(k,225) = b(k,225) - lu(k,1398) * b(k,240) + b(k,205) = b(k,205) - lu(k,1397) * b(k,240) + b(k,190) = b(k,190) - lu(k,1396) * b(k,240) + b(k,182) = b(k,182) - lu(k,1395) * b(k,240) + b(k,179) = b(k,179) - lu(k,1394) * b(k,240) + b(k,239) = b(k,239) * lu(k,1379) + b(k,238) = b(k,238) - lu(k,1378) * b(k,239) + b(k,234) = b(k,234) - lu(k,1377) * b(k,239) + b(k,227) = b(k,227) - lu(k,1376) * b(k,239) + b(k,225) = b(k,225) - lu(k,1375) * b(k,239) + b(k,221) = b(k,221) - lu(k,1374) * b(k,239) + b(k,219) = b(k,219) - lu(k,1373) * b(k,239) + b(k,215) = b(k,215) - lu(k,1372) * b(k,239) + b(k,205) = b(k,205) - lu(k,1371) * b(k,239) + b(k,238) = b(k,238) * lu(k,1358) + b(k,234) = b(k,234) - lu(k,1357) * b(k,238) + b(k,230) = b(k,230) - lu(k,1356) * b(k,238) + b(k,227) = b(k,227) - lu(k,1355) * b(k,238) + b(k,226) = b(k,226) - lu(k,1354) * b(k,238) + b(k,225) = b(k,225) - lu(k,1353) * b(k,238) + b(k,222) = b(k,222) - lu(k,1352) * b(k,238) + b(k,200) = b(k,200) - lu(k,1351) * b(k,238) + b(k,142) = b(k,142) - lu(k,1350) * b(k,238) + b(k,237) = b(k,237) * lu(k,1334) + b(k,234) = b(k,234) - lu(k,1333) * b(k,237) + b(k,233) = b(k,233) - lu(k,1332) * b(k,237) + b(k,231) = b(k,231) - lu(k,1331) * b(k,237) + b(k,230) = b(k,230) - lu(k,1330) * b(k,237) + b(k,227) = b(k,227) - lu(k,1329) * b(k,237) + b(k,226) = b(k,226) - lu(k,1328) * b(k,237) + b(k,225) = b(k,225) - lu(k,1327) * b(k,237) + b(k,222) = b(k,222) - lu(k,1326) * b(k,237) + b(k,216) = b(k,216) - lu(k,1325) * b(k,237) + b(k,210) = b(k,210) - lu(k,1324) * b(k,237) + b(k,207) = b(k,207) - lu(k,1323) * b(k,237) + b(k,200) = b(k,200) - lu(k,1322) * b(k,237) + b(k,195) = b(k,195) - lu(k,1321) * b(k,237) + b(k,180) = b(k,180) - lu(k,1320) * b(k,237) + b(k,174) = b(k,174) - lu(k,1319) * b(k,237) + b(k,141) = b(k,141) - lu(k,1318) * b(k,237) + b(k,120) = b(k,120) - lu(k,1317) * b(k,237) + b(k,236) = b(k,236) * lu(k,1301) + b(k,234) = b(k,234) - lu(k,1300) * b(k,236) + b(k,233) = b(k,233) - lu(k,1299) * b(k,236) + b(k,231) = b(k,231) - lu(k,1298) * b(k,236) + b(k,230) = b(k,230) - lu(k,1297) * b(k,236) + b(k,227) = b(k,227) - lu(k,1296) * b(k,236) + b(k,226) = b(k,226) - lu(k,1295) * b(k,236) + b(k,225) = b(k,225) - lu(k,1294) * b(k,236) + b(k,222) = b(k,222) - lu(k,1293) * b(k,236) + b(k,205) = b(k,205) - lu(k,1292) * b(k,236) + b(k,200) = b(k,200) - lu(k,1291) * b(k,236) + b(k,195) = b(k,195) - lu(k,1290) * b(k,236) + b(k,177) = b(k,177) - lu(k,1289) * b(k,236) + b(k,235) = b(k,235) * lu(k,1276) + b(k,208) = b(k,208) - lu(k,1275) * b(k,235) + b(k,169) = b(k,169) - lu(k,1274) * b(k,235) + b(k,137) = b(k,137) - lu(k,1273) * b(k,235) + b(k,234) = b(k,234) * lu(k,1265) + b(k,225) = b(k,225) - lu(k,1264) * b(k,234) + b(k,233) = b(k,233) * lu(k,1253) + b(k,225) = b(k,225) - lu(k,1252) * b(k,233) + b(k,215) = b(k,215) - lu(k,1251) * b(k,233) + b(k,232) = b(k,232) * lu(k,1237) + b(k,231) = b(k,231) - lu(k,1236) * b(k,232) + b(k,225) = b(k,225) - lu(k,1235) * b(k,232) + b(k,222) = b(k,222) - lu(k,1234) * b(k,232) + b(k,220) = b(k,220) - lu(k,1233) * b(k,232) + b(k,207) = b(k,207) - lu(k,1232) * b(k,232) + b(k,200) = b(k,200) - lu(k,1231) * b(k,232) + b(k,195) = b(k,195) - lu(k,1230) * b(k,232) + b(k,155) = b(k,155) - lu(k,1229) * b(k,232) + b(k,148) = b(k,148) - lu(k,1228) * b(k,232) + b(k,231) = b(k,231) * lu(k,1217) + b(k,227) = b(k,227) - lu(k,1216) * b(k,231) + b(k,225) = b(k,225) - lu(k,1215) * b(k,231) + b(k,222) = b(k,222) - lu(k,1214) * b(k,231) + b(k,216) = b(k,216) - lu(k,1213) * b(k,231) + b(k,205) = b(k,205) - lu(k,1212) * b(k,231) + b(k,200) = b(k,200) - lu(k,1211) * b(k,231) + b(k,113) = b(k,113) - lu(k,1210) * b(k,231) + b(k,230) = b(k,230) * lu(k,1200) + b(k,227) = b(k,227) - lu(k,1199) * b(k,230) + b(k,200) = b(k,200) - lu(k,1198) * b(k,230) + b(k,147) = b(k,147) - lu(k,1197) * b(k,230) + b(k,229) = b(k,229) * lu(k,1184) + b(k,228) = b(k,228) - lu(k,1183) * b(k,229) + b(k,225) = b(k,225) - lu(k,1182) * b(k,229) + b(k,224) = b(k,224) - lu(k,1181) * b(k,229) + b(k,223) = b(k,223) - lu(k,1180) * b(k,229) + b(k,218) = b(k,218) - lu(k,1179) * b(k,229) + b(k,214) = b(k,214) - lu(k,1178) * b(k,229) + b(k,200) = b(k,200) - lu(k,1177) * b(k,229) + b(k,183) = b(k,183) - lu(k,1176) * b(k,229) + b(k,163) = b(k,163) - lu(k,1175) * b(k,229) + b(k,228) = b(k,228) * lu(k,1163) + b(k,225) = b(k,225) - lu(k,1162) * b(k,228) + b(k,224) = b(k,224) - lu(k,1161) * b(k,228) + b(k,222) = b(k,222) - lu(k,1160) * b(k,228) + b(k,214) = b(k,214) - lu(k,1159) * b(k,228) + b(k,205) = b(k,205) - lu(k,1158) * b(k,228) + b(k,200) = b(k,200) - lu(k,1157) * b(k,228) + b(k,188) = b(k,188) - lu(k,1156) * b(k,228) + b(k,117) = b(k,117) - lu(k,1155) * b(k,228) + end do + end subroutine lu_slv10 + subroutine lu_slv11( 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,227) = b(k,227) * lu(k,1149) + b(k,226) = b(k,226) * lu(k,1136) + b(k,225) = b(k,225) - lu(k,1135) * b(k,226) + b(k,222) = b(k,222) - lu(k,1134) * b(k,226) + b(k,221) = b(k,221) - lu(k,1133) * b(k,226) + b(k,214) = b(k,214) - lu(k,1132) * b(k,226) + b(k,117) = b(k,117) - lu(k,1131) * b(k,226) + b(k,225) = b(k,225) * lu(k,1127) + b(k,205) = b(k,205) - lu(k,1126) * b(k,225) + b(k,224) = b(k,224) * lu(k,1116) + b(k,214) = b(k,214) - lu(k,1115) * b(k,224) + b(k,205) = b(k,205) - lu(k,1114) * b(k,224) + b(k,223) = b(k,223) * lu(k,1102) + b(k,218) = b(k,218) - lu(k,1101) * b(k,223) + b(k,200) = b(k,200) - lu(k,1100) * b(k,223) + b(k,183) = b(k,183) - lu(k,1099) * b(k,223) + b(k,152) = b(k,152) - lu(k,1098) * b(k,223) + b(k,222) = b(k,222) * lu(k,1092) + b(k,216) = b(k,216) - lu(k,1091) * b(k,222) + b(k,205) = b(k,205) - lu(k,1090) * b(k,222) + b(k,221) = b(k,221) * lu(k,1081) + b(k,220) = b(k,220) * lu(k,1069) + b(k,216) = b(k,216) - lu(k,1068) * b(k,220) + b(k,210) = b(k,210) - lu(k,1067) * b(k,220) + b(k,207) = b(k,207) - lu(k,1066) * b(k,220) + b(k,180) = b(k,180) - lu(k,1065) * b(k,220) + b(k,219) = b(k,219) * lu(k,1048) + b(k,215) = b(k,215) - lu(k,1047) * b(k,219) + b(k,207) = b(k,207) - lu(k,1046) * b(k,219) + b(k,205) = b(k,205) - lu(k,1045) * b(k,219) + b(k,198) = b(k,198) - lu(k,1044) * b(k,219) + b(k,190) = b(k,190) - lu(k,1043) * b(k,219) + b(k,218) = b(k,218) * lu(k,1035) + b(k,217) = b(k,217) * lu(k,1015) + b(k,216) = b(k,216) - lu(k,1014) * b(k,217) + b(k,215) = b(k,215) - lu(k,1013) * b(k,217) + b(k,214) = b(k,214) - lu(k,1012) * b(k,217) + b(k,212) = b(k,212) - lu(k,1011) * b(k,217) + b(k,205) = b(k,205) - lu(k,1010) * b(k,217) + b(k,149) = b(k,149) - lu(k,1009) * b(k,217) + b(k,116) = b(k,116) - lu(k,1008) * b(k,217) + b(k,71) = b(k,71) - lu(k,1007) * b(k,217) + b(k,70) = b(k,70) - lu(k,1006) * b(k,217) + b(k,69) = b(k,69) - lu(k,1005) * b(k,217) + b(k,68) = b(k,68) - lu(k,1004) * b(k,217) + b(k,67) = b(k,67) - lu(k,1003) * b(k,217) + b(k,66) = b(k,66) - lu(k,1002) * b(k,217) + b(k,216) = b(k,216) * lu(k,997) + b(k,205) = b(k,205) - lu(k,996) * b(k,216) + b(k,66) = b(k,66) - lu(k,995) * b(k,216) + b(k,215) = b(k,215) * lu(k,989) + b(k,205) = b(k,205) - lu(k,988) * b(k,215) + b(k,214) = b(k,214) * lu(k,982) + b(k,213) = b(k,213) * lu(k,972) + b(k,203) = b(k,203) - lu(k,971) * b(k,213) + b(k,107) = b(k,107) - lu(k,970) * b(k,213) + b(k,212) = b(k,212) * lu(k,960) + b(k,204) = b(k,204) - lu(k,959) * b(k,212) + b(k,187) = b(k,187) - lu(k,958) * b(k,212) + b(k,186) = b(k,186) - lu(k,957) * b(k,212) + b(k,185) = b(k,185) - lu(k,956) * b(k,212) + b(k,168) = b(k,168) - lu(k,955) * b(k,212) + b(k,211) = b(k,211) * lu(k,936) + b(k,205) = b(k,205) - lu(k,935) * b(k,211) + b(k,149) = b(k,149) - lu(k,934) * b(k,211) + b(k,116) = b(k,116) - lu(k,933) * b(k,211) + b(k,73) = b(k,73) - lu(k,932) * b(k,211) + b(k,70) = b(k,70) - lu(k,931) * b(k,211) + b(k,69) = b(k,69) - lu(k,930) * b(k,211) + b(k,68) = b(k,68) - lu(k,929) * b(k,211) + b(k,67) = b(k,67) - lu(k,928) * b(k,211) + b(k,66) = b(k,66) - lu(k,927) * b(k,211) + b(k,210) = b(k,210) * lu(k,918) + b(k,209) = b(k,209) * lu(k,909) + b(k,133) = b(k,133) - lu(k,908) * b(k,209) + b(k,208) = b(k,208) * lu(k,902) + b(k,125) = b(k,125) - lu(k,901) * b(k,208) + b(k,207) = b(k,207) * lu(k,895) + b(k,206) = b(k,206) * lu(k,879) + b(k,72) = b(k,72) - lu(k,878) * b(k,206) + b(k,70) = b(k,70) - lu(k,877) * b(k,206) + b(k,69) = b(k,69) - lu(k,876) * b(k,206) + b(k,205) = b(k,205) * lu(k,873) + b(k,204) = b(k,204) * lu(k,865) + b(k,200) = b(k,200) - lu(k,864) * b(k,204) + b(k,140) = b(k,140) - lu(k,863) * b(k,204) + b(k,126) = b(k,126) - lu(k,862) * b(k,204) + b(k,203) = b(k,203) * lu(k,855) + b(k,107) = b(k,107) - lu(k,854) * b(k,203) + b(k,202) = b(k,202) * lu(k,846) + b(k,201) = b(k,201) * lu(k,836) + b(k,150) = b(k,150) - lu(k,835) * b(k,201) + b(k,200) = b(k,200) * lu(k,831) + b(k,199) = b(k,199) * lu(k,823) + b(k,118) = b(k,118) - lu(k,822) * b(k,199) + b(k,198) = b(k,198) * lu(k,813) + b(k,173) = b(k,173) - lu(k,812) * b(k,198) + b(k,197) = b(k,197) * lu(k,804) + b(k,196) = b(k,196) * lu(k,793) + b(k,193) = b(k,193) - lu(k,792) * b(k,196) + b(k,191) = b(k,191) - lu(k,791) * b(k,196) + b(k,180) = b(k,180) - lu(k,790) * b(k,196) + b(k,161) = b(k,161) - lu(k,789) * b(k,196) + b(k,136) = b(k,136) - lu(k,788) * b(k,196) + b(k,129) = b(k,129) - lu(k,787) * b(k,196) + b(k,195) = b(k,195) * lu(k,780) + b(k,96) = b(k,96) - lu(k,779) * b(k,195) + b(k,194) = b(k,194) * lu(k,769) + b(k,193) = b(k,193) - lu(k,768) * b(k,194) + b(k,189) = b(k,189) - lu(k,767) * b(k,194) + b(k,180) = b(k,180) - lu(k,766) * b(k,194) + b(k,161) = b(k,161) - lu(k,765) * b(k,194) + b(k,129) = b(k,129) - lu(k,764) * b(k,194) + b(k,193) = b(k,193) * lu(k,758) + b(k,192) = b(k,192) * lu(k,751) + b(k,128) = b(k,128) - lu(k,750) * b(k,192) + b(k,102) = b(k,102) - lu(k,749) * b(k,192) + b(k,191) = b(k,191) * lu(k,738) + b(k,180) = b(k,180) - lu(k,737) * b(k,191) + b(k,161) = b(k,161) - lu(k,736) * b(k,191) + b(k,136) = b(k,136) - lu(k,735) * b(k,191) + b(k,129) = b(k,129) - lu(k,734) * b(k,191) + b(k,190) = b(k,190) * lu(k,729) + b(k,189) = b(k,189) * lu(k,719) + b(k,180) = b(k,180) - lu(k,718) * b(k,189) + b(k,161) = b(k,161) - lu(k,717) * b(k,189) + b(k,129) = b(k,129) - lu(k,716) * b(k,189) + b(k,188) = b(k,188) * lu(k,706) + b(k,187) = b(k,187) * lu(k,699) + b(k,143) = b(k,143) - lu(k,698) * b(k,187) + b(k,186) = b(k,186) * lu(k,688) + b(k,168) = b(k,168) - lu(k,687) * b(k,186) + b(k,185) = b(k,185) * lu(k,677) + b(k,168) = b(k,168) - lu(k,676) * b(k,185) + b(k,184) = b(k,184) * lu(k,670) + b(k,164) = b(k,164) - lu(k,669) * b(k,184) + b(k,127) = b(k,127) - lu(k,668) * b(k,184) + b(k,183) = b(k,183) * lu(k,662) + b(k,182) = b(k,182) * lu(k,653) + b(k,181) = b(k,181) * lu(k,646) + b(k,180) = b(k,180) * lu(k,642) + b(k,179) = b(k,179) * lu(k,635) + b(k,178) = b(k,178) * lu(k,626) + b(k,177) = b(k,177) * lu(k,617) + b(k,176) = b(k,176) * lu(k,609) + b(k,175) = b(k,175) * lu(k,601) + b(k,174) = b(k,174) * lu(k,593) + b(k,173) = b(k,173) * lu(k,585) + b(k,172) = b(k,172) * lu(k,577) + b(k,171) = b(k,171) * lu(k,569) + b(k,170) = b(k,170) * lu(k,563) + b(k,97) = b(k,97) - lu(k,562) * b(k,170) + b(k,169) = b(k,169) * lu(k,556) + b(k,168) = b(k,168) * lu(k,551) + b(k,167) = b(k,167) * lu(k,544) + b(k,157) = b(k,157) - lu(k,543) * b(k,167) + b(k,166) = b(k,166) * lu(k,536) + b(k,161) = b(k,161) - lu(k,535) * b(k,166) + b(k,156) = b(k,156) - lu(k,534) * b(k,166) + b(k,165) = b(k,165) * lu(k,527) + b(k,108) = b(k,108) - lu(k,526) * b(k,165) + b(k,164) = b(k,164) * lu(k,522) + b(k,163) = b(k,163) * lu(k,515) + b(k,162) = b(k,162) * lu(k,508) + b(k,161) = b(k,161) * lu(k,505) + b(k,160) = b(k,160) * lu(k,499) + b(k,138) = b(k,138) - lu(k,498) * b(k,160) + b(k,159) = b(k,159) * lu(k,492) + b(k,158) = b(k,158) * lu(k,486) + b(k,139) = b(k,139) - lu(k,485) * b(k,158) + b(k,119) = b(k,119) - lu(k,484) * b(k,158) + b(k,157) = b(k,157) * lu(k,478) + b(k,156) = b(k,156) * lu(k,472) + b(k,155) = b(k,155) * lu(k,466) + b(k,154) = b(k,154) * lu(k,460) + b(k,153) = b(k,153) * lu(k,454) + b(k,152) = b(k,152) * lu(k,448) + b(k,151) = b(k,151) * lu(k,442) + b(k,150) = b(k,150) * lu(k,436) + b(k,149) = b(k,149) * lu(k,430) + b(k,148) = b(k,148) * lu(k,424) + b(k,147) = b(k,147) * lu(k,418) + b(k,146) = b(k,146) * lu(k,410) + b(k,145) = b(k,145) * lu(k,402) + b(k,144) = b(k,144) * lu(k,394) + b(k,143) = b(k,143) * lu(k,389) + b(k,142) = b(k,142) * lu(k,384) + b(k,141) = b(k,141) * lu(k,381) + b(k,140) = b(k,140) * lu(k,376) + b(k,139) = b(k,139) * lu(k,371) + b(k,119) = b(k,119) - lu(k,370) * b(k,139) + b(k,138) = b(k,138) * lu(k,365) + b(k,137) = b(k,137) * lu(k,360) + b(k,136) = b(k,136) * lu(k,355) + b(k,135) = b(k,135) * lu(k,349) + b(k,134) = b(k,134) * lu(k,343) + b(k,133) = b(k,133) * lu(k,340) + b(k,132) = b(k,132) * lu(k,334) + b(k,121) = b(k,121) - lu(k,333) * b(k,132) + b(k,131) = b(k,131) * lu(k,327) + b(k,130) = b(k,130) * lu(k,321) + end do + end subroutine lu_slv11 + subroutine lu_slv12( 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,129) = b(k,129) * lu(k,318) + b(k,128) = b(k,128) * lu(k,314) + b(k,127) = b(k,127) * lu(k,310) + b(k,126) = b(k,126) * lu(k,306) + b(k,125) = b(k,125) * lu(k,302) + b(k,103) = b(k,103) - lu(k,301) * b(k,125) + b(k,124) = b(k,124) * lu(k,296) + b(k,121) = b(k,121) - lu(k,295) * b(k,124) + b(k,123) = b(k,123) * lu(k,291) + b(k,122) = b(k,122) * lu(k,286) + b(k,121) = b(k,121) * lu(k,283) + b(k,120) = b(k,120) * lu(k,278) + b(k,119) = b(k,119) * lu(k,275) + b(k,118) = b(k,118) * lu(k,272) + b(k,117) = b(k,117) * lu(k,269) + b(k,116) = b(k,116) * lu(k,266) + b(k,115) = b(k,115) * lu(k,261) + b(k,114) = b(k,114) * lu(k,253) + b(k,112) = b(k,112) - lu(k,252) * b(k,114) + b(k,85) = b(k,85) - lu(k,251) * b(k,114) + b(k,113) = b(k,113) * lu(k,248) + b(k,112) = b(k,112) * lu(k,244) + b(k,111) = b(k,111) * lu(k,239) + b(k,110) = b(k,110) * lu(k,232) + b(k,84) = b(k,84) - lu(k,231) * b(k,110) + b(k,109) = b(k,109) * lu(k,227) + b(k,108) = b(k,108) * lu(k,224) + b(k,107) = b(k,107) * lu(k,222) + b(k,106) = b(k,106) * lu(k,217) + b(k,105) = b(k,105) * lu(k,213) + b(k,104) = b(k,104) * lu(k,207) + b(k,81) = b(k,81) - lu(k,206) * b(k,104) + b(k,103) = b(k,103) * lu(k,203) + b(k,102) = b(k,102) * lu(k,200) + b(k,101) = b(k,101) * lu(k,195) + b(k,100) = b(k,100) * lu(k,190) + b(k,99) = b(k,99) * lu(k,185) + b(k,98) = b(k,98) * lu(k,180) + b(k,97) = b(k,97) * lu(k,177) + b(k,96) = b(k,96) * lu(k,174) + b(k,95) = b(k,95) * lu(k,170) + b(k,94) = b(k,94) * lu(k,166) + b(k,93) = b(k,93) * lu(k,162) + b(k,92) = b(k,92) * lu(k,158) + b(k,91) = b(k,91) * lu(k,154) + b(k,90) = b(k,90) * lu(k,150) + b(k,89) = b(k,89) * lu(k,147) + b(k,88) = b(k,88) * lu(k,144) + b(k,87) = b(k,87) * lu(k,141) + b(k,86) = b(k,86) * lu(k,138) + b(k,85) = b(k,85) * lu(k,137) + b(k,78) = b(k,78) - lu(k,136) * b(k,85) + b(k,77) = b(k,77) - lu(k,135) * b(k,85) + b(k,76) = b(k,76) - lu(k,134) * b(k,85) + b(k,75) = b(k,75) - lu(k,133) * b(k,85) + b(k,74) = b(k,74) - lu(k,132) * b(k,85) + b(k,84) = b(k,84) * lu(k,131) + b(k,78) = b(k,78) - lu(k,130) * b(k,84) + b(k,77) = b(k,77) - lu(k,129) * b(k,84) + b(k,76) = b(k,76) - lu(k,128) * b(k,84) + b(k,75) = b(k,75) - lu(k,127) * b(k,84) + b(k,74) = b(k,74) - lu(k,126) * b(k,84) + b(k,83) = b(k,83) * lu(k,125) + b(k,78) = b(k,78) - lu(k,124) * b(k,83) + b(k,77) = b(k,77) - lu(k,123) * b(k,83) + b(k,76) = b(k,76) - lu(k,122) * b(k,83) + b(k,75) = b(k,75) - lu(k,121) * b(k,83) + b(k,74) = b(k,74) - lu(k,120) * b(k,83) + b(k,82) = b(k,82) * lu(k,119) + b(k,63) = b(k,63) - lu(k,118) * b(k,82) + b(k,62) = b(k,62) - lu(k,117) * b(k,82) + b(k,61) = b(k,61) - lu(k,116) * b(k,82) + b(k,60) = b(k,60) - lu(k,115) * b(k,82) + b(k,59) = b(k,59) - lu(k,114) * b(k,82) + b(k,81) = b(k,81) * lu(k,113) + b(k,78) = b(k,78) - lu(k,112) * b(k,81) + b(k,77) = b(k,77) - lu(k,111) * b(k,81) + b(k,76) = b(k,76) - lu(k,110) * b(k,81) + b(k,75) = b(k,75) - lu(k,109) * b(k,81) + b(k,74) = b(k,74) - lu(k,108) * b(k,81) + b(k,80) = b(k,80) * lu(k,107) + b(k,79) = b(k,79) - lu(k,106) * b(k,80) + b(k,79) = b(k,79) * lu(k,105) + b(k,78) = b(k,78) - lu(k,104) * b(k,79) + b(k,77) = b(k,77) - lu(k,103) * b(k,79) + b(k,76) = b(k,76) - lu(k,102) * b(k,79) + b(k,75) = b(k,75) - lu(k,101) * b(k,79) + b(k,74) = b(k,74) - lu(k,100) * b(k,79) + b(k,78) = b(k,78) * lu(k,99) + b(k,77) = b(k,77) * lu(k,98) + b(k,76) = b(k,76) * lu(k,97) + b(k,75) = b(k,75) * lu(k,96) + b(k,74) = b(k,74) * lu(k,95) + b(k,73) = b(k,73) * lu(k,94) + b(k,70) = b(k,70) - lu(k,93) * b(k,73) + b(k,69) = b(k,69) - lu(k,92) * b(k,73) + b(k,68) = b(k,68) - lu(k,91) * b(k,73) + b(k,67) = b(k,67) - lu(k,90) * b(k,73) + b(k,66) = b(k,66) - lu(k,89) * b(k,73) + b(k,72) = b(k,72) * lu(k,88) + b(k,70) = b(k,70) - lu(k,87) * b(k,72) + b(k,69) = b(k,69) - lu(k,86) * b(k,72) + b(k,68) = b(k,68) - lu(k,85) * b(k,72) + b(k,67) = b(k,67) - lu(k,84) * b(k,72) + b(k,66) = b(k,66) - lu(k,83) * b(k,72) + b(k,71) = b(k,71) * lu(k,82) + b(k,70) = b(k,70) - lu(k,81) * b(k,71) + b(k,69) = b(k,69) - lu(k,80) * b(k,71) + b(k,68) = b(k,68) - lu(k,79) * b(k,71) + b(k,67) = b(k,67) - lu(k,78) * b(k,71) + b(k,66) = b(k,66) - lu(k,77) * b(k,71) + b(k,70) = b(k,70) * lu(k,76) + b(k,69) = b(k,69) * lu(k,75) + b(k,68) = b(k,68) * lu(k,74) + b(k,67) = b(k,67) * lu(k,73) + b(k,66) = b(k,66) * lu(k,72) + b(k,65) = b(k,65) * lu(k,71) + b(k,64) = b(k,64) - lu(k,70) * b(k,65) + b(k,64) = b(k,64) * lu(k,69) + b(k,63) = b(k,63) - lu(k,68) * b(k,64) + b(k,62) = b(k,62) - lu(k,67) * b(k,64) + b(k,61) = b(k,61) - lu(k,66) * b(k,64) + b(k,60) = b(k,60) - lu(k,65) * b(k,64) + b(k,59) = b(k,59) - lu(k,64) * b(k,64) + b(k,63) = b(k,63) * lu(k,63) + b(k,62) = b(k,62) * lu(k,62) + b(k,61) = b(k,61) * lu(k,61) + b(k,60) = b(k,60) * lu(k,60) + b(k,59) = b(k,59) * lu(k,59) + b(k,58) = b(k,58) * lu(k,58) + b(k,57) = b(k,57) * lu(k,57) + b(k,56) = b(k,56) * lu(k,56) + b(k,55) = b(k,55) * lu(k,55) + b(k,54) = b(k,54) * lu(k,54) + b(k,53) = b(k,53) * lu(k,53) + b(k,52) = b(k,52) * lu(k,52) + b(k,51) = b(k,51) * lu(k,51) + b(k,50) = b(k,50) * lu(k,50) + b(k,49) = b(k,49) * lu(k,49) + b(k,48) = b(k,48) * lu(k,48) + b(k,47) = b(k,47) * lu(k,47) + b(k,46) = b(k,46) * lu(k,46) + b(k,45) = b(k,45) * lu(k,45) + b(k,44) = b(k,44) * lu(k,44) + b(k,43) = b(k,43) * lu(k,43) + b(k,42) = b(k,42) * lu(k,42) + b(k,41) = b(k,41) * lu(k,41) + b(k,40) = b(k,40) * lu(k,40) + b(k,39) = b(k,39) * lu(k,39) + b(k,38) = b(k,38) * lu(k,38) + b(k,37) = b(k,37) * lu(k,37) + b(k,36) = b(k,36) * lu(k,36) + b(k,35) = b(k,35) * lu(k,35) + b(k,34) = b(k,34) * lu(k,34) + b(k,33) = b(k,33) * lu(k,33) + b(k,32) = b(k,32) * lu(k,32) + b(k,31) = b(k,31) * lu(k,31) + b(k,30) = b(k,30) * lu(k,30) + b(k,29) = b(k,29) * lu(k,29) + b(k,28) = b(k,28) * lu(k,28) + b(k,27) = b(k,27) * lu(k,27) + b(k,26) = b(k,26) * lu(k,26) + b(k,25) = b(k,25) * lu(k,25) + b(k,24) = b(k,24) * lu(k,24) + b(k,23) = b(k,23) * lu(k,23) + b(k,22) = b(k,22) * lu(k,22) + b(k,21) = b(k,21) * lu(k,21) + b(k,20) = b(k,20) * lu(k,20) + b(k,19) = b(k,19) * lu(k,19) + b(k,18) = b(k,18) * lu(k,18) + b(k,17) = b(k,17) * lu(k,17) + b(k,16) = b(k,16) * lu(k,16) + b(k,15) = b(k,15) * lu(k,15) + b(k,14) = b(k,14) * lu(k,14) + b(k,13) = b(k,13) * lu(k,13) + b(k,12) = b(k,12) * lu(k,12) + b(k,11) = b(k,11) * lu(k,11) + b(k,10) = b(k,10) * lu(k,10) + 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_slv12 + 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 ) + call lu_slv09( avec_len, lu, b ) + call lu_slv10( avec_len, lu, b ) + call lu_slv11( avec_len, lu, b ) + call lu_slv12( avec_len, lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_trop_strat_mam5_vbsext/mo_nln_matrix.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_nln_matrix.F90 new file mode 100644 index 0000000000..0c9da10b71 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_nln_matrix.F90 @@ -0,0 +1,3816 @@ + 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,688) = -(rxt(k,375)*y(k,253)) + mat(k,1759) = -rxt(k,375)*y(k,1) + mat(k,1903) = rxt(k,378)*y(k,230) + mat(k,957) = rxt(k,378)*y(k,129) + mat(k,677) = -(rxt(k,379)*y(k,253)) + mat(k,1758) = -rxt(k,379)*y(k,2) + mat(k,956) = rxt(k,376)*y(k,242) + mat(k,2249) = rxt(k,376)*y(k,230) + mat(k,1015) = -(rxt(k,458)*y(k,131) + rxt(k,459)*y(k,140) + rxt(k,460) & + *y(k,253)) + mat(k,2051) = -rxt(k,458)*y(k,6) + mat(k,2155) = -rxt(k,459)*y(k,6) + mat(k,1789) = -rxt(k,460)*y(k,6) + mat(k,82) = -(rxt(k,513)*y(k,242) + rxt(k,514)*y(k,129)) + mat(k,2207) = -rxt(k,513)*y(k,7) + mat(k,1869) = -rxt(k,514)*y(k,7) + mat(k,1007) = rxt(k,516)*y(k,253) + mat(k,1669) = rxt(k,516)*y(k,6) + mat(k,207) = -(rxt(k,417)*y(k,253)) + mat(k,1689) = -rxt(k,417)*y(k,8) + mat(k,113) = -(rxt(k,518)*y(k,242) + rxt(k,519)*y(k,129)) + mat(k,2216) = -rxt(k,518)*y(k,9) + mat(k,1878) = -rxt(k,519)*y(k,9) + mat(k,206) = rxt(k,517)*y(k,253) + mat(k,1679) = rxt(k,517)*y(k,8) + mat(k,472) = -(rxt(k,420)*y(k,253)) + mat(k,1731) = -rxt(k,420)*y(k,10) + mat(k,534) = rxt(k,418)*y(k,242) + mat(k,2234) = rxt(k,418)*y(k,231) + mat(k,208) = .120_r8*rxt(k,417)*y(k,253) + mat(k,1690) = .120_r8*rxt(k,417)*y(k,8) + mat(k,1009) = .100_r8*rxt(k,459)*y(k,140) + mat(k,934) = .100_r8*rxt(k,462)*y(k,140) + mat(k,2140) = .100_r8*rxt(k,459)*y(k,6) + .100_r8*rxt(k,462)*y(k,116) + mat(k,1890) = .500_r8*rxt(k,419)*y(k,231) + .200_r8*rxt(k,446)*y(k,259) & + + .060_r8*rxt(k,452)*y(k,261) + mat(k,535) = .500_r8*rxt(k,419)*y(k,129) + mat(k,765) = .200_r8*rxt(k,446)*y(k,129) + mat(k,789) = .060_r8*rxt(k,452)*y(k,129) + mat(k,1884) = .200_r8*rxt(k,446)*y(k,259) + .200_r8*rxt(k,452)*y(k,261) + mat(k,764) = .200_r8*rxt(k,446)*y(k,129) + mat(k,787) = .200_r8*rxt(k,452)*y(k,129) + mat(k,1900) = .200_r8*rxt(k,446)*y(k,259) + .150_r8*rxt(k,452)*y(k,261) + mat(k,766) = .200_r8*rxt(k,446)*y(k,129) + mat(k,790) = .150_r8*rxt(k,452)*y(k,129) + mat(k,1885) = .210_r8*rxt(k,452)*y(k,261) + mat(k,788) = .210_r8*rxt(k,452)*y(k,129) + mat(k,266) = -(rxt(k,380)*y(k,253)) + mat(k,1699) = -rxt(k,380)*y(k,17) + mat(k,1008) = .050_r8*rxt(k,459)*y(k,140) + mat(k,933) = .050_r8*rxt(k,462)*y(k,140) + mat(k,2139) = .050_r8*rxt(k,459)*y(k,6) + .050_r8*rxt(k,462)*y(k,116) + mat(k,394) = -(rxt(k,346)*y(k,131) + rxt(k,347)*y(k,253)) + mat(k,2041) = -rxt(k,346)*y(k,18) + mat(k,1720) = -rxt(k,347)*y(k,18) + mat(k,1462) = -(rxt(k,230)*y(k,44) + rxt(k,231)*y(k,242) + rxt(k,232) & + *y(k,140)) + mat(k,1528) = -rxt(k,230)*y(k,19) + mat(k,2295) = -rxt(k,231)*y(k,19) + mat(k,2177) = -rxt(k,232)*y(k,19) + mat(k,1840) = 4.000_r8*rxt(k,233)*y(k,21) + (rxt(k,234)+rxt(k,235))*y(k,61) & + + rxt(k,238)*y(k,129) + rxt(k,241)*y(k,139) + rxt(k,488) & + *y(k,158) + rxt(k,242)*y(k,253) + mat(k,182) = rxt(k,220)*y(k,252) + mat(k,188) = rxt(k,246)*y(k,252) + mat(k,509) = 2.000_r8*rxt(k,257)*y(k,58) + 2.000_r8*rxt(k,269)*y(k,252) & + + 2.000_r8*rxt(k,258)*y(k,253) + mat(k,627) = rxt(k,259)*y(k,58) + rxt(k,270)*y(k,252) + rxt(k,260)*y(k,253) + mat(k,461) = 3.000_r8*rxt(k,264)*y(k,58) + 3.000_r8*rxt(k,247)*y(k,252) & + + 3.000_r8*rxt(k,265)*y(k,253) + mat(k,2115) = 2.000_r8*rxt(k,257)*y(k,43) + rxt(k,259)*y(k,45) & + + 3.000_r8*rxt(k,264)*y(k,57) + mat(k,2322) = (rxt(k,234)+rxt(k,235))*y(k,21) + mat(k,152) = 2.000_r8*rxt(k,248)*y(k,252) + mat(k,847) = rxt(k,243)*y(k,139) + rxt(k,249)*y(k,252) + rxt(k,244)*y(k,253) + mat(k,1942) = rxt(k,238)*y(k,21) + mat(k,1602) = rxt(k,241)*y(k,21) + rxt(k,243)*y(k,83) + mat(k,1277) = rxt(k,488)*y(k,21) + mat(k,1643) = rxt(k,220)*y(k,36) + rxt(k,246)*y(k,37) + 2.000_r8*rxt(k,269) & + *y(k,43) + rxt(k,270)*y(k,45) + 3.000_r8*rxt(k,247)*y(k,57) & + + 2.000_r8*rxt(k,248)*y(k,80) + rxt(k,249)*y(k,83) + mat(k,1815) = rxt(k,242)*y(k,21) + 2.000_r8*rxt(k,258)*y(k,43) + rxt(k,260) & + *y(k,45) + 3.000_r8*rxt(k,265)*y(k,57) + rxt(k,244)*y(k,83) + mat(k,1834) = rxt(k,236)*y(k,61) + mat(k,2316) = rxt(k,236)*y(k,21) + mat(k,2014) = (rxt(k,553)+rxt(k,558))*y(k,93) + mat(k,822) = (rxt(k,553)+rxt(k,558))*y(k,87) + mat(k,1848) = -(4._r8*rxt(k,233)*y(k,21) + (rxt(k,234) + rxt(k,235) + rxt(k,236) & + ) * y(k,61) + rxt(k,237)*y(k,242) + rxt(k,238)*y(k,129) & + + rxt(k,239)*y(k,130) + rxt(k,241)*y(k,139) + rxt(k,242) & + *y(k,253) + rxt(k,488)*y(k,158)) + mat(k,2330) = -(rxt(k,234) + rxt(k,235) + rxt(k,236)) * y(k,21) + mat(k,2304) = -rxt(k,237)*y(k,21) + mat(k,1951) = -rxt(k,238)*y(k,21) + mat(k,1580) = -rxt(k,239)*y(k,21) + mat(k,1611) = -rxt(k,241)*y(k,21) + mat(k,1824) = -rxt(k,242)*y(k,21) + mat(k,1282) = -rxt(k,488)*y(k,21) + mat(k,1468) = rxt(k,232)*y(k,140) + mat(k,583) = rxt(k,240)*y(k,139) + mat(k,852) = rxt(k,250)*y(k,252) + mat(k,827) = rxt(k,245)*y(k,139) + mat(k,1611) = mat(k,1611) + rxt(k,240)*y(k,22) + rxt(k,245)*y(k,93) + mat(k,2186) = rxt(k,232)*y(k,19) + mat(k,1652) = rxt(k,250)*y(k,83) + mat(k,577) = -(rxt(k,240)*y(k,139)) + mat(k,1592) = -rxt(k,240)*y(k,22) + mat(k,1836) = rxt(k,239)*y(k,130) + mat(k,1554) = rxt(k,239)*y(k,21) + mat(k,275) = -(rxt(k,421)*y(k,253)) + mat(k,1701) = -rxt(k,421)*y(k,24) + mat(k,1882) = rxt(k,424)*y(k,232) + mat(k,484) = rxt(k,424)*y(k,129) + mat(k,371) = -(rxt(k,423)*y(k,253)) + mat(k,1715) = -rxt(k,423)*y(k,25) + mat(k,485) = rxt(k,422)*y(k,242) + mat(k,2224) = rxt(k,422)*y(k,232) + mat(k,321) = -(rxt(k,295)*y(k,58) + rxt(k,296)*y(k,253)) + mat(k,2096) = -rxt(k,295)*y(k,26) + mat(k,1710) = -rxt(k,296)*y(k,26) + mat(k,601) = -(rxt(k,297)*y(k,58) + rxt(k,298)*y(k,140) + rxt(k,323)*y(k,253)) + mat(k,2101) = -rxt(k,297)*y(k,27) + mat(k,2143) = -rxt(k,298)*y(k,27) + mat(k,1748) = -rxt(k,323)*y(k,27) + mat(k,306) = -(rxt(k,303)*y(k,253)) + mat(k,1708) = -rxt(k,303)*y(k,28) + mat(k,862) = .800_r8*rxt(k,299)*y(k,233) + .200_r8*rxt(k,300)*y(k,237) + mat(k,1961) = .200_r8*rxt(k,300)*y(k,233) + mat(k,376) = -(rxt(k,304)*y(k,253)) + mat(k,1716) = -rxt(k,304)*y(k,29) + mat(k,863) = rxt(k,301)*y(k,242) + mat(k,2225) = rxt(k,301)*y(k,233) + mat(k,327) = -(rxt(k,305)*y(k,58) + rxt(k,306)*y(k,253)) + mat(k,2097) = -rxt(k,305)*y(k,30) + mat(k,1711) = -rxt(k,306)*y(k,30) + mat(k,1048) = -(rxt(k,326)*y(k,131) + rxt(k,327)*y(k,140) + rxt(k,344) & + *y(k,253)) + mat(k,2053) = -rxt(k,326)*y(k,31) + mat(k,2157) = -rxt(k,327)*y(k,31) + mat(k,1791) = -rxt(k,344)*y(k,31) + mat(k,881) = .130_r8*rxt(k,404)*y(k,140) + mat(k,2157) = mat(k,2157) + .130_r8*rxt(k,404)*y(k,100) + mat(k,436) = -(rxt(k,331)*y(k,253)) + mat(k,1725) = -rxt(k,331)*y(k,32) + mat(k,835) = rxt(k,329)*y(k,242) + mat(k,2230) = rxt(k,329)*y(k,234) + mat(k,154) = -(rxt(k,332)*y(k,253)) + mat(k,1686) = -rxt(k,332)*y(k,33) + mat(k,310) = -(rxt(k,427)*y(k,253)) + mat(k,1709) = -rxt(k,427)*y(k,34) + mat(k,668) = rxt(k,425)*y(k,242) + mat(k,2221) = rxt(k,425)*y(k,235) + mat(k,141) = -(rxt(k,219)*y(k,252)) + mat(k,1621) = -rxt(k,219)*y(k,35) + mat(k,180) = -(rxt(k,220)*y(k,252)) + mat(k,1626) = -rxt(k,220)*y(k,36) + mat(k,185) = -(rxt(k,246)*y(k,252)) + mat(k,1627) = -rxt(k,246)*y(k,37) + mat(k,158) = -(rxt(k,221)*y(k,252)) + mat(k,1623) = -rxt(k,221)*y(k,38) + mat(k,190) = -(rxt(k,222)*y(k,252)) + mat(k,1628) = -rxt(k,222)*y(k,39) + mat(k,162) = -(rxt(k,223)*y(k,252)) + mat(k,1624) = -rxt(k,223)*y(k,40) + mat(k,195) = -(rxt(k,224)*y(k,252)) + mat(k,1629) = -rxt(k,224)*y(k,41) + mat(k,166) = -(rxt(k,225)*y(k,252)) + mat(k,1625) = -rxt(k,225)*y(k,42) + mat(k,508) = -(rxt(k,257)*y(k,58) + rxt(k,258)*y(k,253) + rxt(k,269)*y(k,252)) + mat(k,2100) = -rxt(k,257)*y(k,43) + mat(k,1736) = -rxt(k,258)*y(k,43) + mat(k,1638) = -rxt(k,269)*y(k,43) + mat(k,1532) = -(rxt(k,194)*y(k,58) + rxt(k,230)*y(k,19) + rxt(k,274)*y(k,242) & + + rxt(k,275)*y(k,131) + rxt(k,276)*y(k,139) + rxt(k,277) & + *y(k,253)) + mat(k,2119) = -rxt(k,194)*y(k,44) + mat(k,1464) = -rxt(k,230)*y(k,44) + mat(k,2299) = -rxt(k,274)*y(k,44) + mat(k,2080) = -rxt(k,275)*y(k,44) + mat(k,1606) = -rxt(k,276)*y(k,44) + mat(k,1819) = -rxt(k,277)*y(k,44) + mat(k,694) = .400_r8*rxt(k,375)*y(k,253) + mat(k,1025) = .340_r8*rxt(k,459)*y(k,140) + mat(k,398) = .500_r8*rxt(k,346)*y(k,131) + mat(k,605) = rxt(k,298)*y(k,140) + mat(k,1055) = .500_r8*rxt(k,327)*y(k,140) + mat(k,638) = .500_r8*rxt(k,315)*y(k,253) + mat(k,832) = rxt(k,282)*y(k,253) + mat(k,456) = .300_r8*rxt(k,283)*y(k,253) + mat(k,1480) = (rxt(k,291)+rxt(k,292))*y(k,252) + mat(k,2325) = rxt(k,201)*y(k,237) + mat(k,1094) = .800_r8*rxt(k,320)*y(k,253) + mat(k,889) = .910_r8*rxt(k,404)*y(k,140) + mat(k,622) = .300_r8*rxt(k,395)*y(k,253) + mat(k,1243) = .800_r8*rxt(k,399)*y(k,237) + mat(k,1258) = .120_r8*rxt(k,357)*y(k,140) + mat(k,657) = .500_r8*rxt(k,370)*y(k,253) + mat(k,949) = .340_r8*rxt(k,462)*y(k,140) + mat(k,1384) = .600_r8*rxt(k,371)*y(k,140) + mat(k,1946) = .100_r8*rxt(k,377)*y(k,230) + rxt(k,281)*y(k,237) & + + .500_r8*rxt(k,348)*y(k,239) + .500_r8*rxt(k,317)*y(k,241) & + + .920_r8*rxt(k,387)*y(k,244) + .250_r8*rxt(k,355)*y(k,246) & + + rxt(k,364)*y(k,248) + rxt(k,338)*y(k,255) + rxt(k,342) & + *y(k,256) + .340_r8*rxt(k,471)*y(k,257) + .320_r8*rxt(k,476) & + *y(k,258) + .250_r8*rxt(k,412)*y(k,260) + mat(k,2080) = mat(k,2080) + .500_r8*rxt(k,346)*y(k,18) + rxt(k,388)*y(k,244) & + + .250_r8*rxt(k,354)*y(k,246) + rxt(k,365)*y(k,248) + mat(k,2181) = .340_r8*rxt(k,459)*y(k,6) + rxt(k,298)*y(k,27) & + + .500_r8*rxt(k,327)*y(k,31) + .910_r8*rxt(k,404)*y(k,100) & + + .120_r8*rxt(k,357)*y(k,111) + .340_r8*rxt(k,462)*y(k,116) & + + .600_r8*rxt(k,371)*y(k,118) + mat(k,572) = rxt(k,322)*y(k,253) + mat(k,1120) = .680_r8*rxt(k,480)*y(k,253) + mat(k,964) = .100_r8*rxt(k,377)*y(k,129) + mat(k,867) = .700_r8*rxt(k,300)*y(k,237) + mat(k,839) = rxt(k,328)*y(k,237) + mat(k,1436) = rxt(k,311)*y(k,237) + rxt(k,384)*y(k,244) + .250_r8*rxt(k,351) & + *y(k,246) + rxt(k,360)*y(k,248) + .250_r8*rxt(k,409)*y(k,260) + mat(k,1998) = rxt(k,201)*y(k,61) + .800_r8*rxt(k,399)*y(k,103) + rxt(k,281) & + *y(k,129) + .700_r8*rxt(k,300)*y(k,233) + rxt(k,328)*y(k,234) & + + rxt(k,311)*y(k,236) + (4.000_r8*rxt(k,278)+2.000_r8*rxt(k,279)) & + *y(k,237) + 1.500_r8*rxt(k,385)*y(k,244) + .750_r8*rxt(k,390) & + *y(k,245) + .880_r8*rxt(k,352)*y(k,246) + 2.000_r8*rxt(k,361) & + *y(k,248) + .750_r8*rxt(k,464)*y(k,251) + .800_r8*rxt(k,340) & + *y(k,256) + .930_r8*rxt(k,469)*y(k,257) + .950_r8*rxt(k,474) & + *y(k,258) + .800_r8*rxt(k,410)*y(k,260) + mat(k,613) = .500_r8*rxt(k,348)*y(k,129) + mat(k,753) = .500_r8*rxt(k,317)*y(k,129) + mat(k,2299) = mat(k,2299) + .450_r8*rxt(k,362)*y(k,248) + .150_r8*rxt(k,341) & + *y(k,256) + mat(k,1307) = .920_r8*rxt(k,387)*y(k,129) + rxt(k,388)*y(k,131) + rxt(k,384) & + *y(k,236) + 1.500_r8*rxt(k,385)*y(k,237) + mat(k,1340) = .750_r8*rxt(k,390)*y(k,237) + mat(k,1362) = .250_r8*rxt(k,355)*y(k,129) + .250_r8*rxt(k,354)*y(k,131) & + + .250_r8*rxt(k,351)*y(k,236) + .880_r8*rxt(k,352)*y(k,237) + mat(k,1404) = rxt(k,364)*y(k,129) + rxt(k,365)*y(k,131) + rxt(k,360)*y(k,236) & + + 2.000_r8*rxt(k,361)*y(k,237) + .450_r8*rxt(k,362)*y(k,242) & + + 4.000_r8*rxt(k,363)*y(k,248) + mat(k,1107) = .750_r8*rxt(k,464)*y(k,237) + mat(k,1647) = (rxt(k,291)+rxt(k,292))*y(k,56) + mat(k,1819) = mat(k,1819) + .400_r8*rxt(k,375)*y(k,1) + .500_r8*rxt(k,315) & + *y(k,53) + rxt(k,282)*y(k,54) + .300_r8*rxt(k,283)*y(k,55) & + + .800_r8*rxt(k,320)*y(k,76) + .300_r8*rxt(k,395)*y(k,101) & + + .500_r8*rxt(k,370)*y(k,115) + rxt(k,322)*y(k,145) & + + .680_r8*rxt(k,480)*y(k,217) + mat(k,816) = rxt(k,338)*y(k,129) + mat(k,1203) = rxt(k,342)*y(k,129) + .800_r8*rxt(k,340)*y(k,237) & + + .150_r8*rxt(k,341)*y(k,242) + mat(k,1167) = .340_r8*rxt(k,471)*y(k,129) + .930_r8*rxt(k,469)*y(k,237) + mat(k,1188) = .320_r8*rxt(k,476)*y(k,129) + .950_r8*rxt(k,474)*y(k,237) + mat(k,1220) = .250_r8*rxt(k,412)*y(k,129) + .250_r8*rxt(k,409)*y(k,236) & + + .800_r8*rxt(k,410)*y(k,237) + 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,626) = -(rxt(k,259)*y(k,58) + rxt(k,260)*y(k,253) + rxt(k,270)*y(k,252)) + mat(k,2102) = -rxt(k,259)*y(k,45) + mat(k,1751) = -rxt(k,260)*y(k,45) + mat(k,1639) = -rxt(k,270)*y(k,45) + mat(k,170) = -(rxt(k,261)*y(k,253)) + mat(k,1687) = -rxt(k,261)*y(k,46) + mat(k,1081) = -(rxt(k,307)*y(k,131) + rxt(k,308)*y(k,253)) + mat(k,2055) = -rxt(k,307)*y(k,47) + mat(k,1793) = -rxt(k,308)*y(k,47) + mat(k,692) = .800_r8*rxt(k,375)*y(k,253) + mat(k,397) = rxt(k,346)*y(k,131) + mat(k,307) = rxt(k,303)*y(k,253) + mat(k,378) = .500_r8*rxt(k,304)*y(k,253) + mat(k,1049) = .500_r8*rxt(k,327)*y(k,140) + mat(k,1374) = .100_r8*rxt(k,371)*y(k,140) + mat(k,1922) = .400_r8*rxt(k,377)*y(k,230) + rxt(k,302)*y(k,233) & + + .270_r8*rxt(k,330)*y(k,234) + rxt(k,348)*y(k,239) + rxt(k,367) & + *y(k,250) + rxt(k,338)*y(k,255) + mat(k,2055) = mat(k,2055) + rxt(k,346)*y(k,18) + mat(k,2158) = .500_r8*rxt(k,327)*y(k,31) + .100_r8*rxt(k,371)*y(k,118) + mat(k,962) = .400_r8*rxt(k,377)*y(k,129) + mat(k,866) = rxt(k,302)*y(k,129) + 3.200_r8*rxt(k,299)*y(k,233) & + + .800_r8*rxt(k,300)*y(k,237) + mat(k,838) = .270_r8*rxt(k,330)*y(k,129) + mat(k,1976) = .800_r8*rxt(k,300)*y(k,233) + mat(k,611) = rxt(k,348)*y(k,129) + mat(k,2275) = .200_r8*rxt(k,366)*y(k,250) + mat(k,700) = rxt(k,367)*y(k,129) + .200_r8*rxt(k,366)*y(k,242) + mat(k,1793) = mat(k,1793) + .800_r8*rxt(k,375)*y(k,1) + rxt(k,303)*y(k,28) & + + .500_r8*rxt(k,304)*y(k,29) + mat(k,814) = rxt(k,338)*y(k,129) + mat(k,402) = -(rxt(k,262)*y(k,58) + rxt(k,263)*y(k,253)) + mat(k,2098) = -rxt(k,262)*y(k,48) + mat(k,1721) = -rxt(k,263)*y(k,48) + mat(k,144) = -(rxt(k,309)*y(k,253)) + mat(k,1685) = -rxt(k,309)*y(k,49) + mat(k,982) = -(rxt(k,345)*y(k,253)) + mat(k,1786) = -rxt(k,345)*y(k,50) + mat(k,691) = .800_r8*rxt(k,375)*y(k,253) + mat(k,1012) = .520_r8*rxt(k,459)*y(k,140) + mat(k,396) = .500_r8*rxt(k,346)*y(k,131) + mat(k,938) = .520_r8*rxt(k,462)*y(k,140) + mat(k,1917) = .250_r8*rxt(k,377)*y(k,230) + .820_r8*rxt(k,330)*y(k,234) & + + .500_r8*rxt(k,348)*y(k,239) + .270_r8*rxt(k,471)*y(k,257) & + + .040_r8*rxt(k,476)*y(k,258) + mat(k,2048) = .500_r8*rxt(k,346)*y(k,18) + mat(k,2152) = .520_r8*rxt(k,459)*y(k,6) + .520_r8*rxt(k,462)*y(k,116) + mat(k,1115) = .500_r8*rxt(k,480)*y(k,253) + mat(k,961) = .250_r8*rxt(k,377)*y(k,129) + mat(k,837) = .820_r8*rxt(k,330)*y(k,129) + .820_r8*rxt(k,328)*y(k,237) + mat(k,1972) = .820_r8*rxt(k,328)*y(k,234) + .150_r8*rxt(k,469)*y(k,257) & + + .025_r8*rxt(k,474)*y(k,258) + mat(k,610) = .500_r8*rxt(k,348)*y(k,129) + mat(k,1786) = mat(k,1786) + .800_r8*rxt(k,375)*y(k,1) + .500_r8*rxt(k,480) & + *y(k,217) + mat(k,1159) = .270_r8*rxt(k,471)*y(k,129) + .150_r8*rxt(k,469)*y(k,237) + mat(k,1178) = .040_r8*rxt(k,476)*y(k,129) + .025_r8*rxt(k,474)*y(k,237) + mat(k,1265) = -(rxt(k,333)*y(k,131) + rxt(k,334)*y(k,253)) + mat(k,2068) = -rxt(k,333)*y(k,51) + mat(k,1806) = -rxt(k,334)*y(k,51) + mat(k,1150) = rxt(k,335)*y(k,253) + mat(k,1254) = .880_r8*rxt(k,357)*y(k,140) + mat(k,1377) = .500_r8*rxt(k,371)*y(k,140) + mat(k,1935) = .170_r8*rxt(k,430)*y(k,238) + .050_r8*rxt(k,393)*y(k,245) & + + .250_r8*rxt(k,355)*y(k,246) + .170_r8*rxt(k,436)*y(k,249) & + + .400_r8*rxt(k,446)*y(k,259) + .250_r8*rxt(k,412)*y(k,260) & + + .540_r8*rxt(k,452)*y(k,261) + .510_r8*rxt(k,455)*y(k,262) + mat(k,2068) = mat(k,2068) + .050_r8*rxt(k,394)*y(k,245) + .250_r8*rxt(k,354) & + *y(k,246) + .250_r8*rxt(k,413)*y(k,260) + mat(k,896) = rxt(k,336)*y(k,253) + mat(k,2169) = .880_r8*rxt(k,357)*y(k,111) + .500_r8*rxt(k,371)*y(k,118) + mat(k,1427) = .250_r8*rxt(k,351)*y(k,246) + .250_r8*rxt(k,409)*y(k,260) + mat(k,1988) = .240_r8*rxt(k,352)*y(k,246) + .500_r8*rxt(k,340)*y(k,256) & + + .100_r8*rxt(k,410)*y(k,260) + mat(k,806) = .170_r8*rxt(k,430)*y(k,129) + .070_r8*rxt(k,429)*y(k,242) + mat(k,2287) = .070_r8*rxt(k,429)*y(k,238) + .070_r8*rxt(k,435)*y(k,249) + mat(k,1333) = .050_r8*rxt(k,393)*y(k,129) + .050_r8*rxt(k,394)*y(k,131) + mat(k,1357) = .250_r8*rxt(k,355)*y(k,129) + .250_r8*rxt(k,354)*y(k,131) & + + .250_r8*rxt(k,351)*y(k,236) + .240_r8*rxt(k,352)*y(k,237) + mat(k,921) = .170_r8*rxt(k,436)*y(k,129) + .070_r8*rxt(k,435)*y(k,242) + mat(k,1806) = mat(k,1806) + rxt(k,335)*y(k,97) + rxt(k,336)*y(k,132) + mat(k,1201) = .500_r8*rxt(k,340)*y(k,237) + mat(k,774) = .400_r8*rxt(k,446)*y(k,129) + mat(k,1218) = .250_r8*rxt(k,412)*y(k,129) + .250_r8*rxt(k,413)*y(k,131) & + + .250_r8*rxt(k,409)*y(k,236) + .100_r8*rxt(k,410)*y(k,237) + mat(k,798) = .540_r8*rxt(k,452)*y(k,129) + mat(k,546) = .510_r8*rxt(k,455)*y(k,129) + mat(k,729) = -(rxt(k,314)*y(k,253)) + mat(k,1763) = -rxt(k,314)*y(k,52) + mat(k,1043) = .120_r8*rxt(k,327)*y(k,140) + mat(k,2145) = .120_r8*rxt(k,327)*y(k,31) + mat(k,1417) = .100_r8*rxt(k,311)*y(k,237) + .150_r8*rxt(k,312)*y(k,242) + mat(k,1966) = .100_r8*rxt(k,311)*y(k,236) + mat(k,2253) = .150_r8*rxt(k,312)*y(k,236) + .150_r8*rxt(k,362)*y(k,248) + mat(k,1396) = .150_r8*rxt(k,362)*y(k,242) + mat(k,635) = -(rxt(k,315)*y(k,253)) + mat(k,1752) = -rxt(k,315)*y(k,53) + mat(k,1416) = .400_r8*rxt(k,312)*y(k,242) + mat(k,2246) = .400_r8*rxt(k,312)*y(k,236) + .400_r8*rxt(k,362)*y(k,248) + mat(k,1394) = .400_r8*rxt(k,362)*y(k,242) + mat(k,831) = -(rxt(k,282)*y(k,253)) + mat(k,1772) = -rxt(k,282)*y(k,54) + mat(k,1231) = .200_r8*rxt(k,399)*y(k,237) + mat(k,864) = .300_r8*rxt(k,300)*y(k,237) + mat(k,1967) = .200_r8*rxt(k,399)*y(k,103) + .300_r8*rxt(k,300)*y(k,233) & + + 2.000_r8*rxt(k,279)*y(k,237) + .250_r8*rxt(k,385)*y(k,244) & + + .250_r8*rxt(k,390)*y(k,245) + .250_r8*rxt(k,352)*y(k,246) & + + .250_r8*rxt(k,464)*y(k,251) + .500_r8*rxt(k,340)*y(k,256) & + + .250_r8*rxt(k,469)*y(k,257) + .250_r8*rxt(k,474)*y(k,258) & + + .300_r8*rxt(k,410)*y(k,260) + mat(k,1291) = .250_r8*rxt(k,385)*y(k,237) + mat(k,1322) = .250_r8*rxt(k,390)*y(k,237) + mat(k,1351) = .250_r8*rxt(k,352)*y(k,237) + mat(k,1100) = .250_r8*rxt(k,464)*y(k,237) + mat(k,1198) = .500_r8*rxt(k,340)*y(k,237) + mat(k,1157) = .250_r8*rxt(k,469)*y(k,237) + mat(k,1177) = .250_r8*rxt(k,474)*y(k,237) + mat(k,1211) = .300_r8*rxt(k,410)*y(k,237) + mat(k,454) = -(rxt(k,283)*y(k,253)) + mat(k,1728) = -rxt(k,283)*y(k,55) + mat(k,1963) = rxt(k,280)*y(k,242) + mat(k,2233) = rxt(k,280)*y(k,237) + mat(k,1477) = -(rxt(k,195)*y(k,58) + rxt(k,251)*y(k,75) + rxt(k,284)*y(k,253) & + + (rxt(k,290) + rxt(k,291) + rxt(k,292)) * y(k,252)) + mat(k,2116) = -rxt(k,195)*y(k,56) + mat(k,911) = -rxt(k,251)*y(k,56) + mat(k,1816) = -rxt(k,284)*y(k,56) + mat(k,1644) = -(rxt(k,290) + rxt(k,291) + rxt(k,292)) * y(k,56) + mat(k,1054) = .100_r8*rxt(k,327)*y(k,140) + mat(k,2178) = .100_r8*rxt(k,327)*y(k,31) + mat(k,460) = -(rxt(k,247)*y(k,252) + rxt(k,264)*y(k,58) + rxt(k,265)*y(k,253)) + mat(k,1637) = -rxt(k,247)*y(k,57) + mat(k,2099) = -rxt(k,264)*y(k,57) + mat(k,1729) = -rxt(k,265)*y(k,57) + mat(k,2129) = -(rxt(k,194)*y(k,44) + rxt(k,195)*y(k,56) + rxt(k,196)*y(k,79) & + + rxt(k,197)*y(k,81) + (rxt(k,198) + rxt(k,199)) * y(k,242) & + + rxt(k,200)*y(k,140) + rxt(k,207)*y(k,62) + rxt(k,216)*y(k,94) & + + rxt(k,257)*y(k,43) + rxt(k,259)*y(k,45) + rxt(k,262)*y(k,48) & + + rxt(k,264)*y(k,57) + rxt(k,305)*y(k,30)) + mat(k,1542) = -rxt(k,194)*y(k,58) + mat(k,1487) = -rxt(k,195)*y(k,58) + mat(k,1458) = -rxt(k,196)*y(k,58) + mat(k,650) = -rxt(k,197)*y(k,58) + mat(k,2309) = -(rxt(k,198) + rxt(k,199)) * y(k,58) + mat(k,2191) = -rxt(k,200)*y(k,58) + mat(k,979) = -rxt(k,207)*y(k,58) + mat(k,859) = -rxt(k,216)*y(k,58) + mat(k,513) = -rxt(k,257)*y(k,58) + mat(k,632) = -rxt(k,259)*y(k,58) + mat(k,407) = -rxt(k,262)*y(k,58) + mat(k,465) = -rxt(k,264)*y(k,58) + mat(k,331) = -rxt(k,305)*y(k,58) + mat(k,1853) = rxt(k,235)*y(k,61) + mat(k,143) = 4.000_r8*rxt(k,219)*y(k,252) + mat(k,184) = rxt(k,220)*y(k,252) + mat(k,161) = 2.000_r8*rxt(k,221)*y(k,252) + mat(k,194) = 2.000_r8*rxt(k,222)*y(k,252) + mat(k,165) = 2.000_r8*rxt(k,223)*y(k,252) + mat(k,199) = rxt(k,224)*y(k,252) + mat(k,169) = 2.000_r8*rxt(k,225)*y(k,252) + mat(k,172) = 3.000_r8*rxt(k,261)*y(k,253) + mat(k,407) = mat(k,407) + rxt(k,263)*y(k,253) + mat(k,2335) = rxt(k,235)*y(k,21) + (4.000_r8*rxt(k,202)+2.000_r8*rxt(k,204)) & + *y(k,61) + rxt(k,206)*y(k,129) + rxt(k,211)*y(k,139) & + + rxt(k,489)*y(k,158) + rxt(k,201)*y(k,237) + rxt(k,212) & + *y(k,253) + mat(k,294) = rxt(k,256)*y(k,252) + mat(k,290) = rxt(k,271)*y(k,252) + rxt(k,266)*y(k,253) + mat(k,300) = rxt(k,272)*y(k,252) + rxt(k,267)*y(k,253) + mat(k,338) = rxt(k,273)*y(k,252) + rxt(k,268)*y(k,253) + mat(k,2031) = rxt(k,214)*y(k,139) + rxt(k,226)*y(k,252) + rxt(k,215)*y(k,253) + mat(k,1956) = rxt(k,206)*y(k,61) + mat(k,1616) = rxt(k,211)*y(k,61) + rxt(k,214)*y(k,87) + mat(k,1284) = rxt(k,489)*y(k,61) + mat(k,2008) = rxt(k,201)*y(k,61) + mat(k,1657) = 4.000_r8*rxt(k,219)*y(k,35) + rxt(k,220)*y(k,36) & + + 2.000_r8*rxt(k,221)*y(k,38) + 2.000_r8*rxt(k,222)*y(k,39) & + + 2.000_r8*rxt(k,223)*y(k,40) + rxt(k,224)*y(k,41) & + + 2.000_r8*rxt(k,225)*y(k,42) + rxt(k,256)*y(k,67) + rxt(k,271) & + *y(k,84) + rxt(k,272)*y(k,85) + rxt(k,273)*y(k,86) + rxt(k,226) & + *y(k,87) + mat(k,1829) = 3.000_r8*rxt(k,261)*y(k,46) + rxt(k,263)*y(k,48) + rxt(k,212) & + *y(k,61) + rxt(k,266)*y(k,84) + rxt(k,267)*y(k,85) + rxt(k,268) & + *y(k,86) + rxt(k,215)*y(k,87) + mat(k,2095) = rxt(k,207)*y(k,62) + mat(k,2315) = 2.000_r8*rxt(k,203)*y(k,61) + mat(k,970) = rxt(k,207)*y(k,58) + (rxt(k,551)+rxt(k,556)+rxt(k,561))*y(k,87) + mat(k,2013) = (rxt(k,551)+rxt(k,556)+rxt(k,561))*y(k,62) + (rxt(k,546) & + +rxt(k,552)+rxt(k,557))*y(k,94) + mat(k,854) = (rxt(k,546)+rxt(k,552)+rxt(k,557))*y(k,87) + mat(k,2314) = 2.000_r8*rxt(k,228)*y(k,61) + mat(k,2338) = -(rxt(k,201)*y(k,237) + (4._r8*rxt(k,202) + 4._r8*rxt(k,203) & + + 4._r8*rxt(k,204) + 4._r8*rxt(k,228)) * y(k,61) + rxt(k,205) & + *y(k,242) + rxt(k,206)*y(k,129) + rxt(k,208)*y(k,130) + rxt(k,211) & + *y(k,139) + (rxt(k,212) + rxt(k,213)) * y(k,253) + (rxt(k,234) & + + rxt(k,235) + rxt(k,236)) * y(k,21) + rxt(k,489)*y(k,158)) + mat(k,2011) = -rxt(k,201)*y(k,61) + mat(k,2312) = -rxt(k,205)*y(k,61) + mat(k,1959) = -rxt(k,206)*y(k,61) + mat(k,1588) = -rxt(k,208)*y(k,61) + mat(k,1619) = -rxt(k,211)*y(k,61) + mat(k,1832) = -(rxt(k,212) + rxt(k,213)) * y(k,61) + mat(k,1856) = -(rxt(k,234) + rxt(k,235) + rxt(k,236)) * y(k,61) + mat(k,1287) = -rxt(k,489)*y(k,61) + mat(k,2132) = rxt(k,216)*y(k,94) + rxt(k,200)*y(k,140) + rxt(k,199)*y(k,242) + mat(k,980) = rxt(k,209)*y(k,139) + mat(k,2034) = rxt(k,227)*y(k,252) + mat(k,860) = rxt(k,216)*y(k,58) + rxt(k,217)*y(k,139) + rxt(k,218)*y(k,253) + mat(k,1619) = mat(k,1619) + rxt(k,209)*y(k,62) + rxt(k,217)*y(k,94) + mat(k,2194) = rxt(k,200)*y(k,58) + mat(k,364) = rxt(k,494)*y(k,158) + mat(k,1287) = mat(k,1287) + rxt(k,494)*y(k,142) + mat(k,2312) = mat(k,2312) + rxt(k,199)*y(k,58) + mat(k,1660) = rxt(k,227)*y(k,87) + mat(k,1832) = mat(k,1832) + rxt(k,218)*y(k,94) + 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,972) = -(rxt(k,207)*y(k,58) + rxt(k,209)*y(k,139) + rxt(k,210)*y(k,253) & + + (rxt(k,551) + rxt(k,556) + rxt(k,561)) * y(k,87)) + mat(k,2107) = -rxt(k,207)*y(k,62) + mat(k,1598) = -rxt(k,209)*y(k,62) + mat(k,1785) = -rxt(k,210)*y(k,62) + mat(k,2017) = -(rxt(k,551) + rxt(k,556) + rxt(k,561)) * y(k,62) + mat(k,2320) = rxt(k,208)*y(k,130) + mat(k,1563) = rxt(k,208)*y(k,61) + mat(k,1127) = -(rxt(k,294)*y(k,253)) + mat(k,1797) = -rxt(k,294)*y(k,64) + mat(k,1020) = .230_r8*rxt(k,459)*y(k,140) + mat(k,1461) = rxt(k,230)*y(k,44) + mat(k,324) = .350_r8*rxt(k,296)*y(k,253) + mat(k,604) = .630_r8*rxt(k,298)*y(k,140) + mat(k,1050) = .560_r8*rxt(k,327)*y(k,140) + mat(k,1526) = rxt(k,230)*y(k,19) + rxt(k,194)*y(k,58) + rxt(k,275)*y(k,131) & + + rxt(k,276)*y(k,139) + rxt(k,277)*y(k,253) + mat(k,403) = rxt(k,262)*y(k,58) + mat(k,1264) = rxt(k,333)*y(k,131) + rxt(k,334)*y(k,253) + mat(k,2112) = rxt(k,194)*y(k,44) + rxt(k,262)*y(k,48) + mat(k,998) = rxt(k,321)*y(k,253) + mat(k,882) = .620_r8*rxt(k,404)*y(k,140) + mat(k,1252) = .650_r8*rxt(k,357)*y(k,140) + mat(k,944) = .230_r8*rxt(k,462)*y(k,140) + mat(k,1375) = .560_r8*rxt(k,371)*y(k,140) + mat(k,1926) = .170_r8*rxt(k,430)*y(k,238) + .220_r8*rxt(k,355)*y(k,246) & + + .400_r8*rxt(k,433)*y(k,247) + .350_r8*rxt(k,436)*y(k,249) & + + .225_r8*rxt(k,471)*y(k,257) + .250_r8*rxt(k,412)*y(k,260) + mat(k,2059) = rxt(k,275)*y(k,44) + rxt(k,333)*y(k,51) + .220_r8*rxt(k,354) & + *y(k,246) + .500_r8*rxt(k,413)*y(k,260) + mat(k,1599) = rxt(k,276)*y(k,44) + rxt(k,483)*y(k,143) + mat(k,2162) = .230_r8*rxt(k,459)*y(k,6) + .630_r8*rxt(k,298)*y(k,27) & + + .560_r8*rxt(k,327)*y(k,31) + .620_r8*rxt(k,404)*y(k,100) & + + .650_r8*rxt(k,357)*y(k,111) + .230_r8*rxt(k,462)*y(k,116) & + + .560_r8*rxt(k,371)*y(k,118) + mat(k,413) = rxt(k,483)*y(k,139) + rxt(k,484)*y(k,253) + mat(k,1117) = .700_r8*rxt(k,480)*y(k,253) + mat(k,1422) = .220_r8*rxt(k,351)*y(k,246) + .250_r8*rxt(k,409)*y(k,260) + mat(k,1980) = .110_r8*rxt(k,352)*y(k,246) + .125_r8*rxt(k,469)*y(k,257) & + + .200_r8*rxt(k,410)*y(k,260) + mat(k,805) = .170_r8*rxt(k,430)*y(k,129) + .070_r8*rxt(k,429)*y(k,242) + mat(k,2279) = .070_r8*rxt(k,429)*y(k,238) + .160_r8*rxt(k,432)*y(k,247) & + + .140_r8*rxt(k,435)*y(k,249) + mat(k,1353) = .220_r8*rxt(k,355)*y(k,129) + .220_r8*rxt(k,354)*y(k,131) & + + .220_r8*rxt(k,351)*y(k,236) + .110_r8*rxt(k,352)*y(k,237) + mat(k,760) = .400_r8*rxt(k,433)*y(k,129) + .160_r8*rxt(k,432)*y(k,242) + mat(k,920) = .350_r8*rxt(k,436)*y(k,129) + .140_r8*rxt(k,435)*y(k,242) + mat(k,1797) = mat(k,1797) + .350_r8*rxt(k,296)*y(k,26) + rxt(k,277)*y(k,44) & + + rxt(k,334)*y(k,51) + rxt(k,321)*y(k,77) + rxt(k,484)*y(k,143) & + + .700_r8*rxt(k,480)*y(k,217) + mat(k,1162) = .225_r8*rxt(k,471)*y(k,129) + .125_r8*rxt(k,469)*y(k,237) + mat(k,1215) = .250_r8*rxt(k,412)*y(k,129) + .500_r8*rxt(k,413)*y(k,131) & + + .250_r8*rxt(k,409)*y(k,236) + .200_r8*rxt(k,410)*y(k,237) + mat(k,1010) = .270_r8*rxt(k,459)*y(k,140) + mat(k,1045) = .200_r8*rxt(k,327)*y(k,140) + mat(k,730) = rxt(k,314)*y(k,253) + mat(k,636) = .500_r8*rxt(k,315)*y(k,253) + mat(k,1126) = rxt(k,294)*y(k,253) + mat(k,1090) = .800_r8*rxt(k,320)*y(k,253) + mat(k,996) = rxt(k,321)*y(k,253) + mat(k,988) = rxt(k,286)*y(k,253) + mat(k,654) = .500_r8*rxt(k,370)*y(k,253) + mat(k,935) = .270_r8*rxt(k,462)*y(k,140) + mat(k,1371) = .100_r8*rxt(k,371)*y(k,140) + mat(k,1913) = rxt(k,313)*y(k,236) + .900_r8*rxt(k,471)*y(k,257) + mat(k,2147) = .270_r8*rxt(k,459)*y(k,6) + .200_r8*rxt(k,327)*y(k,31) & + + .270_r8*rxt(k,462)*y(k,116) + .100_r8*rxt(k,371)*y(k,118) + mat(k,1114) = 1.800_r8*rxt(k,480)*y(k,253) + mat(k,1418) = rxt(k,313)*y(k,129) + 4.000_r8*rxt(k,310)*y(k,236) & + + .900_r8*rxt(k,311)*y(k,237) + rxt(k,384)*y(k,244) & + + 2.000_r8*rxt(k,360)*y(k,248) + rxt(k,409)*y(k,260) + mat(k,1970) = .900_r8*rxt(k,311)*y(k,236) + rxt(k,361)*y(k,248) & + + .500_r8*rxt(k,469)*y(k,257) + mat(k,2267) = .450_r8*rxt(k,362)*y(k,248) + mat(k,1292) = rxt(k,384)*y(k,236) + mat(k,1397) = 2.000_r8*rxt(k,360)*y(k,236) + rxt(k,361)*y(k,237) & + + .450_r8*rxt(k,362)*y(k,242) + 4.000_r8*rxt(k,363)*y(k,248) + mat(k,1777) = rxt(k,314)*y(k,52) + .500_r8*rxt(k,315)*y(k,53) + rxt(k,294) & + *y(k,64) + .800_r8*rxt(k,320)*y(k,76) + rxt(k,321)*y(k,77) & + + rxt(k,286)*y(k,89) + .500_r8*rxt(k,370)*y(k,115) & + + 1.800_r8*rxt(k,480)*y(k,217) + mat(k,1158) = .900_r8*rxt(k,471)*y(k,129) + .500_r8*rxt(k,469)*y(k,237) + mat(k,1212) = rxt(k,409)*y(k,236) + mat(k,283) = -(rxt(k,255)*y(k,252)) + mat(k,1632) = -rxt(k,255)*y(k,66) + mat(k,181) = rxt(k,220)*y(k,252) + mat(k,186) = rxt(k,246)*y(k,252) + mat(k,191) = rxt(k,222)*y(k,252) + mat(k,163) = 2.000_r8*rxt(k,223)*y(k,252) + mat(k,196) = 2.000_r8*rxt(k,224)*y(k,252) + mat(k,167) = rxt(k,225)*y(k,252) + mat(k,151) = 2.000_r8*rxt(k,248)*y(k,252) + mat(k,295) = rxt(k,272)*y(k,252) + rxt(k,267)*y(k,253) + mat(k,333) = rxt(k,273)*y(k,252) + rxt(k,268)*y(k,253) + mat(k,1632) = mat(k,1632) + rxt(k,220)*y(k,36) + rxt(k,246)*y(k,37) & + + rxt(k,222)*y(k,39) + 2.000_r8*rxt(k,223)*y(k,40) & + + 2.000_r8*rxt(k,224)*y(k,41) + rxt(k,225)*y(k,42) & + + 2.000_r8*rxt(k,248)*y(k,80) + rxt(k,272)*y(k,85) + rxt(k,273) & + *y(k,86) + mat(k,1703) = rxt(k,267)*y(k,85) + rxt(k,268)*y(k,86) + mat(k,291) = -(rxt(k,256)*y(k,252)) + mat(k,1634) = -rxt(k,256)*y(k,67) + mat(k,159) = rxt(k,221)*y(k,252) + mat(k,192) = rxt(k,222)*y(k,252) + mat(k,287) = rxt(k,271)*y(k,252) + rxt(k,266)*y(k,253) + mat(k,1634) = mat(k,1634) + rxt(k,221)*y(k,38) + rxt(k,222)*y(k,39) & + + rxt(k,271)*y(k,84) + mat(k,1705) = rxt(k,266)*y(k,84) + mat(k,239) = -(rxt(k,428)*y(k,253)) + mat(k,1694) = -rxt(k,428)*y(k,68) + mat(k,233) = .180_r8*rxt(k,448)*y(k,253) + mat(k,1694) = mat(k,1694) + .180_r8*rxt(k,448)*y(k,219) + mat(k,349) = -(rxt(k,481)*y(k,131) + (rxt(k,482) + rxt(k,496)) * y(k,253)) + mat(k,2039) = -rxt(k,481)*y(k,69) + mat(k,1713) = -(rxt(k,482) + rxt(k,496)) * y(k,69) + mat(k,749) = rxt(k,316)*y(k,242) + mat(k,2219) = rxt(k,316)*y(k,241) + mat(k,909) = -(rxt(k,251)*y(k,56) + rxt(k,252)*y(k,79) + rxt(k,253)*y(k,263) & + + rxt(k,254)*y(k,91)) + mat(k,1474) = -rxt(k,251)*y(k,75) + mat(k,1447) = -rxt(k,252)*y(k,75) + mat(k,2344) = -rxt(k,253)*y(k,75) + mat(k,1491) = -rxt(k,254)*y(k,75) + mat(k,187) = rxt(k,246)*y(k,252) + mat(k,197) = rxt(k,224)*y(k,252) + mat(k,284) = 2.000_r8*rxt(k,255)*y(k,252) + mat(k,292) = rxt(k,256)*y(k,252) + mat(k,1641) = rxt(k,246)*y(k,37) + rxt(k,224)*y(k,41) + 2.000_r8*rxt(k,255) & + *y(k,66) + rxt(k,256)*y(k,67) + mat(k,1092) = -(rxt(k,320)*y(k,253)) + mat(k,1794) = -rxt(k,320)*y(k,76) + mat(k,618) = .700_r8*rxt(k,395)*y(k,253) + mat(k,595) = .500_r8*rxt(k,396)*y(k,253) + mat(k,468) = rxt(k,407)*y(k,253) + mat(k,1923) = .050_r8*rxt(k,393)*y(k,245) + .530_r8*rxt(k,355)*y(k,246) & + + .225_r8*rxt(k,471)*y(k,257) + .250_r8*rxt(k,412)*y(k,260) + mat(k,2056) = .050_r8*rxt(k,394)*y(k,245) + .530_r8*rxt(k,354)*y(k,246) & + + .250_r8*rxt(k,413)*y(k,260) + mat(k,1421) = .530_r8*rxt(k,351)*y(k,246) + .250_r8*rxt(k,409)*y(k,260) + mat(k,1977) = .260_r8*rxt(k,352)*y(k,246) + .125_r8*rxt(k,469)*y(k,257) & + + .100_r8*rxt(k,410)*y(k,260) + mat(k,1326) = .050_r8*rxt(k,393)*y(k,129) + .050_r8*rxt(k,394)*y(k,131) + mat(k,1352) = .530_r8*rxt(k,355)*y(k,129) + .530_r8*rxt(k,354)*y(k,131) & + + .530_r8*rxt(k,351)*y(k,236) + .260_r8*rxt(k,352)*y(k,237) + mat(k,1794) = mat(k,1794) + .700_r8*rxt(k,395)*y(k,101) + .500_r8*rxt(k,396) & + *y(k,102) + rxt(k,407)*y(k,122) + mat(k,1160) = .225_r8*rxt(k,471)*y(k,129) + .125_r8*rxt(k,469)*y(k,237) + mat(k,1214) = .250_r8*rxt(k,412)*y(k,129) + .250_r8*rxt(k,413)*y(k,131) & + + .250_r8*rxt(k,409)*y(k,236) + .100_r8*rxt(k,410)*y(k,237) + mat(k,997) = -(rxt(k,321)*y(k,253)) + mat(k,1788) = -rxt(k,321)*y(k,77) + mat(k,323) = .650_r8*rxt(k,296)*y(k,253) + mat(k,1091) = .200_r8*rxt(k,320)*y(k,253) + mat(k,1068) = rxt(k,408)*y(k,253) + mat(k,1919) = rxt(k,419)*y(k,231) + .050_r8*rxt(k,393)*y(k,245) & + + .400_r8*rxt(k,433)*y(k,247) + .170_r8*rxt(k,436)*y(k,249) & + + .700_r8*rxt(k,439)*y(k,254) + .600_r8*rxt(k,446)*y(k,259) & + + .250_r8*rxt(k,412)*y(k,260) + .340_r8*rxt(k,452)*y(k,261) & + + .170_r8*rxt(k,455)*y(k,262) + mat(k,2050) = .050_r8*rxt(k,394)*y(k,245) + .250_r8*rxt(k,413)*y(k,260) + mat(k,538) = rxt(k,419)*y(k,129) + mat(k,1419) = .250_r8*rxt(k,409)*y(k,260) + mat(k,1973) = .100_r8*rxt(k,410)*y(k,260) + mat(k,2273) = .160_r8*rxt(k,432)*y(k,247) + .070_r8*rxt(k,435)*y(k,249) + mat(k,1325) = .050_r8*rxt(k,393)*y(k,129) + .050_r8*rxt(k,394)*y(k,131) + mat(k,759) = .400_r8*rxt(k,433)*y(k,129) + .160_r8*rxt(k,432)*y(k,242) + mat(k,919) = .170_r8*rxt(k,436)*y(k,129) + .070_r8*rxt(k,435)*y(k,242) + mat(k,1788) = mat(k,1788) + .650_r8*rxt(k,296)*y(k,26) + .200_r8*rxt(k,320) & + *y(k,76) + rxt(k,408)*y(k,123) + mat(k,500) = .700_r8*rxt(k,439)*y(k,129) + mat(k,772) = .600_r8*rxt(k,446)*y(k,129) + mat(k,1213) = .250_r8*rxt(k,412)*y(k,129) + .250_r8*rxt(k,413)*y(k,131) & + + .250_r8*rxt(k,409)*y(k,236) + .100_r8*rxt(k,410)*y(k,237) + mat(k,796) = .340_r8*rxt(k,452)*y(k,129) + mat(k,545) = .170_r8*rxt(k,455)*y(k,129) + mat(k,1510) = -((rxt(k,154) + rxt(k,155) + rxt(k,156)) * y(k,242) + rxt(k,160) & + *y(k,140)) + mat(k,2298) = -(rxt(k,154) + rxt(k,155) + rxt(k,156)) * y(k,78) + mat(k,2180) = -rxt(k,160)*y(k,78) + mat(k,1531) = rxt(k,277)*y(k,253) + mat(k,1479) = rxt(k,291)*y(k,252) + mat(k,2118) = rxt(k,196)*y(k,79) + mat(k,913) = rxt(k,252)*y(k,79) + mat(k,1451) = rxt(k,196)*y(k,58) + rxt(k,252)*y(k,75) + rxt(k,152)*y(k,139) & + + rxt(k,144)*y(k,252) + rxt(k,161)*y(k,253) + mat(k,848) = rxt(k,250)*y(k,252) + mat(k,2020) = rxt(k,227)*y(k,252) + mat(k,528) = rxt(k,182)*y(k,253) + mat(k,1605) = rxt(k,152)*y(k,79) + rxt(k,164)*y(k,253) + mat(k,415) = rxt(k,484)*y(k,253) + mat(k,558) = rxt(k,490)*y(k,253) + mat(k,1278) = rxt(k,495)*y(k,253) + mat(k,1646) = rxt(k,291)*y(k,56) + rxt(k,144)*y(k,79) + rxt(k,250)*y(k,83) & + + rxt(k,227)*y(k,87) + mat(k,1818) = rxt(k,277)*y(k,44) + rxt(k,161)*y(k,79) + rxt(k,182)*y(k,119) & + + rxt(k,164)*y(k,139) + rxt(k,484)*y(k,143) + rxt(k,490) & + *y(k,156) + rxt(k,495)*y(k,158) + mat(k,1448) = -(rxt(k,144)*y(k,252) + rxt(k,152)*y(k,139) + rxt(k,161) & + *y(k,253) + rxt(k,196)*y(k,58) + rxt(k,252)*y(k,75)) + mat(k,1642) = -rxt(k,144)*y(k,79) + mat(k,1601) = -rxt(k,152)*y(k,79) + mat(k,1814) = -rxt(k,161)*y(k,79) + mat(k,2114) = -rxt(k,196)*y(k,79) + mat(k,910) = -rxt(k,252)*y(k,79) + mat(k,1476) = rxt(k,292)*y(k,252) + mat(k,1507) = rxt(k,154)*y(k,242) + mat(k,2294) = rxt(k,154)*y(k,78) + mat(k,1642) = mat(k,1642) + rxt(k,292)*y(k,56) + 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,150) = -(rxt(k,248)*y(k,252)) + mat(k,1622) = -rxt(k,248)*y(k,80) + mat(k,646) = -(rxt(k,153)*y(k,139) + rxt(k,162)*y(k,253) + rxt(k,197)*y(k,58)) + mat(k,1593) = -rxt(k,153)*y(k,81) + mat(k,1754) = -rxt(k,162)*y(k,81) + mat(k,2103) = -rxt(k,197)*y(k,81) + mat(k,2247) = 2.000_r8*rxt(k,168)*y(k,242) + mat(k,1754) = mat(k,1754) + 2.000_r8*rxt(k,167)*y(k,253) + mat(k,301) = rxt(k,497)*y(k,263) + mat(k,2340) = rxt(k,497)*y(k,160) + mat(k,846) = -(rxt(k,243)*y(k,139) + rxt(k,244)*y(k,253) + (rxt(k,249) & + + rxt(k,250)) * y(k,252)) + mat(k,1595) = -rxt(k,243)*y(k,83) + mat(k,1774) = -rxt(k,244)*y(k,83) + mat(k,1640) = -(rxt(k,249) + rxt(k,250)) * y(k,83) + mat(k,1460) = rxt(k,230)*y(k,44) + rxt(k,231)*y(k,242) + mat(k,1524) = rxt(k,230)*y(k,19) + mat(k,2264) = rxt(k,231)*y(k,19) + mat(k,286) = -(rxt(k,266)*y(k,253) + rxt(k,271)*y(k,252)) + mat(k,1704) = -rxt(k,266)*y(k,84) + mat(k,1633) = -rxt(k,271)*y(k,84) + mat(k,296) = -(rxt(k,267)*y(k,253) + rxt(k,272)*y(k,252)) + mat(k,1706) = -rxt(k,267)*y(k,85) + mat(k,1635) = -rxt(k,272)*y(k,85) + mat(k,334) = -(rxt(k,268)*y(k,253) + rxt(k,273)*y(k,252)) + mat(k,1712) = -rxt(k,268)*y(k,86) + mat(k,1636) = -rxt(k,273)*y(k,86) + mat(k,2029) = -(rxt(k,214)*y(k,139) + rxt(k,215)*y(k,253) + (rxt(k,226) & + + rxt(k,227)) * y(k,252) + (rxt(k,546) + rxt(k,552) + rxt(k,557) & + ) * y(k,94) + (rxt(k,551) + rxt(k,556) + rxt(k,561)) * y(k,62) & + + (rxt(k,553) + rxt(k,558)) * y(k,93)) + mat(k,1614) = -rxt(k,214)*y(k,87) + mat(k,1827) = -rxt(k,215)*y(k,87) + mat(k,1655) = -(rxt(k,226) + rxt(k,227)) * y(k,87) + mat(k,858) = -(rxt(k,546) + rxt(k,552) + rxt(k,557)) * y(k,87) + mat(k,977) = -(rxt(k,551) + rxt(k,556) + rxt(k,561)) * y(k,87) + mat(k,828) = -(rxt(k,553) + rxt(k,558)) * y(k,87) + mat(k,330) = rxt(k,305)*y(k,58) + mat(k,512) = rxt(k,257)*y(k,58) + mat(k,1540) = rxt(k,194)*y(k,58) + mat(k,631) = rxt(k,259)*y(k,58) + mat(k,406) = 2.000_r8*rxt(k,262)*y(k,58) + mat(k,1485) = rxt(k,195)*y(k,58) + mat(k,464) = rxt(k,264)*y(k,58) + mat(k,2127) = rxt(k,305)*y(k,30) + rxt(k,257)*y(k,43) + rxt(k,194)*y(k,44) & + + rxt(k,259)*y(k,45) + 2.000_r8*rxt(k,262)*y(k,48) + rxt(k,195) & + *y(k,56) + rxt(k,264)*y(k,57) + rxt(k,196)*y(k,79) + rxt(k,197) & + *y(k,81) + rxt(k,216)*y(k,94) + rxt(k,198)*y(k,242) + mat(k,2333) = rxt(k,213)*y(k,253) + mat(k,1456) = rxt(k,196)*y(k,58) + mat(k,649) = rxt(k,197)*y(k,58) + mat(k,858) = mat(k,858) + rxt(k,216)*y(k,58) + mat(k,2307) = rxt(k,198)*y(k,58) + mat(k,1827) = mat(k,1827) + rxt(k,213)*y(k,61) + mat(k,227) = -(rxt(k,285)*y(k,253) + rxt(k,293)*y(k,252)) + mat(k,1692) = -rxt(k,285)*y(k,88) + mat(k,1631) = -rxt(k,293)*y(k,88) + mat(k,989) = -(rxt(k,286)*y(k,253)) + mat(k,1787) = -rxt(k,286)*y(k,89) + mat(k,1013) = .050_r8*rxt(k,459)*y(k,140) + mat(k,322) = .350_r8*rxt(k,296)*y(k,253) + mat(k,603) = .370_r8*rxt(k,298)*y(k,140) + mat(k,1047) = .120_r8*rxt(k,327)*y(k,140) + mat(k,880) = .110_r8*rxt(k,404)*y(k,140) + mat(k,1251) = .330_r8*rxt(k,357)*y(k,140) + mat(k,939) = .050_r8*rxt(k,462)*y(k,140) + mat(k,1372) = .120_r8*rxt(k,371)*y(k,140) + mat(k,1918) = rxt(k,289)*y(k,243) + mat(k,2153) = .050_r8*rxt(k,459)*y(k,6) + .370_r8*rxt(k,298)*y(k,27) & + + .120_r8*rxt(k,327)*y(k,31) + .110_r8*rxt(k,404)*y(k,100) & + + .330_r8*rxt(k,357)*y(k,111) + .050_r8*rxt(k,462)*y(k,116) & + + .120_r8*rxt(k,371)*y(k,118) + mat(k,2272) = rxt(k,287)*y(k,243) + mat(k,493) = rxt(k,289)*y(k,129) + rxt(k,287)*y(k,242) + mat(k,1787) = mat(k,1787) + .350_r8*rxt(k,296)*y(k,26) + mat(k,1472) = rxt(k,251)*y(k,75) + mat(k,908) = rxt(k,251)*y(k,56) + rxt(k,252)*y(k,79) + rxt(k,254)*y(k,91) & + + rxt(k,253)*y(k,263) + mat(k,1446) = rxt(k,252)*y(k,75) + mat(k,1490) = rxt(k,254)*y(k,75) + mat(k,2342) = rxt(k,253)*y(k,75) + mat(k,1494) = -(rxt(k,191)*y(k,253) + rxt(k,254)*y(k,75)) + mat(k,1817) = -rxt(k,191)*y(k,91) + mat(k,912) = -rxt(k,254)*y(k,91) + mat(k,1530) = rxt(k,275)*y(k,131) + mat(k,1084) = rxt(k,307)*y(k,131) + mat(k,1267) = rxt(k,333)*y(k,131) + mat(k,973) = (rxt(k,551)+rxt(k,556)+rxt(k,561))*y(k,87) + mat(k,351) = rxt(k,481)*y(k,131) + mat(k,2019) = (rxt(k,551)+rxt(k,556)+rxt(k,561))*y(k,62) + mat(k,1573) = rxt(k,190)*y(k,253) + mat(k,2078) = rxt(k,275)*y(k,44) + rxt(k,307)*y(k,47) + rxt(k,333)*y(k,51) & + + rxt(k,481)*y(k,69) + mat(k,1817) = mat(k,1817) + rxt(k,190)*y(k,130) + mat(k,442) = -(rxt(k,169)*y(k,253)) + mat(k,1726) = -rxt(k,169)*y(k,92) + mat(k,1549) = rxt(k,188)*y(k,242) + mat(k,2231) = rxt(k,188)*y(k,130) + mat(k,823) = -(rxt(k,245)*y(k,139) + (rxt(k,553) + rxt(k,558)) * y(k,87)) + mat(k,1594) = -rxt(k,245)*y(k,93) + mat(k,2015) = -(rxt(k,553) + rxt(k,558)) * y(k,93) + mat(k,1837) = rxt(k,237)*y(k,242) + mat(k,2262) = rxt(k,237)*y(k,21) + mat(k,855) = -(rxt(k,216)*y(k,58) + rxt(k,217)*y(k,139) + rxt(k,218)*y(k,253) & + + (rxt(k,546) + rxt(k,552) + rxt(k,557)) * y(k,87)) + mat(k,2105) = -rxt(k,216)*y(k,94) + mat(k,1596) = -rxt(k,217)*y(k,94) + mat(k,1775) = -rxt(k,218)*y(k,94) + mat(k,2016) = -(rxt(k,546) + rxt(k,552) + rxt(k,557)) * y(k,94) + mat(k,2318) = rxt(k,205)*y(k,242) + mat(k,971) = rxt(k,210)*y(k,253) + mat(k,2265) = rxt(k,205)*y(k,61) + mat(k,1775) = mat(k,1775) + rxt(k,210)*y(k,62) + mat(k,1136) = -(rxt(k,350)*y(k,253)) + mat(k,1798) = -rxt(k,350)*y(k,95) + mat(k,619) = .300_r8*rxt(k,395)*y(k,253) + mat(k,596) = .500_r8*rxt(k,396)*y(k,253) + mat(k,1927) = rxt(k,349)*y(k,239) + rxt(k,356)*y(k,246) + mat(k,612) = rxt(k,349)*y(k,129) + mat(k,1354) = rxt(k,356)*y(k,129) + mat(k,1798) = mat(k,1798) + .300_r8*rxt(k,395)*y(k,101) + .500_r8*rxt(k,396) & + *y(k,102) + mat(k,278) = -(rxt(k,381)*y(k,253)) + mat(k,1702) = -rxt(k,381)*y(k,96) + mat(k,1149) = -(rxt(k,335)*y(k,253)) + mat(k,1799) = -rxt(k,335)*y(k,97) + mat(k,620) = .700_r8*rxt(k,395)*y(k,253) + mat(k,597) = .500_r8*rxt(k,396)*y(k,253) + mat(k,655) = .500_r8*rxt(k,370)*y(k,253) + mat(k,1928) = .050_r8*rxt(k,393)*y(k,245) + .220_r8*rxt(k,355)*y(k,246) & + + .250_r8*rxt(k,412)*y(k,260) + mat(k,2061) = .050_r8*rxt(k,394)*y(k,245) + .220_r8*rxt(k,354)*y(k,246) & + + .250_r8*rxt(k,413)*y(k,260) + mat(k,588) = .500_r8*rxt(k,339)*y(k,253) + mat(k,1423) = .220_r8*rxt(k,351)*y(k,246) + .250_r8*rxt(k,409)*y(k,260) + mat(k,1981) = .230_r8*rxt(k,352)*y(k,246) + .200_r8*rxt(k,340)*y(k,256) & + + .100_r8*rxt(k,410)*y(k,260) + mat(k,1329) = .050_r8*rxt(k,393)*y(k,129) + .050_r8*rxt(k,394)*y(k,131) + mat(k,1355) = .220_r8*rxt(k,355)*y(k,129) + .220_r8*rxt(k,354)*y(k,131) & + + .220_r8*rxt(k,351)*y(k,236) + .230_r8*rxt(k,352)*y(k,237) + mat(k,1799) = mat(k,1799) + .700_r8*rxt(k,395)*y(k,101) + .500_r8*rxt(k,396) & + *y(k,102) + .500_r8*rxt(k,370)*y(k,115) + .500_r8*rxt(k,339) & + *y(k,154) + mat(k,1199) = .200_r8*rxt(k,340)*y(k,237) + mat(k,1216) = .250_r8*rxt(k,412)*y(k,129) + .250_r8*rxt(k,413)*y(k,131) & + + .250_r8*rxt(k,409)*y(k,236) + .100_r8*rxt(k,410)*y(k,237) + mat(k,381) = -(rxt(k,382)*y(k,253)) + mat(k,1717) = -rxt(k,382)*y(k,98) + mat(k,1886) = .870_r8*rxt(k,393)*y(k,245) + mat(k,2040) = .950_r8*rxt(k,394)*y(k,245) + mat(k,1414) = rxt(k,389)*y(k,245) + mat(k,1962) = .750_r8*rxt(k,390)*y(k,245) + mat(k,1318) = .870_r8*rxt(k,393)*y(k,129) + .950_r8*rxt(k,394)*y(k,131) & + + rxt(k,389)*y(k,236) + .750_r8*rxt(k,390)*y(k,237) + mat(k,174) = -(rxt(k,383)*y(k,253)) + mat(k,1688) = -rxt(k,383)*y(k,99) + mat(k,779) = .600_r8*rxt(k,406)*y(k,253) + mat(k,1688) = mat(k,1688) + .600_r8*rxt(k,406)*y(k,106) + mat(k,879) = -(rxt(k,397)*y(k,131) + rxt(k,404)*y(k,140) + rxt(k,405) & + *y(k,253)) + mat(k,2043) = -rxt(k,397)*y(k,100) + mat(k,2148) = -rxt(k,404)*y(k,100) + mat(k,1778) = -rxt(k,405)*y(k,100) + mat(k,617) = -(rxt(k,395)*y(k,253)) + mat(k,1750) = -rxt(k,395)*y(k,101) + mat(k,1899) = .080_r8*rxt(k,387)*y(k,244) + mat(k,1289) = .080_r8*rxt(k,387)*y(k,129) + mat(k,593) = -(rxt(k,396)*y(k,253)) + mat(k,1747) = -rxt(k,396)*y(k,102) + mat(k,1897) = .080_r8*rxt(k,393)*y(k,245) + mat(k,1319) = .080_r8*rxt(k,393)*y(k,129) + mat(k,1237) = -(rxt(k,398)*y(k,236) + rxt(k,399)*y(k,237) + rxt(k,400) & + *y(k,242) + rxt(k,401)*y(k,129) + rxt(k,402)*y(k,131)) + mat(k,1425) = -rxt(k,398)*y(k,103) + mat(k,1986) = -rxt(k,399)*y(k,103) + mat(k,2285) = -rxt(k,400)*y(k,103) + mat(k,1933) = -rxt(k,401)*y(k,103) + mat(k,2066) = -rxt(k,402)*y(k,103) + mat(k,883) = rxt(k,397)*y(k,131) + mat(k,2066) = mat(k,2066) + rxt(k,397)*y(k,100) + mat(k,424) = -(rxt(k,403)*y(k,253)) + mat(k,1724) = -rxt(k,403)*y(k,104) + mat(k,1228) = rxt(k,400)*y(k,242) + mat(k,2229) = rxt(k,400)*y(k,103) + mat(k,88) = -(rxt(k,521)*y(k,242) + rxt(k,522)*y(k,129)) + mat(k,2208) = -rxt(k,521)*y(k,105) + mat(k,1870) = -rxt(k,522)*y(k,105) + mat(k,878) = rxt(k,524)*y(k,253) + mat(k,1670) = rxt(k,524)*y(k,100) + mat(k,780) = -(rxt(k,406)*y(k,253)) + mat(k,1768) = -rxt(k,406)*y(k,106) + mat(k,2258) = rxt(k,386)*y(k,244) + rxt(k,391)*y(k,245) + mat(k,1290) = rxt(k,386)*y(k,242) + mat(k,1321) = rxt(k,391)*y(k,242) + mat(k,71) = -(rxt(k,527)*y(k,253)) + mat(k,1668) = -rxt(k,527)*y(k,107) + mat(k,69) = -(rxt(k,525)*y(k,242) + rxt(k,526)*y(k,129)) + mat(k,2201) = -rxt(k,525)*y(k,108) + mat(k,1863) = -rxt(k,526)*y(k,108) + mat(k,70) = rxt(k,527)*y(k,253) + mat(k,1667) = rxt(k,527)*y(k,107) + 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,107) = -(rxt(k,530)*y(k,253)) + mat(k,1678) = -rxt(k,530)*y(k,109) + mat(k,105) = -(rxt(k,528)*y(k,242) + rxt(k,529)*y(k,129)) + mat(k,2215) = -rxt(k,528)*y(k,110) + mat(k,1877) = -rxt(k,529)*y(k,110) + mat(k,106) = rxt(k,530)*y(k,253) + mat(k,1677) = rxt(k,530)*y(k,109) + mat(k,1253) = -(rxt(k,357)*y(k,140) + rxt(k,358)*y(k,253)) + mat(k,2168) = -rxt(k,357)*y(k,111) + mat(k,1805) = -rxt(k,358)*y(k,111) + mat(k,884) = .300_r8*rxt(k,404)*y(k,140) + mat(k,1934) = .360_r8*rxt(k,387)*y(k,244) + mat(k,2067) = .400_r8*rxt(k,388)*y(k,244) + mat(k,2168) = mat(k,2168) + .300_r8*rxt(k,404)*y(k,100) + mat(k,1426) = .390_r8*rxt(k,384)*y(k,244) + mat(k,1987) = .310_r8*rxt(k,385)*y(k,244) + mat(k,1299) = .360_r8*rxt(k,387)*y(k,129) + .400_r8*rxt(k,388)*y(k,131) & + + .390_r8*rxt(k,384)*y(k,236) + .310_r8*rxt(k,385)*y(k,237) + mat(k,384) = -(rxt(k,359)*y(k,253)) + mat(k,1718) = -rxt(k,359)*y(k,112) + mat(k,2226) = rxt(k,353)*y(k,246) + mat(k,1350) = rxt(k,353)*y(k,242) + mat(k,551) = -(rxt(k,368)*y(k,253)) + mat(k,1742) = -rxt(k,368)*y(k,113) + mat(k,1895) = .800_r8*rxt(k,377)*y(k,230) + mat(k,955) = .800_r8*rxt(k,377)*y(k,129) + mat(k,389) = -(rxt(k,369)*y(k,253)) + mat(k,1719) = -rxt(k,369)*y(k,114) + mat(k,2227) = .800_r8*rxt(k,366)*y(k,250) + mat(k,698) = .800_r8*rxt(k,366)*y(k,242) + mat(k,653) = -(rxt(k,370)*y(k,253)) + mat(k,1755) = -rxt(k,370)*y(k,115) + mat(k,1555) = rxt(k,373)*y(k,248) + mat(k,1395) = rxt(k,373)*y(k,130) + mat(k,936) = -(rxt(k,461)*y(k,131) + rxt(k,462)*y(k,140) + rxt(k,463) & + *y(k,253)) + mat(k,2046) = -rxt(k,461)*y(k,116) + mat(k,2150) = -rxt(k,462)*y(k,116) + mat(k,1783) = -rxt(k,463)*y(k,116) + mat(k,94) = -(rxt(k,532)*y(k,242) + rxt(k,533)*y(k,129)) + mat(k,2209) = -rxt(k,532)*y(k,117) + mat(k,1871) = -rxt(k,533)*y(k,117) + mat(k,932) = rxt(k,535)*y(k,253) + mat(k,1671) = rxt(k,535)*y(k,116) + mat(k,1379) = -(rxt(k,371)*y(k,140) + rxt(k,372)*y(k,253)) + mat(k,2174) = -rxt(k,371)*y(k,118) + mat(k,1811) = -rxt(k,372)*y(k,118) + mat(k,887) = .200_r8*rxt(k,404)*y(k,140) + mat(k,1939) = .560_r8*rxt(k,387)*y(k,244) + mat(k,2073) = .600_r8*rxt(k,388)*y(k,244) + mat(k,2174) = mat(k,2174) + .200_r8*rxt(k,404)*y(k,100) + mat(k,1431) = .610_r8*rxt(k,384)*y(k,244) + mat(k,1992) = .440_r8*rxt(k,385)*y(k,244) + mat(k,1303) = .560_r8*rxt(k,387)*y(k,129) + .600_r8*rxt(k,388)*y(k,131) & + + .610_r8*rxt(k,384)*y(k,236) + .440_r8*rxt(k,385)*y(k,237) + mat(k,527) = -(rxt(k,170)*y(k,129) + (rxt(k,171) + rxt(k,172) + rxt(k,173) & + ) * y(k,130) + rxt(k,182)*y(k,253)) + mat(k,1892) = -rxt(k,170)*y(k,119) + mat(k,1551) = -(rxt(k,171) + rxt(k,172) + rxt(k,173)) * y(k,119) + mat(k,1739) = -rxt(k,182)*y(k,119) + mat(k,224) = -((rxt(k,186) + rxt(k,187)) * y(k,252)) + mat(k,1630) = -(rxt(k,186) + rxt(k,187)) * y(k,120) + mat(k,526) = rxt(k,171)*y(k,130) + mat(k,1547) = rxt(k,171)*y(k,119) + mat(k,1548) = rxt(k,189)*y(k,131) + mat(k,2038) = rxt(k,189)*y(k,130) + mat(k,466) = -(rxt(k,407)*y(k,253)) + mat(k,1730) = -rxt(k,407)*y(k,122) + mat(k,1229) = .200_r8*rxt(k,399)*y(k,237) + mat(k,1964) = .200_r8*rxt(k,399)*y(k,103) + mat(k,1069) = -(rxt(k,408)*y(k,253)) + mat(k,1792) = -rxt(k,408)*y(k,123) + mat(k,1233) = rxt(k,401)*y(k,129) + rxt(k,402)*y(k,131) + rxt(k,398)*y(k,236) & + + .800_r8*rxt(k,399)*y(k,237) + mat(k,1921) = rxt(k,401)*y(k,103) + mat(k,2054) = rxt(k,402)*y(k,103) + mat(k,1420) = rxt(k,398)*y(k,103) + mat(k,1975) = .800_r8*rxt(k,399)*y(k,103) + mat(k,138) = -(rxt(k,498)*y(k,253)) + mat(k,1684) = -rxt(k,498)*y(k,127) + mat(k,1952) = -(rxt(k,170)*y(k,119) + rxt(k,179)*y(k,131) + rxt(k,183) & + *y(k,242) + rxt(k,184)*y(k,140) + rxt(k,185)*y(k,139) + rxt(k,206) & + *y(k,61) + rxt(k,238)*y(k,21) + rxt(k,281)*y(k,237) + rxt(k,289) & + *y(k,243) + rxt(k,302)*y(k,233) + rxt(k,313)*y(k,236) + rxt(k,317) & + *y(k,241) + rxt(k,330)*y(k,234) + rxt(k,338)*y(k,255) + rxt(k,342) & + *y(k,256) + (rxt(k,348) + rxt(k,349)) * y(k,239) + (rxt(k,355) & + + rxt(k,356)) * y(k,246) + rxt(k,364)*y(k,248) + rxt(k,367) & + *y(k,250) + (rxt(k,377) + rxt(k,378)) * y(k,230) + rxt(k,387) & + *y(k,244) + rxt(k,393)*y(k,245) + rxt(k,401)*y(k,103) + rxt(k,412) & + *y(k,260) + rxt(k,416)*y(k,229) + rxt(k,419)*y(k,231) + rxt(k,424) & + *y(k,232) + rxt(k,426)*y(k,235) + rxt(k,430)*y(k,238) + rxt(k,433) & + *y(k,247) + rxt(k,436)*y(k,249) + rxt(k,439)*y(k,254) + rxt(k,446) & + *y(k,259) + rxt(k,452)*y(k,261) + rxt(k,455)*y(k,262) + rxt(k,466) & + *y(k,251) + rxt(k,471)*y(k,257) + rxt(k,476)*y(k,258)) + mat(k,533) = -rxt(k,170)*y(k,129) + mat(k,2086) = -rxt(k,179)*y(k,129) + mat(k,2305) = -rxt(k,183)*y(k,129) + mat(k,2187) = -rxt(k,184)*y(k,129) + mat(k,1612) = -rxt(k,185)*y(k,129) + mat(k,2331) = -rxt(k,206)*y(k,129) + mat(k,1849) = -rxt(k,238)*y(k,129) + mat(k,2004) = -rxt(k,281)*y(k,129) + mat(k,496) = -rxt(k,289)*y(k,129) + mat(k,870) = -rxt(k,302)*y(k,129) + mat(k,1440) = -rxt(k,313)*y(k,129) + mat(k,756) = -rxt(k,317)*y(k,129) + mat(k,842) = -rxt(k,330)*y(k,129) + mat(k,819) = -rxt(k,338)*y(k,129) + mat(k,1206) = -rxt(k,342)*y(k,129) + mat(k,615) = -(rxt(k,348) + rxt(k,349)) * y(k,129) + mat(k,1366) = -(rxt(k,355) + rxt(k,356)) * y(k,129) + mat(k,1408) = -rxt(k,364)*y(k,129) + mat(k,704) = -rxt(k,367)*y(k,129) + mat(k,967) = -(rxt(k,377) + rxt(k,378)) * y(k,129) + mat(k,1311) = -rxt(k,387)*y(k,129) + mat(k,1344) = -rxt(k,393)*y(k,129) + mat(k,1247) = -rxt(k,401)*y(k,129) + mat(k,1224) = -rxt(k,412)*y(k,129) + mat(k,567) = -rxt(k,416)*y(k,129) + mat(k,541) = -rxt(k,419)*y(k,129) + mat(k,490) = -rxt(k,424)*y(k,129) + mat(k,673) = -rxt(k,426)*y(k,129) + mat(k,809) = -rxt(k,430)*y(k,129) + mat(k,762) = -rxt(k,433)*y(k,129) + mat(k,924) = -rxt(k,436)*y(k,129) + mat(k,503) = -rxt(k,439)*y(k,129) + mat(k,777) = -rxt(k,446)*y(k,129) + mat(k,802) = -rxt(k,452)*y(k,129) + mat(k,549) = -rxt(k,455)*y(k,129) + mat(k,1110) = -rxt(k,466)*y(k,129) + mat(k,1171) = -rxt(k,471)*y(k,129) + mat(k,1192) = -rxt(k,476)*y(k,129) + mat(k,533) = mat(k,533) + 2.000_r8*rxt(k,172)*y(k,130) + rxt(k,182)*y(k,253) + mat(k,226) = 2.000_r8*rxt(k,186)*y(k,252) + mat(k,1581) = 2.000_r8*rxt(k,172)*y(k,119) + rxt(k,175)*y(k,139) + rxt(k,491) & + *y(k,158) + mat(k,1612) = mat(k,1612) + rxt(k,175)*y(k,130) + mat(k,1283) = rxt(k,491)*y(k,130) + mat(k,1653) = 2.000_r8*rxt(k,186)*y(k,120) + mat(k,1825) = rxt(k,182)*y(k,119) + mat(k,1576) = -((rxt(k,171) + rxt(k,172) + rxt(k,173)) * y(k,119) + (rxt(k,175) & + + rxt(k,177)) * y(k,139) + rxt(k,176)*y(k,140) + rxt(k,188) & + *y(k,242) + rxt(k,189)*y(k,131) + rxt(k,190)*y(k,253) + rxt(k,208) & + *y(k,61) + rxt(k,239)*y(k,21) + rxt(k,324)*y(k,236) + rxt(k,373) & + *y(k,248) + rxt(k,431)*y(k,238) + rxt(k,434)*y(k,247) + rxt(k,437) & + *y(k,249) + rxt(k,441)*y(k,147) + rxt(k,444)*y(k,229) + rxt(k,491) & + *y(k,158)) + mat(k,529) = -(rxt(k,171) + rxt(k,172) + rxt(k,173)) * y(k,130) + mat(k,1607) = -(rxt(k,175) + rxt(k,177)) * y(k,130) + mat(k,2182) = -rxt(k,176)*y(k,130) + mat(k,2300) = -rxt(k,188)*y(k,130) + mat(k,2081) = -rxt(k,189)*y(k,130) + mat(k,1820) = -rxt(k,190)*y(k,130) + mat(k,2326) = -rxt(k,208)*y(k,130) + mat(k,1844) = -rxt(k,239)*y(k,130) + mat(k,1437) = -rxt(k,324)*y(k,130) + mat(k,1405) = -rxt(k,373)*y(k,130) + mat(k,807) = -rxt(k,431)*y(k,130) + mat(k,761) = -rxt(k,434)*y(k,130) + mat(k,922) = -rxt(k,437)*y(k,130) + mat(k,524) = -rxt(k,441)*y(k,130) + mat(k,565) = -rxt(k,444)*y(k,130) + mat(k,1279) = -rxt(k,491)*y(k,130) + mat(k,695) = rxt(k,375)*y(k,253) + mat(k,399) = rxt(k,346)*y(k,131) + mat(k,1844) = mat(k,1844) + rxt(k,238)*y(k,129) + mat(k,2326) = mat(k,2326) + rxt(k,206)*y(k,129) + mat(k,443) = rxt(k,169)*y(k,253) + mat(k,623) = .700_r8*rxt(k,395)*y(k,253) + mat(k,1244) = rxt(k,401)*y(k,129) + rxt(k,402)*y(k,131) + mat(k,1947) = rxt(k,238)*y(k,21) + rxt(k,206)*y(k,61) + rxt(k,401)*y(k,103) & + + 2.000_r8*rxt(k,179)*y(k,131) + rxt(k,185)*y(k,139) & + + rxt(k,184)*y(k,140) + rxt(k,416)*y(k,229) + rxt(k,377) & + *y(k,230) + rxt(k,419)*y(k,231) + rxt(k,424)*y(k,232) & + + rxt(k,302)*y(k,233) + rxt(k,330)*y(k,234) + rxt(k,426) & + *y(k,235) + rxt(k,313)*y(k,236) + rxt(k,281)*y(k,237) & + + rxt(k,430)*y(k,238) + rxt(k,348)*y(k,239) + rxt(k,317) & + *y(k,241) + rxt(k,183)*y(k,242) + rxt(k,289)*y(k,243) & + + .920_r8*rxt(k,387)*y(k,244) + .920_r8*rxt(k,393)*y(k,245) & + + rxt(k,355)*y(k,246) + rxt(k,433)*y(k,247) + rxt(k,364) & + *y(k,248) + rxt(k,436)*y(k,249) + rxt(k,367)*y(k,250) & + + 1.600_r8*rxt(k,466)*y(k,251) + rxt(k,439)*y(k,254) & + + rxt(k,338)*y(k,255) + rxt(k,342)*y(k,256) + .900_r8*rxt(k,471) & + *y(k,257) + .800_r8*rxt(k,476)*y(k,258) + rxt(k,446)*y(k,259) & + + rxt(k,412)*y(k,260) + rxt(k,452)*y(k,261) + rxt(k,455) & + *y(k,262) + mat(k,2081) = mat(k,2081) + rxt(k,346)*y(k,18) + rxt(k,402)*y(k,103) & + + 2.000_r8*rxt(k,179)*y(k,129) + rxt(k,180)*y(k,139) & + + rxt(k,178)*y(k,242) + rxt(k,388)*y(k,244) + rxt(k,394) & + *y(k,245) + rxt(k,354)*y(k,246) + rxt(k,365)*y(k,248) & + + 2.000_r8*rxt(k,467)*y(k,251) + rxt(k,181)*y(k,253) & + + rxt(k,413)*y(k,260) + mat(k,899) = rxt(k,336)*y(k,253) + mat(k,1607) = mat(k,1607) + rxt(k,185)*y(k,129) + rxt(k,180)*y(k,131) + mat(k,2182) = mat(k,2182) + rxt(k,184)*y(k,129) + mat(k,665) = rxt(k,473)*y(k,253) + mat(k,565) = mat(k,565) + rxt(k,416)*y(k,129) + mat(k,965) = rxt(k,377)*y(k,129) + mat(k,539) = rxt(k,419)*y(k,129) + mat(k,488) = rxt(k,424)*y(k,129) + mat(k,868) = rxt(k,302)*y(k,129) + mat(k,840) = rxt(k,330)*y(k,129) + mat(k,671) = rxt(k,426)*y(k,129) + mat(k,1437) = mat(k,1437) + rxt(k,313)*y(k,129) + mat(k,1999) = rxt(k,281)*y(k,129) + .500_r8*rxt(k,464)*y(k,251) + mat(k,807) = mat(k,807) + rxt(k,430)*y(k,129) + mat(k,614) = rxt(k,348)*y(k,129) + mat(k,754) = rxt(k,317)*y(k,129) + mat(k,2300) = mat(k,2300) + rxt(k,183)*y(k,129) + rxt(k,178)*y(k,131) + mat(k,495) = rxt(k,289)*y(k,129) + mat(k,1308) = .920_r8*rxt(k,387)*y(k,129) + rxt(k,388)*y(k,131) + mat(k,1341) = .920_r8*rxt(k,393)*y(k,129) + rxt(k,394)*y(k,131) + mat(k,1363) = rxt(k,355)*y(k,129) + rxt(k,354)*y(k,131) + mat(k,761) = mat(k,761) + rxt(k,433)*y(k,129) + mat(k,1405) = mat(k,1405) + rxt(k,364)*y(k,129) + rxt(k,365)*y(k,131) + mat(k,922) = mat(k,922) + rxt(k,436)*y(k,129) + mat(k,702) = rxt(k,367)*y(k,129) + mat(k,1108) = 1.600_r8*rxt(k,466)*y(k,129) + 2.000_r8*rxt(k,467)*y(k,131) & + + .500_r8*rxt(k,464)*y(k,237) + mat(k,1820) = mat(k,1820) + rxt(k,375)*y(k,1) + rxt(k,169)*y(k,92) & + + .700_r8*rxt(k,395)*y(k,101) + rxt(k,181)*y(k,131) + rxt(k,336) & + *y(k,132) + rxt(k,473)*y(k,214) + mat(k,501) = rxt(k,439)*y(k,129) + mat(k,817) = rxt(k,338)*y(k,129) + mat(k,1204) = rxt(k,342)*y(k,129) + mat(k,1168) = .900_r8*rxt(k,471)*y(k,129) + mat(k,1189) = .800_r8*rxt(k,476)*y(k,129) + mat(k,775) = rxt(k,446)*y(k,129) + mat(k,1221) = rxt(k,412)*y(k,129) + rxt(k,413)*y(k,131) + mat(k,800) = rxt(k,452)*y(k,129) + mat(k,547) = rxt(k,455)*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,2089) = -(rxt(k,178)*y(k,242) + rxt(k,179)*y(k,129) + rxt(k,180) & + *y(k,139) + rxt(k,181)*y(k,253) + rxt(k,189)*y(k,130) + rxt(k,275) & + *y(k,44) + rxt(k,307)*y(k,47) + rxt(k,326)*y(k,31) + rxt(k,333) & + *y(k,51) + rxt(k,346)*y(k,18) + rxt(k,354)*y(k,246) + rxt(k,365) & + *y(k,248) + rxt(k,388)*y(k,244) + rxt(k,394)*y(k,245) + rxt(k,397) & + *y(k,100) + rxt(k,402)*y(k,103) + rxt(k,413)*y(k,260) + rxt(k,458) & + *y(k,6) + rxt(k,461)*y(k,116) + rxt(k,467)*y(k,251) + rxt(k,478) & + *y(k,216) + rxt(k,481)*y(k,69)) + mat(k,2308) = -rxt(k,178)*y(k,131) + mat(k,1955) = -rxt(k,179)*y(k,131) + mat(k,1615) = -rxt(k,180)*y(k,131) + mat(k,1828) = -rxt(k,181)*y(k,131) + mat(k,1584) = -rxt(k,189)*y(k,131) + mat(k,1541) = -rxt(k,275)*y(k,131) + mat(k,1087) = -rxt(k,307)*y(k,131) + mat(k,1061) = -rxt(k,326)*y(k,131) + mat(k,1270) = -rxt(k,333)*y(k,131) + mat(k,401) = -rxt(k,346)*y(k,131) + mat(k,1368) = -rxt(k,354)*y(k,131) + mat(k,1410) = -rxt(k,365)*y(k,131) + mat(k,1313) = -rxt(k,388)*y(k,131) + mat(k,1346) = -rxt(k,394)*y(k,131) + mat(k,892) = -rxt(k,397)*y(k,131) + mat(k,1249) = -rxt(k,402)*y(k,131) + mat(k,1226) = -rxt(k,413)*y(k,131) + mat(k,1031) = -rxt(k,458)*y(k,131) + mat(k,952) = -rxt(k,461)*y(k,131) + mat(k,1112) = -rxt(k,467)*y(k,131) + mat(k,1041) = -rxt(k,478)*y(k,131) + mat(k,353) = -rxt(k,481)*y(k,131) + mat(k,584) = rxt(k,240)*y(k,139) + mat(k,2128) = rxt(k,207)*y(k,62) + mat(k,978) = rxt(k,207)*y(k,58) + rxt(k,209)*y(k,139) + rxt(k,210)*y(k,253) + mat(k,916) = rxt(k,254)*y(k,91) + mat(k,1503) = rxt(k,254)*y(k,75) + rxt(k,191)*y(k,253) + mat(k,660) = .500_r8*rxt(k,370)*y(k,253) + mat(k,1584) = mat(k,1584) + rxt(k,177)*y(k,139) + rxt(k,176)*y(k,140) + mat(k,1615) = mat(k,1615) + rxt(k,240)*y(k,22) + rxt(k,209)*y(k,62) & + + rxt(k,177)*y(k,130) + mat(k,2190) = rxt(k,176)*y(k,130) + mat(k,576) = rxt(k,322)*y(k,253) + mat(k,1828) = mat(k,1828) + rxt(k,210)*y(k,62) + rxt(k,191)*y(k,91) & + + .500_r8*rxt(k,370)*y(k,115) + rxt(k,322)*y(k,145) + mat(k,895) = -(rxt(k,336)*y(k,253)) + mat(k,1779) = -rxt(k,336)*y(k,132) + mat(k,1046) = rxt(k,326)*y(k,131) + mat(k,594) = .500_r8*rxt(k,396)*y(k,253) + mat(k,426) = rxt(k,403)*y(k,253) + mat(k,467) = rxt(k,407)*y(k,253) + mat(k,1066) = rxt(k,408)*y(k,253) + mat(k,2044) = rxt(k,326)*y(k,31) + mat(k,1779) = mat(k,1779) + .500_r8*rxt(k,396)*y(k,102) + rxt(k,403)*y(k,104) & + + rxt(k,407)*y(k,122) + rxt(k,408)*y(k,123) + mat(k,448) = -(rxt(k,468)*y(k,253)) + mat(k,1727) = -rxt(k,468)*y(k,133) + mat(k,2232) = rxt(k,465)*y(k,251) + mat(k,1098) = rxt(k,465)*y(k,242) + mat(k,1608) = -(rxt(k,149)*y(k,140) + 4._r8*rxt(k,150)*y(k,139) + rxt(k,152) & + *y(k,79) + rxt(k,153)*y(k,81) + rxt(k,158)*y(k,242) + rxt(k,164) & + *y(k,253) + (rxt(k,175) + rxt(k,177)) * y(k,130) + rxt(k,180) & + *y(k,131) + rxt(k,185)*y(k,129) + rxt(k,209)*y(k,62) + rxt(k,211) & + *y(k,61) + rxt(k,214)*y(k,87) + rxt(k,217)*y(k,94) + rxt(k,240) & + *y(k,22) + rxt(k,241)*y(k,21) + rxt(k,243)*y(k,83) + rxt(k,245) & + *y(k,93) + rxt(k,276)*y(k,44) + rxt(k,483)*y(k,143)) + mat(k,2183) = -rxt(k,149)*y(k,139) + mat(k,1452) = -rxt(k,152)*y(k,139) + mat(k,647) = -rxt(k,153)*y(k,139) + mat(k,2301) = -rxt(k,158)*y(k,139) + mat(k,1821) = -rxt(k,164)*y(k,139) + mat(k,1577) = -(rxt(k,175) + rxt(k,177)) * y(k,139) + mat(k,2082) = -rxt(k,180)*y(k,139) + mat(k,1948) = -rxt(k,185)*y(k,139) + mat(k,975) = -rxt(k,209)*y(k,139) + mat(k,2327) = -rxt(k,211)*y(k,139) + mat(k,2023) = -rxt(k,214)*y(k,139) + mat(k,856) = -rxt(k,217)*y(k,139) + mat(k,582) = -rxt(k,240)*y(k,139) + mat(k,1845) = -rxt(k,241)*y(k,139) + mat(k,849) = -rxt(k,243)*y(k,139) + mat(k,825) = -rxt(k,245)*y(k,139) + mat(k,1534) = -rxt(k,276)*y(k,139) + mat(k,416) = -rxt(k,483)*y(k,139) + mat(k,1513) = rxt(k,156)*y(k,242) + mat(k,530) = rxt(k,170)*y(k,129) + rxt(k,171)*y(k,130) + mat(k,1948) = mat(k,1948) + rxt(k,170)*y(k,119) + mat(k,1577) = mat(k,1577) + rxt(k,171)*y(k,119) + mat(k,2301) = mat(k,2301) + rxt(k,156)*y(k,78) + mat(k,1821) = mat(k,1821) + 2.000_r8*rxt(k,166)*y(k,253) + mat(k,2192) = -(rxt(k,148)*y(k,252) + rxt(k,149)*y(k,139) + rxt(k,159) & + *y(k,242) + rxt(k,160)*y(k,78) + rxt(k,165)*y(k,253) + rxt(k,176) & + *y(k,130) + rxt(k,184)*y(k,129) + rxt(k,200)*y(k,58) + rxt(k,232) & + *y(k,19) + rxt(k,298)*y(k,27) + rxt(k,327)*y(k,31) + rxt(k,357) & + *y(k,111) + rxt(k,371)*y(k,118) + rxt(k,404)*y(k,100) + rxt(k,442) & + *y(k,147) + rxt(k,459)*y(k,6) + rxt(k,462)*y(k,116) + rxt(k,487) & + *y(k,156) + rxt(k,493)*y(k,158)) + mat(k,1658) = -rxt(k,148)*y(k,140) + mat(k,1617) = -rxt(k,149)*y(k,140) + mat(k,2310) = -rxt(k,159)*y(k,140) + mat(k,1520) = -rxt(k,160)*y(k,140) + mat(k,1830) = -rxt(k,165)*y(k,140) + mat(k,1586) = -rxt(k,176)*y(k,140) + mat(k,1957) = -rxt(k,184)*y(k,140) + mat(k,2130) = -rxt(k,200)*y(k,140) + mat(k,1469) = -rxt(k,232)*y(k,140) + mat(k,607) = -rxt(k,298)*y(k,140) + mat(k,1062) = -rxt(k,327)*y(k,140) + mat(k,1261) = -rxt(k,357)*y(k,140) + mat(k,1391) = -rxt(k,371)*y(k,140) + mat(k,893) = -rxt(k,404)*y(k,140) + mat(k,525) = -rxt(k,442)*y(k,140) + mat(k,1032) = -rxt(k,459)*y(k,140) + mat(k,953) = -rxt(k,462)*y(k,140) + mat(k,561) = -rxt(k,487)*y(k,140) + mat(k,1285) = -rxt(k,493)*y(k,140) + mat(k,1443) = .150_r8*rxt(k,312)*y(k,242) + mat(k,2310) = mat(k,2310) + .150_r8*rxt(k,312)*y(k,236) + .150_r8*rxt(k,362) & + *y(k,248) + mat(k,1411) = .150_r8*rxt(k,362)*y(k,242) + mat(k,360) = -(rxt(k,494)*y(k,158)) + mat(k,1273) = -rxt(k,494)*y(k,142) + mat(k,1835) = rxt(k,234)*y(k,61) + mat(k,2317) = rxt(k,234)*y(k,21) + 2.000_r8*rxt(k,204)*y(k,61) + mat(k,410) = -(rxt(k,483)*y(k,139) + rxt(k,484)*y(k,253)) + mat(k,1590) = -rxt(k,483)*y(k,143) + mat(k,1722) = -rxt(k,484)*y(k,143) + mat(k,1131) = rxt(k,350)*y(k,253) + mat(k,1881) = .100_r8*rxt(k,471)*y(k,257) + mat(k,1700) = rxt(k,350)*y(k,95) + mat(k,1155) = .100_r8*rxt(k,471)*y(k,129) + mat(k,569) = -(rxt(k,322)*y(k,253)) + mat(k,1745) = -rxt(k,322)*y(k,145) + mat(k,1553) = rxt(k,324)*y(k,236) + mat(k,1415) = rxt(k,324)*y(k,130) + mat(k,1546) = rxt(k,444)*y(k,229) + mat(k,562) = rxt(k,444)*y(k,130) + mat(k,522) = -(rxt(k,441)*y(k,130) + rxt(k,442)*y(k,140)) + mat(k,1550) = -rxt(k,441)*y(k,147) + mat(k,2141) = -rxt(k,442)*y(k,147) + mat(k,241) = .070_r8*rxt(k,428)*y(k,253) + mat(k,1891) = rxt(k,426)*y(k,235) + mat(k,219) = .060_r8*rxt(k,440)*y(k,253) + mat(k,262) = .070_r8*rxt(k,456)*y(k,253) + mat(k,669) = rxt(k,426)*y(k,129) + mat(k,1738) = .070_r8*rxt(k,428)*y(k,68) + .060_r8*rxt(k,440)*y(k,148) & + + .070_r8*rxt(k,456)*y(k,225) + mat(k,217) = -(rxt(k,440)*y(k,253)) + mat(k,1691) = -rxt(k,440)*y(k,148) + mat(k,209) = .530_r8*rxt(k,417)*y(k,253) + mat(k,1691) = mat(k,1691) + .530_r8*rxt(k,417)*y(k,8) + mat(k,365) = -(rxt(k,443)*y(k,253)) + mat(k,1714) = -rxt(k,443)*y(k,149) + mat(k,2223) = rxt(k,438)*y(k,254) + mat(k,498) = rxt(k,438)*y(k,242) + mat(k,585) = -(rxt(k,339)*y(k,253)) + mat(k,1746) = -rxt(k,339)*y(k,154) + mat(k,2245) = rxt(k,337)*y(k,255) + mat(k,812) = rxt(k,337)*y(k,242) + mat(k,418) = -(rxt(k,343)*y(k,253)) + mat(k,1723) = -rxt(k,343)*y(k,155) + mat(k,2228) = .850_r8*rxt(k,341)*y(k,256) + mat(k,1197) = .850_r8*rxt(k,341)*y(k,242) + mat(k,556) = -(rxt(k,487)*y(k,140) + rxt(k,490)*y(k,253)) + mat(k,2142) = -rxt(k,487)*y(k,156) + mat(k,1743) = -rxt(k,490)*y(k,156) + mat(k,1276) = -(rxt(k,488)*y(k,21) + rxt(k,489)*y(k,61) + rxt(k,491)*y(k,130) & + + rxt(k,493)*y(k,140) + rxt(k,494)*y(k,142) + rxt(k,495) & + *y(k,253)) + mat(k,1839) = -rxt(k,488)*y(k,158) + mat(k,2321) = -rxt(k,489)*y(k,158) + mat(k,1568) = -rxt(k,491)*y(k,158) + mat(k,2170) = -rxt(k,493)*y(k,158) + mat(k,362) = -rxt(k,494)*y(k,158) + mat(k,1807) = -rxt(k,495)*y(k,158) + mat(k,1600) = rxt(k,483)*y(k,143) + mat(k,2170) = mat(k,2170) + rxt(k,487)*y(k,156) + mat(k,414) = rxt(k,483)*y(k,139) + mat(k,557) = rxt(k,487)*y(k,140) + rxt(k,490)*y(k,253) + mat(k,1807) = mat(k,1807) + rxt(k,490)*y(k,156) + mat(k,902) = -(rxt(k,486)*y(k,253)) + mat(k,1780) = -rxt(k,486)*y(k,159) + mat(k,1838) = rxt(k,488)*y(k,158) + mat(k,2319) = rxt(k,489)*y(k,158) + mat(k,350) = rxt(k,481)*y(k,131) + (rxt(k,482)+.500_r8*rxt(k,496))*y(k,253) + mat(k,1561) = rxt(k,491)*y(k,158) + mat(k,2045) = rxt(k,481)*y(k,69) + mat(k,2149) = rxt(k,493)*y(k,158) + mat(k,361) = rxt(k,494)*y(k,158) + mat(k,412) = rxt(k,484)*y(k,253) + mat(k,1275) = rxt(k,488)*y(k,21) + rxt(k,489)*y(k,61) + rxt(k,491)*y(k,130) & + + rxt(k,493)*y(k,140) + rxt(k,494)*y(k,142) + rxt(k,495) & + *y(k,253) + mat(k,1780) = mat(k,1780) + (rxt(k,482)+.500_r8*rxt(k,496))*y(k,69) & + + rxt(k,484)*y(k,143) + rxt(k,495)*y(k,158) + mat(k,302) = -(rxt(k,497)*y(k,263)) + mat(k,2341) = -rxt(k,497)*y(k,160) + mat(k,901) = rxt(k,486)*y(k,253) + mat(k,1707) = rxt(k,486)*y(k,159) + mat(k,64) = .1056005_r8*rxt(k,526)*y(k,129) + .2381005_r8*rxt(k,525)*y(k,242) + mat(k,1858) = .1056005_r8*rxt(k,526)*y(k,108) + mat(k,114) = .5931005_r8*rxt(k,536)*y(k,253) + mat(k,2196) = .2381005_r8*rxt(k,525)*y(k,108) + mat(k,1662) = .5931005_r8*rxt(k,536)*y(k,210) + 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,65) = .1026005_r8*rxt(k,526)*y(k,129) + .1308005_r8*rxt(k,525)*y(k,242) + mat(k,1859) = .1026005_r8*rxt(k,526)*y(k,108) + mat(k,115) = .1534005_r8*rxt(k,536)*y(k,253) + mat(k,2197) = .1308005_r8*rxt(k,525)*y(k,108) + mat(k,1663) = .1534005_r8*rxt(k,536)*y(k,210) + mat(k,66) = .0521005_r8*rxt(k,526)*y(k,129) + .0348005_r8*rxt(k,525)*y(k,242) + mat(k,1860) = .0521005_r8*rxt(k,526)*y(k,108) + mat(k,116) = .0459005_r8*rxt(k,536)*y(k,253) + mat(k,2198) = .0348005_r8*rxt(k,525)*y(k,108) + mat(k,1664) = .0459005_r8*rxt(k,536)*y(k,210) + mat(k,67) = .0143005_r8*rxt(k,526)*y(k,129) + .0076005_r8*rxt(k,525)*y(k,242) + mat(k,1861) = .0143005_r8*rxt(k,526)*y(k,108) + mat(k,117) = .0085005_r8*rxt(k,536)*y(k,253) + mat(k,2199) = .0076005_r8*rxt(k,525)*y(k,108) + mat(k,1665) = .0085005_r8*rxt(k,536)*y(k,210) + mat(k,68) = .0166005_r8*rxt(k,526)*y(k,129) + .0113005_r8*rxt(k,525)*y(k,242) + mat(k,1862) = .0166005_r8*rxt(k,526)*y(k,108) + mat(k,118) = .0128005_r8*rxt(k,536)*y(k,253) + mat(k,2200) = .0113005_r8*rxt(k,525)*y(k,108) + mat(k,1666) = .0128005_r8*rxt(k,536)*y(k,210) + mat(k,1002) = .2202005_r8*rxt(k,515)*y(k,140) + mat(k,77) = .1279005_r8*rxt(k,514)*y(k,129) + .2202005_r8*rxt(k,513)*y(k,242) + mat(k,83) = .0003005_r8*rxt(k,522)*y(k,129) + .0031005_r8*rxt(k,521)*y(k,242) + mat(k,927) = .0508005_r8*rxt(k,534)*y(k,140) + mat(k,89) = .0245005_r8*rxt(k,533)*y(k,129) + .0508005_r8*rxt(k,532)*y(k,242) + mat(k,1864) = .1279005_r8*rxt(k,514)*y(k,7) + .0003005_r8*rxt(k,522)*y(k,105) & + + .0245005_r8*rxt(k,533)*y(k,117) + mat(k,2134) = .2202005_r8*rxt(k,515)*y(k,6) + .0508005_r8*rxt(k,534)*y(k,116) + mat(k,2202) = .2202005_r8*rxt(k,513)*y(k,7) + .0031005_r8*rxt(k,521)*y(k,105) & + + .0508005_r8*rxt(k,532)*y(k,117) + mat(k,1003) = .2067005_r8*rxt(k,515)*y(k,140) + mat(k,78) = .1792005_r8*rxt(k,514)*y(k,129) + .2067005_r8*rxt(k,513)*y(k,242) + mat(k,84) = .0003005_r8*rxt(k,522)*y(k,129) + .0035005_r8*rxt(k,521)*y(k,242) + mat(k,928) = .1149005_r8*rxt(k,534)*y(k,140) + mat(k,90) = .0082005_r8*rxt(k,533)*y(k,129) + .1149005_r8*rxt(k,532)*y(k,242) + mat(k,1865) = .1792005_r8*rxt(k,514)*y(k,7) + .0003005_r8*rxt(k,522)*y(k,105) & + + .0082005_r8*rxt(k,533)*y(k,117) + mat(k,2135) = .2067005_r8*rxt(k,515)*y(k,6) + .1149005_r8*rxt(k,534)*y(k,116) + mat(k,2203) = .2067005_r8*rxt(k,513)*y(k,7) + .0035005_r8*rxt(k,521)*y(k,105) & + + .1149005_r8*rxt(k,532)*y(k,117) + mat(k,1004) = .0653005_r8*rxt(k,515)*y(k,140) + mat(k,79) = .0676005_r8*rxt(k,514)*y(k,129) + .0653005_r8*rxt(k,513)*y(k,242) + mat(k,85) = .0073005_r8*rxt(k,522)*y(k,129) + .0003005_r8*rxt(k,521)*y(k,242) + mat(k,929) = .0348005_r8*rxt(k,534)*y(k,140) + mat(k,91) = .0772005_r8*rxt(k,533)*y(k,129) + .0348005_r8*rxt(k,532)*y(k,242) + mat(k,1866) = .0676005_r8*rxt(k,514)*y(k,7) + .0073005_r8*rxt(k,522)*y(k,105) & + + .0772005_r8*rxt(k,533)*y(k,117) + mat(k,2136) = .0653005_r8*rxt(k,515)*y(k,6) + .0348005_r8*rxt(k,534)*y(k,116) + mat(k,2204) = .0653005_r8*rxt(k,513)*y(k,7) + .0003005_r8*rxt(k,521)*y(k,105) & + + .0348005_r8*rxt(k,532)*y(k,117) + mat(k,1005) = .1749305_r8*rxt(k,512)*y(k,131) + .1284005_r8*rxt(k,515) & + *y(k,140) + mat(k,80) = .079_r8*rxt(k,514)*y(k,129) + .1284005_r8*rxt(k,513)*y(k,242) + mat(k,876) = .0590245_r8*rxt(k,520)*y(k,131) + .0033005_r8*rxt(k,523) & + *y(k,140) + mat(k,86) = .0057005_r8*rxt(k,522)*y(k,129) + .0271005_r8*rxt(k,521)*y(k,242) + mat(k,930) = .1749305_r8*rxt(k,531)*y(k,131) + .0554005_r8*rxt(k,534) & + *y(k,140) + mat(k,92) = .0332005_r8*rxt(k,533)*y(k,129) + .0554005_r8*rxt(k,532)*y(k,242) + mat(k,1867) = .079_r8*rxt(k,514)*y(k,7) + .0057005_r8*rxt(k,522)*y(k,105) & + + .0332005_r8*rxt(k,533)*y(k,117) + mat(k,2036) = .1749305_r8*rxt(k,512)*y(k,6) + .0590245_r8*rxt(k,520)*y(k,100) & + + .1749305_r8*rxt(k,531)*y(k,116) + mat(k,2137) = .1284005_r8*rxt(k,515)*y(k,6) + .0033005_r8*rxt(k,523)*y(k,100) & + + .0554005_r8*rxt(k,534)*y(k,116) + mat(k,2205) = .1284005_r8*rxt(k,513)*y(k,7) + .0271005_r8*rxt(k,521)*y(k,105) & + + .0554005_r8*rxt(k,532)*y(k,117) + mat(k,1006) = .5901905_r8*rxt(k,512)*y(k,131) + .114_r8*rxt(k,515)*y(k,140) + mat(k,81) = .1254005_r8*rxt(k,514)*y(k,129) + .114_r8*rxt(k,513)*y(k,242) + mat(k,877) = .0250245_r8*rxt(k,520)*y(k,131) + mat(k,87) = .0623005_r8*rxt(k,522)*y(k,129) + .0474005_r8*rxt(k,521)*y(k,242) + mat(k,931) = .5901905_r8*rxt(k,531)*y(k,131) + .1278005_r8*rxt(k,534) & + *y(k,140) + mat(k,93) = .130_r8*rxt(k,533)*y(k,129) + .1278005_r8*rxt(k,532)*y(k,242) + mat(k,1868) = .1254005_r8*rxt(k,514)*y(k,7) + .0623005_r8*rxt(k,522)*y(k,105) & + + .130_r8*rxt(k,533)*y(k,117) + mat(k,2037) = .5901905_r8*rxt(k,512)*y(k,6) + .0250245_r8*rxt(k,520)*y(k,100) & + + .5901905_r8*rxt(k,531)*y(k,116) + mat(k,2138) = .114_r8*rxt(k,515)*y(k,6) + .1278005_r8*rxt(k,534)*y(k,116) + mat(k,2206) = .114_r8*rxt(k,513)*y(k,7) + .0474005_r8*rxt(k,521)*y(k,105) & + + .1278005_r8*rxt(k,532)*y(k,117) + mat(k,108) = .0097005_r8*rxt(k,519)*y(k,129) + .0023005_r8*rxt(k,518) & + *y(k,242) + mat(k,100) = .1056005_r8*rxt(k,529)*y(k,129) + .2381005_r8*rxt(k,528) & + *y(k,242) + mat(k,1872) = .0097005_r8*rxt(k,519)*y(k,9) + .1056005_r8*rxt(k,529)*y(k,110) & + + .0154005_r8*rxt(k,540)*y(k,220) + .0063005_r8*rxt(k,544) & + *y(k,224) + mat(k,120) = .5931005_r8*rxt(k,537)*y(k,253) + mat(k,126) = .0154005_r8*rxt(k,540)*y(k,129) + .1364005_r8*rxt(k,539) & + *y(k,242) + mat(k,132) = .0063005_r8*rxt(k,544)*y(k,129) + .1677005_r8*rxt(k,543) & + *y(k,242) + mat(k,2210) = .0023005_r8*rxt(k,518)*y(k,9) + .2381005_r8*rxt(k,528)*y(k,110) & + + .1364005_r8*rxt(k,539)*y(k,220) + .1677005_r8*rxt(k,543) & + *y(k,224) + mat(k,1672) = .5931005_r8*rxt(k,537)*y(k,211) + mat(k,109) = .0034005_r8*rxt(k,519)*y(k,129) + .0008005_r8*rxt(k,518) & + *y(k,242) + mat(k,101) = .1026005_r8*rxt(k,529)*y(k,129) + .1308005_r8*rxt(k,528) & + *y(k,242) + mat(k,1873) = .0034005_r8*rxt(k,519)*y(k,9) + .1026005_r8*rxt(k,529)*y(k,110) & + + .0452005_r8*rxt(k,540)*y(k,220) + .0237005_r8*rxt(k,544) & + *y(k,224) + mat(k,121) = .1534005_r8*rxt(k,537)*y(k,253) + mat(k,127) = .0452005_r8*rxt(k,540)*y(k,129) + .0101005_r8*rxt(k,539) & + *y(k,242) + mat(k,133) = .0237005_r8*rxt(k,544)*y(k,129) + .0174005_r8*rxt(k,543) & + *y(k,242) + mat(k,2211) = .0008005_r8*rxt(k,518)*y(k,9) + .1308005_r8*rxt(k,528)*y(k,110) & + + .0101005_r8*rxt(k,539)*y(k,220) + .0174005_r8*rxt(k,543) & + *y(k,224) + mat(k,1673) = .1534005_r8*rxt(k,537)*y(k,211) + mat(k,110) = .1579005_r8*rxt(k,519)*y(k,129) + .0843005_r8*rxt(k,518) & + *y(k,242) + mat(k,102) = .0521005_r8*rxt(k,529)*y(k,129) + .0348005_r8*rxt(k,528) & + *y(k,242) + mat(k,1874) = .1579005_r8*rxt(k,519)*y(k,9) + .0521005_r8*rxt(k,529)*y(k,110) & + + .0966005_r8*rxt(k,540)*y(k,220) + .0025005_r8*rxt(k,544) & + *y(k,224) + mat(k,122) = .0459005_r8*rxt(k,537)*y(k,253) + mat(k,128) = .0966005_r8*rxt(k,540)*y(k,129) + .0763005_r8*rxt(k,539) & + *y(k,242) + mat(k,134) = .0025005_r8*rxt(k,544)*y(k,129) + .086_r8*rxt(k,543)*y(k,242) + mat(k,2212) = .0843005_r8*rxt(k,518)*y(k,9) + .0348005_r8*rxt(k,528)*y(k,110) & + + .0763005_r8*rxt(k,539)*y(k,220) + .086_r8*rxt(k,543)*y(k,224) + mat(k,1674) = .0459005_r8*rxt(k,537)*y(k,211) + mat(k,111) = .0059005_r8*rxt(k,519)*y(k,129) + .0443005_r8*rxt(k,518) & + *y(k,242) + mat(k,103) = .0143005_r8*rxt(k,529)*y(k,129) + .0076005_r8*rxt(k,528) & + *y(k,242) + mat(k,1875) = .0059005_r8*rxt(k,519)*y(k,9) + .0143005_r8*rxt(k,529)*y(k,110) & + + .0073005_r8*rxt(k,540)*y(k,220) + .011_r8*rxt(k,544)*y(k,224) + mat(k,123) = .0085005_r8*rxt(k,537)*y(k,253) + mat(k,129) = .0073005_r8*rxt(k,540)*y(k,129) + .2157005_r8*rxt(k,539) & + *y(k,242) + mat(k,135) = .011_r8*rxt(k,544)*y(k,129) + .0512005_r8*rxt(k,543)*y(k,242) + mat(k,2213) = .0443005_r8*rxt(k,518)*y(k,9) + .0076005_r8*rxt(k,528)*y(k,110) & + + .2157005_r8*rxt(k,539)*y(k,220) + .0512005_r8*rxt(k,543) & + *y(k,224) + mat(k,1675) = .0085005_r8*rxt(k,537)*y(k,211) + mat(k,112) = .0536005_r8*rxt(k,519)*y(k,129) + .1621005_r8*rxt(k,518) & + *y(k,242) + mat(k,104) = .0166005_r8*rxt(k,529)*y(k,129) + .0113005_r8*rxt(k,528) & + *y(k,242) + mat(k,1876) = .0536005_r8*rxt(k,519)*y(k,9) + .0166005_r8*rxt(k,529)*y(k,110) & + + .238_r8*rxt(k,540)*y(k,220) + .1185005_r8*rxt(k,544)*y(k,224) + mat(k,124) = .0128005_r8*rxt(k,537)*y(k,253) + mat(k,130) = .238_r8*rxt(k,540)*y(k,129) + .0738005_r8*rxt(k,539)*y(k,242) + mat(k,136) = .1185005_r8*rxt(k,544)*y(k,129) + .1598005_r8*rxt(k,543) & + *y(k,242) + mat(k,2214) = .1621005_r8*rxt(k,518)*y(k,9) + .0113005_r8*rxt(k,528)*y(k,110) & + + .0738005_r8*rxt(k,539)*y(k,220) + .1598005_r8*rxt(k,543) & + *y(k,224) + mat(k,1676) = .0128005_r8*rxt(k,537)*y(k,211) + mat(k,119) = -(rxt(k,536)*y(k,253)) + mat(k,1680) = -rxt(k,536)*y(k,210) + mat(k,125) = -(rxt(k,537)*y(k,253)) + mat(k,1681) = -rxt(k,537)*y(k,211) + mat(k,234) = .100_r8*rxt(k,448)*y(k,253) + mat(k,252) = .230_r8*rxt(k,450)*y(k,253) + mat(k,1695) = .100_r8*rxt(k,448)*y(k,219) + .230_r8*rxt(k,450)*y(k,222) + mat(k,706) = -(rxt(k,472)*y(k,253)) + mat(k,1761) = -rxt(k,472)*y(k,213) + mat(k,2251) = rxt(k,470)*y(k,257) + mat(k,1156) = rxt(k,470)*y(k,242) + mat(k,662) = -(rxt(k,473)*y(k,253)) + mat(k,1756) = -rxt(k,473)*y(k,214) + mat(k,1901) = .200_r8*rxt(k,466)*y(k,251) + .200_r8*rxt(k,476)*y(k,258) + mat(k,1965) = .500_r8*rxt(k,464)*y(k,251) + mat(k,1099) = .200_r8*rxt(k,466)*y(k,129) + .500_r8*rxt(k,464)*y(k,237) + mat(k,1176) = .200_r8*rxt(k,476)*y(k,129) + mat(k,515) = -(rxt(k,477)*y(k,253)) + mat(k,1737) = -rxt(k,477)*y(k,215) + mat(k,2240) = rxt(k,475)*y(k,258) + mat(k,1175) = rxt(k,475)*y(k,242) + mat(k,1035) = -(rxt(k,478)*y(k,131) + rxt(k,479)*y(k,253)) + mat(k,2052) = -rxt(k,478)*y(k,216) + mat(k,1790) = -rxt(k,479)*y(k,216) + mat(k,1016) = .330_r8*rxt(k,459)*y(k,140) + mat(k,941) = .330_r8*rxt(k,462)*y(k,140) + mat(k,1920) = .800_r8*rxt(k,466)*y(k,251) + .800_r8*rxt(k,476)*y(k,258) + mat(k,2052) = mat(k,2052) + rxt(k,467)*y(k,251) + mat(k,2156) = .330_r8*rxt(k,459)*y(k,6) + .330_r8*rxt(k,462)*y(k,116) + mat(k,663) = rxt(k,473)*y(k,253) + mat(k,1974) = .500_r8*rxt(k,464)*y(k,251) + rxt(k,474)*y(k,258) + mat(k,1101) = .800_r8*rxt(k,466)*y(k,129) + rxt(k,467)*y(k,131) & + + .500_r8*rxt(k,464)*y(k,237) + mat(k,1790) = mat(k,1790) + rxt(k,473)*y(k,214) + mat(k,1179) = .800_r8*rxt(k,476)*y(k,129) + rxt(k,474)*y(k,237) + mat(k,1116) = -(rxt(k,480)*y(k,253)) + mat(k,1796) = -rxt(k,480)*y(k,217) + mat(k,1019) = .300_r8*rxt(k,459)*y(k,140) + mat(k,943) = .300_r8*rxt(k,462)*y(k,140) + mat(k,1925) = .900_r8*rxt(k,471)*y(k,257) + mat(k,2161) = .300_r8*rxt(k,459)*y(k,6) + .300_r8*rxt(k,462)*y(k,116) + mat(k,1979) = rxt(k,469)*y(k,257) + mat(k,1161) = .900_r8*rxt(k,471)*y(k,129) + rxt(k,469)*y(k,237) + mat(k,719) = -(rxt(k,447)*y(k,253)) + mat(k,1762) = -rxt(k,447)*y(k,218) + mat(k,2252) = rxt(k,445)*y(k,259) + mat(k,767) = rxt(k,445)*y(k,242) + end do + end subroutine nlnmat07 + subroutine nlnmat08( 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,232) = -(rxt(k,448)*y(k,253)) + mat(k,1693) = -rxt(k,448)*y(k,219) + mat(k,131) = -(rxt(k,539)*y(k,242) + rxt(k,540)*y(k,129)) + mat(k,2217) = -rxt(k,539)*y(k,220) + mat(k,1879) = -rxt(k,540)*y(k,220) + mat(k,231) = rxt(k,538)*y(k,253) + mat(k,1682) = rxt(k,538)*y(k,219) + mat(k,248) = -(rxt(k,414)*y(k,253)) + mat(k,1696) = -rxt(k,414)*y(k,221) + mat(k,2220) = rxt(k,411)*y(k,260) + mat(k,1210) = rxt(k,411)*y(k,242) + mat(k,253) = -(rxt(k,450)*y(k,253)) + mat(k,1697) = -rxt(k,450)*y(k,222) + mat(k,738) = -(rxt(k,453)*y(k,253)) + mat(k,1764) = -rxt(k,453)*y(k,223) + mat(k,2254) = rxt(k,451)*y(k,261) + mat(k,791) = rxt(k,451)*y(k,242) + mat(k,137) = -(rxt(k,543)*y(k,242) + rxt(k,544)*y(k,129)) + mat(k,2218) = -rxt(k,543)*y(k,224) + mat(k,1880) = -rxt(k,544)*y(k,224) + mat(k,251) = rxt(k,542)*y(k,253) + mat(k,1683) = rxt(k,542)*y(k,222) + mat(k,261) = -(rxt(k,456)*y(k,253)) + mat(k,1698) = -rxt(k,456)*y(k,225) + mat(k,254) = .150_r8*rxt(k,450)*y(k,253) + mat(k,1698) = mat(k,1698) + .150_r8*rxt(k,450)*y(k,222) + mat(k,478) = -(rxt(k,457)*y(k,253)) + mat(k,1732) = -rxt(k,457)*y(k,226) + mat(k,2235) = rxt(k,454)*y(k,262) + mat(k,543) = rxt(k,454)*y(k,242) + mat(k,563) = -(rxt(k,415)*y(k,242) + rxt(k,416)*y(k,129) + rxt(k,444) & + *y(k,130)) + mat(k,2244) = -rxt(k,415)*y(k,229) + mat(k,1896) = -rxt(k,416)*y(k,229) + mat(k,1552) = -rxt(k,444)*y(k,229) + mat(k,276) = rxt(k,421)*y(k,253) + mat(k,1744) = rxt(k,421)*y(k,24) + mat(k,960) = -(rxt(k,376)*y(k,242) + (rxt(k,377) + rxt(k,378)) * y(k,129)) + mat(k,2270) = -rxt(k,376)*y(k,230) + mat(k,1916) = -(rxt(k,377) + rxt(k,378)) * y(k,230) + mat(k,680) = rxt(k,379)*y(k,253) + mat(k,267) = rxt(k,380)*y(k,253) + mat(k,1784) = rxt(k,379)*y(k,2) + rxt(k,380)*y(k,17) + mat(k,536) = -(rxt(k,418)*y(k,242) + rxt(k,419)*y(k,129)) + mat(k,2242) = -rxt(k,418)*y(k,231) + mat(k,1893) = -rxt(k,419)*y(k,231) + mat(k,210) = .350_r8*rxt(k,417)*y(k,253) + mat(k,474) = rxt(k,420)*y(k,253) + mat(k,1740) = .350_r8*rxt(k,417)*y(k,8) + rxt(k,420)*y(k,10) + mat(k,486) = -(rxt(k,422)*y(k,242) + rxt(k,424)*y(k,129)) + mat(k,2236) = -rxt(k,422)*y(k,232) + mat(k,1887) = -rxt(k,424)*y(k,232) + mat(k,372) = rxt(k,423)*y(k,253) + mat(k,235) = .070_r8*rxt(k,448)*y(k,253) + mat(k,255) = .060_r8*rxt(k,450)*y(k,253) + mat(k,1733) = rxt(k,423)*y(k,25) + .070_r8*rxt(k,448)*y(k,219) & + + .060_r8*rxt(k,450)*y(k,222) + mat(k,865) = -(4._r8*rxt(k,299)*y(k,233) + rxt(k,300)*y(k,237) + rxt(k,301) & + *y(k,242) + rxt(k,302)*y(k,129)) + mat(k,1969) = -rxt(k,300)*y(k,233) + mat(k,2266) = -rxt(k,301)*y(k,233) + mat(k,1912) = -rxt(k,302)*y(k,233) + mat(k,377) = .500_r8*rxt(k,304)*y(k,253) + mat(k,328) = rxt(k,305)*y(k,58) + rxt(k,306)*y(k,253) + mat(k,2106) = rxt(k,305)*y(k,30) + mat(k,1776) = .500_r8*rxt(k,304)*y(k,29) + rxt(k,306)*y(k,30) + mat(k,836) = -(rxt(k,328)*y(k,237) + rxt(k,329)*y(k,242) + rxt(k,330) & + *y(k,129)) + mat(k,1968) = -rxt(k,328)*y(k,234) + mat(k,2263) = -rxt(k,329)*y(k,234) + mat(k,1911) = -rxt(k,330)*y(k,234) + mat(k,437) = rxt(k,331)*y(k,253) + mat(k,155) = rxt(k,332)*y(k,253) + mat(k,1773) = rxt(k,331)*y(k,32) + rxt(k,332)*y(k,33) + mat(k,670) = -(rxt(k,425)*y(k,242) + rxt(k,426)*y(k,129)) + mat(k,2248) = -rxt(k,425)*y(k,235) + mat(k,1902) = -rxt(k,426)*y(k,235) + mat(k,312) = rxt(k,427)*y(k,253) + mat(k,1902) = mat(k,1902) + rxt(k,416)*y(k,229) + mat(k,2144) = rxt(k,442)*y(k,147) + mat(k,523) = rxt(k,442)*y(k,140) + mat(k,564) = rxt(k,416)*y(k,129) + .400_r8*rxt(k,415)*y(k,242) + mat(k,2248) = mat(k,2248) + .400_r8*rxt(k,415)*y(k,229) + mat(k,1757) = rxt(k,427)*y(k,34) + mat(k,1433) = -(4._r8*rxt(k,310)*y(k,236) + rxt(k,311)*y(k,237) + rxt(k,312) & + *y(k,242) + rxt(k,313)*y(k,129) + rxt(k,324)*y(k,130) + rxt(k,351) & + *y(k,246) + rxt(k,384)*y(k,244) + rxt(k,389)*y(k,245) + rxt(k,398) & + *y(k,103) + rxt(k,409)*y(k,260)) + mat(k,1994) = -rxt(k,311)*y(k,236) + mat(k,2293) = -rxt(k,312)*y(k,236) + mat(k,1941) = -rxt(k,313)*y(k,236) + mat(k,1570) = -rxt(k,324)*y(k,236) + mat(k,1360) = -rxt(k,351)*y(k,236) + mat(k,1305) = -rxt(k,384)*y(k,236) + mat(k,1338) = -rxt(k,389)*y(k,236) + mat(k,1241) = -rxt(k,398)*y(k,236) + mat(k,1219) = -rxt(k,409)*y(k,236) + mat(k,1024) = .060_r8*rxt(k,459)*y(k,140) + mat(k,1083) = rxt(k,307)*y(k,131) + rxt(k,308)*y(k,253) + mat(k,1266) = rxt(k,333)*y(k,131) + rxt(k,334)*y(k,253) + mat(k,637) = .500_r8*rxt(k,315)*y(k,253) + mat(k,888) = .080_r8*rxt(k,404)*y(k,140) + mat(k,1257) = .100_r8*rxt(k,357)*y(k,140) + mat(k,948) = .060_r8*rxt(k,462)*y(k,140) + mat(k,1381) = .280_r8*rxt(k,371)*y(k,140) + mat(k,1941) = mat(k,1941) + .530_r8*rxt(k,355)*y(k,246) + rxt(k,364)*y(k,248) & + + rxt(k,367)*y(k,250) + rxt(k,342)*y(k,256) + mat(k,2075) = rxt(k,307)*y(k,47) + rxt(k,333)*y(k,51) + .530_r8*rxt(k,354) & + *y(k,246) + rxt(k,365)*y(k,248) + mat(k,2176) = .060_r8*rxt(k,459)*y(k,6) + .080_r8*rxt(k,404)*y(k,100) & + + .100_r8*rxt(k,357)*y(k,111) + .060_r8*rxt(k,462)*y(k,116) & + + .280_r8*rxt(k,371)*y(k,118) + mat(k,1119) = .650_r8*rxt(k,480)*y(k,253) + mat(k,1433) = mat(k,1433) + .530_r8*rxt(k,351)*y(k,246) + mat(k,1994) = mat(k,1994) + .260_r8*rxt(k,352)*y(k,246) + rxt(k,361)*y(k,248) & + + .300_r8*rxt(k,340)*y(k,256) + mat(k,2293) = mat(k,2293) + .450_r8*rxt(k,362)*y(k,248) + .200_r8*rxt(k,366) & + *y(k,250) + .150_r8*rxt(k,341)*y(k,256) + mat(k,1360) = mat(k,1360) + .530_r8*rxt(k,355)*y(k,129) + .530_r8*rxt(k,354) & + *y(k,131) + .530_r8*rxt(k,351)*y(k,236) + .260_r8*rxt(k,352) & + *y(k,237) + mat(k,1402) = rxt(k,364)*y(k,129) + rxt(k,365)*y(k,131) + rxt(k,361)*y(k,237) & + + .450_r8*rxt(k,362)*y(k,242) + 4.000_r8*rxt(k,363)*y(k,248) + mat(k,701) = rxt(k,367)*y(k,129) + .200_r8*rxt(k,366)*y(k,242) + mat(k,1813) = rxt(k,308)*y(k,47) + rxt(k,334)*y(k,51) + .500_r8*rxt(k,315) & + *y(k,53) + .650_r8*rxt(k,480)*y(k,217) + mat(k,1202) = rxt(k,342)*y(k,129) + .300_r8*rxt(k,340)*y(k,237) & + + .150_r8*rxt(k,341)*y(k,242) + mat(k,2005) = -(rxt(k,201)*y(k,61) + (4._r8*rxt(k,278) + 4._r8*rxt(k,279) & + ) * y(k,237) + rxt(k,280)*y(k,242) + rxt(k,281)*y(k,129) & + + rxt(k,300)*y(k,233) + rxt(k,311)*y(k,236) + rxt(k,328) & + *y(k,234) + rxt(k,340)*y(k,256) + rxt(k,352)*y(k,246) + rxt(k,361) & + *y(k,248) + rxt(k,385)*y(k,244) + rxt(k,390)*y(k,245) + rxt(k,399) & + *y(k,103) + rxt(k,410)*y(k,260) + rxt(k,464)*y(k,251) + rxt(k,469) & + *y(k,257) + rxt(k,474)*y(k,258)) + mat(k,2332) = -rxt(k,201)*y(k,237) + mat(k,2306) = -rxt(k,280)*y(k,237) + mat(k,1953) = -rxt(k,281)*y(k,237) + mat(k,871) = -rxt(k,300)*y(k,237) + mat(k,1441) = -rxt(k,311)*y(k,237) + mat(k,843) = -rxt(k,328)*y(k,237) + mat(k,1207) = -rxt(k,340)*y(k,237) + mat(k,1367) = -rxt(k,352)*y(k,237) + mat(k,1409) = -rxt(k,361)*y(k,237) + mat(k,1312) = -rxt(k,385)*y(k,237) + mat(k,1345) = -rxt(k,390)*y(k,237) + mat(k,1248) = -rxt(k,399)*y(k,237) + mat(k,1225) = -rxt(k,410)*y(k,237) + mat(k,1111) = -rxt(k,464)*y(k,237) + mat(k,1172) = -rxt(k,469)*y(k,237) + mat(k,1193) = -rxt(k,474)*y(k,237) + mat(k,1060) = .280_r8*rxt(k,327)*y(k,140) + mat(k,732) = rxt(k,314)*y(k,253) + mat(k,458) = .700_r8*rxt(k,283)*y(k,253) + mat(k,1484) = rxt(k,195)*y(k,58) + rxt(k,251)*y(k,75) + rxt(k,290)*y(k,252) & + + rxt(k,284)*y(k,253) + mat(k,2126) = rxt(k,195)*y(k,56) + mat(k,915) = rxt(k,251)*y(k,56) + mat(k,891) = .050_r8*rxt(k,404)*y(k,140) + mat(k,1248) = mat(k,1248) + rxt(k,398)*y(k,236) + mat(k,1953) = mat(k,1953) + rxt(k,313)*y(k,236) + .830_r8*rxt(k,430)*y(k,238) & + + .170_r8*rxt(k,436)*y(k,249) + mat(k,2188) = .280_r8*rxt(k,327)*y(k,31) + .050_r8*rxt(k,404)*y(k,100) + mat(k,1441) = mat(k,1441) + rxt(k,398)*y(k,103) + rxt(k,313)*y(k,129) & + + 4.000_r8*rxt(k,310)*y(k,236) + .900_r8*rxt(k,311)*y(k,237) & + + .450_r8*rxt(k,312)*y(k,242) + rxt(k,384)*y(k,244) + rxt(k,389) & + *y(k,245) + rxt(k,351)*y(k,246) + rxt(k,360)*y(k,248) & + + rxt(k,409)*y(k,260) + mat(k,2005) = mat(k,2005) + .900_r8*rxt(k,311)*y(k,236) + mat(k,810) = .830_r8*rxt(k,430)*y(k,129) + .330_r8*rxt(k,429)*y(k,242) + mat(k,2306) = mat(k,2306) + .450_r8*rxt(k,312)*y(k,236) + .330_r8*rxt(k,429) & + *y(k,238) + .070_r8*rxt(k,435)*y(k,249) + mat(k,1312) = mat(k,1312) + rxt(k,384)*y(k,236) + mat(k,1345) = mat(k,1345) + rxt(k,389)*y(k,236) + mat(k,1367) = mat(k,1367) + rxt(k,351)*y(k,236) + mat(k,1409) = mat(k,1409) + rxt(k,360)*y(k,236) + mat(k,925) = .170_r8*rxt(k,436)*y(k,129) + .070_r8*rxt(k,435)*y(k,242) + mat(k,1654) = rxt(k,290)*y(k,56) + mat(k,1826) = rxt(k,314)*y(k,52) + .700_r8*rxt(k,283)*y(k,55) + rxt(k,284) & + *y(k,56) + mat(k,1225) = mat(k,1225) + rxt(k,409)*y(k,236) + mat(k,804) = -(rxt(k,429)*y(k,242) + rxt(k,430)*y(k,129) + rxt(k,431) & + *y(k,130)) + mat(k,2260) = -rxt(k,429)*y(k,238) + mat(k,1909) = -rxt(k,430)*y(k,238) + mat(k,1558) = -rxt(k,431)*y(k,238) + mat(k,609) = -((rxt(k,348) + rxt(k,349)) * y(k,129)) + mat(k,1898) = -(rxt(k,348) + rxt(k,349)) * y(k,239) + mat(k,395) = rxt(k,347)*y(k,253) + mat(k,1749) = rxt(k,347)*y(k,18) + mat(k,1883) = .750_r8*rxt(k,317)*y(k,241) + mat(k,750) = .750_r8*rxt(k,317)*y(k,129) + mat(k,751) = -(rxt(k,316)*y(k,242) + rxt(k,317)*y(k,129)) + mat(k,2255) = -rxt(k,316)*y(k,241) + mat(k,1905) = -rxt(k,317)*y(k,241) + mat(k,602) = rxt(k,323)*y(k,253) + mat(k,1765) = rxt(k,323)*y(k,27) + mat(k,2311) = -((rxt(k,154) + rxt(k,155) + rxt(k,156)) * y(k,78) + rxt(k,158) & + *y(k,139) + rxt(k,159)*y(k,140) + rxt(k,163)*y(k,253) & + + 4._r8*rxt(k,168)*y(k,242) + rxt(k,178)*y(k,131) + rxt(k,183) & + *y(k,129) + rxt(k,188)*y(k,130) + (rxt(k,198) + rxt(k,199) & + ) * y(k,58) + rxt(k,205)*y(k,61) + rxt(k,231)*y(k,19) + rxt(k,237) & + *y(k,21) + rxt(k,274)*y(k,44) + rxt(k,280)*y(k,237) + rxt(k,287) & + *y(k,243) + rxt(k,301)*y(k,233) + rxt(k,312)*y(k,236) + rxt(k,316) & + *y(k,241) + rxt(k,329)*y(k,234) + rxt(k,337)*y(k,255) + rxt(k,341) & + *y(k,256) + rxt(k,353)*y(k,246) + rxt(k,362)*y(k,248) + rxt(k,366) & + *y(k,250) + rxt(k,376)*y(k,230) + rxt(k,386)*y(k,244) + rxt(k,391) & + *y(k,245) + rxt(k,400)*y(k,103) + rxt(k,411)*y(k,260) + rxt(k,415) & + *y(k,229) + rxt(k,418)*y(k,231) + rxt(k,422)*y(k,232) + rxt(k,425) & + *y(k,235) + rxt(k,429)*y(k,238) + rxt(k,432)*y(k,247) + rxt(k,435) & + *y(k,249) + rxt(k,438)*y(k,254) + rxt(k,445)*y(k,259) + rxt(k,451) & + *y(k,261) + rxt(k,454)*y(k,262) + rxt(k,465)*y(k,251) + rxt(k,470) & + *y(k,257) + rxt(k,475)*y(k,258)) + mat(k,1521) = -(rxt(k,154) + rxt(k,155) + rxt(k,156)) * y(k,242) + mat(k,1618) = -rxt(k,158)*y(k,242) + mat(k,2193) = -rxt(k,159)*y(k,242) + mat(k,1831) = -rxt(k,163)*y(k,242) + mat(k,2092) = -rxt(k,178)*y(k,242) + mat(k,1958) = -rxt(k,183)*y(k,242) + mat(k,1587) = -rxt(k,188)*y(k,242) + mat(k,2131) = -(rxt(k,198) + rxt(k,199)) * y(k,242) + mat(k,2337) = -rxt(k,205)*y(k,242) + mat(k,1470) = -rxt(k,231)*y(k,242) + mat(k,1855) = -rxt(k,237)*y(k,242) + mat(k,1544) = -rxt(k,274)*y(k,242) + mat(k,2010) = -rxt(k,280)*y(k,242) + mat(k,497) = -rxt(k,287)*y(k,242) + mat(k,872) = -rxt(k,301)*y(k,242) + mat(k,1444) = -rxt(k,312)*y(k,242) + mat(k,757) = -rxt(k,316)*y(k,242) + mat(k,844) = -rxt(k,329)*y(k,242) + mat(k,820) = -rxt(k,337)*y(k,242) + mat(k,1208) = -rxt(k,341)*y(k,242) + mat(k,1369) = -rxt(k,353)*y(k,242) + mat(k,1412) = -rxt(k,362)*y(k,242) + mat(k,705) = -rxt(k,366)*y(k,242) + mat(k,969) = -rxt(k,376)*y(k,242) + mat(k,1315) = -rxt(k,386)*y(k,242) + mat(k,1348) = -rxt(k,391)*y(k,242) + mat(k,1250) = -rxt(k,400)*y(k,242) + mat(k,1227) = -rxt(k,411)*y(k,242) + mat(k,568) = -rxt(k,415)*y(k,242) + mat(k,542) = -rxt(k,418)*y(k,242) + mat(k,491) = -rxt(k,422)*y(k,242) + mat(k,675) = -rxt(k,425)*y(k,242) + mat(k,811) = -rxt(k,429)*y(k,242) + mat(k,763) = -rxt(k,432)*y(k,242) + mat(k,926) = -rxt(k,435)*y(k,242) + mat(k,504) = -rxt(k,438)*y(k,242) + mat(k,778) = -rxt(k,445)*y(k,242) + mat(k,803) = -rxt(k,451)*y(k,242) + mat(k,550) = -rxt(k,454)*y(k,242) + mat(k,1113) = -rxt(k,465)*y(k,242) + mat(k,1173) = -rxt(k,470)*y(k,242) + mat(k,1195) = -rxt(k,475)*y(k,242) + mat(k,1033) = .570_r8*rxt(k,459)*y(k,140) + mat(k,212) = .650_r8*rxt(k,417)*y(k,253) + mat(k,1470) = mat(k,1470) + rxt(k,230)*y(k,44) + mat(k,1855) = mat(k,1855) + rxt(k,242)*y(k,253) + mat(k,326) = .350_r8*rxt(k,296)*y(k,253) + mat(k,608) = .130_r8*rxt(k,298)*y(k,140) + mat(k,309) = rxt(k,303)*y(k,253) + mat(k,1063) = .280_r8*rxt(k,327)*y(k,140) + mat(k,1544) = mat(k,1544) + rxt(k,230)*y(k,19) + rxt(k,194)*y(k,58) & + + rxt(k,275)*y(k,131) + rxt(k,276)*y(k,139) + mat(k,633) = rxt(k,259)*y(k,58) + rxt(k,260)*y(k,253) + mat(k,408) = rxt(k,262)*y(k,58) + rxt(k,263)*y(k,253) + mat(k,146) = rxt(k,309)*y(k,253) + mat(k,834) = rxt(k,282)*y(k,253) + mat(k,1488) = rxt(k,291)*y(k,252) + mat(k,2131) = mat(k,2131) + rxt(k,194)*y(k,44) + rxt(k,259)*y(k,45) & + + rxt(k,262)*y(k,48) + rxt(k,197)*y(k,81) + mat(k,2337) = mat(k,2337) + rxt(k,201)*y(k,237) + rxt(k,212)*y(k,253) + mat(k,1130) = rxt(k,294)*y(k,253) + mat(k,243) = .730_r8*rxt(k,428)*y(k,253) + mat(k,354) = .500_r8*rxt(k,496)*y(k,253) + mat(k,1097) = rxt(k,320)*y(k,253) + mat(k,1001) = rxt(k,321)*y(k,253) + mat(k,651) = rxt(k,197)*y(k,58) + rxt(k,153)*y(k,139) + rxt(k,162)*y(k,253) + mat(k,230) = rxt(k,285)*y(k,253) + mat(k,993) = rxt(k,286)*y(k,253) + mat(k,1147) = rxt(k,350)*y(k,253) + mat(k,1154) = rxt(k,335)*y(k,253) + mat(k,894) = .370_r8*rxt(k,404)*y(k,140) + mat(k,625) = .300_r8*rxt(k,395)*y(k,253) + mat(k,600) = rxt(k,396)*y(k,253) + mat(k,1250) = mat(k,1250) + rxt(k,401)*y(k,129) + rxt(k,402)*y(k,131) & + + rxt(k,398)*y(k,236) + 1.200_r8*rxt(k,399)*y(k,237) + mat(k,429) = rxt(k,403)*y(k,253) + mat(k,1262) = .140_r8*rxt(k,357)*y(k,140) + mat(k,388) = .200_r8*rxt(k,359)*y(k,253) + mat(k,661) = .500_r8*rxt(k,370)*y(k,253) + mat(k,954) = .570_r8*rxt(k,462)*y(k,140) + mat(k,1392) = .280_r8*rxt(k,371)*y(k,140) + mat(k,471) = rxt(k,407)*y(k,253) + mat(k,1080) = rxt(k,408)*y(k,253) + mat(k,1958) = mat(k,1958) + rxt(k,401)*y(k,103) + rxt(k,377)*y(k,230) & + + rxt(k,419)*y(k,231) + rxt(k,424)*y(k,232) + rxt(k,302) & + *y(k,233) + rxt(k,330)*y(k,234) + rxt(k,281)*y(k,237) & + + .170_r8*rxt(k,430)*y(k,238) + rxt(k,348)*y(k,239) & + + .250_r8*rxt(k,317)*y(k,241) + rxt(k,289)*y(k,243) & + + .920_r8*rxt(k,387)*y(k,244) + .920_r8*rxt(k,393)*y(k,245) & + + .470_r8*rxt(k,355)*y(k,246) + .400_r8*rxt(k,433)*y(k,247) & + + .830_r8*rxt(k,436)*y(k,249) + rxt(k,439)*y(k,254) + rxt(k,338) & + *y(k,255) + .900_r8*rxt(k,471)*y(k,257) + .800_r8*rxt(k,476) & + *y(k,258) + rxt(k,446)*y(k,259) + rxt(k,412)*y(k,260) & + + rxt(k,452)*y(k,261) + rxt(k,455)*y(k,262) + mat(k,2092) = mat(k,2092) + rxt(k,275)*y(k,44) + rxt(k,402)*y(k,103) & + + rxt(k,388)*y(k,244) + rxt(k,394)*y(k,245) + .470_r8*rxt(k,354) & + *y(k,246) + rxt(k,181)*y(k,253) + rxt(k,413)*y(k,260) + mat(k,1618) = mat(k,1618) + rxt(k,276)*y(k,44) + rxt(k,153)*y(k,81) + mat(k,2193) = mat(k,2193) + .570_r8*rxt(k,459)*y(k,6) + .130_r8*rxt(k,298) & + *y(k,27) + .280_r8*rxt(k,327)*y(k,31) + .370_r8*rxt(k,404) & + *y(k,100) + .140_r8*rxt(k,357)*y(k,111) + .570_r8*rxt(k,462) & + *y(k,116) + .280_r8*rxt(k,371)*y(k,118) + rxt(k,165)*y(k,253) + mat(k,221) = .800_r8*rxt(k,440)*y(k,253) + mat(k,906) = rxt(k,486)*y(k,253) + mat(k,1124) = .200_r8*rxt(k,480)*y(k,253) + mat(k,238) = .280_r8*rxt(k,448)*y(k,253) + mat(k,260) = .380_r8*rxt(k,450)*y(k,253) + mat(k,265) = .630_r8*rxt(k,456)*y(k,253) + mat(k,969) = mat(k,969) + rxt(k,377)*y(k,129) + mat(k,542) = mat(k,542) + rxt(k,419)*y(k,129) + mat(k,491) = mat(k,491) + rxt(k,424)*y(k,129) + mat(k,872) = mat(k,872) + rxt(k,302)*y(k,129) + 2.400_r8*rxt(k,299)*y(k,233) & + + rxt(k,300)*y(k,237) + mat(k,844) = mat(k,844) + rxt(k,330)*y(k,129) + rxt(k,328)*y(k,237) + mat(k,1444) = mat(k,1444) + rxt(k,398)*y(k,103) + .900_r8*rxt(k,311)*y(k,237) & + + rxt(k,384)*y(k,244) + rxt(k,389)*y(k,245) + .470_r8*rxt(k,351) & + *y(k,246) + rxt(k,409)*y(k,260) + mat(k,2010) = mat(k,2010) + rxt(k,201)*y(k,61) + 1.200_r8*rxt(k,399)*y(k,103) & + + rxt(k,281)*y(k,129) + rxt(k,300)*y(k,233) + rxt(k,328) & + *y(k,234) + .900_r8*rxt(k,311)*y(k,236) + 4.000_r8*rxt(k,278) & + *y(k,237) + rxt(k,385)*y(k,244) + rxt(k,390)*y(k,245) & + + .730_r8*rxt(k,352)*y(k,246) + rxt(k,361)*y(k,248) & + + .500_r8*rxt(k,464)*y(k,251) + .300_r8*rxt(k,340)*y(k,256) & + + rxt(k,469)*y(k,257) + rxt(k,474)*y(k,258) + .800_r8*rxt(k,410) & + *y(k,260) + mat(k,811) = mat(k,811) + .170_r8*rxt(k,430)*y(k,129) + .070_r8*rxt(k,429) & + *y(k,242) + mat(k,616) = rxt(k,348)*y(k,129) + mat(k,757) = mat(k,757) + .250_r8*rxt(k,317)*y(k,129) + mat(k,2311) = mat(k,2311) + .070_r8*rxt(k,429)*y(k,238) + .160_r8*rxt(k,432) & + *y(k,247) + .330_r8*rxt(k,435)*y(k,249) + mat(k,497) = mat(k,497) + rxt(k,289)*y(k,129) + mat(k,1315) = mat(k,1315) + .920_r8*rxt(k,387)*y(k,129) + rxt(k,388)*y(k,131) & + + rxt(k,384)*y(k,236) + rxt(k,385)*y(k,237) + mat(k,1348) = mat(k,1348) + .920_r8*rxt(k,393)*y(k,129) + rxt(k,394)*y(k,131) & + + rxt(k,389)*y(k,236) + rxt(k,390)*y(k,237) + mat(k,1369) = mat(k,1369) + .470_r8*rxt(k,355)*y(k,129) + .470_r8*rxt(k,354) & + *y(k,131) + .470_r8*rxt(k,351)*y(k,236) + .730_r8*rxt(k,352) & + *y(k,237) + mat(k,763) = mat(k,763) + .400_r8*rxt(k,433)*y(k,129) + .160_r8*rxt(k,432) & + *y(k,242) + mat(k,1412) = mat(k,1412) + rxt(k,361)*y(k,237) + mat(k,926) = mat(k,926) + .830_r8*rxt(k,436)*y(k,129) + .330_r8*rxt(k,435) & + *y(k,242) + mat(k,1113) = mat(k,1113) + .500_r8*rxt(k,464)*y(k,237) + mat(k,1659) = rxt(k,291)*y(k,56) + mat(k,1831) = mat(k,1831) + .650_r8*rxt(k,417)*y(k,8) + rxt(k,242)*y(k,21) & + + .350_r8*rxt(k,296)*y(k,26) + rxt(k,303)*y(k,28) + rxt(k,260) & + *y(k,45) + rxt(k,263)*y(k,48) + rxt(k,309)*y(k,49) + rxt(k,282) & + *y(k,54) + rxt(k,212)*y(k,61) + rxt(k,294)*y(k,64) & + + .730_r8*rxt(k,428)*y(k,68) + .500_r8*rxt(k,496)*y(k,69) & + + rxt(k,320)*y(k,76) + rxt(k,321)*y(k,77) + rxt(k,162)*y(k,81) & + + rxt(k,285)*y(k,88) + rxt(k,286)*y(k,89) + rxt(k,350)*y(k,95) & + + rxt(k,335)*y(k,97) + .300_r8*rxt(k,395)*y(k,101) + rxt(k,396) & + *y(k,102) + rxt(k,403)*y(k,104) + .200_r8*rxt(k,359)*y(k,112) & + + .500_r8*rxt(k,370)*y(k,115) + rxt(k,407)*y(k,122) + rxt(k,408) & + *y(k,123) + rxt(k,181)*y(k,131) + rxt(k,165)*y(k,140) & + + .800_r8*rxt(k,440)*y(k,148) + rxt(k,486)*y(k,159) & + + .200_r8*rxt(k,480)*y(k,217) + .280_r8*rxt(k,448)*y(k,219) & + + .380_r8*rxt(k,450)*y(k,222) + .630_r8*rxt(k,456)*y(k,225) + mat(k,504) = mat(k,504) + rxt(k,439)*y(k,129) + mat(k,820) = mat(k,820) + rxt(k,338)*y(k,129) + mat(k,1208) = mat(k,1208) + .300_r8*rxt(k,340)*y(k,237) + mat(k,1173) = mat(k,1173) + .900_r8*rxt(k,471)*y(k,129) + rxt(k,469)*y(k,237) + mat(k,1195) = mat(k,1195) + .800_r8*rxt(k,476)*y(k,129) + rxt(k,474)*y(k,237) + mat(k,778) = mat(k,778) + rxt(k,446)*y(k,129) + mat(k,1227) = mat(k,1227) + rxt(k,412)*y(k,129) + rxt(k,413)*y(k,131) & + + rxt(k,409)*y(k,236) + .800_r8*rxt(k,410)*y(k,237) + mat(k,803) = mat(k,803) + rxt(k,452)*y(k,129) + mat(k,550) = mat(k,550) + rxt(k,455)*y(k,129) + end do + end subroutine nlnmat08 + subroutine nlnmat09( 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,492) = -(rxt(k,287)*y(k,242) + rxt(k,289)*y(k,129)) + mat(k,2237) = -rxt(k,287)*y(k,243) + mat(k,1888) = -rxt(k,289)*y(k,243) + mat(k,1523) = rxt(k,274)*y(k,242) + mat(k,2237) = mat(k,2237) + rxt(k,274)*y(k,44) + mat(k,1301) = -(rxt(k,384)*y(k,236) + rxt(k,385)*y(k,237) + rxt(k,386) & + *y(k,242) + rxt(k,387)*y(k,129) + rxt(k,388)*y(k,131)) + mat(k,1428) = -rxt(k,384)*y(k,244) + mat(k,1989) = -rxt(k,385)*y(k,244) + mat(k,2288) = -rxt(k,386)*y(k,244) + mat(k,1936) = -rxt(k,387)*y(k,244) + mat(k,2070) = -rxt(k,388)*y(k,244) + mat(k,885) = .600_r8*rxt(k,405)*y(k,253) + mat(k,1808) = .600_r8*rxt(k,405)*y(k,100) + mat(k,1334) = -(rxt(k,389)*y(k,236) + rxt(k,390)*y(k,237) + rxt(k,391) & + *y(k,242) + rxt(k,393)*y(k,129) + rxt(k,394)*y(k,131)) + mat(k,1429) = -rxt(k,389)*y(k,245) + mat(k,1990) = -rxt(k,390)*y(k,245) + mat(k,2289) = -rxt(k,391)*y(k,245) + mat(k,1937) = -rxt(k,393)*y(k,245) + mat(k,2071) = -rxt(k,394)*y(k,245) + mat(k,886) = .400_r8*rxt(k,405)*y(k,253) + mat(k,1809) = .400_r8*rxt(k,405)*y(k,100) + mat(k,1358) = -(rxt(k,351)*y(k,236) + rxt(k,352)*y(k,237) + rxt(k,353) & + *y(k,242) + rxt(k,354)*y(k,131) + (rxt(k,355) + rxt(k,356) & + ) * y(k,129)) + mat(k,1430) = -rxt(k,351)*y(k,246) + mat(k,1991) = -rxt(k,352)*y(k,246) + mat(k,2290) = -rxt(k,353)*y(k,246) + mat(k,2072) = -rxt(k,354)*y(k,246) + mat(k,1938) = -(rxt(k,355) + rxt(k,356)) * y(k,246) + mat(k,1255) = .500_r8*rxt(k,358)*y(k,253) + mat(k,385) = .200_r8*rxt(k,359)*y(k,253) + mat(k,1378) = rxt(k,372)*y(k,253) + mat(k,1810) = .500_r8*rxt(k,358)*y(k,111) + .200_r8*rxt(k,359)*y(k,112) & + + rxt(k,372)*y(k,118) + mat(k,758) = -(rxt(k,432)*y(k,242) + rxt(k,433)*y(k,129) + rxt(k,434) & + *y(k,130)) + mat(k,2256) = -rxt(k,432)*y(k,247) + mat(k,1906) = -rxt(k,433)*y(k,247) + mat(k,1557) = -rxt(k,434)*y(k,247) + mat(k,1401) = -(rxt(k,360)*y(k,236) + rxt(k,361)*y(k,237) + rxt(k,362) & + *y(k,242) + 4._r8*rxt(k,363)*y(k,248) + rxt(k,364)*y(k,129) & + + rxt(k,365)*y(k,131) + rxt(k,373)*y(k,130)) + mat(k,1432) = -rxt(k,360)*y(k,248) + mat(k,1993) = -rxt(k,361)*y(k,248) + mat(k,2292) = -rxt(k,362)*y(k,248) + mat(k,1940) = -rxt(k,364)*y(k,248) + mat(k,2074) = -rxt(k,365)*y(k,248) + mat(k,1569) = -rxt(k,373)*y(k,248) + mat(k,1256) = .500_r8*rxt(k,358)*y(k,253) + mat(k,386) = .500_r8*rxt(k,359)*y(k,253) + mat(k,1812) = .500_r8*rxt(k,358)*y(k,111) + .500_r8*rxt(k,359)*y(k,112) + mat(k,918) = -(rxt(k,435)*y(k,242) + rxt(k,436)*y(k,129) + rxt(k,437) & + *y(k,130)) + mat(k,2269) = -rxt(k,435)*y(k,249) + mat(k,1915) = -rxt(k,436)*y(k,249) + mat(k,1562) = -rxt(k,437)*y(k,249) + mat(k,699) = -(rxt(k,366)*y(k,242) + rxt(k,367)*y(k,129)) + mat(k,2250) = -rxt(k,366)*y(k,250) + mat(k,1904) = -rxt(k,367)*y(k,250) + mat(k,552) = rxt(k,368)*y(k,253) + mat(k,390) = rxt(k,369)*y(k,253) + mat(k,1760) = rxt(k,368)*y(k,113) + rxt(k,369)*y(k,114) + mat(k,1102) = -(rxt(k,464)*y(k,237) + rxt(k,465)*y(k,242) + rxt(k,466) & + *y(k,129) + rxt(k,467)*y(k,131)) + mat(k,1978) = -rxt(k,464)*y(k,251) + mat(k,2277) = -rxt(k,465)*y(k,251) + mat(k,1924) = -rxt(k,466)*y(k,251) + mat(k,2057) = -rxt(k,467)*y(k,251) + mat(k,1018) = rxt(k,458)*y(k,131) + mat(k,942) = rxt(k,461)*y(k,131) + mat(k,2057) = mat(k,2057) + rxt(k,458)*y(k,6) + rxt(k,461)*y(k,116) & + + .500_r8*rxt(k,478)*y(k,216) + mat(k,450) = rxt(k,468)*y(k,253) + mat(k,1036) = .500_r8*rxt(k,478)*y(k,131) + mat(k,1795) = rxt(k,468)*y(k,133) + mat(k,1650) = -(rxt(k,144)*y(k,79) + rxt(k,145)*y(k,263) + rxt(k,148) & + *y(k,140) + (rxt(k,186) + rxt(k,187)) * y(k,120) + rxt(k,219) & + *y(k,35) + rxt(k,220)*y(k,36) + rxt(k,221)*y(k,38) + rxt(k,222) & + *y(k,39) + rxt(k,223)*y(k,40) + rxt(k,224)*y(k,41) + rxt(k,225) & + *y(k,42) + (rxt(k,226) + rxt(k,227)) * y(k,87) + rxt(k,246) & + *y(k,37) + rxt(k,247)*y(k,57) + rxt(k,248)*y(k,80) + (rxt(k,249) & + + rxt(k,250)) * y(k,83) + rxt(k,255)*y(k,66) + rxt(k,256) & + *y(k,67) + rxt(k,269)*y(k,43) + rxt(k,270)*y(k,45) + rxt(k,271) & + *y(k,84) + rxt(k,272)*y(k,85) + rxt(k,273)*y(k,86) + (rxt(k,290) & + + rxt(k,291) + rxt(k,292)) * y(k,56) + rxt(k,293)*y(k,88)) + mat(k,1453) = -rxt(k,144)*y(k,252) + mat(k,2354) = -rxt(k,145)*y(k,252) + mat(k,2184) = -rxt(k,148)*y(k,252) + mat(k,225) = -(rxt(k,186) + rxt(k,187)) * y(k,252) + mat(k,142) = -rxt(k,219)*y(k,252) + mat(k,183) = -rxt(k,220)*y(k,252) + mat(k,160) = -rxt(k,221)*y(k,252) + mat(k,193) = -rxt(k,222)*y(k,252) + mat(k,164) = -rxt(k,223)*y(k,252) + mat(k,198) = -rxt(k,224)*y(k,252) + mat(k,168) = -rxt(k,225)*y(k,252) + mat(k,2024) = -(rxt(k,226) + rxt(k,227)) * y(k,252) + mat(k,189) = -rxt(k,246)*y(k,252) + mat(k,462) = -rxt(k,247)*y(k,252) + mat(k,153) = -rxt(k,248)*y(k,252) + mat(k,850) = -(rxt(k,249) + rxt(k,250)) * y(k,252) + mat(k,285) = -rxt(k,255)*y(k,252) + mat(k,293) = -rxt(k,256)*y(k,252) + mat(k,510) = -rxt(k,269)*y(k,252) + mat(k,628) = -rxt(k,270)*y(k,252) + mat(k,288) = -rxt(k,271)*y(k,252) + mat(k,298) = -rxt(k,272)*y(k,252) + mat(k,336) = -rxt(k,273)*y(k,252) + mat(k,1482) = -(rxt(k,290) + rxt(k,291) + rxt(k,292)) * y(k,252) + mat(k,228) = -rxt(k,293)*y(k,252) + mat(k,1823) = -(rxt(k,161)*y(k,79) + rxt(k,162)*y(k,81) + rxt(k,163)*y(k,242) & + + rxt(k,164)*y(k,139) + rxt(k,165)*y(k,140) + (4._r8*rxt(k,166) & + + 4._r8*rxt(k,167)) * y(k,253) + rxt(k,169)*y(k,92) + rxt(k,181) & + *y(k,131) + rxt(k,182)*y(k,119) + rxt(k,190)*y(k,130) + rxt(k,191) & + *y(k,91) + rxt(k,210)*y(k,62) + (rxt(k,212) + rxt(k,213) & + ) * y(k,61) + rxt(k,215)*y(k,87) + rxt(k,218)*y(k,94) + rxt(k,242) & + *y(k,21) + rxt(k,244)*y(k,83) + rxt(k,258)*y(k,43) + rxt(k,260) & + *y(k,45) + rxt(k,261)*y(k,46) + rxt(k,263)*y(k,48) + rxt(k,265) & + *y(k,57) + rxt(k,266)*y(k,84) + rxt(k,267)*y(k,85) + rxt(k,268) & + *y(k,86) + rxt(k,277)*y(k,44) + rxt(k,282)*y(k,54) + rxt(k,283) & + *y(k,55) + rxt(k,284)*y(k,56) + rxt(k,285)*y(k,88) + rxt(k,286) & + *y(k,89) + rxt(k,294)*y(k,64) + rxt(k,296)*y(k,26) + rxt(k,303) & + *y(k,28) + rxt(k,304)*y(k,29) + rxt(k,306)*y(k,30) + rxt(k,308) & + *y(k,47) + rxt(k,309)*y(k,49) + rxt(k,314)*y(k,52) + rxt(k,315) & + *y(k,53) + rxt(k,320)*y(k,76) + rxt(k,321)*y(k,77) + rxt(k,322) & + *y(k,145) + rxt(k,323)*y(k,27) + rxt(k,331)*y(k,32) + rxt(k,332) & + *y(k,33) + rxt(k,334)*y(k,51) + rxt(k,335)*y(k,97) + rxt(k,336) & + *y(k,132) + rxt(k,339)*y(k,154) + rxt(k,343)*y(k,155) + rxt(k,344) & + *y(k,31) + rxt(k,345)*y(k,50) + rxt(k,347)*y(k,18) + rxt(k,350) & + *y(k,95) + rxt(k,358)*y(k,111) + rxt(k,359)*y(k,112) + rxt(k,368) & + *y(k,113) + rxt(k,369)*y(k,114) + rxt(k,370)*y(k,115) + rxt(k,372) & + *y(k,118) + rxt(k,375)*y(k,1) + rxt(k,379)*y(k,2) + rxt(k,380) & + *y(k,17) + rxt(k,381)*y(k,96) + rxt(k,382)*y(k,98) + rxt(k,383) & + *y(k,99) + rxt(k,395)*y(k,101) + rxt(k,396)*y(k,102) + rxt(k,403) & + *y(k,104) + rxt(k,405)*y(k,100) + rxt(k,406)*y(k,106) + rxt(k,407) & + *y(k,122) + rxt(k,408)*y(k,123) + rxt(k,414)*y(k,221) + rxt(k,417) & + *y(k,8) + rxt(k,420)*y(k,10) + rxt(k,421)*y(k,24) + rxt(k,423) & + *y(k,25) + rxt(k,427)*y(k,34) + rxt(k,428)*y(k,68) + rxt(k,440) & + *y(k,148) + rxt(k,443)*y(k,149) + rxt(k,447)*y(k,218) + rxt(k,448) & + *y(k,219) + rxt(k,450)*y(k,222) + rxt(k,453)*y(k,223) + rxt(k,456) & + *y(k,225) + rxt(k,457)*y(k,226) + rxt(k,460)*y(k,6) + rxt(k,463) & + *y(k,116) + rxt(k,468)*y(k,133) + rxt(k,472)*y(k,213) + rxt(k,473) & + *y(k,214) + rxt(k,477)*y(k,215) + rxt(k,479)*y(k,216) + rxt(k,480) & + *y(k,217) + (rxt(k,482) + rxt(k,496)) * y(k,69) + rxt(k,484) & + *y(k,143) + rxt(k,486)*y(k,159) + rxt(k,490)*y(k,156) + rxt(k,495) & + *y(k,158) + rxt(k,498)*y(k,127)) + mat(k,1454) = -rxt(k,161)*y(k,253) + mat(k,648) = -rxt(k,162)*y(k,253) + mat(k,2303) = -rxt(k,163)*y(k,253) + mat(k,1610) = -rxt(k,164)*y(k,253) + mat(k,2185) = -rxt(k,165)*y(k,253) + mat(k,444) = -rxt(k,169)*y(k,253) + mat(k,2084) = -rxt(k,181)*y(k,253) + mat(k,532) = -rxt(k,182)*y(k,253) + mat(k,1579) = -rxt(k,190)*y(k,253) + mat(k,1500) = -rxt(k,191)*y(k,253) + mat(k,976) = -rxt(k,210)*y(k,253) + mat(k,2329) = -(rxt(k,212) + rxt(k,213)) * y(k,253) + mat(k,2025) = -rxt(k,215)*y(k,253) + mat(k,857) = -rxt(k,218)*y(k,253) + mat(k,1847) = -rxt(k,242)*y(k,253) + mat(k,851) = -rxt(k,244)*y(k,253) + mat(k,511) = -rxt(k,258)*y(k,253) + mat(k,629) = -rxt(k,260)*y(k,253) + mat(k,171) = -rxt(k,261)*y(k,253) + mat(k,404) = -rxt(k,263)*y(k,253) + mat(k,463) = -rxt(k,265)*y(k,253) + mat(k,289) = -rxt(k,266)*y(k,253) + mat(k,299) = -rxt(k,267)*y(k,253) + mat(k,337) = -rxt(k,268)*y(k,253) + mat(k,1536) = -rxt(k,277)*y(k,253) + mat(k,833) = -rxt(k,282)*y(k,253) + mat(k,457) = -rxt(k,283)*y(k,253) + mat(k,1483) = -rxt(k,284)*y(k,253) + mat(k,229) = -rxt(k,285)*y(k,253) + mat(k,992) = -rxt(k,286)*y(k,253) + mat(k,1129) = -rxt(k,294)*y(k,253) + mat(k,325) = -rxt(k,296)*y(k,253) + mat(k,308) = -rxt(k,303)*y(k,253) + mat(k,379) = -rxt(k,304)*y(k,253) + mat(k,329) = -rxt(k,306)*y(k,253) + mat(k,1085) = -rxt(k,308)*y(k,253) + mat(k,145) = -rxt(k,309)*y(k,253) + mat(k,731) = -rxt(k,314)*y(k,253) + mat(k,639) = -rxt(k,315)*y(k,253) + mat(k,1096) = -rxt(k,320)*y(k,253) + mat(k,1000) = -rxt(k,321)*y(k,253) + mat(k,574) = -rxt(k,322)*y(k,253) + mat(k,606) = -rxt(k,323)*y(k,253) + mat(k,439) = -rxt(k,331)*y(k,253) + mat(k,156) = -rxt(k,332)*y(k,253) + mat(k,1269) = -rxt(k,334)*y(k,253) + mat(k,1153) = -rxt(k,335)*y(k,253) + mat(k,900) = -rxt(k,336)*y(k,253) + mat(k,590) = -rxt(k,339)*y(k,253) + mat(k,422) = -rxt(k,343)*y(k,253) + mat(k,1058) = -rxt(k,344)*y(k,253) + mat(k,985) = -rxt(k,345)*y(k,253) + mat(k,400) = -rxt(k,347)*y(k,253) + mat(k,1144) = -rxt(k,350)*y(k,253) + mat(k,1260) = -rxt(k,358)*y(k,253) + mat(k,387) = -rxt(k,359)*y(k,253) + mat(k,555) = -rxt(k,368)*y(k,253) + mat(k,393) = -rxt(k,369)*y(k,253) + mat(k,659) = -rxt(k,370)*y(k,253) + mat(k,1387) = -rxt(k,372)*y(k,253) + mat(k,696) = -rxt(k,375)*y(k,253) + mat(k,685) = -rxt(k,379)*y(k,253) + mat(k,268) = -rxt(k,380)*y(k,253) + mat(k,281) = -rxt(k,381)*y(k,253) + mat(k,383) = -rxt(k,382)*y(k,253) + mat(k,176) = -rxt(k,383)*y(k,253) + mat(k,624) = -rxt(k,395)*y(k,253) + mat(k,599) = -rxt(k,396)*y(k,253) + mat(k,428) = -rxt(k,403)*y(k,253) + mat(k,890) = -rxt(k,405)*y(k,253) + mat(k,785) = -rxt(k,406)*y(k,253) + mat(k,470) = -rxt(k,407)*y(k,253) + mat(k,1077) = -rxt(k,408)*y(k,253) + mat(k,250) = -rxt(k,414)*y(k,253) + mat(k,211) = -rxt(k,417)*y(k,253) + mat(k,476) = -rxt(k,420)*y(k,253) + mat(k,277) = -rxt(k,421)*y(k,253) + mat(k,374) = -rxt(k,423)*y(k,253) + mat(k,313) = -rxt(k,427)*y(k,253) + mat(k,242) = -rxt(k,428)*y(k,253) + mat(k,220) = -rxt(k,440)*y(k,253) + mat(k,368) = -rxt(k,443)*y(k,253) + mat(k,727) = -rxt(k,447)*y(k,253) + mat(k,237) = -rxt(k,448)*y(k,253) + mat(k,259) = -rxt(k,450)*y(k,253) + mat(k,747) = -rxt(k,453)*y(k,253) + mat(k,264) = -rxt(k,456)*y(k,253) + mat(k,482) = -rxt(k,457)*y(k,253) + mat(k,1028) = -rxt(k,460)*y(k,253) + mat(k,951) = -rxt(k,463)*y(k,253) + mat(k,453) = -rxt(k,468)*y(k,253) + mat(k,714) = -rxt(k,472)*y(k,253) + mat(k,666) = -rxt(k,473)*y(k,253) + mat(k,520) = -rxt(k,477)*y(k,253) + mat(k,1040) = -rxt(k,479)*y(k,253) + mat(k,1122) = -rxt(k,480)*y(k,253) + mat(k,352) = -(rxt(k,482) + rxt(k,496)) * y(k,253) + mat(k,417) = -rxt(k,484)*y(k,253) + mat(k,905) = -rxt(k,486)*y(k,253) + mat(k,560) = -rxt(k,490)*y(k,253) + mat(k,1281) = -rxt(k,495)*y(k,253) + mat(k,139) = -rxt(k,498)*y(k,253) + mat(k,1028) = mat(k,1028) + .630_r8*rxt(k,459)*y(k,140) + mat(k,325) = mat(k,325) + .650_r8*rxt(k,296)*y(k,253) + mat(k,606) = mat(k,606) + .130_r8*rxt(k,298)*y(k,140) + mat(k,379) = mat(k,379) + .500_r8*rxt(k,304)*y(k,253) + mat(k,1058) = mat(k,1058) + .360_r8*rxt(k,327)*y(k,140) + mat(k,1536) = mat(k,1536) + rxt(k,276)*y(k,139) + mat(k,457) = mat(k,457) + .300_r8*rxt(k,283)*y(k,253) + mat(k,1483) = mat(k,1483) + rxt(k,290)*y(k,252) + mat(k,2123) = rxt(k,199)*y(k,242) + mat(k,914) = rxt(k,253)*y(k,263) + mat(k,1515) = rxt(k,160)*y(k,140) + 2.000_r8*rxt(k,155)*y(k,242) + mat(k,1454) = mat(k,1454) + rxt(k,152)*y(k,139) + rxt(k,144)*y(k,252) + mat(k,648) = mat(k,648) + rxt(k,153)*y(k,139) + mat(k,851) = mat(k,851) + rxt(k,243)*y(k,139) + rxt(k,249)*y(k,252) + mat(k,2025) = mat(k,2025) + rxt(k,214)*y(k,139) + rxt(k,226)*y(k,252) + mat(k,229) = mat(k,229) + rxt(k,293)*y(k,252) + mat(k,826) = rxt(k,245)*y(k,139) + mat(k,857) = mat(k,857) + rxt(k,217)*y(k,139) + mat(k,890) = mat(k,890) + .320_r8*rxt(k,404)*y(k,140) + mat(k,785) = mat(k,785) + .600_r8*rxt(k,406)*y(k,253) + mat(k,1260) = mat(k,1260) + .240_r8*rxt(k,357)*y(k,140) + mat(k,387) = mat(k,387) + .100_r8*rxt(k,359)*y(k,253) + mat(k,951) = mat(k,951) + .630_r8*rxt(k,462)*y(k,140) + mat(k,1387) = mat(k,1387) + .360_r8*rxt(k,371)*y(k,140) + mat(k,1950) = rxt(k,183)*y(k,242) + mat(k,2084) = mat(k,2084) + rxt(k,178)*y(k,242) + mat(k,1610) = mat(k,1610) + rxt(k,276)*y(k,44) + rxt(k,152)*y(k,79) & + + rxt(k,153)*y(k,81) + rxt(k,243)*y(k,83) + rxt(k,214)*y(k,87) & + + rxt(k,245)*y(k,93) + rxt(k,217)*y(k,94) + rxt(k,158)*y(k,242) + mat(k,2185) = mat(k,2185) + .630_r8*rxt(k,459)*y(k,6) + .130_r8*rxt(k,298) & + *y(k,27) + .360_r8*rxt(k,327)*y(k,31) + rxt(k,160)*y(k,78) & + + .320_r8*rxt(k,404)*y(k,100) + .240_r8*rxt(k,357)*y(k,111) & + + .630_r8*rxt(k,462)*y(k,116) + .360_r8*rxt(k,371)*y(k,118) & + + rxt(k,159)*y(k,242) + mat(k,590) = mat(k,590) + .500_r8*rxt(k,339)*y(k,253) + mat(k,250) = mat(k,250) + .500_r8*rxt(k,414)*y(k,253) + mat(k,566) = .400_r8*rxt(k,415)*y(k,242) + mat(k,1439) = .450_r8*rxt(k,312)*y(k,242) + mat(k,808) = .400_r8*rxt(k,429)*y(k,242) + mat(k,2303) = mat(k,2303) + rxt(k,199)*y(k,58) + 2.000_r8*rxt(k,155)*y(k,78) & + + rxt(k,183)*y(k,129) + rxt(k,178)*y(k,131) + rxt(k,158) & + *y(k,139) + rxt(k,159)*y(k,140) + .400_r8*rxt(k,415)*y(k,229) & + + .450_r8*rxt(k,312)*y(k,236) + .400_r8*rxt(k,429)*y(k,238) & + + .450_r8*rxt(k,362)*y(k,248) + .400_r8*rxt(k,435)*y(k,249) & + + .200_r8*rxt(k,366)*y(k,250) + .150_r8*rxt(k,341)*y(k,256) + mat(k,1407) = .450_r8*rxt(k,362)*y(k,242) + mat(k,923) = .400_r8*rxt(k,435)*y(k,242) + mat(k,703) = .200_r8*rxt(k,366)*y(k,242) + mat(k,1651) = rxt(k,290)*y(k,56) + rxt(k,144)*y(k,79) + rxt(k,249)*y(k,83) & + + rxt(k,226)*y(k,87) + rxt(k,293)*y(k,88) + 2.000_r8*rxt(k,145) & + *y(k,263) + mat(k,1823) = mat(k,1823) + .650_r8*rxt(k,296)*y(k,26) + .500_r8*rxt(k,304) & + *y(k,29) + .300_r8*rxt(k,283)*y(k,55) + .600_r8*rxt(k,406) & + *y(k,106) + .100_r8*rxt(k,359)*y(k,112) + .500_r8*rxt(k,339) & + *y(k,154) + .500_r8*rxt(k,414)*y(k,221) + mat(k,1205) = .150_r8*rxt(k,341)*y(k,242) + mat(k,2355) = rxt(k,253)*y(k,75) + 2.000_r8*rxt(k,145)*y(k,252) + end do + end subroutine nlnmat09 + subroutine nlnmat10( 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,499) = -(rxt(k,438)*y(k,242) + rxt(k,439)*y(k,129)) + mat(k,2238) = -rxt(k,438)*y(k,254) + mat(k,1889) = -rxt(k,439)*y(k,254) + mat(k,240) = .200_r8*rxt(k,428)*y(k,253) + mat(k,218) = .140_r8*rxt(k,440)*y(k,253) + mat(k,366) = rxt(k,443)*y(k,253) + mat(k,1734) = .200_r8*rxt(k,428)*y(k,68) + .140_r8*rxt(k,440)*y(k,148) & + + rxt(k,443)*y(k,149) + mat(k,813) = -(rxt(k,337)*y(k,242) + rxt(k,338)*y(k,129)) + mat(k,2261) = -rxt(k,337)*y(k,255) + mat(k,1910) = -rxt(k,338)*y(k,255) + mat(k,1044) = rxt(k,344)*y(k,253) + mat(k,586) = .500_r8*rxt(k,339)*y(k,253) + mat(k,1771) = rxt(k,344)*y(k,31) + .500_r8*rxt(k,339)*y(k,154) + mat(k,1200) = -(rxt(k,340)*y(k,237) + rxt(k,341)*y(k,242) + rxt(k,342) & + *y(k,129)) + mat(k,1984) = -rxt(k,340)*y(k,256) + mat(k,2283) = -rxt(k,341)*y(k,256) + mat(k,1931) = -rxt(k,342)*y(k,256) + mat(k,1022) = .060_r8*rxt(k,459)*y(k,140) + mat(k,983) = rxt(k,345)*y(k,253) + mat(k,946) = .060_r8*rxt(k,462)*y(k,140) + mat(k,2166) = .060_r8*rxt(k,459)*y(k,6) + .060_r8*rxt(k,462)*y(k,116) + mat(k,419) = rxt(k,343)*y(k,253) + mat(k,1118) = .150_r8*rxt(k,480)*y(k,253) + mat(k,1802) = rxt(k,345)*y(k,50) + rxt(k,343)*y(k,155) + .150_r8*rxt(k,480) & + *y(k,217) + mat(k,1163) = -(rxt(k,469)*y(k,237) + rxt(k,470)*y(k,242) + rxt(k,471) & + *y(k,129)) + mat(k,1982) = -rxt(k,469)*y(k,257) + mat(k,2281) = -rxt(k,470)*y(k,257) + mat(k,1929) = -rxt(k,471)*y(k,257) + mat(k,2062) = .500_r8*rxt(k,478)*y(k,216) + mat(k,712) = rxt(k,472)*y(k,253) + mat(k,1039) = .500_r8*rxt(k,478)*y(k,131) + rxt(k,479)*y(k,253) + mat(k,1800) = rxt(k,472)*y(k,213) + rxt(k,479)*y(k,216) + mat(k,1184) = -(rxt(k,474)*y(k,237) + rxt(k,475)*y(k,242) + rxt(k,476) & + *y(k,129)) + mat(k,1983) = -rxt(k,474)*y(k,258) + mat(k,2282) = -rxt(k,475)*y(k,258) + mat(k,1930) = -rxt(k,476)*y(k,258) + mat(k,1021) = rxt(k,460)*y(k,253) + mat(k,945) = rxt(k,463)*y(k,253) + mat(k,518) = rxt(k,477)*y(k,253) + mat(k,1801) = rxt(k,460)*y(k,6) + rxt(k,463)*y(k,116) + rxt(k,477)*y(k,215) + mat(k,769) = -(rxt(k,445)*y(k,242) + rxt(k,446)*y(k,129)) + mat(k,2257) = -rxt(k,445)*y(k,259) + mat(k,1907) = -rxt(k,446)*y(k,259) + mat(k,721) = rxt(k,447)*y(k,253) + mat(k,236) = .650_r8*rxt(k,448)*y(k,253) + mat(k,1767) = rxt(k,447)*y(k,218) + .650_r8*rxt(k,448)*y(k,219) + mat(k,1217) = -(rxt(k,409)*y(k,236) + rxt(k,410)*y(k,237) + rxt(k,411) & + *y(k,242) + rxt(k,412)*y(k,129) + rxt(k,413)*y(k,131)) + mat(k,1424) = -rxt(k,409)*y(k,260) + mat(k,1985) = -rxt(k,410)*y(k,260) + mat(k,2284) = -rxt(k,411)*y(k,260) + mat(k,1932) = -rxt(k,412)*y(k,260) + mat(k,2065) = -rxt(k,413)*y(k,260) + mat(k,280) = rxt(k,381)*y(k,253) + mat(k,382) = rxt(k,382)*y(k,253) + mat(k,175) = rxt(k,383)*y(k,253) + mat(k,781) = .400_r8*rxt(k,406)*y(k,253) + mat(k,249) = .500_r8*rxt(k,414)*y(k,253) + mat(k,1803) = rxt(k,381)*y(k,96) + rxt(k,382)*y(k,98) + rxt(k,383)*y(k,99) & + + .400_r8*rxt(k,406)*y(k,106) + .500_r8*rxt(k,414)*y(k,221) + mat(k,793) = -(rxt(k,451)*y(k,242) + rxt(k,452)*y(k,129)) + mat(k,2259) = -rxt(k,451)*y(k,261) + mat(k,1908) = -rxt(k,452)*y(k,261) + mat(k,256) = .560_r8*rxt(k,450)*y(k,253) + mat(k,740) = rxt(k,453)*y(k,253) + mat(k,1769) = .560_r8*rxt(k,450)*y(k,222) + rxt(k,453)*y(k,223) + mat(k,544) = -(rxt(k,454)*y(k,242) + rxt(k,455)*y(k,129)) + mat(k,2243) = -rxt(k,454)*y(k,262) + mat(k,1894) = -rxt(k,455)*y(k,262) + mat(k,263) = .300_r8*rxt(k,456)*y(k,253) + mat(k,479) = rxt(k,457)*y(k,253) + mat(k,1741) = .300_r8*rxt(k,456)*y(k,225) + rxt(k,457)*y(k,226) + mat(k,2365) = -(rxt(k,145)*y(k,252) + rxt(k,253)*y(k,75) + rxt(k,497) & + *y(k,160)) + mat(k,1661) = -rxt(k,145)*y(k,263) + mat(k,917) = -rxt(k,253)*y(k,263) + mat(k,305) = -rxt(k,497)*y(k,263) + mat(k,332) = rxt(k,306)*y(k,253) + mat(k,441) = rxt(k,331)*y(k,253) + mat(k,157) = rxt(k,332)*y(k,253) + mat(k,514) = rxt(k,258)*y(k,253) + mat(k,1545) = rxt(k,277)*y(k,253) + mat(k,634) = rxt(k,260)*y(k,253) + mat(k,173) = rxt(k,261)*y(k,253) + mat(k,1089) = rxt(k,308)*y(k,253) + mat(k,409) = rxt(k,263)*y(k,253) + mat(k,987) = rxt(k,345)*y(k,253) + mat(k,1272) = rxt(k,334)*y(k,253) + mat(k,733) = rxt(k,314)*y(k,253) + mat(k,641) = rxt(k,315)*y(k,253) + mat(k,459) = rxt(k,283)*y(k,253) + mat(k,1489) = rxt(k,284)*y(k,253) + mat(k,1522) = rxt(k,156)*y(k,242) + mat(k,1459) = rxt(k,161)*y(k,253) + mat(k,652) = rxt(k,162)*y(k,253) + mat(k,853) = rxt(k,244)*y(k,253) + mat(k,339) = rxt(k,268)*y(k,253) + mat(k,2035) = (rxt(k,553)+rxt(k,558))*y(k,93) + (rxt(k,546)+rxt(k,552) & + +rxt(k,557))*y(k,94) + rxt(k,215)*y(k,253) + mat(k,994) = rxt(k,286)*y(k,253) + mat(k,1506) = rxt(k,191)*y(k,253) + mat(k,447) = rxt(k,169)*y(k,253) + mat(k,830) = (rxt(k,553)+rxt(k,558))*y(k,87) + mat(k,861) = (rxt(k,546)+rxt(k,552)+rxt(k,557))*y(k,87) + rxt(k,218)*y(k,253) + mat(k,1263) = .500_r8*rxt(k,358)*y(k,253) + mat(k,140) = rxt(k,498)*y(k,253) + mat(k,592) = rxt(k,339)*y(k,253) + mat(k,423) = rxt(k,343)*y(k,253) + mat(k,2313) = rxt(k,156)*y(k,78) + rxt(k,163)*y(k,253) + mat(k,1833) = rxt(k,306)*y(k,30) + rxt(k,331)*y(k,32) + rxt(k,332)*y(k,33) & + + rxt(k,258)*y(k,43) + rxt(k,277)*y(k,44) + rxt(k,260)*y(k,45) & + + rxt(k,261)*y(k,46) + rxt(k,308)*y(k,47) + rxt(k,263)*y(k,48) & + + rxt(k,345)*y(k,50) + rxt(k,334)*y(k,51) + rxt(k,314)*y(k,52) & + + rxt(k,315)*y(k,53) + rxt(k,283)*y(k,55) + rxt(k,284)*y(k,56) & + + rxt(k,161)*y(k,79) + rxt(k,162)*y(k,81) + rxt(k,244)*y(k,83) & + + rxt(k,268)*y(k,86) + rxt(k,215)*y(k,87) + rxt(k,286)*y(k,89) & + + rxt(k,191)*y(k,91) + rxt(k,169)*y(k,92) + rxt(k,218)*y(k,94) & + + .500_r8*rxt(k,358)*y(k,111) + rxt(k,498)*y(k,127) + rxt(k,339) & + *y(k,154) + rxt(k,343)*y(k,155) + rxt(k,163)*y(k,242) & + + 2.000_r8*rxt(k,166)*y(k,253) + end do + end subroutine nlnmat10 + 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) = lmat(k, 39) + mat(k, 40) = lmat(k, 40) + mat(k, 41) = lmat(k, 41) + mat(k, 42) = lmat(k, 42) + mat(k, 43) = lmat(k, 43) + mat(k, 44) = lmat(k, 44) + mat(k, 45) = lmat(k, 45) + mat(k, 46) = lmat(k, 46) + mat(k, 47) = lmat(k, 47) + mat(k, 48) = lmat(k, 48) + mat(k, 49) = lmat(k, 49) + mat(k, 50) = lmat(k, 50) + mat(k, 51) = lmat(k, 51) + mat(k, 52) = lmat(k, 52) + mat(k, 53) = lmat(k, 53) + mat(k, 54) = lmat(k, 54) + mat(k, 55) = lmat(k, 55) + mat(k, 56) = lmat(k, 56) + mat(k, 57) = lmat(k, 57) + mat(k, 58) = lmat(k, 58) + mat(k, 59) = lmat(k, 59) + mat(k, 60) = lmat(k, 60) + mat(k, 61) = lmat(k, 61) + mat(k, 62) = lmat(k, 62) + mat(k, 63) = lmat(k, 63) + mat(k, 69) = mat(k, 69) + lmat(k, 69) + mat(k, 71) = mat(k, 71) + lmat(k, 71) + mat(k, 72) = lmat(k, 72) + mat(k, 73) = lmat(k, 73) + mat(k, 74) = lmat(k, 74) + mat(k, 75) = lmat(k, 75) + mat(k, 76) = lmat(k, 76) + mat(k, 82) = mat(k, 82) + lmat(k, 82) + mat(k, 88) = mat(k, 88) + lmat(k, 88) + mat(k, 94) = mat(k, 94) + lmat(k, 94) + mat(k, 95) = lmat(k, 95) + mat(k, 96) = lmat(k, 96) + mat(k, 97) = lmat(k, 97) + mat(k, 98) = lmat(k, 98) + mat(k, 99) = lmat(k, 99) + mat(k, 105) = mat(k, 105) + lmat(k, 105) + mat(k, 107) = mat(k, 107) + lmat(k, 107) + mat(k, 113) = mat(k, 113) + lmat(k, 113) + mat(k, 119) = mat(k, 119) + lmat(k, 119) + mat(k, 125) = mat(k, 125) + lmat(k, 125) + mat(k, 131) = mat(k, 131) + lmat(k, 131) + mat(k, 137) = mat(k, 137) + lmat(k, 137) + mat(k, 138) = mat(k, 138) + lmat(k, 138) + mat(k, 141) = mat(k, 141) + lmat(k, 141) + mat(k, 143) = mat(k, 143) + lmat(k, 143) + mat(k, 144) = mat(k, 144) + lmat(k, 144) + mat(k, 147) = lmat(k, 147) + mat(k, 148) = lmat(k, 148) + mat(k, 149) = lmat(k, 149) + mat(k, 150) = 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, 154) = mat(k, 154) + lmat(k, 154) + mat(k, 158) = mat(k, 158) + lmat(k, 158) + mat(k, 159) = mat(k, 159) + lmat(k, 159) + mat(k, 161) = mat(k, 161) + lmat(k, 161) + mat(k, 162) = mat(k, 162) + lmat(k, 162) + mat(k, 163) = mat(k, 163) + lmat(k, 163) + mat(k, 165) = mat(k, 165) + lmat(k, 165) + mat(k, 166) = mat(k, 166) + lmat(k, 166) + mat(k, 167) = mat(k, 167) + lmat(k, 167) + mat(k, 169) = mat(k, 169) + lmat(k, 169) + mat(k, 170) = mat(k, 170) + lmat(k, 170) + mat(k, 172) = mat(k, 172) + lmat(k, 172) + mat(k, 174) = mat(k, 174) + lmat(k, 174) + mat(k, 177) = lmat(k, 177) + mat(k, 178) = lmat(k, 178) + mat(k, 179) = lmat(k, 179) + mat(k, 180) = mat(k, 180) + lmat(k, 180) + mat(k, 181) = mat(k, 181) + lmat(k, 181) + mat(k, 182) = mat(k, 182) + lmat(k, 182) + mat(k, 184) = mat(k, 184) + lmat(k, 184) + mat(k, 185) = mat(k, 185) + lmat(k, 185) + mat(k, 186) = mat(k, 186) + lmat(k, 186) + mat(k, 187) = mat(k, 187) + lmat(k, 187) + mat(k, 188) = mat(k, 188) + lmat(k, 188) + mat(k, 190) = mat(k, 190) + lmat(k, 190) + mat(k, 191) = 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, 195) = mat(k, 195) + lmat(k, 195) + mat(k, 196) = mat(k, 196) + lmat(k, 196) + mat(k, 197) = mat(k, 197) + lmat(k, 197) + mat(k, 199) = mat(k, 199) + lmat(k, 199) + mat(k, 200) = lmat(k, 200) + mat(k, 201) = lmat(k, 201) + mat(k, 202) = lmat(k, 202) + mat(k, 203) = lmat(k, 203) + mat(k, 204) = lmat(k, 204) + mat(k, 205) = lmat(k, 205) + mat(k, 207) = mat(k, 207) + lmat(k, 207) + mat(k, 213) = lmat(k, 213) + mat(k, 214) = lmat(k, 214) + mat(k, 215) = lmat(k, 215) + mat(k, 216) = lmat(k, 216) + mat(k, 217) = mat(k, 217) + lmat(k, 217) + mat(k, 222) = lmat(k, 222) + mat(k, 223) = lmat(k, 223) + mat(k, 224) = mat(k, 224) + lmat(k, 224) + mat(k, 225) = mat(k, 225) + lmat(k, 225) + mat(k, 227) = mat(k, 227) + lmat(k, 227) + mat(k, 232) = mat(k, 232) + lmat(k, 232) + mat(k, 239) = mat(k, 239) + lmat(k, 239) + mat(k, 244) = lmat(k, 244) + mat(k, 245) = lmat(k, 245) + mat(k, 246) = lmat(k, 246) + mat(k, 247) = lmat(k, 247) + mat(k, 248) = mat(k, 248) + lmat(k, 248) + mat(k, 250) = mat(k, 250) + lmat(k, 250) + mat(k, 253) = mat(k, 253) + lmat(k, 253) + mat(k, 261) = mat(k, 261) + lmat(k, 261) + mat(k, 266) = mat(k, 266) + lmat(k, 266) + mat(k, 269) = lmat(k, 269) + mat(k, 270) = lmat(k, 270) + mat(k, 271) = lmat(k, 271) + mat(k, 272) = lmat(k, 272) + mat(k, 273) = lmat(k, 273) + mat(k, 274) = lmat(k, 274) + mat(k, 275) = mat(k, 275) + lmat(k, 275) + mat(k, 278) = mat(k, 278) + lmat(k, 278) + mat(k, 279) = lmat(k, 279) + mat(k, 281) = mat(k, 281) + lmat(k, 281) + mat(k, 282) = lmat(k, 282) + mat(k, 283) = mat(k, 283) + lmat(k, 283) + mat(k, 284) = mat(k, 284) + lmat(k, 284) + mat(k, 286) = mat(k, 286) + lmat(k, 286) + mat(k, 287) = mat(k, 287) + lmat(k, 287) + mat(k, 290) = mat(k, 290) + lmat(k, 290) + mat(k, 291) = mat(k, 291) + lmat(k, 291) + mat(k, 292) = mat(k, 292) + lmat(k, 292) + mat(k, 294) = mat(k, 294) + lmat(k, 294) + mat(k, 295) = mat(k, 295) + lmat(k, 295) + mat(k, 296) = mat(k, 296) + lmat(k, 296) + mat(k, 300) = mat(k, 300) + lmat(k, 300) + mat(k, 302) = mat(k, 302) + lmat(k, 302) + mat(k, 303) = lmat(k, 303) + mat(k, 304) = lmat(k, 304) + mat(k, 306) = mat(k, 306) + lmat(k, 306) + mat(k, 310) = mat(k, 310) + lmat(k, 310) + mat(k, 311) = lmat(k, 311) + mat(k, 313) = mat(k, 313) + lmat(k, 313) + mat(k, 314) = lmat(k, 314) + mat(k, 315) = lmat(k, 315) + mat(k, 316) = lmat(k, 316) + mat(k, 317) = lmat(k, 317) + mat(k, 318) = lmat(k, 318) + mat(k, 319) = lmat(k, 319) + mat(k, 320) = lmat(k, 320) + mat(k, 321) = mat(k, 321) + lmat(k, 321) + mat(k, 327) = mat(k, 327) + lmat(k, 327) + mat(k, 333) = mat(k, 333) + lmat(k, 333) + mat(k, 334) = mat(k, 334) + lmat(k, 334) + mat(k, 338) = mat(k, 338) + lmat(k, 338) + mat(k, 340) = lmat(k, 340) + mat(k, 341) = lmat(k, 341) + mat(k, 342) = lmat(k, 342) + mat(k, 343) = lmat(k, 343) + mat(k, 344) = lmat(k, 344) + mat(k, 345) = lmat(k, 345) + mat(k, 346) = lmat(k, 346) + mat(k, 347) = lmat(k, 347) + mat(k, 348) = lmat(k, 348) + mat(k, 349) = mat(k, 349) + lmat(k, 349) + mat(k, 355) = lmat(k, 355) + mat(k, 356) = lmat(k, 356) + mat(k, 357) = lmat(k, 357) + mat(k, 358) = lmat(k, 358) + mat(k, 359) = lmat(k, 359) + mat(k, 360) = mat(k, 360) + lmat(k, 360) + mat(k, 363) = lmat(k, 363) + mat(k, 364) = mat(k, 364) + lmat(k, 364) + mat(k, 365) = mat(k, 365) + lmat(k, 365) + mat(k, 367) = lmat(k, 367) + mat(k, 368) = mat(k, 368) + lmat(k, 368) + mat(k, 369) = lmat(k, 369) + mat(k, 370) = lmat(k, 370) + mat(k, 371) = mat(k, 371) + lmat(k, 371) + mat(k, 374) = mat(k, 374) + lmat(k, 374) + mat(k, 375) = lmat(k, 375) + mat(k, 376) = mat(k, 376) + lmat(k, 376) + mat(k, 378) = mat(k, 378) + lmat(k, 378) + mat(k, 379) = mat(k, 379) + lmat(k, 379) + mat(k, 380) = lmat(k, 380) + mat(k, 381) = mat(k, 381) + lmat(k, 381) + mat(k, 384) = mat(k, 384) + lmat(k, 384) + mat(k, 389) = mat(k, 389) + lmat(k, 389) + mat(k, 391) = lmat(k, 391) + mat(k, 392) = lmat(k, 392) + mat(k, 393) = mat(k, 393) + lmat(k, 393) + mat(k, 394) = mat(k, 394) + lmat(k, 394) + mat(k, 402) = mat(k, 402) + lmat(k, 402) + mat(k, 405) = lmat(k, 405) + mat(k, 407) = mat(k, 407) + lmat(k, 407) + mat(k, 410) = mat(k, 410) + lmat(k, 410) + mat(k, 411) = lmat(k, 411) + mat(k, 413) = mat(k, 413) + lmat(k, 413) + mat(k, 418) = mat(k, 418) + lmat(k, 418) + mat(k, 420) = lmat(k, 420) + mat(k, 421) = lmat(k, 421) + mat(k, 422) = mat(k, 422) + lmat(k, 422) + mat(k, 424) = mat(k, 424) + lmat(k, 424) + mat(k, 425) = lmat(k, 425) + mat(k, 427) = lmat(k, 427) + mat(k, 429) = mat(k, 429) + lmat(k, 429) + mat(k, 430) = lmat(k, 430) + mat(k, 431) = lmat(k, 431) + mat(k, 432) = lmat(k, 432) + mat(k, 433) = lmat(k, 433) + mat(k, 434) = lmat(k, 434) + mat(k, 435) = lmat(k, 435) + mat(k, 436) = mat(k, 436) + lmat(k, 436) + mat(k, 438) = lmat(k, 438) + mat(k, 439) = mat(k, 439) + lmat(k, 439) + mat(k, 440) = lmat(k, 440) + mat(k, 442) = mat(k, 442) + lmat(k, 442) + mat(k, 443) = mat(k, 443) + lmat(k, 443) + mat(k, 444) = mat(k, 444) + lmat(k, 444) + mat(k, 445) = lmat(k, 445) + mat(k, 446) = lmat(k, 446) + mat(k, 448) = mat(k, 448) + lmat(k, 448) + mat(k, 449) = lmat(k, 449) + mat(k, 451) = lmat(k, 451) + mat(k, 452) = lmat(k, 452) + mat(k, 453) = mat(k, 453) + lmat(k, 453) + mat(k, 454) = mat(k, 454) + lmat(k, 454) + mat(k, 455) = lmat(k, 455) + mat(k, 456) = mat(k, 456) + lmat(k, 456) + mat(k, 457) = mat(k, 457) + lmat(k, 457) + mat(k, 460) = mat(k, 460) + lmat(k, 460) + mat(k, 461) = mat(k, 461) + lmat(k, 461) + mat(k, 466) = mat(k, 466) + lmat(k, 466) + mat(k, 469) = lmat(k, 469) + mat(k, 472) = mat(k, 472) + lmat(k, 472) + mat(k, 473) = lmat(k, 473) + mat(k, 475) = lmat(k, 475) + mat(k, 476) = mat(k, 476) + lmat(k, 476) + mat(k, 477) = lmat(k, 477) + mat(k, 478) = mat(k, 478) + lmat(k, 478) + mat(k, 480) = lmat(k, 480) + mat(k, 481) = lmat(k, 481) + mat(k, 482) = mat(k, 482) + lmat(k, 482) + mat(k, 483) = lmat(k, 483) + mat(k, 486) = mat(k, 486) + lmat(k, 486) + mat(k, 492) = mat(k, 492) + lmat(k, 492) + mat(k, 494) = lmat(k, 494) + mat(k, 497) = mat(k, 497) + lmat(k, 497) + mat(k, 499) = mat(k, 499) + lmat(k, 499) + mat(k, 505) = lmat(k, 505) + mat(k, 506) = lmat(k, 506) + mat(k, 507) = lmat(k, 507) + mat(k, 508) = mat(k, 508) + lmat(k, 508) + mat(k, 509) = mat(k, 509) + lmat(k, 509) + mat(k, 515) = mat(k, 515) + lmat(k, 515) + mat(k, 516) = lmat(k, 516) + mat(k, 517) = lmat(k, 517) + mat(k, 519) = lmat(k, 519) + mat(k, 520) = mat(k, 520) + lmat(k, 520) + mat(k, 521) = lmat(k, 521) + mat(k, 522) = mat(k, 522) + lmat(k, 522) + mat(k, 527) = mat(k, 527) + lmat(k, 527) + mat(k, 530) = mat(k, 530) + lmat(k, 530) + mat(k, 533) = mat(k, 533) + lmat(k, 533) + mat(k, 536) = mat(k, 536) + lmat(k, 536) + mat(k, 544) = mat(k, 544) + lmat(k, 544) + mat(k, 551) = mat(k, 551) + lmat(k, 551) + mat(k, 553) = lmat(k, 553) + mat(k, 554) = lmat(k, 554) + mat(k, 556) = mat(k, 556) + lmat(k, 556) + mat(k, 557) = mat(k, 557) + lmat(k, 557) + mat(k, 559) = lmat(k, 559) + mat(k, 563) = mat(k, 563) + lmat(k, 563) + mat(k, 569) = mat(k, 569) + lmat(k, 569) + mat(k, 570) = lmat(k, 570) + mat(k, 571) = lmat(k, 571) + mat(k, 573) = lmat(k, 573) + mat(k, 575) = lmat(k, 575) + mat(k, 576) = mat(k, 576) + lmat(k, 576) + mat(k, 577) = mat(k, 577) + lmat(k, 577) + mat(k, 578) = lmat(k, 578) + mat(k, 579) = lmat(k, 579) + mat(k, 580) = lmat(k, 580) + mat(k, 581) = lmat(k, 581) + mat(k, 583) = mat(k, 583) + lmat(k, 583) + mat(k, 584) = mat(k, 584) + lmat(k, 584) + mat(k, 585) = mat(k, 585) + lmat(k, 585) + mat(k, 587) = lmat(k, 587) + mat(k, 589) = lmat(k, 589) + mat(k, 590) = mat(k, 590) + lmat(k, 590) + mat(k, 591) = lmat(k, 591) + mat(k, 593) = mat(k, 593) + lmat(k, 593) + mat(k, 598) = lmat(k, 598) + mat(k, 601) = mat(k, 601) + lmat(k, 601) + mat(k, 609) = mat(k, 609) + lmat(k, 609) + mat(k, 617) = mat(k, 617) + lmat(k, 617) + mat(k, 621) = lmat(k, 621) + mat(k, 626) = mat(k, 626) + lmat(k, 626) + mat(k, 627) = mat(k, 627) + lmat(k, 627) + mat(k, 630) = lmat(k, 630) + mat(k, 635) = mat(k, 635) + lmat(k, 635) + mat(k, 636) = mat(k, 636) + lmat(k, 636) + mat(k, 639) = mat(k, 639) + lmat(k, 639) + mat(k, 640) = lmat(k, 640) + mat(k, 642) = lmat(k, 642) + mat(k, 643) = lmat(k, 643) + mat(k, 644) = lmat(k, 644) + mat(k, 645) = lmat(k, 645) + mat(k, 646) = mat(k, 646) + lmat(k, 646) + mat(k, 648) = mat(k, 648) + lmat(k, 648) + mat(k, 653) = mat(k, 653) + lmat(k, 653) + mat(k, 656) = lmat(k, 656) + mat(k, 658) = lmat(k, 658) + mat(k, 662) = mat(k, 662) + lmat(k, 662) + mat(k, 663) = mat(k, 663) + lmat(k, 663) + mat(k, 664) = lmat(k, 664) + mat(k, 665) = mat(k, 665) + lmat(k, 665) + mat(k, 667) = lmat(k, 667) + mat(k, 670) = mat(k, 670) + lmat(k, 670) + mat(k, 676) = lmat(k, 676) + mat(k, 677) = mat(k, 677) + lmat(k, 677) + mat(k, 681) = lmat(k, 681) + mat(k, 682) = lmat(k, 682) + mat(k, 684) = lmat(k, 684) + mat(k, 685) = mat(k, 685) + lmat(k, 685) + mat(k, 686) = lmat(k, 686) + mat(k, 687) = lmat(k, 687) + mat(k, 688) = mat(k, 688) + lmat(k, 688) + mat(k, 691) = mat(k, 691) + lmat(k, 691) + mat(k, 692) = mat(k, 692) + lmat(k, 692) + mat(k, 694) = mat(k, 694) + lmat(k, 694) + mat(k, 695) = mat(k, 695) + lmat(k, 695) + mat(k, 697) = lmat(k, 697) + mat(k, 699) = mat(k, 699) + lmat(k, 699) + mat(k, 706) = mat(k, 706) + lmat(k, 706) + mat(k, 707) = lmat(k, 707) + mat(k, 708) = lmat(k, 708) + mat(k, 709) = lmat(k, 709) + mat(k, 710) = lmat(k, 710) + mat(k, 711) = lmat(k, 711) + mat(k, 713) = lmat(k, 713) + mat(k, 714) = mat(k, 714) + lmat(k, 714) + mat(k, 715) = lmat(k, 715) + mat(k, 716) = lmat(k, 716) + mat(k, 717) = lmat(k, 717) + mat(k, 718) = lmat(k, 718) + mat(k, 719) = mat(k, 719) + lmat(k, 719) + mat(k, 724) = lmat(k, 724) + mat(k, 726) = lmat(k, 726) + mat(k, 727) = mat(k, 727) + lmat(k, 727) + mat(k, 728) = lmat(k, 728) + mat(k, 729) = mat(k, 729) + lmat(k, 729) + mat(k, 734) = lmat(k, 734) + mat(k, 735) = lmat(k, 735) + mat(k, 736) = lmat(k, 736) + mat(k, 737) = lmat(k, 737) + mat(k, 738) = mat(k, 738) + lmat(k, 738) + mat(k, 743) = lmat(k, 743) + mat(k, 745) = lmat(k, 745) + mat(k, 747) = mat(k, 747) + lmat(k, 747) + mat(k, 748) = lmat(k, 748) + mat(k, 751) = mat(k, 751) + lmat(k, 751) + mat(k, 758) = mat(k, 758) + lmat(k, 758) + mat(k, 769) = mat(k, 769) + lmat(k, 769) + mat(k, 780) = mat(k, 780) + lmat(k, 780) + mat(k, 782) = lmat(k, 782) + mat(k, 783) = lmat(k, 783) + mat(k, 784) = lmat(k, 784) + mat(k, 785) = mat(k, 785) + lmat(k, 785) + mat(k, 786) = lmat(k, 786) + mat(k, 793) = mat(k, 793) + lmat(k, 793) + mat(k, 804) = mat(k, 804) + lmat(k, 804) + mat(k, 813) = mat(k, 813) + lmat(k, 813) + mat(k, 823) = mat(k, 823) + lmat(k, 823) + mat(k, 824) = lmat(k, 824) + mat(k, 826) = mat(k, 826) + lmat(k, 826) + mat(k, 831) = mat(k, 831) + lmat(k, 831) + mat(k, 836) = mat(k, 836) + lmat(k, 836) + mat(k, 846) = mat(k, 846) + lmat(k, 846) + mat(k, 847) = mat(k, 847) + lmat(k, 847) + mat(k, 848) = mat(k, 848) + lmat(k, 848) + mat(k, 855) = mat(k, 855) + lmat(k, 855) + mat(k, 857) = mat(k, 857) + lmat(k, 857) + mat(k, 859) = mat(k, 859) + lmat(k, 859) + mat(k, 865) = mat(k, 865) + lmat(k, 865) + mat(k, 873) = lmat(k, 873) + mat(k, 874) = lmat(k, 874) + mat(k, 875) = lmat(k, 875) + mat(k, 879) = mat(k, 879) + lmat(k, 879) + mat(k, 895) = mat(k, 895) + lmat(k, 895) + mat(k, 897) = lmat(k, 897) + mat(k, 898) = lmat(k, 898) + mat(k, 899) = mat(k, 899) + lmat(k, 899) + mat(k, 902) = mat(k, 902) + lmat(k, 902) + mat(k, 903) = lmat(k, 903) + mat(k, 904) = lmat(k, 904) + mat(k, 909) = mat(k, 909) + lmat(k, 909) + mat(k, 918) = mat(k, 918) + lmat(k, 918) + mat(k, 936) = mat(k, 936) + lmat(k, 936) + mat(k, 960) = mat(k, 960) + lmat(k, 960) + mat(k, 971) = mat(k, 971) + lmat(k, 971) + mat(k, 972) = mat(k, 972) + lmat(k, 972) + mat(k, 973) = mat(k, 973) + lmat(k, 973) + mat(k, 974) = lmat(k, 974) + mat(k, 978) = mat(k, 978) + lmat(k, 978) + mat(k, 979) = mat(k, 979) + lmat(k, 979) + mat(k, 980) = mat(k, 980) + lmat(k, 980) + mat(k, 982) = mat(k, 982) + lmat(k, 982) + mat(k, 984) = lmat(k, 984) + mat(k, 986) = lmat(k, 986) + mat(k, 989) = mat(k, 989) + lmat(k, 989) + mat(k, 995) = lmat(k, 995) + mat(k, 997) = mat(k, 997) + lmat(k, 997) + mat(k, 998) = mat(k, 998) + lmat(k, 998) + mat(k,1001) = mat(k,1001) + lmat(k,1001) + mat(k,1015) = mat(k,1015) + lmat(k,1015) + mat(k,1035) = mat(k,1035) + lmat(k,1035) + mat(k,1037) = lmat(k,1037) + mat(k,1038) = lmat(k,1038) + mat(k,1042) = lmat(k,1042) + mat(k,1048) = mat(k,1048) + lmat(k,1048) + mat(k,1065) = lmat(k,1065) + mat(k,1069) = mat(k,1069) + lmat(k,1069) + mat(k,1073) = lmat(k,1073) + mat(k,1075) = lmat(k,1075) + mat(k,1080) = mat(k,1080) + lmat(k,1080) + mat(k,1081) = mat(k,1081) + lmat(k,1081) + mat(k,1082) = lmat(k,1082) + mat(k,1086) = lmat(k,1086) + mat(k,1088) = lmat(k,1088) + mat(k,1092) = mat(k,1092) + lmat(k,1092) + mat(k,1093) = lmat(k,1093) + mat(k,1094) = mat(k,1094) + lmat(k,1094) + mat(k,1097) = mat(k,1097) + lmat(k,1097) + mat(k,1102) = mat(k,1102) + lmat(k,1102) + mat(k,1114) = mat(k,1114) + lmat(k,1114) + mat(k,1115) = mat(k,1115) + lmat(k,1115) + mat(k,1116) = mat(k,1116) + lmat(k,1116) + mat(k,1117) = mat(k,1117) + lmat(k,1117) + mat(k,1118) = mat(k,1118) + lmat(k,1118) + mat(k,1119) = mat(k,1119) + lmat(k,1119) + mat(k,1120) = mat(k,1120) + lmat(k,1120) + mat(k,1124) = mat(k,1124) + lmat(k,1124) + mat(k,1127) = mat(k,1127) + lmat(k,1127) + mat(k,1132) = lmat(k,1132) + mat(k,1133) = lmat(k,1133) + mat(k,1134) = lmat(k,1134) + mat(k,1135) = lmat(k,1135) + mat(k,1136) = mat(k,1136) + lmat(k,1136) + mat(k,1137) = lmat(k,1137) + mat(k,1139) = lmat(k,1139) + mat(k,1140) = lmat(k,1140) + mat(k,1141) = lmat(k,1141) + mat(k,1142) = lmat(k,1142) + mat(k,1147) = mat(k,1147) + lmat(k,1147) + mat(k,1149) = mat(k,1149) + lmat(k,1149) + mat(k,1151) = lmat(k,1151) + mat(k,1152) = lmat(k,1152) + mat(k,1154) = mat(k,1154) + lmat(k,1154) + mat(k,1163) = mat(k,1163) + lmat(k,1163) + mat(k,1184) = mat(k,1184) + lmat(k,1184) + mat(k,1200) = mat(k,1200) + lmat(k,1200) + mat(k,1217) = mat(k,1217) + lmat(k,1217) + mat(k,1237) = mat(k,1237) + lmat(k,1237) + mat(k,1252) = mat(k,1252) + lmat(k,1252) + mat(k,1253) = mat(k,1253) + lmat(k,1253) + mat(k,1256) = mat(k,1256) + lmat(k,1256) + mat(k,1257) = mat(k,1257) + lmat(k,1257) + mat(k,1258) = mat(k,1258) + lmat(k,1258) + mat(k,1262) = mat(k,1262) + lmat(k,1262) + mat(k,1264) = mat(k,1264) + lmat(k,1264) + mat(k,1265) = mat(k,1265) + lmat(k,1265) + mat(k,1266) = mat(k,1266) + lmat(k,1266) + mat(k,1271) = lmat(k,1271) + mat(k,1274) = lmat(k,1274) + mat(k,1275) = mat(k,1275) + lmat(k,1275) + mat(k,1276) = mat(k,1276) + lmat(k,1276) + mat(k,1280) = lmat(k,1280) + mat(k,1301) = mat(k,1301) + lmat(k,1301) + mat(k,1317) = lmat(k,1317) + mat(k,1334) = mat(k,1334) + lmat(k,1334) + mat(k,1348) = mat(k,1348) + lmat(k,1348) + mat(k,1358) = mat(k,1358) + lmat(k,1358) + mat(k,1373) = lmat(k,1373) + mat(k,1375) = mat(k,1375) + lmat(k,1375) + mat(k,1379) = mat(k,1379) + lmat(k,1379) + mat(k,1381) = mat(k,1381) + lmat(k,1381) + mat(k,1389) = lmat(k,1389) + mat(k,1401) = mat(k,1401) + lmat(k,1401) + mat(k,1433) = mat(k,1433) + lmat(k,1433) + mat(k,1448) = mat(k,1448) + lmat(k,1448) + mat(k,1462) = mat(k,1462) + lmat(k,1462) + mat(k,1473) = lmat(k,1473) + mat(k,1475) = lmat(k,1475) + mat(k,1476) = mat(k,1476) + lmat(k,1476) + mat(k,1477) = mat(k,1477) + lmat(k,1477) + mat(k,1479) = mat(k,1479) + lmat(k,1479) + mat(k,1480) = mat(k,1480) + lmat(k,1480) + mat(k,1481) = lmat(k,1481) + mat(k,1483) = mat(k,1483) + lmat(k,1483) + mat(k,1484) = mat(k,1484) + lmat(k,1484) + mat(k,1489) = mat(k,1489) + lmat(k,1489) + mat(k,1494) = mat(k,1494) + lmat(k,1494) + mat(k,1497) = lmat(k,1497) + mat(k,1500) = mat(k,1500) + lmat(k,1500) + mat(k,1510) = mat(k,1510) + lmat(k,1510) + mat(k,1521) = mat(k,1521) + lmat(k,1521) + mat(k,1526) = mat(k,1526) + lmat(k,1526) + mat(k,1527) = lmat(k,1527) + mat(k,1531) = mat(k,1531) + lmat(k,1531) + mat(k,1532) = mat(k,1532) + lmat(k,1532) + mat(k,1573) = mat(k,1573) + lmat(k,1573) + mat(k,1576) = mat(k,1576) + lmat(k,1576) + mat(k,1577) = mat(k,1577) + lmat(k,1577) + mat(k,1579) = mat(k,1579) + lmat(k,1579) + mat(k,1581) = mat(k,1581) + lmat(k,1581) + mat(k,1608) = mat(k,1608) + lmat(k,1608) + mat(k,1617) = mat(k,1617) + lmat(k,1617) + mat(k,1649) = lmat(k,1649) + mat(k,1650) = mat(k,1650) + lmat(k,1650) + mat(k,1823) = mat(k,1823) + lmat(k,1823) + mat(k,1840) = mat(k,1840) + lmat(k,1840) + mat(k,1845) = mat(k,1845) + lmat(k,1845) + mat(k,1848) = mat(k,1848) + lmat(k,1848) + mat(k,1892) = mat(k,1892) + lmat(k,1892) + mat(k,1948) = mat(k,1948) + lmat(k,1948) + mat(k,1952) = mat(k,1952) + lmat(k,1952) + mat(k,2005) = mat(k,2005) + lmat(k,2005) + mat(k,2020) = mat(k,2020) + lmat(k,2020) + mat(k,2029) = mat(k,2029) + lmat(k,2029) + mat(k,2031) = mat(k,2031) + lmat(k,2031) + mat(k,2078) = mat(k,2078) + lmat(k,2078) + mat(k,2081) = mat(k,2081) + lmat(k,2081) + mat(k,2082) = mat(k,2082) + lmat(k,2082) + mat(k,2086) = mat(k,2086) + lmat(k,2086) + mat(k,2089) = mat(k,2089) + lmat(k,2089) + mat(k,2129) = mat(k,2129) + lmat(k,2129) + mat(k,2183) = mat(k,2183) + lmat(k,2183) + mat(k,2184) = mat(k,2184) + lmat(k,2184) + mat(k,2192) = mat(k,2192) + lmat(k,2192) + mat(k,2247) = mat(k,2247) + lmat(k,2247) + mat(k,2311) = mat(k,2311) + lmat(k,2311) + mat(k,2327) = mat(k,2327) + lmat(k,2327) + mat(k,2335) = mat(k,2335) + lmat(k,2335) + mat(k,2338) = mat(k,2338) + lmat(k,2338) + mat(k,2346) = lmat(k,2346) + mat(k,2350) = lmat(k,2350) + mat(k,2353) = lmat(k,2353) + mat(k,2354) = mat(k,2354) + lmat(k,2354) + mat(k,2355) = mat(k,2355) + lmat(k,2355) + mat(k,2365) = mat(k,2365) + lmat(k,2365) + mat(k, 257) = 0._r8 + mat(k, 258) = 0._r8 + mat(k, 297) = 0._r8 + mat(k, 335) = 0._r8 + mat(k, 373) = 0._r8 + mat(k, 487) = 0._r8 + mat(k, 489) = 0._r8 + mat(k, 502) = 0._r8 + mat(k, 531) = 0._r8 + mat(k, 537) = 0._r8 + mat(k, 540) = 0._r8 + mat(k, 548) = 0._r8 + mat(k, 672) = 0._r8 + mat(k, 674) = 0._r8 + mat(k, 678) = 0._r8 + mat(k, 679) = 0._r8 + mat(k, 683) = 0._r8 + mat(k, 689) = 0._r8 + mat(k, 690) = 0._r8 + mat(k, 693) = 0._r8 + mat(k, 720) = 0._r8 + mat(k, 722) = 0._r8 + mat(k, 723) = 0._r8 + mat(k, 725) = 0._r8 + mat(k, 739) = 0._r8 + mat(k, 741) = 0._r8 + mat(k, 742) = 0._r8 + mat(k, 744) = 0._r8 + mat(k, 746) = 0._r8 + mat(k, 752) = 0._r8 + mat(k, 755) = 0._r8 + mat(k, 768) = 0._r8 + mat(k, 770) = 0._r8 + mat(k, 771) = 0._r8 + mat(k, 773) = 0._r8 + mat(k, 776) = 0._r8 + mat(k, 792) = 0._r8 + mat(k, 794) = 0._r8 + mat(k, 795) = 0._r8 + mat(k, 797) = 0._r8 + mat(k, 799) = 0._r8 + mat(k, 801) = 0._r8 + mat(k, 815) = 0._r8 + mat(k, 818) = 0._r8 + mat(k, 821) = 0._r8 + mat(k, 829) = 0._r8 + mat(k, 841) = 0._r8 + mat(k, 845) = 0._r8 + mat(k, 869) = 0._r8 + mat(k, 907) = 0._r8 + mat(k, 937) = 0._r8 + mat(k, 940) = 0._r8 + mat(k, 947) = 0._r8 + mat(k, 950) = 0._r8 + mat(k, 958) = 0._r8 + mat(k, 959) = 0._r8 + mat(k, 963) = 0._r8 + mat(k, 966) = 0._r8 + mat(k, 968) = 0._r8 + mat(k, 981) = 0._r8 + mat(k, 990) = 0._r8 + mat(k, 991) = 0._r8 + mat(k, 999) = 0._r8 + mat(k,1011) = 0._r8 + mat(k,1014) = 0._r8 + mat(k,1017) = 0._r8 + mat(k,1023) = 0._r8 + mat(k,1026) = 0._r8 + mat(k,1027) = 0._r8 + mat(k,1029) = 0._r8 + mat(k,1030) = 0._r8 + mat(k,1034) = 0._r8 + mat(k,1051) = 0._r8 + mat(k,1052) = 0._r8 + mat(k,1053) = 0._r8 + mat(k,1056) = 0._r8 + mat(k,1057) = 0._r8 + mat(k,1059) = 0._r8 + mat(k,1064) = 0._r8 + mat(k,1067) = 0._r8 + mat(k,1070) = 0._r8 + mat(k,1071) = 0._r8 + mat(k,1072) = 0._r8 + mat(k,1074) = 0._r8 + mat(k,1076) = 0._r8 + mat(k,1078) = 0._r8 + mat(k,1079) = 0._r8 + mat(k,1095) = 0._r8 + mat(k,1103) = 0._r8 + mat(k,1104) = 0._r8 + mat(k,1105) = 0._r8 + mat(k,1106) = 0._r8 + mat(k,1109) = 0._r8 + mat(k,1121) = 0._r8 + mat(k,1123) = 0._r8 + mat(k,1125) = 0._r8 + mat(k,1128) = 0._r8 + mat(k,1138) = 0._r8 + mat(k,1143) = 0._r8 + mat(k,1145) = 0._r8 + mat(k,1146) = 0._r8 + mat(k,1148) = 0._r8 + mat(k,1164) = 0._r8 + mat(k,1165) = 0._r8 + mat(k,1166) = 0._r8 + mat(k,1169) = 0._r8 + mat(k,1170) = 0._r8 + mat(k,1174) = 0._r8 + mat(k,1180) = 0._r8 + mat(k,1181) = 0._r8 + mat(k,1182) = 0._r8 + mat(k,1183) = 0._r8 + mat(k,1185) = 0._r8 + mat(k,1186) = 0._r8 + mat(k,1187) = 0._r8 + mat(k,1190) = 0._r8 + mat(k,1191) = 0._r8 + mat(k,1194) = 0._r8 + mat(k,1196) = 0._r8 + mat(k,1209) = 0._r8 + mat(k,1222) = 0._r8 + mat(k,1223) = 0._r8 + mat(k,1230) = 0._r8 + mat(k,1232) = 0._r8 + mat(k,1234) = 0._r8 + mat(k,1235) = 0._r8 + mat(k,1236) = 0._r8 + mat(k,1238) = 0._r8 + mat(k,1239) = 0._r8 + mat(k,1240) = 0._r8 + mat(k,1242) = 0._r8 + mat(k,1245) = 0._r8 + mat(k,1246) = 0._r8 + mat(k,1259) = 0._r8 + mat(k,1268) = 0._r8 + mat(k,1286) = 0._r8 + mat(k,1288) = 0._r8 + mat(k,1293) = 0._r8 + mat(k,1294) = 0._r8 + mat(k,1295) = 0._r8 + mat(k,1296) = 0._r8 + mat(k,1297) = 0._r8 + mat(k,1298) = 0._r8 + mat(k,1300) = 0._r8 + mat(k,1302) = 0._r8 + mat(k,1304) = 0._r8 + mat(k,1306) = 0._r8 + mat(k,1309) = 0._r8 + mat(k,1310) = 0._r8 + mat(k,1314) = 0._r8 + mat(k,1316) = 0._r8 + mat(k,1320) = 0._r8 + mat(k,1323) = 0._r8 + mat(k,1324) = 0._r8 + mat(k,1327) = 0._r8 + mat(k,1328) = 0._r8 + mat(k,1330) = 0._r8 + mat(k,1331) = 0._r8 + mat(k,1332) = 0._r8 + mat(k,1335) = 0._r8 + mat(k,1336) = 0._r8 + mat(k,1337) = 0._r8 + mat(k,1339) = 0._r8 + mat(k,1342) = 0._r8 + mat(k,1343) = 0._r8 + mat(k,1347) = 0._r8 + mat(k,1349) = 0._r8 + mat(k,1356) = 0._r8 + mat(k,1359) = 0._r8 + mat(k,1361) = 0._r8 + mat(k,1364) = 0._r8 + mat(k,1365) = 0._r8 + mat(k,1370) = 0._r8 + mat(k,1376) = 0._r8 + mat(k,1380) = 0._r8 + mat(k,1382) = 0._r8 + mat(k,1383) = 0._r8 + mat(k,1385) = 0._r8 + mat(k,1386) = 0._r8 + mat(k,1388) = 0._r8 + mat(k,1390) = 0._r8 + mat(k,1393) = 0._r8 + mat(k,1398) = 0._r8 + mat(k,1399) = 0._r8 + mat(k,1400) = 0._r8 + mat(k,1403) = 0._r8 + mat(k,1406) = 0._r8 + mat(k,1413) = 0._r8 + mat(k,1434) = 0._r8 + mat(k,1435) = 0._r8 + mat(k,1438) = 0._r8 + mat(k,1442) = 0._r8 + mat(k,1445) = 0._r8 + mat(k,1449) = 0._r8 + mat(k,1450) = 0._r8 + mat(k,1455) = 0._r8 + mat(k,1457) = 0._r8 + mat(k,1463) = 0._r8 + mat(k,1465) = 0._r8 + mat(k,1466) = 0._r8 + mat(k,1467) = 0._r8 + mat(k,1471) = 0._r8 + mat(k,1478) = 0._r8 + mat(k,1486) = 0._r8 + mat(k,1492) = 0._r8 + mat(k,1493) = 0._r8 + mat(k,1495) = 0._r8 + mat(k,1496) = 0._r8 + mat(k,1498) = 0._r8 + mat(k,1499) = 0._r8 + mat(k,1501) = 0._r8 + mat(k,1502) = 0._r8 + mat(k,1504) = 0._r8 + mat(k,1505) = 0._r8 + mat(k,1508) = 0._r8 + mat(k,1509) = 0._r8 + mat(k,1511) = 0._r8 + mat(k,1512) = 0._r8 + mat(k,1514) = 0._r8 + mat(k,1516) = 0._r8 + mat(k,1517) = 0._r8 + mat(k,1518) = 0._r8 + mat(k,1519) = 0._r8 + mat(k,1525) = 0._r8 + mat(k,1529) = 0._r8 + mat(k,1533) = 0._r8 + mat(k,1535) = 0._r8 + mat(k,1537) = 0._r8 + mat(k,1538) = 0._r8 + mat(k,1539) = 0._r8 + mat(k,1543) = 0._r8 + mat(k,1556) = 0._r8 + mat(k,1559) = 0._r8 + mat(k,1560) = 0._r8 + mat(k,1564) = 0._r8 + mat(k,1565) = 0._r8 + mat(k,1566) = 0._r8 + mat(k,1567) = 0._r8 + mat(k,1571) = 0._r8 + mat(k,1572) = 0._r8 + mat(k,1574) = 0._r8 + mat(k,1575) = 0._r8 + mat(k,1578) = 0._r8 + mat(k,1582) = 0._r8 + mat(k,1583) = 0._r8 + mat(k,1585) = 0._r8 + mat(k,1589) = 0._r8 + mat(k,1591) = 0._r8 + mat(k,1597) = 0._r8 + mat(k,1603) = 0._r8 + mat(k,1604) = 0._r8 + mat(k,1609) = 0._r8 + mat(k,1613) = 0._r8 + mat(k,1620) = 0._r8 + mat(k,1645) = 0._r8 + mat(k,1648) = 0._r8 + mat(k,1656) = 0._r8 + mat(k,1735) = 0._r8 + mat(k,1753) = 0._r8 + mat(k,1766) = 0._r8 + mat(k,1770) = 0._r8 + mat(k,1781) = 0._r8 + mat(k,1782) = 0._r8 + mat(k,1804) = 0._r8 + mat(k,1822) = 0._r8 + mat(k,1841) = 0._r8 + mat(k,1842) = 0._r8 + mat(k,1843) = 0._r8 + mat(k,1846) = 0._r8 + mat(k,1850) = 0._r8 + mat(k,1851) = 0._r8 + mat(k,1852) = 0._r8 + mat(k,1854) = 0._r8 + mat(k,1857) = 0._r8 + mat(k,1914) = 0._r8 + mat(k,1943) = 0._r8 + mat(k,1944) = 0._r8 + mat(k,1945) = 0._r8 + mat(k,1949) = 0._r8 + mat(k,1954) = 0._r8 + mat(k,1960) = 0._r8 + mat(k,1971) = 0._r8 + mat(k,1995) = 0._r8 + mat(k,1996) = 0._r8 + mat(k,1997) = 0._r8 + mat(k,2000) = 0._r8 + mat(k,2001) = 0._r8 + mat(k,2002) = 0._r8 + mat(k,2003) = 0._r8 + mat(k,2006) = 0._r8 + mat(k,2007) = 0._r8 + mat(k,2009) = 0._r8 + mat(k,2012) = 0._r8 + mat(k,2018) = 0._r8 + mat(k,2021) = 0._r8 + mat(k,2022) = 0._r8 + mat(k,2026) = 0._r8 + mat(k,2027) = 0._r8 + mat(k,2028) = 0._r8 + mat(k,2030) = 0._r8 + mat(k,2032) = 0._r8 + mat(k,2033) = 0._r8 + mat(k,2042) = 0._r8 + mat(k,2047) = 0._r8 + mat(k,2049) = 0._r8 + mat(k,2058) = 0._r8 + mat(k,2060) = 0._r8 + mat(k,2063) = 0._r8 + mat(k,2064) = 0._r8 + mat(k,2069) = 0._r8 + mat(k,2076) = 0._r8 + mat(k,2077) = 0._r8 + mat(k,2079) = 0._r8 + mat(k,2083) = 0._r8 + mat(k,2085) = 0._r8 + mat(k,2087) = 0._r8 + mat(k,2088) = 0._r8 + mat(k,2090) = 0._r8 + mat(k,2091) = 0._r8 + mat(k,2093) = 0._r8 + mat(k,2094) = 0._r8 + mat(k,2104) = 0._r8 + mat(k,2108) = 0._r8 + mat(k,2109) = 0._r8 + mat(k,2110) = 0._r8 + mat(k,2111) = 0._r8 + mat(k,2113) = 0._r8 + mat(k,2117) = 0._r8 + mat(k,2120) = 0._r8 + mat(k,2121) = 0._r8 + mat(k,2122) = 0._r8 + mat(k,2124) = 0._r8 + mat(k,2125) = 0._r8 + mat(k,2133) = 0._r8 + mat(k,2146) = 0._r8 + mat(k,2151) = 0._r8 + mat(k,2154) = 0._r8 + mat(k,2159) = 0._r8 + mat(k,2160) = 0._r8 + mat(k,2163) = 0._r8 + mat(k,2164) = 0._r8 + mat(k,2165) = 0._r8 + mat(k,2167) = 0._r8 + mat(k,2171) = 0._r8 + mat(k,2172) = 0._r8 + mat(k,2173) = 0._r8 + mat(k,2175) = 0._r8 + mat(k,2179) = 0._r8 + mat(k,2189) = 0._r8 + mat(k,2195) = 0._r8 + mat(k,2222) = 0._r8 + mat(k,2239) = 0._r8 + mat(k,2241) = 0._r8 + mat(k,2268) = 0._r8 + mat(k,2271) = 0._r8 + mat(k,2274) = 0._r8 + mat(k,2276) = 0._r8 + mat(k,2278) = 0._r8 + mat(k,2280) = 0._r8 + mat(k,2286) = 0._r8 + mat(k,2291) = 0._r8 + mat(k,2296) = 0._r8 + mat(k,2297) = 0._r8 + mat(k,2302) = 0._r8 + mat(k,2323) = 0._r8 + mat(k,2324) = 0._r8 + mat(k,2328) = 0._r8 + mat(k,2334) = 0._r8 + mat(k,2336) = 0._r8 + mat(k,2339) = 0._r8 + mat(k,2343) = 0._r8 + mat(k,2345) = 0._r8 + mat(k,2347) = 0._r8 + mat(k,2348) = 0._r8 + mat(k,2349) = 0._r8 + mat(k,2351) = 0._r8 + mat(k,2352) = 0._r8 + mat(k,2356) = 0._r8 + mat(k,2357) = 0._r8 + mat(k,2358) = 0._r8 + mat(k,2359) = 0._r8 + mat(k,2360) = 0._r8 + mat(k,2361) = 0._r8 + mat(k,2362) = 0._r8 + mat(k,2363) = 0._r8 + mat(k,2364) = 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, 10) = mat(k, 10) - 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, 33) = mat(k, 33) - 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, 37) = mat(k, 37) - dti(k) + mat(k, 38) = mat(k, 38) - dti(k) + mat(k, 39) = mat(k, 39) - dti(k) + mat(k, 40) = mat(k, 40) - dti(k) + mat(k, 41) = mat(k, 41) - dti(k) + mat(k, 42) = mat(k, 42) - dti(k) + mat(k, 43) = mat(k, 43) - dti(k) + mat(k, 44) = mat(k, 44) - dti(k) + mat(k, 45) = mat(k, 45) - dti(k) + mat(k, 46) = mat(k, 46) - dti(k) + mat(k, 47) = mat(k, 47) - dti(k) + mat(k, 48) = mat(k, 48) - dti(k) + mat(k, 49) = mat(k, 49) - dti(k) + mat(k, 50) = mat(k, 50) - dti(k) + mat(k, 51) = mat(k, 51) - dti(k) + mat(k, 52) = mat(k, 52) - dti(k) + mat(k, 53) = mat(k, 53) - dti(k) + mat(k, 54) = mat(k, 54) - dti(k) + mat(k, 55) = mat(k, 55) - dti(k) + mat(k, 56) = mat(k, 56) - dti(k) + mat(k, 57) = mat(k, 57) - dti(k) + mat(k, 58) = mat(k, 58) - dti(k) + mat(k, 59) = mat(k, 59) - dti(k) + mat(k, 60) = mat(k, 60) - dti(k) + mat(k, 61) = mat(k, 61) - dti(k) + mat(k, 62) = mat(k, 62) - dti(k) + mat(k, 63) = mat(k, 63) - dti(k) + mat(k, 69) = mat(k, 69) - dti(k) + mat(k, 71) = mat(k, 71) - dti(k) + mat(k, 72) = mat(k, 72) - dti(k) + mat(k, 73) = mat(k, 73) - dti(k) + mat(k, 74) = mat(k, 74) - dti(k) + mat(k, 75) = mat(k, 75) - dti(k) + mat(k, 76) = mat(k, 76) - dti(k) + mat(k, 82) = mat(k, 82) - dti(k) + mat(k, 88) = mat(k, 88) - dti(k) + mat(k, 94) = mat(k, 94) - dti(k) + mat(k, 95) = mat(k, 95) - dti(k) + mat(k, 96) = mat(k, 96) - dti(k) + mat(k, 97) = mat(k, 97) - dti(k) + mat(k, 98) = mat(k, 98) - dti(k) + mat(k, 99) = mat(k, 99) - dti(k) + mat(k, 105) = mat(k, 105) - dti(k) + mat(k, 107) = mat(k, 107) - dti(k) + mat(k, 113) = mat(k, 113) - dti(k) + mat(k, 119) = mat(k, 119) - dti(k) + mat(k, 125) = mat(k, 125) - dti(k) + mat(k, 131) = mat(k, 131) - dti(k) + mat(k, 137) = mat(k, 137) - dti(k) + mat(k, 138) = mat(k, 138) - dti(k) + mat(k, 141) = mat(k, 141) - dti(k) + mat(k, 144) = mat(k, 144) - dti(k) + mat(k, 147) = mat(k, 147) - dti(k) + mat(k, 150) = mat(k, 150) - dti(k) + mat(k, 154) = mat(k, 154) - dti(k) + mat(k, 158) = mat(k, 158) - dti(k) + mat(k, 162) = mat(k, 162) - dti(k) + mat(k, 166) = mat(k, 166) - dti(k) + mat(k, 170) = mat(k, 170) - dti(k) + mat(k, 174) = mat(k, 174) - dti(k) + mat(k, 177) = mat(k, 177) - dti(k) + mat(k, 180) = mat(k, 180) - dti(k) + mat(k, 185) = mat(k, 185) - dti(k) + mat(k, 190) = mat(k, 190) - dti(k) + mat(k, 195) = mat(k, 195) - dti(k) + mat(k, 200) = mat(k, 200) - dti(k) + mat(k, 203) = mat(k, 203) - dti(k) + mat(k, 207) = mat(k, 207) - dti(k) + mat(k, 213) = mat(k, 213) - dti(k) + mat(k, 217) = mat(k, 217) - dti(k) + mat(k, 222) = mat(k, 222) - dti(k) + mat(k, 224) = mat(k, 224) - dti(k) + mat(k, 227) = mat(k, 227) - dti(k) + mat(k, 232) = mat(k, 232) - dti(k) + mat(k, 239) = mat(k, 239) - dti(k) + mat(k, 244) = mat(k, 244) - dti(k) + mat(k, 248) = mat(k, 248) - dti(k) + mat(k, 253) = mat(k, 253) - dti(k) + mat(k, 261) = mat(k, 261) - dti(k) + mat(k, 266) = mat(k, 266) - dti(k) + mat(k, 269) = mat(k, 269) - dti(k) + mat(k, 272) = mat(k, 272) - dti(k) + mat(k, 275) = mat(k, 275) - dti(k) + mat(k, 278) = mat(k, 278) - dti(k) + mat(k, 283) = mat(k, 283) - dti(k) + mat(k, 286) = mat(k, 286) - dti(k) + mat(k, 291) = mat(k, 291) - dti(k) + mat(k, 296) = mat(k, 296) - dti(k) + mat(k, 302) = mat(k, 302) - dti(k) + mat(k, 306) = mat(k, 306) - dti(k) + mat(k, 310) = mat(k, 310) - dti(k) + mat(k, 314) = mat(k, 314) - dti(k) + mat(k, 318) = mat(k, 318) - dti(k) + mat(k, 321) = mat(k, 321) - dti(k) + mat(k, 327) = mat(k, 327) - dti(k) + mat(k, 334) = mat(k, 334) - dti(k) + mat(k, 340) = mat(k, 340) - dti(k) + mat(k, 343) = mat(k, 343) - dti(k) + mat(k, 349) = mat(k, 349) - dti(k) + mat(k, 355) = mat(k, 355) - dti(k) + mat(k, 360) = mat(k, 360) - dti(k) + mat(k, 365) = mat(k, 365) - dti(k) + mat(k, 371) = mat(k, 371) - dti(k) + mat(k, 376) = mat(k, 376) - dti(k) + mat(k, 381) = mat(k, 381) - dti(k) + mat(k, 384) = mat(k, 384) - dti(k) + mat(k, 389) = mat(k, 389) - dti(k) + mat(k, 394) = mat(k, 394) - dti(k) + mat(k, 402) = mat(k, 402) - dti(k) + mat(k, 410) = mat(k, 410) - dti(k) + mat(k, 418) = mat(k, 418) - dti(k) + mat(k, 424) = mat(k, 424) - dti(k) + mat(k, 430) = mat(k, 430) - dti(k) + mat(k, 436) = mat(k, 436) - dti(k) + mat(k, 442) = mat(k, 442) - dti(k) + mat(k, 448) = mat(k, 448) - dti(k) + mat(k, 454) = mat(k, 454) - dti(k) + mat(k, 460) = mat(k, 460) - dti(k) + mat(k, 466) = mat(k, 466) - dti(k) + mat(k, 472) = mat(k, 472) - dti(k) + mat(k, 478) = mat(k, 478) - dti(k) + mat(k, 486) = mat(k, 486) - dti(k) + mat(k, 492) = mat(k, 492) - dti(k) + mat(k, 499) = mat(k, 499) - dti(k) + mat(k, 505) = mat(k, 505) - dti(k) + mat(k, 508) = mat(k, 508) - dti(k) + mat(k, 515) = mat(k, 515) - dti(k) + mat(k, 522) = mat(k, 522) - dti(k) + mat(k, 527) = mat(k, 527) - dti(k) + mat(k, 536) = mat(k, 536) - dti(k) + mat(k, 544) = mat(k, 544) - dti(k) + mat(k, 551) = mat(k, 551) - dti(k) + mat(k, 556) = mat(k, 556) - dti(k) + mat(k, 563) = mat(k, 563) - dti(k) + mat(k, 569) = mat(k, 569) - dti(k) + mat(k, 577) = mat(k, 577) - dti(k) + mat(k, 585) = mat(k, 585) - dti(k) + mat(k, 593) = mat(k, 593) - dti(k) + mat(k, 601) = mat(k, 601) - dti(k) + mat(k, 609) = mat(k, 609) - dti(k) + mat(k, 617) = mat(k, 617) - dti(k) + mat(k, 626) = mat(k, 626) - dti(k) + mat(k, 635) = mat(k, 635) - dti(k) + mat(k, 642) = mat(k, 642) - dti(k) + mat(k, 646) = mat(k, 646) - dti(k) + mat(k, 653) = mat(k, 653) - dti(k) + mat(k, 662) = mat(k, 662) - dti(k) + mat(k, 670) = mat(k, 670) - dti(k) + mat(k, 677) = mat(k, 677) - dti(k) + mat(k, 688) = mat(k, 688) - dti(k) + mat(k, 699) = mat(k, 699) - dti(k) + mat(k, 706) = mat(k, 706) - dti(k) + mat(k, 719) = mat(k, 719) - dti(k) + mat(k, 729) = mat(k, 729) - dti(k) + mat(k, 738) = mat(k, 738) - dti(k) + mat(k, 751) = mat(k, 751) - dti(k) + mat(k, 758) = mat(k, 758) - dti(k) + mat(k, 769) = mat(k, 769) - dti(k) + mat(k, 780) = mat(k, 780) - dti(k) + mat(k, 793) = mat(k, 793) - dti(k) + mat(k, 804) = mat(k, 804) - dti(k) + mat(k, 813) = mat(k, 813) - dti(k) + mat(k, 823) = mat(k, 823) - dti(k) + mat(k, 831) = mat(k, 831) - dti(k) + mat(k, 836) = mat(k, 836) - dti(k) + mat(k, 846) = mat(k, 846) - dti(k) + mat(k, 855) = mat(k, 855) - dti(k) + mat(k, 865) = mat(k, 865) - dti(k) + mat(k, 873) = mat(k, 873) - dti(k) + mat(k, 879) = mat(k, 879) - dti(k) + mat(k, 895) = mat(k, 895) - dti(k) + mat(k, 902) = mat(k, 902) - dti(k) + mat(k, 909) = mat(k, 909) - dti(k) + mat(k, 918) = mat(k, 918) - dti(k) + mat(k, 936) = mat(k, 936) - dti(k) + mat(k, 960) = mat(k, 960) - dti(k) + mat(k, 972) = mat(k, 972) - dti(k) + mat(k, 982) = mat(k, 982) - dti(k) + mat(k, 989) = mat(k, 989) - dti(k) + mat(k, 997) = mat(k, 997) - dti(k) + mat(k,1015) = mat(k,1015) - dti(k) + mat(k,1035) = mat(k,1035) - dti(k) + mat(k,1048) = mat(k,1048) - dti(k) + mat(k,1069) = mat(k,1069) - dti(k) + mat(k,1081) = mat(k,1081) - dti(k) + mat(k,1092) = mat(k,1092) - dti(k) + mat(k,1102) = mat(k,1102) - dti(k) + mat(k,1116) = mat(k,1116) - dti(k) + mat(k,1127) = mat(k,1127) - dti(k) + mat(k,1136) = mat(k,1136) - dti(k) + mat(k,1149) = mat(k,1149) - dti(k) + mat(k,1163) = mat(k,1163) - dti(k) + mat(k,1184) = mat(k,1184) - dti(k) + mat(k,1200) = mat(k,1200) - dti(k) + mat(k,1217) = mat(k,1217) - dti(k) + mat(k,1237) = mat(k,1237) - dti(k) + mat(k,1253) = mat(k,1253) - dti(k) + mat(k,1265) = mat(k,1265) - dti(k) + mat(k,1276) = mat(k,1276) - dti(k) + mat(k,1301) = mat(k,1301) - dti(k) + mat(k,1334) = mat(k,1334) - dti(k) + mat(k,1358) = mat(k,1358) - dti(k) + mat(k,1379) = mat(k,1379) - dti(k) + mat(k,1401) = mat(k,1401) - dti(k) + mat(k,1433) = mat(k,1433) - dti(k) + mat(k,1448) = mat(k,1448) - dti(k) + mat(k,1462) = mat(k,1462) - dti(k) + mat(k,1477) = mat(k,1477) - dti(k) + mat(k,1494) = mat(k,1494) - dti(k) + mat(k,1510) = mat(k,1510) - dti(k) + mat(k,1532) = mat(k,1532) - dti(k) + mat(k,1576) = mat(k,1576) - dti(k) + mat(k,1608) = mat(k,1608) - dti(k) + mat(k,1650) = mat(k,1650) - dti(k) + mat(k,1823) = mat(k,1823) - dti(k) + mat(k,1848) = mat(k,1848) - dti(k) + mat(k,1952) = mat(k,1952) - dti(k) + mat(k,2005) = mat(k,2005) - dti(k) + mat(k,2029) = mat(k,2029) - dti(k) + mat(k,2089) = mat(k,2089) - dti(k) + mat(k,2129) = mat(k,2129) - dti(k) + mat(k,2192) = mat(k,2192) - dti(k) + mat(k,2311) = mat(k,2311) - dti(k) + mat(k,2338) = mat(k,2338) - dti(k) + mat(k,2365) = mat(k,2365) - 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 nlnmat08( avec_len, mat, y, rxt ) + call nlnmat09( avec_len, mat, y, rxt ) + call nlnmat10( 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_vbsext/mo_phtadj.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_phtadj.F90 new file mode 100644 index 0000000000..6698bf2f2b --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/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_vbsext/mo_prod_loss.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_prod_loss.F90 new file mode 100644 index 0000000000..9a1684af5c --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_prod_loss.F90 @@ -0,0 +1,1330 @@ + 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,227))* y(k,227) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,228))* y(k,228) + 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,186) = (rxt(k,375)* y(k,253) + rxt(k,19) + het_rates(k,1))* y(k,1) + prod(k,186) =rxt(k,378)*y(k,230)*y(k,129) + loss(k,185) = (rxt(k,379)* y(k,253) + rxt(k,20) + het_rates(k,2))* y(k,2) + prod(k,185) =rxt(k,376)*y(k,242)*y(k,230) + loss(k,1) = ( + het_rates(k,3))* y(k,3) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,4))* y(k,4) + prod(k,2) = 0._r8 + loss(k,3) = ( + het_rates(k,5))* y(k,5) + prod(k,3) = 0._r8 + loss(k,217) = (rxt(k,458)* y(k,131) +rxt(k,459)* y(k,140) +rxt(k,460) & + * y(k,253) + het_rates(k,6))* y(k,6) + prod(k,217) = 0._r8 + loss(k,71) = (rxt(k,514)* y(k,129) +rxt(k,513)* y(k,242) + het_rates(k,7)) & + * y(k,7) + prod(k,71) =rxt(k,516)*y(k,253)*y(k,6) + loss(k,104) = (rxt(k,417)* y(k,253) + het_rates(k,8))* y(k,8) + prod(k,104) = 0._r8 + loss(k,81) = (rxt(k,519)* y(k,129) +rxt(k,518)* y(k,242) + het_rates(k,9)) & + * y(k,9) + prod(k,81) =rxt(k,517)*y(k,253)*y(k,8) + loss(k,156) = (rxt(k,420)* y(k,253) + rxt(k,21) + het_rates(k,10))* y(k,10) + prod(k,156) =rxt(k,418)*y(k,242)*y(k,231) + loss(k,105) = ( + rxt(k,22) + het_rates(k,11))* y(k,11) + prod(k,105) =.120_r8*rxt(k,417)*y(k,253)*y(k,8) + loss(k,149) = ( + rxt(k,23) + het_rates(k,12))* y(k,12) + prod(k,149) = (.100_r8*rxt(k,459)*y(k,6) +.100_r8*rxt(k,462)*y(k,116)) & + *y(k,140) + loss(k,161) = ( + rxt(k,24) + het_rates(k,13))* y(k,13) + prod(k,161) = (.500_r8*rxt(k,419)*y(k,231) +.200_r8*rxt(k,446)*y(k,259) + & + .060_r8*rxt(k,452)*y(k,261))*y(k,129) +.500_r8*rxt(k,21)*y(k,10) & + +rxt(k,22)*y(k,11) +.200_r8*rxt(k,70)*y(k,218) +.060_r8*rxt(k,72) & + *y(k,223) + loss(k,129) = ( + rxt(k,25) + het_rates(k,14))* y(k,14) + prod(k,129) = (.200_r8*rxt(k,446)*y(k,259) +.200_r8*rxt(k,452)*y(k,261)) & + *y(k,129) +.200_r8*rxt(k,70)*y(k,218) +.200_r8*rxt(k,72)*y(k,223) + loss(k,180) = ( + rxt(k,26) + het_rates(k,15))* y(k,15) + prod(k,180) = (.200_r8*rxt(k,446)*y(k,259) +.150_r8*rxt(k,452)*y(k,261)) & + *y(k,129) +rxt(k,46)*y(k,96) +rxt(k,56)*y(k,123) +.200_r8*rxt(k,70) & + *y(k,218) +.150_r8*rxt(k,72)*y(k,223) + loss(k,136) = ( + rxt(k,27) + het_rates(k,16))* y(k,16) + prod(k,136) =.210_r8*rxt(k,452)*y(k,261)*y(k,129) +.210_r8*rxt(k,72)*y(k,223) + loss(k,116) = (rxt(k,380)* y(k,253) + het_rates(k,17))* y(k,17) + prod(k,116) = (.050_r8*rxt(k,459)*y(k,6) +.050_r8*rxt(k,462)*y(k,116)) & + *y(k,140) + loss(k,144) = (rxt(k,346)* y(k,131) +rxt(k,347)* y(k,253) + het_rates(k,18)) & + * y(k,18) + prod(k,144) = 0._r8 + loss(k,243) = (rxt(k,230)* y(k,44) +rxt(k,232)* y(k,140) +rxt(k,231) & + * y(k,242) + het_rates(k,19))* y(k,19) + prod(k,243) = (rxt(k,75) +2.000_r8*rxt(k,233)*y(k,21) +rxt(k,234)*y(k,61) + & + rxt(k,235)*y(k,61) +rxt(k,238)*y(k,129) +rxt(k,241)*y(k,139) + & + rxt(k,242)*y(k,253) +rxt(k,488)*y(k,158))*y(k,21) & + + (rxt(k,220)*y(k,36) +rxt(k,246)*y(k,37) + & + 3.000_r8*rxt(k,247)*y(k,57) +2.000_r8*rxt(k,248)*y(k,80) + & + rxt(k,249)*y(k,83) +2.000_r8*rxt(k,269)*y(k,43) +rxt(k,270)*y(k,45)) & + *y(k,252) + (rxt(k,244)*y(k,83) +2.000_r8*rxt(k,258)*y(k,43) + & + rxt(k,260)*y(k,45) +3.000_r8*rxt(k,265)*y(k,57))*y(k,253) & + + (2.000_r8*rxt(k,257)*y(k,43) +rxt(k,259)*y(k,45) + & + 3.000_r8*rxt(k,264)*y(k,57))*y(k,58) + (rxt(k,99) + & + rxt(k,243)*y(k,139))*y(k,83) +rxt(k,74)*y(k,20) +rxt(k,77)*y(k,22) & + +rxt(k,79)*y(k,36) +rxt(k,80)*y(k,37) +2.000_r8*rxt(k,86)*y(k,43) & + +rxt(k,87)*y(k,45) +3.000_r8*rxt(k,90)*y(k,57) +2.000_r8*rxt(k,98) & + *y(k,80) +rxt(k,105)*y(k,93) + loss(k,118) = ( + rxt(k,74) + het_rates(k,20))* y(k,20) + prod(k,118) = (rxt(k,553)*y(k,93) +rxt(k,558)*y(k,93))*y(k,87) & + +rxt(k,236)*y(k,61)*y(k,21) + loss(k,252) = (2._r8*rxt(k,233)* y(k,21) + (rxt(k,234) +rxt(k,235) + & + rxt(k,236))* y(k,61) +rxt(k,238)* y(k,129) +rxt(k,239)* y(k,130) & + +rxt(k,241)* y(k,139) +rxt(k,488)* y(k,158) +rxt(k,237)* y(k,242) & + +rxt(k,242)* y(k,253) + rxt(k,75) + het_rates(k,21))* y(k,21) + prod(k,252) = (rxt(k,76) +rxt(k,240)*y(k,139))*y(k,22) +rxt(k,232)*y(k,140) & + *y(k,19) +rxt(k,250)*y(k,252)*y(k,83) +rxt(k,245)*y(k,139)*y(k,93) + loss(k,172) = (rxt(k,240)* y(k,139) + rxt(k,76) + rxt(k,77) + rxt(k,547) & + + rxt(k,550) + rxt(k,555) + het_rates(k,22))* y(k,22) + prod(k,172) =rxt(k,239)*y(k,130)*y(k,21) + loss(k,4) = ( + het_rates(k,23))* y(k,23) + prod(k,4) = 0._r8 + loss(k,119) = (rxt(k,421)* y(k,253) + het_rates(k,24))* y(k,24) + prod(k,119) =rxt(k,28)*y(k,25) +rxt(k,424)*y(k,232)*y(k,129) + loss(k,139) = (rxt(k,423)* y(k,253) + rxt(k,28) + het_rates(k,25))* y(k,25) + prod(k,139) =rxt(k,422)*y(k,242)*y(k,232) + loss(k,130) = (rxt(k,295)* y(k,58) +rxt(k,296)* y(k,253) + het_rates(k,26)) & + * y(k,26) + prod(k,130) = 0._r8 + loss(k,175) = (rxt(k,297)* y(k,58) +rxt(k,298)* y(k,140) +rxt(k,323) & + * y(k,253) + het_rates(k,27))* y(k,27) + prod(k,175) = 0._r8 + loss(k,126) = (rxt(k,303)* y(k,253) + het_rates(k,28))* y(k,28) + prod(k,126) = (.400_r8*rxt(k,299)*y(k,233) +.200_r8*rxt(k,300)*y(k,237)) & + *y(k,233) + loss(k,140) = (rxt(k,304)* y(k,253) + rxt(k,29) + het_rates(k,29))* y(k,29) + prod(k,140) =rxt(k,301)*y(k,242)*y(k,233) + loss(k,131) = (rxt(k,305)* y(k,58) +rxt(k,306)* y(k,253) + het_rates(k,30)) & + * y(k,30) + prod(k,131) = 0._r8 + loss(k,219) = (rxt(k,326)* y(k,131) +rxt(k,327)* y(k,140) +rxt(k,344) & + * y(k,253) + het_rates(k,31))* y(k,31) + prod(k,219) =.130_r8*rxt(k,404)*y(k,140)*y(k,100) +.700_r8*rxt(k,55)*y(k,118) + loss(k,150) = (rxt(k,331)* y(k,253) + rxt(k,30) + het_rates(k,32))* y(k,32) + prod(k,150) =rxt(k,329)*y(k,242)*y(k,234) + loss(k,91) = (rxt(k,332)* y(k,253) + het_rates(k,33))* y(k,33) + prod(k,91) = 0._r8 + loss(k,127) = (rxt(k,427)* y(k,253) + rxt(k,31) + het_rates(k,34))* y(k,34) + prod(k,127) =rxt(k,425)*y(k,242)*y(k,235) + loss(k,87) = (rxt(k,219)* y(k,252) + rxt(k,78) + het_rates(k,35))* y(k,35) + prod(k,87) = 0._r8 + loss(k,98) = (rxt(k,220)* y(k,252) + rxt(k,79) + het_rates(k,36))* y(k,36) + prod(k,98) = 0._r8 + loss(k,99) = (rxt(k,246)* y(k,252) + rxt(k,80) + het_rates(k,37))* y(k,37) + prod(k,99) = 0._r8 + loss(k,92) = (rxt(k,221)* y(k,252) + rxt(k,81) + het_rates(k,38))* y(k,38) + prod(k,92) = 0._r8 + loss(k,100) = (rxt(k,222)* y(k,252) + rxt(k,82) + het_rates(k,39))* y(k,39) + prod(k,100) = 0._r8 + loss(k,93) = (rxt(k,223)* y(k,252) + rxt(k,83) + het_rates(k,40))* y(k,40) + prod(k,93) = 0._r8 + loss(k,101) = (rxt(k,224)* y(k,252) + rxt(k,84) + het_rates(k,41))* y(k,41) + prod(k,101) = 0._r8 + loss(k,94) = (rxt(k,225)* y(k,252) + rxt(k,85) + het_rates(k,42))* y(k,42) + prod(k,94) = 0._r8 + loss(k,162) = (rxt(k,257)* y(k,58) +rxt(k,269)* y(k,252) +rxt(k,258) & + * y(k,253) + rxt(k,86) + het_rates(k,43))* y(k,43) + prod(k,162) = 0._r8 + loss(k,247) = (rxt(k,230)* y(k,19) +rxt(k,194)* y(k,58) +rxt(k,275)* y(k,131) & + +rxt(k,276)* y(k,139) +rxt(k,274)* y(k,242) +rxt(k,277)* y(k,253) & + + rxt(k,32) + rxt(k,33) + het_rates(k,44))* y(k,44) + prod(k,247) = (rxt(k,201)*y(k,61) +2.000_r8*rxt(k,278)*y(k,237) + & + rxt(k,279)*y(k,237) +rxt(k,281)*y(k,129) + & + .700_r8*rxt(k,300)*y(k,233) +rxt(k,311)*y(k,236) + & + rxt(k,328)*y(k,234) +.800_r8*rxt(k,340)*y(k,256) + & + .880_r8*rxt(k,352)*y(k,246) +2.000_r8*rxt(k,361)*y(k,248) + & + 1.500_r8*rxt(k,385)*y(k,244) +.750_r8*rxt(k,390)*y(k,245) + & + .800_r8*rxt(k,399)*y(k,103) +.800_r8*rxt(k,410)*y(k,260) + & + .750_r8*rxt(k,464)*y(k,251) +.930_r8*rxt(k,469)*y(k,257) + & + .950_r8*rxt(k,474)*y(k,258))*y(k,237) & + + (.500_r8*rxt(k,317)*y(k,241) +rxt(k,338)*y(k,255) + & + rxt(k,342)*y(k,256) +.500_r8*rxt(k,348)*y(k,239) + & + .250_r8*rxt(k,355)*y(k,246) +rxt(k,364)*y(k,248) + & + .100_r8*rxt(k,377)*y(k,230) +.920_r8*rxt(k,387)*y(k,244) + & + .250_r8*rxt(k,412)*y(k,260) +.340_r8*rxt(k,471)*y(k,257) + & + .320_r8*rxt(k,476)*y(k,258))*y(k,129) + (rxt(k,282)*y(k,54) + & + .300_r8*rxt(k,283)*y(k,55) +.500_r8*rxt(k,315)*y(k,53) + & + .800_r8*rxt(k,320)*y(k,76) +rxt(k,322)*y(k,145) + & + .500_r8*rxt(k,370)*y(k,115) +.400_r8*rxt(k,375)*y(k,1) + & + .300_r8*rxt(k,395)*y(k,101) +.680_r8*rxt(k,480)*y(k,217))*y(k,253) & + + (rxt(k,298)*y(k,27) +.500_r8*rxt(k,327)*y(k,31) + & + .120_r8*rxt(k,357)*y(k,111) +.600_r8*rxt(k,371)*y(k,118) + & + .910_r8*rxt(k,404)*y(k,100) +.340_r8*rxt(k,459)*y(k,6) + & + .340_r8*rxt(k,462)*y(k,116))*y(k,140) + (.500_r8*rxt(k,346)*y(k,18) + & + .250_r8*rxt(k,354)*y(k,246) +rxt(k,365)*y(k,248) + & + rxt(k,388)*y(k,244))*y(k,131) + (.250_r8*rxt(k,351)*y(k,246) + & + rxt(k,360)*y(k,248) +rxt(k,384)*y(k,244) + & + .250_r8*rxt(k,409)*y(k,260))*y(k,236) + (.180_r8*rxt(k,39) + & + rxt(k,291)*y(k,252) +rxt(k,292)*y(k,252))*y(k,56) & + + (.150_r8*rxt(k,341)*y(k,256) +.450_r8*rxt(k,362)*y(k,248)) & + *y(k,242) +.100_r8*rxt(k,19)*y(k,1) +.100_r8*rxt(k,20)*y(k,2) & + +rxt(k,38)*y(k,55) +rxt(k,43)*y(k,76) +.330_r8*rxt(k,45)*y(k,95) & + +rxt(k,47)*y(k,97) +rxt(k,49)*y(k,106) +1.340_r8*rxt(k,51)*y(k,111) & + +rxt(k,57)*y(k,132) +rxt(k,62)*y(k,154) +rxt(k,63)*y(k,155) & + +.375_r8*rxt(k,65)*y(k,213) +.400_r8*rxt(k,67)*y(k,215) & + +.680_r8*rxt(k,69)*y(k,217) +2.000_r8*rxt(k,318)*y(k,240) & + +rxt(k,288)*y(k,243) +2.000_r8*rxt(k,363)*y(k,248)*y(k,248) + loss(k,178) = (rxt(k,259)* y(k,58) +rxt(k,270)* y(k,252) +rxt(k,260) & + * y(k,253) + rxt(k,87) + het_rates(k,45))* y(k,45) + prod(k,178) = 0._r8 + loss(k,95) = (rxt(k,261)* y(k,253) + rxt(k,88) + het_rates(k,46))* y(k,46) + prod(k,95) = 0._r8 + loss(k,221) = (rxt(k,307)* y(k,131) +rxt(k,308)* y(k,253) + rxt(k,34) & + + het_rates(k,47))* y(k,47) + prod(k,221) = (rxt(k,302)*y(k,233) +.270_r8*rxt(k,330)*y(k,234) + & + rxt(k,338)*y(k,255) +rxt(k,348)*y(k,239) +rxt(k,367)*y(k,250) + & + .400_r8*rxt(k,377)*y(k,230))*y(k,129) + (rxt(k,303)*y(k,28) + & + .500_r8*rxt(k,304)*y(k,29) +.800_r8*rxt(k,375)*y(k,1))*y(k,253) & + + (.500_r8*rxt(k,327)*y(k,31) +.100_r8*rxt(k,371)*y(k,118))*y(k,140) & + + (1.600_r8*rxt(k,299)*y(k,233) +.800_r8*rxt(k,300)*y(k,237)) & + *y(k,233) +.400_r8*rxt(k,19)*y(k,1) +.400_r8*rxt(k,20)*y(k,2) & + +rxt(k,346)*y(k,131)*y(k,18) +rxt(k,29)*y(k,29) +.330_r8*rxt(k,45) & + *y(k,95) +rxt(k,53)*y(k,114) +rxt(k,62)*y(k,154) & + +.200_r8*rxt(k,366)*y(k,250)*y(k,242) + loss(k,145) = (rxt(k,262)* y(k,58) +rxt(k,263)* y(k,253) + rxt(k,89) & + + het_rates(k,48))* y(k,48) + prod(k,145) = 0._r8 + loss(k,88) = (rxt(k,309)* y(k,253) + het_rates(k,49))* y(k,49) + prod(k,88) = 0._r8 + loss(k,214) = (rxt(k,345)* y(k,253) + rxt(k,35) + het_rates(k,50))* y(k,50) + prod(k,214) = (.820_r8*rxt(k,330)*y(k,234) +.500_r8*rxt(k,348)*y(k,239) + & + .250_r8*rxt(k,377)*y(k,230) +.270_r8*rxt(k,471)*y(k,257) + & + .040_r8*rxt(k,476)*y(k,258))*y(k,129) & + + (.820_r8*rxt(k,328)*y(k,234) +.150_r8*rxt(k,469)*y(k,257) + & + .025_r8*rxt(k,474)*y(k,258))*y(k,237) + (.250_r8*rxt(k,19) + & + .800_r8*rxt(k,375)*y(k,253))*y(k,1) + (.520_r8*rxt(k,459)*y(k,6) + & + .520_r8*rxt(k,462)*y(k,116))*y(k,140) + (.500_r8*rxt(k,69) + & + .500_r8*rxt(k,480)*y(k,253))*y(k,217) +.250_r8*rxt(k,20)*y(k,2) & + +.500_r8*rxt(k,346)*y(k,131)*y(k,18) +.820_r8*rxt(k,30)*y(k,32) & + +.170_r8*rxt(k,45)*y(k,95) +.300_r8*rxt(k,65)*y(k,213) & + +.050_r8*rxt(k,67)*y(k,215) + loss(k,234) = (rxt(k,333)* y(k,131) +rxt(k,334)* y(k,253) + rxt(k,36) & + + het_rates(k,51))* y(k,51) + prod(k,234) = (.250_r8*rxt(k,355)*y(k,246) +.050_r8*rxt(k,393)*y(k,245) + & + .250_r8*rxt(k,412)*y(k,260) +.170_r8*rxt(k,430)*y(k,238) + & + .170_r8*rxt(k,436)*y(k,249) +.400_r8*rxt(k,446)*y(k,259) + & + .540_r8*rxt(k,452)*y(k,261) +.510_r8*rxt(k,455)*y(k,262))*y(k,129) & + + (.250_r8*rxt(k,354)*y(k,246) +.050_r8*rxt(k,394)*y(k,245) + & + .250_r8*rxt(k,413)*y(k,260))*y(k,131) & + + (.500_r8*rxt(k,340)*y(k,256) +.240_r8*rxt(k,352)*y(k,246) + & + .100_r8*rxt(k,410)*y(k,260))*y(k,237) & + + (.880_r8*rxt(k,357)*y(k,111) +.500_r8*rxt(k,371)*y(k,118)) & + *y(k,140) + (.250_r8*rxt(k,351)*y(k,246) + & + .250_r8*rxt(k,409)*y(k,260))*y(k,236) & + + (.070_r8*rxt(k,429)*y(k,238) +.070_r8*rxt(k,435)*y(k,249)) & + *y(k,242) + (rxt(k,335)*y(k,97) +rxt(k,336)*y(k,132))*y(k,253) & + +.180_r8*rxt(k,23)*y(k,12) +rxt(k,27)*y(k,16) +.400_r8*rxt(k,70) & + *y(k,218) +.540_r8*rxt(k,72)*y(k,223) +.510_r8*rxt(k,73)*y(k,226) + loss(k,190) = (rxt(k,314)* y(k,253) + het_rates(k,52))* y(k,52) + prod(k,190) = (.100_r8*rxt(k,311)*y(k,237) +.150_r8*rxt(k,312)*y(k,242)) & + *y(k,236) +.120_r8*rxt(k,327)*y(k,140)*y(k,31) & + +.150_r8*rxt(k,362)*y(k,248)*y(k,242) + loss(k,179) = (rxt(k,315)* y(k,253) + rxt(k,37) + het_rates(k,53))* y(k,53) + prod(k,179) = (.400_r8*rxt(k,312)*y(k,236) +.400_r8*rxt(k,362)*y(k,248)) & + *y(k,242) + loss(k,200) = (rxt(k,282)* y(k,253) + het_rates(k,54))* y(k,54) + prod(k,200) = (rxt(k,279)*y(k,237) +.300_r8*rxt(k,300)*y(k,233) + & + .500_r8*rxt(k,340)*y(k,256) +.250_r8*rxt(k,352)*y(k,246) + & + .250_r8*rxt(k,385)*y(k,244) +.250_r8*rxt(k,390)*y(k,245) + & + .200_r8*rxt(k,399)*y(k,103) +.300_r8*rxt(k,410)*y(k,260) + & + .250_r8*rxt(k,464)*y(k,251) +.250_r8*rxt(k,469)*y(k,257) + & + .250_r8*rxt(k,474)*y(k,258))*y(k,237) + loss(k,153) = (rxt(k,283)* y(k,253) + rxt(k,38) + het_rates(k,55))* y(k,55) + prod(k,153) =rxt(k,280)*y(k,242)*y(k,237) + loss(k,244) = (rxt(k,195)* y(k,58) +rxt(k,251)* y(k,75) + (rxt(k,290) + & + rxt(k,291) +rxt(k,292))* y(k,252) +rxt(k,284)* y(k,253) + rxt(k,39) & + + rxt(k,40) + het_rates(k,56))* y(k,56) + prod(k,244) =.100_r8*rxt(k,327)*y(k,140)*y(k,31) + loss(k,154) = (rxt(k,264)* y(k,58) +rxt(k,247)* y(k,252) +rxt(k,265) & + * y(k,253) + rxt(k,90) + het_rates(k,57))* y(k,57) + prod(k,154) = 0._r8 + loss(k,257) = (rxt(k,305)* y(k,30) +rxt(k,257)* y(k,43) +rxt(k,194)* y(k,44) & + +rxt(k,259)* y(k,45) +rxt(k,262)* y(k,48) +rxt(k,195)* y(k,56) & + +rxt(k,264)* y(k,57) +rxt(k,207)* y(k,62) +rxt(k,196)* y(k,79) & + +rxt(k,197)* y(k,81) +rxt(k,216)* y(k,94) +rxt(k,200)* y(k,140) & + + (rxt(k,198) +rxt(k,199))* y(k,242) + het_rates(k,58))* y(k,58) + prod(k,257) = (4.000_r8*rxt(k,219)*y(k,35) +rxt(k,220)*y(k,36) + & + 2.000_r8*rxt(k,221)*y(k,38) +2.000_r8*rxt(k,222)*y(k,39) + & + 2.000_r8*rxt(k,223)*y(k,40) +rxt(k,224)*y(k,41) + & + 2.000_r8*rxt(k,225)*y(k,42) +rxt(k,226)*y(k,87) +rxt(k,256)*y(k,67) + & + rxt(k,271)*y(k,84) +rxt(k,272)*y(k,85) +rxt(k,273)*y(k,86))*y(k,252) & + + (rxt(k,93) +rxt(k,201)*y(k,237) +2.000_r8*rxt(k,202)*y(k,61) + & + rxt(k,204)*y(k,61) +rxt(k,206)*y(k,129) +rxt(k,211)*y(k,139) + & + rxt(k,212)*y(k,253) +rxt(k,235)*y(k,21) +rxt(k,489)*y(k,158))*y(k,61) & + + (rxt(k,215)*y(k,87) +3.000_r8*rxt(k,261)*y(k,46) + & + rxt(k,263)*y(k,48) +rxt(k,266)*y(k,84) +rxt(k,267)*y(k,85) + & + rxt(k,268)*y(k,86))*y(k,253) + (rxt(k,103) +rxt(k,214)*y(k,139)) & + *y(k,87) +rxt(k,74)*y(k,20) +4.000_r8*rxt(k,78)*y(k,35) +rxt(k,79) & + *y(k,36) +2.000_r8*rxt(k,81)*y(k,38) +2.000_r8*rxt(k,82)*y(k,39) & + +2.000_r8*rxt(k,83)*y(k,40) +rxt(k,84)*y(k,41) +2.000_r8*rxt(k,85) & + *y(k,42) +3.000_r8*rxt(k,88)*y(k,46) +rxt(k,89)*y(k,48) & + +2.000_r8*rxt(k,91)*y(k,59) +2.000_r8*rxt(k,92)*y(k,60) +rxt(k,95) & + *y(k,62) +rxt(k,97)*y(k,67) +rxt(k,100)*y(k,84) +rxt(k,101)*y(k,85) & + +rxt(k,102)*y(k,86) +rxt(k,106)*y(k,94) + loss(k,107) = ( + rxt(k,91) + het_rates(k,59))* y(k,59) + prod(k,107) = (rxt(k,546)*y(k,94) +rxt(k,551)*y(k,62) +rxt(k,552)*y(k,94) + & + rxt(k,556)*y(k,62) +rxt(k,557)*y(k,94) +rxt(k,561)*y(k,62))*y(k,87) & + +rxt(k,207)*y(k,62)*y(k,58) +rxt(k,203)*y(k,61)*y(k,61) + loss(k,89) = ( + rxt(k,92) + rxt(k,229) + het_rates(k,60))* y(k,60) + prod(k,89) =rxt(k,228)*y(k,61)*y(k,61) + loss(k,260) = ((rxt(k,234) +rxt(k,235) +rxt(k,236))* y(k,21) & + + 2._r8*(rxt(k,202) +rxt(k,203) +rxt(k,204) +rxt(k,228))* y(k,61) & + +rxt(k,206)* y(k,129) +rxt(k,208)* y(k,130) +rxt(k,211)* y(k,139) & + +rxt(k,489)* y(k,158) +rxt(k,201)* y(k,237) +rxt(k,205)* y(k,242) & + + (rxt(k,212) +rxt(k,213))* y(k,253) + rxt(k,93) + het_rates(k,61)) & + * y(k,61) + prod(k,260) = (rxt(k,199)*y(k,242) +rxt(k,200)*y(k,140) +rxt(k,216)*y(k,94)) & + *y(k,58) + (rxt(k,94) +rxt(k,209)*y(k,139))*y(k,62) & + + (rxt(k,217)*y(k,139) +rxt(k,218)*y(k,253))*y(k,94) + (rxt(k,107) + & + rxt(k,494)*y(k,158))*y(k,142) +2.000_r8*rxt(k,229)*y(k,60) & + +rxt(k,227)*y(k,252)*y(k,87) + loss(k,213) = (rxt(k,207)* y(k,58) + (rxt(k,551) +rxt(k,556) +rxt(k,561)) & + * y(k,87) +rxt(k,209)* y(k,139) +rxt(k,210)* y(k,253) + rxt(k,94) & + + rxt(k,95) + rxt(k,549) + rxt(k,554) + rxt(k,560) & + + het_rates(k,62))* y(k,62) + prod(k,213) =rxt(k,208)*y(k,130)*y(k,61) + loss(k,5) = ( + het_rates(k,63))* y(k,63) + prod(k,5) = 0._r8 + loss(k,225) = (rxt(k,294)* y(k,253) + het_rates(k,64))* y(k,64) + prod(k,225) = (rxt(k,32) +rxt(k,33) +rxt(k,194)*y(k,58) +rxt(k,230)*y(k,19) + & + rxt(k,275)*y(k,131) +rxt(k,276)*y(k,139) +rxt(k,277)*y(k,253)) & + *y(k,44) + (.630_r8*rxt(k,298)*y(k,27) +.560_r8*rxt(k,327)*y(k,31) + & + .650_r8*rxt(k,357)*y(k,111) +.560_r8*rxt(k,371)*y(k,118) + & + .620_r8*rxt(k,404)*y(k,100) +.230_r8*rxt(k,459)*y(k,6) + & + .230_r8*rxt(k,462)*y(k,116))*y(k,140) & + + (.220_r8*rxt(k,355)*y(k,246) +.250_r8*rxt(k,412)*y(k,260) + & + .170_r8*rxt(k,430)*y(k,238) +.400_r8*rxt(k,433)*y(k,247) + & + .350_r8*rxt(k,436)*y(k,249) +.225_r8*rxt(k,471)*y(k,257))*y(k,129) & + + (.350_r8*rxt(k,296)*y(k,26) +rxt(k,321)*y(k,77) + & + rxt(k,334)*y(k,51) +.700_r8*rxt(k,480)*y(k,217) +rxt(k,484)*y(k,143)) & + *y(k,253) + (rxt(k,333)*y(k,51) +.220_r8*rxt(k,354)*y(k,246) + & + .500_r8*rxt(k,413)*y(k,260))*y(k,131) & + + (.110_r8*rxt(k,352)*y(k,246) +.200_r8*rxt(k,410)*y(k,260) + & + .125_r8*rxt(k,469)*y(k,257))*y(k,237) & + + (.070_r8*rxt(k,429)*y(k,238) +.160_r8*rxt(k,432)*y(k,247) + & + .140_r8*rxt(k,435)*y(k,249))*y(k,242) + (rxt(k,110) + & + rxt(k,483)*y(k,139))*y(k,143) + (.220_r8*rxt(k,351)*y(k,246) + & + .250_r8*rxt(k,409)*y(k,260))*y(k,236) +1.500_r8*rxt(k,22)*y(k,11) & + +.450_r8*rxt(k,23)*y(k,12) +.600_r8*rxt(k,26)*y(k,15) +rxt(k,27) & + *y(k,16) +rxt(k,34)*y(k,47) +rxt(k,262)*y(k,58)*y(k,48) +rxt(k,36) & + *y(k,51) +.380_r8*rxt(k,39)*y(k,56) +rxt(k,41)*y(k,65) +rxt(k,43) & + *y(k,76) +2.000_r8*rxt(k,44)*y(k,77) +.330_r8*rxt(k,45)*y(k,95) & + +1.340_r8*rxt(k,50)*y(k,111) +.700_r8*rxt(k,55)*y(k,118) & + +1.500_r8*rxt(k,64)*y(k,212) +.250_r8*rxt(k,65)*y(k,213) +rxt(k,68) & + *y(k,216) +1.700_r8*rxt(k,69)*y(k,217) + loss(k,205) = ( + rxt(k,41) + het_rates(k,65))* y(k,65) + prod(k,205) = (rxt(k,286)*y(k,89) +rxt(k,294)*y(k,64) +rxt(k,314)*y(k,52) + & + .500_r8*rxt(k,315)*y(k,53) +.800_r8*rxt(k,320)*y(k,76) + & + rxt(k,321)*y(k,77) +.500_r8*rxt(k,370)*y(k,115) + & + 1.800_r8*rxt(k,480)*y(k,217))*y(k,253) & + + (2.000_r8*rxt(k,310)*y(k,236) +.900_r8*rxt(k,311)*y(k,237) + & + rxt(k,313)*y(k,129) +2.000_r8*rxt(k,360)*y(k,248) + & + rxt(k,384)*y(k,244) +rxt(k,409)*y(k,260))*y(k,236) & + + (.200_r8*rxt(k,327)*y(k,31) +.100_r8*rxt(k,371)*y(k,118) + & + .270_r8*rxt(k,459)*y(k,6) +.270_r8*rxt(k,462)*y(k,116))*y(k,140) & + + (rxt(k,361)*y(k,237) +.450_r8*rxt(k,362)*y(k,242) + & + 2.000_r8*rxt(k,363)*y(k,248))*y(k,248) & + + (.500_r8*rxt(k,469)*y(k,237) +.900_r8*rxt(k,471)*y(k,129)) & + *y(k,257) +rxt(k,37)*y(k,53) +.440_r8*rxt(k,39)*y(k,56) & + +.400_r8*rxt(k,60)*y(k,145) +rxt(k,65)*y(k,213) +.800_r8*rxt(k,69) & + *y(k,217) + loss(k,121) = (rxt(k,255)* y(k,252) + rxt(k,96) + het_rates(k,66))* y(k,66) + prod(k,121) = (rxt(k,220)*y(k,36) +rxt(k,222)*y(k,39) + & + 2.000_r8*rxt(k,223)*y(k,40) +2.000_r8*rxt(k,224)*y(k,41) + & + rxt(k,225)*y(k,42) +rxt(k,246)*y(k,37) +2.000_r8*rxt(k,248)*y(k,80) + & + rxt(k,272)*y(k,85) +rxt(k,273)*y(k,86))*y(k,252) + (rxt(k,101) + & + rxt(k,267)*y(k,253))*y(k,85) + (rxt(k,102) +rxt(k,268)*y(k,253)) & + *y(k,86) +rxt(k,79)*y(k,36) +rxt(k,80)*y(k,37) +rxt(k,82)*y(k,39) & + +2.000_r8*rxt(k,83)*y(k,40) +2.000_r8*rxt(k,84)*y(k,41) +rxt(k,85) & + *y(k,42) +2.000_r8*rxt(k,98)*y(k,80) + loss(k,123) = (rxt(k,256)* y(k,252) + rxt(k,97) + het_rates(k,67))* y(k,67) + prod(k,123) = (rxt(k,100) +rxt(k,266)*y(k,253) +rxt(k,271)*y(k,252))*y(k,84) & + + (rxt(k,81) +rxt(k,221)*y(k,252))*y(k,38) + (rxt(k,82) + & + rxt(k,222)*y(k,252))*y(k,39) + loss(k,111) = (rxt(k,428)* y(k,253) + het_rates(k,68))* y(k,68) + prod(k,111) =.180_r8*rxt(k,448)*y(k,253)*y(k,219) + loss(k,135) = (rxt(k,481)* y(k,131) + (rxt(k,482) +rxt(k,496))* y(k,253) & + + het_rates(k,69))* y(k,69) + prod(k,135) = 0._r8 + loss(k,6) = ( + het_rates(k,70))* y(k,70) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,71))* y(k,71) + prod(k,7) = 0._r8 + loss(k,8) = ( + het_rates(k,72))* y(k,72) + prod(k,8) = 0._r8 + loss(k,9) = ( + rxt(k,562) + het_rates(k,73))* y(k,73) + prod(k,9) = 0._r8 + loss(k,102) = ( + rxt(k,42) + het_rates(k,74))* y(k,74) + prod(k,102) =rxt(k,316)*y(k,242)*y(k,241) + loss(k,209) = (rxt(k,251)* y(k,56) +rxt(k,252)* y(k,79) +rxt(k,254)* y(k,91) & + +rxt(k,253)* y(k,263) + het_rates(k,75))* y(k,75) + prod(k,209) = (rxt(k,224)*y(k,41) +rxt(k,246)*y(k,37) + & + 2.000_r8*rxt(k,255)*y(k,66) +rxt(k,256)*y(k,67))*y(k,252) +rxt(k,80) & + *y(k,37) +rxt(k,84)*y(k,41) +2.000_r8*rxt(k,96)*y(k,66) +rxt(k,97) & + *y(k,67) +rxt(k,104)*y(k,90) + loss(k,222) = (rxt(k,320)* y(k,253) + rxt(k,43) + het_rates(k,76))* y(k,76) + prod(k,222) = (.530_r8*rxt(k,355)*y(k,246) +.050_r8*rxt(k,393)*y(k,245) + & + .250_r8*rxt(k,412)*y(k,260) +.225_r8*rxt(k,471)*y(k,257))*y(k,129) & + + (.530_r8*rxt(k,354)*y(k,246) +.050_r8*rxt(k,394)*y(k,245) + & + .250_r8*rxt(k,413)*y(k,260))*y(k,131) & + + (.260_r8*rxt(k,352)*y(k,246) +.100_r8*rxt(k,410)*y(k,260) + & + .125_r8*rxt(k,469)*y(k,257))*y(k,237) & + + (.700_r8*rxt(k,395)*y(k,101) +.500_r8*rxt(k,396)*y(k,102) + & + rxt(k,407)*y(k,122))*y(k,253) + (.530_r8*rxt(k,351)*y(k,246) + & + .250_r8*rxt(k,409)*y(k,260))*y(k,236) +.330_r8*rxt(k,45)*y(k,95) & + +.250_r8*rxt(k,65)*y(k,213) +rxt(k,319)*y(k,240) + loss(k,216) = (rxt(k,321)* y(k,253) + rxt(k,44) + rxt(k,541) & + + het_rates(k,77))* y(k,77) + prod(k,216) = (.050_r8*rxt(k,393)*y(k,245) +.250_r8*rxt(k,412)*y(k,260) + & + rxt(k,419)*y(k,231) +.400_r8*rxt(k,433)*y(k,247) + & + .170_r8*rxt(k,436)*y(k,249) +.700_r8*rxt(k,439)*y(k,254) + & + .600_r8*rxt(k,446)*y(k,259) +.340_r8*rxt(k,452)*y(k,261) + & + .170_r8*rxt(k,455)*y(k,262))*y(k,129) + (.650_r8*rxt(k,296)*y(k,26) + & + .200_r8*rxt(k,320)*y(k,76) +rxt(k,408)*y(k,123))*y(k,253) & + + (.250_r8*rxt(k,409)*y(k,236) +.100_r8*rxt(k,410)*y(k,237) + & + .250_r8*rxt(k,413)*y(k,131))*y(k,260) & + + (.160_r8*rxt(k,432)*y(k,247) +.070_r8*rxt(k,435)*y(k,249)) & + *y(k,242) +rxt(k,21)*y(k,10) +.130_r8*rxt(k,23)*y(k,12) & + +.050_r8*rxt(k,394)*y(k,245)*y(k,131) +.700_r8*rxt(k,61)*y(k,149) & + +.600_r8*rxt(k,70)*y(k,218) +.340_r8*rxt(k,72)*y(k,223) & + +.170_r8*rxt(k,73)*y(k,226) + loss(k,246) = (rxt(k,160)* y(k,140) + (rxt(k,154) +rxt(k,155) +rxt(k,156)) & + * y(k,242) + rxt(k,157) + het_rates(k,78))* y(k,78) + prod(k,246) = (rxt(k,161)*y(k,79) +rxt(k,164)*y(k,139) +rxt(k,182)*y(k,119) + & + rxt(k,277)*y(k,44) +rxt(k,484)*y(k,143) +rxt(k,490)*y(k,156) + & + rxt(k,495)*y(k,158))*y(k,253) + (rxt(k,144)*y(k,252) + & + rxt(k,152)*y(k,139) +rxt(k,196)*y(k,58) +rxt(k,252)*y(k,75))*y(k,79) & + + (.330_r8*rxt(k,39) +rxt(k,40) +rxt(k,291)*y(k,252))*y(k,56) & + + (rxt(k,99) +rxt(k,250)*y(k,252))*y(k,83) + (rxt(k,103) + & + rxt(k,227)*y(k,252))*y(k,87) + (rxt(k,2) +2.000_r8*rxt(k,3))*y(k,263) & + +2.000_r8*rxt(k,33)*y(k,44) +rxt(k,38)*y(k,55) +rxt(k,104)*y(k,90) + loss(k,242) = (rxt(k,196)* y(k,58) +rxt(k,252)* y(k,75) +rxt(k,152)* y(k,139) & + +rxt(k,144)* y(k,252) +rxt(k,161)* y(k,253) + het_rates(k,79)) & + * y(k,79) + prod(k,242) = (1.440_r8*rxt(k,39) +rxt(k,292)*y(k,252))*y(k,56) +rxt(k,32) & + *y(k,44) +rxt(k,154)*y(k,242)*y(k,78) +rxt(k,1)*y(k,263) + loss(k,90) = (rxt(k,248)* y(k,252) + rxt(k,98) + het_rates(k,80))* y(k,80) + prod(k,90) = 0._r8 + loss(k,181) = (rxt(k,197)* y(k,58) +rxt(k,153)* y(k,139) +rxt(k,162) & + * y(k,253) + rxt(k,4) + het_rates(k,81))* y(k,81) + prod(k,181) = (.500_r8*rxt(k,499) +rxt(k,168)*y(k,242))*y(k,242) & + +rxt(k,167)*y(k,253)*y(k,253) + loss(k,103) = ( + rxt(k,109) + het_rates(k,82))* y(k,82) + prod(k,103) =rxt(k,497)*y(k,263)*y(k,160) + loss(k,202) = (rxt(k,243)* y(k,139) + (rxt(k,249) +rxt(k,250))* y(k,252) & + +rxt(k,244)* y(k,253) + rxt(k,99) + het_rates(k,83))* y(k,83) + prod(k,202) = (rxt(k,230)*y(k,44) +rxt(k,231)*y(k,242))*y(k,19) + loss(k,122) = (rxt(k,271)* y(k,252) +rxt(k,266)* y(k,253) + rxt(k,100) & + + het_rates(k,84))* y(k,84) + prod(k,122) = 0._r8 + loss(k,124) = (rxt(k,272)* y(k,252) +rxt(k,267)* y(k,253) + rxt(k,101) & + + het_rates(k,85))* y(k,85) + prod(k,124) = 0._r8 + loss(k,132) = (rxt(k,273)* y(k,252) +rxt(k,268)* y(k,253) + rxt(k,102) & + + het_rates(k,86))* y(k,86) + prod(k,132) = 0._r8 + loss(k,255) = ((rxt(k,551) +rxt(k,556) +rxt(k,561))* y(k,62) + (rxt(k,553) + & + rxt(k,558))* y(k,93) + (rxt(k,546) +rxt(k,552) +rxt(k,557))* y(k,94) & + +rxt(k,214)* y(k,139) + (rxt(k,226) +rxt(k,227))* y(k,252) & + +rxt(k,215)* y(k,253) + rxt(k,103) + het_rates(k,87))* y(k,87) + prod(k,255) = (rxt(k,194)*y(k,44) +rxt(k,195)*y(k,56) +rxt(k,196)*y(k,79) + & + rxt(k,197)*y(k,81) +rxt(k,198)*y(k,242) +rxt(k,216)*y(k,94) + & + rxt(k,257)*y(k,43) +rxt(k,259)*y(k,45) +2.000_r8*rxt(k,262)*y(k,48) + & + rxt(k,264)*y(k,57) +rxt(k,305)*y(k,30))*y(k,58) +rxt(k,213)*y(k,253) & + *y(k,61) + loss(k,109) = (rxt(k,293)* y(k,252) +rxt(k,285)* y(k,253) + het_rates(k,88)) & + * y(k,88) + prod(k,109) = 0._r8 + loss(k,215) = (rxt(k,286)* y(k,253) + het_rates(k,89))* y(k,89) + prod(k,215) = (.370_r8*rxt(k,298)*y(k,27) +.120_r8*rxt(k,327)*y(k,31) + & + .330_r8*rxt(k,357)*y(k,111) +.120_r8*rxt(k,371)*y(k,118) + & + .110_r8*rxt(k,404)*y(k,100) +.050_r8*rxt(k,459)*y(k,6) + & + .050_r8*rxt(k,462)*y(k,116))*y(k,140) + (rxt(k,287)*y(k,242) + & + rxt(k,289)*y(k,129))*y(k,243) +.350_r8*rxt(k,296)*y(k,253)*y(k,26) + loss(k,133) = ( + rxt(k,104) + het_rates(k,90))* y(k,90) + prod(k,133) = (rxt(k,251)*y(k,56) +rxt(k,252)*y(k,79) +rxt(k,253)*y(k,263) + & + rxt(k,254)*y(k,91))*y(k,75) + loss(k,245) = (rxt(k,254)* y(k,75) +rxt(k,191)* y(k,253) + rxt(k,9) & + + het_rates(k,91))* y(k,91) + prod(k,245) = (rxt(k,549) +rxt(k,554) +rxt(k,560) +rxt(k,551)*y(k,87) + & + rxt(k,556)*y(k,87) +rxt(k,561)*y(k,87))*y(k,62) + (rxt(k,508) + & + rxt(k,275)*y(k,44) +rxt(k,307)*y(k,47) +rxt(k,333)*y(k,51) + & + rxt(k,481)*y(k,69))*y(k,131) + (2.000_r8*rxt(k,503) + & + 2.000_r8*rxt(k,545) +2.000_r8*rxt(k,548) +2.000_r8*rxt(k,559)) & + *y(k,121) + (rxt(k,547) +rxt(k,550) +rxt(k,555))*y(k,22) & + + (.500_r8*rxt(k,507) +rxt(k,190)*y(k,253))*y(k,130) +rxt(k,500) & + *y(k,95) +rxt(k,501)*y(k,101) +rxt(k,502)*y(k,102) +rxt(k,504) & + *y(k,122) +rxt(k,505)*y(k,123) +rxt(k,509)*y(k,133) +rxt(k,510) & + *y(k,144) +rxt(k,511)*y(k,214) + loss(k,151) = (rxt(k,169)* y(k,253) + rxt(k,10) + rxt(k,11) + rxt(k,192) & + + het_rates(k,92))* y(k,92) + prod(k,151) =rxt(k,188)*y(k,242)*y(k,130) + loss(k,199) = ((rxt(k,553) +rxt(k,558))* y(k,87) +rxt(k,245)* y(k,139) & + + rxt(k,105) + het_rates(k,93))* y(k,93) + prod(k,199) = (rxt(k,547) +rxt(k,550) +rxt(k,555))*y(k,22) & + +rxt(k,237)*y(k,242)*y(k,21) + loss(k,203) = (rxt(k,216)* y(k,58) + (rxt(k,546) +rxt(k,552) +rxt(k,557)) & + * y(k,87) +rxt(k,217)* y(k,139) +rxt(k,218)* y(k,253) + rxt(k,106) & + + het_rates(k,94))* y(k,94) + prod(k,203) = (rxt(k,549) +rxt(k,554) +rxt(k,560) +rxt(k,210)*y(k,253)) & + *y(k,62) +rxt(k,205)*y(k,242)*y(k,61) + loss(k,226) = (rxt(k,350)* y(k,253) + rxt(k,45) + rxt(k,500) & + + het_rates(k,95))* y(k,95) + prod(k,226) = (rxt(k,349)*y(k,239) +rxt(k,356)*y(k,246))*y(k,129) & + + (.300_r8*rxt(k,395)*y(k,101) +.500_r8*rxt(k,396)*y(k,102)) & + *y(k,253) + loss(k,120) = (rxt(k,381)* y(k,253) + rxt(k,46) + het_rates(k,96))* y(k,96) + prod(k,120) =rxt(k,392)*y(k,245) + loss(k,227) = (rxt(k,335)* y(k,253) + rxt(k,47) + het_rates(k,97))* y(k,97) + prod(k,227) = (.220_r8*rxt(k,351)*y(k,236) +.230_r8*rxt(k,352)*y(k,237) + & + .220_r8*rxt(k,354)*y(k,131) +.220_r8*rxt(k,355)*y(k,129))*y(k,246) & + + (.500_r8*rxt(k,339)*y(k,154) +.500_r8*rxt(k,370)*y(k,115) + & + .700_r8*rxt(k,395)*y(k,101) +.500_r8*rxt(k,396)*y(k,102))*y(k,253) & + + (.250_r8*rxt(k,409)*y(k,236) +.100_r8*rxt(k,410)*y(k,237) + & + .250_r8*rxt(k,412)*y(k,129) +.250_r8*rxt(k,413)*y(k,131))*y(k,260) & + + (.050_r8*rxt(k,393)*y(k,129) +.050_r8*rxt(k,394)*y(k,131)) & + *y(k,245) +.170_r8*rxt(k,45)*y(k,95) +.200_r8*rxt(k,340)*y(k,256) & + *y(k,237) + loss(k,141) = (rxt(k,382)* y(k,253) + het_rates(k,98))* y(k,98) + prod(k,141) = (rxt(k,389)*y(k,236) +.750_r8*rxt(k,390)*y(k,237) + & + .870_r8*rxt(k,393)*y(k,129) +.950_r8*rxt(k,394)*y(k,131))*y(k,245) + loss(k,96) = (rxt(k,383)* y(k,253) + het_rates(k,99))* y(k,99) + prod(k,96) =.600_r8*rxt(k,406)*y(k,253)*y(k,106) + loss(k,206) = (rxt(k,397)* y(k,131) +rxt(k,404)* y(k,140) +rxt(k,405) & + * y(k,253) + het_rates(k,100))* y(k,100) + prod(k,206) = 0._r8 + loss(k,177) = (rxt(k,395)* y(k,253) + rxt(k,501) + het_rates(k,101)) & + * y(k,101) + prod(k,177) =.080_r8*rxt(k,387)*y(k,244)*y(k,129) + loss(k,174) = (rxt(k,396)* y(k,253) + rxt(k,502) + het_rates(k,102)) & + * y(k,102) + prod(k,174) =.080_r8*rxt(k,393)*y(k,245)*y(k,129) + loss(k,232) = (rxt(k,401)* y(k,129) +rxt(k,402)* y(k,131) +rxt(k,398) & + * y(k,236) +rxt(k,399)* y(k,237) +rxt(k,400)* y(k,242) & + + het_rates(k,103))* y(k,103) + prod(k,232) =rxt(k,397)*y(k,131)*y(k,100) + loss(k,148) = (rxt(k,403)* y(k,253) + rxt(k,48) + het_rates(k,104))* y(k,104) + prod(k,148) =rxt(k,400)*y(k,242)*y(k,103) + loss(k,72) = (rxt(k,522)* y(k,129) +rxt(k,521)* y(k,242) + het_rates(k,105)) & + * y(k,105) + prod(k,72) =rxt(k,524)*y(k,253)*y(k,100) + loss(k,195) = (rxt(k,406)* y(k,253) + rxt(k,49) + het_rates(k,106))* y(k,106) + prod(k,195) = (rxt(k,386)*y(k,244) +rxt(k,391)*y(k,245))*y(k,242) +rxt(k,48) & + *y(k,104) + loss(k,65) = (rxt(k,527)* y(k,253) + het_rates(k,107))* y(k,107) + prod(k,65) = 0._r8 + loss(k,64) = (rxt(k,526)* y(k,129) +rxt(k,525)* y(k,242) + het_rates(k,108)) & + * y(k,108) + prod(k,64) =rxt(k,527)*y(k,253)*y(k,107) + loss(k,80) = (rxt(k,530)* y(k,253) + het_rates(k,109))* y(k,109) + prod(k,80) = 0._r8 + loss(k,79) = (rxt(k,529)* y(k,129) +rxt(k,528)* y(k,242) + het_rates(k,110)) & + * y(k,110) + prod(k,79) =rxt(k,530)*y(k,253)*y(k,109) + loss(k,233) = (rxt(k,357)* y(k,140) +rxt(k,358)* y(k,253) + rxt(k,50) & + + rxt(k,51) + het_rates(k,111))* y(k,111) + prod(k,233) = (.390_r8*rxt(k,384)*y(k,236) +.310_r8*rxt(k,385)*y(k,237) + & + .360_r8*rxt(k,387)*y(k,129) +.400_r8*rxt(k,388)*y(k,131))*y(k,244) & + +.300_r8*rxt(k,404)*y(k,140)*y(k,100) +.300_r8*rxt(k,49)*y(k,106) + loss(k,142) = (rxt(k,359)* y(k,253) + het_rates(k,112))* y(k,112) + prod(k,142) =rxt(k,353)*y(k,246)*y(k,242) + loss(k,168) = (rxt(k,368)* y(k,253) + rxt(k,52) + het_rates(k,113))* y(k,113) + prod(k,168) =.800_r8*rxt(k,19)*y(k,1) +.800_r8*rxt(k,20)*y(k,2) & + +.800_r8*rxt(k,377)*y(k,230)*y(k,129) + loss(k,143) = (rxt(k,369)* y(k,253) + rxt(k,53) + het_rates(k,114))* y(k,114) + prod(k,143) =.800_r8*rxt(k,366)*y(k,250)*y(k,242) + loss(k,182) = (rxt(k,370)* y(k,253) + rxt(k,54) + rxt(k,374) & + + het_rates(k,115))* y(k,115) + prod(k,182) =rxt(k,373)*y(k,248)*y(k,130) + loss(k,211) = (rxt(k,461)* y(k,131) +rxt(k,462)* y(k,140) +rxt(k,463) & + * y(k,253) + het_rates(k,116))* y(k,116) + prod(k,211) = 0._r8 + loss(k,73) = (rxt(k,533)* y(k,129) +rxt(k,532)* y(k,242) + het_rates(k,117)) & + * y(k,117) + prod(k,73) =rxt(k,535)*y(k,253)*y(k,116) + loss(k,239) = (rxt(k,371)* y(k,140) +rxt(k,372)* y(k,253) + rxt(k,55) & + + het_rates(k,118))* y(k,118) + prod(k,239) = (.610_r8*rxt(k,384)*y(k,236) +.440_r8*rxt(k,385)*y(k,237) + & + .560_r8*rxt(k,387)*y(k,129) +.600_r8*rxt(k,388)*y(k,131))*y(k,244) & + +.200_r8*rxt(k,404)*y(k,140)*y(k,100) +.700_r8*rxt(k,49)*y(k,106) + loss(k,165) = (rxt(k,170)* y(k,129) + (rxt(k,171) +rxt(k,172) +rxt(k,173)) & + * y(k,130) +rxt(k,182)* y(k,253) + rxt(k,174) + het_rates(k,119)) & + * y(k,119) + prod(k,165) =rxt(k,15)*y(k,129) + loss(k,108) = ((rxt(k,186) +rxt(k,187))* y(k,252) + rxt(k,12) & + + het_rates(k,120))* y(k,120) + prod(k,108) =rxt(k,171)*y(k,130)*y(k,119) + loss(k,134) = ( + rxt(k,13) + rxt(k,14) + rxt(k,193) + rxt(k,503) & + + rxt(k,545) + rxt(k,548) + rxt(k,559) + het_rates(k,121))* y(k,121) + prod(k,134) =rxt(k,189)*y(k,131)*y(k,130) + loss(k,155) = (rxt(k,407)* y(k,253) + rxt(k,504) + het_rates(k,122)) & + * y(k,122) + prod(k,155) =.200_r8*rxt(k,399)*y(k,237)*y(k,103) + loss(k,220) = (rxt(k,408)* y(k,253) + rxt(k,56) + rxt(k,505) & + + het_rates(k,123))* y(k,123) + prod(k,220) = (rxt(k,398)*y(k,236) +.800_r8*rxt(k,399)*y(k,237) + & + rxt(k,401)*y(k,129) +rxt(k,402)*y(k,131))*y(k,103) + loss(k,10) = ( + het_rates(k,124))* y(k,124) + prod(k,10) = 0._r8 + loss(k,11) = ( + het_rates(k,125))* y(k,125) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,126))* y(k,126) + prod(k,12) = 0._r8 + loss(k,86) = (rxt(k,498)* y(k,253) + het_rates(k,127))* y(k,127) + prod(k,86) = 0._r8 + loss(k,13) = ( + rxt(k,506) + het_rates(k,128))* y(k,128) + prod(k,13) = 0._r8 + loss(k,253) = (rxt(k,238)* y(k,21) +rxt(k,206)* y(k,61) +rxt(k,401)* y(k,103) & + +rxt(k,170)* y(k,119) +rxt(k,179)* y(k,131) +rxt(k,185)* y(k,139) & + +rxt(k,184)* y(k,140) +rxt(k,416)* y(k,229) + (rxt(k,377) + & + rxt(k,378))* y(k,230) +rxt(k,419)* y(k,231) +rxt(k,424)* y(k,232) & + +rxt(k,302)* y(k,233) +rxt(k,330)* y(k,234) +rxt(k,426)* y(k,235) & + +rxt(k,313)* y(k,236) +rxt(k,281)* y(k,237) +rxt(k,430)* y(k,238) & + + (rxt(k,348) +rxt(k,349))* y(k,239) +rxt(k,317)* y(k,241) & + +rxt(k,183)* y(k,242) +rxt(k,289)* y(k,243) +rxt(k,387)* y(k,244) & + +rxt(k,393)* y(k,245) + (rxt(k,355) +rxt(k,356))* y(k,246) & + +rxt(k,433)* y(k,247) +rxt(k,364)* y(k,248) +rxt(k,436)* y(k,249) & + +rxt(k,367)* y(k,250) +rxt(k,466)* y(k,251) +rxt(k,439)* y(k,254) & + +rxt(k,338)* y(k,255) +rxt(k,342)* y(k,256) +rxt(k,471)* y(k,257) & + +rxt(k,476)* y(k,258) +rxt(k,446)* y(k,259) +rxt(k,412)* y(k,260) & + +rxt(k,452)* y(k,261) +rxt(k,455)* y(k,262) + rxt(k,15) & + + het_rates(k,129))* y(k,129) + prod(k,253) = (rxt(k,16) +.500_r8*rxt(k,507) +2.000_r8*rxt(k,172)*y(k,119) + & + rxt(k,175)*y(k,139) +rxt(k,491)*y(k,158))*y(k,130) + (rxt(k,174) + & + rxt(k,182)*y(k,253))*y(k,119) +2.000_r8*rxt(k,186)*y(k,252)*y(k,120) & + +rxt(k,13)*y(k,121) +rxt(k,17)*y(k,131) + loss(k,248) = (rxt(k,239)* y(k,21) +rxt(k,208)* y(k,61) + (rxt(k,171) + & + rxt(k,172) +rxt(k,173))* y(k,119) +rxt(k,189)* y(k,131) & + + (rxt(k,175) +rxt(k,177))* y(k,139) +rxt(k,176)* y(k,140) & + +rxt(k,441)* y(k,147) +rxt(k,491)* y(k,158) +rxt(k,444)* y(k,229) & + +rxt(k,324)* y(k,236) +rxt(k,431)* y(k,238) +rxt(k,188)* y(k,242) & + +rxt(k,434)* y(k,247) +rxt(k,373)* y(k,248) +rxt(k,437)* y(k,249) & + +rxt(k,190)* y(k,253) + rxt(k,16) + rxt(k,507) + het_rates(k,130)) & + * y(k,130) + prod(k,248) = (2.000_r8*rxt(k,179)*y(k,131) +rxt(k,183)*y(k,242) + & + rxt(k,184)*y(k,140) +rxt(k,185)*y(k,139) +rxt(k,206)*y(k,61) + & + rxt(k,238)*y(k,21) +rxt(k,281)*y(k,237) +rxt(k,289)*y(k,243) + & + rxt(k,302)*y(k,233) +rxt(k,313)*y(k,236) +rxt(k,317)*y(k,241) + & + rxt(k,330)*y(k,234) +rxt(k,338)*y(k,255) +rxt(k,342)*y(k,256) + & + rxt(k,348)*y(k,239) +rxt(k,355)*y(k,246) +rxt(k,364)*y(k,248) + & + rxt(k,367)*y(k,250) +rxt(k,377)*y(k,230) + & + .920_r8*rxt(k,387)*y(k,244) +.920_r8*rxt(k,393)*y(k,245) + & + rxt(k,401)*y(k,103) +rxt(k,412)*y(k,260) +rxt(k,416)*y(k,229) + & + rxt(k,419)*y(k,231) +rxt(k,424)*y(k,232) +rxt(k,426)*y(k,235) + & + rxt(k,430)*y(k,238) +rxt(k,433)*y(k,247) +rxt(k,436)*y(k,249) + & + rxt(k,439)*y(k,254) +rxt(k,446)*y(k,259) +rxt(k,452)*y(k,261) + & + rxt(k,455)*y(k,262) +1.600_r8*rxt(k,466)*y(k,251) + & + .900_r8*rxt(k,471)*y(k,257) +.800_r8*rxt(k,476)*y(k,258))*y(k,129) & + + (rxt(k,18) +rxt(k,178)*y(k,242) +rxt(k,180)*y(k,139) + & + rxt(k,181)*y(k,253) +rxt(k,346)*y(k,18) +rxt(k,354)*y(k,246) + & + rxt(k,365)*y(k,248) +rxt(k,388)*y(k,244) +rxt(k,394)*y(k,245) + & + rxt(k,402)*y(k,103) +rxt(k,413)*y(k,260) + & + 2.000_r8*rxt(k,467)*y(k,251))*y(k,131) + (rxt(k,169)*y(k,92) + & + rxt(k,336)*y(k,132) +rxt(k,375)*y(k,1) +.700_r8*rxt(k,395)*y(k,101) + & + rxt(k,473)*y(k,214))*y(k,253) + (rxt(k,11) +rxt(k,192))*y(k,92) & + + (rxt(k,54) +rxt(k,374))*y(k,115) + (rxt(k,14) +rxt(k,193)) & + *y(k,121) + (.600_r8*rxt(k,60) +rxt(k,325))*y(k,145) +rxt(k,19) & + *y(k,1) +rxt(k,76)*y(k,22) +rxt(k,94)*y(k,62) +rxt(k,9)*y(k,91) & + +rxt(k,45)*y(k,95) +rxt(k,48)*y(k,104) +rxt(k,56)*y(k,123) & + +rxt(k,57)*y(k,132) +rxt(k,58)*y(k,133) +rxt(k,59)*y(k,144) & + +rxt(k,449)*y(k,146) +rxt(k,66)*y(k,214) & + +.500_r8*rxt(k,464)*y(k,251)*y(k,237) + loss(k,256) = (rxt(k,458)* y(k,6) +rxt(k,346)* y(k,18) +rxt(k,326)* y(k,31) & + +rxt(k,275)* y(k,44) +rxt(k,307)* y(k,47) +rxt(k,333)* y(k,51) & + +rxt(k,481)* y(k,69) +rxt(k,397)* y(k,100) +rxt(k,402)* y(k,103) & + +rxt(k,461)* y(k,116) +rxt(k,179)* y(k,129) +rxt(k,189)* y(k,130) & + +rxt(k,180)* y(k,139) +rxt(k,478)* y(k,216) +rxt(k,178)* y(k,242) & + +rxt(k,388)* y(k,244) +rxt(k,394)* y(k,245) +rxt(k,354)* y(k,246) & + +rxt(k,365)* y(k,248) +rxt(k,467)* y(k,251) +rxt(k,181)* y(k,253) & + +rxt(k,413)* y(k,260) + rxt(k,17) + rxt(k,18) + rxt(k,508) & + + het_rates(k,131))* y(k,131) + prod(k,256) = (rxt(k,95) +rxt(k,207)*y(k,58) +rxt(k,209)*y(k,139) + & + rxt(k,210)*y(k,253))*y(k,62) + (rxt(k,13) +rxt(k,14) +rxt(k,193)) & + *y(k,121) + (rxt(k,191)*y(k,91) +rxt(k,322)*y(k,145) + & + .500_r8*rxt(k,370)*y(k,115))*y(k,253) + (rxt(k,77) + & + rxt(k,240)*y(k,139))*y(k,22) + (rxt(k,176)*y(k,140) + & + rxt(k,177)*y(k,139))*y(k,130) +rxt(k,254)*y(k,91)*y(k,75) +rxt(k,10) & + *y(k,92) +.400_r8*rxt(k,60)*y(k,145) + loss(k,207) = (rxt(k,336)* y(k,253) + rxt(k,57) + het_rates(k,132))* y(k,132) + prod(k,207) = (.500_r8*rxt(k,396)*y(k,102) +rxt(k,403)*y(k,104) + & + rxt(k,407)*y(k,122) +rxt(k,408)*y(k,123))*y(k,253) & + +rxt(k,326)*y(k,131)*y(k,31) + loss(k,152) = (rxt(k,468)* y(k,253) + rxt(k,58) + rxt(k,509) & + + het_rates(k,133))* y(k,133) + prod(k,152) =rxt(k,465)*y(k,251)*y(k,242) + loss(k,14) = ( + het_rates(k,134))* y(k,134) + prod(k,14) = 0._r8 + loss(k,15) = ( + het_rates(k,135))* y(k,135) + prod(k,15) = 0._r8 + loss(k,16) = ( + het_rates(k,136))* y(k,136) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,137))* y(k,137) + prod(k,17) = 0._r8 + loss(k,18) = ( + het_rates(k,138))* y(k,138) + prod(k,18) = 0._r8 + loss(k,249) = (rxt(k,241)* y(k,21) +rxt(k,240)* y(k,22) +rxt(k,276)* y(k,44) & + +rxt(k,211)* y(k,61) +rxt(k,209)* y(k,62) +rxt(k,152)* y(k,79) & + +rxt(k,153)* y(k,81) +rxt(k,243)* y(k,83) +rxt(k,214)* y(k,87) & + +rxt(k,245)* y(k,93) +rxt(k,217)* y(k,94) +rxt(k,185)* y(k,129) & + + (rxt(k,175) +rxt(k,177))* y(k,130) +rxt(k,180)* y(k,131) & + + 2._r8*rxt(k,150)* y(k,139) +rxt(k,149)* y(k,140) +rxt(k,483) & + * y(k,143) +rxt(k,158)* y(k,242) +rxt(k,164)* y(k,253) + rxt(k,151) & + + het_rates(k,139))* y(k,139) + prod(k,249) = (rxt(k,174) +rxt(k,170)*y(k,129) +rxt(k,171)*y(k,130))*y(k,119) & + + (rxt(k,111) +rxt(k,492))*y(k,158) + (rxt(k,146) +rxt(k,147)) & + *y(k,252) +rxt(k,75)*y(k,21) +.180_r8*rxt(k,39)*y(k,56) +rxt(k,93) & + *y(k,61) +rxt(k,41)*y(k,65) +rxt(k,156)*y(k,242)*y(k,78) +rxt(k,13) & + *y(k,121) +rxt(k,15)*y(k,129) +rxt(k,16)*y(k,130) +rxt(k,18)*y(k,131) & + +rxt(k,8)*y(k,140) +rxt(k,107)*y(k,142) +rxt(k,485)*y(k,156) & + +rxt(k,112)*y(k,159) +rxt(k,113)*y(k,160) +rxt(k,166)*y(k,253) & + *y(k,253) +rxt(k,3)*y(k,263) + loss(k,258) = (rxt(k,459)* y(k,6) +rxt(k,232)* y(k,19) +rxt(k,298)* y(k,27) & + +rxt(k,327)* y(k,31) +rxt(k,200)* y(k,58) +rxt(k,160)* y(k,78) & + +rxt(k,404)* y(k,100) +rxt(k,357)* y(k,111) +rxt(k,462)* y(k,116) & + +rxt(k,371)* y(k,118) +rxt(k,184)* y(k,129) +rxt(k,176)* y(k,130) & + +rxt(k,149)* y(k,139) +rxt(k,442)* y(k,147) +rxt(k,487)* y(k,156) & + +rxt(k,493)* y(k,158) +rxt(k,159)* y(k,242) +rxt(k,148)* y(k,252) & + +rxt(k,165)* y(k,253) + rxt(k,7) + rxt(k,8) + het_rates(k,140)) & + * y(k,140) + prod(k,258) = (.150_r8*rxt(k,312)*y(k,236) +.150_r8*rxt(k,362)*y(k,248)) & + *y(k,242) +rxt(k,151)*y(k,139) + loss(k,19) = ( + het_rates(k,141))* y(k,141) + prod(k,19) = 0._r8 + loss(k,137) = (rxt(k,494)* y(k,158) + rxt(k,107) + het_rates(k,142)) & + * y(k,142) + prod(k,137) = (rxt(k,204)*y(k,61) +rxt(k,234)*y(k,21))*y(k,61) + loss(k,146) = (rxt(k,483)* y(k,139) +rxt(k,484)* y(k,253) + rxt(k,110) & + + het_rates(k,143))* y(k,143) + prod(k,146) = 0._r8 + loss(k,117) = ( + rxt(k,59) + rxt(k,510) + het_rates(k,144))* y(k,144) + prod(k,117) =rxt(k,350)*y(k,253)*y(k,95) +.100_r8*rxt(k,471)*y(k,257) & + *y(k,129) + loss(k,171) = (rxt(k,322)* y(k,253) + rxt(k,60) + rxt(k,325) & + + het_rates(k,145))* y(k,145) + prod(k,171) =rxt(k,324)*y(k,236)*y(k,130) + loss(k,97) = ( + rxt(k,449) + het_rates(k,146))* y(k,146) + prod(k,97) =rxt(k,444)*y(k,229)*y(k,130) + loss(k,164) = (rxt(k,441)* y(k,130) +rxt(k,442)* y(k,140) + het_rates(k,147)) & + * y(k,147) + prod(k,164) = (.070_r8*rxt(k,428)*y(k,68) +.060_r8*rxt(k,440)*y(k,148) + & + .070_r8*rxt(k,456)*y(k,225))*y(k,253) +rxt(k,31)*y(k,34) & + +rxt(k,426)*y(k,235)*y(k,129) + loss(k,106) = (rxt(k,440)* y(k,253) + het_rates(k,148))* y(k,148) + prod(k,106) =.530_r8*rxt(k,417)*y(k,253)*y(k,8) + loss(k,138) = (rxt(k,443)* y(k,253) + rxt(k,61) + het_rates(k,149))* y(k,149) + prod(k,138) =rxt(k,438)*y(k,254)*y(k,242) + loss(k,20) = ( + het_rates(k,150))* y(k,150) + prod(k,20) = 0._r8 + loss(k,21) = ( + het_rates(k,151))* y(k,151) + prod(k,21) = 0._r8 + loss(k,22) = ( + het_rates(k,152))* y(k,152) + prod(k,22) = 0._r8 + loss(k,23) = ( + het_rates(k,153))* y(k,153) + prod(k,23) = 0._r8 + loss(k,173) = (rxt(k,339)* y(k,253) + rxt(k,62) + het_rates(k,154))* y(k,154) + prod(k,173) =rxt(k,337)*y(k,255)*y(k,242) + loss(k,147) = (rxt(k,343)* y(k,253) + rxt(k,63) + het_rates(k,155))* y(k,155) + prod(k,147) =.850_r8*rxt(k,341)*y(k,256)*y(k,242) + loss(k,169) = (rxt(k,487)* y(k,140) +rxt(k,490)* y(k,253) + rxt(k,485) & + + het_rates(k,156))* y(k,156) + prod(k,169) =rxt(k,110)*y(k,143) +rxt(k,111)*y(k,158) + loss(k,24) = ( + rxt(k,108) + het_rates(k,157))* y(k,157) + prod(k,24) = 0._r8 + loss(k,235) = (rxt(k,488)* y(k,21) +rxt(k,489)* y(k,61) +rxt(k,491)* y(k,130) & + +rxt(k,493)* y(k,140) +rxt(k,494)* y(k,142) +rxt(k,495)* y(k,253) & + + rxt(k,111) + rxt(k,492) + het_rates(k,158))* y(k,158) + prod(k,235) = (rxt(k,485) +rxt(k,487)*y(k,140) +rxt(k,490)*y(k,253))*y(k,156) & + +rxt(k,483)*y(k,143)*y(k,139) +rxt(k,112)*y(k,159) + loss(k,208) = (rxt(k,486)* y(k,253) + rxt(k,112) + het_rates(k,159)) & + * y(k,159) + prod(k,208) = (rxt(k,492) +rxt(k,488)*y(k,21) +rxt(k,489)*y(k,61) + & + rxt(k,491)*y(k,130) +rxt(k,493)*y(k,140) +rxt(k,494)*y(k,142) + & + rxt(k,495)*y(k,253))*y(k,158) + (rxt(k,481)*y(k,131) + & + rxt(k,482)*y(k,253) +.500_r8*rxt(k,496)*y(k,253))*y(k,69) & + +rxt(k,484)*y(k,253)*y(k,143) +rxt(k,113)*y(k,160) + loss(k,125) = (rxt(k,497)* y(k,263) + rxt(k,113) + het_rates(k,160)) & + * y(k,160) + prod(k,125) =rxt(k,109)*y(k,82) +rxt(k,486)*y(k,253)*y(k,159) + loss(k,25) = ( + het_rates(k,161))* y(k,161) + prod(k,25) = 0._r8 + loss(k,26) = ( + het_rates(k,162))* y(k,162) + prod(k,26) = 0._r8 + loss(k,27) = ( + het_rates(k,163))* y(k,163) + prod(k,27) = 0._r8 + loss(k,28) = ( + het_rates(k,164))* y(k,164) + prod(k,28) = 0._r8 + loss(k,29) = ( + rxt(k,114) + het_rates(k,165))* y(k,165) + prod(k,29) = 0._r8 + loss(k,30) = ( + rxt(k,115) + het_rates(k,166))* y(k,166) + prod(k,30) = 0._r8 + loss(k,31) = ( + rxt(k,116) + het_rates(k,167))* y(k,167) + prod(k,31) = 0._r8 + loss(k,32) = ( + rxt(k,117) + het_rates(k,168))* y(k,168) + prod(k,32) = 0._r8 + loss(k,33) = ( + rxt(k,118) + het_rates(k,169))* y(k,169) + prod(k,33) = 0._r8 + loss(k,34) = ( + rxt(k,119) + het_rates(k,170))* y(k,170) + prod(k,34) = 0._r8 + loss(k,35) = ( + rxt(k,120) + het_rates(k,171))* y(k,171) + prod(k,35) = 0._r8 + loss(k,36) = ( + rxt(k,121) + het_rates(k,172))* y(k,172) + prod(k,36) = 0._r8 + loss(k,37) = ( + rxt(k,122) + het_rates(k,173))* y(k,173) + prod(k,37) = 0._r8 + loss(k,38) = ( + rxt(k,123) + het_rates(k,174))* y(k,174) + prod(k,38) = 0._r8 + loss(k,39) = ( + rxt(k,124) + het_rates(k,175))* y(k,175) + prod(k,39) = 0._r8 + loss(k,40) = ( + rxt(k,125) + het_rates(k,176))* y(k,176) + prod(k,40) = 0._r8 + loss(k,41) = ( + rxt(k,126) + het_rates(k,177))* y(k,177) + prod(k,41) = 0._r8 + loss(k,42) = ( + rxt(k,127) + het_rates(k,178))* y(k,178) + prod(k,42) = 0._r8 + loss(k,43) = ( + rxt(k,128) + het_rates(k,179))* y(k,179) + prod(k,43) = 0._r8 + loss(k,44) = ( + rxt(k,129) + het_rates(k,180))* y(k,180) + prod(k,44) = 0._r8 + loss(k,45) = ( + rxt(k,130) + het_rates(k,181))* y(k,181) + prod(k,45) = 0._r8 + loss(k,46) = ( + rxt(k,131) + het_rates(k,182))* y(k,182) + prod(k,46) = 0._r8 + loss(k,47) = ( + rxt(k,132) + het_rates(k,183))* y(k,183) + prod(k,47) = 0._r8 + loss(k,48) = ( + rxt(k,133) + het_rates(k,184))* y(k,184) + prod(k,48) = 0._r8 + loss(k,49) = ( + rxt(k,134) + het_rates(k,185))* y(k,185) + prod(k,49) = 0._r8 + loss(k,50) = ( + rxt(k,135) + het_rates(k,186))* y(k,186) + prod(k,50) = 0._r8 + loss(k,51) = ( + rxt(k,136) + het_rates(k,187))* y(k,187) + prod(k,51) = 0._r8 + loss(k,52) = ( + rxt(k,137) + het_rates(k,188))* y(k,188) + prod(k,52) = 0._r8 + loss(k,53) = ( + rxt(k,138) + het_rates(k,189))* y(k,189) + prod(k,53) = 0._r8 + loss(k,54) = ( + rxt(k,139) + het_rates(k,190))* y(k,190) + prod(k,54) = 0._r8 + loss(k,55) = ( + rxt(k,140) + het_rates(k,191))* y(k,191) + prod(k,55) = 0._r8 + loss(k,56) = ( + rxt(k,141) + het_rates(k,192))* y(k,192) + prod(k,56) = 0._r8 + loss(k,57) = ( + rxt(k,142) + het_rates(k,193))* y(k,193) + prod(k,57) = 0._r8 + loss(k,58) = ( + rxt(k,143) + het_rates(k,194))* y(k,194) + prod(k,58) = 0._r8 + loss(k,59) = ( + het_rates(k,195))* y(k,195) + prod(k,59) = (.2381005_r8*rxt(k,525)*y(k,242) + & + .1056005_r8*rxt(k,526)*y(k,129))*y(k,108) & + +.5931005_r8*rxt(k,536)*y(k,253)*y(k,210) + loss(k,60) = ( + het_rates(k,196))* y(k,196) + prod(k,60) = (.1308005_r8*rxt(k,525)*y(k,242) + & + .1026005_r8*rxt(k,526)*y(k,129))*y(k,108) & + +.1534005_r8*rxt(k,536)*y(k,253)*y(k,210) + loss(k,61) = ( + het_rates(k,197))* y(k,197) + prod(k,61) = (.0348005_r8*rxt(k,525)*y(k,242) + & + .0521005_r8*rxt(k,526)*y(k,129))*y(k,108) & + +.0459005_r8*rxt(k,536)*y(k,253)*y(k,210) + loss(k,62) = ( + het_rates(k,198))* y(k,198) + prod(k,62) = (.0076005_r8*rxt(k,525)*y(k,242) + & + .0143005_r8*rxt(k,526)*y(k,129))*y(k,108) & + +.0085005_r8*rxt(k,536)*y(k,253)*y(k,210) + loss(k,63) = ( + het_rates(k,199))* y(k,199) + prod(k,63) = (.0113005_r8*rxt(k,525)*y(k,242) + & + .0166005_r8*rxt(k,526)*y(k,129))*y(k,108) & + +.0128005_r8*rxt(k,536)*y(k,253)*y(k,210) + loss(k,66) = ( + het_rates(k,200))* y(k,200) + prod(k,66) = (.1279005_r8*rxt(k,514)*y(k,7) + & + .0003005_r8*rxt(k,522)*y(k,105) +.0245005_r8*rxt(k,533)*y(k,117)) & + *y(k,129) + (.2202005_r8*rxt(k,513)*y(k,7) + & + .0031005_r8*rxt(k,521)*y(k,105) +.0508005_r8*rxt(k,532)*y(k,117)) & + *y(k,242) + (.2202005_r8*rxt(k,515)*y(k,6) + & + .0508005_r8*rxt(k,534)*y(k,116))*y(k,140) +rxt(k,541)*y(k,77) + loss(k,67) = ( + het_rates(k,201))* y(k,201) + prod(k,67) = (.1792005_r8*rxt(k,514)*y(k,7) + & + .0003005_r8*rxt(k,522)*y(k,105) +.0082005_r8*rxt(k,533)*y(k,117)) & + *y(k,129) + (.2067005_r8*rxt(k,513)*y(k,7) + & + .0035005_r8*rxt(k,521)*y(k,105) +.1149005_r8*rxt(k,532)*y(k,117)) & + *y(k,242) + (.2067005_r8*rxt(k,515)*y(k,6) + & + .1149005_r8*rxt(k,534)*y(k,116))*y(k,140) + loss(k,68) = ( + het_rates(k,202))* y(k,202) + prod(k,68) = (.0676005_r8*rxt(k,514)*y(k,7) + & + .0073005_r8*rxt(k,522)*y(k,105) +.0772005_r8*rxt(k,533)*y(k,117)) & + *y(k,129) + (.0653005_r8*rxt(k,513)*y(k,7) + & + .0003005_r8*rxt(k,521)*y(k,105) +.0348005_r8*rxt(k,532)*y(k,117)) & + *y(k,242) + (.0653005_r8*rxt(k,515)*y(k,6) + & + .0348005_r8*rxt(k,534)*y(k,116))*y(k,140) + loss(k,69) = ( + het_rates(k,203))* y(k,203) + prod(k,69) = (.079_r8*rxt(k,514)*y(k,7) +.0057005_r8*rxt(k,522)*y(k,105) + & + .0332005_r8*rxt(k,533)*y(k,117))*y(k,129) & + + (.1749305_r8*rxt(k,512)*y(k,6) +.0590245_r8*rxt(k,520)*y(k,100) + & + .1749305_r8*rxt(k,531)*y(k,116))*y(k,131) & + + (.1284005_r8*rxt(k,515)*y(k,6) +.0033005_r8*rxt(k,523)*y(k,100) + & + .0554005_r8*rxt(k,534)*y(k,116))*y(k,140) & + + (.1284005_r8*rxt(k,513)*y(k,7) +.0271005_r8*rxt(k,521)*y(k,105) + & + .0554005_r8*rxt(k,532)*y(k,117))*y(k,242) + loss(k,70) = ( + het_rates(k,204))* y(k,204) + prod(k,70) = (.1254005_r8*rxt(k,514)*y(k,7) + & + .0623005_r8*rxt(k,522)*y(k,105) +.130_r8*rxt(k,533)*y(k,117)) & + *y(k,129) + (.5901905_r8*rxt(k,512)*y(k,6) + & + .0250245_r8*rxt(k,520)*y(k,100) +.5901905_r8*rxt(k,531)*y(k,116)) & + *y(k,131) + (.114_r8*rxt(k,513)*y(k,7) + & + .0474005_r8*rxt(k,521)*y(k,105) +.1278005_r8*rxt(k,532)*y(k,117)) & + *y(k,242) + (.114_r8*rxt(k,515)*y(k,6) + & + .1278005_r8*rxt(k,534)*y(k,116))*y(k,140) + loss(k,74) = ( + het_rates(k,205))* y(k,205) + prod(k,74) = (.0097005_r8*rxt(k,519)*y(k,9) + & + .1056005_r8*rxt(k,529)*y(k,110) +.0154005_r8*rxt(k,540)*y(k,220) + & + .0063005_r8*rxt(k,544)*y(k,224))*y(k,129) & + + (.0023005_r8*rxt(k,518)*y(k,9) +.2381005_r8*rxt(k,528)*y(k,110) + & + .1364005_r8*rxt(k,539)*y(k,220) +.1677005_r8*rxt(k,543)*y(k,224)) & + *y(k,242) +.5931005_r8*rxt(k,537)*y(k,253)*y(k,211) + loss(k,75) = ( + het_rates(k,206))* y(k,206) + prod(k,75) = (.0034005_r8*rxt(k,519)*y(k,9) + & + .1026005_r8*rxt(k,529)*y(k,110) +.0452005_r8*rxt(k,540)*y(k,220) + & + .0237005_r8*rxt(k,544)*y(k,224))*y(k,129) & + + (.0008005_r8*rxt(k,518)*y(k,9) +.1308005_r8*rxt(k,528)*y(k,110) + & + .0101005_r8*rxt(k,539)*y(k,220) +.0174005_r8*rxt(k,543)*y(k,224)) & + *y(k,242) +.1534005_r8*rxt(k,537)*y(k,253)*y(k,211) + loss(k,76) = ( + het_rates(k,207))* y(k,207) + prod(k,76) = (.1579005_r8*rxt(k,519)*y(k,9) + & + .0521005_r8*rxt(k,529)*y(k,110) +.0966005_r8*rxt(k,540)*y(k,220) + & + .0025005_r8*rxt(k,544)*y(k,224))*y(k,129) & + + (.0843005_r8*rxt(k,518)*y(k,9) +.0348005_r8*rxt(k,528)*y(k,110) + & + .0763005_r8*rxt(k,539)*y(k,220) +.086_r8*rxt(k,543)*y(k,224)) & + *y(k,242) +.0459005_r8*rxt(k,537)*y(k,253)*y(k,211) + loss(k,77) = ( + het_rates(k,208))* y(k,208) + prod(k,77) = (.0059005_r8*rxt(k,519)*y(k,9) + & + .0143005_r8*rxt(k,529)*y(k,110) +.0073005_r8*rxt(k,540)*y(k,220) + & + .011_r8*rxt(k,544)*y(k,224))*y(k,129) & + + (.0443005_r8*rxt(k,518)*y(k,9) +.0076005_r8*rxt(k,528)*y(k,110) + & + .2157005_r8*rxt(k,539)*y(k,220) +.0512005_r8*rxt(k,543)*y(k,224)) & + *y(k,242) +.0085005_r8*rxt(k,537)*y(k,253)*y(k,211) + loss(k,78) = ( + het_rates(k,209))* y(k,209) + prod(k,78) = (.0536005_r8*rxt(k,519)*y(k,9) + & + .0166005_r8*rxt(k,529)*y(k,110) +.238_r8*rxt(k,540)*y(k,220) + & + .1185005_r8*rxt(k,544)*y(k,224))*y(k,129) & + + (.1621005_r8*rxt(k,518)*y(k,9) +.0113005_r8*rxt(k,528)*y(k,110) + & + .0738005_r8*rxt(k,539)*y(k,220) +.1598005_r8*rxt(k,543)*y(k,224)) & + *y(k,242) +.0128005_r8*rxt(k,537)*y(k,253)*y(k,211) + loss(k,82) = (rxt(k,536)* y(k,253) + het_rates(k,210))* y(k,210) + prod(k,82) = 0._r8 + loss(k,83) = (rxt(k,537)* y(k,253) + het_rates(k,211))* y(k,211) + prod(k,83) = 0._r8 + loss(k,112) = ( + rxt(k,64) + het_rates(k,212))* y(k,212) + prod(k,112) = (.100_r8*rxt(k,448)*y(k,219) +.230_r8*rxt(k,450)*y(k,222)) & + *y(k,253) + loss(k,188) = (rxt(k,472)* y(k,253) + rxt(k,65) + het_rates(k,213))* y(k,213) + prod(k,188) =rxt(k,470)*y(k,257)*y(k,242) + loss(k,183) = (rxt(k,473)* y(k,253) + rxt(k,66) + rxt(k,511) & + + het_rates(k,214))* y(k,214) + prod(k,183) = (.200_r8*rxt(k,466)*y(k,251) +.200_r8*rxt(k,476)*y(k,258)) & + *y(k,129) +.500_r8*rxt(k,464)*y(k,251)*y(k,237) + loss(k,163) = (rxt(k,477)* y(k,253) + rxt(k,67) + het_rates(k,215))* y(k,215) + prod(k,163) =rxt(k,475)*y(k,258)*y(k,242) + loss(k,218) = (rxt(k,478)* y(k,131) +rxt(k,479)* y(k,253) + rxt(k,68) & + + het_rates(k,216))* y(k,216) + prod(k,218) = (.500_r8*rxt(k,464)*y(k,237) +.800_r8*rxt(k,466)*y(k,129) + & + rxt(k,467)*y(k,131))*y(k,251) + (.330_r8*rxt(k,459)*y(k,6) + & + .330_r8*rxt(k,462)*y(k,116))*y(k,140) + (rxt(k,66) + & + rxt(k,473)*y(k,253))*y(k,214) + (rxt(k,474)*y(k,237) + & + .800_r8*rxt(k,476)*y(k,129))*y(k,258) +rxt(k,58)*y(k,133) +rxt(k,67) & + *y(k,215) + loss(k,224) = (rxt(k,480)* y(k,253) + rxt(k,69) + het_rates(k,217))* y(k,217) + prod(k,224) = (.300_r8*rxt(k,459)*y(k,6) +.300_r8*rxt(k,462)*y(k,116)) & + *y(k,140) + (rxt(k,469)*y(k,237) +.900_r8*rxt(k,471)*y(k,129)) & + *y(k,257) +rxt(k,65)*y(k,213) +rxt(k,68)*y(k,216) + loss(k,189) = (rxt(k,447)* y(k,253) + rxt(k,70) + het_rates(k,218))* y(k,218) + prod(k,189) =rxt(k,445)*y(k,259)*y(k,242) + loss(k,110) = (rxt(k,448)* y(k,253) + het_rates(k,219))* y(k,219) + prod(k,110) = 0._r8 + loss(k,84) = (rxt(k,540)* y(k,129) +rxt(k,539)* y(k,242) + het_rates(k,220)) & + * y(k,220) + prod(k,84) =rxt(k,538)*y(k,253)*y(k,219) + loss(k,113) = (rxt(k,414)* y(k,253) + rxt(k,71) + het_rates(k,221))* y(k,221) + prod(k,113) =rxt(k,411)*y(k,260)*y(k,242) + loss(k,114) = (rxt(k,450)* y(k,253) + het_rates(k,222))* y(k,222) + prod(k,114) = 0._r8 + loss(k,191) = (rxt(k,453)* y(k,253) + rxt(k,72) + het_rates(k,223))* y(k,223) + prod(k,191) =rxt(k,451)*y(k,261)*y(k,242) + loss(k,85) = (rxt(k,544)* y(k,129) +rxt(k,543)* y(k,242) + het_rates(k,224)) & + * y(k,224) + prod(k,85) =rxt(k,542)*y(k,253)*y(k,222) + loss(k,115) = (rxt(k,456)* y(k,253) + het_rates(k,225))* y(k,225) + prod(k,115) =.150_r8*rxt(k,450)*y(k,253)*y(k,222) + loss(k,157) = (rxt(k,457)* y(k,253) + rxt(k,73) + het_rates(k,226))* y(k,226) + prod(k,157) =rxt(k,454)*y(k,262)*y(k,242) + loss(k,170) = (rxt(k,416)* y(k,129) +rxt(k,444)* y(k,130) +rxt(k,415) & + * y(k,242) + het_rates(k,229))* y(k,229) + prod(k,170) =rxt(k,421)*y(k,253)*y(k,24) +rxt(k,449)*y(k,146) + loss(k,212) = ((rxt(k,377) +rxt(k,378))* y(k,129) +rxt(k,376)* y(k,242) & + + het_rates(k,230))* y(k,230) + prod(k,212) = (rxt(k,379)*y(k,2) +rxt(k,380)*y(k,17))*y(k,253) + loss(k,166) = (rxt(k,419)* y(k,129) +rxt(k,418)* y(k,242) + het_rates(k,231)) & + * y(k,231) + prod(k,166) = (.350_r8*rxt(k,417)*y(k,8) +rxt(k,420)*y(k,10))*y(k,253) + loss(k,158) = (rxt(k,424)* y(k,129) +rxt(k,422)* y(k,242) + het_rates(k,232)) & + * y(k,232) + prod(k,158) = (rxt(k,423)*y(k,25) +.070_r8*rxt(k,448)*y(k,219) + & + .060_r8*rxt(k,450)*y(k,222))*y(k,253) + loss(k,204) = (rxt(k,302)* y(k,129) + 2._r8*rxt(k,299)* y(k,233) +rxt(k,300) & + * y(k,237) +rxt(k,301)* y(k,242) + het_rates(k,233))* y(k,233) + prod(k,204) = (rxt(k,305)*y(k,58) +rxt(k,306)*y(k,253))*y(k,30) & + +.500_r8*rxt(k,304)*y(k,253)*y(k,29) +rxt(k,52)*y(k,113) + loss(k,201) = (rxt(k,330)* y(k,129) +rxt(k,328)* y(k,237) +rxt(k,329) & + * y(k,242) + het_rates(k,234))* y(k,234) + prod(k,201) = (rxt(k,331)*y(k,32) +rxt(k,332)*y(k,33))*y(k,253) + loss(k,184) = (rxt(k,426)* y(k,129) +rxt(k,425)* y(k,242) + het_rates(k,235)) & + * y(k,235) + prod(k,184) = (.400_r8*rxt(k,415)*y(k,242) +rxt(k,416)*y(k,129))*y(k,229) & + +rxt(k,427)*y(k,253)*y(k,34) +rxt(k,442)*y(k,147)*y(k,140) + loss(k,241) = (rxt(k,398)* y(k,103) +rxt(k,313)* y(k,129) +rxt(k,324) & + * y(k,130) + 2._r8*rxt(k,310)* y(k,236) +rxt(k,311)* y(k,237) & + +rxt(k,312)* y(k,242) +rxt(k,384)* y(k,244) +rxt(k,389)* y(k,245) & + +rxt(k,351)* y(k,246) +rxt(k,409)* y(k,260) + het_rates(k,236)) & + * y(k,236) + prod(k,241) = (.100_r8*rxt(k,357)*y(k,111) +.280_r8*rxt(k,371)*y(k,118) + & + .080_r8*rxt(k,404)*y(k,100) +.060_r8*rxt(k,459)*y(k,6) + & + .060_r8*rxt(k,462)*y(k,116))*y(k,140) + (rxt(k,361)*y(k,237) + & + .450_r8*rxt(k,362)*y(k,242) +2.000_r8*rxt(k,363)*y(k,248) + & + rxt(k,364)*y(k,129) +rxt(k,365)*y(k,131))*y(k,248) & + + (.530_r8*rxt(k,351)*y(k,236) +.260_r8*rxt(k,352)*y(k,237) + & + .530_r8*rxt(k,354)*y(k,131) +.530_r8*rxt(k,355)*y(k,129))*y(k,246) & + + (rxt(k,308)*y(k,47) +.500_r8*rxt(k,315)*y(k,53) + & + rxt(k,334)*y(k,51) +.650_r8*rxt(k,480)*y(k,217))*y(k,253) & + + (.300_r8*rxt(k,340)*y(k,237) +.150_r8*rxt(k,341)*y(k,242) + & + rxt(k,342)*y(k,129))*y(k,256) + (rxt(k,36) +rxt(k,333)*y(k,131)) & + *y(k,51) + (.600_r8*rxt(k,60) +rxt(k,325))*y(k,145) & + + (.200_r8*rxt(k,366)*y(k,242) +rxt(k,367)*y(k,129))*y(k,250) & + +.130_r8*rxt(k,23)*y(k,12) +rxt(k,27)*y(k,16) +rxt(k,307)*y(k,131) & + *y(k,47) +rxt(k,35)*y(k,50) +.330_r8*rxt(k,45)*y(k,95) +rxt(k,47) & + *y(k,97) +1.340_r8*rxt(k,51)*y(k,111) +rxt(k,52)*y(k,113) +rxt(k,53) & + *y(k,114) +.300_r8*rxt(k,55)*y(k,118) +rxt(k,57)*y(k,132) +rxt(k,63) & + *y(k,155) +.500_r8*rxt(k,64)*y(k,212) +.650_r8*rxt(k,69)*y(k,217) + loss(k,254) = (rxt(k,201)* y(k,61) +rxt(k,399)* y(k,103) +rxt(k,281) & + * y(k,129) +rxt(k,300)* y(k,233) +rxt(k,328)* y(k,234) +rxt(k,311) & + * y(k,236) + 2._r8*(rxt(k,278) +rxt(k,279))* y(k,237) +rxt(k,280) & + * y(k,242) +rxt(k,385)* y(k,244) +rxt(k,390)* y(k,245) +rxt(k,352) & + * y(k,246) +rxt(k,361)* y(k,248) +rxt(k,464)* y(k,251) +rxt(k,340) & + * y(k,256) +rxt(k,469)* y(k,257) +rxt(k,474)* y(k,258) +rxt(k,410) & + * y(k,260) + het_rates(k,237))* y(k,237) + prod(k,254) = (2.000_r8*rxt(k,310)*y(k,236) +.900_r8*rxt(k,311)*y(k,237) + & + .450_r8*rxt(k,312)*y(k,242) +rxt(k,313)*y(k,129) + & + rxt(k,351)*y(k,246) +rxt(k,360)*y(k,248) +rxt(k,384)*y(k,244) + & + rxt(k,389)*y(k,245) +rxt(k,398)*y(k,103) +rxt(k,409)*y(k,260)) & + *y(k,236) + (rxt(k,40) +rxt(k,195)*y(k,58) +rxt(k,251)*y(k,75) + & + rxt(k,284)*y(k,253) +rxt(k,290)*y(k,252))*y(k,56) & + + (.830_r8*rxt(k,430)*y(k,238) +.170_r8*rxt(k,436)*y(k,249)) & + *y(k,129) + (.280_r8*rxt(k,327)*y(k,31) +.050_r8*rxt(k,404)*y(k,100)) & + *y(k,140) + (.330_r8*rxt(k,429)*y(k,238) + & + .070_r8*rxt(k,435)*y(k,249))*y(k,242) + (.700_r8*rxt(k,283)*y(k,55) + & + rxt(k,314)*y(k,52))*y(k,253) +rxt(k,87)*y(k,45) +rxt(k,34)*y(k,47) & + +rxt(k,89)*y(k,48) +rxt(k,35)*y(k,50) +rxt(k,37)*y(k,53) & + +.300_r8*rxt(k,55)*y(k,118) +.400_r8*rxt(k,60)*y(k,145) + loss(k,197) = (rxt(k,430)* y(k,129) +rxt(k,431)* y(k,130) +rxt(k,429) & + * y(k,242) + het_rates(k,238))* y(k,238) + prod(k,197) =.600_r8*rxt(k,25)*y(k,14) + loss(k,176) = ((rxt(k,348) +rxt(k,349))* y(k,129) + het_rates(k,239)) & + * y(k,239) + prod(k,176) =rxt(k,347)*y(k,253)*y(k,18) + loss(k,128) = ( + rxt(k,318) + rxt(k,319) + het_rates(k,240))* y(k,240) + prod(k,128) =rxt(k,42)*y(k,74) +.750_r8*rxt(k,317)*y(k,241)*y(k,129) + loss(k,192) = (rxt(k,317)* y(k,129) +rxt(k,316)* y(k,242) + het_rates(k,241)) & + * y(k,241) + prod(k,192) =rxt(k,323)*y(k,253)*y(k,27) + loss(k,259) = (rxt(k,231)* y(k,19) +rxt(k,237)* y(k,21) +rxt(k,274)* y(k,44) & + + (rxt(k,198) +rxt(k,199))* y(k,58) +rxt(k,205)* y(k,61) & + + (rxt(k,154) +rxt(k,155) +rxt(k,156))* y(k,78) +rxt(k,400) & + * y(k,103) +rxt(k,183)* y(k,129) +rxt(k,188)* y(k,130) +rxt(k,178) & + * y(k,131) +rxt(k,158)* y(k,139) +rxt(k,159)* y(k,140) +rxt(k,415) & + * y(k,229) +rxt(k,376)* y(k,230) +rxt(k,418)* y(k,231) +rxt(k,422) & + * y(k,232) +rxt(k,301)* y(k,233) +rxt(k,329)* y(k,234) +rxt(k,425) & + * y(k,235) +rxt(k,312)* y(k,236) +rxt(k,280)* y(k,237) +rxt(k,429) & + * y(k,238) +rxt(k,316)* y(k,241) + 2._r8*rxt(k,168)* y(k,242) & + +rxt(k,287)* y(k,243) +rxt(k,386)* y(k,244) +rxt(k,391)* y(k,245) & + +rxt(k,353)* y(k,246) +rxt(k,432)* y(k,247) +rxt(k,362)* y(k,248) & + +rxt(k,435)* y(k,249) +rxt(k,366)* y(k,250) +rxt(k,465)* y(k,251) & + +rxt(k,163)* y(k,253) +rxt(k,438)* y(k,254) +rxt(k,337)* y(k,255) & + +rxt(k,341)* y(k,256) +rxt(k,470)* y(k,257) +rxt(k,475)* y(k,258) & + +rxt(k,445)* y(k,259) +rxt(k,411)* y(k,260) +rxt(k,451)* y(k,261) & + +rxt(k,454)* y(k,262) + rxt(k,499) + het_rates(k,242))* y(k,242) + prod(k,259) = (rxt(k,162)*y(k,81) +rxt(k,165)*y(k,140) +rxt(k,181)*y(k,131) + & + rxt(k,212)*y(k,61) +rxt(k,242)*y(k,21) +rxt(k,260)*y(k,45) + & + rxt(k,263)*y(k,48) +rxt(k,282)*y(k,54) +rxt(k,285)*y(k,88) + & + rxt(k,286)*y(k,89) +rxt(k,294)*y(k,64) +.350_r8*rxt(k,296)*y(k,26) + & + rxt(k,303)*y(k,28) +rxt(k,309)*y(k,49) +rxt(k,320)*y(k,76) + & + rxt(k,321)*y(k,77) +rxt(k,335)*y(k,97) +rxt(k,350)*y(k,95) + & + .200_r8*rxt(k,359)*y(k,112) +.500_r8*rxt(k,370)*y(k,115) + & + .300_r8*rxt(k,395)*y(k,101) +rxt(k,396)*y(k,102) + & + rxt(k,403)*y(k,104) +rxt(k,407)*y(k,122) +rxt(k,408)*y(k,123) + & + .650_r8*rxt(k,417)*y(k,8) +.730_r8*rxt(k,428)*y(k,68) + & + .800_r8*rxt(k,440)*y(k,148) +.280_r8*rxt(k,448)*y(k,219) + & + .380_r8*rxt(k,450)*y(k,222) +.630_r8*rxt(k,456)*y(k,225) + & + .200_r8*rxt(k,480)*y(k,217) +rxt(k,486)*y(k,159) + & + .500_r8*rxt(k,496)*y(k,69))*y(k,253) + (rxt(k,281)*y(k,237) + & + rxt(k,289)*y(k,243) +rxt(k,302)*y(k,233) + & + .250_r8*rxt(k,317)*y(k,241) +rxt(k,330)*y(k,234) + & + rxt(k,338)*y(k,255) +rxt(k,348)*y(k,239) + & + .470_r8*rxt(k,355)*y(k,246) +rxt(k,377)*y(k,230) + & + .920_r8*rxt(k,387)*y(k,244) +.920_r8*rxt(k,393)*y(k,245) + & + rxt(k,401)*y(k,103) +rxt(k,412)*y(k,260) +rxt(k,419)*y(k,231) + & + rxt(k,424)*y(k,232) +.170_r8*rxt(k,430)*y(k,238) + & + .400_r8*rxt(k,433)*y(k,247) +.830_r8*rxt(k,436)*y(k,249) + & + rxt(k,439)*y(k,254) +rxt(k,446)*y(k,259) +rxt(k,452)*y(k,261) + & + rxt(k,455)*y(k,262) +.900_r8*rxt(k,471)*y(k,257) + & + .800_r8*rxt(k,476)*y(k,258))*y(k,129) + (rxt(k,201)*y(k,61) + & + 2.000_r8*rxt(k,278)*y(k,237) +rxt(k,300)*y(k,233) + & + .900_r8*rxt(k,311)*y(k,236) +rxt(k,328)*y(k,234) + & + .300_r8*rxt(k,340)*y(k,256) +.730_r8*rxt(k,352)*y(k,246) + & + rxt(k,361)*y(k,248) +rxt(k,385)*y(k,244) +rxt(k,390)*y(k,245) + & + 1.200_r8*rxt(k,399)*y(k,103) +.800_r8*rxt(k,410)*y(k,260) + & + .500_r8*rxt(k,464)*y(k,251) +rxt(k,469)*y(k,257) + & + rxt(k,474)*y(k,258))*y(k,237) + (.130_r8*rxt(k,298)*y(k,27) + & + .280_r8*rxt(k,327)*y(k,31) +.140_r8*rxt(k,357)*y(k,111) + & + .280_r8*rxt(k,371)*y(k,118) +.370_r8*rxt(k,404)*y(k,100) + & + .570_r8*rxt(k,459)*y(k,6) +.570_r8*rxt(k,462)*y(k,116))*y(k,140) & + + (rxt(k,275)*y(k,44) +.470_r8*rxt(k,354)*y(k,246) + & + rxt(k,388)*y(k,244) +rxt(k,394)*y(k,245) +rxt(k,402)*y(k,103) + & + rxt(k,413)*y(k,260))*y(k,131) + (.470_r8*rxt(k,351)*y(k,246) + & + rxt(k,384)*y(k,244) +rxt(k,389)*y(k,245) +rxt(k,398)*y(k,103) + & + rxt(k,409)*y(k,260))*y(k,236) + (rxt(k,194)*y(k,44) + & + rxt(k,197)*y(k,81) +rxt(k,259)*y(k,45) +rxt(k,262)*y(k,48))*y(k,58) & + + (.070_r8*rxt(k,429)*y(k,238) +.160_r8*rxt(k,432)*y(k,247) + & + .330_r8*rxt(k,435)*y(k,249))*y(k,242) + (rxt(k,230)*y(k,19) + & + rxt(k,276)*y(k,139))*y(k,44) + (rxt(k,11) +rxt(k,192))*y(k,92) & + + (.660_r8*rxt(k,50) +1.340_r8*rxt(k,51))*y(k,111) + (rxt(k,318) + & + rxt(k,319))*y(k,240) +rxt(k,19)*y(k,1) +.900_r8*rxt(k,20)*y(k,2) & + +rxt(k,21)*y(k,10) +1.500_r8*rxt(k,22)*y(k,11) +.560_r8*rxt(k,23) & + *y(k,12) +rxt(k,24)*y(k,13) +.600_r8*rxt(k,25)*y(k,14) & + +.600_r8*rxt(k,26)*y(k,15) +rxt(k,27)*y(k,16) +rxt(k,28)*y(k,25) & + +rxt(k,29)*y(k,29) +rxt(k,30)*y(k,32) +rxt(k,34)*y(k,47) +rxt(k,36) & + *y(k,51) +rxt(k,291)*y(k,252)*y(k,56) +2.000_r8*rxt(k,43)*y(k,76) & + +2.000_r8*rxt(k,44)*y(k,77) +rxt(k,157)*y(k,78) +rxt(k,153)*y(k,139) & + *y(k,81) +.670_r8*rxt(k,45)*y(k,95) +rxt(k,46)*y(k,96) +rxt(k,47) & + *y(k,97) +rxt(k,48)*y(k,104) +rxt(k,49)*y(k,106) +rxt(k,56)*y(k,123) & + +rxt(k,61)*y(k,149) +rxt(k,62)*y(k,154) +rxt(k,64)*y(k,212) & + +rxt(k,65)*y(k,213) +rxt(k,66)*y(k,214) +rxt(k,67)*y(k,215) & + +rxt(k,68)*y(k,216) +1.200_r8*rxt(k,69)*y(k,217) +rxt(k,70)*y(k,218) & + +rxt(k,72)*y(k,223) +rxt(k,73)*y(k,226) & + +1.200_r8*rxt(k,299)*y(k,233)*y(k,233) +rxt(k,288)*y(k,243) & + +rxt(k,392)*y(k,245) + loss(k,159) = (rxt(k,289)* y(k,129) +rxt(k,287)* y(k,242) + rxt(k,288) & + + het_rates(k,243))* y(k,243) + prod(k,159) =rxt(k,274)*y(k,242)*y(k,44) + loss(k,236) = (rxt(k,387)* y(k,129) +rxt(k,388)* y(k,131) +rxt(k,384) & + * y(k,236) +rxt(k,385)* y(k,237) +rxt(k,386)* y(k,242) & + + het_rates(k,244))* y(k,244) + prod(k,236) =.600_r8*rxt(k,405)*y(k,253)*y(k,100) + loss(k,237) = (rxt(k,393)* y(k,129) +rxt(k,394)* y(k,131) +rxt(k,389) & + * y(k,236) +rxt(k,390)* y(k,237) +rxt(k,391)* y(k,242) + rxt(k,392) & + + het_rates(k,245))* y(k,245) + prod(k,237) =.400_r8*rxt(k,405)*y(k,253)*y(k,100) + loss(k,238) = ((rxt(k,355) +rxt(k,356))* y(k,129) +rxt(k,354)* y(k,131) & + +rxt(k,351)* y(k,236) +rxt(k,352)* y(k,237) +rxt(k,353)* y(k,242) & + + het_rates(k,246))* y(k,246) + prod(k,238) = (.500_r8*rxt(k,358)*y(k,111) +.200_r8*rxt(k,359)*y(k,112) + & + rxt(k,372)*y(k,118))*y(k,253) + loss(k,193) = (rxt(k,433)* y(k,129) +rxt(k,434)* y(k,130) +rxt(k,432) & + * y(k,242) + het_rates(k,247))* y(k,247) + prod(k,193) =.600_r8*rxt(k,24)*y(k,13) + loss(k,240) = (rxt(k,364)* y(k,129) +rxt(k,373)* y(k,130) +rxt(k,365) & + * y(k,131) +rxt(k,360)* y(k,236) +rxt(k,361)* y(k,237) +rxt(k,362) & + * y(k,242) + 2._r8*rxt(k,363)* y(k,248) + het_rates(k,248))* y(k,248) + prod(k,240) = (.660_r8*rxt(k,51) +.500_r8*rxt(k,358)*y(k,253))*y(k,111) & + + (rxt(k,54) +rxt(k,374))*y(k,115) +.500_r8*rxt(k,359)*y(k,253) & + *y(k,112) + loss(k,210) = (rxt(k,436)* y(k,129) +rxt(k,437)* y(k,130) +rxt(k,435) & + * y(k,242) + het_rates(k,249))* y(k,249) + prod(k,210) =.600_r8*rxt(k,26)*y(k,15) + loss(k,187) = (rxt(k,367)* y(k,129) +rxt(k,366)* y(k,242) + het_rates(k,250)) & + * y(k,250) + prod(k,187) = (rxt(k,368)*y(k,113) +rxt(k,369)*y(k,114))*y(k,253) + loss(k,223) = (rxt(k,466)* y(k,129) +rxt(k,467)* y(k,131) +rxt(k,464) & + * y(k,237) +rxt(k,465)* y(k,242) + het_rates(k,251))* y(k,251) + prod(k,223) = (rxt(k,458)*y(k,6) +rxt(k,461)*y(k,116) + & + .500_r8*rxt(k,478)*y(k,216))*y(k,131) +rxt(k,468)*y(k,253)*y(k,133) + loss(k,250) = (rxt(k,219)* y(k,35) +rxt(k,220)* y(k,36) +rxt(k,246)* y(k,37) & + +rxt(k,221)* y(k,38) +rxt(k,222)* y(k,39) +rxt(k,223)* y(k,40) & + +rxt(k,224)* y(k,41) +rxt(k,225)* y(k,42) +rxt(k,269)* y(k,43) & + +rxt(k,270)* y(k,45) + (rxt(k,290) +rxt(k,291) +rxt(k,292))* y(k,56) & + +rxt(k,247)* y(k,57) +rxt(k,255)* y(k,66) +rxt(k,256)* y(k,67) & + +rxt(k,144)* y(k,79) +rxt(k,248)* y(k,80) + (rxt(k,249) +rxt(k,250)) & + * y(k,83) +rxt(k,271)* y(k,84) +rxt(k,272)* y(k,85) +rxt(k,273) & + * y(k,86) + (rxt(k,226) +rxt(k,227))* y(k,87) +rxt(k,293)* y(k,88) & + + (rxt(k,186) +rxt(k,187))* y(k,120) +rxt(k,148)* y(k,140) & + +rxt(k,145)* y(k,263) + rxt(k,146) + rxt(k,147) + het_rates(k,252)) & + * y(k,252) + prod(k,250) =rxt(k,12)*y(k,120) +rxt(k,7)*y(k,140) +rxt(k,1)*y(k,263) + loss(k,251) = (rxt(k,375)* y(k,1) +rxt(k,379)* y(k,2) +rxt(k,460)* y(k,6) & + +rxt(k,417)* y(k,8) +rxt(k,420)* y(k,10) +rxt(k,380)* y(k,17) & + +rxt(k,347)* y(k,18) +rxt(k,242)* y(k,21) +rxt(k,421)* y(k,24) & + +rxt(k,423)* y(k,25) +rxt(k,296)* y(k,26) +rxt(k,323)* y(k,27) & + +rxt(k,303)* y(k,28) +rxt(k,304)* y(k,29) +rxt(k,306)* y(k,30) & + +rxt(k,344)* y(k,31) +rxt(k,331)* y(k,32) +rxt(k,332)* y(k,33) & + +rxt(k,427)* y(k,34) +rxt(k,258)* y(k,43) +rxt(k,277)* y(k,44) & + +rxt(k,260)* y(k,45) +rxt(k,261)* y(k,46) +rxt(k,308)* y(k,47) & + +rxt(k,263)* y(k,48) +rxt(k,309)* y(k,49) +rxt(k,345)* y(k,50) & + +rxt(k,334)* y(k,51) +rxt(k,314)* y(k,52) +rxt(k,315)* y(k,53) & + +rxt(k,282)* y(k,54) +rxt(k,283)* y(k,55) +rxt(k,284)* y(k,56) & + +rxt(k,265)* y(k,57) + (rxt(k,212) +rxt(k,213))* y(k,61) +rxt(k,210) & + * y(k,62) +rxt(k,294)* y(k,64) +rxt(k,428)* y(k,68) + (rxt(k,482) + & + rxt(k,496))* y(k,69) +rxt(k,320)* y(k,76) +rxt(k,321)* y(k,77) & + +rxt(k,161)* y(k,79) +rxt(k,162)* y(k,81) +rxt(k,244)* y(k,83) & + +rxt(k,266)* y(k,84) +rxt(k,267)* y(k,85) +rxt(k,268)* y(k,86) & + +rxt(k,215)* y(k,87) +rxt(k,285)* y(k,88) +rxt(k,286)* y(k,89) & + +rxt(k,191)* y(k,91) +rxt(k,169)* y(k,92) +rxt(k,218)* y(k,94) & + +rxt(k,350)* y(k,95) +rxt(k,381)* y(k,96) +rxt(k,335)* y(k,97) & + +rxt(k,382)* y(k,98) +rxt(k,383)* y(k,99) +rxt(k,405)* y(k,100) & + +rxt(k,395)* y(k,101) +rxt(k,396)* y(k,102) +rxt(k,403)* y(k,104) & + +rxt(k,406)* y(k,106) +rxt(k,358)* y(k,111) +rxt(k,359)* y(k,112) & + +rxt(k,368)* y(k,113) +rxt(k,369)* y(k,114) +rxt(k,370)* y(k,115) & + +rxt(k,463)* y(k,116) +rxt(k,372)* y(k,118) +rxt(k,182)* y(k,119) & + +rxt(k,407)* y(k,122) +rxt(k,408)* y(k,123) +rxt(k,498)* y(k,127) & + +rxt(k,190)* y(k,130) +rxt(k,181)* y(k,131) +rxt(k,336)* y(k,132) & + +rxt(k,468)* y(k,133) +rxt(k,164)* y(k,139) +rxt(k,165)* y(k,140) & + +rxt(k,484)* y(k,143) +rxt(k,322)* y(k,145) +rxt(k,440)* y(k,148) & + +rxt(k,443)* y(k,149) +rxt(k,339)* y(k,154) +rxt(k,343)* y(k,155) & + +rxt(k,490)* y(k,156) +rxt(k,495)* y(k,158) +rxt(k,486)* y(k,159) & + +rxt(k,472)* y(k,213) +rxt(k,473)* y(k,214) +rxt(k,477)* y(k,215) & + +rxt(k,479)* y(k,216) +rxt(k,480)* y(k,217) +rxt(k,447)* y(k,218) & + +rxt(k,448)* y(k,219) +rxt(k,414)* y(k,221) +rxt(k,450)* y(k,222) & + +rxt(k,453)* y(k,223) +rxt(k,456)* y(k,225) +rxt(k,457)* y(k,226) & + +rxt(k,163)* y(k,242) + 2._r8*(rxt(k,166) +rxt(k,167))* y(k,253) & + + het_rates(k,253))* y(k,253) + prod(k,251) = (2.000_r8*rxt(k,155)*y(k,78) +rxt(k,158)*y(k,139) + & + rxt(k,159)*y(k,140) +rxt(k,178)*y(k,131) +rxt(k,183)*y(k,129) + & + rxt(k,199)*y(k,58) +.450_r8*rxt(k,312)*y(k,236) + & + .150_r8*rxt(k,341)*y(k,256) +.450_r8*rxt(k,362)*y(k,248) + & + .200_r8*rxt(k,366)*y(k,250) +.400_r8*rxt(k,415)*y(k,229) + & + .400_r8*rxt(k,429)*y(k,238) +.400_r8*rxt(k,435)*y(k,249))*y(k,242) & + + (rxt(k,160)*y(k,78) +.130_r8*rxt(k,298)*y(k,27) + & + .360_r8*rxt(k,327)*y(k,31) +.240_r8*rxt(k,357)*y(k,111) + & + .360_r8*rxt(k,371)*y(k,118) +.320_r8*rxt(k,404)*y(k,100) + & + .630_r8*rxt(k,459)*y(k,6) +.630_r8*rxt(k,462)*y(k,116))*y(k,140) & + + (rxt(k,152)*y(k,79) +rxt(k,153)*y(k,81) +rxt(k,214)*y(k,87) + & + rxt(k,217)*y(k,94) +rxt(k,243)*y(k,83) +rxt(k,245)*y(k,93) + & + rxt(k,276)*y(k,44))*y(k,139) + (.300_r8*rxt(k,283)*y(k,55) + & + .650_r8*rxt(k,296)*y(k,26) +.500_r8*rxt(k,304)*y(k,29) + & + .500_r8*rxt(k,339)*y(k,154) +.100_r8*rxt(k,359)*y(k,112) + & + .600_r8*rxt(k,406)*y(k,106) +.500_r8*rxt(k,414)*y(k,221))*y(k,253) & + + (rxt(k,144)*y(k,79) +2.000_r8*rxt(k,145)*y(k,263) + & + rxt(k,226)*y(k,87) +rxt(k,249)*y(k,83) +rxt(k,290)*y(k,56) + & + rxt(k,293)*y(k,88))*y(k,252) + (rxt(k,2) +rxt(k,253)*y(k,75)) & + *y(k,263) +rxt(k,20)*y(k,2) +rxt(k,21)*y(k,10) +rxt(k,28)*y(k,25) & + +rxt(k,29)*y(k,29) +rxt(k,30)*y(k,32) +rxt(k,31)*y(k,34) +rxt(k,37) & + *y(k,53) +rxt(k,38)*y(k,55) +.330_r8*rxt(k,39)*y(k,56) +rxt(k,42) & + *y(k,74) +2.000_r8*rxt(k,4)*y(k,81) +rxt(k,9)*y(k,91) +rxt(k,10) & + *y(k,92) +rxt(k,105)*y(k,93) +rxt(k,106)*y(k,94) +rxt(k,46)*y(k,96) & + +rxt(k,49)*y(k,106) +rxt(k,53)*y(k,114) +.500_r8*rxt(k,507)*y(k,130) & + +rxt(k,58)*y(k,133) +rxt(k,61)*y(k,149) +rxt(k,62)*y(k,154) & + +rxt(k,63)*y(k,155) +rxt(k,65)*y(k,213) +rxt(k,67)*y(k,215) & + +rxt(k,70)*y(k,218) +rxt(k,71)*y(k,221) +rxt(k,72)*y(k,223) & + +rxt(k,73)*y(k,226) + loss(k,160) = (rxt(k,439)* y(k,129) +rxt(k,438)* y(k,242) + het_rates(k,254)) & + * y(k,254) + prod(k,160) = (.200_r8*rxt(k,428)*y(k,68) +.140_r8*rxt(k,440)*y(k,148) + & + rxt(k,443)*y(k,149))*y(k,253) + loss(k,198) = (rxt(k,338)* y(k,129) +rxt(k,337)* y(k,242) + het_rates(k,255)) & + * y(k,255) + prod(k,198) = (.500_r8*rxt(k,339)*y(k,154) +rxt(k,344)*y(k,31))*y(k,253) + loss(k,230) = (rxt(k,342)* y(k,129) +rxt(k,340)* y(k,237) +rxt(k,341) & + * y(k,242) + het_rates(k,256))* y(k,256) + prod(k,230) = (rxt(k,343)*y(k,155) +rxt(k,345)*y(k,50) + & + .150_r8*rxt(k,480)*y(k,217))*y(k,253) + (.060_r8*rxt(k,459)*y(k,6) + & + .060_r8*rxt(k,462)*y(k,116))*y(k,140) +.150_r8*rxt(k,69)*y(k,217) + loss(k,228) = (rxt(k,471)* y(k,129) +rxt(k,469)* y(k,237) +rxt(k,470) & + * y(k,242) + het_rates(k,257))* y(k,257) + prod(k,228) = (.500_r8*rxt(k,478)*y(k,131) +rxt(k,479)*y(k,253))*y(k,216) & + +rxt(k,472)*y(k,253)*y(k,213) + loss(k,229) = (rxt(k,476)* y(k,129) +rxt(k,474)* y(k,237) +rxt(k,475) & + * y(k,242) + het_rates(k,258))* y(k,258) + prod(k,229) = (rxt(k,460)*y(k,6) +rxt(k,463)*y(k,116) +rxt(k,477)*y(k,215)) & + *y(k,253) + loss(k,194) = (rxt(k,446)* y(k,129) +rxt(k,445)* y(k,242) + het_rates(k,259)) & + * y(k,259) + prod(k,194) = (rxt(k,447)*y(k,218) +.650_r8*rxt(k,448)*y(k,219))*y(k,253) + loss(k,231) = (rxt(k,412)* y(k,129) +rxt(k,413)* y(k,131) +rxt(k,409) & + * y(k,236) +rxt(k,410)* y(k,237) +rxt(k,411)* y(k,242) & + + het_rates(k,260))* y(k,260) + prod(k,231) = (rxt(k,381)*y(k,96) +rxt(k,382)*y(k,98) +rxt(k,383)*y(k,99) + & + .400_r8*rxt(k,406)*y(k,106) +.500_r8*rxt(k,414)*y(k,221))*y(k,253) + loss(k,196) = (rxt(k,452)* y(k,129) +rxt(k,451)* y(k,242) + het_rates(k,261)) & + * y(k,261) + prod(k,196) = (.560_r8*rxt(k,450)*y(k,222) +rxt(k,453)*y(k,223))*y(k,253) + loss(k,167) = (rxt(k,455)* y(k,129) +rxt(k,454)* y(k,242) + het_rates(k,262)) & + * y(k,262) + prod(k,167) = (.300_r8*rxt(k,456)*y(k,225) +rxt(k,457)*y(k,226))*y(k,253) + loss(k,261) = (rxt(k,253)* y(k,75) +rxt(k,497)* y(k,160) +rxt(k,145) & + * y(k,252) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,263)) & + * y(k,263) + prod(k,261) = (rxt(k,161)*y(k,79) +rxt(k,162)*y(k,81) +rxt(k,163)*y(k,242) + & + rxt(k,166)*y(k,253) +rxt(k,169)*y(k,92) +rxt(k,191)*y(k,91) + & + rxt(k,215)*y(k,87) +rxt(k,218)*y(k,94) +rxt(k,244)*y(k,83) + & + rxt(k,258)*y(k,43) +rxt(k,260)*y(k,45) +rxt(k,261)*y(k,46) + & + rxt(k,263)*y(k,48) +rxt(k,268)*y(k,86) +rxt(k,277)*y(k,44) + & + rxt(k,283)*y(k,55) +rxt(k,284)*y(k,56) +rxt(k,286)*y(k,89) + & + rxt(k,306)*y(k,30) +rxt(k,308)*y(k,47) +rxt(k,314)*y(k,52) + & + rxt(k,315)*y(k,53) +rxt(k,331)*y(k,32) +rxt(k,332)*y(k,33) + & + rxt(k,334)*y(k,51) +rxt(k,339)*y(k,154) +rxt(k,343)*y(k,155) + & + rxt(k,345)*y(k,50) +.500_r8*rxt(k,358)*y(k,111) +rxt(k,498)*y(k,127)) & + *y(k,253) + (rxt(k,546)*y(k,94) +rxt(k,552)*y(k,94) + & + rxt(k,553)*y(k,93) +rxt(k,557)*y(k,94) +rxt(k,558)*y(k,93))*y(k,87) & + +.050_r8*rxt(k,39)*y(k,56) +rxt(k,156)*y(k,242)*y(k,78) +rxt(k,109) & + *y(k,82) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_trop_strat_mam5_vbsext/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..3b5c9b99e9 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_rxt_rates_conv.F90 @@ -0,0 +1,574 @@ +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,:, 263) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 263) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 263) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 81) ! rate_const*H2O2 + ! rate_const*O2 + ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 140) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 140) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 91) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 92) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 92) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 120) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 129) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 130) ! rate_const*NO2 + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 131) ! rate_const*NO3 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 131) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 1) ! rate_const*ALKNIT + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 2) ! rate_const*ALKOOH + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 10) ! rate_const*BENZOOH + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 11) ! rate_const*BEPOMUC + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 12) ! rate_const*BIGALD + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 13) ! rate_const*BIGALD1 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 14) ! rate_const*BIGALD2 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 15) ! rate_const*BIGALD3 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 16) ! rate_const*BIGALD4 + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 25) ! rate_const*BZOOH + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 29) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 32) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 34) ! rate_const*C6H5OOH + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 44) ! rate_const*CH2O + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 44) ! rate_const*CH2O + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 47) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 50) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 51) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 53) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 55) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 56) ! rate_const*CH4 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 56) ! rate_const*CH4 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 65) ! rate_const*CO2 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 74) ! rate_const*EOOH + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 76) ! rate_const*GLYALD + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 77) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 95) ! rate_const*HONITR + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 96) ! rate_const*HPALD + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 97) ! rate_const*HYAC + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 104) ! rate_const*ISOPNOOH + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 106) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 111) ! rate_const*MACR + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 111) ! rate_const*MACR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 113) ! rate_const*MEK + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 114) ! rate_const*MEKOOH + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 115) ! rate_const*MPAN + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 118) ! rate_const*MVK + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 123) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 132) ! rate_const*NOA + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 133) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 144) ! rate_const*ONITR + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 145) ! rate_const*PAN + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 149) ! rate_const*PHENOOH + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 154) ! rate_const*POOH + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 155) ! rate_const*ROOH + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 212) ! rate_const*TEPOMUC + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 213) ! rate_const*TERP2OOH + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 214) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 215) ! rate_const*TERPOOH + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 216) ! rate_const*TERPROD1 + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 217) ! rate_const*TERPROD2 + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 218) ! rate_const*TOLOOH + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 221) ! rate_const*XOOH + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 223) ! rate_const*XYLENOOH + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 226) ! rate_const*XYLOLOOH + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 20) ! rate_const*BRCL + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 21) ! rate_const*BRO + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 35) ! rate_const*CCL4 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 36) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 37) ! rate_const*CF3BR + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 38) ! rate_const*CFC11 + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 39) ! rate_const*CFC113 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 40) ! rate_const*CFC114 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 41) ! rate_const*CFC115 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 42) ! rate_const*CFC12 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 43) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 45) ! rate_const*CH3BR + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 46) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 48) ! rate_const*CH3CL + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 57) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 59) ! rate_const*CL2 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 60) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 61) ! rate_const*CLO + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 66) ! rate_const*COF2 + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 67) ! rate_const*COFCL + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 80) ! rate_const*H2402 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 83) ! rate_const*HBR + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 84) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 85) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 86) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 87) ! rate_const*HCL + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 90) ! rate_const*HF + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 93) ! rate_const*HOBR + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 94) ! rate_const*HOCL + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 142) ! rate_const*OCLO + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 157) ! rate_const*SF6 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 82) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 143) ! rate_const*OCS + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 158) ! rate_const*SO + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 159) ! rate_const*SO2 + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 160) ! rate_const*SO3 + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 165) ! rate_const*soabb1_a1 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 166) ! rate_const*soabb1_a2 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 167) ! rate_const*soabb2_a1 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 168) ! rate_const*soabb2_a2 + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 169) ! rate_const*soabb3_a1 + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 170) ! rate_const*soabb3_a2 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 171) ! rate_const*soabb4_a1 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 172) ! rate_const*soabb4_a2 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 173) ! rate_const*soabb5_a1 + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 174) ! rate_const*soabb5_a2 + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 175) ! rate_const*soabg1_a1 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 176) ! rate_const*soabg1_a2 + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 177) ! rate_const*soabg2_a1 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 178) ! rate_const*soabg2_a2 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 179) ! rate_const*soabg3_a1 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 180) ! rate_const*soabg3_a2 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 181) ! rate_const*soabg4_a1 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 182) ! rate_const*soabg4_a2 + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 183) ! rate_const*soabg5_a1 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 184) ! rate_const*soabg5_a2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 185) ! rate_const*soaff1_a1 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 186) ! rate_const*soaff1_a2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 187) ! rate_const*soaff2_a1 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 188) ! rate_const*soaff2_a2 + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 189) ! rate_const*soaff3_a1 + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 190) ! rate_const*soaff3_a2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 191) ! rate_const*soaff4_a1 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 192) ! rate_const*soaff4_a2 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 193) ! rate_const*soaff5_a1 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 194) ! rate_const*soaff5_a2 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 252)*sol(:ncol,:, 79) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 252)*sol(:ncol,:, 263) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 252) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 252) ! rate_const*O2*O1D + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 252)*sol(:ncol,:, 140) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 139)*sol(:ncol,:, 140) ! rate_const*O*O3 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 139)*sol(:ncol,:, 139) ! rate_const*M*O*O + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 139) ! rate_const*O2*M*O + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 79)*sol(:ncol,:, 139) ! rate_const*H2*O + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 81)*sol(:ncol,:, 139) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 78)*sol(:ncol,:, 242) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 78)*sol(:ncol,:, 242) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 78)*sol(:ncol,:, 242) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 78) ! rate_const*O2*M*H + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 242)*sol(:ncol,:, 139) ! rate_const*HO2*O + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 242)*sol(:ncol,:, 140) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 78)*sol(:ncol,:, 140) ! rate_const*H*O3 + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 253)*sol(:ncol,:, 79) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 253)*sol(:ncol,:, 81) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 253)*sol(:ncol,:, 242) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 253)*sol(:ncol,:, 139) ! rate_const*OH*O + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 253)*sol(:ncol,:, 140) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 253)*sol(:ncol,:, 253) ! rate_const*OH*OH + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 253)*sol(:ncol,:, 253) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 242)*sol(:ncol,:, 242) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 92)*sol(:ncol,:, 253) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 119)*sol(:ncol,:, 129) ! rate_const*N*NO + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 119)*sol(:ncol,:, 130) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 119)*sol(:ncol,:, 130) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 119)*sol(:ncol,:, 130) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 119) ! rate_const*O2*N + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 130)*sol(:ncol,:, 139) ! rate_const*NO2*O + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 130)*sol(:ncol,:, 140) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 130)*sol(:ncol,:, 139) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 131)*sol(:ncol,:, 242) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 131)*sol(:ncol,:, 129) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 131)*sol(:ncol,:, 139) ! rate_const*NO3*O + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 131)*sol(:ncol,:, 253) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 119)*sol(:ncol,:, 253) ! rate_const*N*OH + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 129)*sol(:ncol,:, 242) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 129)*sol(:ncol,:, 140) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 129)*sol(:ncol,:, 139) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 252)*sol(:ncol,:, 120) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 252)*sol(:ncol,:, 120) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 130)*sol(:ncol,:, 242) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 130)*sol(:ncol,:, 131) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 130)*sol(:ncol,:, 253) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 91)*sol(:ncol,:, 253) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 92) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 121) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 58)*sol(:ncol,:, 44) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 58)*sol(:ncol,:, 56) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 58)*sol(:ncol,:, 79) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 58)*sol(:ncol,:, 81) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 58)*sol(:ncol,:, 242) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 58)*sol(:ncol,:, 242) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 58)*sol(:ncol,:, 140) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 61)*sol(:ncol,:, 237) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 61)*sol(:ncol,:, 242) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 61)*sol(:ncol,:, 129) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 62)*sol(:ncol,:, 58) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 61)*sol(:ncol,:, 130) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 62)*sol(:ncol,:, 139) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 62)*sol(:ncol,:, 253) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 61)*sol(:ncol,:, 139) ! rate_const*CLO*O + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 61)*sol(:ncol,:, 253) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 61)*sol(:ncol,:, 253) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 87)*sol(:ncol,:, 139) ! rate_const*HCL*O + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 87)*sol(:ncol,:, 253) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 94)*sol(:ncol,:, 58) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 94)*sol(:ncol,:, 139) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 94)*sol(:ncol,:, 253) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 252)*sol(:ncol,:, 35) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 252)*sol(:ncol,:, 36) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 252)*sol(:ncol,:, 38) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 252)*sol(:ncol,:, 39) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 252)*sol(:ncol,:, 40) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 252)*sol(:ncol,:, 41) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 252)*sol(:ncol,:, 42) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 252)*sol(:ncol,:, 87) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 252)*sol(:ncol,:, 87) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 60) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 19)*sol(:ncol,:, 44) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 19)*sol(:ncol,:, 242) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 19)*sol(:ncol,:, 140) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 21)*sol(:ncol,:, 21) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 21)*sol(:ncol,:, 242) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 21)*sol(:ncol,:, 129) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 21)*sol(:ncol,:, 130) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 22)*sol(:ncol,:, 139) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 21)*sol(:ncol,:, 139) ! rate_const*BRO*O + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 21)*sol(:ncol,:, 253) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 83)*sol(:ncol,:, 139) ! rate_const*HBR*O + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 83)*sol(:ncol,:, 253) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 93)*sol(:ncol,:, 139) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 252)*sol(:ncol,:, 37) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 252)*sol(:ncol,:, 57) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 252)*sol(:ncol,:, 80) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 252)*sol(:ncol,:, 83) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 252)*sol(:ncol,:, 83) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 75)*sol(:ncol,:, 56) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 75)*sol(:ncol,:, 79) ! rate_const*F*H2 + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 75)*sol(:ncol,:, 263) ! rate_const*F*H2O + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 75)*sol(:ncol,:, 91) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 252)*sol(:ncol,:, 66) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 252)*sol(:ncol,:, 67) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 43)*sol(:ncol,:, 58) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 43)*sol(:ncol,:, 253) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 45)*sol(:ncol,:, 58) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 45)*sol(:ncol,:, 253) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 46)*sol(:ncol,:, 253) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 48)*sol(:ncol,:, 58) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 48)*sol(:ncol,:, 253) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 57)*sol(:ncol,:, 58) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 57)*sol(:ncol,:, 253) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 84)*sol(:ncol,:, 253) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 85)*sol(:ncol,:, 253) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 86)*sol(:ncol,:, 253) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 252)*sol(:ncol,:, 43) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 252)*sol(:ncol,:, 45) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 252)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 252)*sol(:ncol,:, 85) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 252)*sol(:ncol,:, 86) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 44)*sol(:ncol,:, 242) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 44)*sol(:ncol,:, 131) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 44)*sol(:ncol,:, 139) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 44)*sol(:ncol,:, 253) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 237)*sol(:ncol,:, 237) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 237)*sol(:ncol,:, 237) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 237)*sol(:ncol,:, 242) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 237)*sol(:ncol,:, 129) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 54)*sol(:ncol,:, 253) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 55)*sol(:ncol,:, 253) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 56)*sol(:ncol,:, 253) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 88)*sol(:ncol,:, 253) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 89)*sol(:ncol,:, 253) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 243)*sol(:ncol,:, 242) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 243) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 243)*sol(:ncol,:, 129) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 252)*sol(:ncol,:, 56) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 252)*sol(:ncol,:, 56) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 252)*sol(:ncol,:, 56) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 252)*sol(:ncol,:, 88) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 64)*sol(:ncol,:, 253) ! rate_const*CO*OH + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 26)*sol(:ncol,:, 58) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 26)*sol(:ncol,:, 253) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 27)*sol(:ncol,:, 58) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 27)*sol(:ncol,:, 140) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 233)*sol(:ncol,:, 233) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 233)*sol(:ncol,:, 237) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 233)*sol(:ncol,:, 242) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 233)*sol(:ncol,:, 129) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 28)*sol(:ncol,:, 253) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 29)*sol(:ncol,:, 253) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 30)*sol(:ncol,:, 58) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 30)*sol(:ncol,:, 253) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 47)*sol(:ncol,:, 131) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 47)*sol(:ncol,:, 253) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 49)*sol(:ncol,:, 253) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 236)*sol(:ncol,:, 236) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 236)*sol(:ncol,:, 237) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 236)*sol(:ncol,:, 242) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 236)*sol(:ncol,:, 129) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 52)*sol(:ncol,:, 253) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 53)*sol(:ncol,:, 253) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 241)*sol(:ncol,:, 242) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 241)*sol(:ncol,:, 129) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 240) ! rate_const*EO + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 240) ! rate_const*O2*EO + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 76)*sol(:ncol,:, 253) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 77)*sol(:ncol,:, 253) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 145)*sol(:ncol,:, 253) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 27)*sol(:ncol,:, 253) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 236)*sol(:ncol,:, 130) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 145) ! rate_const*M*PAN + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 31)*sol(:ncol,:, 131) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 31)*sol(:ncol,:, 140) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 234)*sol(:ncol,:, 237) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 234)*sol(:ncol,:, 242) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 234)*sol(:ncol,:, 129) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 32)*sol(:ncol,:, 253) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 33)*sol(:ncol,:, 253) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 51)*sol(:ncol,:, 131) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 51)*sol(:ncol,:, 253) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 97)*sol(:ncol,:, 253) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 132)*sol(:ncol,:, 253) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 255)*sol(:ncol,:, 242) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 255)*sol(:ncol,:, 129) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 154)*sol(:ncol,:, 253) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 256)*sol(:ncol,:, 237) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 256)*sol(:ncol,:, 242) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 256)*sol(:ncol,:, 129) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 155)*sol(:ncol,:, 253) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 31)*sol(:ncol,:, 253) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 50)*sol(:ncol,:, 253) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 18)*sol(:ncol,:, 131) ! rate_const*BIGENE*NO3 + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 18)*sol(:ncol,:, 253) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 239)*sol(:ncol,:, 129) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 239)*sol(:ncol,:, 129) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 95)*sol(:ncol,:, 253) ! rate_const*HONITR*OH + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 246)*sol(:ncol,:, 236) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 246)*sol(:ncol,:, 237) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 246)*sol(:ncol,:, 242) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 246)*sol(:ncol,:, 131) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 246)*sol(:ncol,:, 129) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 246)*sol(:ncol,:, 129) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 111)*sol(:ncol,:, 140) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 111)*sol(:ncol,:, 253) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 112)*sol(:ncol,:, 253) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 248)*sol(:ncol,:, 236) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 248)*sol(:ncol,:, 237) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 248)*sol(:ncol,:, 242) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 248)*sol(:ncol,:, 248) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 248)*sol(:ncol,:, 129) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 248)*sol(:ncol,:, 131) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 250)*sol(:ncol,:, 242) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 250)*sol(:ncol,:, 129) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 113)*sol(:ncol,:, 253) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 114)*sol(:ncol,:, 253) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 115)*sol(:ncol,:, 253) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 118)*sol(:ncol,:, 140) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 118)*sol(:ncol,:, 253) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 248)*sol(:ncol,:, 130) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 115) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 1)*sol(:ncol,:, 253) ! rate_const*ALKNIT*OH + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 230)*sol(:ncol,:, 242) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 230)*sol(:ncol,:, 129) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 230)*sol(:ncol,:, 129) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 2)*sol(:ncol,:, 253) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 17)*sol(:ncol,:, 253) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 96)*sol(:ncol,:, 253) ! rate_const*HPALD*OH + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 98)*sol(:ncol,:, 253) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 99)*sol(:ncol,:, 253) ! rate_const*IEPOX*OH + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 244)*sol(:ncol,:, 236) ! rate_const*ISOPAO2*CH3CO3 + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 244)*sol(:ncol,:, 237) ! rate_const*ISOPAO2*CH3O2 + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 244)*sol(:ncol,:, 242) ! rate_const*ISOPAO2*HO2 + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 244)*sol(:ncol,:, 129) ! rate_const*ISOPAO2*NO + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 244)*sol(:ncol,:, 131) ! rate_const*ISOPAO2*NO3 + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 245)*sol(:ncol,:, 236) ! rate_const*ISOPBO2*CH3CO3 + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 245)*sol(:ncol,:, 237) ! rate_const*ISOPBO2*CH3O2 + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 245)*sol(:ncol,:, 242) ! rate_const*ISOPBO2*HO2 + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 245) ! rate_const*ISOPBO2 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 245)*sol(:ncol,:, 129) ! rate_const*ISOPBO2*NO + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 245)*sol(:ncol,:, 131) ! rate_const*ISOPBO2*NO3 + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 101)*sol(:ncol,:, 253) ! rate_const*ISOPNITA*OH + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 102)*sol(:ncol,:, 253) ! rate_const*ISOPNITB*OH + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 100)*sol(:ncol,:, 131) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 103)*sol(:ncol,:, 236) ! rate_const*ISOPNO3*CH3CO3 + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 103)*sol(:ncol,:, 237) ! rate_const*ISOPNO3*CH3O2 + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 103)*sol(:ncol,:, 242) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 103)*sol(:ncol,:, 129) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 103)*sol(:ncol,:, 131) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 104)*sol(:ncol,:, 253) ! rate_const*ISOPNOOH*OH + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 100)*sol(:ncol,:, 140) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 100)*sol(:ncol,:, 253) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 106)*sol(:ncol,:, 253) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 122)*sol(:ncol,:, 253) ! rate_const*NC4CH2OH*OH + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 123)*sol(:ncol,:, 253) ! rate_const*NC4CHO*OH + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 260)*sol(:ncol,:, 236) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 260)*sol(:ncol,:, 237) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 260)*sol(:ncol,:, 242) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 260)*sol(:ncol,:, 129) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 260)*sol(:ncol,:, 131) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 221)*sol(:ncol,:, 253) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 229)*sol(:ncol,:, 242) ! rate_const*ACBZO2*HO2 + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 229)*sol(:ncol,:, 129) ! rate_const*ACBZO2*NO + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 8)*sol(:ncol,:, 253) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 231)*sol(:ncol,:, 242) ! rate_const*BENZO2*HO2 + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 231)*sol(:ncol,:, 129) ! rate_const*BENZO2*NO + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 10)*sol(:ncol,:, 253) ! rate_const*BENZOOH*OH + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 24)*sol(:ncol,:, 253) ! rate_const*BZALD*OH + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 232)*sol(:ncol,:, 242) ! rate_const*BZOO*HO2 + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 25)*sol(:ncol,:, 253) ! rate_const*BZOOH*OH + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 232)*sol(:ncol,:, 129) ! rate_const*BZOO*NO + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 235)*sol(:ncol,:, 242) ! rate_const*C6H5O2*HO2 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 235)*sol(:ncol,:, 129) ! rate_const*C6H5O2*NO + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 34)*sol(:ncol,:, 253) ! rate_const*C6H5OOH*OH + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 68)*sol(:ncol,:, 253) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 238)*sol(:ncol,:, 242) ! rate_const*DICARBO2*HO2 + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 238)*sol(:ncol,:, 129) ! rate_const*DICARBO2*NO + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 238)*sol(:ncol,:, 130) ! rate_const*M*DICARBO2*NO2 + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 247)*sol(:ncol,:, 242) ! rate_const*MALO2*HO2 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 247)*sol(:ncol,:, 129) ! rate_const*MALO2*NO + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 247)*sol(:ncol,:, 130) ! rate_const*M*MALO2*NO2 + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 249)*sol(:ncol,:, 242) ! rate_const*MDIALO2*HO2 + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 249)*sol(:ncol,:, 129) ! rate_const*MDIALO2*NO + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 249)*sol(:ncol,:, 130) ! rate_const*M*MDIALO2*NO2 + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 254)*sol(:ncol,:, 242) ! rate_const*PHENO2*HO2 + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 254)*sol(:ncol,:, 129) ! rate_const*PHENO2*NO + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 148)*sol(:ncol,:, 253) ! rate_const*PHENOL*OH + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 147)*sol(:ncol,:, 130) ! rate_const*PHENO*NO2 + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 147)*sol(:ncol,:, 140) ! rate_const*PHENO*O3 + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 149)*sol(:ncol,:, 253) ! rate_const*PHENOOH*OH + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 229)*sol(:ncol,:, 130) ! rate_const*M*ACBZO2*NO2 + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 259)*sol(:ncol,:, 242) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 259)*sol(:ncol,:, 129) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 218)*sol(:ncol,:, 253) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 219)*sol(:ncol,:, 253) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 146) ! rate_const*M*PBZNIT + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 222)*sol(:ncol,:, 253) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 261)*sol(:ncol,:, 242) ! rate_const*XYLENO2*HO2 + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 261)*sol(:ncol,:, 129) ! rate_const*XYLENO2*NO + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 223)*sol(:ncol,:, 253) ! rate_const*XYLENOOH*OH + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 262)*sol(:ncol,:, 242) ! rate_const*XYLOLO2*HO2 + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 262)*sol(:ncol,:, 129) ! rate_const*XYLOLO2*NO + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 225)*sol(:ncol,:, 253) ! rate_const*XYLOL*OH + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 226)*sol(:ncol,:, 253) ! rate_const*XYLOLOOH*OH + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 6)*sol(:ncol,:, 131) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 6)*sol(:ncol,:, 140) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 6)*sol(:ncol,:, 253) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 116)*sol(:ncol,:, 131) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 116)*sol(:ncol,:, 140) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 116)*sol(:ncol,:, 253) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 251)*sol(:ncol,:, 237) ! rate_const*NTERPO2*CH3O2 + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 251)*sol(:ncol,:, 242) ! rate_const*NTERPO2*HO2 + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 251)*sol(:ncol,:, 129) ! rate_const*NTERPO2*NO + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 251)*sol(:ncol,:, 131) ! rate_const*NTERPO2*NO3 + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 133)*sol(:ncol,:, 253) ! rate_const*NTERPOOH*OH + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 257)*sol(:ncol,:, 237) ! rate_const*TERP2O2*CH3O2 + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 257)*sol(:ncol,:, 242) ! rate_const*TERP2O2*HO2 + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 257)*sol(:ncol,:, 129) ! rate_const*TERP2O2*NO + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 213)*sol(:ncol,:, 253) ! rate_const*TERP2OOH*OH + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 214)*sol(:ncol,:, 253) ! rate_const*TERPNIT*OH + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 258)*sol(:ncol,:, 237) ! rate_const*TERPO2*CH3O2 + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 258)*sol(:ncol,:, 242) ! rate_const*TERPO2*HO2 + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 258)*sol(:ncol,:, 129) ! rate_const*TERPO2*NO + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 215)*sol(:ncol,:, 253) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 216)*sol(:ncol,:, 131) ! rate_const*TERPROD1*NO3 + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 216)*sol(:ncol,:, 253) ! rate_const*TERPROD1*OH + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 217)*sol(:ncol,:, 253) ! rate_const*TERPROD2*OH + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 69)*sol(:ncol,:, 131) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 69)*sol(:ncol,:, 253) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 143)*sol(:ncol,:, 139) ! rate_const*OCS*O + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 143)*sol(:ncol,:, 253) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 156) ! rate_const*O2*S + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 159)*sol(:ncol,:, 253) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 156)*sol(:ncol,:, 140) ! rate_const*S*O3 + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 158)*sol(:ncol,:, 21) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 158)*sol(:ncol,:, 61) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 156)*sol(:ncol,:, 253) ! rate_const*S*OH + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 158)*sol(:ncol,:, 130) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 158) ! rate_const*O2*SO + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 158)*sol(:ncol,:, 140) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 158)*sol(:ncol,:, 142) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 158)*sol(:ncol,:, 253) ! rate_const*SO*OH + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 69)*sol(:ncol,:, 253) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 160)*sol(:ncol,:, 263) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 127)*sol(:ncol,:, 253) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 242) ! rate_const*HO2 + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 95) ! rate_const*HONITR + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 101) ! rate_const*ISOPNITA + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 102) ! rate_const*ISOPNITB + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 122) ! rate_const*NC4CH2OH + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 123) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 128) ! rate_const*NH4 + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 130) ! rate_const*NO2 + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 131) ! rate_const*NO3 + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 133) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 144) ! rate_const*ONITR + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 214) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 6)*sol(:ncol,:, 131) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 7)*sol(:ncol,:, 242) ! rate_const*BCARYO2VBS*HO2 + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 7)*sol(:ncol,:, 129) ! rate_const*BCARYO2VBS*NO + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 6)*sol(:ncol,:, 140) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 6)*sol(:ncol,:, 253) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 8)*sol(:ncol,:, 253) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 9)*sol(:ncol,:, 242) ! rate_const*BENZO2VBS*HO2 + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 9)*sol(:ncol,:, 129) ! rate_const*BENZO2VBS*NO + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 100)*sol(:ncol,:, 131) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 105)*sol(:ncol,:, 242) ! rate_const*ISOPO2VBS*HO2 + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 105)*sol(:ncol,:, 129) ! rate_const*ISOPO2VBS*NO + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 100)*sol(:ncol,:, 140) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 100)*sol(:ncol,:, 253) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 108)*sol(:ncol,:, 242) ! rate_const*IVOCbbO2VBS*HO2 + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 108)*sol(:ncol,:, 129) ! rate_const*IVOCbbO2VBS*NO + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 107)*sol(:ncol,:, 253) ! rate_const*IVOCbb*OH + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 110)*sol(:ncol,:, 242) ! rate_const*IVOCffO2VBS*HO2 + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 110)*sol(:ncol,:, 129) ! rate_const*IVOCffO2VBS*NO + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 109)*sol(:ncol,:, 253) ! rate_const*IVOCff*OH + rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 116)*sol(:ncol,:, 131) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 117)*sol(:ncol,:, 242) ! rate_const*MTERPO2VBS*HO2 + rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 117)*sol(:ncol,:, 129) ! rate_const*MTERPO2VBS*NO + rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 116)*sol(:ncol,:, 140) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 116)*sol(:ncol,:, 253) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 210)*sol(:ncol,:, 253) ! rate_const*SVOCbb*OH + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 211)*sol(:ncol,:, 253) ! rate_const*SVOCff*OH + rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 219)*sol(:ncol,:, 253) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 220)*sol(:ncol,:, 242) ! rate_const*TOLUO2VBS*HO2 + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 220)*sol(:ncol,:, 129) ! rate_const*TOLUO2VBS*NO + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 77) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 222)*sol(:ncol,:, 253) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 224)*sol(:ncol,:, 242) ! rate_const*XYLEO2VBS*HO2 + rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 224)*sol(:ncol,:, 129) ! rate_const*XYLEO2VBS*NO + rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 94)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 62)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 94)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 93)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 62)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 94)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 93)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 62)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 73) ! rate_const*E90 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_trop_strat_mam5_vbsext/mo_setrxt.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_setrxt.F90 new file mode 100644 index 0000000000..4133ccd686 --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_setrxt.F90 @@ -0,0 +1,695 @@ + + 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(:,144) = 1.2e-10_r8 + rate(:,148) = 1.2e-10_r8 + rate(:,154) = 6.9e-12_r8 + rate(:,155) = 7.2e-11_r8 + rate(:,156) = 1.6e-12_r8 + rate(:,162) = 1.8e-12_r8 + rate(:,166) = 1.8e-12_r8 + rate(:,178) = 3.5e-12_r8 + rate(:,180) = 1.3e-11_r8 + rate(:,181) = 2.2e-11_r8 + rate(:,182) = 5e-11_r8 + rate(:,217) = 1.7e-13_r8 + rate(:,219) = 2.607e-10_r8 + rate(:,220) = 9.75e-11_r8 + rate(:,221) = 2.07e-10_r8 + rate(:,222) = 2.088e-10_r8 + rate(:,223) = 1.17e-10_r8 + rate(:,224) = 4.644e-11_r8 + rate(:,225) = 1.204e-10_r8 + rate(:,226) = 9.9e-11_r8 + rate(:,227) = 3.3e-12_r8 + rate(:,246) = 4.5e-11_r8 + rate(:,247) = 4.62e-10_r8 + rate(:,248) = 1.2e-10_r8 + rate(:,249) = 9e-11_r8 + rate(:,250) = 3e-11_r8 + rate(:,255) = 2.14e-11_r8 + rate(:,256) = 1.9e-10_r8 + rate(:,269) = 2.57e-10_r8 + rate(:,270) = 1.8e-10_r8 + rate(:,271) = 1.794e-10_r8 + rate(:,272) = 1.3e-10_r8 + rate(:,273) = 7.65e-11_r8 + rate(:,286) = 4e-13_r8 + rate(:,290) = 1.31e-10_r8 + rate(:,291) = 3.5e-11_r8 + rate(:,292) = 9e-12_r8 + rate(:,299) = 6.8e-14_r8 + rate(:,300) = 2e-13_r8 + rate(:,315) = 1e-12_r8 + rate(:,319) = 1e-14_r8 + rate(:,320) = 1e-11_r8 + rate(:,321) = 1.15e-11_r8 + rate(:,322) = 4e-14_r8 + rate(:,335) = 3e-12_r8 + rate(:,336) = 6.7e-13_r8 + rate(:,346) = 3.5e-13_r8 + rate(:,347) = 5.4e-11_r8 + rate(:,350) = 2e-12_r8 + rate(:,351) = 1.4e-11_r8 + rate(:,354) = 2.4e-12_r8 + rate(:,365) = 5e-12_r8 + rate(:,375) = 1.6e-12_r8 + rate(:,377) = 6.7e-12_r8 + rate(:,380) = 3.5e-12_r8 + rate(:,383) = 1.3e-11_r8 + rate(:,384) = 1.4e-11_r8 + rate(:,388) = 2.4e-12_r8 + rate(:,389) = 1.4e-11_r8 + rate(:,394) = 2.4e-12_r8 + rate(:,395) = 4e-11_r8 + rate(:,396) = 4e-11_r8 + rate(:,398) = 1.4e-11_r8 + rate(:,402) = 2.4e-12_r8 + rate(:,403) = 4e-11_r8 + rate(:,407) = 7e-11_r8 + rate(:,408) = 1e-10_r8 + rate(:,413) = 2.4e-12_r8 + rate(:,428) = 4.7e-11_r8 + rate(:,441) = 2.1e-12_r8 + rate(:,442) = 2.8e-13_r8 + rate(:,450) = 1.7e-11_r8 + rate(:,456) = 8.4e-11_r8 + rate(:,458) = 1.9e-11_r8 + rate(:,459) = 1.2e-14_r8 + rate(:,460) = 2e-10_r8 + rate(:,467) = 2.4e-12_r8 + rate(:,468) = 2e-11_r8 + rate(:,472) = 2.3e-11_r8 + rate(:,473) = 2e-11_r8 + rate(:,477) = 3.3e-11_r8 + rate(:,478) = 1e-12_r8 + rate(:,479) = 5.7e-11_r8 + rate(:,480) = 3.4e-11_r8 + rate(:,485) = 2.3e-12_r8 + rate(:,487) = 1.2e-11_r8 + rate(:,488) = 5.7e-11_r8 + rate(:,489) = 2.8e-11_r8 + rate(:,490) = 6.6e-11_r8 + rate(:,491) = 1.4e-11_r8 + rate(:,494) = 1.9e-12_r8 + rate(:,506) = 6.34e-08_r8 + rate(:,512) = 1.9e-11_r8 + rate(:,515) = 1.2e-14_r8 + rate(:,516) = 2e-10_r8 + rate(:,527) = 1.34e-11_r8 + rate(:,530) = 1.34e-11_r8 + rate(:,536) = 1.34e-11_r8 + rate(:,537) = 1.34e-11_r8 + rate(:,542) = 1.7e-11_r8 + rate(:,562) = 1.29e-07_r8 + + do n = 1,pver + offset = (n-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,n) + end do + + rate(:,145) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,146) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:,147) = 3.3e-11_r8 * exp( 55._r8 * itemp(:) ) + rate(:,149) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,152) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + exp_fac(:) = exp( -2000._r8 * itemp(:) ) + rate(:,153) = 1.4e-12_r8 * exp_fac(:) + rate(:,404) = 1.05e-14_r8 * exp_fac(:) + rate(:,523) = 1.05e-14_r8 * exp_fac(:) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,158) = 3e-11_r8 * exp_fac(:) + rate(:,244) = 5.5e-12_r8 * exp_fac(:) + rate(:,283) = 3.8e-12_r8 * exp_fac(:) + rate(:,304) = 3.8e-12_r8 * exp_fac(:) + rate(:,331) = 3.8e-12_r8 * exp_fac(:) + rate(:,339) = 3.8e-12_r8 * exp_fac(:) + rate(:,343) = 3.8e-12_r8 * exp_fac(:) + rate(:,359) = 2.3e-11_r8 * exp_fac(:) + rate(:,369) = 3.8e-12_r8 * exp_fac(:) + rate(:,379) = 3.8e-12_r8 * exp_fac(:) + rate(:,406) = 1.52e-11_r8 * exp_fac(:) + rate(:,414) = 1.52e-12_r8 * exp_fac(:) + rate(:,420) = 3.8e-12_r8 * exp_fac(:) + rate(:,423) = 3.8e-12_r8 * exp_fac(:) + rate(:,427) = 3.8e-12_r8 * exp_fac(:) + rate(:,443) = 3.8e-12_r8 * exp_fac(:) + rate(:,447) = 3.8e-12_r8 * exp_fac(:) + rate(:,453) = 3.8e-12_r8 * exp_fac(:) + rate(:,457) = 3.8e-12_r8 * exp_fac(:) + rate(:,159) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,160) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,161) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,163) = 4.8e-11_r8 * exp_fac(:) + rate(:,242) = 1.7e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 180._r8 * itemp(:) ) + rate(:,164) = 1.8e-11_r8 * exp_fac(:) + rate(:,317) = 4.2e-12_r8 * exp_fac(:) + rate(:,330) = 4.2e-12_r8 * exp_fac(:) + rate(:,338) = 4.2e-12_r8 * exp_fac(:) + rate(:,367) = 4.2e-12_r8 * exp_fac(:) + rate(:,387) = 4.4e-12_r8 * exp_fac(:) + rate(:,393) = 4.4e-12_r8 * exp_fac(:) + rate(:,466) = 4.2e-12_r8 * exp_fac(:) + rate(:,471) = 4.2e-12_r8 * exp_fac(:) + rate(:,476) = 4.2e-12_r8 * exp_fac(:) + rate(:,165) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,169) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) + rate(:,170) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,171) = 2.9e-12_r8 * exp_fac(:) + rate(:,172) = 1.45e-12_r8 * exp_fac(:) + rate(:,173) = 1.45e-12_r8 * exp_fac(:) + rate(:,174) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:,175) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,176) = 1.2e-13_r8 * exp_fac(:) + rate(:,202) = 3e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,179) = 1.7e-11_r8 * exp_fac(:) + rate(:,277) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,183) = 3.44e-12_r8 * exp_fac(:) + rate(:,235) = 2.3e-12_r8 * exp_fac(:) + rate(:,238) = 8.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,184) = 3e-12_r8 * exp_fac(:) + rate(:,243) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,186) = 7.26e-11_r8 * exp_fac(:) + rate(:,187) = 4.64e-11_r8 * exp_fac(:) + rate(:,194) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,195) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,196) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,197) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,198) = 1.4e-11_r8 * exp_fac(:) + rate(:,212) = 7.4e-12_r8 * exp_fac(:) + rate(:,313) = 8.1e-12_r8 * exp_fac(:) + rate(:,199) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,200) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,201) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,203) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,204) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,205) = 2.6e-12_r8 * exp_fac(:) + rate(:,206) = 6.4e-12_r8 * exp_fac(:) + rate(:,236) = 4.1e-13_r8 * exp_fac(:) + rate(:,416) = 7.5e-12_r8 * exp_fac(:) + rate(:,430) = 7.5e-12_r8 * exp_fac(:) + rate(:,433) = 7.5e-12_r8 * exp_fac(:) + rate(:,436) = 7.5e-12_r8 * exp_fac(:) + rate(:,207) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,209) = 3.6e-12_r8 * exp_fac(:) + rate(:,258) = 2e-12_r8 * exp_fac(:) + rate(:,210) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,211) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,213) = 6e-13_r8 * exp_fac(:) + rate(:,233) = 1.5e-12_r8 * exp_fac(:) + rate(:,241) = 1.9e-11_r8 * exp_fac(:) + rate(:,214) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,215) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,216) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + exp_fac(:) = exp( -500._r8 * itemp(:) ) + rate(:,218) = 3e-12_r8 * exp_fac(:) + rate(:,252) = 1.4e-10_r8 * exp_fac(:) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,230) = 1.7e-11_r8 * exp_fac(:) + rate(:,257) = 6.3e-12_r8 * exp_fac(:) + rate(:,231) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,232) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,234) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + rate(:,237) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,240) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,245) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,251) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) + exp_fac(:) = exp( 0._r8 * itemp(:) ) + rate(:,253) = 1.4e-11_r8 * exp_fac(:) + rate(:,255) = 2.14e-11_r8 * exp_fac(:) + rate(:,256) = 1.9e-10_r8 * exp_fac(:) + rate(:,269) = 2.57e-10_r8 * exp_fac(:) + rate(:,270) = 1.8e-10_r8 * exp_fac(:) + rate(:,271) = 1.794e-10_r8 * exp_fac(:) + rate(:,272) = 1.3e-10_r8 * exp_fac(:) + rate(:,273) = 7.65e-11_r8 * exp_fac(:) + rate(:,286) = 4e-13_r8 * exp_fac(:) + rate(:,290) = 1.31e-10_r8 * exp_fac(:) + rate(:,291) = 3.5e-11_r8 * exp_fac(:) + rate(:,292) = 9e-12_r8 * exp_fac(:) + rate(:,299) = 6.8e-14_r8 * exp_fac(:) + rate(:,300) = 2e-13_r8 * exp_fac(:) + rate(:,315) = 1e-12_r8 * exp_fac(:) + rate(:,319) = 1e-14_r8 * exp_fac(:) + rate(:,320) = 1e-11_r8 * exp_fac(:) + rate(:,321) = 1.15e-11_r8 * exp_fac(:) + rate(:,322) = 4e-14_r8 * exp_fac(:) + rate(:,335) = 3e-12_r8 * exp_fac(:) + rate(:,336) = 6.7e-13_r8 * exp_fac(:) + rate(:,346) = 3.5e-13_r8 * exp_fac(:) + rate(:,347) = 5.4e-11_r8 * exp_fac(:) + rate(:,350) = 2e-12_r8 * exp_fac(:) + rate(:,351) = 1.4e-11_r8 * exp_fac(:) + rate(:,354) = 2.4e-12_r8 * exp_fac(:) + rate(:,365) = 5e-12_r8 * exp_fac(:) + rate(:,375) = 1.6e-12_r8 * exp_fac(:) + rate(:,377) = 6.7e-12_r8 * exp_fac(:) + rate(:,380) = 3.5e-12_r8 * exp_fac(:) + rate(:,383) = 1.3e-11_r8 * exp_fac(:) + rate(:,384) = 1.4e-11_r8 * exp_fac(:) + rate(:,388) = 2.4e-12_r8 * exp_fac(:) + rate(:,389) = 1.4e-11_r8 * exp_fac(:) + rate(:,394) = 2.4e-12_r8 * exp_fac(:) + rate(:,395) = 4e-11_r8 * exp_fac(:) + rate(:,396) = 4e-11_r8 * exp_fac(:) + rate(:,398) = 1.4e-11_r8 * exp_fac(:) + rate(:,402) = 2.4e-12_r8 * exp_fac(:) + rate(:,403) = 4e-11_r8 * exp_fac(:) + rate(:,407) = 7e-11_r8 * exp_fac(:) + rate(:,408) = 1e-10_r8 * exp_fac(:) + rate(:,413) = 2.4e-12_r8 * exp_fac(:) + rate(:,428) = 4.7e-11_r8 * exp_fac(:) + rate(:,441) = 2.1e-12_r8 * exp_fac(:) + rate(:,442) = 2.8e-13_r8 * exp_fac(:) + rate(:,450) = 1.7e-11_r8 * exp_fac(:) + rate(:,456) = 8.4e-11_r8 * exp_fac(:) + rate(:,458) = 1.9e-11_r8 * exp_fac(:) + rate(:,459) = 1.2e-14_r8 * exp_fac(:) + rate(:,460) = 2e-10_r8 * exp_fac(:) + rate(:,467) = 2.4e-12_r8 * exp_fac(:) + rate(:,468) = 2e-11_r8 * exp_fac(:) + rate(:,472) = 2.3e-11_r8 * exp_fac(:) + rate(:,473) = 2e-11_r8 * exp_fac(:) + rate(:,477) = 3.3e-11_r8 * exp_fac(:) + rate(:,478) = 1e-12_r8 * exp_fac(:) + rate(:,479) = 5.7e-11_r8 * exp_fac(:) + rate(:,480) = 3.4e-11_r8 * exp_fac(:) + rate(:,485) = 2.3e-12_r8 * exp_fac(:) + rate(:,487) = 1.2e-11_r8 * exp_fac(:) + rate(:,488) = 5.7e-11_r8 * exp_fac(:) + rate(:,489) = 2.8e-11_r8 * exp_fac(:) + rate(:,490) = 6.6e-11_r8 * exp_fac(:) + rate(:,491) = 1.4e-11_r8 * exp_fac(:) + rate(:,494) = 1.9e-12_r8 * exp_fac(:) + rate(:,506) = 6.34e-08_r8 * exp_fac(:) + rate(:,512) = 1.9e-11_r8 * exp_fac(:) + rate(:,515) = 1.2e-14_r8 * exp_fac(:) + rate(:,516) = 2e-10_r8 * exp_fac(:) + rate(:,527) = 1.34e-11_r8 * exp_fac(:) + rate(:,530) = 1.34e-11_r8 * exp_fac(:) + rate(:,536) = 1.34e-11_r8 * exp_fac(:) + rate(:,537) = 1.34e-11_r8 * exp_fac(:) + rate(:,542) = 1.7e-11_r8 * exp_fac(:) + rate(:,562) = 1.29e-07_r8 * exp_fac(:) + exp_fac(:) = exp( 400._r8 * itemp(:) ) + rate(:,254) = 6e-12_r8 * exp_fac(:) + rate(:,352) = 5e-13_r8 * exp_fac(:) + rate(:,385) = 5e-13_r8 * exp_fac(:) + rate(:,390) = 5e-13_r8 * exp_fac(:) + rate(:,399) = 5e-13_r8 * exp_fac(:) + rate(:,410) = 5e-13_r8 * exp_fac(:) + rate(:,259) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,260) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + exp_fac(:) = exp( -1520._r8 * itemp(:) ) + rate(:,261) = 1.64e-12_r8 * exp_fac(:) + rate(:,371) = 8.5e-16_r8 * exp_fac(:) + rate(:,262) = 2.03e-11_r8 * exp( -1110._r8 * itemp(:) ) + rate(:,263) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,264) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,265) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,266) = 1.25e-12_r8 * exp_fac(:) + rate(:,276) = 3.4e-11_r8 * exp_fac(:) + rate(:,267) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,268) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,274) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) + rate(:,275) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,278) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) + rate(:,279) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) + rate(:,280) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + exp_fac(:) = exp( 300._r8 * itemp(:) ) + rate(:,281) = 2.8e-12_r8 * exp_fac(:) + rate(:,342) = 2.9e-12_r8 * exp_fac(:) + rate(:,282) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) + rate(:,284) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + exp_fac(:) = exp( 700._r8 * itemp(:) ) + rate(:,287) = 7.5e-13_r8 * exp_fac(:) + rate(:,301) = 7.5e-13_r8 * exp_fac(:) + rate(:,316) = 7.5e-13_r8 * exp_fac(:) + rate(:,329) = 7.5e-13_r8 * exp_fac(:) + rate(:,337) = 7.5e-13_r8 * exp_fac(:) + rate(:,341) = 8.6e-13_r8 * exp_fac(:) + rate(:,353) = 8e-13_r8 * exp_fac(:) + rate(:,366) = 7.5e-13_r8 * exp_fac(:) + rate(:,376) = 7.5e-13_r8 * exp_fac(:) + rate(:,386) = 8e-13_r8 * exp_fac(:) + rate(:,391) = 8e-13_r8 * exp_fac(:) + rate(:,400) = 8e-13_r8 * exp_fac(:) + rate(:,411) = 8e-13_r8 * exp_fac(:) + rate(:,418) = 7.5e-13_r8 * exp_fac(:) + rate(:,422) = 7.5e-13_r8 * exp_fac(:) + rate(:,425) = 7.5e-13_r8 * exp_fac(:) + rate(:,438) = 7.5e-13_r8 * exp_fac(:) + rate(:,445) = 7.5e-13_r8 * exp_fac(:) + rate(:,451) = 7.5e-13_r8 * exp_fac(:) + rate(:,454) = 7.5e-13_r8 * exp_fac(:) + rate(:,465) = 7.5e-13_r8 * exp_fac(:) + rate(:,470) = 7.5e-13_r8 * exp_fac(:) + rate(:,475) = 7.5e-13_r8 * exp_fac(:) + rate(:,518) = 7.5e-13_r8 * exp_fac(:) + rate(:,525) = 7.5e-13_r8 * exp_fac(:) + rate(:,528) = 7.5e-13_r8 * exp_fac(:) + rate(:,539) = 7.5e-13_r8 * exp_fac(:) + rate(:,543) = 7.5e-13_r8 * exp_fac(:) + rate(:,288) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) + rate(:,289) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) + rate(:,293) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) + rate(:,298) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + exp_fac(:) = exp( 365._r8 * itemp(:) ) + rate(:,302) = 2.6e-12_r8 * exp_fac(:) + rate(:,419) = 2.6e-12_r8 * exp_fac(:) + rate(:,424) = 2.6e-12_r8 * exp_fac(:) + rate(:,426) = 2.6e-12_r8 * exp_fac(:) + rate(:,439) = 2.6e-12_r8 * exp_fac(:) + rate(:,446) = 2.6e-12_r8 * exp_fac(:) + rate(:,452) = 2.6e-12_r8 * exp_fac(:) + rate(:,455) = 2.6e-12_r8 * exp_fac(:) + rate(:,519) = 2.6e-12_r8 * exp_fac(:) + rate(:,526) = 2.6e-12_r8 * exp_fac(:) + rate(:,529) = 2.6e-12_r8 * exp_fac(:) + rate(:,540) = 2.6e-12_r8 * exp_fac(:) + rate(:,544) = 2.6e-12_r8 * exp_fac(:) + rate(:,303) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,305) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,306) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + exp_fac(:) = exp( -1900._r8 * itemp(:) ) + rate(:,307) = 1.4e-12_r8 * exp_fac(:) + rate(:,327) = 6.5e-15_r8 * exp_fac(:) + exp_fac(:) = exp( 350._r8 * itemp(:) ) + rate(:,308) = 4.63e-12_r8 * exp_fac(:) + rate(:,522) = 2.7e-12_r8 * exp_fac(:) + rate(:,309) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) + exp_fac(:) = exp( 500._r8 * itemp(:) ) + rate(:,310) = 2.9e-12_r8 * exp_fac(:) + rate(:,311) = 2e-12_r8 * exp_fac(:) + rate(:,340) = 7.1e-13_r8 * exp_fac(:) + rate(:,361) = 2e-12_r8 * exp_fac(:) + rate(:,464) = 2e-12_r8 * exp_fac(:) + rate(:,469) = 2e-12_r8 * exp_fac(:) + rate(:,474) = 2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 1040._r8 * itemp(:) ) + rate(:,312) = 4.3e-13_r8 * exp_fac(:) + rate(:,362) = 4.3e-13_r8 * exp_fac(:) + rate(:,415) = 4.3e-13_r8 * exp_fac(:) + rate(:,429) = 4.3e-13_r8 * exp_fac(:) + rate(:,432) = 4.3e-13_r8 * exp_fac(:) + rate(:,435) = 4.3e-13_r8 * exp_fac(:) + rate(:,314) = 3.15e-14_r8 * exp( 920._r8 * itemp(:) ) + rate(:,318) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,326) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,328) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,332) = 9.19e-12_r8 * exp( -630._r8 * itemp(:) ) + rate(:,333) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) + rate(:,334) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + rate(:,348) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) + rate(:,349) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) + exp_fac(:) = exp( 360._r8 * itemp(:) ) + rate(:,355) = 2.7e-12_r8 * exp_fac(:) + rate(:,356) = 1.3e-13_r8 * exp_fac(:) + rate(:,358) = 9.6e-12_r8 * exp_fac(:) + rate(:,364) = 5.3e-12_r8 * exp_fac(:) + rate(:,401) = 2.7e-12_r8 * exp_fac(:) + rate(:,412) = 2.7e-12_r8 * exp_fac(:) + rate(:,514) = 2.7e-12_r8 * exp_fac(:) + rate(:,533) = 2.7e-12_r8 * exp_fac(:) + rate(:,357) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) + exp_fac(:) = exp( 530._r8 * itemp(:) ) + rate(:,360) = 4.6e-12_r8 * exp_fac(:) + rate(:,363) = 2.3e-12_r8 * exp_fac(:) + rate(:,368) = 2.3e-12_r8 * exp( -170._r8 * itemp(:) ) + rate(:,372) = 4.13e-12_r8 * exp( 452._r8 * itemp(:) ) + rate(:,378) = 5.4e-14_r8 * exp( 870._r8 * itemp(:) ) + exp_fac(:) = exp( 175._r8 * itemp(:) ) + rate(:,381) = 1.86e-11_r8 * exp_fac(:) + rate(:,382) = 1.86e-11_r8 * exp_fac(:) + rate(:,392) = 1.6e+09_r8 * exp( -8300._r8 * itemp(:) ) + exp_fac(:) = exp( -446._r8 * itemp(:) ) + rate(:,397) = 3.03e-12_r8 * exp_fac(:) + rate(:,520) = 3.03e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 410._r8 * itemp(:) ) + rate(:,405) = 2.54e-11_r8 * exp_fac(:) + rate(:,524) = 2.54e-11_r8 * exp_fac(:) + rate(:,409) = 1.3e-12_r8 * exp( 640._r8 * itemp(:) ) + exp_fac(:) = exp( -193._r8 * itemp(:) ) + rate(:,417) = 2.3e-12_r8 * exp_fac(:) + rate(:,517) = 2.3e-12_r8 * exp_fac(:) + rate(:,421) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) + rate(:,440) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) + exp_fac(:) = exp( 352._r8 * itemp(:) ) + rate(:,448) = 1.7e-12_r8 * exp_fac(:) + rate(:,538) = 1.7e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 490._r8 * itemp(:) ) + rate(:,461) = 1.2e-12_r8 * exp_fac(:) + rate(:,531) = 1.2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -580._r8 * itemp(:) ) + rate(:,462) = 6.3e-16_r8 * exp_fac(:) + rate(:,534) = 6.3e-16_r8 * exp_fac(:) + exp_fac(:) = exp( 440._r8 * itemp(:) ) + rate(:,463) = 1.2e-11_r8 * exp_fac(:) + rate(:,535) = 1.2e-11_r8 * exp_fac(:) + rate(:,481) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,482) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,483) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,484) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,492) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,493) = 3.4e-12_r8 * exp( -1100._r8 * itemp(:) ) + rate(:,495) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) + rate(:,498) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + exp_fac(:) = exp( 1300._r8 * itemp(:) ) + rate(:,513) = 2.75e-13_r8 * exp_fac(:) + rate(:,521) = 2.12e-13_r8 * exp_fac(:) + rate(:,532) = 2.6e-13_r8 * exp_fac(:) + + 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(:,157), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,167), 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(:,177), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,185), 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(:,188), 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(:,189), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,190), 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(:,208), 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(:,228), 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(:,239), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.1e-33_r8 * itemp(:)**1.5_r8 + kinf(:) = 9.8e-15_r8 * itemp(:)**(-4.6_r8) + call jpl( rate(:,285), m, 0.8_r8, ko, kinf, n ) + + ko(:) = 5.2e-30_r8 * itemp(:)**2.4_r8 + kinf(:) = 2.2e-10_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,295), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.5e-30_r8 + kinf(:) = 8.3e-13_r8 * itemp(:)**(-2._r8) + call jpl( rate(:,296), 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(:,297), 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(:,323), 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(:,324), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,344), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,370), 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(:,431), m, 0.6_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(:,434), m, 0.6_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(:,437), m, 0.6_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(:,444), 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(:,486), 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,154) = 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,146) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + rate(:n,149) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,158) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,159) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,160) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,163) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,164) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,165) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,170) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,174) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:n,175) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,183) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) + rate(:n,184) = 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,157) = wrk(:) + + + + + + + + + + + + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_trop_strat_mam5_vbsext/mo_sim_dat.F90 b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_sim_dat.F90 new file mode 100644 index 0000000000..950078c36d --- /dev/null +++ b/src/chemistry/pp_trop_strat_mam5_vbsext/mo_sim_dat.F90 @@ -0,0 +1,876 @@ + + 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, 261, 0 /) + + cls_rxt_cnt(:,1) = (/ 9, 0, 0, 2 /) + cls_rxt_cnt(:,4) = (/ 2, 182, 378, 261 /) + + solsym(:263) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','bc_a1 ','bc_a4 ', & + 'BCARY ','BCARYO2VBS ','BENZENE ','BENZO2VBS ','BENZOOH ', & + 'BEPOMUC ','BIGALD ','BIGALD1 ','BIGALD2 ','BIGALD3 ', & + 'BIGALD4 ','BIGALK ','BIGENE ','BR ','BRCL ', & + 'BRO ','BRONO2 ','BRY ','BZALD ','BZOOH ', & + 'C2H2 ','C2H4 ','C2H5OH ','C2H5OOH ','C2H6 ', & + 'C3H6 ','C3H7OOH ','C3H8 ','C6H5OOH ','CCL4 ', & + 'CF2CLBR ','CF3BR ','CFC11 ','CFC113 ','CFC114 ', & + 'CFC115 ','CFC12 ','CH2BR2 ','CH2O ','CH3BR ', & + 'CH3CCL3 ','CH3CHO ','CH3CL ','CH3CN ','CH3COCH3 ', & + 'CH3COCHO ','CH3COOH ','CH3COOOH ','CH3OH ','CH3OOH ', & + 'CH4 ','CHBR3 ','CL ','CL2 ','CL2O2 ', & + 'CLO ','CLONO2 ','CLY ','CO ','CO2 ', & + 'COF2 ','COFCL ','CRESOL ','DMS ','dst_a1 ', & + 'dst_a2 ','dst_a3 ','E90 ','EOOH ','F ', & + 'GLYALD ','GLYOXAL ','H ','H2 ','H2402 ', & + 'H2O2 ','H2SO4 ','HBR ','HCFC141B ','HCFC142B ', & + 'HCFC22 ','HCL ','HCN ','HCOOH ','HF ', & + 'HNO3 ','HO2NO2 ','HOBR ','HOCL ','HONITR ', & + 'HPALD ','HYAC ','HYDRALD ','IEPOX ','ISOP ', & + 'ISOPNITA ','ISOPNITB ','ISOPNO3 ','ISOPNOOH ','ISOPO2VBS ', & + 'ISOPOOH ','IVOCbb ','IVOCbbO2VBS ','IVOCff ','IVOCffO2VBS ', & + 'MACR ','MACROOH ','MEK ','MEKOOH ','MPAN ', & + 'MTERP ','MTERPO2VBS ','MVK ','N ','N2O ', & + 'N2O5 ','NC4CH2OH ','NC4CHO ','ncl_a1 ','ncl_a2 ', & + 'ncl_a3 ','NH3 ','NH4 ','NO ','NO2 ', & + 'NO3 ','NOA ','NTERPOOH ','num_a1 ','num_a2 ', & + 'num_a3 ','num_a4 ','num_a5 ','O ','O3 ', & + 'O3S ','OCLO ','OCS ','ONITR ','PAN ', & + 'PBZNIT ','PHENO ','PHENOL ','PHENOOH ','pombb1_a1 ', & + 'pombb1_a4 ','pomff1_a1 ','pomff1_a4 ','POOH ','ROOH ', & + 'S ','SF6 ','SO ','SO2 ','SO3 ', & + 'so4_a1 ','so4_a2 ','so4_a3 ','so4_a5 ','soabb1_a1 ', & + 'soabb1_a2 ','soabb2_a1 ','soabb2_a2 ','soabb3_a1 ','soabb3_a2 ', & + 'soabb4_a1 ','soabb4_a2 ','soabb5_a1 ','soabb5_a2 ','soabg1_a1 ', & + 'soabg1_a2 ','soabg2_a1 ','soabg2_a2 ','soabg3_a1 ','soabg3_a2 ', & + 'soabg4_a1 ','soabg4_a2 ','soabg5_a1 ','soabg5_a2 ','soaff1_a1 ', & + 'soaff1_a2 ','soaff2_a1 ','soaff2_a2 ','soaff3_a1 ','soaff3_a2 ', & + 'soaff4_a1 ','soaff4_a2 ','soaff5_a1 ','soaff5_a2 ','SOAGbb0 ', & + 'SOAGbb1 ','SOAGbb2 ','SOAGbb3 ','SOAGbb4 ','SOAGbg0 ', & + 'SOAGbg1 ','SOAGbg2 ','SOAGbg3 ','SOAGbg4 ','SOAGff0 ', & + 'SOAGff1 ','SOAGff2 ','SOAGff3 ','SOAGff4 ','SVOCbb ', & + 'SVOCff ','TEPOMUC ','TERP2OOH ','TERPNIT ','TERPOOH ', & + 'TERPROD1 ','TERPROD2 ','TOLOOH ','TOLUENE ','TOLUO2VBS ', & + 'XOOH ','XYLENES ','XYLENOOH ','XYLEO2VBS ','XYLOL ', & + 'XYLOLOOH ','NHDEP ','NDEP ','ACBZO2 ','ALKO2 ', & + 'BENZO2 ','BZOO ','C2H5O2 ','C3H7O2 ','C6H5O2 ', & + 'CH3CO3 ','CH3O2 ','DICARBO2 ','ENEO2 ','EO ', & + 'EO2 ','HO2 ','HOCH2OO ','ISOPAO2 ','ISOPBO2 ', & + 'MACRO2 ','MALO2 ','MCO3 ','MDIALO2 ','MEKO2 ', & + 'NTERPO2 ','O1D ','OH ','PHENO2 ','PO2 ', & + 'RO2 ','TERP2O2 ','TERPO2 ','TOLO2 ','XO2 ', & + 'XYLENO2 ','XYLOLO2 ','H2O ' /) + + adv_mass(:263) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 12.011000_r8, 12.011000_r8, & + 204.342600_r8, 253.348200_r8, 78.110400_r8, 159.114800_r8, 160.122200_r8, & + 126.108600_r8, 98.098200_r8, 84.072400_r8, 98.098200_r8, 98.098200_r8, & + 112.124000_r8, 72.143800_r8, 56.103200_r8, 79.904000_r8, 115.356700_r8, & + 95.903400_r8, 141.908940_r8, 99.716850_r8, 106.120800_r8, 124.135000_r8, & + 26.036800_r8, 28.051600_r8, 46.065800_r8, 62.065200_r8, 30.066400_r8, & + 42.077400_r8, 76.091000_r8, 44.092200_r8, 110.109200_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, 41.050940_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, & + 66.007206_r8, 82.461503_r8, 108.135600_r8, 62.132400_r8, 135.064039_r8, & + 135.064039_r8, 135.064039_r8, 28.010400_r8, 78.064600_r8, 18.998403_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, 27.025140_r8, 46.024600_r8, 20.005803_r8, & + 63.012340_r8, 79.011740_r8, 96.910800_r8, 52.459500_r8, 135.114940_r8, & + 116.112400_r8, 74.076200_r8, 100.113000_r8, 118.127200_r8, 68.114200_r8, & + 147.125940_r8, 147.125940_r8, 162.117940_r8, 163.125340_r8, 117.119800_r8, & + 118.127200_r8, 184.350200_r8, 233.355800_r8, 184.350200_r8, 233.355800_r8, & + 70.087800_r8, 120.100800_r8, 72.102600_r8, 104.101400_r8, 147.084740_r8, & + 136.228400_r8, 185.234000_r8, 70.087800_r8, 14.006740_r8, 44.012880_r8, & + 108.010480_r8, 147.125940_r8, 145.111140_r8, 58.442468_r8, 58.442468_r8, & + 58.442468_r8, 17.028940_r8, 18.036340_r8, 30.006140_r8, 46.005540_r8, & + 62.004940_r8, 119.074340_r8, 231.239540_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, & + 183.117740_r8, 93.102400_r8, 94.109800_r8, 176.121600_r8, 12.011000_r8, & + 12.011000_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, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 310.582400_r8, & + 310.582400_r8, 140.134400_r8, 200.226000_r8, 215.240140_r8, 186.241400_r8, & + 168.227200_r8, 154.201400_r8, 174.148000_r8, 92.136200_r8, 173.140600_r8, & + 150.126000_r8, 106.162000_r8, 188.173800_r8, 187.166400_r8, 122.161400_r8, & + 204.173200_r8, 14.006740_r8, 14.006740_r8, 137.112200_r8, 103.135200_r8, & + 159.114800_r8, 123.127600_r8, 61.057800_r8, 75.083600_r8, 109.101800_r8, & + 75.042400_r8, 47.032000_r8, 129.089600_r8, 105.108800_r8, 61.057800_r8, & + 77.057200_r8, 33.006200_r8, 63.031400_r8, 117.119800_r8, 117.119800_r8, & + 119.093400_r8, 115.063800_r8, 101.079200_r8, 117.078600_r8, 103.094000_r8, & + 230.232140_r8, 15.999400_r8, 17.006800_r8, 175.114200_r8, 91.083000_r8, & + 89.068200_r8, 199.218600_r8, 185.234000_r8, 173.140600_r8, 149.118600_r8, & + 187.166400_r8, 203.165800_r8, 18.014200_r8 /) + + crb_mass(:263) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 180.165000_r8, 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, & + 72.066000_r8, 60.055000_r8, 48.044000_r8, 60.055000_r8, 60.055000_r8, & + 72.066000_r8, 60.055000_r8, 48.044000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 84.077000_r8, 84.077000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 36.033000_r8, 36.033000_r8, 36.033000_r8, 72.066000_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, 24.022000_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, & + 12.011000_r8, 12.011000_r8, 84.077000_r8, 24.022000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_r8, 24.022000_r8, 0.000000_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, 12.011000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 48.044000_r8, & + 60.055000_r8, 36.033000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 156.143000_r8, 156.143000_r8, 156.143000_r8, 156.143000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 120.110000_r8, 120.110000_r8, 48.044000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 60.055000_r8, 60.055000_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, 36.033000_r8, 120.110000_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, & + 84.077000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, 12.011000_r8, & + 12.011000_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, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 264.242000_r8, & + 264.242000_r8, 84.077000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, & + 120.110000_r8, 108.099000_r8, 84.077000_r8, 84.077000_r8, 84.077000_r8, & + 60.055000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, & + 96.088000_r8, 0.000000_r8, 0.000000_r8, 84.077000_r8, 60.055000_r8, & + 72.066000_r8, 84.077000_r8, 24.022000_r8, 36.033000_r8, 72.066000_r8, & + 24.022000_r8, 12.011000_r8, 60.055000_r8, 48.044000_r8, 24.022000_r8, & + 24.022000_r8, 0.000000_r8, 12.011000_r8, 60.055000_r8, 60.055000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 120.110000_r8, 0.000000_r8, 0.000000_r8, 72.066000_r8, 36.033000_r8, & + 36.033000_r8, 120.110000_r8, 120.110000_r8, 84.077000_r8, 60.055000_r8, & + 96.088000_r8, 96.088000_r8, 0.000000_r8 /) + + fix_mass(: 3) = (/ 0.00000000_r8, 31.9988000_r8, 28.0134800_r8 /) + + clsmap(: 2,1) = (/ 227, 228 /) + clsmap(:261,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, 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, 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 /) + + permute(:261,4) = (/ 186, 185, 1, 2, 3, 217, 71, 104, 81, 156, & + 105, 149, 161, 129, 180, 136, 116, 144, 243, 118, & + 252, 172, 4, 119, 139, 130, 175, 126, 140, 131, & + 219, 150, 91, 127, 87, 98, 99, 92, 100, 93, & + 101, 94, 162, 247, 178, 95, 221, 145, 88, 214, & + 234, 190, 179, 200, 153, 244, 154, 257, 107, 89, & + 260, 213, 5, 225, 205, 121, 123, 111, 135, 6, & + 7, 8, 9, 102, 209, 222, 216, 246, 242, 90, & + 181, 103, 202, 122, 124, 132, 255, 109, 215, 133, & + 245, 151, 199, 203, 226, 120, 227, 141, 96, 206, & + 177, 174, 232, 148, 72, 195, 65, 64, 80, 79, & + 233, 142, 168, 143, 182, 211, 73, 239, 165, 108, & + 134, 155, 220, 10, 11, 12, 86, 13, 253, 248, & + 256, 207, 152, 14, 15, 16, 17, 18, 249, 258, & + 19, 137, 146, 117, 171, 97, 164, 106, 138, 20, & + 21, 22, 23, 173, 147, 169, 24, 235, 208, 125, & + 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, 66, & + 67, 68, 69, 70, 74, 75, 76, 77, 78, 82, & + 83, 112, 188, 183, 163, 218, 224, 189, 110, 84, & + 113, 114, 191, 85, 115, 157, 170, 212, 166, 158, & + 204, 201, 184, 241, 254, 197, 176, 128, 192, 259, & + 159, 236, 237, 238, 193, 240, 210, 187, 223, 250, & + 251, 160, 198, 230, 228, 229, 194, 231, 196, 167, & + 261 /) + + diag_map(:261) = (/ 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, 69, 71, 72, 73, 74, 75, 76, & + 82, 88, 94, 95, 96, 97, 98, 99, 105, 107, & + 113, 119, 125, 131, 137, 138, 141, 144, 147, 150, & + 154, 158, 162, 166, 170, 174, 177, 180, 185, 190, & + 195, 200, 203, 207, 213, 217, 222, 224, 227, 232, & + 239, 244, 248, 253, 261, 266, 269, 272, 275, 278, & + 283, 286, 291, 296, 302, 306, 310, 314, 318, 321, & + 327, 334, 340, 343, 349, 355, 360, 365, 371, 376, & + 381, 384, 389, 394, 402, 410, 418, 424, 430, 436, & + 442, 448, 454, 460, 466, 472, 478, 486, 492, 499, & + 505, 508, 515, 522, 527, 536, 544, 551, 556, 563, & + 569, 577, 585, 593, 601, 609, 617, 626, 635, 642, & + 646, 653, 662, 670, 677, 688, 699, 706, 719, 729, & + 738, 751, 758, 769, 780, 793, 804, 813, 823, 831, & + 836, 846, 855, 865, 873, 879, 895, 902, 909, 918, & + 936, 960, 972, 982, 989, 997,1015,1035,1048,1069, & + 1081,1092,1102,1116,1127,1136,1149,1163,1184,1200, & + 1217,1237,1253,1265,1276,1301,1334,1358,1379,1401, & + 1433,1448,1462,1477,1494,1510,1532,1576,1608,1650, & + 1823,1848,1952,2005,2029,2089,2129,2192,2311,2338, & + 2365 /) + + extfrc_lst(: 20) = (/ 'bc_a1 ','bc_a4 ','CO ','NO ','NO2 ', & + 'num_a1 ','num_a2 ','num_a4 ','num_a5 ','SO2 ', & + 'so4_a1 ','so4_a2 ','so4_a5 ','SVOCbb ','SVOCff ', & + 'pomff1_a4 ','pombb1_a4 ','AOA_NH ','N ','OH ' /) + + frc_from_dataset(: 20) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .false., .false., .false. /) + + inv_lst(: 3) = (/ 'M ', 'O2 ', 'N2 ' /) + + slvd_lst(: 34) = (/ 'ACBZO2 ', 'ALKO2 ', 'BENZO2 ', 'BZOO ', 'C2H5O2 ', & + 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', 'CH3O2 ', 'DICARBO2 ', & + 'ENEO2 ', 'EO ', 'EO2 ', 'HO2 ', 'HOCH2OO ', & + 'ISOPAO2 ', 'ISOPBO2 ', 'MACRO2 ', 'MALO2 ', 'MCO3 ', & + 'MDIALO2 ', 'MEKO2 ', 'NTERPO2 ', 'O1D ', 'OH ', & + 'PHENO2 ', 'PO2 ', 'RO2 ', 'TERP2O2 ', 'TERPO2 ', & + 'TOLO2 ', 'XO2 ', 'XYLENO2 ', 'XYLOLO2 ' /) + + 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_b ', 'jn2o5_a ', & + 'jno ', 'jno2 ', & + 'jno3_b ', 'jno3_a ', & + 'jalknit ', 'jalkooh ', & + 'jbenzooh ', 'jbepomuc ', & + 'jbigald ', 'jbigald1 ', & + 'jbigald2 ', 'jbigald3 ', & + 'jbigald4 ', 'jbzooh ', & + 'jc2h5ooh ', 'jc3h7ooh ', & + 'jc6h5ooh ', 'jch2o_b ', & + 'jch2o_a ', 'jch3cho ', & + 'jacet ', 'jmgly ', & + 'jch3co3h ', 'jch3ooh ', & + 'jch4_b ', 'jch4_a ', & + 'jco2 ', 'jeooh ', & + 'jglyald ', 'jglyoxal ', & + 'jhonitr ', 'jhpald ', & + 'jhyac ', 'jisopnooh ', & + 'jisopooh ', 'jmacr_b ', & + 'jmacr_a ', 'jmek ', & + 'jmekooh ', 'jmpan ', & + 'jmvk ', 'jnc4cho ', & + 'jnoa ', 'jnterpooh ', & + 'jonitr ', 'jpan ', & + 'jphenooh ', 'jpooh ', & + 'jrooh ', 'jtepomuc ', & + 'jterp2ooh ', 'jterpnit ', & + 'jterpooh ', 'jterprd1 ', & + 'jterprd2 ', 'jtolooh ', & + 'jxooh ', 'jxylenooh ', & + 'jxylolooh ', '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 ', 'jcof2 ', & + 'jcofcl ', 'jh2402 ', & + 'jhbr ', 'jhcfc141b ', & + 'jhcfc142b ', 'jhcfc22 ', & + 'jhcl ', 'jhf ', & + 'jhobr ', 'jhocl ', & + 'joclo ', 'jsf6 ', & + 'jh2so4 ', 'jocs ', & + 'jso ', 'jso2 ', & + 'jso3 ', 'jsoabb1_a1 ', & + 'jsoabb1_a2 ', 'jsoabb2_a1 ', & + 'jsoabb2_a2 ', 'jsoabb3_a1 ', & + 'jsoabb3_a2 ', 'jsoabb4_a1 ', & + 'jsoabb4_a2 ', 'jsoabb5_a1 ', & + 'jsoabb5_a2 ', 'jsoabg1_a1 ', & + 'jsoabg1_a2 ', 'jsoabg2_a1 ', & + 'jsoabg2_a2 ', 'jsoabg3_a1 ', & + 'jsoabg3_a2 ', 'jsoabg4_a1 ', & + 'jsoabg4_a2 ', 'jsoabg5_a1 ', & + 'jsoabg5_a2 ', 'jsoaff1_a1 ', & + 'jsoaff1_a2 ', 'jsoaff2_a1 ', & + 'jsoaff2_a2 ', 'jsoaff3_a1 ', & + 'jsoaff3_a2 ', 'jsoaff4_a1 ', & + 'jsoaff4_a2 ', 'jsoaff5_a1 ', & + 'jsoaff5_a2 ', 'O1D_H2 ', & + 'O1D_H2O ', 'O1D_N2 ', & + 'O1D_O2ab ', 'O1D_O3 ', & + '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 ' /) + rxt_tag_lst( 201: 400) = (/ '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 ', & + 'F_CH4 ', 'F_H2 ', & + 'F_H2O ', 'F_HNO3 ', & + 'O1D_COF2 ', 'O1D_COFCL ', & + 'CH2BR2_CL ', 'CH2BR2_OH ', & + 'CH3BR_CL ', 'CH3BR_OH ', & + 'CH3CCL3_OH ', 'CH3CL_CL ', & + 'CH3CL_OH ', 'CHBR3_CL ', & + 'CHBR3_OH ', 'HCFC141B_OH ', & + 'HCFC142B_OH ', 'HCFC22_OH ', & + 'O1D_CH2BR2 ', 'O1D_CH3BR ', & + 'O1D_HCFC141B ', 'O1D_HCFC142B ', & + 'O1D_HCFC22 ', 'CH2O_HO2 ', & + 'CH2O_NO3 ', 'CH2O_O ', & + 'CH2O_OH ', 'CH3O2_CH3O2a ', & + 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & + 'CH3O2_NO ', 'CH3OH_OH ', & + 'CH3OOH_OH ', 'CH4_OH ', & + 'HCN_OH ', 'HCOOH_OH ', & + 'HOCH2OO_HO2 ', 'HOCH2OO_M ', & + 'HOCH2OO_NO ', 'O1D_CH4a ', & + 'O1D_CH4b ', 'O1D_CH4c ', & + 'O1D_HCN ', 'usr_CO_OH ', & + 'C2H2_CL_M ', 'C2H2_OH_M ', & + '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 ', & + 'CH3CN_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 ', 'BIGENE_NO3 ', & + 'BIGENE_OH ', 'ENEO2_NO ', & + 'ENEO2_NOb ', 'HONITR_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 ', 'MEKO2_HO2 ', & + 'MEKO2_NO ', 'MEK_OH ', & + 'MEKOOH_OH ', 'MPAN_OH_M ', & + 'MVK_O3 ', 'MVK_OH ', & + 'usr_MCO3_NO2 ', 'usr_MPAN_M ', & + 'ALKNIT_OH ', 'ALKO2_HO2 ', & + 'ALKO2_NO ', 'ALKO2_NOb ', & + 'ALKOOH_OH ', 'BIGALK_OH ', & + 'HPALD_OH ', 'HYDRALD_OH ', & + 'IEPOX_OH ', 'ISOPAO2_CH3CO3 ', & + 'ISOPAO2_CH3O2 ', 'ISOPAO2_HO2 ', & + 'ISOPAO2_NO ', 'ISOPAO2_NO3 ', & + 'ISOPBO2_CH3CO3 ', 'ISOPBO2_CH3O2 ', & + 'ISOPBO2_HO2 ', 'ISOPBO2_M ', & + 'ISOPBO2_NO ', 'ISOPBO2_NO3 ', & + 'ISOPNITA_OH ', 'ISOPNITB_OH ', & + 'ISOP_NO3 ', 'ISOPNO3_CH3CO3 ', & + 'ISOPNO3_CH3O2 ', 'ISOPNO3_HO2 ' /) + rxt_tag_lst( 401: 562) = (/ 'ISOPNO3_NO ', 'ISOPNO3_NO3 ', & + 'ISOPNOOH_OH ', 'ISOP_O3 ', & + 'ISOP_OH ', 'ISOPOOH_OH ', & + 'NC4CH2OH_OH ', 'NC4CHO_OH ', & + 'XO2_CH3CO3 ', 'XO2_CH3O2 ', & + 'XO2_HO2 ', 'XO2_NO ', & + 'XO2_NO3 ', 'XOOH_OH ', & + 'ACBZO2_HO2 ', 'ACBZO2_NO ', & + 'BENZENE_OH ', 'BENZO2_HO2 ', & + 'BENZO2_NO ', 'BENZOOH_OH ', & + 'BZALD_OH ', 'BZOO_HO2 ', & + 'BZOOH_OH ', 'BZOO_NO ', & + 'C6H5O2_HO2 ', 'C6H5O2_NO ', & + 'C6H5OOH_OH ', 'CRESOL_OH ', & + 'DICARBO2_HO2 ', 'DICARBO2_NO ', & + 'DICARBO2_NO2 ', 'MALO2_HO2 ', & + 'MALO2_NO ', 'MALO2_NO2 ', & + 'MDIALO2_HO2 ', 'MDIALO2_NO ', & + 'MDIALO2_NO2 ', 'PHENO2_HO2 ', & + 'PHENO2_NO ', 'PHENOL_OH ', & + 'PHENO_NO2 ', 'PHENO_O3 ', & + 'PHENOOH_OH ', 'tag_ACBZO2_NO2 ', & + 'TOLO2_HO2 ', 'TOLO2_NO ', & + 'TOLOOH_OH ', 'TOLUENE_OH ', & + 'usr_PBZNIT_M ', 'XYLENES_OH ', & + 'XYLENO2_HO2 ', 'XYLENO2_NO ', & + 'XYLENOOH_OH ', 'XYLOLO2_HO2 ', & + 'XYLOLO2_NO ', 'XYLOL_OH ', & + 'XYLOLOOH_OH ', 'BCARY_NO3 ', & + 'BCARY_O3 ', 'BCARY_OH ', & + 'MTERP_NO3 ', 'MTERP_O3 ', & + 'MTERP_OH ', 'NTERPO2_CH3O2 ', & + 'NTERPO2_HO2 ', 'NTERPO2_NO ', & + 'NTERPO2_NO3 ', 'NTERPOOH_OH ', & + 'TERP2O2_CH3O2 ', 'TERP2O2_HO2 ', & + 'TERP2O2_NO ', 'TERP2OOH_OH ', & + 'TERPNIT_OH ', 'TERPO2_CH3O2 ', & + 'TERPO2_HO2 ', 'TERPO2_NO ', & + 'TERPOOH_OH ', 'TERPROD1_NO3 ', & + 'TERPROD1_OH ', 'TERPROD2_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_HONITR_aer ', & + 'usr_ISOPNITA_aer ', 'usr_ISOPNITB_aer ', & + 'usr_N2O5_aer ', 'usr_NC4CH2OH_aer ', & + 'usr_NC4CHO_aer ', 'usr_NH4_strat_tau ', & + 'usr_NO2_aer ', 'usr_NO3_aer ', & + 'usr_NTERPOOH_aer ', 'usr_ONITR_aer ', & + 'usr_TERPNIT_aer ', 'BCARY_NO3_vbs ', & + 'BCARYO2_HO2_vbs ', 'BCARYO2_NO_vbs ', & + 'BCARY_O3_vbs ', 'BCARY_OH_vbs ', & + 'BENZENE_OH_vbs ', 'BENZO2_HO2_vbs ', & + 'BENZO2_NO_vbs ', 'ISOP_NO3_vbs ', & + 'ISOPO2_HO2_vbs ', 'ISOPO2_NO_vbs ', & + 'ISOP_O3_vbs ', 'ISOP_OH_vbs ', & + 'IVOCbbO2_HO2_vbs ', 'IVOCbbO2_NO_vbs ', & + 'IVOCbb_OH_vbs ', 'IVOCffO2_HO2_vbs ', & + 'IVOCffO2_NO_vbs ', 'IVOCff_OH_vbs ', & + 'MTERP_NO3_vbs ', 'MTERPO2_HO2_vbs ', & + 'MTERPO2_NO_vbs ', 'MTERP_O3_vbs ', & + 'MTERP_OH_vbs ', 'SVOCbb_OH ', & + 'SVOCff_OH ', 'TOLUENE_OH_vbs ', & + 'TOLUO2_HO2_vbs ', 'TOLUO2_NO_vbs ', & + 'usr_GLYOXAL_aer ', 'XYLENES_OH_vbs ', & + 'XYLEO2_HO2_vbs ', 'XYLEO2_NO_vbs ', & + 'het1 ', 'het10 ', & + 'het11 ', 'het12 ', & + 'het13 ', 'het14 ', & + 'het15 ', 'het16 ', & + 'het17 ', 'het2 ', & + 'het3 ', 'het4 ', & + 'het5 ', 'het6 ', & + 'het7 ', 'het8 ', & + 'het9 ', 'E90_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, 364, 365, 366, 367, 368, 369, 370, & + 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, & + 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, & + 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, & + 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, & + 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, & + 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, & + 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, & + 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, & + 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, & + 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, & + 471, 472, 473, 474, 475, 476, 477, 478, 479, 480, & + 481, 482, 483, 484, 485, 486, 487, 488, 489, 490, & + 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, & + 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, & + 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, & + 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, & + 531, 532, 533, 534, 535, 536, 537, 538, 539, 540, & + 541, 542, 543, 544, 545, 546, 547, 548, 549, 550, & + 551, 552, 553, 554, 555, 556, 557, 558, 559, 560, & + 561, 562 /) + 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 ', & + 'jch3ooh ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', ' ', & + ' ', ' ', ' ', ' ', & + 'jh2o2 ', ' ', ' ', ' ', & + ' ', 'jch3ooh ', ' ', 'jmgly ', & + 'jch2o_a ', 'jno2 ', ' ', 'jch3ooh ', & + 'jch3ooh ', ' ', ' ', 'jacet ', & + 'jch3ooh ', 'jpan ', ' ', 'jch2o_a ', & + 'jch2o_a ', 'jch3ooh ', 'jch3cho ', ' ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jno2 ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3cho ', & + 'jch3cho ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', '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, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 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, .10_r8, 0.2_r8, .14_r8, .20_r8, & + .20_r8, .006_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, & + .006_r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, .10_r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 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, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_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(:) = (/ 146, 149, 150, 151, 154, & + 157, 158, 159, 160, 163, & + 164, 165, 168, 170, 174, & + 175, 183, 184 /) + 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, 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, 2, 2, & + 2, 3, 2, 2, 1, 2, 2, 2, 2, 2, & + 2, 3, 3, 3, 2, 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, 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, 1, 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, & + 3, 2, 2, 3, 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, 3, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 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, 1, 2, 2, & + 2, 1, 2, 1, 1, 1, 1, 2, 2, 2, & + 1, 1, 2, 2, 2, 1, 1, 2, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_ma/chem_mech.doc b/src/chemistry/pp_waccm_ma/chem_mech.doc index 82d9b2e0dc..cd2cc38532 100644 --- a/src/chemistry/pp_waccm_ma/chem_mech.doc +++ b/src/chemistry/pp_waccm_ma/chem_mech.doc @@ -1,66 +1,66 @@ Solution species - ( 1) BRCL (BrCl) - ( 2) BRO (BrO) - ( 3) BRONO2 (BrONO2) - ( 4) BRY - ( 5) CCL4 (CCl4) - ( 6) CF2CLBR (CF2ClBr) - ( 7) CF3BR (CF3Br) - ( 8) CFC11 (CFCl3) - ( 9) CFC113 (CCl2FCClF2) - ( 10) CFC114 (CClF2CClF2) - ( 11) CFC115 (CClF2CF3) - ( 12) CFC12 (CF2Cl2) - ( 13) CH2BR2 (CH2Br2) - ( 14) CH2O - ( 15) CH3BR (CH3Br) - ( 16) CH3CCL3 (CH3CCl3) - ( 17) CH3CL (CH3Cl) - ( 18) CH3O2 - ( 19) CH3OOH - ( 20) CH4 - ( 21) CHBR3 (CHBr3) - ( 22) CL2 (Cl2) - ( 23) CL2O2 (Cl2O2) - ( 24) CLO (ClO) - ( 25) CLONO2 (ClONO2) - ( 26) CLY - ( 27) CO - ( 28) CO2 - ( 29) COF2 - ( 30) COFCL (COFCl) - ( 31) F - ( 32) H - ( 33) H2 - ( 34) H2402 (CBrF2CBrF2) - ( 35) H2O2 - ( 36) HBR (HBr) - ( 37) HCFC141B (CH3CCl2F) - ( 38) HCFC142B (CH3CClF2) - ( 39) HCFC22 (CHF2Cl) - ( 40) HCL (HCl) - ( 41) HF - ( 42) HNO3 - ( 43) HO2 - ( 44) HO2NO2 - ( 45) HOBR (HOBr) - ( 46) HOCL (HOCl) - ( 47) N - ( 48) N2O - ( 49) N2O5 - ( 50) NO - ( 51) NO2 - ( 52) NO3 - ( 53) O - ( 54) O2 - ( 55) O3 - ( 56) OCLO (OClO) - ( 57) SF6 - ( 58) BR (Br) - ( 59) CL (Cl) - ( 60) e (E) + ( 1) BR (Br) + ( 2) BRCL (BrCl) + ( 3) BRO (BrO) + ( 4) BRONO2 (BrONO2) + ( 5) BRY + ( 6) CCL4 (CCl4) + ( 7) CF2CLBR (CF2ClBr) + ( 8) CF3BR (CF3Br) + ( 9) CFC11 (CFCl3) + ( 10) CFC113 (CCl2FCClF2) + ( 11) CFC114 (CClF2CClF2) + ( 12) CFC115 (CClF2CF3) + ( 13) CFC12 (CF2Cl2) + ( 14) CH2BR2 (CH2Br2) + ( 15) CH2O + ( 16) CH3BR (CH3Br) + ( 17) CH3CCL3 (CH3CCl3) + ( 18) CH3CL (CH3Cl) + ( 19) CH3O2 + ( 20) CH3OOH + ( 21) CH4 + ( 22) CHBR3 (CHBr3) + ( 23) CL (Cl) + ( 24) CL2 (Cl2) + ( 25) CL2O2 (Cl2O2) + ( 26) CLO (ClO) + ( 27) CLONO2 (ClONO2) + ( 28) CLY + ( 29) CO + ( 30) CO2 + ( 31) COF2 + ( 32) COFCL (COFCl) + ( 33) F + ( 34) H + ( 35) H2 + ( 36) H2402 (CBrF2CBrF2) + ( 37) H2O2 + ( 38) HBR (HBr) + ( 39) HCFC141B (CH3CCl2F) + ( 40) HCFC142B (CH3CClF2) + ( 41) HCFC22 (CHF2Cl) + ( 42) HCL (HCl) + ( 43) HF + ( 44) HNO3 + ( 45) HO2NO2 + ( 46) HOBR (HOBr) + ( 47) HOCL (HOCl) + ( 48) N + ( 49) N2O + ( 50) N2O5 + ( 51) NO + ( 52) NO2 + ( 53) NO3 + ( 54) O + ( 55) O2 + ( 56) O3 + ( 57) OCLO (OClO) + ( 58) SF6 + ( 59) e (E) + ( 60) HO2 ( 61) N2D (N) ( 62) N2p (N2) ( 63) NOp (NO) @@ -115,43 +115,43 @@ Class List Implicit -------- - ( 1) BRCL - ( 2) BRO - ( 3) BRONO2 - ( 4) CH2O - ( 5) CH3O2 - ( 6) CH3OOH - ( 7) CL2 - ( 8) CL2O2 - ( 9) CLO - ( 10) CLONO2 - ( 11) CO - ( 12) COF2 - ( 13) COFCL - ( 14) F - ( 15) H - ( 16) H2 - ( 17) H2O2 - ( 18) HBR - ( 19) HCL - ( 20) HF - ( 21) HNO3 - ( 22) HO2 - ( 23) HO2NO2 - ( 24) HOBR - ( 25) HOCL - ( 26) N - ( 27) N2O5 - ( 28) NO - ( 29) NO2 - ( 30) NO3 - ( 31) O - ( 32) O2 - ( 33) O3 - ( 34) OCLO - ( 35) BR - ( 36) CL - ( 37) e + ( 1) BR + ( 2) BRCL + ( 3) BRO + ( 4) BRONO2 + ( 5) CH2O + ( 6) CH3O2 + ( 7) CH3OOH + ( 8) CL + ( 9) CL2 + ( 10) CL2O2 + ( 11) CLO + ( 12) CLONO2 + ( 13) CO + ( 14) COF2 + ( 15) COFCL + ( 16) F + ( 17) H + ( 18) H2 + ( 19) H2O2 + ( 20) HBR + ( 21) HCL + ( 22) HF + ( 23) HNO3 + ( 24) HO2NO2 + ( 25) HOBR + ( 26) HOCL + ( 27) N + ( 28) N2O5 + ( 29) NO + ( 30) NO2 + ( 31) NO3 + ( 32) O + ( 33) O2 + ( 34) O3 + ( 35) OCLO + ( 36) e + ( 37) HO2 ( 38) N2D ( 39) N2p ( 40) NOp @@ -499,6 +499,13 @@ Extraneous prod/loss species Equation Report + d(BR)/dt = j26*BRCL + j27*BRO + j29*BRONO2 + j31*CF2CLBR + j32*CF3BR + 2*j38*CH2BR2 + j39*CH3BR + + 3*j42*CHBR3 + 2*j50*H2402 + j51*HBR + j57*HOBR + r90*O1D*CF2CLBR + 2*r103*BRO*BRO + + r104*BRO*CLO + r105*BRO*CLO + r108*BRO*NO + r111*BRO*O + r112*BRO*OH + r113*HBR*O + + r114*HBR*OH + r116*O1D*CF3BR + 3*r117*O1D*CHBR3 + 2*r118*O1D*H2402 + r119*O1D*HBR + + 2*r127*CH2BR2*CL + 2*r128*CH2BR2*OH + r129*CH3BR*CL + r130*CH3BR*OH + 3*r134*CHBR3*CL + + 3*r135*CHBR3*OH + 2*r139*O1D*CH2BR2 + r140*O1D*CH3BR + - r100*CH2O*BR - r101*HO2*BR - r102*O3*BR d(BRCL)/dt = r106*BRO*CLO + r168*HOBR*HCL + r173*HOBR*HCL - j26*BRCL d(BRO)/dt = j28*BRONO2 + r102*BR*O3 + r110*BRONO2*O + r115*HOBR*O + r120*O1D*HBR @@ -531,6 +538,16 @@ Extraneous prod/loss species d(CH4)/dt = - j23*CH4 - j24*CH4 - r65*CL*CH4 - r121*F*CH4 - r150*OH*CH4 - r152*O1D*CH4 - r153*O1D*CH4 - r154*O1D*CH4 d(CHBR3)/dt = - j42*CHBR3 - r117*O1D*CHBR3 - r134*CL*CHBR3 - r135*OH*CHBR3 + d(CL)/dt = j26*BRCL + 4*j30*CCL4 + j31*CF2CLBR + 2*j33*CFC11 + 2*j34*CFC113 + 2*j35*CFC114 + j36*CFC115 + + 2*j37*CFC12 + 3*j40*CH3CCL3 + j41*CH3CL + 2*j43*CL2 + 2*j44*CL2O2 + j45*CLO + j46*CLONO2 + + j49*COFCL + j52*HCFC141B + j53*HCFC142B + j54*HCFC22 + j55*HCL + j58*HOCL + r71*CLO*CH3O2 + + 2*r72*CLO*CLO + r74*CLO*CLO + r76*CLO*NO + r81*CLO*O + r82*CLO*OH + r84*HCL*O + r85*HCL*OH + + 4*r89*O1D*CCL4 + r90*O1D*CF2CLBR + 2*r91*O1D*CFC11 + 2*r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + r94*O1D*CFC115 + 2*r95*O1D*CFC12 + r96*O1D*HCL + r105*BRO*CLO + r126*O1D*COFCL + + 3*r131*CH3CCL3*OH + r133*CH3CL*OH + r136*HCFC141B*OH + r137*HCFC142B*OH + r138*HCFC22*OH + + r141*O1D*HCFC141B + r142*O1D*HCFC142B + r143*O1D*HCFC22 + - r64*CH2O*CL - r65*CH4*CL - r66*H2*CL - r67*H2O2*CL - r68*HO2*CL - r69*HO2*CL - r70*O3*CL + - r77*CLONO2*CL - r86*HOCL*CL - r127*CH2BR2*CL - r129*CH3BR*CL - r132*CH3CL*CL - r134*CHBR3*CL d(CL2)/dt = r73*CLO*CLO + r77*CLONO2*CL + r161*HOCL*HCL + r166*CLONO2*HCL + r167*HOCL*HCL + r171*CLONO2*HCL + r172*HOCL*HCL + r176*CLONO2*HCL - j43*CL2 @@ -586,13 +603,6 @@ Extraneous prod/loss species + r165*BRONO2 + r169*CLONO2 + r170*BRONO2 + 2*r174*N2O5 + r175*CLONO2 + r60*M*NO2*OH + r144*CH2O*NO3 + r166*CLONO2*HCL + r171*CLONO2*HCL + r176*CLONO2*HCL - j9*HNO3 - r61*OH*HNO3 - r124*F*HNO3 - d(HO2)/dt = j11*HO2NO2 + r62*M*HO2NO2 + r21*H2O2*O + r25*M*H*O2 + r30*OH*H2O2 + r33*OH*O3 + r51*NO3*OH - + r64*CL*CH2O + r67*CL*H2O2 + r71*CLO*CH3O2 + r82*CLO*OH + r100*BR*CH2O + r112*BRO*OH - + r129*CH3BR*CL + r130*CH3BR*OH + r132*CH3CL*CL + r133*CH3CL*OH + r144*CH2O*NO3 + r145*CH2O*O - + r148*CH3O2*NO + r151*M*CO*OH + r153*O1D*CH4 - - r156*HO2 - r22*H*HO2 - r23*H*HO2 - r24*H*HO2 - r26*O*HO2 - r27*O3*HO2 - r31*OH*HO2 - - 2*r36*HO2*HO2 - r48*NO3*HO2 - r53*NO*HO2 - r58*M*NO2*HO2 - r68*CL*HO2 - r69*CL*HO2 - - r75*CLO*HO2 - r101*BR*HO2 - r107*BRO*HO2 - r147*CH3O2*HO2 d(HO2NO2)/dt = r58*M*NO2*HO2 - j10*HO2NO2 - j11*HO2NO2 - r62*M*HO2NO2 - r37*OH*HO2NO2 d(HOBR)/dt = r162*BRONO2 + r165*BRONO2 + r170*BRONO2 + r107*BRO*HO2 @@ -646,27 +656,17 @@ Extraneous prod/loss species d(OCLO)/dt = r74*CLO*CLO + r104*BRO*CLO - j59*OCLO d(SF6)/dt = - j60*SF6 - d(BR)/dt = j26*BRCL + j27*BRO + j29*BRONO2 + j31*CF2CLBR + j32*CF3BR + 2*j38*CH2BR2 + j39*CH3BR - + 3*j42*CHBR3 + 2*j50*H2402 + j51*HBR + j57*HOBR + r90*O1D*CF2CLBR + 2*r103*BRO*BRO - + r104*BRO*CLO + r105*BRO*CLO + r108*BRO*NO + r111*BRO*O + r112*BRO*OH + r113*HBR*O - + r114*HBR*OH + r116*O1D*CF3BR + 3*r117*O1D*CHBR3 + 2*r118*O1D*H2402 + r119*O1D*HBR - + 2*r127*CH2BR2*CL + 2*r128*CH2BR2*OH + r129*CH3BR*CL + r130*CH3BR*OH + 3*r134*CHBR3*CL - + 3*r135*CHBR3*OH + 2*r139*O1D*CH2BR2 + r140*O1D*CH3BR - - r100*CH2O*BR - r101*HO2*BR - r102*O3*BR - d(CL)/dt = j26*BRCL + 4*j30*CCL4 + j31*CF2CLBR + 2*j33*CFC11 + 2*j34*CFC113 + 2*j35*CFC114 + j36*CFC115 - + 2*j37*CFC12 + 3*j40*CH3CCL3 + j41*CH3CL + 2*j43*CL2 + 2*j44*CL2O2 + j45*CLO + j46*CLONO2 - + j49*COFCL + j52*HCFC141B + j53*HCFC142B + j54*HCFC22 + j55*HCL + j58*HOCL + r71*CLO*CH3O2 - + 2*r72*CLO*CLO + r74*CLO*CLO + r76*CLO*NO + r81*CLO*O + r82*CLO*OH + r84*HCL*O + r85*HCL*OH - + 4*r89*O1D*CCL4 + r90*O1D*CF2CLBR + 2*r91*O1D*CFC11 + 2*r92*O1D*CFC113 + 2*r93*O1D*CFC114 - + r94*O1D*CFC115 + 2*r95*O1D*CFC12 + r96*O1D*HCL + r105*BRO*CLO + r126*O1D*COFCL - + 3*r131*CH3CCL3*OH + r133*CH3CL*OH + r136*HCFC141B*OH + r137*HCFC142B*OH + r138*HCFC22*OH - + r141*O1D*HCFC141B + r142*O1D*HCFC142B + r143*O1D*HCFC22 - - r64*CH2O*CL - r65*CH4*CL - r66*H2*CL - r67*H2O2*CL - r68*HO2*CL - r69*HO2*CL - r70*O3*CL - - r77*CLONO2*CL - r86*HOCL*CL - r127*CH2BR2*CL - r129*CH3BR*CL - r132*CH3CL*CL - r134*CHBR3*CL d(e)/dt = j63*N2 + j65*N2 + j66*N2 + j67*N2 + j69*N2 + j70*N2 + j16*NO + j62*N + j71*O + j72*O + j73*O + j74*O + j75*O + j76*O + j77*O2 + j78*O2 + j79*O2 + j80*O2 + j81*O2 + j84*O2 + j85*O2 + j86*O2 - r180*NOp*e - r181*O2p*e - r182*N2p*e + d(HO2)/dt = j11*HO2NO2 + r62*M*HO2NO2 + r21*H2O2*O + r25*M*H*O2 + r30*OH*H2O2 + r33*OH*O3 + r51*NO3*OH + + r64*CL*CH2O + r67*CL*H2O2 + r71*CLO*CH3O2 + r82*CLO*OH + r100*BR*CH2O + r112*BRO*OH + + r129*CH3BR*CL + r130*CH3BR*OH + r132*CH3CL*CL + r133*CH3CL*OH + r144*CH2O*NO3 + r145*CH2O*O + + r148*CH3O2*NO + r151*M*CO*OH + r153*O1D*CH4 + - r156*HO2 - r22*H*HO2 - r23*H*HO2 - r24*H*HO2 - r26*O*HO2 - r27*O3*HO2 - r31*OH*HO2 + - 2*r36*HO2*HO2 - r48*NO3*HO2 - r53*NO*HO2 - r58*M*NO2*HO2 - r68*CL*HO2 - r69*CL*HO2 + - r75*CLO*HO2 - r101*BR*HO2 - r107*BRO*HO2 - r147*CH3O2*HO2 d(N2D)/dt = j63*N2 + 1.2*j64*N2 + 1.2*j68*N2 + j69*N2 + .8*r180*NOp*e + .9*r182*N2p*e + r184*N2p*O - r38*O*N2D - r39*O2*N2D - r194*Op*N2D d(N2p)/dt = j65*N2 + j67*N2 + r197*N2*Op2D + r202*N2*Op2P diff --git a/src/chemistry/pp_waccm_ma/chem_mech.in b/src/chemistry/pp_waccm_ma/chem_mech.in index a219f1d2de..6564d151d4 100644 --- a/src/chemistry/pp_waccm_ma/chem_mech.in +++ b/src/chemistry/pp_waccm_ma/chem_mech.in @@ -1,15 +1,16 @@ * Comments -* User-given Tag Description: MA_1 -* Tag database identifier : MZ255_MA_20190128 -* Tag created by : ajc +* User-given Tag Description: WACCM_MA +* Tag database identifier : MZ282_MA_20210122 +* Tag created by : lke * Tag created from branch : MA -* Tag created on : 2019-01-28 15:31:03.753615-07 +* Tag created on : 2021-01-22 15:26:54.35253-07 * Comments for this tag follow: -* ajc : 2019-01-28 : add ion_Op_N2D +* lke : 2021-01-22 : Middle Atmosphere mechanism for WACCM, no aerosols, with BR, CL transported SPECIES Solution + BR -> Br, BRCL -> BrCl, BRO -> BrO, BRONO2 -> BrONO2, @@ -31,6 +32,7 @@ CH3OOH, CH4, CHBR3 -> CHBr3, + CL -> Cl, CL2 -> Cl2, CL2O2 -> Cl2O2, CLO -> ClO, @@ -52,7 +54,6 @@ HCL -> HCl, HF, HNO3, - HO2, HO2NO2, HOBR -> HOBr, HOCL -> HOCl, @@ -67,9 +68,8 @@ O3, OCLO -> OClO, SF6, - BR -> Br, - CL -> Cl, e -> E, + HO2, N2D -> N, N2p -> N2, NOp -> NO, @@ -97,9 +97,8 @@ End Col-int Not-Transported - BR, - CL, e, + HO2, N2D, N2p, NOp, @@ -145,12 +144,14 @@ End Explicit Implicit + BR BRCL BRO BRONO2 CH2O CH3O2 CH3OOH + CL CL2 CL2O2 CLO @@ -166,7 +167,6 @@ HCL HF HNO3 - HO2 HO2NO2 HOBR HOCL @@ -179,9 +179,8 @@ O2 O3 OCLO - BR - CL e + HO2 N2D N2p NOp diff --git a/src/chemistry/pp_waccm_ma/chem_mods.F90 b/src/chemistry/pp_waccm_ma/chem_mods.F90 index a4de6f541a..4daa9f36ee 100644 --- a/src/chemistry/pp_waccm_ma/chem_mods.F90 +++ b/src/chemistry/pp_waccm_ma/chem_mods.F90 @@ -25,7 +25,7 @@ module chem_mods clsze = 1, & ! loop length for implicit chemistry rxt_tag_cnt = 290, & enthalpy_cnt = 54, & - nslvd = 15 + nslvd = 14 integer :: clscnt(5) = 0 integer :: cls_rxt_cnt(4,5) = 0 integer :: clsmap(gas_pcnst,5) = 0 diff --git a/src/chemistry/pp_waccm_ma/m_spc_id.F90 b/src/chemistry/pp_waccm_ma/m_spc_id.F90 index f00c8eff7d..f4dcd3ff5b 100644 --- a/src/chemistry/pp_waccm_ma/m_spc_id.F90 +++ b/src/chemistry/pp_waccm_ma/m_spc_id.F90 @@ -1,65 +1,65 @@ module m_spc_id implicit none - integer, parameter :: id_BRCL = 1 - integer, parameter :: id_BRO = 2 - integer, parameter :: id_BRONO2 = 3 - integer, parameter :: id_BRY = 4 - integer, parameter :: id_CCL4 = 5 - integer, parameter :: id_CF2CLBR = 6 - integer, parameter :: id_CF3BR = 7 - integer, parameter :: id_CFC11 = 8 - integer, parameter :: id_CFC113 = 9 - integer, parameter :: id_CFC114 = 10 - integer, parameter :: id_CFC115 = 11 - integer, parameter :: id_CFC12 = 12 - integer, parameter :: id_CH2BR2 = 13 - integer, parameter :: id_CH2O = 14 - integer, parameter :: id_CH3BR = 15 - integer, parameter :: id_CH3CCL3 = 16 - integer, parameter :: id_CH3CL = 17 - integer, parameter :: id_CH3O2 = 18 - integer, parameter :: id_CH3OOH = 19 - integer, parameter :: id_CH4 = 20 - integer, parameter :: id_CHBR3 = 21 - integer, parameter :: id_CL2 = 22 - integer, parameter :: id_CL2O2 = 23 - integer, parameter :: id_CLO = 24 - integer, parameter :: id_CLONO2 = 25 - integer, parameter :: id_CLY = 26 - integer, parameter :: id_CO = 27 - integer, parameter :: id_CO2 = 28 - integer, parameter :: id_COF2 = 29 - integer, parameter :: id_COFCL = 30 - integer, parameter :: id_F = 31 - integer, parameter :: id_H = 32 - integer, parameter :: id_H2 = 33 - integer, parameter :: id_H2402 = 34 - integer, parameter :: id_H2O2 = 35 - integer, parameter :: id_HBR = 36 - integer, parameter :: id_HCFC141B = 37 - integer, parameter :: id_HCFC142B = 38 - integer, parameter :: id_HCFC22 = 39 - integer, parameter :: id_HCL = 40 - integer, parameter :: id_HF = 41 - integer, parameter :: id_HNO3 = 42 - integer, parameter :: id_HO2 = 43 - integer, parameter :: id_HO2NO2 = 44 - integer, parameter :: id_HOBR = 45 - integer, parameter :: id_HOCL = 46 - integer, parameter :: id_N = 47 - integer, parameter :: id_N2O = 48 - integer, parameter :: id_N2O5 = 49 - integer, parameter :: id_NO = 50 - integer, parameter :: id_NO2 = 51 - integer, parameter :: id_NO3 = 52 - integer, parameter :: id_O = 53 - integer, parameter :: id_O2 = 54 - integer, parameter :: id_O3 = 55 - integer, parameter :: id_OCLO = 56 - integer, parameter :: id_SF6 = 57 - integer, parameter :: id_BR = 58 - integer, parameter :: id_CL = 59 - integer, parameter :: id_e = 60 + integer, parameter :: id_BR = 1 + integer, parameter :: id_BRCL = 2 + integer, parameter :: id_BRO = 3 + integer, parameter :: id_BRONO2 = 4 + integer, parameter :: id_BRY = 5 + integer, parameter :: id_CCL4 = 6 + integer, parameter :: id_CF2CLBR = 7 + integer, parameter :: id_CF3BR = 8 + integer, parameter :: id_CFC11 = 9 + integer, parameter :: id_CFC113 = 10 + integer, parameter :: id_CFC114 = 11 + integer, parameter :: id_CFC115 = 12 + integer, parameter :: id_CFC12 = 13 + integer, parameter :: id_CH2BR2 = 14 + integer, parameter :: id_CH2O = 15 + integer, parameter :: id_CH3BR = 16 + integer, parameter :: id_CH3CCL3 = 17 + integer, parameter :: id_CH3CL = 18 + integer, parameter :: id_CH3O2 = 19 + integer, parameter :: id_CH3OOH = 20 + integer, parameter :: id_CH4 = 21 + integer, parameter :: id_CHBR3 = 22 + integer, parameter :: id_CL = 23 + integer, parameter :: id_CL2 = 24 + integer, parameter :: id_CL2O2 = 25 + integer, parameter :: id_CLO = 26 + integer, parameter :: id_CLONO2 = 27 + integer, parameter :: id_CLY = 28 + integer, parameter :: id_CO = 29 + integer, parameter :: id_CO2 = 30 + integer, parameter :: id_COF2 = 31 + integer, parameter :: id_COFCL = 32 + integer, parameter :: id_F = 33 + integer, parameter :: id_H = 34 + integer, parameter :: id_H2 = 35 + integer, parameter :: id_H2402 = 36 + integer, parameter :: id_H2O2 = 37 + integer, parameter :: id_HBR = 38 + integer, parameter :: id_HCFC141B = 39 + integer, parameter :: id_HCFC142B = 40 + integer, parameter :: id_HCFC22 = 41 + integer, parameter :: id_HCL = 42 + integer, parameter :: id_HF = 43 + integer, parameter :: id_HNO3 = 44 + integer, parameter :: id_HO2NO2 = 45 + integer, parameter :: id_HOBR = 46 + integer, parameter :: id_HOCL = 47 + integer, parameter :: id_N = 48 + integer, parameter :: id_N2O = 49 + integer, parameter :: id_N2O5 = 50 + integer, parameter :: id_NO = 51 + integer, parameter :: id_NO2 = 52 + integer, parameter :: id_NO3 = 53 + integer, parameter :: id_O = 54 + integer, parameter :: id_O2 = 55 + integer, parameter :: id_O3 = 56 + integer, parameter :: id_OCLO = 57 + integer, parameter :: id_SF6 = 58 + integer, parameter :: id_e = 59 + integer, parameter :: id_HO2 = 60 integer, parameter :: id_N2D = 61 integer, parameter :: id_N2p = 62 integer, parameter :: id_NOp = 63 diff --git a/src/chemistry/pp_waccm_ma/mo_adjrxt.F90 b/src/chemistry/pp_waccm_ma/mo_adjrxt.F90 index f7c7af4176..5fced11465 100644 --- a/src/chemistry/pp_waccm_ma/mo_adjrxt.F90 +++ b/src/chemistry/pp_waccm_ma/mo_adjrxt.F90 @@ -16,27 +16,27 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) rate(:,:, 91) = rate(:,:, 91) * inv(:,:, 2) rate(:,:, 95) = rate(:,:, 95) * inv(:,:, 2) rate(:,:, 99) = rate(:,:, 99) * inv(:,:, 2) - rate(:,:,104) = rate(:,:,104) * inv(:,:, 1) - rate(:,:,105) = rate(:,:,105) * inv(:,:, 1) - rate(:,:,111) = rate(:,:,111) * inv(:,:, 1) - rate(:,:,121) = rate(:,:,121) * inv(:,:, 1) - rate(:,:,133) = rate(:,:,133) * inv(:,:, 1) - rate(:,:,141) = rate(:,:,141) * inv(:,:, 1) - rate(:,:,144) = rate(:,:,144) * inv(:,:, 1) - rate(:,:,145) = rate(:,:,145) * inv(:,:, 1) - rate(:,:,146) = rate(:,:,146) * inv(:,:, 1) - rate(:,:,148) = rate(:,:,148) * inv(:,:, 1) - rate(:,:,149) = rate(:,:,149) * inv(:,:, 1) - rate(:,:,164) = rate(:,:,164) * inv(:,:, 1) - rate(:,:,184) = rate(:,:,184) * inv(:,:, 1) - rate(:,:,185) = rate(:,:,185) * inv(:,:, 1) - rate(:,:,195) = rate(:,:,195) * inv(:,:, 1) - rate(:,:,237) = rate(:,:,237) * inv(:,:, 1) - rate(:,:,276) = rate(:,:,276) * inv(:,:, 2) - rate(:,:,279) = rate(:,:,279) * inv(:,:, 2) - rate(:,:,283) = rate(:,:,283) * inv(:,:, 2) - rate(:,:,288) = rate(:,:,288) * inv(:,:, 2) - rate(:,:,289) = rate(:,:,289) * inv(:,:, 2) + rate(:,:, 104) = rate(:,:, 104) * inv(:,:, 1) + rate(:,:, 105) = rate(:,:, 105) * inv(:,:, 1) + rate(:,:, 111) = rate(:,:, 111) * inv(:,:, 1) + rate(:,:, 121) = rate(:,:, 121) * inv(:,:, 1) + rate(:,:, 133) = rate(:,:, 133) * inv(:,:, 1) + rate(:,:, 141) = rate(:,:, 141) * inv(:,:, 1) + rate(:,:, 144) = rate(:,:, 144) * inv(:,:, 1) + rate(:,:, 145) = rate(:,:, 145) * inv(:,:, 1) + rate(:,:, 146) = rate(:,:, 146) * inv(:,:, 1) + rate(:,:, 148) = rate(:,:, 148) * inv(:,:, 1) + rate(:,:, 149) = rate(:,:, 149) * inv(:,:, 1) + rate(:,:, 164) = rate(:,:, 164) * inv(:,:, 1) + rate(:,:, 184) = rate(:,:, 184) * inv(:,:, 1) + rate(:,:, 185) = rate(:,:, 185) * inv(:,:, 1) + rate(:,:, 195) = rate(:,:, 195) * inv(:,:, 1) + rate(:,:, 237) = rate(:,:, 237) * inv(:,:, 1) + rate(:,:, 276) = rate(:,:, 276) * inv(:,:, 2) + rate(:,:, 279) = rate(:,:, 279) * inv(:,:, 2) + rate(:,:, 283) = rate(:,:, 283) * inv(:,:, 2) + rate(:,:, 288) = rate(:,:, 288) * inv(:,:, 2) + rate(:,:, 289) = rate(:,:, 289) * inv(:,:, 2) rate(:,:, 89) = rate(:,:, 89) * m(:,:) rate(:,:, 90) = rate(:,:, 90) * m(:,:) rate(:,:, 92) = rate(:,:, 92) * m(:,:) @@ -45,172 +45,172 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) rate(:,:, 96) = rate(:,:, 96) * m(:,:) rate(:,:, 97) = rate(:,:, 97) * m(:,:) rate(:,:, 98) = rate(:,:, 98) * m(:,:) - rate(:,:,100) = rate(:,:,100) * 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(:,:,117) = rate(:,:,117) * 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(:,:,135) = rate(:,:,135) * m(:,:) - rate(:,:,136) = rate(:,:,136) * 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(:,:,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(:,:,172) = rate(:,:,172) * 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(:,:,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(:,:,247) = rate(:,:,247) * m(:,:) - rate(:,:,252) = rate(:,:,252) * m(:,:) - rate(:,:,253) = rate(:,:,253) * m(:,:) - rate(:,:,254) = rate(:,:,254) * m(:,:) - rate(:,:,257) = rate(:,:,257) * m(:,:) - rate(:,:,258) = rate(:,:,258) * m(:,:) - rate(:,:,259) = rate(:,:,259) * m(:,:) - rate(:,:,262) = rate(:,:,262) * 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(:,:,277) = rate(:,:,277) * m(:,:) - rate(:,:,278) = rate(:,:,278) * m(:,:) - rate(:,:,280) = rate(:,:,280) * m(:,:) - rate(:,:,281) = rate(:,:,281) * m(:,:) - rate(:,:,282) = rate(:,:,282) * m(:,:) - rate(:,:,284) = rate(:,:,284) * m(:,:) - rate(:,:,285) = rate(:,:,285) * m(:,:) - rate(:,:,286) = rate(:,:,286) * m(:,:) - rate(:,:,287) = rate(:,:,287) * m(:,:) - rate(:,:,290) = rate(:,:,290) * m(:,:) + rate(:,:, 100) = rate(:,:, 100) * 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(:,:, 117) = rate(:,:, 117) * 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(:,:, 135) = rate(:,:, 135) * m(:,:) + rate(:,:, 136) = rate(:,:, 136) * 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(:,:, 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(:,:, 172) = rate(:,:, 172) * 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(:,:, 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(:,:, 247) = rate(:,:, 247) * m(:,:) + rate(:,:, 252) = rate(:,:, 252) * m(:,:) + rate(:,:, 253) = rate(:,:, 253) * m(:,:) + rate(:,:, 254) = rate(:,:, 254) * m(:,:) + rate(:,:, 257) = rate(:,:, 257) * m(:,:) + rate(:,:, 258) = rate(:,:, 258) * m(:,:) + rate(:,:, 259) = rate(:,:, 259) * m(:,:) + rate(:,:, 262) = rate(:,:, 262) * 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(:,:, 277) = rate(:,:, 277) * m(:,:) + rate(:,:, 278) = rate(:,:, 278) * m(:,:) + rate(:,:, 280) = rate(:,:, 280) * m(:,:) + rate(:,:, 281) = rate(:,:, 281) * m(:,:) + rate(:,:, 282) = rate(:,:, 282) * m(:,:) + rate(:,:, 284) = rate(:,:, 284) * m(:,:) + rate(:,:, 285) = rate(:,:, 285) * m(:,:) + rate(:,:, 286) = rate(:,:, 286) * m(:,:) + rate(:,:, 287) = rate(:,:, 287) * m(:,:) + rate(:,:, 290) = rate(:,:, 290) * m(:,:) end subroutine adjrxt end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_ma/mo_indprd.F90 b/src/chemistry/pp_waccm_ma/mo_indprd.F90 index bec3676844..862a913c43 100644 --- a/src/chemistry/pp_waccm_ma/mo_indprd.F90 +++ b/src/chemistry/pp_waccm_ma/mo_indprd.F90 @@ -36,80 +36,80 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) prod(:,14) = 0._r8 prod(:,15) = 0._r8 prod(:,16) = 0._r8 - prod(:,17) = (rxt(:,237)*y(:,69) +rxt(:,241)*y(:,69))*y(:,27) + prod(:,17) = (rxt(:,237)*y(:,69) +rxt(:,241)*y(:,69))*y(:,29) prod(:,18) = 0._r8 prod(:,19) = 0._r8 prod(:,20) = 0._r8 prod(:,21) = 0._r8 - prod(:,22) =rxt(:,127)*y(:,51)*y(:,47) + prod(:,22) =rxt(:,127)*y(:,52)*y(:,48) prod(:,23) = 0._r8 !-------------------------------------------------------------------- ! ... "independent" production for Implicit species !-------------------------------------------------------------------- else if( class == 4 ) then + prod(:,38) =rxt(:,31)*y(:,7) +rxt(:,32)*y(:,8) +2.000_r8*rxt(:,38)*y(:,14) & + +rxt(:,39)*y(:,16) +3.000_r8*rxt(:,42)*y(:,22) +2.000_r8*rxt(:,50) & + *y(:,36) prod(:,8) = 0._r8 - prod(:,39) = 0._r8 + prod(:,44) = 0._r8 prod(:,15) = 0._r8 - prod(:,35) =.180_r8*rxt(:,24)*y(:,20) - prod(:,44) =rxt(:,39)*y(:,15) +rxt(:,41)*y(:,17) +rxt(:,23)*y(:,20) + prod(:,35) =.180_r8*rxt(:,24)*y(:,21) + prod(:,47) =rxt(:,39)*y(:,16) +rxt(:,41)*y(:,18) +rxt(:,23)*y(:,21) prod(:,11) = 0._r8 + prod(:,48) =4.000_r8*rxt(:,30)*y(:,6) +rxt(:,31)*y(:,7) +2.000_r8*rxt(:,33) & + *y(:,9) +2.000_r8*rxt(:,34)*y(:,10) +2.000_r8*rxt(:,35)*y(:,11) & + +rxt(:,36)*y(:,12) +2.000_r8*rxt(:,37)*y(:,13) +3.000_r8*rxt(:,40) & + *y(:,17) +rxt(:,41)*y(:,18) +rxt(:,52)*y(:,39) +rxt(:,53)*y(:,40) & + +rxt(:,54)*y(:,41) prod(:,6) = 0._r8 prod(:,1) = 0._r8 - prod(:,41) = 0._r8 + prod(:,43) = 0._r8 prod(:,30) = 0._r8 - prod(:,16) = (rxt(:,25) +rxt(:,61))*y(:,28) +.380_r8*rxt(:,24)*y(:,20) & + prod(:,16) = (rxt(:,25) +rxt(:,61))*y(:,30) +.380_r8*rxt(:,24)*y(:,21) & + extfrc(:,2) - prod(:,2) =rxt(:,31)*y(:,6) +rxt(:,32)*y(:,7) +rxt(:,34)*y(:,9) & - +2.000_r8*rxt(:,35)*y(:,10) +2.000_r8*rxt(:,36)*y(:,11) +rxt(:,37) & - *y(:,12) +2.000_r8*rxt(:,50)*y(:,34) +rxt(:,53)*y(:,38) +rxt(:,54) & - *y(:,39) - prod(:,7) =rxt(:,33)*y(:,8) +rxt(:,34)*y(:,9) +rxt(:,52)*y(:,37) - prod(:,21) =rxt(:,32)*y(:,7) +rxt(:,36)*y(:,11) - prod(:,36) = (rxt(:,23) +.330_r8*rxt(:,24))*y(:,20) - prod(:,49) =1.440_r8*rxt(:,24)*y(:,20) + prod(:,2) =rxt(:,31)*y(:,7) +rxt(:,32)*y(:,8) +rxt(:,34)*y(:,10) & + +2.000_r8*rxt(:,35)*y(:,11) +2.000_r8*rxt(:,36)*y(:,12) +rxt(:,37) & + *y(:,13) +2.000_r8*rxt(:,50)*y(:,36) +rxt(:,53)*y(:,40) +rxt(:,54) & + *y(:,41) + prod(:,7) =rxt(:,33)*y(:,9) +rxt(:,34)*y(:,10) +rxt(:,52)*y(:,39) + prod(:,21) =rxt(:,32)*y(:,8) +rxt(:,36)*y(:,12) + prod(:,36) = (rxt(:,23) +.330_r8*rxt(:,24))*y(:,21) + prod(:,39) =1.440_r8*rxt(:,24)*y(:,21) prod(:,17) = 0._r8 - prod(:,23) = 0._r8 + prod(:,22) = 0._r8 prod(:,34) = 0._r8 prod(:,9) = 0._r8 prod(:,31) = 0._r8 - prod(:,47) = 0._r8 prod(:,12) = 0._r8 prod(:,20) = 0._r8 - prod(:,22) = 0._r8 + prod(:,23) = 0._r8 prod(:,29) = (.800_r8*rxt(:,64) +rxt(:,66) +.800_r8*rxt(:,68) +rxt(:,70)) & + extfrc(:,7) prod(:,10) = 0._r8 - prod(:,38) = + extfrc(:,3) - prod(:,45) = + extfrc(:,1) - prod(:,37) = 0._r8 - prod(:,48) = (rxt(:,25) +rxt(:,61))*y(:,28) +.180_r8*rxt(:,24)*y(:,20) + prod(:,40) = + extfrc(:,3) + prod(:,41) = + extfrc(:,1) + prod(:,45) = 0._r8 + prod(:,50) = (rxt(:,25) +rxt(:,61))*y(:,30) +.180_r8*rxt(:,24)*y(:,21) prod(:,32) = 0._r8 - prod(:,50) = 0._r8 + prod(:,49) = 0._r8 prod(:,3) = 0._r8 - prod(:,43) =rxt(:,31)*y(:,6) +rxt(:,32)*y(:,7) +2.000_r8*rxt(:,38)*y(:,13) & - +rxt(:,39)*y(:,15) +3.000_r8*rxt(:,42)*y(:,21) +2.000_r8*rxt(:,50) & - *y(:,34) - prod(:,40) =4.000_r8*rxt(:,30)*y(:,5) +rxt(:,31)*y(:,6) +2.000_r8*rxt(:,33) & - *y(:,8) +2.000_r8*rxt(:,34)*y(:,9) +2.000_r8*rxt(:,35)*y(:,10) & - +rxt(:,36)*y(:,11) +2.000_r8*rxt(:,37)*y(:,12) +3.000_r8*rxt(:,40) & - *y(:,16) +rxt(:,41)*y(:,17) +rxt(:,52)*y(:,37) +rxt(:,53)*y(:,38) & - +rxt(:,54)*y(:,39) prod(:,27) = (rxt(:,63) +rxt(:,65) +rxt(:,66) +rxt(:,67) +rxt(:,69) + & rxt(:,70)) + extfrc(:,9) + prod(:,37) = 0._r8 prod(:,28) = (rxt(:,63) +1.200_r8*rxt(:,64) +1.200_r8*rxt(:,68) +rxt(:,69)) & + extfrc(:,11) prod(:,18) = (rxt(:,65) +rxt(:,67)) + extfrc(:,6) prod(:,19) = 0._r8 prod(:,24) = (rxt(:,63) +rxt(:,66) +rxt(:,69) +rxt(:,70)) + extfrc(:,10) - prod(:,42) =rxt(:,12)*y(:,48) + prod(:,42) =rxt(:,12)*y(:,49) prod(:,4) = 0._r8 prod(:,5) = 0._r8 prod(:,26) = + extfrc(:,4) - prod(:,46) =.330_r8*rxt(:,24)*y(:,20) + extfrc(:,8) + prod(:,46) =.330_r8*rxt(:,24)*y(:,21) + extfrc(:,8) prod(:,25) = + extfrc(:,5) prod(:,14) = 0._r8 prod(:,13) = 0._r8 - prod(:,33) =.050_r8*rxt(:,24)*y(:,20) + prod(:,33) =.050_r8*rxt(:,24)*y(:,21) end if end subroutine indprd end module mo_indprd diff --git a/src/chemistry/pp_waccm_ma/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_ma/mo_lin_matrix.F90 index 464e66e6fc..3ac9760926 100644 --- a/src/chemistry/pp_waccm_ma/mo_lin_matrix.F90 +++ b/src/chemistry/pp_waccm_ma/mo_lin_matrix.F90 @@ -23,213 +23,213 @@ subroutine linmat01( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,21) = -( rxt(k,26) + het_rates(k,1) ) - mat(k,363) = -( rxt(k,27) + het_rates(k,2) ) - mat(k,63) = rxt(k,28) + mat(k,341) = -( het_rates(k,1) ) + mat(k,22) = rxt(k,26) + mat(k,482) = rxt(k,27) + mat(k,62) = rxt(k,29) + mat(k,113) = rxt(k,51) + mat(k,96) = rxt(k,57) + mat(k,433) = rxt(k,176)*y(k,7) + rxt(k,202)*y(k,8) + 3.000_r8*rxt(k,203)*y(k,22) & + + 2.000_r8*rxt(k,204)*y(k,36) + 2.000_r8*rxt(k,225)*y(k,14) & + + rxt(k,226)*y(k,16) + mat(k,578) = 2.000_r8*rxt(k,213)*y(k,14) + rxt(k,215)*y(k,16) & + + 3.000_r8*rxt(k,220)*y(k,22) + mat(k,534) = 2.000_r8*rxt(k,214)*y(k,14) + rxt(k,216)*y(k,16) & + + 3.000_r8*rxt(k,221)*y(k,22) + mat(k,21) = -( rxt(k,26) + het_rates(k,2) ) + mat(k,488) = -( rxt(k,27) + het_rates(k,3) ) + mat(k,64) = rxt(k,28) mat(k,59) = -( rxt(k,28) + rxt(k,29) + rxt(k,248) + rxt(k,251) + rxt(k,256) & - + het_rates(k,3) ) - mat(k,282) = -( rxt(k,20) + rxt(k,21) + het_rates(k,14) ) + + het_rates(k,4) ) + mat(k,282) = -( rxt(k,20) + rxt(k,21) + het_rates(k,15) ) mat(k,35) = rxt(k,22) - mat(k,435) = rxt(k,239)*y(k,20) + rxt(k,240)*y(k,20) - mat(k,483) = -( het_rates(k,18) ) - mat(k,393) = rxt(k,151)*y(k,20) - mat(k,107) = rxt(k,207)*y(k,20) - mat(k,539) = rxt(k,236)*y(k,20) - mat(k,444) = rxt(k,238)*y(k,20) - mat(k,33) = -( rxt(k,22) + het_rates(k,19) ) - mat(k,15) = -( rxt(k,43) + het_rates(k,22) ) - mat(k,1) = -( rxt(k,44) + rxt(k,185) + het_rates(k,23) ) - mat(k,416) = -( rxt(k,45) + het_rates(k,24) ) - mat(k,210) = rxt(k,47) + mat(k,430) = rxt(k,239)*y(k,21) + rxt(k,240)*y(k,21) + mat(k,562) = -( het_rates(k,19) ) + mat(k,587) = rxt(k,151)*y(k,21) + mat(k,109) = rxt(k,207)*y(k,21) + mat(k,543) = rxt(k,236)*y(k,21) + mat(k,442) = rxt(k,238)*y(k,21) + mat(k,33) = -( rxt(k,22) + het_rates(k,20) ) + mat(k,588) = -( rxt(k,151)*y(k,21) + rxt(k,213)*y(k,14) + rxt(k,215)*y(k,16) & + + rxt(k,218)*y(k,18) + rxt(k,220)*y(k,22) + het_rates(k,23) ) + mat(k,23) = rxt(k,26) + mat(k,16) = 2.000_r8*rxt(k,43) + mat(k,3) = 2.000_r8*rxt(k,44) + mat(k,469) = rxt(k,45) + mat(k,212) = rxt(k,46) + mat(k,20) = rxt(k,49) + mat(k,275) = rxt(k,55) + mat(k,124) = rxt(k,58) + mat(k,443) = 4.000_r8*rxt(k,175)*y(k,6) + rxt(k,176)*y(k,7) & + + 2.000_r8*rxt(k,177)*y(k,9) + 2.000_r8*rxt(k,178)*y(k,10) & + + 2.000_r8*rxt(k,179)*y(k,11) + rxt(k,180)*y(k,12) & + + 2.000_r8*rxt(k,181)*y(k,13) + rxt(k,227)*y(k,39) & + + rxt(k,228)*y(k,40) + rxt(k,229)*y(k,41) + mat(k,544) = 3.000_r8*rxt(k,217)*y(k,17) + rxt(k,219)*y(k,18) & + + rxt(k,222)*y(k,39) + rxt(k,223)*y(k,40) + rxt(k,224)*y(k,41) + mat(k,15) = -( rxt(k,43) + het_rates(k,24) ) + mat(k,1) = -( rxt(k,44) + rxt(k,185) + het_rates(k,25) ) + mat(k,464) = -( rxt(k,45) + het_rates(k,26) ) + mat(k,209) = rxt(k,47) mat(k,8) = rxt(k,59) - mat(k,3) = 2.000_r8*rxt(k,185) + mat(k,2) = 2.000_r8*rxt(k,185) mat(k,204) = -( rxt(k,46) + rxt(k,47) + rxt(k,250) + rxt(k,255) + rxt(k,261) & - + het_rates(k,25) ) - mat(k,67) = -( het_rates(k,27) ) + + het_rates(k,27) ) + mat(k,67) = -( het_rates(k,29) ) mat(k,277) = rxt(k,20) + rxt(k,21) - mat(k,376) = rxt(k,218)*y(k,17) - mat(k,135) = rxt(k,278)*y(k,28) - mat(k,4) = -( rxt(k,48) + het_rates(k,29) ) - mat(k,426) = rxt(k,176)*y(k,6) + rxt(k,178)*y(k,9) + 2.000_r8*rxt(k,179)*y(k,10) & - + 2.000_r8*rxt(k,180)*y(k,11) + rxt(k,181)*y(k,12) & - + rxt(k,202)*y(k,7) + 2.000_r8*rxt(k,204)*y(k,34) & - + rxt(k,228)*y(k,38) + rxt(k,229)*y(k,39) - mat(k,515) = rxt(k,223)*y(k,38) + rxt(k,224)*y(k,39) - mat(k,17) = -( rxt(k,49) + het_rates(k,30) ) - mat(k,428) = rxt(k,177)*y(k,8) + rxt(k,178)*y(k,9) + rxt(k,227)*y(k,37) - mat(k,516) = rxt(k,222)*y(k,37) - mat(k,102) = -( rxt(k,207)*y(k,20) + het_rates(k,31) ) + mat(k,567) = rxt(k,218)*y(k,18) + mat(k,135) = rxt(k,278)*y(k,30) + mat(k,4) = -( rxt(k,48) + het_rates(k,31) ) + mat(k,421) = rxt(k,176)*y(k,7) + rxt(k,178)*y(k,10) + 2.000_r8*rxt(k,179)*y(k,11) & + + 2.000_r8*rxt(k,180)*y(k,12) + rxt(k,181)*y(k,13) & + + rxt(k,202)*y(k,8) + 2.000_r8*rxt(k,204)*y(k,36) & + + rxt(k,228)*y(k,40) + rxt(k,229)*y(k,41) + mat(k,516) = rxt(k,223)*y(k,40) + rxt(k,224)*y(k,41) + mat(k,17) = -( rxt(k,49) + het_rates(k,32) ) + mat(k,423) = rxt(k,177)*y(k,9) + rxt(k,178)*y(k,10) + rxt(k,227)*y(k,39) + mat(k,517) = rxt(k,222)*y(k,39) + mat(k,102) = -( rxt(k,207)*y(k,21) + het_rates(k,33) ) mat(k,5) = 2.000_r8*rxt(k,48) mat(k,18) = rxt(k,49) mat(k,25) = rxt(k,56) - mat(k,429) = rxt(k,180)*y(k,11) + rxt(k,202)*y(k,7) - mat(k,298) = -( het_rates(k,32) ) + mat(k,424) = rxt(k,180)*y(k,12) + rxt(k,202)*y(k,8) + mat(k,298) = -( het_rates(k,34) ) mat(k,249) = 2.000_r8*rxt(k,2) + rxt(k,3) mat(k,283) = 2.000_r8*rxt(k,20) mat(k,36) = rxt(k,22) - mat(k,120) = rxt(k,51) + mat(k,112) = rxt(k,51) mat(k,265) = rxt(k,55) mat(k,26) = rxt(k,56) - mat(k,436) = rxt(k,239)*y(k,20) - mat(k,628) = -( het_rates(k,33) ) - mat(k,256) = rxt(k,1) - mat(k,295) = rxt(k,21) - mat(k,449) = rxt(k,240)*y(k,20) - mat(k,71) = -( rxt(k,4) + het_rates(k,35) ) - mat(k,548) = .500_r8*rxt(k,242) - mat(k,118) = -( rxt(k,51) + het_rates(k,36) ) - mat(k,264) = -( rxt(k,55) + het_rates(k,40) ) - mat(k,383) = rxt(k,151)*y(k,20) + rxt(k,213)*y(k,13) + rxt(k,215)*y(k,15) & - + 2.000_r8*rxt(k,218)*y(k,17) + rxt(k,220)*y(k,21) - mat(k,24) = -( rxt(k,56) + het_rates(k,41) ) - mat(k,101) = rxt(k,207)*y(k,20) - mat(k,216) = -( rxt(k,9) + het_rates(k,42) ) + mat(k,431) = rxt(k,239)*y(k,21) + mat(k,362) = -( het_rates(k,35) ) + mat(k,250) = rxt(k,1) + mat(k,286) = rxt(k,21) + mat(k,434) = rxt(k,240)*y(k,21) + mat(k,71) = -( rxt(k,4) + het_rates(k,37) ) + mat(k,311) = .500_r8*rxt(k,242) + mat(k,110) = -( rxt(k,51) + het_rates(k,38) ) + mat(k,264) = -( rxt(k,55) + het_rates(k,42) ) + mat(k,574) = rxt(k,151)*y(k,21) + rxt(k,213)*y(k,14) + rxt(k,215)*y(k,16) & + + 2.000_r8*rxt(k,218)*y(k,18) + rxt(k,220)*y(k,22) + mat(k,24) = -( rxt(k,56) + het_rates(k,43) ) + mat(k,101) = rxt(k,207)*y(k,21) + mat(k,216) = -( rxt(k,9) + het_rates(k,44) ) mat(k,28) = 2.000_r8*rxt(k,243) + 2.000_r8*rxt(k,246) + 2.000_r8*rxt(k,249) & + 2.000_r8*rxt(k,260) - mat(k,496) = .500_r8*rxt(k,244) - mat(k,311) = rxt(k,245) + mat(k,402) = .500_r8*rxt(k,244) + mat(k,497) = rxt(k,245) mat(k,61) = rxt(k,248) + rxt(k,251) + rxt(k,256) mat(k,205) = rxt(k,250) + rxt(k,255) + rxt(k,261) - mat(k,567) = -( rxt(k,242) + het_rates(k,43) ) - mat(k,45) = rxt(k,11) + rxt(k,148) - mat(k,396) = rxt(k,215)*y(k,15) + rxt(k,218)*y(k,17) - mat(k,542) = rxt(k,216)*y(k,15) + rxt(k,219)*y(k,17) - mat(k,447) = rxt(k,239)*y(k,20) - mat(k,39) = -( rxt(k,10) + rxt(k,11) + rxt(k,148) + het_rates(k,44) ) - mat(k,93) = -( rxt(k,57) + het_rates(k,45) ) + mat(k,39) = -( rxt(k,10) + rxt(k,11) + rxt(k,148) + het_rates(k,45) ) + mat(k,93) = -( rxt(k,57) + het_rates(k,46) ) mat(k,60) = rxt(k,248) + rxt(k,251) + rxt(k,256) - mat(k,111) = -( rxt(k,58) + het_rates(k,46) ) + mat(k,119) = -( rxt(k,58) + het_rates(k,47) ) mat(k,203) = rxt(k,250) + rxt(k,255) + rxt(k,261) - mat(k,193) = -( rxt(k,62) + het_rates(k,47) ) - mat(k,334) = rxt(k,15) + mat(k,193) = -( rxt(k,62) + het_rates(k,48) ) + mat(k,378) = rxt(k,15) mat(k,142) = rxt(k,279) mat(k,27) = -( rxt(k,13) + rxt(k,14) + rxt(k,149) + rxt(k,243) + rxt(k,246) & - + rxt(k,249) + rxt(k,260) + het_rates(k,49) ) - mat(k,339) = -( rxt(k,15) + rxt(k,16) + het_rates(k,50) ) - mat(k,30) = rxt(k,14) - mat(k,502) = rxt(k,17) + .500_r8*rxt(k,244) - mat(k,317) = rxt(k,19) + + rxt(k,249) + rxt(k,260) + het_rates(k,50) ) + mat(k,385) = -( rxt(k,15) + rxt(k,16) + het_rates(k,51) ) + mat(k,29) = rxt(k,14) + mat(k,410) = rxt(k,17) + .500_r8*rxt(k,244) + mat(k,505) = rxt(k,19) mat(k,154) = rxt(k,276) mat(k,51) = rxt(k,289) - mat(k,438) = 2.000_r8*rxt(k,142)*y(k,48) - mat(k,509) = -( rxt(k,17) + rxt(k,244) + het_rates(k,51) ) - mat(k,221) = rxt(k,9) + mat(k,435) = 2.000_r8*rxt(k,142)*y(k,49) + mat(k,411) = -( rxt(k,17) + rxt(k,244) + het_rates(k,52) ) + mat(k,220) = rxt(k,9) mat(k,43) = rxt(k,11) + rxt(k,148) - mat(k,31) = rxt(k,13) + rxt(k,149) - mat(k,324) = rxt(k,18) - mat(k,65) = rxt(k,28) - mat(k,211) = rxt(k,47) - mat(k,316) = -( rxt(k,18) + rxt(k,19) + rxt(k,245) + het_rates(k,52) ) - mat(k,42) = rxt(k,10) - mat(k,29) = rxt(k,13) + rxt(k,14) + rxt(k,149) - mat(k,62) = rxt(k,29) - mat(k,208) = rxt(k,46) - mat(k,607) = -( rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & - + rxt(k,76) + het_rates(k,53) ) - mat(k,255) = rxt(k,2) - mat(k,243) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,79) + rxt(k,81) & + mat(k,30) = rxt(k,13) + rxt(k,149) + mat(k,506) = rxt(k,18) + mat(k,63) = rxt(k,28) + mat(k,208) = rxt(k,47) + mat(k,510) = -( rxt(k,18) + rxt(k,19) + rxt(k,245) + het_rates(k,53) ) + mat(k,44) = rxt(k,10) + mat(k,31) = rxt(k,13) + rxt(k,14) + rxt(k,149) + mat(k,65) = rxt(k,29) + mat(k,210) = rxt(k,46) + mat(k,647) = -( rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & + + rxt(k,76) + het_rates(k,54) ) + mat(k,256) = rxt(k,2) + mat(k,244) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,79) + rxt(k,81) & + 2.000_r8*rxt(k,82) + 2.000_r8*rxt(k,83) + rxt(k,84) + rxt(k,85) & + rxt(k,86) - mat(k,645) = rxt(k,8) + mat(k,608) = rxt(k,8) mat(k,32) = rxt(k,14) - mat(k,349) = rxt(k,15) - mat(k,512) = rxt(k,17) - mat(k,327) = rxt(k,18) - mat(k,372) = rxt(k,27) - mat(k,423) = rxt(k,45) + mat(k,395) = rxt(k,15) + mat(k,420) = rxt(k,17) + mat(k,515) = rxt(k,18) + mat(k,494) = rxt(k,27) + mat(k,471) = rxt(k,45) mat(k,9) = rxt(k,59) - mat(k,448) = rxt(k,91) + mat(k,445) = rxt(k,91) mat(k,58) = rxt(k,283) mat(k,52) = rxt(k,288) mat(k,236) = -( rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,78) + rxt(k,79) & + rxt(k,80) + rxt(k,81) + rxt(k,82) + rxt(k,83) + rxt(k,84) & - + rxt(k,85) + rxt(k,86) + het_rates(k,54) ) - mat(k,632) = rxt(k,8) - mat(k,312) = rxt(k,19) + + rxt(k,85) + rxt(k,86) + het_rates(k,55) ) + mat(k,593) = rxt(k,8) + mat(k,498) = rxt(k,19) mat(k,11) = rxt(k,87) + rxt(k,95) mat(k,14) = rxt(k,88) - mat(k,432) = rxt(k,143)*y(k,48) - mat(k,647) = -( rxt(k,7) + rxt(k,8) + het_rates(k,55) ) - mat(k,7) = -( rxt(k,59) + het_rates(k,56) ) - mat(k,463) = -( het_rates(k,58) ) - mat(k,23) = rxt(k,26) - mat(k,367) = rxt(k,27) - mat(k,64) = rxt(k,29) - mat(k,123) = rxt(k,51) - mat(k,98) = rxt(k,57) - mat(k,443) = rxt(k,176)*y(k,6) + rxt(k,202)*y(k,7) + 3.000_r8*rxt(k,203)*y(k,21) & - + 2.000_r8*rxt(k,204)*y(k,34) + 2.000_r8*rxt(k,225)*y(k,13) & - + rxt(k,226)*y(k,15) - mat(k,392) = 2.000_r8*rxt(k,213)*y(k,13) + rxt(k,215)*y(k,15) & - + 3.000_r8*rxt(k,220)*y(k,21) - mat(k,538) = 2.000_r8*rxt(k,214)*y(k,13) + rxt(k,216)*y(k,15) & - + 3.000_r8*rxt(k,221)*y(k,21) - mat(k,389) = -( rxt(k,151)*y(k,20) + rxt(k,213)*y(k,13) + rxt(k,215)*y(k,15) & - + rxt(k,218)*y(k,17) + rxt(k,220)*y(k,21) + het_rates(k,59) ) - mat(k,22) = rxt(k,26) - mat(k,16) = 2.000_r8*rxt(k,43) - mat(k,2) = 2.000_r8*rxt(k,44) - mat(k,415) = rxt(k,45) - mat(k,209) = rxt(k,46) - mat(k,19) = rxt(k,49) - mat(k,268) = rxt(k,55) - mat(k,114) = rxt(k,58) - mat(k,440) = 4.000_r8*rxt(k,175)*y(k,5) + rxt(k,176)*y(k,6) & - + 2.000_r8*rxt(k,177)*y(k,8) + 2.000_r8*rxt(k,178)*y(k,9) & - + 2.000_r8*rxt(k,179)*y(k,10) + rxt(k,180)*y(k,11) & - + 2.000_r8*rxt(k,181)*y(k,12) + rxt(k,227)*y(k,37) & - + rxt(k,228)*y(k,38) + rxt(k,229)*y(k,39) - mat(k,535) = 3.000_r8*rxt(k,217)*y(k,16) + rxt(k,219)*y(k,17) & - + rxt(k,222)*y(k,37) + rxt(k,223)*y(k,38) + rxt(k,224)*y(k,39) - mat(k,164) = -( het_rates(k,60) ) - mat(k,332) = rxt(k,16) + mat(k,427) = rxt(k,143)*y(k,49) + mat(k,607) = -( rxt(k,7) + rxt(k,8) + het_rates(k,56) ) + mat(k,7) = -( rxt(k,59) + het_rates(k,57) ) + mat(k,164) = -( het_rates(k,59) ) + mat(k,376) = rxt(k,16) mat(k,191) = rxt(k,62) - mat(k,586) = rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & + mat(k,624) = rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & + rxt(k,76) mat(k,233) = rxt(k,77) + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) & + rxt(k,84) + rxt(k,85) + rxt(k,86) + mat(k,320) = -( rxt(k,242) + het_rates(k,60) ) + mat(k,42) = rxt(k,11) + rxt(k,148) + mat(k,577) = rxt(k,215)*y(k,16) + rxt(k,218)*y(k,18) + mat(k,533) = rxt(k,216)*y(k,16) + rxt(k,219)*y(k,18) + mat(k,432) = rxt(k,239)*y(k,21) mat(k,178) = -( het_rates(k,61) ) mat(k,78) = -( het_rates(k,62) ) mat(k,54) = rxt(k,283) mat(k,48) = rxt(k,288) mat(k,87) = -( het_rates(k,63) ) - mat(k,330) = rxt(k,16) + mat(k,374) = rxt(k,16) mat(k,148) = rxt(k,276) mat(k,136) = rxt(k,279) mat(k,127) = -( het_rates(k,64) ) mat(k,188) = rxt(k,62) mat(k,49) = rxt(k,289) - mat(k,442) = -( rxt(k,91) + rxt(k,142)*y(k,48) + rxt(k,143)*y(k,48) & - + rxt(k,175)*y(k,5) + rxt(k,176)*y(k,6) + rxt(k,177)*y(k,8) & - + rxt(k,178)*y(k,9) + rxt(k,179)*y(k,10) + rxt(k,180)*y(k,11) & - + rxt(k,181)*y(k,12) + rxt(k,202)*y(k,7) + rxt(k,203)*y(k,21) & - + rxt(k,204)*y(k,34) + rxt(k,225)*y(k,13) + rxt(k,226)*y(k,15) & - + rxt(k,227)*y(k,37) + rxt(k,228)*y(k,38) + rxt(k,229)*y(k,39) & - + rxt(k,238)*y(k,20) + rxt(k,239)*y(k,20) + rxt(k,240)*y(k,20) & + mat(k,437) = -( rxt(k,91) + rxt(k,142)*y(k,49) + rxt(k,143)*y(k,49) & + + rxt(k,175)*y(k,6) + rxt(k,176)*y(k,7) + rxt(k,177)*y(k,9) & + + rxt(k,178)*y(k,10) + rxt(k,179)*y(k,11) + rxt(k,180)*y(k,12) & + + rxt(k,181)*y(k,13) + rxt(k,202)*y(k,8) + rxt(k,203)*y(k,22) & + + rxt(k,204)*y(k,36) + rxt(k,225)*y(k,14) + rxt(k,226)*y(k,16) & + + rxt(k,227)*y(k,39) + rxt(k,228)*y(k,40) + rxt(k,229)*y(k,41) & + + rxt(k,238)*y(k,21) + rxt(k,239)*y(k,21) + rxt(k,240)*y(k,21) & + het_rates(k,65) ) - mat(k,251) = rxt(k,1) - mat(k,239) = rxt(k,6) - mat(k,639) = rxt(k,7) + mat(k,252) = rxt(k,1) + mat(k,241) = rxt(k,6) + mat(k,600) = rxt(k,7) mat(k,10) = -( rxt(k,87) + rxt(k,95) + het_rates(k,66) ) - mat(k,630) = rxt(k,7) - mat(k,12) = rxt(k,99) + rxt(k,98)*y(k,28) - mat(k,13) = -( rxt(k,88) + rxt(k,99) + rxt(k,98)*y(k,28) + het_rates(k,67) ) + mat(k,591) = rxt(k,7) + mat(k,12) = rxt(k,99) + rxt(k,98)*y(k,30) + mat(k,13) = -( rxt(k,88) + rxt(k,99) + rxt(k,98)*y(k,30) + het_rates(k,67) ) mat(k,149) = -( rxt(k,276) + het_rates(k,68) ) mat(k,232) = rxt(k,78) + rxt(k,80) - mat(k,139) = rxt(k,278)*y(k,28) - mat(k,541) = -( rxt(k,214)*y(k,13) + rxt(k,216)*y(k,15) + rxt(k,217)*y(k,16) & - + rxt(k,219)*y(k,17) + rxt(k,221)*y(k,21) + rxt(k,222)*y(k,37) & - + rxt(k,223)*y(k,38) + rxt(k,224)*y(k,39) + rxt(k,236)*y(k,20) & + mat(k,139) = rxt(k,278)*y(k,30) + mat(k,542) = -( rxt(k,214)*y(k,14) + rxt(k,216)*y(k,16) + rxt(k,217)*y(k,17) & + + rxt(k,219)*y(k,18) + rxt(k,221)*y(k,22) + rxt(k,222)*y(k,39) & + + rxt(k,223)*y(k,40) + rxt(k,224)*y(k,41) + rxt(k,236)*y(k,21) & + het_rates(k,69) ) mat(k,254) = rxt(k,3) mat(k,75) = 2.000_r8*rxt(k,4) mat(k,222) = rxt(k,9) - mat(k,44) = rxt(k,10) - mat(k,38) = rxt(k,22) - mat(k,99) = rxt(k,57) - mat(k,116) = rxt(k,58) - mat(k,510) = .500_r8*rxt(k,244) - mat(k,446) = rxt(k,238)*y(k,20) + mat(k,45) = rxt(k,10) + mat(k,37) = rxt(k,22) + mat(k,98) = rxt(k,57) + mat(k,123) = rxt(k,58) + mat(k,416) = .500_r8*rxt(k,244) + mat(k,441) = rxt(k,238)*y(k,21) end do end subroutine linmat01 subroutine linmat02( avec_len, mat, y, rxt, het_rates ) @@ -252,22 +252,22 @@ subroutine linmat02( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,138) = -( rxt(k,279) + rxt(k,278)*y(k,28) + het_rates(k,70) ) - mat(k,584) = rxt(k,71) + rxt(k,72) + mat(k,138) = -( rxt(k,279) + rxt(k,278)*y(k,30) + het_rates(k,70) ) + mat(k,622) = rxt(k,71) + rxt(k,72) mat(k,231) = rxt(k,79) + rxt(k,81) mat(k,50) = rxt(k,263) mat(k,55) = rxt(k,264) mat(k,53) = -( rxt(k,264) + rxt(k,283) + het_rates(k,71) ) - mat(k,574) = rxt(k,73) + rxt(k,75) + mat(k,612) = rxt(k,73) + rxt(k,75) mat(k,227) = rxt(k,84) + rxt(k,86) mat(k,47) = rxt(k,265) mat(k,46) = -( rxt(k,263) + rxt(k,265) + rxt(k,288) + rxt(k,289) & + het_rates(k,72) ) - mat(k,573) = rxt(k,74) + rxt(k,76) + mat(k,611) = rxt(k,74) + rxt(k,76) mat(k,226) = rxt(k,77) + rxt(k,85) mat(k,248) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,73) ) - mat(k,528) = rxt(k,214)*y(k,13) + rxt(k,216)*y(k,15) + rxt(k,217)*y(k,16) & - + rxt(k,219)*y(k,17) + rxt(k,224)*y(k,39) + rxt(k,236)*y(k,20) + mat(k,529) = rxt(k,214)*y(k,14) + rxt(k,216)*y(k,16) + rxt(k,217)*y(k,17) & + + rxt(k,219)*y(k,18) + rxt(k,224)*y(k,41) + rxt(k,236)*y(k,21) end do end subroutine linmat02 subroutine linmat( avec_len, mat, y, rxt, het_rates ) diff --git a/src/chemistry/pp_waccm_ma/mo_lu_factor.F90 b/src/chemistry/pp_waccm_ma/mo_lu_factor.F90 index 2298214e11..bc31b60706 100644 --- a/src/chemistry/pp_waccm_ma/mo_lu_factor.F90 +++ b/src/chemistry/pp_waccm_ma/mo_lu_factor.F90 @@ -20,62 +20,62 @@ subroutine lu_fac01( avec_len, lu ) lu(k,1) = 1._r8 / lu(k,1) lu(k,2) = lu(k,2) * lu(k,1) lu(k,3) = lu(k,3) * lu(k,1) - lu(k,415) = lu(k,415) - lu(k,2) * lu(k,400) - lu(k,416) = lu(k,416) - lu(k,3) * lu(k,400) + lu(k,464) = lu(k,464) - lu(k,2) * lu(k,446) + lu(k,469) = lu(k,469) - lu(k,3) * lu(k,446) lu(k,4) = 1._r8 / lu(k,4) lu(k,5) = lu(k,5) * lu(k,4) lu(k,6) = lu(k,6) * lu(k,4) - lu(k,429) = lu(k,429) - lu(k,5) * lu(k,426) - lu(k,442) = lu(k,442) - lu(k,6) * lu(k,426) - lu(k,521) = - lu(k,5) * lu(k,515) - lu(k,537) = - lu(k,6) * lu(k,515) + lu(k,424) = lu(k,424) - lu(k,5) * lu(k,421) + lu(k,437) = lu(k,437) - lu(k,6) * lu(k,421) + lu(k,522) = - lu(k,5) * lu(k,516) + lu(k,538) = - lu(k,6) * lu(k,516) lu(k,7) = 1._r8 / lu(k,7) lu(k,8) = lu(k,8) * lu(k,7) lu(k,9) = lu(k,9) * lu(k,7) - lu(k,365) = lu(k,365) - lu(k,8) * lu(k,352) - lu(k,372) = lu(k,372) - lu(k,9) * lu(k,352) - lu(k,416) = lu(k,416) - lu(k,8) * lu(k,401) - lu(k,423) = lu(k,423) - lu(k,9) * lu(k,401) + lu(k,464) = lu(k,464) - lu(k,8) * lu(k,447) + lu(k,471) = lu(k,471) - lu(k,9) * lu(k,447) + lu(k,487) = lu(k,487) - lu(k,8) * lu(k,472) + lu(k,494) = lu(k,494) - lu(k,9) * lu(k,472) lu(k,10) = 1._r8 / lu(k,10) lu(k,11) = lu(k,11) * lu(k,10) lu(k,14) = lu(k,14) - lu(k,11) * lu(k,12) lu(k,236) = lu(k,236) - lu(k,11) * lu(k,224) - lu(k,591) = lu(k,591) - lu(k,11) * lu(k,571) - lu(k,632) = lu(k,632) - lu(k,11) * lu(k,630) + lu(k,593) = lu(k,593) - lu(k,11) * lu(k,591) + lu(k,629) = lu(k,629) - lu(k,11) * lu(k,609) lu(k,13) = 1._r8 / lu(k,13) lu(k,14) = lu(k,14) * lu(k,13) lu(k,236) = lu(k,236) - lu(k,14) * lu(k,225) - lu(k,432) = lu(k,432) - lu(k,14) * lu(k,427) - lu(k,591) = lu(k,591) - lu(k,14) * lu(k,572) - lu(k,632) = lu(k,632) - lu(k,14) * lu(k,631) + lu(k,427) = lu(k,427) - lu(k,14) * lu(k,422) + lu(k,593) = lu(k,593) - lu(k,14) * lu(k,592) + lu(k,629) = lu(k,629) - lu(k,14) * lu(k,610) lu(k,15) = 1._r8 / lu(k,15) lu(k,16) = lu(k,16) * lu(k,15) - lu(k,114) = lu(k,114) - lu(k,16) * lu(k,110) - lu(k,209) = lu(k,209) - lu(k,16) * lu(k,202) - lu(k,268) = lu(k,268) - lu(k,16) * lu(k,257) - lu(k,389) = lu(k,389) - lu(k,16) * lu(k,375) - lu(k,415) = lu(k,415) - lu(k,16) * lu(k,402) + lu(k,124) = lu(k,124) - lu(k,16) * lu(k,118) + lu(k,212) = lu(k,212) - lu(k,16) * lu(k,202) + lu(k,275) = lu(k,275) - lu(k,16) * lu(k,257) + lu(k,469) = lu(k,469) - lu(k,16) * lu(k,448) + lu(k,588) = lu(k,588) - lu(k,16) * lu(k,566) lu(k,17) = 1._r8 / lu(k,17) lu(k,18) = lu(k,18) * lu(k,17) lu(k,19) = lu(k,19) * lu(k,17) lu(k,20) = lu(k,20) * lu(k,17) - lu(k,429) = lu(k,429) - lu(k,18) * lu(k,428) - lu(k,440) = lu(k,440) - lu(k,19) * lu(k,428) - lu(k,442) = lu(k,442) - lu(k,20) * lu(k,428) - lu(k,521) = lu(k,521) - lu(k,18) * lu(k,516) - lu(k,535) = lu(k,535) - lu(k,19) * lu(k,516) - lu(k,537) = lu(k,537) - lu(k,20) * lu(k,516) + lu(k,424) = lu(k,424) - lu(k,18) * lu(k,423) + lu(k,437) = lu(k,437) - lu(k,19) * lu(k,423) + lu(k,443) = lu(k,443) - lu(k,20) * lu(k,423) + lu(k,522) = lu(k,522) - lu(k,18) * lu(k,517) + lu(k,538) = lu(k,538) - lu(k,19) * lu(k,517) + lu(k,544) = lu(k,544) - lu(k,20) * lu(k,517) lu(k,21) = 1._r8 / lu(k,21) lu(k,22) = lu(k,22) * lu(k,21) lu(k,23) = lu(k,23) * lu(k,21) - lu(k,97) = - lu(k,22) * lu(k,92) - lu(k,98) = lu(k,98) - lu(k,23) * lu(k,92) - lu(k,268) = lu(k,268) - lu(k,22) * lu(k,258) - lu(k,271) = - lu(k,23) * lu(k,258) - lu(k,364) = lu(k,364) - lu(k,22) * lu(k,353) - lu(k,367) = lu(k,367) - lu(k,23) * lu(k,353) - lu(k,415) = lu(k,415) - lu(k,22) * lu(k,403) - lu(k,418) = lu(k,418) - lu(k,23) * lu(k,403) + lu(k,96) = lu(k,96) - lu(k,22) * lu(k,92) + lu(k,99) = - lu(k,23) * lu(k,92) + lu(k,266) = - lu(k,22) * lu(k,258) + lu(k,275) = lu(k,275) - lu(k,23) * lu(k,258) + lu(k,459) = lu(k,459) - lu(k,22) * lu(k,449) + lu(k,469) = lu(k,469) - lu(k,23) * lu(k,449) + lu(k,482) = lu(k,482) - lu(k,22) * lu(k,473) + lu(k,492) = lu(k,492) - lu(k,23) * lu(k,473) lu(k,24) = 1._r8 / lu(k,24) lu(k,25) = lu(k,25) * lu(k,24) lu(k,26) = lu(k,26) * lu(k,24) @@ -85,45 +85,45 @@ subroutine lu_fac01( avec_len, lu ) lu(k,218) = - lu(k,26) * lu(k,214) lu(k,246) = lu(k,246) - lu(k,25) * lu(k,245) lu(k,249) = lu(k,249) - lu(k,26) * lu(k,245) - lu(k,611) = lu(k,611) - lu(k,25) * lu(k,610) - lu(k,615) = lu(k,615) - lu(k,26) * lu(k,610) + lu(k,355) = lu(k,355) - lu(k,25) * lu(k,354) + lu(k,359) = lu(k,359) - lu(k,26) * lu(k,354) lu(k,27) = 1._r8 / lu(k,27) lu(k,28) = lu(k,28) * lu(k,27) lu(k,29) = lu(k,29) * lu(k,27) lu(k,30) = lu(k,30) * lu(k,27) lu(k,31) = lu(k,31) * lu(k,27) lu(k,32) = lu(k,32) * lu(k,27) - lu(k,311) = lu(k,311) - lu(k,28) * lu(k,309) - lu(k,316) = lu(k,316) - lu(k,29) * lu(k,309) - lu(k,317) = lu(k,317) - lu(k,30) * lu(k,309) - lu(k,324) = lu(k,324) - lu(k,31) * lu(k,309) - lu(k,327) = lu(k,327) - lu(k,32) * lu(k,309) - lu(k,496) = lu(k,496) - lu(k,28) * lu(k,490) - lu(k,501) = lu(k,501) - lu(k,29) * lu(k,490) - lu(k,502) = lu(k,502) - lu(k,30) * lu(k,490) - lu(k,509) = lu(k,509) - lu(k,31) * lu(k,490) - lu(k,512) = lu(k,512) - lu(k,32) * lu(k,490) + lu(k,402) = lu(k,402) - lu(k,28) * lu(k,396) + lu(k,410) = lu(k,410) - lu(k,29) * lu(k,396) + lu(k,411) = lu(k,411) - lu(k,30) * lu(k,396) + lu(k,415) = lu(k,415) - lu(k,31) * lu(k,396) + lu(k,420) = lu(k,420) - lu(k,32) * lu(k,396) + lu(k,497) = lu(k,497) - lu(k,28) * lu(k,495) + lu(k,505) = lu(k,505) - lu(k,29) * lu(k,495) + lu(k,506) = lu(k,506) - lu(k,30) * lu(k,495) + lu(k,510) = lu(k,510) - lu(k,31) * lu(k,495) + lu(k,515) = lu(k,515) - lu(k,32) * lu(k,495) lu(k,33) = 1._r8 / lu(k,33) lu(k,34) = lu(k,34) * lu(k,33) lu(k,35) = lu(k,35) * lu(k,33) lu(k,36) = lu(k,36) * lu(k,33) lu(k,37) = lu(k,37) * lu(k,33) lu(k,38) = lu(k,38) * lu(k,33) - lu(k,473) = - lu(k,34) * lu(k,471) - lu(k,474) = lu(k,474) - lu(k,35) * lu(k,471) - lu(k,475) = - lu(k,36) * lu(k,471) - lu(k,483) = lu(k,483) - lu(k,37) * lu(k,471) - lu(k,485) = - lu(k,38) * lu(k,471) - lu(k,528) = lu(k,528) - lu(k,34) * lu(k,517) - lu(k,530) = lu(k,530) - lu(k,35) * lu(k,517) - lu(k,531) = lu(k,531) - lu(k,36) * lu(k,517) - lu(k,539) = lu(k,539) - lu(k,37) * lu(k,517) - lu(k,541) = lu(k,541) - lu(k,38) * lu(k,517) - lu(k,553) = lu(k,553) - lu(k,34) * lu(k,546) - lu(k,555) = - lu(k,35) * lu(k,546) - lu(k,556) = lu(k,556) - lu(k,36) * lu(k,546) - lu(k,564) = lu(k,564) - lu(k,37) * lu(k,546) - lu(k,566) = lu(k,566) - lu(k,38) * lu(k,546) + lu(k,316) = lu(k,316) - lu(k,34) * lu(k,309) + lu(k,318) = - lu(k,35) * lu(k,309) + lu(k,319) = lu(k,319) - lu(k,36) * lu(k,309) + lu(k,329) = lu(k,329) - lu(k,37) * lu(k,309) + lu(k,330) = lu(k,330) - lu(k,38) * lu(k,309) + lu(k,529) = lu(k,529) - lu(k,34) * lu(k,518) + lu(k,531) = lu(k,531) - lu(k,35) * lu(k,518) + lu(k,532) = lu(k,532) - lu(k,36) * lu(k,518) + lu(k,542) = lu(k,542) - lu(k,37) * lu(k,518) + lu(k,543) = lu(k,543) - lu(k,38) * lu(k,518) + lu(k,549) = - lu(k,34) * lu(k,547) + lu(k,550) = lu(k,550) - lu(k,35) * lu(k,547) + lu(k,551) = - lu(k,36) * lu(k,547) + lu(k,561) = - lu(k,37) * lu(k,547) + lu(k,562) = lu(k,562) - lu(k,38) * lu(k,547) 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) @@ -131,24 +131,24 @@ subroutine lu_fac01( avec_len, lu ) lu(k,43) = lu(k,43) * lu(k,39) lu(k,44) = lu(k,44) * lu(k,39) lu(k,45) = lu(k,45) * lu(k,39) - lu(k,497) = lu(k,497) - lu(k,40) * lu(k,491) - lu(k,498) = - lu(k,41) * lu(k,491) - lu(k,501) = lu(k,501) - lu(k,42) * lu(k,491) - lu(k,509) = lu(k,509) - lu(k,43) * lu(k,491) - lu(k,510) = lu(k,510) - lu(k,44) * lu(k,491) - lu(k,511) = lu(k,511) - lu(k,45) * lu(k,491) - lu(k,527) = lu(k,527) - lu(k,40) * lu(k,518) - lu(k,528) = lu(k,528) - lu(k,41) * lu(k,518) - lu(k,532) = lu(k,532) - lu(k,42) * lu(k,518) - lu(k,540) = lu(k,540) - lu(k,43) * lu(k,518) - lu(k,541) = lu(k,541) - lu(k,44) * lu(k,518) - lu(k,542) = lu(k,542) - lu(k,45) * lu(k,518) - lu(k,552) = lu(k,552) - lu(k,40) * lu(k,547) - lu(k,553) = lu(k,553) - lu(k,41) * lu(k,547) - lu(k,557) = lu(k,557) - lu(k,42) * lu(k,547) - lu(k,565) = lu(k,565) - lu(k,43) * lu(k,547) - lu(k,566) = lu(k,566) - lu(k,44) * lu(k,547) - lu(k,567) = lu(k,567) - lu(k,45) * lu(k,547) + lu(k,315) = lu(k,315) - lu(k,40) * lu(k,310) + lu(k,316) = lu(k,316) - lu(k,41) * lu(k,310) + lu(k,320) = lu(k,320) - lu(k,42) * lu(k,310) + lu(k,324) = lu(k,324) - lu(k,43) * lu(k,310) + lu(k,328) = lu(k,328) - lu(k,44) * lu(k,310) + lu(k,329) = lu(k,329) - lu(k,45) * lu(k,310) + lu(k,403) = lu(k,403) - lu(k,40) * lu(k,397) + lu(k,404) = - lu(k,41) * lu(k,397) + lu(k,407) = lu(k,407) - lu(k,42) * lu(k,397) + lu(k,411) = lu(k,411) - lu(k,43) * lu(k,397) + lu(k,415) = lu(k,415) - lu(k,44) * lu(k,397) + lu(k,416) = lu(k,416) - lu(k,45) * lu(k,397) + lu(k,528) = lu(k,528) - lu(k,40) * lu(k,519) + lu(k,529) = lu(k,529) - lu(k,41) * lu(k,519) + lu(k,533) = lu(k,533) - lu(k,42) * lu(k,519) + lu(k,537) = lu(k,537) - lu(k,43) * lu(k,519) + lu(k,541) = lu(k,541) - lu(k,44) * lu(k,519) + lu(k,542) = lu(k,542) - lu(k,45) * lu(k,519) end do end subroutine lu_fac01 subroutine lu_fac02( avec_len, lu ) @@ -176,20 +176,20 @@ subroutine lu_fac02( avec_len, lu ) lu(k,159) = lu(k,159) - lu(k,48) * lu(k,157) lu(k,161) = - lu(k,49) * lu(k,157) lu(k,162) = lu(k,162) - lu(k,50) * lu(k,157) - lu(k,169) = - lu(k,51) * lu(k,157) + lu(k,170) = - lu(k,51) * lu(k,157) lu(k,173) = lu(k,173) - lu(k,52) * lu(k,157) lu(k,227) = lu(k,227) - lu(k,47) * lu(k,226) lu(k,228) = lu(k,228) - lu(k,48) * lu(k,226) lu(k,230) = lu(k,230) - lu(k,49) * lu(k,226) lu(k,231) = lu(k,231) - lu(k,50) * lu(k,226) - lu(k,238) = lu(k,238) - lu(k,51) * lu(k,226) - lu(k,243) = lu(k,243) - lu(k,52) * lu(k,226) - lu(k,574) = lu(k,574) - lu(k,47) * lu(k,573) - lu(k,578) = lu(k,578) - lu(k,48) * lu(k,573) - lu(k,583) = lu(k,583) - lu(k,49) * lu(k,573) - lu(k,584) = lu(k,584) - lu(k,50) * lu(k,573) - lu(k,597) = lu(k,597) - lu(k,51) * lu(k,573) - lu(k,607) = lu(k,607) - lu(k,52) * lu(k,573) + lu(k,239) = lu(k,239) - lu(k,51) * lu(k,226) + lu(k,244) = lu(k,244) - lu(k,52) * lu(k,226) + lu(k,612) = lu(k,612) - lu(k,47) * lu(k,611) + lu(k,616) = lu(k,616) - lu(k,48) * lu(k,611) + lu(k,621) = lu(k,621) - lu(k,49) * lu(k,611) + lu(k,622) = lu(k,622) - lu(k,50) * lu(k,611) + lu(k,637) = lu(k,637) - lu(k,51) * lu(k,611) + lu(k,647) = lu(k,647) - lu(k,52) * lu(k,611) lu(k,53) = 1._r8 / lu(k,53) lu(k,54) = lu(k,54) * lu(k,53) lu(k,55) = lu(k,55) * lu(k,53) @@ -205,12 +205,12 @@ subroutine lu_fac02( avec_len, lu ) lu(k,231) = lu(k,231) - lu(k,55) * lu(k,227) lu(k,232) = lu(k,232) - lu(k,56) * lu(k,227) lu(k,236) = lu(k,236) - lu(k,57) * lu(k,227) - lu(k,243) = lu(k,243) - lu(k,58) * lu(k,227) - lu(k,578) = lu(k,578) - lu(k,54) * lu(k,574) - lu(k,584) = lu(k,584) - lu(k,55) * lu(k,574) - lu(k,585) = - lu(k,56) * lu(k,574) - lu(k,591) = lu(k,591) - lu(k,57) * lu(k,574) - lu(k,607) = lu(k,607) - lu(k,58) * lu(k,574) + lu(k,244) = lu(k,244) - lu(k,58) * lu(k,227) + lu(k,616) = lu(k,616) - lu(k,54) * lu(k,612) + lu(k,622) = lu(k,622) - lu(k,55) * lu(k,612) + lu(k,623) = - lu(k,56) * lu(k,612) + lu(k,629) = lu(k,629) - lu(k,57) * lu(k,612) + lu(k,647) = lu(k,647) - lu(k,58) * lu(k,612) lu(k,59) = 1._r8 / lu(k,59) lu(k,60) = lu(k,60) * lu(k,59) lu(k,61) = lu(k,61) * lu(k,59) @@ -219,27 +219,27 @@ subroutine lu_fac02( avec_len, lu ) lu(k,64) = lu(k,64) * lu(k,59) lu(k,65) = lu(k,65) * lu(k,59) lu(k,66) = lu(k,66) * lu(k,59) - lu(k,355) = lu(k,355) - lu(k,60) * lu(k,354) - lu(k,356) = - lu(k,61) * lu(k,354) - lu(k,361) = - lu(k,62) * lu(k,354) - lu(k,363) = lu(k,363) - lu(k,63) * lu(k,354) - lu(k,367) = lu(k,367) - lu(k,64) * lu(k,354) - lu(k,369) = lu(k,369) - lu(k,65) * lu(k,354) - lu(k,372) = lu(k,372) - lu(k,66) * lu(k,354) - lu(k,493) = - lu(k,60) * lu(k,492) - lu(k,496) = lu(k,496) - lu(k,61) * lu(k,492) - lu(k,501) = lu(k,501) - lu(k,62) * lu(k,492) - lu(k,503) = lu(k,503) - lu(k,63) * lu(k,492) - lu(k,507) = - lu(k,64) * lu(k,492) - lu(k,509) = lu(k,509) - lu(k,65) * lu(k,492) - lu(k,512) = lu(k,512) - lu(k,66) * lu(k,492) - lu(k,580) = lu(k,580) - lu(k,60) * lu(k,575) - lu(k,590) = - lu(k,61) * lu(k,575) - lu(k,596) = lu(k,596) - lu(k,62) * lu(k,575) - lu(k,598) = lu(k,598) - lu(k,63) * lu(k,575) - lu(k,602) = lu(k,602) - lu(k,64) * lu(k,575) - lu(k,604) = lu(k,604) - lu(k,65) * lu(k,575) - lu(k,607) = lu(k,607) - lu(k,66) * lu(k,575) + lu(k,399) = - lu(k,60) * lu(k,398) + lu(k,402) = lu(k,402) - lu(k,61) * lu(k,398) + lu(k,408) = - lu(k,62) * lu(k,398) + lu(k,411) = lu(k,411) - lu(k,63) * lu(k,398) + lu(k,414) = lu(k,414) - lu(k,64) * lu(k,398) + lu(k,415) = lu(k,415) - lu(k,65) * lu(k,398) + lu(k,420) = lu(k,420) - lu(k,66) * lu(k,398) + lu(k,475) = lu(k,475) - lu(k,60) * lu(k,474) + lu(k,476) = - lu(k,61) * lu(k,474) + lu(k,482) = lu(k,482) - lu(k,62) * lu(k,474) + lu(k,485) = lu(k,485) - lu(k,63) * lu(k,474) + lu(k,488) = lu(k,488) - lu(k,64) * lu(k,474) + lu(k,489) = - lu(k,65) * lu(k,474) + lu(k,494) = lu(k,494) - lu(k,66) * lu(k,474) + lu(k,618) = lu(k,618) - lu(k,60) * lu(k,613) + lu(k,628) = - lu(k,61) * lu(k,613) + lu(k,635) = lu(k,635) - lu(k,62) * lu(k,613) + lu(k,638) = lu(k,638) - lu(k,63) * lu(k,613) + lu(k,641) = lu(k,641) - lu(k,64) * lu(k,613) + lu(k,642) = lu(k,642) - lu(k,65) * lu(k,613) + lu(k,647) = lu(k,647) - lu(k,66) * lu(k,613) lu(k,67) = 1._r8 / lu(k,67) lu(k,68) = lu(k,68) * lu(k,67) lu(k,69) = lu(k,69) * lu(k,67) @@ -248,23 +248,23 @@ subroutine lu_fac02( avec_len, lu ) lu(k,145) = - lu(k,69) * lu(k,135) lu(k,146) = - lu(k,70) * lu(k,135) lu(k,283) = lu(k,283) - lu(k,68) * lu(k,277) - lu(k,292) = lu(k,292) - lu(k,69) * lu(k,277) - lu(k,293) = lu(k,293) - lu(k,70) * lu(k,277) - lu(k,315) = - lu(k,68) * lu(k,310) - lu(k,325) = lu(k,325) - lu(k,69) * lu(k,310) - lu(k,326) = lu(k,326) - lu(k,70) * lu(k,310) - lu(k,385) = lu(k,385) - lu(k,68) * lu(k,376) - lu(k,395) = lu(k,395) - lu(k,69) * lu(k,376) - lu(k,396) = lu(k,396) - lu(k,70) * lu(k,376) - lu(k,456) = - lu(k,68) * lu(k,451) - lu(k,466) = - lu(k,69) * lu(k,451) - lu(k,467) = lu(k,467) - lu(k,70) * lu(k,451) - lu(k,531) = lu(k,531) - lu(k,68) * lu(k,519) - lu(k,541) = lu(k,541) - lu(k,69) * lu(k,519) - lu(k,542) = lu(k,542) - lu(k,70) * lu(k,519) - lu(k,595) = lu(k,595) - lu(k,68) * lu(k,576) - lu(k,605) = lu(k,605) - lu(k,69) * lu(k,576) - lu(k,606) = lu(k,606) - lu(k,70) * lu(k,576) + lu(k,284) = lu(k,284) - lu(k,69) * lu(k,277) + lu(k,292) = lu(k,292) - lu(k,70) * lu(k,277) + lu(k,339) = - lu(k,68) * lu(k,334) + lu(k,340) = lu(k,340) - lu(k,69) * lu(k,334) + lu(k,349) = - lu(k,70) * lu(k,334) + lu(k,501) = - lu(k,68) * lu(k,496) + lu(k,502) = lu(k,502) - lu(k,69) * lu(k,496) + lu(k,511) = lu(k,511) - lu(k,70) * lu(k,496) + lu(k,532) = lu(k,532) - lu(k,68) * lu(k,520) + lu(k,533) = lu(k,533) - lu(k,69) * lu(k,520) + lu(k,542) = lu(k,542) - lu(k,70) * lu(k,520) + lu(k,576) = lu(k,576) - lu(k,68) * lu(k,567) + lu(k,577) = lu(k,577) - lu(k,69) * lu(k,567) + lu(k,586) = lu(k,586) - lu(k,70) * lu(k,567) + lu(k,633) = lu(k,633) - lu(k,68) * lu(k,614) + lu(k,634) = lu(k,634) - lu(k,69) * lu(k,614) + lu(k,643) = lu(k,643) - lu(k,70) * lu(k,614) lu(k,71) = 1._r8 / lu(k,71) lu(k,72) = lu(k,72) * lu(k,71) lu(k,73) = lu(k,73) * lu(k,71) @@ -272,30 +272,30 @@ subroutine lu_fac02( avec_len, lu ) lu(k,75) = lu(k,75) * lu(k,71) lu(k,76) = lu(k,76) * lu(k,71) lu(k,77) = lu(k,77) * lu(k,71) - lu(k,382) = - lu(k,72) * lu(k,377) - lu(k,383) = lu(k,383) - lu(k,73) * lu(k,377) - lu(k,389) = lu(k,389) - lu(k,74) * lu(k,377) - lu(k,395) = lu(k,395) - lu(k,75) * lu(k,377) - lu(k,396) = lu(k,396) - lu(k,76) * lu(k,377) - lu(k,397) = - lu(k,77) * lu(k,377) - lu(k,528) = lu(k,528) - lu(k,72) * lu(k,520) - lu(k,529) = lu(k,529) - lu(k,73) * lu(k,520) - lu(k,535) = lu(k,535) - lu(k,74) * lu(k,520) - lu(k,541) = lu(k,541) - lu(k,75) * lu(k,520) - lu(k,542) = lu(k,542) - lu(k,76) * lu(k,520) - lu(k,543) = lu(k,543) - lu(k,77) * lu(k,520) - lu(k,553) = lu(k,553) - lu(k,72) * lu(k,548) - lu(k,554) = lu(k,554) - lu(k,73) * lu(k,548) - lu(k,560) = lu(k,560) - lu(k,74) * lu(k,548) - lu(k,566) = lu(k,566) - lu(k,75) * lu(k,548) - lu(k,567) = lu(k,567) - lu(k,76) * lu(k,548) - lu(k,568) = lu(k,568) - lu(k,77) * lu(k,548) - lu(k,592) = - lu(k,72) * lu(k,577) - lu(k,593) = lu(k,593) - lu(k,73) * lu(k,577) - lu(k,599) = lu(k,599) - lu(k,74) * lu(k,577) - lu(k,605) = lu(k,605) - lu(k,75) * lu(k,577) - lu(k,606) = lu(k,606) - lu(k,76) * lu(k,577) - lu(k,607) = lu(k,607) - lu(k,77) * lu(k,577) + lu(k,316) = lu(k,316) - lu(k,72) * lu(k,311) + lu(k,317) = lu(k,317) - lu(k,73) * lu(k,311) + lu(k,320) = lu(k,320) - lu(k,74) * lu(k,311) + lu(k,329) = lu(k,329) - lu(k,75) * lu(k,311) + lu(k,331) = lu(k,331) - lu(k,76) * lu(k,311) + lu(k,333) = lu(k,333) - lu(k,77) * lu(k,311) + lu(k,529) = lu(k,529) - lu(k,72) * lu(k,521) + lu(k,530) = lu(k,530) - lu(k,73) * lu(k,521) + lu(k,533) = lu(k,533) - lu(k,74) * lu(k,521) + lu(k,542) = lu(k,542) - lu(k,75) * lu(k,521) + lu(k,544) = lu(k,544) - lu(k,76) * lu(k,521) + lu(k,546) = lu(k,546) - lu(k,77) * lu(k,521) + lu(k,573) = - lu(k,72) * lu(k,568) + lu(k,574) = lu(k,574) - lu(k,73) * lu(k,568) + lu(k,577) = lu(k,577) - lu(k,74) * lu(k,568) + lu(k,586) = lu(k,586) - lu(k,75) * lu(k,568) + lu(k,588) = lu(k,588) - lu(k,76) * lu(k,568) + lu(k,590) = - lu(k,77) * lu(k,568) + lu(k,630) = - lu(k,72) * lu(k,615) + lu(k,631) = lu(k,631) - lu(k,73) * lu(k,615) + lu(k,634) = lu(k,634) - lu(k,74) * lu(k,615) + lu(k,643) = lu(k,643) - lu(k,75) * lu(k,615) + lu(k,645) = lu(k,645) - lu(k,76) * lu(k,615) + lu(k,647) = lu(k,647) - lu(k,77) * lu(k,615) lu(k,78) = 1._r8 / lu(k,78) lu(k,79) = lu(k,79) * lu(k,78) lu(k,80) = lu(k,80) * lu(k,78) @@ -320,15 +320,15 @@ subroutine lu_fac02( avec_len, lu ) lu(k,234) = lu(k,234) - lu(k,83) * lu(k,228) lu(k,235) = lu(k,235) - lu(k,84) * lu(k,228) lu(k,236) = lu(k,236) - lu(k,85) * lu(k,228) - lu(k,243) = lu(k,243) - lu(k,86) * lu(k,228) - lu(k,579) = lu(k,579) - lu(k,79) * lu(k,578) - lu(k,584) = lu(k,584) - lu(k,80) * lu(k,578) - lu(k,585) = lu(k,585) - lu(k,81) * lu(k,578) - lu(k,586) = lu(k,586) - lu(k,82) * lu(k,578) - lu(k,587) = lu(k,587) - lu(k,83) * lu(k,578) - lu(k,588) = lu(k,588) - lu(k,84) * lu(k,578) - lu(k,591) = lu(k,591) - lu(k,85) * lu(k,578) - lu(k,607) = lu(k,607) - lu(k,86) * lu(k,578) + lu(k,244) = lu(k,244) - lu(k,86) * lu(k,228) + lu(k,617) = lu(k,617) - lu(k,79) * lu(k,616) + lu(k,622) = lu(k,622) - lu(k,80) * lu(k,616) + lu(k,623) = lu(k,623) - lu(k,81) * lu(k,616) + lu(k,624) = lu(k,624) - lu(k,82) * lu(k,616) + lu(k,625) = lu(k,625) - lu(k,83) * lu(k,616) + lu(k,626) = lu(k,626) - lu(k,84) * lu(k,616) + lu(k,629) = lu(k,629) - lu(k,85) * lu(k,616) + lu(k,647) = lu(k,647) - lu(k,86) * lu(k,616) end do end subroutine lu_fac02 subroutine lu_fac03( avec_len, lu ) @@ -373,15 +373,15 @@ subroutine lu_fac03( avec_len, lu ) lu(k,233) = lu(k,233) - lu(k,88) * lu(k,229) lu(k,234) = lu(k,234) - lu(k,89) * lu(k,229) lu(k,235) = lu(k,235) - lu(k,90) * lu(k,229) - lu(k,243) = lu(k,243) - lu(k,91) * lu(k,229) - lu(k,332) = lu(k,332) - lu(k,88) * lu(k,330) - lu(k,333) = - lu(k,89) * lu(k,330) - lu(k,334) = lu(k,334) - lu(k,90) * lu(k,330) - lu(k,349) = lu(k,349) - lu(k,91) * lu(k,330) - lu(k,586) = lu(k,586) - lu(k,88) * lu(k,579) - lu(k,587) = lu(k,587) - lu(k,89) * lu(k,579) - lu(k,588) = lu(k,588) - lu(k,90) * lu(k,579) - lu(k,607) = lu(k,607) - lu(k,91) * lu(k,579) + lu(k,244) = lu(k,244) - lu(k,91) * lu(k,229) + lu(k,376) = lu(k,376) - lu(k,88) * lu(k,374) + lu(k,377) = - lu(k,89) * lu(k,374) + lu(k,378) = lu(k,378) - lu(k,90) * lu(k,374) + lu(k,395) = lu(k,395) - lu(k,91) * lu(k,374) + lu(k,624) = lu(k,624) - lu(k,88) * lu(k,617) + lu(k,625) = lu(k,625) - lu(k,89) * lu(k,617) + lu(k,626) = lu(k,626) - lu(k,90) * lu(k,617) + lu(k,647) = lu(k,647) - lu(k,91) * lu(k,617) 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) @@ -392,39 +392,39 @@ subroutine lu_fac03( avec_len, lu ) lu(k,100) = lu(k,100) * lu(k,93) lu(k,263) = lu(k,263) - lu(k,94) * lu(k,259) lu(k,264) = lu(k,264) - lu(k,95) * lu(k,259) - lu(k,267) = - lu(k,96) * lu(k,259) - lu(k,268) = lu(k,268) - lu(k,97) * lu(k,259) - lu(k,271) = lu(k,271) - lu(k,98) * lu(k,259) - lu(k,274) = lu(k,274) - lu(k,99) * lu(k,259) - lu(k,275) = lu(k,275) - lu(k,100) * lu(k,259) - lu(k,358) = - lu(k,94) * lu(k,355) - lu(k,359) = - lu(k,95) * lu(k,355) - lu(k,363) = lu(k,363) - lu(k,96) * lu(k,355) - lu(k,364) = lu(k,364) - lu(k,97) * lu(k,355) - lu(k,367) = lu(k,367) - lu(k,98) * lu(k,355) - lu(k,370) = lu(k,370) - lu(k,99) * lu(k,355) - lu(k,372) = lu(k,372) - lu(k,100) * lu(k,355) - lu(k,498) = lu(k,498) - lu(k,94) * lu(k,493) - lu(k,499) = - lu(k,95) * lu(k,493) - lu(k,503) = lu(k,503) - lu(k,96) * lu(k,493) - lu(k,504) = - lu(k,97) * lu(k,493) - lu(k,507) = lu(k,507) - lu(k,98) * lu(k,493) - lu(k,510) = lu(k,510) - lu(k,99) * lu(k,493) - lu(k,512) = lu(k,512) - lu(k,100) * lu(k,493) - lu(k,553) = lu(k,553) - lu(k,94) * lu(k,549) - lu(k,554) = lu(k,554) - lu(k,95) * lu(k,549) - lu(k,559) = lu(k,559) - lu(k,96) * lu(k,549) - lu(k,560) = lu(k,560) - lu(k,97) * lu(k,549) - lu(k,563) = lu(k,563) - lu(k,98) * lu(k,549) - lu(k,566) = lu(k,566) - lu(k,99) * lu(k,549) - lu(k,568) = lu(k,568) - lu(k,100) * lu(k,549) - lu(k,592) = lu(k,592) - lu(k,94) * lu(k,580) - lu(k,593) = lu(k,593) - lu(k,95) * lu(k,580) - lu(k,598) = lu(k,598) - lu(k,96) * lu(k,580) - lu(k,599) = lu(k,599) - lu(k,97) * lu(k,580) - lu(k,602) = lu(k,602) - lu(k,98) * lu(k,580) - lu(k,605) = lu(k,605) - lu(k,99) * lu(k,580) - lu(k,607) = lu(k,607) - lu(k,100) * lu(k,580) + lu(k,266) = lu(k,266) - lu(k,96) * lu(k,259) + lu(k,271) = - lu(k,97) * lu(k,259) + lu(k,273) = lu(k,273) - lu(k,98) * lu(k,259) + lu(k,275) = lu(k,275) - lu(k,99) * lu(k,259) + lu(k,276) = lu(k,276) - lu(k,100) * lu(k,259) + lu(k,316) = lu(k,316) - lu(k,94) * lu(k,312) + lu(k,317) = lu(k,317) - lu(k,95) * lu(k,312) + lu(k,321) = lu(k,321) - lu(k,96) * lu(k,312) + lu(k,327) = lu(k,327) - lu(k,97) * lu(k,312) + lu(k,329) = lu(k,329) - lu(k,98) * lu(k,312) + lu(k,331) = lu(k,331) - lu(k,99) * lu(k,312) + lu(k,333) = lu(k,333) - lu(k,100) * lu(k,312) + lu(k,404) = lu(k,404) - lu(k,94) * lu(k,399) + lu(k,405) = - lu(k,95) * lu(k,399) + lu(k,408) = lu(k,408) - lu(k,96) * lu(k,399) + lu(k,414) = lu(k,414) - lu(k,97) * lu(k,399) + lu(k,416) = lu(k,416) - lu(k,98) * lu(k,399) + lu(k,418) = - lu(k,99) * lu(k,399) + lu(k,420) = lu(k,420) - lu(k,100) * lu(k,399) + lu(k,478) = - lu(k,94) * lu(k,475) + lu(k,479) = - lu(k,95) * lu(k,475) + lu(k,482) = lu(k,482) - lu(k,96) * lu(k,475) + lu(k,488) = lu(k,488) - lu(k,97) * lu(k,475) + lu(k,490) = lu(k,490) - lu(k,98) * lu(k,475) + lu(k,492) = lu(k,492) - lu(k,99) * lu(k,475) + lu(k,494) = lu(k,494) - lu(k,100) * lu(k,475) + lu(k,630) = lu(k,630) - lu(k,94) * lu(k,618) + lu(k,631) = lu(k,631) - lu(k,95) * lu(k,618) + lu(k,635) = lu(k,635) - lu(k,96) * lu(k,618) + lu(k,641) = lu(k,641) - lu(k,97) * lu(k,618) + lu(k,643) = lu(k,643) - lu(k,98) * lu(k,618) + lu(k,645) = lu(k,645) - lu(k,99) * lu(k,618) + lu(k,647) = lu(k,647) - lu(k,100) * lu(k,618) lu(k,102) = 1._r8 / lu(k,102) lu(k,103) = lu(k,103) * lu(k,102) lu(k,104) = lu(k,104) * lu(k,102) @@ -436,87 +436,88 @@ subroutine lu_fac03( avec_len, lu ) lu(k,216) = lu(k,216) - lu(k,103) * lu(k,215) lu(k,217) = lu(k,217) - lu(k,104) * lu(k,215) lu(k,218) = lu(k,218) - lu(k,105) * lu(k,215) - lu(k,219) = lu(k,219) - lu(k,106) * lu(k,215) - lu(k,220) = - lu(k,107) * lu(k,215) + lu(k,219) = - lu(k,106) * lu(k,215) + lu(k,221) = lu(k,221) - lu(k,107) * lu(k,215) lu(k,222) = lu(k,222) - lu(k,108) * lu(k,215) lu(k,223) = - lu(k,109) * lu(k,215) lu(k,247) = - lu(k,103) * lu(k,246) lu(k,248) = lu(k,248) - lu(k,104) * lu(k,246) lu(k,249) = lu(k,249) - lu(k,105) * lu(k,246) - lu(k,250) = - lu(k,106) * lu(k,246) - lu(k,252) = - lu(k,107) * lu(k,246) + lu(k,250) = lu(k,250) - lu(k,106) * lu(k,246) + lu(k,253) = - lu(k,107) * lu(k,246) lu(k,254) = lu(k,254) - lu(k,108) * lu(k,246) - lu(k,256) = lu(k,256) - lu(k,109) * lu(k,246) - lu(k,431) = - lu(k,103) * lu(k,429) - lu(k,433) = lu(k,433) - lu(k,104) * lu(k,429) - lu(k,436) = lu(k,436) - lu(k,105) * lu(k,429) - lu(k,437) = - lu(k,106) * lu(k,429) - lu(k,444) = lu(k,444) - lu(k,107) * lu(k,429) - lu(k,446) = lu(k,446) - lu(k,108) * lu(k,429) - lu(k,449) = lu(k,449) - lu(k,109) * lu(k,429) - lu(k,526) = lu(k,526) - lu(k,103) * lu(k,521) - lu(k,528) = lu(k,528) - lu(k,104) * lu(k,521) - lu(k,531) = lu(k,531) - lu(k,105) * lu(k,521) - lu(k,532) = lu(k,532) - lu(k,106) * lu(k,521) - lu(k,539) = lu(k,539) - lu(k,107) * lu(k,521) - lu(k,541) = lu(k,541) - lu(k,108) * lu(k,521) - lu(k,544) = lu(k,544) - lu(k,109) * lu(k,521) - lu(k,612) = - lu(k,103) * lu(k,611) - lu(k,613) = lu(k,613) - lu(k,104) * lu(k,611) - lu(k,615) = lu(k,615) - lu(k,105) * lu(k,611) - lu(k,616) = - lu(k,106) * lu(k,611) - lu(k,623) = - lu(k,107) * lu(k,611) - lu(k,625) = lu(k,625) - lu(k,108) * lu(k,611) - lu(k,628) = lu(k,628) - lu(k,109) * lu(k,611) - 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,115) = lu(k,115) * lu(k,111) - lu(k,116) = lu(k,116) * lu(k,111) - lu(k,117) = lu(k,117) * lu(k,111) - lu(k,206) = - lu(k,112) * lu(k,203) - lu(k,207) = lu(k,207) - lu(k,113) * lu(k,203) - lu(k,209) = lu(k,209) - lu(k,114) * lu(k,203) - lu(k,210) = lu(k,210) - lu(k,115) * lu(k,203) - lu(k,212) = lu(k,212) - lu(k,116) * lu(k,203) - lu(k,213) = lu(k,213) - lu(k,117) * lu(k,203) - lu(k,263) = lu(k,263) - lu(k,112) * lu(k,260) - lu(k,264) = lu(k,264) - lu(k,113) * lu(k,260) - lu(k,268) = lu(k,268) - lu(k,114) * lu(k,260) - lu(k,269) = lu(k,269) - lu(k,115) * lu(k,260) - lu(k,274) = lu(k,274) - lu(k,116) * lu(k,260) - lu(k,275) = lu(k,275) - lu(k,117) * lu(k,260) - lu(k,382) = lu(k,382) - lu(k,112) * lu(k,378) - lu(k,383) = lu(k,383) - lu(k,113) * lu(k,378) - lu(k,389) = lu(k,389) - lu(k,114) * lu(k,378) - lu(k,390) = lu(k,390) - lu(k,115) * lu(k,378) - lu(k,395) = lu(k,395) - lu(k,116) * lu(k,378) - lu(k,397) = lu(k,397) - lu(k,117) * lu(k,378) - lu(k,408) = - lu(k,112) * lu(k,404) - lu(k,409) = lu(k,409) - lu(k,113) * lu(k,404) - lu(k,415) = lu(k,415) - lu(k,114) * lu(k,404) - lu(k,416) = lu(k,416) - lu(k,115) * lu(k,404) - lu(k,421) = lu(k,421) - lu(k,116) * lu(k,404) - lu(k,423) = lu(k,423) - lu(k,117) * lu(k,404) - lu(k,528) = lu(k,528) - lu(k,112) * lu(k,522) - lu(k,529) = lu(k,529) - lu(k,113) * lu(k,522) - lu(k,535) = lu(k,535) - lu(k,114) * lu(k,522) - lu(k,536) = lu(k,536) - lu(k,115) * lu(k,522) - lu(k,541) = lu(k,541) - lu(k,116) * lu(k,522) - lu(k,543) = lu(k,543) - lu(k,117) * lu(k,522) - lu(k,553) = lu(k,553) - lu(k,112) * lu(k,550) - lu(k,554) = lu(k,554) - lu(k,113) * lu(k,550) - lu(k,560) = lu(k,560) - lu(k,114) * lu(k,550) - lu(k,561) = lu(k,561) - lu(k,115) * lu(k,550) - lu(k,566) = lu(k,566) - lu(k,116) * lu(k,550) - lu(k,568) = lu(k,568) - lu(k,117) * lu(k,550) - lu(k,592) = lu(k,592) - lu(k,112) * lu(k,581) - lu(k,593) = lu(k,593) - lu(k,113) * lu(k,581) - lu(k,599) = lu(k,599) - lu(k,114) * lu(k,581) - lu(k,600) = lu(k,600) - lu(k,115) * lu(k,581) - lu(k,605) = lu(k,605) - lu(k,116) * lu(k,581) - lu(k,607) = lu(k,607) - lu(k,117) * lu(k,581) + lu(k,255) = - lu(k,109) * lu(k,246) + lu(k,356) = - lu(k,103) * lu(k,355) + lu(k,357) = lu(k,357) - lu(k,104) * lu(k,355) + lu(k,359) = lu(k,359) - lu(k,105) * lu(k,355) + lu(k,362) = lu(k,362) - lu(k,106) * lu(k,355) + lu(k,368) = - lu(k,107) * lu(k,355) + lu(k,369) = lu(k,369) - lu(k,108) * lu(k,355) + lu(k,370) = - lu(k,109) * lu(k,355) + lu(k,426) = - lu(k,103) * lu(k,424) + lu(k,428) = lu(k,428) - lu(k,104) * lu(k,424) + lu(k,431) = lu(k,431) - lu(k,105) * lu(k,424) + lu(k,434) = lu(k,434) - lu(k,106) * lu(k,424) + lu(k,440) = - lu(k,107) * lu(k,424) + lu(k,441) = lu(k,441) - lu(k,108) * lu(k,424) + lu(k,442) = lu(k,442) - lu(k,109) * lu(k,424) + lu(k,527) = lu(k,527) - lu(k,103) * lu(k,522) + lu(k,529) = lu(k,529) - lu(k,104) * lu(k,522) + lu(k,532) = lu(k,532) - lu(k,105) * lu(k,522) + lu(k,535) = lu(k,535) - lu(k,106) * lu(k,522) + lu(k,541) = lu(k,541) - lu(k,107) * lu(k,522) + lu(k,542) = lu(k,542) - lu(k,108) * lu(k,522) + lu(k,543) = lu(k,543) - lu(k,109) * lu(k,522) + lu(k,110) = 1._r8 / lu(k,110) + lu(k,111) = lu(k,111) * lu(k,110) + lu(k,112) = lu(k,112) * lu(k,110) + lu(k,113) = lu(k,113) * lu(k,110) + lu(k,114) = lu(k,114) * lu(k,110) + lu(k,115) = lu(k,115) * lu(k,110) + lu(k,116) = lu(k,116) * lu(k,110) + lu(k,117) = lu(k,117) * lu(k,110) + lu(k,280) = lu(k,280) - lu(k,111) * lu(k,278) + lu(k,283) = lu(k,283) - lu(k,112) * lu(k,278) + lu(k,285) = lu(k,285) - lu(k,113) * lu(k,278) + lu(k,288) = - lu(k,114) * lu(k,278) + lu(k,290) = - lu(k,115) * lu(k,278) + lu(k,292) = lu(k,292) - lu(k,116) * lu(k,278) + lu(k,295) = lu(k,295) - lu(k,117) * lu(k,278) + lu(k,316) = lu(k,316) - lu(k,111) * lu(k,313) + lu(k,319) = lu(k,319) - lu(k,112) * lu(k,313) + lu(k,321) = lu(k,321) - lu(k,113) * lu(k,313) + lu(k,325) = - lu(k,114) * lu(k,313) + lu(k,327) = lu(k,327) - lu(k,115) * lu(k,313) + lu(k,329) = lu(k,329) - lu(k,116) * lu(k,313) + lu(k,333) = lu(k,333) - lu(k,117) * lu(k,313) + lu(k,337) = - lu(k,111) * lu(k,335) + lu(k,339) = lu(k,339) - lu(k,112) * lu(k,335) + lu(k,341) = lu(k,341) - lu(k,113) * lu(k,335) + lu(k,345) = - lu(k,114) * lu(k,335) + lu(k,347) = lu(k,347) - lu(k,115) * lu(k,335) + lu(k,349) = lu(k,349) - lu(k,116) * lu(k,335) + lu(k,353) = - lu(k,117) * lu(k,335) + lu(k,428) = lu(k,428) - lu(k,111) * lu(k,425) + lu(k,431) = lu(k,431) - lu(k,112) * lu(k,425) + lu(k,433) = lu(k,433) - lu(k,113) * lu(k,425) + lu(k,437) = lu(k,437) - lu(k,114) * lu(k,425) + lu(k,439) = lu(k,439) - lu(k,115) * lu(k,425) + lu(k,441) = lu(k,441) - lu(k,116) * lu(k,425) + lu(k,445) = lu(k,445) - lu(k,117) * lu(k,425) + lu(k,529) = lu(k,529) - lu(k,111) * lu(k,523) + lu(k,532) = lu(k,532) - lu(k,112) * lu(k,523) + lu(k,534) = lu(k,534) - lu(k,113) * lu(k,523) + lu(k,538) = lu(k,538) - lu(k,114) * lu(k,523) + lu(k,540) = lu(k,540) - lu(k,115) * lu(k,523) + lu(k,542) = lu(k,542) - lu(k,116) * lu(k,523) + lu(k,546) = lu(k,546) - lu(k,117) * lu(k,523) + lu(k,630) = lu(k,630) - lu(k,111) * lu(k,619) + lu(k,633) = lu(k,633) - lu(k,112) * lu(k,619) + lu(k,635) = lu(k,635) - lu(k,113) * lu(k,619) + lu(k,639) = - lu(k,114) * lu(k,619) + lu(k,641) = lu(k,641) - lu(k,115) * lu(k,619) + lu(k,643) = lu(k,643) - lu(k,116) * lu(k,619) + lu(k,647) = lu(k,647) - lu(k,117) * lu(k,619) end do end subroutine lu_fac03 subroutine lu_fac04( avec_len, lu ) @@ -533,56 +534,55 @@ subroutine lu_fac04( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,118) = 1._r8 / lu(k,118) - lu(k,119) = lu(k,119) * lu(k,118) - lu(k,120) = lu(k,120) * lu(k,118) - lu(k,121) = lu(k,121) * lu(k,118) - lu(k,122) = lu(k,122) * lu(k,118) - lu(k,123) = lu(k,123) * lu(k,118) - lu(k,124) = lu(k,124) * lu(k,118) - lu(k,125) = lu(k,125) * lu(k,118) - lu(k,280) = lu(k,280) - lu(k,119) * lu(k,278) - lu(k,283) = lu(k,283) - lu(k,120) * lu(k,278) - lu(k,285) = - lu(k,121) * lu(k,278) - lu(k,288) = - lu(k,122) * lu(k,278) - lu(k,289) = lu(k,289) - lu(k,123) * lu(k,278) - lu(k,292) = lu(k,292) - lu(k,124) * lu(k,278) - lu(k,294) = lu(k,294) - lu(k,125) * lu(k,278) - lu(k,433) = lu(k,433) - lu(k,119) * lu(k,430) - lu(k,436) = lu(k,436) - lu(k,120) * lu(k,430) - lu(k,439) = lu(k,439) - lu(k,121) * lu(k,430) - lu(k,442) = lu(k,442) - lu(k,122) * lu(k,430) - lu(k,443) = lu(k,443) - lu(k,123) * lu(k,430) - lu(k,446) = lu(k,446) - lu(k,124) * lu(k,430) - lu(k,448) = lu(k,448) - lu(k,125) * lu(k,430) - lu(k,454) = - lu(k,119) * lu(k,452) - lu(k,456) = lu(k,456) - lu(k,120) * lu(k,452) - lu(k,459) = lu(k,459) - lu(k,121) * lu(k,452) - lu(k,462) = - lu(k,122) * lu(k,452) - lu(k,463) = lu(k,463) - lu(k,123) * lu(k,452) - lu(k,466) = lu(k,466) - lu(k,124) * lu(k,452) - lu(k,468) = - lu(k,125) * lu(k,452) - lu(k,528) = lu(k,528) - lu(k,119) * lu(k,523) - lu(k,531) = lu(k,531) - lu(k,120) * lu(k,523) - lu(k,534) = lu(k,534) - lu(k,121) * lu(k,523) - lu(k,537) = lu(k,537) - lu(k,122) * lu(k,523) - lu(k,538) = lu(k,538) - lu(k,123) * lu(k,523) - lu(k,541) = lu(k,541) - lu(k,124) * lu(k,523) - lu(k,543) = lu(k,543) - lu(k,125) * lu(k,523) - lu(k,553) = lu(k,553) - lu(k,119) * lu(k,551) - lu(k,556) = lu(k,556) - lu(k,120) * lu(k,551) - lu(k,559) = lu(k,559) - lu(k,121) * lu(k,551) - lu(k,562) = - lu(k,122) * lu(k,551) - lu(k,563) = lu(k,563) - lu(k,123) * lu(k,551) - lu(k,566) = lu(k,566) - lu(k,124) * lu(k,551) - lu(k,568) = lu(k,568) - lu(k,125) * lu(k,551) - lu(k,592) = lu(k,592) - lu(k,119) * lu(k,582) - lu(k,595) = lu(k,595) - lu(k,120) * lu(k,582) - lu(k,598) = lu(k,598) - lu(k,121) * lu(k,582) - lu(k,601) = - lu(k,122) * lu(k,582) - lu(k,602) = lu(k,602) - lu(k,123) * lu(k,582) - lu(k,605) = lu(k,605) - lu(k,124) * lu(k,582) - lu(k,607) = lu(k,607) - lu(k,125) * lu(k,582) + lu(k,119) = 1._r8 / lu(k,119) + lu(k,120) = lu(k,120) * lu(k,119) + lu(k,121) = lu(k,121) * lu(k,119) + lu(k,122) = lu(k,122) * lu(k,119) + lu(k,123) = lu(k,123) * lu(k,119) + lu(k,124) = lu(k,124) * lu(k,119) + lu(k,125) = lu(k,125) * lu(k,119) + lu(k,206) = - lu(k,120) * lu(k,203) + lu(k,207) = lu(k,207) - lu(k,121) * lu(k,203) + lu(k,209) = lu(k,209) - lu(k,122) * lu(k,203) + lu(k,211) = lu(k,211) - lu(k,123) * lu(k,203) + lu(k,212) = lu(k,212) - lu(k,124) * lu(k,203) + lu(k,213) = lu(k,213) - lu(k,125) * lu(k,203) + lu(k,263) = lu(k,263) - lu(k,120) * lu(k,260) + lu(k,264) = lu(k,264) - lu(k,121) * lu(k,260) + lu(k,270) = lu(k,270) - lu(k,122) * lu(k,260) + lu(k,273) = lu(k,273) - lu(k,123) * lu(k,260) + lu(k,275) = lu(k,275) - lu(k,124) * lu(k,260) + lu(k,276) = lu(k,276) - lu(k,125) * lu(k,260) + lu(k,316) = lu(k,316) - lu(k,120) * lu(k,314) + lu(k,317) = lu(k,317) - lu(k,121) * lu(k,314) + lu(k,326) = lu(k,326) - lu(k,122) * lu(k,314) + lu(k,329) = lu(k,329) - lu(k,123) * lu(k,314) + lu(k,331) = lu(k,331) - lu(k,124) * lu(k,314) + lu(k,333) = lu(k,333) - lu(k,125) * lu(k,314) + lu(k,454) = - lu(k,120) * lu(k,450) + lu(k,455) = lu(k,455) - lu(k,121) * lu(k,450) + lu(k,464) = lu(k,464) - lu(k,122) * lu(k,450) + lu(k,467) = lu(k,467) - lu(k,123) * lu(k,450) + lu(k,469) = lu(k,469) - lu(k,124) * lu(k,450) + lu(k,471) = lu(k,471) - lu(k,125) * lu(k,450) + lu(k,529) = lu(k,529) - lu(k,120) * lu(k,524) + lu(k,530) = lu(k,530) - lu(k,121) * lu(k,524) + lu(k,539) = lu(k,539) - lu(k,122) * lu(k,524) + lu(k,542) = lu(k,542) - lu(k,123) * lu(k,524) + lu(k,544) = lu(k,544) - lu(k,124) * lu(k,524) + lu(k,546) = lu(k,546) - lu(k,125) * lu(k,524) + lu(k,573) = lu(k,573) - lu(k,120) * lu(k,569) + lu(k,574) = lu(k,574) - lu(k,121) * lu(k,569) + lu(k,583) = lu(k,583) - lu(k,122) * lu(k,569) + lu(k,586) = lu(k,586) - lu(k,123) * lu(k,569) + lu(k,588) = lu(k,588) - lu(k,124) * lu(k,569) + lu(k,590) = lu(k,590) - lu(k,125) * lu(k,569) + lu(k,630) = lu(k,630) - lu(k,120) * lu(k,620) + lu(k,631) = lu(k,631) - lu(k,121) * lu(k,620) + lu(k,640) = lu(k,640) - lu(k,122) * lu(k,620) + lu(k,643) = lu(k,643) - lu(k,123) * lu(k,620) + lu(k,645) = lu(k,645) - lu(k,124) * lu(k,620) + lu(k,647) = lu(k,647) - lu(k,125) * lu(k,620) lu(k,127) = 1._r8 / lu(k,127) lu(k,128) = lu(k,128) * lu(k,127) lu(k,129) = lu(k,129) * lu(k,127) @@ -625,14 +625,14 @@ subroutine lu_fac04( avec_len, lu ) lu(k,234) = lu(k,234) - lu(k,131) * lu(k,230) lu(k,235) = lu(k,235) - lu(k,132) * lu(k,230) lu(k,236) = lu(k,236) - lu(k,133) * lu(k,230) - lu(k,243) = lu(k,243) - lu(k,134) * lu(k,230) - lu(k,584) = lu(k,584) - lu(k,128) * lu(k,583) - lu(k,585) = lu(k,585) - lu(k,129) * lu(k,583) - lu(k,586) = lu(k,586) - lu(k,130) * lu(k,583) - lu(k,587) = lu(k,587) - lu(k,131) * lu(k,583) - lu(k,588) = lu(k,588) - lu(k,132) * lu(k,583) - lu(k,591) = lu(k,591) - lu(k,133) * lu(k,583) - lu(k,607) = lu(k,607) - lu(k,134) * lu(k,583) + lu(k,244) = lu(k,244) - lu(k,134) * lu(k,230) + lu(k,622) = lu(k,622) - lu(k,128) * lu(k,621) + lu(k,623) = lu(k,623) - lu(k,129) * lu(k,621) + lu(k,624) = lu(k,624) - lu(k,130) * lu(k,621) + lu(k,625) = lu(k,625) - lu(k,131) * lu(k,621) + lu(k,626) = lu(k,626) - lu(k,132) * lu(k,621) + lu(k,629) = lu(k,629) - lu(k,133) * lu(k,621) + lu(k,647) = lu(k,647) - lu(k,134) * lu(k,621) lu(k,138) = 1._r8 / lu(k,138) lu(k,139) = lu(k,139) * lu(k,138) lu(k,140) = lu(k,140) * lu(k,138) @@ -649,7 +649,7 @@ subroutine lu_fac04( avec_len, lu ) lu(k,166) = lu(k,166) - lu(k,142) * lu(k,162) lu(k,167) = lu(k,167) - lu(k,143) * lu(k,162) lu(k,168) = - lu(k,144) * lu(k,162) - lu(k,171) = - lu(k,145) * lu(k,162) + lu(k,169) = - lu(k,145) * lu(k,162) lu(k,172) = - lu(k,146) * lu(k,162) lu(k,173) = lu(k,173) - lu(k,147) * lu(k,162) lu(k,176) = lu(k,176) - lu(k,139) * lu(k,175) @@ -658,7 +658,7 @@ subroutine lu_fac04( avec_len, lu ) lu(k,179) = lu(k,179) - lu(k,142) * lu(k,175) lu(k,180) = lu(k,180) - lu(k,143) * lu(k,175) lu(k,181) = - lu(k,144) * lu(k,175) - lu(k,184) = - lu(k,145) * lu(k,175) + lu(k,182) = - lu(k,145) * lu(k,175) lu(k,185) = - lu(k,146) * lu(k,175) lu(k,186) = lu(k,186) - lu(k,147) * lu(k,175) lu(k,190) = lu(k,190) - lu(k,139) * lu(k,189) @@ -667,8 +667,8 @@ subroutine lu_fac04( avec_len, lu ) lu(k,193) = lu(k,193) - lu(k,142) * lu(k,189) lu(k,194) = lu(k,194) - lu(k,143) * lu(k,189) lu(k,195) = lu(k,195) - lu(k,144) * lu(k,189) - lu(k,199) = lu(k,199) - lu(k,145) * lu(k,189) - lu(k,200) = - lu(k,146) * lu(k,189) + lu(k,196) = - lu(k,145) * lu(k,189) + lu(k,200) = lu(k,200) - lu(k,146) * lu(k,189) lu(k,201) = lu(k,201) - lu(k,147) * lu(k,189) lu(k,232) = lu(k,232) - lu(k,139) * lu(k,231) lu(k,233) = lu(k,233) - lu(k,140) * lu(k,231) @@ -676,18 +676,18 @@ subroutine lu_fac04( avec_len, lu ) lu(k,235) = lu(k,235) - lu(k,142) * lu(k,231) lu(k,236) = lu(k,236) - lu(k,143) * lu(k,231) lu(k,237) = lu(k,237) - lu(k,144) * lu(k,231) - lu(k,241) = - lu(k,145) * lu(k,231) - lu(k,242) = lu(k,242) - lu(k,146) * lu(k,231) - lu(k,243) = lu(k,243) - lu(k,147) * lu(k,231) - lu(k,585) = lu(k,585) - lu(k,139) * lu(k,584) - lu(k,586) = lu(k,586) - lu(k,140) * lu(k,584) - lu(k,587) = lu(k,587) - lu(k,141) * lu(k,584) - lu(k,588) = lu(k,588) - lu(k,142) * lu(k,584) - lu(k,591) = lu(k,591) - lu(k,143) * lu(k,584) - lu(k,595) = lu(k,595) - lu(k,144) * lu(k,584) - lu(k,605) = lu(k,605) - lu(k,145) * lu(k,584) - lu(k,606) = lu(k,606) - lu(k,146) * lu(k,584) - lu(k,607) = lu(k,607) - lu(k,147) * lu(k,584) + lu(k,238) = lu(k,238) - lu(k,145) * lu(k,231) + lu(k,242) = - lu(k,146) * lu(k,231) + lu(k,244) = lu(k,244) - lu(k,147) * lu(k,231) + lu(k,623) = lu(k,623) - lu(k,139) * lu(k,622) + lu(k,624) = lu(k,624) - lu(k,140) * lu(k,622) + lu(k,625) = lu(k,625) - lu(k,141) * lu(k,622) + lu(k,626) = lu(k,626) - lu(k,142) * lu(k,622) + lu(k,629) = lu(k,629) - lu(k,143) * lu(k,622) + lu(k,633) = lu(k,633) - lu(k,144) * lu(k,622) + lu(k,634) = lu(k,634) - lu(k,145) * lu(k,622) + lu(k,643) = lu(k,643) - lu(k,146) * lu(k,622) + lu(k,647) = lu(k,647) - lu(k,147) * lu(k,622) lu(k,149) = 1._r8 / lu(k,149) lu(k,150) = lu(k,150) * lu(k,149) lu(k,151) = lu(k,151) * lu(k,149) @@ -700,60 +700,44 @@ subroutine lu_fac04( avec_len, lu ) lu(k,165) = lu(k,165) - lu(k,151) * lu(k,163) lu(k,166) = lu(k,166) - lu(k,152) * lu(k,163) lu(k,167) = lu(k,167) - lu(k,153) * lu(k,163) - lu(k,169) = lu(k,169) - lu(k,154) * lu(k,163) - lu(k,170) = lu(k,170) - lu(k,155) * lu(k,163) + lu(k,170) = lu(k,170) - lu(k,154) * lu(k,163) + lu(k,171) = lu(k,171) - lu(k,155) * lu(k,163) lu(k,173) = lu(k,173) - lu(k,156) * lu(k,163) lu(k,177) = lu(k,177) - lu(k,150) * lu(k,176) lu(k,178) = lu(k,178) - lu(k,151) * lu(k,176) lu(k,179) = lu(k,179) - lu(k,152) * lu(k,176) lu(k,180) = lu(k,180) - lu(k,153) * lu(k,176) - lu(k,182) = lu(k,182) - lu(k,154) * lu(k,176) - lu(k,183) = lu(k,183) - lu(k,155) * lu(k,176) + lu(k,183) = lu(k,183) - lu(k,154) * lu(k,176) + lu(k,184) = lu(k,184) - lu(k,155) * lu(k,176) lu(k,186) = lu(k,186) - lu(k,156) * lu(k,176) lu(k,191) = lu(k,191) - lu(k,150) * lu(k,190) lu(k,192) = lu(k,192) - lu(k,151) * lu(k,190) lu(k,193) = lu(k,193) - lu(k,152) * lu(k,190) lu(k,194) = lu(k,194) - lu(k,153) * lu(k,190) - lu(k,196) = lu(k,196) - lu(k,154) * lu(k,190) - lu(k,197) = - lu(k,155) * lu(k,190) + lu(k,197) = lu(k,197) - lu(k,154) * lu(k,190) + lu(k,199) = - lu(k,155) * lu(k,190) lu(k,201) = lu(k,201) - lu(k,156) * lu(k,190) lu(k,233) = lu(k,233) - lu(k,150) * lu(k,232) lu(k,234) = lu(k,234) - lu(k,151) * lu(k,232) lu(k,235) = lu(k,235) - lu(k,152) * lu(k,232) lu(k,236) = lu(k,236) - lu(k,153) * lu(k,232) - lu(k,238) = lu(k,238) - lu(k,154) * lu(k,232) - lu(k,239) = lu(k,239) - lu(k,155) * lu(k,232) - lu(k,243) = lu(k,243) - lu(k,156) * lu(k,232) - lu(k,332) = lu(k,332) - lu(k,150) * lu(k,331) - lu(k,333) = lu(k,333) - lu(k,151) * lu(k,331) - lu(k,334) = lu(k,334) - lu(k,152) * lu(k,331) - lu(k,335) = lu(k,335) - lu(k,153) * lu(k,331) - lu(k,339) = lu(k,339) - lu(k,154) * lu(k,331) - lu(k,343) = - lu(k,155) * lu(k,331) - lu(k,349) = lu(k,349) - lu(k,156) * lu(k,331) - lu(k,586) = lu(k,586) - lu(k,150) * lu(k,585) - lu(k,587) = lu(k,587) - lu(k,151) * lu(k,585) - lu(k,588) = lu(k,588) - lu(k,152) * lu(k,585) - lu(k,591) = lu(k,591) - lu(k,153) * lu(k,585) - lu(k,597) = lu(k,597) - lu(k,154) * lu(k,585) - lu(k,601) = lu(k,601) - lu(k,155) * lu(k,585) - lu(k,607) = lu(k,607) - lu(k,156) * lu(k,585) - 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,239) = lu(k,239) - lu(k,154) * lu(k,232) + lu(k,241) = lu(k,241) - lu(k,155) * lu(k,232) + lu(k,244) = lu(k,244) - lu(k,156) * lu(k,232) + lu(k,376) = lu(k,376) - lu(k,150) * lu(k,375) + lu(k,377) = lu(k,377) - lu(k,151) * lu(k,375) + lu(k,378) = lu(k,378) - lu(k,152) * lu(k,375) + lu(k,379) = lu(k,379) - lu(k,153) * lu(k,375) + lu(k,385) = lu(k,385) - lu(k,154) * lu(k,375) + lu(k,387) = - lu(k,155) * lu(k,375) + lu(k,395) = lu(k,395) - lu(k,156) * lu(k,375) + lu(k,624) = lu(k,624) - lu(k,150) * lu(k,623) + lu(k,625) = lu(k,625) - lu(k,151) * lu(k,623) + lu(k,626) = lu(k,626) - lu(k,152) * lu(k,623) + lu(k,629) = lu(k,629) - lu(k,153) * lu(k,623) + lu(k,637) = lu(k,637) - lu(k,154) * lu(k,623) + lu(k,639) = lu(k,639) - lu(k,155) * lu(k,623) + lu(k,647) = lu(k,647) - lu(k,156) * lu(k,623) lu(k,164) = 1._r8 / lu(k,164) lu(k,165) = lu(k,165) * lu(k,164) lu(k,166) = lu(k,166) * lu(k,164) @@ -790,25 +774,41 @@ subroutine lu_fac05( avec_len, lu ) lu(k,239) = lu(k,239) - lu(k,170) * lu(k,233) lu(k,241) = lu(k,241) - lu(k,171) * lu(k,233) lu(k,242) = lu(k,242) - lu(k,172) * lu(k,233) - lu(k,243) = lu(k,243) - lu(k,173) * lu(k,233) - lu(k,333) = lu(k,333) - lu(k,165) * lu(k,332) - lu(k,334) = lu(k,334) - lu(k,166) * lu(k,332) - lu(k,335) = lu(k,335) - lu(k,167) * lu(k,332) - lu(k,337) = - lu(k,168) * lu(k,332) - lu(k,339) = lu(k,339) - lu(k,169) * lu(k,332) - lu(k,343) = lu(k,343) - lu(k,170) * lu(k,332) - lu(k,347) = lu(k,347) - lu(k,171) * lu(k,332) - lu(k,348) = lu(k,348) - lu(k,172) * lu(k,332) - lu(k,349) = lu(k,349) - lu(k,173) * lu(k,332) - lu(k,587) = lu(k,587) - lu(k,165) * lu(k,586) - lu(k,588) = lu(k,588) - lu(k,166) * lu(k,586) - lu(k,591) = lu(k,591) - lu(k,167) * lu(k,586) - lu(k,595) = lu(k,595) - lu(k,168) * lu(k,586) - lu(k,597) = lu(k,597) - lu(k,169) * lu(k,586) - lu(k,601) = lu(k,601) - lu(k,170) * lu(k,586) - lu(k,605) = lu(k,605) - lu(k,171) * lu(k,586) - lu(k,606) = lu(k,606) - lu(k,172) * lu(k,586) - lu(k,607) = lu(k,607) - lu(k,173) * lu(k,586) + lu(k,244) = lu(k,244) - lu(k,173) * lu(k,233) + lu(k,377) = lu(k,377) - lu(k,165) * lu(k,376) + lu(k,378) = lu(k,378) - lu(k,166) * lu(k,376) + lu(k,379) = lu(k,379) - lu(k,167) * lu(k,376) + lu(k,381) = - lu(k,168) * lu(k,376) + lu(k,382) = lu(k,382) - lu(k,169) * lu(k,376) + lu(k,385) = lu(k,385) - lu(k,170) * lu(k,376) + lu(k,387) = lu(k,387) - lu(k,171) * lu(k,376) + lu(k,391) = lu(k,391) - lu(k,172) * lu(k,376) + lu(k,395) = lu(k,395) - lu(k,173) * lu(k,376) + lu(k,625) = lu(k,625) - lu(k,165) * lu(k,624) + lu(k,626) = lu(k,626) - lu(k,166) * lu(k,624) + lu(k,629) = lu(k,629) - lu(k,167) * lu(k,624) + lu(k,633) = lu(k,633) - lu(k,168) * lu(k,624) + lu(k,634) = lu(k,634) - lu(k,169) * lu(k,624) + lu(k,637) = lu(k,637) - lu(k,170) * lu(k,624) + lu(k,639) = lu(k,639) - lu(k,171) * lu(k,624) + lu(k,643) = lu(k,643) - lu(k,172) * lu(k,624) + lu(k,647) = lu(k,647) - lu(k,173) * lu(k,624) + 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,178) = 1._r8 / lu(k,178) lu(k,179) = lu(k,179) * lu(k,178) lu(k,180) = lu(k,180) * lu(k,178) @@ -833,23 +833,23 @@ subroutine lu_fac05( avec_len, lu ) lu(k,239) = lu(k,239) - lu(k,183) * lu(k,234) lu(k,241) = lu(k,241) - lu(k,184) * lu(k,234) lu(k,242) = lu(k,242) - lu(k,185) * lu(k,234) - lu(k,243) = lu(k,243) - lu(k,186) * lu(k,234) - lu(k,334) = lu(k,334) - lu(k,179) * lu(k,333) - lu(k,335) = lu(k,335) - lu(k,180) * lu(k,333) - lu(k,337) = lu(k,337) - lu(k,181) * lu(k,333) - lu(k,339) = lu(k,339) - lu(k,182) * lu(k,333) - lu(k,343) = lu(k,343) - lu(k,183) * lu(k,333) - lu(k,347) = lu(k,347) - lu(k,184) * lu(k,333) - lu(k,348) = lu(k,348) - lu(k,185) * lu(k,333) - lu(k,349) = lu(k,349) - lu(k,186) * lu(k,333) - lu(k,588) = lu(k,588) - lu(k,179) * lu(k,587) - lu(k,591) = lu(k,591) - lu(k,180) * lu(k,587) - lu(k,595) = lu(k,595) - lu(k,181) * lu(k,587) - lu(k,597) = lu(k,597) - lu(k,182) * lu(k,587) - lu(k,601) = lu(k,601) - lu(k,183) * lu(k,587) - lu(k,605) = lu(k,605) - lu(k,184) * lu(k,587) - lu(k,606) = lu(k,606) - lu(k,185) * lu(k,587) - lu(k,607) = lu(k,607) - lu(k,186) * lu(k,587) + lu(k,244) = lu(k,244) - lu(k,186) * lu(k,234) + lu(k,378) = lu(k,378) - lu(k,179) * lu(k,377) + lu(k,379) = lu(k,379) - lu(k,180) * lu(k,377) + lu(k,381) = lu(k,381) - lu(k,181) * lu(k,377) + lu(k,382) = lu(k,382) - lu(k,182) * lu(k,377) + lu(k,385) = lu(k,385) - lu(k,183) * lu(k,377) + lu(k,387) = lu(k,387) - lu(k,184) * lu(k,377) + lu(k,391) = lu(k,391) - lu(k,185) * lu(k,377) + lu(k,395) = lu(k,395) - lu(k,186) * lu(k,377) + lu(k,626) = lu(k,626) - lu(k,179) * lu(k,625) + lu(k,629) = lu(k,629) - lu(k,180) * lu(k,625) + lu(k,633) = lu(k,633) - lu(k,181) * lu(k,625) + lu(k,634) = lu(k,634) - lu(k,182) * lu(k,625) + lu(k,637) = lu(k,637) - lu(k,183) * lu(k,625) + lu(k,639) = lu(k,639) - lu(k,184) * lu(k,625) + lu(k,643) = lu(k,643) - lu(k,185) * lu(k,625) + lu(k,647) = lu(k,647) - lu(k,186) * lu(k,625) lu(k,193) = 1._r8 / lu(k,193) lu(k,194) = lu(k,194) * lu(k,193) lu(k,195) = lu(k,195) * lu(k,193) @@ -866,39 +866,39 @@ subroutine lu_fac05( avec_len, lu ) lu(k,240) = - lu(k,198) * lu(k,235) lu(k,241) = lu(k,241) - lu(k,199) * lu(k,235) lu(k,242) = lu(k,242) - lu(k,200) * lu(k,235) - lu(k,243) = lu(k,243) - lu(k,201) * lu(k,235) - lu(k,335) = lu(k,335) - lu(k,194) * lu(k,334) - lu(k,337) = lu(k,337) - lu(k,195) * lu(k,334) - lu(k,339) = lu(k,339) - lu(k,196) * lu(k,334) - lu(k,343) = lu(k,343) - lu(k,197) * lu(k,334) - lu(k,346) = lu(k,346) - lu(k,198) * lu(k,334) - lu(k,347) = lu(k,347) - lu(k,199) * lu(k,334) - lu(k,348) = lu(k,348) - lu(k,200) * lu(k,334) - lu(k,349) = lu(k,349) - lu(k,201) * lu(k,334) - lu(k,497) = lu(k,497) - lu(k,194) * lu(k,494) - lu(k,500) = - lu(k,195) * lu(k,494) - lu(k,502) = lu(k,502) - lu(k,196) * lu(k,494) - lu(k,506) = - lu(k,197) * lu(k,494) - lu(k,509) = lu(k,509) - lu(k,198) * lu(k,494) - lu(k,510) = lu(k,510) - lu(k,199) * lu(k,494) - lu(k,511) = lu(k,511) - lu(k,200) * lu(k,494) - lu(k,512) = lu(k,512) - lu(k,201) * lu(k,494) - lu(k,527) = lu(k,527) - lu(k,194) * lu(k,524) - lu(k,531) = lu(k,531) - lu(k,195) * lu(k,524) - lu(k,533) = lu(k,533) - lu(k,196) * lu(k,524) - lu(k,537) = lu(k,537) - lu(k,197) * lu(k,524) - lu(k,540) = lu(k,540) - lu(k,198) * lu(k,524) - lu(k,541) = lu(k,541) - lu(k,199) * lu(k,524) - lu(k,542) = lu(k,542) - lu(k,200) * lu(k,524) - lu(k,543) = lu(k,543) - lu(k,201) * lu(k,524) - lu(k,591) = lu(k,591) - lu(k,194) * lu(k,588) - lu(k,595) = lu(k,595) - lu(k,195) * lu(k,588) - lu(k,597) = lu(k,597) - lu(k,196) * lu(k,588) - lu(k,601) = lu(k,601) - lu(k,197) * lu(k,588) - lu(k,604) = lu(k,604) - lu(k,198) * lu(k,588) - lu(k,605) = lu(k,605) - lu(k,199) * lu(k,588) - lu(k,606) = lu(k,606) - lu(k,200) * lu(k,588) - lu(k,607) = lu(k,607) - lu(k,201) * lu(k,588) + lu(k,244) = lu(k,244) - lu(k,201) * lu(k,235) + lu(k,379) = lu(k,379) - lu(k,194) * lu(k,378) + lu(k,381) = lu(k,381) - lu(k,195) * lu(k,378) + lu(k,382) = lu(k,382) - lu(k,196) * lu(k,378) + lu(k,385) = lu(k,385) - lu(k,197) * lu(k,378) + lu(k,386) = lu(k,386) - lu(k,198) * lu(k,378) + lu(k,387) = lu(k,387) - lu(k,199) * lu(k,378) + lu(k,391) = lu(k,391) - lu(k,200) * lu(k,378) + lu(k,395) = lu(k,395) - lu(k,201) * lu(k,378) + lu(k,403) = lu(k,403) - lu(k,194) * lu(k,400) + lu(k,406) = - lu(k,195) * lu(k,400) + lu(k,407) = lu(k,407) - lu(k,196) * lu(k,400) + lu(k,410) = lu(k,410) - lu(k,197) * lu(k,400) + lu(k,411) = lu(k,411) - lu(k,198) * lu(k,400) + lu(k,412) = - lu(k,199) * lu(k,400) + lu(k,416) = lu(k,416) - lu(k,200) * lu(k,400) + lu(k,420) = lu(k,420) - lu(k,201) * lu(k,400) + lu(k,528) = lu(k,528) - lu(k,194) * lu(k,525) + lu(k,532) = lu(k,532) - lu(k,195) * lu(k,525) + lu(k,533) = lu(k,533) - lu(k,196) * lu(k,525) + lu(k,536) = lu(k,536) - lu(k,197) * lu(k,525) + lu(k,537) = lu(k,537) - lu(k,198) * lu(k,525) + lu(k,538) = lu(k,538) - lu(k,199) * lu(k,525) + lu(k,542) = lu(k,542) - lu(k,200) * lu(k,525) + lu(k,546) = lu(k,546) - lu(k,201) * lu(k,525) + lu(k,629) = lu(k,629) - lu(k,194) * lu(k,626) + lu(k,633) = lu(k,633) - lu(k,195) * lu(k,626) + lu(k,634) = lu(k,634) - lu(k,196) * lu(k,626) + lu(k,637) = lu(k,637) - lu(k,197) * lu(k,626) + lu(k,638) = lu(k,638) - lu(k,198) * lu(k,626) + lu(k,639) = lu(k,639) - lu(k,199) * lu(k,626) + lu(k,643) = lu(k,643) - lu(k,200) * lu(k,626) + lu(k,647) = lu(k,647) - lu(k,201) * lu(k,626) lu(k,204) = 1._r8 / lu(k,204) lu(k,205) = lu(k,205) * lu(k,204) lu(k,206) = lu(k,206) * lu(k,204) @@ -912,57 +912,57 @@ subroutine lu_fac05( avec_len, lu ) lu(k,262) = lu(k,262) - lu(k,205) * lu(k,261) lu(k,263) = lu(k,263) - lu(k,206) * lu(k,261) lu(k,264) = lu(k,264) - lu(k,207) * lu(k,261) - lu(k,266) = - lu(k,208) * lu(k,261) - lu(k,268) = lu(k,268) - lu(k,209) * lu(k,261) - lu(k,269) = lu(k,269) - lu(k,210) * lu(k,261) - lu(k,273) = - lu(k,211) * lu(k,261) - lu(k,274) = lu(k,274) - lu(k,212) * lu(k,261) - lu(k,275) = lu(k,275) - lu(k,213) * lu(k,261) - lu(k,380) = - lu(k,205) * lu(k,379) - lu(k,382) = lu(k,382) - lu(k,206) * lu(k,379) - lu(k,383) = lu(k,383) - lu(k,207) * lu(k,379) - lu(k,386) = lu(k,386) - lu(k,208) * lu(k,379) - lu(k,389) = lu(k,389) - lu(k,209) * lu(k,379) - lu(k,390) = lu(k,390) - lu(k,210) * lu(k,379) - lu(k,394) = - lu(k,211) * lu(k,379) - lu(k,395) = lu(k,395) - lu(k,212) * lu(k,379) - lu(k,397) = lu(k,397) - lu(k,213) * lu(k,379) - lu(k,406) = - lu(k,205) * lu(k,405) - lu(k,408) = lu(k,408) - lu(k,206) * lu(k,405) - lu(k,409) = lu(k,409) - lu(k,207) * lu(k,405) - lu(k,412) = - lu(k,208) * lu(k,405) - lu(k,415) = lu(k,415) - lu(k,209) * lu(k,405) - lu(k,416) = lu(k,416) - lu(k,210) * lu(k,405) - lu(k,420) = lu(k,420) - lu(k,211) * lu(k,405) - lu(k,421) = lu(k,421) - lu(k,212) * lu(k,405) - lu(k,423) = lu(k,423) - lu(k,213) * lu(k,405) - lu(k,496) = lu(k,496) - lu(k,205) * lu(k,495) - lu(k,498) = lu(k,498) - lu(k,206) * lu(k,495) - lu(k,499) = lu(k,499) - lu(k,207) * lu(k,495) - lu(k,501) = lu(k,501) - lu(k,208) * lu(k,495) - lu(k,504) = lu(k,504) - lu(k,209) * lu(k,495) - lu(k,505) = lu(k,505) - lu(k,210) * lu(k,495) - lu(k,509) = lu(k,509) - lu(k,211) * lu(k,495) - lu(k,510) = lu(k,510) - lu(k,212) * lu(k,495) - lu(k,512) = lu(k,512) - lu(k,213) * lu(k,495) - lu(k,526) = lu(k,526) - lu(k,205) * lu(k,525) - lu(k,528) = lu(k,528) - lu(k,206) * lu(k,525) - lu(k,529) = lu(k,529) - lu(k,207) * lu(k,525) - lu(k,532) = lu(k,532) - lu(k,208) * lu(k,525) - lu(k,535) = lu(k,535) - lu(k,209) * lu(k,525) - lu(k,536) = lu(k,536) - lu(k,210) * lu(k,525) - lu(k,540) = lu(k,540) - lu(k,211) * lu(k,525) - lu(k,541) = lu(k,541) - lu(k,212) * lu(k,525) - lu(k,543) = lu(k,543) - lu(k,213) * lu(k,525) - lu(k,590) = lu(k,590) - lu(k,205) * lu(k,589) - lu(k,592) = lu(k,592) - lu(k,206) * lu(k,589) - lu(k,593) = lu(k,593) - lu(k,207) * lu(k,589) - lu(k,596) = lu(k,596) - lu(k,208) * lu(k,589) - lu(k,599) = lu(k,599) - lu(k,209) * lu(k,589) - lu(k,600) = lu(k,600) - lu(k,210) * lu(k,589) - lu(k,604) = lu(k,604) - lu(k,211) * lu(k,589) - lu(k,605) = lu(k,605) - lu(k,212) * lu(k,589) - lu(k,607) = lu(k,607) - lu(k,213) * lu(k,589) + lu(k,268) = - lu(k,208) * lu(k,261) + lu(k,270) = lu(k,270) - lu(k,209) * lu(k,261) + lu(k,272) = - lu(k,210) * lu(k,261) + lu(k,273) = lu(k,273) - lu(k,211) * lu(k,261) + lu(k,275) = lu(k,275) - lu(k,212) * lu(k,261) + lu(k,276) = lu(k,276) - lu(k,213) * lu(k,261) + lu(k,402) = lu(k,402) - lu(k,205) * lu(k,401) + lu(k,404) = lu(k,404) - lu(k,206) * lu(k,401) + lu(k,405) = lu(k,405) - lu(k,207) * lu(k,401) + lu(k,411) = lu(k,411) - lu(k,208) * lu(k,401) + lu(k,413) = lu(k,413) - lu(k,209) * lu(k,401) + lu(k,415) = lu(k,415) - lu(k,210) * lu(k,401) + lu(k,416) = lu(k,416) - lu(k,211) * lu(k,401) + lu(k,418) = lu(k,418) - lu(k,212) * lu(k,401) + lu(k,420) = lu(k,420) - lu(k,213) * lu(k,401) + lu(k,452) = - lu(k,205) * lu(k,451) + lu(k,454) = lu(k,454) - lu(k,206) * lu(k,451) + lu(k,455) = lu(k,455) - lu(k,207) * lu(k,451) + lu(k,462) = lu(k,462) - lu(k,208) * lu(k,451) + lu(k,464) = lu(k,464) - lu(k,209) * lu(k,451) + lu(k,466) = - lu(k,210) * lu(k,451) + lu(k,467) = lu(k,467) - lu(k,211) * lu(k,451) + lu(k,469) = lu(k,469) - lu(k,212) * lu(k,451) + lu(k,471) = lu(k,471) - lu(k,213) * lu(k,451) + lu(k,527) = lu(k,527) - lu(k,205) * lu(k,526) + lu(k,529) = lu(k,529) - lu(k,206) * lu(k,526) + lu(k,530) = lu(k,530) - lu(k,207) * lu(k,526) + lu(k,537) = lu(k,537) - lu(k,208) * lu(k,526) + lu(k,539) = lu(k,539) - lu(k,209) * lu(k,526) + lu(k,541) = lu(k,541) - lu(k,210) * lu(k,526) + lu(k,542) = lu(k,542) - lu(k,211) * lu(k,526) + lu(k,544) = lu(k,544) - lu(k,212) * lu(k,526) + lu(k,546) = lu(k,546) - lu(k,213) * lu(k,526) + lu(k,571) = - lu(k,205) * lu(k,570) + lu(k,573) = lu(k,573) - lu(k,206) * lu(k,570) + lu(k,574) = lu(k,574) - lu(k,207) * lu(k,570) + lu(k,581) = - lu(k,208) * lu(k,570) + lu(k,583) = lu(k,583) - lu(k,209) * lu(k,570) + lu(k,585) = lu(k,585) - lu(k,210) * lu(k,570) + lu(k,586) = lu(k,586) - lu(k,211) * lu(k,570) + lu(k,588) = lu(k,588) - lu(k,212) * lu(k,570) + lu(k,590) = lu(k,590) - lu(k,213) * lu(k,570) + lu(k,628) = lu(k,628) - lu(k,205) * lu(k,627) + lu(k,630) = lu(k,630) - lu(k,206) * lu(k,627) + lu(k,631) = lu(k,631) - lu(k,207) * lu(k,627) + lu(k,638) = lu(k,638) - lu(k,208) * lu(k,627) + lu(k,640) = lu(k,640) - lu(k,209) * lu(k,627) + lu(k,642) = lu(k,642) - lu(k,210) * lu(k,627) + lu(k,643) = lu(k,643) - lu(k,211) * lu(k,627) + lu(k,645) = lu(k,645) - lu(k,212) * lu(k,627) + lu(k,647) = lu(k,647) - lu(k,213) * lu(k,627) lu(k,216) = 1._r8 / lu(k,216) lu(k,217) = lu(k,217) * lu(k,216) lu(k,218) = lu(k,218) * lu(k,216) @@ -974,87 +974,87 @@ subroutine lu_fac05( avec_len, lu ) lu(k,248) = lu(k,248) - lu(k,217) * lu(k,247) lu(k,249) = lu(k,249) - lu(k,218) * lu(k,247) lu(k,250) = lu(k,250) - lu(k,219) * lu(k,247) - lu(k,252) = lu(k,252) - lu(k,220) * lu(k,247) - lu(k,253) = - lu(k,221) * lu(k,247) + lu(k,251) = - lu(k,220) * lu(k,247) + lu(k,253) = lu(k,253) - lu(k,221) * lu(k,247) lu(k,254) = lu(k,254) - lu(k,222) * lu(k,247) - lu(k,256) = lu(k,256) - lu(k,223) * lu(k,247) + lu(k,255) = lu(k,255) - lu(k,223) * lu(k,247) lu(k,263) = lu(k,263) - lu(k,217) * lu(k,262) lu(k,265) = lu(k,265) - lu(k,218) * lu(k,262) - lu(k,266) = lu(k,266) - lu(k,219) * lu(k,262) - lu(k,272) = - lu(k,220) * lu(k,262) - lu(k,273) = lu(k,273) - lu(k,221) * lu(k,262) - lu(k,274) = lu(k,274) - lu(k,222) * lu(k,262) - lu(k,276) = - lu(k,223) * lu(k,262) + lu(k,267) = - lu(k,219) * lu(k,262) + lu(k,268) = lu(k,268) - lu(k,220) * lu(k,262) + lu(k,272) = lu(k,272) - lu(k,221) * lu(k,262) + lu(k,273) = lu(k,273) - lu(k,222) * lu(k,262) + lu(k,274) = - lu(k,223) * lu(k,262) lu(k,280) = lu(k,280) - lu(k,217) * lu(k,279) lu(k,283) = lu(k,283) - lu(k,218) * lu(k,279) - lu(k,284) = lu(k,284) - lu(k,219) * lu(k,279) - lu(k,290) = - lu(k,220) * lu(k,279) - lu(k,291) = - lu(k,221) * lu(k,279) + lu(k,286) = lu(k,286) - lu(k,219) * lu(k,279) + lu(k,287) = - lu(k,220) * lu(k,279) + lu(k,291) = lu(k,291) - lu(k,221) * lu(k,279) lu(k,292) = lu(k,292) - lu(k,222) * lu(k,279) - lu(k,295) = lu(k,295) - lu(k,223) * lu(k,279) - lu(k,313) = - lu(k,217) * lu(k,311) - lu(k,315) = lu(k,315) - lu(k,218) * lu(k,311) - lu(k,316) = lu(k,316) - lu(k,219) * lu(k,311) - lu(k,323) = - lu(k,220) * lu(k,311) - lu(k,324) = lu(k,324) - lu(k,221) * lu(k,311) - lu(k,325) = lu(k,325) - lu(k,222) * lu(k,311) - lu(k,328) = - lu(k,223) * lu(k,311) - lu(k,358) = lu(k,358) - lu(k,217) * lu(k,356) - lu(k,360) = - lu(k,218) * lu(k,356) - lu(k,361) = lu(k,361) - lu(k,219) * lu(k,356) - lu(k,368) = - lu(k,220) * lu(k,356) - lu(k,369) = lu(k,369) - lu(k,221) * lu(k,356) - lu(k,370) = lu(k,370) - lu(k,222) * lu(k,356) - lu(k,373) = - lu(k,223) * lu(k,356) - lu(k,382) = lu(k,382) - lu(k,217) * lu(k,380) - lu(k,385) = lu(k,385) - lu(k,218) * lu(k,380) - lu(k,386) = lu(k,386) - lu(k,219) * lu(k,380) - lu(k,393) = lu(k,393) - lu(k,220) * lu(k,380) - lu(k,394) = lu(k,394) - lu(k,221) * lu(k,380) - lu(k,395) = lu(k,395) - lu(k,222) * lu(k,380) - lu(k,398) = lu(k,398) - lu(k,223) * lu(k,380) - lu(k,408) = lu(k,408) - lu(k,217) * lu(k,406) - lu(k,411) = - lu(k,218) * lu(k,406) - lu(k,412) = lu(k,412) - lu(k,219) * lu(k,406) - lu(k,419) = lu(k,419) - lu(k,220) * lu(k,406) - lu(k,420) = lu(k,420) - lu(k,221) * lu(k,406) - lu(k,421) = lu(k,421) - lu(k,222) * lu(k,406) - lu(k,424) = - lu(k,223) * lu(k,406) - lu(k,433) = lu(k,433) - lu(k,217) * lu(k,431) - lu(k,436) = lu(k,436) - lu(k,218) * lu(k,431) - lu(k,437) = lu(k,437) - lu(k,219) * lu(k,431) - lu(k,444) = lu(k,444) - lu(k,220) * lu(k,431) - lu(k,445) = - lu(k,221) * lu(k,431) - lu(k,446) = lu(k,446) - lu(k,222) * lu(k,431) - lu(k,449) = lu(k,449) - lu(k,223) * lu(k,431) - lu(k,498) = lu(k,498) - lu(k,217) * lu(k,496) - lu(k,500) = lu(k,500) - lu(k,218) * lu(k,496) - lu(k,501) = lu(k,501) - lu(k,219) * lu(k,496) - lu(k,508) = - lu(k,220) * lu(k,496) - lu(k,509) = lu(k,509) - lu(k,221) * lu(k,496) - lu(k,510) = lu(k,510) - lu(k,222) * lu(k,496) - lu(k,513) = - lu(k,223) * lu(k,496) - lu(k,528) = lu(k,528) - lu(k,217) * lu(k,526) - lu(k,531) = lu(k,531) - lu(k,218) * lu(k,526) - lu(k,532) = lu(k,532) - lu(k,219) * lu(k,526) - lu(k,539) = lu(k,539) - lu(k,220) * lu(k,526) - lu(k,540) = lu(k,540) - lu(k,221) * lu(k,526) - lu(k,541) = lu(k,541) - lu(k,222) * lu(k,526) - lu(k,544) = lu(k,544) - lu(k,223) * lu(k,526) - lu(k,592) = lu(k,592) - lu(k,217) * lu(k,590) - lu(k,595) = lu(k,595) - lu(k,218) * lu(k,590) - lu(k,596) = lu(k,596) - lu(k,219) * lu(k,590) - lu(k,603) = - lu(k,220) * lu(k,590) - lu(k,604) = lu(k,604) - lu(k,221) * lu(k,590) - lu(k,605) = lu(k,605) - lu(k,222) * lu(k,590) - lu(k,608) = lu(k,608) - lu(k,223) * lu(k,590) - lu(k,613) = lu(k,613) - lu(k,217) * lu(k,612) - lu(k,615) = lu(k,615) - lu(k,218) * lu(k,612) - lu(k,616) = lu(k,616) - lu(k,219) * lu(k,612) - lu(k,623) = lu(k,623) - lu(k,220) * lu(k,612) - lu(k,624) = - lu(k,221) * lu(k,612) - lu(k,625) = lu(k,625) - lu(k,222) * lu(k,612) - lu(k,628) = lu(k,628) - lu(k,223) * lu(k,612) + lu(k,293) = - lu(k,223) * lu(k,279) + lu(k,357) = lu(k,357) - lu(k,217) * lu(k,356) + lu(k,359) = lu(k,359) - lu(k,218) * lu(k,356) + lu(k,362) = lu(k,362) - lu(k,219) * lu(k,356) + lu(k,364) = - lu(k,220) * lu(k,356) + lu(k,368) = lu(k,368) - lu(k,221) * lu(k,356) + lu(k,369) = lu(k,369) - lu(k,222) * lu(k,356) + lu(k,370) = lu(k,370) - lu(k,223) * lu(k,356) + lu(k,404) = lu(k,404) - lu(k,217) * lu(k,402) + lu(k,406) = lu(k,406) - lu(k,218) * lu(k,402) + lu(k,409) = - lu(k,219) * lu(k,402) + lu(k,411) = lu(k,411) - lu(k,220) * lu(k,402) + lu(k,415) = lu(k,415) - lu(k,221) * lu(k,402) + lu(k,416) = lu(k,416) - lu(k,222) * lu(k,402) + lu(k,417) = - lu(k,223) * lu(k,402) + lu(k,428) = lu(k,428) - lu(k,217) * lu(k,426) + lu(k,431) = lu(k,431) - lu(k,218) * lu(k,426) + lu(k,434) = lu(k,434) - lu(k,219) * lu(k,426) + lu(k,436) = - lu(k,220) * lu(k,426) + lu(k,440) = lu(k,440) - lu(k,221) * lu(k,426) + lu(k,441) = lu(k,441) - lu(k,222) * lu(k,426) + lu(k,442) = lu(k,442) - lu(k,223) * lu(k,426) + lu(k,454) = lu(k,454) - lu(k,217) * lu(k,452) + lu(k,457) = - lu(k,218) * lu(k,452) + lu(k,460) = - lu(k,219) * lu(k,452) + lu(k,462) = lu(k,462) - lu(k,220) * lu(k,452) + lu(k,466) = lu(k,466) - lu(k,221) * lu(k,452) + lu(k,467) = lu(k,467) - lu(k,222) * lu(k,452) + lu(k,468) = lu(k,468) - lu(k,223) * lu(k,452) + lu(k,478) = lu(k,478) - lu(k,217) * lu(k,476) + lu(k,480) = - lu(k,218) * lu(k,476) + lu(k,483) = - lu(k,219) * lu(k,476) + lu(k,485) = lu(k,485) - lu(k,220) * lu(k,476) + lu(k,489) = lu(k,489) - lu(k,221) * lu(k,476) + lu(k,490) = lu(k,490) - lu(k,222) * lu(k,476) + lu(k,491) = - lu(k,223) * lu(k,476) + lu(k,499) = - lu(k,217) * lu(k,497) + lu(k,501) = lu(k,501) - lu(k,218) * lu(k,497) + lu(k,504) = - lu(k,219) * lu(k,497) + lu(k,506) = lu(k,506) - lu(k,220) * lu(k,497) + lu(k,510) = lu(k,510) - lu(k,221) * lu(k,497) + lu(k,511) = lu(k,511) - lu(k,222) * lu(k,497) + lu(k,512) = - lu(k,223) * lu(k,497) + lu(k,529) = lu(k,529) - lu(k,217) * lu(k,527) + lu(k,532) = lu(k,532) - lu(k,218) * lu(k,527) + lu(k,535) = lu(k,535) - lu(k,219) * lu(k,527) + lu(k,537) = lu(k,537) - lu(k,220) * lu(k,527) + lu(k,541) = lu(k,541) - lu(k,221) * lu(k,527) + lu(k,542) = lu(k,542) - lu(k,222) * lu(k,527) + lu(k,543) = lu(k,543) - lu(k,223) * lu(k,527) + lu(k,573) = lu(k,573) - lu(k,217) * lu(k,571) + lu(k,576) = lu(k,576) - lu(k,218) * lu(k,571) + lu(k,579) = lu(k,579) - lu(k,219) * lu(k,571) + lu(k,581) = lu(k,581) - lu(k,220) * lu(k,571) + lu(k,585) = lu(k,585) - lu(k,221) * lu(k,571) + lu(k,586) = lu(k,586) - lu(k,222) * lu(k,571) + lu(k,587) = lu(k,587) - lu(k,223) * lu(k,571) + lu(k,630) = lu(k,630) - lu(k,217) * lu(k,628) + lu(k,633) = lu(k,633) - lu(k,218) * lu(k,628) + lu(k,636) = lu(k,636) - lu(k,219) * lu(k,628) + lu(k,638) = lu(k,638) - lu(k,220) * lu(k,628) + lu(k,642) = lu(k,642) - lu(k,221) * lu(k,628) + lu(k,643) = lu(k,643) - lu(k,222) * lu(k,628) + lu(k,644) = - lu(k,223) * lu(k,628) end do end subroutine lu_fac05 subroutine lu_fac06( avec_len, lu ) @@ -1081,117 +1081,117 @@ subroutine lu_fac06( avec_len, lu ) lu(k,243) = lu(k,243) * lu(k,236) lu(k,244) = lu(k,244) * lu(k,236) lu(k,298) = lu(k,298) - lu(k,237) * lu(k,296) - lu(k,300) = - lu(k,238) * lu(k,296) + lu(k,299) = lu(k,299) - lu(k,238) * lu(k,296) lu(k,301) = - lu(k,239) * lu(k,296) - lu(k,303) = - lu(k,240) * lu(k,296) - lu(k,304) = lu(k,304) - lu(k,241) * lu(k,296) + lu(k,302) = - lu(k,240) * lu(k,296) + lu(k,303) = - lu(k,241) * lu(k,296) lu(k,305) = lu(k,305) - lu(k,242) * lu(k,296) - lu(k,306) = lu(k,306) - lu(k,243) * lu(k,296) + lu(k,307) = lu(k,307) - lu(k,243) * lu(k,296) lu(k,308) = lu(k,308) - lu(k,244) * lu(k,296) - lu(k,315) = lu(k,315) - lu(k,237) * lu(k,312) - lu(k,317) = lu(k,317) - lu(k,238) * lu(k,312) - lu(k,321) = - lu(k,239) * lu(k,312) - lu(k,324) = lu(k,324) - lu(k,240) * lu(k,312) - lu(k,325) = lu(k,325) - lu(k,241) * lu(k,312) - lu(k,326) = lu(k,326) - lu(k,242) * lu(k,312) - lu(k,327) = lu(k,327) - lu(k,243) * lu(k,312) - lu(k,329) = - lu(k,244) * lu(k,312) - lu(k,337) = lu(k,337) - lu(k,237) * lu(k,335) - lu(k,339) = lu(k,339) - lu(k,238) * lu(k,335) - lu(k,343) = lu(k,343) - lu(k,239) * lu(k,335) - lu(k,346) = lu(k,346) - lu(k,240) * lu(k,335) - lu(k,347) = lu(k,347) - lu(k,241) * lu(k,335) - lu(k,348) = lu(k,348) - lu(k,242) * lu(k,335) - lu(k,349) = lu(k,349) - lu(k,243) * lu(k,335) - lu(k,351) = lu(k,351) - lu(k,244) * lu(k,335) - lu(k,360) = lu(k,360) - lu(k,237) * lu(k,357) - lu(k,362) = lu(k,362) - lu(k,238) * lu(k,357) - lu(k,366) = - lu(k,239) * lu(k,357) - lu(k,369) = lu(k,369) - lu(k,240) * lu(k,357) - lu(k,370) = lu(k,370) - lu(k,241) * lu(k,357) - lu(k,371) = lu(k,371) - lu(k,242) * lu(k,357) - lu(k,372) = lu(k,372) - lu(k,243) * lu(k,357) - lu(k,374) = - lu(k,244) * lu(k,357) - lu(k,385) = lu(k,385) - lu(k,237) * lu(k,381) - lu(k,387) = - lu(k,238) * lu(k,381) - lu(k,391) = - lu(k,239) * lu(k,381) - lu(k,394) = lu(k,394) - lu(k,240) * lu(k,381) - lu(k,395) = lu(k,395) - lu(k,241) * lu(k,381) - lu(k,396) = lu(k,396) - lu(k,242) * lu(k,381) - lu(k,397) = lu(k,397) - lu(k,243) * lu(k,381) - lu(k,399) = lu(k,399) - lu(k,244) * lu(k,381) - lu(k,411) = lu(k,411) - lu(k,237) * lu(k,407) - lu(k,413) = lu(k,413) - lu(k,238) * lu(k,407) - lu(k,417) = - lu(k,239) * lu(k,407) - lu(k,420) = lu(k,420) - lu(k,240) * lu(k,407) - lu(k,421) = lu(k,421) - lu(k,241) * lu(k,407) - lu(k,422) = lu(k,422) - lu(k,242) * lu(k,407) - lu(k,423) = lu(k,423) - lu(k,243) * lu(k,407) - lu(k,425) = - lu(k,244) * lu(k,407) - lu(k,436) = lu(k,436) - lu(k,237) * lu(k,432) - lu(k,438) = lu(k,438) - lu(k,238) * lu(k,432) - lu(k,442) = lu(k,442) - lu(k,239) * lu(k,432) - lu(k,445) = lu(k,445) - lu(k,240) * lu(k,432) - lu(k,446) = lu(k,446) - lu(k,241) * lu(k,432) - lu(k,447) = lu(k,447) - lu(k,242) * lu(k,432) - lu(k,448) = lu(k,448) - lu(k,243) * lu(k,432) - lu(k,450) = lu(k,450) - lu(k,244) * lu(k,432) - lu(k,456) = lu(k,456) - lu(k,237) * lu(k,453) - lu(k,458) = - lu(k,238) * lu(k,453) - lu(k,462) = lu(k,462) - lu(k,239) * lu(k,453) - lu(k,465) = - lu(k,240) * lu(k,453) - lu(k,466) = lu(k,466) - lu(k,241) * lu(k,453) + lu(k,319) = lu(k,319) - lu(k,237) * lu(k,315) + lu(k,320) = lu(k,320) - lu(k,238) * lu(k,315) + lu(k,323) = lu(k,323) - lu(k,239) * lu(k,315) + lu(k,324) = lu(k,324) - lu(k,240) * lu(k,315) + lu(k,325) = lu(k,325) - lu(k,241) * lu(k,315) + lu(k,329) = lu(k,329) - lu(k,242) * lu(k,315) + lu(k,332) = lu(k,332) - lu(k,243) * lu(k,315) + lu(k,333) = lu(k,333) - lu(k,244) * lu(k,315) + lu(k,339) = lu(k,339) - lu(k,237) * lu(k,336) + lu(k,340) = lu(k,340) - lu(k,238) * lu(k,336) + lu(k,343) = - lu(k,239) * lu(k,336) + lu(k,344) = - lu(k,240) * lu(k,336) + lu(k,345) = lu(k,345) - lu(k,241) * lu(k,336) + lu(k,349) = lu(k,349) - lu(k,242) * lu(k,336) + lu(k,352) = lu(k,352) - lu(k,243) * lu(k,336) + lu(k,353) = lu(k,353) - lu(k,244) * lu(k,336) + lu(k,381) = lu(k,381) - lu(k,237) * lu(k,379) + lu(k,382) = lu(k,382) - lu(k,238) * lu(k,379) + lu(k,385) = lu(k,385) - lu(k,239) * lu(k,379) + lu(k,386) = lu(k,386) - lu(k,240) * lu(k,379) + lu(k,387) = lu(k,387) - lu(k,241) * lu(k,379) + lu(k,391) = lu(k,391) - lu(k,242) * lu(k,379) + lu(k,394) = lu(k,394) - lu(k,243) * lu(k,379) + lu(k,395) = lu(k,395) - lu(k,244) * lu(k,379) + lu(k,406) = lu(k,406) - lu(k,237) * lu(k,403) + lu(k,407) = lu(k,407) - lu(k,238) * lu(k,403) + lu(k,410) = lu(k,410) - lu(k,239) * lu(k,403) + lu(k,411) = lu(k,411) - lu(k,240) * lu(k,403) + lu(k,412) = lu(k,412) - lu(k,241) * lu(k,403) + lu(k,416) = lu(k,416) - lu(k,242) * lu(k,403) + lu(k,419) = lu(k,419) - lu(k,243) * lu(k,403) + lu(k,420) = lu(k,420) - lu(k,244) * lu(k,403) + lu(k,431) = lu(k,431) - lu(k,237) * lu(k,427) + lu(k,432) = lu(k,432) - lu(k,238) * lu(k,427) + lu(k,435) = lu(k,435) - lu(k,239) * lu(k,427) + lu(k,436) = lu(k,436) - lu(k,240) * lu(k,427) + lu(k,437) = lu(k,437) - lu(k,241) * lu(k,427) + lu(k,441) = lu(k,441) - lu(k,242) * lu(k,427) + lu(k,444) = lu(k,444) - lu(k,243) * lu(k,427) + lu(k,445) = lu(k,445) - lu(k,244) * lu(k,427) + lu(k,457) = lu(k,457) - lu(k,237) * lu(k,453) + lu(k,458) = lu(k,458) - lu(k,238) * lu(k,453) + lu(k,461) = lu(k,461) - lu(k,239) * lu(k,453) + lu(k,462) = lu(k,462) - lu(k,240) * lu(k,453) + lu(k,463) = - lu(k,241) * lu(k,453) lu(k,467) = lu(k,467) - lu(k,242) * lu(k,453) - lu(k,468) = lu(k,468) - lu(k,243) * lu(k,453) - lu(k,470) = lu(k,470) - lu(k,244) * lu(k,453) - lu(k,475) = lu(k,475) - lu(k,237) * lu(k,472) - lu(k,477) = lu(k,477) - lu(k,238) * lu(k,472) - lu(k,481) = - lu(k,239) * lu(k,472) - lu(k,484) = lu(k,484) - lu(k,240) * lu(k,472) - lu(k,485) = lu(k,485) - lu(k,241) * lu(k,472) - lu(k,486) = lu(k,486) - lu(k,242) * lu(k,472) - lu(k,487) = - lu(k,243) * lu(k,472) - lu(k,489) = - lu(k,244) * lu(k,472) - lu(k,500) = lu(k,500) - lu(k,237) * lu(k,497) - lu(k,502) = lu(k,502) - lu(k,238) * lu(k,497) - lu(k,506) = lu(k,506) - lu(k,239) * lu(k,497) - lu(k,509) = lu(k,509) - lu(k,240) * lu(k,497) - lu(k,510) = lu(k,510) - lu(k,241) * lu(k,497) - lu(k,511) = lu(k,511) - lu(k,242) * lu(k,497) - lu(k,512) = lu(k,512) - lu(k,243) * lu(k,497) - lu(k,514) = lu(k,514) - lu(k,244) * lu(k,497) - lu(k,531) = lu(k,531) - lu(k,237) * lu(k,527) - lu(k,533) = lu(k,533) - lu(k,238) * lu(k,527) - lu(k,537) = lu(k,537) - lu(k,239) * lu(k,527) - lu(k,540) = lu(k,540) - lu(k,240) * lu(k,527) - lu(k,541) = lu(k,541) - lu(k,241) * lu(k,527) - lu(k,542) = lu(k,542) - lu(k,242) * lu(k,527) - lu(k,543) = lu(k,543) - lu(k,243) * lu(k,527) - lu(k,545) = lu(k,545) - lu(k,244) * lu(k,527) - lu(k,556) = lu(k,556) - lu(k,237) * lu(k,552) - lu(k,558) = lu(k,558) - lu(k,238) * lu(k,552) - lu(k,562) = lu(k,562) - lu(k,239) * lu(k,552) - lu(k,565) = lu(k,565) - lu(k,240) * lu(k,552) - lu(k,566) = lu(k,566) - lu(k,241) * lu(k,552) - lu(k,567) = lu(k,567) - lu(k,242) * lu(k,552) - lu(k,568) = lu(k,568) - lu(k,243) * lu(k,552) - lu(k,570) = lu(k,570) - lu(k,244) * lu(k,552) - lu(k,595) = lu(k,595) - lu(k,237) * lu(k,591) - lu(k,597) = lu(k,597) - lu(k,238) * lu(k,591) - lu(k,601) = lu(k,601) - lu(k,239) * lu(k,591) - lu(k,604) = lu(k,604) - lu(k,240) * lu(k,591) - lu(k,605) = lu(k,605) - lu(k,241) * lu(k,591) - lu(k,606) = lu(k,606) - lu(k,242) * lu(k,591) - lu(k,607) = lu(k,607) - lu(k,243) * lu(k,591) - lu(k,609) = lu(k,609) - lu(k,244) * lu(k,591) - lu(k,633) = lu(k,633) - lu(k,237) * lu(k,632) - lu(k,635) = lu(k,635) - lu(k,238) * lu(k,632) - lu(k,639) = lu(k,639) - lu(k,239) * lu(k,632) - lu(k,642) = lu(k,642) - lu(k,240) * lu(k,632) - lu(k,643) = lu(k,643) - lu(k,241) * lu(k,632) - lu(k,644) = lu(k,644) - lu(k,242) * lu(k,632) - lu(k,645) = lu(k,645) - lu(k,243) * lu(k,632) - lu(k,647) = lu(k,647) - lu(k,244) * lu(k,632) + lu(k,470) = - lu(k,243) * lu(k,453) + lu(k,471) = lu(k,471) - lu(k,244) * lu(k,453) + lu(k,480) = lu(k,480) - lu(k,237) * lu(k,477) + lu(k,481) = lu(k,481) - lu(k,238) * lu(k,477) + lu(k,484) = lu(k,484) - lu(k,239) * lu(k,477) + lu(k,485) = lu(k,485) - lu(k,240) * lu(k,477) + lu(k,486) = - lu(k,241) * lu(k,477) + lu(k,490) = lu(k,490) - lu(k,242) * lu(k,477) + lu(k,493) = - lu(k,243) * lu(k,477) + lu(k,494) = lu(k,494) - lu(k,244) * lu(k,477) + lu(k,501) = lu(k,501) - lu(k,237) * lu(k,498) + lu(k,502) = lu(k,502) - lu(k,238) * lu(k,498) + lu(k,505) = lu(k,505) - lu(k,239) * lu(k,498) + lu(k,506) = lu(k,506) - lu(k,240) * lu(k,498) + lu(k,507) = - lu(k,241) * lu(k,498) + lu(k,511) = lu(k,511) - lu(k,242) * lu(k,498) + lu(k,514) = - lu(k,243) * lu(k,498) + lu(k,515) = lu(k,515) - lu(k,244) * lu(k,498) + lu(k,532) = lu(k,532) - lu(k,237) * lu(k,528) + lu(k,533) = lu(k,533) - lu(k,238) * lu(k,528) + lu(k,536) = lu(k,536) - lu(k,239) * lu(k,528) + lu(k,537) = lu(k,537) - lu(k,240) * lu(k,528) + lu(k,538) = lu(k,538) - lu(k,241) * lu(k,528) + lu(k,542) = lu(k,542) - lu(k,242) * lu(k,528) + lu(k,545) = lu(k,545) - lu(k,243) * lu(k,528) + lu(k,546) = lu(k,546) - lu(k,244) * lu(k,528) + lu(k,551) = lu(k,551) - lu(k,237) * lu(k,548) + lu(k,552) = lu(k,552) - lu(k,238) * lu(k,548) + lu(k,555) = lu(k,555) - lu(k,239) * lu(k,548) + lu(k,556) = lu(k,556) - lu(k,240) * lu(k,548) + lu(k,557) = - lu(k,241) * lu(k,548) + lu(k,561) = lu(k,561) - lu(k,242) * lu(k,548) + lu(k,564) = - lu(k,243) * lu(k,548) + lu(k,565) = - lu(k,244) * lu(k,548) + lu(k,576) = lu(k,576) - lu(k,237) * lu(k,572) + lu(k,577) = lu(k,577) - lu(k,238) * lu(k,572) + lu(k,580) = - lu(k,239) * lu(k,572) + lu(k,581) = lu(k,581) - lu(k,240) * lu(k,572) + lu(k,582) = - lu(k,241) * lu(k,572) + lu(k,586) = lu(k,586) - lu(k,242) * lu(k,572) + lu(k,589) = lu(k,589) - lu(k,243) * lu(k,572) + lu(k,590) = lu(k,590) - lu(k,244) * lu(k,572) + lu(k,594) = lu(k,594) - lu(k,237) * lu(k,593) + lu(k,595) = lu(k,595) - lu(k,238) * lu(k,593) + lu(k,598) = lu(k,598) - lu(k,239) * lu(k,593) + lu(k,599) = lu(k,599) - lu(k,240) * lu(k,593) + lu(k,600) = lu(k,600) - lu(k,241) * lu(k,593) + lu(k,604) = lu(k,604) - lu(k,242) * lu(k,593) + lu(k,607) = lu(k,607) - lu(k,243) * lu(k,593) + lu(k,608) = lu(k,608) - lu(k,244) * lu(k,593) + lu(k,633) = lu(k,633) - lu(k,237) * lu(k,629) + lu(k,634) = lu(k,634) - lu(k,238) * lu(k,629) + lu(k,637) = lu(k,637) - lu(k,239) * lu(k,629) + lu(k,638) = lu(k,638) - lu(k,240) * lu(k,629) + lu(k,639) = lu(k,639) - lu(k,241) * lu(k,629) + lu(k,643) = lu(k,643) - lu(k,242) * lu(k,629) + lu(k,646) = lu(k,646) - lu(k,243) * lu(k,629) + lu(k,647) = lu(k,647) - lu(k,244) * lu(k,629) 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) @@ -1202,125 +1202,125 @@ subroutine lu_fac06( avec_len, lu ) lu(k,255) = lu(k,255) * lu(k,248) lu(k,256) = lu(k,256) * lu(k,248) lu(k,265) = lu(k,265) - lu(k,249) * lu(k,263) - lu(k,266) = lu(k,266) - lu(k,250) * lu(k,263) - lu(k,270) = lu(k,270) - lu(k,251) * lu(k,263) - lu(k,272) = lu(k,272) - lu(k,252) * lu(k,263) - lu(k,273) = lu(k,273) - lu(k,253) * lu(k,263) - lu(k,274) = lu(k,274) - lu(k,254) * lu(k,263) - lu(k,275) = lu(k,275) - lu(k,255) * lu(k,263) + lu(k,267) = lu(k,267) - lu(k,250) * lu(k,263) + lu(k,268) = lu(k,268) - lu(k,251) * lu(k,263) + lu(k,269) = lu(k,269) - lu(k,252) * lu(k,263) + lu(k,272) = lu(k,272) - lu(k,253) * lu(k,263) + lu(k,273) = lu(k,273) - lu(k,254) * lu(k,263) + lu(k,274) = lu(k,274) - lu(k,255) * lu(k,263) lu(k,276) = lu(k,276) - lu(k,256) * lu(k,263) lu(k,283) = lu(k,283) - lu(k,249) * lu(k,280) - lu(k,284) = lu(k,284) - lu(k,250) * lu(k,280) - lu(k,288) = lu(k,288) - lu(k,251) * lu(k,280) - lu(k,290) = lu(k,290) - lu(k,252) * lu(k,280) + lu(k,286) = lu(k,286) - lu(k,250) * lu(k,280) + lu(k,287) = lu(k,287) - lu(k,251) * lu(k,280) + lu(k,288) = lu(k,288) - lu(k,252) * lu(k,280) lu(k,291) = lu(k,291) - lu(k,253) * lu(k,280) lu(k,292) = lu(k,292) - lu(k,254) * lu(k,280) - lu(k,294) = lu(k,294) - lu(k,255) * lu(k,280) + lu(k,293) = lu(k,293) - lu(k,255) * lu(k,280) lu(k,295) = lu(k,295) - lu(k,256) * lu(k,280) lu(k,298) = lu(k,298) - lu(k,249) * lu(k,297) - lu(k,299) = - lu(k,250) * lu(k,297) - lu(k,301) = lu(k,301) - lu(k,251) * lu(k,297) - lu(k,302) = - lu(k,252) * lu(k,297) - lu(k,303) = lu(k,303) - lu(k,253) * lu(k,297) - lu(k,304) = lu(k,304) - lu(k,254) * lu(k,297) - lu(k,306) = lu(k,306) - lu(k,255) * lu(k,297) - lu(k,307) = lu(k,307) - lu(k,256) * lu(k,297) - lu(k,315) = lu(k,315) - lu(k,249) * lu(k,313) - lu(k,316) = lu(k,316) - lu(k,250) * lu(k,313) - lu(k,321) = lu(k,321) - lu(k,251) * lu(k,313) - lu(k,323) = lu(k,323) - lu(k,252) * lu(k,313) - lu(k,324) = lu(k,324) - lu(k,253) * lu(k,313) - lu(k,325) = lu(k,325) - lu(k,254) * lu(k,313) - lu(k,327) = lu(k,327) - lu(k,255) * lu(k,313) - lu(k,328) = lu(k,328) - lu(k,256) * lu(k,313) - lu(k,360) = lu(k,360) - lu(k,249) * lu(k,358) - lu(k,361) = lu(k,361) - lu(k,250) * lu(k,358) - lu(k,366) = lu(k,366) - lu(k,251) * lu(k,358) - lu(k,368) = lu(k,368) - lu(k,252) * lu(k,358) - lu(k,369) = lu(k,369) - lu(k,253) * lu(k,358) - lu(k,370) = lu(k,370) - lu(k,254) * lu(k,358) - lu(k,372) = lu(k,372) - lu(k,255) * lu(k,358) - lu(k,373) = lu(k,373) - lu(k,256) * lu(k,358) - lu(k,385) = lu(k,385) - lu(k,249) * lu(k,382) - lu(k,386) = lu(k,386) - lu(k,250) * lu(k,382) - lu(k,391) = lu(k,391) - lu(k,251) * lu(k,382) - lu(k,393) = lu(k,393) - lu(k,252) * lu(k,382) - lu(k,394) = lu(k,394) - lu(k,253) * lu(k,382) - lu(k,395) = lu(k,395) - lu(k,254) * lu(k,382) - lu(k,397) = lu(k,397) - lu(k,255) * lu(k,382) - lu(k,398) = lu(k,398) - lu(k,256) * lu(k,382) - lu(k,411) = lu(k,411) - lu(k,249) * lu(k,408) - lu(k,412) = lu(k,412) - lu(k,250) * lu(k,408) - lu(k,417) = lu(k,417) - lu(k,251) * lu(k,408) - lu(k,419) = lu(k,419) - lu(k,252) * lu(k,408) - lu(k,420) = lu(k,420) - lu(k,253) * lu(k,408) - lu(k,421) = lu(k,421) - lu(k,254) * lu(k,408) - lu(k,423) = lu(k,423) - lu(k,255) * lu(k,408) - lu(k,424) = lu(k,424) - lu(k,256) * lu(k,408) - lu(k,436) = lu(k,436) - lu(k,249) * lu(k,433) - lu(k,437) = lu(k,437) - lu(k,250) * lu(k,433) - lu(k,442) = lu(k,442) - lu(k,251) * lu(k,433) - lu(k,444) = lu(k,444) - lu(k,252) * lu(k,433) - lu(k,445) = lu(k,445) - lu(k,253) * lu(k,433) - lu(k,446) = lu(k,446) - lu(k,254) * lu(k,433) - lu(k,448) = lu(k,448) - lu(k,255) * lu(k,433) - lu(k,449) = lu(k,449) - lu(k,256) * lu(k,433) - lu(k,456) = lu(k,456) - lu(k,249) * lu(k,454) - lu(k,457) = - lu(k,250) * lu(k,454) + lu(k,300) = lu(k,300) - lu(k,250) * lu(k,297) + lu(k,302) = lu(k,302) - lu(k,251) * lu(k,297) + lu(k,303) = lu(k,303) - lu(k,252) * lu(k,297) + lu(k,304) = - lu(k,253) * lu(k,297) + lu(k,305) = lu(k,305) - lu(k,254) * lu(k,297) + lu(k,306) = - lu(k,255) * lu(k,297) + lu(k,308) = lu(k,308) - lu(k,256) * lu(k,297) + lu(k,319) = lu(k,319) - lu(k,249) * lu(k,316) + lu(k,322) = lu(k,322) - lu(k,250) * lu(k,316) + lu(k,324) = lu(k,324) - lu(k,251) * lu(k,316) + lu(k,325) = lu(k,325) - lu(k,252) * lu(k,316) + lu(k,328) = lu(k,328) - lu(k,253) * lu(k,316) + lu(k,329) = lu(k,329) - lu(k,254) * lu(k,316) + lu(k,330) = lu(k,330) - lu(k,255) * lu(k,316) + lu(k,333) = lu(k,333) - lu(k,256) * lu(k,316) + lu(k,339) = lu(k,339) - lu(k,249) * lu(k,337) + lu(k,342) = - lu(k,250) * lu(k,337) + lu(k,344) = lu(k,344) - lu(k,251) * lu(k,337) + lu(k,345) = lu(k,345) - lu(k,252) * lu(k,337) + lu(k,348) = - lu(k,253) * lu(k,337) + lu(k,349) = lu(k,349) - lu(k,254) * lu(k,337) + lu(k,350) = - lu(k,255) * lu(k,337) + lu(k,353) = lu(k,353) - lu(k,256) * lu(k,337) + lu(k,359) = lu(k,359) - lu(k,249) * lu(k,357) + lu(k,362) = lu(k,362) - lu(k,250) * lu(k,357) + lu(k,364) = lu(k,364) - lu(k,251) * lu(k,357) + lu(k,365) = lu(k,365) - lu(k,252) * lu(k,357) + lu(k,368) = lu(k,368) - lu(k,253) * lu(k,357) + lu(k,369) = lu(k,369) - lu(k,254) * lu(k,357) + lu(k,370) = lu(k,370) - lu(k,255) * lu(k,357) + lu(k,373) = lu(k,373) - lu(k,256) * lu(k,357) + lu(k,406) = lu(k,406) - lu(k,249) * lu(k,404) + lu(k,409) = lu(k,409) - lu(k,250) * lu(k,404) + lu(k,411) = lu(k,411) - lu(k,251) * lu(k,404) + lu(k,412) = lu(k,412) - lu(k,252) * lu(k,404) + lu(k,415) = lu(k,415) - lu(k,253) * lu(k,404) + lu(k,416) = lu(k,416) - lu(k,254) * lu(k,404) + lu(k,417) = lu(k,417) - lu(k,255) * lu(k,404) + lu(k,420) = lu(k,420) - lu(k,256) * lu(k,404) + lu(k,431) = lu(k,431) - lu(k,249) * lu(k,428) + lu(k,434) = lu(k,434) - lu(k,250) * lu(k,428) + lu(k,436) = lu(k,436) - lu(k,251) * lu(k,428) + lu(k,437) = lu(k,437) - lu(k,252) * lu(k,428) + lu(k,440) = lu(k,440) - lu(k,253) * lu(k,428) + lu(k,441) = lu(k,441) - lu(k,254) * lu(k,428) + lu(k,442) = lu(k,442) - lu(k,255) * lu(k,428) + lu(k,445) = lu(k,445) - lu(k,256) * lu(k,428) + lu(k,457) = lu(k,457) - lu(k,249) * lu(k,454) + lu(k,460) = lu(k,460) - lu(k,250) * lu(k,454) lu(k,462) = lu(k,462) - lu(k,251) * lu(k,454) - lu(k,464) = - lu(k,252) * lu(k,454) - lu(k,465) = lu(k,465) - lu(k,253) * lu(k,454) - lu(k,466) = lu(k,466) - lu(k,254) * lu(k,454) + lu(k,463) = lu(k,463) - lu(k,252) * lu(k,454) + lu(k,466) = lu(k,466) - lu(k,253) * lu(k,454) + lu(k,467) = lu(k,467) - lu(k,254) * lu(k,454) lu(k,468) = lu(k,468) - lu(k,255) * lu(k,454) - lu(k,469) = - lu(k,256) * lu(k,454) - lu(k,475) = lu(k,475) - lu(k,249) * lu(k,473) - lu(k,476) = - lu(k,250) * lu(k,473) - lu(k,481) = lu(k,481) - lu(k,251) * lu(k,473) - lu(k,483) = lu(k,483) - lu(k,252) * lu(k,473) - lu(k,484) = lu(k,484) - lu(k,253) * lu(k,473) - lu(k,485) = lu(k,485) - lu(k,254) * lu(k,473) - lu(k,487) = lu(k,487) - lu(k,255) * lu(k,473) - lu(k,488) = - lu(k,256) * lu(k,473) - lu(k,500) = lu(k,500) - lu(k,249) * lu(k,498) - lu(k,501) = lu(k,501) - lu(k,250) * lu(k,498) - lu(k,506) = lu(k,506) - lu(k,251) * lu(k,498) - lu(k,508) = lu(k,508) - lu(k,252) * lu(k,498) - lu(k,509) = lu(k,509) - lu(k,253) * lu(k,498) - lu(k,510) = lu(k,510) - lu(k,254) * lu(k,498) - lu(k,512) = lu(k,512) - lu(k,255) * lu(k,498) - lu(k,513) = lu(k,513) - lu(k,256) * lu(k,498) - lu(k,531) = lu(k,531) - lu(k,249) * lu(k,528) - lu(k,532) = lu(k,532) - lu(k,250) * lu(k,528) - lu(k,537) = lu(k,537) - lu(k,251) * lu(k,528) - lu(k,539) = lu(k,539) - lu(k,252) * lu(k,528) - lu(k,540) = lu(k,540) - lu(k,253) * lu(k,528) - lu(k,541) = lu(k,541) - lu(k,254) * lu(k,528) - lu(k,543) = lu(k,543) - lu(k,255) * lu(k,528) - lu(k,544) = lu(k,544) - lu(k,256) * lu(k,528) - lu(k,556) = lu(k,556) - lu(k,249) * lu(k,553) - lu(k,557) = lu(k,557) - lu(k,250) * lu(k,553) - lu(k,562) = lu(k,562) - lu(k,251) * lu(k,553) - lu(k,564) = lu(k,564) - lu(k,252) * lu(k,553) - lu(k,565) = lu(k,565) - lu(k,253) * lu(k,553) - lu(k,566) = lu(k,566) - lu(k,254) * lu(k,553) - lu(k,568) = lu(k,568) - lu(k,255) * lu(k,553) - lu(k,569) = lu(k,569) - lu(k,256) * lu(k,553) - lu(k,595) = lu(k,595) - lu(k,249) * lu(k,592) - lu(k,596) = lu(k,596) - lu(k,250) * lu(k,592) - lu(k,601) = lu(k,601) - lu(k,251) * lu(k,592) - lu(k,603) = lu(k,603) - lu(k,252) * lu(k,592) - lu(k,604) = lu(k,604) - lu(k,253) * lu(k,592) - lu(k,605) = lu(k,605) - lu(k,254) * lu(k,592) - lu(k,607) = lu(k,607) - lu(k,255) * lu(k,592) - lu(k,608) = lu(k,608) - lu(k,256) * lu(k,592) - lu(k,615) = lu(k,615) - lu(k,249) * lu(k,613) - lu(k,616) = lu(k,616) - lu(k,250) * lu(k,613) - lu(k,621) = lu(k,621) - lu(k,251) * lu(k,613) - lu(k,623) = lu(k,623) - lu(k,252) * lu(k,613) - lu(k,624) = lu(k,624) - lu(k,253) * lu(k,613) - lu(k,625) = lu(k,625) - lu(k,254) * lu(k,613) - lu(k,627) = lu(k,627) - lu(k,255) * lu(k,613) - lu(k,628) = lu(k,628) - lu(k,256) * lu(k,613) + lu(k,471) = lu(k,471) - lu(k,256) * lu(k,454) + lu(k,480) = lu(k,480) - lu(k,249) * lu(k,478) + lu(k,483) = lu(k,483) - lu(k,250) * lu(k,478) + lu(k,485) = lu(k,485) - lu(k,251) * lu(k,478) + lu(k,486) = lu(k,486) - lu(k,252) * lu(k,478) + lu(k,489) = lu(k,489) - lu(k,253) * lu(k,478) + lu(k,490) = lu(k,490) - lu(k,254) * lu(k,478) + lu(k,491) = lu(k,491) - lu(k,255) * lu(k,478) + lu(k,494) = lu(k,494) - lu(k,256) * lu(k,478) + lu(k,501) = lu(k,501) - lu(k,249) * lu(k,499) + lu(k,504) = lu(k,504) - lu(k,250) * lu(k,499) + lu(k,506) = lu(k,506) - lu(k,251) * lu(k,499) + lu(k,507) = lu(k,507) - lu(k,252) * lu(k,499) + lu(k,510) = lu(k,510) - lu(k,253) * lu(k,499) + lu(k,511) = lu(k,511) - lu(k,254) * lu(k,499) + lu(k,512) = lu(k,512) - lu(k,255) * lu(k,499) + lu(k,515) = lu(k,515) - lu(k,256) * lu(k,499) + lu(k,532) = lu(k,532) - lu(k,249) * lu(k,529) + lu(k,535) = lu(k,535) - lu(k,250) * lu(k,529) + lu(k,537) = lu(k,537) - lu(k,251) * lu(k,529) + lu(k,538) = lu(k,538) - lu(k,252) * lu(k,529) + lu(k,541) = lu(k,541) - lu(k,253) * lu(k,529) + lu(k,542) = lu(k,542) - lu(k,254) * lu(k,529) + lu(k,543) = lu(k,543) - lu(k,255) * lu(k,529) + lu(k,546) = lu(k,546) - lu(k,256) * lu(k,529) + lu(k,551) = lu(k,551) - lu(k,249) * lu(k,549) + lu(k,554) = - lu(k,250) * lu(k,549) + lu(k,556) = lu(k,556) - lu(k,251) * lu(k,549) + lu(k,557) = lu(k,557) - lu(k,252) * lu(k,549) + lu(k,560) = - lu(k,253) * lu(k,549) + lu(k,561) = lu(k,561) - lu(k,254) * lu(k,549) + lu(k,562) = lu(k,562) - lu(k,255) * lu(k,549) + lu(k,565) = lu(k,565) - lu(k,256) * lu(k,549) + lu(k,576) = lu(k,576) - lu(k,249) * lu(k,573) + lu(k,579) = lu(k,579) - lu(k,250) * lu(k,573) + lu(k,581) = lu(k,581) - lu(k,251) * lu(k,573) + lu(k,582) = lu(k,582) - lu(k,252) * lu(k,573) + lu(k,585) = lu(k,585) - lu(k,253) * lu(k,573) + lu(k,586) = lu(k,586) - lu(k,254) * lu(k,573) + lu(k,587) = lu(k,587) - lu(k,255) * lu(k,573) + lu(k,590) = lu(k,590) - lu(k,256) * lu(k,573) + lu(k,633) = lu(k,633) - lu(k,249) * lu(k,630) + lu(k,636) = lu(k,636) - lu(k,250) * lu(k,630) + lu(k,638) = lu(k,638) - lu(k,251) * lu(k,630) + lu(k,639) = lu(k,639) - lu(k,252) * lu(k,630) + lu(k,642) = lu(k,642) - lu(k,253) * lu(k,630) + lu(k,643) = lu(k,643) - lu(k,254) * lu(k,630) + lu(k,644) = lu(k,644) - lu(k,255) * lu(k,630) + lu(k,647) = lu(k,647) - lu(k,256) * lu(k,630) lu(k,264) = 1._r8 / lu(k,264) lu(k,265) = lu(k,265) * lu(k,264) lu(k,266) = lu(k,266) * lu(k,264) @@ -1335,125 +1335,125 @@ subroutine lu_fac06( avec_len, lu ) lu(k,275) = lu(k,275) * lu(k,264) lu(k,276) = lu(k,276) * lu(k,264) lu(k,283) = lu(k,283) - lu(k,265) * lu(k,281) - lu(k,284) = lu(k,284) - lu(k,266) * lu(k,281) - lu(k,285) = lu(k,285) - lu(k,267) * lu(k,281) - lu(k,286) = lu(k,286) - lu(k,268) * lu(k,281) - lu(k,287) = - lu(k,269) * lu(k,281) - lu(k,288) = lu(k,288) - lu(k,270) * lu(k,281) - lu(k,289) = lu(k,289) - lu(k,271) * lu(k,281) - lu(k,290) = lu(k,290) - lu(k,272) * lu(k,281) - lu(k,291) = lu(k,291) - lu(k,273) * lu(k,281) - lu(k,292) = lu(k,292) - lu(k,274) * lu(k,281) + lu(k,285) = lu(k,285) - lu(k,266) * lu(k,281) + lu(k,286) = lu(k,286) - lu(k,267) * lu(k,281) + lu(k,287) = lu(k,287) - lu(k,268) * lu(k,281) + lu(k,288) = lu(k,288) - lu(k,269) * lu(k,281) + lu(k,289) = - lu(k,270) * lu(k,281) + lu(k,290) = lu(k,290) - lu(k,271) * lu(k,281) + lu(k,291) = lu(k,291) - lu(k,272) * lu(k,281) + lu(k,292) = lu(k,292) - lu(k,273) * lu(k,281) + lu(k,293) = lu(k,293) - lu(k,274) * lu(k,281) lu(k,294) = lu(k,294) - lu(k,275) * lu(k,281) lu(k,295) = lu(k,295) - lu(k,276) * lu(k,281) - lu(k,360) = lu(k,360) - lu(k,265) * lu(k,359) - lu(k,361) = lu(k,361) - lu(k,266) * lu(k,359) - lu(k,363) = lu(k,363) - lu(k,267) * lu(k,359) - lu(k,364) = lu(k,364) - lu(k,268) * lu(k,359) - lu(k,365) = lu(k,365) - lu(k,269) * lu(k,359) - lu(k,366) = lu(k,366) - lu(k,270) * lu(k,359) - lu(k,367) = lu(k,367) - lu(k,271) * lu(k,359) - lu(k,368) = lu(k,368) - lu(k,272) * lu(k,359) - lu(k,369) = lu(k,369) - lu(k,273) * lu(k,359) - lu(k,370) = lu(k,370) - lu(k,274) * lu(k,359) - lu(k,372) = lu(k,372) - lu(k,275) * lu(k,359) - lu(k,373) = lu(k,373) - lu(k,276) * lu(k,359) - lu(k,385) = lu(k,385) - lu(k,265) * lu(k,383) - lu(k,386) = lu(k,386) - lu(k,266) * lu(k,383) - lu(k,388) = - lu(k,267) * lu(k,383) - lu(k,389) = lu(k,389) - lu(k,268) * lu(k,383) - lu(k,390) = lu(k,390) - lu(k,269) * lu(k,383) - lu(k,391) = lu(k,391) - lu(k,270) * lu(k,383) - lu(k,392) = lu(k,392) - lu(k,271) * lu(k,383) - lu(k,393) = lu(k,393) - lu(k,272) * lu(k,383) - lu(k,394) = lu(k,394) - lu(k,273) * lu(k,383) - lu(k,395) = lu(k,395) - lu(k,274) * lu(k,383) - lu(k,397) = lu(k,397) - lu(k,275) * lu(k,383) - lu(k,398) = lu(k,398) - lu(k,276) * lu(k,383) - lu(k,411) = lu(k,411) - lu(k,265) * lu(k,409) - lu(k,412) = lu(k,412) - lu(k,266) * lu(k,409) - lu(k,414) = lu(k,414) - lu(k,267) * lu(k,409) - lu(k,415) = lu(k,415) - lu(k,268) * lu(k,409) - lu(k,416) = lu(k,416) - lu(k,269) * lu(k,409) - lu(k,417) = lu(k,417) - lu(k,270) * lu(k,409) - lu(k,418) = lu(k,418) - lu(k,271) * lu(k,409) - lu(k,419) = lu(k,419) - lu(k,272) * lu(k,409) - lu(k,420) = lu(k,420) - lu(k,273) * lu(k,409) - lu(k,421) = lu(k,421) - lu(k,274) * lu(k,409) - lu(k,423) = lu(k,423) - lu(k,275) * lu(k,409) - lu(k,424) = lu(k,424) - lu(k,276) * lu(k,409) - lu(k,436) = lu(k,436) - lu(k,265) * lu(k,434) - lu(k,437) = lu(k,437) - lu(k,266) * lu(k,434) - lu(k,439) = lu(k,439) - lu(k,267) * lu(k,434) - lu(k,440) = lu(k,440) - lu(k,268) * lu(k,434) - lu(k,441) = lu(k,441) - lu(k,269) * lu(k,434) - lu(k,442) = lu(k,442) - lu(k,270) * lu(k,434) - lu(k,443) = lu(k,443) - lu(k,271) * lu(k,434) - lu(k,444) = lu(k,444) - lu(k,272) * lu(k,434) - lu(k,445) = lu(k,445) - lu(k,273) * lu(k,434) - lu(k,446) = lu(k,446) - lu(k,274) * lu(k,434) - lu(k,448) = lu(k,448) - lu(k,275) * lu(k,434) - lu(k,449) = lu(k,449) - lu(k,276) * lu(k,434) - lu(k,500) = lu(k,500) - lu(k,265) * lu(k,499) - lu(k,501) = lu(k,501) - lu(k,266) * lu(k,499) - lu(k,503) = lu(k,503) - lu(k,267) * lu(k,499) - lu(k,504) = lu(k,504) - lu(k,268) * lu(k,499) - lu(k,505) = lu(k,505) - lu(k,269) * lu(k,499) - lu(k,506) = lu(k,506) - lu(k,270) * lu(k,499) - lu(k,507) = lu(k,507) - lu(k,271) * lu(k,499) - lu(k,508) = lu(k,508) - lu(k,272) * lu(k,499) - lu(k,509) = lu(k,509) - lu(k,273) * lu(k,499) - lu(k,510) = lu(k,510) - lu(k,274) * lu(k,499) - lu(k,512) = lu(k,512) - lu(k,275) * lu(k,499) - lu(k,513) = lu(k,513) - lu(k,276) * lu(k,499) - lu(k,531) = lu(k,531) - lu(k,265) * lu(k,529) - lu(k,532) = lu(k,532) - lu(k,266) * lu(k,529) - lu(k,534) = lu(k,534) - lu(k,267) * lu(k,529) - lu(k,535) = lu(k,535) - lu(k,268) * lu(k,529) - lu(k,536) = lu(k,536) - lu(k,269) * lu(k,529) - lu(k,537) = lu(k,537) - lu(k,270) * lu(k,529) - lu(k,538) = lu(k,538) - lu(k,271) * lu(k,529) - lu(k,539) = lu(k,539) - lu(k,272) * lu(k,529) - lu(k,540) = lu(k,540) - lu(k,273) * lu(k,529) - lu(k,541) = lu(k,541) - lu(k,274) * lu(k,529) - lu(k,543) = lu(k,543) - lu(k,275) * lu(k,529) - lu(k,544) = lu(k,544) - lu(k,276) * lu(k,529) - lu(k,556) = lu(k,556) - lu(k,265) * lu(k,554) - lu(k,557) = lu(k,557) - lu(k,266) * lu(k,554) - lu(k,559) = lu(k,559) - lu(k,267) * lu(k,554) - lu(k,560) = lu(k,560) - lu(k,268) * lu(k,554) - lu(k,561) = lu(k,561) - lu(k,269) * lu(k,554) - lu(k,562) = lu(k,562) - lu(k,270) * lu(k,554) - lu(k,563) = lu(k,563) - lu(k,271) * lu(k,554) - lu(k,564) = lu(k,564) - lu(k,272) * lu(k,554) - lu(k,565) = lu(k,565) - lu(k,273) * lu(k,554) - lu(k,566) = lu(k,566) - lu(k,274) * lu(k,554) - lu(k,568) = lu(k,568) - lu(k,275) * lu(k,554) - lu(k,569) = lu(k,569) - lu(k,276) * lu(k,554) - lu(k,595) = lu(k,595) - lu(k,265) * lu(k,593) - lu(k,596) = lu(k,596) - lu(k,266) * lu(k,593) - lu(k,598) = lu(k,598) - lu(k,267) * lu(k,593) - lu(k,599) = lu(k,599) - lu(k,268) * lu(k,593) - lu(k,600) = lu(k,600) - lu(k,269) * lu(k,593) - lu(k,601) = lu(k,601) - lu(k,270) * lu(k,593) - lu(k,602) = lu(k,602) - lu(k,271) * lu(k,593) - lu(k,603) = lu(k,603) - lu(k,272) * lu(k,593) - lu(k,604) = lu(k,604) - lu(k,273) * lu(k,593) - lu(k,605) = lu(k,605) - lu(k,274) * lu(k,593) - lu(k,607) = lu(k,607) - lu(k,275) * lu(k,593) - lu(k,608) = lu(k,608) - lu(k,276) * lu(k,593) - lu(k,615) = lu(k,615) - lu(k,265) * lu(k,614) - lu(k,616) = lu(k,616) - lu(k,266) * lu(k,614) - lu(k,618) = - lu(k,267) * lu(k,614) - lu(k,619) = lu(k,619) - lu(k,268) * lu(k,614) - lu(k,620) = - lu(k,269) * lu(k,614) - lu(k,621) = lu(k,621) - lu(k,270) * lu(k,614) - lu(k,622) = - lu(k,271) * lu(k,614) - lu(k,623) = lu(k,623) - lu(k,272) * lu(k,614) - lu(k,624) = lu(k,624) - lu(k,273) * lu(k,614) - lu(k,625) = lu(k,625) - lu(k,274) * lu(k,614) - lu(k,627) = lu(k,627) - lu(k,275) * lu(k,614) - lu(k,628) = lu(k,628) - lu(k,276) * lu(k,614) + lu(k,319) = lu(k,319) - lu(k,265) * lu(k,317) + lu(k,321) = lu(k,321) - lu(k,266) * lu(k,317) + lu(k,322) = lu(k,322) - lu(k,267) * lu(k,317) + lu(k,324) = lu(k,324) - lu(k,268) * lu(k,317) + lu(k,325) = lu(k,325) - lu(k,269) * lu(k,317) + lu(k,326) = lu(k,326) - lu(k,270) * lu(k,317) + lu(k,327) = lu(k,327) - lu(k,271) * lu(k,317) + lu(k,328) = lu(k,328) - lu(k,272) * lu(k,317) + lu(k,329) = lu(k,329) - lu(k,273) * lu(k,317) + lu(k,330) = lu(k,330) - lu(k,274) * lu(k,317) + lu(k,331) = lu(k,331) - lu(k,275) * lu(k,317) + lu(k,333) = lu(k,333) - lu(k,276) * lu(k,317) + lu(k,359) = lu(k,359) - lu(k,265) * lu(k,358) + lu(k,361) = - lu(k,266) * lu(k,358) + lu(k,362) = lu(k,362) - lu(k,267) * lu(k,358) + lu(k,364) = lu(k,364) - lu(k,268) * lu(k,358) + lu(k,365) = lu(k,365) - lu(k,269) * lu(k,358) + lu(k,366) = - lu(k,270) * lu(k,358) + lu(k,367) = - lu(k,271) * lu(k,358) + lu(k,368) = lu(k,368) - lu(k,272) * lu(k,358) + lu(k,369) = lu(k,369) - lu(k,273) * lu(k,358) + lu(k,370) = lu(k,370) - lu(k,274) * lu(k,358) + lu(k,371) = lu(k,371) - lu(k,275) * lu(k,358) + lu(k,373) = lu(k,373) - lu(k,276) * lu(k,358) + lu(k,406) = lu(k,406) - lu(k,265) * lu(k,405) + lu(k,408) = lu(k,408) - lu(k,266) * lu(k,405) + lu(k,409) = lu(k,409) - lu(k,267) * lu(k,405) + lu(k,411) = lu(k,411) - lu(k,268) * lu(k,405) + lu(k,412) = lu(k,412) - lu(k,269) * lu(k,405) + lu(k,413) = lu(k,413) - lu(k,270) * lu(k,405) + lu(k,414) = lu(k,414) - lu(k,271) * lu(k,405) + lu(k,415) = lu(k,415) - lu(k,272) * lu(k,405) + lu(k,416) = lu(k,416) - lu(k,273) * lu(k,405) + lu(k,417) = lu(k,417) - lu(k,274) * lu(k,405) + lu(k,418) = lu(k,418) - lu(k,275) * lu(k,405) + lu(k,420) = lu(k,420) - lu(k,276) * lu(k,405) + lu(k,431) = lu(k,431) - lu(k,265) * lu(k,429) + lu(k,433) = lu(k,433) - lu(k,266) * lu(k,429) + lu(k,434) = lu(k,434) - lu(k,267) * lu(k,429) + lu(k,436) = lu(k,436) - lu(k,268) * lu(k,429) + lu(k,437) = lu(k,437) - lu(k,269) * lu(k,429) + lu(k,438) = lu(k,438) - lu(k,270) * lu(k,429) + lu(k,439) = lu(k,439) - lu(k,271) * lu(k,429) + lu(k,440) = lu(k,440) - lu(k,272) * lu(k,429) + lu(k,441) = lu(k,441) - lu(k,273) * lu(k,429) + lu(k,442) = lu(k,442) - lu(k,274) * lu(k,429) + lu(k,443) = lu(k,443) - lu(k,275) * lu(k,429) + lu(k,445) = lu(k,445) - lu(k,276) * lu(k,429) + lu(k,457) = lu(k,457) - lu(k,265) * lu(k,455) + lu(k,459) = lu(k,459) - lu(k,266) * lu(k,455) + lu(k,460) = lu(k,460) - lu(k,267) * lu(k,455) + lu(k,462) = lu(k,462) - lu(k,268) * lu(k,455) + lu(k,463) = lu(k,463) - lu(k,269) * lu(k,455) + lu(k,464) = lu(k,464) - lu(k,270) * lu(k,455) + lu(k,465) = lu(k,465) - lu(k,271) * lu(k,455) + lu(k,466) = lu(k,466) - lu(k,272) * lu(k,455) + lu(k,467) = lu(k,467) - lu(k,273) * lu(k,455) + lu(k,468) = lu(k,468) - lu(k,274) * lu(k,455) + lu(k,469) = lu(k,469) - lu(k,275) * lu(k,455) + lu(k,471) = lu(k,471) - lu(k,276) * lu(k,455) + lu(k,480) = lu(k,480) - lu(k,265) * lu(k,479) + lu(k,482) = lu(k,482) - lu(k,266) * lu(k,479) + lu(k,483) = lu(k,483) - lu(k,267) * lu(k,479) + lu(k,485) = lu(k,485) - lu(k,268) * lu(k,479) + lu(k,486) = lu(k,486) - lu(k,269) * lu(k,479) + lu(k,487) = lu(k,487) - lu(k,270) * lu(k,479) + lu(k,488) = lu(k,488) - lu(k,271) * lu(k,479) + lu(k,489) = lu(k,489) - lu(k,272) * lu(k,479) + lu(k,490) = lu(k,490) - lu(k,273) * lu(k,479) + lu(k,491) = lu(k,491) - lu(k,274) * lu(k,479) + lu(k,492) = lu(k,492) - lu(k,275) * lu(k,479) + lu(k,494) = lu(k,494) - lu(k,276) * lu(k,479) + lu(k,532) = lu(k,532) - lu(k,265) * lu(k,530) + lu(k,534) = lu(k,534) - lu(k,266) * lu(k,530) + lu(k,535) = lu(k,535) - lu(k,267) * lu(k,530) + lu(k,537) = lu(k,537) - lu(k,268) * lu(k,530) + lu(k,538) = lu(k,538) - lu(k,269) * lu(k,530) + lu(k,539) = lu(k,539) - lu(k,270) * lu(k,530) + lu(k,540) = lu(k,540) - lu(k,271) * lu(k,530) + lu(k,541) = lu(k,541) - lu(k,272) * lu(k,530) + lu(k,542) = lu(k,542) - lu(k,273) * lu(k,530) + lu(k,543) = lu(k,543) - lu(k,274) * lu(k,530) + lu(k,544) = lu(k,544) - lu(k,275) * lu(k,530) + lu(k,546) = lu(k,546) - lu(k,276) * lu(k,530) + lu(k,576) = lu(k,576) - lu(k,265) * lu(k,574) + lu(k,578) = lu(k,578) - lu(k,266) * lu(k,574) + lu(k,579) = lu(k,579) - lu(k,267) * lu(k,574) + lu(k,581) = lu(k,581) - lu(k,268) * lu(k,574) + lu(k,582) = lu(k,582) - lu(k,269) * lu(k,574) + lu(k,583) = lu(k,583) - lu(k,270) * lu(k,574) + lu(k,584) = - lu(k,271) * lu(k,574) + lu(k,585) = lu(k,585) - lu(k,272) * lu(k,574) + lu(k,586) = lu(k,586) - lu(k,273) * lu(k,574) + lu(k,587) = lu(k,587) - lu(k,274) * lu(k,574) + lu(k,588) = lu(k,588) - lu(k,275) * lu(k,574) + lu(k,590) = lu(k,590) - lu(k,276) * lu(k,574) + lu(k,633) = lu(k,633) - lu(k,265) * lu(k,631) + lu(k,635) = lu(k,635) - lu(k,266) * lu(k,631) + lu(k,636) = lu(k,636) - lu(k,267) * lu(k,631) + lu(k,638) = lu(k,638) - lu(k,268) * lu(k,631) + lu(k,639) = lu(k,639) - lu(k,269) * lu(k,631) + lu(k,640) = lu(k,640) - lu(k,270) * lu(k,631) + lu(k,641) = lu(k,641) - lu(k,271) * lu(k,631) + lu(k,642) = lu(k,642) - lu(k,272) * lu(k,631) + lu(k,643) = lu(k,643) - lu(k,273) * lu(k,631) + lu(k,644) = lu(k,644) - lu(k,274) * lu(k,631) + lu(k,645) = lu(k,645) - lu(k,275) * lu(k,631) + lu(k,647) = lu(k,647) - lu(k,276) * lu(k,631) end do end subroutine lu_fac06 subroutine lu_fac07( avec_len, lu ) @@ -1484,136 +1484,136 @@ subroutine lu_fac07( avec_len, lu ) lu(k,293) = lu(k,293) * lu(k,282) lu(k,294) = lu(k,294) * lu(k,282) lu(k,295) = lu(k,295) * lu(k,282) - lu(k,315) = lu(k,315) - lu(k,283) * lu(k,314) - lu(k,316) = lu(k,316) - lu(k,284) * lu(k,314) - lu(k,318) = - lu(k,285) * lu(k,314) - lu(k,319) = - lu(k,286) * lu(k,314) - lu(k,320) = - lu(k,287) * lu(k,314) - lu(k,321) = lu(k,321) - lu(k,288) * lu(k,314) - lu(k,322) = - lu(k,289) * lu(k,314) - lu(k,323) = lu(k,323) - lu(k,290) * lu(k,314) - lu(k,324) = lu(k,324) - lu(k,291) * lu(k,314) - lu(k,325) = lu(k,325) - lu(k,292) * lu(k,314) - lu(k,326) = lu(k,326) - lu(k,293) * lu(k,314) - lu(k,327) = lu(k,327) - lu(k,294) * lu(k,314) - lu(k,328) = lu(k,328) - lu(k,295) * lu(k,314) - lu(k,337) = lu(k,337) - lu(k,283) * lu(k,336) - lu(k,338) = lu(k,338) - lu(k,284) * lu(k,336) - lu(k,340) = lu(k,340) - lu(k,285) * lu(k,336) - lu(k,341) = lu(k,341) - lu(k,286) * lu(k,336) - lu(k,342) = lu(k,342) - lu(k,287) * lu(k,336) - lu(k,343) = lu(k,343) - lu(k,288) * lu(k,336) - lu(k,344) = lu(k,344) - lu(k,289) * lu(k,336) - lu(k,345) = lu(k,345) - lu(k,290) * lu(k,336) - lu(k,346) = lu(k,346) - lu(k,291) * lu(k,336) - lu(k,347) = lu(k,347) - lu(k,292) * lu(k,336) - lu(k,348) = lu(k,348) - lu(k,293) * lu(k,336) - lu(k,349) = lu(k,349) - lu(k,294) * lu(k,336) - lu(k,350) = - lu(k,295) * lu(k,336) - lu(k,385) = lu(k,385) - lu(k,283) * lu(k,384) - lu(k,386) = lu(k,386) - lu(k,284) * lu(k,384) - lu(k,388) = lu(k,388) - lu(k,285) * lu(k,384) - lu(k,389) = lu(k,389) - lu(k,286) * lu(k,384) - lu(k,390) = lu(k,390) - lu(k,287) * lu(k,384) - lu(k,391) = lu(k,391) - lu(k,288) * lu(k,384) - lu(k,392) = lu(k,392) - lu(k,289) * lu(k,384) - lu(k,393) = lu(k,393) - lu(k,290) * lu(k,384) - lu(k,394) = lu(k,394) - lu(k,291) * lu(k,384) - lu(k,395) = lu(k,395) - lu(k,292) * lu(k,384) - lu(k,396) = lu(k,396) - lu(k,293) * lu(k,384) - lu(k,397) = lu(k,397) - lu(k,294) * lu(k,384) - lu(k,398) = lu(k,398) - lu(k,295) * lu(k,384) - lu(k,411) = lu(k,411) - lu(k,283) * lu(k,410) - lu(k,412) = lu(k,412) - lu(k,284) * lu(k,410) - lu(k,414) = lu(k,414) - lu(k,285) * lu(k,410) - lu(k,415) = lu(k,415) - lu(k,286) * lu(k,410) - lu(k,416) = lu(k,416) - lu(k,287) * lu(k,410) - lu(k,417) = lu(k,417) - lu(k,288) * lu(k,410) - lu(k,418) = lu(k,418) - lu(k,289) * lu(k,410) - lu(k,419) = lu(k,419) - lu(k,290) * lu(k,410) - lu(k,420) = lu(k,420) - lu(k,291) * lu(k,410) - lu(k,421) = lu(k,421) - lu(k,292) * lu(k,410) - lu(k,422) = lu(k,422) - lu(k,293) * lu(k,410) - lu(k,423) = lu(k,423) - lu(k,294) * lu(k,410) - lu(k,424) = lu(k,424) - lu(k,295) * lu(k,410) - lu(k,436) = lu(k,436) - lu(k,283) * lu(k,435) - lu(k,437) = lu(k,437) - lu(k,284) * lu(k,435) - lu(k,439) = lu(k,439) - lu(k,285) * lu(k,435) - lu(k,440) = lu(k,440) - lu(k,286) * lu(k,435) - lu(k,441) = lu(k,441) - lu(k,287) * lu(k,435) - lu(k,442) = lu(k,442) - lu(k,288) * lu(k,435) - lu(k,443) = lu(k,443) - lu(k,289) * lu(k,435) - lu(k,444) = lu(k,444) - lu(k,290) * lu(k,435) - lu(k,445) = lu(k,445) - lu(k,291) * lu(k,435) - lu(k,446) = lu(k,446) - lu(k,292) * lu(k,435) - lu(k,447) = lu(k,447) - lu(k,293) * lu(k,435) - lu(k,448) = lu(k,448) - lu(k,294) * lu(k,435) - lu(k,449) = lu(k,449) - lu(k,295) * lu(k,435) - lu(k,456) = lu(k,456) - lu(k,283) * lu(k,455) - lu(k,457) = lu(k,457) - lu(k,284) * lu(k,455) - lu(k,459) = lu(k,459) - lu(k,285) * lu(k,455) - lu(k,460) = - lu(k,286) * lu(k,455) - lu(k,461) = - lu(k,287) * lu(k,455) - lu(k,462) = lu(k,462) - lu(k,288) * lu(k,455) - lu(k,463) = lu(k,463) - lu(k,289) * lu(k,455) - lu(k,464) = lu(k,464) - lu(k,290) * lu(k,455) - lu(k,465) = lu(k,465) - lu(k,291) * lu(k,455) - lu(k,466) = lu(k,466) - lu(k,292) * lu(k,455) - lu(k,467) = lu(k,467) - lu(k,293) * lu(k,455) - lu(k,468) = lu(k,468) - lu(k,294) * lu(k,455) - lu(k,469) = lu(k,469) - lu(k,295) * lu(k,455) - lu(k,475) = lu(k,475) - lu(k,283) * lu(k,474) - lu(k,476) = lu(k,476) - lu(k,284) * lu(k,474) - lu(k,478) = - lu(k,285) * lu(k,474) - lu(k,479) = lu(k,479) - lu(k,286) * lu(k,474) - lu(k,480) = lu(k,480) - lu(k,287) * lu(k,474) - lu(k,481) = lu(k,481) - lu(k,288) * lu(k,474) - lu(k,482) = - lu(k,289) * lu(k,474) - lu(k,483) = lu(k,483) - lu(k,290) * lu(k,474) - lu(k,484) = lu(k,484) - lu(k,291) * lu(k,474) - lu(k,485) = lu(k,485) - lu(k,292) * lu(k,474) - lu(k,486) = lu(k,486) - lu(k,293) * lu(k,474) - lu(k,487) = lu(k,487) - lu(k,294) * lu(k,474) - lu(k,488) = lu(k,488) - lu(k,295) * lu(k,474) - lu(k,531) = lu(k,531) - lu(k,283) * lu(k,530) - lu(k,532) = lu(k,532) - lu(k,284) * lu(k,530) - lu(k,534) = lu(k,534) - lu(k,285) * lu(k,530) - lu(k,535) = lu(k,535) - lu(k,286) * lu(k,530) - lu(k,536) = lu(k,536) - lu(k,287) * lu(k,530) - lu(k,537) = lu(k,537) - lu(k,288) * lu(k,530) - lu(k,538) = lu(k,538) - lu(k,289) * lu(k,530) - lu(k,539) = lu(k,539) - lu(k,290) * lu(k,530) - lu(k,540) = lu(k,540) - lu(k,291) * lu(k,530) - lu(k,541) = lu(k,541) - lu(k,292) * lu(k,530) - lu(k,542) = lu(k,542) - lu(k,293) * lu(k,530) - lu(k,543) = lu(k,543) - lu(k,294) * lu(k,530) - lu(k,544) = lu(k,544) - lu(k,295) * lu(k,530) - lu(k,556) = lu(k,556) - lu(k,283) * lu(k,555) - lu(k,557) = lu(k,557) - lu(k,284) * lu(k,555) - lu(k,559) = lu(k,559) - lu(k,285) * lu(k,555) - lu(k,560) = lu(k,560) - lu(k,286) * lu(k,555) - lu(k,561) = lu(k,561) - lu(k,287) * lu(k,555) - lu(k,562) = lu(k,562) - lu(k,288) * lu(k,555) - lu(k,563) = lu(k,563) - lu(k,289) * lu(k,555) - lu(k,564) = lu(k,564) - lu(k,290) * lu(k,555) - lu(k,565) = lu(k,565) - lu(k,291) * lu(k,555) - lu(k,566) = lu(k,566) - lu(k,292) * lu(k,555) - lu(k,567) = lu(k,567) - lu(k,293) * lu(k,555) - lu(k,568) = lu(k,568) - lu(k,294) * lu(k,555) - lu(k,569) = lu(k,569) - lu(k,295) * lu(k,555) - lu(k,595) = lu(k,595) - lu(k,283) * lu(k,594) - lu(k,596) = lu(k,596) - lu(k,284) * lu(k,594) - lu(k,598) = lu(k,598) - lu(k,285) * lu(k,594) - lu(k,599) = lu(k,599) - lu(k,286) * lu(k,594) - lu(k,600) = lu(k,600) - lu(k,287) * lu(k,594) - lu(k,601) = lu(k,601) - lu(k,288) * lu(k,594) - lu(k,602) = lu(k,602) - lu(k,289) * lu(k,594) - lu(k,603) = lu(k,603) - lu(k,290) * lu(k,594) - lu(k,604) = lu(k,604) - lu(k,291) * lu(k,594) - lu(k,605) = lu(k,605) - lu(k,292) * lu(k,594) - lu(k,606) = lu(k,606) - lu(k,293) * lu(k,594) - lu(k,607) = lu(k,607) - lu(k,294) * lu(k,594) - lu(k,608) = lu(k,608) - lu(k,295) * lu(k,594) + lu(k,319) = lu(k,319) - lu(k,283) * lu(k,318) + lu(k,320) = lu(k,320) - lu(k,284) * lu(k,318) + lu(k,321) = lu(k,321) - lu(k,285) * lu(k,318) + lu(k,322) = lu(k,322) - lu(k,286) * lu(k,318) + lu(k,324) = lu(k,324) - lu(k,287) * lu(k,318) + lu(k,325) = lu(k,325) - lu(k,288) * lu(k,318) + lu(k,326) = lu(k,326) - lu(k,289) * lu(k,318) + lu(k,327) = lu(k,327) - lu(k,290) * lu(k,318) + lu(k,328) = lu(k,328) - lu(k,291) * lu(k,318) + lu(k,329) = lu(k,329) - lu(k,292) * lu(k,318) + lu(k,330) = lu(k,330) - lu(k,293) * lu(k,318) + lu(k,331) = lu(k,331) - lu(k,294) * lu(k,318) + lu(k,333) = lu(k,333) - lu(k,295) * lu(k,318) + lu(k,339) = lu(k,339) - lu(k,283) * lu(k,338) + lu(k,340) = lu(k,340) - lu(k,284) * lu(k,338) + lu(k,341) = lu(k,341) - lu(k,285) * lu(k,338) + lu(k,342) = lu(k,342) - lu(k,286) * lu(k,338) + lu(k,344) = lu(k,344) - lu(k,287) * lu(k,338) + lu(k,345) = lu(k,345) - lu(k,288) * lu(k,338) + lu(k,346) = - lu(k,289) * lu(k,338) + lu(k,347) = lu(k,347) - lu(k,290) * lu(k,338) + lu(k,348) = lu(k,348) - lu(k,291) * lu(k,338) + lu(k,349) = lu(k,349) - lu(k,292) * lu(k,338) + lu(k,350) = lu(k,350) - lu(k,293) * lu(k,338) + lu(k,351) = - lu(k,294) * lu(k,338) + lu(k,353) = lu(k,353) - lu(k,295) * lu(k,338) + lu(k,381) = lu(k,381) - lu(k,283) * lu(k,380) + lu(k,382) = lu(k,382) - lu(k,284) * lu(k,380) + lu(k,383) = lu(k,383) - lu(k,285) * lu(k,380) + lu(k,384) = - lu(k,286) * lu(k,380) + lu(k,386) = lu(k,386) - lu(k,287) * lu(k,380) + lu(k,387) = lu(k,387) - lu(k,288) * lu(k,380) + lu(k,388) = lu(k,388) - lu(k,289) * lu(k,380) + lu(k,389) = lu(k,389) - lu(k,290) * lu(k,380) + lu(k,390) = lu(k,390) - lu(k,291) * lu(k,380) + lu(k,391) = lu(k,391) - lu(k,292) * lu(k,380) + lu(k,392) = lu(k,392) - lu(k,293) * lu(k,380) + lu(k,393) = lu(k,393) - lu(k,294) * lu(k,380) + lu(k,395) = lu(k,395) - lu(k,295) * lu(k,380) + lu(k,431) = lu(k,431) - lu(k,283) * lu(k,430) + lu(k,432) = lu(k,432) - lu(k,284) * lu(k,430) + lu(k,433) = lu(k,433) - lu(k,285) * lu(k,430) + lu(k,434) = lu(k,434) - lu(k,286) * lu(k,430) + lu(k,436) = lu(k,436) - lu(k,287) * lu(k,430) + lu(k,437) = lu(k,437) - lu(k,288) * lu(k,430) + lu(k,438) = lu(k,438) - lu(k,289) * lu(k,430) + lu(k,439) = lu(k,439) - lu(k,290) * lu(k,430) + lu(k,440) = lu(k,440) - lu(k,291) * lu(k,430) + lu(k,441) = lu(k,441) - lu(k,292) * lu(k,430) + lu(k,442) = lu(k,442) - lu(k,293) * lu(k,430) + lu(k,443) = lu(k,443) - lu(k,294) * lu(k,430) + lu(k,445) = lu(k,445) - lu(k,295) * lu(k,430) + lu(k,457) = lu(k,457) - lu(k,283) * lu(k,456) + lu(k,458) = lu(k,458) - lu(k,284) * lu(k,456) + lu(k,459) = lu(k,459) - lu(k,285) * lu(k,456) + lu(k,460) = lu(k,460) - lu(k,286) * lu(k,456) + lu(k,462) = lu(k,462) - lu(k,287) * lu(k,456) + lu(k,463) = lu(k,463) - lu(k,288) * lu(k,456) + lu(k,464) = lu(k,464) - lu(k,289) * lu(k,456) + lu(k,465) = lu(k,465) - lu(k,290) * lu(k,456) + lu(k,466) = lu(k,466) - lu(k,291) * lu(k,456) + lu(k,467) = lu(k,467) - lu(k,292) * lu(k,456) + lu(k,468) = lu(k,468) - lu(k,293) * lu(k,456) + lu(k,469) = lu(k,469) - lu(k,294) * lu(k,456) + lu(k,471) = lu(k,471) - lu(k,295) * lu(k,456) + lu(k,501) = lu(k,501) - lu(k,283) * lu(k,500) + lu(k,502) = lu(k,502) - lu(k,284) * lu(k,500) + lu(k,503) = - lu(k,285) * lu(k,500) + lu(k,504) = lu(k,504) - lu(k,286) * lu(k,500) + lu(k,506) = lu(k,506) - lu(k,287) * lu(k,500) + lu(k,507) = lu(k,507) - lu(k,288) * lu(k,500) + lu(k,508) = - lu(k,289) * lu(k,500) + lu(k,509) = - lu(k,290) * lu(k,500) + lu(k,510) = lu(k,510) - lu(k,291) * lu(k,500) + lu(k,511) = lu(k,511) - lu(k,292) * lu(k,500) + lu(k,512) = lu(k,512) - lu(k,293) * lu(k,500) + lu(k,513) = - lu(k,294) * lu(k,500) + lu(k,515) = lu(k,515) - lu(k,295) * lu(k,500) + lu(k,532) = lu(k,532) - lu(k,283) * lu(k,531) + lu(k,533) = lu(k,533) - lu(k,284) * lu(k,531) + lu(k,534) = lu(k,534) - lu(k,285) * lu(k,531) + lu(k,535) = lu(k,535) - lu(k,286) * lu(k,531) + lu(k,537) = lu(k,537) - lu(k,287) * lu(k,531) + lu(k,538) = lu(k,538) - lu(k,288) * lu(k,531) + lu(k,539) = lu(k,539) - lu(k,289) * lu(k,531) + lu(k,540) = lu(k,540) - lu(k,290) * lu(k,531) + lu(k,541) = lu(k,541) - lu(k,291) * lu(k,531) + lu(k,542) = lu(k,542) - lu(k,292) * lu(k,531) + lu(k,543) = lu(k,543) - lu(k,293) * lu(k,531) + lu(k,544) = lu(k,544) - lu(k,294) * lu(k,531) + lu(k,546) = lu(k,546) - lu(k,295) * lu(k,531) + lu(k,551) = lu(k,551) - lu(k,283) * lu(k,550) + lu(k,552) = lu(k,552) - lu(k,284) * lu(k,550) + lu(k,553) = - lu(k,285) * lu(k,550) + lu(k,554) = lu(k,554) - lu(k,286) * lu(k,550) + lu(k,556) = lu(k,556) - lu(k,287) * lu(k,550) + lu(k,557) = lu(k,557) - lu(k,288) * lu(k,550) + lu(k,558) = lu(k,558) - lu(k,289) * lu(k,550) + lu(k,559) = - lu(k,290) * lu(k,550) + lu(k,560) = lu(k,560) - lu(k,291) * lu(k,550) + lu(k,561) = lu(k,561) - lu(k,292) * lu(k,550) + lu(k,562) = lu(k,562) - lu(k,293) * lu(k,550) + lu(k,563) = lu(k,563) - lu(k,294) * lu(k,550) + lu(k,565) = lu(k,565) - lu(k,295) * lu(k,550) + lu(k,576) = lu(k,576) - lu(k,283) * lu(k,575) + lu(k,577) = lu(k,577) - lu(k,284) * lu(k,575) + lu(k,578) = lu(k,578) - lu(k,285) * lu(k,575) + lu(k,579) = lu(k,579) - lu(k,286) * lu(k,575) + lu(k,581) = lu(k,581) - lu(k,287) * lu(k,575) + lu(k,582) = lu(k,582) - lu(k,288) * lu(k,575) + lu(k,583) = lu(k,583) - lu(k,289) * lu(k,575) + lu(k,584) = lu(k,584) - lu(k,290) * lu(k,575) + lu(k,585) = lu(k,585) - lu(k,291) * lu(k,575) + lu(k,586) = lu(k,586) - lu(k,292) * lu(k,575) + lu(k,587) = lu(k,587) - lu(k,293) * lu(k,575) + lu(k,588) = lu(k,588) - lu(k,294) * lu(k,575) + lu(k,590) = lu(k,590) - lu(k,295) * lu(k,575) + lu(k,633) = lu(k,633) - lu(k,283) * lu(k,632) + lu(k,634) = lu(k,634) - lu(k,284) * lu(k,632) + lu(k,635) = lu(k,635) - lu(k,285) * lu(k,632) + lu(k,636) = lu(k,636) - lu(k,286) * lu(k,632) + lu(k,638) = lu(k,638) - lu(k,287) * lu(k,632) + lu(k,639) = lu(k,639) - lu(k,288) * lu(k,632) + lu(k,640) = lu(k,640) - lu(k,289) * lu(k,632) + lu(k,641) = lu(k,641) - lu(k,290) * lu(k,632) + lu(k,642) = lu(k,642) - lu(k,291) * lu(k,632) + lu(k,643) = lu(k,643) - lu(k,292) * lu(k,632) + lu(k,644) = lu(k,644) - lu(k,293) * lu(k,632) + lu(k,645) = lu(k,645) - lu(k,294) * lu(k,632) + lu(k,647) = lu(k,647) - lu(k,295) * lu(k,632) lu(k,298) = 1._r8 / lu(k,298) lu(k,299) = lu(k,299) * lu(k,298) lu(k,300) = lu(k,300) * lu(k,298) @@ -1625,329 +1625,329 @@ subroutine lu_fac07( avec_len, lu ) lu(k,306) = lu(k,306) * lu(k,298) lu(k,307) = lu(k,307) * lu(k,298) lu(k,308) = lu(k,308) * lu(k,298) - lu(k,316) = lu(k,316) - lu(k,299) * lu(k,315) - lu(k,317) = lu(k,317) - lu(k,300) * lu(k,315) - lu(k,321) = lu(k,321) - lu(k,301) * lu(k,315) - lu(k,323) = lu(k,323) - lu(k,302) * lu(k,315) - lu(k,324) = lu(k,324) - lu(k,303) * lu(k,315) - lu(k,325) = lu(k,325) - lu(k,304) * lu(k,315) - lu(k,326) = lu(k,326) - lu(k,305) * lu(k,315) - lu(k,327) = lu(k,327) - lu(k,306) * lu(k,315) - lu(k,328) = lu(k,328) - lu(k,307) * lu(k,315) - lu(k,329) = lu(k,329) - lu(k,308) * lu(k,315) - lu(k,338) = lu(k,338) - lu(k,299) * lu(k,337) - lu(k,339) = lu(k,339) - lu(k,300) * lu(k,337) - lu(k,343) = lu(k,343) - lu(k,301) * lu(k,337) - lu(k,345) = lu(k,345) - lu(k,302) * lu(k,337) - lu(k,346) = lu(k,346) - lu(k,303) * lu(k,337) - lu(k,347) = lu(k,347) - lu(k,304) * lu(k,337) - lu(k,348) = lu(k,348) - lu(k,305) * lu(k,337) - lu(k,349) = lu(k,349) - lu(k,306) * lu(k,337) - lu(k,350) = lu(k,350) - lu(k,307) * lu(k,337) - lu(k,351) = lu(k,351) - lu(k,308) * lu(k,337) - lu(k,361) = lu(k,361) - lu(k,299) * lu(k,360) - lu(k,362) = lu(k,362) - lu(k,300) * lu(k,360) - lu(k,366) = lu(k,366) - lu(k,301) * lu(k,360) - lu(k,368) = lu(k,368) - lu(k,302) * lu(k,360) - lu(k,369) = lu(k,369) - lu(k,303) * lu(k,360) - lu(k,370) = lu(k,370) - lu(k,304) * lu(k,360) - lu(k,371) = lu(k,371) - lu(k,305) * lu(k,360) - lu(k,372) = lu(k,372) - lu(k,306) * lu(k,360) - lu(k,373) = lu(k,373) - lu(k,307) * lu(k,360) - lu(k,374) = lu(k,374) - lu(k,308) * lu(k,360) - lu(k,386) = lu(k,386) - lu(k,299) * lu(k,385) - lu(k,387) = lu(k,387) - lu(k,300) * lu(k,385) - lu(k,391) = lu(k,391) - lu(k,301) * lu(k,385) - lu(k,393) = lu(k,393) - lu(k,302) * lu(k,385) - lu(k,394) = lu(k,394) - lu(k,303) * lu(k,385) - lu(k,395) = lu(k,395) - lu(k,304) * lu(k,385) - lu(k,396) = lu(k,396) - lu(k,305) * lu(k,385) - lu(k,397) = lu(k,397) - lu(k,306) * lu(k,385) - lu(k,398) = lu(k,398) - lu(k,307) * lu(k,385) - lu(k,399) = lu(k,399) - lu(k,308) * lu(k,385) - lu(k,412) = lu(k,412) - lu(k,299) * lu(k,411) - lu(k,413) = lu(k,413) - lu(k,300) * lu(k,411) - lu(k,417) = lu(k,417) - lu(k,301) * lu(k,411) - lu(k,419) = lu(k,419) - lu(k,302) * lu(k,411) - lu(k,420) = lu(k,420) - lu(k,303) * lu(k,411) - lu(k,421) = lu(k,421) - lu(k,304) * lu(k,411) - lu(k,422) = lu(k,422) - lu(k,305) * lu(k,411) - lu(k,423) = lu(k,423) - lu(k,306) * lu(k,411) - lu(k,424) = lu(k,424) - lu(k,307) * lu(k,411) - lu(k,425) = lu(k,425) - lu(k,308) * lu(k,411) - lu(k,437) = lu(k,437) - lu(k,299) * lu(k,436) - lu(k,438) = lu(k,438) - lu(k,300) * lu(k,436) - lu(k,442) = lu(k,442) - lu(k,301) * lu(k,436) - lu(k,444) = lu(k,444) - lu(k,302) * lu(k,436) - lu(k,445) = lu(k,445) - lu(k,303) * lu(k,436) - lu(k,446) = lu(k,446) - lu(k,304) * lu(k,436) - lu(k,447) = lu(k,447) - lu(k,305) * lu(k,436) - lu(k,448) = lu(k,448) - lu(k,306) * lu(k,436) - lu(k,449) = lu(k,449) - lu(k,307) * lu(k,436) - lu(k,450) = lu(k,450) - lu(k,308) * lu(k,436) - lu(k,457) = lu(k,457) - lu(k,299) * lu(k,456) - lu(k,458) = lu(k,458) - lu(k,300) * lu(k,456) - lu(k,462) = lu(k,462) - lu(k,301) * lu(k,456) - lu(k,464) = lu(k,464) - lu(k,302) * lu(k,456) - lu(k,465) = lu(k,465) - lu(k,303) * lu(k,456) - lu(k,466) = lu(k,466) - lu(k,304) * lu(k,456) - lu(k,467) = lu(k,467) - lu(k,305) * lu(k,456) - lu(k,468) = lu(k,468) - lu(k,306) * lu(k,456) - lu(k,469) = lu(k,469) - lu(k,307) * lu(k,456) - lu(k,470) = lu(k,470) - lu(k,308) * lu(k,456) - lu(k,476) = lu(k,476) - lu(k,299) * lu(k,475) - lu(k,477) = lu(k,477) - lu(k,300) * lu(k,475) - lu(k,481) = lu(k,481) - lu(k,301) * lu(k,475) - lu(k,483) = lu(k,483) - lu(k,302) * lu(k,475) - lu(k,484) = lu(k,484) - lu(k,303) * lu(k,475) - lu(k,485) = lu(k,485) - lu(k,304) * lu(k,475) - lu(k,486) = lu(k,486) - lu(k,305) * lu(k,475) - lu(k,487) = lu(k,487) - lu(k,306) * lu(k,475) - lu(k,488) = lu(k,488) - lu(k,307) * lu(k,475) - lu(k,489) = lu(k,489) - lu(k,308) * lu(k,475) - lu(k,501) = lu(k,501) - lu(k,299) * lu(k,500) - lu(k,502) = lu(k,502) - lu(k,300) * lu(k,500) - lu(k,506) = lu(k,506) - lu(k,301) * lu(k,500) - lu(k,508) = lu(k,508) - lu(k,302) * lu(k,500) - lu(k,509) = lu(k,509) - lu(k,303) * lu(k,500) - lu(k,510) = lu(k,510) - lu(k,304) * lu(k,500) - lu(k,511) = lu(k,511) - lu(k,305) * lu(k,500) - lu(k,512) = lu(k,512) - lu(k,306) * lu(k,500) - lu(k,513) = lu(k,513) - lu(k,307) * lu(k,500) - lu(k,514) = lu(k,514) - lu(k,308) * lu(k,500) - lu(k,532) = lu(k,532) - lu(k,299) * lu(k,531) - lu(k,533) = lu(k,533) - lu(k,300) * lu(k,531) - lu(k,537) = lu(k,537) - lu(k,301) * lu(k,531) - lu(k,539) = lu(k,539) - lu(k,302) * lu(k,531) - lu(k,540) = lu(k,540) - lu(k,303) * lu(k,531) - lu(k,541) = lu(k,541) - lu(k,304) * lu(k,531) - lu(k,542) = lu(k,542) - lu(k,305) * lu(k,531) - lu(k,543) = lu(k,543) - lu(k,306) * lu(k,531) - lu(k,544) = lu(k,544) - lu(k,307) * lu(k,531) - lu(k,545) = lu(k,545) - lu(k,308) * lu(k,531) - lu(k,557) = lu(k,557) - lu(k,299) * lu(k,556) - lu(k,558) = lu(k,558) - lu(k,300) * lu(k,556) - lu(k,562) = lu(k,562) - lu(k,301) * lu(k,556) - lu(k,564) = lu(k,564) - lu(k,302) * lu(k,556) - lu(k,565) = lu(k,565) - lu(k,303) * lu(k,556) - lu(k,566) = lu(k,566) - lu(k,304) * lu(k,556) - lu(k,567) = lu(k,567) - lu(k,305) * lu(k,556) - lu(k,568) = lu(k,568) - lu(k,306) * lu(k,556) - lu(k,569) = lu(k,569) - lu(k,307) * lu(k,556) - lu(k,570) = lu(k,570) - lu(k,308) * lu(k,556) - lu(k,596) = lu(k,596) - lu(k,299) * lu(k,595) - lu(k,597) = lu(k,597) - lu(k,300) * lu(k,595) - lu(k,601) = lu(k,601) - lu(k,301) * lu(k,595) - lu(k,603) = lu(k,603) - lu(k,302) * lu(k,595) - lu(k,604) = lu(k,604) - lu(k,303) * lu(k,595) - lu(k,605) = lu(k,605) - lu(k,304) * lu(k,595) - lu(k,606) = lu(k,606) - lu(k,305) * lu(k,595) - lu(k,607) = lu(k,607) - lu(k,306) * lu(k,595) - lu(k,608) = lu(k,608) - lu(k,307) * lu(k,595) - lu(k,609) = lu(k,609) - lu(k,308) * lu(k,595) - lu(k,616) = lu(k,616) - lu(k,299) * lu(k,615) - lu(k,617) = - lu(k,300) * lu(k,615) - lu(k,621) = lu(k,621) - lu(k,301) * lu(k,615) - lu(k,623) = lu(k,623) - lu(k,302) * lu(k,615) - lu(k,624) = lu(k,624) - lu(k,303) * lu(k,615) - lu(k,625) = lu(k,625) - lu(k,304) * lu(k,615) - lu(k,626) = - lu(k,305) * lu(k,615) - lu(k,627) = lu(k,627) - lu(k,306) * lu(k,615) - lu(k,628) = lu(k,628) - lu(k,307) * lu(k,615) - lu(k,629) = - lu(k,308) * lu(k,615) + lu(k,320) = lu(k,320) - lu(k,299) * lu(k,319) + lu(k,322) = lu(k,322) - lu(k,300) * lu(k,319) + lu(k,323) = lu(k,323) - lu(k,301) * lu(k,319) + lu(k,324) = lu(k,324) - lu(k,302) * lu(k,319) + lu(k,325) = lu(k,325) - lu(k,303) * lu(k,319) + lu(k,328) = lu(k,328) - lu(k,304) * lu(k,319) + lu(k,329) = lu(k,329) - lu(k,305) * lu(k,319) + lu(k,330) = lu(k,330) - lu(k,306) * lu(k,319) + lu(k,332) = lu(k,332) - lu(k,307) * lu(k,319) + lu(k,333) = lu(k,333) - lu(k,308) * lu(k,319) + lu(k,340) = lu(k,340) - lu(k,299) * lu(k,339) + lu(k,342) = lu(k,342) - lu(k,300) * lu(k,339) + lu(k,343) = lu(k,343) - lu(k,301) * lu(k,339) + lu(k,344) = lu(k,344) - lu(k,302) * lu(k,339) + lu(k,345) = lu(k,345) - lu(k,303) * lu(k,339) + lu(k,348) = lu(k,348) - lu(k,304) * lu(k,339) + lu(k,349) = lu(k,349) - lu(k,305) * lu(k,339) + lu(k,350) = lu(k,350) - lu(k,306) * lu(k,339) + lu(k,352) = lu(k,352) - lu(k,307) * lu(k,339) + lu(k,353) = lu(k,353) - lu(k,308) * lu(k,339) + lu(k,360) = - lu(k,299) * lu(k,359) + lu(k,362) = lu(k,362) - lu(k,300) * lu(k,359) + lu(k,363) = - lu(k,301) * lu(k,359) + lu(k,364) = lu(k,364) - lu(k,302) * lu(k,359) + lu(k,365) = lu(k,365) - lu(k,303) * lu(k,359) + lu(k,368) = lu(k,368) - lu(k,304) * lu(k,359) + lu(k,369) = lu(k,369) - lu(k,305) * lu(k,359) + lu(k,370) = lu(k,370) - lu(k,306) * lu(k,359) + lu(k,372) = - lu(k,307) * lu(k,359) + lu(k,373) = lu(k,373) - lu(k,308) * lu(k,359) + lu(k,382) = lu(k,382) - lu(k,299) * lu(k,381) + lu(k,384) = lu(k,384) - lu(k,300) * lu(k,381) + lu(k,385) = lu(k,385) - lu(k,301) * lu(k,381) + lu(k,386) = lu(k,386) - lu(k,302) * lu(k,381) + lu(k,387) = lu(k,387) - lu(k,303) * lu(k,381) + lu(k,390) = lu(k,390) - lu(k,304) * lu(k,381) + lu(k,391) = lu(k,391) - lu(k,305) * lu(k,381) + lu(k,392) = lu(k,392) - lu(k,306) * lu(k,381) + lu(k,394) = lu(k,394) - lu(k,307) * lu(k,381) + lu(k,395) = lu(k,395) - lu(k,308) * lu(k,381) + lu(k,407) = lu(k,407) - lu(k,299) * lu(k,406) + lu(k,409) = lu(k,409) - lu(k,300) * lu(k,406) + lu(k,410) = lu(k,410) - lu(k,301) * lu(k,406) + lu(k,411) = lu(k,411) - lu(k,302) * lu(k,406) + lu(k,412) = lu(k,412) - lu(k,303) * lu(k,406) + lu(k,415) = lu(k,415) - lu(k,304) * lu(k,406) + lu(k,416) = lu(k,416) - lu(k,305) * lu(k,406) + lu(k,417) = lu(k,417) - lu(k,306) * lu(k,406) + lu(k,419) = lu(k,419) - lu(k,307) * lu(k,406) + lu(k,420) = lu(k,420) - lu(k,308) * lu(k,406) + lu(k,432) = lu(k,432) - lu(k,299) * lu(k,431) + lu(k,434) = lu(k,434) - lu(k,300) * lu(k,431) + lu(k,435) = lu(k,435) - lu(k,301) * lu(k,431) + lu(k,436) = lu(k,436) - lu(k,302) * lu(k,431) + lu(k,437) = lu(k,437) - lu(k,303) * lu(k,431) + lu(k,440) = lu(k,440) - lu(k,304) * lu(k,431) + lu(k,441) = lu(k,441) - lu(k,305) * lu(k,431) + lu(k,442) = lu(k,442) - lu(k,306) * lu(k,431) + lu(k,444) = lu(k,444) - lu(k,307) * lu(k,431) + lu(k,445) = lu(k,445) - lu(k,308) * lu(k,431) + lu(k,458) = lu(k,458) - lu(k,299) * lu(k,457) + lu(k,460) = lu(k,460) - lu(k,300) * lu(k,457) + lu(k,461) = lu(k,461) - lu(k,301) * lu(k,457) + lu(k,462) = lu(k,462) - lu(k,302) * lu(k,457) + lu(k,463) = lu(k,463) - lu(k,303) * lu(k,457) + lu(k,466) = lu(k,466) - lu(k,304) * lu(k,457) + lu(k,467) = lu(k,467) - lu(k,305) * lu(k,457) + lu(k,468) = lu(k,468) - lu(k,306) * lu(k,457) + lu(k,470) = lu(k,470) - lu(k,307) * lu(k,457) + lu(k,471) = lu(k,471) - lu(k,308) * lu(k,457) + lu(k,481) = lu(k,481) - lu(k,299) * lu(k,480) + lu(k,483) = lu(k,483) - lu(k,300) * lu(k,480) + lu(k,484) = lu(k,484) - lu(k,301) * lu(k,480) + lu(k,485) = lu(k,485) - lu(k,302) * lu(k,480) + lu(k,486) = lu(k,486) - lu(k,303) * lu(k,480) + lu(k,489) = lu(k,489) - lu(k,304) * lu(k,480) + lu(k,490) = lu(k,490) - lu(k,305) * lu(k,480) + lu(k,491) = lu(k,491) - lu(k,306) * lu(k,480) + lu(k,493) = lu(k,493) - lu(k,307) * lu(k,480) + lu(k,494) = lu(k,494) - lu(k,308) * lu(k,480) + lu(k,502) = lu(k,502) - lu(k,299) * lu(k,501) + lu(k,504) = lu(k,504) - lu(k,300) * lu(k,501) + lu(k,505) = lu(k,505) - lu(k,301) * lu(k,501) + lu(k,506) = lu(k,506) - lu(k,302) * lu(k,501) + lu(k,507) = lu(k,507) - lu(k,303) * lu(k,501) + lu(k,510) = lu(k,510) - lu(k,304) * lu(k,501) + lu(k,511) = lu(k,511) - lu(k,305) * lu(k,501) + lu(k,512) = lu(k,512) - lu(k,306) * lu(k,501) + lu(k,514) = lu(k,514) - lu(k,307) * lu(k,501) + lu(k,515) = lu(k,515) - lu(k,308) * lu(k,501) + lu(k,533) = lu(k,533) - lu(k,299) * lu(k,532) + lu(k,535) = lu(k,535) - lu(k,300) * lu(k,532) + lu(k,536) = lu(k,536) - lu(k,301) * lu(k,532) + lu(k,537) = lu(k,537) - lu(k,302) * lu(k,532) + lu(k,538) = lu(k,538) - lu(k,303) * lu(k,532) + lu(k,541) = lu(k,541) - lu(k,304) * lu(k,532) + lu(k,542) = lu(k,542) - lu(k,305) * lu(k,532) + lu(k,543) = lu(k,543) - lu(k,306) * lu(k,532) + lu(k,545) = lu(k,545) - lu(k,307) * lu(k,532) + lu(k,546) = lu(k,546) - lu(k,308) * lu(k,532) + lu(k,552) = lu(k,552) - lu(k,299) * lu(k,551) + lu(k,554) = lu(k,554) - lu(k,300) * lu(k,551) + lu(k,555) = lu(k,555) - lu(k,301) * lu(k,551) + lu(k,556) = lu(k,556) - lu(k,302) * lu(k,551) + lu(k,557) = lu(k,557) - lu(k,303) * lu(k,551) + lu(k,560) = lu(k,560) - lu(k,304) * lu(k,551) + lu(k,561) = lu(k,561) - lu(k,305) * lu(k,551) + lu(k,562) = lu(k,562) - lu(k,306) * lu(k,551) + lu(k,564) = lu(k,564) - lu(k,307) * lu(k,551) + lu(k,565) = lu(k,565) - lu(k,308) * lu(k,551) + lu(k,577) = lu(k,577) - lu(k,299) * lu(k,576) + lu(k,579) = lu(k,579) - lu(k,300) * lu(k,576) + lu(k,580) = lu(k,580) - lu(k,301) * lu(k,576) + lu(k,581) = lu(k,581) - lu(k,302) * lu(k,576) + lu(k,582) = lu(k,582) - lu(k,303) * lu(k,576) + lu(k,585) = lu(k,585) - lu(k,304) * lu(k,576) + lu(k,586) = lu(k,586) - lu(k,305) * lu(k,576) + lu(k,587) = lu(k,587) - lu(k,306) * lu(k,576) + lu(k,589) = lu(k,589) - lu(k,307) * lu(k,576) + lu(k,590) = lu(k,590) - lu(k,308) * lu(k,576) + lu(k,595) = lu(k,595) - lu(k,299) * lu(k,594) + lu(k,597) = - lu(k,300) * lu(k,594) + lu(k,598) = lu(k,598) - lu(k,301) * lu(k,594) + lu(k,599) = lu(k,599) - lu(k,302) * lu(k,594) + lu(k,600) = lu(k,600) - lu(k,303) * lu(k,594) + lu(k,603) = lu(k,603) - lu(k,304) * lu(k,594) + lu(k,604) = lu(k,604) - lu(k,305) * lu(k,594) + lu(k,605) = - lu(k,306) * lu(k,594) + lu(k,607) = lu(k,607) - lu(k,307) * lu(k,594) + lu(k,608) = lu(k,608) - lu(k,308) * lu(k,594) lu(k,634) = lu(k,634) - lu(k,299) * lu(k,633) - lu(k,635) = lu(k,635) - lu(k,300) * lu(k,633) - lu(k,639) = lu(k,639) - lu(k,301) * lu(k,633) - lu(k,641) = - lu(k,302) * lu(k,633) - lu(k,642) = lu(k,642) - lu(k,303) * lu(k,633) - lu(k,643) = lu(k,643) - lu(k,304) * lu(k,633) - lu(k,644) = lu(k,644) - lu(k,305) * lu(k,633) - lu(k,645) = lu(k,645) - lu(k,306) * lu(k,633) - lu(k,646) = - lu(k,307) * lu(k,633) + lu(k,636) = lu(k,636) - lu(k,300) * lu(k,633) + lu(k,637) = lu(k,637) - lu(k,301) * lu(k,633) + lu(k,638) = lu(k,638) - lu(k,302) * lu(k,633) + lu(k,639) = lu(k,639) - lu(k,303) * lu(k,633) + lu(k,642) = lu(k,642) - lu(k,304) * lu(k,633) + lu(k,643) = lu(k,643) - lu(k,305) * lu(k,633) + lu(k,644) = lu(k,644) - lu(k,306) * lu(k,633) + lu(k,646) = lu(k,646) - lu(k,307) * lu(k,633) lu(k,647) = lu(k,647) - lu(k,308) * lu(k,633) - lu(k,316) = 1._r8 / lu(k,316) - lu(k,317) = lu(k,317) * lu(k,316) - lu(k,318) = lu(k,318) * lu(k,316) - lu(k,319) = lu(k,319) * lu(k,316) - lu(k,320) = lu(k,320) * lu(k,316) - lu(k,321) = lu(k,321) * lu(k,316) - lu(k,322) = lu(k,322) * lu(k,316) - lu(k,323) = lu(k,323) * lu(k,316) - lu(k,324) = lu(k,324) * lu(k,316) - lu(k,325) = lu(k,325) * lu(k,316) - lu(k,326) = lu(k,326) * lu(k,316) - lu(k,327) = lu(k,327) * lu(k,316) - lu(k,328) = lu(k,328) * lu(k,316) - lu(k,329) = lu(k,329) * lu(k,316) - lu(k,339) = lu(k,339) - lu(k,317) * lu(k,338) - lu(k,340) = lu(k,340) - lu(k,318) * lu(k,338) - lu(k,341) = lu(k,341) - lu(k,319) * lu(k,338) - lu(k,342) = lu(k,342) - lu(k,320) * lu(k,338) - lu(k,343) = lu(k,343) - lu(k,321) * lu(k,338) - lu(k,344) = lu(k,344) - lu(k,322) * lu(k,338) - lu(k,345) = lu(k,345) - lu(k,323) * lu(k,338) - lu(k,346) = lu(k,346) - lu(k,324) * lu(k,338) - lu(k,347) = lu(k,347) - lu(k,325) * lu(k,338) - lu(k,348) = lu(k,348) - lu(k,326) * lu(k,338) - lu(k,349) = lu(k,349) - lu(k,327) * lu(k,338) - lu(k,350) = lu(k,350) - lu(k,328) * lu(k,338) - lu(k,351) = lu(k,351) - lu(k,329) * lu(k,338) - lu(k,362) = lu(k,362) - lu(k,317) * lu(k,361) - lu(k,363) = lu(k,363) - lu(k,318) * lu(k,361) - lu(k,364) = lu(k,364) - lu(k,319) * lu(k,361) - lu(k,365) = lu(k,365) - lu(k,320) * lu(k,361) - lu(k,366) = lu(k,366) - lu(k,321) * lu(k,361) - lu(k,367) = lu(k,367) - lu(k,322) * lu(k,361) - lu(k,368) = lu(k,368) - lu(k,323) * lu(k,361) - lu(k,369) = lu(k,369) - lu(k,324) * lu(k,361) - lu(k,370) = lu(k,370) - lu(k,325) * lu(k,361) - lu(k,371) = lu(k,371) - lu(k,326) * lu(k,361) - lu(k,372) = lu(k,372) - lu(k,327) * lu(k,361) - lu(k,373) = lu(k,373) - lu(k,328) * lu(k,361) - lu(k,374) = lu(k,374) - lu(k,329) * lu(k,361) - lu(k,387) = lu(k,387) - lu(k,317) * lu(k,386) - lu(k,388) = lu(k,388) - lu(k,318) * lu(k,386) - lu(k,389) = lu(k,389) - lu(k,319) * lu(k,386) - lu(k,390) = lu(k,390) - lu(k,320) * lu(k,386) - lu(k,391) = lu(k,391) - lu(k,321) * lu(k,386) - lu(k,392) = lu(k,392) - lu(k,322) * lu(k,386) - lu(k,393) = lu(k,393) - lu(k,323) * lu(k,386) - lu(k,394) = lu(k,394) - lu(k,324) * lu(k,386) - lu(k,395) = lu(k,395) - lu(k,325) * lu(k,386) - lu(k,396) = lu(k,396) - lu(k,326) * lu(k,386) - lu(k,397) = lu(k,397) - lu(k,327) * lu(k,386) - lu(k,398) = lu(k,398) - lu(k,328) * lu(k,386) - lu(k,399) = lu(k,399) - lu(k,329) * lu(k,386) - lu(k,413) = lu(k,413) - lu(k,317) * lu(k,412) - lu(k,414) = lu(k,414) - lu(k,318) * lu(k,412) - lu(k,415) = lu(k,415) - lu(k,319) * lu(k,412) - lu(k,416) = lu(k,416) - lu(k,320) * lu(k,412) - lu(k,417) = lu(k,417) - lu(k,321) * lu(k,412) - lu(k,418) = lu(k,418) - lu(k,322) * lu(k,412) - lu(k,419) = lu(k,419) - lu(k,323) * lu(k,412) - lu(k,420) = lu(k,420) - lu(k,324) * lu(k,412) - lu(k,421) = lu(k,421) - lu(k,325) * lu(k,412) - lu(k,422) = lu(k,422) - lu(k,326) * lu(k,412) - lu(k,423) = lu(k,423) - lu(k,327) * lu(k,412) - lu(k,424) = lu(k,424) - lu(k,328) * lu(k,412) - lu(k,425) = lu(k,425) - lu(k,329) * lu(k,412) - lu(k,438) = lu(k,438) - lu(k,317) * lu(k,437) - lu(k,439) = lu(k,439) - lu(k,318) * lu(k,437) - lu(k,440) = lu(k,440) - lu(k,319) * lu(k,437) - lu(k,441) = lu(k,441) - lu(k,320) * lu(k,437) - lu(k,442) = lu(k,442) - lu(k,321) * lu(k,437) - lu(k,443) = lu(k,443) - lu(k,322) * lu(k,437) - lu(k,444) = lu(k,444) - lu(k,323) * lu(k,437) - lu(k,445) = lu(k,445) - lu(k,324) * lu(k,437) - lu(k,446) = lu(k,446) - lu(k,325) * lu(k,437) - lu(k,447) = lu(k,447) - lu(k,326) * lu(k,437) - lu(k,448) = lu(k,448) - lu(k,327) * lu(k,437) - lu(k,449) = lu(k,449) - lu(k,328) * lu(k,437) - lu(k,450) = lu(k,450) - lu(k,329) * lu(k,437) - lu(k,458) = lu(k,458) - lu(k,317) * lu(k,457) - lu(k,459) = lu(k,459) - lu(k,318) * lu(k,457) - lu(k,460) = lu(k,460) - lu(k,319) * lu(k,457) - lu(k,461) = lu(k,461) - lu(k,320) * lu(k,457) - lu(k,462) = lu(k,462) - lu(k,321) * lu(k,457) - lu(k,463) = lu(k,463) - lu(k,322) * lu(k,457) - lu(k,464) = lu(k,464) - lu(k,323) * lu(k,457) - lu(k,465) = lu(k,465) - lu(k,324) * lu(k,457) - lu(k,466) = lu(k,466) - lu(k,325) * lu(k,457) - lu(k,467) = lu(k,467) - lu(k,326) * lu(k,457) - lu(k,468) = lu(k,468) - lu(k,327) * lu(k,457) - lu(k,469) = lu(k,469) - lu(k,328) * lu(k,457) - lu(k,470) = lu(k,470) - lu(k,329) * lu(k,457) - lu(k,477) = lu(k,477) - lu(k,317) * lu(k,476) - lu(k,478) = lu(k,478) - lu(k,318) * lu(k,476) - lu(k,479) = lu(k,479) - lu(k,319) * lu(k,476) - lu(k,480) = lu(k,480) - lu(k,320) * lu(k,476) - lu(k,481) = lu(k,481) - lu(k,321) * lu(k,476) - lu(k,482) = lu(k,482) - lu(k,322) * lu(k,476) - lu(k,483) = lu(k,483) - lu(k,323) * lu(k,476) - lu(k,484) = lu(k,484) - lu(k,324) * lu(k,476) - lu(k,485) = lu(k,485) - lu(k,325) * lu(k,476) - lu(k,486) = lu(k,486) - lu(k,326) * lu(k,476) - lu(k,487) = lu(k,487) - lu(k,327) * lu(k,476) - lu(k,488) = lu(k,488) - lu(k,328) * lu(k,476) - lu(k,489) = lu(k,489) - lu(k,329) * lu(k,476) - lu(k,502) = lu(k,502) - lu(k,317) * lu(k,501) - lu(k,503) = lu(k,503) - lu(k,318) * lu(k,501) - lu(k,504) = lu(k,504) - lu(k,319) * lu(k,501) - lu(k,505) = lu(k,505) - lu(k,320) * lu(k,501) - lu(k,506) = lu(k,506) - lu(k,321) * lu(k,501) - lu(k,507) = lu(k,507) - lu(k,322) * lu(k,501) - lu(k,508) = lu(k,508) - lu(k,323) * lu(k,501) - lu(k,509) = lu(k,509) - lu(k,324) * lu(k,501) - lu(k,510) = lu(k,510) - lu(k,325) * lu(k,501) - lu(k,511) = lu(k,511) - lu(k,326) * lu(k,501) - lu(k,512) = lu(k,512) - lu(k,327) * lu(k,501) - lu(k,513) = lu(k,513) - lu(k,328) * lu(k,501) - lu(k,514) = lu(k,514) - lu(k,329) * lu(k,501) - lu(k,533) = lu(k,533) - lu(k,317) * lu(k,532) - lu(k,534) = lu(k,534) - lu(k,318) * lu(k,532) - lu(k,535) = lu(k,535) - lu(k,319) * lu(k,532) - lu(k,536) = lu(k,536) - lu(k,320) * lu(k,532) - lu(k,537) = lu(k,537) - lu(k,321) * lu(k,532) - lu(k,538) = lu(k,538) - lu(k,322) * lu(k,532) - lu(k,539) = lu(k,539) - lu(k,323) * lu(k,532) - lu(k,540) = lu(k,540) - lu(k,324) * lu(k,532) - lu(k,541) = lu(k,541) - lu(k,325) * lu(k,532) - lu(k,542) = lu(k,542) - lu(k,326) * lu(k,532) - lu(k,543) = lu(k,543) - lu(k,327) * lu(k,532) - lu(k,544) = lu(k,544) - lu(k,328) * lu(k,532) - lu(k,545) = lu(k,545) - lu(k,329) * lu(k,532) - lu(k,558) = lu(k,558) - lu(k,317) * lu(k,557) - lu(k,559) = lu(k,559) - lu(k,318) * lu(k,557) - lu(k,560) = lu(k,560) - lu(k,319) * lu(k,557) - lu(k,561) = lu(k,561) - lu(k,320) * lu(k,557) - lu(k,562) = lu(k,562) - lu(k,321) * lu(k,557) - lu(k,563) = lu(k,563) - lu(k,322) * lu(k,557) - lu(k,564) = lu(k,564) - lu(k,323) * lu(k,557) - lu(k,565) = lu(k,565) - lu(k,324) * lu(k,557) - lu(k,566) = lu(k,566) - lu(k,325) * lu(k,557) - lu(k,567) = lu(k,567) - lu(k,326) * lu(k,557) - lu(k,568) = lu(k,568) - lu(k,327) * lu(k,557) - lu(k,569) = lu(k,569) - lu(k,328) * lu(k,557) - lu(k,570) = lu(k,570) - lu(k,329) * lu(k,557) - lu(k,597) = lu(k,597) - lu(k,317) * lu(k,596) - lu(k,598) = lu(k,598) - lu(k,318) * lu(k,596) - lu(k,599) = lu(k,599) - lu(k,319) * lu(k,596) - lu(k,600) = lu(k,600) - lu(k,320) * lu(k,596) - lu(k,601) = lu(k,601) - lu(k,321) * lu(k,596) - lu(k,602) = lu(k,602) - lu(k,322) * lu(k,596) - lu(k,603) = lu(k,603) - lu(k,323) * lu(k,596) - lu(k,604) = lu(k,604) - lu(k,324) * lu(k,596) - lu(k,605) = lu(k,605) - lu(k,325) * lu(k,596) - lu(k,606) = lu(k,606) - lu(k,326) * lu(k,596) - lu(k,607) = lu(k,607) - lu(k,327) * lu(k,596) - lu(k,608) = lu(k,608) - lu(k,328) * lu(k,596) - lu(k,609) = lu(k,609) - lu(k,329) * lu(k,596) - lu(k,617) = lu(k,617) - lu(k,317) * lu(k,616) - lu(k,618) = lu(k,618) - lu(k,318) * lu(k,616) - lu(k,619) = lu(k,619) - lu(k,319) * lu(k,616) - lu(k,620) = lu(k,620) - lu(k,320) * lu(k,616) - lu(k,621) = lu(k,621) - lu(k,321) * lu(k,616) - lu(k,622) = lu(k,622) - lu(k,322) * lu(k,616) - lu(k,623) = lu(k,623) - lu(k,323) * lu(k,616) - lu(k,624) = lu(k,624) - lu(k,324) * lu(k,616) - lu(k,625) = lu(k,625) - lu(k,325) * lu(k,616) - lu(k,626) = lu(k,626) - lu(k,326) * lu(k,616) - lu(k,627) = lu(k,627) - lu(k,327) * lu(k,616) - lu(k,628) = lu(k,628) - lu(k,328) * lu(k,616) - lu(k,629) = lu(k,629) - lu(k,329) * lu(k,616) - lu(k,635) = lu(k,635) - lu(k,317) * lu(k,634) - lu(k,636) = lu(k,636) - lu(k,318) * lu(k,634) - lu(k,637) = lu(k,637) - lu(k,319) * lu(k,634) - lu(k,638) = lu(k,638) - lu(k,320) * lu(k,634) - lu(k,639) = lu(k,639) - lu(k,321) * lu(k,634) - lu(k,640) = lu(k,640) - lu(k,322) * lu(k,634) - lu(k,641) = lu(k,641) - lu(k,323) * lu(k,634) - lu(k,642) = lu(k,642) - lu(k,324) * lu(k,634) - lu(k,643) = lu(k,643) - lu(k,325) * lu(k,634) - lu(k,644) = lu(k,644) - lu(k,326) * lu(k,634) - lu(k,645) = lu(k,645) - lu(k,327) * lu(k,634) - lu(k,646) = lu(k,646) - lu(k,328) * lu(k,634) - lu(k,647) = lu(k,647) - lu(k,329) * lu(k,634) + lu(k,320) = 1._r8 / lu(k,320) + lu(k,321) = lu(k,321) * lu(k,320) + lu(k,322) = lu(k,322) * lu(k,320) + lu(k,323) = lu(k,323) * lu(k,320) + lu(k,324) = lu(k,324) * lu(k,320) + lu(k,325) = lu(k,325) * lu(k,320) + lu(k,326) = lu(k,326) * lu(k,320) + lu(k,327) = lu(k,327) * lu(k,320) + lu(k,328) = lu(k,328) * lu(k,320) + lu(k,329) = lu(k,329) * lu(k,320) + lu(k,330) = lu(k,330) * lu(k,320) + lu(k,331) = lu(k,331) * lu(k,320) + lu(k,332) = lu(k,332) * lu(k,320) + lu(k,333) = lu(k,333) * lu(k,320) + lu(k,341) = lu(k,341) - lu(k,321) * lu(k,340) + lu(k,342) = lu(k,342) - lu(k,322) * lu(k,340) + lu(k,343) = lu(k,343) - lu(k,323) * lu(k,340) + lu(k,344) = lu(k,344) - lu(k,324) * lu(k,340) + lu(k,345) = lu(k,345) - lu(k,325) * lu(k,340) + lu(k,346) = lu(k,346) - lu(k,326) * lu(k,340) + lu(k,347) = lu(k,347) - lu(k,327) * lu(k,340) + lu(k,348) = lu(k,348) - lu(k,328) * lu(k,340) + lu(k,349) = lu(k,349) - lu(k,329) * lu(k,340) + lu(k,350) = lu(k,350) - lu(k,330) * lu(k,340) + lu(k,351) = lu(k,351) - lu(k,331) * lu(k,340) + lu(k,352) = lu(k,352) - lu(k,332) * lu(k,340) + lu(k,353) = lu(k,353) - lu(k,333) * lu(k,340) + lu(k,361) = lu(k,361) - lu(k,321) * lu(k,360) + lu(k,362) = lu(k,362) - lu(k,322) * lu(k,360) + lu(k,363) = lu(k,363) - lu(k,323) * lu(k,360) + lu(k,364) = lu(k,364) - lu(k,324) * lu(k,360) + lu(k,365) = lu(k,365) - lu(k,325) * lu(k,360) + lu(k,366) = lu(k,366) - lu(k,326) * lu(k,360) + lu(k,367) = lu(k,367) - lu(k,327) * lu(k,360) + lu(k,368) = lu(k,368) - lu(k,328) * lu(k,360) + lu(k,369) = lu(k,369) - lu(k,329) * lu(k,360) + lu(k,370) = lu(k,370) - lu(k,330) * lu(k,360) + lu(k,371) = lu(k,371) - lu(k,331) * lu(k,360) + lu(k,372) = lu(k,372) - lu(k,332) * lu(k,360) + lu(k,373) = lu(k,373) - lu(k,333) * lu(k,360) + lu(k,383) = lu(k,383) - lu(k,321) * lu(k,382) + lu(k,384) = lu(k,384) - lu(k,322) * lu(k,382) + lu(k,385) = lu(k,385) - lu(k,323) * lu(k,382) + lu(k,386) = lu(k,386) - lu(k,324) * lu(k,382) + lu(k,387) = lu(k,387) - lu(k,325) * lu(k,382) + lu(k,388) = lu(k,388) - lu(k,326) * lu(k,382) + lu(k,389) = lu(k,389) - lu(k,327) * lu(k,382) + lu(k,390) = lu(k,390) - lu(k,328) * lu(k,382) + lu(k,391) = lu(k,391) - lu(k,329) * lu(k,382) + lu(k,392) = lu(k,392) - lu(k,330) * lu(k,382) + lu(k,393) = lu(k,393) - lu(k,331) * lu(k,382) + lu(k,394) = lu(k,394) - lu(k,332) * lu(k,382) + lu(k,395) = lu(k,395) - lu(k,333) * lu(k,382) + lu(k,408) = lu(k,408) - lu(k,321) * lu(k,407) + lu(k,409) = lu(k,409) - lu(k,322) * lu(k,407) + lu(k,410) = lu(k,410) - lu(k,323) * lu(k,407) + lu(k,411) = lu(k,411) - lu(k,324) * lu(k,407) + lu(k,412) = lu(k,412) - lu(k,325) * lu(k,407) + lu(k,413) = lu(k,413) - lu(k,326) * lu(k,407) + lu(k,414) = lu(k,414) - lu(k,327) * lu(k,407) + lu(k,415) = lu(k,415) - lu(k,328) * lu(k,407) + lu(k,416) = lu(k,416) - lu(k,329) * lu(k,407) + lu(k,417) = lu(k,417) - lu(k,330) * lu(k,407) + lu(k,418) = lu(k,418) - lu(k,331) * lu(k,407) + lu(k,419) = lu(k,419) - lu(k,332) * lu(k,407) + lu(k,420) = lu(k,420) - lu(k,333) * lu(k,407) + lu(k,433) = lu(k,433) - lu(k,321) * lu(k,432) + lu(k,434) = lu(k,434) - lu(k,322) * lu(k,432) + lu(k,435) = lu(k,435) - lu(k,323) * lu(k,432) + lu(k,436) = lu(k,436) - lu(k,324) * lu(k,432) + lu(k,437) = lu(k,437) - lu(k,325) * lu(k,432) + lu(k,438) = lu(k,438) - lu(k,326) * lu(k,432) + lu(k,439) = lu(k,439) - lu(k,327) * lu(k,432) + lu(k,440) = lu(k,440) - lu(k,328) * lu(k,432) + lu(k,441) = lu(k,441) - lu(k,329) * lu(k,432) + lu(k,442) = lu(k,442) - lu(k,330) * lu(k,432) + lu(k,443) = lu(k,443) - lu(k,331) * lu(k,432) + lu(k,444) = lu(k,444) - lu(k,332) * lu(k,432) + lu(k,445) = lu(k,445) - lu(k,333) * lu(k,432) + lu(k,459) = lu(k,459) - lu(k,321) * lu(k,458) + lu(k,460) = lu(k,460) - lu(k,322) * lu(k,458) + lu(k,461) = lu(k,461) - lu(k,323) * lu(k,458) + lu(k,462) = lu(k,462) - lu(k,324) * lu(k,458) + lu(k,463) = lu(k,463) - lu(k,325) * lu(k,458) + lu(k,464) = lu(k,464) - lu(k,326) * lu(k,458) + lu(k,465) = lu(k,465) - lu(k,327) * lu(k,458) + lu(k,466) = lu(k,466) - lu(k,328) * lu(k,458) + lu(k,467) = lu(k,467) - lu(k,329) * lu(k,458) + lu(k,468) = lu(k,468) - lu(k,330) * lu(k,458) + lu(k,469) = lu(k,469) - lu(k,331) * lu(k,458) + lu(k,470) = lu(k,470) - lu(k,332) * lu(k,458) + lu(k,471) = lu(k,471) - lu(k,333) * lu(k,458) + lu(k,482) = lu(k,482) - lu(k,321) * lu(k,481) + lu(k,483) = lu(k,483) - lu(k,322) * lu(k,481) + lu(k,484) = lu(k,484) - lu(k,323) * lu(k,481) + lu(k,485) = lu(k,485) - lu(k,324) * lu(k,481) + lu(k,486) = lu(k,486) - lu(k,325) * lu(k,481) + lu(k,487) = lu(k,487) - lu(k,326) * lu(k,481) + lu(k,488) = lu(k,488) - lu(k,327) * lu(k,481) + lu(k,489) = lu(k,489) - lu(k,328) * lu(k,481) + lu(k,490) = lu(k,490) - lu(k,329) * lu(k,481) + lu(k,491) = lu(k,491) - lu(k,330) * lu(k,481) + lu(k,492) = lu(k,492) - lu(k,331) * lu(k,481) + lu(k,493) = lu(k,493) - lu(k,332) * lu(k,481) + lu(k,494) = lu(k,494) - lu(k,333) * lu(k,481) + lu(k,503) = lu(k,503) - lu(k,321) * lu(k,502) + lu(k,504) = lu(k,504) - lu(k,322) * lu(k,502) + lu(k,505) = lu(k,505) - lu(k,323) * lu(k,502) + lu(k,506) = lu(k,506) - lu(k,324) * lu(k,502) + lu(k,507) = lu(k,507) - lu(k,325) * lu(k,502) + lu(k,508) = lu(k,508) - lu(k,326) * lu(k,502) + lu(k,509) = lu(k,509) - lu(k,327) * lu(k,502) + lu(k,510) = lu(k,510) - lu(k,328) * lu(k,502) + lu(k,511) = lu(k,511) - lu(k,329) * lu(k,502) + lu(k,512) = lu(k,512) - lu(k,330) * lu(k,502) + lu(k,513) = lu(k,513) - lu(k,331) * lu(k,502) + lu(k,514) = lu(k,514) - lu(k,332) * lu(k,502) + lu(k,515) = lu(k,515) - lu(k,333) * lu(k,502) + lu(k,534) = lu(k,534) - lu(k,321) * lu(k,533) + lu(k,535) = lu(k,535) - lu(k,322) * lu(k,533) + lu(k,536) = lu(k,536) - lu(k,323) * lu(k,533) + lu(k,537) = lu(k,537) - lu(k,324) * lu(k,533) + lu(k,538) = lu(k,538) - lu(k,325) * lu(k,533) + lu(k,539) = lu(k,539) - lu(k,326) * lu(k,533) + lu(k,540) = lu(k,540) - lu(k,327) * lu(k,533) + lu(k,541) = lu(k,541) - lu(k,328) * lu(k,533) + lu(k,542) = lu(k,542) - lu(k,329) * lu(k,533) + lu(k,543) = lu(k,543) - lu(k,330) * lu(k,533) + lu(k,544) = lu(k,544) - lu(k,331) * lu(k,533) + lu(k,545) = lu(k,545) - lu(k,332) * lu(k,533) + lu(k,546) = lu(k,546) - lu(k,333) * lu(k,533) + lu(k,553) = lu(k,553) - lu(k,321) * lu(k,552) + lu(k,554) = lu(k,554) - lu(k,322) * lu(k,552) + lu(k,555) = lu(k,555) - lu(k,323) * lu(k,552) + lu(k,556) = lu(k,556) - lu(k,324) * lu(k,552) + lu(k,557) = lu(k,557) - lu(k,325) * lu(k,552) + lu(k,558) = lu(k,558) - lu(k,326) * lu(k,552) + lu(k,559) = lu(k,559) - lu(k,327) * lu(k,552) + lu(k,560) = lu(k,560) - lu(k,328) * lu(k,552) + lu(k,561) = lu(k,561) - lu(k,329) * lu(k,552) + lu(k,562) = lu(k,562) - lu(k,330) * lu(k,552) + lu(k,563) = lu(k,563) - lu(k,331) * lu(k,552) + lu(k,564) = lu(k,564) - lu(k,332) * lu(k,552) + lu(k,565) = lu(k,565) - lu(k,333) * lu(k,552) + lu(k,578) = lu(k,578) - lu(k,321) * lu(k,577) + lu(k,579) = lu(k,579) - lu(k,322) * lu(k,577) + lu(k,580) = lu(k,580) - lu(k,323) * lu(k,577) + lu(k,581) = lu(k,581) - lu(k,324) * lu(k,577) + lu(k,582) = lu(k,582) - lu(k,325) * lu(k,577) + lu(k,583) = lu(k,583) - lu(k,326) * lu(k,577) + lu(k,584) = lu(k,584) - lu(k,327) * lu(k,577) + lu(k,585) = lu(k,585) - lu(k,328) * lu(k,577) + lu(k,586) = lu(k,586) - lu(k,329) * lu(k,577) + lu(k,587) = lu(k,587) - lu(k,330) * lu(k,577) + lu(k,588) = lu(k,588) - lu(k,331) * lu(k,577) + lu(k,589) = lu(k,589) - lu(k,332) * lu(k,577) + lu(k,590) = lu(k,590) - lu(k,333) * lu(k,577) + lu(k,596) = lu(k,596) - lu(k,321) * lu(k,595) + lu(k,597) = lu(k,597) - lu(k,322) * lu(k,595) + lu(k,598) = lu(k,598) - lu(k,323) * lu(k,595) + lu(k,599) = lu(k,599) - lu(k,324) * lu(k,595) + lu(k,600) = lu(k,600) - lu(k,325) * lu(k,595) + lu(k,601) = lu(k,601) - lu(k,326) * lu(k,595) + lu(k,602) = lu(k,602) - lu(k,327) * lu(k,595) + lu(k,603) = lu(k,603) - lu(k,328) * lu(k,595) + lu(k,604) = lu(k,604) - lu(k,329) * lu(k,595) + lu(k,605) = lu(k,605) - lu(k,330) * lu(k,595) + lu(k,606) = lu(k,606) - lu(k,331) * lu(k,595) + lu(k,607) = lu(k,607) - lu(k,332) * lu(k,595) + lu(k,608) = lu(k,608) - lu(k,333) * lu(k,595) + lu(k,635) = lu(k,635) - lu(k,321) * lu(k,634) + lu(k,636) = lu(k,636) - lu(k,322) * lu(k,634) + lu(k,637) = lu(k,637) - lu(k,323) * lu(k,634) + lu(k,638) = lu(k,638) - lu(k,324) * lu(k,634) + lu(k,639) = lu(k,639) - lu(k,325) * lu(k,634) + lu(k,640) = lu(k,640) - lu(k,326) * lu(k,634) + lu(k,641) = lu(k,641) - lu(k,327) * lu(k,634) + lu(k,642) = lu(k,642) - lu(k,328) * lu(k,634) + lu(k,643) = lu(k,643) - lu(k,329) * lu(k,634) + lu(k,644) = lu(k,644) - lu(k,330) * lu(k,634) + lu(k,645) = lu(k,645) - lu(k,331) * lu(k,634) + lu(k,646) = lu(k,646) - lu(k,332) * lu(k,634) + lu(k,647) = lu(k,647) - lu(k,333) * lu(k,634) end do end subroutine lu_fac07 subroutine lu_fac08( avec_len, lu ) @@ -1964,571 +1964,571 @@ subroutine lu_fac08( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,339) = 1._r8 / lu(k,339) - lu(k,340) = lu(k,340) * lu(k,339) - lu(k,341) = lu(k,341) * lu(k,339) - lu(k,342) = lu(k,342) * lu(k,339) - lu(k,343) = lu(k,343) * lu(k,339) - lu(k,344) = lu(k,344) * lu(k,339) - lu(k,345) = lu(k,345) * lu(k,339) - lu(k,346) = lu(k,346) * lu(k,339) - lu(k,347) = lu(k,347) * lu(k,339) - lu(k,348) = lu(k,348) * lu(k,339) - lu(k,349) = lu(k,349) * lu(k,339) - lu(k,350) = lu(k,350) * lu(k,339) - lu(k,351) = lu(k,351) * lu(k,339) - lu(k,363) = lu(k,363) - lu(k,340) * lu(k,362) - lu(k,364) = lu(k,364) - lu(k,341) * lu(k,362) - lu(k,365) = lu(k,365) - lu(k,342) * lu(k,362) - lu(k,366) = lu(k,366) - lu(k,343) * lu(k,362) - lu(k,367) = lu(k,367) - lu(k,344) * lu(k,362) - lu(k,368) = lu(k,368) - lu(k,345) * lu(k,362) - lu(k,369) = lu(k,369) - lu(k,346) * lu(k,362) - lu(k,370) = lu(k,370) - lu(k,347) * lu(k,362) - lu(k,371) = lu(k,371) - lu(k,348) * lu(k,362) - lu(k,372) = lu(k,372) - lu(k,349) * lu(k,362) - lu(k,373) = lu(k,373) - lu(k,350) * lu(k,362) - lu(k,374) = lu(k,374) - lu(k,351) * lu(k,362) - lu(k,388) = lu(k,388) - lu(k,340) * lu(k,387) - lu(k,389) = lu(k,389) - lu(k,341) * lu(k,387) - lu(k,390) = lu(k,390) - lu(k,342) * lu(k,387) - lu(k,391) = lu(k,391) - lu(k,343) * lu(k,387) - lu(k,392) = lu(k,392) - lu(k,344) * lu(k,387) - lu(k,393) = lu(k,393) - lu(k,345) * lu(k,387) - lu(k,394) = lu(k,394) - lu(k,346) * lu(k,387) - lu(k,395) = lu(k,395) - lu(k,347) * lu(k,387) - lu(k,396) = lu(k,396) - lu(k,348) * lu(k,387) - lu(k,397) = lu(k,397) - lu(k,349) * lu(k,387) - lu(k,398) = lu(k,398) - lu(k,350) * lu(k,387) - lu(k,399) = lu(k,399) - lu(k,351) * lu(k,387) - lu(k,414) = lu(k,414) - lu(k,340) * lu(k,413) - lu(k,415) = lu(k,415) - lu(k,341) * lu(k,413) - lu(k,416) = lu(k,416) - lu(k,342) * lu(k,413) - lu(k,417) = lu(k,417) - lu(k,343) * lu(k,413) - lu(k,418) = lu(k,418) - lu(k,344) * lu(k,413) - lu(k,419) = lu(k,419) - lu(k,345) * lu(k,413) - lu(k,420) = lu(k,420) - lu(k,346) * lu(k,413) - lu(k,421) = lu(k,421) - lu(k,347) * lu(k,413) - lu(k,422) = lu(k,422) - lu(k,348) * lu(k,413) - lu(k,423) = lu(k,423) - lu(k,349) * lu(k,413) - lu(k,424) = lu(k,424) - lu(k,350) * lu(k,413) - lu(k,425) = lu(k,425) - lu(k,351) * lu(k,413) - lu(k,439) = lu(k,439) - lu(k,340) * lu(k,438) - lu(k,440) = lu(k,440) - lu(k,341) * lu(k,438) - lu(k,441) = lu(k,441) - lu(k,342) * lu(k,438) - lu(k,442) = lu(k,442) - lu(k,343) * lu(k,438) - lu(k,443) = lu(k,443) - lu(k,344) * lu(k,438) - lu(k,444) = lu(k,444) - lu(k,345) * lu(k,438) - lu(k,445) = lu(k,445) - lu(k,346) * lu(k,438) - lu(k,446) = lu(k,446) - lu(k,347) * lu(k,438) - lu(k,447) = lu(k,447) - lu(k,348) * lu(k,438) - lu(k,448) = lu(k,448) - lu(k,349) * lu(k,438) - lu(k,449) = lu(k,449) - lu(k,350) * lu(k,438) - lu(k,450) = lu(k,450) - lu(k,351) * lu(k,438) - lu(k,459) = lu(k,459) - lu(k,340) * lu(k,458) - lu(k,460) = lu(k,460) - lu(k,341) * lu(k,458) - lu(k,461) = lu(k,461) - lu(k,342) * lu(k,458) - lu(k,462) = lu(k,462) - lu(k,343) * lu(k,458) - lu(k,463) = lu(k,463) - lu(k,344) * lu(k,458) - lu(k,464) = lu(k,464) - lu(k,345) * lu(k,458) - lu(k,465) = lu(k,465) - lu(k,346) * lu(k,458) - lu(k,466) = lu(k,466) - lu(k,347) * lu(k,458) - lu(k,467) = lu(k,467) - lu(k,348) * lu(k,458) - lu(k,468) = lu(k,468) - lu(k,349) * lu(k,458) - lu(k,469) = lu(k,469) - lu(k,350) * lu(k,458) - lu(k,470) = lu(k,470) - lu(k,351) * lu(k,458) - lu(k,478) = lu(k,478) - lu(k,340) * lu(k,477) - lu(k,479) = lu(k,479) - lu(k,341) * lu(k,477) - lu(k,480) = lu(k,480) - lu(k,342) * lu(k,477) - lu(k,481) = lu(k,481) - lu(k,343) * lu(k,477) - lu(k,482) = lu(k,482) - lu(k,344) * lu(k,477) - lu(k,483) = lu(k,483) - lu(k,345) * lu(k,477) - lu(k,484) = lu(k,484) - lu(k,346) * lu(k,477) - lu(k,485) = lu(k,485) - lu(k,347) * lu(k,477) - lu(k,486) = lu(k,486) - lu(k,348) * lu(k,477) - lu(k,487) = lu(k,487) - lu(k,349) * lu(k,477) - lu(k,488) = lu(k,488) - lu(k,350) * lu(k,477) - lu(k,489) = lu(k,489) - lu(k,351) * lu(k,477) - lu(k,503) = lu(k,503) - lu(k,340) * lu(k,502) - lu(k,504) = lu(k,504) - lu(k,341) * lu(k,502) - lu(k,505) = lu(k,505) - lu(k,342) * lu(k,502) - lu(k,506) = lu(k,506) - lu(k,343) * lu(k,502) - lu(k,507) = lu(k,507) - lu(k,344) * lu(k,502) - lu(k,508) = lu(k,508) - lu(k,345) * lu(k,502) - lu(k,509) = lu(k,509) - lu(k,346) * lu(k,502) - lu(k,510) = lu(k,510) - lu(k,347) * lu(k,502) - lu(k,511) = lu(k,511) - lu(k,348) * lu(k,502) - lu(k,512) = lu(k,512) - lu(k,349) * lu(k,502) - lu(k,513) = lu(k,513) - lu(k,350) * lu(k,502) - lu(k,514) = lu(k,514) - lu(k,351) * lu(k,502) - lu(k,534) = lu(k,534) - lu(k,340) * lu(k,533) - lu(k,535) = lu(k,535) - lu(k,341) * lu(k,533) - lu(k,536) = lu(k,536) - lu(k,342) * lu(k,533) - lu(k,537) = lu(k,537) - lu(k,343) * lu(k,533) - lu(k,538) = lu(k,538) - lu(k,344) * lu(k,533) - lu(k,539) = lu(k,539) - lu(k,345) * lu(k,533) - lu(k,540) = lu(k,540) - lu(k,346) * lu(k,533) - lu(k,541) = lu(k,541) - lu(k,347) * lu(k,533) - lu(k,542) = lu(k,542) - lu(k,348) * lu(k,533) - lu(k,543) = lu(k,543) - lu(k,349) * lu(k,533) - lu(k,544) = lu(k,544) - lu(k,350) * lu(k,533) - lu(k,545) = lu(k,545) - lu(k,351) * lu(k,533) - lu(k,559) = lu(k,559) - lu(k,340) * lu(k,558) - lu(k,560) = lu(k,560) - lu(k,341) * lu(k,558) - lu(k,561) = lu(k,561) - lu(k,342) * lu(k,558) - lu(k,562) = lu(k,562) - lu(k,343) * lu(k,558) - lu(k,563) = lu(k,563) - lu(k,344) * lu(k,558) - lu(k,564) = lu(k,564) - lu(k,345) * lu(k,558) - lu(k,565) = lu(k,565) - lu(k,346) * lu(k,558) - lu(k,566) = lu(k,566) - lu(k,347) * lu(k,558) - lu(k,567) = lu(k,567) - lu(k,348) * lu(k,558) - lu(k,568) = lu(k,568) - lu(k,349) * lu(k,558) - lu(k,569) = lu(k,569) - lu(k,350) * lu(k,558) - lu(k,570) = lu(k,570) - lu(k,351) * lu(k,558) - lu(k,598) = lu(k,598) - lu(k,340) * lu(k,597) - lu(k,599) = lu(k,599) - lu(k,341) * lu(k,597) - lu(k,600) = lu(k,600) - lu(k,342) * lu(k,597) - lu(k,601) = lu(k,601) - lu(k,343) * lu(k,597) - lu(k,602) = lu(k,602) - lu(k,344) * lu(k,597) - lu(k,603) = lu(k,603) - lu(k,345) * lu(k,597) - lu(k,604) = lu(k,604) - lu(k,346) * lu(k,597) - lu(k,605) = lu(k,605) - lu(k,347) * lu(k,597) - lu(k,606) = lu(k,606) - lu(k,348) * lu(k,597) - lu(k,607) = lu(k,607) - lu(k,349) * lu(k,597) - lu(k,608) = lu(k,608) - lu(k,350) * lu(k,597) - lu(k,609) = lu(k,609) - lu(k,351) * lu(k,597) - lu(k,618) = lu(k,618) - lu(k,340) * lu(k,617) - lu(k,619) = lu(k,619) - lu(k,341) * lu(k,617) - lu(k,620) = lu(k,620) - lu(k,342) * lu(k,617) - lu(k,621) = lu(k,621) - lu(k,343) * lu(k,617) - lu(k,622) = lu(k,622) - lu(k,344) * lu(k,617) - lu(k,623) = lu(k,623) - lu(k,345) * lu(k,617) - lu(k,624) = lu(k,624) - lu(k,346) * lu(k,617) - lu(k,625) = lu(k,625) - lu(k,347) * lu(k,617) - lu(k,626) = lu(k,626) - lu(k,348) * lu(k,617) - lu(k,627) = lu(k,627) - lu(k,349) * lu(k,617) - lu(k,628) = lu(k,628) - lu(k,350) * lu(k,617) - lu(k,629) = lu(k,629) - lu(k,351) * lu(k,617) - lu(k,636) = lu(k,636) - lu(k,340) * lu(k,635) - lu(k,637) = lu(k,637) - lu(k,341) * lu(k,635) - lu(k,638) = lu(k,638) - lu(k,342) * lu(k,635) - lu(k,639) = lu(k,639) - lu(k,343) * lu(k,635) - lu(k,640) = lu(k,640) - lu(k,344) * lu(k,635) - lu(k,641) = lu(k,641) - lu(k,345) * lu(k,635) - lu(k,642) = lu(k,642) - lu(k,346) * lu(k,635) - lu(k,643) = lu(k,643) - lu(k,347) * lu(k,635) - lu(k,644) = lu(k,644) - lu(k,348) * lu(k,635) - lu(k,645) = lu(k,645) - lu(k,349) * lu(k,635) - lu(k,646) = lu(k,646) - lu(k,350) * lu(k,635) - lu(k,647) = lu(k,647) - lu(k,351) * lu(k,635) - lu(k,363) = 1._r8 / lu(k,363) - lu(k,364) = lu(k,364) * lu(k,363) - lu(k,365) = lu(k,365) * lu(k,363) - lu(k,366) = lu(k,366) * lu(k,363) - lu(k,367) = lu(k,367) * lu(k,363) - lu(k,368) = lu(k,368) * lu(k,363) - lu(k,369) = lu(k,369) * lu(k,363) - lu(k,370) = lu(k,370) * lu(k,363) - lu(k,371) = lu(k,371) * lu(k,363) - lu(k,372) = lu(k,372) * lu(k,363) - lu(k,373) = lu(k,373) * lu(k,363) - lu(k,374) = lu(k,374) * lu(k,363) - lu(k,389) = lu(k,389) - lu(k,364) * lu(k,388) - lu(k,390) = lu(k,390) - lu(k,365) * lu(k,388) - lu(k,391) = lu(k,391) - lu(k,366) * lu(k,388) - lu(k,392) = lu(k,392) - lu(k,367) * lu(k,388) - lu(k,393) = lu(k,393) - lu(k,368) * lu(k,388) - lu(k,394) = lu(k,394) - lu(k,369) * lu(k,388) - lu(k,395) = lu(k,395) - lu(k,370) * lu(k,388) - lu(k,396) = lu(k,396) - lu(k,371) * lu(k,388) - lu(k,397) = lu(k,397) - lu(k,372) * lu(k,388) - lu(k,398) = lu(k,398) - lu(k,373) * lu(k,388) - lu(k,399) = lu(k,399) - lu(k,374) * lu(k,388) - lu(k,415) = lu(k,415) - lu(k,364) * lu(k,414) - lu(k,416) = lu(k,416) - lu(k,365) * lu(k,414) - lu(k,417) = lu(k,417) - lu(k,366) * lu(k,414) - lu(k,418) = lu(k,418) - lu(k,367) * lu(k,414) - lu(k,419) = lu(k,419) - lu(k,368) * lu(k,414) - lu(k,420) = lu(k,420) - lu(k,369) * lu(k,414) - lu(k,421) = lu(k,421) - lu(k,370) * lu(k,414) - lu(k,422) = lu(k,422) - lu(k,371) * lu(k,414) - lu(k,423) = lu(k,423) - lu(k,372) * lu(k,414) - lu(k,424) = lu(k,424) - lu(k,373) * lu(k,414) - lu(k,425) = lu(k,425) - lu(k,374) * lu(k,414) - lu(k,440) = lu(k,440) - lu(k,364) * lu(k,439) - lu(k,441) = lu(k,441) - lu(k,365) * lu(k,439) - lu(k,442) = lu(k,442) - lu(k,366) * lu(k,439) - lu(k,443) = lu(k,443) - lu(k,367) * lu(k,439) - lu(k,444) = lu(k,444) - lu(k,368) * lu(k,439) - lu(k,445) = lu(k,445) - lu(k,369) * lu(k,439) - lu(k,446) = lu(k,446) - lu(k,370) * lu(k,439) - lu(k,447) = lu(k,447) - lu(k,371) * lu(k,439) - lu(k,448) = lu(k,448) - lu(k,372) * lu(k,439) - lu(k,449) = lu(k,449) - lu(k,373) * lu(k,439) - lu(k,450) = lu(k,450) - lu(k,374) * lu(k,439) - lu(k,460) = lu(k,460) - lu(k,364) * lu(k,459) - lu(k,461) = lu(k,461) - lu(k,365) * lu(k,459) - lu(k,462) = lu(k,462) - lu(k,366) * lu(k,459) - lu(k,463) = lu(k,463) - lu(k,367) * lu(k,459) - lu(k,464) = lu(k,464) - lu(k,368) * lu(k,459) - lu(k,465) = lu(k,465) - lu(k,369) * lu(k,459) - lu(k,466) = lu(k,466) - lu(k,370) * lu(k,459) - lu(k,467) = lu(k,467) - lu(k,371) * lu(k,459) - lu(k,468) = lu(k,468) - lu(k,372) * lu(k,459) - lu(k,469) = lu(k,469) - lu(k,373) * lu(k,459) - lu(k,470) = lu(k,470) - lu(k,374) * lu(k,459) - lu(k,479) = lu(k,479) - lu(k,364) * lu(k,478) - lu(k,480) = lu(k,480) - lu(k,365) * lu(k,478) - lu(k,481) = lu(k,481) - lu(k,366) * lu(k,478) - lu(k,482) = lu(k,482) - lu(k,367) * lu(k,478) - lu(k,483) = lu(k,483) - lu(k,368) * lu(k,478) - lu(k,484) = lu(k,484) - lu(k,369) * lu(k,478) - lu(k,485) = lu(k,485) - lu(k,370) * lu(k,478) - lu(k,486) = lu(k,486) - lu(k,371) * lu(k,478) - lu(k,487) = lu(k,487) - lu(k,372) * lu(k,478) - lu(k,488) = lu(k,488) - lu(k,373) * lu(k,478) - lu(k,489) = lu(k,489) - lu(k,374) * lu(k,478) - lu(k,504) = lu(k,504) - lu(k,364) * lu(k,503) - lu(k,505) = lu(k,505) - lu(k,365) * lu(k,503) - lu(k,506) = lu(k,506) - lu(k,366) * lu(k,503) - lu(k,507) = lu(k,507) - lu(k,367) * lu(k,503) - lu(k,508) = lu(k,508) - lu(k,368) * lu(k,503) - lu(k,509) = lu(k,509) - lu(k,369) * lu(k,503) - lu(k,510) = lu(k,510) - lu(k,370) * lu(k,503) - lu(k,511) = lu(k,511) - lu(k,371) * lu(k,503) - lu(k,512) = lu(k,512) - lu(k,372) * lu(k,503) - lu(k,513) = lu(k,513) - lu(k,373) * lu(k,503) - lu(k,514) = lu(k,514) - lu(k,374) * lu(k,503) - lu(k,535) = lu(k,535) - lu(k,364) * lu(k,534) - lu(k,536) = lu(k,536) - lu(k,365) * lu(k,534) - lu(k,537) = lu(k,537) - lu(k,366) * lu(k,534) - lu(k,538) = lu(k,538) - lu(k,367) * lu(k,534) - lu(k,539) = lu(k,539) - lu(k,368) * lu(k,534) - lu(k,540) = lu(k,540) - lu(k,369) * lu(k,534) - lu(k,541) = lu(k,541) - lu(k,370) * lu(k,534) - lu(k,542) = lu(k,542) - lu(k,371) * lu(k,534) - lu(k,543) = lu(k,543) - lu(k,372) * lu(k,534) - lu(k,544) = lu(k,544) - lu(k,373) * lu(k,534) - lu(k,545) = lu(k,545) - lu(k,374) * lu(k,534) - lu(k,560) = lu(k,560) - lu(k,364) * lu(k,559) - lu(k,561) = lu(k,561) - lu(k,365) * lu(k,559) - lu(k,562) = lu(k,562) - lu(k,366) * lu(k,559) - lu(k,563) = lu(k,563) - lu(k,367) * lu(k,559) - lu(k,564) = lu(k,564) - lu(k,368) * lu(k,559) - lu(k,565) = lu(k,565) - lu(k,369) * lu(k,559) - lu(k,566) = lu(k,566) - lu(k,370) * lu(k,559) - lu(k,567) = lu(k,567) - lu(k,371) * lu(k,559) - lu(k,568) = lu(k,568) - lu(k,372) * lu(k,559) - lu(k,569) = lu(k,569) - lu(k,373) * lu(k,559) - lu(k,570) = lu(k,570) - lu(k,374) * lu(k,559) - lu(k,599) = lu(k,599) - lu(k,364) * lu(k,598) - lu(k,600) = lu(k,600) - lu(k,365) * lu(k,598) - lu(k,601) = lu(k,601) - lu(k,366) * lu(k,598) - lu(k,602) = lu(k,602) - lu(k,367) * lu(k,598) - lu(k,603) = lu(k,603) - lu(k,368) * lu(k,598) - lu(k,604) = lu(k,604) - lu(k,369) * lu(k,598) - lu(k,605) = lu(k,605) - lu(k,370) * lu(k,598) - lu(k,606) = lu(k,606) - lu(k,371) * lu(k,598) - lu(k,607) = lu(k,607) - lu(k,372) * lu(k,598) - lu(k,608) = lu(k,608) - lu(k,373) * lu(k,598) - lu(k,609) = lu(k,609) - lu(k,374) * lu(k,598) - lu(k,619) = lu(k,619) - lu(k,364) * lu(k,618) - lu(k,620) = lu(k,620) - lu(k,365) * lu(k,618) - lu(k,621) = lu(k,621) - lu(k,366) * lu(k,618) - lu(k,622) = lu(k,622) - lu(k,367) * lu(k,618) - lu(k,623) = lu(k,623) - lu(k,368) * lu(k,618) - lu(k,624) = lu(k,624) - lu(k,369) * lu(k,618) - lu(k,625) = lu(k,625) - lu(k,370) * lu(k,618) - lu(k,626) = lu(k,626) - lu(k,371) * lu(k,618) - lu(k,627) = lu(k,627) - lu(k,372) * lu(k,618) - lu(k,628) = lu(k,628) - lu(k,373) * lu(k,618) - lu(k,629) = lu(k,629) - lu(k,374) * lu(k,618) - lu(k,637) = lu(k,637) - lu(k,364) * lu(k,636) - lu(k,638) = lu(k,638) - lu(k,365) * lu(k,636) - lu(k,639) = lu(k,639) - lu(k,366) * lu(k,636) - lu(k,640) = lu(k,640) - lu(k,367) * lu(k,636) - lu(k,641) = lu(k,641) - lu(k,368) * lu(k,636) - lu(k,642) = lu(k,642) - lu(k,369) * lu(k,636) - lu(k,643) = lu(k,643) - lu(k,370) * lu(k,636) - lu(k,644) = lu(k,644) - lu(k,371) * lu(k,636) - lu(k,645) = lu(k,645) - lu(k,372) * lu(k,636) - lu(k,646) = lu(k,646) - lu(k,373) * lu(k,636) - lu(k,647) = lu(k,647) - lu(k,374) * lu(k,636) - 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,416) = lu(k,416) - lu(k,390) * lu(k,415) - lu(k,417) = lu(k,417) - lu(k,391) * lu(k,415) - lu(k,418) = lu(k,418) - lu(k,392) * lu(k,415) - lu(k,419) = lu(k,419) - lu(k,393) * lu(k,415) - lu(k,420) = lu(k,420) - lu(k,394) * lu(k,415) - lu(k,421) = lu(k,421) - lu(k,395) * lu(k,415) - lu(k,422) = lu(k,422) - lu(k,396) * lu(k,415) - lu(k,423) = lu(k,423) - lu(k,397) * lu(k,415) - lu(k,424) = lu(k,424) - lu(k,398) * lu(k,415) - lu(k,425) = lu(k,425) - lu(k,399) * lu(k,415) - lu(k,441) = lu(k,441) - lu(k,390) * lu(k,440) - lu(k,442) = lu(k,442) - lu(k,391) * lu(k,440) - lu(k,443) = lu(k,443) - lu(k,392) * lu(k,440) - lu(k,444) = lu(k,444) - lu(k,393) * lu(k,440) - lu(k,445) = lu(k,445) - lu(k,394) * lu(k,440) - lu(k,446) = lu(k,446) - lu(k,395) * lu(k,440) - lu(k,447) = lu(k,447) - lu(k,396) * lu(k,440) - lu(k,448) = lu(k,448) - lu(k,397) * lu(k,440) - lu(k,449) = lu(k,449) - lu(k,398) * lu(k,440) - lu(k,450) = lu(k,450) - lu(k,399) * lu(k,440) - lu(k,461) = lu(k,461) - lu(k,390) * lu(k,460) - lu(k,462) = lu(k,462) - lu(k,391) * lu(k,460) - lu(k,463) = lu(k,463) - lu(k,392) * lu(k,460) - lu(k,464) = lu(k,464) - lu(k,393) * lu(k,460) - lu(k,465) = lu(k,465) - lu(k,394) * lu(k,460) - lu(k,466) = lu(k,466) - lu(k,395) * lu(k,460) - lu(k,467) = lu(k,467) - lu(k,396) * lu(k,460) - lu(k,468) = lu(k,468) - lu(k,397) * lu(k,460) - lu(k,469) = lu(k,469) - lu(k,398) * lu(k,460) - lu(k,470) = lu(k,470) - lu(k,399) * lu(k,460) - lu(k,480) = lu(k,480) - lu(k,390) * lu(k,479) - lu(k,481) = lu(k,481) - lu(k,391) * lu(k,479) - lu(k,482) = lu(k,482) - lu(k,392) * lu(k,479) - lu(k,483) = lu(k,483) - lu(k,393) * lu(k,479) - lu(k,484) = lu(k,484) - lu(k,394) * lu(k,479) - lu(k,485) = lu(k,485) - lu(k,395) * lu(k,479) - lu(k,486) = lu(k,486) - lu(k,396) * lu(k,479) - lu(k,487) = lu(k,487) - lu(k,397) * lu(k,479) - lu(k,488) = lu(k,488) - lu(k,398) * lu(k,479) - lu(k,489) = lu(k,489) - lu(k,399) * lu(k,479) - lu(k,505) = lu(k,505) - lu(k,390) * lu(k,504) - lu(k,506) = lu(k,506) - lu(k,391) * lu(k,504) - lu(k,507) = lu(k,507) - lu(k,392) * lu(k,504) - lu(k,508) = lu(k,508) - lu(k,393) * lu(k,504) - lu(k,509) = lu(k,509) - lu(k,394) * lu(k,504) - lu(k,510) = lu(k,510) - lu(k,395) * lu(k,504) - lu(k,511) = lu(k,511) - lu(k,396) * lu(k,504) - lu(k,512) = lu(k,512) - lu(k,397) * lu(k,504) - lu(k,513) = lu(k,513) - lu(k,398) * lu(k,504) - lu(k,514) = lu(k,514) - lu(k,399) * lu(k,504) - lu(k,536) = lu(k,536) - lu(k,390) * lu(k,535) - lu(k,537) = lu(k,537) - lu(k,391) * lu(k,535) - lu(k,538) = lu(k,538) - lu(k,392) * lu(k,535) - lu(k,539) = lu(k,539) - lu(k,393) * lu(k,535) - lu(k,540) = lu(k,540) - lu(k,394) * lu(k,535) - lu(k,541) = lu(k,541) - lu(k,395) * lu(k,535) - lu(k,542) = lu(k,542) - lu(k,396) * lu(k,535) - lu(k,543) = lu(k,543) - lu(k,397) * lu(k,535) - lu(k,544) = lu(k,544) - lu(k,398) * lu(k,535) - lu(k,545) = lu(k,545) - lu(k,399) * lu(k,535) - lu(k,561) = lu(k,561) - lu(k,390) * lu(k,560) - lu(k,562) = lu(k,562) - lu(k,391) * lu(k,560) - lu(k,563) = lu(k,563) - lu(k,392) * lu(k,560) - lu(k,564) = lu(k,564) - lu(k,393) * lu(k,560) - lu(k,565) = lu(k,565) - lu(k,394) * lu(k,560) - lu(k,566) = lu(k,566) - lu(k,395) * lu(k,560) - lu(k,567) = lu(k,567) - lu(k,396) * lu(k,560) - lu(k,568) = lu(k,568) - lu(k,397) * lu(k,560) - lu(k,569) = lu(k,569) - lu(k,398) * lu(k,560) - lu(k,570) = lu(k,570) - lu(k,399) * lu(k,560) - lu(k,600) = lu(k,600) - lu(k,390) * lu(k,599) - lu(k,601) = lu(k,601) - lu(k,391) * lu(k,599) - lu(k,602) = lu(k,602) - lu(k,392) * lu(k,599) - lu(k,603) = lu(k,603) - lu(k,393) * lu(k,599) - lu(k,604) = lu(k,604) - lu(k,394) * lu(k,599) - lu(k,605) = lu(k,605) - lu(k,395) * lu(k,599) - lu(k,606) = lu(k,606) - lu(k,396) * lu(k,599) - lu(k,607) = lu(k,607) - lu(k,397) * lu(k,599) - lu(k,608) = lu(k,608) - lu(k,398) * lu(k,599) - lu(k,609) = lu(k,609) - lu(k,399) * lu(k,599) - lu(k,620) = lu(k,620) - lu(k,390) * lu(k,619) - lu(k,621) = lu(k,621) - lu(k,391) * lu(k,619) - lu(k,622) = lu(k,622) - lu(k,392) * lu(k,619) - lu(k,623) = lu(k,623) - lu(k,393) * lu(k,619) - lu(k,624) = lu(k,624) - lu(k,394) * lu(k,619) - lu(k,625) = lu(k,625) - lu(k,395) * lu(k,619) - lu(k,626) = lu(k,626) - lu(k,396) * lu(k,619) - lu(k,627) = lu(k,627) - lu(k,397) * lu(k,619) - lu(k,628) = lu(k,628) - lu(k,398) * lu(k,619) - lu(k,629) = lu(k,629) - lu(k,399) * lu(k,619) - lu(k,638) = lu(k,638) - lu(k,390) * lu(k,637) - lu(k,639) = lu(k,639) - lu(k,391) * lu(k,637) - lu(k,640) = lu(k,640) - lu(k,392) * lu(k,637) - lu(k,641) = lu(k,641) - lu(k,393) * lu(k,637) - lu(k,642) = lu(k,642) - lu(k,394) * lu(k,637) - lu(k,643) = lu(k,643) - lu(k,395) * lu(k,637) - lu(k,644) = lu(k,644) - lu(k,396) * lu(k,637) - lu(k,645) = lu(k,645) - lu(k,397) * lu(k,637) - lu(k,646) = lu(k,646) - lu(k,398) * lu(k,637) - lu(k,647) = lu(k,647) - lu(k,399) * lu(k,637) - 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,421) = lu(k,421) * lu(k,416) - lu(k,422) = lu(k,422) * lu(k,416) - lu(k,423) = lu(k,423) * lu(k,416) - lu(k,424) = lu(k,424) * lu(k,416) - lu(k,425) = lu(k,425) * lu(k,416) - lu(k,442) = lu(k,442) - lu(k,417) * lu(k,441) - lu(k,443) = lu(k,443) - lu(k,418) * lu(k,441) - lu(k,444) = lu(k,444) - lu(k,419) * lu(k,441) - lu(k,445) = lu(k,445) - lu(k,420) * lu(k,441) - lu(k,446) = lu(k,446) - lu(k,421) * lu(k,441) - lu(k,447) = lu(k,447) - lu(k,422) * lu(k,441) - lu(k,448) = lu(k,448) - lu(k,423) * lu(k,441) - lu(k,449) = lu(k,449) - lu(k,424) * lu(k,441) - lu(k,450) = lu(k,450) - lu(k,425) * lu(k,441) - lu(k,462) = lu(k,462) - lu(k,417) * lu(k,461) - lu(k,463) = lu(k,463) - lu(k,418) * lu(k,461) - lu(k,464) = lu(k,464) - lu(k,419) * lu(k,461) - lu(k,465) = lu(k,465) - lu(k,420) * lu(k,461) - lu(k,466) = lu(k,466) - lu(k,421) * lu(k,461) - lu(k,467) = lu(k,467) - lu(k,422) * lu(k,461) - lu(k,468) = lu(k,468) - lu(k,423) * lu(k,461) - lu(k,469) = lu(k,469) - lu(k,424) * lu(k,461) - lu(k,470) = lu(k,470) - lu(k,425) * lu(k,461) - lu(k,481) = lu(k,481) - lu(k,417) * lu(k,480) - lu(k,482) = lu(k,482) - lu(k,418) * lu(k,480) - lu(k,483) = lu(k,483) - lu(k,419) * lu(k,480) - lu(k,484) = lu(k,484) - lu(k,420) * lu(k,480) - lu(k,485) = lu(k,485) - lu(k,421) * lu(k,480) - lu(k,486) = lu(k,486) - lu(k,422) * lu(k,480) - lu(k,487) = lu(k,487) - lu(k,423) * lu(k,480) - lu(k,488) = lu(k,488) - lu(k,424) * lu(k,480) - lu(k,489) = lu(k,489) - lu(k,425) * lu(k,480) - lu(k,506) = lu(k,506) - lu(k,417) * lu(k,505) - lu(k,507) = lu(k,507) - lu(k,418) * lu(k,505) - lu(k,508) = lu(k,508) - lu(k,419) * lu(k,505) - lu(k,509) = lu(k,509) - lu(k,420) * lu(k,505) - lu(k,510) = lu(k,510) - lu(k,421) * lu(k,505) - lu(k,511) = lu(k,511) - lu(k,422) * lu(k,505) - lu(k,512) = lu(k,512) - lu(k,423) * lu(k,505) - lu(k,513) = lu(k,513) - lu(k,424) * lu(k,505) - lu(k,514) = lu(k,514) - lu(k,425) * lu(k,505) - lu(k,537) = lu(k,537) - lu(k,417) * lu(k,536) - lu(k,538) = lu(k,538) - lu(k,418) * lu(k,536) - lu(k,539) = lu(k,539) - lu(k,419) * lu(k,536) - lu(k,540) = lu(k,540) - lu(k,420) * lu(k,536) - lu(k,541) = lu(k,541) - lu(k,421) * lu(k,536) - lu(k,542) = lu(k,542) - lu(k,422) * lu(k,536) - lu(k,543) = lu(k,543) - lu(k,423) * lu(k,536) - lu(k,544) = lu(k,544) - lu(k,424) * lu(k,536) - lu(k,545) = lu(k,545) - lu(k,425) * lu(k,536) - lu(k,562) = lu(k,562) - lu(k,417) * lu(k,561) - lu(k,563) = lu(k,563) - lu(k,418) * lu(k,561) - lu(k,564) = lu(k,564) - lu(k,419) * lu(k,561) - lu(k,565) = lu(k,565) - lu(k,420) * lu(k,561) - lu(k,566) = lu(k,566) - lu(k,421) * lu(k,561) - lu(k,567) = lu(k,567) - lu(k,422) * lu(k,561) - lu(k,568) = lu(k,568) - lu(k,423) * lu(k,561) - lu(k,569) = lu(k,569) - lu(k,424) * lu(k,561) - lu(k,570) = lu(k,570) - lu(k,425) * lu(k,561) - lu(k,601) = lu(k,601) - lu(k,417) * lu(k,600) - lu(k,602) = lu(k,602) - lu(k,418) * lu(k,600) - lu(k,603) = lu(k,603) - lu(k,419) * lu(k,600) - lu(k,604) = lu(k,604) - lu(k,420) * lu(k,600) - lu(k,605) = lu(k,605) - lu(k,421) * lu(k,600) - lu(k,606) = lu(k,606) - lu(k,422) * lu(k,600) - lu(k,607) = lu(k,607) - lu(k,423) * lu(k,600) - lu(k,608) = lu(k,608) - lu(k,424) * lu(k,600) - lu(k,609) = lu(k,609) - lu(k,425) * lu(k,600) - lu(k,621) = lu(k,621) - lu(k,417) * lu(k,620) - lu(k,622) = lu(k,622) - lu(k,418) * lu(k,620) - lu(k,623) = lu(k,623) - lu(k,419) * lu(k,620) - lu(k,624) = lu(k,624) - lu(k,420) * lu(k,620) - lu(k,625) = lu(k,625) - lu(k,421) * lu(k,620) - lu(k,626) = lu(k,626) - lu(k,422) * lu(k,620) - lu(k,627) = lu(k,627) - lu(k,423) * lu(k,620) - lu(k,628) = lu(k,628) - lu(k,424) * lu(k,620) - lu(k,629) = lu(k,629) - lu(k,425) * lu(k,620) - lu(k,639) = lu(k,639) - lu(k,417) * lu(k,638) - lu(k,640) = lu(k,640) - lu(k,418) * lu(k,638) - lu(k,641) = lu(k,641) - lu(k,419) * lu(k,638) - lu(k,642) = lu(k,642) - lu(k,420) * lu(k,638) - lu(k,643) = lu(k,643) - lu(k,421) * lu(k,638) - lu(k,644) = lu(k,644) - lu(k,422) * lu(k,638) - lu(k,645) = lu(k,645) - lu(k,423) * lu(k,638) - lu(k,646) = lu(k,646) - lu(k,424) * lu(k,638) - lu(k,647) = lu(k,647) - lu(k,425) * lu(k,638) - lu(k,442) = 1._r8 / lu(k,442) - lu(k,443) = lu(k,443) * lu(k,442) - lu(k,444) = lu(k,444) * lu(k,442) - lu(k,445) = lu(k,445) * lu(k,442) - lu(k,446) = lu(k,446) * lu(k,442) - lu(k,447) = lu(k,447) * lu(k,442) - lu(k,448) = lu(k,448) * lu(k,442) - lu(k,449) = lu(k,449) * lu(k,442) - lu(k,450) = lu(k,450) * lu(k,442) - lu(k,463) = lu(k,463) - lu(k,443) * lu(k,462) - lu(k,464) = lu(k,464) - lu(k,444) * lu(k,462) - lu(k,465) = lu(k,465) - lu(k,445) * lu(k,462) - lu(k,466) = lu(k,466) - lu(k,446) * lu(k,462) - lu(k,467) = lu(k,467) - lu(k,447) * lu(k,462) - lu(k,468) = lu(k,468) - lu(k,448) * lu(k,462) - lu(k,469) = lu(k,469) - lu(k,449) * lu(k,462) - lu(k,470) = lu(k,470) - lu(k,450) * lu(k,462) - lu(k,482) = lu(k,482) - lu(k,443) * lu(k,481) - lu(k,483) = lu(k,483) - lu(k,444) * lu(k,481) - lu(k,484) = lu(k,484) - lu(k,445) * lu(k,481) - lu(k,485) = lu(k,485) - lu(k,446) * lu(k,481) - lu(k,486) = lu(k,486) - lu(k,447) * lu(k,481) - lu(k,487) = lu(k,487) - lu(k,448) * lu(k,481) - lu(k,488) = lu(k,488) - lu(k,449) * lu(k,481) - lu(k,489) = lu(k,489) - lu(k,450) * lu(k,481) - lu(k,507) = lu(k,507) - lu(k,443) * lu(k,506) - lu(k,508) = lu(k,508) - lu(k,444) * lu(k,506) - lu(k,509) = lu(k,509) - lu(k,445) * lu(k,506) - lu(k,510) = lu(k,510) - lu(k,446) * lu(k,506) - lu(k,511) = lu(k,511) - lu(k,447) * lu(k,506) - lu(k,512) = lu(k,512) - lu(k,448) * lu(k,506) - lu(k,513) = lu(k,513) - lu(k,449) * lu(k,506) - lu(k,514) = lu(k,514) - lu(k,450) * lu(k,506) - lu(k,538) = lu(k,538) - lu(k,443) * lu(k,537) - lu(k,539) = lu(k,539) - lu(k,444) * lu(k,537) - lu(k,540) = lu(k,540) - lu(k,445) * lu(k,537) - lu(k,541) = lu(k,541) - lu(k,446) * lu(k,537) - lu(k,542) = lu(k,542) - lu(k,447) * lu(k,537) - lu(k,543) = lu(k,543) - lu(k,448) * lu(k,537) - lu(k,544) = lu(k,544) - lu(k,449) * lu(k,537) - lu(k,545) = lu(k,545) - lu(k,450) * lu(k,537) - lu(k,563) = lu(k,563) - lu(k,443) * lu(k,562) - lu(k,564) = lu(k,564) - lu(k,444) * lu(k,562) - lu(k,565) = lu(k,565) - lu(k,445) * lu(k,562) - lu(k,566) = lu(k,566) - lu(k,446) * lu(k,562) - lu(k,567) = lu(k,567) - lu(k,447) * lu(k,562) - lu(k,568) = lu(k,568) - lu(k,448) * lu(k,562) - lu(k,569) = lu(k,569) - lu(k,449) * lu(k,562) - lu(k,570) = lu(k,570) - lu(k,450) * lu(k,562) - lu(k,602) = lu(k,602) - lu(k,443) * lu(k,601) - lu(k,603) = lu(k,603) - lu(k,444) * lu(k,601) - lu(k,604) = lu(k,604) - lu(k,445) * lu(k,601) - lu(k,605) = lu(k,605) - lu(k,446) * lu(k,601) - lu(k,606) = lu(k,606) - lu(k,447) * lu(k,601) - lu(k,607) = lu(k,607) - lu(k,448) * lu(k,601) - lu(k,608) = lu(k,608) - lu(k,449) * lu(k,601) - lu(k,609) = lu(k,609) - lu(k,450) * lu(k,601) - lu(k,622) = lu(k,622) - lu(k,443) * lu(k,621) - lu(k,623) = lu(k,623) - lu(k,444) * lu(k,621) - lu(k,624) = lu(k,624) - lu(k,445) * lu(k,621) - lu(k,625) = lu(k,625) - lu(k,446) * lu(k,621) - lu(k,626) = lu(k,626) - lu(k,447) * lu(k,621) - lu(k,627) = lu(k,627) - lu(k,448) * lu(k,621) - lu(k,628) = lu(k,628) - lu(k,449) * lu(k,621) - lu(k,629) = lu(k,629) - lu(k,450) * lu(k,621) - lu(k,640) = lu(k,640) - lu(k,443) * lu(k,639) - lu(k,641) = lu(k,641) - lu(k,444) * lu(k,639) - lu(k,642) = lu(k,642) - lu(k,445) * lu(k,639) - lu(k,643) = lu(k,643) - lu(k,446) * lu(k,639) - lu(k,644) = lu(k,644) - lu(k,447) * lu(k,639) - lu(k,645) = lu(k,645) - lu(k,448) * lu(k,639) - lu(k,646) = lu(k,646) - lu(k,449) * lu(k,639) - lu(k,647) = lu(k,647) - lu(k,450) * lu(k,639) + lu(k,341) = 1._r8 / lu(k,341) + lu(k,342) = lu(k,342) * lu(k,341) + lu(k,343) = lu(k,343) * lu(k,341) + lu(k,344) = lu(k,344) * lu(k,341) + lu(k,345) = lu(k,345) * lu(k,341) + lu(k,346) = lu(k,346) * lu(k,341) + lu(k,347) = lu(k,347) * lu(k,341) + lu(k,348) = lu(k,348) * lu(k,341) + lu(k,349) = lu(k,349) * lu(k,341) + lu(k,350) = lu(k,350) * lu(k,341) + lu(k,351) = lu(k,351) * lu(k,341) + lu(k,352) = lu(k,352) * lu(k,341) + lu(k,353) = lu(k,353) * lu(k,341) + lu(k,362) = lu(k,362) - lu(k,342) * lu(k,361) + lu(k,363) = lu(k,363) - lu(k,343) * lu(k,361) + lu(k,364) = lu(k,364) - lu(k,344) * lu(k,361) + lu(k,365) = lu(k,365) - lu(k,345) * lu(k,361) + lu(k,366) = lu(k,366) - lu(k,346) * lu(k,361) + lu(k,367) = lu(k,367) - lu(k,347) * lu(k,361) + lu(k,368) = lu(k,368) - lu(k,348) * lu(k,361) + lu(k,369) = lu(k,369) - lu(k,349) * lu(k,361) + lu(k,370) = lu(k,370) - lu(k,350) * lu(k,361) + lu(k,371) = lu(k,371) - lu(k,351) * lu(k,361) + lu(k,372) = lu(k,372) - lu(k,352) * lu(k,361) + lu(k,373) = lu(k,373) - lu(k,353) * lu(k,361) + lu(k,384) = lu(k,384) - lu(k,342) * lu(k,383) + lu(k,385) = lu(k,385) - lu(k,343) * lu(k,383) + lu(k,386) = lu(k,386) - lu(k,344) * lu(k,383) + lu(k,387) = lu(k,387) - lu(k,345) * lu(k,383) + lu(k,388) = lu(k,388) - lu(k,346) * lu(k,383) + lu(k,389) = lu(k,389) - lu(k,347) * lu(k,383) + lu(k,390) = lu(k,390) - lu(k,348) * lu(k,383) + lu(k,391) = lu(k,391) - lu(k,349) * lu(k,383) + lu(k,392) = lu(k,392) - lu(k,350) * lu(k,383) + lu(k,393) = lu(k,393) - lu(k,351) * lu(k,383) + lu(k,394) = lu(k,394) - lu(k,352) * lu(k,383) + lu(k,395) = lu(k,395) - lu(k,353) * lu(k,383) + lu(k,409) = lu(k,409) - lu(k,342) * lu(k,408) + lu(k,410) = lu(k,410) - lu(k,343) * lu(k,408) + lu(k,411) = lu(k,411) - lu(k,344) * lu(k,408) + lu(k,412) = lu(k,412) - lu(k,345) * lu(k,408) + lu(k,413) = lu(k,413) - lu(k,346) * lu(k,408) + lu(k,414) = lu(k,414) - lu(k,347) * lu(k,408) + lu(k,415) = lu(k,415) - lu(k,348) * lu(k,408) + lu(k,416) = lu(k,416) - lu(k,349) * lu(k,408) + lu(k,417) = lu(k,417) - lu(k,350) * lu(k,408) + lu(k,418) = lu(k,418) - lu(k,351) * lu(k,408) + lu(k,419) = lu(k,419) - lu(k,352) * lu(k,408) + lu(k,420) = lu(k,420) - lu(k,353) * lu(k,408) + lu(k,434) = lu(k,434) - lu(k,342) * lu(k,433) + lu(k,435) = lu(k,435) - lu(k,343) * lu(k,433) + lu(k,436) = lu(k,436) - lu(k,344) * lu(k,433) + lu(k,437) = lu(k,437) - lu(k,345) * lu(k,433) + lu(k,438) = lu(k,438) - lu(k,346) * lu(k,433) + lu(k,439) = lu(k,439) - lu(k,347) * lu(k,433) + lu(k,440) = lu(k,440) - lu(k,348) * lu(k,433) + lu(k,441) = lu(k,441) - lu(k,349) * lu(k,433) + lu(k,442) = lu(k,442) - lu(k,350) * lu(k,433) + lu(k,443) = lu(k,443) - lu(k,351) * lu(k,433) + lu(k,444) = lu(k,444) - lu(k,352) * lu(k,433) + lu(k,445) = lu(k,445) - lu(k,353) * lu(k,433) + lu(k,460) = lu(k,460) - lu(k,342) * lu(k,459) + lu(k,461) = lu(k,461) - lu(k,343) * lu(k,459) + lu(k,462) = lu(k,462) - lu(k,344) * lu(k,459) + lu(k,463) = lu(k,463) - lu(k,345) * lu(k,459) + lu(k,464) = lu(k,464) - lu(k,346) * lu(k,459) + lu(k,465) = lu(k,465) - lu(k,347) * lu(k,459) + lu(k,466) = lu(k,466) - lu(k,348) * lu(k,459) + lu(k,467) = lu(k,467) - lu(k,349) * lu(k,459) + lu(k,468) = lu(k,468) - lu(k,350) * lu(k,459) + lu(k,469) = lu(k,469) - lu(k,351) * lu(k,459) + lu(k,470) = lu(k,470) - lu(k,352) * lu(k,459) + lu(k,471) = lu(k,471) - lu(k,353) * lu(k,459) + lu(k,483) = lu(k,483) - lu(k,342) * lu(k,482) + lu(k,484) = lu(k,484) - lu(k,343) * lu(k,482) + lu(k,485) = lu(k,485) - lu(k,344) * lu(k,482) + lu(k,486) = lu(k,486) - lu(k,345) * lu(k,482) + lu(k,487) = lu(k,487) - lu(k,346) * lu(k,482) + lu(k,488) = lu(k,488) - lu(k,347) * lu(k,482) + lu(k,489) = lu(k,489) - lu(k,348) * lu(k,482) + lu(k,490) = lu(k,490) - lu(k,349) * lu(k,482) + lu(k,491) = lu(k,491) - lu(k,350) * lu(k,482) + lu(k,492) = lu(k,492) - lu(k,351) * lu(k,482) + lu(k,493) = lu(k,493) - lu(k,352) * lu(k,482) + lu(k,494) = lu(k,494) - lu(k,353) * lu(k,482) + lu(k,504) = lu(k,504) - lu(k,342) * lu(k,503) + lu(k,505) = lu(k,505) - lu(k,343) * lu(k,503) + lu(k,506) = lu(k,506) - lu(k,344) * lu(k,503) + lu(k,507) = lu(k,507) - lu(k,345) * lu(k,503) + lu(k,508) = lu(k,508) - lu(k,346) * lu(k,503) + lu(k,509) = lu(k,509) - lu(k,347) * lu(k,503) + lu(k,510) = lu(k,510) - lu(k,348) * lu(k,503) + lu(k,511) = lu(k,511) - lu(k,349) * lu(k,503) + lu(k,512) = lu(k,512) - lu(k,350) * lu(k,503) + lu(k,513) = lu(k,513) - lu(k,351) * lu(k,503) + lu(k,514) = lu(k,514) - lu(k,352) * lu(k,503) + lu(k,515) = lu(k,515) - lu(k,353) * lu(k,503) + lu(k,535) = lu(k,535) - lu(k,342) * lu(k,534) + lu(k,536) = lu(k,536) - lu(k,343) * lu(k,534) + lu(k,537) = lu(k,537) - lu(k,344) * lu(k,534) + lu(k,538) = lu(k,538) - lu(k,345) * lu(k,534) + lu(k,539) = lu(k,539) - lu(k,346) * lu(k,534) + lu(k,540) = lu(k,540) - lu(k,347) * lu(k,534) + lu(k,541) = lu(k,541) - lu(k,348) * lu(k,534) + lu(k,542) = lu(k,542) - lu(k,349) * lu(k,534) + lu(k,543) = lu(k,543) - lu(k,350) * lu(k,534) + lu(k,544) = lu(k,544) - lu(k,351) * lu(k,534) + lu(k,545) = lu(k,545) - lu(k,352) * lu(k,534) + lu(k,546) = lu(k,546) - lu(k,353) * lu(k,534) + lu(k,554) = lu(k,554) - lu(k,342) * lu(k,553) + lu(k,555) = lu(k,555) - lu(k,343) * lu(k,553) + lu(k,556) = lu(k,556) - lu(k,344) * lu(k,553) + lu(k,557) = lu(k,557) - lu(k,345) * lu(k,553) + lu(k,558) = lu(k,558) - lu(k,346) * lu(k,553) + lu(k,559) = lu(k,559) - lu(k,347) * lu(k,553) + lu(k,560) = lu(k,560) - lu(k,348) * lu(k,553) + lu(k,561) = lu(k,561) - lu(k,349) * lu(k,553) + lu(k,562) = lu(k,562) - lu(k,350) * lu(k,553) + lu(k,563) = lu(k,563) - lu(k,351) * lu(k,553) + lu(k,564) = lu(k,564) - lu(k,352) * lu(k,553) + lu(k,565) = lu(k,565) - lu(k,353) * lu(k,553) + lu(k,579) = lu(k,579) - lu(k,342) * lu(k,578) + lu(k,580) = lu(k,580) - lu(k,343) * lu(k,578) + lu(k,581) = lu(k,581) - lu(k,344) * lu(k,578) + lu(k,582) = lu(k,582) - lu(k,345) * lu(k,578) + lu(k,583) = lu(k,583) - lu(k,346) * lu(k,578) + lu(k,584) = lu(k,584) - lu(k,347) * lu(k,578) + lu(k,585) = lu(k,585) - lu(k,348) * lu(k,578) + lu(k,586) = lu(k,586) - lu(k,349) * lu(k,578) + lu(k,587) = lu(k,587) - lu(k,350) * lu(k,578) + lu(k,588) = lu(k,588) - lu(k,351) * lu(k,578) + lu(k,589) = lu(k,589) - lu(k,352) * lu(k,578) + lu(k,590) = lu(k,590) - lu(k,353) * lu(k,578) + lu(k,597) = lu(k,597) - lu(k,342) * lu(k,596) + lu(k,598) = lu(k,598) - lu(k,343) * lu(k,596) + lu(k,599) = lu(k,599) - lu(k,344) * lu(k,596) + lu(k,600) = lu(k,600) - lu(k,345) * lu(k,596) + lu(k,601) = lu(k,601) - lu(k,346) * lu(k,596) + lu(k,602) = lu(k,602) - lu(k,347) * lu(k,596) + lu(k,603) = lu(k,603) - lu(k,348) * lu(k,596) + lu(k,604) = lu(k,604) - lu(k,349) * lu(k,596) + lu(k,605) = lu(k,605) - lu(k,350) * lu(k,596) + lu(k,606) = lu(k,606) - lu(k,351) * lu(k,596) + lu(k,607) = lu(k,607) - lu(k,352) * lu(k,596) + lu(k,608) = lu(k,608) - lu(k,353) * lu(k,596) + lu(k,636) = lu(k,636) - lu(k,342) * lu(k,635) + lu(k,637) = lu(k,637) - lu(k,343) * lu(k,635) + lu(k,638) = lu(k,638) - lu(k,344) * lu(k,635) + lu(k,639) = lu(k,639) - lu(k,345) * lu(k,635) + lu(k,640) = lu(k,640) - lu(k,346) * lu(k,635) + lu(k,641) = lu(k,641) - lu(k,347) * lu(k,635) + lu(k,642) = lu(k,642) - lu(k,348) * lu(k,635) + lu(k,643) = lu(k,643) - lu(k,349) * lu(k,635) + lu(k,644) = lu(k,644) - lu(k,350) * lu(k,635) + lu(k,645) = lu(k,645) - lu(k,351) * lu(k,635) + lu(k,646) = lu(k,646) - lu(k,352) * lu(k,635) + lu(k,647) = lu(k,647) - lu(k,353) * lu(k,635) + lu(k,362) = 1._r8 / lu(k,362) + lu(k,363) = lu(k,363) * lu(k,362) + lu(k,364) = lu(k,364) * lu(k,362) + lu(k,365) = lu(k,365) * lu(k,362) + lu(k,366) = lu(k,366) * lu(k,362) + lu(k,367) = lu(k,367) * lu(k,362) + lu(k,368) = lu(k,368) * lu(k,362) + lu(k,369) = lu(k,369) * lu(k,362) + lu(k,370) = lu(k,370) * lu(k,362) + lu(k,371) = lu(k,371) * lu(k,362) + lu(k,372) = lu(k,372) * lu(k,362) + lu(k,373) = lu(k,373) * lu(k,362) + lu(k,385) = lu(k,385) - lu(k,363) * lu(k,384) + lu(k,386) = lu(k,386) - lu(k,364) * lu(k,384) + lu(k,387) = lu(k,387) - lu(k,365) * lu(k,384) + lu(k,388) = lu(k,388) - lu(k,366) * lu(k,384) + lu(k,389) = lu(k,389) - lu(k,367) * lu(k,384) + lu(k,390) = lu(k,390) - lu(k,368) * lu(k,384) + lu(k,391) = lu(k,391) - lu(k,369) * lu(k,384) + lu(k,392) = lu(k,392) - lu(k,370) * lu(k,384) + lu(k,393) = lu(k,393) - lu(k,371) * lu(k,384) + lu(k,394) = lu(k,394) - lu(k,372) * lu(k,384) + lu(k,395) = lu(k,395) - lu(k,373) * lu(k,384) + lu(k,410) = lu(k,410) - lu(k,363) * lu(k,409) + lu(k,411) = lu(k,411) - lu(k,364) * lu(k,409) + lu(k,412) = lu(k,412) - lu(k,365) * lu(k,409) + lu(k,413) = lu(k,413) - lu(k,366) * lu(k,409) + lu(k,414) = lu(k,414) - lu(k,367) * lu(k,409) + lu(k,415) = lu(k,415) - lu(k,368) * lu(k,409) + lu(k,416) = lu(k,416) - lu(k,369) * lu(k,409) + lu(k,417) = lu(k,417) - lu(k,370) * lu(k,409) + lu(k,418) = lu(k,418) - lu(k,371) * lu(k,409) + lu(k,419) = lu(k,419) - lu(k,372) * lu(k,409) + lu(k,420) = lu(k,420) - lu(k,373) * lu(k,409) + lu(k,435) = lu(k,435) - lu(k,363) * lu(k,434) + lu(k,436) = lu(k,436) - lu(k,364) * lu(k,434) + lu(k,437) = lu(k,437) - lu(k,365) * lu(k,434) + lu(k,438) = lu(k,438) - lu(k,366) * lu(k,434) + lu(k,439) = lu(k,439) - lu(k,367) * lu(k,434) + lu(k,440) = lu(k,440) - lu(k,368) * lu(k,434) + lu(k,441) = lu(k,441) - lu(k,369) * lu(k,434) + lu(k,442) = lu(k,442) - lu(k,370) * lu(k,434) + lu(k,443) = lu(k,443) - lu(k,371) * lu(k,434) + lu(k,444) = lu(k,444) - lu(k,372) * lu(k,434) + lu(k,445) = lu(k,445) - lu(k,373) * lu(k,434) + lu(k,461) = lu(k,461) - lu(k,363) * lu(k,460) + lu(k,462) = lu(k,462) - lu(k,364) * lu(k,460) + lu(k,463) = lu(k,463) - lu(k,365) * lu(k,460) + lu(k,464) = lu(k,464) - lu(k,366) * lu(k,460) + lu(k,465) = lu(k,465) - lu(k,367) * lu(k,460) + lu(k,466) = lu(k,466) - lu(k,368) * lu(k,460) + lu(k,467) = lu(k,467) - lu(k,369) * lu(k,460) + lu(k,468) = lu(k,468) - lu(k,370) * lu(k,460) + lu(k,469) = lu(k,469) - lu(k,371) * lu(k,460) + lu(k,470) = lu(k,470) - lu(k,372) * lu(k,460) + lu(k,471) = lu(k,471) - lu(k,373) * lu(k,460) + lu(k,484) = lu(k,484) - lu(k,363) * lu(k,483) + lu(k,485) = lu(k,485) - lu(k,364) * lu(k,483) + lu(k,486) = lu(k,486) - lu(k,365) * lu(k,483) + lu(k,487) = lu(k,487) - lu(k,366) * lu(k,483) + lu(k,488) = lu(k,488) - lu(k,367) * lu(k,483) + lu(k,489) = lu(k,489) - lu(k,368) * lu(k,483) + lu(k,490) = lu(k,490) - lu(k,369) * lu(k,483) + lu(k,491) = lu(k,491) - lu(k,370) * lu(k,483) + lu(k,492) = lu(k,492) - lu(k,371) * lu(k,483) + lu(k,493) = lu(k,493) - lu(k,372) * lu(k,483) + lu(k,494) = lu(k,494) - lu(k,373) * lu(k,483) + lu(k,505) = lu(k,505) - lu(k,363) * lu(k,504) + lu(k,506) = lu(k,506) - lu(k,364) * lu(k,504) + lu(k,507) = lu(k,507) - lu(k,365) * lu(k,504) + lu(k,508) = lu(k,508) - lu(k,366) * lu(k,504) + lu(k,509) = lu(k,509) - lu(k,367) * lu(k,504) + lu(k,510) = lu(k,510) - lu(k,368) * lu(k,504) + lu(k,511) = lu(k,511) - lu(k,369) * lu(k,504) + lu(k,512) = lu(k,512) - lu(k,370) * lu(k,504) + lu(k,513) = lu(k,513) - lu(k,371) * lu(k,504) + lu(k,514) = lu(k,514) - lu(k,372) * lu(k,504) + lu(k,515) = lu(k,515) - lu(k,373) * lu(k,504) + lu(k,536) = lu(k,536) - lu(k,363) * lu(k,535) + lu(k,537) = lu(k,537) - lu(k,364) * lu(k,535) + lu(k,538) = lu(k,538) - lu(k,365) * lu(k,535) + lu(k,539) = lu(k,539) - lu(k,366) * lu(k,535) + lu(k,540) = lu(k,540) - lu(k,367) * lu(k,535) + lu(k,541) = lu(k,541) - lu(k,368) * lu(k,535) + lu(k,542) = lu(k,542) - lu(k,369) * lu(k,535) + lu(k,543) = lu(k,543) - lu(k,370) * lu(k,535) + lu(k,544) = lu(k,544) - lu(k,371) * lu(k,535) + lu(k,545) = lu(k,545) - lu(k,372) * lu(k,535) + lu(k,546) = lu(k,546) - lu(k,373) * lu(k,535) + lu(k,555) = lu(k,555) - lu(k,363) * lu(k,554) + lu(k,556) = lu(k,556) - lu(k,364) * lu(k,554) + lu(k,557) = lu(k,557) - lu(k,365) * lu(k,554) + lu(k,558) = lu(k,558) - lu(k,366) * lu(k,554) + lu(k,559) = lu(k,559) - lu(k,367) * lu(k,554) + lu(k,560) = lu(k,560) - lu(k,368) * lu(k,554) + lu(k,561) = lu(k,561) - lu(k,369) * lu(k,554) + lu(k,562) = lu(k,562) - lu(k,370) * lu(k,554) + lu(k,563) = lu(k,563) - lu(k,371) * lu(k,554) + lu(k,564) = lu(k,564) - lu(k,372) * lu(k,554) + lu(k,565) = lu(k,565) - lu(k,373) * lu(k,554) + lu(k,580) = lu(k,580) - lu(k,363) * lu(k,579) + lu(k,581) = lu(k,581) - lu(k,364) * lu(k,579) + lu(k,582) = lu(k,582) - lu(k,365) * lu(k,579) + lu(k,583) = lu(k,583) - lu(k,366) * lu(k,579) + lu(k,584) = lu(k,584) - lu(k,367) * lu(k,579) + lu(k,585) = lu(k,585) - lu(k,368) * lu(k,579) + lu(k,586) = lu(k,586) - lu(k,369) * lu(k,579) + lu(k,587) = lu(k,587) - lu(k,370) * lu(k,579) + lu(k,588) = lu(k,588) - lu(k,371) * lu(k,579) + lu(k,589) = lu(k,589) - lu(k,372) * lu(k,579) + lu(k,590) = lu(k,590) - lu(k,373) * lu(k,579) + lu(k,598) = lu(k,598) - lu(k,363) * lu(k,597) + lu(k,599) = lu(k,599) - lu(k,364) * lu(k,597) + lu(k,600) = lu(k,600) - lu(k,365) * lu(k,597) + lu(k,601) = lu(k,601) - lu(k,366) * lu(k,597) + lu(k,602) = lu(k,602) - lu(k,367) * lu(k,597) + lu(k,603) = lu(k,603) - lu(k,368) * lu(k,597) + lu(k,604) = lu(k,604) - lu(k,369) * lu(k,597) + lu(k,605) = lu(k,605) - lu(k,370) * lu(k,597) + lu(k,606) = lu(k,606) - lu(k,371) * lu(k,597) + lu(k,607) = lu(k,607) - lu(k,372) * lu(k,597) + lu(k,608) = lu(k,608) - lu(k,373) * lu(k,597) + lu(k,637) = lu(k,637) - lu(k,363) * lu(k,636) + lu(k,638) = lu(k,638) - lu(k,364) * lu(k,636) + lu(k,639) = lu(k,639) - lu(k,365) * lu(k,636) + lu(k,640) = lu(k,640) - lu(k,366) * lu(k,636) + lu(k,641) = lu(k,641) - lu(k,367) * lu(k,636) + lu(k,642) = lu(k,642) - lu(k,368) * lu(k,636) + lu(k,643) = lu(k,643) - lu(k,369) * lu(k,636) + lu(k,644) = lu(k,644) - lu(k,370) * lu(k,636) + lu(k,645) = lu(k,645) - lu(k,371) * lu(k,636) + lu(k,646) = lu(k,646) - lu(k,372) * lu(k,636) + lu(k,647) = lu(k,647) - lu(k,373) * lu(k,636) + lu(k,385) = 1._r8 / lu(k,385) + lu(k,386) = lu(k,386) * lu(k,385) + lu(k,387) = lu(k,387) * lu(k,385) + lu(k,388) = lu(k,388) * lu(k,385) + lu(k,389) = lu(k,389) * lu(k,385) + lu(k,390) = lu(k,390) * lu(k,385) + lu(k,391) = lu(k,391) * lu(k,385) + lu(k,392) = lu(k,392) * lu(k,385) + lu(k,393) = lu(k,393) * lu(k,385) + lu(k,394) = lu(k,394) * lu(k,385) + lu(k,395) = lu(k,395) * lu(k,385) + lu(k,411) = lu(k,411) - lu(k,386) * lu(k,410) + lu(k,412) = lu(k,412) - lu(k,387) * lu(k,410) + lu(k,413) = lu(k,413) - lu(k,388) * lu(k,410) + lu(k,414) = lu(k,414) - lu(k,389) * lu(k,410) + lu(k,415) = lu(k,415) - lu(k,390) * lu(k,410) + lu(k,416) = lu(k,416) - lu(k,391) * lu(k,410) + lu(k,417) = lu(k,417) - lu(k,392) * lu(k,410) + lu(k,418) = lu(k,418) - lu(k,393) * lu(k,410) + lu(k,419) = lu(k,419) - lu(k,394) * lu(k,410) + lu(k,420) = lu(k,420) - lu(k,395) * lu(k,410) + lu(k,436) = lu(k,436) - lu(k,386) * lu(k,435) + lu(k,437) = lu(k,437) - lu(k,387) * lu(k,435) + lu(k,438) = lu(k,438) - lu(k,388) * lu(k,435) + lu(k,439) = lu(k,439) - lu(k,389) * lu(k,435) + lu(k,440) = lu(k,440) - lu(k,390) * lu(k,435) + lu(k,441) = lu(k,441) - lu(k,391) * lu(k,435) + lu(k,442) = lu(k,442) - lu(k,392) * lu(k,435) + lu(k,443) = lu(k,443) - lu(k,393) * lu(k,435) + lu(k,444) = lu(k,444) - lu(k,394) * lu(k,435) + lu(k,445) = lu(k,445) - lu(k,395) * lu(k,435) + lu(k,462) = lu(k,462) - lu(k,386) * lu(k,461) + lu(k,463) = lu(k,463) - lu(k,387) * lu(k,461) + lu(k,464) = lu(k,464) - lu(k,388) * lu(k,461) + lu(k,465) = lu(k,465) - lu(k,389) * lu(k,461) + lu(k,466) = lu(k,466) - lu(k,390) * lu(k,461) + lu(k,467) = lu(k,467) - lu(k,391) * lu(k,461) + lu(k,468) = lu(k,468) - lu(k,392) * lu(k,461) + lu(k,469) = lu(k,469) - lu(k,393) * lu(k,461) + lu(k,470) = lu(k,470) - lu(k,394) * lu(k,461) + lu(k,471) = lu(k,471) - lu(k,395) * lu(k,461) + lu(k,485) = lu(k,485) - lu(k,386) * lu(k,484) + lu(k,486) = lu(k,486) - lu(k,387) * lu(k,484) + lu(k,487) = lu(k,487) - lu(k,388) * lu(k,484) + lu(k,488) = lu(k,488) - lu(k,389) * lu(k,484) + lu(k,489) = lu(k,489) - lu(k,390) * lu(k,484) + lu(k,490) = lu(k,490) - lu(k,391) * lu(k,484) + lu(k,491) = lu(k,491) - lu(k,392) * lu(k,484) + lu(k,492) = lu(k,492) - lu(k,393) * lu(k,484) + lu(k,493) = lu(k,493) - lu(k,394) * lu(k,484) + lu(k,494) = lu(k,494) - lu(k,395) * lu(k,484) + lu(k,506) = lu(k,506) - lu(k,386) * lu(k,505) + lu(k,507) = lu(k,507) - lu(k,387) * lu(k,505) + lu(k,508) = lu(k,508) - lu(k,388) * lu(k,505) + lu(k,509) = lu(k,509) - lu(k,389) * lu(k,505) + lu(k,510) = lu(k,510) - lu(k,390) * lu(k,505) + lu(k,511) = lu(k,511) - lu(k,391) * lu(k,505) + lu(k,512) = lu(k,512) - lu(k,392) * lu(k,505) + lu(k,513) = lu(k,513) - lu(k,393) * lu(k,505) + lu(k,514) = lu(k,514) - lu(k,394) * lu(k,505) + lu(k,515) = lu(k,515) - lu(k,395) * lu(k,505) + lu(k,537) = lu(k,537) - lu(k,386) * lu(k,536) + lu(k,538) = lu(k,538) - lu(k,387) * lu(k,536) + lu(k,539) = lu(k,539) - lu(k,388) * lu(k,536) + lu(k,540) = lu(k,540) - lu(k,389) * lu(k,536) + lu(k,541) = lu(k,541) - lu(k,390) * lu(k,536) + lu(k,542) = lu(k,542) - lu(k,391) * lu(k,536) + lu(k,543) = lu(k,543) - lu(k,392) * lu(k,536) + lu(k,544) = lu(k,544) - lu(k,393) * lu(k,536) + lu(k,545) = lu(k,545) - lu(k,394) * lu(k,536) + lu(k,546) = lu(k,546) - lu(k,395) * lu(k,536) + lu(k,556) = lu(k,556) - lu(k,386) * lu(k,555) + lu(k,557) = lu(k,557) - lu(k,387) * lu(k,555) + lu(k,558) = lu(k,558) - lu(k,388) * lu(k,555) + lu(k,559) = lu(k,559) - lu(k,389) * lu(k,555) + lu(k,560) = lu(k,560) - lu(k,390) * lu(k,555) + lu(k,561) = lu(k,561) - lu(k,391) * lu(k,555) + lu(k,562) = lu(k,562) - lu(k,392) * lu(k,555) + lu(k,563) = lu(k,563) - lu(k,393) * lu(k,555) + lu(k,564) = lu(k,564) - lu(k,394) * lu(k,555) + lu(k,565) = lu(k,565) - lu(k,395) * lu(k,555) + lu(k,581) = lu(k,581) - lu(k,386) * lu(k,580) + lu(k,582) = lu(k,582) - lu(k,387) * lu(k,580) + lu(k,583) = lu(k,583) - lu(k,388) * lu(k,580) + lu(k,584) = lu(k,584) - lu(k,389) * lu(k,580) + lu(k,585) = lu(k,585) - lu(k,390) * lu(k,580) + lu(k,586) = lu(k,586) - lu(k,391) * lu(k,580) + lu(k,587) = lu(k,587) - lu(k,392) * lu(k,580) + lu(k,588) = lu(k,588) - lu(k,393) * lu(k,580) + lu(k,589) = lu(k,589) - lu(k,394) * lu(k,580) + lu(k,590) = lu(k,590) - lu(k,395) * lu(k,580) + lu(k,599) = lu(k,599) - lu(k,386) * lu(k,598) + lu(k,600) = lu(k,600) - lu(k,387) * lu(k,598) + lu(k,601) = lu(k,601) - lu(k,388) * lu(k,598) + lu(k,602) = lu(k,602) - lu(k,389) * lu(k,598) + lu(k,603) = lu(k,603) - lu(k,390) * lu(k,598) + lu(k,604) = lu(k,604) - lu(k,391) * lu(k,598) + lu(k,605) = lu(k,605) - lu(k,392) * lu(k,598) + lu(k,606) = lu(k,606) - lu(k,393) * lu(k,598) + lu(k,607) = lu(k,607) - lu(k,394) * lu(k,598) + lu(k,608) = lu(k,608) - lu(k,395) * lu(k,598) + lu(k,638) = lu(k,638) - lu(k,386) * lu(k,637) + lu(k,639) = lu(k,639) - lu(k,387) * lu(k,637) + lu(k,640) = lu(k,640) - lu(k,388) * lu(k,637) + lu(k,641) = lu(k,641) - lu(k,389) * lu(k,637) + lu(k,642) = lu(k,642) - lu(k,390) * lu(k,637) + lu(k,643) = lu(k,643) - lu(k,391) * lu(k,637) + lu(k,644) = lu(k,644) - lu(k,392) * lu(k,637) + lu(k,645) = lu(k,645) - lu(k,393) * lu(k,637) + lu(k,646) = lu(k,646) - lu(k,394) * lu(k,637) + lu(k,647) = lu(k,647) - lu(k,395) * lu(k,637) + lu(k,411) = 1._r8 / lu(k,411) + lu(k,412) = lu(k,412) * lu(k,411) + lu(k,413) = lu(k,413) * lu(k,411) + lu(k,414) = lu(k,414) * lu(k,411) + lu(k,415) = lu(k,415) * lu(k,411) + lu(k,416) = lu(k,416) * lu(k,411) + lu(k,417) = lu(k,417) * lu(k,411) + lu(k,418) = lu(k,418) * lu(k,411) + lu(k,419) = lu(k,419) * lu(k,411) + lu(k,420) = lu(k,420) * lu(k,411) + lu(k,437) = lu(k,437) - lu(k,412) * lu(k,436) + lu(k,438) = lu(k,438) - lu(k,413) * lu(k,436) + lu(k,439) = lu(k,439) - lu(k,414) * lu(k,436) + lu(k,440) = lu(k,440) - lu(k,415) * lu(k,436) + lu(k,441) = lu(k,441) - lu(k,416) * lu(k,436) + lu(k,442) = lu(k,442) - lu(k,417) * lu(k,436) + lu(k,443) = lu(k,443) - lu(k,418) * lu(k,436) + lu(k,444) = lu(k,444) - lu(k,419) * lu(k,436) + lu(k,445) = lu(k,445) - lu(k,420) * lu(k,436) + lu(k,463) = lu(k,463) - lu(k,412) * lu(k,462) + lu(k,464) = lu(k,464) - lu(k,413) * lu(k,462) + lu(k,465) = lu(k,465) - lu(k,414) * lu(k,462) + lu(k,466) = lu(k,466) - lu(k,415) * lu(k,462) + lu(k,467) = lu(k,467) - lu(k,416) * lu(k,462) + lu(k,468) = lu(k,468) - lu(k,417) * lu(k,462) + lu(k,469) = lu(k,469) - lu(k,418) * lu(k,462) + lu(k,470) = lu(k,470) - lu(k,419) * lu(k,462) + lu(k,471) = lu(k,471) - lu(k,420) * lu(k,462) + lu(k,486) = lu(k,486) - lu(k,412) * lu(k,485) + lu(k,487) = lu(k,487) - lu(k,413) * lu(k,485) + lu(k,488) = lu(k,488) - lu(k,414) * lu(k,485) + lu(k,489) = lu(k,489) - lu(k,415) * lu(k,485) + lu(k,490) = lu(k,490) - lu(k,416) * lu(k,485) + lu(k,491) = lu(k,491) - lu(k,417) * lu(k,485) + lu(k,492) = lu(k,492) - lu(k,418) * lu(k,485) + lu(k,493) = lu(k,493) - lu(k,419) * lu(k,485) + lu(k,494) = lu(k,494) - lu(k,420) * lu(k,485) + lu(k,507) = lu(k,507) - lu(k,412) * lu(k,506) + lu(k,508) = lu(k,508) - lu(k,413) * lu(k,506) + lu(k,509) = lu(k,509) - lu(k,414) * lu(k,506) + lu(k,510) = lu(k,510) - lu(k,415) * lu(k,506) + lu(k,511) = lu(k,511) - lu(k,416) * lu(k,506) + lu(k,512) = lu(k,512) - lu(k,417) * lu(k,506) + lu(k,513) = lu(k,513) - lu(k,418) * lu(k,506) + lu(k,514) = lu(k,514) - lu(k,419) * lu(k,506) + lu(k,515) = lu(k,515) - lu(k,420) * lu(k,506) + lu(k,538) = lu(k,538) - lu(k,412) * lu(k,537) + lu(k,539) = lu(k,539) - lu(k,413) * lu(k,537) + lu(k,540) = lu(k,540) - lu(k,414) * lu(k,537) + lu(k,541) = lu(k,541) - lu(k,415) * lu(k,537) + lu(k,542) = lu(k,542) - lu(k,416) * lu(k,537) + lu(k,543) = lu(k,543) - lu(k,417) * lu(k,537) + lu(k,544) = lu(k,544) - lu(k,418) * lu(k,537) + lu(k,545) = lu(k,545) - lu(k,419) * lu(k,537) + lu(k,546) = lu(k,546) - lu(k,420) * lu(k,537) + lu(k,557) = lu(k,557) - lu(k,412) * lu(k,556) + lu(k,558) = lu(k,558) - lu(k,413) * lu(k,556) + lu(k,559) = lu(k,559) - lu(k,414) * lu(k,556) + lu(k,560) = lu(k,560) - lu(k,415) * lu(k,556) + lu(k,561) = lu(k,561) - lu(k,416) * lu(k,556) + lu(k,562) = lu(k,562) - lu(k,417) * lu(k,556) + lu(k,563) = lu(k,563) - lu(k,418) * lu(k,556) + lu(k,564) = lu(k,564) - lu(k,419) * lu(k,556) + lu(k,565) = lu(k,565) - lu(k,420) * lu(k,556) + lu(k,582) = lu(k,582) - lu(k,412) * lu(k,581) + lu(k,583) = lu(k,583) - lu(k,413) * lu(k,581) + lu(k,584) = lu(k,584) - lu(k,414) * lu(k,581) + lu(k,585) = lu(k,585) - lu(k,415) * lu(k,581) + lu(k,586) = lu(k,586) - lu(k,416) * lu(k,581) + lu(k,587) = lu(k,587) - lu(k,417) * lu(k,581) + lu(k,588) = lu(k,588) - lu(k,418) * lu(k,581) + lu(k,589) = lu(k,589) - lu(k,419) * lu(k,581) + lu(k,590) = lu(k,590) - lu(k,420) * lu(k,581) + lu(k,600) = lu(k,600) - lu(k,412) * lu(k,599) + lu(k,601) = lu(k,601) - lu(k,413) * lu(k,599) + lu(k,602) = lu(k,602) - lu(k,414) * lu(k,599) + lu(k,603) = lu(k,603) - lu(k,415) * lu(k,599) + lu(k,604) = lu(k,604) - lu(k,416) * lu(k,599) + lu(k,605) = lu(k,605) - lu(k,417) * lu(k,599) + lu(k,606) = lu(k,606) - lu(k,418) * lu(k,599) + lu(k,607) = lu(k,607) - lu(k,419) * lu(k,599) + lu(k,608) = lu(k,608) - lu(k,420) * lu(k,599) + lu(k,639) = lu(k,639) - lu(k,412) * lu(k,638) + lu(k,640) = lu(k,640) - lu(k,413) * lu(k,638) + lu(k,641) = lu(k,641) - lu(k,414) * lu(k,638) + lu(k,642) = lu(k,642) - lu(k,415) * lu(k,638) + lu(k,643) = lu(k,643) - lu(k,416) * lu(k,638) + lu(k,644) = lu(k,644) - lu(k,417) * lu(k,638) + lu(k,645) = lu(k,645) - lu(k,418) * lu(k,638) + lu(k,646) = lu(k,646) - lu(k,419) * lu(k,638) + lu(k,647) = lu(k,647) - lu(k,420) * lu(k,638) + lu(k,437) = 1._r8 / lu(k,437) + lu(k,438) = lu(k,438) * lu(k,437) + lu(k,439) = lu(k,439) * lu(k,437) + lu(k,440) = lu(k,440) * lu(k,437) + lu(k,441) = lu(k,441) * lu(k,437) + lu(k,442) = lu(k,442) * lu(k,437) + lu(k,443) = lu(k,443) * lu(k,437) + lu(k,444) = lu(k,444) * lu(k,437) + lu(k,445) = lu(k,445) * lu(k,437) + lu(k,464) = lu(k,464) - lu(k,438) * lu(k,463) + lu(k,465) = lu(k,465) - lu(k,439) * lu(k,463) + lu(k,466) = lu(k,466) - lu(k,440) * lu(k,463) + lu(k,467) = lu(k,467) - lu(k,441) * lu(k,463) + lu(k,468) = lu(k,468) - lu(k,442) * lu(k,463) + lu(k,469) = lu(k,469) - lu(k,443) * lu(k,463) + lu(k,470) = lu(k,470) - lu(k,444) * lu(k,463) + lu(k,471) = lu(k,471) - lu(k,445) * lu(k,463) + lu(k,487) = lu(k,487) - lu(k,438) * lu(k,486) + lu(k,488) = lu(k,488) - lu(k,439) * lu(k,486) + lu(k,489) = lu(k,489) - lu(k,440) * lu(k,486) + lu(k,490) = lu(k,490) - lu(k,441) * lu(k,486) + lu(k,491) = lu(k,491) - lu(k,442) * lu(k,486) + lu(k,492) = lu(k,492) - lu(k,443) * lu(k,486) + lu(k,493) = lu(k,493) - lu(k,444) * lu(k,486) + lu(k,494) = lu(k,494) - lu(k,445) * lu(k,486) + lu(k,508) = lu(k,508) - lu(k,438) * lu(k,507) + lu(k,509) = lu(k,509) - lu(k,439) * lu(k,507) + lu(k,510) = lu(k,510) - lu(k,440) * lu(k,507) + lu(k,511) = lu(k,511) - lu(k,441) * lu(k,507) + lu(k,512) = lu(k,512) - lu(k,442) * lu(k,507) + lu(k,513) = lu(k,513) - lu(k,443) * lu(k,507) + lu(k,514) = lu(k,514) - lu(k,444) * lu(k,507) + lu(k,515) = lu(k,515) - lu(k,445) * lu(k,507) + lu(k,539) = lu(k,539) - lu(k,438) * lu(k,538) + lu(k,540) = lu(k,540) - lu(k,439) * lu(k,538) + lu(k,541) = lu(k,541) - lu(k,440) * lu(k,538) + lu(k,542) = lu(k,542) - lu(k,441) * lu(k,538) + lu(k,543) = lu(k,543) - lu(k,442) * lu(k,538) + lu(k,544) = lu(k,544) - lu(k,443) * lu(k,538) + lu(k,545) = lu(k,545) - lu(k,444) * lu(k,538) + lu(k,546) = lu(k,546) - lu(k,445) * lu(k,538) + lu(k,558) = lu(k,558) - lu(k,438) * lu(k,557) + lu(k,559) = lu(k,559) - lu(k,439) * lu(k,557) + lu(k,560) = lu(k,560) - lu(k,440) * lu(k,557) + lu(k,561) = lu(k,561) - lu(k,441) * lu(k,557) + lu(k,562) = lu(k,562) - lu(k,442) * lu(k,557) + lu(k,563) = lu(k,563) - lu(k,443) * lu(k,557) + lu(k,564) = lu(k,564) - lu(k,444) * lu(k,557) + lu(k,565) = lu(k,565) - lu(k,445) * lu(k,557) + lu(k,583) = lu(k,583) - lu(k,438) * lu(k,582) + lu(k,584) = lu(k,584) - lu(k,439) * lu(k,582) + lu(k,585) = lu(k,585) - lu(k,440) * lu(k,582) + lu(k,586) = lu(k,586) - lu(k,441) * lu(k,582) + lu(k,587) = lu(k,587) - lu(k,442) * lu(k,582) + lu(k,588) = lu(k,588) - lu(k,443) * lu(k,582) + lu(k,589) = lu(k,589) - lu(k,444) * lu(k,582) + lu(k,590) = lu(k,590) - lu(k,445) * lu(k,582) + lu(k,601) = lu(k,601) - lu(k,438) * lu(k,600) + lu(k,602) = lu(k,602) - lu(k,439) * lu(k,600) + lu(k,603) = lu(k,603) - lu(k,440) * lu(k,600) + lu(k,604) = lu(k,604) - lu(k,441) * lu(k,600) + lu(k,605) = lu(k,605) - lu(k,442) * lu(k,600) + lu(k,606) = lu(k,606) - lu(k,443) * lu(k,600) + lu(k,607) = lu(k,607) - lu(k,444) * lu(k,600) + lu(k,608) = lu(k,608) - lu(k,445) * lu(k,600) + lu(k,640) = lu(k,640) - lu(k,438) * lu(k,639) + lu(k,641) = lu(k,641) - lu(k,439) * lu(k,639) + lu(k,642) = lu(k,642) - lu(k,440) * lu(k,639) + lu(k,643) = lu(k,643) - lu(k,441) * lu(k,639) + lu(k,644) = lu(k,644) - lu(k,442) * lu(k,639) + lu(k,645) = lu(k,645) - lu(k,443) * lu(k,639) + lu(k,646) = lu(k,646) - lu(k,444) * lu(k,639) + lu(k,647) = lu(k,647) - lu(k,445) * lu(k,639) end do end subroutine lu_fac08 subroutine lu_fac09( avec_len, lu ) @@ -2545,181 +2545,181 @@ subroutine lu_fac09( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,463) = 1._r8 / lu(k,463) - lu(k,464) = lu(k,464) * lu(k,463) - lu(k,465) = lu(k,465) * lu(k,463) - lu(k,466) = lu(k,466) * lu(k,463) - lu(k,467) = lu(k,467) * lu(k,463) - lu(k,468) = lu(k,468) * lu(k,463) - lu(k,469) = lu(k,469) * lu(k,463) - lu(k,470) = lu(k,470) * lu(k,463) - lu(k,483) = lu(k,483) - lu(k,464) * lu(k,482) - lu(k,484) = lu(k,484) - lu(k,465) * lu(k,482) - lu(k,485) = lu(k,485) - lu(k,466) * lu(k,482) - lu(k,486) = lu(k,486) - lu(k,467) * lu(k,482) - lu(k,487) = lu(k,487) - lu(k,468) * lu(k,482) - lu(k,488) = lu(k,488) - lu(k,469) * lu(k,482) - lu(k,489) = lu(k,489) - lu(k,470) * lu(k,482) - lu(k,508) = lu(k,508) - lu(k,464) * lu(k,507) - lu(k,509) = lu(k,509) - lu(k,465) * lu(k,507) - lu(k,510) = lu(k,510) - lu(k,466) * lu(k,507) - lu(k,511) = lu(k,511) - lu(k,467) * lu(k,507) - lu(k,512) = lu(k,512) - lu(k,468) * lu(k,507) - lu(k,513) = lu(k,513) - lu(k,469) * lu(k,507) - lu(k,514) = lu(k,514) - lu(k,470) * lu(k,507) - lu(k,539) = lu(k,539) - lu(k,464) * lu(k,538) - lu(k,540) = lu(k,540) - lu(k,465) * lu(k,538) - lu(k,541) = lu(k,541) - lu(k,466) * lu(k,538) - lu(k,542) = lu(k,542) - lu(k,467) * lu(k,538) - lu(k,543) = lu(k,543) - lu(k,468) * lu(k,538) - lu(k,544) = lu(k,544) - lu(k,469) * lu(k,538) - lu(k,545) = lu(k,545) - lu(k,470) * lu(k,538) - lu(k,564) = lu(k,564) - lu(k,464) * lu(k,563) - lu(k,565) = lu(k,565) - lu(k,465) * lu(k,563) - lu(k,566) = lu(k,566) - lu(k,466) * lu(k,563) - lu(k,567) = lu(k,567) - lu(k,467) * lu(k,563) - lu(k,568) = lu(k,568) - lu(k,468) * lu(k,563) - lu(k,569) = lu(k,569) - lu(k,469) * lu(k,563) - lu(k,570) = lu(k,570) - lu(k,470) * lu(k,563) - lu(k,603) = lu(k,603) - lu(k,464) * lu(k,602) - lu(k,604) = lu(k,604) - lu(k,465) * lu(k,602) - lu(k,605) = lu(k,605) - lu(k,466) * lu(k,602) - lu(k,606) = lu(k,606) - lu(k,467) * lu(k,602) - lu(k,607) = lu(k,607) - lu(k,468) * lu(k,602) - lu(k,608) = lu(k,608) - lu(k,469) * lu(k,602) - lu(k,609) = lu(k,609) - lu(k,470) * lu(k,602) - lu(k,623) = lu(k,623) - lu(k,464) * lu(k,622) - lu(k,624) = lu(k,624) - lu(k,465) * lu(k,622) - lu(k,625) = lu(k,625) - lu(k,466) * lu(k,622) - lu(k,626) = lu(k,626) - lu(k,467) * lu(k,622) - lu(k,627) = lu(k,627) - lu(k,468) * lu(k,622) - lu(k,628) = lu(k,628) - lu(k,469) * lu(k,622) - lu(k,629) = lu(k,629) - lu(k,470) * lu(k,622) - lu(k,641) = lu(k,641) - lu(k,464) * lu(k,640) - lu(k,642) = lu(k,642) - lu(k,465) * lu(k,640) - lu(k,643) = lu(k,643) - lu(k,466) * lu(k,640) - lu(k,644) = lu(k,644) - lu(k,467) * lu(k,640) - lu(k,645) = lu(k,645) - lu(k,468) * lu(k,640) - lu(k,646) = lu(k,646) - lu(k,469) * lu(k,640) - lu(k,647) = lu(k,647) - lu(k,470) * lu(k,640) - lu(k,483) = 1._r8 / lu(k,483) - lu(k,484) = lu(k,484) * lu(k,483) - lu(k,485) = lu(k,485) * lu(k,483) - lu(k,486) = lu(k,486) * lu(k,483) - lu(k,487) = lu(k,487) * lu(k,483) - lu(k,488) = lu(k,488) * lu(k,483) - lu(k,489) = lu(k,489) * lu(k,483) - lu(k,509) = lu(k,509) - lu(k,484) * lu(k,508) - lu(k,510) = lu(k,510) - lu(k,485) * lu(k,508) - lu(k,511) = lu(k,511) - lu(k,486) * lu(k,508) - lu(k,512) = lu(k,512) - lu(k,487) * lu(k,508) - lu(k,513) = lu(k,513) - lu(k,488) * lu(k,508) - lu(k,514) = lu(k,514) - lu(k,489) * lu(k,508) - lu(k,540) = lu(k,540) - lu(k,484) * lu(k,539) - lu(k,541) = lu(k,541) - lu(k,485) * lu(k,539) - lu(k,542) = lu(k,542) - lu(k,486) * lu(k,539) - lu(k,543) = lu(k,543) - lu(k,487) * lu(k,539) - lu(k,544) = lu(k,544) - lu(k,488) * lu(k,539) - lu(k,545) = lu(k,545) - lu(k,489) * lu(k,539) - lu(k,565) = lu(k,565) - lu(k,484) * lu(k,564) - lu(k,566) = lu(k,566) - lu(k,485) * lu(k,564) - lu(k,567) = lu(k,567) - lu(k,486) * lu(k,564) - lu(k,568) = lu(k,568) - lu(k,487) * lu(k,564) - lu(k,569) = lu(k,569) - lu(k,488) * lu(k,564) - lu(k,570) = lu(k,570) - lu(k,489) * lu(k,564) - lu(k,604) = lu(k,604) - lu(k,484) * lu(k,603) - lu(k,605) = lu(k,605) - lu(k,485) * lu(k,603) - lu(k,606) = lu(k,606) - lu(k,486) * lu(k,603) - lu(k,607) = lu(k,607) - lu(k,487) * lu(k,603) - lu(k,608) = lu(k,608) - lu(k,488) * lu(k,603) - lu(k,609) = lu(k,609) - lu(k,489) * lu(k,603) - lu(k,624) = lu(k,624) - lu(k,484) * lu(k,623) - lu(k,625) = lu(k,625) - lu(k,485) * lu(k,623) - lu(k,626) = lu(k,626) - lu(k,486) * lu(k,623) - lu(k,627) = lu(k,627) - lu(k,487) * lu(k,623) - lu(k,628) = lu(k,628) - lu(k,488) * lu(k,623) - lu(k,629) = lu(k,629) - lu(k,489) * lu(k,623) - lu(k,642) = lu(k,642) - lu(k,484) * lu(k,641) - lu(k,643) = lu(k,643) - lu(k,485) * lu(k,641) - lu(k,644) = lu(k,644) - lu(k,486) * lu(k,641) - lu(k,645) = lu(k,645) - lu(k,487) * lu(k,641) - lu(k,646) = lu(k,646) - lu(k,488) * lu(k,641) - lu(k,647) = lu(k,647) - lu(k,489) * lu(k,641) - lu(k,509) = 1._r8 / lu(k,509) - lu(k,510) = lu(k,510) * lu(k,509) - lu(k,511) = lu(k,511) * lu(k,509) - lu(k,512) = lu(k,512) * lu(k,509) - lu(k,513) = lu(k,513) * lu(k,509) - lu(k,514) = lu(k,514) * lu(k,509) - lu(k,541) = lu(k,541) - lu(k,510) * lu(k,540) - lu(k,542) = lu(k,542) - lu(k,511) * lu(k,540) - lu(k,543) = lu(k,543) - lu(k,512) * lu(k,540) - lu(k,544) = lu(k,544) - lu(k,513) * lu(k,540) - lu(k,545) = lu(k,545) - lu(k,514) * lu(k,540) - lu(k,566) = lu(k,566) - lu(k,510) * lu(k,565) - lu(k,567) = lu(k,567) - lu(k,511) * lu(k,565) - lu(k,568) = lu(k,568) - lu(k,512) * lu(k,565) - lu(k,569) = lu(k,569) - lu(k,513) * lu(k,565) - lu(k,570) = lu(k,570) - lu(k,514) * lu(k,565) - lu(k,605) = lu(k,605) - lu(k,510) * lu(k,604) - lu(k,606) = lu(k,606) - lu(k,511) * lu(k,604) - lu(k,607) = lu(k,607) - lu(k,512) * lu(k,604) - lu(k,608) = lu(k,608) - lu(k,513) * lu(k,604) - lu(k,609) = lu(k,609) - lu(k,514) * lu(k,604) - lu(k,625) = lu(k,625) - lu(k,510) * lu(k,624) - lu(k,626) = lu(k,626) - lu(k,511) * lu(k,624) - lu(k,627) = lu(k,627) - lu(k,512) * lu(k,624) - lu(k,628) = lu(k,628) - lu(k,513) * lu(k,624) - lu(k,629) = lu(k,629) - lu(k,514) * lu(k,624) - lu(k,643) = lu(k,643) - lu(k,510) * lu(k,642) - lu(k,644) = lu(k,644) - lu(k,511) * lu(k,642) - lu(k,645) = lu(k,645) - lu(k,512) * lu(k,642) - lu(k,646) = lu(k,646) - lu(k,513) * lu(k,642) - lu(k,647) = lu(k,647) - lu(k,514) * lu(k,642) - lu(k,541) = 1._r8 / lu(k,541) - lu(k,542) = lu(k,542) * lu(k,541) - lu(k,543) = lu(k,543) * lu(k,541) - lu(k,544) = lu(k,544) * lu(k,541) - lu(k,545) = lu(k,545) * lu(k,541) - lu(k,567) = lu(k,567) - lu(k,542) * lu(k,566) - lu(k,568) = lu(k,568) - lu(k,543) * lu(k,566) - lu(k,569) = lu(k,569) - lu(k,544) * lu(k,566) - lu(k,570) = lu(k,570) - lu(k,545) * lu(k,566) - lu(k,606) = lu(k,606) - lu(k,542) * lu(k,605) - lu(k,607) = lu(k,607) - lu(k,543) * lu(k,605) - lu(k,608) = lu(k,608) - lu(k,544) * lu(k,605) - lu(k,609) = lu(k,609) - lu(k,545) * lu(k,605) - lu(k,626) = lu(k,626) - lu(k,542) * lu(k,625) - lu(k,627) = lu(k,627) - lu(k,543) * lu(k,625) - lu(k,628) = lu(k,628) - lu(k,544) * lu(k,625) - lu(k,629) = lu(k,629) - lu(k,545) * lu(k,625) - lu(k,644) = lu(k,644) - lu(k,542) * lu(k,643) - lu(k,645) = lu(k,645) - lu(k,543) * lu(k,643) - lu(k,646) = lu(k,646) - lu(k,544) * lu(k,643) - lu(k,647) = lu(k,647) - lu(k,545) * lu(k,643) - lu(k,567) = 1._r8 / lu(k,567) - lu(k,568) = lu(k,568) * lu(k,567) - lu(k,569) = lu(k,569) * lu(k,567) - lu(k,570) = lu(k,570) * lu(k,567) - lu(k,607) = lu(k,607) - lu(k,568) * lu(k,606) - lu(k,608) = lu(k,608) - lu(k,569) * lu(k,606) - lu(k,609) = lu(k,609) - lu(k,570) * lu(k,606) - lu(k,627) = lu(k,627) - lu(k,568) * lu(k,626) - lu(k,628) = lu(k,628) - lu(k,569) * lu(k,626) - lu(k,629) = lu(k,629) - lu(k,570) * lu(k,626) - lu(k,645) = lu(k,645) - lu(k,568) * lu(k,644) - lu(k,646) = lu(k,646) - lu(k,569) * lu(k,644) - lu(k,647) = lu(k,647) - lu(k,570) * lu(k,644) + lu(k,464) = 1._r8 / lu(k,464) + lu(k,465) = lu(k,465) * lu(k,464) + lu(k,466) = lu(k,466) * lu(k,464) + lu(k,467) = lu(k,467) * lu(k,464) + lu(k,468) = lu(k,468) * lu(k,464) + lu(k,469) = lu(k,469) * lu(k,464) + lu(k,470) = lu(k,470) * lu(k,464) + lu(k,471) = lu(k,471) * lu(k,464) + lu(k,488) = lu(k,488) - lu(k,465) * lu(k,487) + lu(k,489) = lu(k,489) - lu(k,466) * lu(k,487) + lu(k,490) = lu(k,490) - lu(k,467) * lu(k,487) + lu(k,491) = lu(k,491) - lu(k,468) * lu(k,487) + lu(k,492) = lu(k,492) - lu(k,469) * lu(k,487) + lu(k,493) = lu(k,493) - lu(k,470) * lu(k,487) + lu(k,494) = lu(k,494) - lu(k,471) * lu(k,487) + lu(k,509) = lu(k,509) - lu(k,465) * lu(k,508) + lu(k,510) = lu(k,510) - lu(k,466) * lu(k,508) + lu(k,511) = lu(k,511) - lu(k,467) * lu(k,508) + lu(k,512) = lu(k,512) - lu(k,468) * lu(k,508) + lu(k,513) = lu(k,513) - lu(k,469) * lu(k,508) + lu(k,514) = lu(k,514) - lu(k,470) * lu(k,508) + lu(k,515) = lu(k,515) - lu(k,471) * lu(k,508) + lu(k,540) = lu(k,540) - lu(k,465) * lu(k,539) + lu(k,541) = lu(k,541) - lu(k,466) * lu(k,539) + lu(k,542) = lu(k,542) - lu(k,467) * lu(k,539) + lu(k,543) = lu(k,543) - lu(k,468) * lu(k,539) + lu(k,544) = lu(k,544) - lu(k,469) * lu(k,539) + lu(k,545) = lu(k,545) - lu(k,470) * lu(k,539) + lu(k,546) = lu(k,546) - lu(k,471) * lu(k,539) + lu(k,559) = lu(k,559) - lu(k,465) * lu(k,558) + lu(k,560) = lu(k,560) - lu(k,466) * lu(k,558) + lu(k,561) = lu(k,561) - lu(k,467) * lu(k,558) + lu(k,562) = lu(k,562) - lu(k,468) * lu(k,558) + lu(k,563) = lu(k,563) - lu(k,469) * lu(k,558) + lu(k,564) = lu(k,564) - lu(k,470) * lu(k,558) + lu(k,565) = lu(k,565) - lu(k,471) * lu(k,558) + lu(k,584) = lu(k,584) - lu(k,465) * lu(k,583) + lu(k,585) = lu(k,585) - lu(k,466) * lu(k,583) + lu(k,586) = lu(k,586) - lu(k,467) * lu(k,583) + lu(k,587) = lu(k,587) - lu(k,468) * lu(k,583) + lu(k,588) = lu(k,588) - lu(k,469) * lu(k,583) + lu(k,589) = lu(k,589) - lu(k,470) * lu(k,583) + lu(k,590) = lu(k,590) - lu(k,471) * lu(k,583) + lu(k,602) = lu(k,602) - lu(k,465) * lu(k,601) + lu(k,603) = lu(k,603) - lu(k,466) * lu(k,601) + lu(k,604) = lu(k,604) - lu(k,467) * lu(k,601) + lu(k,605) = lu(k,605) - lu(k,468) * lu(k,601) + lu(k,606) = lu(k,606) - lu(k,469) * lu(k,601) + lu(k,607) = lu(k,607) - lu(k,470) * lu(k,601) + lu(k,608) = lu(k,608) - lu(k,471) * lu(k,601) + lu(k,641) = lu(k,641) - lu(k,465) * lu(k,640) + lu(k,642) = lu(k,642) - lu(k,466) * lu(k,640) + lu(k,643) = lu(k,643) - lu(k,467) * lu(k,640) + lu(k,644) = lu(k,644) - lu(k,468) * lu(k,640) + lu(k,645) = lu(k,645) - lu(k,469) * lu(k,640) + lu(k,646) = lu(k,646) - lu(k,470) * lu(k,640) + lu(k,647) = lu(k,647) - lu(k,471) * lu(k,640) + lu(k,488) = 1._r8 / lu(k,488) + lu(k,489) = lu(k,489) * lu(k,488) + lu(k,490) = lu(k,490) * lu(k,488) + lu(k,491) = lu(k,491) * lu(k,488) + lu(k,492) = lu(k,492) * lu(k,488) + lu(k,493) = lu(k,493) * lu(k,488) + lu(k,494) = lu(k,494) * lu(k,488) + lu(k,510) = lu(k,510) - lu(k,489) * lu(k,509) + lu(k,511) = lu(k,511) - lu(k,490) * lu(k,509) + lu(k,512) = lu(k,512) - lu(k,491) * lu(k,509) + lu(k,513) = lu(k,513) - lu(k,492) * lu(k,509) + lu(k,514) = lu(k,514) - lu(k,493) * lu(k,509) + lu(k,515) = lu(k,515) - lu(k,494) * lu(k,509) + lu(k,541) = lu(k,541) - lu(k,489) * lu(k,540) + lu(k,542) = lu(k,542) - lu(k,490) * lu(k,540) + lu(k,543) = lu(k,543) - lu(k,491) * lu(k,540) + lu(k,544) = lu(k,544) - lu(k,492) * lu(k,540) + lu(k,545) = lu(k,545) - lu(k,493) * lu(k,540) + lu(k,546) = lu(k,546) - lu(k,494) * lu(k,540) + lu(k,560) = lu(k,560) - lu(k,489) * lu(k,559) + lu(k,561) = lu(k,561) - lu(k,490) * lu(k,559) + lu(k,562) = lu(k,562) - lu(k,491) * lu(k,559) + lu(k,563) = lu(k,563) - lu(k,492) * lu(k,559) + lu(k,564) = lu(k,564) - lu(k,493) * lu(k,559) + lu(k,565) = lu(k,565) - lu(k,494) * lu(k,559) + lu(k,585) = lu(k,585) - lu(k,489) * lu(k,584) + lu(k,586) = lu(k,586) - lu(k,490) * lu(k,584) + lu(k,587) = lu(k,587) - lu(k,491) * lu(k,584) + lu(k,588) = lu(k,588) - lu(k,492) * lu(k,584) + lu(k,589) = lu(k,589) - lu(k,493) * lu(k,584) + lu(k,590) = lu(k,590) - lu(k,494) * lu(k,584) + lu(k,603) = lu(k,603) - lu(k,489) * lu(k,602) + lu(k,604) = lu(k,604) - lu(k,490) * lu(k,602) + lu(k,605) = lu(k,605) - lu(k,491) * lu(k,602) + lu(k,606) = lu(k,606) - lu(k,492) * lu(k,602) + lu(k,607) = lu(k,607) - lu(k,493) * lu(k,602) + lu(k,608) = lu(k,608) - lu(k,494) * lu(k,602) + lu(k,642) = lu(k,642) - lu(k,489) * lu(k,641) + lu(k,643) = lu(k,643) - lu(k,490) * lu(k,641) + lu(k,644) = lu(k,644) - lu(k,491) * lu(k,641) + lu(k,645) = lu(k,645) - lu(k,492) * lu(k,641) + lu(k,646) = lu(k,646) - lu(k,493) * lu(k,641) + lu(k,647) = lu(k,647) - lu(k,494) * lu(k,641) + 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,514) = lu(k,514) * lu(k,510) + lu(k,515) = lu(k,515) * lu(k,510) + lu(k,542) = lu(k,542) - lu(k,511) * lu(k,541) + lu(k,543) = lu(k,543) - lu(k,512) * lu(k,541) + lu(k,544) = lu(k,544) - lu(k,513) * lu(k,541) + lu(k,545) = lu(k,545) - lu(k,514) * lu(k,541) + lu(k,546) = lu(k,546) - lu(k,515) * lu(k,541) + lu(k,561) = lu(k,561) - lu(k,511) * lu(k,560) + lu(k,562) = lu(k,562) - lu(k,512) * lu(k,560) + lu(k,563) = lu(k,563) - lu(k,513) * lu(k,560) + lu(k,564) = lu(k,564) - lu(k,514) * lu(k,560) + lu(k,565) = lu(k,565) - lu(k,515) * lu(k,560) + lu(k,586) = lu(k,586) - lu(k,511) * lu(k,585) + lu(k,587) = lu(k,587) - lu(k,512) * lu(k,585) + lu(k,588) = lu(k,588) - lu(k,513) * lu(k,585) + lu(k,589) = lu(k,589) - lu(k,514) * lu(k,585) + lu(k,590) = lu(k,590) - lu(k,515) * lu(k,585) + lu(k,604) = lu(k,604) - lu(k,511) * lu(k,603) + lu(k,605) = lu(k,605) - lu(k,512) * lu(k,603) + lu(k,606) = lu(k,606) - lu(k,513) * lu(k,603) + lu(k,607) = lu(k,607) - lu(k,514) * lu(k,603) + lu(k,608) = lu(k,608) - lu(k,515) * lu(k,603) + lu(k,643) = lu(k,643) - lu(k,511) * lu(k,642) + lu(k,644) = lu(k,644) - lu(k,512) * lu(k,642) + lu(k,645) = lu(k,645) - lu(k,513) * lu(k,642) + lu(k,646) = lu(k,646) - lu(k,514) * lu(k,642) + lu(k,647) = lu(k,647) - lu(k,515) * lu(k,642) + lu(k,542) = 1._r8 / lu(k,542) + lu(k,543) = lu(k,543) * lu(k,542) + lu(k,544) = lu(k,544) * lu(k,542) + lu(k,545) = lu(k,545) * lu(k,542) + lu(k,546) = lu(k,546) * lu(k,542) + lu(k,562) = lu(k,562) - lu(k,543) * lu(k,561) + lu(k,563) = lu(k,563) - lu(k,544) * lu(k,561) + lu(k,564) = lu(k,564) - lu(k,545) * lu(k,561) + lu(k,565) = lu(k,565) - lu(k,546) * lu(k,561) + lu(k,587) = lu(k,587) - lu(k,543) * lu(k,586) + lu(k,588) = lu(k,588) - lu(k,544) * lu(k,586) + lu(k,589) = lu(k,589) - lu(k,545) * lu(k,586) + lu(k,590) = lu(k,590) - lu(k,546) * lu(k,586) + lu(k,605) = lu(k,605) - lu(k,543) * lu(k,604) + lu(k,606) = lu(k,606) - lu(k,544) * lu(k,604) + lu(k,607) = lu(k,607) - lu(k,545) * lu(k,604) + lu(k,608) = lu(k,608) - lu(k,546) * lu(k,604) + lu(k,644) = lu(k,644) - lu(k,543) * lu(k,643) + lu(k,645) = lu(k,645) - lu(k,544) * lu(k,643) + lu(k,646) = lu(k,646) - lu(k,545) * lu(k,643) + lu(k,647) = lu(k,647) - lu(k,546) * lu(k,643) + lu(k,562) = 1._r8 / lu(k,562) + lu(k,563) = lu(k,563) * lu(k,562) + lu(k,564) = lu(k,564) * lu(k,562) + lu(k,565) = lu(k,565) * lu(k,562) + lu(k,588) = lu(k,588) - lu(k,563) * lu(k,587) + lu(k,589) = lu(k,589) - lu(k,564) * lu(k,587) + lu(k,590) = lu(k,590) - lu(k,565) * lu(k,587) + lu(k,606) = lu(k,606) - lu(k,563) * lu(k,605) + lu(k,607) = lu(k,607) - lu(k,564) * lu(k,605) + lu(k,608) = lu(k,608) - lu(k,565) * lu(k,605) + lu(k,645) = lu(k,645) - lu(k,563) * lu(k,644) + lu(k,646) = lu(k,646) - lu(k,564) * lu(k,644) + lu(k,647) = lu(k,647) - lu(k,565) * lu(k,644) + lu(k,588) = 1._r8 / lu(k,588) + lu(k,589) = lu(k,589) * lu(k,588) + lu(k,590) = lu(k,590) * lu(k,588) + lu(k,607) = lu(k,607) - lu(k,589) * lu(k,606) + lu(k,608) = lu(k,608) - lu(k,590) * lu(k,606) + lu(k,646) = lu(k,646) - lu(k,589) * lu(k,645) + lu(k,647) = lu(k,647) - lu(k,590) * lu(k,645) lu(k,607) = 1._r8 / lu(k,607) lu(k,608) = lu(k,608) * lu(k,607) - lu(k,609) = lu(k,609) * lu(k,607) - lu(k,628) = lu(k,628) - lu(k,608) * lu(k,627) - lu(k,629) = lu(k,629) - lu(k,609) * lu(k,627) - lu(k,646) = lu(k,646) - lu(k,608) * lu(k,645) - lu(k,647) = lu(k,647) - lu(k,609) * lu(k,645) - lu(k,628) = 1._r8 / lu(k,628) - lu(k,629) = lu(k,629) * lu(k,628) - lu(k,647) = lu(k,647) - lu(k,629) * lu(k,646) + lu(k,647) = lu(k,647) - lu(k,608) * lu(k,646) lu(k,647) = 1._r8 / lu(k,647) end do end subroutine lu_fac09 diff --git a/src/chemistry/pp_waccm_ma/mo_lu_solve.F90 b/src/chemistry/pp_waccm_ma/mo_lu_solve.F90 index 9122181a69..8eb1800255 100644 --- a/src/chemistry/pp_waccm_ma/mo_lu_solve.F90 +++ b/src/chemistry/pp_waccm_ma/mo_lu_solve.F90 @@ -21,65 +21,65 @@ subroutine lu_slv01( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,40) = b(k,40) - lu(k,2) * b(k,1) - b(k,41) = b(k,41) - lu(k,3) * b(k,1) + b(k,43) = b(k,43) - lu(k,2) * b(k,1) + b(k,48) = b(k,48) - lu(k,3) * b(k,1) b(k,21) = b(k,21) - lu(k,5) * b(k,2) b(k,42) = b(k,42) - lu(k,6) * b(k,2) - b(k,41) = b(k,41) - lu(k,8) * b(k,3) - b(k,48) = b(k,48) - lu(k,9) * b(k,3) + b(k,43) = b(k,43) - lu(k,8) * b(k,3) + b(k,50) = b(k,50) - lu(k,9) * b(k,3) b(k,32) = b(k,32) - lu(k,11) * b(k,4) b(k,32) = b(k,32) - lu(k,14) * b(k,5) - b(k,40) = b(k,40) - lu(k,16) * b(k,6) + b(k,48) = b(k,48) - lu(k,16) * b(k,6) b(k,21) = b(k,21) - lu(k,18) * b(k,7) - b(k,40) = b(k,40) - lu(k,19) * b(k,7) - b(k,42) = b(k,42) - lu(k,20) * b(k,7) - b(k,40) = b(k,40) - lu(k,22) * b(k,8) - b(k,43) = b(k,43) - lu(k,23) * b(k,8) + b(k,42) = b(k,42) - lu(k,19) * b(k,7) + b(k,48) = b(k,48) - lu(k,20) * b(k,7) + b(k,38) = b(k,38) - lu(k,22) * b(k,8) + b(k,48) = b(k,48) - lu(k,23) * b(k,8) b(k,21) = b(k,21) - lu(k,25) * b(k,9) b(k,36) = b(k,36) - lu(k,26) * b(k,9) b(k,31) = b(k,31) - lu(k,28) * b(k,10) - b(k,37) = b(k,37) - lu(k,29) * b(k,10) - b(k,38) = b(k,38) - lu(k,30) * b(k,10) + b(k,40) = b(k,40) - lu(k,29) * b(k,10) + b(k,41) = b(k,41) - lu(k,30) * b(k,10) b(k,45) = b(k,45) - lu(k,31) * b(k,10) - b(k,48) = b(k,48) - lu(k,32) * b(k,10) + b(k,50) = b(k,50) - lu(k,32) * b(k,10) b(k,33) = b(k,33) - lu(k,34) * b(k,11) b(k,35) = b(k,35) - lu(k,35) * b(k,11) b(k,36) = b(k,36) - lu(k,36) * b(k,11) - b(k,44) = b(k,44) - lu(k,37) * b(k,11) - b(k,46) = b(k,46) - lu(k,38) * b(k,11) + b(k,46) = b(k,46) - lu(k,37) * b(k,11) + b(k,47) = b(k,47) - lu(k,38) * b(k,11) b(k,32) = b(k,32) - lu(k,40) * b(k,12) b(k,33) = b(k,33) - lu(k,41) * b(k,12) b(k,37) = b(k,37) - lu(k,42) * b(k,12) - b(k,45) = b(k,45) - lu(k,43) * b(k,12) - b(k,46) = b(k,46) - lu(k,44) * b(k,12) - b(k,47) = b(k,47) - lu(k,45) * b(k,12) + b(k,41) = b(k,41) - lu(k,43) * b(k,12) + b(k,45) = b(k,45) - lu(k,44) * b(k,12) + b(k,46) = b(k,46) - lu(k,45) * b(k,12) b(k,14) = b(k,14) - lu(k,47) * b(k,13) b(k,18) = b(k,18) - lu(k,48) * b(k,13) b(k,24) = b(k,24) - lu(k,49) * b(k,13) b(k,25) = b(k,25) - lu(k,50) * b(k,13) - b(k,38) = b(k,38) - lu(k,51) * b(k,13) - b(k,48) = b(k,48) - lu(k,52) * b(k,13) + b(k,40) = b(k,40) - lu(k,51) * b(k,13) + b(k,50) = b(k,50) - lu(k,52) * b(k,13) b(k,18) = b(k,18) - lu(k,54) * b(k,14) b(k,25) = b(k,25) - lu(k,55) * b(k,14) b(k,26) = b(k,26) - lu(k,56) * b(k,14) b(k,32) = b(k,32) - lu(k,57) * b(k,14) - b(k,48) = b(k,48) - lu(k,58) * b(k,14) + b(k,50) = b(k,50) - lu(k,58) * b(k,14) b(k,20) = b(k,20) - lu(k,60) * b(k,15) b(k,31) = b(k,31) - lu(k,61) * b(k,15) - b(k,37) = b(k,37) - lu(k,62) * b(k,15) - b(k,39) = b(k,39) - lu(k,63) * b(k,15) - b(k,43) = b(k,43) - lu(k,64) * b(k,15) + b(k,38) = b(k,38) - lu(k,62) * b(k,15) + b(k,41) = b(k,41) - lu(k,63) * b(k,15) + b(k,44) = b(k,44) - lu(k,64) * b(k,15) b(k,45) = b(k,45) - lu(k,65) * b(k,15) - b(k,48) = b(k,48) - lu(k,66) * b(k,15) + b(k,50) = b(k,50) - lu(k,66) * b(k,15) b(k,36) = b(k,36) - lu(k,68) * b(k,16) - b(k,46) = b(k,46) - lu(k,69) * b(k,16) - b(k,47) = b(k,47) - lu(k,70) * b(k,16) + b(k,37) = b(k,37) - lu(k,69) * b(k,16) + b(k,46) = b(k,46) - lu(k,70) * b(k,16) b(k,33) = b(k,33) - lu(k,72) * b(k,17) b(k,34) = b(k,34) - lu(k,73) * b(k,17) - b(k,40) = b(k,40) - lu(k,74) * b(k,17) + b(k,37) = b(k,37) - lu(k,74) * b(k,17) b(k,46) = b(k,46) - lu(k,75) * b(k,17) - b(k,47) = b(k,47) - lu(k,76) * b(k,17) - b(k,48) = b(k,48) - lu(k,77) * b(k,17) + b(k,48) = b(k,48) - lu(k,76) * b(k,17) + b(k,50) = b(k,50) - lu(k,77) * b(k,17) b(k,19) = b(k,19) - lu(k,79) * b(k,18) b(k,25) = b(k,25) - lu(k,80) * b(k,18) b(k,26) = b(k,26) - lu(k,81) * b(k,18) @@ -87,134 +87,134 @@ subroutine lu_slv01( avec_len, lu, b ) b(k,28) = b(k,28) - lu(k,83) * b(k,18) b(k,29) = b(k,29) - lu(k,84) * b(k,18) b(k,32) = b(k,32) - lu(k,85) * b(k,18) - b(k,48) = b(k,48) - lu(k,86) * b(k,18) + b(k,50) = b(k,50) - lu(k,86) * b(k,18) b(k,27) = b(k,27) - lu(k,88) * b(k,19) b(k,28) = b(k,28) - lu(k,89) * b(k,19) b(k,29) = b(k,29) - lu(k,90) * b(k,19) - b(k,48) = b(k,48) - lu(k,91) * b(k,19) + b(k,50) = b(k,50) - lu(k,91) * b(k,19) b(k,33) = b(k,33) - lu(k,94) * b(k,20) b(k,34) = b(k,34) - lu(k,95) * b(k,20) - b(k,39) = b(k,39) - lu(k,96) * b(k,20) - b(k,40) = b(k,40) - lu(k,97) * b(k,20) - b(k,43) = b(k,43) - lu(k,98) * b(k,20) - b(k,46) = b(k,46) - lu(k,99) * b(k,20) - b(k,48) = b(k,48) - lu(k,100) * b(k,20) + b(k,38) = b(k,38) - lu(k,96) * b(k,20) + b(k,44) = b(k,44) - lu(k,97) * b(k,20) + b(k,46) = b(k,46) - lu(k,98) * b(k,20) + b(k,48) = b(k,48) - lu(k,99) * b(k,20) + b(k,50) = b(k,50) - lu(k,100) * b(k,20) b(k,31) = b(k,31) - lu(k,103) * b(k,21) b(k,33) = b(k,33) - lu(k,104) * b(k,21) b(k,36) = b(k,36) - lu(k,105) * b(k,21) - b(k,37) = b(k,37) - lu(k,106) * b(k,21) - b(k,44) = b(k,44) - lu(k,107) * b(k,21) + b(k,39) = b(k,39) - lu(k,106) * b(k,21) + b(k,45) = b(k,45) - lu(k,107) * b(k,21) b(k,46) = b(k,46) - lu(k,108) * b(k,21) - b(k,49) = b(k,49) - lu(k,109) * b(k,21) - b(k,33) = b(k,33) - lu(k,112) * b(k,22) - b(k,34) = b(k,34) - lu(k,113) * b(k,22) - b(k,40) = b(k,40) - lu(k,114) * b(k,22) - b(k,41) = b(k,41) - lu(k,115) * b(k,22) + b(k,47) = b(k,47) - lu(k,109) * b(k,21) + b(k,33) = b(k,33) - lu(k,111) * b(k,22) + b(k,36) = b(k,36) - lu(k,112) * b(k,22) + b(k,38) = b(k,38) - lu(k,113) * b(k,22) + b(k,42) = b(k,42) - lu(k,114) * b(k,22) + b(k,44) = b(k,44) - lu(k,115) * b(k,22) b(k,46) = b(k,46) - lu(k,116) * b(k,22) - b(k,48) = b(k,48) - lu(k,117) * b(k,22) - b(k,33) = b(k,33) - lu(k,119) * b(k,23) - b(k,36) = b(k,36) - lu(k,120) * b(k,23) - b(k,39) = b(k,39) - lu(k,121) * b(k,23) - b(k,42) = b(k,42) - lu(k,122) * b(k,23) - b(k,43) = b(k,43) - lu(k,123) * b(k,23) - b(k,46) = b(k,46) - lu(k,124) * b(k,23) - b(k,48) = b(k,48) - lu(k,125) * b(k,23) + b(k,50) = b(k,50) - lu(k,117) * b(k,22) + b(k,33) = b(k,33) - lu(k,120) * b(k,23) + b(k,34) = b(k,34) - lu(k,121) * b(k,23) + b(k,43) = b(k,43) - lu(k,122) * b(k,23) + b(k,46) = b(k,46) - lu(k,123) * b(k,23) + b(k,48) = b(k,48) - lu(k,124) * b(k,23) + b(k,50) = b(k,50) - lu(k,125) * b(k,23) b(k,25) = b(k,25) - lu(k,128) * b(k,24) b(k,26) = b(k,26) - lu(k,129) * b(k,24) b(k,27) = b(k,27) - lu(k,130) * b(k,24) b(k,28) = b(k,28) - lu(k,131) * b(k,24) b(k,29) = b(k,29) - lu(k,132) * b(k,24) b(k,32) = b(k,32) - lu(k,133) * b(k,24) - b(k,48) = b(k,48) - lu(k,134) * b(k,24) + b(k,50) = b(k,50) - lu(k,134) * b(k,24) b(k,26) = b(k,26) - lu(k,139) * b(k,25) b(k,27) = b(k,27) - lu(k,140) * b(k,25) b(k,28) = b(k,28) - lu(k,141) * b(k,25) b(k,29) = b(k,29) - lu(k,142) * b(k,25) b(k,32) = b(k,32) - lu(k,143) * b(k,25) b(k,36) = b(k,36) - lu(k,144) * b(k,25) - b(k,46) = b(k,46) - lu(k,145) * b(k,25) - b(k,47) = b(k,47) - lu(k,146) * b(k,25) - b(k,48) = b(k,48) - lu(k,147) * b(k,25) + b(k,37) = b(k,37) - lu(k,145) * b(k,25) + b(k,46) = b(k,46) - lu(k,146) * b(k,25) + b(k,50) = b(k,50) - lu(k,147) * b(k,25) b(k,27) = b(k,27) - lu(k,150) * b(k,26) b(k,28) = b(k,28) - lu(k,151) * b(k,26) b(k,29) = b(k,29) - lu(k,152) * b(k,26) b(k,32) = b(k,32) - lu(k,153) * b(k,26) - b(k,38) = b(k,38) - lu(k,154) * b(k,26) + b(k,40) = b(k,40) - lu(k,154) * b(k,26) b(k,42) = b(k,42) - lu(k,155) * b(k,26) - b(k,48) = b(k,48) - lu(k,156) * b(k,26) + b(k,50) = b(k,50) - lu(k,156) * b(k,26) b(k,28) = b(k,28) - lu(k,165) * b(k,27) b(k,29) = b(k,29) - lu(k,166) * b(k,27) b(k,32) = b(k,32) - lu(k,167) * b(k,27) b(k,36) = b(k,36) - lu(k,168) * b(k,27) - b(k,38) = b(k,38) - lu(k,169) * b(k,27) - b(k,42) = b(k,42) - lu(k,170) * b(k,27) - b(k,46) = b(k,46) - lu(k,171) * b(k,27) - b(k,47) = b(k,47) - lu(k,172) * b(k,27) - b(k,48) = b(k,48) - lu(k,173) * b(k,27) + b(k,37) = b(k,37) - lu(k,169) * b(k,27) + b(k,40) = b(k,40) - lu(k,170) * b(k,27) + b(k,42) = b(k,42) - lu(k,171) * b(k,27) + b(k,46) = b(k,46) - lu(k,172) * b(k,27) + b(k,50) = b(k,50) - lu(k,173) * b(k,27) b(k,29) = b(k,29) - lu(k,179) * b(k,28) b(k,32) = b(k,32) - lu(k,180) * b(k,28) b(k,36) = b(k,36) - lu(k,181) * b(k,28) - b(k,38) = b(k,38) - lu(k,182) * b(k,28) - b(k,42) = b(k,42) - lu(k,183) * b(k,28) - b(k,46) = b(k,46) - lu(k,184) * b(k,28) - b(k,47) = b(k,47) - lu(k,185) * b(k,28) - b(k,48) = b(k,48) - lu(k,186) * b(k,28) + b(k,37) = b(k,37) - lu(k,182) * b(k,28) + b(k,40) = b(k,40) - lu(k,183) * b(k,28) + b(k,42) = b(k,42) - lu(k,184) * b(k,28) + b(k,46) = b(k,46) - lu(k,185) * b(k,28) + b(k,50) = b(k,50) - lu(k,186) * b(k,28) b(k,32) = b(k,32) - lu(k,194) * b(k,29) b(k,36) = b(k,36) - lu(k,195) * b(k,29) - b(k,38) = b(k,38) - lu(k,196) * b(k,29) - b(k,42) = b(k,42) - lu(k,197) * b(k,29) - b(k,45) = b(k,45) - lu(k,198) * b(k,29) - b(k,46) = b(k,46) - lu(k,199) * b(k,29) - b(k,47) = b(k,47) - lu(k,200) * b(k,29) - b(k,48) = b(k,48) - lu(k,201) * b(k,29) + b(k,37) = b(k,37) - lu(k,196) * b(k,29) + b(k,40) = b(k,40) - lu(k,197) * b(k,29) + b(k,41) = b(k,41) - lu(k,198) * b(k,29) + b(k,42) = b(k,42) - lu(k,199) * b(k,29) + b(k,46) = b(k,46) - lu(k,200) * b(k,29) + b(k,50) = b(k,50) - lu(k,201) * b(k,29) b(k,31) = b(k,31) - lu(k,205) * b(k,30) b(k,33) = b(k,33) - lu(k,206) * b(k,30) b(k,34) = b(k,34) - lu(k,207) * b(k,30) - b(k,37) = b(k,37) - lu(k,208) * b(k,30) - b(k,40) = b(k,40) - lu(k,209) * b(k,30) - b(k,41) = b(k,41) - lu(k,210) * b(k,30) - b(k,45) = b(k,45) - lu(k,211) * b(k,30) - b(k,46) = b(k,46) - lu(k,212) * b(k,30) - b(k,48) = b(k,48) - lu(k,213) * b(k,30) + b(k,41) = b(k,41) - lu(k,208) * b(k,30) + b(k,43) = b(k,43) - lu(k,209) * b(k,30) + b(k,45) = b(k,45) - lu(k,210) * b(k,30) + b(k,46) = b(k,46) - lu(k,211) * b(k,30) + b(k,48) = b(k,48) - lu(k,212) * b(k,30) + b(k,50) = b(k,50) - lu(k,213) * b(k,30) b(k,33) = b(k,33) - lu(k,217) * b(k,31) b(k,36) = b(k,36) - lu(k,218) * b(k,31) - b(k,37) = b(k,37) - lu(k,219) * b(k,31) - b(k,44) = b(k,44) - lu(k,220) * b(k,31) + b(k,39) = b(k,39) - lu(k,219) * b(k,31) + b(k,41) = b(k,41) - lu(k,220) * b(k,31) b(k,45) = b(k,45) - lu(k,221) * b(k,31) b(k,46) = b(k,46) - lu(k,222) * b(k,31) - b(k,49) = b(k,49) - lu(k,223) * b(k,31) + b(k,47) = b(k,47) - lu(k,223) * b(k,31) b(k,36) = b(k,36) - lu(k,237) * b(k,32) - b(k,38) = b(k,38) - lu(k,238) * b(k,32) - b(k,42) = b(k,42) - lu(k,239) * b(k,32) - b(k,45) = b(k,45) - lu(k,240) * b(k,32) - b(k,46) = b(k,46) - lu(k,241) * b(k,32) - b(k,47) = b(k,47) - lu(k,242) * b(k,32) - b(k,48) = b(k,48) - lu(k,243) * b(k,32) + b(k,37) = b(k,37) - lu(k,238) * b(k,32) + b(k,40) = b(k,40) - lu(k,239) * b(k,32) + b(k,41) = b(k,41) - lu(k,240) * b(k,32) + b(k,42) = b(k,42) - lu(k,241) * b(k,32) + b(k,46) = b(k,46) - lu(k,242) * b(k,32) + b(k,49) = b(k,49) - lu(k,243) * b(k,32) b(k,50) = b(k,50) - lu(k,244) * b(k,32) b(k,36) = b(k,36) - lu(k,249) * b(k,33) - b(k,37) = b(k,37) - lu(k,250) * b(k,33) - b(k,42) = b(k,42) - lu(k,251) * b(k,33) - b(k,44) = b(k,44) - lu(k,252) * b(k,33) + b(k,39) = b(k,39) - lu(k,250) * b(k,33) + b(k,41) = b(k,41) - lu(k,251) * b(k,33) + b(k,42) = b(k,42) - lu(k,252) * b(k,33) b(k,45) = b(k,45) - lu(k,253) * b(k,33) b(k,46) = b(k,46) - lu(k,254) * b(k,33) - b(k,48) = b(k,48) - lu(k,255) * b(k,33) - b(k,49) = b(k,49) - lu(k,256) * b(k,33) + b(k,47) = b(k,47) - lu(k,255) * b(k,33) + b(k,50) = b(k,50) - lu(k,256) * b(k,33) b(k,36) = b(k,36) - lu(k,265) * b(k,34) - b(k,37) = b(k,37) - lu(k,266) * b(k,34) + b(k,38) = b(k,38) - lu(k,266) * b(k,34) b(k,39) = b(k,39) - lu(k,267) * b(k,34) - b(k,40) = b(k,40) - lu(k,268) * b(k,34) - b(k,41) = b(k,41) - lu(k,269) * b(k,34) - b(k,42) = b(k,42) - lu(k,270) * b(k,34) - b(k,43) = b(k,43) - lu(k,271) * b(k,34) - b(k,44) = b(k,44) - lu(k,272) * b(k,34) - b(k,45) = b(k,45) - lu(k,273) * b(k,34) - b(k,46) = b(k,46) - lu(k,274) * b(k,34) + b(k,41) = b(k,41) - lu(k,268) * b(k,34) + b(k,42) = b(k,42) - lu(k,269) * b(k,34) + b(k,43) = b(k,43) - lu(k,270) * b(k,34) + b(k,44) = b(k,44) - lu(k,271) * b(k,34) + b(k,45) = b(k,45) - lu(k,272) * b(k,34) + b(k,46) = b(k,46) - lu(k,273) * b(k,34) + b(k,47) = b(k,47) - lu(k,274) * b(k,34) b(k,48) = b(k,48) - lu(k,275) * b(k,34) - b(k,49) = b(k,49) - lu(k,276) * b(k,34) + b(k,50) = b(k,50) - lu(k,276) * b(k,34) b(k,36) = b(k,36) - lu(k,283) * b(k,35) b(k,37) = b(k,37) - lu(k,284) * b(k,35) - b(k,39) = b(k,39) - lu(k,285) * b(k,35) - b(k,40) = b(k,40) - lu(k,286) * b(k,35) + b(k,38) = b(k,38) - lu(k,285) * b(k,35) + b(k,39) = b(k,39) - lu(k,286) * b(k,35) b(k,41) = b(k,41) - lu(k,287) * b(k,35) b(k,42) = b(k,42) - lu(k,288) * b(k,35) b(k,43) = b(k,43) - lu(k,289) * b(k,35) @@ -223,7 +223,7 @@ subroutine lu_slv01( avec_len, lu, b ) b(k,46) = b(k,46) - lu(k,292) * b(k,35) b(k,47) = b(k,47) - lu(k,293) * b(k,35) b(k,48) = b(k,48) - lu(k,294) * b(k,35) - b(k,49) = b(k,49) - lu(k,295) * b(k,35) + b(k,50) = b(k,50) - lu(k,295) * b(k,35) end do end subroutine lu_slv01 subroutine lu_slv02( avec_len, lu, b ) @@ -245,106 +245,106 @@ subroutine lu_slv02( avec_len, lu, b ) !----------------------------------------------------------------------- do k = 1,avec_len b(k,37) = b(k,37) - lu(k,299) * b(k,36) - b(k,38) = b(k,38) - lu(k,300) * b(k,36) - b(k,42) = b(k,42) - lu(k,301) * b(k,36) - b(k,44) = b(k,44) - lu(k,302) * b(k,36) - b(k,45) = b(k,45) - lu(k,303) * b(k,36) - b(k,46) = b(k,46) - lu(k,304) * b(k,36) - b(k,47) = b(k,47) - lu(k,305) * b(k,36) - b(k,48) = b(k,48) - lu(k,306) * b(k,36) + b(k,39) = b(k,39) - lu(k,300) * b(k,36) + b(k,40) = b(k,40) - lu(k,301) * b(k,36) + b(k,41) = b(k,41) - lu(k,302) * b(k,36) + b(k,42) = b(k,42) - lu(k,303) * b(k,36) + b(k,45) = b(k,45) - lu(k,304) * b(k,36) + b(k,46) = b(k,46) - lu(k,305) * b(k,36) + b(k,47) = b(k,47) - lu(k,306) * b(k,36) b(k,49) = b(k,49) - lu(k,307) * b(k,36) b(k,50) = b(k,50) - lu(k,308) * b(k,36) - b(k,38) = b(k,38) - lu(k,317) * b(k,37) - b(k,39) = b(k,39) - lu(k,318) * b(k,37) - b(k,40) = b(k,40) - lu(k,319) * b(k,37) - b(k,41) = b(k,41) - lu(k,320) * b(k,37) - b(k,42) = b(k,42) - lu(k,321) * b(k,37) - b(k,43) = b(k,43) - lu(k,322) * b(k,37) - b(k,44) = b(k,44) - lu(k,323) * b(k,37) - b(k,45) = b(k,45) - lu(k,324) * b(k,37) - b(k,46) = b(k,46) - lu(k,325) * b(k,37) - b(k,47) = b(k,47) - lu(k,326) * b(k,37) - b(k,48) = b(k,48) - lu(k,327) * b(k,37) - b(k,49) = b(k,49) - lu(k,328) * b(k,37) - b(k,50) = b(k,50) - lu(k,329) * b(k,37) - b(k,39) = b(k,39) - lu(k,340) * b(k,38) - b(k,40) = b(k,40) - lu(k,341) * b(k,38) - b(k,41) = b(k,41) - lu(k,342) * b(k,38) - b(k,42) = b(k,42) - lu(k,343) * b(k,38) - b(k,43) = b(k,43) - lu(k,344) * b(k,38) - b(k,44) = b(k,44) - lu(k,345) * b(k,38) - b(k,45) = b(k,45) - lu(k,346) * b(k,38) - b(k,46) = b(k,46) - lu(k,347) * b(k,38) - b(k,47) = b(k,47) - lu(k,348) * b(k,38) - b(k,48) = b(k,48) - lu(k,349) * b(k,38) - b(k,49) = b(k,49) - lu(k,350) * b(k,38) - b(k,50) = b(k,50) - lu(k,351) * b(k,38) - b(k,40) = b(k,40) - lu(k,364) * b(k,39) - b(k,41) = b(k,41) - lu(k,365) * b(k,39) - b(k,42) = b(k,42) - lu(k,366) * b(k,39) - b(k,43) = b(k,43) - lu(k,367) * b(k,39) - b(k,44) = b(k,44) - lu(k,368) * b(k,39) - b(k,45) = b(k,45) - lu(k,369) * b(k,39) - b(k,46) = b(k,46) - lu(k,370) * b(k,39) - b(k,47) = b(k,47) - lu(k,371) * b(k,39) - b(k,48) = b(k,48) - lu(k,372) * b(k,39) - b(k,49) = b(k,49) - lu(k,373) * b(k,39) - b(k,50) = b(k,50) - lu(k,374) * b(k,39) - b(k,41) = b(k,41) - lu(k,390) * b(k,40) - b(k,42) = b(k,42) - lu(k,391) * b(k,40) - b(k,43) = b(k,43) - lu(k,392) * b(k,40) - b(k,44) = b(k,44) - lu(k,393) * b(k,40) - b(k,45) = b(k,45) - lu(k,394) * b(k,40) - b(k,46) = b(k,46) - lu(k,395) * b(k,40) - b(k,47) = b(k,47) - lu(k,396) * b(k,40) - b(k,48) = b(k,48) - lu(k,397) * b(k,40) - b(k,49) = b(k,49) - lu(k,398) * b(k,40) - b(k,50) = b(k,50) - lu(k,399) * b(k,40) - b(k,42) = b(k,42) - lu(k,417) * b(k,41) - b(k,43) = b(k,43) - lu(k,418) * b(k,41) - b(k,44) = b(k,44) - lu(k,419) * b(k,41) - b(k,45) = b(k,45) - lu(k,420) * b(k,41) - b(k,46) = b(k,46) - lu(k,421) * b(k,41) - b(k,47) = b(k,47) - lu(k,422) * b(k,41) - b(k,48) = b(k,48) - lu(k,423) * b(k,41) - b(k,49) = b(k,49) - lu(k,424) * b(k,41) - b(k,50) = b(k,50) - lu(k,425) * b(k,41) - b(k,43) = b(k,43) - lu(k,443) * b(k,42) - b(k,44) = b(k,44) - lu(k,444) * b(k,42) - b(k,45) = b(k,45) - lu(k,445) * b(k,42) - b(k,46) = b(k,46) - lu(k,446) * b(k,42) - b(k,47) = b(k,47) - lu(k,447) * b(k,42) - b(k,48) = b(k,48) - lu(k,448) * b(k,42) - b(k,49) = b(k,49) - lu(k,449) * b(k,42) - b(k,50) = b(k,50) - lu(k,450) * b(k,42) - b(k,44) = b(k,44) - lu(k,464) * b(k,43) - b(k,45) = b(k,45) - lu(k,465) * b(k,43) - b(k,46) = b(k,46) - lu(k,466) * b(k,43) - b(k,47) = b(k,47) - lu(k,467) * b(k,43) - b(k,48) = b(k,48) - lu(k,468) * b(k,43) - b(k,49) = b(k,49) - lu(k,469) * b(k,43) - b(k,50) = b(k,50) - lu(k,470) * b(k,43) - b(k,45) = b(k,45) - lu(k,484) * b(k,44) - b(k,46) = b(k,46) - lu(k,485) * b(k,44) - b(k,47) = b(k,47) - lu(k,486) * b(k,44) - b(k,48) = b(k,48) - lu(k,487) * b(k,44) - b(k,49) = b(k,49) - lu(k,488) * b(k,44) - b(k,50) = b(k,50) - lu(k,489) * b(k,44) - b(k,46) = b(k,46) - lu(k,510) * b(k,45) - b(k,47) = b(k,47) - lu(k,511) * b(k,45) - b(k,48) = b(k,48) - lu(k,512) * b(k,45) - b(k,49) = b(k,49) - lu(k,513) * b(k,45) - b(k,50) = b(k,50) - lu(k,514) * b(k,45) - b(k,47) = b(k,47) - lu(k,542) * b(k,46) - b(k,48) = b(k,48) - lu(k,543) * b(k,46) - b(k,49) = b(k,49) - lu(k,544) * b(k,46) - b(k,50) = b(k,50) - lu(k,545) * b(k,46) - b(k,48) = b(k,48) - lu(k,568) * b(k,47) - b(k,49) = b(k,49) - lu(k,569) * b(k,47) - b(k,50) = b(k,50) - lu(k,570) * b(k,47) - b(k,49) = b(k,49) - lu(k,608) * b(k,48) - b(k,50) = b(k,50) - lu(k,609) * b(k,48) - b(k,50) = b(k,50) - lu(k,629) * b(k,49) + b(k,38) = b(k,38) - lu(k,321) * b(k,37) + b(k,39) = b(k,39) - lu(k,322) * b(k,37) + b(k,40) = b(k,40) - lu(k,323) * b(k,37) + b(k,41) = b(k,41) - lu(k,324) * b(k,37) + b(k,42) = b(k,42) - lu(k,325) * b(k,37) + b(k,43) = b(k,43) - lu(k,326) * b(k,37) + b(k,44) = b(k,44) - lu(k,327) * b(k,37) + b(k,45) = b(k,45) - lu(k,328) * b(k,37) + b(k,46) = b(k,46) - lu(k,329) * b(k,37) + b(k,47) = b(k,47) - lu(k,330) * b(k,37) + b(k,48) = b(k,48) - lu(k,331) * b(k,37) + b(k,49) = b(k,49) - lu(k,332) * b(k,37) + b(k,50) = b(k,50) - lu(k,333) * b(k,37) + b(k,39) = b(k,39) - lu(k,342) * b(k,38) + b(k,40) = b(k,40) - lu(k,343) * b(k,38) + b(k,41) = b(k,41) - lu(k,344) * b(k,38) + b(k,42) = b(k,42) - lu(k,345) * b(k,38) + b(k,43) = b(k,43) - lu(k,346) * b(k,38) + b(k,44) = b(k,44) - lu(k,347) * b(k,38) + b(k,45) = b(k,45) - lu(k,348) * b(k,38) + b(k,46) = b(k,46) - lu(k,349) * b(k,38) + b(k,47) = b(k,47) - lu(k,350) * b(k,38) + b(k,48) = b(k,48) - lu(k,351) * b(k,38) + b(k,49) = b(k,49) - lu(k,352) * b(k,38) + b(k,50) = b(k,50) - lu(k,353) * b(k,38) + b(k,40) = b(k,40) - lu(k,363) * b(k,39) + b(k,41) = b(k,41) - lu(k,364) * b(k,39) + b(k,42) = b(k,42) - lu(k,365) * b(k,39) + b(k,43) = b(k,43) - lu(k,366) * b(k,39) + b(k,44) = b(k,44) - lu(k,367) * b(k,39) + b(k,45) = b(k,45) - lu(k,368) * b(k,39) + b(k,46) = b(k,46) - lu(k,369) * b(k,39) + b(k,47) = b(k,47) - lu(k,370) * b(k,39) + b(k,48) = b(k,48) - lu(k,371) * b(k,39) + b(k,49) = b(k,49) - lu(k,372) * b(k,39) + b(k,50) = b(k,50) - lu(k,373) * b(k,39) + b(k,41) = b(k,41) - lu(k,386) * b(k,40) + b(k,42) = b(k,42) - lu(k,387) * b(k,40) + b(k,43) = b(k,43) - lu(k,388) * b(k,40) + b(k,44) = b(k,44) - lu(k,389) * b(k,40) + b(k,45) = b(k,45) - lu(k,390) * b(k,40) + b(k,46) = b(k,46) - lu(k,391) * b(k,40) + b(k,47) = b(k,47) - lu(k,392) * b(k,40) + b(k,48) = b(k,48) - lu(k,393) * b(k,40) + b(k,49) = b(k,49) - lu(k,394) * b(k,40) + b(k,50) = b(k,50) - lu(k,395) * b(k,40) + b(k,42) = b(k,42) - lu(k,412) * b(k,41) + b(k,43) = b(k,43) - lu(k,413) * b(k,41) + b(k,44) = b(k,44) - lu(k,414) * b(k,41) + b(k,45) = b(k,45) - lu(k,415) * b(k,41) + b(k,46) = b(k,46) - lu(k,416) * b(k,41) + b(k,47) = b(k,47) - lu(k,417) * b(k,41) + b(k,48) = b(k,48) - lu(k,418) * b(k,41) + b(k,49) = b(k,49) - lu(k,419) * b(k,41) + b(k,50) = b(k,50) - lu(k,420) * b(k,41) + b(k,43) = b(k,43) - lu(k,438) * b(k,42) + b(k,44) = b(k,44) - lu(k,439) * b(k,42) + b(k,45) = b(k,45) - lu(k,440) * b(k,42) + b(k,46) = b(k,46) - lu(k,441) * b(k,42) + b(k,47) = b(k,47) - lu(k,442) * b(k,42) + b(k,48) = b(k,48) - lu(k,443) * b(k,42) + b(k,49) = b(k,49) - lu(k,444) * b(k,42) + b(k,50) = b(k,50) - lu(k,445) * b(k,42) + b(k,44) = b(k,44) - lu(k,465) * b(k,43) + b(k,45) = b(k,45) - lu(k,466) * b(k,43) + b(k,46) = b(k,46) - lu(k,467) * b(k,43) + b(k,47) = b(k,47) - lu(k,468) * b(k,43) + b(k,48) = b(k,48) - lu(k,469) * b(k,43) + b(k,49) = b(k,49) - lu(k,470) * b(k,43) + b(k,50) = b(k,50) - lu(k,471) * b(k,43) + b(k,45) = b(k,45) - lu(k,489) * b(k,44) + b(k,46) = b(k,46) - lu(k,490) * b(k,44) + b(k,47) = b(k,47) - lu(k,491) * b(k,44) + b(k,48) = b(k,48) - lu(k,492) * b(k,44) + b(k,49) = b(k,49) - lu(k,493) * b(k,44) + b(k,50) = b(k,50) - lu(k,494) * b(k,44) + b(k,46) = b(k,46) - lu(k,511) * b(k,45) + b(k,47) = b(k,47) - lu(k,512) * b(k,45) + b(k,48) = b(k,48) - lu(k,513) * b(k,45) + b(k,49) = b(k,49) - lu(k,514) * b(k,45) + b(k,50) = b(k,50) - lu(k,515) * b(k,45) + b(k,47) = b(k,47) - lu(k,543) * b(k,46) + b(k,48) = b(k,48) - lu(k,544) * b(k,46) + b(k,49) = b(k,49) - lu(k,545) * b(k,46) + b(k,50) = b(k,50) - lu(k,546) * b(k,46) + b(k,48) = b(k,48) - lu(k,563) * b(k,47) + b(k,49) = b(k,49) - lu(k,564) * b(k,47) + b(k,50) = b(k,50) - lu(k,565) * b(k,47) + b(k,49) = b(k,49) - lu(k,589) * b(k,48) + b(k,50) = b(k,50) - lu(k,590) * b(k,48) + b(k,50) = b(k,50) - lu(k,608) * b(k,49) end do end subroutine lu_slv02 subroutine lu_slv03( avec_len, lu, b ) @@ -383,194 +383,198 @@ subroutine lu_slv03( avec_len, lu, b ) b(k,38) = b(k,38) - lu(k,635) * b(k,50) b(k,37) = b(k,37) - lu(k,634) * b(k,50) b(k,36) = b(k,36) - lu(k,633) * b(k,50) - b(k,32) = b(k,32) - lu(k,632) * b(k,50) - b(k,5) = b(k,5) - lu(k,631) * b(k,50) - b(k,4) = b(k,4) - lu(k,630) * b(k,50) - b(k,49) = b(k,49) * lu(k,628) - b(k,48) = b(k,48) - lu(k,627) * b(k,49) - b(k,47) = b(k,47) - lu(k,626) * b(k,49) - b(k,46) = b(k,46) - lu(k,625) * b(k,49) - b(k,45) = b(k,45) - lu(k,624) * b(k,49) - b(k,44) = b(k,44) - lu(k,623) * b(k,49) - b(k,43) = b(k,43) - lu(k,622) * b(k,49) - b(k,42) = b(k,42) - lu(k,621) * b(k,49) - b(k,41) = b(k,41) - lu(k,620) * b(k,49) - b(k,40) = b(k,40) - lu(k,619) * b(k,49) - b(k,39) = b(k,39) - lu(k,618) * b(k,49) - b(k,38) = b(k,38) - lu(k,617) * b(k,49) - b(k,37) = b(k,37) - lu(k,616) * b(k,49) - b(k,36) = b(k,36) - lu(k,615) * b(k,49) - b(k,34) = b(k,34) - lu(k,614) * b(k,49) - b(k,33) = b(k,33) - lu(k,613) * b(k,49) - b(k,31) = b(k,31) - lu(k,612) * b(k,49) - b(k,21) = b(k,21) - lu(k,611) * b(k,49) - b(k,9) = b(k,9) - lu(k,610) * b(k,49) - b(k,48) = b(k,48) * lu(k,607) - b(k,47) = b(k,47) - lu(k,606) * b(k,48) - b(k,46) = b(k,46) - lu(k,605) * b(k,48) - b(k,45) = b(k,45) - lu(k,604) * b(k,48) - b(k,44) = b(k,44) - lu(k,603) * b(k,48) - b(k,43) = b(k,43) - lu(k,602) * b(k,48) - b(k,42) = b(k,42) - lu(k,601) * b(k,48) - b(k,41) = b(k,41) - lu(k,600) * b(k,48) - b(k,40) = b(k,40) - lu(k,599) * b(k,48) - b(k,39) = b(k,39) - lu(k,598) * b(k,48) - b(k,38) = b(k,38) - lu(k,597) * b(k,48) - b(k,37) = b(k,37) - lu(k,596) * b(k,48) - b(k,36) = b(k,36) - lu(k,595) * b(k,48) - b(k,35) = b(k,35) - lu(k,594) * b(k,48) - b(k,34) = b(k,34) - lu(k,593) * b(k,48) - b(k,33) = b(k,33) - lu(k,592) * b(k,48) - b(k,32) = b(k,32) - lu(k,591) * b(k,48) - b(k,31) = b(k,31) - lu(k,590) * b(k,48) - b(k,30) = b(k,30) - lu(k,589) * b(k,48) - b(k,29) = b(k,29) - lu(k,588) * b(k,48) - b(k,28) = b(k,28) - lu(k,587) * b(k,48) - b(k,27) = b(k,27) - lu(k,586) * b(k,48) - b(k,26) = b(k,26) - lu(k,585) * b(k,48) - b(k,25) = b(k,25) - lu(k,584) * b(k,48) - b(k,24) = b(k,24) - lu(k,583) * b(k,48) - b(k,23) = b(k,23) - lu(k,582) * b(k,48) - b(k,22) = b(k,22) - lu(k,581) * b(k,48) - b(k,20) = b(k,20) - lu(k,580) * b(k,48) - b(k,19) = b(k,19) - lu(k,579) * b(k,48) - b(k,18) = b(k,18) - lu(k,578) * b(k,48) - b(k,17) = b(k,17) - lu(k,577) * b(k,48) - b(k,16) = b(k,16) - lu(k,576) * b(k,48) - b(k,15) = b(k,15) - lu(k,575) * b(k,48) - b(k,14) = b(k,14) - lu(k,574) * b(k,48) - b(k,13) = b(k,13) - lu(k,573) * b(k,48) - b(k,5) = b(k,5) - lu(k,572) * b(k,48) - b(k,4) = b(k,4) - lu(k,571) * b(k,48) - b(k,47) = b(k,47) * lu(k,567) - b(k,46) = b(k,46) - lu(k,566) * b(k,47) - b(k,45) = b(k,45) - lu(k,565) * b(k,47) - b(k,44) = b(k,44) - lu(k,564) * b(k,47) - b(k,43) = b(k,43) - lu(k,563) * b(k,47) - b(k,42) = b(k,42) - lu(k,562) * b(k,47) - b(k,41) = b(k,41) - lu(k,561) * b(k,47) - b(k,40) = b(k,40) - lu(k,560) * b(k,47) - b(k,39) = b(k,39) - lu(k,559) * b(k,47) - b(k,38) = b(k,38) - lu(k,558) * b(k,47) - b(k,37) = b(k,37) - lu(k,557) * b(k,47) - b(k,36) = b(k,36) - lu(k,556) * b(k,47) - b(k,35) = b(k,35) - lu(k,555) * b(k,47) - b(k,34) = b(k,34) - lu(k,554) * b(k,47) - b(k,33) = b(k,33) - lu(k,553) * b(k,47) - b(k,32) = b(k,32) - lu(k,552) * b(k,47) - b(k,23) = b(k,23) - lu(k,551) * b(k,47) - b(k,22) = b(k,22) - lu(k,550) * b(k,47) - b(k,20) = b(k,20) - lu(k,549) * b(k,47) - b(k,17) = b(k,17) - lu(k,548) * b(k,47) - b(k,12) = b(k,12) - lu(k,547) * b(k,47) - b(k,11) = b(k,11) - lu(k,546) * b(k,47) - b(k,46) = b(k,46) * lu(k,541) - b(k,45) = b(k,45) - lu(k,540) * b(k,46) - b(k,44) = b(k,44) - lu(k,539) * b(k,46) - b(k,43) = b(k,43) - lu(k,538) * b(k,46) - b(k,42) = b(k,42) - lu(k,537) * b(k,46) - b(k,41) = b(k,41) - lu(k,536) * b(k,46) - b(k,40) = b(k,40) - lu(k,535) * b(k,46) - b(k,39) = b(k,39) - lu(k,534) * b(k,46) - b(k,38) = b(k,38) - lu(k,533) * b(k,46) - b(k,37) = b(k,37) - lu(k,532) * b(k,46) - b(k,36) = b(k,36) - lu(k,531) * b(k,46) - b(k,35) = b(k,35) - lu(k,530) * b(k,46) - b(k,34) = b(k,34) - lu(k,529) * b(k,46) - b(k,33) = b(k,33) - lu(k,528) * b(k,46) - b(k,32) = b(k,32) - lu(k,527) * b(k,46) - b(k,31) = b(k,31) - lu(k,526) * b(k,46) - b(k,30) = b(k,30) - lu(k,525) * b(k,46) - b(k,29) = b(k,29) - lu(k,524) * b(k,46) - b(k,23) = b(k,23) - lu(k,523) * b(k,46) - b(k,22) = b(k,22) - lu(k,522) * b(k,46) - b(k,21) = b(k,21) - lu(k,521) * b(k,46) - b(k,17) = b(k,17) - lu(k,520) * b(k,46) - b(k,16) = b(k,16) - lu(k,519) * b(k,46) - b(k,12) = b(k,12) - lu(k,518) * b(k,46) - b(k,11) = b(k,11) - lu(k,517) * b(k,46) - b(k,7) = b(k,7) - lu(k,516) * b(k,46) - b(k,2) = b(k,2) - lu(k,515) * b(k,46) - b(k,45) = b(k,45) * lu(k,509) - b(k,44) = b(k,44) - lu(k,508) * b(k,45) - b(k,43) = b(k,43) - lu(k,507) * b(k,45) - b(k,42) = b(k,42) - lu(k,506) * b(k,45) - b(k,41) = b(k,41) - lu(k,505) * b(k,45) - b(k,40) = b(k,40) - lu(k,504) * b(k,45) - b(k,39) = b(k,39) - lu(k,503) * b(k,45) - b(k,38) = b(k,38) - lu(k,502) * b(k,45) - b(k,37) = b(k,37) - lu(k,501) * b(k,45) - b(k,36) = b(k,36) - lu(k,500) * b(k,45) - b(k,34) = b(k,34) - lu(k,499) * b(k,45) - b(k,33) = b(k,33) - lu(k,498) * b(k,45) - b(k,32) = b(k,32) - lu(k,497) * b(k,45) - b(k,31) = b(k,31) - lu(k,496) * b(k,45) - b(k,30) = b(k,30) - lu(k,495) * b(k,45) - b(k,29) = b(k,29) - lu(k,494) * b(k,45) - b(k,20) = b(k,20) - lu(k,493) * b(k,45) - b(k,15) = b(k,15) - lu(k,492) * b(k,45) - b(k,12) = b(k,12) - lu(k,491) * b(k,45) - b(k,10) = b(k,10) - lu(k,490) * b(k,45) - b(k,44) = b(k,44) * lu(k,483) - b(k,43) = b(k,43) - lu(k,482) * b(k,44) - b(k,42) = b(k,42) - lu(k,481) * b(k,44) - b(k,41) = b(k,41) - lu(k,480) * b(k,44) - b(k,40) = b(k,40) - lu(k,479) * b(k,44) - b(k,39) = b(k,39) - lu(k,478) * b(k,44) - b(k,38) = b(k,38) - lu(k,477) * b(k,44) - b(k,37) = b(k,37) - lu(k,476) * b(k,44) - b(k,36) = b(k,36) - lu(k,475) * b(k,44) - b(k,35) = b(k,35) - lu(k,474) * b(k,44) - b(k,33) = b(k,33) - lu(k,473) * b(k,44) - b(k,32) = b(k,32) - lu(k,472) * b(k,44) - b(k,11) = b(k,11) - lu(k,471) * b(k,44) - b(k,43) = b(k,43) * lu(k,463) - b(k,42) = b(k,42) - lu(k,462) * b(k,43) - b(k,41) = b(k,41) - lu(k,461) * b(k,43) - b(k,40) = b(k,40) - lu(k,460) * b(k,43) - b(k,39) = b(k,39) - lu(k,459) * b(k,43) - b(k,38) = b(k,38) - lu(k,458) * b(k,43) - b(k,37) = b(k,37) - lu(k,457) * b(k,43) - b(k,36) = b(k,36) - lu(k,456) * b(k,43) - b(k,35) = b(k,35) - lu(k,455) * b(k,43) + b(k,35) = b(k,35) - lu(k,632) * b(k,50) + b(k,34) = b(k,34) - lu(k,631) * b(k,50) + b(k,33) = b(k,33) - lu(k,630) * b(k,50) + b(k,32) = b(k,32) - lu(k,629) * b(k,50) + b(k,31) = b(k,31) - lu(k,628) * b(k,50) + b(k,30) = b(k,30) - lu(k,627) * b(k,50) + b(k,29) = b(k,29) - lu(k,626) * b(k,50) + b(k,28) = b(k,28) - lu(k,625) * b(k,50) + b(k,27) = b(k,27) - lu(k,624) * b(k,50) + b(k,26) = b(k,26) - lu(k,623) * b(k,50) + b(k,25) = b(k,25) - lu(k,622) * b(k,50) + b(k,24) = b(k,24) - lu(k,621) * b(k,50) + b(k,23) = b(k,23) - lu(k,620) * b(k,50) + b(k,22) = b(k,22) - lu(k,619) * b(k,50) + b(k,20) = b(k,20) - lu(k,618) * b(k,50) + b(k,19) = b(k,19) - lu(k,617) * b(k,50) + b(k,18) = b(k,18) - lu(k,616) * b(k,50) + b(k,17) = b(k,17) - lu(k,615) * b(k,50) + b(k,16) = b(k,16) - lu(k,614) * b(k,50) + b(k,15) = b(k,15) - lu(k,613) * b(k,50) + b(k,14) = b(k,14) - lu(k,612) * b(k,50) + b(k,13) = b(k,13) - lu(k,611) * b(k,50) + b(k,5) = b(k,5) - lu(k,610) * b(k,50) + b(k,4) = b(k,4) - lu(k,609) * b(k,50) + b(k,49) = b(k,49) * lu(k,607) + b(k,48) = b(k,48) - lu(k,606) * b(k,49) + b(k,47) = b(k,47) - lu(k,605) * b(k,49) + b(k,46) = b(k,46) - lu(k,604) * b(k,49) + b(k,45) = b(k,45) - lu(k,603) * b(k,49) + b(k,44) = b(k,44) - lu(k,602) * b(k,49) + b(k,43) = b(k,43) - lu(k,601) * b(k,49) + b(k,42) = b(k,42) - lu(k,600) * b(k,49) + b(k,41) = b(k,41) - lu(k,599) * b(k,49) + b(k,40) = b(k,40) - lu(k,598) * b(k,49) + b(k,39) = b(k,39) - lu(k,597) * b(k,49) + b(k,38) = b(k,38) - lu(k,596) * b(k,49) + b(k,37) = b(k,37) - lu(k,595) * b(k,49) + b(k,36) = b(k,36) - lu(k,594) * b(k,49) + b(k,32) = b(k,32) - lu(k,593) * b(k,49) + b(k,5) = b(k,5) - lu(k,592) * b(k,49) + b(k,4) = b(k,4) - lu(k,591) * b(k,49) + b(k,48) = b(k,48) * lu(k,588) + b(k,47) = b(k,47) - lu(k,587) * b(k,48) + b(k,46) = b(k,46) - lu(k,586) * b(k,48) + b(k,45) = b(k,45) - lu(k,585) * b(k,48) + b(k,44) = b(k,44) - lu(k,584) * b(k,48) + b(k,43) = b(k,43) - lu(k,583) * b(k,48) + b(k,42) = b(k,42) - lu(k,582) * b(k,48) + b(k,41) = b(k,41) - lu(k,581) * b(k,48) + b(k,40) = b(k,40) - lu(k,580) * b(k,48) + b(k,39) = b(k,39) - lu(k,579) * b(k,48) + b(k,38) = b(k,38) - lu(k,578) * b(k,48) + b(k,37) = b(k,37) - lu(k,577) * b(k,48) + b(k,36) = b(k,36) - lu(k,576) * b(k,48) + b(k,35) = b(k,35) - lu(k,575) * b(k,48) + b(k,34) = b(k,34) - lu(k,574) * b(k,48) + b(k,33) = b(k,33) - lu(k,573) * b(k,48) + b(k,32) = b(k,32) - lu(k,572) * b(k,48) + b(k,31) = b(k,31) - lu(k,571) * b(k,48) + b(k,30) = b(k,30) - lu(k,570) * b(k,48) + b(k,23) = b(k,23) - lu(k,569) * b(k,48) + b(k,17) = b(k,17) - lu(k,568) * b(k,48) + b(k,16) = b(k,16) - lu(k,567) * b(k,48) + b(k,6) = b(k,6) - lu(k,566) * b(k,48) + b(k,47) = b(k,47) * lu(k,562) + b(k,46) = b(k,46) - lu(k,561) * b(k,47) + b(k,45) = b(k,45) - lu(k,560) * b(k,47) + b(k,44) = b(k,44) - lu(k,559) * b(k,47) + b(k,43) = b(k,43) - lu(k,558) * b(k,47) + b(k,42) = b(k,42) - lu(k,557) * b(k,47) + b(k,41) = b(k,41) - lu(k,556) * b(k,47) + b(k,40) = b(k,40) - lu(k,555) * b(k,47) + b(k,39) = b(k,39) - lu(k,554) * b(k,47) + b(k,38) = b(k,38) - lu(k,553) * b(k,47) + b(k,37) = b(k,37) - lu(k,552) * b(k,47) + b(k,36) = b(k,36) - lu(k,551) * b(k,47) + b(k,35) = b(k,35) - lu(k,550) * b(k,47) + b(k,33) = b(k,33) - lu(k,549) * b(k,47) + b(k,32) = b(k,32) - lu(k,548) * b(k,47) + b(k,11) = b(k,11) - lu(k,547) * b(k,47) + b(k,46) = b(k,46) * lu(k,542) + b(k,45) = b(k,45) - lu(k,541) * b(k,46) + b(k,44) = b(k,44) - lu(k,540) * b(k,46) + b(k,43) = b(k,43) - lu(k,539) * b(k,46) + b(k,42) = b(k,42) - lu(k,538) * b(k,46) + b(k,41) = b(k,41) - lu(k,537) * b(k,46) + b(k,40) = b(k,40) - lu(k,536) * b(k,46) + b(k,39) = b(k,39) - lu(k,535) * b(k,46) + b(k,38) = b(k,38) - lu(k,534) * b(k,46) + b(k,37) = b(k,37) - lu(k,533) * b(k,46) + b(k,36) = b(k,36) - lu(k,532) * b(k,46) + b(k,35) = b(k,35) - lu(k,531) * b(k,46) + b(k,34) = b(k,34) - lu(k,530) * b(k,46) + b(k,33) = b(k,33) - lu(k,529) * b(k,46) + b(k,32) = b(k,32) - lu(k,528) * b(k,46) + b(k,31) = b(k,31) - lu(k,527) * b(k,46) + b(k,30) = b(k,30) - lu(k,526) * b(k,46) + b(k,29) = b(k,29) - lu(k,525) * b(k,46) + b(k,23) = b(k,23) - lu(k,524) * b(k,46) + b(k,22) = b(k,22) - lu(k,523) * b(k,46) + b(k,21) = b(k,21) - lu(k,522) * b(k,46) + b(k,17) = b(k,17) - lu(k,521) * b(k,46) + b(k,16) = b(k,16) - lu(k,520) * b(k,46) + b(k,12) = b(k,12) - lu(k,519) * b(k,46) + b(k,11) = b(k,11) - lu(k,518) * b(k,46) + b(k,7) = b(k,7) - lu(k,517) * b(k,46) + b(k,2) = b(k,2) - lu(k,516) * b(k,46) + b(k,45) = b(k,45) * lu(k,510) + b(k,44) = b(k,44) - lu(k,509) * b(k,45) + b(k,43) = b(k,43) - lu(k,508) * b(k,45) + b(k,42) = b(k,42) - lu(k,507) * b(k,45) + b(k,41) = b(k,41) - lu(k,506) * b(k,45) + b(k,40) = b(k,40) - lu(k,505) * b(k,45) + b(k,39) = b(k,39) - lu(k,504) * b(k,45) + b(k,38) = b(k,38) - lu(k,503) * b(k,45) + b(k,37) = b(k,37) - lu(k,502) * b(k,45) + b(k,36) = b(k,36) - lu(k,501) * b(k,45) + b(k,35) = b(k,35) - lu(k,500) * b(k,45) + b(k,33) = b(k,33) - lu(k,499) * b(k,45) + b(k,32) = b(k,32) - lu(k,498) * b(k,45) + b(k,31) = b(k,31) - lu(k,497) * b(k,45) + b(k,16) = b(k,16) - lu(k,496) * b(k,45) + b(k,10) = b(k,10) - lu(k,495) * b(k,45) + b(k,44) = b(k,44) * lu(k,488) + b(k,43) = b(k,43) - lu(k,487) * b(k,44) + b(k,42) = b(k,42) - lu(k,486) * b(k,44) + b(k,41) = b(k,41) - lu(k,485) * b(k,44) + b(k,40) = b(k,40) - lu(k,484) * b(k,44) + b(k,39) = b(k,39) - lu(k,483) * b(k,44) + b(k,38) = b(k,38) - lu(k,482) * b(k,44) + b(k,37) = b(k,37) - lu(k,481) * b(k,44) + b(k,36) = b(k,36) - lu(k,480) * b(k,44) + b(k,34) = b(k,34) - lu(k,479) * b(k,44) + b(k,33) = b(k,33) - lu(k,478) * b(k,44) + b(k,32) = b(k,32) - lu(k,477) * b(k,44) + b(k,31) = b(k,31) - lu(k,476) * b(k,44) + b(k,20) = b(k,20) - lu(k,475) * b(k,44) + b(k,15) = b(k,15) - lu(k,474) * b(k,44) + b(k,8) = b(k,8) - lu(k,473) * b(k,44) + b(k,3) = b(k,3) - lu(k,472) * b(k,44) + b(k,43) = b(k,43) * lu(k,464) + b(k,42) = b(k,42) - lu(k,463) * b(k,43) + b(k,41) = b(k,41) - lu(k,462) * b(k,43) + b(k,40) = b(k,40) - lu(k,461) * b(k,43) + b(k,39) = b(k,39) - lu(k,460) * b(k,43) + b(k,38) = b(k,38) - lu(k,459) * b(k,43) + b(k,37) = b(k,37) - lu(k,458) * b(k,43) + b(k,36) = b(k,36) - lu(k,457) * b(k,43) + b(k,35) = b(k,35) - lu(k,456) * b(k,43) + b(k,34) = b(k,34) - lu(k,455) * b(k,43) b(k,33) = b(k,33) - lu(k,454) * b(k,43) b(k,32) = b(k,32) - lu(k,453) * b(k,43) - b(k,23) = b(k,23) - lu(k,452) * b(k,43) - b(k,16) = b(k,16) - lu(k,451) * b(k,43) - b(k,42) = b(k,42) * lu(k,442) - b(k,41) = b(k,41) - lu(k,441) * b(k,42) - b(k,40) = b(k,40) - lu(k,440) * b(k,42) - b(k,39) = b(k,39) - lu(k,439) * b(k,42) - b(k,38) = b(k,38) - lu(k,438) * b(k,42) - b(k,37) = b(k,37) - lu(k,437) * b(k,42) - b(k,36) = b(k,36) - lu(k,436) * b(k,42) - b(k,35) = b(k,35) - lu(k,435) * b(k,42) - b(k,34) = b(k,34) - lu(k,434) * b(k,42) - b(k,33) = b(k,33) - lu(k,433) * b(k,42) - b(k,32) = b(k,32) - lu(k,432) * b(k,42) - b(k,31) = b(k,31) - lu(k,431) * b(k,42) - b(k,23) = b(k,23) - lu(k,430) * b(k,42) - b(k,21) = b(k,21) - lu(k,429) * b(k,42) - b(k,7) = b(k,7) - lu(k,428) * b(k,42) - b(k,5) = b(k,5) - lu(k,427) * b(k,42) - b(k,2) = b(k,2) - lu(k,426) * b(k,42) - b(k,41) = b(k,41) * lu(k,416) - b(k,40) = b(k,40) - lu(k,415) * b(k,41) - b(k,39) = b(k,39) - lu(k,414) * b(k,41) - b(k,38) = b(k,38) - lu(k,413) * b(k,41) - b(k,37) = b(k,37) - lu(k,412) * b(k,41) - b(k,36) = b(k,36) - lu(k,411) * b(k,41) - b(k,35) = b(k,35) - lu(k,410) * b(k,41) - b(k,34) = b(k,34) - lu(k,409) * b(k,41) - b(k,33) = b(k,33) - lu(k,408) * b(k,41) - b(k,32) = b(k,32) - lu(k,407) * b(k,41) - b(k,31) = b(k,31) - lu(k,406) * b(k,41) - b(k,30) = b(k,30) - lu(k,405) * b(k,41) - b(k,22) = b(k,22) - lu(k,404) * b(k,41) - b(k,8) = b(k,8) - lu(k,403) * b(k,41) - b(k,6) = b(k,6) - lu(k,402) * b(k,41) - b(k,3) = b(k,3) - lu(k,401) * b(k,41) - b(k,1) = b(k,1) - lu(k,400) * b(k,41) + b(k,31) = b(k,31) - lu(k,452) * b(k,43) + b(k,30) = b(k,30) - lu(k,451) * b(k,43) + b(k,23) = b(k,23) - lu(k,450) * b(k,43) + b(k,8) = b(k,8) - lu(k,449) * b(k,43) + b(k,6) = b(k,6) - lu(k,448) * b(k,43) + b(k,3) = b(k,3) - lu(k,447) * b(k,43) + b(k,1) = b(k,1) - lu(k,446) * b(k,43) + b(k,42) = b(k,42) * lu(k,437) + b(k,41) = b(k,41) - lu(k,436) * b(k,42) + b(k,40) = b(k,40) - lu(k,435) * b(k,42) + b(k,39) = b(k,39) - lu(k,434) * b(k,42) + b(k,38) = b(k,38) - lu(k,433) * b(k,42) + b(k,37) = b(k,37) - lu(k,432) * b(k,42) + b(k,36) = b(k,36) - lu(k,431) * b(k,42) + b(k,35) = b(k,35) - lu(k,430) * b(k,42) + b(k,34) = b(k,34) - lu(k,429) * b(k,42) + b(k,33) = b(k,33) - lu(k,428) * b(k,42) + b(k,32) = b(k,32) - lu(k,427) * b(k,42) + b(k,31) = b(k,31) - lu(k,426) * b(k,42) + b(k,22) = b(k,22) - lu(k,425) * b(k,42) + b(k,21) = b(k,21) - lu(k,424) * b(k,42) + b(k,7) = b(k,7) - lu(k,423) * b(k,42) + b(k,5) = b(k,5) - lu(k,422) * b(k,42) + b(k,2) = b(k,2) - lu(k,421) * b(k,42) + b(k,41) = b(k,41) * lu(k,411) + b(k,40) = b(k,40) - lu(k,410) * b(k,41) + b(k,39) = b(k,39) - lu(k,409) * b(k,41) + b(k,38) = b(k,38) - lu(k,408) * b(k,41) + b(k,37) = b(k,37) - lu(k,407) * b(k,41) + b(k,36) = b(k,36) - lu(k,406) * b(k,41) + b(k,34) = b(k,34) - lu(k,405) * b(k,41) + b(k,33) = b(k,33) - lu(k,404) * b(k,41) + b(k,32) = b(k,32) - lu(k,403) * b(k,41) + b(k,31) = b(k,31) - lu(k,402) * b(k,41) + b(k,30) = b(k,30) - lu(k,401) * b(k,41) + b(k,29) = b(k,29) - lu(k,400) * b(k,41) + b(k,20) = b(k,20) - lu(k,399) * b(k,41) + b(k,15) = b(k,15) - lu(k,398) * b(k,41) + b(k,12) = b(k,12) - lu(k,397) * b(k,41) + b(k,10) = b(k,10) - lu(k,396) * b(k,41) end do end subroutine lu_slv03 subroutine lu_slv04( avec_len, lu, b ) @@ -591,51 +595,47 @@ subroutine lu_slv04( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,40) = b(k,40) * lu(k,389) - b(k,39) = b(k,39) - lu(k,388) * b(k,40) - b(k,38) = b(k,38) - lu(k,387) * b(k,40) - b(k,37) = b(k,37) - lu(k,386) * b(k,40) - b(k,36) = b(k,36) - lu(k,385) * b(k,40) - b(k,35) = b(k,35) - lu(k,384) * b(k,40) - b(k,34) = b(k,34) - lu(k,383) * b(k,40) - b(k,33) = b(k,33) - lu(k,382) * b(k,40) - b(k,32) = b(k,32) - lu(k,381) * b(k,40) - b(k,31) = b(k,31) - lu(k,380) * b(k,40) - b(k,30) = b(k,30) - lu(k,379) * b(k,40) - b(k,22) = b(k,22) - lu(k,378) * b(k,40) - b(k,17) = b(k,17) - lu(k,377) * b(k,40) - b(k,16) = b(k,16) - lu(k,376) * b(k,40) - b(k,6) = b(k,6) - lu(k,375) * b(k,40) - b(k,39) = b(k,39) * lu(k,363) - b(k,38) = b(k,38) - lu(k,362) * b(k,39) - b(k,37) = b(k,37) - lu(k,361) * b(k,39) - b(k,36) = b(k,36) - lu(k,360) * b(k,39) - b(k,34) = b(k,34) - lu(k,359) * b(k,39) - b(k,33) = b(k,33) - lu(k,358) * b(k,39) - b(k,32) = b(k,32) - lu(k,357) * b(k,39) + b(k,40) = b(k,40) * lu(k,385) + b(k,39) = b(k,39) - lu(k,384) * b(k,40) + b(k,38) = b(k,38) - lu(k,383) * b(k,40) + b(k,37) = b(k,37) - lu(k,382) * b(k,40) + b(k,36) = b(k,36) - lu(k,381) * b(k,40) + b(k,35) = b(k,35) - lu(k,380) * b(k,40) + b(k,32) = b(k,32) - lu(k,379) * b(k,40) + b(k,29) = b(k,29) - lu(k,378) * b(k,40) + b(k,28) = b(k,28) - lu(k,377) * b(k,40) + b(k,27) = b(k,27) - lu(k,376) * b(k,40) + b(k,26) = b(k,26) - lu(k,375) * b(k,40) + b(k,19) = b(k,19) - lu(k,374) * b(k,40) + b(k,39) = b(k,39) * lu(k,362) + b(k,38) = b(k,38) - lu(k,361) * b(k,39) + b(k,37) = b(k,37) - lu(k,360) * b(k,39) + b(k,36) = b(k,36) - lu(k,359) * b(k,39) + b(k,34) = b(k,34) - lu(k,358) * b(k,39) + b(k,33) = b(k,33) - lu(k,357) * b(k,39) b(k,31) = b(k,31) - lu(k,356) * b(k,39) - b(k,20) = b(k,20) - lu(k,355) * b(k,39) - b(k,15) = b(k,15) - lu(k,354) * b(k,39) - b(k,8) = b(k,8) - lu(k,353) * b(k,39) - b(k,3) = b(k,3) - lu(k,352) * b(k,39) - b(k,38) = b(k,38) * lu(k,339) - b(k,37) = b(k,37) - lu(k,338) * b(k,38) - b(k,36) = b(k,36) - lu(k,337) * b(k,38) - b(k,35) = b(k,35) - lu(k,336) * b(k,38) - b(k,32) = b(k,32) - lu(k,335) * b(k,38) - b(k,29) = b(k,29) - lu(k,334) * b(k,38) - b(k,28) = b(k,28) - lu(k,333) * b(k,38) - b(k,27) = b(k,27) - lu(k,332) * b(k,38) - b(k,26) = b(k,26) - lu(k,331) * b(k,38) - b(k,19) = b(k,19) - lu(k,330) * b(k,38) - b(k,37) = b(k,37) * lu(k,316) - b(k,36) = b(k,36) - lu(k,315) * b(k,37) - b(k,35) = b(k,35) - lu(k,314) * b(k,37) - b(k,33) = b(k,33) - lu(k,313) * b(k,37) - b(k,32) = b(k,32) - lu(k,312) * b(k,37) - b(k,31) = b(k,31) - lu(k,311) * b(k,37) - b(k,16) = b(k,16) - lu(k,310) * b(k,37) - b(k,10) = b(k,10) - lu(k,309) * b(k,37) + b(k,21) = b(k,21) - lu(k,355) * b(k,39) + b(k,9) = b(k,9) - lu(k,354) * b(k,39) + b(k,38) = b(k,38) * lu(k,341) + b(k,37) = b(k,37) - lu(k,340) * b(k,38) + b(k,36) = b(k,36) - lu(k,339) * b(k,38) + b(k,35) = b(k,35) - lu(k,338) * b(k,38) + b(k,33) = b(k,33) - lu(k,337) * b(k,38) + b(k,32) = b(k,32) - lu(k,336) * b(k,38) + b(k,22) = b(k,22) - lu(k,335) * b(k,38) + b(k,16) = b(k,16) - lu(k,334) * b(k,38) + b(k,37) = b(k,37) * lu(k,320) + b(k,36) = b(k,36) - lu(k,319) * b(k,37) + b(k,35) = b(k,35) - lu(k,318) * b(k,37) + b(k,34) = b(k,34) - lu(k,317) * b(k,37) + b(k,33) = b(k,33) - lu(k,316) * b(k,37) + b(k,32) = b(k,32) - lu(k,315) * b(k,37) + b(k,23) = b(k,23) - lu(k,314) * b(k,37) + b(k,22) = b(k,22) - lu(k,313) * b(k,37) + b(k,20) = b(k,20) - lu(k,312) * b(k,37) + b(k,17) = b(k,17) - lu(k,311) * b(k,37) + b(k,12) = b(k,12) - lu(k,310) * b(k,37) + b(k,11) = b(k,11) - lu(k,309) * b(k,37) b(k,36) = b(k,36) * lu(k,298) b(k,33) = b(k,33) - lu(k,297) * b(k,36) b(k,32) = b(k,32) - lu(k,296) * b(k,36) @@ -643,13 +643,13 @@ subroutine lu_slv04( avec_len, lu, b ) b(k,34) = b(k,34) - lu(k,281) * b(k,35) b(k,33) = b(k,33) - lu(k,280) * b(k,35) b(k,31) = b(k,31) - lu(k,279) * b(k,35) - b(k,23) = b(k,23) - lu(k,278) * b(k,35) + b(k,22) = b(k,22) - lu(k,278) * b(k,35) b(k,16) = b(k,16) - lu(k,277) * b(k,35) b(k,34) = b(k,34) * lu(k,264) b(k,33) = b(k,33) - lu(k,263) * b(k,34) b(k,31) = b(k,31) - lu(k,262) * b(k,34) b(k,30) = b(k,30) - lu(k,261) * b(k,34) - b(k,22) = b(k,22) - lu(k,260) * b(k,34) + b(k,23) = b(k,23) - lu(k,260) * b(k,34) b(k,20) = b(k,20) - lu(k,259) * b(k,34) b(k,8) = b(k,8) - lu(k,258) * b(k,34) b(k,6) = b(k,6) - lu(k,257) * b(k,34) @@ -674,7 +674,7 @@ subroutine lu_slv04( avec_len, lu, b ) b(k,21) = b(k,21) - lu(k,215) * b(k,31) b(k,9) = b(k,9) - lu(k,214) * b(k,31) b(k,30) = b(k,30) * lu(k,204) - b(k,22) = b(k,22) - lu(k,203) * b(k,30) + b(k,23) = b(k,23) - lu(k,203) * b(k,30) b(k,6) = b(k,6) - lu(k,202) * b(k,30) b(k,29) = b(k,29) * lu(k,193) b(k,28) = b(k,28) - lu(k,192) * b(k,29) @@ -704,9 +704,9 @@ subroutine lu_slv04( avec_len, lu, b ) b(k,16) = b(k,16) - lu(k,135) * b(k,25) b(k,24) = b(k,24) * lu(k,127) b(k,19) = b(k,19) - lu(k,126) * b(k,24) - b(k,23) = b(k,23) * lu(k,118) - b(k,22) = b(k,22) * lu(k,111) - b(k,6) = b(k,6) - lu(k,110) * b(k,22) + b(k,23) = b(k,23) * lu(k,119) + b(k,6) = b(k,6) - lu(k,118) * b(k,23) + b(k,22) = b(k,22) * lu(k,110) b(k,21) = b(k,21) * lu(k,102) b(k,9) = b(k,9) - lu(k,101) * b(k,21) b(k,20) = b(k,20) * lu(k,93) diff --git a/src/chemistry/pp_waccm_ma/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_ma/mo_nln_matrix.F90 index fd393fb657..6704f24962 100644 --- a/src/chemistry/pp_waccm_ma/mo_nln_matrix.F90 +++ b/src/chemistry/pp_waccm_ma/mo_nln_matrix.F90 @@ -22,217 +22,214 @@ subroutine nlnmat01( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,353) = rxt(k,192)*y(k,24) - mat(k,403) = rxt(k,192)*y(k,2) - mat(k,258) = (rxt(k,254)+rxt(k,259))*y(k,45) - mat(k,92) = (rxt(k,254)+rxt(k,259))*y(k,40) - mat(k,363) = -(4._r8*rxt(k,189)*y(k,2) + (rxt(k,190) + rxt(k,191) + rxt(k,192) & - ) * y(k,24) + rxt(k,193)*y(k,43) + rxt(k,194)*y(k,50) + rxt(k,195) & - *y(k,51) + rxt(k,197)*y(k,53) + rxt(k,198)*y(k,69)) - mat(k,414) = -(rxt(k,190) + rxt(k,191) + rxt(k,192)) * y(k,2) - mat(k,559) = -rxt(k,193)*y(k,2) - mat(k,340) = -rxt(k,194)*y(k,2) - mat(k,503) = -rxt(k,195)*y(k,2) - mat(k,598) = -rxt(k,197)*y(k,2) - mat(k,534) = -rxt(k,198)*y(k,2) - mat(k,63) = rxt(k,196)*y(k,53) - mat(k,121) = rxt(k,206)*y(k,65) - mat(k,96) = rxt(k,201)*y(k,53) - mat(k,598) = mat(k,598) + rxt(k,196)*y(k,3) + rxt(k,201)*y(k,45) - mat(k,636) = rxt(k,188)*y(k,58) - mat(k,459) = rxt(k,188)*y(k,55) - mat(k,439) = rxt(k,206)*y(k,36) - mat(k,59) = -(rxt(k,196)*y(k,53)) - mat(k,575) = -rxt(k,196)*y(k,3) - mat(k,354) = rxt(k,195)*y(k,51) - mat(k,492) = rxt(k,195)*y(k,2) - mat(k,282) = -(rxt(k,150)*y(k,59) + rxt(k,186)*y(k,58) + rxt(k,230)*y(k,52) & - + rxt(k,231)*y(k,53) + rxt(k,232)*y(k,69)) - mat(k,384) = -rxt(k,150)*y(k,14) - mat(k,455) = -rxt(k,186)*y(k,14) - mat(k,314) = -rxt(k,230)*y(k,14) - mat(k,594) = -rxt(k,231)*y(k,14) - mat(k,530) = -rxt(k,232)*y(k,14) - mat(k,474) = rxt(k,157)*y(k,24) + rxt(k,234)*y(k,50) + mat(k,341) = -(rxt(k,186)*y(k,15) + rxt(k,187)*y(k,60) + rxt(k,188)*y(k,56)) + mat(k,285) = -rxt(k,186)*y(k,1) + mat(k,321) = -rxt(k,187)*y(k,1) + mat(k,596) = -rxt(k,188)*y(k,1) + mat(k,482) = 4.000_r8*rxt(k,189)*y(k,3) + (rxt(k,190)+rxt(k,191))*y(k,26) & + + rxt(k,194)*y(k,51) + rxt(k,197)*y(k,54) + rxt(k,198)*y(k,69) + mat(k,459) = (rxt(k,190)+rxt(k,191))*y(k,3) + mat(k,113) = rxt(k,199)*y(k,54) + rxt(k,205)*y(k,65) + rxt(k,200)*y(k,69) + mat(k,383) = rxt(k,194)*y(k,3) + mat(k,635) = rxt(k,197)*y(k,3) + rxt(k,199)*y(k,38) + mat(k,433) = rxt(k,205)*y(k,38) + mat(k,534) = rxt(k,198)*y(k,3) + rxt(k,200)*y(k,38) + mat(k,473) = rxt(k,192)*y(k,26) + mat(k,449) = rxt(k,192)*y(k,3) + mat(k,258) = (rxt(k,254)+rxt(k,259))*y(k,46) + mat(k,92) = (rxt(k,254)+rxt(k,259))*y(k,42) + mat(k,488) = -(4._r8*rxt(k,189)*y(k,3) + (rxt(k,190) + rxt(k,191) + rxt(k,192) & + ) * y(k,26) + rxt(k,193)*y(k,60) + rxt(k,194)*y(k,51) + rxt(k,195) & + *y(k,52) + rxt(k,197)*y(k,54) + rxt(k,198)*y(k,69)) + mat(k,465) = -(rxt(k,190) + rxt(k,191) + rxt(k,192)) * y(k,3) + mat(k,327) = -rxt(k,193)*y(k,3) + mat(k,389) = -rxt(k,194)*y(k,3) + mat(k,414) = -rxt(k,195)*y(k,3) + mat(k,641) = -rxt(k,197)*y(k,3) + mat(k,540) = -rxt(k,198)*y(k,3) + mat(k,347) = rxt(k,188)*y(k,56) + mat(k,64) = rxt(k,196)*y(k,54) + mat(k,115) = rxt(k,206)*y(k,65) + mat(k,97) = rxt(k,201)*y(k,54) + mat(k,641) = mat(k,641) + rxt(k,196)*y(k,4) + rxt(k,201)*y(k,46) + mat(k,602) = rxt(k,188)*y(k,1) + mat(k,439) = rxt(k,206)*y(k,38) + mat(k,59) = -(rxt(k,196)*y(k,54)) + mat(k,613) = -rxt(k,196)*y(k,4) + mat(k,474) = rxt(k,195)*y(k,52) + mat(k,398) = rxt(k,195)*y(k,3) + mat(k,282) = -(rxt(k,150)*y(k,23) + rxt(k,186)*y(k,1) + rxt(k,230)*y(k,53) & + + rxt(k,231)*y(k,54) + rxt(k,232)*y(k,69)) + mat(k,575) = -rxt(k,150)*y(k,15) + mat(k,338) = -rxt(k,186)*y(k,15) + mat(k,500) = -rxt(k,230)*y(k,15) + mat(k,632) = -rxt(k,231)*y(k,15) + mat(k,531) = -rxt(k,232)*y(k,15) + mat(k,550) = rxt(k,157)*y(k,26) + rxt(k,234)*y(k,51) mat(k,35) = .300_r8*rxt(k,235)*y(k,69) - mat(k,410) = rxt(k,157)*y(k,18) - mat(k,336) = rxt(k,234)*y(k,18) - mat(k,530) = mat(k,530) + .300_r8*rxt(k,235)*y(k,19) - mat(k,483) = -(rxt(k,157)*y(k,24) + rxt(k,233)*y(k,43) + rxt(k,234)*y(k,50)) - mat(k,419) = -rxt(k,157)*y(k,18) - mat(k,564) = -rxt(k,233)*y(k,18) - mat(k,345) = -rxt(k,234)*y(k,18) - mat(k,37) = .700_r8*rxt(k,235)*y(k,69) - mat(k,539) = .700_r8*rxt(k,235)*y(k,19) + mat(k,456) = rxt(k,157)*y(k,19) + mat(k,380) = rxt(k,234)*y(k,19) + mat(k,531) = mat(k,531) + .300_r8*rxt(k,235)*y(k,20) + mat(k,562) = -(rxt(k,157)*y(k,26) + rxt(k,233)*y(k,60) + rxt(k,234)*y(k,51)) + mat(k,468) = -rxt(k,157)*y(k,19) + mat(k,330) = -rxt(k,233)*y(k,19) + mat(k,392) = -rxt(k,234)*y(k,19) + mat(k,38) = .700_r8*rxt(k,235)*y(k,69) + mat(k,543) = .700_r8*rxt(k,235)*y(k,20) mat(k,33) = -(rxt(k,235)*y(k,69)) - mat(k,517) = -rxt(k,235)*y(k,19) - mat(k,471) = rxt(k,233)*y(k,43) - mat(k,546) = rxt(k,233)*y(k,18) - mat(k,402) = 2.000_r8*rxt(k,159)*y(k,24) - mat(k,202) = (rxt(k,252)+rxt(k,257)+rxt(k,262))*y(k,40) + rxt(k,163)*y(k,59) - mat(k,257) = (rxt(k,252)+rxt(k,257)+rxt(k,262))*y(k,25) + (rxt(k,247) & - +rxt(k,253)+rxt(k,258))*y(k,46) - mat(k,110) = (rxt(k,247)+rxt(k,253)+rxt(k,258))*y(k,40) - mat(k,375) = rxt(k,163)*y(k,25) - mat(k,400) = 2.000_r8*rxt(k,184)*y(k,24) - mat(k,416) = -(rxt(k,157)*y(k,18) + (4._r8*rxt(k,158) + 4._r8*rxt(k,159) & - + 4._r8*rxt(k,160) + 4._r8*rxt(k,184)) * y(k,24) + rxt(k,161) & - *y(k,43) + rxt(k,162)*y(k,50) + rxt(k,164)*y(k,51) + rxt(k,167) & - *y(k,53) + (rxt(k,168) + rxt(k,169)) * y(k,69) + (rxt(k,190) & - + rxt(k,191) + rxt(k,192)) * y(k,2)) - mat(k,480) = -rxt(k,157)*y(k,24) - mat(k,561) = -rxt(k,161)*y(k,24) - mat(k,342) = -rxt(k,162)*y(k,24) - mat(k,505) = -rxt(k,164)*y(k,24) - mat(k,600) = -rxt(k,167)*y(k,24) - mat(k,536) = -(rxt(k,168) + rxt(k,169)) * y(k,24) - mat(k,365) = -(rxt(k,190) + rxt(k,191) + rxt(k,192)) * y(k,24) - mat(k,210) = rxt(k,165)*y(k,53) - mat(k,269) = rxt(k,183)*y(k,65) - mat(k,561) = mat(k,561) + rxt(k,155)*y(k,59) - mat(k,115) = rxt(k,173)*y(k,53) + rxt(k,172)*y(k,59) + rxt(k,174)*y(k,69) - mat(k,600) = mat(k,600) + rxt(k,165)*y(k,25) + rxt(k,173)*y(k,46) - mat(k,638) = rxt(k,156)*y(k,59) - mat(k,390) = rxt(k,155)*y(k,43) + rxt(k,172)*y(k,46) + rxt(k,156)*y(k,55) - mat(k,441) = rxt(k,183)*y(k,40) - mat(k,536) = mat(k,536) + rxt(k,174)*y(k,46) - mat(k,204) = -(rxt(k,163)*y(k,59) + rxt(k,165)*y(k,53) + rxt(k,166)*y(k,69) & - + (rxt(k,252) + rxt(k,257) + rxt(k,262)) * y(k,40)) - mat(k,379) = -rxt(k,163)*y(k,25) - mat(k,589) = -rxt(k,165)*y(k,25) - mat(k,525) = -rxt(k,166)*y(k,25) - mat(k,261) = -(rxt(k,252) + rxt(k,257) + rxt(k,262)) * y(k,25) - mat(k,405) = rxt(k,164)*y(k,51) - mat(k,495) = rxt(k,164)*y(k,24) + mat(k,518) = -rxt(k,235)*y(k,20) + mat(k,547) = rxt(k,233)*y(k,60) + mat(k,309) = rxt(k,233)*y(k,19) + mat(k,588) = -(rxt(k,150)*y(k,15) + rxt(k,152)*y(k,35) + rxt(k,153)*y(k,37) & + + (rxt(k,154) + rxt(k,155)) * y(k,60) + rxt(k,156)*y(k,56) & + + rxt(k,163)*y(k,27) + rxt(k,172)*y(k,47)) + mat(k,294) = -rxt(k,150)*y(k,23) + mat(k,371) = -rxt(k,152)*y(k,23) + mat(k,76) = -rxt(k,153)*y(k,23) + mat(k,331) = -(rxt(k,154) + rxt(k,155)) * y(k,23) + mat(k,606) = -rxt(k,156)*y(k,23) + mat(k,212) = -rxt(k,163)*y(k,23) + mat(k,124) = -rxt(k,172)*y(k,23) + mat(k,492) = rxt(k,191)*y(k,26) + mat(k,563) = rxt(k,157)*y(k,26) + mat(k,469) = rxt(k,191)*y(k,3) + rxt(k,157)*y(k,19) + (4.000_r8*rxt(k,158) & + +2.000_r8*rxt(k,160))*y(k,26) + rxt(k,162)*y(k,51) + rxt(k,167) & + *y(k,54) + rxt(k,168)*y(k,69) + mat(k,20) = rxt(k,212)*y(k,65) + mat(k,275) = rxt(k,170)*y(k,54) + rxt(k,182)*y(k,65) + rxt(k,171)*y(k,69) + mat(k,393) = rxt(k,162)*y(k,26) + mat(k,645) = rxt(k,167)*y(k,26) + rxt(k,170)*y(k,42) + mat(k,443) = rxt(k,212)*y(k,32) + rxt(k,182)*y(k,42) + mat(k,544) = rxt(k,168)*y(k,26) + rxt(k,171)*y(k,42) + mat(k,566) = rxt(k,163)*y(k,27) + mat(k,448) = 2.000_r8*rxt(k,159)*y(k,26) + mat(k,202) = rxt(k,163)*y(k,23) + (rxt(k,252)+rxt(k,257)+rxt(k,262))*y(k,42) + mat(k,257) = (rxt(k,252)+rxt(k,257)+rxt(k,262))*y(k,27) + (rxt(k,247) & + +rxt(k,253)+rxt(k,258))*y(k,47) + mat(k,118) = (rxt(k,247)+rxt(k,253)+rxt(k,258))*y(k,42) + mat(k,446) = 2.000_r8*rxt(k,184)*y(k,26) + mat(k,464) = -(rxt(k,157)*y(k,19) + (4._r8*rxt(k,158) + 4._r8*rxt(k,159) & + + 4._r8*rxt(k,160) + 4._r8*rxt(k,184)) * y(k,26) + rxt(k,161) & + *y(k,60) + rxt(k,162)*y(k,51) + rxt(k,164)*y(k,52) + rxt(k,167) & + *y(k,54) + (rxt(k,168) + rxt(k,169)) * y(k,69) + (rxt(k,190) & + + rxt(k,191) + rxt(k,192)) * y(k,3)) + mat(k,558) = -rxt(k,157)*y(k,26) + mat(k,326) = -rxt(k,161)*y(k,26) + mat(k,388) = -rxt(k,162)*y(k,26) + mat(k,413) = -rxt(k,164)*y(k,26) + mat(k,640) = -rxt(k,167)*y(k,26) + mat(k,539) = -(rxt(k,168) + rxt(k,169)) * y(k,26) + mat(k,487) = -(rxt(k,190) + rxt(k,191) + rxt(k,192)) * y(k,26) + mat(k,583) = rxt(k,172)*y(k,47) + rxt(k,156)*y(k,56) + rxt(k,155)*y(k,60) + mat(k,209) = rxt(k,165)*y(k,54) + mat(k,270) = rxt(k,183)*y(k,65) + mat(k,122) = rxt(k,172)*y(k,23) + rxt(k,173)*y(k,54) + rxt(k,174)*y(k,69) + mat(k,640) = mat(k,640) + rxt(k,165)*y(k,27) + rxt(k,173)*y(k,47) + mat(k,601) = rxt(k,156)*y(k,23) + mat(k,326) = mat(k,326) + rxt(k,155)*y(k,23) + mat(k,438) = rxt(k,183)*y(k,42) + mat(k,539) = mat(k,539) + rxt(k,174)*y(k,47) + mat(k,204) = -(rxt(k,163)*y(k,23) + rxt(k,165)*y(k,54) + rxt(k,166)*y(k,69) & + + (rxt(k,252) + rxt(k,257) + rxt(k,262)) * y(k,42)) + mat(k,570) = -rxt(k,163)*y(k,27) + mat(k,627) = -rxt(k,165)*y(k,27) + mat(k,526) = -rxt(k,166)*y(k,27) + mat(k,261) = -(rxt(k,252) + rxt(k,257) + rxt(k,262)) * y(k,27) + mat(k,451) = rxt(k,164)*y(k,52) + mat(k,401) = rxt(k,164)*y(k,26) mat(k,67) = -((rxt(k,237) + rxt(k,241)) * y(k,69)) - mat(k,519) = -(rxt(k,237) + rxt(k,241)) * y(k,27) - mat(k,277) = rxt(k,230)*y(k,52) + rxt(k,231)*y(k,53) + rxt(k,186)*y(k,58) & - + rxt(k,150)*y(k,59) + rxt(k,232)*y(k,69) - mat(k,310) = rxt(k,230)*y(k,14) - mat(k,576) = rxt(k,231)*y(k,14) - mat(k,451) = rxt(k,186)*y(k,14) - mat(k,376) = rxt(k,150)*y(k,14) - mat(k,519) = mat(k,519) + rxt(k,232)*y(k,14) + mat(k,520) = -(rxt(k,237) + rxt(k,241)) * y(k,29) + mat(k,334) = rxt(k,186)*y(k,15) + mat(k,277) = rxt(k,186)*y(k,1) + rxt(k,150)*y(k,23) + rxt(k,230)*y(k,53) & + + rxt(k,231)*y(k,54) + rxt(k,232)*y(k,69) + mat(k,567) = rxt(k,150)*y(k,15) + mat(k,496) = rxt(k,230)*y(k,15) + mat(k,614) = rxt(k,231)*y(k,15) + mat(k,520) = mat(k,520) + rxt(k,232)*y(k,15) mat(k,4) = -(rxt(k,211)*y(k,65)) - mat(k,426) = -rxt(k,211)*y(k,29) + mat(k,421) = -rxt(k,211)*y(k,31) mat(k,17) = -(rxt(k,212)*y(k,65)) - mat(k,428) = -rxt(k,212)*y(k,30) - mat(k,102) = -(rxt(k,208)*y(k,33) + rxt(k,209)*y(k,73) + rxt(k,210)*y(k,42)) - mat(k,611) = -rxt(k,208)*y(k,31) - mat(k,246) = -rxt(k,209)*y(k,31) - mat(k,215) = -rxt(k,210)*y(k,31) + mat(k,423) = -rxt(k,212)*y(k,32) + mat(k,102) = -(rxt(k,208)*y(k,35) + rxt(k,209)*y(k,73) + rxt(k,210)*y(k,44)) + mat(k,355) = -rxt(k,208)*y(k,33) + mat(k,246) = -rxt(k,209)*y(k,33) + mat(k,215) = -rxt(k,210)*y(k,33) mat(k,5) = 2.000_r8*rxt(k,211)*y(k,65) mat(k,18) = rxt(k,212)*y(k,65) - mat(k,429) = 2.000_r8*rxt(k,211)*y(k,29) + rxt(k,212)*y(k,30) - mat(k,298) = -((rxt(k,108) + rxt(k,109) + rxt(k,110)) * y(k,43) + rxt(k,111) & - *y(k,54) + rxt(k,114)*y(k,55)) - mat(k,556) = -(rxt(k,108) + rxt(k,109) + rxt(k,110)) * y(k,32) - mat(k,237) = -rxt(k,111)*y(k,32) - mat(k,633) = -rxt(k,114)*y(k,32) + mat(k,424) = 2.000_r8*rxt(k,211)*y(k,31) + rxt(k,212)*y(k,32) + mat(k,298) = -((rxt(k,108) + rxt(k,109) + rxt(k,110)) * y(k,60) + rxt(k,111) & + *y(k,55) + rxt(k,114)*y(k,56)) + mat(k,319) = -(rxt(k,108) + rxt(k,109) + rxt(k,110)) * y(k,34) + mat(k,237) = -rxt(k,111)*y(k,34) + mat(k,594) = -rxt(k,114)*y(k,34) mat(k,283) = rxt(k,232)*y(k,69) + mat(k,576) = rxt(k,152)*y(k,35) mat(k,68) = rxt(k,241)*y(k,69) - mat(k,105) = rxt(k,208)*y(k,33) - mat(k,615) = rxt(k,208)*y(k,31) + rxt(k,106)*y(k,53) + rxt(k,152)*y(k,59) & + mat(k,105) = rxt(k,208)*y(k,35) + mat(k,359) = rxt(k,152)*y(k,23) + rxt(k,208)*y(k,33) + rxt(k,106)*y(k,54) & + rxt(k,89)*y(k,65) + rxt(k,115)*y(k,69) - mat(k,120) = rxt(k,206)*y(k,65) + mat(k,112) = rxt(k,206)*y(k,65) mat(k,265) = rxt(k,183)*y(k,65) mat(k,195) = rxt(k,138)*y(k,69) - mat(k,595) = rxt(k,106)*y(k,33) + rxt(k,118)*y(k,69) - mat(k,385) = rxt(k,152)*y(k,33) - mat(k,436) = rxt(k,89)*y(k,33) + rxt(k,206)*y(k,36) + rxt(k,183)*y(k,40) - mat(k,531) = rxt(k,232)*y(k,14) + rxt(k,241)*y(k,27) + rxt(k,115)*y(k,33) & - + rxt(k,138)*y(k,47) + rxt(k,118)*y(k,53) - mat(k,628) = -(rxt(k,89)*y(k,65) + rxt(k,106)*y(k,53) + rxt(k,115)*y(k,69) & - + rxt(k,152)*y(k,59) + rxt(k,208)*y(k,31)) - mat(k,449) = -rxt(k,89)*y(k,33) - mat(k,608) = -rxt(k,106)*y(k,33) - mat(k,544) = -rxt(k,115)*y(k,33) - mat(k,398) = -rxt(k,152)*y(k,33) - mat(k,109) = -rxt(k,208)*y(k,33) - mat(k,307) = rxt(k,108)*y(k,43) - mat(k,569) = rxt(k,108)*y(k,32) - mat(k,71) = -(rxt(k,107)*y(k,53) + rxt(k,116)*y(k,69) + rxt(k,153)*y(k,59)) - mat(k,577) = -rxt(k,107)*y(k,35) - mat(k,520) = -rxt(k,116)*y(k,35) - mat(k,377) = -rxt(k,153)*y(k,35) - mat(k,548) = 2.000_r8*rxt(k,122)*y(k,43) - mat(k,520) = mat(k,520) + 2.000_r8*rxt(k,121)*y(k,69) - mat(k,118) = -(rxt(k,199)*y(k,53) + rxt(k,200)*y(k,69) + (rxt(k,205) & + mat(k,633) = rxt(k,106)*y(k,35) + rxt(k,118)*y(k,69) + mat(k,431) = rxt(k,89)*y(k,35) + rxt(k,206)*y(k,38) + rxt(k,183)*y(k,42) + mat(k,532) = rxt(k,232)*y(k,15) + rxt(k,241)*y(k,29) + rxt(k,115)*y(k,35) & + + rxt(k,138)*y(k,48) + rxt(k,118)*y(k,54) + mat(k,362) = -(rxt(k,89)*y(k,65) + rxt(k,106)*y(k,54) + rxt(k,115)*y(k,69) & + + rxt(k,152)*y(k,23) + rxt(k,208)*y(k,33)) + mat(k,434) = -rxt(k,89)*y(k,35) + mat(k,636) = -rxt(k,106)*y(k,35) + mat(k,535) = -rxt(k,115)*y(k,35) + mat(k,579) = -rxt(k,152)*y(k,35) + mat(k,106) = -rxt(k,208)*y(k,35) + mat(k,300) = rxt(k,108)*y(k,60) + mat(k,322) = rxt(k,108)*y(k,34) + mat(k,71) = -(rxt(k,107)*y(k,54) + rxt(k,116)*y(k,69) + rxt(k,153)*y(k,23)) + mat(k,615) = -rxt(k,107)*y(k,37) + mat(k,521) = -rxt(k,116)*y(k,37) + mat(k,568) = -rxt(k,153)*y(k,37) + mat(k,311) = 2.000_r8*rxt(k,122)*y(k,60) + mat(k,521) = mat(k,521) + 2.000_r8*rxt(k,121)*y(k,69) + mat(k,110) = -(rxt(k,199)*y(k,54) + rxt(k,200)*y(k,69) + (rxt(k,205) & + rxt(k,206)) * y(k,65)) - mat(k,582) = -rxt(k,199)*y(k,36) - mat(k,523) = -rxt(k,200)*y(k,36) - mat(k,430) = -(rxt(k,205) + rxt(k,206)) * y(k,36) - mat(k,278) = rxt(k,186)*y(k,58) - mat(k,551) = rxt(k,187)*y(k,58) - mat(k,452) = rxt(k,186)*y(k,14) + rxt(k,187)*y(k,43) - mat(k,264) = -(rxt(k,170)*y(k,53) + rxt(k,171)*y(k,69) + (rxt(k,182) & + mat(k,619) = -rxt(k,199)*y(k,38) + mat(k,523) = -rxt(k,200)*y(k,38) + mat(k,425) = -(rxt(k,205) + rxt(k,206)) * y(k,38) + mat(k,335) = rxt(k,186)*y(k,15) + rxt(k,187)*y(k,60) + mat(k,278) = rxt(k,186)*y(k,1) + mat(k,313) = rxt(k,187)*y(k,1) + mat(k,264) = -(rxt(k,170)*y(k,54) + rxt(k,171)*y(k,69) + (rxt(k,182) & + rxt(k,183)) * y(k,65) + (rxt(k,247) + rxt(k,253) + rxt(k,258) & - ) * y(k,46) + (rxt(k,252) + rxt(k,257) + rxt(k,262)) * y(k,25) & - + (rxt(k,254) + rxt(k,259)) * y(k,45)) - mat(k,593) = -rxt(k,170)*y(k,40) - mat(k,529) = -rxt(k,171)*y(k,40) - mat(k,434) = -(rxt(k,182) + rxt(k,183)) * y(k,40) - mat(k,113) = -(rxt(k,247) + rxt(k,253) + rxt(k,258)) * y(k,40) - mat(k,207) = -(rxt(k,252) + rxt(k,257) + rxt(k,262)) * y(k,40) - mat(k,95) = -(rxt(k,254) + rxt(k,259)) * y(k,40) - mat(k,281) = rxt(k,150)*y(k,59) - mat(k,409) = rxt(k,169)*y(k,69) - mat(k,614) = rxt(k,152)*y(k,59) - mat(k,73) = rxt(k,153)*y(k,59) - mat(k,554) = rxt(k,154)*y(k,59) - mat(k,113) = mat(k,113) + rxt(k,172)*y(k,59) - mat(k,383) = rxt(k,150)*y(k,14) + rxt(k,152)*y(k,33) + rxt(k,153)*y(k,35) & - + rxt(k,154)*y(k,43) + rxt(k,172)*y(k,46) - mat(k,529) = mat(k,529) + rxt(k,169)*y(k,24) - mat(k,101) = rxt(k,208)*y(k,33) + rxt(k,210)*y(k,42) + rxt(k,209)*y(k,73) - mat(k,610) = rxt(k,208)*y(k,31) - mat(k,214) = rxt(k,210)*y(k,31) - mat(k,245) = rxt(k,209)*y(k,31) - mat(k,216) = -(rxt(k,147)*y(k,69) + rxt(k,210)*y(k,31)) - mat(k,526) = -rxt(k,147)*y(k,42) - mat(k,103) = -rxt(k,210)*y(k,42) - mat(k,279) = rxt(k,230)*y(k,52) - mat(k,205) = (rxt(k,252)+rxt(k,257)+rxt(k,262))*y(k,40) - mat(k,262) = (rxt(k,252)+rxt(k,257)+rxt(k,262))*y(k,25) - mat(k,496) = rxt(k,146)*y(k,69) - mat(k,311) = rxt(k,230)*y(k,14) - mat(k,526) = mat(k,526) + rxt(k,146)*y(k,51) - mat(k,567) = -((rxt(k,108) + rxt(k,109) + rxt(k,110)) * y(k,32) + rxt(k,112) & - *y(k,53) + rxt(k,113)*y(k,55) + rxt(k,117)*y(k,69) & - + 4._r8*rxt(k,122)*y(k,43) + rxt(k,134)*y(k,52) + rxt(k,139) & - *y(k,50) + rxt(k,144)*y(k,51) + (rxt(k,154) + rxt(k,155) & - ) * y(k,59) + rxt(k,161)*y(k,24) + rxt(k,187)*y(k,58) + rxt(k,193) & - *y(k,2) + rxt(k,233)*y(k,18)) - mat(k,305) = -(rxt(k,108) + rxt(k,109) + rxt(k,110)) * y(k,43) - mat(k,606) = -rxt(k,112)*y(k,43) - mat(k,644) = -rxt(k,113)*y(k,43) - mat(k,542) = -rxt(k,117)*y(k,43) - mat(k,326) = -rxt(k,134)*y(k,43) - mat(k,348) = -rxt(k,139)*y(k,43) - mat(k,511) = -rxt(k,144)*y(k,43) - mat(k,396) = -(rxt(k,154) + rxt(k,155)) * y(k,43) - mat(k,422) = -rxt(k,161)*y(k,43) - mat(k,467) = -rxt(k,187)*y(k,43) - mat(k,371) = -rxt(k,193)*y(k,43) - mat(k,486) = -rxt(k,233)*y(k,43) - mat(k,371) = mat(k,371) + rxt(k,198)*y(k,69) - mat(k,293) = rxt(k,230)*y(k,52) + rxt(k,231)*y(k,53) + rxt(k,186)*y(k,58) & - + rxt(k,150)*y(k,59) - mat(k,486) = mat(k,486) + rxt(k,157)*y(k,24) + rxt(k,234)*y(k,50) - mat(k,422) = mat(k,422) + rxt(k,157)*y(k,18) + rxt(k,168)*y(k,69) - mat(k,70) = rxt(k,237)*y(k,69) - mat(k,305) = mat(k,305) + rxt(k,111)*y(k,54) - mat(k,76) = rxt(k,107)*y(k,53) + rxt(k,153)*y(k,59) + rxt(k,116)*y(k,69) - mat(k,348) = mat(k,348) + rxt(k,234)*y(k,18) - mat(k,326) = mat(k,326) + rxt(k,230)*y(k,14) + rxt(k,137)*y(k,69) - mat(k,606) = mat(k,606) + rxt(k,231)*y(k,14) + rxt(k,107)*y(k,35) - mat(k,242) = rxt(k,111)*y(k,32) - mat(k,644) = mat(k,644) + rxt(k,119)*y(k,69) - mat(k,467) = mat(k,467) + rxt(k,186)*y(k,14) - mat(k,396) = mat(k,396) + rxt(k,150)*y(k,14) + rxt(k,153)*y(k,35) - mat(k,542) = mat(k,542) + rxt(k,198)*y(k,2) + rxt(k,168)*y(k,24) + rxt(k,237) & - *y(k,27) + rxt(k,116)*y(k,35) + rxt(k,137)*y(k,52) + rxt(k,119) & - *y(k,55) + ) * y(k,47) + (rxt(k,252) + rxt(k,257) + rxt(k,262)) * y(k,27) & + + (rxt(k,254) + rxt(k,259)) * y(k,46)) + mat(k,631) = -rxt(k,170)*y(k,42) + mat(k,530) = -rxt(k,171)*y(k,42) + mat(k,429) = -(rxt(k,182) + rxt(k,183)) * y(k,42) + mat(k,121) = -(rxt(k,247) + rxt(k,253) + rxt(k,258)) * y(k,42) + mat(k,207) = -(rxt(k,252) + rxt(k,257) + rxt(k,262)) * y(k,42) + mat(k,95) = -(rxt(k,254) + rxt(k,259)) * y(k,42) + mat(k,281) = rxt(k,150)*y(k,23) + mat(k,574) = rxt(k,150)*y(k,15) + rxt(k,152)*y(k,35) + rxt(k,153)*y(k,37) & + + rxt(k,172)*y(k,47) + rxt(k,154)*y(k,60) + mat(k,455) = rxt(k,169)*y(k,69) + mat(k,358) = rxt(k,152)*y(k,23) + mat(k,73) = rxt(k,153)*y(k,23) + mat(k,121) = mat(k,121) + rxt(k,172)*y(k,23) + mat(k,317) = rxt(k,154)*y(k,23) + mat(k,530) = mat(k,530) + rxt(k,169)*y(k,26) + mat(k,101) = rxt(k,208)*y(k,35) + rxt(k,210)*y(k,44) + rxt(k,209)*y(k,73) + mat(k,354) = rxt(k,208)*y(k,33) + mat(k,214) = rxt(k,210)*y(k,33) + mat(k,245) = rxt(k,209)*y(k,33) + mat(k,216) = -(rxt(k,147)*y(k,69) + rxt(k,210)*y(k,33)) + mat(k,527) = -rxt(k,147)*y(k,44) + mat(k,103) = -rxt(k,210)*y(k,44) + mat(k,279) = rxt(k,230)*y(k,53) + mat(k,205) = (rxt(k,252)+rxt(k,257)+rxt(k,262))*y(k,42) + mat(k,262) = (rxt(k,252)+rxt(k,257)+rxt(k,262))*y(k,27) + mat(k,402) = rxt(k,146)*y(k,69) + mat(k,497) = rxt(k,230)*y(k,15) + mat(k,527) = mat(k,527) + rxt(k,146)*y(k,52) end do end subroutine nlnmat01 subroutine nlnmat02( avec_len, mat, y, rxt ) @@ -254,209 +251,209 @@ subroutine nlnmat02( avec_len, mat, y, rxt ) !---------------------------------------------- do k = 1,avec_len mat(k,39) = -(rxt(k,123)*y(k,69)) - mat(k,518) = -rxt(k,123)*y(k,44) - mat(k,547) = rxt(k,144)*y(k,51) - mat(k,491) = rxt(k,144)*y(k,43) - mat(k,93) = -(rxt(k,201)*y(k,53) + (rxt(k,254) + rxt(k,259)) * y(k,40)) - mat(k,580) = -rxt(k,201)*y(k,45) - mat(k,259) = -(rxt(k,254) + rxt(k,259)) * y(k,45) - mat(k,355) = rxt(k,193)*y(k,43) - mat(k,549) = rxt(k,193)*y(k,2) - mat(k,111) = -(rxt(k,172)*y(k,59) + rxt(k,173)*y(k,53) + rxt(k,174)*y(k,69) & - + (rxt(k,247) + rxt(k,253) + rxt(k,258)) * y(k,40)) - mat(k,378) = -rxt(k,172)*y(k,46) - mat(k,581) = -rxt(k,173)*y(k,46) - mat(k,522) = -rxt(k,174)*y(k,46) - mat(k,260) = -(rxt(k,247) + rxt(k,253) + rxt(k,258)) * y(k,46) - mat(k,404) = rxt(k,161)*y(k,43) + mat(k,519) = -rxt(k,123)*y(k,45) + mat(k,397) = rxt(k,144)*y(k,60) + mat(k,310) = rxt(k,144)*y(k,52) + mat(k,93) = -(rxt(k,201)*y(k,54) + (rxt(k,254) + rxt(k,259)) * y(k,42)) + mat(k,618) = -rxt(k,201)*y(k,46) + mat(k,259) = -(rxt(k,254) + rxt(k,259)) * y(k,46) + mat(k,475) = rxt(k,193)*y(k,60) + mat(k,312) = rxt(k,193)*y(k,3) + mat(k,119) = -(rxt(k,172)*y(k,23) + rxt(k,173)*y(k,54) + rxt(k,174)*y(k,69) & + + (rxt(k,247) + rxt(k,253) + rxt(k,258)) * y(k,42)) + mat(k,569) = -rxt(k,172)*y(k,47) + mat(k,620) = -rxt(k,173)*y(k,47) + mat(k,524) = -rxt(k,174)*y(k,47) + mat(k,260) = -(rxt(k,247) + rxt(k,253) + rxt(k,258)) * y(k,47) + mat(k,450) = rxt(k,161)*y(k,60) mat(k,203) = rxt(k,166)*y(k,69) - mat(k,550) = rxt(k,161)*y(k,24) - mat(k,522) = mat(k,522) + rxt(k,166)*y(k,25) - mat(k,193) = -(rxt(k,126)*y(k,50) + (rxt(k,127) + rxt(k,128) + rxt(k,129) & - ) * y(k,51) + rxt(k,130)*y(k,54) + rxt(k,138)*y(k,69) + rxt(k,275) & + mat(k,314) = rxt(k,161)*y(k,26) + mat(k,524) = mat(k,524) + rxt(k,166)*y(k,27) + mat(k,193) = -(rxt(k,126)*y(k,51) + (rxt(k,127) + rxt(k,128) + rxt(k,129) & + ) * y(k,52) + rxt(k,130)*y(k,55) + rxt(k,138)*y(k,69) + rxt(k,275) & *y(k,68)) - mat(k,334) = -rxt(k,126)*y(k,47) - mat(k,494) = -(rxt(k,127) + rxt(k,128) + rxt(k,129)) * y(k,47) - mat(k,235) = -rxt(k,130)*y(k,47) - mat(k,524) = -rxt(k,138)*y(k,47) - mat(k,152) = -rxt(k,275)*y(k,47) - mat(k,588) = rxt(k,124)*y(k,61) + rxt(k,272)*y(k,64) + mat(k,378) = -rxt(k,126)*y(k,48) + mat(k,400) = -(rxt(k,127) + rxt(k,128) + rxt(k,129)) * y(k,48) + mat(k,235) = -rxt(k,130)*y(k,48) + mat(k,525) = -rxt(k,138)*y(k,48) + mat(k,152) = -rxt(k,275)*y(k,48) + mat(k,626) = rxt(k,124)*y(k,61) + rxt(k,272)*y(k,64) mat(k,235) = mat(k,235) + rxt(k,273)*y(k,64) mat(k,166) = 1.100_r8*rxt(k,268)*y(k,62) + .200_r8*rxt(k,266)*y(k,63) - mat(k,179) = rxt(k,124)*y(k,53) - mat(k,84) = 1.100_r8*rxt(k,268)*y(k,60) - mat(k,90) = .200_r8*rxt(k,266)*y(k,60) - mat(k,132) = rxt(k,272)*y(k,53) + rxt(k,273)*y(k,54) - mat(k,490) = rxt(k,145)*y(k,52) - mat(k,309) = rxt(k,145)*y(k,51) - mat(k,339) = -(rxt(k,126)*y(k,47) + rxt(k,135)*y(k,52) + rxt(k,139)*y(k,43) & - + rxt(k,140)*y(k,55) + rxt(k,141)*y(k,53) + rxt(k,162)*y(k,24) & - + rxt(k,194)*y(k,2) + rxt(k,234)*y(k,18) + rxt(k,277)*y(k,68)) - mat(k,196) = -rxt(k,126)*y(k,50) - mat(k,317) = -rxt(k,135)*y(k,50) - mat(k,558) = -rxt(k,139)*y(k,50) - mat(k,635) = -rxt(k,140)*y(k,50) - mat(k,597) = -rxt(k,141)*y(k,50) - mat(k,413) = -rxt(k,162)*y(k,50) - mat(k,362) = -rxt(k,194)*y(k,50) - mat(k,477) = -rxt(k,234)*y(k,50) - mat(k,154) = -rxt(k,277)*y(k,50) - mat(k,196) = mat(k,196) + 2.000_r8*rxt(k,128)*y(k,51) + rxt(k,130)*y(k,54) & + mat(k,179) = rxt(k,124)*y(k,54) + mat(k,84) = 1.100_r8*rxt(k,268)*y(k,59) + mat(k,90) = .200_r8*rxt(k,266)*y(k,59) + mat(k,132) = rxt(k,272)*y(k,54) + rxt(k,273)*y(k,55) + mat(k,396) = rxt(k,145)*y(k,53) + mat(k,495) = rxt(k,145)*y(k,52) + mat(k,385) = -(rxt(k,126)*y(k,48) + rxt(k,135)*y(k,53) + rxt(k,139)*y(k,60) & + + rxt(k,140)*y(k,56) + rxt(k,141)*y(k,54) + rxt(k,162)*y(k,26) & + + rxt(k,194)*y(k,3) + rxt(k,234)*y(k,19) + rxt(k,277)*y(k,68)) + mat(k,197) = -rxt(k,126)*y(k,51) + mat(k,505) = -rxt(k,135)*y(k,51) + mat(k,323) = -rxt(k,139)*y(k,51) + mat(k,598) = -rxt(k,140)*y(k,51) + mat(k,637) = -rxt(k,141)*y(k,51) + mat(k,461) = -rxt(k,162)*y(k,51) + mat(k,484) = -rxt(k,194)*y(k,51) + mat(k,555) = -rxt(k,234)*y(k,51) + mat(k,154) = -rxt(k,277)*y(k,51) + mat(k,197) = mat(k,197) + 2.000_r8*rxt(k,128)*y(k,52) + rxt(k,130)*y(k,55) & + rxt(k,138)*y(k,69) - mat(k,502) = 2.000_r8*rxt(k,128)*y(k,47) + rxt(k,131)*y(k,53) - mat(k,597) = mat(k,597) + rxt(k,131)*y(k,51) - mat(k,238) = rxt(k,130)*y(k,47) + rxt(k,125)*y(k,61) - mat(k,182) = rxt(k,125)*y(k,54) - mat(k,533) = rxt(k,138)*y(k,47) - mat(k,509) = -((rxt(k,127) + rxt(k,128) + rxt(k,129)) * y(k,47) + (rxt(k,131) & - + rxt(k,133)) * y(k,53) + rxt(k,132)*y(k,55) + rxt(k,144) & - *y(k,43) + rxt(k,145)*y(k,52) + rxt(k,146)*y(k,69) + rxt(k,164) & - *y(k,24) + rxt(k,195)*y(k,2)) - mat(k,198) = -(rxt(k,127) + rxt(k,128) + rxt(k,129)) * y(k,51) - mat(k,604) = -(rxt(k,131) + rxt(k,133)) * y(k,51) - mat(k,642) = -rxt(k,132)*y(k,51) - mat(k,565) = -rxt(k,144)*y(k,51) - mat(k,324) = -rxt(k,145)*y(k,51) - mat(k,540) = -rxt(k,146)*y(k,51) - mat(k,420) = -rxt(k,164)*y(k,51) - mat(k,369) = -rxt(k,195)*y(k,51) - mat(k,369) = mat(k,369) + rxt(k,194)*y(k,50) - mat(k,484) = rxt(k,234)*y(k,50) - mat(k,420) = mat(k,420) + rxt(k,162)*y(k,50) - mat(k,565) = mat(k,565) + rxt(k,139)*y(k,50) + rxt(k,134)*y(k,52) + mat(k,410) = 2.000_r8*rxt(k,128)*y(k,48) + rxt(k,131)*y(k,54) + mat(k,637) = mat(k,637) + rxt(k,131)*y(k,52) + mat(k,239) = rxt(k,130)*y(k,48) + rxt(k,125)*y(k,61) + mat(k,183) = rxt(k,125)*y(k,55) + mat(k,536) = rxt(k,138)*y(k,48) + mat(k,411) = -((rxt(k,127) + rxt(k,128) + rxt(k,129)) * y(k,48) + (rxt(k,131) & + + rxt(k,133)) * y(k,54) + rxt(k,132)*y(k,56) + rxt(k,144) & + *y(k,60) + rxt(k,145)*y(k,53) + rxt(k,146)*y(k,69) + rxt(k,164) & + *y(k,26) + rxt(k,195)*y(k,3)) + mat(k,198) = -(rxt(k,127) + rxt(k,128) + rxt(k,129)) * y(k,52) + mat(k,638) = -(rxt(k,131) + rxt(k,133)) * y(k,52) + mat(k,599) = -rxt(k,132)*y(k,52) + mat(k,324) = -rxt(k,144)*y(k,52) + mat(k,506) = -rxt(k,145)*y(k,52) + mat(k,537) = -rxt(k,146)*y(k,52) + mat(k,462) = -rxt(k,164)*y(k,52) + mat(k,485) = -rxt(k,195)*y(k,52) + mat(k,485) = mat(k,485) + rxt(k,194)*y(k,51) + mat(k,556) = rxt(k,234)*y(k,51) + mat(k,462) = mat(k,462) + rxt(k,162)*y(k,51) mat(k,43) = rxt(k,123)*y(k,69) - mat(k,346) = rxt(k,194)*y(k,2) + rxt(k,234)*y(k,18) + rxt(k,162)*y(k,24) & - + rxt(k,139)*y(k,43) + 2.000_r8*rxt(k,135)*y(k,52) + rxt(k,141) & - *y(k,53) + rxt(k,140)*y(k,55) - mat(k,324) = mat(k,324) + rxt(k,134)*y(k,43) + 2.000_r8*rxt(k,135)*y(k,50) & - + rxt(k,136)*y(k,53) + rxt(k,137)*y(k,69) - mat(k,604) = mat(k,604) + rxt(k,141)*y(k,50) + rxt(k,136)*y(k,52) - mat(k,642) = mat(k,642) + rxt(k,140)*y(k,50) - mat(k,540) = mat(k,540) + rxt(k,123)*y(k,44) + rxt(k,137)*y(k,52) - mat(k,316) = -(rxt(k,134)*y(k,43) + rxt(k,135)*y(k,50) + rxt(k,136)*y(k,53) & - + rxt(k,137)*y(k,69) + rxt(k,145)*y(k,51) + rxt(k,230)*y(k,14)) - mat(k,557) = -rxt(k,134)*y(k,52) - mat(k,338) = -rxt(k,135)*y(k,52) - mat(k,596) = -rxt(k,136)*y(k,52) - mat(k,532) = -rxt(k,137)*y(k,52) - mat(k,501) = -rxt(k,145)*y(k,52) - mat(k,284) = -rxt(k,230)*y(k,52) - mat(k,62) = rxt(k,196)*y(k,53) - mat(k,208) = rxt(k,165)*y(k,53) + rxt(k,163)*y(k,59) + rxt(k,166)*y(k,69) - mat(k,106) = rxt(k,210)*y(k,42) - mat(k,219) = rxt(k,210)*y(k,31) + rxt(k,147)*y(k,69) - mat(k,501) = mat(k,501) + rxt(k,133)*y(k,53) + rxt(k,132)*y(k,55) - mat(k,596) = mat(k,596) + rxt(k,196)*y(k,3) + rxt(k,165)*y(k,25) + rxt(k,133) & - *y(k,51) - mat(k,634) = rxt(k,132)*y(k,51) - mat(k,386) = rxt(k,163)*y(k,25) - mat(k,532) = mat(k,532) + rxt(k,166)*y(k,25) + rxt(k,147)*y(k,42) - mat(k,607) = -(rxt(k,103)*y(k,55) + 4._r8*rxt(k,104)*y(k,53) + rxt(k,105) & - *y(k,54) + rxt(k,106)*y(k,33) + rxt(k,107)*y(k,35) + rxt(k,112) & - *y(k,43) + rxt(k,118)*y(k,69) + (rxt(k,131) + rxt(k,133) & - ) * y(k,51) + rxt(k,136)*y(k,52) + rxt(k,141)*y(k,50) + rxt(k,165) & - *y(k,25) + rxt(k,167)*y(k,24) + rxt(k,170)*y(k,40) + rxt(k,173) & - *y(k,46) + rxt(k,196)*y(k,3) + rxt(k,197)*y(k,2) + rxt(k,199) & - *y(k,36) + rxt(k,201)*y(k,45) + rxt(k,231)*y(k,14) + (rxt(k,270) & + mat(k,386) = rxt(k,194)*y(k,3) + rxt(k,234)*y(k,19) + rxt(k,162)*y(k,26) & + + 2.000_r8*rxt(k,135)*y(k,53) + rxt(k,141)*y(k,54) + rxt(k,140) & + *y(k,56) + rxt(k,139)*y(k,60) + mat(k,506) = mat(k,506) + 2.000_r8*rxt(k,135)*y(k,51) + rxt(k,136)*y(k,54) & + + rxt(k,134)*y(k,60) + rxt(k,137)*y(k,69) + mat(k,638) = mat(k,638) + rxt(k,141)*y(k,51) + rxt(k,136)*y(k,53) + mat(k,599) = mat(k,599) + rxt(k,140)*y(k,51) + mat(k,324) = mat(k,324) + rxt(k,139)*y(k,51) + rxt(k,134)*y(k,53) + mat(k,537) = mat(k,537) + rxt(k,123)*y(k,45) + rxt(k,137)*y(k,53) + mat(k,510) = -(rxt(k,134)*y(k,60) + rxt(k,135)*y(k,51) + rxt(k,136)*y(k,54) & + + rxt(k,137)*y(k,69) + rxt(k,145)*y(k,52) + rxt(k,230)*y(k,15)) + mat(k,328) = -rxt(k,134)*y(k,53) + mat(k,390) = -rxt(k,135)*y(k,53) + mat(k,642) = -rxt(k,136)*y(k,53) + mat(k,541) = -rxt(k,137)*y(k,53) + mat(k,415) = -rxt(k,145)*y(k,53) + mat(k,291) = -rxt(k,230)*y(k,53) + mat(k,65) = rxt(k,196)*y(k,54) + mat(k,585) = rxt(k,163)*y(k,27) + mat(k,210) = rxt(k,163)*y(k,23) + rxt(k,165)*y(k,54) + rxt(k,166)*y(k,69) + mat(k,107) = rxt(k,210)*y(k,44) + mat(k,221) = rxt(k,210)*y(k,33) + rxt(k,147)*y(k,69) + mat(k,415) = mat(k,415) + rxt(k,133)*y(k,54) + rxt(k,132)*y(k,56) + mat(k,642) = mat(k,642) + rxt(k,196)*y(k,4) + rxt(k,165)*y(k,27) + rxt(k,133) & + *y(k,52) + mat(k,603) = rxt(k,132)*y(k,52) + mat(k,541) = mat(k,541) + rxt(k,166)*y(k,27) + rxt(k,147)*y(k,44) + mat(k,647) = -(rxt(k,103)*y(k,56) + 4._r8*rxt(k,104)*y(k,54) + rxt(k,105) & + *y(k,55) + rxt(k,106)*y(k,35) + rxt(k,107)*y(k,37) + rxt(k,112) & + *y(k,60) + rxt(k,118)*y(k,69) + (rxt(k,131) + rxt(k,133) & + ) * y(k,52) + rxt(k,136)*y(k,53) + rxt(k,141)*y(k,51) + rxt(k,165) & + *y(k,27) + rxt(k,167)*y(k,26) + rxt(k,170)*y(k,42) + rxt(k,173) & + *y(k,47) + rxt(k,196)*y(k,4) + rxt(k,197)*y(k,3) + rxt(k,199) & + *y(k,38) + rxt(k,201)*y(k,46) + rxt(k,231)*y(k,15) + (rxt(k,270) & + rxt(k,271)) * y(k,62) + rxt(k,272)*y(k,64)) - mat(k,645) = -rxt(k,103)*y(k,53) - mat(k,243) = -rxt(k,105)*y(k,53) - mat(k,627) = -rxt(k,106)*y(k,53) - mat(k,77) = -rxt(k,107)*y(k,53) - mat(k,568) = -rxt(k,112)*y(k,53) - mat(k,543) = -rxt(k,118)*y(k,53) - mat(k,512) = -(rxt(k,131) + rxt(k,133)) * y(k,53) - mat(k,327) = -rxt(k,136)*y(k,53) - mat(k,349) = -rxt(k,141)*y(k,53) - mat(k,213) = -rxt(k,165)*y(k,53) - mat(k,423) = -rxt(k,167)*y(k,53) - mat(k,275) = -rxt(k,170)*y(k,53) - mat(k,117) = -rxt(k,173)*y(k,53) - mat(k,66) = -rxt(k,196)*y(k,53) - mat(k,372) = -rxt(k,197)*y(k,53) - mat(k,125) = -rxt(k,199)*y(k,53) - mat(k,100) = -rxt(k,201)*y(k,53) - mat(k,294) = -rxt(k,231)*y(k,53) - mat(k,86) = -(rxt(k,270) + rxt(k,271)) * y(k,53) - mat(k,134) = -rxt(k,272)*y(k,53) - mat(k,306) = rxt(k,110)*y(k,43) - mat(k,568) = mat(k,568) + rxt(k,110)*y(k,32) - mat(k,201) = rxt(k,126)*y(k,50) + rxt(k,127)*y(k,51) + rxt(k,130)*y(k,54) & + mat(k,608) = -rxt(k,103)*y(k,54) + mat(k,244) = -rxt(k,105)*y(k,54) + mat(k,373) = -rxt(k,106)*y(k,54) + mat(k,77) = -rxt(k,107)*y(k,54) + mat(k,333) = -rxt(k,112)*y(k,54) + mat(k,546) = -rxt(k,118)*y(k,54) + mat(k,420) = -(rxt(k,131) + rxt(k,133)) * y(k,54) + mat(k,515) = -rxt(k,136)*y(k,54) + mat(k,395) = -rxt(k,141)*y(k,54) + mat(k,213) = -rxt(k,165)*y(k,54) + mat(k,471) = -rxt(k,167)*y(k,54) + mat(k,276) = -rxt(k,170)*y(k,54) + mat(k,125) = -rxt(k,173)*y(k,54) + mat(k,66) = -rxt(k,196)*y(k,54) + mat(k,494) = -rxt(k,197)*y(k,54) + mat(k,117) = -rxt(k,199)*y(k,54) + mat(k,100) = -rxt(k,201)*y(k,54) + mat(k,295) = -rxt(k,231)*y(k,54) + mat(k,86) = -(rxt(k,270) + rxt(k,271)) * y(k,54) + mat(k,134) = -rxt(k,272)*y(k,54) + mat(k,308) = rxt(k,110)*y(k,60) + mat(k,201) = rxt(k,126)*y(k,51) + rxt(k,127)*y(k,52) + rxt(k,130)*y(k,55) & + rxt(k,275)*y(k,68) - mat(k,349) = mat(k,349) + rxt(k,126)*y(k,47) - mat(k,512) = mat(k,512) + rxt(k,127)*y(k,47) - mat(k,243) = mat(k,243) + rxt(k,130)*y(k,47) + rxt(k,274)*y(k,64) + ( & + mat(k,395) = mat(k,395) + rxt(k,126)*y(k,48) + mat(k,420) = mat(k,420) + rxt(k,127)*y(k,48) + mat(k,244) = mat(k,244) + rxt(k,130)*y(k,48) + rxt(k,274)*y(k,64) + ( & + rxt(k,92)+rxt(k,93))*y(k,65) + rxt(k,281)*y(k,70) + rxt(k,285) & *y(k,71) mat(k,173) = rxt(k,266)*y(k,63) + 1.150_r8*rxt(k,267)*y(k,68) + mat(k,333) = mat(k,333) + rxt(k,110)*y(k,34) mat(k,186) = rxt(k,280)*y(k,70) - mat(k,91) = rxt(k,266)*y(k,60) - mat(k,134) = mat(k,134) + rxt(k,274)*y(k,54) - mat(k,448) = (rxt(k,92)+rxt(k,93))*y(k,54) - mat(k,156) = rxt(k,275)*y(k,47) + 1.150_r8*rxt(k,267)*y(k,60) - mat(k,543) = mat(k,543) + 2.000_r8*rxt(k,120)*y(k,69) - mat(k,147) = rxt(k,281)*y(k,54) + rxt(k,280)*y(k,61) - mat(k,58) = rxt(k,285)*y(k,54) - mat(k,236) = -(rxt(k,92)*y(k,65) + rxt(k,97)*y(k,66) + rxt(k,105)*y(k,53) & - + rxt(k,111)*y(k,32) + rxt(k,125)*y(k,61) + rxt(k,130)*y(k,47) & + mat(k,91) = rxt(k,266)*y(k,59) + mat(k,134) = mat(k,134) + rxt(k,274)*y(k,55) + mat(k,445) = (rxt(k,92)+rxt(k,93))*y(k,55) + mat(k,156) = rxt(k,275)*y(k,48) + 1.150_r8*rxt(k,267)*y(k,59) + mat(k,546) = mat(k,546) + 2.000_r8*rxt(k,120)*y(k,69) + mat(k,147) = rxt(k,281)*y(k,55) + rxt(k,280)*y(k,61) + mat(k,58) = rxt(k,285)*y(k,55) + mat(k,236) = -(rxt(k,92)*y(k,65) + rxt(k,97)*y(k,66) + rxt(k,105)*y(k,54) & + + rxt(k,111)*y(k,34) + rxt(k,125)*y(k,61) + rxt(k,130)*y(k,48) & + rxt(k,269)*y(k,62) + (rxt(k,273) + rxt(k,274)) * y(k,64) & + rxt(k,281)*y(k,70) + rxt(k,285)*y(k,71)) - mat(k,432) = -rxt(k,92)*y(k,54) - mat(k,11) = -rxt(k,97)*y(k,54) - mat(k,591) = -rxt(k,105)*y(k,54) - mat(k,296) = -rxt(k,111)*y(k,54) - mat(k,180) = -rxt(k,125)*y(k,54) - mat(k,194) = -rxt(k,130)*y(k,54) - mat(k,85) = -rxt(k,269)*y(k,54) - mat(k,133) = -(rxt(k,273) + rxt(k,274)) * y(k,54) - mat(k,143) = -rxt(k,281)*y(k,54) - mat(k,57) = -rxt(k,285)*y(k,54) - mat(k,357) = 2.000_r8*rxt(k,189)*y(k,2) + (rxt(k,191)+rxt(k,192))*y(k,24) & - + rxt(k,193)*y(k,43) + rxt(k,197)*y(k,53) - mat(k,472) = rxt(k,233)*y(k,43) - mat(k,407) = (rxt(k,191)+rxt(k,192))*y(k,2) + (2.000_r8*rxt(k,158) & - +2.000_r8*rxt(k,159))*y(k,24) + rxt(k,161)*y(k,43) + rxt(k,167) & - *y(k,53) + rxt(k,169)*y(k,69) - mat(k,296) = mat(k,296) + rxt(k,108)*y(k,43) + rxt(k,114)*y(k,55) - mat(k,552) = rxt(k,193)*y(k,2) + rxt(k,233)*y(k,18) + rxt(k,161)*y(k,24) & - + rxt(k,108)*y(k,32) + 2.000_r8*rxt(k,122)*y(k,43) + rxt(k,134) & - *y(k,52) + rxt(k,112)*y(k,53) + 2.000_r8*rxt(k,113)*y(k,55) & - + rxt(k,187)*y(k,58) + rxt(k,154)*y(k,59) + rxt(k,117)*y(k,69) + mat(k,427) = -rxt(k,92)*y(k,55) + mat(k,11) = -rxt(k,97)*y(k,55) + mat(k,629) = -rxt(k,105)*y(k,55) + mat(k,296) = -rxt(k,111)*y(k,55) + mat(k,180) = -rxt(k,125)*y(k,55) + mat(k,194) = -rxt(k,130)*y(k,55) + mat(k,85) = -rxt(k,269)*y(k,55) + mat(k,133) = -(rxt(k,273) + rxt(k,274)) * y(k,55) + mat(k,143) = -rxt(k,281)*y(k,55) + mat(k,57) = -rxt(k,285)*y(k,55) + mat(k,336) = rxt(k,188)*y(k,56) + rxt(k,187)*y(k,60) + mat(k,477) = 2.000_r8*rxt(k,189)*y(k,3) + (rxt(k,191)+rxt(k,192))*y(k,26) & + + rxt(k,197)*y(k,54) + rxt(k,193)*y(k,60) + mat(k,548) = rxt(k,233)*y(k,60) + mat(k,572) = rxt(k,156)*y(k,56) + rxt(k,154)*y(k,60) + mat(k,453) = (rxt(k,191)+rxt(k,192))*y(k,3) + (2.000_r8*rxt(k,158) & + +2.000_r8*rxt(k,159))*y(k,26) + rxt(k,167)*y(k,54) + rxt(k,161) & + *y(k,60) + rxt(k,169)*y(k,69) + mat(k,296) = mat(k,296) + rxt(k,114)*y(k,56) + rxt(k,108)*y(k,60) mat(k,40) = rxt(k,123)*y(k,69) - mat(k,194) = mat(k,194) + rxt(k,129)*y(k,51) - mat(k,335) = rxt(k,140)*y(k,55) + rxt(k,277)*y(k,68) - mat(k,497) = rxt(k,129)*y(k,47) + rxt(k,131)*y(k,53) + rxt(k,132)*y(k,55) - mat(k,312) = rxt(k,134)*y(k,43) + rxt(k,136)*y(k,53) - mat(k,591) = mat(k,591) + rxt(k,197)*y(k,2) + rxt(k,167)*y(k,24) + rxt(k,112) & - *y(k,43) + rxt(k,131)*y(k,51) + rxt(k,136)*y(k,52) & - + 2.000_r8*rxt(k,104)*y(k,53) + 2.000_r8*rxt(k,103)*y(k,55) & - + rxt(k,96)*y(k,66) + rxt(k,118)*y(k,69) + mat(k,194) = mat(k,194) + rxt(k,129)*y(k,52) + mat(k,379) = rxt(k,140)*y(k,56) + rxt(k,277)*y(k,68) + mat(k,403) = rxt(k,129)*y(k,48) + rxt(k,131)*y(k,54) + rxt(k,132)*y(k,56) + mat(k,498) = rxt(k,136)*y(k,54) + rxt(k,134)*y(k,60) + mat(k,629) = mat(k,629) + rxt(k,197)*y(k,3) + rxt(k,167)*y(k,26) + rxt(k,131) & + *y(k,52) + rxt(k,136)*y(k,53) + 2.000_r8*rxt(k,104)*y(k,54) & + + 2.000_r8*rxt(k,103)*y(k,56) + rxt(k,112)*y(k,60) + rxt(k,96) & + *y(k,66) + rxt(k,118)*y(k,69) mat(k,236) = mat(k,236) + 2.000_r8*rxt(k,97)*y(k,66) - mat(k,632) = rxt(k,114)*y(k,32) + 2.000_r8*rxt(k,113)*y(k,43) + rxt(k,140) & - *y(k,50) + rxt(k,132)*y(k,51) + 2.000_r8*rxt(k,103)*y(k,53) & - + rxt(k,188)*y(k,58) + rxt(k,156)*y(k,59) + 2.000_r8*rxt(k,94) & + mat(k,593) = rxt(k,188)*y(k,1) + rxt(k,156)*y(k,23) + rxt(k,114)*y(k,34) & + + rxt(k,140)*y(k,51) + rxt(k,132)*y(k,52) + 2.000_r8*rxt(k,103) & + *y(k,54) + 2.000_r8*rxt(k,113)*y(k,60) + 2.000_r8*rxt(k,94) & *y(k,65) + rxt(k,119)*y(k,69) - mat(k,453) = rxt(k,187)*y(k,43) + rxt(k,188)*y(k,55) - mat(k,381) = rxt(k,154)*y(k,43) + rxt(k,156)*y(k,55) - mat(k,432) = mat(k,432) + 2.000_r8*rxt(k,94)*y(k,55) - mat(k,11) = mat(k,11) + rxt(k,96)*y(k,53) + 2.000_r8*rxt(k,97)*y(k,54) - mat(k,153) = rxt(k,277)*y(k,50) - mat(k,527) = rxt(k,169)*y(k,24) + rxt(k,117)*y(k,43) + rxt(k,123)*y(k,44) & - + rxt(k,118)*y(k,53) + rxt(k,119)*y(k,55) - mat(k,647) = -(rxt(k,94)*y(k,65) + rxt(k,103)*y(k,53) + rxt(k,113)*y(k,43) & - + rxt(k,114)*y(k,32) + rxt(k,119)*y(k,69) + rxt(k,132)*y(k,51) & - + rxt(k,140)*y(k,50) + rxt(k,156)*y(k,59) + rxt(k,188)*y(k,58)) - mat(k,450) = -rxt(k,94)*y(k,55) - mat(k,609) = -rxt(k,103)*y(k,55) - mat(k,570) = -rxt(k,113)*y(k,55) - mat(k,308) = -rxt(k,114)*y(k,55) - mat(k,545) = -rxt(k,119)*y(k,55) - mat(k,514) = -rxt(k,132)*y(k,55) - mat(k,351) = -rxt(k,140)*y(k,55) - mat(k,399) = -rxt(k,156)*y(k,55) - mat(k,470) = -rxt(k,188)*y(k,55) - mat(k,609) = mat(k,609) + rxt(k,105)*y(k,54) - mat(k,244) = rxt(k,105)*y(k,53) + mat(k,315) = rxt(k,187)*y(k,1) + rxt(k,193)*y(k,3) + rxt(k,233)*y(k,19) & + + rxt(k,154)*y(k,23) + rxt(k,161)*y(k,26) + rxt(k,108)*y(k,34) & + + rxt(k,134)*y(k,53) + rxt(k,112)*y(k,54) + 2.000_r8*rxt(k,113) & + *y(k,56) + 2.000_r8*rxt(k,122)*y(k,60) + rxt(k,117)*y(k,69) + mat(k,427) = mat(k,427) + 2.000_r8*rxt(k,94)*y(k,56) + mat(k,11) = mat(k,11) + rxt(k,96)*y(k,54) + 2.000_r8*rxt(k,97)*y(k,55) + mat(k,153) = rxt(k,277)*y(k,51) + mat(k,528) = rxt(k,169)*y(k,26) + rxt(k,123)*y(k,45) + rxt(k,118)*y(k,54) & + + rxt(k,119)*y(k,56) + rxt(k,117)*y(k,60) + mat(k,607) = -(rxt(k,94)*y(k,65) + rxt(k,103)*y(k,54) + rxt(k,113)*y(k,60) & + + rxt(k,114)*y(k,34) + rxt(k,119)*y(k,69) + rxt(k,132)*y(k,52) & + + rxt(k,140)*y(k,51) + rxt(k,156)*y(k,23) + rxt(k,188)*y(k,1)) + mat(k,444) = -rxt(k,94)*y(k,56) + mat(k,646) = -rxt(k,103)*y(k,56) + mat(k,332) = -rxt(k,113)*y(k,56) + mat(k,307) = -rxt(k,114)*y(k,56) + mat(k,545) = -rxt(k,119)*y(k,56) + mat(k,419) = -rxt(k,132)*y(k,56) + mat(k,394) = -rxt(k,140)*y(k,56) + mat(k,589) = -rxt(k,156)*y(k,56) + mat(k,352) = -rxt(k,188)*y(k,56) + mat(k,646) = mat(k,646) + rxt(k,105)*y(k,55) + mat(k,243) = rxt(k,105)*y(k,54) end do end subroutine nlnmat02 subroutine nlnmat03( avec_len, mat, y, rxt ) @@ -477,201 +474,204 @@ subroutine nlnmat03( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,352) = rxt(k,190)*y(k,24) - mat(k,401) = rxt(k,190)*y(k,2) + 2.000_r8*rxt(k,160)*y(k,24) - mat(k,463) = -(rxt(k,186)*y(k,14) + rxt(k,187)*y(k,43) + rxt(k,188)*y(k,55)) - mat(k,289) = -rxt(k,186)*y(k,58) - mat(k,563) = -rxt(k,187)*y(k,58) - mat(k,640) = -rxt(k,188)*y(k,58) - mat(k,367) = 4.000_r8*rxt(k,189)*y(k,2) + (rxt(k,190)+rxt(k,191))*y(k,24) & - + rxt(k,194)*y(k,50) + rxt(k,197)*y(k,53) + rxt(k,198)*y(k,69) - mat(k,418) = (rxt(k,190)+rxt(k,191))*y(k,2) - mat(k,123) = rxt(k,199)*y(k,53) + rxt(k,205)*y(k,65) + rxt(k,200)*y(k,69) - mat(k,344) = rxt(k,194)*y(k,2) - mat(k,602) = rxt(k,197)*y(k,2) + rxt(k,199)*y(k,36) - mat(k,443) = rxt(k,205)*y(k,36) - mat(k,538) = rxt(k,198)*y(k,2) + rxt(k,200)*y(k,36) - mat(k,389) = -(rxt(k,150)*y(k,14) + rxt(k,152)*y(k,33) + rxt(k,153)*y(k,35) & - + (rxt(k,154) + rxt(k,155)) * y(k,43) + rxt(k,156)*y(k,55) & - + rxt(k,163)*y(k,25) + rxt(k,172)*y(k,46)) - mat(k,286) = -rxt(k,150)*y(k,59) - mat(k,619) = -rxt(k,152)*y(k,59) - mat(k,74) = -rxt(k,153)*y(k,59) - mat(k,560) = -(rxt(k,154) + rxt(k,155)) * y(k,59) - mat(k,637) = -rxt(k,156)*y(k,59) - mat(k,209) = -rxt(k,163)*y(k,59) - mat(k,114) = -rxt(k,172)*y(k,59) - mat(k,364) = rxt(k,191)*y(k,24) - mat(k,479) = rxt(k,157)*y(k,24) - mat(k,415) = rxt(k,191)*y(k,2) + rxt(k,157)*y(k,18) + (4.000_r8*rxt(k,158) & - +2.000_r8*rxt(k,160))*y(k,24) + rxt(k,162)*y(k,50) + rxt(k,167) & - *y(k,53) + rxt(k,168)*y(k,69) - mat(k,19) = rxt(k,212)*y(k,65) - mat(k,268) = rxt(k,170)*y(k,53) + rxt(k,182)*y(k,65) + rxt(k,171)*y(k,69) - mat(k,341) = rxt(k,162)*y(k,24) - mat(k,599) = rxt(k,167)*y(k,24) + rxt(k,170)*y(k,40) - mat(k,440) = rxt(k,212)*y(k,30) + rxt(k,182)*y(k,40) - mat(k,535) = rxt(k,168)*y(k,24) + rxt(k,171)*y(k,40) + mat(k,472) = rxt(k,190)*y(k,26) + mat(k,447) = rxt(k,190)*y(k,3) + 2.000_r8*rxt(k,160)*y(k,26) mat(k,164) = -(rxt(k,266)*y(k,63) + rxt(k,267)*y(k,68) + rxt(k,268)*y(k,62)) - mat(k,88) = -rxt(k,266)*y(k,60) - mat(k,150) = -rxt(k,267)*y(k,60) - mat(k,82) = -rxt(k,268)*y(k,60) - mat(k,178) = -(rxt(k,124)*y(k,53) + rxt(k,125)*y(k,54) + rxt(k,280)*y(k,70)) - mat(k,587) = -rxt(k,124)*y(k,61) + mat(k,88) = -rxt(k,266)*y(k,59) + mat(k,150) = -rxt(k,267)*y(k,59) + mat(k,82) = -rxt(k,268)*y(k,59) + mat(k,320) = -((rxt(k,108) + rxt(k,109) + rxt(k,110)) * y(k,34) + rxt(k,112) & + *y(k,54) + rxt(k,113)*y(k,56) + rxt(k,117)*y(k,69) & + + 4._r8*rxt(k,122)*y(k,60) + rxt(k,134)*y(k,53) + rxt(k,139) & + *y(k,51) + rxt(k,144)*y(k,52) + (rxt(k,154) + rxt(k,155) & + ) * y(k,23) + rxt(k,161)*y(k,26) + rxt(k,187)*y(k,1) + rxt(k,193) & + *y(k,3) + rxt(k,233)*y(k,19)) + mat(k,299) = -(rxt(k,108) + rxt(k,109) + rxt(k,110)) * y(k,60) + mat(k,634) = -rxt(k,112)*y(k,60) + mat(k,595) = -rxt(k,113)*y(k,60) + mat(k,533) = -rxt(k,117)*y(k,60) + mat(k,502) = -rxt(k,134)*y(k,60) + mat(k,382) = -rxt(k,139)*y(k,60) + mat(k,407) = -rxt(k,144)*y(k,60) + mat(k,577) = -(rxt(k,154) + rxt(k,155)) * y(k,60) + mat(k,458) = -rxt(k,161)*y(k,60) + mat(k,340) = -rxt(k,187)*y(k,60) + mat(k,481) = -rxt(k,193)*y(k,60) + mat(k,552) = -rxt(k,233)*y(k,60) + mat(k,340) = mat(k,340) + rxt(k,186)*y(k,15) + mat(k,481) = mat(k,481) + rxt(k,198)*y(k,69) + mat(k,284) = rxt(k,186)*y(k,1) + rxt(k,150)*y(k,23) + rxt(k,230)*y(k,53) & + + rxt(k,231)*y(k,54) + mat(k,552) = mat(k,552) + rxt(k,157)*y(k,26) + rxt(k,234)*y(k,51) + mat(k,577) = mat(k,577) + rxt(k,150)*y(k,15) + rxt(k,153)*y(k,37) + mat(k,458) = mat(k,458) + rxt(k,157)*y(k,19) + rxt(k,168)*y(k,69) + mat(k,69) = rxt(k,237)*y(k,69) + mat(k,299) = mat(k,299) + rxt(k,111)*y(k,55) + mat(k,74) = rxt(k,153)*y(k,23) + rxt(k,107)*y(k,54) + rxt(k,116)*y(k,69) + mat(k,382) = mat(k,382) + rxt(k,234)*y(k,19) + mat(k,502) = mat(k,502) + rxt(k,230)*y(k,15) + rxt(k,137)*y(k,69) + mat(k,634) = mat(k,634) + rxt(k,231)*y(k,15) + rxt(k,107)*y(k,37) + mat(k,238) = rxt(k,111)*y(k,34) + mat(k,595) = mat(k,595) + rxt(k,119)*y(k,69) + mat(k,533) = mat(k,533) + rxt(k,198)*y(k,3) + rxt(k,168)*y(k,26) + rxt(k,237) & + *y(k,29) + rxt(k,116)*y(k,37) + rxt(k,137)*y(k,53) + rxt(k,119) & + *y(k,56) + mat(k,178) = -(rxt(k,124)*y(k,54) + rxt(k,125)*y(k,55) + rxt(k,280)*y(k,70)) + mat(k,625) = -rxt(k,124)*y(k,61) mat(k,234) = -rxt(k,125)*y(k,61) mat(k,141) = -rxt(k,280)*y(k,61) - mat(k,587) = mat(k,587) + rxt(k,270)*y(k,62) + mat(k,625) = mat(k,625) + rxt(k,270)*y(k,62) mat(k,165) = .900_r8*rxt(k,268)*y(k,62) + .800_r8*rxt(k,266)*y(k,63) - mat(k,83) = rxt(k,270)*y(k,53) + .900_r8*rxt(k,268)*y(k,60) - mat(k,89) = .800_r8*rxt(k,266)*y(k,60) - mat(k,78) = -(rxt(k,268)*y(k,60) + rxt(k,269)*y(k,54) + (rxt(k,270) + rxt(k,271) & - ) * y(k,53)) + mat(k,83) = rxt(k,270)*y(k,54) + .900_r8*rxt(k,268)*y(k,59) + mat(k,89) = .800_r8*rxt(k,266)*y(k,59) + mat(k,78) = -(rxt(k,268)*y(k,59) + rxt(k,269)*y(k,55) + (rxt(k,270) + rxt(k,271) & + ) * y(k,54)) mat(k,159) = -rxt(k,268)*y(k,62) mat(k,228) = -rxt(k,269)*y(k,62) - mat(k,578) = -(rxt(k,270) + rxt(k,271)) * y(k,62) - mat(k,87) = -(rxt(k,266)*y(k,60)) + mat(k,616) = -(rxt(k,270) + rxt(k,271)) * y(k,62) + mat(k,87) = -(rxt(k,266)*y(k,59)) mat(k,160) = -rxt(k,266)*y(k,63) mat(k,187) = rxt(k,275)*y(k,68) - mat(k,330) = rxt(k,277)*y(k,68) - mat(k,579) = rxt(k,270)*y(k,62) + mat(k,374) = rxt(k,277)*y(k,68) + mat(k,617) = rxt(k,270)*y(k,62) mat(k,229) = rxt(k,274)*y(k,64) - mat(k,79) = rxt(k,270)*y(k,53) - mat(k,126) = rxt(k,274)*y(k,54) - mat(k,148) = rxt(k,275)*y(k,47) + rxt(k,277)*y(k,50) - mat(k,127) = -(rxt(k,272)*y(k,53) + (rxt(k,273) + rxt(k,274)) * y(k,54)) - mat(k,583) = -rxt(k,272)*y(k,64) + mat(k,79) = rxt(k,270)*y(k,54) + mat(k,126) = rxt(k,274)*y(k,55) + mat(k,148) = rxt(k,275)*y(k,48) + rxt(k,277)*y(k,51) + mat(k,127) = -(rxt(k,272)*y(k,54) + (rxt(k,273) + rxt(k,274)) * y(k,55)) + mat(k,621) = -rxt(k,272)*y(k,64) mat(k,230) = -(rxt(k,273) + rxt(k,274)) * y(k,64) mat(k,174) = rxt(k,280)*y(k,70) mat(k,137) = rxt(k,280)*y(k,61) - mat(k,442) = -(rxt(k,89)*y(k,33) + rxt(k,90)*y(k,73) + (rxt(k,92) + rxt(k,93) & - ) * y(k,54) + rxt(k,94)*y(k,55) + (rxt(k,182) + rxt(k,183) & - ) * y(k,40) + (rxt(k,205) + rxt(k,206)) * y(k,36) + rxt(k,211) & - *y(k,29) + rxt(k,212)*y(k,30)) - mat(k,621) = -rxt(k,89)*y(k,65) - mat(k,251) = -rxt(k,90)*y(k,65) - mat(k,239) = -(rxt(k,92) + rxt(k,93)) * y(k,65) - mat(k,639) = -rxt(k,94)*y(k,65) - mat(k,270) = -(rxt(k,182) + rxt(k,183)) * y(k,65) - mat(k,122) = -(rxt(k,205) + rxt(k,206)) * y(k,65) + mat(k,437) = -(rxt(k,89)*y(k,35) + rxt(k,90)*y(k,73) + (rxt(k,92) + rxt(k,93) & + ) * y(k,55) + rxt(k,94)*y(k,56) + (rxt(k,182) + rxt(k,183) & + ) * y(k,42) + (rxt(k,205) + rxt(k,206)) * y(k,38) + rxt(k,211) & + *y(k,31) + rxt(k,212)*y(k,32)) + mat(k,365) = -rxt(k,89)*y(k,65) + mat(k,252) = -rxt(k,90)*y(k,65) + mat(k,241) = -(rxt(k,92) + rxt(k,93)) * y(k,65) + mat(k,600) = -rxt(k,94)*y(k,65) + mat(k,269) = -(rxt(k,182) + rxt(k,183)) * y(k,65) + mat(k,114) = -(rxt(k,205) + rxt(k,206)) * y(k,65) mat(k,6) = -rxt(k,211)*y(k,65) - mat(k,20) = -rxt(k,212)*y(k,65) - mat(k,239) = mat(k,239) + rxt(k,125)*y(k,61) - mat(k,170) = .850_r8*rxt(k,267)*y(k,68) - mat(k,183) = rxt(k,125)*y(k,54) - mat(k,155) = .850_r8*rxt(k,267)*y(k,60) - mat(k,10) = -(rxt(k,96)*y(k,53) + rxt(k,97)*y(k,54)) - mat(k,571) = -rxt(k,96)*y(k,66) + mat(k,19) = -rxt(k,212)*y(k,65) + mat(k,241) = mat(k,241) + rxt(k,125)*y(k,61) + mat(k,171) = .850_r8*rxt(k,267)*y(k,68) + mat(k,184) = rxt(k,125)*y(k,55) + mat(k,155) = .850_r8*rxt(k,267)*y(k,59) + mat(k,10) = -(rxt(k,96)*y(k,54) + rxt(k,97)*y(k,55)) + mat(k,609) = -rxt(k,96)*y(k,66) mat(k,224) = -rxt(k,97)*y(k,66) - mat(k,571) = mat(k,571) + rxt(k,100)*y(k,67) + mat(k,609) = mat(k,609) + rxt(k,100)*y(k,67) mat(k,224) = mat(k,224) + rxt(k,101)*y(k,67) - mat(k,630) = rxt(k,102)*y(k,67) - mat(k,12) = rxt(k,100)*y(k,53) + rxt(k,101)*y(k,54) + rxt(k,102)*y(k,55) - mat(k,13) = -(rxt(k,100)*y(k,53) + rxt(k,101)*y(k,54) + rxt(k,102)*y(k,55)) - mat(k,572) = -rxt(k,100)*y(k,67) + mat(k,591) = rxt(k,102)*y(k,67) + mat(k,12) = rxt(k,100)*y(k,54) + rxt(k,101)*y(k,55) + rxt(k,102)*y(k,56) + mat(k,13) = -(rxt(k,100)*y(k,54) + rxt(k,101)*y(k,55) + rxt(k,102)*y(k,56)) + mat(k,610) = -rxt(k,100)*y(k,67) mat(k,225) = -rxt(k,101)*y(k,67) - mat(k,631) = -rxt(k,102)*y(k,67) + mat(k,592) = -rxt(k,102)*y(k,67) mat(k,225) = mat(k,225) + rxt(k,92)*y(k,65) - mat(k,427) = rxt(k,92)*y(k,54) - mat(k,149) = -(rxt(k,267)*y(k,60) + rxt(k,275)*y(k,47) + rxt(k,277)*y(k,50)) + mat(k,422) = rxt(k,92)*y(k,55) + mat(k,149) = -(rxt(k,267)*y(k,59) + rxt(k,275)*y(k,48) + rxt(k,277)*y(k,51)) mat(k,163) = -rxt(k,267)*y(k,68) mat(k,190) = -rxt(k,275)*y(k,68) - mat(k,331) = -rxt(k,277)*y(k,68) + mat(k,375) = -rxt(k,277)*y(k,68) mat(k,232) = rxt(k,269)*y(k,62) + rxt(k,273)*y(k,64) + rxt(k,281)*y(k,70) & + rxt(k,285)*y(k,71) - mat(k,81) = rxt(k,269)*y(k,54) - mat(k,129) = rxt(k,273)*y(k,54) - mat(k,139) = rxt(k,281)*y(k,54) - mat(k,56) = rxt(k,285)*y(k,54) - mat(k,541) = -(rxt(k,115)*y(k,33) + rxt(k,116)*y(k,35) + rxt(k,117)*y(k,43) & - + rxt(k,118)*y(k,53) + rxt(k,119)*y(k,55) + (4._r8*rxt(k,120) & - + 4._r8*rxt(k,121)) * y(k,69) + rxt(k,123)*y(k,44) + rxt(k,137) & - *y(k,52) + rxt(k,138)*y(k,47) + rxt(k,146)*y(k,51) + rxt(k,147) & - *y(k,42) + rxt(k,166)*y(k,25) + (rxt(k,168) + rxt(k,169) & - ) * y(k,24) + rxt(k,171)*y(k,40) + rxt(k,174)*y(k,46) + rxt(k,198) & - *y(k,2) + rxt(k,200)*y(k,36) + rxt(k,232)*y(k,14) + rxt(k,235) & - *y(k,19) + (rxt(k,237) + rxt(k,241)) * y(k,27)) - mat(k,625) = -rxt(k,115)*y(k,69) + mat(k,81) = rxt(k,269)*y(k,55) + mat(k,129) = rxt(k,273)*y(k,55) + mat(k,139) = rxt(k,281)*y(k,55) + mat(k,56) = rxt(k,285)*y(k,55) + mat(k,542) = -(rxt(k,115)*y(k,35) + rxt(k,116)*y(k,37) + rxt(k,117)*y(k,60) & + + rxt(k,118)*y(k,54) + rxt(k,119)*y(k,56) + (4._r8*rxt(k,120) & + + 4._r8*rxt(k,121)) * y(k,69) + rxt(k,123)*y(k,45) + rxt(k,137) & + *y(k,53) + rxt(k,138)*y(k,48) + rxt(k,146)*y(k,52) + rxt(k,147) & + *y(k,44) + rxt(k,166)*y(k,27) + (rxt(k,168) + rxt(k,169) & + ) * y(k,26) + rxt(k,171)*y(k,42) + rxt(k,174)*y(k,47) + rxt(k,198) & + *y(k,3) + rxt(k,200)*y(k,38) + rxt(k,232)*y(k,15) + rxt(k,235) & + *y(k,20) + (rxt(k,237) + rxt(k,241)) * y(k,29)) + mat(k,369) = -rxt(k,115)*y(k,69) mat(k,75) = -rxt(k,116)*y(k,69) - mat(k,566) = -rxt(k,117)*y(k,69) - mat(k,605) = -rxt(k,118)*y(k,69) - mat(k,643) = -rxt(k,119)*y(k,69) - mat(k,44) = -rxt(k,123)*y(k,69) - mat(k,325) = -rxt(k,137)*y(k,69) - mat(k,199) = -rxt(k,138)*y(k,69) - mat(k,510) = -rxt(k,146)*y(k,69) + mat(k,329) = -rxt(k,117)*y(k,69) + mat(k,643) = -rxt(k,118)*y(k,69) + mat(k,604) = -rxt(k,119)*y(k,69) + mat(k,45) = -rxt(k,123)*y(k,69) + mat(k,511) = -rxt(k,137)*y(k,69) + mat(k,200) = -rxt(k,138)*y(k,69) + mat(k,416) = -rxt(k,146)*y(k,69) mat(k,222) = -rxt(k,147)*y(k,69) - mat(k,212) = -rxt(k,166)*y(k,69) - mat(k,421) = -(rxt(k,168) + rxt(k,169)) * y(k,69) - mat(k,274) = -rxt(k,171)*y(k,69) - mat(k,116) = -rxt(k,174)*y(k,69) - mat(k,370) = -rxt(k,198)*y(k,69) - mat(k,124) = -rxt(k,200)*y(k,69) + mat(k,211) = -rxt(k,166)*y(k,69) + mat(k,467) = -(rxt(k,168) + rxt(k,169)) * y(k,69) + mat(k,273) = -rxt(k,171)*y(k,69) + mat(k,123) = -rxt(k,174)*y(k,69) + mat(k,490) = -rxt(k,198)*y(k,69) + mat(k,116) = -rxt(k,200)*y(k,69) mat(k,292) = -rxt(k,232)*y(k,69) - mat(k,38) = -rxt(k,235)*y(k,69) - mat(k,69) = -(rxt(k,237) + rxt(k,241)) * y(k,69) - mat(k,292) = mat(k,292) + rxt(k,231)*y(k,53) - mat(k,38) = mat(k,38) + .300_r8*rxt(k,235)*y(k,69) + mat(k,37) = -rxt(k,235)*y(k,69) + mat(k,70) = -(rxt(k,237) + rxt(k,241)) * y(k,69) + mat(k,292) = mat(k,292) + rxt(k,231)*y(k,54) + mat(k,37) = mat(k,37) + .300_r8*rxt(k,235)*y(k,69) + mat(k,586) = rxt(k,155)*y(k,60) mat(k,108) = rxt(k,209)*y(k,73) - mat(k,304) = 2.000_r8*rxt(k,109)*y(k,43) + rxt(k,114)*y(k,55) - mat(k,625) = mat(k,625) + rxt(k,106)*y(k,53) + rxt(k,89)*y(k,65) - mat(k,75) = mat(k,75) + rxt(k,107)*y(k,53) - mat(k,124) = mat(k,124) + rxt(k,199)*y(k,53) + rxt(k,205)*y(k,65) - mat(k,274) = mat(k,274) + rxt(k,170)*y(k,53) + rxt(k,182)*y(k,65) - mat(k,566) = mat(k,566) + 2.000_r8*rxt(k,109)*y(k,32) + rxt(k,139)*y(k,50) & - + rxt(k,134)*y(k,52) + rxt(k,112)*y(k,53) + rxt(k,113)*y(k,55) & - + rxt(k,155)*y(k,59) - mat(k,99) = rxt(k,201)*y(k,53) - mat(k,116) = mat(k,116) + rxt(k,173)*y(k,53) - mat(k,347) = rxt(k,139)*y(k,43) - mat(k,325) = mat(k,325) + rxt(k,134)*y(k,43) - mat(k,605) = mat(k,605) + rxt(k,231)*y(k,14) + rxt(k,106)*y(k,33) & - + rxt(k,107)*y(k,35) + rxt(k,199)*y(k,36) + rxt(k,170)*y(k,40) & - + rxt(k,112)*y(k,43) + rxt(k,201)*y(k,45) + rxt(k,173)*y(k,46) - mat(k,643) = mat(k,643) + rxt(k,114)*y(k,32) + rxt(k,113)*y(k,43) - mat(k,395) = rxt(k,155)*y(k,43) - mat(k,446) = rxt(k,89)*y(k,33) + rxt(k,205)*y(k,36) + rxt(k,182)*y(k,40) & + mat(k,305) = rxt(k,114)*y(k,56) + 2.000_r8*rxt(k,109)*y(k,60) + mat(k,369) = mat(k,369) + rxt(k,106)*y(k,54) + rxt(k,89)*y(k,65) + mat(k,75) = mat(k,75) + rxt(k,107)*y(k,54) + mat(k,116) = mat(k,116) + rxt(k,199)*y(k,54) + rxt(k,205)*y(k,65) + mat(k,273) = mat(k,273) + rxt(k,170)*y(k,54) + rxt(k,182)*y(k,65) + mat(k,98) = rxt(k,201)*y(k,54) + mat(k,123) = mat(k,123) + rxt(k,173)*y(k,54) + mat(k,391) = rxt(k,139)*y(k,60) + mat(k,511) = mat(k,511) + rxt(k,134)*y(k,60) + mat(k,643) = mat(k,643) + rxt(k,231)*y(k,15) + rxt(k,106)*y(k,35) & + + rxt(k,107)*y(k,37) + rxt(k,199)*y(k,38) + rxt(k,170)*y(k,42) & + + rxt(k,201)*y(k,46) + rxt(k,173)*y(k,47) + rxt(k,112)*y(k,60) + mat(k,604) = mat(k,604) + rxt(k,114)*y(k,34) + rxt(k,113)*y(k,60) + mat(k,329) = mat(k,329) + rxt(k,155)*y(k,23) + 2.000_r8*rxt(k,109)*y(k,34) & + + rxt(k,139)*y(k,51) + rxt(k,134)*y(k,53) + rxt(k,112)*y(k,54) & + + rxt(k,113)*y(k,56) + mat(k,441) = rxt(k,89)*y(k,35) + rxt(k,205)*y(k,38) + rxt(k,182)*y(k,42) & + 2.000_r8*rxt(k,90)*y(k,73) - mat(k,541) = mat(k,541) + .300_r8*rxt(k,235)*y(k,19) - mat(k,254) = rxt(k,209)*y(k,31) + 2.000_r8*rxt(k,90)*y(k,65) - mat(k,138) = -(rxt(k,280)*y(k,61) + rxt(k,281)*y(k,54)) + mat(k,542) = mat(k,542) + .300_r8*rxt(k,235)*y(k,20) + mat(k,254) = rxt(k,209)*y(k,33) + 2.000_r8*rxt(k,90)*y(k,65) + mat(k,138) = -(rxt(k,280)*y(k,61) + rxt(k,281)*y(k,55)) mat(k,175) = -rxt(k,280)*y(k,70) mat(k,231) = -rxt(k,281)*y(k,70) - mat(k,584) = rxt(k,271)*y(k,62) + rxt(k,272)*y(k,64) + rxt(k,284)*y(k,71) & + mat(k,622) = rxt(k,271)*y(k,62) + rxt(k,272)*y(k,64) + rxt(k,284)*y(k,71) & + rxt(k,290)*y(k,72) mat(k,162) = rxt(k,282)*y(k,71) + rxt(k,287)*y(k,72) - mat(k,80) = rxt(k,271)*y(k,53) - mat(k,128) = rxt(k,272)*y(k,53) - mat(k,55) = rxt(k,284)*y(k,53) + rxt(k,282)*y(k,60) - mat(k,50) = rxt(k,290)*y(k,53) + rxt(k,287)*y(k,60) - mat(k,53) = -(rxt(k,282)*y(k,60) + rxt(k,284)*y(k,53) + rxt(k,285)*y(k,54)) + mat(k,80) = rxt(k,271)*y(k,54) + mat(k,128) = rxt(k,272)*y(k,54) + mat(k,55) = rxt(k,284)*y(k,54) + rxt(k,282)*y(k,59) + mat(k,50) = rxt(k,290)*y(k,54) + rxt(k,287)*y(k,59) + mat(k,53) = -(rxt(k,282)*y(k,59) + rxt(k,284)*y(k,54) + rxt(k,285)*y(k,55)) mat(k,158) = -rxt(k,282)*y(k,71) - mat(k,574) = -rxt(k,284)*y(k,71) + mat(k,612) = -rxt(k,284)*y(k,71) mat(k,227) = -rxt(k,285)*y(k,71) mat(k,158) = mat(k,158) + rxt(k,286)*y(k,72) - mat(k,47) = rxt(k,286)*y(k,60) - mat(k,46) = -((rxt(k,286) + rxt(k,287)) * y(k,60) + rxt(k,290)*y(k,53)) + mat(k,47) = rxt(k,286)*y(k,59) + mat(k,46) = -((rxt(k,286) + rxt(k,287)) * y(k,59) + rxt(k,290)*y(k,54)) mat(k,157) = -(rxt(k,286) + rxt(k,287)) * y(k,72) - mat(k,573) = -rxt(k,290)*y(k,72) - mat(k,248) = -(rxt(k,90)*y(k,65) + rxt(k,209)*y(k,31)) - mat(k,433) = -rxt(k,90)*y(k,73) + mat(k,611) = -rxt(k,290)*y(k,72) + mat(k,248) = -(rxt(k,90)*y(k,65) + rxt(k,209)*y(k,33)) + mat(k,428) = -rxt(k,90)*y(k,73) mat(k,104) = -rxt(k,209)*y(k,73) mat(k,280) = rxt(k,232)*y(k,69) mat(k,34) = rxt(k,235)*y(k,69) - mat(k,297) = rxt(k,110)*y(k,43) - mat(k,613) = rxt(k,115)*y(k,69) + mat(k,297) = rxt(k,110)*y(k,60) + mat(k,357) = rxt(k,115)*y(k,69) mat(k,72) = rxt(k,116)*y(k,69) - mat(k,119) = rxt(k,200)*y(k,69) - mat(k,263) = (rxt(k,254)+rxt(k,259))*y(k,45) + (rxt(k,247)+rxt(k,253) & - +rxt(k,258))*y(k,46) + rxt(k,171)*y(k,69) + mat(k,111) = rxt(k,200)*y(k,69) + mat(k,263) = (rxt(k,254)+rxt(k,259))*y(k,46) + (rxt(k,247)+rxt(k,253) & + +rxt(k,258))*y(k,47) + rxt(k,171)*y(k,69) mat(k,217) = rxt(k,147)*y(k,69) - mat(k,553) = rxt(k,110)*y(k,32) + rxt(k,117)*y(k,69) mat(k,41) = rxt(k,123)*y(k,69) - mat(k,94) = (rxt(k,254)+rxt(k,259))*y(k,40) - mat(k,112) = (rxt(k,247)+rxt(k,253)+rxt(k,258))*y(k,40) + rxt(k,174)*y(k,69) - mat(k,528) = rxt(k,232)*y(k,14) + rxt(k,235)*y(k,19) + rxt(k,115)*y(k,33) & - + rxt(k,116)*y(k,35) + rxt(k,200)*y(k,36) + rxt(k,171)*y(k,40) & - + rxt(k,147)*y(k,42) + rxt(k,117)*y(k,43) + rxt(k,123)*y(k,44) & - + rxt(k,174)*y(k,46) + 2.000_r8*rxt(k,120)*y(k,69) + mat(k,94) = (rxt(k,254)+rxt(k,259))*y(k,42) + mat(k,120) = (rxt(k,247)+rxt(k,253)+rxt(k,258))*y(k,42) + rxt(k,174)*y(k,69) + mat(k,316) = rxt(k,110)*y(k,34) + rxt(k,117)*y(k,69) + mat(k,529) = rxt(k,232)*y(k,15) + rxt(k,235)*y(k,20) + rxt(k,115)*y(k,35) & + + rxt(k,116)*y(k,37) + rxt(k,200)*y(k,38) + rxt(k,171)*y(k,42) & + + rxt(k,147)*y(k,44) + rxt(k,123)*y(k,45) + rxt(k,174)*y(k,47) & + + rxt(k,117)*y(k,60) + 2.000_r8*rxt(k,120)*y(k,69) end do end subroutine nlnmat03 subroutine nlnmat_finit( avec_len, mat, lmat, dti ) @@ -709,7 +709,7 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 16) = lmat(k, 16) mat(k, 17) = mat(k, 17) + lmat(k, 17) mat(k, 18) = mat(k, 18) + lmat(k, 18) - mat(k, 19) = mat(k, 19) + lmat(k, 19) + mat(k, 20) = mat(k, 20) + lmat(k, 20) mat(k, 21) = lmat(k, 21) mat(k, 22) = lmat(k, 22) mat(k, 23) = lmat(k, 23) @@ -725,12 +725,12 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 33) = mat(k, 33) + lmat(k, 33) mat(k, 35) = mat(k, 35) + lmat(k, 35) mat(k, 36) = lmat(k, 36) - mat(k, 38) = mat(k, 38) + lmat(k, 38) + mat(k, 37) = mat(k, 37) + lmat(k, 37) mat(k, 39) = mat(k, 39) + lmat(k, 39) mat(k, 42) = lmat(k, 42) mat(k, 43) = mat(k, 43) + lmat(k, 43) - mat(k, 44) = mat(k, 44) + lmat(k, 44) - mat(k, 45) = lmat(k, 45) + mat(k, 44) = lmat(k, 44) + mat(k, 45) = mat(k, 45) + lmat(k, 45) mat(k, 46) = mat(k, 46) + lmat(k, 46) mat(k, 47) = mat(k, 47) + lmat(k, 47) mat(k, 48) = lmat(k, 48) @@ -745,27 +745,27 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 59) = mat(k, 59) + lmat(k, 59) mat(k, 60) = lmat(k, 60) mat(k, 61) = lmat(k, 61) - mat(k, 62) = mat(k, 62) + lmat(k, 62) - mat(k, 63) = mat(k, 63) + lmat(k, 63) - mat(k, 64) = lmat(k, 64) - mat(k, 65) = lmat(k, 65) + mat(k, 62) = lmat(k, 62) + mat(k, 63) = lmat(k, 63) + mat(k, 64) = mat(k, 64) + lmat(k, 64) + mat(k, 65) = mat(k, 65) + lmat(k, 65) mat(k, 67) = mat(k, 67) + lmat(k, 67) mat(k, 71) = mat(k, 71) + lmat(k, 71) mat(k, 75) = mat(k, 75) + lmat(k, 75) mat(k, 78) = mat(k, 78) + lmat(k, 78) mat(k, 87) = mat(k, 87) + lmat(k, 87) mat(k, 93) = mat(k, 93) + lmat(k, 93) - mat(k, 98) = lmat(k, 98) - mat(k, 99) = mat(k, 99) + lmat(k, 99) + mat(k, 96) = lmat(k, 96) + mat(k, 98) = mat(k, 98) + lmat(k, 98) mat(k, 101) = mat(k, 101) + lmat(k, 101) mat(k, 102) = mat(k, 102) + lmat(k, 102) - mat(k, 107) = lmat(k, 107) - mat(k, 111) = mat(k, 111) + lmat(k, 111) - mat(k, 114) = mat(k, 114) + lmat(k, 114) - mat(k, 116) = mat(k, 116) + lmat(k, 116) - mat(k, 118) = mat(k, 118) + lmat(k, 118) - mat(k, 120) = mat(k, 120) + lmat(k, 120) + mat(k, 109) = lmat(k, 109) + mat(k, 110) = mat(k, 110) + lmat(k, 110) + mat(k, 112) = mat(k, 112) + lmat(k, 112) + mat(k, 113) = mat(k, 113) + lmat(k, 113) + mat(k, 119) = mat(k, 119) + lmat(k, 119) mat(k, 123) = mat(k, 123) + lmat(k, 123) + mat(k, 124) = mat(k, 124) + lmat(k, 124) mat(k, 127) = mat(k, 127) + lmat(k, 127) mat(k, 135) = lmat(k, 135) mat(k, 136) = lmat(k, 136) @@ -783,12 +783,12 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 203) = mat(k, 203) + lmat(k, 203) mat(k, 204) = mat(k, 204) + lmat(k, 204) mat(k, 205) = mat(k, 205) + lmat(k, 205) - mat(k, 208) = mat(k, 208) + lmat(k, 208) + mat(k, 208) = lmat(k, 208) mat(k, 209) = mat(k, 209) + lmat(k, 209) mat(k, 210) = mat(k, 210) + lmat(k, 210) - mat(k, 211) = lmat(k, 211) + mat(k, 212) = mat(k, 212) + lmat(k, 212) mat(k, 216) = mat(k, 216) + lmat(k, 216) - mat(k, 221) = lmat(k, 221) + mat(k, 220) = lmat(k, 220) mat(k, 222) = mat(k, 222) + lmat(k, 222) mat(k, 226) = lmat(k, 226) mat(k, 227) = mat(k, 227) + lmat(k, 227) @@ -796,89 +796,89 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 232) = mat(k, 232) + lmat(k, 232) mat(k, 233) = lmat(k, 233) mat(k, 236) = mat(k, 236) + lmat(k, 236) - mat(k, 239) = mat(k, 239) + lmat(k, 239) - mat(k, 243) = mat(k, 243) + lmat(k, 243) + mat(k, 241) = mat(k, 241) + lmat(k, 241) + mat(k, 244) = mat(k, 244) + lmat(k, 244) mat(k, 248) = mat(k, 248) + lmat(k, 248) mat(k, 249) = lmat(k, 249) - mat(k, 251) = mat(k, 251) + lmat(k, 251) + mat(k, 250) = lmat(k, 250) + mat(k, 252) = mat(k, 252) + lmat(k, 252) mat(k, 254) = mat(k, 254) + lmat(k, 254) - mat(k, 255) = lmat(k, 255) mat(k, 256) = lmat(k, 256) mat(k, 264) = mat(k, 264) + lmat(k, 264) mat(k, 265) = mat(k, 265) + lmat(k, 265) - mat(k, 268) = mat(k, 268) + lmat(k, 268) + mat(k, 275) = mat(k, 275) + lmat(k, 275) mat(k, 277) = mat(k, 277) + lmat(k, 277) mat(k, 282) = mat(k, 282) + lmat(k, 282) mat(k, 283) = mat(k, 283) + lmat(k, 283) - mat(k, 295) = lmat(k, 295) + mat(k, 286) = lmat(k, 286) mat(k, 298) = mat(k, 298) + lmat(k, 298) mat(k, 311) = mat(k, 311) + lmat(k, 311) - mat(k, 312) = mat(k, 312) + lmat(k, 312) - mat(k, 316) = mat(k, 316) + lmat(k, 316) - mat(k, 317) = mat(k, 317) + lmat(k, 317) - mat(k, 324) = mat(k, 324) + lmat(k, 324) - mat(k, 327) = mat(k, 327) + lmat(k, 327) - mat(k, 330) = mat(k, 330) + lmat(k, 330) - mat(k, 332) = lmat(k, 332) - mat(k, 334) = mat(k, 334) + lmat(k, 334) - mat(k, 339) = mat(k, 339) + lmat(k, 339) - mat(k, 349) = mat(k, 349) + lmat(k, 349) - mat(k, 363) = mat(k, 363) + lmat(k, 363) - mat(k, 367) = mat(k, 367) + lmat(k, 367) - mat(k, 372) = mat(k, 372) + lmat(k, 372) - mat(k, 376) = mat(k, 376) + lmat(k, 376) - mat(k, 383) = mat(k, 383) + lmat(k, 383) - mat(k, 389) = mat(k, 389) + lmat(k, 389) - mat(k, 392) = lmat(k, 392) - mat(k, 393) = lmat(k, 393) - mat(k, 396) = mat(k, 396) + lmat(k, 396) - mat(k, 415) = mat(k, 415) + lmat(k, 415) + mat(k, 320) = mat(k, 320) + lmat(k, 320) + mat(k, 341) = mat(k, 341) + lmat(k, 341) + mat(k, 362) = mat(k, 362) + lmat(k, 362) + mat(k, 374) = mat(k, 374) + lmat(k, 374) + mat(k, 376) = lmat(k, 376) + mat(k, 378) = mat(k, 378) + lmat(k, 378) + mat(k, 385) = mat(k, 385) + lmat(k, 385) + mat(k, 395) = mat(k, 395) + lmat(k, 395) + mat(k, 402) = mat(k, 402) + lmat(k, 402) + mat(k, 410) = mat(k, 410) + lmat(k, 410) + mat(k, 411) = mat(k, 411) + lmat(k, 411) mat(k, 416) = mat(k, 416) + lmat(k, 416) + mat(k, 420) = mat(k, 420) + lmat(k, 420) + mat(k, 421) = mat(k, 421) + lmat(k, 421) mat(k, 423) = mat(k, 423) + lmat(k, 423) - mat(k, 426) = mat(k, 426) + lmat(k, 426) - mat(k, 428) = mat(k, 428) + lmat(k, 428) - mat(k, 429) = mat(k, 429) + lmat(k, 429) - mat(k, 432) = mat(k, 432) + lmat(k, 432) + mat(k, 424) = mat(k, 424) + lmat(k, 424) + mat(k, 427) = mat(k, 427) + lmat(k, 427) + mat(k, 430) = lmat(k, 430) + mat(k, 431) = mat(k, 431) + lmat(k, 431) + mat(k, 432) = lmat(k, 432) + mat(k, 433) = mat(k, 433) + lmat(k, 433) + mat(k, 434) = mat(k, 434) + lmat(k, 434) mat(k, 435) = lmat(k, 435) - mat(k, 436) = mat(k, 436) + lmat(k, 436) - mat(k, 438) = lmat(k, 438) - mat(k, 440) = mat(k, 440) + lmat(k, 440) - mat(k, 442) = mat(k, 442) + lmat(k, 442) + mat(k, 437) = mat(k, 437) + lmat(k, 437) + mat(k, 441) = mat(k, 441) + lmat(k, 441) + mat(k, 442) = lmat(k, 442) mat(k, 443) = mat(k, 443) + lmat(k, 443) - mat(k, 444) = lmat(k, 444) - mat(k, 446) = mat(k, 446) + lmat(k, 446) - mat(k, 447) = lmat(k, 447) - mat(k, 448) = mat(k, 448) + lmat(k, 448) - mat(k, 449) = mat(k, 449) + lmat(k, 449) - mat(k, 463) = mat(k, 463) + lmat(k, 463) - mat(k, 483) = mat(k, 483) + lmat(k, 483) - mat(k, 496) = mat(k, 496) + lmat(k, 496) - mat(k, 502) = mat(k, 502) + lmat(k, 502) - mat(k, 509) = mat(k, 509) + lmat(k, 509) + mat(k, 445) = mat(k, 445) + lmat(k, 445) + mat(k, 464) = mat(k, 464) + lmat(k, 464) + mat(k, 469) = mat(k, 469) + lmat(k, 469) + mat(k, 471) = mat(k, 471) + lmat(k, 471) + mat(k, 482) = mat(k, 482) + lmat(k, 482) + mat(k, 488) = mat(k, 488) + lmat(k, 488) + mat(k, 494) = mat(k, 494) + lmat(k, 494) + mat(k, 497) = mat(k, 497) + lmat(k, 497) + mat(k, 498) = mat(k, 498) + lmat(k, 498) + mat(k, 505) = mat(k, 505) + lmat(k, 505) + mat(k, 506) = mat(k, 506) + lmat(k, 506) mat(k, 510) = mat(k, 510) + lmat(k, 510) - mat(k, 512) = mat(k, 512) + lmat(k, 512) - mat(k, 515) = lmat(k, 515) + mat(k, 515) = mat(k, 515) + lmat(k, 515) mat(k, 516) = lmat(k, 516) - mat(k, 528) = mat(k, 528) + lmat(k, 528) - mat(k, 535) = mat(k, 535) + lmat(k, 535) - mat(k, 538) = mat(k, 538) + lmat(k, 538) - mat(k, 539) = mat(k, 539) + lmat(k, 539) - mat(k, 541) = mat(k, 541) + lmat(k, 541) + mat(k, 517) = lmat(k, 517) + mat(k, 529) = mat(k, 529) + lmat(k, 529) + mat(k, 533) = mat(k, 533) + lmat(k, 533) + mat(k, 534) = mat(k, 534) + lmat(k, 534) mat(k, 542) = mat(k, 542) + lmat(k, 542) - mat(k, 548) = mat(k, 548) + lmat(k, 548) + mat(k, 543) = mat(k, 543) + lmat(k, 543) + mat(k, 544) = mat(k, 544) + lmat(k, 544) + mat(k, 562) = mat(k, 562) + lmat(k, 562) mat(k, 567) = mat(k, 567) + lmat(k, 567) - mat(k, 573) = mat(k, 573) + lmat(k, 573) mat(k, 574) = mat(k, 574) + lmat(k, 574) - mat(k, 584) = mat(k, 584) + lmat(k, 584) - mat(k, 586) = lmat(k, 586) + mat(k, 577) = mat(k, 577) + lmat(k, 577) + mat(k, 578) = lmat(k, 578) + mat(k, 587) = lmat(k, 587) + mat(k, 588) = mat(k, 588) + lmat(k, 588) + mat(k, 591) = mat(k, 591) + lmat(k, 591) + mat(k, 593) = mat(k, 593) + lmat(k, 593) + mat(k, 600) = mat(k, 600) + lmat(k, 600) mat(k, 607) = mat(k, 607) + lmat(k, 607) - mat(k, 628) = mat(k, 628) + lmat(k, 628) - mat(k, 630) = mat(k, 630) + lmat(k, 630) - mat(k, 632) = mat(k, 632) + lmat(k, 632) - mat(k, 639) = mat(k, 639) + lmat(k, 639) - mat(k, 645) = mat(k, 645) + lmat(k, 645) + mat(k, 608) = mat(k, 608) + lmat(k, 608) + mat(k, 611) = mat(k, 611) + lmat(k, 611) + mat(k, 612) = mat(k, 612) + lmat(k, 612) + mat(k, 622) = mat(k, 622) + lmat(k, 622) + mat(k, 624) = lmat(k, 624) mat(k, 647) = mat(k, 647) + lmat(k, 647) - mat(k, 97) = 0._r8 + mat(k, 99) = 0._r8 mat(k, 130) = 0._r8 mat(k, 131) = 0._r8 mat(k, 140) = 0._r8 @@ -890,135 +890,135 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 167) = 0._r8 mat(k, 168) = 0._r8 mat(k, 169) = 0._r8 - mat(k, 171) = 0._r8 + mat(k, 170) = 0._r8 mat(k, 172) = 0._r8 mat(k, 176) = 0._r8 mat(k, 177) = 0._r8 mat(k, 181) = 0._r8 - mat(k, 184) = 0._r8 + mat(k, 182) = 0._r8 mat(k, 185) = 0._r8 mat(k, 189) = 0._r8 mat(k, 192) = 0._r8 - mat(k, 197) = 0._r8 - mat(k, 200) = 0._r8 + mat(k, 196) = 0._r8 + mat(k, 199) = 0._r8 mat(k, 206) = 0._r8 mat(k, 218) = 0._r8 - mat(k, 220) = 0._r8 + mat(k, 219) = 0._r8 mat(k, 223) = 0._r8 mat(k, 240) = 0._r8 - mat(k, 241) = 0._r8 + mat(k, 242) = 0._r8 mat(k, 247) = 0._r8 - mat(k, 250) = 0._r8 - mat(k, 252) = 0._r8 + mat(k, 251) = 0._r8 mat(k, 253) = 0._r8 + mat(k, 255) = 0._r8 mat(k, 266) = 0._r8 mat(k, 267) = 0._r8 + mat(k, 268) = 0._r8 mat(k, 271) = 0._r8 mat(k, 272) = 0._r8 - mat(k, 273) = 0._r8 - mat(k, 276) = 0._r8 - mat(k, 285) = 0._r8 + mat(k, 274) = 0._r8 mat(k, 287) = 0._r8 mat(k, 288) = 0._r8 + mat(k, 289) = 0._r8 mat(k, 290) = 0._r8 - mat(k, 291) = 0._r8 - mat(k, 299) = 0._r8 - mat(k, 300) = 0._r8 + mat(k, 293) = 0._r8 mat(k, 301) = 0._r8 mat(k, 302) = 0._r8 mat(k, 303) = 0._r8 - mat(k, 313) = 0._r8 - mat(k, 315) = 0._r8 + mat(k, 304) = 0._r8 + mat(k, 306) = 0._r8 mat(k, 318) = 0._r8 - mat(k, 319) = 0._r8 - mat(k, 320) = 0._r8 - mat(k, 321) = 0._r8 - mat(k, 322) = 0._r8 - mat(k, 323) = 0._r8 - mat(k, 328) = 0._r8 - mat(k, 329) = 0._r8 - mat(k, 333) = 0._r8 + mat(k, 325) = 0._r8 mat(k, 337) = 0._r8 + mat(k, 339) = 0._r8 + mat(k, 342) = 0._r8 mat(k, 343) = 0._r8 + mat(k, 344) = 0._r8 + mat(k, 345) = 0._r8 + mat(k, 346) = 0._r8 + mat(k, 348) = 0._r8 + mat(k, 349) = 0._r8 mat(k, 350) = 0._r8 + mat(k, 351) = 0._r8 + mat(k, 353) = 0._r8 mat(k, 356) = 0._r8 - mat(k, 358) = 0._r8 - mat(k, 359) = 0._r8 mat(k, 360) = 0._r8 mat(k, 361) = 0._r8 + mat(k, 363) = 0._r8 + mat(k, 364) = 0._r8 mat(k, 366) = 0._r8 + mat(k, 367) = 0._r8 mat(k, 368) = 0._r8 - mat(k, 373) = 0._r8 - mat(k, 374) = 0._r8 - mat(k, 380) = 0._r8 - mat(k, 382) = 0._r8 + mat(k, 370) = 0._r8 + mat(k, 372) = 0._r8 + mat(k, 377) = 0._r8 + mat(k, 381) = 0._r8 + mat(k, 384) = 0._r8 mat(k, 387) = 0._r8 - mat(k, 388) = 0._r8 - mat(k, 391) = 0._r8 - mat(k, 394) = 0._r8 - mat(k, 397) = 0._r8 + mat(k, 399) = 0._r8 + mat(k, 404) = 0._r8 + mat(k, 405) = 0._r8 mat(k, 406) = 0._r8 mat(k, 408) = 0._r8 - mat(k, 411) = 0._r8 + mat(k, 409) = 0._r8 mat(k, 412) = 0._r8 mat(k, 417) = 0._r8 - mat(k, 424) = 0._r8 - mat(k, 425) = 0._r8 - mat(k, 431) = 0._r8 - mat(k, 437) = 0._r8 - mat(k, 445) = 0._r8 + mat(k, 418) = 0._r8 + mat(k, 426) = 0._r8 + mat(k, 436) = 0._r8 + mat(k, 440) = 0._r8 + mat(k, 452) = 0._r8 mat(k, 454) = 0._r8 - mat(k, 456) = 0._r8 mat(k, 457) = 0._r8 - mat(k, 458) = 0._r8 mat(k, 460) = 0._r8 - mat(k, 461) = 0._r8 - mat(k, 462) = 0._r8 - mat(k, 464) = 0._r8 - mat(k, 465) = 0._r8 + mat(k, 463) = 0._r8 mat(k, 466) = 0._r8 - mat(k, 468) = 0._r8 - mat(k, 469) = 0._r8 - mat(k, 473) = 0._r8 - mat(k, 475) = 0._r8 + mat(k, 470) = 0._r8 mat(k, 476) = 0._r8 mat(k, 478) = 0._r8 - mat(k, 481) = 0._r8 - mat(k, 482) = 0._r8 - mat(k, 485) = 0._r8 - mat(k, 487) = 0._r8 - mat(k, 488) = 0._r8 + mat(k, 479) = 0._r8 + mat(k, 480) = 0._r8 + mat(k, 483) = 0._r8 + mat(k, 486) = 0._r8 mat(k, 489) = 0._r8 + mat(k, 491) = 0._r8 mat(k, 493) = 0._r8 - mat(k, 498) = 0._r8 mat(k, 499) = 0._r8 - mat(k, 500) = 0._r8 + mat(k, 501) = 0._r8 + mat(k, 503) = 0._r8 mat(k, 504) = 0._r8 - mat(k, 506) = 0._r8 mat(k, 507) = 0._r8 mat(k, 508) = 0._r8 + mat(k, 509) = 0._r8 + mat(k, 512) = 0._r8 mat(k, 513) = 0._r8 - mat(k, 521) = 0._r8 - mat(k, 537) = 0._r8 - mat(k, 555) = 0._r8 - mat(k, 562) = 0._r8 - mat(k, 585) = 0._r8 + mat(k, 514) = 0._r8 + mat(k, 522) = 0._r8 + mat(k, 538) = 0._r8 + mat(k, 549) = 0._r8 + mat(k, 551) = 0._r8 + mat(k, 553) = 0._r8 + mat(k, 554) = 0._r8 + mat(k, 557) = 0._r8 + mat(k, 559) = 0._r8 + mat(k, 560) = 0._r8 + mat(k, 561) = 0._r8 + mat(k, 564) = 0._r8 + mat(k, 565) = 0._r8 + mat(k, 571) = 0._r8 + mat(k, 573) = 0._r8 + mat(k, 580) = 0._r8 + mat(k, 581) = 0._r8 + mat(k, 582) = 0._r8 + mat(k, 584) = 0._r8 mat(k, 590) = 0._r8 - mat(k, 592) = 0._r8 - mat(k, 601) = 0._r8 - mat(k, 603) = 0._r8 - mat(k, 612) = 0._r8 - mat(k, 616) = 0._r8 - mat(k, 617) = 0._r8 - mat(k, 618) = 0._r8 - mat(k, 620) = 0._r8 - mat(k, 622) = 0._r8 + mat(k, 597) = 0._r8 + mat(k, 605) = 0._r8 mat(k, 623) = 0._r8 - mat(k, 624) = 0._r8 - mat(k, 626) = 0._r8 - mat(k, 629) = 0._r8 - mat(k, 641) = 0._r8 - mat(k, 646) = 0._r8 + mat(k, 628) = 0._r8 + mat(k, 630) = 0._r8 + mat(k, 639) = 0._r8 + mat(k, 644) = 0._r8 mat(k, 1) = mat(k, 1) - dti(k) mat(k, 4) = mat(k, 4) - dti(k) mat(k, 7) = mat(k, 7) - dti(k) @@ -1040,8 +1040,8 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 87) = mat(k, 87) - dti(k) mat(k, 93) = mat(k, 93) - dti(k) mat(k, 102) = mat(k, 102) - dti(k) - mat(k, 111) = mat(k, 111) - dti(k) - mat(k, 118) = mat(k, 118) - dti(k) + mat(k, 110) = mat(k, 110) - dti(k) + mat(k, 119) = mat(k, 119) - dti(k) mat(k, 127) = mat(k, 127) - dti(k) mat(k, 138) = mat(k, 138) - dti(k) mat(k, 149) = mat(k, 149) - dti(k) @@ -1055,19 +1055,19 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 264) = mat(k, 264) - dti(k) mat(k, 282) = mat(k, 282) - dti(k) mat(k, 298) = mat(k, 298) - dti(k) - mat(k, 316) = mat(k, 316) - dti(k) - mat(k, 339) = mat(k, 339) - dti(k) - mat(k, 363) = mat(k, 363) - dti(k) - mat(k, 389) = mat(k, 389) - dti(k) - mat(k, 416) = mat(k, 416) - dti(k) - mat(k, 442) = mat(k, 442) - dti(k) - mat(k, 463) = mat(k, 463) - dti(k) - mat(k, 483) = mat(k, 483) - dti(k) - mat(k, 509) = mat(k, 509) - dti(k) - mat(k, 541) = mat(k, 541) - dti(k) - mat(k, 567) = mat(k, 567) - dti(k) + mat(k, 320) = mat(k, 320) - dti(k) + mat(k, 341) = mat(k, 341) - dti(k) + mat(k, 362) = mat(k, 362) - dti(k) + mat(k, 385) = mat(k, 385) - dti(k) + mat(k, 411) = mat(k, 411) - dti(k) + mat(k, 437) = mat(k, 437) - dti(k) + mat(k, 464) = mat(k, 464) - dti(k) + mat(k, 488) = mat(k, 488) - dti(k) + mat(k, 510) = mat(k, 510) - dti(k) + mat(k, 542) = mat(k, 542) - dti(k) + mat(k, 562) = mat(k, 562) - dti(k) + mat(k, 588) = mat(k, 588) - dti(k) mat(k, 607) = mat(k, 607) - dti(k) - mat(k, 628) = mat(k, 628) - dti(k) mat(k, 647) = mat(k, 647) - dti(k) end do end subroutine nlnmat_finit diff --git a/src/chemistry/pp_waccm_ma/mo_prod_loss.F90 b/src/chemistry/pp_waccm_ma/mo_prod_loss.F90 index 04ea0ea1e7..a89d0ad7a1 100644 --- a/src/chemistry/pp_waccm_ma/mo_prod_loss.F90 +++ b/src/chemistry/pp_waccm_ma/mo_prod_loss.F90 @@ -27,62 +27,62 @@ subroutine exp_prod_loss( ofl, ofu, prod, loss, y, & ! ... loss and production for Explicit method !-------------------------------------------------------------------- do k = ofl,ofu - loss(k,1) = ( + het_rates(k,4))* y(k,4) + loss(k,1) = ( + het_rates(k,5))* y(k,5) prod(k,1) = 0._r8 - loss(k,2) = (rxt(k,175)* y(k,65) + rxt(k,30) + het_rates(k,5))* y(k,5) + loss(k,2) = (rxt(k,175)* y(k,65) + rxt(k,30) + het_rates(k,6))* y(k,6) prod(k,2) = 0._r8 - loss(k,3) = (rxt(k,176)* y(k,65) + rxt(k,31) + het_rates(k,6))* y(k,6) + loss(k,3) = (rxt(k,176)* y(k,65) + rxt(k,31) + het_rates(k,7))* y(k,7) prod(k,3) = 0._r8 - loss(k,4) = (rxt(k,202)* y(k,65) + rxt(k,32) + het_rates(k,7))* y(k,7) + loss(k,4) = (rxt(k,202)* y(k,65) + rxt(k,32) + het_rates(k,8))* y(k,8) prod(k,4) = 0._r8 - loss(k,5) = (rxt(k,177)* y(k,65) + rxt(k,33) + het_rates(k,8))* y(k,8) + loss(k,5) = (rxt(k,177)* y(k,65) + rxt(k,33) + het_rates(k,9))* y(k,9) prod(k,5) = 0._r8 - loss(k,6) = (rxt(k,178)* y(k,65) + rxt(k,34) + het_rates(k,9))* y(k,9) + loss(k,6) = (rxt(k,178)* y(k,65) + rxt(k,34) + het_rates(k,10))* y(k,10) prod(k,6) = 0._r8 - loss(k,7) = (rxt(k,179)* y(k,65) + rxt(k,35) + het_rates(k,10))* y(k,10) + loss(k,7) = (rxt(k,179)* y(k,65) + rxt(k,35) + het_rates(k,11))* y(k,11) prod(k,7) = 0._r8 - loss(k,8) = (rxt(k,180)* y(k,65) + rxt(k,36) + het_rates(k,11))* y(k,11) + loss(k,8) = (rxt(k,180)* y(k,65) + rxt(k,36) + het_rates(k,12))* y(k,12) prod(k,8) = 0._r8 - loss(k,9) = (rxt(k,181)* y(k,65) + rxt(k,37) + het_rates(k,12))* y(k,12) + loss(k,9) = (rxt(k,181)* y(k,65) + rxt(k,37) + het_rates(k,13))* y(k,13) prod(k,9) = 0._r8 - loss(k,10) = (rxt(k,213)* y(k,59) +rxt(k,225)* y(k,65) +rxt(k,214)* y(k,69) & - + rxt(k,38) + het_rates(k,13))* y(k,13) + loss(k,10) = (rxt(k,213)* y(k,23) +rxt(k,225)* y(k,65) +rxt(k,214)* y(k,69) & + + rxt(k,38) + het_rates(k,14))* y(k,14) prod(k,10) = 0._r8 - loss(k,11) = (rxt(k,215)* y(k,59) +rxt(k,226)* y(k,65) +rxt(k,216)* y(k,69) & - + rxt(k,39) + het_rates(k,15))* y(k,15) + loss(k,11) = (rxt(k,215)* y(k,23) +rxt(k,226)* y(k,65) +rxt(k,216)* y(k,69) & + + rxt(k,39) + het_rates(k,16))* y(k,16) prod(k,11) = 0._r8 - loss(k,12) = (rxt(k,217)* y(k,69) + rxt(k,40) + het_rates(k,16))* y(k,16) + loss(k,12) = (rxt(k,217)* y(k,69) + rxt(k,40) + het_rates(k,17))* y(k,17) prod(k,12) = 0._r8 - loss(k,13) = (rxt(k,218)* y(k,59) +rxt(k,219)* y(k,69) + rxt(k,41) & - + het_rates(k,17))* y(k,17) + loss(k,13) = (rxt(k,218)* y(k,23) +rxt(k,219)* y(k,69) + rxt(k,41) & + + het_rates(k,18))* y(k,18) prod(k,13) = 0._r8 - loss(k,14) = (rxt(k,207)* y(k,31) +rxt(k,151)* y(k,59) + (rxt(k,238) + & + loss(k,14) = (rxt(k,151)* y(k,23) +rxt(k,207)* y(k,33) + (rxt(k,238) + & rxt(k,239) +rxt(k,240))* y(k,65) +rxt(k,236)* y(k,69) + rxt(k,23) & - + rxt(k,24) + het_rates(k,20))* y(k,20) + + rxt(k,24) + het_rates(k,21))* y(k,21) prod(k,14) = 0._r8 - loss(k,15) = (rxt(k,220)* y(k,59) +rxt(k,203)* y(k,65) +rxt(k,221)* y(k,69) & - + rxt(k,42) + het_rates(k,21))* y(k,21) + loss(k,15) = (rxt(k,220)* y(k,23) +rxt(k,203)* y(k,65) +rxt(k,221)* y(k,69) & + + rxt(k,42) + het_rates(k,22))* y(k,22) prod(k,15) = 0._r8 - loss(k,16) = ( + het_rates(k,26))* y(k,26) + loss(k,16) = ( + het_rates(k,28))* y(k,28) prod(k,16) = 0._r8 - loss(k,17) = (rxt(k,278)* y(k,70) + rxt(k,25) + rxt(k,61) + het_rates(k,28)) & - * y(k,28) - prod(k,17) =.440_r8*rxt(k,24)*y(k,20) - loss(k,18) = (rxt(k,204)* y(k,65) + rxt(k,50) + het_rates(k,34))* y(k,34) + loss(k,17) = (rxt(k,278)* y(k,70) + rxt(k,25) + rxt(k,61) + het_rates(k,30)) & + * y(k,30) + prod(k,17) =.440_r8*rxt(k,24)*y(k,21) + loss(k,18) = (rxt(k,204)* y(k,65) + rxt(k,50) + het_rates(k,36))* y(k,36) prod(k,18) = 0._r8 loss(k,19) = (rxt(k,227)* y(k,65) +rxt(k,222)* y(k,69) + rxt(k,52) & - + het_rates(k,37))* y(k,37) + + het_rates(k,39))* y(k,39) prod(k,19) = 0._r8 loss(k,20) = (rxt(k,228)* y(k,65) +rxt(k,223)* y(k,69) + rxt(k,53) & - + het_rates(k,38))* y(k,38) + + het_rates(k,40))* y(k,40) prod(k,20) = 0._r8 loss(k,21) = (rxt(k,229)* y(k,65) +rxt(k,224)* y(k,69) + rxt(k,54) & - + het_rates(k,39))* y(k,39) + + het_rates(k,41))* y(k,41) prod(k,21) = 0._r8 loss(k,22) = ((rxt(k,142) +rxt(k,143))* y(k,65) + rxt(k,12) & - + het_rates(k,48))* y(k,48) + + het_rates(k,49))* y(k,49) prod(k,22) = 0._r8 - loss(k,23) = ( + rxt(k,60) + het_rates(k,57))* y(k,57) + loss(k,23) = ( + rxt(k,60) + het_rates(k,58))* y(k,58) prod(k,23) = 0._r8 end do end subroutine exp_prod_loss @@ -108,348 +108,350 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & ! ... loss and production for Implicit method !-------------------------------------------------------------------- do k = 1,avec_len - loss(k,8) = ( + rxt(k,26) + het_rates(k,1))* y(k,1) - prod(k,8) = (rxt(k,254)*y(k,45) +rxt(k,259)*y(k,45))*y(k,40) & - +rxt(k,192)*y(k,24)*y(k,2) - loss(k,39) = (2._r8*rxt(k,189)* y(k,2) + (rxt(k,190) +rxt(k,191) +rxt(k,192)) & - * y(k,24) +rxt(k,193)* y(k,43) +rxt(k,194)* y(k,50) +rxt(k,195) & - * y(k,51) +rxt(k,197)* y(k,53) +rxt(k,198)* y(k,69) + rxt(k,27) & - + het_rates(k,2))* y(k,2) - prod(k,39) = (rxt(k,28) +rxt(k,196)*y(k,53))*y(k,3) +rxt(k,206)*y(k,65) & - *y(k,36) +rxt(k,201)*y(k,53)*y(k,45) +rxt(k,188)*y(k,58)*y(k,55) - loss(k,15) = (rxt(k,196)* y(k,53) + rxt(k,28) + rxt(k,29) + rxt(k,248) & - + rxt(k,251) + rxt(k,256) + het_rates(k,3))* y(k,3) - prod(k,15) =rxt(k,195)*y(k,51)*y(k,2) - loss(k,35) = (rxt(k,230)* y(k,52) +rxt(k,231)* y(k,53) +rxt(k,186)* y(k,58) & - +rxt(k,150)* y(k,59) +rxt(k,232)* y(k,69) + rxt(k,20) + rxt(k,21) & - + het_rates(k,14))* y(k,14) - prod(k,35) = (rxt(k,157)*y(k,24) +rxt(k,234)*y(k,50))*y(k,18) + (rxt(k,22) + & - .300_r8*rxt(k,235)*y(k,69))*y(k,19) + (rxt(k,239)*y(k,65) + & - rxt(k,240)*y(k,65))*y(k,20) - loss(k,44) = (rxt(k,157)* y(k,24) +rxt(k,233)* y(k,43) +rxt(k,234)* y(k,50) & - + het_rates(k,18))* y(k,18) - prod(k,44) = (rxt(k,151)*y(k,59) +rxt(k,207)*y(k,31) +rxt(k,236)*y(k,69) + & - rxt(k,238)*y(k,65))*y(k,20) +.700_r8*rxt(k,235)*y(k,69)*y(k,19) - loss(k,11) = (rxt(k,235)* y(k,69) + rxt(k,22) + het_rates(k,19))* y(k,19) - prod(k,11) =rxt(k,233)*y(k,43)*y(k,18) - loss(k,6) = ( + rxt(k,43) + het_rates(k,22))* y(k,22) - prod(k,6) = (rxt(k,247)*y(k,46) +rxt(k,252)*y(k,25) +rxt(k,253)*y(k,46) + & - rxt(k,257)*y(k,25) +rxt(k,258)*y(k,46) +rxt(k,262)*y(k,25))*y(k,40) & - +rxt(k,159)*y(k,24)*y(k,24) +rxt(k,163)*y(k,59)*y(k,25) - loss(k,1) = ( + rxt(k,44) + rxt(k,185) + het_rates(k,23))* y(k,23) - prod(k,1) =rxt(k,184)*y(k,24)*y(k,24) - loss(k,41) = ((rxt(k,190) +rxt(k,191) +rxt(k,192))* y(k,2) +rxt(k,157) & - * y(k,18) + 2._r8*(rxt(k,158) +rxt(k,159) +rxt(k,160) +rxt(k,184)) & - * y(k,24) +rxt(k,161)* y(k,43) +rxt(k,162)* y(k,50) +rxt(k,164) & - * y(k,51) +rxt(k,167)* y(k,53) + (rxt(k,168) +rxt(k,169))* y(k,69) & - + rxt(k,45) + het_rates(k,24))* y(k,24) - prod(k,41) = (rxt(k,172)*y(k,59) +rxt(k,173)*y(k,53) +rxt(k,174)*y(k,69)) & - *y(k,46) + (rxt(k,47) +rxt(k,165)*y(k,53))*y(k,25) & - + (rxt(k,155)*y(k,43) +rxt(k,156)*y(k,55))*y(k,59) & - +2.000_r8*rxt(k,185)*y(k,23) +rxt(k,183)*y(k,65)*y(k,40) +rxt(k,59) & - *y(k,56) - loss(k,30) = ((rxt(k,252) +rxt(k,257) +rxt(k,262))* y(k,40) +rxt(k,165) & - * y(k,53) +rxt(k,163)* y(k,59) +rxt(k,166)* y(k,69) + rxt(k,46) & + loss(k,38) = (rxt(k,186)* y(k,15) +rxt(k,188)* y(k,56) +rxt(k,187)* y(k,60) & + + het_rates(k,1))* y(k,1) + prod(k,38) = (rxt(k,27) +2.000_r8*rxt(k,189)*y(k,3) +rxt(k,190)*y(k,26) + & + rxt(k,191)*y(k,26) +rxt(k,194)*y(k,51) +rxt(k,197)*y(k,54) + & + rxt(k,198)*y(k,69))*y(k,3) + (rxt(k,176)*y(k,7) +rxt(k,202)*y(k,8) + & + 3.000_r8*rxt(k,203)*y(k,22) +2.000_r8*rxt(k,204)*y(k,36) + & + 2.000_r8*rxt(k,225)*y(k,14) +rxt(k,226)*y(k,16) +rxt(k,205)*y(k,38)) & + *y(k,65) + (2.000_r8*rxt(k,214)*y(k,14) +rxt(k,216)*y(k,16) + & + 3.000_r8*rxt(k,221)*y(k,22) +rxt(k,200)*y(k,38))*y(k,69) & + + (2.000_r8*rxt(k,213)*y(k,14) +rxt(k,215)*y(k,16) + & + 3.000_r8*rxt(k,220)*y(k,22))*y(k,23) + (rxt(k,51) + & + rxt(k,199)*y(k,54))*y(k,38) +rxt(k,26)*y(k,2) +rxt(k,29)*y(k,4) & + +rxt(k,57)*y(k,46) + loss(k,8) = ( + rxt(k,26) + het_rates(k,2))* y(k,2) + prod(k,8) = (rxt(k,254)*y(k,46) +rxt(k,259)*y(k,46))*y(k,42) & + +rxt(k,192)*y(k,26)*y(k,3) + loss(k,44) = (2._r8*rxt(k,189)* y(k,3) + (rxt(k,190) +rxt(k,191) +rxt(k,192)) & + * y(k,26) +rxt(k,194)* y(k,51) +rxt(k,195)* y(k,52) +rxt(k,197) & + * y(k,54) +rxt(k,193)* y(k,60) +rxt(k,198)* y(k,69) + rxt(k,27) & + + het_rates(k,3))* y(k,3) + prod(k,44) = (rxt(k,28) +rxt(k,196)*y(k,54))*y(k,4) +rxt(k,188)*y(k,56) & + *y(k,1) +rxt(k,206)*y(k,65)*y(k,38) +rxt(k,201)*y(k,54)*y(k,46) + loss(k,15) = (rxt(k,196)* y(k,54) + rxt(k,28) + rxt(k,29) + rxt(k,248) & + + rxt(k,251) + rxt(k,256) + het_rates(k,4))* y(k,4) + prod(k,15) =rxt(k,195)*y(k,52)*y(k,3) + loss(k,35) = (rxt(k,186)* y(k,1) +rxt(k,150)* y(k,23) +rxt(k,230)* y(k,53) & + +rxt(k,231)* y(k,54) +rxt(k,232)* y(k,69) + rxt(k,20) + rxt(k,21) & + + het_rates(k,15))* y(k,15) + prod(k,35) = (rxt(k,157)*y(k,26) +rxt(k,234)*y(k,51))*y(k,19) + (rxt(k,22) + & + .300_r8*rxt(k,235)*y(k,69))*y(k,20) + (rxt(k,239)*y(k,65) + & + rxt(k,240)*y(k,65))*y(k,21) + loss(k,47) = (rxt(k,157)* y(k,26) +rxt(k,234)* y(k,51) +rxt(k,233)* y(k,60) & + + het_rates(k,19))* y(k,19) + prod(k,47) = (rxt(k,151)*y(k,23) +rxt(k,207)*y(k,33) +rxt(k,236)*y(k,69) + & + rxt(k,238)*y(k,65))*y(k,21) +.700_r8*rxt(k,235)*y(k,69)*y(k,20) + loss(k,11) = (rxt(k,235)* y(k,69) + rxt(k,22) + het_rates(k,20))* y(k,20) + prod(k,11) =rxt(k,233)*y(k,60)*y(k,19) + loss(k,48) = (rxt(k,213)* y(k,14) +rxt(k,150)* y(k,15) +rxt(k,215)* y(k,16) & + +rxt(k,218)* y(k,18) +rxt(k,151)* y(k,21) +rxt(k,220)* y(k,22) & + +rxt(k,163)* y(k,27) +rxt(k,152)* y(k,35) +rxt(k,153)* y(k,37) & + +rxt(k,172)* y(k,47) +rxt(k,156)* y(k,56) + (rxt(k,154) +rxt(k,155)) & + * y(k,60) + het_rates(k,23))* y(k,23) + prod(k,48) = (4.000_r8*rxt(k,175)*y(k,6) +rxt(k,176)*y(k,7) + & + 2.000_r8*rxt(k,177)*y(k,9) +2.000_r8*rxt(k,178)*y(k,10) + & + 2.000_r8*rxt(k,179)*y(k,11) +rxt(k,180)*y(k,12) + & + 2.000_r8*rxt(k,181)*y(k,13) +rxt(k,227)*y(k,39) +rxt(k,228)*y(k,40) + & + rxt(k,229)*y(k,41) +rxt(k,182)*y(k,42) +rxt(k,212)*y(k,32))*y(k,65) & + + (rxt(k,45) +rxt(k,157)*y(k,19) +2.000_r8*rxt(k,158)*y(k,26) + & + rxt(k,160)*y(k,26) +rxt(k,162)*y(k,51) +rxt(k,167)*y(k,54) + & + rxt(k,168)*y(k,69) +rxt(k,191)*y(k,3))*y(k,26) & + + (3.000_r8*rxt(k,217)*y(k,17) +rxt(k,219)*y(k,18) + & + rxt(k,222)*y(k,39) +rxt(k,223)*y(k,40) +rxt(k,224)*y(k,41) + & + rxt(k,171)*y(k,42))*y(k,69) + (rxt(k,55) +rxt(k,170)*y(k,54))*y(k,42) & + +rxt(k,26)*y(k,2) +2.000_r8*rxt(k,43)*y(k,24) +2.000_r8*rxt(k,44) & + *y(k,25) +rxt(k,46)*y(k,27) +rxt(k,49)*y(k,32) +rxt(k,58)*y(k,47) + loss(k,6) = ( + rxt(k,43) + het_rates(k,24))* y(k,24) + prod(k,6) = (rxt(k,247)*y(k,47) +rxt(k,252)*y(k,27) +rxt(k,253)*y(k,47) + & + rxt(k,257)*y(k,27) +rxt(k,258)*y(k,47) +rxt(k,262)*y(k,27))*y(k,42) & + +rxt(k,163)*y(k,27)*y(k,23) +rxt(k,159)*y(k,26)*y(k,26) + loss(k,1) = ( + rxt(k,44) + rxt(k,185) + het_rates(k,25))* y(k,25) + prod(k,1) =rxt(k,184)*y(k,26)*y(k,26) + loss(k,43) = ((rxt(k,190) +rxt(k,191) +rxt(k,192))* y(k,3) +rxt(k,157) & + * y(k,19) + 2._r8*(rxt(k,158) +rxt(k,159) +rxt(k,160) +rxt(k,184)) & + * y(k,26) +rxt(k,162)* y(k,51) +rxt(k,164)* y(k,52) +rxt(k,167) & + * y(k,54) +rxt(k,161)* y(k,60) + (rxt(k,168) +rxt(k,169))* y(k,69) & + + rxt(k,45) + het_rates(k,26))* y(k,26) + prod(k,43) = (rxt(k,155)*y(k,60) +rxt(k,156)*y(k,56) +rxt(k,172)*y(k,47)) & + *y(k,23) + (rxt(k,47) +rxt(k,165)*y(k,54))*y(k,27) & + + (rxt(k,173)*y(k,54) +rxt(k,174)*y(k,69))*y(k,47) & + +2.000_r8*rxt(k,185)*y(k,25) +rxt(k,183)*y(k,65)*y(k,42) +rxt(k,59) & + *y(k,57) + loss(k,30) = (rxt(k,163)* y(k,23) + (rxt(k,252) +rxt(k,257) +rxt(k,262)) & + * y(k,42) +rxt(k,165)* y(k,54) +rxt(k,166)* y(k,69) + rxt(k,46) & + rxt(k,47) + rxt(k,250) + rxt(k,255) + rxt(k,261) & - + het_rates(k,25))* y(k,25) - prod(k,30) =rxt(k,164)*y(k,51)*y(k,24) - loss(k,16) = ((rxt(k,237) +rxt(k,241))* y(k,69) + het_rates(k,27))* y(k,27) - prod(k,16) = (rxt(k,20) +rxt(k,21) +rxt(k,150)*y(k,59) +rxt(k,186)*y(k,58) + & - rxt(k,230)*y(k,52) +rxt(k,231)*y(k,53) +rxt(k,232)*y(k,69))*y(k,14) & - +rxt(k,218)*y(k,59)*y(k,17) +rxt(k,278)*y(k,70)*y(k,28) - loss(k,2) = (rxt(k,211)* y(k,65) + rxt(k,48) + het_rates(k,29))* y(k,29) - prod(k,2) = (rxt(k,176)*y(k,6) +rxt(k,178)*y(k,9) + & - 2.000_r8*rxt(k,179)*y(k,10) +2.000_r8*rxt(k,180)*y(k,11) + & - rxt(k,181)*y(k,12) +rxt(k,202)*y(k,7) +2.000_r8*rxt(k,204)*y(k,34) + & - rxt(k,228)*y(k,38) +rxt(k,229)*y(k,39))*y(k,65) & - + (rxt(k,223)*y(k,38) +rxt(k,224)*y(k,39))*y(k,69) - loss(k,7) = (rxt(k,212)* y(k,65) + rxt(k,49) + het_rates(k,30))* y(k,30) - prod(k,7) = (rxt(k,177)*y(k,8) +rxt(k,178)*y(k,9) +rxt(k,227)*y(k,37)) & - *y(k,65) +rxt(k,222)*y(k,69)*y(k,37) - loss(k,21) = (rxt(k,207)* y(k,20) +rxt(k,208)* y(k,33) +rxt(k,210)* y(k,42) & - +rxt(k,209)* y(k,73) + het_rates(k,31))* y(k,31) - prod(k,21) = (rxt(k,180)*y(k,11) +rxt(k,202)*y(k,7) + & - 2.000_r8*rxt(k,211)*y(k,29) +rxt(k,212)*y(k,30))*y(k,65) & - +2.000_r8*rxt(k,48)*y(k,29) +rxt(k,49)*y(k,30) +rxt(k,56)*y(k,41) - loss(k,36) = ((rxt(k,108) +rxt(k,109) +rxt(k,110))* y(k,43) +rxt(k,111) & - * y(k,54) +rxt(k,114)* y(k,55) + het_rates(k,32))* y(k,32) - prod(k,36) = (rxt(k,89)*y(k,65) +rxt(k,106)*y(k,53) +rxt(k,115)*y(k,69) + & - rxt(k,152)*y(k,59) +rxt(k,208)*y(k,31))*y(k,33) & - + (rxt(k,118)*y(k,53) +rxt(k,138)*y(k,47) +rxt(k,232)*y(k,14) + & - rxt(k,241)*y(k,27))*y(k,69) + (rxt(k,239)*y(k,20) + & - rxt(k,183)*y(k,40) +rxt(k,206)*y(k,36))*y(k,65) & - + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,73) +2.000_r8*rxt(k,20)*y(k,14) & - +rxt(k,22)*y(k,19) +rxt(k,51)*y(k,36) +rxt(k,55)*y(k,40) +rxt(k,56) & - *y(k,41) - loss(k,49) = (rxt(k,208)* y(k,31) +rxt(k,106)* y(k,53) +rxt(k,152)* y(k,59) & - +rxt(k,89)* y(k,65) +rxt(k,115)* y(k,69) + het_rates(k,33))* y(k,33) - prod(k,49) =rxt(k,21)*y(k,14) +rxt(k,240)*y(k,65)*y(k,20) +rxt(k,108)*y(k,43) & - *y(k,32) +rxt(k,1)*y(k,73) - loss(k,17) = (rxt(k,107)* y(k,53) +rxt(k,153)* y(k,59) +rxt(k,116)* y(k,69) & - + rxt(k,4) + het_rates(k,35))* y(k,35) - prod(k,17) = (.500_r8*rxt(k,242) +rxt(k,122)*y(k,43))*y(k,43) & + + het_rates(k,27))* y(k,27) + prod(k,30) =rxt(k,164)*y(k,52)*y(k,26) + loss(k,16) = ((rxt(k,237) +rxt(k,241))* y(k,69) + het_rates(k,29))* y(k,29) + prod(k,16) = (rxt(k,20) +rxt(k,21) +rxt(k,150)*y(k,23) +rxt(k,186)*y(k,1) + & + rxt(k,230)*y(k,53) +rxt(k,231)*y(k,54) +rxt(k,232)*y(k,69))*y(k,15) & + +rxt(k,218)*y(k,23)*y(k,18) +rxt(k,278)*y(k,70)*y(k,30) + loss(k,2) = (rxt(k,211)* y(k,65) + rxt(k,48) + het_rates(k,31))* y(k,31) + prod(k,2) = (rxt(k,176)*y(k,7) +rxt(k,178)*y(k,10) + & + 2.000_r8*rxt(k,179)*y(k,11) +2.000_r8*rxt(k,180)*y(k,12) + & + rxt(k,181)*y(k,13) +rxt(k,202)*y(k,8) +2.000_r8*rxt(k,204)*y(k,36) + & + rxt(k,228)*y(k,40) +rxt(k,229)*y(k,41))*y(k,65) & + + (rxt(k,223)*y(k,40) +rxt(k,224)*y(k,41))*y(k,69) + loss(k,7) = (rxt(k,212)* y(k,65) + rxt(k,49) + het_rates(k,32))* y(k,32) + prod(k,7) = (rxt(k,177)*y(k,9) +rxt(k,178)*y(k,10) +rxt(k,227)*y(k,39)) & + *y(k,65) +rxt(k,222)*y(k,69)*y(k,39) + loss(k,21) = (rxt(k,207)* y(k,21) +rxt(k,208)* y(k,35) +rxt(k,210)* y(k,44) & + +rxt(k,209)* y(k,73) + het_rates(k,33))* y(k,33) + prod(k,21) = (rxt(k,180)*y(k,12) +rxt(k,202)*y(k,8) + & + 2.000_r8*rxt(k,211)*y(k,31) +rxt(k,212)*y(k,32))*y(k,65) & + +2.000_r8*rxt(k,48)*y(k,31) +rxt(k,49)*y(k,32) +rxt(k,56)*y(k,43) + loss(k,36) = (rxt(k,111)* y(k,55) +rxt(k,114)* y(k,56) + (rxt(k,108) + & + rxt(k,109) +rxt(k,110))* y(k,60) + het_rates(k,34))* y(k,34) + prod(k,36) = (rxt(k,89)*y(k,65) +rxt(k,106)*y(k,54) +rxt(k,115)*y(k,69) + & + rxt(k,152)*y(k,23) +rxt(k,208)*y(k,33))*y(k,35) & + + (rxt(k,118)*y(k,54) +rxt(k,138)*y(k,48) +rxt(k,232)*y(k,15) + & + rxt(k,241)*y(k,29))*y(k,69) + (rxt(k,239)*y(k,21) + & + rxt(k,183)*y(k,42) +rxt(k,206)*y(k,38))*y(k,65) & + + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,73) +2.000_r8*rxt(k,20)*y(k,15) & + +rxt(k,22)*y(k,20) +rxt(k,51)*y(k,38) +rxt(k,55)*y(k,42) +rxt(k,56) & + *y(k,43) + loss(k,39) = (rxt(k,152)* y(k,23) +rxt(k,208)* y(k,33) +rxt(k,106)* y(k,54) & + +rxt(k,89)* y(k,65) +rxt(k,115)* y(k,69) + het_rates(k,35))* y(k,35) + prod(k,39) =rxt(k,21)*y(k,15) +rxt(k,240)*y(k,65)*y(k,21) +rxt(k,108)*y(k,60) & + *y(k,34) +rxt(k,1)*y(k,73) + loss(k,17) = (rxt(k,153)* y(k,23) +rxt(k,107)* y(k,54) +rxt(k,116)* y(k,69) & + + rxt(k,4) + het_rates(k,37))* y(k,37) + prod(k,17) = (.500_r8*rxt(k,242) +rxt(k,122)*y(k,60))*y(k,60) & +rxt(k,121)*y(k,69)*y(k,69) - loss(k,23) = (rxt(k,199)* y(k,53) + (rxt(k,205) +rxt(k,206))* y(k,65) & - +rxt(k,200)* y(k,69) + rxt(k,51) + het_rates(k,36))* y(k,36) - prod(k,23) = (rxt(k,186)*y(k,14) +rxt(k,187)*y(k,43))*y(k,58) - loss(k,34) = ((rxt(k,252) +rxt(k,257) +rxt(k,262))* y(k,25) + (rxt(k,254) + & - rxt(k,259))* y(k,45) + (rxt(k,247) +rxt(k,253) +rxt(k,258))* y(k,46) & - +rxt(k,170)* y(k,53) + (rxt(k,182) +rxt(k,183))* y(k,65) +rxt(k,171) & - * y(k,69) + rxt(k,55) + het_rates(k,40))* y(k,40) - prod(k,34) = (rxt(k,151)*y(k,20) +rxt(k,213)*y(k,13) +rxt(k,215)*y(k,15) + & - 2.000_r8*rxt(k,218)*y(k,17) +rxt(k,220)*y(k,21) +rxt(k,150)*y(k,14) + & - rxt(k,152)*y(k,33) +rxt(k,153)*y(k,35) +rxt(k,154)*y(k,43) + & - rxt(k,172)*y(k,46))*y(k,59) +rxt(k,169)*y(k,69)*y(k,24) - loss(k,9) = ( + rxt(k,56) + het_rates(k,41))* y(k,41) - prod(k,9) = (rxt(k,207)*y(k,20) +rxt(k,208)*y(k,33) +rxt(k,209)*y(k,73) + & - rxt(k,210)*y(k,42))*y(k,31) - loss(k,31) = (rxt(k,210)* y(k,31) +rxt(k,147)* y(k,69) + rxt(k,9) & - + het_rates(k,42))* y(k,42) - prod(k,31) = (rxt(k,250) +rxt(k,255) +rxt(k,261) +rxt(k,252)*y(k,40) + & - rxt(k,257)*y(k,40) +rxt(k,262)*y(k,40))*y(k,25) & + loss(k,22) = (rxt(k,199)* y(k,54) + (rxt(k,205) +rxt(k,206))* y(k,65) & + +rxt(k,200)* y(k,69) + rxt(k,51) + het_rates(k,38))* y(k,38) + prod(k,22) = (rxt(k,186)*y(k,15) +rxt(k,187)*y(k,60))*y(k,1) + loss(k,34) = ((rxt(k,252) +rxt(k,257) +rxt(k,262))* y(k,27) + (rxt(k,254) + & + rxt(k,259))* y(k,46) + (rxt(k,247) +rxt(k,253) +rxt(k,258))* y(k,47) & + +rxt(k,170)* y(k,54) + (rxt(k,182) +rxt(k,183))* y(k,65) +rxt(k,171) & + * y(k,69) + rxt(k,55) + het_rates(k,42))* y(k,42) + prod(k,34) = (rxt(k,151)*y(k,21) +rxt(k,213)*y(k,14) +rxt(k,215)*y(k,16) + & + 2.000_r8*rxt(k,218)*y(k,18) +rxt(k,220)*y(k,22) +rxt(k,150)*y(k,15) + & + rxt(k,152)*y(k,35) +rxt(k,153)*y(k,37) +rxt(k,154)*y(k,60) + & + rxt(k,172)*y(k,47))*y(k,23) +rxt(k,169)*y(k,69)*y(k,26) + loss(k,9) = ( + rxt(k,56) + het_rates(k,43))* y(k,43) + prod(k,9) = (rxt(k,207)*y(k,21) +rxt(k,208)*y(k,35) +rxt(k,209)*y(k,73) + & + rxt(k,210)*y(k,44))*y(k,33) + loss(k,31) = (rxt(k,210)* y(k,33) +rxt(k,147)* y(k,69) + rxt(k,9) & + + het_rates(k,44))* y(k,44) + prod(k,31) = (rxt(k,250) +rxt(k,255) +rxt(k,261) +rxt(k,252)*y(k,42) + & + rxt(k,257)*y(k,42) +rxt(k,262)*y(k,42))*y(k,27) & + (2.000_r8*rxt(k,243) +2.000_r8*rxt(k,246) +2.000_r8*rxt(k,249) + & - 2.000_r8*rxt(k,260))*y(k,49) + (rxt(k,248) +rxt(k,251) +rxt(k,256)) & - *y(k,3) + (.500_r8*rxt(k,244) +rxt(k,146)*y(k,69))*y(k,51) & - + (rxt(k,245) +rxt(k,230)*y(k,14))*y(k,52) - loss(k,47) = (rxt(k,193)* y(k,2) +rxt(k,233)* y(k,18) +rxt(k,161)* y(k,24) & - + (rxt(k,108) +rxt(k,109) +rxt(k,110))* y(k,32) + 2._r8*rxt(k,122) & - * y(k,43) +rxt(k,139)* y(k,50) +rxt(k,144)* y(k,51) +rxt(k,134) & - * y(k,52) +rxt(k,112)* y(k,53) +rxt(k,113)* y(k,55) +rxt(k,187) & - * y(k,58) + (rxt(k,154) +rxt(k,155))* y(k,59) +rxt(k,117)* y(k,69) & - + rxt(k,242) + het_rates(k,43))* y(k,43) - prod(k,47) = (rxt(k,216)*y(k,15) +rxt(k,219)*y(k,17) +rxt(k,116)*y(k,35) + & - rxt(k,119)*y(k,55) +rxt(k,137)*y(k,52) +rxt(k,168)*y(k,24) + & - rxt(k,198)*y(k,2) +rxt(k,237)*y(k,27))*y(k,69) & - + (rxt(k,150)*y(k,59) +rxt(k,186)*y(k,58) +rxt(k,230)*y(k,52) + & - rxt(k,231)*y(k,53))*y(k,14) + (rxt(k,215)*y(k,15) + & - rxt(k,218)*y(k,17) +rxt(k,153)*y(k,35))*y(k,59) & - + (rxt(k,157)*y(k,24) +rxt(k,234)*y(k,50))*y(k,18) + (rxt(k,11) + & - rxt(k,148))*y(k,44) +rxt(k,239)*y(k,65)*y(k,20) +rxt(k,111)*y(k,54) & - *y(k,32) +rxt(k,107)*y(k,53)*y(k,35) + 2.000_r8*rxt(k,260))*y(k,50) + (rxt(k,248) +rxt(k,251) +rxt(k,256)) & + *y(k,4) + (.500_r8*rxt(k,244) +rxt(k,146)*y(k,69))*y(k,52) & + + (rxt(k,245) +rxt(k,230)*y(k,15))*y(k,53) loss(k,12) = (rxt(k,123)* y(k,69) + rxt(k,10) + rxt(k,11) + rxt(k,148) & - + het_rates(k,44))* y(k,44) - prod(k,12) =rxt(k,144)*y(k,51)*y(k,43) - loss(k,20) = ((rxt(k,254) +rxt(k,259))* y(k,40) +rxt(k,201)* y(k,53) & - + rxt(k,57) + het_rates(k,45))* y(k,45) - prod(k,20) = (rxt(k,248) +rxt(k,251) +rxt(k,256))*y(k,3) +rxt(k,193)*y(k,43) & - *y(k,2) - loss(k,22) = ((rxt(k,247) +rxt(k,253) +rxt(k,258))* y(k,40) +rxt(k,173) & - * y(k,53) +rxt(k,172)* y(k,59) +rxt(k,174)* y(k,69) + rxt(k,58) & - + het_rates(k,46))* y(k,46) - prod(k,22) = (rxt(k,250) +rxt(k,255) +rxt(k,261) +rxt(k,166)*y(k,69))*y(k,25) & - +rxt(k,161)*y(k,43)*y(k,24) - loss(k,29) = (rxt(k,126)* y(k,50) + (rxt(k,127) +rxt(k,128) +rxt(k,129)) & - * y(k,51) +rxt(k,130)* y(k,54) +rxt(k,275)* y(k,68) +rxt(k,138) & - * y(k,69) + rxt(k,62) + het_rates(k,47))* y(k,47) - prod(k,29) = (rxt(k,124)*y(k,61) +rxt(k,272)*y(k,64))*y(k,53) & - + (.200_r8*rxt(k,266)*y(k,63) +1.100_r8*rxt(k,268)*y(k,62))*y(k,60) & - +rxt(k,15)*y(k,50) +rxt(k,273)*y(k,64)*y(k,54) +rxt(k,279)*y(k,70) + + het_rates(k,45))* y(k,45) + prod(k,12) =rxt(k,144)*y(k,60)*y(k,52) + loss(k,20) = ((rxt(k,254) +rxt(k,259))* y(k,42) +rxt(k,201)* y(k,54) & + + rxt(k,57) + het_rates(k,46))* y(k,46) + prod(k,20) = (rxt(k,248) +rxt(k,251) +rxt(k,256))*y(k,4) +rxt(k,193)*y(k,60) & + *y(k,3) + loss(k,23) = (rxt(k,172)* y(k,23) + (rxt(k,247) +rxt(k,253) +rxt(k,258)) & + * y(k,42) +rxt(k,173)* y(k,54) +rxt(k,174)* y(k,69) + rxt(k,58) & + + het_rates(k,47))* y(k,47) + prod(k,23) = (rxt(k,250) +rxt(k,255) +rxt(k,261) +rxt(k,166)*y(k,69))*y(k,27) & + +rxt(k,161)*y(k,60)*y(k,26) + loss(k,29) = (rxt(k,126)* y(k,51) + (rxt(k,127) +rxt(k,128) +rxt(k,129)) & + * y(k,52) +rxt(k,130)* y(k,55) +rxt(k,275)* y(k,68) +rxt(k,138) & + * y(k,69) + rxt(k,62) + het_rates(k,48))* y(k,48) + prod(k,29) = (rxt(k,124)*y(k,61) +rxt(k,272)*y(k,64))*y(k,54) & + + (.200_r8*rxt(k,266)*y(k,63) +1.100_r8*rxt(k,268)*y(k,62))*y(k,59) & + +rxt(k,15)*y(k,51) +rxt(k,273)*y(k,64)*y(k,55) +rxt(k,279)*y(k,70) loss(k,10) = ( + rxt(k,13) + rxt(k,14) + rxt(k,149) + rxt(k,243) + rxt(k,246) & - + rxt(k,249) + rxt(k,260) + het_rates(k,49))* y(k,49) - prod(k,10) =rxt(k,145)*y(k,52)*y(k,51) - loss(k,38) = (rxt(k,194)* y(k,2) +rxt(k,234)* y(k,18) +rxt(k,162)* y(k,24) & - +rxt(k,139)* y(k,43) +rxt(k,126)* y(k,47) +rxt(k,135)* y(k,52) & - +rxt(k,141)* y(k,53) +rxt(k,140)* y(k,55) +rxt(k,277)* y(k,68) & - + rxt(k,15) + rxt(k,16) + het_rates(k,50))* y(k,50) - prod(k,38) = (rxt(k,17) +.500_r8*rxt(k,244) +2.000_r8*rxt(k,128)*y(k,47) + & - rxt(k,131)*y(k,53))*y(k,51) + (rxt(k,130)*y(k,54) + & - rxt(k,138)*y(k,69))*y(k,47) +2.000_r8*rxt(k,142)*y(k,65)*y(k,48) & - +rxt(k,14)*y(k,49) +rxt(k,19)*y(k,52) +rxt(k,125)*y(k,61)*y(k,54) & + + rxt(k,249) + rxt(k,260) + het_rates(k,50))* y(k,50) + prod(k,10) =rxt(k,145)*y(k,53)*y(k,52) + loss(k,40) = (rxt(k,194)* y(k,3) +rxt(k,234)* y(k,19) +rxt(k,162)* y(k,26) & + +rxt(k,126)* y(k,48) +rxt(k,135)* y(k,53) +rxt(k,141)* y(k,54) & + +rxt(k,140)* y(k,56) +rxt(k,139)* y(k,60) +rxt(k,277)* y(k,68) & + + rxt(k,15) + rxt(k,16) + het_rates(k,51))* y(k,51) + prod(k,40) = (rxt(k,17) +.500_r8*rxt(k,244) +2.000_r8*rxt(k,128)*y(k,48) + & + rxt(k,131)*y(k,54))*y(k,52) + (rxt(k,130)*y(k,55) + & + rxt(k,138)*y(k,69))*y(k,48) +2.000_r8*rxt(k,142)*y(k,65)*y(k,49) & + +rxt(k,14)*y(k,50) +rxt(k,19)*y(k,53) +rxt(k,125)*y(k,61)*y(k,55) & +rxt(k,276)*y(k,68) +rxt(k,289)*y(k,72) - loss(k,45) = (rxt(k,195)* y(k,2) +rxt(k,164)* y(k,24) +rxt(k,144)* y(k,43) & - + (rxt(k,127) +rxt(k,128) +rxt(k,129))* y(k,47) +rxt(k,145)* y(k,52) & - + (rxt(k,131) +rxt(k,133))* y(k,53) +rxt(k,132)* y(k,55) +rxt(k,146) & - * y(k,69) + rxt(k,17) + rxt(k,244) + het_rates(k,51))* y(k,51) - prod(k,45) = (2.000_r8*rxt(k,135)*y(k,52) +rxt(k,139)*y(k,43) + & - rxt(k,140)*y(k,55) +rxt(k,141)*y(k,53) +rxt(k,162)*y(k,24) + & - rxt(k,194)*y(k,2) +rxt(k,234)*y(k,18))*y(k,50) + (rxt(k,18) + & - rxt(k,134)*y(k,43) +rxt(k,136)*y(k,53) +rxt(k,137)*y(k,69))*y(k,52) & - + (rxt(k,11) +rxt(k,148) +rxt(k,123)*y(k,69))*y(k,44) + (rxt(k,13) + & - rxt(k,149))*y(k,49) +rxt(k,28)*y(k,3) +rxt(k,47)*y(k,25) +rxt(k,9) & - *y(k,42) - loss(k,37) = (rxt(k,230)* y(k,14) +rxt(k,134)* y(k,43) +rxt(k,135)* y(k,50) & - +rxt(k,145)* y(k,51) +rxt(k,136)* y(k,53) +rxt(k,137)* y(k,69) & - + rxt(k,18) + rxt(k,19) + rxt(k,245) + het_rates(k,52))* y(k,52) - prod(k,37) = (rxt(k,46) +rxt(k,163)*y(k,59) +rxt(k,165)*y(k,53) + & - rxt(k,166)*y(k,69))*y(k,25) + (rxt(k,13) +rxt(k,14) +rxt(k,149)) & - *y(k,49) + (rxt(k,29) +rxt(k,196)*y(k,53))*y(k,3) & - + (rxt(k,147)*y(k,69) +rxt(k,210)*y(k,31))*y(k,42) & - + (rxt(k,132)*y(k,55) +rxt(k,133)*y(k,53))*y(k,51) +rxt(k,10) & + loss(k,41) = (rxt(k,195)* y(k,3) +rxt(k,164)* y(k,26) + (rxt(k,127) + & + rxt(k,128) +rxt(k,129))* y(k,48) +rxt(k,145)* y(k,53) + (rxt(k,131) + & + rxt(k,133))* y(k,54) +rxt(k,132)* y(k,56) +rxt(k,144)* y(k,60) & + +rxt(k,146)* y(k,69) + rxt(k,17) + rxt(k,244) + het_rates(k,52)) & + * y(k,52) + prod(k,41) = (2.000_r8*rxt(k,135)*y(k,53) +rxt(k,139)*y(k,60) + & + rxt(k,140)*y(k,56) +rxt(k,141)*y(k,54) +rxt(k,162)*y(k,26) + & + rxt(k,194)*y(k,3) +rxt(k,234)*y(k,19))*y(k,51) + (rxt(k,18) + & + rxt(k,134)*y(k,60) +rxt(k,136)*y(k,54) +rxt(k,137)*y(k,69))*y(k,53) & + + (rxt(k,11) +rxt(k,148) +rxt(k,123)*y(k,69))*y(k,45) + (rxt(k,13) + & + rxt(k,149))*y(k,50) +rxt(k,28)*y(k,4) +rxt(k,47)*y(k,27) +rxt(k,9) & *y(k,44) - loss(k,48) = (rxt(k,197)* y(k,2) +rxt(k,196)* y(k,3) +rxt(k,231)* y(k,14) & - +rxt(k,167)* y(k,24) +rxt(k,165)* y(k,25) +rxt(k,106)* y(k,33) & - +rxt(k,107)* y(k,35) +rxt(k,199)* y(k,36) +rxt(k,170)* y(k,40) & - +rxt(k,112)* y(k,43) +rxt(k,201)* y(k,45) +rxt(k,173)* y(k,46) & - +rxt(k,141)* y(k,50) + (rxt(k,131) +rxt(k,133))* y(k,51) +rxt(k,136) & - * y(k,52) + 2._r8*rxt(k,104)* y(k,53) +rxt(k,105)* y(k,54) & - +rxt(k,103)* y(k,55) + (rxt(k,270) +rxt(k,271))* y(k,62) +rxt(k,272) & - * y(k,64) +rxt(k,118)* y(k,69) + rxt(k,71) + rxt(k,72) + rxt(k,73) & - + rxt(k,74) + rxt(k,75) + rxt(k,76) + het_rates(k,53))* y(k,53) - prod(k,48) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,77) +rxt(k,79) +rxt(k,81) + & + loss(k,45) = (rxt(k,230)* y(k,15) +rxt(k,135)* y(k,51) +rxt(k,145)* y(k,52) & + +rxt(k,136)* y(k,54) +rxt(k,134)* y(k,60) +rxt(k,137)* y(k,69) & + + rxt(k,18) + rxt(k,19) + rxt(k,245) + het_rates(k,53))* y(k,53) + prod(k,45) = (rxt(k,46) +rxt(k,163)*y(k,23) +rxt(k,165)*y(k,54) + & + rxt(k,166)*y(k,69))*y(k,27) + (rxt(k,13) +rxt(k,14) +rxt(k,149)) & + *y(k,50) + (rxt(k,29) +rxt(k,196)*y(k,54))*y(k,4) & + + (rxt(k,147)*y(k,69) +rxt(k,210)*y(k,33))*y(k,44) & + + (rxt(k,132)*y(k,56) +rxt(k,133)*y(k,54))*y(k,52) +rxt(k,10) & + *y(k,45) + loss(k,50) = (rxt(k,197)* y(k,3) +rxt(k,196)* y(k,4) +rxt(k,231)* y(k,15) & + +rxt(k,167)* y(k,26) +rxt(k,165)* y(k,27) +rxt(k,106)* y(k,35) & + +rxt(k,107)* y(k,37) +rxt(k,199)* y(k,38) +rxt(k,170)* y(k,42) & + +rxt(k,201)* y(k,46) +rxt(k,173)* y(k,47) +rxt(k,141)* y(k,51) & + + (rxt(k,131) +rxt(k,133))* y(k,52) +rxt(k,136)* y(k,53) & + + 2._r8*rxt(k,104)* y(k,54) +rxt(k,105)* y(k,55) +rxt(k,103) & + * y(k,56) +rxt(k,112)* y(k,60) + (rxt(k,270) +rxt(k,271))* y(k,62) & + +rxt(k,272)* y(k,64) +rxt(k,118)* y(k,69) + rxt(k,71) + rxt(k,72) & + + rxt(k,73) + rxt(k,74) + rxt(k,75) + rxt(k,76) + het_rates(k,54)) & + * y(k,54) + prod(k,50) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,77) +rxt(k,79) +rxt(k,81) + & 2.000_r8*rxt(k,82) +2.000_r8*rxt(k,83) +rxt(k,84) +rxt(k,85) + & - rxt(k,86) +rxt(k,92)*y(k,65) +rxt(k,93)*y(k,65) +rxt(k,130)*y(k,47) + & - rxt(k,274)*y(k,64) +rxt(k,281)*y(k,70) +rxt(k,285)*y(k,71))*y(k,54) & - + (rxt(k,126)*y(k,50) +rxt(k,127)*y(k,51) +rxt(k,275)*y(k,68)) & - *y(k,47) + (rxt(k,266)*y(k,63) +1.150_r8*rxt(k,267)*y(k,68))*y(k,60) & - +rxt(k,27)*y(k,2) +rxt(k,45)*y(k,24) +rxt(k,110)*y(k,43)*y(k,32) & - +rxt(k,14)*y(k,49) +rxt(k,15)*y(k,50) +rxt(k,17)*y(k,51) +rxt(k,18) & - *y(k,52) +rxt(k,8)*y(k,55) +rxt(k,59)*y(k,56) +rxt(k,280)*y(k,70) & + rxt(k,86) +rxt(k,92)*y(k,65) +rxt(k,93)*y(k,65) +rxt(k,130)*y(k,48) + & + rxt(k,274)*y(k,64) +rxt(k,281)*y(k,70) +rxt(k,285)*y(k,71))*y(k,55) & + + (rxt(k,126)*y(k,51) +rxt(k,127)*y(k,52) +rxt(k,275)*y(k,68)) & + *y(k,48) + (rxt(k,266)*y(k,63) +1.150_r8*rxt(k,267)*y(k,68))*y(k,59) & + +rxt(k,27)*y(k,3) +rxt(k,45)*y(k,26) +rxt(k,110)*y(k,60)*y(k,34) & + +rxt(k,14)*y(k,50) +rxt(k,15)*y(k,51) +rxt(k,17)*y(k,52) +rxt(k,18) & + *y(k,53) +rxt(k,8)*y(k,56) +rxt(k,59)*y(k,57) +rxt(k,280)*y(k,70) & *y(k,61) +rxt(k,91)*y(k,65) +rxt(k,120)*y(k,69)*y(k,69) +rxt(k,283) & *y(k,71) +rxt(k,288)*y(k,72) +rxt(k,2)*y(k,73) - loss(k,32) = (rxt(k,111)* y(k,32) +rxt(k,130)* y(k,47) +rxt(k,105)* y(k,53) & + loss(k,32) = (rxt(k,111)* y(k,34) +rxt(k,130)* y(k,48) +rxt(k,105)* y(k,54) & +rxt(k,125)* y(k,61) +rxt(k,269)* y(k,62) + (rxt(k,273) +rxt(k,274)) & * y(k,64) +rxt(k,92)* y(k,65) +rxt(k,97)* y(k,66) +rxt(k,281) & * y(k,70) +rxt(k,285)* y(k,71) + rxt(k,5) + rxt(k,6) + rxt(k,77) & + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) + rxt(k,82) & - + rxt(k,83) + rxt(k,84) + rxt(k,85) + rxt(k,86) + het_rates(k,54)) & - * y(k,54) - prod(k,32) = (rxt(k,108)*y(k,32) +rxt(k,112)*y(k,53) + & - 2.000_r8*rxt(k,113)*y(k,55) +rxt(k,117)*y(k,69) +rxt(k,122)*y(k,43) + & - rxt(k,134)*y(k,52) +rxt(k,154)*y(k,59) +rxt(k,161)*y(k,24) + & - rxt(k,187)*y(k,58) +rxt(k,193)*y(k,2) +rxt(k,233)*y(k,18))*y(k,43) & + + rxt(k,83) + rxt(k,84) + rxt(k,85) + rxt(k,86) + het_rates(k,55)) & + * y(k,55) + prod(k,32) = (rxt(k,108)*y(k,34) +rxt(k,112)*y(k,54) + & + 2.000_r8*rxt(k,113)*y(k,56) +rxt(k,117)*y(k,69) +rxt(k,122)*y(k,60) + & + rxt(k,134)*y(k,53) +rxt(k,154)*y(k,23) +rxt(k,161)*y(k,26) + & + rxt(k,187)*y(k,1) +rxt(k,193)*y(k,3) +rxt(k,233)*y(k,19))*y(k,60) & + (rxt(k,8) +2.000_r8*rxt(k,94)*y(k,65) + & - 2.000_r8*rxt(k,103)*y(k,53) +rxt(k,114)*y(k,32) +rxt(k,119)*y(k,69) + & - rxt(k,132)*y(k,51) +rxt(k,140)*y(k,50) +rxt(k,156)*y(k,59) + & - rxt(k,188)*y(k,58))*y(k,55) + (rxt(k,96)*y(k,66) + & - rxt(k,104)*y(k,53) +rxt(k,118)*y(k,69) +rxt(k,131)*y(k,51) + & - rxt(k,136)*y(k,52) +rxt(k,167)*y(k,24) +rxt(k,197)*y(k,2))*y(k,53) & - + (rxt(k,158)*y(k,24) +rxt(k,159)*y(k,24) +rxt(k,169)*y(k,69) + & - rxt(k,191)*y(k,2) +rxt(k,192)*y(k,2))*y(k,24) + (rxt(k,87) + & - rxt(k,95) +2.000_r8*rxt(k,97)*y(k,54))*y(k,66) +rxt(k,189)*y(k,2) & - *y(k,2) +rxt(k,123)*y(k,69)*y(k,44) +rxt(k,129)*y(k,51)*y(k,47) & - +rxt(k,143)*y(k,65)*y(k,48) +rxt(k,277)*y(k,68)*y(k,50) +rxt(k,19) & - *y(k,52) +rxt(k,88)*y(k,67) - loss(k,50) = (rxt(k,114)* y(k,32) +rxt(k,113)* y(k,43) +rxt(k,140)* y(k,50) & - +rxt(k,132)* y(k,51) +rxt(k,103)* y(k,53) +rxt(k,188)* y(k,58) & - +rxt(k,156)* y(k,59) +rxt(k,94)* y(k,65) +rxt(k,119)* y(k,69) & - + rxt(k,7) + rxt(k,8) + het_rates(k,55))* y(k,55) - prod(k,50) =rxt(k,105)*y(k,54)*y(k,53) - loss(k,3) = ( + rxt(k,59) + het_rates(k,56))* y(k,56) - prod(k,3) = (rxt(k,160)*y(k,24) +rxt(k,190)*y(k,2))*y(k,24) - loss(k,43) = (rxt(k,186)* y(k,14) +rxt(k,187)* y(k,43) +rxt(k,188)* y(k,55) & - + het_rates(k,58))* y(k,58) - prod(k,43) = (rxt(k,27) +2.000_r8*rxt(k,189)*y(k,2) +rxt(k,190)*y(k,24) + & - rxt(k,191)*y(k,24) +rxt(k,194)*y(k,50) +rxt(k,197)*y(k,53) + & - rxt(k,198)*y(k,69))*y(k,2) + (rxt(k,176)*y(k,6) +rxt(k,202)*y(k,7) + & - 3.000_r8*rxt(k,203)*y(k,21) +2.000_r8*rxt(k,204)*y(k,34) + & - 2.000_r8*rxt(k,225)*y(k,13) +rxt(k,226)*y(k,15) +rxt(k,205)*y(k,36)) & - *y(k,65) + (2.000_r8*rxt(k,214)*y(k,13) +rxt(k,216)*y(k,15) + & - 3.000_r8*rxt(k,221)*y(k,21) +rxt(k,200)*y(k,36))*y(k,69) & - + (2.000_r8*rxt(k,213)*y(k,13) +rxt(k,215)*y(k,15) + & - 3.000_r8*rxt(k,220)*y(k,21))*y(k,59) + (rxt(k,51) + & - rxt(k,199)*y(k,53))*y(k,36) +rxt(k,26)*y(k,1) +rxt(k,29)*y(k,3) & - +rxt(k,57)*y(k,45) - loss(k,40) = (rxt(k,213)* y(k,13) +rxt(k,150)* y(k,14) +rxt(k,215)* y(k,15) & - +rxt(k,218)* y(k,17) +rxt(k,151)* y(k,20) +rxt(k,220)* y(k,21) & - +rxt(k,163)* y(k,25) +rxt(k,152)* y(k,33) +rxt(k,153)* y(k,35) & - + (rxt(k,154) +rxt(k,155))* y(k,43) +rxt(k,172)* y(k,46) +rxt(k,156) & - * y(k,55) + het_rates(k,59))* y(k,59) - prod(k,40) = (4.000_r8*rxt(k,175)*y(k,5) +rxt(k,176)*y(k,6) + & - 2.000_r8*rxt(k,177)*y(k,8) +2.000_r8*rxt(k,178)*y(k,9) + & - 2.000_r8*rxt(k,179)*y(k,10) +rxt(k,180)*y(k,11) + & - 2.000_r8*rxt(k,181)*y(k,12) +rxt(k,227)*y(k,37) +rxt(k,228)*y(k,38) + & - rxt(k,229)*y(k,39) +rxt(k,182)*y(k,40) +rxt(k,212)*y(k,30))*y(k,65) & - + (rxt(k,45) +rxt(k,157)*y(k,18) +2.000_r8*rxt(k,158)*y(k,24) + & - rxt(k,160)*y(k,24) +rxt(k,162)*y(k,50) +rxt(k,167)*y(k,53) + & - rxt(k,168)*y(k,69) +rxt(k,191)*y(k,2))*y(k,24) & - + (3.000_r8*rxt(k,217)*y(k,16) +rxt(k,219)*y(k,17) + & - rxt(k,222)*y(k,37) +rxt(k,223)*y(k,38) +rxt(k,224)*y(k,39) + & - rxt(k,171)*y(k,40))*y(k,69) + (rxt(k,55) +rxt(k,170)*y(k,53))*y(k,40) & - +rxt(k,26)*y(k,1) +2.000_r8*rxt(k,43)*y(k,22) +2.000_r8*rxt(k,44) & - *y(k,23) +rxt(k,46)*y(k,25) +rxt(k,49)*y(k,30) +rxt(k,58)*y(k,46) + 2.000_r8*rxt(k,103)*y(k,54) +rxt(k,114)*y(k,34) +rxt(k,119)*y(k,69) + & + rxt(k,132)*y(k,52) +rxt(k,140)*y(k,51) +rxt(k,156)*y(k,23) + & + rxt(k,188)*y(k,1))*y(k,56) + (rxt(k,96)*y(k,66) +rxt(k,104)*y(k,54) + & + rxt(k,118)*y(k,69) +rxt(k,131)*y(k,52) +rxt(k,136)*y(k,53) + & + rxt(k,167)*y(k,26) +rxt(k,197)*y(k,3))*y(k,54) & + + (rxt(k,158)*y(k,26) +rxt(k,159)*y(k,26) +rxt(k,169)*y(k,69) + & + rxt(k,191)*y(k,3) +rxt(k,192)*y(k,3))*y(k,26) + (rxt(k,87) + & + rxt(k,95) +2.000_r8*rxt(k,97)*y(k,55))*y(k,66) +rxt(k,189)*y(k,3) & + *y(k,3) +rxt(k,123)*y(k,69)*y(k,45) +rxt(k,129)*y(k,52)*y(k,48) & + +rxt(k,143)*y(k,65)*y(k,49) +rxt(k,277)*y(k,68)*y(k,51) +rxt(k,19) & + *y(k,53) +rxt(k,88)*y(k,67) + loss(k,49) = (rxt(k,188)* y(k,1) +rxt(k,156)* y(k,23) +rxt(k,114)* y(k,34) & + +rxt(k,140)* y(k,51) +rxt(k,132)* y(k,52) +rxt(k,103)* y(k,54) & + +rxt(k,113)* y(k,60) +rxt(k,94)* y(k,65) +rxt(k,119)* y(k,69) & + + rxt(k,7) + rxt(k,8) + het_rates(k,56))* y(k,56) + prod(k,49) =rxt(k,105)*y(k,55)*y(k,54) + loss(k,3) = ( + rxt(k,59) + het_rates(k,57))* y(k,57) + prod(k,3) = (rxt(k,160)*y(k,26) +rxt(k,190)*y(k,3))*y(k,26) loss(k,27) = (rxt(k,268)* y(k,62) +rxt(k,266)* y(k,63) +rxt(k,267)* y(k,68) & - + het_rates(k,60))* y(k,60) + + het_rates(k,59))* y(k,59) prod(k,27) = (rxt(k,77) +rxt(k,78) +rxt(k,79) +rxt(k,80) +rxt(k,81) + & - rxt(k,84) +rxt(k,85) +rxt(k,86))*y(k,54) + (rxt(k,71) +rxt(k,72) + & - rxt(k,73) +rxt(k,74) +rxt(k,75) +rxt(k,76))*y(k,53) +rxt(k,62) & - *y(k,47) +rxt(k,16)*y(k,50) - loss(k,28) = (rxt(k,124)* y(k,53) +rxt(k,125)* y(k,54) +rxt(k,280)* y(k,70) & + rxt(k,84) +rxt(k,85) +rxt(k,86))*y(k,55) + (rxt(k,71) +rxt(k,72) + & + rxt(k,73) +rxt(k,74) +rxt(k,75) +rxt(k,76))*y(k,54) +rxt(k,62) & + *y(k,48) +rxt(k,16)*y(k,51) + loss(k,37) = (rxt(k,187)* y(k,1) +rxt(k,193)* y(k,3) +rxt(k,233)* y(k,19) & + + (rxt(k,154) +rxt(k,155))* y(k,23) +rxt(k,161)* y(k,26) & + + (rxt(k,108) +rxt(k,109) +rxt(k,110))* y(k,34) +rxt(k,139)* y(k,51) & + +rxt(k,144)* y(k,52) +rxt(k,134)* y(k,53) +rxt(k,112)* y(k,54) & + +rxt(k,113)* y(k,56) + 2._r8*rxt(k,122)* y(k,60) +rxt(k,117) & + * y(k,69) + rxt(k,242) + het_rates(k,60))* y(k,60) + prod(k,37) = (rxt(k,216)*y(k,16) +rxt(k,219)*y(k,18) +rxt(k,116)*y(k,37) + & + rxt(k,119)*y(k,56) +rxt(k,137)*y(k,53) +rxt(k,168)*y(k,26) + & + rxt(k,198)*y(k,3) +rxt(k,237)*y(k,29))*y(k,69) & + + (rxt(k,150)*y(k,23) +rxt(k,186)*y(k,1) +rxt(k,230)*y(k,53) + & + rxt(k,231)*y(k,54))*y(k,15) + (rxt(k,215)*y(k,16) + & + rxt(k,218)*y(k,18) +rxt(k,153)*y(k,37))*y(k,23) & + + (rxt(k,157)*y(k,26) +rxt(k,234)*y(k,51))*y(k,19) + (rxt(k,11) + & + rxt(k,148))*y(k,45) +rxt(k,239)*y(k,65)*y(k,21) +rxt(k,111)*y(k,55) & + *y(k,34) +rxt(k,107)*y(k,54)*y(k,37) + loss(k,28) = (rxt(k,124)* y(k,54) +rxt(k,125)* y(k,55) +rxt(k,280)* y(k,70) & + het_rates(k,61))* y(k,61) - prod(k,28) = (.800_r8*rxt(k,266)*y(k,63) +.900_r8*rxt(k,268)*y(k,62))*y(k,60) & - +rxt(k,270)*y(k,62)*y(k,53) - loss(k,18) = ((rxt(k,270) +rxt(k,271))* y(k,53) +rxt(k,269)* y(k,54) & - +rxt(k,268)* y(k,60) + het_rates(k,62))* y(k,62) + prod(k,28) = (.800_r8*rxt(k,266)*y(k,63) +.900_r8*rxt(k,268)*y(k,62))*y(k,59) & + +rxt(k,270)*y(k,62)*y(k,54) + loss(k,18) = ((rxt(k,270) +rxt(k,271))* y(k,54) +rxt(k,269)* y(k,55) & + +rxt(k,268)* y(k,59) + het_rates(k,62))* y(k,62) prod(k,18) =rxt(k,283)*y(k,71) +rxt(k,288)*y(k,72) - loss(k,19) = (rxt(k,266)* y(k,60) + het_rates(k,63))* y(k,63) - prod(k,19) = (rxt(k,276) +rxt(k,275)*y(k,47) +rxt(k,277)*y(k,50))*y(k,68) & - +rxt(k,16)*y(k,50) +rxt(k,270)*y(k,62)*y(k,53) +rxt(k,274)*y(k,64) & - *y(k,54) +rxt(k,279)*y(k,70) - loss(k,24) = (rxt(k,272)* y(k,53) + (rxt(k,273) +rxt(k,274))* y(k,54) & + loss(k,19) = (rxt(k,266)* y(k,59) + het_rates(k,63))* y(k,63) + prod(k,19) = (rxt(k,276) +rxt(k,275)*y(k,48) +rxt(k,277)*y(k,51))*y(k,68) & + +rxt(k,16)*y(k,51) +rxt(k,270)*y(k,62)*y(k,54) +rxt(k,274)*y(k,64) & + *y(k,55) +rxt(k,279)*y(k,70) + loss(k,24) = (rxt(k,272)* y(k,54) + (rxt(k,273) +rxt(k,274))* y(k,55) & + het_rates(k,64))* y(k,64) - prod(k,24) =rxt(k,62)*y(k,47) +rxt(k,280)*y(k,70)*y(k,61) +rxt(k,289)*y(k,72) - loss(k,42) = (rxt(k,175)* y(k,5) +rxt(k,176)* y(k,6) +rxt(k,202)* y(k,7) & - +rxt(k,177)* y(k,8) +rxt(k,178)* y(k,9) +rxt(k,179)* y(k,10) & - +rxt(k,180)* y(k,11) +rxt(k,181)* y(k,12) +rxt(k,225)* y(k,13) & - +rxt(k,226)* y(k,15) + (rxt(k,238) +rxt(k,239) +rxt(k,240))* y(k,20) & - +rxt(k,203)* y(k,21) +rxt(k,211)* y(k,29) +rxt(k,212)* y(k,30) & - +rxt(k,89)* y(k,33) +rxt(k,204)* y(k,34) + (rxt(k,205) +rxt(k,206)) & - * y(k,36) +rxt(k,227)* y(k,37) +rxt(k,228)* y(k,38) +rxt(k,229) & - * y(k,39) + (rxt(k,182) +rxt(k,183))* y(k,40) + (rxt(k,142) + & - rxt(k,143))* y(k,48) + (rxt(k,92) +rxt(k,93))* y(k,54) +rxt(k,94) & - * y(k,55) +rxt(k,90)* y(k,73) + rxt(k,91) + het_rates(k,65))* y(k,65) - prod(k,42) = (rxt(k,6) +rxt(k,125)*y(k,61))*y(k,54) +rxt(k,7)*y(k,55) & - +.850_r8*rxt(k,267)*y(k,68)*y(k,60) +rxt(k,1)*y(k,73) - loss(k,4) = (rxt(k,96)* y(k,53) +rxt(k,97)* y(k,54) + rxt(k,87) + rxt(k,95) & + prod(k,24) =rxt(k,62)*y(k,48) +rxt(k,280)*y(k,70)*y(k,61) +rxt(k,289)*y(k,72) + loss(k,42) = (rxt(k,175)* y(k,6) +rxt(k,176)* y(k,7) +rxt(k,202)* y(k,8) & + +rxt(k,177)* y(k,9) +rxt(k,178)* y(k,10) +rxt(k,179)* y(k,11) & + +rxt(k,180)* y(k,12) +rxt(k,181)* y(k,13) +rxt(k,225)* y(k,14) & + +rxt(k,226)* y(k,16) + (rxt(k,238) +rxt(k,239) +rxt(k,240))* y(k,21) & + +rxt(k,203)* y(k,22) +rxt(k,211)* y(k,31) +rxt(k,212)* y(k,32) & + +rxt(k,89)* y(k,35) +rxt(k,204)* y(k,36) + (rxt(k,205) +rxt(k,206)) & + * y(k,38) +rxt(k,227)* y(k,39) +rxt(k,228)* y(k,40) +rxt(k,229) & + * y(k,41) + (rxt(k,182) +rxt(k,183))* y(k,42) + (rxt(k,142) + & + rxt(k,143))* y(k,49) + (rxt(k,92) +rxt(k,93))* y(k,55) +rxt(k,94) & + * y(k,56) +rxt(k,90)* y(k,73) + rxt(k,91) + het_rates(k,65))* y(k,65) + prod(k,42) = (rxt(k,6) +rxt(k,125)*y(k,61))*y(k,55) +rxt(k,7)*y(k,56) & + +.850_r8*rxt(k,267)*y(k,68)*y(k,59) +rxt(k,1)*y(k,73) + loss(k,4) = (rxt(k,96)* y(k,54) +rxt(k,97)* y(k,55) + rxt(k,87) + rxt(k,95) & + het_rates(k,66))* y(k,66) - prod(k,4) = (rxt(k,99) +rxt(k,98)*y(k,28) +rxt(k,100)*y(k,53) + & - rxt(k,101)*y(k,54) +rxt(k,102)*y(k,55))*y(k,67) +rxt(k,7)*y(k,55) - loss(k,5) = (rxt(k,98)* y(k,28) +rxt(k,100)* y(k,53) +rxt(k,101)* y(k,54) & - +rxt(k,102)* y(k,55) + rxt(k,88) + rxt(k,99) + het_rates(k,67)) & + prod(k,4) = (rxt(k,99) +rxt(k,98)*y(k,30) +rxt(k,100)*y(k,54) + & + rxt(k,101)*y(k,55) +rxt(k,102)*y(k,56))*y(k,67) +rxt(k,7)*y(k,56) + loss(k,5) = (rxt(k,98)* y(k,30) +rxt(k,100)* y(k,54) +rxt(k,101)* y(k,55) & + +rxt(k,102)* y(k,56) + rxt(k,88) + rxt(k,99) + het_rates(k,67)) & * y(k,67) - prod(k,5) =rxt(k,92)*y(k,65)*y(k,54) - loss(k,26) = (rxt(k,275)* y(k,47) +rxt(k,277)* y(k,50) +rxt(k,267)* y(k,60) & + prod(k,5) =rxt(k,92)*y(k,65)*y(k,55) + loss(k,26) = (rxt(k,275)* y(k,48) +rxt(k,277)* y(k,51) +rxt(k,267)* y(k,59) & + rxt(k,276) + het_rates(k,68))* y(k,68) prod(k,26) = (rxt(k,78) +rxt(k,80) +rxt(k,269)*y(k,62) +rxt(k,273)*y(k,64) + & - rxt(k,281)*y(k,70) +rxt(k,285)*y(k,71))*y(k,54) +rxt(k,278)*y(k,70) & - *y(k,28) - loss(k,46) = (rxt(k,198)* y(k,2) +rxt(k,214)* y(k,13) +rxt(k,232)* y(k,14) & - +rxt(k,216)* y(k,15) +rxt(k,217)* y(k,16) +rxt(k,219)* y(k,17) & - +rxt(k,235)* y(k,19) +rxt(k,236)* y(k,20) +rxt(k,221)* y(k,21) & - + (rxt(k,168) +rxt(k,169))* y(k,24) +rxt(k,166)* y(k,25) & - + (rxt(k,237) +rxt(k,241))* y(k,27) +rxt(k,115)* y(k,33) +rxt(k,116) & - * y(k,35) +rxt(k,200)* y(k,36) +rxt(k,222)* y(k,37) +rxt(k,223) & - * y(k,38) +rxt(k,224)* y(k,39) +rxt(k,171)* y(k,40) +rxt(k,147) & - * y(k,42) +rxt(k,117)* y(k,43) +rxt(k,123)* y(k,44) +rxt(k,174) & - * y(k,46) +rxt(k,138)* y(k,47) +rxt(k,146)* y(k,51) +rxt(k,137) & - * y(k,52) +rxt(k,118)* y(k,53) +rxt(k,119)* y(k,55) & + rxt(k,281)*y(k,70) +rxt(k,285)*y(k,71))*y(k,55) +rxt(k,278)*y(k,70) & + *y(k,30) + loss(k,46) = (rxt(k,198)* y(k,3) +rxt(k,214)* y(k,14) +rxt(k,232)* y(k,15) & + +rxt(k,216)* y(k,16) +rxt(k,217)* y(k,17) +rxt(k,219)* y(k,18) & + +rxt(k,235)* y(k,20) +rxt(k,236)* y(k,21) +rxt(k,221)* y(k,22) & + + (rxt(k,168) +rxt(k,169))* y(k,26) +rxt(k,166)* y(k,27) & + + (rxt(k,237) +rxt(k,241))* y(k,29) +rxt(k,115)* y(k,35) +rxt(k,116) & + * y(k,37) +rxt(k,200)* y(k,38) +rxt(k,222)* y(k,39) +rxt(k,223) & + * y(k,40) +rxt(k,224)* y(k,41) +rxt(k,171)* y(k,42) +rxt(k,147) & + * y(k,44) +rxt(k,123)* y(k,45) +rxt(k,174)* y(k,47) +rxt(k,138) & + * y(k,48) +rxt(k,146)* y(k,52) +rxt(k,137)* y(k,53) +rxt(k,118) & + * y(k,54) +rxt(k,119)* y(k,56) +rxt(k,117)* y(k,60) & + 2._r8*(rxt(k,120) +rxt(k,121))* y(k,69) + het_rates(k,69)) & * y(k,69) - prod(k,46) = (rxt(k,106)*y(k,33) +rxt(k,107)*y(k,35) +rxt(k,112)*y(k,43) + & - rxt(k,170)*y(k,40) +rxt(k,173)*y(k,46) +rxt(k,199)*y(k,36) + & - rxt(k,201)*y(k,45) +rxt(k,231)*y(k,14))*y(k,53) & - + (2.000_r8*rxt(k,109)*y(k,32) +rxt(k,113)*y(k,55) + & - rxt(k,134)*y(k,52) +rxt(k,139)*y(k,50) +rxt(k,155)*y(k,59))*y(k,43) & - + (rxt(k,238)*y(k,20) +rxt(k,89)*y(k,33) + & - 2.000_r8*rxt(k,90)*y(k,73) +rxt(k,182)*y(k,40) +rxt(k,205)*y(k,36)) & - *y(k,65) + (rxt(k,22) +.300_r8*rxt(k,235)*y(k,69))*y(k,19) & - + (rxt(k,3) +rxt(k,209)*y(k,31))*y(k,73) +rxt(k,114)*y(k,55)*y(k,32) & - +2.000_r8*rxt(k,4)*y(k,35) +rxt(k,9)*y(k,42) +rxt(k,10)*y(k,44) & - +rxt(k,57)*y(k,45) +rxt(k,58)*y(k,46) +.500_r8*rxt(k,244)*y(k,51) - loss(k,25) = (rxt(k,278)* y(k,28) +rxt(k,281)* y(k,54) +rxt(k,280)* y(k,61) & + prod(k,46) = (rxt(k,106)*y(k,35) +rxt(k,107)*y(k,37) +rxt(k,112)*y(k,60) + & + rxt(k,170)*y(k,42) +rxt(k,173)*y(k,47) +rxt(k,199)*y(k,38) + & + rxt(k,201)*y(k,46) +rxt(k,231)*y(k,15))*y(k,54) & + + (2.000_r8*rxt(k,109)*y(k,34) +rxt(k,113)*y(k,56) + & + rxt(k,134)*y(k,53) +rxt(k,139)*y(k,51) +rxt(k,155)*y(k,23))*y(k,60) & + + (rxt(k,238)*y(k,21) +rxt(k,89)*y(k,35) + & + 2.000_r8*rxt(k,90)*y(k,73) +rxt(k,182)*y(k,42) +rxt(k,205)*y(k,38)) & + *y(k,65) + (rxt(k,22) +.300_r8*rxt(k,235)*y(k,69))*y(k,20) & + + (rxt(k,3) +rxt(k,209)*y(k,33))*y(k,73) +rxt(k,114)*y(k,56)*y(k,34) & + +2.000_r8*rxt(k,4)*y(k,37) +rxt(k,9)*y(k,44) +rxt(k,10)*y(k,45) & + +rxt(k,57)*y(k,46) +rxt(k,58)*y(k,47) +.500_r8*rxt(k,244)*y(k,52) + loss(k,25) = (rxt(k,278)* y(k,30) +rxt(k,281)* y(k,55) +rxt(k,280)* y(k,61) & + rxt(k,279) + het_rates(k,70))* y(k,70) prod(k,25) = (rxt(k,71) +rxt(k,72) +rxt(k,271)*y(k,62) +rxt(k,272)*y(k,64) + & - rxt(k,284)*y(k,71) +rxt(k,290)*y(k,72))*y(k,53) + (rxt(k,79) + & - rxt(k,81))*y(k,54) + (rxt(k,282)*y(k,71) +rxt(k,287)*y(k,72))*y(k,60) & + rxt(k,284)*y(k,71) +rxt(k,290)*y(k,72))*y(k,54) + (rxt(k,79) + & + rxt(k,81))*y(k,55) + (rxt(k,282)*y(k,71) +rxt(k,287)*y(k,72))*y(k,59) & +rxt(k,264)*y(k,71) +rxt(k,263)*y(k,72) - loss(k,14) = (rxt(k,284)* y(k,53) +rxt(k,285)* y(k,54) +rxt(k,282)* y(k,60) & + loss(k,14) = (rxt(k,284)* y(k,54) +rxt(k,285)* y(k,55) +rxt(k,282)* y(k,59) & + rxt(k,264) + rxt(k,283) + het_rates(k,71))* y(k,71) - prod(k,14) = (rxt(k,73) +rxt(k,75))*y(k,53) + (rxt(k,84) +rxt(k,86))*y(k,54) & - + (rxt(k,265) +rxt(k,286)*y(k,60))*y(k,72) - loss(k,13) = (rxt(k,290)* y(k,53) + (rxt(k,286) +rxt(k,287))* y(k,60) & + prod(k,14) = (rxt(k,73) +rxt(k,75))*y(k,54) + (rxt(k,84) +rxt(k,86))*y(k,55) & + + (rxt(k,265) +rxt(k,286)*y(k,59))*y(k,72) + loss(k,13) = (rxt(k,290)* y(k,54) + (rxt(k,286) +rxt(k,287))* y(k,59) & + rxt(k,263) + rxt(k,265) + rxt(k,288) + rxt(k,289) & + het_rates(k,72))* y(k,72) - prod(k,13) = (rxt(k,74) +rxt(k,76))*y(k,53) + (rxt(k,77) +rxt(k,85))*y(k,54) - loss(k,33) = (rxt(k,209)* y(k,31) +rxt(k,90)* y(k,65) + rxt(k,1) + rxt(k,2) & + prod(k,13) = (rxt(k,74) +rxt(k,76))*y(k,54) + (rxt(k,77) +rxt(k,85))*y(k,55) + loss(k,33) = (rxt(k,209)* y(k,33) +rxt(k,90)* y(k,65) + rxt(k,1) + rxt(k,2) & + rxt(k,3) + het_rates(k,73))* y(k,73) - prod(k,33) = (rxt(k,214)*y(k,13) +rxt(k,216)*y(k,15) +rxt(k,217)*y(k,16) + & - rxt(k,219)*y(k,17) +rxt(k,224)*y(k,39) +rxt(k,236)*y(k,20) + & - rxt(k,115)*y(k,33) +rxt(k,116)*y(k,35) +rxt(k,117)*y(k,43) + & - rxt(k,120)*y(k,69) +rxt(k,123)*y(k,44) +rxt(k,147)*y(k,42) + & - rxt(k,171)*y(k,40) +rxt(k,174)*y(k,46) +rxt(k,200)*y(k,36) + & - rxt(k,232)*y(k,14) +rxt(k,235)*y(k,19))*y(k,69) & - + (rxt(k,247)*y(k,46) +rxt(k,253)*y(k,46) +rxt(k,254)*y(k,45) + & - rxt(k,258)*y(k,46) +rxt(k,259)*y(k,45))*y(k,40) +rxt(k,110)*y(k,43) & - *y(k,32) + prod(k,33) = (rxt(k,214)*y(k,14) +rxt(k,216)*y(k,16) +rxt(k,217)*y(k,17) + & + rxt(k,219)*y(k,18) +rxt(k,224)*y(k,41) +rxt(k,236)*y(k,21) + & + rxt(k,115)*y(k,35) +rxt(k,116)*y(k,37) +rxt(k,117)*y(k,60) + & + rxt(k,120)*y(k,69) +rxt(k,123)*y(k,45) +rxt(k,147)*y(k,44) + & + rxt(k,171)*y(k,42) +rxt(k,174)*y(k,47) +rxt(k,200)*y(k,38) + & + rxt(k,232)*y(k,15) +rxt(k,235)*y(k,20))*y(k,69) & + + (rxt(k,247)*y(k,47) +rxt(k,253)*y(k,47) +rxt(k,254)*y(k,46) + & + rxt(k,258)*y(k,47) +rxt(k,259)*y(k,46))*y(k,42) +rxt(k,110)*y(k,60) & + *y(k,34) end do end subroutine imp_prod_loss end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_ma/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_ma/mo_rxt_rates_conv.F90 index af8d25f9b5..901f3821b0 100644 --- a/src/chemistry/pp_waccm_ma/mo_rxt_rates_conv.F90 +++ b/src/chemistry/pp_waccm_ma/mo_rxt_rates_conv.F90 @@ -11,65 +11,65 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 73) ! rate_const*H2O rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 73) ! rate_const*H2O rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 73) ! rate_const*H2O - rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 35) ! rate_const*H2O2 - rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 54) ! rate_const*O2 - rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 54) ! rate_const*O2 - rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 55) ! rate_const*O3 - rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 55) ! rate_const*O3 - rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 42) ! rate_const*HNO3 - rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 44) ! rate_const*HO2NO2 - rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 44) ! rate_const*HO2NO2 - rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 48) ! rate_const*N2O - rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 49) ! rate_const*N2O5 - rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 49) ! rate_const*N2O5 - rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 50) ! rate_const*NO - rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 50) ! rate_const*NO - rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 51) ! rate_const*NO2 - rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 52) ! rate_const*NO3 - rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 52) ! rate_const*NO3 - rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 14) ! rate_const*CH2O - rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 14) ! rate_const*CH2O - rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 19) ! rate_const*CH3OOH - rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 20) ! rate_const*CH4 - rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 20) ! rate_const*CH4 - rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 28) ! rate_const*CO2 - rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 1) ! rate_const*BRCL - rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 2) ! rate_const*BRO - rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 3) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 3) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 5) ! rate_const*CCL4 - rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 6) ! rate_const*CF2CLBR - rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 7) ! rate_const*CF3BR - rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 8) ! rate_const*CFC11 - rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 9) ! rate_const*CFC113 - rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 10) ! rate_const*CFC114 - rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 11) ! rate_const*CFC115 - rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 12) ! rate_const*CFC12 - rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 13) ! rate_const*CH2BR2 - rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 15) ! rate_const*CH3BR - rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 16) ! rate_const*CH3CCL3 - rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 17) ! rate_const*CH3CL - rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 21) ! rate_const*CHBR3 - rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 22) ! rate_const*CL2 - rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 23) ! rate_const*CL2O2 - rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 24) ! rate_const*CLO - rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 25) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 25) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 29) ! rate_const*COF2 - rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 30) ! rate_const*COFCL - rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 34) ! rate_const*H2402 - rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 36) ! rate_const*HBR - rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 37) ! rate_const*HCFC141B - rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 38) ! rate_const*HCFC142B - rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 39) ! rate_const*HCFC22 - rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 40) ! rate_const*HCL - rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 41) ! rate_const*HF - rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 45) ! rate_const*HOBR - rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 46) ! rate_const*HOCL - rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 56) ! rate_const*OCLO - rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 57) ! rate_const*SF6 - rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 28) ! rate_const*CO2 - rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 47) ! rate_const*N + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 37) ! rate_const*H2O2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 55) ! rate_const*O2 + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 55) ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 56) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 56) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 44) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 45) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 45) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 49) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 50) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 50) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 51) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 51) ! rate_const*NO + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 52) ! rate_const*NO2 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 53) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 53) ! rate_const*NO3 + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 15) ! rate_const*CH2O + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 15) ! rate_const*CH2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 20) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 21) ! rate_const*CH4 + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 21) ! rate_const*CH4 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 30) ! rate_const*CO2 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 2) ! rate_const*BRCL + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 3) ! rate_const*BRO + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 6) ! rate_const*CCL4 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 7) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 8) ! rate_const*CF3BR + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 9) ! rate_const*CFC11 + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 10) ! rate_const*CFC113 + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 11) ! rate_const*CFC114 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 12) ! rate_const*CFC115 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 13) ! rate_const*CFC12 + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 14) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 16) ! rate_const*CH3BR + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 17) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 18) ! rate_const*CH3CL + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 22) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 24) ! rate_const*CL2 + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 25) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 26) ! rate_const*CLO + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 31) ! rate_const*COF2 + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 32) ! rate_const*COFCL + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 36) ! rate_const*H2402 + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 38) ! rate_const*HBR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 39) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 40) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 41) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 42) ! rate_const*HCL + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 43) ! rate_const*HF + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 46) ! rate_const*HOBR + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 47) ! rate_const*HOCL + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 57) ! rate_const*OCLO + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 58) ! rate_const*SF6 + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 30) ! rate_const*CO2 + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 48) ! rate_const*N ! rate_const*N2 ! rate_const*N2 ! rate_const*N2 @@ -78,225 +78,225 @@ subroutine set_rates( rxt_rates, sol, ncol ) ! rate_const*N2 ! rate_const*N2 ! rate_const*N2 - rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 53) ! rate_const*O - rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 53) ! rate_const*O - rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 53) ! rate_const*O - rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 53) ! rate_const*O - rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 53) ! rate_const*O - rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 53) ! rate_const*O - rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 54) ! rate_const*O2 - rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 54) ! rate_const*O2 - rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 54) ! rate_const*O2 - rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 54) ! rate_const*O2 - rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 54) ! rate_const*O2 - rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 54) ! rate_const*O2 - rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 54) ! rate_const*O2 - rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 54) ! rate_const*O2 - rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 54) ! rate_const*O2 - rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 54) ! rate_const*O2 + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 54) ! rate_const*O + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 54) ! rate_const*O + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 54) ! rate_const*O + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 54) ! rate_const*O + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 54) ! rate_const*O + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 54) ! rate_const*O + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 55) ! rate_const*O2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 55) ! rate_const*O2 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 55) ! rate_const*O2 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 55) ! rate_const*O2 + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 55) ! rate_const*O2 + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 55) ! rate_const*O2 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 55) ! rate_const*O2 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 55) ! rate_const*O2 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 55) ! rate_const*O2 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 55) ! rate_const*O2 rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 66) ! rate_const*O2_1D rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 67) ! rate_const*O2_1S - rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 65)*sol(:ncol,:, 33) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 65)*sol(:ncol,:, 35) ! rate_const*O1D*H2 rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 65)*sol(:ncol,:, 73) ! rate_const*O1D*H2O rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 65) ! rate_const*N2*O1D - rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 65)*sol(:ncol,:, 54) ! rate_const*O1D*O2 - rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 65)*sol(:ncol,:, 54) ! rate_const*O1D*O2 - rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 65)*sol(:ncol,:, 55) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 65)*sol(:ncol,:, 55) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 65)*sol(:ncol,:, 55) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 65)*sol(:ncol,:, 56) ! rate_const*O1D*O3 rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 66) ! rate_const*N2*O2_1D - rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 66)*sol(:ncol,:, 53) ! rate_const*O2_1D*O - rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 66)*sol(:ncol,:, 54) ! rate_const*O2_1D*O2 - rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 67)*sol(:ncol,:, 28) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 66)*sol(:ncol,:, 54) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 66)*sol(:ncol,:, 55) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 67)*sol(:ncol,:, 30) ! rate_const*O2_1S*CO2 rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 67) ! rate_const*N2*O2_1S - rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 67)*sol(:ncol,:, 53) ! rate_const*O2_1S*O - rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 67)*sol(:ncol,:, 54) ! rate_const*O2_1S*O2 - rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 67)*sol(:ncol,:, 55) ! rate_const*O2_1S*O3 - rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 53)*sol(:ncol,:, 55) ! rate_const*O*O3 - rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 53)*sol(:ncol,:, 53) ! rate_const*M*O*O - rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 53)*sol(:ncol,:, 54) ! rate_const*M*O*O2 - rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 33)*sol(:ncol,:, 53) ! rate_const*H2*O - rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 35)*sol(:ncol,:, 53) ! rate_const*H2O2*O - rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 32)*sol(:ncol,:, 43) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 32)*sol(:ncol,:, 43) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 32)*sol(:ncol,:, 43) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 32)*sol(:ncol,:, 54) ! rate_const*M*H*O2 - rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 43)*sol(:ncol,:, 53) ! rate_const*HO2*O - rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 43)*sol(:ncol,:, 55) ! rate_const*HO2*O3 - rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 32)*sol(:ncol,:, 55) ! rate_const*H*O3 - rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 69)*sol(:ncol,:, 33) ! rate_const*OH*H2 - rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 69)*sol(:ncol,:, 35) ! rate_const*OH*H2O2 - rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 69)*sol(:ncol,:, 43) ! rate_const*OH*HO2 - rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 69)*sol(:ncol,:, 53) ! rate_const*OH*O - rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 69)*sol(:ncol,:, 55) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 67)*sol(:ncol,:, 54) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 67)*sol(:ncol,:, 55) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 67)*sol(:ncol,:, 56) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 54)*sol(:ncol,:, 56) ! rate_const*O*O3 + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 54)*sol(:ncol,:, 54) ! rate_const*M*O*O + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 54)*sol(:ncol,:, 55) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 35)*sol(:ncol,:, 54) ! rate_const*H2*O + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 37)*sol(:ncol,:, 54) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 34)*sol(:ncol,:, 60) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 34)*sol(:ncol,:, 60) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 34)*sol(:ncol,:, 60) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 34)*sol(:ncol,:, 55) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 60)*sol(:ncol,:, 54) ! rate_const*HO2*O + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 60)*sol(:ncol,:, 56) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 34)*sol(:ncol,:, 56) ! rate_const*H*O3 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 69)*sol(:ncol,:, 35) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 69)*sol(:ncol,:, 37) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 69)*sol(:ncol,:, 60) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 69)*sol(:ncol,:, 54) ! rate_const*OH*O + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 69)*sol(:ncol,:, 56) ! rate_const*OH*O3 rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 69)*sol(:ncol,:, 69) ! rate_const*OH*OH rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 69)*sol(:ncol,:, 69) ! rate_const*M*OH*OH - rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 43)*sol(:ncol,:, 43) ! rate_const*HO2*HO2 - rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 44)*sol(:ncol,:, 69) ! rate_const*HO2NO2*OH - rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 61)*sol(:ncol,:, 53) ! rate_const*N2D*O - rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 61)*sol(:ncol,:, 54) ! rate_const*N2D*O2 - rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 47)*sol(:ncol,:, 50) ! rate_const*N*NO - rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 47)*sol(:ncol,:, 51) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 47)*sol(:ncol,:, 51) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 47)*sol(:ncol,:, 51) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 47)*sol(:ncol,:, 54) ! rate_const*N*O2 - rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 51)*sol(:ncol,:, 53) ! rate_const*NO2*O - rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 51)*sol(:ncol,:, 55) ! rate_const*NO2*O3 - rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 51)*sol(:ncol,:, 53) ! rate_const*M*NO2*O - rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 52)*sol(:ncol,:, 43) ! rate_const*NO3*HO2 - rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 52)*sol(:ncol,:, 50) ! rate_const*NO3*NO - rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 52)*sol(:ncol,:, 53) ! rate_const*NO3*O - rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 52)*sol(:ncol,:, 69) ! rate_const*NO3*OH - rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 47)*sol(:ncol,:, 69) ! rate_const*N*OH - rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 50)*sol(:ncol,:, 43) ! rate_const*NO*HO2 - rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 50)*sol(:ncol,:, 55) ! rate_const*NO*O3 - rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 50)*sol(:ncol,:, 53) ! rate_const*M*NO*O - rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 65)*sol(:ncol,:, 48) ! rate_const*O1D*N2O - rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 65)*sol(:ncol,:, 48) ! rate_const*O1D*N2O - rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 51)*sol(:ncol,:, 43) ! rate_const*M*NO2*HO2 - rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 51)*sol(:ncol,:, 52) ! rate_const*M*NO2*NO3 - rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 51)*sol(:ncol,:, 69) ! rate_const*M*NO2*OH - rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 42)*sol(:ncol,:, 69) ! rate_const*HNO3*OH - rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 44) ! rate_const*M*HO2NO2 - rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 49) ! rate_const*M*N2O5 - rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 59)*sol(:ncol,:, 14) ! rate_const*CL*CH2O - rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 59)*sol(:ncol,:, 20) ! rate_const*CL*CH4 - rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 59)*sol(:ncol,:, 33) ! rate_const*CL*H2 - rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 59)*sol(:ncol,:, 35) ! rate_const*CL*H2O2 - rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 59)*sol(:ncol,:, 43) ! rate_const*CL*HO2 - rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 59)*sol(:ncol,:, 43) ! rate_const*CL*HO2 - rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 59)*sol(:ncol,:, 55) ! rate_const*CL*O3 - rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 24)*sol(:ncol,:, 18) ! rate_const*CLO*CH3O2 - rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 24)*sol(:ncol,:, 43) ! rate_const*CLO*HO2 - rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 24)*sol(:ncol,:, 50) ! rate_const*CLO*NO - rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 25)*sol(:ncol,:, 59) ! rate_const*CLONO2*CL - rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 24)*sol(:ncol,:, 51) ! rate_const*M*CLO*NO2 - rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 25)*sol(:ncol,:, 53) ! rate_const*CLONO2*O - rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 25)*sol(:ncol,:, 69) ! rate_const*CLONO2*OH - rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 24)*sol(:ncol,:, 53) ! rate_const*CLO*O - rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 24)*sol(:ncol,:, 69) ! rate_const*CLO*OH - rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 24)*sol(:ncol,:, 69) ! rate_const*CLO*OH - rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 40)*sol(:ncol,:, 53) ! rate_const*HCL*O - rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 40)*sol(:ncol,:, 69) ! rate_const*HCL*OH - rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 46)*sol(:ncol,:, 59) ! rate_const*HOCL*CL - rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 46)*sol(:ncol,:, 53) ! rate_const*HOCL*O - rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 46)*sol(:ncol,:, 69) ! rate_const*HOCL*OH - rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 65)*sol(:ncol,:, 5) ! rate_const*O1D*CCL4 - rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 65)*sol(:ncol,:, 6) ! rate_const*O1D*CF2CLBR - rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 65)*sol(:ncol,:, 8) ! rate_const*O1D*CFC11 - rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 65)*sol(:ncol,:, 9) ! rate_const*O1D*CFC113 - rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 65)*sol(:ncol,:, 10) ! rate_const*O1D*CFC114 - rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 65)*sol(:ncol,:, 11) ! rate_const*O1D*CFC115 - rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 65)*sol(:ncol,:, 12) ! rate_const*O1D*CFC12 - rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 65)*sol(:ncol,:, 40) ! rate_const*O1D*HCL - rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 65)*sol(:ncol,:, 40) ! rate_const*O1D*HCL - rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*M*CLO*CLO - rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 23) ! rate_const*M*CL2O2 - rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 58)*sol(:ncol,:, 14) ! rate_const*BR*CH2O - rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 58)*sol(:ncol,:, 43) ! rate_const*BR*HO2 - rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 58)*sol(:ncol,:, 55) ! rate_const*BR*O3 - rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 2)*sol(:ncol,:, 2) ! rate_const*BRO*BRO - rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 2)*sol(:ncol,:, 24) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 2)*sol(:ncol,:, 24) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 2)*sol(:ncol,:, 24) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 2)*sol(:ncol,:, 43) ! rate_const*BRO*HO2 - rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 2)*sol(:ncol,:, 50) ! rate_const*BRO*NO - rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 2)*sol(:ncol,:, 51) ! rate_const*M*BRO*NO2 - rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 3)*sol(:ncol,:, 53) ! rate_const*BRONO2*O - rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 2)*sol(:ncol,:, 53) ! rate_const*BRO*O - rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 2)*sol(:ncol,:, 69) ! rate_const*BRO*OH - rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 36)*sol(:ncol,:, 53) ! rate_const*HBR*O - rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 36)*sol(:ncol,:, 69) ! rate_const*HBR*OH - rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 45)*sol(:ncol,:, 53) ! rate_const*HOBR*O - rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 65)*sol(:ncol,:, 7) ! rate_const*O1D*CF3BR - rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 65)*sol(:ncol,:, 21) ! rate_const*O1D*CHBR3 - rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 65)*sol(:ncol,:, 34) ! rate_const*O1D*H2402 - rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 65)*sol(:ncol,:, 36) ! rate_const*O1D*HBR - rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 65)*sol(:ncol,:, 36) ! rate_const*O1D*HBR - rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 31)*sol(:ncol,:, 20) ! rate_const*F*CH4 - rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 31)*sol(:ncol,:, 33) ! rate_const*F*H2 - rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 31)*sol(:ncol,:, 73) ! rate_const*F*H2O - rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 31)*sol(:ncol,:, 42) ! rate_const*F*HNO3 - rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 65)*sol(:ncol,:, 29) ! rate_const*O1D*COF2 - rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 65)*sol(:ncol,:, 30) ! rate_const*O1D*COFCL - rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 13)*sol(:ncol,:, 59) ! rate_const*CH2BR2*CL - rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 13)*sol(:ncol,:, 69) ! rate_const*CH2BR2*OH - rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 15)*sol(:ncol,:, 59) ! rate_const*CH3BR*CL - rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 15)*sol(:ncol,:, 69) ! rate_const*CH3BR*OH - rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 16)*sol(:ncol,:, 69) ! rate_const*CH3CCL3*OH - rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 17)*sol(:ncol,:, 59) ! rate_const*CH3CL*CL - rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 17)*sol(:ncol,:, 69) ! rate_const*CH3CL*OH - rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 21)*sol(:ncol,:, 59) ! rate_const*CHBR3*CL - rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 21)*sol(:ncol,:, 69) ! rate_const*CHBR3*OH - rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 37)*sol(:ncol,:, 69) ! rate_const*HCFC141B*OH - rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 38)*sol(:ncol,:, 69) ! rate_const*HCFC142B*OH - rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 39)*sol(:ncol,:, 69) ! rate_const*HCFC22*OH - rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 65)*sol(:ncol,:, 13) ! rate_const*O1D*CH2BR2 - rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 65)*sol(:ncol,:, 15) ! rate_const*O1D*CH3BR - rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 65)*sol(:ncol,:, 37) ! rate_const*O1D*HCFC141B - rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 65)*sol(:ncol,:, 38) ! rate_const*O1D*HCFC142B - rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 65)*sol(:ncol,:, 39) ! rate_const*O1D*HCFC22 - rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 14)*sol(:ncol,:, 52) ! rate_const*CH2O*NO3 - rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 14)*sol(:ncol,:, 53) ! rate_const*CH2O*O - rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 14)*sol(:ncol,:, 69) ! rate_const*CH2O*OH - rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 18)*sol(:ncol,:, 43) ! rate_const*CH3O2*HO2 - rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 18)*sol(:ncol,:, 50) ! rate_const*CH3O2*NO - rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 19)*sol(:ncol,:, 69) ! rate_const*CH3OOH*OH - rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 20)*sol(:ncol,:, 69) ! rate_const*CH4*OH - rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 27)*sol(:ncol,:, 69) ! rate_const*M*CO*OH - rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 65)*sol(:ncol,:, 20) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 65)*sol(:ncol,:, 20) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 65)*sol(:ncol,:, 20) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 27)*sol(:ncol,:, 69) ! rate_const*CO*OH - rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 43) ! rate_const*HO2 - rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 49) ! rate_const*N2O5 - rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 51) ! rate_const*NO2 - rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 52) ! rate_const*NO3 - rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 49) ! rate_const*N2O5 - rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 46)*sol(:ncol,:, 40) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 3) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 49) ! rate_const*N2O5 - rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 25) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 3) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 25)*sol(:ncol,:, 40) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 46)*sol(:ncol,:, 40) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 45)*sol(:ncol,:, 40) ! rate_const*HOBR*HCL - rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 25) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 3) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 25)*sol(:ncol,:, 40) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 46)*sol(:ncol,:, 40) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 45)*sol(:ncol,:, 40) ! rate_const*HOBR*HCL - rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 49) ! rate_const*N2O5 - rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 25) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 25)*sol(:ncol,:, 40) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 60)*sol(:ncol,:, 60) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 45)*sol(:ncol,:, 69) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 61)*sol(:ncol,:, 54) ! rate_const*N2D*O + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 61)*sol(:ncol,:, 55) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 48)*sol(:ncol,:, 51) ! rate_const*N*NO + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 48)*sol(:ncol,:, 52) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 48)*sol(:ncol,:, 52) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 48)*sol(:ncol,:, 52) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 48)*sol(:ncol,:, 55) ! rate_const*N*O2 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 52)*sol(:ncol,:, 54) ! rate_const*NO2*O + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 52)*sol(:ncol,:, 56) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 52)*sol(:ncol,:, 54) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 53)*sol(:ncol,:, 60) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 53)*sol(:ncol,:, 51) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 53)*sol(:ncol,:, 54) ! rate_const*NO3*O + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 53)*sol(:ncol,:, 69) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 48)*sol(:ncol,:, 69) ! rate_const*N*OH + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 51)*sol(:ncol,:, 60) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 51)*sol(:ncol,:, 56) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 51)*sol(:ncol,:, 54) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 65)*sol(:ncol,:, 49) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 65)*sol(:ncol,:, 49) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 52)*sol(:ncol,:, 60) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 52)*sol(:ncol,:, 53) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 52)*sol(:ncol,:, 69) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 44)*sol(:ncol,:, 69) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 45) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 50) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 23)*sol(:ncol,:, 15) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 23)*sol(:ncol,:, 21) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 23)*sol(:ncol,:, 35) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 23)*sol(:ncol,:, 37) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 23)*sol(:ncol,:, 60) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 23)*sol(:ncol,:, 60) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 23)*sol(:ncol,:, 56) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 26)*sol(:ncol,:, 19) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 26)*sol(:ncol,:, 60) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 26)*sol(:ncol,:, 51) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 27)*sol(:ncol,:, 23) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 26)*sol(:ncol,:, 52) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 27)*sol(:ncol,:, 54) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 27)*sol(:ncol,:, 69) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 26)*sol(:ncol,:, 54) ! rate_const*CLO*O + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 26)*sol(:ncol,:, 69) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 26)*sol(:ncol,:, 69) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 42)*sol(:ncol,:, 54) ! rate_const*HCL*O + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 42)*sol(:ncol,:, 69) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 47)*sol(:ncol,:, 23) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 47)*sol(:ncol,:, 54) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 47)*sol(:ncol,:, 69) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 65)*sol(:ncol,:, 6) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 65)*sol(:ncol,:, 7) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 65)*sol(:ncol,:, 9) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 65)*sol(:ncol,:, 10) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 65)*sol(:ncol,:, 11) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 65)*sol(:ncol,:, 12) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 65)*sol(:ncol,:, 13) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 65)*sol(:ncol,:, 42) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 65)*sol(:ncol,:, 42) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 25) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 1)*sol(:ncol,:, 15) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 1)*sol(:ncol,:, 60) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 1)*sol(:ncol,:, 56) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 3)*sol(:ncol,:, 3) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 3)*sol(:ncol,:, 26) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 3)*sol(:ncol,:, 26) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 3)*sol(:ncol,:, 26) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 3)*sol(:ncol,:, 60) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 3)*sol(:ncol,:, 51) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 3)*sol(:ncol,:, 52) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 4)*sol(:ncol,:, 54) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 3)*sol(:ncol,:, 54) ! rate_const*BRO*O + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 3)*sol(:ncol,:, 69) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 38)*sol(:ncol,:, 54) ! rate_const*HBR*O + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 38)*sol(:ncol,:, 69) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 46)*sol(:ncol,:, 54) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 65)*sol(:ncol,:, 8) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 65)*sol(:ncol,:, 22) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 65)*sol(:ncol,:, 36) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 65)*sol(:ncol,:, 38) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 65)*sol(:ncol,:, 38) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 33)*sol(:ncol,:, 21) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 33)*sol(:ncol,:, 35) ! rate_const*F*H2 + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 33)*sol(:ncol,:, 73) ! rate_const*F*H2O + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 33)*sol(:ncol,:, 44) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 65)*sol(:ncol,:, 31) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 65)*sol(:ncol,:, 32) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 14)*sol(:ncol,:, 23) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 14)*sol(:ncol,:, 69) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 16)*sol(:ncol,:, 23) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 16)*sol(:ncol,:, 69) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 17)*sol(:ncol,:, 69) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 18)*sol(:ncol,:, 23) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 18)*sol(:ncol,:, 69) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 22)*sol(:ncol,:, 23) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 22)*sol(:ncol,:, 69) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 39)*sol(:ncol,:, 69) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 40)*sol(:ncol,:, 69) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 41)*sol(:ncol,:, 69) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 65)*sol(:ncol,:, 14) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 65)*sol(:ncol,:, 16) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 65)*sol(:ncol,:, 39) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 65)*sol(:ncol,:, 40) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 65)*sol(:ncol,:, 41) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 15)*sol(:ncol,:, 53) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 15)*sol(:ncol,:, 54) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 15)*sol(:ncol,:, 69) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 19)*sol(:ncol,:, 60) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 19)*sol(:ncol,:, 51) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 20)*sol(:ncol,:, 69) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 21)*sol(:ncol,:, 69) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 29)*sol(:ncol,:, 69) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 65)*sol(:ncol,:, 21) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 65)*sol(:ncol,:, 21) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 65)*sol(:ncol,:, 21) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 29)*sol(:ncol,:, 69) ! rate_const*CO*OH + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 60) ! rate_const*HO2 + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 50) ! rate_const*N2O5 + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 52) ! rate_const*NO2 + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 53) ! rate_const*NO3 + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 50) ! rate_const*N2O5 + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 47)*sol(:ncol,:, 42) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 50) ! rate_const*N2O5 + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 27)*sol(:ncol,:, 42) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 47)*sol(:ncol,:, 42) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 46)*sol(:ncol,:, 42) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 27)*sol(:ncol,:, 42) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 47)*sol(:ncol,:, 42) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 46)*sol(:ncol,:, 42) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 50) ! rate_const*N2O5 + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 27)*sol(:ncol,:, 42) ! rate_const*CLONO2*HCL rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 72) ! rate_const*Op2P rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 71) ! rate_const*Op2D rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 72) ! rate_const*Op2P - rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 63)*sol(:ncol,:, 60) ! rate_const*NOp*e - rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 68)*sol(:ncol,:, 60) ! rate_const*O2p*e - rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 62)*sol(:ncol,:, 60) ! rate_const*N2p*e - rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 62)*sol(:ncol,:, 54) ! rate_const*N2p*O2 - rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 62)*sol(:ncol,:, 53) ! rate_const*N2p*O - rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 62)*sol(:ncol,:, 53) ! rate_const*N2p*O - rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 64)*sol(:ncol,:, 53) ! rate_const*Np*O - rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 64)*sol(:ncol,:, 54) ! rate_const*Np*O2 - rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 64)*sol(:ncol,:, 54) ! rate_const*Np*O2 - rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 68)*sol(:ncol,:, 47) ! rate_const*O2p*N + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 63)*sol(:ncol,:, 59) ! rate_const*NOp*e + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 68)*sol(:ncol,:, 59) ! rate_const*O2p*e + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 62)*sol(:ncol,:, 59) ! rate_const*N2p*e + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 62)*sol(:ncol,:, 55) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 62)*sol(:ncol,:, 54) ! rate_const*N2p*O + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 62)*sol(:ncol,:, 54) ! rate_const*N2p*O + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 64)*sol(:ncol,:, 54) ! rate_const*Np*O + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 64)*sol(:ncol,:, 55) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 64)*sol(:ncol,:, 55) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 68)*sol(:ncol,:, 48) ! rate_const*O2p*N rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 68) ! rate_const*N2*O2p - rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 68)*sol(:ncol,:, 50) ! rate_const*O2p*NO - rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 70)*sol(:ncol,:, 28) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 68)*sol(:ncol,:, 51) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 70)*sol(:ncol,:, 30) ! rate_const*Op*CO2 rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 70) ! rate_const*N2*Op rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 70)*sol(:ncol,:, 61) ! rate_const*Op*N2D - rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 70)*sol(:ncol,:, 54) ! rate_const*Op*O2 - rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 71)*sol(:ncol,:, 60) ! rate_const*Op2D*e + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 70)*sol(:ncol,:, 55) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 71)*sol(:ncol,:, 59) ! rate_const*Op2D*e rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 71) ! rate_const*N2*Op2D - rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 71)*sol(:ncol,:, 53) ! rate_const*Op2D*O - rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 71)*sol(:ncol,:, 54) ! rate_const*Op2D*O2 - rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 72)*sol(:ncol,:, 60) ! rate_const*Op2P*e - rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 72)*sol(:ncol,:, 60) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 71)*sol(:ncol,:, 54) ! rate_const*Op2D*O + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 71)*sol(:ncol,:, 55) ! rate_const*Op2D*O2 + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 72)*sol(:ncol,:, 59) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 72)*sol(:ncol,:, 59) ! rate_const*Op2P*e rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 72) ! rate_const*N2*Op2P rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 72) ! rate_const*N2*Op2P - rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 72)*sol(:ncol,:, 53) ! rate_const*Op2P*O + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 72)*sol(:ncol,:, 54) ! rate_const*Op2P*O end subroutine set_rates end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_ma/mo_sim_dat.F90 b/src/chemistry/pp_waccm_ma/mo_sim_dat.F90 index c56667c039..e17aca3e5b 100644 --- a/src/chemistry/pp_waccm_ma/mo_sim_dat.F90 +++ b/src/chemistry/pp_waccm_ma/mo_sim_dat.F90 @@ -36,47 +36,47 @@ subroutine set_sim_dat cls_rxt_cnt(:,1) = (/ 3, 59, 0, 23 /) cls_rxt_cnt(:,4) = (/ 30, 121, 138, 50 /) - solsym(: 73) = (/ 'BRCL ','BRO ','BRONO2 ','BRY ','CCL4 ', & - 'CF2CLBR ','CF3BR ','CFC11 ','CFC113 ','CFC114 ', & - 'CFC115 ','CFC12 ','CH2BR2 ','CH2O ','CH3BR ', & - 'CH3CCL3 ','CH3CL ','CH3O2 ','CH3OOH ','CH4 ', & - 'CHBR3 ','CL2 ','CL2O2 ','CLO ','CLONO2 ', & - 'CLY ','CO ','CO2 ','COF2 ','COFCL ', & - 'F ','H ','H2 ','H2402 ','H2O2 ', & - 'HBR ','HCFC141B ','HCFC142B ','HCFC22 ','HCL ', & - 'HF ','HNO3 ','HO2 ','HO2NO2 ','HOBR ', & - 'HOCL ','N ','N2O ','N2O5 ','NO ', & - 'NO2 ','NO3 ','O ','O2 ','O3 ', & - 'OCLO ','SF6 ','BR ','CL ','e ', & + solsym(: 73) = (/ 'BR ','BRCL ','BRO ','BRONO2 ','BRY ', & + 'CCL4 ','CF2CLBR ','CF3BR ','CFC11 ','CFC113 ', & + 'CFC114 ','CFC115 ','CFC12 ','CH2BR2 ','CH2O ', & + 'CH3BR ','CH3CCL3 ','CH3CL ','CH3O2 ','CH3OOH ', & + 'CH4 ','CHBR3 ','CL ','CL2 ','CL2O2 ', & + 'CLO ','CLONO2 ','CLY ','CO ','CO2 ', & + 'COF2 ','COFCL ','F ','H ','H2 ', & + 'H2402 ','H2O2 ','HBR ','HCFC141B ','HCFC142B ', & + 'HCFC22 ','HCL ','HF ','HNO3 ','HO2NO2 ', & + 'HOBR ','HOCL ','N ','N2O ','N2O5 ', & + 'NO ','NO2 ','NO3 ','O ','O2 ', & + 'O3 ','OCLO ','SF6 ','e ','HO2 ', & 'N2D ','N2p ','NOp ','Np ','O1D ', & 'O2_1D ','O2_1S ','O2p ','OH ','Op ', & 'Op2D ','Op2P ','H2O ' /) - adv_mass(: 73) = (/ 115.356700_r8, 95.903400_r8, 141.908940_r8, 99.716850_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, 50.485900_r8, 47.032000_r8, 48.039400_r8, 16.040600_r8, & - 252.730400_r8, 70.905400_r8, 102.904200_r8, 51.452100_r8, 97.457640_r8, & - 100.916850_r8, 28.010400_r8, 44.009800_r8, 66.007206_r8, 82.461503_r8, & - 18.998403_r8, 1.007400_r8, 2.014800_r8, 259.823613_r8, 34.013600_r8, & - 80.911400_r8, 116.948003_r8, 100.493706_r8, 86.467906_r8, 36.460100_r8, & - 20.005803_r8, 63.012340_r8, 33.006200_r8, 79.011740_r8, 96.910800_r8, & - 52.459500_r8, 14.006740_r8, 44.012880_r8, 108.010480_r8, 30.006140_r8, & - 46.005540_r8, 62.004940_r8, 15.999400_r8, 31.998800_r8, 47.998200_r8, & - 67.451500_r8, 146.056419_r8, 79.904000_r8, 35.452700_r8, 0.548567E-03_r8, & + adv_mass(: 73) = (/ 79.904000_r8, 115.356700_r8, 95.903400_r8, 141.908940_r8, 99.716850_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, 50.485900_r8, 47.032000_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, & + 66.007206_r8, 82.461503_r8, 18.998403_r8, 1.007400_r8, 2.014800_r8, & + 259.823613_r8, 34.013600_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, 14.006740_r8, 44.012880_r8, 108.010480_r8, & + 30.006140_r8, 46.005540_r8, 62.004940_r8, 15.999400_r8, 31.998800_r8, & + 47.998200_r8, 67.451500_r8, 146.056419_r8, 0.548567E-03_r8, 33.006200_r8, & 14.006740_r8, 28.013480_r8, 30.006140_r8, 14.006740_r8, 15.999400_r8, & 31.998800_r8, 31.998800_r8, 31.998800_r8, 17.006800_r8, 15.999400_r8, & 15.999400_r8, 15.999400_r8, 18.014200_r8 /) - crb_mass(: 73) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_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, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + crb_mass(: 73) = (/ 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, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 12.011000_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, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 24.022000_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, & - 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & - 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_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, & 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, 0.000000_r8, & 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & @@ -86,26 +86,26 @@ subroutine set_sim_dat fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) - clsmap(: 23,1) = (/ 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, & - 15, 16, 17, 20, 21, 26, 28, 34, 37, 38, & - 39, 48, 57 /) - clsmap(: 50,4) = (/ 1, 2, 3, 14, 18, 19, 22, 23, 24, 25, & - 27, 29, 30, 31, 32, 33, 35, 36, 40, 41, & - 42, 43, 44, 45, 46, 47, 49, 50, 51, 52, & - 53, 54, 55, 56, 58, 59, 60, 61, 62, 63, & + clsmap(: 23,1) = (/ 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, & + 16, 17, 18, 21, 22, 28, 30, 36, 39, 40, & + 41, 49, 58 /) + clsmap(: 50,4) = (/ 1, 2, 3, 4, 15, 19, 20, 23, 24, 25, & + 26, 27, 29, 31, 32, 33, 34, 35, 37, 38, & + 42, 43, 44, 45, 46, 47, 48, 50, 51, 52, & + 53, 54, 55, 56, 57, 59, 60, 61, 62, 63, & 64, 65, 66, 67, 68, 69, 70, 71, 72, 73 /) - permute(: 50,4) = (/ 8, 39, 15, 35, 44, 11, 6, 1, 41, 30, & - 16, 2, 7, 21, 36, 49, 17, 23, 34, 9, & - 31, 47, 12, 20, 22, 29, 10, 38, 45, 37, & - 48, 32, 50, 3, 43, 40, 27, 28, 18, 19, & + permute(: 50,4) = (/ 38, 8, 44, 15, 35, 47, 11, 48, 6, 1, & + 43, 30, 16, 2, 7, 21, 36, 39, 17, 22, & + 34, 9, 31, 12, 20, 23, 29, 10, 40, 41, & + 45, 50, 32, 49, 3, 27, 37, 28, 18, 19, & 24, 42, 4, 5, 26, 46, 25, 14, 13, 33 /) diag_map(: 50) = (/ 1, 4, 7, 10, 13, 15, 17, 21, 24, 27, & 33, 39, 46, 53, 59, 67, 71, 78, 87, 93, & - 102, 111, 118, 127, 138, 149, 164, 178, 193, 204, & - 216, 236, 248, 264, 282, 298, 316, 339, 363, 389, & - 416, 442, 463, 483, 509, 541, 567, 607, 628, 647 /) + 102, 110, 119, 127, 138, 149, 164, 178, 193, 204, & + 216, 236, 248, 264, 282, 298, 320, 341, 362, 385, & + 411, 437, 464, 488, 510, 542, 562, 588, 607, 647 /) extfrc_lst(: 11) = (/ 'NO2 ','CO ','NO ','O2p ','Op ', & 'N2p ','N ','OH ','e ','Np ', & @@ -117,9 +117,9 @@ subroutine set_sim_dat inv_lst(: 2) = (/ 'M ', 'N2 ' /) - slvd_lst(: 15) = (/ 'BR ', 'CL ', 'e ', 'N2D ', 'N2p ', & - 'NOp ', 'Np ', 'O1D ', 'O2_1D ', 'O2_1S ', & - 'O2p ', 'OH ', 'Op ', 'Op2D ', 'Op2P ' /) + slvd_lst(: 14) = (/ 'e ', 'HO2 ', 'N2D ', 'N2p ', 'NOp ', & + 'Np ', 'O1D ', 'O2_1D ', 'O2_1S ', 'O2p ', & + 'OH ', 'Op ', 'Op2D ', 'Op2P ' /) if( allocated( rxt_tag_lst ) ) then deallocate( rxt_tag_lst ) diff --git a/src/chemistry/pp_waccm_ma_mam4/chem_mech.doc b/src/chemistry/pp_waccm_ma_mam4/chem_mech.doc index 894fd376eb..c4decb21d4 100644 --- a/src/chemistry/pp_waccm_ma_mam4/chem_mech.doc +++ b/src/chemistry/pp_waccm_ma_mam4/chem_mech.doc @@ -3,89 +3,89 @@ Solution species ( 1) bc_a1 (C) ( 2) bc_a4 (C) - ( 3) BRCL (BrCl) - ( 4) BRO (BrO) - ( 5) BRONO2 (BrONO2) - ( 6) BRY - ( 7) CCL4 (CCl4) - ( 8) CF2CLBR (CF2ClBr) - ( 9) CF3BR (CF3Br) - ( 10) CFC11 (CFCl3) - ( 11) CFC113 (CCl2FCClF2) - ( 12) CFC114 (CClF2CClF2) - ( 13) CFC115 (CClF2CF3) - ( 14) CFC12 (CF2Cl2) - ( 15) CH2BR2 (CH2Br2) - ( 16) CH2O - ( 17) CH3BR (CH3Br) - ( 18) CH3CCL3 (CH3CCl3) - ( 19) CH3CL (CH3Cl) - ( 20) CH3O2 - ( 21) CH3OOH - ( 22) CH4 - ( 23) CHBR3 (CHBr3) - ( 24) CL2 (Cl2) - ( 25) CL2O2 (Cl2O2) - ( 26) CLO (ClO) - ( 27) CLONO2 (ClONO2) - ( 28) CLY - ( 29) CO - ( 30) CO2 - ( 31) COF2 - ( 32) COFCL (COFCl) - ( 33) DMS (CH3SCH3) - ( 34) dst_a1 (AlSiO5) - ( 35) dst_a2 (AlSiO5) - ( 36) dst_a3 (AlSiO5) - ( 37) F - ( 38) H - ( 39) H2 - ( 40) H2402 (CBrF2CBrF2) - ( 41) H2O2 - ( 42) H2SO4 (H2SO4) - ( 43) HBR (HBr) - ( 44) HCFC141B (CH3CCl2F) - ( 45) HCFC142B (CH3CClF2) - ( 46) HCFC22 (CHF2Cl) - ( 47) HCL (HCl) - ( 48) HF - ( 49) HNO3 - ( 50) HO2NO2 - ( 51) HOBR (HOBr) - ( 52) HOCL (HOCl) - ( 53) N - ( 54) N2O - ( 55) N2O5 - ( 56) ncl_a1 (NaCl) - ( 57) ncl_a2 (NaCl) - ( 58) ncl_a3 (NaCl) - ( 59) NO - ( 60) NO2 - ( 61) NO3 - ( 62) num_a1 (H) - ( 63) num_a2 (H) - ( 64) num_a3 (H) - ( 65) num_a4 (H) - ( 66) O - ( 67) O2 - ( 68) O3 - ( 69) OCLO (OClO) - ( 70) OCS (OCS) - ( 71) pom_a1 (C) - ( 72) pom_a4 (C) - ( 73) S (S) - ( 74) SF6 - ( 75) SO (SO) - ( 76) SO2 - ( 77) SO3 (SO3) - ( 78) so4_a1 (NH4HSO4) - ( 79) so4_a2 (NH4HSO4) - ( 80) so4_a3 (NH4HSO4) - ( 81) soa_a1 (C) - ( 82) soa_a2 (C) - ( 83) SOAG (C) - ( 84) BR (Br) - ( 85) CL (Cl) + ( 3) BR (Br) + ( 4) BRCL (BrCl) + ( 5) BRO (BrO) + ( 6) BRONO2 (BrONO2) + ( 7) BRY + ( 8) CCL4 (CCl4) + ( 9) CF2CLBR (CF2ClBr) + ( 10) CF3BR (CF3Br) + ( 11) CFC11 (CFCl3) + ( 12) CFC113 (CCl2FCClF2) + ( 13) CFC114 (CClF2CClF2) + ( 14) CFC115 (CClF2CF3) + ( 15) CFC12 (CF2Cl2) + ( 16) CH2BR2 (CH2Br2) + ( 17) CH2O + ( 18) CH3BR (CH3Br) + ( 19) CH3CCL3 (CH3CCl3) + ( 20) CH3CL (CH3Cl) + ( 21) CH3O2 + ( 22) CH3OOH + ( 23) CH4 + ( 24) CHBR3 (CHBr3) + ( 25) CL (Cl) + ( 26) CL2 (Cl2) + ( 27) CL2O2 (Cl2O2) + ( 28) CLO (ClO) + ( 29) CLONO2 (ClONO2) + ( 30) CLY + ( 31) CO + ( 32) CO2 + ( 33) COF2 + ( 34) COFCL (COFCl) + ( 35) DMS (CH3SCH3) + ( 36) dst_a1 (AlSiO5) + ( 37) dst_a2 (AlSiO5) + ( 38) dst_a3 (AlSiO5) + ( 39) F + ( 40) H + ( 41) H2 + ( 42) H2402 (CBrF2CBrF2) + ( 43) H2O2 + ( 44) H2SO4 (H2SO4) + ( 45) HBR (HBr) + ( 46) HCFC141B (CH3CCl2F) + ( 47) HCFC142B (CH3CClF2) + ( 48) HCFC22 (CHF2Cl) + ( 49) HCL (HCl) + ( 50) HF + ( 51) HNO3 + ( 52) HO2NO2 + ( 53) HOBR (HOBr) + ( 54) HOCL (HOCl) + ( 55) N + ( 56) N2O + ( 57) N2O5 + ( 58) ncl_a1 (NaCl) + ( 59) ncl_a2 (NaCl) + ( 60) ncl_a3 (NaCl) + ( 61) NO + ( 62) NO2 + ( 63) NO3 + ( 64) num_a1 (H) + ( 65) num_a2 (H) + ( 66) num_a3 (H) + ( 67) num_a4 (H) + ( 68) O + ( 69) O2 + ( 70) O3 + ( 71) OCLO (OClO) + ( 72) OCS (OCS) + ( 73) pom_a1 (C) + ( 74) pom_a4 (C) + ( 75) S (S) + ( 76) SF6 + ( 77) SO (SO) + ( 78) SO2 + ( 79) SO3 (SO3) + ( 80) so4_a1 (NH4HSO4) + ( 81) so4_a2 (NH4HSO4) + ( 82) so4_a3 (NH4HSO4) + ( 83) soa_a1 (C) + ( 84) soa_a2 (C) + ( 85) SOAG (C) ( 86) e (E) ( 87) HO2 ( 88) N2D (N) @@ -114,111 +114,109 @@ Class List ========== - Explicit - -------- - ( 1) BRY - ( 2) CCL4 - ( 3) CF2CLBR - ( 4) CF3BR - ( 5) CFC11 - ( 6) CFC113 - ( 7) CFC114 - ( 8) CFC115 - ( 9) CFC12 - ( 10) CH2BR2 - ( 11) CH3BR - ( 12) CH3CCL3 - ( 13) CH3CL - ( 14) CH4 - ( 15) CHBR3 - ( 16) CLY - ( 17) CO2 - ( 18) H2402 - ( 19) HCFC141B - ( 20) HCFC142B - ( 21) HCFC22 - ( 22) N2O - ( 23) SF6 Implicit -------- ( 1) bc_a1 ( 2) bc_a4 - ( 3) BRCL - ( 4) BRO - ( 5) BRONO2 - ( 6) CH2O - ( 7) CH3O2 - ( 8) CH3OOH - ( 9) CL2 - ( 10) CL2O2 - ( 11) CLO - ( 12) CLONO2 - ( 13) CO - ( 14) COF2 - ( 15) COFCL - ( 16) DMS - ( 17) dst_a1 - ( 18) dst_a2 - ( 19) dst_a3 - ( 20) F - ( 21) H - ( 22) H2 - ( 23) H2O2 - ( 24) H2SO4 - ( 25) HBR - ( 26) HCL - ( 27) HF - ( 28) HNO3 - ( 29) HO2NO2 - ( 30) HOBR - ( 31) HOCL - ( 32) N - ( 33) N2O5 - ( 34) ncl_a1 - ( 35) ncl_a2 - ( 36) ncl_a3 - ( 37) NO - ( 38) NO2 - ( 39) NO3 - ( 40) num_a1 - ( 41) num_a2 - ( 42) num_a3 - ( 43) num_a4 - ( 44) O - ( 45) O2 - ( 46) O3 - ( 47) OCLO - ( 48) OCS - ( 49) pom_a1 - ( 50) pom_a4 - ( 51) S - ( 52) SO - ( 53) SO2 - ( 54) SO3 - ( 55) so4_a1 - ( 56) so4_a2 - ( 57) so4_a3 - ( 58) soa_a1 - ( 59) soa_a2 - ( 60) SOAG - ( 61) BR - ( 62) CL - ( 63) e - ( 64) HO2 - ( 65) N2D - ( 66) N2p - ( 67) NOp - ( 68) Np - ( 69) O1D - ( 70) O2_1D - ( 71) O2_1S - ( 72) O2p - ( 73) OH - ( 74) Op - ( 75) Op2D - ( 76) Op2P - ( 77) H2O + ( 3) BR + ( 4) BRCL + ( 5) BRO + ( 6) BRONO2 + ( 7) BRY + ( 8) CCL4 + ( 9) CF2CLBR + ( 10) CF3BR + ( 11) CFC11 + ( 12) CFC113 + ( 13) CFC114 + ( 14) CFC115 + ( 15) CFC12 + ( 16) CH2BR2 + ( 17) CH2O + ( 18) CH3BR + ( 19) CH3CCL3 + ( 20) CH3CL + ( 21) CH3O2 + ( 22) CH3OOH + ( 23) CH4 + ( 24) CHBR3 + ( 25) CL + ( 26) CL2 + ( 27) CL2O2 + ( 28) CLO + ( 29) CLONO2 + ( 30) CLY + ( 31) CO + ( 32) CO2 + ( 33) COF2 + ( 34) COFCL + ( 35) DMS + ( 36) dst_a1 + ( 37) dst_a2 + ( 38) dst_a3 + ( 39) F + ( 40) H + ( 41) H2 + ( 42) H2402 + ( 43) H2O2 + ( 44) H2SO4 + ( 45) HBR + ( 46) HCFC141B + ( 47) HCFC142B + ( 48) HCFC22 + ( 49) HCL + ( 50) HF + ( 51) HNO3 + ( 52) HO2NO2 + ( 53) HOBR + ( 54) HOCL + ( 55) N + ( 56) N2O + ( 57) N2O5 + ( 58) ncl_a1 + ( 59) ncl_a2 + ( 60) ncl_a3 + ( 61) NO + ( 62) NO2 + ( 63) NO3 + ( 64) num_a1 + ( 65) num_a2 + ( 66) num_a3 + ( 67) num_a4 + ( 68) O + ( 69) O2 + ( 70) O3 + ( 71) OCLO + ( 72) OCS + ( 73) pom_a1 + ( 74) pom_a4 + ( 75) S + ( 76) SF6 + ( 77) SO + ( 78) SO2 + ( 79) SO3 + ( 80) so4_a1 + ( 81) so4_a2 + ( 82) so4_a3 + ( 83) soa_a1 + ( 84) soa_a2 + ( 85) SOAG + ( 86) e + ( 87) HO2 + ( 88) N2D + ( 89) N2p + ( 90) NOp + ( 91) Np + ( 92) O1D + ( 93) O2_1D + ( 94) O2_1S + ( 95) O2p + ( 96) OH + ( 97) Op + ( 98) Op2D + ( 99) Op2P + (100) H2O Photolysis jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) @@ -339,8 +337,8 @@ Class List H_HO2 ( 22) H + HO2 -> H2 + O2 rate = 6.90E-12 (113) H_HO2a ( 23) H + HO2 -> 2*OH rate = 7.20E-11 (114) H_HO2b ( 24) H + HO2 -> H2O + O rate = 1.60E-12 (115) - H_O2 ( 25) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (116) - ki=7.50E-11*(300/t)**-0.20 + H_O2 ( 25) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (116) + ki=9.50E-11*(300/t)**-0.40 f=0.60 HO2_O ( 26) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (117) HO2_O3 ( 27) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (118) @@ -355,25 +353,25 @@ Class List ki=2.60E-11 f=0.60 usr_HO2_HO2 ( 36) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (127) - HO2NO2_OH ( 37) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (128) + HO2NO2_OH ( 37) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (128) N2D_O ( 38) N2D + O -> N + O rate = 7.00E-13 (129) N2D_O2 ( 39) N2D + O2 -> NO + O1D rate = 5.00E-12 (130) N_NO ( 40) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (131) N_NO2a ( 41) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (132) N_NO2b ( 42) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (133) N_NO2c ( 43) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (134) - N_O2 ( 44) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (135) + N_O2 ( 44) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (135) NO2_O ( 45) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (136) NO2_O3 ( 46) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (137) NO2_O_M ( 47) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (138) ki=2.20E-11*(300/t)**0.70 f=0.60 NO3_HO2 ( 48) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (139) - NO3_NO ( 49) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (140) - NO3_O ( 50) NO3 + O -> NO2 + O2 rate = 1.00E-11 (141) + NO3_NO ( 49) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (140) + NO3_O ( 50) NO3 + O -> NO2 + O2 rate = 1.30E-11 (141) NO3_OH ( 51) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (142) N_OH ( 52) N + OH -> NO + H rate = 5.00E-11 (143) - NO_HO2 ( 53) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (144) + NO_HO2 ( 53) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (144) NO_O3 ( 54) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (145) NO_O_M ( 55) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (146) ki=3.00E-11 @@ -466,7 +464,7 @@ Class List CH3BR_CL (129) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (220) CH3BR_OH (130) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (221) CH3CCL3_OH (131) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (222) - CH3CL_CL (132) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (223) + CH3CL_CL (132) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1110./t) (223) CH3CL_OH (133) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (224) CHBR3_CL (134) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (225) CHBR3_OH (135) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (226) @@ -485,79 +483,78 @@ Class List CH3O2_NO (148) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (239) CH3OOH_OH (149) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (240) CH4_OH (150) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (241) - CO_OH_M (151) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.00 (242) - ki=1.10E-12*(300/t)**-1.30 + O1D_CH4a (151) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (242) + O1D_CH4b (152) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (243) + O1D_CH4c (153) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (244) + usr_CO_OH (154) CO + OH -> CO2 + HO2 rate = ** User defined ** (245) + DMS_NO3 (155) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (246) + DMS_OHa (156) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (247) + OCS_O (157) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (248) + OCS_OH (158) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (249) + S_O2 (159) S + O2 -> SO + O rate = 2.30E-12 (250) + SO2_OH_M (160) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (251) + ki=1.70E-12*(300/t)**-0.20 f=0.60 - O1D_CH4a (152) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (243) - O1D_CH4b (153) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (244) - O1D_CH4c (154) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (245) - usr_CO_OH_b (155) CO + OH -> CO2 + H rate = ** User defined ** (246) - OCS_O (156) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (247) - OCS_OH (157) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (248) - S_O2 (158) S + O2 -> SO + O rate = 2.30E-12 (249) - S_O3 (159) S + O3 -> SO + O2 rate = 1.20E-11 (250) - SO_BRO (160) SO + BRO -> SO2 + BR rate = 5.70E-11 (251) - SO_CLO (161) SO + CLO -> SO2 + CL rate = 2.80E-11 (252) - S_OH (162) S + OH -> SO + H rate = 6.60E-11 (253) - SO_NO2 (163) SO + NO2 -> SO2 + NO rate = 1.40E-11 (254) - SO_O2 (164) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (255) - SO_O3 (165) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (256) - SO_OCLO (166) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (257) - SO_OH (167) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (258) - usr_SO2_OH (168) SO2 + OH -> SO3 + HO2 rate = ** User defined ** (259) - usr_SO3_H2O (169) SO3 + H2O -> H2SO4 rate = ** User defined ** (260) - DMS_NO3 (170) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (261) - DMS_OHa (171) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (262) - usr_DMS_OH (172) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (263) - usr_HO2_aer (173) HO2 -> 0.5*H2O2 rate = ** User defined ** (264) - usr_N2O5_aer (174) N2O5 -> 2*HNO3 rate = ** User defined ** (265) - usr_NO2_aer (175) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (266) - usr_NO3_aer (176) NO3 -> HNO3 rate = ** User defined ** (267) - het1 (177) N2O5 -> 2*HNO3 rate = ** User defined ** (268) - het10 (178) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (269) - het11 (179) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (270) - het12 (180) N2O5 -> 2*HNO3 rate = ** User defined ** (271) - het13 (181) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (272) - het14 (182) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (273) - het15 (183) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (274) - het16 (184) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (275) - het17 (185) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (276) - het2 (186) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (277) - het3 (187) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (278) - het4 (188) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (279) - het5 (189) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (280) - het6 (190) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (281) - het7 (191) N2O5 -> 2*HNO3 rate = ** User defined ** (282) - het8 (192) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (283) - het9 (193) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (284) - ag247nm (194) Op2P -> Op rate = 4.70E-02 (285) - ag373nm (195) Op2D -> Op rate = 7.70E-05 (286) - ag732nm (196) Op2P -> Op2D rate = 1.71E-01 (287) - elec1 (197) NOp + e -> 0.2*N + 0.8*N2D + O rate = ** User defined ** (288) - elec2 (198) O2p + e -> 1.15*O + 0.85*O1D rate = ** User defined ** (289) - elec3 (199) N2p + e -> 1.1*N + 0.9*N2D rate = ** User defined ** (290) - ion_N2p_O2 (200) N2p + O2 -> O2p + N2 rate = 6.00E-11 (291) - ion_N2p_Oa (201) N2p + O -> NOp + N2D rate = ** User defined ** (292) - ion_N2p_Ob (202) N2p + O -> Op + N2 rate = ** User defined ** (293) - ion_Np_O (203) Np + O -> Op + N rate = 1.00E-12 (294) - ion_Np_O2a (204) Np + O2 -> O2p + N rate = 4.00E-10 (295) - ion_Np_O2b (205) Np + O2 -> NOp + O rate = 2.00E-10 (296) - ion_O2p_N (206) O2p + N -> NOp + O rate = 1.00E-10 (297) - ion_O2p_N2 (207) O2p + N2 -> NOp + NO rate = 5.00E-16 (298) - ion_O2p_NO (208) O2p + NO -> NOp + O2 rate = 4.40E-10 (299) - ion_Op_CO2 (209) Op + CO2 -> O2p + CO rate = 9.00E-10 (300) - ion_Op_N2 (210) Op + N2 -> NOp + N rate = ** User defined ** (301) - ion_Op_N2D (211) Op + N2D -> Np + O rate = 1.30E-10 (302) - ion_Op_O2 (212) Op + O2 -> O2p + O rate = ** User defined ** (303) - Op2D_e (213) Op2D + e -> Op + e rate = ** User defined ** (304) - Op2D_N2 (214) Op2D + N2 -> N2p + O rate = 8.00E-10 (305) - Op2D_O (215) Op2D + O -> Op + O rate = 5.00E-12 (306) - Op2D_O2 (216) Op2D + O2 -> O2p + O rate = 7.00E-10 (307) - Op2P_ea (217) Op2P + e -> Op2D + e rate = ** User defined ** (308) - Op2P_eb (218) Op2P + e -> Op + e rate = ** User defined ** (309) - Op2P_N2a (219) Op2P + N2 -> N2p + O rate = 4.80E-10 (310) - Op2P_N2b (220) Op2P + N2 -> Np + NO rate = 1.00E-10 (311) - Op2P_O (221) Op2P + O -> Op + O rate = 4.00E-10 (312) + S_O3 (161) S + O3 -> SO + O2 rate = 1.20E-11 (252) + SO_BRO (162) SO + BRO -> SO2 + BR rate = 5.70E-11 (253) + SO_CLO (163) SO + CLO -> SO2 + CL rate = 2.80E-11 (254) + S_OH (164) S + OH -> SO + H rate = 6.60E-11 (255) + SO_NO2 (165) SO + NO2 -> SO2 + NO rate = 1.40E-11 (256) + SO_O2 (166) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (257) + SO_O3 (167) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (258) + SO_OCLO (168) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (259) + SO_OH (169) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (260) + usr_DMS_OH (170) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (261) + usr_SO3_H2O (171) SO3 + H2O -> H2SO4 rate = ** User defined ** (262) + usr_HO2_aer (172) HO2 -> 0.5*H2O2 rate = ** User defined ** (263) + usr_N2O5_aer (173) N2O5 -> 2*HNO3 rate = ** User defined ** (264) + usr_NO2_aer (174) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (265) + usr_NO3_aer (175) NO3 -> HNO3 rate = ** User defined ** (266) + het1 (176) N2O5 -> 2*HNO3 rate = ** User defined ** (267) + het10 (177) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (268) + het11 (178) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (269) + het12 (179) N2O5 -> 2*HNO3 rate = ** User defined ** (270) + het13 (180) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (271) + het14 (181) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (272) + het15 (182) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (273) + het16 (183) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (274) + het17 (184) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (275) + het2 (185) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (276) + het3 (186) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (277) + het4 (187) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (278) + het5 (188) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (279) + het6 (189) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (280) + het7 (190) N2O5 -> 2*HNO3 rate = ** User defined ** (281) + het8 (191) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (282) + het9 (192) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (283) + ag247nm (193) Op2P -> Op rate = 4.70E-02 (284) + ag373nm (194) Op2D -> Op rate = 7.70E-05 (285) + ag732nm (195) Op2P -> Op2D rate = 1.71E-01 (286) + elec1 (196) NOp + e -> 0.2*N + 0.8*N2D + O rate = ** User defined ** (287) + elec2 (197) O2p + e -> 1.15*O + 0.85*O1D rate = ** User defined ** (288) + elec3 (198) N2p + e -> 1.1*N + 0.9*N2D rate = ** User defined ** (289) + ion_N2p_O2 (199) N2p + O2 -> O2p + N2 rate = 6.00E-11 (290) + ion_N2p_Oa (200) N2p + O -> NOp + N2D rate = ** User defined ** (291) + ion_N2p_Ob (201) N2p + O -> Op + N2 rate = ** User defined ** (292) + ion_Np_O (202) Np + O -> Op + N rate = 1.00E-12 (293) + ion_Np_O2a (203) Np + O2 -> O2p + N rate = 4.00E-10 (294) + ion_Np_O2b (204) Np + O2 -> NOp + O rate = 2.00E-10 (295) + ion_O2p_N (205) O2p + N -> NOp + O rate = 1.00E-10 (296) + ion_O2p_N2 (206) O2p + N2 -> NOp + NO rate = 5.00E-16 (297) + ion_O2p_NO (207) O2p + NO -> NOp + O2 rate = 4.40E-10 (298) + ion_Op_CO2 (208) Op + CO2 -> O2p + CO rate = 9.00E-10 (299) + ion_Op_N2 (209) Op + N2 -> NOp + N rate = ** User defined ** (300) + ion_Op_N2D (210) Op + N2D -> Np + O rate = 1.30E-10 (301) + ion_Op_O2 (211) Op + O2 -> O2p + O rate = ** User defined ** (302) + Op2D_e (212) Op2D + e -> Op + e rate = ** User defined ** (303) + Op2D_N2 (213) Op2D + N2 -> N2p + O rate = 8.00E-10 (304) + Op2D_O (214) Op2D + O -> Op + O rate = 5.00E-12 (305) + Op2D_O2 (215) Op2D + O2 -> O2p + O rate = 7.00E-10 (306) + Op2P_ea (216) Op2P + e -> Op2D + e rate = ** User defined ** (307) + Op2P_eb (217) Op2P + e -> Op + e rate = ** User defined ** (308) + Op2P_N2a (218) Op2P + N2 -> N2p + O rate = 4.80E-10 (309) + Op2P_N2b (219) Op2P + N2 -> Np + NO rate = 1.00E-10 (310) + Op2P_O (220) Op2P + O -> Op + O rate = 4.00E-10 (311) Extraneous prod/loss species ( 1) so4_a2 (dataset) @@ -588,13 +585,20 @@ Extraneous prod/loss species d(bc_a1)/dt = 0 d(bc_a4)/dt = 0 - d(BRCL)/dt = r106*BRO*CLO + r185*HOBR*HCL + r190*HOBR*HCL + d(BR)/dt = j26*BRCL + j27*BRO + j29*BRONO2 + j31*CF2CLBR + j32*CF3BR + 2*j38*CH2BR2 + j39*CH3BR + + 3*j42*CHBR3 + 2*j50*H2402 + j51*HBR + j57*HOBR + r90*O1D*CF2CLBR + 2*r103*BRO*BRO + + r104*BRO*CLO + r105*BRO*CLO + r108*BRO*NO + r111*BRO*O + r112*BRO*OH + r113*HBR*O + + r114*HBR*OH + r116*O1D*CF3BR + 3*r117*O1D*CHBR3 + 2*r118*O1D*H2402 + r119*O1D*HBR + + 2*r127*CH2BR2*CL + 2*r128*CH2BR2*OH + r129*CH3BR*CL + r130*CH3BR*OH + 3*r134*CHBR3*CL + + 3*r135*CHBR3*OH + 2*r139*O1D*CH2BR2 + r140*O1D*CH3BR + r162*SO*BRO + - r100*CH2O*BR - r101*HO2*BR - r102*O3*BR + d(BRCL)/dt = r106*BRO*CLO + r184*HOBR*HCL + r189*HOBR*HCL - j26*BRCL d(BRO)/dt = j28*BRONO2 + r102*BR*O3 + r110*BRONO2*O + r115*HOBR*O + r120*O1D*HBR - j27*BRO - 2*r103*BRO*BRO - r104*CLO*BRO - r105*CLO*BRO - r106*CLO*BRO - r107*HO2*BRO - - r108*NO*BRO - r109*M*NO2*BRO - r111*O*BRO - r112*OH*BRO - r160*SO*BRO + - r108*NO*BRO - r109*M*NO2*BRO - r111*O*BRO - r112*OH*BRO - r162*SO*BRO d(BRONO2)/dt = r109*M*BRO*NO2 - - j28*BRONO2 - j29*BRONO2 - r179*BRONO2 - r182*BRONO2 - r187*BRONO2 - r110*O*BRONO2 + - j28*BRONO2 - j29*BRONO2 - r178*BRONO2 - r181*BRONO2 - r186*BRONO2 - r110*O*BRONO2 d(BRY)/dt = 0 d(CCL4)/dt = - j30*CCL4 - r89*O1D*CCL4 d(CF2CLBR)/dt = - j31*CF2CLBR - r90*O1D*CF2CLBR @@ -605,41 +609,51 @@ Extraneous prod/loss species d(CFC115)/dt = - j36*CFC115 - r94*O1D*CFC115 d(CFC12)/dt = - j37*CFC12 - r95*O1D*CFC12 d(CH2BR2)/dt = - j38*CH2BR2 - r127*CL*CH2BR2 - r128*OH*CH2BR2 - r139*O1D*CH2BR2 - d(CH2O)/dt = j22*CH3OOH + .18*j24*CH4 + r71*CLO*CH3O2 + r148*CH3O2*NO + .3*r149*CH3OOH*OH + r153*O1D*CH4 - + r154*O1D*CH4 + d(CH2O)/dt = j22*CH3OOH + .18*j24*CH4 + r71*CLO*CH3O2 + r148*CH3O2*NO + .3*r149*CH3OOH*OH + r152*O1D*CH4 + + r153*O1D*CH4 - j20*CH2O - j21*CH2O - r64*CL*CH2O - r100*BR*CH2O - r144*NO3*CH2O - r145*O*CH2O - r146*OH*CH2O d(CH3BR)/dt = - j39*CH3BR - r129*CL*CH3BR - r130*OH*CH3BR - r140*O1D*CH3BR d(CH3CCL3)/dt = - j40*CH3CCL3 - r131*OH*CH3CCL3 d(CH3CL)/dt = - j41*CH3CL - r132*CL*CH3CL - r133*OH*CH3CL d(CH3O2)/dt = j23*CH4 + j39*CH3BR + j41*CH3CL + r65*CL*CH4 + r121*F*CH4 + .7*r149*CH3OOH*OH + r150*CH4*OH - + r152*O1D*CH4 + + r151*O1D*CH4 - r71*CLO*CH3O2 - r147*HO2*CH3O2 - r148*NO*CH3O2 d(CH3OOH)/dt = r147*CH3O2*HO2 - j22*CH3OOH - r149*OH*CH3OOH - d(CH4)/dt = - j23*CH4 - j24*CH4 - r65*CL*CH4 - r121*F*CH4 - r150*OH*CH4 - r152*O1D*CH4 - r153*O1D*CH4 - - r154*O1D*CH4 + d(CH4)/dt = - j23*CH4 - j24*CH4 - r65*CL*CH4 - r121*F*CH4 - r150*OH*CH4 - r151*O1D*CH4 - r152*O1D*CH4 + - r153*O1D*CH4 d(CHBR3)/dt = - j42*CHBR3 - r117*O1D*CHBR3 - r134*CL*CHBR3 - r135*OH*CHBR3 - d(CL2)/dt = r73*CLO*CLO + r77*CLONO2*CL + r178*HOCL*HCL + r183*CLONO2*HCL + r184*HOCL*HCL + r188*CLONO2*HCL - + r189*HOCL*HCL + r193*CLONO2*HCL + d(CL)/dt = j26*BRCL + 4*j30*CCL4 + j31*CF2CLBR + 2*j33*CFC11 + 2*j34*CFC113 + 2*j35*CFC114 + j36*CFC115 + + 2*j37*CFC12 + 3*j40*CH3CCL3 + j41*CH3CL + 2*j43*CL2 + 2*j44*CL2O2 + j45*CLO + j46*CLONO2 + + j49*COFCL + j52*HCFC141B + j53*HCFC142B + j54*HCFC22 + j55*HCL + j58*HOCL + r71*CLO*CH3O2 + + 2*r72*CLO*CLO + r74*CLO*CLO + r76*CLO*NO + r81*CLO*O + r82*CLO*OH + r84*HCL*O + r85*HCL*OH + + 4*r89*O1D*CCL4 + r90*O1D*CF2CLBR + 2*r91*O1D*CFC11 + 2*r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + r94*O1D*CFC115 + 2*r95*O1D*CFC12 + r96*O1D*HCL + r105*BRO*CLO + r126*O1D*COFCL + + 3*r131*CH3CCL3*OH + r133*CH3CL*OH + r136*HCFC141B*OH + r137*HCFC142B*OH + r138*HCFC22*OH + + r141*O1D*HCFC141B + r142*O1D*HCFC142B + r143*O1D*HCFC22 + r163*SO*CLO + - r64*CH2O*CL - r65*CH4*CL - r66*H2*CL - r67*H2O2*CL - r68*HO2*CL - r69*HO2*CL - r70*O3*CL + - r77*CLONO2*CL - r86*HOCL*CL - r127*CH2BR2*CL - r129*CH3BR*CL - r132*CH3CL*CL - r134*CHBR3*CL + d(CL2)/dt = r73*CLO*CLO + r77*CLONO2*CL + r177*HOCL*HCL + r182*CLONO2*HCL + r183*HOCL*HCL + r187*CLONO2*HCL + + r188*HOCL*HCL + r192*CLONO2*HCL - j43*CL2 d(CL2O2)/dt = r98*M*CLO*CLO - j44*CL2O2 - r99*M*CL2O2 d(CLO)/dt = j47*CLONO2 + j59*OCLO + r99*M*CL2O2 + r99*M*CL2O2 + r69*CL*HO2 + r70*CL*O3 + r79*CLONO2*O - + r86*HOCL*CL + r87*HOCL*O + r88*HOCL*OH + r97*O1D*HCL + r166*SO*OCLO + + r86*HOCL*CL + r87*HOCL*O + r88*HOCL*OH + r97*O1D*HCL + r168*SO*OCLO - j45*CLO - r71*CH3O2*CLO - 2*r72*CLO*CLO - 2*r73*CLO*CLO - 2*r74*CLO*CLO - r75*HO2*CLO - r76*NO*CLO - r78*M*NO2*CLO - r81*O*CLO - r82*OH*CLO - r83*OH*CLO - 2*r98*M*CLO*CLO - - r104*BRO*CLO - r105*BRO*CLO - r106*BRO*CLO - r161*SO*CLO + - r104*BRO*CLO - r105*BRO*CLO - r106*BRO*CLO - r163*SO*CLO d(CLONO2)/dt = r78*M*CLO*NO2 - - j46*CLONO2 - j47*CLONO2 - r181*CLONO2 - r186*CLONO2 - r192*CLONO2 - r77*CL*CLONO2 - - r79*O*CLONO2 - r80*OH*CLONO2 - r183*HCL*CLONO2 - r188*HCL*CLONO2 - r193*HCL*CLONO2 + - j46*CLONO2 - j47*CLONO2 - r180*CLONO2 - r185*CLONO2 - r191*CLONO2 - r77*CL*CLONO2 + - r79*O*CLONO2 - r80*OH*CLONO2 - r182*HCL*CLONO2 - r187*HCL*CLONO2 - r192*HCL*CLONO2 d(CLY)/dt = 0 d(CO)/dt = j20*CH2O + j21*CH2O + .38*j24*CH4 + j25*CO2 + j61*CO2 + j88*OCS + r64*CL*CH2O + r100*BR*CH2O - + r132*CH3CL*CL + r144*CH2O*NO3 + r145*CH2O*O + r146*CH2O*OH + r156*OCS*O + r157*OCS*OH - + r209*Op*CO2 - - r151*M*OH*CO - r155*OH*CO - d(CO2)/dt = .44*j24*CH4 + r151*M*CO*OH + r155*CO*OH - - j25*CO2 - j61*CO2 - r209*Op*CO2 + + r132*CH3CL*CL + r144*CH2O*NO3 + r145*CH2O*O + r146*CH2O*OH + r157*OCS*O + r158*OCS*OH + + r208*Op*CO2 + - r154*OH*CO + d(CO2)/dt = .44*j24*CH4 + r154*CO*OH + - j25*CO2 - j61*CO2 - r208*Op*CO2 d(COF2)/dt = j31*CF2CLBR + j32*CF3BR + j34*CFC113 + 2*j35*CFC114 + 2*j36*CFC115 + j37*CFC12 + 2*j50*H2402 + j53*HCFC142B + j54*HCFC22 + r90*O1D*CF2CLBR + r92*O1D*CFC113 + 2*r93*O1D*CFC114 + 2*r94*O1D*CFC115 + r95*O1D*CFC12 + r116*O1D*CF3BR + 2*r118*O1D*H2402 + r137*HCFC142B*OH @@ -648,7 +662,7 @@ Extraneous prod/loss species d(COFCL)/dt = j33*CFC11 + j34*CFC113 + j52*HCFC141B + r91*O1D*CFC11 + r92*O1D*CFC113 + r136*HCFC141B*OH + r141*O1D*HCFC141B - j49*COFCL - r126*O1D*COFCL - d(DMS)/dt = - r170*NO3*DMS - r171*OH*DMS - r172*OH*DMS + d(DMS)/dt = - r155*NO3*DMS - r156*OH*DMS - r170*OH*DMS d(dst_a1)/dt = 0 d(dst_a2)/dt = 0 d(dst_a3)/dt = 0 @@ -657,15 +671,14 @@ Extraneous prod/loss species - r121*CH4*F - r122*H2*F - r123*H2O*F - r124*HNO3*F d(H)/dt = 2*j2*H2O + j3*H2O + 2*j20*CH2O + j22*CH3OOH + j23*CH4 + .33*j24*CH4 + j51*HBR + j55*HCL + j56*HF + r3*O1D*H2 + r20*H2*O + r29*OH*H2 + r32*OH*O + r52*N*OH + r66*CL*H2 + r97*O1D*HCL - + r120*O1D*HBR + r122*F*H2 + r146*CH2O*OH + r153*O1D*CH4 + r155*CO*OH + r157*OCS*OH + r162*S*OH - + r167*SO*OH + + r120*O1D*HBR + r122*F*H2 + r146*CH2O*OH + r152*O1D*CH4 + r158*OCS*OH + r164*S*OH + r169*SO*OH - r22*HO2*H - r23*HO2*H - r24*HO2*H - r25*M*O2*H - r28*O3*H - d(H2)/dt = j1*H2O + j21*CH2O + 1.4400001*j24*CH4 + r22*H*HO2 + r154*O1D*CH4 + d(H2)/dt = j1*H2O + j21*CH2O + 1.4400001*j24*CH4 + r22*H*HO2 + r153*O1D*CH4 - r3*O1D*H2 - r20*O*H2 - r29*OH*H2 - r66*CL*H2 - r122*F*H2 d(H2402)/dt = - j50*H2402 - r118*O1D*H2402 - d(H2O2)/dt = .5*r173*HO2 + r35*M*OH*OH + r36*HO2*HO2 + d(H2O2)/dt = .5*r172*HO2 + r35*M*OH*OH + r36*HO2*HO2 - j4*H2O2 - r21*O*H2O2 - r30*OH*H2O2 - r67*CL*H2O2 - d(H2SO4)/dt = r169*SO3*H2O + d(H2SO4)/dt = r171*SO3*H2O - j87*H2SO4 d(HBR)/dt = r100*BR*CH2O + r101*BR*HO2 - j51*HBR - r113*O*HBR - r114*OH*HBR - r119*O1D*HBR - r120*O1D*HBR @@ -674,168 +687,151 @@ Extraneous prod/loss species d(HCFC22)/dt = - j54*HCFC22 - r138*OH*HCFC22 - r143*O1D*HCFC22 d(HCL)/dt = r64*CL*CH2O + r65*CL*CH4 + r66*CL*H2 + r67*CL*H2O2 + r68*CL*HO2 + r83*CLO*OH + r86*HOCL*CL + r127*CH2BR2*CL + r129*CH3BR*CL + 2*r132*CH3CL*CL + r134*CHBR3*CL - - j55*HCL - r84*O*HCL - r85*OH*HCL - r96*O1D*HCL - r97*O1D*HCL - r178*HOCL*HCL - - r183*CLONO2*HCL - r184*HOCL*HCL - r185*HOBR*HCL - r188*CLONO2*HCL - r189*HOCL*HCL - - r190*HOBR*HCL - r193*CLONO2*HCL + - j55*HCL - r84*O*HCL - r85*OH*HCL - r96*O1D*HCL - r97*O1D*HCL - r177*HOCL*HCL + - r182*CLONO2*HCL - r183*HOCL*HCL - r184*HOBR*HCL - r187*CLONO2*HCL - r188*HOCL*HCL + - r189*HOBR*HCL - r192*CLONO2*HCL d(HF)/dt = r121*F*CH4 + r122*F*H2 + r123*F*H2O + r124*F*HNO3 - j56*HF - d(HNO3)/dt = 2*r174*N2O5 + .5*r175*NO2 + r176*NO3 + 2*r177*N2O5 + r179*BRONO2 + 2*r180*N2O5 + r181*CLONO2 - + r182*BRONO2 + r186*CLONO2 + r187*BRONO2 + 2*r191*N2O5 + r192*CLONO2 + r60*M*NO2*OH - + r144*CH2O*NO3 + r170*DMS*NO3 + r183*CLONO2*HCL + r188*CLONO2*HCL + r193*CLONO2*HCL + d(HNO3)/dt = 2*r173*N2O5 + .5*r174*NO2 + r175*NO3 + 2*r176*N2O5 + r178*BRONO2 + 2*r179*N2O5 + r180*CLONO2 + + r181*BRONO2 + r185*CLONO2 + r186*BRONO2 + 2*r190*N2O5 + r191*CLONO2 + r60*M*NO2*OH + + r144*CH2O*NO3 + r155*DMS*NO3 + r182*CLONO2*HCL + r187*CLONO2*HCL + r192*CLONO2*HCL - j9*HNO3 - r61*OH*HNO3 - r124*F*HNO3 d(HO2NO2)/dt = r58*M*NO2*HO2 - j10*HO2NO2 - j11*HO2NO2 - r62*M*HO2NO2 - r37*OH*HO2NO2 - d(HOBR)/dt = r179*BRONO2 + r182*BRONO2 + r187*BRONO2 + r107*BRO*HO2 - - j57*HOBR - r115*O*HOBR - r185*HCL*HOBR - r190*HCL*HOBR - d(HOCL)/dt = r181*CLONO2 + r186*CLONO2 + r192*CLONO2 + r75*CLO*HO2 + r80*CLONO2*OH - - j58*HOCL - r86*CL*HOCL - r87*O*HOCL - r88*OH*HOCL - r178*HCL*HOCL - r184*HCL*HOCL - - r189*HCL*HOCL - d(N)/dt = j64*N2 + .8*j66*N2 + .8*j68*N2 + j70*N2 + j15*NO + r210*N2*Op + r38*N2D*O + .2*r197*NOp*e - + 1.1*r199*N2p*e + r203*Np*O + r204*Np*O2 - - j62*N - r40*NO*N - r41*NO2*N - r42*NO2*N - r43*NO2*N - r44*O2*N - r52*OH*N - r206*O2p*N + d(HOBR)/dt = r178*BRONO2 + r181*BRONO2 + r186*BRONO2 + r107*BRO*HO2 + - j57*HOBR - r115*O*HOBR - r184*HCL*HOBR - r189*HCL*HOBR + d(HOCL)/dt = r180*CLONO2 + r185*CLONO2 + r191*CLONO2 + r75*CLO*HO2 + r80*CLONO2*OH + - j58*HOCL - r86*CL*HOCL - r87*O*HOCL - r88*OH*HOCL - r177*HCL*HOCL - r183*HCL*HOCL + - r188*HCL*HOCL + d(N)/dt = j64*N2 + .8*j66*N2 + .8*j68*N2 + j70*N2 + j15*NO + r209*N2*Op + r38*N2D*O + .2*r196*NOp*e + + 1.1*r198*N2p*e + r202*Np*O + r203*Np*O2 + - j62*N - r40*NO*N - r41*NO2*N - r42*NO2*N - r43*NO2*N - r44*O2*N - r52*OH*N - r205*O2p*N d(N2O)/dt = r41*N*NO2 - j12*N2O - r56*O1D*N2O - r57*O1D*N2O d(N2O5)/dt = r59*M*NO2*NO3 - - j13*N2O5 - j14*N2O5 - r63*M*N2O5 - r174*N2O5 - r177*N2O5 - r180*N2O5 - r191*N2O5 + - j13*N2O5 - j14*N2O5 - r63*M*N2O5 - r173*N2O5 - r176*N2O5 - r179*N2O5 - r190*N2O5 d(ncl_a1)/dt = 0 d(ncl_a2)/dt = 0 d(ncl_a3)/dt = 0 - d(NO)/dt = j14*N2O5 + j17*NO2 + j19*NO3 + .5*r175*NO2 + r207*N2*O2p + r220*N2*Op2P + r39*N2D*O2 - + 2*r42*N*NO2 + r44*N*O2 + r45*NO2*O + r52*N*OH + 2*r56*O1D*N2O + r163*SO*NO2 + d(NO)/dt = j14*N2O5 + j17*NO2 + j19*NO3 + .5*r174*NO2 + r206*N2*O2p + r219*N2*Op2P + r39*N2D*O2 + + 2*r42*N*NO2 + r44*N*O2 + r45*NO2*O + r52*N*OH + 2*r56*O1D*N2O + r165*SO*NO2 - j15*NO - j16*NO - r40*N*NO - r49*NO3*NO - r53*HO2*NO - r54*O3*NO - r55*M*O*NO - r76*CLO*NO - - r108*BRO*NO - r148*CH3O2*NO - r208*O2p*NO + - r108*BRO*NO - r148*CH3O2*NO - r207*O2p*NO d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j28*BRONO2 + j47*CLONO2 + r62*M*HO2NO2 + r63*M*N2O5 + r37*HO2NO2*OH + r48*NO3*HO2 + 2*r49*NO3*NO + r50*NO3*O + r51*NO3*OH + r53*NO*HO2 + r54*NO*O3 + r55*M*NO*O + r76*CLO*NO + r108*BRO*NO + r148*CH3O2*NO - - j17*NO2 - r175*NO2 - r41*N*NO2 - r42*N*NO2 - r43*N*NO2 - r45*O*NO2 - r46*O3*NO2 + - j17*NO2 - r174*NO2 - r41*N*NO2 - r42*N*NO2 - r43*N*NO2 - r45*O*NO2 - r46*O3*NO2 - r47*M*O*NO2 - r58*M*HO2*NO2 - r59*M*NO3*NO2 - r60*M*OH*NO2 - r78*M*CLO*NO2 - r109*M*BRO*NO2 - - r163*SO*NO2 + - r165*SO*NO2 d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + j29*BRONO2 + j46*CLONO2 + r63*M*N2O5 + r46*NO2*O3 + r47*M*NO2*O + r61*HNO3*OH + r77*CLONO2*CL + r79*CLONO2*O + r80*CLONO2*OH + r110*BRONO2*O + r124*F*HNO3 - - j18*NO3 - j19*NO3 - r176*NO3 - r48*HO2*NO3 - r49*NO*NO3 - r50*O*NO3 - r51*OH*NO3 - - r59*M*NO2*NO3 - r144*CH2O*NO3 - r170*DMS*NO3 + - j18*NO3 - j19*NO3 - r175*NO3 - r48*HO2*NO3 - r49*NO*NO3 - r50*O*NO3 - r51*OH*NO3 + - r59*M*NO2*NO3 - r144*CH2O*NO3 - r155*DMS*NO3 d(num_a1)/dt = 0 d(num_a2)/dt = 0 d(num_a3)/dt = 0 d(num_a4)/dt = 0 d(O)/dt = j2*H2O + 2*j5*O2 + j6*O2 + j8*O3 + j14*N2O5 + j15*NO + j17*NO2 + j18*NO3 + .18*j24*CH4 + j25*CO2 + j27*BRO + j45*CLO + j59*OCLO + j61*CO2 + j77*O2 + j79*O2 + j81*O2 + 2*j82*O2 - + 2*j83*O2 + j84*O2 + j85*O2 + j86*O2 + j89*SO + j90*SO2 + j91*SO3 + r5*N2*O1D + r214*N2*Op2D - + r219*N2*Op2P + r6*O1D*O2 + r7*O1D*O2 + r24*H*HO2 + r34*OH*OH + r40*N*NO + r41*N*NO2 + r44*N*O2 - + r158*S*O2 + r164*SO*O2 + r197*NOp*e + 1.15*r198*O2p*e + r205*Np*O2 + r206*O2p*N + r211*Op*N2D - + r212*Op*O2 + r216*Op2D*O2 + + 2*j83*O2 + j84*O2 + j85*O2 + j86*O2 + j89*SO + j90*SO2 + j91*SO3 + r5*N2*O1D + r213*N2*Op2D + + r218*N2*Op2P + r6*O1D*O2 + r7*O1D*O2 + r24*H*HO2 + r34*OH*OH + r40*N*NO + r41*N*NO2 + r44*N*O2 + + r159*S*O2 + r166*SO*O2 + r196*NOp*e + 1.15*r197*O2p*e + r204*Np*O2 + r205*O2p*N + r210*Op*N2D + + r211*Op*O2 + r215*Op2D*O2 - j71*O - j72*O - j73*O - j74*O - j75*O - j76*O - r17*O3*O - 2*r18*M*O*O - r19*M*O2*O - r20*H2*O - r21*H2O2*O - r26*HO2*O - r32*OH*O - r45*NO2*O - r47*M*NO2*O - r50*NO3*O - r55*M*NO*O - r79*CLONO2*O - r81*CLO*O - r84*HCL*O - r87*HOCL*O - r110*BRONO2*O - r111*BRO*O - - r113*HBR*O - r115*HOBR*O - r145*CH2O*O - r156*OCS*O - r201*N2p*O - r202*N2p*O - r203*Np*O + - r113*HBR*O - r115*HOBR*O - r145*CH2O*O - r157*OCS*O - r200*N2p*O - r201*N2p*O - r202*Np*O d(O2)/dt = j8*O3 + j19*NO3 + r1*O2_1D + r2*O2_1S + r9*N2*O2_1D + r8*O1D*O3 + r8*O1D*O3 + r10*O2_1D*O + 2*r11*O2_1D*O2 + 2*r17*O*O3 + r18*M*O*O + r22*H*HO2 + r26*HO2*O + 2*r27*HO2*O3 + r28*H*O3 + r31*OH*HO2 + r32*OH*O + r33*OH*O3 + r36*HO2*HO2 + r37*HO2NO2*OH + r43*N*NO2 + r45*NO2*O + r46*NO2*O3 + r48*NO3*HO2 + r50*NO3*O + r54*NO*O3 + r57*O1D*N2O + r68*CL*HO2 + r70*CL*O3 + r72*CLO*CLO + r73*CLO*CLO + r75*CLO*HO2 + r81*CLO*O + r83*CLO*OH + r101*BR*HO2 + r102*BR*O3 + r103*BRO*BRO + r105*BRO*CLO + r106*BRO*CLO + r107*BRO*HO2 + r111*BRO*O + r147*CH3O2*HO2 - + r159*S*O3 + r165*SO*O3 + r208*O2p*NO + + r161*S*O3 + r167*SO*O3 + r207*O2p*NO - j5*O2 - j6*O2 - j77*O2 - j78*O2 - j79*O2 - j80*O2 - j81*O2 - j82*O2 - j83*O2 - j84*O2 - j85*O2 - j86*O2 - r6*O1D*O2 - r11*O2_1D*O2 - r19*M*O*O2 - r25*M*H*O2 - r39*N2D*O2 - r44*N*O2 - - r158*S*O2 - r164*SO*O2 - r200*N2p*O2 - r204*Np*O2 - r205*Np*O2 - r212*Op*O2 - r216*Op2D*O2 + - r159*S*O2 - r166*SO*O2 - r199*N2p*O2 - r203*Np*O2 - r204*Np*O2 - r211*Op*O2 - r215*Op2D*O2 d(O3)/dt = r19*M*O*O2 - j7*O3 - j8*O3 - r8*O1D*O3 - r17*O*O3 - r27*HO2*O3 - r28*H*O3 - r33*OH*O3 - r46*NO2*O3 - - r54*NO*O3 - r70*CL*O3 - r102*BR*O3 - r159*S*O3 - r165*SO*O3 + - r54*NO*O3 - r70*CL*O3 - r102*BR*O3 - r161*S*O3 - r167*SO*O3 d(OCLO)/dt = r74*CLO*CLO + r104*BRO*CLO - - j59*OCLO - r166*SO*OCLO - d(OCS)/dt = - j88*OCS - r156*O*OCS - r157*OH*OCS + - j59*OCLO - r168*SO*OCLO + d(OCS)/dt = - j88*OCS - r157*O*OCS - r158*OH*OCS d(pom_a1)/dt = 0 d(pom_a4)/dt = 0 d(S)/dt = j88*OCS + j89*SO - - r158*O2*S - r159*O3*S - r162*OH*S + - r159*O2*S - r161*O3*S - r164*OH*S d(SF6)/dt = - j60*SF6 - d(SO)/dt = j90*SO2 + r156*OCS*O + r158*S*O2 + r159*S*O3 + r162*S*OH - - j89*SO - r160*BRO*SO - r161*CLO*SO - r163*NO2*SO - r164*O2*SO - r165*O3*SO - r166*OCLO*SO - - r167*OH*SO - d(SO2)/dt = j91*SO3 + r157*OCS*OH + r160*SO*BRO + r161*SO*CLO + r163*SO*NO2 + r164*SO*O2 + r165*SO*O3 - + r166*SO*OCLO + r167*SO*OH + r170*DMS*NO3 + r171*DMS*OH + .5*r172*DMS*OH - - j90*SO2 - r168*OH*SO2 - d(SO3)/dt = j87*H2SO4 + r168*SO2*OH - - j91*SO3 - r169*H2O*SO3 + d(SO)/dt = j90*SO2 + r157*OCS*O + r159*S*O2 + r161*S*O3 + r164*S*OH + - j89*SO - r162*BRO*SO - r163*CLO*SO - r165*NO2*SO - r166*O2*SO - r167*O3*SO - r168*OCLO*SO + - r169*OH*SO + d(SO2)/dt = j91*SO3 + r155*DMS*NO3 + r156*DMS*OH + r158*OCS*OH + r162*SO*BRO + r163*SO*CLO + r165*SO*NO2 + + r166*SO*O2 + r167*SO*O3 + r168*SO*OCLO + r169*SO*OH + .5*r170*DMS*OH + - j90*SO2 - r160*M*OH*SO2 + d(SO3)/dt = j87*H2SO4 + r160*M*SO2*OH + - j91*SO3 - r171*H2O*SO3 d(so4_a1)/dt = 0 d(so4_a2)/dt = 0 d(so4_a3)/dt = 0 d(soa_a1)/dt = 0 d(soa_a2)/dt = 0 d(SOAG)/dt = 0 - d(BR)/dt = j26*BRCL + j27*BRO + j29*BRONO2 + j31*CF2CLBR + j32*CF3BR + 2*j38*CH2BR2 + j39*CH3BR - + 3*j42*CHBR3 + 2*j50*H2402 + j51*HBR + j57*HOBR + r90*O1D*CF2CLBR + 2*r103*BRO*BRO - + r104*BRO*CLO + r105*BRO*CLO + r108*BRO*NO + r111*BRO*O + r112*BRO*OH + r113*HBR*O - + r114*HBR*OH + r116*O1D*CF3BR + 3*r117*O1D*CHBR3 + 2*r118*O1D*H2402 + r119*O1D*HBR - + 2*r127*CH2BR2*CL + 2*r128*CH2BR2*OH + r129*CH3BR*CL + r130*CH3BR*OH + 3*r134*CHBR3*CL - + 3*r135*CHBR3*OH + 2*r139*O1D*CH2BR2 + r140*O1D*CH3BR + r160*SO*BRO - - r100*CH2O*BR - r101*HO2*BR - r102*O3*BR - d(CL)/dt = j26*BRCL + 4*j30*CCL4 + j31*CF2CLBR + 2*j33*CFC11 + 2*j34*CFC113 + 2*j35*CFC114 + j36*CFC115 - + 2*j37*CFC12 + 3*j40*CH3CCL3 + j41*CH3CL + 2*j43*CL2 + 2*j44*CL2O2 + j45*CLO + j46*CLONO2 - + j49*COFCL + j52*HCFC141B + j53*HCFC142B + j54*HCFC22 + j55*HCL + j58*HOCL + r71*CLO*CH3O2 - + 2*r72*CLO*CLO + r74*CLO*CLO + r76*CLO*NO + r81*CLO*O + r82*CLO*OH + r84*HCL*O + r85*HCL*OH - + 4*r89*O1D*CCL4 + r90*O1D*CF2CLBR + 2*r91*O1D*CFC11 + 2*r92*O1D*CFC113 + 2*r93*O1D*CFC114 - + r94*O1D*CFC115 + 2*r95*O1D*CFC12 + r96*O1D*HCL + r105*BRO*CLO + r126*O1D*COFCL - + 3*r131*CH3CCL3*OH + r133*CH3CL*OH + r136*HCFC141B*OH + r137*HCFC142B*OH + r138*HCFC22*OH - + r141*O1D*HCFC141B + r142*O1D*HCFC142B + r143*O1D*HCFC22 + r161*SO*CLO - - r64*CH2O*CL - r65*CH4*CL - r66*H2*CL - r67*H2O2*CL - r68*HO2*CL - r69*HO2*CL - r70*O3*CL - - r77*CLONO2*CL - r86*HOCL*CL - r127*CH2BR2*CL - r129*CH3BR*CL - r132*CH3CL*CL - r134*CHBR3*CL d(e)/dt = j63*N2 + j64*N2 + j65*N2 + j67*N2 + j69*N2 + j70*N2 + j16*NO + j62*N + j71*O + j72*O + j73*O + j74*O + j75*O + j76*O + j77*O2 + j78*O2 + j79*O2 + j80*O2 + j81*O2 + j84*O2 + j85*O2 + j86*O2 - - r197*NOp*e - r198*O2p*e - r199*N2p*e + - r196*NOp*e - r197*O2p*e - r198*N2p*e d(HO2)/dt = j11*HO2NO2 + r62*M*HO2NO2 + r21*H2O2*O + r25*M*H*O2 + r30*OH*H2O2 + r33*OH*O3 + r51*NO3*OH + r64*CL*CH2O + r67*CL*H2O2 + r71*CLO*CH3O2 + r82*CLO*OH + r100*BR*CH2O + r112*BRO*OH + r129*CH3BR*CL + r130*CH3BR*OH + r132*CH3CL*CL + r133*CH3CL*OH + r144*CH2O*NO3 + r145*CH2O*O - + r148*CH3O2*NO + r151*M*CO*OH + r153*O1D*CH4 + r168*SO2*OH + .5*r172*DMS*OH - - r173*HO2 - r22*H*HO2 - r23*H*HO2 - r24*H*HO2 - r26*O*HO2 - r27*O3*HO2 - r31*OH*HO2 + + r148*CH3O2*NO + r152*O1D*CH4 + r154*CO*OH + r160*M*SO2*OH + .5*r170*DMS*OH + - r172*HO2 - r22*H*HO2 - r23*H*HO2 - r24*H*HO2 - r26*O*HO2 - r27*O3*HO2 - r31*OH*HO2 - 2*r36*HO2*HO2 - r48*NO3*HO2 - r53*NO*HO2 - r58*M*NO2*HO2 - r68*CL*HO2 - r69*CL*HO2 - r75*CLO*HO2 - r101*BR*HO2 - r107*BRO*HO2 - r147*CH3O2*HO2 - d(N2D)/dt = j65*N2 + 1.2*j66*N2 + 1.2*j68*N2 + j69*N2 + .8*r197*NOp*e + .9*r199*N2p*e + r201*N2p*O - - r38*O*N2D - r39*O2*N2D - r211*Op*N2D - d(N2p)/dt = j63*N2 + j67*N2 + r214*N2*Op2D + r219*N2*Op2P - - r199*e*N2p - r200*O2*N2p - r201*O*N2p - r202*O*N2p - d(NOp)/dt = j16*NO + r207*N2*O2p + r210*N2*Op + r201*N2p*O + r205*Np*O2 + r206*O2p*N + r208*O2p*NO - - r197*e*NOp - d(Np)/dt = j64*N2 + j65*N2 + j69*N2 + j70*N2 + j62*N + r220*N2*Op2P + r211*Op*N2D - - r203*O*Np - r204*O2*Np - r205*O2*Np - d(O1D)/dt = j1*H2O + j6*O2 + j7*O3 + j12*N2O + r39*N2D*O2 + .85*r198*O2p*e + d(N2D)/dt = j65*N2 + 1.2*j66*N2 + 1.2*j68*N2 + j69*N2 + .8*r196*NOp*e + .9*r198*N2p*e + r200*N2p*O + - r38*O*N2D - r39*O2*N2D - r210*Op*N2D + d(N2p)/dt = j63*N2 + j67*N2 + r213*N2*Op2D + r218*N2*Op2P + - r198*e*N2p - r199*O2*N2p - r200*O*N2p - r201*O*N2p + d(NOp)/dt = j16*NO + r206*N2*O2p + r209*N2*Op + r200*N2p*O + r204*Np*O2 + r205*O2p*N + r207*O2p*NO + - r196*e*NOp + d(Np)/dt = j64*N2 + j65*N2 + j69*N2 + j70*N2 + j62*N + r219*N2*Op2P + r210*Op*N2D + - r202*O*Np - r203*O2*Np - r204*O2*Np + d(O1D)/dt = j1*H2O + j6*O2 + j7*O3 + j12*N2O + r39*N2D*O2 + .85*r197*O2p*e - r5*N2*O1D - r3*H2*O1D - r4*H2O*O1D - r6*O2*O1D - r7*O2*O1D - r8*O3*O1D - r56*N2O*O1D - r57*N2O*O1D - r89*CCL4*O1D - r90*CF2CLBR*O1D - r91*CFC11*O1D - r92*CFC113*O1D - r93*CFC114*O1D - r94*CFC115*O1D - r95*CFC12*O1D - r96*HCL*O1D - r97*HCL*O1D - r116*CF3BR*O1D - r117*CHBR3*O1D - r118*H2402*O1D - r119*HBR*O1D - r120*HBR*O1D - r125*COF2*O1D - r126*COFCL*O1D - r139*CH2BR2*O1D - r140*CH3BR*O1D - r141*HCFC141B*O1D - r142*HCFC142B*O1D - r143*HCFC22*O1D - - r152*CH4*O1D - r153*CH4*O1D - r154*CH4*O1D + - r151*CH4*O1D - r152*CH4*O1D - r153*CH4*O1D d(O2_1D)/dt = j7*O3 + r13*N2*O2_1S + r12*O2_1S*CO2 + r14*O2_1S*O + r15*O2_1S*O2 + r16*O2_1S*O3 - r1*O2_1D - r9*N2*O2_1D - r10*O*O2_1D - r11*O2*O2_1D d(O2_1S)/dt = r6*O1D*O2 - r2*O2_1S - r13*N2*O2_1S - r12*CO2*O2_1S - r14*O*O2_1S - r15*O2*O2_1S - r16*O3*O2_1S - d(O2p)/dt = j78*O2 + j80*O2 + r200*N2p*O2 + r204*Np*O2 + r209*Op*CO2 + r212*Op*O2 + r216*Op2D*O2 - - r207*N2*O2p - r198*e*O2p - r206*N*O2p - r208*NO*O2p + d(O2p)/dt = j78*O2 + j80*O2 + r199*N2p*O2 + r203*Np*O2 + r208*Op*CO2 + r211*Op*O2 + r215*Op2D*O2 + - r206*N2*O2p - r197*e*O2p - r205*N*O2p - r207*NO*O2p d(OH)/dt = j3*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j22*CH3OOH + .33*j24*CH4 + j57*HOBR + j58*HOCL - + .5*r175*NO2 + r3*O1D*H2 + 2*r4*O1D*H2O + r20*H2*O + r21*H2O2*O + 2*r23*H*HO2 + r26*HO2*O + + .5*r174*NO2 + r3*O1D*H2 + 2*r4*O1D*H2O + r20*H2*O + r21*H2O2*O + 2*r23*H*HO2 + r26*HO2*O + r27*HO2*O3 + r28*H*O3 + r48*NO3*HO2 + r53*NO*HO2 + r69*CL*HO2 + r84*HCL*O + r87*HOCL*O + r96*O1D*HCL + r113*HBR*O + r115*HOBR*O + r119*O1D*HBR + r123*F*H2O + r145*CH2O*O - + .3*r149*CH3OOH*OH + r152*O1D*CH4 + + .3*r149*CH3OOH*OH + r151*O1D*CH4 - r29*H2*OH - r30*H2O2*OH - r31*HO2*OH - r32*O*OH - r33*O3*OH - 2*r34*OH*OH - 2*r35*M*OH*OH - r37*HO2NO2*OH - r51*NO3*OH - r52*N*OH - r60*M*NO2*OH - r61*HNO3*OH - r80*CLONO2*OH - r82*CLO*OH - r83*CLO*OH - r85*HCL*OH - r88*HOCL*OH - r112*BRO*OH - r114*HBR*OH - r128*CH2BR2*OH - r130*CH3BR*OH - r131*CH3CCL3*OH - r133*CH3CL*OH - r135*CHBR3*OH - r136*HCFC141B*OH - r137*HCFC142B*OH - r138*HCFC22*OH - r146*CH2O*OH - r149*CH3OOH*OH - - r150*CH4*OH - r151*M*CO*OH - r155*CO*OH - r157*OCS*OH - r162*S*OH - r167*SO*OH - r168*SO2*OH - - r171*DMS*OH - r172*DMS*OH - d(Op)/dt = j73*O + j74*O + j79*O2 + j81*O2 + r194*Op2P + r195*Op2D + r202*N2p*O + r203*Np*O + r213*Op2D*e - + r215*Op2D*O + r218*Op2P*e + r221*Op2P*O - - r210*N2*Op - r209*CO2*Op - r211*N2D*Op - r212*O2*Op - d(Op2D)/dt = j75*O + j76*O + j85*O2 + j86*O2 + r196*Op2P + r217*Op2P*e - - r195*Op2D - r214*N2*Op2D - r213*e*Op2D - r215*O*Op2D - r216*O2*Op2D + - r150*CH4*OH - r154*CO*OH - r156*DMS*OH - r158*OCS*OH - r160*M*SO2*OH - r164*S*OH - r169*SO*OH + - r170*DMS*OH + d(Op)/dt = j73*O + j74*O + j79*O2 + j81*O2 + r193*Op2P + r194*Op2D + r201*N2p*O + r202*Np*O + r212*Op2D*e + + r214*Op2D*O + r217*Op2P*e + r220*Op2P*O + - r209*N2*Op - r208*CO2*Op - r210*N2D*Op - r211*O2*Op + d(Op2D)/dt = j75*O + j76*O + j85*O2 + j86*O2 + r195*Op2P + r216*Op2P*e + - r194*Op2D - r213*N2*Op2D - r212*e*Op2D - r214*O*Op2D - r215*O2*Op2D d(Op2P)/dt = j71*O + j72*O + j77*O2 + j84*O2 - - r194*Op2P - r196*Op2P - r219*N2*Op2P - r220*N2*Op2P - r217*e*Op2P - r218*e*Op2P - - r221*O*Op2P + - r193*Op2P - r195*Op2P - r218*N2*Op2P - r219*N2*Op2P - r216*e*Op2P - r217*e*Op2P + - r220*O*Op2P d(H2O)/dt = .05*j24*CH4 + j87*H2SO4 + r24*H*HO2 + r29*OH*H2 + r30*OH*H2O2 + r31*OH*HO2 + r34*OH*OH + r37*HO2NO2*OH + r61*HNO3*OH + r85*HCL*OH + r88*HOCL*OH + r114*HBR*OH + r128*CH2BR2*OH + r130*CH3BR*OH + r131*CH3CCL3*OH + r133*CH3CL*OH + r138*HCFC22*OH + r146*CH2O*OH - + r149*CH3OOH*OH + r150*CH4*OH + r178*HOCL*HCL + r184*HOCL*HCL + r185*HOBR*HCL + r189*HOCL*HCL - + r190*HOBR*HCL - - j1*H2O - j2*H2O - j3*H2O - r4*O1D*H2O - r123*F*H2O - r169*SO3*H2O + + r149*CH3OOH*OH + r150*CH4*OH + r177*HOCL*HCL + r183*HOCL*HCL + r184*HOBR*HCL + r188*HOCL*HCL + + r189*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r4*O1D*H2O - r123*F*H2O - r171*SO3*H2O diff --git a/src/chemistry/pp_waccm_ma_mam4/chem_mech.in b/src/chemistry/pp_waccm_ma_mam4/chem_mech.in index 59b5c230da..ccef2e3248 100644 --- a/src/chemistry/pp_waccm_ma_mam4/chem_mech.in +++ b/src/chemistry/pp_waccm_ma_mam4/chem_mech.in @@ -1,17 +1,18 @@ * Comments -* User-given Tag Description: MA_MAM4_1 -* Tag database identifier : MZ254_MA_MAM4_20190125 -* Tag created by : ajc +* User-given Tag Description: WACCM_MA_MAM4_JPL19 +* Tag database identifier : MZ319_MA_MAM4_20221220 +* Tag created by : lke * Tag created from branch : MA_MAM4 -* Tag created on : 2019-01-25 13:05:48.065223-07 +* Tag created on : 2022-12-20 13:58:07.831193-07 * Comments for this tag follow: -* ajc : 2019-01-25 : Reconcilliation of code to match Dan/Francis's version +* lke : 2022-12-20 : WACCM middle atmosphere with MAM4 updated to JPL19 reaction rates SPECIES Solution bc_a1 -> C, bc_a4 -> C, + BR -> Br, BRCL -> BrCl, BRO -> BrO, BRONO2 -> BrONO2, @@ -33,6 +34,7 @@ CH3OOH, CH4, CHBR3 -> CHBr3, + CL -> Cl, CL2 -> Cl2, CL2O2 -> Cl2O2, CLO -> ClO, @@ -93,8 +95,6 @@ soa_a1 -> C, soa_a2 -> C, SOAG -> C, - BR -> Br, - CL -> Cl, e -> E, HO2, N2D -> N, @@ -124,8 +124,6 @@ End Col-int Not-Transported - BR, - CL, e, HO2, N2D, @@ -147,6 +145,16 @@ Solution classes Explicit + + End Explicit + + Implicit + bc_a1 + bc_a4 + BR + BRCL + BRO + BRONO2 BRY CCL4 CF2CLBR @@ -157,35 +165,22 @@ CFC115 CFC12 CH2BR2 + CH2O CH3BR CH3CCL3 CH3CL - CH4 - CHBR3 - CLY - CO2 - H2402 - HCFC141B - HCFC142B - HCFC22 - N2O - SF6 - End Explicit - - Implicit - bc_a1 - bc_a4 - BRCL - BRO - BRONO2 - CH2O CH3O2 CH3OOH + CH4 + CHBR3 + CL CL2 CL2O2 CLO CLONO2 + CLY CO + CO2 COF2 COFCL DMS @@ -195,9 +190,13 @@ F H H2 + H2402 H2O2 H2SO4 HBR + HCFC141B + HCFC142B + HCFC22 HCL HF HNO3 @@ -205,6 +204,7 @@ HOBR HOCL N + N2O N2O5 ncl_a1 ncl_a2 @@ -224,6 +224,7 @@ pom_a1 pom_a4 S + SF6 SO SO2 SO3 @@ -233,8 +234,6 @@ soa_a1 soa_a2 SOAG - BR - CL e HO2 N2D @@ -399,7 +398,7 @@ [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 ; 4.4e-32, 1.3, 7.5e-11, -0.2, 0.6 +[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 @@ -414,23 +413,23 @@ ********************************* *** odd-nitrogen ********************************* -[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 +[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 4.5e-13, 610 [N2D_O,cph=229.61] N2D + O -> N + O ; 7e-13 [N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5e-12 [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 ; 1.5e-11, -3600 +[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.5e-11, 170 -[NO3_O] NO3 + O -> NO2 + O2 ; 1e-11 +[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.3e-12, 270 +[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 @@ -521,7 +520,7 @@ [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_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.03e-11, -1110 [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 @@ -543,17 +542,19 @@ [CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 [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 -[CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.9e-33, 1, 1.1e-12, -1.3, 0.6 [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_b] CO + OH -> CO2 + H +[usr_CO_OH] CO + OH -> CO2 + HO2 ********************************* *** 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 @@ -562,15 +563,12 @@ [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.7e-11, 335 -[usr_SO2_OH] SO2 + OH -> SO3 + HO2 +[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 ********************************* -[DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 -[DMS_OHa] DMS + OH -> SO2 ; 9.6e-12, -234 -[usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 [usr_HO2_aer] HO2 -> 0.5*H2O2 [usr_N2O5_aer] N2O5 -> 2*HNO3 [usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 diff --git a/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 index 73fc00ed41..ffe4e8fc8e 100644 --- a/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/chem_mods.F90 @@ -6,26 +6,26 @@ module chem_mods implicit none save integer, parameter :: phtcnt = 91, & ! number of photolysis reactions - rxntot = 312, & ! number of total reactions - gascnt = 221, & ! number of gas phase reactions + rxntot = 311, & ! number of total reactions + gascnt = 220, & ! number of gas phase reactions nabscol = 2, & ! number of absorbing column densities gas_pcnst = 100, & ! number of "gas phase" species nfs = 2, & ! number of "fixed" species relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members - nzcnt = 764, & ! number of non-zero matrix entries + nzcnt = 956, & ! number of non-zero matrix entries extcnt = 22, & ! number of species with external forcing - clscnt1 = 23, & ! number of species in explicit class + clscnt1 = 0, & ! number of species in explicit class clscnt2 = 0, & ! number of species in hov class clscnt3 = 0, & ! number of species in ebi class - clscnt4 = 77, & ! number of species in implicit class + clscnt4 = 100, & ! 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 = 312, & + rxt_tag_cnt = 311, & enthalpy_cnt = 54, & - nslvd = 16 + nslvd = 14 integer :: clscnt(5) = 0 integer :: cls_rxt_cnt(4,5) = 0 integer :: clsmap(gas_pcnst,5) = 0 diff --git a/src/chemistry/pp_waccm_ma_mam4/m_rxt_id.F90 b/src/chemistry/pp_waccm_ma_mam4/m_rxt_id.F90 index e906aff4d5..61adf10946 100644 --- a/src/chemistry/pp_waccm_ma_mam4/m_rxt_id.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/m_rxt_id.F90 @@ -241,75 +241,74 @@ module m_rxt_id integer, parameter :: rid_CH3O2_NO = 239 integer, parameter :: rid_CH3OOH_OH = 240 integer, parameter :: rid_CH4_OH = 241 - integer, parameter :: rid_CO_OH_M = 242 - integer, parameter :: rid_O1D_CH4a = 243 - integer, parameter :: rid_O1D_CH4b = 244 - integer, parameter :: rid_O1D_CH4c = 245 - integer, parameter :: rid_usr_CO_OH_b = 246 - integer, parameter :: rid_OCS_O = 247 - integer, parameter :: rid_OCS_OH = 248 - integer, parameter :: rid_S_O2 = 249 - integer, parameter :: rid_S_O3 = 250 - integer, parameter :: rid_SO_BRO = 251 - integer, parameter :: rid_SO_CLO = 252 - integer, parameter :: rid_S_OH = 253 - integer, parameter :: rid_SO_NO2 = 254 - integer, parameter :: rid_SO_O2 = 255 - integer, parameter :: rid_SO_O3 = 256 - integer, parameter :: rid_SO_OCLO = 257 - integer, parameter :: rid_SO_OH = 258 - integer, parameter :: rid_usr_SO2_OH = 259 - integer, parameter :: rid_usr_SO3_H2O = 260 - integer, parameter :: rid_DMS_NO3 = 261 - integer, parameter :: rid_DMS_OHa = 262 - integer, parameter :: rid_usr_DMS_OH = 263 - integer, parameter :: rid_usr_HO2_aer = 264 - integer, parameter :: rid_usr_N2O5_aer = 265 - integer, parameter :: rid_usr_NO2_aer = 266 - integer, parameter :: rid_usr_NO3_aer = 267 - integer, parameter :: rid_het1 = 268 - integer, parameter :: rid_het10 = 269 - integer, parameter :: rid_het11 = 270 - integer, parameter :: rid_het12 = 271 - integer, parameter :: rid_het13 = 272 - integer, parameter :: rid_het14 = 273 - integer, parameter :: rid_het15 = 274 - integer, parameter :: rid_het16 = 275 - integer, parameter :: rid_het17 = 276 - integer, parameter :: rid_het2 = 277 - integer, parameter :: rid_het3 = 278 - integer, parameter :: rid_het4 = 279 - integer, parameter :: rid_het5 = 280 - integer, parameter :: rid_het6 = 281 - integer, parameter :: rid_het7 = 282 - integer, parameter :: rid_het8 = 283 - integer, parameter :: rid_het9 = 284 - integer, parameter :: rid_ag247nm = 285 - integer, parameter :: rid_ag373nm = 286 - integer, parameter :: rid_ag732nm = 287 - integer, parameter :: rid_elec1 = 288 - integer, parameter :: rid_elec2 = 289 - integer, parameter :: rid_elec3 = 290 - integer, parameter :: rid_ion_N2p_O2 = 291 - integer, parameter :: rid_ion_N2p_Oa = 292 - integer, parameter :: rid_ion_N2p_Ob = 293 - integer, parameter :: rid_ion_Np_O = 294 - integer, parameter :: rid_ion_Np_O2a = 295 - integer, parameter :: rid_ion_Np_O2b = 296 - integer, parameter :: rid_ion_O2p_N = 297 - integer, parameter :: rid_ion_O2p_N2 = 298 - integer, parameter :: rid_ion_O2p_NO = 299 - integer, parameter :: rid_ion_Op_CO2 = 300 - integer, parameter :: rid_ion_Op_N2 = 301 - integer, parameter :: rid_ion_Op_N2D = 302 - integer, parameter :: rid_ion_Op_O2 = 303 - integer, parameter :: rid_Op2D_e = 304 - integer, parameter :: rid_Op2D_N2 = 305 - integer, parameter :: rid_Op2D_O = 306 - integer, parameter :: rid_Op2D_O2 = 307 - integer, parameter :: rid_Op2P_ea = 308 - integer, parameter :: rid_Op2P_eb = 309 - integer, parameter :: rid_Op2P_N2a = 310 - integer, parameter :: rid_Op2P_N2b = 311 - integer, parameter :: rid_Op2P_O = 312 + integer, parameter :: rid_O1D_CH4a = 242 + integer, parameter :: rid_O1D_CH4b = 243 + integer, parameter :: rid_O1D_CH4c = 244 + integer, parameter :: rid_usr_CO_OH = 245 + integer, parameter :: rid_DMS_NO3 = 246 + integer, parameter :: rid_DMS_OHa = 247 + integer, parameter :: rid_OCS_O = 248 + integer, parameter :: rid_OCS_OH = 249 + integer, parameter :: rid_S_O2 = 250 + integer, parameter :: rid_SO2_OH_M = 251 + integer, parameter :: rid_S_O3 = 252 + integer, parameter :: rid_SO_BRO = 253 + integer, parameter :: rid_SO_CLO = 254 + integer, parameter :: rid_S_OH = 255 + integer, parameter :: rid_SO_NO2 = 256 + integer, parameter :: rid_SO_O2 = 257 + integer, parameter :: rid_SO_O3 = 258 + integer, parameter :: rid_SO_OCLO = 259 + integer, parameter :: rid_SO_OH = 260 + integer, parameter :: rid_usr_DMS_OH = 261 + integer, parameter :: rid_usr_SO3_H2O = 262 + integer, parameter :: rid_usr_HO2_aer = 263 + integer, parameter :: rid_usr_N2O5_aer = 264 + integer, parameter :: rid_usr_NO2_aer = 265 + integer, parameter :: rid_usr_NO3_aer = 266 + integer, parameter :: rid_het1 = 267 + integer, parameter :: rid_het10 = 268 + integer, parameter :: rid_het11 = 269 + integer, parameter :: rid_het12 = 270 + integer, parameter :: rid_het13 = 271 + integer, parameter :: rid_het14 = 272 + integer, parameter :: rid_het15 = 273 + integer, parameter :: rid_het16 = 274 + integer, parameter :: rid_het17 = 275 + integer, parameter :: rid_het2 = 276 + integer, parameter :: rid_het3 = 277 + integer, parameter :: rid_het4 = 278 + integer, parameter :: rid_het5 = 279 + integer, parameter :: rid_het6 = 280 + integer, parameter :: rid_het7 = 281 + integer, parameter :: rid_het8 = 282 + integer, parameter :: rid_het9 = 283 + integer, parameter :: rid_ag247nm = 284 + integer, parameter :: rid_ag373nm = 285 + integer, parameter :: rid_ag732nm = 286 + integer, parameter :: rid_elec1 = 287 + integer, parameter :: rid_elec2 = 288 + integer, parameter :: rid_elec3 = 289 + integer, parameter :: rid_ion_N2p_O2 = 290 + integer, parameter :: rid_ion_N2p_Oa = 291 + integer, parameter :: rid_ion_N2p_Ob = 292 + integer, parameter :: rid_ion_Np_O = 293 + integer, parameter :: rid_ion_Np_O2a = 294 + integer, parameter :: rid_ion_Np_O2b = 295 + integer, parameter :: rid_ion_O2p_N = 296 + integer, parameter :: rid_ion_O2p_N2 = 297 + integer, parameter :: rid_ion_O2p_NO = 298 + integer, parameter :: rid_ion_Op_CO2 = 299 + integer, parameter :: rid_ion_Op_N2 = 300 + integer, parameter :: rid_ion_Op_N2D = 301 + integer, parameter :: rid_ion_Op_O2 = 302 + integer, parameter :: rid_Op2D_e = 303 + integer, parameter :: rid_Op2D_N2 = 304 + integer, parameter :: rid_Op2D_O = 305 + integer, parameter :: rid_Op2D_O2 = 306 + integer, parameter :: rid_Op2P_ea = 307 + integer, parameter :: rid_Op2P_eb = 308 + integer, parameter :: rid_Op2P_N2a = 309 + integer, parameter :: rid_Op2P_N2b = 310 + integer, parameter :: rid_Op2P_O = 311 end module m_rxt_id diff --git a/src/chemistry/pp_waccm_ma_mam4/m_spc_id.F90 b/src/chemistry/pp_waccm_ma_mam4/m_spc_id.F90 index 80115389db..74a7ee75b5 100644 --- a/src/chemistry/pp_waccm_ma_mam4/m_spc_id.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/m_spc_id.F90 @@ -2,89 +2,89 @@ module m_spc_id implicit none integer, parameter :: id_bc_a1 = 1 integer, parameter :: id_bc_a4 = 2 - integer, parameter :: id_BRCL = 3 - integer, parameter :: id_BRO = 4 - integer, parameter :: id_BRONO2 = 5 - integer, parameter :: id_BRY = 6 - integer, parameter :: id_CCL4 = 7 - integer, parameter :: id_CF2CLBR = 8 - integer, parameter :: id_CF3BR = 9 - integer, parameter :: id_CFC11 = 10 - integer, parameter :: id_CFC113 = 11 - integer, parameter :: id_CFC114 = 12 - integer, parameter :: id_CFC115 = 13 - integer, parameter :: id_CFC12 = 14 - integer, parameter :: id_CH2BR2 = 15 - integer, parameter :: id_CH2O = 16 - integer, parameter :: id_CH3BR = 17 - integer, parameter :: id_CH3CCL3 = 18 - integer, parameter :: id_CH3CL = 19 - integer, parameter :: id_CH3O2 = 20 - integer, parameter :: id_CH3OOH = 21 - integer, parameter :: id_CH4 = 22 - integer, parameter :: id_CHBR3 = 23 - integer, parameter :: id_CL2 = 24 - integer, parameter :: id_CL2O2 = 25 - integer, parameter :: id_CLO = 26 - integer, parameter :: id_CLONO2 = 27 - integer, parameter :: id_CLY = 28 - integer, parameter :: id_CO = 29 - integer, parameter :: id_CO2 = 30 - integer, parameter :: id_COF2 = 31 - integer, parameter :: id_COFCL = 32 - integer, parameter :: id_DMS = 33 - integer, parameter :: id_dst_a1 = 34 - integer, parameter :: id_dst_a2 = 35 - integer, parameter :: id_dst_a3 = 36 - integer, parameter :: id_F = 37 - integer, parameter :: id_H = 38 - integer, parameter :: id_H2 = 39 - integer, parameter :: id_H2402 = 40 - integer, parameter :: id_H2O2 = 41 - integer, parameter :: id_H2SO4 = 42 - integer, parameter :: id_HBR = 43 - integer, parameter :: id_HCFC141B = 44 - integer, parameter :: id_HCFC142B = 45 - integer, parameter :: id_HCFC22 = 46 - integer, parameter :: id_HCL = 47 - integer, parameter :: id_HF = 48 - integer, parameter :: id_HNO3 = 49 - integer, parameter :: id_HO2NO2 = 50 - integer, parameter :: id_HOBR = 51 - integer, parameter :: id_HOCL = 52 - integer, parameter :: id_N = 53 - integer, parameter :: id_N2O = 54 - integer, parameter :: id_N2O5 = 55 - integer, parameter :: id_ncl_a1 = 56 - integer, parameter :: id_ncl_a2 = 57 - integer, parameter :: id_ncl_a3 = 58 - integer, parameter :: id_NO = 59 - integer, parameter :: id_NO2 = 60 - integer, parameter :: id_NO3 = 61 - integer, parameter :: id_num_a1 = 62 - integer, parameter :: id_num_a2 = 63 - integer, parameter :: id_num_a3 = 64 - integer, parameter :: id_num_a4 = 65 - integer, parameter :: id_O = 66 - integer, parameter :: id_O2 = 67 - integer, parameter :: id_O3 = 68 - integer, parameter :: id_OCLO = 69 - integer, parameter :: id_OCS = 70 - integer, parameter :: id_pom_a1 = 71 - integer, parameter :: id_pom_a4 = 72 - integer, parameter :: id_S = 73 - integer, parameter :: id_SF6 = 74 - integer, parameter :: id_SO = 75 - integer, parameter :: id_SO2 = 76 - integer, parameter :: id_SO3 = 77 - integer, parameter :: id_so4_a1 = 78 - integer, parameter :: id_so4_a2 = 79 - integer, parameter :: id_so4_a3 = 80 - integer, parameter :: id_soa_a1 = 81 - integer, parameter :: id_soa_a2 = 82 - integer, parameter :: id_SOAG = 83 - integer, parameter :: id_BR = 84 - integer, parameter :: id_CL = 85 + integer, parameter :: id_BR = 3 + integer, parameter :: id_BRCL = 4 + integer, parameter :: id_BRO = 5 + integer, parameter :: id_BRONO2 = 6 + integer, parameter :: id_BRY = 7 + integer, parameter :: id_CCL4 = 8 + integer, parameter :: id_CF2CLBR = 9 + integer, parameter :: id_CF3BR = 10 + integer, parameter :: id_CFC11 = 11 + integer, parameter :: id_CFC113 = 12 + integer, parameter :: id_CFC114 = 13 + integer, parameter :: id_CFC115 = 14 + integer, parameter :: id_CFC12 = 15 + integer, parameter :: id_CH2BR2 = 16 + integer, parameter :: id_CH2O = 17 + integer, parameter :: id_CH3BR = 18 + integer, parameter :: id_CH3CCL3 = 19 + integer, parameter :: id_CH3CL = 20 + integer, parameter :: id_CH3O2 = 21 + integer, parameter :: id_CH3OOH = 22 + integer, parameter :: id_CH4 = 23 + integer, parameter :: id_CHBR3 = 24 + integer, parameter :: id_CL = 25 + integer, parameter :: id_CL2 = 26 + integer, parameter :: id_CL2O2 = 27 + integer, parameter :: id_CLO = 28 + integer, parameter :: id_CLONO2 = 29 + integer, parameter :: id_CLY = 30 + integer, parameter :: id_CO = 31 + integer, parameter :: id_CO2 = 32 + integer, parameter :: id_COF2 = 33 + integer, parameter :: id_COFCL = 34 + integer, parameter :: id_DMS = 35 + integer, parameter :: id_dst_a1 = 36 + integer, parameter :: id_dst_a2 = 37 + integer, parameter :: id_dst_a3 = 38 + integer, parameter :: id_F = 39 + integer, parameter :: id_H = 40 + integer, parameter :: id_H2 = 41 + integer, parameter :: id_H2402 = 42 + integer, parameter :: id_H2O2 = 43 + integer, parameter :: id_H2SO4 = 44 + integer, parameter :: id_HBR = 45 + integer, parameter :: id_HCFC141B = 46 + integer, parameter :: id_HCFC142B = 47 + integer, parameter :: id_HCFC22 = 48 + integer, parameter :: id_HCL = 49 + integer, parameter :: id_HF = 50 + integer, parameter :: id_HNO3 = 51 + integer, parameter :: id_HO2NO2 = 52 + integer, parameter :: id_HOBR = 53 + integer, parameter :: id_HOCL = 54 + integer, parameter :: id_N = 55 + integer, parameter :: id_N2O = 56 + integer, parameter :: id_N2O5 = 57 + integer, parameter :: id_ncl_a1 = 58 + integer, parameter :: id_ncl_a2 = 59 + integer, parameter :: id_ncl_a3 = 60 + integer, parameter :: id_NO = 61 + integer, parameter :: id_NO2 = 62 + integer, parameter :: id_NO3 = 63 + integer, parameter :: id_num_a1 = 64 + integer, parameter :: id_num_a2 = 65 + integer, parameter :: id_num_a3 = 66 + integer, parameter :: id_num_a4 = 67 + integer, parameter :: id_O = 68 + integer, parameter :: id_O2 = 69 + integer, parameter :: id_O3 = 70 + integer, parameter :: id_OCLO = 71 + integer, parameter :: id_OCS = 72 + integer, parameter :: id_pom_a1 = 73 + integer, parameter :: id_pom_a4 = 74 + integer, parameter :: id_S = 75 + integer, parameter :: id_SF6 = 76 + integer, parameter :: id_SO = 77 + integer, parameter :: id_SO2 = 78 + integer, parameter :: id_SO3 = 79 + integer, parameter :: id_so4_a1 = 80 + integer, parameter :: id_so4_a2 = 81 + integer, parameter :: id_so4_a3 = 82 + integer, parameter :: id_soa_a1 = 83 + integer, parameter :: id_soa_a2 = 84 + integer, parameter :: id_SOAG = 85 integer, parameter :: id_e = 86 integer, parameter :: id_HO2 = 87 integer, parameter :: id_N2D = 88 diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_adjrxt.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_adjrxt.F90 index fadce62bf1..1f5d1ba14f 100644 --- a/src/chemistry/pp_waccm_ma_mam4/mo_adjrxt.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/mo_adjrxt.F90 @@ -14,220 +14,219 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) real(r8), intent(in) :: m(ncol,nlev) real(r8), intent(inout) :: rate(ncol,nlev,rxntot) rate(:,:, 96) = rate(:,:, 96) * inv(:,:, 2) - rate(:,:,100) = rate(:,:,100) * inv(:,:, 2) - rate(:,:,104) = rate(:,:,104) * inv(:,:, 2) - rate(:,:,109) = rate(:,:,109) * inv(:,:, 1) - rate(:,:,110) = rate(:,:,110) * inv(:,:, 1) - rate(:,:,116) = rate(:,:,116) * inv(:,:, 1) - rate(:,:,126) = rate(:,:,126) * inv(:,:, 1) - rate(:,:,138) = rate(:,:,138) * inv(:,:, 1) - rate(:,:,146) = rate(:,:,146) * inv(:,:, 1) - rate(:,:,149) = rate(:,:,149) * inv(:,:, 1) - rate(:,:,150) = rate(:,:,150) * inv(:,:, 1) - rate(:,:,151) = rate(:,:,151) * inv(:,:, 1) - rate(:,:,153) = rate(:,:,153) * inv(:,:, 1) - rate(:,:,154) = rate(:,:,154) * inv(:,:, 1) - rate(:,:,169) = rate(:,:,169) * inv(:,:, 1) - rate(:,:,189) = rate(:,:,189) * inv(:,:, 1) - rate(:,:,190) = rate(:,:,190) * inv(:,:, 1) - rate(:,:,200) = rate(:,:,200) * inv(:,:, 1) - rate(:,:,242) = rate(:,:,242) * inv(:,:, 1) - rate(:,:,298) = rate(:,:,298) * inv(:,:, 2) - rate(:,:,301) = rate(:,:,301) * inv(:,:, 2) - rate(:,:,305) = rate(:,:,305) * inv(:,:, 2) - rate(:,:,310) = rate(:,:,310) * inv(:,:, 2) - rate(:,:,311) = rate(:,:,311) * inv(:,:, 2) + rate(:,:, 100) = rate(:,:, 100) * inv(:,:, 2) + rate(:,:, 104) = rate(:,:, 104) * inv(:,:, 2) + rate(:,:, 109) = rate(:,:, 109) * inv(:,:, 1) + rate(:,:, 110) = rate(:,:, 110) * inv(:,:, 1) + rate(:,:, 116) = rate(:,:, 116) * inv(:,:, 1) + rate(:,:, 126) = rate(:,:, 126) * inv(:,:, 1) + rate(:,:, 138) = rate(:,:, 138) * inv(:,:, 1) + rate(:,:, 146) = rate(:,:, 146) * inv(:,:, 1) + rate(:,:, 149) = rate(:,:, 149) * inv(:,:, 1) + rate(:,:, 150) = rate(:,:, 150) * inv(:,:, 1) + rate(:,:, 151) = rate(:,:, 151) * inv(:,:, 1) + rate(:,:, 153) = rate(:,:, 153) * inv(:,:, 1) + rate(:,:, 154) = rate(:,:, 154) * inv(:,:, 1) + rate(:,:, 169) = rate(:,:, 169) * inv(:,:, 1) + rate(:,:, 189) = rate(:,:, 189) * inv(:,:, 1) + rate(:,:, 190) = rate(:,:, 190) * inv(:,:, 1) + rate(:,:, 200) = rate(:,:, 200) * inv(:,:, 1) + rate(:,:, 251) = rate(:,:, 251) * inv(:,:, 1) + rate(:,:, 297) = rate(:,:, 297) * inv(:,:, 2) + rate(:,:, 300) = rate(:,:, 300) * inv(:,:, 2) + rate(:,:, 304) = rate(:,:, 304) * inv(:,:, 2) + rate(:,:, 309) = rate(:,:, 309) * inv(:,:, 2) + rate(:,:, 310) = rate(:,:, 310) * inv(:,:, 2) rate(:,:, 94) = rate(:,:, 94) * m(:,:) rate(:,:, 95) = rate(:,:, 95) * 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(:,:,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(:,:,117) = rate(:,:,117) * 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(:,:,135) = rate(:,:,135) * m(:,:) - rate(:,:,136) = rate(:,:,136) * 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(:,:,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(:,:,172) = rate(:,:,172) * 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(:,:,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(:,:,245) = rate(:,:,245) * m(:,:) - rate(:,:,246) = rate(:,:,246) * 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(:,:,252) = rate(:,:,252) * 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(:,:,269) = rate(:,:,269) * m(:,:) - rate(:,:,274) = rate(:,:,274) * m(:,:) - rate(:,:,275) = rate(:,:,275) * m(:,:) - rate(:,:,276) = rate(:,:,276) * m(:,:) - rate(:,:,279) = rate(:,:,279) * m(:,:) - rate(:,:,280) = rate(:,:,280) * m(:,:) - rate(:,:,281) = rate(:,:,281) * m(:,:) - rate(:,:,284) = rate(:,:,284) * m(:,:) - rate(:,:,288) = rate(:,:,288) * m(:,:) - rate(:,:,289) = rate(:,:,289) * m(:,:) - rate(:,:,290) = rate(:,:,290) * m(:,:) - rate(:,:,291) = rate(:,:,291) * m(:,:) - rate(:,:,292) = rate(:,:,292) * 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(:,:,299) = rate(:,:,299) * m(:,:) - rate(:,:,300) = rate(:,:,300) * m(:,:) - rate(:,:,302) = rate(:,:,302) * m(:,:) - rate(:,:,303) = rate(:,:,303) * m(:,:) - rate(:,:,304) = rate(:,:,304) * m(:,:) - rate(:,:,306) = rate(:,:,306) * m(:,:) - rate(:,:,307) = rate(:,:,307) * m(:,:) - rate(:,:,308) = rate(:,:,308) * m(:,:) - rate(:,:,309) = rate(:,:,309) * m(:,:) - rate(:,:,312) = rate(:,:,312) * m(:,:) + rate(:,:, 101) = rate(:,:, 101) * m(:,:) + rate(:,:, 102) = rate(:,:, 102) * m(:,:) + rate(:,:, 103) = rate(:,:, 103) * 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(:,:, 117) = rate(:,:, 117) * 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(:,:, 135) = rate(:,:, 135) * m(:,:) + rate(:,:, 136) = rate(:,:, 136) * 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(:,:, 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(:,:, 172) = rate(:,:, 172) * 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(:,:, 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * 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(:,:, 252) = rate(:,:, 252) * 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(:,:, 268) = rate(:,:, 268) * m(:,:) + rate(:,:, 273) = rate(:,:, 273) * m(:,:) + rate(:,:, 274) = rate(:,:, 274) * m(:,:) + rate(:,:, 275) = rate(:,:, 275) * m(:,:) + rate(:,:, 278) = rate(:,:, 278) * m(:,:) + rate(:,:, 279) = rate(:,:, 279) * m(:,:) + rate(:,:, 280) = rate(:,:, 280) * m(:,:) + rate(:,:, 283) = rate(:,:, 283) * 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(:,:, 292) = rate(:,:, 292) * m(:,:) + rate(:,:, 293) = rate(:,:, 293) * m(:,:) + rate(:,:, 294) = rate(:,:, 294) * m(:,:) + rate(:,:, 295) = rate(:,:, 295) * m(:,:) + rate(:,:, 296) = rate(:,:, 296) * m(:,:) + rate(:,:, 298) = rate(:,:, 298) * m(:,:) + rate(:,:, 299) = rate(:,:, 299) * m(:,:) + rate(:,:, 301) = rate(:,:, 301) * m(:,:) + rate(:,:, 302) = rate(:,:, 302) * m(:,:) + rate(:,:, 303) = rate(:,:, 303) * m(:,:) + rate(:,:, 305) = rate(:,:, 305) * m(:,:) + rate(:,:, 306) = rate(:,:, 306) * m(:,:) + rate(:,:, 307) = rate(:,:, 307) * m(:,:) + rate(:,:, 308) = rate(:,:, 308) * m(:,:) + rate(:,:, 311) = rate(:,:, 311) * m(:,:) end subroutine adjrxt end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_indprd.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_indprd.F90 index 0d72168858..0ccfc9741c 100644 --- a/src/chemistry/pp_waccm_ma_mam4/mo_indprd.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/mo_indprd.F90 @@ -17,126 +17,112 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) real(r8), intent(in) :: extfrc(chnkpnts,extcnt) real(r8), intent(inout) :: prod(chnkpnts,nprod) !-------------------------------------------------------------------- -! ... "independent" production for Explicit species +! ... "independent" production for Implicit species !-------------------------------------------------------------------- - if( class == 1 ) then - prod(:,1) = 0._r8 - prod(:,2) = 0._r8 + if( class == 4 ) then + prod(:,1) = + extfrc(:,14) + prod(:,2) = + extfrc(:,3) + prod(:,94) = 0._r8 + prod(:,43) = 0._r8 + prod(:,93) = 0._r8 + prod(:,60) = 0._r8 prod(:,3) = 0._r8 + prod(:,25) = 0._r8 + prod(:,32) = 0._r8 + prod(:,33) = 0._r8 + prod(:,27) = 0._r8 + prod(:,34) = 0._r8 + prod(:,28) = 0._r8 + prod(:,35) = 0._r8 + prod(:,29) = 0._r8 + prod(:,55) = 0._r8 + prod(:,84) = 0._r8 + prod(:,61) = 0._r8 + prod(:,30) = 0._r8 + prod(:,52) = 0._r8 + prod(:,80) = 0._r8 + prod(:,54) = 0._r8 + prod(:,79) = 0._r8 + prod(:,53) = 0._r8 + prod(:,98) = 0._r8 + prod(:,36) = 0._r8 + prod(:,24) = 0._r8 + prod(:,88) = 0._r8 + prod(:,73) = 0._r8 prod(:,4) = 0._r8 + prod(:,70) = + extfrc(:,10) + prod(:,59) = 0._r8 + prod(:,42) = 0._r8 + prod(:,40) = 0._r8 + prod(:,49) = + extfrc(:,2) prod(:,5) = 0._r8 prod(:,6) = 0._r8 prod(:,7) = 0._r8 - prod(:,8) = 0._r8 - prod(:,9) = 0._r8 - prod(:,10) = 0._r8 - prod(:,11) = 0._r8 - prod(:,12) = 0._r8 - prod(:,13) = 0._r8 - prod(:,14) = 0._r8 - prod(:,15) = 0._r8 - prod(:,16) = 0._r8 - prod(:,17) = (rxt(:,242)*y(:,96) +rxt(:,246)*y(:,96))*y(:,29) - prod(:,18) = 0._r8 - prod(:,19) = 0._r8 - prod(:,20) = 0._r8 - prod(:,21) = 0._r8 - prod(:,22) =rxt(:,132)*y(:,60)*y(:,53) - prod(:,23) = 0._r8 -!-------------------------------------------------------------------- -! ... "independent" production for Implicit species -!-------------------------------------------------------------------- - else if( class == 4 ) then - prod(:,1) = + extfrc(:,14) - prod(:,2) = + extfrc(:,3) - prod(:,29) = 0._r8 prod(:,71) = 0._r8 - prod(:,40) = 0._r8 - prod(:,68) =.180_r8*rxt(:,24)*y(:,22) - prod(:,62) =rxt(:,39)*y(:,17) +rxt(:,41)*y(:,19) +rxt(:,23)*y(:,22) - prod(:,35) = 0._r8 + prod(:,82) = 0._r8 + prod(:,99) = 0._r8 prod(:,26) = 0._r8 - prod(:,21) = 0._r8 - prod(:,66) = 0._r8 - prod(:,56) = 0._r8 - prod(:,39) = (rxt(:,25) +rxt(:,61))*y(:,30) +.380_r8*rxt(:,24)*y(:,22) & - + extfrc(:,10) - prod(:,23) =rxt(:,31)*y(:,8) +rxt(:,32)*y(:,9) +rxt(:,34)*y(:,11) & - +2.000_r8*rxt(:,35)*y(:,12) +2.000_r8*rxt(:,36)*y(:,13) +rxt(:,37) & - *y(:,14) +2.000_r8*rxt(:,50)*y(:,40) +rxt(:,53)*y(:,45) +rxt(:,54) & - *y(:,46) - prod(:,27) =rxt(:,33)*y(:,10) +rxt(:,34)*y(:,11) +rxt(:,52)*y(:,44) - prod(:,32) = + extfrc(:,2) - prod(:,3) = 0._r8 - prod(:,4) = 0._r8 - prod(:,5) = 0._r8 - prod(:,46) =rxt(:,32)*y(:,9) +rxt(:,36)*y(:,13) - prod(:,59) = (rxt(:,23) +.330_r8*rxt(:,24))*y(:,22) - prod(:,70) =1.440_r8*rxt(:,24)*y(:,22) + prod(:,62) = 0._r8 + prod(:,31) = 0._r8 + prod(:,67) = 0._r8 + prod(:,39) = 0._r8 prod(:,41) = 0._r8 - prod(:,22) = 0._r8 - prod(:,49) = 0._r8 - prod(:,61) = 0._r8 - prod(:,28) = 0._r8 - prod(:,57) = 0._r8 - prod(:,36) = 0._r8 - prod(:,45) = 0._r8 + prod(:,46) = 0._r8 + prod(:,83) = 0._r8 prod(:,47) = 0._r8 - prod(:,54) = (rxt(:,64) +.800_r8*rxt(:,66) +.800_r8*rxt(:,68) +rxt(:,70)) & + prod(:,97) = 0._r8 + prod(:,56) = 0._r8 + prod(:,66) = 0._r8 + prod(:,68) = 0._r8 + prod(:,76) = (rxt(:,64) +.800_r8*rxt(:,66) +.800_r8*rxt(:,68) +rxt(:,70)) & + extfrc(:,15) - prod(:,31) = 0._r8 - prod(:,6) = 0._r8 - prod(:,7) = 0._r8 + prod(:,44) = 0._r8 + prod(:,48) = 0._r8 prod(:,8) = 0._r8 - prod(:,76) = + extfrc(:,11) - prod(:,75) = + extfrc(:,12) - prod(:,63) = 0._r8 - prod(:,9) = + extfrc(:,4) - prod(:,10) = + extfrc(:,5) - prod(:,11) = 0._r8 - prod(:,12) = + extfrc(:,6) - prod(:,67) = (rxt(:,25) +rxt(:,61))*y(:,30) +.180_r8*rxt(:,24)*y(:,22) - prod(:,72) = 0._r8 - prod(:,74) = 0._r8 - prod(:,33) = 0._r8 - prod(:,34) = 0._r8 - prod(:,13) = + extfrc(:,7) - prod(:,14) = + extfrc(:,8) - prod(:,43) = 0._r8 - prod(:,58) = 0._r8 - prod(:,55) = + extfrc(:,13) - prod(:,30) = 0._r8 - prod(:,15) = + extfrc(:,9) - prod(:,16) = + extfrc(:,1) + prod(:,9) = 0._r8 + prod(:,10) = 0._r8 + prod(:,91) = + extfrc(:,11) + prod(:,95) = + extfrc(:,12) + prod(:,89) = 0._r8 + prod(:,11) = + extfrc(:,4) + prod(:,12) = + extfrc(:,5) + prod(:,13) = 0._r8 + prod(:,14) = + extfrc(:,6) + prod(:,90) = 0._r8 + prod(:,85) = 0._r8 + prod(:,86) = 0._r8 + prod(:,50) = 0._r8 + prod(:,51) = 0._r8 + prod(:,15) = + extfrc(:,7) + prod(:,16) = + extfrc(:,8) + prod(:,64) = 0._r8 prod(:,17) = 0._r8 - prod(:,18) = 0._r8 - prod(:,19) = 0._r8 + prod(:,81) = 0._r8 + prod(:,72) = + extfrc(:,13) + prod(:,45) = 0._r8 + prod(:,18) = + extfrc(:,9) + prod(:,19) = + extfrc(:,1) prod(:,20) = 0._r8 - prod(:,60) =rxt(:,31)*y(:,8) +rxt(:,32)*y(:,9) +2.000_r8*rxt(:,38)*y(:,15) & - +rxt(:,39)*y(:,17) +3.000_r8*rxt(:,42)*y(:,23) +2.000_r8*rxt(:,50) & - *y(:,40) - prod(:,65) =4.000_r8*rxt(:,30)*y(:,7) +rxt(:,31)*y(:,8) +2.000_r8*rxt(:,33) & - *y(:,10) +2.000_r8*rxt(:,34)*y(:,11) +2.000_r8*rxt(:,35)*y(:,12) & - +rxt(:,36)*y(:,13) +2.000_r8*rxt(:,37)*y(:,14) +3.000_r8*rxt(:,40) & - *y(:,18) +rxt(:,41)*y(:,19) +rxt(:,52)*y(:,44) +rxt(:,53)*y(:,45) & - +rxt(:,54)*y(:,46) - prod(:,52) = (rxt(:,63) +rxt(:,64) +rxt(:,65) +rxt(:,67) +rxt(:,69) + & + prod(:,21) = 0._r8 + prod(:,22) = 0._r8 + prod(:,23) = 0._r8 + prod(:,74) = (rxt(:,63) +rxt(:,64) +rxt(:,65) +rxt(:,67) +rxt(:,69) + & rxt(:,70)) + extfrc(:,19) - prod(:,64) = 0._r8 - prod(:,53) = (rxt(:,65) +1.200_r8*rxt(:,66) +1.200_r8*rxt(:,68) +rxt(:,69)) & + prod(:,87) = 0._r8 + prod(:,75) = (rxt(:,65) +1.200_r8*rxt(:,66) +1.200_r8*rxt(:,68) +rxt(:,69)) & + extfrc(:,16) - prod(:,42) = (rxt(:,63) +rxt(:,67)) + extfrc(:,17) - prod(:,44) = 0._r8 - prod(:,48) = (rxt(:,64) +rxt(:,65) +rxt(:,69) +rxt(:,70)) + extfrc(:,20) - prod(:,69) =rxt(:,12)*y(:,54) - prod(:,24) = 0._r8 - prod(:,25) = 0._r8 - prod(:,51) = + extfrc(:,21) - prod(:,73) =.330_r8*rxt(:,24)*y(:,22) + extfrc(:,22) - prod(:,50) = + extfrc(:,18) - prod(:,38) = 0._r8 + prod(:,63) = (rxt(:,63) +rxt(:,67)) + extfrc(:,17) + prod(:,65) = 0._r8 + prod(:,69) = (rxt(:,64) +rxt(:,65) +rxt(:,69) +rxt(:,70)) + extfrc(:,20) + prod(:,92) = 0._r8 prod(:,37) = 0._r8 - prod(:,77) =.050_r8*rxt(:,24)*y(:,22) + prod(:,38) = 0._r8 + prod(:,77) = + extfrc(:,21) + prod(:,96) = + extfrc(:,22) + prod(:,78) = + extfrc(:,18) + prod(:,58) = 0._r8 + prod(:,57) = 0._r8 + prod(:,100) = 0._r8 end if end subroutine indprd end module mo_indprd diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_lin_matrix.F90 index 8c68f34a2c..c7f589b4ad 100644 --- a/src/chemistry/pp_waccm_ma_mam4/mo_lin_matrix.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/mo_lin_matrix.F90 @@ -25,205 +25,205 @@ subroutine linmat01( avec_len, mat, y, rxt, het_rates ) do k = 1,avec_len mat(k,1) = -( het_rates(k,1) ) mat(k,2) = -( het_rates(k,2) ) - mat(k,44) = -( rxt(k,26) + het_rates(k,3) ) - mat(k,592) = -( rxt(k,27) + het_rates(k,4) ) - mat(k,113) = rxt(k,28) - mat(k,107) = -( rxt(k,28) + rxt(k,29) + rxt(k,270) + rxt(k,273) + rxt(k,278) & - + het_rates(k,5) ) - mat(k,517) = -( rxt(k,20) + rxt(k,21) + het_rates(k,16) ) - mat(k,80) = rxt(k,22) - mat(k,542) = rxt(k,244)*y(k,22) + rxt(k,245)*y(k,22) - mat(k,347) = -( het_rates(k,20) ) - mat(k,418) = rxt(k,156)*y(k,22) - mat(k,156) = rxt(k,212)*y(k,22) - mat(k,651) = rxt(k,241)*y(k,22) - mat(k,536) = rxt(k,243)*y(k,22) - mat(k,77) = -( rxt(k,22) + het_rates(k,21) ) - mat(k,35) = -( rxt(k,43) + het_rates(k,24) ) - mat(k,21) = -( rxt(k,44) + rxt(k,190) + het_rates(k,25) ) - mat(k,450) = -( rxt(k,45) + het_rates(k,26) ) - mat(k,267) = rxt(k,47) - mat(k,67) = rxt(k,59) - mat(k,23) = 2.000_r8*rxt(k,190) - mat(k,262) = -( rxt(k,46) + rxt(k,47) + rxt(k,272) + rxt(k,277) + rxt(k,283) & - + het_rates(k,27) ) - mat(k,103) = -( het_rates(k,29) ) - mat(k,505) = rxt(k,20) + rxt(k,21) - mat(k,70) = rxt(k,88) - mat(k,410) = rxt(k,223)*y(k,19) - mat(k,186) = rxt(k,300)*y(k,30) - mat(k,27) = -( rxt(k,48) + het_rates(k,31) ) - mat(k,527) = rxt(k,181)*y(k,8) + rxt(k,183)*y(k,11) + 2.000_r8*rxt(k,184)*y(k,12) & - + 2.000_r8*rxt(k,185)*y(k,13) + rxt(k,186)*y(k,14) & - + rxt(k,207)*y(k,9) + 2.000_r8*rxt(k,209)*y(k,40) & - + rxt(k,233)*y(k,45) + rxt(k,234)*y(k,46) - mat(k,630) = rxt(k,228)*y(k,45) + rxt(k,229)*y(k,46) - mat(k,37) = -( rxt(k,49) + het_rates(k,32) ) - mat(k,529) = rxt(k,182)*y(k,10) + rxt(k,183)*y(k,11) + rxt(k,232)*y(k,44) - mat(k,631) = rxt(k,227)*y(k,44) - mat(k,58) = -( het_rates(k,33) ) - mat(k,3) = -( het_rates(k,34) ) - mat(k,4) = -( het_rates(k,35) ) + mat(k,767) = -( het_rates(k,3) ) + mat(k,98) = rxt(k,26) + mat(k,745) = rxt(k,27) + mat(k,204) = rxt(k,29) + mat(k,56) = rxt(k,31) + mat(k,62) = rxt(k,32) + mat(k,167) = 2.000_r8*rxt(k,38) + mat(k,212) = rxt(k,39) + mat(k,155) = 3.000_r8*rxt(k,42) + mat(k,33) = 2.000_r8*rxt(k,50) + mat(k,258) = rxt(k,51) + mat(k,249) = rxt(k,57) + mat(k,97) = -( rxt(k,26) + het_rates(k,4) ) + mat(k,744) = -( rxt(k,27) + het_rates(k,5) ) + mat(k,203) = rxt(k,28) + mat(k,199) = -( rxt(k,28) + rxt(k,29) + rxt(k,269) + rxt(k,272) + rxt(k,277) & + + het_rates(k,6) ) + mat(k,3) = -( het_rates(k,7) ) + mat(k,27) = -( rxt(k,30) + het_rates(k,8) ) + mat(k,53) = -( rxt(k,31) + het_rates(k,9) ) + mat(k,58) = -( rxt(k,32) + het_rates(k,10) ) + mat(k,34) = -( rxt(k,33) + het_rates(k,11) ) + mat(k,63) = -( rxt(k,34) + het_rates(k,12) ) + mat(k,38) = -( rxt(k,35) + het_rates(k,13) ) + mat(k,68) = -( rxt(k,36) + het_rates(k,14) ) + mat(k,42) = -( rxt(k,37) + het_rates(k,15) ) + mat(k,164) = -( rxt(k,38) + het_rates(k,16) ) + mat(k,472) = -( rxt(k,20) + rxt(k,21) + het_rates(k,17) ) + mat(k,161) = rxt(k,22) + mat(k,394) = .180_r8*rxt(k,24) + mat(k,207) = -( rxt(k,39) + het_rates(k,18) ) + mat(k,46) = -( rxt(k,40) + het_rates(k,19) ) + mat(k,144) = -( rxt(k,41) + het_rates(k,20) ) + mat(k,408) = -( het_rates(k,21) ) + mat(k,391) = rxt(k,23) + mat(k,208) = rxt(k,39) + mat(k,146) = rxt(k,41) + mat(k,158) = -( rxt(k,22) + het_rates(k,22) ) + mat(k,390) = -( rxt(k,23) + rxt(k,24) + het_rates(k,23) ) + mat(k,152) = -( rxt(k,42) + het_rates(k,24) ) + mat(k,904) = -( het_rates(k,25) ) + mat(k,99) = rxt(k,26) + mat(k,29) = 4.000_r8*rxt(k,30) + mat(k,57) = rxt(k,31) + mat(k,37) = 2.000_r8*rxt(k,33) + mat(k,67) = 2.000_r8*rxt(k,34) + mat(k,41) = 2.000_r8*rxt(k,35) + mat(k,72) = rxt(k,36) + mat(k,45) = 2.000_r8*rxt(k,37) + mat(k,48) = 3.000_r8*rxt(k,40) + mat(k,150) = rxt(k,41) + mat(k,74) = 2.000_r8*rxt(k,43) + mat(k,26) = 2.000_r8*rxt(k,44) + mat(k,591) = rxt(k,45) + mat(k,313) = rxt(k,46) + mat(k,88) = rxt(k,49) + mat(k,84) = rxt(k,52) + mat(k,93) = rxt(k,53) + mat(k,114) = rxt(k,54) + mat(k,463) = rxt(k,55) + mat(k,267) = rxt(k,58) + mat(k,73) = -( rxt(k,43) + het_rates(k,26) ) + mat(k,24) = -( rxt(k,44) + rxt(k,190) + het_rates(k,27) ) + mat(k,581) = -( rxt(k,45) + het_rates(k,28) ) + mat(k,307) = rxt(k,47) + mat(k,134) = rxt(k,59) + mat(k,25) = 2.000_r8*rxt(k,190) + mat(k,305) = -( rxt(k,46) + rxt(k,47) + rxt(k,271) + rxt(k,276) + rxt(k,282) & + + het_rates(k,29) ) + mat(k,4) = -( het_rates(k,30) ) + mat(k,279) = -( het_rates(k,31) ) + mat(k,467) = rxt(k,20) + rxt(k,21) + mat(k,386) = .380_r8*rxt(k,24) + mat(k,194) = rxt(k,25) + rxt(k,61) + mat(k,138) = rxt(k,88) + mat(k,193) = -( rxt(k,25) + rxt(k,61) + het_rates(k,32) ) + mat(k,385) = .440_r8*rxt(k,24) + mat(k,94) = -( rxt(k,48) + het_rates(k,33) ) + mat(k,54) = rxt(k,31) + mat(k,59) = rxt(k,32) + mat(k,65) = rxt(k,34) + mat(k,39) = 2.000_r8*rxt(k,35) + mat(k,69) = 2.000_r8*rxt(k,36) + mat(k,43) = rxt(k,37) + mat(k,31) = 2.000_r8*rxt(k,50) + mat(k,90) = rxt(k,53) + mat(k,109) = rxt(k,54) + mat(k,85) = -( rxt(k,49) + het_rates(k,34) ) + mat(k,35) = rxt(k,33) + mat(k,64) = rxt(k,34) + mat(k,81) = rxt(k,52) + mat(k,125) = -( het_rates(k,35) ) mat(k,5) = -( het_rates(k,36) ) - mat(k,153) = -( rxt(k,212)*y(k,22) + het_rates(k,37) ) - mat(k,28) = 2.000_r8*rxt(k,48) - mat(k,38) = rxt(k,49) - mat(k,42) = rxt(k,56) - mat(k,530) = rxt(k,185)*y(k,13) + rxt(k,207)*y(k,9) - mat(k,299) = -( het_rates(k,38) ) - mat(k,747) = 2.000_r8*rxt(k,2) + rxt(k,3) - mat(k,508) = 2.000_r8*rxt(k,20) - mat(k,78) = rxt(k,22) - mat(k,179) = rxt(k,51) - mat(k,327) = rxt(k,55) - mat(k,43) = rxt(k,56) - mat(k,533) = rxt(k,244)*y(k,22) - mat(k,565) = -( het_rates(k,39) ) - mat(k,757) = rxt(k,1) - mat(k,519) = rxt(k,21) - mat(k,544) = rxt(k,245)*y(k,22) - mat(k,115) = -( rxt(k,4) + het_rates(k,41) ) - mat(k,386) = .500_r8*rxt(k,264) - mat(k,24) = -( rxt(k,87) + het_rates(k,42) ) - mat(k,178) = -( rxt(k,51) + het_rates(k,43) ) - mat(k,329) = -( rxt(k,55) + het_rates(k,47) ) - mat(k,417) = rxt(k,156)*y(k,22) + rxt(k,218)*y(k,15) + rxt(k,220)*y(k,17) & - + 2.000_r8*rxt(k,223)*y(k,19) + rxt(k,225)*y(k,23) - mat(k,41) = -( rxt(k,56) + het_rates(k,48) ) - mat(k,152) = rxt(k,212)*y(k,22) - mat(k,274) = -( rxt(k,9) + het_rates(k,49) ) - mat(k,53) = 2.000_r8*rxt(k,265) + 2.000_r8*rxt(k,268) + 2.000_r8*rxt(k,271) & - + 2.000_r8*rxt(k,282) - mat(k,696) = .500_r8*rxt(k,266) - mat(k,364) = rxt(k,267) - mat(k,109) = rxt(k,270) + rxt(k,273) + rxt(k,278) - mat(k,263) = rxt(k,272) + rxt(k,277) + rxt(k,283) - mat(k,83) = -( rxt(k,10) + rxt(k,11) + rxt(k,153) + het_rates(k,50) ) - mat(k,144) = -( rxt(k,57) + het_rates(k,51) ) - mat(k,108) = rxt(k,270) + rxt(k,273) + rxt(k,278) - mat(k,162) = -( rxt(k,58) + het_rates(k,52) ) - mat(k,261) = rxt(k,272) + rxt(k,277) + rxt(k,283) - mat(k,244) = -( rxt(k,62) + het_rates(k,53) ) - mat(k,721) = rxt(k,15) - mat(k,193) = rxt(k,301) - mat(k,52) = -( rxt(k,13) + rxt(k,14) + rxt(k,154) + rxt(k,265) + rxt(k,268) & - + rxt(k,271) + rxt(k,282) + het_rates(k,55) ) - mat(k,6) = -( het_rates(k,56) ) - mat(k,7) = -( het_rates(k,57) ) + mat(k,6) = -( het_rates(k,37) ) + mat(k,7) = -( het_rates(k,38) ) + mat(k,287) = -( het_rates(k,39) ) + mat(k,60) = rxt(k,32) + mat(k,70) = rxt(k,36) + mat(k,95) = 2.000_r8*rxt(k,48) + mat(k,86) = rxt(k,49) + mat(k,117) = rxt(k,56) + mat(k,436) = -( het_rates(k,40) ) + mat(k,938) = 2.000_r8*rxt(k,2) + rxt(k,3) + mat(k,470) = 2.000_r8*rxt(k,20) + mat(k,160) = rxt(k,22) + mat(k,392) = rxt(k,23) + .330_r8*rxt(k,24) + mat(k,254) = rxt(k,51) + mat(k,449) = rxt(k,55) + mat(k,118) = rxt(k,56) + mat(k,928) = -( het_rates(k,41) ) + mat(k,955) = rxt(k,1) + mat(k,487) = rxt(k,21) + mat(k,405) = 1.440_r8*rxt(k,24) + mat(k,30) = -( rxt(k,50) + het_rates(k,42) ) + mat(k,216) = -( rxt(k,4) + het_rates(k,43) ) + mat(k,542) = .500_r8*rxt(k,263) + mat(k,50) = -( rxt(k,87) + het_rates(k,44) ) + mat(k,253) = -( rxt(k,51) + het_rates(k,45) ) + mat(k,80) = -( rxt(k,52) + het_rates(k,46) ) + mat(k,89) = -( rxt(k,53) + het_rates(k,47) ) + mat(k,110) = -( rxt(k,54) + het_rates(k,48) ) + mat(k,450) = -( rxt(k,55) + het_rates(k,49) ) + mat(k,116) = -( rxt(k,56) + het_rates(k,50) ) + mat(k,871) = -( rxt(k,9) + het_rates(k,51) ) + mat(k,124) = 2.000_r8*rxt(k,264) + 2.000_r8*rxt(k,267) + 2.000_r8*rxt(k,270) & + + 2.000_r8*rxt(k,281) + mat(k,799) = .500_r8*rxt(k,265) + mat(k,615) = rxt(k,266) + mat(k,206) = rxt(k,269) + rxt(k,272) + rxt(k,277) + mat(k,312) = rxt(k,271) + rxt(k,276) + rxt(k,282) + mat(k,171) = -( rxt(k,10) + rxt(k,11) + rxt(k,153) + het_rates(k,52) ) + mat(k,245) = -( rxt(k,57) + het_rates(k,53) ) + mat(k,200) = rxt(k,269) + rxt(k,272) + rxt(k,277) + mat(k,262) = -( rxt(k,58) + het_rates(k,54) ) + mat(k,304) = rxt(k,271) + rxt(k,276) + rxt(k,282) + mat(k,344) = -( rxt(k,62) + het_rates(k,55) ) + mat(k,664) = rxt(k,15) + mat(k,373) = rxt(k,300) + mat(k,100) = -( rxt(k,12) + het_rates(k,56) ) + mat(k,119) = -( rxt(k,13) + rxt(k,14) + rxt(k,154) + rxt(k,264) + rxt(k,267) & + + rxt(k,270) + rxt(k,281) + het_rates(k,57) ) mat(k,8) = -( het_rates(k,58) ) - mat(k,738) = -( rxt(k,15) + rxt(k,16) + het_rates(k,59) ) - mat(k,57) = rxt(k,14) - mat(k,715) = rxt(k,17) + .500_r8*rxt(k,266) - mat(k,382) = rxt(k,19) - mat(k,207) = rxt(k,298) - mat(k,96) = rxt(k,311) - mat(k,550) = 2.000_r8*rxt(k,147)*y(k,54) - mat(k,714) = -( rxt(k,17) + rxt(k,266) + het_rates(k,60) ) - mat(k,280) = rxt(k,9) - mat(k,88) = rxt(k,11) + rxt(k,153) - mat(k,56) = rxt(k,13) + rxt(k,154) - mat(k,381) = rxt(k,18) - mat(k,114) = rxt(k,28) - mat(k,270) = rxt(k,47) - mat(k,369) = -( rxt(k,18) + rxt(k,19) + rxt(k,267) + het_rates(k,61) ) - mat(k,84) = rxt(k,10) - mat(k,54) = rxt(k,13) + rxt(k,14) + rxt(k,154) - mat(k,111) = rxt(k,29) - mat(k,265) = rxt(k,46) - mat(k,9) = -( het_rates(k,62) ) - mat(k,10) = -( het_rates(k,63) ) + mat(k,9) = -( het_rates(k,59) ) + mat(k,10) = -( het_rates(k,60) ) + mat(k,676) = -( rxt(k,15) + rxt(k,16) + het_rates(k,61) ) + mat(k,122) = rxt(k,14) + mat(k,793) = rxt(k,17) + .500_r8*rxt(k,265) + mat(k,609) = rxt(k,19) + mat(k,363) = rxt(k,297) + mat(k,184) = rxt(k,310) + mat(k,797) = -( rxt(k,17) + rxt(k,265) + het_rates(k,62) ) + mat(k,869) = rxt(k,9) + mat(k,175) = rxt(k,11) + rxt(k,153) + mat(k,123) = rxt(k,13) + rxt(k,154) + mat(k,613) = rxt(k,18) + mat(k,205) = rxt(k,28) + mat(k,310) = rxt(k,47) + mat(k,607) = -( rxt(k,18) + rxt(k,19) + rxt(k,266) + het_rates(k,63) ) + mat(k,174) = rxt(k,10) + mat(k,120) = rxt(k,13) + rxt(k,14) + rxt(k,154) + mat(k,201) = rxt(k,29) + mat(k,308) = rxt(k,46) mat(k,11) = -( het_rates(k,64) ) mat(k,12) = -( het_rates(k,65) ) - mat(k,494) = -( rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & - + rxt(k,76) + het_rates(k,66) ) - mat(k,754) = rxt(k,2) - mat(k,619) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,79) + rxt(k,81) & + mat(k,13) = -( het_rates(k,66) ) + mat(k,14) = -( het_rates(k,67) ) + mat(k,650) = -( rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & + + rxt(k,76) + het_rates(k,68) ) + mat(k,946) = rxt(k,2) + mat(k,509) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,79) + rxt(k,81) & + 2.000_r8*rxt(k,82) + 2.000_r8*rxt(k,83) + rxt(k,84) + rxt(k,85) & + rxt(k,86) - mat(k,678) = rxt(k,8) - mat(k,55) = rxt(k,14) - mat(k,729) = rxt(k,15) - mat(k,706) = rxt(k,17) - mat(k,373) = rxt(k,18) - mat(k,588) = rxt(k,27) - mat(k,451) = rxt(k,45) - mat(k,68) = rxt(k,59) - mat(k,291) = rxt(k,89) - mat(k,257) = rxt(k,90) - mat(k,50) = rxt(k,91) - mat(k,541) = rxt(k,96) - mat(k,101) = rxt(k,305) - mat(k,95) = rxt(k,310) - mat(k,624) = -( rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,78) + rxt(k,79) & + mat(k,530) = rxt(k,8) + mat(k,121) = rxt(k,14) + mat(k,675) = rxt(k,15) + mat(k,792) = rxt(k,17) + mat(k,608) = rxt(k,18) + mat(k,398) = .180_r8*rxt(k,24) + mat(k,198) = rxt(k,25) + rxt(k,61) + mat(k,741) = rxt(k,27) + mat(k,583) = rxt(k,45) + mat(k,135) = rxt(k,59) + mat(k,428) = rxt(k,89) + mat(k,300) = rxt(k,90) + mat(k,107) = rxt(k,91) + mat(k,717) = rxt(k,96) + mat(k,190) = rxt(k,304) + mat(k,183) = rxt(k,309) + mat(k,505) = -( rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,78) + rxt(k,79) & + rxt(k,80) + rxt(k,81) + rxt(k,82) + rxt(k,83) + rxt(k,84) & - + rxt(k,85) + rxt(k,86) + het_rates(k,67) ) - mat(k,683) = rxt(k,8) - mat(k,378) = rxt(k,19) - mat(k,31) = rxt(k,92) + rxt(k,100) - mat(k,34) = rxt(k,93) - mat(k,546) = rxt(k,148)*y(k,54) - mat(k,685) = -( rxt(k,7) + rxt(k,8) + het_rates(k,68) ) - mat(k,64) = -( rxt(k,59) + het_rates(k,69) ) - mat(k,69) = -( rxt(k,88) + het_rates(k,70) ) - mat(k,13) = -( het_rates(k,71) ) - mat(k,14) = -( het_rates(k,72) ) - mat(k,131) = -( het_rates(k,73) ) - mat(k,71) = rxt(k,88) - mat(k,283) = rxt(k,89) - mat(k,285) = -( rxt(k,89) + het_rates(k,75) ) - mat(k,255) = rxt(k,90) - mat(k,254) = -( rxt(k,90) + het_rates(k,76) ) - mat(k,49) = rxt(k,91) - mat(k,48) = -( rxt(k,91) + het_rates(k,77) ) - mat(k,25) = rxt(k,87) - mat(k,15) = -( het_rates(k,78) ) - mat(k,16) = -( het_rates(k,79) ) - mat(k,17) = -( het_rates(k,80) ) - mat(k,18) = -( het_rates(k,81) ) - mat(k,19) = -( het_rates(k,82) ) - mat(k,20) = -( het_rates(k,83) ) - mat(k,310) = -( het_rates(k,84) ) - mat(k,45) = rxt(k,26) - mat(k,581) = rxt(k,27) - mat(k,110) = rxt(k,29) - mat(k,180) = rxt(k,51) - mat(k,145) = rxt(k,57) - mat(k,534) = rxt(k,181)*y(k,8) + rxt(k,207)*y(k,9) + 3.000_r8*rxt(k,208)*y(k,23) & - + 2.000_r8*rxt(k,209)*y(k,40) + 2.000_r8*rxt(k,230)*y(k,15) & - + rxt(k,231)*y(k,17) - mat(k,416) = 2.000_r8*rxt(k,218)*y(k,15) + rxt(k,220)*y(k,17) & - + 3.000_r8*rxt(k,225)*y(k,23) - mat(k,649) = 2.000_r8*rxt(k,219)*y(k,15) + rxt(k,221)*y(k,17) & - + 3.000_r8*rxt(k,226)*y(k,23) - mat(k,421) = -( rxt(k,156)*y(k,22) + rxt(k,218)*y(k,15) + rxt(k,220)*y(k,17) & - + rxt(k,223)*y(k,19) + rxt(k,225)*y(k,23) + het_rates(k,85) ) - mat(k,46) = rxt(k,26) - mat(k,36) = 2.000_r8*rxt(k,43) - mat(k,22) = 2.000_r8*rxt(k,44) - mat(k,449) = rxt(k,45) - mat(k,266) = rxt(k,46) - mat(k,39) = rxt(k,49) - mat(k,333) = rxt(k,55) - mat(k,164) = rxt(k,58) - mat(k,539) = 4.000_r8*rxt(k,180)*y(k,7) + rxt(k,181)*y(k,8) & - + 2.000_r8*rxt(k,182)*y(k,10) + 2.000_r8*rxt(k,183)*y(k,11) & - + 2.000_r8*rxt(k,184)*y(k,12) + rxt(k,185)*y(k,13) & - + 2.000_r8*rxt(k,186)*y(k,14) + rxt(k,232)*y(k,44) & - + rxt(k,233)*y(k,45) + rxt(k,234)*y(k,46) - mat(k,654) = 3.000_r8*rxt(k,222)*y(k,18) + rxt(k,224)*y(k,19) & - + rxt(k,227)*y(k,44) + rxt(k,228)*y(k,45) + rxt(k,229)*y(k,46) - mat(k,215) = -( het_rates(k,86) ) - mat(k,719) = rxt(k,16) - mat(k,242) = rxt(k,62) - mat(k,479) = rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & - + rxt(k,76) - mat(k,609) = rxt(k,77) + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) & - + rxt(k,84) + rxt(k,85) + rxt(k,86) - mat(k,395) = -( rxt(k,264) + het_rates(k,87) ) - mat(k,85) = rxt(k,11) + rxt(k,153) - mat(k,420) = rxt(k,220)*y(k,17) + rxt(k,223)*y(k,19) - mat(k,653) = rxt(k,221)*y(k,17) + rxt(k,224)*y(k,19) - mat(k,538) = rxt(k,244)*y(k,22) + + rxt(k,85) + rxt(k,86) + het_rates(k,69) ) + mat(k,525) = rxt(k,8) + mat(k,603) = rxt(k,19) + mat(k,76) = rxt(k,92) + rxt(k,100) + mat(k,79) = rxt(k,93) + mat(k,526) = -( rxt(k,7) + rxt(k,8) + het_rates(k,70) ) + mat(k,131) = -( rxt(k,59) + het_rates(k,71) ) + mat(k,136) = -( rxt(k,88) + het_rates(k,72) ) + mat(k,15) = -( het_rates(k,73) ) end do end subroutine linmat01 subroutine linmat02( avec_len, mat, y, rxt, het_rates ) @@ -246,65 +246,80 @@ subroutine linmat02( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,229) = -( het_rates(k,88) ) - mat(k,122) = -( het_rates(k,89) ) - mat(k,98) = rxt(k,305) - mat(k,92) = rxt(k,310) - mat(k,138) = -( het_rates(k,90) ) - mat(k,717) = rxt(k,16) - mat(k,199) = rxt(k,298) - mat(k,187) = rxt(k,301) - mat(k,170) = -( het_rates(k,91) ) - mat(k,239) = rxt(k,62) - mat(k,93) = rxt(k,311) - mat(k,543) = -( rxt(k,96) + rxt(k,147)*y(k,54) + rxt(k,148)*y(k,54) & - + rxt(k,180)*y(k,7) + rxt(k,181)*y(k,8) + rxt(k,182)*y(k,10) & - + rxt(k,183)*y(k,11) + rxt(k,184)*y(k,12) + rxt(k,185)*y(k,13) & - + rxt(k,186)*y(k,14) + rxt(k,207)*y(k,9) + rxt(k,208)*y(k,23) & - + rxt(k,209)*y(k,40) + rxt(k,230)*y(k,15) + rxt(k,231)*y(k,17) & - + rxt(k,232)*y(k,44) + rxt(k,233)*y(k,45) + rxt(k,234)*y(k,46) & - + rxt(k,243)*y(k,22) + rxt(k,244)*y(k,22) + rxt(k,245)*y(k,22) & - + het_rates(k,92) ) - mat(k,756) = rxt(k,1) - mat(k,621) = rxt(k,6) - mat(k,680) = rxt(k,7) - mat(k,30) = -( rxt(k,92) + rxt(k,100) + het_rates(k,93) ) - mat(k,667) = rxt(k,7) - mat(k,32) = rxt(k,104) + rxt(k,103)*y(k,30) - mat(k,33) = -( rxt(k,93) + rxt(k,104) + rxt(k,103)*y(k,30) + het_rates(k,94) ) - mat(k,200) = -( rxt(k,298) + het_rates(k,95) ) - mat(k,608) = rxt(k,78) + rxt(k,80) - mat(k,190) = rxt(k,300)*y(k,30) - mat(k,662) = -( rxt(k,219)*y(k,15) + rxt(k,221)*y(k,17) + rxt(k,222)*y(k,18) & - + rxt(k,224)*y(k,19) + rxt(k,226)*y(k,23) + rxt(k,227)*y(k,44) & - + rxt(k,228)*y(k,45) + rxt(k,229)*y(k,46) + rxt(k,241)*y(k,22) & - + het_rates(k,96) ) - mat(k,760) = rxt(k,3) - mat(k,120) = 2.000_r8*rxt(k,4) - mat(k,279) = rxt(k,9) - mat(k,87) = rxt(k,10) - mat(k,81) = rxt(k,22) - mat(k,150) = rxt(k,57) - mat(k,167) = rxt(k,58) - mat(k,712) = .500_r8*rxt(k,266) - mat(k,547) = rxt(k,243)*y(k,22) - mat(k,189) = -( rxt(k,301) + rxt(k,300)*y(k,30) + het_rates(k,97) ) - mat(k,477) = rxt(k,73) + rxt(k,74) - mat(k,607) = rxt(k,79) + rxt(k,81) - mat(k,94) = rxt(k,285) - mat(k,99) = rxt(k,286) - mat(k,97) = -( rxt(k,286) + rxt(k,305) + het_rates(k,98) ) - mat(k,466) = rxt(k,75) + rxt(k,76) - mat(k,602) = rxt(k,85) + rxt(k,86) - mat(k,91) = rxt(k,287) - mat(k,90) = -( rxt(k,285) + rxt(k,287) + rxt(k,310) + rxt(k,311) & + mat(k,16) = -( het_rates(k,74) ) + mat(k,232) = -( het_rates(k,75) ) + mat(k,137) = rxt(k,88) + mat(k,420) = rxt(k,89) + mat(k,17) = -( rxt(k,60) + het_rates(k,76) ) + mat(k,422) = -( rxt(k,89) + het_rates(k,77) ) + mat(k,298) = rxt(k,90) + mat(k,297) = -( rxt(k,90) + het_rates(k,78) ) + mat(k,106) = rxt(k,91) + mat(k,105) = -( rxt(k,91) + het_rates(k,79) ) + mat(k,51) = rxt(k,87) + mat(k,18) = -( het_rates(k,80) ) + mat(k,19) = -( het_rates(k,81) ) + mat(k,20) = -( het_rates(k,82) ) + mat(k,21) = -( het_rates(k,83) ) + mat(k,22) = -( het_rates(k,84) ) + mat(k,23) = -( het_rates(k,85) ) + mat(k,320) = -( het_rates(k,86) ) + mat(k,662) = rxt(k,16) + mat(k,342) = rxt(k,62) + mat(k,636) = rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & + + rxt(k,76) + mat(k,498) = rxt(k,77) + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) & + + rxt(k,84) + rxt(k,85) + rxt(k,86) + mat(k,552) = -( rxt(k,263) + het_rates(k,87) ) + mat(k,173) = rxt(k,11) + rxt(k,153) + mat(k,331) = -( het_rates(k,88) ) + mat(k,223) = -( het_rates(k,89) ) + mat(k,186) = rxt(k,304) + mat(k,180) = rxt(k,309) + mat(k,239) = -( het_rates(k,90) ) + mat(k,661) = rxt(k,16) + mat(k,354) = rxt(k,297) + mat(k,368) = rxt(k,300) + mat(k,270) = -( het_rates(k,91) ) + mat(k,341) = rxt(k,62) + mat(k,181) = rxt(k,310) + mat(k,719) = -( rxt(k,96) + het_rates(k,92) ) + mat(k,948) = rxt(k,1) + mat(k,511) = rxt(k,6) + mat(k,532) = rxt(k,7) + mat(k,103) = rxt(k,12) + mat(k,75) = -( rxt(k,92) + rxt(k,100) + het_rates(k,93) ) + mat(k,519) = rxt(k,7) + mat(k,77) = rxt(k,104) + mat(k,78) = -( rxt(k,93) + rxt(k,104) + het_rates(k,94) ) + mat(k,358) = -( rxt(k,297) + het_rates(k,95) ) + mat(k,501) = rxt(k,78) + rxt(k,80) + mat(k,847) = -( het_rates(k,96) ) + mat(k,952) = rxt(k,3) + mat(k,220) = 2.000_r8*rxt(k,4) + mat(k,870) = rxt(k,9) + mat(k,176) = rxt(k,10) + mat(k,162) = rxt(k,22) + mat(k,402) = .330_r8*rxt(k,24) + mat(k,250) = rxt(k,57) + mat(k,266) = rxt(k,58) + mat(k,798) = .500_r8*rxt(k,265) + mat(k,375) = -( rxt(k,300) + het_rates(k,97) ) + mat(k,640) = rxt(k,73) + rxt(k,74) + mat(k,502) = rxt(k,79) + rxt(k,81) + mat(k,182) = rxt(k,284) + mat(k,188) = rxt(k,285) + mat(k,185) = -( rxt(k,285) + rxt(k,304) + het_rates(k,98) ) + mat(k,623) = rxt(k,75) + rxt(k,76) + mat(k,492) = rxt(k,85) + rxt(k,86) + mat(k,179) = rxt(k,286) + mat(k,178) = -( rxt(k,284) + rxt(k,286) + rxt(k,309) + rxt(k,310) & + het_rates(k,99) ) - mat(k,465) = rxt(k,71) + rxt(k,72) - mat(k,601) = rxt(k,77) + rxt(k,84) - mat(k,764) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,100) ) - mat(k,26) = rxt(k,87) - mat(k,666) = rxt(k,219)*y(k,15) + rxt(k,221)*y(k,17) + rxt(k,222)*y(k,18) & - + rxt(k,224)*y(k,19) + rxt(k,229)*y(k,46) + rxt(k,241)*y(k,22) + mat(k,622) = rxt(k,71) + rxt(k,72) + mat(k,491) = rxt(k,77) + rxt(k,84) + mat(k,956) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,100) ) + mat(k,406) = .050_r8*rxt(k,24) + mat(k,52) = rxt(k,87) end do end subroutine linmat02 subroutine linmat( avec_len, mat, y, rxt, het_rates ) diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_lu_factor.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_lu_factor.F90 index 212376423d..ea79a852c8 100644 --- a/src/chemistry/pp_waccm_ma_mam4/mo_lu_factor.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/mo_lu_factor.F90 @@ -38,88 +38,60 @@ subroutine lu_fac01( avec_len, lu ) 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) = lu(k,22) * lu(k,21) - lu(k,23) = lu(k,23) * lu(k,21) - lu(k,449) = lu(k,449) - lu(k,22) * lu(k,434) - lu(k,450) = lu(k,450) - lu(k,23) * lu(k,434) + 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) = lu(k,25) * lu(k,24) lu(k,26) = lu(k,26) * lu(k,24) - lu(k,48) = lu(k,48) - lu(k,25) * lu(k,47) - lu(k,51) = lu(k,51) - lu(k,26) * lu(k,47) - lu(k,742) = lu(k,742) - lu(k,25) * lu(k,740) - lu(k,764) = lu(k,764) - lu(k,26) * lu(k,740) + lu(k,581) = lu(k,581) - lu(k,25) * lu(k,566) + lu(k,591) = lu(k,591) - lu(k,26) * lu(k,566) lu(k,27) = 1._r8 / lu(k,27) lu(k,28) = lu(k,28) * lu(k,27) lu(k,29) = lu(k,29) * lu(k,27) - lu(k,530) = lu(k,530) - lu(k,28) * lu(k,527) - lu(k,543) = lu(k,543) - lu(k,29) * lu(k,527) - lu(k,640) = - lu(k,28) * lu(k,630) - lu(k,658) = - lu(k,29) * lu(k,630) + lu(k,719) = lu(k,719) - lu(k,28) * lu(k,686) + lu(k,725) = lu(k,725) - lu(k,29) * lu(k,686) lu(k,30) = 1._r8 / lu(k,30) lu(k,31) = lu(k,31) * lu(k,30) - lu(k,34) = lu(k,34) - lu(k,31) * lu(k,32) - lu(k,499) = lu(k,499) - lu(k,31) * lu(k,462) - lu(k,624) = lu(k,624) - lu(k,31) * lu(k,599) - lu(k,683) = lu(k,683) - lu(k,31) * lu(k,667) - lu(k,33) = 1._r8 / lu(k,33) - lu(k,34) = lu(k,34) * lu(k,33) - lu(k,499) = lu(k,499) - lu(k,34) * lu(k,463) - lu(k,546) = lu(k,546) - lu(k,34) * lu(k,528) - lu(k,624) = lu(k,624) - lu(k,34) * lu(k,600) - lu(k,683) = lu(k,683) - lu(k,34) * lu(k,668) - lu(k,35) = 1._r8 / lu(k,35) - lu(k,36) = lu(k,36) * lu(k,35) - lu(k,164) = lu(k,164) - lu(k,36) * lu(k,161) - lu(k,266) = lu(k,266) - lu(k,36) * lu(k,260) - lu(k,333) = lu(k,333) - lu(k,36) * lu(k,321) - lu(k,421) = lu(k,421) - lu(k,36) * lu(k,409) - lu(k,449) = lu(k,449) - lu(k,36) * lu(k,435) - lu(k,37) = 1._r8 / lu(k,37) - lu(k,38) = lu(k,38) * lu(k,37) - lu(k,39) = lu(k,39) * lu(k,37) - lu(k,40) = lu(k,40) * lu(k,37) - lu(k,530) = lu(k,530) - lu(k,38) * lu(k,529) - lu(k,539) = lu(k,539) - lu(k,39) * lu(k,529) - lu(k,543) = lu(k,543) - lu(k,40) * lu(k,529) - lu(k,640) = lu(k,640) - lu(k,38) * lu(k,631) - lu(k,654) = lu(k,654) - lu(k,39) * lu(k,631) - lu(k,658) = lu(k,658) - lu(k,40) * lu(k,631) - lu(k,41) = 1._r8 / lu(k,41) - lu(k,42) = lu(k,42) * lu(k,41) - lu(k,43) = lu(k,43) * lu(k,41) - lu(k,153) = lu(k,153) - lu(k,42) * lu(k,152) - lu(k,155) = lu(k,155) - lu(k,43) * lu(k,152) - lu(k,273) = lu(k,273) - lu(k,42) * lu(k,272) - lu(k,275) = - lu(k,43) * lu(k,272) - lu(k,553) = lu(k,553) - lu(k,42) * lu(k,552) - lu(k,555) = lu(k,555) - lu(k,43) * lu(k,552) - lu(k,743) = lu(k,743) - lu(k,42) * lu(k,741) - lu(k,747) = lu(k,747) - lu(k,43) * lu(k,741) - lu(k,44) = 1._r8 / lu(k,44) - lu(k,45) = lu(k,45) * lu(k,44) - lu(k,46) = lu(k,46) * lu(k,44) - lu(k,145) = lu(k,145) - lu(k,45) * lu(k,143) - lu(k,147) = - lu(k,46) * lu(k,143) - lu(k,328) = - lu(k,45) * lu(k,322) - lu(k,333) = lu(k,333) - lu(k,46) * lu(k,322) - lu(k,444) = lu(k,444) - lu(k,45) * lu(k,436) - lu(k,449) = lu(k,449) - lu(k,46) * lu(k,436) - lu(k,581) = lu(k,581) - lu(k,45) * lu(k,573) - lu(k,586) = lu(k,586) - lu(k,46) * lu(k,573) - 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,51) = lu(k,51) * lu(k,48) - lu(k,254) = lu(k,254) - lu(k,49) * lu(k,253) - lu(k,257) = lu(k,257) - lu(k,50) * lu(k,253) - lu(k,259) = - lu(k,51) * lu(k,253) - lu(k,644) = lu(k,644) - lu(k,49) * lu(k,632) - lu(k,656) = lu(k,656) - lu(k,50) * lu(k,632) - lu(k,666) = lu(k,666) - lu(k,51) * lu(k,632) - lu(k,744) = - lu(k,49) * lu(k,742) - lu(k,754) = lu(k,754) - lu(k,50) * lu(k,742) - lu(k,764) = lu(k,764) - lu(k,51) * lu(k,742) + lu(k,32) = lu(k,32) * lu(k,30) + lu(k,33) = lu(k,33) * lu(k,30) + lu(k,699) = lu(k,699) - lu(k,31) * lu(k,687) + lu(k,719) = lu(k,719) - lu(k,32) * lu(k,687) + lu(k,721) = lu(k,721) - lu(k,33) * lu(k,687) + lu(k,34) = 1._r8 / lu(k,34) + lu(k,35) = lu(k,35) * lu(k,34) + lu(k,36) = lu(k,36) * lu(k,34) + lu(k,37) = lu(k,37) * lu(k,34) + lu(k,697) = lu(k,697) - lu(k,35) * lu(k,688) + lu(k,719) = lu(k,719) - lu(k,36) * lu(k,688) + lu(k,725) = lu(k,725) - lu(k,37) * lu(k,688) + lu(k,38) = 1._r8 / lu(k,38) + lu(k,39) = lu(k,39) * lu(k,38) + lu(k,40) = lu(k,40) * lu(k,38) + lu(k,41) = lu(k,41) * lu(k,38) + lu(k,699) = lu(k,699) - lu(k,39) * lu(k,689) + lu(k,719) = lu(k,719) - lu(k,40) * lu(k,689) + lu(k,725) = lu(k,725) - lu(k,41) * lu(k,689) + 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,45) = lu(k,45) * lu(k,42) + lu(k,699) = lu(k,699) - lu(k,43) * lu(k,690) + lu(k,719) = lu(k,719) - lu(k,44) * lu(k,690) + lu(k,725) = lu(k,725) - lu(k,45) * lu(k,690) + lu(k,46) = 1._r8 / lu(k,46) + lu(k,47) = lu(k,47) * lu(k,46) + lu(k,48) = lu(k,48) * lu(k,46) + lu(k,49) = lu(k,49) * lu(k,46) + lu(k,847) = lu(k,847) - lu(k,47) * lu(k,803) + lu(k,849) = lu(k,849) - lu(k,48) * lu(k,803) + lu(k,851) = lu(k,851) - lu(k,49) * lu(k,803) + lu(k,50) = 1._r8 / lu(k,50) + lu(k,51) = lu(k,51) * lu(k,50) + lu(k,52) = lu(k,52) * lu(k,50) + lu(k,105) = lu(k,105) - lu(k,51) * lu(k,104) + lu(k,108) = lu(k,108) - lu(k,52) * lu(k,104) + lu(k,931) = lu(k,931) - lu(k,51) * lu(k,930) + lu(k,956) = lu(k,956) - lu(k,52) * lu(k,930) end do end subroutine lu_fac01 subroutine lu_fac02( avec_len, lu ) @@ -136,148 +108,119 @@ subroutine lu_fac02( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,52) = 1._r8 / lu(k,52) - lu(k,53) = lu(k,53) * lu(k,52) - lu(k,54) = lu(k,54) * lu(k,52) - lu(k,55) = lu(k,55) * lu(k,52) - lu(k,56) = lu(k,56) * lu(k,52) - lu(k,57) = lu(k,57) * lu(k,52) - lu(k,364) = lu(k,364) - lu(k,53) * lu(k,360) - lu(k,369) = lu(k,369) - lu(k,54) * lu(k,360) - lu(k,373) = lu(k,373) - lu(k,55) * lu(k,360) - lu(k,381) = lu(k,381) - lu(k,56) * lu(k,360) - lu(k,382) = lu(k,382) - lu(k,57) * lu(k,360) - lu(k,696) = lu(k,696) - lu(k,53) * lu(k,689) - lu(k,702) = lu(k,702) - lu(k,54) * lu(k,689) - lu(k,706) = lu(k,706) - lu(k,55) * lu(k,689) - lu(k,714) = lu(k,714) - lu(k,56) * lu(k,689) - lu(k,715) = lu(k,715) - lu(k,57) * lu(k,689) + lu(k,53) = 1._r8 / lu(k,53) + lu(k,54) = lu(k,54) * lu(k,53) + lu(k,55) = lu(k,55) * lu(k,53) + lu(k,56) = lu(k,56) * lu(k,53) + lu(k,57) = lu(k,57) * lu(k,53) + lu(k,699) = lu(k,699) - lu(k,54) * lu(k,691) + lu(k,719) = lu(k,719) - lu(k,55) * lu(k,691) + lu(k,721) = lu(k,721) - lu(k,56) * lu(k,691) + lu(k,725) = lu(k,725) - lu(k,57) * lu(k,691) lu(k,58) = 1._r8 / lu(k,58) lu(k,59) = lu(k,59) * lu(k,58) lu(k,60) = lu(k,60) * lu(k,58) lu(k,61) = lu(k,61) * lu(k,58) lu(k,62) = lu(k,62) * lu(k,58) - lu(k,63) = lu(k,63) * lu(k,58) - lu(k,363) = lu(k,363) - lu(k,59) * lu(k,361) - lu(k,364) = lu(k,364) - lu(k,60) * lu(k,361) - lu(k,369) = lu(k,369) - lu(k,61) * lu(k,361) - lu(k,370) = lu(k,370) - lu(k,62) * lu(k,361) - lu(k,379) = lu(k,379) - lu(k,63) * lu(k,361) - lu(k,644) = lu(k,644) - lu(k,59) * lu(k,633) - lu(k,646) = lu(k,646) - lu(k,60) * lu(k,633) - lu(k,652) = lu(k,652) - lu(k,61) * lu(k,633) - lu(k,653) = lu(k,653) - lu(k,62) * lu(k,633) - lu(k,662) = lu(k,662) - lu(k,63) * lu(k,633) - lu(k,64) = 1._r8 / lu(k,64) - lu(k,65) = lu(k,65) * lu(k,64) - lu(k,66) = lu(k,66) * lu(k,64) - lu(k,67) = lu(k,67) * lu(k,64) - lu(k,68) = lu(k,68) * lu(k,64) - lu(k,284) = lu(k,284) - lu(k,65) * lu(k,282) - lu(k,285) = lu(k,285) - lu(k,66) * lu(k,282) - lu(k,290) = lu(k,290) - lu(k,67) * lu(k,282) - lu(k,291) = lu(k,291) - lu(k,68) * lu(k,282) - lu(k,439) = lu(k,439) - lu(k,65) * lu(k,437) - lu(k,442) = lu(k,442) - lu(k,66) * lu(k,437) - lu(k,450) = lu(k,450) - lu(k,67) * lu(k,437) - lu(k,451) = lu(k,451) - lu(k,68) * lu(k,437) - lu(k,577) = lu(k,577) - lu(k,65) * lu(k,574) - lu(k,579) = lu(k,579) - lu(k,66) * lu(k,574) - lu(k,587) = lu(k,587) - lu(k,67) * lu(k,574) - lu(k,588) = lu(k,588) - lu(k,68) * lu(k,574) - 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,73) = lu(k,73) * lu(k,69) - lu(k,74) = lu(k,74) * lu(k,69) - lu(k,75) = lu(k,75) * lu(k,69) - lu(k,76) = lu(k,76) * lu(k,69) - lu(k,467) = lu(k,467) - lu(k,70) * lu(k,464) - lu(k,471) = - lu(k,71) * lu(k,464) - lu(k,482) = - lu(k,72) * lu(k,464) - lu(k,485) = lu(k,485) - lu(k,73) * lu(k,464) - lu(k,486) = lu(k,486) - lu(k,74) * lu(k,464) - lu(k,494) = lu(k,494) - lu(k,75) * lu(k,464) - lu(k,500) = lu(k,500) - lu(k,76) * lu(k,464) - lu(k,637) = lu(k,637) - lu(k,70) * lu(k,634) - lu(k,639) = lu(k,639) - lu(k,71) * lu(k,634) - lu(k,644) = lu(k,644) - lu(k,72) * lu(k,634) - lu(k,647) = lu(k,647) - lu(k,73) * lu(k,634) - lu(k,648) = lu(k,648) - lu(k,74) * lu(k,634) - lu(k,656) = lu(k,656) - lu(k,75) * lu(k,634) - lu(k,662) = lu(k,662) - lu(k,76) * lu(k,634) - 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,81) = lu(k,81) * lu(k,77) - lu(k,82) = lu(k,82) * lu(k,77) - lu(k,346) = - lu(k,78) * lu(k,345) - lu(k,347) = lu(k,347) - lu(k,79) * lu(k,345) - lu(k,352) = lu(k,352) - lu(k,80) * lu(k,345) - lu(k,355) = - lu(k,81) * lu(k,345) - lu(k,359) = - lu(k,82) * lu(k,345) - lu(k,390) = lu(k,390) - lu(k,78) * lu(k,384) - lu(k,393) = lu(k,393) - lu(k,79) * lu(k,384) - lu(k,399) = - lu(k,80) * lu(k,384) - lu(k,404) = lu(k,404) - lu(k,81) * lu(k,384) - lu(k,408) = lu(k,408) - lu(k,82) * lu(k,384) - lu(k,648) = lu(k,648) - lu(k,78) * lu(k,635) - lu(k,651) = lu(k,651) - lu(k,79) * lu(k,635) - lu(k,657) = lu(k,657) - lu(k,80) * lu(k,635) - lu(k,662) = lu(k,662) - lu(k,81) * lu(k,635) - lu(k,666) = lu(k,666) - lu(k,82) * lu(k,635) - lu(k,83) = 1._r8 / lu(k,83) - lu(k,84) = lu(k,84) * lu(k,83) - lu(k,85) = lu(k,85) * lu(k,83) - lu(k,86) = lu(k,86) * lu(k,83) - lu(k,87) = lu(k,87) * lu(k,83) - lu(k,88) = lu(k,88) * lu(k,83) - lu(k,89) = lu(k,89) * lu(k,83) - lu(k,394) = lu(k,394) - lu(k,84) * lu(k,385) - lu(k,395) = lu(k,395) - lu(k,85) * lu(k,385) - lu(k,403) = lu(k,403) - lu(k,86) * lu(k,385) - lu(k,404) = lu(k,404) - lu(k,87) * lu(k,385) - lu(k,406) = lu(k,406) - lu(k,88) * lu(k,385) - lu(k,408) = lu(k,408) - lu(k,89) * lu(k,385) - lu(k,652) = lu(k,652) - lu(k,84) * lu(k,636) - lu(k,653) = lu(k,653) - lu(k,85) * lu(k,636) - lu(k,661) = lu(k,661) - lu(k,86) * lu(k,636) - lu(k,662) = lu(k,662) - lu(k,87) * lu(k,636) - lu(k,664) = lu(k,664) - lu(k,88) * lu(k,636) - lu(k,666) = lu(k,666) - lu(k,89) * lu(k,636) - lu(k,702) = lu(k,702) - lu(k,84) * lu(k,690) - lu(k,703) = lu(k,703) - lu(k,85) * lu(k,690) - lu(k,711) = lu(k,711) - lu(k,86) * lu(k,690) - lu(k,712) = lu(k,712) - lu(k,87) * lu(k,690) - lu(k,714) = lu(k,714) - lu(k,88) * lu(k,690) - lu(k,716) = - lu(k,89) * lu(k,690) - lu(k,90) = 1._r8 / lu(k,90) - lu(k,91) = lu(k,91) * lu(k,90) - lu(k,92) = lu(k,92) * lu(k,90) - lu(k,93) = lu(k,93) * lu(k,90) - lu(k,94) = lu(k,94) * lu(k,90) - lu(k,95) = lu(k,95) * lu(k,90) - lu(k,96) = lu(k,96) * lu(k,90) - lu(k,209) = lu(k,209) - lu(k,91) * lu(k,208) - lu(k,210) = lu(k,210) - lu(k,92) * lu(k,208) - lu(k,212) = - lu(k,93) * lu(k,208) - lu(k,213) = lu(k,213) - lu(k,94) * lu(k,208) - lu(k,220) = lu(k,220) - lu(k,95) * lu(k,208) - lu(k,224) = - lu(k,96) * lu(k,208) - lu(k,466) = lu(k,466) - lu(k,91) * lu(k,465) - lu(k,470) = lu(k,470) - lu(k,92) * lu(k,465) - lu(k,475) = lu(k,475) - lu(k,93) * lu(k,465) - lu(k,477) = lu(k,477) - lu(k,94) * lu(k,465) - lu(k,494) = lu(k,494) - lu(k,95) * lu(k,465) - lu(k,503) = lu(k,503) - lu(k,96) * lu(k,465) - lu(k,602) = lu(k,602) - lu(k,91) * lu(k,601) - lu(k,603) = lu(k,603) - lu(k,92) * lu(k,601) - lu(k,606) = lu(k,606) - lu(k,93) * lu(k,601) - lu(k,607) = lu(k,607) - lu(k,94) * lu(k,601) - lu(k,619) = lu(k,619) - lu(k,95) * lu(k,601) - lu(k,628) = lu(k,628) - lu(k,96) * lu(k,601) + lu(k,699) = lu(k,699) - lu(k,59) * lu(k,692) + lu(k,706) = lu(k,706) - lu(k,60) * lu(k,692) + lu(k,719) = lu(k,719) - lu(k,61) * lu(k,692) + lu(k,721) = lu(k,721) - lu(k,62) * lu(k,692) + 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,66) = lu(k,66) * lu(k,63) + lu(k,67) = lu(k,67) * lu(k,63) + lu(k,697) = lu(k,697) - lu(k,64) * lu(k,693) + lu(k,699) = lu(k,699) - lu(k,65) * lu(k,693) + lu(k,719) = lu(k,719) - lu(k,66) * lu(k,693) + lu(k,725) = lu(k,725) - lu(k,67) * lu(k,693) + lu(k,68) = 1._r8 / lu(k,68) + lu(k,69) = lu(k,69) * lu(k,68) + lu(k,70) = lu(k,70) * lu(k,68) + lu(k,71) = lu(k,71) * lu(k,68) + lu(k,72) = lu(k,72) * lu(k,68) + lu(k,699) = lu(k,699) - lu(k,69) * lu(k,694) + lu(k,706) = lu(k,706) - lu(k,70) * lu(k,694) + lu(k,719) = lu(k,719) - lu(k,71) * lu(k,694) + lu(k,725) = lu(k,725) - lu(k,72) * lu(k,694) + lu(k,73) = 1._r8 / lu(k,73) + lu(k,74) = lu(k,74) * lu(k,73) + lu(k,267) = lu(k,267) - lu(k,74) * lu(k,261) + lu(k,313) = lu(k,313) - lu(k,74) * lu(k,303) + lu(k,463) = lu(k,463) - lu(k,74) * lu(k,444) + lu(k,591) = lu(k,591) - lu(k,74) * lu(k,567) + lu(k,904) = lu(k,904) - lu(k,74) * lu(k,875) + lu(k,75) = 1._r8 / lu(k,75) + lu(k,76) = lu(k,76) * lu(k,75) + lu(k,79) = lu(k,79) - lu(k,76) * lu(k,77) + lu(k,197) = - lu(k,76) * lu(k,191) + lu(k,505) = lu(k,505) - lu(k,76) * lu(k,489) + lu(k,525) = lu(k,525) - lu(k,76) * lu(k,519) + lu(k,645) = lu(k,645) - lu(k,76) * lu(k,619) + lu(k,78) = 1._r8 / lu(k,78) + lu(k,79) = lu(k,79) * lu(k,78) + lu(k,197) = lu(k,197) - lu(k,79) * lu(k,192) + lu(k,505) = lu(k,505) - lu(k,79) * lu(k,490) + lu(k,525) = lu(k,525) - lu(k,79) * lu(k,520) + lu(k,645) = lu(k,645) - lu(k,79) * lu(k,620) + lu(k,712) = lu(k,712) - lu(k,79) * lu(k,695) + lu(k,80) = 1._r8 / lu(k,80) + lu(k,81) = lu(k,81) * lu(k,80) + lu(k,82) = lu(k,82) * lu(k,80) + lu(k,83) = lu(k,83) * lu(k,80) + lu(k,84) = lu(k,84) * lu(k,80) + lu(k,697) = lu(k,697) - lu(k,81) * lu(k,696) + lu(k,719) = lu(k,719) - lu(k,82) * lu(k,696) + lu(k,723) = lu(k,723) - lu(k,83) * lu(k,696) + lu(k,725) = lu(k,725) - lu(k,84) * lu(k,696) + lu(k,805) = lu(k,805) - lu(k,81) * lu(k,804) + lu(k,843) = - lu(k,82) * lu(k,804) + lu(k,847) = lu(k,847) - lu(k,83) * lu(k,804) + lu(k,849) = lu(k,849) - lu(k,84) * lu(k,804) + lu(k,85) = 1._r8 / lu(k,85) + lu(k,86) = lu(k,86) * lu(k,85) + lu(k,87) = lu(k,87) * lu(k,85) + lu(k,88) = lu(k,88) * lu(k,85) + lu(k,706) = lu(k,706) - lu(k,86) * lu(k,697) + lu(k,719) = lu(k,719) - lu(k,87) * lu(k,697) + lu(k,725) = lu(k,725) - lu(k,88) * lu(k,697) + lu(k,824) = - lu(k,86) * lu(k,805) + lu(k,843) = lu(k,843) - lu(k,87) * lu(k,805) + lu(k,849) = lu(k,849) - lu(k,88) * lu(k,805) + 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,93) = lu(k,93) * lu(k,89) + lu(k,699) = lu(k,699) - lu(k,90) * lu(k,698) + lu(k,719) = lu(k,719) - lu(k,91) * lu(k,698) + lu(k,723) = lu(k,723) - lu(k,92) * lu(k,698) + lu(k,725) = lu(k,725) - lu(k,93) * lu(k,698) + lu(k,807) = lu(k,807) - lu(k,90) * lu(k,806) + lu(k,843) = lu(k,843) - lu(k,91) * lu(k,806) + lu(k,847) = lu(k,847) - lu(k,92) * lu(k,806) + lu(k,849) = lu(k,849) - lu(k,93) * lu(k,806) + lu(k,94) = 1._r8 / lu(k,94) + lu(k,95) = lu(k,95) * lu(k,94) + lu(k,96) = lu(k,96) * lu(k,94) + lu(k,111) = - lu(k,95) * lu(k,109) + lu(k,112) = lu(k,112) - lu(k,96) * lu(k,109) + lu(k,706) = lu(k,706) - lu(k,95) * lu(k,699) + lu(k,719) = lu(k,719) - lu(k,96) * lu(k,699) + lu(k,824) = lu(k,824) - lu(k,95) * lu(k,807) + lu(k,843) = lu(k,843) - lu(k,96) * lu(k,807) + 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,249) = lu(k,249) - lu(k,98) * lu(k,244) + lu(k,251) = - lu(k,99) * lu(k,244) + lu(k,459) = - lu(k,98) * lu(k,445) + lu(k,463) = lu(k,463) - lu(k,99) * lu(k,445) + lu(k,587) = lu(k,587) - lu(k,98) * lu(k,568) + lu(k,591) = lu(k,591) - lu(k,99) * lu(k,568) + lu(k,745) = lu(k,745) - lu(k,98) * lu(k,728) + lu(k,749) = lu(k,749) - lu(k,99) * lu(k,728) end do end subroutine lu_fac02 subroutine lu_fac03( avec_len, lu ) @@ -294,182 +237,154 @@ subroutine lu_fac03( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - 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,100) = lu(k,100) * lu(k,97) - lu(k,101) = lu(k,101) * lu(k,97) - lu(k,102) = lu(k,102) * lu(k,97) - lu(k,210) = lu(k,210) - lu(k,98) * lu(k,209) - lu(k,213) = lu(k,213) - lu(k,99) * lu(k,209) - lu(k,214) = lu(k,214) - lu(k,100) * lu(k,209) - lu(k,220) = lu(k,220) - lu(k,101) * lu(k,209) - lu(k,222) = - lu(k,102) * lu(k,209) - lu(k,470) = lu(k,470) - lu(k,98) * lu(k,466) - lu(k,477) = lu(k,477) - lu(k,99) * lu(k,466) - lu(k,478) = - lu(k,100) * lu(k,466) - lu(k,494) = lu(k,494) - lu(k,101) * lu(k,466) - lu(k,499) = lu(k,499) - lu(k,102) * lu(k,466) - lu(k,603) = lu(k,603) - lu(k,98) * lu(k,602) - lu(k,607) = lu(k,607) - lu(k,99) * lu(k,602) - lu(k,608) = lu(k,608) - lu(k,100) * lu(k,602) - lu(k,619) = lu(k,619) - lu(k,101) * lu(k,602) - lu(k,624) = lu(k,624) - lu(k,102) * lu(k,602) - 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,194) = - lu(k,104) * lu(k,186) - lu(k,195) = - lu(k,105) * lu(k,186) - lu(k,198) = - lu(k,106) * lu(k,186) - lu(k,309) = - lu(k,104) * lu(k,307) - lu(k,311) = lu(k,311) - lu(k,105) * lu(k,307) - lu(k,318) = - lu(k,106) * lu(k,307) - lu(k,366) = - lu(k,104) * lu(k,362) - lu(k,370) = lu(k,370) - lu(k,105) * lu(k,362) - lu(k,379) = lu(k,379) - lu(k,106) * lu(k,362) - lu(k,415) = lu(k,415) - lu(k,104) * lu(k,410) - lu(k,420) = lu(k,420) - lu(k,105) * lu(k,410) - lu(k,429) = lu(k,429) - lu(k,106) * lu(k,410) - lu(k,486) = lu(k,486) - lu(k,104) * lu(k,467) - lu(k,491) = lu(k,491) - lu(k,105) * lu(k,467) - lu(k,500) = lu(k,500) - lu(k,106) * lu(k,467) - lu(k,508) = lu(k,508) - lu(k,104) * lu(k,505) - lu(k,513) = lu(k,513) - lu(k,105) * lu(k,505) - lu(k,522) = lu(k,522) - lu(k,106) * lu(k,505) - lu(k,648) = lu(k,648) - lu(k,104) * lu(k,637) - lu(k,653) = lu(k,653) - lu(k,105) * lu(k,637) - lu(k,662) = lu(k,662) - lu(k,106) * lu(k,637) - lu(k,107) = 1._r8 / lu(k,107) - lu(k,108) = lu(k,108) * lu(k,107) - lu(k,109) = lu(k,109) * lu(k,107) - lu(k,110) = lu(k,110) * lu(k,107) - lu(k,111) = lu(k,111) * lu(k,107) - lu(k,112) = lu(k,112) * lu(k,107) - lu(k,113) = lu(k,113) * lu(k,107) - lu(k,114) = lu(k,114) * lu(k,107) - lu(k,473) = lu(k,473) - lu(k,108) * lu(k,468) - lu(k,484) = - lu(k,109) * lu(k,468) - lu(k,487) = lu(k,487) - lu(k,110) * lu(k,468) - lu(k,490) = lu(k,490) - lu(k,111) * lu(k,468) - lu(k,494) = lu(k,494) - lu(k,112) * lu(k,468) - lu(k,498) = lu(k,498) - lu(k,113) * lu(k,468) - lu(k,502) = lu(k,502) - lu(k,114) * lu(k,468) - lu(k,576) = lu(k,576) - lu(k,108) * lu(k,575) - lu(k,578) = - lu(k,109) * lu(k,575) - lu(k,581) = lu(k,581) - lu(k,110) * lu(k,575) - lu(k,584) = - lu(k,111) * lu(k,575) - lu(k,588) = lu(k,588) - lu(k,112) * lu(k,575) - lu(k,592) = lu(k,592) - lu(k,113) * lu(k,575) - lu(k,596) = lu(k,596) - lu(k,114) * lu(k,575) - lu(k,692) = - lu(k,108) * lu(k,691) - lu(k,696) = lu(k,696) - lu(k,109) * lu(k,691) - lu(k,699) = - lu(k,110) * lu(k,691) - lu(k,702) = lu(k,702) - lu(k,111) * lu(k,691) - lu(k,706) = lu(k,706) - lu(k,112) * lu(k,691) - lu(k,710) = lu(k,710) - lu(k,113) * lu(k,691) - lu(k,714) = lu(k,714) - lu(k,114) * lu(k,691) - lu(k,115) = 1._r8 / lu(k,115) - lu(k,116) = lu(k,116) * lu(k,115) - lu(k,117) = lu(k,117) * lu(k,115) - lu(k,118) = lu(k,118) * lu(k,115) - lu(k,119) = lu(k,119) * lu(k,115) - lu(k,120) = lu(k,120) * lu(k,115) - lu(k,121) = lu(k,121) * lu(k,115) - lu(k,392) = lu(k,392) - lu(k,116) * lu(k,386) - lu(k,395) = lu(k,395) - lu(k,117) * lu(k,386) - lu(k,396) = lu(k,396) - lu(k,118) * lu(k,386) - lu(k,398) = lu(k,398) - lu(k,119) * lu(k,386) - lu(k,404) = lu(k,404) - lu(k,120) * lu(k,386) - lu(k,408) = lu(k,408) - lu(k,121) * lu(k,386) - lu(k,417) = lu(k,417) - lu(k,116) * lu(k,411) - lu(k,420) = lu(k,420) - lu(k,117) * lu(k,411) - lu(k,421) = lu(k,421) - lu(k,118) * lu(k,411) - lu(k,423) = - lu(k,119) * lu(k,411) - lu(k,429) = lu(k,429) - lu(k,120) * lu(k,411) - lu(k,433) = - lu(k,121) * lu(k,411) - lu(k,488) = lu(k,488) - lu(k,116) * lu(k,469) - lu(k,491) = lu(k,491) - lu(k,117) * lu(k,469) - lu(k,492) = lu(k,492) - lu(k,118) * lu(k,469) - lu(k,494) = lu(k,494) - lu(k,119) * lu(k,469) - lu(k,500) = lu(k,500) - lu(k,120) * lu(k,469) - lu(k,504) = - lu(k,121) * lu(k,469) - lu(k,650) = lu(k,650) - lu(k,116) * lu(k,638) - lu(k,653) = lu(k,653) - lu(k,117) * lu(k,638) - lu(k,654) = lu(k,654) - lu(k,118) * lu(k,638) - lu(k,656) = lu(k,656) - lu(k,119) * lu(k,638) - lu(k,662) = lu(k,662) - lu(k,120) * lu(k,638) - lu(k,666) = lu(k,666) - lu(k,121) * lu(k,638) - lu(k,122) = 1._r8 / lu(k,122) - lu(k,123) = lu(k,123) * lu(k,122) - lu(k,124) = lu(k,124) * lu(k,122) - lu(k,125) = lu(k,125) * lu(k,122) - lu(k,126) = lu(k,126) * lu(k,122) - lu(k,127) = lu(k,127) * lu(k,122) - lu(k,128) = lu(k,128) * lu(k,122) - lu(k,129) = lu(k,129) * lu(k,122) - lu(k,130) = lu(k,130) * lu(k,122) - lu(k,211) = lu(k,211) - lu(k,123) * lu(k,210) - lu(k,213) = lu(k,213) - lu(k,124) * lu(k,210) - lu(k,214) = lu(k,214) - lu(k,125) * lu(k,210) - lu(k,215) = lu(k,215) - lu(k,126) * lu(k,210) - lu(k,216) = lu(k,216) - lu(k,127) * lu(k,210) - lu(k,217) = lu(k,217) - lu(k,128) * lu(k,210) - lu(k,220) = lu(k,220) - lu(k,129) * lu(k,210) - lu(k,222) = lu(k,222) - lu(k,130) * lu(k,210) - lu(k,472) = lu(k,472) - lu(k,123) * lu(k,470) - lu(k,477) = lu(k,477) - lu(k,124) * lu(k,470) - lu(k,478) = lu(k,478) - lu(k,125) * lu(k,470) - lu(k,479) = lu(k,479) - lu(k,126) * lu(k,470) - lu(k,480) = lu(k,480) - lu(k,127) * lu(k,470) - lu(k,481) = lu(k,481) - lu(k,128) * lu(k,470) - lu(k,494) = lu(k,494) - lu(k,129) * lu(k,470) - lu(k,499) = lu(k,499) - lu(k,130) * lu(k,470) - lu(k,605) = lu(k,605) - lu(k,123) * lu(k,603) - lu(k,607) = lu(k,607) - lu(k,124) * lu(k,603) - lu(k,608) = lu(k,608) - lu(k,125) * lu(k,603) - lu(k,609) = lu(k,609) - lu(k,126) * lu(k,603) - lu(k,610) = lu(k,610) - lu(k,127) * lu(k,603) - lu(k,611) = lu(k,611) - lu(k,128) * lu(k,603) - lu(k,619) = lu(k,619) - lu(k,129) * lu(k,603) - lu(k,624) = lu(k,624) - lu(k,130) * lu(k,603) + 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,103) = lu(k,103) * lu(k,100) + lu(k,348) = lu(k,348) - lu(k,101) * lu(k,339) + lu(k,350) = lu(k,350) - lu(k,102) * lu(k,339) + lu(k,351) = - lu(k,103) * lu(k,339) + lu(k,712) = lu(k,712) - lu(k,101) * lu(k,700) + lu(k,718) = lu(k,718) - lu(k,102) * lu(k,700) + lu(k,719) = lu(k,719) - lu(k,103) * lu(k,700) + lu(k,787) = lu(k,787) - lu(k,101) * lu(k,774) + lu(k,793) = lu(k,793) - lu(k,102) * lu(k,774) + lu(k,794) = - lu(k,103) * lu(k,774) + lu(k,105) = 1._r8 / lu(k,105) + lu(k,106) = lu(k,106) * lu(k,105) + lu(k,107) = lu(k,107) * lu(k,105) + lu(k,108) = lu(k,108) * lu(k,105) + lu(k,297) = lu(k,297) - lu(k,106) * lu(k,296) + lu(k,300) = lu(k,300) - lu(k,107) * lu(k,296) + lu(k,302) = - lu(k,108) * lu(k,296) + lu(k,825) = lu(k,825) - lu(k,106) * lu(k,808) + lu(k,841) = lu(k,841) - lu(k,107) * lu(k,808) + lu(k,851) = lu(k,851) - lu(k,108) * lu(k,808) + lu(k,934) = - lu(k,106) * lu(k,931) + lu(k,946) = lu(k,946) - lu(k,107) * lu(k,931) + lu(k,956) = lu(k,956) - lu(k,108) * lu(k,931) + lu(k,110) = 1._r8 / lu(k,110) + lu(k,111) = lu(k,111) * lu(k,110) + lu(k,112) = lu(k,112) * lu(k,110) + lu(k,113) = lu(k,113) * lu(k,110) + lu(k,114) = lu(k,114) * lu(k,110) + lu(k,115) = lu(k,115) * lu(k,110) + lu(k,706) = lu(k,706) - lu(k,111) * lu(k,701) + lu(k,719) = lu(k,719) - lu(k,112) * lu(k,701) + lu(k,723) = lu(k,723) - lu(k,113) * lu(k,701) + lu(k,725) = lu(k,725) - lu(k,114) * lu(k,701) + lu(k,727) = lu(k,727) - lu(k,115) * lu(k,701) + lu(k,824) = lu(k,824) - lu(k,111) * lu(k,809) + lu(k,843) = lu(k,843) - lu(k,112) * lu(k,809) + lu(k,847) = lu(k,847) - lu(k,113) * lu(k,809) + lu(k,849) = lu(k,849) - lu(k,114) * lu(k,809) + lu(k,851) = lu(k,851) - lu(k,115) * lu(k,809) + 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,287) = lu(k,287) - lu(k,117) * lu(k,286) + lu(k,290) = lu(k,290) - lu(k,118) * lu(k,286) + lu(k,387) = lu(k,387) - lu(k,117) * lu(k,384) + lu(k,392) = lu(k,392) - lu(k,118) * lu(k,384) + lu(k,853) = lu(k,853) - lu(k,117) * lu(k,852) + lu(k,856) = - lu(k,118) * lu(k,852) + lu(k,908) = lu(k,908) - lu(k,117) * lu(k,907) + lu(k,911) = lu(k,911) - lu(k,118) * lu(k,907) + lu(k,933) = lu(k,933) - lu(k,117) * lu(k,932) + lu(k,938) = lu(k,938) - lu(k,118) * lu(k,932) + lu(k,119) = 1._r8 / lu(k,119) + lu(k,120) = lu(k,120) * lu(k,119) + lu(k,121) = lu(k,121) * lu(k,119) + lu(k,122) = lu(k,122) * lu(k,119) + lu(k,123) = lu(k,123) * lu(k,119) + lu(k,124) = lu(k,124) * lu(k,119) + lu(k,607) = lu(k,607) - lu(k,120) * lu(k,594) + lu(k,608) = lu(k,608) - lu(k,121) * lu(k,594) + lu(k,609) = lu(k,609) - lu(k,122) * lu(k,594) + lu(k,613) = lu(k,613) - lu(k,123) * lu(k,594) + lu(k,615) = lu(k,615) - lu(k,124) * lu(k,594) + lu(k,791) = lu(k,791) - lu(k,120) * lu(k,775) + lu(k,792) = lu(k,792) - lu(k,121) * lu(k,775) + lu(k,793) = lu(k,793) - lu(k,122) * lu(k,775) + lu(k,797) = lu(k,797) - lu(k,123) * lu(k,775) + lu(k,799) = lu(k,799) - lu(k,124) * lu(k,775) + lu(k,125) = 1._r8 / lu(k,125) + lu(k,126) = lu(k,126) * lu(k,125) + lu(k,127) = lu(k,127) * lu(k,125) + lu(k,128) = lu(k,128) * lu(k,125) + lu(k,129) = lu(k,129) * lu(k,125) + lu(k,130) = lu(k,130) * lu(k,125) + lu(k,597) = lu(k,597) - lu(k,126) * lu(k,595) + lu(k,605) = lu(k,605) - lu(k,127) * lu(k,595) + lu(k,607) = lu(k,607) - lu(k,128) * lu(k,595) + lu(k,614) = lu(k,614) - lu(k,129) * lu(k,595) + lu(k,615) = lu(k,615) - lu(k,130) * lu(k,595) + lu(k,825) = lu(k,825) - lu(k,126) * lu(k,810) + lu(k,838) = lu(k,838) - lu(k,127) * lu(k,810) + lu(k,840) = lu(k,840) - lu(k,128) * lu(k,810) + lu(k,847) = lu(k,847) - lu(k,129) * lu(k,810) + lu(k,848) = lu(k,848) - lu(k,130) * lu(k,810) lu(k,131) = 1._r8 / lu(k,131) lu(k,132) = lu(k,132) * lu(k,131) lu(k,133) = lu(k,133) * lu(k,131) lu(k,134) = lu(k,134) * lu(k,131) lu(k,135) = lu(k,135) * lu(k,131) - lu(k,136) = lu(k,136) * lu(k,131) - lu(k,137) = lu(k,137) * lu(k,131) - lu(k,285) = lu(k,285) - lu(k,132) * lu(k,283) - lu(k,286) = lu(k,286) - lu(k,133) * lu(k,283) - lu(k,291) = lu(k,291) - lu(k,134) * lu(k,283) - lu(k,293) = lu(k,293) - lu(k,135) * lu(k,283) - lu(k,294) = lu(k,294) - lu(k,136) * lu(k,283) - lu(k,295) = lu(k,295) - lu(k,137) * lu(k,283) - lu(k,485) = lu(k,485) - lu(k,132) * lu(k,471) - lu(k,486) = lu(k,486) - lu(k,133) * lu(k,471) - lu(k,494) = lu(k,494) - lu(k,134) * lu(k,471) - lu(k,499) = lu(k,499) - lu(k,135) * lu(k,471) - lu(k,500) = lu(k,500) - lu(k,136) * lu(k,471) - lu(k,501) = lu(k,501) - lu(k,137) * lu(k,471) - lu(k,613) = lu(k,613) - lu(k,132) * lu(k,604) - lu(k,614) = lu(k,614) - lu(k,133) * lu(k,604) - lu(k,619) = lu(k,619) - lu(k,134) * lu(k,604) - lu(k,624) = lu(k,624) - lu(k,135) * lu(k,604) - lu(k,625) = - lu(k,136) * lu(k,604) - lu(k,626) = lu(k,626) - lu(k,137) * lu(k,604) - lu(k,647) = lu(k,647) - lu(k,132) * lu(k,639) - lu(k,648) = lu(k,648) - lu(k,133) * lu(k,639) - lu(k,656) = lu(k,656) - lu(k,134) * lu(k,639) - lu(k,661) = lu(k,661) - lu(k,135) * lu(k,639) - lu(k,662) = lu(k,662) - lu(k,136) * lu(k,639) - lu(k,663) = lu(k,663) - lu(k,137) * lu(k,639) - lu(k,671) = lu(k,671) - lu(k,132) * lu(k,669) - lu(k,672) = lu(k,672) - lu(k,133) * lu(k,669) - lu(k,678) = lu(k,678) - lu(k,134) * lu(k,669) - lu(k,683) = lu(k,683) - lu(k,135) * lu(k,669) - lu(k,684) = lu(k,684) - lu(k,136) * lu(k,669) - lu(k,685) = lu(k,685) - lu(k,137) * lu(k,669) + lu(k,421) = lu(k,421) - lu(k,132) * lu(k,419) + lu(k,422) = lu(k,422) - lu(k,133) * lu(k,419) + lu(k,427) = lu(k,427) - lu(k,134) * lu(k,419) + lu(k,428) = lu(k,428) - lu(k,135) * lu(k,419) + lu(k,571) = lu(k,571) - lu(k,132) * lu(k,569) + lu(k,574) = lu(k,574) - lu(k,133) * lu(k,569) + lu(k,581) = lu(k,581) - lu(k,134) * lu(k,569) + lu(k,583) = lu(k,583) - lu(k,135) * lu(k,569) + lu(k,732) = lu(k,732) - lu(k,132) * lu(k,729) + lu(k,733) = lu(k,733) - lu(k,133) * lu(k,729) + lu(k,739) = lu(k,739) - lu(k,134) * lu(k,729) + lu(k,741) = lu(k,741) - lu(k,135) * lu(k,729) + 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,142) = lu(k,142) * lu(k,136) + lu(k,143) = lu(k,143) * lu(k,136) + lu(k,627) = - lu(k,137) * lu(k,621) + lu(k,633) = lu(k,633) - lu(k,138) * lu(k,621) + lu(k,634) = - lu(k,139) * lu(k,621) + lu(k,641) = lu(k,641) - lu(k,140) * lu(k,621) + lu(k,642) = lu(k,642) - lu(k,141) * lu(k,621) + lu(k,650) = lu(k,650) - lu(k,142) * lu(k,621) + lu(k,656) = lu(k,656) - lu(k,143) * lu(k,621) + lu(k,820) = lu(k,820) - lu(k,137) * lu(k,811) + lu(k,823) = lu(k,823) - lu(k,138) * lu(k,811) + lu(k,825) = lu(k,825) - lu(k,139) * lu(k,811) + lu(k,832) = lu(k,832) - lu(k,140) * lu(k,811) + lu(k,833) = lu(k,833) - lu(k,141) * lu(k,811) + lu(k,841) = lu(k,841) - lu(k,142) * lu(k,811) + lu(k,847) = lu(k,847) - lu(k,143) * lu(k,811) + lu(k,144) = 1._r8 / lu(k,144) + lu(k,145) = lu(k,145) * lu(k,144) + lu(k,146) = lu(k,146) * lu(k,144) + lu(k,147) = lu(k,147) * lu(k,144) + lu(k,148) = lu(k,148) * lu(k,144) + lu(k,149) = lu(k,149) * lu(k,144) + lu(k,150) = lu(k,150) * lu(k,144) + lu(k,151) = lu(k,151) * lu(k,144) + lu(k,823) = lu(k,823) - lu(k,145) * lu(k,812) + lu(k,831) = lu(k,831) - lu(k,146) * lu(k,812) + lu(k,834) = lu(k,834) - lu(k,147) * lu(k,812) + lu(k,838) = lu(k,838) - lu(k,148) * lu(k,812) + lu(k,847) = lu(k,847) - lu(k,149) * lu(k,812) + lu(k,849) = lu(k,849) - lu(k,150) * lu(k,812) + lu(k,851) = lu(k,851) - lu(k,151) * lu(k,812) + lu(k,882) = lu(k,882) - lu(k,145) * lu(k,876) + lu(k,887) = lu(k,887) - lu(k,146) * lu(k,876) + lu(k,889) = lu(k,889) - lu(k,147) * lu(k,876) + lu(k,893) = lu(k,893) - lu(k,148) * lu(k,876) + lu(k,902) = lu(k,902) - lu(k,149) * lu(k,876) + lu(k,904) = lu(k,904) - lu(k,150) * lu(k,876) + lu(k,906) = - lu(k,151) * lu(k,876) end do end subroutine lu_fac03 subroutine lu_fac04( avec_len, lu ) @@ -486,178 +401,170 @@ subroutine lu_fac04( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,138) = 1._r8 / lu(k,138) - lu(k,139) = lu(k,139) * lu(k,138) - lu(k,140) = lu(k,140) * lu(k,138) - lu(k,141) = lu(k,141) * lu(k,138) - lu(k,142) = lu(k,142) * lu(k,138) - lu(k,173) = - lu(k,139) * lu(k,169) - lu(k,174) = - lu(k,140) * lu(k,169) - lu(k,175) = lu(k,175) - lu(k,141) * lu(k,169) - lu(k,176) = lu(k,176) - lu(k,142) * lu(k,169) - lu(k,191) = - lu(k,139) * lu(k,187) - lu(k,192) = lu(k,192) - lu(k,140) * lu(k,187) - lu(k,193) = lu(k,193) - lu(k,141) * lu(k,187) - lu(k,196) = lu(k,196) - lu(k,142) * lu(k,187) - lu(k,201) = lu(k,201) - lu(k,139) * lu(k,199) - lu(k,202) = - lu(k,140) * lu(k,199) - lu(k,203) = lu(k,203) - lu(k,141) * lu(k,199) - lu(k,204) = lu(k,204) - lu(k,142) * lu(k,199) - lu(k,215) = lu(k,215) - lu(k,139) * lu(k,211) - lu(k,216) = lu(k,216) - lu(k,140) * lu(k,211) - lu(k,217) = lu(k,217) - lu(k,141) * lu(k,211) - lu(k,220) = lu(k,220) - lu(k,142) * lu(k,211) - lu(k,242) = lu(k,242) - lu(k,139) * lu(k,238) - lu(k,243) = - lu(k,140) * lu(k,238) - lu(k,244) = lu(k,244) - lu(k,141) * lu(k,238) - lu(k,247) = lu(k,247) - lu(k,142) * lu(k,238) - lu(k,479) = lu(k,479) - lu(k,139) * lu(k,472) - lu(k,480) = lu(k,480) - lu(k,140) * lu(k,472) - lu(k,481) = lu(k,481) - lu(k,141) * lu(k,472) - lu(k,494) = lu(k,494) - lu(k,142) * lu(k,472) - lu(k,609) = lu(k,609) - lu(k,139) * lu(k,605) - lu(k,610) = lu(k,610) - lu(k,140) * lu(k,605) - lu(k,611) = lu(k,611) - lu(k,141) * lu(k,605) - lu(k,619) = lu(k,619) - lu(k,142) * lu(k,605) - lu(k,719) = lu(k,719) - lu(k,139) * lu(k,717) - lu(k,720) = - lu(k,140) * lu(k,717) - lu(k,721) = lu(k,721) - lu(k,141) * lu(k,717) - lu(k,729) = lu(k,729) - lu(k,142) * lu(k,717) - lu(k,144) = 1._r8 / lu(k,144) - lu(k,145) = lu(k,145) * lu(k,144) - lu(k,146) = lu(k,146) * lu(k,144) - lu(k,147) = lu(k,147) * lu(k,144) - lu(k,148) = lu(k,148) * lu(k,144) - lu(k,149) = lu(k,149) * lu(k,144) - lu(k,150) = lu(k,150) * lu(k,144) - lu(k,151) = lu(k,151) * lu(k,144) - lu(k,328) = lu(k,328) - lu(k,145) * lu(k,323) - lu(k,329) = lu(k,329) - lu(k,146) * lu(k,323) - lu(k,333) = lu(k,333) - lu(k,147) * lu(k,323) - lu(k,335) = lu(k,335) - lu(k,148) * lu(k,323) - lu(k,339) = - lu(k,149) * lu(k,323) - lu(k,341) = lu(k,341) - lu(k,150) * lu(k,323) - lu(k,344) = lu(k,344) - lu(k,151) * lu(k,323) - lu(k,391) = lu(k,391) - lu(k,145) * lu(k,387) - lu(k,392) = lu(k,392) - lu(k,146) * lu(k,387) - lu(k,396) = lu(k,396) - lu(k,147) * lu(k,387) - lu(k,398) = lu(k,398) - lu(k,148) * lu(k,387) - lu(k,402) = lu(k,402) - lu(k,149) * lu(k,387) - lu(k,404) = lu(k,404) - lu(k,150) * lu(k,387) - lu(k,408) = lu(k,408) - lu(k,151) * lu(k,387) - lu(k,487) = lu(k,487) - lu(k,145) * lu(k,473) - lu(k,488) = lu(k,488) - lu(k,146) * lu(k,473) - lu(k,492) = lu(k,492) - lu(k,147) * lu(k,473) - lu(k,494) = lu(k,494) - lu(k,148) * lu(k,473) - lu(k,498) = lu(k,498) - lu(k,149) * lu(k,473) - lu(k,500) = lu(k,500) - lu(k,150) * lu(k,473) - lu(k,504) = lu(k,504) - lu(k,151) * lu(k,473) - lu(k,581) = lu(k,581) - lu(k,145) * lu(k,576) - lu(k,582) = - lu(k,146) * lu(k,576) - lu(k,586) = lu(k,586) - lu(k,147) * lu(k,576) - lu(k,588) = lu(k,588) - lu(k,148) * lu(k,576) - lu(k,592) = lu(k,592) - lu(k,149) * lu(k,576) - lu(k,594) = lu(k,594) - lu(k,150) * lu(k,576) - lu(k,598) = - lu(k,151) * lu(k,576) - lu(k,699) = lu(k,699) - lu(k,145) * lu(k,692) - lu(k,700) = - lu(k,146) * lu(k,692) - lu(k,704) = - lu(k,147) * lu(k,692) - lu(k,706) = lu(k,706) - lu(k,148) * lu(k,692) - lu(k,710) = lu(k,710) - lu(k,149) * lu(k,692) - lu(k,712) = lu(k,712) - lu(k,150) * lu(k,692) - lu(k,716) = lu(k,716) - lu(k,151) * lu(k,692) - lu(k,153) = 1._r8 / lu(k,153) - lu(k,154) = lu(k,154) * lu(k,153) - lu(k,155) = lu(k,155) * lu(k,153) - lu(k,156) = lu(k,156) * lu(k,153) - lu(k,157) = lu(k,157) * lu(k,153) - lu(k,158) = lu(k,158) * lu(k,153) - lu(k,159) = lu(k,159) * lu(k,153) - lu(k,160) = lu(k,160) * lu(k,153) - lu(k,274) = lu(k,274) - lu(k,154) * lu(k,273) - lu(k,275) = lu(k,275) - lu(k,155) * lu(k,273) - lu(k,276) = - lu(k,156) * lu(k,273) - lu(k,277) = lu(k,277) - lu(k,157) * lu(k,273) - lu(k,278) = - lu(k,158) * lu(k,273) - lu(k,279) = lu(k,279) - lu(k,159) * lu(k,273) - lu(k,281) = lu(k,281) - lu(k,160) * lu(k,273) - lu(k,532) = - lu(k,154) * lu(k,530) - lu(k,533) = lu(k,533) - lu(k,155) * lu(k,530) - lu(k,536) = lu(k,536) - lu(k,156) * lu(k,530) - lu(k,537) = - lu(k,157) * lu(k,530) - lu(k,544) = lu(k,544) - lu(k,158) * lu(k,530) - lu(k,547) = lu(k,547) - lu(k,159) * lu(k,530) - lu(k,551) = lu(k,551) - lu(k,160) * lu(k,530) - lu(k,554) = - lu(k,154) * lu(k,553) - lu(k,555) = lu(k,555) - lu(k,155) * lu(k,553) - lu(k,557) = - lu(k,156) * lu(k,553) - lu(k,558) = - lu(k,157) * lu(k,553) - lu(k,565) = lu(k,565) - lu(k,158) * lu(k,553) - lu(k,568) = lu(k,568) - lu(k,159) * lu(k,553) - lu(k,572) = lu(k,572) - lu(k,160) * lu(k,553) - lu(k,646) = lu(k,646) - lu(k,154) * lu(k,640) - lu(k,648) = lu(k,648) - lu(k,155) * lu(k,640) - lu(k,651) = lu(k,651) - lu(k,156) * lu(k,640) - lu(k,652) = lu(k,652) - lu(k,157) * lu(k,640) - lu(k,659) = lu(k,659) - lu(k,158) * lu(k,640) - lu(k,662) = lu(k,662) - lu(k,159) * lu(k,640) - lu(k,666) = lu(k,666) - lu(k,160) * lu(k,640) - lu(k,745) = - lu(k,154) * lu(k,743) - lu(k,747) = lu(k,747) - lu(k,155) * lu(k,743) - lu(k,749) = - lu(k,156) * lu(k,743) - lu(k,750) = - lu(k,157) * lu(k,743) - lu(k,757) = lu(k,757) - lu(k,158) * lu(k,743) - lu(k,760) = lu(k,760) - lu(k,159) * lu(k,743) - lu(k,764) = lu(k,764) - lu(k,160) * lu(k,743) - lu(k,162) = 1._r8 / lu(k,162) - lu(k,163) = lu(k,163) * lu(k,162) - lu(k,164) = lu(k,164) * lu(k,162) - lu(k,165) = lu(k,165) * lu(k,162) - lu(k,166) = lu(k,166) * lu(k,162) - lu(k,167) = lu(k,167) * lu(k,162) - lu(k,168) = lu(k,168) * lu(k,162) - lu(k,264) = lu(k,264) - lu(k,163) * lu(k,261) - lu(k,266) = lu(k,266) - lu(k,164) * lu(k,261) - lu(k,267) = lu(k,267) - lu(k,165) * lu(k,261) - lu(k,268) = lu(k,268) - lu(k,166) * lu(k,261) - lu(k,269) = lu(k,269) - lu(k,167) * lu(k,261) - lu(k,271) = - lu(k,168) * lu(k,261) - lu(k,329) = lu(k,329) - lu(k,163) * lu(k,324) - lu(k,333) = lu(k,333) - lu(k,164) * lu(k,324) - lu(k,334) = lu(k,334) - lu(k,165) * lu(k,324) - lu(k,335) = lu(k,335) - lu(k,166) * lu(k,324) - lu(k,341) = lu(k,341) - lu(k,167) * lu(k,324) - lu(k,344) = lu(k,344) - lu(k,168) * lu(k,324) - lu(k,392) = lu(k,392) - lu(k,163) * lu(k,388) - lu(k,396) = lu(k,396) - lu(k,164) * lu(k,388) - lu(k,397) = lu(k,397) - lu(k,165) * lu(k,388) - lu(k,398) = lu(k,398) - lu(k,166) * lu(k,388) - lu(k,404) = lu(k,404) - lu(k,167) * lu(k,388) - lu(k,408) = lu(k,408) - lu(k,168) * lu(k,388) - lu(k,417) = lu(k,417) - lu(k,163) * lu(k,412) - lu(k,421) = lu(k,421) - lu(k,164) * lu(k,412) - lu(k,422) = lu(k,422) - lu(k,165) * lu(k,412) - lu(k,423) = lu(k,423) - lu(k,166) * lu(k,412) - lu(k,429) = lu(k,429) - lu(k,167) * lu(k,412) - lu(k,433) = lu(k,433) - lu(k,168) * lu(k,412) - lu(k,445) = lu(k,445) - lu(k,163) * lu(k,438) - lu(k,449) = lu(k,449) - lu(k,164) * lu(k,438) - lu(k,450) = lu(k,450) - lu(k,165) * lu(k,438) - lu(k,451) = lu(k,451) - lu(k,166) * lu(k,438) - lu(k,457) = lu(k,457) - lu(k,167) * lu(k,438) - lu(k,461) = - lu(k,168) * lu(k,438) - lu(k,488) = lu(k,488) - lu(k,163) * lu(k,474) - lu(k,492) = lu(k,492) - lu(k,164) * lu(k,474) - lu(k,493) = lu(k,493) - lu(k,165) * lu(k,474) - lu(k,494) = lu(k,494) - lu(k,166) * lu(k,474) - lu(k,500) = lu(k,500) - lu(k,167) * lu(k,474) - lu(k,504) = lu(k,504) - lu(k,168) * lu(k,474) - lu(k,650) = lu(k,650) - lu(k,163) * lu(k,641) - lu(k,654) = lu(k,654) - lu(k,164) * lu(k,641) - lu(k,655) = lu(k,655) - lu(k,165) * lu(k,641) - lu(k,656) = lu(k,656) - lu(k,166) * lu(k,641) - lu(k,662) = lu(k,662) - lu(k,167) * lu(k,641) - lu(k,666) = lu(k,666) - lu(k,168) * lu(k,641) + 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,157) = lu(k,157) * lu(k,152) + lu(k,710) = lu(k,710) - lu(k,153) * lu(k,702) + lu(k,719) = lu(k,719) - lu(k,154) * lu(k,702) + lu(k,721) = lu(k,721) - lu(k,155) * lu(k,702) + lu(k,723) = lu(k,723) - lu(k,156) * lu(k,702) + lu(k,725) = lu(k,725) - lu(k,157) * lu(k,702) + lu(k,834) = lu(k,834) - lu(k,153) * lu(k,813) + lu(k,843) = lu(k,843) - lu(k,154) * lu(k,813) + lu(k,845) = lu(k,845) - lu(k,155) * lu(k,813) + lu(k,847) = lu(k,847) - lu(k,156) * lu(k,813) + lu(k,849) = lu(k,849) - lu(k,157) * lu(k,813) + lu(k,889) = lu(k,889) - lu(k,153) * lu(k,877) + lu(k,898) = - lu(k,154) * lu(k,877) + lu(k,900) = lu(k,900) - lu(k,155) * lu(k,877) + lu(k,902) = lu(k,902) - lu(k,156) * lu(k,877) + lu(k,904) = lu(k,904) - lu(k,157) * lu(k,877) + lu(k,158) = 1._r8 / lu(k,158) + lu(k,159) = lu(k,159) * lu(k,158) + lu(k,160) = lu(k,160) * lu(k,158) + lu(k,161) = lu(k,161) * lu(k,158) + lu(k,162) = lu(k,162) * lu(k,158) + lu(k,163) = lu(k,163) * lu(k,158) + lu(k,408) = lu(k,408) - lu(k,159) * lu(k,407) + lu(k,409) = - lu(k,160) * lu(k,407) + lu(k,410) = lu(k,410) - lu(k,161) * lu(k,407) + lu(k,416) = - lu(k,162) * lu(k,407) + lu(k,418) = - lu(k,163) * lu(k,407) + lu(k,546) = lu(k,546) - lu(k,159) * lu(k,540) + lu(k,547) = lu(k,547) - lu(k,160) * lu(k,540) + lu(k,549) = - lu(k,161) * lu(k,540) + lu(k,561) = lu(k,561) - lu(k,162) * lu(k,540) + lu(k,565) = lu(k,565) - lu(k,163) * lu(k,540) + lu(k,831) = lu(k,831) - lu(k,159) * lu(k,814) + lu(k,833) = lu(k,833) - lu(k,160) * lu(k,814) + lu(k,835) = lu(k,835) - lu(k,161) * lu(k,814) + lu(k,847) = lu(k,847) - lu(k,162) * lu(k,814) + lu(k,851) = lu(k,851) - lu(k,163) * lu(k,814) + lu(k,164) = 1._r8 / lu(k,164) + lu(k,165) = lu(k,165) * lu(k,164) + lu(k,166) = lu(k,166) * lu(k,164) + lu(k,167) = lu(k,167) * lu(k,164) + lu(k,168) = lu(k,168) * lu(k,164) + lu(k,169) = lu(k,169) * lu(k,164) + lu(k,170) = lu(k,170) * lu(k,164) + lu(k,710) = lu(k,710) - lu(k,165) * lu(k,703) + lu(k,719) = lu(k,719) - lu(k,166) * lu(k,703) + lu(k,721) = lu(k,721) - lu(k,167) * lu(k,703) + lu(k,723) = lu(k,723) - lu(k,168) * lu(k,703) + lu(k,725) = lu(k,725) - lu(k,169) * lu(k,703) + lu(k,727) = lu(k,727) - lu(k,170) * lu(k,703) + lu(k,834) = lu(k,834) - lu(k,165) * lu(k,815) + lu(k,843) = lu(k,843) - lu(k,166) * lu(k,815) + lu(k,845) = lu(k,845) - lu(k,167) * lu(k,815) + lu(k,847) = lu(k,847) - lu(k,168) * lu(k,815) + lu(k,849) = lu(k,849) - lu(k,169) * lu(k,815) + lu(k,851) = lu(k,851) - lu(k,170) * lu(k,815) + lu(k,889) = lu(k,889) - lu(k,165) * lu(k,878) + lu(k,898) = lu(k,898) - lu(k,166) * lu(k,878) + lu(k,900) = lu(k,900) - lu(k,167) * lu(k,878) + lu(k,902) = lu(k,902) - lu(k,168) * lu(k,878) + lu(k,904) = lu(k,904) - lu(k,169) * lu(k,878) + lu(k,906) = lu(k,906) - lu(k,170) * lu(k,878) + lu(k,171) = 1._r8 / lu(k,171) + lu(k,172) = lu(k,172) * lu(k,171) + lu(k,173) = lu(k,173) * lu(k,171) + lu(k,174) = lu(k,174) * lu(k,171) + lu(k,175) = lu(k,175) * lu(k,171) + lu(k,176) = lu(k,176) * lu(k,171) + lu(k,177) = lu(k,177) * lu(k,171) + lu(k,550) = lu(k,550) - lu(k,172) * lu(k,541) + lu(k,552) = lu(k,552) - lu(k,173) * lu(k,541) + lu(k,554) = lu(k,554) - lu(k,174) * lu(k,541) + lu(k,560) = lu(k,560) - lu(k,175) * lu(k,541) + lu(k,561) = lu(k,561) - lu(k,176) * lu(k,541) + lu(k,565) = lu(k,565) - lu(k,177) * lu(k,541) + lu(k,787) = lu(k,787) - lu(k,172) * lu(k,776) + lu(k,789) = lu(k,789) - lu(k,173) * lu(k,776) + lu(k,791) = lu(k,791) - lu(k,174) * lu(k,776) + lu(k,797) = lu(k,797) - lu(k,175) * lu(k,776) + lu(k,798) = lu(k,798) - lu(k,176) * lu(k,776) + lu(k,802) = - lu(k,177) * lu(k,776) + lu(k,836) = lu(k,836) - lu(k,172) * lu(k,816) + lu(k,838) = lu(k,838) - lu(k,173) * lu(k,816) + lu(k,840) = lu(k,840) - lu(k,174) * lu(k,816) + lu(k,846) = lu(k,846) - lu(k,175) * lu(k,816) + lu(k,847) = lu(k,847) - lu(k,176) * lu(k,816) + lu(k,851) = lu(k,851) - lu(k,177) * lu(k,816) + lu(k,178) = 1._r8 / lu(k,178) + lu(k,179) = lu(k,179) * lu(k,178) + lu(k,180) = lu(k,180) * lu(k,178) + lu(k,181) = lu(k,181) * lu(k,178) + lu(k,182) = lu(k,182) * lu(k,178) + lu(k,183) = lu(k,183) * lu(k,178) + lu(k,184) = lu(k,184) * lu(k,178) + lu(k,316) = lu(k,316) - lu(k,179) * lu(k,315) + lu(k,317) = lu(k,317) - lu(k,180) * lu(k,315) + lu(k,319) = - lu(k,181) * lu(k,315) + lu(k,324) = lu(k,324) - lu(k,182) * lu(k,315) + lu(k,326) = lu(k,326) - lu(k,183) * lu(k,315) + lu(k,327) = - lu(k,184) * lu(k,315) + lu(k,492) = lu(k,492) - lu(k,179) * lu(k,491) + lu(k,493) = lu(k,493) - lu(k,180) * lu(k,491) + lu(k,496) = lu(k,496) - lu(k,181) * lu(k,491) + lu(k,502) = lu(k,502) - lu(k,182) * lu(k,491) + lu(k,509) = lu(k,509) - lu(k,183) * lu(k,491) + lu(k,510) = lu(k,510) - lu(k,184) * lu(k,491) + lu(k,623) = lu(k,623) - lu(k,179) * lu(k,622) + lu(k,626) = lu(k,626) - lu(k,180) * lu(k,622) + lu(k,632) = lu(k,632) - lu(k,181) * lu(k,622) + lu(k,640) = lu(k,640) - lu(k,182) * lu(k,622) + lu(k,650) = lu(k,650) - lu(k,183) * lu(k,622) + lu(k,651) = lu(k,651) - lu(k,184) * lu(k,622) + lu(k,185) = 1._r8 / lu(k,185) + lu(k,186) = lu(k,186) * lu(k,185) + lu(k,187) = lu(k,187) * lu(k,185) + lu(k,188) = lu(k,188) * lu(k,185) + lu(k,189) = lu(k,189) * lu(k,185) + lu(k,190) = lu(k,190) * lu(k,185) + lu(k,317) = lu(k,317) - lu(k,186) * lu(k,316) + lu(k,323) = lu(k,323) - lu(k,187) * lu(k,316) + lu(k,324) = lu(k,324) - lu(k,188) * lu(k,316) + lu(k,325) = - lu(k,189) * lu(k,316) + lu(k,326) = lu(k,326) - lu(k,190) * lu(k,316) + lu(k,493) = lu(k,493) - lu(k,186) * lu(k,492) + lu(k,501) = lu(k,501) - lu(k,187) * lu(k,492) + lu(k,502) = lu(k,502) - lu(k,188) * lu(k,492) + lu(k,505) = lu(k,505) - lu(k,189) * lu(k,492) + lu(k,509) = lu(k,509) - lu(k,190) * lu(k,492) + lu(k,626) = lu(k,626) - lu(k,186) * lu(k,623) + lu(k,639) = - lu(k,187) * lu(k,623) + lu(k,640) = lu(k,640) - lu(k,188) * lu(k,623) + lu(k,645) = lu(k,645) - lu(k,189) * lu(k,623) + lu(k,650) = lu(k,650) - lu(k,190) * lu(k,623) + lu(k,193) = 1._r8 / lu(k,193) + lu(k,194) = lu(k,194) * lu(k,193) + lu(k,195) = lu(k,195) * lu(k,193) + lu(k,196) = lu(k,196) * lu(k,193) + lu(k,197) = lu(k,197) * lu(k,193) + lu(k,198) = lu(k,198) * lu(k,193) + lu(k,279) = lu(k,279) - lu(k,194) * lu(k,278) + lu(k,280) = - lu(k,195) * lu(k,278) + lu(k,281) = - lu(k,196) * lu(k,278) + lu(k,282) = - lu(k,197) * lu(k,278) + lu(k,284) = - lu(k,198) * lu(k,278) + lu(k,370) = lu(k,370) - lu(k,194) * lu(k,367) + lu(k,374) = lu(k,374) - lu(k,195) * lu(k,367) + lu(k,375) = lu(k,375) - lu(k,196) * lu(k,367) + lu(k,377) = lu(k,377) - lu(k,197) * lu(k,367) + lu(k,379) = lu(k,379) - lu(k,198) * lu(k,367) + lu(k,386) = lu(k,386) - lu(k,194) * lu(k,385) + lu(k,388) = - lu(k,195) * lu(k,385) + lu(k,389) = - lu(k,196) * lu(k,385) + lu(k,395) = - lu(k,197) * lu(k,385) + lu(k,398) = lu(k,398) - lu(k,198) * lu(k,385) + lu(k,823) = lu(k,823) - lu(k,194) * lu(k,817) + lu(k,828) = - lu(k,195) * lu(k,817) + lu(k,829) = - lu(k,196) * lu(k,817) + lu(k,836) = lu(k,836) - lu(k,197) * lu(k,817) + lu(k,841) = lu(k,841) - lu(k,198) * lu(k,817) end do end subroutine lu_fac04 subroutine lu_fac05( avec_len, lu ) @@ -674,211 +581,206 @@ subroutine lu_fac05( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,170) = 1._r8 / lu(k,170) - lu(k,171) = lu(k,171) * lu(k,170) - lu(k,172) = lu(k,172) * lu(k,170) - lu(k,173) = lu(k,173) * lu(k,170) - lu(k,174) = lu(k,174) * lu(k,170) - lu(k,175) = lu(k,175) * lu(k,170) - lu(k,176) = lu(k,176) * lu(k,170) - lu(k,177) = lu(k,177) * lu(k,170) - lu(k,189) = lu(k,189) - lu(k,171) * lu(k,188) - lu(k,190) = lu(k,190) - lu(k,172) * lu(k,188) - lu(k,191) = lu(k,191) - lu(k,173) * lu(k,188) - lu(k,192) = lu(k,192) - lu(k,174) * lu(k,188) - lu(k,193) = lu(k,193) - lu(k,175) * lu(k,188) - lu(k,196) = lu(k,196) - lu(k,176) * lu(k,188) - lu(k,197) = lu(k,197) - lu(k,177) * lu(k,188) - lu(k,213) = lu(k,213) - lu(k,171) * lu(k,212) - lu(k,214) = lu(k,214) - lu(k,172) * lu(k,212) - lu(k,215) = lu(k,215) - lu(k,173) * lu(k,212) - lu(k,216) = lu(k,216) - lu(k,174) * lu(k,212) - lu(k,217) = lu(k,217) - lu(k,175) * lu(k,212) - lu(k,220) = lu(k,220) - lu(k,176) * lu(k,212) - lu(k,222) = lu(k,222) - lu(k,177) * lu(k,212) - lu(k,226) = lu(k,226) - lu(k,171) * lu(k,225) - lu(k,227) = - lu(k,172) * lu(k,225) - lu(k,228) = - lu(k,173) * lu(k,225) - lu(k,229) = lu(k,229) - lu(k,174) * lu(k,225) - lu(k,230) = lu(k,230) - lu(k,175) * lu(k,225) - lu(k,233) = lu(k,233) - lu(k,176) * lu(k,225) - lu(k,235) = lu(k,235) - lu(k,177) * lu(k,225) - lu(k,240) = - lu(k,171) * lu(k,239) - lu(k,241) = lu(k,241) - lu(k,172) * lu(k,239) - lu(k,242) = lu(k,242) - lu(k,173) * lu(k,239) - lu(k,243) = lu(k,243) - lu(k,174) * lu(k,239) - lu(k,244) = lu(k,244) - lu(k,175) * lu(k,239) - lu(k,247) = lu(k,247) - lu(k,176) * lu(k,239) - lu(k,249) = lu(k,249) - lu(k,177) * lu(k,239) - lu(k,477) = lu(k,477) - lu(k,171) * lu(k,475) - lu(k,478) = lu(k,478) - lu(k,172) * lu(k,475) - lu(k,479) = lu(k,479) - lu(k,173) * lu(k,475) - lu(k,480) = lu(k,480) - lu(k,174) * lu(k,475) - lu(k,481) = lu(k,481) - lu(k,175) * lu(k,475) - lu(k,494) = lu(k,494) - lu(k,176) * lu(k,475) - lu(k,499) = lu(k,499) - lu(k,177) * lu(k,475) - lu(k,607) = lu(k,607) - lu(k,171) * lu(k,606) - lu(k,608) = lu(k,608) - lu(k,172) * lu(k,606) - lu(k,609) = lu(k,609) - lu(k,173) * lu(k,606) - lu(k,610) = lu(k,610) - lu(k,174) * lu(k,606) - lu(k,611) = lu(k,611) - lu(k,175) * lu(k,606) - lu(k,619) = lu(k,619) - lu(k,176) * lu(k,606) - lu(k,624) = lu(k,624) - lu(k,177) * lu(k,606) - lu(k,178) = 1._r8 / lu(k,178) - lu(k,179) = lu(k,179) * lu(k,178) - lu(k,180) = lu(k,180) * lu(k,178) - lu(k,181) = lu(k,181) * lu(k,178) - lu(k,182) = lu(k,182) * lu(k,178) - lu(k,183) = lu(k,183) * lu(k,178) - lu(k,184) = lu(k,184) * lu(k,178) - lu(k,185) = lu(k,185) * lu(k,178) - lu(k,309) = lu(k,309) - lu(k,179) * lu(k,308) - lu(k,310) = lu(k,310) - lu(k,180) * lu(k,308) - lu(k,312) = - lu(k,181) * lu(k,308) - lu(k,314) = - lu(k,182) * lu(k,308) - lu(k,316) = lu(k,316) - lu(k,183) * lu(k,308) - lu(k,318) = lu(k,318) - lu(k,184) * lu(k,308) - lu(k,320) = - lu(k,185) * lu(k,308) - lu(k,390) = lu(k,390) - lu(k,179) * lu(k,389) - lu(k,391) = lu(k,391) - lu(k,180) * lu(k,389) - lu(k,398) = lu(k,398) - lu(k,181) * lu(k,389) - lu(k,400) = - lu(k,182) * lu(k,389) - lu(k,402) = lu(k,402) - lu(k,183) * lu(k,389) - lu(k,404) = lu(k,404) - lu(k,184) * lu(k,389) - lu(k,408) = lu(k,408) - lu(k,185) * lu(k,389) - lu(k,486) = lu(k,486) - lu(k,179) * lu(k,476) - lu(k,487) = lu(k,487) - lu(k,180) * lu(k,476) - lu(k,494) = lu(k,494) - lu(k,181) * lu(k,476) - lu(k,496) = - lu(k,182) * lu(k,476) - lu(k,498) = lu(k,498) - lu(k,183) * lu(k,476) - lu(k,500) = lu(k,500) - lu(k,184) * lu(k,476) - lu(k,504) = lu(k,504) - lu(k,185) * lu(k,476) - lu(k,508) = lu(k,508) - lu(k,179) * lu(k,506) - lu(k,509) = lu(k,509) - lu(k,180) * lu(k,506) - lu(k,516) = lu(k,516) - lu(k,181) * lu(k,506) - lu(k,518) = - lu(k,182) * lu(k,506) - lu(k,520) = - lu(k,183) * lu(k,506) - lu(k,522) = lu(k,522) - lu(k,184) * lu(k,506) - lu(k,526) = lu(k,526) - lu(k,185) * lu(k,506) - lu(k,533) = lu(k,533) - lu(k,179) * lu(k,531) - lu(k,534) = lu(k,534) - lu(k,180) * lu(k,531) - lu(k,541) = lu(k,541) - lu(k,181) * lu(k,531) - lu(k,543) = lu(k,543) - lu(k,182) * lu(k,531) - lu(k,545) = lu(k,545) - lu(k,183) * lu(k,531) - lu(k,547) = lu(k,547) - lu(k,184) * lu(k,531) - lu(k,551) = lu(k,551) - lu(k,185) * lu(k,531) - lu(k,648) = lu(k,648) - lu(k,179) * lu(k,642) - lu(k,649) = lu(k,649) - lu(k,180) * lu(k,642) - lu(k,656) = lu(k,656) - lu(k,181) * lu(k,642) - lu(k,658) = lu(k,658) - lu(k,182) * lu(k,642) - lu(k,660) = lu(k,660) - lu(k,183) * lu(k,642) - lu(k,662) = lu(k,662) - lu(k,184) * lu(k,642) - lu(k,666) = lu(k,666) - lu(k,185) * lu(k,642) - lu(k,189) = 1._r8 / lu(k,189) - lu(k,190) = lu(k,190) * lu(k,189) - lu(k,191) = lu(k,191) * lu(k,189) - lu(k,192) = lu(k,192) * lu(k,189) - lu(k,193) = lu(k,193) * lu(k,189) - lu(k,194) = lu(k,194) * lu(k,189) - lu(k,195) = lu(k,195) * lu(k,189) - lu(k,196) = lu(k,196) * lu(k,189) - lu(k,197) = lu(k,197) * lu(k,189) - lu(k,198) = lu(k,198) * lu(k,189) - lu(k,214) = lu(k,214) - lu(k,190) * lu(k,213) - lu(k,215) = lu(k,215) - lu(k,191) * lu(k,213) - lu(k,216) = lu(k,216) - lu(k,192) * lu(k,213) - lu(k,217) = lu(k,217) - lu(k,193) * lu(k,213) - lu(k,218) = - lu(k,194) * lu(k,213) - lu(k,219) = - lu(k,195) * lu(k,213) - lu(k,220) = lu(k,220) - lu(k,196) * lu(k,213) - lu(k,222) = lu(k,222) - lu(k,197) * lu(k,213) - lu(k,223) = - lu(k,198) * lu(k,213) - lu(k,227) = lu(k,227) - lu(k,190) * lu(k,226) - lu(k,228) = lu(k,228) - lu(k,191) * lu(k,226) - lu(k,229) = lu(k,229) - lu(k,192) * lu(k,226) - lu(k,230) = lu(k,230) - lu(k,193) * lu(k,226) - lu(k,231) = - lu(k,194) * lu(k,226) - lu(k,232) = - lu(k,195) * lu(k,226) - lu(k,233) = lu(k,233) - lu(k,196) * lu(k,226) - lu(k,235) = lu(k,235) - lu(k,197) * lu(k,226) - lu(k,236) = - lu(k,198) * lu(k,226) - lu(k,241) = lu(k,241) - lu(k,190) * lu(k,240) - lu(k,242) = lu(k,242) - lu(k,191) * lu(k,240) - lu(k,243) = lu(k,243) - lu(k,192) * lu(k,240) - lu(k,244) = lu(k,244) - lu(k,193) * lu(k,240) - lu(k,245) = lu(k,245) - lu(k,194) * lu(k,240) - lu(k,246) = - lu(k,195) * lu(k,240) - lu(k,247) = lu(k,247) - lu(k,196) * lu(k,240) - lu(k,249) = lu(k,249) - lu(k,197) * lu(k,240) - lu(k,250) = lu(k,250) - lu(k,198) * lu(k,240) - lu(k,478) = lu(k,478) - lu(k,190) * lu(k,477) - lu(k,479) = lu(k,479) - lu(k,191) * lu(k,477) - lu(k,480) = lu(k,480) - lu(k,192) * lu(k,477) - lu(k,481) = lu(k,481) - lu(k,193) * lu(k,477) - lu(k,486) = lu(k,486) - lu(k,194) * lu(k,477) - lu(k,491) = lu(k,491) - lu(k,195) * lu(k,477) - lu(k,494) = lu(k,494) - lu(k,196) * lu(k,477) - lu(k,499) = lu(k,499) - lu(k,197) * lu(k,477) - lu(k,500) = lu(k,500) - lu(k,198) * lu(k,477) - lu(k,608) = lu(k,608) - lu(k,190) * lu(k,607) - lu(k,609) = lu(k,609) - lu(k,191) * lu(k,607) - lu(k,610) = lu(k,610) - lu(k,192) * lu(k,607) - lu(k,611) = lu(k,611) - lu(k,193) * lu(k,607) - lu(k,614) = lu(k,614) - lu(k,194) * lu(k,607) - lu(k,616) = lu(k,616) - lu(k,195) * lu(k,607) - lu(k,619) = lu(k,619) - lu(k,196) * lu(k,607) - lu(k,624) = lu(k,624) - lu(k,197) * lu(k,607) - lu(k,625) = lu(k,625) - lu(k,198) * lu(k,607) - 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,206) = lu(k,206) * lu(k,200) - lu(k,207) = lu(k,207) * lu(k,200) - lu(k,215) = lu(k,215) - lu(k,201) * lu(k,214) - lu(k,216) = lu(k,216) - lu(k,202) * lu(k,214) - lu(k,217) = lu(k,217) - lu(k,203) * lu(k,214) - lu(k,220) = lu(k,220) - lu(k,204) * lu(k,214) - lu(k,221) = lu(k,221) - lu(k,205) * lu(k,214) - lu(k,222) = lu(k,222) - lu(k,206) * lu(k,214) - lu(k,224) = lu(k,224) - lu(k,207) * lu(k,214) - lu(k,228) = lu(k,228) - lu(k,201) * lu(k,227) - lu(k,229) = lu(k,229) - lu(k,202) * lu(k,227) - lu(k,230) = lu(k,230) - lu(k,203) * lu(k,227) - lu(k,233) = lu(k,233) - lu(k,204) * lu(k,227) - lu(k,234) = lu(k,234) - lu(k,205) * lu(k,227) - lu(k,235) = lu(k,235) - lu(k,206) * lu(k,227) - lu(k,237) = lu(k,237) - lu(k,207) * lu(k,227) - lu(k,242) = lu(k,242) - lu(k,201) * lu(k,241) - lu(k,243) = lu(k,243) - lu(k,202) * lu(k,241) - lu(k,244) = lu(k,244) - lu(k,203) * lu(k,241) - lu(k,247) = lu(k,247) - lu(k,204) * lu(k,241) - lu(k,248) = - lu(k,205) * lu(k,241) - lu(k,249) = lu(k,249) - lu(k,206) * lu(k,241) - lu(k,252) = lu(k,252) - lu(k,207) * lu(k,241) - lu(k,479) = lu(k,479) - lu(k,201) * lu(k,478) - lu(k,480) = lu(k,480) - lu(k,202) * lu(k,478) - lu(k,481) = lu(k,481) - lu(k,203) * lu(k,478) - lu(k,494) = lu(k,494) - lu(k,204) * lu(k,478) - lu(k,496) = lu(k,496) - lu(k,205) * lu(k,478) - lu(k,499) = lu(k,499) - lu(k,206) * lu(k,478) - lu(k,503) = lu(k,503) - lu(k,207) * lu(k,478) - lu(k,609) = lu(k,609) - lu(k,201) * lu(k,608) - lu(k,610) = lu(k,610) - lu(k,202) * lu(k,608) - lu(k,611) = lu(k,611) - lu(k,203) * lu(k,608) - lu(k,619) = lu(k,619) - lu(k,204) * lu(k,608) - lu(k,621) = lu(k,621) - lu(k,205) * lu(k,608) - lu(k,624) = lu(k,624) - lu(k,206) * lu(k,608) - lu(k,628) = lu(k,628) - lu(k,207) * lu(k,608) - lu(k,719) = lu(k,719) - lu(k,201) * lu(k,718) - lu(k,720) = lu(k,720) - lu(k,202) * lu(k,718) - lu(k,721) = lu(k,721) - lu(k,203) * lu(k,718) - lu(k,729) = lu(k,729) - lu(k,204) * lu(k,718) - lu(k,731) = - lu(k,205) * lu(k,718) - lu(k,734) = lu(k,734) - lu(k,206) * lu(k,718) - lu(k,738) = lu(k,738) - lu(k,207) * lu(k,718) + lu(k,199) = 1._r8 / lu(k,199) + lu(k,200) = lu(k,200) * lu(k,199) + lu(k,201) = lu(k,201) * lu(k,199) + lu(k,202) = lu(k,202) * lu(k,199) + lu(k,203) = lu(k,203) * lu(k,199) + lu(k,204) = lu(k,204) * lu(k,199) + lu(k,205) = lu(k,205) * lu(k,199) + lu(k,206) = lu(k,206) * lu(k,199) + lu(k,629) = lu(k,629) - lu(k,200) * lu(k,624) + lu(k,649) = lu(k,649) - lu(k,201) * lu(k,624) + lu(k,650) = lu(k,650) - lu(k,202) * lu(k,624) + lu(k,653) = lu(k,653) - lu(k,203) * lu(k,624) + lu(k,654) = lu(k,654) - lu(k,204) * lu(k,624) + lu(k,655) = lu(k,655) - lu(k,205) * lu(k,624) + lu(k,657) = - lu(k,206) * lu(k,624) + lu(k,731) = lu(k,731) - lu(k,200) * lu(k,730) + lu(k,740) = - lu(k,201) * lu(k,730) + lu(k,741) = lu(k,741) - lu(k,202) * lu(k,730) + lu(k,744) = lu(k,744) - lu(k,203) * lu(k,730) + lu(k,745) = lu(k,745) - lu(k,204) * lu(k,730) + lu(k,746) = lu(k,746) - lu(k,205) * lu(k,730) + lu(k,748) = - lu(k,206) * lu(k,730) + lu(k,778) = - lu(k,200) * lu(k,777) + lu(k,791) = lu(k,791) - lu(k,201) * lu(k,777) + lu(k,792) = lu(k,792) - lu(k,202) * lu(k,777) + lu(k,795) = lu(k,795) - lu(k,203) * lu(k,777) + lu(k,796) = - lu(k,204) * lu(k,777) + lu(k,797) = lu(k,797) - lu(k,205) * lu(k,777) + lu(k,799) = lu(k,799) - lu(k,206) * lu(k,777) + lu(k,207) = 1._r8 / lu(k,207) + lu(k,208) = lu(k,208) * lu(k,207) + lu(k,209) = lu(k,209) * lu(k,207) + lu(k,210) = lu(k,210) * lu(k,207) + lu(k,211) = lu(k,211) * lu(k,207) + lu(k,212) = lu(k,212) * lu(k,207) + lu(k,213) = lu(k,213) * lu(k,207) + lu(k,214) = lu(k,214) * lu(k,207) + lu(k,215) = lu(k,215) * lu(k,207) + lu(k,708) = lu(k,708) - lu(k,208) * lu(k,704) + lu(k,710) = lu(k,710) - lu(k,209) * lu(k,704) + lu(k,714) = lu(k,714) - lu(k,210) * lu(k,704) + lu(k,719) = lu(k,719) - lu(k,211) * lu(k,704) + lu(k,721) = lu(k,721) - lu(k,212) * lu(k,704) + lu(k,723) = lu(k,723) - lu(k,213) * lu(k,704) + lu(k,725) = lu(k,725) - lu(k,214) * lu(k,704) + lu(k,727) = lu(k,727) - lu(k,215) * lu(k,704) + lu(k,831) = lu(k,831) - lu(k,208) * lu(k,818) + lu(k,834) = lu(k,834) - lu(k,209) * lu(k,818) + lu(k,838) = lu(k,838) - lu(k,210) * lu(k,818) + lu(k,843) = lu(k,843) - lu(k,211) * lu(k,818) + lu(k,845) = lu(k,845) - lu(k,212) * lu(k,818) + lu(k,847) = lu(k,847) - lu(k,213) * lu(k,818) + lu(k,849) = lu(k,849) - lu(k,214) * lu(k,818) + lu(k,851) = lu(k,851) - lu(k,215) * lu(k,818) + lu(k,887) = lu(k,887) - lu(k,208) * lu(k,879) + lu(k,889) = lu(k,889) - lu(k,209) * lu(k,879) + lu(k,893) = lu(k,893) - lu(k,210) * lu(k,879) + lu(k,898) = lu(k,898) - lu(k,211) * lu(k,879) + lu(k,900) = lu(k,900) - lu(k,212) * lu(k,879) + lu(k,902) = lu(k,902) - lu(k,213) * lu(k,879) + lu(k,904) = lu(k,904) - lu(k,214) * lu(k,879) + lu(k,906) = lu(k,906) - lu(k,215) * lu(k,879) + lu(k,216) = 1._r8 / lu(k,216) + lu(k,217) = lu(k,217) * lu(k,216) + lu(k,218) = lu(k,218) * lu(k,216) + lu(k,219) = lu(k,219) * lu(k,216) + lu(k,220) = lu(k,220) * lu(k,216) + lu(k,221) = lu(k,221) * lu(k,216) + lu(k,222) = lu(k,222) * lu(k,216) + lu(k,548) = lu(k,548) - lu(k,217) * lu(k,542) + lu(k,552) = lu(k,552) - lu(k,218) * lu(k,542) + lu(k,555) = lu(k,555) - lu(k,219) * lu(k,542) + lu(k,561) = lu(k,561) - lu(k,220) * lu(k,542) + lu(k,563) = lu(k,563) - lu(k,221) * lu(k,542) + lu(k,565) = lu(k,565) - lu(k,222) * lu(k,542) + lu(k,643) = lu(k,643) - lu(k,217) * lu(k,625) + lu(k,647) = lu(k,647) - lu(k,218) * lu(k,625) + lu(k,650) = lu(k,650) - lu(k,219) * lu(k,625) + lu(k,656) = lu(k,656) - lu(k,220) * lu(k,625) + lu(k,658) = lu(k,658) - lu(k,221) * lu(k,625) + lu(k,660) = - lu(k,222) * lu(k,625) + lu(k,834) = lu(k,834) - lu(k,217) * lu(k,819) + lu(k,838) = lu(k,838) - lu(k,218) * lu(k,819) + lu(k,841) = lu(k,841) - lu(k,219) * lu(k,819) + lu(k,847) = lu(k,847) - lu(k,220) * lu(k,819) + lu(k,849) = lu(k,849) - lu(k,221) * lu(k,819) + lu(k,851) = lu(k,851) - lu(k,222) * lu(k,819) + lu(k,889) = lu(k,889) - lu(k,217) * lu(k,880) + lu(k,893) = lu(k,893) - lu(k,218) * lu(k,880) + lu(k,896) = - lu(k,219) * lu(k,880) + lu(k,902) = lu(k,902) - lu(k,220) * lu(k,880) + lu(k,904) = lu(k,904) - lu(k,221) * lu(k,880) + lu(k,906) = lu(k,906) - lu(k,222) * lu(k,880) + lu(k,223) = 1._r8 / lu(k,223) + lu(k,224) = lu(k,224) * lu(k,223) + lu(k,225) = lu(k,225) * lu(k,223) + lu(k,226) = lu(k,226) * lu(k,223) + lu(k,227) = lu(k,227) * lu(k,223) + lu(k,228) = lu(k,228) * lu(k,223) + lu(k,229) = lu(k,229) * lu(k,223) + lu(k,230) = lu(k,230) * lu(k,223) + lu(k,231) = lu(k,231) * lu(k,223) + lu(k,318) = lu(k,318) - lu(k,224) * lu(k,317) + lu(k,320) = lu(k,320) - lu(k,225) * lu(k,317) + lu(k,321) = lu(k,321) - lu(k,226) * lu(k,317) + lu(k,322) = lu(k,322) - lu(k,227) * lu(k,317) + lu(k,323) = lu(k,323) - lu(k,228) * lu(k,317) + lu(k,324) = lu(k,324) - lu(k,229) * lu(k,317) + lu(k,325) = lu(k,325) - lu(k,230) * lu(k,317) + lu(k,326) = lu(k,326) - lu(k,231) * lu(k,317) + lu(k,495) = lu(k,495) - lu(k,224) * lu(k,493) + lu(k,498) = lu(k,498) - lu(k,225) * lu(k,493) + lu(k,499) = lu(k,499) - lu(k,226) * lu(k,493) + lu(k,500) = lu(k,500) - lu(k,227) * lu(k,493) + lu(k,501) = lu(k,501) - lu(k,228) * lu(k,493) + lu(k,502) = lu(k,502) - lu(k,229) * lu(k,493) + lu(k,505) = lu(k,505) - lu(k,230) * lu(k,493) + lu(k,509) = lu(k,509) - lu(k,231) * lu(k,493) + lu(k,628) = lu(k,628) - lu(k,224) * lu(k,626) + lu(k,636) = lu(k,636) - lu(k,225) * lu(k,626) + lu(k,637) = lu(k,637) - lu(k,226) * lu(k,626) + lu(k,638) = lu(k,638) - lu(k,227) * lu(k,626) + lu(k,639) = lu(k,639) - lu(k,228) * lu(k,626) + lu(k,640) = lu(k,640) - lu(k,229) * lu(k,626) + lu(k,645) = lu(k,645) - lu(k,230) * lu(k,626) + lu(k,650) = lu(k,650) - lu(k,231) * lu(k,626) + lu(k,232) = 1._r8 / lu(k,232) + lu(k,233) = lu(k,233) * lu(k,232) + lu(k,234) = lu(k,234) * lu(k,232) + lu(k,235) = lu(k,235) * lu(k,232) + lu(k,236) = lu(k,236) * lu(k,232) + lu(k,237) = lu(k,237) * lu(k,232) + lu(k,238) = lu(k,238) * lu(k,232) + lu(k,422) = lu(k,422) - lu(k,233) * lu(k,420) + lu(k,423) = lu(k,423) - lu(k,234) * lu(k,420) + lu(k,424) = lu(k,424) - lu(k,235) * lu(k,420) + lu(k,425) = lu(k,425) - lu(k,236) * lu(k,420) + lu(k,428) = lu(k,428) - lu(k,237) * lu(k,420) + lu(k,433) = lu(k,433) - lu(k,238) * lu(k,420) + lu(k,503) = lu(k,503) - lu(k,233) * lu(k,494) + lu(k,504) = lu(k,504) - lu(k,234) * lu(k,494) + lu(k,505) = lu(k,505) - lu(k,235) * lu(k,494) + lu(k,506) = lu(k,506) - lu(k,236) * lu(k,494) + lu(k,509) = lu(k,509) - lu(k,237) * lu(k,494) + lu(k,515) = - lu(k,238) * lu(k,494) + lu(k,523) = lu(k,523) - lu(k,233) * lu(k,521) + lu(k,524) = lu(k,524) - lu(k,234) * lu(k,521) + lu(k,525) = lu(k,525) - lu(k,235) * lu(k,521) + lu(k,526) = lu(k,526) - lu(k,236) * lu(k,521) + lu(k,530) = lu(k,530) - lu(k,237) * lu(k,521) + lu(k,536) = lu(k,536) - lu(k,238) * lu(k,521) + lu(k,641) = lu(k,641) - lu(k,233) * lu(k,627) + lu(k,642) = lu(k,642) - lu(k,234) * lu(k,627) + lu(k,645) = lu(k,645) - lu(k,235) * lu(k,627) + lu(k,646) = lu(k,646) - lu(k,236) * lu(k,627) + lu(k,650) = lu(k,650) - lu(k,237) * lu(k,627) + lu(k,656) = lu(k,656) - lu(k,238) * lu(k,627) + lu(k,832) = lu(k,832) - lu(k,233) * lu(k,820) + lu(k,833) = lu(k,833) - lu(k,234) * lu(k,820) + lu(k,836) = lu(k,836) - lu(k,235) * lu(k,820) + lu(k,837) = lu(k,837) - lu(k,236) * lu(k,820) + lu(k,841) = lu(k,841) - lu(k,237) * lu(k,820) + lu(k,847) = lu(k,847) - lu(k,238) * lu(k,820) + lu(k,239) = 1._r8 / lu(k,239) + lu(k,240) = lu(k,240) * lu(k,239) + lu(k,241) = lu(k,241) * lu(k,239) + lu(k,242) = lu(k,242) * lu(k,239) + lu(k,243) = lu(k,243) * lu(k,239) + lu(k,271) = - lu(k,240) * lu(k,269) + lu(k,272) = - lu(k,241) * lu(k,269) + lu(k,273) = lu(k,273) - lu(k,242) * lu(k,269) + lu(k,277) = lu(k,277) - lu(k,243) * lu(k,269) + lu(k,320) = lu(k,320) - lu(k,240) * lu(k,318) + lu(k,321) = lu(k,321) - lu(k,241) * lu(k,318) + lu(k,322) = lu(k,322) - lu(k,242) * lu(k,318) + lu(k,326) = lu(k,326) - lu(k,243) * lu(k,318) + lu(k,342) = lu(k,342) - lu(k,240) * lu(k,340) + lu(k,343) = - lu(k,241) * lu(k,340) + lu(k,344) = lu(k,344) - lu(k,242) * lu(k,340) + lu(k,349) = lu(k,349) - lu(k,243) * lu(k,340) + lu(k,355) = lu(k,355) - lu(k,240) * lu(k,354) + lu(k,356) = - lu(k,241) * lu(k,354) + lu(k,357) = lu(k,357) - lu(k,242) * lu(k,354) + lu(k,362) = lu(k,362) - lu(k,243) * lu(k,354) + lu(k,371) = - lu(k,240) * lu(k,368) + lu(k,372) = lu(k,372) - lu(k,241) * lu(k,368) + lu(k,373) = lu(k,373) - lu(k,242) * lu(k,368) + lu(k,379) = lu(k,379) - lu(k,243) * lu(k,368) + lu(k,498) = lu(k,498) - lu(k,240) * lu(k,495) + lu(k,499) = lu(k,499) - lu(k,241) * lu(k,495) + lu(k,500) = lu(k,500) - lu(k,242) * lu(k,495) + lu(k,509) = lu(k,509) - lu(k,243) * lu(k,495) + lu(k,636) = lu(k,636) - lu(k,240) * lu(k,628) + lu(k,637) = lu(k,637) - lu(k,241) * lu(k,628) + lu(k,638) = lu(k,638) - lu(k,242) * lu(k,628) + lu(k,650) = lu(k,650) - lu(k,243) * lu(k,628) + lu(k,662) = lu(k,662) - lu(k,240) * lu(k,661) + lu(k,663) = - lu(k,241) * lu(k,661) + lu(k,664) = lu(k,664) - lu(k,242) * lu(k,661) + lu(k,675) = lu(k,675) - lu(k,243) * lu(k,661) end do end subroutine lu_fac05 subroutine lu_fac06( avec_len, lu ) @@ -895,207 +797,99 @@ subroutine lu_fac06( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,215) = 1._r8 / lu(k,215) - lu(k,216) = lu(k,216) * lu(k,215) - lu(k,217) = lu(k,217) * lu(k,215) - lu(k,218) = lu(k,218) * lu(k,215) - lu(k,219) = lu(k,219) * lu(k,215) - lu(k,220) = lu(k,220) * lu(k,215) - lu(k,221) = lu(k,221) * lu(k,215) - lu(k,222) = lu(k,222) * lu(k,215) - lu(k,223) = lu(k,223) * lu(k,215) - lu(k,224) = lu(k,224) * lu(k,215) - lu(k,229) = lu(k,229) - lu(k,216) * lu(k,228) - lu(k,230) = lu(k,230) - lu(k,217) * lu(k,228) - lu(k,231) = lu(k,231) - lu(k,218) * lu(k,228) - lu(k,232) = lu(k,232) - lu(k,219) * lu(k,228) - lu(k,233) = lu(k,233) - lu(k,220) * lu(k,228) - lu(k,234) = lu(k,234) - lu(k,221) * lu(k,228) - lu(k,235) = lu(k,235) - lu(k,222) * lu(k,228) - lu(k,236) = lu(k,236) - lu(k,223) * lu(k,228) - lu(k,237) = lu(k,237) - lu(k,224) * lu(k,228) - lu(k,243) = lu(k,243) - lu(k,216) * lu(k,242) - lu(k,244) = lu(k,244) - lu(k,217) * lu(k,242) - lu(k,245) = lu(k,245) - lu(k,218) * lu(k,242) - lu(k,246) = lu(k,246) - lu(k,219) * lu(k,242) - lu(k,247) = lu(k,247) - lu(k,220) * lu(k,242) - lu(k,248) = lu(k,248) - lu(k,221) * lu(k,242) - lu(k,249) = lu(k,249) - lu(k,222) * lu(k,242) - lu(k,250) = lu(k,250) - lu(k,223) * lu(k,242) - lu(k,252) = lu(k,252) - lu(k,224) * lu(k,242) - lu(k,480) = lu(k,480) - lu(k,216) * lu(k,479) - lu(k,481) = lu(k,481) - lu(k,217) * lu(k,479) - lu(k,486) = lu(k,486) - lu(k,218) * lu(k,479) - lu(k,491) = lu(k,491) - lu(k,219) * lu(k,479) - lu(k,494) = lu(k,494) - lu(k,220) * lu(k,479) - lu(k,496) = lu(k,496) - lu(k,221) * lu(k,479) - lu(k,499) = lu(k,499) - lu(k,222) * lu(k,479) - lu(k,500) = lu(k,500) - lu(k,223) * lu(k,479) - lu(k,503) = lu(k,503) - lu(k,224) * lu(k,479) - lu(k,610) = lu(k,610) - lu(k,216) * lu(k,609) - lu(k,611) = lu(k,611) - lu(k,217) * lu(k,609) - lu(k,614) = lu(k,614) - lu(k,218) * lu(k,609) - lu(k,616) = lu(k,616) - lu(k,219) * lu(k,609) - lu(k,619) = lu(k,619) - lu(k,220) * lu(k,609) - lu(k,621) = lu(k,621) - lu(k,221) * lu(k,609) - lu(k,624) = lu(k,624) - lu(k,222) * lu(k,609) - lu(k,625) = lu(k,625) - lu(k,223) * lu(k,609) - lu(k,628) = lu(k,628) - lu(k,224) * lu(k,609) - lu(k,720) = lu(k,720) - lu(k,216) * lu(k,719) - lu(k,721) = lu(k,721) - lu(k,217) * lu(k,719) - lu(k,722) = - lu(k,218) * lu(k,719) - lu(k,726) = lu(k,726) - lu(k,219) * lu(k,719) - lu(k,729) = lu(k,729) - lu(k,220) * lu(k,719) - lu(k,731) = lu(k,731) - lu(k,221) * lu(k,719) - lu(k,734) = lu(k,734) - lu(k,222) * lu(k,719) - lu(k,735) = lu(k,735) - lu(k,223) * lu(k,719) - lu(k,738) = lu(k,738) - lu(k,224) * lu(k,719) - lu(k,229) = 1._r8 / lu(k,229) - lu(k,230) = lu(k,230) * lu(k,229) - lu(k,231) = lu(k,231) * lu(k,229) - lu(k,232) = lu(k,232) * lu(k,229) - lu(k,233) = lu(k,233) * lu(k,229) - lu(k,234) = lu(k,234) * lu(k,229) - lu(k,235) = lu(k,235) * lu(k,229) - lu(k,236) = lu(k,236) * lu(k,229) - lu(k,237) = lu(k,237) * lu(k,229) - lu(k,244) = lu(k,244) - lu(k,230) * lu(k,243) - lu(k,245) = lu(k,245) - lu(k,231) * lu(k,243) - lu(k,246) = lu(k,246) - lu(k,232) * lu(k,243) - lu(k,247) = lu(k,247) - lu(k,233) * lu(k,243) - lu(k,248) = lu(k,248) - lu(k,234) * lu(k,243) - lu(k,249) = lu(k,249) - lu(k,235) * lu(k,243) - lu(k,250) = lu(k,250) - lu(k,236) * lu(k,243) - lu(k,252) = lu(k,252) - lu(k,237) * lu(k,243) - lu(k,481) = lu(k,481) - lu(k,230) * lu(k,480) - lu(k,486) = lu(k,486) - lu(k,231) * lu(k,480) - lu(k,491) = lu(k,491) - lu(k,232) * lu(k,480) - lu(k,494) = lu(k,494) - lu(k,233) * lu(k,480) - lu(k,496) = lu(k,496) - lu(k,234) * lu(k,480) - lu(k,499) = lu(k,499) - lu(k,235) * lu(k,480) - lu(k,500) = lu(k,500) - lu(k,236) * lu(k,480) - lu(k,503) = lu(k,503) - lu(k,237) * lu(k,480) - lu(k,611) = lu(k,611) - lu(k,230) * lu(k,610) - lu(k,614) = lu(k,614) - lu(k,231) * lu(k,610) - lu(k,616) = lu(k,616) - lu(k,232) * lu(k,610) - lu(k,619) = lu(k,619) - lu(k,233) * lu(k,610) - lu(k,621) = lu(k,621) - lu(k,234) * lu(k,610) - lu(k,624) = lu(k,624) - lu(k,235) * lu(k,610) - lu(k,625) = lu(k,625) - lu(k,236) * lu(k,610) - lu(k,628) = lu(k,628) - lu(k,237) * lu(k,610) - lu(k,721) = lu(k,721) - lu(k,230) * lu(k,720) - lu(k,722) = lu(k,722) - lu(k,231) * lu(k,720) - lu(k,726) = lu(k,726) - lu(k,232) * lu(k,720) - lu(k,729) = lu(k,729) - lu(k,233) * lu(k,720) - lu(k,731) = lu(k,731) - lu(k,234) * lu(k,720) - lu(k,734) = lu(k,734) - lu(k,235) * lu(k,720) - lu(k,735) = lu(k,735) - lu(k,236) * lu(k,720) - lu(k,738) = lu(k,738) - lu(k,237) * lu(k,720) - lu(k,244) = 1._r8 / lu(k,244) - lu(k,245) = lu(k,245) * lu(k,244) - lu(k,246) = lu(k,246) * lu(k,244) - lu(k,247) = lu(k,247) * lu(k,244) - lu(k,248) = lu(k,248) * lu(k,244) - lu(k,249) = lu(k,249) * lu(k,244) - lu(k,250) = lu(k,250) * lu(k,244) - lu(k,251) = lu(k,251) * lu(k,244) - lu(k,252) = lu(k,252) * lu(k,244) - lu(k,486) = lu(k,486) - lu(k,245) * lu(k,481) - lu(k,491) = lu(k,491) - lu(k,246) * lu(k,481) - lu(k,494) = lu(k,494) - lu(k,247) * lu(k,481) - lu(k,496) = lu(k,496) - lu(k,248) * lu(k,481) - lu(k,499) = lu(k,499) - lu(k,249) * lu(k,481) - lu(k,500) = lu(k,500) - lu(k,250) * lu(k,481) - lu(k,502) = lu(k,502) - lu(k,251) * lu(k,481) - lu(k,503) = lu(k,503) - lu(k,252) * lu(k,481) - lu(k,614) = lu(k,614) - lu(k,245) * lu(k,611) - lu(k,616) = lu(k,616) - lu(k,246) * lu(k,611) - lu(k,619) = lu(k,619) - lu(k,247) * lu(k,611) - lu(k,621) = lu(k,621) - lu(k,248) * lu(k,611) - lu(k,624) = lu(k,624) - lu(k,249) * lu(k,611) - lu(k,625) = lu(k,625) - lu(k,250) * lu(k,611) - lu(k,627) = - lu(k,251) * lu(k,611) - lu(k,628) = lu(k,628) - lu(k,252) * lu(k,611) - lu(k,648) = lu(k,648) - lu(k,245) * lu(k,643) - lu(k,653) = lu(k,653) - lu(k,246) * lu(k,643) - lu(k,656) = lu(k,656) - lu(k,247) * lu(k,643) - lu(k,658) = lu(k,658) - lu(k,248) * lu(k,643) - lu(k,661) = lu(k,661) - lu(k,249) * lu(k,643) - lu(k,662) = lu(k,662) - lu(k,250) * lu(k,643) - lu(k,664) = lu(k,664) - lu(k,251) * lu(k,643) - lu(k,665) = lu(k,665) - lu(k,252) * lu(k,643) - lu(k,698) = - lu(k,245) * lu(k,693) - lu(k,703) = lu(k,703) - lu(k,246) * lu(k,693) - lu(k,706) = lu(k,706) - lu(k,247) * lu(k,693) - lu(k,708) = - lu(k,248) * lu(k,693) - lu(k,711) = lu(k,711) - lu(k,249) * lu(k,693) - lu(k,712) = lu(k,712) - lu(k,250) * lu(k,693) - lu(k,714) = lu(k,714) - lu(k,251) * lu(k,693) - lu(k,715) = lu(k,715) - lu(k,252) * lu(k,693) - lu(k,722) = lu(k,722) - lu(k,245) * lu(k,721) - lu(k,726) = lu(k,726) - lu(k,246) * lu(k,721) - lu(k,729) = lu(k,729) - lu(k,247) * lu(k,721) - lu(k,731) = lu(k,731) - lu(k,248) * lu(k,721) - lu(k,734) = lu(k,734) - lu(k,249) * lu(k,721) - lu(k,735) = lu(k,735) - lu(k,250) * lu(k,721) - lu(k,737) = lu(k,737) - lu(k,251) * lu(k,721) - lu(k,738) = lu(k,738) - lu(k,252) * lu(k,721) - lu(k,254) = 1._r8 / lu(k,254) - lu(k,255) = lu(k,255) * lu(k,254) - lu(k,256) = lu(k,256) * lu(k,254) - lu(k,257) = lu(k,257) * lu(k,254) - lu(k,258) = lu(k,258) * lu(k,254) - lu(k,259) = lu(k,259) * lu(k,254) - lu(k,285) = lu(k,285) - lu(k,255) * lu(k,284) - lu(k,288) = - lu(k,256) * lu(k,284) - lu(k,291) = lu(k,291) - lu(k,257) * lu(k,284) - lu(k,294) = lu(k,294) - lu(k,258) * lu(k,284) - lu(k,298) = - lu(k,259) * lu(k,284) - lu(k,365) = - lu(k,255) * lu(k,363) - lu(k,370) = lu(k,370) - lu(k,256) * lu(k,363) - lu(k,373) = lu(k,373) - lu(k,257) * lu(k,363) - lu(k,379) = lu(k,379) - lu(k,258) * lu(k,363) - lu(k,383) = - lu(k,259) * lu(k,363) - lu(k,442) = lu(k,442) - lu(k,255) * lu(k,439) - lu(k,448) = lu(k,448) - lu(k,256) * lu(k,439) - lu(k,451) = lu(k,451) - lu(k,257) * lu(k,439) - lu(k,457) = lu(k,457) - lu(k,258) * lu(k,439) - lu(k,461) = lu(k,461) - lu(k,259) * lu(k,439) - lu(k,485) = lu(k,485) - lu(k,255) * lu(k,482) - lu(k,491) = lu(k,491) - lu(k,256) * lu(k,482) - lu(k,494) = lu(k,494) - lu(k,257) * lu(k,482) - lu(k,500) = lu(k,500) - lu(k,258) * lu(k,482) - lu(k,504) = lu(k,504) - lu(k,259) * lu(k,482) - lu(k,579) = lu(k,579) - lu(k,255) * lu(k,577) - lu(k,585) = lu(k,585) - lu(k,256) * lu(k,577) - lu(k,588) = lu(k,588) - lu(k,257) * lu(k,577) - lu(k,594) = lu(k,594) - lu(k,258) * lu(k,577) - lu(k,598) = lu(k,598) - lu(k,259) * lu(k,577) - lu(k,613) = lu(k,613) - lu(k,255) * lu(k,612) - lu(k,616) = lu(k,616) - lu(k,256) * lu(k,612) - lu(k,619) = lu(k,619) - lu(k,257) * lu(k,612) - lu(k,625) = lu(k,625) - lu(k,258) * lu(k,612) - lu(k,629) = - lu(k,259) * lu(k,612) - lu(k,647) = lu(k,647) - lu(k,255) * lu(k,644) - lu(k,653) = lu(k,653) - lu(k,256) * lu(k,644) - lu(k,656) = lu(k,656) - lu(k,257) * lu(k,644) - lu(k,662) = lu(k,662) - lu(k,258) * lu(k,644) - lu(k,666) = lu(k,666) - lu(k,259) * lu(k,644) - lu(k,671) = lu(k,671) - lu(k,255) * lu(k,670) - lu(k,675) = lu(k,675) - lu(k,256) * lu(k,670) - lu(k,678) = lu(k,678) - lu(k,257) * lu(k,670) - lu(k,684) = lu(k,684) - lu(k,258) * lu(k,670) - lu(k,688) = - lu(k,259) * lu(k,670) - lu(k,697) = lu(k,697) - lu(k,255) * lu(k,694) - lu(k,703) = lu(k,703) - lu(k,256) * lu(k,694) - lu(k,706) = lu(k,706) - lu(k,257) * lu(k,694) - lu(k,712) = lu(k,712) - lu(k,258) * lu(k,694) - lu(k,716) = lu(k,716) - lu(k,259) * lu(k,694) - lu(k,746) = - lu(k,255) * lu(k,744) - lu(k,751) = - lu(k,256) * lu(k,744) - lu(k,754) = lu(k,754) - lu(k,257) * lu(k,744) - lu(k,760) = lu(k,760) - lu(k,258) * lu(k,744) - lu(k,764) = lu(k,764) - lu(k,259) * lu(k,744) + lu(k,245) = 1._r8 / lu(k,245) + lu(k,246) = lu(k,246) * lu(k,245) + lu(k,247) = lu(k,247) * lu(k,245) + lu(k,248) = lu(k,248) * lu(k,245) + lu(k,249) = lu(k,249) * lu(k,245) + lu(k,250) = lu(k,250) * lu(k,245) + lu(k,251) = lu(k,251) * lu(k,245) + lu(k,252) = lu(k,252) * lu(k,245) + lu(k,450) = lu(k,450) - lu(k,246) * lu(k,446) + lu(k,456) = lu(k,456) - lu(k,247) * lu(k,446) + lu(k,458) = - lu(k,248) * lu(k,446) + lu(k,459) = lu(k,459) - lu(k,249) * lu(k,446) + lu(k,461) = lu(k,461) - lu(k,250) * lu(k,446) + lu(k,463) = lu(k,463) - lu(k,251) * lu(k,446) + lu(k,465) = lu(k,465) - lu(k,252) * lu(k,446) + lu(k,548) = lu(k,548) - lu(k,246) * lu(k,543) + lu(k,555) = lu(k,555) - lu(k,247) * lu(k,543) + lu(k,558) = lu(k,558) - lu(k,248) * lu(k,543) + lu(k,559) = lu(k,559) - lu(k,249) * lu(k,543) + lu(k,561) = lu(k,561) - lu(k,250) * lu(k,543) + lu(k,563) = lu(k,563) - lu(k,251) * lu(k,543) + lu(k,565) = lu(k,565) - lu(k,252) * lu(k,543) + lu(k,643) = lu(k,643) - lu(k,246) * lu(k,629) + lu(k,650) = lu(k,650) - lu(k,247) * lu(k,629) + lu(k,653) = lu(k,653) - lu(k,248) * lu(k,629) + lu(k,654) = lu(k,654) - lu(k,249) * lu(k,629) + lu(k,656) = lu(k,656) - lu(k,250) * lu(k,629) + lu(k,658) = lu(k,658) - lu(k,251) * lu(k,629) + lu(k,660) = lu(k,660) - lu(k,252) * lu(k,629) + lu(k,735) = - lu(k,246) * lu(k,731) + lu(k,741) = lu(k,741) - lu(k,247) * lu(k,731) + lu(k,744) = lu(k,744) - lu(k,248) * lu(k,731) + lu(k,745) = lu(k,745) - lu(k,249) * lu(k,731) + lu(k,747) = lu(k,747) - lu(k,250) * lu(k,731) + lu(k,749) = lu(k,749) - lu(k,251) * lu(k,731) + lu(k,751) = - lu(k,252) * lu(k,731) + lu(k,786) = - lu(k,246) * lu(k,778) + lu(k,792) = lu(k,792) - lu(k,247) * lu(k,778) + lu(k,795) = lu(k,795) - lu(k,248) * lu(k,778) + lu(k,796) = lu(k,796) - lu(k,249) * lu(k,778) + lu(k,798) = lu(k,798) - lu(k,250) * lu(k,778) + lu(k,800) = - lu(k,251) * lu(k,778) + lu(k,802) = lu(k,802) - lu(k,252) * lu(k,778) + lu(k,253) = 1._r8 / lu(k,253) + lu(k,254) = lu(k,254) * lu(k,253) + lu(k,255) = lu(k,255) * lu(k,253) + lu(k,256) = lu(k,256) * lu(k,253) + lu(k,257) = lu(k,257) * lu(k,253) + lu(k,258) = lu(k,258) * lu(k,253) + lu(k,259) = lu(k,259) * lu(k,253) + lu(k,260) = lu(k,260) * lu(k,253) + lu(k,470) = lu(k,470) - lu(k,254) * lu(k,466) + lu(k,478) = lu(k,478) - lu(k,255) * lu(k,466) + lu(k,480) = - lu(k,256) * lu(k,466) + lu(k,481) = - lu(k,257) * lu(k,466) + lu(k,482) = lu(k,482) - lu(k,258) * lu(k,466) + lu(k,484) = lu(k,484) - lu(k,259) * lu(k,466) + lu(k,488) = lu(k,488) - lu(k,260) * lu(k,466) + lu(k,547) = lu(k,547) - lu(k,254) * lu(k,544) + lu(k,555) = lu(k,555) - lu(k,255) * lu(k,544) + lu(k,557) = - lu(k,256) * lu(k,544) + lu(k,558) = lu(k,558) - lu(k,257) * lu(k,544) + lu(k,559) = lu(k,559) - lu(k,258) * lu(k,544) + lu(k,561) = lu(k,561) - lu(k,259) * lu(k,544) + lu(k,565) = lu(k,565) - lu(k,260) * lu(k,544) + lu(k,642) = lu(k,642) - lu(k,254) * lu(k,630) + lu(k,650) = lu(k,650) - lu(k,255) * lu(k,630) + lu(k,652) = - lu(k,256) * lu(k,630) + lu(k,653) = lu(k,653) - lu(k,257) * lu(k,630) + lu(k,654) = lu(k,654) - lu(k,258) * lu(k,630) + lu(k,656) = lu(k,656) - lu(k,259) * lu(k,630) + lu(k,660) = lu(k,660) - lu(k,260) * lu(k,630) + lu(k,709) = lu(k,709) - lu(k,254) * lu(k,705) + lu(k,717) = lu(k,717) - lu(k,255) * lu(k,705) + lu(k,719) = lu(k,719) - lu(k,256) * lu(k,705) + lu(k,720) = lu(k,720) - lu(k,257) * lu(k,705) + lu(k,721) = lu(k,721) - lu(k,258) * lu(k,705) + lu(k,723) = lu(k,723) - lu(k,259) * lu(k,705) + lu(k,727) = lu(k,727) - lu(k,260) * lu(k,705) + lu(k,756) = - lu(k,254) * lu(k,752) + lu(k,763) = - lu(k,255) * lu(k,752) + lu(k,765) = - lu(k,256) * lu(k,752) + lu(k,766) = lu(k,766) - lu(k,257) * lu(k,752) + lu(k,767) = lu(k,767) - lu(k,258) * lu(k,752) + lu(k,769) = - lu(k,259) * lu(k,752) + lu(k,773) = - lu(k,260) * lu(k,752) + lu(k,833) = lu(k,833) - lu(k,254) * lu(k,821) + lu(k,841) = lu(k,841) - lu(k,255) * lu(k,821) + lu(k,843) = lu(k,843) - lu(k,256) * lu(k,821) + lu(k,844) = lu(k,844) - lu(k,257) * lu(k,821) + lu(k,845) = lu(k,845) - lu(k,258) * lu(k,821) + lu(k,847) = lu(k,847) - lu(k,259) * lu(k,821) + lu(k,851) = lu(k,851) - lu(k,260) * lu(k,821) lu(k,262) = 1._r8 / lu(k,262) lu(k,263) = lu(k,263) * lu(k,262) lu(k,264) = lu(k,264) * lu(k,262) @@ -1103,63 +897,153 @@ subroutine lu_fac06( avec_len, lu ) lu(k,266) = lu(k,266) * lu(k,262) lu(k,267) = lu(k,267) * lu(k,262) lu(k,268) = lu(k,268) * lu(k,262) - lu(k,269) = lu(k,269) * lu(k,262) - lu(k,270) = lu(k,270) * lu(k,262) - lu(k,271) = lu(k,271) * lu(k,262) - lu(k,326) = lu(k,326) - lu(k,263) * lu(k,325) - lu(k,329) = lu(k,329) - lu(k,264) * lu(k,325) - lu(k,331) = - lu(k,265) * lu(k,325) - lu(k,333) = lu(k,333) - lu(k,266) * lu(k,325) - lu(k,334) = lu(k,334) - lu(k,267) * lu(k,325) - lu(k,335) = lu(k,335) - lu(k,268) * lu(k,325) - lu(k,341) = lu(k,341) - lu(k,269) * lu(k,325) - lu(k,343) = - lu(k,270) * lu(k,325) - lu(k,344) = lu(k,344) - lu(k,271) * lu(k,325) - lu(k,414) = - lu(k,263) * lu(k,413) - lu(k,417) = lu(k,417) - lu(k,264) * lu(k,413) - lu(k,419) = lu(k,419) - lu(k,265) * lu(k,413) - lu(k,421) = lu(k,421) - lu(k,266) * lu(k,413) - lu(k,422) = lu(k,422) - lu(k,267) * lu(k,413) - lu(k,423) = lu(k,423) - lu(k,268) * lu(k,413) - lu(k,429) = lu(k,429) - lu(k,269) * lu(k,413) - lu(k,431) = - lu(k,270) * lu(k,413) - lu(k,433) = lu(k,433) - lu(k,271) * lu(k,413) - lu(k,441) = - lu(k,263) * lu(k,440) - lu(k,445) = lu(k,445) - lu(k,264) * lu(k,440) - lu(k,447) = - lu(k,265) * lu(k,440) - lu(k,449) = lu(k,449) - lu(k,266) * lu(k,440) - lu(k,450) = lu(k,450) - lu(k,267) * lu(k,440) - lu(k,451) = lu(k,451) - lu(k,268) * lu(k,440) - lu(k,457) = lu(k,457) - lu(k,269) * lu(k,440) - lu(k,459) = lu(k,459) - lu(k,270) * lu(k,440) - lu(k,461) = lu(k,461) - lu(k,271) * lu(k,440) - lu(k,484) = lu(k,484) - lu(k,263) * lu(k,483) - lu(k,488) = lu(k,488) - lu(k,264) * lu(k,483) - lu(k,490) = lu(k,490) - lu(k,265) * lu(k,483) - lu(k,492) = lu(k,492) - lu(k,266) * lu(k,483) - lu(k,493) = lu(k,493) - lu(k,267) * lu(k,483) - lu(k,494) = lu(k,494) - lu(k,268) * lu(k,483) - lu(k,500) = lu(k,500) - lu(k,269) * lu(k,483) - lu(k,502) = lu(k,502) - lu(k,270) * lu(k,483) - lu(k,504) = lu(k,504) - lu(k,271) * lu(k,483) - lu(k,646) = lu(k,646) - lu(k,263) * lu(k,645) - lu(k,650) = lu(k,650) - lu(k,264) * lu(k,645) - lu(k,652) = lu(k,652) - lu(k,265) * lu(k,645) - lu(k,654) = lu(k,654) - lu(k,266) * lu(k,645) - lu(k,655) = lu(k,655) - lu(k,267) * lu(k,645) - lu(k,656) = lu(k,656) - lu(k,268) * lu(k,645) - lu(k,662) = lu(k,662) - lu(k,269) * lu(k,645) - lu(k,664) = lu(k,664) - lu(k,270) * lu(k,645) - lu(k,666) = lu(k,666) - lu(k,271) * lu(k,645) - lu(k,696) = lu(k,696) - lu(k,263) * lu(k,695) - lu(k,700) = lu(k,700) - lu(k,264) * lu(k,695) - lu(k,702) = lu(k,702) - lu(k,265) * lu(k,695) - lu(k,704) = lu(k,704) - lu(k,266) * lu(k,695) - lu(k,705) = lu(k,705) - lu(k,267) * lu(k,695) - lu(k,706) = lu(k,706) - lu(k,268) * lu(k,695) - lu(k,712) = lu(k,712) - lu(k,269) * lu(k,695) - lu(k,714) = lu(k,714) - lu(k,270) * lu(k,695) - lu(k,716) = lu(k,716) - lu(k,271) * lu(k,695) + lu(k,306) = lu(k,306) - lu(k,263) * lu(k,304) + lu(k,307) = lu(k,307) - lu(k,264) * lu(k,304) + lu(k,309) = lu(k,309) - lu(k,265) * lu(k,304) + lu(k,311) = lu(k,311) - lu(k,266) * lu(k,304) + lu(k,313) = lu(k,313) - lu(k,267) * lu(k,304) + lu(k,314) = - lu(k,268) * lu(k,304) + lu(k,450) = lu(k,450) - lu(k,263) * lu(k,447) + lu(k,454) = lu(k,454) - lu(k,264) * lu(k,447) + lu(k,456) = lu(k,456) - lu(k,265) * lu(k,447) + lu(k,461) = lu(k,461) - lu(k,266) * lu(k,447) + lu(k,463) = lu(k,463) - lu(k,267) * lu(k,447) + lu(k,465) = lu(k,465) - lu(k,268) * lu(k,447) + lu(k,548) = lu(k,548) - lu(k,263) * lu(k,545) + lu(k,553) = lu(k,553) - lu(k,264) * lu(k,545) + lu(k,555) = lu(k,555) - lu(k,265) * lu(k,545) + lu(k,561) = lu(k,561) - lu(k,266) * lu(k,545) + lu(k,563) = lu(k,563) - lu(k,267) * lu(k,545) + lu(k,565) = lu(k,565) - lu(k,268) * lu(k,545) + lu(k,576) = lu(k,576) - lu(k,263) * lu(k,570) + lu(k,581) = lu(k,581) - lu(k,264) * lu(k,570) + lu(k,583) = lu(k,583) - lu(k,265) * lu(k,570) + lu(k,589) = lu(k,589) - lu(k,266) * lu(k,570) + lu(k,591) = lu(k,591) - lu(k,267) * lu(k,570) + lu(k,593) = - lu(k,268) * lu(k,570) + lu(k,643) = lu(k,643) - lu(k,263) * lu(k,631) + lu(k,648) = lu(k,648) - lu(k,264) * lu(k,631) + lu(k,650) = lu(k,650) - lu(k,265) * lu(k,631) + lu(k,656) = lu(k,656) - lu(k,266) * lu(k,631) + lu(k,658) = lu(k,658) - lu(k,267) * lu(k,631) + lu(k,660) = lu(k,660) - lu(k,268) * lu(k,631) + lu(k,834) = lu(k,834) - lu(k,263) * lu(k,822) + lu(k,839) = lu(k,839) - lu(k,264) * lu(k,822) + lu(k,841) = lu(k,841) - lu(k,265) * lu(k,822) + lu(k,847) = lu(k,847) - lu(k,266) * lu(k,822) + lu(k,849) = lu(k,849) - lu(k,267) * lu(k,822) + lu(k,851) = lu(k,851) - lu(k,268) * lu(k,822) + lu(k,889) = lu(k,889) - lu(k,263) * lu(k,881) + lu(k,894) = lu(k,894) - lu(k,264) * lu(k,881) + lu(k,896) = lu(k,896) - lu(k,265) * lu(k,881) + lu(k,902) = lu(k,902) - lu(k,266) * lu(k,881) + lu(k,904) = lu(k,904) - lu(k,267) * lu(k,881) + lu(k,906) = lu(k,906) - lu(k,268) * lu(k,881) + lu(k,270) = 1._r8 / lu(k,270) + lu(k,271) = lu(k,271) * lu(k,270) + lu(k,272) = lu(k,272) * lu(k,270) + lu(k,273) = lu(k,273) * lu(k,270) + lu(k,274) = lu(k,274) * lu(k,270) + lu(k,275) = lu(k,275) * lu(k,270) + lu(k,276) = lu(k,276) * lu(k,270) + lu(k,277) = lu(k,277) * lu(k,270) + lu(k,320) = lu(k,320) - lu(k,271) * lu(k,319) + lu(k,321) = lu(k,321) - lu(k,272) * lu(k,319) + lu(k,322) = lu(k,322) - lu(k,273) * lu(k,319) + lu(k,323) = lu(k,323) - lu(k,274) * lu(k,319) + lu(k,324) = lu(k,324) - lu(k,275) * lu(k,319) + lu(k,325) = lu(k,325) - lu(k,276) * lu(k,319) + lu(k,326) = lu(k,326) - lu(k,277) * lu(k,319) + lu(k,330) = - lu(k,271) * lu(k,329) + lu(k,331) = lu(k,331) - lu(k,272) * lu(k,329) + lu(k,332) = lu(k,332) - lu(k,273) * lu(k,329) + lu(k,333) = - lu(k,274) * lu(k,329) + lu(k,334) = lu(k,334) - lu(k,275) * lu(k,329) + lu(k,335) = lu(k,335) - lu(k,276) * lu(k,329) + lu(k,336) = lu(k,336) - lu(k,277) * lu(k,329) + lu(k,342) = lu(k,342) - lu(k,271) * lu(k,341) + lu(k,343) = lu(k,343) - lu(k,272) * lu(k,341) + lu(k,344) = lu(k,344) - lu(k,273) * lu(k,341) + lu(k,345) = lu(k,345) - lu(k,274) * lu(k,341) + lu(k,346) = - lu(k,275) * lu(k,341) + lu(k,348) = lu(k,348) - lu(k,276) * lu(k,341) + lu(k,349) = lu(k,349) - lu(k,277) * lu(k,341) + lu(k,371) = lu(k,371) - lu(k,271) * lu(k,369) + lu(k,372) = lu(k,372) - lu(k,272) * lu(k,369) + lu(k,373) = lu(k,373) - lu(k,273) * lu(k,369) + lu(k,374) = lu(k,374) - lu(k,274) * lu(k,369) + lu(k,375) = lu(k,375) - lu(k,275) * lu(k,369) + lu(k,377) = lu(k,377) - lu(k,276) * lu(k,369) + lu(k,379) = lu(k,379) - lu(k,277) * lu(k,369) + lu(k,498) = lu(k,498) - lu(k,271) * lu(k,496) + lu(k,499) = lu(k,499) - lu(k,272) * lu(k,496) + lu(k,500) = lu(k,500) - lu(k,273) * lu(k,496) + lu(k,501) = lu(k,501) - lu(k,274) * lu(k,496) + lu(k,502) = lu(k,502) - lu(k,275) * lu(k,496) + lu(k,505) = lu(k,505) - lu(k,276) * lu(k,496) + lu(k,509) = lu(k,509) - lu(k,277) * lu(k,496) + lu(k,636) = lu(k,636) - lu(k,271) * lu(k,632) + lu(k,637) = lu(k,637) - lu(k,272) * lu(k,632) + lu(k,638) = lu(k,638) - lu(k,273) * lu(k,632) + lu(k,639) = lu(k,639) - lu(k,274) * lu(k,632) + lu(k,640) = lu(k,640) - lu(k,275) * lu(k,632) + lu(k,645) = lu(k,645) - lu(k,276) * lu(k,632) + lu(k,650) = lu(k,650) - lu(k,277) * lu(k,632) + lu(k,279) = 1._r8 / lu(k,279) + lu(k,280) = lu(k,280) * lu(k,279) + lu(k,281) = lu(k,281) * lu(k,279) + lu(k,282) = lu(k,282) * lu(k,279) + lu(k,283) = lu(k,283) * lu(k,279) + lu(k,284) = lu(k,284) * lu(k,279) + lu(k,285) = lu(k,285) * lu(k,279) + lu(k,374) = lu(k,374) - lu(k,280) * lu(k,370) + lu(k,375) = lu(k,375) - lu(k,281) * lu(k,370) + lu(k,377) = lu(k,377) - lu(k,282) * lu(k,370) + lu(k,378) = - lu(k,283) * lu(k,370) + lu(k,379) = lu(k,379) - lu(k,284) * lu(k,370) + lu(k,383) = - lu(k,285) * lu(k,370) + lu(k,388) = lu(k,388) - lu(k,280) * lu(k,386) + lu(k,389) = lu(k,389) - lu(k,281) * lu(k,386) + lu(k,395) = lu(k,395) - lu(k,282) * lu(k,386) + lu(k,396) = lu(k,396) - lu(k,283) * lu(k,386) + lu(k,398) = lu(k,398) - lu(k,284) * lu(k,386) + lu(k,402) = lu(k,402) - lu(k,285) * lu(k,386) + lu(k,468) = - lu(k,280) * lu(k,467) + lu(k,469) = - lu(k,281) * lu(k,467) + lu(k,473) = - lu(k,282) * lu(k,467) + lu(k,475) = lu(k,475) - lu(k,283) * lu(k,467) + lu(k,478) = lu(k,478) - lu(k,284) * lu(k,467) + lu(k,484) = lu(k,484) - lu(k,285) * lu(k,467) + lu(k,598) = - lu(k,280) * lu(k,596) + lu(k,599) = - lu(k,281) * lu(k,596) + lu(k,603) = lu(k,603) - lu(k,282) * lu(k,596) + lu(k,605) = lu(k,605) - lu(k,283) * lu(k,596) + lu(k,608) = lu(k,608) - lu(k,284) * lu(k,596) + lu(k,614) = lu(k,614) - lu(k,285) * lu(k,596) + lu(k,639) = lu(k,639) - lu(k,280) * lu(k,633) + lu(k,640) = lu(k,640) - lu(k,281) * lu(k,633) + lu(k,645) = lu(k,645) - lu(k,282) * lu(k,633) + lu(k,647) = lu(k,647) - lu(k,283) * lu(k,633) + lu(k,650) = lu(k,650) - lu(k,284) * lu(k,633) + lu(k,656) = lu(k,656) - lu(k,285) * lu(k,633) + lu(k,754) = - lu(k,280) * lu(k,753) + lu(k,755) = - lu(k,281) * lu(k,753) + lu(k,758) = lu(k,758) - lu(k,282) * lu(k,753) + lu(k,760) = lu(k,760) - lu(k,283) * lu(k,753) + lu(k,763) = lu(k,763) - lu(k,284) * lu(k,753) + lu(k,769) = lu(k,769) - lu(k,285) * lu(k,753) + lu(k,828) = lu(k,828) - lu(k,280) * lu(k,823) + lu(k,829) = lu(k,829) - lu(k,281) * lu(k,823) + lu(k,836) = lu(k,836) - lu(k,282) * lu(k,823) + lu(k,838) = lu(k,838) - lu(k,283) * lu(k,823) + lu(k,841) = lu(k,841) - lu(k,284) * lu(k,823) + lu(k,847) = lu(k,847) - lu(k,285) * lu(k,823) + lu(k,884) = - lu(k,280) * lu(k,882) + lu(k,885) = - lu(k,281) * lu(k,882) + lu(k,891) = lu(k,891) - lu(k,282) * lu(k,882) + lu(k,893) = lu(k,893) - lu(k,283) * lu(k,882) + lu(k,896) = lu(k,896) - lu(k,284) * lu(k,882) + lu(k,902) = lu(k,902) - lu(k,285) * lu(k,882) end do end subroutine lu_fac06 subroutine lu_fac07( avec_len, lu ) @@ -1176,229 +1060,183 @@ subroutine lu_fac07( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,274) = 1._r8 / lu(k,274) - lu(k,275) = lu(k,275) * lu(k,274) - lu(k,276) = lu(k,276) * lu(k,274) - lu(k,277) = lu(k,277) * lu(k,274) - lu(k,278) = lu(k,278) * lu(k,274) - lu(k,279) = lu(k,279) * lu(k,274) - lu(k,280) = lu(k,280) * lu(k,274) - lu(k,281) = lu(k,281) * lu(k,274) - lu(k,327) = lu(k,327) - lu(k,275) * lu(k,326) - lu(k,330) = - lu(k,276) * lu(k,326) - lu(k,331) = lu(k,331) - lu(k,277) * lu(k,326) - lu(k,338) = - lu(k,278) * lu(k,326) - lu(k,341) = lu(k,341) - lu(k,279) * lu(k,326) - lu(k,343) = lu(k,343) - lu(k,280) * lu(k,326) - lu(k,344) = lu(k,344) - lu(k,281) * lu(k,326) - lu(k,366) = lu(k,366) - lu(k,275) * lu(k,364) - lu(k,368) = - lu(k,276) * lu(k,364) - lu(k,369) = lu(k,369) - lu(k,277) * lu(k,364) - lu(k,376) = - lu(k,278) * lu(k,364) - lu(k,379) = lu(k,379) - lu(k,279) * lu(k,364) - lu(k,381) = lu(k,381) - lu(k,280) * lu(k,364) - lu(k,383) = lu(k,383) - lu(k,281) * lu(k,364) - lu(k,415) = lu(k,415) - lu(k,275) * lu(k,414) - lu(k,418) = lu(k,418) - lu(k,276) * lu(k,414) - lu(k,419) = lu(k,419) - lu(k,277) * lu(k,414) - lu(k,426) = lu(k,426) - lu(k,278) * lu(k,414) - lu(k,429) = lu(k,429) - lu(k,279) * lu(k,414) - lu(k,431) = lu(k,431) - lu(k,280) * lu(k,414) - lu(k,433) = lu(k,433) - lu(k,281) * lu(k,414) - lu(k,443) = - lu(k,275) * lu(k,441) - lu(k,446) = lu(k,446) - lu(k,276) * lu(k,441) - lu(k,447) = lu(k,447) - lu(k,277) * lu(k,441) - lu(k,454) = - lu(k,278) * lu(k,441) - lu(k,457) = lu(k,457) - lu(k,279) * lu(k,441) - lu(k,459) = lu(k,459) - lu(k,280) * lu(k,441) - lu(k,461) = lu(k,461) - lu(k,281) * lu(k,441) - lu(k,486) = lu(k,486) - lu(k,275) * lu(k,484) - lu(k,489) = - lu(k,276) * lu(k,484) - lu(k,490) = lu(k,490) - lu(k,277) * lu(k,484) - lu(k,497) = lu(k,497) - lu(k,278) * lu(k,484) - lu(k,500) = lu(k,500) - lu(k,279) * lu(k,484) - lu(k,502) = lu(k,502) - lu(k,280) * lu(k,484) - lu(k,504) = lu(k,504) - lu(k,281) * lu(k,484) - lu(k,508) = lu(k,508) - lu(k,275) * lu(k,507) - lu(k,511) = - lu(k,276) * lu(k,507) - lu(k,512) = lu(k,512) - lu(k,277) * lu(k,507) - lu(k,519) = lu(k,519) - lu(k,278) * lu(k,507) - lu(k,522) = lu(k,522) - lu(k,279) * lu(k,507) - lu(k,524) = - lu(k,280) * lu(k,507) - lu(k,526) = lu(k,526) - lu(k,281) * lu(k,507) - lu(k,533) = lu(k,533) - lu(k,275) * lu(k,532) - lu(k,536) = lu(k,536) - lu(k,276) * lu(k,532) - lu(k,537) = lu(k,537) - lu(k,277) * lu(k,532) - lu(k,544) = lu(k,544) - lu(k,278) * lu(k,532) - lu(k,547) = lu(k,547) - lu(k,279) * lu(k,532) - lu(k,549) = - lu(k,280) * lu(k,532) - lu(k,551) = lu(k,551) - lu(k,281) * lu(k,532) - lu(k,555) = lu(k,555) - lu(k,275) * lu(k,554) - lu(k,557) = lu(k,557) - lu(k,276) * lu(k,554) - lu(k,558) = lu(k,558) - lu(k,277) * lu(k,554) - lu(k,565) = lu(k,565) - lu(k,278) * lu(k,554) - lu(k,568) = lu(k,568) - lu(k,279) * lu(k,554) - lu(k,570) = - lu(k,280) * lu(k,554) - lu(k,572) = lu(k,572) - lu(k,281) * lu(k,554) - lu(k,580) = - lu(k,275) * lu(k,578) - lu(k,583) = - lu(k,276) * lu(k,578) - lu(k,584) = lu(k,584) - lu(k,277) * lu(k,578) - lu(k,591) = - lu(k,278) * lu(k,578) - lu(k,594) = lu(k,594) - lu(k,279) * lu(k,578) - lu(k,596) = lu(k,596) - lu(k,280) * lu(k,578) - lu(k,598) = lu(k,598) - lu(k,281) * lu(k,578) - lu(k,648) = lu(k,648) - lu(k,275) * lu(k,646) - lu(k,651) = lu(k,651) - lu(k,276) * lu(k,646) - lu(k,652) = lu(k,652) - lu(k,277) * lu(k,646) - lu(k,659) = lu(k,659) - lu(k,278) * lu(k,646) - lu(k,662) = lu(k,662) - lu(k,279) * lu(k,646) - lu(k,664) = lu(k,664) - lu(k,280) * lu(k,646) - lu(k,666) = lu(k,666) - lu(k,281) * lu(k,646) - lu(k,698) = lu(k,698) - lu(k,275) * lu(k,696) - lu(k,701) = - lu(k,276) * lu(k,696) - lu(k,702) = lu(k,702) - lu(k,277) * lu(k,696) - lu(k,709) = - lu(k,278) * lu(k,696) - lu(k,712) = lu(k,712) - lu(k,279) * lu(k,696) - lu(k,714) = lu(k,714) - lu(k,280) * lu(k,696) - lu(k,716) = lu(k,716) - lu(k,281) * lu(k,696) - lu(k,747) = lu(k,747) - lu(k,275) * lu(k,745) - lu(k,749) = lu(k,749) - lu(k,276) * lu(k,745) - lu(k,750) = lu(k,750) - lu(k,277) * lu(k,745) - lu(k,757) = lu(k,757) - lu(k,278) * lu(k,745) - lu(k,760) = lu(k,760) - lu(k,279) * lu(k,745) - lu(k,762) = - lu(k,280) * lu(k,745) - lu(k,764) = lu(k,764) - lu(k,281) * lu(k,745) - lu(k,285) = 1._r8 / lu(k,285) - lu(k,286) = lu(k,286) * lu(k,285) - lu(k,287) = lu(k,287) * lu(k,285) - lu(k,288) = lu(k,288) * lu(k,285) - lu(k,289) = lu(k,289) * lu(k,285) - lu(k,290) = lu(k,290) * lu(k,285) - lu(k,291) = lu(k,291) * lu(k,285) - lu(k,292) = lu(k,292) * lu(k,285) - lu(k,293) = lu(k,293) * lu(k,285) - lu(k,294) = lu(k,294) * lu(k,285) - lu(k,295) = lu(k,295) * lu(k,285) - lu(k,296) = lu(k,296) * lu(k,285) - lu(k,297) = lu(k,297) * lu(k,285) - lu(k,298) = lu(k,298) * lu(k,285) - lu(k,366) = lu(k,366) - lu(k,286) * lu(k,365) - lu(k,367) = - lu(k,287) * lu(k,365) - lu(k,370) = lu(k,370) - lu(k,288) * lu(k,365) - lu(k,371) = - lu(k,289) * lu(k,365) - lu(k,372) = - lu(k,290) * lu(k,365) - lu(k,373) = lu(k,373) - lu(k,291) * lu(k,365) - lu(k,377) = - lu(k,292) * lu(k,365) - lu(k,378) = lu(k,378) - lu(k,293) * lu(k,365) - lu(k,379) = lu(k,379) - lu(k,294) * lu(k,365) - lu(k,380) = - lu(k,295) * lu(k,365) - lu(k,381) = lu(k,381) - lu(k,296) * lu(k,365) - lu(k,382) = lu(k,382) - lu(k,297) * lu(k,365) - lu(k,383) = lu(k,383) - lu(k,298) * lu(k,365) - lu(k,443) = lu(k,443) - lu(k,286) * lu(k,442) - lu(k,444) = lu(k,444) - lu(k,287) * lu(k,442) - lu(k,448) = lu(k,448) - lu(k,288) * lu(k,442) - lu(k,449) = lu(k,449) - lu(k,289) * lu(k,442) - lu(k,450) = lu(k,450) - lu(k,290) * lu(k,442) - lu(k,451) = lu(k,451) - lu(k,291) * lu(k,442) - lu(k,455) = lu(k,455) - lu(k,292) * lu(k,442) - lu(k,456) = lu(k,456) - lu(k,293) * lu(k,442) - lu(k,457) = lu(k,457) - lu(k,294) * lu(k,442) - lu(k,458) = - lu(k,295) * lu(k,442) - lu(k,459) = lu(k,459) - lu(k,296) * lu(k,442) - lu(k,460) = lu(k,460) - lu(k,297) * lu(k,442) - lu(k,461) = lu(k,461) - lu(k,298) * lu(k,442) - lu(k,486) = lu(k,486) - lu(k,286) * lu(k,485) - lu(k,487) = lu(k,487) - lu(k,287) * lu(k,485) - lu(k,491) = lu(k,491) - lu(k,288) * lu(k,485) - lu(k,492) = lu(k,492) - lu(k,289) * lu(k,485) - lu(k,493) = lu(k,493) - lu(k,290) * lu(k,485) - lu(k,494) = lu(k,494) - lu(k,291) * lu(k,485) - lu(k,498) = lu(k,498) - lu(k,292) * lu(k,485) - lu(k,499) = lu(k,499) - lu(k,293) * lu(k,485) - lu(k,500) = lu(k,500) - lu(k,294) * lu(k,485) - lu(k,501) = lu(k,501) - lu(k,295) * lu(k,485) - lu(k,502) = lu(k,502) - lu(k,296) * lu(k,485) - lu(k,503) = lu(k,503) - lu(k,297) * lu(k,485) - lu(k,504) = lu(k,504) - lu(k,298) * lu(k,485) - lu(k,580) = lu(k,580) - lu(k,286) * lu(k,579) - lu(k,581) = lu(k,581) - lu(k,287) * lu(k,579) - lu(k,585) = lu(k,585) - lu(k,288) * lu(k,579) - lu(k,586) = lu(k,586) - lu(k,289) * lu(k,579) - lu(k,587) = lu(k,587) - lu(k,290) * lu(k,579) - lu(k,588) = lu(k,588) - lu(k,291) * lu(k,579) - lu(k,592) = lu(k,592) - lu(k,292) * lu(k,579) - lu(k,593) = lu(k,593) - lu(k,293) * lu(k,579) - lu(k,594) = lu(k,594) - lu(k,294) * lu(k,579) - lu(k,595) = - lu(k,295) * lu(k,579) - lu(k,596) = lu(k,596) - lu(k,296) * lu(k,579) - lu(k,597) = lu(k,597) - lu(k,297) * lu(k,579) - lu(k,598) = lu(k,598) - lu(k,298) * lu(k,579) - lu(k,614) = lu(k,614) - lu(k,286) * lu(k,613) - lu(k,615) = - lu(k,287) * lu(k,613) - lu(k,616) = lu(k,616) - lu(k,288) * lu(k,613) - lu(k,617) = - lu(k,289) * lu(k,613) - lu(k,618) = - lu(k,290) * lu(k,613) - lu(k,619) = lu(k,619) - lu(k,291) * lu(k,613) - lu(k,623) = - lu(k,292) * lu(k,613) - lu(k,624) = lu(k,624) - lu(k,293) * lu(k,613) - lu(k,625) = lu(k,625) - lu(k,294) * lu(k,613) - lu(k,626) = lu(k,626) - lu(k,295) * lu(k,613) - lu(k,627) = lu(k,627) - lu(k,296) * lu(k,613) - lu(k,628) = lu(k,628) - lu(k,297) * lu(k,613) - lu(k,629) = lu(k,629) - lu(k,298) * lu(k,613) - lu(k,648) = lu(k,648) - lu(k,286) * lu(k,647) - lu(k,649) = lu(k,649) - lu(k,287) * lu(k,647) - lu(k,653) = lu(k,653) - lu(k,288) * lu(k,647) - lu(k,654) = lu(k,654) - lu(k,289) * lu(k,647) - lu(k,655) = lu(k,655) - lu(k,290) * lu(k,647) - lu(k,656) = lu(k,656) - lu(k,291) * lu(k,647) - lu(k,660) = lu(k,660) - lu(k,292) * lu(k,647) - lu(k,661) = lu(k,661) - lu(k,293) * lu(k,647) - lu(k,662) = lu(k,662) - lu(k,294) * lu(k,647) - lu(k,663) = lu(k,663) - lu(k,295) * lu(k,647) - lu(k,664) = lu(k,664) - lu(k,296) * lu(k,647) - lu(k,665) = lu(k,665) - lu(k,297) * lu(k,647) - lu(k,666) = lu(k,666) - lu(k,298) * lu(k,647) - lu(k,672) = lu(k,672) - lu(k,286) * lu(k,671) - lu(k,673) = lu(k,673) - lu(k,287) * lu(k,671) - lu(k,675) = lu(k,675) - lu(k,288) * lu(k,671) - lu(k,676) = lu(k,676) - lu(k,289) * lu(k,671) - lu(k,677) = lu(k,677) - lu(k,290) * lu(k,671) - lu(k,678) = lu(k,678) - lu(k,291) * lu(k,671) - lu(k,682) = lu(k,682) - lu(k,292) * lu(k,671) - lu(k,683) = lu(k,683) - lu(k,293) * lu(k,671) - lu(k,684) = lu(k,684) - lu(k,294) * lu(k,671) - lu(k,685) = lu(k,685) - lu(k,295) * lu(k,671) - lu(k,686) = lu(k,686) - lu(k,296) * lu(k,671) - lu(k,687) = lu(k,687) - lu(k,297) * lu(k,671) - lu(k,688) = lu(k,688) - lu(k,298) * lu(k,671) - lu(k,698) = lu(k,698) - lu(k,286) * lu(k,697) - lu(k,699) = lu(k,699) - lu(k,287) * lu(k,697) - lu(k,703) = lu(k,703) - lu(k,288) * lu(k,697) - lu(k,704) = lu(k,704) - lu(k,289) * lu(k,697) - lu(k,705) = lu(k,705) - lu(k,290) * lu(k,697) - lu(k,706) = lu(k,706) - lu(k,291) * lu(k,697) - lu(k,710) = lu(k,710) - lu(k,292) * lu(k,697) - lu(k,711) = lu(k,711) - lu(k,293) * lu(k,697) - lu(k,712) = lu(k,712) - lu(k,294) * lu(k,697) - lu(k,713) = lu(k,713) - lu(k,295) * lu(k,697) - lu(k,714) = lu(k,714) - lu(k,296) * lu(k,697) - lu(k,715) = lu(k,715) - lu(k,297) * lu(k,697) - lu(k,716) = lu(k,716) - lu(k,298) * lu(k,697) - lu(k,747) = lu(k,747) - lu(k,286) * lu(k,746) - lu(k,748) = - lu(k,287) * lu(k,746) - lu(k,751) = lu(k,751) - lu(k,288) * lu(k,746) - lu(k,752) = - lu(k,289) * lu(k,746) - lu(k,753) = - lu(k,290) * lu(k,746) - lu(k,754) = lu(k,754) - lu(k,291) * lu(k,746) - lu(k,758) = - lu(k,292) * lu(k,746) - lu(k,759) = - lu(k,293) * lu(k,746) - lu(k,760) = lu(k,760) - lu(k,294) * lu(k,746) - lu(k,761) = - lu(k,295) * lu(k,746) - lu(k,762) = lu(k,762) - lu(k,296) * lu(k,746) - lu(k,763) = - lu(k,297) * lu(k,746) - lu(k,764) = lu(k,764) - lu(k,298) * lu(k,746) + lu(k,287) = 1._r8 / lu(k,287) + lu(k,288) = lu(k,288) * lu(k,287) + lu(k,289) = lu(k,289) * lu(k,287) + lu(k,290) = lu(k,290) * lu(k,287) + lu(k,291) = lu(k,291) * lu(k,287) + lu(k,292) = lu(k,292) * lu(k,287) + lu(k,293) = lu(k,293) * lu(k,287) + lu(k,294) = lu(k,294) * lu(k,287) + lu(k,295) = lu(k,295) * lu(k,287) + lu(k,390) = lu(k,390) - lu(k,288) * lu(k,387) + lu(k,391) = lu(k,391) - lu(k,289) * lu(k,387) + lu(k,392) = lu(k,392) - lu(k,290) * lu(k,387) + lu(k,397) = - lu(k,291) * lu(k,387) + lu(k,402) = lu(k,402) - lu(k,292) * lu(k,387) + lu(k,403) = - lu(k,293) * lu(k,387) + lu(k,405) = lu(k,405) - lu(k,294) * lu(k,387) + lu(k,406) = lu(k,406) - lu(k,295) * lu(k,387) + lu(k,707) = lu(k,707) - lu(k,288) * lu(k,706) + lu(k,708) = lu(k,708) - lu(k,289) * lu(k,706) + lu(k,709) = lu(k,709) - lu(k,290) * lu(k,706) + lu(k,716) = - lu(k,291) * lu(k,706) + lu(k,723) = lu(k,723) - lu(k,292) * lu(k,706) + lu(k,724) = - lu(k,293) * lu(k,706) + lu(k,726) = lu(k,726) - lu(k,294) * lu(k,706) + lu(k,727) = lu(k,727) - lu(k,295) * lu(k,706) + lu(k,830) = lu(k,830) - lu(k,288) * lu(k,824) + lu(k,831) = lu(k,831) - lu(k,289) * lu(k,824) + lu(k,833) = lu(k,833) - lu(k,290) * lu(k,824) + lu(k,840) = lu(k,840) - lu(k,291) * lu(k,824) + lu(k,847) = lu(k,847) - lu(k,292) * lu(k,824) + lu(k,848) = lu(k,848) - lu(k,293) * lu(k,824) + lu(k,850) = lu(k,850) - lu(k,294) * lu(k,824) + lu(k,851) = lu(k,851) - lu(k,295) * lu(k,824) + lu(k,854) = - lu(k,288) * lu(k,853) + lu(k,855) = - lu(k,289) * lu(k,853) + lu(k,856) = lu(k,856) - lu(k,290) * lu(k,853) + lu(k,863) = lu(k,863) - lu(k,291) * lu(k,853) + lu(k,870) = lu(k,870) - lu(k,292) * lu(k,853) + lu(k,871) = lu(k,871) - lu(k,293) * lu(k,853) + lu(k,873) = - lu(k,294) * lu(k,853) + lu(k,874) = lu(k,874) - lu(k,295) * lu(k,853) + lu(k,909) = - lu(k,288) * lu(k,908) + lu(k,910) = - lu(k,289) * lu(k,908) + lu(k,911) = lu(k,911) - lu(k,290) * lu(k,908) + lu(k,918) = - lu(k,291) * lu(k,908) + lu(k,925) = lu(k,925) - lu(k,292) * lu(k,908) + lu(k,926) = - lu(k,293) * lu(k,908) + lu(k,928) = lu(k,928) - lu(k,294) * lu(k,908) + lu(k,929) = lu(k,929) - lu(k,295) * lu(k,908) + lu(k,935) = - lu(k,288) * lu(k,933) + lu(k,936) = - lu(k,289) * lu(k,933) + lu(k,938) = lu(k,938) - lu(k,290) * lu(k,933) + lu(k,945) = - lu(k,291) * lu(k,933) + lu(k,952) = lu(k,952) - lu(k,292) * lu(k,933) + lu(k,953) = - lu(k,293) * lu(k,933) + lu(k,955) = lu(k,955) - lu(k,294) * lu(k,933) + lu(k,956) = lu(k,956) - lu(k,295) * lu(k,933) + lu(k,297) = 1._r8 / lu(k,297) + lu(k,298) = lu(k,298) * lu(k,297) + lu(k,299) = lu(k,299) * lu(k,297) + lu(k,300) = lu(k,300) * lu(k,297) + lu(k,301) = lu(k,301) * lu(k,297) + lu(k,302) = lu(k,302) * lu(k,297) + lu(k,422) = lu(k,422) - lu(k,298) * lu(k,421) + lu(k,426) = - lu(k,299) * lu(k,421) + lu(k,428) = lu(k,428) - lu(k,300) * lu(k,421) + lu(k,433) = lu(k,433) - lu(k,301) * lu(k,421) + lu(k,435) = - lu(k,302) * lu(k,421) + lu(k,503) = lu(k,503) - lu(k,298) * lu(k,497) + lu(k,507) = lu(k,507) - lu(k,299) * lu(k,497) + lu(k,509) = lu(k,509) - lu(k,300) * lu(k,497) + lu(k,515) = lu(k,515) - lu(k,301) * lu(k,497) + lu(k,518) = - lu(k,302) * lu(k,497) + lu(k,523) = lu(k,523) - lu(k,298) * lu(k,522) + lu(k,527) = lu(k,527) - lu(k,299) * lu(k,522) + lu(k,530) = lu(k,530) - lu(k,300) * lu(k,522) + lu(k,536) = lu(k,536) - lu(k,301) * lu(k,522) + lu(k,539) = - lu(k,302) * lu(k,522) + lu(k,574) = lu(k,574) - lu(k,298) * lu(k,571) + lu(k,580) = lu(k,580) - lu(k,299) * lu(k,571) + lu(k,583) = lu(k,583) - lu(k,300) * lu(k,571) + lu(k,589) = lu(k,589) - lu(k,301) * lu(k,571) + lu(k,593) = lu(k,593) - lu(k,302) * lu(k,571) + lu(k,600) = - lu(k,298) * lu(k,597) + lu(k,605) = lu(k,605) - lu(k,299) * lu(k,597) + lu(k,608) = lu(k,608) - lu(k,300) * lu(k,597) + lu(k,614) = lu(k,614) - lu(k,301) * lu(k,597) + lu(k,618) = - lu(k,302) * lu(k,597) + lu(k,641) = lu(k,641) - lu(k,298) * lu(k,634) + lu(k,647) = lu(k,647) - lu(k,299) * lu(k,634) + lu(k,650) = lu(k,650) - lu(k,300) * lu(k,634) + lu(k,656) = lu(k,656) - lu(k,301) * lu(k,634) + lu(k,660) = lu(k,660) - lu(k,302) * lu(k,634) + lu(k,733) = lu(k,733) - lu(k,298) * lu(k,732) + lu(k,738) = lu(k,738) - lu(k,299) * lu(k,732) + lu(k,741) = lu(k,741) - lu(k,300) * lu(k,732) + lu(k,747) = lu(k,747) - lu(k,301) * lu(k,732) + lu(k,751) = lu(k,751) - lu(k,302) * lu(k,732) + lu(k,784) = lu(k,784) - lu(k,298) * lu(k,779) + lu(k,789) = lu(k,789) - lu(k,299) * lu(k,779) + lu(k,792) = lu(k,792) - lu(k,300) * lu(k,779) + lu(k,798) = lu(k,798) - lu(k,301) * lu(k,779) + lu(k,802) = lu(k,802) - lu(k,302) * lu(k,779) + lu(k,832) = lu(k,832) - lu(k,298) * lu(k,825) + lu(k,838) = lu(k,838) - lu(k,299) * lu(k,825) + lu(k,841) = lu(k,841) - lu(k,300) * lu(k,825) + lu(k,847) = lu(k,847) - lu(k,301) * lu(k,825) + lu(k,851) = lu(k,851) - lu(k,302) * lu(k,825) + lu(k,937) = - lu(k,298) * lu(k,934) + lu(k,943) = - lu(k,299) * lu(k,934) + lu(k,946) = lu(k,946) - lu(k,300) * lu(k,934) + lu(k,952) = lu(k,952) - lu(k,301) * lu(k,934) + lu(k,956) = lu(k,956) - lu(k,302) * lu(k,934) + lu(k,305) = 1._r8 / lu(k,305) + lu(k,306) = lu(k,306) * lu(k,305) + lu(k,307) = lu(k,307) * lu(k,305) + lu(k,308) = lu(k,308) * lu(k,305) + lu(k,309) = lu(k,309) * lu(k,305) + lu(k,310) = lu(k,310) * lu(k,305) + lu(k,311) = lu(k,311) * lu(k,305) + lu(k,312) = lu(k,312) * lu(k,305) + lu(k,313) = lu(k,313) * lu(k,305) + lu(k,314) = lu(k,314) * lu(k,305) + lu(k,450) = lu(k,450) - lu(k,306) * lu(k,448) + lu(k,454) = lu(k,454) - lu(k,307) * lu(k,448) + lu(k,455) = - lu(k,308) * lu(k,448) + lu(k,456) = lu(k,456) - lu(k,309) * lu(k,448) + lu(k,460) = - lu(k,310) * lu(k,448) + lu(k,461) = lu(k,461) - lu(k,311) * lu(k,448) + lu(k,462) = lu(k,462) - lu(k,312) * lu(k,448) + lu(k,463) = lu(k,463) - lu(k,313) * lu(k,448) + lu(k,465) = lu(k,465) - lu(k,314) * lu(k,448) + lu(k,576) = lu(k,576) - lu(k,306) * lu(k,572) + lu(k,581) = lu(k,581) - lu(k,307) * lu(k,572) + lu(k,582) = - lu(k,308) * lu(k,572) + lu(k,583) = lu(k,583) - lu(k,309) * lu(k,572) + lu(k,588) = lu(k,588) - lu(k,310) * lu(k,572) + lu(k,589) = lu(k,589) - lu(k,311) * lu(k,572) + lu(k,590) = - lu(k,312) * lu(k,572) + lu(k,591) = lu(k,591) - lu(k,313) * lu(k,572) + lu(k,593) = lu(k,593) - lu(k,314) * lu(k,572) + lu(k,643) = lu(k,643) - lu(k,306) * lu(k,635) + lu(k,648) = lu(k,648) - lu(k,307) * lu(k,635) + lu(k,649) = lu(k,649) - lu(k,308) * lu(k,635) + lu(k,650) = lu(k,650) - lu(k,309) * lu(k,635) + lu(k,655) = lu(k,655) - lu(k,310) * lu(k,635) + lu(k,656) = lu(k,656) - lu(k,311) * lu(k,635) + lu(k,657) = lu(k,657) - lu(k,312) * lu(k,635) + lu(k,658) = lu(k,658) - lu(k,313) * lu(k,635) + lu(k,660) = lu(k,660) - lu(k,314) * lu(k,635) + lu(k,786) = lu(k,786) - lu(k,306) * lu(k,780) + lu(k,790) = lu(k,790) - lu(k,307) * lu(k,780) + lu(k,791) = lu(k,791) - lu(k,308) * lu(k,780) + lu(k,792) = lu(k,792) - lu(k,309) * lu(k,780) + lu(k,797) = lu(k,797) - lu(k,310) * lu(k,780) + lu(k,798) = lu(k,798) - lu(k,311) * lu(k,780) + lu(k,799) = lu(k,799) - lu(k,312) * lu(k,780) + lu(k,800) = lu(k,800) - lu(k,313) * lu(k,780) + lu(k,802) = lu(k,802) - lu(k,314) * lu(k,780) + lu(k,834) = lu(k,834) - lu(k,306) * lu(k,826) + lu(k,839) = lu(k,839) - lu(k,307) * lu(k,826) + lu(k,840) = lu(k,840) - lu(k,308) * lu(k,826) + lu(k,841) = lu(k,841) - lu(k,309) * lu(k,826) + lu(k,846) = lu(k,846) - lu(k,310) * lu(k,826) + lu(k,847) = lu(k,847) - lu(k,311) * lu(k,826) + lu(k,848) = lu(k,848) - lu(k,312) * lu(k,826) + lu(k,849) = lu(k,849) - lu(k,313) * lu(k,826) + lu(k,851) = lu(k,851) - lu(k,314) * lu(k,826) + lu(k,889) = lu(k,889) - lu(k,306) * lu(k,883) + lu(k,894) = lu(k,894) - lu(k,307) * lu(k,883) + lu(k,895) = lu(k,895) - lu(k,308) * lu(k,883) + lu(k,896) = lu(k,896) - lu(k,309) * lu(k,883) + lu(k,901) = - lu(k,310) * lu(k,883) + lu(k,902) = lu(k,902) - lu(k,311) * lu(k,883) + lu(k,903) = - lu(k,312) * lu(k,883) + lu(k,904) = lu(k,904) - lu(k,313) * lu(k,883) + lu(k,906) = lu(k,906) - lu(k,314) * lu(k,883) end do end subroutine lu_fac07 subroutine lu_fac08( avec_len, lu ) @@ -1415,467 +1253,291 @@ subroutine lu_fac08( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,299) = 1._r8 / lu(k,299) - lu(k,300) = lu(k,300) * lu(k,299) - lu(k,301) = lu(k,301) * lu(k,299) - lu(k,302) = lu(k,302) * lu(k,299) - lu(k,303) = lu(k,303) * lu(k,299) - lu(k,304) = lu(k,304) * lu(k,299) - lu(k,305) = lu(k,305) * lu(k,299) - lu(k,306) = lu(k,306) * lu(k,299) - lu(k,311) = lu(k,311) - lu(k,300) * lu(k,309) - lu(k,312) = lu(k,312) - lu(k,301) * lu(k,309) - lu(k,315) = - lu(k,302) * lu(k,309) - lu(k,317) = lu(k,317) - lu(k,303) * lu(k,309) - lu(k,318) = lu(k,318) - lu(k,304) * lu(k,309) - lu(k,319) = lu(k,319) - lu(k,305) * lu(k,309) - lu(k,320) = lu(k,320) - lu(k,306) * lu(k,309) - lu(k,332) = - lu(k,300) * lu(k,327) - lu(k,335) = lu(k,335) - lu(k,301) * lu(k,327) - lu(k,338) = lu(k,338) - lu(k,302) * lu(k,327) - lu(k,340) = - lu(k,303) * lu(k,327) - lu(k,341) = lu(k,341) - lu(k,304) * lu(k,327) - lu(k,342) = - lu(k,305) * lu(k,327) - lu(k,344) = lu(k,344) - lu(k,306) * lu(k,327) - lu(k,348) = lu(k,348) - lu(k,300) * lu(k,346) - lu(k,351) = - lu(k,301) * lu(k,346) - lu(k,353) = - lu(k,302) * lu(k,346) - lu(k,354) = lu(k,354) - lu(k,303) * lu(k,346) - lu(k,355) = lu(k,355) - lu(k,304) * lu(k,346) - lu(k,356) = - lu(k,305) * lu(k,346) - lu(k,359) = lu(k,359) - lu(k,306) * lu(k,346) - lu(k,370) = lu(k,370) - lu(k,300) * lu(k,366) - lu(k,373) = lu(k,373) - lu(k,301) * lu(k,366) - lu(k,376) = lu(k,376) - lu(k,302) * lu(k,366) - lu(k,378) = lu(k,378) - lu(k,303) * lu(k,366) - lu(k,379) = lu(k,379) - lu(k,304) * lu(k,366) - lu(k,380) = lu(k,380) - lu(k,305) * lu(k,366) - lu(k,383) = lu(k,383) - lu(k,306) * lu(k,366) - lu(k,395) = lu(k,395) - lu(k,300) * lu(k,390) - lu(k,398) = lu(k,398) - lu(k,301) * lu(k,390) - lu(k,401) = lu(k,401) - lu(k,302) * lu(k,390) - lu(k,403) = lu(k,403) - lu(k,303) * lu(k,390) - lu(k,404) = lu(k,404) - lu(k,304) * lu(k,390) - lu(k,405) = lu(k,405) - lu(k,305) * lu(k,390) - lu(k,408) = lu(k,408) - lu(k,306) * lu(k,390) - lu(k,420) = lu(k,420) - lu(k,300) * lu(k,415) - lu(k,423) = lu(k,423) - lu(k,301) * lu(k,415) - lu(k,426) = lu(k,426) - lu(k,302) * lu(k,415) - lu(k,428) = lu(k,428) - lu(k,303) * lu(k,415) - lu(k,429) = lu(k,429) - lu(k,304) * lu(k,415) - lu(k,430) = lu(k,430) - lu(k,305) * lu(k,415) - lu(k,433) = lu(k,433) - lu(k,306) * lu(k,415) - lu(k,448) = lu(k,448) - lu(k,300) * lu(k,443) - lu(k,451) = lu(k,451) - lu(k,301) * lu(k,443) - lu(k,454) = lu(k,454) - lu(k,302) * lu(k,443) - lu(k,456) = lu(k,456) - lu(k,303) * lu(k,443) - lu(k,457) = lu(k,457) - lu(k,304) * lu(k,443) - lu(k,458) = lu(k,458) - lu(k,305) * lu(k,443) - lu(k,461) = lu(k,461) - lu(k,306) * lu(k,443) - lu(k,491) = lu(k,491) - lu(k,300) * lu(k,486) - lu(k,494) = lu(k,494) - lu(k,301) * lu(k,486) - lu(k,497) = lu(k,497) - lu(k,302) * lu(k,486) - lu(k,499) = lu(k,499) - lu(k,303) * lu(k,486) - lu(k,500) = lu(k,500) - lu(k,304) * lu(k,486) - lu(k,501) = lu(k,501) - lu(k,305) * lu(k,486) - lu(k,504) = lu(k,504) - lu(k,306) * lu(k,486) - lu(k,513) = lu(k,513) - lu(k,300) * lu(k,508) - lu(k,516) = lu(k,516) - lu(k,301) * lu(k,508) - lu(k,519) = lu(k,519) - lu(k,302) * lu(k,508) - lu(k,521) = - lu(k,303) * lu(k,508) - lu(k,522) = lu(k,522) - lu(k,304) * lu(k,508) - lu(k,523) = - lu(k,305) * lu(k,508) - lu(k,526) = lu(k,526) - lu(k,306) * lu(k,508) - lu(k,538) = lu(k,538) - lu(k,300) * lu(k,533) - lu(k,541) = lu(k,541) - lu(k,301) * lu(k,533) - lu(k,544) = lu(k,544) - lu(k,302) * lu(k,533) - lu(k,546) = lu(k,546) - lu(k,303) * lu(k,533) - lu(k,547) = lu(k,547) - lu(k,304) * lu(k,533) - lu(k,548) = lu(k,548) - lu(k,305) * lu(k,533) - lu(k,551) = lu(k,551) - lu(k,306) * lu(k,533) - lu(k,559) = - lu(k,300) * lu(k,555) - lu(k,562) = lu(k,562) - lu(k,301) * lu(k,555) - lu(k,565) = lu(k,565) - lu(k,302) * lu(k,555) - lu(k,567) = - lu(k,303) * lu(k,555) - lu(k,568) = lu(k,568) - lu(k,304) * lu(k,555) - lu(k,569) = - lu(k,305) * lu(k,555) - lu(k,572) = lu(k,572) - lu(k,306) * lu(k,555) - lu(k,585) = lu(k,585) - lu(k,300) * lu(k,580) - lu(k,588) = lu(k,588) - lu(k,301) * lu(k,580) - lu(k,591) = lu(k,591) - lu(k,302) * lu(k,580) - lu(k,593) = lu(k,593) - lu(k,303) * lu(k,580) - lu(k,594) = lu(k,594) - lu(k,304) * lu(k,580) - lu(k,595) = lu(k,595) - lu(k,305) * lu(k,580) - lu(k,598) = lu(k,598) - lu(k,306) * lu(k,580) - lu(k,616) = lu(k,616) - lu(k,300) * lu(k,614) - lu(k,619) = lu(k,619) - lu(k,301) * lu(k,614) - lu(k,622) = - lu(k,302) * lu(k,614) - lu(k,624) = lu(k,624) - lu(k,303) * lu(k,614) - lu(k,625) = lu(k,625) - lu(k,304) * lu(k,614) - lu(k,626) = lu(k,626) - lu(k,305) * lu(k,614) - lu(k,629) = lu(k,629) - lu(k,306) * lu(k,614) - lu(k,653) = lu(k,653) - lu(k,300) * lu(k,648) - lu(k,656) = lu(k,656) - lu(k,301) * lu(k,648) - lu(k,659) = lu(k,659) - lu(k,302) * lu(k,648) - lu(k,661) = lu(k,661) - lu(k,303) * lu(k,648) - lu(k,662) = lu(k,662) - lu(k,304) * lu(k,648) - lu(k,663) = lu(k,663) - lu(k,305) * lu(k,648) - lu(k,666) = lu(k,666) - lu(k,306) * lu(k,648) - lu(k,675) = lu(k,675) - lu(k,300) * lu(k,672) - lu(k,678) = lu(k,678) - lu(k,301) * lu(k,672) - lu(k,681) = - lu(k,302) * lu(k,672) - lu(k,683) = lu(k,683) - lu(k,303) * lu(k,672) - lu(k,684) = lu(k,684) - lu(k,304) * lu(k,672) - lu(k,685) = lu(k,685) - lu(k,305) * lu(k,672) - lu(k,688) = lu(k,688) - lu(k,306) * lu(k,672) - lu(k,703) = lu(k,703) - lu(k,300) * lu(k,698) - lu(k,706) = lu(k,706) - lu(k,301) * lu(k,698) - lu(k,709) = lu(k,709) - lu(k,302) * lu(k,698) - lu(k,711) = lu(k,711) - lu(k,303) * lu(k,698) - lu(k,712) = lu(k,712) - lu(k,304) * lu(k,698) - lu(k,713) = lu(k,713) - lu(k,305) * lu(k,698) - lu(k,716) = lu(k,716) - lu(k,306) * lu(k,698) - lu(k,726) = lu(k,726) - lu(k,300) * lu(k,722) - lu(k,729) = lu(k,729) - lu(k,301) * lu(k,722) - lu(k,732) = - lu(k,302) * lu(k,722) - lu(k,734) = lu(k,734) - lu(k,303) * lu(k,722) - lu(k,735) = lu(k,735) - lu(k,304) * lu(k,722) - lu(k,736) = lu(k,736) - lu(k,305) * lu(k,722) - lu(k,739) = - lu(k,306) * lu(k,722) - lu(k,751) = lu(k,751) - lu(k,300) * lu(k,747) - lu(k,754) = lu(k,754) - lu(k,301) * lu(k,747) - lu(k,757) = lu(k,757) - lu(k,302) * lu(k,747) - lu(k,759) = lu(k,759) - lu(k,303) * lu(k,747) - lu(k,760) = lu(k,760) - lu(k,304) * lu(k,747) - lu(k,761) = lu(k,761) - lu(k,305) * lu(k,747) - lu(k,764) = lu(k,764) - lu(k,306) * lu(k,747) - lu(k,310) = 1._r8 / lu(k,310) - lu(k,311) = lu(k,311) * lu(k,310) - lu(k,312) = lu(k,312) * lu(k,310) - lu(k,313) = lu(k,313) * lu(k,310) - lu(k,314) = lu(k,314) * lu(k,310) - lu(k,315) = lu(k,315) * lu(k,310) - lu(k,316) = lu(k,316) * lu(k,310) - lu(k,317) = lu(k,317) * lu(k,310) - lu(k,318) = lu(k,318) * lu(k,310) - lu(k,319) = lu(k,319) * lu(k,310) - lu(k,320) = lu(k,320) * lu(k,310) - lu(k,332) = lu(k,332) - lu(k,311) * lu(k,328) - lu(k,335) = lu(k,335) - lu(k,312) * lu(k,328) - lu(k,336) = - lu(k,313) * lu(k,328) - lu(k,337) = lu(k,337) - lu(k,314) * lu(k,328) - lu(k,338) = lu(k,338) - lu(k,315) * lu(k,328) - lu(k,339) = lu(k,339) - lu(k,316) * lu(k,328) - lu(k,340) = lu(k,340) - lu(k,317) * lu(k,328) - lu(k,341) = lu(k,341) - lu(k,318) * lu(k,328) - lu(k,342) = lu(k,342) - lu(k,319) * lu(k,328) - lu(k,344) = lu(k,344) - lu(k,320) * lu(k,328) - lu(k,370) = lu(k,370) - lu(k,311) * lu(k,367) - lu(k,373) = lu(k,373) - lu(k,312) * lu(k,367) - lu(k,374) = lu(k,374) - lu(k,313) * lu(k,367) - lu(k,375) = - lu(k,314) * lu(k,367) - lu(k,376) = lu(k,376) - lu(k,315) * lu(k,367) - lu(k,377) = lu(k,377) - lu(k,316) * lu(k,367) - lu(k,378) = lu(k,378) - lu(k,317) * lu(k,367) - lu(k,379) = lu(k,379) - lu(k,318) * lu(k,367) - lu(k,380) = lu(k,380) - lu(k,319) * lu(k,367) - lu(k,383) = lu(k,383) - lu(k,320) * lu(k,367) - lu(k,395) = lu(k,395) - lu(k,311) * lu(k,391) - lu(k,398) = lu(k,398) - lu(k,312) * lu(k,391) - lu(k,399) = lu(k,399) - lu(k,313) * lu(k,391) - lu(k,400) = lu(k,400) - lu(k,314) * lu(k,391) - lu(k,401) = lu(k,401) - lu(k,315) * lu(k,391) - lu(k,402) = lu(k,402) - lu(k,316) * lu(k,391) - lu(k,403) = lu(k,403) - lu(k,317) * lu(k,391) - lu(k,404) = lu(k,404) - lu(k,318) * lu(k,391) - lu(k,405) = lu(k,405) - lu(k,319) * lu(k,391) - lu(k,408) = lu(k,408) - lu(k,320) * lu(k,391) - lu(k,420) = lu(k,420) - lu(k,311) * lu(k,416) - lu(k,423) = lu(k,423) - lu(k,312) * lu(k,416) - lu(k,424) = lu(k,424) - lu(k,313) * lu(k,416) - lu(k,425) = - lu(k,314) * lu(k,416) - lu(k,426) = lu(k,426) - lu(k,315) * lu(k,416) - lu(k,427) = - lu(k,316) * lu(k,416) - lu(k,428) = lu(k,428) - lu(k,317) * lu(k,416) - lu(k,429) = lu(k,429) - lu(k,318) * lu(k,416) - lu(k,430) = lu(k,430) - lu(k,319) * lu(k,416) - lu(k,433) = lu(k,433) - lu(k,320) * lu(k,416) - lu(k,448) = lu(k,448) - lu(k,311) * lu(k,444) - lu(k,451) = lu(k,451) - lu(k,312) * lu(k,444) - lu(k,452) = lu(k,452) - lu(k,313) * lu(k,444) - lu(k,453) = - lu(k,314) * lu(k,444) - lu(k,454) = lu(k,454) - lu(k,315) * lu(k,444) - lu(k,455) = lu(k,455) - lu(k,316) * lu(k,444) - lu(k,456) = lu(k,456) - lu(k,317) * lu(k,444) - lu(k,457) = lu(k,457) - lu(k,318) * lu(k,444) - lu(k,458) = lu(k,458) - lu(k,319) * lu(k,444) - lu(k,461) = lu(k,461) - lu(k,320) * lu(k,444) - lu(k,491) = lu(k,491) - lu(k,311) * lu(k,487) - lu(k,494) = lu(k,494) - lu(k,312) * lu(k,487) - lu(k,495) = lu(k,495) - lu(k,313) * lu(k,487) - lu(k,496) = lu(k,496) - lu(k,314) * lu(k,487) - lu(k,497) = lu(k,497) - lu(k,315) * lu(k,487) - lu(k,498) = lu(k,498) - lu(k,316) * lu(k,487) - lu(k,499) = lu(k,499) - lu(k,317) * lu(k,487) - lu(k,500) = lu(k,500) - lu(k,318) * lu(k,487) - lu(k,501) = lu(k,501) - lu(k,319) * lu(k,487) - lu(k,504) = lu(k,504) - lu(k,320) * lu(k,487) - lu(k,513) = lu(k,513) - lu(k,311) * lu(k,509) - lu(k,516) = lu(k,516) - lu(k,312) * lu(k,509) - lu(k,517) = lu(k,517) - lu(k,313) * lu(k,509) - lu(k,518) = lu(k,518) - lu(k,314) * lu(k,509) - lu(k,519) = lu(k,519) - lu(k,315) * lu(k,509) - lu(k,520) = lu(k,520) - lu(k,316) * lu(k,509) - lu(k,521) = lu(k,521) - lu(k,317) * lu(k,509) - lu(k,522) = lu(k,522) - lu(k,318) * lu(k,509) - lu(k,523) = lu(k,523) - lu(k,319) * lu(k,509) - lu(k,526) = lu(k,526) - lu(k,320) * lu(k,509) - lu(k,538) = lu(k,538) - lu(k,311) * lu(k,534) - lu(k,541) = lu(k,541) - lu(k,312) * lu(k,534) - lu(k,542) = lu(k,542) - lu(k,313) * lu(k,534) - lu(k,543) = lu(k,543) - lu(k,314) * lu(k,534) - lu(k,544) = lu(k,544) - lu(k,315) * lu(k,534) - lu(k,545) = lu(k,545) - lu(k,316) * lu(k,534) - lu(k,546) = lu(k,546) - lu(k,317) * lu(k,534) - lu(k,547) = lu(k,547) - lu(k,318) * lu(k,534) - lu(k,548) = lu(k,548) - lu(k,319) * lu(k,534) - lu(k,551) = lu(k,551) - lu(k,320) * lu(k,534) - lu(k,585) = lu(k,585) - lu(k,311) * lu(k,581) - lu(k,588) = lu(k,588) - lu(k,312) * lu(k,581) - lu(k,589) = - lu(k,313) * lu(k,581) - lu(k,590) = - lu(k,314) * lu(k,581) - lu(k,591) = lu(k,591) - lu(k,315) * lu(k,581) - lu(k,592) = lu(k,592) - lu(k,316) * lu(k,581) - lu(k,593) = lu(k,593) - lu(k,317) * lu(k,581) - lu(k,594) = lu(k,594) - lu(k,318) * lu(k,581) - lu(k,595) = lu(k,595) - lu(k,319) * lu(k,581) - lu(k,598) = lu(k,598) - lu(k,320) * lu(k,581) - lu(k,616) = lu(k,616) - lu(k,311) * lu(k,615) - lu(k,619) = lu(k,619) - lu(k,312) * lu(k,615) - lu(k,620) = - lu(k,313) * lu(k,615) - lu(k,621) = lu(k,621) - lu(k,314) * lu(k,615) - lu(k,622) = lu(k,622) - lu(k,315) * lu(k,615) - lu(k,623) = lu(k,623) - lu(k,316) * lu(k,615) - lu(k,624) = lu(k,624) - lu(k,317) * lu(k,615) - lu(k,625) = lu(k,625) - lu(k,318) * lu(k,615) - lu(k,626) = lu(k,626) - lu(k,319) * lu(k,615) - lu(k,629) = lu(k,629) - lu(k,320) * lu(k,615) - lu(k,653) = lu(k,653) - lu(k,311) * lu(k,649) - lu(k,656) = lu(k,656) - lu(k,312) * lu(k,649) - lu(k,657) = lu(k,657) - lu(k,313) * lu(k,649) - lu(k,658) = lu(k,658) - lu(k,314) * lu(k,649) - lu(k,659) = lu(k,659) - lu(k,315) * lu(k,649) - lu(k,660) = lu(k,660) - lu(k,316) * lu(k,649) - lu(k,661) = lu(k,661) - lu(k,317) * lu(k,649) - lu(k,662) = lu(k,662) - lu(k,318) * lu(k,649) - lu(k,663) = lu(k,663) - lu(k,319) * lu(k,649) - lu(k,666) = lu(k,666) - lu(k,320) * lu(k,649) - lu(k,675) = lu(k,675) - lu(k,311) * lu(k,673) - lu(k,678) = lu(k,678) - lu(k,312) * lu(k,673) - lu(k,679) = - lu(k,313) * lu(k,673) - lu(k,680) = lu(k,680) - lu(k,314) * lu(k,673) - lu(k,681) = lu(k,681) - lu(k,315) * lu(k,673) - lu(k,682) = lu(k,682) - lu(k,316) * lu(k,673) - lu(k,683) = lu(k,683) - lu(k,317) * lu(k,673) - lu(k,684) = lu(k,684) - lu(k,318) * lu(k,673) - lu(k,685) = lu(k,685) - lu(k,319) * lu(k,673) - lu(k,688) = lu(k,688) - lu(k,320) * lu(k,673) - lu(k,703) = lu(k,703) - lu(k,311) * lu(k,699) - lu(k,706) = lu(k,706) - lu(k,312) * lu(k,699) - lu(k,707) = - lu(k,313) * lu(k,699) - lu(k,708) = lu(k,708) - lu(k,314) * lu(k,699) - lu(k,709) = lu(k,709) - lu(k,315) * lu(k,699) - lu(k,710) = lu(k,710) - lu(k,316) * lu(k,699) - lu(k,711) = lu(k,711) - lu(k,317) * lu(k,699) - lu(k,712) = lu(k,712) - lu(k,318) * lu(k,699) - lu(k,713) = lu(k,713) - lu(k,319) * lu(k,699) - lu(k,716) = lu(k,716) - lu(k,320) * lu(k,699) - lu(k,726) = lu(k,726) - lu(k,311) * lu(k,723) - lu(k,729) = lu(k,729) - lu(k,312) * lu(k,723) - lu(k,730) = lu(k,730) - lu(k,313) * lu(k,723) - lu(k,731) = lu(k,731) - lu(k,314) * lu(k,723) - lu(k,732) = lu(k,732) - lu(k,315) * lu(k,723) - lu(k,733) = lu(k,733) - lu(k,316) * lu(k,723) - lu(k,734) = lu(k,734) - lu(k,317) * lu(k,723) - lu(k,735) = lu(k,735) - lu(k,318) * lu(k,723) - lu(k,736) = lu(k,736) - lu(k,319) * lu(k,723) - lu(k,739) = lu(k,739) - lu(k,320) * lu(k,723) - lu(k,751) = lu(k,751) - lu(k,311) * lu(k,748) - lu(k,754) = lu(k,754) - lu(k,312) * lu(k,748) - lu(k,755) = - lu(k,313) * lu(k,748) - lu(k,756) = lu(k,756) - lu(k,314) * lu(k,748) - lu(k,757) = lu(k,757) - lu(k,315) * lu(k,748) - lu(k,758) = lu(k,758) - lu(k,316) * lu(k,748) - lu(k,759) = lu(k,759) - lu(k,317) * lu(k,748) - lu(k,760) = lu(k,760) - lu(k,318) * lu(k,748) - lu(k,761) = lu(k,761) - lu(k,319) * lu(k,748) - lu(k,764) = lu(k,764) - lu(k,320) * lu(k,748) - lu(k,329) = 1._r8 / lu(k,329) - lu(k,330) = lu(k,330) * lu(k,329) - lu(k,331) = lu(k,331) * lu(k,329) - lu(k,332) = lu(k,332) * lu(k,329) - lu(k,333) = lu(k,333) * lu(k,329) - lu(k,334) = lu(k,334) * lu(k,329) - lu(k,335) = lu(k,335) * lu(k,329) - lu(k,336) = lu(k,336) * lu(k,329) - lu(k,337) = lu(k,337) * lu(k,329) - lu(k,338) = lu(k,338) * lu(k,329) - lu(k,339) = lu(k,339) * lu(k,329) - lu(k,340) = lu(k,340) * lu(k,329) - lu(k,341) = lu(k,341) * lu(k,329) - lu(k,342) = lu(k,342) * lu(k,329) - lu(k,343) = lu(k,343) * lu(k,329) - lu(k,344) = lu(k,344) * lu(k,329) - lu(k,393) = lu(k,393) - lu(k,330) * lu(k,392) - lu(k,394) = lu(k,394) - lu(k,331) * lu(k,392) - lu(k,395) = lu(k,395) - lu(k,332) * lu(k,392) - lu(k,396) = lu(k,396) - lu(k,333) * lu(k,392) - lu(k,397) = lu(k,397) - lu(k,334) * lu(k,392) - lu(k,398) = lu(k,398) - lu(k,335) * lu(k,392) - lu(k,399) = lu(k,399) - lu(k,336) * lu(k,392) - lu(k,400) = lu(k,400) - lu(k,337) * lu(k,392) - lu(k,401) = lu(k,401) - lu(k,338) * lu(k,392) - lu(k,402) = lu(k,402) - lu(k,339) * lu(k,392) - lu(k,403) = lu(k,403) - lu(k,340) * lu(k,392) - lu(k,404) = lu(k,404) - lu(k,341) * lu(k,392) - lu(k,405) = lu(k,405) - lu(k,342) * lu(k,392) - lu(k,406) = lu(k,406) - lu(k,343) * lu(k,392) - lu(k,408) = lu(k,408) - lu(k,344) * lu(k,392) - lu(k,418) = lu(k,418) - lu(k,330) * lu(k,417) - lu(k,419) = lu(k,419) - lu(k,331) * lu(k,417) - lu(k,420) = lu(k,420) - lu(k,332) * lu(k,417) - lu(k,421) = lu(k,421) - lu(k,333) * lu(k,417) - lu(k,422) = lu(k,422) - lu(k,334) * lu(k,417) - lu(k,423) = lu(k,423) - lu(k,335) * lu(k,417) - lu(k,424) = lu(k,424) - lu(k,336) * lu(k,417) - lu(k,425) = lu(k,425) - lu(k,337) * lu(k,417) - lu(k,426) = lu(k,426) - lu(k,338) * lu(k,417) - lu(k,427) = lu(k,427) - lu(k,339) * lu(k,417) - lu(k,428) = lu(k,428) - lu(k,340) * lu(k,417) - lu(k,429) = lu(k,429) - lu(k,341) * lu(k,417) - lu(k,430) = lu(k,430) - lu(k,342) * lu(k,417) - lu(k,431) = lu(k,431) - lu(k,343) * lu(k,417) - lu(k,433) = lu(k,433) - lu(k,344) * lu(k,417) - lu(k,446) = lu(k,446) - lu(k,330) * lu(k,445) - lu(k,447) = lu(k,447) - lu(k,331) * lu(k,445) - lu(k,448) = lu(k,448) - lu(k,332) * lu(k,445) - lu(k,449) = lu(k,449) - lu(k,333) * lu(k,445) - lu(k,450) = lu(k,450) - lu(k,334) * lu(k,445) - lu(k,451) = lu(k,451) - lu(k,335) * lu(k,445) - lu(k,452) = lu(k,452) - lu(k,336) * lu(k,445) - lu(k,453) = lu(k,453) - lu(k,337) * lu(k,445) - lu(k,454) = lu(k,454) - lu(k,338) * lu(k,445) - lu(k,455) = lu(k,455) - lu(k,339) * lu(k,445) - lu(k,456) = lu(k,456) - lu(k,340) * lu(k,445) - lu(k,457) = lu(k,457) - lu(k,341) * lu(k,445) - lu(k,458) = lu(k,458) - lu(k,342) * lu(k,445) - lu(k,459) = lu(k,459) - lu(k,343) * lu(k,445) - lu(k,461) = lu(k,461) - lu(k,344) * lu(k,445) - lu(k,489) = lu(k,489) - lu(k,330) * lu(k,488) - lu(k,490) = lu(k,490) - lu(k,331) * lu(k,488) - lu(k,491) = lu(k,491) - lu(k,332) * lu(k,488) - lu(k,492) = lu(k,492) - lu(k,333) * lu(k,488) - lu(k,493) = lu(k,493) - lu(k,334) * lu(k,488) - lu(k,494) = lu(k,494) - lu(k,335) * lu(k,488) - lu(k,495) = lu(k,495) - lu(k,336) * lu(k,488) - lu(k,496) = lu(k,496) - lu(k,337) * lu(k,488) - lu(k,497) = lu(k,497) - lu(k,338) * lu(k,488) - lu(k,498) = lu(k,498) - lu(k,339) * lu(k,488) - lu(k,499) = lu(k,499) - lu(k,340) * lu(k,488) - lu(k,500) = lu(k,500) - lu(k,341) * lu(k,488) - lu(k,501) = lu(k,501) - lu(k,342) * lu(k,488) - lu(k,502) = lu(k,502) - lu(k,343) * lu(k,488) - lu(k,504) = lu(k,504) - lu(k,344) * lu(k,488) - lu(k,511) = lu(k,511) - lu(k,330) * lu(k,510) - lu(k,512) = lu(k,512) - lu(k,331) * lu(k,510) - lu(k,513) = lu(k,513) - lu(k,332) * lu(k,510) - lu(k,514) = lu(k,514) - lu(k,333) * lu(k,510) - lu(k,515) = - lu(k,334) * lu(k,510) - lu(k,516) = lu(k,516) - lu(k,335) * lu(k,510) - lu(k,517) = lu(k,517) - lu(k,336) * lu(k,510) - lu(k,518) = lu(k,518) - lu(k,337) * lu(k,510) - lu(k,519) = lu(k,519) - lu(k,338) * lu(k,510) - lu(k,520) = lu(k,520) - lu(k,339) * lu(k,510) - lu(k,521) = lu(k,521) - lu(k,340) * lu(k,510) - lu(k,522) = lu(k,522) - lu(k,341) * lu(k,510) - lu(k,523) = lu(k,523) - lu(k,342) * lu(k,510) - lu(k,524) = lu(k,524) - lu(k,343) * lu(k,510) - lu(k,526) = lu(k,526) - lu(k,344) * lu(k,510) - lu(k,536) = lu(k,536) - lu(k,330) * lu(k,535) - lu(k,537) = lu(k,537) - lu(k,331) * lu(k,535) - lu(k,538) = lu(k,538) - lu(k,332) * lu(k,535) - lu(k,539) = lu(k,539) - lu(k,333) * lu(k,535) - lu(k,540) = lu(k,540) - lu(k,334) * lu(k,535) - lu(k,541) = lu(k,541) - lu(k,335) * lu(k,535) - lu(k,542) = lu(k,542) - lu(k,336) * lu(k,535) - lu(k,543) = lu(k,543) - lu(k,337) * lu(k,535) - lu(k,544) = lu(k,544) - lu(k,338) * lu(k,535) - lu(k,545) = lu(k,545) - lu(k,339) * lu(k,535) - lu(k,546) = lu(k,546) - lu(k,340) * lu(k,535) - lu(k,547) = lu(k,547) - lu(k,341) * lu(k,535) - lu(k,548) = lu(k,548) - lu(k,342) * lu(k,535) - lu(k,549) = lu(k,549) - lu(k,343) * lu(k,535) - lu(k,551) = lu(k,551) - lu(k,344) * lu(k,535) - lu(k,557) = lu(k,557) - lu(k,330) * lu(k,556) - lu(k,558) = lu(k,558) - lu(k,331) * lu(k,556) - lu(k,559) = lu(k,559) - lu(k,332) * lu(k,556) - lu(k,560) = lu(k,560) - lu(k,333) * lu(k,556) - lu(k,561) = - lu(k,334) * lu(k,556) - lu(k,562) = lu(k,562) - lu(k,335) * lu(k,556) - lu(k,563) = - lu(k,336) * lu(k,556) - lu(k,564) = lu(k,564) - lu(k,337) * lu(k,556) - lu(k,565) = lu(k,565) - lu(k,338) * lu(k,556) - lu(k,566) = - lu(k,339) * lu(k,556) - lu(k,567) = lu(k,567) - lu(k,340) * lu(k,556) - lu(k,568) = lu(k,568) - lu(k,341) * lu(k,556) - lu(k,569) = lu(k,569) - lu(k,342) * lu(k,556) - lu(k,570) = lu(k,570) - lu(k,343) * lu(k,556) - lu(k,572) = lu(k,572) - lu(k,344) * lu(k,556) - lu(k,583) = lu(k,583) - lu(k,330) * lu(k,582) - lu(k,584) = lu(k,584) - lu(k,331) * lu(k,582) - lu(k,585) = lu(k,585) - lu(k,332) * lu(k,582) - lu(k,586) = lu(k,586) - lu(k,333) * lu(k,582) - lu(k,587) = lu(k,587) - lu(k,334) * lu(k,582) - lu(k,588) = lu(k,588) - lu(k,335) * lu(k,582) - lu(k,589) = lu(k,589) - lu(k,336) * lu(k,582) - lu(k,590) = lu(k,590) - lu(k,337) * lu(k,582) - lu(k,591) = lu(k,591) - lu(k,338) * lu(k,582) - lu(k,592) = lu(k,592) - lu(k,339) * lu(k,582) - lu(k,593) = lu(k,593) - lu(k,340) * lu(k,582) - lu(k,594) = lu(k,594) - lu(k,341) * lu(k,582) - lu(k,595) = lu(k,595) - lu(k,342) * lu(k,582) - lu(k,596) = lu(k,596) - lu(k,343) * lu(k,582) - lu(k,598) = lu(k,598) - lu(k,344) * lu(k,582) - lu(k,651) = lu(k,651) - lu(k,330) * lu(k,650) - lu(k,652) = lu(k,652) - lu(k,331) * lu(k,650) - lu(k,653) = lu(k,653) - lu(k,332) * lu(k,650) - lu(k,654) = lu(k,654) - lu(k,333) * lu(k,650) - lu(k,655) = lu(k,655) - lu(k,334) * lu(k,650) - lu(k,656) = lu(k,656) - lu(k,335) * lu(k,650) - lu(k,657) = lu(k,657) - lu(k,336) * lu(k,650) - lu(k,658) = lu(k,658) - lu(k,337) * lu(k,650) - lu(k,659) = lu(k,659) - lu(k,338) * lu(k,650) - lu(k,660) = lu(k,660) - lu(k,339) * lu(k,650) - lu(k,661) = lu(k,661) - lu(k,340) * lu(k,650) - lu(k,662) = lu(k,662) - lu(k,341) * lu(k,650) - lu(k,663) = lu(k,663) - lu(k,342) * lu(k,650) - lu(k,664) = lu(k,664) - lu(k,343) * lu(k,650) - lu(k,666) = lu(k,666) - lu(k,344) * lu(k,650) - lu(k,701) = lu(k,701) - lu(k,330) * lu(k,700) - lu(k,702) = lu(k,702) - lu(k,331) * lu(k,700) - lu(k,703) = lu(k,703) - lu(k,332) * lu(k,700) - lu(k,704) = lu(k,704) - lu(k,333) * lu(k,700) - lu(k,705) = lu(k,705) - lu(k,334) * lu(k,700) - lu(k,706) = lu(k,706) - lu(k,335) * lu(k,700) - lu(k,707) = lu(k,707) - lu(k,336) * lu(k,700) - lu(k,708) = lu(k,708) - lu(k,337) * lu(k,700) - lu(k,709) = lu(k,709) - lu(k,338) * lu(k,700) - lu(k,710) = lu(k,710) - lu(k,339) * lu(k,700) - lu(k,711) = lu(k,711) - lu(k,340) * lu(k,700) - lu(k,712) = lu(k,712) - lu(k,341) * lu(k,700) - lu(k,713) = lu(k,713) - lu(k,342) * lu(k,700) - lu(k,714) = lu(k,714) - lu(k,343) * lu(k,700) - lu(k,716) = lu(k,716) - lu(k,344) * lu(k,700) + lu(k,320) = 1._r8 / lu(k,320) + lu(k,321) = lu(k,321) * lu(k,320) + lu(k,322) = lu(k,322) * lu(k,320) + lu(k,323) = lu(k,323) * lu(k,320) + lu(k,324) = lu(k,324) * lu(k,320) + lu(k,325) = lu(k,325) * lu(k,320) + lu(k,326) = lu(k,326) * lu(k,320) + lu(k,327) = lu(k,327) * lu(k,320) + lu(k,328) = lu(k,328) * lu(k,320) + lu(k,331) = lu(k,331) - lu(k,321) * lu(k,330) + lu(k,332) = lu(k,332) - lu(k,322) * lu(k,330) + lu(k,333) = lu(k,333) - lu(k,323) * lu(k,330) + lu(k,334) = lu(k,334) - lu(k,324) * lu(k,330) + lu(k,335) = lu(k,335) - lu(k,325) * lu(k,330) + lu(k,336) = lu(k,336) - lu(k,326) * lu(k,330) + lu(k,337) = lu(k,337) - lu(k,327) * lu(k,330) + lu(k,338) = lu(k,338) - lu(k,328) * lu(k,330) + lu(k,343) = lu(k,343) - lu(k,321) * lu(k,342) + lu(k,344) = lu(k,344) - lu(k,322) * lu(k,342) + lu(k,345) = lu(k,345) - lu(k,323) * lu(k,342) + lu(k,346) = lu(k,346) - lu(k,324) * lu(k,342) + lu(k,348) = lu(k,348) - lu(k,325) * lu(k,342) + lu(k,349) = lu(k,349) - lu(k,326) * lu(k,342) + lu(k,350) = lu(k,350) - lu(k,327) * lu(k,342) + lu(k,351) = lu(k,351) - lu(k,328) * lu(k,342) + lu(k,356) = lu(k,356) - lu(k,321) * lu(k,355) + lu(k,357) = lu(k,357) - lu(k,322) * lu(k,355) + lu(k,358) = lu(k,358) - lu(k,323) * lu(k,355) + lu(k,359) = - lu(k,324) * lu(k,355) + lu(k,361) = lu(k,361) - lu(k,325) * lu(k,355) + lu(k,362) = lu(k,362) - lu(k,326) * lu(k,355) + lu(k,363) = lu(k,363) - lu(k,327) * lu(k,355) + lu(k,364) = lu(k,364) - lu(k,328) * lu(k,355) + lu(k,372) = lu(k,372) - lu(k,321) * lu(k,371) + lu(k,373) = lu(k,373) - lu(k,322) * lu(k,371) + lu(k,374) = lu(k,374) - lu(k,323) * lu(k,371) + lu(k,375) = lu(k,375) - lu(k,324) * lu(k,371) + lu(k,377) = lu(k,377) - lu(k,325) * lu(k,371) + lu(k,379) = lu(k,379) - lu(k,326) * lu(k,371) + lu(k,380) = - lu(k,327) * lu(k,371) + lu(k,381) = - lu(k,328) * lu(k,371) + lu(k,499) = lu(k,499) - lu(k,321) * lu(k,498) + lu(k,500) = lu(k,500) - lu(k,322) * lu(k,498) + lu(k,501) = lu(k,501) - lu(k,323) * lu(k,498) + lu(k,502) = lu(k,502) - lu(k,324) * lu(k,498) + lu(k,505) = lu(k,505) - lu(k,325) * lu(k,498) + lu(k,509) = lu(k,509) - lu(k,326) * lu(k,498) + lu(k,510) = lu(k,510) - lu(k,327) * lu(k,498) + lu(k,511) = lu(k,511) - lu(k,328) * lu(k,498) + lu(k,637) = lu(k,637) - lu(k,321) * lu(k,636) + lu(k,638) = lu(k,638) - lu(k,322) * lu(k,636) + lu(k,639) = lu(k,639) - lu(k,323) * lu(k,636) + lu(k,640) = lu(k,640) - lu(k,324) * lu(k,636) + lu(k,645) = lu(k,645) - lu(k,325) * lu(k,636) + lu(k,650) = lu(k,650) - lu(k,326) * lu(k,636) + lu(k,651) = lu(k,651) - lu(k,327) * lu(k,636) + lu(k,652) = lu(k,652) - lu(k,328) * lu(k,636) + lu(k,663) = lu(k,663) - lu(k,321) * lu(k,662) + lu(k,664) = lu(k,664) - lu(k,322) * lu(k,662) + lu(k,665) = lu(k,665) - lu(k,323) * lu(k,662) + lu(k,666) = - lu(k,324) * lu(k,662) + lu(k,670) = lu(k,670) - lu(k,325) * lu(k,662) + lu(k,675) = lu(k,675) - lu(k,326) * lu(k,662) + lu(k,676) = lu(k,676) - lu(k,327) * lu(k,662) + lu(k,677) = - lu(k,328) * lu(k,662) + lu(k,331) = 1._r8 / lu(k,331) + lu(k,332) = lu(k,332) * lu(k,331) + lu(k,333) = lu(k,333) * lu(k,331) + lu(k,334) = lu(k,334) * lu(k,331) + lu(k,335) = lu(k,335) * lu(k,331) + lu(k,336) = lu(k,336) * lu(k,331) + lu(k,337) = lu(k,337) * lu(k,331) + lu(k,338) = lu(k,338) * lu(k,331) + lu(k,344) = lu(k,344) - lu(k,332) * lu(k,343) + lu(k,345) = lu(k,345) - lu(k,333) * lu(k,343) + lu(k,346) = lu(k,346) - lu(k,334) * lu(k,343) + lu(k,348) = lu(k,348) - lu(k,335) * lu(k,343) + lu(k,349) = lu(k,349) - lu(k,336) * lu(k,343) + lu(k,350) = lu(k,350) - lu(k,337) * lu(k,343) + lu(k,351) = lu(k,351) - lu(k,338) * lu(k,343) + lu(k,357) = lu(k,357) - lu(k,332) * lu(k,356) + lu(k,358) = lu(k,358) - lu(k,333) * lu(k,356) + lu(k,359) = lu(k,359) - lu(k,334) * lu(k,356) + lu(k,361) = lu(k,361) - lu(k,335) * lu(k,356) + lu(k,362) = lu(k,362) - lu(k,336) * lu(k,356) + lu(k,363) = lu(k,363) - lu(k,337) * lu(k,356) + lu(k,364) = lu(k,364) - lu(k,338) * lu(k,356) + lu(k,373) = lu(k,373) - lu(k,332) * lu(k,372) + lu(k,374) = lu(k,374) - lu(k,333) * lu(k,372) + lu(k,375) = lu(k,375) - lu(k,334) * lu(k,372) + lu(k,377) = lu(k,377) - lu(k,335) * lu(k,372) + lu(k,379) = lu(k,379) - lu(k,336) * lu(k,372) + lu(k,380) = lu(k,380) - lu(k,337) * lu(k,372) + lu(k,381) = lu(k,381) - lu(k,338) * lu(k,372) + lu(k,500) = lu(k,500) - lu(k,332) * lu(k,499) + lu(k,501) = lu(k,501) - lu(k,333) * lu(k,499) + lu(k,502) = lu(k,502) - lu(k,334) * lu(k,499) + lu(k,505) = lu(k,505) - lu(k,335) * lu(k,499) + lu(k,509) = lu(k,509) - lu(k,336) * lu(k,499) + lu(k,510) = lu(k,510) - lu(k,337) * lu(k,499) + lu(k,511) = lu(k,511) - lu(k,338) * lu(k,499) + lu(k,638) = lu(k,638) - lu(k,332) * lu(k,637) + lu(k,639) = lu(k,639) - lu(k,333) * lu(k,637) + lu(k,640) = lu(k,640) - lu(k,334) * lu(k,637) + lu(k,645) = lu(k,645) - lu(k,335) * lu(k,637) + lu(k,650) = lu(k,650) - lu(k,336) * lu(k,637) + lu(k,651) = lu(k,651) - lu(k,337) * lu(k,637) + lu(k,652) = lu(k,652) - lu(k,338) * lu(k,637) + lu(k,664) = lu(k,664) - lu(k,332) * lu(k,663) + lu(k,665) = lu(k,665) - lu(k,333) * lu(k,663) + lu(k,666) = lu(k,666) - lu(k,334) * lu(k,663) + lu(k,670) = lu(k,670) - lu(k,335) * lu(k,663) + lu(k,675) = lu(k,675) - lu(k,336) * lu(k,663) + lu(k,676) = lu(k,676) - lu(k,337) * lu(k,663) + lu(k,677) = lu(k,677) - lu(k,338) * lu(k,663) + lu(k,344) = 1._r8 / lu(k,344) + lu(k,345) = lu(k,345) * lu(k,344) + lu(k,346) = lu(k,346) * lu(k,344) + lu(k,347) = lu(k,347) * lu(k,344) + lu(k,348) = lu(k,348) * lu(k,344) + lu(k,349) = lu(k,349) * lu(k,344) + lu(k,350) = lu(k,350) * lu(k,344) + lu(k,351) = lu(k,351) * lu(k,344) + lu(k,352) = lu(k,352) * lu(k,344) + lu(k,353) = lu(k,353) * lu(k,344) + lu(k,358) = lu(k,358) - lu(k,345) * lu(k,357) + lu(k,359) = lu(k,359) - lu(k,346) * lu(k,357) + lu(k,360) = - lu(k,347) * lu(k,357) + lu(k,361) = lu(k,361) - lu(k,348) * lu(k,357) + lu(k,362) = lu(k,362) - lu(k,349) * lu(k,357) + lu(k,363) = lu(k,363) - lu(k,350) * lu(k,357) + lu(k,364) = lu(k,364) - lu(k,351) * lu(k,357) + lu(k,365) = - lu(k,352) * lu(k,357) + lu(k,366) = - lu(k,353) * lu(k,357) + lu(k,374) = lu(k,374) - lu(k,345) * lu(k,373) + lu(k,375) = lu(k,375) - lu(k,346) * lu(k,373) + lu(k,376) = - lu(k,347) * lu(k,373) + lu(k,377) = lu(k,377) - lu(k,348) * lu(k,373) + lu(k,379) = lu(k,379) - lu(k,349) * lu(k,373) + lu(k,380) = lu(k,380) - lu(k,350) * lu(k,373) + lu(k,381) = lu(k,381) - lu(k,351) * lu(k,373) + lu(k,382) = - lu(k,352) * lu(k,373) + lu(k,383) = lu(k,383) - lu(k,353) * lu(k,373) + lu(k,501) = lu(k,501) - lu(k,345) * lu(k,500) + lu(k,502) = lu(k,502) - lu(k,346) * lu(k,500) + lu(k,504) = lu(k,504) - lu(k,347) * lu(k,500) + lu(k,505) = lu(k,505) - lu(k,348) * lu(k,500) + lu(k,509) = lu(k,509) - lu(k,349) * lu(k,500) + lu(k,510) = lu(k,510) - lu(k,350) * lu(k,500) + lu(k,511) = lu(k,511) - lu(k,351) * lu(k,500) + lu(k,514) = - lu(k,352) * lu(k,500) + lu(k,515) = lu(k,515) - lu(k,353) * lu(k,500) + lu(k,639) = lu(k,639) - lu(k,345) * lu(k,638) + lu(k,640) = lu(k,640) - lu(k,346) * lu(k,638) + lu(k,642) = lu(k,642) - lu(k,347) * lu(k,638) + lu(k,645) = lu(k,645) - lu(k,348) * lu(k,638) + lu(k,650) = lu(k,650) - lu(k,349) * lu(k,638) + lu(k,651) = lu(k,651) - lu(k,350) * lu(k,638) + lu(k,652) = lu(k,652) - lu(k,351) * lu(k,638) + lu(k,655) = lu(k,655) - lu(k,352) * lu(k,638) + lu(k,656) = lu(k,656) - lu(k,353) * lu(k,638) + lu(k,665) = lu(k,665) - lu(k,345) * lu(k,664) + lu(k,666) = lu(k,666) - lu(k,346) * lu(k,664) + lu(k,668) = - lu(k,347) * lu(k,664) + lu(k,670) = lu(k,670) - lu(k,348) * lu(k,664) + lu(k,675) = lu(k,675) - lu(k,349) * lu(k,664) + lu(k,676) = lu(k,676) - lu(k,350) * lu(k,664) + lu(k,677) = lu(k,677) - lu(k,351) * lu(k,664) + lu(k,680) = lu(k,680) - lu(k,352) * lu(k,664) + lu(k,681) = lu(k,681) - lu(k,353) * lu(k,664) + lu(k,782) = - lu(k,345) * lu(k,781) + lu(k,783) = - lu(k,346) * lu(k,781) + lu(k,785) = - lu(k,347) * lu(k,781) + lu(k,787) = lu(k,787) - lu(k,348) * lu(k,781) + lu(k,792) = lu(k,792) - lu(k,349) * lu(k,781) + lu(k,793) = lu(k,793) - lu(k,350) * lu(k,781) + lu(k,794) = lu(k,794) - lu(k,351) * lu(k,781) + lu(k,797) = lu(k,797) - lu(k,352) * lu(k,781) + lu(k,798) = lu(k,798) - lu(k,353) * lu(k,781) + lu(k,828) = lu(k,828) - lu(k,345) * lu(k,827) + lu(k,829) = lu(k,829) - lu(k,346) * lu(k,827) + lu(k,833) = lu(k,833) - lu(k,347) * lu(k,827) + lu(k,836) = lu(k,836) - lu(k,348) * lu(k,827) + lu(k,841) = lu(k,841) - lu(k,349) * lu(k,827) + lu(k,842) = lu(k,842) - lu(k,350) * lu(k,827) + lu(k,843) = lu(k,843) - lu(k,351) * lu(k,827) + lu(k,846) = lu(k,846) - lu(k,352) * lu(k,827) + lu(k,847) = lu(k,847) - lu(k,353) * lu(k,827) + lu(k,358) = 1._r8 / lu(k,358) + lu(k,359) = lu(k,359) * lu(k,358) + lu(k,360) = lu(k,360) * lu(k,358) + lu(k,361) = lu(k,361) * lu(k,358) + lu(k,362) = lu(k,362) * lu(k,358) + lu(k,363) = lu(k,363) * lu(k,358) + lu(k,364) = lu(k,364) * lu(k,358) + lu(k,365) = lu(k,365) * lu(k,358) + lu(k,366) = lu(k,366) * lu(k,358) + lu(k,375) = lu(k,375) - lu(k,359) * lu(k,374) + lu(k,376) = lu(k,376) - lu(k,360) * lu(k,374) + lu(k,377) = lu(k,377) - lu(k,361) * lu(k,374) + lu(k,379) = lu(k,379) - lu(k,362) * lu(k,374) + lu(k,380) = lu(k,380) - lu(k,363) * lu(k,374) + lu(k,381) = lu(k,381) - lu(k,364) * lu(k,374) + lu(k,382) = lu(k,382) - lu(k,365) * lu(k,374) + lu(k,383) = lu(k,383) - lu(k,366) * lu(k,374) + lu(k,389) = lu(k,389) - lu(k,359) * lu(k,388) + lu(k,392) = lu(k,392) - lu(k,360) * lu(k,388) + lu(k,395) = lu(k,395) - lu(k,361) * lu(k,388) + lu(k,398) = lu(k,398) - lu(k,362) * lu(k,388) + lu(k,399) = - lu(k,363) * lu(k,388) + lu(k,400) = lu(k,400) - lu(k,364) * lu(k,388) + lu(k,401) = - lu(k,365) * lu(k,388) + lu(k,402) = lu(k,402) - lu(k,366) * lu(k,388) + lu(k,469) = lu(k,469) - lu(k,359) * lu(k,468) + lu(k,470) = lu(k,470) - lu(k,360) * lu(k,468) + lu(k,473) = lu(k,473) - lu(k,361) * lu(k,468) + lu(k,478) = lu(k,478) - lu(k,362) * lu(k,468) + lu(k,479) = - lu(k,363) * lu(k,468) + lu(k,480) = lu(k,480) - lu(k,364) * lu(k,468) + lu(k,483) = - lu(k,365) * lu(k,468) + lu(k,484) = lu(k,484) - lu(k,366) * lu(k,468) + lu(k,502) = lu(k,502) - lu(k,359) * lu(k,501) + lu(k,504) = lu(k,504) - lu(k,360) * lu(k,501) + lu(k,505) = lu(k,505) - lu(k,361) * lu(k,501) + lu(k,509) = lu(k,509) - lu(k,362) * lu(k,501) + lu(k,510) = lu(k,510) - lu(k,363) * lu(k,501) + lu(k,511) = lu(k,511) - lu(k,364) * lu(k,501) + lu(k,514) = lu(k,514) - lu(k,365) * lu(k,501) + lu(k,515) = lu(k,515) - lu(k,366) * lu(k,501) + lu(k,599) = lu(k,599) - lu(k,359) * lu(k,598) + lu(k,601) = - lu(k,360) * lu(k,598) + lu(k,603) = lu(k,603) - lu(k,361) * lu(k,598) + lu(k,608) = lu(k,608) - lu(k,362) * lu(k,598) + lu(k,609) = lu(k,609) - lu(k,363) * lu(k,598) + lu(k,610) = - lu(k,364) * lu(k,598) + lu(k,613) = lu(k,613) - lu(k,365) * lu(k,598) + lu(k,614) = lu(k,614) - lu(k,366) * lu(k,598) + lu(k,640) = lu(k,640) - lu(k,359) * lu(k,639) + lu(k,642) = lu(k,642) - lu(k,360) * lu(k,639) + lu(k,645) = lu(k,645) - lu(k,361) * lu(k,639) + lu(k,650) = lu(k,650) - lu(k,362) * lu(k,639) + lu(k,651) = lu(k,651) - lu(k,363) * lu(k,639) + lu(k,652) = lu(k,652) - lu(k,364) * lu(k,639) + lu(k,655) = lu(k,655) - lu(k,365) * lu(k,639) + lu(k,656) = lu(k,656) - lu(k,366) * lu(k,639) + lu(k,666) = lu(k,666) - lu(k,359) * lu(k,665) + lu(k,668) = lu(k,668) - lu(k,360) * lu(k,665) + lu(k,670) = lu(k,670) - lu(k,361) * lu(k,665) + lu(k,675) = lu(k,675) - lu(k,362) * lu(k,665) + lu(k,676) = lu(k,676) - lu(k,363) * lu(k,665) + lu(k,677) = lu(k,677) - lu(k,364) * lu(k,665) + lu(k,680) = lu(k,680) - lu(k,365) * lu(k,665) + lu(k,681) = lu(k,681) - lu(k,366) * lu(k,665) + lu(k,755) = lu(k,755) - lu(k,359) * lu(k,754) + lu(k,756) = lu(k,756) - lu(k,360) * lu(k,754) + lu(k,758) = lu(k,758) - lu(k,361) * lu(k,754) + lu(k,763) = lu(k,763) - lu(k,362) * lu(k,754) + lu(k,764) = - lu(k,363) * lu(k,754) + lu(k,765) = lu(k,765) - lu(k,364) * lu(k,754) + lu(k,768) = - lu(k,365) * lu(k,754) + lu(k,769) = lu(k,769) - lu(k,366) * lu(k,754) + lu(k,783) = lu(k,783) - lu(k,359) * lu(k,782) + lu(k,785) = lu(k,785) - lu(k,360) * lu(k,782) + lu(k,787) = lu(k,787) - lu(k,361) * lu(k,782) + lu(k,792) = lu(k,792) - lu(k,362) * lu(k,782) + lu(k,793) = lu(k,793) - lu(k,363) * lu(k,782) + lu(k,794) = lu(k,794) - lu(k,364) * lu(k,782) + lu(k,797) = lu(k,797) - lu(k,365) * lu(k,782) + lu(k,798) = lu(k,798) - lu(k,366) * lu(k,782) + lu(k,829) = lu(k,829) - lu(k,359) * lu(k,828) + lu(k,833) = lu(k,833) - lu(k,360) * lu(k,828) + lu(k,836) = lu(k,836) - lu(k,361) * lu(k,828) + lu(k,841) = lu(k,841) - lu(k,362) * lu(k,828) + lu(k,842) = lu(k,842) - lu(k,363) * lu(k,828) + lu(k,843) = lu(k,843) - lu(k,364) * lu(k,828) + lu(k,846) = lu(k,846) - lu(k,365) * lu(k,828) + lu(k,847) = lu(k,847) - lu(k,366) * lu(k,828) + lu(k,885) = lu(k,885) - lu(k,359) * lu(k,884) + lu(k,888) = lu(k,888) - lu(k,360) * lu(k,884) + lu(k,891) = lu(k,891) - lu(k,361) * lu(k,884) + lu(k,896) = lu(k,896) - lu(k,362) * lu(k,884) + lu(k,897) = - lu(k,363) * lu(k,884) + lu(k,898) = lu(k,898) - lu(k,364) * lu(k,884) + lu(k,901) = lu(k,901) - lu(k,365) * lu(k,884) + lu(k,902) = lu(k,902) - lu(k,366) * lu(k,884) end do end subroutine lu_fac08 subroutine lu_fac09( avec_len, lu ) @@ -1892,712 +1554,309 @@ subroutine lu_fac09( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,347) = 1._r8 / lu(k,347) - lu(k,348) = lu(k,348) * lu(k,347) - lu(k,349) = lu(k,349) * lu(k,347) - lu(k,350) = lu(k,350) * lu(k,347) - lu(k,351) = lu(k,351) * lu(k,347) - lu(k,352) = lu(k,352) * lu(k,347) - lu(k,353) = lu(k,353) * lu(k,347) - lu(k,354) = lu(k,354) * lu(k,347) - lu(k,355) = lu(k,355) * lu(k,347) - lu(k,356) = lu(k,356) * lu(k,347) - lu(k,357) = lu(k,357) * lu(k,347) - lu(k,358) = lu(k,358) * lu(k,347) - lu(k,359) = lu(k,359) * lu(k,347) - lu(k,370) = lu(k,370) - lu(k,348) * lu(k,368) - lu(k,371) = lu(k,371) - lu(k,349) * lu(k,368) - lu(k,372) = lu(k,372) - lu(k,350) * lu(k,368) - lu(k,373) = lu(k,373) - lu(k,351) * lu(k,368) - lu(k,374) = lu(k,374) - lu(k,352) * lu(k,368) - lu(k,376) = lu(k,376) - lu(k,353) * lu(k,368) - lu(k,378) = lu(k,378) - lu(k,354) * lu(k,368) - lu(k,379) = lu(k,379) - lu(k,355) * lu(k,368) - lu(k,380) = lu(k,380) - lu(k,356) * lu(k,368) - lu(k,381) = lu(k,381) - lu(k,357) * lu(k,368) - lu(k,382) = lu(k,382) - lu(k,358) * lu(k,368) - lu(k,383) = lu(k,383) - lu(k,359) * lu(k,368) - lu(k,395) = lu(k,395) - lu(k,348) * lu(k,393) - lu(k,396) = lu(k,396) - lu(k,349) * lu(k,393) - lu(k,397) = lu(k,397) - lu(k,350) * lu(k,393) - lu(k,398) = lu(k,398) - lu(k,351) * lu(k,393) - lu(k,399) = lu(k,399) - lu(k,352) * lu(k,393) - lu(k,401) = lu(k,401) - lu(k,353) * lu(k,393) - lu(k,403) = lu(k,403) - lu(k,354) * lu(k,393) - lu(k,404) = lu(k,404) - lu(k,355) * lu(k,393) - lu(k,405) = lu(k,405) - lu(k,356) * lu(k,393) - lu(k,406) = lu(k,406) - lu(k,357) * lu(k,393) - lu(k,407) = lu(k,407) - lu(k,358) * lu(k,393) - lu(k,408) = lu(k,408) - lu(k,359) * lu(k,393) - lu(k,420) = lu(k,420) - lu(k,348) * lu(k,418) - lu(k,421) = lu(k,421) - lu(k,349) * lu(k,418) - lu(k,422) = lu(k,422) - lu(k,350) * lu(k,418) - lu(k,423) = lu(k,423) - lu(k,351) * lu(k,418) - lu(k,424) = lu(k,424) - lu(k,352) * lu(k,418) - lu(k,426) = lu(k,426) - lu(k,353) * lu(k,418) - lu(k,428) = lu(k,428) - lu(k,354) * lu(k,418) - lu(k,429) = lu(k,429) - lu(k,355) * lu(k,418) - lu(k,430) = lu(k,430) - lu(k,356) * lu(k,418) - lu(k,431) = lu(k,431) - lu(k,357) * lu(k,418) - lu(k,432) = - lu(k,358) * lu(k,418) - lu(k,433) = lu(k,433) - lu(k,359) * lu(k,418) - lu(k,448) = lu(k,448) - lu(k,348) * lu(k,446) - lu(k,449) = lu(k,449) - lu(k,349) * lu(k,446) - lu(k,450) = lu(k,450) - lu(k,350) * lu(k,446) - lu(k,451) = lu(k,451) - lu(k,351) * lu(k,446) - lu(k,452) = lu(k,452) - lu(k,352) * lu(k,446) - lu(k,454) = lu(k,454) - lu(k,353) * lu(k,446) - lu(k,456) = lu(k,456) - lu(k,354) * lu(k,446) - lu(k,457) = lu(k,457) - lu(k,355) * lu(k,446) - lu(k,458) = lu(k,458) - lu(k,356) * lu(k,446) - lu(k,459) = lu(k,459) - lu(k,357) * lu(k,446) - lu(k,460) = lu(k,460) - lu(k,358) * lu(k,446) - lu(k,461) = lu(k,461) - lu(k,359) * lu(k,446) - lu(k,491) = lu(k,491) - lu(k,348) * lu(k,489) - lu(k,492) = lu(k,492) - lu(k,349) * lu(k,489) - lu(k,493) = lu(k,493) - lu(k,350) * lu(k,489) - lu(k,494) = lu(k,494) - lu(k,351) * lu(k,489) - lu(k,495) = lu(k,495) - lu(k,352) * lu(k,489) - lu(k,497) = lu(k,497) - lu(k,353) * lu(k,489) - lu(k,499) = lu(k,499) - lu(k,354) * lu(k,489) - lu(k,500) = lu(k,500) - lu(k,355) * lu(k,489) - lu(k,501) = lu(k,501) - lu(k,356) * lu(k,489) - lu(k,502) = lu(k,502) - lu(k,357) * lu(k,489) - lu(k,503) = lu(k,503) - lu(k,358) * lu(k,489) - lu(k,504) = lu(k,504) - lu(k,359) * lu(k,489) - lu(k,513) = lu(k,513) - lu(k,348) * lu(k,511) - lu(k,514) = lu(k,514) - lu(k,349) * lu(k,511) - lu(k,515) = lu(k,515) - lu(k,350) * lu(k,511) - lu(k,516) = lu(k,516) - lu(k,351) * lu(k,511) - lu(k,517) = lu(k,517) - lu(k,352) * lu(k,511) - lu(k,519) = lu(k,519) - lu(k,353) * lu(k,511) - lu(k,521) = lu(k,521) - lu(k,354) * lu(k,511) - lu(k,522) = lu(k,522) - lu(k,355) * lu(k,511) - lu(k,523) = lu(k,523) - lu(k,356) * lu(k,511) - lu(k,524) = lu(k,524) - lu(k,357) * lu(k,511) - lu(k,525) = - lu(k,358) * lu(k,511) - lu(k,526) = lu(k,526) - lu(k,359) * lu(k,511) - lu(k,538) = lu(k,538) - lu(k,348) * lu(k,536) - lu(k,539) = lu(k,539) - lu(k,349) * lu(k,536) - lu(k,540) = lu(k,540) - lu(k,350) * lu(k,536) - lu(k,541) = lu(k,541) - lu(k,351) * lu(k,536) - lu(k,542) = lu(k,542) - lu(k,352) * lu(k,536) - lu(k,544) = lu(k,544) - lu(k,353) * lu(k,536) - lu(k,546) = lu(k,546) - lu(k,354) * lu(k,536) - lu(k,547) = lu(k,547) - lu(k,355) * lu(k,536) - lu(k,548) = lu(k,548) - lu(k,356) * lu(k,536) - lu(k,549) = lu(k,549) - lu(k,357) * lu(k,536) - lu(k,550) = lu(k,550) - lu(k,358) * lu(k,536) - lu(k,551) = lu(k,551) - lu(k,359) * lu(k,536) - lu(k,559) = lu(k,559) - lu(k,348) * lu(k,557) - lu(k,560) = lu(k,560) - lu(k,349) * lu(k,557) - lu(k,561) = lu(k,561) - lu(k,350) * lu(k,557) - lu(k,562) = lu(k,562) - lu(k,351) * lu(k,557) - lu(k,563) = lu(k,563) - lu(k,352) * lu(k,557) - lu(k,565) = lu(k,565) - lu(k,353) * lu(k,557) - lu(k,567) = lu(k,567) - lu(k,354) * lu(k,557) - lu(k,568) = lu(k,568) - lu(k,355) * lu(k,557) - lu(k,569) = lu(k,569) - lu(k,356) * lu(k,557) - lu(k,570) = lu(k,570) - lu(k,357) * lu(k,557) - lu(k,571) = - lu(k,358) * lu(k,557) - lu(k,572) = lu(k,572) - lu(k,359) * lu(k,557) - lu(k,585) = lu(k,585) - lu(k,348) * lu(k,583) - lu(k,586) = lu(k,586) - lu(k,349) * lu(k,583) - lu(k,587) = lu(k,587) - lu(k,350) * lu(k,583) - lu(k,588) = lu(k,588) - lu(k,351) * lu(k,583) - lu(k,589) = lu(k,589) - lu(k,352) * lu(k,583) - lu(k,591) = lu(k,591) - lu(k,353) * lu(k,583) - lu(k,593) = lu(k,593) - lu(k,354) * lu(k,583) - lu(k,594) = lu(k,594) - lu(k,355) * lu(k,583) - lu(k,595) = lu(k,595) - lu(k,356) * lu(k,583) - lu(k,596) = lu(k,596) - lu(k,357) * lu(k,583) - lu(k,597) = lu(k,597) - lu(k,358) * lu(k,583) - lu(k,598) = lu(k,598) - lu(k,359) * lu(k,583) - lu(k,653) = lu(k,653) - lu(k,348) * lu(k,651) - lu(k,654) = lu(k,654) - lu(k,349) * lu(k,651) - lu(k,655) = lu(k,655) - lu(k,350) * lu(k,651) - lu(k,656) = lu(k,656) - lu(k,351) * lu(k,651) - lu(k,657) = lu(k,657) - lu(k,352) * lu(k,651) - lu(k,659) = lu(k,659) - lu(k,353) * lu(k,651) - lu(k,661) = lu(k,661) - lu(k,354) * lu(k,651) - lu(k,662) = lu(k,662) - lu(k,355) * lu(k,651) - lu(k,663) = lu(k,663) - lu(k,356) * lu(k,651) - lu(k,664) = lu(k,664) - lu(k,357) * lu(k,651) - lu(k,665) = lu(k,665) - lu(k,358) * lu(k,651) - lu(k,666) = lu(k,666) - lu(k,359) * lu(k,651) - lu(k,703) = lu(k,703) - lu(k,348) * lu(k,701) - lu(k,704) = lu(k,704) - lu(k,349) * lu(k,701) - lu(k,705) = lu(k,705) - lu(k,350) * lu(k,701) - lu(k,706) = lu(k,706) - lu(k,351) * lu(k,701) - lu(k,707) = lu(k,707) - lu(k,352) * lu(k,701) - lu(k,709) = lu(k,709) - lu(k,353) * lu(k,701) - lu(k,711) = lu(k,711) - lu(k,354) * lu(k,701) - lu(k,712) = lu(k,712) - lu(k,355) * lu(k,701) - lu(k,713) = lu(k,713) - lu(k,356) * lu(k,701) - lu(k,714) = lu(k,714) - lu(k,357) * lu(k,701) - lu(k,715) = lu(k,715) - lu(k,358) * lu(k,701) - lu(k,716) = lu(k,716) - lu(k,359) * lu(k,701) - lu(k,726) = lu(k,726) - lu(k,348) * lu(k,724) - lu(k,727) = lu(k,727) - lu(k,349) * lu(k,724) - lu(k,728) = lu(k,728) - lu(k,350) * lu(k,724) - lu(k,729) = lu(k,729) - lu(k,351) * lu(k,724) - lu(k,730) = lu(k,730) - lu(k,352) * lu(k,724) - lu(k,732) = lu(k,732) - lu(k,353) * lu(k,724) - lu(k,734) = lu(k,734) - lu(k,354) * lu(k,724) - lu(k,735) = lu(k,735) - lu(k,355) * lu(k,724) - lu(k,736) = lu(k,736) - lu(k,356) * lu(k,724) - lu(k,737) = lu(k,737) - lu(k,357) * lu(k,724) - lu(k,738) = lu(k,738) - lu(k,358) * lu(k,724) - lu(k,739) = lu(k,739) - lu(k,359) * lu(k,724) - lu(k,751) = lu(k,751) - lu(k,348) * lu(k,749) - lu(k,752) = lu(k,752) - lu(k,349) * lu(k,749) - lu(k,753) = lu(k,753) - lu(k,350) * lu(k,749) - lu(k,754) = lu(k,754) - lu(k,351) * lu(k,749) - lu(k,755) = lu(k,755) - lu(k,352) * lu(k,749) - lu(k,757) = lu(k,757) - lu(k,353) * lu(k,749) - lu(k,759) = lu(k,759) - lu(k,354) * lu(k,749) - lu(k,760) = lu(k,760) - lu(k,355) * lu(k,749) - lu(k,761) = lu(k,761) - lu(k,356) * lu(k,749) - lu(k,762) = lu(k,762) - lu(k,357) * lu(k,749) - lu(k,763) = lu(k,763) - lu(k,358) * lu(k,749) - lu(k,764) = lu(k,764) - lu(k,359) * lu(k,749) - 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,377) = lu(k,377) * lu(k,369) - lu(k,378) = lu(k,378) * lu(k,369) - lu(k,379) = lu(k,379) * lu(k,369) - lu(k,380) = lu(k,380) * lu(k,369) - lu(k,381) = lu(k,381) * lu(k,369) - lu(k,382) = lu(k,382) * lu(k,369) - lu(k,383) = lu(k,383) * lu(k,369) - lu(k,395) = lu(k,395) - lu(k,370) * lu(k,394) - lu(k,396) = lu(k,396) - lu(k,371) * lu(k,394) - lu(k,397) = lu(k,397) - lu(k,372) * lu(k,394) - lu(k,398) = lu(k,398) - lu(k,373) * lu(k,394) - lu(k,399) = lu(k,399) - lu(k,374) * lu(k,394) - lu(k,400) = lu(k,400) - lu(k,375) * lu(k,394) - lu(k,401) = lu(k,401) - lu(k,376) * lu(k,394) - lu(k,402) = lu(k,402) - lu(k,377) * lu(k,394) - lu(k,403) = lu(k,403) - lu(k,378) * lu(k,394) - lu(k,404) = lu(k,404) - lu(k,379) * lu(k,394) - lu(k,405) = lu(k,405) - lu(k,380) * lu(k,394) - lu(k,406) = lu(k,406) - lu(k,381) * lu(k,394) - lu(k,407) = lu(k,407) - lu(k,382) * lu(k,394) - lu(k,408) = lu(k,408) - lu(k,383) * lu(k,394) - lu(k,420) = lu(k,420) - lu(k,370) * lu(k,419) - lu(k,421) = lu(k,421) - lu(k,371) * lu(k,419) - lu(k,422) = lu(k,422) - lu(k,372) * lu(k,419) - lu(k,423) = lu(k,423) - lu(k,373) * lu(k,419) - lu(k,424) = lu(k,424) - lu(k,374) * lu(k,419) - lu(k,425) = lu(k,425) - lu(k,375) * lu(k,419) - lu(k,426) = lu(k,426) - lu(k,376) * lu(k,419) - lu(k,427) = lu(k,427) - lu(k,377) * lu(k,419) - lu(k,428) = lu(k,428) - lu(k,378) * lu(k,419) - lu(k,429) = lu(k,429) - lu(k,379) * lu(k,419) - lu(k,430) = lu(k,430) - lu(k,380) * lu(k,419) - lu(k,431) = lu(k,431) - lu(k,381) * lu(k,419) - lu(k,432) = lu(k,432) - lu(k,382) * lu(k,419) - lu(k,433) = lu(k,433) - lu(k,383) * lu(k,419) - lu(k,448) = lu(k,448) - lu(k,370) * lu(k,447) - lu(k,449) = lu(k,449) - lu(k,371) * lu(k,447) - lu(k,450) = lu(k,450) - lu(k,372) * lu(k,447) - lu(k,451) = lu(k,451) - lu(k,373) * lu(k,447) - lu(k,452) = lu(k,452) - lu(k,374) * lu(k,447) - lu(k,453) = lu(k,453) - lu(k,375) * lu(k,447) - lu(k,454) = lu(k,454) - lu(k,376) * lu(k,447) - lu(k,455) = lu(k,455) - lu(k,377) * lu(k,447) - lu(k,456) = lu(k,456) - lu(k,378) * lu(k,447) - lu(k,457) = lu(k,457) - lu(k,379) * lu(k,447) - lu(k,458) = lu(k,458) - lu(k,380) * lu(k,447) - lu(k,459) = lu(k,459) - lu(k,381) * lu(k,447) - lu(k,460) = lu(k,460) - lu(k,382) * lu(k,447) - lu(k,461) = lu(k,461) - lu(k,383) * lu(k,447) - lu(k,491) = lu(k,491) - lu(k,370) * lu(k,490) - lu(k,492) = lu(k,492) - lu(k,371) * lu(k,490) - lu(k,493) = lu(k,493) - lu(k,372) * lu(k,490) - lu(k,494) = lu(k,494) - lu(k,373) * lu(k,490) - lu(k,495) = lu(k,495) - lu(k,374) * lu(k,490) - lu(k,496) = lu(k,496) - lu(k,375) * lu(k,490) - lu(k,497) = lu(k,497) - lu(k,376) * lu(k,490) - lu(k,498) = lu(k,498) - lu(k,377) * lu(k,490) - lu(k,499) = lu(k,499) - lu(k,378) * lu(k,490) - lu(k,500) = lu(k,500) - lu(k,379) * lu(k,490) - lu(k,501) = lu(k,501) - lu(k,380) * lu(k,490) - lu(k,502) = lu(k,502) - lu(k,381) * lu(k,490) - lu(k,503) = lu(k,503) - lu(k,382) * lu(k,490) - lu(k,504) = lu(k,504) - lu(k,383) * lu(k,490) - lu(k,513) = lu(k,513) - lu(k,370) * lu(k,512) - lu(k,514) = lu(k,514) - lu(k,371) * lu(k,512) - lu(k,515) = lu(k,515) - lu(k,372) * lu(k,512) - lu(k,516) = lu(k,516) - lu(k,373) * lu(k,512) - lu(k,517) = lu(k,517) - lu(k,374) * lu(k,512) - lu(k,518) = lu(k,518) - lu(k,375) * lu(k,512) - lu(k,519) = lu(k,519) - lu(k,376) * lu(k,512) - lu(k,520) = lu(k,520) - lu(k,377) * lu(k,512) - lu(k,521) = lu(k,521) - lu(k,378) * lu(k,512) - lu(k,522) = lu(k,522) - lu(k,379) * lu(k,512) - lu(k,523) = lu(k,523) - lu(k,380) * lu(k,512) - lu(k,524) = lu(k,524) - lu(k,381) * lu(k,512) - lu(k,525) = lu(k,525) - lu(k,382) * lu(k,512) - lu(k,526) = lu(k,526) - lu(k,383) * lu(k,512) - lu(k,538) = lu(k,538) - lu(k,370) * lu(k,537) - lu(k,539) = lu(k,539) - lu(k,371) * lu(k,537) - lu(k,540) = lu(k,540) - lu(k,372) * lu(k,537) - lu(k,541) = lu(k,541) - lu(k,373) * lu(k,537) - lu(k,542) = lu(k,542) - lu(k,374) * lu(k,537) - lu(k,543) = lu(k,543) - lu(k,375) * lu(k,537) - lu(k,544) = lu(k,544) - lu(k,376) * lu(k,537) - lu(k,545) = lu(k,545) - lu(k,377) * lu(k,537) - lu(k,546) = lu(k,546) - lu(k,378) * lu(k,537) - lu(k,547) = lu(k,547) - lu(k,379) * lu(k,537) - lu(k,548) = lu(k,548) - lu(k,380) * lu(k,537) - lu(k,549) = lu(k,549) - lu(k,381) * lu(k,537) - lu(k,550) = lu(k,550) - lu(k,382) * lu(k,537) - lu(k,551) = lu(k,551) - lu(k,383) * lu(k,537) - lu(k,559) = lu(k,559) - lu(k,370) * lu(k,558) - lu(k,560) = lu(k,560) - lu(k,371) * lu(k,558) - lu(k,561) = lu(k,561) - lu(k,372) * lu(k,558) - lu(k,562) = lu(k,562) - lu(k,373) * lu(k,558) - lu(k,563) = lu(k,563) - lu(k,374) * lu(k,558) - lu(k,564) = lu(k,564) - lu(k,375) * lu(k,558) - lu(k,565) = lu(k,565) - lu(k,376) * lu(k,558) - lu(k,566) = lu(k,566) - lu(k,377) * lu(k,558) - lu(k,567) = lu(k,567) - lu(k,378) * lu(k,558) - lu(k,568) = lu(k,568) - lu(k,379) * lu(k,558) - lu(k,569) = lu(k,569) - lu(k,380) * lu(k,558) - lu(k,570) = lu(k,570) - lu(k,381) * lu(k,558) - lu(k,571) = lu(k,571) - lu(k,382) * lu(k,558) - lu(k,572) = lu(k,572) - lu(k,383) * lu(k,558) - lu(k,585) = lu(k,585) - lu(k,370) * lu(k,584) - lu(k,586) = lu(k,586) - lu(k,371) * lu(k,584) - lu(k,587) = lu(k,587) - lu(k,372) * lu(k,584) - lu(k,588) = lu(k,588) - lu(k,373) * lu(k,584) - lu(k,589) = lu(k,589) - lu(k,374) * lu(k,584) - lu(k,590) = lu(k,590) - lu(k,375) * lu(k,584) - lu(k,591) = lu(k,591) - lu(k,376) * lu(k,584) - lu(k,592) = lu(k,592) - lu(k,377) * lu(k,584) - lu(k,593) = lu(k,593) - lu(k,378) * lu(k,584) - lu(k,594) = lu(k,594) - lu(k,379) * lu(k,584) - lu(k,595) = lu(k,595) - lu(k,380) * lu(k,584) - lu(k,596) = lu(k,596) - lu(k,381) * lu(k,584) - lu(k,597) = lu(k,597) - lu(k,382) * lu(k,584) - lu(k,598) = lu(k,598) - lu(k,383) * lu(k,584) - lu(k,653) = lu(k,653) - lu(k,370) * lu(k,652) - lu(k,654) = lu(k,654) - lu(k,371) * lu(k,652) - lu(k,655) = lu(k,655) - lu(k,372) * lu(k,652) - lu(k,656) = lu(k,656) - lu(k,373) * lu(k,652) - lu(k,657) = lu(k,657) - lu(k,374) * lu(k,652) - lu(k,658) = lu(k,658) - lu(k,375) * lu(k,652) - lu(k,659) = lu(k,659) - lu(k,376) * lu(k,652) - lu(k,660) = lu(k,660) - lu(k,377) * lu(k,652) - lu(k,661) = lu(k,661) - lu(k,378) * lu(k,652) - lu(k,662) = lu(k,662) - lu(k,379) * lu(k,652) - lu(k,663) = lu(k,663) - lu(k,380) * lu(k,652) - lu(k,664) = lu(k,664) - lu(k,381) * lu(k,652) - lu(k,665) = lu(k,665) - lu(k,382) * lu(k,652) - lu(k,666) = lu(k,666) - lu(k,383) * lu(k,652) - lu(k,675) = lu(k,675) - lu(k,370) * lu(k,674) - lu(k,676) = lu(k,676) - lu(k,371) * lu(k,674) - lu(k,677) = lu(k,677) - lu(k,372) * lu(k,674) - lu(k,678) = lu(k,678) - lu(k,373) * lu(k,674) - lu(k,679) = lu(k,679) - lu(k,374) * lu(k,674) - lu(k,680) = lu(k,680) - lu(k,375) * lu(k,674) - lu(k,681) = lu(k,681) - lu(k,376) * lu(k,674) - lu(k,682) = lu(k,682) - lu(k,377) * lu(k,674) - lu(k,683) = lu(k,683) - lu(k,378) * lu(k,674) - lu(k,684) = lu(k,684) - lu(k,379) * lu(k,674) - lu(k,685) = lu(k,685) - lu(k,380) * lu(k,674) - lu(k,686) = lu(k,686) - lu(k,381) * lu(k,674) - lu(k,687) = lu(k,687) - lu(k,382) * lu(k,674) - lu(k,688) = lu(k,688) - lu(k,383) * lu(k,674) - lu(k,703) = lu(k,703) - lu(k,370) * lu(k,702) - lu(k,704) = lu(k,704) - lu(k,371) * lu(k,702) - lu(k,705) = lu(k,705) - lu(k,372) * lu(k,702) - lu(k,706) = lu(k,706) - lu(k,373) * lu(k,702) - lu(k,707) = lu(k,707) - lu(k,374) * lu(k,702) - lu(k,708) = lu(k,708) - lu(k,375) * lu(k,702) - lu(k,709) = lu(k,709) - lu(k,376) * lu(k,702) - lu(k,710) = lu(k,710) - lu(k,377) * lu(k,702) - lu(k,711) = lu(k,711) - lu(k,378) * lu(k,702) - lu(k,712) = lu(k,712) - lu(k,379) * lu(k,702) - lu(k,713) = lu(k,713) - lu(k,380) * lu(k,702) - lu(k,714) = lu(k,714) - lu(k,381) * lu(k,702) - lu(k,715) = lu(k,715) - lu(k,382) * lu(k,702) - lu(k,716) = lu(k,716) - lu(k,383) * lu(k,702) - lu(k,726) = lu(k,726) - lu(k,370) * lu(k,725) - lu(k,727) = lu(k,727) - lu(k,371) * lu(k,725) - lu(k,728) = lu(k,728) - lu(k,372) * lu(k,725) - lu(k,729) = lu(k,729) - lu(k,373) * lu(k,725) - lu(k,730) = lu(k,730) - lu(k,374) * lu(k,725) - lu(k,731) = lu(k,731) - lu(k,375) * lu(k,725) - lu(k,732) = lu(k,732) - lu(k,376) * lu(k,725) - lu(k,733) = lu(k,733) - lu(k,377) * lu(k,725) - lu(k,734) = lu(k,734) - lu(k,378) * lu(k,725) - lu(k,735) = lu(k,735) - lu(k,379) * lu(k,725) - lu(k,736) = lu(k,736) - lu(k,380) * lu(k,725) - lu(k,737) = lu(k,737) - lu(k,381) * lu(k,725) - lu(k,738) = lu(k,738) - lu(k,382) * lu(k,725) - lu(k,739) = lu(k,739) - lu(k,383) * lu(k,725) - lu(k,751) = lu(k,751) - lu(k,370) * lu(k,750) - lu(k,752) = lu(k,752) - lu(k,371) * lu(k,750) - lu(k,753) = lu(k,753) - lu(k,372) * lu(k,750) - lu(k,754) = lu(k,754) - lu(k,373) * lu(k,750) - lu(k,755) = lu(k,755) - lu(k,374) * lu(k,750) - lu(k,756) = lu(k,756) - lu(k,375) * lu(k,750) - lu(k,757) = lu(k,757) - lu(k,376) * lu(k,750) - lu(k,758) = lu(k,758) - lu(k,377) * lu(k,750) - lu(k,759) = lu(k,759) - lu(k,378) * lu(k,750) - lu(k,760) = lu(k,760) - lu(k,379) * lu(k,750) - lu(k,761) = lu(k,761) - lu(k,380) * lu(k,750) - lu(k,762) = lu(k,762) - lu(k,381) * lu(k,750) - lu(k,763) = lu(k,763) - lu(k,382) * lu(k,750) - lu(k,764) = lu(k,764) - lu(k,383) * lu(k,750) - lu(k,395) = 1._r8 / lu(k,395) - lu(k,396) = lu(k,396) * lu(k,395) - lu(k,397) = lu(k,397) * lu(k,395) - lu(k,398) = lu(k,398) * lu(k,395) - lu(k,399) = lu(k,399) * lu(k,395) - lu(k,400) = lu(k,400) * lu(k,395) - lu(k,401) = lu(k,401) * lu(k,395) - lu(k,402) = lu(k,402) * lu(k,395) - lu(k,403) = lu(k,403) * lu(k,395) - lu(k,404) = lu(k,404) * lu(k,395) - lu(k,405) = lu(k,405) * lu(k,395) - lu(k,406) = lu(k,406) * lu(k,395) - lu(k,407) = lu(k,407) * lu(k,395) - lu(k,408) = lu(k,408) * lu(k,395) - lu(k,421) = lu(k,421) - lu(k,396) * lu(k,420) - lu(k,422) = lu(k,422) - lu(k,397) * lu(k,420) - lu(k,423) = lu(k,423) - lu(k,398) * lu(k,420) - lu(k,424) = lu(k,424) - lu(k,399) * lu(k,420) - lu(k,425) = lu(k,425) - lu(k,400) * lu(k,420) - lu(k,426) = lu(k,426) - lu(k,401) * lu(k,420) - lu(k,427) = lu(k,427) - lu(k,402) * lu(k,420) - lu(k,428) = lu(k,428) - lu(k,403) * lu(k,420) - lu(k,429) = lu(k,429) - lu(k,404) * lu(k,420) - lu(k,430) = lu(k,430) - lu(k,405) * lu(k,420) - lu(k,431) = lu(k,431) - lu(k,406) * lu(k,420) - lu(k,432) = lu(k,432) - lu(k,407) * lu(k,420) - lu(k,433) = lu(k,433) - lu(k,408) * lu(k,420) - lu(k,449) = lu(k,449) - lu(k,396) * lu(k,448) - lu(k,450) = lu(k,450) - lu(k,397) * lu(k,448) - lu(k,451) = lu(k,451) - lu(k,398) * lu(k,448) - lu(k,452) = lu(k,452) - lu(k,399) * lu(k,448) - lu(k,453) = lu(k,453) - lu(k,400) * lu(k,448) - lu(k,454) = lu(k,454) - lu(k,401) * lu(k,448) - lu(k,455) = lu(k,455) - lu(k,402) * lu(k,448) - lu(k,456) = lu(k,456) - lu(k,403) * lu(k,448) - lu(k,457) = lu(k,457) - lu(k,404) * lu(k,448) - lu(k,458) = lu(k,458) - lu(k,405) * lu(k,448) - lu(k,459) = lu(k,459) - lu(k,406) * lu(k,448) - lu(k,460) = lu(k,460) - lu(k,407) * lu(k,448) - lu(k,461) = lu(k,461) - lu(k,408) * lu(k,448) - lu(k,492) = lu(k,492) - lu(k,396) * lu(k,491) - lu(k,493) = lu(k,493) - lu(k,397) * lu(k,491) - lu(k,494) = lu(k,494) - lu(k,398) * lu(k,491) - lu(k,495) = lu(k,495) - lu(k,399) * lu(k,491) - lu(k,496) = lu(k,496) - lu(k,400) * lu(k,491) - lu(k,497) = lu(k,497) - lu(k,401) * lu(k,491) - lu(k,498) = lu(k,498) - lu(k,402) * lu(k,491) - lu(k,499) = lu(k,499) - lu(k,403) * lu(k,491) - lu(k,500) = lu(k,500) - lu(k,404) * lu(k,491) - lu(k,501) = lu(k,501) - lu(k,405) * lu(k,491) - lu(k,502) = lu(k,502) - lu(k,406) * lu(k,491) - lu(k,503) = lu(k,503) - lu(k,407) * lu(k,491) - lu(k,504) = lu(k,504) - lu(k,408) * lu(k,491) - lu(k,514) = lu(k,514) - lu(k,396) * lu(k,513) - lu(k,515) = lu(k,515) - lu(k,397) * lu(k,513) - lu(k,516) = lu(k,516) - lu(k,398) * lu(k,513) - lu(k,517) = lu(k,517) - lu(k,399) * lu(k,513) - lu(k,518) = lu(k,518) - lu(k,400) * lu(k,513) - lu(k,519) = lu(k,519) - lu(k,401) * lu(k,513) - lu(k,520) = lu(k,520) - lu(k,402) * lu(k,513) - lu(k,521) = lu(k,521) - lu(k,403) * lu(k,513) - lu(k,522) = lu(k,522) - lu(k,404) * lu(k,513) - lu(k,523) = lu(k,523) - lu(k,405) * lu(k,513) - lu(k,524) = lu(k,524) - lu(k,406) * lu(k,513) - lu(k,525) = lu(k,525) - lu(k,407) * lu(k,513) - lu(k,526) = lu(k,526) - lu(k,408) * lu(k,513) - lu(k,539) = lu(k,539) - lu(k,396) * lu(k,538) - lu(k,540) = lu(k,540) - lu(k,397) * lu(k,538) - lu(k,541) = lu(k,541) - lu(k,398) * lu(k,538) - lu(k,542) = lu(k,542) - lu(k,399) * lu(k,538) - lu(k,543) = lu(k,543) - lu(k,400) * lu(k,538) - lu(k,544) = lu(k,544) - lu(k,401) * lu(k,538) - lu(k,545) = lu(k,545) - lu(k,402) * lu(k,538) - lu(k,546) = lu(k,546) - lu(k,403) * lu(k,538) - lu(k,547) = lu(k,547) - lu(k,404) * lu(k,538) - lu(k,548) = lu(k,548) - lu(k,405) * lu(k,538) - lu(k,549) = lu(k,549) - lu(k,406) * lu(k,538) - lu(k,550) = lu(k,550) - lu(k,407) * lu(k,538) - lu(k,551) = lu(k,551) - lu(k,408) * lu(k,538) - lu(k,560) = lu(k,560) - lu(k,396) * lu(k,559) - lu(k,561) = lu(k,561) - lu(k,397) * lu(k,559) - lu(k,562) = lu(k,562) - lu(k,398) * lu(k,559) - lu(k,563) = lu(k,563) - lu(k,399) * lu(k,559) - lu(k,564) = lu(k,564) - lu(k,400) * lu(k,559) - lu(k,565) = lu(k,565) - lu(k,401) * lu(k,559) - lu(k,566) = lu(k,566) - lu(k,402) * lu(k,559) - lu(k,567) = lu(k,567) - lu(k,403) * lu(k,559) - lu(k,568) = lu(k,568) - lu(k,404) * lu(k,559) - lu(k,569) = lu(k,569) - lu(k,405) * lu(k,559) - lu(k,570) = lu(k,570) - lu(k,406) * lu(k,559) - lu(k,571) = lu(k,571) - lu(k,407) * lu(k,559) - lu(k,572) = lu(k,572) - lu(k,408) * lu(k,559) - lu(k,586) = lu(k,586) - lu(k,396) * lu(k,585) - lu(k,587) = lu(k,587) - lu(k,397) * lu(k,585) - lu(k,588) = lu(k,588) - lu(k,398) * lu(k,585) - lu(k,589) = lu(k,589) - lu(k,399) * lu(k,585) - lu(k,590) = lu(k,590) - lu(k,400) * lu(k,585) - lu(k,591) = lu(k,591) - lu(k,401) * lu(k,585) - lu(k,592) = lu(k,592) - lu(k,402) * lu(k,585) - lu(k,593) = lu(k,593) - lu(k,403) * lu(k,585) - lu(k,594) = lu(k,594) - lu(k,404) * lu(k,585) - lu(k,595) = lu(k,595) - lu(k,405) * lu(k,585) - lu(k,596) = lu(k,596) - lu(k,406) * lu(k,585) - lu(k,597) = lu(k,597) - lu(k,407) * lu(k,585) - lu(k,598) = lu(k,598) - lu(k,408) * lu(k,585) - lu(k,617) = lu(k,617) - lu(k,396) * lu(k,616) - lu(k,618) = lu(k,618) - lu(k,397) * lu(k,616) - lu(k,619) = lu(k,619) - lu(k,398) * lu(k,616) - lu(k,620) = lu(k,620) - lu(k,399) * lu(k,616) - lu(k,621) = lu(k,621) - lu(k,400) * lu(k,616) - lu(k,622) = lu(k,622) - lu(k,401) * lu(k,616) - lu(k,623) = lu(k,623) - lu(k,402) * lu(k,616) - lu(k,624) = lu(k,624) - lu(k,403) * lu(k,616) - lu(k,625) = lu(k,625) - lu(k,404) * lu(k,616) - lu(k,626) = lu(k,626) - lu(k,405) * lu(k,616) - lu(k,627) = lu(k,627) - lu(k,406) * lu(k,616) - lu(k,628) = lu(k,628) - lu(k,407) * lu(k,616) - lu(k,629) = lu(k,629) - lu(k,408) * lu(k,616) - lu(k,654) = lu(k,654) - lu(k,396) * lu(k,653) - lu(k,655) = lu(k,655) - lu(k,397) * lu(k,653) - lu(k,656) = lu(k,656) - lu(k,398) * lu(k,653) - lu(k,657) = lu(k,657) - lu(k,399) * lu(k,653) - lu(k,658) = lu(k,658) - lu(k,400) * lu(k,653) - lu(k,659) = lu(k,659) - lu(k,401) * lu(k,653) - lu(k,660) = lu(k,660) - lu(k,402) * lu(k,653) - lu(k,661) = lu(k,661) - lu(k,403) * lu(k,653) - lu(k,662) = lu(k,662) - lu(k,404) * lu(k,653) - lu(k,663) = lu(k,663) - lu(k,405) * lu(k,653) - lu(k,664) = lu(k,664) - lu(k,406) * lu(k,653) - lu(k,665) = lu(k,665) - lu(k,407) * lu(k,653) - lu(k,666) = lu(k,666) - lu(k,408) * lu(k,653) - lu(k,676) = lu(k,676) - lu(k,396) * lu(k,675) - lu(k,677) = lu(k,677) - lu(k,397) * lu(k,675) - lu(k,678) = lu(k,678) - lu(k,398) * lu(k,675) - lu(k,679) = lu(k,679) - lu(k,399) * lu(k,675) - lu(k,680) = lu(k,680) - lu(k,400) * lu(k,675) - lu(k,681) = lu(k,681) - lu(k,401) * lu(k,675) - lu(k,682) = lu(k,682) - lu(k,402) * lu(k,675) - lu(k,683) = lu(k,683) - lu(k,403) * lu(k,675) - lu(k,684) = lu(k,684) - lu(k,404) * lu(k,675) - lu(k,685) = lu(k,685) - lu(k,405) * lu(k,675) - lu(k,686) = lu(k,686) - lu(k,406) * lu(k,675) - lu(k,687) = lu(k,687) - lu(k,407) * lu(k,675) - lu(k,688) = lu(k,688) - lu(k,408) * lu(k,675) - lu(k,704) = lu(k,704) - lu(k,396) * lu(k,703) - lu(k,705) = lu(k,705) - lu(k,397) * lu(k,703) - lu(k,706) = lu(k,706) - lu(k,398) * lu(k,703) - lu(k,707) = lu(k,707) - lu(k,399) * lu(k,703) - lu(k,708) = lu(k,708) - lu(k,400) * lu(k,703) - lu(k,709) = lu(k,709) - lu(k,401) * lu(k,703) - lu(k,710) = lu(k,710) - lu(k,402) * lu(k,703) - lu(k,711) = lu(k,711) - lu(k,403) * lu(k,703) - lu(k,712) = lu(k,712) - lu(k,404) * lu(k,703) - lu(k,713) = lu(k,713) - lu(k,405) * lu(k,703) - lu(k,714) = lu(k,714) - lu(k,406) * lu(k,703) - lu(k,715) = lu(k,715) - lu(k,407) * lu(k,703) - lu(k,716) = lu(k,716) - lu(k,408) * lu(k,703) - lu(k,727) = lu(k,727) - lu(k,396) * lu(k,726) - lu(k,728) = lu(k,728) - lu(k,397) * lu(k,726) - lu(k,729) = lu(k,729) - lu(k,398) * lu(k,726) - lu(k,730) = lu(k,730) - lu(k,399) * lu(k,726) - lu(k,731) = lu(k,731) - lu(k,400) * lu(k,726) - lu(k,732) = lu(k,732) - lu(k,401) * lu(k,726) - lu(k,733) = lu(k,733) - lu(k,402) * lu(k,726) - lu(k,734) = lu(k,734) - lu(k,403) * lu(k,726) - lu(k,735) = lu(k,735) - lu(k,404) * lu(k,726) - lu(k,736) = lu(k,736) - lu(k,405) * lu(k,726) - lu(k,737) = lu(k,737) - lu(k,406) * lu(k,726) - lu(k,738) = lu(k,738) - lu(k,407) * lu(k,726) - lu(k,739) = lu(k,739) - lu(k,408) * lu(k,726) - lu(k,752) = lu(k,752) - lu(k,396) * lu(k,751) - lu(k,753) = lu(k,753) - lu(k,397) * lu(k,751) - lu(k,754) = lu(k,754) - lu(k,398) * lu(k,751) - lu(k,755) = lu(k,755) - lu(k,399) * lu(k,751) - lu(k,756) = lu(k,756) - lu(k,400) * lu(k,751) - lu(k,757) = lu(k,757) - lu(k,401) * lu(k,751) - lu(k,758) = lu(k,758) - lu(k,402) * lu(k,751) - lu(k,759) = lu(k,759) - lu(k,403) * lu(k,751) - lu(k,760) = lu(k,760) - lu(k,404) * lu(k,751) - lu(k,761) = lu(k,761) - lu(k,405) * lu(k,751) - lu(k,762) = lu(k,762) - lu(k,406) * lu(k,751) - lu(k,763) = lu(k,763) - lu(k,407) * lu(k,751) - lu(k,764) = lu(k,764) - lu(k,408) * lu(k,751) - lu(k,421) = 1._r8 / lu(k,421) - lu(k,422) = lu(k,422) * lu(k,421) - lu(k,423) = lu(k,423) * lu(k,421) - lu(k,424) = lu(k,424) * lu(k,421) - lu(k,425) = lu(k,425) * lu(k,421) - lu(k,426) = lu(k,426) * lu(k,421) - lu(k,427) = lu(k,427) * lu(k,421) - lu(k,428) = lu(k,428) * lu(k,421) - lu(k,429) = lu(k,429) * lu(k,421) - lu(k,430) = lu(k,430) * lu(k,421) - lu(k,431) = lu(k,431) * lu(k,421) - lu(k,432) = lu(k,432) * lu(k,421) - lu(k,433) = lu(k,433) * lu(k,421) - lu(k,450) = lu(k,450) - lu(k,422) * lu(k,449) - lu(k,451) = lu(k,451) - lu(k,423) * lu(k,449) - lu(k,452) = lu(k,452) - lu(k,424) * lu(k,449) - lu(k,453) = lu(k,453) - lu(k,425) * lu(k,449) - lu(k,454) = lu(k,454) - lu(k,426) * lu(k,449) - lu(k,455) = lu(k,455) - lu(k,427) * lu(k,449) - lu(k,456) = lu(k,456) - lu(k,428) * lu(k,449) - lu(k,457) = lu(k,457) - lu(k,429) * lu(k,449) - lu(k,458) = lu(k,458) - lu(k,430) * lu(k,449) - lu(k,459) = lu(k,459) - lu(k,431) * lu(k,449) - lu(k,460) = lu(k,460) - lu(k,432) * lu(k,449) - lu(k,461) = lu(k,461) - lu(k,433) * lu(k,449) - lu(k,493) = lu(k,493) - lu(k,422) * lu(k,492) - lu(k,494) = lu(k,494) - lu(k,423) * lu(k,492) - lu(k,495) = lu(k,495) - lu(k,424) * lu(k,492) - lu(k,496) = lu(k,496) - lu(k,425) * lu(k,492) - lu(k,497) = lu(k,497) - lu(k,426) * lu(k,492) - lu(k,498) = lu(k,498) - lu(k,427) * lu(k,492) - lu(k,499) = lu(k,499) - lu(k,428) * lu(k,492) - lu(k,500) = lu(k,500) - lu(k,429) * lu(k,492) - lu(k,501) = lu(k,501) - lu(k,430) * lu(k,492) - lu(k,502) = lu(k,502) - lu(k,431) * lu(k,492) - lu(k,503) = lu(k,503) - lu(k,432) * lu(k,492) - lu(k,504) = lu(k,504) - lu(k,433) * lu(k,492) - lu(k,515) = lu(k,515) - lu(k,422) * lu(k,514) - lu(k,516) = lu(k,516) - lu(k,423) * lu(k,514) - lu(k,517) = lu(k,517) - lu(k,424) * lu(k,514) - lu(k,518) = lu(k,518) - lu(k,425) * lu(k,514) - lu(k,519) = lu(k,519) - lu(k,426) * lu(k,514) - lu(k,520) = lu(k,520) - lu(k,427) * lu(k,514) - lu(k,521) = lu(k,521) - lu(k,428) * lu(k,514) - lu(k,522) = lu(k,522) - lu(k,429) * lu(k,514) - lu(k,523) = lu(k,523) - lu(k,430) * lu(k,514) - lu(k,524) = lu(k,524) - lu(k,431) * lu(k,514) - lu(k,525) = lu(k,525) - lu(k,432) * lu(k,514) - lu(k,526) = lu(k,526) - lu(k,433) * lu(k,514) - lu(k,540) = lu(k,540) - lu(k,422) * lu(k,539) - lu(k,541) = lu(k,541) - lu(k,423) * lu(k,539) - lu(k,542) = lu(k,542) - lu(k,424) * lu(k,539) - lu(k,543) = lu(k,543) - lu(k,425) * lu(k,539) - lu(k,544) = lu(k,544) - lu(k,426) * lu(k,539) - lu(k,545) = lu(k,545) - lu(k,427) * lu(k,539) - lu(k,546) = lu(k,546) - lu(k,428) * lu(k,539) - lu(k,547) = lu(k,547) - lu(k,429) * lu(k,539) - lu(k,548) = lu(k,548) - lu(k,430) * lu(k,539) - lu(k,549) = lu(k,549) - lu(k,431) * lu(k,539) - lu(k,550) = lu(k,550) - lu(k,432) * lu(k,539) - lu(k,551) = lu(k,551) - lu(k,433) * lu(k,539) - lu(k,561) = lu(k,561) - lu(k,422) * lu(k,560) - lu(k,562) = lu(k,562) - lu(k,423) * lu(k,560) - lu(k,563) = lu(k,563) - lu(k,424) * lu(k,560) - lu(k,564) = lu(k,564) - lu(k,425) * lu(k,560) - lu(k,565) = lu(k,565) - lu(k,426) * lu(k,560) - lu(k,566) = lu(k,566) - lu(k,427) * lu(k,560) - lu(k,567) = lu(k,567) - lu(k,428) * lu(k,560) - lu(k,568) = lu(k,568) - lu(k,429) * lu(k,560) - lu(k,569) = lu(k,569) - lu(k,430) * lu(k,560) - lu(k,570) = lu(k,570) - lu(k,431) * lu(k,560) - lu(k,571) = lu(k,571) - lu(k,432) * lu(k,560) - lu(k,572) = lu(k,572) - lu(k,433) * lu(k,560) - lu(k,587) = lu(k,587) - lu(k,422) * lu(k,586) - lu(k,588) = lu(k,588) - lu(k,423) * lu(k,586) - lu(k,589) = lu(k,589) - lu(k,424) * lu(k,586) - lu(k,590) = lu(k,590) - lu(k,425) * lu(k,586) - lu(k,591) = lu(k,591) - lu(k,426) * lu(k,586) - lu(k,592) = lu(k,592) - lu(k,427) * lu(k,586) - lu(k,593) = lu(k,593) - lu(k,428) * lu(k,586) - lu(k,594) = lu(k,594) - lu(k,429) * lu(k,586) - lu(k,595) = lu(k,595) - lu(k,430) * lu(k,586) - lu(k,596) = lu(k,596) - lu(k,431) * lu(k,586) - lu(k,597) = lu(k,597) - lu(k,432) * lu(k,586) - lu(k,598) = lu(k,598) - lu(k,433) * lu(k,586) - lu(k,618) = lu(k,618) - lu(k,422) * lu(k,617) - lu(k,619) = lu(k,619) - lu(k,423) * lu(k,617) - lu(k,620) = lu(k,620) - lu(k,424) * lu(k,617) - lu(k,621) = lu(k,621) - lu(k,425) * lu(k,617) - lu(k,622) = lu(k,622) - lu(k,426) * lu(k,617) - lu(k,623) = lu(k,623) - lu(k,427) * lu(k,617) - lu(k,624) = lu(k,624) - lu(k,428) * lu(k,617) - lu(k,625) = lu(k,625) - lu(k,429) * lu(k,617) - lu(k,626) = lu(k,626) - lu(k,430) * lu(k,617) - lu(k,627) = lu(k,627) - lu(k,431) * lu(k,617) - lu(k,628) = lu(k,628) - lu(k,432) * lu(k,617) - lu(k,629) = lu(k,629) - lu(k,433) * lu(k,617) - lu(k,655) = lu(k,655) - lu(k,422) * lu(k,654) - lu(k,656) = lu(k,656) - lu(k,423) * lu(k,654) - lu(k,657) = lu(k,657) - lu(k,424) * lu(k,654) - lu(k,658) = lu(k,658) - lu(k,425) * lu(k,654) - lu(k,659) = lu(k,659) - lu(k,426) * lu(k,654) - lu(k,660) = lu(k,660) - lu(k,427) * lu(k,654) - lu(k,661) = lu(k,661) - lu(k,428) * lu(k,654) - lu(k,662) = lu(k,662) - lu(k,429) * lu(k,654) - lu(k,663) = lu(k,663) - lu(k,430) * lu(k,654) - lu(k,664) = lu(k,664) - lu(k,431) * lu(k,654) - lu(k,665) = lu(k,665) - lu(k,432) * lu(k,654) - lu(k,666) = lu(k,666) - lu(k,433) * lu(k,654) - lu(k,677) = lu(k,677) - lu(k,422) * lu(k,676) - lu(k,678) = lu(k,678) - lu(k,423) * lu(k,676) - lu(k,679) = lu(k,679) - lu(k,424) * lu(k,676) - lu(k,680) = lu(k,680) - lu(k,425) * lu(k,676) - lu(k,681) = lu(k,681) - lu(k,426) * lu(k,676) - lu(k,682) = lu(k,682) - lu(k,427) * lu(k,676) - lu(k,683) = lu(k,683) - lu(k,428) * lu(k,676) - lu(k,684) = lu(k,684) - lu(k,429) * lu(k,676) - lu(k,685) = lu(k,685) - lu(k,430) * lu(k,676) - lu(k,686) = lu(k,686) - lu(k,431) * lu(k,676) - lu(k,687) = lu(k,687) - lu(k,432) * lu(k,676) - lu(k,688) = lu(k,688) - lu(k,433) * lu(k,676) - lu(k,705) = lu(k,705) - lu(k,422) * lu(k,704) - lu(k,706) = lu(k,706) - lu(k,423) * lu(k,704) - lu(k,707) = lu(k,707) - lu(k,424) * lu(k,704) - lu(k,708) = lu(k,708) - lu(k,425) * lu(k,704) - lu(k,709) = lu(k,709) - lu(k,426) * lu(k,704) - lu(k,710) = lu(k,710) - lu(k,427) * lu(k,704) - lu(k,711) = lu(k,711) - lu(k,428) * lu(k,704) - lu(k,712) = lu(k,712) - lu(k,429) * lu(k,704) - lu(k,713) = lu(k,713) - lu(k,430) * lu(k,704) - lu(k,714) = lu(k,714) - lu(k,431) * lu(k,704) - lu(k,715) = lu(k,715) - lu(k,432) * lu(k,704) - lu(k,716) = lu(k,716) - lu(k,433) * lu(k,704) - lu(k,728) = lu(k,728) - lu(k,422) * lu(k,727) - lu(k,729) = lu(k,729) - lu(k,423) * lu(k,727) - lu(k,730) = lu(k,730) - lu(k,424) * lu(k,727) - lu(k,731) = lu(k,731) - lu(k,425) * lu(k,727) - lu(k,732) = lu(k,732) - lu(k,426) * lu(k,727) - lu(k,733) = lu(k,733) - lu(k,427) * lu(k,727) - lu(k,734) = lu(k,734) - lu(k,428) * lu(k,727) - lu(k,735) = lu(k,735) - lu(k,429) * lu(k,727) - lu(k,736) = lu(k,736) - lu(k,430) * lu(k,727) - lu(k,737) = lu(k,737) - lu(k,431) * lu(k,727) - lu(k,738) = lu(k,738) - lu(k,432) * lu(k,727) - lu(k,739) = lu(k,739) - lu(k,433) * lu(k,727) - lu(k,753) = lu(k,753) - lu(k,422) * lu(k,752) - lu(k,754) = lu(k,754) - lu(k,423) * lu(k,752) - lu(k,755) = lu(k,755) - lu(k,424) * lu(k,752) - lu(k,756) = lu(k,756) - lu(k,425) * lu(k,752) - lu(k,757) = lu(k,757) - lu(k,426) * lu(k,752) - lu(k,758) = lu(k,758) - lu(k,427) * lu(k,752) - lu(k,759) = lu(k,759) - lu(k,428) * lu(k,752) - lu(k,760) = lu(k,760) - lu(k,429) * lu(k,752) - lu(k,761) = lu(k,761) - lu(k,430) * lu(k,752) - lu(k,762) = lu(k,762) - lu(k,431) * lu(k,752) - lu(k,763) = lu(k,763) - lu(k,432) * lu(k,752) - lu(k,764) = lu(k,764) - lu(k,433) * lu(k,752) + lu(k,375) = 1._r8 / lu(k,375) + lu(k,376) = lu(k,376) * lu(k,375) + lu(k,377) = lu(k,377) * lu(k,375) + lu(k,378) = lu(k,378) * lu(k,375) + lu(k,379) = lu(k,379) * lu(k,375) + lu(k,380) = lu(k,380) * lu(k,375) + lu(k,381) = lu(k,381) * lu(k,375) + lu(k,382) = lu(k,382) * lu(k,375) + lu(k,383) = lu(k,383) * lu(k,375) + lu(k,392) = lu(k,392) - lu(k,376) * lu(k,389) + lu(k,395) = lu(k,395) - lu(k,377) * lu(k,389) + lu(k,396) = lu(k,396) - lu(k,378) * lu(k,389) + lu(k,398) = lu(k,398) - lu(k,379) * lu(k,389) + lu(k,399) = lu(k,399) - lu(k,380) * lu(k,389) + lu(k,400) = lu(k,400) - lu(k,381) * lu(k,389) + lu(k,401) = lu(k,401) - lu(k,382) * lu(k,389) + lu(k,402) = lu(k,402) - lu(k,383) * lu(k,389) + lu(k,470) = lu(k,470) - lu(k,376) * lu(k,469) + lu(k,473) = lu(k,473) - lu(k,377) * lu(k,469) + lu(k,475) = lu(k,475) - lu(k,378) * lu(k,469) + lu(k,478) = lu(k,478) - lu(k,379) * lu(k,469) + lu(k,479) = lu(k,479) - lu(k,380) * lu(k,469) + lu(k,480) = lu(k,480) - lu(k,381) * lu(k,469) + lu(k,483) = lu(k,483) - lu(k,382) * lu(k,469) + lu(k,484) = lu(k,484) - lu(k,383) * lu(k,469) + lu(k,504) = lu(k,504) - lu(k,376) * lu(k,502) + lu(k,505) = lu(k,505) - lu(k,377) * lu(k,502) + lu(k,507) = lu(k,507) - lu(k,378) * lu(k,502) + lu(k,509) = lu(k,509) - lu(k,379) * lu(k,502) + lu(k,510) = lu(k,510) - lu(k,380) * lu(k,502) + lu(k,511) = lu(k,511) - lu(k,381) * lu(k,502) + lu(k,514) = lu(k,514) - lu(k,382) * lu(k,502) + lu(k,515) = lu(k,515) - lu(k,383) * lu(k,502) + lu(k,601) = lu(k,601) - lu(k,376) * lu(k,599) + lu(k,603) = lu(k,603) - lu(k,377) * lu(k,599) + lu(k,605) = lu(k,605) - lu(k,378) * lu(k,599) + lu(k,608) = lu(k,608) - lu(k,379) * lu(k,599) + lu(k,609) = lu(k,609) - lu(k,380) * lu(k,599) + lu(k,610) = lu(k,610) - lu(k,381) * lu(k,599) + lu(k,613) = lu(k,613) - lu(k,382) * lu(k,599) + lu(k,614) = lu(k,614) - lu(k,383) * lu(k,599) + lu(k,642) = lu(k,642) - lu(k,376) * lu(k,640) + lu(k,645) = lu(k,645) - lu(k,377) * lu(k,640) + lu(k,647) = lu(k,647) - lu(k,378) * lu(k,640) + lu(k,650) = lu(k,650) - lu(k,379) * lu(k,640) + lu(k,651) = lu(k,651) - lu(k,380) * lu(k,640) + lu(k,652) = lu(k,652) - lu(k,381) * lu(k,640) + lu(k,655) = lu(k,655) - lu(k,382) * lu(k,640) + lu(k,656) = lu(k,656) - lu(k,383) * lu(k,640) + lu(k,668) = lu(k,668) - lu(k,376) * lu(k,666) + lu(k,670) = lu(k,670) - lu(k,377) * lu(k,666) + lu(k,672) = lu(k,672) - lu(k,378) * lu(k,666) + lu(k,675) = lu(k,675) - lu(k,379) * lu(k,666) + lu(k,676) = lu(k,676) - lu(k,380) * lu(k,666) + lu(k,677) = lu(k,677) - lu(k,381) * lu(k,666) + lu(k,680) = lu(k,680) - lu(k,382) * lu(k,666) + lu(k,681) = lu(k,681) - lu(k,383) * lu(k,666) + lu(k,756) = lu(k,756) - lu(k,376) * lu(k,755) + lu(k,758) = lu(k,758) - lu(k,377) * lu(k,755) + lu(k,760) = lu(k,760) - lu(k,378) * lu(k,755) + lu(k,763) = lu(k,763) - lu(k,379) * lu(k,755) + lu(k,764) = lu(k,764) - lu(k,380) * lu(k,755) + lu(k,765) = lu(k,765) - lu(k,381) * lu(k,755) + lu(k,768) = lu(k,768) - lu(k,382) * lu(k,755) + lu(k,769) = lu(k,769) - lu(k,383) * lu(k,755) + lu(k,785) = lu(k,785) - lu(k,376) * lu(k,783) + lu(k,787) = lu(k,787) - lu(k,377) * lu(k,783) + lu(k,789) = lu(k,789) - lu(k,378) * lu(k,783) + lu(k,792) = lu(k,792) - lu(k,379) * lu(k,783) + lu(k,793) = lu(k,793) - lu(k,380) * lu(k,783) + lu(k,794) = lu(k,794) - lu(k,381) * lu(k,783) + lu(k,797) = lu(k,797) - lu(k,382) * lu(k,783) + lu(k,798) = lu(k,798) - lu(k,383) * lu(k,783) + lu(k,833) = lu(k,833) - lu(k,376) * lu(k,829) + lu(k,836) = lu(k,836) - lu(k,377) * lu(k,829) + lu(k,838) = lu(k,838) - lu(k,378) * lu(k,829) + lu(k,841) = lu(k,841) - lu(k,379) * lu(k,829) + lu(k,842) = lu(k,842) - lu(k,380) * lu(k,829) + lu(k,843) = lu(k,843) - lu(k,381) * lu(k,829) + lu(k,846) = lu(k,846) - lu(k,382) * lu(k,829) + lu(k,847) = lu(k,847) - lu(k,383) * lu(k,829) + lu(k,888) = lu(k,888) - lu(k,376) * lu(k,885) + lu(k,891) = lu(k,891) - lu(k,377) * lu(k,885) + lu(k,893) = lu(k,893) - lu(k,378) * lu(k,885) + lu(k,896) = lu(k,896) - lu(k,379) * lu(k,885) + lu(k,897) = lu(k,897) - lu(k,380) * lu(k,885) + lu(k,898) = lu(k,898) - lu(k,381) * lu(k,885) + lu(k,901) = lu(k,901) - lu(k,382) * lu(k,885) + lu(k,902) = lu(k,902) - lu(k,383) * lu(k,885) + lu(k,390) = 1._r8 / lu(k,390) + lu(k,391) = lu(k,391) * lu(k,390) + lu(k,392) = lu(k,392) * lu(k,390) + lu(k,393) = lu(k,393) * lu(k,390) + lu(k,394) = lu(k,394) * lu(k,390) + lu(k,395) = lu(k,395) * lu(k,390) + lu(k,396) = lu(k,396) * lu(k,390) + lu(k,397) = lu(k,397) * lu(k,390) + lu(k,398) = lu(k,398) * lu(k,390) + lu(k,399) = lu(k,399) * lu(k,390) + lu(k,400) = lu(k,400) * lu(k,390) + lu(k,401) = lu(k,401) * lu(k,390) + lu(k,402) = lu(k,402) * lu(k,390) + lu(k,403) = lu(k,403) * lu(k,390) + lu(k,404) = lu(k,404) * lu(k,390) + lu(k,405) = lu(k,405) * lu(k,390) + lu(k,406) = lu(k,406) * lu(k,390) + lu(k,708) = lu(k,708) - lu(k,391) * lu(k,707) + lu(k,709) = lu(k,709) - lu(k,392) * lu(k,707) + lu(k,710) = lu(k,710) - lu(k,393) * lu(k,707) + lu(k,711) = lu(k,711) - lu(k,394) * lu(k,707) + lu(k,712) = lu(k,712) - lu(k,395) * lu(k,707) + lu(k,714) = lu(k,714) - lu(k,396) * lu(k,707) + lu(k,716) = lu(k,716) - lu(k,397) * lu(k,707) + lu(k,717) = lu(k,717) - lu(k,398) * lu(k,707) + lu(k,718) = lu(k,718) - lu(k,399) * lu(k,707) + lu(k,719) = lu(k,719) - lu(k,400) * lu(k,707) + lu(k,722) = - lu(k,401) * lu(k,707) + lu(k,723) = lu(k,723) - lu(k,402) * lu(k,707) + lu(k,724) = lu(k,724) - lu(k,403) * lu(k,707) + lu(k,725) = lu(k,725) - lu(k,404) * lu(k,707) + lu(k,726) = lu(k,726) - lu(k,405) * lu(k,707) + lu(k,727) = lu(k,727) - lu(k,406) * lu(k,707) + lu(k,831) = lu(k,831) - lu(k,391) * lu(k,830) + lu(k,833) = lu(k,833) - lu(k,392) * lu(k,830) + lu(k,834) = lu(k,834) - lu(k,393) * lu(k,830) + lu(k,835) = lu(k,835) - lu(k,394) * lu(k,830) + lu(k,836) = lu(k,836) - lu(k,395) * lu(k,830) + lu(k,838) = lu(k,838) - lu(k,396) * lu(k,830) + lu(k,840) = lu(k,840) - lu(k,397) * lu(k,830) + lu(k,841) = lu(k,841) - lu(k,398) * lu(k,830) + lu(k,842) = lu(k,842) - lu(k,399) * lu(k,830) + lu(k,843) = lu(k,843) - lu(k,400) * lu(k,830) + lu(k,846) = lu(k,846) - lu(k,401) * lu(k,830) + lu(k,847) = lu(k,847) - lu(k,402) * lu(k,830) + lu(k,848) = lu(k,848) - lu(k,403) * lu(k,830) + lu(k,849) = lu(k,849) - lu(k,404) * lu(k,830) + lu(k,850) = lu(k,850) - lu(k,405) * lu(k,830) + lu(k,851) = lu(k,851) - lu(k,406) * lu(k,830) + lu(k,855) = lu(k,855) - lu(k,391) * lu(k,854) + lu(k,856) = lu(k,856) - lu(k,392) * lu(k,854) + lu(k,857) = - lu(k,393) * lu(k,854) + lu(k,858) = - lu(k,394) * lu(k,854) + lu(k,859) = - lu(k,395) * lu(k,854) + lu(k,861) = - lu(k,396) * lu(k,854) + lu(k,863) = lu(k,863) - lu(k,397) * lu(k,854) + lu(k,864) = - lu(k,398) * lu(k,854) + lu(k,865) = - lu(k,399) * lu(k,854) + lu(k,866) = - lu(k,400) * lu(k,854) + lu(k,869) = lu(k,869) - lu(k,401) * lu(k,854) + lu(k,870) = lu(k,870) - lu(k,402) * lu(k,854) + lu(k,871) = lu(k,871) - lu(k,403) * lu(k,854) + lu(k,872) = - lu(k,404) * lu(k,854) + lu(k,873) = lu(k,873) - lu(k,405) * lu(k,854) + lu(k,874) = lu(k,874) - lu(k,406) * lu(k,854) + lu(k,887) = lu(k,887) - lu(k,391) * lu(k,886) + lu(k,888) = lu(k,888) - lu(k,392) * lu(k,886) + lu(k,889) = lu(k,889) - lu(k,393) * lu(k,886) + lu(k,890) = lu(k,890) - lu(k,394) * lu(k,886) + lu(k,891) = lu(k,891) - lu(k,395) * lu(k,886) + lu(k,893) = lu(k,893) - lu(k,396) * lu(k,886) + lu(k,895) = lu(k,895) - lu(k,397) * lu(k,886) + lu(k,896) = lu(k,896) - lu(k,398) * lu(k,886) + lu(k,897) = lu(k,897) - lu(k,399) * lu(k,886) + lu(k,898) = lu(k,898) - lu(k,400) * lu(k,886) + lu(k,901) = lu(k,901) - lu(k,401) * lu(k,886) + lu(k,902) = lu(k,902) - lu(k,402) * lu(k,886) + lu(k,903) = lu(k,903) - lu(k,403) * lu(k,886) + lu(k,904) = lu(k,904) - lu(k,404) * lu(k,886) + lu(k,905) = lu(k,905) - lu(k,405) * lu(k,886) + lu(k,906) = lu(k,906) - lu(k,406) * lu(k,886) + lu(k,910) = lu(k,910) - lu(k,391) * lu(k,909) + lu(k,911) = lu(k,911) - lu(k,392) * lu(k,909) + lu(k,912) = lu(k,912) - lu(k,393) * lu(k,909) + lu(k,913) = - lu(k,394) * lu(k,909) + lu(k,914) = - lu(k,395) * lu(k,909) + lu(k,916) = - lu(k,396) * lu(k,909) + lu(k,918) = lu(k,918) - lu(k,397) * lu(k,909) + lu(k,919) = lu(k,919) - lu(k,398) * lu(k,909) + lu(k,920) = - lu(k,399) * lu(k,909) + lu(k,921) = lu(k,921) - lu(k,400) * lu(k,909) + lu(k,924) = - lu(k,401) * lu(k,909) + lu(k,925) = lu(k,925) - lu(k,402) * lu(k,909) + lu(k,926) = lu(k,926) - lu(k,403) * lu(k,909) + lu(k,927) = lu(k,927) - lu(k,404) * lu(k,909) + lu(k,928) = lu(k,928) - lu(k,405) * lu(k,909) + lu(k,929) = lu(k,929) - lu(k,406) * lu(k,909) + lu(k,936) = lu(k,936) - lu(k,391) * lu(k,935) + lu(k,938) = lu(k,938) - lu(k,392) * lu(k,935) + lu(k,939) = - lu(k,393) * lu(k,935) + lu(k,940) = - lu(k,394) * lu(k,935) + lu(k,941) = - lu(k,395) * lu(k,935) + lu(k,943) = lu(k,943) - lu(k,396) * lu(k,935) + lu(k,945) = lu(k,945) - lu(k,397) * lu(k,935) + lu(k,946) = lu(k,946) - lu(k,398) * lu(k,935) + lu(k,947) = - lu(k,399) * lu(k,935) + lu(k,948) = lu(k,948) - lu(k,400) * lu(k,935) + lu(k,951) = - lu(k,401) * lu(k,935) + lu(k,952) = lu(k,952) - lu(k,402) * lu(k,935) + lu(k,953) = lu(k,953) - lu(k,403) * lu(k,935) + lu(k,954) = - lu(k,404) * lu(k,935) + lu(k,955) = lu(k,955) - lu(k,405) * lu(k,935) + lu(k,956) = lu(k,956) - lu(k,406) * lu(k,935) + 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,416) = lu(k,416) * lu(k,408) + lu(k,417) = lu(k,417) * lu(k,408) + lu(k,418) = lu(k,418) * lu(k,408) + lu(k,547) = lu(k,547) - lu(k,409) * lu(k,546) + lu(k,549) = lu(k,549) - lu(k,410) * lu(k,546) + lu(k,550) = lu(k,550) - lu(k,411) * lu(k,546) + lu(k,552) = lu(k,552) - lu(k,412) * lu(k,546) + lu(k,553) = lu(k,553) - lu(k,413) * lu(k,546) + lu(k,556) = lu(k,556) - lu(k,414) * lu(k,546) + lu(k,560) = lu(k,560) - lu(k,415) * lu(k,546) + lu(k,561) = lu(k,561) - lu(k,416) * lu(k,546) + lu(k,563) = lu(k,563) - lu(k,417) * lu(k,546) + lu(k,565) = lu(k,565) - lu(k,418) * lu(k,546) + lu(k,575) = - lu(k,409) * lu(k,573) + lu(k,577) = lu(k,577) - lu(k,410) * lu(k,573) + lu(k,578) = lu(k,578) - lu(k,411) * lu(k,573) + lu(k,580) = lu(k,580) - lu(k,412) * lu(k,573) + lu(k,581) = lu(k,581) - lu(k,413) * lu(k,573) + lu(k,584) = lu(k,584) - lu(k,414) * lu(k,573) + lu(k,588) = lu(k,588) - lu(k,415) * lu(k,573) + lu(k,589) = lu(k,589) - lu(k,416) * lu(k,573) + lu(k,591) = lu(k,591) - lu(k,417) * lu(k,573) + lu(k,593) = lu(k,593) - lu(k,418) * lu(k,573) + lu(k,668) = lu(k,668) - lu(k,409) * lu(k,667) + lu(k,669) = lu(k,669) - lu(k,410) * lu(k,667) + lu(k,670) = lu(k,670) - lu(k,411) * lu(k,667) + lu(k,672) = lu(k,672) - lu(k,412) * lu(k,667) + lu(k,673) = lu(k,673) - lu(k,413) * lu(k,667) + lu(k,676) = lu(k,676) - lu(k,414) * lu(k,667) + lu(k,680) = lu(k,680) - lu(k,415) * lu(k,667) + lu(k,681) = lu(k,681) - lu(k,416) * lu(k,667) + lu(k,683) = lu(k,683) - lu(k,417) * lu(k,667) + lu(k,685) = - lu(k,418) * lu(k,667) + lu(k,709) = lu(k,709) - lu(k,409) * lu(k,708) + lu(k,711) = lu(k,711) - lu(k,410) * lu(k,708) + lu(k,712) = lu(k,712) - lu(k,411) * lu(k,708) + lu(k,714) = lu(k,714) - lu(k,412) * lu(k,708) + lu(k,715) = lu(k,715) - lu(k,413) * lu(k,708) + lu(k,718) = lu(k,718) - lu(k,414) * lu(k,708) + lu(k,722) = lu(k,722) - lu(k,415) * lu(k,708) + lu(k,723) = lu(k,723) - lu(k,416) * lu(k,708) + lu(k,725) = lu(k,725) - lu(k,417) * lu(k,708) + lu(k,727) = lu(k,727) - lu(k,418) * lu(k,708) + lu(k,833) = lu(k,833) - lu(k,409) * lu(k,831) + lu(k,835) = lu(k,835) - lu(k,410) * lu(k,831) + lu(k,836) = lu(k,836) - lu(k,411) * lu(k,831) + lu(k,838) = lu(k,838) - lu(k,412) * lu(k,831) + lu(k,839) = lu(k,839) - lu(k,413) * lu(k,831) + lu(k,842) = lu(k,842) - lu(k,414) * lu(k,831) + lu(k,846) = lu(k,846) - lu(k,415) * lu(k,831) + lu(k,847) = lu(k,847) - lu(k,416) * lu(k,831) + lu(k,849) = lu(k,849) - lu(k,417) * lu(k,831) + lu(k,851) = lu(k,851) - lu(k,418) * lu(k,831) + lu(k,856) = lu(k,856) - lu(k,409) * lu(k,855) + lu(k,858) = lu(k,858) - lu(k,410) * lu(k,855) + lu(k,859) = lu(k,859) - lu(k,411) * lu(k,855) + lu(k,861) = lu(k,861) - lu(k,412) * lu(k,855) + lu(k,862) = - lu(k,413) * lu(k,855) + lu(k,865) = lu(k,865) - lu(k,414) * lu(k,855) + lu(k,869) = lu(k,869) - lu(k,415) * lu(k,855) + lu(k,870) = lu(k,870) - lu(k,416) * lu(k,855) + lu(k,872) = lu(k,872) - lu(k,417) * lu(k,855) + lu(k,874) = lu(k,874) - lu(k,418) * lu(k,855) + lu(k,888) = lu(k,888) - lu(k,409) * lu(k,887) + lu(k,890) = lu(k,890) - lu(k,410) * lu(k,887) + lu(k,891) = lu(k,891) - lu(k,411) * lu(k,887) + lu(k,893) = lu(k,893) - lu(k,412) * lu(k,887) + lu(k,894) = lu(k,894) - lu(k,413) * lu(k,887) + lu(k,897) = lu(k,897) - lu(k,414) * lu(k,887) + lu(k,901) = lu(k,901) - lu(k,415) * lu(k,887) + lu(k,902) = lu(k,902) - lu(k,416) * lu(k,887) + lu(k,904) = lu(k,904) - lu(k,417) * lu(k,887) + lu(k,906) = lu(k,906) - lu(k,418) * lu(k,887) + lu(k,911) = lu(k,911) - lu(k,409) * lu(k,910) + lu(k,913) = lu(k,913) - lu(k,410) * lu(k,910) + lu(k,914) = lu(k,914) - lu(k,411) * lu(k,910) + lu(k,916) = lu(k,916) - lu(k,412) * lu(k,910) + lu(k,917) = - lu(k,413) * lu(k,910) + lu(k,920) = lu(k,920) - lu(k,414) * lu(k,910) + lu(k,924) = lu(k,924) - lu(k,415) * lu(k,910) + lu(k,925) = lu(k,925) - lu(k,416) * lu(k,910) + lu(k,927) = lu(k,927) - lu(k,417) * lu(k,910) + lu(k,929) = lu(k,929) - lu(k,418) * lu(k,910) + lu(k,938) = lu(k,938) - lu(k,409) * lu(k,936) + lu(k,940) = lu(k,940) - lu(k,410) * lu(k,936) + lu(k,941) = lu(k,941) - lu(k,411) * lu(k,936) + lu(k,943) = lu(k,943) - lu(k,412) * lu(k,936) + lu(k,944) = - lu(k,413) * lu(k,936) + lu(k,947) = lu(k,947) - lu(k,414) * lu(k,936) + lu(k,951) = lu(k,951) - lu(k,415) * lu(k,936) + lu(k,952) = lu(k,952) - lu(k,416) * lu(k,936) + lu(k,954) = lu(k,954) - lu(k,417) * lu(k,936) + lu(k,956) = lu(k,956) - lu(k,418) * lu(k,936) end do end subroutine lu_fac09 subroutine lu_fac10( avec_len, lu ) @@ -2611,6 +1870,287 @@ subroutine lu_fac10( avec_len, lu ) real(r8), intent(inout) :: lu(veclen,nzcnt) !----------------------------------------------------------------------- ! ... local variables +!----------------------------------------------------------------------- + integer :: k + do k = 1,avec_len + 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,428) = lu(k,428) * lu(k,422) + lu(k,429) = lu(k,429) * lu(k,422) + lu(k,430) = lu(k,430) * lu(k,422) + lu(k,431) = lu(k,431) * lu(k,422) + lu(k,432) = lu(k,432) * lu(k,422) + lu(k,433) = lu(k,433) * lu(k,422) + lu(k,434) = lu(k,434) * lu(k,422) + lu(k,435) = lu(k,435) * lu(k,422) + lu(k,504) = lu(k,504) - lu(k,423) * lu(k,503) + lu(k,505) = lu(k,505) - lu(k,424) * lu(k,503) + lu(k,506) = lu(k,506) - lu(k,425) * lu(k,503) + lu(k,507) = lu(k,507) - lu(k,426) * lu(k,503) + lu(k,508) = - lu(k,427) * lu(k,503) + lu(k,509) = lu(k,509) - lu(k,428) * lu(k,503) + lu(k,510) = lu(k,510) - lu(k,429) * lu(k,503) + lu(k,512) = - lu(k,430) * lu(k,503) + lu(k,513) = - lu(k,431) * lu(k,503) + lu(k,514) = lu(k,514) - lu(k,432) * lu(k,503) + lu(k,515) = lu(k,515) - lu(k,433) * lu(k,503) + lu(k,516) = - lu(k,434) * lu(k,503) + lu(k,518) = lu(k,518) - lu(k,435) * lu(k,503) + lu(k,524) = lu(k,524) - lu(k,423) * lu(k,523) + lu(k,525) = lu(k,525) - lu(k,424) * lu(k,523) + lu(k,526) = lu(k,526) - lu(k,425) * lu(k,523) + lu(k,527) = lu(k,527) - lu(k,426) * lu(k,523) + lu(k,528) = lu(k,528) - lu(k,427) * lu(k,523) + lu(k,530) = lu(k,530) - lu(k,428) * lu(k,523) + lu(k,531) = lu(k,531) - lu(k,429) * lu(k,523) + lu(k,533) = lu(k,533) - lu(k,430) * lu(k,523) + lu(k,534) = lu(k,534) - lu(k,431) * lu(k,523) + lu(k,535) = lu(k,535) - lu(k,432) * lu(k,523) + lu(k,536) = lu(k,536) - lu(k,433) * lu(k,523) + lu(k,537) = lu(k,537) - lu(k,434) * lu(k,523) + lu(k,539) = lu(k,539) - lu(k,435) * lu(k,523) + lu(k,575) = lu(k,575) - lu(k,423) * lu(k,574) + lu(k,578) = lu(k,578) - lu(k,424) * lu(k,574) + lu(k,579) = - lu(k,425) * lu(k,574) + lu(k,580) = lu(k,580) - lu(k,426) * lu(k,574) + lu(k,581) = lu(k,581) - lu(k,427) * lu(k,574) + lu(k,583) = lu(k,583) - lu(k,428) * lu(k,574) + lu(k,584) = lu(k,584) - lu(k,429) * lu(k,574) + lu(k,586) = lu(k,586) - lu(k,430) * lu(k,574) + lu(k,587) = lu(k,587) - lu(k,431) * lu(k,574) + lu(k,588) = lu(k,588) - lu(k,432) * lu(k,574) + lu(k,589) = lu(k,589) - lu(k,433) * lu(k,574) + lu(k,591) = lu(k,591) - lu(k,434) * lu(k,574) + lu(k,593) = lu(k,593) - lu(k,435) * lu(k,574) + lu(k,601) = lu(k,601) - lu(k,423) * lu(k,600) + lu(k,603) = lu(k,603) - lu(k,424) * lu(k,600) + lu(k,604) = - lu(k,425) * lu(k,600) + lu(k,605) = lu(k,605) - lu(k,426) * lu(k,600) + lu(k,606) = - lu(k,427) * lu(k,600) + lu(k,608) = lu(k,608) - lu(k,428) * lu(k,600) + lu(k,609) = lu(k,609) - lu(k,429) * lu(k,600) + lu(k,611) = - lu(k,430) * lu(k,600) + lu(k,612) = - lu(k,431) * lu(k,600) + lu(k,613) = lu(k,613) - lu(k,432) * lu(k,600) + lu(k,614) = lu(k,614) - lu(k,433) * lu(k,600) + lu(k,616) = - lu(k,434) * lu(k,600) + lu(k,618) = lu(k,618) - lu(k,435) * lu(k,600) + lu(k,642) = lu(k,642) - lu(k,423) * lu(k,641) + lu(k,645) = lu(k,645) - lu(k,424) * lu(k,641) + lu(k,646) = lu(k,646) - lu(k,425) * lu(k,641) + lu(k,647) = lu(k,647) - lu(k,426) * lu(k,641) + lu(k,648) = lu(k,648) - lu(k,427) * lu(k,641) + lu(k,650) = lu(k,650) - lu(k,428) * lu(k,641) + lu(k,651) = lu(k,651) - lu(k,429) * lu(k,641) + lu(k,653) = lu(k,653) - lu(k,430) * lu(k,641) + lu(k,654) = lu(k,654) - lu(k,431) * lu(k,641) + lu(k,655) = lu(k,655) - lu(k,432) * lu(k,641) + lu(k,656) = lu(k,656) - lu(k,433) * lu(k,641) + lu(k,658) = lu(k,658) - lu(k,434) * lu(k,641) + lu(k,660) = lu(k,660) - lu(k,435) * lu(k,641) + lu(k,734) = - lu(k,423) * lu(k,733) + lu(k,736) = lu(k,736) - lu(k,424) * lu(k,733) + lu(k,737) = - lu(k,425) * lu(k,733) + lu(k,738) = lu(k,738) - lu(k,426) * lu(k,733) + lu(k,739) = lu(k,739) - lu(k,427) * lu(k,733) + lu(k,741) = lu(k,741) - lu(k,428) * lu(k,733) + lu(k,742) = lu(k,742) - lu(k,429) * lu(k,733) + lu(k,744) = lu(k,744) - lu(k,430) * lu(k,733) + lu(k,745) = lu(k,745) - lu(k,431) * lu(k,733) + lu(k,746) = lu(k,746) - lu(k,432) * lu(k,733) + lu(k,747) = lu(k,747) - lu(k,433) * lu(k,733) + lu(k,749) = lu(k,749) - lu(k,434) * lu(k,733) + lu(k,751) = lu(k,751) - lu(k,435) * lu(k,733) + lu(k,785) = lu(k,785) - lu(k,423) * lu(k,784) + lu(k,787) = lu(k,787) - lu(k,424) * lu(k,784) + lu(k,788) = lu(k,788) - lu(k,425) * lu(k,784) + lu(k,789) = lu(k,789) - lu(k,426) * lu(k,784) + lu(k,790) = lu(k,790) - lu(k,427) * lu(k,784) + lu(k,792) = lu(k,792) - lu(k,428) * lu(k,784) + lu(k,793) = lu(k,793) - lu(k,429) * lu(k,784) + lu(k,795) = lu(k,795) - lu(k,430) * lu(k,784) + lu(k,796) = lu(k,796) - lu(k,431) * lu(k,784) + lu(k,797) = lu(k,797) - lu(k,432) * lu(k,784) + lu(k,798) = lu(k,798) - lu(k,433) * lu(k,784) + lu(k,800) = lu(k,800) - lu(k,434) * lu(k,784) + lu(k,802) = lu(k,802) - lu(k,435) * lu(k,784) + lu(k,833) = lu(k,833) - lu(k,423) * lu(k,832) + lu(k,836) = lu(k,836) - lu(k,424) * lu(k,832) + lu(k,837) = lu(k,837) - lu(k,425) * lu(k,832) + lu(k,838) = lu(k,838) - lu(k,426) * lu(k,832) + lu(k,839) = lu(k,839) - lu(k,427) * lu(k,832) + lu(k,841) = lu(k,841) - lu(k,428) * lu(k,832) + lu(k,842) = lu(k,842) - lu(k,429) * lu(k,832) + lu(k,844) = lu(k,844) - lu(k,430) * lu(k,832) + lu(k,845) = lu(k,845) - lu(k,431) * lu(k,832) + lu(k,846) = lu(k,846) - lu(k,432) * lu(k,832) + lu(k,847) = lu(k,847) - lu(k,433) * lu(k,832) + lu(k,849) = lu(k,849) - lu(k,434) * lu(k,832) + lu(k,851) = lu(k,851) - lu(k,435) * lu(k,832) + lu(k,938) = lu(k,938) - lu(k,423) * lu(k,937) + lu(k,941) = lu(k,941) - lu(k,424) * lu(k,937) + lu(k,942) = - lu(k,425) * lu(k,937) + lu(k,943) = lu(k,943) - lu(k,426) * lu(k,937) + lu(k,944) = lu(k,944) - lu(k,427) * lu(k,937) + lu(k,946) = lu(k,946) - lu(k,428) * lu(k,937) + lu(k,947) = lu(k,947) - lu(k,429) * lu(k,937) + lu(k,949) = - lu(k,430) * lu(k,937) + lu(k,950) = - lu(k,431) * lu(k,937) + lu(k,951) = lu(k,951) - lu(k,432) * lu(k,937) + lu(k,952) = lu(k,952) - lu(k,433) * lu(k,937) + lu(k,954) = lu(k,954) - lu(k,434) * lu(k,937) + lu(k,956) = lu(k,956) - lu(k,435) * lu(k,937) + lu(k,436) = 1._r8 / lu(k,436) + lu(k,437) = lu(k,437) * lu(k,436) + lu(k,438) = lu(k,438) * lu(k,436) + lu(k,439) = lu(k,439) * lu(k,436) + lu(k,440) = lu(k,440) * lu(k,436) + lu(k,441) = lu(k,441) * lu(k,436) + lu(k,442) = lu(k,442) * lu(k,436) + lu(k,443) = lu(k,443) * lu(k,436) + lu(k,451) = - lu(k,437) * lu(k,449) + lu(k,452) = - lu(k,438) * lu(k,449) + lu(k,453) = - lu(k,439) * lu(k,449) + lu(k,456) = lu(k,456) - lu(k,440) * lu(k,449) + lu(k,461) = lu(k,461) - lu(k,441) * lu(k,449) + lu(k,464) = - lu(k,442) * lu(k,449) + lu(k,465) = lu(k,465) - lu(k,443) * lu(k,449) + lu(k,473) = lu(k,473) - lu(k,437) * lu(k,470) + lu(k,474) = - lu(k,438) * lu(k,470) + lu(k,475) = lu(k,475) - lu(k,439) * lu(k,470) + lu(k,478) = lu(k,478) - lu(k,440) * lu(k,470) + lu(k,484) = lu(k,484) - lu(k,441) * lu(k,470) + lu(k,487) = lu(k,487) - lu(k,442) * lu(k,470) + lu(k,488) = lu(k,488) - lu(k,443) * lu(k,470) + lu(k,505) = lu(k,505) - lu(k,437) * lu(k,504) + lu(k,506) = lu(k,506) - lu(k,438) * lu(k,504) + lu(k,507) = lu(k,507) - lu(k,439) * lu(k,504) + lu(k,509) = lu(k,509) - lu(k,440) * lu(k,504) + lu(k,515) = lu(k,515) - lu(k,441) * lu(k,504) + lu(k,517) = - lu(k,442) * lu(k,504) + lu(k,518) = lu(k,518) - lu(k,443) * lu(k,504) + lu(k,525) = lu(k,525) - lu(k,437) * lu(k,524) + lu(k,526) = lu(k,526) - lu(k,438) * lu(k,524) + lu(k,527) = lu(k,527) - lu(k,439) * lu(k,524) + lu(k,530) = lu(k,530) - lu(k,440) * lu(k,524) + lu(k,536) = lu(k,536) - lu(k,441) * lu(k,524) + lu(k,538) = - lu(k,442) * lu(k,524) + lu(k,539) = lu(k,539) - lu(k,443) * lu(k,524) + lu(k,550) = lu(k,550) - lu(k,437) * lu(k,547) + lu(k,551) = lu(k,551) - lu(k,438) * lu(k,547) + lu(k,552) = lu(k,552) - lu(k,439) * lu(k,547) + lu(k,555) = lu(k,555) - lu(k,440) * lu(k,547) + lu(k,561) = lu(k,561) - lu(k,441) * lu(k,547) + lu(k,564) = lu(k,564) - lu(k,442) * lu(k,547) + lu(k,565) = lu(k,565) - lu(k,443) * lu(k,547) + lu(k,578) = lu(k,578) - lu(k,437) * lu(k,575) + lu(k,579) = lu(k,579) - lu(k,438) * lu(k,575) + lu(k,580) = lu(k,580) - lu(k,439) * lu(k,575) + lu(k,583) = lu(k,583) - lu(k,440) * lu(k,575) + lu(k,589) = lu(k,589) - lu(k,441) * lu(k,575) + lu(k,592) = - lu(k,442) * lu(k,575) + lu(k,593) = lu(k,593) - lu(k,443) * lu(k,575) + lu(k,603) = lu(k,603) - lu(k,437) * lu(k,601) + lu(k,604) = lu(k,604) - lu(k,438) * lu(k,601) + lu(k,605) = lu(k,605) - lu(k,439) * lu(k,601) + lu(k,608) = lu(k,608) - lu(k,440) * lu(k,601) + lu(k,614) = lu(k,614) - lu(k,441) * lu(k,601) + lu(k,617) = - lu(k,442) * lu(k,601) + lu(k,618) = lu(k,618) - lu(k,443) * lu(k,601) + lu(k,645) = lu(k,645) - lu(k,437) * lu(k,642) + lu(k,646) = lu(k,646) - lu(k,438) * lu(k,642) + lu(k,647) = lu(k,647) - lu(k,439) * lu(k,642) + lu(k,650) = lu(k,650) - lu(k,440) * lu(k,642) + lu(k,656) = lu(k,656) - lu(k,441) * lu(k,642) + lu(k,659) = lu(k,659) - lu(k,442) * lu(k,642) + lu(k,660) = lu(k,660) - lu(k,443) * lu(k,642) + lu(k,670) = lu(k,670) - lu(k,437) * lu(k,668) + lu(k,671) = lu(k,671) - lu(k,438) * lu(k,668) + lu(k,672) = lu(k,672) - lu(k,439) * lu(k,668) + lu(k,675) = lu(k,675) - lu(k,440) * lu(k,668) + lu(k,681) = lu(k,681) - lu(k,441) * lu(k,668) + lu(k,684) = - lu(k,442) * lu(k,668) + lu(k,685) = lu(k,685) - lu(k,443) * lu(k,668) + lu(k,712) = lu(k,712) - lu(k,437) * lu(k,709) + lu(k,713) = lu(k,713) - lu(k,438) * lu(k,709) + lu(k,714) = lu(k,714) - lu(k,439) * lu(k,709) + lu(k,717) = lu(k,717) - lu(k,440) * lu(k,709) + lu(k,723) = lu(k,723) - lu(k,441) * lu(k,709) + lu(k,726) = lu(k,726) - lu(k,442) * lu(k,709) + lu(k,727) = lu(k,727) - lu(k,443) * lu(k,709) + lu(k,736) = lu(k,736) - lu(k,437) * lu(k,734) + lu(k,737) = lu(k,737) - lu(k,438) * lu(k,734) + lu(k,738) = lu(k,738) - lu(k,439) * lu(k,734) + lu(k,741) = lu(k,741) - lu(k,440) * lu(k,734) + lu(k,747) = lu(k,747) - lu(k,441) * lu(k,734) + lu(k,750) = - lu(k,442) * lu(k,734) + lu(k,751) = lu(k,751) - lu(k,443) * lu(k,734) + lu(k,758) = lu(k,758) - lu(k,437) * lu(k,756) + lu(k,759) = lu(k,759) - lu(k,438) * lu(k,756) + lu(k,760) = lu(k,760) - lu(k,439) * lu(k,756) + lu(k,763) = lu(k,763) - lu(k,440) * lu(k,756) + lu(k,769) = lu(k,769) - lu(k,441) * lu(k,756) + lu(k,772) = - lu(k,442) * lu(k,756) + lu(k,773) = lu(k,773) - lu(k,443) * lu(k,756) + lu(k,787) = lu(k,787) - lu(k,437) * lu(k,785) + lu(k,788) = lu(k,788) - lu(k,438) * lu(k,785) + lu(k,789) = lu(k,789) - lu(k,439) * lu(k,785) + lu(k,792) = lu(k,792) - lu(k,440) * lu(k,785) + lu(k,798) = lu(k,798) - lu(k,441) * lu(k,785) + lu(k,801) = - lu(k,442) * lu(k,785) + lu(k,802) = lu(k,802) - lu(k,443) * lu(k,785) + lu(k,836) = lu(k,836) - lu(k,437) * lu(k,833) + lu(k,837) = lu(k,837) - lu(k,438) * lu(k,833) + lu(k,838) = lu(k,838) - lu(k,439) * lu(k,833) + lu(k,841) = lu(k,841) - lu(k,440) * lu(k,833) + lu(k,847) = lu(k,847) - lu(k,441) * lu(k,833) + lu(k,850) = lu(k,850) - lu(k,442) * lu(k,833) + lu(k,851) = lu(k,851) - lu(k,443) * lu(k,833) + lu(k,859) = lu(k,859) - lu(k,437) * lu(k,856) + lu(k,860) = - lu(k,438) * lu(k,856) + lu(k,861) = lu(k,861) - lu(k,439) * lu(k,856) + lu(k,864) = lu(k,864) - lu(k,440) * lu(k,856) + lu(k,870) = lu(k,870) - lu(k,441) * lu(k,856) + lu(k,873) = lu(k,873) - lu(k,442) * lu(k,856) + lu(k,874) = lu(k,874) - lu(k,443) * lu(k,856) + lu(k,891) = lu(k,891) - lu(k,437) * lu(k,888) + lu(k,892) = lu(k,892) - lu(k,438) * lu(k,888) + lu(k,893) = lu(k,893) - lu(k,439) * lu(k,888) + lu(k,896) = lu(k,896) - lu(k,440) * lu(k,888) + lu(k,902) = lu(k,902) - lu(k,441) * lu(k,888) + lu(k,905) = lu(k,905) - lu(k,442) * lu(k,888) + lu(k,906) = lu(k,906) - lu(k,443) * lu(k,888) + lu(k,914) = lu(k,914) - lu(k,437) * lu(k,911) + lu(k,915) = - lu(k,438) * lu(k,911) + lu(k,916) = lu(k,916) - lu(k,439) * lu(k,911) + lu(k,919) = lu(k,919) - lu(k,440) * lu(k,911) + lu(k,925) = lu(k,925) - lu(k,441) * lu(k,911) + lu(k,928) = lu(k,928) - lu(k,442) * lu(k,911) + lu(k,929) = lu(k,929) - lu(k,443) * lu(k,911) + lu(k,941) = lu(k,941) - lu(k,437) * lu(k,938) + lu(k,942) = lu(k,942) - lu(k,438) * lu(k,938) + lu(k,943) = lu(k,943) - lu(k,439) * lu(k,938) + lu(k,946) = lu(k,946) - lu(k,440) * lu(k,938) + lu(k,952) = lu(k,952) - lu(k,441) * lu(k,938) + lu(k,955) = lu(k,955) - lu(k,442) * lu(k,938) + lu(k,956) = lu(k,956) - lu(k,443) * lu(k,938) + 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 @@ -2626,505 +2166,611 @@ subroutine lu_fac10( avec_len, lu ) lu(k,459) = lu(k,459) * lu(k,450) lu(k,460) = lu(k,460) * lu(k,450) lu(k,461) = lu(k,461) * lu(k,450) - lu(k,494) = lu(k,494) - lu(k,451) * lu(k,493) - lu(k,495) = lu(k,495) - lu(k,452) * lu(k,493) - lu(k,496) = lu(k,496) - lu(k,453) * lu(k,493) - lu(k,497) = lu(k,497) - lu(k,454) * lu(k,493) - lu(k,498) = lu(k,498) - lu(k,455) * lu(k,493) - lu(k,499) = lu(k,499) - lu(k,456) * lu(k,493) - lu(k,500) = lu(k,500) - lu(k,457) * lu(k,493) - lu(k,501) = lu(k,501) - lu(k,458) * lu(k,493) - lu(k,502) = lu(k,502) - lu(k,459) * lu(k,493) - lu(k,503) = lu(k,503) - lu(k,460) * lu(k,493) - lu(k,504) = lu(k,504) - lu(k,461) * lu(k,493) - lu(k,516) = lu(k,516) - lu(k,451) * lu(k,515) - lu(k,517) = lu(k,517) - lu(k,452) * lu(k,515) - lu(k,518) = lu(k,518) - lu(k,453) * lu(k,515) - lu(k,519) = lu(k,519) - lu(k,454) * lu(k,515) - lu(k,520) = lu(k,520) - lu(k,455) * lu(k,515) - lu(k,521) = lu(k,521) - lu(k,456) * lu(k,515) - lu(k,522) = lu(k,522) - lu(k,457) * lu(k,515) - lu(k,523) = lu(k,523) - lu(k,458) * lu(k,515) - lu(k,524) = lu(k,524) - lu(k,459) * lu(k,515) - lu(k,525) = lu(k,525) - lu(k,460) * lu(k,515) - lu(k,526) = lu(k,526) - lu(k,461) * lu(k,515) - lu(k,541) = lu(k,541) - lu(k,451) * lu(k,540) - lu(k,542) = lu(k,542) - lu(k,452) * lu(k,540) - lu(k,543) = lu(k,543) - lu(k,453) * lu(k,540) - lu(k,544) = lu(k,544) - lu(k,454) * lu(k,540) - lu(k,545) = lu(k,545) - lu(k,455) * lu(k,540) - lu(k,546) = lu(k,546) - lu(k,456) * lu(k,540) - lu(k,547) = lu(k,547) - lu(k,457) * lu(k,540) - lu(k,548) = lu(k,548) - lu(k,458) * lu(k,540) - lu(k,549) = lu(k,549) - lu(k,459) * lu(k,540) - lu(k,550) = lu(k,550) - lu(k,460) * lu(k,540) - lu(k,551) = lu(k,551) - lu(k,461) * lu(k,540) - lu(k,562) = lu(k,562) - lu(k,451) * lu(k,561) - lu(k,563) = lu(k,563) - lu(k,452) * lu(k,561) - lu(k,564) = lu(k,564) - lu(k,453) * lu(k,561) - lu(k,565) = lu(k,565) - lu(k,454) * lu(k,561) - lu(k,566) = lu(k,566) - lu(k,455) * lu(k,561) - lu(k,567) = lu(k,567) - lu(k,456) * lu(k,561) - lu(k,568) = lu(k,568) - lu(k,457) * lu(k,561) - lu(k,569) = lu(k,569) - lu(k,458) * lu(k,561) - lu(k,570) = lu(k,570) - lu(k,459) * lu(k,561) - lu(k,571) = lu(k,571) - lu(k,460) * lu(k,561) - lu(k,572) = lu(k,572) - lu(k,461) * lu(k,561) - lu(k,588) = lu(k,588) - lu(k,451) * lu(k,587) - lu(k,589) = lu(k,589) - lu(k,452) * lu(k,587) - lu(k,590) = lu(k,590) - lu(k,453) * lu(k,587) - lu(k,591) = lu(k,591) - lu(k,454) * lu(k,587) - lu(k,592) = lu(k,592) - lu(k,455) * lu(k,587) - lu(k,593) = lu(k,593) - lu(k,456) * lu(k,587) - lu(k,594) = lu(k,594) - lu(k,457) * lu(k,587) - lu(k,595) = lu(k,595) - lu(k,458) * lu(k,587) - lu(k,596) = lu(k,596) - lu(k,459) * lu(k,587) - lu(k,597) = lu(k,597) - lu(k,460) * lu(k,587) - lu(k,598) = lu(k,598) - lu(k,461) * lu(k,587) - lu(k,619) = lu(k,619) - lu(k,451) * lu(k,618) - lu(k,620) = lu(k,620) - lu(k,452) * lu(k,618) - lu(k,621) = lu(k,621) - lu(k,453) * lu(k,618) - lu(k,622) = lu(k,622) - lu(k,454) * lu(k,618) - lu(k,623) = lu(k,623) - lu(k,455) * lu(k,618) - lu(k,624) = lu(k,624) - lu(k,456) * lu(k,618) - lu(k,625) = lu(k,625) - lu(k,457) * lu(k,618) - lu(k,626) = lu(k,626) - lu(k,458) * lu(k,618) - lu(k,627) = lu(k,627) - lu(k,459) * lu(k,618) - lu(k,628) = lu(k,628) - lu(k,460) * lu(k,618) - lu(k,629) = lu(k,629) - lu(k,461) * lu(k,618) - lu(k,656) = lu(k,656) - lu(k,451) * lu(k,655) - lu(k,657) = lu(k,657) - lu(k,452) * lu(k,655) - lu(k,658) = lu(k,658) - lu(k,453) * lu(k,655) - lu(k,659) = lu(k,659) - lu(k,454) * lu(k,655) - lu(k,660) = lu(k,660) - lu(k,455) * lu(k,655) - lu(k,661) = lu(k,661) - lu(k,456) * lu(k,655) - lu(k,662) = lu(k,662) - lu(k,457) * lu(k,655) - lu(k,663) = lu(k,663) - lu(k,458) * lu(k,655) - lu(k,664) = lu(k,664) - lu(k,459) * lu(k,655) - lu(k,665) = lu(k,665) - lu(k,460) * lu(k,655) - lu(k,666) = lu(k,666) - lu(k,461) * lu(k,655) - lu(k,678) = lu(k,678) - lu(k,451) * lu(k,677) - lu(k,679) = lu(k,679) - lu(k,452) * lu(k,677) - lu(k,680) = lu(k,680) - lu(k,453) * lu(k,677) - lu(k,681) = lu(k,681) - lu(k,454) * lu(k,677) - lu(k,682) = lu(k,682) - lu(k,455) * lu(k,677) - lu(k,683) = lu(k,683) - lu(k,456) * lu(k,677) - lu(k,684) = lu(k,684) - lu(k,457) * lu(k,677) - lu(k,685) = lu(k,685) - lu(k,458) * lu(k,677) - lu(k,686) = lu(k,686) - lu(k,459) * lu(k,677) - lu(k,687) = lu(k,687) - lu(k,460) * lu(k,677) - lu(k,688) = lu(k,688) - lu(k,461) * lu(k,677) - lu(k,706) = lu(k,706) - lu(k,451) * lu(k,705) - lu(k,707) = lu(k,707) - lu(k,452) * lu(k,705) - lu(k,708) = lu(k,708) - lu(k,453) * lu(k,705) - lu(k,709) = lu(k,709) - lu(k,454) * lu(k,705) - lu(k,710) = lu(k,710) - lu(k,455) * lu(k,705) - lu(k,711) = lu(k,711) - lu(k,456) * lu(k,705) - lu(k,712) = lu(k,712) - lu(k,457) * lu(k,705) - lu(k,713) = lu(k,713) - lu(k,458) * lu(k,705) - lu(k,714) = lu(k,714) - lu(k,459) * lu(k,705) - lu(k,715) = lu(k,715) - lu(k,460) * lu(k,705) - lu(k,716) = lu(k,716) - lu(k,461) * lu(k,705) - lu(k,729) = lu(k,729) - lu(k,451) * lu(k,728) - lu(k,730) = lu(k,730) - lu(k,452) * lu(k,728) - lu(k,731) = lu(k,731) - lu(k,453) * lu(k,728) - lu(k,732) = lu(k,732) - lu(k,454) * lu(k,728) - lu(k,733) = lu(k,733) - lu(k,455) * lu(k,728) - lu(k,734) = lu(k,734) - lu(k,456) * lu(k,728) - lu(k,735) = lu(k,735) - lu(k,457) * lu(k,728) - lu(k,736) = lu(k,736) - lu(k,458) * lu(k,728) - lu(k,737) = lu(k,737) - lu(k,459) * lu(k,728) - lu(k,738) = lu(k,738) - lu(k,460) * lu(k,728) - lu(k,739) = lu(k,739) - lu(k,461) * lu(k,728) - lu(k,754) = lu(k,754) - lu(k,451) * lu(k,753) - lu(k,755) = lu(k,755) - lu(k,452) * lu(k,753) - lu(k,756) = lu(k,756) - lu(k,453) * lu(k,753) - lu(k,757) = lu(k,757) - lu(k,454) * lu(k,753) - lu(k,758) = lu(k,758) - lu(k,455) * lu(k,753) - lu(k,759) = lu(k,759) - lu(k,456) * lu(k,753) - lu(k,760) = lu(k,760) - lu(k,457) * lu(k,753) - lu(k,761) = lu(k,761) - lu(k,458) * lu(k,753) - lu(k,762) = lu(k,762) - lu(k,459) * lu(k,753) - lu(k,763) = lu(k,763) - lu(k,460) * lu(k,753) - lu(k,764) = lu(k,764) - lu(k,461) * lu(k,753) - lu(k,494) = 1._r8 / lu(k,494) - lu(k,495) = lu(k,495) * lu(k,494) - lu(k,496) = lu(k,496) * lu(k,494) - lu(k,497) = lu(k,497) * lu(k,494) - lu(k,498) = lu(k,498) * lu(k,494) - lu(k,499) = lu(k,499) * lu(k,494) - lu(k,500) = lu(k,500) * lu(k,494) - lu(k,501) = lu(k,501) * lu(k,494) - lu(k,502) = lu(k,502) * lu(k,494) - lu(k,503) = lu(k,503) * lu(k,494) - lu(k,504) = lu(k,504) * lu(k,494) - lu(k,517) = lu(k,517) - lu(k,495) * lu(k,516) - lu(k,518) = lu(k,518) - lu(k,496) * lu(k,516) - lu(k,519) = lu(k,519) - lu(k,497) * lu(k,516) - lu(k,520) = lu(k,520) - lu(k,498) * lu(k,516) - lu(k,521) = lu(k,521) - lu(k,499) * lu(k,516) - lu(k,522) = lu(k,522) - lu(k,500) * lu(k,516) - lu(k,523) = lu(k,523) - lu(k,501) * lu(k,516) - lu(k,524) = lu(k,524) - lu(k,502) * lu(k,516) - lu(k,525) = lu(k,525) - lu(k,503) * lu(k,516) - lu(k,526) = lu(k,526) - lu(k,504) * lu(k,516) - lu(k,542) = lu(k,542) - lu(k,495) * lu(k,541) - lu(k,543) = lu(k,543) - lu(k,496) * lu(k,541) - lu(k,544) = lu(k,544) - lu(k,497) * lu(k,541) - lu(k,545) = lu(k,545) - lu(k,498) * lu(k,541) - lu(k,546) = lu(k,546) - lu(k,499) * lu(k,541) - lu(k,547) = lu(k,547) - lu(k,500) * lu(k,541) - lu(k,548) = lu(k,548) - lu(k,501) * lu(k,541) - lu(k,549) = lu(k,549) - lu(k,502) * lu(k,541) - lu(k,550) = lu(k,550) - lu(k,503) * lu(k,541) - lu(k,551) = lu(k,551) - lu(k,504) * lu(k,541) - lu(k,563) = lu(k,563) - lu(k,495) * lu(k,562) - lu(k,564) = lu(k,564) - lu(k,496) * lu(k,562) - lu(k,565) = lu(k,565) - lu(k,497) * lu(k,562) - lu(k,566) = lu(k,566) - lu(k,498) * lu(k,562) - lu(k,567) = lu(k,567) - lu(k,499) * lu(k,562) - lu(k,568) = lu(k,568) - lu(k,500) * lu(k,562) - lu(k,569) = lu(k,569) - lu(k,501) * lu(k,562) - lu(k,570) = lu(k,570) - lu(k,502) * lu(k,562) - lu(k,571) = lu(k,571) - lu(k,503) * lu(k,562) - lu(k,572) = lu(k,572) - lu(k,504) * lu(k,562) - lu(k,589) = lu(k,589) - lu(k,495) * lu(k,588) - lu(k,590) = lu(k,590) - lu(k,496) * lu(k,588) - lu(k,591) = lu(k,591) - lu(k,497) * lu(k,588) - lu(k,592) = lu(k,592) - lu(k,498) * lu(k,588) - lu(k,593) = lu(k,593) - lu(k,499) * lu(k,588) - lu(k,594) = lu(k,594) - lu(k,500) * lu(k,588) - lu(k,595) = lu(k,595) - lu(k,501) * lu(k,588) - lu(k,596) = lu(k,596) - lu(k,502) * lu(k,588) - lu(k,597) = lu(k,597) - lu(k,503) * lu(k,588) - lu(k,598) = lu(k,598) - lu(k,504) * lu(k,588) - lu(k,620) = lu(k,620) - lu(k,495) * lu(k,619) - lu(k,621) = lu(k,621) - lu(k,496) * lu(k,619) - lu(k,622) = lu(k,622) - lu(k,497) * lu(k,619) - lu(k,623) = lu(k,623) - lu(k,498) * lu(k,619) - lu(k,624) = lu(k,624) - lu(k,499) * lu(k,619) - lu(k,625) = lu(k,625) - lu(k,500) * lu(k,619) - lu(k,626) = lu(k,626) - lu(k,501) * lu(k,619) - lu(k,627) = lu(k,627) - lu(k,502) * lu(k,619) - lu(k,628) = lu(k,628) - lu(k,503) * lu(k,619) - lu(k,629) = lu(k,629) - lu(k,504) * lu(k,619) - lu(k,657) = lu(k,657) - lu(k,495) * lu(k,656) - lu(k,658) = lu(k,658) - lu(k,496) * lu(k,656) - lu(k,659) = lu(k,659) - lu(k,497) * lu(k,656) - lu(k,660) = lu(k,660) - lu(k,498) * lu(k,656) - lu(k,661) = lu(k,661) - lu(k,499) * lu(k,656) - lu(k,662) = lu(k,662) - lu(k,500) * lu(k,656) - lu(k,663) = lu(k,663) - lu(k,501) * lu(k,656) - lu(k,664) = lu(k,664) - lu(k,502) * lu(k,656) - lu(k,665) = lu(k,665) - lu(k,503) * lu(k,656) - lu(k,666) = lu(k,666) - lu(k,504) * lu(k,656) - lu(k,679) = lu(k,679) - lu(k,495) * lu(k,678) - lu(k,680) = lu(k,680) - lu(k,496) * lu(k,678) - lu(k,681) = lu(k,681) - lu(k,497) * lu(k,678) - lu(k,682) = lu(k,682) - lu(k,498) * lu(k,678) - lu(k,683) = lu(k,683) - lu(k,499) * lu(k,678) - lu(k,684) = lu(k,684) - lu(k,500) * lu(k,678) - lu(k,685) = lu(k,685) - lu(k,501) * lu(k,678) - lu(k,686) = lu(k,686) - lu(k,502) * lu(k,678) - lu(k,687) = lu(k,687) - lu(k,503) * lu(k,678) - lu(k,688) = lu(k,688) - lu(k,504) * lu(k,678) - lu(k,707) = lu(k,707) - lu(k,495) * lu(k,706) - lu(k,708) = lu(k,708) - lu(k,496) * lu(k,706) - lu(k,709) = lu(k,709) - lu(k,497) * lu(k,706) - lu(k,710) = lu(k,710) - lu(k,498) * lu(k,706) - lu(k,711) = lu(k,711) - lu(k,499) * lu(k,706) - lu(k,712) = lu(k,712) - lu(k,500) * lu(k,706) - lu(k,713) = lu(k,713) - lu(k,501) * lu(k,706) - lu(k,714) = lu(k,714) - lu(k,502) * lu(k,706) - lu(k,715) = lu(k,715) - lu(k,503) * lu(k,706) - lu(k,716) = lu(k,716) - lu(k,504) * lu(k,706) - lu(k,730) = lu(k,730) - lu(k,495) * lu(k,729) - lu(k,731) = lu(k,731) - lu(k,496) * lu(k,729) - lu(k,732) = lu(k,732) - lu(k,497) * lu(k,729) - lu(k,733) = lu(k,733) - lu(k,498) * lu(k,729) - lu(k,734) = lu(k,734) - lu(k,499) * lu(k,729) - lu(k,735) = lu(k,735) - lu(k,500) * lu(k,729) - lu(k,736) = lu(k,736) - lu(k,501) * lu(k,729) - lu(k,737) = lu(k,737) - lu(k,502) * lu(k,729) - lu(k,738) = lu(k,738) - lu(k,503) * lu(k,729) - lu(k,739) = lu(k,739) - lu(k,504) * lu(k,729) - lu(k,755) = lu(k,755) - lu(k,495) * lu(k,754) - lu(k,756) = lu(k,756) - lu(k,496) * lu(k,754) - lu(k,757) = lu(k,757) - lu(k,497) * lu(k,754) - lu(k,758) = lu(k,758) - lu(k,498) * lu(k,754) - lu(k,759) = lu(k,759) - lu(k,499) * lu(k,754) - lu(k,760) = lu(k,760) - lu(k,500) * lu(k,754) - lu(k,761) = lu(k,761) - lu(k,501) * lu(k,754) - lu(k,762) = lu(k,762) - lu(k,502) * lu(k,754) - lu(k,763) = lu(k,763) - lu(k,503) * lu(k,754) - lu(k,764) = lu(k,764) - lu(k,504) * lu(k,754) - lu(k,517) = 1._r8 / lu(k,517) - lu(k,518) = lu(k,518) * lu(k,517) - lu(k,519) = lu(k,519) * lu(k,517) - lu(k,520) = lu(k,520) * lu(k,517) - lu(k,521) = lu(k,521) * lu(k,517) - lu(k,522) = lu(k,522) * lu(k,517) - lu(k,523) = lu(k,523) * lu(k,517) - lu(k,524) = lu(k,524) * lu(k,517) - lu(k,525) = lu(k,525) * lu(k,517) - lu(k,526) = lu(k,526) * lu(k,517) - lu(k,543) = lu(k,543) - lu(k,518) * lu(k,542) - lu(k,544) = lu(k,544) - lu(k,519) * lu(k,542) - lu(k,545) = lu(k,545) - lu(k,520) * lu(k,542) - lu(k,546) = lu(k,546) - lu(k,521) * lu(k,542) - lu(k,547) = lu(k,547) - lu(k,522) * lu(k,542) - lu(k,548) = lu(k,548) - lu(k,523) * lu(k,542) - lu(k,549) = lu(k,549) - lu(k,524) * lu(k,542) - lu(k,550) = lu(k,550) - lu(k,525) * lu(k,542) - lu(k,551) = lu(k,551) - lu(k,526) * lu(k,542) - lu(k,564) = lu(k,564) - lu(k,518) * lu(k,563) - lu(k,565) = lu(k,565) - lu(k,519) * lu(k,563) - lu(k,566) = lu(k,566) - lu(k,520) * lu(k,563) - lu(k,567) = lu(k,567) - lu(k,521) * lu(k,563) - lu(k,568) = lu(k,568) - lu(k,522) * lu(k,563) - lu(k,569) = lu(k,569) - lu(k,523) * lu(k,563) - lu(k,570) = lu(k,570) - lu(k,524) * lu(k,563) - lu(k,571) = lu(k,571) - lu(k,525) * lu(k,563) - lu(k,572) = lu(k,572) - lu(k,526) * lu(k,563) - lu(k,590) = lu(k,590) - lu(k,518) * lu(k,589) - lu(k,591) = lu(k,591) - lu(k,519) * lu(k,589) - lu(k,592) = lu(k,592) - lu(k,520) * lu(k,589) - lu(k,593) = lu(k,593) - lu(k,521) * lu(k,589) - lu(k,594) = lu(k,594) - lu(k,522) * lu(k,589) - lu(k,595) = lu(k,595) - lu(k,523) * lu(k,589) - lu(k,596) = lu(k,596) - lu(k,524) * lu(k,589) - lu(k,597) = lu(k,597) - lu(k,525) * lu(k,589) - lu(k,598) = lu(k,598) - lu(k,526) * lu(k,589) - lu(k,621) = lu(k,621) - lu(k,518) * lu(k,620) - lu(k,622) = lu(k,622) - lu(k,519) * lu(k,620) - lu(k,623) = lu(k,623) - lu(k,520) * lu(k,620) - lu(k,624) = lu(k,624) - lu(k,521) * lu(k,620) - lu(k,625) = lu(k,625) - lu(k,522) * lu(k,620) - lu(k,626) = lu(k,626) - lu(k,523) * lu(k,620) - lu(k,627) = lu(k,627) - lu(k,524) * lu(k,620) - lu(k,628) = lu(k,628) - lu(k,525) * lu(k,620) - lu(k,629) = lu(k,629) - lu(k,526) * lu(k,620) - lu(k,658) = lu(k,658) - lu(k,518) * lu(k,657) - lu(k,659) = lu(k,659) - lu(k,519) * lu(k,657) - lu(k,660) = lu(k,660) - lu(k,520) * lu(k,657) - lu(k,661) = lu(k,661) - lu(k,521) * lu(k,657) - lu(k,662) = lu(k,662) - lu(k,522) * lu(k,657) - lu(k,663) = lu(k,663) - lu(k,523) * lu(k,657) - lu(k,664) = lu(k,664) - lu(k,524) * lu(k,657) - lu(k,665) = lu(k,665) - lu(k,525) * lu(k,657) - lu(k,666) = lu(k,666) - lu(k,526) * lu(k,657) - lu(k,680) = lu(k,680) - lu(k,518) * lu(k,679) - lu(k,681) = lu(k,681) - lu(k,519) * lu(k,679) - lu(k,682) = lu(k,682) - lu(k,520) * lu(k,679) - lu(k,683) = lu(k,683) - lu(k,521) * lu(k,679) - lu(k,684) = lu(k,684) - lu(k,522) * lu(k,679) - lu(k,685) = lu(k,685) - lu(k,523) * lu(k,679) - lu(k,686) = lu(k,686) - lu(k,524) * lu(k,679) - lu(k,687) = lu(k,687) - lu(k,525) * lu(k,679) - lu(k,688) = lu(k,688) - lu(k,526) * lu(k,679) - lu(k,708) = lu(k,708) - lu(k,518) * lu(k,707) - lu(k,709) = lu(k,709) - lu(k,519) * lu(k,707) - lu(k,710) = lu(k,710) - lu(k,520) * lu(k,707) - lu(k,711) = lu(k,711) - lu(k,521) * lu(k,707) - lu(k,712) = lu(k,712) - lu(k,522) * lu(k,707) - lu(k,713) = lu(k,713) - lu(k,523) * lu(k,707) - lu(k,714) = lu(k,714) - lu(k,524) * lu(k,707) - lu(k,715) = lu(k,715) - lu(k,525) * lu(k,707) - lu(k,716) = lu(k,716) - lu(k,526) * lu(k,707) - lu(k,731) = lu(k,731) - lu(k,518) * lu(k,730) - lu(k,732) = lu(k,732) - lu(k,519) * lu(k,730) - lu(k,733) = lu(k,733) - lu(k,520) * lu(k,730) - lu(k,734) = lu(k,734) - lu(k,521) * lu(k,730) - lu(k,735) = lu(k,735) - lu(k,522) * lu(k,730) - lu(k,736) = lu(k,736) - lu(k,523) * lu(k,730) - lu(k,737) = lu(k,737) - lu(k,524) * lu(k,730) - lu(k,738) = lu(k,738) - lu(k,525) * lu(k,730) - lu(k,739) = lu(k,739) - lu(k,526) * lu(k,730) - lu(k,756) = lu(k,756) - lu(k,518) * lu(k,755) - lu(k,757) = lu(k,757) - lu(k,519) * lu(k,755) - lu(k,758) = lu(k,758) - lu(k,520) * lu(k,755) - lu(k,759) = lu(k,759) - lu(k,521) * lu(k,755) - lu(k,760) = lu(k,760) - lu(k,522) * lu(k,755) - lu(k,761) = lu(k,761) - lu(k,523) * lu(k,755) - lu(k,762) = lu(k,762) - lu(k,524) * lu(k,755) - lu(k,763) = lu(k,763) - lu(k,525) * lu(k,755) - lu(k,764) = lu(k,764) - lu(k,526) * lu(k,755) - lu(k,543) = 1._r8 / lu(k,543) - lu(k,544) = lu(k,544) * lu(k,543) - lu(k,545) = lu(k,545) * lu(k,543) - lu(k,546) = lu(k,546) * lu(k,543) - lu(k,547) = lu(k,547) * lu(k,543) - lu(k,548) = lu(k,548) * lu(k,543) - lu(k,549) = lu(k,549) * lu(k,543) - lu(k,550) = lu(k,550) * lu(k,543) - lu(k,551) = lu(k,551) * lu(k,543) - lu(k,565) = lu(k,565) - lu(k,544) * lu(k,564) - lu(k,566) = lu(k,566) - lu(k,545) * lu(k,564) - lu(k,567) = lu(k,567) - lu(k,546) * lu(k,564) - lu(k,568) = lu(k,568) - lu(k,547) * lu(k,564) - lu(k,569) = lu(k,569) - lu(k,548) * lu(k,564) - lu(k,570) = lu(k,570) - lu(k,549) * lu(k,564) - lu(k,571) = lu(k,571) - lu(k,550) * lu(k,564) - lu(k,572) = lu(k,572) - lu(k,551) * lu(k,564) - lu(k,591) = lu(k,591) - lu(k,544) * lu(k,590) - lu(k,592) = lu(k,592) - lu(k,545) * lu(k,590) - lu(k,593) = lu(k,593) - lu(k,546) * lu(k,590) - lu(k,594) = lu(k,594) - lu(k,547) * lu(k,590) - lu(k,595) = lu(k,595) - lu(k,548) * lu(k,590) - lu(k,596) = lu(k,596) - lu(k,549) * lu(k,590) - lu(k,597) = lu(k,597) - lu(k,550) * lu(k,590) - lu(k,598) = lu(k,598) - lu(k,551) * lu(k,590) - lu(k,622) = lu(k,622) - lu(k,544) * lu(k,621) - lu(k,623) = lu(k,623) - lu(k,545) * lu(k,621) - lu(k,624) = lu(k,624) - lu(k,546) * lu(k,621) - lu(k,625) = lu(k,625) - lu(k,547) * lu(k,621) - lu(k,626) = lu(k,626) - lu(k,548) * lu(k,621) - lu(k,627) = lu(k,627) - lu(k,549) * lu(k,621) - lu(k,628) = lu(k,628) - lu(k,550) * lu(k,621) - lu(k,629) = lu(k,629) - lu(k,551) * lu(k,621) - lu(k,659) = lu(k,659) - lu(k,544) * lu(k,658) - lu(k,660) = lu(k,660) - lu(k,545) * lu(k,658) - lu(k,661) = lu(k,661) - lu(k,546) * lu(k,658) - lu(k,662) = lu(k,662) - lu(k,547) * lu(k,658) - lu(k,663) = lu(k,663) - lu(k,548) * lu(k,658) - lu(k,664) = lu(k,664) - lu(k,549) * lu(k,658) - lu(k,665) = lu(k,665) - lu(k,550) * lu(k,658) - lu(k,666) = lu(k,666) - lu(k,551) * lu(k,658) - lu(k,681) = lu(k,681) - lu(k,544) * lu(k,680) - lu(k,682) = lu(k,682) - lu(k,545) * lu(k,680) - lu(k,683) = lu(k,683) - lu(k,546) * lu(k,680) - lu(k,684) = lu(k,684) - lu(k,547) * lu(k,680) - lu(k,685) = lu(k,685) - lu(k,548) * lu(k,680) - lu(k,686) = lu(k,686) - lu(k,549) * lu(k,680) - lu(k,687) = lu(k,687) - lu(k,550) * lu(k,680) - lu(k,688) = lu(k,688) - lu(k,551) * lu(k,680) - lu(k,709) = lu(k,709) - lu(k,544) * lu(k,708) - lu(k,710) = lu(k,710) - lu(k,545) * lu(k,708) - lu(k,711) = lu(k,711) - lu(k,546) * lu(k,708) - lu(k,712) = lu(k,712) - lu(k,547) * lu(k,708) - lu(k,713) = lu(k,713) - lu(k,548) * lu(k,708) - lu(k,714) = lu(k,714) - lu(k,549) * lu(k,708) - lu(k,715) = lu(k,715) - lu(k,550) * lu(k,708) - lu(k,716) = lu(k,716) - lu(k,551) * lu(k,708) - lu(k,732) = lu(k,732) - lu(k,544) * lu(k,731) - lu(k,733) = lu(k,733) - lu(k,545) * lu(k,731) - lu(k,734) = lu(k,734) - lu(k,546) * lu(k,731) - lu(k,735) = lu(k,735) - lu(k,547) * lu(k,731) - lu(k,736) = lu(k,736) - lu(k,548) * lu(k,731) - lu(k,737) = lu(k,737) - lu(k,549) * lu(k,731) - lu(k,738) = lu(k,738) - lu(k,550) * lu(k,731) - lu(k,739) = lu(k,739) - lu(k,551) * lu(k,731) - lu(k,757) = lu(k,757) - lu(k,544) * lu(k,756) - lu(k,758) = lu(k,758) - lu(k,545) * lu(k,756) - lu(k,759) = lu(k,759) - lu(k,546) * lu(k,756) - lu(k,760) = lu(k,760) - lu(k,547) * lu(k,756) - lu(k,761) = lu(k,761) - lu(k,548) * lu(k,756) - lu(k,762) = lu(k,762) - lu(k,549) * lu(k,756) - lu(k,763) = lu(k,763) - lu(k,550) * lu(k,756) - lu(k,764) = lu(k,764) - lu(k,551) * lu(k,756) - lu(k,565) = 1._r8 / lu(k,565) - lu(k,566) = lu(k,566) * lu(k,565) - lu(k,567) = lu(k,567) * lu(k,565) - lu(k,568) = lu(k,568) * lu(k,565) - lu(k,569) = lu(k,569) * lu(k,565) - lu(k,570) = lu(k,570) * lu(k,565) - lu(k,571) = lu(k,571) * lu(k,565) - lu(k,572) = lu(k,572) * lu(k,565) - lu(k,592) = lu(k,592) - lu(k,566) * lu(k,591) - lu(k,593) = lu(k,593) - lu(k,567) * lu(k,591) - lu(k,594) = lu(k,594) - lu(k,568) * lu(k,591) - lu(k,595) = lu(k,595) - lu(k,569) * lu(k,591) - lu(k,596) = lu(k,596) - lu(k,570) * lu(k,591) - lu(k,597) = lu(k,597) - lu(k,571) * lu(k,591) - lu(k,598) = lu(k,598) - lu(k,572) * lu(k,591) - lu(k,623) = lu(k,623) - lu(k,566) * lu(k,622) - lu(k,624) = lu(k,624) - lu(k,567) * lu(k,622) - lu(k,625) = lu(k,625) - lu(k,568) * lu(k,622) - lu(k,626) = lu(k,626) - lu(k,569) * lu(k,622) - lu(k,627) = lu(k,627) - lu(k,570) * lu(k,622) - lu(k,628) = lu(k,628) - lu(k,571) * lu(k,622) - lu(k,629) = lu(k,629) - lu(k,572) * lu(k,622) - lu(k,660) = lu(k,660) - lu(k,566) * lu(k,659) - lu(k,661) = lu(k,661) - lu(k,567) * lu(k,659) - lu(k,662) = lu(k,662) - lu(k,568) * lu(k,659) - lu(k,663) = lu(k,663) - lu(k,569) * lu(k,659) - lu(k,664) = lu(k,664) - lu(k,570) * lu(k,659) - lu(k,665) = lu(k,665) - lu(k,571) * lu(k,659) - lu(k,666) = lu(k,666) - lu(k,572) * lu(k,659) - lu(k,682) = lu(k,682) - lu(k,566) * lu(k,681) - lu(k,683) = lu(k,683) - lu(k,567) * lu(k,681) - lu(k,684) = lu(k,684) - lu(k,568) * lu(k,681) - lu(k,685) = lu(k,685) - lu(k,569) * lu(k,681) - lu(k,686) = lu(k,686) - lu(k,570) * lu(k,681) - lu(k,687) = lu(k,687) - lu(k,571) * lu(k,681) - lu(k,688) = lu(k,688) - lu(k,572) * lu(k,681) - lu(k,710) = lu(k,710) - lu(k,566) * lu(k,709) - lu(k,711) = lu(k,711) - lu(k,567) * lu(k,709) - lu(k,712) = lu(k,712) - lu(k,568) * lu(k,709) - lu(k,713) = lu(k,713) - lu(k,569) * lu(k,709) - lu(k,714) = lu(k,714) - lu(k,570) * lu(k,709) - lu(k,715) = lu(k,715) - lu(k,571) * lu(k,709) - lu(k,716) = lu(k,716) - lu(k,572) * lu(k,709) - lu(k,733) = lu(k,733) - lu(k,566) * lu(k,732) - lu(k,734) = lu(k,734) - lu(k,567) * lu(k,732) - lu(k,735) = lu(k,735) - lu(k,568) * lu(k,732) - lu(k,736) = lu(k,736) - lu(k,569) * lu(k,732) - lu(k,737) = lu(k,737) - lu(k,570) * lu(k,732) - lu(k,738) = lu(k,738) - lu(k,571) * lu(k,732) - lu(k,739) = lu(k,739) - lu(k,572) * lu(k,732) - lu(k,758) = lu(k,758) - lu(k,566) * lu(k,757) - lu(k,759) = lu(k,759) - lu(k,567) * lu(k,757) - lu(k,760) = lu(k,760) - lu(k,568) * lu(k,757) - lu(k,761) = lu(k,761) - lu(k,569) * lu(k,757) - lu(k,762) = lu(k,762) - lu(k,570) * lu(k,757) - lu(k,763) = lu(k,763) - lu(k,571) * lu(k,757) - lu(k,764) = lu(k,764) - lu(k,572) * lu(k,757) - lu(k,592) = 1._r8 / lu(k,592) - lu(k,593) = lu(k,593) * lu(k,592) - lu(k,594) = lu(k,594) * lu(k,592) - lu(k,595) = lu(k,595) * lu(k,592) - lu(k,596) = lu(k,596) * lu(k,592) - lu(k,597) = lu(k,597) * lu(k,592) - lu(k,598) = lu(k,598) * lu(k,592) - lu(k,624) = lu(k,624) - lu(k,593) * lu(k,623) - lu(k,625) = lu(k,625) - lu(k,594) * lu(k,623) - lu(k,626) = lu(k,626) - lu(k,595) * lu(k,623) - lu(k,627) = lu(k,627) - lu(k,596) * lu(k,623) - lu(k,628) = lu(k,628) - lu(k,597) * lu(k,623) - lu(k,629) = lu(k,629) - lu(k,598) * lu(k,623) - lu(k,661) = lu(k,661) - lu(k,593) * lu(k,660) - lu(k,662) = lu(k,662) - lu(k,594) * lu(k,660) - lu(k,663) = lu(k,663) - lu(k,595) * lu(k,660) - lu(k,664) = lu(k,664) - lu(k,596) * lu(k,660) - lu(k,665) = lu(k,665) - lu(k,597) * lu(k,660) - lu(k,666) = lu(k,666) - lu(k,598) * lu(k,660) - lu(k,683) = lu(k,683) - lu(k,593) * lu(k,682) - lu(k,684) = lu(k,684) - lu(k,594) * lu(k,682) - lu(k,685) = lu(k,685) - lu(k,595) * lu(k,682) - lu(k,686) = lu(k,686) - lu(k,596) * lu(k,682) - lu(k,687) = lu(k,687) - lu(k,597) * lu(k,682) - lu(k,688) = lu(k,688) - lu(k,598) * lu(k,682) - lu(k,711) = lu(k,711) - lu(k,593) * lu(k,710) - lu(k,712) = lu(k,712) - lu(k,594) * lu(k,710) - lu(k,713) = lu(k,713) - lu(k,595) * lu(k,710) - lu(k,714) = lu(k,714) - lu(k,596) * lu(k,710) - lu(k,715) = lu(k,715) - lu(k,597) * lu(k,710) - lu(k,716) = lu(k,716) - lu(k,598) * lu(k,710) - lu(k,734) = lu(k,734) - lu(k,593) * lu(k,733) - lu(k,735) = lu(k,735) - lu(k,594) * lu(k,733) - lu(k,736) = lu(k,736) - lu(k,595) * lu(k,733) - lu(k,737) = lu(k,737) - lu(k,596) * lu(k,733) - lu(k,738) = lu(k,738) - lu(k,597) * lu(k,733) - lu(k,739) = lu(k,739) - lu(k,598) * lu(k,733) - lu(k,759) = lu(k,759) - lu(k,593) * lu(k,758) - lu(k,760) = lu(k,760) - lu(k,594) * lu(k,758) - lu(k,761) = lu(k,761) - lu(k,595) * lu(k,758) - lu(k,762) = lu(k,762) - lu(k,596) * lu(k,758) - lu(k,763) = lu(k,763) - lu(k,597) * lu(k,758) - lu(k,764) = lu(k,764) - lu(k,598) * lu(k,758) + lu(k,462) = lu(k,462) * lu(k,450) + lu(k,463) = lu(k,463) * lu(k,450) + lu(k,464) = lu(k,464) * lu(k,450) + lu(k,465) = lu(k,465) * lu(k,450) + lu(k,473) = lu(k,473) - lu(k,451) * lu(k,471) + lu(k,474) = lu(k,474) - lu(k,452) * lu(k,471) + lu(k,475) = lu(k,475) - lu(k,453) * lu(k,471) + lu(k,476) = - lu(k,454) * lu(k,471) + lu(k,477) = lu(k,477) - lu(k,455) * lu(k,471) + lu(k,478) = lu(k,478) - lu(k,456) * lu(k,471) + lu(k,480) = lu(k,480) - lu(k,457) * lu(k,471) + lu(k,481) = lu(k,481) - lu(k,458) * lu(k,471) + lu(k,482) = lu(k,482) - lu(k,459) * lu(k,471) + lu(k,483) = lu(k,483) - lu(k,460) * lu(k,471) + lu(k,484) = lu(k,484) - lu(k,461) * lu(k,471) + lu(k,485) = lu(k,485) - lu(k,462) * lu(k,471) + lu(k,486) = lu(k,486) - lu(k,463) * lu(k,471) + lu(k,487) = lu(k,487) - lu(k,464) * lu(k,471) + lu(k,488) = lu(k,488) - lu(k,465) * lu(k,471) + lu(k,550) = lu(k,550) - lu(k,451) * lu(k,548) + lu(k,551) = lu(k,551) - lu(k,452) * lu(k,548) + lu(k,552) = lu(k,552) - lu(k,453) * lu(k,548) + lu(k,553) = lu(k,553) - lu(k,454) * lu(k,548) + lu(k,554) = lu(k,554) - lu(k,455) * lu(k,548) + lu(k,555) = lu(k,555) - lu(k,456) * lu(k,548) + lu(k,557) = lu(k,557) - lu(k,457) * lu(k,548) + lu(k,558) = lu(k,558) - lu(k,458) * lu(k,548) + lu(k,559) = lu(k,559) - lu(k,459) * lu(k,548) + lu(k,560) = lu(k,560) - lu(k,460) * lu(k,548) + lu(k,561) = lu(k,561) - lu(k,461) * lu(k,548) + lu(k,562) = - lu(k,462) * lu(k,548) + lu(k,563) = lu(k,563) - lu(k,463) * lu(k,548) + lu(k,564) = lu(k,564) - lu(k,464) * lu(k,548) + lu(k,565) = lu(k,565) - lu(k,465) * lu(k,548) + lu(k,578) = lu(k,578) - lu(k,451) * lu(k,576) + lu(k,579) = lu(k,579) - lu(k,452) * lu(k,576) + lu(k,580) = lu(k,580) - lu(k,453) * lu(k,576) + lu(k,581) = lu(k,581) - lu(k,454) * lu(k,576) + lu(k,582) = lu(k,582) - lu(k,455) * lu(k,576) + lu(k,583) = lu(k,583) - lu(k,456) * lu(k,576) + lu(k,585) = - lu(k,457) * lu(k,576) + lu(k,586) = lu(k,586) - lu(k,458) * lu(k,576) + lu(k,587) = lu(k,587) - lu(k,459) * lu(k,576) + lu(k,588) = lu(k,588) - lu(k,460) * lu(k,576) + lu(k,589) = lu(k,589) - lu(k,461) * lu(k,576) + lu(k,590) = lu(k,590) - lu(k,462) * lu(k,576) + lu(k,591) = lu(k,591) - lu(k,463) * lu(k,576) + lu(k,592) = lu(k,592) - lu(k,464) * lu(k,576) + lu(k,593) = lu(k,593) - lu(k,465) * lu(k,576) + lu(k,645) = lu(k,645) - lu(k,451) * lu(k,643) + lu(k,646) = lu(k,646) - lu(k,452) * lu(k,643) + lu(k,647) = lu(k,647) - lu(k,453) * lu(k,643) + lu(k,648) = lu(k,648) - lu(k,454) * lu(k,643) + lu(k,649) = lu(k,649) - lu(k,455) * lu(k,643) + lu(k,650) = lu(k,650) - lu(k,456) * lu(k,643) + lu(k,652) = lu(k,652) - lu(k,457) * lu(k,643) + lu(k,653) = lu(k,653) - lu(k,458) * lu(k,643) + lu(k,654) = lu(k,654) - lu(k,459) * lu(k,643) + lu(k,655) = lu(k,655) - lu(k,460) * lu(k,643) + lu(k,656) = lu(k,656) - lu(k,461) * lu(k,643) + lu(k,657) = lu(k,657) - lu(k,462) * lu(k,643) + lu(k,658) = lu(k,658) - lu(k,463) * lu(k,643) + lu(k,659) = lu(k,659) - lu(k,464) * lu(k,643) + lu(k,660) = lu(k,660) - lu(k,465) * lu(k,643) + lu(k,712) = lu(k,712) - lu(k,451) * lu(k,710) + lu(k,713) = lu(k,713) - lu(k,452) * lu(k,710) + lu(k,714) = lu(k,714) - lu(k,453) * lu(k,710) + lu(k,715) = lu(k,715) - lu(k,454) * lu(k,710) + lu(k,716) = lu(k,716) - lu(k,455) * lu(k,710) + lu(k,717) = lu(k,717) - lu(k,456) * lu(k,710) + lu(k,719) = lu(k,719) - lu(k,457) * lu(k,710) + lu(k,720) = lu(k,720) - lu(k,458) * lu(k,710) + lu(k,721) = lu(k,721) - lu(k,459) * lu(k,710) + lu(k,722) = lu(k,722) - lu(k,460) * lu(k,710) + lu(k,723) = lu(k,723) - lu(k,461) * lu(k,710) + lu(k,724) = lu(k,724) - lu(k,462) * lu(k,710) + lu(k,725) = lu(k,725) - lu(k,463) * lu(k,710) + lu(k,726) = lu(k,726) - lu(k,464) * lu(k,710) + lu(k,727) = lu(k,727) - lu(k,465) * lu(k,710) + lu(k,736) = lu(k,736) - lu(k,451) * lu(k,735) + lu(k,737) = lu(k,737) - lu(k,452) * lu(k,735) + lu(k,738) = lu(k,738) - lu(k,453) * lu(k,735) + lu(k,739) = lu(k,739) - lu(k,454) * lu(k,735) + lu(k,740) = lu(k,740) - lu(k,455) * lu(k,735) + lu(k,741) = lu(k,741) - lu(k,456) * lu(k,735) + lu(k,743) = - lu(k,457) * lu(k,735) + lu(k,744) = lu(k,744) - lu(k,458) * lu(k,735) + lu(k,745) = lu(k,745) - lu(k,459) * lu(k,735) + lu(k,746) = lu(k,746) - lu(k,460) * lu(k,735) + lu(k,747) = lu(k,747) - lu(k,461) * lu(k,735) + lu(k,748) = lu(k,748) - lu(k,462) * lu(k,735) + lu(k,749) = lu(k,749) - lu(k,463) * lu(k,735) + lu(k,750) = lu(k,750) - lu(k,464) * lu(k,735) + lu(k,751) = lu(k,751) - lu(k,465) * lu(k,735) + lu(k,787) = lu(k,787) - lu(k,451) * lu(k,786) + lu(k,788) = lu(k,788) - lu(k,452) * lu(k,786) + lu(k,789) = lu(k,789) - lu(k,453) * lu(k,786) + lu(k,790) = lu(k,790) - lu(k,454) * lu(k,786) + lu(k,791) = lu(k,791) - lu(k,455) * lu(k,786) + lu(k,792) = lu(k,792) - lu(k,456) * lu(k,786) + lu(k,794) = lu(k,794) - lu(k,457) * lu(k,786) + lu(k,795) = lu(k,795) - lu(k,458) * lu(k,786) + lu(k,796) = lu(k,796) - lu(k,459) * lu(k,786) + lu(k,797) = lu(k,797) - lu(k,460) * lu(k,786) + lu(k,798) = lu(k,798) - lu(k,461) * lu(k,786) + lu(k,799) = lu(k,799) - lu(k,462) * lu(k,786) + lu(k,800) = lu(k,800) - lu(k,463) * lu(k,786) + lu(k,801) = lu(k,801) - lu(k,464) * lu(k,786) + lu(k,802) = lu(k,802) - lu(k,465) * lu(k,786) + lu(k,836) = lu(k,836) - lu(k,451) * lu(k,834) + lu(k,837) = lu(k,837) - lu(k,452) * lu(k,834) + lu(k,838) = lu(k,838) - lu(k,453) * lu(k,834) + lu(k,839) = lu(k,839) - lu(k,454) * lu(k,834) + lu(k,840) = lu(k,840) - lu(k,455) * lu(k,834) + lu(k,841) = lu(k,841) - lu(k,456) * lu(k,834) + lu(k,843) = lu(k,843) - lu(k,457) * lu(k,834) + lu(k,844) = lu(k,844) - lu(k,458) * lu(k,834) + lu(k,845) = lu(k,845) - lu(k,459) * lu(k,834) + lu(k,846) = lu(k,846) - lu(k,460) * lu(k,834) + lu(k,847) = lu(k,847) - lu(k,461) * lu(k,834) + lu(k,848) = lu(k,848) - lu(k,462) * lu(k,834) + lu(k,849) = lu(k,849) - lu(k,463) * lu(k,834) + lu(k,850) = lu(k,850) - lu(k,464) * lu(k,834) + lu(k,851) = lu(k,851) - lu(k,465) * lu(k,834) + lu(k,859) = lu(k,859) - lu(k,451) * lu(k,857) + lu(k,860) = lu(k,860) - lu(k,452) * lu(k,857) + lu(k,861) = lu(k,861) - lu(k,453) * lu(k,857) + lu(k,862) = lu(k,862) - lu(k,454) * lu(k,857) + lu(k,863) = lu(k,863) - lu(k,455) * lu(k,857) + lu(k,864) = lu(k,864) - lu(k,456) * lu(k,857) + lu(k,866) = lu(k,866) - lu(k,457) * lu(k,857) + lu(k,867) = - lu(k,458) * lu(k,857) + lu(k,868) = - lu(k,459) * lu(k,857) + lu(k,869) = lu(k,869) - lu(k,460) * lu(k,857) + lu(k,870) = lu(k,870) - lu(k,461) * lu(k,857) + lu(k,871) = lu(k,871) - lu(k,462) * lu(k,857) + lu(k,872) = lu(k,872) - lu(k,463) * lu(k,857) + lu(k,873) = lu(k,873) - lu(k,464) * lu(k,857) + lu(k,874) = lu(k,874) - lu(k,465) * lu(k,857) + lu(k,891) = lu(k,891) - lu(k,451) * lu(k,889) + lu(k,892) = lu(k,892) - lu(k,452) * lu(k,889) + lu(k,893) = lu(k,893) - lu(k,453) * lu(k,889) + lu(k,894) = lu(k,894) - lu(k,454) * lu(k,889) + lu(k,895) = lu(k,895) - lu(k,455) * lu(k,889) + lu(k,896) = lu(k,896) - lu(k,456) * lu(k,889) + lu(k,898) = lu(k,898) - lu(k,457) * lu(k,889) + lu(k,899) = - lu(k,458) * lu(k,889) + lu(k,900) = lu(k,900) - lu(k,459) * lu(k,889) + lu(k,901) = lu(k,901) - lu(k,460) * lu(k,889) + lu(k,902) = lu(k,902) - lu(k,461) * lu(k,889) + lu(k,903) = lu(k,903) - lu(k,462) * lu(k,889) + lu(k,904) = lu(k,904) - lu(k,463) * lu(k,889) + lu(k,905) = lu(k,905) - lu(k,464) * lu(k,889) + lu(k,906) = lu(k,906) - lu(k,465) * lu(k,889) + lu(k,914) = lu(k,914) - lu(k,451) * lu(k,912) + lu(k,915) = lu(k,915) - lu(k,452) * lu(k,912) + lu(k,916) = lu(k,916) - lu(k,453) * lu(k,912) + lu(k,917) = lu(k,917) - lu(k,454) * lu(k,912) + lu(k,918) = lu(k,918) - lu(k,455) * lu(k,912) + lu(k,919) = lu(k,919) - lu(k,456) * lu(k,912) + lu(k,921) = lu(k,921) - lu(k,457) * lu(k,912) + lu(k,922) = - lu(k,458) * lu(k,912) + lu(k,923) = - lu(k,459) * lu(k,912) + lu(k,924) = lu(k,924) - lu(k,460) * lu(k,912) + lu(k,925) = lu(k,925) - lu(k,461) * lu(k,912) + lu(k,926) = lu(k,926) - lu(k,462) * lu(k,912) + lu(k,927) = lu(k,927) - lu(k,463) * lu(k,912) + lu(k,928) = lu(k,928) - lu(k,464) * lu(k,912) + lu(k,929) = lu(k,929) - lu(k,465) * lu(k,912) + lu(k,941) = lu(k,941) - lu(k,451) * lu(k,939) + lu(k,942) = lu(k,942) - lu(k,452) * lu(k,939) + lu(k,943) = lu(k,943) - lu(k,453) * lu(k,939) + lu(k,944) = lu(k,944) - lu(k,454) * lu(k,939) + lu(k,945) = lu(k,945) - lu(k,455) * lu(k,939) + lu(k,946) = lu(k,946) - lu(k,456) * lu(k,939) + lu(k,948) = lu(k,948) - lu(k,457) * lu(k,939) + lu(k,949) = lu(k,949) - lu(k,458) * lu(k,939) + lu(k,950) = lu(k,950) - lu(k,459) * lu(k,939) + lu(k,951) = lu(k,951) - lu(k,460) * lu(k,939) + lu(k,952) = lu(k,952) - lu(k,461) * lu(k,939) + lu(k,953) = lu(k,953) - lu(k,462) * lu(k,939) + lu(k,954) = lu(k,954) - lu(k,463) * lu(k,939) + lu(k,955) = lu(k,955) - lu(k,464) * lu(k,939) + lu(k,956) = lu(k,956) - lu(k,465) * lu(k,939) + lu(k,472) = 1._r8 / lu(k,472) + lu(k,473) = lu(k,473) * lu(k,472) + lu(k,474) = lu(k,474) * lu(k,472) + lu(k,475) = lu(k,475) * lu(k,472) + lu(k,476) = lu(k,476) * lu(k,472) + lu(k,477) = lu(k,477) * lu(k,472) + lu(k,478) = lu(k,478) * lu(k,472) + lu(k,479) = lu(k,479) * lu(k,472) + lu(k,480) = lu(k,480) * lu(k,472) + lu(k,481) = lu(k,481) * lu(k,472) + lu(k,482) = lu(k,482) * lu(k,472) + lu(k,483) = lu(k,483) * lu(k,472) + lu(k,484) = lu(k,484) * lu(k,472) + lu(k,485) = lu(k,485) * lu(k,472) + lu(k,486) = lu(k,486) * lu(k,472) + lu(k,487) = lu(k,487) * lu(k,472) + lu(k,488) = lu(k,488) * lu(k,472) + lu(k,550) = lu(k,550) - lu(k,473) * lu(k,549) + lu(k,551) = lu(k,551) - lu(k,474) * lu(k,549) + lu(k,552) = lu(k,552) - lu(k,475) * lu(k,549) + lu(k,553) = lu(k,553) - lu(k,476) * lu(k,549) + lu(k,554) = lu(k,554) - lu(k,477) * lu(k,549) + lu(k,555) = lu(k,555) - lu(k,478) * lu(k,549) + lu(k,556) = lu(k,556) - lu(k,479) * lu(k,549) + lu(k,557) = lu(k,557) - lu(k,480) * lu(k,549) + lu(k,558) = lu(k,558) - lu(k,481) * lu(k,549) + lu(k,559) = lu(k,559) - lu(k,482) * lu(k,549) + lu(k,560) = lu(k,560) - lu(k,483) * lu(k,549) + lu(k,561) = lu(k,561) - lu(k,484) * lu(k,549) + lu(k,562) = lu(k,562) - lu(k,485) * lu(k,549) + lu(k,563) = lu(k,563) - lu(k,486) * lu(k,549) + lu(k,564) = lu(k,564) - lu(k,487) * lu(k,549) + lu(k,565) = lu(k,565) - lu(k,488) * lu(k,549) + lu(k,578) = lu(k,578) - lu(k,473) * lu(k,577) + lu(k,579) = lu(k,579) - lu(k,474) * lu(k,577) + lu(k,580) = lu(k,580) - lu(k,475) * lu(k,577) + lu(k,581) = lu(k,581) - lu(k,476) * lu(k,577) + lu(k,582) = lu(k,582) - lu(k,477) * lu(k,577) + lu(k,583) = lu(k,583) - lu(k,478) * lu(k,577) + lu(k,584) = lu(k,584) - lu(k,479) * lu(k,577) + lu(k,585) = lu(k,585) - lu(k,480) * lu(k,577) + lu(k,586) = lu(k,586) - lu(k,481) * lu(k,577) + lu(k,587) = lu(k,587) - lu(k,482) * lu(k,577) + lu(k,588) = lu(k,588) - lu(k,483) * lu(k,577) + lu(k,589) = lu(k,589) - lu(k,484) * lu(k,577) + lu(k,590) = lu(k,590) - lu(k,485) * lu(k,577) + lu(k,591) = lu(k,591) - lu(k,486) * lu(k,577) + lu(k,592) = lu(k,592) - lu(k,487) * lu(k,577) + lu(k,593) = lu(k,593) - lu(k,488) * lu(k,577) + lu(k,603) = lu(k,603) - lu(k,473) * lu(k,602) + lu(k,604) = lu(k,604) - lu(k,474) * lu(k,602) + lu(k,605) = lu(k,605) - lu(k,475) * lu(k,602) + lu(k,606) = lu(k,606) - lu(k,476) * lu(k,602) + lu(k,607) = lu(k,607) - lu(k,477) * lu(k,602) + lu(k,608) = lu(k,608) - lu(k,478) * lu(k,602) + lu(k,609) = lu(k,609) - lu(k,479) * lu(k,602) + lu(k,610) = lu(k,610) - lu(k,480) * lu(k,602) + lu(k,611) = lu(k,611) - lu(k,481) * lu(k,602) + lu(k,612) = lu(k,612) - lu(k,482) * lu(k,602) + lu(k,613) = lu(k,613) - lu(k,483) * lu(k,602) + lu(k,614) = lu(k,614) - lu(k,484) * lu(k,602) + lu(k,615) = lu(k,615) - lu(k,485) * lu(k,602) + lu(k,616) = lu(k,616) - lu(k,486) * lu(k,602) + lu(k,617) = lu(k,617) - lu(k,487) * lu(k,602) + lu(k,618) = lu(k,618) - lu(k,488) * lu(k,602) + lu(k,645) = lu(k,645) - lu(k,473) * lu(k,644) + lu(k,646) = lu(k,646) - lu(k,474) * lu(k,644) + lu(k,647) = lu(k,647) - lu(k,475) * lu(k,644) + lu(k,648) = lu(k,648) - lu(k,476) * lu(k,644) + lu(k,649) = lu(k,649) - lu(k,477) * lu(k,644) + lu(k,650) = lu(k,650) - lu(k,478) * lu(k,644) + lu(k,651) = lu(k,651) - lu(k,479) * lu(k,644) + lu(k,652) = lu(k,652) - lu(k,480) * lu(k,644) + lu(k,653) = lu(k,653) - lu(k,481) * lu(k,644) + lu(k,654) = lu(k,654) - lu(k,482) * lu(k,644) + lu(k,655) = lu(k,655) - lu(k,483) * lu(k,644) + lu(k,656) = lu(k,656) - lu(k,484) * lu(k,644) + lu(k,657) = lu(k,657) - lu(k,485) * lu(k,644) + lu(k,658) = lu(k,658) - lu(k,486) * lu(k,644) + lu(k,659) = lu(k,659) - lu(k,487) * lu(k,644) + lu(k,660) = lu(k,660) - lu(k,488) * lu(k,644) + lu(k,670) = lu(k,670) - lu(k,473) * lu(k,669) + lu(k,671) = lu(k,671) - lu(k,474) * lu(k,669) + lu(k,672) = lu(k,672) - lu(k,475) * lu(k,669) + lu(k,673) = lu(k,673) - lu(k,476) * lu(k,669) + lu(k,674) = lu(k,674) - lu(k,477) * lu(k,669) + lu(k,675) = lu(k,675) - lu(k,478) * lu(k,669) + lu(k,676) = lu(k,676) - lu(k,479) * lu(k,669) + lu(k,677) = lu(k,677) - lu(k,480) * lu(k,669) + lu(k,678) = lu(k,678) - lu(k,481) * lu(k,669) + lu(k,679) = lu(k,679) - lu(k,482) * lu(k,669) + lu(k,680) = lu(k,680) - lu(k,483) * lu(k,669) + lu(k,681) = lu(k,681) - lu(k,484) * lu(k,669) + lu(k,682) = - lu(k,485) * lu(k,669) + lu(k,683) = lu(k,683) - lu(k,486) * lu(k,669) + lu(k,684) = lu(k,684) - lu(k,487) * lu(k,669) + lu(k,685) = lu(k,685) - lu(k,488) * lu(k,669) + lu(k,712) = lu(k,712) - lu(k,473) * lu(k,711) + lu(k,713) = lu(k,713) - lu(k,474) * lu(k,711) + lu(k,714) = lu(k,714) - lu(k,475) * lu(k,711) + lu(k,715) = lu(k,715) - lu(k,476) * lu(k,711) + lu(k,716) = lu(k,716) - lu(k,477) * lu(k,711) + lu(k,717) = lu(k,717) - lu(k,478) * lu(k,711) + lu(k,718) = lu(k,718) - lu(k,479) * lu(k,711) + lu(k,719) = lu(k,719) - lu(k,480) * lu(k,711) + lu(k,720) = lu(k,720) - lu(k,481) * lu(k,711) + lu(k,721) = lu(k,721) - lu(k,482) * lu(k,711) + lu(k,722) = lu(k,722) - lu(k,483) * lu(k,711) + lu(k,723) = lu(k,723) - lu(k,484) * lu(k,711) + lu(k,724) = lu(k,724) - lu(k,485) * lu(k,711) + lu(k,725) = lu(k,725) - lu(k,486) * lu(k,711) + lu(k,726) = lu(k,726) - lu(k,487) * lu(k,711) + lu(k,727) = lu(k,727) - lu(k,488) * lu(k,711) + lu(k,758) = lu(k,758) - lu(k,473) * lu(k,757) + lu(k,759) = lu(k,759) - lu(k,474) * lu(k,757) + lu(k,760) = lu(k,760) - lu(k,475) * lu(k,757) + lu(k,761) = - lu(k,476) * lu(k,757) + lu(k,762) = - lu(k,477) * lu(k,757) + lu(k,763) = lu(k,763) - lu(k,478) * lu(k,757) + lu(k,764) = lu(k,764) - lu(k,479) * lu(k,757) + lu(k,765) = lu(k,765) - lu(k,480) * lu(k,757) + lu(k,766) = lu(k,766) - lu(k,481) * lu(k,757) + lu(k,767) = lu(k,767) - lu(k,482) * lu(k,757) + lu(k,768) = lu(k,768) - lu(k,483) * lu(k,757) + lu(k,769) = lu(k,769) - lu(k,484) * lu(k,757) + lu(k,770) = - lu(k,485) * lu(k,757) + lu(k,771) = - lu(k,486) * lu(k,757) + lu(k,772) = lu(k,772) - lu(k,487) * lu(k,757) + lu(k,773) = lu(k,773) - lu(k,488) * lu(k,757) + lu(k,836) = lu(k,836) - lu(k,473) * lu(k,835) + lu(k,837) = lu(k,837) - lu(k,474) * lu(k,835) + lu(k,838) = lu(k,838) - lu(k,475) * lu(k,835) + lu(k,839) = lu(k,839) - lu(k,476) * lu(k,835) + lu(k,840) = lu(k,840) - lu(k,477) * lu(k,835) + lu(k,841) = lu(k,841) - lu(k,478) * lu(k,835) + lu(k,842) = lu(k,842) - lu(k,479) * lu(k,835) + lu(k,843) = lu(k,843) - lu(k,480) * lu(k,835) + lu(k,844) = lu(k,844) - lu(k,481) * lu(k,835) + lu(k,845) = lu(k,845) - lu(k,482) * lu(k,835) + lu(k,846) = lu(k,846) - lu(k,483) * lu(k,835) + lu(k,847) = lu(k,847) - lu(k,484) * lu(k,835) + lu(k,848) = lu(k,848) - lu(k,485) * lu(k,835) + lu(k,849) = lu(k,849) - lu(k,486) * lu(k,835) + lu(k,850) = lu(k,850) - lu(k,487) * lu(k,835) + lu(k,851) = lu(k,851) - lu(k,488) * lu(k,835) + lu(k,859) = lu(k,859) - lu(k,473) * lu(k,858) + lu(k,860) = lu(k,860) - lu(k,474) * lu(k,858) + lu(k,861) = lu(k,861) - lu(k,475) * lu(k,858) + lu(k,862) = lu(k,862) - lu(k,476) * lu(k,858) + lu(k,863) = lu(k,863) - lu(k,477) * lu(k,858) + lu(k,864) = lu(k,864) - lu(k,478) * lu(k,858) + lu(k,865) = lu(k,865) - lu(k,479) * lu(k,858) + lu(k,866) = lu(k,866) - lu(k,480) * lu(k,858) + lu(k,867) = lu(k,867) - lu(k,481) * lu(k,858) + lu(k,868) = lu(k,868) - lu(k,482) * lu(k,858) + lu(k,869) = lu(k,869) - lu(k,483) * lu(k,858) + lu(k,870) = lu(k,870) - lu(k,484) * lu(k,858) + lu(k,871) = lu(k,871) - lu(k,485) * lu(k,858) + lu(k,872) = lu(k,872) - lu(k,486) * lu(k,858) + lu(k,873) = lu(k,873) - lu(k,487) * lu(k,858) + lu(k,874) = lu(k,874) - lu(k,488) * lu(k,858) + lu(k,891) = lu(k,891) - lu(k,473) * lu(k,890) + lu(k,892) = lu(k,892) - lu(k,474) * lu(k,890) + lu(k,893) = lu(k,893) - lu(k,475) * lu(k,890) + lu(k,894) = lu(k,894) - lu(k,476) * lu(k,890) + lu(k,895) = lu(k,895) - lu(k,477) * lu(k,890) + lu(k,896) = lu(k,896) - lu(k,478) * lu(k,890) + lu(k,897) = lu(k,897) - lu(k,479) * lu(k,890) + lu(k,898) = lu(k,898) - lu(k,480) * lu(k,890) + lu(k,899) = lu(k,899) - lu(k,481) * lu(k,890) + lu(k,900) = lu(k,900) - lu(k,482) * lu(k,890) + lu(k,901) = lu(k,901) - lu(k,483) * lu(k,890) + lu(k,902) = lu(k,902) - lu(k,484) * lu(k,890) + lu(k,903) = lu(k,903) - lu(k,485) * lu(k,890) + lu(k,904) = lu(k,904) - lu(k,486) * lu(k,890) + lu(k,905) = lu(k,905) - lu(k,487) * lu(k,890) + lu(k,906) = lu(k,906) - lu(k,488) * lu(k,890) + lu(k,914) = lu(k,914) - lu(k,473) * lu(k,913) + lu(k,915) = lu(k,915) - lu(k,474) * lu(k,913) + lu(k,916) = lu(k,916) - lu(k,475) * lu(k,913) + lu(k,917) = lu(k,917) - lu(k,476) * lu(k,913) + lu(k,918) = lu(k,918) - lu(k,477) * lu(k,913) + lu(k,919) = lu(k,919) - lu(k,478) * lu(k,913) + lu(k,920) = lu(k,920) - lu(k,479) * lu(k,913) + lu(k,921) = lu(k,921) - lu(k,480) * lu(k,913) + lu(k,922) = lu(k,922) - lu(k,481) * lu(k,913) + lu(k,923) = lu(k,923) - lu(k,482) * lu(k,913) + lu(k,924) = lu(k,924) - lu(k,483) * lu(k,913) + lu(k,925) = lu(k,925) - lu(k,484) * lu(k,913) + lu(k,926) = lu(k,926) - lu(k,485) * lu(k,913) + lu(k,927) = lu(k,927) - lu(k,486) * lu(k,913) + lu(k,928) = lu(k,928) - lu(k,487) * lu(k,913) + lu(k,929) = lu(k,929) - lu(k,488) * lu(k,913) + lu(k,941) = lu(k,941) - lu(k,473) * lu(k,940) + lu(k,942) = lu(k,942) - lu(k,474) * lu(k,940) + lu(k,943) = lu(k,943) - lu(k,475) * lu(k,940) + lu(k,944) = lu(k,944) - lu(k,476) * lu(k,940) + lu(k,945) = lu(k,945) - lu(k,477) * lu(k,940) + lu(k,946) = lu(k,946) - lu(k,478) * lu(k,940) + lu(k,947) = lu(k,947) - lu(k,479) * lu(k,940) + lu(k,948) = lu(k,948) - lu(k,480) * lu(k,940) + lu(k,949) = lu(k,949) - lu(k,481) * lu(k,940) + lu(k,950) = lu(k,950) - lu(k,482) * lu(k,940) + lu(k,951) = lu(k,951) - lu(k,483) * lu(k,940) + lu(k,952) = lu(k,952) - lu(k,484) * lu(k,940) + lu(k,953) = lu(k,953) - lu(k,485) * lu(k,940) + lu(k,954) = lu(k,954) - lu(k,486) * lu(k,940) + lu(k,955) = lu(k,955) - lu(k,487) * lu(k,940) + lu(k,956) = lu(k,956) - lu(k,488) * lu(k,940) + lu(k,505) = 1._r8 / lu(k,505) + lu(k,506) = lu(k,506) * lu(k,505) + lu(k,507) = lu(k,507) * lu(k,505) + lu(k,508) = lu(k,508) * lu(k,505) + lu(k,509) = lu(k,509) * lu(k,505) + lu(k,510) = lu(k,510) * lu(k,505) + lu(k,511) = lu(k,511) * lu(k,505) + lu(k,512) = lu(k,512) * lu(k,505) + lu(k,513) = lu(k,513) * lu(k,505) + lu(k,514) = lu(k,514) * lu(k,505) + lu(k,515) = lu(k,515) * lu(k,505) + lu(k,516) = lu(k,516) * lu(k,505) + lu(k,517) = lu(k,517) * lu(k,505) + lu(k,518) = lu(k,518) * lu(k,505) + lu(k,526) = lu(k,526) - lu(k,506) * lu(k,525) + lu(k,527) = lu(k,527) - lu(k,507) * lu(k,525) + lu(k,528) = lu(k,528) - lu(k,508) * lu(k,525) + lu(k,530) = lu(k,530) - lu(k,509) * lu(k,525) + lu(k,531) = lu(k,531) - lu(k,510) * lu(k,525) + lu(k,532) = lu(k,532) - lu(k,511) * lu(k,525) + lu(k,533) = lu(k,533) - lu(k,512) * lu(k,525) + lu(k,534) = lu(k,534) - lu(k,513) * lu(k,525) + lu(k,535) = lu(k,535) - lu(k,514) * lu(k,525) + lu(k,536) = lu(k,536) - lu(k,515) * lu(k,525) + lu(k,537) = lu(k,537) - lu(k,516) * lu(k,525) + lu(k,538) = lu(k,538) - lu(k,517) * lu(k,525) + lu(k,539) = lu(k,539) - lu(k,518) * lu(k,525) + lu(k,551) = lu(k,551) - lu(k,506) * lu(k,550) + lu(k,552) = lu(k,552) - lu(k,507) * lu(k,550) + lu(k,553) = lu(k,553) - lu(k,508) * lu(k,550) + lu(k,555) = lu(k,555) - lu(k,509) * lu(k,550) + lu(k,556) = lu(k,556) - lu(k,510) * lu(k,550) + lu(k,557) = lu(k,557) - lu(k,511) * lu(k,550) + lu(k,558) = lu(k,558) - lu(k,512) * lu(k,550) + lu(k,559) = lu(k,559) - lu(k,513) * lu(k,550) + lu(k,560) = lu(k,560) - lu(k,514) * lu(k,550) + lu(k,561) = lu(k,561) - lu(k,515) * lu(k,550) + lu(k,563) = lu(k,563) - lu(k,516) * lu(k,550) + lu(k,564) = lu(k,564) - lu(k,517) * lu(k,550) + lu(k,565) = lu(k,565) - lu(k,518) * lu(k,550) + lu(k,579) = lu(k,579) - lu(k,506) * lu(k,578) + lu(k,580) = lu(k,580) - lu(k,507) * lu(k,578) + lu(k,581) = lu(k,581) - lu(k,508) * lu(k,578) + lu(k,583) = lu(k,583) - lu(k,509) * lu(k,578) + lu(k,584) = lu(k,584) - lu(k,510) * lu(k,578) + lu(k,585) = lu(k,585) - lu(k,511) * lu(k,578) + lu(k,586) = lu(k,586) - lu(k,512) * lu(k,578) + lu(k,587) = lu(k,587) - lu(k,513) * lu(k,578) + lu(k,588) = lu(k,588) - lu(k,514) * lu(k,578) + lu(k,589) = lu(k,589) - lu(k,515) * lu(k,578) + lu(k,591) = lu(k,591) - lu(k,516) * lu(k,578) + lu(k,592) = lu(k,592) - lu(k,517) * lu(k,578) + lu(k,593) = lu(k,593) - lu(k,518) * lu(k,578) + lu(k,604) = lu(k,604) - lu(k,506) * lu(k,603) + lu(k,605) = lu(k,605) - lu(k,507) * lu(k,603) + lu(k,606) = lu(k,606) - lu(k,508) * lu(k,603) + lu(k,608) = lu(k,608) - lu(k,509) * lu(k,603) + lu(k,609) = lu(k,609) - lu(k,510) * lu(k,603) + lu(k,610) = lu(k,610) - lu(k,511) * lu(k,603) + lu(k,611) = lu(k,611) - lu(k,512) * lu(k,603) + lu(k,612) = lu(k,612) - lu(k,513) * lu(k,603) + lu(k,613) = lu(k,613) - lu(k,514) * lu(k,603) + lu(k,614) = lu(k,614) - lu(k,515) * lu(k,603) + lu(k,616) = lu(k,616) - lu(k,516) * lu(k,603) + lu(k,617) = lu(k,617) - lu(k,517) * lu(k,603) + lu(k,618) = lu(k,618) - lu(k,518) * lu(k,603) + lu(k,646) = lu(k,646) - lu(k,506) * lu(k,645) + lu(k,647) = lu(k,647) - lu(k,507) * lu(k,645) + lu(k,648) = lu(k,648) - lu(k,508) * lu(k,645) + lu(k,650) = lu(k,650) - lu(k,509) * lu(k,645) + lu(k,651) = lu(k,651) - lu(k,510) * lu(k,645) + lu(k,652) = lu(k,652) - lu(k,511) * lu(k,645) + lu(k,653) = lu(k,653) - lu(k,512) * lu(k,645) + lu(k,654) = lu(k,654) - lu(k,513) * lu(k,645) + lu(k,655) = lu(k,655) - lu(k,514) * lu(k,645) + lu(k,656) = lu(k,656) - lu(k,515) * lu(k,645) + lu(k,658) = lu(k,658) - lu(k,516) * lu(k,645) + lu(k,659) = lu(k,659) - lu(k,517) * lu(k,645) + lu(k,660) = lu(k,660) - lu(k,518) * lu(k,645) + lu(k,671) = lu(k,671) - lu(k,506) * lu(k,670) + lu(k,672) = lu(k,672) - lu(k,507) * lu(k,670) + lu(k,673) = lu(k,673) - lu(k,508) * lu(k,670) + lu(k,675) = lu(k,675) - lu(k,509) * lu(k,670) + lu(k,676) = lu(k,676) - lu(k,510) * lu(k,670) + lu(k,677) = lu(k,677) - lu(k,511) * lu(k,670) + lu(k,678) = lu(k,678) - lu(k,512) * lu(k,670) + lu(k,679) = lu(k,679) - lu(k,513) * lu(k,670) + lu(k,680) = lu(k,680) - lu(k,514) * lu(k,670) + lu(k,681) = lu(k,681) - lu(k,515) * lu(k,670) + lu(k,683) = lu(k,683) - lu(k,516) * lu(k,670) + lu(k,684) = lu(k,684) - lu(k,517) * lu(k,670) + lu(k,685) = lu(k,685) - lu(k,518) * lu(k,670) + lu(k,713) = lu(k,713) - lu(k,506) * lu(k,712) + lu(k,714) = lu(k,714) - lu(k,507) * lu(k,712) + lu(k,715) = lu(k,715) - lu(k,508) * lu(k,712) + lu(k,717) = lu(k,717) - lu(k,509) * lu(k,712) + lu(k,718) = lu(k,718) - lu(k,510) * lu(k,712) + lu(k,719) = lu(k,719) - lu(k,511) * lu(k,712) + lu(k,720) = lu(k,720) - lu(k,512) * lu(k,712) + lu(k,721) = lu(k,721) - lu(k,513) * lu(k,712) + lu(k,722) = lu(k,722) - lu(k,514) * lu(k,712) + lu(k,723) = lu(k,723) - lu(k,515) * lu(k,712) + lu(k,725) = lu(k,725) - lu(k,516) * lu(k,712) + lu(k,726) = lu(k,726) - lu(k,517) * lu(k,712) + lu(k,727) = lu(k,727) - lu(k,518) * lu(k,712) + lu(k,737) = lu(k,737) - lu(k,506) * lu(k,736) + lu(k,738) = lu(k,738) - lu(k,507) * lu(k,736) + lu(k,739) = lu(k,739) - lu(k,508) * lu(k,736) + lu(k,741) = lu(k,741) - lu(k,509) * lu(k,736) + lu(k,742) = lu(k,742) - lu(k,510) * lu(k,736) + lu(k,743) = lu(k,743) - lu(k,511) * lu(k,736) + lu(k,744) = lu(k,744) - lu(k,512) * lu(k,736) + lu(k,745) = lu(k,745) - lu(k,513) * lu(k,736) + lu(k,746) = lu(k,746) - lu(k,514) * lu(k,736) + lu(k,747) = lu(k,747) - lu(k,515) * lu(k,736) + lu(k,749) = lu(k,749) - lu(k,516) * lu(k,736) + lu(k,750) = lu(k,750) - lu(k,517) * lu(k,736) + lu(k,751) = lu(k,751) - lu(k,518) * lu(k,736) + lu(k,759) = lu(k,759) - lu(k,506) * lu(k,758) + lu(k,760) = lu(k,760) - lu(k,507) * lu(k,758) + lu(k,761) = lu(k,761) - lu(k,508) * lu(k,758) + lu(k,763) = lu(k,763) - lu(k,509) * lu(k,758) + lu(k,764) = lu(k,764) - lu(k,510) * lu(k,758) + lu(k,765) = lu(k,765) - lu(k,511) * lu(k,758) + lu(k,766) = lu(k,766) - lu(k,512) * lu(k,758) + lu(k,767) = lu(k,767) - lu(k,513) * lu(k,758) + lu(k,768) = lu(k,768) - lu(k,514) * lu(k,758) + lu(k,769) = lu(k,769) - lu(k,515) * lu(k,758) + lu(k,771) = lu(k,771) - lu(k,516) * lu(k,758) + lu(k,772) = lu(k,772) - lu(k,517) * lu(k,758) + lu(k,773) = lu(k,773) - lu(k,518) * lu(k,758) + lu(k,788) = lu(k,788) - lu(k,506) * lu(k,787) + lu(k,789) = lu(k,789) - lu(k,507) * lu(k,787) + lu(k,790) = lu(k,790) - lu(k,508) * lu(k,787) + lu(k,792) = lu(k,792) - lu(k,509) * lu(k,787) + lu(k,793) = lu(k,793) - lu(k,510) * lu(k,787) + lu(k,794) = lu(k,794) - lu(k,511) * lu(k,787) + lu(k,795) = lu(k,795) - lu(k,512) * lu(k,787) + lu(k,796) = lu(k,796) - lu(k,513) * lu(k,787) + lu(k,797) = lu(k,797) - lu(k,514) * lu(k,787) + lu(k,798) = lu(k,798) - lu(k,515) * lu(k,787) + lu(k,800) = lu(k,800) - lu(k,516) * lu(k,787) + lu(k,801) = lu(k,801) - lu(k,517) * lu(k,787) + lu(k,802) = lu(k,802) - lu(k,518) * lu(k,787) + lu(k,837) = lu(k,837) - lu(k,506) * lu(k,836) + lu(k,838) = lu(k,838) - lu(k,507) * lu(k,836) + lu(k,839) = lu(k,839) - lu(k,508) * lu(k,836) + lu(k,841) = lu(k,841) - lu(k,509) * lu(k,836) + lu(k,842) = lu(k,842) - lu(k,510) * lu(k,836) + lu(k,843) = lu(k,843) - lu(k,511) * lu(k,836) + lu(k,844) = lu(k,844) - lu(k,512) * lu(k,836) + lu(k,845) = lu(k,845) - lu(k,513) * lu(k,836) + lu(k,846) = lu(k,846) - lu(k,514) * lu(k,836) + lu(k,847) = lu(k,847) - lu(k,515) * lu(k,836) + lu(k,849) = lu(k,849) - lu(k,516) * lu(k,836) + lu(k,850) = lu(k,850) - lu(k,517) * lu(k,836) + lu(k,851) = lu(k,851) - lu(k,518) * lu(k,836) + lu(k,860) = lu(k,860) - lu(k,506) * lu(k,859) + lu(k,861) = lu(k,861) - lu(k,507) * lu(k,859) + lu(k,862) = lu(k,862) - lu(k,508) * lu(k,859) + lu(k,864) = lu(k,864) - lu(k,509) * lu(k,859) + lu(k,865) = lu(k,865) - lu(k,510) * lu(k,859) + lu(k,866) = lu(k,866) - lu(k,511) * lu(k,859) + lu(k,867) = lu(k,867) - lu(k,512) * lu(k,859) + lu(k,868) = lu(k,868) - lu(k,513) * lu(k,859) + lu(k,869) = lu(k,869) - lu(k,514) * lu(k,859) + lu(k,870) = lu(k,870) - lu(k,515) * lu(k,859) + lu(k,872) = lu(k,872) - lu(k,516) * lu(k,859) + lu(k,873) = lu(k,873) - lu(k,517) * lu(k,859) + lu(k,874) = lu(k,874) - lu(k,518) * lu(k,859) + lu(k,892) = lu(k,892) - lu(k,506) * lu(k,891) + lu(k,893) = lu(k,893) - lu(k,507) * lu(k,891) + lu(k,894) = lu(k,894) - lu(k,508) * lu(k,891) + lu(k,896) = lu(k,896) - lu(k,509) * lu(k,891) + lu(k,897) = lu(k,897) - lu(k,510) * lu(k,891) + lu(k,898) = lu(k,898) - lu(k,511) * lu(k,891) + lu(k,899) = lu(k,899) - lu(k,512) * lu(k,891) + lu(k,900) = lu(k,900) - lu(k,513) * lu(k,891) + lu(k,901) = lu(k,901) - lu(k,514) * lu(k,891) + lu(k,902) = lu(k,902) - lu(k,515) * lu(k,891) + lu(k,904) = lu(k,904) - lu(k,516) * lu(k,891) + lu(k,905) = lu(k,905) - lu(k,517) * lu(k,891) + lu(k,906) = lu(k,906) - lu(k,518) * lu(k,891) + lu(k,915) = lu(k,915) - lu(k,506) * lu(k,914) + lu(k,916) = lu(k,916) - lu(k,507) * lu(k,914) + lu(k,917) = lu(k,917) - lu(k,508) * lu(k,914) + lu(k,919) = lu(k,919) - lu(k,509) * lu(k,914) + lu(k,920) = lu(k,920) - lu(k,510) * lu(k,914) + lu(k,921) = lu(k,921) - lu(k,511) * lu(k,914) + lu(k,922) = lu(k,922) - lu(k,512) * lu(k,914) + lu(k,923) = lu(k,923) - lu(k,513) * lu(k,914) + lu(k,924) = lu(k,924) - lu(k,514) * lu(k,914) + lu(k,925) = lu(k,925) - lu(k,515) * lu(k,914) + lu(k,927) = lu(k,927) - lu(k,516) * lu(k,914) + lu(k,928) = lu(k,928) - lu(k,517) * lu(k,914) + lu(k,929) = lu(k,929) - lu(k,518) * lu(k,914) + lu(k,942) = lu(k,942) - lu(k,506) * lu(k,941) + lu(k,943) = lu(k,943) - lu(k,507) * lu(k,941) + lu(k,944) = lu(k,944) - lu(k,508) * lu(k,941) + lu(k,946) = lu(k,946) - lu(k,509) * lu(k,941) + lu(k,947) = lu(k,947) - lu(k,510) * lu(k,941) + lu(k,948) = lu(k,948) - lu(k,511) * lu(k,941) + lu(k,949) = lu(k,949) - lu(k,512) * lu(k,941) + lu(k,950) = lu(k,950) - lu(k,513) * lu(k,941) + lu(k,951) = lu(k,951) - lu(k,514) * lu(k,941) + lu(k,952) = lu(k,952) - lu(k,515) * lu(k,941) + lu(k,954) = lu(k,954) - lu(k,516) * lu(k,941) + lu(k,955) = lu(k,955) - lu(k,517) * lu(k,941) + lu(k,956) = lu(k,956) - lu(k,518) * lu(k,941) end do - end subroutine lu_fac10 - subroutine lu_fac11( avec_len, lu ) + 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 @@ -3138,84 +2784,1160 @@ subroutine lu_fac11( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,624) = 1._r8 / lu(k,624) - lu(k,625) = lu(k,625) * lu(k,624) - lu(k,626) = lu(k,626) * lu(k,624) - lu(k,627) = lu(k,627) * lu(k,624) - lu(k,628) = lu(k,628) * lu(k,624) - lu(k,629) = lu(k,629) * lu(k,624) - lu(k,662) = lu(k,662) - lu(k,625) * lu(k,661) - lu(k,663) = lu(k,663) - lu(k,626) * lu(k,661) - lu(k,664) = lu(k,664) - lu(k,627) * lu(k,661) - lu(k,665) = lu(k,665) - lu(k,628) * lu(k,661) - lu(k,666) = lu(k,666) - lu(k,629) * lu(k,661) - lu(k,684) = lu(k,684) - lu(k,625) * lu(k,683) - lu(k,685) = lu(k,685) - lu(k,626) * lu(k,683) - lu(k,686) = lu(k,686) - lu(k,627) * lu(k,683) - lu(k,687) = lu(k,687) - lu(k,628) * lu(k,683) - lu(k,688) = lu(k,688) - lu(k,629) * lu(k,683) - lu(k,712) = lu(k,712) - lu(k,625) * lu(k,711) - lu(k,713) = lu(k,713) - lu(k,626) * lu(k,711) - lu(k,714) = lu(k,714) - lu(k,627) * lu(k,711) - lu(k,715) = lu(k,715) - lu(k,628) * lu(k,711) - lu(k,716) = lu(k,716) - lu(k,629) * lu(k,711) - lu(k,735) = lu(k,735) - lu(k,625) * lu(k,734) - lu(k,736) = lu(k,736) - lu(k,626) * lu(k,734) - lu(k,737) = lu(k,737) - lu(k,627) * lu(k,734) - lu(k,738) = lu(k,738) - lu(k,628) * lu(k,734) - lu(k,739) = lu(k,739) - lu(k,629) * lu(k,734) - lu(k,760) = lu(k,760) - lu(k,625) * lu(k,759) - lu(k,761) = lu(k,761) - lu(k,626) * lu(k,759) - lu(k,762) = lu(k,762) - lu(k,627) * lu(k,759) - lu(k,763) = lu(k,763) - lu(k,628) * lu(k,759) - lu(k,764) = lu(k,764) - lu(k,629) * lu(k,759) - lu(k,662) = 1._r8 / lu(k,662) - lu(k,663) = lu(k,663) * lu(k,662) - lu(k,664) = lu(k,664) * lu(k,662) - lu(k,665) = lu(k,665) * lu(k,662) - lu(k,666) = lu(k,666) * lu(k,662) - lu(k,685) = lu(k,685) - lu(k,663) * lu(k,684) - lu(k,686) = lu(k,686) - lu(k,664) * lu(k,684) - lu(k,687) = lu(k,687) - lu(k,665) * lu(k,684) - lu(k,688) = lu(k,688) - lu(k,666) * lu(k,684) - lu(k,713) = lu(k,713) - lu(k,663) * lu(k,712) - lu(k,714) = lu(k,714) - lu(k,664) * lu(k,712) - lu(k,715) = lu(k,715) - lu(k,665) * lu(k,712) - lu(k,716) = lu(k,716) - lu(k,666) * lu(k,712) - lu(k,736) = lu(k,736) - lu(k,663) * lu(k,735) - lu(k,737) = lu(k,737) - lu(k,664) * lu(k,735) - lu(k,738) = lu(k,738) - lu(k,665) * lu(k,735) - lu(k,739) = lu(k,739) - lu(k,666) * lu(k,735) - lu(k,761) = lu(k,761) - lu(k,663) * lu(k,760) - lu(k,762) = lu(k,762) - lu(k,664) * lu(k,760) - lu(k,763) = lu(k,763) - lu(k,665) * lu(k,760) - lu(k,764) = lu(k,764) - lu(k,666) * lu(k,760) - lu(k,685) = 1._r8 / lu(k,685) - lu(k,686) = lu(k,686) * lu(k,685) - lu(k,687) = lu(k,687) * lu(k,685) - lu(k,688) = lu(k,688) * lu(k,685) - lu(k,714) = lu(k,714) - lu(k,686) * lu(k,713) - lu(k,715) = lu(k,715) - lu(k,687) * lu(k,713) - lu(k,716) = lu(k,716) - lu(k,688) * lu(k,713) - lu(k,737) = lu(k,737) - lu(k,686) * lu(k,736) - lu(k,738) = lu(k,738) - lu(k,687) * lu(k,736) - lu(k,739) = lu(k,739) - lu(k,688) * lu(k,736) - lu(k,762) = lu(k,762) - lu(k,686) * lu(k,761) - lu(k,763) = lu(k,763) - lu(k,687) * lu(k,761) - lu(k,764) = lu(k,764) - lu(k,688) * lu(k,761) - lu(k,714) = 1._r8 / lu(k,714) - lu(k,715) = lu(k,715) * lu(k,714) - lu(k,716) = lu(k,716) * lu(k,714) - lu(k,738) = lu(k,738) - lu(k,715) * lu(k,737) - lu(k,739) = lu(k,739) - lu(k,716) * lu(k,737) - lu(k,763) = lu(k,763) - lu(k,715) * lu(k,762) - lu(k,764) = lu(k,764) - lu(k,716) * lu(k,762) - lu(k,738) = 1._r8 / lu(k,738) - lu(k,739) = lu(k,739) * lu(k,738) - lu(k,764) = lu(k,764) - lu(k,739) * lu(k,763) - lu(k,764) = 1._r8 / lu(k,764) + lu(k,526) = 1._r8 / lu(k,526) + lu(k,527) = lu(k,527) * lu(k,526) + lu(k,528) = lu(k,528) * lu(k,526) + lu(k,529) = lu(k,529) * lu(k,526) + lu(k,530) = lu(k,530) * lu(k,526) + lu(k,531) = lu(k,531) * lu(k,526) + lu(k,532) = lu(k,532) * lu(k,526) + lu(k,533) = lu(k,533) * lu(k,526) + lu(k,534) = lu(k,534) * lu(k,526) + lu(k,535) = lu(k,535) * lu(k,526) + lu(k,536) = lu(k,536) * lu(k,526) + lu(k,537) = lu(k,537) * lu(k,526) + lu(k,538) = lu(k,538) * lu(k,526) + lu(k,539) = lu(k,539) * lu(k,526) + lu(k,552) = lu(k,552) - lu(k,527) * lu(k,551) + lu(k,553) = lu(k,553) - lu(k,528) * lu(k,551) + lu(k,554) = lu(k,554) - lu(k,529) * lu(k,551) + lu(k,555) = lu(k,555) - lu(k,530) * lu(k,551) + lu(k,556) = lu(k,556) - lu(k,531) * lu(k,551) + lu(k,557) = lu(k,557) - lu(k,532) * lu(k,551) + lu(k,558) = lu(k,558) - lu(k,533) * lu(k,551) + lu(k,559) = lu(k,559) - lu(k,534) * lu(k,551) + lu(k,560) = lu(k,560) - lu(k,535) * lu(k,551) + lu(k,561) = lu(k,561) - lu(k,536) * lu(k,551) + lu(k,563) = lu(k,563) - lu(k,537) * lu(k,551) + lu(k,564) = lu(k,564) - lu(k,538) * lu(k,551) + lu(k,565) = lu(k,565) - lu(k,539) * lu(k,551) + lu(k,580) = lu(k,580) - lu(k,527) * lu(k,579) + lu(k,581) = lu(k,581) - lu(k,528) * lu(k,579) + lu(k,582) = lu(k,582) - lu(k,529) * lu(k,579) + lu(k,583) = lu(k,583) - lu(k,530) * lu(k,579) + lu(k,584) = lu(k,584) - lu(k,531) * lu(k,579) + lu(k,585) = lu(k,585) - lu(k,532) * lu(k,579) + lu(k,586) = lu(k,586) - lu(k,533) * lu(k,579) + lu(k,587) = lu(k,587) - lu(k,534) * lu(k,579) + lu(k,588) = lu(k,588) - lu(k,535) * lu(k,579) + lu(k,589) = lu(k,589) - lu(k,536) * lu(k,579) + lu(k,591) = lu(k,591) - lu(k,537) * lu(k,579) + lu(k,592) = lu(k,592) - lu(k,538) * lu(k,579) + lu(k,593) = lu(k,593) - lu(k,539) * lu(k,579) + lu(k,605) = lu(k,605) - lu(k,527) * lu(k,604) + lu(k,606) = lu(k,606) - lu(k,528) * lu(k,604) + lu(k,607) = lu(k,607) - lu(k,529) * lu(k,604) + lu(k,608) = lu(k,608) - lu(k,530) * lu(k,604) + lu(k,609) = lu(k,609) - lu(k,531) * lu(k,604) + lu(k,610) = lu(k,610) - lu(k,532) * lu(k,604) + lu(k,611) = lu(k,611) - lu(k,533) * lu(k,604) + lu(k,612) = lu(k,612) - lu(k,534) * lu(k,604) + lu(k,613) = lu(k,613) - lu(k,535) * lu(k,604) + lu(k,614) = lu(k,614) - lu(k,536) * lu(k,604) + lu(k,616) = lu(k,616) - lu(k,537) * lu(k,604) + lu(k,617) = lu(k,617) - lu(k,538) * lu(k,604) + lu(k,618) = lu(k,618) - lu(k,539) * lu(k,604) + lu(k,647) = lu(k,647) - lu(k,527) * lu(k,646) + lu(k,648) = lu(k,648) - lu(k,528) * lu(k,646) + lu(k,649) = lu(k,649) - lu(k,529) * lu(k,646) + lu(k,650) = lu(k,650) - lu(k,530) * lu(k,646) + lu(k,651) = lu(k,651) - lu(k,531) * lu(k,646) + lu(k,652) = lu(k,652) - lu(k,532) * lu(k,646) + lu(k,653) = lu(k,653) - lu(k,533) * lu(k,646) + lu(k,654) = lu(k,654) - lu(k,534) * lu(k,646) + lu(k,655) = lu(k,655) - lu(k,535) * lu(k,646) + lu(k,656) = lu(k,656) - lu(k,536) * lu(k,646) + lu(k,658) = lu(k,658) - lu(k,537) * lu(k,646) + lu(k,659) = lu(k,659) - lu(k,538) * lu(k,646) + lu(k,660) = lu(k,660) - lu(k,539) * lu(k,646) + lu(k,672) = lu(k,672) - lu(k,527) * lu(k,671) + lu(k,673) = lu(k,673) - lu(k,528) * lu(k,671) + lu(k,674) = lu(k,674) - lu(k,529) * lu(k,671) + lu(k,675) = lu(k,675) - lu(k,530) * lu(k,671) + lu(k,676) = lu(k,676) - lu(k,531) * lu(k,671) + lu(k,677) = lu(k,677) - lu(k,532) * lu(k,671) + lu(k,678) = lu(k,678) - lu(k,533) * lu(k,671) + lu(k,679) = lu(k,679) - lu(k,534) * lu(k,671) + lu(k,680) = lu(k,680) - lu(k,535) * lu(k,671) + lu(k,681) = lu(k,681) - lu(k,536) * lu(k,671) + lu(k,683) = lu(k,683) - lu(k,537) * lu(k,671) + lu(k,684) = lu(k,684) - lu(k,538) * lu(k,671) + lu(k,685) = lu(k,685) - lu(k,539) * lu(k,671) + lu(k,714) = lu(k,714) - lu(k,527) * lu(k,713) + lu(k,715) = lu(k,715) - lu(k,528) * lu(k,713) + lu(k,716) = lu(k,716) - lu(k,529) * lu(k,713) + lu(k,717) = lu(k,717) - lu(k,530) * lu(k,713) + lu(k,718) = lu(k,718) - lu(k,531) * lu(k,713) + lu(k,719) = lu(k,719) - lu(k,532) * lu(k,713) + lu(k,720) = lu(k,720) - lu(k,533) * lu(k,713) + lu(k,721) = lu(k,721) - lu(k,534) * lu(k,713) + lu(k,722) = lu(k,722) - lu(k,535) * lu(k,713) + lu(k,723) = lu(k,723) - lu(k,536) * lu(k,713) + lu(k,725) = lu(k,725) - lu(k,537) * lu(k,713) + lu(k,726) = lu(k,726) - lu(k,538) * lu(k,713) + lu(k,727) = lu(k,727) - lu(k,539) * lu(k,713) + lu(k,738) = lu(k,738) - lu(k,527) * lu(k,737) + lu(k,739) = lu(k,739) - lu(k,528) * lu(k,737) + lu(k,740) = lu(k,740) - lu(k,529) * lu(k,737) + lu(k,741) = lu(k,741) - lu(k,530) * lu(k,737) + lu(k,742) = lu(k,742) - lu(k,531) * lu(k,737) + lu(k,743) = lu(k,743) - lu(k,532) * lu(k,737) + lu(k,744) = lu(k,744) - lu(k,533) * lu(k,737) + lu(k,745) = lu(k,745) - lu(k,534) * lu(k,737) + lu(k,746) = lu(k,746) - lu(k,535) * lu(k,737) + lu(k,747) = lu(k,747) - lu(k,536) * lu(k,737) + lu(k,749) = lu(k,749) - lu(k,537) * lu(k,737) + lu(k,750) = lu(k,750) - lu(k,538) * lu(k,737) + lu(k,751) = lu(k,751) - lu(k,539) * lu(k,737) + lu(k,760) = lu(k,760) - lu(k,527) * lu(k,759) + lu(k,761) = lu(k,761) - lu(k,528) * lu(k,759) + lu(k,762) = lu(k,762) - lu(k,529) * lu(k,759) + lu(k,763) = lu(k,763) - lu(k,530) * lu(k,759) + lu(k,764) = lu(k,764) - lu(k,531) * lu(k,759) + lu(k,765) = lu(k,765) - lu(k,532) * lu(k,759) + lu(k,766) = lu(k,766) - lu(k,533) * lu(k,759) + lu(k,767) = lu(k,767) - lu(k,534) * lu(k,759) + lu(k,768) = lu(k,768) - lu(k,535) * lu(k,759) + lu(k,769) = lu(k,769) - lu(k,536) * lu(k,759) + lu(k,771) = lu(k,771) - lu(k,537) * lu(k,759) + lu(k,772) = lu(k,772) - lu(k,538) * lu(k,759) + lu(k,773) = lu(k,773) - lu(k,539) * lu(k,759) + lu(k,789) = lu(k,789) - lu(k,527) * lu(k,788) + lu(k,790) = lu(k,790) - lu(k,528) * lu(k,788) + lu(k,791) = lu(k,791) - lu(k,529) * lu(k,788) + lu(k,792) = lu(k,792) - lu(k,530) * lu(k,788) + lu(k,793) = lu(k,793) - lu(k,531) * lu(k,788) + lu(k,794) = lu(k,794) - lu(k,532) * lu(k,788) + lu(k,795) = lu(k,795) - lu(k,533) * lu(k,788) + lu(k,796) = lu(k,796) - lu(k,534) * lu(k,788) + lu(k,797) = lu(k,797) - lu(k,535) * lu(k,788) + lu(k,798) = lu(k,798) - lu(k,536) * lu(k,788) + lu(k,800) = lu(k,800) - lu(k,537) * lu(k,788) + lu(k,801) = lu(k,801) - lu(k,538) * lu(k,788) + lu(k,802) = lu(k,802) - lu(k,539) * lu(k,788) + lu(k,838) = lu(k,838) - lu(k,527) * lu(k,837) + lu(k,839) = lu(k,839) - lu(k,528) * lu(k,837) + lu(k,840) = lu(k,840) - lu(k,529) * lu(k,837) + lu(k,841) = lu(k,841) - lu(k,530) * lu(k,837) + lu(k,842) = lu(k,842) - lu(k,531) * lu(k,837) + lu(k,843) = lu(k,843) - lu(k,532) * lu(k,837) + lu(k,844) = lu(k,844) - lu(k,533) * lu(k,837) + lu(k,845) = lu(k,845) - lu(k,534) * lu(k,837) + lu(k,846) = lu(k,846) - lu(k,535) * lu(k,837) + lu(k,847) = lu(k,847) - lu(k,536) * lu(k,837) + lu(k,849) = lu(k,849) - lu(k,537) * lu(k,837) + lu(k,850) = lu(k,850) - lu(k,538) * lu(k,837) + lu(k,851) = lu(k,851) - lu(k,539) * lu(k,837) + lu(k,861) = lu(k,861) - lu(k,527) * lu(k,860) + lu(k,862) = lu(k,862) - lu(k,528) * lu(k,860) + lu(k,863) = lu(k,863) - lu(k,529) * lu(k,860) + lu(k,864) = lu(k,864) - lu(k,530) * lu(k,860) + lu(k,865) = lu(k,865) - lu(k,531) * lu(k,860) + lu(k,866) = lu(k,866) - lu(k,532) * lu(k,860) + lu(k,867) = lu(k,867) - lu(k,533) * lu(k,860) + lu(k,868) = lu(k,868) - lu(k,534) * lu(k,860) + lu(k,869) = lu(k,869) - lu(k,535) * lu(k,860) + lu(k,870) = lu(k,870) - lu(k,536) * lu(k,860) + lu(k,872) = lu(k,872) - lu(k,537) * lu(k,860) + lu(k,873) = lu(k,873) - lu(k,538) * lu(k,860) + lu(k,874) = lu(k,874) - lu(k,539) * lu(k,860) + lu(k,893) = lu(k,893) - lu(k,527) * lu(k,892) + lu(k,894) = lu(k,894) - lu(k,528) * lu(k,892) + lu(k,895) = lu(k,895) - lu(k,529) * lu(k,892) + lu(k,896) = lu(k,896) - lu(k,530) * lu(k,892) + lu(k,897) = lu(k,897) - lu(k,531) * lu(k,892) + lu(k,898) = lu(k,898) - lu(k,532) * lu(k,892) + lu(k,899) = lu(k,899) - lu(k,533) * lu(k,892) + lu(k,900) = lu(k,900) - lu(k,534) * lu(k,892) + lu(k,901) = lu(k,901) - lu(k,535) * lu(k,892) + lu(k,902) = lu(k,902) - lu(k,536) * lu(k,892) + lu(k,904) = lu(k,904) - lu(k,537) * lu(k,892) + lu(k,905) = lu(k,905) - lu(k,538) * lu(k,892) + lu(k,906) = lu(k,906) - lu(k,539) * lu(k,892) + lu(k,916) = lu(k,916) - lu(k,527) * lu(k,915) + lu(k,917) = lu(k,917) - lu(k,528) * lu(k,915) + lu(k,918) = lu(k,918) - lu(k,529) * lu(k,915) + lu(k,919) = lu(k,919) - lu(k,530) * lu(k,915) + lu(k,920) = lu(k,920) - lu(k,531) * lu(k,915) + lu(k,921) = lu(k,921) - lu(k,532) * lu(k,915) + lu(k,922) = lu(k,922) - lu(k,533) * lu(k,915) + lu(k,923) = lu(k,923) - lu(k,534) * lu(k,915) + lu(k,924) = lu(k,924) - lu(k,535) * lu(k,915) + lu(k,925) = lu(k,925) - lu(k,536) * lu(k,915) + lu(k,927) = lu(k,927) - lu(k,537) * lu(k,915) + lu(k,928) = lu(k,928) - lu(k,538) * lu(k,915) + lu(k,929) = lu(k,929) - lu(k,539) * lu(k,915) + lu(k,943) = lu(k,943) - lu(k,527) * lu(k,942) + lu(k,944) = lu(k,944) - lu(k,528) * lu(k,942) + lu(k,945) = lu(k,945) - lu(k,529) * lu(k,942) + lu(k,946) = lu(k,946) - lu(k,530) * lu(k,942) + lu(k,947) = lu(k,947) - lu(k,531) * lu(k,942) + lu(k,948) = lu(k,948) - lu(k,532) * lu(k,942) + lu(k,949) = lu(k,949) - lu(k,533) * lu(k,942) + lu(k,950) = lu(k,950) - lu(k,534) * lu(k,942) + lu(k,951) = lu(k,951) - lu(k,535) * lu(k,942) + lu(k,952) = lu(k,952) - lu(k,536) * lu(k,942) + lu(k,954) = lu(k,954) - lu(k,537) * lu(k,942) + lu(k,955) = lu(k,955) - lu(k,538) * lu(k,942) + lu(k,956) = lu(k,956) - lu(k,539) * lu(k,942) + lu(k,552) = 1._r8 / lu(k,552) + lu(k,553) = lu(k,553) * lu(k,552) + lu(k,554) = lu(k,554) * lu(k,552) + lu(k,555) = lu(k,555) * lu(k,552) + lu(k,556) = lu(k,556) * lu(k,552) + lu(k,557) = lu(k,557) * lu(k,552) + lu(k,558) = lu(k,558) * lu(k,552) + lu(k,559) = lu(k,559) * lu(k,552) + lu(k,560) = lu(k,560) * lu(k,552) + lu(k,561) = lu(k,561) * lu(k,552) + lu(k,562) = lu(k,562) * lu(k,552) + lu(k,563) = lu(k,563) * lu(k,552) + lu(k,564) = lu(k,564) * lu(k,552) + lu(k,565) = lu(k,565) * lu(k,552) + lu(k,581) = lu(k,581) - lu(k,553) * lu(k,580) + lu(k,582) = lu(k,582) - lu(k,554) * lu(k,580) + lu(k,583) = lu(k,583) - lu(k,555) * lu(k,580) + lu(k,584) = lu(k,584) - lu(k,556) * lu(k,580) + lu(k,585) = lu(k,585) - lu(k,557) * lu(k,580) + lu(k,586) = lu(k,586) - lu(k,558) * lu(k,580) + lu(k,587) = lu(k,587) - lu(k,559) * lu(k,580) + lu(k,588) = lu(k,588) - lu(k,560) * lu(k,580) + lu(k,589) = lu(k,589) - lu(k,561) * lu(k,580) + lu(k,590) = lu(k,590) - lu(k,562) * lu(k,580) + lu(k,591) = lu(k,591) - lu(k,563) * lu(k,580) + lu(k,592) = lu(k,592) - lu(k,564) * lu(k,580) + lu(k,593) = lu(k,593) - lu(k,565) * lu(k,580) + lu(k,606) = lu(k,606) - lu(k,553) * lu(k,605) + lu(k,607) = lu(k,607) - lu(k,554) * lu(k,605) + lu(k,608) = lu(k,608) - lu(k,555) * lu(k,605) + lu(k,609) = lu(k,609) - lu(k,556) * lu(k,605) + lu(k,610) = lu(k,610) - lu(k,557) * lu(k,605) + lu(k,611) = lu(k,611) - lu(k,558) * lu(k,605) + lu(k,612) = lu(k,612) - lu(k,559) * lu(k,605) + lu(k,613) = lu(k,613) - lu(k,560) * lu(k,605) + lu(k,614) = lu(k,614) - lu(k,561) * lu(k,605) + lu(k,615) = lu(k,615) - lu(k,562) * lu(k,605) + lu(k,616) = lu(k,616) - lu(k,563) * lu(k,605) + lu(k,617) = lu(k,617) - lu(k,564) * lu(k,605) + lu(k,618) = lu(k,618) - lu(k,565) * lu(k,605) + lu(k,648) = lu(k,648) - lu(k,553) * lu(k,647) + lu(k,649) = lu(k,649) - lu(k,554) * lu(k,647) + lu(k,650) = lu(k,650) - lu(k,555) * lu(k,647) + lu(k,651) = lu(k,651) - lu(k,556) * lu(k,647) + lu(k,652) = lu(k,652) - lu(k,557) * lu(k,647) + lu(k,653) = lu(k,653) - lu(k,558) * lu(k,647) + lu(k,654) = lu(k,654) - lu(k,559) * lu(k,647) + lu(k,655) = lu(k,655) - lu(k,560) * lu(k,647) + lu(k,656) = lu(k,656) - lu(k,561) * lu(k,647) + lu(k,657) = lu(k,657) - lu(k,562) * lu(k,647) + lu(k,658) = lu(k,658) - lu(k,563) * lu(k,647) + lu(k,659) = lu(k,659) - lu(k,564) * lu(k,647) + lu(k,660) = lu(k,660) - lu(k,565) * lu(k,647) + lu(k,673) = lu(k,673) - lu(k,553) * lu(k,672) + lu(k,674) = lu(k,674) - lu(k,554) * lu(k,672) + lu(k,675) = lu(k,675) - lu(k,555) * lu(k,672) + lu(k,676) = lu(k,676) - lu(k,556) * lu(k,672) + lu(k,677) = lu(k,677) - lu(k,557) * lu(k,672) + lu(k,678) = lu(k,678) - lu(k,558) * lu(k,672) + lu(k,679) = lu(k,679) - lu(k,559) * lu(k,672) + lu(k,680) = lu(k,680) - lu(k,560) * lu(k,672) + lu(k,681) = lu(k,681) - lu(k,561) * lu(k,672) + lu(k,682) = lu(k,682) - lu(k,562) * lu(k,672) + lu(k,683) = lu(k,683) - lu(k,563) * lu(k,672) + lu(k,684) = lu(k,684) - lu(k,564) * lu(k,672) + lu(k,685) = lu(k,685) - lu(k,565) * lu(k,672) + lu(k,715) = lu(k,715) - lu(k,553) * lu(k,714) + lu(k,716) = lu(k,716) - lu(k,554) * lu(k,714) + lu(k,717) = lu(k,717) - lu(k,555) * lu(k,714) + lu(k,718) = lu(k,718) - lu(k,556) * lu(k,714) + lu(k,719) = lu(k,719) - lu(k,557) * lu(k,714) + lu(k,720) = lu(k,720) - lu(k,558) * lu(k,714) + lu(k,721) = lu(k,721) - lu(k,559) * lu(k,714) + lu(k,722) = lu(k,722) - lu(k,560) * lu(k,714) + lu(k,723) = lu(k,723) - lu(k,561) * lu(k,714) + lu(k,724) = lu(k,724) - lu(k,562) * lu(k,714) + lu(k,725) = lu(k,725) - lu(k,563) * lu(k,714) + lu(k,726) = lu(k,726) - lu(k,564) * lu(k,714) + lu(k,727) = lu(k,727) - lu(k,565) * lu(k,714) + lu(k,739) = lu(k,739) - lu(k,553) * lu(k,738) + lu(k,740) = lu(k,740) - lu(k,554) * lu(k,738) + lu(k,741) = lu(k,741) - lu(k,555) * lu(k,738) + lu(k,742) = lu(k,742) - lu(k,556) * lu(k,738) + lu(k,743) = lu(k,743) - lu(k,557) * lu(k,738) + lu(k,744) = lu(k,744) - lu(k,558) * lu(k,738) + lu(k,745) = lu(k,745) - lu(k,559) * lu(k,738) + lu(k,746) = lu(k,746) - lu(k,560) * lu(k,738) + lu(k,747) = lu(k,747) - lu(k,561) * lu(k,738) + lu(k,748) = lu(k,748) - lu(k,562) * lu(k,738) + lu(k,749) = lu(k,749) - lu(k,563) * lu(k,738) + lu(k,750) = lu(k,750) - lu(k,564) * lu(k,738) + lu(k,751) = lu(k,751) - lu(k,565) * lu(k,738) + lu(k,761) = lu(k,761) - lu(k,553) * lu(k,760) + lu(k,762) = lu(k,762) - lu(k,554) * lu(k,760) + lu(k,763) = lu(k,763) - lu(k,555) * lu(k,760) + lu(k,764) = lu(k,764) - lu(k,556) * lu(k,760) + lu(k,765) = lu(k,765) - lu(k,557) * lu(k,760) + lu(k,766) = lu(k,766) - lu(k,558) * lu(k,760) + lu(k,767) = lu(k,767) - lu(k,559) * lu(k,760) + lu(k,768) = lu(k,768) - lu(k,560) * lu(k,760) + lu(k,769) = lu(k,769) - lu(k,561) * lu(k,760) + lu(k,770) = lu(k,770) - lu(k,562) * lu(k,760) + lu(k,771) = lu(k,771) - lu(k,563) * lu(k,760) + lu(k,772) = lu(k,772) - lu(k,564) * lu(k,760) + lu(k,773) = lu(k,773) - lu(k,565) * lu(k,760) + lu(k,790) = lu(k,790) - lu(k,553) * lu(k,789) + lu(k,791) = lu(k,791) - lu(k,554) * lu(k,789) + lu(k,792) = lu(k,792) - lu(k,555) * lu(k,789) + lu(k,793) = lu(k,793) - lu(k,556) * lu(k,789) + lu(k,794) = lu(k,794) - lu(k,557) * lu(k,789) + lu(k,795) = lu(k,795) - lu(k,558) * lu(k,789) + lu(k,796) = lu(k,796) - lu(k,559) * lu(k,789) + lu(k,797) = lu(k,797) - lu(k,560) * lu(k,789) + lu(k,798) = lu(k,798) - lu(k,561) * lu(k,789) + lu(k,799) = lu(k,799) - lu(k,562) * lu(k,789) + lu(k,800) = lu(k,800) - lu(k,563) * lu(k,789) + lu(k,801) = lu(k,801) - lu(k,564) * lu(k,789) + lu(k,802) = lu(k,802) - lu(k,565) * lu(k,789) + lu(k,839) = lu(k,839) - lu(k,553) * lu(k,838) + lu(k,840) = lu(k,840) - lu(k,554) * lu(k,838) + lu(k,841) = lu(k,841) - lu(k,555) * lu(k,838) + lu(k,842) = lu(k,842) - lu(k,556) * lu(k,838) + lu(k,843) = lu(k,843) - lu(k,557) * lu(k,838) + lu(k,844) = lu(k,844) - lu(k,558) * lu(k,838) + lu(k,845) = lu(k,845) - lu(k,559) * lu(k,838) + lu(k,846) = lu(k,846) - lu(k,560) * lu(k,838) + lu(k,847) = lu(k,847) - lu(k,561) * lu(k,838) + lu(k,848) = lu(k,848) - lu(k,562) * lu(k,838) + lu(k,849) = lu(k,849) - lu(k,563) * lu(k,838) + lu(k,850) = lu(k,850) - lu(k,564) * lu(k,838) + lu(k,851) = lu(k,851) - lu(k,565) * lu(k,838) + lu(k,862) = lu(k,862) - lu(k,553) * lu(k,861) + lu(k,863) = lu(k,863) - lu(k,554) * lu(k,861) + lu(k,864) = lu(k,864) - lu(k,555) * lu(k,861) + lu(k,865) = lu(k,865) - lu(k,556) * lu(k,861) + lu(k,866) = lu(k,866) - lu(k,557) * lu(k,861) + lu(k,867) = lu(k,867) - lu(k,558) * lu(k,861) + lu(k,868) = lu(k,868) - lu(k,559) * lu(k,861) + lu(k,869) = lu(k,869) - lu(k,560) * lu(k,861) + lu(k,870) = lu(k,870) - lu(k,561) * lu(k,861) + lu(k,871) = lu(k,871) - lu(k,562) * lu(k,861) + lu(k,872) = lu(k,872) - lu(k,563) * lu(k,861) + lu(k,873) = lu(k,873) - lu(k,564) * lu(k,861) + lu(k,874) = lu(k,874) - lu(k,565) * lu(k,861) + lu(k,894) = lu(k,894) - lu(k,553) * lu(k,893) + lu(k,895) = lu(k,895) - lu(k,554) * lu(k,893) + lu(k,896) = lu(k,896) - lu(k,555) * lu(k,893) + lu(k,897) = lu(k,897) - lu(k,556) * lu(k,893) + lu(k,898) = lu(k,898) - lu(k,557) * lu(k,893) + lu(k,899) = lu(k,899) - lu(k,558) * lu(k,893) + lu(k,900) = lu(k,900) - lu(k,559) * lu(k,893) + lu(k,901) = lu(k,901) - lu(k,560) * lu(k,893) + lu(k,902) = lu(k,902) - lu(k,561) * lu(k,893) + lu(k,903) = lu(k,903) - lu(k,562) * lu(k,893) + lu(k,904) = lu(k,904) - lu(k,563) * lu(k,893) + lu(k,905) = lu(k,905) - lu(k,564) * lu(k,893) + lu(k,906) = lu(k,906) - lu(k,565) * lu(k,893) + lu(k,917) = lu(k,917) - lu(k,553) * lu(k,916) + lu(k,918) = lu(k,918) - lu(k,554) * lu(k,916) + lu(k,919) = lu(k,919) - lu(k,555) * lu(k,916) + lu(k,920) = lu(k,920) - lu(k,556) * lu(k,916) + lu(k,921) = lu(k,921) - lu(k,557) * lu(k,916) + lu(k,922) = lu(k,922) - lu(k,558) * lu(k,916) + lu(k,923) = lu(k,923) - lu(k,559) * lu(k,916) + lu(k,924) = lu(k,924) - lu(k,560) * lu(k,916) + lu(k,925) = lu(k,925) - lu(k,561) * lu(k,916) + lu(k,926) = lu(k,926) - lu(k,562) * lu(k,916) + lu(k,927) = lu(k,927) - lu(k,563) * lu(k,916) + lu(k,928) = lu(k,928) - lu(k,564) * lu(k,916) + lu(k,929) = lu(k,929) - lu(k,565) * lu(k,916) + lu(k,944) = lu(k,944) - lu(k,553) * lu(k,943) + lu(k,945) = lu(k,945) - lu(k,554) * lu(k,943) + lu(k,946) = lu(k,946) - lu(k,555) * lu(k,943) + lu(k,947) = lu(k,947) - lu(k,556) * lu(k,943) + lu(k,948) = lu(k,948) - lu(k,557) * lu(k,943) + lu(k,949) = lu(k,949) - lu(k,558) * lu(k,943) + lu(k,950) = lu(k,950) - lu(k,559) * lu(k,943) + lu(k,951) = lu(k,951) - lu(k,560) * lu(k,943) + lu(k,952) = lu(k,952) - lu(k,561) * lu(k,943) + lu(k,953) = lu(k,953) - lu(k,562) * lu(k,943) + lu(k,954) = lu(k,954) - lu(k,563) * lu(k,943) + lu(k,955) = lu(k,955) - lu(k,564) * lu(k,943) + lu(k,956) = lu(k,956) - lu(k,565) * lu(k,943) + lu(k,581) = 1._r8 / lu(k,581) + lu(k,582) = lu(k,582) * lu(k,581) + lu(k,583) = lu(k,583) * lu(k,581) + lu(k,584) = lu(k,584) * lu(k,581) + lu(k,585) = lu(k,585) * lu(k,581) + lu(k,586) = lu(k,586) * lu(k,581) + lu(k,587) = lu(k,587) * lu(k,581) + lu(k,588) = lu(k,588) * lu(k,581) + lu(k,589) = lu(k,589) * lu(k,581) + lu(k,590) = lu(k,590) * lu(k,581) + lu(k,591) = lu(k,591) * lu(k,581) + lu(k,592) = lu(k,592) * lu(k,581) + lu(k,593) = lu(k,593) * lu(k,581) + lu(k,607) = lu(k,607) - lu(k,582) * lu(k,606) + lu(k,608) = lu(k,608) - lu(k,583) * lu(k,606) + lu(k,609) = lu(k,609) - lu(k,584) * lu(k,606) + lu(k,610) = lu(k,610) - lu(k,585) * lu(k,606) + lu(k,611) = lu(k,611) - lu(k,586) * lu(k,606) + lu(k,612) = lu(k,612) - lu(k,587) * lu(k,606) + lu(k,613) = lu(k,613) - lu(k,588) * lu(k,606) + lu(k,614) = lu(k,614) - lu(k,589) * lu(k,606) + lu(k,615) = lu(k,615) - lu(k,590) * lu(k,606) + lu(k,616) = lu(k,616) - lu(k,591) * lu(k,606) + lu(k,617) = lu(k,617) - lu(k,592) * lu(k,606) + lu(k,618) = lu(k,618) - lu(k,593) * lu(k,606) + lu(k,649) = lu(k,649) - lu(k,582) * lu(k,648) + lu(k,650) = lu(k,650) - lu(k,583) * lu(k,648) + lu(k,651) = lu(k,651) - lu(k,584) * lu(k,648) + lu(k,652) = lu(k,652) - lu(k,585) * lu(k,648) + lu(k,653) = lu(k,653) - lu(k,586) * lu(k,648) + lu(k,654) = lu(k,654) - lu(k,587) * lu(k,648) + lu(k,655) = lu(k,655) - lu(k,588) * lu(k,648) + lu(k,656) = lu(k,656) - lu(k,589) * lu(k,648) + lu(k,657) = lu(k,657) - lu(k,590) * lu(k,648) + lu(k,658) = lu(k,658) - lu(k,591) * lu(k,648) + lu(k,659) = lu(k,659) - lu(k,592) * lu(k,648) + lu(k,660) = lu(k,660) - lu(k,593) * lu(k,648) + lu(k,674) = lu(k,674) - lu(k,582) * lu(k,673) + lu(k,675) = lu(k,675) - lu(k,583) * lu(k,673) + lu(k,676) = lu(k,676) - lu(k,584) * lu(k,673) + lu(k,677) = lu(k,677) - lu(k,585) * lu(k,673) + lu(k,678) = lu(k,678) - lu(k,586) * lu(k,673) + lu(k,679) = lu(k,679) - lu(k,587) * lu(k,673) + lu(k,680) = lu(k,680) - lu(k,588) * lu(k,673) + lu(k,681) = lu(k,681) - lu(k,589) * lu(k,673) + lu(k,682) = lu(k,682) - lu(k,590) * lu(k,673) + lu(k,683) = lu(k,683) - lu(k,591) * lu(k,673) + lu(k,684) = lu(k,684) - lu(k,592) * lu(k,673) + lu(k,685) = lu(k,685) - lu(k,593) * lu(k,673) + lu(k,716) = lu(k,716) - lu(k,582) * lu(k,715) + lu(k,717) = lu(k,717) - lu(k,583) * lu(k,715) + lu(k,718) = lu(k,718) - lu(k,584) * lu(k,715) + lu(k,719) = lu(k,719) - lu(k,585) * lu(k,715) + lu(k,720) = lu(k,720) - lu(k,586) * lu(k,715) + lu(k,721) = lu(k,721) - lu(k,587) * lu(k,715) + lu(k,722) = lu(k,722) - lu(k,588) * lu(k,715) + lu(k,723) = lu(k,723) - lu(k,589) * lu(k,715) + lu(k,724) = lu(k,724) - lu(k,590) * lu(k,715) + lu(k,725) = lu(k,725) - lu(k,591) * lu(k,715) + lu(k,726) = lu(k,726) - lu(k,592) * lu(k,715) + lu(k,727) = lu(k,727) - lu(k,593) * lu(k,715) + lu(k,740) = lu(k,740) - lu(k,582) * lu(k,739) + lu(k,741) = lu(k,741) - lu(k,583) * lu(k,739) + lu(k,742) = lu(k,742) - lu(k,584) * lu(k,739) + lu(k,743) = lu(k,743) - lu(k,585) * lu(k,739) + lu(k,744) = lu(k,744) - lu(k,586) * lu(k,739) + lu(k,745) = lu(k,745) - lu(k,587) * lu(k,739) + lu(k,746) = lu(k,746) - lu(k,588) * lu(k,739) + lu(k,747) = lu(k,747) - lu(k,589) * lu(k,739) + lu(k,748) = lu(k,748) - lu(k,590) * lu(k,739) + lu(k,749) = lu(k,749) - lu(k,591) * lu(k,739) + lu(k,750) = lu(k,750) - lu(k,592) * lu(k,739) + lu(k,751) = lu(k,751) - lu(k,593) * lu(k,739) + lu(k,762) = lu(k,762) - lu(k,582) * lu(k,761) + lu(k,763) = lu(k,763) - lu(k,583) * lu(k,761) + lu(k,764) = lu(k,764) - lu(k,584) * lu(k,761) + lu(k,765) = lu(k,765) - lu(k,585) * lu(k,761) + lu(k,766) = lu(k,766) - lu(k,586) * lu(k,761) + lu(k,767) = lu(k,767) - lu(k,587) * lu(k,761) + lu(k,768) = lu(k,768) - lu(k,588) * lu(k,761) + lu(k,769) = lu(k,769) - lu(k,589) * lu(k,761) + lu(k,770) = lu(k,770) - lu(k,590) * lu(k,761) + lu(k,771) = lu(k,771) - lu(k,591) * lu(k,761) + lu(k,772) = lu(k,772) - lu(k,592) * lu(k,761) + lu(k,773) = lu(k,773) - lu(k,593) * lu(k,761) + lu(k,791) = lu(k,791) - lu(k,582) * lu(k,790) + lu(k,792) = lu(k,792) - lu(k,583) * lu(k,790) + lu(k,793) = lu(k,793) - lu(k,584) * lu(k,790) + lu(k,794) = lu(k,794) - lu(k,585) * lu(k,790) + lu(k,795) = lu(k,795) - lu(k,586) * lu(k,790) + lu(k,796) = lu(k,796) - lu(k,587) * lu(k,790) + lu(k,797) = lu(k,797) - lu(k,588) * lu(k,790) + lu(k,798) = lu(k,798) - lu(k,589) * lu(k,790) + lu(k,799) = lu(k,799) - lu(k,590) * lu(k,790) + lu(k,800) = lu(k,800) - lu(k,591) * lu(k,790) + lu(k,801) = lu(k,801) - lu(k,592) * lu(k,790) + lu(k,802) = lu(k,802) - lu(k,593) * lu(k,790) + lu(k,840) = lu(k,840) - lu(k,582) * lu(k,839) + lu(k,841) = lu(k,841) - lu(k,583) * lu(k,839) + lu(k,842) = lu(k,842) - lu(k,584) * lu(k,839) + lu(k,843) = lu(k,843) - lu(k,585) * lu(k,839) + lu(k,844) = lu(k,844) - lu(k,586) * lu(k,839) + lu(k,845) = lu(k,845) - lu(k,587) * lu(k,839) + lu(k,846) = lu(k,846) - lu(k,588) * lu(k,839) + lu(k,847) = lu(k,847) - lu(k,589) * lu(k,839) + lu(k,848) = lu(k,848) - lu(k,590) * lu(k,839) + lu(k,849) = lu(k,849) - lu(k,591) * lu(k,839) + lu(k,850) = lu(k,850) - lu(k,592) * lu(k,839) + lu(k,851) = lu(k,851) - lu(k,593) * lu(k,839) + lu(k,863) = lu(k,863) - lu(k,582) * lu(k,862) + lu(k,864) = lu(k,864) - lu(k,583) * lu(k,862) + lu(k,865) = lu(k,865) - lu(k,584) * lu(k,862) + lu(k,866) = lu(k,866) - lu(k,585) * lu(k,862) + lu(k,867) = lu(k,867) - lu(k,586) * lu(k,862) + lu(k,868) = lu(k,868) - lu(k,587) * lu(k,862) + lu(k,869) = lu(k,869) - lu(k,588) * lu(k,862) + lu(k,870) = lu(k,870) - lu(k,589) * lu(k,862) + lu(k,871) = lu(k,871) - lu(k,590) * lu(k,862) + lu(k,872) = lu(k,872) - lu(k,591) * lu(k,862) + lu(k,873) = lu(k,873) - lu(k,592) * lu(k,862) + lu(k,874) = lu(k,874) - lu(k,593) * lu(k,862) + lu(k,895) = lu(k,895) - lu(k,582) * lu(k,894) + lu(k,896) = lu(k,896) - lu(k,583) * lu(k,894) + lu(k,897) = lu(k,897) - lu(k,584) * lu(k,894) + lu(k,898) = lu(k,898) - lu(k,585) * lu(k,894) + lu(k,899) = lu(k,899) - lu(k,586) * lu(k,894) + lu(k,900) = lu(k,900) - lu(k,587) * lu(k,894) + lu(k,901) = lu(k,901) - lu(k,588) * lu(k,894) + lu(k,902) = lu(k,902) - lu(k,589) * lu(k,894) + lu(k,903) = lu(k,903) - lu(k,590) * lu(k,894) + lu(k,904) = lu(k,904) - lu(k,591) * lu(k,894) + lu(k,905) = lu(k,905) - lu(k,592) * lu(k,894) + lu(k,906) = lu(k,906) - lu(k,593) * lu(k,894) + lu(k,918) = lu(k,918) - lu(k,582) * lu(k,917) + lu(k,919) = lu(k,919) - lu(k,583) * lu(k,917) + lu(k,920) = lu(k,920) - lu(k,584) * lu(k,917) + lu(k,921) = lu(k,921) - lu(k,585) * lu(k,917) + lu(k,922) = lu(k,922) - lu(k,586) * lu(k,917) + lu(k,923) = lu(k,923) - lu(k,587) * lu(k,917) + lu(k,924) = lu(k,924) - lu(k,588) * lu(k,917) + lu(k,925) = lu(k,925) - lu(k,589) * lu(k,917) + lu(k,926) = lu(k,926) - lu(k,590) * lu(k,917) + lu(k,927) = lu(k,927) - lu(k,591) * lu(k,917) + lu(k,928) = lu(k,928) - lu(k,592) * lu(k,917) + lu(k,929) = lu(k,929) - lu(k,593) * lu(k,917) + lu(k,945) = lu(k,945) - lu(k,582) * lu(k,944) + lu(k,946) = lu(k,946) - lu(k,583) * lu(k,944) + lu(k,947) = lu(k,947) - lu(k,584) * lu(k,944) + lu(k,948) = lu(k,948) - lu(k,585) * lu(k,944) + lu(k,949) = lu(k,949) - lu(k,586) * lu(k,944) + lu(k,950) = lu(k,950) - lu(k,587) * lu(k,944) + lu(k,951) = lu(k,951) - lu(k,588) * lu(k,944) + lu(k,952) = lu(k,952) - lu(k,589) * lu(k,944) + lu(k,953) = lu(k,953) - lu(k,590) * lu(k,944) + lu(k,954) = lu(k,954) - lu(k,591) * lu(k,944) + lu(k,955) = lu(k,955) - lu(k,592) * lu(k,944) + lu(k,956) = lu(k,956) - lu(k,593) * lu(k,944) + lu(k,607) = 1._r8 / lu(k,607) + lu(k,608) = lu(k,608) * lu(k,607) + lu(k,609) = lu(k,609) * lu(k,607) + lu(k,610) = lu(k,610) * lu(k,607) + lu(k,611) = lu(k,611) * lu(k,607) + lu(k,612) = lu(k,612) * lu(k,607) + lu(k,613) = lu(k,613) * lu(k,607) + lu(k,614) = lu(k,614) * lu(k,607) + lu(k,615) = lu(k,615) * lu(k,607) + lu(k,616) = lu(k,616) * lu(k,607) + lu(k,617) = lu(k,617) * lu(k,607) + lu(k,618) = lu(k,618) * lu(k,607) + lu(k,650) = lu(k,650) - lu(k,608) * lu(k,649) + lu(k,651) = lu(k,651) - lu(k,609) * lu(k,649) + lu(k,652) = lu(k,652) - lu(k,610) * lu(k,649) + lu(k,653) = lu(k,653) - lu(k,611) * lu(k,649) + lu(k,654) = lu(k,654) - lu(k,612) * lu(k,649) + lu(k,655) = lu(k,655) - lu(k,613) * lu(k,649) + lu(k,656) = lu(k,656) - lu(k,614) * lu(k,649) + lu(k,657) = lu(k,657) - lu(k,615) * lu(k,649) + lu(k,658) = lu(k,658) - lu(k,616) * lu(k,649) + lu(k,659) = lu(k,659) - lu(k,617) * lu(k,649) + lu(k,660) = lu(k,660) - lu(k,618) * lu(k,649) + lu(k,675) = lu(k,675) - lu(k,608) * lu(k,674) + lu(k,676) = lu(k,676) - lu(k,609) * lu(k,674) + lu(k,677) = lu(k,677) - lu(k,610) * lu(k,674) + lu(k,678) = lu(k,678) - lu(k,611) * lu(k,674) + lu(k,679) = lu(k,679) - lu(k,612) * lu(k,674) + lu(k,680) = lu(k,680) - lu(k,613) * lu(k,674) + lu(k,681) = lu(k,681) - lu(k,614) * lu(k,674) + lu(k,682) = lu(k,682) - lu(k,615) * lu(k,674) + lu(k,683) = lu(k,683) - lu(k,616) * lu(k,674) + lu(k,684) = lu(k,684) - lu(k,617) * lu(k,674) + lu(k,685) = lu(k,685) - lu(k,618) * lu(k,674) + lu(k,717) = lu(k,717) - lu(k,608) * lu(k,716) + lu(k,718) = lu(k,718) - lu(k,609) * lu(k,716) + lu(k,719) = lu(k,719) - lu(k,610) * lu(k,716) + lu(k,720) = lu(k,720) - lu(k,611) * lu(k,716) + lu(k,721) = lu(k,721) - lu(k,612) * lu(k,716) + lu(k,722) = lu(k,722) - lu(k,613) * lu(k,716) + lu(k,723) = lu(k,723) - lu(k,614) * lu(k,716) + lu(k,724) = lu(k,724) - lu(k,615) * lu(k,716) + lu(k,725) = lu(k,725) - lu(k,616) * lu(k,716) + lu(k,726) = lu(k,726) - lu(k,617) * lu(k,716) + lu(k,727) = lu(k,727) - lu(k,618) * lu(k,716) + lu(k,741) = lu(k,741) - lu(k,608) * lu(k,740) + lu(k,742) = lu(k,742) - lu(k,609) * lu(k,740) + lu(k,743) = lu(k,743) - lu(k,610) * lu(k,740) + lu(k,744) = lu(k,744) - lu(k,611) * lu(k,740) + lu(k,745) = lu(k,745) - lu(k,612) * lu(k,740) + lu(k,746) = lu(k,746) - lu(k,613) * lu(k,740) + lu(k,747) = lu(k,747) - lu(k,614) * lu(k,740) + lu(k,748) = lu(k,748) - lu(k,615) * lu(k,740) + lu(k,749) = lu(k,749) - lu(k,616) * lu(k,740) + lu(k,750) = lu(k,750) - lu(k,617) * lu(k,740) + lu(k,751) = lu(k,751) - lu(k,618) * lu(k,740) + lu(k,763) = lu(k,763) - lu(k,608) * lu(k,762) + lu(k,764) = lu(k,764) - lu(k,609) * lu(k,762) + lu(k,765) = lu(k,765) - lu(k,610) * lu(k,762) + lu(k,766) = lu(k,766) - lu(k,611) * lu(k,762) + lu(k,767) = lu(k,767) - lu(k,612) * lu(k,762) + lu(k,768) = lu(k,768) - lu(k,613) * lu(k,762) + lu(k,769) = lu(k,769) - lu(k,614) * lu(k,762) + lu(k,770) = lu(k,770) - lu(k,615) * lu(k,762) + lu(k,771) = lu(k,771) - lu(k,616) * lu(k,762) + lu(k,772) = lu(k,772) - lu(k,617) * lu(k,762) + lu(k,773) = lu(k,773) - lu(k,618) * lu(k,762) + lu(k,792) = lu(k,792) - lu(k,608) * lu(k,791) + lu(k,793) = lu(k,793) - lu(k,609) * lu(k,791) + lu(k,794) = lu(k,794) - lu(k,610) * lu(k,791) + lu(k,795) = lu(k,795) - lu(k,611) * lu(k,791) + lu(k,796) = lu(k,796) - lu(k,612) * lu(k,791) + lu(k,797) = lu(k,797) - lu(k,613) * lu(k,791) + lu(k,798) = lu(k,798) - lu(k,614) * lu(k,791) + lu(k,799) = lu(k,799) - lu(k,615) * lu(k,791) + lu(k,800) = lu(k,800) - lu(k,616) * lu(k,791) + lu(k,801) = lu(k,801) - lu(k,617) * lu(k,791) + lu(k,802) = lu(k,802) - lu(k,618) * lu(k,791) + lu(k,841) = lu(k,841) - lu(k,608) * lu(k,840) + lu(k,842) = lu(k,842) - lu(k,609) * lu(k,840) + lu(k,843) = lu(k,843) - lu(k,610) * lu(k,840) + lu(k,844) = lu(k,844) - lu(k,611) * lu(k,840) + lu(k,845) = lu(k,845) - lu(k,612) * lu(k,840) + lu(k,846) = lu(k,846) - lu(k,613) * lu(k,840) + lu(k,847) = lu(k,847) - lu(k,614) * lu(k,840) + lu(k,848) = lu(k,848) - lu(k,615) * lu(k,840) + lu(k,849) = lu(k,849) - lu(k,616) * lu(k,840) + lu(k,850) = lu(k,850) - lu(k,617) * lu(k,840) + lu(k,851) = lu(k,851) - lu(k,618) * lu(k,840) + lu(k,864) = lu(k,864) - lu(k,608) * lu(k,863) + lu(k,865) = lu(k,865) - lu(k,609) * lu(k,863) + lu(k,866) = lu(k,866) - lu(k,610) * lu(k,863) + lu(k,867) = lu(k,867) - lu(k,611) * lu(k,863) + lu(k,868) = lu(k,868) - lu(k,612) * lu(k,863) + lu(k,869) = lu(k,869) - lu(k,613) * lu(k,863) + lu(k,870) = lu(k,870) - lu(k,614) * lu(k,863) + lu(k,871) = lu(k,871) - lu(k,615) * lu(k,863) + lu(k,872) = lu(k,872) - lu(k,616) * lu(k,863) + lu(k,873) = lu(k,873) - lu(k,617) * lu(k,863) + lu(k,874) = lu(k,874) - lu(k,618) * lu(k,863) + lu(k,896) = lu(k,896) - lu(k,608) * lu(k,895) + lu(k,897) = lu(k,897) - lu(k,609) * lu(k,895) + lu(k,898) = lu(k,898) - lu(k,610) * lu(k,895) + lu(k,899) = lu(k,899) - lu(k,611) * lu(k,895) + lu(k,900) = lu(k,900) - lu(k,612) * lu(k,895) + lu(k,901) = lu(k,901) - lu(k,613) * lu(k,895) + lu(k,902) = lu(k,902) - lu(k,614) * lu(k,895) + lu(k,903) = lu(k,903) - lu(k,615) * lu(k,895) + lu(k,904) = lu(k,904) - lu(k,616) * lu(k,895) + lu(k,905) = lu(k,905) - lu(k,617) * lu(k,895) + lu(k,906) = lu(k,906) - lu(k,618) * lu(k,895) + lu(k,919) = lu(k,919) - lu(k,608) * lu(k,918) + lu(k,920) = lu(k,920) - lu(k,609) * lu(k,918) + lu(k,921) = lu(k,921) - lu(k,610) * lu(k,918) + lu(k,922) = lu(k,922) - lu(k,611) * lu(k,918) + lu(k,923) = lu(k,923) - lu(k,612) * lu(k,918) + lu(k,924) = lu(k,924) - lu(k,613) * lu(k,918) + lu(k,925) = lu(k,925) - lu(k,614) * lu(k,918) + lu(k,926) = lu(k,926) - lu(k,615) * lu(k,918) + lu(k,927) = lu(k,927) - lu(k,616) * lu(k,918) + lu(k,928) = lu(k,928) - lu(k,617) * lu(k,918) + lu(k,929) = lu(k,929) - lu(k,618) * lu(k,918) + lu(k,946) = lu(k,946) - lu(k,608) * lu(k,945) + lu(k,947) = lu(k,947) - lu(k,609) * lu(k,945) + lu(k,948) = lu(k,948) - lu(k,610) * lu(k,945) + lu(k,949) = lu(k,949) - lu(k,611) * lu(k,945) + lu(k,950) = lu(k,950) - lu(k,612) * lu(k,945) + lu(k,951) = lu(k,951) - lu(k,613) * lu(k,945) + lu(k,952) = lu(k,952) - lu(k,614) * lu(k,945) + lu(k,953) = lu(k,953) - lu(k,615) * lu(k,945) + lu(k,954) = lu(k,954) - lu(k,616) * lu(k,945) + lu(k,955) = lu(k,955) - lu(k,617) * lu(k,945) + lu(k,956) = lu(k,956) - lu(k,618) * lu(k,945) end do - end subroutine lu_fac11 + 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,650) = 1._r8 / lu(k,650) + lu(k,651) = lu(k,651) * lu(k,650) + lu(k,652) = lu(k,652) * lu(k,650) + lu(k,653) = lu(k,653) * lu(k,650) + lu(k,654) = lu(k,654) * lu(k,650) + lu(k,655) = lu(k,655) * lu(k,650) + lu(k,656) = lu(k,656) * lu(k,650) + lu(k,657) = lu(k,657) * lu(k,650) + lu(k,658) = lu(k,658) * lu(k,650) + lu(k,659) = lu(k,659) * lu(k,650) + lu(k,660) = lu(k,660) * lu(k,650) + lu(k,676) = lu(k,676) - lu(k,651) * lu(k,675) + lu(k,677) = lu(k,677) - lu(k,652) * lu(k,675) + lu(k,678) = lu(k,678) - lu(k,653) * lu(k,675) + lu(k,679) = lu(k,679) - lu(k,654) * lu(k,675) + lu(k,680) = lu(k,680) - lu(k,655) * lu(k,675) + lu(k,681) = lu(k,681) - lu(k,656) * lu(k,675) + lu(k,682) = lu(k,682) - lu(k,657) * lu(k,675) + lu(k,683) = lu(k,683) - lu(k,658) * lu(k,675) + lu(k,684) = lu(k,684) - lu(k,659) * lu(k,675) + lu(k,685) = lu(k,685) - lu(k,660) * lu(k,675) + lu(k,718) = lu(k,718) - lu(k,651) * lu(k,717) + lu(k,719) = lu(k,719) - lu(k,652) * lu(k,717) + lu(k,720) = lu(k,720) - lu(k,653) * lu(k,717) + lu(k,721) = lu(k,721) - lu(k,654) * lu(k,717) + lu(k,722) = lu(k,722) - lu(k,655) * lu(k,717) + lu(k,723) = lu(k,723) - lu(k,656) * lu(k,717) + lu(k,724) = lu(k,724) - lu(k,657) * lu(k,717) + lu(k,725) = lu(k,725) - lu(k,658) * lu(k,717) + lu(k,726) = lu(k,726) - lu(k,659) * lu(k,717) + lu(k,727) = lu(k,727) - lu(k,660) * lu(k,717) + lu(k,742) = lu(k,742) - lu(k,651) * lu(k,741) + lu(k,743) = lu(k,743) - lu(k,652) * lu(k,741) + lu(k,744) = lu(k,744) - lu(k,653) * lu(k,741) + lu(k,745) = lu(k,745) - lu(k,654) * lu(k,741) + lu(k,746) = lu(k,746) - lu(k,655) * lu(k,741) + lu(k,747) = lu(k,747) - lu(k,656) * lu(k,741) + lu(k,748) = lu(k,748) - lu(k,657) * lu(k,741) + lu(k,749) = lu(k,749) - lu(k,658) * lu(k,741) + lu(k,750) = lu(k,750) - lu(k,659) * lu(k,741) + lu(k,751) = lu(k,751) - lu(k,660) * lu(k,741) + lu(k,764) = lu(k,764) - lu(k,651) * lu(k,763) + lu(k,765) = lu(k,765) - lu(k,652) * lu(k,763) + lu(k,766) = lu(k,766) - lu(k,653) * lu(k,763) + lu(k,767) = lu(k,767) - lu(k,654) * lu(k,763) + lu(k,768) = lu(k,768) - lu(k,655) * lu(k,763) + lu(k,769) = lu(k,769) - lu(k,656) * lu(k,763) + lu(k,770) = lu(k,770) - lu(k,657) * lu(k,763) + lu(k,771) = lu(k,771) - lu(k,658) * lu(k,763) + lu(k,772) = lu(k,772) - lu(k,659) * lu(k,763) + lu(k,773) = lu(k,773) - lu(k,660) * lu(k,763) + lu(k,793) = lu(k,793) - lu(k,651) * lu(k,792) + lu(k,794) = lu(k,794) - lu(k,652) * lu(k,792) + lu(k,795) = lu(k,795) - lu(k,653) * lu(k,792) + lu(k,796) = lu(k,796) - lu(k,654) * lu(k,792) + lu(k,797) = lu(k,797) - lu(k,655) * lu(k,792) + lu(k,798) = lu(k,798) - lu(k,656) * lu(k,792) + lu(k,799) = lu(k,799) - lu(k,657) * lu(k,792) + lu(k,800) = lu(k,800) - lu(k,658) * lu(k,792) + lu(k,801) = lu(k,801) - lu(k,659) * lu(k,792) + lu(k,802) = lu(k,802) - lu(k,660) * lu(k,792) + lu(k,842) = lu(k,842) - lu(k,651) * lu(k,841) + lu(k,843) = lu(k,843) - lu(k,652) * lu(k,841) + lu(k,844) = lu(k,844) - lu(k,653) * lu(k,841) + lu(k,845) = lu(k,845) - lu(k,654) * lu(k,841) + lu(k,846) = lu(k,846) - lu(k,655) * lu(k,841) + lu(k,847) = lu(k,847) - lu(k,656) * lu(k,841) + lu(k,848) = lu(k,848) - lu(k,657) * lu(k,841) + lu(k,849) = lu(k,849) - lu(k,658) * lu(k,841) + lu(k,850) = lu(k,850) - lu(k,659) * lu(k,841) + lu(k,851) = lu(k,851) - lu(k,660) * lu(k,841) + lu(k,865) = lu(k,865) - lu(k,651) * lu(k,864) + lu(k,866) = lu(k,866) - lu(k,652) * lu(k,864) + lu(k,867) = lu(k,867) - lu(k,653) * lu(k,864) + lu(k,868) = lu(k,868) - lu(k,654) * lu(k,864) + lu(k,869) = lu(k,869) - lu(k,655) * lu(k,864) + lu(k,870) = lu(k,870) - lu(k,656) * lu(k,864) + lu(k,871) = lu(k,871) - lu(k,657) * lu(k,864) + lu(k,872) = lu(k,872) - lu(k,658) * lu(k,864) + lu(k,873) = lu(k,873) - lu(k,659) * lu(k,864) + lu(k,874) = lu(k,874) - lu(k,660) * lu(k,864) + lu(k,897) = lu(k,897) - lu(k,651) * lu(k,896) + lu(k,898) = lu(k,898) - lu(k,652) * lu(k,896) + lu(k,899) = lu(k,899) - lu(k,653) * lu(k,896) + lu(k,900) = lu(k,900) - lu(k,654) * lu(k,896) + lu(k,901) = lu(k,901) - lu(k,655) * lu(k,896) + lu(k,902) = lu(k,902) - lu(k,656) * lu(k,896) + lu(k,903) = lu(k,903) - lu(k,657) * lu(k,896) + lu(k,904) = lu(k,904) - lu(k,658) * lu(k,896) + lu(k,905) = lu(k,905) - lu(k,659) * lu(k,896) + lu(k,906) = lu(k,906) - lu(k,660) * lu(k,896) + lu(k,920) = lu(k,920) - lu(k,651) * lu(k,919) + lu(k,921) = lu(k,921) - lu(k,652) * lu(k,919) + lu(k,922) = lu(k,922) - lu(k,653) * lu(k,919) + lu(k,923) = lu(k,923) - lu(k,654) * lu(k,919) + lu(k,924) = lu(k,924) - lu(k,655) * lu(k,919) + lu(k,925) = lu(k,925) - lu(k,656) * lu(k,919) + lu(k,926) = lu(k,926) - lu(k,657) * lu(k,919) + lu(k,927) = lu(k,927) - lu(k,658) * lu(k,919) + lu(k,928) = lu(k,928) - lu(k,659) * lu(k,919) + lu(k,929) = lu(k,929) - lu(k,660) * lu(k,919) + lu(k,947) = lu(k,947) - lu(k,651) * lu(k,946) + lu(k,948) = lu(k,948) - lu(k,652) * lu(k,946) + lu(k,949) = lu(k,949) - lu(k,653) * lu(k,946) + lu(k,950) = lu(k,950) - lu(k,654) * lu(k,946) + lu(k,951) = lu(k,951) - lu(k,655) * lu(k,946) + lu(k,952) = lu(k,952) - lu(k,656) * lu(k,946) + lu(k,953) = lu(k,953) - lu(k,657) * lu(k,946) + lu(k,954) = lu(k,954) - lu(k,658) * lu(k,946) + lu(k,955) = lu(k,955) - lu(k,659) * lu(k,946) + lu(k,956) = lu(k,956) - lu(k,660) * lu(k,946) + lu(k,676) = 1._r8 / lu(k,676) + lu(k,677) = lu(k,677) * lu(k,676) + lu(k,678) = lu(k,678) * lu(k,676) + lu(k,679) = lu(k,679) * lu(k,676) + lu(k,680) = lu(k,680) * lu(k,676) + lu(k,681) = lu(k,681) * lu(k,676) + lu(k,682) = lu(k,682) * lu(k,676) + lu(k,683) = lu(k,683) * lu(k,676) + lu(k,684) = lu(k,684) * lu(k,676) + lu(k,685) = lu(k,685) * lu(k,676) + lu(k,719) = lu(k,719) - lu(k,677) * lu(k,718) + lu(k,720) = lu(k,720) - lu(k,678) * lu(k,718) + lu(k,721) = lu(k,721) - lu(k,679) * lu(k,718) + lu(k,722) = lu(k,722) - lu(k,680) * lu(k,718) + lu(k,723) = lu(k,723) - lu(k,681) * lu(k,718) + lu(k,724) = lu(k,724) - lu(k,682) * lu(k,718) + lu(k,725) = lu(k,725) - lu(k,683) * lu(k,718) + lu(k,726) = lu(k,726) - lu(k,684) * lu(k,718) + lu(k,727) = lu(k,727) - lu(k,685) * lu(k,718) + lu(k,743) = lu(k,743) - lu(k,677) * lu(k,742) + lu(k,744) = lu(k,744) - lu(k,678) * lu(k,742) + lu(k,745) = lu(k,745) - lu(k,679) * lu(k,742) + lu(k,746) = lu(k,746) - lu(k,680) * lu(k,742) + lu(k,747) = lu(k,747) - lu(k,681) * lu(k,742) + lu(k,748) = lu(k,748) - lu(k,682) * lu(k,742) + lu(k,749) = lu(k,749) - lu(k,683) * lu(k,742) + lu(k,750) = lu(k,750) - lu(k,684) * lu(k,742) + lu(k,751) = lu(k,751) - lu(k,685) * lu(k,742) + lu(k,765) = lu(k,765) - lu(k,677) * lu(k,764) + lu(k,766) = lu(k,766) - lu(k,678) * lu(k,764) + lu(k,767) = lu(k,767) - lu(k,679) * lu(k,764) + lu(k,768) = lu(k,768) - lu(k,680) * lu(k,764) + lu(k,769) = lu(k,769) - lu(k,681) * lu(k,764) + lu(k,770) = lu(k,770) - lu(k,682) * lu(k,764) + lu(k,771) = lu(k,771) - lu(k,683) * lu(k,764) + lu(k,772) = lu(k,772) - lu(k,684) * lu(k,764) + lu(k,773) = lu(k,773) - lu(k,685) * lu(k,764) + lu(k,794) = lu(k,794) - lu(k,677) * lu(k,793) + lu(k,795) = lu(k,795) - lu(k,678) * lu(k,793) + lu(k,796) = lu(k,796) - lu(k,679) * lu(k,793) + lu(k,797) = lu(k,797) - lu(k,680) * lu(k,793) + lu(k,798) = lu(k,798) - lu(k,681) * lu(k,793) + lu(k,799) = lu(k,799) - lu(k,682) * lu(k,793) + lu(k,800) = lu(k,800) - lu(k,683) * lu(k,793) + lu(k,801) = lu(k,801) - lu(k,684) * lu(k,793) + lu(k,802) = lu(k,802) - lu(k,685) * lu(k,793) + lu(k,843) = lu(k,843) - lu(k,677) * lu(k,842) + lu(k,844) = lu(k,844) - lu(k,678) * lu(k,842) + lu(k,845) = lu(k,845) - lu(k,679) * lu(k,842) + lu(k,846) = lu(k,846) - lu(k,680) * lu(k,842) + lu(k,847) = lu(k,847) - lu(k,681) * lu(k,842) + lu(k,848) = lu(k,848) - lu(k,682) * lu(k,842) + lu(k,849) = lu(k,849) - lu(k,683) * lu(k,842) + lu(k,850) = lu(k,850) - lu(k,684) * lu(k,842) + lu(k,851) = lu(k,851) - lu(k,685) * lu(k,842) + lu(k,866) = lu(k,866) - lu(k,677) * lu(k,865) + lu(k,867) = lu(k,867) - lu(k,678) * lu(k,865) + lu(k,868) = lu(k,868) - lu(k,679) * lu(k,865) + lu(k,869) = lu(k,869) - lu(k,680) * lu(k,865) + lu(k,870) = lu(k,870) - lu(k,681) * lu(k,865) + lu(k,871) = lu(k,871) - lu(k,682) * lu(k,865) + lu(k,872) = lu(k,872) - lu(k,683) * lu(k,865) + lu(k,873) = lu(k,873) - lu(k,684) * lu(k,865) + lu(k,874) = lu(k,874) - lu(k,685) * lu(k,865) + lu(k,898) = lu(k,898) - lu(k,677) * lu(k,897) + lu(k,899) = lu(k,899) - lu(k,678) * lu(k,897) + lu(k,900) = lu(k,900) - lu(k,679) * lu(k,897) + lu(k,901) = lu(k,901) - lu(k,680) * lu(k,897) + lu(k,902) = lu(k,902) - lu(k,681) * lu(k,897) + lu(k,903) = lu(k,903) - lu(k,682) * lu(k,897) + lu(k,904) = lu(k,904) - lu(k,683) * lu(k,897) + lu(k,905) = lu(k,905) - lu(k,684) * lu(k,897) + lu(k,906) = lu(k,906) - lu(k,685) * lu(k,897) + lu(k,921) = lu(k,921) - lu(k,677) * lu(k,920) + lu(k,922) = lu(k,922) - lu(k,678) * lu(k,920) + lu(k,923) = lu(k,923) - lu(k,679) * lu(k,920) + lu(k,924) = lu(k,924) - lu(k,680) * lu(k,920) + lu(k,925) = lu(k,925) - lu(k,681) * lu(k,920) + lu(k,926) = lu(k,926) - lu(k,682) * lu(k,920) + lu(k,927) = lu(k,927) - lu(k,683) * lu(k,920) + lu(k,928) = lu(k,928) - lu(k,684) * lu(k,920) + lu(k,929) = lu(k,929) - lu(k,685) * lu(k,920) + lu(k,948) = lu(k,948) - lu(k,677) * lu(k,947) + lu(k,949) = lu(k,949) - lu(k,678) * lu(k,947) + lu(k,950) = lu(k,950) - lu(k,679) * lu(k,947) + lu(k,951) = lu(k,951) - lu(k,680) * lu(k,947) + lu(k,952) = lu(k,952) - lu(k,681) * lu(k,947) + lu(k,953) = lu(k,953) - lu(k,682) * lu(k,947) + lu(k,954) = lu(k,954) - lu(k,683) * lu(k,947) + lu(k,955) = lu(k,955) - lu(k,684) * lu(k,947) + lu(k,956) = lu(k,956) - lu(k,685) * lu(k,947) + lu(k,719) = 1._r8 / lu(k,719) + lu(k,720) = lu(k,720) * lu(k,719) + lu(k,721) = lu(k,721) * lu(k,719) + lu(k,722) = lu(k,722) * lu(k,719) + lu(k,723) = lu(k,723) * lu(k,719) + lu(k,724) = lu(k,724) * lu(k,719) + lu(k,725) = lu(k,725) * lu(k,719) + lu(k,726) = lu(k,726) * lu(k,719) + lu(k,727) = lu(k,727) * lu(k,719) + lu(k,744) = lu(k,744) - lu(k,720) * lu(k,743) + lu(k,745) = lu(k,745) - lu(k,721) * lu(k,743) + lu(k,746) = lu(k,746) - lu(k,722) * lu(k,743) + lu(k,747) = lu(k,747) - lu(k,723) * lu(k,743) + lu(k,748) = lu(k,748) - lu(k,724) * lu(k,743) + lu(k,749) = lu(k,749) - lu(k,725) * lu(k,743) + lu(k,750) = lu(k,750) - lu(k,726) * lu(k,743) + lu(k,751) = lu(k,751) - lu(k,727) * lu(k,743) + lu(k,766) = lu(k,766) - lu(k,720) * lu(k,765) + lu(k,767) = lu(k,767) - lu(k,721) * lu(k,765) + lu(k,768) = lu(k,768) - lu(k,722) * lu(k,765) + lu(k,769) = lu(k,769) - lu(k,723) * lu(k,765) + lu(k,770) = lu(k,770) - lu(k,724) * lu(k,765) + lu(k,771) = lu(k,771) - lu(k,725) * lu(k,765) + lu(k,772) = lu(k,772) - lu(k,726) * lu(k,765) + lu(k,773) = lu(k,773) - lu(k,727) * lu(k,765) + lu(k,795) = lu(k,795) - lu(k,720) * lu(k,794) + lu(k,796) = lu(k,796) - lu(k,721) * lu(k,794) + lu(k,797) = lu(k,797) - lu(k,722) * lu(k,794) + lu(k,798) = lu(k,798) - lu(k,723) * lu(k,794) + lu(k,799) = lu(k,799) - lu(k,724) * lu(k,794) + lu(k,800) = lu(k,800) - lu(k,725) * lu(k,794) + lu(k,801) = lu(k,801) - lu(k,726) * lu(k,794) + lu(k,802) = lu(k,802) - lu(k,727) * lu(k,794) + lu(k,844) = lu(k,844) - lu(k,720) * lu(k,843) + lu(k,845) = lu(k,845) - lu(k,721) * lu(k,843) + lu(k,846) = lu(k,846) - lu(k,722) * lu(k,843) + lu(k,847) = lu(k,847) - lu(k,723) * lu(k,843) + lu(k,848) = lu(k,848) - lu(k,724) * lu(k,843) + lu(k,849) = lu(k,849) - lu(k,725) * lu(k,843) + lu(k,850) = lu(k,850) - lu(k,726) * lu(k,843) + lu(k,851) = lu(k,851) - lu(k,727) * lu(k,843) + lu(k,867) = lu(k,867) - lu(k,720) * lu(k,866) + lu(k,868) = lu(k,868) - lu(k,721) * lu(k,866) + lu(k,869) = lu(k,869) - lu(k,722) * lu(k,866) + lu(k,870) = lu(k,870) - lu(k,723) * lu(k,866) + lu(k,871) = lu(k,871) - lu(k,724) * lu(k,866) + lu(k,872) = lu(k,872) - lu(k,725) * lu(k,866) + lu(k,873) = lu(k,873) - lu(k,726) * lu(k,866) + lu(k,874) = lu(k,874) - lu(k,727) * lu(k,866) + lu(k,899) = lu(k,899) - lu(k,720) * lu(k,898) + lu(k,900) = lu(k,900) - lu(k,721) * lu(k,898) + lu(k,901) = lu(k,901) - lu(k,722) * lu(k,898) + lu(k,902) = lu(k,902) - lu(k,723) * lu(k,898) + lu(k,903) = lu(k,903) - lu(k,724) * lu(k,898) + lu(k,904) = lu(k,904) - lu(k,725) * lu(k,898) + lu(k,905) = lu(k,905) - lu(k,726) * lu(k,898) + lu(k,906) = lu(k,906) - lu(k,727) * lu(k,898) + lu(k,922) = lu(k,922) - lu(k,720) * lu(k,921) + lu(k,923) = lu(k,923) - lu(k,721) * lu(k,921) + lu(k,924) = lu(k,924) - lu(k,722) * lu(k,921) + lu(k,925) = lu(k,925) - lu(k,723) * lu(k,921) + lu(k,926) = lu(k,926) - lu(k,724) * lu(k,921) + lu(k,927) = lu(k,927) - lu(k,725) * lu(k,921) + lu(k,928) = lu(k,928) - lu(k,726) * lu(k,921) + lu(k,929) = lu(k,929) - lu(k,727) * lu(k,921) + lu(k,949) = lu(k,949) - lu(k,720) * lu(k,948) + lu(k,950) = lu(k,950) - lu(k,721) * lu(k,948) + lu(k,951) = lu(k,951) - lu(k,722) * lu(k,948) + lu(k,952) = lu(k,952) - lu(k,723) * lu(k,948) + lu(k,953) = lu(k,953) - lu(k,724) * lu(k,948) + lu(k,954) = lu(k,954) - lu(k,725) * lu(k,948) + lu(k,955) = lu(k,955) - lu(k,726) * lu(k,948) + lu(k,956) = lu(k,956) - lu(k,727) * lu(k,948) + lu(k,744) = 1._r8 / lu(k,744) + lu(k,745) = lu(k,745) * lu(k,744) + lu(k,746) = lu(k,746) * lu(k,744) + lu(k,747) = lu(k,747) * lu(k,744) + lu(k,748) = lu(k,748) * lu(k,744) + lu(k,749) = lu(k,749) * lu(k,744) + lu(k,750) = lu(k,750) * lu(k,744) + lu(k,751) = lu(k,751) * lu(k,744) + lu(k,767) = lu(k,767) - lu(k,745) * lu(k,766) + lu(k,768) = lu(k,768) - lu(k,746) * lu(k,766) + lu(k,769) = lu(k,769) - lu(k,747) * lu(k,766) + lu(k,770) = lu(k,770) - lu(k,748) * lu(k,766) + lu(k,771) = lu(k,771) - lu(k,749) * lu(k,766) + lu(k,772) = lu(k,772) - lu(k,750) * lu(k,766) + lu(k,773) = lu(k,773) - lu(k,751) * lu(k,766) + lu(k,796) = lu(k,796) - lu(k,745) * lu(k,795) + lu(k,797) = lu(k,797) - lu(k,746) * lu(k,795) + lu(k,798) = lu(k,798) - lu(k,747) * lu(k,795) + lu(k,799) = lu(k,799) - lu(k,748) * lu(k,795) + lu(k,800) = lu(k,800) - lu(k,749) * lu(k,795) + lu(k,801) = lu(k,801) - lu(k,750) * lu(k,795) + lu(k,802) = lu(k,802) - lu(k,751) * lu(k,795) + lu(k,845) = lu(k,845) - lu(k,745) * lu(k,844) + lu(k,846) = lu(k,846) - lu(k,746) * lu(k,844) + lu(k,847) = lu(k,847) - lu(k,747) * lu(k,844) + lu(k,848) = lu(k,848) - lu(k,748) * lu(k,844) + lu(k,849) = lu(k,849) - lu(k,749) * lu(k,844) + lu(k,850) = lu(k,850) - lu(k,750) * lu(k,844) + lu(k,851) = lu(k,851) - lu(k,751) * lu(k,844) + lu(k,868) = lu(k,868) - lu(k,745) * lu(k,867) + lu(k,869) = lu(k,869) - lu(k,746) * lu(k,867) + lu(k,870) = lu(k,870) - lu(k,747) * lu(k,867) + lu(k,871) = lu(k,871) - lu(k,748) * lu(k,867) + lu(k,872) = lu(k,872) - lu(k,749) * lu(k,867) + lu(k,873) = lu(k,873) - lu(k,750) * lu(k,867) + lu(k,874) = lu(k,874) - lu(k,751) * lu(k,867) + lu(k,900) = lu(k,900) - lu(k,745) * lu(k,899) + lu(k,901) = lu(k,901) - lu(k,746) * lu(k,899) + lu(k,902) = lu(k,902) - lu(k,747) * lu(k,899) + lu(k,903) = lu(k,903) - lu(k,748) * lu(k,899) + lu(k,904) = lu(k,904) - lu(k,749) * lu(k,899) + lu(k,905) = lu(k,905) - lu(k,750) * lu(k,899) + lu(k,906) = lu(k,906) - lu(k,751) * lu(k,899) + lu(k,923) = lu(k,923) - lu(k,745) * lu(k,922) + lu(k,924) = lu(k,924) - lu(k,746) * lu(k,922) + lu(k,925) = lu(k,925) - lu(k,747) * lu(k,922) + lu(k,926) = lu(k,926) - lu(k,748) * lu(k,922) + lu(k,927) = lu(k,927) - lu(k,749) * lu(k,922) + lu(k,928) = lu(k,928) - lu(k,750) * lu(k,922) + lu(k,929) = lu(k,929) - lu(k,751) * lu(k,922) + lu(k,950) = lu(k,950) - lu(k,745) * lu(k,949) + lu(k,951) = lu(k,951) - lu(k,746) * lu(k,949) + lu(k,952) = lu(k,952) - lu(k,747) * lu(k,949) + lu(k,953) = lu(k,953) - lu(k,748) * lu(k,949) + lu(k,954) = lu(k,954) - lu(k,749) * lu(k,949) + lu(k,955) = lu(k,955) - lu(k,750) * lu(k,949) + lu(k,956) = lu(k,956) - lu(k,751) * lu(k,949) + lu(k,767) = 1._r8 / lu(k,767) + lu(k,768) = lu(k,768) * lu(k,767) + lu(k,769) = lu(k,769) * lu(k,767) + lu(k,770) = lu(k,770) * lu(k,767) + lu(k,771) = lu(k,771) * lu(k,767) + lu(k,772) = lu(k,772) * lu(k,767) + lu(k,773) = lu(k,773) * lu(k,767) + lu(k,797) = lu(k,797) - lu(k,768) * lu(k,796) + lu(k,798) = lu(k,798) - lu(k,769) * lu(k,796) + lu(k,799) = lu(k,799) - lu(k,770) * lu(k,796) + lu(k,800) = lu(k,800) - lu(k,771) * lu(k,796) + lu(k,801) = lu(k,801) - lu(k,772) * lu(k,796) + lu(k,802) = lu(k,802) - lu(k,773) * lu(k,796) + lu(k,846) = lu(k,846) - lu(k,768) * lu(k,845) + lu(k,847) = lu(k,847) - lu(k,769) * lu(k,845) + lu(k,848) = lu(k,848) - lu(k,770) * lu(k,845) + lu(k,849) = lu(k,849) - lu(k,771) * lu(k,845) + lu(k,850) = lu(k,850) - lu(k,772) * lu(k,845) + lu(k,851) = lu(k,851) - lu(k,773) * lu(k,845) + lu(k,869) = lu(k,869) - lu(k,768) * lu(k,868) + lu(k,870) = lu(k,870) - lu(k,769) * lu(k,868) + lu(k,871) = lu(k,871) - lu(k,770) * lu(k,868) + lu(k,872) = lu(k,872) - lu(k,771) * lu(k,868) + lu(k,873) = lu(k,873) - lu(k,772) * lu(k,868) + lu(k,874) = lu(k,874) - lu(k,773) * lu(k,868) + lu(k,901) = lu(k,901) - lu(k,768) * lu(k,900) + lu(k,902) = lu(k,902) - lu(k,769) * lu(k,900) + lu(k,903) = lu(k,903) - lu(k,770) * lu(k,900) + lu(k,904) = lu(k,904) - lu(k,771) * lu(k,900) + lu(k,905) = lu(k,905) - lu(k,772) * lu(k,900) + lu(k,906) = lu(k,906) - lu(k,773) * lu(k,900) + lu(k,924) = lu(k,924) - lu(k,768) * lu(k,923) + lu(k,925) = lu(k,925) - lu(k,769) * lu(k,923) + lu(k,926) = lu(k,926) - lu(k,770) * lu(k,923) + lu(k,927) = lu(k,927) - lu(k,771) * lu(k,923) + lu(k,928) = lu(k,928) - lu(k,772) * lu(k,923) + lu(k,929) = lu(k,929) - lu(k,773) * lu(k,923) + lu(k,951) = lu(k,951) - lu(k,768) * lu(k,950) + lu(k,952) = lu(k,952) - lu(k,769) * lu(k,950) + lu(k,953) = lu(k,953) - lu(k,770) * lu(k,950) + lu(k,954) = lu(k,954) - lu(k,771) * lu(k,950) + lu(k,955) = lu(k,955) - lu(k,772) * lu(k,950) + lu(k,956) = lu(k,956) - lu(k,773) * lu(k,950) + lu(k,797) = 1._r8 / lu(k,797) + lu(k,798) = lu(k,798) * lu(k,797) + lu(k,799) = lu(k,799) * lu(k,797) + lu(k,800) = lu(k,800) * lu(k,797) + lu(k,801) = lu(k,801) * lu(k,797) + lu(k,802) = lu(k,802) * lu(k,797) + lu(k,847) = lu(k,847) - lu(k,798) * lu(k,846) + lu(k,848) = lu(k,848) - lu(k,799) * lu(k,846) + lu(k,849) = lu(k,849) - lu(k,800) * lu(k,846) + lu(k,850) = lu(k,850) - lu(k,801) * lu(k,846) + lu(k,851) = lu(k,851) - lu(k,802) * lu(k,846) + lu(k,870) = lu(k,870) - lu(k,798) * lu(k,869) + lu(k,871) = lu(k,871) - lu(k,799) * lu(k,869) + lu(k,872) = lu(k,872) - lu(k,800) * lu(k,869) + lu(k,873) = lu(k,873) - lu(k,801) * lu(k,869) + lu(k,874) = lu(k,874) - lu(k,802) * lu(k,869) + lu(k,902) = lu(k,902) - lu(k,798) * lu(k,901) + lu(k,903) = lu(k,903) - lu(k,799) * lu(k,901) + lu(k,904) = lu(k,904) - lu(k,800) * lu(k,901) + lu(k,905) = lu(k,905) - lu(k,801) * lu(k,901) + lu(k,906) = lu(k,906) - lu(k,802) * lu(k,901) + lu(k,925) = lu(k,925) - lu(k,798) * lu(k,924) + lu(k,926) = lu(k,926) - lu(k,799) * lu(k,924) + lu(k,927) = lu(k,927) - lu(k,800) * lu(k,924) + lu(k,928) = lu(k,928) - lu(k,801) * lu(k,924) + lu(k,929) = lu(k,929) - lu(k,802) * lu(k,924) + lu(k,952) = lu(k,952) - lu(k,798) * lu(k,951) + lu(k,953) = lu(k,953) - lu(k,799) * lu(k,951) + lu(k,954) = lu(k,954) - lu(k,800) * lu(k,951) + lu(k,955) = lu(k,955) - lu(k,801) * lu(k,951) + lu(k,956) = lu(k,956) - lu(k,802) * lu(k,951) + 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,847) = 1._r8 / lu(k,847) + lu(k,848) = lu(k,848) * lu(k,847) + lu(k,849) = lu(k,849) * lu(k,847) + lu(k,850) = lu(k,850) * lu(k,847) + lu(k,851) = lu(k,851) * lu(k,847) + lu(k,871) = lu(k,871) - lu(k,848) * lu(k,870) + lu(k,872) = lu(k,872) - lu(k,849) * lu(k,870) + lu(k,873) = lu(k,873) - lu(k,850) * lu(k,870) + lu(k,874) = lu(k,874) - lu(k,851) * lu(k,870) + lu(k,903) = lu(k,903) - lu(k,848) * lu(k,902) + lu(k,904) = lu(k,904) - lu(k,849) * lu(k,902) + lu(k,905) = lu(k,905) - lu(k,850) * lu(k,902) + lu(k,906) = lu(k,906) - lu(k,851) * lu(k,902) + lu(k,926) = lu(k,926) - lu(k,848) * lu(k,925) + lu(k,927) = lu(k,927) - lu(k,849) * lu(k,925) + lu(k,928) = lu(k,928) - lu(k,850) * lu(k,925) + lu(k,929) = lu(k,929) - lu(k,851) * lu(k,925) + lu(k,953) = lu(k,953) - lu(k,848) * lu(k,952) + lu(k,954) = lu(k,954) - lu(k,849) * lu(k,952) + lu(k,955) = lu(k,955) - lu(k,850) * lu(k,952) + lu(k,956) = lu(k,956) - lu(k,851) * lu(k,952) + lu(k,871) = 1._r8 / lu(k,871) + lu(k,872) = lu(k,872) * lu(k,871) + lu(k,873) = lu(k,873) * lu(k,871) + lu(k,874) = lu(k,874) * lu(k,871) + lu(k,904) = lu(k,904) - lu(k,872) * lu(k,903) + lu(k,905) = lu(k,905) - lu(k,873) * lu(k,903) + lu(k,906) = lu(k,906) - lu(k,874) * lu(k,903) + lu(k,927) = lu(k,927) - lu(k,872) * lu(k,926) + lu(k,928) = lu(k,928) - lu(k,873) * lu(k,926) + lu(k,929) = lu(k,929) - lu(k,874) * lu(k,926) + lu(k,954) = lu(k,954) - lu(k,872) * lu(k,953) + lu(k,955) = lu(k,955) - lu(k,873) * lu(k,953) + lu(k,956) = lu(k,956) - lu(k,874) * lu(k,953) + lu(k,904) = 1._r8 / lu(k,904) + lu(k,905) = lu(k,905) * lu(k,904) + lu(k,906) = lu(k,906) * lu(k,904) + lu(k,928) = lu(k,928) - lu(k,905) * lu(k,927) + lu(k,929) = lu(k,929) - lu(k,906) * lu(k,927) + lu(k,955) = lu(k,955) - lu(k,905) * lu(k,954) + lu(k,956) = lu(k,956) - lu(k,906) * lu(k,954) + lu(k,928) = 1._r8 / lu(k,928) + lu(k,929) = lu(k,929) * lu(k,928) + lu(k,956) = lu(k,956) - lu(k,929) * lu(k,955) + lu(k,956) = 1._r8 / lu(k,956) + end do + end subroutine lu_fac14 subroutine lu_fac( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 @@ -3236,5 +3958,8 @@ subroutine lu_fac( 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 ) end subroutine lu_fac end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_lu_solve.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_lu_solve.F90 index db323045ee..a4e2b69d79 100644 --- a/src/chemistry/pp_waccm_ma_mam4/mo_lu_solve.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/mo_lu_solve.F90 @@ -21,211 +21,212 @@ subroutine lu_slv01( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,65) = b(k,65) - lu(k,22) * b(k,21) - b(k,66) = b(k,66) - lu(k,23) * b(k,21) - b(k,30) = b(k,30) - lu(k,25) * b(k,22) - b(k,77) = b(k,77) - lu(k,26) * b(k,22) - b(k,46) = b(k,46) - lu(k,28) * b(k,23) - b(k,69) = b(k,69) - lu(k,29) * b(k,23) - b(k,72) = b(k,72) - lu(k,31) * b(k,24) - b(k,72) = b(k,72) - lu(k,34) * b(k,25) - b(k,65) = b(k,65) - lu(k,36) * b(k,26) - b(k,46) = b(k,46) - lu(k,38) * b(k,27) - b(k,65) = b(k,65) - lu(k,39) * b(k,27) - b(k,69) = b(k,69) - lu(k,40) * b(k,27) - b(k,46) = b(k,46) - lu(k,42) * b(k,28) - b(k,59) = b(k,59) - lu(k,43) * b(k,28) - b(k,60) = b(k,60) - lu(k,45) * b(k,29) - b(k,65) = b(k,65) - lu(k,46) * b(k,29) - b(k,55) = b(k,55) - lu(k,49) * b(k,30) - b(k,67) = b(k,67) - lu(k,50) * b(k,30) - b(k,77) = b(k,77) - lu(k,51) * b(k,30) - b(k,57) = b(k,57) - lu(k,53) * b(k,31) - b(k,63) = b(k,63) - lu(k,54) * b(k,31) - b(k,67) = b(k,67) - lu(k,55) * b(k,31) - b(k,75) = b(k,75) - lu(k,56) * b(k,31) - b(k,76) = b(k,76) - lu(k,57) * b(k,31) - b(k,55) = b(k,55) - lu(k,59) * b(k,32) - b(k,57) = b(k,57) - lu(k,60) * b(k,32) - b(k,63) = b(k,63) - lu(k,61) * b(k,32) - b(k,64) = b(k,64) - lu(k,62) * b(k,32) - b(k,73) = b(k,73) - lu(k,63) * b(k,32) - b(k,55) = b(k,55) - lu(k,65) * b(k,33) - b(k,58) = b(k,58) - lu(k,66) * b(k,33) - b(k,66) = b(k,66) - lu(k,67) * b(k,33) - b(k,67) = b(k,67) - lu(k,68) * b(k,33) - b(k,39) = b(k,39) - lu(k,70) * b(k,34) - b(k,43) = b(k,43) - lu(k,71) * b(k,34) - b(k,55) = b(k,55) - lu(k,72) * b(k,34) - b(k,58) = b(k,58) - lu(k,73) * b(k,34) - b(k,59) = b(k,59) - lu(k,74) * b(k,34) - b(k,67) = b(k,67) - lu(k,75) * b(k,34) - b(k,73) = b(k,73) - lu(k,76) * b(k,34) - b(k,59) = b(k,59) - lu(k,78) * b(k,35) - b(k,62) = b(k,62) - lu(k,79) * b(k,35) - b(k,68) = b(k,68) - lu(k,80) * b(k,35) - b(k,73) = b(k,73) - lu(k,81) * b(k,35) - b(k,77) = b(k,77) - lu(k,82) * b(k,35) - b(k,63) = b(k,63) - lu(k,84) * b(k,36) - b(k,64) = b(k,64) - lu(k,85) * b(k,36) - b(k,72) = b(k,72) - lu(k,86) * b(k,36) - b(k,73) = b(k,73) - lu(k,87) * b(k,36) - b(k,75) = b(k,75) - lu(k,88) * b(k,36) - b(k,77) = b(k,77) - lu(k,89) * b(k,36) - b(k,38) = b(k,38) - lu(k,91) * b(k,37) - b(k,42) = b(k,42) - lu(k,92) * b(k,37) - b(k,48) = b(k,48) - lu(k,93) * b(k,37) - b(k,50) = b(k,50) - lu(k,94) * b(k,37) - b(k,67) = b(k,67) - lu(k,95) * b(k,37) - b(k,76) = b(k,76) - lu(k,96) * b(k,37) - b(k,42) = b(k,42) - lu(k,98) * b(k,38) - b(k,50) = b(k,50) - lu(k,99) * b(k,38) - b(k,51) = b(k,51) - lu(k,100) * b(k,38) - b(k,67) = b(k,67) - lu(k,101) * b(k,38) - b(k,72) = b(k,72) - lu(k,102) * b(k,38) - b(k,59) = b(k,59) - lu(k,104) * b(k,39) - b(k,64) = b(k,64) - lu(k,105) * b(k,39) - b(k,73) = b(k,73) - lu(k,106) * b(k,39) - b(k,45) = b(k,45) - lu(k,108) * b(k,40) - b(k,57) = b(k,57) - lu(k,109) * b(k,40) - b(k,60) = b(k,60) - lu(k,110) * b(k,40) - b(k,63) = b(k,63) - lu(k,111) * b(k,40) - b(k,67) = b(k,67) - lu(k,112) * b(k,40) - b(k,71) = b(k,71) - lu(k,113) * b(k,40) - b(k,75) = b(k,75) - lu(k,114) * b(k,40) - b(k,61) = b(k,61) - lu(k,116) * b(k,41) - b(k,64) = b(k,64) - lu(k,117) * b(k,41) - b(k,65) = b(k,65) - lu(k,118) * b(k,41) - b(k,67) = b(k,67) - lu(k,119) * b(k,41) - b(k,73) = b(k,73) - lu(k,120) * b(k,41) - b(k,77) = b(k,77) - lu(k,121) * b(k,41) - b(k,44) = b(k,44) - lu(k,123) * b(k,42) - b(k,50) = b(k,50) - lu(k,124) * b(k,42) - b(k,51) = b(k,51) - lu(k,125) * b(k,42) - b(k,52) = b(k,52) - lu(k,126) * b(k,42) - b(k,53) = b(k,53) - lu(k,127) * b(k,42) - b(k,54) = b(k,54) - lu(k,128) * b(k,42) - b(k,67) = b(k,67) - lu(k,129) * b(k,42) - b(k,72) = b(k,72) - lu(k,130) * b(k,42) - b(k,58) = b(k,58) - lu(k,132) * b(k,43) - b(k,59) = b(k,59) - lu(k,133) * b(k,43) - b(k,67) = b(k,67) - lu(k,134) * b(k,43) - b(k,72) = b(k,72) - lu(k,135) * b(k,43) - b(k,73) = b(k,73) - lu(k,136) * b(k,43) - b(k,74) = b(k,74) - lu(k,137) * b(k,43) - b(k,52) = b(k,52) - lu(k,139) * b(k,44) - b(k,53) = b(k,53) - lu(k,140) * b(k,44) - b(k,54) = b(k,54) - lu(k,141) * b(k,44) - b(k,67) = b(k,67) - lu(k,142) * b(k,44) - b(k,60) = b(k,60) - lu(k,145) * b(k,45) - b(k,61) = b(k,61) - lu(k,146) * b(k,45) - b(k,65) = b(k,65) - lu(k,147) * b(k,45) - b(k,67) = b(k,67) - lu(k,148) * b(k,45) - b(k,71) = b(k,71) - lu(k,149) * b(k,45) - b(k,73) = b(k,73) - lu(k,150) * b(k,45) - b(k,77) = b(k,77) - lu(k,151) * b(k,45) - b(k,57) = b(k,57) - lu(k,154) * b(k,46) - b(k,59) = b(k,59) - lu(k,155) * b(k,46) - b(k,62) = b(k,62) - lu(k,156) * b(k,46) - b(k,63) = b(k,63) - lu(k,157) * b(k,46) - b(k,70) = b(k,70) - lu(k,158) * b(k,46) - b(k,73) = b(k,73) - lu(k,159) * b(k,46) - b(k,77) = b(k,77) - lu(k,160) * b(k,46) - b(k,61) = b(k,61) - lu(k,163) * b(k,47) - b(k,65) = b(k,65) - lu(k,164) * b(k,47) - b(k,66) = b(k,66) - lu(k,165) * b(k,47) - b(k,67) = b(k,67) - lu(k,166) * b(k,47) - b(k,73) = b(k,73) - lu(k,167) * b(k,47) - b(k,77) = b(k,77) - lu(k,168) * b(k,47) - b(k,50) = b(k,50) - lu(k,171) * b(k,48) - b(k,51) = b(k,51) - lu(k,172) * b(k,48) - b(k,52) = b(k,52) - lu(k,173) * b(k,48) - b(k,53) = b(k,53) - lu(k,174) * b(k,48) - b(k,54) = b(k,54) - lu(k,175) * b(k,48) - b(k,67) = b(k,67) - lu(k,176) * b(k,48) - b(k,72) = b(k,72) - lu(k,177) * b(k,48) - b(k,59) = b(k,59) - lu(k,179) * b(k,49) - b(k,60) = b(k,60) - lu(k,180) * b(k,49) - b(k,67) = b(k,67) - lu(k,181) * b(k,49) - b(k,69) = b(k,69) - lu(k,182) * b(k,49) - b(k,71) = b(k,71) - lu(k,183) * b(k,49) - b(k,73) = b(k,73) - lu(k,184) * b(k,49) - b(k,77) = b(k,77) - lu(k,185) * b(k,49) - b(k,51) = b(k,51) - lu(k,190) * b(k,50) - b(k,52) = b(k,52) - lu(k,191) * b(k,50) - b(k,53) = b(k,53) - lu(k,192) * b(k,50) - b(k,54) = b(k,54) - lu(k,193) * b(k,50) - b(k,59) = b(k,59) - lu(k,194) * b(k,50) - b(k,64) = b(k,64) - lu(k,195) * b(k,50) - b(k,67) = b(k,67) - lu(k,196) * b(k,50) - b(k,72) = b(k,72) - lu(k,197) * b(k,50) - b(k,73) = b(k,73) - lu(k,198) * b(k,50) - b(k,52) = b(k,52) - lu(k,201) * b(k,51) - b(k,53) = b(k,53) - lu(k,202) * b(k,51) - b(k,54) = b(k,54) - lu(k,203) * b(k,51) - b(k,67) = b(k,67) - lu(k,204) * b(k,51) - b(k,69) = b(k,69) - lu(k,205) * b(k,51) - b(k,72) = b(k,72) - lu(k,206) * b(k,51) - b(k,76) = b(k,76) - lu(k,207) * b(k,51) - b(k,53) = b(k,53) - lu(k,216) * b(k,52) - b(k,54) = b(k,54) - lu(k,217) * b(k,52) - b(k,59) = b(k,59) - lu(k,218) * b(k,52) - b(k,64) = b(k,64) - lu(k,219) * b(k,52) - b(k,67) = b(k,67) - lu(k,220) * b(k,52) - b(k,69) = b(k,69) - lu(k,221) * b(k,52) - b(k,72) = b(k,72) - lu(k,222) * b(k,52) - b(k,73) = b(k,73) - lu(k,223) * b(k,52) - b(k,76) = b(k,76) - lu(k,224) * b(k,52) - b(k,54) = b(k,54) - lu(k,230) * b(k,53) - b(k,59) = b(k,59) - lu(k,231) * b(k,53) - b(k,64) = b(k,64) - lu(k,232) * b(k,53) - b(k,67) = b(k,67) - lu(k,233) * b(k,53) - b(k,69) = b(k,69) - lu(k,234) * b(k,53) - b(k,72) = b(k,72) - lu(k,235) * b(k,53) - b(k,73) = b(k,73) - lu(k,236) * b(k,53) - b(k,76) = b(k,76) - lu(k,237) * b(k,53) - b(k,59) = b(k,59) - lu(k,245) * b(k,54) - b(k,64) = b(k,64) - lu(k,246) * b(k,54) - b(k,67) = b(k,67) - lu(k,247) * b(k,54) - b(k,69) = b(k,69) - lu(k,248) * b(k,54) - b(k,72) = b(k,72) - lu(k,249) * b(k,54) - b(k,73) = b(k,73) - lu(k,250) * b(k,54) - b(k,75) = b(k,75) - lu(k,251) * b(k,54) - b(k,76) = b(k,76) - lu(k,252) * b(k,54) - b(k,58) = b(k,58) - lu(k,255) * b(k,55) - b(k,64) = b(k,64) - lu(k,256) * b(k,55) - b(k,67) = b(k,67) - lu(k,257) * b(k,55) - b(k,73) = b(k,73) - lu(k,258) * b(k,55) - b(k,77) = b(k,77) - lu(k,259) * b(k,55) - b(k,57) = b(k,57) - lu(k,263) * b(k,56) - b(k,61) = b(k,61) - lu(k,264) * b(k,56) - b(k,63) = b(k,63) - lu(k,265) * b(k,56) - b(k,65) = b(k,65) - lu(k,266) * b(k,56) - b(k,66) = b(k,66) - lu(k,267) * b(k,56) - b(k,67) = b(k,67) - lu(k,268) * b(k,56) - b(k,73) = b(k,73) - lu(k,269) * b(k,56) - b(k,75) = b(k,75) - lu(k,270) * b(k,56) - b(k,77) = b(k,77) - lu(k,271) * b(k,56) - b(k,59) = b(k,59) - lu(k,275) * b(k,57) - b(k,62) = b(k,62) - lu(k,276) * b(k,57) - b(k,63) = b(k,63) - lu(k,277) * b(k,57) - b(k,70) = b(k,70) - lu(k,278) * b(k,57) - b(k,73) = b(k,73) - lu(k,279) * b(k,57) - b(k,75) = b(k,75) - lu(k,280) * b(k,57) - b(k,77) = b(k,77) - lu(k,281) * b(k,57) - b(k,59) = b(k,59) - lu(k,286) * b(k,58) - b(k,60) = b(k,60) - lu(k,287) * b(k,58) - b(k,64) = b(k,64) - lu(k,288) * b(k,58) - b(k,65) = b(k,65) - lu(k,289) * b(k,58) - b(k,66) = b(k,66) - lu(k,290) * b(k,58) - b(k,67) = b(k,67) - lu(k,291) * b(k,58) - b(k,71) = b(k,71) - lu(k,292) * b(k,58) - b(k,72) = b(k,72) - lu(k,293) * b(k,58) - b(k,73) = b(k,73) - lu(k,294) * b(k,58) - b(k,74) = b(k,74) - lu(k,295) * b(k,58) - b(k,75) = b(k,75) - lu(k,296) * b(k,58) - b(k,76) = b(k,76) - lu(k,297) * b(k,58) - b(k,77) = b(k,77) - lu(k,298) * b(k,58) + b(k,88) = b(k,88) - lu(k,25) * b(k,24) + b(k,98) = b(k,98) - lu(k,26) * b(k,24) + b(k,92) = b(k,92) - lu(k,28) * b(k,25) + b(k,98) = b(k,98) - lu(k,29) * b(k,25) + b(k,42) = b(k,42) - lu(k,31) * b(k,26) + b(k,92) = b(k,92) - lu(k,32) * b(k,26) + b(k,94) = b(k,94) - lu(k,33) * b(k,26) + b(k,40) = b(k,40) - lu(k,35) * b(k,27) + b(k,92) = b(k,92) - lu(k,36) * b(k,27) + b(k,98) = b(k,98) - lu(k,37) * b(k,27) + b(k,42) = b(k,42) - lu(k,39) * b(k,28) + b(k,92) = b(k,92) - lu(k,40) * b(k,28) + b(k,98) = b(k,98) - lu(k,41) * b(k,28) + b(k,42) = b(k,42) - lu(k,43) * b(k,29) + b(k,92) = b(k,92) - lu(k,44) * b(k,29) + b(k,98) = b(k,98) - lu(k,45) * b(k,29) + b(k,96) = b(k,96) - lu(k,47) * b(k,30) + b(k,98) = b(k,98) - lu(k,48) * b(k,30) + b(k,100) = b(k,100) - lu(k,49) * b(k,30) + b(k,45) = b(k,45) - lu(k,51) * b(k,31) + b(k,100) = b(k,100) - lu(k,52) * b(k,31) + b(k,42) = b(k,42) - lu(k,54) * b(k,32) + b(k,92) = b(k,92) - lu(k,55) * b(k,32) + b(k,94) = b(k,94) - lu(k,56) * b(k,32) + b(k,98) = b(k,98) - lu(k,57) * b(k,32) + b(k,42) = b(k,42) - lu(k,59) * b(k,33) + b(k,71) = b(k,71) - lu(k,60) * b(k,33) + b(k,92) = b(k,92) - lu(k,61) * b(k,33) + b(k,94) = b(k,94) - lu(k,62) * b(k,33) + b(k,40) = b(k,40) - lu(k,64) * b(k,34) + b(k,42) = b(k,42) - lu(k,65) * b(k,34) + b(k,92) = b(k,92) - lu(k,66) * b(k,34) + b(k,98) = b(k,98) - lu(k,67) * b(k,34) + b(k,42) = b(k,42) - lu(k,69) * b(k,35) + b(k,71) = b(k,71) - lu(k,70) * b(k,35) + b(k,92) = b(k,92) - lu(k,71) * b(k,35) + b(k,98) = b(k,98) - lu(k,72) * b(k,35) + b(k,98) = b(k,98) - lu(k,74) * b(k,36) + b(k,85) = b(k,85) - lu(k,76) * b(k,37) + b(k,85) = b(k,85) - lu(k,79) * b(k,38) + b(k,40) = b(k,40) - lu(k,81) * b(k,39) + b(k,92) = b(k,92) - lu(k,82) * b(k,39) + b(k,96) = b(k,96) - lu(k,83) * b(k,39) + b(k,98) = b(k,98) - lu(k,84) * b(k,39) + b(k,71) = b(k,71) - lu(k,86) * b(k,40) + b(k,92) = b(k,92) - lu(k,87) * b(k,40) + b(k,98) = b(k,98) - lu(k,88) * b(k,40) + b(k,42) = b(k,42) - lu(k,90) * b(k,41) + b(k,92) = b(k,92) - lu(k,91) * b(k,41) + b(k,96) = b(k,96) - lu(k,92) * b(k,41) + b(k,98) = b(k,98) - lu(k,93) * b(k,41) + b(k,71) = b(k,71) - lu(k,95) * b(k,42) + b(k,92) = b(k,92) - lu(k,96) * b(k,42) + b(k,94) = b(k,94) - lu(k,98) * b(k,43) + b(k,98) = b(k,98) - lu(k,99) * b(k,43) + b(k,85) = b(k,85) - lu(k,101) * b(k,44) + b(k,91) = b(k,91) - lu(k,102) * b(k,44) + b(k,92) = b(k,92) - lu(k,103) * b(k,44) + b(k,72) = b(k,72) - lu(k,106) * b(k,45) + b(k,90) = b(k,90) - lu(k,107) * b(k,45) + b(k,100) = b(k,100) - lu(k,108) * b(k,45) + b(k,71) = b(k,71) - lu(k,111) * b(k,46) + b(k,92) = b(k,92) - lu(k,112) * b(k,46) + b(k,96) = b(k,96) - lu(k,113) * b(k,46) + b(k,98) = b(k,98) - lu(k,114) * b(k,46) + b(k,100) = b(k,100) - lu(k,115) * b(k,46) + b(k,71) = b(k,71) - lu(k,117) * b(k,47) + b(k,82) = b(k,82) - lu(k,118) * b(k,47) + b(k,89) = b(k,89) - lu(k,120) * b(k,48) + b(k,90) = b(k,90) - lu(k,121) * b(k,48) + b(k,91) = b(k,91) - lu(k,122) * b(k,48) + b(k,95) = b(k,95) - lu(k,123) * b(k,48) + b(k,97) = b(k,97) - lu(k,124) * b(k,48) + b(k,72) = b(k,72) - lu(k,126) * b(k,49) + b(k,87) = b(k,87) - lu(k,127) * b(k,49) + b(k,89) = b(k,89) - lu(k,128) * b(k,49) + b(k,96) = b(k,96) - lu(k,129) * b(k,49) + b(k,97) = b(k,97) - lu(k,130) * b(k,49) + b(k,72) = b(k,72) - lu(k,132) * b(k,50) + b(k,81) = b(k,81) - lu(k,133) * b(k,50) + b(k,88) = b(k,88) - lu(k,134) * b(k,50) + b(k,90) = b(k,90) - lu(k,135) * b(k,50) + b(k,64) = b(k,64) - lu(k,137) * b(k,51) + b(k,70) = b(k,70) - lu(k,138) * b(k,51) + b(k,72) = b(k,72) - lu(k,139) * b(k,51) + b(k,81) = b(k,81) - lu(k,140) * b(k,51) + b(k,82) = b(k,82) - lu(k,141) * b(k,51) + b(k,90) = b(k,90) - lu(k,142) * b(k,51) + b(k,96) = b(k,96) - lu(k,143) * b(k,51) + b(k,70) = b(k,70) - lu(k,145) * b(k,52) + b(k,80) = b(k,80) - lu(k,146) * b(k,52) + b(k,83) = b(k,83) - lu(k,147) * b(k,52) + b(k,87) = b(k,87) - lu(k,148) * b(k,52) + b(k,96) = b(k,96) - lu(k,149) * b(k,52) + b(k,98) = b(k,98) - lu(k,150) * b(k,52) + b(k,100) = b(k,100) - lu(k,151) * b(k,52) + b(k,83) = b(k,83) - lu(k,153) * b(k,53) + b(k,92) = b(k,92) - lu(k,154) * b(k,53) + b(k,94) = b(k,94) - lu(k,155) * b(k,53) + b(k,96) = b(k,96) - lu(k,156) * b(k,53) + b(k,98) = b(k,98) - lu(k,157) * b(k,53) + b(k,80) = b(k,80) - lu(k,159) * b(k,54) + b(k,82) = b(k,82) - lu(k,160) * b(k,54) + b(k,84) = b(k,84) - lu(k,161) * b(k,54) + b(k,96) = b(k,96) - lu(k,162) * b(k,54) + b(k,100) = b(k,100) - lu(k,163) * b(k,54) + b(k,83) = b(k,83) - lu(k,165) * b(k,55) + b(k,92) = b(k,92) - lu(k,166) * b(k,55) + b(k,94) = b(k,94) - lu(k,167) * b(k,55) + b(k,96) = b(k,96) - lu(k,168) * b(k,55) + b(k,98) = b(k,98) - lu(k,169) * b(k,55) + b(k,100) = b(k,100) - lu(k,170) * b(k,55) + b(k,85) = b(k,85) - lu(k,172) * b(k,56) + b(k,87) = b(k,87) - lu(k,173) * b(k,56) + b(k,89) = b(k,89) - lu(k,174) * b(k,56) + b(k,95) = b(k,95) - lu(k,175) * b(k,56) + b(k,96) = b(k,96) - lu(k,176) * b(k,56) + b(k,100) = b(k,100) - lu(k,177) * b(k,56) + b(k,58) = b(k,58) - lu(k,179) * b(k,57) + b(k,63) = b(k,63) - lu(k,180) * b(k,57) + b(k,69) = b(k,69) - lu(k,181) * b(k,57) + b(k,78) = b(k,78) - lu(k,182) * b(k,57) + b(k,90) = b(k,90) - lu(k,183) * b(k,57) + b(k,91) = b(k,91) - lu(k,184) * b(k,57) + b(k,63) = b(k,63) - lu(k,186) * b(k,58) + b(k,77) = b(k,77) - lu(k,187) * b(k,58) + b(k,78) = b(k,78) - lu(k,188) * b(k,58) + b(k,85) = b(k,85) - lu(k,189) * b(k,58) + b(k,90) = b(k,90) - lu(k,190) * b(k,58) + b(k,70) = b(k,70) - lu(k,194) * b(k,59) + b(k,77) = b(k,77) - lu(k,195) * b(k,59) + b(k,78) = b(k,78) - lu(k,196) * b(k,59) + b(k,85) = b(k,85) - lu(k,197) * b(k,59) + b(k,90) = b(k,90) - lu(k,198) * b(k,59) + b(k,66) = b(k,66) - lu(k,200) * b(k,60) + b(k,89) = b(k,89) - lu(k,201) * b(k,60) + b(k,90) = b(k,90) - lu(k,202) * b(k,60) + b(k,93) = b(k,93) - lu(k,203) * b(k,60) + b(k,94) = b(k,94) - lu(k,204) * b(k,60) + b(k,95) = b(k,95) - lu(k,205) * b(k,60) + b(k,97) = b(k,97) - lu(k,206) * b(k,60) + b(k,80) = b(k,80) - lu(k,208) * b(k,61) + b(k,83) = b(k,83) - lu(k,209) * b(k,61) + b(k,87) = b(k,87) - lu(k,210) * b(k,61) + b(k,92) = b(k,92) - lu(k,211) * b(k,61) + b(k,94) = b(k,94) - lu(k,212) * b(k,61) + b(k,96) = b(k,96) - lu(k,213) * b(k,61) + b(k,98) = b(k,98) - lu(k,214) * b(k,61) + b(k,100) = b(k,100) - lu(k,215) * b(k,61) + b(k,83) = b(k,83) - lu(k,217) * b(k,62) + b(k,87) = b(k,87) - lu(k,218) * b(k,62) + b(k,90) = b(k,90) - lu(k,219) * b(k,62) + b(k,96) = b(k,96) - lu(k,220) * b(k,62) + b(k,98) = b(k,98) - lu(k,221) * b(k,62) + b(k,100) = b(k,100) - lu(k,222) * b(k,62) + b(k,65) = b(k,65) - lu(k,224) * b(k,63) + b(k,74) = b(k,74) - lu(k,225) * b(k,63) + b(k,75) = b(k,75) - lu(k,226) * b(k,63) + b(k,76) = b(k,76) - lu(k,227) * b(k,63) + b(k,77) = b(k,77) - lu(k,228) * b(k,63) + b(k,78) = b(k,78) - lu(k,229) * b(k,63) + b(k,85) = b(k,85) - lu(k,230) * b(k,63) + b(k,90) = b(k,90) - lu(k,231) * b(k,63) + b(k,81) = b(k,81) - lu(k,233) * b(k,64) + b(k,82) = b(k,82) - lu(k,234) * b(k,64) + b(k,85) = b(k,85) - lu(k,235) * b(k,64) + b(k,86) = b(k,86) - lu(k,236) * b(k,64) + b(k,90) = b(k,90) - lu(k,237) * b(k,64) + b(k,96) = b(k,96) - lu(k,238) * b(k,64) + b(k,74) = b(k,74) - lu(k,240) * b(k,65) + b(k,75) = b(k,75) - lu(k,241) * b(k,65) + b(k,76) = b(k,76) - lu(k,242) * b(k,65) + b(k,90) = b(k,90) - lu(k,243) * b(k,65) + b(k,83) = b(k,83) - lu(k,246) * b(k,66) + b(k,90) = b(k,90) - lu(k,247) * b(k,66) + b(k,93) = b(k,93) - lu(k,248) * b(k,66) + b(k,94) = b(k,94) - lu(k,249) * b(k,66) + b(k,96) = b(k,96) - lu(k,250) * b(k,66) + b(k,98) = b(k,98) - lu(k,251) * b(k,66) + b(k,100) = b(k,100) - lu(k,252) * b(k,66) + b(k,82) = b(k,82) - lu(k,254) * b(k,67) + b(k,90) = b(k,90) - lu(k,255) * b(k,67) + b(k,92) = b(k,92) - lu(k,256) * b(k,67) + b(k,93) = b(k,93) - lu(k,257) * b(k,67) + b(k,94) = b(k,94) - lu(k,258) * b(k,67) + b(k,96) = b(k,96) - lu(k,259) * b(k,67) + b(k,100) = b(k,100) - lu(k,260) * b(k,67) + b(k,83) = b(k,83) - lu(k,263) * b(k,68) + b(k,88) = b(k,88) - lu(k,264) * b(k,68) + b(k,90) = b(k,90) - lu(k,265) * b(k,68) + b(k,96) = b(k,96) - lu(k,266) * b(k,68) + b(k,98) = b(k,98) - lu(k,267) * b(k,68) + b(k,100) = b(k,100) - lu(k,268) * b(k,68) + b(k,74) = b(k,74) - lu(k,271) * b(k,69) + b(k,75) = b(k,75) - lu(k,272) * b(k,69) + b(k,76) = b(k,76) - lu(k,273) * b(k,69) + b(k,77) = b(k,77) - lu(k,274) * b(k,69) + b(k,78) = b(k,78) - lu(k,275) * b(k,69) + b(k,85) = b(k,85) - lu(k,276) * b(k,69) + b(k,90) = b(k,90) - lu(k,277) * b(k,69) + b(k,77) = b(k,77) - lu(k,280) * b(k,70) + b(k,78) = b(k,78) - lu(k,281) * b(k,70) + b(k,85) = b(k,85) - lu(k,282) * b(k,70) + b(k,87) = b(k,87) - lu(k,283) * b(k,70) + b(k,90) = b(k,90) - lu(k,284) * b(k,70) + b(k,96) = b(k,96) - lu(k,285) * b(k,70) end do end subroutine lu_slv01 subroutine lu_slv02( avec_len, lu, b ) @@ -246,155 +247,207 @@ subroutine lu_slv02( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,64) = b(k,64) - lu(k,300) * b(k,59) - b(k,67) = b(k,67) - lu(k,301) * b(k,59) - b(k,70) = b(k,70) - lu(k,302) * b(k,59) - b(k,72) = b(k,72) - lu(k,303) * b(k,59) - b(k,73) = b(k,73) - lu(k,304) * b(k,59) - b(k,74) = b(k,74) - lu(k,305) * b(k,59) - b(k,77) = b(k,77) - lu(k,306) * b(k,59) - b(k,64) = b(k,64) - lu(k,311) * b(k,60) - b(k,67) = b(k,67) - lu(k,312) * b(k,60) - b(k,68) = b(k,68) - lu(k,313) * b(k,60) - b(k,69) = b(k,69) - lu(k,314) * b(k,60) - b(k,70) = b(k,70) - lu(k,315) * b(k,60) - b(k,71) = b(k,71) - lu(k,316) * b(k,60) - b(k,72) = b(k,72) - lu(k,317) * b(k,60) - b(k,73) = b(k,73) - lu(k,318) * b(k,60) - b(k,74) = b(k,74) - lu(k,319) * b(k,60) - b(k,77) = b(k,77) - lu(k,320) * b(k,60) - b(k,62) = b(k,62) - lu(k,330) * b(k,61) - b(k,63) = b(k,63) - lu(k,331) * b(k,61) - b(k,64) = b(k,64) - lu(k,332) * b(k,61) - b(k,65) = b(k,65) - lu(k,333) * b(k,61) - b(k,66) = b(k,66) - lu(k,334) * b(k,61) - b(k,67) = b(k,67) - lu(k,335) * b(k,61) - b(k,68) = b(k,68) - lu(k,336) * b(k,61) - b(k,69) = b(k,69) - lu(k,337) * b(k,61) - b(k,70) = b(k,70) - lu(k,338) * b(k,61) - b(k,71) = b(k,71) - lu(k,339) * b(k,61) - b(k,72) = b(k,72) - lu(k,340) * b(k,61) - b(k,73) = b(k,73) - lu(k,341) * b(k,61) - b(k,74) = b(k,74) - lu(k,342) * b(k,61) - b(k,75) = b(k,75) - lu(k,343) * b(k,61) - b(k,77) = b(k,77) - lu(k,344) * b(k,61) - b(k,64) = b(k,64) - lu(k,348) * b(k,62) - b(k,65) = b(k,65) - lu(k,349) * b(k,62) - b(k,66) = b(k,66) - lu(k,350) * b(k,62) - b(k,67) = b(k,67) - lu(k,351) * b(k,62) - b(k,68) = b(k,68) - lu(k,352) * b(k,62) - b(k,70) = b(k,70) - lu(k,353) * b(k,62) - b(k,72) = b(k,72) - lu(k,354) * b(k,62) - b(k,73) = b(k,73) - lu(k,355) * b(k,62) - b(k,74) = b(k,74) - lu(k,356) * b(k,62) - b(k,75) = b(k,75) - lu(k,357) * b(k,62) - b(k,76) = b(k,76) - lu(k,358) * b(k,62) - b(k,77) = b(k,77) - lu(k,359) * b(k,62) - b(k,64) = b(k,64) - lu(k,370) * b(k,63) - b(k,65) = b(k,65) - lu(k,371) * b(k,63) - b(k,66) = b(k,66) - lu(k,372) * b(k,63) - b(k,67) = b(k,67) - lu(k,373) * b(k,63) - b(k,68) = b(k,68) - lu(k,374) * b(k,63) - b(k,69) = b(k,69) - lu(k,375) * b(k,63) - b(k,70) = b(k,70) - lu(k,376) * b(k,63) - b(k,71) = b(k,71) - lu(k,377) * b(k,63) - b(k,72) = b(k,72) - lu(k,378) * b(k,63) - b(k,73) = b(k,73) - lu(k,379) * b(k,63) - b(k,74) = b(k,74) - lu(k,380) * b(k,63) - b(k,75) = b(k,75) - lu(k,381) * b(k,63) - b(k,76) = b(k,76) - lu(k,382) * b(k,63) - b(k,77) = b(k,77) - lu(k,383) * b(k,63) - b(k,65) = b(k,65) - lu(k,396) * b(k,64) - b(k,66) = b(k,66) - lu(k,397) * b(k,64) - b(k,67) = b(k,67) - lu(k,398) * b(k,64) - b(k,68) = b(k,68) - lu(k,399) * b(k,64) - b(k,69) = b(k,69) - lu(k,400) * b(k,64) - b(k,70) = b(k,70) - lu(k,401) * b(k,64) - b(k,71) = b(k,71) - lu(k,402) * b(k,64) - b(k,72) = b(k,72) - lu(k,403) * b(k,64) - b(k,73) = b(k,73) - lu(k,404) * b(k,64) - b(k,74) = b(k,74) - lu(k,405) * b(k,64) - b(k,75) = b(k,75) - lu(k,406) * b(k,64) - b(k,76) = b(k,76) - lu(k,407) * b(k,64) - b(k,77) = b(k,77) - lu(k,408) * b(k,64) - b(k,66) = b(k,66) - lu(k,422) * b(k,65) - b(k,67) = b(k,67) - lu(k,423) * b(k,65) - b(k,68) = b(k,68) - lu(k,424) * b(k,65) - b(k,69) = b(k,69) - lu(k,425) * b(k,65) - b(k,70) = b(k,70) - lu(k,426) * b(k,65) - b(k,71) = b(k,71) - lu(k,427) * b(k,65) - b(k,72) = b(k,72) - lu(k,428) * b(k,65) - b(k,73) = b(k,73) - lu(k,429) * b(k,65) - b(k,74) = b(k,74) - lu(k,430) * b(k,65) - b(k,75) = b(k,75) - lu(k,431) * b(k,65) - b(k,76) = b(k,76) - lu(k,432) * b(k,65) - b(k,77) = b(k,77) - lu(k,433) * b(k,65) - b(k,67) = b(k,67) - lu(k,451) * b(k,66) - b(k,68) = b(k,68) - lu(k,452) * b(k,66) - b(k,69) = b(k,69) - lu(k,453) * b(k,66) - b(k,70) = b(k,70) - lu(k,454) * b(k,66) - b(k,71) = b(k,71) - lu(k,455) * b(k,66) - b(k,72) = b(k,72) - lu(k,456) * b(k,66) - b(k,73) = b(k,73) - lu(k,457) * b(k,66) - b(k,74) = b(k,74) - lu(k,458) * b(k,66) - b(k,75) = b(k,75) - lu(k,459) * b(k,66) - b(k,76) = b(k,76) - lu(k,460) * b(k,66) - b(k,77) = b(k,77) - lu(k,461) * b(k,66) - b(k,68) = b(k,68) - lu(k,495) * b(k,67) - b(k,69) = b(k,69) - lu(k,496) * b(k,67) - b(k,70) = b(k,70) - lu(k,497) * b(k,67) - b(k,71) = b(k,71) - lu(k,498) * b(k,67) - b(k,72) = b(k,72) - lu(k,499) * b(k,67) - b(k,73) = b(k,73) - lu(k,500) * b(k,67) - b(k,74) = b(k,74) - lu(k,501) * b(k,67) - b(k,75) = b(k,75) - lu(k,502) * b(k,67) - b(k,76) = b(k,76) - lu(k,503) * b(k,67) - b(k,77) = b(k,77) - lu(k,504) * b(k,67) - b(k,69) = b(k,69) - lu(k,518) * b(k,68) - b(k,70) = b(k,70) - lu(k,519) * b(k,68) - b(k,71) = b(k,71) - lu(k,520) * b(k,68) - b(k,72) = b(k,72) - lu(k,521) * b(k,68) - b(k,73) = b(k,73) - lu(k,522) * b(k,68) - b(k,74) = b(k,74) - lu(k,523) * b(k,68) - b(k,75) = b(k,75) - lu(k,524) * b(k,68) - b(k,76) = b(k,76) - lu(k,525) * b(k,68) - b(k,77) = b(k,77) - lu(k,526) * b(k,68) - b(k,70) = b(k,70) - lu(k,544) * b(k,69) - b(k,71) = b(k,71) - lu(k,545) * b(k,69) - b(k,72) = b(k,72) - lu(k,546) * b(k,69) - b(k,73) = b(k,73) - lu(k,547) * b(k,69) - b(k,74) = b(k,74) - lu(k,548) * b(k,69) - b(k,75) = b(k,75) - lu(k,549) * b(k,69) - b(k,76) = b(k,76) - lu(k,550) * b(k,69) - b(k,77) = b(k,77) - lu(k,551) * b(k,69) - b(k,71) = b(k,71) - lu(k,566) * b(k,70) - b(k,72) = b(k,72) - lu(k,567) * b(k,70) - b(k,73) = b(k,73) - lu(k,568) * b(k,70) - b(k,74) = b(k,74) - lu(k,569) * b(k,70) - b(k,75) = b(k,75) - lu(k,570) * b(k,70) - b(k,76) = b(k,76) - lu(k,571) * b(k,70) - b(k,77) = b(k,77) - lu(k,572) * b(k,70) - b(k,72) = b(k,72) - lu(k,593) * b(k,71) - b(k,73) = b(k,73) - lu(k,594) * b(k,71) - b(k,74) = b(k,74) - lu(k,595) * b(k,71) - b(k,75) = b(k,75) - lu(k,596) * b(k,71) - b(k,76) = b(k,76) - lu(k,597) * b(k,71) - b(k,77) = b(k,77) - lu(k,598) * b(k,71) - b(k,73) = b(k,73) - lu(k,625) * b(k,72) - b(k,74) = b(k,74) - lu(k,626) * b(k,72) - b(k,75) = b(k,75) - lu(k,627) * b(k,72) - b(k,76) = b(k,76) - lu(k,628) * b(k,72) - b(k,77) = b(k,77) - lu(k,629) * b(k,72) - b(k,74) = b(k,74) - lu(k,663) * b(k,73) - b(k,75) = b(k,75) - lu(k,664) * b(k,73) - b(k,76) = b(k,76) - lu(k,665) * b(k,73) - b(k,77) = b(k,77) - lu(k,666) * b(k,73) - b(k,75) = b(k,75) - lu(k,686) * b(k,74) - b(k,76) = b(k,76) - lu(k,687) * b(k,74) - b(k,77) = b(k,77) - lu(k,688) * b(k,74) - b(k,76) = b(k,76) - lu(k,715) * b(k,75) - b(k,77) = b(k,77) - lu(k,716) * b(k,75) - b(k,77) = b(k,77) - lu(k,739) * b(k,76) + b(k,79) = b(k,79) - lu(k,288) * b(k,71) + b(k,80) = b(k,80) - lu(k,289) * b(k,71) + b(k,82) = b(k,82) - lu(k,290) * b(k,71) + b(k,89) = b(k,89) - lu(k,291) * b(k,71) + b(k,96) = b(k,96) - lu(k,292) * b(k,71) + b(k,97) = b(k,97) - lu(k,293) * b(k,71) + b(k,99) = b(k,99) - lu(k,294) * b(k,71) + b(k,100) = b(k,100) - lu(k,295) * b(k,71) + b(k,81) = b(k,81) - lu(k,298) * b(k,72) + b(k,87) = b(k,87) - lu(k,299) * b(k,72) + b(k,90) = b(k,90) - lu(k,300) * b(k,72) + b(k,96) = b(k,96) - lu(k,301) * b(k,72) + b(k,100) = b(k,100) - lu(k,302) * b(k,72) + b(k,83) = b(k,83) - lu(k,306) * b(k,73) + b(k,88) = b(k,88) - lu(k,307) * b(k,73) + b(k,89) = b(k,89) - lu(k,308) * b(k,73) + b(k,90) = b(k,90) - lu(k,309) * b(k,73) + b(k,95) = b(k,95) - lu(k,310) * b(k,73) + b(k,96) = b(k,96) - lu(k,311) * b(k,73) + b(k,97) = b(k,97) - lu(k,312) * b(k,73) + b(k,98) = b(k,98) - lu(k,313) * b(k,73) + b(k,100) = b(k,100) - lu(k,314) * b(k,73) + b(k,75) = b(k,75) - lu(k,321) * b(k,74) + b(k,76) = b(k,76) - lu(k,322) * b(k,74) + b(k,77) = b(k,77) - lu(k,323) * b(k,74) + b(k,78) = b(k,78) - lu(k,324) * b(k,74) + b(k,85) = b(k,85) - lu(k,325) * b(k,74) + b(k,90) = b(k,90) - lu(k,326) * b(k,74) + b(k,91) = b(k,91) - lu(k,327) * b(k,74) + b(k,92) = b(k,92) - lu(k,328) * b(k,74) + b(k,76) = b(k,76) - lu(k,332) * b(k,75) + b(k,77) = b(k,77) - lu(k,333) * b(k,75) + b(k,78) = b(k,78) - lu(k,334) * b(k,75) + b(k,85) = b(k,85) - lu(k,335) * b(k,75) + b(k,90) = b(k,90) - lu(k,336) * b(k,75) + b(k,91) = b(k,91) - lu(k,337) * b(k,75) + b(k,92) = b(k,92) - lu(k,338) * b(k,75) + b(k,77) = b(k,77) - lu(k,345) * b(k,76) + b(k,78) = b(k,78) - lu(k,346) * b(k,76) + b(k,82) = b(k,82) - lu(k,347) * b(k,76) + b(k,85) = b(k,85) - lu(k,348) * b(k,76) + b(k,90) = b(k,90) - lu(k,349) * b(k,76) + b(k,91) = b(k,91) - lu(k,350) * b(k,76) + b(k,92) = b(k,92) - lu(k,351) * b(k,76) + b(k,95) = b(k,95) - lu(k,352) * b(k,76) + b(k,96) = b(k,96) - lu(k,353) * b(k,76) + b(k,78) = b(k,78) - lu(k,359) * b(k,77) + b(k,82) = b(k,82) - lu(k,360) * b(k,77) + b(k,85) = b(k,85) - lu(k,361) * b(k,77) + b(k,90) = b(k,90) - lu(k,362) * b(k,77) + b(k,91) = b(k,91) - lu(k,363) * b(k,77) + b(k,92) = b(k,92) - lu(k,364) * b(k,77) + b(k,95) = b(k,95) - lu(k,365) * b(k,77) + b(k,96) = b(k,96) - lu(k,366) * b(k,77) + b(k,82) = b(k,82) - lu(k,376) * b(k,78) + b(k,85) = b(k,85) - lu(k,377) * b(k,78) + b(k,87) = b(k,87) - lu(k,378) * b(k,78) + b(k,90) = b(k,90) - lu(k,379) * b(k,78) + b(k,91) = b(k,91) - lu(k,380) * b(k,78) + b(k,92) = b(k,92) - lu(k,381) * b(k,78) + b(k,95) = b(k,95) - lu(k,382) * b(k,78) + b(k,96) = b(k,96) - lu(k,383) * b(k,78) + b(k,80) = b(k,80) - lu(k,391) * b(k,79) + b(k,82) = b(k,82) - lu(k,392) * b(k,79) + b(k,83) = b(k,83) - lu(k,393) * b(k,79) + b(k,84) = b(k,84) - lu(k,394) * b(k,79) + b(k,85) = b(k,85) - lu(k,395) * b(k,79) + b(k,87) = b(k,87) - lu(k,396) * b(k,79) + b(k,89) = b(k,89) - lu(k,397) * b(k,79) + b(k,90) = b(k,90) - lu(k,398) * b(k,79) + b(k,91) = b(k,91) - lu(k,399) * b(k,79) + b(k,92) = b(k,92) - lu(k,400) * b(k,79) + b(k,95) = b(k,95) - lu(k,401) * b(k,79) + b(k,96) = b(k,96) - lu(k,402) * b(k,79) + b(k,97) = b(k,97) - lu(k,403) * b(k,79) + b(k,98) = b(k,98) - lu(k,404) * b(k,79) + b(k,99) = b(k,99) - lu(k,405) * b(k,79) + b(k,100) = b(k,100) - lu(k,406) * b(k,79) + b(k,82) = b(k,82) - lu(k,409) * b(k,80) + b(k,84) = b(k,84) - lu(k,410) * b(k,80) + b(k,85) = b(k,85) - lu(k,411) * b(k,80) + b(k,87) = b(k,87) - lu(k,412) * b(k,80) + b(k,88) = b(k,88) - lu(k,413) * b(k,80) + b(k,91) = b(k,91) - lu(k,414) * b(k,80) + b(k,95) = b(k,95) - lu(k,415) * b(k,80) + b(k,96) = b(k,96) - lu(k,416) * b(k,80) + b(k,98) = b(k,98) - lu(k,417) * b(k,80) + b(k,100) = b(k,100) - lu(k,418) * b(k,80) + b(k,82) = b(k,82) - lu(k,423) * b(k,81) + b(k,85) = b(k,85) - lu(k,424) * b(k,81) + b(k,86) = b(k,86) - lu(k,425) * b(k,81) + b(k,87) = b(k,87) - lu(k,426) * b(k,81) + b(k,88) = b(k,88) - lu(k,427) * b(k,81) + b(k,90) = b(k,90) - lu(k,428) * b(k,81) + b(k,91) = b(k,91) - lu(k,429) * b(k,81) + b(k,93) = b(k,93) - lu(k,430) * b(k,81) + b(k,94) = b(k,94) - lu(k,431) * b(k,81) + b(k,95) = b(k,95) - lu(k,432) * b(k,81) + b(k,96) = b(k,96) - lu(k,433) * b(k,81) + b(k,98) = b(k,98) - lu(k,434) * b(k,81) + b(k,100) = b(k,100) - lu(k,435) * b(k,81) + b(k,85) = b(k,85) - lu(k,437) * b(k,82) + b(k,86) = b(k,86) - lu(k,438) * b(k,82) + b(k,87) = b(k,87) - lu(k,439) * b(k,82) + b(k,90) = b(k,90) - lu(k,440) * b(k,82) + b(k,96) = b(k,96) - lu(k,441) * b(k,82) + b(k,99) = b(k,99) - lu(k,442) * b(k,82) + b(k,100) = b(k,100) - lu(k,443) * b(k,82) + b(k,85) = b(k,85) - lu(k,451) * b(k,83) + b(k,86) = b(k,86) - lu(k,452) * b(k,83) + b(k,87) = b(k,87) - lu(k,453) * b(k,83) + b(k,88) = b(k,88) - lu(k,454) * b(k,83) + b(k,89) = b(k,89) - lu(k,455) * b(k,83) + b(k,90) = b(k,90) - lu(k,456) * b(k,83) + b(k,92) = b(k,92) - lu(k,457) * b(k,83) + b(k,93) = b(k,93) - lu(k,458) * b(k,83) + b(k,94) = b(k,94) - lu(k,459) * b(k,83) + b(k,95) = b(k,95) - lu(k,460) * b(k,83) + b(k,96) = b(k,96) - lu(k,461) * b(k,83) + b(k,97) = b(k,97) - lu(k,462) * b(k,83) + b(k,98) = b(k,98) - lu(k,463) * b(k,83) + b(k,99) = b(k,99) - lu(k,464) * b(k,83) + b(k,100) = b(k,100) - lu(k,465) * b(k,83) + b(k,85) = b(k,85) - lu(k,473) * b(k,84) + b(k,86) = b(k,86) - lu(k,474) * b(k,84) + b(k,87) = b(k,87) - lu(k,475) * b(k,84) + b(k,88) = b(k,88) - lu(k,476) * b(k,84) + b(k,89) = b(k,89) - lu(k,477) * b(k,84) + b(k,90) = b(k,90) - lu(k,478) * b(k,84) + b(k,91) = b(k,91) - lu(k,479) * b(k,84) + b(k,92) = b(k,92) - lu(k,480) * b(k,84) + b(k,93) = b(k,93) - lu(k,481) * b(k,84) + b(k,94) = b(k,94) - lu(k,482) * b(k,84) + b(k,95) = b(k,95) - lu(k,483) * b(k,84) + b(k,96) = b(k,96) - lu(k,484) * b(k,84) + b(k,97) = b(k,97) - lu(k,485) * b(k,84) + b(k,98) = b(k,98) - lu(k,486) * b(k,84) + b(k,99) = b(k,99) - lu(k,487) * b(k,84) + b(k,100) = b(k,100) - lu(k,488) * b(k,84) + b(k,86) = b(k,86) - lu(k,506) * b(k,85) + b(k,87) = b(k,87) - lu(k,507) * b(k,85) + b(k,88) = b(k,88) - lu(k,508) * b(k,85) + b(k,90) = b(k,90) - lu(k,509) * b(k,85) + b(k,91) = b(k,91) - lu(k,510) * b(k,85) + b(k,92) = b(k,92) - lu(k,511) * b(k,85) + b(k,93) = b(k,93) - lu(k,512) * b(k,85) + b(k,94) = b(k,94) - lu(k,513) * b(k,85) + b(k,95) = b(k,95) - lu(k,514) * b(k,85) + b(k,96) = b(k,96) - lu(k,515) * b(k,85) + b(k,98) = b(k,98) - lu(k,516) * b(k,85) + b(k,99) = b(k,99) - lu(k,517) * b(k,85) + b(k,100) = b(k,100) - lu(k,518) * b(k,85) + b(k,87) = b(k,87) - lu(k,527) * b(k,86) + b(k,88) = b(k,88) - lu(k,528) * b(k,86) + b(k,89) = b(k,89) - lu(k,529) * b(k,86) + b(k,90) = b(k,90) - lu(k,530) * b(k,86) + b(k,91) = b(k,91) - lu(k,531) * b(k,86) + b(k,92) = b(k,92) - lu(k,532) * b(k,86) + b(k,93) = b(k,93) - lu(k,533) * b(k,86) + b(k,94) = b(k,94) - lu(k,534) * b(k,86) + b(k,95) = b(k,95) - lu(k,535) * b(k,86) + b(k,96) = b(k,96) - lu(k,536) * b(k,86) + b(k,98) = b(k,98) - lu(k,537) * b(k,86) + b(k,99) = b(k,99) - lu(k,538) * b(k,86) + b(k,100) = b(k,100) - lu(k,539) * b(k,86) + b(k,88) = b(k,88) - lu(k,553) * b(k,87) + b(k,89) = b(k,89) - lu(k,554) * b(k,87) + b(k,90) = b(k,90) - lu(k,555) * b(k,87) + b(k,91) = b(k,91) - lu(k,556) * b(k,87) + b(k,92) = b(k,92) - lu(k,557) * b(k,87) + b(k,93) = b(k,93) - lu(k,558) * b(k,87) + b(k,94) = b(k,94) - lu(k,559) * b(k,87) + b(k,95) = b(k,95) - lu(k,560) * b(k,87) + b(k,96) = b(k,96) - lu(k,561) * b(k,87) + b(k,97) = b(k,97) - lu(k,562) * b(k,87) + b(k,98) = b(k,98) - lu(k,563) * b(k,87) + b(k,99) = b(k,99) - lu(k,564) * b(k,87) + b(k,100) = b(k,100) - lu(k,565) * b(k,87) + b(k,89) = b(k,89) - lu(k,582) * b(k,88) + b(k,90) = b(k,90) - lu(k,583) * b(k,88) + b(k,91) = b(k,91) - lu(k,584) * b(k,88) + b(k,92) = b(k,92) - lu(k,585) * b(k,88) + b(k,93) = b(k,93) - lu(k,586) * b(k,88) + b(k,94) = b(k,94) - lu(k,587) * b(k,88) + b(k,95) = b(k,95) - lu(k,588) * b(k,88) + b(k,96) = b(k,96) - lu(k,589) * b(k,88) + b(k,97) = b(k,97) - lu(k,590) * b(k,88) + b(k,98) = b(k,98) - lu(k,591) * b(k,88) + b(k,99) = b(k,99) - lu(k,592) * b(k,88) + b(k,100) = b(k,100) - lu(k,593) * b(k,88) + b(k,90) = b(k,90) - lu(k,608) * b(k,89) + b(k,91) = b(k,91) - lu(k,609) * b(k,89) + b(k,92) = b(k,92) - lu(k,610) * b(k,89) + b(k,93) = b(k,93) - lu(k,611) * b(k,89) + b(k,94) = b(k,94) - lu(k,612) * b(k,89) + b(k,95) = b(k,95) - lu(k,613) * b(k,89) + b(k,96) = b(k,96) - lu(k,614) * b(k,89) + b(k,97) = b(k,97) - lu(k,615) * b(k,89) + b(k,98) = b(k,98) - lu(k,616) * b(k,89) + b(k,99) = b(k,99) - lu(k,617) * b(k,89) + b(k,100) = b(k,100) - lu(k,618) * b(k,89) end do end subroutine lu_slv02 subroutine lu_slv03( avec_len, lu, b ) @@ -415,211 +468,61 @@ subroutine lu_slv03( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len -!----------------------------------------------------------------------- -! ... Solve U * x = y -!----------------------------------------------------------------------- - b(k,77) = b(k,77) * lu(k,764) - b(k,76) = b(k,76) - lu(k,763) * b(k,77) - b(k,75) = b(k,75) - lu(k,762) * b(k,77) - b(k,74) = b(k,74) - lu(k,761) * b(k,77) - b(k,73) = b(k,73) - lu(k,760) * b(k,77) - b(k,72) = b(k,72) - lu(k,759) * b(k,77) - b(k,71) = b(k,71) - lu(k,758) * b(k,77) - b(k,70) = b(k,70) - lu(k,757) * b(k,77) - b(k,69) = b(k,69) - lu(k,756) * b(k,77) - b(k,68) = b(k,68) - lu(k,755) * b(k,77) - b(k,67) = b(k,67) - lu(k,754) * b(k,77) - b(k,66) = b(k,66) - lu(k,753) * b(k,77) - b(k,65) = b(k,65) - lu(k,752) * b(k,77) - b(k,64) = b(k,64) - lu(k,751) * b(k,77) - b(k,63) = b(k,63) - lu(k,750) * b(k,77) - b(k,62) = b(k,62) - lu(k,749) * b(k,77) - b(k,60) = b(k,60) - lu(k,748) * b(k,77) - b(k,59) = b(k,59) - lu(k,747) * b(k,77) - b(k,58) = b(k,58) - lu(k,746) * b(k,77) - b(k,57) = b(k,57) - lu(k,745) * b(k,77) - b(k,55) = b(k,55) - lu(k,744) * b(k,77) - b(k,46) = b(k,46) - lu(k,743) * b(k,77) - b(k,30) = b(k,30) - lu(k,742) * b(k,77) - b(k,28) = b(k,28) - lu(k,741) * b(k,77) - b(k,22) = b(k,22) - lu(k,740) * b(k,77) - b(k,76) = b(k,76) * lu(k,738) - b(k,75) = b(k,75) - lu(k,737) * b(k,76) - b(k,74) = b(k,74) - lu(k,736) * b(k,76) - b(k,73) = b(k,73) - lu(k,735) * b(k,76) - b(k,72) = b(k,72) - lu(k,734) * b(k,76) - b(k,71) = b(k,71) - lu(k,733) * b(k,76) - b(k,70) = b(k,70) - lu(k,732) * b(k,76) - b(k,69) = b(k,69) - lu(k,731) * b(k,76) - b(k,68) = b(k,68) - lu(k,730) * b(k,76) - b(k,67) = b(k,67) - lu(k,729) * b(k,76) - b(k,66) = b(k,66) - lu(k,728) * b(k,76) - b(k,65) = b(k,65) - lu(k,727) * b(k,76) - b(k,64) = b(k,64) - lu(k,726) * b(k,76) - b(k,63) = b(k,63) - lu(k,725) * b(k,76) - b(k,62) = b(k,62) - lu(k,724) * b(k,76) - b(k,60) = b(k,60) - lu(k,723) * b(k,76) - b(k,59) = b(k,59) - lu(k,722) * b(k,76) - b(k,54) = b(k,54) - lu(k,721) * b(k,76) - b(k,53) = b(k,53) - lu(k,720) * b(k,76) - b(k,52) = b(k,52) - lu(k,719) * b(k,76) - b(k,51) = b(k,51) - lu(k,718) * b(k,76) - b(k,44) = b(k,44) - lu(k,717) * b(k,76) - b(k,75) = b(k,75) * lu(k,714) - b(k,74) = b(k,74) - lu(k,713) * b(k,75) - b(k,73) = b(k,73) - lu(k,712) * b(k,75) - b(k,72) = b(k,72) - lu(k,711) * b(k,75) - b(k,71) = b(k,71) - lu(k,710) * b(k,75) - b(k,70) = b(k,70) - lu(k,709) * b(k,75) - b(k,69) = b(k,69) - lu(k,708) * b(k,75) - b(k,68) = b(k,68) - lu(k,707) * b(k,75) - b(k,67) = b(k,67) - lu(k,706) * b(k,75) - b(k,66) = b(k,66) - lu(k,705) * b(k,75) - b(k,65) = b(k,65) - lu(k,704) * b(k,75) - b(k,64) = b(k,64) - lu(k,703) * b(k,75) - b(k,63) = b(k,63) - lu(k,702) * b(k,75) - b(k,62) = b(k,62) - lu(k,701) * b(k,75) - b(k,61) = b(k,61) - lu(k,700) * b(k,75) - b(k,60) = b(k,60) - lu(k,699) * b(k,75) - b(k,59) = b(k,59) - lu(k,698) * b(k,75) - b(k,58) = b(k,58) - lu(k,697) * b(k,75) - b(k,57) = b(k,57) - lu(k,696) * b(k,75) - b(k,56) = b(k,56) - lu(k,695) * b(k,75) - b(k,55) = b(k,55) - lu(k,694) * b(k,75) - b(k,54) = b(k,54) - lu(k,693) * b(k,75) - b(k,45) = b(k,45) - lu(k,692) * b(k,75) - b(k,40) = b(k,40) - lu(k,691) * b(k,75) - b(k,36) = b(k,36) - lu(k,690) * b(k,75) - b(k,31) = b(k,31) - lu(k,689) * b(k,75) - b(k,74) = b(k,74) * lu(k,685) - b(k,73) = b(k,73) - lu(k,684) * b(k,74) - b(k,72) = b(k,72) - lu(k,683) * b(k,74) - b(k,71) = b(k,71) - lu(k,682) * b(k,74) - b(k,70) = b(k,70) - lu(k,681) * b(k,74) - b(k,69) = b(k,69) - lu(k,680) * b(k,74) - b(k,68) = b(k,68) - lu(k,679) * b(k,74) - b(k,67) = b(k,67) - lu(k,678) * b(k,74) - b(k,66) = b(k,66) - lu(k,677) * b(k,74) - b(k,65) = b(k,65) - lu(k,676) * b(k,74) - b(k,64) = b(k,64) - lu(k,675) * b(k,74) - b(k,63) = b(k,63) - lu(k,674) * b(k,74) - b(k,60) = b(k,60) - lu(k,673) * b(k,74) - b(k,59) = b(k,59) - lu(k,672) * b(k,74) - b(k,58) = b(k,58) - lu(k,671) * b(k,74) - b(k,55) = b(k,55) - lu(k,670) * b(k,74) - b(k,43) = b(k,43) - lu(k,669) * b(k,74) - b(k,25) = b(k,25) - lu(k,668) * b(k,74) - b(k,24) = b(k,24) - lu(k,667) * b(k,74) - b(k,73) = b(k,73) * lu(k,662) - b(k,72) = b(k,72) - lu(k,661) * b(k,73) - b(k,71) = b(k,71) - lu(k,660) * b(k,73) - b(k,70) = b(k,70) - lu(k,659) * b(k,73) - b(k,69) = b(k,69) - lu(k,658) * b(k,73) - b(k,68) = b(k,68) - lu(k,657) * b(k,73) - b(k,67) = b(k,67) - lu(k,656) * b(k,73) - b(k,66) = b(k,66) - lu(k,655) * b(k,73) - b(k,65) = b(k,65) - lu(k,654) * b(k,73) - b(k,64) = b(k,64) - lu(k,653) * b(k,73) - b(k,63) = b(k,63) - lu(k,652) * b(k,73) - b(k,62) = b(k,62) - lu(k,651) * b(k,73) - b(k,61) = b(k,61) - lu(k,650) * b(k,73) - b(k,60) = b(k,60) - lu(k,649) * b(k,73) - b(k,59) = b(k,59) - lu(k,648) * b(k,73) - b(k,58) = b(k,58) - lu(k,647) * b(k,73) - b(k,57) = b(k,57) - lu(k,646) * b(k,73) - b(k,56) = b(k,56) - lu(k,645) * b(k,73) - b(k,55) = b(k,55) - lu(k,644) * b(k,73) - b(k,54) = b(k,54) - lu(k,643) * b(k,73) - b(k,49) = b(k,49) - lu(k,642) * b(k,73) - b(k,47) = b(k,47) - lu(k,641) * b(k,73) - b(k,46) = b(k,46) - lu(k,640) * b(k,73) - b(k,43) = b(k,43) - lu(k,639) * b(k,73) - b(k,41) = b(k,41) - lu(k,638) * b(k,73) - b(k,39) = b(k,39) - lu(k,637) * b(k,73) - b(k,36) = b(k,36) - lu(k,636) * b(k,73) - b(k,35) = b(k,35) - lu(k,635) * b(k,73) - b(k,34) = b(k,34) - lu(k,634) * b(k,73) - b(k,32) = b(k,32) - lu(k,633) * b(k,73) - b(k,30) = b(k,30) - lu(k,632) * b(k,73) - b(k,27) = b(k,27) - lu(k,631) * b(k,73) - b(k,23) = b(k,23) - lu(k,630) * b(k,73) - b(k,72) = b(k,72) * lu(k,624) - b(k,71) = b(k,71) - lu(k,623) * b(k,72) - b(k,70) = b(k,70) - lu(k,622) * b(k,72) - b(k,69) = b(k,69) - lu(k,621) * b(k,72) - b(k,68) = b(k,68) - lu(k,620) * b(k,72) - b(k,67) = b(k,67) - lu(k,619) * b(k,72) - b(k,66) = b(k,66) - lu(k,618) * b(k,72) - b(k,65) = b(k,65) - lu(k,617) * b(k,72) - b(k,64) = b(k,64) - lu(k,616) * b(k,72) - b(k,60) = b(k,60) - lu(k,615) * b(k,72) - b(k,59) = b(k,59) - lu(k,614) * b(k,72) - b(k,58) = b(k,58) - lu(k,613) * b(k,72) - b(k,55) = b(k,55) - lu(k,612) * b(k,72) - b(k,54) = b(k,54) - lu(k,611) * b(k,72) - b(k,53) = b(k,53) - lu(k,610) * b(k,72) - b(k,52) = b(k,52) - lu(k,609) * b(k,72) - b(k,51) = b(k,51) - lu(k,608) * b(k,72) - b(k,50) = b(k,50) - lu(k,607) * b(k,72) - b(k,48) = b(k,48) - lu(k,606) * b(k,72) - b(k,44) = b(k,44) - lu(k,605) * b(k,72) - b(k,43) = b(k,43) - lu(k,604) * b(k,72) - b(k,42) = b(k,42) - lu(k,603) * b(k,72) - b(k,38) = b(k,38) - lu(k,602) * b(k,72) - b(k,37) = b(k,37) - lu(k,601) * b(k,72) - b(k,25) = b(k,25) - lu(k,600) * b(k,72) - b(k,24) = b(k,24) - lu(k,599) * b(k,72) - b(k,71) = b(k,71) * lu(k,592) - b(k,70) = b(k,70) - lu(k,591) * b(k,71) - b(k,69) = b(k,69) - lu(k,590) * b(k,71) - b(k,68) = b(k,68) - lu(k,589) * b(k,71) - b(k,67) = b(k,67) - lu(k,588) * b(k,71) - b(k,66) = b(k,66) - lu(k,587) * b(k,71) - b(k,65) = b(k,65) - lu(k,586) * b(k,71) - b(k,64) = b(k,64) - lu(k,585) * b(k,71) - b(k,63) = b(k,63) - lu(k,584) * b(k,71) - b(k,62) = b(k,62) - lu(k,583) * b(k,71) - b(k,61) = b(k,61) - lu(k,582) * b(k,71) - b(k,60) = b(k,60) - lu(k,581) * b(k,71) - b(k,59) = b(k,59) - lu(k,580) * b(k,71) - b(k,58) = b(k,58) - lu(k,579) * b(k,71) - b(k,57) = b(k,57) - lu(k,578) * b(k,71) - b(k,55) = b(k,55) - lu(k,577) * b(k,71) - b(k,45) = b(k,45) - lu(k,576) * b(k,71) - b(k,40) = b(k,40) - lu(k,575) * b(k,71) - b(k,33) = b(k,33) - lu(k,574) * b(k,71) - b(k,29) = b(k,29) - lu(k,573) * b(k,71) - b(k,70) = b(k,70) * lu(k,565) - b(k,69) = b(k,69) - lu(k,564) * b(k,70) - b(k,68) = b(k,68) - lu(k,563) * b(k,70) - b(k,67) = b(k,67) - lu(k,562) * b(k,70) - b(k,66) = b(k,66) - lu(k,561) * b(k,70) - b(k,65) = b(k,65) - lu(k,560) * b(k,70) - b(k,64) = b(k,64) - lu(k,559) * b(k,70) - b(k,63) = b(k,63) - lu(k,558) * b(k,70) - b(k,62) = b(k,62) - lu(k,557) * b(k,70) - b(k,61) = b(k,61) - lu(k,556) * b(k,70) - b(k,59) = b(k,59) - lu(k,555) * b(k,70) - b(k,57) = b(k,57) - lu(k,554) * b(k,70) - b(k,46) = b(k,46) - lu(k,553) * b(k,70) - b(k,28) = b(k,28) - lu(k,552) * b(k,70) - b(k,69) = b(k,69) * lu(k,543) - b(k,68) = b(k,68) - lu(k,542) * b(k,69) - b(k,67) = b(k,67) - lu(k,541) * b(k,69) - b(k,66) = b(k,66) - lu(k,540) * b(k,69) - b(k,65) = b(k,65) - lu(k,539) * b(k,69) - b(k,64) = b(k,64) - lu(k,538) * b(k,69) - b(k,63) = b(k,63) - lu(k,537) * b(k,69) - b(k,62) = b(k,62) - lu(k,536) * b(k,69) - b(k,61) = b(k,61) - lu(k,535) * b(k,69) - b(k,60) = b(k,60) - lu(k,534) * b(k,69) - b(k,59) = b(k,59) - lu(k,533) * b(k,69) - b(k,57) = b(k,57) - lu(k,532) * b(k,69) - b(k,49) = b(k,49) - lu(k,531) * b(k,69) - b(k,46) = b(k,46) - lu(k,530) * b(k,69) - b(k,27) = b(k,27) - lu(k,529) * b(k,69) - b(k,25) = b(k,25) - lu(k,528) * b(k,69) - b(k,23) = b(k,23) - lu(k,527) * b(k,69) + b(k,91) = b(k,91) - lu(k,651) * b(k,90) + b(k,92) = b(k,92) - lu(k,652) * b(k,90) + b(k,93) = b(k,93) - lu(k,653) * b(k,90) + b(k,94) = b(k,94) - lu(k,654) * b(k,90) + b(k,95) = b(k,95) - lu(k,655) * b(k,90) + b(k,96) = b(k,96) - lu(k,656) * b(k,90) + b(k,97) = b(k,97) - lu(k,657) * b(k,90) + b(k,98) = b(k,98) - lu(k,658) * b(k,90) + b(k,99) = b(k,99) - lu(k,659) * b(k,90) + b(k,100) = b(k,100) - lu(k,660) * b(k,90) + b(k,92) = b(k,92) - lu(k,677) * b(k,91) + b(k,93) = b(k,93) - lu(k,678) * b(k,91) + b(k,94) = b(k,94) - lu(k,679) * b(k,91) + b(k,95) = b(k,95) - lu(k,680) * b(k,91) + b(k,96) = b(k,96) - lu(k,681) * b(k,91) + b(k,97) = b(k,97) - lu(k,682) * b(k,91) + b(k,98) = b(k,98) - lu(k,683) * b(k,91) + b(k,99) = b(k,99) - lu(k,684) * b(k,91) + b(k,100) = b(k,100) - lu(k,685) * b(k,91) + b(k,93) = b(k,93) - lu(k,720) * b(k,92) + b(k,94) = b(k,94) - lu(k,721) * b(k,92) + b(k,95) = b(k,95) - lu(k,722) * b(k,92) + b(k,96) = b(k,96) - lu(k,723) * b(k,92) + b(k,97) = b(k,97) - lu(k,724) * b(k,92) + b(k,98) = b(k,98) - lu(k,725) * b(k,92) + b(k,99) = b(k,99) - lu(k,726) * b(k,92) + b(k,100) = b(k,100) - lu(k,727) * b(k,92) + b(k,94) = b(k,94) - lu(k,745) * b(k,93) + b(k,95) = b(k,95) - lu(k,746) * b(k,93) + b(k,96) = b(k,96) - lu(k,747) * b(k,93) + b(k,97) = b(k,97) - lu(k,748) * b(k,93) + b(k,98) = b(k,98) - lu(k,749) * b(k,93) + b(k,99) = b(k,99) - lu(k,750) * b(k,93) + b(k,100) = b(k,100) - lu(k,751) * b(k,93) + b(k,95) = b(k,95) - lu(k,768) * b(k,94) + b(k,96) = b(k,96) - lu(k,769) * b(k,94) + b(k,97) = b(k,97) - lu(k,770) * b(k,94) + b(k,98) = b(k,98) - lu(k,771) * b(k,94) + b(k,99) = b(k,99) - lu(k,772) * b(k,94) + b(k,100) = b(k,100) - lu(k,773) * b(k,94) + b(k,96) = b(k,96) - lu(k,798) * b(k,95) + b(k,97) = b(k,97) - lu(k,799) * b(k,95) + b(k,98) = b(k,98) - lu(k,800) * b(k,95) + b(k,99) = b(k,99) - lu(k,801) * b(k,95) + b(k,100) = b(k,100) - lu(k,802) * b(k,95) + b(k,97) = b(k,97) - lu(k,848) * b(k,96) + b(k,98) = b(k,98) - lu(k,849) * b(k,96) + b(k,99) = b(k,99) - lu(k,850) * b(k,96) + b(k,100) = b(k,100) - lu(k,851) * b(k,96) + b(k,98) = b(k,98) - lu(k,872) * b(k,97) + b(k,99) = b(k,99) - lu(k,873) * b(k,97) + b(k,100) = b(k,100) - lu(k,874) * b(k,97) + b(k,99) = b(k,99) - lu(k,905) * b(k,98) + b(k,100) = b(k,100) - lu(k,906) * b(k,98) + b(k,100) = b(k,100) - lu(k,929) * b(k,99) end do end subroutine lu_slv03 subroutine lu_slv04( avec_len, lu, b ) @@ -640,207 +543,210 @@ subroutine lu_slv04( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,68) = b(k,68) * lu(k,517) - b(k,67) = b(k,67) - lu(k,516) * b(k,68) - b(k,66) = b(k,66) - lu(k,515) * b(k,68) - b(k,65) = b(k,65) - lu(k,514) * b(k,68) - b(k,64) = b(k,64) - lu(k,513) * b(k,68) - b(k,63) = b(k,63) - lu(k,512) * b(k,68) - b(k,62) = b(k,62) - lu(k,511) * b(k,68) - b(k,61) = b(k,61) - lu(k,510) * b(k,68) - b(k,60) = b(k,60) - lu(k,509) * b(k,68) - b(k,59) = b(k,59) - lu(k,508) * b(k,68) - b(k,57) = b(k,57) - lu(k,507) * b(k,68) - b(k,49) = b(k,49) - lu(k,506) * b(k,68) - b(k,39) = b(k,39) - lu(k,505) * b(k,68) - b(k,67) = b(k,67) * lu(k,494) - b(k,66) = b(k,66) - lu(k,493) * b(k,67) - b(k,65) = b(k,65) - lu(k,492) * b(k,67) - b(k,64) = b(k,64) - lu(k,491) * b(k,67) - b(k,63) = b(k,63) - lu(k,490) * b(k,67) - b(k,62) = b(k,62) - lu(k,489) * b(k,67) - b(k,61) = b(k,61) - lu(k,488) * b(k,67) - b(k,60) = b(k,60) - lu(k,487) * b(k,67) - b(k,59) = b(k,59) - lu(k,486) * b(k,67) - b(k,58) = b(k,58) - lu(k,485) * b(k,67) - b(k,57) = b(k,57) - lu(k,484) * b(k,67) - b(k,56) = b(k,56) - lu(k,483) * b(k,67) - b(k,55) = b(k,55) - lu(k,482) * b(k,67) - b(k,54) = b(k,54) - lu(k,481) * b(k,67) - b(k,53) = b(k,53) - lu(k,480) * b(k,67) - b(k,52) = b(k,52) - lu(k,479) * b(k,67) - b(k,51) = b(k,51) - lu(k,478) * b(k,67) - b(k,50) = b(k,50) - lu(k,477) * b(k,67) - b(k,49) = b(k,49) - lu(k,476) * b(k,67) - b(k,48) = b(k,48) - lu(k,475) * b(k,67) - b(k,47) = b(k,47) - lu(k,474) * b(k,67) - b(k,45) = b(k,45) - lu(k,473) * b(k,67) - b(k,44) = b(k,44) - lu(k,472) * b(k,67) - b(k,43) = b(k,43) - lu(k,471) * b(k,67) - b(k,42) = b(k,42) - lu(k,470) * b(k,67) - b(k,41) = b(k,41) - lu(k,469) * b(k,67) - b(k,40) = b(k,40) - lu(k,468) * b(k,67) - b(k,39) = b(k,39) - lu(k,467) * b(k,67) - b(k,38) = b(k,38) - lu(k,466) * b(k,67) - b(k,37) = b(k,37) - lu(k,465) * b(k,67) - b(k,34) = b(k,34) - lu(k,464) * b(k,67) - b(k,25) = b(k,25) - lu(k,463) * b(k,67) - b(k,24) = b(k,24) - lu(k,462) * b(k,67) - b(k,66) = b(k,66) * lu(k,450) - b(k,65) = b(k,65) - lu(k,449) * b(k,66) - b(k,64) = b(k,64) - lu(k,448) * b(k,66) - b(k,63) = b(k,63) - lu(k,447) * b(k,66) - b(k,62) = b(k,62) - lu(k,446) * b(k,66) - b(k,61) = b(k,61) - lu(k,445) * b(k,66) - b(k,60) = b(k,60) - lu(k,444) * b(k,66) - b(k,59) = b(k,59) - lu(k,443) * b(k,66) - b(k,58) = b(k,58) - lu(k,442) * b(k,66) - b(k,57) = b(k,57) - lu(k,441) * b(k,66) - b(k,56) = b(k,56) - lu(k,440) * b(k,66) - b(k,55) = b(k,55) - lu(k,439) * b(k,66) - b(k,47) = b(k,47) - lu(k,438) * b(k,66) - b(k,33) = b(k,33) - lu(k,437) * b(k,66) - b(k,29) = b(k,29) - lu(k,436) * b(k,66) - b(k,26) = b(k,26) - lu(k,435) * b(k,66) - b(k,21) = b(k,21) - lu(k,434) * b(k,66) - b(k,65) = b(k,65) * lu(k,421) - b(k,64) = b(k,64) - lu(k,420) * b(k,65) - b(k,63) = b(k,63) - lu(k,419) * b(k,65) - b(k,62) = b(k,62) - lu(k,418) * b(k,65) - b(k,61) = b(k,61) - lu(k,417) * b(k,65) - b(k,60) = b(k,60) - lu(k,416) * b(k,65) - b(k,59) = b(k,59) - lu(k,415) * b(k,65) - b(k,57) = b(k,57) - lu(k,414) * b(k,65) - b(k,56) = b(k,56) - lu(k,413) * b(k,65) - b(k,47) = b(k,47) - lu(k,412) * b(k,65) - b(k,41) = b(k,41) - lu(k,411) * b(k,65) - b(k,39) = b(k,39) - lu(k,410) * b(k,65) - b(k,26) = b(k,26) - lu(k,409) * b(k,65) - b(k,64) = b(k,64) * lu(k,395) - b(k,63) = b(k,63) - lu(k,394) * b(k,64) - b(k,62) = b(k,62) - lu(k,393) * b(k,64) - b(k,61) = b(k,61) - lu(k,392) * b(k,64) - b(k,60) = b(k,60) - lu(k,391) * b(k,64) - b(k,59) = b(k,59) - lu(k,390) * b(k,64) - b(k,49) = b(k,49) - lu(k,389) * b(k,64) - b(k,47) = b(k,47) - lu(k,388) * b(k,64) - b(k,45) = b(k,45) - lu(k,387) * b(k,64) - b(k,41) = b(k,41) - lu(k,386) * b(k,64) - b(k,36) = b(k,36) - lu(k,385) * b(k,64) - b(k,35) = b(k,35) - lu(k,384) * b(k,64) - b(k,63) = b(k,63) * lu(k,369) - b(k,62) = b(k,62) - lu(k,368) * b(k,63) - b(k,60) = b(k,60) - lu(k,367) * b(k,63) - b(k,59) = b(k,59) - lu(k,366) * b(k,63) - b(k,58) = b(k,58) - lu(k,365) * b(k,63) - b(k,57) = b(k,57) - lu(k,364) * b(k,63) - b(k,55) = b(k,55) - lu(k,363) * b(k,63) - b(k,39) = b(k,39) - lu(k,362) * b(k,63) - b(k,32) = b(k,32) - lu(k,361) * b(k,63) - b(k,31) = b(k,31) - lu(k,360) * b(k,63) - b(k,62) = b(k,62) * lu(k,347) - b(k,59) = b(k,59) - lu(k,346) * b(k,62) - b(k,35) = b(k,35) - lu(k,345) * b(k,62) - b(k,61) = b(k,61) * lu(k,329) - b(k,60) = b(k,60) - lu(k,328) * b(k,61) - b(k,59) = b(k,59) - lu(k,327) * b(k,61) - b(k,57) = b(k,57) - lu(k,326) * b(k,61) - b(k,56) = b(k,56) - lu(k,325) * b(k,61) - b(k,47) = b(k,47) - lu(k,324) * b(k,61) - b(k,45) = b(k,45) - lu(k,323) * b(k,61) - b(k,29) = b(k,29) - lu(k,322) * b(k,61) - b(k,26) = b(k,26) - lu(k,321) * b(k,61) - b(k,60) = b(k,60) * lu(k,310) - b(k,59) = b(k,59) - lu(k,309) * b(k,60) - b(k,49) = b(k,49) - lu(k,308) * b(k,60) - b(k,39) = b(k,39) - lu(k,307) * b(k,60) - b(k,59) = b(k,59) * lu(k,299) - b(k,58) = b(k,58) * lu(k,285) - b(k,55) = b(k,55) - lu(k,284) * b(k,58) - b(k,43) = b(k,43) - lu(k,283) * b(k,58) - b(k,33) = b(k,33) - lu(k,282) * b(k,58) - b(k,57) = b(k,57) * lu(k,274) - b(k,46) = b(k,46) - lu(k,273) * b(k,57) - b(k,28) = b(k,28) - lu(k,272) * b(k,57) - b(k,56) = b(k,56) * lu(k,262) - b(k,47) = b(k,47) - lu(k,261) * b(k,56) - b(k,26) = b(k,26) - lu(k,260) * b(k,56) - b(k,55) = b(k,55) * lu(k,254) - b(k,30) = b(k,30) - lu(k,253) * b(k,55) - b(k,54) = b(k,54) * lu(k,244) - b(k,53) = b(k,53) - lu(k,243) * b(k,54) - b(k,52) = b(k,52) - lu(k,242) * b(k,54) - b(k,51) = b(k,51) - lu(k,241) * b(k,54) - b(k,50) = b(k,50) - lu(k,240) * b(k,54) - b(k,48) = b(k,48) - lu(k,239) * b(k,54) - b(k,44) = b(k,44) - lu(k,238) * b(k,54) - b(k,53) = b(k,53) * lu(k,229) - b(k,52) = b(k,52) - lu(k,228) * b(k,53) - b(k,51) = b(k,51) - lu(k,227) * b(k,53) - b(k,50) = b(k,50) - lu(k,226) * b(k,53) - b(k,48) = b(k,48) - lu(k,225) * b(k,53) - b(k,52) = b(k,52) * lu(k,215) - b(k,51) = b(k,51) - lu(k,214) * b(k,52) - b(k,50) = b(k,50) - lu(k,213) * b(k,52) - b(k,48) = b(k,48) - lu(k,212) * b(k,52) - b(k,44) = b(k,44) - lu(k,211) * b(k,52) - b(k,42) = b(k,42) - lu(k,210) * b(k,52) - b(k,38) = b(k,38) - lu(k,209) * b(k,52) - b(k,37) = b(k,37) - lu(k,208) * b(k,52) - b(k,51) = b(k,51) * lu(k,200) - b(k,44) = b(k,44) - lu(k,199) * b(k,51) - b(k,50) = b(k,50) * lu(k,189) - b(k,48) = b(k,48) - lu(k,188) * b(k,50) - b(k,44) = b(k,44) - lu(k,187) * b(k,50) - b(k,39) = b(k,39) - lu(k,186) * b(k,50) - b(k,49) = b(k,49) * lu(k,178) - b(k,48) = b(k,48) * lu(k,170) - b(k,44) = b(k,44) - lu(k,169) * b(k,48) - b(k,47) = b(k,47) * lu(k,162) - b(k,26) = b(k,26) - lu(k,161) * b(k,47) - b(k,46) = b(k,46) * lu(k,153) - b(k,28) = b(k,28) - lu(k,152) * b(k,46) - b(k,45) = b(k,45) * lu(k,144) - b(k,29) = b(k,29) - lu(k,143) * b(k,45) - b(k,44) = b(k,44) * lu(k,138) - b(k,43) = b(k,43) * lu(k,131) - b(k,42) = b(k,42) * lu(k,122) - b(k,41) = b(k,41) * lu(k,115) - b(k,40) = b(k,40) * lu(k,107) - b(k,39) = b(k,39) * lu(k,103) - b(k,38) = b(k,38) * lu(k,97) - b(k,37) = b(k,37) * lu(k,90) - b(k,36) = b(k,36) * lu(k,83) - b(k,35) = b(k,35) * lu(k,77) - b(k,34) = b(k,34) * lu(k,69) - b(k,33) = b(k,33) * lu(k,64) - b(k,32) = b(k,32) * lu(k,58) - b(k,31) = b(k,31) * lu(k,52) - b(k,30) = b(k,30) * lu(k,48) - b(k,22) = b(k,22) - lu(k,47) * b(k,30) - b(k,29) = b(k,29) * lu(k,44) - b(k,28) = b(k,28) * lu(k,41) - b(k,27) = b(k,27) * lu(k,37) - b(k,26) = b(k,26) * lu(k,35) - b(k,25) = b(k,25) * lu(k,33) - b(k,24) = b(k,24) - lu(k,32) * b(k,25) - b(k,24) = b(k,24) * lu(k,30) - b(k,23) = b(k,23) * lu(k,27) - b(k,22) = b(k,22) * lu(k,24) - b(k,21) = b(k,21) * lu(k,21) - b(k,20) = b(k,20) * lu(k,20) - b(k,19) = b(k,19) * lu(k,19) - b(k,18) = b(k,18) * lu(k,18) - b(k,17) = b(k,17) * lu(k,17) - b(k,16) = b(k,16) * lu(k,16) - b(k,15) = b(k,15) * lu(k,15) - b(k,14) = b(k,14) * lu(k,14) - b(k,13) = b(k,13) * lu(k,13) - b(k,12) = b(k,12) * lu(k,12) - b(k,11) = b(k,11) * lu(k,11) - b(k,10) = b(k,10) * lu(k,10) - b(k,9) = b(k,9) * lu(k,9) - b(k,8) = b(k,8) * lu(k,8) +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,100) = b(k,100) * lu(k,956) + b(k,99) = b(k,99) - lu(k,955) * b(k,100) + b(k,98) = b(k,98) - lu(k,954) * b(k,100) + b(k,97) = b(k,97) - lu(k,953) * b(k,100) + b(k,96) = b(k,96) - lu(k,952) * b(k,100) + b(k,95) = b(k,95) - lu(k,951) * b(k,100) + b(k,94) = b(k,94) - lu(k,950) * b(k,100) + b(k,93) = b(k,93) - lu(k,949) * b(k,100) + b(k,92) = b(k,92) - lu(k,948) * b(k,100) + b(k,91) = b(k,91) - lu(k,947) * b(k,100) + b(k,90) = b(k,90) - lu(k,946) * b(k,100) + b(k,89) = b(k,89) - lu(k,945) * b(k,100) + b(k,88) = b(k,88) - lu(k,944) * b(k,100) + b(k,87) = b(k,87) - lu(k,943) * b(k,100) + b(k,86) = b(k,86) - lu(k,942) * b(k,100) + b(k,85) = b(k,85) - lu(k,941) * b(k,100) + b(k,84) = b(k,84) - lu(k,940) * b(k,100) + b(k,83) = b(k,83) - lu(k,939) * b(k,100) + b(k,82) = b(k,82) - lu(k,938) * b(k,100) + b(k,81) = b(k,81) - lu(k,937) * b(k,100) + b(k,80) = b(k,80) - lu(k,936) * b(k,100) + b(k,79) = b(k,79) - lu(k,935) * b(k,100) + b(k,72) = b(k,72) - lu(k,934) * b(k,100) + b(k,71) = b(k,71) - lu(k,933) * b(k,100) + b(k,47) = b(k,47) - lu(k,932) * b(k,100) + b(k,45) = b(k,45) - lu(k,931) * b(k,100) + b(k,31) = b(k,31) - lu(k,930) * b(k,100) + b(k,99) = b(k,99) * lu(k,928) + b(k,98) = b(k,98) - lu(k,927) * b(k,99) + b(k,97) = b(k,97) - lu(k,926) * b(k,99) + b(k,96) = b(k,96) - lu(k,925) * b(k,99) + b(k,95) = b(k,95) - lu(k,924) * b(k,99) + b(k,94) = b(k,94) - lu(k,923) * b(k,99) + b(k,93) = b(k,93) - lu(k,922) * b(k,99) + b(k,92) = b(k,92) - lu(k,921) * b(k,99) + b(k,91) = b(k,91) - lu(k,920) * b(k,99) + b(k,90) = b(k,90) - lu(k,919) * b(k,99) + b(k,89) = b(k,89) - lu(k,918) * b(k,99) + b(k,88) = b(k,88) - lu(k,917) * b(k,99) + b(k,87) = b(k,87) - lu(k,916) * b(k,99) + b(k,86) = b(k,86) - lu(k,915) * b(k,99) + b(k,85) = b(k,85) - lu(k,914) * b(k,99) + b(k,84) = b(k,84) - lu(k,913) * b(k,99) + b(k,83) = b(k,83) - lu(k,912) * b(k,99) + b(k,82) = b(k,82) - lu(k,911) * b(k,99) + b(k,80) = b(k,80) - lu(k,910) * b(k,99) + b(k,79) = b(k,79) - lu(k,909) * b(k,99) + b(k,71) = b(k,71) - lu(k,908) * b(k,99) + b(k,47) = b(k,47) - lu(k,907) * b(k,99) + b(k,98) = b(k,98) * lu(k,904) + b(k,97) = b(k,97) - lu(k,903) * b(k,98) + b(k,96) = b(k,96) - lu(k,902) * b(k,98) + b(k,95) = b(k,95) - lu(k,901) * b(k,98) + b(k,94) = b(k,94) - lu(k,900) * b(k,98) + b(k,93) = b(k,93) - lu(k,899) * b(k,98) + b(k,92) = b(k,92) - lu(k,898) * b(k,98) + b(k,91) = b(k,91) - lu(k,897) * b(k,98) + b(k,90) = b(k,90) - lu(k,896) * b(k,98) + b(k,89) = b(k,89) - lu(k,895) * b(k,98) + b(k,88) = b(k,88) - lu(k,894) * b(k,98) + b(k,87) = b(k,87) - lu(k,893) * b(k,98) + b(k,86) = b(k,86) - lu(k,892) * b(k,98) + b(k,85) = b(k,85) - lu(k,891) * b(k,98) + b(k,84) = b(k,84) - lu(k,890) * b(k,98) + b(k,83) = b(k,83) - lu(k,889) * b(k,98) + b(k,82) = b(k,82) - lu(k,888) * b(k,98) + b(k,80) = b(k,80) - lu(k,887) * b(k,98) + b(k,79) = b(k,79) - lu(k,886) * b(k,98) + b(k,78) = b(k,78) - lu(k,885) * b(k,98) + b(k,77) = b(k,77) - lu(k,884) * b(k,98) + b(k,73) = b(k,73) - lu(k,883) * b(k,98) + b(k,70) = b(k,70) - lu(k,882) * b(k,98) + b(k,68) = b(k,68) - lu(k,881) * b(k,98) + b(k,62) = b(k,62) - lu(k,880) * b(k,98) + b(k,61) = b(k,61) - lu(k,879) * b(k,98) + b(k,55) = b(k,55) - lu(k,878) * b(k,98) + b(k,53) = b(k,53) - lu(k,877) * b(k,98) + b(k,52) = b(k,52) - lu(k,876) * b(k,98) + b(k,36) = b(k,36) - lu(k,875) * b(k,98) + b(k,97) = b(k,97) * lu(k,871) + b(k,96) = b(k,96) - lu(k,870) * b(k,97) + b(k,95) = b(k,95) - lu(k,869) * b(k,97) + b(k,94) = b(k,94) - lu(k,868) * b(k,97) + b(k,93) = b(k,93) - lu(k,867) * b(k,97) + b(k,92) = b(k,92) - lu(k,866) * b(k,97) + b(k,91) = b(k,91) - lu(k,865) * b(k,97) + b(k,90) = b(k,90) - lu(k,864) * b(k,97) + b(k,89) = b(k,89) - lu(k,863) * b(k,97) + b(k,88) = b(k,88) - lu(k,862) * b(k,97) + b(k,87) = b(k,87) - lu(k,861) * b(k,97) + b(k,86) = b(k,86) - lu(k,860) * b(k,97) + b(k,85) = b(k,85) - lu(k,859) * b(k,97) + b(k,84) = b(k,84) - lu(k,858) * b(k,97) + b(k,83) = b(k,83) - lu(k,857) * b(k,97) + b(k,82) = b(k,82) - lu(k,856) * b(k,97) + b(k,80) = b(k,80) - lu(k,855) * b(k,97) + b(k,79) = b(k,79) - lu(k,854) * b(k,97) + b(k,71) = b(k,71) - lu(k,853) * b(k,97) + b(k,47) = b(k,47) - lu(k,852) * b(k,97) + b(k,96) = b(k,96) * lu(k,847) + b(k,95) = b(k,95) - lu(k,846) * b(k,96) + b(k,94) = b(k,94) - lu(k,845) * b(k,96) + b(k,93) = b(k,93) - lu(k,844) * b(k,96) + b(k,92) = b(k,92) - lu(k,843) * b(k,96) + b(k,91) = b(k,91) - lu(k,842) * b(k,96) + b(k,90) = b(k,90) - lu(k,841) * b(k,96) + b(k,89) = b(k,89) - lu(k,840) * b(k,96) + b(k,88) = b(k,88) - lu(k,839) * b(k,96) + b(k,87) = b(k,87) - lu(k,838) * b(k,96) + b(k,86) = b(k,86) - lu(k,837) * b(k,96) + b(k,85) = b(k,85) - lu(k,836) * b(k,96) + b(k,84) = b(k,84) - lu(k,835) * b(k,96) + b(k,83) = b(k,83) - lu(k,834) * b(k,96) + b(k,82) = b(k,82) - lu(k,833) * b(k,96) + b(k,81) = b(k,81) - lu(k,832) * b(k,96) + b(k,80) = b(k,80) - lu(k,831) * b(k,96) + b(k,79) = b(k,79) - lu(k,830) * b(k,96) + b(k,78) = b(k,78) - lu(k,829) * b(k,96) + b(k,77) = b(k,77) - lu(k,828) * b(k,96) + b(k,76) = b(k,76) - lu(k,827) * b(k,96) + b(k,73) = b(k,73) - lu(k,826) * b(k,96) + b(k,72) = b(k,72) - lu(k,825) * b(k,96) + b(k,71) = b(k,71) - lu(k,824) * b(k,96) + b(k,70) = b(k,70) - lu(k,823) * b(k,96) + b(k,68) = b(k,68) - lu(k,822) * b(k,96) + b(k,67) = b(k,67) - lu(k,821) * b(k,96) + b(k,64) = b(k,64) - lu(k,820) * b(k,96) + b(k,62) = b(k,62) - lu(k,819) * b(k,96) + b(k,61) = b(k,61) - lu(k,818) * b(k,96) + b(k,59) = b(k,59) - lu(k,817) * b(k,96) + b(k,56) = b(k,56) - lu(k,816) * b(k,96) + b(k,55) = b(k,55) - lu(k,815) * b(k,96) + b(k,54) = b(k,54) - lu(k,814) * b(k,96) + b(k,53) = b(k,53) - lu(k,813) * b(k,96) + b(k,52) = b(k,52) - lu(k,812) * b(k,96) + b(k,51) = b(k,51) - lu(k,811) * b(k,96) + b(k,49) = b(k,49) - lu(k,810) * b(k,96) + b(k,46) = b(k,46) - lu(k,809) * b(k,96) + b(k,45) = b(k,45) - lu(k,808) * b(k,96) + b(k,42) = b(k,42) - lu(k,807) * b(k,96) + b(k,41) = b(k,41) - lu(k,806) * b(k,96) + b(k,40) = b(k,40) - lu(k,805) * b(k,96) + b(k,39) = b(k,39) - lu(k,804) * b(k,96) + b(k,30) = b(k,30) - lu(k,803) * b(k,96) + b(k,95) = b(k,95) * lu(k,797) + b(k,94) = b(k,94) - lu(k,796) * b(k,95) + b(k,93) = b(k,93) - lu(k,795) * b(k,95) + b(k,92) = b(k,92) - lu(k,794) * b(k,95) + b(k,91) = b(k,91) - lu(k,793) * b(k,95) + b(k,90) = b(k,90) - lu(k,792) * b(k,95) + b(k,89) = b(k,89) - lu(k,791) * b(k,95) + b(k,88) = b(k,88) - lu(k,790) * b(k,95) + b(k,87) = b(k,87) - lu(k,789) * b(k,95) + b(k,86) = b(k,86) - lu(k,788) * b(k,95) + b(k,85) = b(k,85) - lu(k,787) * b(k,95) + b(k,83) = b(k,83) - lu(k,786) * b(k,95) + b(k,82) = b(k,82) - lu(k,785) * b(k,95) + b(k,81) = b(k,81) - lu(k,784) * b(k,95) + b(k,78) = b(k,78) - lu(k,783) * b(k,95) + b(k,77) = b(k,77) - lu(k,782) * b(k,95) + b(k,76) = b(k,76) - lu(k,781) * b(k,95) + b(k,73) = b(k,73) - lu(k,780) * b(k,95) + b(k,72) = b(k,72) - lu(k,779) * b(k,95) + b(k,66) = b(k,66) - lu(k,778) * b(k,95) + b(k,60) = b(k,60) - lu(k,777) * b(k,95) + b(k,56) = b(k,56) - lu(k,776) * b(k,95) + b(k,48) = b(k,48) - lu(k,775) * b(k,95) + b(k,44) = b(k,44) - lu(k,774) * b(k,95) + b(k,94) = b(k,94) * lu(k,767) + b(k,93) = b(k,93) - lu(k,766) * b(k,94) + b(k,92) = b(k,92) - lu(k,765) * b(k,94) + b(k,91) = b(k,91) - lu(k,764) * b(k,94) + b(k,90) = b(k,90) - lu(k,763) * b(k,94) + b(k,89) = b(k,89) - lu(k,762) * b(k,94) + b(k,88) = b(k,88) - lu(k,761) * b(k,94) + b(k,87) = b(k,87) - lu(k,760) * b(k,94) + b(k,86) = b(k,86) - lu(k,759) * b(k,94) + b(k,85) = b(k,85) - lu(k,758) * b(k,94) + b(k,84) = b(k,84) - lu(k,757) * b(k,94) + b(k,82) = b(k,82) - lu(k,756) * b(k,94) + b(k,78) = b(k,78) - lu(k,755) * b(k,94) + b(k,77) = b(k,77) - lu(k,754) * b(k,94) + b(k,70) = b(k,70) - lu(k,753) * b(k,94) + b(k,67) = b(k,67) - lu(k,752) * b(k,94) + b(k,93) = b(k,93) * lu(k,744) + b(k,92) = b(k,92) - lu(k,743) * b(k,93) + b(k,91) = b(k,91) - lu(k,742) * b(k,93) + b(k,90) = b(k,90) - lu(k,741) * b(k,93) + b(k,89) = b(k,89) - lu(k,740) * b(k,93) + b(k,88) = b(k,88) - lu(k,739) * b(k,93) + b(k,87) = b(k,87) - lu(k,738) * b(k,93) + b(k,86) = b(k,86) - lu(k,737) * b(k,93) + b(k,85) = b(k,85) - lu(k,736) * b(k,93) + b(k,83) = b(k,83) - lu(k,735) * b(k,93) + b(k,82) = b(k,82) - lu(k,734) * b(k,93) + b(k,81) = b(k,81) - lu(k,733) * b(k,93) + b(k,72) = b(k,72) - lu(k,732) * b(k,93) + b(k,66) = b(k,66) - lu(k,731) * b(k,93) + b(k,60) = b(k,60) - lu(k,730) * b(k,93) + b(k,50) = b(k,50) - lu(k,729) * b(k,93) + b(k,43) = b(k,43) - lu(k,728) * b(k,93) end do end subroutine lu_slv04 subroutine lu_slv05( avec_len, lu, b ) @@ -861,6 +767,312 @@ subroutine lu_slv05( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len + b(k,92) = b(k,92) * lu(k,719) + b(k,91) = b(k,91) - lu(k,718) * b(k,92) + b(k,90) = b(k,90) - lu(k,717) * b(k,92) + b(k,89) = b(k,89) - lu(k,716) * b(k,92) + b(k,88) = b(k,88) - lu(k,715) * b(k,92) + b(k,87) = b(k,87) - lu(k,714) * b(k,92) + b(k,86) = b(k,86) - lu(k,713) * b(k,92) + b(k,85) = b(k,85) - lu(k,712) * b(k,92) + b(k,84) = b(k,84) - lu(k,711) * b(k,92) + b(k,83) = b(k,83) - lu(k,710) * b(k,92) + b(k,82) = b(k,82) - lu(k,709) * b(k,92) + b(k,80) = b(k,80) - lu(k,708) * b(k,92) + b(k,79) = b(k,79) - lu(k,707) * b(k,92) + b(k,71) = b(k,71) - lu(k,706) * b(k,92) + b(k,67) = b(k,67) - lu(k,705) * b(k,92) + b(k,61) = b(k,61) - lu(k,704) * b(k,92) + b(k,55) = b(k,55) - lu(k,703) * b(k,92) + b(k,53) = b(k,53) - lu(k,702) * b(k,92) + b(k,46) = b(k,46) - lu(k,701) * b(k,92) + b(k,44) = b(k,44) - lu(k,700) * b(k,92) + b(k,42) = b(k,42) - lu(k,699) * b(k,92) + b(k,41) = b(k,41) - lu(k,698) * b(k,92) + b(k,40) = b(k,40) - lu(k,697) * b(k,92) + b(k,39) = b(k,39) - lu(k,696) * b(k,92) + b(k,38) = b(k,38) - lu(k,695) * b(k,92) + b(k,35) = b(k,35) - lu(k,694) * b(k,92) + b(k,34) = b(k,34) - lu(k,693) * b(k,92) + b(k,33) = b(k,33) - lu(k,692) * b(k,92) + b(k,32) = b(k,32) - lu(k,691) * b(k,92) + b(k,29) = b(k,29) - lu(k,690) * b(k,92) + b(k,28) = b(k,28) - lu(k,689) * b(k,92) + b(k,27) = b(k,27) - lu(k,688) * b(k,92) + b(k,26) = b(k,26) - lu(k,687) * b(k,92) + b(k,25) = b(k,25) - lu(k,686) * b(k,92) + b(k,91) = b(k,91) * lu(k,676) + b(k,90) = b(k,90) - lu(k,675) * b(k,91) + b(k,89) = b(k,89) - lu(k,674) * b(k,91) + b(k,88) = b(k,88) - lu(k,673) * b(k,91) + b(k,87) = b(k,87) - lu(k,672) * b(k,91) + b(k,86) = b(k,86) - lu(k,671) * b(k,91) + b(k,85) = b(k,85) - lu(k,670) * b(k,91) + b(k,84) = b(k,84) - lu(k,669) * b(k,91) + b(k,82) = b(k,82) - lu(k,668) * b(k,91) + b(k,80) = b(k,80) - lu(k,667) * b(k,91) + b(k,78) = b(k,78) - lu(k,666) * b(k,91) + b(k,77) = b(k,77) - lu(k,665) * b(k,91) + b(k,76) = b(k,76) - lu(k,664) * b(k,91) + b(k,75) = b(k,75) - lu(k,663) * b(k,91) + b(k,74) = b(k,74) - lu(k,662) * b(k,91) + b(k,65) = b(k,65) - lu(k,661) * b(k,91) + b(k,90) = b(k,90) * lu(k,650) + b(k,89) = b(k,89) - lu(k,649) * b(k,90) + b(k,88) = b(k,88) - lu(k,648) * b(k,90) + b(k,87) = b(k,87) - lu(k,647) * b(k,90) + b(k,86) = b(k,86) - lu(k,646) * b(k,90) + b(k,85) = b(k,85) - lu(k,645) * b(k,90) + b(k,84) = b(k,84) - lu(k,644) * b(k,90) + b(k,83) = b(k,83) - lu(k,643) * b(k,90) + b(k,82) = b(k,82) - lu(k,642) * b(k,90) + b(k,81) = b(k,81) - lu(k,641) * b(k,90) + b(k,78) = b(k,78) - lu(k,640) * b(k,90) + b(k,77) = b(k,77) - lu(k,639) * b(k,90) + b(k,76) = b(k,76) - lu(k,638) * b(k,90) + b(k,75) = b(k,75) - lu(k,637) * b(k,90) + b(k,74) = b(k,74) - lu(k,636) * b(k,90) + b(k,73) = b(k,73) - lu(k,635) * b(k,90) + b(k,72) = b(k,72) - lu(k,634) * b(k,90) + b(k,70) = b(k,70) - lu(k,633) * b(k,90) + b(k,69) = b(k,69) - lu(k,632) * b(k,90) + b(k,68) = b(k,68) - lu(k,631) * b(k,90) + b(k,67) = b(k,67) - lu(k,630) * b(k,90) + b(k,66) = b(k,66) - lu(k,629) * b(k,90) + b(k,65) = b(k,65) - lu(k,628) * b(k,90) + b(k,64) = b(k,64) - lu(k,627) * b(k,90) + b(k,63) = b(k,63) - lu(k,626) * b(k,90) + b(k,62) = b(k,62) - lu(k,625) * b(k,90) + b(k,60) = b(k,60) - lu(k,624) * b(k,90) + b(k,58) = b(k,58) - lu(k,623) * b(k,90) + b(k,57) = b(k,57) - lu(k,622) * b(k,90) + b(k,51) = b(k,51) - lu(k,621) * b(k,90) + b(k,38) = b(k,38) - lu(k,620) * b(k,90) + b(k,37) = b(k,37) - lu(k,619) * b(k,90) + b(k,89) = b(k,89) * lu(k,607) + b(k,88) = b(k,88) - lu(k,606) * b(k,89) + b(k,87) = b(k,87) - lu(k,605) * b(k,89) + b(k,86) = b(k,86) - lu(k,604) * b(k,89) + b(k,85) = b(k,85) - lu(k,603) * b(k,89) + b(k,84) = b(k,84) - lu(k,602) * b(k,89) + b(k,82) = b(k,82) - lu(k,601) * b(k,89) + b(k,81) = b(k,81) - lu(k,600) * b(k,89) + b(k,78) = b(k,78) - lu(k,599) * b(k,89) + b(k,77) = b(k,77) - lu(k,598) * b(k,89) + b(k,72) = b(k,72) - lu(k,597) * b(k,89) + b(k,70) = b(k,70) - lu(k,596) * b(k,89) + b(k,49) = b(k,49) - lu(k,595) * b(k,89) + b(k,48) = b(k,48) - lu(k,594) * b(k,89) + b(k,88) = b(k,88) * lu(k,581) + b(k,87) = b(k,87) - lu(k,580) * b(k,88) + b(k,86) = b(k,86) - lu(k,579) * b(k,88) + b(k,85) = b(k,85) - lu(k,578) * b(k,88) + b(k,84) = b(k,84) - lu(k,577) * b(k,88) + b(k,83) = b(k,83) - lu(k,576) * b(k,88) + b(k,82) = b(k,82) - lu(k,575) * b(k,88) + b(k,81) = b(k,81) - lu(k,574) * b(k,88) + b(k,80) = b(k,80) - lu(k,573) * b(k,88) + b(k,73) = b(k,73) - lu(k,572) * b(k,88) + b(k,72) = b(k,72) - lu(k,571) * b(k,88) + b(k,68) = b(k,68) - lu(k,570) * b(k,88) + b(k,50) = b(k,50) - lu(k,569) * b(k,88) + b(k,43) = b(k,43) - lu(k,568) * b(k,88) + b(k,36) = b(k,36) - lu(k,567) * b(k,88) + b(k,24) = b(k,24) - lu(k,566) * b(k,88) + b(k,87) = b(k,87) * lu(k,552) + b(k,86) = b(k,86) - lu(k,551) * b(k,87) + b(k,85) = b(k,85) - lu(k,550) * b(k,87) + b(k,84) = b(k,84) - lu(k,549) * b(k,87) + b(k,83) = b(k,83) - lu(k,548) * b(k,87) + b(k,82) = b(k,82) - lu(k,547) * b(k,87) + b(k,80) = b(k,80) - lu(k,546) * b(k,87) + b(k,68) = b(k,68) - lu(k,545) * b(k,87) + b(k,67) = b(k,67) - lu(k,544) * b(k,87) + b(k,66) = b(k,66) - lu(k,543) * b(k,87) + b(k,62) = b(k,62) - lu(k,542) * b(k,87) + b(k,56) = b(k,56) - lu(k,541) * b(k,87) + b(k,54) = b(k,54) - lu(k,540) * b(k,87) + b(k,86) = b(k,86) * lu(k,526) + b(k,85) = b(k,85) - lu(k,525) * b(k,86) + b(k,82) = b(k,82) - lu(k,524) * b(k,86) + b(k,81) = b(k,81) - lu(k,523) * b(k,86) + b(k,72) = b(k,72) - lu(k,522) * b(k,86) + b(k,64) = b(k,64) - lu(k,521) * b(k,86) + b(k,38) = b(k,38) - lu(k,520) * b(k,86) + b(k,37) = b(k,37) - lu(k,519) * b(k,86) + b(k,85) = b(k,85) * lu(k,505) + b(k,82) = b(k,82) - lu(k,504) * b(k,85) + b(k,81) = b(k,81) - lu(k,503) * b(k,85) + b(k,78) = b(k,78) - lu(k,502) * b(k,85) + b(k,77) = b(k,77) - lu(k,501) * b(k,85) + b(k,76) = b(k,76) - lu(k,500) * b(k,85) + b(k,75) = b(k,75) - lu(k,499) * b(k,85) + b(k,74) = b(k,74) - lu(k,498) * b(k,85) + b(k,72) = b(k,72) - lu(k,497) * b(k,85) + b(k,69) = b(k,69) - lu(k,496) * b(k,85) + b(k,65) = b(k,65) - lu(k,495) * b(k,85) + b(k,64) = b(k,64) - lu(k,494) * b(k,85) + b(k,63) = b(k,63) - lu(k,493) * b(k,85) + b(k,58) = b(k,58) - lu(k,492) * b(k,85) + b(k,57) = b(k,57) - lu(k,491) * b(k,85) + b(k,38) = b(k,38) - lu(k,490) * b(k,85) + b(k,37) = b(k,37) - lu(k,489) * b(k,85) + b(k,84) = b(k,84) * lu(k,472) + b(k,83) = b(k,83) - lu(k,471) * b(k,84) + b(k,82) = b(k,82) - lu(k,470) * b(k,84) + b(k,78) = b(k,78) - lu(k,469) * b(k,84) + b(k,77) = b(k,77) - lu(k,468) * b(k,84) + b(k,70) = b(k,70) - lu(k,467) * b(k,84) + b(k,67) = b(k,67) - lu(k,466) * b(k,84) + b(k,83) = b(k,83) * lu(k,450) + b(k,82) = b(k,82) - lu(k,449) * b(k,83) + b(k,73) = b(k,73) - lu(k,448) * b(k,83) + b(k,68) = b(k,68) - lu(k,447) * b(k,83) + b(k,66) = b(k,66) - lu(k,446) * b(k,83) + b(k,43) = b(k,43) - lu(k,445) * b(k,83) + b(k,36) = b(k,36) - lu(k,444) * b(k,83) + b(k,82) = b(k,82) * lu(k,436) + b(k,81) = b(k,81) * lu(k,422) + b(k,72) = b(k,72) - lu(k,421) * b(k,81) + b(k,64) = b(k,64) - lu(k,420) * b(k,81) + b(k,50) = b(k,50) - lu(k,419) * b(k,81) + b(k,80) = b(k,80) * lu(k,408) + b(k,54) = b(k,54) - lu(k,407) * b(k,80) + b(k,79) = b(k,79) * lu(k,390) + b(k,78) = b(k,78) - lu(k,389) * b(k,79) + b(k,77) = b(k,77) - lu(k,388) * b(k,79) + b(k,71) = b(k,71) - lu(k,387) * b(k,79) + b(k,70) = b(k,70) - lu(k,386) * b(k,79) + b(k,59) = b(k,59) - lu(k,385) * b(k,79) + b(k,47) = b(k,47) - lu(k,384) * b(k,79) + b(k,78) = b(k,78) * lu(k,375) + b(k,77) = b(k,77) - lu(k,374) * b(k,78) + b(k,76) = b(k,76) - lu(k,373) * b(k,78) + b(k,75) = b(k,75) - lu(k,372) * b(k,78) + b(k,74) = b(k,74) - lu(k,371) * b(k,78) + b(k,70) = b(k,70) - lu(k,370) * b(k,78) + b(k,69) = b(k,69) - lu(k,369) * b(k,78) + b(k,65) = b(k,65) - lu(k,368) * b(k,78) + b(k,59) = b(k,59) - lu(k,367) * b(k,78) + b(k,77) = b(k,77) * lu(k,358) + b(k,76) = b(k,76) - lu(k,357) * b(k,77) + b(k,75) = b(k,75) - lu(k,356) * b(k,77) + b(k,74) = b(k,74) - lu(k,355) * b(k,77) + b(k,65) = b(k,65) - lu(k,354) * b(k,77) + b(k,76) = b(k,76) * lu(k,344) + b(k,75) = b(k,75) - lu(k,343) * b(k,76) + b(k,74) = b(k,74) - lu(k,342) * b(k,76) + b(k,69) = b(k,69) - lu(k,341) * b(k,76) + b(k,65) = b(k,65) - lu(k,340) * b(k,76) + b(k,44) = b(k,44) - lu(k,339) * b(k,76) + b(k,75) = b(k,75) * lu(k,331) + b(k,74) = b(k,74) - lu(k,330) * b(k,75) + b(k,69) = b(k,69) - lu(k,329) * b(k,75) + 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,74) = b(k,74) * lu(k,320) + b(k,69) = b(k,69) - lu(k,319) * b(k,74) + b(k,65) = b(k,65) - lu(k,318) * b(k,74) + b(k,63) = b(k,63) - lu(k,317) * b(k,74) + b(k,58) = b(k,58) - lu(k,316) * b(k,74) + b(k,57) = b(k,57) - lu(k,315) * b(k,74) + b(k,73) = b(k,73) * lu(k,305) + b(k,68) = b(k,68) - lu(k,304) * b(k,73) + b(k,36) = b(k,36) - lu(k,303) * b(k,73) + b(k,72) = b(k,72) * lu(k,297) + b(k,45) = b(k,45) - lu(k,296) * b(k,72) + b(k,71) = b(k,71) * lu(k,287) + b(k,47) = b(k,47) - lu(k,286) * b(k,71) + b(k,70) = b(k,70) * lu(k,279) + b(k,59) = b(k,59) - lu(k,278) * b(k,70) + b(k,69) = b(k,69) * lu(k,270) + b(k,65) = b(k,65) - lu(k,269) * b(k,69) + b(k,68) = b(k,68) * lu(k,262) + b(k,36) = b(k,36) - lu(k,261) * b(k,68) + b(k,67) = b(k,67) * lu(k,253) + b(k,66) = b(k,66) * lu(k,245) + b(k,43) = b(k,43) - lu(k,244) * b(k,66) + b(k,65) = b(k,65) * lu(k,239) + b(k,64) = b(k,64) * lu(k,232) + b(k,63) = b(k,63) * lu(k,223) + b(k,62) = b(k,62) * lu(k,216) + b(k,61) = b(k,61) * lu(k,207) + b(k,60) = b(k,60) * lu(k,199) + b(k,59) = b(k,59) * lu(k,193) + b(k,38) = b(k,38) - lu(k,192) * b(k,59) + b(k,37) = b(k,37) - lu(k,191) * b(k,59) + b(k,58) = b(k,58) * lu(k,185) + b(k,57) = b(k,57) * lu(k,178) + b(k,56) = b(k,56) * lu(k,171) + b(k,55) = b(k,55) * lu(k,164) + b(k,54) = b(k,54) * lu(k,158) + b(k,53) = b(k,53) * lu(k,152) + b(k,52) = b(k,52) * lu(k,144) + b(k,51) = b(k,51) * lu(k,136) + b(k,50) = b(k,50) * lu(k,131) + b(k,49) = b(k,49) * lu(k,125) + b(k,48) = b(k,48) * lu(k,119) + b(k,47) = b(k,47) * lu(k,116) + b(k,46) = b(k,46) * lu(k,110) + b(k,42) = b(k,42) - lu(k,109) * b(k,46) + b(k,45) = b(k,45) * lu(k,105) + b(k,31) = b(k,31) - lu(k,104) * b(k,45) + b(k,44) = b(k,44) * lu(k,100) + b(k,43) = b(k,43) * lu(k,97) + b(k,42) = b(k,42) * lu(k,94) + b(k,41) = b(k,41) * lu(k,89) + b(k,40) = b(k,40) * lu(k,85) + b(k,39) = b(k,39) * lu(k,80) + b(k,38) = b(k,38) * lu(k,78) + b(k,37) = b(k,37) - lu(k,77) * b(k,38) + b(k,37) = b(k,37) * lu(k,75) + b(k,36) = b(k,36) * lu(k,73) + b(k,35) = b(k,35) * lu(k,68) + b(k,34) = b(k,34) * lu(k,63) + b(k,33) = b(k,33) * lu(k,58) + b(k,32) = b(k,32) * lu(k,53) + b(k,31) = b(k,31) * lu(k,50) + b(k,30) = b(k,30) * lu(k,46) + b(k,29) = b(k,29) * lu(k,42) + b(k,28) = b(k,28) * lu(k,38) + b(k,27) = b(k,27) * lu(k,34) + b(k,26) = b(k,26) * lu(k,30) + b(k,25) = b(k,25) * lu(k,27) + b(k,24) = b(k,24) * lu(k,24) + b(k,23) = b(k,23) * lu(k,23) + b(k,22) = b(k,22) * lu(k,22) + b(k,21) = b(k,21) * lu(k,21) + b(k,20) = b(k,20) * lu(k,20) + b(k,19) = b(k,19) * lu(k,19) + b(k,18) = b(k,18) * lu(k,18) + b(k,17) = b(k,17) * lu(k,17) + b(k,16) = b(k,16) * lu(k,16) + b(k,15) = b(k,15) * lu(k,15) + b(k,14) = b(k,14) * lu(k,14) + b(k,13) = b(k,13) * lu(k,13) + b(k,12) = b(k,12) * lu(k,12) + b(k,11) = b(k,11) * lu(k,11) + b(k,10) = b(k,10) * lu(k,10) + 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) @@ -869,7 +1081,7 @@ subroutine lu_slv05( avec_len, lu, b ) b(k,2) = b(k,2) * lu(k,2) b(k,1) = b(k,1) * lu(k,1) end do - end subroutine lu_slv05 + end subroutine lu_slv06 subroutine lu_slv( avec_len, lu, b ) use shr_kind_mod, only : r8 => shr_kind_r8 use chem_mods, only : clscnt4, nzcnt @@ -885,5 +1097,6 @@ subroutine lu_slv( 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 ) end subroutine lu_slv end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_nln_matrix.F90 index 95559062bc..47ae0fc9e1 100644 --- a/src/chemistry/pp_waccm_ma_mam4/mo_nln_matrix.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/mo_nln_matrix.F90 @@ -22,216 +22,214 @@ subroutine nlnmat01( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,573) = rxt(k,197)*y(k,26) - mat(k,436) = rxt(k,197)*y(k,4) - mat(k,322) = (rxt(k,276)+rxt(k,281))*y(k,51) - mat(k,143) = (rxt(k,276)+rxt(k,281))*y(k,47) - mat(k,592) = -(4._r8*rxt(k,194)*y(k,4) + (rxt(k,195) + rxt(k,196) + rxt(k,197) & - ) * y(k,26) + rxt(k,198)*y(k,87) + rxt(k,199)*y(k,59) + rxt(k,200) & - *y(k,60) + rxt(k,202)*y(k,66) + rxt(k,203)*y(k,96) + rxt(k,251) & - *y(k,75)) - mat(k,455) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,4) - mat(k,402) = -rxt(k,198)*y(k,4) - mat(k,733) = -rxt(k,199)*y(k,4) - mat(k,710) = -rxt(k,200)*y(k,4) - mat(k,498) = -rxt(k,202)*y(k,4) - mat(k,660) = -rxt(k,203)*y(k,4) - mat(k,292) = -rxt(k,251)*y(k,4) - mat(k,113) = rxt(k,201)*y(k,66) - mat(k,183) = rxt(k,211)*y(k,92) - mat(k,149) = rxt(k,206)*y(k,66) - mat(k,498) = mat(k,498) + rxt(k,201)*y(k,5) + rxt(k,206)*y(k,51) - mat(k,682) = rxt(k,193)*y(k,84) - mat(k,316) = rxt(k,193)*y(k,68) - mat(k,545) = rxt(k,211)*y(k,43) - mat(k,107) = -(rxt(k,201)*y(k,66)) - mat(k,468) = -rxt(k,201)*y(k,5) - mat(k,575) = rxt(k,200)*y(k,60) - mat(k,691) = rxt(k,200)*y(k,4) - mat(k,517) = -(rxt(k,155)*y(k,85) + rxt(k,191)*y(k,84) + rxt(k,235)*y(k,61) & - + rxt(k,236)*y(k,66) + rxt(k,237)*y(k,96)) - mat(k,424) = -rxt(k,155)*y(k,16) - mat(k,313) = -rxt(k,191)*y(k,16) - mat(k,374) = -rxt(k,235)*y(k,16) - mat(k,495) = -rxt(k,236)*y(k,16) - mat(k,657) = -rxt(k,237)*y(k,16) - mat(k,352) = rxt(k,162)*y(k,26) + rxt(k,239)*y(k,59) - mat(k,80) = .300_r8*rxt(k,240)*y(k,96) - mat(k,452) = rxt(k,162)*y(k,20) - mat(k,730) = rxt(k,239)*y(k,20) - mat(k,657) = mat(k,657) + .300_r8*rxt(k,240)*y(k,21) - mat(k,347) = -(rxt(k,162)*y(k,26) + rxt(k,238)*y(k,87) + rxt(k,239)*y(k,59)) - mat(k,446) = -rxt(k,162)*y(k,20) - mat(k,393) = -rxt(k,238)*y(k,20) - mat(k,724) = -rxt(k,239)*y(k,20) - mat(k,79) = .700_r8*rxt(k,240)*y(k,96) - mat(k,651) = .700_r8*rxt(k,240)*y(k,21) - mat(k,77) = -(rxt(k,240)*y(k,96)) - mat(k,635) = -rxt(k,240)*y(k,21) - mat(k,345) = rxt(k,238)*y(k,87) - mat(k,384) = rxt(k,238)*y(k,20) - mat(k,435) = 2.000_r8*rxt(k,164)*y(k,26) - mat(k,260) = (rxt(k,274)+rxt(k,279)+rxt(k,284))*y(k,47) + rxt(k,168)*y(k,85) - mat(k,321) = (rxt(k,274)+rxt(k,279)+rxt(k,284))*y(k,27) + (rxt(k,269) & - +rxt(k,275)+rxt(k,280))*y(k,52) - mat(k,161) = (rxt(k,269)+rxt(k,275)+rxt(k,280))*y(k,47) - mat(k,409) = rxt(k,168)*y(k,27) - mat(k,434) = 2.000_r8*rxt(k,189)*y(k,26) - mat(k,450) = -(rxt(k,162)*y(k,20) + (4._r8*rxt(k,163) + 4._r8*rxt(k,164) & - + 4._r8*rxt(k,165) + 4._r8*rxt(k,189)) * y(k,26) + rxt(k,166) & - *y(k,87) + rxt(k,167)*y(k,59) + rxt(k,169)*y(k,60) + rxt(k,172) & - *y(k,66) + (rxt(k,173) + rxt(k,174)) * y(k,96) + (rxt(k,195) & - + rxt(k,196) + rxt(k,197)) * y(k,4) + rxt(k,252)*y(k,75)) - mat(k,350) = -rxt(k,162)*y(k,26) - mat(k,397) = -rxt(k,166)*y(k,26) - mat(k,728) = -rxt(k,167)*y(k,26) - mat(k,705) = -rxt(k,169)*y(k,26) - mat(k,493) = -rxt(k,172)*y(k,26) - mat(k,655) = -(rxt(k,173) + rxt(k,174)) * y(k,26) - mat(k,587) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,26) - mat(k,290) = -rxt(k,252)*y(k,26) - mat(k,267) = rxt(k,170)*y(k,66) - mat(k,334) = rxt(k,188)*y(k,92) - mat(k,165) = rxt(k,178)*y(k,66) + rxt(k,177)*y(k,85) + rxt(k,179)*y(k,96) - mat(k,493) = mat(k,493) + rxt(k,170)*y(k,27) + rxt(k,178)*y(k,52) - mat(k,677) = rxt(k,161)*y(k,85) - mat(k,67) = rxt(k,257)*y(k,75) - mat(k,290) = mat(k,290) + rxt(k,257)*y(k,69) - mat(k,422) = rxt(k,177)*y(k,52) + rxt(k,161)*y(k,68) + rxt(k,160)*y(k,87) - mat(k,397) = mat(k,397) + rxt(k,160)*y(k,85) - mat(k,540) = rxt(k,188)*y(k,47) - mat(k,655) = mat(k,655) + rxt(k,179)*y(k,52) - mat(k,262) = -(rxt(k,168)*y(k,85) + rxt(k,170)*y(k,66) + rxt(k,171)*y(k,96) & - + (rxt(k,274) + rxt(k,279) + rxt(k,284)) * y(k,47)) - mat(k,413) = -rxt(k,168)*y(k,27) - mat(k,483) = -rxt(k,170)*y(k,27) - mat(k,645) = -rxt(k,171)*y(k,27) - mat(k,325) = -(rxt(k,274) + rxt(k,279) + rxt(k,284)) * y(k,27) - mat(k,440) = rxt(k,169)*y(k,60) - mat(k,695) = rxt(k,169)*y(k,26) - mat(k,103) = -((rxt(k,242) + rxt(k,246)) * y(k,96)) - mat(k,637) = -(rxt(k,242) + rxt(k,246)) * y(k,29) - mat(k,505) = rxt(k,235)*y(k,61) + rxt(k,236)*y(k,66) + rxt(k,191)*y(k,84) & - + rxt(k,155)*y(k,85) + rxt(k,237)*y(k,96) - mat(k,362) = rxt(k,235)*y(k,16) - mat(k,467) = rxt(k,236)*y(k,16) + rxt(k,247)*y(k,70) - mat(k,70) = rxt(k,247)*y(k,66) + rxt(k,248)*y(k,96) - mat(k,307) = rxt(k,191)*y(k,16) - mat(k,410) = rxt(k,155)*y(k,16) - mat(k,637) = mat(k,637) + rxt(k,237)*y(k,16) + rxt(k,248)*y(k,70) - mat(k,27) = -(rxt(k,216)*y(k,92)) - mat(k,527) = -rxt(k,216)*y(k,31) - mat(k,37) = -(rxt(k,217)*y(k,92)) - mat(k,529) = -rxt(k,217)*y(k,32) - mat(k,58) = -(rxt(k,261)*y(k,61) + (rxt(k,262) + rxt(k,263)) * y(k,96)) - mat(k,361) = -rxt(k,261)*y(k,33) - mat(k,633) = -(rxt(k,262) + rxt(k,263)) * y(k,33) - mat(k,153) = -(rxt(k,213)*y(k,39) + rxt(k,214)*y(k,100) + rxt(k,215)*y(k,49)) - mat(k,553) = -rxt(k,213)*y(k,37) - mat(k,743) = -rxt(k,214)*y(k,37) - mat(k,273) = -rxt(k,215)*y(k,37) - mat(k,28) = 2.000_r8*rxt(k,216)*y(k,92) - mat(k,38) = rxt(k,217)*y(k,92) - mat(k,530) = 2.000_r8*rxt(k,216)*y(k,31) + rxt(k,217)*y(k,32) - mat(k,299) = -((rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,87) + rxt(k,116) & - *y(k,67) + rxt(k,119)*y(k,68)) - mat(k,390) = -(rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,38) - mat(k,614) = -rxt(k,116)*y(k,38) - mat(k,672) = -rxt(k,119)*y(k,38) - mat(k,508) = rxt(k,237)*y(k,96) - mat(k,104) = rxt(k,246)*y(k,96) - mat(k,155) = rxt(k,213)*y(k,39) - mat(k,555) = rxt(k,213)*y(k,37) + rxt(k,111)*y(k,66) + rxt(k,157)*y(k,85) & - + rxt(k,94)*y(k,92) + rxt(k,120)*y(k,96) - mat(k,179) = rxt(k,211)*y(k,92) - mat(k,327) = rxt(k,188)*y(k,92) - mat(k,245) = rxt(k,143)*y(k,96) - mat(k,486) = rxt(k,111)*y(k,39) + rxt(k,123)*y(k,96) - mat(k,74) = rxt(k,248)*y(k,96) - mat(k,133) = rxt(k,253)*y(k,96) - mat(k,286) = rxt(k,258)*y(k,96) - mat(k,415) = rxt(k,157)*y(k,39) - mat(k,533) = rxt(k,94)*y(k,39) + rxt(k,211)*y(k,43) + rxt(k,188)*y(k,47) - mat(k,648) = rxt(k,237)*y(k,16) + rxt(k,246)*y(k,29) + rxt(k,120)*y(k,39) & - + rxt(k,143)*y(k,53) + rxt(k,123)*y(k,66) + rxt(k,248)*y(k,70) & - + rxt(k,253)*y(k,73) + rxt(k,258)*y(k,75) - mat(k,565) = -(rxt(k,94)*y(k,92) + rxt(k,111)*y(k,66) + rxt(k,120)*y(k,96) & - + rxt(k,157)*y(k,85) + rxt(k,213)*y(k,37)) - mat(k,544) = -rxt(k,94)*y(k,39) - mat(k,497) = -rxt(k,111)*y(k,39) - mat(k,659) = -rxt(k,120)*y(k,39) - mat(k,426) = -rxt(k,157)*y(k,39) - mat(k,158) = -rxt(k,213)*y(k,39) - mat(k,302) = rxt(k,113)*y(k,87) - mat(k,401) = rxt(k,113)*y(k,38) - mat(k,115) = -(rxt(k,112)*y(k,66) + rxt(k,121)*y(k,96) + rxt(k,158)*y(k,85)) - mat(k,469) = -rxt(k,112)*y(k,41) - mat(k,638) = -rxt(k,121)*y(k,41) - mat(k,411) = -rxt(k,158)*y(k,41) - mat(k,386) = 2.000_r8*rxt(k,127)*y(k,87) - mat(k,638) = mat(k,638) + 2.000_r8*rxt(k,126)*y(k,96) - mat(k,47) = rxt(k,260)*y(k,100) - mat(k,740) = rxt(k,260)*y(k,77) - mat(k,178) = -(rxt(k,204)*y(k,66) + rxt(k,205)*y(k,96) + (rxt(k,210) & - + rxt(k,211)) * y(k,92)) - mat(k,476) = -rxt(k,204)*y(k,43) - mat(k,642) = -rxt(k,205)*y(k,43) - mat(k,531) = -(rxt(k,210) + rxt(k,211)) * y(k,43) - mat(k,506) = rxt(k,191)*y(k,84) - mat(k,308) = rxt(k,191)*y(k,16) + rxt(k,192)*y(k,87) - mat(k,389) = rxt(k,192)*y(k,84) - mat(k,329) = -(rxt(k,175)*y(k,66) + rxt(k,176)*y(k,96) + (rxt(k,187) & - + rxt(k,188)) * y(k,92) + (rxt(k,269) + rxt(k,275) + rxt(k,280) & - ) * y(k,52) + (rxt(k,274) + rxt(k,279) + rxt(k,284)) * y(k,27) & - + (rxt(k,276) + rxt(k,281)) * y(k,51)) - mat(k,488) = -rxt(k,175)*y(k,47) - mat(k,650) = -rxt(k,176)*y(k,47) - mat(k,535) = -(rxt(k,187) + rxt(k,188)) * y(k,47) - mat(k,163) = -(rxt(k,269) + rxt(k,275) + rxt(k,280)) * y(k,47) - mat(k,264) = -(rxt(k,274) + rxt(k,279) + rxt(k,284)) * y(k,47) - mat(k,146) = -(rxt(k,276) + rxt(k,281)) * y(k,47) - mat(k,510) = rxt(k,155)*y(k,85) - mat(k,445) = rxt(k,174)*y(k,96) - mat(k,556) = rxt(k,157)*y(k,85) - mat(k,116) = rxt(k,158)*y(k,85) - mat(k,163) = mat(k,163) + rxt(k,177)*y(k,85) - mat(k,417) = rxt(k,155)*y(k,16) + rxt(k,157)*y(k,39) + rxt(k,158)*y(k,41) & - + rxt(k,177)*y(k,52) + rxt(k,159)*y(k,87) - mat(k,392) = rxt(k,159)*y(k,85) - mat(k,650) = mat(k,650) + rxt(k,174)*y(k,26) - mat(k,152) = rxt(k,213)*y(k,39) + rxt(k,215)*y(k,49) + rxt(k,214)*y(k,100) - mat(k,552) = rxt(k,213)*y(k,37) - mat(k,272) = rxt(k,215)*y(k,37) - mat(k,741) = rxt(k,214)*y(k,37) - mat(k,274) = -(rxt(k,152)*y(k,96) + rxt(k,215)*y(k,37)) - mat(k,646) = -rxt(k,152)*y(k,49) - mat(k,154) = -rxt(k,215)*y(k,49) - mat(k,507) = rxt(k,235)*y(k,61) - mat(k,263) = (rxt(k,274)+rxt(k,279)+rxt(k,284))*y(k,47) - mat(k,60) = rxt(k,261)*y(k,61) - mat(k,326) = (rxt(k,274)+rxt(k,279)+rxt(k,284))*y(k,27) - mat(k,696) = rxt(k,151)*y(k,96) - mat(k,364) = rxt(k,235)*y(k,16) + rxt(k,261)*y(k,33) - mat(k,646) = mat(k,646) + rxt(k,151)*y(k,60) - mat(k,83) = -(rxt(k,128)*y(k,96)) - mat(k,636) = -rxt(k,128)*y(k,50) - mat(k,690) = rxt(k,149)*y(k,87) - mat(k,385) = rxt(k,149)*y(k,60) - mat(k,144) = -(rxt(k,206)*y(k,66) + (rxt(k,276) + rxt(k,281)) * y(k,47)) - mat(k,473) = -rxt(k,206)*y(k,51) - mat(k,323) = -(rxt(k,276) + rxt(k,281)) * y(k,51) - mat(k,576) = rxt(k,198)*y(k,87) - mat(k,387) = rxt(k,198)*y(k,4) - mat(k,162) = -(rxt(k,177)*y(k,85) + rxt(k,178)*y(k,66) + rxt(k,179)*y(k,96) & - + (rxt(k,269) + rxt(k,275) + rxt(k,280)) * y(k,47)) - mat(k,412) = -rxt(k,177)*y(k,52) - mat(k,474) = -rxt(k,178)*y(k,52) - mat(k,641) = -rxt(k,179)*y(k,52) - mat(k,324) = -(rxt(k,269) + rxt(k,275) + rxt(k,280)) * y(k,52) - mat(k,438) = rxt(k,166)*y(k,87) - mat(k,261) = rxt(k,171)*y(k,96) - mat(k,388) = rxt(k,166)*y(k,26) - mat(k,641) = mat(k,641) + rxt(k,171)*y(k,27) + mat(k,767) = -(rxt(k,191)*y(k,17) + rxt(k,192)*y(k,87) + rxt(k,193)*y(k,70)) + mat(k,482) = -rxt(k,191)*y(k,3) + mat(k,559) = -rxt(k,192)*y(k,3) + mat(k,534) = -rxt(k,193)*y(k,3) + mat(k,745) = 4.000_r8*rxt(k,194)*y(k,5) + (rxt(k,195)+rxt(k,196))*y(k,28) & + + rxt(k,199)*y(k,61) + rxt(k,202)*y(k,68) + rxt(k,253)*y(k,77) & + + rxt(k,203)*y(k,96) + mat(k,56) = rxt(k,181)*y(k,92) + mat(k,62) = rxt(k,207)*y(k,92) + mat(k,167) = 2.000_r8*rxt(k,218)*y(k,25) + 2.000_r8*rxt(k,230)*y(k,92) & + + 2.000_r8*rxt(k,219)*y(k,96) + mat(k,212) = rxt(k,220)*y(k,25) + rxt(k,231)*y(k,92) + rxt(k,221)*y(k,96) + mat(k,155) = 3.000_r8*rxt(k,225)*y(k,25) + 3.000_r8*rxt(k,208)*y(k,92) & + + 3.000_r8*rxt(k,226)*y(k,96) + mat(k,900) = 2.000_r8*rxt(k,218)*y(k,16) + rxt(k,220)*y(k,18) & + + 3.000_r8*rxt(k,225)*y(k,24) + mat(k,587) = (rxt(k,195)+rxt(k,196))*y(k,5) + mat(k,33) = 2.000_r8*rxt(k,209)*y(k,92) + mat(k,258) = rxt(k,204)*y(k,68) + rxt(k,210)*y(k,92) + rxt(k,205)*y(k,96) + mat(k,679) = rxt(k,199)*y(k,5) + mat(k,654) = rxt(k,202)*y(k,5) + rxt(k,204)*y(k,45) + mat(k,431) = rxt(k,253)*y(k,5) + mat(k,721) = rxt(k,181)*y(k,9) + rxt(k,207)*y(k,10) + 2.000_r8*rxt(k,230) & + *y(k,16) + rxt(k,231)*y(k,18) + 3.000_r8*rxt(k,208)*y(k,24) & + + 2.000_r8*rxt(k,209)*y(k,42) + rxt(k,210)*y(k,45) + mat(k,845) = rxt(k,203)*y(k,5) + 2.000_r8*rxt(k,219)*y(k,16) + rxt(k,221) & + *y(k,18) + 3.000_r8*rxt(k,226)*y(k,24) + rxt(k,205)*y(k,45) + mat(k,728) = rxt(k,197)*y(k,28) + mat(k,568) = rxt(k,197)*y(k,5) + mat(k,445) = (rxt(k,275)+rxt(k,280))*y(k,53) + mat(k,244) = (rxt(k,275)+rxt(k,280))*y(k,49) + mat(k,744) = -(4._r8*rxt(k,194)*y(k,5) + (rxt(k,195) + rxt(k,196) + rxt(k,197) & + ) * y(k,28) + rxt(k,198)*y(k,87) + rxt(k,199)*y(k,61) + rxt(k,200) & + *y(k,62) + rxt(k,202)*y(k,68) + rxt(k,203)*y(k,96) + rxt(k,253) & + *y(k,77)) + mat(k,586) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,5) + mat(k,558) = -rxt(k,198)*y(k,5) + mat(k,678) = -rxt(k,199)*y(k,5) + mat(k,795) = -rxt(k,200)*y(k,5) + mat(k,653) = -rxt(k,202)*y(k,5) + mat(k,844) = -rxt(k,203)*y(k,5) + mat(k,430) = -rxt(k,253)*y(k,5) + mat(k,766) = rxt(k,193)*y(k,70) + mat(k,203) = rxt(k,201)*y(k,68) + mat(k,257) = rxt(k,211)*y(k,92) + mat(k,248) = rxt(k,206)*y(k,68) + mat(k,653) = mat(k,653) + rxt(k,201)*y(k,6) + rxt(k,206)*y(k,53) + mat(k,533) = rxt(k,193)*y(k,3) + mat(k,720) = rxt(k,211)*y(k,45) + mat(k,199) = -(rxt(k,201)*y(k,68)) + mat(k,624) = -rxt(k,201)*y(k,6) + mat(k,730) = rxt(k,200)*y(k,62) + mat(k,777) = rxt(k,200)*y(k,5) + mat(k,27) = -(rxt(k,180)*y(k,92)) + mat(k,686) = -rxt(k,180)*y(k,8) + mat(k,53) = -(rxt(k,181)*y(k,92)) + mat(k,691) = -rxt(k,181)*y(k,9) + mat(k,58) = -(rxt(k,207)*y(k,92)) + mat(k,692) = -rxt(k,207)*y(k,10) + mat(k,34) = -(rxt(k,182)*y(k,92)) + mat(k,688) = -rxt(k,182)*y(k,11) + mat(k,63) = -(rxt(k,183)*y(k,92)) + mat(k,693) = -rxt(k,183)*y(k,12) + mat(k,38) = -(rxt(k,184)*y(k,92)) + mat(k,689) = -rxt(k,184)*y(k,13) + mat(k,68) = -(rxt(k,185)*y(k,92)) + mat(k,694) = -rxt(k,185)*y(k,14) + mat(k,42) = -(rxt(k,186)*y(k,92)) + mat(k,690) = -rxt(k,186)*y(k,15) + mat(k,164) = -(rxt(k,218)*y(k,25) + rxt(k,219)*y(k,96) + rxt(k,230)*y(k,92)) + mat(k,878) = -rxt(k,218)*y(k,16) + mat(k,815) = -rxt(k,219)*y(k,16) + mat(k,703) = -rxt(k,230)*y(k,16) + mat(k,472) = -(rxt(k,155)*y(k,25) + rxt(k,191)*y(k,3) + rxt(k,235)*y(k,63) & + + rxt(k,236)*y(k,68) + rxt(k,237)*y(k,96)) + mat(k,890) = -rxt(k,155)*y(k,17) + mat(k,757) = -rxt(k,191)*y(k,17) + mat(k,602) = -rxt(k,235)*y(k,17) + mat(k,644) = -rxt(k,236)*y(k,17) + mat(k,835) = -rxt(k,237)*y(k,17) + mat(k,410) = rxt(k,162)*y(k,28) + rxt(k,239)*y(k,61) + mat(k,161) = .300_r8*rxt(k,240)*y(k,96) + mat(k,394) = (rxt(k,243)+rxt(k,244))*y(k,92) + mat(k,577) = rxt(k,162)*y(k,21) + mat(k,669) = rxt(k,239)*y(k,21) + mat(k,711) = (rxt(k,243)+rxt(k,244))*y(k,23) + mat(k,835) = mat(k,835) + .300_r8*rxt(k,240)*y(k,22) + mat(k,207) = -(rxt(k,220)*y(k,25) + rxt(k,221)*y(k,96) + rxt(k,231)*y(k,92)) + mat(k,879) = -rxt(k,220)*y(k,18) + mat(k,818) = -rxt(k,221)*y(k,18) + mat(k,704) = -rxt(k,231)*y(k,18) + mat(k,46) = -(rxt(k,222)*y(k,96)) + mat(k,803) = -rxt(k,222)*y(k,19) + mat(k,144) = -(rxt(k,223)*y(k,25) + rxt(k,224)*y(k,96)) + mat(k,876) = -rxt(k,223)*y(k,20) + mat(k,812) = -rxt(k,224)*y(k,20) + mat(k,408) = -(rxt(k,162)*y(k,28) + rxt(k,238)*y(k,87) + rxt(k,239)*y(k,61)) + mat(k,573) = -rxt(k,162)*y(k,21) + mat(k,546) = -rxt(k,238)*y(k,21) + mat(k,667) = -rxt(k,239)*y(k,21) + mat(k,159) = .700_r8*rxt(k,240)*y(k,96) + mat(k,391) = rxt(k,156)*y(k,25) + rxt(k,212)*y(k,39) + rxt(k,242)*y(k,92) & + + rxt(k,241)*y(k,96) + mat(k,887) = rxt(k,156)*y(k,23) + mat(k,289) = rxt(k,212)*y(k,23) + mat(k,708) = rxt(k,242)*y(k,23) + mat(k,831) = .700_r8*rxt(k,240)*y(k,22) + rxt(k,241)*y(k,23) + mat(k,158) = -(rxt(k,240)*y(k,96)) + mat(k,814) = -rxt(k,240)*y(k,22) + mat(k,407) = rxt(k,238)*y(k,87) + mat(k,540) = rxt(k,238)*y(k,21) + mat(k,390) = -(rxt(k,156)*y(k,25) + rxt(k,212)*y(k,39) + rxt(k,241)*y(k,96) & + + (rxt(k,242) + rxt(k,243) + rxt(k,244)) * y(k,92)) + mat(k,886) = -rxt(k,156)*y(k,23) + mat(k,288) = -rxt(k,212)*y(k,23) + mat(k,830) = -rxt(k,241)*y(k,23) + mat(k,707) = -(rxt(k,242) + rxt(k,243) + rxt(k,244)) * y(k,23) + mat(k,152) = -(rxt(k,208)*y(k,92) + rxt(k,225)*y(k,25) + rxt(k,226)*y(k,96)) + mat(k,702) = -rxt(k,208)*y(k,24) + mat(k,877) = -rxt(k,225)*y(k,24) + mat(k,813) = -rxt(k,226)*y(k,24) + mat(k,904) = -(rxt(k,155)*y(k,17) + rxt(k,156)*y(k,23) + rxt(k,157)*y(k,41) & + + rxt(k,158)*y(k,43) + (rxt(k,159) + rxt(k,160)) * y(k,87) & + + rxt(k,161)*y(k,70) + rxt(k,168)*y(k,29) + rxt(k,177)*y(k,54) & + + rxt(k,218)*y(k,16) + rxt(k,220)*y(k,18) + rxt(k,223)*y(k,20) & + + rxt(k,225)*y(k,24)) + mat(k,486) = -rxt(k,155)*y(k,25) + mat(k,404) = -rxt(k,156)*y(k,25) + mat(k,927) = -rxt(k,157)*y(k,25) + mat(k,221) = -rxt(k,158)*y(k,25) + mat(k,563) = -(rxt(k,159) + rxt(k,160)) * y(k,25) + mat(k,537) = -rxt(k,161)*y(k,25) + mat(k,313) = -rxt(k,168)*y(k,25) + mat(k,267) = -rxt(k,177)*y(k,25) + mat(k,169) = -rxt(k,218)*y(k,25) + mat(k,214) = -rxt(k,220)*y(k,25) + mat(k,150) = -rxt(k,223)*y(k,25) + mat(k,157) = -rxt(k,225)*y(k,25) + mat(k,749) = rxt(k,196)*y(k,28) + mat(k,29) = 4.000_r8*rxt(k,180)*y(k,92) + mat(k,57) = rxt(k,181)*y(k,92) + mat(k,37) = 2.000_r8*rxt(k,182)*y(k,92) + mat(k,67) = 2.000_r8*rxt(k,183)*y(k,92) + mat(k,41) = 2.000_r8*rxt(k,184)*y(k,92) + mat(k,72) = rxt(k,185)*y(k,92) + mat(k,45) = 2.000_r8*rxt(k,186)*y(k,92) + mat(k,48) = 3.000_r8*rxt(k,222)*y(k,96) + mat(k,150) = mat(k,150) + rxt(k,224)*y(k,96) + mat(k,417) = rxt(k,162)*y(k,28) + mat(k,591) = rxt(k,196)*y(k,5) + rxt(k,162)*y(k,21) + (4.000_r8*rxt(k,163) & + +2.000_r8*rxt(k,165))*y(k,28) + rxt(k,167)*y(k,61) + rxt(k,172) & + *y(k,68) + rxt(k,254)*y(k,77) + rxt(k,173)*y(k,96) + mat(k,88) = rxt(k,217)*y(k,92) + mat(k,84) = rxt(k,232)*y(k,92) + rxt(k,227)*y(k,96) + mat(k,93) = rxt(k,233)*y(k,92) + rxt(k,228)*y(k,96) + mat(k,114) = rxt(k,234)*y(k,92) + rxt(k,229)*y(k,96) + mat(k,463) = rxt(k,175)*y(k,68) + rxt(k,187)*y(k,92) + rxt(k,176)*y(k,96) + mat(k,683) = rxt(k,167)*y(k,28) + mat(k,658) = rxt(k,172)*y(k,28) + rxt(k,175)*y(k,49) + mat(k,434) = rxt(k,254)*y(k,28) + mat(k,725) = 4.000_r8*rxt(k,180)*y(k,8) + rxt(k,181)*y(k,9) & + + 2.000_r8*rxt(k,182)*y(k,11) + 2.000_r8*rxt(k,183)*y(k,12) & + + 2.000_r8*rxt(k,184)*y(k,13) + rxt(k,185)*y(k,14) & + + 2.000_r8*rxt(k,186)*y(k,15) + rxt(k,217)*y(k,34) + rxt(k,232) & + *y(k,46) + rxt(k,233)*y(k,47) + rxt(k,234)*y(k,48) + rxt(k,187) & + *y(k,49) + mat(k,849) = 3.000_r8*rxt(k,222)*y(k,19) + rxt(k,224)*y(k,20) + rxt(k,173) & + *y(k,28) + rxt(k,227)*y(k,46) + rxt(k,228)*y(k,47) + rxt(k,229) & + *y(k,48) + rxt(k,176)*y(k,49) + mat(k,875) = rxt(k,168)*y(k,29) + mat(k,567) = 2.000_r8*rxt(k,164)*y(k,28) + mat(k,303) = rxt(k,168)*y(k,25) + (rxt(k,273)+rxt(k,278)+rxt(k,283))*y(k,49) + mat(k,444) = (rxt(k,273)+rxt(k,278)+rxt(k,283))*y(k,29) + (rxt(k,268) & + +rxt(k,274)+rxt(k,279))*y(k,54) + mat(k,261) = (rxt(k,268)+rxt(k,274)+rxt(k,279))*y(k,49) + mat(k,566) = 2.000_r8*rxt(k,189)*y(k,28) + mat(k,581) = -(rxt(k,162)*y(k,21) + (4._r8*rxt(k,163) + 4._r8*rxt(k,164) & + + 4._r8*rxt(k,165) + 4._r8*rxt(k,189)) * y(k,28) + rxt(k,166) & + *y(k,87) + rxt(k,167)*y(k,61) + rxt(k,169)*y(k,62) + rxt(k,172) & + *y(k,68) + (rxt(k,173) + rxt(k,174)) * y(k,96) + (rxt(k,195) & + + rxt(k,196) + rxt(k,197)) * y(k,5) + rxt(k,254)*y(k,77)) + mat(k,413) = -rxt(k,162)*y(k,28) + mat(k,553) = -rxt(k,166)*y(k,28) + mat(k,673) = -rxt(k,167)*y(k,28) + mat(k,790) = -rxt(k,169)*y(k,28) + mat(k,648) = -rxt(k,172)*y(k,28) + mat(k,839) = -(rxt(k,173) + rxt(k,174)) * y(k,28) + mat(k,739) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,28) + mat(k,427) = -rxt(k,254)*y(k,28) + mat(k,894) = rxt(k,177)*y(k,54) + rxt(k,161)*y(k,70) + rxt(k,160)*y(k,87) + mat(k,307) = rxt(k,170)*y(k,68) + mat(k,454) = rxt(k,188)*y(k,92) + mat(k,264) = rxt(k,177)*y(k,25) + rxt(k,178)*y(k,68) + rxt(k,179)*y(k,96) + mat(k,648) = mat(k,648) + rxt(k,170)*y(k,29) + rxt(k,178)*y(k,54) + mat(k,528) = rxt(k,161)*y(k,25) + mat(k,134) = rxt(k,259)*y(k,77) + mat(k,427) = mat(k,427) + rxt(k,259)*y(k,71) + mat(k,553) = mat(k,553) + rxt(k,160)*y(k,25) + mat(k,715) = rxt(k,188)*y(k,49) + mat(k,839) = mat(k,839) + rxt(k,179)*y(k,54) + mat(k,305) = -(rxt(k,168)*y(k,25) + rxt(k,170)*y(k,68) + rxt(k,171)*y(k,96) & + + (rxt(k,273) + rxt(k,278) + rxt(k,283)) * y(k,49)) + mat(k,883) = -rxt(k,168)*y(k,29) + mat(k,635) = -rxt(k,170)*y(k,29) + mat(k,826) = -rxt(k,171)*y(k,29) + mat(k,448) = -(rxt(k,273) + rxt(k,278) + rxt(k,283)) * y(k,29) + mat(k,572) = rxt(k,169)*y(k,62) + mat(k,780) = rxt(k,169)*y(k,28) end do end subroutine nlnmat01 subroutine nlnmat02( avec_len, mat, y, rxt ) @@ -252,212 +250,460 @@ subroutine nlnmat02( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,244) = -(rxt(k,131)*y(k,59) + (rxt(k,132) + rxt(k,133) + rxt(k,134) & - ) * y(k,60) + rxt(k,135)*y(k,67) + rxt(k,143)*y(k,96) + rxt(k,297) & + mat(k,279) = -(rxt(k,245)*y(k,96)) + mat(k,823) = -rxt(k,245)*y(k,31) + mat(k,753) = rxt(k,191)*y(k,17) + mat(k,467) = rxt(k,191)*y(k,3) + rxt(k,155)*y(k,25) + rxt(k,235)*y(k,63) & + + rxt(k,236)*y(k,68) + rxt(k,237)*y(k,96) + mat(k,145) = rxt(k,223)*y(k,25) + mat(k,882) = rxt(k,155)*y(k,17) + rxt(k,223)*y(k,20) + mat(k,194) = rxt(k,299)*y(k,97) + mat(k,596) = rxt(k,235)*y(k,17) + mat(k,633) = rxt(k,236)*y(k,17) + rxt(k,248)*y(k,72) + mat(k,138) = rxt(k,248)*y(k,68) + rxt(k,249)*y(k,96) + mat(k,823) = mat(k,823) + rxt(k,237)*y(k,17) + rxt(k,249)*y(k,72) + mat(k,370) = rxt(k,299)*y(k,32) + mat(k,193) = -(rxt(k,299)*y(k,97)) + mat(k,367) = -rxt(k,299)*y(k,32) + mat(k,278) = rxt(k,245)*y(k,96) + mat(k,817) = rxt(k,245)*y(k,31) + mat(k,94) = -(rxt(k,216)*y(k,92)) + mat(k,699) = -rxt(k,216)*y(k,33) + mat(k,54) = rxt(k,181)*y(k,92) + mat(k,59) = rxt(k,207)*y(k,92) + mat(k,65) = rxt(k,183)*y(k,92) + mat(k,39) = 2.000_r8*rxt(k,184)*y(k,92) + mat(k,69) = 2.000_r8*rxt(k,185)*y(k,92) + mat(k,43) = rxt(k,186)*y(k,92) + mat(k,31) = 2.000_r8*rxt(k,209)*y(k,92) + mat(k,90) = rxt(k,233)*y(k,92) + rxt(k,228)*y(k,96) + mat(k,109) = rxt(k,234)*y(k,92) + rxt(k,229)*y(k,96) + mat(k,699) = mat(k,699) + rxt(k,181)*y(k,9) + rxt(k,207)*y(k,10) + rxt(k,183) & + *y(k,12) + 2.000_r8*rxt(k,184)*y(k,13) + 2.000_r8*rxt(k,185) & + *y(k,14) + rxt(k,186)*y(k,15) + 2.000_r8*rxt(k,209)*y(k,42) & + + rxt(k,233)*y(k,47) + rxt(k,234)*y(k,48) + mat(k,807) = rxt(k,228)*y(k,47) + rxt(k,229)*y(k,48) + mat(k,85) = -(rxt(k,217)*y(k,92)) + mat(k,697) = -rxt(k,217)*y(k,34) + mat(k,35) = rxt(k,182)*y(k,92) + mat(k,64) = rxt(k,183)*y(k,92) + mat(k,81) = rxt(k,232)*y(k,92) + rxt(k,227)*y(k,96) + mat(k,697) = mat(k,697) + rxt(k,182)*y(k,11) + rxt(k,183)*y(k,12) & + + rxt(k,232)*y(k,46) + mat(k,805) = rxt(k,227)*y(k,46) + mat(k,125) = -(rxt(k,246)*y(k,63) + (rxt(k,247) + rxt(k,261)) * y(k,96)) + mat(k,595) = -rxt(k,246)*y(k,35) + mat(k,810) = -(rxt(k,247) + rxt(k,261)) * y(k,35) + mat(k,287) = -(rxt(k,212)*y(k,23) + rxt(k,213)*y(k,41) + rxt(k,214)*y(k,100) & + + rxt(k,215)*y(k,51)) + mat(k,387) = -rxt(k,212)*y(k,39) + mat(k,908) = -rxt(k,213)*y(k,39) + mat(k,933) = -rxt(k,214)*y(k,39) + mat(k,853) = -rxt(k,215)*y(k,39) + mat(k,60) = rxt(k,207)*y(k,92) + mat(k,70) = rxt(k,185)*y(k,92) + mat(k,95) = 2.000_r8*rxt(k,216)*y(k,92) + mat(k,86) = rxt(k,217)*y(k,92) + mat(k,706) = rxt(k,207)*y(k,10) + rxt(k,185)*y(k,14) + 2.000_r8*rxt(k,216) & + *y(k,33) + rxt(k,217)*y(k,34) + mat(k,436) = -((rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,87) + rxt(k,116) & + *y(k,69) + rxt(k,119)*y(k,70)) + mat(k,547) = -(rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,40) + mat(k,504) = -rxt(k,116)*y(k,40) + mat(k,524) = -rxt(k,119)*y(k,40) + mat(k,470) = rxt(k,237)*y(k,96) + mat(k,392) = rxt(k,243)*y(k,92) + mat(k,888) = rxt(k,157)*y(k,41) + mat(k,290) = rxt(k,213)*y(k,41) + mat(k,911) = rxt(k,157)*y(k,25) + rxt(k,213)*y(k,39) + rxt(k,111)*y(k,68) & + + rxt(k,94)*y(k,92) + rxt(k,120)*y(k,96) + mat(k,254) = rxt(k,211)*y(k,92) + mat(k,449) = rxt(k,188)*y(k,92) + mat(k,347) = rxt(k,143)*y(k,96) + mat(k,642) = rxt(k,111)*y(k,41) + rxt(k,123)*y(k,96) + mat(k,141) = rxt(k,249)*y(k,96) + mat(k,234) = rxt(k,255)*y(k,96) + mat(k,423) = rxt(k,260)*y(k,96) + mat(k,709) = rxt(k,243)*y(k,23) + rxt(k,94)*y(k,41) + rxt(k,211)*y(k,45) & + + rxt(k,188)*y(k,49) + mat(k,833) = rxt(k,237)*y(k,17) + rxt(k,120)*y(k,41) + rxt(k,143)*y(k,55) & + + rxt(k,123)*y(k,68) + rxt(k,249)*y(k,72) + rxt(k,255)*y(k,75) & + + rxt(k,260)*y(k,77) + mat(k,928) = -(rxt(k,94)*y(k,92) + rxt(k,111)*y(k,68) + rxt(k,120)*y(k,96) & + + rxt(k,157)*y(k,25) + rxt(k,213)*y(k,39)) + mat(k,726) = -rxt(k,94)*y(k,41) + mat(k,659) = -rxt(k,111)*y(k,41) + mat(k,850) = -rxt(k,120)*y(k,41) + mat(k,905) = -rxt(k,157)*y(k,41) + mat(k,294) = -rxt(k,213)*y(k,41) + mat(k,405) = rxt(k,244)*y(k,92) + mat(k,442) = rxt(k,113)*y(k,87) + mat(k,564) = rxt(k,113)*y(k,40) + mat(k,726) = mat(k,726) + rxt(k,244)*y(k,23) + mat(k,30) = -(rxt(k,209)*y(k,92)) + mat(k,687) = -rxt(k,209)*y(k,42) + mat(k,216) = -(rxt(k,112)*y(k,68) + rxt(k,121)*y(k,96) + rxt(k,158)*y(k,25)) + mat(k,625) = -rxt(k,112)*y(k,43) + mat(k,819) = -rxt(k,121)*y(k,43) + mat(k,880) = -rxt(k,158)*y(k,43) + mat(k,542) = 2.000_r8*rxt(k,127)*y(k,87) + mat(k,819) = mat(k,819) + 2.000_r8*rxt(k,126)*y(k,96) + mat(k,104) = rxt(k,262)*y(k,100) + mat(k,930) = rxt(k,262)*y(k,79) + mat(k,253) = -(rxt(k,204)*y(k,68) + rxt(k,205)*y(k,96) + (rxt(k,210) & + + rxt(k,211)) * y(k,92)) + mat(k,630) = -rxt(k,204)*y(k,45) + mat(k,821) = -rxt(k,205)*y(k,45) + mat(k,705) = -(rxt(k,210) + rxt(k,211)) * y(k,45) + mat(k,752) = rxt(k,191)*y(k,17) + rxt(k,192)*y(k,87) + mat(k,466) = rxt(k,191)*y(k,3) + mat(k,544) = rxt(k,192)*y(k,3) + mat(k,80) = -(rxt(k,227)*y(k,96) + rxt(k,232)*y(k,92)) + mat(k,804) = -rxt(k,227)*y(k,46) + mat(k,696) = -rxt(k,232)*y(k,46) + mat(k,89) = -(rxt(k,228)*y(k,96) + rxt(k,233)*y(k,92)) + mat(k,806) = -rxt(k,228)*y(k,47) + mat(k,698) = -rxt(k,233)*y(k,47) + mat(k,110) = -(rxt(k,229)*y(k,96) + rxt(k,234)*y(k,92)) + mat(k,809) = -rxt(k,229)*y(k,48) + mat(k,701) = -rxt(k,234)*y(k,48) + mat(k,450) = -(rxt(k,175)*y(k,68) + rxt(k,176)*y(k,96) + (rxt(k,187) & + + rxt(k,188)) * y(k,92) + (rxt(k,268) + rxt(k,274) + rxt(k,279) & + ) * y(k,54) + (rxt(k,273) + rxt(k,278) + rxt(k,283)) * y(k,29) & + + (rxt(k,275) + rxt(k,280)) * y(k,53)) + mat(k,643) = -rxt(k,175)*y(k,49) + mat(k,834) = -rxt(k,176)*y(k,49) + mat(k,710) = -(rxt(k,187) + rxt(k,188)) * y(k,49) + mat(k,263) = -(rxt(k,268) + rxt(k,274) + rxt(k,279)) * y(k,49) + mat(k,306) = -(rxt(k,273) + rxt(k,278) + rxt(k,283)) * y(k,49) + mat(k,246) = -(rxt(k,275) + rxt(k,280)) * y(k,49) + mat(k,165) = rxt(k,218)*y(k,25) + mat(k,471) = rxt(k,155)*y(k,25) + mat(k,209) = rxt(k,220)*y(k,25) + mat(k,147) = 2.000_r8*rxt(k,223)*y(k,25) + mat(k,393) = rxt(k,156)*y(k,25) + mat(k,153) = rxt(k,225)*y(k,25) + mat(k,889) = rxt(k,218)*y(k,16) + rxt(k,155)*y(k,17) + rxt(k,220)*y(k,18) & + + 2.000_r8*rxt(k,223)*y(k,20) + rxt(k,156)*y(k,23) + rxt(k,225) & + *y(k,24) + rxt(k,157)*y(k,41) + rxt(k,158)*y(k,43) + rxt(k,177) & + *y(k,54) + rxt(k,159)*y(k,87) + mat(k,576) = rxt(k,174)*y(k,96) + mat(k,912) = rxt(k,157)*y(k,25) + mat(k,217) = rxt(k,158)*y(k,25) + mat(k,263) = mat(k,263) + rxt(k,177)*y(k,25) + mat(k,548) = rxt(k,159)*y(k,25) + mat(k,834) = mat(k,834) + rxt(k,174)*y(k,28) + mat(k,384) = rxt(k,212)*y(k,39) + mat(k,286) = rxt(k,212)*y(k,23) + rxt(k,213)*y(k,41) + rxt(k,215)*y(k,51) & + + rxt(k,214)*y(k,100) + mat(k,907) = rxt(k,213)*y(k,39) + mat(k,852) = rxt(k,215)*y(k,39) + mat(k,932) = rxt(k,214)*y(k,39) + mat(k,871) = -(rxt(k,152)*y(k,96) + rxt(k,215)*y(k,39)) + mat(k,848) = -rxt(k,152)*y(k,51) + mat(k,293) = -rxt(k,215)*y(k,51) + mat(k,485) = rxt(k,235)*y(k,63) + mat(k,312) = (rxt(k,273)+rxt(k,278)+rxt(k,283))*y(k,49) + mat(k,130) = rxt(k,246)*y(k,63) + mat(k,462) = (rxt(k,273)+rxt(k,278)+rxt(k,283))*y(k,29) + mat(k,799) = rxt(k,151)*y(k,96) + mat(k,615) = rxt(k,235)*y(k,17) + rxt(k,246)*y(k,35) + mat(k,848) = mat(k,848) + rxt(k,151)*y(k,62) + mat(k,171) = -(rxt(k,128)*y(k,96)) + mat(k,816) = -rxt(k,128)*y(k,52) + mat(k,776) = rxt(k,149)*y(k,87) + mat(k,541) = rxt(k,149)*y(k,62) + mat(k,245) = -(rxt(k,206)*y(k,68) + (rxt(k,275) + rxt(k,280)) * y(k,49)) + mat(k,629) = -rxt(k,206)*y(k,53) + mat(k,446) = -(rxt(k,275) + rxt(k,280)) * y(k,53) + mat(k,731) = rxt(k,198)*y(k,87) + mat(k,543) = rxt(k,198)*y(k,5) + mat(k,262) = -(rxt(k,177)*y(k,25) + rxt(k,178)*y(k,68) + rxt(k,179)*y(k,96) & + + (rxt(k,268) + rxt(k,274) + rxt(k,279)) * y(k,49)) + mat(k,881) = -rxt(k,177)*y(k,54) + mat(k,631) = -rxt(k,178)*y(k,54) + mat(k,822) = -rxt(k,179)*y(k,54) + mat(k,447) = -(rxt(k,268) + rxt(k,274) + rxt(k,279)) * y(k,54) + mat(k,570) = rxt(k,166)*y(k,87) + mat(k,304) = rxt(k,171)*y(k,96) + mat(k,545) = rxt(k,166)*y(k,28) + mat(k,822) = mat(k,822) + rxt(k,171)*y(k,29) + mat(k,344) = -(rxt(k,131)*y(k,61) + (rxt(k,132) + rxt(k,133) + rxt(k,134) & + ) * y(k,62) + rxt(k,135)*y(k,69) + rxt(k,143)*y(k,96) + rxt(k,296) & *y(k,95)) - mat(k,721) = -rxt(k,131)*y(k,53) - mat(k,693) = -(rxt(k,132) + rxt(k,133) + rxt(k,134)) * y(k,53) - mat(k,611) = -rxt(k,135)*y(k,53) - mat(k,643) = -rxt(k,143)*y(k,53) - mat(k,203) = -rxt(k,297)*y(k,53) - mat(k,481) = rxt(k,129)*y(k,88) + rxt(k,294)*y(k,91) - mat(k,611) = mat(k,611) + rxt(k,295)*y(k,91) - mat(k,217) = 1.100_r8*rxt(k,290)*y(k,89) + .200_r8*rxt(k,288)*y(k,90) - mat(k,230) = rxt(k,129)*y(k,66) - mat(k,128) = 1.100_r8*rxt(k,290)*y(k,86) - mat(k,141) = .200_r8*rxt(k,288)*y(k,86) - mat(k,175) = rxt(k,294)*y(k,66) + rxt(k,295)*y(k,67) - mat(k,689) = rxt(k,150)*y(k,61) - mat(k,360) = rxt(k,150)*y(k,60) - mat(k,738) = -(rxt(k,131)*y(k,53) + rxt(k,140)*y(k,61) + rxt(k,144)*y(k,87) & - + rxt(k,145)*y(k,68) + rxt(k,146)*y(k,66) + rxt(k,167)*y(k,26) & - + rxt(k,199)*y(k,4) + rxt(k,239)*y(k,20) + rxt(k,299)*y(k,95)) - mat(k,252) = -rxt(k,131)*y(k,59) - mat(k,382) = -rxt(k,140)*y(k,59) - mat(k,407) = -rxt(k,144)*y(k,59) - mat(k,687) = -rxt(k,145)*y(k,59) - mat(k,503) = -rxt(k,146)*y(k,59) - mat(k,460) = -rxt(k,167)*y(k,59) - mat(k,597) = -rxt(k,199)*y(k,59) - mat(k,358) = -rxt(k,239)*y(k,59) - mat(k,207) = -rxt(k,299)*y(k,59) - mat(k,252) = mat(k,252) + 2.000_r8*rxt(k,133)*y(k,60) + rxt(k,135)*y(k,67) & + mat(k,664) = -rxt(k,131)*y(k,55) + mat(k,781) = -(rxt(k,132) + rxt(k,133) + rxt(k,134)) * y(k,55) + mat(k,500) = -rxt(k,135)*y(k,55) + mat(k,827) = -rxt(k,143)*y(k,55) + mat(k,357) = -rxt(k,296)*y(k,55) + mat(k,638) = rxt(k,129)*y(k,88) + rxt(k,293)*y(k,91) + mat(k,500) = mat(k,500) + rxt(k,294)*y(k,91) + mat(k,322) = 1.100_r8*rxt(k,289)*y(k,89) + .200_r8*rxt(k,287)*y(k,90) + mat(k,332) = rxt(k,129)*y(k,68) + mat(k,227) = 1.100_r8*rxt(k,289)*y(k,86) + mat(k,242) = .200_r8*rxt(k,287)*y(k,86) + mat(k,273) = rxt(k,293)*y(k,68) + rxt(k,294)*y(k,69) + mat(k,100) = -((rxt(k,147) + rxt(k,148)) * y(k,92)) + mat(k,700) = -(rxt(k,147) + rxt(k,148)) * y(k,56) + mat(k,339) = rxt(k,132)*y(k,62) + mat(k,774) = rxt(k,132)*y(k,55) + mat(k,775) = rxt(k,150)*y(k,63) + mat(k,594) = rxt(k,150)*y(k,62) + mat(k,676) = -(rxt(k,131)*y(k,55) + rxt(k,140)*y(k,63) + rxt(k,144)*y(k,87) & + + rxt(k,145)*y(k,70) + rxt(k,146)*y(k,68) + rxt(k,167)*y(k,28) & + + rxt(k,199)*y(k,5) + rxt(k,239)*y(k,21) + rxt(k,298)*y(k,95)) + mat(k,350) = -rxt(k,131)*y(k,61) + mat(k,609) = -rxt(k,140)*y(k,61) + mat(k,556) = -rxt(k,144)*y(k,61) + mat(k,531) = -rxt(k,145)*y(k,61) + mat(k,651) = -rxt(k,146)*y(k,61) + mat(k,584) = -rxt(k,167)*y(k,61) + mat(k,742) = -rxt(k,199)*y(k,61) + mat(k,414) = -rxt(k,239)*y(k,61) + mat(k,363) = -rxt(k,298)*y(k,61) + mat(k,350) = mat(k,350) + 2.000_r8*rxt(k,133)*y(k,62) + rxt(k,135)*y(k,69) & + rxt(k,143)*y(k,96) - mat(k,715) = 2.000_r8*rxt(k,133)*y(k,53) + rxt(k,136)*y(k,66) + rxt(k,254) & - *y(k,75) - mat(k,503) = mat(k,503) + rxt(k,136)*y(k,60) - mat(k,628) = rxt(k,135)*y(k,53) + rxt(k,130)*y(k,88) - mat(k,297) = rxt(k,254)*y(k,60) - mat(k,237) = rxt(k,130)*y(k,67) - mat(k,665) = rxt(k,143)*y(k,53) - mat(k,714) = -((rxt(k,132) + rxt(k,133) + rxt(k,134)) * y(k,53) + (rxt(k,136) & - + rxt(k,138)) * y(k,66) + rxt(k,137)*y(k,68) + rxt(k,149) & - *y(k,87) + rxt(k,150)*y(k,61) + rxt(k,151)*y(k,96) + rxt(k,169) & - *y(k,26) + rxt(k,200)*y(k,4) + rxt(k,254)*y(k,75)) - mat(k,251) = -(rxt(k,132) + rxt(k,133) + rxt(k,134)) * y(k,60) - mat(k,502) = -(rxt(k,136) + rxt(k,138)) * y(k,60) - mat(k,686) = -rxt(k,137)*y(k,60) - mat(k,406) = -rxt(k,149)*y(k,60) - mat(k,381) = -rxt(k,150)*y(k,60) - mat(k,664) = -rxt(k,151)*y(k,60) - mat(k,459) = -rxt(k,169)*y(k,60) - mat(k,596) = -rxt(k,200)*y(k,60) - mat(k,296) = -rxt(k,254)*y(k,60) - mat(k,596) = mat(k,596) + rxt(k,199)*y(k,59) - mat(k,357) = rxt(k,239)*y(k,59) - mat(k,459) = mat(k,459) + rxt(k,167)*y(k,59) - mat(k,88) = rxt(k,128)*y(k,96) - mat(k,737) = rxt(k,199)*y(k,4) + rxt(k,239)*y(k,20) + rxt(k,167)*y(k,26) & - + 2.000_r8*rxt(k,140)*y(k,61) + rxt(k,146)*y(k,66) + rxt(k,145) & - *y(k,68) + rxt(k,144)*y(k,87) - mat(k,381) = mat(k,381) + 2.000_r8*rxt(k,140)*y(k,59) + rxt(k,141)*y(k,66) & + mat(k,102) = 2.000_r8*rxt(k,147)*y(k,92) + mat(k,793) = 2.000_r8*rxt(k,133)*y(k,55) + rxt(k,136)*y(k,68) + rxt(k,256) & + *y(k,77) + mat(k,651) = mat(k,651) + rxt(k,136)*y(k,62) + mat(k,510) = rxt(k,135)*y(k,55) + rxt(k,130)*y(k,88) + mat(k,429) = rxt(k,256)*y(k,62) + mat(k,337) = rxt(k,130)*y(k,69) + mat(k,718) = 2.000_r8*rxt(k,147)*y(k,56) + mat(k,842) = rxt(k,143)*y(k,55) + 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,797) = -((rxt(k,132) + rxt(k,133) + rxt(k,134)) * y(k,55) + (rxt(k,136) & + + rxt(k,138)) * y(k,68) + rxt(k,137)*y(k,70) + rxt(k,149) & + *y(k,87) + rxt(k,150)*y(k,63) + rxt(k,151)*y(k,96) + rxt(k,169) & + *y(k,28) + rxt(k,200)*y(k,5) + rxt(k,256)*y(k,77)) + mat(k,352) = -(rxt(k,132) + rxt(k,133) + rxt(k,134)) * y(k,62) + mat(k,655) = -(rxt(k,136) + rxt(k,138)) * y(k,62) + mat(k,535) = -rxt(k,137)*y(k,62) + mat(k,560) = -rxt(k,149)*y(k,62) + mat(k,613) = -rxt(k,150)*y(k,62) + mat(k,846) = -rxt(k,151)*y(k,62) + mat(k,588) = -rxt(k,169)*y(k,62) + mat(k,746) = -rxt(k,200)*y(k,62) + mat(k,432) = -rxt(k,256)*y(k,62) + mat(k,746) = mat(k,746) + rxt(k,199)*y(k,61) + mat(k,415) = rxt(k,239)*y(k,61) + mat(k,588) = mat(k,588) + rxt(k,167)*y(k,61) + mat(k,175) = rxt(k,128)*y(k,96) + mat(k,680) = rxt(k,199)*y(k,5) + rxt(k,239)*y(k,21) + rxt(k,167)*y(k,28) & + + 2.000_r8*rxt(k,140)*y(k,63) + rxt(k,146)*y(k,68) + rxt(k,145) & + *y(k,70) + rxt(k,144)*y(k,87) + mat(k,613) = mat(k,613) + 2.000_r8*rxt(k,140)*y(k,61) + rxt(k,141)*y(k,68) & + rxt(k,139)*y(k,87) + rxt(k,142)*y(k,96) - mat(k,502) = mat(k,502) + rxt(k,146)*y(k,59) + rxt(k,141)*y(k,61) - mat(k,686) = mat(k,686) + rxt(k,145)*y(k,59) - mat(k,406) = mat(k,406) + rxt(k,144)*y(k,59) + rxt(k,139)*y(k,61) - mat(k,664) = mat(k,664) + rxt(k,128)*y(k,50) + rxt(k,142)*y(k,61) - mat(k,369) = -(rxt(k,139)*y(k,87) + rxt(k,140)*y(k,59) + rxt(k,141)*y(k,66) & - + rxt(k,142)*y(k,96) + rxt(k,150)*y(k,60) + rxt(k,235)*y(k,16) & - + rxt(k,261)*y(k,33)) - mat(k,394) = -rxt(k,139)*y(k,61) - mat(k,725) = -rxt(k,140)*y(k,61) - mat(k,490) = -rxt(k,141)*y(k,61) - mat(k,652) = -rxt(k,142)*y(k,61) - mat(k,702) = -rxt(k,150)*y(k,61) - mat(k,512) = -rxt(k,235)*y(k,61) - mat(k,61) = -rxt(k,261)*y(k,61) - mat(k,111) = rxt(k,201)*y(k,66) - mat(k,265) = rxt(k,170)*y(k,66) + rxt(k,168)*y(k,85) + rxt(k,171)*y(k,96) - mat(k,157) = rxt(k,215)*y(k,49) - mat(k,277) = rxt(k,215)*y(k,37) + rxt(k,152)*y(k,96) - mat(k,702) = mat(k,702) + rxt(k,138)*y(k,66) + rxt(k,137)*y(k,68) - mat(k,490) = mat(k,490) + rxt(k,201)*y(k,5) + rxt(k,170)*y(k,27) + rxt(k,138) & - *y(k,60) - mat(k,674) = rxt(k,137)*y(k,60) - mat(k,419) = rxt(k,168)*y(k,27) - mat(k,652) = mat(k,652) + rxt(k,171)*y(k,27) + rxt(k,152)*y(k,49) - mat(k,494) = -(rxt(k,108)*y(k,68) + 4._r8*rxt(k,109)*y(k,66) + rxt(k,110) & - *y(k,67) + rxt(k,111)*y(k,39) + rxt(k,112)*y(k,41) + rxt(k,117) & + mat(k,655) = mat(k,655) + rxt(k,146)*y(k,61) + rxt(k,141)*y(k,63) + mat(k,535) = mat(k,535) + rxt(k,145)*y(k,61) + mat(k,560) = mat(k,560) + rxt(k,144)*y(k,61) + rxt(k,139)*y(k,63) + mat(k,846) = mat(k,846) + rxt(k,128)*y(k,52) + rxt(k,142)*y(k,63) + mat(k,607) = -(rxt(k,139)*y(k,87) + rxt(k,140)*y(k,61) + rxt(k,141)*y(k,68) & + + rxt(k,142)*y(k,96) + rxt(k,150)*y(k,62) + rxt(k,235)*y(k,17) & + + rxt(k,246)*y(k,35)) + mat(k,554) = -rxt(k,139)*y(k,63) + mat(k,674) = -rxt(k,140)*y(k,63) + mat(k,649) = -rxt(k,141)*y(k,63) + mat(k,840) = -rxt(k,142)*y(k,63) + mat(k,791) = -rxt(k,150)*y(k,63) + mat(k,477) = -rxt(k,235)*y(k,63) + mat(k,128) = -rxt(k,246)*y(k,63) + mat(k,201) = rxt(k,201)*y(k,68) + mat(k,895) = rxt(k,168)*y(k,29) + mat(k,308) = rxt(k,168)*y(k,25) + rxt(k,170)*y(k,68) + rxt(k,171)*y(k,96) + mat(k,291) = rxt(k,215)*y(k,51) + mat(k,863) = rxt(k,215)*y(k,39) + rxt(k,152)*y(k,96) + mat(k,791) = mat(k,791) + rxt(k,138)*y(k,68) + rxt(k,137)*y(k,70) + mat(k,649) = mat(k,649) + rxt(k,201)*y(k,6) + rxt(k,170)*y(k,29) + rxt(k,138) & + *y(k,62) + mat(k,529) = rxt(k,137)*y(k,62) + mat(k,840) = mat(k,840) + rxt(k,171)*y(k,29) + rxt(k,152)*y(k,51) + mat(k,650) = -(rxt(k,108)*y(k,70) + 4._r8*rxt(k,109)*y(k,68) + rxt(k,110) & + *y(k,69) + rxt(k,111)*y(k,41) + rxt(k,112)*y(k,43) + rxt(k,117) & *y(k,87) + rxt(k,123)*y(k,96) + (rxt(k,136) + rxt(k,138) & - ) * y(k,60) + rxt(k,141)*y(k,61) + rxt(k,146)*y(k,59) + rxt(k,170) & - *y(k,27) + rxt(k,172)*y(k,26) + rxt(k,175)*y(k,47) + rxt(k,178) & - *y(k,52) + rxt(k,201)*y(k,5) + rxt(k,202)*y(k,4) + rxt(k,204) & - *y(k,43) + rxt(k,206)*y(k,51) + rxt(k,236)*y(k,16) + rxt(k,247) & - *y(k,70) + (rxt(k,292) + rxt(k,293)) * y(k,89) + rxt(k,294) & + ) * y(k,62) + rxt(k,141)*y(k,63) + rxt(k,146)*y(k,61) + rxt(k,170) & + *y(k,29) + rxt(k,172)*y(k,28) + rxt(k,175)*y(k,49) + rxt(k,178) & + *y(k,54) + rxt(k,201)*y(k,6) + rxt(k,202)*y(k,5) + rxt(k,204) & + *y(k,45) + rxt(k,206)*y(k,53) + rxt(k,236)*y(k,17) + rxt(k,248) & + *y(k,72) + (rxt(k,291) + rxt(k,292)) * y(k,89) + rxt(k,293) & *y(k,91)) - mat(k,678) = -rxt(k,108)*y(k,66) - mat(k,619) = -rxt(k,110)*y(k,66) - mat(k,562) = -rxt(k,111)*y(k,66) - mat(k,119) = -rxt(k,112)*y(k,66) - mat(k,398) = -rxt(k,117)*y(k,66) - mat(k,656) = -rxt(k,123)*y(k,66) - mat(k,706) = -(rxt(k,136) + rxt(k,138)) * y(k,66) - mat(k,373) = -rxt(k,141)*y(k,66) - mat(k,729) = -rxt(k,146)*y(k,66) - mat(k,268) = -rxt(k,170)*y(k,66) - mat(k,451) = -rxt(k,172)*y(k,66) - mat(k,335) = -rxt(k,175)*y(k,66) - mat(k,166) = -rxt(k,178)*y(k,66) - mat(k,112) = -rxt(k,201)*y(k,66) - mat(k,588) = -rxt(k,202)*y(k,66) - mat(k,181) = -rxt(k,204)*y(k,66) - mat(k,148) = -rxt(k,206)*y(k,66) - mat(k,516) = -rxt(k,236)*y(k,66) - mat(k,75) = -rxt(k,247)*y(k,66) - mat(k,129) = -(rxt(k,292) + rxt(k,293)) * y(k,66) - mat(k,176) = -rxt(k,294)*y(k,66) - mat(k,301) = rxt(k,115)*y(k,87) - mat(k,247) = rxt(k,131)*y(k,59) + rxt(k,132)*y(k,60) + rxt(k,135)*y(k,67) & - + rxt(k,297)*y(k,95) - mat(k,729) = mat(k,729) + rxt(k,131)*y(k,53) - mat(k,706) = mat(k,706) + rxt(k,132)*y(k,53) - mat(k,619) = mat(k,619) + rxt(k,135)*y(k,53) + rxt(k,249)*y(k,73) & - + rxt(k,255)*y(k,75) + rxt(k,296)*y(k,91) + (rxt(k,97)+rxt(k,98)) & - *y(k,92) + rxt(k,303)*y(k,97) + rxt(k,307)*y(k,98) - mat(k,134) = rxt(k,249)*y(k,67) - mat(k,291) = rxt(k,255)*y(k,67) - mat(k,220) = rxt(k,288)*y(k,90) + 1.150_r8*rxt(k,289)*y(k,95) - mat(k,398) = mat(k,398) + rxt(k,115)*y(k,38) - mat(k,233) = rxt(k,302)*y(k,97) - mat(k,142) = rxt(k,288)*y(k,86) - mat(k,176) = mat(k,176) + rxt(k,296)*y(k,67) - mat(k,541) = (rxt(k,97)+rxt(k,98))*y(k,67) - mat(k,204) = rxt(k,297)*y(k,53) + 1.150_r8*rxt(k,289)*y(k,86) - mat(k,656) = mat(k,656) + 2.000_r8*rxt(k,125)*y(k,96) - mat(k,196) = rxt(k,303)*y(k,67) + rxt(k,302)*y(k,88) - mat(k,101) = rxt(k,307)*y(k,67) - mat(k,624) = -(rxt(k,97)*y(k,92) + rxt(k,102)*y(k,93) + rxt(k,110)*y(k,66) & - + rxt(k,116)*y(k,38) + rxt(k,130)*y(k,88) + rxt(k,135)*y(k,53) & - + rxt(k,249)*y(k,73) + rxt(k,255)*y(k,75) + rxt(k,291)*y(k,89) & - + (rxt(k,295) + rxt(k,296)) * y(k,91) + rxt(k,303)*y(k,97) & - + rxt(k,307)*y(k,98)) - mat(k,546) = -rxt(k,97)*y(k,67) - mat(k,31) = -rxt(k,102)*y(k,67) - mat(k,499) = -rxt(k,110)*y(k,67) - mat(k,303) = -rxt(k,116)*y(k,67) - mat(k,235) = -rxt(k,130)*y(k,67) - mat(k,249) = -rxt(k,135)*y(k,67) - mat(k,135) = -rxt(k,249)*y(k,67) - mat(k,293) = -rxt(k,255)*y(k,67) - mat(k,130) = -rxt(k,291)*y(k,67) - mat(k,177) = -(rxt(k,295) + rxt(k,296)) * y(k,67) - mat(k,197) = -rxt(k,303)*y(k,67) - mat(k,102) = -rxt(k,307)*y(k,67) - mat(k,593) = 2.000_r8*rxt(k,194)*y(k,4) + (rxt(k,196)+rxt(k,197))*y(k,26) & - + rxt(k,202)*y(k,66) + rxt(k,198)*y(k,87) - mat(k,354) = rxt(k,238)*y(k,87) - mat(k,456) = (rxt(k,196)+rxt(k,197))*y(k,4) + (2.000_r8*rxt(k,163) & - +2.000_r8*rxt(k,164))*y(k,26) + rxt(k,172)*y(k,66) + rxt(k,166) & + mat(k,530) = -rxt(k,108)*y(k,68) + mat(k,509) = -rxt(k,110)*y(k,68) + mat(k,919) = -rxt(k,111)*y(k,68) + mat(k,219) = -rxt(k,112)*y(k,68) + mat(k,555) = -rxt(k,117)*y(k,68) + mat(k,841) = -rxt(k,123)*y(k,68) + mat(k,792) = -(rxt(k,136) + rxt(k,138)) * y(k,68) + mat(k,608) = -rxt(k,141)*y(k,68) + mat(k,675) = -rxt(k,146)*y(k,68) + mat(k,309) = -rxt(k,170)*y(k,68) + mat(k,583) = -rxt(k,172)*y(k,68) + mat(k,456) = -rxt(k,175)*y(k,68) + mat(k,265) = -rxt(k,178)*y(k,68) + mat(k,202) = -rxt(k,201)*y(k,68) + mat(k,741) = -rxt(k,202)*y(k,68) + mat(k,255) = -rxt(k,204)*y(k,68) + mat(k,247) = -rxt(k,206)*y(k,68) + mat(k,478) = -rxt(k,236)*y(k,68) + mat(k,142) = -rxt(k,248)*y(k,68) + mat(k,231) = -(rxt(k,291) + rxt(k,292)) * y(k,68) + mat(k,277) = -rxt(k,293)*y(k,68) + mat(k,440) = rxt(k,115)*y(k,87) + mat(k,349) = rxt(k,131)*y(k,61) + rxt(k,132)*y(k,62) + rxt(k,135)*y(k,69) & + + rxt(k,296)*y(k,95) + mat(k,675) = mat(k,675) + rxt(k,131)*y(k,55) + mat(k,792) = mat(k,792) + rxt(k,132)*y(k,55) + mat(k,509) = mat(k,509) + rxt(k,135)*y(k,55) + rxt(k,250)*y(k,75) & + + rxt(k,257)*y(k,77) + rxt(k,295)*y(k,91) + (rxt(k,97)+rxt(k,98)) & + *y(k,92) + rxt(k,302)*y(k,97) + rxt(k,306)*y(k,98) + mat(k,237) = rxt(k,250)*y(k,69) + mat(k,428) = rxt(k,257)*y(k,69) + mat(k,326) = rxt(k,287)*y(k,90) + 1.150_r8*rxt(k,288)*y(k,95) + mat(k,555) = mat(k,555) + rxt(k,115)*y(k,40) + mat(k,336) = rxt(k,301)*y(k,97) + mat(k,243) = rxt(k,287)*y(k,86) + mat(k,277) = mat(k,277) + rxt(k,295)*y(k,69) + mat(k,717) = (rxt(k,97)+rxt(k,98))*y(k,69) + mat(k,362) = rxt(k,296)*y(k,55) + 1.150_r8*rxt(k,288)*y(k,86) + mat(k,841) = mat(k,841) + 2.000_r8*rxt(k,125)*y(k,96) + mat(k,379) = rxt(k,302)*y(k,69) + rxt(k,301)*y(k,88) + mat(k,190) = rxt(k,306)*y(k,69) + mat(k,505) = -(rxt(k,97)*y(k,92) + rxt(k,102)*y(k,93) + rxt(k,110)*y(k,68) & + + rxt(k,116)*y(k,40) + rxt(k,130)*y(k,88) + rxt(k,135)*y(k,55) & + + rxt(k,250)*y(k,75) + rxt(k,257)*y(k,77) + rxt(k,290)*y(k,89) & + + (rxt(k,294) + rxt(k,295)) * y(k,91) + rxt(k,302)*y(k,97) & + + rxt(k,306)*y(k,98)) + mat(k,712) = -rxt(k,97)*y(k,69) + mat(k,76) = -rxt(k,102)*y(k,69) + mat(k,645) = -rxt(k,110)*y(k,69) + mat(k,437) = -rxt(k,116)*y(k,69) + mat(k,335) = -rxt(k,130)*y(k,69) + mat(k,348) = -rxt(k,135)*y(k,69) + mat(k,235) = -rxt(k,250)*y(k,69) + mat(k,424) = -rxt(k,257)*y(k,69) + mat(k,230) = -rxt(k,290)*y(k,69) + mat(k,276) = -(rxt(k,294) + rxt(k,295)) * y(k,69) + mat(k,377) = -rxt(k,302)*y(k,69) + mat(k,189) = -rxt(k,306)*y(k,69) + mat(k,758) = rxt(k,193)*y(k,70) + rxt(k,192)*y(k,87) + mat(k,736) = 2.000_r8*rxt(k,194)*y(k,5) + (rxt(k,196)+rxt(k,197))*y(k,28) & + + rxt(k,202)*y(k,68) + rxt(k,198)*y(k,87) + mat(k,411) = rxt(k,238)*y(k,87) + mat(k,891) = rxt(k,161)*y(k,70) + rxt(k,159)*y(k,87) + mat(k,578) = (rxt(k,196)+rxt(k,197))*y(k,5) + (2.000_r8*rxt(k,163) & + +2.000_r8*rxt(k,164))*y(k,28) + rxt(k,172)*y(k,68) + rxt(k,166) & *y(k,87) + rxt(k,174)*y(k,96) - mat(k,303) = mat(k,303) + rxt(k,119)*y(k,68) + rxt(k,113)*y(k,87) - mat(k,86) = rxt(k,128)*y(k,96) - mat(k,249) = mat(k,249) + rxt(k,134)*y(k,60) - mat(k,734) = rxt(k,145)*y(k,68) + rxt(k,299)*y(k,95) - mat(k,711) = rxt(k,134)*y(k,53) + rxt(k,136)*y(k,66) + rxt(k,137)*y(k,68) - mat(k,378) = rxt(k,141)*y(k,66) + rxt(k,139)*y(k,87) - mat(k,499) = mat(k,499) + rxt(k,202)*y(k,4) + rxt(k,172)*y(k,26) + rxt(k,136) & - *y(k,60) + rxt(k,141)*y(k,61) + 2.000_r8*rxt(k,109)*y(k,66) & - + 2.000_r8*rxt(k,108)*y(k,68) + rxt(k,117)*y(k,87) + rxt(k,101) & + mat(k,437) = mat(k,437) + rxt(k,119)*y(k,70) + rxt(k,113)*y(k,87) + mat(k,172) = rxt(k,128)*y(k,96) + mat(k,348) = mat(k,348) + rxt(k,134)*y(k,62) + mat(k,101) = rxt(k,148)*y(k,92) + mat(k,670) = rxt(k,145)*y(k,70) + rxt(k,298)*y(k,95) + mat(k,787) = rxt(k,134)*y(k,55) + rxt(k,136)*y(k,68) + rxt(k,137)*y(k,70) + mat(k,603) = rxt(k,141)*y(k,68) + rxt(k,139)*y(k,87) + mat(k,645) = mat(k,645) + rxt(k,202)*y(k,5) + rxt(k,172)*y(k,28) + rxt(k,136) & + *y(k,62) + rxt(k,141)*y(k,63) + 2.000_r8*rxt(k,109)*y(k,68) & + + 2.000_r8*rxt(k,108)*y(k,70) + rxt(k,117)*y(k,87) + rxt(k,101) & *y(k,93) + rxt(k,123)*y(k,96) - mat(k,624) = mat(k,624) + 2.000_r8*rxt(k,102)*y(k,93) - mat(k,683) = rxt(k,119)*y(k,38) + rxt(k,145)*y(k,59) + rxt(k,137)*y(k,60) & - + 2.000_r8*rxt(k,108)*y(k,66) + rxt(k,250)*y(k,73) + rxt(k,256) & - *y(k,75) + rxt(k,193)*y(k,84) + rxt(k,161)*y(k,85) & + mat(k,505) = mat(k,505) + 2.000_r8*rxt(k,102)*y(k,93) + mat(k,525) = rxt(k,193)*y(k,3) + rxt(k,161)*y(k,25) + rxt(k,119)*y(k,40) & + + rxt(k,145)*y(k,61) + rxt(k,137)*y(k,62) + 2.000_r8*rxt(k,108) & + *y(k,68) + rxt(k,252)*y(k,75) + rxt(k,258)*y(k,77) & + 2.000_r8*rxt(k,118)*y(k,87) + 2.000_r8*rxt(k,99)*y(k,92) & + rxt(k,124)*y(k,96) - mat(k,135) = mat(k,135) + rxt(k,250)*y(k,68) - mat(k,293) = mat(k,293) + rxt(k,256)*y(k,68) - mat(k,317) = rxt(k,193)*y(k,68) + rxt(k,192)*y(k,87) - mat(k,428) = rxt(k,161)*y(k,68) + rxt(k,159)*y(k,87) - mat(k,403) = rxt(k,198)*y(k,4) + rxt(k,238)*y(k,20) + rxt(k,166)*y(k,26) & - + rxt(k,113)*y(k,38) + rxt(k,139)*y(k,61) + rxt(k,117)*y(k,66) & - + 2.000_r8*rxt(k,118)*y(k,68) + rxt(k,192)*y(k,84) + rxt(k,159) & - *y(k,85) + 2.000_r8*rxt(k,127)*y(k,87) + rxt(k,122)*y(k,96) - mat(k,546) = mat(k,546) + 2.000_r8*rxt(k,99)*y(k,68) - mat(k,31) = mat(k,31) + rxt(k,101)*y(k,66) + 2.000_r8*rxt(k,102)*y(k,67) - mat(k,206) = rxt(k,299)*y(k,59) - mat(k,661) = rxt(k,174)*y(k,26) + rxt(k,128)*y(k,50) + rxt(k,123)*y(k,66) & - + rxt(k,124)*y(k,68) + rxt(k,122)*y(k,87) - mat(k,685) = -(rxt(k,99)*y(k,92) + rxt(k,108)*y(k,66) + rxt(k,118)*y(k,87) & - + rxt(k,119)*y(k,38) + rxt(k,124)*y(k,96) + rxt(k,137)*y(k,60) & - + rxt(k,145)*y(k,59) + rxt(k,161)*y(k,85) + rxt(k,193)*y(k,84) & - + rxt(k,250)*y(k,73) + rxt(k,256)*y(k,75)) - mat(k,548) = -rxt(k,99)*y(k,68) - mat(k,501) = -rxt(k,108)*y(k,68) - mat(k,405) = -rxt(k,118)*y(k,68) - mat(k,305) = -rxt(k,119)*y(k,68) - mat(k,663) = -rxt(k,124)*y(k,68) - mat(k,713) = -rxt(k,137)*y(k,68) - mat(k,736) = -rxt(k,145)*y(k,68) - mat(k,430) = -rxt(k,161)*y(k,68) - mat(k,319) = -rxt(k,193)*y(k,68) - mat(k,137) = -rxt(k,250)*y(k,68) - mat(k,295) = -rxt(k,256)*y(k,68) - mat(k,501) = mat(k,501) + rxt(k,110)*y(k,67) - mat(k,626) = rxt(k,110)*y(k,66) + mat(k,235) = mat(k,235) + rxt(k,252)*y(k,70) + mat(k,424) = mat(k,424) + rxt(k,258)*y(k,70) + mat(k,550) = rxt(k,192)*y(k,3) + rxt(k,198)*y(k,5) + rxt(k,238)*y(k,21) & + + rxt(k,159)*y(k,25) + rxt(k,166)*y(k,28) + rxt(k,113)*y(k,40) & + + rxt(k,139)*y(k,63) + rxt(k,117)*y(k,68) + 2.000_r8*rxt(k,118) & + *y(k,70) + 2.000_r8*rxt(k,127)*y(k,87) + rxt(k,122)*y(k,96) + mat(k,712) = mat(k,712) + rxt(k,148)*y(k,56) + 2.000_r8*rxt(k,99)*y(k,70) + mat(k,76) = mat(k,76) + rxt(k,101)*y(k,68) + 2.000_r8*rxt(k,102)*y(k,69) + mat(k,361) = rxt(k,298)*y(k,61) + mat(k,836) = rxt(k,174)*y(k,28) + rxt(k,128)*y(k,52) + rxt(k,123)*y(k,68) & + + rxt(k,124)*y(k,70) + rxt(k,122)*y(k,87) + mat(k,526) = -(rxt(k,99)*y(k,92) + rxt(k,108)*y(k,68) + rxt(k,118)*y(k,87) & + + rxt(k,119)*y(k,40) + rxt(k,124)*y(k,96) + rxt(k,137)*y(k,62) & + + rxt(k,145)*y(k,61) + rxt(k,161)*y(k,25) + rxt(k,193)*y(k,3) & + + rxt(k,252)*y(k,75) + rxt(k,258)*y(k,77)) + mat(k,713) = -rxt(k,99)*y(k,70) + mat(k,646) = -rxt(k,108)*y(k,70) + mat(k,551) = -rxt(k,118)*y(k,70) + mat(k,438) = -rxt(k,119)*y(k,70) + mat(k,837) = -rxt(k,124)*y(k,70) + mat(k,788) = -rxt(k,137)*y(k,70) + mat(k,671) = -rxt(k,145)*y(k,70) + mat(k,892) = -rxt(k,161)*y(k,70) + mat(k,759) = -rxt(k,193)*y(k,70) + mat(k,236) = -rxt(k,252)*y(k,70) + mat(k,425) = -rxt(k,258)*y(k,70) + mat(k,646) = mat(k,646) + rxt(k,110)*y(k,69) + mat(k,506) = rxt(k,110)*y(k,68) + mat(k,131) = -(rxt(k,259)*y(k,77)) + mat(k,419) = -rxt(k,259)*y(k,71) + mat(k,729) = rxt(k,195)*y(k,28) + mat(k,569) = rxt(k,195)*y(k,5) + 2.000_r8*rxt(k,165)*y(k,28) + mat(k,136) = -(rxt(k,248)*y(k,68) + rxt(k,249)*y(k,96)) + mat(k,621) = -rxt(k,248)*y(k,72) + mat(k,811) = -rxt(k,249)*y(k,72) + mat(k,232) = -(rxt(k,250)*y(k,69) + rxt(k,252)*y(k,70) + rxt(k,255)*y(k,96)) + mat(k,494) = -rxt(k,250)*y(k,75) + mat(k,521) = -rxt(k,252)*y(k,75) + mat(k,820) = -rxt(k,255)*y(k,75) + mat(k,422) = -(rxt(k,253)*y(k,5) + rxt(k,254)*y(k,28) + rxt(k,256)*y(k,62) & + + rxt(k,257)*y(k,69) + rxt(k,258)*y(k,70) + rxt(k,259)*y(k,71) & + + rxt(k,260)*y(k,96)) + mat(k,733) = -rxt(k,253)*y(k,77) + mat(k,574) = -rxt(k,254)*y(k,77) + mat(k,784) = -rxt(k,256)*y(k,77) + mat(k,503) = -rxt(k,257)*y(k,77) + mat(k,523) = -rxt(k,258)*y(k,77) + mat(k,133) = -rxt(k,259)*y(k,77) + mat(k,832) = -rxt(k,260)*y(k,77) + mat(k,641) = rxt(k,248)*y(k,72) + mat(k,503) = mat(k,503) + rxt(k,250)*y(k,75) + mat(k,523) = mat(k,523) + rxt(k,252)*y(k,75) + mat(k,140) = rxt(k,248)*y(k,68) + mat(k,233) = rxt(k,250)*y(k,69) + rxt(k,252)*y(k,70) + rxt(k,255)*y(k,96) + mat(k,832) = mat(k,832) + rxt(k,255)*y(k,75) + mat(k,297) = -(rxt(k,251)*y(k,96)) + mat(k,825) = -rxt(k,251)*y(k,78) + mat(k,732) = rxt(k,253)*y(k,77) + mat(k,571) = rxt(k,254)*y(k,77) + mat(k,126) = rxt(k,246)*y(k,63) + (rxt(k,247)+.500_r8*rxt(k,261))*y(k,96) + mat(k,779) = rxt(k,256)*y(k,77) + mat(k,597) = rxt(k,246)*y(k,35) + mat(k,497) = rxt(k,257)*y(k,77) + mat(k,522) = rxt(k,258)*y(k,77) + mat(k,132) = rxt(k,259)*y(k,77) + mat(k,139) = rxt(k,249)*y(k,96) + mat(k,421) = rxt(k,253)*y(k,5) + rxt(k,254)*y(k,28) + rxt(k,256)*y(k,62) & + + rxt(k,257)*y(k,69) + rxt(k,258)*y(k,70) + rxt(k,259)*y(k,71) & + + rxt(k,260)*y(k,96) + mat(k,825) = mat(k,825) + (rxt(k,247)+.500_r8*rxt(k,261))*y(k,35) & + + rxt(k,249)*y(k,72) + rxt(k,260)*y(k,77) end do - end subroutine nlnmat02 - subroutine nlnmat03( avec_len, mat, y, rxt ) + end subroutine nlnmat03 + subroutine nlnmat04( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -475,258 +721,226 @@ subroutine nlnmat03( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,64) = -(rxt(k,257)*y(k,75)) - mat(k,282) = -rxt(k,257)*y(k,69) - mat(k,574) = rxt(k,195)*y(k,26) - mat(k,437) = rxt(k,195)*y(k,4) + 2.000_r8*rxt(k,165)*y(k,26) - mat(k,69) = -(rxt(k,247)*y(k,66) + rxt(k,248)*y(k,96)) - mat(k,464) = -rxt(k,247)*y(k,70) - mat(k,634) = -rxt(k,248)*y(k,70) - mat(k,131) = -(rxt(k,249)*y(k,67) + rxt(k,250)*y(k,68) + rxt(k,253)*y(k,96)) - mat(k,604) = -rxt(k,249)*y(k,73) - mat(k,669) = -rxt(k,250)*y(k,73) - mat(k,639) = -rxt(k,253)*y(k,73) - mat(k,285) = -(rxt(k,251)*y(k,4) + rxt(k,252)*y(k,26) + rxt(k,254)*y(k,60) & - + rxt(k,255)*y(k,67) + rxt(k,256)*y(k,68) + rxt(k,257)*y(k,69) & - + rxt(k,258)*y(k,96)) - mat(k,579) = -rxt(k,251)*y(k,75) - mat(k,442) = -rxt(k,252)*y(k,75) - mat(k,697) = -rxt(k,254)*y(k,75) - mat(k,613) = -rxt(k,255)*y(k,75) - mat(k,671) = -rxt(k,256)*y(k,75) - mat(k,66) = -rxt(k,257)*y(k,75) - mat(k,647) = -rxt(k,258)*y(k,75) - mat(k,485) = rxt(k,247)*y(k,70) - mat(k,613) = mat(k,613) + rxt(k,249)*y(k,73) - mat(k,671) = mat(k,671) + rxt(k,250)*y(k,73) - mat(k,73) = rxt(k,247)*y(k,66) - mat(k,132) = rxt(k,249)*y(k,67) + rxt(k,250)*y(k,68) + rxt(k,253)*y(k,96) - mat(k,647) = mat(k,647) + rxt(k,253)*y(k,73) - mat(k,254) = -(rxt(k,259)*y(k,96)) - mat(k,644) = -rxt(k,259)*y(k,76) - mat(k,577) = rxt(k,251)*y(k,75) - mat(k,439) = rxt(k,252)*y(k,75) - mat(k,59) = rxt(k,261)*y(k,61) + (rxt(k,262)+.500_r8*rxt(k,263))*y(k,96) - mat(k,694) = rxt(k,254)*y(k,75) - mat(k,363) = rxt(k,261)*y(k,33) - mat(k,612) = rxt(k,255)*y(k,75) - mat(k,670) = rxt(k,256)*y(k,75) - mat(k,65) = rxt(k,257)*y(k,75) - mat(k,72) = rxt(k,248)*y(k,96) - mat(k,284) = rxt(k,251)*y(k,4) + rxt(k,252)*y(k,26) + rxt(k,254)*y(k,60) & - + rxt(k,255)*y(k,67) + rxt(k,256)*y(k,68) + rxt(k,257)*y(k,69) & - + rxt(k,258)*y(k,96) - mat(k,644) = mat(k,644) + (rxt(k,262)+.500_r8*rxt(k,263))*y(k,33) & - + rxt(k,248)*y(k,70) + rxt(k,258)*y(k,75) - mat(k,48) = -(rxt(k,260)*y(k,100)) - mat(k,742) = -rxt(k,260)*y(k,77) - mat(k,253) = rxt(k,259)*y(k,96) - mat(k,632) = rxt(k,259)*y(k,76) - mat(k,310) = -(rxt(k,191)*y(k,16) + rxt(k,192)*y(k,87) + rxt(k,193)*y(k,68)) - mat(k,509) = -rxt(k,191)*y(k,84) - mat(k,391) = -rxt(k,192)*y(k,84) - mat(k,673) = -rxt(k,193)*y(k,84) - mat(k,581) = 4.000_r8*rxt(k,194)*y(k,4) + (rxt(k,195)+rxt(k,196))*y(k,26) & - + rxt(k,199)*y(k,59) + rxt(k,202)*y(k,66) + rxt(k,251)*y(k,75) & - + rxt(k,203)*y(k,96) - mat(k,444) = (rxt(k,195)+rxt(k,196))*y(k,4) - mat(k,180) = rxt(k,204)*y(k,66) + rxt(k,210)*y(k,92) + rxt(k,205)*y(k,96) - mat(k,723) = rxt(k,199)*y(k,4) - mat(k,487) = rxt(k,202)*y(k,4) + rxt(k,204)*y(k,43) - mat(k,287) = rxt(k,251)*y(k,4) - mat(k,534) = rxt(k,210)*y(k,43) - mat(k,649) = rxt(k,203)*y(k,4) + rxt(k,205)*y(k,43) - mat(k,421) = -(rxt(k,155)*y(k,16) + rxt(k,157)*y(k,39) + rxt(k,158)*y(k,41) & - + (rxt(k,159) + rxt(k,160)) * y(k,87) + rxt(k,161)*y(k,68) & - + rxt(k,168)*y(k,27) + rxt(k,177)*y(k,52)) - mat(k,514) = -rxt(k,155)*y(k,85) - mat(k,560) = -rxt(k,157)*y(k,85) - mat(k,118) = -rxt(k,158)*y(k,85) - mat(k,396) = -(rxt(k,159) + rxt(k,160)) * y(k,85) - mat(k,676) = -rxt(k,161)*y(k,85) - mat(k,266) = -rxt(k,168)*y(k,85) - mat(k,164) = -rxt(k,177)*y(k,85) - mat(k,586) = rxt(k,196)*y(k,26) - mat(k,349) = rxt(k,162)*y(k,26) - mat(k,449) = rxt(k,196)*y(k,4) + rxt(k,162)*y(k,20) + (4.000_r8*rxt(k,163) & - +2.000_r8*rxt(k,165))*y(k,26) + rxt(k,167)*y(k,59) + rxt(k,172) & - *y(k,66) + rxt(k,252)*y(k,75) + rxt(k,173)*y(k,96) - mat(k,39) = rxt(k,217)*y(k,92) - mat(k,333) = rxt(k,175)*y(k,66) + rxt(k,187)*y(k,92) + rxt(k,176)*y(k,96) - mat(k,727) = rxt(k,167)*y(k,26) - mat(k,492) = rxt(k,172)*y(k,26) + rxt(k,175)*y(k,47) - mat(k,289) = rxt(k,252)*y(k,26) - mat(k,539) = rxt(k,217)*y(k,32) + rxt(k,187)*y(k,47) - mat(k,654) = rxt(k,173)*y(k,26) + rxt(k,176)*y(k,47) - mat(k,215) = -(rxt(k,288)*y(k,90) + rxt(k,289)*y(k,95) + rxt(k,290)*y(k,89)) - mat(k,139) = -rxt(k,288)*y(k,86) - mat(k,201) = -rxt(k,289)*y(k,86) - mat(k,126) = -rxt(k,290)*y(k,86) - mat(k,395) = -((rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,38) + rxt(k,117) & - *y(k,66) + rxt(k,118)*y(k,68) + rxt(k,122)*y(k,96) & - + 4._r8*rxt(k,127)*y(k,87) + rxt(k,139)*y(k,61) + rxt(k,144) & - *y(k,59) + rxt(k,149)*y(k,60) + (rxt(k,159) + rxt(k,160) & - ) * y(k,85) + rxt(k,166)*y(k,26) + rxt(k,192)*y(k,84) + rxt(k,198) & - *y(k,4) + rxt(k,238)*y(k,20)) - mat(k,300) = -(rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,87) - mat(k,491) = -rxt(k,117)*y(k,87) - mat(k,675) = -rxt(k,118)*y(k,87) - mat(k,653) = -rxt(k,122)*y(k,87) - mat(k,370) = -rxt(k,139)*y(k,87) - mat(k,726) = -rxt(k,144)*y(k,87) - mat(k,703) = -rxt(k,149)*y(k,87) - mat(k,420) = -(rxt(k,159) + rxt(k,160)) * y(k,87) - mat(k,448) = -rxt(k,166)*y(k,87) - mat(k,311) = -rxt(k,192)*y(k,87) - mat(k,585) = -rxt(k,198)*y(k,87) - mat(k,348) = -rxt(k,238)*y(k,87) - mat(k,585) = mat(k,585) + rxt(k,203)*y(k,96) - mat(k,513) = rxt(k,235)*y(k,61) + rxt(k,236)*y(k,66) + rxt(k,191)*y(k,84) & - + rxt(k,155)*y(k,85) - mat(k,348) = mat(k,348) + rxt(k,162)*y(k,26) + rxt(k,239)*y(k,59) - mat(k,448) = mat(k,448) + rxt(k,162)*y(k,20) + rxt(k,173)*y(k,96) - mat(k,105) = rxt(k,242)*y(k,96) - mat(k,62) = .500_r8*rxt(k,263)*y(k,96) - mat(k,300) = mat(k,300) + rxt(k,116)*y(k,67) - mat(k,117) = rxt(k,112)*y(k,66) + rxt(k,158)*y(k,85) + rxt(k,121)*y(k,96) - mat(k,726) = mat(k,726) + rxt(k,239)*y(k,20) - mat(k,370) = mat(k,370) + rxt(k,235)*y(k,16) + rxt(k,142)*y(k,96) - mat(k,491) = mat(k,491) + rxt(k,236)*y(k,16) + rxt(k,112)*y(k,41) - mat(k,616) = rxt(k,116)*y(k,38) - mat(k,675) = mat(k,675) + rxt(k,124)*y(k,96) - mat(k,256) = rxt(k,259)*y(k,96) - mat(k,311) = mat(k,311) + rxt(k,191)*y(k,16) - mat(k,420) = mat(k,420) + rxt(k,155)*y(k,16) + rxt(k,158)*y(k,41) - mat(k,653) = mat(k,653) + rxt(k,203)*y(k,4) + rxt(k,173)*y(k,26) + rxt(k,242) & - *y(k,29) + .500_r8*rxt(k,263)*y(k,33) + rxt(k,121)*y(k,41) & - + rxt(k,142)*y(k,61) + rxt(k,124)*y(k,68) + rxt(k,259)*y(k,76) - mat(k,229) = -(rxt(k,129)*y(k,66) + rxt(k,130)*y(k,67) + rxt(k,302)*y(k,97)) - mat(k,480) = -rxt(k,129)*y(k,88) - mat(k,610) = -rxt(k,130)*y(k,88) - mat(k,192) = -rxt(k,302)*y(k,88) - mat(k,480) = mat(k,480) + rxt(k,292)*y(k,89) - mat(k,216) = .900_r8*rxt(k,290)*y(k,89) + .800_r8*rxt(k,288)*y(k,90) - mat(k,127) = rxt(k,292)*y(k,66) + .900_r8*rxt(k,290)*y(k,86) - mat(k,140) = .800_r8*rxt(k,288)*y(k,86) - mat(k,122) = -(rxt(k,290)*y(k,86) + rxt(k,291)*y(k,67) + (rxt(k,292) & - + rxt(k,293)) * y(k,66)) - mat(k,210) = -rxt(k,290)*y(k,89) - mat(k,603) = -rxt(k,291)*y(k,89) - mat(k,470) = -(rxt(k,292) + rxt(k,293)) * y(k,89) - mat(k,138) = -(rxt(k,288)*y(k,86)) - mat(k,211) = -rxt(k,288)*y(k,90) - mat(k,238) = rxt(k,297)*y(k,95) - mat(k,717) = rxt(k,299)*y(k,95) - mat(k,472) = rxt(k,292)*y(k,89) - mat(k,605) = rxt(k,296)*y(k,91) - mat(k,123) = rxt(k,292)*y(k,66) - mat(k,169) = rxt(k,296)*y(k,67) - mat(k,199) = rxt(k,297)*y(k,53) + rxt(k,299)*y(k,59) - mat(k,170) = -(rxt(k,294)*y(k,66) + (rxt(k,295) + rxt(k,296)) * y(k,67)) - mat(k,475) = -rxt(k,294)*y(k,91) - mat(k,606) = -(rxt(k,295) + rxt(k,296)) * y(k,91) - mat(k,225) = rxt(k,302)*y(k,97) - mat(k,188) = rxt(k,302)*y(k,88) - mat(k,543) = -(rxt(k,94)*y(k,39) + rxt(k,95)*y(k,100) + (rxt(k,97) + rxt(k,98) & - ) * y(k,67) + rxt(k,99)*y(k,68) + (rxt(k,187) + rxt(k,188) & - ) * y(k,47) + (rxt(k,210) + rxt(k,211)) * y(k,43) + rxt(k,216) & - *y(k,31) + rxt(k,217)*y(k,32)) - mat(k,564) = -rxt(k,94)*y(k,92) - mat(k,756) = -rxt(k,95)*y(k,92) - mat(k,621) = -(rxt(k,97) + rxt(k,98)) * y(k,92) - mat(k,680) = -rxt(k,99)*y(k,92) - mat(k,337) = -(rxt(k,187) + rxt(k,188)) * y(k,92) - mat(k,182) = -(rxt(k,210) + rxt(k,211)) * y(k,92) - mat(k,29) = -rxt(k,216)*y(k,92) - mat(k,40) = -rxt(k,217)*y(k,92) - mat(k,621) = mat(k,621) + rxt(k,130)*y(k,88) - mat(k,221) = .850_r8*rxt(k,289)*y(k,95) - mat(k,234) = rxt(k,130)*y(k,67) - mat(k,205) = .850_r8*rxt(k,289)*y(k,86) - mat(k,30) = -(rxt(k,101)*y(k,66) + rxt(k,102)*y(k,67)) - mat(k,462) = -rxt(k,101)*y(k,93) - mat(k,599) = -rxt(k,102)*y(k,93) - mat(k,462) = mat(k,462) + rxt(k,105)*y(k,94) - mat(k,599) = mat(k,599) + rxt(k,106)*y(k,94) - mat(k,667) = rxt(k,107)*y(k,94) - mat(k,32) = rxt(k,105)*y(k,66) + rxt(k,106)*y(k,67) + rxt(k,107)*y(k,68) - mat(k,33) = -(rxt(k,105)*y(k,66) + rxt(k,106)*y(k,67) + rxt(k,107)*y(k,68)) - mat(k,463) = -rxt(k,105)*y(k,94) - mat(k,600) = -rxt(k,106)*y(k,94) - mat(k,668) = -rxt(k,107)*y(k,94) - mat(k,600) = mat(k,600) + rxt(k,97)*y(k,92) - mat(k,528) = rxt(k,97)*y(k,67) - mat(k,200) = -(rxt(k,289)*y(k,86) + rxt(k,297)*y(k,53) + rxt(k,299)*y(k,59)) - mat(k,214) = -rxt(k,289)*y(k,95) - mat(k,241) = -rxt(k,297)*y(k,95) - mat(k,718) = -rxt(k,299)*y(k,95) - mat(k,608) = rxt(k,291)*y(k,89) + rxt(k,295)*y(k,91) + rxt(k,303)*y(k,97) & - + rxt(k,307)*y(k,98) - mat(k,125) = rxt(k,291)*y(k,67) - mat(k,172) = rxt(k,295)*y(k,67) - mat(k,190) = rxt(k,303)*y(k,67) - mat(k,100) = rxt(k,307)*y(k,67) - mat(k,662) = -(rxt(k,120)*y(k,39) + rxt(k,121)*y(k,41) + rxt(k,122)*y(k,87) & - + rxt(k,123)*y(k,66) + rxt(k,124)*y(k,68) + (4._r8*rxt(k,125) & - + 4._r8*rxt(k,126)) * y(k,96) + rxt(k,128)*y(k,50) + rxt(k,142) & - *y(k,61) + rxt(k,143)*y(k,53) + rxt(k,151)*y(k,60) + rxt(k,152) & - *y(k,49) + rxt(k,171)*y(k,27) + (rxt(k,173) + rxt(k,174) & - ) * y(k,26) + rxt(k,176)*y(k,47) + rxt(k,179)*y(k,52) + rxt(k,203) & - *y(k,4) + rxt(k,205)*y(k,43) + rxt(k,237)*y(k,16) + rxt(k,240) & - *y(k,21) + (rxt(k,242) + rxt(k,246)) * y(k,29) + rxt(k,248) & - *y(k,70) + rxt(k,253)*y(k,73) + rxt(k,258)*y(k,75) + rxt(k,259) & - *y(k,76) + (rxt(k,262) + rxt(k,263)) * y(k,33)) - mat(k,568) = -rxt(k,120)*y(k,96) - mat(k,120) = -rxt(k,121)*y(k,96) - mat(k,404) = -rxt(k,122)*y(k,96) - mat(k,500) = -rxt(k,123)*y(k,96) - mat(k,684) = -rxt(k,124)*y(k,96) - mat(k,87) = -rxt(k,128)*y(k,96) - mat(k,379) = -rxt(k,142)*y(k,96) - mat(k,250) = -rxt(k,143)*y(k,96) - mat(k,712) = -rxt(k,151)*y(k,96) - mat(k,279) = -rxt(k,152)*y(k,96) - mat(k,269) = -rxt(k,171)*y(k,96) - mat(k,457) = -(rxt(k,173) + rxt(k,174)) * y(k,96) - mat(k,341) = -rxt(k,176)*y(k,96) - mat(k,167) = -rxt(k,179)*y(k,96) - mat(k,594) = -rxt(k,203)*y(k,96) - mat(k,184) = -rxt(k,205)*y(k,96) - mat(k,522) = -rxt(k,237)*y(k,96) - mat(k,81) = -rxt(k,240)*y(k,96) - mat(k,106) = -(rxt(k,242) + rxt(k,246)) * y(k,96) - mat(k,76) = -rxt(k,248)*y(k,96) - mat(k,136) = -rxt(k,253)*y(k,96) - mat(k,294) = -rxt(k,258)*y(k,96) - mat(k,258) = -rxt(k,259)*y(k,96) - mat(k,63) = -(rxt(k,262) + rxt(k,263)) * y(k,96) - mat(k,522) = mat(k,522) + rxt(k,236)*y(k,66) - mat(k,81) = mat(k,81) + .300_r8*rxt(k,240)*y(k,96) - mat(k,159) = rxt(k,214)*y(k,100) - mat(k,304) = rxt(k,119)*y(k,68) + 2.000_r8*rxt(k,114)*y(k,87) - mat(k,568) = mat(k,568) + rxt(k,111)*y(k,66) + rxt(k,94)*y(k,92) - mat(k,120) = mat(k,120) + rxt(k,112)*y(k,66) - mat(k,184) = mat(k,184) + rxt(k,204)*y(k,66) + rxt(k,210)*y(k,92) - mat(k,341) = mat(k,341) + rxt(k,175)*y(k,66) + rxt(k,187)*y(k,92) - mat(k,150) = rxt(k,206)*y(k,66) - mat(k,167) = mat(k,167) + rxt(k,178)*y(k,66) - mat(k,735) = rxt(k,144)*y(k,87) - mat(k,379) = mat(k,379) + rxt(k,139)*y(k,87) - mat(k,500) = mat(k,500) + rxt(k,236)*y(k,16) + rxt(k,111)*y(k,39) & - + rxt(k,112)*y(k,41) + rxt(k,204)*y(k,43) + rxt(k,175)*y(k,47) & - + rxt(k,206)*y(k,51) + rxt(k,178)*y(k,52) + rxt(k,117)*y(k,87) - mat(k,684) = mat(k,684) + rxt(k,119)*y(k,38) + rxt(k,118)*y(k,87) - mat(k,429) = rxt(k,160)*y(k,87) - mat(k,404) = mat(k,404) + 2.000_r8*rxt(k,114)*y(k,38) + rxt(k,144)*y(k,59) & - + rxt(k,139)*y(k,61) + rxt(k,117)*y(k,66) + rxt(k,118)*y(k,68) & - + rxt(k,160)*y(k,85) - mat(k,547) = rxt(k,94)*y(k,39) + rxt(k,210)*y(k,43) + rxt(k,187)*y(k,47) & - + 2.000_r8*rxt(k,95)*y(k,100) - mat(k,662) = mat(k,662) + .300_r8*rxt(k,240)*y(k,21) - mat(k,760) = rxt(k,214)*y(k,37) + 2.000_r8*rxt(k,95)*y(k,92) + mat(k,105) = -(rxt(k,262)*y(k,100)) + mat(k,931) = -rxt(k,262)*y(k,79) + mat(k,296) = rxt(k,251)*y(k,96) + mat(k,808) = rxt(k,251)*y(k,78) + mat(k,320) = -(rxt(k,287)*y(k,90) + rxt(k,288)*y(k,95) + rxt(k,289)*y(k,89)) + mat(k,240) = -rxt(k,287)*y(k,86) + mat(k,355) = -rxt(k,288)*y(k,86) + mat(k,225) = -rxt(k,289)*y(k,86) + mat(k,552) = -((rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,40) + rxt(k,117) & + *y(k,68) + rxt(k,118)*y(k,70) + rxt(k,122)*y(k,96) & + + 4._r8*rxt(k,127)*y(k,87) + rxt(k,139)*y(k,63) + rxt(k,144) & + *y(k,61) + rxt(k,149)*y(k,62) + (rxt(k,159) + rxt(k,160) & + ) * y(k,25) + rxt(k,166)*y(k,28) + rxt(k,192)*y(k,3) + rxt(k,198) & + *y(k,5) + rxt(k,238)*y(k,21)) + mat(k,439) = -(rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,87) + mat(k,647) = -rxt(k,117)*y(k,87) + mat(k,527) = -rxt(k,118)*y(k,87) + mat(k,838) = -rxt(k,122)*y(k,87) + mat(k,605) = -rxt(k,139)*y(k,87) + mat(k,672) = -rxt(k,144)*y(k,87) + mat(k,789) = -rxt(k,149)*y(k,87) + mat(k,893) = -(rxt(k,159) + rxt(k,160)) * y(k,87) + mat(k,580) = -rxt(k,166)*y(k,87) + mat(k,760) = -rxt(k,192)*y(k,87) + mat(k,738) = -rxt(k,198)*y(k,87) + mat(k,412) = -rxt(k,238)*y(k,87) + mat(k,760) = mat(k,760) + rxt(k,191)*y(k,17) + mat(k,738) = mat(k,738) + rxt(k,203)*y(k,96) + mat(k,475) = rxt(k,191)*y(k,3) + rxt(k,155)*y(k,25) + rxt(k,235)*y(k,63) & + + rxt(k,236)*y(k,68) + mat(k,210) = rxt(k,220)*y(k,25) + rxt(k,221)*y(k,96) + mat(k,148) = rxt(k,223)*y(k,25) + rxt(k,224)*y(k,96) + mat(k,412) = mat(k,412) + rxt(k,162)*y(k,28) + rxt(k,239)*y(k,61) + mat(k,396) = rxt(k,243)*y(k,92) + mat(k,893) = mat(k,893) + rxt(k,155)*y(k,17) + rxt(k,220)*y(k,18) & + + rxt(k,223)*y(k,20) + rxt(k,158)*y(k,43) + mat(k,580) = mat(k,580) + rxt(k,162)*y(k,21) + rxt(k,173)*y(k,96) + mat(k,283) = rxt(k,245)*y(k,96) + mat(k,127) = .500_r8*rxt(k,261)*y(k,96) + mat(k,439) = mat(k,439) + rxt(k,116)*y(k,69) + mat(k,218) = rxt(k,158)*y(k,25) + rxt(k,112)*y(k,68) + rxt(k,121)*y(k,96) + mat(k,672) = mat(k,672) + rxt(k,239)*y(k,21) + mat(k,605) = mat(k,605) + rxt(k,235)*y(k,17) + rxt(k,142)*y(k,96) + mat(k,647) = mat(k,647) + rxt(k,236)*y(k,17) + rxt(k,112)*y(k,43) + mat(k,507) = rxt(k,116)*y(k,40) + mat(k,527) = mat(k,527) + rxt(k,124)*y(k,96) + mat(k,299) = rxt(k,251)*y(k,96) + mat(k,714) = rxt(k,243)*y(k,23) + mat(k,838) = mat(k,838) + rxt(k,203)*y(k,5) + rxt(k,221)*y(k,18) + rxt(k,224) & + *y(k,20) + rxt(k,173)*y(k,28) + rxt(k,245)*y(k,31) & + + .500_r8*rxt(k,261)*y(k,35) + rxt(k,121)*y(k,43) + rxt(k,142) & + *y(k,63) + rxt(k,124)*y(k,70) + rxt(k,251)*y(k,78) + mat(k,331) = -(rxt(k,129)*y(k,68) + rxt(k,130)*y(k,69) + rxt(k,301)*y(k,97)) + mat(k,637) = -rxt(k,129)*y(k,88) + mat(k,499) = -rxt(k,130)*y(k,88) + mat(k,372) = -rxt(k,301)*y(k,88) + mat(k,637) = mat(k,637) + rxt(k,291)*y(k,89) + mat(k,321) = .900_r8*rxt(k,289)*y(k,89) + .800_r8*rxt(k,287)*y(k,90) + mat(k,226) = rxt(k,291)*y(k,68) + .900_r8*rxt(k,289)*y(k,86) + mat(k,241) = .800_r8*rxt(k,287)*y(k,86) + mat(k,223) = -(rxt(k,289)*y(k,86) + rxt(k,290)*y(k,69) + (rxt(k,291) & + + rxt(k,292)) * y(k,68)) + mat(k,317) = -rxt(k,289)*y(k,89) + mat(k,493) = -rxt(k,290)*y(k,89) + mat(k,626) = -(rxt(k,291) + rxt(k,292)) * y(k,89) + mat(k,239) = -(rxt(k,287)*y(k,86)) + mat(k,318) = -rxt(k,287)*y(k,90) + mat(k,340) = rxt(k,296)*y(k,95) + mat(k,661) = rxt(k,298)*y(k,95) + mat(k,628) = rxt(k,291)*y(k,89) + mat(k,495) = rxt(k,295)*y(k,91) + mat(k,224) = rxt(k,291)*y(k,68) + mat(k,269) = rxt(k,295)*y(k,69) + mat(k,354) = rxt(k,296)*y(k,55) + rxt(k,298)*y(k,61) + mat(k,270) = -(rxt(k,293)*y(k,68) + (rxt(k,294) + rxt(k,295)) * y(k,69)) + mat(k,632) = -rxt(k,293)*y(k,91) + mat(k,496) = -(rxt(k,294) + rxt(k,295)) * y(k,91) + mat(k,329) = rxt(k,301)*y(k,97) + mat(k,369) = rxt(k,301)*y(k,88) + mat(k,719) = -(rxt(k,94)*y(k,41) + rxt(k,95)*y(k,100) + (rxt(k,97) + rxt(k,98) & + ) * y(k,69) + rxt(k,99)*y(k,70) + (rxt(k,147) + rxt(k,148) & + ) * y(k,56) + rxt(k,180)*y(k,8) + rxt(k,181)*y(k,9) + rxt(k,182) & + *y(k,11) + rxt(k,183)*y(k,12) + rxt(k,184)*y(k,13) + rxt(k,185) & + *y(k,14) + rxt(k,186)*y(k,15) + (rxt(k,187) + rxt(k,188) & + ) * y(k,49) + rxt(k,207)*y(k,10) + rxt(k,208)*y(k,24) + rxt(k,209) & + *y(k,42) + (rxt(k,210) + rxt(k,211)) * y(k,45) + rxt(k,216) & + *y(k,33) + rxt(k,217)*y(k,34) + rxt(k,230)*y(k,16) + rxt(k,231) & + *y(k,18) + rxt(k,232)*y(k,46) + rxt(k,233)*y(k,47) + rxt(k,234) & + *y(k,48) + (rxt(k,242) + rxt(k,243) + rxt(k,244)) * y(k,23)) + mat(k,921) = -rxt(k,94)*y(k,92) + mat(k,948) = -rxt(k,95)*y(k,92) + mat(k,511) = -(rxt(k,97) + rxt(k,98)) * y(k,92) + mat(k,532) = -rxt(k,99)*y(k,92) + mat(k,103) = -(rxt(k,147) + rxt(k,148)) * y(k,92) + mat(k,28) = -rxt(k,180)*y(k,92) + mat(k,55) = -rxt(k,181)*y(k,92) + mat(k,36) = -rxt(k,182)*y(k,92) + mat(k,66) = -rxt(k,183)*y(k,92) + mat(k,40) = -rxt(k,184)*y(k,92) + mat(k,71) = -rxt(k,185)*y(k,92) + mat(k,44) = -rxt(k,186)*y(k,92) + mat(k,457) = -(rxt(k,187) + rxt(k,188)) * y(k,92) + mat(k,61) = -rxt(k,207)*y(k,92) + mat(k,154) = -rxt(k,208)*y(k,92) + mat(k,32) = -rxt(k,209)*y(k,92) + mat(k,256) = -(rxt(k,210) + rxt(k,211)) * y(k,92) + mat(k,96) = -rxt(k,216)*y(k,92) + mat(k,87) = -rxt(k,217)*y(k,92) + mat(k,166) = -rxt(k,230)*y(k,92) + mat(k,211) = -rxt(k,231)*y(k,92) + mat(k,82) = -rxt(k,232)*y(k,92) + mat(k,91) = -rxt(k,233)*y(k,92) + mat(k,112) = -rxt(k,234)*y(k,92) + mat(k,400) = -(rxt(k,242) + rxt(k,243) + rxt(k,244)) * y(k,92) + mat(k,511) = mat(k,511) + rxt(k,130)*y(k,88) + mat(k,328) = .850_r8*rxt(k,288)*y(k,95) + mat(k,338) = rxt(k,130)*y(k,69) + mat(k,364) = .850_r8*rxt(k,288)*y(k,86) + mat(k,75) = -(rxt(k,101)*y(k,68) + rxt(k,102)*y(k,69)) + mat(k,619) = -rxt(k,101)*y(k,93) + mat(k,489) = -rxt(k,102)*y(k,93) + mat(k,191) = rxt(k,103)*y(k,94) + mat(k,619) = mat(k,619) + rxt(k,105)*y(k,94) + mat(k,489) = mat(k,489) + rxt(k,106)*y(k,94) + mat(k,519) = rxt(k,107)*y(k,94) + mat(k,77) = rxt(k,103)*y(k,32) + rxt(k,105)*y(k,68) + rxt(k,106)*y(k,69) & + + rxt(k,107)*y(k,70) + mat(k,78) = -(rxt(k,103)*y(k,32) + rxt(k,105)*y(k,68) + rxt(k,106)*y(k,69) & + + rxt(k,107)*y(k,70)) + mat(k,192) = -rxt(k,103)*y(k,94) + mat(k,620) = -rxt(k,105)*y(k,94) + mat(k,490) = -rxt(k,106)*y(k,94) + mat(k,520) = -rxt(k,107)*y(k,94) + mat(k,490) = mat(k,490) + rxt(k,97)*y(k,92) + mat(k,695) = rxt(k,97)*y(k,69) + mat(k,358) = -(rxt(k,288)*y(k,86) + rxt(k,296)*y(k,55) + rxt(k,298)*y(k,61)) + mat(k,323) = -rxt(k,288)*y(k,95) + mat(k,345) = -rxt(k,296)*y(k,95) + mat(k,665) = -rxt(k,298)*y(k,95) + mat(k,195) = rxt(k,299)*y(k,97) + mat(k,501) = rxt(k,290)*y(k,89) + rxt(k,294)*y(k,91) + rxt(k,302)*y(k,97) & + + rxt(k,306)*y(k,98) + mat(k,228) = rxt(k,290)*y(k,69) + mat(k,274) = rxt(k,294)*y(k,69) + mat(k,374) = rxt(k,299)*y(k,32) + rxt(k,302)*y(k,69) + mat(k,187) = rxt(k,306)*y(k,69) + mat(k,847) = -(rxt(k,120)*y(k,41) + rxt(k,121)*y(k,43) + rxt(k,122)*y(k,87) & + + rxt(k,123)*y(k,68) + rxt(k,124)*y(k,70) + (4._r8*rxt(k,125) & + + 4._r8*rxt(k,126)) * y(k,96) + rxt(k,128)*y(k,52) + rxt(k,142) & + *y(k,63) + rxt(k,143)*y(k,55) + rxt(k,151)*y(k,62) + rxt(k,152) & + *y(k,51) + rxt(k,171)*y(k,29) + (rxt(k,173) + rxt(k,174) & + ) * y(k,28) + rxt(k,176)*y(k,49) + rxt(k,179)*y(k,54) + rxt(k,203) & + *y(k,5) + rxt(k,205)*y(k,45) + rxt(k,219)*y(k,16) + rxt(k,221) & + *y(k,18) + rxt(k,222)*y(k,19) + rxt(k,224)*y(k,20) + rxt(k,226) & + *y(k,24) + rxt(k,227)*y(k,46) + rxt(k,228)*y(k,47) + rxt(k,229) & + *y(k,48) + rxt(k,237)*y(k,17) + rxt(k,240)*y(k,22) + rxt(k,241) & + *y(k,23) + rxt(k,245)*y(k,31) + (rxt(k,247) + rxt(k,261) & + ) * y(k,35) + rxt(k,249)*y(k,72) + rxt(k,251)*y(k,78) + rxt(k,255) & + *y(k,75) + rxt(k,260)*y(k,77)) + mat(k,925) = -rxt(k,120)*y(k,96) + mat(k,220) = -rxt(k,121)*y(k,96) + mat(k,561) = -rxt(k,122)*y(k,96) + mat(k,656) = -rxt(k,123)*y(k,96) + mat(k,536) = -rxt(k,124)*y(k,96) + mat(k,176) = -rxt(k,128)*y(k,96) + mat(k,614) = -rxt(k,142)*y(k,96) + mat(k,353) = -rxt(k,143)*y(k,96) + mat(k,798) = -rxt(k,151)*y(k,96) + mat(k,870) = -rxt(k,152)*y(k,96) + mat(k,311) = -rxt(k,171)*y(k,96) + mat(k,589) = -(rxt(k,173) + rxt(k,174)) * y(k,96) + mat(k,461) = -rxt(k,176)*y(k,96) + mat(k,266) = -rxt(k,179)*y(k,96) + mat(k,747) = -rxt(k,203)*y(k,96) + mat(k,259) = -rxt(k,205)*y(k,96) + mat(k,168) = -rxt(k,219)*y(k,96) + mat(k,213) = -rxt(k,221)*y(k,96) + mat(k,47) = -rxt(k,222)*y(k,96) + mat(k,149) = -rxt(k,224)*y(k,96) + mat(k,156) = -rxt(k,226)*y(k,96) + mat(k,83) = -rxt(k,227)*y(k,96) + mat(k,92) = -rxt(k,228)*y(k,96) + mat(k,113) = -rxt(k,229)*y(k,96) + mat(k,484) = -rxt(k,237)*y(k,96) + mat(k,162) = -rxt(k,240)*y(k,96) + mat(k,402) = -rxt(k,241)*y(k,96) + mat(k,285) = -rxt(k,245)*y(k,96) + mat(k,129) = -(rxt(k,247) + rxt(k,261)) * y(k,96) + mat(k,143) = -rxt(k,249)*y(k,96) + mat(k,301) = -rxt(k,251)*y(k,96) + mat(k,238) = -rxt(k,255)*y(k,96) + mat(k,433) = -rxt(k,260)*y(k,96) + mat(k,484) = mat(k,484) + rxt(k,236)*y(k,68) + mat(k,162) = mat(k,162) + .300_r8*rxt(k,240)*y(k,96) + mat(k,402) = mat(k,402) + rxt(k,242)*y(k,92) + mat(k,902) = rxt(k,160)*y(k,87) + mat(k,292) = rxt(k,214)*y(k,100) + mat(k,441) = rxt(k,119)*y(k,70) + 2.000_r8*rxt(k,114)*y(k,87) + mat(k,925) = mat(k,925) + rxt(k,111)*y(k,68) + rxt(k,94)*y(k,92) + mat(k,220) = mat(k,220) + rxt(k,112)*y(k,68) + mat(k,259) = mat(k,259) + rxt(k,204)*y(k,68) + rxt(k,210)*y(k,92) + mat(k,461) = mat(k,461) + rxt(k,175)*y(k,68) + rxt(k,187)*y(k,92) + mat(k,250) = rxt(k,206)*y(k,68) + mat(k,266) = mat(k,266) + rxt(k,178)*y(k,68) + mat(k,681) = rxt(k,144)*y(k,87) + mat(k,614) = mat(k,614) + rxt(k,139)*y(k,87) + mat(k,656) = mat(k,656) + rxt(k,236)*y(k,17) + rxt(k,111)*y(k,41) & + + rxt(k,112)*y(k,43) + rxt(k,204)*y(k,45) + rxt(k,175)*y(k,49) & + + rxt(k,206)*y(k,53) + rxt(k,178)*y(k,54) + rxt(k,117)*y(k,87) + mat(k,536) = mat(k,536) + rxt(k,119)*y(k,40) + rxt(k,118)*y(k,87) + mat(k,561) = mat(k,561) + rxt(k,160)*y(k,25) + 2.000_r8*rxt(k,114)*y(k,40) & + + rxt(k,144)*y(k,61) + rxt(k,139)*y(k,63) + rxt(k,117)*y(k,68) & + + rxt(k,118)*y(k,70) + mat(k,723) = rxt(k,242)*y(k,23) + rxt(k,94)*y(k,41) + rxt(k,210)*y(k,45) & + + rxt(k,187)*y(k,49) + 2.000_r8*rxt(k,95)*y(k,100) + mat(k,847) = mat(k,847) + .300_r8*rxt(k,240)*y(k,22) + mat(k,952) = rxt(k,214)*y(k,39) + 2.000_r8*rxt(k,95)*y(k,92) end do - end subroutine nlnmat03 - subroutine nlnmat04( avec_len, mat, y, rxt ) + end subroutine nlnmat04 + subroutine nlnmat05( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -744,48 +958,57 @@ subroutine nlnmat04( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,189) = -(rxt(k,302)*y(k,88) + rxt(k,303)*y(k,67)) - mat(k,226) = -rxt(k,302)*y(k,97) - mat(k,607) = -rxt(k,303)*y(k,97) - mat(k,477) = rxt(k,293)*y(k,89) + rxt(k,294)*y(k,91) + rxt(k,306)*y(k,98) & - + rxt(k,312)*y(k,99) - mat(k,213) = rxt(k,304)*y(k,98) + rxt(k,309)*y(k,99) - mat(k,124) = rxt(k,293)*y(k,66) - mat(k,171) = rxt(k,294)*y(k,66) - mat(k,99) = rxt(k,306)*y(k,66) + rxt(k,304)*y(k,86) - mat(k,94) = rxt(k,312)*y(k,66) + rxt(k,309)*y(k,86) - mat(k,97) = -(rxt(k,304)*y(k,86) + rxt(k,306)*y(k,66) + rxt(k,307)*y(k,67)) - mat(k,209) = -rxt(k,304)*y(k,98) - mat(k,466) = -rxt(k,306)*y(k,98) - mat(k,602) = -rxt(k,307)*y(k,98) - mat(k,209) = mat(k,209) + rxt(k,308)*y(k,99) - mat(k,91) = rxt(k,308)*y(k,86) - mat(k,90) = -((rxt(k,308) + rxt(k,309)) * y(k,86) + rxt(k,312)*y(k,66)) - mat(k,208) = -(rxt(k,308) + rxt(k,309)) * y(k,99) - mat(k,465) = -rxt(k,312)*y(k,99) - mat(k,764) = -(rxt(k,95)*y(k,92) + rxt(k,214)*y(k,37) + rxt(k,260)*y(k,77)) - mat(k,551) = -rxt(k,95)*y(k,100) - mat(k,160) = -rxt(k,214)*y(k,100) - mat(k,51) = -rxt(k,260)*y(k,100) - mat(k,526) = rxt(k,237)*y(k,96) - mat(k,82) = rxt(k,240)*y(k,96) - mat(k,306) = rxt(k,115)*y(k,87) - mat(k,572) = rxt(k,120)*y(k,96) - mat(k,121) = rxt(k,121)*y(k,96) - mat(k,185) = rxt(k,205)*y(k,96) - mat(k,344) = (rxt(k,276)+rxt(k,281))*y(k,51) + (rxt(k,269)+rxt(k,275) & - +rxt(k,280))*y(k,52) + rxt(k,176)*y(k,96) - mat(k,281) = rxt(k,152)*y(k,96) - mat(k,89) = rxt(k,128)*y(k,96) - mat(k,151) = (rxt(k,276)+rxt(k,281))*y(k,47) - mat(k,168) = (rxt(k,269)+rxt(k,275)+rxt(k,280))*y(k,47) + rxt(k,179)*y(k,96) - mat(k,408) = rxt(k,115)*y(k,38) + rxt(k,122)*y(k,96) - mat(k,666) = rxt(k,237)*y(k,16) + rxt(k,240)*y(k,21) + rxt(k,120)*y(k,39) & - + rxt(k,121)*y(k,41) + rxt(k,205)*y(k,43) + rxt(k,176)*y(k,47) & - + rxt(k,152)*y(k,49) + rxt(k,128)*y(k,50) + rxt(k,179)*y(k,52) & + mat(k,375) = -(rxt(k,299)*y(k,32) + rxt(k,301)*y(k,88) + rxt(k,302)*y(k,69)) + mat(k,196) = -rxt(k,299)*y(k,97) + mat(k,334) = -rxt(k,301)*y(k,97) + mat(k,502) = -rxt(k,302)*y(k,97) + mat(k,640) = rxt(k,292)*y(k,89) + rxt(k,293)*y(k,91) + rxt(k,305)*y(k,98) & + + rxt(k,311)*y(k,99) + mat(k,324) = rxt(k,303)*y(k,98) + rxt(k,308)*y(k,99) + mat(k,229) = rxt(k,292)*y(k,68) + mat(k,275) = rxt(k,293)*y(k,68) + mat(k,188) = rxt(k,305)*y(k,68) + rxt(k,303)*y(k,86) + mat(k,182) = rxt(k,311)*y(k,68) + rxt(k,308)*y(k,86) + mat(k,185) = -(rxt(k,303)*y(k,86) + rxt(k,305)*y(k,68) + rxt(k,306)*y(k,69)) + mat(k,316) = -rxt(k,303)*y(k,98) + mat(k,623) = -rxt(k,305)*y(k,98) + mat(k,492) = -rxt(k,306)*y(k,98) + mat(k,316) = mat(k,316) + rxt(k,307)*y(k,99) + mat(k,179) = rxt(k,307)*y(k,86) + mat(k,178) = -((rxt(k,307) + rxt(k,308)) * y(k,86) + rxt(k,311)*y(k,68)) + mat(k,315) = -(rxt(k,307) + rxt(k,308)) * y(k,99) + mat(k,622) = -rxt(k,311)*y(k,99) + mat(k,956) = -(rxt(k,95)*y(k,92) + rxt(k,214)*y(k,39) + rxt(k,262)*y(k,79)) + mat(k,727) = -rxt(k,95)*y(k,100) + mat(k,295) = -rxt(k,214)*y(k,100) + mat(k,108) = -rxt(k,262)*y(k,100) + mat(k,170) = rxt(k,219)*y(k,96) + mat(k,488) = rxt(k,237)*y(k,96) + mat(k,215) = rxt(k,221)*y(k,96) + mat(k,49) = rxt(k,222)*y(k,96) + mat(k,151) = rxt(k,224)*y(k,96) + mat(k,163) = rxt(k,240)*y(k,96) + mat(k,406) = rxt(k,241)*y(k,96) + mat(k,443) = rxt(k,115)*y(k,87) + mat(k,929) = rxt(k,120)*y(k,96) + mat(k,222) = rxt(k,121)*y(k,96) + mat(k,260) = rxt(k,205)*y(k,96) + mat(k,115) = rxt(k,229)*y(k,96) + mat(k,465) = (rxt(k,275)+rxt(k,280))*y(k,53) + (rxt(k,268)+rxt(k,274) & + +rxt(k,279))*y(k,54) + rxt(k,176)*y(k,96) + mat(k,874) = rxt(k,152)*y(k,96) + mat(k,177) = rxt(k,128)*y(k,96) + mat(k,252) = (rxt(k,275)+rxt(k,280))*y(k,49) + mat(k,268) = (rxt(k,268)+rxt(k,274)+rxt(k,279))*y(k,49) + rxt(k,179)*y(k,96) + mat(k,565) = rxt(k,115)*y(k,40) + rxt(k,122)*y(k,96) + mat(k,851) = rxt(k,219)*y(k,16) + rxt(k,237)*y(k,17) + rxt(k,221)*y(k,18) & + + rxt(k,222)*y(k,19) + rxt(k,224)*y(k,20) + rxt(k,240)*y(k,22) & + + rxt(k,241)*y(k,23) + rxt(k,120)*y(k,41) + rxt(k,121)*y(k,43) & + + rxt(k,205)*y(k,45) + rxt(k,229)*y(k,48) + rxt(k,176)*y(k,49) & + + rxt(k,152)*y(k,51) + rxt(k,128)*y(k,52) + rxt(k,179)*y(k,54) & + rxt(k,122)*y(k,87) + 2.000_r8*rxt(k,125)*y(k,96) end do - end subroutine nlnmat04 + end subroutine nlnmat05 subroutine nlnmat_finit( avec_len, mat, lmat, dti ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none @@ -831,364 +1054,441 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 25) = lmat(k, 25) mat(k, 26) = lmat(k, 26) mat(k, 27) = mat(k, 27) + lmat(k, 27) - mat(k, 28) = mat(k, 28) + lmat(k, 28) + mat(k, 29) = mat(k, 29) + lmat(k, 29) mat(k, 30) = mat(k, 30) + lmat(k, 30) mat(k, 31) = mat(k, 31) + lmat(k, 31) - mat(k, 32) = mat(k, 32) + lmat(k, 32) mat(k, 33) = 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, 34) = mat(k, 34) + lmat(k, 34) + mat(k, 35) = mat(k, 35) + lmat(k, 35) mat(k, 37) = mat(k, 37) + lmat(k, 37) mat(k, 38) = mat(k, 38) + lmat(k, 38) mat(k, 39) = mat(k, 39) + lmat(k, 39) - mat(k, 41) = lmat(k, 41) - mat(k, 42) = lmat(k, 42) - mat(k, 43) = lmat(k, 43) - mat(k, 44) = lmat(k, 44) - mat(k, 45) = lmat(k, 45) - mat(k, 46) = lmat(k, 46) + mat(k, 41) = mat(k, 41) + lmat(k, 41) + 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, 46) = mat(k, 46) + lmat(k, 46) mat(k, 48) = mat(k, 48) + lmat(k, 48) - mat(k, 49) = lmat(k, 49) mat(k, 50) = lmat(k, 50) + mat(k, 51) = lmat(k, 51) mat(k, 52) = lmat(k, 52) - mat(k, 53) = lmat(k, 53) - mat(k, 54) = lmat(k, 54) - mat(k, 55) = lmat(k, 55) - mat(k, 56) = lmat(k, 56) - mat(k, 57) = lmat(k, 57) + mat(k, 53) = mat(k, 53) + lmat(k, 53) + mat(k, 54) = mat(k, 54) + lmat(k, 54) + mat(k, 56) = mat(k, 56) + lmat(k, 56) + mat(k, 57) = mat(k, 57) + lmat(k, 57) mat(k, 58) = mat(k, 58) + lmat(k, 58) + mat(k, 59) = mat(k, 59) + lmat(k, 59) + mat(k, 60) = mat(k, 60) + lmat(k, 60) + mat(k, 62) = mat(k, 62) + lmat(k, 62) + mat(k, 63) = mat(k, 63) + lmat(k, 63) mat(k, 64) = mat(k, 64) + lmat(k, 64) + mat(k, 65) = mat(k, 65) + lmat(k, 65) mat(k, 67) = mat(k, 67) + lmat(k, 67) - mat(k, 68) = lmat(k, 68) + mat(k, 68) = mat(k, 68) + lmat(k, 68) mat(k, 69) = mat(k, 69) + lmat(k, 69) mat(k, 70) = mat(k, 70) + lmat(k, 70) - mat(k, 71) = lmat(k, 71) + mat(k, 72) = mat(k, 72) + lmat(k, 72) + mat(k, 73) = lmat(k, 73) + mat(k, 74) = lmat(k, 74) + mat(k, 75) = mat(k, 75) + lmat(k, 75) + mat(k, 76) = mat(k, 76) + lmat(k, 76) mat(k, 77) = mat(k, 77) + lmat(k, 77) - mat(k, 78) = lmat(k, 78) + mat(k, 78) = mat(k, 78) + lmat(k, 78) + mat(k, 79) = lmat(k, 79) mat(k, 80) = mat(k, 80) + lmat(k, 80) mat(k, 81) = mat(k, 81) + lmat(k, 81) - mat(k, 83) = mat(k, 83) + lmat(k, 83) - mat(k, 84) = lmat(k, 84) - mat(k, 85) = lmat(k, 85) - mat(k, 87) = mat(k, 87) + lmat(k, 87) + mat(k, 84) = mat(k, 84) + lmat(k, 84) + mat(k, 85) = mat(k, 85) + lmat(k, 85) + mat(k, 86) = mat(k, 86) + lmat(k, 86) mat(k, 88) = 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, 91) = mat(k, 91) + lmat(k, 91) - mat(k, 92) = lmat(k, 92) - mat(k, 93) = lmat(k, 93) + mat(k, 93) = mat(k, 93) + lmat(k, 93) mat(k, 94) = mat(k, 94) + lmat(k, 94) - mat(k, 95) = lmat(k, 95) - mat(k, 96) = lmat(k, 96) - mat(k, 97) = mat(k, 97) + lmat(k, 97) + mat(k, 95) = mat(k, 95) + lmat(k, 95) + mat(k, 97) = lmat(k, 97) mat(k, 98) = lmat(k, 98) - mat(k, 99) = mat(k, 99) + lmat(k, 99) - mat(k, 101) = mat(k, 101) + lmat(k, 101) + mat(k, 99) = lmat(k, 99) + mat(k, 100) = mat(k, 100) + lmat(k, 100) mat(k, 103) = mat(k, 103) + lmat(k, 103) - mat(k, 107) = mat(k, 107) + lmat(k, 107) - 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, 113) = mat(k, 113) + lmat(k, 113) - mat(k, 114) = lmat(k, 114) - mat(k, 115) = mat(k, 115) + lmat(k, 115) - mat(k, 120) = mat(k, 120) + lmat(k, 120) - mat(k, 122) = mat(k, 122) + lmat(k, 122) + mat(k, 105) = mat(k, 105) + lmat(k, 105) + mat(k, 106) = lmat(k, 106) + mat(k, 107) = lmat(k, 107) + mat(k, 109) = mat(k, 109) + lmat(k, 109) + mat(k, 110) = mat(k, 110) + lmat(k, 110) + mat(k, 114) = mat(k, 114) + lmat(k, 114) + mat(k, 116) = lmat(k, 116) + mat(k, 117) = lmat(k, 117) + mat(k, 118) = lmat(k, 118) + mat(k, 119) = lmat(k, 119) + 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) = mat(k, 125) + lmat(k, 125) mat(k, 131) = mat(k, 131) + lmat(k, 131) + mat(k, 134) = mat(k, 134) + lmat(k, 134) + mat(k, 135) = lmat(k, 135) + mat(k, 136) = mat(k, 136) + lmat(k, 136) + mat(k, 137) = lmat(k, 137) mat(k, 138) = mat(k, 138) + lmat(k, 138) mat(k, 144) = mat(k, 144) + lmat(k, 144) - mat(k, 145) = lmat(k, 145) + mat(k, 146) = lmat(k, 146) mat(k, 150) = mat(k, 150) + lmat(k, 150) mat(k, 152) = mat(k, 152) + lmat(k, 152) - mat(k, 153) = mat(k, 153) + lmat(k, 153) - mat(k, 156) = lmat(k, 156) + mat(k, 155) = mat(k, 155) + lmat(k, 155) + mat(k, 158) = mat(k, 158) + lmat(k, 158) + mat(k, 160) = lmat(k, 160) + mat(k, 161) = mat(k, 161) + lmat(k, 161) mat(k, 162) = mat(k, 162) + lmat(k, 162) mat(k, 164) = mat(k, 164) + lmat(k, 164) mat(k, 167) = mat(k, 167) + lmat(k, 167) - mat(k, 170) = mat(k, 170) + lmat(k, 170) + mat(k, 171) = mat(k, 171) + lmat(k, 171) + mat(k, 173) = lmat(k, 173) + mat(k, 174) = lmat(k, 174) + mat(k, 175) = mat(k, 175) + lmat(k, 175) + mat(k, 176) = mat(k, 176) + lmat(k, 176) mat(k, 178) = mat(k, 178) + lmat(k, 178) mat(k, 179) = mat(k, 179) + lmat(k, 179) - mat(k, 180) = mat(k, 180) + lmat(k, 180) + mat(k, 180) = lmat(k, 180) + mat(k, 181) = lmat(k, 181) + mat(k, 182) = mat(k, 182) + lmat(k, 182) + mat(k, 183) = lmat(k, 183) + mat(k, 184) = lmat(k, 184) + mat(k, 185) = mat(k, 185) + lmat(k, 185) mat(k, 186) = lmat(k, 186) - mat(k, 187) = lmat(k, 187) - mat(k, 189) = mat(k, 189) + lmat(k, 189) + mat(k, 188) = mat(k, 188) + lmat(k, 188) mat(k, 190) = mat(k, 190) + lmat(k, 190) - mat(k, 193) = lmat(k, 193) + mat(k, 193) = mat(k, 193) + lmat(k, 193) + mat(k, 194) = mat(k, 194) + lmat(k, 194) + mat(k, 198) = lmat(k, 198) mat(k, 199) = mat(k, 199) + lmat(k, 199) - mat(k, 200) = mat(k, 200) + lmat(k, 200) + mat(k, 200) = lmat(k, 200) + mat(k, 201) = mat(k, 201) + lmat(k, 201) + mat(k, 203) = mat(k, 203) + lmat(k, 203) + mat(k, 204) = lmat(k, 204) + mat(k, 205) = lmat(k, 205) + mat(k, 206) = lmat(k, 206) mat(k, 207) = mat(k, 207) + lmat(k, 207) - mat(k, 215) = mat(k, 215) + lmat(k, 215) - mat(k, 229) = mat(k, 229) + lmat(k, 229) - mat(k, 239) = lmat(k, 239) - mat(k, 242) = lmat(k, 242) - mat(k, 244) = mat(k, 244) + lmat(k, 244) + mat(k, 208) = lmat(k, 208) + mat(k, 212) = mat(k, 212) + lmat(k, 212) + mat(k, 216) = mat(k, 216) + lmat(k, 216) + mat(k, 220) = mat(k, 220) + lmat(k, 220) + mat(k, 223) = mat(k, 223) + lmat(k, 223) + mat(k, 232) = mat(k, 232) + lmat(k, 232) + mat(k, 239) = mat(k, 239) + lmat(k, 239) + mat(k, 245) = mat(k, 245) + lmat(k, 245) + mat(k, 249) = lmat(k, 249) + mat(k, 250) = mat(k, 250) + lmat(k, 250) + mat(k, 253) = mat(k, 253) + lmat(k, 253) mat(k, 254) = mat(k, 254) + lmat(k, 254) - mat(k, 255) = lmat(k, 255) - mat(k, 257) = lmat(k, 257) - mat(k, 261) = mat(k, 261) + lmat(k, 261) + mat(k, 258) = mat(k, 258) + lmat(k, 258) mat(k, 262) = mat(k, 262) + lmat(k, 262) - mat(k, 263) = mat(k, 263) + lmat(k, 263) - mat(k, 265) = mat(k, 265) + lmat(k, 265) mat(k, 266) = mat(k, 266) + lmat(k, 266) mat(k, 267) = mat(k, 267) + lmat(k, 267) - mat(k, 270) = lmat(k, 270) - mat(k, 274) = mat(k, 274) + lmat(k, 274) + mat(k, 270) = mat(k, 270) + lmat(k, 270) mat(k, 279) = mat(k, 279) + lmat(k, 279) - mat(k, 280) = lmat(k, 280) - mat(k, 283) = lmat(k, 283) - mat(k, 285) = mat(k, 285) + lmat(k, 285) - mat(k, 291) = mat(k, 291) + lmat(k, 291) - mat(k, 299) = mat(k, 299) + lmat(k, 299) - mat(k, 310) = mat(k, 310) + lmat(k, 310) - mat(k, 327) = mat(k, 327) + lmat(k, 327) - mat(k, 329) = mat(k, 329) + lmat(k, 329) - mat(k, 333) = mat(k, 333) + lmat(k, 333) - mat(k, 347) = mat(k, 347) + lmat(k, 347) - mat(k, 364) = mat(k, 364) + lmat(k, 364) - mat(k, 369) = mat(k, 369) + lmat(k, 369) - mat(k, 373) = mat(k, 373) + lmat(k, 373) - mat(k, 378) = mat(k, 378) + lmat(k, 378) - mat(k, 381) = mat(k, 381) + lmat(k, 381) - mat(k, 382) = mat(k, 382) + lmat(k, 382) - mat(k, 386) = mat(k, 386) + lmat(k, 386) - mat(k, 395) = mat(k, 395) + lmat(k, 395) - mat(k, 410) = mat(k, 410) + lmat(k, 410) - mat(k, 416) = lmat(k, 416) - mat(k, 417) = mat(k, 417) + lmat(k, 417) - mat(k, 418) = lmat(k, 418) - mat(k, 420) = mat(k, 420) + lmat(k, 420) - mat(k, 421) = mat(k, 421) + lmat(k, 421) + mat(k, 287) = mat(k, 287) + lmat(k, 287) + mat(k, 297) = mat(k, 297) + lmat(k, 297) + mat(k, 298) = lmat(k, 298) + mat(k, 300) = lmat(k, 300) + mat(k, 304) = mat(k, 304) + lmat(k, 304) + mat(k, 305) = mat(k, 305) + lmat(k, 305) + mat(k, 307) = mat(k, 307) + lmat(k, 307) + mat(k, 308) = mat(k, 308) + lmat(k, 308) + mat(k, 310) = lmat(k, 310) + mat(k, 312) = mat(k, 312) + lmat(k, 312) + mat(k, 313) = mat(k, 313) + lmat(k, 313) + mat(k, 320) = mat(k, 320) + lmat(k, 320) + mat(k, 331) = mat(k, 331) + lmat(k, 331) + mat(k, 341) = lmat(k, 341) + mat(k, 342) = lmat(k, 342) + mat(k, 344) = mat(k, 344) + lmat(k, 344) + mat(k, 354) = mat(k, 354) + lmat(k, 354) + mat(k, 358) = mat(k, 358) + lmat(k, 358) + mat(k, 363) = mat(k, 363) + lmat(k, 363) + mat(k, 368) = lmat(k, 368) + mat(k, 373) = lmat(k, 373) + mat(k, 375) = mat(k, 375) + lmat(k, 375) + mat(k, 385) = lmat(k, 385) + mat(k, 386) = lmat(k, 386) + mat(k, 390) = mat(k, 390) + lmat(k, 390) + mat(k, 391) = mat(k, 391) + lmat(k, 391) + mat(k, 392) = mat(k, 392) + lmat(k, 392) + mat(k, 394) = mat(k, 394) + lmat(k, 394) + mat(k, 398) = lmat(k, 398) + mat(k, 402) = mat(k, 402) + lmat(k, 402) + mat(k, 405) = mat(k, 405) + lmat(k, 405) + mat(k, 406) = mat(k, 406) + lmat(k, 406) + mat(k, 408) = mat(k, 408) + lmat(k, 408) + mat(k, 420) = lmat(k, 420) + mat(k, 422) = mat(k, 422) + lmat(k, 422) + mat(k, 428) = mat(k, 428) + lmat(k, 428) + mat(k, 436) = mat(k, 436) + lmat(k, 436) mat(k, 449) = mat(k, 449) + lmat(k, 449) mat(k, 450) = mat(k, 450) + lmat(k, 450) - mat(k, 451) = mat(k, 451) + lmat(k, 451) - mat(k, 465) = mat(k, 465) + lmat(k, 465) - mat(k, 466) = mat(k, 466) + lmat(k, 466) - mat(k, 477) = mat(k, 477) + lmat(k, 477) - mat(k, 479) = lmat(k, 479) - mat(k, 494) = mat(k, 494) + lmat(k, 494) + mat(k, 463) = mat(k, 463) + lmat(k, 463) + mat(k, 467) = mat(k, 467) + lmat(k, 467) + mat(k, 470) = mat(k, 470) + lmat(k, 470) + mat(k, 472) = mat(k, 472) + lmat(k, 472) + mat(k, 487) = lmat(k, 487) + mat(k, 491) = lmat(k, 491) + mat(k, 492) = mat(k, 492) + lmat(k, 492) + mat(k, 498) = lmat(k, 498) + mat(k, 501) = mat(k, 501) + lmat(k, 501) + mat(k, 502) = mat(k, 502) + lmat(k, 502) mat(k, 505) = mat(k, 505) + lmat(k, 505) - mat(k, 508) = mat(k, 508) + lmat(k, 508) - mat(k, 517) = mat(k, 517) + lmat(k, 517) - mat(k, 519) = lmat(k, 519) - mat(k, 527) = mat(k, 527) + lmat(k, 527) - mat(k, 529) = mat(k, 529) + lmat(k, 529) + mat(k, 509) = mat(k, 509) + lmat(k, 509) + mat(k, 511) = mat(k, 511) + lmat(k, 511) + mat(k, 519) = mat(k, 519) + lmat(k, 519) + mat(k, 525) = mat(k, 525) + lmat(k, 525) + mat(k, 526) = mat(k, 526) + lmat(k, 526) mat(k, 530) = mat(k, 530) + lmat(k, 530) - mat(k, 533) = mat(k, 533) + lmat(k, 533) - mat(k, 534) = mat(k, 534) + lmat(k, 534) - mat(k, 536) = lmat(k, 536) - mat(k, 538) = lmat(k, 538) - mat(k, 539) = mat(k, 539) + lmat(k, 539) - mat(k, 541) = mat(k, 541) + lmat(k, 541) - mat(k, 542) = lmat(k, 542) - mat(k, 543) = mat(k, 543) + lmat(k, 543) - mat(k, 544) = mat(k, 544) + lmat(k, 544) - mat(k, 546) = mat(k, 546) + lmat(k, 546) - mat(k, 547) = mat(k, 547) + lmat(k, 547) - mat(k, 550) = lmat(k, 550) - mat(k, 565) = mat(k, 565) + lmat(k, 565) + mat(k, 532) = mat(k, 532) + lmat(k, 532) + mat(k, 542) = mat(k, 542) + lmat(k, 542) + mat(k, 552) = mat(k, 552) + lmat(k, 552) mat(k, 581) = mat(k, 581) + lmat(k, 581) - mat(k, 588) = mat(k, 588) + lmat(k, 588) - mat(k, 592) = mat(k, 592) + lmat(k, 592) - mat(k, 601) = lmat(k, 601) - mat(k, 602) = mat(k, 602) + lmat(k, 602) + mat(k, 583) = mat(k, 583) + lmat(k, 583) + mat(k, 591) = mat(k, 591) + lmat(k, 591) + mat(k, 603) = mat(k, 603) + lmat(k, 603) mat(k, 607) = mat(k, 607) + lmat(k, 607) mat(k, 608) = mat(k, 608) + lmat(k, 608) - mat(k, 609) = lmat(k, 609) - mat(k, 619) = mat(k, 619) + lmat(k, 619) - mat(k, 621) = mat(k, 621) + lmat(k, 621) - mat(k, 624) = mat(k, 624) + lmat(k, 624) - mat(k, 630) = lmat(k, 630) - mat(k, 631) = lmat(k, 631) - mat(k, 649) = mat(k, 649) + lmat(k, 649) - mat(k, 651) = mat(k, 651) + lmat(k, 651) - mat(k, 653) = mat(k, 653) + lmat(k, 653) - mat(k, 654) = mat(k, 654) + lmat(k, 654) - mat(k, 662) = mat(k, 662) + lmat(k, 662) - mat(k, 666) = mat(k, 666) + lmat(k, 666) - mat(k, 667) = mat(k, 667) + lmat(k, 667) - mat(k, 678) = mat(k, 678) + lmat(k, 678) - mat(k, 680) = mat(k, 680) + lmat(k, 680) - mat(k, 683) = mat(k, 683) + lmat(k, 683) - mat(k, 685) = mat(k, 685) + lmat(k, 685) - mat(k, 696) = mat(k, 696) + lmat(k, 696) - mat(k, 706) = mat(k, 706) + lmat(k, 706) - mat(k, 712) = mat(k, 712) + lmat(k, 712) - mat(k, 714) = mat(k, 714) + lmat(k, 714) - mat(k, 715) = mat(k, 715) + lmat(k, 715) + mat(k, 609) = mat(k, 609) + lmat(k, 609) + mat(k, 613) = mat(k, 613) + lmat(k, 613) + mat(k, 615) = mat(k, 615) + lmat(k, 615) + mat(k, 622) = mat(k, 622) + lmat(k, 622) + mat(k, 623) = mat(k, 623) + lmat(k, 623) + mat(k, 636) = lmat(k, 636) + mat(k, 640) = mat(k, 640) + lmat(k, 640) + mat(k, 650) = mat(k, 650) + lmat(k, 650) + mat(k, 661) = mat(k, 661) + lmat(k, 661) + mat(k, 662) = lmat(k, 662) + mat(k, 664) = mat(k, 664) + lmat(k, 664) + mat(k, 675) = mat(k, 675) + lmat(k, 675) + mat(k, 676) = mat(k, 676) + lmat(k, 676) mat(k, 717) = mat(k, 717) + lmat(k, 717) - mat(k, 719) = lmat(k, 719) - mat(k, 721) = mat(k, 721) + lmat(k, 721) - mat(k, 729) = mat(k, 729) + lmat(k, 729) - mat(k, 738) = mat(k, 738) + lmat(k, 738) - mat(k, 747) = lmat(k, 747) - mat(k, 754) = lmat(k, 754) - mat(k, 756) = mat(k, 756) + lmat(k, 756) - mat(k, 757) = lmat(k, 757) - mat(k, 760) = mat(k, 760) + lmat(k, 760) - mat(k, 764) = mat(k, 764) + lmat(k, 764) - mat(k, 147) = 0._r8 - mat(k, 173) = 0._r8 - mat(k, 174) = 0._r8 - mat(k, 191) = 0._r8 - mat(k, 194) = 0._r8 - mat(k, 195) = 0._r8 - mat(k, 198) = 0._r8 - mat(k, 202) = 0._r8 - mat(k, 212) = 0._r8 - mat(k, 218) = 0._r8 - mat(k, 219) = 0._r8 - mat(k, 222) = 0._r8 - mat(k, 223) = 0._r8 - mat(k, 224) = 0._r8 - mat(k, 227) = 0._r8 - mat(k, 228) = 0._r8 - mat(k, 231) = 0._r8 - mat(k, 232) = 0._r8 - mat(k, 236) = 0._r8 - mat(k, 240) = 0._r8 - mat(k, 243) = 0._r8 - mat(k, 246) = 0._r8 - mat(k, 248) = 0._r8 - mat(k, 259) = 0._r8 + mat(k, 719) = mat(k, 719) + lmat(k, 719) + mat(k, 741) = mat(k, 741) + lmat(k, 741) + mat(k, 744) = mat(k, 744) + lmat(k, 744) + mat(k, 745) = mat(k, 745) + lmat(k, 745) + mat(k, 767) = mat(k, 767) + lmat(k, 767) + mat(k, 792) = mat(k, 792) + lmat(k, 792) + mat(k, 793) = mat(k, 793) + lmat(k, 793) + mat(k, 797) = mat(k, 797) + lmat(k, 797) + mat(k, 798) = mat(k, 798) + lmat(k, 798) + mat(k, 799) = mat(k, 799) + lmat(k, 799) + mat(k, 847) = mat(k, 847) + lmat(k, 847) + mat(k, 869) = lmat(k, 869) + mat(k, 870) = mat(k, 870) + lmat(k, 870) + mat(k, 871) = mat(k, 871) + lmat(k, 871) + mat(k, 904) = mat(k, 904) + lmat(k, 904) + mat(k, 928) = mat(k, 928) + lmat(k, 928) + mat(k, 938) = lmat(k, 938) + mat(k, 946) = lmat(k, 946) + mat(k, 948) = mat(k, 948) + lmat(k, 948) + mat(k, 952) = mat(k, 952) + lmat(k, 952) + mat(k, 955) = lmat(k, 955) + mat(k, 956) = mat(k, 956) + lmat(k, 956) + mat(k, 111) = 0._r8 + mat(k, 197) = 0._r8 + mat(k, 251) = 0._r8 mat(k, 271) = 0._r8 - mat(k, 275) = 0._r8 - mat(k, 276) = 0._r8 - mat(k, 278) = 0._r8 - mat(k, 288) = 0._r8 - mat(k, 298) = 0._r8 - mat(k, 309) = 0._r8 - mat(k, 312) = 0._r8 + mat(k, 272) = 0._r8 + mat(k, 280) = 0._r8 + mat(k, 281) = 0._r8 + mat(k, 282) = 0._r8 + mat(k, 284) = 0._r8 + mat(k, 302) = 0._r8 mat(k, 314) = 0._r8 - mat(k, 315) = 0._r8 - mat(k, 318) = 0._r8 - mat(k, 320) = 0._r8 - mat(k, 328) = 0._r8 + mat(k, 319) = 0._r8 + mat(k, 325) = 0._r8 + mat(k, 327) = 0._r8 mat(k, 330) = 0._r8 - mat(k, 331) = 0._r8 - mat(k, 332) = 0._r8 - mat(k, 336) = 0._r8 - mat(k, 338) = 0._r8 - mat(k, 339) = 0._r8 - mat(k, 340) = 0._r8 - mat(k, 342) = 0._r8 + mat(k, 333) = 0._r8 mat(k, 343) = 0._r8 mat(k, 346) = 0._r8 mat(k, 351) = 0._r8 - mat(k, 353) = 0._r8 - mat(k, 355) = 0._r8 mat(k, 356) = 0._r8 mat(k, 359) = 0._r8 + mat(k, 360) = 0._r8 mat(k, 365) = 0._r8 mat(k, 366) = 0._r8 - mat(k, 367) = 0._r8 - mat(k, 368) = 0._r8 mat(k, 371) = 0._r8 - mat(k, 372) = 0._r8 - mat(k, 375) = 0._r8 mat(k, 376) = 0._r8 - mat(k, 377) = 0._r8 + mat(k, 378) = 0._r8 mat(k, 380) = 0._r8 + mat(k, 381) = 0._r8 + mat(k, 382) = 0._r8 mat(k, 383) = 0._r8 + mat(k, 388) = 0._r8 + mat(k, 389) = 0._r8 + mat(k, 395) = 0._r8 + mat(k, 397) = 0._r8 mat(k, 399) = 0._r8 - mat(k, 400) = 0._r8 - mat(k, 414) = 0._r8 - mat(k, 423) = 0._r8 - mat(k, 425) = 0._r8 - mat(k, 427) = 0._r8 - mat(k, 431) = 0._r8 - mat(k, 432) = 0._r8 - mat(k, 433) = 0._r8 - mat(k, 441) = 0._r8 - mat(k, 443) = 0._r8 - mat(k, 447) = 0._r8 + mat(k, 401) = 0._r8 + mat(k, 403) = 0._r8 + mat(k, 409) = 0._r8 + mat(k, 416) = 0._r8 + mat(k, 418) = 0._r8 + mat(k, 426) = 0._r8 + mat(k, 435) = 0._r8 + mat(k, 451) = 0._r8 + mat(k, 452) = 0._r8 mat(k, 453) = 0._r8 - mat(k, 454) = 0._r8 + mat(k, 455) = 0._r8 mat(k, 458) = 0._r8 - mat(k, 461) = 0._r8 - mat(k, 471) = 0._r8 - mat(k, 478) = 0._r8 - mat(k, 482) = 0._r8 - mat(k, 484) = 0._r8 - mat(k, 489) = 0._r8 - mat(k, 496) = 0._r8 - mat(k, 504) = 0._r8 - mat(k, 511) = 0._r8 + mat(k, 459) = 0._r8 + mat(k, 460) = 0._r8 + mat(k, 464) = 0._r8 + mat(k, 468) = 0._r8 + mat(k, 469) = 0._r8 + mat(k, 473) = 0._r8 + mat(k, 474) = 0._r8 + mat(k, 476) = 0._r8 + mat(k, 479) = 0._r8 + mat(k, 480) = 0._r8 + mat(k, 481) = 0._r8 + mat(k, 483) = 0._r8 + mat(k, 508) = 0._r8 + mat(k, 512) = 0._r8 + mat(k, 513) = 0._r8 + mat(k, 514) = 0._r8 mat(k, 515) = 0._r8 + mat(k, 516) = 0._r8 + mat(k, 517) = 0._r8 mat(k, 518) = 0._r8 - mat(k, 520) = 0._r8 - mat(k, 521) = 0._r8 - mat(k, 523) = 0._r8 - mat(k, 524) = 0._r8 - mat(k, 525) = 0._r8 - mat(k, 532) = 0._r8 - mat(k, 537) = 0._r8 + mat(k, 538) = 0._r8 + mat(k, 539) = 0._r8 mat(k, 549) = 0._r8 - mat(k, 554) = 0._r8 mat(k, 557) = 0._r8 - mat(k, 558) = 0._r8 - mat(k, 559) = 0._r8 - mat(k, 561) = 0._r8 - mat(k, 563) = 0._r8 - mat(k, 566) = 0._r8 - mat(k, 567) = 0._r8 - mat(k, 569) = 0._r8 - mat(k, 570) = 0._r8 - mat(k, 571) = 0._r8 - mat(k, 578) = 0._r8 - mat(k, 580) = 0._r8 + mat(k, 562) = 0._r8 + mat(k, 575) = 0._r8 + mat(k, 579) = 0._r8 mat(k, 582) = 0._r8 - mat(k, 583) = 0._r8 - mat(k, 584) = 0._r8 - mat(k, 589) = 0._r8 + mat(k, 585) = 0._r8 mat(k, 590) = 0._r8 - mat(k, 591) = 0._r8 - mat(k, 595) = 0._r8 + mat(k, 592) = 0._r8 + mat(k, 593) = 0._r8 mat(k, 598) = 0._r8 - mat(k, 615) = 0._r8 + mat(k, 599) = 0._r8 + mat(k, 600) = 0._r8 + mat(k, 601) = 0._r8 + mat(k, 604) = 0._r8 + mat(k, 606) = 0._r8 + mat(k, 610) = 0._r8 + mat(k, 611) = 0._r8 + mat(k, 612) = 0._r8 + mat(k, 616) = 0._r8 mat(k, 617) = 0._r8 mat(k, 618) = 0._r8 - mat(k, 620) = 0._r8 - mat(k, 622) = 0._r8 - mat(k, 623) = 0._r8 - mat(k, 625) = 0._r8 mat(k, 627) = 0._r8 - mat(k, 629) = 0._r8 - mat(k, 640) = 0._r8 - mat(k, 658) = 0._r8 - mat(k, 679) = 0._r8 - mat(k, 681) = 0._r8 - mat(k, 688) = 0._r8 - mat(k, 692) = 0._r8 - mat(k, 698) = 0._r8 - mat(k, 699) = 0._r8 - mat(k, 700) = 0._r8 - mat(k, 701) = 0._r8 - mat(k, 704) = 0._r8 - mat(k, 707) = 0._r8 - mat(k, 708) = 0._r8 - mat(k, 709) = 0._r8 + mat(k, 634) = 0._r8 + mat(k, 639) = 0._r8 + mat(k, 652) = 0._r8 + mat(k, 657) = 0._r8 + mat(k, 660) = 0._r8 + mat(k, 663) = 0._r8 + mat(k, 666) = 0._r8 + mat(k, 668) = 0._r8 + mat(k, 677) = 0._r8 + mat(k, 682) = 0._r8 + mat(k, 684) = 0._r8 + mat(k, 685) = 0._r8 mat(k, 716) = 0._r8 - mat(k, 720) = 0._r8 mat(k, 722) = 0._r8 - mat(k, 731) = 0._r8 - mat(k, 732) = 0._r8 - mat(k, 739) = 0._r8 - mat(k, 744) = 0._r8 - mat(k, 745) = 0._r8 - mat(k, 746) = 0._r8 + mat(k, 724) = 0._r8 + mat(k, 734) = 0._r8 + mat(k, 735) = 0._r8 + mat(k, 737) = 0._r8 + mat(k, 740) = 0._r8 + mat(k, 743) = 0._r8 mat(k, 748) = 0._r8 - mat(k, 749) = 0._r8 mat(k, 750) = 0._r8 mat(k, 751) = 0._r8 - mat(k, 752) = 0._r8 - mat(k, 753) = 0._r8 + mat(k, 754) = 0._r8 mat(k, 755) = 0._r8 - mat(k, 758) = 0._r8 - mat(k, 759) = 0._r8 + mat(k, 756) = 0._r8 mat(k, 761) = 0._r8 mat(k, 762) = 0._r8 mat(k, 763) = 0._r8 + mat(k, 764) = 0._r8 + mat(k, 765) = 0._r8 + mat(k, 768) = 0._r8 + mat(k, 769) = 0._r8 + mat(k, 770) = 0._r8 + mat(k, 771) = 0._r8 + mat(k, 772) = 0._r8 + mat(k, 773) = 0._r8 + mat(k, 778) = 0._r8 + mat(k, 782) = 0._r8 + mat(k, 783) = 0._r8 + mat(k, 785) = 0._r8 + mat(k, 786) = 0._r8 + mat(k, 794) = 0._r8 + mat(k, 796) = 0._r8 + mat(k, 800) = 0._r8 + mat(k, 801) = 0._r8 + mat(k, 802) = 0._r8 + mat(k, 824) = 0._r8 + mat(k, 828) = 0._r8 + mat(k, 829) = 0._r8 + mat(k, 843) = 0._r8 + mat(k, 854) = 0._r8 + mat(k, 855) = 0._r8 + mat(k, 856) = 0._r8 + mat(k, 857) = 0._r8 + mat(k, 858) = 0._r8 + mat(k, 859) = 0._r8 + mat(k, 860) = 0._r8 + mat(k, 861) = 0._r8 + mat(k, 862) = 0._r8 + mat(k, 864) = 0._r8 + mat(k, 865) = 0._r8 + mat(k, 866) = 0._r8 + mat(k, 867) = 0._r8 + mat(k, 868) = 0._r8 + mat(k, 872) = 0._r8 + mat(k, 873) = 0._r8 + mat(k, 884) = 0._r8 + mat(k, 885) = 0._r8 + mat(k, 896) = 0._r8 + mat(k, 897) = 0._r8 + mat(k, 898) = 0._r8 + mat(k, 899) = 0._r8 + mat(k, 901) = 0._r8 + mat(k, 903) = 0._r8 + mat(k, 906) = 0._r8 + mat(k, 909) = 0._r8 + mat(k, 910) = 0._r8 + mat(k, 913) = 0._r8 + mat(k, 914) = 0._r8 + mat(k, 915) = 0._r8 + mat(k, 916) = 0._r8 + mat(k, 917) = 0._r8 + mat(k, 918) = 0._r8 + mat(k, 920) = 0._r8 + mat(k, 922) = 0._r8 + mat(k, 923) = 0._r8 + mat(k, 924) = 0._r8 + mat(k, 926) = 0._r8 + mat(k, 934) = 0._r8 + mat(k, 935) = 0._r8 + mat(k, 936) = 0._r8 + mat(k, 937) = 0._r8 + mat(k, 939) = 0._r8 + mat(k, 940) = 0._r8 + mat(k, 941) = 0._r8 + mat(k, 942) = 0._r8 + mat(k, 943) = 0._r8 + mat(k, 944) = 0._r8 + mat(k, 945) = 0._r8 + mat(k, 947) = 0._r8 + mat(k, 949) = 0._r8 + mat(k, 950) = 0._r8 + mat(k, 951) = 0._r8 + mat(k, 953) = 0._r8 + mat(k, 954) = 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) @@ -1210,62 +1510,85 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) 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, 27) = mat(k, 27) - dti(k) mat(k, 30) = mat(k, 30) - dti(k) - mat(k, 33) = mat(k, 33) - dti(k) - mat(k, 35) = mat(k, 35) - dti(k) - mat(k, 37) = mat(k, 37) - dti(k) - mat(k, 41) = mat(k, 41) - dti(k) - mat(k, 44) = mat(k, 44) - dti(k) - mat(k, 48) = mat(k, 48) - dti(k) - mat(k, 52) = mat(k, 52) - dti(k) + mat(k, 34) = mat(k, 34) - dti(k) + mat(k, 38) = mat(k, 38) - dti(k) + mat(k, 42) = mat(k, 42) - dti(k) + mat(k, 46) = mat(k, 46) - dti(k) + mat(k, 50) = mat(k, 50) - dti(k) + mat(k, 53) = mat(k, 53) - dti(k) mat(k, 58) = mat(k, 58) - dti(k) - mat(k, 64) = mat(k, 64) - dti(k) - mat(k, 69) = mat(k, 69) - dti(k) - mat(k, 77) = mat(k, 77) - dti(k) - mat(k, 83) = mat(k, 83) - dti(k) - mat(k, 90) = mat(k, 90) - dti(k) + mat(k, 63) = mat(k, 63) - dti(k) + mat(k, 68) = mat(k, 68) - dti(k) + mat(k, 73) = mat(k, 73) - dti(k) + mat(k, 75) = mat(k, 75) - dti(k) + mat(k, 78) = mat(k, 78) - dti(k) + mat(k, 80) = mat(k, 80) - dti(k) + mat(k, 85) = mat(k, 85) - dti(k) + mat(k, 89) = mat(k, 89) - dti(k) + mat(k, 94) = mat(k, 94) - dti(k) mat(k, 97) = mat(k, 97) - dti(k) - mat(k, 103) = mat(k, 103) - dti(k) - mat(k, 107) = mat(k, 107) - dti(k) - mat(k, 115) = mat(k, 115) - dti(k) - mat(k, 122) = mat(k, 122) - dti(k) + mat(k, 100) = mat(k, 100) - dti(k) + mat(k, 105) = mat(k, 105) - dti(k) + mat(k, 110) = mat(k, 110) - dti(k) + mat(k, 116) = mat(k, 116) - dti(k) + mat(k, 119) = mat(k, 119) - dti(k) + mat(k, 125) = mat(k, 125) - dti(k) mat(k, 131) = mat(k, 131) - dti(k) - mat(k, 138) = mat(k, 138) - dti(k) + mat(k, 136) = mat(k, 136) - dti(k) mat(k, 144) = mat(k, 144) - dti(k) - mat(k, 153) = mat(k, 153) - dti(k) - mat(k, 162) = mat(k, 162) - dti(k) - mat(k, 170) = mat(k, 170) - dti(k) + mat(k, 152) = mat(k, 152) - dti(k) + mat(k, 158) = mat(k, 158) - dti(k) + mat(k, 164) = mat(k, 164) - dti(k) + mat(k, 171) = mat(k, 171) - dti(k) mat(k, 178) = mat(k, 178) - dti(k) - mat(k, 189) = mat(k, 189) - dti(k) - mat(k, 200) = mat(k, 200) - dti(k) - mat(k, 215) = mat(k, 215) - dti(k) - mat(k, 229) = mat(k, 229) - dti(k) - mat(k, 244) = mat(k, 244) - dti(k) - mat(k, 254) = mat(k, 254) - dti(k) + mat(k, 185) = mat(k, 185) - dti(k) + mat(k, 193) = mat(k, 193) - dti(k) + mat(k, 199) = mat(k, 199) - dti(k) + mat(k, 207) = mat(k, 207) - dti(k) + mat(k, 216) = mat(k, 216) - dti(k) + mat(k, 223) = mat(k, 223) - dti(k) + mat(k, 232) = mat(k, 232) - dti(k) + mat(k, 239) = mat(k, 239) - dti(k) + mat(k, 245) = mat(k, 245) - dti(k) + mat(k, 253) = mat(k, 253) - dti(k) mat(k, 262) = mat(k, 262) - dti(k) - mat(k, 274) = mat(k, 274) - dti(k) - mat(k, 285) = mat(k, 285) - dti(k) - mat(k, 299) = mat(k, 299) - dti(k) - mat(k, 310) = mat(k, 310) - dti(k) - mat(k, 329) = mat(k, 329) - dti(k) - mat(k, 347) = mat(k, 347) - dti(k) - mat(k, 369) = mat(k, 369) - dti(k) - mat(k, 395) = mat(k, 395) - dti(k) - mat(k, 421) = mat(k, 421) - dti(k) + mat(k, 270) = mat(k, 270) - dti(k) + mat(k, 279) = mat(k, 279) - dti(k) + mat(k, 287) = mat(k, 287) - dti(k) + mat(k, 297) = mat(k, 297) - dti(k) + mat(k, 305) = mat(k, 305) - dti(k) + mat(k, 320) = mat(k, 320) - dti(k) + mat(k, 331) = mat(k, 331) - dti(k) + mat(k, 344) = mat(k, 344) - dti(k) + mat(k, 358) = mat(k, 358) - dti(k) + mat(k, 375) = mat(k, 375) - dti(k) + mat(k, 390) = mat(k, 390) - dti(k) + mat(k, 408) = mat(k, 408) - dti(k) + mat(k, 422) = mat(k, 422) - dti(k) + mat(k, 436) = mat(k, 436) - dti(k) mat(k, 450) = mat(k, 450) - dti(k) - mat(k, 494) = mat(k, 494) - dti(k) - mat(k, 517) = mat(k, 517) - dti(k) - mat(k, 543) = mat(k, 543) - dti(k) - mat(k, 565) = mat(k, 565) - dti(k) - mat(k, 592) = mat(k, 592) - dti(k) - mat(k, 624) = mat(k, 624) - dti(k) - mat(k, 662) = mat(k, 662) - dti(k) - mat(k, 685) = mat(k, 685) - dti(k) - mat(k, 714) = mat(k, 714) - dti(k) - mat(k, 738) = mat(k, 738) - dti(k) - mat(k, 764) = mat(k, 764) - dti(k) + mat(k, 472) = mat(k, 472) - dti(k) + mat(k, 505) = mat(k, 505) - dti(k) + mat(k, 526) = mat(k, 526) - dti(k) + mat(k, 552) = mat(k, 552) - dti(k) + mat(k, 581) = mat(k, 581) - dti(k) + mat(k, 607) = mat(k, 607) - dti(k) + mat(k, 650) = mat(k, 650) - dti(k) + mat(k, 676) = mat(k, 676) - dti(k) + mat(k, 719) = mat(k, 719) - dti(k) + mat(k, 744) = mat(k, 744) - dti(k) + mat(k, 767) = mat(k, 767) - dti(k) + mat(k, 797) = mat(k, 797) - dti(k) + mat(k, 847) = mat(k, 847) - dti(k) + mat(k, 871) = mat(k, 871) - dti(k) + mat(k, 904) = mat(k, 904) - dti(k) + mat(k, 928) = mat(k, 928) - dti(k) + mat(k, 956) = mat(k, 956) - dti(k) end do end subroutine nlnmat_finit subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) @@ -1284,6 +1607,7 @@ subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) 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 nlnmat_finit( avec_len, mat, lmat, dti ) end subroutine nlnmat end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_prod_loss.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_prod_loss.F90 index f5d8d12130..4581196178 100644 --- a/src/chemistry/pp_waccm_ma_mam4/mo_prod_loss.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/mo_prod_loss.F90 @@ -19,72 +19,6 @@ subroutine exp_prod_loss( ofl, ofu, prod, loss, y, & 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,6))* y(k,6) - prod(k,1) = 0._r8 - loss(k,2) = (rxt(k,180)* y(k,92) + rxt(k,30) + het_rates(k,7))* y(k,7) - prod(k,2) = 0._r8 - loss(k,3) = (rxt(k,181)* y(k,92) + rxt(k,31) + het_rates(k,8))* y(k,8) - prod(k,3) = 0._r8 - loss(k,4) = (rxt(k,207)* y(k,92) + rxt(k,32) + het_rates(k,9))* y(k,9) - prod(k,4) = 0._r8 - loss(k,5) = (rxt(k,182)* y(k,92) + rxt(k,33) + het_rates(k,10))* y(k,10) - prod(k,5) = 0._r8 - loss(k,6) = (rxt(k,183)* y(k,92) + rxt(k,34) + het_rates(k,11))* y(k,11) - prod(k,6) = 0._r8 - loss(k,7) = (rxt(k,184)* y(k,92) + rxt(k,35) + het_rates(k,12))* y(k,12) - prod(k,7) = 0._r8 - loss(k,8) = (rxt(k,185)* y(k,92) + rxt(k,36) + het_rates(k,13))* y(k,13) - prod(k,8) = 0._r8 - loss(k,9) = (rxt(k,186)* y(k,92) + rxt(k,37) + het_rates(k,14))* y(k,14) - prod(k,9) = 0._r8 - loss(k,10) = (rxt(k,218)* y(k,85) +rxt(k,230)* y(k,92) +rxt(k,219)* y(k,96) & - + rxt(k,38) + het_rates(k,15))* y(k,15) - prod(k,10) = 0._r8 - loss(k,11) = (rxt(k,220)* y(k,85) +rxt(k,231)* y(k,92) +rxt(k,221)* y(k,96) & - + rxt(k,39) + het_rates(k,17))* y(k,17) - prod(k,11) = 0._r8 - loss(k,12) = (rxt(k,222)* y(k,96) + rxt(k,40) + het_rates(k,18))* y(k,18) - prod(k,12) = 0._r8 - loss(k,13) = (rxt(k,223)* y(k,85) +rxt(k,224)* y(k,96) + rxt(k,41) & - + het_rates(k,19))* y(k,19) - prod(k,13) = 0._r8 - loss(k,14) = (rxt(k,212)* y(k,37) +rxt(k,156)* y(k,85) + (rxt(k,243) + & - rxt(k,244) +rxt(k,245))* y(k,92) +rxt(k,241)* y(k,96) + rxt(k,23) & - + rxt(k,24) + het_rates(k,22))* y(k,22) - prod(k,14) = 0._r8 - loss(k,15) = (rxt(k,225)* y(k,85) +rxt(k,208)* y(k,92) +rxt(k,226)* y(k,96) & - + rxt(k,42) + het_rates(k,23))* y(k,23) - prod(k,15) = 0._r8 - loss(k,16) = ( + het_rates(k,28))* y(k,28) - prod(k,16) = 0._r8 - loss(k,17) = (rxt(k,300)* y(k,97) + rxt(k,25) + rxt(k,61) + het_rates(k,30)) & - * y(k,30) - prod(k,17) =.440_r8*rxt(k,24)*y(k,22) - loss(k,18) = (rxt(k,209)* y(k,92) + rxt(k,50) + het_rates(k,40))* y(k,40) - prod(k,18) = 0._r8 - loss(k,19) = (rxt(k,232)* y(k,92) +rxt(k,227)* y(k,96) + rxt(k,52) & - + het_rates(k,44))* y(k,44) - prod(k,19) = 0._r8 - loss(k,20) = (rxt(k,233)* y(k,92) +rxt(k,228)* y(k,96) + rxt(k,53) & - + het_rates(k,45))* y(k,45) - prod(k,20) = 0._r8 - loss(k,21) = (rxt(k,234)* y(k,92) +rxt(k,229)* y(k,96) + rxt(k,54) & - + het_rates(k,46))* y(k,46) - prod(k,21) = 0._r8 - loss(k,22) = ((rxt(k,147) +rxt(k,148))* y(k,92) + rxt(k,12) & - + het_rates(k,54))* y(k,54) - prod(k,22) = 0._r8 - loss(k,23) = ( + rxt(k,60) + het_rates(k,74))* y(k,74) - prod(k,23) = 0._r8 - end do end subroutine exp_prod_loss subroutine imp_prod_loss( avec_len, prod, loss, y, & rxt, het_rates ) @@ -112,423 +46,494 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & prod(k,1) = 0._r8 loss(k,2) = ( + het_rates(k,2))* y(k,2) prod(k,2) = 0._r8 - loss(k,29) = ( + rxt(k,26) + het_rates(k,3))* y(k,3) - prod(k,29) = (rxt(k,276)*y(k,51) +rxt(k,281)*y(k,51))*y(k,47) & - +rxt(k,197)*y(k,26)*y(k,4) - loss(k,71) = (2._r8*rxt(k,194)* y(k,4) + (rxt(k,195) +rxt(k,196) +rxt(k,197)) & - * y(k,26) +rxt(k,199)* y(k,59) +rxt(k,200)* y(k,60) +rxt(k,202) & - * y(k,66) +rxt(k,251)* y(k,75) +rxt(k,198)* y(k,87) +rxt(k,203) & - * y(k,96) + rxt(k,27) + het_rates(k,4))* y(k,4) - prod(k,71) = (rxt(k,28) +rxt(k,201)*y(k,66))*y(k,5) +rxt(k,211)*y(k,92) & - *y(k,43) +rxt(k,206)*y(k,66)*y(k,51) +rxt(k,193)*y(k,84)*y(k,68) - loss(k,40) = (rxt(k,201)* y(k,66) + rxt(k,28) + rxt(k,29) + rxt(k,270) & - + rxt(k,273) + rxt(k,278) + het_rates(k,5))* y(k,5) - prod(k,40) =rxt(k,200)*y(k,60)*y(k,4) - loss(k,68) = (rxt(k,235)* y(k,61) +rxt(k,236)* y(k,66) +rxt(k,191)* y(k,84) & - +rxt(k,155)* y(k,85) +rxt(k,237)* y(k,96) + rxt(k,20) + rxt(k,21) & - + het_rates(k,16))* y(k,16) - prod(k,68) = (rxt(k,162)*y(k,26) +rxt(k,239)*y(k,59))*y(k,20) + (rxt(k,22) + & - .300_r8*rxt(k,240)*y(k,96))*y(k,21) + (rxt(k,244)*y(k,92) + & - rxt(k,245)*y(k,92))*y(k,22) - loss(k,62) = (rxt(k,162)* y(k,26) +rxt(k,239)* y(k,59) +rxt(k,238)* y(k,87) & - + het_rates(k,20))* y(k,20) - prod(k,62) = (rxt(k,156)*y(k,85) +rxt(k,212)*y(k,37) +rxt(k,241)*y(k,96) + & - rxt(k,243)*y(k,92))*y(k,22) +.700_r8*rxt(k,240)*y(k,96)*y(k,21) - loss(k,35) = (rxt(k,240)* y(k,96) + rxt(k,22) + het_rates(k,21))* y(k,21) - prod(k,35) =rxt(k,238)*y(k,87)*y(k,20) - loss(k,26) = ( + rxt(k,43) + het_rates(k,24))* y(k,24) - prod(k,26) = (rxt(k,269)*y(k,52) +rxt(k,274)*y(k,27) +rxt(k,275)*y(k,52) + & - rxt(k,279)*y(k,27) +rxt(k,280)*y(k,52) +rxt(k,284)*y(k,27))*y(k,47) & - +rxt(k,164)*y(k,26)*y(k,26) +rxt(k,168)*y(k,85)*y(k,27) - loss(k,21) = ( + rxt(k,44) + rxt(k,190) + het_rates(k,25))* y(k,25) - prod(k,21) =rxt(k,189)*y(k,26)*y(k,26) - loss(k,66) = ((rxt(k,195) +rxt(k,196) +rxt(k,197))* y(k,4) +rxt(k,162) & - * y(k,20) + 2._r8*(rxt(k,163) +rxt(k,164) +rxt(k,165) +rxt(k,189)) & - * y(k,26) +rxt(k,167)* y(k,59) +rxt(k,169)* y(k,60) +rxt(k,172) & - * y(k,66) +rxt(k,252)* y(k,75) +rxt(k,166)* y(k,87) + (rxt(k,173) + & - rxt(k,174))* y(k,96) + rxt(k,45) + het_rates(k,26))* y(k,26) - prod(k,66) = (rxt(k,177)*y(k,85) +rxt(k,178)*y(k,66) +rxt(k,179)*y(k,96)) & - *y(k,52) + (rxt(k,47) +rxt(k,170)*y(k,66))*y(k,27) + (rxt(k,59) + & - rxt(k,257)*y(k,75))*y(k,69) + (rxt(k,160)*y(k,87) + & - rxt(k,161)*y(k,68))*y(k,85) +2.000_r8*rxt(k,190)*y(k,25) & - +rxt(k,188)*y(k,92)*y(k,47) - loss(k,56) = ((rxt(k,274) +rxt(k,279) +rxt(k,284))* y(k,47) +rxt(k,170) & - * y(k,66) +rxt(k,168)* y(k,85) +rxt(k,171)* y(k,96) + rxt(k,46) & - + rxt(k,47) + rxt(k,272) + rxt(k,277) + rxt(k,283) & - + het_rates(k,27))* y(k,27) - prod(k,56) =rxt(k,169)*y(k,60)*y(k,26) - loss(k,39) = ((rxt(k,242) +rxt(k,246))* y(k,96) + het_rates(k,29))* y(k,29) - prod(k,39) = (rxt(k,20) +rxt(k,21) +rxt(k,155)*y(k,85) +rxt(k,191)*y(k,84) + & - rxt(k,235)*y(k,61) +rxt(k,236)*y(k,66) +rxt(k,237)*y(k,96))*y(k,16) & - + (rxt(k,88) +rxt(k,247)*y(k,66) +rxt(k,248)*y(k,96))*y(k,70) & - +rxt(k,223)*y(k,85)*y(k,19) +rxt(k,300)*y(k,97)*y(k,30) - loss(k,23) = (rxt(k,216)* y(k,92) + rxt(k,48) + het_rates(k,31))* y(k,31) - prod(k,23) = (rxt(k,181)*y(k,8) +rxt(k,183)*y(k,11) + & - 2.000_r8*rxt(k,184)*y(k,12) +2.000_r8*rxt(k,185)*y(k,13) + & - rxt(k,186)*y(k,14) +rxt(k,207)*y(k,9) +2.000_r8*rxt(k,209)*y(k,40) + & - rxt(k,233)*y(k,45) +rxt(k,234)*y(k,46))*y(k,92) & - + (rxt(k,228)*y(k,45) +rxt(k,229)*y(k,46))*y(k,96) - loss(k,27) = (rxt(k,217)* y(k,92) + rxt(k,49) + het_rates(k,32))* y(k,32) - prod(k,27) = (rxt(k,182)*y(k,10) +rxt(k,183)*y(k,11) +rxt(k,232)*y(k,44)) & - *y(k,92) +rxt(k,227)*y(k,96)*y(k,44) - loss(k,32) = (rxt(k,261)* y(k,61) + (rxt(k,262) +rxt(k,263))* y(k,96) & - + het_rates(k,33))* y(k,33) - prod(k,32) = 0._r8 - loss(k,3) = ( + het_rates(k,34))* y(k,34) + loss(k,94) = (rxt(k,191)* y(k,17) +rxt(k,193)* y(k,70) +rxt(k,192)* y(k,87) & + + het_rates(k,3))* y(k,3) + prod(k,94) = (rxt(k,27) +2.000_r8*rxt(k,194)*y(k,5) +rxt(k,195)*y(k,28) + & + rxt(k,196)*y(k,28) +rxt(k,199)*y(k,61) +rxt(k,202)*y(k,68) + & + rxt(k,203)*y(k,96) +rxt(k,253)*y(k,77))*y(k,5) + (rxt(k,181)*y(k,9) + & + rxt(k,207)*y(k,10) +3.000_r8*rxt(k,208)*y(k,24) + & + 2.000_r8*rxt(k,209)*y(k,42) +rxt(k,210)*y(k,45) + & + 2.000_r8*rxt(k,230)*y(k,16) +rxt(k,231)*y(k,18))*y(k,92) & + + (rxt(k,205)*y(k,45) +2.000_r8*rxt(k,219)*y(k,16) + & + rxt(k,221)*y(k,18) +3.000_r8*rxt(k,226)*y(k,24))*y(k,96) & + + (2.000_r8*rxt(k,218)*y(k,16) +rxt(k,220)*y(k,18) + & + 3.000_r8*rxt(k,225)*y(k,24))*y(k,25) + (rxt(k,51) + & + rxt(k,204)*y(k,68))*y(k,45) +rxt(k,26)*y(k,4) +rxt(k,29)*y(k,6) & + +rxt(k,31)*y(k,9) +rxt(k,32)*y(k,10) +2.000_r8*rxt(k,38)*y(k,16) & + +rxt(k,39)*y(k,18) +3.000_r8*rxt(k,42)*y(k,24) +2.000_r8*rxt(k,50) & + *y(k,42) +rxt(k,57)*y(k,53) + loss(k,43) = ( + rxt(k,26) + het_rates(k,4))* y(k,4) + prod(k,43) = (rxt(k,275)*y(k,53) +rxt(k,280)*y(k,53))*y(k,49) & + +rxt(k,197)*y(k,28)*y(k,5) + loss(k,93) = (2._r8*rxt(k,194)* y(k,5) + (rxt(k,195) +rxt(k,196) +rxt(k,197)) & + * y(k,28) +rxt(k,199)* y(k,61) +rxt(k,200)* y(k,62) +rxt(k,202) & + * y(k,68) +rxt(k,253)* y(k,77) +rxt(k,198)* y(k,87) +rxt(k,203) & + * y(k,96) + rxt(k,27) + het_rates(k,5))* y(k,5) + prod(k,93) = (rxt(k,28) +rxt(k,201)*y(k,68))*y(k,6) +rxt(k,193)*y(k,70) & + *y(k,3) +rxt(k,211)*y(k,92)*y(k,45) +rxt(k,206)*y(k,68)*y(k,53) + loss(k,60) = (rxt(k,201)* y(k,68) + rxt(k,28) + rxt(k,29) + rxt(k,269) & + + rxt(k,272) + rxt(k,277) + het_rates(k,6))* y(k,6) + prod(k,60) =rxt(k,200)*y(k,62)*y(k,5) + loss(k,3) = ( + het_rates(k,7))* y(k,7) prod(k,3) = 0._r8 - loss(k,4) = ( + het_rates(k,35))* y(k,35) + loss(k,25) = (rxt(k,180)* y(k,92) + rxt(k,30) + het_rates(k,8))* y(k,8) + prod(k,25) = 0._r8 + loss(k,32) = (rxt(k,181)* y(k,92) + rxt(k,31) + het_rates(k,9))* y(k,9) + prod(k,32) = 0._r8 + loss(k,33) = (rxt(k,207)* y(k,92) + rxt(k,32) + het_rates(k,10))* y(k,10) + prod(k,33) = 0._r8 + loss(k,27) = (rxt(k,182)* y(k,92) + rxt(k,33) + het_rates(k,11))* y(k,11) + prod(k,27) = 0._r8 + loss(k,34) = (rxt(k,183)* y(k,92) + rxt(k,34) + het_rates(k,12))* y(k,12) + prod(k,34) = 0._r8 + loss(k,28) = (rxt(k,184)* y(k,92) + rxt(k,35) + het_rates(k,13))* y(k,13) + prod(k,28) = 0._r8 + loss(k,35) = (rxt(k,185)* y(k,92) + rxt(k,36) + het_rates(k,14))* y(k,14) + prod(k,35) = 0._r8 + loss(k,29) = (rxt(k,186)* y(k,92) + rxt(k,37) + het_rates(k,15))* y(k,15) + prod(k,29) = 0._r8 + loss(k,55) = (rxt(k,218)* y(k,25) +rxt(k,230)* y(k,92) +rxt(k,219)* y(k,96) & + + rxt(k,38) + het_rates(k,16))* y(k,16) + prod(k,55) = 0._r8 + loss(k,84) = (rxt(k,191)* y(k,3) +rxt(k,155)* y(k,25) +rxt(k,235)* y(k,63) & + +rxt(k,236)* y(k,68) +rxt(k,237)* y(k,96) + rxt(k,20) + rxt(k,21) & + + het_rates(k,17))* y(k,17) + prod(k,84) = (.180_r8*rxt(k,24) +rxt(k,243)*y(k,92) +rxt(k,244)*y(k,92)) & + *y(k,23) + (rxt(k,162)*y(k,28) +rxt(k,239)*y(k,61))*y(k,21) & + + (rxt(k,22) +.300_r8*rxt(k,240)*y(k,96))*y(k,22) + loss(k,61) = (rxt(k,220)* y(k,25) +rxt(k,231)* y(k,92) +rxt(k,221)* y(k,96) & + + rxt(k,39) + het_rates(k,18))* y(k,18) + prod(k,61) = 0._r8 + loss(k,30) = (rxt(k,222)* y(k,96) + rxt(k,40) + het_rates(k,19))* y(k,19) + prod(k,30) = 0._r8 + loss(k,52) = (rxt(k,223)* y(k,25) +rxt(k,224)* y(k,96) + rxt(k,41) & + + het_rates(k,20))* y(k,20) + prod(k,52) = 0._r8 + loss(k,80) = (rxt(k,162)* y(k,28) +rxt(k,239)* y(k,61) +rxt(k,238)* y(k,87) & + + het_rates(k,21))* y(k,21) + prod(k,80) = (rxt(k,23) +rxt(k,156)*y(k,25) +rxt(k,212)*y(k,39) + & + rxt(k,241)*y(k,96) +rxt(k,242)*y(k,92))*y(k,23) +rxt(k,39)*y(k,18) & + +rxt(k,41)*y(k,20) +.700_r8*rxt(k,240)*y(k,96)*y(k,22) + loss(k,54) = (rxt(k,240)* y(k,96) + rxt(k,22) + het_rates(k,22))* y(k,22) + prod(k,54) =rxt(k,238)*y(k,87)*y(k,21) + loss(k,79) = (rxt(k,156)* y(k,25) +rxt(k,212)* y(k,39) + (rxt(k,242) + & + rxt(k,243) +rxt(k,244))* y(k,92) +rxt(k,241)* y(k,96) + rxt(k,23) & + + rxt(k,24) + het_rates(k,23))* y(k,23) + prod(k,79) = 0._r8 + loss(k,53) = (rxt(k,225)* y(k,25) +rxt(k,208)* y(k,92) +rxt(k,226)* y(k,96) & + + rxt(k,42) + het_rates(k,24))* y(k,24) + prod(k,53) = 0._r8 + loss(k,98) = (rxt(k,218)* y(k,16) +rxt(k,155)* y(k,17) +rxt(k,220)* y(k,18) & + +rxt(k,223)* y(k,20) +rxt(k,156)* y(k,23) +rxt(k,225)* y(k,24) & + +rxt(k,168)* y(k,29) +rxt(k,157)* y(k,41) +rxt(k,158)* y(k,43) & + +rxt(k,177)* y(k,54) +rxt(k,161)* y(k,70) + (rxt(k,159) +rxt(k,160)) & + * y(k,87) + het_rates(k,25))* y(k,25) + prod(k,98) = (4.000_r8*rxt(k,180)*y(k,8) +rxt(k,181)*y(k,9) + & + 2.000_r8*rxt(k,182)*y(k,11) +2.000_r8*rxt(k,183)*y(k,12) + & + 2.000_r8*rxt(k,184)*y(k,13) +rxt(k,185)*y(k,14) + & + 2.000_r8*rxt(k,186)*y(k,15) +rxt(k,187)*y(k,49) +rxt(k,217)*y(k,34) + & + rxt(k,232)*y(k,46) +rxt(k,233)*y(k,47) +rxt(k,234)*y(k,48))*y(k,92) & + + (rxt(k,45) +rxt(k,162)*y(k,21) +2.000_r8*rxt(k,163)*y(k,28) + & + rxt(k,165)*y(k,28) +rxt(k,167)*y(k,61) +rxt(k,172)*y(k,68) + & + rxt(k,173)*y(k,96) +rxt(k,196)*y(k,5) +rxt(k,254)*y(k,77))*y(k,28) & + + (rxt(k,176)*y(k,49) +3.000_r8*rxt(k,222)*y(k,19) + & + rxt(k,224)*y(k,20) +rxt(k,227)*y(k,46) +rxt(k,228)*y(k,47) + & + rxt(k,229)*y(k,48))*y(k,96) + (rxt(k,55) +rxt(k,175)*y(k,68))*y(k,49) & + +rxt(k,26)*y(k,4) +4.000_r8*rxt(k,30)*y(k,8) +rxt(k,31)*y(k,9) & + +2.000_r8*rxt(k,33)*y(k,11) +2.000_r8*rxt(k,34)*y(k,12) & + +2.000_r8*rxt(k,35)*y(k,13) +rxt(k,36)*y(k,14) +2.000_r8*rxt(k,37) & + *y(k,15) +3.000_r8*rxt(k,40)*y(k,19) +rxt(k,41)*y(k,20) & + +2.000_r8*rxt(k,43)*y(k,26) +2.000_r8*rxt(k,44)*y(k,27) +rxt(k,46) & + *y(k,29) +rxt(k,49)*y(k,34) +rxt(k,52)*y(k,46) +rxt(k,53)*y(k,47) & + +rxt(k,54)*y(k,48) +rxt(k,58)*y(k,54) + loss(k,36) = ( + rxt(k,43) + het_rates(k,26))* y(k,26) + prod(k,36) = (rxt(k,268)*y(k,54) +rxt(k,273)*y(k,29) +rxt(k,274)*y(k,54) + & + rxt(k,278)*y(k,29) +rxt(k,279)*y(k,54) +rxt(k,283)*y(k,29))*y(k,49) & + +rxt(k,168)*y(k,29)*y(k,25) +rxt(k,164)*y(k,28)*y(k,28) + loss(k,24) = ( + rxt(k,44) + rxt(k,190) + het_rates(k,27))* y(k,27) + prod(k,24) =rxt(k,189)*y(k,28)*y(k,28) + loss(k,88) = ((rxt(k,195) +rxt(k,196) +rxt(k,197))* y(k,5) +rxt(k,162) & + * y(k,21) + 2._r8*(rxt(k,163) +rxt(k,164) +rxt(k,165) +rxt(k,189)) & + * y(k,28) +rxt(k,167)* y(k,61) +rxt(k,169)* y(k,62) +rxt(k,172) & + * y(k,68) +rxt(k,254)* y(k,77) +rxt(k,166)* y(k,87) + (rxt(k,173) + & + rxt(k,174))* y(k,96) + rxt(k,45) + het_rates(k,28))* y(k,28) + prod(k,88) = (rxt(k,160)*y(k,87) +rxt(k,161)*y(k,70) +rxt(k,177)*y(k,54)) & + *y(k,25) + (rxt(k,47) +rxt(k,170)*y(k,68))*y(k,29) & + + (rxt(k,178)*y(k,68) +rxt(k,179)*y(k,96))*y(k,54) + (rxt(k,59) + & + rxt(k,259)*y(k,77))*y(k,71) +2.000_r8*rxt(k,190)*y(k,27) & + +rxt(k,188)*y(k,92)*y(k,49) + loss(k,73) = (rxt(k,168)* y(k,25) + (rxt(k,273) +rxt(k,278) +rxt(k,283)) & + * y(k,49) +rxt(k,170)* y(k,68) +rxt(k,171)* y(k,96) + rxt(k,46) & + + rxt(k,47) + rxt(k,271) + rxt(k,276) + rxt(k,282) & + + het_rates(k,29))* y(k,29) + prod(k,73) =rxt(k,169)*y(k,62)*y(k,28) + loss(k,4) = ( + het_rates(k,30))* y(k,30) prod(k,4) = 0._r8 + loss(k,70) = (rxt(k,245)* y(k,96) + het_rates(k,31))* y(k,31) + prod(k,70) = (rxt(k,20) +rxt(k,21) +rxt(k,155)*y(k,25) +rxt(k,191)*y(k,3) + & + rxt(k,235)*y(k,63) +rxt(k,236)*y(k,68) +rxt(k,237)*y(k,96))*y(k,17) & + + (rxt(k,25) +rxt(k,61) +rxt(k,299)*y(k,97))*y(k,32) + (rxt(k,88) + & + rxt(k,248)*y(k,68) +rxt(k,249)*y(k,96))*y(k,72) +rxt(k,223)*y(k,25) & + *y(k,20) +.380_r8*rxt(k,24)*y(k,23) + loss(k,59) = (rxt(k,299)* y(k,97) + rxt(k,25) + rxt(k,61) + het_rates(k,32)) & + * y(k,32) + prod(k,59) =.440_r8*rxt(k,24)*y(k,23) +rxt(k,245)*y(k,96)*y(k,31) + loss(k,42) = (rxt(k,216)* y(k,92) + rxt(k,48) + het_rates(k,33))* y(k,33) + prod(k,42) = (rxt(k,181)*y(k,9) +rxt(k,183)*y(k,12) + & + 2.000_r8*rxt(k,184)*y(k,13) +2.000_r8*rxt(k,185)*y(k,14) + & + rxt(k,186)*y(k,15) +rxt(k,207)*y(k,10) +2.000_r8*rxt(k,209)*y(k,42) + & + rxt(k,233)*y(k,47) +rxt(k,234)*y(k,48))*y(k,92) + (rxt(k,53) + & + rxt(k,228)*y(k,96))*y(k,47) + (rxt(k,54) +rxt(k,229)*y(k,96))*y(k,48) & + +rxt(k,31)*y(k,9) +rxt(k,32)*y(k,10) +rxt(k,34)*y(k,12) & + +2.000_r8*rxt(k,35)*y(k,13) +2.000_r8*rxt(k,36)*y(k,14) +rxt(k,37) & + *y(k,15) +2.000_r8*rxt(k,50)*y(k,42) + loss(k,40) = (rxt(k,217)* y(k,92) + rxt(k,49) + het_rates(k,34))* y(k,34) + prod(k,40) = (rxt(k,52) +rxt(k,227)*y(k,96) +rxt(k,232)*y(k,92))*y(k,46) & + + (rxt(k,33) +rxt(k,182)*y(k,92))*y(k,11) + (rxt(k,34) + & + rxt(k,183)*y(k,92))*y(k,12) + loss(k,49) = (rxt(k,246)* y(k,63) + (rxt(k,247) +rxt(k,261))* y(k,96) & + + het_rates(k,35))* y(k,35) + prod(k,49) = 0._r8 loss(k,5) = ( + het_rates(k,36))* y(k,36) prod(k,5) = 0._r8 - loss(k,46) = (rxt(k,212)* y(k,22) +rxt(k,213)* y(k,39) +rxt(k,215)* y(k,49) & - +rxt(k,214)* y(k,100) + het_rates(k,37))* y(k,37) - prod(k,46) = (rxt(k,185)*y(k,13) +rxt(k,207)*y(k,9) + & - 2.000_r8*rxt(k,216)*y(k,31) +rxt(k,217)*y(k,32))*y(k,92) & - +2.000_r8*rxt(k,48)*y(k,31) +rxt(k,49)*y(k,32) +rxt(k,56)*y(k,48) - loss(k,59) = (rxt(k,116)* y(k,67) +rxt(k,119)* y(k,68) + (rxt(k,113) + & - rxt(k,114) +rxt(k,115))* y(k,87) + het_rates(k,38))* y(k,38) - prod(k,59) = (rxt(k,120)*y(k,39) +rxt(k,123)*y(k,66) +rxt(k,143)*y(k,53) + & - rxt(k,237)*y(k,16) +rxt(k,246)*y(k,29) +rxt(k,248)*y(k,70) + & - rxt(k,253)*y(k,73) +rxt(k,258)*y(k,75))*y(k,96) & - + (rxt(k,94)*y(k,92) +rxt(k,111)*y(k,66) +rxt(k,157)*y(k,85) + & - rxt(k,213)*y(k,37))*y(k,39) + (rxt(k,244)*y(k,22) + & - rxt(k,188)*y(k,47) +rxt(k,211)*y(k,43))*y(k,92) & - + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,100) +2.000_r8*rxt(k,20)*y(k,16) & - +rxt(k,22)*y(k,21) +rxt(k,51)*y(k,43) +rxt(k,55)*y(k,47) +rxt(k,56) & - *y(k,48) - loss(k,70) = (rxt(k,213)* y(k,37) +rxt(k,111)* y(k,66) +rxt(k,157)* y(k,85) & - +rxt(k,94)* y(k,92) +rxt(k,120)* y(k,96) + het_rates(k,39))* y(k,39) - prod(k,70) =rxt(k,21)*y(k,16) +rxt(k,245)*y(k,92)*y(k,22) +rxt(k,113)*y(k,87) & - *y(k,38) +rxt(k,1)*y(k,100) - loss(k,41) = (rxt(k,112)* y(k,66) +rxt(k,158)* y(k,85) +rxt(k,121)* y(k,96) & - + rxt(k,4) + het_rates(k,41))* y(k,41) - prod(k,41) = (.500_r8*rxt(k,264) +rxt(k,127)*y(k,87))*y(k,87) & - +rxt(k,126)*y(k,96)*y(k,96) - loss(k,22) = ( + rxt(k,87) + het_rates(k,42))* y(k,42) - prod(k,22) =rxt(k,260)*y(k,100)*y(k,77) - loss(k,49) = (rxt(k,204)* y(k,66) + (rxt(k,210) +rxt(k,211))* y(k,92) & - +rxt(k,205)* y(k,96) + rxt(k,51) + het_rates(k,43))* y(k,43) - prod(k,49) = (rxt(k,191)*y(k,16) +rxt(k,192)*y(k,87))*y(k,84) - loss(k,61) = ((rxt(k,274) +rxt(k,279) +rxt(k,284))* y(k,27) + (rxt(k,276) + & - rxt(k,281))* y(k,51) + (rxt(k,269) +rxt(k,275) +rxt(k,280))* y(k,52) & - +rxt(k,175)* y(k,66) + (rxt(k,187) +rxt(k,188))* y(k,92) +rxt(k,176) & - * y(k,96) + rxt(k,55) + het_rates(k,47))* y(k,47) - prod(k,61) = (rxt(k,156)*y(k,22) +rxt(k,218)*y(k,15) +rxt(k,220)*y(k,17) + & - 2.000_r8*rxt(k,223)*y(k,19) +rxt(k,225)*y(k,23) +rxt(k,155)*y(k,16) + & - rxt(k,157)*y(k,39) +rxt(k,158)*y(k,41) +rxt(k,159)*y(k,87) + & - rxt(k,177)*y(k,52))*y(k,85) +rxt(k,174)*y(k,96)*y(k,26) - loss(k,28) = ( + rxt(k,56) + het_rates(k,48))* y(k,48) - prod(k,28) = (rxt(k,212)*y(k,22) +rxt(k,213)*y(k,39) +rxt(k,214)*y(k,100) + & - rxt(k,215)*y(k,49))*y(k,37) - loss(k,57) = (rxt(k,215)* y(k,37) +rxt(k,152)* y(k,96) + rxt(k,9) & - + het_rates(k,49))* y(k,49) - prod(k,57) = (rxt(k,272) +rxt(k,277) +rxt(k,283) +rxt(k,274)*y(k,47) + & - rxt(k,279)*y(k,47) +rxt(k,284)*y(k,47))*y(k,27) & - + (2.000_r8*rxt(k,265) +2.000_r8*rxt(k,268) +2.000_r8*rxt(k,271) + & - 2.000_r8*rxt(k,282))*y(k,55) + (rxt(k,270) +rxt(k,273) +rxt(k,278)) & - *y(k,5) + (rxt(k,267) +rxt(k,235)*y(k,16) +rxt(k,261)*y(k,33)) & - *y(k,61) + (.500_r8*rxt(k,266) +rxt(k,151)*y(k,96))*y(k,60) - loss(k,36) = (rxt(k,128)* y(k,96) + rxt(k,10) + rxt(k,11) + rxt(k,153) & - + het_rates(k,50))* y(k,50) - prod(k,36) =rxt(k,149)*y(k,87)*y(k,60) - loss(k,45) = ((rxt(k,276) +rxt(k,281))* y(k,47) +rxt(k,206)* y(k,66) & - + rxt(k,57) + het_rates(k,51))* y(k,51) - prod(k,45) = (rxt(k,270) +rxt(k,273) +rxt(k,278))*y(k,5) +rxt(k,198)*y(k,87) & - *y(k,4) - loss(k,47) = ((rxt(k,269) +rxt(k,275) +rxt(k,280))* y(k,47) +rxt(k,178) & - * y(k,66) +rxt(k,177)* y(k,85) +rxt(k,179)* y(k,96) + rxt(k,58) & - + het_rates(k,52))* y(k,52) - prod(k,47) = (rxt(k,272) +rxt(k,277) +rxt(k,283) +rxt(k,171)*y(k,96))*y(k,27) & - +rxt(k,166)*y(k,87)*y(k,26) - loss(k,54) = (rxt(k,131)* y(k,59) + (rxt(k,132) +rxt(k,133) +rxt(k,134)) & - * y(k,60) +rxt(k,135)* y(k,67) +rxt(k,297)* y(k,95) +rxt(k,143) & - * y(k,96) + rxt(k,62) + het_rates(k,53))* y(k,53) - prod(k,54) = (rxt(k,129)*y(k,88) +rxt(k,294)*y(k,91))*y(k,66) & - + (.200_r8*rxt(k,288)*y(k,90) +1.100_r8*rxt(k,290)*y(k,89))*y(k,86) & - +rxt(k,15)*y(k,59) +rxt(k,295)*y(k,91)*y(k,67) +rxt(k,301)*y(k,97) - loss(k,31) = ( + rxt(k,13) + rxt(k,14) + rxt(k,154) + rxt(k,265) + rxt(k,268) & - + rxt(k,271) + rxt(k,282) + het_rates(k,55))* y(k,55) - prod(k,31) =rxt(k,150)*y(k,61)*y(k,60) - loss(k,6) = ( + het_rates(k,56))* y(k,56) + loss(k,6) = ( + het_rates(k,37))* y(k,37) prod(k,6) = 0._r8 - loss(k,7) = ( + het_rates(k,57))* y(k,57) + loss(k,7) = ( + het_rates(k,38))* y(k,38) prod(k,7) = 0._r8 + loss(k,71) = (rxt(k,212)* y(k,23) +rxt(k,213)* y(k,41) +rxt(k,215)* y(k,51) & + +rxt(k,214)* y(k,100) + het_rates(k,39))* y(k,39) + prod(k,71) = (rxt(k,185)*y(k,14) +rxt(k,207)*y(k,10) + & + 2.000_r8*rxt(k,216)*y(k,33) +rxt(k,217)*y(k,34))*y(k,92) +rxt(k,32) & + *y(k,10) +rxt(k,36)*y(k,14) +2.000_r8*rxt(k,48)*y(k,33) +rxt(k,49) & + *y(k,34) +rxt(k,56)*y(k,50) + loss(k,82) = (rxt(k,116)* y(k,69) +rxt(k,119)* y(k,70) + (rxt(k,113) + & + rxt(k,114) +rxt(k,115))* y(k,87) + het_rates(k,40))* y(k,40) + prod(k,82) = (rxt(k,120)*y(k,41) +rxt(k,123)*y(k,68) +rxt(k,143)*y(k,55) + & + rxt(k,237)*y(k,17) +rxt(k,249)*y(k,72) +rxt(k,255)*y(k,75) + & + rxt(k,260)*y(k,77))*y(k,96) + (rxt(k,94)*y(k,92) + & + rxt(k,111)*y(k,68) +rxt(k,157)*y(k,25) +rxt(k,213)*y(k,39))*y(k,41) & + + (rxt(k,23) +.330_r8*rxt(k,24) +rxt(k,243)*y(k,92))*y(k,23) & + + (rxt(k,51) +rxt(k,211)*y(k,92))*y(k,45) + (rxt(k,55) + & + rxt(k,188)*y(k,92))*y(k,49) + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,100) & + +2.000_r8*rxt(k,20)*y(k,17) +rxt(k,22)*y(k,22) +rxt(k,56)*y(k,50) + loss(k,99) = (rxt(k,157)* y(k,25) +rxt(k,213)* y(k,39) +rxt(k,111)* y(k,68) & + +rxt(k,94)* y(k,92) +rxt(k,120)* y(k,96) + het_rates(k,41))* y(k,41) + prod(k,99) = (1.440_r8*rxt(k,24) +rxt(k,244)*y(k,92))*y(k,23) +rxt(k,21) & + *y(k,17) +rxt(k,113)*y(k,87)*y(k,40) +rxt(k,1)*y(k,100) + loss(k,26) = (rxt(k,209)* y(k,92) + rxt(k,50) + het_rates(k,42))* y(k,42) + prod(k,26) = 0._r8 + loss(k,62) = (rxt(k,158)* y(k,25) +rxt(k,112)* y(k,68) +rxt(k,121)* y(k,96) & + + rxt(k,4) + het_rates(k,43))* y(k,43) + prod(k,62) = (.500_r8*rxt(k,263) +rxt(k,127)*y(k,87))*y(k,87) & + +rxt(k,126)*y(k,96)*y(k,96) + loss(k,31) = ( + rxt(k,87) + het_rates(k,44))* y(k,44) + prod(k,31) =rxt(k,262)*y(k,100)*y(k,79) + loss(k,67) = (rxt(k,204)* y(k,68) + (rxt(k,210) +rxt(k,211))* y(k,92) & + +rxt(k,205)* y(k,96) + rxt(k,51) + het_rates(k,45))* y(k,45) + prod(k,67) = (rxt(k,191)*y(k,17) +rxt(k,192)*y(k,87))*y(k,3) + loss(k,39) = (rxt(k,232)* y(k,92) +rxt(k,227)* y(k,96) + rxt(k,52) & + + het_rates(k,46))* y(k,46) + prod(k,39) = 0._r8 + loss(k,41) = (rxt(k,233)* y(k,92) +rxt(k,228)* y(k,96) + rxt(k,53) & + + het_rates(k,47))* y(k,47) + prod(k,41) = 0._r8 + loss(k,46) = (rxt(k,234)* y(k,92) +rxt(k,229)* y(k,96) + rxt(k,54) & + + het_rates(k,48))* y(k,48) + prod(k,46) = 0._r8 + loss(k,83) = ((rxt(k,273) +rxt(k,278) +rxt(k,283))* y(k,29) + (rxt(k,275) + & + rxt(k,280))* y(k,53) + (rxt(k,268) +rxt(k,274) +rxt(k,279))* y(k,54) & + +rxt(k,175)* y(k,68) + (rxt(k,187) +rxt(k,188))* y(k,92) +rxt(k,176) & + * y(k,96) + rxt(k,55) + het_rates(k,49))* y(k,49) + prod(k,83) = (rxt(k,155)*y(k,17) +rxt(k,156)*y(k,23) +rxt(k,157)*y(k,41) + & + rxt(k,158)*y(k,43) +rxt(k,159)*y(k,87) +rxt(k,177)*y(k,54) + & + rxt(k,218)*y(k,16) +rxt(k,220)*y(k,18) +2.000_r8*rxt(k,223)*y(k,20) + & + rxt(k,225)*y(k,24))*y(k,25) +rxt(k,174)*y(k,96)*y(k,28) + loss(k,47) = ( + rxt(k,56) + het_rates(k,50))* y(k,50) + prod(k,47) = (rxt(k,212)*y(k,23) +rxt(k,213)*y(k,41) +rxt(k,214)*y(k,100) + & + rxt(k,215)*y(k,51))*y(k,39) + loss(k,97) = (rxt(k,215)* y(k,39) +rxt(k,152)* y(k,96) + rxt(k,9) & + + het_rates(k,51))* y(k,51) + prod(k,97) = (rxt(k,271) +rxt(k,276) +rxt(k,282) +rxt(k,273)*y(k,49) + & + rxt(k,278)*y(k,49) +rxt(k,283)*y(k,49))*y(k,29) & + + (2.000_r8*rxt(k,264) +2.000_r8*rxt(k,267) +2.000_r8*rxt(k,270) + & + 2.000_r8*rxt(k,281))*y(k,57) + (rxt(k,269) +rxt(k,272) +rxt(k,277)) & + *y(k,6) + (rxt(k,266) +rxt(k,235)*y(k,17) +rxt(k,246)*y(k,35)) & + *y(k,63) + (.500_r8*rxt(k,265) +rxt(k,151)*y(k,96))*y(k,62) + loss(k,56) = (rxt(k,128)* y(k,96) + rxt(k,10) + rxt(k,11) + rxt(k,153) & + + het_rates(k,52))* y(k,52) + prod(k,56) =rxt(k,149)*y(k,87)*y(k,62) + loss(k,66) = ((rxt(k,275) +rxt(k,280))* y(k,49) +rxt(k,206)* y(k,68) & + + rxt(k,57) + het_rates(k,53))* y(k,53) + prod(k,66) = (rxt(k,269) +rxt(k,272) +rxt(k,277))*y(k,6) +rxt(k,198)*y(k,87) & + *y(k,5) + loss(k,68) = (rxt(k,177)* y(k,25) + (rxt(k,268) +rxt(k,274) +rxt(k,279)) & + * y(k,49) +rxt(k,178)* y(k,68) +rxt(k,179)* y(k,96) + rxt(k,58) & + + het_rates(k,54))* y(k,54) + prod(k,68) = (rxt(k,271) +rxt(k,276) +rxt(k,282) +rxt(k,171)*y(k,96))*y(k,29) & + +rxt(k,166)*y(k,87)*y(k,28) + loss(k,76) = (rxt(k,131)* y(k,61) + (rxt(k,132) +rxt(k,133) +rxt(k,134)) & + * y(k,62) +rxt(k,135)* y(k,69) +rxt(k,296)* y(k,95) +rxt(k,143) & + * y(k,96) + rxt(k,62) + het_rates(k,55))* y(k,55) + prod(k,76) = (rxt(k,129)*y(k,88) +rxt(k,293)*y(k,91))*y(k,68) & + + (.200_r8*rxt(k,287)*y(k,90) +1.100_r8*rxt(k,289)*y(k,89))*y(k,86) & + +rxt(k,15)*y(k,61) +rxt(k,294)*y(k,91)*y(k,69) +rxt(k,300)*y(k,97) + loss(k,44) = ((rxt(k,147) +rxt(k,148))* y(k,92) + rxt(k,12) & + + het_rates(k,56))* y(k,56) + prod(k,44) =rxt(k,132)*y(k,62)*y(k,55) + loss(k,48) = ( + rxt(k,13) + rxt(k,14) + rxt(k,154) + rxt(k,264) + rxt(k,267) & + + rxt(k,270) + rxt(k,281) + het_rates(k,57))* y(k,57) + prod(k,48) =rxt(k,150)*y(k,63)*y(k,62) loss(k,8) = ( + het_rates(k,58))* y(k,58) prod(k,8) = 0._r8 - loss(k,76) = (rxt(k,199)* y(k,4) +rxt(k,239)* y(k,20) +rxt(k,167)* y(k,26) & - +rxt(k,131)* y(k,53) +rxt(k,140)* y(k,61) +rxt(k,146)* y(k,66) & - +rxt(k,145)* y(k,68) +rxt(k,144)* y(k,87) +rxt(k,299)* y(k,95) & - + rxt(k,15) + rxt(k,16) + het_rates(k,59))* y(k,59) - prod(k,76) = (rxt(k,17) +.500_r8*rxt(k,266) +2.000_r8*rxt(k,133)*y(k,53) + & - rxt(k,136)*y(k,66) +rxt(k,254)*y(k,75))*y(k,60) & - + (rxt(k,135)*y(k,67) +rxt(k,143)*y(k,96))*y(k,53) & - +2.000_r8*rxt(k,147)*y(k,92)*y(k,54) +rxt(k,14)*y(k,55) +rxt(k,19) & - *y(k,61) +rxt(k,130)*y(k,88)*y(k,67) +rxt(k,298)*y(k,95) +rxt(k,311) & - *y(k,99) - loss(k,75) = (rxt(k,200)* y(k,4) +rxt(k,169)* y(k,26) + (rxt(k,132) + & - rxt(k,133) +rxt(k,134))* y(k,53) +rxt(k,150)* y(k,61) + (rxt(k,136) + & - rxt(k,138))* y(k,66) +rxt(k,137)* y(k,68) +rxt(k,254)* y(k,75) & - +rxt(k,149)* y(k,87) +rxt(k,151)* y(k,96) + rxt(k,17) + rxt(k,266) & - + het_rates(k,60))* y(k,60) - prod(k,75) = (2.000_r8*rxt(k,140)*y(k,61) +rxt(k,144)*y(k,87) + & - rxt(k,145)*y(k,68) +rxt(k,146)*y(k,66) +rxt(k,167)*y(k,26) + & - rxt(k,199)*y(k,4) +rxt(k,239)*y(k,20))*y(k,59) + (rxt(k,18) + & - rxt(k,139)*y(k,87) +rxt(k,141)*y(k,66) +rxt(k,142)*y(k,96))*y(k,61) & - + (rxt(k,11) +rxt(k,153) +rxt(k,128)*y(k,96))*y(k,50) + (rxt(k,13) + & - rxt(k,154))*y(k,55) +rxt(k,28)*y(k,5) +rxt(k,47)*y(k,27) +rxt(k,9) & - *y(k,49) - loss(k,63) = (rxt(k,235)* y(k,16) +rxt(k,261)* y(k,33) +rxt(k,140)* y(k,59) & - +rxt(k,150)* y(k,60) +rxt(k,141)* y(k,66) +rxt(k,139)* y(k,87) & - +rxt(k,142)* y(k,96) + rxt(k,18) + rxt(k,19) + rxt(k,267) & - + het_rates(k,61))* y(k,61) - prod(k,63) = (rxt(k,46) +rxt(k,168)*y(k,85) +rxt(k,170)*y(k,66) + & - rxt(k,171)*y(k,96))*y(k,27) + (rxt(k,13) +rxt(k,14) +rxt(k,154)) & - *y(k,55) + (rxt(k,29) +rxt(k,201)*y(k,66))*y(k,5) & - + (rxt(k,152)*y(k,96) +rxt(k,215)*y(k,37))*y(k,49) & - + (rxt(k,137)*y(k,68) +rxt(k,138)*y(k,66))*y(k,60) +rxt(k,10) & - *y(k,50) - loss(k,9) = ( + het_rates(k,62))* y(k,62) + loss(k,9) = ( + het_rates(k,59))* y(k,59) prod(k,9) = 0._r8 - loss(k,10) = ( + het_rates(k,63))* y(k,63) + loss(k,10) = ( + het_rates(k,60))* y(k,60) prod(k,10) = 0._r8 + loss(k,91) = (rxt(k,199)* y(k,5) +rxt(k,239)* y(k,21) +rxt(k,167)* y(k,28) & + +rxt(k,131)* y(k,55) +rxt(k,140)* y(k,63) +rxt(k,146)* y(k,68) & + +rxt(k,145)* y(k,70) +rxt(k,144)* y(k,87) +rxt(k,298)* y(k,95) & + + rxt(k,15) + rxt(k,16) + het_rates(k,61))* y(k,61) + prod(k,91) = (rxt(k,17) +.500_r8*rxt(k,265) +2.000_r8*rxt(k,133)*y(k,55) + & + rxt(k,136)*y(k,68) +rxt(k,256)*y(k,77))*y(k,62) & + + (rxt(k,135)*y(k,69) +rxt(k,143)*y(k,96))*y(k,55) & + +2.000_r8*rxt(k,147)*y(k,92)*y(k,56) +rxt(k,14)*y(k,57) +rxt(k,19) & + *y(k,63) +rxt(k,130)*y(k,88)*y(k,69) +rxt(k,297)*y(k,95) +rxt(k,310) & + *y(k,99) + loss(k,95) = (rxt(k,200)* y(k,5) +rxt(k,169)* y(k,28) + (rxt(k,132) + & + rxt(k,133) +rxt(k,134))* y(k,55) +rxt(k,150)* y(k,63) + (rxt(k,136) + & + rxt(k,138))* y(k,68) +rxt(k,137)* y(k,70) +rxt(k,256)* y(k,77) & + +rxt(k,149)* y(k,87) +rxt(k,151)* y(k,96) + rxt(k,17) + rxt(k,265) & + + het_rates(k,62))* y(k,62) + prod(k,95) = (2.000_r8*rxt(k,140)*y(k,63) +rxt(k,144)*y(k,87) + & + rxt(k,145)*y(k,70) +rxt(k,146)*y(k,68) +rxt(k,167)*y(k,28) + & + rxt(k,199)*y(k,5) +rxt(k,239)*y(k,21))*y(k,61) + (rxt(k,18) + & + rxt(k,139)*y(k,87) +rxt(k,141)*y(k,68) +rxt(k,142)*y(k,96))*y(k,63) & + + (rxt(k,11) +rxt(k,153) +rxt(k,128)*y(k,96))*y(k,52) + (rxt(k,13) + & + rxt(k,154))*y(k,57) +rxt(k,28)*y(k,6) +rxt(k,47)*y(k,29) +rxt(k,9) & + *y(k,51) + loss(k,89) = (rxt(k,235)* y(k,17) +rxt(k,246)* y(k,35) +rxt(k,140)* y(k,61) & + +rxt(k,150)* y(k,62) +rxt(k,141)* y(k,68) +rxt(k,139)* y(k,87) & + +rxt(k,142)* y(k,96) + rxt(k,18) + rxt(k,19) + rxt(k,266) & + + het_rates(k,63))* y(k,63) + prod(k,89) = (rxt(k,46) +rxt(k,168)*y(k,25) +rxt(k,170)*y(k,68) + & + rxt(k,171)*y(k,96))*y(k,29) + (rxt(k,13) +rxt(k,14) +rxt(k,154)) & + *y(k,57) + (rxt(k,29) +rxt(k,201)*y(k,68))*y(k,6) & + + (rxt(k,152)*y(k,96) +rxt(k,215)*y(k,39))*y(k,51) & + + (rxt(k,137)*y(k,70) +rxt(k,138)*y(k,68))*y(k,62) +rxt(k,10) & + *y(k,52) loss(k,11) = ( + het_rates(k,64))* y(k,64) prod(k,11) = 0._r8 loss(k,12) = ( + het_rates(k,65))* y(k,65) prod(k,12) = 0._r8 - loss(k,67) = (rxt(k,202)* y(k,4) +rxt(k,201)* y(k,5) +rxt(k,236)* y(k,16) & - +rxt(k,172)* y(k,26) +rxt(k,170)* y(k,27) +rxt(k,111)* y(k,39) & - +rxt(k,112)* y(k,41) +rxt(k,204)* y(k,43) +rxt(k,175)* y(k,47) & - +rxt(k,206)* y(k,51) +rxt(k,178)* y(k,52) +rxt(k,146)* y(k,59) & - + (rxt(k,136) +rxt(k,138))* y(k,60) +rxt(k,141)* y(k,61) & - + 2._r8*rxt(k,109)* y(k,66) +rxt(k,110)* y(k,67) +rxt(k,108) & - * y(k,68) +rxt(k,247)* y(k,70) +rxt(k,117)* y(k,87) + (rxt(k,292) + & - rxt(k,293))* y(k,89) +rxt(k,294)* y(k,91) +rxt(k,123)* y(k,96) & + loss(k,13) = ( + het_rates(k,66))* y(k,66) + prod(k,13) = 0._r8 + loss(k,14) = ( + het_rates(k,67))* y(k,67) + prod(k,14) = 0._r8 + loss(k,90) = (rxt(k,202)* y(k,5) +rxt(k,201)* y(k,6) +rxt(k,236)* y(k,17) & + +rxt(k,172)* y(k,28) +rxt(k,170)* y(k,29) +rxt(k,111)* y(k,41) & + +rxt(k,112)* y(k,43) +rxt(k,204)* y(k,45) +rxt(k,175)* y(k,49) & + +rxt(k,206)* y(k,53) +rxt(k,178)* y(k,54) +rxt(k,146)* y(k,61) & + + (rxt(k,136) +rxt(k,138))* y(k,62) +rxt(k,141)* y(k,63) & + + 2._r8*rxt(k,109)* y(k,68) +rxt(k,110)* y(k,69) +rxt(k,108) & + * y(k,70) +rxt(k,248)* y(k,72) +rxt(k,117)* y(k,87) + (rxt(k,291) + & + rxt(k,292))* y(k,89) +rxt(k,293)* y(k,91) +rxt(k,123)* y(k,96) & + rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & - + rxt(k,76) + het_rates(k,66))* y(k,66) - prod(k,67) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,77) +rxt(k,79) +rxt(k,81) + & + + rxt(k,76) + het_rates(k,68))* y(k,68) + prod(k,90) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,77) +rxt(k,79) +rxt(k,81) + & 2.000_r8*rxt(k,82) +2.000_r8*rxt(k,83) +rxt(k,84) +rxt(k,85) + & - rxt(k,86) +rxt(k,97)*y(k,92) +rxt(k,98)*y(k,92) +rxt(k,135)*y(k,53) + & - rxt(k,249)*y(k,73) +rxt(k,255)*y(k,75) +rxt(k,296)*y(k,91) + & - rxt(k,303)*y(k,97) +rxt(k,307)*y(k,98))*y(k,67) & - + (rxt(k,131)*y(k,59) +rxt(k,132)*y(k,60) +rxt(k,297)*y(k,95)) & - *y(k,53) + (rxt(k,288)*y(k,90) +1.150_r8*rxt(k,289)*y(k,95))*y(k,86) & - +rxt(k,27)*y(k,4) +rxt(k,45)*y(k,26) +rxt(k,115)*y(k,87)*y(k,38) & - +rxt(k,14)*y(k,55) +rxt(k,15)*y(k,59) +rxt(k,17)*y(k,60) +rxt(k,18) & - *y(k,61) +rxt(k,8)*y(k,68) +rxt(k,59)*y(k,69) +rxt(k,89)*y(k,75) & - +rxt(k,90)*y(k,76) +rxt(k,91)*y(k,77) +rxt(k,302)*y(k,97)*y(k,88) & - +rxt(k,96)*y(k,92) +rxt(k,125)*y(k,96)*y(k,96) +rxt(k,305)*y(k,98) & - +rxt(k,310)*y(k,99) +rxt(k,2)*y(k,100) - loss(k,72) = (rxt(k,116)* y(k,38) +rxt(k,135)* y(k,53) +rxt(k,110)* y(k,66) & - +rxt(k,249)* y(k,73) +rxt(k,255)* y(k,75) +rxt(k,130)* y(k,88) & - +rxt(k,291)* y(k,89) + (rxt(k,295) +rxt(k,296))* y(k,91) +rxt(k,97) & - * y(k,92) +rxt(k,102)* y(k,93) +rxt(k,303)* y(k,97) +rxt(k,307) & + rxt(k,86) +rxt(k,97)*y(k,92) +rxt(k,98)*y(k,92) +rxt(k,135)*y(k,55) + & + rxt(k,250)*y(k,75) +rxt(k,257)*y(k,77) +rxt(k,295)*y(k,91) + & + rxt(k,302)*y(k,97) +rxt(k,306)*y(k,98))*y(k,69) & + + (rxt(k,131)*y(k,61) +rxt(k,132)*y(k,62) +rxt(k,296)*y(k,95)) & + *y(k,55) + (rxt(k,25) +rxt(k,61))*y(k,32) + (rxt(k,287)*y(k,90) + & + 1.150_r8*rxt(k,288)*y(k,95))*y(k,86) +rxt(k,27)*y(k,5) & + +.180_r8*rxt(k,24)*y(k,23) +rxt(k,45)*y(k,28) +rxt(k,115)*y(k,87) & + *y(k,40) +rxt(k,14)*y(k,57) +rxt(k,15)*y(k,61) +rxt(k,17)*y(k,62) & + +rxt(k,18)*y(k,63) +rxt(k,8)*y(k,70) +rxt(k,59)*y(k,71) +rxt(k,89) & + *y(k,77) +rxt(k,90)*y(k,78) +rxt(k,91)*y(k,79) +rxt(k,301)*y(k,97) & + *y(k,88) +rxt(k,96)*y(k,92) +rxt(k,125)*y(k,96)*y(k,96) +rxt(k,304) & + *y(k,98) +rxt(k,309)*y(k,99) +rxt(k,2)*y(k,100) + loss(k,85) = (rxt(k,116)* y(k,40) +rxt(k,135)* y(k,55) +rxt(k,110)* y(k,68) & + +rxt(k,250)* y(k,75) +rxt(k,257)* y(k,77) +rxt(k,130)* y(k,88) & + +rxt(k,290)* y(k,89) + (rxt(k,294) +rxt(k,295))* y(k,91) +rxt(k,97) & + * y(k,92) +rxt(k,102)* y(k,93) +rxt(k,302)* y(k,97) +rxt(k,306) & * y(k,98) + rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,78) + rxt(k,79) & + rxt(k,80) + rxt(k,81) + rxt(k,82) + rxt(k,83) + rxt(k,84) & - + rxt(k,85) + rxt(k,86) + het_rates(k,67))* y(k,67) - prod(k,72) = (rxt(k,8) +2.000_r8*rxt(k,99)*y(k,92) + & - 2.000_r8*rxt(k,108)*y(k,66) +2.000_r8*rxt(k,118)*y(k,87) + & - rxt(k,119)*y(k,38) +rxt(k,124)*y(k,96) +rxt(k,137)*y(k,60) + & - rxt(k,145)*y(k,59) +rxt(k,161)*y(k,85) +rxt(k,193)*y(k,84) + & - rxt(k,250)*y(k,73) +rxt(k,256)*y(k,75))*y(k,68) & - + (rxt(k,113)*y(k,38) +rxt(k,117)*y(k,66) +rxt(k,122)*y(k,96) + & - rxt(k,127)*y(k,87) +rxt(k,139)*y(k,61) +rxt(k,159)*y(k,85) + & - rxt(k,166)*y(k,26) +rxt(k,192)*y(k,84) +rxt(k,198)*y(k,4) + & - rxt(k,238)*y(k,20))*y(k,87) + (rxt(k,101)*y(k,93) + & - rxt(k,109)*y(k,66) +rxt(k,123)*y(k,96) +rxt(k,136)*y(k,60) + & - rxt(k,141)*y(k,61) +rxt(k,172)*y(k,26) +rxt(k,202)*y(k,4))*y(k,66) & - + (rxt(k,163)*y(k,26) +rxt(k,164)*y(k,26) +rxt(k,174)*y(k,96) + & - rxt(k,196)*y(k,4) +rxt(k,197)*y(k,4))*y(k,26) + (rxt(k,92) + & - rxt(k,100) +2.000_r8*rxt(k,102)*y(k,67))*y(k,93) +rxt(k,194)*y(k,4) & - *y(k,4) +rxt(k,128)*y(k,96)*y(k,50) +rxt(k,134)*y(k,60)*y(k,53) & - +rxt(k,148)*y(k,92)*y(k,54) +rxt(k,299)*y(k,95)*y(k,59) +rxt(k,19) & - *y(k,61) +rxt(k,93)*y(k,94) - loss(k,74) = (rxt(k,119)* y(k,38) +rxt(k,145)* y(k,59) +rxt(k,137)* y(k,60) & - +rxt(k,108)* y(k,66) +rxt(k,250)* y(k,73) +rxt(k,256)* y(k,75) & - +rxt(k,193)* y(k,84) +rxt(k,161)* y(k,85) +rxt(k,118)* y(k,87) & + + rxt(k,85) + rxt(k,86) + het_rates(k,69))* y(k,69) + prod(k,85) = (rxt(k,8) +2.000_r8*rxt(k,99)*y(k,92) + & + 2.000_r8*rxt(k,108)*y(k,68) +2.000_r8*rxt(k,118)*y(k,87) + & + rxt(k,119)*y(k,40) +rxt(k,124)*y(k,96) +rxt(k,137)*y(k,62) + & + rxt(k,145)*y(k,61) +rxt(k,161)*y(k,25) +rxt(k,193)*y(k,3) + & + rxt(k,252)*y(k,75) +rxt(k,258)*y(k,77))*y(k,70) & + + (rxt(k,113)*y(k,40) +rxt(k,117)*y(k,68) +rxt(k,122)*y(k,96) + & + rxt(k,127)*y(k,87) +rxt(k,139)*y(k,63) +rxt(k,159)*y(k,25) + & + rxt(k,166)*y(k,28) +rxt(k,192)*y(k,3) +rxt(k,198)*y(k,5) + & + rxt(k,238)*y(k,21))*y(k,87) + (rxt(k,101)*y(k,93) + & + rxt(k,109)*y(k,68) +rxt(k,123)*y(k,96) +rxt(k,136)*y(k,62) + & + rxt(k,141)*y(k,63) +rxt(k,172)*y(k,28) +rxt(k,202)*y(k,5))*y(k,68) & + + (rxt(k,163)*y(k,28) +rxt(k,164)*y(k,28) +rxt(k,174)*y(k,96) + & + rxt(k,196)*y(k,5) +rxt(k,197)*y(k,5))*y(k,28) + (rxt(k,92) + & + rxt(k,100) +2.000_r8*rxt(k,102)*y(k,69))*y(k,93) +rxt(k,194)*y(k,5) & + *y(k,5) +rxt(k,128)*y(k,96)*y(k,52) +rxt(k,134)*y(k,62)*y(k,55) & + +rxt(k,148)*y(k,92)*y(k,56) +rxt(k,298)*y(k,95)*y(k,61) +rxt(k,19) & + *y(k,63) +rxt(k,93)*y(k,94) + loss(k,86) = (rxt(k,193)* y(k,3) +rxt(k,161)* y(k,25) +rxt(k,119)* y(k,40) & + +rxt(k,145)* y(k,61) +rxt(k,137)* y(k,62) +rxt(k,108)* y(k,68) & + +rxt(k,252)* y(k,75) +rxt(k,258)* y(k,77) +rxt(k,118)* y(k,87) & +rxt(k,99)* y(k,92) +rxt(k,124)* y(k,96) + rxt(k,7) + rxt(k,8) & - + het_rates(k,68))* y(k,68) - prod(k,74) =rxt(k,110)*y(k,67)*y(k,66) - loss(k,33) = (rxt(k,257)* y(k,75) + rxt(k,59) + het_rates(k,69))* y(k,69) - prod(k,33) = (rxt(k,165)*y(k,26) +rxt(k,195)*y(k,4))*y(k,26) - loss(k,34) = (rxt(k,247)* y(k,66) +rxt(k,248)* y(k,96) + rxt(k,88) & + het_rates(k,70))* y(k,70) - prod(k,34) = 0._r8 - loss(k,13) = ( + het_rates(k,71))* y(k,71) - prod(k,13) = 0._r8 - loss(k,14) = ( + het_rates(k,72))* y(k,72) - prod(k,14) = 0._r8 - loss(k,43) = (rxt(k,249)* y(k,67) +rxt(k,250)* y(k,68) +rxt(k,253)* y(k,96) & - + het_rates(k,73))* y(k,73) - prod(k,43) =rxt(k,88)*y(k,70) +rxt(k,89)*y(k,75) - loss(k,58) = (rxt(k,251)* y(k,4) +rxt(k,252)* y(k,26) +rxt(k,254)* y(k,60) & - +rxt(k,255)* y(k,67) +rxt(k,256)* y(k,68) +rxt(k,257)* y(k,69) & - +rxt(k,258)* y(k,96) + rxt(k,89) + het_rates(k,75))* y(k,75) - prod(k,58) = (rxt(k,249)*y(k,67) +rxt(k,250)*y(k,68) +rxt(k,253)*y(k,96)) & - *y(k,73) +rxt(k,247)*y(k,70)*y(k,66) +rxt(k,90)*y(k,76) - loss(k,55) = (rxt(k,259)* y(k,96) + rxt(k,90) + het_rates(k,76))* y(k,76) - prod(k,55) = (rxt(k,251)*y(k,4) +rxt(k,252)*y(k,26) +rxt(k,254)*y(k,60) + & - rxt(k,255)*y(k,67) +rxt(k,256)*y(k,68) +rxt(k,257)*y(k,69) + & - rxt(k,258)*y(k,96))*y(k,75) + (rxt(k,261)*y(k,61) + & - rxt(k,262)*y(k,96) +.500_r8*rxt(k,263)*y(k,96))*y(k,33) & - +rxt(k,248)*y(k,96)*y(k,70) +rxt(k,91)*y(k,77) - loss(k,30) = (rxt(k,260)* y(k,100) + rxt(k,91) + het_rates(k,77))* y(k,77) - prod(k,30) =rxt(k,87)*y(k,42) +rxt(k,259)*y(k,96)*y(k,76) - loss(k,15) = ( + het_rates(k,78))* y(k,78) + prod(k,86) =rxt(k,110)*y(k,69)*y(k,68) + loss(k,50) = (rxt(k,259)* y(k,77) + rxt(k,59) + het_rates(k,71))* y(k,71) + prod(k,50) = (rxt(k,165)*y(k,28) +rxt(k,195)*y(k,5))*y(k,28) + loss(k,51) = (rxt(k,248)* y(k,68) +rxt(k,249)* y(k,96) + rxt(k,88) & + + het_rates(k,72))* y(k,72) + prod(k,51) = 0._r8 + loss(k,15) = ( + het_rates(k,73))* y(k,73) prod(k,15) = 0._r8 - loss(k,16) = ( + het_rates(k,79))* y(k,79) + loss(k,16) = ( + het_rates(k,74))* y(k,74) prod(k,16) = 0._r8 - loss(k,17) = ( + het_rates(k,80))* y(k,80) + loss(k,64) = (rxt(k,250)* y(k,69) +rxt(k,252)* y(k,70) +rxt(k,255)* y(k,96) & + + het_rates(k,75))* y(k,75) + prod(k,64) =rxt(k,88)*y(k,72) +rxt(k,89)*y(k,77) + loss(k,17) = ( + rxt(k,60) + het_rates(k,76))* y(k,76) prod(k,17) = 0._r8 - loss(k,18) = ( + het_rates(k,81))* y(k,81) + loss(k,81) = (rxt(k,253)* y(k,5) +rxt(k,254)* y(k,28) +rxt(k,256)* y(k,62) & + +rxt(k,257)* y(k,69) +rxt(k,258)* y(k,70) +rxt(k,259)* y(k,71) & + +rxt(k,260)* y(k,96) + rxt(k,89) + het_rates(k,77))* y(k,77) + prod(k,81) = (rxt(k,250)*y(k,69) +rxt(k,252)*y(k,70) +rxt(k,255)*y(k,96)) & + *y(k,75) +rxt(k,248)*y(k,72)*y(k,68) +rxt(k,90)*y(k,78) + loss(k,72) = (rxt(k,251)* y(k,96) + rxt(k,90) + het_rates(k,78))* y(k,78) + prod(k,72) = (rxt(k,253)*y(k,5) +rxt(k,254)*y(k,28) +rxt(k,256)*y(k,62) + & + rxt(k,257)*y(k,69) +rxt(k,258)*y(k,70) +rxt(k,259)*y(k,71) + & + rxt(k,260)*y(k,96))*y(k,77) + (rxt(k,246)*y(k,63) + & + rxt(k,247)*y(k,96) +.500_r8*rxt(k,261)*y(k,96))*y(k,35) & + +rxt(k,249)*y(k,96)*y(k,72) +rxt(k,91)*y(k,79) + loss(k,45) = (rxt(k,262)* y(k,100) + rxt(k,91) + het_rates(k,79))* y(k,79) + prod(k,45) =rxt(k,87)*y(k,44) +rxt(k,251)*y(k,96)*y(k,78) + loss(k,18) = ( + het_rates(k,80))* y(k,80) prod(k,18) = 0._r8 - loss(k,19) = ( + het_rates(k,82))* y(k,82) + loss(k,19) = ( + het_rates(k,81))* y(k,81) prod(k,19) = 0._r8 - loss(k,20) = ( + het_rates(k,83))* y(k,83) + loss(k,20) = ( + het_rates(k,82))* y(k,82) prod(k,20) = 0._r8 - loss(k,60) = (rxt(k,191)* y(k,16) +rxt(k,193)* y(k,68) +rxt(k,192)* y(k,87) & - + het_rates(k,84))* y(k,84) - prod(k,60) = (rxt(k,27) +2.000_r8*rxt(k,194)*y(k,4) +rxt(k,195)*y(k,26) + & - rxt(k,196)*y(k,26) +rxt(k,199)*y(k,59) +rxt(k,202)*y(k,66) + & - rxt(k,203)*y(k,96) +rxt(k,251)*y(k,75))*y(k,4) + (rxt(k,181)*y(k,8) + & - rxt(k,207)*y(k,9) +3.000_r8*rxt(k,208)*y(k,23) + & - 2.000_r8*rxt(k,209)*y(k,40) +2.000_r8*rxt(k,230)*y(k,15) + & - rxt(k,231)*y(k,17) +rxt(k,210)*y(k,43))*y(k,92) & - + (2.000_r8*rxt(k,219)*y(k,15) +rxt(k,221)*y(k,17) + & - 3.000_r8*rxt(k,226)*y(k,23) +rxt(k,205)*y(k,43))*y(k,96) & - + (2.000_r8*rxt(k,218)*y(k,15) +rxt(k,220)*y(k,17) + & - 3.000_r8*rxt(k,225)*y(k,23))*y(k,85) + (rxt(k,51) + & - rxt(k,204)*y(k,66))*y(k,43) +rxt(k,26)*y(k,3) +rxt(k,29)*y(k,5) & - +rxt(k,57)*y(k,51) - loss(k,65) = (rxt(k,218)* y(k,15) +rxt(k,155)* y(k,16) +rxt(k,220)* y(k,17) & - +rxt(k,223)* y(k,19) +rxt(k,156)* y(k,22) +rxt(k,225)* y(k,23) & - +rxt(k,168)* y(k,27) +rxt(k,157)* y(k,39) +rxt(k,158)* y(k,41) & - +rxt(k,177)* y(k,52) +rxt(k,161)* y(k,68) + (rxt(k,159) +rxt(k,160)) & - * y(k,87) + het_rates(k,85))* y(k,85) - prod(k,65) = (4.000_r8*rxt(k,180)*y(k,7) +rxt(k,181)*y(k,8) + & - 2.000_r8*rxt(k,182)*y(k,10) +2.000_r8*rxt(k,183)*y(k,11) + & - 2.000_r8*rxt(k,184)*y(k,12) +rxt(k,185)*y(k,13) + & - 2.000_r8*rxt(k,186)*y(k,14) +rxt(k,232)*y(k,44) +rxt(k,233)*y(k,45) + & - rxt(k,234)*y(k,46) +rxt(k,187)*y(k,47) +rxt(k,217)*y(k,32))*y(k,92) & - + (rxt(k,45) +rxt(k,162)*y(k,20) +2.000_r8*rxt(k,163)*y(k,26) + & - rxt(k,165)*y(k,26) +rxt(k,167)*y(k,59) +rxt(k,172)*y(k,66) + & - rxt(k,173)*y(k,96) +rxt(k,196)*y(k,4) +rxt(k,252)*y(k,75))*y(k,26) & - + (3.000_r8*rxt(k,222)*y(k,18) +rxt(k,224)*y(k,19) + & - rxt(k,227)*y(k,44) +rxt(k,228)*y(k,45) +rxt(k,229)*y(k,46) + & - rxt(k,176)*y(k,47))*y(k,96) + (rxt(k,55) +rxt(k,175)*y(k,66))*y(k,47) & - +rxt(k,26)*y(k,3) +2.000_r8*rxt(k,43)*y(k,24) +2.000_r8*rxt(k,44) & - *y(k,25) +rxt(k,46)*y(k,27) +rxt(k,49)*y(k,32) +rxt(k,58)*y(k,52) - loss(k,52) = (rxt(k,290)* y(k,89) +rxt(k,288)* y(k,90) +rxt(k,289)* y(k,95) & + loss(k,21) = ( + het_rates(k,83))* y(k,83) + prod(k,21) = 0._r8 + loss(k,22) = ( + het_rates(k,84))* y(k,84) + prod(k,22) = 0._r8 + loss(k,23) = ( + het_rates(k,85))* y(k,85) + prod(k,23) = 0._r8 + loss(k,74) = (rxt(k,289)* y(k,89) +rxt(k,287)* y(k,90) +rxt(k,288)* y(k,95) & + het_rates(k,86))* y(k,86) - prod(k,52) = (rxt(k,77) +rxt(k,78) +rxt(k,79) +rxt(k,80) +rxt(k,81) + & - rxt(k,84) +rxt(k,85) +rxt(k,86))*y(k,67) + (rxt(k,71) +rxt(k,72) + & - rxt(k,73) +rxt(k,74) +rxt(k,75) +rxt(k,76))*y(k,66) +rxt(k,62) & - *y(k,53) +rxt(k,16)*y(k,59) - loss(k,64) = (rxt(k,198)* y(k,4) +rxt(k,238)* y(k,20) +rxt(k,166)* y(k,26) & - + (rxt(k,113) +rxt(k,114) +rxt(k,115))* y(k,38) +rxt(k,144)* y(k,59) & - +rxt(k,149)* y(k,60) +rxt(k,139)* y(k,61) +rxt(k,117)* y(k,66) & - +rxt(k,118)* y(k,68) +rxt(k,192)* y(k,84) + (rxt(k,159) +rxt(k,160)) & - * y(k,85) + 2._r8*rxt(k,127)* y(k,87) +rxt(k,122)* y(k,96) & - + rxt(k,264) + het_rates(k,87))* y(k,87) - prod(k,64) = (rxt(k,221)*y(k,17) +rxt(k,224)*y(k,19) +rxt(k,121)*y(k,41) + & - rxt(k,124)*y(k,68) +rxt(k,142)*y(k,61) +rxt(k,173)*y(k,26) + & - rxt(k,203)*y(k,4) +rxt(k,242)*y(k,29) +rxt(k,259)*y(k,76) + & - .500_r8*rxt(k,263)*y(k,33))*y(k,96) + (rxt(k,155)*y(k,85) + & - rxt(k,191)*y(k,84) +rxt(k,235)*y(k,61) +rxt(k,236)*y(k,66))*y(k,16) & - + (rxt(k,220)*y(k,17) +rxt(k,223)*y(k,19) +rxt(k,158)*y(k,41)) & - *y(k,85) + (rxt(k,162)*y(k,26) +rxt(k,239)*y(k,59))*y(k,20) & - + (rxt(k,11) +rxt(k,153))*y(k,50) +rxt(k,244)*y(k,92)*y(k,22) & - +rxt(k,116)*y(k,67)*y(k,38) +rxt(k,112)*y(k,66)*y(k,41) - loss(k,53) = (rxt(k,129)* y(k,66) +rxt(k,130)* y(k,67) +rxt(k,302)* y(k,97) & + prod(k,74) = (rxt(k,77) +rxt(k,78) +rxt(k,79) +rxt(k,80) +rxt(k,81) + & + rxt(k,84) +rxt(k,85) +rxt(k,86))*y(k,69) + (rxt(k,71) +rxt(k,72) + & + rxt(k,73) +rxt(k,74) +rxt(k,75) +rxt(k,76))*y(k,68) +rxt(k,62) & + *y(k,55) +rxt(k,16)*y(k,61) + loss(k,87) = (rxt(k,192)* y(k,3) +rxt(k,198)* y(k,5) +rxt(k,238)* y(k,21) & + + (rxt(k,159) +rxt(k,160))* y(k,25) +rxt(k,166)* y(k,28) & + + (rxt(k,113) +rxt(k,114) +rxt(k,115))* y(k,40) +rxt(k,144)* y(k,61) & + +rxt(k,149)* y(k,62) +rxt(k,139)* y(k,63) +rxt(k,117)* y(k,68) & + +rxt(k,118)* y(k,70) + 2._r8*rxt(k,127)* y(k,87) +rxt(k,122) & + * y(k,96) + rxt(k,263) + het_rates(k,87))* y(k,87) + prod(k,87) = (rxt(k,121)*y(k,43) +rxt(k,124)*y(k,70) +rxt(k,142)*y(k,63) + & + rxt(k,173)*y(k,28) +rxt(k,203)*y(k,5) +rxt(k,221)*y(k,18) + & + rxt(k,224)*y(k,20) +rxt(k,245)*y(k,31) +rxt(k,251)*y(k,78) + & + .500_r8*rxt(k,261)*y(k,35))*y(k,96) + (rxt(k,155)*y(k,25) + & + rxt(k,191)*y(k,3) +rxt(k,235)*y(k,63) +rxt(k,236)*y(k,68))*y(k,17) & + + (rxt(k,158)*y(k,43) +rxt(k,220)*y(k,18) +rxt(k,223)*y(k,20)) & + *y(k,25) + (rxt(k,162)*y(k,28) +rxt(k,239)*y(k,61))*y(k,21) & + + (rxt(k,11) +rxt(k,153))*y(k,52) +rxt(k,243)*y(k,92)*y(k,23) & + +rxt(k,116)*y(k,69)*y(k,40) +rxt(k,112)*y(k,68)*y(k,43) + loss(k,75) = (rxt(k,129)* y(k,68) +rxt(k,130)* y(k,69) +rxt(k,301)* y(k,97) & + het_rates(k,88))* y(k,88) - prod(k,53) = (.800_r8*rxt(k,288)*y(k,90) +.900_r8*rxt(k,290)*y(k,89))*y(k,86) & - +rxt(k,292)*y(k,89)*y(k,66) - loss(k,42) = ((rxt(k,292) +rxt(k,293))* y(k,66) +rxt(k,291)* y(k,67) & - +rxt(k,290)* y(k,86) + het_rates(k,89))* y(k,89) - prod(k,42) =rxt(k,305)*y(k,98) +rxt(k,310)*y(k,99) - loss(k,44) = (rxt(k,288)* y(k,86) + het_rates(k,90))* y(k,90) - prod(k,44) = (rxt(k,298) +rxt(k,297)*y(k,53) +rxt(k,299)*y(k,59))*y(k,95) & - +rxt(k,16)*y(k,59) +rxt(k,292)*y(k,89)*y(k,66) +rxt(k,296)*y(k,91) & - *y(k,67) +rxt(k,301)*y(k,97) - loss(k,48) = (rxt(k,294)* y(k,66) + (rxt(k,295) +rxt(k,296))* y(k,67) & + prod(k,75) = (.800_r8*rxt(k,287)*y(k,90) +.900_r8*rxt(k,289)*y(k,89))*y(k,86) & + +rxt(k,291)*y(k,89)*y(k,68) + loss(k,63) = ((rxt(k,291) +rxt(k,292))* y(k,68) +rxt(k,290)* y(k,69) & + +rxt(k,289)* y(k,86) + het_rates(k,89))* y(k,89) + prod(k,63) =rxt(k,304)*y(k,98) +rxt(k,309)*y(k,99) + loss(k,65) = (rxt(k,287)* y(k,86) + het_rates(k,90))* y(k,90) + prod(k,65) = (rxt(k,297) +rxt(k,296)*y(k,55) +rxt(k,298)*y(k,61))*y(k,95) & + +rxt(k,16)*y(k,61) +rxt(k,291)*y(k,89)*y(k,68) +rxt(k,295)*y(k,91) & + *y(k,69) +rxt(k,300)*y(k,97) + loss(k,69) = (rxt(k,293)* y(k,68) + (rxt(k,294) +rxt(k,295))* y(k,69) & + het_rates(k,91))* y(k,91) - prod(k,48) =rxt(k,62)*y(k,53) +rxt(k,302)*y(k,97)*y(k,88) +rxt(k,311)*y(k,99) - loss(k,69) = (rxt(k,180)* y(k,7) +rxt(k,181)* y(k,8) +rxt(k,207)* y(k,9) & - +rxt(k,182)* y(k,10) +rxt(k,183)* y(k,11) +rxt(k,184)* y(k,12) & - +rxt(k,185)* y(k,13) +rxt(k,186)* y(k,14) +rxt(k,230)* y(k,15) & - +rxt(k,231)* y(k,17) + (rxt(k,243) +rxt(k,244) +rxt(k,245))* y(k,22) & - +rxt(k,208)* y(k,23) +rxt(k,216)* y(k,31) +rxt(k,217)* y(k,32) & - +rxt(k,94)* y(k,39) +rxt(k,209)* y(k,40) + (rxt(k,210) +rxt(k,211)) & - * y(k,43) +rxt(k,232)* y(k,44) +rxt(k,233)* y(k,45) +rxt(k,234) & - * y(k,46) + (rxt(k,187) +rxt(k,188))* y(k,47) + (rxt(k,147) + & - rxt(k,148))* y(k,54) + (rxt(k,97) +rxt(k,98))* y(k,67) +rxt(k,99) & - * y(k,68) +rxt(k,95)* y(k,100) + rxt(k,96) + het_rates(k,92)) & + prod(k,69) =rxt(k,62)*y(k,55) +rxt(k,301)*y(k,97)*y(k,88) +rxt(k,310)*y(k,99) + loss(k,92) = (rxt(k,180)* y(k,8) +rxt(k,181)* y(k,9) +rxt(k,207)* y(k,10) & + +rxt(k,182)* y(k,11) +rxt(k,183)* y(k,12) +rxt(k,184)* y(k,13) & + +rxt(k,185)* y(k,14) +rxt(k,186)* y(k,15) +rxt(k,230)* y(k,16) & + +rxt(k,231)* y(k,18) + (rxt(k,242) +rxt(k,243) +rxt(k,244))* y(k,23) & + +rxt(k,208)* y(k,24) +rxt(k,216)* y(k,33) +rxt(k,217)* y(k,34) & + +rxt(k,94)* y(k,41) +rxt(k,209)* y(k,42) + (rxt(k,210) +rxt(k,211)) & + * y(k,45) +rxt(k,232)* y(k,46) +rxt(k,233)* y(k,47) +rxt(k,234) & + * y(k,48) + (rxt(k,187) +rxt(k,188))* y(k,49) + (rxt(k,147) + & + rxt(k,148))* y(k,56) + (rxt(k,97) +rxt(k,98))* y(k,69) +rxt(k,99) & + * y(k,70) +rxt(k,95)* y(k,100) + rxt(k,96) + het_rates(k,92)) & * y(k,92) - prod(k,69) = (rxt(k,6) +rxt(k,130)*y(k,88))*y(k,67) +rxt(k,7)*y(k,68) & - +.850_r8*rxt(k,289)*y(k,95)*y(k,86) +rxt(k,1)*y(k,100) - loss(k,24) = (rxt(k,101)* y(k,66) +rxt(k,102)* y(k,67) + rxt(k,92) & + prod(k,92) = (rxt(k,6) +rxt(k,130)*y(k,88))*y(k,69) +rxt(k,12)*y(k,56) & + +rxt(k,7)*y(k,70) +.850_r8*rxt(k,288)*y(k,95)*y(k,86) +rxt(k,1) & + *y(k,100) + loss(k,37) = (rxt(k,101)* y(k,68) +rxt(k,102)* y(k,69) + rxt(k,92) & + rxt(k,100) + het_rates(k,93))* y(k,93) - prod(k,24) = (rxt(k,104) +rxt(k,103)*y(k,30) +rxt(k,105)*y(k,66) + & - rxt(k,106)*y(k,67) +rxt(k,107)*y(k,68))*y(k,94) +rxt(k,7)*y(k,68) - loss(k,25) = (rxt(k,103)* y(k,30) +rxt(k,105)* y(k,66) +rxt(k,106)* y(k,67) & - +rxt(k,107)* y(k,68) + rxt(k,93) + rxt(k,104) + het_rates(k,94)) & + prod(k,37) = (rxt(k,104) +rxt(k,103)*y(k,32) +rxt(k,105)*y(k,68) + & + rxt(k,106)*y(k,69) +rxt(k,107)*y(k,70))*y(k,94) +rxt(k,7)*y(k,70) + loss(k,38) = (rxt(k,103)* y(k,32) +rxt(k,105)* y(k,68) +rxt(k,106)* y(k,69) & + +rxt(k,107)* y(k,70) + rxt(k,93) + rxt(k,104) + het_rates(k,94)) & * y(k,94) - prod(k,25) =rxt(k,97)*y(k,92)*y(k,67) - loss(k,51) = (rxt(k,297)* y(k,53) +rxt(k,299)* y(k,59) +rxt(k,289)* y(k,86) & - + rxt(k,298) + het_rates(k,95))* y(k,95) - prod(k,51) = (rxt(k,78) +rxt(k,80) +rxt(k,291)*y(k,89) +rxt(k,295)*y(k,91) + & - rxt(k,303)*y(k,97) +rxt(k,307)*y(k,98))*y(k,67) +rxt(k,300)*y(k,97) & - *y(k,30) - loss(k,73) = (rxt(k,203)* y(k,4) +rxt(k,219)* y(k,15) +rxt(k,237)* y(k,16) & - +rxt(k,221)* y(k,17) +rxt(k,222)* y(k,18) +rxt(k,224)* y(k,19) & - +rxt(k,240)* y(k,21) +rxt(k,241)* y(k,22) +rxt(k,226)* y(k,23) & - + (rxt(k,173) +rxt(k,174))* y(k,26) +rxt(k,171)* y(k,27) & - + (rxt(k,242) +rxt(k,246))* y(k,29) + (rxt(k,262) +rxt(k,263)) & - * y(k,33) +rxt(k,120)* y(k,39) +rxt(k,121)* y(k,41) +rxt(k,205) & - * y(k,43) +rxt(k,227)* y(k,44) +rxt(k,228)* y(k,45) +rxt(k,229) & - * y(k,46) +rxt(k,176)* y(k,47) +rxt(k,152)* y(k,49) +rxt(k,128) & - * y(k,50) +rxt(k,179)* y(k,52) +rxt(k,143)* y(k,53) +rxt(k,151) & - * y(k,60) +rxt(k,142)* y(k,61) +rxt(k,123)* y(k,66) +rxt(k,124) & - * y(k,68) +rxt(k,248)* y(k,70) +rxt(k,253)* y(k,73) +rxt(k,258) & - * y(k,75) +rxt(k,259)* y(k,76) +rxt(k,122)* y(k,87) & - + 2._r8*(rxt(k,125) +rxt(k,126))* y(k,96) + het_rates(k,96)) & - * y(k,96) - prod(k,73) = (rxt(k,111)*y(k,39) +rxt(k,112)*y(k,41) +rxt(k,117)*y(k,87) + & - rxt(k,175)*y(k,47) +rxt(k,178)*y(k,52) +rxt(k,204)*y(k,43) + & - rxt(k,206)*y(k,51) +rxt(k,236)*y(k,16))*y(k,66) & - + (2.000_r8*rxt(k,114)*y(k,38) +rxt(k,118)*y(k,68) + & - rxt(k,139)*y(k,61) +rxt(k,144)*y(k,59) +rxt(k,160)*y(k,85))*y(k,87) & - + (rxt(k,243)*y(k,22) +rxt(k,94)*y(k,39) + & - 2.000_r8*rxt(k,95)*y(k,100) +rxt(k,187)*y(k,47) +rxt(k,210)*y(k,43)) & - *y(k,92) + (rxt(k,22) +.300_r8*rxt(k,240)*y(k,96))*y(k,21) & - + (rxt(k,3) +rxt(k,214)*y(k,37))*y(k,100) +rxt(k,119)*y(k,68) & - *y(k,38) +2.000_r8*rxt(k,4)*y(k,41) +rxt(k,9)*y(k,49) +rxt(k,10) & - *y(k,50) +rxt(k,57)*y(k,51) +rxt(k,58)*y(k,52) +.500_r8*rxt(k,266) & - *y(k,60) - loss(k,50) = (rxt(k,300)* y(k,30) +rxt(k,303)* y(k,67) +rxt(k,302)* y(k,88) & - + rxt(k,301) + het_rates(k,97))* y(k,97) - prod(k,50) = (rxt(k,73) +rxt(k,74) +rxt(k,293)*y(k,89) +rxt(k,294)*y(k,91) + & - rxt(k,306)*y(k,98) +rxt(k,312)*y(k,99))*y(k,66) + (rxt(k,79) + & - rxt(k,81))*y(k,67) + (rxt(k,304)*y(k,98) +rxt(k,309)*y(k,99))*y(k,86) & - +rxt(k,286)*y(k,98) +rxt(k,285)*y(k,99) - loss(k,38) = (rxt(k,306)* y(k,66) +rxt(k,307)* y(k,67) +rxt(k,304)* y(k,86) & - + rxt(k,286) + rxt(k,305) + het_rates(k,98))* y(k,98) - prod(k,38) = (rxt(k,75) +rxt(k,76))*y(k,66) + (rxt(k,85) +rxt(k,86))*y(k,67) & - + (rxt(k,287) +rxt(k,308)*y(k,86))*y(k,99) - loss(k,37) = (rxt(k,312)* y(k,66) + (rxt(k,308) +rxt(k,309))* y(k,86) & - + rxt(k,285) + rxt(k,287) + rxt(k,310) + rxt(k,311) & + prod(k,38) =rxt(k,97)*y(k,92)*y(k,69) + loss(k,77) = (rxt(k,296)* y(k,55) +rxt(k,298)* y(k,61) +rxt(k,288)* y(k,86) & + + rxt(k,297) + het_rates(k,95))* y(k,95) + prod(k,77) = (rxt(k,78) +rxt(k,80) +rxt(k,290)*y(k,89) +rxt(k,294)*y(k,91) + & + rxt(k,302)*y(k,97) +rxt(k,306)*y(k,98))*y(k,69) +rxt(k,299)*y(k,97) & + *y(k,32) + loss(k,96) = (rxt(k,203)* y(k,5) +rxt(k,219)* y(k,16) +rxt(k,237)* y(k,17) & + +rxt(k,221)* y(k,18) +rxt(k,222)* y(k,19) +rxt(k,224)* y(k,20) & + +rxt(k,240)* y(k,22) +rxt(k,241)* y(k,23) +rxt(k,226)* y(k,24) & + + (rxt(k,173) +rxt(k,174))* y(k,28) +rxt(k,171)* y(k,29) +rxt(k,245) & + * y(k,31) + (rxt(k,247) +rxt(k,261))* y(k,35) +rxt(k,120)* y(k,41) & + +rxt(k,121)* y(k,43) +rxt(k,205)* y(k,45) +rxt(k,227)* y(k,46) & + +rxt(k,228)* y(k,47) +rxt(k,229)* y(k,48) +rxt(k,176)* y(k,49) & + +rxt(k,152)* y(k,51) +rxt(k,128)* y(k,52) +rxt(k,179)* y(k,54) & + +rxt(k,143)* y(k,55) +rxt(k,151)* y(k,62) +rxt(k,142)* y(k,63) & + +rxt(k,123)* y(k,68) +rxt(k,124)* y(k,70) +rxt(k,249)* y(k,72) & + +rxt(k,255)* y(k,75) +rxt(k,260)* y(k,77) +rxt(k,251)* y(k,78) & + +rxt(k,122)* y(k,87) + 2._r8*(rxt(k,125) +rxt(k,126))* y(k,96) & + + het_rates(k,96))* y(k,96) + prod(k,96) = (rxt(k,111)*y(k,41) +rxt(k,112)*y(k,43) +rxt(k,117)*y(k,87) + & + rxt(k,175)*y(k,49) +rxt(k,178)*y(k,54) +rxt(k,204)*y(k,45) + & + rxt(k,206)*y(k,53) +rxt(k,236)*y(k,17))*y(k,68) & + + (2.000_r8*rxt(k,114)*y(k,40) +rxt(k,118)*y(k,70) + & + rxt(k,139)*y(k,63) +rxt(k,144)*y(k,61) +rxt(k,160)*y(k,25))*y(k,87) & + + (rxt(k,94)*y(k,41) +2.000_r8*rxt(k,95)*y(k,100) + & + rxt(k,187)*y(k,49) +rxt(k,210)*y(k,45) +rxt(k,242)*y(k,23))*y(k,92) & + + (rxt(k,22) +.300_r8*rxt(k,240)*y(k,96))*y(k,22) + (rxt(k,3) + & + rxt(k,214)*y(k,39))*y(k,100) +.330_r8*rxt(k,24)*y(k,23) & + +rxt(k,119)*y(k,70)*y(k,40) +2.000_r8*rxt(k,4)*y(k,43) +rxt(k,9) & + *y(k,51) +rxt(k,10)*y(k,52) +rxt(k,57)*y(k,53) +rxt(k,58)*y(k,54) & + +.500_r8*rxt(k,265)*y(k,62) + loss(k,78) = (rxt(k,299)* y(k,32) +rxt(k,302)* y(k,69) +rxt(k,301)* y(k,88) & + + rxt(k,300) + het_rates(k,97))* y(k,97) + prod(k,78) = (rxt(k,73) +rxt(k,74) +rxt(k,292)*y(k,89) +rxt(k,293)*y(k,91) + & + rxt(k,305)*y(k,98) +rxt(k,311)*y(k,99))*y(k,68) + (rxt(k,79) + & + rxt(k,81))*y(k,69) + (rxt(k,303)*y(k,98) +rxt(k,308)*y(k,99))*y(k,86) & + +rxt(k,285)*y(k,98) +rxt(k,284)*y(k,99) + loss(k,58) = (rxt(k,305)* y(k,68) +rxt(k,306)* y(k,69) +rxt(k,303)* y(k,86) & + + rxt(k,285) + rxt(k,304) + het_rates(k,98))* y(k,98) + prod(k,58) = (rxt(k,75) +rxt(k,76))*y(k,68) + (rxt(k,85) +rxt(k,86))*y(k,69) & + + (rxt(k,286) +rxt(k,307)*y(k,86))*y(k,99) + loss(k,57) = (rxt(k,311)* y(k,68) + (rxt(k,307) +rxt(k,308))* y(k,86) & + + rxt(k,284) + rxt(k,286) + rxt(k,309) + rxt(k,310) & + het_rates(k,99))* y(k,99) - prod(k,37) = (rxt(k,71) +rxt(k,72))*y(k,66) + (rxt(k,77) +rxt(k,84))*y(k,67) - loss(k,77) = (rxt(k,214)* y(k,37) +rxt(k,260)* y(k,77) +rxt(k,95)* y(k,92) & + prod(k,57) = (rxt(k,71) +rxt(k,72))*y(k,68) + (rxt(k,77) +rxt(k,84))*y(k,69) + loss(k,100) = (rxt(k,214)* y(k,39) +rxt(k,262)* y(k,79) +rxt(k,95)* y(k,92) & + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,100))* y(k,100) - prod(k,77) = (rxt(k,219)*y(k,15) +rxt(k,221)*y(k,17) +rxt(k,222)*y(k,18) + & - rxt(k,224)*y(k,19) +rxt(k,229)*y(k,46) +rxt(k,241)*y(k,22) + & - rxt(k,120)*y(k,39) +rxt(k,121)*y(k,41) +rxt(k,122)*y(k,87) + & - rxt(k,125)*y(k,96) +rxt(k,128)*y(k,50) +rxt(k,152)*y(k,49) + & - rxt(k,176)*y(k,47) +rxt(k,179)*y(k,52) +rxt(k,205)*y(k,43) + & - rxt(k,237)*y(k,16) +rxt(k,240)*y(k,21))*y(k,96) & - + (rxt(k,269)*y(k,52) +rxt(k,275)*y(k,52) +rxt(k,276)*y(k,51) + & - rxt(k,280)*y(k,52) +rxt(k,281)*y(k,51))*y(k,47) +rxt(k,115)*y(k,87) & - *y(k,38) +rxt(k,87)*y(k,42) + prod(k,100) = (rxt(k,120)*y(k,41) +rxt(k,121)*y(k,43) +rxt(k,122)*y(k,87) + & + rxt(k,125)*y(k,96) +rxt(k,128)*y(k,52) +rxt(k,152)*y(k,51) + & + rxt(k,176)*y(k,49) +rxt(k,179)*y(k,54) +rxt(k,205)*y(k,45) + & + rxt(k,219)*y(k,16) +rxt(k,221)*y(k,18) +rxt(k,222)*y(k,19) + & + rxt(k,224)*y(k,20) +rxt(k,229)*y(k,48) +rxt(k,237)*y(k,17) + & + rxt(k,240)*y(k,22) +rxt(k,241)*y(k,23))*y(k,96) & + + (rxt(k,268)*y(k,54) +rxt(k,274)*y(k,54) +rxt(k,275)*y(k,53) + & + rxt(k,279)*y(k,54) +rxt(k,280)*y(k,53))*y(k,49) +.050_r8*rxt(k,24) & + *y(k,23) +rxt(k,115)*y(k,87)*y(k,40) +rxt(k,87)*y(k,44) end do end subroutine imp_prod_loss end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_rxt_rates_conv.F90 index e4af026508..259254ea20 100644 --- a/src/chemistry/pp_waccm_ma_mam4/mo_rxt_rates_conv.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/mo_rxt_rates_conv.F90 @@ -11,65 +11,65 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 100) ! rate_const*H2O rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 100) ! rate_const*H2O rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 100) ! rate_const*H2O - rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 41) ! rate_const*H2O2 - rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 67) ! rate_const*O2 - rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 67) ! rate_const*O2 - rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 68) ! rate_const*O3 - rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 68) ! rate_const*O3 - rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 49) ! rate_const*HNO3 - rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 50) ! rate_const*HO2NO2 - rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 50) ! rate_const*HO2NO2 - rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 54) ! rate_const*N2O - rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 55) ! rate_const*N2O5 - rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 55) ! rate_const*N2O5 - rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 59) ! rate_const*NO - rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 59) ! rate_const*NO - rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 60) ! rate_const*NO2 - rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 61) ! rate_const*NO3 - rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 61) ! rate_const*NO3 - rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 16) ! rate_const*CH2O - rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 16) ! rate_const*CH2O - rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 21) ! rate_const*CH3OOH - rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 22) ! rate_const*CH4 - rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 22) ! rate_const*CH4 - rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 30) ! rate_const*CO2 - rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 3) ! rate_const*BRCL - rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 4) ! rate_const*BRO - rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 5) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 5) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 7) ! rate_const*CCL4 - rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 8) ! rate_const*CF2CLBR - rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 9) ! rate_const*CF3BR - rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 10) ! rate_const*CFC11 - rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 11) ! rate_const*CFC113 - rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 12) ! rate_const*CFC114 - rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 13) ! rate_const*CFC115 - rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 14) ! rate_const*CFC12 - rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 15) ! rate_const*CH2BR2 - rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 17) ! rate_const*CH3BR - rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 18) ! rate_const*CH3CCL3 - rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 19) ! rate_const*CH3CL - rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 23) ! rate_const*CHBR3 - rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 24) ! rate_const*CL2 - rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 25) ! rate_const*CL2O2 - rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 26) ! rate_const*CLO - rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 27) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 27) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 31) ! rate_const*COF2 - rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 32) ! rate_const*COFCL - rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 40) ! rate_const*H2402 - rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 43) ! rate_const*HBR - rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 44) ! rate_const*HCFC141B - rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 45) ! rate_const*HCFC142B - rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 46) ! rate_const*HCFC22 - rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 47) ! rate_const*HCL - rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 48) ! rate_const*HF - rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 51) ! rate_const*HOBR - rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 52) ! rate_const*HOCL - rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 69) ! rate_const*OCLO - rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 74) ! rate_const*SF6 - rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 30) ! rate_const*CO2 - rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 53) ! rate_const*N + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 43) ! rate_const*H2O2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 69) ! rate_const*O2 + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 69) ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 70) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 70) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 51) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 52) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 52) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 56) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 57) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 57) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 61) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 61) ! rate_const*NO + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 62) ! rate_const*NO2 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 63) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 63) ! rate_const*NO3 + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 17) ! rate_const*CH2O + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 17) ! rate_const*CH2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 22) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 23) ! rate_const*CH4 + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 23) ! rate_const*CH4 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 32) ! rate_const*CO2 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 4) ! rate_const*BRCL + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 5) ! rate_const*BRO + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 8) ! rate_const*CCL4 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 9) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 10) ! rate_const*CF3BR + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 11) ! rate_const*CFC11 + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 12) ! rate_const*CFC113 + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 13) ! rate_const*CFC114 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 14) ! rate_const*CFC115 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 15) ! rate_const*CFC12 + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 16) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 18) ! rate_const*CH3BR + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 19) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 20) ! rate_const*CH3CL + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 24) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 26) ! rate_const*CL2 + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 27) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 28) ! rate_const*CLO + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 33) ! rate_const*COF2 + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 34) ! rate_const*COFCL + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 42) ! rate_const*H2402 + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 45) ! rate_const*HBR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 46) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 47) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 48) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 49) ! rate_const*HCL + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 50) ! rate_const*HF + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 53) ! rate_const*HOBR + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 54) ! rate_const*HOCL + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 71) ! rate_const*OCLO + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 76) ! rate_const*SF6 + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 32) ! rate_const*CO2 + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 55) ! rate_const*N ! rate_const*N2 ! rate_const*N2 ! rate_const*N2 @@ -78,247 +78,246 @@ subroutine set_rates( rxt_rates, sol, ncol ) ! rate_const*N2 ! rate_const*N2 ! rate_const*N2 - rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 66) ! rate_const*O - rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 66) ! rate_const*O - rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 66) ! rate_const*O - rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 66) ! rate_const*O - rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 66) ! rate_const*O - rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 66) ! rate_const*O - rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 67) ! rate_const*O2 - rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 67) ! rate_const*O2 - rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 67) ! rate_const*O2 - rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 67) ! rate_const*O2 - rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 67) ! rate_const*O2 - rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 67) ! rate_const*O2 - rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 67) ! rate_const*O2 - rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 67) ! rate_const*O2 - rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 67) ! rate_const*O2 - rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 67) ! rate_const*O2 - rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 42) ! rate_const*H2SO4 - rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 70) ! rate_const*OCS - rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 75) ! rate_const*SO - rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 76) ! rate_const*SO2 - rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 77) ! rate_const*SO3 + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 68) ! rate_const*O + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 68) ! rate_const*O + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 68) ! rate_const*O + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 68) ! rate_const*O + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 68) ! rate_const*O + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 68) ! rate_const*O + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 69) ! rate_const*O2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 69) ! rate_const*O2 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 69) ! rate_const*O2 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 69) ! rate_const*O2 + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 69) ! rate_const*O2 + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 69) ! rate_const*O2 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 69) ! rate_const*O2 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 69) ! rate_const*O2 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 69) ! rate_const*O2 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 69) ! rate_const*O2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 44) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 72) ! rate_const*OCS + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 77) ! rate_const*SO + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 78) ! rate_const*SO2 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 79) ! rate_const*SO3 rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 93) ! rate_const*O2_1D rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 94) ! rate_const*O2_1S - rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 92)*sol(:ncol,:, 39) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 92)*sol(:ncol,:, 41) ! rate_const*O1D*H2 rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 92)*sol(:ncol,:, 100) ! rate_const*O1D*H2O rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 92) ! rate_const*N2*O1D - rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 92)*sol(:ncol,:, 67) ! rate_const*O1D*O2 - rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 92)*sol(:ncol,:, 67) ! rate_const*O1D*O2 - rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 92)*sol(:ncol,:, 68) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 92)*sol(:ncol,:, 69) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 92)*sol(:ncol,:, 69) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 92)*sol(:ncol,:, 70) ! rate_const*O1D*O3 rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 93) ! rate_const*N2*O2_1D - rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 93)*sol(:ncol,:, 66) ! rate_const*O2_1D*O - rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 93)*sol(:ncol,:, 67) ! rate_const*O2_1D*O2 - rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 94)*sol(:ncol,:, 30) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 93)*sol(:ncol,:, 68) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 93)*sol(:ncol,:, 69) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 94)*sol(:ncol,:, 32) ! rate_const*O2_1S*CO2 rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 94) ! rate_const*N2*O2_1S - rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 94)*sol(:ncol,:, 66) ! rate_const*O2_1S*O - rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 94)*sol(:ncol,:, 67) ! rate_const*O2_1S*O2 - rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 94)*sol(:ncol,:, 68) ! rate_const*O2_1S*O3 - rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 66)*sol(:ncol,:, 68) ! rate_const*O*O3 - rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 66)*sol(:ncol,:, 66) ! rate_const*M*O*O - rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 66)*sol(:ncol,:, 67) ! rate_const*M*O*O2 - rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 39)*sol(:ncol,:, 66) ! rate_const*H2*O - rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 41)*sol(:ncol,:, 66) ! rate_const*H2O2*O - rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 38)*sol(:ncol,:, 87) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 38)*sol(:ncol,:, 87) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 38)*sol(:ncol,:, 87) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 38)*sol(:ncol,:, 67) ! rate_const*M*H*O2 - rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 87)*sol(:ncol,:, 66) ! rate_const*HO2*O - rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 87)*sol(:ncol,:, 68) ! rate_const*HO2*O3 - rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 38)*sol(:ncol,:, 68) ! rate_const*H*O3 - rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 96)*sol(:ncol,:, 39) ! rate_const*OH*H2 - rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 96)*sol(:ncol,:, 41) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 94)*sol(:ncol,:, 68) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 94)*sol(:ncol,:, 69) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 94)*sol(:ncol,:, 70) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 68)*sol(:ncol,:, 70) ! rate_const*O*O3 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 68)*sol(:ncol,:, 68) ! rate_const*M*O*O + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 68)*sol(:ncol,:, 69) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 41)*sol(:ncol,:, 68) ! rate_const*H2*O + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 43)*sol(:ncol,:, 68) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 40)*sol(:ncol,:, 87) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 40)*sol(:ncol,:, 87) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 40)*sol(:ncol,:, 87) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 40)*sol(:ncol,:, 69) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 87)*sol(:ncol,:, 68) ! rate_const*HO2*O + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 87)*sol(:ncol,:, 70) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 40)*sol(:ncol,:, 70) ! rate_const*H*O3 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 96)*sol(:ncol,:, 41) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 96)*sol(:ncol,:, 43) ! rate_const*OH*H2O2 rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 96)*sol(:ncol,:, 87) ! rate_const*OH*HO2 - rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 96)*sol(:ncol,:, 66) ! rate_const*OH*O - rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 96)*sol(:ncol,:, 68) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 96)*sol(:ncol,:, 68) ! rate_const*OH*O + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 96)*sol(:ncol,:, 70) ! rate_const*OH*O3 rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 96)*sol(:ncol,:, 96) ! rate_const*OH*OH rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 96)*sol(:ncol,:, 96) ! rate_const*M*OH*OH rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 87)*sol(:ncol,:, 87) ! rate_const*HO2*HO2 - rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 50)*sol(:ncol,:, 96) ! rate_const*HO2NO2*OH - rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 88)*sol(:ncol,:, 66) ! rate_const*N2D*O - rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 88)*sol(:ncol,:, 67) ! rate_const*N2D*O2 - rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 53)*sol(:ncol,:, 59) ! rate_const*N*NO - rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 53)*sol(:ncol,:, 60) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 53)*sol(:ncol,:, 60) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 53)*sol(:ncol,:, 60) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 53)*sol(:ncol,:, 67) ! rate_const*N*O2 - rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 60)*sol(:ncol,:, 66) ! rate_const*NO2*O - rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 60)*sol(:ncol,:, 68) ! rate_const*NO2*O3 - rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 60)*sol(:ncol,:, 66) ! rate_const*M*NO2*O - rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 61)*sol(:ncol,:, 87) ! rate_const*NO3*HO2 - rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 61)*sol(:ncol,:, 59) ! rate_const*NO3*NO - rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 61)*sol(:ncol,:, 66) ! rate_const*NO3*O - rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 61)*sol(:ncol,:, 96) ! rate_const*NO3*OH - rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 53)*sol(:ncol,:, 96) ! rate_const*N*OH - rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 59)*sol(:ncol,:, 87) ! rate_const*NO*HO2 - rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 59)*sol(:ncol,:, 68) ! rate_const*NO*O3 - rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 59)*sol(:ncol,:, 66) ! rate_const*M*NO*O - rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 92)*sol(:ncol,:, 54) ! rate_const*O1D*N2O - rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 92)*sol(:ncol,:, 54) ! rate_const*O1D*N2O - rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 60)*sol(:ncol,:, 87) ! rate_const*M*NO2*HO2 - rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 60)*sol(:ncol,:, 61) ! rate_const*M*NO2*NO3 - rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 60)*sol(:ncol,:, 96) ! rate_const*M*NO2*OH - rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 49)*sol(:ncol,:, 96) ! rate_const*HNO3*OH - rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 50) ! rate_const*M*HO2NO2 - rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 55) ! rate_const*M*N2O5 - rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 85)*sol(:ncol,:, 16) ! rate_const*CL*CH2O - rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 85)*sol(:ncol,:, 22) ! rate_const*CL*CH4 - rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 85)*sol(:ncol,:, 39) ! rate_const*CL*H2 - rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 85)*sol(:ncol,:, 41) ! rate_const*CL*H2O2 - rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 85)*sol(:ncol,:, 87) ! rate_const*CL*HO2 - rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 85)*sol(:ncol,:, 87) ! rate_const*CL*HO2 - rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 85)*sol(:ncol,:, 68) ! rate_const*CL*O3 - rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 26)*sol(:ncol,:, 20) ! rate_const*CLO*CH3O2 - rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 26)*sol(:ncol,:, 87) ! rate_const*CLO*HO2 - rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 26)*sol(:ncol,:, 59) ! rate_const*CLO*NO - rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 27)*sol(:ncol,:, 85) ! rate_const*CLONO2*CL - rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 26)*sol(:ncol,:, 60) ! rate_const*M*CLO*NO2 - rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 27)*sol(:ncol,:, 66) ! rate_const*CLONO2*O - rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 27)*sol(:ncol,:, 96) ! rate_const*CLONO2*OH - rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 26)*sol(:ncol,:, 66) ! rate_const*CLO*O - rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 26)*sol(:ncol,:, 96) ! rate_const*CLO*OH - rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 26)*sol(:ncol,:, 96) ! rate_const*CLO*OH - rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 47)*sol(:ncol,:, 66) ! rate_const*HCL*O - rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 47)*sol(:ncol,:, 96) ! rate_const*HCL*OH - rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 52)*sol(:ncol,:, 85) ! rate_const*HOCL*CL - rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 52)*sol(:ncol,:, 66) ! rate_const*HOCL*O - rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 52)*sol(:ncol,:, 96) ! rate_const*HOCL*OH - rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 92)*sol(:ncol,:, 7) ! rate_const*O1D*CCL4 - rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 92)*sol(:ncol,:, 8) ! rate_const*O1D*CF2CLBR - rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 92)*sol(:ncol,:, 10) ! rate_const*O1D*CFC11 - rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 92)*sol(:ncol,:, 11) ! rate_const*O1D*CFC113 - rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 92)*sol(:ncol,:, 12) ! rate_const*O1D*CFC114 - rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 92)*sol(:ncol,:, 13) ! rate_const*O1D*CFC115 - rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 92)*sol(:ncol,:, 14) ! rate_const*O1D*CFC12 - rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 92)*sol(:ncol,:, 47) ! rate_const*O1D*HCL - rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 92)*sol(:ncol,:, 47) ! rate_const*O1D*HCL - rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*M*CLO*CLO - rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 25) ! rate_const*M*CL2O2 - rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 84)*sol(:ncol,:, 16) ! rate_const*BR*CH2O - rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 84)*sol(:ncol,:, 87) ! rate_const*BR*HO2 - rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 84)*sol(:ncol,:, 68) ! rate_const*BR*O3 - rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 4)*sol(:ncol,:, 4) ! rate_const*BRO*BRO - rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 4)*sol(:ncol,:, 26) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 4)*sol(:ncol,:, 26) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 4)*sol(:ncol,:, 26) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 4)*sol(:ncol,:, 87) ! rate_const*BRO*HO2 - rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 4)*sol(:ncol,:, 59) ! rate_const*BRO*NO - rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 4)*sol(:ncol,:, 60) ! rate_const*M*BRO*NO2 - rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 5)*sol(:ncol,:, 66) ! rate_const*BRONO2*O - rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 4)*sol(:ncol,:, 66) ! rate_const*BRO*O - rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 4)*sol(:ncol,:, 96) ! rate_const*BRO*OH - rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 43)*sol(:ncol,:, 66) ! rate_const*HBR*O - rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 43)*sol(:ncol,:, 96) ! rate_const*HBR*OH - rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 51)*sol(:ncol,:, 66) ! rate_const*HOBR*O - rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 92)*sol(:ncol,:, 9) ! rate_const*O1D*CF3BR - rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 92)*sol(:ncol,:, 23) ! rate_const*O1D*CHBR3 - rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 92)*sol(:ncol,:, 40) ! rate_const*O1D*H2402 - rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 92)*sol(:ncol,:, 43) ! rate_const*O1D*HBR - rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 92)*sol(:ncol,:, 43) ! rate_const*O1D*HBR - rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 37)*sol(:ncol,:, 22) ! rate_const*F*CH4 - rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 37)*sol(:ncol,:, 39) ! rate_const*F*H2 - rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 37)*sol(:ncol,:, 100) ! rate_const*F*H2O - rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 37)*sol(:ncol,:, 49) ! rate_const*F*HNO3 - rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 92)*sol(:ncol,:, 31) ! rate_const*O1D*COF2 - rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 92)*sol(:ncol,:, 32) ! rate_const*O1D*COFCL - rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 15)*sol(:ncol,:, 85) ! rate_const*CH2BR2*CL - rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 15)*sol(:ncol,:, 96) ! rate_const*CH2BR2*OH - rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 17)*sol(:ncol,:, 85) ! rate_const*CH3BR*CL - rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 17)*sol(:ncol,:, 96) ! rate_const*CH3BR*OH - rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 18)*sol(:ncol,:, 96) ! rate_const*CH3CCL3*OH - rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 19)*sol(:ncol,:, 85) ! rate_const*CH3CL*CL - rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 19)*sol(:ncol,:, 96) ! rate_const*CH3CL*OH - rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 23)*sol(:ncol,:, 85) ! rate_const*CHBR3*CL - rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 23)*sol(:ncol,:, 96) ! rate_const*CHBR3*OH - rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 44)*sol(:ncol,:, 96) ! rate_const*HCFC141B*OH - rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 45)*sol(:ncol,:, 96) ! rate_const*HCFC142B*OH - rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 46)*sol(:ncol,:, 96) ! rate_const*HCFC22*OH - rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 92)*sol(:ncol,:, 15) ! rate_const*O1D*CH2BR2 - rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 92)*sol(:ncol,:, 17) ! rate_const*O1D*CH3BR - rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 92)*sol(:ncol,:, 44) ! rate_const*O1D*HCFC141B - rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 92)*sol(:ncol,:, 45) ! rate_const*O1D*HCFC142B - rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 92)*sol(:ncol,:, 46) ! rate_const*O1D*HCFC22 - rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 16)*sol(:ncol,:, 61) ! rate_const*CH2O*NO3 - rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 16)*sol(:ncol,:, 66) ! rate_const*CH2O*O - rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 16)*sol(:ncol,:, 96) ! rate_const*CH2O*OH - rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 20)*sol(:ncol,:, 87) ! rate_const*CH3O2*HO2 - rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 20)*sol(:ncol,:, 59) ! rate_const*CH3O2*NO - rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 21)*sol(:ncol,:, 96) ! rate_const*CH3OOH*OH - rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 22)*sol(:ncol,:, 96) ! rate_const*CH4*OH - rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 29)*sol(:ncol,:, 96) ! rate_const*M*CO*OH - rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 92)*sol(:ncol,:, 22) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 92)*sol(:ncol,:, 22) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 92)*sol(:ncol,:, 22) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 29)*sol(:ncol,:, 96) ! rate_const*CO*OH - rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 70)*sol(:ncol,:, 66) ! rate_const*OCS*O - rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 70)*sol(:ncol,:, 96) ! rate_const*OCS*OH - rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 73)*sol(:ncol,:, 67) ! rate_const*S*O2 - rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 73)*sol(:ncol,:, 68) ! rate_const*S*O3 - rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 75)*sol(:ncol,:, 4) ! rate_const*SO*BRO - rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 75)*sol(:ncol,:, 26) ! rate_const*SO*CLO - rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 73)*sol(:ncol,:, 96) ! rate_const*S*OH - rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 75)*sol(:ncol,:, 60) ! rate_const*SO*NO2 - rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 75)*sol(:ncol,:, 67) ! rate_const*SO*O2 - rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 75)*sol(:ncol,:, 68) ! rate_const*SO*O3 - rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 75)*sol(:ncol,:, 69) ! rate_const*SO*OCLO - rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 75)*sol(:ncol,:, 96) ! rate_const*SO*OH - rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 76)*sol(:ncol,:, 96) ! rate_const*SO2*OH - rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 77)*sol(:ncol,:, 100) ! rate_const*SO3*H2O - rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 33)*sol(:ncol,:, 61) ! rate_const*DMS*NO3 - rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 33)*sol(:ncol,:, 96) ! rate_const*DMS*OH - rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 33)*sol(:ncol,:, 96) ! rate_const*DMS*OH - rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 87) ! rate_const*HO2 - rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 55) ! rate_const*N2O5 - rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 60) ! rate_const*NO2 - rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 61) ! rate_const*NO3 - rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 55) ! rate_const*N2O5 - rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 52)*sol(:ncol,:, 47) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 5) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 55) ! rate_const*N2O5 - rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 27) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 5) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 27)*sol(:ncol,:, 47) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 52)*sol(:ncol,:, 47) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 51)*sol(:ncol,:, 47) ! rate_const*HOBR*HCL - rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 27) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 5) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 27)*sol(:ncol,:, 47) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 52)*sol(:ncol,:, 47) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 51)*sol(:ncol,:, 47) ! rate_const*HOBR*HCL - rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 55) ! rate_const*N2O5 - rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 27) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 27)*sol(:ncol,:, 47) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 99) ! rate_const*Op2P - rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 98) ! rate_const*Op2D - rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 99) ! rate_const*Op2P - rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 90)*sol(:ncol,:, 86) ! rate_const*NOp*e - rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 95)*sol(:ncol,:, 86) ! rate_const*O2p*e - rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 89)*sol(:ncol,:, 86) ! rate_const*N2p*e - rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 89)*sol(:ncol,:, 67) ! rate_const*N2p*O2 - rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 89)*sol(:ncol,:, 66) ! rate_const*N2p*O - rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 89)*sol(:ncol,:, 66) ! rate_const*N2p*O - rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 91)*sol(:ncol,:, 66) ! rate_const*Np*O - rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 91)*sol(:ncol,:, 67) ! rate_const*Np*O2 - rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 91)*sol(:ncol,:, 67) ! rate_const*Np*O2 - rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 95)*sol(:ncol,:, 53) ! rate_const*O2p*N - rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 95) ! rate_const*N2*O2p - rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 95)*sol(:ncol,:, 59) ! rate_const*O2p*NO - rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 97)*sol(:ncol,:, 30) ! rate_const*Op*CO2 - rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 97) ! rate_const*N2*Op - rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 97)*sol(:ncol,:, 88) ! rate_const*Op*N2D - rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 97)*sol(:ncol,:, 67) ! rate_const*Op*O2 - rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 98)*sol(:ncol,:, 86) ! rate_const*Op2D*e - rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 98) ! rate_const*N2*Op2D - rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 98)*sol(:ncol,:, 66) ! rate_const*Op2D*O - rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 98)*sol(:ncol,:, 67) ! rate_const*Op2D*O2 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 52)*sol(:ncol,:, 96) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 88)*sol(:ncol,:, 68) ! rate_const*N2D*O + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 88)*sol(:ncol,:, 69) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 55)*sol(:ncol,:, 61) ! rate_const*N*NO + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 55)*sol(:ncol,:, 62) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 55)*sol(:ncol,:, 62) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 55)*sol(:ncol,:, 62) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 55)*sol(:ncol,:, 69) ! rate_const*N*O2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 62)*sol(:ncol,:, 68) ! rate_const*NO2*O + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 62)*sol(:ncol,:, 70) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 62)*sol(:ncol,:, 68) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 63)*sol(:ncol,:, 87) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 63)*sol(:ncol,:, 61) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 63)*sol(:ncol,:, 68) ! rate_const*NO3*O + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 63)*sol(:ncol,:, 96) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 55)*sol(:ncol,:, 96) ! rate_const*N*OH + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 61)*sol(:ncol,:, 87) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 61)*sol(:ncol,:, 70) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 61)*sol(:ncol,:, 68) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 92)*sol(:ncol,:, 56) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 92)*sol(:ncol,:, 56) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 62)*sol(:ncol,:, 87) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 62)*sol(:ncol,:, 63) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 62)*sol(:ncol,:, 96) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 51)*sol(:ncol,:, 96) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 52) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 57) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 25)*sol(:ncol,:, 17) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 25)*sol(:ncol,:, 23) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 25)*sol(:ncol,:, 41) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 25)*sol(:ncol,:, 43) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 25)*sol(:ncol,:, 87) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 25)*sol(:ncol,:, 87) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 25)*sol(:ncol,:, 70) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 28)*sol(:ncol,:, 21) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 28)*sol(:ncol,:, 87) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 28)*sol(:ncol,:, 61) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 29)*sol(:ncol,:, 25) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 28)*sol(:ncol,:, 62) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 29)*sol(:ncol,:, 68) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 29)*sol(:ncol,:, 96) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 28)*sol(:ncol,:, 68) ! rate_const*CLO*O + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 28)*sol(:ncol,:, 96) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 28)*sol(:ncol,:, 96) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 49)*sol(:ncol,:, 68) ! rate_const*HCL*O + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 49)*sol(:ncol,:, 96) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 54)*sol(:ncol,:, 25) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 54)*sol(:ncol,:, 68) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 54)*sol(:ncol,:, 96) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 92)*sol(:ncol,:, 8) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 92)*sol(:ncol,:, 9) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 92)*sol(:ncol,:, 11) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 92)*sol(:ncol,:, 12) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 92)*sol(:ncol,:, 13) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 92)*sol(:ncol,:, 14) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 92)*sol(:ncol,:, 15) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 92)*sol(:ncol,:, 49) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 92)*sol(:ncol,:, 49) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 27) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 3)*sol(:ncol,:, 17) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 3)*sol(:ncol,:, 87) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 3)*sol(:ncol,:, 70) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 5)*sol(:ncol,:, 5) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 5)*sol(:ncol,:, 28) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 5)*sol(:ncol,:, 28) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 5)*sol(:ncol,:, 28) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 5)*sol(:ncol,:, 87) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 5)*sol(:ncol,:, 61) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 5)*sol(:ncol,:, 62) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 6)*sol(:ncol,:, 68) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 5)*sol(:ncol,:, 68) ! rate_const*BRO*O + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 5)*sol(:ncol,:, 96) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 45)*sol(:ncol,:, 68) ! rate_const*HBR*O + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 45)*sol(:ncol,:, 96) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 53)*sol(:ncol,:, 68) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 92)*sol(:ncol,:, 10) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 92)*sol(:ncol,:, 24) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 92)*sol(:ncol,:, 42) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 92)*sol(:ncol,:, 45) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 92)*sol(:ncol,:, 45) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 39)*sol(:ncol,:, 23) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 39)*sol(:ncol,:, 41) ! rate_const*F*H2 + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 39)*sol(:ncol,:, 100) ! rate_const*F*H2O + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 39)*sol(:ncol,:, 51) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 92)*sol(:ncol,:, 33) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 92)*sol(:ncol,:, 34) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 16)*sol(:ncol,:, 25) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 16)*sol(:ncol,:, 96) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 18)*sol(:ncol,:, 25) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 18)*sol(:ncol,:, 96) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 19)*sol(:ncol,:, 96) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 20)*sol(:ncol,:, 25) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 20)*sol(:ncol,:, 96) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 24)*sol(:ncol,:, 25) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 24)*sol(:ncol,:, 96) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 46)*sol(:ncol,:, 96) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 47)*sol(:ncol,:, 96) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 48)*sol(:ncol,:, 96) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 92)*sol(:ncol,:, 16) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 92)*sol(:ncol,:, 18) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 92)*sol(:ncol,:, 46) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 92)*sol(:ncol,:, 47) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 92)*sol(:ncol,:, 48) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 17)*sol(:ncol,:, 63) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 17)*sol(:ncol,:, 68) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 17)*sol(:ncol,:, 96) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 21)*sol(:ncol,:, 87) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 22)*sol(:ncol,:, 96) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 23)*sol(:ncol,:, 96) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 92)*sol(:ncol,:, 23) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 92)*sol(:ncol,:, 23) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 92)*sol(:ncol,:, 23) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 31)*sol(:ncol,:, 96) ! rate_const*CO*OH + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 35)*sol(:ncol,:, 63) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 35)*sol(:ncol,:, 96) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 72)*sol(:ncol,:, 68) ! rate_const*OCS*O + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 72)*sol(:ncol,:, 96) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 75)*sol(:ncol,:, 69) ! rate_const*S*O2 + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 78)*sol(:ncol,:, 96) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 75)*sol(:ncol,:, 70) ! rate_const*S*O3 + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 77)*sol(:ncol,:, 5) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 77)*sol(:ncol,:, 28) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 75)*sol(:ncol,:, 96) ! rate_const*S*OH + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 77)*sol(:ncol,:, 62) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 77)*sol(:ncol,:, 69) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 77)*sol(:ncol,:, 70) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 77)*sol(:ncol,:, 71) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 77)*sol(:ncol,:, 96) ! rate_const*SO*OH + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 35)*sol(:ncol,:, 96) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 79)*sol(:ncol,:, 100) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 87) ! rate_const*HO2 + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 57) ! rate_const*N2O5 + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 62) ! rate_const*NO2 + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 63) ! rate_const*NO3 + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 57) ! rate_const*N2O5 + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 54)*sol(:ncol,:, 49) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 57) ! rate_const*N2O5 + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 29)*sol(:ncol,:, 49) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 54)*sol(:ncol,:, 49) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 53)*sol(:ncol,:, 49) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 29)*sol(:ncol,:, 49) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 54)*sol(:ncol,:, 49) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 53)*sol(:ncol,:, 49) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 57) ! rate_const*N2O5 + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 29)*sol(:ncol,:, 49) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 99) ! rate_const*Op2P + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 98) ! rate_const*Op2D + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 99) ! rate_const*Op2P + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 90)*sol(:ncol,:, 86) ! rate_const*NOp*e + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 95)*sol(:ncol,:, 86) ! rate_const*O2p*e + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 89)*sol(:ncol,:, 86) ! rate_const*N2p*e + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 89)*sol(:ncol,:, 69) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 89)*sol(:ncol,:, 68) ! rate_const*N2p*O + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 89)*sol(:ncol,:, 68) ! rate_const*N2p*O + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 91)*sol(:ncol,:, 68) ! rate_const*Np*O + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 91)*sol(:ncol,:, 69) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 91)*sol(:ncol,:, 69) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 95)*sol(:ncol,:, 55) ! rate_const*O2p*N + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 95) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 95)*sol(:ncol,:, 61) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 97)*sol(:ncol,:, 32) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 97) ! rate_const*N2*Op + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 97)*sol(:ncol,:, 88) ! rate_const*Op*N2D + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 97)*sol(:ncol,:, 69) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 98)*sol(:ncol,:, 86) ! rate_const*Op2D*e + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 98) ! rate_const*N2*Op2D + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 98)*sol(:ncol,:, 68) ! rate_const*Op2D*O + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 98)*sol(:ncol,:, 69) ! rate_const*Op2D*O2 + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 99)*sol(:ncol,:, 86) ! rate_const*Op2P*e rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 99)*sol(:ncol,:, 86) ! rate_const*Op2P*e - rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 99)*sol(:ncol,:, 86) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 99) ! rate_const*N2*Op2P rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 99) ! rate_const*N2*Op2P - rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 99) ! rate_const*N2*Op2P - rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 99)*sol(:ncol,:, 66) ! rate_const*Op2P*O + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 99)*sol(:ncol,:, 68) ! rate_const*Op2P*O end subroutine set_rates end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_setrxt.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_setrxt.F90 index 325860d61a..feb5e03468 100644 --- a/src/chemistry/pp_waccm_ma_mam4/mo_setrxt.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/mo_setrxt.F90 @@ -54,7 +54,7 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,129) = 7e-13_r8 rate(:,130) = 5e-12_r8 rate(:,139) = 3.5e-12_r8 - rate(:,141) = 1e-11_r8 + rate(:,141) = 1.3e-11_r8 rate(:,142) = 2.2e-11_r8 rate(:,143) = 5e-11_r8 rate(:,178) = 1.7e-13_r8 @@ -79,34 +79,34 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,232) = 1.794e-10_r8 rate(:,233) = 1.3e-10_r8 rate(:,234) = 7.65e-11_r8 - rate(:,243) = 1.31e-10_r8 - rate(:,244) = 3.5e-11_r8 - rate(:,245) = 9e-12_r8 - rate(:,249) = 2.3e-12_r8 - rate(:,250) = 1.2e-11_r8 - rate(:,251) = 5.7e-11_r8 - rate(:,252) = 2.8e-11_r8 - rate(:,253) = 6.6e-11_r8 - rate(:,254) = 1.4e-11_r8 - rate(:,257) = 1.9e-12_r8 - rate(:,285) = 0.047_r8 - rate(:,286) = 7.7e-05_r8 - rate(:,287) = 0.171_r8 - rate(:,291) = 6e-11_r8 - rate(:,294) = 1e-12_r8 - rate(:,295) = 4e-10_r8 - rate(:,296) = 2e-10_r8 - rate(:,297) = 1e-10_r8 - rate(:,298) = 5e-16_r8 - rate(:,299) = 4.4e-10_r8 - rate(:,300) = 9e-10_r8 - rate(:,302) = 1.3e-10_r8 - rate(:,305) = 8e-10_r8 - rate(:,306) = 5e-12_r8 - rate(:,307) = 7e-10_r8 - rate(:,310) = 4.8e-10_r8 - rate(:,311) = 1e-10_r8 - rate(:,312) = 4e-10_r8 + rate(:,242) = 1.31e-10_r8 + rate(:,243) = 3.5e-11_r8 + rate(:,244) = 9e-12_r8 + rate(:,250) = 2.3e-12_r8 + rate(:,252) = 1.2e-11_r8 + rate(:,253) = 5.7e-11_r8 + rate(:,254) = 2.8e-11_r8 + rate(:,255) = 6.6e-11_r8 + rate(:,256) = 1.4e-11_r8 + rate(:,259) = 1.9e-12_r8 + rate(:,284) = 0.047_r8 + rate(:,285) = 7.7e-05_r8 + rate(:,286) = 0.171_r8 + rate(:,290) = 6e-11_r8 + rate(:,293) = 1e-12_r8 + rate(:,294) = 4e-10_r8 + rate(:,295) = 2e-10_r8 + rate(:,296) = 1e-10_r8 + rate(:,297) = 5e-16_r8 + rate(:,298) = 4.4e-10_r8 + rate(:,299) = 9e-10_r8 + rate(:,301) = 1.3e-10_r8 + rate(:,304) = 8e-10_r8 + rate(:,305) = 5e-12_r8 + rate(:,306) = 7e-10_r8 + rate(:,309) = 4.8e-10_r8 + rate(:,310) = 1e-10_r8 + rate(:,311) = 4e-10_r8 do n = 1,pver offset = (n-1)*ncol @@ -136,22 +136,24 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,203) = 1.7e-11_r8 * exp_fac(:) rate(:,123) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) rate(:,124) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) - rate(:,128) = 1.3e-12_r8 * exp( 380._r8 * itemp(:) ) + rate(:,128) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) rate(:,131) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) exp_fac(:) = exp( 220._r8 * itemp(:) ) rate(:,132) = 2.9e-12_r8 * exp_fac(:) rate(:,133) = 1.45e-12_r8 * exp_fac(:) rate(:,134) = 1.45e-12_r8 * exp_fac(:) - rate(:,135) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:,135) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) rate(:,136) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) exp_fac(:) = exp( -2450._r8 * itemp(:) ) rate(:,137) = 1.2e-13_r8 * exp_fac(:) rate(:,163) = 3e-11_r8 * exp_fac(:) - rate(:,140) = 1.5e-11_r8 * exp( 170._r8 * itemp(:) ) - exp_fac(:) = exp( 270._r8 * itemp(:) ) - rate(:,144) = 3.3e-12_r8 * exp_fac(:) - rate(:,159) = 1.4e-11_r8 * exp_fac(:) - rate(:,173) = 7.4e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,140) = 1.7e-11_r8 * exp_fac(:) + rate(:,237) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,144) = 3.44e-12_r8 * exp_fac(:) + rate(:,196) = 2.3e-12_r8 * exp_fac(:) + rate(:,199) = 8.8e-12_r8 * exp_fac(:) exp_fac(:) = exp( -1500._r8 * itemp(:) ) rate(:,145) = 3e-12_r8 * exp_fac(:) rate(:,204) = 5.8e-12_r8 * exp_fac(:) @@ -162,6 +164,9 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,156) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) rate(:,157) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) rate(:,158) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,159) = 1.4e-11_r8 * exp_fac(:) + rate(:,173) = 7.4e-12_r8 * exp_fac(:) rate(:,160) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) rate(:,161) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) rate(:,162) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) @@ -193,9 +198,6 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,192) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) rate(:,193) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) rate(:,195) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) - exp_fac(:) = exp( 260._r8 * itemp(:) ) - rate(:,196) = 2.3e-12_r8 * exp_fac(:) - rate(:,199) = 8.8e-12_r8 * exp_fac(:) rate(:,198) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) rate(:,201) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) rate(:,206) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) @@ -209,41 +211,39 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,232) = 1.794e-10_r8 * exp_fac(:) rate(:,233) = 1.3e-10_r8 * exp_fac(:) rate(:,234) = 7.65e-11_r8 * exp_fac(:) - rate(:,243) = 1.31e-10_r8 * exp_fac(:) - rate(:,244) = 3.5e-11_r8 * exp_fac(:) - rate(:,245) = 9e-12_r8 * exp_fac(:) - rate(:,249) = 2.3e-12_r8 * exp_fac(:) - rate(:,250) = 1.2e-11_r8 * exp_fac(:) - rate(:,251) = 5.7e-11_r8 * exp_fac(:) - rate(:,252) = 2.8e-11_r8 * exp_fac(:) - rate(:,253) = 6.6e-11_r8 * exp_fac(:) - rate(:,254) = 1.4e-11_r8 * exp_fac(:) - rate(:,257) = 1.9e-12_r8 * exp_fac(:) - rate(:,285) = 0.047_r8 * exp_fac(:) - rate(:,286) = 7.7e-05_r8 * exp_fac(:) - rate(:,287) = 0.171_r8 * exp_fac(:) - rate(:,291) = 6e-11_r8 * exp_fac(:) - rate(:,294) = 1e-12_r8 * exp_fac(:) - rate(:,295) = 4e-10_r8 * exp_fac(:) - rate(:,296) = 2e-10_r8 * exp_fac(:) - rate(:,297) = 1e-10_r8 * exp_fac(:) - rate(:,298) = 5e-16_r8 * exp_fac(:) - rate(:,299) = 4.4e-10_r8 * exp_fac(:) - rate(:,300) = 9e-10_r8 * exp_fac(:) - rate(:,302) = 1.3e-10_r8 * exp_fac(:) - rate(:,305) = 8e-10_r8 * exp_fac(:) - rate(:,306) = 5e-12_r8 * exp_fac(:) - rate(:,307) = 7e-10_r8 * exp_fac(:) - rate(:,310) = 4.8e-10_r8 * exp_fac(:) - rate(:,311) = 1e-10_r8 * exp_fac(:) - rate(:,312) = 4e-10_r8 * exp_fac(:) + rate(:,242) = 1.31e-10_r8 * exp_fac(:) + rate(:,243) = 3.5e-11_r8 * exp_fac(:) + rate(:,244) = 9e-12_r8 * exp_fac(:) + rate(:,250) = 2.3e-12_r8 * exp_fac(:) + rate(:,252) = 1.2e-11_r8 * exp_fac(:) + rate(:,253) = 5.7e-11_r8 * exp_fac(:) + rate(:,254) = 2.8e-11_r8 * exp_fac(:) + rate(:,255) = 6.6e-11_r8 * exp_fac(:) + rate(:,256) = 1.4e-11_r8 * exp_fac(:) + rate(:,259) = 1.9e-12_r8 * exp_fac(:) + rate(:,284) = 0.047_r8 * exp_fac(:) + rate(:,285) = 7.7e-05_r8 * exp_fac(:) + rate(:,286) = 0.171_r8 * exp_fac(:) + rate(:,290) = 6e-11_r8 * exp_fac(:) + rate(:,293) = 1e-12_r8 * exp_fac(:) + rate(:,294) = 4e-10_r8 * exp_fac(:) + rate(:,295) = 2e-10_r8 * exp_fac(:) + rate(:,296) = 1e-10_r8 * exp_fac(:) + rate(:,297) = 5e-16_r8 * exp_fac(:) + rate(:,298) = 4.4e-10_r8 * exp_fac(:) + rate(:,299) = 9e-10_r8 * exp_fac(:) + rate(:,301) = 1.3e-10_r8 * exp_fac(:) + rate(:,304) = 8e-10_r8 * exp_fac(:) + rate(:,305) = 5e-12_r8 * exp_fac(:) + rate(:,306) = 7e-10_r8 * exp_fac(:) + rate(:,309) = 4.8e-10_r8 * exp_fac(:) + rate(:,310) = 1e-10_r8 * exp_fac(:) + rate(:,311) = 4e-10_r8 * exp_fac(:) rate(:,215) = 6e-12_r8 * exp( 400._r8 * itemp(:) ) rate(:,220) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) rate(:,221) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) rate(:,222) = 1.64e-12_r8 * exp( -1520._r8 * itemp(:) ) - exp_fac(:) = exp( -1100._r8 * itemp(:) ) - rate(:,223) = 2.03e-11_r8 * exp_fac(:) - rate(:,256) = 3.4e-12_r8 * exp_fac(:) + rate(:,223) = 2.03e-11_r8 * exp( -1110._r8 * itemp(:) ) rate(:,224) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) rate(:,225) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) rate(:,226) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) @@ -253,23 +253,23 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,228) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) rate(:,229) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) rate(:,235) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) - rate(:,237) = 5.5e-12_r8 * exp( 125._r8 * itemp(:) ) rate(:,238) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) rate(:,239) = 2.8e-12_r8 * exp( 300._r8 * itemp(:) ) rate(:,241) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) - rate(:,247) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) - rate(:,248) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) - rate(:,255) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) - rate(:,258) = 2.7e-11_r8 * exp( 335._r8 * itemp(:) ) - rate(:,261) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) - rate(:,262) = 9.6e-12_r8 * exp( -234._r8 * itemp(:) ) + rate(:,246) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,247) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,248) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,249) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,257) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,258) = 3.4e-12_r8 * exp( -1100._r8 * itemp(:) ) + rate(:,260) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) itemp(:) = 300._r8 * itemp(:) n = ncol*pver - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + ko(:) = 5.3e-32_r8 * itemp(:)**1.8_r8 + kinf(:) = 9.5e-11_r8 * itemp(:)**(-0.4_r8) call jpl( rate(:,116), m, 0.6_r8, ko, kinf, n ) ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 @@ -308,9 +308,9 @@ subroutine setrxt( rate, temp, m, ncol ) kinf(:) = 6.9e-12_r8 * itemp(:)**2.9_r8 call jpl( rate(:,200), m, 0.6_r8, ko, kinf, n ) - ko(:) = 5.9e-33_r8 * itemp(:)**1._r8 - kinf(:) = 1.1e-12_r8 * itemp(:)**(-1.3_r8) - call jpl( rate(:,242), 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(:,251), m, 0.6_r8, ko, kinf, n ) end subroutine setrxt @@ -355,22 +355,22 @@ subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) rate(:n,113) = 6.9e-12_r8 rate(:n,129) = 7e-13_r8 rate(:n,130) = 5e-12_r8 - rate(:n,285) = 0.047_r8 - rate(:n,286) = 7.7e-05_r8 - rate(:n,287) = 0.171_r8 - rate(:n,291) = 6e-11_r8 - rate(:n,294) = 1e-12_r8 - rate(:n,295) = 4e-10_r8 - rate(:n,296) = 2e-10_r8 - rate(:n,297) = 1e-10_r8 - rate(:n,299) = 4.4e-10_r8 - rate(:n,302) = 1.3e-10_r8 - rate(:n,305) = 8e-10_r8 - rate(:n,306) = 5e-12_r8 - rate(:n,307) = 7e-10_r8 - rate(:n,310) = 4.8e-10_r8 - rate(:n,311) = 1e-10_r8 - rate(:n,312) = 4e-10_r8 + rate(:n,284) = 0.047_r8 + rate(:n,285) = 7.7e-05_r8 + rate(:n,286) = 0.171_r8 + rate(:n,290) = 6e-11_r8 + rate(:n,293) = 1e-12_r8 + rate(:n,294) = 4e-10_r8 + rate(:n,295) = 2e-10_r8 + rate(:n,296) = 1e-10_r8 + rate(:n,298) = 4.4e-10_r8 + rate(:n,301) = 1.3e-10_r8 + rate(:n,304) = 8e-10_r8 + rate(:n,305) = 5e-12_r8 + rate(:n,306) = 7e-10_r8 + rate(:n,309) = 4.8e-10_r8 + rate(:n,310) = 1e-10_r8 + rate(:n,311) = 4e-10_r8 do k = 1,kbot offset = (k-1)*ncol @@ -392,15 +392,15 @@ subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) rate(:n,123) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) rate(:n,124) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) rate(:n,131) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) - rate(:n,135) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:n,135) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) rate(:n,136) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) - rate(:n,144) = 3.3e-12_r8 * exp( 270._r8 * itemp(:) ) + rate(:n,144) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) rate(:n,145) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) itemp(:) = 300._r8 * itemp(:) - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + 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,116) = wrk(:) diff --git a/src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 b/src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 index 49346ee553..04a88d7f8f 100644 --- a/src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 +++ b/src/chemistry/pp_waccm_ma_mam4/mo_sim_dat.F90 @@ -31,105 +31,107 @@ subroutine set_sim_dat is_scalar = .false. is_vector = .true. - clscnt(:) = (/ 23, 0, 0, 77, 0 /) + clscnt(:) = (/ 0, 0, 0, 100, 0 /) - cls_rxt_cnt(:,1) = (/ 3, 59, 0, 23 /) - cls_rxt_cnt(:,4) = (/ 30, 126, 155, 77 /) + cls_rxt_cnt(:,4) = (/ 8, 112, 191, 100 /) - solsym(:100) = (/ 'bc_a1 ','bc_a4 ','BRCL ','BRO ','BRONO2 ', & - 'BRY ','CCL4 ','CF2CLBR ','CF3BR ','CFC11 ', & - 'CFC113 ','CFC114 ','CFC115 ','CFC12 ','CH2BR2 ', & - 'CH2O ','CH3BR ','CH3CCL3 ','CH3CL ','CH3O2 ', & - 'CH3OOH ','CH4 ','CHBR3 ','CL2 ','CL2O2 ', & - 'CLO ','CLONO2 ','CLY ','CO ','CO2 ', & - 'COF2 ','COFCL ','DMS ','dst_a1 ','dst_a2 ', & - 'dst_a3 ','F ','H ','H2 ','H2402 ', & - 'H2O2 ','H2SO4 ','HBR ','HCFC141B ','HCFC142B ', & - 'HCFC22 ','HCL ','HF ','HNO3 ','HO2NO2 ', & - 'HOBR ','HOCL ','N ','N2O ','N2O5 ', & - 'ncl_a1 ','ncl_a2 ','ncl_a3 ','NO ','NO2 ', & - 'NO3 ','num_a1 ','num_a2 ','num_a3 ','num_a4 ', & - 'O ','O2 ','O3 ','OCLO ','OCS ', & - 'pom_a1 ','pom_a4 ','S ','SF6 ','SO ', & - 'SO2 ','SO3 ','so4_a1 ','so4_a2 ','so4_a3 ', & - 'soa_a1 ','soa_a2 ','SOAG ','BR ','CL ', & + solsym(:100) = (/ 'bc_a1 ','bc_a4 ','BR ','BRCL ','BRO ', & + 'BRONO2 ','BRY ','CCL4 ','CF2CLBR ','CF3BR ', & + 'CFC11 ','CFC113 ','CFC114 ','CFC115 ','CFC12 ', & + 'CH2BR2 ','CH2O ','CH3BR ','CH3CCL3 ','CH3CL ', & + 'CH3O2 ','CH3OOH ','CH4 ','CHBR3 ','CL ', & + 'CL2 ','CL2O2 ','CLO ','CLONO2 ','CLY ', & + 'CO ','CO2 ','COF2 ','COFCL ','DMS ', & + 'dst_a1 ','dst_a2 ','dst_a3 ','F ','H ', & + 'H2 ','H2402 ','H2O2 ','H2SO4 ','HBR ', & + 'HCFC141B ','HCFC142B ','HCFC22 ','HCL ','HF ', & + 'HNO3 ','HO2NO2 ','HOBR ','HOCL ','N ', & + 'N2O ','N2O5 ','ncl_a1 ','ncl_a2 ','ncl_a3 ', & + 'NO ','NO2 ','NO3 ','num_a1 ','num_a2 ', & + 'num_a3 ','num_a4 ','O ','O2 ','O3 ', & + 'OCLO ','OCS ','pom_a1 ','pom_a4 ','S ', & + 'SF6 ','SO ','SO2 ','SO3 ','so4_a1 ', & + 'so4_a2 ','so4_a3 ','soa_a1 ','soa_a2 ','SOAG ', & 'e ','HO2 ','N2D ','N2p ','NOp ', & 'Np ','O1D ','O2_1D ','O2_1S ','O2p ', & 'OH ','Op ','Op2D ','Op2P ','H2O ' /) - adv_mass(:100) = (/ 12.011000_r8, 12.011000_r8, 115.356700_r8, 95.903400_r8, 141.908940_r8, & - 99.716850_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, 50.485900_r8, 47.032000_r8, & - 48.039400_r8, 16.040600_r8, 252.730400_r8, 70.905400_r8, 102.904200_r8, & - 51.452100_r8, 97.457640_r8, 100.916850_r8, 28.010400_r8, 44.009800_r8, & - 66.007206_r8, 82.461503_r8, 62.132400_r8, 135.064039_r8, 135.064039_r8, & - 135.064039_r8, 18.998403_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, 14.006740_r8, 44.012880_r8, 108.010480_r8, & - 58.442468_r8, 58.442468_r8, 58.442468_r8, 30.006140_r8, 46.005540_r8, & - 62.004940_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, & - 15.999400_r8, 31.998800_r8, 47.998200_r8, 67.451500_r8, 60.076400_r8, & - 12.011000_r8, 12.011000_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, & - 12.011000_r8, 12.011000_r8, 12.011000_r8, 79.904000_r8, 35.452700_r8, & + adv_mass(:100) = (/ 12.011000_r8, 12.011000_r8, 79.904000_r8, 115.356700_r8, 95.903400_r8, & + 141.908940_r8, 99.716850_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, 50.485900_r8, & + 47.032000_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, 66.007206_r8, 82.461503_r8, 62.132400_r8, & + 135.064039_r8, 135.064039_r8, 135.064039_r8, 18.998403_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, 14.006740_r8, & + 44.012880_r8, 108.010480_r8, 58.442468_r8, 58.442468_r8, 58.442468_r8, & + 30.006140_r8, 46.005540_r8, 62.004940_r8, 1.007400_r8, 1.007400_r8, & + 1.007400_r8, 1.007400_r8, 15.999400_r8, 31.998800_r8, 47.998200_r8, & + 67.451500_r8, 60.076400_r8, 12.011000_r8, 12.011000_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, 12.011000_r8, 12.011000_r8, 12.011000_r8, & 0.548567E-03_r8, 33.006200_r8, 14.006740_r8, 28.013480_r8, 30.006140_r8, & 14.006740_r8, 15.999400_r8, 31.998800_r8, 31.998800_r8, 31.998800_r8, & 17.006800_r8, 15.999400_r8, 15.999400_r8, 15.999400_r8, 18.014200_r8 /) crb_mass(:100) = (/ 12.011000_r8, 12.011000_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, & - 24.022000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, & - 12.011000_r8, 12.011000_r8, 24.022000_r8, 12.011000_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, 12.011000_r8, 12.011000_r8, 12.011000_r8, & - 12.011000_r8, 12.011000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, & - 0.000000_r8, 0.000000_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, & + 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, 12.011000_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, 12.011000_r8, 12.011000_r8, 24.022000_r8, & 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_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, 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, 0.000000_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, 0.000000_r8, 0.000000_r8, 0.000000_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, 0.000000_r8, 0.000000_r8, & + 0.000000_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, 0.000000_r8, & + 0.000000_r8, 0.000000_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, & 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, 0.000000_r8 /) fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) - clsmap(: 23,1) = (/ 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, & - 17, 18, 19, 22, 23, 28, 30, 40, 44, 45, & - 46, 54, 74 /) - clsmap(: 77,4) = (/ 1, 2, 3, 4, 5, 16, 20, 21, 24, 25, & - 26, 27, 29, 31, 32, 33, 34, 35, 36, 37, & - 38, 39, 41, 42, 43, 47, 48, 49, 50, 51, & - 52, 53, 55, 56, 57, 58, 59, 60, 61, 62, & - 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, & - 73, 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 /) + clsmap(:100,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 /) - permute(: 77,4) = (/ 1, 2, 29, 71, 40, 68, 62, 35, 26, 21, & - 66, 56, 39, 23, 27, 32, 3, 4, 5, 46, & - 59, 70, 41, 22, 49, 61, 28, 57, 36, 45, & - 47, 54, 31, 6, 7, 8, 76, 75, 63, 9, & - 10, 11, 12, 67, 72, 74, 33, 34, 13, 14, & - 43, 58, 55, 30, 15, 16, 17, 18, 19, 20, & - 60, 65, 52, 64, 53, 42, 44, 48, 69, 24, & - 25, 51, 73, 50, 38, 37, 77 /) + permute(:100,4) = (/ 1, 2, 94, 43, 93, 60, 3, 25, 32, 33, & + 27, 34, 28, 35, 29, 55, 84, 61, 30, 52, & + 80, 54, 79, 53, 98, 36, 24, 88, 73, 4, & + 70, 59, 42, 40, 49, 5, 6, 7, 71, 82, & + 99, 26, 62, 31, 67, 39, 41, 46, 83, 47, & + 97, 56, 66, 68, 76, 44, 48, 8, 9, 10, & + 91, 95, 89, 11, 12, 13, 14, 90, 85, 86, & + 50, 51, 15, 16, 64, 17, 81, 72, 45, 18, & + 19, 20, 21, 22, 23, 74, 87, 75, 63, 65, & + 69, 92, 37, 38, 77, 96, 78, 58, 57, 100 /) - diag_map(: 77) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + diag_map(:100) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & - 21, 24, 27, 30, 33, 35, 37, 41, 44, 48, & - 52, 58, 64, 69, 77, 83, 90, 97, 103, 107, & - 115, 122, 131, 138, 144, 153, 162, 170, 178, 189, & - 200, 215, 229, 244, 254, 262, 274, 285, 299, 310, & - 329, 347, 369, 395, 421, 450, 494, 517, 543, 565, & - 592, 624, 662, 685, 714, 738, 764 /) + 21, 22, 23, 24, 27, 30, 34, 38, 42, 46, & + 50, 53, 58, 63, 68, 73, 75, 78, 80, 85, & + 89, 94, 97, 100, 105, 110, 116, 119, 125, 131, & + 136, 144, 152, 158, 164, 171, 178, 185, 193, 199, & + 207, 216, 223, 232, 239, 245, 253, 262, 270, 279, & + 287, 297, 305, 320, 331, 344, 358, 375, 390, 408, & + 422, 436, 450, 472, 505, 526, 552, 581, 607, 650, & + 676, 719, 744, 767, 797, 847, 871, 904, 928, 956 /) extfrc_lst(: 22) = (/ 'so4_a2 ','DMS ','bc_a4 ','num_a1 ','num_a2 ', & 'num_a4 ','pom_a1 ','pom_a4 ','so4_a1 ','CO ', & @@ -145,10 +147,9 @@ subroutine set_sim_dat inv_lst(: 2) = (/ 'M ', 'N2 ' /) - slvd_lst(: 16) = (/ 'BR ', 'CL ', 'e ', 'HO2 ', 'N2D ', & - 'N2p ', 'NOp ', 'Np ', 'O1D ', 'O2_1D ', & - 'O2_1S ', 'O2p ', 'OH ', 'Op ', 'Op2D ', & - 'Op2P ' /) + slvd_lst(: 14) = (/ 'e ', 'HO2 ', 'N2D ', 'N2p ', 'NOp ', & + 'Np ', 'O1D ', 'O2_1D ', 'O2_1S ', 'O2p ', & + 'OH ', 'Op ', 'Op2D ', 'Op2P ' /) if( allocated( rxt_tag_lst ) ) then deallocate( rxt_tag_lst ) @@ -266,7 +267,7 @@ subroutine set_sim_dat 'BRO_CLOa ', 'BRO_CLOb ', & 'BRO_CLOc ', 'BRO_HO2 ', & 'BRO_NO ', 'BRO_NO2_M ' /) - rxt_tag_lst( 201: 312) = (/ 'BRONO2_O ', 'BRO_O ', & + rxt_tag_lst( 201: 311) = (/ 'BRONO2_O ', 'BRO_O ', & 'BRO_OH ', 'HBR_O ', & 'HBR_OH ', 'HOBR_O ', & 'O1D_CF3BR ', 'O1D_CHBR3 ', & @@ -286,42 +287,42 @@ subroutine set_sim_dat 'CH2O_NO3 ', 'CH2O_O ', & 'CH2O_OH ', 'CH3O2_HO2 ', & 'CH3O2_NO ', 'CH3OOH_OH ', & - 'CH4_OH ', 'CO_OH_M ', & - 'O1D_CH4a ', 'O1D_CH4b ', & - 'O1D_CH4c ', 'usr_CO_OH_b ', & - 'OCS_O ', 'OCS_OH ', & - 'S_O2 ', 'S_O3 ', & + 'CH4_OH ', 'O1D_CH4a ', & + 'O1D_CH4b ', 'O1D_CH4c ', & + 'usr_CO_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_SO2_OH ', 'usr_SO3_H2O ', & - 'DMS_NO3 ', 'DMS_OHa ', & - 'usr_DMS_OH ', 'usr_HO2_aer ', & - 'usr_N2O5_aer ', 'usr_NO2_aer ', & - 'usr_NO3_aer ', 'het1 ', & - 'het10 ', 'het11 ', & - 'het12 ', 'het13 ', & - 'het14 ', 'het15 ', & - 'het16 ', 'het17 ', & - 'het2 ', 'het3 ', & - 'het4 ', 'het5 ', & - 'het6 ', 'het7 ', & - 'het8 ', 'het9 ', & - 'ag247nm ', 'ag373nm ', & - 'ag732nm ', 'elec1 ', & - 'elec2 ', 'elec3 ', & - 'ion_N2p_O2 ', 'ion_N2p_Oa ', & - 'ion_N2p_Ob ', 'ion_Np_O ', & - 'ion_Np_O2a ', 'ion_Np_O2b ', & - 'ion_O2p_N ', 'ion_O2p_N2 ', & - 'ion_O2p_NO ', 'ion_Op_CO2 ', & - 'ion_Op_N2 ', 'ion_Op_N2D ', & - 'ion_Op_O2 ', 'Op2D_e ', & - 'Op2D_N2 ', 'Op2D_O ', & - 'Op2D_O2 ', 'Op2P_ea ', & - 'Op2P_eb ', 'Op2P_N2a ', & - 'Op2P_N2b ', 'Op2P_O ' /) + 'usr_DMS_OH ', 'usr_SO3_H2O ', & + 'usr_HO2_aer ', 'usr_N2O5_aer ', & + 'usr_NO2_aer ', 'usr_NO3_aer ', & + 'het1 ', 'het10 ', & + 'het11 ', 'het12 ', & + 'het13 ', 'het14 ', & + 'het15 ', 'het16 ', & + 'het17 ', 'het2 ', & + 'het3 ', 'het4 ', & + 'het5 ', 'het6 ', & + 'het7 ', 'het8 ', & + 'het9 ', 'ag247nm ', & + 'ag373nm ', 'ag732nm ', & + 'elec1 ', 'elec2 ', & + 'elec3 ', 'ion_N2p_O2 ', & + 'ion_N2p_Oa ', 'ion_N2p_Ob ', & + 'ion_Np_O ', 'ion_Np_O2a ', & + 'ion_Np_O2b ', 'ion_O2p_N ', & + 'ion_O2p_N2 ', 'ion_O2p_NO ', & + 'ion_Op_CO2 ', 'ion_Op_N2 ', & + 'ion_Op_N2D ', 'ion_Op_O2 ', & + 'Op2D_e ', 'Op2D_N2 ', & + 'Op2D_O ', 'Op2D_O2 ', & + 'Op2P_ea ', 'Op2P_eb ', & + 'Op2P_N2a ', 'Op2P_N2b ', & + 'Op2P_O ' /) 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, & @@ -353,7 +354,7 @@ subroutine set_sim_dat 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 /) + 311 /) if( allocated( pht_alias_lst ) ) then deallocate( pht_alias_lst ) end if @@ -469,12 +470,12 @@ subroutine set_sim_dat 108, 109, 110, 113, 116, & 117, 118, 119, 122, 123, & 124, 127, 129, 130, 131, & - 135, 136, 144, 145, 285, & - 286, 287, 288, 289, 290, & - 291, 292, 294, 295, 296, & - 297, 299, 301, 302, 303, & - 304, 305, 306, 307, 308, & - 309, 310, 311, 312 /) + 135, 136, 144, 145, 284, & + 285, 286, 287, 288, 289, & + 290, 291, 293, 294, 295, & + 296, 298, 300, 301, 302, & + 303, 304, 305, 306, 307, & + 308, 309, 310, 311 /) cph_enthalpy(:) = (/ 189.810000_r8, 32.910000_r8, 189.810000_r8, 94.300000_r8, 94.300000_r8, & 94.300000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, & 392.190000_r8, 493.580000_r8, 101.390000_r8, 232.590000_r8, 203.400000_r8, & @@ -506,14 +507,13 @@ subroutine set_sim_dat 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, & - 2, 2, 1, 1, 1, 1, 1, 2, 1, 1, & - 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, & - 1, 1, 2, 1, 1, 1, 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, 1, 1, 1, 1, 1, 2, 1, 1, 1, & + 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, & + 1, 2, 1, 1, 1, 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 /) end subroutine set_sim_dat diff --git a/src/chemistry/pp_waccm_ma_mam5/chem_mech.doc b/src/chemistry/pp_waccm_ma_mam5/chem_mech.doc new file mode 100644 index 0000000000..5712d4ca8a --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/chem_mech.doc @@ -0,0 +1,850 @@ + + + Solution species + ( 1) bc_a1 (C) + ( 2) bc_a4 (C) + ( 3) BR (Br) + ( 4) BRCL (BrCl) + ( 5) BRO (BrO) + ( 6) BRONO2 (BrONO2) + ( 7) BRY + ( 8) CCL4 (CCl4) + ( 9) CF2CLBR (CF2ClBr) + ( 10) CF3BR (CF3Br) + ( 11) CFC11 (CFCl3) + ( 12) CFC113 (CCl2FCClF2) + ( 13) CFC114 (CClF2CClF2) + ( 14) CFC115 (CClF2CF3) + ( 15) CFC12 (CF2Cl2) + ( 16) CH2BR2 (CH2Br2) + ( 17) CH2O + ( 18) CH3BR (CH3Br) + ( 19) CH3CCL3 (CH3CCl3) + ( 20) CH3CL (CH3Cl) + ( 21) CH3O2 + ( 22) CH3OOH + ( 23) CH4 + ( 24) CHBR3 (CHBr3) + ( 25) CL (Cl) + ( 26) CL2 (Cl2) + ( 27) CL2O2 (Cl2O2) + ( 28) CLO (ClO) + ( 29) CLONO2 (ClONO2) + ( 30) CLY + ( 31) CO + ( 32) CO2 + ( 33) COF2 + ( 34) COFCL (COFCl) + ( 35) DMS (CH3SCH3) + ( 36) dst_a1 (AlSiO5) + ( 37) dst_a2 (AlSiO5) + ( 38) dst_a3 (AlSiO5) + ( 39) F + ( 40) H + ( 41) H2 + ( 42) H2402 (CBrF2CBrF2) + ( 43) H2O2 + ( 44) H2SO4 (H2SO4) + ( 45) HBR (HBr) + ( 46) HCFC141B (CH3CCl2F) + ( 47) HCFC142B (CH3CClF2) + ( 48) HCFC22 (CHF2Cl) + ( 49) HCL (HCl) + ( 50) HF + ( 51) HNO3 + ( 52) HO2NO2 + ( 53) HOBR (HOBr) + ( 54) HOCL (HOCl) + ( 55) N + ( 56) N2O + ( 57) N2O5 + ( 58) ncl_a1 (NaCl) + ( 59) ncl_a2 (NaCl) + ( 60) ncl_a3 (NaCl) + ( 61) NO + ( 62) NO2 + ( 63) NO3 + ( 64) num_a1 (H) + ( 65) num_a2 (H) + ( 66) num_a3 (H) + ( 67) num_a4 (H) + ( 68) num_a5 (H) + ( 69) O + ( 70) O2 + ( 71) O3 + ( 72) O3S (O3) + ( 73) OCLO (OClO) + ( 74) OCS (OCS) + ( 75) pom_a1 (C) + ( 76) pom_a4 (C) + ( 77) S (S) + ( 78) SF6 + ( 79) SO (SO) + ( 80) SO2 + ( 81) SO3 (SO3) + ( 82) so4_a1 (NH4HSO4) + ( 83) so4_a2 (NH4HSO4) + ( 84) so4_a3 (NH4HSO4) + ( 85) so4_a5 (NH4HSO4) + ( 86) soa_a1 (C) + ( 87) soa_a2 (C) + ( 88) SOAG (C) + ( 89) e (E) + ( 90) HO2 + ( 91) N2D (N) + ( 92) N2p (N2) + ( 93) NOp (NO) + ( 94) Np (N) + ( 95) O1D (O) + ( 96) O2_1D (O2) + ( 97) O2_1S (O2) + ( 98) O2p (O2) + ( 99) OH + (100) Op (O) + (101) Op2D (O) + (102) Op2P (O) + (103) H2O + + + Invariant species + ( 1) M + ( 2) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) O3S + + Implicit + -------- + ( 1) bc_a1 + ( 2) bc_a4 + ( 3) BR + ( 4) BRCL + ( 5) BRO + ( 6) BRONO2 + ( 7) BRY + ( 8) CCL4 + ( 9) CF2CLBR + ( 10) CF3BR + ( 11) CFC11 + ( 12) CFC113 + ( 13) CFC114 + ( 14) CFC115 + ( 15) CFC12 + ( 16) CH2BR2 + ( 17) CH2O + ( 18) CH3BR + ( 19) CH3CCL3 + ( 20) CH3CL + ( 21) CH3O2 + ( 22) CH3OOH + ( 23) CH4 + ( 24) CHBR3 + ( 25) CL + ( 26) CL2 + ( 27) CL2O2 + ( 28) CLO + ( 29) CLONO2 + ( 30) CLY + ( 31) CO + ( 32) CO2 + ( 33) COF2 + ( 34) COFCL + ( 35) DMS + ( 36) dst_a1 + ( 37) dst_a2 + ( 38) dst_a3 + ( 39) F + ( 40) H + ( 41) H2 + ( 42) H2402 + ( 43) H2O2 + ( 44) H2SO4 + ( 45) HBR + ( 46) HCFC141B + ( 47) HCFC142B + ( 48) HCFC22 + ( 49) HCL + ( 50) HF + ( 51) HNO3 + ( 52) HO2NO2 + ( 53) HOBR + ( 54) HOCL + ( 55) N + ( 56) N2O + ( 57) N2O5 + ( 58) ncl_a1 + ( 59) ncl_a2 + ( 60) ncl_a3 + ( 61) NO + ( 62) NO2 + ( 63) NO3 + ( 64) num_a1 + ( 65) num_a2 + ( 66) num_a3 + ( 67) num_a4 + ( 68) num_a5 + ( 69) O + ( 70) O2 + ( 71) O3 + ( 72) OCLO + ( 73) OCS + ( 74) pom_a1 + ( 75) pom_a4 + ( 76) S + ( 77) SF6 + ( 78) SO + ( 79) SO2 + ( 80) SO3 + ( 81) so4_a1 + ( 82) so4_a2 + ( 83) so4_a3 + ( 84) so4_a5 + ( 85) soa_a1 + ( 86) soa_a2 + ( 87) SOAG + ( 88) e + ( 89) HO2 + ( 90) N2D + ( 91) N2p + ( 92) NOp + ( 93) Np + ( 94) O1D + ( 95) O2_1D + ( 96) O2_1S + ( 97) O2p + ( 98) OH + ( 99) Op + (100) Op2D + (101) Op2P + (102) H2O + + Photolysis + jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) + jh2o_c ( 2) H2O + hv -> 2*H + O rate = ** User defined ** ( 2) + jh2o_a ( 3) H2O + hv -> OH + H rate = ** User defined ** ( 3) + jh2o2 ( 4) H2O2 + hv -> 2*OH rate = ** User defined ** ( 4) + jo2_b ( 5) O2 + hv -> 2*O rate = ** User defined ** ( 5) + jo2_a ( 6) O2 + hv -> O + O1D rate = ** User defined ** ( 6) + jo3_a ( 7) O3 + hv -> O1D + O2_1D 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) + jno_i ( 16) NO + hv -> NOp + e rate = ** User defined ** ( 16) + jno2 ( 17) NO2 + hv -> NO + O rate = ** User defined ** ( 17) + jno3_a ( 18) NO3 + hv -> NO2 + O rate = ** User defined ** ( 18) + jno3_b ( 19) NO3 + hv -> NO + O2 rate = ** User defined ** ( 19) + jch2o_a ( 20) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 20) + jch2o_b ( 21) CH2O + hv -> CO + H2 rate = ** User defined ** ( 21) + jch3ooh ( 22) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 22) + jch4_a ( 23) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 23) + jch4_b ( 24) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 24) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jco2 ( 25) CO2 + hv -> CO + O rate = ** User defined ** ( 25) + jbrcl ( 26) BRCL + hv -> BR + CL rate = ** User defined ** ( 26) + jbro ( 27) BRO + hv -> BR + O rate = ** User defined ** ( 27) + jbrono2_b ( 28) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 28) + jbrono2_a ( 29) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 29) + jccl4 ( 30) CCL4 + hv -> 4*CL rate = ** User defined ** ( 30) + jcf2clbr ( 31) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 31) + jcf3br ( 32) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 32) + jcfcl3 ( 33) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 33) + jcfc113 ( 34) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 34) + jcfc114 ( 35) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 35) + jcfc115 ( 36) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 36) + jcf2cl2 ( 37) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 37) + jch2br2 ( 38) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 38) + jch3br ( 39) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 39) + jch3ccl3 ( 40) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 40) + jch3cl ( 41) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 41) + jchbr3 ( 42) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 42) + jcl2 ( 43) CL2 + hv -> 2*CL rate = ** User defined ** ( 43) + jcl2o2 ( 44) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 44) + jclo ( 45) CLO + hv -> CL + O rate = ** User defined ** ( 45) + jclono2_a ( 46) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 46) + jclono2_b ( 47) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 47) + jcof2 ( 48) COF2 + hv -> 2*F rate = ** User defined ** ( 48) + jcofcl ( 49) COFCL + hv -> F + CL rate = ** User defined ** ( 49) + jh2402 ( 50) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 50) + jhbr ( 51) HBR + hv -> BR + H rate = ** User defined ** ( 51) + jhcfc141b ( 52) HCFC141B + hv -> CL + COFCL rate = ** User defined ** ( 52) + jhcfc142b ( 53) HCFC142B + hv -> CL + COF2 rate = ** User defined ** ( 53) + jhcfc22 ( 54) HCFC22 + hv -> CL + COF2 rate = ** User defined ** ( 54) + jhcl ( 55) HCL + hv -> H + CL rate = ** User defined ** ( 55) + jhf ( 56) HF + hv -> H + F rate = ** User defined ** ( 56) + jhobr ( 57) HOBR + hv -> BR + OH rate = ** User defined ** ( 57) + jhocl ( 58) HOCL + hv -> OH + CL rate = ** User defined ** ( 58) + joclo ( 59) OCLO + hv -> O + CLO rate = ** User defined ** ( 59) + jsf6 ( 60) SF6 + hv -> {sink} rate = ** User defined ** ( 60) + jeuv_26 ( 61) CO2 + hv -> CO + O rate = ** User defined ** ( 61) + jeuv_4 ( 62) N + hv -> Np + e rate = ** User defined ** ( 62) + jeuv_6 ( 63) N2 + hv -> N2p + e rate = ** User defined ** ( 63) + jeuv_22 ( 64) N2 + hv -> N + Np + e rate = ** User defined ** ( 64) + jeuv_23 ( 65) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 65) + jeuv_25 ( 66) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** ( 66) + jeuv_18 ( 67) N2 + hv -> N2p + e rate = ** User defined ** ( 67) + jeuv_13 ( 68) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** ( 68) + jeuv_11 ( 69) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 69) + jeuv_10 ( 70) N2 + hv -> N + Np + e rate = ** User defined ** ( 70) + jeuv_3 ( 71) O + hv -> Op2P + e rate = ** User defined ** ( 71) + jeuv_16 ( 72) O + hv -> Op2P + e rate = ** User defined ** ( 72) + jeuv_1 ( 73) O + hv -> Op + e rate = ** User defined ** ( 73) + jeuv_14 ( 74) O + hv -> Op + e rate = ** User defined ** ( 74) + jeuv_2 ( 75) O + hv -> Op2D + e rate = ** User defined ** ( 75) + jeuv_15 ( 76) O + hv -> Op2D + e rate = ** User defined ** ( 76) + jeuv_21 ( 77) O2 + hv -> O + Op2P + e rate = ** User defined ** ( 77) + jeuv_17 ( 78) O2 + hv -> O2p + e rate = ** User defined ** ( 78) + jeuv_7 ( 79) O2 + hv -> O + Op + e rate = ** User defined ** ( 79) + jeuv_5 ( 80) O2 + hv -> O2p + e rate = ** User defined ** ( 80) + jeuv_19 ( 81) O2 + hv -> O + Op + e rate = ** User defined ** ( 81) + jeuv_24 ( 82) O2 + hv -> 2*O rate = ** User defined ** ( 82) + jeuv_12 ( 83) O2 + hv -> 2*O rate = ** User defined ** ( 83) + jeuv_9 ( 84) O2 + hv -> O + Op2P + e rate = ** User defined ** ( 84) + jeuv_8 ( 85) O2 + hv -> O + Op2D + e rate = ** User defined ** ( 85) + jeuv_20 ( 86) O2 + hv -> O + Op2D + e rate = ** User defined ** ( 86) + jh2so4 ( 87) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** ( 87) + jocs ( 88) OCS + hv -> S + CO rate = ** User defined ** ( 88) + jso ( 89) SO + hv -> S + O rate = ** User defined ** ( 89) + jso2 ( 90) SO2 + hv -> SO + O rate = ** User defined ** ( 90) + jso3 ( 91) SO3 + hv -> SO2 + O rate = ** User defined ** ( 91) + + Reactions + ag1 ( 1) O2_1D -> O2 rate = 2.58E-04 ( 92) + ag2 ( 2) O2_1S -> O2 rate = 8.50E-02 ( 93) + O1D_H2 ( 3) O1D + H2 -> H + OH rate = 1.20E-10 ( 94) + O1D_H2O ( 4) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) ( 95) + O1D_N2 ( 5) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) ( 96) + O1D_O2 ( 6) O1D + O2 -> O + O2_1S rate = 2.64E-11*exp( 55./t) ( 97) + O1D_O2b ( 7) O1D + O2 -> O + O2 rate = 6.60E-12*exp( 55./t) ( 98) + O1D_O3 ( 8) O1D + O3 -> O2 + O2 rate = 1.20E-10 ( 99) + O2_1D_N2 ( 9) O2_1D + N2 -> O2 + N2 rate = 1.00E-20 (100) + O2_1D_O ( 10) O2_1D + O -> O2 + O rate = 1.30E-16 (101) + O2_1D_O2 ( 11) O2_1D + O2 -> 2*O2 rate = 3.60E-18*exp( -220./t) (102) + O2_1S_CO2 ( 12) O2_1S + CO2 -> O2_1D + CO2 rate = 4.20E-13 (103) + O2_1S_N2 ( 13) O2_1S + N2 -> O2_1D + N2 rate = 1.80E-15*exp( 45./t) (104) + O2_1S_O ( 14) O2_1S + O -> O2_1D + O rate = 8.00E-14 (105) + O2_1S_O2 ( 15) O2_1S + O2 -> O2_1D + O2 rate = 3.90E-17 (106) + O2_1S_O3 ( 16) O2_1S + O3 -> O2_1D + O3 rate = 3.50E-11*exp( -135./t) (107) + O_O3 ( 17) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (108) + usr_O_O ( 18) O + O + M -> O2 + M rate = ** User defined ** (109) + usr_O_O2 ( 19) O + O2 + M -> O3 + M rate = ** User defined ** (110) + H2_O ( 20) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (111) + H2O2_O ( 21) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (112) + H_HO2 ( 22) H + HO2 -> H2 + O2 rate = 6.90E-12 (113) + H_HO2a ( 23) H + HO2 -> 2*OH rate = 7.20E-11 (114) + H_HO2b ( 24) H + HO2 -> H2O + O rate = 1.60E-12 (115) + H_O2 ( 25) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (116) + ki=9.50E-11*(300/t)**-0.40 + f=0.60 + HO2_O ( 26) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (117) + HO2_O3 ( 27) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (118) + H_O3 ( 28) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (119) + OH_H2 ( 29) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (120) + OH_H2O2 ( 30) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (121) + OH_HO2 ( 31) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (122) + OH_O ( 32) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (123) + OH_O3 ( 33) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (124) + OH_OH ( 34) OH + OH -> H2O + O rate = 1.80E-12 (125) + OH_OH_M ( 35) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (126) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 ( 36) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (127) + HO2NO2_OH ( 37) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (128) + N2D_O ( 38) N2D + O -> N + O rate = 7.00E-13 (129) + N2D_O2 ( 39) N2D + O2 -> NO + O1D rate = 5.00E-12 (130) + N_NO ( 40) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (131) + N_NO2a ( 41) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (132) + N_NO2b ( 42) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (133) + N_NO2c ( 43) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (134) + N_O2 ( 44) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (135) + NO2_O ( 45) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (136) + NO2_O3 ( 46) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (137) + NO2_O_M ( 47) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (138) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 ( 48) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (139) + NO3_NO ( 49) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (140) + NO3_O ( 50) NO3 + O -> NO2 + O2 rate = 1.30E-11 (141) + NO3_OH ( 51) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (142) + N_OH ( 52) N + OH -> NO + H rate = 5.00E-11 (143) + NO_HO2 ( 53) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (144) + NO_O3 ( 54) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (145) + NO_O_M ( 55) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (146) + ki=3.00E-11 + f=0.60 + O1D_N2Oa ( 56) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (147) + O1D_N2Ob ( 57) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (148) + tag_NO2_HO2 ( 58) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (149) + ki=4.00E-12*(300/t)**0.30 + f=0.60 + tag_NO2_NO3 ( 59) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (150) + ki=1.60E-12*(300/t)**-0.10 + f=0.60 + tag_NO2_OH ( 60) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (151) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 61) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (152) + usr_HO2NO2_M ( 62) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (153) + usr_N2O5_M ( 63) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (154) + CL_CH2O ( 64) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (155) + CL_CH4 ( 65) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (156) + CL_H2 ( 66) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (157) + CL_H2O2 ( 67) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (158) + CL_HO2a ( 68) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (159) + CL_HO2b ( 69) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (160) + CL_O3 ( 70) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (161) + CLO_CH3O2 ( 71) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (162) + CLO_CLOa ( 72) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (163) + CLO_CLOb ( 73) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (164) + CLO_CLOc ( 74) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (165) + CLO_HO2 ( 75) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (166) + CLO_NO ( 76) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (167) + CLONO2_CL ( 77) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (168) + CLO_NO2_M ( 78) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (169) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLONO2_O ( 79) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (170) + CLONO2_OH ( 80) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (171) + CLO_O ( 81) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (172) + CLO_OHa ( 82) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (173) + CLO_OHb ( 83) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (174) + HCL_O ( 84) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (175) + HCL_OH ( 85) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (176) + HOCL_CL ( 86) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (177) + HOCL_O ( 87) HOCL + O -> CLO + OH rate = 1.70E-13 (178) + HOCL_OH ( 88) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (179) + O1D_CCL4 ( 89) O1D + CCL4 -> 4*CL rate = 2.61E-10 (180) + O1D_CF2CLBR ( 90) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (181) + O1D_CFC11 ( 91) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (182) + O1D_CFC113 ( 92) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (183) + O1D_CFC114 ( 93) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (184) + O1D_CFC115 ( 94) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (185) + O1D_CFC12 ( 95) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (186) + O1D_HCLa ( 96) O1D + HCL -> CL + OH rate = 9.90E-11 (187) + O1D_HCLb ( 97) O1D + HCL -> CLO + H rate = 3.30E-12 (188) + tag_CLO_CLO_M ( 98) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (189) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M ( 99) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (190) + BR_CH2O (100) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (191) + BR_HO2 (101) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (192) + BR_O3 (102) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (193) + BRO_BRO (103) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (194) + BRO_CLOa (104) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (195) + BRO_CLOb (105) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (196) + BRO_CLOc (106) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (197) + BRO_HO2 (107) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (198) + BRO_NO (108) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (199) + BRO_NO2_M (109) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (200) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRONO2_O (110) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (201) + BRO_O (111) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (202) + BRO_OH (112) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (203) + HBR_O (113) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (204) + HBR_OH (114) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (205) + HOBR_O (115) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (206) + O1D_CF3BR (116) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (207) + O1D_CHBR3 (117) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (208) + O1D_H2402 (118) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (209) + O1D_HBRa (119) O1D + HBR -> BR + OH rate = 9.00E-11 (210) + O1D_HBRb (120) O1D + HBR -> BRO + H rate = 3.00E-11 (211) + F_CH4 (121) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (212) + F_H2 (122) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (213) + F_H2O (123) F + H2O -> HF + OH rate = 1.40E-11 (214) + F_HNO3 (124) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (215) + O1D_COF2 (125) O1D + COF2 -> 2*F rate = 2.14E-11 (216) + O1D_COFCL (126) O1D + COFCL -> F + CL rate = 1.90E-10 (217) + CH2BR2_CL (127) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (218) + CH2BR2_OH (128) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (219) + CH3BR_CL (129) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (220) + CH3BR_OH (130) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (221) + CH3CCL3_OH (131) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (222) + CH3CL_CL (132) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1110./t) (223) + CH3CL_OH (133) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (224) + CHBR3_CL (134) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (225) + CHBR3_OH (135) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (226) + HCFC141B_OH (136) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (227) + HCFC142B_OH (137) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (228) + HCFC22_OH (138) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (229) + O1D_CH2BR2 (139) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (230) + O1D_CH3BR (140) O1D + CH3BR -> BR rate = 1.80E-10 (231) + O1D_HCFC141B (141) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (232) + O1D_HCFC142B (142) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (233) + O1D_HCFC22 (143) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (234) + CH2O_NO3 (144) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (235) + CH2O_O (145) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (236) + CH2O_OH (146) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (237) + CH3O2_HO2 (147) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (238) + CH3O2_NO (148) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (239) + CH3OOH_OH (149) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (240) + CH4_OH (150) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (241) + O1D_CH4a (151) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (242) + O1D_CH4b (152) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (243) + O1D_CH4c (153) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (244) + usr_CO_OH (154) CO + OH -> CO2 + HO2 rate = ** User defined ** (245) + DMS_NO3 (155) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (246) + DMS_OHa (156) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (247) + OCS_O (157) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (248) + OCS_OH (158) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (249) + S_O2 (159) S + O2 -> SO + O rate = 2.30E-12 (250) + SO2_OH_M (160) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (251) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + S_O3 (161) S + O3 -> SO + O2 rate = 1.20E-11 (252) + SO_BRO (162) SO + BRO -> SO2 + BR rate = 5.70E-11 (253) + SO_CLO (163) SO + CLO -> SO2 + CL rate = 2.80E-11 (254) + S_OH (164) S + OH -> SO + H rate = 6.60E-11 (255) + SO_NO2 (165) SO + NO2 -> SO2 + NO rate = 1.40E-11 (256) + SO_O2 (166) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (257) + SO_O3 (167) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (258) + SO_OCLO (168) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (259) + SO_OH (169) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (260) + usr_DMS_OH (170) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (261) + usr_SO3_H2O (171) SO3 + H2O -> H2SO4 rate = ** User defined ** (262) + usr_HO2_aer (172) HO2 -> 0.5*H2O2 rate = ** User defined ** (263) + usr_N2O5_aer (173) N2O5 -> 2*HNO3 rate = ** User defined ** (264) + usr_NO2_aer (174) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (265) + usr_NO3_aer (175) NO3 -> HNO3 rate = ** User defined ** (266) + het1 (176) N2O5 -> 2*HNO3 rate = ** User defined ** (267) + het10 (177) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (268) + het11 (178) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (269) + het12 (179) N2O5 -> 2*HNO3 rate = ** User defined ** (270) + het13 (180) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (271) + het14 (181) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (272) + het15 (182) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (273) + het16 (183) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (274) + het17 (184) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (275) + het2 (185) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (276) + het3 (186) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (277) + het4 (187) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (278) + het5 (188) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (279) + het6 (189) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (280) + het7 (190) N2O5 -> 2*HNO3 rate = ** User defined ** (281) + het8 (191) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (282) + het9 (192) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (283) + ag247nm (193) Op2P -> Op rate = 4.70E-02 (284) + ag373nm (194) Op2D -> Op rate = 7.70E-05 (285) + ag732nm (195) Op2P -> Op2D rate = 1.71E-01 (286) + elec1 (196) NOp + e -> 0.2*N + 0.8*N2D + O rate = ** User defined ** (287) + elec2 (197) O2p + e -> 1.15*O + 0.85*O1D rate = ** User defined ** (288) + elec3 (198) N2p + e -> 1.1*N + 0.9*N2D rate = ** User defined ** (289) + ion_N2p_O2 (199) N2p + O2 -> O2p + N2 rate = 6.00E-11 (290) + ion_N2p_Oa (200) N2p + O -> NOp + N2D rate = ** User defined ** (291) + ion_N2p_Ob (201) N2p + O -> Op + N2 rate = ** User defined ** (292) + ion_Np_O (202) Np + O -> Op + N rate = 1.00E-12 (293) + ion_Np_O2a (203) Np + O2 -> O2p + N rate = 4.00E-10 (294) + ion_Np_O2b (204) Np + O2 -> NOp + O rate = 2.00E-10 (295) + ion_O2p_N (205) O2p + N -> NOp + O rate = 1.00E-10 (296) + ion_O2p_N2 (206) O2p + N2 -> NOp + NO rate = 5.00E-16 (297) + ion_O2p_NO (207) O2p + NO -> NOp + O2 rate = 4.40E-10 (298) + ion_Op_CO2 (208) Op + CO2 -> O2p + CO rate = 9.00E-10 (299) + ion_Op_N2 (209) Op + N2 -> NOp + N rate = ** User defined ** (300) + ion_Op_N2D (210) Op + N2D -> Np + O rate = 1.30E-10 (301) + ion_Op_O2 (211) Op + O2 -> O2p + O rate = ** User defined ** (302) + Op2D_e (212) Op2D + e -> Op + e rate = ** User defined ** (303) + Op2D_N2 (213) Op2D + N2 -> N2p + O rate = 8.00E-10 (304) + Op2D_O (214) Op2D + O -> Op + O rate = 5.00E-12 (305) + Op2D_O2 (215) Op2D + O2 -> O2p + O rate = 7.00E-10 (306) + Op2P_ea (216) Op2P + e -> Op2D + e rate = ** User defined ** (307) + Op2P_eb (217) Op2P + e -> Op + e rate = ** User defined ** (308) + Op2P_N2a (218) Op2P + N2 -> N2p + O rate = 4.80E-10 (309) + Op2P_N2b (219) Op2P + N2 -> Np + NO rate = 1.00E-10 (310) + Op2P_O (220) Op2P + O -> Op + O rate = 4.00E-10 (311) + +Extraneous prod/loss species + ( 1) so4_a2 (dataset) + ( 2) DMS (dataset) + ( 3) bc_a4 (dataset) + ( 4) num_a1 (dataset) + ( 5) num_a2 (dataset) + ( 6) num_a4 (dataset) + ( 7) num_a5 (dataset) + ( 8) pom_a1 (dataset) + ( 9) pom_a4 (dataset) + (10) so4_a1 (dataset) + (11) so4_a5 (dataset) + (12) CO (dataset) + (13) NO (dataset) + (14) NO2 (dataset) + (15) SO2 (dataset) + (16) bc_a1 (dataset) + (17) N + (18) N2D + (19) N2p + (20) Op + (21) e + (22) Np + (23) O2p + (24) OH + + + Equation Report + + d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(BR)/dt = j26*BRCL + j27*BRO + j29*BRONO2 + j31*CF2CLBR + j32*CF3BR + 2*j38*CH2BR2 + j39*CH3BR + + 3*j42*CHBR3 + 2*j50*H2402 + j51*HBR + j57*HOBR + r90*O1D*CF2CLBR + 2*r103*BRO*BRO + + r104*BRO*CLO + r105*BRO*CLO + r108*BRO*NO + r111*BRO*O + r112*BRO*OH + r113*HBR*O + + r114*HBR*OH + r116*O1D*CF3BR + 3*r117*O1D*CHBR3 + 2*r118*O1D*H2402 + r119*O1D*HBR + + 2*r127*CH2BR2*CL + 2*r128*CH2BR2*OH + r129*CH3BR*CL + r130*CH3BR*OH + 3*r134*CHBR3*CL + + 3*r135*CHBR3*OH + 2*r139*O1D*CH2BR2 + r140*O1D*CH3BR + r162*SO*BRO + - r100*CH2O*BR - r101*HO2*BR - r102*O3*BR + d(BRCL)/dt = r106*BRO*CLO + r184*HOBR*HCL + r189*HOBR*HCL + - j26*BRCL + d(BRO)/dt = j28*BRONO2 + r102*BR*O3 + r110*BRONO2*O + r115*HOBR*O + r120*O1D*HBR + - j27*BRO - 2*r103*BRO*BRO - r104*CLO*BRO - r105*CLO*BRO - r106*CLO*BRO - r107*HO2*BRO + - r108*NO*BRO - r109*M*NO2*BRO - r111*O*BRO - r112*OH*BRO - r162*SO*BRO + d(BRONO2)/dt = r109*M*BRO*NO2 + - j28*BRONO2 - j29*BRONO2 - r178*BRONO2 - r181*BRONO2 - r186*BRONO2 - r110*O*BRONO2 + d(BRY)/dt = 0 + d(CCL4)/dt = - j30*CCL4 - r89*O1D*CCL4 + d(CF2CLBR)/dt = - j31*CF2CLBR - r90*O1D*CF2CLBR + d(CF3BR)/dt = - j32*CF3BR - r116*O1D*CF3BR + d(CFC11)/dt = - j33*CFC11 - r91*O1D*CFC11 + d(CFC113)/dt = - j34*CFC113 - r92*O1D*CFC113 + d(CFC114)/dt = - j35*CFC114 - r93*O1D*CFC114 + d(CFC115)/dt = - j36*CFC115 - r94*O1D*CFC115 + d(CFC12)/dt = - j37*CFC12 - r95*O1D*CFC12 + d(CH2BR2)/dt = - j38*CH2BR2 - r127*CL*CH2BR2 - r128*OH*CH2BR2 - r139*O1D*CH2BR2 + d(CH2O)/dt = j22*CH3OOH + .18*j24*CH4 + r71*CLO*CH3O2 + r148*CH3O2*NO + .3*r149*CH3OOH*OH + r152*O1D*CH4 + + r153*O1D*CH4 + - j20*CH2O - j21*CH2O - r64*CL*CH2O - r100*BR*CH2O - r144*NO3*CH2O - r145*O*CH2O + - r146*OH*CH2O + d(CH3BR)/dt = - j39*CH3BR - r129*CL*CH3BR - r130*OH*CH3BR - r140*O1D*CH3BR + d(CH3CCL3)/dt = - j40*CH3CCL3 - r131*OH*CH3CCL3 + d(CH3CL)/dt = - j41*CH3CL - r132*CL*CH3CL - r133*OH*CH3CL + d(CH3O2)/dt = j23*CH4 + j39*CH3BR + j41*CH3CL + r65*CL*CH4 + r121*F*CH4 + .7*r149*CH3OOH*OH + r150*CH4*OH + + r151*O1D*CH4 + - r71*CLO*CH3O2 - r147*HO2*CH3O2 - r148*NO*CH3O2 + d(CH3OOH)/dt = r147*CH3O2*HO2 + - j22*CH3OOH - r149*OH*CH3OOH + d(CH4)/dt = - j23*CH4 - j24*CH4 - r65*CL*CH4 - r121*F*CH4 - r150*OH*CH4 - r151*O1D*CH4 - r152*O1D*CH4 + - r153*O1D*CH4 + d(CHBR3)/dt = - j42*CHBR3 - r117*O1D*CHBR3 - r134*CL*CHBR3 - r135*OH*CHBR3 + d(CL)/dt = j26*BRCL + 4*j30*CCL4 + j31*CF2CLBR + 2*j33*CFC11 + 2*j34*CFC113 + 2*j35*CFC114 + j36*CFC115 + + 2*j37*CFC12 + 3*j40*CH3CCL3 + j41*CH3CL + 2*j43*CL2 + 2*j44*CL2O2 + j45*CLO + j46*CLONO2 + + j49*COFCL + j52*HCFC141B + j53*HCFC142B + j54*HCFC22 + j55*HCL + j58*HOCL + r71*CLO*CH3O2 + + 2*r72*CLO*CLO + r74*CLO*CLO + r76*CLO*NO + r81*CLO*O + r82*CLO*OH + r84*HCL*O + r85*HCL*OH + + 4*r89*O1D*CCL4 + r90*O1D*CF2CLBR + 2*r91*O1D*CFC11 + 2*r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + r94*O1D*CFC115 + 2*r95*O1D*CFC12 + r96*O1D*HCL + r105*BRO*CLO + r126*O1D*COFCL + + 3*r131*CH3CCL3*OH + r133*CH3CL*OH + r136*HCFC141B*OH + r137*HCFC142B*OH + r138*HCFC22*OH + + r141*O1D*HCFC141B + r142*O1D*HCFC142B + r143*O1D*HCFC22 + r163*SO*CLO + - r64*CH2O*CL - r65*CH4*CL - r66*H2*CL - r67*H2O2*CL - r68*HO2*CL - r69*HO2*CL - r70*O3*CL + - r77*CLONO2*CL - r86*HOCL*CL - r127*CH2BR2*CL - r129*CH3BR*CL - r132*CH3CL*CL - r134*CHBR3*CL + d(CL2)/dt = r73*CLO*CLO + r77*CLONO2*CL + r177*HOCL*HCL + r182*CLONO2*HCL + r183*HOCL*HCL + r187*CLONO2*HCL + + r188*HOCL*HCL + r192*CLONO2*HCL + - j43*CL2 + d(CL2O2)/dt = r98*M*CLO*CLO + - j44*CL2O2 - r99*M*CL2O2 + d(CLO)/dt = j47*CLONO2 + j59*OCLO + r99*M*CL2O2 + r99*M*CL2O2 + r69*CL*HO2 + r70*CL*O3 + r79*CLONO2*O + + r86*HOCL*CL + r87*HOCL*O + r88*HOCL*OH + r97*O1D*HCL + r168*SO*OCLO + - j45*CLO - r71*CH3O2*CLO - 2*r72*CLO*CLO - 2*r73*CLO*CLO - 2*r74*CLO*CLO - r75*HO2*CLO + - r76*NO*CLO - r78*M*NO2*CLO - r81*O*CLO - r82*OH*CLO - r83*OH*CLO - 2*r98*M*CLO*CLO + - r104*BRO*CLO - r105*BRO*CLO - r106*BRO*CLO - r163*SO*CLO + d(CLONO2)/dt = r78*M*CLO*NO2 + - j46*CLONO2 - j47*CLONO2 - r180*CLONO2 - r185*CLONO2 - r191*CLONO2 - r77*CL*CLONO2 + - r79*O*CLONO2 - r80*OH*CLONO2 - r182*HCL*CLONO2 - r187*HCL*CLONO2 - r192*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = j20*CH2O + j21*CH2O + .38*j24*CH4 + j25*CO2 + j61*CO2 + j88*OCS + r64*CL*CH2O + r100*BR*CH2O + + r132*CH3CL*CL + r144*CH2O*NO3 + r145*CH2O*O + r146*CH2O*OH + r157*OCS*O + r158*OCS*OH + + r208*Op*CO2 + - r154*OH*CO + d(CO2)/dt = .44*j24*CH4 + r154*CO*OH + - j25*CO2 - j61*CO2 - r208*Op*CO2 + d(COF2)/dt = j31*CF2CLBR + j32*CF3BR + j34*CFC113 + 2*j35*CFC114 + 2*j36*CFC115 + j37*CFC12 + 2*j50*H2402 + + j53*HCFC142B + j54*HCFC22 + r90*O1D*CF2CLBR + r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + 2*r94*O1D*CFC115 + r95*O1D*CFC12 + r116*O1D*CF3BR + 2*r118*O1D*H2402 + r137*HCFC142B*OH + + r138*HCFC22*OH + r142*O1D*HCFC142B + r143*O1D*HCFC22 + - j48*COF2 - r125*O1D*COF2 + d(COFCL)/dt = j33*CFC11 + j34*CFC113 + j52*HCFC141B + r91*O1D*CFC11 + r92*O1D*CFC113 + r136*HCFC141B*OH + + r141*O1D*HCFC141B + - j49*COFCL - r126*O1D*COFCL + d(DMS)/dt = - r155*NO3*DMS - r156*OH*DMS - r170*OH*DMS + d(dst_a1)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(F)/dt = j32*CF3BR + j36*CFC115 + 2*j48*COF2 + j49*COFCL + j56*HF + r94*O1D*CFC115 + r116*O1D*CF3BR + + 2*r125*O1D*COF2 + r126*O1D*COFCL + - r121*CH4*F - r122*H2*F - r123*H2O*F - r124*HNO3*F + d(H)/dt = 2*j2*H2O + j3*H2O + 2*j20*CH2O + j22*CH3OOH + j23*CH4 + .33*j24*CH4 + j51*HBR + j55*HCL + j56*HF + + r3*O1D*H2 + r20*H2*O + r29*OH*H2 + r32*OH*O + r52*N*OH + r66*CL*H2 + r97*O1D*HCL + + r120*O1D*HBR + r122*F*H2 + r146*CH2O*OH + r152*O1D*CH4 + r158*OCS*OH + r164*S*OH + r169*SO*OH + - r22*HO2*H - r23*HO2*H - r24*HO2*H - r25*M*O2*H - r28*O3*H + d(H2)/dt = j1*H2O + j21*CH2O + 1.4400001*j24*CH4 + r22*H*HO2 + r153*O1D*CH4 + - r3*O1D*H2 - r20*O*H2 - r29*OH*H2 - r66*CL*H2 - r122*F*H2 + d(H2402)/dt = - j50*H2402 - r118*O1D*H2402 + d(H2O2)/dt = .5*r172*HO2 + r35*M*OH*OH + r36*HO2*HO2 + - j4*H2O2 - r21*O*H2O2 - r30*OH*H2O2 - r67*CL*H2O2 + d(H2SO4)/dt = r171*SO3*H2O + - j87*H2SO4 + d(HBR)/dt = r100*BR*CH2O + r101*BR*HO2 + - j51*HBR - r113*O*HBR - r114*OH*HBR - r119*O1D*HBR - r120*O1D*HBR + d(HCFC141B)/dt = - j52*HCFC141B - r136*OH*HCFC141B - r141*O1D*HCFC141B + d(HCFC142B)/dt = - j53*HCFC142B - r137*OH*HCFC142B - r142*O1D*HCFC142B + d(HCFC22)/dt = - j54*HCFC22 - r138*OH*HCFC22 - r143*O1D*HCFC22 + d(HCL)/dt = r64*CL*CH2O + r65*CL*CH4 + r66*CL*H2 + r67*CL*H2O2 + r68*CL*HO2 + r83*CLO*OH + r86*HOCL*CL + + r127*CH2BR2*CL + r129*CH3BR*CL + 2*r132*CH3CL*CL + r134*CHBR3*CL + - j55*HCL - r84*O*HCL - r85*OH*HCL - r96*O1D*HCL - r97*O1D*HCL - r177*HOCL*HCL + - r182*CLONO2*HCL - r183*HOCL*HCL - r184*HOBR*HCL - r187*CLONO2*HCL - r188*HOCL*HCL + - r189*HOBR*HCL - r192*CLONO2*HCL + d(HF)/dt = r121*F*CH4 + r122*F*H2 + r123*F*H2O + r124*F*HNO3 + - j56*HF + d(HNO3)/dt = 2*r173*N2O5 + .5*r174*NO2 + r175*NO3 + 2*r176*N2O5 + r178*BRONO2 + 2*r179*N2O5 + r180*CLONO2 + + r181*BRONO2 + r185*CLONO2 + r186*BRONO2 + 2*r190*N2O5 + r191*CLONO2 + r60*M*NO2*OH + + r144*CH2O*NO3 + r155*DMS*NO3 + r182*CLONO2*HCL + r187*CLONO2*HCL + r192*CLONO2*HCL + - j9*HNO3 - r61*OH*HNO3 - r124*F*HNO3 + d(HO2NO2)/dt = r58*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r62*M*HO2NO2 - r37*OH*HO2NO2 + d(HOBR)/dt = r178*BRONO2 + r181*BRONO2 + r186*BRONO2 + r107*BRO*HO2 + - j57*HOBR - r115*O*HOBR - r184*HCL*HOBR - r189*HCL*HOBR + d(HOCL)/dt = r180*CLONO2 + r185*CLONO2 + r191*CLONO2 + r75*CLO*HO2 + r80*CLONO2*OH + - j58*HOCL - r86*CL*HOCL - r87*O*HOCL - r88*OH*HOCL - r177*HCL*HOCL - r183*HCL*HOCL + - r188*HCL*HOCL + d(N)/dt = j64*N2 + .8*j66*N2 + .8*j68*N2 + j70*N2 + j15*NO + r209*N2*Op + r38*N2D*O + .2*r196*NOp*e + + 1.1*r198*N2p*e + r202*Np*O + r203*Np*O2 + - j62*N - r40*NO*N - r41*NO2*N - r42*NO2*N - r43*NO2*N - r44*O2*N - r52*OH*N - r205*O2p*N + d(N2O)/dt = r41*N*NO2 + - j12*N2O - r56*O1D*N2O - r57*O1D*N2O + d(N2O5)/dt = r59*M*NO2*NO3 + - j13*N2O5 - j14*N2O5 - r63*M*N2O5 - r173*N2O5 - r176*N2O5 - r179*N2O5 - r190*N2O5 + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 + d(ncl_a3)/dt = 0 + d(NO)/dt = j14*N2O5 + j17*NO2 + j19*NO3 + .5*r174*NO2 + r206*N2*O2p + r219*N2*Op2P + r39*N2D*O2 + + 2*r42*N*NO2 + r44*N*O2 + r45*NO2*O + r52*N*OH + 2*r56*O1D*N2O + r165*SO*NO2 + - j15*NO - j16*NO - r40*N*NO - r49*NO3*NO - r53*HO2*NO - r54*O3*NO - r55*M*O*NO - r76*CLO*NO + - r108*BRO*NO - r148*CH3O2*NO - r207*O2p*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j28*BRONO2 + j47*CLONO2 + r62*M*HO2NO2 + r63*M*N2O5 + + r37*HO2NO2*OH + r48*NO3*HO2 + 2*r49*NO3*NO + r50*NO3*O + r51*NO3*OH + r53*NO*HO2 + r54*NO*O3 + + r55*M*NO*O + r76*CLO*NO + r108*BRO*NO + r148*CH3O2*NO + - j17*NO2 - r174*NO2 - r41*N*NO2 - r42*N*NO2 - r43*N*NO2 - r45*O*NO2 - r46*O3*NO2 + - r47*M*O*NO2 - r58*M*HO2*NO2 - r59*M*NO3*NO2 - r60*M*OH*NO2 - r78*M*CLO*NO2 - r109*M*BRO*NO2 + - r165*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + j29*BRONO2 + j46*CLONO2 + r63*M*N2O5 + r46*NO2*O3 + + r47*M*NO2*O + r61*HNO3*OH + r77*CLONO2*CL + r79*CLONO2*O + r80*CLONO2*OH + r110*BRONO2*O + + r124*F*HNO3 + - j18*NO3 - j19*NO3 - r175*NO3 - r48*HO2*NO3 - r49*NO*NO3 - r50*O*NO3 - r51*OH*NO3 + - r59*M*NO2*NO3 - r144*CH2O*NO3 - r155*DMS*NO3 + 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 = j2*H2O + 2*j5*O2 + j6*O2 + j8*O3 + j14*N2O5 + j15*NO + j17*NO2 + j18*NO3 + .18*j24*CH4 + + j25*CO2 + j27*BRO + j45*CLO + j59*OCLO + j61*CO2 + j77*O2 + j79*O2 + j81*O2 + 2*j82*O2 + + 2*j83*O2 + j84*O2 + j85*O2 + j86*O2 + j89*SO + j90*SO2 + j91*SO3 + r5*N2*O1D + r213*N2*Op2D + + r218*N2*Op2P + r6*O1D*O2 + r7*O1D*O2 + r24*H*HO2 + r34*OH*OH + r40*N*NO + r41*N*NO2 + r44*N*O2 + + r159*S*O2 + r166*SO*O2 + r196*NOp*e + 1.15*r197*O2p*e + r204*Np*O2 + r205*O2p*N + r210*Op*N2D + + r211*Op*O2 + r215*Op2D*O2 + - j71*O - j72*O - j73*O - j74*O - j75*O - j76*O - r17*O3*O - 2*r18*M*O*O - r19*M*O2*O + - r20*H2*O - r21*H2O2*O - r26*HO2*O - r32*OH*O - r45*NO2*O - r47*M*NO2*O - r50*NO3*O + - r55*M*NO*O - r79*CLONO2*O - r81*CLO*O - r84*HCL*O - r87*HOCL*O - r110*BRONO2*O - r111*BRO*O + - r113*HBR*O - r115*HOBR*O - r145*CH2O*O - r157*OCS*O - r200*N2p*O - r201*N2p*O - r202*Np*O + d(O2)/dt = j8*O3 + j19*NO3 + r1*O2_1D + r2*O2_1S + r9*N2*O2_1D + r8*O1D*O3 + r8*O1D*O3 + r10*O2_1D*O + + 2*r11*O2_1D*O2 + 2*r17*O*O3 + r18*M*O*O + r22*H*HO2 + r26*HO2*O + 2*r27*HO2*O3 + r28*H*O3 + + r31*OH*HO2 + r32*OH*O + r33*OH*O3 + r36*HO2*HO2 + r37*HO2NO2*OH + r43*N*NO2 + r45*NO2*O + + r46*NO2*O3 + r48*NO3*HO2 + r50*NO3*O + r54*NO*O3 + r57*O1D*N2O + r68*CL*HO2 + r70*CL*O3 + + r72*CLO*CLO + r73*CLO*CLO + r75*CLO*HO2 + r81*CLO*O + r83*CLO*OH + r101*BR*HO2 + r102*BR*O3 + + r103*BRO*BRO + r105*BRO*CLO + r106*BRO*CLO + r107*BRO*HO2 + r111*BRO*O + r147*CH3O2*HO2 + + r161*S*O3 + r167*SO*O3 + r207*O2p*NO + - j5*O2 - j6*O2 - j77*O2 - j78*O2 - j79*O2 - j80*O2 - j81*O2 - j82*O2 - j83*O2 - j84*O2 + - j85*O2 - j86*O2 - r6*O1D*O2 - r11*O2_1D*O2 - r19*M*O*O2 - r25*M*H*O2 - r39*N2D*O2 - r44*N*O2 + - r159*S*O2 - r166*SO*O2 - r199*N2p*O2 - r203*Np*O2 - r204*Np*O2 - r211*Op*O2 - r215*Op2D*O2 + d(O3)/dt = r19*M*O*O2 + - j7*O3 - j8*O3 - r8*O1D*O3 - r17*O*O3 - r27*HO2*O3 - r28*H*O3 - r33*OH*O3 - r46*NO2*O3 + - r54*NO*O3 - r70*CL*O3 - r102*BR*O3 - r161*S*O3 - r167*SO*O3 + d(O3S)/dt = 0 + d(OCLO)/dt = r74*CLO*CLO + r104*BRO*CLO + - j59*OCLO - r168*SO*OCLO + d(OCS)/dt = - j88*OCS - r157*O*OCS - r158*OH*OCS + d(pom_a1)/dt = 0 + d(pom_a4)/dt = 0 + d(S)/dt = j88*OCS + j89*SO + - r159*O2*S - r161*O3*S - r164*OH*S + d(SF6)/dt = - j60*SF6 + d(SO)/dt = j90*SO2 + r157*OCS*O + r159*S*O2 + r161*S*O3 + r164*S*OH + - j89*SO - r162*BRO*SO - r163*CLO*SO - r165*NO2*SO - r166*O2*SO - r167*O3*SO - r168*OCLO*SO + - r169*OH*SO + d(SO2)/dt = j91*SO3 + r155*DMS*NO3 + r156*DMS*OH + r158*OCS*OH + r162*SO*BRO + r163*SO*CLO + r165*SO*NO2 + + r166*SO*O2 + r167*SO*O3 + r168*SO*OCLO + r169*SO*OH + .5*r170*DMS*OH + - j90*SO2 - r160*M*OH*SO2 + d(SO3)/dt = j87*H2SO4 + r160*M*SO2*OH + - j91*SO3 - r171*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 = 0 + d(soa_a2)/dt = 0 + d(SOAG)/dt = 0 + d(e)/dt = j63*N2 + j64*N2 + j65*N2 + j67*N2 + j69*N2 + j70*N2 + j16*NO + j62*N + j71*O + j72*O + j73*O + + j74*O + j75*O + j76*O + j77*O2 + j78*O2 + j79*O2 + j80*O2 + j81*O2 + j84*O2 + j85*O2 + + j86*O2 + - r196*NOp*e - r197*O2p*e - r198*N2p*e + d(HO2)/dt = j11*HO2NO2 + r62*M*HO2NO2 + r21*H2O2*O + r25*M*H*O2 + r30*OH*H2O2 + r33*OH*O3 + r51*NO3*OH + + r64*CL*CH2O + r67*CL*H2O2 + r71*CLO*CH3O2 + r82*CLO*OH + r100*BR*CH2O + r112*BRO*OH + + r129*CH3BR*CL + r130*CH3BR*OH + r132*CH3CL*CL + r133*CH3CL*OH + r144*CH2O*NO3 + r145*CH2O*O + + r148*CH3O2*NO + r152*O1D*CH4 + r154*CO*OH + r160*M*SO2*OH + .5*r170*DMS*OH + - r172*HO2 - r22*H*HO2 - r23*H*HO2 - r24*H*HO2 - r26*O*HO2 - r27*O3*HO2 - r31*OH*HO2 + - 2*r36*HO2*HO2 - r48*NO3*HO2 - r53*NO*HO2 - r58*M*NO2*HO2 - r68*CL*HO2 - r69*CL*HO2 + - r75*CLO*HO2 - r101*BR*HO2 - r107*BRO*HO2 - r147*CH3O2*HO2 + d(N2D)/dt = j65*N2 + 1.2*j66*N2 + 1.2*j68*N2 + j69*N2 + .8*r196*NOp*e + .9*r198*N2p*e + r200*N2p*O + - r38*O*N2D - r39*O2*N2D - r210*Op*N2D + d(N2p)/dt = j63*N2 + j67*N2 + r213*N2*Op2D + r218*N2*Op2P + - r198*e*N2p - r199*O2*N2p - r200*O*N2p - r201*O*N2p + d(NOp)/dt = j16*NO + r206*N2*O2p + r209*N2*Op + r200*N2p*O + r204*Np*O2 + r205*O2p*N + r207*O2p*NO + - r196*e*NOp + d(Np)/dt = j64*N2 + j65*N2 + j69*N2 + j70*N2 + j62*N + r219*N2*Op2P + r210*Op*N2D + - r202*O*Np - r203*O2*Np - r204*O2*Np + d(O1D)/dt = j1*H2O + j6*O2 + j7*O3 + j12*N2O + r39*N2D*O2 + .85*r197*O2p*e + - r5*N2*O1D - r3*H2*O1D - r4*H2O*O1D - r6*O2*O1D - r7*O2*O1D - r8*O3*O1D - r56*N2O*O1D + - r57*N2O*O1D - r89*CCL4*O1D - r90*CF2CLBR*O1D - r91*CFC11*O1D - r92*CFC113*O1D - r93*CFC114*O1D + - r94*CFC115*O1D - r95*CFC12*O1D - r96*HCL*O1D - r97*HCL*O1D - r116*CF3BR*O1D - r117*CHBR3*O1D + - r118*H2402*O1D - r119*HBR*O1D - r120*HBR*O1D - r125*COF2*O1D - r126*COFCL*O1D + - r139*CH2BR2*O1D - r140*CH3BR*O1D - r141*HCFC141B*O1D - r142*HCFC142B*O1D - r143*HCFC22*O1D + - r151*CH4*O1D - r152*CH4*O1D - r153*CH4*O1D + d(O2_1D)/dt = j7*O3 + r13*N2*O2_1S + r12*O2_1S*CO2 + r14*O2_1S*O + r15*O2_1S*O2 + r16*O2_1S*O3 + - r1*O2_1D - r9*N2*O2_1D - r10*O*O2_1D - r11*O2*O2_1D + d(O2_1S)/dt = r6*O1D*O2 + - r2*O2_1S - r13*N2*O2_1S - r12*CO2*O2_1S - r14*O*O2_1S - r15*O2*O2_1S - r16*O3*O2_1S + d(O2p)/dt = j78*O2 + j80*O2 + r199*N2p*O2 + r203*Np*O2 + r208*Op*CO2 + r211*Op*O2 + r215*Op2D*O2 + - r206*N2*O2p - r197*e*O2p - r205*N*O2p - r207*NO*O2p + d(OH)/dt = j3*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j22*CH3OOH + .33*j24*CH4 + j57*HOBR + j58*HOCL + + .5*r174*NO2 + r3*O1D*H2 + 2*r4*O1D*H2O + r20*H2*O + r21*H2O2*O + 2*r23*H*HO2 + r26*HO2*O + + r27*HO2*O3 + r28*H*O3 + r48*NO3*HO2 + r53*NO*HO2 + r69*CL*HO2 + r84*HCL*O + r87*HOCL*O + + r96*O1D*HCL + r113*HBR*O + r115*HOBR*O + r119*O1D*HBR + r123*F*H2O + r145*CH2O*O + + .3*r149*CH3OOH*OH + r151*O1D*CH4 + - r29*H2*OH - r30*H2O2*OH - r31*HO2*OH - r32*O*OH - r33*O3*OH - 2*r34*OH*OH - 2*r35*M*OH*OH + - r37*HO2NO2*OH - r51*NO3*OH - r52*N*OH - r60*M*NO2*OH - r61*HNO3*OH - r80*CLONO2*OH + - r82*CLO*OH - r83*CLO*OH - r85*HCL*OH - r88*HOCL*OH - r112*BRO*OH - r114*HBR*OH + - r128*CH2BR2*OH - r130*CH3BR*OH - r131*CH3CCL3*OH - r133*CH3CL*OH - r135*CHBR3*OH + - r136*HCFC141B*OH - r137*HCFC142B*OH - r138*HCFC22*OH - r146*CH2O*OH - r149*CH3OOH*OH + - r150*CH4*OH - r154*CO*OH - r156*DMS*OH - r158*OCS*OH - r160*M*SO2*OH - r164*S*OH - r169*SO*OH + - r170*DMS*OH + d(Op)/dt = j73*O + j74*O + j79*O2 + j81*O2 + r193*Op2P + r194*Op2D + r201*N2p*O + r202*Np*O + r212*Op2D*e + + r214*Op2D*O + r217*Op2P*e + r220*Op2P*O + - r209*N2*Op - r208*CO2*Op - r210*N2D*Op - r211*O2*Op + d(Op2D)/dt = j75*O + j76*O + j85*O2 + j86*O2 + r195*Op2P + r216*Op2P*e + - r194*Op2D - r213*N2*Op2D - r212*e*Op2D - r214*O*Op2D - r215*O2*Op2D + d(Op2P)/dt = j71*O + j72*O + j77*O2 + j84*O2 + - r193*Op2P - r195*Op2P - r218*N2*Op2P - r219*N2*Op2P - r216*e*Op2P - r217*e*Op2P + - r220*O*Op2P + d(H2O)/dt = .05*j24*CH4 + j87*H2SO4 + r24*H*HO2 + r29*OH*H2 + r30*OH*H2O2 + r31*OH*HO2 + r34*OH*OH + + r37*HO2NO2*OH + r61*HNO3*OH + r85*HCL*OH + r88*HOCL*OH + r114*HBR*OH + r128*CH2BR2*OH + + r130*CH3BR*OH + r131*CH3CCL3*OH + r133*CH3CL*OH + r138*HCFC22*OH + r146*CH2O*OH + + r149*CH3OOH*OH + r150*CH4*OH + r177*HOCL*HCL + r183*HOCL*HCL + r184*HOBR*HCL + r188*HOCL*HCL + + r189*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r4*O1D*H2O - r123*F*H2O - r171*SO3*H2O diff --git a/src/chemistry/pp_waccm_ma_mam5/chem_mech.in b/src/chemistry/pp_waccm_ma_mam5/chem_mech.in new file mode 100644 index 0000000000..8443364166 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/chem_mech.in @@ -0,0 +1,675 @@ +* Comments +* User-given Tag Description: WACCM_MA_MAM4_JPL19 +* Tag database identifier : MZ319_MA_MAM4_20221220 +* Tag created by : lke +* Tag created from branch : MA_MAM4 +* Tag created on : 2022-12-20 13:58:07.831193-07 +* Comments for this tag follow: +* lke : 2022-12-20 : WACCM middle atmosphere with MAM4 updated to JPL19 reaction rates + + SPECIES + + Solution + bc_a1 -> C, + bc_a4 -> C, + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + CCL4 -> CCl4, + CF2CLBR -> CF2ClBr, + CF3BR -> CF3Br, + CFC11 -> CFCl3, + CFC113 -> CCl2FCClF2, + CFC114 -> CClF2CClF2, + CFC115 -> CClF2CF3, + CFC12 -> CF2Cl2, + CH2BR2 -> CH2Br2, + CH2O, + CH3BR -> CH3Br, + CH3CCL3 -> CH3CCl3, + CH3CL -> CH3Cl, + CH3O2, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + COF2, + COFCL -> COFCl, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + F, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HF, + HNO3, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + N, + N2O, + N2O5, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + NO, + NO2, + NO3, + num_a1 -> H, + num_a2 -> H, + num_a3 -> H, + num_a4 -> H, + num_a5 -> H, + O, + O2, + O3, + O3S -> O3, + OCLO -> OClO, + OCS -> OCS, + pom_a1 -> C, + pom_a4 -> C, + 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, + SOAG -> C, + e -> E, + HO2, + N2D -> N, + N2p -> N2, + NOp -> NO, + Np -> N, + O1D -> O, + O2_1D -> O2, + O2_1S -> O2, + O2p -> O2, + OH, + Op -> O, + Op2D -> O, + Op2P -> O, + H2O + + End Solution + + + Fixed + M, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + e, + HO2, + N2D, + N2p, + NOp, + Np, + O1D, + O2_1D, + O2_1S, + O2p, + OH, + Op, + Op2D, + Op2P + End Not-Transported + + END Species + + + Solution classes + Explicit + O3S + End Explicit + + Implicit + bc_a1 + bc_a4 + BR + BRCL + BRO + BRONO2 + BRY + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH2O + CH3BR + CH3CCL3 + CH3CL + CH3O2 + CH3OOH + CH4 + CHBR3 + CL + CL2 + CL2O2 + CLO + CLONO2 + CLY + CO + CO2 + COF2 + COFCL + DMS + dst_a1 + dst_a2 + dst_a3 + F + H + H2 + H2402 + H2O2 + H2SO4 + HBR + HCFC141B + HCFC142B + HCFC22 + HCL + HF + HNO3 + HO2NO2 + HOBR + HOCL + N + N2O + N2O5 + ncl_a1 + ncl_a2 + ncl_a3 + NO + NO2 + NO3 + num_a1 + num_a2 + num_a3 + num_a4 + num_a5 + O + O2 + O3 + OCLO + OCS + pom_a1 + pom_a4 + S + SF6 + SO + SO2 + SO3 + so4_a1 + so4_a2 + so4_a3 + so4_a5 + soa_a1 + soa_a2 + SOAG + e + HO2 + N2D + N2p + NOp + Np + O1D + O2_1D + O2_1S + O2p + OH + Op + Op2D + Op2P + H2O + End Implicit + + End Solution classes + + + CHEMISTRY + Photolysis +********************************* +*** odd-oxygen +********************************* +[jh2o_b] H2O + hv -> H2 + O1D +[jh2o_c] H2O + hv -> 2*H + O +[jh2o_a] H2O + hv -> OH + H +[jh2o2] H2O2 + hv -> 2*OH +[jo2_b=userdefined,] O2 + hv -> 2*O +[jo2_a=userdefined,] O2 + hv -> O + O1D +[jo3_a] O3 + hv -> O1D + O2_1D +[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 +[jno_i] NO + hv -> NOp + e +[jno2] NO2 + hv -> NO + O +[jno3_a] NO3 + hv -> NO2 + O +[jno3_b] NO3 + hv -> NO + O2 +********************************* +*** organics +********************************* +[jch2o_a] CH2O + hv -> CO + 2*H +[jch2o_b] CH2O + hv -> CO + H2 +[jch3ooh] CH3OOH + hv -> CH2O + H + OH +[jch4_a] CH4 + hv -> H + CH3O2 +[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 +[jco2] CO2 + hv -> CO + O +********************************* +*** 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 -> 2*CL + COFCL +[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 +[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_a] CLONO2 + hv -> CL + NO3 +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jcof2] COF2 + hv -> 2*F +[jcofcl] COFCL + hv -> F + CL +[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 +********************************* +*** ions +********************************* +[jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O +[jeuv_4=userdefined,userdefined] N + hv -> Np + e +[jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_3=userdefined,userdefined] O + hv -> Op2P + e +[jeuv_16=userdefined,userdefined] O + hv -> Op2P + e +[jeuv_1=userdefined,userdefined] O + hv -> Op + e +[jeuv_14=userdefined,userdefined] O + hv -> Op + e +[jeuv_2=userdefined,userdefined] O + hv -> Op2D + e +[jeuv_15=userdefined,userdefined] O + hv -> Op2D + e +[jeuv_21=userdefined,userdefined] O2 + hv -> O + Op2P + e +[jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_24=userdefined,userdefined] O2 + hv -> 2*O +[jeuv_12=userdefined,userdefined] O2 + hv -> 2*O +[jeuv_9=userdefined,userdefined] O2 + hv -> O + Op2P + e +[jeuv_8=userdefined,userdefined] O2 + hv -> O + Op2D + e +[jeuv_20=userdefined,userdefined] O2 + hv -> O + Op2D + e +********************************* +*** 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 + End Photolysis + + Reactions +********************************* +*** odd-oxygen +********************************* +[ag1] O2_1D -> O2 ; 0.000258 +[ag2] O2_1S -> O2 ; 0.085 +[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_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 2.64e-11, 55 +[O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 6.6e-12, 55 +[O1D_O3] O1D + O3 -> O2 + O2 ; 1.2e-10 +[O2_1D_N2,cph=94.3] O2_1D + N2 -> O2 + N2 ; 1e-20 +[O2_1D_O,cph=94.3] O2_1D + O -> O2 + O ; 1.3e-16 +[O2_1D_O2,cph=94.3] O2_1D + O2 -> 2*O2 ; 3.6e-18, -220 +[O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13 +[O2_1S_N2,cph=62.6] O2_1S + N2 -> O2_1D + N2 ; 1.8e-15, 45 +[O2_1S_O,cph=62.6] O2_1S + O -> O2_1D + O ; 8e-14 +[O2_1S_O2,cph=62.6] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17 +[O2_1S_O3,cph=62.6] O2_1S + O3 -> O2_1D + O3 ; 3.5e-11, -135 +[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 +[N2D_O,cph=229.61] N2D + O -> N + O ; 7e-13 +[N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5e-12 +[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 -> 2*CL + COFCL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 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 +********************************* +*** odd-fluorine +********************************* +[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 +[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 +[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 +[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 +[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 +[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 +********************************* +*** 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, -1110 +[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 + COFCL ; 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 + COFCL ; 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_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750 +[CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 +[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 +********************************* +*** 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 +********************************* +[usr_HO2_aer] HO2 -> 0.5*H2O2 +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 +[usr_NO3_aer] NO3 -> HNO3 +********************************* +*** 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 +********************************* +*** Ions +********************************* +[ag247nm,cph=483.39] Op2P -> Op ; 0.047 +[ag373nm,cph=321.3] Op2D -> Op ; 7.7e-05 +[ag732nm,cph=163.06] Op2P -> Op2D ; 0.171 +[elec1,cph=82.389] NOp + e -> 0.2*N + 0.8*N2D + O +[elec2,cph=508.95] O2p + e -> 1.15*O + 0.85*O1D +[elec3,cph=354.83] N2p + e -> 1.1*N + 0.9*N2D +[ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6e-11 +[ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D +[ion_N2p_Ob] N2p + O -> Op + N2 +[ion_Np_O,cph=95.55] Np + O -> Op + N ; 1e-12 +[ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4e-10 +[ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2e-10 +[ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1e-10 +[ion_O2p_N2] O2p + N2 -> NOp + NO ; 5e-16 +[ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 +[ion_Op_CO2] Op + CO2 -> O2p + CO ; 9e-10 +[ion_Op_N2,cph=105.04] Op + N2 -> NOp + N +[ion_Op_N2D,cph=139.9] Op + N2D -> Np + O ; 1.3e-10 +[ion_Op_O2,cph=150.11] Op + O2 -> O2p + O +[Op2D_e,cph=319.37] Op2D + e -> Op + e +[Op2D_N2,cph=128.32] Op2D + N2 -> N2p + O ; 8e-10 +[Op2D_O,cph=319.36] Op2D + O -> Op + O ; 5e-12 +[Op2D_O2,cph=469.4] Op2D + O2 -> O2p + O ; 7e-10 +[Op2P_ea,cph=163.06] Op2P + e -> Op2D + e +[Op2P_eb,cph=482.43] Op2P + e -> Op + e +[Op2P_N2a,cph=291.38] Op2P + N2 -> N2p + O ; 4.8e-10 +[Op2P_N2b,cph=67.54] Op2P + N2 -> Np + NO ; 1e-10 +[Op2P_O,cph=501.72] Op2P + O -> Op + O ; 4e-10 + End Reactions + + Ext Forcing + so4_a2 <- dataset + DMS <- dataset + bc_a4 <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset + num_a5 <- dataset + pom_a1 <- dataset + pom_a4 <- dataset + so4_a1 <- dataset + so4_a5 <- dataset + CO <- dataset + NO <- dataset + NO2 <- dataset + SO2 <- dataset + bc_a1 <- dataset + N + N2D + N2p + Op + e + Np + O2p + OH + 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_waccm_ma_mam5/chem_mods.F90 b/src/chemistry/pp_waccm_ma_mam5/chem_mods.F90 new file mode 100644 index 0000000000..3c74c4fd26 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/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 = 91, & ! number of photolysis reactions + rxntot = 311, & ! number of total reactions + gascnt = 220, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 103, & ! number of "gas phase" species + nfs = 2, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 959, & ! number of non-zero matrix entries + extcnt = 24, & ! number of species with external forcing + clscnt1 = 1, & ! number of species in explicit class + clscnt2 = 0, & ! number of species in hov class + clscnt3 = 0, & ! number of species in ebi class + clscnt4 = 102, & ! 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 = 311, & + enthalpy_cnt = 54, & + nslvd = 14 + 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_waccm_ma_mam5/m_rxt_id.F90 b/src/chemistry/pp_waccm_ma_mam5/m_rxt_id.F90 new file mode 100644 index 0000000000..61adf10946 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/m_rxt_id.F90 @@ -0,0 +1,314 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o_b = 1 + integer, parameter :: rid_jh2o_c = 2 + integer, parameter :: rid_jh2o_a = 3 + integer, parameter :: rid_jh2o2 = 4 + integer, parameter :: rid_jo2_b = 5 + integer, parameter :: rid_jo2_a = 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_jno_i = 16 + integer, parameter :: rid_jno2 = 17 + integer, parameter :: rid_jno3_a = 18 + integer, parameter :: rid_jno3_b = 19 + integer, parameter :: rid_jch2o_a = 20 + integer, parameter :: rid_jch2o_b = 21 + integer, parameter :: rid_jch3ooh = 22 + integer, parameter :: rid_jch4_a = 23 + integer, parameter :: rid_jch4_b = 24 + integer, parameter :: rid_jco2 = 25 + integer, parameter :: rid_jbrcl = 26 + integer, parameter :: rid_jbro = 27 + integer, parameter :: rid_jbrono2_b = 28 + integer, parameter :: rid_jbrono2_a = 29 + integer, parameter :: rid_jccl4 = 30 + integer, parameter :: rid_jcf2clbr = 31 + integer, parameter :: rid_jcf3br = 32 + integer, parameter :: rid_jcfcl3 = 33 + integer, parameter :: rid_jcfc113 = 34 + integer, parameter :: rid_jcfc114 = 35 + integer, parameter :: rid_jcfc115 = 36 + integer, parameter :: rid_jcf2cl2 = 37 + integer, parameter :: rid_jch2br2 = 38 + integer, parameter :: rid_jch3br = 39 + integer, parameter :: rid_jch3ccl3 = 40 + integer, parameter :: rid_jch3cl = 41 + integer, parameter :: rid_jchbr3 = 42 + integer, parameter :: rid_jcl2 = 43 + integer, parameter :: rid_jcl2o2 = 44 + integer, parameter :: rid_jclo = 45 + integer, parameter :: rid_jclono2_a = 46 + integer, parameter :: rid_jclono2_b = 47 + integer, parameter :: rid_jcof2 = 48 + integer, parameter :: rid_jcofcl = 49 + integer, parameter :: rid_jh2402 = 50 + integer, parameter :: rid_jhbr = 51 + integer, parameter :: rid_jhcfc141b = 52 + integer, parameter :: rid_jhcfc142b = 53 + integer, parameter :: rid_jhcfc22 = 54 + integer, parameter :: rid_jhcl = 55 + integer, parameter :: rid_jhf = 56 + integer, parameter :: rid_jhobr = 57 + integer, parameter :: rid_jhocl = 58 + integer, parameter :: rid_joclo = 59 + integer, parameter :: rid_jsf6 = 60 + integer, parameter :: rid_jeuv_26 = 61 + integer, parameter :: rid_jeuv_4 = 62 + integer, parameter :: rid_jeuv_6 = 63 + integer, parameter :: rid_jeuv_22 = 64 + integer, parameter :: rid_jeuv_23 = 65 + integer, parameter :: rid_jeuv_25 = 66 + integer, parameter :: rid_jeuv_18 = 67 + integer, parameter :: rid_jeuv_13 = 68 + integer, parameter :: rid_jeuv_11 = 69 + integer, parameter :: rid_jeuv_10 = 70 + integer, parameter :: rid_jeuv_3 = 71 + integer, parameter :: rid_jeuv_16 = 72 + integer, parameter :: rid_jeuv_1 = 73 + integer, parameter :: rid_jeuv_14 = 74 + integer, parameter :: rid_jeuv_2 = 75 + integer, parameter :: rid_jeuv_15 = 76 + integer, parameter :: rid_jeuv_21 = 77 + integer, parameter :: rid_jeuv_17 = 78 + integer, parameter :: rid_jeuv_7 = 79 + integer, parameter :: rid_jeuv_5 = 80 + integer, parameter :: rid_jeuv_19 = 81 + integer, parameter :: rid_jeuv_24 = 82 + integer, parameter :: rid_jeuv_12 = 83 + integer, parameter :: rid_jeuv_9 = 84 + integer, parameter :: rid_jeuv_8 = 85 + integer, parameter :: rid_jeuv_20 = 86 + integer, parameter :: rid_jh2so4 = 87 + integer, parameter :: rid_jocs = 88 + integer, parameter :: rid_jso = 89 + integer, parameter :: rid_jso2 = 90 + integer, parameter :: rid_jso3 = 91 + integer, parameter :: rid_ag1 = 92 + integer, parameter :: rid_ag2 = 93 + integer, parameter :: rid_O1D_H2 = 94 + integer, parameter :: rid_O1D_H2O = 95 + integer, parameter :: rid_O1D_N2 = 96 + integer, parameter :: rid_O1D_O2 = 97 + integer, parameter :: rid_O1D_O2b = 98 + integer, parameter :: rid_O1D_O3 = 99 + integer, parameter :: rid_O2_1D_N2 = 100 + integer, parameter :: rid_O2_1D_O = 101 + integer, parameter :: rid_O2_1D_O2 = 102 + integer, parameter :: rid_O2_1S_CO2 = 103 + integer, parameter :: rid_O2_1S_N2 = 104 + integer, parameter :: rid_O2_1S_O = 105 + integer, parameter :: rid_O2_1S_O2 = 106 + integer, parameter :: rid_O2_1S_O3 = 107 + integer, parameter :: rid_O_O3 = 108 + integer, parameter :: rid_usr_O_O = 109 + integer, parameter :: rid_usr_O_O2 = 110 + integer, parameter :: rid_H2_O = 111 + integer, parameter :: rid_H2O2_O = 112 + integer, parameter :: rid_H_HO2 = 113 + integer, parameter :: rid_H_HO2a = 114 + integer, parameter :: rid_H_HO2b = 115 + integer, parameter :: rid_H_O2 = 116 + integer, parameter :: rid_HO2_O = 117 + integer, parameter :: rid_HO2_O3 = 118 + integer, parameter :: rid_H_O3 = 119 + integer, parameter :: rid_OH_H2 = 120 + integer, parameter :: rid_OH_H2O2 = 121 + integer, parameter :: rid_OH_HO2 = 122 + integer, parameter :: rid_OH_O = 123 + integer, parameter :: rid_OH_O3 = 124 + integer, parameter :: rid_OH_OH = 125 + integer, parameter :: rid_OH_OH_M = 126 + integer, parameter :: rid_usr_HO2_HO2 = 127 + integer, parameter :: rid_HO2NO2_OH = 128 + integer, parameter :: rid_N2D_O = 129 + integer, parameter :: rid_N2D_O2 = 130 + integer, parameter :: rid_N_NO = 131 + integer, parameter :: rid_N_NO2a = 132 + integer, parameter :: rid_N_NO2b = 133 + integer, parameter :: rid_N_NO2c = 134 + integer, parameter :: rid_N_O2 = 135 + integer, parameter :: rid_NO2_O = 136 + integer, parameter :: rid_NO2_O3 = 137 + integer, parameter :: rid_NO2_O_M = 138 + integer, parameter :: rid_NO3_HO2 = 139 + integer, parameter :: rid_NO3_NO = 140 + integer, parameter :: rid_NO3_O = 141 + integer, parameter :: rid_NO3_OH = 142 + integer, parameter :: rid_N_OH = 143 + integer, parameter :: rid_NO_HO2 = 144 + integer, parameter :: rid_NO_O3 = 145 + integer, parameter :: rid_NO_O_M = 146 + integer, parameter :: rid_O1D_N2Oa = 147 + integer, parameter :: rid_O1D_N2Ob = 148 + integer, parameter :: rid_tag_NO2_HO2 = 149 + integer, parameter :: rid_tag_NO2_NO3 = 150 + integer, parameter :: rid_tag_NO2_OH = 151 + integer, parameter :: rid_usr_HNO3_OH = 152 + integer, parameter :: rid_usr_HO2NO2_M = 153 + integer, parameter :: rid_usr_N2O5_M = 154 + integer, parameter :: rid_CL_CH2O = 155 + integer, parameter :: rid_CL_CH4 = 156 + integer, parameter :: rid_CL_H2 = 157 + integer, parameter :: rid_CL_H2O2 = 158 + integer, parameter :: rid_CL_HO2a = 159 + integer, parameter :: rid_CL_HO2b = 160 + integer, parameter :: rid_CL_O3 = 161 + integer, parameter :: rid_CLO_CH3O2 = 162 + integer, parameter :: rid_CLO_CLOa = 163 + integer, parameter :: rid_CLO_CLOb = 164 + integer, parameter :: rid_CLO_CLOc = 165 + integer, parameter :: rid_CLO_HO2 = 166 + integer, parameter :: rid_CLO_NO = 167 + integer, parameter :: rid_CLONO2_CL = 168 + integer, parameter :: rid_CLO_NO2_M = 169 + integer, parameter :: rid_CLONO2_O = 170 + integer, parameter :: rid_CLONO2_OH = 171 + integer, parameter :: rid_CLO_O = 172 + integer, parameter :: rid_CLO_OHa = 173 + integer, parameter :: rid_CLO_OHb = 174 + integer, parameter :: rid_HCL_O = 175 + integer, parameter :: rid_HCL_OH = 176 + integer, parameter :: rid_HOCL_CL = 177 + integer, parameter :: rid_HOCL_O = 178 + integer, parameter :: rid_HOCL_OH = 179 + integer, parameter :: rid_O1D_CCL4 = 180 + integer, parameter :: rid_O1D_CF2CLBR = 181 + integer, parameter :: rid_O1D_CFC11 = 182 + integer, parameter :: rid_O1D_CFC113 = 183 + integer, parameter :: rid_O1D_CFC114 = 184 + integer, parameter :: rid_O1D_CFC115 = 185 + integer, parameter :: rid_O1D_CFC12 = 186 + integer, parameter :: rid_O1D_HCLa = 187 + integer, parameter :: rid_O1D_HCLb = 188 + integer, parameter :: rid_tag_CLO_CLO_M = 189 + integer, parameter :: rid_usr_CL2O2_M = 190 + integer, parameter :: rid_BR_CH2O = 191 + integer, parameter :: rid_BR_HO2 = 192 + integer, parameter :: rid_BR_O3 = 193 + integer, parameter :: rid_BRO_BRO = 194 + integer, parameter :: rid_BRO_CLOa = 195 + integer, parameter :: rid_BRO_CLOb = 196 + integer, parameter :: rid_BRO_CLOc = 197 + integer, parameter :: rid_BRO_HO2 = 198 + integer, parameter :: rid_BRO_NO = 199 + integer, parameter :: rid_BRO_NO2_M = 200 + integer, parameter :: rid_BRONO2_O = 201 + integer, parameter :: rid_BRO_O = 202 + integer, parameter :: rid_BRO_OH = 203 + integer, parameter :: rid_HBR_O = 204 + integer, parameter :: rid_HBR_OH = 205 + integer, parameter :: rid_HOBR_O = 206 + integer, parameter :: rid_O1D_CF3BR = 207 + integer, parameter :: rid_O1D_CHBR3 = 208 + integer, parameter :: rid_O1D_H2402 = 209 + integer, parameter :: rid_O1D_HBRa = 210 + integer, parameter :: rid_O1D_HBRb = 211 + integer, parameter :: rid_F_CH4 = 212 + integer, parameter :: rid_F_H2 = 213 + integer, parameter :: rid_F_H2O = 214 + integer, parameter :: rid_F_HNO3 = 215 + integer, parameter :: rid_O1D_COF2 = 216 + integer, parameter :: rid_O1D_COFCL = 217 + integer, parameter :: rid_CH2BR2_CL = 218 + integer, parameter :: rid_CH2BR2_OH = 219 + integer, parameter :: rid_CH3BR_CL = 220 + integer, parameter :: rid_CH3BR_OH = 221 + integer, parameter :: rid_CH3CCL3_OH = 222 + integer, parameter :: rid_CH3CL_CL = 223 + integer, parameter :: rid_CH3CL_OH = 224 + integer, parameter :: rid_CHBR3_CL = 225 + integer, parameter :: rid_CHBR3_OH = 226 + integer, parameter :: rid_HCFC141B_OH = 227 + integer, parameter :: rid_HCFC142B_OH = 228 + integer, parameter :: rid_HCFC22_OH = 229 + integer, parameter :: rid_O1D_CH2BR2 = 230 + integer, parameter :: rid_O1D_CH3BR = 231 + integer, parameter :: rid_O1D_HCFC141B = 232 + integer, parameter :: rid_O1D_HCFC142B = 233 + integer, parameter :: rid_O1D_HCFC22 = 234 + integer, parameter :: rid_CH2O_NO3 = 235 + integer, parameter :: rid_CH2O_O = 236 + integer, parameter :: rid_CH2O_OH = 237 + integer, parameter :: rid_CH3O2_HO2 = 238 + integer, parameter :: rid_CH3O2_NO = 239 + integer, parameter :: rid_CH3OOH_OH = 240 + integer, parameter :: rid_CH4_OH = 241 + integer, parameter :: rid_O1D_CH4a = 242 + integer, parameter :: rid_O1D_CH4b = 243 + integer, parameter :: rid_O1D_CH4c = 244 + integer, parameter :: rid_usr_CO_OH = 245 + integer, parameter :: rid_DMS_NO3 = 246 + integer, parameter :: rid_DMS_OHa = 247 + integer, parameter :: rid_OCS_O = 248 + integer, parameter :: rid_OCS_OH = 249 + integer, parameter :: rid_S_O2 = 250 + integer, parameter :: rid_SO2_OH_M = 251 + integer, parameter :: rid_S_O3 = 252 + integer, parameter :: rid_SO_BRO = 253 + integer, parameter :: rid_SO_CLO = 254 + integer, parameter :: rid_S_OH = 255 + integer, parameter :: rid_SO_NO2 = 256 + integer, parameter :: rid_SO_O2 = 257 + integer, parameter :: rid_SO_O3 = 258 + integer, parameter :: rid_SO_OCLO = 259 + integer, parameter :: rid_SO_OH = 260 + integer, parameter :: rid_usr_DMS_OH = 261 + integer, parameter :: rid_usr_SO3_H2O = 262 + integer, parameter :: rid_usr_HO2_aer = 263 + integer, parameter :: rid_usr_N2O5_aer = 264 + integer, parameter :: rid_usr_NO2_aer = 265 + integer, parameter :: rid_usr_NO3_aer = 266 + integer, parameter :: rid_het1 = 267 + integer, parameter :: rid_het10 = 268 + integer, parameter :: rid_het11 = 269 + integer, parameter :: rid_het12 = 270 + integer, parameter :: rid_het13 = 271 + integer, parameter :: rid_het14 = 272 + integer, parameter :: rid_het15 = 273 + integer, parameter :: rid_het16 = 274 + integer, parameter :: rid_het17 = 275 + integer, parameter :: rid_het2 = 276 + integer, parameter :: rid_het3 = 277 + integer, parameter :: rid_het4 = 278 + integer, parameter :: rid_het5 = 279 + integer, parameter :: rid_het6 = 280 + integer, parameter :: rid_het7 = 281 + integer, parameter :: rid_het8 = 282 + integer, parameter :: rid_het9 = 283 + integer, parameter :: rid_ag247nm = 284 + integer, parameter :: rid_ag373nm = 285 + integer, parameter :: rid_ag732nm = 286 + integer, parameter :: rid_elec1 = 287 + integer, parameter :: rid_elec2 = 288 + integer, parameter :: rid_elec3 = 289 + integer, parameter :: rid_ion_N2p_O2 = 290 + integer, parameter :: rid_ion_N2p_Oa = 291 + integer, parameter :: rid_ion_N2p_Ob = 292 + integer, parameter :: rid_ion_Np_O = 293 + integer, parameter :: rid_ion_Np_O2a = 294 + integer, parameter :: rid_ion_Np_O2b = 295 + integer, parameter :: rid_ion_O2p_N = 296 + integer, parameter :: rid_ion_O2p_N2 = 297 + integer, parameter :: rid_ion_O2p_NO = 298 + integer, parameter :: rid_ion_Op_CO2 = 299 + integer, parameter :: rid_ion_Op_N2 = 300 + integer, parameter :: rid_ion_Op_N2D = 301 + integer, parameter :: rid_ion_Op_O2 = 302 + integer, parameter :: rid_Op2D_e = 303 + integer, parameter :: rid_Op2D_N2 = 304 + integer, parameter :: rid_Op2D_O = 305 + integer, parameter :: rid_Op2D_O2 = 306 + integer, parameter :: rid_Op2P_ea = 307 + integer, parameter :: rid_Op2P_eb = 308 + integer, parameter :: rid_Op2P_N2a = 309 + integer, parameter :: rid_Op2P_N2b = 310 + integer, parameter :: rid_Op2P_O = 311 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_ma_mam5/m_spc_id.F90 b/src/chemistry/pp_waccm_ma_mam5/m_spc_id.F90 new file mode 100644 index 0000000000..6c5ec22920 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/m_spc_id.F90 @@ -0,0 +1,106 @@ + module m_spc_id + implicit none + integer, parameter :: id_bc_a1 = 1 + integer, parameter :: id_bc_a4 = 2 + integer, parameter :: id_BR = 3 + integer, parameter :: id_BRCL = 4 + integer, parameter :: id_BRO = 5 + integer, parameter :: id_BRONO2 = 6 + integer, parameter :: id_BRY = 7 + integer, parameter :: id_CCL4 = 8 + integer, parameter :: id_CF2CLBR = 9 + integer, parameter :: id_CF3BR = 10 + integer, parameter :: id_CFC11 = 11 + integer, parameter :: id_CFC113 = 12 + integer, parameter :: id_CFC114 = 13 + integer, parameter :: id_CFC115 = 14 + integer, parameter :: id_CFC12 = 15 + integer, parameter :: id_CH2BR2 = 16 + integer, parameter :: id_CH2O = 17 + integer, parameter :: id_CH3BR = 18 + integer, parameter :: id_CH3CCL3 = 19 + integer, parameter :: id_CH3CL = 20 + integer, parameter :: id_CH3O2 = 21 + integer, parameter :: id_CH3OOH = 22 + integer, parameter :: id_CH4 = 23 + integer, parameter :: id_CHBR3 = 24 + integer, parameter :: id_CL = 25 + integer, parameter :: id_CL2 = 26 + integer, parameter :: id_CL2O2 = 27 + integer, parameter :: id_CLO = 28 + integer, parameter :: id_CLONO2 = 29 + integer, parameter :: id_CLY = 30 + integer, parameter :: id_CO = 31 + integer, parameter :: id_CO2 = 32 + integer, parameter :: id_COF2 = 33 + integer, parameter :: id_COFCL = 34 + integer, parameter :: id_DMS = 35 + integer, parameter :: id_dst_a1 = 36 + integer, parameter :: id_dst_a2 = 37 + integer, parameter :: id_dst_a3 = 38 + integer, parameter :: id_F = 39 + integer, parameter :: id_H = 40 + integer, parameter :: id_H2 = 41 + integer, parameter :: id_H2402 = 42 + integer, parameter :: id_H2O2 = 43 + integer, parameter :: id_H2SO4 = 44 + integer, parameter :: id_HBR = 45 + integer, parameter :: id_HCFC141B = 46 + integer, parameter :: id_HCFC142B = 47 + integer, parameter :: id_HCFC22 = 48 + integer, parameter :: id_HCL = 49 + integer, parameter :: id_HF = 50 + integer, parameter :: id_HNO3 = 51 + integer, parameter :: id_HO2NO2 = 52 + integer, parameter :: id_HOBR = 53 + integer, parameter :: id_HOCL = 54 + integer, parameter :: id_N = 55 + integer, parameter :: id_N2O = 56 + integer, parameter :: id_N2O5 = 57 + integer, parameter :: id_ncl_a1 = 58 + integer, parameter :: id_ncl_a2 = 59 + integer, parameter :: id_ncl_a3 = 60 + integer, parameter :: id_NO = 61 + integer, parameter :: id_NO2 = 62 + integer, parameter :: id_NO3 = 63 + integer, parameter :: id_num_a1 = 64 + integer, parameter :: id_num_a2 = 65 + integer, parameter :: id_num_a3 = 66 + integer, parameter :: id_num_a4 = 67 + integer, parameter :: id_num_a5 = 68 + integer, parameter :: id_O = 69 + integer, parameter :: id_O2 = 70 + integer, parameter :: id_O3 = 71 + integer, parameter :: id_O3S = 72 + integer, parameter :: id_OCLO = 73 + integer, parameter :: id_OCS = 74 + integer, parameter :: id_pom_a1 = 75 + integer, parameter :: id_pom_a4 = 76 + integer, parameter :: id_S = 77 + integer, parameter :: id_SF6 = 78 + integer, parameter :: id_SO = 79 + integer, parameter :: id_SO2 = 80 + integer, parameter :: id_SO3 = 81 + integer, parameter :: id_so4_a1 = 82 + integer, parameter :: id_so4_a2 = 83 + integer, parameter :: id_so4_a3 = 84 + integer, parameter :: id_so4_a5 = 85 + integer, parameter :: id_soa_a1 = 86 + integer, parameter :: id_soa_a2 = 87 + integer, parameter :: id_SOAG = 88 + integer, parameter :: id_e = 89 + integer, parameter :: id_HO2 = 90 + integer, parameter :: id_N2D = 91 + integer, parameter :: id_N2p = 92 + integer, parameter :: id_NOp = 93 + integer, parameter :: id_Np = 94 + integer, parameter :: id_O1D = 95 + integer, parameter :: id_O2_1D = 96 + integer, parameter :: id_O2_1S = 97 + integer, parameter :: id_O2p = 98 + integer, parameter :: id_OH = 99 + integer, parameter :: id_Op = 100 + integer, parameter :: id_Op2D = 101 + integer, parameter :: id_Op2P = 102 + integer, parameter :: id_H2O = 103 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_ma_mam5/mo_adjrxt.F90 b/src/chemistry/pp_waccm_ma_mam5/mo_adjrxt.F90 new file mode 100644 index 0000000000..1f5d1ba14f --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/mo_adjrxt.F90 @@ -0,0 +1,232 @@ + 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(:,:, 96) = rate(:,:, 96) * inv(:,:, 2) + rate(:,:, 100) = rate(:,:, 100) * inv(:,:, 2) + rate(:,:, 104) = rate(:,:, 104) * inv(:,:, 2) + rate(:,:, 109) = rate(:,:, 109) * inv(:,:, 1) + rate(:,:, 110) = rate(:,:, 110) * inv(:,:, 1) + rate(:,:, 116) = rate(:,:, 116) * inv(:,:, 1) + rate(:,:, 126) = rate(:,:, 126) * inv(:,:, 1) + rate(:,:, 138) = rate(:,:, 138) * inv(:,:, 1) + rate(:,:, 146) = rate(:,:, 146) * inv(:,:, 1) + rate(:,:, 149) = rate(:,:, 149) * inv(:,:, 1) + rate(:,:, 150) = rate(:,:, 150) * inv(:,:, 1) + rate(:,:, 151) = rate(:,:, 151) * inv(:,:, 1) + rate(:,:, 153) = rate(:,:, 153) * inv(:,:, 1) + rate(:,:, 154) = rate(:,:, 154) * inv(:,:, 1) + rate(:,:, 169) = rate(:,:, 169) * inv(:,:, 1) + rate(:,:, 189) = rate(:,:, 189) * inv(:,:, 1) + rate(:,:, 190) = rate(:,:, 190) * inv(:,:, 1) + rate(:,:, 200) = rate(:,:, 200) * inv(:,:, 1) + rate(:,:, 251) = rate(:,:, 251) * inv(:,:, 1) + rate(:,:, 297) = rate(:,:, 297) * inv(:,:, 2) + rate(:,:, 300) = rate(:,:, 300) * inv(:,:, 2) + rate(:,:, 304) = rate(:,:, 304) * inv(:,:, 2) + rate(:,:, 309) = rate(:,:, 309) * inv(:,:, 2) + rate(:,:, 310) = rate(:,:, 310) * inv(:,:, 2) + rate(:,:, 94) = rate(:,:, 94) * m(:,:) + rate(:,:, 95) = rate(:,:, 95) * 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(:,:, 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(:,:, 117) = rate(:,:, 117) * 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(:,:, 135) = rate(:,:, 135) * m(:,:) + rate(:,:, 136) = rate(:,:, 136) * 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(:,:, 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(:,:, 172) = rate(:,:, 172) * 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(:,:, 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * 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(:,:, 252) = rate(:,:, 252) * 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(:,:, 268) = rate(:,:, 268) * m(:,:) + rate(:,:, 273) = rate(:,:, 273) * m(:,:) + rate(:,:, 274) = rate(:,:, 274) * m(:,:) + rate(:,:, 275) = rate(:,:, 275) * m(:,:) + rate(:,:, 278) = rate(:,:, 278) * m(:,:) + rate(:,:, 279) = rate(:,:, 279) * m(:,:) + rate(:,:, 280) = rate(:,:, 280) * m(:,:) + rate(:,:, 283) = rate(:,:, 283) * 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(:,:, 292) = rate(:,:, 292) * m(:,:) + rate(:,:, 293) = rate(:,:, 293) * m(:,:) + rate(:,:, 294) = rate(:,:, 294) * m(:,:) + rate(:,:, 295) = rate(:,:, 295) * m(:,:) + rate(:,:, 296) = rate(:,:, 296) * m(:,:) + rate(:,:, 298) = rate(:,:, 298) * m(:,:) + rate(:,:, 299) = rate(:,:, 299) * m(:,:) + rate(:,:, 301) = rate(:,:, 301) * m(:,:) + rate(:,:, 302) = rate(:,:, 302) * m(:,:) + rate(:,:, 303) = rate(:,:, 303) * m(:,:) + rate(:,:, 305) = rate(:,:, 305) * m(:,:) + rate(:,:, 306) = rate(:,:, 306) * m(:,:) + rate(:,:, 307) = rate(:,:, 307) * m(:,:) + rate(:,:, 308) = rate(:,:, 308) * m(:,:) + rate(:,:, 311) = rate(:,:, 311) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_ma_mam5/mo_exp_sol.F90 b/src/chemistry/pp_waccm_ma_mam5/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/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_waccm_ma_mam5/mo_imp_sol.F90 b/src/chemistry/pp_waccm_ma_mam5/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/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_waccm_ma_mam5/mo_indprd.F90 b/src/chemistry/pp_waccm_ma_mam5/mo_indprd.F90 new file mode 100644 index 0000000000..59b51ae306 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/mo_indprd.F90 @@ -0,0 +1,135 @@ + 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) = 0._r8 +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,1) = + extfrc(:,16) + prod(:,2) = + extfrc(:,3) + prod(:,97) = 0._r8 + prod(:,45) = 0._r8 + prod(:,101) = 0._r8 + prod(:,62) = 0._r8 + prod(:,3) = 0._r8 + prod(:,27) = 0._r8 + prod(:,34) = 0._r8 + prod(:,35) = 0._r8 + prod(:,29) = 0._r8 + prod(:,36) = 0._r8 + prod(:,30) = 0._r8 + prod(:,37) = 0._r8 + prod(:,31) = 0._r8 + prod(:,58) = 0._r8 + prod(:,86) = 0._r8 + prod(:,63) = 0._r8 + prod(:,32) = 0._r8 + prod(:,54) = 0._r8 + prod(:,82) = 0._r8 + prod(:,55) = 0._r8 + prod(:,81) = 0._r8 + prod(:,56) = 0._r8 + prod(:,96) = 0._r8 + prod(:,38) = 0._r8 + prod(:,26) = 0._r8 + prod(:,91) = 0._r8 + prod(:,75) = 0._r8 + prod(:,4) = 0._r8 + prod(:,72) = + extfrc(:,12) + prod(:,61) = 0._r8 + prod(:,41) = 0._r8 + prod(:,43) = 0._r8 + prod(:,51) = + extfrc(:,2) + prod(:,5) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,73) = 0._r8 + prod(:,84) = 0._r8 + prod(:,99) = 0._r8 + prod(:,28) = 0._r8 + prod(:,65) = 0._r8 + prod(:,33) = 0._r8 + prod(:,69) = 0._r8 + prod(:,42) = 0._r8 + prod(:,44) = 0._r8 + prod(:,48) = 0._r8 + prod(:,85) = 0._r8 + prod(:,49) = 0._r8 + prod(:,100) = 0._r8 + prod(:,57) = 0._r8 + prod(:,68) = 0._r8 + prod(:,70) = 0._r8 + prod(:,78) = (rxt(:,64) +.800_r8*rxt(:,66) +.800_r8*rxt(:,68) +rxt(:,70)) & + + extfrc(:,17) + prod(:,46) = 0._r8 + prod(:,50) = 0._r8 + prod(:,8) = 0._r8 + prod(:,9) = 0._r8 + prod(:,10) = 0._r8 + prod(:,95) = + extfrc(:,13) + prod(:,92) = + extfrc(:,14) + prod(:,90) = 0._r8 + prod(:,11) = + extfrc(:,4) + prod(:,12) = + extfrc(:,5) + prod(:,13) = 0._r8 + prod(:,14) = + extfrc(:,6) + prod(:,15) = + extfrc(:,7) + prod(:,93) = 0._r8 + prod(:,87) = 0._r8 + prod(:,88) = 0._r8 + prod(:,52) = 0._r8 + prod(:,53) = 0._r8 + prod(:,16) = + extfrc(:,8) + prod(:,17) = + extfrc(:,9) + prod(:,66) = 0._r8 + prod(:,18) = 0._r8 + prod(:,83) = 0._r8 + prod(:,74) = + extfrc(:,15) + prod(:,47) = 0._r8 + prod(:,19) = + extfrc(:,10) + prod(:,20) = + extfrc(:,1) + prod(:,21) = 0._r8 + prod(:,22) = + extfrc(:,11) + prod(:,23) = 0._r8 + prod(:,24) = 0._r8 + prod(:,25) = 0._r8 + prod(:,76) = (rxt(:,63) +rxt(:,64) +rxt(:,65) +rxt(:,67) +rxt(:,69) + & + rxt(:,70)) + extfrc(:,21) + prod(:,89) = 0._r8 + prod(:,77) = (rxt(:,65) +1.200_r8*rxt(:,66) +1.200_r8*rxt(:,68) +rxt(:,69)) & + + extfrc(:,18) + prod(:,64) = (rxt(:,63) +rxt(:,67)) + extfrc(:,19) + prod(:,67) = 0._r8 + prod(:,71) = (rxt(:,64) +rxt(:,65) +rxt(:,69) +rxt(:,70)) + extfrc(:,22) + prod(:,94) = 0._r8 + prod(:,39) = 0._r8 + prod(:,40) = 0._r8 + prod(:,79) = + extfrc(:,23) + prod(:,98) = + extfrc(:,24) + prod(:,80) = + extfrc(:,20) + prod(:,60) = 0._r8 + prod(:,59) = 0._r8 + prod(:,102) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_ma_mam5/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_ma_mam5/mo_lin_matrix.F90 new file mode 100644 index 0000000000..14f1d2a1ef --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/mo_lin_matrix.F90 @@ -0,0 +1,345 @@ + 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,808) = -( het_rates(k,3) ) + mat(k,102) = rxt(k,26) + mat(k,927) = rxt(k,27) + mat(k,207) = rxt(k,29) + mat(k,59) = rxt(k,31) + mat(k,64) = rxt(k,32) + mat(k,178) = 2.000_r8*rxt(k,38) + mat(k,216) = rxt(k,39) + mat(k,165) = 3.000_r8*rxt(k,42) + mat(k,35) = 2.000_r8*rxt(k,50) + mat(k,260) = rxt(k,51) + mat(k,252) = rxt(k,57) + mat(k,100) = -( rxt(k,26) + het_rates(k,4) ) + mat(k,931) = -( rxt(k,27) + het_rates(k,5) ) + mat(k,209) = rxt(k,28) + mat(k,202) = -( rxt(k,28) + rxt(k,29) + rxt(k,269) + rxt(k,272) + rxt(k,277) & + + het_rates(k,6) ) + mat(k,3) = -( het_rates(k,7) ) + mat(k,29) = -( rxt(k,30) + het_rates(k,8) ) + mat(k,55) = -( rxt(k,31) + het_rates(k,9) ) + mat(k,60) = -( rxt(k,32) + het_rates(k,10) ) + mat(k,36) = -( rxt(k,33) + het_rates(k,11) ) + mat(k,65) = -( rxt(k,34) + het_rates(k,12) ) + mat(k,40) = -( rxt(k,35) + het_rates(k,13) ) + mat(k,70) = -( rxt(k,36) + het_rates(k,14) ) + mat(k,44) = -( rxt(k,37) + het_rates(k,15) ) + mat(k,174) = -( rxt(k,38) + het_rates(k,16) ) + mat(k,475) = -( rxt(k,20) + rxt(k,21) + het_rates(k,17) ) + mat(k,158) = rxt(k,22) + mat(k,397) = .180_r8*rxt(k,24) + mat(k,210) = -( rxt(k,39) + het_rates(k,18) ) + mat(k,48) = -( rxt(k,40) + het_rates(k,19) ) + mat(k,147) = -( rxt(k,41) + het_rates(k,20) ) + mat(k,411) = -( het_rates(k,21) ) + mat(k,394) = rxt(k,23) + mat(k,211) = rxt(k,39) + mat(k,149) = rxt(k,41) + mat(k,155) = -( rxt(k,22) + het_rates(k,22) ) + mat(k,393) = -( rxt(k,23) + rxt(k,24) + het_rates(k,23) ) + mat(k,161) = -( rxt(k,42) + het_rates(k,24) ) + mat(k,785) = -( het_rates(k,25) ) + mat(k,101) = rxt(k,26) + mat(k,31) = 4.000_r8*rxt(k,30) + mat(k,58) = rxt(k,31) + mat(k,39) = 2.000_r8*rxt(k,33) + mat(k,69) = 2.000_r8*rxt(k,34) + mat(k,43) = 2.000_r8*rxt(k,35) + mat(k,74) = rxt(k,36) + mat(k,47) = 2.000_r8*rxt(k,37) + mat(k,49) = 3.000_r8*rxt(k,40) + mat(k,152) = rxt(k,41) + mat(k,76) = 2.000_r8*rxt(k,43) + mat(k,28) = 2.000_r8*rxt(k,44) + mat(k,615) = rxt(k,45) + mat(k,314) = rxt(k,46) + mat(k,93) = rxt(k,49) + mat(k,88) = rxt(k,52) + mat(k,98) = rxt(k,53) + mat(k,116) = rxt(k,54) + mat(k,462) = rxt(k,55) + mat(k,269) = rxt(k,58) + mat(k,75) = -( rxt(k,43) + het_rates(k,26) ) + mat(k,26) = -( rxt(k,44) + rxt(k,190) + het_rates(k,27) ) + mat(k,610) = -( rxt(k,45) + het_rates(k,28) ) + mat(k,311) = rxt(k,47) + mat(k,137) = rxt(k,59) + mat(k,27) = 2.000_r8*rxt(k,190) + mat(k,308) = -( rxt(k,46) + rxt(k,47) + rxt(k,271) + rxt(k,276) + rxt(k,282) & + + het_rates(k,29) ) + mat(k,4) = -( het_rates(k,30) ) + mat(k,282) = -( het_rates(k,31) ) + mat(k,470) = rxt(k,20) + rxt(k,21) + mat(k,389) = .380_r8*rxt(k,24) + mat(k,197) = rxt(k,25) + rxt(k,61) + mat(k,141) = rxt(k,88) + mat(k,196) = -( rxt(k,25) + rxt(k,61) + het_rates(k,32) ) + mat(k,388) = .440_r8*rxt(k,24) + mat(k,82) = -( rxt(k,48) + het_rates(k,33) ) + mat(k,56) = rxt(k,31) + mat(k,61) = rxt(k,32) + mat(k,66) = rxt(k,34) + mat(k,41) = 2.000_r8*rxt(k,35) + mat(k,71) = 2.000_r8*rxt(k,36) + mat(k,45) = rxt(k,37) + mat(k,33) = 2.000_r8*rxt(k,50) + mat(k,94) = rxt(k,53) + mat(k,112) = rxt(k,54) + mat(k,90) = -( rxt(k,49) + het_rates(k,34) ) + mat(k,37) = rxt(k,33) + mat(k,67) = rxt(k,34) + mat(k,86) = rxt(k,52) + mat(k,128) = -( het_rates(k,35) ) + mat(k,5) = -( het_rates(k,36) ) + mat(k,6) = -( het_rates(k,37) ) + mat(k,7) = -( het_rates(k,38) ) + mat(k,290) = -( het_rates(k,39) ) + mat(k,62) = rxt(k,32) + mat(k,72) = rxt(k,36) + mat(k,83) = 2.000_r8*rxt(k,48) + mat(k,91) = rxt(k,49) + mat(k,120) = rxt(k,56) + mat(k,439) = -( het_rates(k,40) ) + mat(k,941) = 2.000_r8*rxt(k,2) + rxt(k,3) + mat(k,473) = 2.000_r8*rxt(k,20) + mat(k,157) = rxt(k,22) + mat(k,395) = rxt(k,23) + .330_r8*rxt(k,24) + mat(k,257) = rxt(k,51) + mat(k,452) = rxt(k,55) + mat(k,121) = rxt(k,56) + mat(k,882) = -( het_rates(k,41) ) + mat(k,956) = rxt(k,1) + mat(k,488) = rxt(k,21) + mat(k,407) = 1.440_r8*rxt(k,24) + mat(k,32) = -( rxt(k,50) + het_rates(k,42) ) + mat(k,228) = -( rxt(k,4) + het_rates(k,43) ) + mat(k,545) = .500_r8*rxt(k,263) + mat(k,52) = -( rxt(k,87) + het_rates(k,44) ) + mat(k,256) = -( rxt(k,51) + het_rates(k,45) ) + mat(k,85) = -( rxt(k,52) + het_rates(k,46) ) + mat(k,95) = -( rxt(k,53) + het_rates(k,47) ) + mat(k,113) = -( rxt(k,54) + het_rates(k,48) ) + mat(k,453) = -( rxt(k,55) + het_rates(k,49) ) + mat(k,119) = -( rxt(k,56) + het_rates(k,50) ) + mat(k,906) = -( rxt(k,9) + het_rates(k,51) ) + mat(k,127) = 2.000_r8*rxt(k,264) + 2.000_r8*rxt(k,267) + 2.000_r8*rxt(k,270) & + + 2.000_r8*rxt(k,281) + mat(k,648) = .500_r8*rxt(k,265) + mat(k,591) = rxt(k,266) + mat(k,208) = rxt(k,269) + rxt(k,272) + rxt(k,277) + mat(k,316) = rxt(k,271) + rxt(k,276) + rxt(k,282) + mat(k,167) = -( rxt(k,10) + rxt(k,11) + rxt(k,153) + het_rates(k,52) ) + mat(k,248) = -( rxt(k,57) + het_rates(k,53) ) + mat(k,203) = rxt(k,269) + rxt(k,272) + rxt(k,277) + mat(k,265) = -( rxt(k,58) + het_rates(k,54) ) + mat(k,307) = rxt(k,271) + rxt(k,276) + rxt(k,282) + mat(k,347) = -( rxt(k,62) + het_rates(k,55) ) + mat(k,738) = rxt(k,15) + mat(k,376) = rxt(k,300) + mat(k,103) = -( rxt(k,12) + het_rates(k,56) ) + mat(k,122) = -( rxt(k,13) + rxt(k,14) + rxt(k,154) + rxt(k,264) + rxt(k,267) & + + rxt(k,270) + rxt(k,281) + het_rates(k,57) ) + mat(k,8) = -( het_rates(k,58) ) + mat(k,9) = -( het_rates(k,59) ) + mat(k,10) = -( het_rates(k,60) ) + mat(k,752) = -( rxt(k,15) + rxt(k,16) + het_rates(k,61) ) + mat(k,126) = rxt(k,14) + mat(k,643) = rxt(k,17) + .500_r8*rxt(k,265) + mat(k,586) = rxt(k,19) + mat(k,368) = rxt(k,297) + mat(k,187) = rxt(k,310) + mat(k,640) = -( rxt(k,17) + rxt(k,265) + het_rates(k,62) ) + mat(k,898) = rxt(k,9) + mat(k,171) = rxt(k,11) + rxt(k,153) + mat(k,124) = rxt(k,13) + rxt(k,154) + mat(k,583) = rxt(k,18) + mat(k,205) = rxt(k,28) + mat(k,312) = rxt(k,47) + mat(k,581) = -( rxt(k,18) + rxt(k,19) + rxt(k,266) + het_rates(k,63) ) + mat(k,170) = rxt(k,10) + mat(k,123) = rxt(k,13) + rxt(k,14) + rxt(k,154) + mat(k,204) = rxt(k,29) + mat(k,310) = rxt(k,46) + mat(k,11) = -( het_rates(k,64) ) + mat(k,12) = -( het_rates(k,65) ) + mat(k,13) = -( het_rates(k,66) ) + mat(k,14) = -( het_rates(k,67) ) + mat(k,15) = -( het_rates(k,68) ) + mat(k,683) = -( rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & + + rxt(k,76) + het_rates(k,69) ) + mat(k,950) = rxt(k,2) + mat(k,513) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,79) + rxt(k,81) & + + 2.000_r8*rxt(k,82) + 2.000_r8*rxt(k,83) + rxt(k,84) + rxt(k,85) & + + rxt(k,86) + mat(k,534) = rxt(k,8) + mat(k,125) = rxt(k,14) + mat(k,750) = rxt(k,15) + mat(k,641) = rxt(k,17) + mat(k,584) = rxt(k,18) + mat(k,402) = .180_r8*rxt(k,24) + mat(k,201) = rxt(k,25) + rxt(k,61) + mat(k,923) = rxt(k,27) + mat(k,612) = rxt(k,45) + mat(k,138) = rxt(k,59) + mat(k,432) = rxt(k,89) + mat(k,303) = rxt(k,90) + mat(k,110) = rxt(k,91) + mat(k,725) = rxt(k,96) + mat(k,193) = rxt(k,304) + mat(k,186) = rxt(k,309) + mat(k,508) = -( rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,78) + rxt(k,79) & + + rxt(k,80) + rxt(k,81) + rxt(k,82) + rxt(k,83) + rxt(k,84) & + + rxt(k,85) + rxt(k,86) + het_rates(k,70) ) + mat(k,528) = rxt(k,8) + mat(k,578) = rxt(k,19) + mat(k,78) = rxt(k,92) + rxt(k,100) + mat(k,81) = rxt(k,93) + mat(k,529) = -( rxt(k,7) + rxt(k,8) + het_rates(k,71) ) + mat(k,134) = -( rxt(k,59) + het_rates(k,73) ) + mat(k,139) = -( rxt(k,88) + het_rates(k,74) ) + 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,16) = -( het_rates(k,75) ) + mat(k,17) = -( het_rates(k,76) ) + mat(k,235) = -( het_rates(k,77) ) + mat(k,140) = rxt(k,88) + mat(k,423) = rxt(k,89) + mat(k,18) = -( rxt(k,60) + het_rates(k,78) ) + mat(k,425) = -( rxt(k,89) + het_rates(k,79) ) + mat(k,301) = rxt(k,90) + mat(k,300) = -( rxt(k,90) + het_rates(k,80) ) + mat(k,109) = rxt(k,91) + mat(k,108) = -( rxt(k,91) + het_rates(k,81) ) + mat(k,53) = rxt(k,87) + mat(k,19) = -( het_rates(k,82) ) + mat(k,20) = -( het_rates(k,83) ) + mat(k,21) = -( het_rates(k,84) ) + mat(k,22) = -( het_rates(k,85) ) + mat(k,23) = -( het_rates(k,86) ) + mat(k,24) = -( het_rates(k,87) ) + mat(k,25) = -( het_rates(k,88) ) + mat(k,323) = -( het_rates(k,89) ) + mat(k,736) = rxt(k,16) + mat(k,345) = rxt(k,62) + mat(k,668) = rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & + + rxt(k,76) + mat(k,501) = rxt(k,77) + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) & + + rxt(k,84) + rxt(k,85) + rxt(k,86) + mat(k,555) = -( rxt(k,263) + het_rates(k,90) ) + mat(k,169) = rxt(k,11) + rxt(k,153) + mat(k,334) = -( het_rates(k,91) ) + mat(k,219) = -( het_rates(k,92) ) + mat(k,189) = rxt(k,304) + mat(k,183) = rxt(k,309) + mat(k,242) = -( het_rates(k,93) ) + mat(k,735) = rxt(k,16) + mat(k,357) = rxt(k,297) + mat(k,371) = rxt(k,300) + mat(k,273) = -( het_rates(k,94) ) + mat(k,344) = rxt(k,62) + mat(k,184) = rxt(k,310) + mat(k,726) = -( rxt(k,96) + het_rates(k,95) ) + mat(k,951) = rxt(k,1) + mat(k,514) = rxt(k,6) + mat(k,535) = rxt(k,7) + mat(k,105) = rxt(k,12) + mat(k,77) = -( rxt(k,92) + rxt(k,100) + het_rates(k,96) ) + mat(k,522) = rxt(k,7) + mat(k,79) = rxt(k,104) + mat(k,80) = -( rxt(k,93) + rxt(k,104) + het_rates(k,97) ) + mat(k,361) = -( rxt(k,297) + het_rates(k,98) ) + mat(k,504) = rxt(k,78) + rxt(k,80) + mat(k,858) = -( het_rates(k,99) ) + mat(k,955) = rxt(k,3) + mat(k,233) = 2.000_r8*rxt(k,4) + mat(k,904) = rxt(k,9) + mat(k,172) = rxt(k,10) + mat(k,159) = rxt(k,22) + mat(k,406) = .330_r8*rxt(k,24) + mat(k,253) = rxt(k,57) + mat(k,270) = rxt(k,58) + mat(k,646) = .500_r8*rxt(k,265) + mat(k,378) = -( rxt(k,300) + het_rates(k,100) ) + mat(k,672) = rxt(k,73) + rxt(k,74) + mat(k,505) = rxt(k,79) + rxt(k,81) + mat(k,185) = rxt(k,284) + mat(k,191) = rxt(k,285) + mat(k,188) = -( rxt(k,285) + rxt(k,304) + het_rates(k,101) ) + mat(k,655) = rxt(k,75) + rxt(k,76) + mat(k,495) = rxt(k,85) + rxt(k,86) + mat(k,182) = rxt(k,286) + mat(k,181) = -( rxt(k,284) + rxt(k,286) + rxt(k,309) + rxt(k,310) & + + het_rates(k,102) ) + mat(k,654) = rxt(k,71) + rxt(k,72) + mat(k,494) = rxt(k,77) + rxt(k,84) + mat(k,959) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,103) ) + mat(k,409) = .050_r8*rxt(k,24) + mat(k,54) = rxt(k,87) + 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_waccm_ma_mam5/mo_lu_factor.F90 b/src/chemistry/pp_waccm_ma_mam5/mo_lu_factor.F90 new file mode 100644 index 0000000000..8ef84fb84f --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/mo_lu_factor.F90 @@ -0,0 +1,3969 @@ + 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) = 1._r8 / lu(k,10) + 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) = lu(k,27) * lu(k,26) + lu(k,28) = lu(k,28) * lu(k,26) + lu(k,610) = lu(k,610) - lu(k,27) * lu(k,594) + lu(k,615) = lu(k,615) - lu(k,28) * lu(k,594) + lu(k,29) = 1._r8 / lu(k,29) + lu(k,30) = lu(k,30) * lu(k,29) + lu(k,31) = lu(k,31) * lu(k,29) + lu(k,726) = lu(k,726) - lu(k,30) * lu(k,693) + lu(k,728) = lu(k,728) - lu(k,31) * lu(k,693) + lu(k,32) = 1._r8 / lu(k,32) + lu(k,33) = lu(k,33) * lu(k,32) + lu(k,34) = lu(k,34) * lu(k,32) + lu(k,35) = lu(k,35) * lu(k,32) + lu(k,703) = lu(k,703) - lu(k,33) * lu(k,694) + lu(k,726) = lu(k,726) - lu(k,34) * lu(k,694) + lu(k,729) = lu(k,729) - lu(k,35) * lu(k,694) + 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,39) = lu(k,39) * lu(k,36) + lu(k,705) = lu(k,705) - lu(k,37) * lu(k,695) + lu(k,726) = lu(k,726) - lu(k,38) * lu(k,695) + lu(k,728) = lu(k,728) - lu(k,39) * lu(k,695) + lu(k,40) = 1._r8 / lu(k,40) + lu(k,41) = lu(k,41) * lu(k,40) + lu(k,42) = lu(k,42) * lu(k,40) + lu(k,43) = lu(k,43) * lu(k,40) + lu(k,703) = lu(k,703) - lu(k,41) * lu(k,696) + lu(k,726) = lu(k,726) - lu(k,42) * lu(k,696) + lu(k,728) = lu(k,728) - lu(k,43) * lu(k,696) + lu(k,44) = 1._r8 / lu(k,44) + lu(k,45) = lu(k,45) * lu(k,44) + lu(k,46) = lu(k,46) * lu(k,44) + lu(k,47) = lu(k,47) * lu(k,44) + lu(k,703) = lu(k,703) - lu(k,45) * lu(k,697) + lu(k,726) = lu(k,726) - lu(k,46) * lu(k,697) + lu(k,728) = lu(k,728) - lu(k,47) * lu(k,697) + 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,51) = lu(k,51) * lu(k,48) + lu(k,856) = lu(k,856) - lu(k,49) * lu(k,814) + lu(k,858) = lu(k,858) - lu(k,50) * lu(k,814) + lu(k,862) = lu(k,862) - lu(k,51) * lu(k,814) + 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,52) = 1._r8 / lu(k,52) + lu(k,53) = lu(k,53) * lu(k,52) + lu(k,54) = lu(k,54) * lu(k,52) + lu(k,108) = lu(k,108) - lu(k,53) * lu(k,107) + lu(k,111) = lu(k,111) - lu(k,54) * lu(k,107) + lu(k,934) = lu(k,934) - lu(k,53) * lu(k,933) + lu(k,959) = lu(k,959) - lu(k,54) * lu(k,933) + lu(k,55) = 1._r8 / lu(k,55) + lu(k,56) = lu(k,56) * lu(k,55) + lu(k,57) = lu(k,57) * lu(k,55) + lu(k,58) = lu(k,58) * lu(k,55) + lu(k,59) = lu(k,59) * lu(k,55) + lu(k,703) = lu(k,703) - lu(k,56) * lu(k,698) + lu(k,726) = lu(k,726) - lu(k,57) * lu(k,698) + lu(k,728) = lu(k,728) - lu(k,58) * lu(k,698) + lu(k,729) = lu(k,729) - lu(k,59) * lu(k,698) + 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,63) = lu(k,63) * lu(k,60) + lu(k,64) = lu(k,64) * lu(k,60) + lu(k,703) = lu(k,703) - lu(k,61) * lu(k,699) + lu(k,713) = lu(k,713) - lu(k,62) * lu(k,699) + lu(k,726) = lu(k,726) - lu(k,63) * lu(k,699) + lu(k,729) = lu(k,729) - lu(k,64) * lu(k,699) + lu(k,65) = 1._r8 / lu(k,65) + lu(k,66) = lu(k,66) * lu(k,65) + lu(k,67) = lu(k,67) * lu(k,65) + lu(k,68) = lu(k,68) * lu(k,65) + lu(k,69) = lu(k,69) * lu(k,65) + lu(k,703) = lu(k,703) - lu(k,66) * lu(k,700) + lu(k,705) = lu(k,705) - lu(k,67) * lu(k,700) + lu(k,726) = lu(k,726) - lu(k,68) * lu(k,700) + lu(k,728) = lu(k,728) - lu(k,69) * lu(k,700) + lu(k,70) = 1._r8 / lu(k,70) + lu(k,71) = lu(k,71) * lu(k,70) + lu(k,72) = lu(k,72) * lu(k,70) + lu(k,73) = lu(k,73) * lu(k,70) + lu(k,74) = lu(k,74) * lu(k,70) + lu(k,703) = lu(k,703) - lu(k,71) * lu(k,701) + lu(k,713) = lu(k,713) - lu(k,72) * lu(k,701) + lu(k,726) = lu(k,726) - lu(k,73) * lu(k,701) + lu(k,728) = lu(k,728) - lu(k,74) * lu(k,701) + lu(k,75) = 1._r8 / lu(k,75) + lu(k,76) = lu(k,76) * lu(k,75) + lu(k,269) = lu(k,269) - lu(k,76) * lu(k,264) + lu(k,314) = lu(k,314) - lu(k,76) * lu(k,306) + lu(k,462) = lu(k,462) - lu(k,76) * lu(k,447) + lu(k,615) = lu(k,615) - lu(k,76) * lu(k,595) + lu(k,785) = lu(k,785) - lu(k,76) * lu(k,760) + lu(k,77) = 1._r8 / lu(k,77) + lu(k,78) = lu(k,78) * lu(k,77) + lu(k,81) = lu(k,81) - lu(k,78) * lu(k,79) + lu(k,200) = - lu(k,78) * lu(k,194) + lu(k,508) = lu(k,508) - lu(k,78) * lu(k,492) + lu(k,528) = lu(k,528) - lu(k,78) * lu(k,522) + lu(k,677) = lu(k,677) - lu(k,78) * lu(k,651) + lu(k,80) = 1._r8 / lu(k,80) + lu(k,81) = lu(k,81) * lu(k,80) + lu(k,200) = lu(k,200) - lu(k,81) * lu(k,195) + lu(k,508) = lu(k,508) - lu(k,81) * lu(k,493) + lu(k,528) = lu(k,528) - lu(k,81) * lu(k,523) + lu(k,677) = lu(k,677) - lu(k,81) * lu(k,652) + lu(k,719) = lu(k,719) - lu(k,81) * lu(k,702) + lu(k,82) = 1._r8 / lu(k,82) + lu(k,83) = lu(k,83) * lu(k,82) + lu(k,84) = lu(k,84) * lu(k,82) + lu(k,96) = - lu(k,83) * lu(k,94) + lu(k,97) = lu(k,97) - lu(k,84) * lu(k,94) + lu(k,114) = - lu(k,83) * lu(k,112) + lu(k,115) = lu(k,115) - lu(k,84) * lu(k,112) + lu(k,713) = lu(k,713) - lu(k,83) * lu(k,703) + lu(k,726) = lu(k,726) - lu(k,84) * lu(k,703) + lu(k,835) = - lu(k,83) * lu(k,815) + lu(k,854) = - lu(k,84) * lu(k,815) + lu(k,85) = 1._r8 / lu(k,85) + lu(k,86) = lu(k,86) * lu(k,85) + lu(k,87) = lu(k,87) * lu(k,85) + lu(k,88) = lu(k,88) * lu(k,85) + lu(k,89) = lu(k,89) * lu(k,85) + lu(k,705) = lu(k,705) - lu(k,86) * lu(k,704) + lu(k,726) = lu(k,726) - lu(k,87) * lu(k,704) + lu(k,728) = lu(k,728) - lu(k,88) * lu(k,704) + lu(k,730) = lu(k,730) - lu(k,89) * lu(k,704) + lu(k,817) = lu(k,817) - lu(k,86) * lu(k,816) + lu(k,854) = lu(k,854) - lu(k,87) * lu(k,816) + lu(k,856) = lu(k,856) - lu(k,88) * lu(k,816) + lu(k,858) = lu(k,858) - lu(k,89) * lu(k,816) + lu(k,90) = 1._r8 / lu(k,90) + lu(k,91) = lu(k,91) * lu(k,90) + lu(k,92) = lu(k,92) * lu(k,90) + lu(k,93) = lu(k,93) * lu(k,90) + lu(k,713) = lu(k,713) - lu(k,91) * lu(k,705) + lu(k,726) = lu(k,726) - lu(k,92) * lu(k,705) + lu(k,728) = lu(k,728) - lu(k,93) * lu(k,705) + lu(k,835) = lu(k,835) - lu(k,91) * lu(k,817) + lu(k,854) = lu(k,854) - lu(k,92) * lu(k,817) + lu(k,856) = lu(k,856) - lu(k,93) * lu(k,817) + lu(k,95) = 1._r8 / lu(k,95) + lu(k,96) = lu(k,96) * lu(k,95) + lu(k,97) = lu(k,97) * lu(k,95) + lu(k,98) = lu(k,98) * lu(k,95) + lu(k,99) = lu(k,99) * lu(k,95) + lu(k,713) = lu(k,713) - lu(k,96) * lu(k,706) + lu(k,726) = lu(k,726) - lu(k,97) * lu(k,706) + lu(k,728) = lu(k,728) - lu(k,98) * lu(k,706) + lu(k,730) = lu(k,730) - lu(k,99) * lu(k,706) + lu(k,835) = lu(k,835) - lu(k,96) * lu(k,818) + lu(k,854) = lu(k,854) - lu(k,97) * lu(k,818) + lu(k,856) = lu(k,856) - lu(k,98) * lu(k,818) + lu(k,858) = lu(k,858) - lu(k,99) * lu(k,818) + 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,251) = - lu(k,101) * lu(k,247) + lu(k,252) = lu(k,252) - lu(k,102) * lu(k,247) + lu(k,462) = lu(k,462) - lu(k,101) * lu(k,448) + lu(k,463) = - lu(k,102) * lu(k,448) + lu(k,615) = lu(k,615) - lu(k,101) * lu(k,596) + lu(k,616) = lu(k,616) - lu(k,102) * lu(k,596) + lu(k,926) = lu(k,926) - lu(k,101) * lu(k,909) + lu(k,927) = lu(k,927) - lu(k,102) * lu(k,909) + 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,351) = lu(k,351) - lu(k,104) * lu(k,342) + lu(k,354) = - lu(k,105) * lu(k,342) + lu(k,355) = lu(k,355) - lu(k,106) * lu(k,342) + lu(k,635) = lu(k,635) - lu(k,104) * lu(k,622) + lu(k,642) = - lu(k,105) * lu(k,622) + lu(k,643) = lu(k,643) - lu(k,106) * lu(k,622) + lu(k,719) = lu(k,719) - lu(k,104) * lu(k,707) + lu(k,726) = lu(k,726) - lu(k,105) * lu(k,707) + lu(k,727) = lu(k,727) - lu(k,106) * lu(k,707) + 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,111) = lu(k,111) * lu(k,108) + lu(k,300) = lu(k,300) - lu(k,109) * lu(k,299) + lu(k,303) = lu(k,303) - lu(k,110) * lu(k,299) + lu(k,305) = - lu(k,111) * lu(k,299) + lu(k,836) = lu(k,836) - lu(k,109) * lu(k,819) + lu(k,853) = lu(k,853) - lu(k,110) * lu(k,819) + lu(k,862) = lu(k,862) - lu(k,111) * lu(k,819) + lu(k,937) = - lu(k,109) * lu(k,934) + lu(k,950) = lu(k,950) - lu(k,110) * lu(k,934) + lu(k,959) = lu(k,959) - lu(k,111) * lu(k,934) + lu(k,113) = 1._r8 / lu(k,113) + lu(k,114) = lu(k,114) * lu(k,113) + lu(k,115) = lu(k,115) * lu(k,113) + lu(k,116) = lu(k,116) * lu(k,113) + lu(k,117) = lu(k,117) * lu(k,113) + lu(k,118) = lu(k,118) * lu(k,113) + lu(k,713) = lu(k,713) - lu(k,114) * lu(k,708) + lu(k,726) = lu(k,726) - lu(k,115) * lu(k,708) + lu(k,728) = lu(k,728) - lu(k,116) * lu(k,708) + lu(k,730) = lu(k,730) - lu(k,117) * lu(k,708) + lu(k,734) = lu(k,734) - lu(k,118) * lu(k,708) + lu(k,835) = lu(k,835) - lu(k,114) * lu(k,820) + lu(k,854) = lu(k,854) - lu(k,115) * lu(k,820) + lu(k,856) = lu(k,856) - lu(k,116) * lu(k,820) + lu(k,858) = lu(k,858) - lu(k,117) * lu(k,820) + lu(k,862) = lu(k,862) - lu(k,118) * lu(k,820) + lu(k,119) = 1._r8 / lu(k,119) + lu(k,120) = lu(k,120) * lu(k,119) + lu(k,121) = lu(k,121) * lu(k,119) + lu(k,290) = lu(k,290) - lu(k,120) * lu(k,289) + lu(k,293) = lu(k,293) - lu(k,121) * lu(k,289) + lu(k,390) = lu(k,390) - lu(k,120) * lu(k,387) + lu(k,395) = lu(k,395) - lu(k,121) * lu(k,387) + lu(k,864) = lu(k,864) - lu(k,120) * lu(k,863) + lu(k,867) = lu(k,867) - lu(k,121) * lu(k,863) + lu(k,887) = lu(k,887) - lu(k,120) * lu(k,886) + lu(k,890) = - lu(k,121) * lu(k,886) + lu(k,936) = lu(k,936) - lu(k,120) * lu(k,935) + lu(k,941) = lu(k,941) - lu(k,121) * lu(k,935) + lu(k,122) = 1._r8 / lu(k,122) + lu(k,123) = lu(k,123) * lu(k,122) + lu(k,124) = lu(k,124) * lu(k,122) + lu(k,125) = lu(k,125) * lu(k,122) + lu(k,126) = lu(k,126) * lu(k,122) + lu(k,127) = lu(k,127) * lu(k,122) + lu(k,581) = lu(k,581) - lu(k,123) * lu(k,569) + lu(k,583) = lu(k,583) - lu(k,124) * lu(k,569) + lu(k,584) = lu(k,584) - lu(k,125) * lu(k,569) + lu(k,586) = lu(k,586) - lu(k,126) * lu(k,569) + lu(k,591) = lu(k,591) - lu(k,127) * lu(k,569) + lu(k,638) = lu(k,638) - lu(k,123) * lu(k,623) + lu(k,640) = lu(k,640) - lu(k,124) * lu(k,623) + lu(k,641) = lu(k,641) - lu(k,125) * lu(k,623) + lu(k,643) = lu(k,643) - lu(k,126) * lu(k,623) + lu(k,648) = lu(k,648) - lu(k,127) * lu(k,623) + lu(k,128) = 1._r8 / lu(k,128) + lu(k,129) = lu(k,129) * lu(k,128) + lu(k,130) = lu(k,130) * lu(k,128) + lu(k,131) = lu(k,131) * lu(k,128) + lu(k,132) = lu(k,132) * lu(k,128) + lu(k,133) = lu(k,133) * lu(k,128) + lu(k,572) = lu(k,572) - lu(k,129) * lu(k,570) + lu(k,580) = lu(k,580) - lu(k,130) * lu(k,570) + lu(k,581) = lu(k,581) - lu(k,131) * lu(k,570) + lu(k,589) = lu(k,589) - lu(k,132) * lu(k,570) + lu(k,591) = lu(k,591) - lu(k,133) * lu(k,570) + lu(k,836) = lu(k,836) - lu(k,129) * lu(k,821) + lu(k,849) = lu(k,849) - lu(k,130) * lu(k,821) + lu(k,850) = lu(k,850) - lu(k,131) * lu(k,821) + lu(k,858) = lu(k,858) - lu(k,132) * lu(k,821) + lu(k,860) = lu(k,860) - lu(k,133) * lu(k,821) + lu(k,134) = 1._r8 / lu(k,134) + lu(k,135) = lu(k,135) * lu(k,134) + lu(k,136) = lu(k,136) * lu(k,134) + lu(k,137) = lu(k,137) * lu(k,134) + lu(k,138) = lu(k,138) * lu(k,134) + lu(k,424) = lu(k,424) - lu(k,135) * lu(k,422) + lu(k,425) = lu(k,425) - lu(k,136) * lu(k,422) + lu(k,430) = lu(k,430) - lu(k,137) * lu(k,422) + lu(k,432) = lu(k,432) - lu(k,138) * lu(k,422) + lu(k,599) = lu(k,599) - lu(k,135) * lu(k,597) + lu(k,602) = lu(k,602) - lu(k,136) * lu(k,597) + lu(k,610) = lu(k,610) - lu(k,137) * lu(k,597) + lu(k,612) = lu(k,612) - lu(k,138) * lu(k,597) + lu(k,913) = lu(k,913) - lu(k,135) * lu(k,910) + lu(k,914) = lu(k,914) - lu(k,136) * lu(k,910) + lu(k,921) = lu(k,921) - lu(k,137) * lu(k,910) + lu(k,923) = lu(k,923) - lu(k,138) * lu(k,910) + lu(k,139) = 1._r8 / lu(k,139) + lu(k,140) = lu(k,140) * lu(k,139) + lu(k,141) = lu(k,141) * lu(k,139) + lu(k,142) = lu(k,142) * lu(k,139) + lu(k,143) = lu(k,143) * lu(k,139) + lu(k,144) = lu(k,144) * lu(k,139) + lu(k,145) = lu(k,145) * lu(k,139) + lu(k,146) = lu(k,146) * lu(k,139) + lu(k,659) = - lu(k,140) * lu(k,653) + lu(k,665) = lu(k,665) - lu(k,141) * lu(k,653) + lu(k,666) = - lu(k,142) * lu(k,653) + lu(k,673) = lu(k,673) - lu(k,143) * lu(k,653) + lu(k,674) = lu(k,674) - lu(k,144) * lu(k,653) + lu(k,683) = lu(k,683) - lu(k,145) * lu(k,653) + lu(k,688) = lu(k,688) - lu(k,146) * lu(k,653) + lu(k,831) = lu(k,831) - lu(k,140) * lu(k,822) + lu(k,834) = lu(k,834) - lu(k,141) * lu(k,822) + lu(k,836) = lu(k,836) - lu(k,142) * lu(k,822) + lu(k,843) = lu(k,843) - lu(k,143) * lu(k,822) + lu(k,844) = lu(k,844) - lu(k,144) * lu(k,822) + lu(k,853) = lu(k,853) - lu(k,145) * lu(k,822) + lu(k,858) = lu(k,858) - lu(k,146) * lu(k,822) + 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,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,152) = lu(k,152) * lu(k,147) + lu(k,153) = lu(k,153) * lu(k,147) + lu(k,154) = lu(k,154) * lu(k,147) + lu(k,767) = lu(k,767) - lu(k,148) * lu(k,761) + lu(k,772) = lu(k,772) - lu(k,149) * lu(k,761) + lu(k,774) = lu(k,774) - lu(k,150) * lu(k,761) + lu(k,778) = lu(k,778) - lu(k,151) * lu(k,761) + lu(k,785) = lu(k,785) - lu(k,152) * lu(k,761) + lu(k,787) = lu(k,787) - lu(k,153) * lu(k,761) + lu(k,791) = - lu(k,154) * lu(k,761) + lu(k,834) = lu(k,834) - lu(k,148) * lu(k,823) + lu(k,842) = lu(k,842) - lu(k,149) * lu(k,823) + lu(k,845) = lu(k,845) - lu(k,150) * lu(k,823) + lu(k,849) = lu(k,849) - lu(k,151) * lu(k,823) + lu(k,856) = lu(k,856) - lu(k,152) * lu(k,823) + lu(k,858) = lu(k,858) - lu(k,153) * lu(k,823) + lu(k,862) = lu(k,862) - lu(k,154) * lu(k,823) + lu(k,155) = 1._r8 / lu(k,155) + lu(k,156) = lu(k,156) * lu(k,155) + lu(k,157) = lu(k,157) * lu(k,155) + lu(k,158) = lu(k,158) * lu(k,155) + lu(k,159) = lu(k,159) * lu(k,155) + lu(k,160) = lu(k,160) * lu(k,155) + lu(k,411) = lu(k,411) - lu(k,156) * lu(k,410) + lu(k,412) = - lu(k,157) * lu(k,410) + lu(k,413) = lu(k,413) - lu(k,158) * lu(k,410) + lu(k,420) = - lu(k,159) * lu(k,410) + lu(k,421) = - lu(k,160) * lu(k,410) + lu(k,549) = lu(k,549) - lu(k,156) * lu(k,543) + lu(k,550) = lu(k,550) - lu(k,157) * lu(k,543) + lu(k,552) = - lu(k,158) * lu(k,543) + lu(k,564) = lu(k,564) - lu(k,159) * lu(k,543) + lu(k,568) = lu(k,568) - lu(k,160) * lu(k,543) + lu(k,842) = lu(k,842) - lu(k,156) * lu(k,824) + lu(k,844) = lu(k,844) - lu(k,157) * lu(k,824) + lu(k,846) = lu(k,846) - lu(k,158) * lu(k,824) + lu(k,858) = lu(k,858) - lu(k,159) * lu(k,824) + lu(k,862) = lu(k,862) - lu(k,160) * lu(k,824) + lu(k,161) = 1._r8 / lu(k,161) + lu(k,162) = lu(k,162) * lu(k,161) + lu(k,163) = lu(k,163) * lu(k,161) + lu(k,164) = lu(k,164) * lu(k,161) + lu(k,165) = lu(k,165) * lu(k,161) + lu(k,166) = lu(k,166) * lu(k,161) + lu(k,717) = lu(k,717) - lu(k,162) * lu(k,709) + lu(k,726) = lu(k,726) - lu(k,163) * lu(k,709) + lu(k,728) = lu(k,728) - lu(k,164) * lu(k,709) + lu(k,729) = lu(k,729) - lu(k,165) * lu(k,709) + lu(k,730) = lu(k,730) - lu(k,166) * lu(k,709) + lu(k,774) = lu(k,774) - lu(k,162) * lu(k,762) + lu(k,783) = - lu(k,163) * lu(k,762) + lu(k,785) = lu(k,785) - lu(k,164) * lu(k,762) + lu(k,786) = lu(k,786) - lu(k,165) * lu(k,762) + lu(k,787) = lu(k,787) - lu(k,166) * lu(k,762) + lu(k,845) = lu(k,845) - lu(k,162) * lu(k,825) + lu(k,854) = lu(k,854) - lu(k,163) * lu(k,825) + lu(k,856) = lu(k,856) - lu(k,164) * lu(k,825) + lu(k,857) = lu(k,857) - lu(k,165) * lu(k,825) + lu(k,858) = lu(k,858) - lu(k,166) * lu(k,825) + lu(k,167) = 1._r8 / lu(k,167) + lu(k,168) = lu(k,168) * lu(k,167) + lu(k,169) = lu(k,169) * lu(k,167) + lu(k,170) = lu(k,170) * lu(k,167) + lu(k,171) = lu(k,171) * lu(k,167) + lu(k,172) = lu(k,172) * lu(k,167) + lu(k,173) = lu(k,173) * lu(k,167) + lu(k,553) = lu(k,553) - lu(k,168) * lu(k,544) + lu(k,555) = lu(k,555) - lu(k,169) * lu(k,544) + lu(k,556) = lu(k,556) - lu(k,170) * lu(k,544) + lu(k,558) = lu(k,558) - lu(k,171) * lu(k,544) + lu(k,564) = lu(k,564) - lu(k,172) * lu(k,544) + lu(k,568) = lu(k,568) - lu(k,173) * lu(k,544) + lu(k,635) = lu(k,635) - lu(k,168) * lu(k,624) + lu(k,637) = lu(k,637) - lu(k,169) * lu(k,624) + lu(k,638) = lu(k,638) - lu(k,170) * lu(k,624) + lu(k,640) = lu(k,640) - lu(k,171) * lu(k,624) + lu(k,646) = lu(k,646) - lu(k,172) * lu(k,624) + lu(k,650) = - lu(k,173) * lu(k,624) + lu(k,847) = lu(k,847) - lu(k,168) * lu(k,826) + lu(k,849) = lu(k,849) - lu(k,169) * lu(k,826) + lu(k,850) = lu(k,850) - lu(k,170) * lu(k,826) + lu(k,852) = lu(k,852) - lu(k,171) * lu(k,826) + lu(k,858) = lu(k,858) - lu(k,172) * lu(k,826) + lu(k,862) = lu(k,862) - lu(k,173) * lu(k,826) + lu(k,174) = 1._r8 / lu(k,174) + lu(k,175) = lu(k,175) * lu(k,174) + lu(k,176) = lu(k,176) * lu(k,174) + lu(k,177) = lu(k,177) * lu(k,174) + lu(k,178) = lu(k,178) * lu(k,174) + lu(k,179) = lu(k,179) * lu(k,174) + lu(k,180) = lu(k,180) * lu(k,174) + lu(k,717) = lu(k,717) - lu(k,175) * lu(k,710) + lu(k,726) = lu(k,726) - lu(k,176) * lu(k,710) + lu(k,728) = lu(k,728) - lu(k,177) * lu(k,710) + lu(k,729) = lu(k,729) - lu(k,178) * lu(k,710) + lu(k,730) = lu(k,730) - lu(k,179) * lu(k,710) + lu(k,734) = lu(k,734) - lu(k,180) * lu(k,710) + lu(k,774) = lu(k,774) - lu(k,175) * lu(k,763) + lu(k,783) = lu(k,783) - lu(k,176) * lu(k,763) + lu(k,785) = lu(k,785) - lu(k,177) * lu(k,763) + lu(k,786) = lu(k,786) - lu(k,178) * lu(k,763) + lu(k,787) = lu(k,787) - lu(k,179) * lu(k,763) + lu(k,791) = lu(k,791) - lu(k,180) * lu(k,763) + lu(k,845) = lu(k,845) - lu(k,175) * lu(k,827) + lu(k,854) = lu(k,854) - lu(k,176) * lu(k,827) + lu(k,856) = lu(k,856) - lu(k,177) * lu(k,827) + lu(k,857) = lu(k,857) - lu(k,178) * lu(k,827) + lu(k,858) = lu(k,858) - lu(k,179) * lu(k,827) + lu(k,862) = lu(k,862) - lu(k,180) * lu(k,827) + lu(k,181) = 1._r8 / lu(k,181) + lu(k,182) = lu(k,182) * lu(k,181) + lu(k,183) = lu(k,183) * lu(k,181) + lu(k,184) = lu(k,184) * lu(k,181) + lu(k,185) = lu(k,185) * lu(k,181) + lu(k,186) = lu(k,186) * lu(k,181) + lu(k,187) = lu(k,187) * lu(k,181) + lu(k,319) = lu(k,319) - lu(k,182) * lu(k,318) + lu(k,320) = lu(k,320) - lu(k,183) * lu(k,318) + lu(k,322) = - lu(k,184) * lu(k,318) + lu(k,327) = lu(k,327) - lu(k,185) * lu(k,318) + lu(k,329) = lu(k,329) - lu(k,186) * lu(k,318) + lu(k,331) = - lu(k,187) * lu(k,318) + lu(k,495) = lu(k,495) - lu(k,182) * lu(k,494) + lu(k,496) = lu(k,496) - lu(k,183) * lu(k,494) + lu(k,499) = lu(k,499) - lu(k,184) * lu(k,494) + lu(k,505) = lu(k,505) - lu(k,185) * lu(k,494) + lu(k,513) = lu(k,513) - lu(k,186) * lu(k,494) + lu(k,515) = lu(k,515) - lu(k,187) * lu(k,494) + lu(k,655) = lu(k,655) - lu(k,182) * lu(k,654) + lu(k,657) = lu(k,657) - lu(k,183) * lu(k,654) + lu(k,664) = lu(k,664) - lu(k,184) * lu(k,654) + lu(k,672) = lu(k,672) - lu(k,185) * lu(k,654) + lu(k,683) = lu(k,683) - lu(k,186) * lu(k,654) + lu(k,685) = lu(k,685) - lu(k,187) * lu(k,654) + 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,320) = lu(k,320) - lu(k,189) * lu(k,319) + lu(k,326) = lu(k,326) - lu(k,190) * lu(k,319) + lu(k,327) = lu(k,327) - lu(k,191) * lu(k,319) + lu(k,328) = - lu(k,192) * lu(k,319) + lu(k,329) = lu(k,329) - lu(k,193) * lu(k,319) + lu(k,496) = lu(k,496) - lu(k,189) * lu(k,495) + lu(k,504) = lu(k,504) - lu(k,190) * lu(k,495) + lu(k,505) = lu(k,505) - lu(k,191) * lu(k,495) + lu(k,508) = lu(k,508) - lu(k,192) * lu(k,495) + lu(k,513) = lu(k,513) - lu(k,193) * lu(k,495) + lu(k,657) = lu(k,657) - lu(k,189) * lu(k,655) + lu(k,671) = - lu(k,190) * lu(k,655) + lu(k,672) = lu(k,672) - lu(k,191) * lu(k,655) + lu(k,677) = lu(k,677) - lu(k,192) * lu(k,655) + lu(k,683) = lu(k,683) - lu(k,193) * lu(k,655) + 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,196) = 1._r8 / lu(k,196) + lu(k,197) = lu(k,197) * lu(k,196) + lu(k,198) = lu(k,198) * lu(k,196) + lu(k,199) = lu(k,199) * lu(k,196) + lu(k,200) = lu(k,200) * lu(k,196) + lu(k,201) = lu(k,201) * lu(k,196) + lu(k,282) = lu(k,282) - lu(k,197) * lu(k,281) + lu(k,283) = - lu(k,198) * lu(k,281) + lu(k,284) = - lu(k,199) * lu(k,281) + lu(k,285) = - lu(k,200) * lu(k,281) + lu(k,287) = - lu(k,201) * lu(k,281) + lu(k,373) = lu(k,373) - lu(k,197) * lu(k,370) + lu(k,377) = lu(k,377) - lu(k,198) * lu(k,370) + lu(k,378) = lu(k,378) - lu(k,199) * lu(k,370) + lu(k,380) = lu(k,380) - lu(k,200) * lu(k,370) + lu(k,383) = lu(k,383) - lu(k,201) * lu(k,370) + lu(k,389) = lu(k,389) - lu(k,197) * lu(k,388) + lu(k,391) = - lu(k,198) * lu(k,388) + lu(k,392) = - lu(k,199) * lu(k,388) + lu(k,398) = - lu(k,200) * lu(k,388) + lu(k,402) = lu(k,402) - lu(k,201) * lu(k,388) + lu(k,834) = lu(k,834) - lu(k,197) * lu(k,828) + lu(k,839) = - lu(k,198) * lu(k,828) + lu(k,840) = - lu(k,199) * lu(k,828) + lu(k,847) = lu(k,847) - lu(k,200) * lu(k,828) + lu(k,853) = lu(k,853) - lu(k,201) * lu(k,828) + lu(k,202) = 1._r8 / lu(k,202) + lu(k,203) = lu(k,203) * lu(k,202) + lu(k,204) = lu(k,204) * lu(k,202) + lu(k,205) = lu(k,205) * lu(k,202) + lu(k,206) = lu(k,206) * lu(k,202) + lu(k,207) = lu(k,207) * lu(k,202) + lu(k,208) = lu(k,208) * lu(k,202) + lu(k,209) = lu(k,209) * lu(k,202) + lu(k,626) = - lu(k,203) * lu(k,625) + lu(k,638) = lu(k,638) - lu(k,204) * lu(k,625) + lu(k,640) = lu(k,640) - lu(k,205) * lu(k,625) + lu(k,641) = lu(k,641) - lu(k,206) * lu(k,625) + lu(k,645) = - lu(k,207) * lu(k,625) + lu(k,648) = lu(k,648) - lu(k,208) * lu(k,625) + lu(k,649) = lu(k,649) - lu(k,209) * lu(k,625) + lu(k,661) = lu(k,661) - lu(k,203) * lu(k,656) + lu(k,680) = lu(k,680) - lu(k,204) * lu(k,656) + lu(k,682) = lu(k,682) - lu(k,205) * lu(k,656) + lu(k,683) = lu(k,683) - lu(k,206) * lu(k,656) + lu(k,687) = lu(k,687) - lu(k,207) * lu(k,656) + lu(k,690) = - lu(k,208) * lu(k,656) + lu(k,691) = lu(k,691) - lu(k,209) * lu(k,656) + lu(k,912) = lu(k,912) - lu(k,203) * lu(k,911) + lu(k,920) = - lu(k,204) * lu(k,911) + lu(k,922) = lu(k,922) - lu(k,205) * lu(k,911) + lu(k,923) = lu(k,923) - lu(k,206) * lu(k,911) + lu(k,927) = lu(k,927) - lu(k,207) * lu(k,911) + lu(k,930) = - lu(k,208) * lu(k,911) + lu(k,931) = lu(k,931) - lu(k,209) * lu(k,911) + lu(k,210) = 1._r8 / lu(k,210) + lu(k,211) = lu(k,211) * lu(k,210) + lu(k,212) = lu(k,212) * lu(k,210) + lu(k,213) = lu(k,213) * lu(k,210) + lu(k,214) = lu(k,214) * lu(k,210) + lu(k,215) = lu(k,215) * lu(k,210) + lu(k,216) = lu(k,216) * lu(k,210) + lu(k,217) = lu(k,217) * lu(k,210) + lu(k,218) = lu(k,218) * lu(k,210) + lu(k,715) = lu(k,715) - lu(k,211) * lu(k,711) + lu(k,717) = lu(k,717) - lu(k,212) * lu(k,711) + lu(k,721) = lu(k,721) - lu(k,213) * lu(k,711) + lu(k,726) = lu(k,726) - lu(k,214) * lu(k,711) + lu(k,728) = lu(k,728) - lu(k,215) * lu(k,711) + lu(k,729) = lu(k,729) - lu(k,216) * lu(k,711) + lu(k,730) = lu(k,730) - lu(k,217) * lu(k,711) + lu(k,734) = lu(k,734) - lu(k,218) * lu(k,711) + lu(k,772) = lu(k,772) - lu(k,211) * lu(k,764) + lu(k,774) = lu(k,774) - lu(k,212) * lu(k,764) + lu(k,778) = lu(k,778) - lu(k,213) * lu(k,764) + lu(k,783) = lu(k,783) - lu(k,214) * lu(k,764) + lu(k,785) = lu(k,785) - lu(k,215) * lu(k,764) + lu(k,786) = lu(k,786) - lu(k,216) * lu(k,764) + lu(k,787) = lu(k,787) - lu(k,217) * lu(k,764) + lu(k,791) = lu(k,791) - lu(k,218) * lu(k,764) + lu(k,842) = lu(k,842) - lu(k,211) * lu(k,829) + lu(k,845) = lu(k,845) - lu(k,212) * lu(k,829) + lu(k,849) = lu(k,849) - lu(k,213) * lu(k,829) + lu(k,854) = lu(k,854) - lu(k,214) * lu(k,829) + lu(k,856) = lu(k,856) - lu(k,215) * lu(k,829) + lu(k,857) = lu(k,857) - lu(k,216) * lu(k,829) + lu(k,858) = lu(k,858) - lu(k,217) * lu(k,829) + lu(k,862) = lu(k,862) - lu(k,218) * lu(k,829) + lu(k,219) = 1._r8 / lu(k,219) + lu(k,220) = lu(k,220) * lu(k,219) + lu(k,221) = lu(k,221) * lu(k,219) + lu(k,222) = lu(k,222) * lu(k,219) + lu(k,223) = lu(k,223) * lu(k,219) + lu(k,224) = lu(k,224) * lu(k,219) + lu(k,225) = lu(k,225) * lu(k,219) + lu(k,226) = lu(k,226) * lu(k,219) + lu(k,227) = lu(k,227) * lu(k,219) + lu(k,321) = lu(k,321) - lu(k,220) * lu(k,320) + lu(k,323) = lu(k,323) - lu(k,221) * lu(k,320) + lu(k,324) = lu(k,324) - lu(k,222) * lu(k,320) + lu(k,325) = lu(k,325) - lu(k,223) * lu(k,320) + lu(k,326) = lu(k,326) - lu(k,224) * lu(k,320) + lu(k,327) = lu(k,327) - lu(k,225) * lu(k,320) + lu(k,328) = lu(k,328) - lu(k,226) * lu(k,320) + lu(k,329) = lu(k,329) - lu(k,227) * lu(k,320) + lu(k,498) = lu(k,498) - lu(k,220) * lu(k,496) + lu(k,501) = lu(k,501) - lu(k,221) * lu(k,496) + lu(k,502) = lu(k,502) - lu(k,222) * lu(k,496) + lu(k,503) = lu(k,503) - lu(k,223) * lu(k,496) + lu(k,504) = lu(k,504) - lu(k,224) * lu(k,496) + lu(k,505) = lu(k,505) - lu(k,225) * lu(k,496) + lu(k,508) = lu(k,508) - lu(k,226) * lu(k,496) + lu(k,513) = lu(k,513) - lu(k,227) * lu(k,496) + lu(k,660) = lu(k,660) - lu(k,220) * lu(k,657) + lu(k,668) = lu(k,668) - lu(k,221) * lu(k,657) + lu(k,669) = lu(k,669) - lu(k,222) * lu(k,657) + lu(k,670) = lu(k,670) - lu(k,223) * lu(k,657) + lu(k,671) = lu(k,671) - lu(k,224) * lu(k,657) + lu(k,672) = lu(k,672) - lu(k,225) * lu(k,657) + lu(k,677) = lu(k,677) - lu(k,226) * lu(k,657) + lu(k,683) = lu(k,683) - lu(k,227) * lu(k,657) + lu(k,228) = 1._r8 / lu(k,228) + lu(k,229) = lu(k,229) * lu(k,228) + lu(k,230) = lu(k,230) * lu(k,228) + lu(k,231) = lu(k,231) * lu(k,228) + lu(k,232) = lu(k,232) * lu(k,228) + lu(k,233) = lu(k,233) * lu(k,228) + lu(k,234) = lu(k,234) * lu(k,228) + lu(k,551) = lu(k,551) - lu(k,229) * lu(k,545) + lu(k,555) = lu(k,555) - lu(k,230) * lu(k,545) + lu(k,559) = lu(k,559) - lu(k,231) * lu(k,545) + lu(k,562) = lu(k,562) - lu(k,232) * lu(k,545) + lu(k,564) = lu(k,564) - lu(k,233) * lu(k,545) + lu(k,568) = lu(k,568) - lu(k,234) * lu(k,545) + lu(k,675) = lu(k,675) - lu(k,229) * lu(k,658) + lu(k,679) = lu(k,679) - lu(k,230) * lu(k,658) + lu(k,683) = lu(k,683) - lu(k,231) * lu(k,658) + lu(k,686) = lu(k,686) - lu(k,232) * lu(k,658) + lu(k,688) = lu(k,688) - lu(k,233) * lu(k,658) + lu(k,692) = - lu(k,234) * lu(k,658) + lu(k,774) = lu(k,774) - lu(k,229) * lu(k,765) + lu(k,778) = lu(k,778) - lu(k,230) * lu(k,765) + lu(k,782) = - lu(k,231) * lu(k,765) + lu(k,785) = lu(k,785) - lu(k,232) * lu(k,765) + lu(k,787) = lu(k,787) - lu(k,233) * lu(k,765) + lu(k,791) = lu(k,791) - lu(k,234) * lu(k,765) + lu(k,845) = lu(k,845) - lu(k,229) * lu(k,830) + lu(k,849) = lu(k,849) - lu(k,230) * lu(k,830) + lu(k,853) = lu(k,853) - lu(k,231) * lu(k,830) + lu(k,856) = lu(k,856) - lu(k,232) * lu(k,830) + lu(k,858) = lu(k,858) - lu(k,233) * lu(k,830) + lu(k,862) = lu(k,862) - lu(k,234) * lu(k,830) + 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,235) = 1._r8 / lu(k,235) + lu(k,236) = lu(k,236) * lu(k,235) + lu(k,237) = lu(k,237) * lu(k,235) + lu(k,238) = lu(k,238) * lu(k,235) + lu(k,239) = lu(k,239) * lu(k,235) + lu(k,240) = lu(k,240) * lu(k,235) + lu(k,241) = lu(k,241) * lu(k,235) + lu(k,425) = lu(k,425) - lu(k,236) * lu(k,423) + lu(k,426) = lu(k,426) - lu(k,237) * lu(k,423) + lu(k,427) = lu(k,427) - lu(k,238) * lu(k,423) + lu(k,428) = lu(k,428) - lu(k,239) * lu(k,423) + lu(k,432) = lu(k,432) - lu(k,240) * lu(k,423) + lu(k,436) = lu(k,436) - lu(k,241) * lu(k,423) + lu(k,506) = lu(k,506) - lu(k,236) * lu(k,497) + lu(k,507) = lu(k,507) - lu(k,237) * lu(k,497) + lu(k,508) = lu(k,508) - lu(k,238) * lu(k,497) + lu(k,509) = lu(k,509) - lu(k,239) * lu(k,497) + lu(k,513) = lu(k,513) - lu(k,240) * lu(k,497) + lu(k,518) = - lu(k,241) * lu(k,497) + lu(k,526) = lu(k,526) - lu(k,236) * lu(k,524) + lu(k,527) = lu(k,527) - lu(k,237) * lu(k,524) + lu(k,528) = lu(k,528) - lu(k,238) * lu(k,524) + lu(k,529) = lu(k,529) - lu(k,239) * lu(k,524) + lu(k,534) = lu(k,534) - lu(k,240) * lu(k,524) + lu(k,539) = lu(k,539) - lu(k,241) * lu(k,524) + lu(k,673) = lu(k,673) - lu(k,236) * lu(k,659) + lu(k,674) = lu(k,674) - lu(k,237) * lu(k,659) + lu(k,677) = lu(k,677) - lu(k,238) * lu(k,659) + lu(k,678) = lu(k,678) - lu(k,239) * lu(k,659) + lu(k,683) = lu(k,683) - lu(k,240) * lu(k,659) + lu(k,688) = lu(k,688) - lu(k,241) * lu(k,659) + lu(k,843) = lu(k,843) - lu(k,236) * lu(k,831) + lu(k,844) = lu(k,844) - lu(k,237) * lu(k,831) + lu(k,847) = lu(k,847) - lu(k,238) * lu(k,831) + lu(k,848) = lu(k,848) - lu(k,239) * lu(k,831) + lu(k,853) = lu(k,853) - lu(k,240) * lu(k,831) + lu(k,858) = lu(k,858) - lu(k,241) * lu(k,831) + lu(k,242) = 1._r8 / lu(k,242) + lu(k,243) = lu(k,243) * lu(k,242) + lu(k,244) = lu(k,244) * lu(k,242) + lu(k,245) = lu(k,245) * lu(k,242) + lu(k,246) = lu(k,246) * lu(k,242) + lu(k,274) = - lu(k,243) * lu(k,272) + lu(k,275) = - lu(k,244) * lu(k,272) + lu(k,276) = lu(k,276) - lu(k,245) * lu(k,272) + lu(k,280) = lu(k,280) - lu(k,246) * lu(k,272) + lu(k,323) = lu(k,323) - lu(k,243) * lu(k,321) + lu(k,324) = lu(k,324) - lu(k,244) * lu(k,321) + lu(k,325) = lu(k,325) - lu(k,245) * lu(k,321) + lu(k,329) = lu(k,329) - lu(k,246) * lu(k,321) + lu(k,345) = lu(k,345) - lu(k,243) * lu(k,343) + lu(k,346) = - lu(k,244) * lu(k,343) + lu(k,347) = lu(k,347) - lu(k,245) * lu(k,343) + lu(k,353) = lu(k,353) - lu(k,246) * lu(k,343) + lu(k,358) = lu(k,358) - lu(k,243) * lu(k,357) + lu(k,359) = - lu(k,244) * lu(k,357) + lu(k,360) = lu(k,360) - lu(k,245) * lu(k,357) + lu(k,366) = lu(k,366) - lu(k,246) * lu(k,357) + lu(k,374) = - lu(k,243) * lu(k,371) + lu(k,375) = lu(k,375) - lu(k,244) * lu(k,371) + lu(k,376) = lu(k,376) - lu(k,245) * lu(k,371) + lu(k,383) = lu(k,383) - lu(k,246) * lu(k,371) + lu(k,501) = lu(k,501) - lu(k,243) * lu(k,498) + lu(k,502) = lu(k,502) - lu(k,244) * lu(k,498) + lu(k,503) = lu(k,503) - lu(k,245) * lu(k,498) + lu(k,513) = lu(k,513) - lu(k,246) * lu(k,498) + lu(k,668) = lu(k,668) - lu(k,243) * lu(k,660) + lu(k,669) = lu(k,669) - lu(k,244) * lu(k,660) + lu(k,670) = lu(k,670) - lu(k,245) * lu(k,660) + lu(k,683) = lu(k,683) - lu(k,246) * lu(k,660) + lu(k,736) = lu(k,736) - lu(k,243) * lu(k,735) + lu(k,737) = - lu(k,244) * lu(k,735) + lu(k,738) = lu(k,738) - lu(k,245) * lu(k,735) + lu(k,750) = lu(k,750) - lu(k,246) * lu(k,735) + 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,252) = lu(k,252) * lu(k,248) + lu(k,253) = lu(k,253) * lu(k,248) + lu(k,254) = lu(k,254) * lu(k,248) + lu(k,255) = lu(k,255) * lu(k,248) + lu(k,453) = lu(k,453) - lu(k,249) * lu(k,449) + lu(k,460) = lu(k,460) - lu(k,250) * lu(k,449) + lu(k,462) = lu(k,462) - lu(k,251) * lu(k,449) + lu(k,463) = lu(k,463) - lu(k,252) * lu(k,449) + lu(k,464) = lu(k,464) - lu(k,253) * lu(k,449) + lu(k,467) = - lu(k,254) * lu(k,449) + lu(k,468) = lu(k,468) - lu(k,255) * lu(k,449) + lu(k,551) = lu(k,551) - lu(k,249) * lu(k,546) + lu(k,559) = lu(k,559) - lu(k,250) * lu(k,546) + lu(k,562) = lu(k,562) - lu(k,251) * lu(k,546) + lu(k,563) = lu(k,563) - lu(k,252) * lu(k,546) + lu(k,564) = lu(k,564) - lu(k,253) * lu(k,546) + lu(k,567) = lu(k,567) - lu(k,254) * lu(k,546) + lu(k,568) = lu(k,568) - lu(k,255) * lu(k,546) + lu(k,634) = - lu(k,249) * lu(k,626) + lu(k,641) = lu(k,641) - lu(k,250) * lu(k,626) + lu(k,644) = - lu(k,251) * lu(k,626) + lu(k,645) = lu(k,645) - lu(k,252) * lu(k,626) + lu(k,646) = lu(k,646) - lu(k,253) * lu(k,626) + lu(k,649) = lu(k,649) - lu(k,254) * lu(k,626) + lu(k,650) = lu(k,650) - lu(k,255) * lu(k,626) + lu(k,675) = lu(k,675) - lu(k,249) * lu(k,661) + lu(k,683) = lu(k,683) - lu(k,250) * lu(k,661) + lu(k,686) = lu(k,686) - lu(k,251) * lu(k,661) + lu(k,687) = lu(k,687) - lu(k,252) * lu(k,661) + lu(k,688) = lu(k,688) - lu(k,253) * lu(k,661) + lu(k,691) = lu(k,691) - lu(k,254) * lu(k,661) + lu(k,692) = lu(k,692) - lu(k,255) * lu(k,661) + lu(k,916) = - lu(k,249) * lu(k,912) + lu(k,923) = lu(k,923) - lu(k,250) * lu(k,912) + lu(k,926) = lu(k,926) - lu(k,251) * lu(k,912) + lu(k,927) = lu(k,927) - lu(k,252) * lu(k,912) + lu(k,928) = lu(k,928) - lu(k,253) * lu(k,912) + lu(k,931) = lu(k,931) - lu(k,254) * lu(k,912) + lu(k,932) = - lu(k,255) * lu(k,912) + lu(k,256) = 1._r8 / lu(k,256) + lu(k,257) = lu(k,257) * lu(k,256) + lu(k,258) = lu(k,258) * lu(k,256) + lu(k,259) = lu(k,259) * lu(k,256) + lu(k,260) = lu(k,260) * lu(k,256) + lu(k,261) = lu(k,261) * lu(k,256) + lu(k,262) = lu(k,262) * lu(k,256) + lu(k,263) = lu(k,263) * lu(k,256) + lu(k,473) = lu(k,473) - lu(k,257) * lu(k,469) + lu(k,482) = lu(k,482) - lu(k,258) * lu(k,469) + lu(k,483) = - lu(k,259) * lu(k,469) + lu(k,486) = lu(k,486) - lu(k,260) * lu(k,469) + lu(k,487) = lu(k,487) - lu(k,261) * lu(k,469) + lu(k,490) = - lu(k,262) * lu(k,469) + lu(k,491) = lu(k,491) - lu(k,263) * lu(k,469) + lu(k,550) = lu(k,550) - lu(k,257) * lu(k,547) + lu(k,559) = lu(k,559) - lu(k,258) * lu(k,547) + lu(k,560) = - lu(k,259) * lu(k,547) + lu(k,563) = lu(k,563) - lu(k,260) * lu(k,547) + lu(k,564) = lu(k,564) - lu(k,261) * lu(k,547) + lu(k,567) = lu(k,567) - lu(k,262) * lu(k,547) + lu(k,568) = lu(k,568) - lu(k,263) * lu(k,547) + lu(k,674) = lu(k,674) - lu(k,257) * lu(k,662) + lu(k,683) = lu(k,683) - lu(k,258) * lu(k,662) + lu(k,684) = - lu(k,259) * lu(k,662) + lu(k,687) = lu(k,687) - lu(k,260) * lu(k,662) + lu(k,688) = lu(k,688) - lu(k,261) * lu(k,662) + lu(k,691) = lu(k,691) - lu(k,262) * lu(k,662) + lu(k,692) = lu(k,692) - lu(k,263) * lu(k,662) + lu(k,716) = lu(k,716) - lu(k,257) * lu(k,712) + lu(k,725) = lu(k,725) - lu(k,258) * lu(k,712) + lu(k,726) = lu(k,726) - lu(k,259) * lu(k,712) + lu(k,729) = lu(k,729) - lu(k,260) * lu(k,712) + lu(k,730) = lu(k,730) - lu(k,261) * lu(k,712) + lu(k,733) = lu(k,733) - lu(k,262) * lu(k,712) + lu(k,734) = lu(k,734) - lu(k,263) * lu(k,712) + lu(k,796) = - lu(k,257) * lu(k,792) + lu(k,804) = - lu(k,258) * lu(k,792) + lu(k,805) = - lu(k,259) * lu(k,792) + lu(k,808) = lu(k,808) - lu(k,260) * lu(k,792) + lu(k,809) = - lu(k,261) * lu(k,792) + lu(k,812) = lu(k,812) - lu(k,262) * lu(k,792) + lu(k,813) = - lu(k,263) * lu(k,792) + lu(k,844) = lu(k,844) - lu(k,257) * lu(k,832) + lu(k,853) = lu(k,853) - lu(k,258) * lu(k,832) + lu(k,854) = lu(k,854) - lu(k,259) * lu(k,832) + lu(k,857) = lu(k,857) - lu(k,260) * lu(k,832) + lu(k,858) = lu(k,858) - lu(k,261) * lu(k,832) + lu(k,861) = lu(k,861) - lu(k,262) * lu(k,832) + lu(k,862) = lu(k,862) - lu(k,263) * lu(k,832) + lu(k,265) = 1._r8 / lu(k,265) + lu(k,266) = lu(k,266) * lu(k,265) + lu(k,267) = lu(k,267) * lu(k,265) + lu(k,268) = lu(k,268) * lu(k,265) + lu(k,269) = lu(k,269) * lu(k,265) + lu(k,270) = lu(k,270) * lu(k,265) + lu(k,271) = lu(k,271) * lu(k,265) + lu(k,309) = lu(k,309) - lu(k,266) * lu(k,307) + lu(k,311) = lu(k,311) - lu(k,267) * lu(k,307) + lu(k,313) = lu(k,313) - lu(k,268) * lu(k,307) + lu(k,314) = lu(k,314) - lu(k,269) * lu(k,307) + lu(k,315) = lu(k,315) - lu(k,270) * lu(k,307) + lu(k,317) = - lu(k,271) * lu(k,307) + lu(k,453) = lu(k,453) - lu(k,266) * lu(k,450) + lu(k,458) = lu(k,458) - lu(k,267) * lu(k,450) + lu(k,460) = lu(k,460) - lu(k,268) * lu(k,450) + lu(k,462) = lu(k,462) - lu(k,269) * lu(k,450) + lu(k,464) = lu(k,464) - lu(k,270) * lu(k,450) + lu(k,468) = lu(k,468) - lu(k,271) * lu(k,450) + lu(k,551) = lu(k,551) - lu(k,266) * lu(k,548) + lu(k,557) = lu(k,557) - lu(k,267) * lu(k,548) + lu(k,559) = lu(k,559) - lu(k,268) * lu(k,548) + lu(k,562) = lu(k,562) - lu(k,269) * lu(k,548) + lu(k,564) = lu(k,564) - lu(k,270) * lu(k,548) + lu(k,568) = lu(k,568) - lu(k,271) * lu(k,548) + lu(k,604) = lu(k,604) - lu(k,266) * lu(k,598) + lu(k,610) = lu(k,610) - lu(k,267) * lu(k,598) + lu(k,612) = lu(k,612) - lu(k,268) * lu(k,598) + lu(k,615) = lu(k,615) - lu(k,269) * lu(k,598) + lu(k,617) = lu(k,617) - lu(k,270) * lu(k,598) + lu(k,621) = - lu(k,271) * lu(k,598) + lu(k,675) = lu(k,675) - lu(k,266) * lu(k,663) + lu(k,681) = lu(k,681) - lu(k,267) * lu(k,663) + lu(k,683) = lu(k,683) - lu(k,268) * lu(k,663) + lu(k,686) = lu(k,686) - lu(k,269) * lu(k,663) + lu(k,688) = lu(k,688) - lu(k,270) * lu(k,663) + lu(k,692) = lu(k,692) - lu(k,271) * lu(k,663) + lu(k,774) = lu(k,774) - lu(k,266) * lu(k,766) + lu(k,780) = lu(k,780) - lu(k,267) * lu(k,766) + lu(k,782) = lu(k,782) - lu(k,268) * lu(k,766) + lu(k,785) = lu(k,785) - lu(k,269) * lu(k,766) + lu(k,787) = lu(k,787) - lu(k,270) * lu(k,766) + lu(k,791) = lu(k,791) - lu(k,271) * lu(k,766) + lu(k,845) = lu(k,845) - lu(k,266) * lu(k,833) + lu(k,851) = lu(k,851) - lu(k,267) * lu(k,833) + lu(k,853) = lu(k,853) - lu(k,268) * lu(k,833) + lu(k,856) = lu(k,856) - lu(k,269) * lu(k,833) + lu(k,858) = lu(k,858) - lu(k,270) * lu(k,833) + lu(k,862) = lu(k,862) - lu(k,271) * lu(k,833) + 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,273) = 1._r8 / lu(k,273) + lu(k,274) = lu(k,274) * lu(k,273) + lu(k,275) = lu(k,275) * lu(k,273) + lu(k,276) = lu(k,276) * lu(k,273) + lu(k,277) = lu(k,277) * lu(k,273) + lu(k,278) = lu(k,278) * lu(k,273) + lu(k,279) = lu(k,279) * lu(k,273) + lu(k,280) = lu(k,280) * lu(k,273) + lu(k,323) = lu(k,323) - lu(k,274) * lu(k,322) + lu(k,324) = lu(k,324) - lu(k,275) * lu(k,322) + lu(k,325) = lu(k,325) - lu(k,276) * lu(k,322) + lu(k,326) = lu(k,326) - lu(k,277) * lu(k,322) + lu(k,327) = lu(k,327) - lu(k,278) * lu(k,322) + lu(k,328) = lu(k,328) - lu(k,279) * lu(k,322) + lu(k,329) = lu(k,329) - lu(k,280) * lu(k,322) + lu(k,333) = - lu(k,274) * lu(k,332) + lu(k,334) = lu(k,334) - lu(k,275) * lu(k,332) + lu(k,335) = lu(k,335) - lu(k,276) * lu(k,332) + lu(k,336) = - lu(k,277) * lu(k,332) + lu(k,337) = lu(k,337) - lu(k,278) * lu(k,332) + lu(k,338) = lu(k,338) - lu(k,279) * lu(k,332) + lu(k,339) = lu(k,339) - lu(k,280) * lu(k,332) + lu(k,345) = lu(k,345) - lu(k,274) * lu(k,344) + lu(k,346) = lu(k,346) - lu(k,275) * lu(k,344) + lu(k,347) = lu(k,347) - lu(k,276) * lu(k,344) + lu(k,348) = lu(k,348) - lu(k,277) * lu(k,344) + lu(k,349) = - lu(k,278) * lu(k,344) + lu(k,351) = lu(k,351) - lu(k,279) * lu(k,344) + lu(k,353) = lu(k,353) - lu(k,280) * lu(k,344) + lu(k,374) = lu(k,374) - lu(k,274) * lu(k,372) + lu(k,375) = lu(k,375) - lu(k,275) * lu(k,372) + lu(k,376) = lu(k,376) - lu(k,276) * lu(k,372) + lu(k,377) = lu(k,377) - lu(k,277) * lu(k,372) + lu(k,378) = lu(k,378) - lu(k,278) * lu(k,372) + lu(k,380) = lu(k,380) - lu(k,279) * lu(k,372) + lu(k,383) = lu(k,383) - lu(k,280) * lu(k,372) + lu(k,501) = lu(k,501) - lu(k,274) * lu(k,499) + lu(k,502) = lu(k,502) - lu(k,275) * lu(k,499) + lu(k,503) = lu(k,503) - lu(k,276) * lu(k,499) + lu(k,504) = lu(k,504) - lu(k,277) * lu(k,499) + lu(k,505) = lu(k,505) - lu(k,278) * lu(k,499) + lu(k,508) = lu(k,508) - lu(k,279) * lu(k,499) + lu(k,513) = lu(k,513) - lu(k,280) * lu(k,499) + lu(k,668) = lu(k,668) - lu(k,274) * lu(k,664) + lu(k,669) = lu(k,669) - lu(k,275) * lu(k,664) + lu(k,670) = lu(k,670) - lu(k,276) * lu(k,664) + lu(k,671) = lu(k,671) - lu(k,277) * lu(k,664) + lu(k,672) = lu(k,672) - lu(k,278) * lu(k,664) + lu(k,677) = lu(k,677) - lu(k,279) * lu(k,664) + lu(k,683) = lu(k,683) - lu(k,280) * lu(k,664) + lu(k,282) = 1._r8 / lu(k,282) + lu(k,283) = lu(k,283) * lu(k,282) + lu(k,284) = lu(k,284) * lu(k,282) + lu(k,285) = lu(k,285) * lu(k,282) + lu(k,286) = lu(k,286) * lu(k,282) + lu(k,287) = lu(k,287) * lu(k,282) + lu(k,288) = lu(k,288) * lu(k,282) + lu(k,377) = lu(k,377) - lu(k,283) * lu(k,373) + lu(k,378) = lu(k,378) - lu(k,284) * lu(k,373) + lu(k,380) = lu(k,380) - lu(k,285) * lu(k,373) + lu(k,381) = - lu(k,286) * lu(k,373) + lu(k,383) = lu(k,383) - lu(k,287) * lu(k,373) + lu(k,386) = - lu(k,288) * lu(k,373) + lu(k,391) = lu(k,391) - lu(k,283) * lu(k,389) + lu(k,392) = lu(k,392) - lu(k,284) * lu(k,389) + lu(k,398) = lu(k,398) - lu(k,285) * lu(k,389) + lu(k,399) = lu(k,399) - lu(k,286) * lu(k,389) + lu(k,402) = lu(k,402) - lu(k,287) * lu(k,389) + lu(k,406) = lu(k,406) - lu(k,288) * lu(k,389) + lu(k,471) = - lu(k,283) * lu(k,470) + lu(k,472) = - lu(k,284) * lu(k,470) + lu(k,476) = - lu(k,285) * lu(k,470) + lu(k,478) = lu(k,478) - lu(k,286) * lu(k,470) + lu(k,482) = lu(k,482) - lu(k,287) * lu(k,470) + lu(k,487) = lu(k,487) - lu(k,288) * lu(k,470) + lu(k,573) = - lu(k,283) * lu(k,571) + lu(k,574) = - lu(k,284) * lu(k,571) + lu(k,578) = lu(k,578) - lu(k,285) * lu(k,571) + lu(k,580) = lu(k,580) - lu(k,286) * lu(k,571) + lu(k,584) = lu(k,584) - lu(k,287) * lu(k,571) + lu(k,589) = lu(k,589) - lu(k,288) * lu(k,571) + lu(k,671) = lu(k,671) - lu(k,283) * lu(k,665) + lu(k,672) = lu(k,672) - lu(k,284) * lu(k,665) + lu(k,677) = lu(k,677) - lu(k,285) * lu(k,665) + lu(k,679) = lu(k,679) - lu(k,286) * lu(k,665) + lu(k,683) = lu(k,683) - lu(k,287) * lu(k,665) + lu(k,688) = lu(k,688) - lu(k,288) * lu(k,665) + lu(k,769) = - lu(k,283) * lu(k,767) + lu(k,770) = - lu(k,284) * lu(k,767) + lu(k,776) = lu(k,776) - lu(k,285) * lu(k,767) + lu(k,778) = lu(k,778) - lu(k,286) * lu(k,767) + lu(k,782) = lu(k,782) - lu(k,287) * lu(k,767) + lu(k,787) = lu(k,787) - lu(k,288) * lu(k,767) + lu(k,794) = - lu(k,283) * lu(k,793) + lu(k,795) = - lu(k,284) * lu(k,793) + lu(k,798) = lu(k,798) - lu(k,285) * lu(k,793) + lu(k,800) = lu(k,800) - lu(k,286) * lu(k,793) + lu(k,804) = lu(k,804) - lu(k,287) * lu(k,793) + lu(k,809) = lu(k,809) - lu(k,288) * lu(k,793) + lu(k,839) = lu(k,839) - lu(k,283) * lu(k,834) + lu(k,840) = lu(k,840) - lu(k,284) * lu(k,834) + lu(k,847) = lu(k,847) - lu(k,285) * lu(k,834) + lu(k,849) = lu(k,849) - lu(k,286) * lu(k,834) + lu(k,853) = lu(k,853) - lu(k,287) * lu(k,834) + lu(k,858) = lu(k,858) - lu(k,288) * lu(k,834) + lu(k,290) = 1._r8 / lu(k,290) + lu(k,291) = lu(k,291) * lu(k,290) + lu(k,292) = lu(k,292) * lu(k,290) + lu(k,293) = lu(k,293) * lu(k,290) + lu(k,294) = lu(k,294) * lu(k,290) + lu(k,295) = lu(k,295) * lu(k,290) + lu(k,296) = lu(k,296) * lu(k,290) + lu(k,297) = lu(k,297) * lu(k,290) + lu(k,298) = lu(k,298) * lu(k,290) + lu(k,393) = lu(k,393) - lu(k,291) * lu(k,390) + lu(k,394) = lu(k,394) - lu(k,292) * lu(k,390) + lu(k,395) = lu(k,395) - lu(k,293) * lu(k,390) + lu(k,400) = - lu(k,294) * lu(k,390) + lu(k,406) = lu(k,406) - lu(k,295) * lu(k,390) + lu(k,407) = lu(k,407) - lu(k,296) * lu(k,390) + lu(k,408) = - lu(k,297) * lu(k,390) + lu(k,409) = lu(k,409) - lu(k,298) * lu(k,390) + lu(k,714) = lu(k,714) - lu(k,291) * lu(k,713) + lu(k,715) = lu(k,715) - lu(k,292) * lu(k,713) + lu(k,716) = lu(k,716) - lu(k,293) * lu(k,713) + lu(k,722) = - lu(k,294) * lu(k,713) + lu(k,730) = lu(k,730) - lu(k,295) * lu(k,713) + lu(k,731) = lu(k,731) - lu(k,296) * lu(k,713) + lu(k,732) = - lu(k,297) * lu(k,713) + lu(k,734) = lu(k,734) - lu(k,298) * lu(k,713) + lu(k,841) = lu(k,841) - lu(k,291) * lu(k,835) + lu(k,842) = lu(k,842) - lu(k,292) * lu(k,835) + lu(k,844) = lu(k,844) - lu(k,293) * lu(k,835) + lu(k,850) = lu(k,850) - lu(k,294) * lu(k,835) + lu(k,858) = lu(k,858) - lu(k,295) * lu(k,835) + lu(k,859) = lu(k,859) - lu(k,296) * lu(k,835) + lu(k,860) = lu(k,860) - lu(k,297) * lu(k,835) + lu(k,862) = lu(k,862) - lu(k,298) * lu(k,835) + lu(k,865) = - lu(k,291) * lu(k,864) + lu(k,866) = - lu(k,292) * lu(k,864) + lu(k,867) = lu(k,867) - lu(k,293) * lu(k,864) + lu(k,873) = - lu(k,294) * lu(k,864) + lu(k,881) = lu(k,881) - lu(k,295) * lu(k,864) + lu(k,882) = lu(k,882) - lu(k,296) * lu(k,864) + lu(k,883) = - lu(k,297) * lu(k,864) + lu(k,885) = lu(k,885) - lu(k,298) * lu(k,864) + lu(k,888) = - lu(k,291) * lu(k,887) + lu(k,889) = - lu(k,292) * lu(k,887) + lu(k,890) = lu(k,890) - lu(k,293) * lu(k,887) + lu(k,896) = lu(k,896) - lu(k,294) * lu(k,887) + lu(k,904) = lu(k,904) - lu(k,295) * lu(k,887) + lu(k,905) = - lu(k,296) * lu(k,887) + lu(k,906) = lu(k,906) - lu(k,297) * lu(k,887) + lu(k,908) = lu(k,908) - lu(k,298) * lu(k,887) + lu(k,938) = - lu(k,291) * lu(k,936) + lu(k,939) = - lu(k,292) * lu(k,936) + lu(k,941) = lu(k,941) - lu(k,293) * lu(k,936) + lu(k,947) = - lu(k,294) * lu(k,936) + lu(k,955) = lu(k,955) - lu(k,295) * lu(k,936) + lu(k,956) = lu(k,956) - lu(k,296) * lu(k,936) + lu(k,957) = - lu(k,297) * lu(k,936) + lu(k,959) = lu(k,959) - lu(k,298) * lu(k,936) + 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,300) = 1._r8 / lu(k,300) + lu(k,301) = lu(k,301) * lu(k,300) + lu(k,302) = lu(k,302) * lu(k,300) + lu(k,303) = lu(k,303) * lu(k,300) + lu(k,304) = lu(k,304) * lu(k,300) + lu(k,305) = lu(k,305) * lu(k,300) + lu(k,425) = lu(k,425) - lu(k,301) * lu(k,424) + lu(k,429) = - lu(k,302) * lu(k,424) + lu(k,432) = lu(k,432) - lu(k,303) * lu(k,424) + lu(k,436) = lu(k,436) - lu(k,304) * lu(k,424) + lu(k,438) = - lu(k,305) * lu(k,424) + lu(k,506) = lu(k,506) - lu(k,301) * lu(k,500) + lu(k,510) = lu(k,510) - lu(k,302) * lu(k,500) + lu(k,513) = lu(k,513) - lu(k,303) * lu(k,500) + lu(k,518) = lu(k,518) - lu(k,304) * lu(k,500) + lu(k,521) = - lu(k,305) * lu(k,500) + lu(k,526) = lu(k,526) - lu(k,301) * lu(k,525) + lu(k,530) = lu(k,530) - lu(k,302) * lu(k,525) + lu(k,534) = lu(k,534) - lu(k,303) * lu(k,525) + lu(k,539) = lu(k,539) - lu(k,304) * lu(k,525) + lu(k,542) = - lu(k,305) * lu(k,525) + lu(k,575) = - lu(k,301) * lu(k,572) + lu(k,580) = lu(k,580) - lu(k,302) * lu(k,572) + lu(k,584) = lu(k,584) - lu(k,303) * lu(k,572) + lu(k,589) = lu(k,589) - lu(k,304) * lu(k,572) + lu(k,593) = - lu(k,305) * lu(k,572) + lu(k,602) = lu(k,602) - lu(k,301) * lu(k,599) + lu(k,608) = lu(k,608) - lu(k,302) * lu(k,599) + lu(k,612) = lu(k,612) - lu(k,303) * lu(k,599) + lu(k,617) = lu(k,617) - lu(k,304) * lu(k,599) + lu(k,621) = lu(k,621) - lu(k,305) * lu(k,599) + lu(k,632) = lu(k,632) - lu(k,301) * lu(k,627) + lu(k,637) = lu(k,637) - lu(k,302) * lu(k,627) + lu(k,641) = lu(k,641) - lu(k,303) * lu(k,627) + lu(k,646) = lu(k,646) - lu(k,304) * lu(k,627) + lu(k,650) = lu(k,650) - lu(k,305) * lu(k,627) + lu(k,673) = lu(k,673) - lu(k,301) * lu(k,666) + lu(k,679) = lu(k,679) - lu(k,302) * lu(k,666) + lu(k,683) = lu(k,683) - lu(k,303) * lu(k,666) + lu(k,688) = lu(k,688) - lu(k,304) * lu(k,666) + lu(k,692) = lu(k,692) - lu(k,305) * lu(k,666) + lu(k,843) = lu(k,843) - lu(k,301) * lu(k,836) + lu(k,849) = lu(k,849) - lu(k,302) * lu(k,836) + lu(k,853) = lu(k,853) - lu(k,303) * lu(k,836) + lu(k,858) = lu(k,858) - lu(k,304) * lu(k,836) + lu(k,862) = lu(k,862) - lu(k,305) * lu(k,836) + lu(k,914) = lu(k,914) - lu(k,301) * lu(k,913) + lu(k,919) = lu(k,919) - lu(k,302) * lu(k,913) + lu(k,923) = lu(k,923) - lu(k,303) * lu(k,913) + lu(k,928) = lu(k,928) - lu(k,304) * lu(k,913) + lu(k,932) = lu(k,932) - lu(k,305) * lu(k,913) + lu(k,940) = - lu(k,301) * lu(k,937) + lu(k,946) = - lu(k,302) * lu(k,937) + lu(k,950) = lu(k,950) - lu(k,303) * lu(k,937) + lu(k,955) = lu(k,955) - lu(k,304) * lu(k,937) + lu(k,959) = lu(k,959) - lu(k,305) * lu(k,937) + 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,453) = lu(k,453) - lu(k,309) * lu(k,451) + lu(k,457) = - lu(k,310) * lu(k,451) + lu(k,458) = lu(k,458) - lu(k,311) * lu(k,451) + lu(k,459) = - lu(k,312) * lu(k,451) + lu(k,460) = lu(k,460) - lu(k,313) * lu(k,451) + lu(k,462) = lu(k,462) - lu(k,314) * lu(k,451) + lu(k,464) = lu(k,464) - lu(k,315) * lu(k,451) + lu(k,466) = lu(k,466) - lu(k,316) * lu(k,451) + lu(k,468) = lu(k,468) - lu(k,317) * lu(k,451) + lu(k,604) = lu(k,604) - lu(k,309) * lu(k,600) + lu(k,609) = - lu(k,310) * lu(k,600) + lu(k,610) = lu(k,610) - lu(k,311) * lu(k,600) + lu(k,611) = lu(k,611) - lu(k,312) * lu(k,600) + lu(k,612) = lu(k,612) - lu(k,313) * lu(k,600) + lu(k,615) = lu(k,615) - lu(k,314) * lu(k,600) + lu(k,617) = lu(k,617) - lu(k,315) * lu(k,600) + lu(k,619) = - lu(k,316) * lu(k,600) + lu(k,621) = lu(k,621) - lu(k,317) * lu(k,600) + lu(k,634) = lu(k,634) - lu(k,309) * lu(k,628) + lu(k,638) = lu(k,638) - lu(k,310) * lu(k,628) + lu(k,639) = lu(k,639) - lu(k,311) * lu(k,628) + lu(k,640) = lu(k,640) - lu(k,312) * lu(k,628) + lu(k,641) = lu(k,641) - lu(k,313) * lu(k,628) + lu(k,644) = lu(k,644) - lu(k,314) * lu(k,628) + lu(k,646) = lu(k,646) - lu(k,315) * lu(k,628) + lu(k,648) = lu(k,648) - lu(k,316) * lu(k,628) + lu(k,650) = lu(k,650) - lu(k,317) * lu(k,628) + lu(k,675) = lu(k,675) - lu(k,309) * lu(k,667) + lu(k,680) = lu(k,680) - lu(k,310) * lu(k,667) + lu(k,681) = lu(k,681) - lu(k,311) * lu(k,667) + lu(k,682) = lu(k,682) - lu(k,312) * lu(k,667) + lu(k,683) = lu(k,683) - lu(k,313) * lu(k,667) + lu(k,686) = lu(k,686) - lu(k,314) * lu(k,667) + lu(k,688) = lu(k,688) - lu(k,315) * lu(k,667) + lu(k,690) = lu(k,690) - lu(k,316) * lu(k,667) + lu(k,692) = lu(k,692) - lu(k,317) * lu(k,667) + lu(k,774) = lu(k,774) - lu(k,309) * lu(k,768) + lu(k,779) = lu(k,779) - lu(k,310) * lu(k,768) + lu(k,780) = lu(k,780) - lu(k,311) * lu(k,768) + lu(k,781) = - lu(k,312) * lu(k,768) + lu(k,782) = lu(k,782) - lu(k,313) * lu(k,768) + lu(k,785) = lu(k,785) - lu(k,314) * lu(k,768) + lu(k,787) = lu(k,787) - lu(k,315) * lu(k,768) + lu(k,789) = - lu(k,316) * lu(k,768) + lu(k,791) = lu(k,791) - lu(k,317) * lu(k,768) + lu(k,845) = lu(k,845) - lu(k,309) * lu(k,837) + lu(k,850) = lu(k,850) - lu(k,310) * lu(k,837) + lu(k,851) = lu(k,851) - lu(k,311) * lu(k,837) + lu(k,852) = lu(k,852) - lu(k,312) * lu(k,837) + lu(k,853) = lu(k,853) - lu(k,313) * lu(k,837) + lu(k,856) = lu(k,856) - lu(k,314) * lu(k,837) + lu(k,858) = lu(k,858) - lu(k,315) * lu(k,837) + lu(k,860) = lu(k,860) - lu(k,316) * lu(k,837) + lu(k,862) = lu(k,862) - lu(k,317) * lu(k,837) + 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,326) = lu(k,326) * lu(k,323) + lu(k,327) = lu(k,327) * lu(k,323) + lu(k,328) = lu(k,328) * lu(k,323) + lu(k,329) = lu(k,329) * lu(k,323) + lu(k,330) = lu(k,330) * lu(k,323) + lu(k,331) = lu(k,331) * lu(k,323) + lu(k,334) = lu(k,334) - lu(k,324) * lu(k,333) + lu(k,335) = lu(k,335) - lu(k,325) * lu(k,333) + lu(k,336) = lu(k,336) - lu(k,326) * lu(k,333) + lu(k,337) = lu(k,337) - lu(k,327) * lu(k,333) + lu(k,338) = lu(k,338) - lu(k,328) * lu(k,333) + lu(k,339) = lu(k,339) - lu(k,329) * lu(k,333) + lu(k,340) = lu(k,340) - lu(k,330) * lu(k,333) + lu(k,341) = lu(k,341) - lu(k,331) * lu(k,333) + lu(k,346) = lu(k,346) - lu(k,324) * lu(k,345) + lu(k,347) = lu(k,347) - lu(k,325) * lu(k,345) + lu(k,348) = lu(k,348) - lu(k,326) * lu(k,345) + lu(k,349) = lu(k,349) - lu(k,327) * lu(k,345) + lu(k,351) = lu(k,351) - lu(k,328) * lu(k,345) + lu(k,353) = lu(k,353) - lu(k,329) * lu(k,345) + lu(k,354) = lu(k,354) - lu(k,330) * lu(k,345) + lu(k,355) = lu(k,355) - lu(k,331) * lu(k,345) + lu(k,359) = lu(k,359) - lu(k,324) * lu(k,358) + lu(k,360) = lu(k,360) - lu(k,325) * lu(k,358) + lu(k,361) = lu(k,361) - lu(k,326) * lu(k,358) + lu(k,362) = - lu(k,327) * lu(k,358) + lu(k,364) = lu(k,364) - lu(k,328) * lu(k,358) + lu(k,366) = lu(k,366) - lu(k,329) * lu(k,358) + lu(k,367) = lu(k,367) - lu(k,330) * lu(k,358) + lu(k,368) = lu(k,368) - lu(k,331) * lu(k,358) + lu(k,375) = lu(k,375) - lu(k,324) * lu(k,374) + lu(k,376) = lu(k,376) - lu(k,325) * lu(k,374) + lu(k,377) = lu(k,377) - lu(k,326) * lu(k,374) + lu(k,378) = lu(k,378) - lu(k,327) * lu(k,374) + lu(k,380) = lu(k,380) - lu(k,328) * lu(k,374) + lu(k,383) = lu(k,383) - lu(k,329) * lu(k,374) + lu(k,384) = - lu(k,330) * lu(k,374) + lu(k,385) = - lu(k,331) * lu(k,374) + lu(k,502) = lu(k,502) - lu(k,324) * lu(k,501) + lu(k,503) = lu(k,503) - lu(k,325) * lu(k,501) + lu(k,504) = lu(k,504) - lu(k,326) * lu(k,501) + lu(k,505) = lu(k,505) - lu(k,327) * lu(k,501) + lu(k,508) = lu(k,508) - lu(k,328) * lu(k,501) + lu(k,513) = lu(k,513) - lu(k,329) * lu(k,501) + lu(k,514) = lu(k,514) - lu(k,330) * lu(k,501) + lu(k,515) = lu(k,515) - lu(k,331) * lu(k,501) + lu(k,669) = lu(k,669) - lu(k,324) * lu(k,668) + lu(k,670) = lu(k,670) - lu(k,325) * lu(k,668) + lu(k,671) = lu(k,671) - lu(k,326) * lu(k,668) + lu(k,672) = lu(k,672) - lu(k,327) * lu(k,668) + lu(k,677) = lu(k,677) - lu(k,328) * lu(k,668) + lu(k,683) = lu(k,683) - lu(k,329) * lu(k,668) + lu(k,684) = lu(k,684) - lu(k,330) * lu(k,668) + lu(k,685) = lu(k,685) - lu(k,331) * lu(k,668) + lu(k,737) = lu(k,737) - lu(k,324) * lu(k,736) + lu(k,738) = lu(k,738) - lu(k,325) * lu(k,736) + lu(k,739) = lu(k,739) - lu(k,326) * lu(k,736) + lu(k,740) = - lu(k,327) * lu(k,736) + lu(k,744) = lu(k,744) - lu(k,328) * lu(k,736) + lu(k,750) = lu(k,750) - lu(k,329) * lu(k,736) + lu(k,751) = - lu(k,330) * lu(k,736) + lu(k,752) = lu(k,752) - lu(k,331) * lu(k,736) + lu(k,334) = 1._r8 / lu(k,334) + lu(k,335) = lu(k,335) * lu(k,334) + lu(k,336) = lu(k,336) * lu(k,334) + lu(k,337) = lu(k,337) * lu(k,334) + lu(k,338) = lu(k,338) * lu(k,334) + lu(k,339) = lu(k,339) * lu(k,334) + lu(k,340) = lu(k,340) * lu(k,334) + lu(k,341) = lu(k,341) * lu(k,334) + lu(k,347) = lu(k,347) - lu(k,335) * lu(k,346) + lu(k,348) = lu(k,348) - lu(k,336) * lu(k,346) + lu(k,349) = lu(k,349) - lu(k,337) * lu(k,346) + lu(k,351) = lu(k,351) - lu(k,338) * lu(k,346) + lu(k,353) = lu(k,353) - lu(k,339) * lu(k,346) + lu(k,354) = lu(k,354) - lu(k,340) * lu(k,346) + lu(k,355) = lu(k,355) - lu(k,341) * lu(k,346) + lu(k,360) = lu(k,360) - lu(k,335) * lu(k,359) + lu(k,361) = lu(k,361) - lu(k,336) * lu(k,359) + lu(k,362) = lu(k,362) - lu(k,337) * lu(k,359) + lu(k,364) = lu(k,364) - lu(k,338) * lu(k,359) + lu(k,366) = lu(k,366) - lu(k,339) * lu(k,359) + lu(k,367) = lu(k,367) - lu(k,340) * lu(k,359) + lu(k,368) = lu(k,368) - lu(k,341) * lu(k,359) + lu(k,376) = lu(k,376) - lu(k,335) * lu(k,375) + lu(k,377) = lu(k,377) - lu(k,336) * lu(k,375) + lu(k,378) = lu(k,378) - lu(k,337) * lu(k,375) + lu(k,380) = lu(k,380) - lu(k,338) * lu(k,375) + lu(k,383) = lu(k,383) - lu(k,339) * lu(k,375) + lu(k,384) = lu(k,384) - lu(k,340) * lu(k,375) + lu(k,385) = lu(k,385) - lu(k,341) * lu(k,375) + lu(k,503) = lu(k,503) - lu(k,335) * lu(k,502) + lu(k,504) = lu(k,504) - lu(k,336) * lu(k,502) + lu(k,505) = lu(k,505) - lu(k,337) * lu(k,502) + lu(k,508) = lu(k,508) - lu(k,338) * lu(k,502) + lu(k,513) = lu(k,513) - lu(k,339) * lu(k,502) + lu(k,514) = lu(k,514) - lu(k,340) * lu(k,502) + lu(k,515) = lu(k,515) - lu(k,341) * lu(k,502) + lu(k,670) = lu(k,670) - lu(k,335) * lu(k,669) + lu(k,671) = lu(k,671) - lu(k,336) * lu(k,669) + lu(k,672) = lu(k,672) - lu(k,337) * lu(k,669) + lu(k,677) = lu(k,677) - lu(k,338) * lu(k,669) + lu(k,683) = lu(k,683) - lu(k,339) * lu(k,669) + lu(k,684) = lu(k,684) - lu(k,340) * lu(k,669) + lu(k,685) = lu(k,685) - lu(k,341) * lu(k,669) + lu(k,738) = lu(k,738) - lu(k,335) * lu(k,737) + lu(k,739) = lu(k,739) - lu(k,336) * lu(k,737) + lu(k,740) = lu(k,740) - lu(k,337) * lu(k,737) + lu(k,744) = lu(k,744) - lu(k,338) * lu(k,737) + lu(k,750) = lu(k,750) - lu(k,339) * lu(k,737) + lu(k,751) = lu(k,751) - lu(k,340) * lu(k,737) + lu(k,752) = lu(k,752) - lu(k,341) * lu(k,737) + 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,347) = 1._r8 / lu(k,347) + lu(k,348) = lu(k,348) * lu(k,347) + lu(k,349) = lu(k,349) * lu(k,347) + lu(k,350) = lu(k,350) * lu(k,347) + lu(k,351) = lu(k,351) * lu(k,347) + lu(k,352) = lu(k,352) * lu(k,347) + lu(k,353) = lu(k,353) * lu(k,347) + lu(k,354) = lu(k,354) * lu(k,347) + lu(k,355) = lu(k,355) * lu(k,347) + lu(k,356) = lu(k,356) * lu(k,347) + lu(k,361) = lu(k,361) - lu(k,348) * lu(k,360) + lu(k,362) = lu(k,362) - lu(k,349) * lu(k,360) + lu(k,363) = - lu(k,350) * lu(k,360) + lu(k,364) = lu(k,364) - lu(k,351) * lu(k,360) + lu(k,365) = - lu(k,352) * lu(k,360) + lu(k,366) = lu(k,366) - lu(k,353) * lu(k,360) + lu(k,367) = lu(k,367) - lu(k,354) * lu(k,360) + lu(k,368) = lu(k,368) - lu(k,355) * lu(k,360) + lu(k,369) = - lu(k,356) * lu(k,360) + lu(k,377) = lu(k,377) - lu(k,348) * lu(k,376) + lu(k,378) = lu(k,378) - lu(k,349) * lu(k,376) + lu(k,379) = - lu(k,350) * lu(k,376) + lu(k,380) = lu(k,380) - lu(k,351) * lu(k,376) + lu(k,382) = - lu(k,352) * lu(k,376) + lu(k,383) = lu(k,383) - lu(k,353) * lu(k,376) + lu(k,384) = lu(k,384) - lu(k,354) * lu(k,376) + lu(k,385) = lu(k,385) - lu(k,355) * lu(k,376) + lu(k,386) = lu(k,386) - lu(k,356) * lu(k,376) + lu(k,504) = lu(k,504) - lu(k,348) * lu(k,503) + lu(k,505) = lu(k,505) - lu(k,349) * lu(k,503) + lu(k,507) = lu(k,507) - lu(k,350) * lu(k,503) + lu(k,508) = lu(k,508) - lu(k,351) * lu(k,503) + lu(k,512) = - lu(k,352) * lu(k,503) + lu(k,513) = lu(k,513) - lu(k,353) * lu(k,503) + lu(k,514) = lu(k,514) - lu(k,354) * lu(k,503) + lu(k,515) = lu(k,515) - lu(k,355) * lu(k,503) + lu(k,518) = lu(k,518) - lu(k,356) * lu(k,503) + lu(k,630) = - lu(k,348) * lu(k,629) + lu(k,631) = - lu(k,349) * lu(k,629) + lu(k,633) = - lu(k,350) * lu(k,629) + lu(k,635) = lu(k,635) - lu(k,351) * lu(k,629) + lu(k,640) = lu(k,640) - lu(k,352) * lu(k,629) + lu(k,641) = lu(k,641) - lu(k,353) * lu(k,629) + lu(k,642) = lu(k,642) - lu(k,354) * lu(k,629) + lu(k,643) = lu(k,643) - lu(k,355) * lu(k,629) + lu(k,646) = lu(k,646) - lu(k,356) * lu(k,629) + lu(k,671) = lu(k,671) - lu(k,348) * lu(k,670) + lu(k,672) = lu(k,672) - lu(k,349) * lu(k,670) + lu(k,674) = lu(k,674) - lu(k,350) * lu(k,670) + lu(k,677) = lu(k,677) - lu(k,351) * lu(k,670) + lu(k,682) = lu(k,682) - lu(k,352) * lu(k,670) + lu(k,683) = lu(k,683) - lu(k,353) * lu(k,670) + lu(k,684) = lu(k,684) - lu(k,354) * lu(k,670) + lu(k,685) = lu(k,685) - lu(k,355) * lu(k,670) + lu(k,688) = lu(k,688) - lu(k,356) * lu(k,670) + lu(k,739) = lu(k,739) - lu(k,348) * lu(k,738) + lu(k,740) = lu(k,740) - lu(k,349) * lu(k,738) + lu(k,742) = - lu(k,350) * lu(k,738) + lu(k,744) = lu(k,744) - lu(k,351) * lu(k,738) + lu(k,749) = lu(k,749) - lu(k,352) * lu(k,738) + lu(k,750) = lu(k,750) - lu(k,353) * lu(k,738) + lu(k,751) = lu(k,751) - lu(k,354) * lu(k,738) + lu(k,752) = lu(k,752) - lu(k,355) * lu(k,738) + lu(k,755) = lu(k,755) - lu(k,356) * lu(k,738) + lu(k,839) = lu(k,839) - lu(k,348) * lu(k,838) + lu(k,840) = lu(k,840) - lu(k,349) * lu(k,838) + lu(k,844) = lu(k,844) - lu(k,350) * lu(k,838) + lu(k,847) = lu(k,847) - lu(k,351) * lu(k,838) + lu(k,852) = lu(k,852) - lu(k,352) * lu(k,838) + lu(k,853) = lu(k,853) - lu(k,353) * lu(k,838) + lu(k,854) = lu(k,854) - lu(k,354) * lu(k,838) + lu(k,855) = lu(k,855) - lu(k,355) * lu(k,838) + lu(k,858) = lu(k,858) - lu(k,356) * lu(k,838) + lu(k,361) = 1._r8 / lu(k,361) + lu(k,362) = lu(k,362) * lu(k,361) + lu(k,363) = lu(k,363) * lu(k,361) + lu(k,364) = lu(k,364) * lu(k,361) + lu(k,365) = lu(k,365) * lu(k,361) + lu(k,366) = lu(k,366) * lu(k,361) + lu(k,367) = lu(k,367) * lu(k,361) + lu(k,368) = lu(k,368) * lu(k,361) + lu(k,369) = lu(k,369) * lu(k,361) + lu(k,378) = lu(k,378) - lu(k,362) * lu(k,377) + lu(k,379) = lu(k,379) - lu(k,363) * lu(k,377) + lu(k,380) = lu(k,380) - lu(k,364) * lu(k,377) + lu(k,382) = lu(k,382) - lu(k,365) * lu(k,377) + lu(k,383) = lu(k,383) - lu(k,366) * lu(k,377) + lu(k,384) = lu(k,384) - lu(k,367) * lu(k,377) + lu(k,385) = lu(k,385) - lu(k,368) * lu(k,377) + lu(k,386) = lu(k,386) - lu(k,369) * lu(k,377) + lu(k,392) = lu(k,392) - lu(k,362) * lu(k,391) + lu(k,395) = lu(k,395) - lu(k,363) * lu(k,391) + lu(k,398) = lu(k,398) - lu(k,364) * lu(k,391) + lu(k,401) = - lu(k,365) * lu(k,391) + lu(k,402) = lu(k,402) - lu(k,366) * lu(k,391) + lu(k,403) = lu(k,403) - lu(k,367) * lu(k,391) + lu(k,404) = - lu(k,368) * lu(k,391) + lu(k,406) = lu(k,406) - lu(k,369) * lu(k,391) + lu(k,472) = lu(k,472) - lu(k,362) * lu(k,471) + lu(k,473) = lu(k,473) - lu(k,363) * lu(k,471) + lu(k,476) = lu(k,476) - lu(k,364) * lu(k,471) + lu(k,481) = - lu(k,365) * lu(k,471) + lu(k,482) = lu(k,482) - lu(k,366) * lu(k,471) + lu(k,483) = lu(k,483) - lu(k,367) * lu(k,471) + lu(k,484) = - lu(k,368) * lu(k,471) + lu(k,487) = lu(k,487) - lu(k,369) * lu(k,471) + lu(k,505) = lu(k,505) - lu(k,362) * lu(k,504) + lu(k,507) = lu(k,507) - lu(k,363) * lu(k,504) + lu(k,508) = lu(k,508) - lu(k,364) * lu(k,504) + lu(k,512) = lu(k,512) - lu(k,365) * lu(k,504) + lu(k,513) = lu(k,513) - lu(k,366) * lu(k,504) + lu(k,514) = lu(k,514) - lu(k,367) * lu(k,504) + lu(k,515) = lu(k,515) - lu(k,368) * lu(k,504) + lu(k,518) = lu(k,518) - lu(k,369) * lu(k,504) + lu(k,574) = lu(k,574) - lu(k,362) * lu(k,573) + lu(k,576) = - lu(k,363) * lu(k,573) + lu(k,578) = lu(k,578) - lu(k,364) * lu(k,573) + lu(k,583) = lu(k,583) - lu(k,365) * lu(k,573) + lu(k,584) = lu(k,584) - lu(k,366) * lu(k,573) + lu(k,585) = - lu(k,367) * lu(k,573) + lu(k,586) = lu(k,586) - lu(k,368) * lu(k,573) + lu(k,589) = lu(k,589) - lu(k,369) * lu(k,573) + lu(k,631) = lu(k,631) - lu(k,362) * lu(k,630) + lu(k,633) = lu(k,633) - lu(k,363) * lu(k,630) + lu(k,635) = lu(k,635) - lu(k,364) * lu(k,630) + lu(k,640) = lu(k,640) - lu(k,365) * lu(k,630) + lu(k,641) = lu(k,641) - lu(k,366) * lu(k,630) + lu(k,642) = lu(k,642) - lu(k,367) * lu(k,630) + lu(k,643) = lu(k,643) - lu(k,368) * lu(k,630) + lu(k,646) = lu(k,646) - lu(k,369) * lu(k,630) + lu(k,672) = lu(k,672) - lu(k,362) * lu(k,671) + lu(k,674) = lu(k,674) - lu(k,363) * lu(k,671) + lu(k,677) = lu(k,677) - lu(k,364) * lu(k,671) + lu(k,682) = lu(k,682) - lu(k,365) * lu(k,671) + lu(k,683) = lu(k,683) - lu(k,366) * lu(k,671) + lu(k,684) = lu(k,684) - lu(k,367) * lu(k,671) + lu(k,685) = lu(k,685) - lu(k,368) * lu(k,671) + lu(k,688) = lu(k,688) - lu(k,369) * lu(k,671) + lu(k,740) = lu(k,740) - lu(k,362) * lu(k,739) + lu(k,742) = lu(k,742) - lu(k,363) * lu(k,739) + lu(k,744) = lu(k,744) - lu(k,364) * lu(k,739) + lu(k,749) = lu(k,749) - lu(k,365) * lu(k,739) + lu(k,750) = lu(k,750) - lu(k,366) * lu(k,739) + lu(k,751) = lu(k,751) - lu(k,367) * lu(k,739) + lu(k,752) = lu(k,752) - lu(k,368) * lu(k,739) + lu(k,755) = lu(k,755) - lu(k,369) * lu(k,739) + lu(k,770) = lu(k,770) - lu(k,362) * lu(k,769) + lu(k,773) = lu(k,773) - lu(k,363) * lu(k,769) + lu(k,776) = lu(k,776) - lu(k,364) * lu(k,769) + lu(k,781) = lu(k,781) - lu(k,365) * lu(k,769) + lu(k,782) = lu(k,782) - lu(k,366) * lu(k,769) + lu(k,783) = lu(k,783) - lu(k,367) * lu(k,769) + lu(k,784) = - lu(k,368) * lu(k,769) + lu(k,787) = lu(k,787) - lu(k,369) * lu(k,769) + lu(k,795) = lu(k,795) - lu(k,362) * lu(k,794) + lu(k,796) = lu(k,796) - lu(k,363) * lu(k,794) + lu(k,798) = lu(k,798) - lu(k,364) * lu(k,794) + lu(k,803) = - lu(k,365) * lu(k,794) + lu(k,804) = lu(k,804) - lu(k,366) * lu(k,794) + lu(k,805) = lu(k,805) - lu(k,367) * lu(k,794) + lu(k,806) = - lu(k,368) * lu(k,794) + lu(k,809) = lu(k,809) - lu(k,369) * lu(k,794) + lu(k,840) = lu(k,840) - lu(k,362) * lu(k,839) + lu(k,844) = lu(k,844) - lu(k,363) * lu(k,839) + lu(k,847) = lu(k,847) - lu(k,364) * lu(k,839) + lu(k,852) = lu(k,852) - lu(k,365) * lu(k,839) + lu(k,853) = lu(k,853) - lu(k,366) * lu(k,839) + lu(k,854) = lu(k,854) - lu(k,367) * lu(k,839) + lu(k,855) = lu(k,855) - lu(k,368) * lu(k,839) + lu(k,858) = lu(k,858) - lu(k,369) * lu(k,839) + lu(k,378) = 1._r8 / lu(k,378) + lu(k,379) = lu(k,379) * lu(k,378) + lu(k,380) = lu(k,380) * lu(k,378) + lu(k,381) = lu(k,381) * lu(k,378) + lu(k,382) = lu(k,382) * lu(k,378) + lu(k,383) = lu(k,383) * lu(k,378) + lu(k,384) = lu(k,384) * lu(k,378) + lu(k,385) = lu(k,385) * lu(k,378) + lu(k,386) = lu(k,386) * lu(k,378) + lu(k,395) = lu(k,395) - lu(k,379) * lu(k,392) + lu(k,398) = lu(k,398) - lu(k,380) * lu(k,392) + lu(k,399) = lu(k,399) - lu(k,381) * lu(k,392) + lu(k,401) = lu(k,401) - lu(k,382) * lu(k,392) + lu(k,402) = lu(k,402) - lu(k,383) * lu(k,392) + lu(k,403) = lu(k,403) - lu(k,384) * lu(k,392) + lu(k,404) = lu(k,404) - lu(k,385) * lu(k,392) + lu(k,406) = lu(k,406) - lu(k,386) * lu(k,392) + lu(k,473) = lu(k,473) - lu(k,379) * lu(k,472) + lu(k,476) = lu(k,476) - lu(k,380) * lu(k,472) + lu(k,478) = lu(k,478) - lu(k,381) * lu(k,472) + lu(k,481) = lu(k,481) - lu(k,382) * lu(k,472) + lu(k,482) = lu(k,482) - lu(k,383) * lu(k,472) + lu(k,483) = lu(k,483) - lu(k,384) * lu(k,472) + lu(k,484) = lu(k,484) - lu(k,385) * lu(k,472) + lu(k,487) = lu(k,487) - lu(k,386) * lu(k,472) + lu(k,507) = lu(k,507) - lu(k,379) * lu(k,505) + lu(k,508) = lu(k,508) - lu(k,380) * lu(k,505) + lu(k,510) = lu(k,510) - lu(k,381) * lu(k,505) + lu(k,512) = lu(k,512) - lu(k,382) * lu(k,505) + lu(k,513) = lu(k,513) - lu(k,383) * lu(k,505) + lu(k,514) = lu(k,514) - lu(k,384) * lu(k,505) + lu(k,515) = lu(k,515) - lu(k,385) * lu(k,505) + lu(k,518) = lu(k,518) - lu(k,386) * lu(k,505) + lu(k,576) = lu(k,576) - lu(k,379) * lu(k,574) + lu(k,578) = lu(k,578) - lu(k,380) * lu(k,574) + lu(k,580) = lu(k,580) - lu(k,381) * lu(k,574) + lu(k,583) = lu(k,583) - lu(k,382) * lu(k,574) + lu(k,584) = lu(k,584) - lu(k,383) * lu(k,574) + lu(k,585) = lu(k,585) - lu(k,384) * lu(k,574) + lu(k,586) = lu(k,586) - lu(k,385) * lu(k,574) + lu(k,589) = lu(k,589) - lu(k,386) * lu(k,574) + lu(k,633) = lu(k,633) - lu(k,379) * lu(k,631) + lu(k,635) = lu(k,635) - lu(k,380) * lu(k,631) + lu(k,637) = lu(k,637) - lu(k,381) * lu(k,631) + lu(k,640) = lu(k,640) - lu(k,382) * lu(k,631) + lu(k,641) = lu(k,641) - lu(k,383) * lu(k,631) + lu(k,642) = lu(k,642) - lu(k,384) * lu(k,631) + lu(k,643) = lu(k,643) - lu(k,385) * lu(k,631) + lu(k,646) = lu(k,646) - lu(k,386) * lu(k,631) + lu(k,674) = lu(k,674) - lu(k,379) * lu(k,672) + lu(k,677) = lu(k,677) - lu(k,380) * lu(k,672) + lu(k,679) = lu(k,679) - lu(k,381) * lu(k,672) + lu(k,682) = lu(k,682) - lu(k,382) * lu(k,672) + lu(k,683) = lu(k,683) - lu(k,383) * lu(k,672) + lu(k,684) = lu(k,684) - lu(k,384) * lu(k,672) + lu(k,685) = lu(k,685) - lu(k,385) * lu(k,672) + lu(k,688) = lu(k,688) - lu(k,386) * lu(k,672) + lu(k,742) = lu(k,742) - lu(k,379) * lu(k,740) + lu(k,744) = lu(k,744) - lu(k,380) * lu(k,740) + lu(k,746) = lu(k,746) - lu(k,381) * lu(k,740) + lu(k,749) = lu(k,749) - lu(k,382) * lu(k,740) + lu(k,750) = lu(k,750) - lu(k,383) * lu(k,740) + lu(k,751) = lu(k,751) - lu(k,384) * lu(k,740) + lu(k,752) = lu(k,752) - lu(k,385) * lu(k,740) + lu(k,755) = lu(k,755) - lu(k,386) * lu(k,740) + lu(k,773) = lu(k,773) - lu(k,379) * lu(k,770) + lu(k,776) = lu(k,776) - lu(k,380) * lu(k,770) + lu(k,778) = lu(k,778) - lu(k,381) * lu(k,770) + lu(k,781) = lu(k,781) - lu(k,382) * lu(k,770) + lu(k,782) = lu(k,782) - lu(k,383) * lu(k,770) + lu(k,783) = lu(k,783) - lu(k,384) * lu(k,770) + lu(k,784) = lu(k,784) - lu(k,385) * lu(k,770) + lu(k,787) = lu(k,787) - lu(k,386) * lu(k,770) + lu(k,796) = lu(k,796) - lu(k,379) * lu(k,795) + lu(k,798) = lu(k,798) - lu(k,380) * lu(k,795) + lu(k,800) = lu(k,800) - lu(k,381) * lu(k,795) + lu(k,803) = lu(k,803) - lu(k,382) * lu(k,795) + lu(k,804) = lu(k,804) - lu(k,383) * lu(k,795) + lu(k,805) = lu(k,805) - lu(k,384) * lu(k,795) + lu(k,806) = lu(k,806) - lu(k,385) * lu(k,795) + lu(k,809) = lu(k,809) - lu(k,386) * lu(k,795) + lu(k,844) = lu(k,844) - lu(k,379) * lu(k,840) + lu(k,847) = lu(k,847) - lu(k,380) * lu(k,840) + lu(k,849) = lu(k,849) - lu(k,381) * lu(k,840) + lu(k,852) = lu(k,852) - lu(k,382) * lu(k,840) + lu(k,853) = lu(k,853) - lu(k,383) * lu(k,840) + lu(k,854) = lu(k,854) - lu(k,384) * lu(k,840) + lu(k,855) = lu(k,855) - lu(k,385) * lu(k,840) + lu(k,858) = lu(k,858) - lu(k,386) * lu(k,840) + lu(k,393) = 1._r8 / lu(k,393) + lu(k,394) = lu(k,394) * lu(k,393) + lu(k,395) = lu(k,395) * lu(k,393) + lu(k,396) = lu(k,396) * lu(k,393) + lu(k,397) = lu(k,397) * lu(k,393) + lu(k,398) = lu(k,398) * lu(k,393) + lu(k,399) = lu(k,399) * lu(k,393) + lu(k,400) = lu(k,400) * lu(k,393) + lu(k,401) = lu(k,401) * lu(k,393) + lu(k,402) = lu(k,402) * lu(k,393) + lu(k,403) = lu(k,403) * lu(k,393) + lu(k,404) = lu(k,404) * lu(k,393) + lu(k,405) = lu(k,405) * lu(k,393) + lu(k,406) = lu(k,406) * lu(k,393) + lu(k,407) = lu(k,407) * lu(k,393) + lu(k,408) = lu(k,408) * lu(k,393) + lu(k,409) = lu(k,409) * lu(k,393) + lu(k,715) = lu(k,715) - lu(k,394) * lu(k,714) + lu(k,716) = lu(k,716) - lu(k,395) * lu(k,714) + lu(k,717) = lu(k,717) - lu(k,396) * lu(k,714) + lu(k,718) = lu(k,718) - lu(k,397) * lu(k,714) + lu(k,719) = lu(k,719) - lu(k,398) * lu(k,714) + lu(k,721) = lu(k,721) - lu(k,399) * lu(k,714) + lu(k,722) = lu(k,722) - lu(k,400) * lu(k,714) + lu(k,724) = - lu(k,401) * lu(k,714) + lu(k,725) = lu(k,725) - lu(k,402) * lu(k,714) + lu(k,726) = lu(k,726) - lu(k,403) * lu(k,714) + lu(k,727) = lu(k,727) - lu(k,404) * lu(k,714) + lu(k,728) = lu(k,728) - lu(k,405) * lu(k,714) + lu(k,730) = lu(k,730) - lu(k,406) * lu(k,714) + lu(k,731) = lu(k,731) - lu(k,407) * lu(k,714) + lu(k,732) = lu(k,732) - lu(k,408) * lu(k,714) + lu(k,734) = lu(k,734) - lu(k,409) * lu(k,714) + lu(k,772) = lu(k,772) - lu(k,394) * lu(k,771) + lu(k,773) = lu(k,773) - lu(k,395) * lu(k,771) + lu(k,774) = lu(k,774) - lu(k,396) * lu(k,771) + lu(k,775) = lu(k,775) - lu(k,397) * lu(k,771) + lu(k,776) = lu(k,776) - lu(k,398) * lu(k,771) + lu(k,778) = lu(k,778) - lu(k,399) * lu(k,771) + lu(k,779) = lu(k,779) - lu(k,400) * lu(k,771) + lu(k,781) = lu(k,781) - lu(k,401) * lu(k,771) + lu(k,782) = lu(k,782) - lu(k,402) * lu(k,771) + lu(k,783) = lu(k,783) - lu(k,403) * lu(k,771) + lu(k,784) = lu(k,784) - lu(k,404) * lu(k,771) + lu(k,785) = lu(k,785) - lu(k,405) * lu(k,771) + lu(k,787) = lu(k,787) - lu(k,406) * lu(k,771) + lu(k,788) = lu(k,788) - lu(k,407) * lu(k,771) + lu(k,789) = lu(k,789) - lu(k,408) * lu(k,771) + lu(k,791) = lu(k,791) - lu(k,409) * lu(k,771) + lu(k,842) = lu(k,842) - lu(k,394) * lu(k,841) + lu(k,844) = lu(k,844) - lu(k,395) * lu(k,841) + lu(k,845) = lu(k,845) - lu(k,396) * lu(k,841) + lu(k,846) = lu(k,846) - lu(k,397) * lu(k,841) + lu(k,847) = lu(k,847) - lu(k,398) * lu(k,841) + lu(k,849) = lu(k,849) - lu(k,399) * lu(k,841) + lu(k,850) = lu(k,850) - lu(k,400) * lu(k,841) + lu(k,852) = lu(k,852) - lu(k,401) * lu(k,841) + lu(k,853) = lu(k,853) - lu(k,402) * lu(k,841) + lu(k,854) = lu(k,854) - lu(k,403) * lu(k,841) + lu(k,855) = lu(k,855) - lu(k,404) * lu(k,841) + lu(k,856) = lu(k,856) - lu(k,405) * lu(k,841) + lu(k,858) = lu(k,858) - lu(k,406) * lu(k,841) + lu(k,859) = lu(k,859) - lu(k,407) * lu(k,841) + lu(k,860) = lu(k,860) - lu(k,408) * lu(k,841) + lu(k,862) = lu(k,862) - lu(k,409) * lu(k,841) + lu(k,866) = lu(k,866) - lu(k,394) * lu(k,865) + lu(k,867) = lu(k,867) - lu(k,395) * lu(k,865) + lu(k,868) = lu(k,868) - lu(k,396) * lu(k,865) + lu(k,869) = - lu(k,397) * lu(k,865) + lu(k,870) = - lu(k,398) * lu(k,865) + lu(k,872) = - lu(k,399) * lu(k,865) + lu(k,873) = lu(k,873) - lu(k,400) * lu(k,865) + lu(k,875) = - lu(k,401) * lu(k,865) + lu(k,876) = lu(k,876) - lu(k,402) * lu(k,865) + lu(k,877) = lu(k,877) - lu(k,403) * lu(k,865) + lu(k,878) = - lu(k,404) * lu(k,865) + lu(k,879) = lu(k,879) - lu(k,405) * lu(k,865) + lu(k,881) = lu(k,881) - lu(k,406) * lu(k,865) + lu(k,882) = lu(k,882) - lu(k,407) * lu(k,865) + lu(k,883) = lu(k,883) - lu(k,408) * lu(k,865) + lu(k,885) = lu(k,885) - lu(k,409) * lu(k,865) + lu(k,889) = lu(k,889) - lu(k,394) * lu(k,888) + lu(k,890) = lu(k,890) - lu(k,395) * lu(k,888) + lu(k,891) = - lu(k,396) * lu(k,888) + lu(k,892) = - lu(k,397) * lu(k,888) + lu(k,893) = - lu(k,398) * lu(k,888) + lu(k,895) = - lu(k,399) * lu(k,888) + lu(k,896) = lu(k,896) - lu(k,400) * lu(k,888) + lu(k,898) = lu(k,898) - lu(k,401) * lu(k,888) + lu(k,899) = - lu(k,402) * lu(k,888) + lu(k,900) = - lu(k,403) * lu(k,888) + lu(k,901) = - lu(k,404) * lu(k,888) + lu(k,902) = - lu(k,405) * lu(k,888) + lu(k,904) = lu(k,904) - lu(k,406) * lu(k,888) + lu(k,905) = lu(k,905) - lu(k,407) * lu(k,888) + lu(k,906) = lu(k,906) - lu(k,408) * lu(k,888) + lu(k,908) = lu(k,908) - lu(k,409) * lu(k,888) + lu(k,939) = lu(k,939) - lu(k,394) * lu(k,938) + lu(k,941) = lu(k,941) - lu(k,395) * lu(k,938) + lu(k,942) = - lu(k,396) * lu(k,938) + lu(k,943) = - lu(k,397) * lu(k,938) + lu(k,944) = - lu(k,398) * lu(k,938) + lu(k,946) = lu(k,946) - lu(k,399) * lu(k,938) + lu(k,947) = lu(k,947) - lu(k,400) * lu(k,938) + lu(k,949) = - lu(k,401) * lu(k,938) + lu(k,950) = lu(k,950) - lu(k,402) * lu(k,938) + lu(k,951) = lu(k,951) - lu(k,403) * lu(k,938) + lu(k,952) = - lu(k,404) * lu(k,938) + lu(k,953) = - lu(k,405) * lu(k,938) + lu(k,955) = lu(k,955) - lu(k,406) * lu(k,938) + lu(k,956) = lu(k,956) - lu(k,407) * lu(k,938) + lu(k,957) = lu(k,957) - lu(k,408) * lu(k,938) + lu(k,959) = lu(k,959) - lu(k,409) * lu(k,938) + 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,411) = 1._r8 / lu(k,411) + lu(k,412) = lu(k,412) * lu(k,411) + lu(k,413) = lu(k,413) * lu(k,411) + lu(k,414) = lu(k,414) * lu(k,411) + lu(k,415) = lu(k,415) * lu(k,411) + lu(k,416) = lu(k,416) * lu(k,411) + lu(k,417) = lu(k,417) * lu(k,411) + lu(k,418) = lu(k,418) * lu(k,411) + lu(k,419) = lu(k,419) * lu(k,411) + lu(k,420) = lu(k,420) * lu(k,411) + lu(k,421) = lu(k,421) * lu(k,411) + lu(k,550) = lu(k,550) - lu(k,412) * lu(k,549) + lu(k,552) = lu(k,552) - lu(k,413) * lu(k,549) + lu(k,553) = lu(k,553) - lu(k,414) * lu(k,549) + lu(k,555) = lu(k,555) - lu(k,415) * lu(k,549) + lu(k,557) = lu(k,557) - lu(k,416) * lu(k,549) + lu(k,558) = lu(k,558) - lu(k,417) * lu(k,549) + lu(k,561) = lu(k,561) - lu(k,418) * lu(k,549) + lu(k,562) = lu(k,562) - lu(k,419) * lu(k,549) + lu(k,564) = lu(k,564) - lu(k,420) * lu(k,549) + lu(k,568) = lu(k,568) - lu(k,421) * lu(k,549) + lu(k,603) = - lu(k,412) * lu(k,601) + lu(k,605) = lu(k,605) - lu(k,413) * lu(k,601) + lu(k,606) = lu(k,606) - lu(k,414) * lu(k,601) + lu(k,608) = lu(k,608) - lu(k,415) * lu(k,601) + lu(k,610) = lu(k,610) - lu(k,416) * lu(k,601) + lu(k,611) = lu(k,611) - lu(k,417) * lu(k,601) + lu(k,614) = lu(k,614) - lu(k,418) * lu(k,601) + lu(k,615) = lu(k,615) - lu(k,419) * lu(k,601) + lu(k,617) = lu(k,617) - lu(k,420) * lu(k,601) + lu(k,621) = lu(k,621) - lu(k,421) * lu(k,601) + lu(k,716) = lu(k,716) - lu(k,412) * lu(k,715) + lu(k,718) = lu(k,718) - lu(k,413) * lu(k,715) + lu(k,719) = lu(k,719) - lu(k,414) * lu(k,715) + lu(k,721) = lu(k,721) - lu(k,415) * lu(k,715) + lu(k,723) = lu(k,723) - lu(k,416) * lu(k,715) + lu(k,724) = lu(k,724) - lu(k,417) * lu(k,715) + lu(k,727) = lu(k,727) - lu(k,418) * lu(k,715) + lu(k,728) = lu(k,728) - lu(k,419) * lu(k,715) + lu(k,730) = lu(k,730) - lu(k,420) * lu(k,715) + lu(k,734) = lu(k,734) - lu(k,421) * lu(k,715) + lu(k,742) = lu(k,742) - lu(k,412) * lu(k,741) + lu(k,743) = lu(k,743) - lu(k,413) * lu(k,741) + lu(k,744) = lu(k,744) - lu(k,414) * lu(k,741) + lu(k,746) = lu(k,746) - lu(k,415) * lu(k,741) + lu(k,748) = lu(k,748) - lu(k,416) * lu(k,741) + lu(k,749) = lu(k,749) - lu(k,417) * lu(k,741) + lu(k,752) = lu(k,752) - lu(k,418) * lu(k,741) + lu(k,753) = lu(k,753) - lu(k,419) * lu(k,741) + lu(k,755) = lu(k,755) - lu(k,420) * lu(k,741) + lu(k,759) = - lu(k,421) * lu(k,741) + lu(k,773) = lu(k,773) - lu(k,412) * lu(k,772) + lu(k,775) = lu(k,775) - lu(k,413) * lu(k,772) + lu(k,776) = lu(k,776) - lu(k,414) * lu(k,772) + lu(k,778) = lu(k,778) - lu(k,415) * lu(k,772) + lu(k,780) = lu(k,780) - lu(k,416) * lu(k,772) + lu(k,781) = lu(k,781) - lu(k,417) * lu(k,772) + lu(k,784) = lu(k,784) - lu(k,418) * lu(k,772) + lu(k,785) = lu(k,785) - lu(k,419) * lu(k,772) + lu(k,787) = lu(k,787) - lu(k,420) * lu(k,772) + lu(k,791) = lu(k,791) - lu(k,421) * lu(k,772) + lu(k,844) = lu(k,844) - lu(k,412) * lu(k,842) + lu(k,846) = lu(k,846) - lu(k,413) * lu(k,842) + lu(k,847) = lu(k,847) - lu(k,414) * lu(k,842) + lu(k,849) = lu(k,849) - lu(k,415) * lu(k,842) + lu(k,851) = lu(k,851) - lu(k,416) * lu(k,842) + lu(k,852) = lu(k,852) - lu(k,417) * lu(k,842) + lu(k,855) = lu(k,855) - lu(k,418) * lu(k,842) + lu(k,856) = lu(k,856) - lu(k,419) * lu(k,842) + lu(k,858) = lu(k,858) - lu(k,420) * lu(k,842) + lu(k,862) = lu(k,862) - lu(k,421) * lu(k,842) + lu(k,867) = lu(k,867) - lu(k,412) * lu(k,866) + lu(k,869) = lu(k,869) - lu(k,413) * lu(k,866) + lu(k,870) = lu(k,870) - lu(k,414) * lu(k,866) + lu(k,872) = lu(k,872) - lu(k,415) * lu(k,866) + lu(k,874) = - lu(k,416) * lu(k,866) + lu(k,875) = lu(k,875) - lu(k,417) * lu(k,866) + lu(k,878) = lu(k,878) - lu(k,418) * lu(k,866) + lu(k,879) = lu(k,879) - lu(k,419) * lu(k,866) + lu(k,881) = lu(k,881) - lu(k,420) * lu(k,866) + lu(k,885) = lu(k,885) - lu(k,421) * lu(k,866) + lu(k,890) = lu(k,890) - lu(k,412) * lu(k,889) + lu(k,892) = lu(k,892) - lu(k,413) * lu(k,889) + lu(k,893) = lu(k,893) - lu(k,414) * lu(k,889) + lu(k,895) = lu(k,895) - lu(k,415) * lu(k,889) + lu(k,897) = - lu(k,416) * lu(k,889) + lu(k,898) = lu(k,898) - lu(k,417) * lu(k,889) + lu(k,901) = lu(k,901) - lu(k,418) * lu(k,889) + lu(k,902) = lu(k,902) - lu(k,419) * lu(k,889) + lu(k,904) = lu(k,904) - lu(k,420) * lu(k,889) + lu(k,908) = lu(k,908) - lu(k,421) * lu(k,889) + lu(k,941) = lu(k,941) - lu(k,412) * lu(k,939) + lu(k,943) = lu(k,943) - lu(k,413) * lu(k,939) + lu(k,944) = lu(k,944) - lu(k,414) * lu(k,939) + lu(k,946) = lu(k,946) - lu(k,415) * lu(k,939) + lu(k,948) = - lu(k,416) * lu(k,939) + lu(k,949) = lu(k,949) - lu(k,417) * lu(k,939) + lu(k,952) = lu(k,952) - lu(k,418) * lu(k,939) + lu(k,953) = lu(k,953) - lu(k,419) * lu(k,939) + lu(k,955) = lu(k,955) - lu(k,420) * lu(k,939) + lu(k,959) = lu(k,959) - lu(k,421) * lu(k,939) + lu(k,425) = 1._r8 / lu(k,425) + lu(k,426) = lu(k,426) * lu(k,425) + lu(k,427) = lu(k,427) * lu(k,425) + lu(k,428) = lu(k,428) * lu(k,425) + lu(k,429) = lu(k,429) * lu(k,425) + lu(k,430) = lu(k,430) * lu(k,425) + lu(k,431) = lu(k,431) * lu(k,425) + lu(k,432) = lu(k,432) * lu(k,425) + lu(k,433) = lu(k,433) * lu(k,425) + lu(k,434) = lu(k,434) * lu(k,425) + lu(k,435) = lu(k,435) * lu(k,425) + lu(k,436) = lu(k,436) * lu(k,425) + lu(k,437) = lu(k,437) * lu(k,425) + lu(k,438) = lu(k,438) * lu(k,425) + lu(k,507) = lu(k,507) - lu(k,426) * lu(k,506) + lu(k,508) = lu(k,508) - lu(k,427) * lu(k,506) + lu(k,509) = lu(k,509) - lu(k,428) * lu(k,506) + lu(k,510) = lu(k,510) - lu(k,429) * lu(k,506) + lu(k,511) = - lu(k,430) * lu(k,506) + lu(k,512) = lu(k,512) - lu(k,431) * lu(k,506) + lu(k,513) = lu(k,513) - lu(k,432) * lu(k,506) + lu(k,515) = lu(k,515) - lu(k,433) * lu(k,506) + lu(k,516) = - lu(k,434) * lu(k,506) + lu(k,517) = - lu(k,435) * lu(k,506) + lu(k,518) = lu(k,518) - lu(k,436) * lu(k,506) + lu(k,520) = - lu(k,437) * lu(k,506) + lu(k,521) = lu(k,521) - lu(k,438) * lu(k,506) + lu(k,527) = lu(k,527) - lu(k,426) * lu(k,526) + lu(k,528) = lu(k,528) - lu(k,427) * lu(k,526) + lu(k,529) = lu(k,529) - lu(k,428) * lu(k,526) + lu(k,530) = lu(k,530) - lu(k,429) * lu(k,526) + lu(k,532) = lu(k,532) - lu(k,430) * lu(k,526) + lu(k,533) = lu(k,533) - lu(k,431) * lu(k,526) + lu(k,534) = lu(k,534) - lu(k,432) * lu(k,526) + lu(k,536) = lu(k,536) - lu(k,433) * lu(k,526) + lu(k,537) = lu(k,537) - lu(k,434) * lu(k,526) + lu(k,538) = lu(k,538) - lu(k,435) * lu(k,526) + lu(k,539) = lu(k,539) - lu(k,436) * lu(k,526) + lu(k,541) = lu(k,541) - lu(k,437) * lu(k,526) + lu(k,542) = lu(k,542) - lu(k,438) * lu(k,526) + lu(k,576) = lu(k,576) - lu(k,426) * lu(k,575) + lu(k,578) = lu(k,578) - lu(k,427) * lu(k,575) + lu(k,579) = - lu(k,428) * lu(k,575) + lu(k,580) = lu(k,580) - lu(k,429) * lu(k,575) + lu(k,582) = - lu(k,430) * lu(k,575) + lu(k,583) = lu(k,583) - lu(k,431) * lu(k,575) + lu(k,584) = lu(k,584) - lu(k,432) * lu(k,575) + lu(k,586) = lu(k,586) - lu(k,433) * lu(k,575) + lu(k,587) = - lu(k,434) * lu(k,575) + lu(k,588) = - lu(k,435) * lu(k,575) + lu(k,589) = lu(k,589) - lu(k,436) * lu(k,575) + lu(k,592) = - lu(k,437) * lu(k,575) + lu(k,593) = lu(k,593) - lu(k,438) * lu(k,575) + lu(k,603) = lu(k,603) - lu(k,426) * lu(k,602) + lu(k,606) = lu(k,606) - lu(k,427) * lu(k,602) + lu(k,607) = - lu(k,428) * lu(k,602) + lu(k,608) = lu(k,608) - lu(k,429) * lu(k,602) + lu(k,610) = lu(k,610) - lu(k,430) * lu(k,602) + lu(k,611) = lu(k,611) - lu(k,431) * lu(k,602) + lu(k,612) = lu(k,612) - lu(k,432) * lu(k,602) + lu(k,614) = lu(k,614) - lu(k,433) * lu(k,602) + lu(k,615) = lu(k,615) - lu(k,434) * lu(k,602) + lu(k,616) = lu(k,616) - lu(k,435) * lu(k,602) + lu(k,617) = lu(k,617) - lu(k,436) * lu(k,602) + lu(k,620) = lu(k,620) - lu(k,437) * lu(k,602) + lu(k,621) = lu(k,621) - lu(k,438) * lu(k,602) + lu(k,633) = lu(k,633) - lu(k,426) * lu(k,632) + lu(k,635) = lu(k,635) - lu(k,427) * lu(k,632) + lu(k,636) = lu(k,636) - lu(k,428) * lu(k,632) + lu(k,637) = lu(k,637) - lu(k,429) * lu(k,632) + lu(k,639) = lu(k,639) - lu(k,430) * lu(k,632) + lu(k,640) = lu(k,640) - lu(k,431) * lu(k,632) + lu(k,641) = lu(k,641) - lu(k,432) * lu(k,632) + lu(k,643) = lu(k,643) - lu(k,433) * lu(k,632) + lu(k,644) = lu(k,644) - lu(k,434) * lu(k,632) + lu(k,645) = lu(k,645) - lu(k,435) * lu(k,632) + lu(k,646) = lu(k,646) - lu(k,436) * lu(k,632) + lu(k,649) = lu(k,649) - lu(k,437) * lu(k,632) + lu(k,650) = lu(k,650) - lu(k,438) * lu(k,632) + lu(k,674) = lu(k,674) - lu(k,426) * lu(k,673) + lu(k,677) = lu(k,677) - lu(k,427) * lu(k,673) + lu(k,678) = lu(k,678) - lu(k,428) * lu(k,673) + lu(k,679) = lu(k,679) - lu(k,429) * lu(k,673) + lu(k,681) = lu(k,681) - lu(k,430) * lu(k,673) + lu(k,682) = lu(k,682) - lu(k,431) * lu(k,673) + lu(k,683) = lu(k,683) - lu(k,432) * lu(k,673) + lu(k,685) = lu(k,685) - lu(k,433) * lu(k,673) + lu(k,686) = lu(k,686) - lu(k,434) * lu(k,673) + lu(k,687) = lu(k,687) - lu(k,435) * lu(k,673) + lu(k,688) = lu(k,688) - lu(k,436) * lu(k,673) + lu(k,691) = lu(k,691) - lu(k,437) * lu(k,673) + lu(k,692) = lu(k,692) - lu(k,438) * lu(k,673) + lu(k,844) = lu(k,844) - lu(k,426) * lu(k,843) + lu(k,847) = lu(k,847) - lu(k,427) * lu(k,843) + lu(k,848) = lu(k,848) - lu(k,428) * lu(k,843) + lu(k,849) = lu(k,849) - lu(k,429) * lu(k,843) + lu(k,851) = lu(k,851) - lu(k,430) * lu(k,843) + lu(k,852) = lu(k,852) - lu(k,431) * lu(k,843) + lu(k,853) = lu(k,853) - lu(k,432) * lu(k,843) + lu(k,855) = lu(k,855) - lu(k,433) * lu(k,843) + lu(k,856) = lu(k,856) - lu(k,434) * lu(k,843) + lu(k,857) = lu(k,857) - lu(k,435) * lu(k,843) + lu(k,858) = lu(k,858) - lu(k,436) * lu(k,843) + lu(k,861) = lu(k,861) - lu(k,437) * lu(k,843) + lu(k,862) = lu(k,862) - lu(k,438) * lu(k,843) + lu(k,915) = - lu(k,426) * lu(k,914) + lu(k,917) = lu(k,917) - lu(k,427) * lu(k,914) + lu(k,918) = - lu(k,428) * lu(k,914) + lu(k,919) = lu(k,919) - lu(k,429) * lu(k,914) + lu(k,921) = lu(k,921) - lu(k,430) * lu(k,914) + lu(k,922) = lu(k,922) - lu(k,431) * lu(k,914) + lu(k,923) = lu(k,923) - lu(k,432) * lu(k,914) + lu(k,925) = lu(k,925) - lu(k,433) * lu(k,914) + lu(k,926) = lu(k,926) - lu(k,434) * lu(k,914) + lu(k,927) = lu(k,927) - lu(k,435) * lu(k,914) + lu(k,928) = lu(k,928) - lu(k,436) * lu(k,914) + lu(k,931) = lu(k,931) - lu(k,437) * lu(k,914) + lu(k,932) = lu(k,932) - lu(k,438) * lu(k,914) + lu(k,941) = lu(k,941) - lu(k,426) * lu(k,940) + lu(k,944) = lu(k,944) - lu(k,427) * lu(k,940) + lu(k,945) = - lu(k,428) * lu(k,940) + lu(k,946) = lu(k,946) - lu(k,429) * lu(k,940) + lu(k,948) = lu(k,948) - lu(k,430) * lu(k,940) + lu(k,949) = lu(k,949) - lu(k,431) * lu(k,940) + lu(k,950) = lu(k,950) - lu(k,432) * lu(k,940) + lu(k,952) = lu(k,952) - lu(k,433) * lu(k,940) + lu(k,953) = lu(k,953) - lu(k,434) * lu(k,940) + lu(k,954) = - lu(k,435) * lu(k,940) + lu(k,955) = lu(k,955) - lu(k,436) * lu(k,940) + lu(k,958) = - lu(k,437) * lu(k,940) + lu(k,959) = lu(k,959) - lu(k,438) * lu(k,940) + lu(k,439) = 1._r8 / lu(k,439) + lu(k,440) = lu(k,440) * lu(k,439) + lu(k,441) = lu(k,441) * lu(k,439) + lu(k,442) = lu(k,442) * lu(k,439) + lu(k,443) = lu(k,443) * lu(k,439) + lu(k,444) = lu(k,444) * lu(k,439) + lu(k,445) = lu(k,445) * lu(k,439) + lu(k,446) = lu(k,446) * lu(k,439) + lu(k,454) = - lu(k,440) * lu(k,452) + lu(k,455) = - lu(k,441) * lu(k,452) + lu(k,456) = - lu(k,442) * lu(k,452) + lu(k,460) = lu(k,460) - lu(k,443) * lu(k,452) + lu(k,464) = lu(k,464) - lu(k,444) * lu(k,452) + lu(k,465) = - lu(k,445) * lu(k,452) + lu(k,468) = lu(k,468) - lu(k,446) * lu(k,452) + lu(k,476) = lu(k,476) - lu(k,440) * lu(k,473) + lu(k,477) = - lu(k,441) * lu(k,473) + lu(k,478) = lu(k,478) - lu(k,442) * lu(k,473) + lu(k,482) = lu(k,482) - lu(k,443) * lu(k,473) + lu(k,487) = lu(k,487) - lu(k,444) * lu(k,473) + lu(k,488) = lu(k,488) - lu(k,445) * lu(k,473) + lu(k,491) = lu(k,491) - lu(k,446) * lu(k,473) + lu(k,508) = lu(k,508) - lu(k,440) * lu(k,507) + lu(k,509) = lu(k,509) - lu(k,441) * lu(k,507) + lu(k,510) = lu(k,510) - lu(k,442) * lu(k,507) + lu(k,513) = lu(k,513) - lu(k,443) * lu(k,507) + lu(k,518) = lu(k,518) - lu(k,444) * lu(k,507) + lu(k,519) = - lu(k,445) * lu(k,507) + lu(k,521) = lu(k,521) - lu(k,446) * lu(k,507) + lu(k,528) = lu(k,528) - lu(k,440) * lu(k,527) + lu(k,529) = lu(k,529) - lu(k,441) * lu(k,527) + lu(k,530) = lu(k,530) - lu(k,442) * lu(k,527) + lu(k,534) = lu(k,534) - lu(k,443) * lu(k,527) + lu(k,539) = lu(k,539) - lu(k,444) * lu(k,527) + lu(k,540) = - lu(k,445) * lu(k,527) + lu(k,542) = lu(k,542) - lu(k,446) * lu(k,527) + lu(k,553) = lu(k,553) - lu(k,440) * lu(k,550) + lu(k,554) = lu(k,554) - lu(k,441) * lu(k,550) + lu(k,555) = lu(k,555) - lu(k,442) * lu(k,550) + lu(k,559) = lu(k,559) - lu(k,443) * lu(k,550) + lu(k,564) = lu(k,564) - lu(k,444) * lu(k,550) + lu(k,565) = lu(k,565) - lu(k,445) * lu(k,550) + lu(k,568) = lu(k,568) - lu(k,446) * lu(k,550) + lu(k,578) = lu(k,578) - lu(k,440) * lu(k,576) + lu(k,579) = lu(k,579) - lu(k,441) * lu(k,576) + lu(k,580) = lu(k,580) - lu(k,442) * lu(k,576) + lu(k,584) = lu(k,584) - lu(k,443) * lu(k,576) + lu(k,589) = lu(k,589) - lu(k,444) * lu(k,576) + lu(k,590) = - lu(k,445) * lu(k,576) + lu(k,593) = lu(k,593) - lu(k,446) * lu(k,576) + lu(k,606) = lu(k,606) - lu(k,440) * lu(k,603) + lu(k,607) = lu(k,607) - lu(k,441) * lu(k,603) + lu(k,608) = lu(k,608) - lu(k,442) * lu(k,603) + lu(k,612) = lu(k,612) - lu(k,443) * lu(k,603) + lu(k,617) = lu(k,617) - lu(k,444) * lu(k,603) + lu(k,618) = - lu(k,445) * lu(k,603) + lu(k,621) = lu(k,621) - lu(k,446) * lu(k,603) + lu(k,635) = lu(k,635) - lu(k,440) * lu(k,633) + lu(k,636) = lu(k,636) - lu(k,441) * lu(k,633) + lu(k,637) = lu(k,637) - lu(k,442) * lu(k,633) + lu(k,641) = lu(k,641) - lu(k,443) * lu(k,633) + lu(k,646) = lu(k,646) - lu(k,444) * lu(k,633) + lu(k,647) = - lu(k,445) * lu(k,633) + lu(k,650) = lu(k,650) - lu(k,446) * lu(k,633) + lu(k,677) = lu(k,677) - lu(k,440) * lu(k,674) + lu(k,678) = lu(k,678) - lu(k,441) * lu(k,674) + lu(k,679) = lu(k,679) - lu(k,442) * lu(k,674) + lu(k,683) = lu(k,683) - lu(k,443) * lu(k,674) + lu(k,688) = lu(k,688) - lu(k,444) * lu(k,674) + lu(k,689) = lu(k,689) - lu(k,445) * lu(k,674) + lu(k,692) = lu(k,692) - lu(k,446) * lu(k,674) + lu(k,719) = lu(k,719) - lu(k,440) * lu(k,716) + lu(k,720) = lu(k,720) - lu(k,441) * lu(k,716) + lu(k,721) = lu(k,721) - lu(k,442) * lu(k,716) + lu(k,725) = lu(k,725) - lu(k,443) * lu(k,716) + lu(k,730) = lu(k,730) - lu(k,444) * lu(k,716) + lu(k,731) = lu(k,731) - lu(k,445) * lu(k,716) + lu(k,734) = lu(k,734) - lu(k,446) * lu(k,716) + lu(k,744) = lu(k,744) - lu(k,440) * lu(k,742) + lu(k,745) = lu(k,745) - lu(k,441) * lu(k,742) + lu(k,746) = lu(k,746) - lu(k,442) * lu(k,742) + lu(k,750) = lu(k,750) - lu(k,443) * lu(k,742) + lu(k,755) = lu(k,755) - lu(k,444) * lu(k,742) + lu(k,756) = - lu(k,445) * lu(k,742) + lu(k,759) = lu(k,759) - lu(k,446) * lu(k,742) + lu(k,776) = lu(k,776) - lu(k,440) * lu(k,773) + lu(k,777) = lu(k,777) - lu(k,441) * lu(k,773) + lu(k,778) = lu(k,778) - lu(k,442) * lu(k,773) + lu(k,782) = lu(k,782) - lu(k,443) * lu(k,773) + lu(k,787) = lu(k,787) - lu(k,444) * lu(k,773) + lu(k,788) = lu(k,788) - lu(k,445) * lu(k,773) + lu(k,791) = lu(k,791) - lu(k,446) * lu(k,773) + lu(k,798) = lu(k,798) - lu(k,440) * lu(k,796) + lu(k,799) = lu(k,799) - lu(k,441) * lu(k,796) + lu(k,800) = lu(k,800) - lu(k,442) * lu(k,796) + lu(k,804) = lu(k,804) - lu(k,443) * lu(k,796) + lu(k,809) = lu(k,809) - lu(k,444) * lu(k,796) + lu(k,810) = - lu(k,445) * lu(k,796) + lu(k,813) = lu(k,813) - lu(k,446) * lu(k,796) + lu(k,847) = lu(k,847) - lu(k,440) * lu(k,844) + lu(k,848) = lu(k,848) - lu(k,441) * lu(k,844) + lu(k,849) = lu(k,849) - lu(k,442) * lu(k,844) + lu(k,853) = lu(k,853) - lu(k,443) * lu(k,844) + lu(k,858) = lu(k,858) - lu(k,444) * lu(k,844) + lu(k,859) = lu(k,859) - lu(k,445) * lu(k,844) + lu(k,862) = lu(k,862) - lu(k,446) * lu(k,844) + lu(k,870) = lu(k,870) - lu(k,440) * lu(k,867) + lu(k,871) = - lu(k,441) * lu(k,867) + lu(k,872) = lu(k,872) - lu(k,442) * lu(k,867) + lu(k,876) = lu(k,876) - lu(k,443) * lu(k,867) + lu(k,881) = lu(k,881) - lu(k,444) * lu(k,867) + lu(k,882) = lu(k,882) - lu(k,445) * lu(k,867) + lu(k,885) = lu(k,885) - lu(k,446) * lu(k,867) + lu(k,893) = lu(k,893) - lu(k,440) * lu(k,890) + lu(k,894) = - lu(k,441) * lu(k,890) + lu(k,895) = lu(k,895) - lu(k,442) * lu(k,890) + lu(k,899) = lu(k,899) - lu(k,443) * lu(k,890) + lu(k,904) = lu(k,904) - lu(k,444) * lu(k,890) + lu(k,905) = lu(k,905) - lu(k,445) * lu(k,890) + lu(k,908) = lu(k,908) - lu(k,446) * lu(k,890) + lu(k,917) = lu(k,917) - lu(k,440) * lu(k,915) + lu(k,918) = lu(k,918) - lu(k,441) * lu(k,915) + lu(k,919) = lu(k,919) - lu(k,442) * lu(k,915) + lu(k,923) = lu(k,923) - lu(k,443) * lu(k,915) + lu(k,928) = lu(k,928) - lu(k,444) * lu(k,915) + lu(k,929) = - lu(k,445) * lu(k,915) + lu(k,932) = lu(k,932) - lu(k,446) * lu(k,915) + lu(k,944) = lu(k,944) - lu(k,440) * lu(k,941) + lu(k,945) = lu(k,945) - lu(k,441) * lu(k,941) + lu(k,946) = lu(k,946) - lu(k,442) * lu(k,941) + lu(k,950) = lu(k,950) - lu(k,443) * lu(k,941) + lu(k,955) = lu(k,955) - lu(k,444) * lu(k,941) + lu(k,956) = lu(k,956) - lu(k,445) * lu(k,941) + lu(k,959) = lu(k,959) - lu(k,446) * lu(k,941) + 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,453) = 1._r8 / lu(k,453) + lu(k,454) = lu(k,454) * lu(k,453) + lu(k,455) = lu(k,455) * lu(k,453) + lu(k,456) = lu(k,456) * lu(k,453) + lu(k,457) = lu(k,457) * lu(k,453) + lu(k,458) = lu(k,458) * lu(k,453) + lu(k,459) = lu(k,459) * lu(k,453) + lu(k,460) = lu(k,460) * lu(k,453) + lu(k,461) = lu(k,461) * lu(k,453) + lu(k,462) = lu(k,462) * lu(k,453) + lu(k,463) = lu(k,463) * lu(k,453) + lu(k,464) = lu(k,464) * lu(k,453) + lu(k,465) = lu(k,465) * lu(k,453) + lu(k,466) = lu(k,466) * lu(k,453) + lu(k,467) = lu(k,467) * lu(k,453) + lu(k,468) = lu(k,468) * lu(k,453) + lu(k,476) = lu(k,476) - lu(k,454) * lu(k,474) + lu(k,477) = lu(k,477) - lu(k,455) * lu(k,474) + lu(k,478) = lu(k,478) - lu(k,456) * lu(k,474) + lu(k,479) = lu(k,479) - lu(k,457) * lu(k,474) + lu(k,480) = - lu(k,458) * lu(k,474) + lu(k,481) = lu(k,481) - lu(k,459) * lu(k,474) + lu(k,482) = lu(k,482) - lu(k,460) * lu(k,474) + lu(k,483) = lu(k,483) - lu(k,461) * lu(k,474) + lu(k,485) = lu(k,485) - lu(k,462) * lu(k,474) + lu(k,486) = lu(k,486) - lu(k,463) * lu(k,474) + lu(k,487) = lu(k,487) - lu(k,464) * lu(k,474) + lu(k,488) = lu(k,488) - lu(k,465) * lu(k,474) + lu(k,489) = lu(k,489) - lu(k,466) * lu(k,474) + lu(k,490) = lu(k,490) - lu(k,467) * lu(k,474) + lu(k,491) = lu(k,491) - lu(k,468) * lu(k,474) + lu(k,553) = lu(k,553) - lu(k,454) * lu(k,551) + lu(k,554) = lu(k,554) - lu(k,455) * lu(k,551) + lu(k,555) = lu(k,555) - lu(k,456) * lu(k,551) + lu(k,556) = lu(k,556) - lu(k,457) * lu(k,551) + lu(k,557) = lu(k,557) - lu(k,458) * lu(k,551) + lu(k,558) = lu(k,558) - lu(k,459) * lu(k,551) + lu(k,559) = lu(k,559) - lu(k,460) * lu(k,551) + lu(k,560) = lu(k,560) - lu(k,461) * lu(k,551) + lu(k,562) = lu(k,562) - lu(k,462) * lu(k,551) + lu(k,563) = lu(k,563) - lu(k,463) * lu(k,551) + lu(k,564) = lu(k,564) - lu(k,464) * lu(k,551) + lu(k,565) = lu(k,565) - lu(k,465) * lu(k,551) + lu(k,566) = - lu(k,466) * lu(k,551) + lu(k,567) = lu(k,567) - lu(k,467) * lu(k,551) + lu(k,568) = lu(k,568) - lu(k,468) * lu(k,551) + lu(k,606) = lu(k,606) - lu(k,454) * lu(k,604) + lu(k,607) = lu(k,607) - lu(k,455) * lu(k,604) + lu(k,608) = lu(k,608) - lu(k,456) * lu(k,604) + lu(k,609) = lu(k,609) - lu(k,457) * lu(k,604) + lu(k,610) = lu(k,610) - lu(k,458) * lu(k,604) + lu(k,611) = lu(k,611) - lu(k,459) * lu(k,604) + lu(k,612) = lu(k,612) - lu(k,460) * lu(k,604) + lu(k,613) = - lu(k,461) * lu(k,604) + lu(k,615) = lu(k,615) - lu(k,462) * lu(k,604) + lu(k,616) = lu(k,616) - lu(k,463) * lu(k,604) + lu(k,617) = lu(k,617) - lu(k,464) * lu(k,604) + lu(k,618) = lu(k,618) - lu(k,465) * lu(k,604) + lu(k,619) = lu(k,619) - lu(k,466) * lu(k,604) + lu(k,620) = lu(k,620) - lu(k,467) * lu(k,604) + lu(k,621) = lu(k,621) - lu(k,468) * lu(k,604) + lu(k,635) = lu(k,635) - lu(k,454) * lu(k,634) + lu(k,636) = lu(k,636) - lu(k,455) * lu(k,634) + lu(k,637) = lu(k,637) - lu(k,456) * lu(k,634) + lu(k,638) = lu(k,638) - lu(k,457) * lu(k,634) + lu(k,639) = lu(k,639) - lu(k,458) * lu(k,634) + lu(k,640) = lu(k,640) - lu(k,459) * lu(k,634) + lu(k,641) = lu(k,641) - lu(k,460) * lu(k,634) + lu(k,642) = lu(k,642) - lu(k,461) * lu(k,634) + lu(k,644) = lu(k,644) - lu(k,462) * lu(k,634) + lu(k,645) = lu(k,645) - lu(k,463) * lu(k,634) + lu(k,646) = lu(k,646) - lu(k,464) * lu(k,634) + lu(k,647) = lu(k,647) - lu(k,465) * lu(k,634) + lu(k,648) = lu(k,648) - lu(k,466) * lu(k,634) + lu(k,649) = lu(k,649) - lu(k,467) * lu(k,634) + lu(k,650) = lu(k,650) - lu(k,468) * lu(k,634) + lu(k,677) = lu(k,677) - lu(k,454) * lu(k,675) + lu(k,678) = lu(k,678) - lu(k,455) * lu(k,675) + lu(k,679) = lu(k,679) - lu(k,456) * lu(k,675) + lu(k,680) = lu(k,680) - lu(k,457) * lu(k,675) + lu(k,681) = lu(k,681) - lu(k,458) * lu(k,675) + lu(k,682) = lu(k,682) - lu(k,459) * lu(k,675) + lu(k,683) = lu(k,683) - lu(k,460) * lu(k,675) + lu(k,684) = lu(k,684) - lu(k,461) * lu(k,675) + lu(k,686) = lu(k,686) - lu(k,462) * lu(k,675) + lu(k,687) = lu(k,687) - lu(k,463) * lu(k,675) + lu(k,688) = lu(k,688) - lu(k,464) * lu(k,675) + lu(k,689) = lu(k,689) - lu(k,465) * lu(k,675) + lu(k,690) = lu(k,690) - lu(k,466) * lu(k,675) + lu(k,691) = lu(k,691) - lu(k,467) * lu(k,675) + lu(k,692) = lu(k,692) - lu(k,468) * lu(k,675) + lu(k,719) = lu(k,719) - lu(k,454) * lu(k,717) + lu(k,720) = lu(k,720) - lu(k,455) * lu(k,717) + lu(k,721) = lu(k,721) - lu(k,456) * lu(k,717) + lu(k,722) = lu(k,722) - lu(k,457) * lu(k,717) + lu(k,723) = lu(k,723) - lu(k,458) * lu(k,717) + lu(k,724) = lu(k,724) - lu(k,459) * lu(k,717) + lu(k,725) = lu(k,725) - lu(k,460) * lu(k,717) + lu(k,726) = lu(k,726) - lu(k,461) * lu(k,717) + lu(k,728) = lu(k,728) - lu(k,462) * lu(k,717) + lu(k,729) = lu(k,729) - lu(k,463) * lu(k,717) + lu(k,730) = lu(k,730) - lu(k,464) * lu(k,717) + lu(k,731) = lu(k,731) - lu(k,465) * lu(k,717) + lu(k,732) = lu(k,732) - lu(k,466) * lu(k,717) + lu(k,733) = lu(k,733) - lu(k,467) * lu(k,717) + lu(k,734) = lu(k,734) - lu(k,468) * lu(k,717) + lu(k,776) = lu(k,776) - lu(k,454) * lu(k,774) + lu(k,777) = lu(k,777) - lu(k,455) * lu(k,774) + lu(k,778) = lu(k,778) - lu(k,456) * lu(k,774) + lu(k,779) = lu(k,779) - lu(k,457) * lu(k,774) + lu(k,780) = lu(k,780) - lu(k,458) * lu(k,774) + lu(k,781) = lu(k,781) - lu(k,459) * lu(k,774) + lu(k,782) = lu(k,782) - lu(k,460) * lu(k,774) + lu(k,783) = lu(k,783) - lu(k,461) * lu(k,774) + lu(k,785) = lu(k,785) - lu(k,462) * lu(k,774) + lu(k,786) = lu(k,786) - lu(k,463) * lu(k,774) + lu(k,787) = lu(k,787) - lu(k,464) * lu(k,774) + lu(k,788) = lu(k,788) - lu(k,465) * lu(k,774) + lu(k,789) = lu(k,789) - lu(k,466) * lu(k,774) + lu(k,790) = - lu(k,467) * lu(k,774) + lu(k,791) = lu(k,791) - lu(k,468) * lu(k,774) + lu(k,847) = lu(k,847) - lu(k,454) * lu(k,845) + lu(k,848) = lu(k,848) - lu(k,455) * lu(k,845) + lu(k,849) = lu(k,849) - lu(k,456) * lu(k,845) + lu(k,850) = lu(k,850) - lu(k,457) * lu(k,845) + lu(k,851) = lu(k,851) - lu(k,458) * lu(k,845) + lu(k,852) = lu(k,852) - lu(k,459) * lu(k,845) + lu(k,853) = lu(k,853) - lu(k,460) * lu(k,845) + lu(k,854) = lu(k,854) - lu(k,461) * lu(k,845) + lu(k,856) = lu(k,856) - lu(k,462) * lu(k,845) + lu(k,857) = lu(k,857) - lu(k,463) * lu(k,845) + lu(k,858) = lu(k,858) - lu(k,464) * lu(k,845) + lu(k,859) = lu(k,859) - lu(k,465) * lu(k,845) + lu(k,860) = lu(k,860) - lu(k,466) * lu(k,845) + lu(k,861) = lu(k,861) - lu(k,467) * lu(k,845) + lu(k,862) = lu(k,862) - lu(k,468) * lu(k,845) + lu(k,870) = lu(k,870) - lu(k,454) * lu(k,868) + lu(k,871) = lu(k,871) - lu(k,455) * lu(k,868) + lu(k,872) = lu(k,872) - lu(k,456) * lu(k,868) + lu(k,873) = lu(k,873) - lu(k,457) * lu(k,868) + lu(k,874) = lu(k,874) - lu(k,458) * lu(k,868) + lu(k,875) = lu(k,875) - lu(k,459) * lu(k,868) + lu(k,876) = lu(k,876) - lu(k,460) * lu(k,868) + lu(k,877) = lu(k,877) - lu(k,461) * lu(k,868) + lu(k,879) = lu(k,879) - lu(k,462) * lu(k,868) + lu(k,880) = - lu(k,463) * lu(k,868) + lu(k,881) = lu(k,881) - lu(k,464) * lu(k,868) + lu(k,882) = lu(k,882) - lu(k,465) * lu(k,868) + lu(k,883) = lu(k,883) - lu(k,466) * lu(k,868) + lu(k,884) = - lu(k,467) * lu(k,868) + lu(k,885) = lu(k,885) - lu(k,468) * lu(k,868) + lu(k,893) = lu(k,893) - lu(k,454) * lu(k,891) + lu(k,894) = lu(k,894) - lu(k,455) * lu(k,891) + lu(k,895) = lu(k,895) - lu(k,456) * lu(k,891) + lu(k,896) = lu(k,896) - lu(k,457) * lu(k,891) + lu(k,897) = lu(k,897) - lu(k,458) * lu(k,891) + lu(k,898) = lu(k,898) - lu(k,459) * lu(k,891) + lu(k,899) = lu(k,899) - lu(k,460) * lu(k,891) + lu(k,900) = lu(k,900) - lu(k,461) * lu(k,891) + lu(k,902) = lu(k,902) - lu(k,462) * lu(k,891) + lu(k,903) = - lu(k,463) * lu(k,891) + lu(k,904) = lu(k,904) - lu(k,464) * lu(k,891) + lu(k,905) = lu(k,905) - lu(k,465) * lu(k,891) + lu(k,906) = lu(k,906) - lu(k,466) * lu(k,891) + lu(k,907) = - lu(k,467) * lu(k,891) + lu(k,908) = lu(k,908) - lu(k,468) * lu(k,891) + lu(k,917) = lu(k,917) - lu(k,454) * lu(k,916) + lu(k,918) = lu(k,918) - lu(k,455) * lu(k,916) + lu(k,919) = lu(k,919) - lu(k,456) * lu(k,916) + lu(k,920) = lu(k,920) - lu(k,457) * lu(k,916) + lu(k,921) = lu(k,921) - lu(k,458) * lu(k,916) + lu(k,922) = lu(k,922) - lu(k,459) * lu(k,916) + lu(k,923) = lu(k,923) - lu(k,460) * lu(k,916) + lu(k,924) = - lu(k,461) * lu(k,916) + lu(k,926) = lu(k,926) - lu(k,462) * lu(k,916) + lu(k,927) = lu(k,927) - lu(k,463) * lu(k,916) + lu(k,928) = lu(k,928) - lu(k,464) * lu(k,916) + lu(k,929) = lu(k,929) - lu(k,465) * lu(k,916) + lu(k,930) = lu(k,930) - lu(k,466) * lu(k,916) + lu(k,931) = lu(k,931) - lu(k,467) * lu(k,916) + lu(k,932) = lu(k,932) - lu(k,468) * lu(k,916) + lu(k,944) = lu(k,944) - lu(k,454) * lu(k,942) + lu(k,945) = lu(k,945) - lu(k,455) * lu(k,942) + lu(k,946) = lu(k,946) - lu(k,456) * lu(k,942) + lu(k,947) = lu(k,947) - lu(k,457) * lu(k,942) + lu(k,948) = lu(k,948) - lu(k,458) * lu(k,942) + lu(k,949) = lu(k,949) - lu(k,459) * lu(k,942) + lu(k,950) = lu(k,950) - lu(k,460) * lu(k,942) + lu(k,951) = lu(k,951) - lu(k,461) * lu(k,942) + lu(k,953) = lu(k,953) - lu(k,462) * lu(k,942) + lu(k,954) = lu(k,954) - lu(k,463) * lu(k,942) + lu(k,955) = lu(k,955) - lu(k,464) * lu(k,942) + lu(k,956) = lu(k,956) - lu(k,465) * lu(k,942) + lu(k,957) = lu(k,957) - lu(k,466) * lu(k,942) + lu(k,958) = lu(k,958) - lu(k,467) * lu(k,942) + lu(k,959) = lu(k,959) - lu(k,468) * lu(k,942) + lu(k,475) = 1._r8 / lu(k,475) + lu(k,476) = lu(k,476) * lu(k,475) + lu(k,477) = lu(k,477) * lu(k,475) + lu(k,478) = lu(k,478) * lu(k,475) + lu(k,479) = lu(k,479) * lu(k,475) + lu(k,480) = lu(k,480) * lu(k,475) + lu(k,481) = lu(k,481) * lu(k,475) + lu(k,482) = lu(k,482) * lu(k,475) + lu(k,483) = lu(k,483) * lu(k,475) + lu(k,484) = lu(k,484) * lu(k,475) + lu(k,485) = lu(k,485) * lu(k,475) + lu(k,486) = lu(k,486) * lu(k,475) + lu(k,487) = lu(k,487) * lu(k,475) + lu(k,488) = lu(k,488) * lu(k,475) + lu(k,489) = lu(k,489) * lu(k,475) + lu(k,490) = lu(k,490) * lu(k,475) + lu(k,491) = lu(k,491) * lu(k,475) + lu(k,553) = lu(k,553) - lu(k,476) * lu(k,552) + lu(k,554) = lu(k,554) - lu(k,477) * lu(k,552) + lu(k,555) = lu(k,555) - lu(k,478) * lu(k,552) + lu(k,556) = lu(k,556) - lu(k,479) * lu(k,552) + lu(k,557) = lu(k,557) - lu(k,480) * lu(k,552) + lu(k,558) = lu(k,558) - lu(k,481) * lu(k,552) + lu(k,559) = lu(k,559) - lu(k,482) * lu(k,552) + lu(k,560) = lu(k,560) - lu(k,483) * lu(k,552) + lu(k,561) = lu(k,561) - lu(k,484) * lu(k,552) + lu(k,562) = lu(k,562) - lu(k,485) * lu(k,552) + lu(k,563) = lu(k,563) - lu(k,486) * lu(k,552) + lu(k,564) = lu(k,564) - lu(k,487) * lu(k,552) + lu(k,565) = lu(k,565) - lu(k,488) * lu(k,552) + lu(k,566) = lu(k,566) - lu(k,489) * lu(k,552) + lu(k,567) = lu(k,567) - lu(k,490) * lu(k,552) + lu(k,568) = lu(k,568) - lu(k,491) * lu(k,552) + lu(k,578) = lu(k,578) - lu(k,476) * lu(k,577) + lu(k,579) = lu(k,579) - lu(k,477) * lu(k,577) + lu(k,580) = lu(k,580) - lu(k,478) * lu(k,577) + lu(k,581) = lu(k,581) - lu(k,479) * lu(k,577) + lu(k,582) = lu(k,582) - lu(k,480) * lu(k,577) + lu(k,583) = lu(k,583) - lu(k,481) * lu(k,577) + lu(k,584) = lu(k,584) - lu(k,482) * lu(k,577) + lu(k,585) = lu(k,585) - lu(k,483) * lu(k,577) + lu(k,586) = lu(k,586) - lu(k,484) * lu(k,577) + lu(k,587) = lu(k,587) - lu(k,485) * lu(k,577) + lu(k,588) = lu(k,588) - lu(k,486) * lu(k,577) + lu(k,589) = lu(k,589) - lu(k,487) * lu(k,577) + lu(k,590) = lu(k,590) - lu(k,488) * lu(k,577) + lu(k,591) = lu(k,591) - lu(k,489) * lu(k,577) + lu(k,592) = lu(k,592) - lu(k,490) * lu(k,577) + lu(k,593) = lu(k,593) - lu(k,491) * lu(k,577) + lu(k,606) = lu(k,606) - lu(k,476) * lu(k,605) + lu(k,607) = lu(k,607) - lu(k,477) * lu(k,605) + lu(k,608) = lu(k,608) - lu(k,478) * lu(k,605) + lu(k,609) = lu(k,609) - lu(k,479) * lu(k,605) + lu(k,610) = lu(k,610) - lu(k,480) * lu(k,605) + lu(k,611) = lu(k,611) - lu(k,481) * lu(k,605) + lu(k,612) = lu(k,612) - lu(k,482) * lu(k,605) + lu(k,613) = lu(k,613) - lu(k,483) * lu(k,605) + lu(k,614) = lu(k,614) - lu(k,484) * lu(k,605) + lu(k,615) = lu(k,615) - lu(k,485) * lu(k,605) + lu(k,616) = lu(k,616) - lu(k,486) * lu(k,605) + lu(k,617) = lu(k,617) - lu(k,487) * lu(k,605) + lu(k,618) = lu(k,618) - lu(k,488) * lu(k,605) + lu(k,619) = lu(k,619) - lu(k,489) * lu(k,605) + lu(k,620) = lu(k,620) - lu(k,490) * lu(k,605) + lu(k,621) = lu(k,621) - lu(k,491) * lu(k,605) + lu(k,677) = lu(k,677) - lu(k,476) * lu(k,676) + lu(k,678) = lu(k,678) - lu(k,477) * lu(k,676) + lu(k,679) = lu(k,679) - lu(k,478) * lu(k,676) + lu(k,680) = lu(k,680) - lu(k,479) * lu(k,676) + lu(k,681) = lu(k,681) - lu(k,480) * lu(k,676) + lu(k,682) = lu(k,682) - lu(k,481) * lu(k,676) + lu(k,683) = lu(k,683) - lu(k,482) * lu(k,676) + lu(k,684) = lu(k,684) - lu(k,483) * lu(k,676) + lu(k,685) = lu(k,685) - lu(k,484) * lu(k,676) + lu(k,686) = lu(k,686) - lu(k,485) * lu(k,676) + lu(k,687) = lu(k,687) - lu(k,486) * lu(k,676) + lu(k,688) = lu(k,688) - lu(k,487) * lu(k,676) + lu(k,689) = lu(k,689) - lu(k,488) * lu(k,676) + lu(k,690) = lu(k,690) - lu(k,489) * lu(k,676) + lu(k,691) = lu(k,691) - lu(k,490) * lu(k,676) + lu(k,692) = lu(k,692) - lu(k,491) * lu(k,676) + lu(k,719) = lu(k,719) - lu(k,476) * lu(k,718) + lu(k,720) = lu(k,720) - lu(k,477) * lu(k,718) + lu(k,721) = lu(k,721) - lu(k,478) * lu(k,718) + lu(k,722) = lu(k,722) - lu(k,479) * lu(k,718) + lu(k,723) = lu(k,723) - lu(k,480) * lu(k,718) + lu(k,724) = lu(k,724) - lu(k,481) * lu(k,718) + lu(k,725) = lu(k,725) - lu(k,482) * lu(k,718) + lu(k,726) = lu(k,726) - lu(k,483) * lu(k,718) + lu(k,727) = lu(k,727) - lu(k,484) * lu(k,718) + lu(k,728) = lu(k,728) - lu(k,485) * lu(k,718) + lu(k,729) = lu(k,729) - lu(k,486) * lu(k,718) + lu(k,730) = lu(k,730) - lu(k,487) * lu(k,718) + lu(k,731) = lu(k,731) - lu(k,488) * lu(k,718) + lu(k,732) = lu(k,732) - lu(k,489) * lu(k,718) + lu(k,733) = lu(k,733) - lu(k,490) * lu(k,718) + lu(k,734) = lu(k,734) - lu(k,491) * lu(k,718) + lu(k,744) = lu(k,744) - lu(k,476) * lu(k,743) + lu(k,745) = lu(k,745) - lu(k,477) * lu(k,743) + lu(k,746) = lu(k,746) - lu(k,478) * lu(k,743) + lu(k,747) = lu(k,747) - lu(k,479) * lu(k,743) + lu(k,748) = lu(k,748) - lu(k,480) * lu(k,743) + lu(k,749) = lu(k,749) - lu(k,481) * lu(k,743) + lu(k,750) = lu(k,750) - lu(k,482) * lu(k,743) + lu(k,751) = lu(k,751) - lu(k,483) * lu(k,743) + lu(k,752) = lu(k,752) - lu(k,484) * lu(k,743) + lu(k,753) = lu(k,753) - lu(k,485) * lu(k,743) + lu(k,754) = lu(k,754) - lu(k,486) * lu(k,743) + lu(k,755) = lu(k,755) - lu(k,487) * lu(k,743) + lu(k,756) = lu(k,756) - lu(k,488) * lu(k,743) + lu(k,757) = - lu(k,489) * lu(k,743) + lu(k,758) = lu(k,758) - lu(k,490) * lu(k,743) + lu(k,759) = lu(k,759) - lu(k,491) * lu(k,743) + lu(k,776) = lu(k,776) - lu(k,476) * lu(k,775) + lu(k,777) = lu(k,777) - lu(k,477) * lu(k,775) + lu(k,778) = lu(k,778) - lu(k,478) * lu(k,775) + lu(k,779) = lu(k,779) - lu(k,479) * lu(k,775) + lu(k,780) = lu(k,780) - lu(k,480) * lu(k,775) + lu(k,781) = lu(k,781) - lu(k,481) * lu(k,775) + lu(k,782) = lu(k,782) - lu(k,482) * lu(k,775) + lu(k,783) = lu(k,783) - lu(k,483) * lu(k,775) + lu(k,784) = lu(k,784) - lu(k,484) * lu(k,775) + lu(k,785) = lu(k,785) - lu(k,485) * lu(k,775) + lu(k,786) = lu(k,786) - lu(k,486) * lu(k,775) + lu(k,787) = lu(k,787) - lu(k,487) * lu(k,775) + lu(k,788) = lu(k,788) - lu(k,488) * lu(k,775) + lu(k,789) = lu(k,789) - lu(k,489) * lu(k,775) + lu(k,790) = lu(k,790) - lu(k,490) * lu(k,775) + lu(k,791) = lu(k,791) - lu(k,491) * lu(k,775) + lu(k,798) = lu(k,798) - lu(k,476) * lu(k,797) + lu(k,799) = lu(k,799) - lu(k,477) * lu(k,797) + lu(k,800) = lu(k,800) - lu(k,478) * lu(k,797) + lu(k,801) = - lu(k,479) * lu(k,797) + lu(k,802) = - lu(k,480) * lu(k,797) + lu(k,803) = lu(k,803) - lu(k,481) * lu(k,797) + lu(k,804) = lu(k,804) - lu(k,482) * lu(k,797) + lu(k,805) = lu(k,805) - lu(k,483) * lu(k,797) + lu(k,806) = lu(k,806) - lu(k,484) * lu(k,797) + lu(k,807) = - lu(k,485) * lu(k,797) + lu(k,808) = lu(k,808) - lu(k,486) * lu(k,797) + lu(k,809) = lu(k,809) - lu(k,487) * lu(k,797) + lu(k,810) = lu(k,810) - lu(k,488) * lu(k,797) + lu(k,811) = - lu(k,489) * lu(k,797) + lu(k,812) = lu(k,812) - lu(k,490) * lu(k,797) + lu(k,813) = lu(k,813) - lu(k,491) * lu(k,797) + lu(k,847) = lu(k,847) - lu(k,476) * lu(k,846) + lu(k,848) = lu(k,848) - lu(k,477) * lu(k,846) + lu(k,849) = lu(k,849) - lu(k,478) * lu(k,846) + lu(k,850) = lu(k,850) - lu(k,479) * lu(k,846) + lu(k,851) = lu(k,851) - lu(k,480) * lu(k,846) + lu(k,852) = lu(k,852) - lu(k,481) * lu(k,846) + lu(k,853) = lu(k,853) - lu(k,482) * lu(k,846) + lu(k,854) = lu(k,854) - lu(k,483) * lu(k,846) + lu(k,855) = lu(k,855) - lu(k,484) * lu(k,846) + lu(k,856) = lu(k,856) - lu(k,485) * lu(k,846) + lu(k,857) = lu(k,857) - lu(k,486) * lu(k,846) + lu(k,858) = lu(k,858) - lu(k,487) * lu(k,846) + lu(k,859) = lu(k,859) - lu(k,488) * lu(k,846) + lu(k,860) = lu(k,860) - lu(k,489) * lu(k,846) + lu(k,861) = lu(k,861) - lu(k,490) * lu(k,846) + lu(k,862) = lu(k,862) - lu(k,491) * lu(k,846) + lu(k,870) = lu(k,870) - lu(k,476) * lu(k,869) + lu(k,871) = lu(k,871) - lu(k,477) * lu(k,869) + lu(k,872) = lu(k,872) - lu(k,478) * lu(k,869) + lu(k,873) = lu(k,873) - lu(k,479) * lu(k,869) + lu(k,874) = lu(k,874) - lu(k,480) * lu(k,869) + lu(k,875) = lu(k,875) - lu(k,481) * lu(k,869) + lu(k,876) = lu(k,876) - lu(k,482) * lu(k,869) + lu(k,877) = lu(k,877) - lu(k,483) * lu(k,869) + lu(k,878) = lu(k,878) - lu(k,484) * lu(k,869) + lu(k,879) = lu(k,879) - lu(k,485) * lu(k,869) + lu(k,880) = lu(k,880) - lu(k,486) * lu(k,869) + lu(k,881) = lu(k,881) - lu(k,487) * lu(k,869) + lu(k,882) = lu(k,882) - lu(k,488) * lu(k,869) + lu(k,883) = lu(k,883) - lu(k,489) * lu(k,869) + lu(k,884) = lu(k,884) - lu(k,490) * lu(k,869) + lu(k,885) = lu(k,885) - lu(k,491) * lu(k,869) + lu(k,893) = lu(k,893) - lu(k,476) * lu(k,892) + lu(k,894) = lu(k,894) - lu(k,477) * lu(k,892) + lu(k,895) = lu(k,895) - lu(k,478) * lu(k,892) + lu(k,896) = lu(k,896) - lu(k,479) * lu(k,892) + lu(k,897) = lu(k,897) - lu(k,480) * lu(k,892) + lu(k,898) = lu(k,898) - lu(k,481) * lu(k,892) + lu(k,899) = lu(k,899) - lu(k,482) * lu(k,892) + lu(k,900) = lu(k,900) - lu(k,483) * lu(k,892) + lu(k,901) = lu(k,901) - lu(k,484) * lu(k,892) + lu(k,902) = lu(k,902) - lu(k,485) * lu(k,892) + lu(k,903) = lu(k,903) - lu(k,486) * lu(k,892) + lu(k,904) = lu(k,904) - lu(k,487) * lu(k,892) + lu(k,905) = lu(k,905) - lu(k,488) * lu(k,892) + lu(k,906) = lu(k,906) - lu(k,489) * lu(k,892) + lu(k,907) = lu(k,907) - lu(k,490) * lu(k,892) + lu(k,908) = lu(k,908) - lu(k,491) * lu(k,892) + lu(k,944) = lu(k,944) - lu(k,476) * lu(k,943) + lu(k,945) = lu(k,945) - lu(k,477) * lu(k,943) + lu(k,946) = lu(k,946) - lu(k,478) * lu(k,943) + lu(k,947) = lu(k,947) - lu(k,479) * lu(k,943) + lu(k,948) = lu(k,948) - lu(k,480) * lu(k,943) + lu(k,949) = lu(k,949) - lu(k,481) * lu(k,943) + lu(k,950) = lu(k,950) - lu(k,482) * lu(k,943) + lu(k,951) = lu(k,951) - lu(k,483) * lu(k,943) + lu(k,952) = lu(k,952) - lu(k,484) * lu(k,943) + lu(k,953) = lu(k,953) - lu(k,485) * lu(k,943) + lu(k,954) = lu(k,954) - lu(k,486) * lu(k,943) + lu(k,955) = lu(k,955) - lu(k,487) * lu(k,943) + lu(k,956) = lu(k,956) - lu(k,488) * lu(k,943) + lu(k,957) = lu(k,957) - lu(k,489) * lu(k,943) + lu(k,958) = lu(k,958) - lu(k,490) * lu(k,943) + lu(k,959) = lu(k,959) - lu(k,491) * lu(k,943) + lu(k,508) = 1._r8 / lu(k,508) + lu(k,509) = lu(k,509) * lu(k,508) + lu(k,510) = lu(k,510) * lu(k,508) + lu(k,511) = lu(k,511) * lu(k,508) + lu(k,512) = lu(k,512) * lu(k,508) + lu(k,513) = lu(k,513) * lu(k,508) + lu(k,514) = lu(k,514) * lu(k,508) + lu(k,515) = lu(k,515) * lu(k,508) + lu(k,516) = lu(k,516) * lu(k,508) + lu(k,517) = lu(k,517) * lu(k,508) + lu(k,518) = lu(k,518) * lu(k,508) + lu(k,519) = lu(k,519) * lu(k,508) + lu(k,520) = lu(k,520) * lu(k,508) + lu(k,521) = lu(k,521) * lu(k,508) + lu(k,529) = lu(k,529) - lu(k,509) * lu(k,528) + lu(k,530) = lu(k,530) - lu(k,510) * lu(k,528) + lu(k,532) = lu(k,532) - lu(k,511) * lu(k,528) + lu(k,533) = lu(k,533) - lu(k,512) * lu(k,528) + lu(k,534) = lu(k,534) - lu(k,513) * lu(k,528) + lu(k,535) = lu(k,535) - lu(k,514) * lu(k,528) + lu(k,536) = lu(k,536) - lu(k,515) * lu(k,528) + lu(k,537) = lu(k,537) - lu(k,516) * lu(k,528) + lu(k,538) = lu(k,538) - lu(k,517) * lu(k,528) + lu(k,539) = lu(k,539) - lu(k,518) * lu(k,528) + lu(k,540) = lu(k,540) - lu(k,519) * lu(k,528) + lu(k,541) = lu(k,541) - lu(k,520) * lu(k,528) + lu(k,542) = lu(k,542) - lu(k,521) * lu(k,528) + lu(k,554) = lu(k,554) - lu(k,509) * lu(k,553) + lu(k,555) = lu(k,555) - lu(k,510) * lu(k,553) + lu(k,557) = lu(k,557) - lu(k,511) * lu(k,553) + lu(k,558) = lu(k,558) - lu(k,512) * lu(k,553) + lu(k,559) = lu(k,559) - lu(k,513) * lu(k,553) + lu(k,560) = lu(k,560) - lu(k,514) * lu(k,553) + lu(k,561) = lu(k,561) - lu(k,515) * lu(k,553) + lu(k,562) = lu(k,562) - lu(k,516) * lu(k,553) + lu(k,563) = lu(k,563) - lu(k,517) * lu(k,553) + lu(k,564) = lu(k,564) - lu(k,518) * lu(k,553) + lu(k,565) = lu(k,565) - lu(k,519) * lu(k,553) + lu(k,567) = lu(k,567) - lu(k,520) * lu(k,553) + lu(k,568) = lu(k,568) - lu(k,521) * lu(k,553) + lu(k,579) = lu(k,579) - lu(k,509) * lu(k,578) + lu(k,580) = lu(k,580) - lu(k,510) * lu(k,578) + lu(k,582) = lu(k,582) - lu(k,511) * lu(k,578) + lu(k,583) = lu(k,583) - lu(k,512) * lu(k,578) + lu(k,584) = lu(k,584) - lu(k,513) * lu(k,578) + lu(k,585) = lu(k,585) - lu(k,514) * lu(k,578) + lu(k,586) = lu(k,586) - lu(k,515) * lu(k,578) + lu(k,587) = lu(k,587) - lu(k,516) * lu(k,578) + lu(k,588) = lu(k,588) - lu(k,517) * lu(k,578) + lu(k,589) = lu(k,589) - lu(k,518) * lu(k,578) + lu(k,590) = lu(k,590) - lu(k,519) * lu(k,578) + lu(k,592) = lu(k,592) - lu(k,520) * lu(k,578) + lu(k,593) = lu(k,593) - lu(k,521) * lu(k,578) + lu(k,607) = lu(k,607) - lu(k,509) * lu(k,606) + lu(k,608) = lu(k,608) - lu(k,510) * lu(k,606) + lu(k,610) = lu(k,610) - lu(k,511) * lu(k,606) + lu(k,611) = lu(k,611) - lu(k,512) * lu(k,606) + lu(k,612) = lu(k,612) - lu(k,513) * lu(k,606) + lu(k,613) = lu(k,613) - lu(k,514) * lu(k,606) + lu(k,614) = lu(k,614) - lu(k,515) * lu(k,606) + lu(k,615) = lu(k,615) - lu(k,516) * lu(k,606) + lu(k,616) = lu(k,616) - lu(k,517) * lu(k,606) + lu(k,617) = lu(k,617) - lu(k,518) * lu(k,606) + lu(k,618) = lu(k,618) - lu(k,519) * lu(k,606) + lu(k,620) = lu(k,620) - lu(k,520) * lu(k,606) + lu(k,621) = lu(k,621) - lu(k,521) * lu(k,606) + lu(k,636) = lu(k,636) - lu(k,509) * lu(k,635) + lu(k,637) = lu(k,637) - lu(k,510) * lu(k,635) + lu(k,639) = lu(k,639) - lu(k,511) * lu(k,635) + lu(k,640) = lu(k,640) - lu(k,512) * lu(k,635) + lu(k,641) = lu(k,641) - lu(k,513) * lu(k,635) + lu(k,642) = lu(k,642) - lu(k,514) * lu(k,635) + lu(k,643) = lu(k,643) - lu(k,515) * lu(k,635) + lu(k,644) = lu(k,644) - lu(k,516) * lu(k,635) + lu(k,645) = lu(k,645) - lu(k,517) * lu(k,635) + lu(k,646) = lu(k,646) - lu(k,518) * lu(k,635) + lu(k,647) = lu(k,647) - lu(k,519) * lu(k,635) + lu(k,649) = lu(k,649) - lu(k,520) * lu(k,635) + lu(k,650) = lu(k,650) - lu(k,521) * lu(k,635) + lu(k,678) = lu(k,678) - lu(k,509) * lu(k,677) + lu(k,679) = lu(k,679) - lu(k,510) * lu(k,677) + lu(k,681) = lu(k,681) - lu(k,511) * lu(k,677) + lu(k,682) = lu(k,682) - lu(k,512) * lu(k,677) + lu(k,683) = lu(k,683) - lu(k,513) * lu(k,677) + lu(k,684) = lu(k,684) - lu(k,514) * lu(k,677) + lu(k,685) = lu(k,685) - lu(k,515) * lu(k,677) + lu(k,686) = lu(k,686) - lu(k,516) * lu(k,677) + lu(k,687) = lu(k,687) - lu(k,517) * lu(k,677) + lu(k,688) = lu(k,688) - lu(k,518) * lu(k,677) + lu(k,689) = lu(k,689) - lu(k,519) * lu(k,677) + lu(k,691) = lu(k,691) - lu(k,520) * lu(k,677) + lu(k,692) = lu(k,692) - lu(k,521) * lu(k,677) + lu(k,720) = lu(k,720) - lu(k,509) * lu(k,719) + lu(k,721) = lu(k,721) - lu(k,510) * lu(k,719) + lu(k,723) = lu(k,723) - lu(k,511) * lu(k,719) + lu(k,724) = lu(k,724) - lu(k,512) * lu(k,719) + lu(k,725) = lu(k,725) - lu(k,513) * lu(k,719) + lu(k,726) = lu(k,726) - lu(k,514) * lu(k,719) + lu(k,727) = lu(k,727) - lu(k,515) * lu(k,719) + lu(k,728) = lu(k,728) - lu(k,516) * lu(k,719) + lu(k,729) = lu(k,729) - lu(k,517) * lu(k,719) + lu(k,730) = lu(k,730) - lu(k,518) * lu(k,719) + lu(k,731) = lu(k,731) - lu(k,519) * lu(k,719) + lu(k,733) = lu(k,733) - lu(k,520) * lu(k,719) + lu(k,734) = lu(k,734) - lu(k,521) * lu(k,719) + lu(k,745) = lu(k,745) - lu(k,509) * lu(k,744) + lu(k,746) = lu(k,746) - lu(k,510) * lu(k,744) + lu(k,748) = lu(k,748) - lu(k,511) * lu(k,744) + lu(k,749) = lu(k,749) - lu(k,512) * lu(k,744) + lu(k,750) = lu(k,750) - lu(k,513) * lu(k,744) + lu(k,751) = lu(k,751) - lu(k,514) * lu(k,744) + lu(k,752) = lu(k,752) - lu(k,515) * lu(k,744) + lu(k,753) = lu(k,753) - lu(k,516) * lu(k,744) + lu(k,754) = lu(k,754) - lu(k,517) * lu(k,744) + lu(k,755) = lu(k,755) - lu(k,518) * lu(k,744) + lu(k,756) = lu(k,756) - lu(k,519) * lu(k,744) + lu(k,758) = lu(k,758) - lu(k,520) * lu(k,744) + lu(k,759) = lu(k,759) - lu(k,521) * lu(k,744) + lu(k,777) = lu(k,777) - lu(k,509) * lu(k,776) + lu(k,778) = lu(k,778) - lu(k,510) * lu(k,776) + lu(k,780) = lu(k,780) - lu(k,511) * lu(k,776) + lu(k,781) = lu(k,781) - lu(k,512) * lu(k,776) + lu(k,782) = lu(k,782) - lu(k,513) * lu(k,776) + lu(k,783) = lu(k,783) - lu(k,514) * lu(k,776) + lu(k,784) = lu(k,784) - lu(k,515) * lu(k,776) + lu(k,785) = lu(k,785) - lu(k,516) * lu(k,776) + lu(k,786) = lu(k,786) - lu(k,517) * lu(k,776) + lu(k,787) = lu(k,787) - lu(k,518) * lu(k,776) + lu(k,788) = lu(k,788) - lu(k,519) * lu(k,776) + lu(k,790) = lu(k,790) - lu(k,520) * lu(k,776) + lu(k,791) = lu(k,791) - lu(k,521) * lu(k,776) + lu(k,799) = lu(k,799) - lu(k,509) * lu(k,798) + lu(k,800) = lu(k,800) - lu(k,510) * lu(k,798) + lu(k,802) = lu(k,802) - lu(k,511) * lu(k,798) + lu(k,803) = lu(k,803) - lu(k,512) * lu(k,798) + lu(k,804) = lu(k,804) - lu(k,513) * lu(k,798) + lu(k,805) = lu(k,805) - lu(k,514) * lu(k,798) + lu(k,806) = lu(k,806) - lu(k,515) * lu(k,798) + lu(k,807) = lu(k,807) - lu(k,516) * lu(k,798) + lu(k,808) = lu(k,808) - lu(k,517) * lu(k,798) + lu(k,809) = lu(k,809) - lu(k,518) * lu(k,798) + lu(k,810) = lu(k,810) - lu(k,519) * lu(k,798) + lu(k,812) = lu(k,812) - lu(k,520) * lu(k,798) + lu(k,813) = lu(k,813) - lu(k,521) * lu(k,798) + lu(k,848) = lu(k,848) - lu(k,509) * lu(k,847) + lu(k,849) = lu(k,849) - lu(k,510) * lu(k,847) + lu(k,851) = lu(k,851) - lu(k,511) * lu(k,847) + lu(k,852) = lu(k,852) - lu(k,512) * lu(k,847) + lu(k,853) = lu(k,853) - lu(k,513) * lu(k,847) + lu(k,854) = lu(k,854) - lu(k,514) * lu(k,847) + lu(k,855) = lu(k,855) - lu(k,515) * lu(k,847) + lu(k,856) = lu(k,856) - lu(k,516) * lu(k,847) + lu(k,857) = lu(k,857) - lu(k,517) * lu(k,847) + lu(k,858) = lu(k,858) - lu(k,518) * lu(k,847) + lu(k,859) = lu(k,859) - lu(k,519) * lu(k,847) + lu(k,861) = lu(k,861) - lu(k,520) * lu(k,847) + lu(k,862) = lu(k,862) - lu(k,521) * lu(k,847) + lu(k,871) = lu(k,871) - lu(k,509) * lu(k,870) + lu(k,872) = lu(k,872) - lu(k,510) * lu(k,870) + lu(k,874) = lu(k,874) - lu(k,511) * lu(k,870) + lu(k,875) = lu(k,875) - lu(k,512) * lu(k,870) + lu(k,876) = lu(k,876) - lu(k,513) * lu(k,870) + lu(k,877) = lu(k,877) - lu(k,514) * lu(k,870) + lu(k,878) = lu(k,878) - lu(k,515) * lu(k,870) + lu(k,879) = lu(k,879) - lu(k,516) * lu(k,870) + lu(k,880) = lu(k,880) - lu(k,517) * lu(k,870) + lu(k,881) = lu(k,881) - lu(k,518) * lu(k,870) + lu(k,882) = lu(k,882) - lu(k,519) * lu(k,870) + lu(k,884) = lu(k,884) - lu(k,520) * lu(k,870) + lu(k,885) = lu(k,885) - lu(k,521) * lu(k,870) + lu(k,894) = lu(k,894) - lu(k,509) * lu(k,893) + lu(k,895) = lu(k,895) - lu(k,510) * lu(k,893) + lu(k,897) = lu(k,897) - lu(k,511) * lu(k,893) + lu(k,898) = lu(k,898) - lu(k,512) * lu(k,893) + lu(k,899) = lu(k,899) - lu(k,513) * lu(k,893) + lu(k,900) = lu(k,900) - lu(k,514) * lu(k,893) + lu(k,901) = lu(k,901) - lu(k,515) * lu(k,893) + lu(k,902) = lu(k,902) - lu(k,516) * lu(k,893) + lu(k,903) = lu(k,903) - lu(k,517) * lu(k,893) + lu(k,904) = lu(k,904) - lu(k,518) * lu(k,893) + lu(k,905) = lu(k,905) - lu(k,519) * lu(k,893) + lu(k,907) = lu(k,907) - lu(k,520) * lu(k,893) + lu(k,908) = lu(k,908) - lu(k,521) * lu(k,893) + lu(k,918) = lu(k,918) - lu(k,509) * lu(k,917) + lu(k,919) = lu(k,919) - lu(k,510) * lu(k,917) + lu(k,921) = lu(k,921) - lu(k,511) * lu(k,917) + lu(k,922) = lu(k,922) - lu(k,512) * lu(k,917) + lu(k,923) = lu(k,923) - lu(k,513) * lu(k,917) + lu(k,924) = lu(k,924) - lu(k,514) * lu(k,917) + lu(k,925) = lu(k,925) - lu(k,515) * lu(k,917) + lu(k,926) = lu(k,926) - lu(k,516) * lu(k,917) + lu(k,927) = lu(k,927) - lu(k,517) * lu(k,917) + lu(k,928) = lu(k,928) - lu(k,518) * lu(k,917) + lu(k,929) = lu(k,929) - lu(k,519) * lu(k,917) + lu(k,931) = lu(k,931) - lu(k,520) * lu(k,917) + lu(k,932) = lu(k,932) - lu(k,521) * lu(k,917) + lu(k,945) = lu(k,945) - lu(k,509) * lu(k,944) + lu(k,946) = lu(k,946) - lu(k,510) * lu(k,944) + lu(k,948) = lu(k,948) - lu(k,511) * lu(k,944) + lu(k,949) = lu(k,949) - lu(k,512) * lu(k,944) + lu(k,950) = lu(k,950) - lu(k,513) * lu(k,944) + lu(k,951) = lu(k,951) - lu(k,514) * lu(k,944) + lu(k,952) = lu(k,952) - lu(k,515) * lu(k,944) + lu(k,953) = lu(k,953) - lu(k,516) * lu(k,944) + lu(k,954) = lu(k,954) - lu(k,517) * lu(k,944) + lu(k,955) = lu(k,955) - lu(k,518) * lu(k,944) + lu(k,956) = lu(k,956) - lu(k,519) * lu(k,944) + lu(k,958) = lu(k,958) - lu(k,520) * lu(k,944) + lu(k,959) = lu(k,959) - lu(k,521) * lu(k,944) + 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,529) = 1._r8 / lu(k,529) + lu(k,530) = lu(k,530) * lu(k,529) + lu(k,531) = lu(k,531) * lu(k,529) + lu(k,532) = lu(k,532) * lu(k,529) + lu(k,533) = lu(k,533) * lu(k,529) + lu(k,534) = lu(k,534) * lu(k,529) + lu(k,535) = lu(k,535) * lu(k,529) + lu(k,536) = lu(k,536) * lu(k,529) + lu(k,537) = lu(k,537) * lu(k,529) + lu(k,538) = lu(k,538) * lu(k,529) + lu(k,539) = lu(k,539) * lu(k,529) + lu(k,540) = lu(k,540) * lu(k,529) + lu(k,541) = lu(k,541) * lu(k,529) + lu(k,542) = lu(k,542) * lu(k,529) + lu(k,555) = lu(k,555) - lu(k,530) * lu(k,554) + lu(k,556) = lu(k,556) - lu(k,531) * lu(k,554) + lu(k,557) = lu(k,557) - lu(k,532) * lu(k,554) + lu(k,558) = lu(k,558) - lu(k,533) * lu(k,554) + lu(k,559) = lu(k,559) - lu(k,534) * lu(k,554) + lu(k,560) = lu(k,560) - lu(k,535) * lu(k,554) + lu(k,561) = lu(k,561) - lu(k,536) * lu(k,554) + lu(k,562) = lu(k,562) - lu(k,537) * lu(k,554) + lu(k,563) = lu(k,563) - lu(k,538) * lu(k,554) + lu(k,564) = lu(k,564) - lu(k,539) * lu(k,554) + lu(k,565) = lu(k,565) - lu(k,540) * lu(k,554) + lu(k,567) = lu(k,567) - lu(k,541) * lu(k,554) + lu(k,568) = lu(k,568) - lu(k,542) * lu(k,554) + lu(k,580) = lu(k,580) - lu(k,530) * lu(k,579) + lu(k,581) = lu(k,581) - lu(k,531) * lu(k,579) + lu(k,582) = lu(k,582) - lu(k,532) * lu(k,579) + lu(k,583) = lu(k,583) - lu(k,533) * lu(k,579) + lu(k,584) = lu(k,584) - lu(k,534) * lu(k,579) + lu(k,585) = lu(k,585) - lu(k,535) * lu(k,579) + lu(k,586) = lu(k,586) - lu(k,536) * lu(k,579) + lu(k,587) = lu(k,587) - lu(k,537) * lu(k,579) + lu(k,588) = lu(k,588) - lu(k,538) * lu(k,579) + lu(k,589) = lu(k,589) - lu(k,539) * lu(k,579) + lu(k,590) = lu(k,590) - lu(k,540) * lu(k,579) + lu(k,592) = lu(k,592) - lu(k,541) * lu(k,579) + lu(k,593) = lu(k,593) - lu(k,542) * lu(k,579) + lu(k,608) = lu(k,608) - lu(k,530) * lu(k,607) + lu(k,609) = lu(k,609) - lu(k,531) * lu(k,607) + lu(k,610) = lu(k,610) - lu(k,532) * lu(k,607) + lu(k,611) = lu(k,611) - lu(k,533) * lu(k,607) + lu(k,612) = lu(k,612) - lu(k,534) * lu(k,607) + lu(k,613) = lu(k,613) - lu(k,535) * lu(k,607) + lu(k,614) = lu(k,614) - lu(k,536) * lu(k,607) + lu(k,615) = lu(k,615) - lu(k,537) * lu(k,607) + lu(k,616) = lu(k,616) - lu(k,538) * lu(k,607) + lu(k,617) = lu(k,617) - lu(k,539) * lu(k,607) + lu(k,618) = lu(k,618) - lu(k,540) * lu(k,607) + lu(k,620) = lu(k,620) - lu(k,541) * lu(k,607) + lu(k,621) = lu(k,621) - lu(k,542) * lu(k,607) + lu(k,637) = lu(k,637) - lu(k,530) * lu(k,636) + lu(k,638) = lu(k,638) - lu(k,531) * lu(k,636) + lu(k,639) = lu(k,639) - lu(k,532) * lu(k,636) + lu(k,640) = lu(k,640) - lu(k,533) * lu(k,636) + lu(k,641) = lu(k,641) - lu(k,534) * lu(k,636) + lu(k,642) = lu(k,642) - lu(k,535) * lu(k,636) + lu(k,643) = lu(k,643) - lu(k,536) * lu(k,636) + lu(k,644) = lu(k,644) - lu(k,537) * lu(k,636) + lu(k,645) = lu(k,645) - lu(k,538) * lu(k,636) + lu(k,646) = lu(k,646) - lu(k,539) * lu(k,636) + lu(k,647) = lu(k,647) - lu(k,540) * lu(k,636) + lu(k,649) = lu(k,649) - lu(k,541) * lu(k,636) + lu(k,650) = lu(k,650) - lu(k,542) * lu(k,636) + lu(k,679) = lu(k,679) - lu(k,530) * lu(k,678) + lu(k,680) = lu(k,680) - lu(k,531) * lu(k,678) + lu(k,681) = lu(k,681) - lu(k,532) * lu(k,678) + lu(k,682) = lu(k,682) - lu(k,533) * lu(k,678) + lu(k,683) = lu(k,683) - lu(k,534) * lu(k,678) + lu(k,684) = lu(k,684) - lu(k,535) * lu(k,678) + lu(k,685) = lu(k,685) - lu(k,536) * lu(k,678) + lu(k,686) = lu(k,686) - lu(k,537) * lu(k,678) + lu(k,687) = lu(k,687) - lu(k,538) * lu(k,678) + lu(k,688) = lu(k,688) - lu(k,539) * lu(k,678) + lu(k,689) = lu(k,689) - lu(k,540) * lu(k,678) + lu(k,691) = lu(k,691) - lu(k,541) * lu(k,678) + lu(k,692) = lu(k,692) - lu(k,542) * lu(k,678) + lu(k,721) = lu(k,721) - lu(k,530) * lu(k,720) + lu(k,722) = lu(k,722) - lu(k,531) * lu(k,720) + lu(k,723) = lu(k,723) - lu(k,532) * lu(k,720) + lu(k,724) = lu(k,724) - lu(k,533) * lu(k,720) + lu(k,725) = lu(k,725) - lu(k,534) * lu(k,720) + lu(k,726) = lu(k,726) - lu(k,535) * lu(k,720) + lu(k,727) = lu(k,727) - lu(k,536) * lu(k,720) + lu(k,728) = lu(k,728) - lu(k,537) * lu(k,720) + lu(k,729) = lu(k,729) - lu(k,538) * lu(k,720) + lu(k,730) = lu(k,730) - lu(k,539) * lu(k,720) + lu(k,731) = lu(k,731) - lu(k,540) * lu(k,720) + lu(k,733) = lu(k,733) - lu(k,541) * lu(k,720) + lu(k,734) = lu(k,734) - lu(k,542) * lu(k,720) + lu(k,746) = lu(k,746) - lu(k,530) * lu(k,745) + lu(k,747) = lu(k,747) - lu(k,531) * lu(k,745) + lu(k,748) = lu(k,748) - lu(k,532) * lu(k,745) + lu(k,749) = lu(k,749) - lu(k,533) * lu(k,745) + lu(k,750) = lu(k,750) - lu(k,534) * lu(k,745) + lu(k,751) = lu(k,751) - lu(k,535) * lu(k,745) + lu(k,752) = lu(k,752) - lu(k,536) * lu(k,745) + lu(k,753) = lu(k,753) - lu(k,537) * lu(k,745) + lu(k,754) = lu(k,754) - lu(k,538) * lu(k,745) + lu(k,755) = lu(k,755) - lu(k,539) * lu(k,745) + lu(k,756) = lu(k,756) - lu(k,540) * lu(k,745) + lu(k,758) = lu(k,758) - lu(k,541) * lu(k,745) + lu(k,759) = lu(k,759) - lu(k,542) * lu(k,745) + lu(k,778) = lu(k,778) - lu(k,530) * lu(k,777) + lu(k,779) = lu(k,779) - lu(k,531) * lu(k,777) + lu(k,780) = lu(k,780) - lu(k,532) * lu(k,777) + lu(k,781) = lu(k,781) - lu(k,533) * lu(k,777) + lu(k,782) = lu(k,782) - lu(k,534) * lu(k,777) + lu(k,783) = lu(k,783) - lu(k,535) * lu(k,777) + lu(k,784) = lu(k,784) - lu(k,536) * lu(k,777) + lu(k,785) = lu(k,785) - lu(k,537) * lu(k,777) + lu(k,786) = lu(k,786) - lu(k,538) * lu(k,777) + lu(k,787) = lu(k,787) - lu(k,539) * lu(k,777) + lu(k,788) = lu(k,788) - lu(k,540) * lu(k,777) + lu(k,790) = lu(k,790) - lu(k,541) * lu(k,777) + lu(k,791) = lu(k,791) - lu(k,542) * lu(k,777) + lu(k,800) = lu(k,800) - lu(k,530) * lu(k,799) + lu(k,801) = lu(k,801) - lu(k,531) * lu(k,799) + lu(k,802) = lu(k,802) - lu(k,532) * lu(k,799) + lu(k,803) = lu(k,803) - lu(k,533) * lu(k,799) + lu(k,804) = lu(k,804) - lu(k,534) * lu(k,799) + lu(k,805) = lu(k,805) - lu(k,535) * lu(k,799) + lu(k,806) = lu(k,806) - lu(k,536) * lu(k,799) + lu(k,807) = lu(k,807) - lu(k,537) * lu(k,799) + lu(k,808) = lu(k,808) - lu(k,538) * lu(k,799) + lu(k,809) = lu(k,809) - lu(k,539) * lu(k,799) + lu(k,810) = lu(k,810) - lu(k,540) * lu(k,799) + lu(k,812) = lu(k,812) - lu(k,541) * lu(k,799) + lu(k,813) = lu(k,813) - lu(k,542) * lu(k,799) + lu(k,849) = lu(k,849) - lu(k,530) * lu(k,848) + lu(k,850) = lu(k,850) - lu(k,531) * lu(k,848) + lu(k,851) = lu(k,851) - lu(k,532) * lu(k,848) + lu(k,852) = lu(k,852) - lu(k,533) * lu(k,848) + lu(k,853) = lu(k,853) - lu(k,534) * lu(k,848) + lu(k,854) = lu(k,854) - lu(k,535) * lu(k,848) + lu(k,855) = lu(k,855) - lu(k,536) * lu(k,848) + lu(k,856) = lu(k,856) - lu(k,537) * lu(k,848) + lu(k,857) = lu(k,857) - lu(k,538) * lu(k,848) + lu(k,858) = lu(k,858) - lu(k,539) * lu(k,848) + lu(k,859) = lu(k,859) - lu(k,540) * lu(k,848) + lu(k,861) = lu(k,861) - lu(k,541) * lu(k,848) + lu(k,862) = lu(k,862) - lu(k,542) * lu(k,848) + lu(k,872) = lu(k,872) - lu(k,530) * lu(k,871) + lu(k,873) = lu(k,873) - lu(k,531) * lu(k,871) + lu(k,874) = lu(k,874) - lu(k,532) * lu(k,871) + lu(k,875) = lu(k,875) - lu(k,533) * lu(k,871) + lu(k,876) = lu(k,876) - lu(k,534) * lu(k,871) + lu(k,877) = lu(k,877) - lu(k,535) * lu(k,871) + lu(k,878) = lu(k,878) - lu(k,536) * lu(k,871) + lu(k,879) = lu(k,879) - lu(k,537) * lu(k,871) + lu(k,880) = lu(k,880) - lu(k,538) * lu(k,871) + lu(k,881) = lu(k,881) - lu(k,539) * lu(k,871) + lu(k,882) = lu(k,882) - lu(k,540) * lu(k,871) + lu(k,884) = lu(k,884) - lu(k,541) * lu(k,871) + lu(k,885) = lu(k,885) - lu(k,542) * lu(k,871) + lu(k,895) = lu(k,895) - lu(k,530) * lu(k,894) + lu(k,896) = lu(k,896) - lu(k,531) * lu(k,894) + lu(k,897) = lu(k,897) - lu(k,532) * lu(k,894) + lu(k,898) = lu(k,898) - lu(k,533) * lu(k,894) + lu(k,899) = lu(k,899) - lu(k,534) * lu(k,894) + lu(k,900) = lu(k,900) - lu(k,535) * lu(k,894) + lu(k,901) = lu(k,901) - lu(k,536) * lu(k,894) + lu(k,902) = lu(k,902) - lu(k,537) * lu(k,894) + lu(k,903) = lu(k,903) - lu(k,538) * lu(k,894) + lu(k,904) = lu(k,904) - lu(k,539) * lu(k,894) + lu(k,905) = lu(k,905) - lu(k,540) * lu(k,894) + lu(k,907) = lu(k,907) - lu(k,541) * lu(k,894) + lu(k,908) = lu(k,908) - lu(k,542) * lu(k,894) + lu(k,919) = lu(k,919) - lu(k,530) * lu(k,918) + lu(k,920) = lu(k,920) - lu(k,531) * lu(k,918) + lu(k,921) = lu(k,921) - lu(k,532) * lu(k,918) + lu(k,922) = lu(k,922) - lu(k,533) * lu(k,918) + lu(k,923) = lu(k,923) - lu(k,534) * lu(k,918) + lu(k,924) = lu(k,924) - lu(k,535) * lu(k,918) + lu(k,925) = lu(k,925) - lu(k,536) * lu(k,918) + lu(k,926) = lu(k,926) - lu(k,537) * lu(k,918) + lu(k,927) = lu(k,927) - lu(k,538) * lu(k,918) + lu(k,928) = lu(k,928) - lu(k,539) * lu(k,918) + lu(k,929) = lu(k,929) - lu(k,540) * lu(k,918) + lu(k,931) = lu(k,931) - lu(k,541) * lu(k,918) + lu(k,932) = lu(k,932) - lu(k,542) * lu(k,918) + lu(k,946) = lu(k,946) - lu(k,530) * lu(k,945) + lu(k,947) = lu(k,947) - lu(k,531) * lu(k,945) + lu(k,948) = lu(k,948) - lu(k,532) * lu(k,945) + lu(k,949) = lu(k,949) - lu(k,533) * lu(k,945) + lu(k,950) = lu(k,950) - lu(k,534) * lu(k,945) + lu(k,951) = lu(k,951) - lu(k,535) * lu(k,945) + lu(k,952) = lu(k,952) - lu(k,536) * lu(k,945) + lu(k,953) = lu(k,953) - lu(k,537) * lu(k,945) + lu(k,954) = lu(k,954) - lu(k,538) * lu(k,945) + lu(k,955) = lu(k,955) - lu(k,539) * lu(k,945) + lu(k,956) = lu(k,956) - lu(k,540) * lu(k,945) + lu(k,958) = lu(k,958) - lu(k,541) * lu(k,945) + lu(k,959) = lu(k,959) - lu(k,542) * lu(k,945) + lu(k,555) = 1._r8 / lu(k,555) + lu(k,556) = lu(k,556) * lu(k,555) + lu(k,557) = lu(k,557) * lu(k,555) + lu(k,558) = lu(k,558) * lu(k,555) + lu(k,559) = lu(k,559) * lu(k,555) + lu(k,560) = lu(k,560) * lu(k,555) + lu(k,561) = lu(k,561) * lu(k,555) + lu(k,562) = lu(k,562) * lu(k,555) + lu(k,563) = lu(k,563) * lu(k,555) + lu(k,564) = lu(k,564) * lu(k,555) + lu(k,565) = lu(k,565) * lu(k,555) + lu(k,566) = lu(k,566) * lu(k,555) + lu(k,567) = lu(k,567) * lu(k,555) + lu(k,568) = lu(k,568) * lu(k,555) + lu(k,581) = lu(k,581) - lu(k,556) * lu(k,580) + lu(k,582) = lu(k,582) - lu(k,557) * lu(k,580) + lu(k,583) = lu(k,583) - lu(k,558) * lu(k,580) + lu(k,584) = lu(k,584) - lu(k,559) * lu(k,580) + lu(k,585) = lu(k,585) - lu(k,560) * lu(k,580) + lu(k,586) = lu(k,586) - lu(k,561) * lu(k,580) + lu(k,587) = lu(k,587) - lu(k,562) * lu(k,580) + lu(k,588) = lu(k,588) - lu(k,563) * lu(k,580) + lu(k,589) = lu(k,589) - lu(k,564) * lu(k,580) + lu(k,590) = lu(k,590) - lu(k,565) * lu(k,580) + lu(k,591) = lu(k,591) - lu(k,566) * lu(k,580) + lu(k,592) = lu(k,592) - lu(k,567) * lu(k,580) + lu(k,593) = lu(k,593) - lu(k,568) * lu(k,580) + lu(k,609) = lu(k,609) - lu(k,556) * lu(k,608) + lu(k,610) = lu(k,610) - lu(k,557) * lu(k,608) + lu(k,611) = lu(k,611) - lu(k,558) * lu(k,608) + lu(k,612) = lu(k,612) - lu(k,559) * lu(k,608) + lu(k,613) = lu(k,613) - lu(k,560) * lu(k,608) + lu(k,614) = lu(k,614) - lu(k,561) * lu(k,608) + lu(k,615) = lu(k,615) - lu(k,562) * lu(k,608) + lu(k,616) = lu(k,616) - lu(k,563) * lu(k,608) + lu(k,617) = lu(k,617) - lu(k,564) * lu(k,608) + lu(k,618) = lu(k,618) - lu(k,565) * lu(k,608) + lu(k,619) = lu(k,619) - lu(k,566) * lu(k,608) + lu(k,620) = lu(k,620) - lu(k,567) * lu(k,608) + lu(k,621) = lu(k,621) - lu(k,568) * lu(k,608) + lu(k,638) = lu(k,638) - lu(k,556) * lu(k,637) + lu(k,639) = lu(k,639) - lu(k,557) * lu(k,637) + lu(k,640) = lu(k,640) - lu(k,558) * lu(k,637) + lu(k,641) = lu(k,641) - lu(k,559) * lu(k,637) + lu(k,642) = lu(k,642) - lu(k,560) * lu(k,637) + lu(k,643) = lu(k,643) - lu(k,561) * lu(k,637) + lu(k,644) = lu(k,644) - lu(k,562) * lu(k,637) + lu(k,645) = lu(k,645) - lu(k,563) * lu(k,637) + lu(k,646) = lu(k,646) - lu(k,564) * lu(k,637) + lu(k,647) = lu(k,647) - lu(k,565) * lu(k,637) + lu(k,648) = lu(k,648) - lu(k,566) * lu(k,637) + lu(k,649) = lu(k,649) - lu(k,567) * lu(k,637) + lu(k,650) = lu(k,650) - lu(k,568) * lu(k,637) + lu(k,680) = lu(k,680) - lu(k,556) * lu(k,679) + lu(k,681) = lu(k,681) - lu(k,557) * lu(k,679) + lu(k,682) = lu(k,682) - lu(k,558) * lu(k,679) + lu(k,683) = lu(k,683) - lu(k,559) * lu(k,679) + lu(k,684) = lu(k,684) - lu(k,560) * lu(k,679) + lu(k,685) = lu(k,685) - lu(k,561) * lu(k,679) + lu(k,686) = lu(k,686) - lu(k,562) * lu(k,679) + lu(k,687) = lu(k,687) - lu(k,563) * lu(k,679) + lu(k,688) = lu(k,688) - lu(k,564) * lu(k,679) + lu(k,689) = lu(k,689) - lu(k,565) * lu(k,679) + lu(k,690) = lu(k,690) - lu(k,566) * lu(k,679) + lu(k,691) = lu(k,691) - lu(k,567) * lu(k,679) + lu(k,692) = lu(k,692) - lu(k,568) * lu(k,679) + lu(k,722) = lu(k,722) - lu(k,556) * lu(k,721) + lu(k,723) = lu(k,723) - lu(k,557) * lu(k,721) + lu(k,724) = lu(k,724) - lu(k,558) * lu(k,721) + lu(k,725) = lu(k,725) - lu(k,559) * lu(k,721) + lu(k,726) = lu(k,726) - lu(k,560) * lu(k,721) + lu(k,727) = lu(k,727) - lu(k,561) * lu(k,721) + lu(k,728) = lu(k,728) - lu(k,562) * lu(k,721) + lu(k,729) = lu(k,729) - lu(k,563) * lu(k,721) + lu(k,730) = lu(k,730) - lu(k,564) * lu(k,721) + lu(k,731) = lu(k,731) - lu(k,565) * lu(k,721) + lu(k,732) = lu(k,732) - lu(k,566) * lu(k,721) + lu(k,733) = lu(k,733) - lu(k,567) * lu(k,721) + lu(k,734) = lu(k,734) - lu(k,568) * lu(k,721) + lu(k,747) = lu(k,747) - lu(k,556) * lu(k,746) + lu(k,748) = lu(k,748) - lu(k,557) * lu(k,746) + lu(k,749) = lu(k,749) - lu(k,558) * lu(k,746) + lu(k,750) = lu(k,750) - lu(k,559) * lu(k,746) + lu(k,751) = lu(k,751) - lu(k,560) * lu(k,746) + lu(k,752) = lu(k,752) - lu(k,561) * lu(k,746) + lu(k,753) = lu(k,753) - lu(k,562) * lu(k,746) + lu(k,754) = lu(k,754) - lu(k,563) * lu(k,746) + lu(k,755) = lu(k,755) - lu(k,564) * lu(k,746) + lu(k,756) = lu(k,756) - lu(k,565) * lu(k,746) + lu(k,757) = lu(k,757) - lu(k,566) * lu(k,746) + lu(k,758) = lu(k,758) - lu(k,567) * lu(k,746) + lu(k,759) = lu(k,759) - lu(k,568) * lu(k,746) + lu(k,779) = lu(k,779) - lu(k,556) * lu(k,778) + lu(k,780) = lu(k,780) - lu(k,557) * lu(k,778) + lu(k,781) = lu(k,781) - lu(k,558) * lu(k,778) + lu(k,782) = lu(k,782) - lu(k,559) * lu(k,778) + lu(k,783) = lu(k,783) - lu(k,560) * lu(k,778) + lu(k,784) = lu(k,784) - lu(k,561) * lu(k,778) + lu(k,785) = lu(k,785) - lu(k,562) * lu(k,778) + lu(k,786) = lu(k,786) - lu(k,563) * lu(k,778) + lu(k,787) = lu(k,787) - lu(k,564) * lu(k,778) + lu(k,788) = lu(k,788) - lu(k,565) * lu(k,778) + lu(k,789) = lu(k,789) - lu(k,566) * lu(k,778) + lu(k,790) = lu(k,790) - lu(k,567) * lu(k,778) + lu(k,791) = lu(k,791) - lu(k,568) * lu(k,778) + lu(k,801) = lu(k,801) - lu(k,556) * lu(k,800) + lu(k,802) = lu(k,802) - lu(k,557) * lu(k,800) + lu(k,803) = lu(k,803) - lu(k,558) * lu(k,800) + lu(k,804) = lu(k,804) - lu(k,559) * lu(k,800) + lu(k,805) = lu(k,805) - lu(k,560) * lu(k,800) + lu(k,806) = lu(k,806) - lu(k,561) * lu(k,800) + lu(k,807) = lu(k,807) - lu(k,562) * lu(k,800) + lu(k,808) = lu(k,808) - lu(k,563) * lu(k,800) + lu(k,809) = lu(k,809) - lu(k,564) * lu(k,800) + lu(k,810) = lu(k,810) - lu(k,565) * lu(k,800) + lu(k,811) = lu(k,811) - lu(k,566) * lu(k,800) + lu(k,812) = lu(k,812) - lu(k,567) * lu(k,800) + lu(k,813) = lu(k,813) - lu(k,568) * lu(k,800) + lu(k,850) = lu(k,850) - lu(k,556) * lu(k,849) + lu(k,851) = lu(k,851) - lu(k,557) * lu(k,849) + lu(k,852) = lu(k,852) - lu(k,558) * lu(k,849) + lu(k,853) = lu(k,853) - lu(k,559) * lu(k,849) + lu(k,854) = lu(k,854) - lu(k,560) * lu(k,849) + lu(k,855) = lu(k,855) - lu(k,561) * lu(k,849) + lu(k,856) = lu(k,856) - lu(k,562) * lu(k,849) + lu(k,857) = lu(k,857) - lu(k,563) * lu(k,849) + lu(k,858) = lu(k,858) - lu(k,564) * lu(k,849) + lu(k,859) = lu(k,859) - lu(k,565) * lu(k,849) + lu(k,860) = lu(k,860) - lu(k,566) * lu(k,849) + lu(k,861) = lu(k,861) - lu(k,567) * lu(k,849) + lu(k,862) = lu(k,862) - lu(k,568) * lu(k,849) + lu(k,873) = lu(k,873) - lu(k,556) * lu(k,872) + lu(k,874) = lu(k,874) - lu(k,557) * lu(k,872) + lu(k,875) = lu(k,875) - lu(k,558) * lu(k,872) + lu(k,876) = lu(k,876) - lu(k,559) * lu(k,872) + lu(k,877) = lu(k,877) - lu(k,560) * lu(k,872) + lu(k,878) = lu(k,878) - lu(k,561) * lu(k,872) + lu(k,879) = lu(k,879) - lu(k,562) * lu(k,872) + lu(k,880) = lu(k,880) - lu(k,563) * lu(k,872) + lu(k,881) = lu(k,881) - lu(k,564) * lu(k,872) + lu(k,882) = lu(k,882) - lu(k,565) * lu(k,872) + lu(k,883) = lu(k,883) - lu(k,566) * lu(k,872) + lu(k,884) = lu(k,884) - lu(k,567) * lu(k,872) + lu(k,885) = lu(k,885) - lu(k,568) * lu(k,872) + lu(k,896) = lu(k,896) - lu(k,556) * lu(k,895) + lu(k,897) = lu(k,897) - lu(k,557) * lu(k,895) + lu(k,898) = lu(k,898) - lu(k,558) * lu(k,895) + lu(k,899) = lu(k,899) - lu(k,559) * lu(k,895) + lu(k,900) = lu(k,900) - lu(k,560) * lu(k,895) + lu(k,901) = lu(k,901) - lu(k,561) * lu(k,895) + lu(k,902) = lu(k,902) - lu(k,562) * lu(k,895) + lu(k,903) = lu(k,903) - lu(k,563) * lu(k,895) + lu(k,904) = lu(k,904) - lu(k,564) * lu(k,895) + lu(k,905) = lu(k,905) - lu(k,565) * lu(k,895) + lu(k,906) = lu(k,906) - lu(k,566) * lu(k,895) + lu(k,907) = lu(k,907) - lu(k,567) * lu(k,895) + lu(k,908) = lu(k,908) - lu(k,568) * lu(k,895) + lu(k,920) = lu(k,920) - lu(k,556) * lu(k,919) + lu(k,921) = lu(k,921) - lu(k,557) * lu(k,919) + lu(k,922) = lu(k,922) - lu(k,558) * lu(k,919) + lu(k,923) = lu(k,923) - lu(k,559) * lu(k,919) + lu(k,924) = lu(k,924) - lu(k,560) * lu(k,919) + lu(k,925) = lu(k,925) - lu(k,561) * lu(k,919) + lu(k,926) = lu(k,926) - lu(k,562) * lu(k,919) + lu(k,927) = lu(k,927) - lu(k,563) * lu(k,919) + lu(k,928) = lu(k,928) - lu(k,564) * lu(k,919) + lu(k,929) = lu(k,929) - lu(k,565) * lu(k,919) + lu(k,930) = lu(k,930) - lu(k,566) * lu(k,919) + lu(k,931) = lu(k,931) - lu(k,567) * lu(k,919) + lu(k,932) = lu(k,932) - lu(k,568) * lu(k,919) + lu(k,947) = lu(k,947) - lu(k,556) * lu(k,946) + lu(k,948) = lu(k,948) - lu(k,557) * lu(k,946) + lu(k,949) = lu(k,949) - lu(k,558) * lu(k,946) + lu(k,950) = lu(k,950) - lu(k,559) * lu(k,946) + lu(k,951) = lu(k,951) - lu(k,560) * lu(k,946) + lu(k,952) = lu(k,952) - lu(k,561) * lu(k,946) + lu(k,953) = lu(k,953) - lu(k,562) * lu(k,946) + lu(k,954) = lu(k,954) - lu(k,563) * lu(k,946) + lu(k,955) = lu(k,955) - lu(k,564) * lu(k,946) + lu(k,956) = lu(k,956) - lu(k,565) * lu(k,946) + lu(k,957) = lu(k,957) - lu(k,566) * lu(k,946) + lu(k,958) = lu(k,958) - lu(k,567) * lu(k,946) + lu(k,959) = lu(k,959) - lu(k,568) * lu(k,946) + lu(k,581) = 1._r8 / lu(k,581) + lu(k,582) = lu(k,582) * lu(k,581) + lu(k,583) = lu(k,583) * lu(k,581) + lu(k,584) = lu(k,584) * lu(k,581) + lu(k,585) = lu(k,585) * lu(k,581) + lu(k,586) = lu(k,586) * lu(k,581) + lu(k,587) = lu(k,587) * lu(k,581) + lu(k,588) = lu(k,588) * lu(k,581) + lu(k,589) = lu(k,589) * lu(k,581) + lu(k,590) = lu(k,590) * lu(k,581) + lu(k,591) = lu(k,591) * lu(k,581) + lu(k,592) = lu(k,592) * lu(k,581) + lu(k,593) = lu(k,593) * lu(k,581) + lu(k,610) = lu(k,610) - lu(k,582) * lu(k,609) + lu(k,611) = lu(k,611) - lu(k,583) * lu(k,609) + lu(k,612) = lu(k,612) - lu(k,584) * lu(k,609) + lu(k,613) = lu(k,613) - lu(k,585) * lu(k,609) + lu(k,614) = lu(k,614) - lu(k,586) * lu(k,609) + lu(k,615) = lu(k,615) - lu(k,587) * lu(k,609) + lu(k,616) = lu(k,616) - lu(k,588) * lu(k,609) + lu(k,617) = lu(k,617) - lu(k,589) * lu(k,609) + lu(k,618) = lu(k,618) - lu(k,590) * lu(k,609) + lu(k,619) = lu(k,619) - lu(k,591) * lu(k,609) + lu(k,620) = lu(k,620) - lu(k,592) * lu(k,609) + lu(k,621) = lu(k,621) - lu(k,593) * lu(k,609) + lu(k,639) = lu(k,639) - lu(k,582) * lu(k,638) + lu(k,640) = lu(k,640) - lu(k,583) * lu(k,638) + lu(k,641) = lu(k,641) - lu(k,584) * lu(k,638) + lu(k,642) = lu(k,642) - lu(k,585) * lu(k,638) + lu(k,643) = lu(k,643) - lu(k,586) * lu(k,638) + lu(k,644) = lu(k,644) - lu(k,587) * lu(k,638) + lu(k,645) = lu(k,645) - lu(k,588) * lu(k,638) + lu(k,646) = lu(k,646) - lu(k,589) * lu(k,638) + lu(k,647) = lu(k,647) - lu(k,590) * lu(k,638) + lu(k,648) = lu(k,648) - lu(k,591) * lu(k,638) + lu(k,649) = lu(k,649) - lu(k,592) * lu(k,638) + lu(k,650) = lu(k,650) - lu(k,593) * lu(k,638) + lu(k,681) = lu(k,681) - lu(k,582) * lu(k,680) + lu(k,682) = lu(k,682) - lu(k,583) * lu(k,680) + lu(k,683) = lu(k,683) - lu(k,584) * lu(k,680) + lu(k,684) = lu(k,684) - lu(k,585) * lu(k,680) + lu(k,685) = lu(k,685) - lu(k,586) * lu(k,680) + lu(k,686) = lu(k,686) - lu(k,587) * lu(k,680) + lu(k,687) = lu(k,687) - lu(k,588) * lu(k,680) + lu(k,688) = lu(k,688) - lu(k,589) * lu(k,680) + lu(k,689) = lu(k,689) - lu(k,590) * lu(k,680) + lu(k,690) = lu(k,690) - lu(k,591) * lu(k,680) + lu(k,691) = lu(k,691) - lu(k,592) * lu(k,680) + lu(k,692) = lu(k,692) - lu(k,593) * lu(k,680) + lu(k,723) = lu(k,723) - lu(k,582) * lu(k,722) + lu(k,724) = lu(k,724) - lu(k,583) * lu(k,722) + lu(k,725) = lu(k,725) - lu(k,584) * lu(k,722) + lu(k,726) = lu(k,726) - lu(k,585) * lu(k,722) + lu(k,727) = lu(k,727) - lu(k,586) * lu(k,722) + lu(k,728) = lu(k,728) - lu(k,587) * lu(k,722) + lu(k,729) = lu(k,729) - lu(k,588) * lu(k,722) + lu(k,730) = lu(k,730) - lu(k,589) * lu(k,722) + lu(k,731) = lu(k,731) - lu(k,590) * lu(k,722) + lu(k,732) = lu(k,732) - lu(k,591) * lu(k,722) + lu(k,733) = lu(k,733) - lu(k,592) * lu(k,722) + lu(k,734) = lu(k,734) - lu(k,593) * lu(k,722) + lu(k,748) = lu(k,748) - lu(k,582) * lu(k,747) + lu(k,749) = lu(k,749) - lu(k,583) * lu(k,747) + lu(k,750) = lu(k,750) - lu(k,584) * lu(k,747) + lu(k,751) = lu(k,751) - lu(k,585) * lu(k,747) + lu(k,752) = lu(k,752) - lu(k,586) * lu(k,747) + lu(k,753) = lu(k,753) - lu(k,587) * lu(k,747) + lu(k,754) = lu(k,754) - lu(k,588) * lu(k,747) + lu(k,755) = lu(k,755) - lu(k,589) * lu(k,747) + lu(k,756) = lu(k,756) - lu(k,590) * lu(k,747) + lu(k,757) = lu(k,757) - lu(k,591) * lu(k,747) + lu(k,758) = lu(k,758) - lu(k,592) * lu(k,747) + lu(k,759) = lu(k,759) - lu(k,593) * lu(k,747) + lu(k,780) = lu(k,780) - lu(k,582) * lu(k,779) + lu(k,781) = lu(k,781) - lu(k,583) * lu(k,779) + lu(k,782) = lu(k,782) - lu(k,584) * lu(k,779) + lu(k,783) = lu(k,783) - lu(k,585) * lu(k,779) + lu(k,784) = lu(k,784) - lu(k,586) * lu(k,779) + lu(k,785) = lu(k,785) - lu(k,587) * lu(k,779) + lu(k,786) = lu(k,786) - lu(k,588) * lu(k,779) + lu(k,787) = lu(k,787) - lu(k,589) * lu(k,779) + lu(k,788) = lu(k,788) - lu(k,590) * lu(k,779) + lu(k,789) = lu(k,789) - lu(k,591) * lu(k,779) + lu(k,790) = lu(k,790) - lu(k,592) * lu(k,779) + lu(k,791) = lu(k,791) - lu(k,593) * lu(k,779) + lu(k,802) = lu(k,802) - lu(k,582) * lu(k,801) + lu(k,803) = lu(k,803) - lu(k,583) * lu(k,801) + lu(k,804) = lu(k,804) - lu(k,584) * lu(k,801) + lu(k,805) = lu(k,805) - lu(k,585) * lu(k,801) + lu(k,806) = lu(k,806) - lu(k,586) * lu(k,801) + lu(k,807) = lu(k,807) - lu(k,587) * lu(k,801) + lu(k,808) = lu(k,808) - lu(k,588) * lu(k,801) + lu(k,809) = lu(k,809) - lu(k,589) * lu(k,801) + lu(k,810) = lu(k,810) - lu(k,590) * lu(k,801) + lu(k,811) = lu(k,811) - lu(k,591) * lu(k,801) + lu(k,812) = lu(k,812) - lu(k,592) * lu(k,801) + lu(k,813) = lu(k,813) - lu(k,593) * lu(k,801) + lu(k,851) = lu(k,851) - lu(k,582) * lu(k,850) + lu(k,852) = lu(k,852) - lu(k,583) * lu(k,850) + lu(k,853) = lu(k,853) - lu(k,584) * lu(k,850) + lu(k,854) = lu(k,854) - lu(k,585) * lu(k,850) + lu(k,855) = lu(k,855) - lu(k,586) * lu(k,850) + lu(k,856) = lu(k,856) - lu(k,587) * lu(k,850) + lu(k,857) = lu(k,857) - lu(k,588) * lu(k,850) + lu(k,858) = lu(k,858) - lu(k,589) * lu(k,850) + lu(k,859) = lu(k,859) - lu(k,590) * lu(k,850) + lu(k,860) = lu(k,860) - lu(k,591) * lu(k,850) + lu(k,861) = lu(k,861) - lu(k,592) * lu(k,850) + lu(k,862) = lu(k,862) - lu(k,593) * lu(k,850) + lu(k,874) = lu(k,874) - lu(k,582) * lu(k,873) + lu(k,875) = lu(k,875) - lu(k,583) * lu(k,873) + lu(k,876) = lu(k,876) - lu(k,584) * lu(k,873) + lu(k,877) = lu(k,877) - lu(k,585) * lu(k,873) + lu(k,878) = lu(k,878) - lu(k,586) * lu(k,873) + lu(k,879) = lu(k,879) - lu(k,587) * lu(k,873) + lu(k,880) = lu(k,880) - lu(k,588) * lu(k,873) + lu(k,881) = lu(k,881) - lu(k,589) * lu(k,873) + lu(k,882) = lu(k,882) - lu(k,590) * lu(k,873) + lu(k,883) = lu(k,883) - lu(k,591) * lu(k,873) + lu(k,884) = lu(k,884) - lu(k,592) * lu(k,873) + lu(k,885) = lu(k,885) - lu(k,593) * lu(k,873) + lu(k,897) = lu(k,897) - lu(k,582) * lu(k,896) + lu(k,898) = lu(k,898) - lu(k,583) * lu(k,896) + lu(k,899) = lu(k,899) - lu(k,584) * lu(k,896) + lu(k,900) = lu(k,900) - lu(k,585) * lu(k,896) + lu(k,901) = lu(k,901) - lu(k,586) * lu(k,896) + lu(k,902) = lu(k,902) - lu(k,587) * lu(k,896) + lu(k,903) = lu(k,903) - lu(k,588) * lu(k,896) + lu(k,904) = lu(k,904) - lu(k,589) * lu(k,896) + lu(k,905) = lu(k,905) - lu(k,590) * lu(k,896) + lu(k,906) = lu(k,906) - lu(k,591) * lu(k,896) + lu(k,907) = lu(k,907) - lu(k,592) * lu(k,896) + lu(k,908) = lu(k,908) - lu(k,593) * lu(k,896) + lu(k,921) = lu(k,921) - lu(k,582) * lu(k,920) + lu(k,922) = lu(k,922) - lu(k,583) * lu(k,920) + lu(k,923) = lu(k,923) - lu(k,584) * lu(k,920) + lu(k,924) = lu(k,924) - lu(k,585) * lu(k,920) + lu(k,925) = lu(k,925) - lu(k,586) * lu(k,920) + lu(k,926) = lu(k,926) - lu(k,587) * lu(k,920) + lu(k,927) = lu(k,927) - lu(k,588) * lu(k,920) + lu(k,928) = lu(k,928) - lu(k,589) * lu(k,920) + lu(k,929) = lu(k,929) - lu(k,590) * lu(k,920) + lu(k,930) = lu(k,930) - lu(k,591) * lu(k,920) + lu(k,931) = lu(k,931) - lu(k,592) * lu(k,920) + lu(k,932) = lu(k,932) - lu(k,593) * lu(k,920) + lu(k,948) = lu(k,948) - lu(k,582) * lu(k,947) + lu(k,949) = lu(k,949) - lu(k,583) * lu(k,947) + lu(k,950) = lu(k,950) - lu(k,584) * lu(k,947) + lu(k,951) = lu(k,951) - lu(k,585) * lu(k,947) + lu(k,952) = lu(k,952) - lu(k,586) * lu(k,947) + lu(k,953) = lu(k,953) - lu(k,587) * lu(k,947) + lu(k,954) = lu(k,954) - lu(k,588) * lu(k,947) + lu(k,955) = lu(k,955) - lu(k,589) * lu(k,947) + lu(k,956) = lu(k,956) - lu(k,590) * lu(k,947) + lu(k,957) = lu(k,957) - lu(k,591) * lu(k,947) + lu(k,958) = lu(k,958) - lu(k,592) * lu(k,947) + lu(k,959) = lu(k,959) - lu(k,593) * lu(k,947) + lu(k,610) = 1._r8 / lu(k,610) + lu(k,611) = lu(k,611) * lu(k,610) + lu(k,612) = lu(k,612) * lu(k,610) + lu(k,613) = lu(k,613) * lu(k,610) + lu(k,614) = lu(k,614) * lu(k,610) + lu(k,615) = lu(k,615) * lu(k,610) + lu(k,616) = lu(k,616) * lu(k,610) + lu(k,617) = lu(k,617) * lu(k,610) + lu(k,618) = lu(k,618) * lu(k,610) + lu(k,619) = lu(k,619) * lu(k,610) + lu(k,620) = lu(k,620) * lu(k,610) + lu(k,621) = lu(k,621) * lu(k,610) + lu(k,640) = lu(k,640) - lu(k,611) * lu(k,639) + lu(k,641) = lu(k,641) - lu(k,612) * lu(k,639) + lu(k,642) = lu(k,642) - lu(k,613) * lu(k,639) + lu(k,643) = lu(k,643) - lu(k,614) * lu(k,639) + lu(k,644) = lu(k,644) - lu(k,615) * lu(k,639) + lu(k,645) = lu(k,645) - lu(k,616) * lu(k,639) + lu(k,646) = lu(k,646) - lu(k,617) * lu(k,639) + lu(k,647) = lu(k,647) - lu(k,618) * lu(k,639) + lu(k,648) = lu(k,648) - lu(k,619) * lu(k,639) + lu(k,649) = lu(k,649) - lu(k,620) * lu(k,639) + lu(k,650) = lu(k,650) - lu(k,621) * lu(k,639) + lu(k,682) = lu(k,682) - lu(k,611) * lu(k,681) + lu(k,683) = lu(k,683) - lu(k,612) * lu(k,681) + lu(k,684) = lu(k,684) - lu(k,613) * lu(k,681) + lu(k,685) = lu(k,685) - lu(k,614) * lu(k,681) + lu(k,686) = lu(k,686) - lu(k,615) * lu(k,681) + lu(k,687) = lu(k,687) - lu(k,616) * lu(k,681) + lu(k,688) = lu(k,688) - lu(k,617) * lu(k,681) + lu(k,689) = lu(k,689) - lu(k,618) * lu(k,681) + lu(k,690) = lu(k,690) - lu(k,619) * lu(k,681) + lu(k,691) = lu(k,691) - lu(k,620) * lu(k,681) + lu(k,692) = lu(k,692) - lu(k,621) * lu(k,681) + lu(k,724) = lu(k,724) - lu(k,611) * lu(k,723) + lu(k,725) = lu(k,725) - lu(k,612) * lu(k,723) + lu(k,726) = lu(k,726) - lu(k,613) * lu(k,723) + lu(k,727) = lu(k,727) - lu(k,614) * lu(k,723) + lu(k,728) = lu(k,728) - lu(k,615) * lu(k,723) + lu(k,729) = lu(k,729) - lu(k,616) * lu(k,723) + lu(k,730) = lu(k,730) - lu(k,617) * lu(k,723) + lu(k,731) = lu(k,731) - lu(k,618) * lu(k,723) + lu(k,732) = lu(k,732) - lu(k,619) * lu(k,723) + lu(k,733) = lu(k,733) - lu(k,620) * lu(k,723) + lu(k,734) = lu(k,734) - lu(k,621) * lu(k,723) + lu(k,749) = lu(k,749) - lu(k,611) * lu(k,748) + lu(k,750) = lu(k,750) - lu(k,612) * lu(k,748) + lu(k,751) = lu(k,751) - lu(k,613) * lu(k,748) + lu(k,752) = lu(k,752) - lu(k,614) * lu(k,748) + lu(k,753) = lu(k,753) - lu(k,615) * lu(k,748) + lu(k,754) = lu(k,754) - lu(k,616) * lu(k,748) + lu(k,755) = lu(k,755) - lu(k,617) * lu(k,748) + lu(k,756) = lu(k,756) - lu(k,618) * lu(k,748) + lu(k,757) = lu(k,757) - lu(k,619) * lu(k,748) + lu(k,758) = lu(k,758) - lu(k,620) * lu(k,748) + lu(k,759) = lu(k,759) - lu(k,621) * lu(k,748) + lu(k,781) = lu(k,781) - lu(k,611) * lu(k,780) + lu(k,782) = lu(k,782) - lu(k,612) * lu(k,780) + lu(k,783) = lu(k,783) - lu(k,613) * lu(k,780) + lu(k,784) = lu(k,784) - lu(k,614) * lu(k,780) + lu(k,785) = lu(k,785) - lu(k,615) * lu(k,780) + lu(k,786) = lu(k,786) - lu(k,616) * lu(k,780) + lu(k,787) = lu(k,787) - lu(k,617) * lu(k,780) + lu(k,788) = lu(k,788) - lu(k,618) * lu(k,780) + lu(k,789) = lu(k,789) - lu(k,619) * lu(k,780) + lu(k,790) = lu(k,790) - lu(k,620) * lu(k,780) + lu(k,791) = lu(k,791) - lu(k,621) * lu(k,780) + lu(k,803) = lu(k,803) - lu(k,611) * lu(k,802) + lu(k,804) = lu(k,804) - lu(k,612) * lu(k,802) + lu(k,805) = lu(k,805) - lu(k,613) * lu(k,802) + lu(k,806) = lu(k,806) - lu(k,614) * lu(k,802) + lu(k,807) = lu(k,807) - lu(k,615) * lu(k,802) + lu(k,808) = lu(k,808) - lu(k,616) * lu(k,802) + lu(k,809) = lu(k,809) - lu(k,617) * lu(k,802) + lu(k,810) = lu(k,810) - lu(k,618) * lu(k,802) + lu(k,811) = lu(k,811) - lu(k,619) * lu(k,802) + lu(k,812) = lu(k,812) - lu(k,620) * lu(k,802) + lu(k,813) = lu(k,813) - lu(k,621) * lu(k,802) + lu(k,852) = lu(k,852) - lu(k,611) * lu(k,851) + lu(k,853) = lu(k,853) - lu(k,612) * lu(k,851) + lu(k,854) = lu(k,854) - lu(k,613) * lu(k,851) + lu(k,855) = lu(k,855) - lu(k,614) * lu(k,851) + lu(k,856) = lu(k,856) - lu(k,615) * lu(k,851) + lu(k,857) = lu(k,857) - lu(k,616) * lu(k,851) + lu(k,858) = lu(k,858) - lu(k,617) * lu(k,851) + lu(k,859) = lu(k,859) - lu(k,618) * lu(k,851) + lu(k,860) = lu(k,860) - lu(k,619) * lu(k,851) + lu(k,861) = lu(k,861) - lu(k,620) * lu(k,851) + lu(k,862) = lu(k,862) - lu(k,621) * lu(k,851) + lu(k,875) = lu(k,875) - lu(k,611) * lu(k,874) + lu(k,876) = lu(k,876) - lu(k,612) * lu(k,874) + lu(k,877) = lu(k,877) - lu(k,613) * lu(k,874) + lu(k,878) = lu(k,878) - lu(k,614) * lu(k,874) + lu(k,879) = lu(k,879) - lu(k,615) * lu(k,874) + lu(k,880) = lu(k,880) - lu(k,616) * lu(k,874) + lu(k,881) = lu(k,881) - lu(k,617) * lu(k,874) + lu(k,882) = lu(k,882) - lu(k,618) * lu(k,874) + lu(k,883) = lu(k,883) - lu(k,619) * lu(k,874) + lu(k,884) = lu(k,884) - lu(k,620) * lu(k,874) + lu(k,885) = lu(k,885) - lu(k,621) * lu(k,874) + lu(k,898) = lu(k,898) - lu(k,611) * lu(k,897) + lu(k,899) = lu(k,899) - lu(k,612) * lu(k,897) + lu(k,900) = lu(k,900) - lu(k,613) * lu(k,897) + lu(k,901) = lu(k,901) - lu(k,614) * lu(k,897) + lu(k,902) = lu(k,902) - lu(k,615) * lu(k,897) + lu(k,903) = lu(k,903) - lu(k,616) * lu(k,897) + lu(k,904) = lu(k,904) - lu(k,617) * lu(k,897) + lu(k,905) = lu(k,905) - lu(k,618) * lu(k,897) + lu(k,906) = lu(k,906) - lu(k,619) * lu(k,897) + lu(k,907) = lu(k,907) - lu(k,620) * lu(k,897) + lu(k,908) = lu(k,908) - lu(k,621) * lu(k,897) + lu(k,922) = lu(k,922) - lu(k,611) * lu(k,921) + lu(k,923) = lu(k,923) - lu(k,612) * lu(k,921) + lu(k,924) = lu(k,924) - lu(k,613) * lu(k,921) + lu(k,925) = lu(k,925) - lu(k,614) * lu(k,921) + lu(k,926) = lu(k,926) - lu(k,615) * lu(k,921) + lu(k,927) = lu(k,927) - lu(k,616) * lu(k,921) + lu(k,928) = lu(k,928) - lu(k,617) * lu(k,921) + lu(k,929) = lu(k,929) - lu(k,618) * lu(k,921) + lu(k,930) = lu(k,930) - lu(k,619) * lu(k,921) + lu(k,931) = lu(k,931) - lu(k,620) * lu(k,921) + lu(k,932) = lu(k,932) - lu(k,621) * lu(k,921) + lu(k,949) = lu(k,949) - lu(k,611) * lu(k,948) + lu(k,950) = lu(k,950) - lu(k,612) * lu(k,948) + lu(k,951) = lu(k,951) - lu(k,613) * lu(k,948) + lu(k,952) = lu(k,952) - lu(k,614) * lu(k,948) + lu(k,953) = lu(k,953) - lu(k,615) * lu(k,948) + lu(k,954) = lu(k,954) - lu(k,616) * lu(k,948) + lu(k,955) = lu(k,955) - lu(k,617) * lu(k,948) + lu(k,956) = lu(k,956) - lu(k,618) * lu(k,948) + lu(k,957) = lu(k,957) - lu(k,619) * lu(k,948) + lu(k,958) = lu(k,958) - lu(k,620) * lu(k,948) + lu(k,959) = lu(k,959) - lu(k,621) * lu(k,948) + 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,640) = 1._r8 / lu(k,640) + lu(k,641) = lu(k,641) * lu(k,640) + lu(k,642) = lu(k,642) * lu(k,640) + lu(k,643) = lu(k,643) * lu(k,640) + lu(k,644) = lu(k,644) * lu(k,640) + lu(k,645) = lu(k,645) * lu(k,640) + lu(k,646) = lu(k,646) * lu(k,640) + lu(k,647) = lu(k,647) * lu(k,640) + lu(k,648) = lu(k,648) * lu(k,640) + lu(k,649) = lu(k,649) * lu(k,640) + lu(k,650) = lu(k,650) * lu(k,640) + lu(k,683) = lu(k,683) - lu(k,641) * lu(k,682) + lu(k,684) = lu(k,684) - lu(k,642) * lu(k,682) + lu(k,685) = lu(k,685) - lu(k,643) * lu(k,682) + lu(k,686) = lu(k,686) - lu(k,644) * lu(k,682) + lu(k,687) = lu(k,687) - lu(k,645) * lu(k,682) + lu(k,688) = lu(k,688) - lu(k,646) * lu(k,682) + lu(k,689) = lu(k,689) - lu(k,647) * lu(k,682) + lu(k,690) = lu(k,690) - lu(k,648) * lu(k,682) + lu(k,691) = lu(k,691) - lu(k,649) * lu(k,682) + lu(k,692) = lu(k,692) - lu(k,650) * lu(k,682) + lu(k,725) = lu(k,725) - lu(k,641) * lu(k,724) + lu(k,726) = lu(k,726) - lu(k,642) * lu(k,724) + lu(k,727) = lu(k,727) - lu(k,643) * lu(k,724) + lu(k,728) = lu(k,728) - lu(k,644) * lu(k,724) + lu(k,729) = lu(k,729) - lu(k,645) * lu(k,724) + lu(k,730) = lu(k,730) - lu(k,646) * lu(k,724) + lu(k,731) = lu(k,731) - lu(k,647) * lu(k,724) + lu(k,732) = lu(k,732) - lu(k,648) * lu(k,724) + lu(k,733) = lu(k,733) - lu(k,649) * lu(k,724) + lu(k,734) = lu(k,734) - lu(k,650) * lu(k,724) + lu(k,750) = lu(k,750) - lu(k,641) * lu(k,749) + lu(k,751) = lu(k,751) - lu(k,642) * lu(k,749) + lu(k,752) = lu(k,752) - lu(k,643) * lu(k,749) + lu(k,753) = lu(k,753) - lu(k,644) * lu(k,749) + lu(k,754) = lu(k,754) - lu(k,645) * lu(k,749) + lu(k,755) = lu(k,755) - lu(k,646) * lu(k,749) + lu(k,756) = lu(k,756) - lu(k,647) * lu(k,749) + lu(k,757) = lu(k,757) - lu(k,648) * lu(k,749) + lu(k,758) = lu(k,758) - lu(k,649) * lu(k,749) + lu(k,759) = lu(k,759) - lu(k,650) * lu(k,749) + lu(k,782) = lu(k,782) - lu(k,641) * lu(k,781) + lu(k,783) = lu(k,783) - lu(k,642) * lu(k,781) + lu(k,784) = lu(k,784) - lu(k,643) * lu(k,781) + lu(k,785) = lu(k,785) - lu(k,644) * lu(k,781) + lu(k,786) = lu(k,786) - lu(k,645) * lu(k,781) + lu(k,787) = lu(k,787) - lu(k,646) * lu(k,781) + lu(k,788) = lu(k,788) - lu(k,647) * lu(k,781) + lu(k,789) = lu(k,789) - lu(k,648) * lu(k,781) + lu(k,790) = lu(k,790) - lu(k,649) * lu(k,781) + lu(k,791) = lu(k,791) - lu(k,650) * lu(k,781) + lu(k,804) = lu(k,804) - lu(k,641) * lu(k,803) + lu(k,805) = lu(k,805) - lu(k,642) * lu(k,803) + lu(k,806) = lu(k,806) - lu(k,643) * lu(k,803) + lu(k,807) = lu(k,807) - lu(k,644) * lu(k,803) + lu(k,808) = lu(k,808) - lu(k,645) * lu(k,803) + lu(k,809) = lu(k,809) - lu(k,646) * lu(k,803) + lu(k,810) = lu(k,810) - lu(k,647) * lu(k,803) + lu(k,811) = lu(k,811) - lu(k,648) * lu(k,803) + lu(k,812) = lu(k,812) - lu(k,649) * lu(k,803) + lu(k,813) = lu(k,813) - lu(k,650) * lu(k,803) + lu(k,853) = lu(k,853) - lu(k,641) * lu(k,852) + lu(k,854) = lu(k,854) - lu(k,642) * lu(k,852) + lu(k,855) = lu(k,855) - lu(k,643) * lu(k,852) + lu(k,856) = lu(k,856) - lu(k,644) * lu(k,852) + lu(k,857) = lu(k,857) - lu(k,645) * lu(k,852) + lu(k,858) = lu(k,858) - lu(k,646) * lu(k,852) + lu(k,859) = lu(k,859) - lu(k,647) * lu(k,852) + lu(k,860) = lu(k,860) - lu(k,648) * lu(k,852) + lu(k,861) = lu(k,861) - lu(k,649) * lu(k,852) + lu(k,862) = lu(k,862) - lu(k,650) * lu(k,852) + lu(k,876) = lu(k,876) - lu(k,641) * lu(k,875) + lu(k,877) = lu(k,877) - lu(k,642) * lu(k,875) + lu(k,878) = lu(k,878) - lu(k,643) * lu(k,875) + lu(k,879) = lu(k,879) - lu(k,644) * lu(k,875) + lu(k,880) = lu(k,880) - lu(k,645) * lu(k,875) + lu(k,881) = lu(k,881) - lu(k,646) * lu(k,875) + lu(k,882) = lu(k,882) - lu(k,647) * lu(k,875) + lu(k,883) = lu(k,883) - lu(k,648) * lu(k,875) + lu(k,884) = lu(k,884) - lu(k,649) * lu(k,875) + lu(k,885) = lu(k,885) - lu(k,650) * lu(k,875) + lu(k,899) = lu(k,899) - lu(k,641) * lu(k,898) + lu(k,900) = lu(k,900) - lu(k,642) * lu(k,898) + lu(k,901) = lu(k,901) - lu(k,643) * lu(k,898) + lu(k,902) = lu(k,902) - lu(k,644) * lu(k,898) + lu(k,903) = lu(k,903) - lu(k,645) * lu(k,898) + lu(k,904) = lu(k,904) - lu(k,646) * lu(k,898) + lu(k,905) = lu(k,905) - lu(k,647) * lu(k,898) + lu(k,906) = lu(k,906) - lu(k,648) * lu(k,898) + lu(k,907) = lu(k,907) - lu(k,649) * lu(k,898) + lu(k,908) = lu(k,908) - lu(k,650) * lu(k,898) + lu(k,923) = lu(k,923) - lu(k,641) * lu(k,922) + lu(k,924) = lu(k,924) - lu(k,642) * lu(k,922) + lu(k,925) = lu(k,925) - lu(k,643) * lu(k,922) + lu(k,926) = lu(k,926) - lu(k,644) * lu(k,922) + lu(k,927) = lu(k,927) - lu(k,645) * lu(k,922) + lu(k,928) = lu(k,928) - lu(k,646) * lu(k,922) + lu(k,929) = lu(k,929) - lu(k,647) * lu(k,922) + lu(k,930) = lu(k,930) - lu(k,648) * lu(k,922) + lu(k,931) = lu(k,931) - lu(k,649) * lu(k,922) + lu(k,932) = lu(k,932) - lu(k,650) * lu(k,922) + lu(k,950) = lu(k,950) - lu(k,641) * lu(k,949) + lu(k,951) = lu(k,951) - lu(k,642) * lu(k,949) + lu(k,952) = lu(k,952) - lu(k,643) * lu(k,949) + lu(k,953) = lu(k,953) - lu(k,644) * lu(k,949) + lu(k,954) = lu(k,954) - lu(k,645) * lu(k,949) + lu(k,955) = lu(k,955) - lu(k,646) * lu(k,949) + lu(k,956) = lu(k,956) - lu(k,647) * lu(k,949) + lu(k,957) = lu(k,957) - lu(k,648) * lu(k,949) + lu(k,958) = lu(k,958) - lu(k,649) * lu(k,949) + lu(k,959) = lu(k,959) - lu(k,650) * lu(k,949) + lu(k,683) = 1._r8 / lu(k,683) + lu(k,684) = lu(k,684) * lu(k,683) + lu(k,685) = lu(k,685) * lu(k,683) + lu(k,686) = lu(k,686) * lu(k,683) + lu(k,687) = lu(k,687) * lu(k,683) + lu(k,688) = lu(k,688) * lu(k,683) + lu(k,689) = lu(k,689) * lu(k,683) + lu(k,690) = lu(k,690) * lu(k,683) + lu(k,691) = lu(k,691) * lu(k,683) + lu(k,692) = lu(k,692) * lu(k,683) + lu(k,726) = lu(k,726) - lu(k,684) * lu(k,725) + lu(k,727) = lu(k,727) - lu(k,685) * lu(k,725) + lu(k,728) = lu(k,728) - lu(k,686) * lu(k,725) + lu(k,729) = lu(k,729) - lu(k,687) * lu(k,725) + lu(k,730) = lu(k,730) - lu(k,688) * lu(k,725) + lu(k,731) = lu(k,731) - lu(k,689) * lu(k,725) + lu(k,732) = lu(k,732) - lu(k,690) * lu(k,725) + lu(k,733) = lu(k,733) - lu(k,691) * lu(k,725) + lu(k,734) = lu(k,734) - lu(k,692) * lu(k,725) + lu(k,751) = lu(k,751) - lu(k,684) * lu(k,750) + lu(k,752) = lu(k,752) - lu(k,685) * lu(k,750) + lu(k,753) = lu(k,753) - lu(k,686) * lu(k,750) + lu(k,754) = lu(k,754) - lu(k,687) * lu(k,750) + lu(k,755) = lu(k,755) - lu(k,688) * lu(k,750) + lu(k,756) = lu(k,756) - lu(k,689) * lu(k,750) + lu(k,757) = lu(k,757) - lu(k,690) * lu(k,750) + lu(k,758) = lu(k,758) - lu(k,691) * lu(k,750) + lu(k,759) = lu(k,759) - lu(k,692) * lu(k,750) + lu(k,783) = lu(k,783) - lu(k,684) * lu(k,782) + lu(k,784) = lu(k,784) - lu(k,685) * lu(k,782) + lu(k,785) = lu(k,785) - lu(k,686) * lu(k,782) + lu(k,786) = lu(k,786) - lu(k,687) * lu(k,782) + lu(k,787) = lu(k,787) - lu(k,688) * lu(k,782) + lu(k,788) = lu(k,788) - lu(k,689) * lu(k,782) + lu(k,789) = lu(k,789) - lu(k,690) * lu(k,782) + lu(k,790) = lu(k,790) - lu(k,691) * lu(k,782) + lu(k,791) = lu(k,791) - lu(k,692) * lu(k,782) + lu(k,805) = lu(k,805) - lu(k,684) * lu(k,804) + lu(k,806) = lu(k,806) - lu(k,685) * lu(k,804) + lu(k,807) = lu(k,807) - lu(k,686) * lu(k,804) + lu(k,808) = lu(k,808) - lu(k,687) * lu(k,804) + lu(k,809) = lu(k,809) - lu(k,688) * lu(k,804) + lu(k,810) = lu(k,810) - lu(k,689) * lu(k,804) + lu(k,811) = lu(k,811) - lu(k,690) * lu(k,804) + lu(k,812) = lu(k,812) - lu(k,691) * lu(k,804) + lu(k,813) = lu(k,813) - lu(k,692) * lu(k,804) + lu(k,854) = lu(k,854) - lu(k,684) * lu(k,853) + lu(k,855) = lu(k,855) - lu(k,685) * lu(k,853) + lu(k,856) = lu(k,856) - lu(k,686) * lu(k,853) + lu(k,857) = lu(k,857) - lu(k,687) * lu(k,853) + lu(k,858) = lu(k,858) - lu(k,688) * lu(k,853) + lu(k,859) = lu(k,859) - lu(k,689) * lu(k,853) + lu(k,860) = lu(k,860) - lu(k,690) * lu(k,853) + lu(k,861) = lu(k,861) - lu(k,691) * lu(k,853) + lu(k,862) = lu(k,862) - lu(k,692) * lu(k,853) + lu(k,877) = lu(k,877) - lu(k,684) * lu(k,876) + lu(k,878) = lu(k,878) - lu(k,685) * lu(k,876) + lu(k,879) = lu(k,879) - lu(k,686) * lu(k,876) + lu(k,880) = lu(k,880) - lu(k,687) * lu(k,876) + lu(k,881) = lu(k,881) - lu(k,688) * lu(k,876) + lu(k,882) = lu(k,882) - lu(k,689) * lu(k,876) + lu(k,883) = lu(k,883) - lu(k,690) * lu(k,876) + lu(k,884) = lu(k,884) - lu(k,691) * lu(k,876) + lu(k,885) = lu(k,885) - lu(k,692) * lu(k,876) + lu(k,900) = lu(k,900) - lu(k,684) * lu(k,899) + lu(k,901) = lu(k,901) - lu(k,685) * lu(k,899) + lu(k,902) = lu(k,902) - lu(k,686) * lu(k,899) + lu(k,903) = lu(k,903) - lu(k,687) * lu(k,899) + lu(k,904) = lu(k,904) - lu(k,688) * lu(k,899) + lu(k,905) = lu(k,905) - lu(k,689) * lu(k,899) + lu(k,906) = lu(k,906) - lu(k,690) * lu(k,899) + lu(k,907) = lu(k,907) - lu(k,691) * lu(k,899) + lu(k,908) = lu(k,908) - lu(k,692) * lu(k,899) + lu(k,924) = lu(k,924) - lu(k,684) * lu(k,923) + lu(k,925) = lu(k,925) - lu(k,685) * lu(k,923) + lu(k,926) = lu(k,926) - lu(k,686) * lu(k,923) + lu(k,927) = lu(k,927) - lu(k,687) * lu(k,923) + lu(k,928) = lu(k,928) - lu(k,688) * lu(k,923) + lu(k,929) = lu(k,929) - lu(k,689) * lu(k,923) + lu(k,930) = lu(k,930) - lu(k,690) * lu(k,923) + lu(k,931) = lu(k,931) - lu(k,691) * lu(k,923) + lu(k,932) = lu(k,932) - lu(k,692) * lu(k,923) + lu(k,951) = lu(k,951) - lu(k,684) * lu(k,950) + lu(k,952) = lu(k,952) - lu(k,685) * lu(k,950) + lu(k,953) = lu(k,953) - lu(k,686) * lu(k,950) + lu(k,954) = lu(k,954) - lu(k,687) * lu(k,950) + lu(k,955) = lu(k,955) - lu(k,688) * lu(k,950) + lu(k,956) = lu(k,956) - lu(k,689) * lu(k,950) + lu(k,957) = lu(k,957) - lu(k,690) * lu(k,950) + lu(k,958) = lu(k,958) - lu(k,691) * lu(k,950) + lu(k,959) = lu(k,959) - lu(k,692) * lu(k,950) + lu(k,726) = 1._r8 / lu(k,726) + lu(k,727) = lu(k,727) * lu(k,726) + lu(k,728) = lu(k,728) * lu(k,726) + lu(k,729) = lu(k,729) * lu(k,726) + lu(k,730) = lu(k,730) * lu(k,726) + lu(k,731) = lu(k,731) * lu(k,726) + lu(k,732) = lu(k,732) * lu(k,726) + lu(k,733) = lu(k,733) * lu(k,726) + lu(k,734) = lu(k,734) * lu(k,726) + lu(k,752) = lu(k,752) - lu(k,727) * lu(k,751) + lu(k,753) = lu(k,753) - lu(k,728) * lu(k,751) + lu(k,754) = lu(k,754) - lu(k,729) * lu(k,751) + lu(k,755) = lu(k,755) - lu(k,730) * lu(k,751) + lu(k,756) = lu(k,756) - lu(k,731) * lu(k,751) + lu(k,757) = lu(k,757) - lu(k,732) * lu(k,751) + lu(k,758) = lu(k,758) - lu(k,733) * lu(k,751) + lu(k,759) = lu(k,759) - lu(k,734) * lu(k,751) + lu(k,784) = lu(k,784) - lu(k,727) * lu(k,783) + lu(k,785) = lu(k,785) - lu(k,728) * lu(k,783) + lu(k,786) = lu(k,786) - lu(k,729) * lu(k,783) + lu(k,787) = lu(k,787) - lu(k,730) * lu(k,783) + lu(k,788) = lu(k,788) - lu(k,731) * lu(k,783) + lu(k,789) = lu(k,789) - lu(k,732) * lu(k,783) + lu(k,790) = lu(k,790) - lu(k,733) * lu(k,783) + lu(k,791) = lu(k,791) - lu(k,734) * lu(k,783) + lu(k,806) = lu(k,806) - lu(k,727) * lu(k,805) + lu(k,807) = lu(k,807) - lu(k,728) * lu(k,805) + lu(k,808) = lu(k,808) - lu(k,729) * lu(k,805) + lu(k,809) = lu(k,809) - lu(k,730) * lu(k,805) + lu(k,810) = lu(k,810) - lu(k,731) * lu(k,805) + lu(k,811) = lu(k,811) - lu(k,732) * lu(k,805) + lu(k,812) = lu(k,812) - lu(k,733) * lu(k,805) + lu(k,813) = lu(k,813) - lu(k,734) * lu(k,805) + lu(k,855) = lu(k,855) - lu(k,727) * lu(k,854) + lu(k,856) = lu(k,856) - lu(k,728) * lu(k,854) + lu(k,857) = lu(k,857) - lu(k,729) * lu(k,854) + lu(k,858) = lu(k,858) - lu(k,730) * lu(k,854) + lu(k,859) = lu(k,859) - lu(k,731) * lu(k,854) + lu(k,860) = lu(k,860) - lu(k,732) * lu(k,854) + lu(k,861) = lu(k,861) - lu(k,733) * lu(k,854) + lu(k,862) = lu(k,862) - lu(k,734) * lu(k,854) + lu(k,878) = lu(k,878) - lu(k,727) * lu(k,877) + lu(k,879) = lu(k,879) - lu(k,728) * lu(k,877) + lu(k,880) = lu(k,880) - lu(k,729) * lu(k,877) + lu(k,881) = lu(k,881) - lu(k,730) * lu(k,877) + lu(k,882) = lu(k,882) - lu(k,731) * lu(k,877) + lu(k,883) = lu(k,883) - lu(k,732) * lu(k,877) + lu(k,884) = lu(k,884) - lu(k,733) * lu(k,877) + lu(k,885) = lu(k,885) - lu(k,734) * lu(k,877) + lu(k,901) = lu(k,901) - lu(k,727) * lu(k,900) + lu(k,902) = lu(k,902) - lu(k,728) * lu(k,900) + lu(k,903) = lu(k,903) - lu(k,729) * lu(k,900) + lu(k,904) = lu(k,904) - lu(k,730) * lu(k,900) + lu(k,905) = lu(k,905) - lu(k,731) * lu(k,900) + lu(k,906) = lu(k,906) - lu(k,732) * lu(k,900) + lu(k,907) = lu(k,907) - lu(k,733) * lu(k,900) + lu(k,908) = lu(k,908) - lu(k,734) * lu(k,900) + lu(k,925) = lu(k,925) - lu(k,727) * lu(k,924) + lu(k,926) = lu(k,926) - lu(k,728) * lu(k,924) + lu(k,927) = lu(k,927) - lu(k,729) * lu(k,924) + lu(k,928) = lu(k,928) - lu(k,730) * lu(k,924) + lu(k,929) = lu(k,929) - lu(k,731) * lu(k,924) + lu(k,930) = lu(k,930) - lu(k,732) * lu(k,924) + lu(k,931) = lu(k,931) - lu(k,733) * lu(k,924) + lu(k,932) = lu(k,932) - lu(k,734) * lu(k,924) + lu(k,952) = lu(k,952) - lu(k,727) * lu(k,951) + lu(k,953) = lu(k,953) - lu(k,728) * lu(k,951) + lu(k,954) = lu(k,954) - lu(k,729) * lu(k,951) + lu(k,955) = lu(k,955) - lu(k,730) * lu(k,951) + lu(k,956) = lu(k,956) - lu(k,731) * lu(k,951) + lu(k,957) = lu(k,957) - lu(k,732) * lu(k,951) + lu(k,958) = lu(k,958) - lu(k,733) * lu(k,951) + lu(k,959) = lu(k,959) - lu(k,734) * lu(k,951) + lu(k,752) = 1._r8 / lu(k,752) + lu(k,753) = lu(k,753) * lu(k,752) + lu(k,754) = lu(k,754) * lu(k,752) + lu(k,755) = lu(k,755) * lu(k,752) + lu(k,756) = lu(k,756) * lu(k,752) + lu(k,757) = lu(k,757) * lu(k,752) + lu(k,758) = lu(k,758) * lu(k,752) + lu(k,759) = lu(k,759) * lu(k,752) + lu(k,785) = lu(k,785) - lu(k,753) * lu(k,784) + lu(k,786) = lu(k,786) - lu(k,754) * lu(k,784) + lu(k,787) = lu(k,787) - lu(k,755) * lu(k,784) + lu(k,788) = lu(k,788) - lu(k,756) * lu(k,784) + lu(k,789) = lu(k,789) - lu(k,757) * lu(k,784) + lu(k,790) = lu(k,790) - lu(k,758) * lu(k,784) + lu(k,791) = lu(k,791) - lu(k,759) * lu(k,784) + lu(k,807) = lu(k,807) - lu(k,753) * lu(k,806) + lu(k,808) = lu(k,808) - lu(k,754) * lu(k,806) + lu(k,809) = lu(k,809) - lu(k,755) * lu(k,806) + lu(k,810) = lu(k,810) - lu(k,756) * lu(k,806) + lu(k,811) = lu(k,811) - lu(k,757) * lu(k,806) + lu(k,812) = lu(k,812) - lu(k,758) * lu(k,806) + lu(k,813) = lu(k,813) - lu(k,759) * lu(k,806) + lu(k,856) = lu(k,856) - lu(k,753) * lu(k,855) + lu(k,857) = lu(k,857) - lu(k,754) * lu(k,855) + lu(k,858) = lu(k,858) - lu(k,755) * lu(k,855) + lu(k,859) = lu(k,859) - lu(k,756) * lu(k,855) + lu(k,860) = lu(k,860) - lu(k,757) * lu(k,855) + lu(k,861) = lu(k,861) - lu(k,758) * lu(k,855) + lu(k,862) = lu(k,862) - lu(k,759) * lu(k,855) + lu(k,879) = lu(k,879) - lu(k,753) * lu(k,878) + lu(k,880) = lu(k,880) - lu(k,754) * lu(k,878) + lu(k,881) = lu(k,881) - lu(k,755) * lu(k,878) + lu(k,882) = lu(k,882) - lu(k,756) * lu(k,878) + lu(k,883) = lu(k,883) - lu(k,757) * lu(k,878) + lu(k,884) = lu(k,884) - lu(k,758) * lu(k,878) + lu(k,885) = lu(k,885) - lu(k,759) * lu(k,878) + lu(k,902) = lu(k,902) - lu(k,753) * lu(k,901) + lu(k,903) = lu(k,903) - lu(k,754) * lu(k,901) + lu(k,904) = lu(k,904) - lu(k,755) * lu(k,901) + lu(k,905) = lu(k,905) - lu(k,756) * lu(k,901) + lu(k,906) = lu(k,906) - lu(k,757) * lu(k,901) + lu(k,907) = lu(k,907) - lu(k,758) * lu(k,901) + lu(k,908) = lu(k,908) - lu(k,759) * lu(k,901) + lu(k,926) = lu(k,926) - lu(k,753) * lu(k,925) + lu(k,927) = lu(k,927) - lu(k,754) * lu(k,925) + lu(k,928) = lu(k,928) - lu(k,755) * lu(k,925) + lu(k,929) = lu(k,929) - lu(k,756) * lu(k,925) + lu(k,930) = lu(k,930) - lu(k,757) * lu(k,925) + lu(k,931) = lu(k,931) - lu(k,758) * lu(k,925) + lu(k,932) = lu(k,932) - lu(k,759) * lu(k,925) + lu(k,953) = lu(k,953) - lu(k,753) * lu(k,952) + lu(k,954) = lu(k,954) - lu(k,754) * lu(k,952) + lu(k,955) = lu(k,955) - lu(k,755) * lu(k,952) + lu(k,956) = lu(k,956) - lu(k,756) * lu(k,952) + lu(k,957) = lu(k,957) - lu(k,757) * lu(k,952) + lu(k,958) = lu(k,958) - lu(k,758) * lu(k,952) + lu(k,959) = lu(k,959) - lu(k,759) * lu(k,952) + lu(k,785) = 1._r8 / lu(k,785) + lu(k,786) = lu(k,786) * lu(k,785) + lu(k,787) = lu(k,787) * lu(k,785) + lu(k,788) = lu(k,788) * lu(k,785) + lu(k,789) = lu(k,789) * lu(k,785) + lu(k,790) = lu(k,790) * lu(k,785) + lu(k,791) = lu(k,791) * lu(k,785) + lu(k,808) = lu(k,808) - lu(k,786) * lu(k,807) + lu(k,809) = lu(k,809) - lu(k,787) * lu(k,807) + lu(k,810) = lu(k,810) - lu(k,788) * lu(k,807) + lu(k,811) = lu(k,811) - lu(k,789) * lu(k,807) + lu(k,812) = lu(k,812) - lu(k,790) * lu(k,807) + lu(k,813) = lu(k,813) - lu(k,791) * lu(k,807) + lu(k,857) = lu(k,857) - lu(k,786) * lu(k,856) + lu(k,858) = lu(k,858) - lu(k,787) * lu(k,856) + lu(k,859) = lu(k,859) - lu(k,788) * lu(k,856) + lu(k,860) = lu(k,860) - lu(k,789) * lu(k,856) + lu(k,861) = lu(k,861) - lu(k,790) * lu(k,856) + lu(k,862) = lu(k,862) - lu(k,791) * lu(k,856) + lu(k,880) = lu(k,880) - lu(k,786) * lu(k,879) + lu(k,881) = lu(k,881) - lu(k,787) * lu(k,879) + lu(k,882) = lu(k,882) - lu(k,788) * lu(k,879) + lu(k,883) = lu(k,883) - lu(k,789) * lu(k,879) + lu(k,884) = lu(k,884) - lu(k,790) * lu(k,879) + lu(k,885) = lu(k,885) - lu(k,791) * lu(k,879) + lu(k,903) = lu(k,903) - lu(k,786) * lu(k,902) + lu(k,904) = lu(k,904) - lu(k,787) * lu(k,902) + lu(k,905) = lu(k,905) - lu(k,788) * lu(k,902) + lu(k,906) = lu(k,906) - lu(k,789) * lu(k,902) + lu(k,907) = lu(k,907) - lu(k,790) * lu(k,902) + lu(k,908) = lu(k,908) - lu(k,791) * lu(k,902) + lu(k,927) = lu(k,927) - lu(k,786) * lu(k,926) + lu(k,928) = lu(k,928) - lu(k,787) * lu(k,926) + lu(k,929) = lu(k,929) - lu(k,788) * lu(k,926) + lu(k,930) = lu(k,930) - lu(k,789) * lu(k,926) + lu(k,931) = lu(k,931) - lu(k,790) * lu(k,926) + lu(k,932) = lu(k,932) - lu(k,791) * lu(k,926) + lu(k,954) = lu(k,954) - lu(k,786) * lu(k,953) + lu(k,955) = lu(k,955) - lu(k,787) * lu(k,953) + lu(k,956) = lu(k,956) - lu(k,788) * lu(k,953) + lu(k,957) = lu(k,957) - lu(k,789) * lu(k,953) + lu(k,958) = lu(k,958) - lu(k,790) * lu(k,953) + lu(k,959) = lu(k,959) - lu(k,791) * lu(k,953) + lu(k,808) = 1._r8 / lu(k,808) + lu(k,809) = lu(k,809) * lu(k,808) + lu(k,810) = lu(k,810) * lu(k,808) + lu(k,811) = lu(k,811) * lu(k,808) + lu(k,812) = lu(k,812) * lu(k,808) + lu(k,813) = lu(k,813) * lu(k,808) + lu(k,858) = lu(k,858) - lu(k,809) * lu(k,857) + lu(k,859) = lu(k,859) - lu(k,810) * lu(k,857) + lu(k,860) = lu(k,860) - lu(k,811) * lu(k,857) + lu(k,861) = lu(k,861) - lu(k,812) * lu(k,857) + lu(k,862) = lu(k,862) - lu(k,813) * lu(k,857) + lu(k,881) = lu(k,881) - lu(k,809) * lu(k,880) + lu(k,882) = lu(k,882) - lu(k,810) * lu(k,880) + lu(k,883) = lu(k,883) - lu(k,811) * lu(k,880) + lu(k,884) = lu(k,884) - lu(k,812) * lu(k,880) + lu(k,885) = lu(k,885) - lu(k,813) * lu(k,880) + lu(k,904) = lu(k,904) - lu(k,809) * lu(k,903) + lu(k,905) = lu(k,905) - lu(k,810) * lu(k,903) + lu(k,906) = lu(k,906) - lu(k,811) * lu(k,903) + lu(k,907) = lu(k,907) - lu(k,812) * lu(k,903) + lu(k,908) = lu(k,908) - lu(k,813) * lu(k,903) + lu(k,928) = lu(k,928) - lu(k,809) * lu(k,927) + lu(k,929) = lu(k,929) - lu(k,810) * lu(k,927) + lu(k,930) = lu(k,930) - lu(k,811) * lu(k,927) + lu(k,931) = lu(k,931) - lu(k,812) * lu(k,927) + lu(k,932) = lu(k,932) - lu(k,813) * lu(k,927) + lu(k,955) = lu(k,955) - lu(k,809) * lu(k,954) + lu(k,956) = lu(k,956) - lu(k,810) * lu(k,954) + lu(k,957) = lu(k,957) - lu(k,811) * lu(k,954) + lu(k,958) = lu(k,958) - lu(k,812) * lu(k,954) + lu(k,959) = lu(k,959) - lu(k,813) * lu(k,954) + 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,858) = 1._r8 / lu(k,858) + lu(k,859) = lu(k,859) * lu(k,858) + lu(k,860) = lu(k,860) * lu(k,858) + lu(k,861) = lu(k,861) * lu(k,858) + lu(k,862) = lu(k,862) * lu(k,858) + lu(k,882) = lu(k,882) - lu(k,859) * lu(k,881) + lu(k,883) = lu(k,883) - lu(k,860) * lu(k,881) + lu(k,884) = lu(k,884) - lu(k,861) * lu(k,881) + lu(k,885) = lu(k,885) - lu(k,862) * lu(k,881) + lu(k,905) = lu(k,905) - lu(k,859) * lu(k,904) + lu(k,906) = lu(k,906) - lu(k,860) * lu(k,904) + lu(k,907) = lu(k,907) - lu(k,861) * lu(k,904) + lu(k,908) = lu(k,908) - lu(k,862) * lu(k,904) + lu(k,929) = lu(k,929) - lu(k,859) * lu(k,928) + lu(k,930) = lu(k,930) - lu(k,860) * lu(k,928) + lu(k,931) = lu(k,931) - lu(k,861) * lu(k,928) + lu(k,932) = lu(k,932) - lu(k,862) * lu(k,928) + lu(k,956) = lu(k,956) - lu(k,859) * lu(k,955) + lu(k,957) = lu(k,957) - lu(k,860) * lu(k,955) + lu(k,958) = lu(k,958) - lu(k,861) * lu(k,955) + lu(k,959) = lu(k,959) - lu(k,862) * lu(k,955) + lu(k,882) = 1._r8 / lu(k,882) + lu(k,883) = lu(k,883) * lu(k,882) + lu(k,884) = lu(k,884) * lu(k,882) + lu(k,885) = lu(k,885) * lu(k,882) + lu(k,906) = lu(k,906) - lu(k,883) * lu(k,905) + lu(k,907) = lu(k,907) - lu(k,884) * lu(k,905) + lu(k,908) = lu(k,908) - lu(k,885) * lu(k,905) + lu(k,930) = lu(k,930) - lu(k,883) * lu(k,929) + lu(k,931) = lu(k,931) - lu(k,884) * lu(k,929) + lu(k,932) = lu(k,932) - lu(k,885) * lu(k,929) + lu(k,957) = lu(k,957) - lu(k,883) * lu(k,956) + lu(k,958) = lu(k,958) - lu(k,884) * lu(k,956) + lu(k,959) = lu(k,959) - lu(k,885) * lu(k,956) + lu(k,906) = 1._r8 / lu(k,906) + lu(k,907) = lu(k,907) * lu(k,906) + lu(k,908) = lu(k,908) * lu(k,906) + lu(k,931) = lu(k,931) - lu(k,907) * lu(k,930) + lu(k,932) = lu(k,932) - lu(k,908) * lu(k,930) + lu(k,958) = lu(k,958) - lu(k,907) * lu(k,957) + lu(k,959) = lu(k,959) - lu(k,908) * lu(k,957) + lu(k,931) = 1._r8 / lu(k,931) + lu(k,932) = lu(k,932) * lu(k,931) + lu(k,959) = lu(k,959) - lu(k,932) * lu(k,958) + lu(k,959) = 1._r8 / lu(k,959) + end do + end subroutine lu_fac14 + 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 ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_ma_mam5/mo_lu_solve.F90 b/src/chemistry/pp_waccm_ma_mam5/mo_lu_solve.F90 new file mode 100644 index 0000000000..0ac2624f5e --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/mo_lu_solve.F90 @@ -0,0 +1,1105 @@ + 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,91) = b(k,91) - lu(k,27) * b(k,26) + b(k,96) = b(k,96) - lu(k,28) * b(k,26) + b(k,94) = b(k,94) - lu(k,30) * b(k,27) + b(k,96) = b(k,96) - lu(k,31) * b(k,27) + b(k,41) = b(k,41) - lu(k,33) * b(k,28) + b(k,94) = b(k,94) - lu(k,34) * b(k,28) + b(k,97) = b(k,97) - lu(k,35) * b(k,28) + b(k,43) = b(k,43) - lu(k,37) * b(k,29) + b(k,94) = b(k,94) - lu(k,38) * b(k,29) + b(k,96) = b(k,96) - lu(k,39) * b(k,29) + b(k,41) = b(k,41) - lu(k,41) * b(k,30) + b(k,94) = b(k,94) - lu(k,42) * b(k,30) + b(k,96) = b(k,96) - lu(k,43) * b(k,30) + b(k,41) = b(k,41) - lu(k,45) * b(k,31) + b(k,94) = b(k,94) - lu(k,46) * b(k,31) + b(k,96) = b(k,96) - lu(k,47) * b(k,31) + b(k,96) = b(k,96) - lu(k,49) * b(k,32) + b(k,98) = b(k,98) - lu(k,50) * b(k,32) + b(k,102) = b(k,102) - lu(k,51) * b(k,32) + b(k,47) = b(k,47) - lu(k,53) * b(k,33) + b(k,102) = b(k,102) - lu(k,54) * b(k,33) + b(k,41) = b(k,41) - lu(k,56) * b(k,34) + b(k,94) = b(k,94) - lu(k,57) * b(k,34) + b(k,96) = b(k,96) - lu(k,58) * b(k,34) + b(k,97) = b(k,97) - lu(k,59) * b(k,34) + b(k,41) = b(k,41) - lu(k,61) * b(k,35) + b(k,73) = b(k,73) - lu(k,62) * b(k,35) + b(k,94) = b(k,94) - lu(k,63) * b(k,35) + b(k,97) = b(k,97) - lu(k,64) * b(k,35) + b(k,41) = b(k,41) - lu(k,66) * b(k,36) + b(k,43) = b(k,43) - lu(k,67) * b(k,36) + b(k,94) = b(k,94) - lu(k,68) * b(k,36) + b(k,96) = b(k,96) - lu(k,69) * b(k,36) + b(k,41) = b(k,41) - lu(k,71) * b(k,37) + b(k,73) = b(k,73) - lu(k,72) * b(k,37) + b(k,94) = b(k,94) - lu(k,73) * b(k,37) + b(k,96) = b(k,96) - lu(k,74) * b(k,37) + b(k,96) = b(k,96) - lu(k,76) * b(k,38) + b(k,87) = b(k,87) - lu(k,78) * b(k,39) + b(k,87) = b(k,87) - lu(k,81) * b(k,40) + b(k,73) = b(k,73) - lu(k,83) * b(k,41) + b(k,94) = b(k,94) - lu(k,84) * b(k,41) + b(k,43) = b(k,43) - lu(k,86) * b(k,42) + b(k,94) = b(k,94) - lu(k,87) * b(k,42) + b(k,96) = b(k,96) - lu(k,88) * b(k,42) + b(k,98) = b(k,98) - lu(k,89) * b(k,42) + b(k,73) = b(k,73) - lu(k,91) * b(k,43) + b(k,94) = b(k,94) - lu(k,92) * b(k,43) + b(k,96) = b(k,96) - lu(k,93) * b(k,43) + b(k,73) = b(k,73) - lu(k,96) * b(k,44) + b(k,94) = b(k,94) - lu(k,97) * b(k,44) + b(k,96) = b(k,96) - lu(k,98) * b(k,44) + b(k,98) = b(k,98) - lu(k,99) * b(k,44) + b(k,96) = b(k,96) - lu(k,101) * b(k,45) + b(k,97) = b(k,97) - lu(k,102) * b(k,45) + b(k,87) = b(k,87) - lu(k,104) * b(k,46) + b(k,94) = b(k,94) - lu(k,105) * b(k,46) + b(k,95) = b(k,95) - lu(k,106) * b(k,46) + b(k,74) = b(k,74) - lu(k,109) * b(k,47) + b(k,93) = b(k,93) - lu(k,110) * b(k,47) + b(k,102) = b(k,102) - lu(k,111) * b(k,47) + b(k,73) = b(k,73) - lu(k,114) * b(k,48) + b(k,94) = b(k,94) - lu(k,115) * b(k,48) + b(k,96) = b(k,96) - lu(k,116) * b(k,48) + b(k,98) = b(k,98) - lu(k,117) * b(k,48) + b(k,102) = b(k,102) - lu(k,118) * b(k,48) + b(k,73) = b(k,73) - lu(k,120) * b(k,49) + b(k,84) = b(k,84) - lu(k,121) * b(k,49) + b(k,90) = b(k,90) - lu(k,123) * b(k,50) + b(k,92) = b(k,92) - lu(k,124) * b(k,50) + b(k,93) = b(k,93) - lu(k,125) * b(k,50) + b(k,95) = b(k,95) - lu(k,126) * b(k,50) + b(k,100) = b(k,100) - lu(k,127) * b(k,50) + b(k,74) = b(k,74) - lu(k,129) * b(k,51) + b(k,89) = b(k,89) - lu(k,130) * b(k,51) + b(k,90) = b(k,90) - lu(k,131) * b(k,51) + b(k,98) = b(k,98) - lu(k,132) * b(k,51) + b(k,100) = b(k,100) - lu(k,133) * b(k,51) + b(k,74) = b(k,74) - lu(k,135) * b(k,52) + b(k,83) = b(k,83) - lu(k,136) * b(k,52) + b(k,91) = b(k,91) - lu(k,137) * b(k,52) + b(k,93) = b(k,93) - lu(k,138) * b(k,52) + b(k,66) = b(k,66) - lu(k,140) * b(k,53) + b(k,72) = b(k,72) - lu(k,141) * b(k,53) + b(k,74) = b(k,74) - lu(k,142) * b(k,53) + b(k,83) = b(k,83) - lu(k,143) * b(k,53) + b(k,84) = b(k,84) - lu(k,144) * b(k,53) + b(k,93) = b(k,93) - lu(k,145) * b(k,53) + b(k,98) = b(k,98) - lu(k,146) * b(k,53) + b(k,72) = b(k,72) - lu(k,148) * b(k,54) + b(k,82) = b(k,82) - lu(k,149) * b(k,54) + b(k,85) = b(k,85) - lu(k,150) * b(k,54) + b(k,89) = b(k,89) - lu(k,151) * b(k,54) + b(k,96) = b(k,96) - lu(k,152) * b(k,54) + b(k,98) = b(k,98) - lu(k,153) * b(k,54) + b(k,102) = b(k,102) - lu(k,154) * b(k,54) + b(k,82) = b(k,82) - lu(k,156) * b(k,55) + b(k,84) = b(k,84) - lu(k,157) * b(k,55) + b(k,86) = b(k,86) - lu(k,158) * b(k,55) + b(k,98) = b(k,98) - lu(k,159) * b(k,55) + b(k,102) = b(k,102) - lu(k,160) * b(k,55) + b(k,85) = b(k,85) - lu(k,162) * b(k,56) + b(k,94) = b(k,94) - lu(k,163) * b(k,56) + b(k,96) = b(k,96) - lu(k,164) * b(k,56) + b(k,97) = b(k,97) - lu(k,165) * b(k,56) + b(k,98) = b(k,98) - lu(k,166) * b(k,56) + b(k,87) = b(k,87) - lu(k,168) * b(k,57) + b(k,89) = b(k,89) - lu(k,169) * b(k,57) + b(k,90) = b(k,90) - lu(k,170) * b(k,57) + b(k,92) = b(k,92) - lu(k,171) * b(k,57) + b(k,98) = b(k,98) - lu(k,172) * b(k,57) + b(k,102) = b(k,102) - lu(k,173) * b(k,57) + b(k,85) = b(k,85) - lu(k,175) * b(k,58) + b(k,94) = b(k,94) - lu(k,176) * b(k,58) + b(k,96) = b(k,96) - lu(k,177) * b(k,58) + b(k,97) = b(k,97) - lu(k,178) * b(k,58) + b(k,98) = b(k,98) - lu(k,179) * b(k,58) + b(k,102) = b(k,102) - lu(k,180) * b(k,58) + b(k,60) = b(k,60) - lu(k,182) * b(k,59) + b(k,64) = b(k,64) - lu(k,183) * b(k,59) + b(k,71) = b(k,71) - lu(k,184) * b(k,59) + b(k,80) = b(k,80) - lu(k,185) * b(k,59) + b(k,93) = b(k,93) - lu(k,186) * b(k,59) + b(k,95) = b(k,95) - lu(k,187) * b(k,59) + b(k,64) = b(k,64) - lu(k,189) * b(k,60) + b(k,79) = b(k,79) - lu(k,190) * b(k,60) + b(k,80) = b(k,80) - lu(k,191) * b(k,60) + b(k,87) = b(k,87) - lu(k,192) * b(k,60) + b(k,93) = b(k,93) - lu(k,193) * b(k,60) + b(k,72) = b(k,72) - lu(k,197) * b(k,61) + b(k,79) = b(k,79) - lu(k,198) * b(k,61) + b(k,80) = b(k,80) - lu(k,199) * b(k,61) + b(k,87) = b(k,87) - lu(k,200) * b(k,61) + b(k,93) = b(k,93) - lu(k,201) * b(k,61) + b(k,68) = b(k,68) - lu(k,203) * b(k,62) + b(k,90) = b(k,90) - lu(k,204) * b(k,62) + b(k,92) = b(k,92) - lu(k,205) * b(k,62) + b(k,93) = b(k,93) - lu(k,206) * b(k,62) + b(k,97) = b(k,97) - lu(k,207) * b(k,62) + b(k,100) = b(k,100) - lu(k,208) * b(k,62) + b(k,101) = b(k,101) - lu(k,209) * b(k,62) + b(k,82) = b(k,82) - lu(k,211) * b(k,63) + b(k,85) = b(k,85) - lu(k,212) * b(k,63) + b(k,89) = b(k,89) - lu(k,213) * b(k,63) + b(k,94) = b(k,94) - lu(k,214) * b(k,63) + b(k,96) = b(k,96) - lu(k,215) * b(k,63) + b(k,97) = b(k,97) - lu(k,216) * b(k,63) + b(k,98) = b(k,98) - lu(k,217) * b(k,63) + b(k,102) = b(k,102) - lu(k,218) * b(k,63) + b(k,67) = b(k,67) - lu(k,220) * b(k,64) + b(k,76) = b(k,76) - lu(k,221) * b(k,64) + b(k,77) = b(k,77) - lu(k,222) * b(k,64) + b(k,78) = b(k,78) - lu(k,223) * b(k,64) + b(k,79) = b(k,79) - lu(k,224) * b(k,64) + b(k,80) = b(k,80) - lu(k,225) * b(k,64) + b(k,87) = b(k,87) - lu(k,226) * b(k,64) + b(k,93) = b(k,93) - lu(k,227) * b(k,64) + b(k,85) = b(k,85) - lu(k,229) * b(k,65) + b(k,89) = b(k,89) - lu(k,230) * b(k,65) + b(k,93) = b(k,93) - lu(k,231) * b(k,65) + b(k,96) = b(k,96) - lu(k,232) * b(k,65) + b(k,98) = b(k,98) - lu(k,233) * b(k,65) + b(k,102) = b(k,102) - lu(k,234) * b(k,65) + b(k,83) = b(k,83) - lu(k,236) * b(k,66) + b(k,84) = b(k,84) - lu(k,237) * b(k,66) + b(k,87) = b(k,87) - lu(k,238) * b(k,66) + b(k,88) = b(k,88) - lu(k,239) * b(k,66) + b(k,93) = b(k,93) - lu(k,240) * b(k,66) + b(k,98) = b(k,98) - lu(k,241) * b(k,66) + b(k,76) = b(k,76) - lu(k,243) * b(k,67) + b(k,77) = b(k,77) - lu(k,244) * b(k,67) + b(k,78) = b(k,78) - lu(k,245) * b(k,67) + b(k,93) = b(k,93) - lu(k,246) * b(k,67) + b(k,85) = b(k,85) - lu(k,249) * b(k,68) + b(k,93) = b(k,93) - lu(k,250) * b(k,68) + b(k,96) = b(k,96) - lu(k,251) * b(k,68) + b(k,97) = b(k,97) - lu(k,252) * b(k,68) + b(k,98) = b(k,98) - lu(k,253) * b(k,68) + b(k,101) = b(k,101) - lu(k,254) * b(k,68) + b(k,102) = b(k,102) - lu(k,255) * b(k,68) + b(k,84) = b(k,84) - lu(k,257) * b(k,69) + b(k,93) = b(k,93) - lu(k,258) * b(k,69) + b(k,94) = b(k,94) - lu(k,259) * b(k,69) + b(k,97) = b(k,97) - lu(k,260) * b(k,69) + b(k,98) = b(k,98) - lu(k,261) * b(k,69) + b(k,101) = b(k,101) - lu(k,262) * b(k,69) + b(k,102) = b(k,102) - lu(k,263) * b(k,69) + b(k,85) = b(k,85) - lu(k,266) * b(k,70) + b(k,91) = b(k,91) - lu(k,267) * b(k,70) + b(k,93) = b(k,93) - lu(k,268) * b(k,70) + b(k,96) = b(k,96) - lu(k,269) * b(k,70) + b(k,98) = b(k,98) - lu(k,270) * b(k,70) + b(k,102) = b(k,102) - lu(k,271) * b(k,70) + b(k,76) = b(k,76) - lu(k,274) * b(k,71) + b(k,77) = b(k,77) - lu(k,275) * b(k,71) + b(k,78) = b(k,78) - lu(k,276) * b(k,71) + b(k,79) = b(k,79) - lu(k,277) * b(k,71) + b(k,80) = b(k,80) - lu(k,278) * b(k,71) + b(k,87) = b(k,87) - lu(k,279) * b(k,71) + b(k,93) = b(k,93) - lu(k,280) * b(k,71) + b(k,79) = b(k,79) - lu(k,283) * b(k,72) + b(k,80) = b(k,80) - lu(k,284) * b(k,72) + b(k,87) = b(k,87) - lu(k,285) * b(k,72) + b(k,89) = b(k,89) - lu(k,286) * b(k,72) + b(k,93) = b(k,93) - lu(k,287) * b(k,72) + b(k,98) = b(k,98) - lu(k,288) * b(k,72) + 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,81) = b(k,81) - lu(k,291) * b(k,73) + b(k,82) = b(k,82) - lu(k,292) * b(k,73) + b(k,84) = b(k,84) - lu(k,293) * b(k,73) + b(k,90) = b(k,90) - lu(k,294) * b(k,73) + b(k,98) = b(k,98) - lu(k,295) * b(k,73) + b(k,99) = b(k,99) - lu(k,296) * b(k,73) + b(k,100) = b(k,100) - lu(k,297) * b(k,73) + b(k,102) = b(k,102) - lu(k,298) * b(k,73) + b(k,83) = b(k,83) - lu(k,301) * b(k,74) + b(k,89) = b(k,89) - lu(k,302) * b(k,74) + b(k,93) = b(k,93) - lu(k,303) * b(k,74) + b(k,98) = b(k,98) - lu(k,304) * b(k,74) + b(k,102) = b(k,102) - lu(k,305) * b(k,74) + b(k,85) = b(k,85) - lu(k,309) * b(k,75) + b(k,90) = b(k,90) - lu(k,310) * b(k,75) + b(k,91) = b(k,91) - lu(k,311) * b(k,75) + b(k,92) = b(k,92) - lu(k,312) * b(k,75) + b(k,93) = b(k,93) - lu(k,313) * b(k,75) + b(k,96) = b(k,96) - lu(k,314) * b(k,75) + b(k,98) = b(k,98) - lu(k,315) * b(k,75) + b(k,100) = b(k,100) - lu(k,316) * b(k,75) + b(k,102) = b(k,102) - lu(k,317) * b(k,75) + b(k,77) = b(k,77) - lu(k,324) * b(k,76) + b(k,78) = b(k,78) - lu(k,325) * b(k,76) + b(k,79) = b(k,79) - lu(k,326) * b(k,76) + b(k,80) = b(k,80) - lu(k,327) * b(k,76) + b(k,87) = b(k,87) - lu(k,328) * b(k,76) + b(k,93) = b(k,93) - lu(k,329) * b(k,76) + b(k,94) = b(k,94) - lu(k,330) * b(k,76) + b(k,95) = b(k,95) - lu(k,331) * b(k,76) + b(k,78) = b(k,78) - lu(k,335) * b(k,77) + b(k,79) = b(k,79) - lu(k,336) * b(k,77) + b(k,80) = b(k,80) - lu(k,337) * b(k,77) + b(k,87) = b(k,87) - lu(k,338) * b(k,77) + b(k,93) = b(k,93) - lu(k,339) * b(k,77) + b(k,94) = b(k,94) - lu(k,340) * b(k,77) + b(k,95) = b(k,95) - lu(k,341) * b(k,77) + b(k,79) = b(k,79) - lu(k,348) * b(k,78) + b(k,80) = b(k,80) - lu(k,349) * b(k,78) + b(k,84) = b(k,84) - lu(k,350) * b(k,78) + b(k,87) = b(k,87) - lu(k,351) * b(k,78) + b(k,92) = b(k,92) - lu(k,352) * b(k,78) + b(k,93) = b(k,93) - lu(k,353) * b(k,78) + b(k,94) = b(k,94) - lu(k,354) * b(k,78) + b(k,95) = b(k,95) - lu(k,355) * b(k,78) + b(k,98) = b(k,98) - lu(k,356) * b(k,78) + b(k,80) = b(k,80) - lu(k,362) * b(k,79) + b(k,84) = b(k,84) - lu(k,363) * b(k,79) + b(k,87) = b(k,87) - lu(k,364) * b(k,79) + b(k,92) = b(k,92) - lu(k,365) * b(k,79) + b(k,93) = b(k,93) - lu(k,366) * b(k,79) + b(k,94) = b(k,94) - lu(k,367) * b(k,79) + b(k,95) = b(k,95) - lu(k,368) * b(k,79) + b(k,98) = b(k,98) - lu(k,369) * b(k,79) + b(k,84) = b(k,84) - lu(k,379) * b(k,80) + b(k,87) = b(k,87) - lu(k,380) * b(k,80) + b(k,89) = b(k,89) - lu(k,381) * b(k,80) + b(k,92) = b(k,92) - lu(k,382) * b(k,80) + b(k,93) = b(k,93) - lu(k,383) * b(k,80) + b(k,94) = b(k,94) - lu(k,384) * b(k,80) + b(k,95) = b(k,95) - lu(k,385) * b(k,80) + b(k,98) = b(k,98) - lu(k,386) * b(k,80) + b(k,82) = b(k,82) - lu(k,394) * b(k,81) + b(k,84) = b(k,84) - lu(k,395) * b(k,81) + b(k,85) = b(k,85) - lu(k,396) * b(k,81) + b(k,86) = b(k,86) - lu(k,397) * b(k,81) + b(k,87) = b(k,87) - lu(k,398) * b(k,81) + b(k,89) = b(k,89) - lu(k,399) * b(k,81) + b(k,90) = b(k,90) - lu(k,400) * b(k,81) + b(k,92) = b(k,92) - lu(k,401) * b(k,81) + b(k,93) = b(k,93) - lu(k,402) * b(k,81) + b(k,94) = b(k,94) - lu(k,403) * b(k,81) + b(k,95) = b(k,95) - lu(k,404) * b(k,81) + b(k,96) = b(k,96) - lu(k,405) * b(k,81) + b(k,98) = b(k,98) - lu(k,406) * b(k,81) + b(k,99) = b(k,99) - lu(k,407) * b(k,81) + b(k,100) = b(k,100) - lu(k,408) * b(k,81) + b(k,102) = b(k,102) - lu(k,409) * b(k,81) + b(k,84) = b(k,84) - lu(k,412) * b(k,82) + b(k,86) = b(k,86) - lu(k,413) * b(k,82) + b(k,87) = b(k,87) - lu(k,414) * b(k,82) + b(k,89) = b(k,89) - lu(k,415) * b(k,82) + b(k,91) = b(k,91) - lu(k,416) * b(k,82) + b(k,92) = b(k,92) - lu(k,417) * b(k,82) + b(k,95) = b(k,95) - lu(k,418) * b(k,82) + b(k,96) = b(k,96) - lu(k,419) * b(k,82) + b(k,98) = b(k,98) - lu(k,420) * b(k,82) + b(k,102) = b(k,102) - lu(k,421) * b(k,82) + b(k,84) = b(k,84) - lu(k,426) * b(k,83) + b(k,87) = b(k,87) - lu(k,427) * b(k,83) + b(k,88) = b(k,88) - lu(k,428) * b(k,83) + b(k,89) = b(k,89) - lu(k,429) * b(k,83) + b(k,91) = b(k,91) - lu(k,430) * b(k,83) + b(k,92) = b(k,92) - lu(k,431) * b(k,83) + b(k,93) = b(k,93) - lu(k,432) * b(k,83) + b(k,95) = b(k,95) - lu(k,433) * b(k,83) + b(k,96) = b(k,96) - lu(k,434) * b(k,83) + b(k,97) = b(k,97) - lu(k,435) * b(k,83) + b(k,98) = b(k,98) - lu(k,436) * b(k,83) + b(k,101) = b(k,101) - lu(k,437) * b(k,83) + b(k,102) = b(k,102) - lu(k,438) * b(k,83) + b(k,87) = b(k,87) - lu(k,440) * b(k,84) + b(k,88) = b(k,88) - lu(k,441) * b(k,84) + b(k,89) = b(k,89) - lu(k,442) * b(k,84) + b(k,93) = b(k,93) - lu(k,443) * b(k,84) + b(k,98) = b(k,98) - lu(k,444) * b(k,84) + b(k,99) = b(k,99) - lu(k,445) * b(k,84) + b(k,102) = b(k,102) - lu(k,446) * b(k,84) + b(k,87) = b(k,87) - lu(k,454) * b(k,85) + b(k,88) = b(k,88) - lu(k,455) * b(k,85) + b(k,89) = b(k,89) - lu(k,456) * b(k,85) + b(k,90) = b(k,90) - lu(k,457) * b(k,85) + b(k,91) = b(k,91) - lu(k,458) * b(k,85) + b(k,92) = b(k,92) - lu(k,459) * b(k,85) + b(k,93) = b(k,93) - lu(k,460) * b(k,85) + b(k,94) = b(k,94) - lu(k,461) * b(k,85) + b(k,96) = b(k,96) - lu(k,462) * b(k,85) + b(k,97) = b(k,97) - lu(k,463) * b(k,85) + b(k,98) = b(k,98) - lu(k,464) * b(k,85) + b(k,99) = b(k,99) - lu(k,465) * b(k,85) + b(k,100) = b(k,100) - lu(k,466) * b(k,85) + b(k,101) = b(k,101) - lu(k,467) * b(k,85) + b(k,102) = b(k,102) - lu(k,468) * b(k,85) + b(k,87) = b(k,87) - lu(k,476) * b(k,86) + b(k,88) = b(k,88) - lu(k,477) * b(k,86) + b(k,89) = b(k,89) - lu(k,478) * b(k,86) + b(k,90) = b(k,90) - lu(k,479) * b(k,86) + b(k,91) = b(k,91) - lu(k,480) * b(k,86) + b(k,92) = b(k,92) - lu(k,481) * b(k,86) + b(k,93) = b(k,93) - lu(k,482) * b(k,86) + b(k,94) = b(k,94) - lu(k,483) * b(k,86) + b(k,95) = b(k,95) - lu(k,484) * b(k,86) + b(k,96) = b(k,96) - lu(k,485) * b(k,86) + b(k,97) = b(k,97) - lu(k,486) * b(k,86) + b(k,98) = b(k,98) - lu(k,487) * b(k,86) + b(k,99) = b(k,99) - lu(k,488) * b(k,86) + b(k,100) = b(k,100) - lu(k,489) * b(k,86) + b(k,101) = b(k,101) - lu(k,490) * b(k,86) + b(k,102) = b(k,102) - lu(k,491) * b(k,86) + b(k,88) = b(k,88) - lu(k,509) * b(k,87) + b(k,89) = b(k,89) - lu(k,510) * b(k,87) + b(k,91) = b(k,91) - lu(k,511) * b(k,87) + b(k,92) = b(k,92) - lu(k,512) * b(k,87) + b(k,93) = b(k,93) - lu(k,513) * b(k,87) + b(k,94) = b(k,94) - lu(k,514) * b(k,87) + b(k,95) = b(k,95) - lu(k,515) * b(k,87) + b(k,96) = b(k,96) - lu(k,516) * b(k,87) + b(k,97) = b(k,97) - lu(k,517) * b(k,87) + b(k,98) = b(k,98) - lu(k,518) * b(k,87) + b(k,99) = b(k,99) - lu(k,519) * b(k,87) + b(k,101) = b(k,101) - lu(k,520) * b(k,87) + b(k,102) = b(k,102) - lu(k,521) * b(k,87) + b(k,89) = b(k,89) - lu(k,530) * b(k,88) + b(k,90) = b(k,90) - lu(k,531) * b(k,88) + b(k,91) = b(k,91) - lu(k,532) * b(k,88) + b(k,92) = b(k,92) - lu(k,533) * b(k,88) + b(k,93) = b(k,93) - lu(k,534) * b(k,88) + b(k,94) = b(k,94) - lu(k,535) * b(k,88) + b(k,95) = b(k,95) - lu(k,536) * b(k,88) + b(k,96) = b(k,96) - lu(k,537) * b(k,88) + b(k,97) = b(k,97) - lu(k,538) * b(k,88) + b(k,98) = b(k,98) - lu(k,539) * b(k,88) + b(k,99) = b(k,99) - lu(k,540) * b(k,88) + b(k,101) = b(k,101) - lu(k,541) * b(k,88) + b(k,102) = b(k,102) - lu(k,542) * b(k,88) + b(k,90) = b(k,90) - lu(k,556) * b(k,89) + b(k,91) = b(k,91) - lu(k,557) * b(k,89) + b(k,92) = b(k,92) - lu(k,558) * b(k,89) + b(k,93) = b(k,93) - lu(k,559) * b(k,89) + b(k,94) = b(k,94) - lu(k,560) * b(k,89) + b(k,95) = b(k,95) - lu(k,561) * b(k,89) + b(k,96) = b(k,96) - lu(k,562) * b(k,89) + b(k,97) = b(k,97) - lu(k,563) * b(k,89) + b(k,98) = b(k,98) - lu(k,564) * b(k,89) + b(k,99) = b(k,99) - lu(k,565) * b(k,89) + b(k,100) = b(k,100) - lu(k,566) * b(k,89) + b(k,101) = b(k,101) - lu(k,567) * b(k,89) + b(k,102) = b(k,102) - lu(k,568) * b(k,89) + b(k,91) = b(k,91) - lu(k,582) * b(k,90) + b(k,92) = b(k,92) - lu(k,583) * b(k,90) + b(k,93) = b(k,93) - lu(k,584) * b(k,90) + b(k,94) = b(k,94) - lu(k,585) * b(k,90) + b(k,95) = b(k,95) - lu(k,586) * b(k,90) + b(k,96) = b(k,96) - lu(k,587) * b(k,90) + b(k,97) = b(k,97) - lu(k,588) * b(k,90) + b(k,98) = b(k,98) - lu(k,589) * b(k,90) + b(k,99) = b(k,99) - lu(k,590) * b(k,90) + b(k,100) = b(k,100) - lu(k,591) * b(k,90) + b(k,101) = b(k,101) - lu(k,592) * b(k,90) + b(k,102) = b(k,102) - lu(k,593) * b(k,90) + b(k,92) = b(k,92) - lu(k,611) * b(k,91) + b(k,93) = b(k,93) - lu(k,612) * b(k,91) + b(k,94) = b(k,94) - lu(k,613) * b(k,91) + b(k,95) = b(k,95) - lu(k,614) * b(k,91) + b(k,96) = b(k,96) - lu(k,615) * b(k,91) + b(k,97) = b(k,97) - lu(k,616) * b(k,91) + b(k,98) = b(k,98) - lu(k,617) * b(k,91) + b(k,99) = b(k,99) - lu(k,618) * b(k,91) + b(k,100) = b(k,100) - lu(k,619) * b(k,91) + b(k,101) = b(k,101) - lu(k,620) * b(k,91) + b(k,102) = b(k,102) - lu(k,621) * b(k,91) + 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,93) = b(k,93) - lu(k,641) * b(k,92) + b(k,94) = b(k,94) - lu(k,642) * b(k,92) + b(k,95) = b(k,95) - lu(k,643) * b(k,92) + b(k,96) = b(k,96) - lu(k,644) * b(k,92) + b(k,97) = b(k,97) - lu(k,645) * b(k,92) + b(k,98) = b(k,98) - lu(k,646) * b(k,92) + b(k,99) = b(k,99) - lu(k,647) * b(k,92) + b(k,100) = b(k,100) - lu(k,648) * b(k,92) + b(k,101) = b(k,101) - lu(k,649) * b(k,92) + b(k,102) = b(k,102) - lu(k,650) * b(k,92) + b(k,94) = b(k,94) - lu(k,684) * b(k,93) + b(k,95) = b(k,95) - lu(k,685) * b(k,93) + b(k,96) = b(k,96) - lu(k,686) * b(k,93) + b(k,97) = b(k,97) - lu(k,687) * b(k,93) + b(k,98) = b(k,98) - lu(k,688) * b(k,93) + b(k,99) = b(k,99) - lu(k,689) * b(k,93) + b(k,100) = b(k,100) - lu(k,690) * b(k,93) + b(k,101) = b(k,101) - lu(k,691) * b(k,93) + b(k,102) = b(k,102) - lu(k,692) * b(k,93) + b(k,95) = b(k,95) - lu(k,727) * b(k,94) + b(k,96) = b(k,96) - lu(k,728) * b(k,94) + b(k,97) = b(k,97) - lu(k,729) * b(k,94) + b(k,98) = b(k,98) - lu(k,730) * b(k,94) + b(k,99) = b(k,99) - lu(k,731) * b(k,94) + b(k,100) = b(k,100) - lu(k,732) * b(k,94) + b(k,101) = b(k,101) - lu(k,733) * b(k,94) + b(k,102) = b(k,102) - lu(k,734) * b(k,94) + b(k,96) = b(k,96) - lu(k,753) * b(k,95) + b(k,97) = b(k,97) - lu(k,754) * b(k,95) + b(k,98) = b(k,98) - lu(k,755) * b(k,95) + b(k,99) = b(k,99) - lu(k,756) * b(k,95) + b(k,100) = b(k,100) - lu(k,757) * b(k,95) + b(k,101) = b(k,101) - lu(k,758) * b(k,95) + b(k,102) = b(k,102) - lu(k,759) * b(k,95) + b(k,97) = b(k,97) - lu(k,786) * b(k,96) + b(k,98) = b(k,98) - lu(k,787) * b(k,96) + b(k,99) = b(k,99) - lu(k,788) * b(k,96) + b(k,100) = b(k,100) - lu(k,789) * b(k,96) + b(k,101) = b(k,101) - lu(k,790) * b(k,96) + b(k,102) = b(k,102) - lu(k,791) * b(k,96) + b(k,98) = b(k,98) - lu(k,809) * b(k,97) + b(k,99) = b(k,99) - lu(k,810) * b(k,97) + b(k,100) = b(k,100) - lu(k,811) * b(k,97) + b(k,101) = b(k,101) - lu(k,812) * b(k,97) + b(k,102) = b(k,102) - lu(k,813) * b(k,97) + b(k,99) = b(k,99) - lu(k,859) * b(k,98) + b(k,100) = b(k,100) - lu(k,860) * b(k,98) + b(k,101) = b(k,101) - lu(k,861) * b(k,98) + b(k,102) = b(k,102) - lu(k,862) * b(k,98) + b(k,100) = b(k,100) - lu(k,883) * b(k,99) + b(k,101) = b(k,101) - lu(k,884) * b(k,99) + b(k,102) = b(k,102) - lu(k,885) * b(k,99) + b(k,101) = b(k,101) - lu(k,907) * b(k,100) + b(k,102) = b(k,102) - lu(k,908) * b(k,100) + b(k,102) = b(k,102) - lu(k,932) * b(k,101) + 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 +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,102) = b(k,102) * lu(k,959) + b(k,101) = b(k,101) - lu(k,958) * b(k,102) + b(k,100) = b(k,100) - lu(k,957) * b(k,102) + b(k,99) = b(k,99) - lu(k,956) * b(k,102) + b(k,98) = b(k,98) - lu(k,955) * b(k,102) + b(k,97) = b(k,97) - lu(k,954) * b(k,102) + b(k,96) = b(k,96) - lu(k,953) * b(k,102) + b(k,95) = b(k,95) - lu(k,952) * b(k,102) + b(k,94) = b(k,94) - lu(k,951) * b(k,102) + b(k,93) = b(k,93) - lu(k,950) * b(k,102) + b(k,92) = b(k,92) - lu(k,949) * b(k,102) + b(k,91) = b(k,91) - lu(k,948) * b(k,102) + b(k,90) = b(k,90) - lu(k,947) * b(k,102) + b(k,89) = b(k,89) - lu(k,946) * b(k,102) + b(k,88) = b(k,88) - lu(k,945) * b(k,102) + b(k,87) = b(k,87) - lu(k,944) * b(k,102) + b(k,86) = b(k,86) - lu(k,943) * b(k,102) + b(k,85) = b(k,85) - lu(k,942) * b(k,102) + b(k,84) = b(k,84) - lu(k,941) * b(k,102) + b(k,83) = b(k,83) - lu(k,940) * b(k,102) + b(k,82) = b(k,82) - lu(k,939) * b(k,102) + b(k,81) = b(k,81) - lu(k,938) * b(k,102) + b(k,74) = b(k,74) - lu(k,937) * b(k,102) + b(k,73) = b(k,73) - lu(k,936) * b(k,102) + b(k,49) = b(k,49) - lu(k,935) * b(k,102) + b(k,47) = b(k,47) - lu(k,934) * b(k,102) + b(k,33) = b(k,33) - lu(k,933) * b(k,102) + b(k,101) = b(k,101) * lu(k,931) + b(k,100) = b(k,100) - lu(k,930) * b(k,101) + b(k,99) = b(k,99) - lu(k,929) * b(k,101) + b(k,98) = b(k,98) - lu(k,928) * b(k,101) + b(k,97) = b(k,97) - lu(k,927) * b(k,101) + b(k,96) = b(k,96) - lu(k,926) * b(k,101) + b(k,95) = b(k,95) - lu(k,925) * b(k,101) + b(k,94) = b(k,94) - lu(k,924) * b(k,101) + b(k,93) = b(k,93) - lu(k,923) * b(k,101) + b(k,92) = b(k,92) - lu(k,922) * b(k,101) + b(k,91) = b(k,91) - lu(k,921) * b(k,101) + b(k,90) = b(k,90) - lu(k,920) * b(k,101) + b(k,89) = b(k,89) - lu(k,919) * b(k,101) + b(k,88) = b(k,88) - lu(k,918) * b(k,101) + b(k,87) = b(k,87) - lu(k,917) * b(k,101) + b(k,85) = b(k,85) - lu(k,916) * b(k,101) + b(k,84) = b(k,84) - lu(k,915) * b(k,101) + b(k,83) = b(k,83) - lu(k,914) * b(k,101) + b(k,74) = b(k,74) - lu(k,913) * b(k,101) + b(k,68) = b(k,68) - lu(k,912) * b(k,101) + b(k,62) = b(k,62) - lu(k,911) * b(k,101) + b(k,52) = b(k,52) - lu(k,910) * b(k,101) + b(k,45) = b(k,45) - lu(k,909) * b(k,101) + b(k,100) = b(k,100) * lu(k,906) + b(k,99) = b(k,99) - lu(k,905) * b(k,100) + b(k,98) = b(k,98) - lu(k,904) * b(k,100) + b(k,97) = b(k,97) - lu(k,903) * b(k,100) + b(k,96) = b(k,96) - lu(k,902) * b(k,100) + b(k,95) = b(k,95) - lu(k,901) * b(k,100) + b(k,94) = b(k,94) - lu(k,900) * b(k,100) + b(k,93) = b(k,93) - lu(k,899) * b(k,100) + b(k,92) = b(k,92) - lu(k,898) * b(k,100) + b(k,91) = b(k,91) - lu(k,897) * b(k,100) + b(k,90) = b(k,90) - lu(k,896) * b(k,100) + b(k,89) = b(k,89) - lu(k,895) * b(k,100) + b(k,88) = b(k,88) - lu(k,894) * b(k,100) + b(k,87) = b(k,87) - lu(k,893) * b(k,100) + b(k,86) = b(k,86) - lu(k,892) * b(k,100) + b(k,85) = b(k,85) - lu(k,891) * b(k,100) + b(k,84) = b(k,84) - lu(k,890) * b(k,100) + b(k,82) = b(k,82) - lu(k,889) * b(k,100) + b(k,81) = b(k,81) - lu(k,888) * b(k,100) + b(k,73) = b(k,73) - lu(k,887) * b(k,100) + b(k,49) = b(k,49) - lu(k,886) * b(k,100) + b(k,99) = b(k,99) * lu(k,882) + b(k,98) = b(k,98) - lu(k,881) * b(k,99) + b(k,97) = b(k,97) - lu(k,880) * b(k,99) + b(k,96) = b(k,96) - lu(k,879) * b(k,99) + b(k,95) = b(k,95) - lu(k,878) * b(k,99) + b(k,94) = b(k,94) - lu(k,877) * b(k,99) + b(k,93) = b(k,93) - lu(k,876) * b(k,99) + b(k,92) = b(k,92) - lu(k,875) * b(k,99) + b(k,91) = b(k,91) - lu(k,874) * b(k,99) + b(k,90) = b(k,90) - lu(k,873) * b(k,99) + b(k,89) = b(k,89) - lu(k,872) * b(k,99) + b(k,88) = b(k,88) - lu(k,871) * b(k,99) + b(k,87) = b(k,87) - lu(k,870) * b(k,99) + b(k,86) = b(k,86) - lu(k,869) * b(k,99) + b(k,85) = b(k,85) - lu(k,868) * b(k,99) + b(k,84) = b(k,84) - lu(k,867) * b(k,99) + b(k,82) = b(k,82) - lu(k,866) * b(k,99) + b(k,81) = b(k,81) - lu(k,865) * b(k,99) + b(k,73) = b(k,73) - lu(k,864) * b(k,99) + b(k,49) = b(k,49) - lu(k,863) * b(k,99) + b(k,98) = b(k,98) * lu(k,858) + b(k,97) = b(k,97) - lu(k,857) * b(k,98) + b(k,96) = b(k,96) - lu(k,856) * b(k,98) + b(k,95) = b(k,95) - lu(k,855) * b(k,98) + b(k,94) = b(k,94) - lu(k,854) * b(k,98) + b(k,93) = b(k,93) - lu(k,853) * b(k,98) + b(k,92) = b(k,92) - lu(k,852) * b(k,98) + b(k,91) = b(k,91) - lu(k,851) * b(k,98) + b(k,90) = b(k,90) - lu(k,850) * b(k,98) + b(k,89) = b(k,89) - lu(k,849) * b(k,98) + b(k,88) = b(k,88) - lu(k,848) * b(k,98) + b(k,87) = b(k,87) - lu(k,847) * b(k,98) + b(k,86) = b(k,86) - lu(k,846) * b(k,98) + b(k,85) = b(k,85) - lu(k,845) * b(k,98) + b(k,84) = b(k,84) - lu(k,844) * b(k,98) + b(k,83) = b(k,83) - lu(k,843) * b(k,98) + b(k,82) = b(k,82) - lu(k,842) * b(k,98) + b(k,81) = b(k,81) - lu(k,841) * b(k,98) + b(k,80) = b(k,80) - lu(k,840) * b(k,98) + b(k,79) = b(k,79) - lu(k,839) * b(k,98) + b(k,78) = b(k,78) - lu(k,838) * b(k,98) + b(k,75) = b(k,75) - lu(k,837) * b(k,98) + b(k,74) = b(k,74) - lu(k,836) * b(k,98) + b(k,73) = b(k,73) - lu(k,835) * b(k,98) + b(k,72) = b(k,72) - lu(k,834) * b(k,98) + b(k,70) = b(k,70) - lu(k,833) * b(k,98) + b(k,69) = b(k,69) - lu(k,832) * b(k,98) + b(k,66) = b(k,66) - lu(k,831) * b(k,98) + b(k,65) = b(k,65) - lu(k,830) * b(k,98) + b(k,63) = b(k,63) - lu(k,829) * b(k,98) + b(k,61) = b(k,61) - lu(k,828) * b(k,98) + b(k,58) = b(k,58) - lu(k,827) * b(k,98) + b(k,57) = b(k,57) - lu(k,826) * b(k,98) + b(k,56) = b(k,56) - lu(k,825) * b(k,98) + b(k,55) = b(k,55) - lu(k,824) * b(k,98) + b(k,54) = b(k,54) - lu(k,823) * b(k,98) + b(k,53) = b(k,53) - lu(k,822) * b(k,98) + b(k,51) = b(k,51) - lu(k,821) * b(k,98) + b(k,48) = b(k,48) - lu(k,820) * b(k,98) + b(k,47) = b(k,47) - lu(k,819) * b(k,98) + b(k,44) = b(k,44) - lu(k,818) * b(k,98) + b(k,43) = b(k,43) - lu(k,817) * b(k,98) + b(k,42) = b(k,42) - lu(k,816) * b(k,98) + b(k,41) = b(k,41) - lu(k,815) * b(k,98) + b(k,32) = b(k,32) - lu(k,814) * b(k,98) + b(k,97) = b(k,97) * lu(k,808) + b(k,96) = b(k,96) - lu(k,807) * b(k,97) + b(k,95) = b(k,95) - lu(k,806) * b(k,97) + b(k,94) = b(k,94) - lu(k,805) * b(k,97) + b(k,93) = b(k,93) - lu(k,804) * b(k,97) + b(k,92) = b(k,92) - lu(k,803) * b(k,97) + b(k,91) = b(k,91) - lu(k,802) * b(k,97) + b(k,90) = b(k,90) - lu(k,801) * b(k,97) + b(k,89) = b(k,89) - lu(k,800) * b(k,97) + b(k,88) = b(k,88) - lu(k,799) * b(k,97) + b(k,87) = b(k,87) - lu(k,798) * b(k,97) + b(k,86) = b(k,86) - lu(k,797) * b(k,97) + b(k,84) = b(k,84) - lu(k,796) * b(k,97) + b(k,80) = b(k,80) - lu(k,795) * b(k,97) + b(k,79) = b(k,79) - lu(k,794) * b(k,97) + b(k,72) = b(k,72) - lu(k,793) * b(k,97) + b(k,69) = b(k,69) - lu(k,792) * b(k,97) + b(k,96) = b(k,96) * lu(k,785) + b(k,95) = b(k,95) - lu(k,784) * b(k,96) + b(k,94) = b(k,94) - lu(k,783) * b(k,96) + b(k,93) = b(k,93) - lu(k,782) * b(k,96) + b(k,92) = b(k,92) - lu(k,781) * b(k,96) + b(k,91) = b(k,91) - lu(k,780) * b(k,96) + b(k,90) = b(k,90) - lu(k,779) * b(k,96) + b(k,89) = b(k,89) - lu(k,778) * b(k,96) + b(k,88) = b(k,88) - lu(k,777) * b(k,96) + b(k,87) = b(k,87) - lu(k,776) * b(k,96) + b(k,86) = b(k,86) - lu(k,775) * b(k,96) + b(k,85) = b(k,85) - lu(k,774) * b(k,96) + b(k,84) = b(k,84) - lu(k,773) * b(k,96) + b(k,82) = b(k,82) - lu(k,772) * b(k,96) + b(k,81) = b(k,81) - lu(k,771) * b(k,96) + b(k,80) = b(k,80) - lu(k,770) * b(k,96) + b(k,79) = b(k,79) - lu(k,769) * b(k,96) + b(k,75) = b(k,75) - lu(k,768) * b(k,96) + b(k,72) = b(k,72) - lu(k,767) * b(k,96) + b(k,70) = b(k,70) - lu(k,766) * b(k,96) + b(k,65) = b(k,65) - lu(k,765) * b(k,96) + b(k,63) = b(k,63) - lu(k,764) * b(k,96) + b(k,58) = b(k,58) - lu(k,763) * b(k,96) + b(k,56) = b(k,56) - lu(k,762) * b(k,96) + b(k,54) = b(k,54) - lu(k,761) * b(k,96) + b(k,38) = b(k,38) - lu(k,760) * b(k,96) + b(k,95) = b(k,95) * lu(k,752) + b(k,94) = b(k,94) - lu(k,751) * b(k,95) + b(k,93) = b(k,93) - lu(k,750) * b(k,95) + b(k,92) = b(k,92) - lu(k,749) * b(k,95) + b(k,91) = b(k,91) - lu(k,748) * b(k,95) + b(k,90) = b(k,90) - lu(k,747) * b(k,95) + b(k,89) = b(k,89) - lu(k,746) * b(k,95) + b(k,88) = b(k,88) - lu(k,745) * b(k,95) + b(k,87) = b(k,87) - lu(k,744) * b(k,95) + b(k,86) = b(k,86) - lu(k,743) * b(k,95) + b(k,84) = b(k,84) - lu(k,742) * b(k,95) + b(k,82) = b(k,82) - lu(k,741) * b(k,95) + b(k,80) = b(k,80) - lu(k,740) * b(k,95) + b(k,79) = b(k,79) - lu(k,739) * b(k,95) + b(k,78) = b(k,78) - lu(k,738) * b(k,95) + b(k,77) = b(k,77) - lu(k,737) * b(k,95) + b(k,76) = b(k,76) - lu(k,736) * b(k,95) + b(k,67) = b(k,67) - lu(k,735) * b(k,95) + b(k,94) = b(k,94) * lu(k,726) + b(k,93) = b(k,93) - lu(k,725) * b(k,94) + b(k,92) = b(k,92) - lu(k,724) * b(k,94) + b(k,91) = b(k,91) - lu(k,723) * b(k,94) + b(k,90) = b(k,90) - lu(k,722) * b(k,94) + b(k,89) = b(k,89) - lu(k,721) * b(k,94) + b(k,88) = b(k,88) - lu(k,720) * b(k,94) + b(k,87) = b(k,87) - lu(k,719) * b(k,94) + b(k,86) = b(k,86) - lu(k,718) * b(k,94) + b(k,85) = b(k,85) - lu(k,717) * b(k,94) + b(k,84) = b(k,84) - lu(k,716) * b(k,94) + b(k,82) = b(k,82) - lu(k,715) * b(k,94) + b(k,81) = b(k,81) - lu(k,714) * b(k,94) + b(k,73) = b(k,73) - lu(k,713) * b(k,94) + b(k,69) = b(k,69) - lu(k,712) * b(k,94) + b(k,63) = b(k,63) - lu(k,711) * b(k,94) + b(k,58) = b(k,58) - lu(k,710) * b(k,94) + b(k,56) = b(k,56) - lu(k,709) * b(k,94) + b(k,48) = b(k,48) - lu(k,708) * b(k,94) + b(k,46) = b(k,46) - lu(k,707) * b(k,94) + b(k,44) = b(k,44) - lu(k,706) * b(k,94) + b(k,43) = b(k,43) - lu(k,705) * b(k,94) + b(k,42) = b(k,42) - lu(k,704) * b(k,94) + b(k,41) = b(k,41) - lu(k,703) * b(k,94) + b(k,40) = b(k,40) - lu(k,702) * b(k,94) + b(k,37) = b(k,37) - lu(k,701) * b(k,94) + b(k,36) = b(k,36) - lu(k,700) * b(k,94) + b(k,35) = b(k,35) - lu(k,699) * b(k,94) + b(k,34) = b(k,34) - lu(k,698) * b(k,94) + b(k,31) = b(k,31) - lu(k,697) * b(k,94) + b(k,30) = b(k,30) - lu(k,696) * b(k,94) + b(k,29) = b(k,29) - lu(k,695) * b(k,94) + b(k,28) = b(k,28) - lu(k,694) * b(k,94) + b(k,27) = b(k,27) - lu(k,693) * b(k,94) + 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 + b(k,93) = b(k,93) * lu(k,683) + b(k,92) = b(k,92) - lu(k,682) * b(k,93) + b(k,91) = b(k,91) - lu(k,681) * b(k,93) + b(k,90) = b(k,90) - lu(k,680) * b(k,93) + b(k,89) = b(k,89) - lu(k,679) * b(k,93) + b(k,88) = b(k,88) - lu(k,678) * b(k,93) + b(k,87) = b(k,87) - lu(k,677) * b(k,93) + b(k,86) = b(k,86) - lu(k,676) * b(k,93) + b(k,85) = b(k,85) - lu(k,675) * b(k,93) + b(k,84) = b(k,84) - lu(k,674) * b(k,93) + b(k,83) = b(k,83) - lu(k,673) * b(k,93) + b(k,80) = b(k,80) - lu(k,672) * b(k,93) + b(k,79) = b(k,79) - lu(k,671) * b(k,93) + b(k,78) = b(k,78) - lu(k,670) * b(k,93) + b(k,77) = b(k,77) - lu(k,669) * b(k,93) + b(k,76) = b(k,76) - lu(k,668) * b(k,93) + b(k,75) = b(k,75) - lu(k,667) * b(k,93) + b(k,74) = b(k,74) - lu(k,666) * b(k,93) + b(k,72) = b(k,72) - lu(k,665) * b(k,93) + b(k,71) = b(k,71) - lu(k,664) * b(k,93) + b(k,70) = b(k,70) - lu(k,663) * b(k,93) + b(k,69) = b(k,69) - lu(k,662) * b(k,93) + b(k,68) = b(k,68) - lu(k,661) * b(k,93) + b(k,67) = b(k,67) - lu(k,660) * b(k,93) + b(k,66) = b(k,66) - lu(k,659) * b(k,93) + b(k,65) = b(k,65) - lu(k,658) * b(k,93) + b(k,64) = b(k,64) - lu(k,657) * b(k,93) + b(k,62) = b(k,62) - lu(k,656) * b(k,93) + b(k,60) = b(k,60) - lu(k,655) * b(k,93) + b(k,59) = b(k,59) - lu(k,654) * b(k,93) + b(k,53) = b(k,53) - lu(k,653) * b(k,93) + b(k,40) = b(k,40) - lu(k,652) * b(k,93) + b(k,39) = b(k,39) - lu(k,651) * b(k,93) + b(k,92) = b(k,92) * lu(k,640) + b(k,91) = b(k,91) - lu(k,639) * b(k,92) + b(k,90) = b(k,90) - lu(k,638) * b(k,92) + b(k,89) = b(k,89) - lu(k,637) * b(k,92) + b(k,88) = b(k,88) - lu(k,636) * b(k,92) + b(k,87) = b(k,87) - lu(k,635) * b(k,92) + b(k,85) = b(k,85) - lu(k,634) * b(k,92) + b(k,84) = b(k,84) - lu(k,633) * b(k,92) + b(k,83) = b(k,83) - lu(k,632) * b(k,92) + b(k,80) = b(k,80) - lu(k,631) * b(k,92) + b(k,79) = b(k,79) - lu(k,630) * b(k,92) + b(k,78) = b(k,78) - lu(k,629) * b(k,92) + b(k,75) = b(k,75) - lu(k,628) * b(k,92) + b(k,74) = b(k,74) - lu(k,627) * b(k,92) + b(k,68) = b(k,68) - lu(k,626) * b(k,92) + b(k,62) = b(k,62) - lu(k,625) * b(k,92) + b(k,57) = b(k,57) - lu(k,624) * b(k,92) + b(k,50) = b(k,50) - lu(k,623) * b(k,92) + b(k,46) = b(k,46) - lu(k,622) * b(k,92) + b(k,91) = b(k,91) * lu(k,610) + b(k,90) = b(k,90) - lu(k,609) * b(k,91) + b(k,89) = b(k,89) - lu(k,608) * b(k,91) + b(k,88) = b(k,88) - lu(k,607) * b(k,91) + b(k,87) = b(k,87) - lu(k,606) * b(k,91) + b(k,86) = b(k,86) - lu(k,605) * b(k,91) + b(k,85) = b(k,85) - lu(k,604) * b(k,91) + b(k,84) = b(k,84) - lu(k,603) * b(k,91) + b(k,83) = b(k,83) - lu(k,602) * b(k,91) + b(k,82) = b(k,82) - lu(k,601) * b(k,91) + b(k,75) = b(k,75) - lu(k,600) * b(k,91) + b(k,74) = b(k,74) - lu(k,599) * b(k,91) + b(k,70) = b(k,70) - lu(k,598) * b(k,91) + b(k,52) = b(k,52) - lu(k,597) * b(k,91) + b(k,45) = b(k,45) - lu(k,596) * b(k,91) + b(k,38) = b(k,38) - lu(k,595) * b(k,91) + b(k,26) = b(k,26) - lu(k,594) * b(k,91) + b(k,90) = b(k,90) * lu(k,581) + b(k,89) = b(k,89) - lu(k,580) * b(k,90) + b(k,88) = b(k,88) - lu(k,579) * b(k,90) + b(k,87) = b(k,87) - lu(k,578) * b(k,90) + b(k,86) = b(k,86) - lu(k,577) * b(k,90) + b(k,84) = b(k,84) - lu(k,576) * b(k,90) + b(k,83) = b(k,83) - lu(k,575) * b(k,90) + b(k,80) = b(k,80) - lu(k,574) * b(k,90) + b(k,79) = b(k,79) - lu(k,573) * b(k,90) + b(k,74) = b(k,74) - lu(k,572) * b(k,90) + b(k,72) = b(k,72) - lu(k,571) * b(k,90) + b(k,51) = b(k,51) - lu(k,570) * b(k,90) + b(k,50) = b(k,50) - lu(k,569) * b(k,90) + b(k,89) = b(k,89) * lu(k,555) + b(k,88) = b(k,88) - lu(k,554) * b(k,89) + b(k,87) = b(k,87) - lu(k,553) * b(k,89) + b(k,86) = b(k,86) - lu(k,552) * b(k,89) + b(k,85) = b(k,85) - lu(k,551) * b(k,89) + b(k,84) = b(k,84) - lu(k,550) * b(k,89) + b(k,82) = b(k,82) - lu(k,549) * b(k,89) + b(k,70) = b(k,70) - lu(k,548) * b(k,89) + b(k,69) = b(k,69) - lu(k,547) * b(k,89) + b(k,68) = b(k,68) - lu(k,546) * b(k,89) + b(k,65) = b(k,65) - lu(k,545) * b(k,89) + b(k,57) = b(k,57) - lu(k,544) * b(k,89) + b(k,55) = b(k,55) - lu(k,543) * b(k,89) + b(k,88) = b(k,88) * lu(k,529) + b(k,87) = b(k,87) - lu(k,528) * b(k,88) + b(k,84) = b(k,84) - lu(k,527) * b(k,88) + b(k,83) = b(k,83) - lu(k,526) * b(k,88) + b(k,74) = b(k,74) - lu(k,525) * b(k,88) + b(k,66) = b(k,66) - lu(k,524) * b(k,88) + b(k,40) = b(k,40) - lu(k,523) * b(k,88) + b(k,39) = b(k,39) - lu(k,522) * b(k,88) + b(k,87) = b(k,87) * lu(k,508) + b(k,84) = b(k,84) - lu(k,507) * b(k,87) + b(k,83) = b(k,83) - lu(k,506) * b(k,87) + b(k,80) = b(k,80) - lu(k,505) * b(k,87) + b(k,79) = b(k,79) - lu(k,504) * b(k,87) + b(k,78) = b(k,78) - lu(k,503) * b(k,87) + b(k,77) = b(k,77) - lu(k,502) * b(k,87) + b(k,76) = b(k,76) - lu(k,501) * b(k,87) + b(k,74) = b(k,74) - lu(k,500) * b(k,87) + b(k,71) = b(k,71) - lu(k,499) * b(k,87) + b(k,67) = b(k,67) - lu(k,498) * b(k,87) + b(k,66) = b(k,66) - lu(k,497) * b(k,87) + b(k,64) = b(k,64) - lu(k,496) * b(k,87) + b(k,60) = b(k,60) - lu(k,495) * b(k,87) + b(k,59) = b(k,59) - lu(k,494) * b(k,87) + b(k,40) = b(k,40) - lu(k,493) * b(k,87) + b(k,39) = b(k,39) - lu(k,492) * b(k,87) + b(k,86) = b(k,86) * lu(k,475) + b(k,85) = b(k,85) - lu(k,474) * b(k,86) + b(k,84) = b(k,84) - lu(k,473) * b(k,86) + b(k,80) = b(k,80) - lu(k,472) * b(k,86) + b(k,79) = b(k,79) - lu(k,471) * b(k,86) + b(k,72) = b(k,72) - lu(k,470) * b(k,86) + b(k,69) = b(k,69) - lu(k,469) * b(k,86) + b(k,85) = b(k,85) * lu(k,453) + b(k,84) = b(k,84) - lu(k,452) * b(k,85) + b(k,75) = b(k,75) - lu(k,451) * b(k,85) + b(k,70) = b(k,70) - lu(k,450) * b(k,85) + b(k,68) = b(k,68) - lu(k,449) * b(k,85) + b(k,45) = b(k,45) - lu(k,448) * b(k,85) + b(k,38) = b(k,38) - lu(k,447) * b(k,85) + b(k,84) = b(k,84) * lu(k,439) + b(k,83) = b(k,83) * lu(k,425) + b(k,74) = b(k,74) - lu(k,424) * b(k,83) + b(k,66) = b(k,66) - lu(k,423) * b(k,83) + b(k,52) = b(k,52) - lu(k,422) * b(k,83) + b(k,82) = b(k,82) * lu(k,411) + b(k,55) = b(k,55) - lu(k,410) * b(k,82) + b(k,81) = b(k,81) * lu(k,393) + b(k,80) = b(k,80) - lu(k,392) * b(k,81) + b(k,79) = b(k,79) - lu(k,391) * b(k,81) + b(k,73) = b(k,73) - lu(k,390) * b(k,81) + b(k,72) = b(k,72) - lu(k,389) * b(k,81) + b(k,61) = b(k,61) - lu(k,388) * b(k,81) + b(k,49) = b(k,49) - lu(k,387) * b(k,81) + b(k,80) = b(k,80) * lu(k,378) + b(k,79) = b(k,79) - lu(k,377) * b(k,80) + b(k,78) = b(k,78) - lu(k,376) * b(k,80) + b(k,77) = b(k,77) - lu(k,375) * b(k,80) + b(k,76) = b(k,76) - lu(k,374) * b(k,80) + b(k,72) = b(k,72) - lu(k,373) * b(k,80) + b(k,71) = b(k,71) - lu(k,372) * b(k,80) + b(k,67) = b(k,67) - lu(k,371) * b(k,80) + b(k,61) = b(k,61) - lu(k,370) * b(k,80) + b(k,79) = b(k,79) * lu(k,361) + b(k,78) = b(k,78) - lu(k,360) * b(k,79) + b(k,77) = b(k,77) - lu(k,359) * b(k,79) + b(k,76) = b(k,76) - lu(k,358) * b(k,79) + b(k,67) = b(k,67) - lu(k,357) * b(k,79) + b(k,78) = b(k,78) * lu(k,347) + b(k,77) = b(k,77) - lu(k,346) * b(k,78) + b(k,76) = b(k,76) - lu(k,345) * b(k,78) + b(k,71) = b(k,71) - lu(k,344) * b(k,78) + b(k,67) = b(k,67) - lu(k,343) * b(k,78) + b(k,46) = b(k,46) - lu(k,342) * b(k,78) + b(k,77) = b(k,77) * lu(k,334) + b(k,76) = b(k,76) - lu(k,333) * b(k,77) + b(k,71) = b(k,71) - lu(k,332) * b(k,77) + b(k,76) = b(k,76) * lu(k,323) + b(k,71) = b(k,71) - lu(k,322) * b(k,76) + b(k,67) = b(k,67) - lu(k,321) * b(k,76) + b(k,64) = b(k,64) - lu(k,320) * b(k,76) + b(k,60) = b(k,60) - lu(k,319) * b(k,76) + b(k,59) = b(k,59) - lu(k,318) * b(k,76) + b(k,75) = b(k,75) * lu(k,308) + b(k,70) = b(k,70) - lu(k,307) * b(k,75) + b(k,38) = b(k,38) - lu(k,306) * b(k,75) + b(k,74) = b(k,74) * lu(k,300) + b(k,47) = b(k,47) - lu(k,299) * b(k,74) + b(k,73) = b(k,73) * lu(k,290) + b(k,49) = b(k,49) - lu(k,289) * b(k,73) + b(k,72) = b(k,72) * lu(k,282) + b(k,61) = b(k,61) - lu(k,281) * b(k,72) + b(k,71) = b(k,71) * lu(k,273) + b(k,67) = b(k,67) - lu(k,272) * b(k,71) + b(k,70) = b(k,70) * lu(k,265) + b(k,38) = b(k,38) - lu(k,264) * b(k,70) + b(k,69) = b(k,69) * lu(k,256) + b(k,68) = b(k,68) * lu(k,248) + b(k,45) = b(k,45) - lu(k,247) * b(k,68) + b(k,67) = b(k,67) * lu(k,242) + b(k,66) = b(k,66) * lu(k,235) + b(k,65) = b(k,65) * lu(k,228) + b(k,64) = b(k,64) * lu(k,219) + b(k,63) = b(k,63) * lu(k,210) + b(k,62) = b(k,62) * lu(k,202) + b(k,61) = b(k,61) * lu(k,196) + b(k,40) = b(k,40) - lu(k,195) * b(k,61) + b(k,39) = b(k,39) - lu(k,194) * b(k,61) + 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,60) = b(k,60) * lu(k,188) + b(k,59) = b(k,59) * lu(k,181) + b(k,58) = b(k,58) * lu(k,174) + b(k,57) = b(k,57) * lu(k,167) + b(k,56) = b(k,56) * lu(k,161) + b(k,55) = b(k,55) * lu(k,155) + b(k,54) = b(k,54) * lu(k,147) + b(k,53) = b(k,53) * lu(k,139) + b(k,52) = b(k,52) * lu(k,134) + b(k,51) = b(k,51) * lu(k,128) + b(k,50) = b(k,50) * lu(k,122) + b(k,49) = b(k,49) * lu(k,119) + b(k,48) = b(k,48) * lu(k,113) + b(k,41) = b(k,41) - lu(k,112) * b(k,48) + b(k,47) = b(k,47) * lu(k,108) + b(k,33) = b(k,33) - lu(k,107) * b(k,47) + b(k,46) = b(k,46) * lu(k,103) + b(k,45) = b(k,45) * lu(k,100) + b(k,44) = b(k,44) * lu(k,95) + b(k,41) = b(k,41) - lu(k,94) * b(k,44) + b(k,43) = b(k,43) * lu(k,90) + b(k,42) = b(k,42) * lu(k,85) + b(k,41) = b(k,41) * lu(k,82) + b(k,40) = b(k,40) * lu(k,80) + b(k,39) = b(k,39) - lu(k,79) * b(k,40) + b(k,39) = b(k,39) * lu(k,77) + b(k,38) = b(k,38) * lu(k,75) + b(k,37) = b(k,37) * lu(k,70) + b(k,36) = b(k,36) * lu(k,65) + b(k,35) = b(k,35) * lu(k,60) + b(k,34) = b(k,34) * lu(k,55) + b(k,33) = b(k,33) * lu(k,52) + b(k,32) = b(k,32) * lu(k,48) + b(k,31) = b(k,31) * lu(k,44) + b(k,30) = b(k,30) * lu(k,40) + b(k,29) = b(k,29) * lu(k,36) + b(k,28) = b(k,28) * lu(k,32) + b(k,27) = b(k,27) * lu(k,29) + b(k,26) = b(k,26) * lu(k,26) + b(k,25) = b(k,25) * lu(k,25) + b(k,24) = b(k,24) * lu(k,24) + b(k,23) = b(k,23) * lu(k,23) + b(k,22) = b(k,22) * lu(k,22) + b(k,21) = b(k,21) * lu(k,21) + b(k,20) = b(k,20) * lu(k,20) + b(k,19) = b(k,19) * lu(k,19) + b(k,18) = b(k,18) * lu(k,18) + b(k,17) = b(k,17) * lu(k,17) + b(k,16) = b(k,16) * lu(k,16) + b(k,15) = b(k,15) * lu(k,15) + b(k,14) = b(k,14) * lu(k,14) + b(k,13) = b(k,13) * lu(k,13) + b(k,12) = b(k,12) * lu(k,12) + b(k,11) = b(k,11) * lu(k,11) + b(k,10) = b(k,10) * lu(k,10) + 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_slv06 + 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 ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_ma_mam5/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_ma_mam5/mo_nln_matrix.F90 new file mode 100644 index 0000000000..fcd1810f01 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/mo_nln_matrix.F90 @@ -0,0 +1,1618 @@ + 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,808) = -(rxt(k,191)*y(k,17) + rxt(k,192)*y(k,90) + rxt(k,193)*y(k,71)) + mat(k,486) = -rxt(k,191)*y(k,3) + mat(k,563) = -rxt(k,192)*y(k,3) + mat(k,538) = -rxt(k,193)*y(k,3) + mat(k,927) = 4.000_r8*rxt(k,194)*y(k,5) + (rxt(k,195)+rxt(k,196))*y(k,28) & + + rxt(k,199)*y(k,61) + rxt(k,202)*y(k,69) + rxt(k,253)*y(k,79) & + + rxt(k,203)*y(k,99) + mat(k,59) = rxt(k,181)*y(k,95) + mat(k,64) = rxt(k,207)*y(k,95) + mat(k,178) = 2.000_r8*rxt(k,218)*y(k,25) + 2.000_r8*rxt(k,230)*y(k,95) & + + 2.000_r8*rxt(k,219)*y(k,99) + mat(k,216) = rxt(k,220)*y(k,25) + rxt(k,231)*y(k,95) + rxt(k,221)*y(k,99) + mat(k,165) = 3.000_r8*rxt(k,225)*y(k,25) + 3.000_r8*rxt(k,208)*y(k,95) & + + 3.000_r8*rxt(k,226)*y(k,99) + mat(k,786) = 2.000_r8*rxt(k,218)*y(k,16) + rxt(k,220)*y(k,18) & + + 3.000_r8*rxt(k,225)*y(k,24) + mat(k,616) = (rxt(k,195)+rxt(k,196))*y(k,5) + mat(k,35) = 2.000_r8*rxt(k,209)*y(k,95) + mat(k,260) = rxt(k,204)*y(k,69) + rxt(k,210)*y(k,95) + rxt(k,205)*y(k,99) + mat(k,754) = rxt(k,199)*y(k,5) + mat(k,687) = rxt(k,202)*y(k,5) + rxt(k,204)*y(k,45) + mat(k,435) = rxt(k,253)*y(k,5) + mat(k,729) = rxt(k,181)*y(k,9) + rxt(k,207)*y(k,10) + 2.000_r8*rxt(k,230) & + *y(k,16) + rxt(k,231)*y(k,18) + 3.000_r8*rxt(k,208)*y(k,24) & + + 2.000_r8*rxt(k,209)*y(k,42) + rxt(k,210)*y(k,45) + mat(k,857) = rxt(k,203)*y(k,5) + 2.000_r8*rxt(k,219)*y(k,16) + rxt(k,221) & + *y(k,18) + 3.000_r8*rxt(k,226)*y(k,24) + rxt(k,205)*y(k,45) + mat(k,909) = rxt(k,197)*y(k,28) + mat(k,596) = rxt(k,197)*y(k,5) + mat(k,448) = (rxt(k,275)+rxt(k,280))*y(k,53) + mat(k,247) = (rxt(k,275)+rxt(k,280))*y(k,49) + mat(k,931) = -(4._r8*rxt(k,194)*y(k,5) + (rxt(k,195) + rxt(k,196) + rxt(k,197) & + ) * y(k,28) + rxt(k,198)*y(k,90) + rxt(k,199)*y(k,61) + rxt(k,200) & + *y(k,62) + rxt(k,202)*y(k,69) + rxt(k,203)*y(k,99) + rxt(k,253) & + *y(k,79)) + mat(k,620) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,5) + mat(k,567) = -rxt(k,198)*y(k,5) + mat(k,758) = -rxt(k,199)*y(k,5) + mat(k,649) = -rxt(k,200)*y(k,5) + mat(k,691) = -rxt(k,202)*y(k,5) + mat(k,861) = -rxt(k,203)*y(k,5) + mat(k,437) = -rxt(k,253)*y(k,5) + mat(k,812) = rxt(k,193)*y(k,71) + mat(k,209) = rxt(k,201)*y(k,69) + mat(k,262) = rxt(k,211)*y(k,95) + mat(k,254) = rxt(k,206)*y(k,69) + mat(k,691) = mat(k,691) + rxt(k,201)*y(k,6) + rxt(k,206)*y(k,53) + mat(k,541) = rxt(k,193)*y(k,3) + mat(k,733) = rxt(k,211)*y(k,45) + mat(k,202) = -(rxt(k,201)*y(k,69)) + mat(k,656) = -rxt(k,201)*y(k,6) + mat(k,911) = rxt(k,200)*y(k,62) + mat(k,625) = rxt(k,200)*y(k,5) + mat(k,29) = -(rxt(k,180)*y(k,95)) + mat(k,693) = -rxt(k,180)*y(k,8) + mat(k,55) = -(rxt(k,181)*y(k,95)) + mat(k,698) = -rxt(k,181)*y(k,9) + mat(k,60) = -(rxt(k,207)*y(k,95)) + mat(k,699) = -rxt(k,207)*y(k,10) + mat(k,36) = -(rxt(k,182)*y(k,95)) + mat(k,695) = -rxt(k,182)*y(k,11) + mat(k,65) = -(rxt(k,183)*y(k,95)) + mat(k,700) = -rxt(k,183)*y(k,12) + mat(k,40) = -(rxt(k,184)*y(k,95)) + mat(k,696) = -rxt(k,184)*y(k,13) + mat(k,70) = -(rxt(k,185)*y(k,95)) + mat(k,701) = -rxt(k,185)*y(k,14) + mat(k,44) = -(rxt(k,186)*y(k,95)) + mat(k,697) = -rxt(k,186)*y(k,15) + mat(k,174) = -(rxt(k,218)*y(k,25) + rxt(k,219)*y(k,99) + rxt(k,230)*y(k,95)) + mat(k,763) = -rxt(k,218)*y(k,16) + mat(k,827) = -rxt(k,219)*y(k,16) + mat(k,710) = -rxt(k,230)*y(k,16) + mat(k,475) = -(rxt(k,155)*y(k,25) + rxt(k,191)*y(k,3) + rxt(k,235)*y(k,63) & + + rxt(k,236)*y(k,69) + rxt(k,237)*y(k,99)) + mat(k,775) = -rxt(k,155)*y(k,17) + mat(k,797) = -rxt(k,191)*y(k,17) + mat(k,577) = -rxt(k,235)*y(k,17) + mat(k,676) = -rxt(k,236)*y(k,17) + mat(k,846) = -rxt(k,237)*y(k,17) + mat(k,413) = rxt(k,162)*y(k,28) + rxt(k,239)*y(k,61) + mat(k,158) = .300_r8*rxt(k,240)*y(k,99) + mat(k,397) = (rxt(k,243)+rxt(k,244))*y(k,95) + mat(k,605) = rxt(k,162)*y(k,21) + mat(k,743) = rxt(k,239)*y(k,21) + mat(k,718) = (rxt(k,243)+rxt(k,244))*y(k,23) + mat(k,846) = mat(k,846) + .300_r8*rxt(k,240)*y(k,22) + mat(k,210) = -(rxt(k,220)*y(k,25) + rxt(k,221)*y(k,99) + rxt(k,231)*y(k,95)) + mat(k,764) = -rxt(k,220)*y(k,18) + mat(k,829) = -rxt(k,221)*y(k,18) + mat(k,711) = -rxt(k,231)*y(k,18) + mat(k,48) = -(rxt(k,222)*y(k,99)) + mat(k,814) = -rxt(k,222)*y(k,19) + mat(k,147) = -(rxt(k,223)*y(k,25) + rxt(k,224)*y(k,99)) + mat(k,761) = -rxt(k,223)*y(k,20) + mat(k,823) = -rxt(k,224)*y(k,20) + mat(k,411) = -(rxt(k,162)*y(k,28) + rxt(k,238)*y(k,90) + rxt(k,239)*y(k,61)) + mat(k,601) = -rxt(k,162)*y(k,21) + mat(k,549) = -rxt(k,238)*y(k,21) + mat(k,741) = -rxt(k,239)*y(k,21) + mat(k,156) = .700_r8*rxt(k,240)*y(k,99) + mat(k,394) = rxt(k,156)*y(k,25) + rxt(k,212)*y(k,39) + rxt(k,242)*y(k,95) & + + rxt(k,241)*y(k,99) + mat(k,772) = rxt(k,156)*y(k,23) + mat(k,292) = rxt(k,212)*y(k,23) + mat(k,715) = rxt(k,242)*y(k,23) + mat(k,842) = .700_r8*rxt(k,240)*y(k,22) + rxt(k,241)*y(k,23) + mat(k,155) = -(rxt(k,240)*y(k,99)) + mat(k,824) = -rxt(k,240)*y(k,22) + mat(k,410) = rxt(k,238)*y(k,90) + mat(k,543) = rxt(k,238)*y(k,21) + mat(k,393) = -(rxt(k,156)*y(k,25) + rxt(k,212)*y(k,39) + rxt(k,241)*y(k,99) & + + (rxt(k,242) + rxt(k,243) + rxt(k,244)) * y(k,95)) + mat(k,771) = -rxt(k,156)*y(k,23) + mat(k,291) = -rxt(k,212)*y(k,23) + mat(k,841) = -rxt(k,241)*y(k,23) + mat(k,714) = -(rxt(k,242) + rxt(k,243) + rxt(k,244)) * y(k,23) + mat(k,161) = -(rxt(k,208)*y(k,95) + rxt(k,225)*y(k,25) + rxt(k,226)*y(k,99)) + mat(k,709) = -rxt(k,208)*y(k,24) + mat(k,762) = -rxt(k,225)*y(k,24) + mat(k,825) = -rxt(k,226)*y(k,24) + mat(k,785) = -(rxt(k,155)*y(k,17) + rxt(k,156)*y(k,23) + rxt(k,157)*y(k,41) & + + rxt(k,158)*y(k,43) + (rxt(k,159) + rxt(k,160)) * y(k,90) & + + rxt(k,161)*y(k,71) + rxt(k,168)*y(k,29) + rxt(k,177)*y(k,54) & + + rxt(k,218)*y(k,16) + rxt(k,220)*y(k,18) + rxt(k,223)*y(k,20) & + + rxt(k,225)*y(k,24)) + mat(k,485) = -rxt(k,155)*y(k,25) + mat(k,405) = -rxt(k,156)*y(k,25) + mat(k,879) = -rxt(k,157)*y(k,25) + mat(k,232) = -rxt(k,158)*y(k,25) + mat(k,562) = -(rxt(k,159) + rxt(k,160)) * y(k,25) + mat(k,537) = -rxt(k,161)*y(k,25) + mat(k,314) = -rxt(k,168)*y(k,25) + mat(k,269) = -rxt(k,177)*y(k,25) + mat(k,177) = -rxt(k,218)*y(k,25) + mat(k,215) = -rxt(k,220)*y(k,25) + mat(k,152) = -rxt(k,223)*y(k,25) + mat(k,164) = -rxt(k,225)*y(k,25) + mat(k,926) = rxt(k,196)*y(k,28) + mat(k,31) = 4.000_r8*rxt(k,180)*y(k,95) + mat(k,58) = rxt(k,181)*y(k,95) + mat(k,39) = 2.000_r8*rxt(k,182)*y(k,95) + mat(k,69) = 2.000_r8*rxt(k,183)*y(k,95) + mat(k,43) = 2.000_r8*rxt(k,184)*y(k,95) + mat(k,74) = rxt(k,185)*y(k,95) + mat(k,47) = 2.000_r8*rxt(k,186)*y(k,95) + mat(k,49) = 3.000_r8*rxt(k,222)*y(k,99) + mat(k,152) = mat(k,152) + rxt(k,224)*y(k,99) + mat(k,419) = rxt(k,162)*y(k,28) + mat(k,615) = rxt(k,196)*y(k,5) + rxt(k,162)*y(k,21) + (4.000_r8*rxt(k,163) & + +2.000_r8*rxt(k,165))*y(k,28) + rxt(k,167)*y(k,61) + rxt(k,172) & + *y(k,69) + rxt(k,254)*y(k,79) + rxt(k,173)*y(k,99) + mat(k,93) = rxt(k,217)*y(k,95) + mat(k,88) = rxt(k,232)*y(k,95) + rxt(k,227)*y(k,99) + mat(k,98) = rxt(k,233)*y(k,95) + rxt(k,228)*y(k,99) + mat(k,116) = rxt(k,234)*y(k,95) + rxt(k,229)*y(k,99) + mat(k,462) = rxt(k,175)*y(k,69) + rxt(k,187)*y(k,95) + rxt(k,176)*y(k,99) + mat(k,753) = rxt(k,167)*y(k,28) + mat(k,686) = rxt(k,172)*y(k,28) + rxt(k,175)*y(k,49) + mat(k,434) = rxt(k,254)*y(k,28) + mat(k,728) = 4.000_r8*rxt(k,180)*y(k,8) + rxt(k,181)*y(k,9) & + + 2.000_r8*rxt(k,182)*y(k,11) + 2.000_r8*rxt(k,183)*y(k,12) & + + 2.000_r8*rxt(k,184)*y(k,13) + rxt(k,185)*y(k,14) & + + 2.000_r8*rxt(k,186)*y(k,15) + rxt(k,217)*y(k,34) + rxt(k,232) & + *y(k,46) + rxt(k,233)*y(k,47) + rxt(k,234)*y(k,48) + rxt(k,187) & + *y(k,49) + mat(k,856) = 3.000_r8*rxt(k,222)*y(k,19) + rxt(k,224)*y(k,20) + rxt(k,173) & + *y(k,28) + rxt(k,227)*y(k,46) + rxt(k,228)*y(k,47) + rxt(k,229) & + *y(k,48) + rxt(k,176)*y(k,49) + mat(k,760) = rxt(k,168)*y(k,29) + mat(k,595) = 2.000_r8*rxt(k,164)*y(k,28) + mat(k,306) = rxt(k,168)*y(k,25) + (rxt(k,273)+rxt(k,278)+rxt(k,283))*y(k,49) + mat(k,447) = (rxt(k,273)+rxt(k,278)+rxt(k,283))*y(k,29) + (rxt(k,268) & + +rxt(k,274)+rxt(k,279))*y(k,54) + mat(k,264) = (rxt(k,268)+rxt(k,274)+rxt(k,279))*y(k,49) + mat(k,594) = 2.000_r8*rxt(k,189)*y(k,28) + mat(k,610) = -(rxt(k,162)*y(k,21) + (4._r8*rxt(k,163) + 4._r8*rxt(k,164) & + + 4._r8*rxt(k,165) + 4._r8*rxt(k,189)) * y(k,28) + rxt(k,166) & + *y(k,90) + rxt(k,167)*y(k,61) + rxt(k,169)*y(k,62) + rxt(k,172) & + *y(k,69) + (rxt(k,173) + rxt(k,174)) * y(k,99) + (rxt(k,195) & + + rxt(k,196) + rxt(k,197)) * y(k,5) + rxt(k,254)*y(k,79)) + mat(k,416) = -rxt(k,162)*y(k,28) + mat(k,557) = -rxt(k,166)*y(k,28) + mat(k,748) = -rxt(k,167)*y(k,28) + mat(k,639) = -rxt(k,169)*y(k,28) + mat(k,681) = -rxt(k,172)*y(k,28) + mat(k,851) = -(rxt(k,173) + rxt(k,174)) * y(k,28) + mat(k,921) = -(rxt(k,195) + rxt(k,196) + rxt(k,197)) * y(k,28) + mat(k,430) = -rxt(k,254)*y(k,28) + mat(k,780) = rxt(k,177)*y(k,54) + rxt(k,161)*y(k,71) + rxt(k,160)*y(k,90) + mat(k,311) = rxt(k,170)*y(k,69) + mat(k,458) = rxt(k,188)*y(k,95) + mat(k,267) = rxt(k,177)*y(k,25) + rxt(k,178)*y(k,69) + rxt(k,179)*y(k,99) + mat(k,681) = mat(k,681) + rxt(k,170)*y(k,29) + rxt(k,178)*y(k,54) + mat(k,532) = rxt(k,161)*y(k,25) + mat(k,137) = rxt(k,259)*y(k,79) + mat(k,430) = mat(k,430) + rxt(k,259)*y(k,73) + mat(k,557) = mat(k,557) + rxt(k,160)*y(k,25) + mat(k,723) = rxt(k,188)*y(k,49) + mat(k,851) = mat(k,851) + rxt(k,179)*y(k,54) + mat(k,308) = -(rxt(k,168)*y(k,25) + rxt(k,170)*y(k,69) + rxt(k,171)*y(k,99) & + + (rxt(k,273) + rxt(k,278) + rxt(k,283)) * y(k,49)) + mat(k,768) = -rxt(k,168)*y(k,29) + mat(k,667) = -rxt(k,170)*y(k,29) + mat(k,837) = -rxt(k,171)*y(k,29) + mat(k,451) = -(rxt(k,273) + rxt(k,278) + rxt(k,283)) * y(k,29) + mat(k,600) = rxt(k,169)*y(k,62) + mat(k,628) = rxt(k,169)*y(k,28) + 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,282) = -(rxt(k,245)*y(k,99)) + mat(k,834) = -rxt(k,245)*y(k,31) + mat(k,793) = rxt(k,191)*y(k,17) + mat(k,470) = rxt(k,191)*y(k,3) + rxt(k,155)*y(k,25) + rxt(k,235)*y(k,63) & + + rxt(k,236)*y(k,69) + rxt(k,237)*y(k,99) + mat(k,148) = rxt(k,223)*y(k,25) + mat(k,767) = rxt(k,155)*y(k,17) + rxt(k,223)*y(k,20) + mat(k,197) = rxt(k,299)*y(k,100) + mat(k,571) = rxt(k,235)*y(k,17) + mat(k,665) = rxt(k,236)*y(k,17) + rxt(k,248)*y(k,74) + mat(k,141) = rxt(k,248)*y(k,69) + rxt(k,249)*y(k,99) + mat(k,834) = mat(k,834) + rxt(k,237)*y(k,17) + rxt(k,249)*y(k,74) + mat(k,373) = rxt(k,299)*y(k,32) + mat(k,196) = -(rxt(k,299)*y(k,100)) + mat(k,370) = -rxt(k,299)*y(k,32) + mat(k,281) = rxt(k,245)*y(k,99) + mat(k,828) = rxt(k,245)*y(k,31) + mat(k,82) = -(rxt(k,216)*y(k,95)) + mat(k,703) = -rxt(k,216)*y(k,33) + mat(k,56) = rxt(k,181)*y(k,95) + mat(k,61) = rxt(k,207)*y(k,95) + mat(k,66) = rxt(k,183)*y(k,95) + mat(k,41) = 2.000_r8*rxt(k,184)*y(k,95) + mat(k,71) = 2.000_r8*rxt(k,185)*y(k,95) + mat(k,45) = rxt(k,186)*y(k,95) + mat(k,33) = 2.000_r8*rxt(k,209)*y(k,95) + mat(k,94) = rxt(k,233)*y(k,95) + rxt(k,228)*y(k,99) + mat(k,112) = rxt(k,234)*y(k,95) + rxt(k,229)*y(k,99) + mat(k,703) = mat(k,703) + rxt(k,181)*y(k,9) + rxt(k,207)*y(k,10) + rxt(k,183) & + *y(k,12) + 2.000_r8*rxt(k,184)*y(k,13) + 2.000_r8*rxt(k,185) & + *y(k,14) + rxt(k,186)*y(k,15) + 2.000_r8*rxt(k,209)*y(k,42) & + + rxt(k,233)*y(k,47) + rxt(k,234)*y(k,48) + mat(k,815) = rxt(k,228)*y(k,47) + rxt(k,229)*y(k,48) + mat(k,90) = -(rxt(k,217)*y(k,95)) + mat(k,705) = -rxt(k,217)*y(k,34) + mat(k,37) = rxt(k,182)*y(k,95) + mat(k,67) = rxt(k,183)*y(k,95) + mat(k,86) = rxt(k,232)*y(k,95) + rxt(k,227)*y(k,99) + mat(k,705) = mat(k,705) + rxt(k,182)*y(k,11) + rxt(k,183)*y(k,12) & + + rxt(k,232)*y(k,46) + mat(k,817) = rxt(k,227)*y(k,46) + mat(k,128) = -(rxt(k,246)*y(k,63) + (rxt(k,247) + rxt(k,261)) * y(k,99)) + mat(k,570) = -rxt(k,246)*y(k,35) + mat(k,821) = -(rxt(k,247) + rxt(k,261)) * y(k,35) + mat(k,290) = -(rxt(k,212)*y(k,23) + rxt(k,213)*y(k,41) + rxt(k,214)*y(k,103) & + + rxt(k,215)*y(k,51)) + mat(k,390) = -rxt(k,212)*y(k,39) + mat(k,864) = -rxt(k,213)*y(k,39) + mat(k,936) = -rxt(k,214)*y(k,39) + mat(k,887) = -rxt(k,215)*y(k,39) + mat(k,62) = rxt(k,207)*y(k,95) + mat(k,72) = rxt(k,185)*y(k,95) + mat(k,83) = 2.000_r8*rxt(k,216)*y(k,95) + mat(k,91) = rxt(k,217)*y(k,95) + mat(k,713) = rxt(k,207)*y(k,10) + rxt(k,185)*y(k,14) + 2.000_r8*rxt(k,216) & + *y(k,33) + rxt(k,217)*y(k,34) + mat(k,439) = -((rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,90) + rxt(k,116) & + *y(k,70) + rxt(k,119)*y(k,71)) + mat(k,550) = -(rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,40) + mat(k,507) = -rxt(k,116)*y(k,40) + mat(k,527) = -rxt(k,119)*y(k,40) + mat(k,473) = rxt(k,237)*y(k,99) + mat(k,395) = rxt(k,243)*y(k,95) + mat(k,773) = rxt(k,157)*y(k,41) + mat(k,293) = rxt(k,213)*y(k,41) + mat(k,867) = rxt(k,157)*y(k,25) + rxt(k,213)*y(k,39) + rxt(k,111)*y(k,69) & + + rxt(k,94)*y(k,95) + rxt(k,120)*y(k,99) + mat(k,257) = rxt(k,211)*y(k,95) + mat(k,452) = rxt(k,188)*y(k,95) + mat(k,350) = rxt(k,143)*y(k,99) + mat(k,674) = rxt(k,111)*y(k,41) + rxt(k,123)*y(k,99) + mat(k,144) = rxt(k,249)*y(k,99) + mat(k,237) = rxt(k,255)*y(k,99) + mat(k,426) = rxt(k,260)*y(k,99) + mat(k,716) = rxt(k,243)*y(k,23) + rxt(k,94)*y(k,41) + rxt(k,211)*y(k,45) & + + rxt(k,188)*y(k,49) + mat(k,844) = rxt(k,237)*y(k,17) + rxt(k,120)*y(k,41) + rxt(k,143)*y(k,55) & + + rxt(k,123)*y(k,69) + rxt(k,249)*y(k,74) + rxt(k,255)*y(k,77) & + + rxt(k,260)*y(k,79) + mat(k,882) = -(rxt(k,94)*y(k,95) + rxt(k,111)*y(k,69) + rxt(k,120)*y(k,99) & + + rxt(k,157)*y(k,25) + rxt(k,213)*y(k,39)) + mat(k,731) = -rxt(k,94)*y(k,41) + mat(k,689) = -rxt(k,111)*y(k,41) + mat(k,859) = -rxt(k,120)*y(k,41) + mat(k,788) = -rxt(k,157)*y(k,41) + mat(k,296) = -rxt(k,213)*y(k,41) + mat(k,407) = rxt(k,244)*y(k,95) + mat(k,445) = rxt(k,113)*y(k,90) + mat(k,565) = rxt(k,113)*y(k,40) + mat(k,731) = mat(k,731) + rxt(k,244)*y(k,23) + mat(k,32) = -(rxt(k,209)*y(k,95)) + mat(k,694) = -rxt(k,209)*y(k,42) + mat(k,228) = -(rxt(k,112)*y(k,69) + rxt(k,121)*y(k,99) + rxt(k,158)*y(k,25)) + mat(k,658) = -rxt(k,112)*y(k,43) + mat(k,830) = -rxt(k,121)*y(k,43) + mat(k,765) = -rxt(k,158)*y(k,43) + mat(k,545) = 2.000_r8*rxt(k,127)*y(k,90) + mat(k,830) = mat(k,830) + 2.000_r8*rxt(k,126)*y(k,99) + mat(k,107) = rxt(k,262)*y(k,103) + mat(k,933) = rxt(k,262)*y(k,81) + mat(k,256) = -(rxt(k,204)*y(k,69) + rxt(k,205)*y(k,99) + (rxt(k,210) & + + rxt(k,211)) * y(k,95)) + mat(k,662) = -rxt(k,204)*y(k,45) + mat(k,832) = -rxt(k,205)*y(k,45) + mat(k,712) = -(rxt(k,210) + rxt(k,211)) * y(k,45) + mat(k,792) = rxt(k,191)*y(k,17) + rxt(k,192)*y(k,90) + mat(k,469) = rxt(k,191)*y(k,3) + mat(k,547) = rxt(k,192)*y(k,3) + mat(k,85) = -(rxt(k,227)*y(k,99) + rxt(k,232)*y(k,95)) + mat(k,816) = -rxt(k,227)*y(k,46) + mat(k,704) = -rxt(k,232)*y(k,46) + mat(k,95) = -(rxt(k,228)*y(k,99) + rxt(k,233)*y(k,95)) + mat(k,818) = -rxt(k,228)*y(k,47) + mat(k,706) = -rxt(k,233)*y(k,47) + mat(k,113) = -(rxt(k,229)*y(k,99) + rxt(k,234)*y(k,95)) + mat(k,820) = -rxt(k,229)*y(k,48) + mat(k,708) = -rxt(k,234)*y(k,48) + mat(k,453) = -(rxt(k,175)*y(k,69) + rxt(k,176)*y(k,99) + (rxt(k,187) & + + rxt(k,188)) * y(k,95) + (rxt(k,268) + rxt(k,274) + rxt(k,279) & + ) * y(k,54) + (rxt(k,273) + rxt(k,278) + rxt(k,283)) * y(k,29) & + + (rxt(k,275) + rxt(k,280)) * y(k,53)) + mat(k,675) = -rxt(k,175)*y(k,49) + mat(k,845) = -rxt(k,176)*y(k,49) + mat(k,717) = -(rxt(k,187) + rxt(k,188)) * y(k,49) + mat(k,266) = -(rxt(k,268) + rxt(k,274) + rxt(k,279)) * y(k,49) + mat(k,309) = -(rxt(k,273) + rxt(k,278) + rxt(k,283)) * y(k,49) + mat(k,249) = -(rxt(k,275) + rxt(k,280)) * y(k,49) + mat(k,175) = rxt(k,218)*y(k,25) + mat(k,474) = rxt(k,155)*y(k,25) + mat(k,212) = rxt(k,220)*y(k,25) + mat(k,150) = 2.000_r8*rxt(k,223)*y(k,25) + mat(k,396) = rxt(k,156)*y(k,25) + mat(k,162) = rxt(k,225)*y(k,25) + mat(k,774) = rxt(k,218)*y(k,16) + rxt(k,155)*y(k,17) + rxt(k,220)*y(k,18) & + + 2.000_r8*rxt(k,223)*y(k,20) + rxt(k,156)*y(k,23) + rxt(k,225) & + *y(k,24) + rxt(k,157)*y(k,41) + rxt(k,158)*y(k,43) + rxt(k,177) & + *y(k,54) + rxt(k,159)*y(k,90) + mat(k,604) = rxt(k,174)*y(k,99) + mat(k,868) = rxt(k,157)*y(k,25) + mat(k,229) = rxt(k,158)*y(k,25) + mat(k,266) = mat(k,266) + rxt(k,177)*y(k,25) + mat(k,551) = rxt(k,159)*y(k,25) + mat(k,845) = mat(k,845) + rxt(k,174)*y(k,28) + mat(k,387) = rxt(k,212)*y(k,39) + mat(k,289) = rxt(k,212)*y(k,23) + rxt(k,213)*y(k,41) + rxt(k,215)*y(k,51) & + + rxt(k,214)*y(k,103) + mat(k,863) = rxt(k,213)*y(k,39) + mat(k,886) = rxt(k,215)*y(k,39) + mat(k,935) = rxt(k,214)*y(k,39) + mat(k,906) = -(rxt(k,152)*y(k,99) + rxt(k,215)*y(k,39)) + mat(k,860) = -rxt(k,152)*y(k,51) + mat(k,297) = -rxt(k,215)*y(k,51) + mat(k,489) = rxt(k,235)*y(k,63) + mat(k,316) = (rxt(k,273)+rxt(k,278)+rxt(k,283))*y(k,49) + mat(k,133) = rxt(k,246)*y(k,63) + mat(k,466) = (rxt(k,273)+rxt(k,278)+rxt(k,283))*y(k,29) + mat(k,648) = rxt(k,151)*y(k,99) + mat(k,591) = rxt(k,235)*y(k,17) + rxt(k,246)*y(k,35) + mat(k,860) = mat(k,860) + rxt(k,151)*y(k,62) + mat(k,167) = -(rxt(k,128)*y(k,99)) + mat(k,826) = -rxt(k,128)*y(k,52) + mat(k,624) = rxt(k,149)*y(k,90) + mat(k,544) = rxt(k,149)*y(k,62) + mat(k,248) = -(rxt(k,206)*y(k,69) + (rxt(k,275) + rxt(k,280)) * y(k,49)) + mat(k,661) = -rxt(k,206)*y(k,53) + mat(k,449) = -(rxt(k,275) + rxt(k,280)) * y(k,53) + mat(k,912) = rxt(k,198)*y(k,90) + mat(k,546) = rxt(k,198)*y(k,5) + mat(k,265) = -(rxt(k,177)*y(k,25) + rxt(k,178)*y(k,69) + rxt(k,179)*y(k,99) & + + (rxt(k,268) + rxt(k,274) + rxt(k,279)) * y(k,49)) + mat(k,766) = -rxt(k,177)*y(k,54) + mat(k,663) = -rxt(k,178)*y(k,54) + mat(k,833) = -rxt(k,179)*y(k,54) + mat(k,450) = -(rxt(k,268) + rxt(k,274) + rxt(k,279)) * y(k,54) + mat(k,598) = rxt(k,166)*y(k,90) + mat(k,307) = rxt(k,171)*y(k,99) + mat(k,548) = rxt(k,166)*y(k,28) + mat(k,833) = mat(k,833) + rxt(k,171)*y(k,29) + mat(k,347) = -(rxt(k,131)*y(k,61) + (rxt(k,132) + rxt(k,133) + rxt(k,134) & + ) * y(k,62) + rxt(k,135)*y(k,70) + rxt(k,143)*y(k,99) + rxt(k,296) & + *y(k,98)) + mat(k,738) = -rxt(k,131)*y(k,55) + mat(k,629) = -(rxt(k,132) + rxt(k,133) + rxt(k,134)) * y(k,55) + mat(k,503) = -rxt(k,135)*y(k,55) + mat(k,838) = -rxt(k,143)*y(k,55) + mat(k,360) = -rxt(k,296)*y(k,55) + mat(k,670) = rxt(k,129)*y(k,91) + rxt(k,293)*y(k,94) + mat(k,503) = mat(k,503) + rxt(k,294)*y(k,94) + mat(k,325) = 1.100_r8*rxt(k,289)*y(k,92) + .200_r8*rxt(k,287)*y(k,93) + mat(k,335) = rxt(k,129)*y(k,69) + mat(k,223) = 1.100_r8*rxt(k,289)*y(k,89) + mat(k,245) = .200_r8*rxt(k,287)*y(k,89) + mat(k,276) = rxt(k,293)*y(k,69) + rxt(k,294)*y(k,70) + mat(k,103) = -((rxt(k,147) + rxt(k,148)) * y(k,95)) + mat(k,707) = -(rxt(k,147) + rxt(k,148)) * y(k,56) + mat(k,342) = rxt(k,132)*y(k,62) + mat(k,622) = rxt(k,132)*y(k,55) + mat(k,623) = rxt(k,150)*y(k,63) + mat(k,569) = rxt(k,150)*y(k,62) + mat(k,752) = -(rxt(k,131)*y(k,55) + rxt(k,140)*y(k,63) + rxt(k,144)*y(k,90) & + + rxt(k,145)*y(k,71) + rxt(k,146)*y(k,69) + rxt(k,167)*y(k,28) & + + rxt(k,199)*y(k,5) + rxt(k,239)*y(k,21) + rxt(k,298)*y(k,98)) + mat(k,355) = -rxt(k,131)*y(k,61) + mat(k,586) = -rxt(k,140)*y(k,61) + mat(k,561) = -rxt(k,144)*y(k,61) + mat(k,536) = -rxt(k,145)*y(k,61) + mat(k,685) = -rxt(k,146)*y(k,61) + mat(k,614) = -rxt(k,167)*y(k,61) + mat(k,925) = -rxt(k,199)*y(k,61) + mat(k,418) = -rxt(k,239)*y(k,61) + mat(k,368) = -rxt(k,298)*y(k,61) + mat(k,355) = mat(k,355) + 2.000_r8*rxt(k,133)*y(k,62) + rxt(k,135)*y(k,70) & + + rxt(k,143)*y(k,99) + mat(k,106) = 2.000_r8*rxt(k,147)*y(k,95) + mat(k,643) = 2.000_r8*rxt(k,133)*y(k,55) + rxt(k,136)*y(k,69) + rxt(k,256) & + *y(k,79) + mat(k,685) = mat(k,685) + rxt(k,136)*y(k,62) + mat(k,515) = rxt(k,135)*y(k,55) + rxt(k,130)*y(k,91) + mat(k,433) = rxt(k,256)*y(k,62) + mat(k,341) = rxt(k,130)*y(k,70) + mat(k,727) = 2.000_r8*rxt(k,147)*y(k,56) + mat(k,855) = rxt(k,143)*y(k,55) + 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,640) = -((rxt(k,132) + rxt(k,133) + rxt(k,134)) * y(k,55) + (rxt(k,136) & + + rxt(k,138)) * y(k,69) + rxt(k,137)*y(k,71) + rxt(k,149) & + *y(k,90) + rxt(k,150)*y(k,63) + rxt(k,151)*y(k,99) + rxt(k,169) & + *y(k,28) + rxt(k,200)*y(k,5) + rxt(k,256)*y(k,79)) + mat(k,352) = -(rxt(k,132) + rxt(k,133) + rxt(k,134)) * y(k,62) + mat(k,682) = -(rxt(k,136) + rxt(k,138)) * y(k,62) + mat(k,533) = -rxt(k,137)*y(k,62) + mat(k,558) = -rxt(k,149)*y(k,62) + mat(k,583) = -rxt(k,150)*y(k,62) + mat(k,852) = -rxt(k,151)*y(k,62) + mat(k,611) = -rxt(k,169)*y(k,62) + mat(k,922) = -rxt(k,200)*y(k,62) + mat(k,431) = -rxt(k,256)*y(k,62) + mat(k,922) = mat(k,922) + rxt(k,199)*y(k,61) + mat(k,417) = rxt(k,239)*y(k,61) + mat(k,611) = mat(k,611) + rxt(k,167)*y(k,61) + mat(k,171) = rxt(k,128)*y(k,99) + mat(k,749) = rxt(k,199)*y(k,5) + rxt(k,239)*y(k,21) + rxt(k,167)*y(k,28) & + + 2.000_r8*rxt(k,140)*y(k,63) + rxt(k,146)*y(k,69) + rxt(k,145) & + *y(k,71) + rxt(k,144)*y(k,90) + mat(k,583) = mat(k,583) + 2.000_r8*rxt(k,140)*y(k,61) + rxt(k,141)*y(k,69) & + + rxt(k,139)*y(k,90) + rxt(k,142)*y(k,99) + mat(k,682) = mat(k,682) + rxt(k,146)*y(k,61) + rxt(k,141)*y(k,63) + mat(k,533) = mat(k,533) + rxt(k,145)*y(k,61) + mat(k,558) = mat(k,558) + rxt(k,144)*y(k,61) + rxt(k,139)*y(k,63) + mat(k,852) = mat(k,852) + rxt(k,128)*y(k,52) + rxt(k,142)*y(k,63) + mat(k,581) = -(rxt(k,139)*y(k,90) + rxt(k,140)*y(k,61) + rxt(k,141)*y(k,69) & + + rxt(k,142)*y(k,99) + rxt(k,150)*y(k,62) + rxt(k,235)*y(k,17) & + + rxt(k,246)*y(k,35)) + mat(k,556) = -rxt(k,139)*y(k,63) + mat(k,747) = -rxt(k,140)*y(k,63) + mat(k,680) = -rxt(k,141)*y(k,63) + mat(k,850) = -rxt(k,142)*y(k,63) + mat(k,638) = -rxt(k,150)*y(k,63) + mat(k,479) = -rxt(k,235)*y(k,63) + mat(k,131) = -rxt(k,246)*y(k,63) + mat(k,204) = rxt(k,201)*y(k,69) + mat(k,779) = rxt(k,168)*y(k,29) + mat(k,310) = rxt(k,168)*y(k,25) + rxt(k,170)*y(k,69) + rxt(k,171)*y(k,99) + mat(k,294) = rxt(k,215)*y(k,51) + mat(k,896) = rxt(k,215)*y(k,39) + rxt(k,152)*y(k,99) + mat(k,638) = mat(k,638) + rxt(k,138)*y(k,69) + rxt(k,137)*y(k,71) + mat(k,680) = mat(k,680) + rxt(k,201)*y(k,6) + rxt(k,170)*y(k,29) + rxt(k,138) & + *y(k,62) + mat(k,531) = rxt(k,137)*y(k,62) + mat(k,850) = mat(k,850) + rxt(k,171)*y(k,29) + rxt(k,152)*y(k,51) + mat(k,683) = -(rxt(k,108)*y(k,71) + 4._r8*rxt(k,109)*y(k,69) + rxt(k,110) & + *y(k,70) + rxt(k,111)*y(k,41) + rxt(k,112)*y(k,43) + rxt(k,117) & + *y(k,90) + rxt(k,123)*y(k,99) + (rxt(k,136) + rxt(k,138) & + ) * y(k,62) + rxt(k,141)*y(k,63) + rxt(k,146)*y(k,61) + rxt(k,170) & + *y(k,29) + rxt(k,172)*y(k,28) + rxt(k,175)*y(k,49) + rxt(k,178) & + *y(k,54) + rxt(k,201)*y(k,6) + rxt(k,202)*y(k,5) + rxt(k,204) & + *y(k,45) + rxt(k,206)*y(k,53) + rxt(k,236)*y(k,17) + rxt(k,248) & + *y(k,74) + (rxt(k,291) + rxt(k,292)) * y(k,92) + rxt(k,293) & + *y(k,94)) + mat(k,534) = -rxt(k,108)*y(k,69) + mat(k,513) = -rxt(k,110)*y(k,69) + mat(k,876) = -rxt(k,111)*y(k,69) + mat(k,231) = -rxt(k,112)*y(k,69) + mat(k,559) = -rxt(k,117)*y(k,69) + mat(k,853) = -rxt(k,123)*y(k,69) + mat(k,641) = -(rxt(k,136) + rxt(k,138)) * y(k,69) + mat(k,584) = -rxt(k,141)*y(k,69) + mat(k,750) = -rxt(k,146)*y(k,69) + mat(k,313) = -rxt(k,170)*y(k,69) + mat(k,612) = -rxt(k,172)*y(k,69) + mat(k,460) = -rxt(k,175)*y(k,69) + mat(k,268) = -rxt(k,178)*y(k,69) + mat(k,206) = -rxt(k,201)*y(k,69) + mat(k,923) = -rxt(k,202)*y(k,69) + mat(k,258) = -rxt(k,204)*y(k,69) + mat(k,250) = -rxt(k,206)*y(k,69) + mat(k,482) = -rxt(k,236)*y(k,69) + mat(k,145) = -rxt(k,248)*y(k,69) + mat(k,227) = -(rxt(k,291) + rxt(k,292)) * y(k,69) + mat(k,280) = -rxt(k,293)*y(k,69) + mat(k,443) = rxt(k,115)*y(k,90) + mat(k,353) = rxt(k,131)*y(k,61) + rxt(k,132)*y(k,62) + rxt(k,135)*y(k,70) & + + rxt(k,296)*y(k,98) + mat(k,750) = mat(k,750) + rxt(k,131)*y(k,55) + mat(k,641) = mat(k,641) + rxt(k,132)*y(k,55) + mat(k,513) = mat(k,513) + rxt(k,135)*y(k,55) + rxt(k,250)*y(k,77) & + + rxt(k,257)*y(k,79) + rxt(k,295)*y(k,94) + (rxt(k,97)+rxt(k,98)) & + *y(k,95) + rxt(k,302)*y(k,100) + rxt(k,306)*y(k,101) + mat(k,240) = rxt(k,250)*y(k,70) + mat(k,432) = rxt(k,257)*y(k,70) + mat(k,329) = rxt(k,287)*y(k,93) + 1.150_r8*rxt(k,288)*y(k,98) + mat(k,559) = mat(k,559) + rxt(k,115)*y(k,40) + mat(k,339) = rxt(k,301)*y(k,100) + mat(k,246) = rxt(k,287)*y(k,89) + mat(k,280) = mat(k,280) + rxt(k,295)*y(k,70) + mat(k,725) = (rxt(k,97)+rxt(k,98))*y(k,70) + mat(k,366) = rxt(k,296)*y(k,55) + 1.150_r8*rxt(k,288)*y(k,89) + mat(k,853) = mat(k,853) + 2.000_r8*rxt(k,125)*y(k,99) + mat(k,383) = rxt(k,302)*y(k,70) + rxt(k,301)*y(k,91) + mat(k,193) = rxt(k,306)*y(k,70) + mat(k,508) = -(rxt(k,97)*y(k,95) + rxt(k,102)*y(k,96) + rxt(k,110)*y(k,69) & + + rxt(k,116)*y(k,40) + rxt(k,130)*y(k,91) + rxt(k,135)*y(k,55) & + + rxt(k,250)*y(k,77) + rxt(k,257)*y(k,79) + rxt(k,290)*y(k,92) & + + (rxt(k,294) + rxt(k,295)) * y(k,94) + rxt(k,302)*y(k,100) & + + rxt(k,306)*y(k,101)) + mat(k,719) = -rxt(k,97)*y(k,70) + mat(k,78) = -rxt(k,102)*y(k,70) + mat(k,677) = -rxt(k,110)*y(k,70) + mat(k,440) = -rxt(k,116)*y(k,70) + mat(k,338) = -rxt(k,130)*y(k,70) + mat(k,351) = -rxt(k,135)*y(k,70) + mat(k,238) = -rxt(k,250)*y(k,70) + mat(k,427) = -rxt(k,257)*y(k,70) + mat(k,226) = -rxt(k,290)*y(k,70) + mat(k,279) = -(rxt(k,294) + rxt(k,295)) * y(k,70) + mat(k,380) = -rxt(k,302)*y(k,70) + mat(k,192) = -rxt(k,306)*y(k,70) + mat(k,798) = rxt(k,193)*y(k,71) + rxt(k,192)*y(k,90) + mat(k,917) = 2.000_r8*rxt(k,194)*y(k,5) + (rxt(k,196)+rxt(k,197))*y(k,28) & + + rxt(k,202)*y(k,69) + rxt(k,198)*y(k,90) + mat(k,414) = rxt(k,238)*y(k,90) + mat(k,776) = rxt(k,161)*y(k,71) + rxt(k,159)*y(k,90) + mat(k,606) = (rxt(k,196)+rxt(k,197))*y(k,5) + (2.000_r8*rxt(k,163) & + +2.000_r8*rxt(k,164))*y(k,28) + rxt(k,172)*y(k,69) + rxt(k,166) & + *y(k,90) + rxt(k,174)*y(k,99) + mat(k,440) = mat(k,440) + rxt(k,119)*y(k,71) + rxt(k,113)*y(k,90) + mat(k,168) = rxt(k,128)*y(k,99) + mat(k,351) = mat(k,351) + rxt(k,134)*y(k,62) + mat(k,104) = rxt(k,148)*y(k,95) + mat(k,744) = rxt(k,145)*y(k,71) + rxt(k,298)*y(k,98) + mat(k,635) = rxt(k,134)*y(k,55) + rxt(k,136)*y(k,69) + rxt(k,137)*y(k,71) + mat(k,578) = rxt(k,141)*y(k,69) + rxt(k,139)*y(k,90) + mat(k,677) = mat(k,677) + rxt(k,202)*y(k,5) + rxt(k,172)*y(k,28) + rxt(k,136) & + *y(k,62) + rxt(k,141)*y(k,63) + 2.000_r8*rxt(k,109)*y(k,69) & + + 2.000_r8*rxt(k,108)*y(k,71) + rxt(k,117)*y(k,90) + rxt(k,101) & + *y(k,96) + rxt(k,123)*y(k,99) + mat(k,508) = mat(k,508) + 2.000_r8*rxt(k,102)*y(k,96) + mat(k,528) = rxt(k,193)*y(k,3) + rxt(k,161)*y(k,25) + rxt(k,119)*y(k,40) & + + rxt(k,145)*y(k,61) + rxt(k,137)*y(k,62) + 2.000_r8*rxt(k,108) & + *y(k,69) + rxt(k,252)*y(k,77) + rxt(k,258)*y(k,79) & + + 2.000_r8*rxt(k,118)*y(k,90) + 2.000_r8*rxt(k,99)*y(k,95) & + + rxt(k,124)*y(k,99) + mat(k,238) = mat(k,238) + rxt(k,252)*y(k,71) + mat(k,427) = mat(k,427) + rxt(k,258)*y(k,71) + mat(k,553) = rxt(k,192)*y(k,3) + rxt(k,198)*y(k,5) + rxt(k,238)*y(k,21) & + + rxt(k,159)*y(k,25) + rxt(k,166)*y(k,28) + rxt(k,113)*y(k,40) & + + rxt(k,139)*y(k,63) + rxt(k,117)*y(k,69) + 2.000_r8*rxt(k,118) & + *y(k,71) + 2.000_r8*rxt(k,127)*y(k,90) + rxt(k,122)*y(k,99) + mat(k,719) = mat(k,719) + rxt(k,148)*y(k,56) + 2.000_r8*rxt(k,99)*y(k,71) + mat(k,78) = mat(k,78) + rxt(k,101)*y(k,69) + 2.000_r8*rxt(k,102)*y(k,70) + mat(k,364) = rxt(k,298)*y(k,61) + mat(k,847) = rxt(k,174)*y(k,28) + rxt(k,128)*y(k,52) + rxt(k,123)*y(k,69) & + + rxt(k,124)*y(k,71) + rxt(k,122)*y(k,90) + mat(k,529) = -(rxt(k,99)*y(k,95) + rxt(k,108)*y(k,69) + rxt(k,118)*y(k,90) & + + rxt(k,119)*y(k,40) + rxt(k,124)*y(k,99) + rxt(k,137)*y(k,62) & + + rxt(k,145)*y(k,61) + rxt(k,161)*y(k,25) + rxt(k,193)*y(k,3) & + + rxt(k,252)*y(k,77) + rxt(k,258)*y(k,79)) + mat(k,720) = -rxt(k,99)*y(k,71) + mat(k,678) = -rxt(k,108)*y(k,71) + mat(k,554) = -rxt(k,118)*y(k,71) + mat(k,441) = -rxt(k,119)*y(k,71) + mat(k,848) = -rxt(k,124)*y(k,71) + mat(k,636) = -rxt(k,137)*y(k,71) + mat(k,745) = -rxt(k,145)*y(k,71) + mat(k,777) = -rxt(k,161)*y(k,71) + mat(k,799) = -rxt(k,193)*y(k,71) + mat(k,239) = -rxt(k,252)*y(k,71) + mat(k,428) = -rxt(k,258)*y(k,71) + mat(k,678) = mat(k,678) + rxt(k,110)*y(k,70) + mat(k,509) = rxt(k,110)*y(k,69) + mat(k,134) = -(rxt(k,259)*y(k,79)) + mat(k,422) = -rxt(k,259)*y(k,73) + mat(k,910) = rxt(k,195)*y(k,28) + mat(k,597) = rxt(k,195)*y(k,5) + 2.000_r8*rxt(k,165)*y(k,28) + mat(k,139) = -(rxt(k,248)*y(k,69) + rxt(k,249)*y(k,99)) + mat(k,653) = -rxt(k,248)*y(k,74) + mat(k,822) = -rxt(k,249)*y(k,74) + mat(k,235) = -(rxt(k,250)*y(k,70) + rxt(k,252)*y(k,71) + rxt(k,255)*y(k,99)) + mat(k,497) = -rxt(k,250)*y(k,77) + mat(k,524) = -rxt(k,252)*y(k,77) + mat(k,831) = -rxt(k,255)*y(k,77) + mat(k,425) = -(rxt(k,253)*y(k,5) + rxt(k,254)*y(k,28) + rxt(k,256)*y(k,62) & + + rxt(k,257)*y(k,70) + rxt(k,258)*y(k,71) + rxt(k,259)*y(k,73) & + + rxt(k,260)*y(k,99)) + mat(k,914) = -rxt(k,253)*y(k,79) + mat(k,602) = -rxt(k,254)*y(k,79) + mat(k,632) = -rxt(k,256)*y(k,79) + mat(k,506) = -rxt(k,257)*y(k,79) + mat(k,526) = -rxt(k,258)*y(k,79) + mat(k,136) = -rxt(k,259)*y(k,79) + mat(k,843) = -rxt(k,260)*y(k,79) + mat(k,673) = rxt(k,248)*y(k,74) + mat(k,506) = mat(k,506) + rxt(k,250)*y(k,77) + mat(k,526) = mat(k,526) + rxt(k,252)*y(k,77) + mat(k,143) = rxt(k,248)*y(k,69) + mat(k,236) = rxt(k,250)*y(k,70) + rxt(k,252)*y(k,71) + rxt(k,255)*y(k,99) + mat(k,843) = mat(k,843) + rxt(k,255)*y(k,77) + mat(k,300) = -(rxt(k,251)*y(k,99)) + mat(k,836) = -rxt(k,251)*y(k,80) + mat(k,913) = rxt(k,253)*y(k,79) + mat(k,599) = rxt(k,254)*y(k,79) + mat(k,129) = rxt(k,246)*y(k,63) + (rxt(k,247)+.500_r8*rxt(k,261))*y(k,99) + mat(k,627) = rxt(k,256)*y(k,79) + mat(k,572) = rxt(k,246)*y(k,35) + mat(k,500) = rxt(k,257)*y(k,79) + mat(k,525) = rxt(k,258)*y(k,79) + mat(k,135) = rxt(k,259)*y(k,79) + mat(k,142) = rxt(k,249)*y(k,99) + mat(k,424) = rxt(k,253)*y(k,5) + rxt(k,254)*y(k,28) + rxt(k,256)*y(k,62) & + + rxt(k,257)*y(k,70) + rxt(k,258)*y(k,71) + rxt(k,259)*y(k,73) & + + rxt(k,260)*y(k,99) + mat(k,836) = mat(k,836) + (rxt(k,247)+.500_r8*rxt(k,261))*y(k,35) & + + rxt(k,249)*y(k,74) + rxt(k,260)*y(k,79) + 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,108) = -(rxt(k,262)*y(k,103)) + mat(k,934) = -rxt(k,262)*y(k,81) + mat(k,299) = rxt(k,251)*y(k,99) + mat(k,819) = rxt(k,251)*y(k,80) + mat(k,323) = -(rxt(k,287)*y(k,93) + rxt(k,288)*y(k,98) + rxt(k,289)*y(k,92)) + mat(k,243) = -rxt(k,287)*y(k,89) + mat(k,358) = -rxt(k,288)*y(k,89) + mat(k,221) = -rxt(k,289)*y(k,89) + mat(k,555) = -((rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,40) + rxt(k,117) & + *y(k,69) + rxt(k,118)*y(k,71) + rxt(k,122)*y(k,99) & + + 4._r8*rxt(k,127)*y(k,90) + rxt(k,139)*y(k,63) + rxt(k,144) & + *y(k,61) + rxt(k,149)*y(k,62) + (rxt(k,159) + rxt(k,160) & + ) * y(k,25) + rxt(k,166)*y(k,28) + rxt(k,192)*y(k,3) + rxt(k,198) & + *y(k,5) + rxt(k,238)*y(k,21)) + mat(k,442) = -(rxt(k,113) + rxt(k,114) + rxt(k,115)) * y(k,90) + mat(k,679) = -rxt(k,117)*y(k,90) + mat(k,530) = -rxt(k,118)*y(k,90) + mat(k,849) = -rxt(k,122)*y(k,90) + mat(k,580) = -rxt(k,139)*y(k,90) + mat(k,746) = -rxt(k,144)*y(k,90) + mat(k,637) = -rxt(k,149)*y(k,90) + mat(k,778) = -(rxt(k,159) + rxt(k,160)) * y(k,90) + mat(k,608) = -rxt(k,166)*y(k,90) + mat(k,800) = -rxt(k,192)*y(k,90) + mat(k,919) = -rxt(k,198)*y(k,90) + mat(k,415) = -rxt(k,238)*y(k,90) + mat(k,800) = mat(k,800) + rxt(k,191)*y(k,17) + mat(k,919) = mat(k,919) + rxt(k,203)*y(k,99) + mat(k,478) = rxt(k,191)*y(k,3) + rxt(k,155)*y(k,25) + rxt(k,235)*y(k,63) & + + rxt(k,236)*y(k,69) + mat(k,213) = rxt(k,220)*y(k,25) + rxt(k,221)*y(k,99) + mat(k,151) = rxt(k,223)*y(k,25) + rxt(k,224)*y(k,99) + mat(k,415) = mat(k,415) + rxt(k,162)*y(k,28) + rxt(k,239)*y(k,61) + mat(k,399) = rxt(k,243)*y(k,95) + mat(k,778) = mat(k,778) + rxt(k,155)*y(k,17) + rxt(k,220)*y(k,18) & + + rxt(k,223)*y(k,20) + rxt(k,158)*y(k,43) + mat(k,608) = mat(k,608) + rxt(k,162)*y(k,21) + rxt(k,173)*y(k,99) + mat(k,286) = rxt(k,245)*y(k,99) + mat(k,130) = .500_r8*rxt(k,261)*y(k,99) + mat(k,442) = mat(k,442) + rxt(k,116)*y(k,70) + mat(k,230) = rxt(k,158)*y(k,25) + rxt(k,112)*y(k,69) + rxt(k,121)*y(k,99) + mat(k,746) = mat(k,746) + rxt(k,239)*y(k,21) + mat(k,580) = mat(k,580) + rxt(k,235)*y(k,17) + rxt(k,142)*y(k,99) + mat(k,679) = mat(k,679) + rxt(k,236)*y(k,17) + rxt(k,112)*y(k,43) + mat(k,510) = rxt(k,116)*y(k,40) + mat(k,530) = mat(k,530) + rxt(k,124)*y(k,99) + mat(k,302) = rxt(k,251)*y(k,99) + mat(k,721) = rxt(k,243)*y(k,23) + mat(k,849) = mat(k,849) + rxt(k,203)*y(k,5) + rxt(k,221)*y(k,18) + rxt(k,224) & + *y(k,20) + rxt(k,173)*y(k,28) + rxt(k,245)*y(k,31) & + + .500_r8*rxt(k,261)*y(k,35) + rxt(k,121)*y(k,43) + rxt(k,142) & + *y(k,63) + rxt(k,124)*y(k,71) + rxt(k,251)*y(k,80) + mat(k,334) = -(rxt(k,129)*y(k,69) + rxt(k,130)*y(k,70) + rxt(k,301)*y(k,100)) + mat(k,669) = -rxt(k,129)*y(k,91) + mat(k,502) = -rxt(k,130)*y(k,91) + mat(k,375) = -rxt(k,301)*y(k,91) + mat(k,669) = mat(k,669) + rxt(k,291)*y(k,92) + mat(k,324) = .900_r8*rxt(k,289)*y(k,92) + .800_r8*rxt(k,287)*y(k,93) + mat(k,222) = rxt(k,291)*y(k,69) + .900_r8*rxt(k,289)*y(k,89) + mat(k,244) = .800_r8*rxt(k,287)*y(k,89) + mat(k,219) = -(rxt(k,289)*y(k,89) + rxt(k,290)*y(k,70) + (rxt(k,291) & + + rxt(k,292)) * y(k,69)) + mat(k,320) = -rxt(k,289)*y(k,92) + mat(k,496) = -rxt(k,290)*y(k,92) + mat(k,657) = -(rxt(k,291) + rxt(k,292)) * y(k,92) + mat(k,242) = -(rxt(k,287)*y(k,89)) + mat(k,321) = -rxt(k,287)*y(k,93) + mat(k,343) = rxt(k,296)*y(k,98) + mat(k,735) = rxt(k,298)*y(k,98) + mat(k,660) = rxt(k,291)*y(k,92) + mat(k,498) = rxt(k,295)*y(k,94) + mat(k,220) = rxt(k,291)*y(k,69) + mat(k,272) = rxt(k,295)*y(k,70) + mat(k,357) = rxt(k,296)*y(k,55) + rxt(k,298)*y(k,61) + mat(k,273) = -(rxt(k,293)*y(k,69) + (rxt(k,294) + rxt(k,295)) * y(k,70)) + mat(k,664) = -rxt(k,293)*y(k,94) + mat(k,499) = -(rxt(k,294) + rxt(k,295)) * y(k,94) + mat(k,332) = rxt(k,301)*y(k,100) + mat(k,372) = rxt(k,301)*y(k,91) + mat(k,726) = -(rxt(k,94)*y(k,41) + rxt(k,95)*y(k,103) + (rxt(k,97) + rxt(k,98) & + ) * y(k,70) + rxt(k,99)*y(k,71) + (rxt(k,147) + rxt(k,148) & + ) * y(k,56) + rxt(k,180)*y(k,8) + rxt(k,181)*y(k,9) + rxt(k,182) & + *y(k,11) + rxt(k,183)*y(k,12) + rxt(k,184)*y(k,13) + rxt(k,185) & + *y(k,14) + rxt(k,186)*y(k,15) + (rxt(k,187) + rxt(k,188) & + ) * y(k,49) + rxt(k,207)*y(k,10) + rxt(k,208)*y(k,24) + rxt(k,209) & + *y(k,42) + (rxt(k,210) + rxt(k,211)) * y(k,45) + rxt(k,216) & + *y(k,33) + rxt(k,217)*y(k,34) + rxt(k,230)*y(k,16) + rxt(k,231) & + *y(k,18) + rxt(k,232)*y(k,46) + rxt(k,233)*y(k,47) + rxt(k,234) & + *y(k,48) + (rxt(k,242) + rxt(k,243) + rxt(k,244)) * y(k,23)) + mat(k,877) = -rxt(k,94)*y(k,95) + mat(k,951) = -rxt(k,95)*y(k,95) + mat(k,514) = -(rxt(k,97) + rxt(k,98)) * y(k,95) + mat(k,535) = -rxt(k,99)*y(k,95) + mat(k,105) = -(rxt(k,147) + rxt(k,148)) * y(k,95) + mat(k,30) = -rxt(k,180)*y(k,95) + mat(k,57) = -rxt(k,181)*y(k,95) + mat(k,38) = -rxt(k,182)*y(k,95) + mat(k,68) = -rxt(k,183)*y(k,95) + mat(k,42) = -rxt(k,184)*y(k,95) + mat(k,73) = -rxt(k,185)*y(k,95) + mat(k,46) = -rxt(k,186)*y(k,95) + mat(k,461) = -(rxt(k,187) + rxt(k,188)) * y(k,95) + mat(k,63) = -rxt(k,207)*y(k,95) + mat(k,163) = -rxt(k,208)*y(k,95) + mat(k,34) = -rxt(k,209)*y(k,95) + mat(k,259) = -(rxt(k,210) + rxt(k,211)) * y(k,95) + mat(k,84) = -rxt(k,216)*y(k,95) + mat(k,92) = -rxt(k,217)*y(k,95) + mat(k,176) = -rxt(k,230)*y(k,95) + mat(k,214) = -rxt(k,231)*y(k,95) + mat(k,87) = -rxt(k,232)*y(k,95) + mat(k,97) = -rxt(k,233)*y(k,95) + mat(k,115) = -rxt(k,234)*y(k,95) + mat(k,403) = -(rxt(k,242) + rxt(k,243) + rxt(k,244)) * y(k,95) + mat(k,514) = mat(k,514) + rxt(k,130)*y(k,91) + mat(k,330) = .850_r8*rxt(k,288)*y(k,98) + mat(k,340) = rxt(k,130)*y(k,70) + mat(k,367) = .850_r8*rxt(k,288)*y(k,89) + mat(k,77) = -(rxt(k,101)*y(k,69) + rxt(k,102)*y(k,70)) + mat(k,651) = -rxt(k,101)*y(k,96) + mat(k,492) = -rxt(k,102)*y(k,96) + mat(k,194) = rxt(k,103)*y(k,97) + mat(k,651) = mat(k,651) + rxt(k,105)*y(k,97) + mat(k,492) = mat(k,492) + rxt(k,106)*y(k,97) + mat(k,522) = rxt(k,107)*y(k,97) + mat(k,79) = rxt(k,103)*y(k,32) + rxt(k,105)*y(k,69) + rxt(k,106)*y(k,70) & + + rxt(k,107)*y(k,71) + mat(k,80) = -(rxt(k,103)*y(k,32) + rxt(k,105)*y(k,69) + rxt(k,106)*y(k,70) & + + rxt(k,107)*y(k,71)) + mat(k,195) = -rxt(k,103)*y(k,97) + mat(k,652) = -rxt(k,105)*y(k,97) + mat(k,493) = -rxt(k,106)*y(k,97) + mat(k,523) = -rxt(k,107)*y(k,97) + mat(k,493) = mat(k,493) + rxt(k,97)*y(k,95) + mat(k,702) = rxt(k,97)*y(k,70) + mat(k,361) = -(rxt(k,288)*y(k,89) + rxt(k,296)*y(k,55) + rxt(k,298)*y(k,61)) + mat(k,326) = -rxt(k,288)*y(k,98) + mat(k,348) = -rxt(k,296)*y(k,98) + mat(k,739) = -rxt(k,298)*y(k,98) + mat(k,198) = rxt(k,299)*y(k,100) + mat(k,504) = rxt(k,290)*y(k,92) + rxt(k,294)*y(k,94) + rxt(k,302)*y(k,100) & + + rxt(k,306)*y(k,101) + mat(k,224) = rxt(k,290)*y(k,70) + mat(k,277) = rxt(k,294)*y(k,70) + mat(k,377) = rxt(k,299)*y(k,32) + rxt(k,302)*y(k,70) + mat(k,190) = rxt(k,306)*y(k,70) + mat(k,858) = -(rxt(k,120)*y(k,41) + rxt(k,121)*y(k,43) + rxt(k,122)*y(k,90) & + + rxt(k,123)*y(k,69) + rxt(k,124)*y(k,71) + (4._r8*rxt(k,125) & + + 4._r8*rxt(k,126)) * y(k,99) + rxt(k,128)*y(k,52) + rxt(k,142) & + *y(k,63) + rxt(k,143)*y(k,55) + rxt(k,151)*y(k,62) + rxt(k,152) & + *y(k,51) + rxt(k,171)*y(k,29) + (rxt(k,173) + rxt(k,174) & + ) * y(k,28) + rxt(k,176)*y(k,49) + rxt(k,179)*y(k,54) + rxt(k,203) & + *y(k,5) + rxt(k,205)*y(k,45) + rxt(k,219)*y(k,16) + rxt(k,221) & + *y(k,18) + rxt(k,222)*y(k,19) + rxt(k,224)*y(k,20) + rxt(k,226) & + *y(k,24) + rxt(k,227)*y(k,46) + rxt(k,228)*y(k,47) + rxt(k,229) & + *y(k,48) + rxt(k,237)*y(k,17) + rxt(k,240)*y(k,22) + rxt(k,241) & + *y(k,23) + rxt(k,245)*y(k,31) + (rxt(k,247) + rxt(k,261) & + ) * y(k,35) + rxt(k,249)*y(k,74) + rxt(k,251)*y(k,80) + rxt(k,255) & + *y(k,77) + rxt(k,260)*y(k,79)) + mat(k,881) = -rxt(k,120)*y(k,99) + mat(k,233) = -rxt(k,121)*y(k,99) + mat(k,564) = -rxt(k,122)*y(k,99) + mat(k,688) = -rxt(k,123)*y(k,99) + mat(k,539) = -rxt(k,124)*y(k,99) + mat(k,172) = -rxt(k,128)*y(k,99) + mat(k,589) = -rxt(k,142)*y(k,99) + mat(k,356) = -rxt(k,143)*y(k,99) + mat(k,646) = -rxt(k,151)*y(k,99) + mat(k,904) = -rxt(k,152)*y(k,99) + mat(k,315) = -rxt(k,171)*y(k,99) + mat(k,617) = -(rxt(k,173) + rxt(k,174)) * y(k,99) + mat(k,464) = -rxt(k,176)*y(k,99) + mat(k,270) = -rxt(k,179)*y(k,99) + mat(k,928) = -rxt(k,203)*y(k,99) + mat(k,261) = -rxt(k,205)*y(k,99) + mat(k,179) = -rxt(k,219)*y(k,99) + mat(k,217) = -rxt(k,221)*y(k,99) + mat(k,50) = -rxt(k,222)*y(k,99) + mat(k,153) = -rxt(k,224)*y(k,99) + mat(k,166) = -rxt(k,226)*y(k,99) + mat(k,89) = -rxt(k,227)*y(k,99) + mat(k,99) = -rxt(k,228)*y(k,99) + mat(k,117) = -rxt(k,229)*y(k,99) + mat(k,487) = -rxt(k,237)*y(k,99) + mat(k,159) = -rxt(k,240)*y(k,99) + mat(k,406) = -rxt(k,241)*y(k,99) + mat(k,288) = -rxt(k,245)*y(k,99) + mat(k,132) = -(rxt(k,247) + rxt(k,261)) * y(k,99) + mat(k,146) = -rxt(k,249)*y(k,99) + mat(k,304) = -rxt(k,251)*y(k,99) + mat(k,241) = -rxt(k,255)*y(k,99) + mat(k,436) = -rxt(k,260)*y(k,99) + mat(k,487) = mat(k,487) + rxt(k,236)*y(k,69) + mat(k,159) = mat(k,159) + .300_r8*rxt(k,240)*y(k,99) + mat(k,406) = mat(k,406) + rxt(k,242)*y(k,95) + mat(k,787) = rxt(k,160)*y(k,90) + mat(k,295) = rxt(k,214)*y(k,103) + mat(k,444) = rxt(k,119)*y(k,71) + 2.000_r8*rxt(k,114)*y(k,90) + mat(k,881) = mat(k,881) + rxt(k,111)*y(k,69) + rxt(k,94)*y(k,95) + mat(k,233) = mat(k,233) + rxt(k,112)*y(k,69) + mat(k,261) = mat(k,261) + rxt(k,204)*y(k,69) + rxt(k,210)*y(k,95) + mat(k,464) = mat(k,464) + rxt(k,175)*y(k,69) + rxt(k,187)*y(k,95) + mat(k,253) = rxt(k,206)*y(k,69) + mat(k,270) = mat(k,270) + rxt(k,178)*y(k,69) + mat(k,755) = rxt(k,144)*y(k,90) + mat(k,589) = mat(k,589) + rxt(k,139)*y(k,90) + mat(k,688) = mat(k,688) + rxt(k,236)*y(k,17) + rxt(k,111)*y(k,41) & + + rxt(k,112)*y(k,43) + rxt(k,204)*y(k,45) + rxt(k,175)*y(k,49) & + + rxt(k,206)*y(k,53) + rxt(k,178)*y(k,54) + rxt(k,117)*y(k,90) + mat(k,539) = mat(k,539) + rxt(k,119)*y(k,40) + rxt(k,118)*y(k,90) + mat(k,564) = mat(k,564) + rxt(k,160)*y(k,25) + 2.000_r8*rxt(k,114)*y(k,40) & + + rxt(k,144)*y(k,61) + rxt(k,139)*y(k,63) + rxt(k,117)*y(k,69) & + + rxt(k,118)*y(k,71) + mat(k,730) = rxt(k,242)*y(k,23) + rxt(k,94)*y(k,41) + rxt(k,210)*y(k,45) & + + rxt(k,187)*y(k,49) + 2.000_r8*rxt(k,95)*y(k,103) + mat(k,858) = mat(k,858) + .300_r8*rxt(k,240)*y(k,22) + mat(k,955) = rxt(k,214)*y(k,39) + 2.000_r8*rxt(k,95)*y(k,95) + 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,378) = -(rxt(k,299)*y(k,32) + rxt(k,301)*y(k,91) + rxt(k,302)*y(k,70)) + mat(k,199) = -rxt(k,299)*y(k,100) + mat(k,337) = -rxt(k,301)*y(k,100) + mat(k,505) = -rxt(k,302)*y(k,100) + mat(k,672) = rxt(k,292)*y(k,92) + rxt(k,293)*y(k,94) + rxt(k,305)*y(k,101) & + + rxt(k,311)*y(k,102) + mat(k,327) = rxt(k,303)*y(k,101) + rxt(k,308)*y(k,102) + mat(k,225) = rxt(k,292)*y(k,69) + mat(k,278) = rxt(k,293)*y(k,69) + mat(k,191) = rxt(k,305)*y(k,69) + rxt(k,303)*y(k,89) + mat(k,185) = rxt(k,311)*y(k,69) + rxt(k,308)*y(k,89) + mat(k,188) = -(rxt(k,303)*y(k,89) + rxt(k,305)*y(k,69) + rxt(k,306)*y(k,70)) + mat(k,319) = -rxt(k,303)*y(k,101) + mat(k,655) = -rxt(k,305)*y(k,101) + mat(k,495) = -rxt(k,306)*y(k,101) + mat(k,319) = mat(k,319) + rxt(k,307)*y(k,102) + mat(k,182) = rxt(k,307)*y(k,89) + mat(k,181) = -((rxt(k,307) + rxt(k,308)) * y(k,89) + rxt(k,311)*y(k,69)) + mat(k,318) = -(rxt(k,307) + rxt(k,308)) * y(k,102) + mat(k,654) = -rxt(k,311)*y(k,102) + mat(k,959) = -(rxt(k,95)*y(k,95) + rxt(k,214)*y(k,39) + rxt(k,262)*y(k,81)) + mat(k,734) = -rxt(k,95)*y(k,103) + mat(k,298) = -rxt(k,214)*y(k,103) + mat(k,111) = -rxt(k,262)*y(k,103) + mat(k,180) = rxt(k,219)*y(k,99) + mat(k,491) = rxt(k,237)*y(k,99) + mat(k,218) = rxt(k,221)*y(k,99) + mat(k,51) = rxt(k,222)*y(k,99) + mat(k,154) = rxt(k,224)*y(k,99) + mat(k,160) = rxt(k,240)*y(k,99) + mat(k,409) = rxt(k,241)*y(k,99) + mat(k,446) = rxt(k,115)*y(k,90) + mat(k,885) = rxt(k,120)*y(k,99) + mat(k,234) = rxt(k,121)*y(k,99) + mat(k,263) = rxt(k,205)*y(k,99) + mat(k,118) = rxt(k,229)*y(k,99) + mat(k,468) = (rxt(k,275)+rxt(k,280))*y(k,53) + (rxt(k,268)+rxt(k,274) & + +rxt(k,279))*y(k,54) + rxt(k,176)*y(k,99) + mat(k,908) = rxt(k,152)*y(k,99) + mat(k,173) = rxt(k,128)*y(k,99) + mat(k,255) = (rxt(k,275)+rxt(k,280))*y(k,49) + mat(k,271) = (rxt(k,268)+rxt(k,274)+rxt(k,279))*y(k,49) + rxt(k,179)*y(k,99) + mat(k,568) = rxt(k,115)*y(k,40) + rxt(k,122)*y(k,99) + mat(k,862) = rxt(k,219)*y(k,16) + rxt(k,237)*y(k,17) + rxt(k,221)*y(k,18) & + + rxt(k,222)*y(k,19) + rxt(k,224)*y(k,20) + rxt(k,240)*y(k,22) & + + rxt(k,241)*y(k,23) + rxt(k,120)*y(k,41) + rxt(k,121)*y(k,43) & + + rxt(k,205)*y(k,45) + rxt(k,229)*y(k,48) + rxt(k,176)*y(k,49) & + + rxt(k,152)*y(k,51) + rxt(k,128)*y(k,52) + rxt(k,179)*y(k,54) & + + rxt(k,122)*y(k,90) + 2.000_r8*rxt(k,125)*y(k,99) + end do + end subroutine nlnmat05 + 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) = mat(k, 29) + lmat(k, 29) + mat(k, 31) = mat(k, 31) + lmat(k, 31) + mat(k, 32) = mat(k, 32) + lmat(k, 32) + mat(k, 33) = mat(k, 33) + lmat(k, 33) + mat(k, 35) = mat(k, 35) + lmat(k, 35) + mat(k, 36) = mat(k, 36) + lmat(k, 36) + mat(k, 37) = mat(k, 37) + lmat(k, 37) + mat(k, 39) = mat(k, 39) + lmat(k, 39) + mat(k, 40) = mat(k, 40) + lmat(k, 40) + mat(k, 41) = mat(k, 41) + lmat(k, 41) + mat(k, 43) = mat(k, 43) + lmat(k, 43) + mat(k, 44) = mat(k, 44) + lmat(k, 44) + mat(k, 45) = mat(k, 45) + lmat(k, 45) + mat(k, 47) = mat(k, 47) + lmat(k, 47) + mat(k, 48) = mat(k, 48) + lmat(k, 48) + mat(k, 49) = mat(k, 49) + lmat(k, 49) + mat(k, 52) = lmat(k, 52) + mat(k, 53) = lmat(k, 53) + mat(k, 54) = lmat(k, 54) + mat(k, 55) = mat(k, 55) + lmat(k, 55) + mat(k, 56) = mat(k, 56) + lmat(k, 56) + mat(k, 58) = mat(k, 58) + lmat(k, 58) + mat(k, 59) = mat(k, 59) + lmat(k, 59) + mat(k, 60) = mat(k, 60) + lmat(k, 60) + mat(k, 61) = mat(k, 61) + lmat(k, 61) + mat(k, 62) = mat(k, 62) + lmat(k, 62) + mat(k, 64) = mat(k, 64) + lmat(k, 64) + mat(k, 65) = mat(k, 65) + lmat(k, 65) + 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, 70) = mat(k, 70) + lmat(k, 70) + mat(k, 71) = mat(k, 71) + lmat(k, 71) + mat(k, 72) = mat(k, 72) + lmat(k, 72) + mat(k, 74) = mat(k, 74) + lmat(k, 74) + mat(k, 75) = lmat(k, 75) + mat(k, 76) = lmat(k, 76) + mat(k, 77) = mat(k, 77) + lmat(k, 77) + mat(k, 78) = mat(k, 78) + lmat(k, 78) + mat(k, 79) = mat(k, 79) + lmat(k, 79) + mat(k, 80) = mat(k, 80) + lmat(k, 80) + mat(k, 81) = lmat(k, 81) + mat(k, 82) = mat(k, 82) + lmat(k, 82) + mat(k, 83) = mat(k, 83) + lmat(k, 83) + mat(k, 85) = mat(k, 85) + lmat(k, 85) + mat(k, 86) = mat(k, 86) + lmat(k, 86) + mat(k, 88) = mat(k, 88) + lmat(k, 88) + mat(k, 90) = mat(k, 90) + lmat(k, 90) + mat(k, 91) = mat(k, 91) + lmat(k, 91) + mat(k, 93) = mat(k, 93) + lmat(k, 93) + mat(k, 94) = mat(k, 94) + lmat(k, 94) + mat(k, 95) = mat(k, 95) + lmat(k, 95) + mat(k, 98) = mat(k, 98) + lmat(k, 98) + mat(k, 100) = lmat(k, 100) + mat(k, 101) = lmat(k, 101) + mat(k, 102) = lmat(k, 102) + mat(k, 103) = mat(k, 103) + lmat(k, 103) + mat(k, 105) = mat(k, 105) + lmat(k, 105) + mat(k, 108) = mat(k, 108) + lmat(k, 108) + mat(k, 109) = lmat(k, 109) + mat(k, 110) = lmat(k, 110) + mat(k, 112) = mat(k, 112) + lmat(k, 112) + mat(k, 113) = mat(k, 113) + lmat(k, 113) + mat(k, 116) = mat(k, 116) + lmat(k, 116) + mat(k, 119) = lmat(k, 119) + 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) = mat(k, 128) + lmat(k, 128) + mat(k, 134) = mat(k, 134) + lmat(k, 134) + mat(k, 137) = mat(k, 137) + lmat(k, 137) + mat(k, 138) = lmat(k, 138) + mat(k, 139) = mat(k, 139) + lmat(k, 139) + mat(k, 140) = lmat(k, 140) + mat(k, 141) = mat(k, 141) + lmat(k, 141) + mat(k, 147) = mat(k, 147) + lmat(k, 147) + mat(k, 149) = lmat(k, 149) + mat(k, 152) = mat(k, 152) + lmat(k, 152) + mat(k, 155) = mat(k, 155) + lmat(k, 155) + mat(k, 157) = lmat(k, 157) + mat(k, 158) = mat(k, 158) + lmat(k, 158) + mat(k, 159) = mat(k, 159) + lmat(k, 159) + mat(k, 161) = mat(k, 161) + lmat(k, 161) + mat(k, 165) = mat(k, 165) + lmat(k, 165) + mat(k, 167) = mat(k, 167) + lmat(k, 167) + mat(k, 169) = lmat(k, 169) + mat(k, 170) = lmat(k, 170) + mat(k, 171) = mat(k, 171) + lmat(k, 171) + mat(k, 172) = mat(k, 172) + lmat(k, 172) + mat(k, 174) = mat(k, 174) + lmat(k, 174) + mat(k, 178) = mat(k, 178) + lmat(k, 178) + mat(k, 181) = mat(k, 181) + lmat(k, 181) + mat(k, 182) = mat(k, 182) + lmat(k, 182) + mat(k, 183) = lmat(k, 183) + mat(k, 184) = lmat(k, 184) + mat(k, 185) = mat(k, 185) + lmat(k, 185) + mat(k, 186) = lmat(k, 186) + mat(k, 187) = lmat(k, 187) + mat(k, 188) = mat(k, 188) + lmat(k, 188) + mat(k, 189) = lmat(k, 189) + mat(k, 191) = mat(k, 191) + lmat(k, 191) + mat(k, 193) = mat(k, 193) + lmat(k, 193) + mat(k, 196) = mat(k, 196) + lmat(k, 196) + mat(k, 197) = mat(k, 197) + lmat(k, 197) + mat(k, 201) = lmat(k, 201) + mat(k, 202) = mat(k, 202) + lmat(k, 202) + mat(k, 203) = lmat(k, 203) + mat(k, 204) = mat(k, 204) + lmat(k, 204) + mat(k, 205) = lmat(k, 205) + mat(k, 207) = lmat(k, 207) + mat(k, 208) = lmat(k, 208) + mat(k, 209) = mat(k, 209) + lmat(k, 209) + mat(k, 210) = mat(k, 210) + lmat(k, 210) + mat(k, 211) = lmat(k, 211) + mat(k, 216) = mat(k, 216) + lmat(k, 216) + mat(k, 219) = mat(k, 219) + lmat(k, 219) + mat(k, 228) = mat(k, 228) + lmat(k, 228) + mat(k, 233) = mat(k, 233) + lmat(k, 233) + mat(k, 235) = mat(k, 235) + lmat(k, 235) + mat(k, 242) = mat(k, 242) + lmat(k, 242) + mat(k, 248) = mat(k, 248) + lmat(k, 248) + mat(k, 252) = lmat(k, 252) + mat(k, 253) = mat(k, 253) + lmat(k, 253) + mat(k, 256) = mat(k, 256) + lmat(k, 256) + mat(k, 257) = mat(k, 257) + lmat(k, 257) + mat(k, 260) = mat(k, 260) + lmat(k, 260) + mat(k, 265) = mat(k, 265) + lmat(k, 265) + mat(k, 269) = mat(k, 269) + lmat(k, 269) + mat(k, 270) = mat(k, 270) + lmat(k, 270) + mat(k, 273) = mat(k, 273) + lmat(k, 273) + mat(k, 282) = mat(k, 282) + lmat(k, 282) + mat(k, 290) = mat(k, 290) + lmat(k, 290) + mat(k, 300) = mat(k, 300) + lmat(k, 300) + mat(k, 301) = lmat(k, 301) + mat(k, 303) = lmat(k, 303) + mat(k, 307) = mat(k, 307) + lmat(k, 307) + mat(k, 308) = mat(k, 308) + lmat(k, 308) + mat(k, 310) = mat(k, 310) + lmat(k, 310) + mat(k, 311) = mat(k, 311) + lmat(k, 311) + mat(k, 312) = lmat(k, 312) + mat(k, 314) = mat(k, 314) + lmat(k, 314) + mat(k, 316) = mat(k, 316) + lmat(k, 316) + mat(k, 323) = mat(k, 323) + lmat(k, 323) + mat(k, 334) = mat(k, 334) + lmat(k, 334) + mat(k, 344) = lmat(k, 344) + mat(k, 345) = lmat(k, 345) + mat(k, 347) = mat(k, 347) + lmat(k, 347) + mat(k, 357) = mat(k, 357) + lmat(k, 357) + mat(k, 361) = mat(k, 361) + lmat(k, 361) + mat(k, 368) = mat(k, 368) + lmat(k, 368) + mat(k, 371) = lmat(k, 371) + mat(k, 376) = lmat(k, 376) + mat(k, 378) = mat(k, 378) + lmat(k, 378) + mat(k, 388) = lmat(k, 388) + mat(k, 389) = lmat(k, 389) + mat(k, 393) = mat(k, 393) + lmat(k, 393) + mat(k, 394) = mat(k, 394) + lmat(k, 394) + mat(k, 395) = mat(k, 395) + lmat(k, 395) + mat(k, 397) = mat(k, 397) + lmat(k, 397) + mat(k, 402) = lmat(k, 402) + mat(k, 406) = mat(k, 406) + lmat(k, 406) + mat(k, 407) = mat(k, 407) + lmat(k, 407) + mat(k, 409) = mat(k, 409) + lmat(k, 409) + mat(k, 411) = mat(k, 411) + lmat(k, 411) + mat(k, 423) = lmat(k, 423) + mat(k, 425) = mat(k, 425) + lmat(k, 425) + mat(k, 432) = mat(k, 432) + lmat(k, 432) + mat(k, 439) = mat(k, 439) + lmat(k, 439) + mat(k, 452) = mat(k, 452) + lmat(k, 452) + mat(k, 453) = mat(k, 453) + lmat(k, 453) + mat(k, 462) = mat(k, 462) + lmat(k, 462) + mat(k, 470) = mat(k, 470) + lmat(k, 470) + mat(k, 473) = mat(k, 473) + lmat(k, 473) + mat(k, 475) = mat(k, 475) + lmat(k, 475) + mat(k, 488) = lmat(k, 488) + mat(k, 494) = lmat(k, 494) + mat(k, 495) = mat(k, 495) + lmat(k, 495) + mat(k, 501) = lmat(k, 501) + mat(k, 504) = mat(k, 504) + lmat(k, 504) + mat(k, 505) = mat(k, 505) + lmat(k, 505) + mat(k, 508) = mat(k, 508) + lmat(k, 508) + mat(k, 513) = mat(k, 513) + lmat(k, 513) + mat(k, 514) = mat(k, 514) + lmat(k, 514) + mat(k, 522) = mat(k, 522) + lmat(k, 522) + mat(k, 528) = mat(k, 528) + lmat(k, 528) + mat(k, 529) = mat(k, 529) + lmat(k, 529) + mat(k, 534) = mat(k, 534) + lmat(k, 534) + mat(k, 535) = mat(k, 535) + lmat(k, 535) + mat(k, 545) = mat(k, 545) + lmat(k, 545) + mat(k, 555) = mat(k, 555) + lmat(k, 555) + mat(k, 578) = mat(k, 578) + lmat(k, 578) + mat(k, 581) = mat(k, 581) + lmat(k, 581) + mat(k, 583) = mat(k, 583) + lmat(k, 583) + mat(k, 584) = mat(k, 584) + lmat(k, 584) + mat(k, 586) = mat(k, 586) + lmat(k, 586) + mat(k, 591) = mat(k, 591) + lmat(k, 591) + mat(k, 610) = mat(k, 610) + lmat(k, 610) + mat(k, 612) = mat(k, 612) + lmat(k, 612) + mat(k, 615) = mat(k, 615) + lmat(k, 615) + mat(k, 640) = mat(k, 640) + lmat(k, 640) + mat(k, 641) = mat(k, 641) + lmat(k, 641) + mat(k, 643) = mat(k, 643) + lmat(k, 643) + mat(k, 646) = mat(k, 646) + lmat(k, 646) + mat(k, 648) = mat(k, 648) + lmat(k, 648) + mat(k, 654) = mat(k, 654) + lmat(k, 654) + mat(k, 655) = mat(k, 655) + lmat(k, 655) + mat(k, 668) = lmat(k, 668) + mat(k, 672) = mat(k, 672) + lmat(k, 672) + mat(k, 683) = mat(k, 683) + lmat(k, 683) + mat(k, 725) = mat(k, 725) + lmat(k, 725) + mat(k, 726) = mat(k, 726) + lmat(k, 726) + mat(k, 735) = mat(k, 735) + lmat(k, 735) + mat(k, 736) = lmat(k, 736) + mat(k, 738) = mat(k, 738) + lmat(k, 738) + mat(k, 750) = mat(k, 750) + lmat(k, 750) + mat(k, 752) = mat(k, 752) + lmat(k, 752) + mat(k, 785) = mat(k, 785) + lmat(k, 785) + mat(k, 808) = mat(k, 808) + lmat(k, 808) + mat(k, 858) = mat(k, 858) + lmat(k, 858) + mat(k, 882) = mat(k, 882) + lmat(k, 882) + mat(k, 898) = lmat(k, 898) + mat(k, 904) = mat(k, 904) + lmat(k, 904) + mat(k, 906) = mat(k, 906) + lmat(k, 906) + mat(k, 923) = mat(k, 923) + lmat(k, 923) + mat(k, 927) = mat(k, 927) + lmat(k, 927) + mat(k, 931) = mat(k, 931) + lmat(k, 931) + mat(k, 941) = lmat(k, 941) + mat(k, 950) = lmat(k, 950) + mat(k, 951) = mat(k, 951) + lmat(k, 951) + mat(k, 955) = mat(k, 955) + lmat(k, 955) + mat(k, 956) = lmat(k, 956) + mat(k, 959) = mat(k, 959) + lmat(k, 959) + mat(k, 96) = 0._r8 + mat(k, 114) = 0._r8 + mat(k, 200) = 0._r8 + mat(k, 251) = 0._r8 + mat(k, 274) = 0._r8 + mat(k, 275) = 0._r8 + mat(k, 283) = 0._r8 + mat(k, 284) = 0._r8 + mat(k, 285) = 0._r8 + mat(k, 287) = 0._r8 + mat(k, 305) = 0._r8 + mat(k, 317) = 0._r8 + mat(k, 322) = 0._r8 + mat(k, 328) = 0._r8 + mat(k, 331) = 0._r8 + mat(k, 333) = 0._r8 + mat(k, 336) = 0._r8 + mat(k, 346) = 0._r8 + mat(k, 349) = 0._r8 + mat(k, 354) = 0._r8 + mat(k, 359) = 0._r8 + mat(k, 362) = 0._r8 + mat(k, 363) = 0._r8 + mat(k, 365) = 0._r8 + mat(k, 369) = 0._r8 + mat(k, 374) = 0._r8 + mat(k, 379) = 0._r8 + mat(k, 381) = 0._r8 + mat(k, 382) = 0._r8 + mat(k, 384) = 0._r8 + mat(k, 385) = 0._r8 + mat(k, 386) = 0._r8 + mat(k, 391) = 0._r8 + mat(k, 392) = 0._r8 + mat(k, 398) = 0._r8 + mat(k, 400) = 0._r8 + mat(k, 401) = 0._r8 + mat(k, 404) = 0._r8 + mat(k, 408) = 0._r8 + mat(k, 412) = 0._r8 + mat(k, 420) = 0._r8 + mat(k, 421) = 0._r8 + mat(k, 429) = 0._r8 + mat(k, 438) = 0._r8 + mat(k, 454) = 0._r8 + mat(k, 455) = 0._r8 + mat(k, 456) = 0._r8 + mat(k, 457) = 0._r8 + mat(k, 459) = 0._r8 + mat(k, 463) = 0._r8 + mat(k, 465) = 0._r8 + mat(k, 467) = 0._r8 + mat(k, 471) = 0._r8 + mat(k, 472) = 0._r8 + mat(k, 476) = 0._r8 + mat(k, 477) = 0._r8 + mat(k, 480) = 0._r8 + mat(k, 481) = 0._r8 + mat(k, 483) = 0._r8 + mat(k, 484) = 0._r8 + mat(k, 490) = 0._r8 + mat(k, 511) = 0._r8 + mat(k, 512) = 0._r8 + mat(k, 516) = 0._r8 + mat(k, 517) = 0._r8 + mat(k, 518) = 0._r8 + mat(k, 519) = 0._r8 + mat(k, 520) = 0._r8 + mat(k, 521) = 0._r8 + mat(k, 540) = 0._r8 + mat(k, 542) = 0._r8 + mat(k, 552) = 0._r8 + mat(k, 560) = 0._r8 + mat(k, 566) = 0._r8 + mat(k, 573) = 0._r8 + mat(k, 574) = 0._r8 + mat(k, 575) = 0._r8 + mat(k, 576) = 0._r8 + mat(k, 579) = 0._r8 + mat(k, 582) = 0._r8 + mat(k, 585) = 0._r8 + mat(k, 587) = 0._r8 + mat(k, 588) = 0._r8 + mat(k, 590) = 0._r8 + mat(k, 592) = 0._r8 + mat(k, 593) = 0._r8 + mat(k, 603) = 0._r8 + mat(k, 607) = 0._r8 + mat(k, 609) = 0._r8 + mat(k, 613) = 0._r8 + mat(k, 618) = 0._r8 + mat(k, 619) = 0._r8 + mat(k, 621) = 0._r8 + mat(k, 626) = 0._r8 + mat(k, 630) = 0._r8 + mat(k, 631) = 0._r8 + mat(k, 633) = 0._r8 + mat(k, 634) = 0._r8 + mat(k, 642) = 0._r8 + mat(k, 644) = 0._r8 + mat(k, 645) = 0._r8 + mat(k, 647) = 0._r8 + mat(k, 650) = 0._r8 + mat(k, 659) = 0._r8 + mat(k, 666) = 0._r8 + mat(k, 671) = 0._r8 + mat(k, 684) = 0._r8 + mat(k, 690) = 0._r8 + mat(k, 692) = 0._r8 + mat(k, 722) = 0._r8 + mat(k, 724) = 0._r8 + mat(k, 732) = 0._r8 + mat(k, 737) = 0._r8 + mat(k, 740) = 0._r8 + mat(k, 742) = 0._r8 + mat(k, 751) = 0._r8 + mat(k, 756) = 0._r8 + mat(k, 757) = 0._r8 + mat(k, 759) = 0._r8 + mat(k, 769) = 0._r8 + mat(k, 770) = 0._r8 + mat(k, 781) = 0._r8 + mat(k, 782) = 0._r8 + mat(k, 783) = 0._r8 + mat(k, 784) = 0._r8 + mat(k, 789) = 0._r8 + mat(k, 790) = 0._r8 + mat(k, 791) = 0._r8 + mat(k, 794) = 0._r8 + mat(k, 795) = 0._r8 + mat(k, 796) = 0._r8 + mat(k, 801) = 0._r8 + mat(k, 802) = 0._r8 + mat(k, 803) = 0._r8 + mat(k, 804) = 0._r8 + mat(k, 805) = 0._r8 + mat(k, 806) = 0._r8 + mat(k, 807) = 0._r8 + mat(k, 809) = 0._r8 + mat(k, 810) = 0._r8 + mat(k, 811) = 0._r8 + mat(k, 813) = 0._r8 + mat(k, 835) = 0._r8 + mat(k, 839) = 0._r8 + mat(k, 840) = 0._r8 + mat(k, 854) = 0._r8 + mat(k, 865) = 0._r8 + mat(k, 866) = 0._r8 + mat(k, 869) = 0._r8 + mat(k, 870) = 0._r8 + mat(k, 871) = 0._r8 + mat(k, 872) = 0._r8 + mat(k, 873) = 0._r8 + mat(k, 874) = 0._r8 + mat(k, 875) = 0._r8 + mat(k, 878) = 0._r8 + mat(k, 880) = 0._r8 + mat(k, 883) = 0._r8 + mat(k, 884) = 0._r8 + mat(k, 888) = 0._r8 + mat(k, 889) = 0._r8 + mat(k, 890) = 0._r8 + mat(k, 891) = 0._r8 + mat(k, 892) = 0._r8 + mat(k, 893) = 0._r8 + mat(k, 894) = 0._r8 + mat(k, 895) = 0._r8 + mat(k, 897) = 0._r8 + mat(k, 899) = 0._r8 + mat(k, 900) = 0._r8 + mat(k, 901) = 0._r8 + mat(k, 902) = 0._r8 + mat(k, 903) = 0._r8 + mat(k, 905) = 0._r8 + mat(k, 907) = 0._r8 + mat(k, 915) = 0._r8 + mat(k, 916) = 0._r8 + mat(k, 918) = 0._r8 + mat(k, 920) = 0._r8 + mat(k, 924) = 0._r8 + mat(k, 929) = 0._r8 + mat(k, 930) = 0._r8 + mat(k, 932) = 0._r8 + mat(k, 937) = 0._r8 + mat(k, 938) = 0._r8 + mat(k, 939) = 0._r8 + mat(k, 940) = 0._r8 + mat(k, 942) = 0._r8 + mat(k, 943) = 0._r8 + mat(k, 944) = 0._r8 + mat(k, 945) = 0._r8 + mat(k, 946) = 0._r8 + mat(k, 947) = 0._r8 + mat(k, 948) = 0._r8 + mat(k, 949) = 0._r8 + mat(k, 952) = 0._r8 + mat(k, 953) = 0._r8 + mat(k, 954) = 0._r8 + mat(k, 957) = 0._r8 + mat(k, 958) = 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, 10) = mat(k, 10) - 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, 29) = mat(k, 29) - dti(k) + mat(k, 32) = mat(k, 32) - dti(k) + mat(k, 36) = mat(k, 36) - dti(k) + mat(k, 40) = mat(k, 40) - dti(k) + mat(k, 44) = mat(k, 44) - dti(k) + mat(k, 48) = mat(k, 48) - dti(k) + mat(k, 52) = mat(k, 52) - dti(k) + mat(k, 55) = mat(k, 55) - dti(k) + mat(k, 60) = mat(k, 60) - dti(k) + mat(k, 65) = mat(k, 65) - dti(k) + mat(k, 70) = mat(k, 70) - dti(k) + mat(k, 75) = mat(k, 75) - dti(k) + mat(k, 77) = mat(k, 77) - dti(k) + mat(k, 80) = mat(k, 80) - dti(k) + mat(k, 82) = mat(k, 82) - dti(k) + mat(k, 85) = mat(k, 85) - dti(k) + mat(k, 90) = mat(k, 90) - dti(k) + mat(k, 95) = mat(k, 95) - 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, 113) = mat(k, 113) - dti(k) + mat(k, 119) = mat(k, 119) - dti(k) + mat(k, 122) = mat(k, 122) - dti(k) + mat(k, 128) = mat(k, 128) - dti(k) + mat(k, 134) = mat(k, 134) - dti(k) + mat(k, 139) = mat(k, 139) - dti(k) + mat(k, 147) = mat(k, 147) - dti(k) + mat(k, 155) = mat(k, 155) - dti(k) + mat(k, 161) = mat(k, 161) - dti(k) + mat(k, 167) = mat(k, 167) - dti(k) + mat(k, 174) = mat(k, 174) - dti(k) + mat(k, 181) = mat(k, 181) - dti(k) + mat(k, 188) = mat(k, 188) - dti(k) + mat(k, 196) = mat(k, 196) - dti(k) + mat(k, 202) = mat(k, 202) - dti(k) + mat(k, 210) = mat(k, 210) - dti(k) + mat(k, 219) = mat(k, 219) - dti(k) + mat(k, 228) = mat(k, 228) - dti(k) + mat(k, 235) = mat(k, 235) - dti(k) + mat(k, 242) = mat(k, 242) - dti(k) + mat(k, 248) = mat(k, 248) - dti(k) + mat(k, 256) = mat(k, 256) - dti(k) + mat(k, 265) = mat(k, 265) - dti(k) + mat(k, 273) = mat(k, 273) - dti(k) + mat(k, 282) = mat(k, 282) - dti(k) + mat(k, 290) = mat(k, 290) - dti(k) + mat(k, 300) = mat(k, 300) - dti(k) + mat(k, 308) = mat(k, 308) - dti(k) + mat(k, 323) = mat(k, 323) - dti(k) + mat(k, 334) = mat(k, 334) - dti(k) + mat(k, 347) = mat(k, 347) - dti(k) + mat(k, 361) = mat(k, 361) - dti(k) + mat(k, 378) = mat(k, 378) - dti(k) + mat(k, 393) = mat(k, 393) - dti(k) + mat(k, 411) = mat(k, 411) - dti(k) + mat(k, 425) = mat(k, 425) - dti(k) + mat(k, 439) = mat(k, 439) - dti(k) + mat(k, 453) = mat(k, 453) - dti(k) + mat(k, 475) = mat(k, 475) - dti(k) + mat(k, 508) = mat(k, 508) - dti(k) + mat(k, 529) = mat(k, 529) - dti(k) + mat(k, 555) = mat(k, 555) - dti(k) + mat(k, 581) = mat(k, 581) - dti(k) + mat(k, 610) = mat(k, 610) - dti(k) + mat(k, 640) = mat(k, 640) - dti(k) + mat(k, 683) = mat(k, 683) - dti(k) + mat(k, 726) = mat(k, 726) - dti(k) + mat(k, 752) = mat(k, 752) - dti(k) + mat(k, 785) = mat(k, 785) - dti(k) + mat(k, 808) = mat(k, 808) - dti(k) + mat(k, 858) = mat(k, 858) - dti(k) + mat(k, 882) = mat(k, 882) - dti(k) + mat(k, 906) = mat(k, 906) - dti(k) + mat(k, 931) = mat(k, 931) - dti(k) + mat(k, 959) = mat(k, 959) - 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 nlnmat_finit( avec_len, mat, lmat, dti ) + end subroutine nlnmat + end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_ma_mam5/mo_phtadj.F90 b/src/chemistry/pp_waccm_ma_mam5/mo_phtadj.F90 new file mode 100644 index 0000000000..f75938e173 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/mo_phtadj.F90 @@ -0,0 +1,33 @@ + 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, 63) = p_rate(:,k, 63) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 64) = p_rate(:,k, 64) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 65) = p_rate(:,k, 65) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 66) = p_rate(:,k, 66) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 67) = p_rate(:,k, 67) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 68) = p_rate(:,k, 68) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 69) = p_rate(:,k, 69) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 70) = p_rate(:,k, 70) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_ma_mam5/mo_prod_loss.F90 b/src/chemistry/pp_waccm_ma_mam5/mo_prod_loss.F90 new file mode 100644 index 0000000000..4b90d14e1f --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/mo_prod_loss.F90 @@ -0,0 +1,555 @@ + 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,72))* y(k,72) + prod(k,1) = 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,97) = (rxt(k,191)* y(k,17) +rxt(k,193)* y(k,71) +rxt(k,192)* y(k,90) & + + het_rates(k,3))* y(k,3) + prod(k,97) = (rxt(k,27) +2.000_r8*rxt(k,194)*y(k,5) +rxt(k,195)*y(k,28) + & + rxt(k,196)*y(k,28) +rxt(k,199)*y(k,61) +rxt(k,202)*y(k,69) + & + rxt(k,203)*y(k,99) +rxt(k,253)*y(k,79))*y(k,5) + (rxt(k,181)*y(k,9) + & + rxt(k,207)*y(k,10) +3.000_r8*rxt(k,208)*y(k,24) + & + 2.000_r8*rxt(k,209)*y(k,42) +rxt(k,210)*y(k,45) + & + 2.000_r8*rxt(k,230)*y(k,16) +rxt(k,231)*y(k,18))*y(k,95) & + + (rxt(k,205)*y(k,45) +2.000_r8*rxt(k,219)*y(k,16) + & + rxt(k,221)*y(k,18) +3.000_r8*rxt(k,226)*y(k,24))*y(k,99) & + + (2.000_r8*rxt(k,218)*y(k,16) +rxt(k,220)*y(k,18) + & + 3.000_r8*rxt(k,225)*y(k,24))*y(k,25) + (rxt(k,51) + & + rxt(k,204)*y(k,69))*y(k,45) +rxt(k,26)*y(k,4) +rxt(k,29)*y(k,6) & + +rxt(k,31)*y(k,9) +rxt(k,32)*y(k,10) +2.000_r8*rxt(k,38)*y(k,16) & + +rxt(k,39)*y(k,18) +3.000_r8*rxt(k,42)*y(k,24) +2.000_r8*rxt(k,50) & + *y(k,42) +rxt(k,57)*y(k,53) + loss(k,45) = ( + rxt(k,26) + het_rates(k,4))* y(k,4) + prod(k,45) = (rxt(k,275)*y(k,53) +rxt(k,280)*y(k,53))*y(k,49) & + +rxt(k,197)*y(k,28)*y(k,5) + loss(k,101) = (2._r8*rxt(k,194)* y(k,5) + (rxt(k,195) +rxt(k,196) + & + rxt(k,197))* y(k,28) +rxt(k,199)* y(k,61) +rxt(k,200)* y(k,62) & + +rxt(k,202)* y(k,69) +rxt(k,253)* y(k,79) +rxt(k,198)* y(k,90) & + +rxt(k,203)* y(k,99) + rxt(k,27) + het_rates(k,5))* y(k,5) + prod(k,101) = (rxt(k,28) +rxt(k,201)*y(k,69))*y(k,6) +rxt(k,193)*y(k,71) & + *y(k,3) +rxt(k,211)*y(k,95)*y(k,45) +rxt(k,206)*y(k,69)*y(k,53) + loss(k,62) = (rxt(k,201)* y(k,69) + rxt(k,28) + rxt(k,29) + rxt(k,269) & + + rxt(k,272) + rxt(k,277) + het_rates(k,6))* y(k,6) + prod(k,62) =rxt(k,200)*y(k,62)*y(k,5) + loss(k,3) = ( + het_rates(k,7))* y(k,7) + prod(k,3) = 0._r8 + loss(k,27) = (rxt(k,180)* y(k,95) + rxt(k,30) + het_rates(k,8))* y(k,8) + prod(k,27) = 0._r8 + loss(k,34) = (rxt(k,181)* y(k,95) + rxt(k,31) + het_rates(k,9))* y(k,9) + prod(k,34) = 0._r8 + loss(k,35) = (rxt(k,207)* y(k,95) + rxt(k,32) + het_rates(k,10))* y(k,10) + prod(k,35) = 0._r8 + loss(k,29) = (rxt(k,182)* y(k,95) + rxt(k,33) + het_rates(k,11))* y(k,11) + prod(k,29) = 0._r8 + loss(k,36) = (rxt(k,183)* y(k,95) + rxt(k,34) + het_rates(k,12))* y(k,12) + prod(k,36) = 0._r8 + loss(k,30) = (rxt(k,184)* y(k,95) + rxt(k,35) + het_rates(k,13))* y(k,13) + prod(k,30) = 0._r8 + loss(k,37) = (rxt(k,185)* y(k,95) + rxt(k,36) + het_rates(k,14))* y(k,14) + prod(k,37) = 0._r8 + loss(k,31) = (rxt(k,186)* y(k,95) + rxt(k,37) + het_rates(k,15))* y(k,15) + prod(k,31) = 0._r8 + loss(k,58) = (rxt(k,218)* y(k,25) +rxt(k,230)* y(k,95) +rxt(k,219)* y(k,99) & + + rxt(k,38) + het_rates(k,16))* y(k,16) + prod(k,58) = 0._r8 + loss(k,86) = (rxt(k,191)* y(k,3) +rxt(k,155)* y(k,25) +rxt(k,235)* y(k,63) & + +rxt(k,236)* y(k,69) +rxt(k,237)* y(k,99) + rxt(k,20) + rxt(k,21) & + + het_rates(k,17))* y(k,17) + prod(k,86) = (.180_r8*rxt(k,24) +rxt(k,243)*y(k,95) +rxt(k,244)*y(k,95)) & + *y(k,23) + (rxt(k,162)*y(k,28) +rxt(k,239)*y(k,61))*y(k,21) & + + (rxt(k,22) +.300_r8*rxt(k,240)*y(k,99))*y(k,22) + loss(k,63) = (rxt(k,220)* y(k,25) +rxt(k,231)* y(k,95) +rxt(k,221)* y(k,99) & + + rxt(k,39) + het_rates(k,18))* y(k,18) + prod(k,63) = 0._r8 + loss(k,32) = (rxt(k,222)* y(k,99) + rxt(k,40) + het_rates(k,19))* y(k,19) + prod(k,32) = 0._r8 + loss(k,54) = (rxt(k,223)* y(k,25) +rxt(k,224)* y(k,99) + rxt(k,41) & + + het_rates(k,20))* y(k,20) + prod(k,54) = 0._r8 + loss(k,82) = (rxt(k,162)* y(k,28) +rxt(k,239)* y(k,61) +rxt(k,238)* y(k,90) & + + het_rates(k,21))* y(k,21) + prod(k,82) = (rxt(k,23) +rxt(k,156)*y(k,25) +rxt(k,212)*y(k,39) + & + rxt(k,241)*y(k,99) +rxt(k,242)*y(k,95))*y(k,23) +rxt(k,39)*y(k,18) & + +rxt(k,41)*y(k,20) +.700_r8*rxt(k,240)*y(k,99)*y(k,22) + loss(k,55) = (rxt(k,240)* y(k,99) + rxt(k,22) + het_rates(k,22))* y(k,22) + prod(k,55) =rxt(k,238)*y(k,90)*y(k,21) + loss(k,81) = (rxt(k,156)* y(k,25) +rxt(k,212)* y(k,39) + (rxt(k,242) + & + rxt(k,243) +rxt(k,244))* y(k,95) +rxt(k,241)* y(k,99) + rxt(k,23) & + + rxt(k,24) + het_rates(k,23))* y(k,23) + prod(k,81) = 0._r8 + loss(k,56) = (rxt(k,225)* y(k,25) +rxt(k,208)* y(k,95) +rxt(k,226)* y(k,99) & + + rxt(k,42) + het_rates(k,24))* y(k,24) + prod(k,56) = 0._r8 + loss(k,96) = (rxt(k,218)* y(k,16) +rxt(k,155)* y(k,17) +rxt(k,220)* y(k,18) & + +rxt(k,223)* y(k,20) +rxt(k,156)* y(k,23) +rxt(k,225)* y(k,24) & + +rxt(k,168)* y(k,29) +rxt(k,157)* y(k,41) +rxt(k,158)* y(k,43) & + +rxt(k,177)* y(k,54) +rxt(k,161)* y(k,71) + (rxt(k,159) +rxt(k,160)) & + * y(k,90) + het_rates(k,25))* y(k,25) + prod(k,96) = (4.000_r8*rxt(k,180)*y(k,8) +rxt(k,181)*y(k,9) + & + 2.000_r8*rxt(k,182)*y(k,11) +2.000_r8*rxt(k,183)*y(k,12) + & + 2.000_r8*rxt(k,184)*y(k,13) +rxt(k,185)*y(k,14) + & + 2.000_r8*rxt(k,186)*y(k,15) +rxt(k,187)*y(k,49) +rxt(k,217)*y(k,34) + & + rxt(k,232)*y(k,46) +rxt(k,233)*y(k,47) +rxt(k,234)*y(k,48))*y(k,95) & + + (rxt(k,45) +rxt(k,162)*y(k,21) +2.000_r8*rxt(k,163)*y(k,28) + & + rxt(k,165)*y(k,28) +rxt(k,167)*y(k,61) +rxt(k,172)*y(k,69) + & + rxt(k,173)*y(k,99) +rxt(k,196)*y(k,5) +rxt(k,254)*y(k,79))*y(k,28) & + + (rxt(k,176)*y(k,49) +3.000_r8*rxt(k,222)*y(k,19) + & + rxt(k,224)*y(k,20) +rxt(k,227)*y(k,46) +rxt(k,228)*y(k,47) + & + rxt(k,229)*y(k,48))*y(k,99) + (rxt(k,55) +rxt(k,175)*y(k,69))*y(k,49) & + +rxt(k,26)*y(k,4) +4.000_r8*rxt(k,30)*y(k,8) +rxt(k,31)*y(k,9) & + +2.000_r8*rxt(k,33)*y(k,11) +2.000_r8*rxt(k,34)*y(k,12) & + +2.000_r8*rxt(k,35)*y(k,13) +rxt(k,36)*y(k,14) +2.000_r8*rxt(k,37) & + *y(k,15) +3.000_r8*rxt(k,40)*y(k,19) +rxt(k,41)*y(k,20) & + +2.000_r8*rxt(k,43)*y(k,26) +2.000_r8*rxt(k,44)*y(k,27) +rxt(k,46) & + *y(k,29) +rxt(k,49)*y(k,34) +rxt(k,52)*y(k,46) +rxt(k,53)*y(k,47) & + +rxt(k,54)*y(k,48) +rxt(k,58)*y(k,54) + loss(k,38) = ( + rxt(k,43) + het_rates(k,26))* y(k,26) + prod(k,38) = (rxt(k,268)*y(k,54) +rxt(k,273)*y(k,29) +rxt(k,274)*y(k,54) + & + rxt(k,278)*y(k,29) +rxt(k,279)*y(k,54) +rxt(k,283)*y(k,29))*y(k,49) & + +rxt(k,168)*y(k,29)*y(k,25) +rxt(k,164)*y(k,28)*y(k,28) + loss(k,26) = ( + rxt(k,44) + rxt(k,190) + het_rates(k,27))* y(k,27) + prod(k,26) =rxt(k,189)*y(k,28)*y(k,28) + loss(k,91) = ((rxt(k,195) +rxt(k,196) +rxt(k,197))* y(k,5) +rxt(k,162) & + * y(k,21) + 2._r8*(rxt(k,163) +rxt(k,164) +rxt(k,165) +rxt(k,189)) & + * y(k,28) +rxt(k,167)* y(k,61) +rxt(k,169)* y(k,62) +rxt(k,172) & + * y(k,69) +rxt(k,254)* y(k,79) +rxt(k,166)* y(k,90) + (rxt(k,173) + & + rxt(k,174))* y(k,99) + rxt(k,45) + het_rates(k,28))* y(k,28) + prod(k,91) = (rxt(k,160)*y(k,90) +rxt(k,161)*y(k,71) +rxt(k,177)*y(k,54)) & + *y(k,25) + (rxt(k,47) +rxt(k,170)*y(k,69))*y(k,29) & + + (rxt(k,178)*y(k,69) +rxt(k,179)*y(k,99))*y(k,54) + (rxt(k,59) + & + rxt(k,259)*y(k,79))*y(k,73) +2.000_r8*rxt(k,190)*y(k,27) & + +rxt(k,188)*y(k,95)*y(k,49) + loss(k,75) = (rxt(k,168)* y(k,25) + (rxt(k,273) +rxt(k,278) +rxt(k,283)) & + * y(k,49) +rxt(k,170)* y(k,69) +rxt(k,171)* y(k,99) + rxt(k,46) & + + rxt(k,47) + rxt(k,271) + rxt(k,276) + rxt(k,282) & + + het_rates(k,29))* y(k,29) + prod(k,75) =rxt(k,169)*y(k,62)*y(k,28) + loss(k,4) = ( + het_rates(k,30))* y(k,30) + prod(k,4) = 0._r8 + loss(k,72) = (rxt(k,245)* y(k,99) + het_rates(k,31))* y(k,31) + prod(k,72) = (rxt(k,20) +rxt(k,21) +rxt(k,155)*y(k,25) +rxt(k,191)*y(k,3) + & + rxt(k,235)*y(k,63) +rxt(k,236)*y(k,69) +rxt(k,237)*y(k,99))*y(k,17) & + + (rxt(k,25) +rxt(k,61) +rxt(k,299)*y(k,100))*y(k,32) + (rxt(k,88) + & + rxt(k,248)*y(k,69) +rxt(k,249)*y(k,99))*y(k,74) +rxt(k,223)*y(k,25) & + *y(k,20) +.380_r8*rxt(k,24)*y(k,23) + loss(k,61) = (rxt(k,299)* y(k,100) + rxt(k,25) + rxt(k,61) + het_rates(k,32)) & + * y(k,32) + prod(k,61) =.440_r8*rxt(k,24)*y(k,23) +rxt(k,245)*y(k,99)*y(k,31) + loss(k,41) = (rxt(k,216)* y(k,95) + rxt(k,48) + het_rates(k,33))* y(k,33) + prod(k,41) = (rxt(k,181)*y(k,9) +rxt(k,183)*y(k,12) + & + 2.000_r8*rxt(k,184)*y(k,13) +2.000_r8*rxt(k,185)*y(k,14) + & + rxt(k,186)*y(k,15) +rxt(k,207)*y(k,10) +2.000_r8*rxt(k,209)*y(k,42) + & + rxt(k,233)*y(k,47) +rxt(k,234)*y(k,48))*y(k,95) + (rxt(k,53) + & + rxt(k,228)*y(k,99))*y(k,47) + (rxt(k,54) +rxt(k,229)*y(k,99))*y(k,48) & + +rxt(k,31)*y(k,9) +rxt(k,32)*y(k,10) +rxt(k,34)*y(k,12) & + +2.000_r8*rxt(k,35)*y(k,13) +2.000_r8*rxt(k,36)*y(k,14) +rxt(k,37) & + *y(k,15) +2.000_r8*rxt(k,50)*y(k,42) + loss(k,43) = (rxt(k,217)* y(k,95) + rxt(k,49) + het_rates(k,34))* y(k,34) + prod(k,43) = (rxt(k,52) +rxt(k,227)*y(k,99) +rxt(k,232)*y(k,95))*y(k,46) & + + (rxt(k,33) +rxt(k,182)*y(k,95))*y(k,11) + (rxt(k,34) + & + rxt(k,183)*y(k,95))*y(k,12) + loss(k,51) = (rxt(k,246)* y(k,63) + (rxt(k,247) +rxt(k,261))* y(k,99) & + + het_rates(k,35))* y(k,35) + prod(k,51) = 0._r8 + loss(k,5) = ( + het_rates(k,36))* y(k,36) + prod(k,5) = 0._r8 + loss(k,6) = ( + het_rates(k,37))* y(k,37) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,38))* y(k,38) + prod(k,7) = 0._r8 + loss(k,73) = (rxt(k,212)* y(k,23) +rxt(k,213)* y(k,41) +rxt(k,215)* y(k,51) & + +rxt(k,214)* y(k,103) + het_rates(k,39))* y(k,39) + prod(k,73) = (rxt(k,185)*y(k,14) +rxt(k,207)*y(k,10) + & + 2.000_r8*rxt(k,216)*y(k,33) +rxt(k,217)*y(k,34))*y(k,95) +rxt(k,32) & + *y(k,10) +rxt(k,36)*y(k,14) +2.000_r8*rxt(k,48)*y(k,33) +rxt(k,49) & + *y(k,34) +rxt(k,56)*y(k,50) + loss(k,84) = (rxt(k,116)* y(k,70) +rxt(k,119)* y(k,71) + (rxt(k,113) + & + rxt(k,114) +rxt(k,115))* y(k,90) + het_rates(k,40))* y(k,40) + prod(k,84) = (rxt(k,120)*y(k,41) +rxt(k,123)*y(k,69) +rxt(k,143)*y(k,55) + & + rxt(k,237)*y(k,17) +rxt(k,249)*y(k,74) +rxt(k,255)*y(k,77) + & + rxt(k,260)*y(k,79))*y(k,99) + (rxt(k,94)*y(k,95) + & + rxt(k,111)*y(k,69) +rxt(k,157)*y(k,25) +rxt(k,213)*y(k,39))*y(k,41) & + + (rxt(k,23) +.330_r8*rxt(k,24) +rxt(k,243)*y(k,95))*y(k,23) & + + (rxt(k,51) +rxt(k,211)*y(k,95))*y(k,45) + (rxt(k,55) + & + rxt(k,188)*y(k,95))*y(k,49) + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,103) & + +2.000_r8*rxt(k,20)*y(k,17) +rxt(k,22)*y(k,22) +rxt(k,56)*y(k,50) + loss(k,99) = (rxt(k,157)* y(k,25) +rxt(k,213)* y(k,39) +rxt(k,111)* y(k,69) & + +rxt(k,94)* y(k,95) +rxt(k,120)* y(k,99) + het_rates(k,41))* y(k,41) + prod(k,99) = (1.440_r8*rxt(k,24) +rxt(k,244)*y(k,95))*y(k,23) +rxt(k,21) & + *y(k,17) +rxt(k,113)*y(k,90)*y(k,40) +rxt(k,1)*y(k,103) + loss(k,28) = (rxt(k,209)* y(k,95) + rxt(k,50) + het_rates(k,42))* y(k,42) + prod(k,28) = 0._r8 + loss(k,65) = (rxt(k,158)* y(k,25) +rxt(k,112)* y(k,69) +rxt(k,121)* y(k,99) & + + rxt(k,4) + het_rates(k,43))* y(k,43) + prod(k,65) = (.500_r8*rxt(k,263) +rxt(k,127)*y(k,90))*y(k,90) & + +rxt(k,126)*y(k,99)*y(k,99) + loss(k,33) = ( + rxt(k,87) + het_rates(k,44))* y(k,44) + prod(k,33) =rxt(k,262)*y(k,103)*y(k,81) + loss(k,69) = (rxt(k,204)* y(k,69) + (rxt(k,210) +rxt(k,211))* y(k,95) & + +rxt(k,205)* y(k,99) + rxt(k,51) + het_rates(k,45))* y(k,45) + prod(k,69) = (rxt(k,191)*y(k,17) +rxt(k,192)*y(k,90))*y(k,3) + loss(k,42) = (rxt(k,232)* y(k,95) +rxt(k,227)* y(k,99) + rxt(k,52) & + + het_rates(k,46))* y(k,46) + prod(k,42) = 0._r8 + loss(k,44) = (rxt(k,233)* y(k,95) +rxt(k,228)* y(k,99) + rxt(k,53) & + + het_rates(k,47))* y(k,47) + prod(k,44) = 0._r8 + loss(k,48) = (rxt(k,234)* y(k,95) +rxt(k,229)* y(k,99) + rxt(k,54) & + + het_rates(k,48))* y(k,48) + prod(k,48) = 0._r8 + loss(k,85) = ((rxt(k,273) +rxt(k,278) +rxt(k,283))* y(k,29) + (rxt(k,275) + & + rxt(k,280))* y(k,53) + (rxt(k,268) +rxt(k,274) +rxt(k,279))* y(k,54) & + +rxt(k,175)* y(k,69) + (rxt(k,187) +rxt(k,188))* y(k,95) +rxt(k,176) & + * y(k,99) + rxt(k,55) + het_rates(k,49))* y(k,49) + prod(k,85) = (rxt(k,155)*y(k,17) +rxt(k,156)*y(k,23) +rxt(k,157)*y(k,41) + & + rxt(k,158)*y(k,43) +rxt(k,159)*y(k,90) +rxt(k,177)*y(k,54) + & + rxt(k,218)*y(k,16) +rxt(k,220)*y(k,18) +2.000_r8*rxt(k,223)*y(k,20) + & + rxt(k,225)*y(k,24))*y(k,25) +rxt(k,174)*y(k,99)*y(k,28) + loss(k,49) = ( + rxt(k,56) + het_rates(k,50))* y(k,50) + prod(k,49) = (rxt(k,212)*y(k,23) +rxt(k,213)*y(k,41) +rxt(k,214)*y(k,103) + & + rxt(k,215)*y(k,51))*y(k,39) + loss(k,100) = (rxt(k,215)* y(k,39) +rxt(k,152)* y(k,99) + rxt(k,9) & + + het_rates(k,51))* y(k,51) + prod(k,100) = (rxt(k,271) +rxt(k,276) +rxt(k,282) +rxt(k,273)*y(k,49) + & + rxt(k,278)*y(k,49) +rxt(k,283)*y(k,49))*y(k,29) & + + (2.000_r8*rxt(k,264) +2.000_r8*rxt(k,267) +2.000_r8*rxt(k,270) + & + 2.000_r8*rxt(k,281))*y(k,57) + (rxt(k,269) +rxt(k,272) +rxt(k,277)) & + *y(k,6) + (rxt(k,266) +rxt(k,235)*y(k,17) +rxt(k,246)*y(k,35)) & + *y(k,63) + (.500_r8*rxt(k,265) +rxt(k,151)*y(k,99))*y(k,62) + loss(k,57) = (rxt(k,128)* y(k,99) + rxt(k,10) + rxt(k,11) + rxt(k,153) & + + het_rates(k,52))* y(k,52) + prod(k,57) =rxt(k,149)*y(k,90)*y(k,62) + loss(k,68) = ((rxt(k,275) +rxt(k,280))* y(k,49) +rxt(k,206)* y(k,69) & + + rxt(k,57) + het_rates(k,53))* y(k,53) + prod(k,68) = (rxt(k,269) +rxt(k,272) +rxt(k,277))*y(k,6) +rxt(k,198)*y(k,90) & + *y(k,5) + loss(k,70) = (rxt(k,177)* y(k,25) + (rxt(k,268) +rxt(k,274) +rxt(k,279)) & + * y(k,49) +rxt(k,178)* y(k,69) +rxt(k,179)* y(k,99) + rxt(k,58) & + + het_rates(k,54))* y(k,54) + prod(k,70) = (rxt(k,271) +rxt(k,276) +rxt(k,282) +rxt(k,171)*y(k,99))*y(k,29) & + +rxt(k,166)*y(k,90)*y(k,28) + loss(k,78) = (rxt(k,131)* y(k,61) + (rxt(k,132) +rxt(k,133) +rxt(k,134)) & + * y(k,62) +rxt(k,135)* y(k,70) +rxt(k,296)* y(k,98) +rxt(k,143) & + * y(k,99) + rxt(k,62) + het_rates(k,55))* y(k,55) + prod(k,78) = (rxt(k,129)*y(k,91) +rxt(k,293)*y(k,94))*y(k,69) & + + (.200_r8*rxt(k,287)*y(k,93) +1.100_r8*rxt(k,289)*y(k,92))*y(k,89) & + +rxt(k,15)*y(k,61) +rxt(k,294)*y(k,94)*y(k,70) +rxt(k,300)*y(k,100) + loss(k,46) = ((rxt(k,147) +rxt(k,148))* y(k,95) + rxt(k,12) & + + het_rates(k,56))* y(k,56) + prod(k,46) =rxt(k,132)*y(k,62)*y(k,55) + loss(k,50) = ( + rxt(k,13) + rxt(k,14) + rxt(k,154) + rxt(k,264) + rxt(k,267) & + + rxt(k,270) + rxt(k,281) + het_rates(k,57))* y(k,57) + prod(k,50) =rxt(k,150)*y(k,63)*y(k,62) + loss(k,8) = ( + het_rates(k,58))* y(k,58) + prod(k,8) = 0._r8 + loss(k,9) = ( + het_rates(k,59))* y(k,59) + prod(k,9) = 0._r8 + loss(k,10) = ( + het_rates(k,60))* y(k,60) + prod(k,10) = 0._r8 + loss(k,95) = (rxt(k,199)* y(k,5) +rxt(k,239)* y(k,21) +rxt(k,167)* y(k,28) & + +rxt(k,131)* y(k,55) +rxt(k,140)* y(k,63) +rxt(k,146)* y(k,69) & + +rxt(k,145)* y(k,71) +rxt(k,144)* y(k,90) +rxt(k,298)* y(k,98) & + + rxt(k,15) + rxt(k,16) + het_rates(k,61))* y(k,61) + prod(k,95) = (rxt(k,17) +.500_r8*rxt(k,265) +2.000_r8*rxt(k,133)*y(k,55) + & + rxt(k,136)*y(k,69) +rxt(k,256)*y(k,79))*y(k,62) & + + (rxt(k,135)*y(k,70) +rxt(k,143)*y(k,99))*y(k,55) & + +2.000_r8*rxt(k,147)*y(k,95)*y(k,56) +rxt(k,14)*y(k,57) +rxt(k,19) & + *y(k,63) +rxt(k,130)*y(k,91)*y(k,70) +rxt(k,297)*y(k,98) +rxt(k,310) & + *y(k,102) + loss(k,92) = (rxt(k,200)* y(k,5) +rxt(k,169)* y(k,28) + (rxt(k,132) + & + rxt(k,133) +rxt(k,134))* y(k,55) +rxt(k,150)* y(k,63) + (rxt(k,136) + & + rxt(k,138))* y(k,69) +rxt(k,137)* y(k,71) +rxt(k,256)* y(k,79) & + +rxt(k,149)* y(k,90) +rxt(k,151)* y(k,99) + rxt(k,17) + rxt(k,265) & + + het_rates(k,62))* y(k,62) + prod(k,92) = (2.000_r8*rxt(k,140)*y(k,63) +rxt(k,144)*y(k,90) + & + rxt(k,145)*y(k,71) +rxt(k,146)*y(k,69) +rxt(k,167)*y(k,28) + & + rxt(k,199)*y(k,5) +rxt(k,239)*y(k,21))*y(k,61) + (rxt(k,18) + & + rxt(k,139)*y(k,90) +rxt(k,141)*y(k,69) +rxt(k,142)*y(k,99))*y(k,63) & + + (rxt(k,11) +rxt(k,153) +rxt(k,128)*y(k,99))*y(k,52) + (rxt(k,13) + & + rxt(k,154))*y(k,57) +rxt(k,28)*y(k,6) +rxt(k,47)*y(k,29) +rxt(k,9) & + *y(k,51) + loss(k,90) = (rxt(k,235)* y(k,17) +rxt(k,246)* y(k,35) +rxt(k,140)* y(k,61) & + +rxt(k,150)* y(k,62) +rxt(k,141)* y(k,69) +rxt(k,139)* y(k,90) & + +rxt(k,142)* y(k,99) + rxt(k,18) + rxt(k,19) + rxt(k,266) & + + het_rates(k,63))* y(k,63) + prod(k,90) = (rxt(k,46) +rxt(k,168)*y(k,25) +rxt(k,170)*y(k,69) + & + rxt(k,171)*y(k,99))*y(k,29) + (rxt(k,13) +rxt(k,14) +rxt(k,154)) & + *y(k,57) + (rxt(k,29) +rxt(k,201)*y(k,69))*y(k,6) & + + (rxt(k,152)*y(k,99) +rxt(k,215)*y(k,39))*y(k,51) & + + (rxt(k,137)*y(k,71) +rxt(k,138)*y(k,69))*y(k,62) +rxt(k,10) & + *y(k,52) + loss(k,11) = ( + het_rates(k,64))* y(k,64) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,65))* y(k,65) + prod(k,12) = 0._r8 + loss(k,13) = ( + het_rates(k,66))* y(k,66) + prod(k,13) = 0._r8 + loss(k,14) = ( + het_rates(k,67))* y(k,67) + prod(k,14) = 0._r8 + loss(k,15) = ( + het_rates(k,68))* y(k,68) + prod(k,15) = 0._r8 + loss(k,93) = (rxt(k,202)* y(k,5) +rxt(k,201)* y(k,6) +rxt(k,236)* y(k,17) & + +rxt(k,172)* y(k,28) +rxt(k,170)* y(k,29) +rxt(k,111)* y(k,41) & + +rxt(k,112)* y(k,43) +rxt(k,204)* y(k,45) +rxt(k,175)* y(k,49) & + +rxt(k,206)* y(k,53) +rxt(k,178)* y(k,54) +rxt(k,146)* y(k,61) & + + (rxt(k,136) +rxt(k,138))* y(k,62) +rxt(k,141)* y(k,63) & + + 2._r8*rxt(k,109)* y(k,69) +rxt(k,110)* y(k,70) +rxt(k,108) & + * y(k,71) +rxt(k,248)* y(k,74) +rxt(k,117)* y(k,90) + (rxt(k,291) + & + rxt(k,292))* y(k,92) +rxt(k,293)* y(k,94) +rxt(k,123)* y(k,99) & + + rxt(k,71) + rxt(k,72) + rxt(k,73) + rxt(k,74) + rxt(k,75) & + + rxt(k,76) + het_rates(k,69))* y(k,69) + prod(k,93) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,77) +rxt(k,79) +rxt(k,81) + & + 2.000_r8*rxt(k,82) +2.000_r8*rxt(k,83) +rxt(k,84) +rxt(k,85) + & + rxt(k,86) +rxt(k,97)*y(k,95) +rxt(k,98)*y(k,95) +rxt(k,135)*y(k,55) + & + rxt(k,250)*y(k,77) +rxt(k,257)*y(k,79) +rxt(k,295)*y(k,94) + & + rxt(k,302)*y(k,100) +rxt(k,306)*y(k,101))*y(k,70) & + + (rxt(k,131)*y(k,61) +rxt(k,132)*y(k,62) +rxt(k,296)*y(k,98)) & + *y(k,55) + (rxt(k,25) +rxt(k,61))*y(k,32) + (rxt(k,287)*y(k,93) + & + 1.150_r8*rxt(k,288)*y(k,98))*y(k,89) +rxt(k,27)*y(k,5) & + +.180_r8*rxt(k,24)*y(k,23) +rxt(k,45)*y(k,28) +rxt(k,115)*y(k,90) & + *y(k,40) +rxt(k,14)*y(k,57) +rxt(k,15)*y(k,61) +rxt(k,17)*y(k,62) & + +rxt(k,18)*y(k,63) +rxt(k,8)*y(k,71) +rxt(k,59)*y(k,73) +rxt(k,89) & + *y(k,79) +rxt(k,90)*y(k,80) +rxt(k,91)*y(k,81) +rxt(k,301)*y(k,100) & + *y(k,91) +rxt(k,96)*y(k,95) +rxt(k,125)*y(k,99)*y(k,99) +rxt(k,304) & + *y(k,101) +rxt(k,309)*y(k,102) +rxt(k,2)*y(k,103) + loss(k,87) = (rxt(k,116)* y(k,40) +rxt(k,135)* y(k,55) +rxt(k,110)* y(k,69) & + +rxt(k,250)* y(k,77) +rxt(k,257)* y(k,79) +rxt(k,130)* y(k,91) & + +rxt(k,290)* y(k,92) + (rxt(k,294) +rxt(k,295))* y(k,94) +rxt(k,97) & + * y(k,95) +rxt(k,102)* y(k,96) +rxt(k,302)* y(k,100) +rxt(k,306) & + * y(k,101) + rxt(k,5) + rxt(k,6) + rxt(k,77) + rxt(k,78) + rxt(k,79) & + + rxt(k,80) + rxt(k,81) + rxt(k,82) + rxt(k,83) + rxt(k,84) & + + rxt(k,85) + rxt(k,86) + het_rates(k,70))* y(k,70) + prod(k,87) = (rxt(k,8) +2.000_r8*rxt(k,99)*y(k,95) + & + 2.000_r8*rxt(k,108)*y(k,69) +2.000_r8*rxt(k,118)*y(k,90) + & + rxt(k,119)*y(k,40) +rxt(k,124)*y(k,99) +rxt(k,137)*y(k,62) + & + rxt(k,145)*y(k,61) +rxt(k,161)*y(k,25) +rxt(k,193)*y(k,3) + & + rxt(k,252)*y(k,77) +rxt(k,258)*y(k,79))*y(k,71) & + + (rxt(k,113)*y(k,40) +rxt(k,117)*y(k,69) +rxt(k,122)*y(k,99) + & + rxt(k,127)*y(k,90) +rxt(k,139)*y(k,63) +rxt(k,159)*y(k,25) + & + rxt(k,166)*y(k,28) +rxt(k,192)*y(k,3) +rxt(k,198)*y(k,5) + & + rxt(k,238)*y(k,21))*y(k,90) + (rxt(k,101)*y(k,96) + & + rxt(k,109)*y(k,69) +rxt(k,123)*y(k,99) +rxt(k,136)*y(k,62) + & + rxt(k,141)*y(k,63) +rxt(k,172)*y(k,28) +rxt(k,202)*y(k,5))*y(k,69) & + + (rxt(k,163)*y(k,28) +rxt(k,164)*y(k,28) +rxt(k,174)*y(k,99) + & + rxt(k,196)*y(k,5) +rxt(k,197)*y(k,5))*y(k,28) + (rxt(k,92) + & + rxt(k,100) +2.000_r8*rxt(k,102)*y(k,70))*y(k,96) +rxt(k,194)*y(k,5) & + *y(k,5) +rxt(k,128)*y(k,99)*y(k,52) +rxt(k,134)*y(k,62)*y(k,55) & + +rxt(k,148)*y(k,95)*y(k,56) +rxt(k,298)*y(k,98)*y(k,61) +rxt(k,19) & + *y(k,63) +rxt(k,93)*y(k,97) + loss(k,88) = (rxt(k,193)* y(k,3) +rxt(k,161)* y(k,25) +rxt(k,119)* y(k,40) & + +rxt(k,145)* y(k,61) +rxt(k,137)* y(k,62) +rxt(k,108)* y(k,69) & + +rxt(k,252)* y(k,77) +rxt(k,258)* y(k,79) +rxt(k,118)* y(k,90) & + +rxt(k,99)* y(k,95) +rxt(k,124)* y(k,99) + rxt(k,7) + rxt(k,8) & + + het_rates(k,71))* y(k,71) + prod(k,88) =rxt(k,110)*y(k,70)*y(k,69) + loss(k,52) = (rxt(k,259)* y(k,79) + rxt(k,59) + het_rates(k,73))* y(k,73) + prod(k,52) = (rxt(k,165)*y(k,28) +rxt(k,195)*y(k,5))*y(k,28) + loss(k,53) = (rxt(k,248)* y(k,69) +rxt(k,249)* y(k,99) + rxt(k,88) & + + het_rates(k,74))* y(k,74) + prod(k,53) = 0._r8 + loss(k,16) = ( + het_rates(k,75))* y(k,75) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,76))* y(k,76) + prod(k,17) = 0._r8 + loss(k,66) = (rxt(k,250)* y(k,70) +rxt(k,252)* y(k,71) +rxt(k,255)* y(k,99) & + + het_rates(k,77))* y(k,77) + prod(k,66) =rxt(k,88)*y(k,74) +rxt(k,89)*y(k,79) + loss(k,18) = ( + rxt(k,60) + het_rates(k,78))* y(k,78) + prod(k,18) = 0._r8 + loss(k,83) = (rxt(k,253)* y(k,5) +rxt(k,254)* y(k,28) +rxt(k,256)* y(k,62) & + +rxt(k,257)* y(k,70) +rxt(k,258)* y(k,71) +rxt(k,259)* y(k,73) & + +rxt(k,260)* y(k,99) + rxt(k,89) + het_rates(k,79))* y(k,79) + prod(k,83) = (rxt(k,250)*y(k,70) +rxt(k,252)*y(k,71) +rxt(k,255)*y(k,99)) & + *y(k,77) +rxt(k,248)*y(k,74)*y(k,69) +rxt(k,90)*y(k,80) + loss(k,74) = (rxt(k,251)* y(k,99) + rxt(k,90) + het_rates(k,80))* y(k,80) + prod(k,74) = (rxt(k,253)*y(k,5) +rxt(k,254)*y(k,28) +rxt(k,256)*y(k,62) + & + rxt(k,257)*y(k,70) +rxt(k,258)*y(k,71) +rxt(k,259)*y(k,73) + & + rxt(k,260)*y(k,99))*y(k,79) + (rxt(k,246)*y(k,63) + & + rxt(k,247)*y(k,99) +.500_r8*rxt(k,261)*y(k,99))*y(k,35) & + +rxt(k,249)*y(k,99)*y(k,74) +rxt(k,91)*y(k,81) + loss(k,47) = (rxt(k,262)* y(k,103) + rxt(k,91) + het_rates(k,81))* y(k,81) + prod(k,47) =rxt(k,87)*y(k,44) +rxt(k,251)*y(k,99)*y(k,80) + loss(k,19) = ( + het_rates(k,82))* y(k,82) + prod(k,19) = 0._r8 + loss(k,20) = ( + het_rates(k,83))* y(k,83) + prod(k,20) = 0._r8 + loss(k,21) = ( + het_rates(k,84))* y(k,84) + prod(k,21) = 0._r8 + loss(k,22) = ( + het_rates(k,85))* y(k,85) + prod(k,22) = 0._r8 + loss(k,23) = ( + het_rates(k,86))* y(k,86) + prod(k,23) = 0._r8 + loss(k,24) = ( + het_rates(k,87))* y(k,87) + prod(k,24) = 0._r8 + loss(k,25) = ( + het_rates(k,88))* y(k,88) + prod(k,25) = 0._r8 + loss(k,76) = (rxt(k,289)* y(k,92) +rxt(k,287)* y(k,93) +rxt(k,288)* y(k,98) & + + het_rates(k,89))* y(k,89) + prod(k,76) = (rxt(k,77) +rxt(k,78) +rxt(k,79) +rxt(k,80) +rxt(k,81) + & + rxt(k,84) +rxt(k,85) +rxt(k,86))*y(k,70) + (rxt(k,71) +rxt(k,72) + & + rxt(k,73) +rxt(k,74) +rxt(k,75) +rxt(k,76))*y(k,69) +rxt(k,62) & + *y(k,55) +rxt(k,16)*y(k,61) + loss(k,89) = (rxt(k,192)* y(k,3) +rxt(k,198)* y(k,5) +rxt(k,238)* y(k,21) & + + (rxt(k,159) +rxt(k,160))* y(k,25) +rxt(k,166)* y(k,28) & + + (rxt(k,113) +rxt(k,114) +rxt(k,115))* y(k,40) +rxt(k,144)* y(k,61) & + +rxt(k,149)* y(k,62) +rxt(k,139)* y(k,63) +rxt(k,117)* y(k,69) & + +rxt(k,118)* y(k,71) + 2._r8*rxt(k,127)* y(k,90) +rxt(k,122) & + * y(k,99) + rxt(k,263) + het_rates(k,90))* y(k,90) + prod(k,89) = (rxt(k,121)*y(k,43) +rxt(k,124)*y(k,71) +rxt(k,142)*y(k,63) + & + rxt(k,173)*y(k,28) +rxt(k,203)*y(k,5) +rxt(k,221)*y(k,18) + & + rxt(k,224)*y(k,20) +rxt(k,245)*y(k,31) +rxt(k,251)*y(k,80) + & + .500_r8*rxt(k,261)*y(k,35))*y(k,99) + (rxt(k,155)*y(k,25) + & + rxt(k,191)*y(k,3) +rxt(k,235)*y(k,63) +rxt(k,236)*y(k,69))*y(k,17) & + + (rxt(k,158)*y(k,43) +rxt(k,220)*y(k,18) +rxt(k,223)*y(k,20)) & + *y(k,25) + (rxt(k,162)*y(k,28) +rxt(k,239)*y(k,61))*y(k,21) & + + (rxt(k,11) +rxt(k,153))*y(k,52) +rxt(k,243)*y(k,95)*y(k,23) & + +rxt(k,116)*y(k,70)*y(k,40) +rxt(k,112)*y(k,69)*y(k,43) + loss(k,77) = (rxt(k,129)* y(k,69) +rxt(k,130)* y(k,70) +rxt(k,301)* y(k,100) & + + het_rates(k,91))* y(k,91) + prod(k,77) = (.800_r8*rxt(k,287)*y(k,93) +.900_r8*rxt(k,289)*y(k,92))*y(k,89) & + +rxt(k,291)*y(k,92)*y(k,69) + loss(k,64) = ((rxt(k,291) +rxt(k,292))* y(k,69) +rxt(k,290)* y(k,70) & + +rxt(k,289)* y(k,89) + het_rates(k,92))* y(k,92) + prod(k,64) =rxt(k,304)*y(k,101) +rxt(k,309)*y(k,102) + loss(k,67) = (rxt(k,287)* y(k,89) + het_rates(k,93))* y(k,93) + prod(k,67) = (rxt(k,297) +rxt(k,296)*y(k,55) +rxt(k,298)*y(k,61))*y(k,98) & + +rxt(k,16)*y(k,61) +rxt(k,291)*y(k,92)*y(k,69) +rxt(k,295)*y(k,94) & + *y(k,70) +rxt(k,300)*y(k,100) + loss(k,71) = (rxt(k,293)* y(k,69) + (rxt(k,294) +rxt(k,295))* y(k,70) & + + het_rates(k,94))* y(k,94) + prod(k,71) =rxt(k,62)*y(k,55) +rxt(k,301)*y(k,100)*y(k,91) +rxt(k,310) & + *y(k,102) + loss(k,94) = (rxt(k,180)* y(k,8) +rxt(k,181)* y(k,9) +rxt(k,207)* y(k,10) & + +rxt(k,182)* y(k,11) +rxt(k,183)* y(k,12) +rxt(k,184)* y(k,13) & + +rxt(k,185)* y(k,14) +rxt(k,186)* y(k,15) +rxt(k,230)* y(k,16) & + +rxt(k,231)* y(k,18) + (rxt(k,242) +rxt(k,243) +rxt(k,244))* y(k,23) & + +rxt(k,208)* y(k,24) +rxt(k,216)* y(k,33) +rxt(k,217)* y(k,34) & + +rxt(k,94)* y(k,41) +rxt(k,209)* y(k,42) + (rxt(k,210) +rxt(k,211)) & + * y(k,45) +rxt(k,232)* y(k,46) +rxt(k,233)* y(k,47) +rxt(k,234) & + * y(k,48) + (rxt(k,187) +rxt(k,188))* y(k,49) + (rxt(k,147) + & + rxt(k,148))* y(k,56) + (rxt(k,97) +rxt(k,98))* y(k,70) +rxt(k,99) & + * y(k,71) +rxt(k,95)* y(k,103) + rxt(k,96) + het_rates(k,95)) & + * y(k,95) + prod(k,94) = (rxt(k,6) +rxt(k,130)*y(k,91))*y(k,70) +rxt(k,12)*y(k,56) & + +rxt(k,7)*y(k,71) +.850_r8*rxt(k,288)*y(k,98)*y(k,89) +rxt(k,1) & + *y(k,103) + loss(k,39) = (rxt(k,101)* y(k,69) +rxt(k,102)* y(k,70) + rxt(k,92) & + + rxt(k,100) + het_rates(k,96))* y(k,96) + prod(k,39) = (rxt(k,104) +rxt(k,103)*y(k,32) +rxt(k,105)*y(k,69) + & + rxt(k,106)*y(k,70) +rxt(k,107)*y(k,71))*y(k,97) +rxt(k,7)*y(k,71) + loss(k,40) = (rxt(k,103)* y(k,32) +rxt(k,105)* y(k,69) +rxt(k,106)* y(k,70) & + +rxt(k,107)* y(k,71) + rxt(k,93) + rxt(k,104) + het_rates(k,97)) & + * y(k,97) + prod(k,40) =rxt(k,97)*y(k,95)*y(k,70) + loss(k,79) = (rxt(k,296)* y(k,55) +rxt(k,298)* y(k,61) +rxt(k,288)* y(k,89) & + + rxt(k,297) + het_rates(k,98))* y(k,98) + prod(k,79) = (rxt(k,78) +rxt(k,80) +rxt(k,290)*y(k,92) +rxt(k,294)*y(k,94) + & + rxt(k,302)*y(k,100) +rxt(k,306)*y(k,101))*y(k,70) & + +rxt(k,299)*y(k,100)*y(k,32) + loss(k,98) = (rxt(k,203)* y(k,5) +rxt(k,219)* y(k,16) +rxt(k,237)* y(k,17) & + +rxt(k,221)* y(k,18) +rxt(k,222)* y(k,19) +rxt(k,224)* y(k,20) & + +rxt(k,240)* y(k,22) +rxt(k,241)* y(k,23) +rxt(k,226)* y(k,24) & + + (rxt(k,173) +rxt(k,174))* y(k,28) +rxt(k,171)* y(k,29) +rxt(k,245) & + * y(k,31) + (rxt(k,247) +rxt(k,261))* y(k,35) +rxt(k,120)* y(k,41) & + +rxt(k,121)* y(k,43) +rxt(k,205)* y(k,45) +rxt(k,227)* y(k,46) & + +rxt(k,228)* y(k,47) +rxt(k,229)* y(k,48) +rxt(k,176)* y(k,49) & + +rxt(k,152)* y(k,51) +rxt(k,128)* y(k,52) +rxt(k,179)* y(k,54) & + +rxt(k,143)* y(k,55) +rxt(k,151)* y(k,62) +rxt(k,142)* y(k,63) & + +rxt(k,123)* y(k,69) +rxt(k,124)* y(k,71) +rxt(k,249)* y(k,74) & + +rxt(k,255)* y(k,77) +rxt(k,260)* y(k,79) +rxt(k,251)* y(k,80) & + +rxt(k,122)* y(k,90) + 2._r8*(rxt(k,125) +rxt(k,126))* y(k,99) & + + het_rates(k,99))* y(k,99) + prod(k,98) = (rxt(k,111)*y(k,41) +rxt(k,112)*y(k,43) +rxt(k,117)*y(k,90) + & + rxt(k,175)*y(k,49) +rxt(k,178)*y(k,54) +rxt(k,204)*y(k,45) + & + rxt(k,206)*y(k,53) +rxt(k,236)*y(k,17))*y(k,69) & + + (2.000_r8*rxt(k,114)*y(k,40) +rxt(k,118)*y(k,71) + & + rxt(k,139)*y(k,63) +rxt(k,144)*y(k,61) +rxt(k,160)*y(k,25))*y(k,90) & + + (rxt(k,94)*y(k,41) +2.000_r8*rxt(k,95)*y(k,103) + & + rxt(k,187)*y(k,49) +rxt(k,210)*y(k,45) +rxt(k,242)*y(k,23))*y(k,95) & + + (rxt(k,22) +.300_r8*rxt(k,240)*y(k,99))*y(k,22) + (rxt(k,3) + & + rxt(k,214)*y(k,39))*y(k,103) +.330_r8*rxt(k,24)*y(k,23) & + +rxt(k,119)*y(k,71)*y(k,40) +2.000_r8*rxt(k,4)*y(k,43) +rxt(k,9) & + *y(k,51) +rxt(k,10)*y(k,52) +rxt(k,57)*y(k,53) +rxt(k,58)*y(k,54) & + +.500_r8*rxt(k,265)*y(k,62) + loss(k,80) = (rxt(k,299)* y(k,32) +rxt(k,302)* y(k,70) +rxt(k,301)* y(k,91) & + + rxt(k,300) + het_rates(k,100))* y(k,100) + prod(k,80) = (rxt(k,73) +rxt(k,74) +rxt(k,292)*y(k,92) +rxt(k,293)*y(k,94) + & + rxt(k,305)*y(k,101) +rxt(k,311)*y(k,102))*y(k,69) + (rxt(k,79) + & + rxt(k,81))*y(k,70) + (rxt(k,303)*y(k,101) +rxt(k,308)*y(k,102)) & + *y(k,89) +rxt(k,285)*y(k,101) +rxt(k,284)*y(k,102) + loss(k,60) = (rxt(k,305)* y(k,69) +rxt(k,306)* y(k,70) +rxt(k,303)* y(k,89) & + + rxt(k,285) + rxt(k,304) + het_rates(k,101))* y(k,101) + prod(k,60) = (rxt(k,75) +rxt(k,76))*y(k,69) + (rxt(k,85) +rxt(k,86))*y(k,70) & + + (rxt(k,286) +rxt(k,307)*y(k,89))*y(k,102) + loss(k,59) = (rxt(k,311)* y(k,69) + (rxt(k,307) +rxt(k,308))* y(k,89) & + + rxt(k,284) + rxt(k,286) + rxt(k,309) + rxt(k,310) & + + het_rates(k,102))* y(k,102) + prod(k,59) = (rxt(k,71) +rxt(k,72))*y(k,69) + (rxt(k,77) +rxt(k,84))*y(k,70) + loss(k,102) = (rxt(k,214)* y(k,39) +rxt(k,262)* y(k,81) +rxt(k,95)* y(k,95) & + + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,103))* y(k,103) + prod(k,102) = (rxt(k,120)*y(k,41) +rxt(k,121)*y(k,43) +rxt(k,122)*y(k,90) + & + rxt(k,125)*y(k,99) +rxt(k,128)*y(k,52) +rxt(k,152)*y(k,51) + & + rxt(k,176)*y(k,49) +rxt(k,179)*y(k,54) +rxt(k,205)*y(k,45) + & + rxt(k,219)*y(k,16) +rxt(k,221)*y(k,18) +rxt(k,222)*y(k,19) + & + rxt(k,224)*y(k,20) +rxt(k,229)*y(k,48) +rxt(k,237)*y(k,17) + & + rxt(k,240)*y(k,22) +rxt(k,241)*y(k,23))*y(k,99) & + + (rxt(k,268)*y(k,54) +rxt(k,274)*y(k,54) +rxt(k,275)*y(k,53) + & + rxt(k,279)*y(k,54) +rxt(k,280)*y(k,53))*y(k,49) +.050_r8*rxt(k,24) & + *y(k,23) +rxt(k,115)*y(k,90)*y(k,40) +rxt(k,87)*y(k,44) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_ma_mam5/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_ma_mam5/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..bbe9d4d986 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/mo_rxt_rates_conv.F90 @@ -0,0 +1,323 @@ +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,:, 103) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 103) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 103) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 43) ! rate_const*H2O2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 70) ! rate_const*O2 + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 70) ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 71) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 71) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 51) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 52) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 52) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 56) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 57) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 57) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 61) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 61) ! rate_const*NO + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 62) ! rate_const*NO2 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 63) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 63) ! rate_const*NO3 + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 17) ! rate_const*CH2O + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 17) ! rate_const*CH2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 22) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 23) ! rate_const*CH4 + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 23) ! rate_const*CH4 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 32) ! rate_const*CO2 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 4) ! rate_const*BRCL + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 5) ! rate_const*BRO + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 8) ! rate_const*CCL4 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 9) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 10) ! rate_const*CF3BR + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 11) ! rate_const*CFC11 + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 12) ! rate_const*CFC113 + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 13) ! rate_const*CFC114 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 14) ! rate_const*CFC115 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 15) ! rate_const*CFC12 + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 16) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 18) ! rate_const*CH3BR + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 19) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 20) ! rate_const*CH3CL + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 24) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 26) ! rate_const*CL2 + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 27) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 28) ! rate_const*CLO + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 33) ! rate_const*COF2 + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 34) ! rate_const*COFCL + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 42) ! rate_const*H2402 + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 45) ! rate_const*HBR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 46) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 47) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 48) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 49) ! rate_const*HCL + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 50) ! rate_const*HF + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 53) ! rate_const*HOBR + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 54) ! rate_const*HOCL + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 73) ! rate_const*OCLO + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 78) ! rate_const*SF6 + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 32) ! rate_const*CO2 + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 55) ! rate_const*N + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 69) ! rate_const*O + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 69) ! rate_const*O + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 69) ! rate_const*O + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 69) ! rate_const*O + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 69) ! rate_const*O + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 69) ! rate_const*O + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 70) ! rate_const*O2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 70) ! rate_const*O2 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 70) ! rate_const*O2 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 70) ! rate_const*O2 + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 70) ! rate_const*O2 + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 70) ! rate_const*O2 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 70) ! rate_const*O2 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 70) ! rate_const*O2 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 70) ! rate_const*O2 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 70) ! rate_const*O2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 44) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 74) ! rate_const*OCS + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 79) ! rate_const*SO + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 80) ! rate_const*SO2 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 81) ! rate_const*SO3 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 96) ! rate_const*O2_1D + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 97) ! rate_const*O2_1S + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 95)*sol(:ncol,:, 41) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 95)*sol(:ncol,:, 103) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 95) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 95)*sol(:ncol,:, 70) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 95)*sol(:ncol,:, 70) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 95)*sol(:ncol,:, 71) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 96) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 96)*sol(:ncol,:, 69) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 96)*sol(:ncol,:, 70) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 97)*sol(:ncol,:, 32) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 97) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 97)*sol(:ncol,:, 69) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 97)*sol(:ncol,:, 70) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 97)*sol(:ncol,:, 71) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 69)*sol(:ncol,:, 71) ! rate_const*O*O3 + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 69)*sol(:ncol,:, 69) ! rate_const*M*O*O + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 69)*sol(:ncol,:, 70) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 41)*sol(:ncol,:, 69) ! rate_const*H2*O + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 43)*sol(:ncol,:, 69) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 40)*sol(:ncol,:, 90) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 40)*sol(:ncol,:, 90) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 40)*sol(:ncol,:, 90) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 40)*sol(:ncol,:, 70) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 90)*sol(:ncol,:, 69) ! rate_const*HO2*O + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 90)*sol(:ncol,:, 71) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 40)*sol(:ncol,:, 71) ! rate_const*H*O3 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 99)*sol(:ncol,:, 41) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 99)*sol(:ncol,:, 43) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 99)*sol(:ncol,:, 90) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 99)*sol(:ncol,:, 69) ! rate_const*OH*O + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 99)*sol(:ncol,:, 71) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 99)*sol(:ncol,:, 99) ! rate_const*OH*OH + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 99)*sol(:ncol,:, 99) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 90)*sol(:ncol,:, 90) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 52)*sol(:ncol,:, 99) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 91)*sol(:ncol,:, 69) ! rate_const*N2D*O + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 91)*sol(:ncol,:, 70) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 55)*sol(:ncol,:, 61) ! rate_const*N*NO + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 55)*sol(:ncol,:, 62) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 55)*sol(:ncol,:, 62) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 55)*sol(:ncol,:, 62) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 55)*sol(:ncol,:, 70) ! rate_const*N*O2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 62)*sol(:ncol,:, 69) ! rate_const*NO2*O + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 62)*sol(:ncol,:, 71) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 62)*sol(:ncol,:, 69) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 63)*sol(:ncol,:, 90) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 63)*sol(:ncol,:, 61) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 63)*sol(:ncol,:, 69) ! rate_const*NO3*O + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 63)*sol(:ncol,:, 99) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 55)*sol(:ncol,:, 99) ! rate_const*N*OH + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 61)*sol(:ncol,:, 90) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 61)*sol(:ncol,:, 71) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 61)*sol(:ncol,:, 69) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 95)*sol(:ncol,:, 56) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 95)*sol(:ncol,:, 56) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 62)*sol(:ncol,:, 90) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 62)*sol(:ncol,:, 63) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 62)*sol(:ncol,:, 99) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 51)*sol(:ncol,:, 99) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 52) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 57) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 25)*sol(:ncol,:, 17) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 25)*sol(:ncol,:, 23) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 25)*sol(:ncol,:, 41) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 25)*sol(:ncol,:, 43) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 25)*sol(:ncol,:, 90) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 25)*sol(:ncol,:, 90) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 25)*sol(:ncol,:, 71) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 28)*sol(:ncol,:, 21) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 28)*sol(:ncol,:, 90) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 28)*sol(:ncol,:, 61) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 29)*sol(:ncol,:, 25) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 28)*sol(:ncol,:, 62) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 29)*sol(:ncol,:, 69) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 29)*sol(:ncol,:, 99) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 28)*sol(:ncol,:, 69) ! rate_const*CLO*O + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 28)*sol(:ncol,:, 99) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 28)*sol(:ncol,:, 99) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 49)*sol(:ncol,:, 69) ! rate_const*HCL*O + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 49)*sol(:ncol,:, 99) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 54)*sol(:ncol,:, 25) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 54)*sol(:ncol,:, 69) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 54)*sol(:ncol,:, 99) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 95)*sol(:ncol,:, 8) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 95)*sol(:ncol,:, 9) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 95)*sol(:ncol,:, 11) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 95)*sol(:ncol,:, 12) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 95)*sol(:ncol,:, 13) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 95)*sol(:ncol,:, 14) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 95)*sol(:ncol,:, 15) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 95)*sol(:ncol,:, 49) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 95)*sol(:ncol,:, 49) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 27) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 3)*sol(:ncol,:, 17) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 3)*sol(:ncol,:, 90) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 3)*sol(:ncol,:, 71) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 5)*sol(:ncol,:, 5) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 5)*sol(:ncol,:, 28) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 5)*sol(:ncol,:, 28) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 5)*sol(:ncol,:, 28) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 5)*sol(:ncol,:, 90) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 5)*sol(:ncol,:, 61) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 5)*sol(:ncol,:, 62) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 6)*sol(:ncol,:, 69) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 5)*sol(:ncol,:, 69) ! rate_const*BRO*O + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 5)*sol(:ncol,:, 99) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 45)*sol(:ncol,:, 69) ! rate_const*HBR*O + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 45)*sol(:ncol,:, 99) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 53)*sol(:ncol,:, 69) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 95)*sol(:ncol,:, 10) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 95)*sol(:ncol,:, 24) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 95)*sol(:ncol,:, 42) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 95)*sol(:ncol,:, 45) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 95)*sol(:ncol,:, 45) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 39)*sol(:ncol,:, 23) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 39)*sol(:ncol,:, 41) ! rate_const*F*H2 + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 39)*sol(:ncol,:, 103) ! rate_const*F*H2O + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 39)*sol(:ncol,:, 51) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 95)*sol(:ncol,:, 33) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 95)*sol(:ncol,:, 34) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 16)*sol(:ncol,:, 25) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 16)*sol(:ncol,:, 99) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 18)*sol(:ncol,:, 25) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 18)*sol(:ncol,:, 99) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 19)*sol(:ncol,:, 99) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 20)*sol(:ncol,:, 25) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 20)*sol(:ncol,:, 99) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 24)*sol(:ncol,:, 25) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 24)*sol(:ncol,:, 99) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 46)*sol(:ncol,:, 99) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 47)*sol(:ncol,:, 99) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 48)*sol(:ncol,:, 99) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 95)*sol(:ncol,:, 16) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 95)*sol(:ncol,:, 18) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 95)*sol(:ncol,:, 46) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 95)*sol(:ncol,:, 47) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 95)*sol(:ncol,:, 48) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 17)*sol(:ncol,:, 63) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 17)*sol(:ncol,:, 69) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 17)*sol(:ncol,:, 99) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 21)*sol(:ncol,:, 90) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 22)*sol(:ncol,:, 99) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 23)*sol(:ncol,:, 99) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 95)*sol(:ncol,:, 23) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 95)*sol(:ncol,:, 23) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 95)*sol(:ncol,:, 23) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 31)*sol(:ncol,:, 99) ! rate_const*CO*OH + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 35)*sol(:ncol,:, 63) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 35)*sol(:ncol,:, 99) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 74)*sol(:ncol,:, 69) ! rate_const*OCS*O + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 74)*sol(:ncol,:, 99) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 77)*sol(:ncol,:, 70) ! rate_const*S*O2 + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 80)*sol(:ncol,:, 99) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 77)*sol(:ncol,:, 71) ! rate_const*S*O3 + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 79)*sol(:ncol,:, 5) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 79)*sol(:ncol,:, 28) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 77)*sol(:ncol,:, 99) ! rate_const*S*OH + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 79)*sol(:ncol,:, 62) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 79)*sol(:ncol,:, 70) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 79)*sol(:ncol,:, 71) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 79)*sol(:ncol,:, 73) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 79)*sol(:ncol,:, 99) ! rate_const*SO*OH + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 35)*sol(:ncol,:, 99) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 81)*sol(:ncol,:, 103) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 90) ! rate_const*HO2 + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 57) ! rate_const*N2O5 + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 62) ! rate_const*NO2 + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 63) ! rate_const*NO3 + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 57) ! rate_const*N2O5 + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 54)*sol(:ncol,:, 49) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 57) ! rate_const*N2O5 + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 29)*sol(:ncol,:, 49) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 54)*sol(:ncol,:, 49) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 53)*sol(:ncol,:, 49) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 29)*sol(:ncol,:, 49) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 54)*sol(:ncol,:, 49) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 53)*sol(:ncol,:, 49) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 57) ! rate_const*N2O5 + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 29)*sol(:ncol,:, 49) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 102) ! rate_const*Op2P + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 101) ! rate_const*Op2D + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 102) ! rate_const*Op2P + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 93)*sol(:ncol,:, 89) ! rate_const*NOp*e + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 98)*sol(:ncol,:, 89) ! rate_const*O2p*e + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 92)*sol(:ncol,:, 89) ! rate_const*N2p*e + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 92)*sol(:ncol,:, 70) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 92)*sol(:ncol,:, 69) ! rate_const*N2p*O + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 92)*sol(:ncol,:, 69) ! rate_const*N2p*O + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 94)*sol(:ncol,:, 69) ! rate_const*Np*O + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 94)*sol(:ncol,:, 70) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 94)*sol(:ncol,:, 70) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 98)*sol(:ncol,:, 55) ! rate_const*O2p*N + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 98) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 98)*sol(:ncol,:, 61) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 100)*sol(:ncol,:, 32) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 100) ! rate_const*N2*Op + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 100)*sol(:ncol,:, 91) ! rate_const*Op*N2D + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 100)*sol(:ncol,:, 70) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 101)*sol(:ncol,:, 89) ! rate_const*Op2D*e + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 101) ! rate_const*N2*Op2D + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 101)*sol(:ncol,:, 69) ! rate_const*Op2D*O + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 101)*sol(:ncol,:, 70) ! rate_const*Op2D*O2 + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 102)*sol(:ncol,:, 89) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 102)*sol(:ncol,:, 89) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 102) ! rate_const*N2*Op2P + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 102) ! rate_const*N2*Op2P + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 102)*sol(:ncol,:, 69) ! rate_const*Op2P*O + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_ma_mam5/mo_setrxt.F90 b/src/chemistry/pp_waccm_ma_mam5/mo_setrxt.F90 new file mode 100644 index 0000000000..feb5e03468 --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/mo_setrxt.F90 @@ -0,0 +1,419 @@ + + 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(:,92) = 0.000258_r8 + rate(:,93) = 0.085_r8 + rate(:,94) = 1.2e-10_r8 + rate(:,99) = 1.2e-10_r8 + rate(:,100) = 1e-20_r8 + rate(:,101) = 1.3e-16_r8 + rate(:,103) = 4.2e-13_r8 + rate(:,105) = 8e-14_r8 + rate(:,106) = 3.9e-17_r8 + rate(:,113) = 6.9e-12_r8 + rate(:,114) = 7.2e-11_r8 + rate(:,115) = 1.6e-12_r8 + rate(:,121) = 1.8e-12_r8 + rate(:,125) = 1.8e-12_r8 + rate(:,129) = 7e-13_r8 + rate(:,130) = 5e-12_r8 + rate(:,139) = 3.5e-12_r8 + rate(:,141) = 1.3e-11_r8 + rate(:,142) = 2.2e-11_r8 + rate(:,143) = 5e-11_r8 + rate(:,178) = 1.7e-13_r8 + rate(:,180) = 2.607e-10_r8 + rate(:,181) = 9.75e-11_r8 + rate(:,182) = 2.07e-10_r8 + rate(:,183) = 2.088e-10_r8 + rate(:,184) = 1.17e-10_r8 + rate(:,185) = 4.644e-11_r8 + rate(:,186) = 1.204e-10_r8 + rate(:,187) = 9.9e-11_r8 + rate(:,188) = 3.3e-12_r8 + rate(:,207) = 4.5e-11_r8 + rate(:,208) = 4.62e-10_r8 + rate(:,209) = 1.2e-10_r8 + rate(:,210) = 9e-11_r8 + rate(:,211) = 3e-11_r8 + rate(:,216) = 2.14e-11_r8 + rate(:,217) = 1.9e-10_r8 + rate(:,230) = 2.57e-10_r8 + rate(:,231) = 1.8e-10_r8 + rate(:,232) = 1.794e-10_r8 + rate(:,233) = 1.3e-10_r8 + rate(:,234) = 7.65e-11_r8 + rate(:,242) = 1.31e-10_r8 + rate(:,243) = 3.5e-11_r8 + rate(:,244) = 9e-12_r8 + rate(:,250) = 2.3e-12_r8 + rate(:,252) = 1.2e-11_r8 + rate(:,253) = 5.7e-11_r8 + rate(:,254) = 2.8e-11_r8 + rate(:,255) = 6.6e-11_r8 + rate(:,256) = 1.4e-11_r8 + rate(:,259) = 1.9e-12_r8 + rate(:,284) = 0.047_r8 + rate(:,285) = 7.7e-05_r8 + rate(:,286) = 0.171_r8 + rate(:,290) = 6e-11_r8 + rate(:,293) = 1e-12_r8 + rate(:,294) = 4e-10_r8 + rate(:,295) = 2e-10_r8 + rate(:,296) = 1e-10_r8 + rate(:,297) = 5e-16_r8 + rate(:,298) = 4.4e-10_r8 + rate(:,299) = 9e-10_r8 + rate(:,301) = 1.3e-10_r8 + rate(:,304) = 8e-10_r8 + rate(:,305) = 5e-12_r8 + rate(:,306) = 7e-10_r8 + rate(:,309) = 4.8e-10_r8 + rate(:,310) = 1e-10_r8 + rate(:,311) = 4e-10_r8 + + do n = 1,pver + offset = (n-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,n) + end do + + rate(:,95) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,96) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:,97) = 2.64e-11_r8 * exp_fac(:) + rate(:,98) = 6.6e-12_r8 * exp_fac(:) + rate(:,102) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:,104) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:,107) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:,108) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,111) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + rate(:,112) = 1.4e-12_r8 * exp( -2000._r8 * itemp(:) ) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,117) = 3e-11_r8 * exp_fac(:) + rate(:,205) = 5.5e-12_r8 * exp_fac(:) + rate(:,240) = 3.8e-12_r8 * exp_fac(:) + rate(:,118) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,119) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,120) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,122) = 4.8e-11_r8 * exp_fac(:) + rate(:,203) = 1.7e-11_r8 * exp_fac(:) + rate(:,123) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:,124) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,128) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) + rate(:,131) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,132) = 2.9e-12_r8 * exp_fac(:) + rate(:,133) = 1.45e-12_r8 * exp_fac(:) + rate(:,134) = 1.45e-12_r8 * exp_fac(:) + rate(:,135) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:,136) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,137) = 1.2e-13_r8 * exp_fac(:) + rate(:,163) = 3e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,140) = 1.7e-11_r8 * exp_fac(:) + rate(:,237) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,144) = 3.44e-12_r8 * exp_fac(:) + rate(:,196) = 2.3e-12_r8 * exp_fac(:) + rate(:,199) = 8.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,145) = 3e-12_r8 * exp_fac(:) + rate(:,204) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,147) = 7.26e-11_r8 * exp_fac(:) + rate(:,148) = 4.64e-11_r8 * exp_fac(:) + rate(:,155) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,156) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,157) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,158) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,159) = 1.4e-11_r8 * exp_fac(:) + rate(:,173) = 7.4e-12_r8 * exp_fac(:) + rate(:,160) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,161) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,162) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,164) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,165) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,166) = 2.6e-12_r8 * exp_fac(:) + rate(:,167) = 6.4e-12_r8 * exp_fac(:) + rate(:,197) = 4.1e-13_r8 * exp_fac(:) + rate(:,168) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,170) = 3.6e-12_r8 * exp_fac(:) + rate(:,219) = 2e-12_r8 * exp_fac(:) + rate(:,171) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,172) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,174) = 6e-13_r8 * exp_fac(:) + rate(:,194) = 1.5e-12_r8 * exp_fac(:) + rate(:,202) = 1.9e-11_r8 * exp_fac(:) + rate(:,175) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,176) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,177) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + exp_fac(:) = exp( -500._r8 * itemp(:) ) + rate(:,179) = 3e-12_r8 * exp_fac(:) + rate(:,213) = 1.4e-10_r8 * exp_fac(:) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,191) = 1.7e-11_r8 * exp_fac(:) + rate(:,218) = 6.3e-12_r8 * exp_fac(:) + rate(:,192) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,193) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,195) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + rate(:,198) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,201) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,206) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,212) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) + exp_fac(:) = exp( 0._r8 * itemp(:) ) + rate(:,214) = 1.4e-11_r8 * exp_fac(:) + rate(:,216) = 2.14e-11_r8 * exp_fac(:) + rate(:,217) = 1.9e-10_r8 * exp_fac(:) + rate(:,230) = 2.57e-10_r8 * exp_fac(:) + rate(:,231) = 1.8e-10_r8 * exp_fac(:) + rate(:,232) = 1.794e-10_r8 * exp_fac(:) + rate(:,233) = 1.3e-10_r8 * exp_fac(:) + rate(:,234) = 7.65e-11_r8 * exp_fac(:) + rate(:,242) = 1.31e-10_r8 * exp_fac(:) + rate(:,243) = 3.5e-11_r8 * exp_fac(:) + rate(:,244) = 9e-12_r8 * exp_fac(:) + rate(:,250) = 2.3e-12_r8 * exp_fac(:) + rate(:,252) = 1.2e-11_r8 * exp_fac(:) + rate(:,253) = 5.7e-11_r8 * exp_fac(:) + rate(:,254) = 2.8e-11_r8 * exp_fac(:) + rate(:,255) = 6.6e-11_r8 * exp_fac(:) + rate(:,256) = 1.4e-11_r8 * exp_fac(:) + rate(:,259) = 1.9e-12_r8 * exp_fac(:) + rate(:,284) = 0.047_r8 * exp_fac(:) + rate(:,285) = 7.7e-05_r8 * exp_fac(:) + rate(:,286) = 0.171_r8 * exp_fac(:) + rate(:,290) = 6e-11_r8 * exp_fac(:) + rate(:,293) = 1e-12_r8 * exp_fac(:) + rate(:,294) = 4e-10_r8 * exp_fac(:) + rate(:,295) = 2e-10_r8 * exp_fac(:) + rate(:,296) = 1e-10_r8 * exp_fac(:) + rate(:,297) = 5e-16_r8 * exp_fac(:) + rate(:,298) = 4.4e-10_r8 * exp_fac(:) + rate(:,299) = 9e-10_r8 * exp_fac(:) + rate(:,301) = 1.3e-10_r8 * exp_fac(:) + rate(:,304) = 8e-10_r8 * exp_fac(:) + rate(:,305) = 5e-12_r8 * exp_fac(:) + rate(:,306) = 7e-10_r8 * exp_fac(:) + rate(:,309) = 4.8e-10_r8 * exp_fac(:) + rate(:,310) = 1e-10_r8 * exp_fac(:) + rate(:,311) = 4e-10_r8 * exp_fac(:) + rate(:,215) = 6e-12_r8 * exp( 400._r8 * itemp(:) ) + rate(:,220) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,221) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + rate(:,222) = 1.64e-12_r8 * exp( -1520._r8 * itemp(:) ) + rate(:,223) = 2.03e-11_r8 * exp( -1110._r8 * itemp(:) ) + rate(:,224) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,225) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,226) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,227) = 1.25e-12_r8 * exp_fac(:) + rate(:,236) = 3.4e-11_r8 * exp_fac(:) + rate(:,228) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,229) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,235) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,238) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + rate(:,239) = 2.8e-12_r8 * exp( 300._r8 * itemp(:) ) + rate(:,241) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + rate(:,246) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,247) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,248) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,249) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,257) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,258) = 3.4e-12_r8 * exp( -1100._r8 * itemp(:) ) + rate(:,260) = 2.6e-11_r8 * exp( 330._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(:,116), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,126), 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(:,138), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,146), 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(:,149), 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(:,150), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,151), 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(:,169), 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(:,189), 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(:,200), 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(:,251), 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,100) = 1e-20_r8 + rate(:n,101) = 1.3e-16_r8 + rate(:n,105) = 8e-14_r8 + rate(:n,106) = 3.9e-17_r8 + rate(:n,113) = 6.9e-12_r8 + rate(:n,129) = 7e-13_r8 + rate(:n,130) = 5e-12_r8 + rate(:n,284) = 0.047_r8 + rate(:n,285) = 7.7e-05_r8 + rate(:n,286) = 0.171_r8 + rate(:n,290) = 6e-11_r8 + rate(:n,293) = 1e-12_r8 + rate(:n,294) = 4e-10_r8 + rate(:n,295) = 2e-10_r8 + rate(:n,296) = 1e-10_r8 + rate(:n,298) = 4.4e-10_r8 + rate(:n,301) = 1.3e-10_r8 + rate(:n,304) = 8e-10_r8 + rate(:n,305) = 5e-12_r8 + rate(:n,306) = 7e-10_r8 + rate(:n,309) = 4.8e-10_r8 + rate(:n,310) = 1e-10_r8 + rate(:n,311) = 4e-10_r8 + + do k = 1,kbot + offset = (k-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,k) + end do + + rate(:n,96) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:n,97) = 2.64e-11_r8 * exp_fac(:) + rate(:n,98) = 6.6e-12_r8 * exp_fac(:) + rate(:n,102) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:n,104) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:n,107) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:n,108) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,117) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,118) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,119) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,122) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,123) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,124) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,131) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,135) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:n,136) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,144) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) + rate(:n,145) = 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,116) = wrk(:) + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_ma_mam5/mo_sim_dat.F90 b/src/chemistry/pp_waccm_ma_mam5/mo_sim_dat.F90 new file mode 100644 index 0000000000..adb157e52e --- /dev/null +++ b/src/chemistry/pp_waccm_ma_mam5/mo_sim_dat.F90 @@ -0,0 +1,528 @@ + + 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(:) = (/ 1, 0, 0, 102, 0 /) + + cls_rxt_cnt(:,1) = (/ 0, 0, 0, 1 /) + cls_rxt_cnt(:,4) = (/ 8, 112, 191, 102 /) + + solsym(:103) = (/ 'bc_a1 ','bc_a4 ','BR ','BRCL ','BRO ', & + 'BRONO2 ','BRY ','CCL4 ','CF2CLBR ','CF3BR ', & + 'CFC11 ','CFC113 ','CFC114 ','CFC115 ','CFC12 ', & + 'CH2BR2 ','CH2O ','CH3BR ','CH3CCL3 ','CH3CL ', & + 'CH3O2 ','CH3OOH ','CH4 ','CHBR3 ','CL ', & + 'CL2 ','CL2O2 ','CLO ','CLONO2 ','CLY ', & + 'CO ','CO2 ','COF2 ','COFCL ','DMS ', & + 'dst_a1 ','dst_a2 ','dst_a3 ','F ','H ', & + 'H2 ','H2402 ','H2O2 ','H2SO4 ','HBR ', & + 'HCFC141B ','HCFC142B ','HCFC22 ','HCL ','HF ', & + 'HNO3 ','HO2NO2 ','HOBR ','HOCL ','N ', & + 'N2O ','N2O5 ','ncl_a1 ','ncl_a2 ','ncl_a3 ', & + 'NO ','NO2 ','NO3 ','num_a1 ','num_a2 ', & + 'num_a3 ','num_a4 ','num_a5 ','O ','O2 ', & + 'O3 ','O3S ','OCLO ','OCS ','pom_a1 ', & + 'pom_a4 ','S ','SF6 ','SO ','SO2 ', & + 'SO3 ','so4_a1 ','so4_a2 ','so4_a3 ','so4_a5 ', & + 'soa_a1 ','soa_a2 ','SOAG ','e ','HO2 ', & + 'N2D ','N2p ','NOp ','Np ','O1D ', & + 'O2_1D ','O2_1S ','O2p ','OH ','Op ', & + 'Op2D ','Op2P ','H2O ' /) + + adv_mass(:103) = (/ 12.011000_r8, 12.011000_r8, 79.904000_r8, 115.356700_r8, 95.903400_r8, & + 141.908940_r8, 99.716850_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, 50.485900_r8, & + 47.032000_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, 66.007206_r8, 82.461503_r8, 62.132400_r8, & + 135.064039_r8, 135.064039_r8, 135.064039_r8, 18.998403_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, 14.006740_r8, & + 44.012880_r8, 108.010480_r8, 58.442468_r8, 58.442468_r8, 58.442468_r8, & + 30.006140_r8, 46.005540_r8, 62.004940_r8, 1.007400_r8, 1.007400_r8, & + 1.007400_r8, 1.007400_r8, 1.007400_r8, 15.999400_r8, 31.998800_r8, & + 47.998200_r8, 47.998200_r8, 67.451500_r8, 60.076400_r8, 12.011000_r8, & + 12.011000_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, 0.548567E-03_r8, 33.006200_r8, & + 14.006740_r8, 28.013480_r8, 30.006140_r8, 14.006740_r8, 15.999400_r8, & + 31.998800_r8, 31.998800_r8, 31.998800_r8, 17.006800_r8, 15.999400_r8, & + 15.999400_r8, 15.999400_r8, 18.014200_r8 /) + + crb_mass(:103) = (/ 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, & + 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, 12.011000_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, 12.011000_r8, 12.011000_r8, 24.022000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_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, 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, 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, 0.000000_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, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_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, 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, 0.000000_r8 /) + + fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) + + clsmap(: 1,1) = (/ 72 /) + clsmap(:102,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, 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 /) + + permute(:102,4) = (/ 1, 2, 97, 45, 101, 62, 3, 27, 34, 35, & + 29, 36, 30, 37, 31, 58, 86, 63, 32, 54, & + 82, 55, 81, 56, 96, 38, 26, 91, 75, 4, & + 72, 61, 41, 43, 51, 5, 6, 7, 73, 84, & + 99, 28, 65, 33, 69, 42, 44, 48, 85, 49, & + 100, 57, 68, 70, 78, 46, 50, 8, 9, 10, & + 95, 92, 90, 11, 12, 13, 14, 15, 93, 87, & + 88, 52, 53, 16, 17, 66, 18, 83, 74, 47, & + 19, 20, 21, 22, 23, 24, 25, 76, 89, 77, & + 64, 67, 71, 94, 39, 40, 79, 98, 80, 60, & + 59, 102 /) + + diag_map(:102) = (/ 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, 29, 32, 36, 40, & + 44, 48, 52, 55, 60, 65, 70, 75, 77, 80, & + 82, 85, 90, 95, 100, 103, 108, 113, 119, 122, & + 128, 134, 139, 147, 155, 161, 167, 174, 181, 188, & + 196, 202, 210, 219, 228, 235, 242, 248, 256, 265, & + 273, 282, 290, 300, 308, 323, 334, 347, 361, 378, & + 393, 411, 425, 439, 453, 475, 508, 529, 555, 581, & + 610, 640, 683, 726, 752, 785, 808, 858, 882, 906, & + 931, 959 /) + + extfrc_lst(: 24) = (/ 'so4_a2 ','DMS ','bc_a4 ','num_a1 ','num_a2 ', & + 'num_a4 ','num_a5 ','pom_a1 ','pom_a4 ','so4_a1 ', & + 'so4_a5 ','CO ','NO ','NO2 ','SO2 ', & + 'bc_a1 ','N ','N2D ','N2p ','Op ', & + 'e ','Np ','O2p ','OH ' /) + + frc_from_dataset(: 24) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .false., .false., .false., .false., & + .false., .false., .false., .false. /) + + inv_lst(: 2) = (/ 'M ', 'N2 ' /) + + slvd_lst(: 14) = (/ 'e ', 'HO2 ', 'N2D ', 'N2p ', 'NOp ', & + 'Np ', 'O1D ', 'O2_1D ', 'O2_1S ', 'O2p ', & + 'OH ', 'Op ', 'Op2D ', 'Op2P ' /) + + 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_c ', & + 'jh2o_a ', 'jh2o2 ', & + 'jo2_b ', 'jo2_a ', & + 'jo3_a ', 'jo3_b ', & + 'jhno3 ', 'jho2no2_a ', & + 'jho2no2_b ', 'jn2o ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jno ', 'jno_i ', & + 'jno2 ', 'jno3_a ', & + 'jno3_b ', 'jch2o_a ', & + 'jch2o_b ', 'jch3ooh ', & + 'jch4_a ', 'jch4_b ', & + 'jco2 ', 'jbrcl ', & + 'jbro ', 'jbrono2_b ', & + 'jbrono2_a ', 'jccl4 ', & + 'jcf2clbr ', 'jcf3br ', & + 'jcfcl3 ', 'jcfc113 ', & + 'jcfc114 ', 'jcfc115 ', & + 'jcf2cl2 ', 'jch2br2 ', & + 'jch3br ', 'jch3ccl3 ', & + 'jch3cl ', 'jchbr3 ', & + 'jcl2 ', 'jcl2o2 ', & + 'jclo ', 'jclono2_a ', & + 'jclono2_b ', 'jcof2 ', & + 'jcofcl ', 'jh2402 ', & + 'jhbr ', 'jhcfc141b ', & + 'jhcfc142b ', 'jhcfc22 ', & + 'jhcl ', 'jhf ', & + 'jhobr ', 'jhocl ', & + 'joclo ', 'jsf6 ', & + 'jeuv_26 ', 'jeuv_4 ', & + 'jeuv_6 ', 'jeuv_22 ', & + 'jeuv_23 ', 'jeuv_25 ', & + 'jeuv_18 ', 'jeuv_13 ', & + 'jeuv_11 ', 'jeuv_10 ', & + 'jeuv_3 ', 'jeuv_16 ', & + 'jeuv_1 ', 'jeuv_14 ', & + 'jeuv_2 ', 'jeuv_15 ', & + 'jeuv_21 ', 'jeuv_17 ', & + 'jeuv_7 ', 'jeuv_5 ', & + 'jeuv_19 ', 'jeuv_24 ', & + 'jeuv_12 ', 'jeuv_9 ', & + 'jeuv_8 ', 'jeuv_20 ', & + 'jh2so4 ', 'jocs ', & + 'jso ', 'jso2 ', & + 'jso3 ', 'ag1 ', & + 'ag2 ', 'O1D_H2 ', & + 'O1D_H2O ', 'O1D_N2 ', & + 'O1D_O2 ', 'O1D_O2b ', & + 'O1D_O3 ', 'O2_1D_N2 ', & + 'O2_1D_O ', 'O2_1D_O2 ', & + 'O2_1S_CO2 ', 'O2_1S_N2 ', & + 'O2_1S_O ', 'O2_1S_O2 ', & + 'O2_1S_O3 ', '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 ', & + 'N2D_O ', 'N2D_O2 ', & + '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 ' /) + rxt_tag_lst( 201: 311) = (/ 'BRONO2_O ', 'BRO_O ', & + 'BRO_OH ', 'HBR_O ', & + 'HBR_OH ', 'HOBR_O ', & + 'O1D_CF3BR ', 'O1D_CHBR3 ', & + 'O1D_H2402 ', 'O1D_HBRa ', & + 'O1D_HBRb ', 'F_CH4 ', & + 'F_H2 ', 'F_H2O ', & + 'F_HNO3 ', 'O1D_COF2 ', & + 'O1D_COFCL ', 'CH2BR2_CL ', & + 'CH2BR2_OH ', 'CH3BR_CL ', & + 'CH3BR_OH ', 'CH3CCL3_OH ', & + 'CH3CL_CL ', 'CH3CL_OH ', & + '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_HO2 ', & + 'CH3O2_NO ', 'CH3OOH_OH ', & + 'CH4_OH ', 'O1D_CH4a ', & + 'O1D_CH4b ', 'O1D_CH4c ', & + 'usr_CO_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 ', & + 'usr_HO2_aer ', 'usr_N2O5_aer ', & + 'usr_NO2_aer ', 'usr_NO3_aer ', & + 'het1 ', 'het10 ', & + 'het11 ', 'het12 ', & + 'het13 ', 'het14 ', & + 'het15 ', 'het16 ', & + 'het17 ', 'het2 ', & + 'het3 ', 'het4 ', & + 'het5 ', 'het6 ', & + 'het7 ', 'het8 ', & + 'het9 ', 'ag247nm ', & + 'ag373nm ', 'ag732nm ', & + 'elec1 ', 'elec2 ', & + 'elec3 ', 'ion_N2p_O2 ', & + 'ion_N2p_Oa ', 'ion_N2p_Ob ', & + 'ion_Np_O ', 'ion_Np_O2a ', & + 'ion_Np_O2b ', 'ion_O2p_N ', & + 'ion_O2p_N2 ', 'ion_O2p_NO ', & + 'ion_Op_CO2 ', 'ion_Op_N2 ', & + 'ion_Op_N2D ', 'ion_Op_O2 ', & + 'Op2D_e ', 'Op2D_N2 ', & + 'Op2D_O ', 'Op2D_O2 ', & + 'Op2P_ea ', 'Op2P_eb ', & + 'Op2P_N2a ', 'Op2P_N2b ', & + 'Op2P_O ' /) + 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 /) + 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 ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', ' ', ' ', & + ' ', ' ', ' ' /) + 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, & + 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, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._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(:) = (/ 96, 97, 98, 100, 101, & + 102, 104, 105, 106, 107, & + 108, 109, 110, 113, 116, & + 117, 118, 119, 122, 123, & + 124, 127, 129, 130, 131, & + 135, 136, 144, 145, 284, & + 285, 286, 287, 288, 289, & + 290, 291, 293, 294, 295, & + 296, 298, 300, 301, 302, & + 303, 304, 305, 306, 307, & + 308, 309, 310, 311 /) + cph_enthalpy(:) = (/ 189.810000_r8, 32.910000_r8, 189.810000_r8, 94.300000_r8, 94.300000_r8, & + 94.300000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, 62.600000_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, 229.610000_r8, 177.510000_r8, 313.750000_r8, & + 133.750000_r8, 193.020000_r8, 34.470000_r8, 199.170000_r8, 483.390000_r8, & + 321.300000_r8, 163.060000_r8, 82.389000_r8, 508.950000_r8, 354.830000_r8, & + 339.590000_r8, 67.530000_r8, 95.550000_r8, 239.840000_r8, 646.280000_r8, & + 406.160000_r8, 271.380000_r8, 105.040000_r8, 139.900000_r8, 150.110000_r8, & + 319.370000_r8, 128.320000_r8, 319.360000_r8, 469.400000_r8, 163.060000_r8, & + 482.430000_r8, 291.380000_r8, 67.540000_r8, 501.720000_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(:) = (/ 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, & + 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, 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, 2, 2, 2, 2, 2, 2, 2, 2, 3, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 1, 1, 1, 1, 1, 2, 1, 1, 1, & + 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, & + 1, 2, 1, 1, 1, 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 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_ma_sulfur/mo_adjrxt.F90 b/src/chemistry/pp_waccm_ma_sulfur/mo_adjrxt.F90 index 88641a5330..d190d8cfb8 100644 --- a/src/chemistry/pp_waccm_ma_sulfur/mo_adjrxt.F90 +++ b/src/chemistry/pp_waccm_ma_sulfur/mo_adjrxt.F90 @@ -18,23 +18,23 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) rate(:,:, 85) = rate(:,:, 85) * inv(:,:, 2) rate(:,:, 91) = rate(:,:, 91) * inv(:,:, 2) rate(:,:, 93) = rate(:,:, 93) * inv(:,:, 2) - rate(:,:,119) = rate(:,:,119) * inv(:,:, 1) - rate(:,:,123) = rate(:,:,123) * inv(:,:, 1) - rate(:,:,125) = rate(:,:,125) * inv(:,:, 1) - rate(:,:,126) = rate(:,:,126) * inv(:,:, 1) - rate(:,:,127) = rate(:,:,127) * inv(:,:, 1) - rate(:,:,133) = rate(:,:,133) * inv(:,:, 1) - rate(:,:,135) = rate(:,:,135) * inv(:,:, 1) - rate(:,:,143) = rate(:,:,143) * inv(:,:, 1) - rate(:,:,145) = rate(:,:,145) * inv(:,:, 1) - rate(:,:,154) = rate(:,:,154) * inv(:,:, 1) - rate(:,:,173) = rate(:,:,173) * inv(:,:, 1) - rate(:,:,177) = rate(:,:,177) * inv(:,:, 1) - rate(:,:,178) = rate(:,:,178) * inv(:,:, 1) - rate(:,:,194) = rate(:,:,194) * inv(:,:, 1) - rate(:,:,220) = rate(:,:,220) * inv(:,:, 1) - rate(:,:,241) = rate(:,:,241) * inv(:,:, 2) - rate(:,:,250) = rate(:,:,250) * inv(:,:, 2) + rate(:,:, 119) = rate(:,:, 119) * inv(:,:, 1) + rate(:,:, 123) = rate(:,:, 123) * inv(:,:, 1) + rate(:,:, 125) = rate(:,:, 125) * inv(:,:, 1) + rate(:,:, 126) = rate(:,:, 126) * inv(:,:, 1) + rate(:,:, 127) = rate(:,:, 127) * inv(:,:, 1) + rate(:,:, 133) = rate(:,:, 133) * inv(:,:, 1) + rate(:,:, 135) = rate(:,:, 135) * inv(:,:, 1) + rate(:,:, 143) = rate(:,:, 143) * inv(:,:, 1) + rate(:,:, 145) = rate(:,:, 145) * inv(:,:, 1) + rate(:,:, 154) = rate(:,:, 154) * inv(:,:, 1) + rate(:,:, 173) = rate(:,:, 173) * inv(:,:, 1) + rate(:,:, 177) = rate(:,:, 177) * inv(:,:, 1) + rate(:,:, 178) = rate(:,:, 178) * inv(:,:, 1) + rate(:,:, 194) = rate(:,:, 194) * inv(:,:, 1) + rate(:,:, 220) = rate(:,:, 220) * inv(:,:, 1) + rate(:,:, 241) = rate(:,:, 241) * inv(:,:, 2) + rate(:,:, 250) = rate(:,:, 250) * inv(:,:, 2) rate(:,:, 80) = rate(:,:, 80) * m(:,:) rate(:,:, 81) = rate(:,:, 81) * m(:,:) rate(:,:, 82) = rate(:,:, 82) * m(:,:) @@ -50,146 +50,146 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) rate(:,:, 97) = rate(:,:, 97) * m(:,:) rate(:,:, 98) = rate(:,:, 98) * m(:,:) rate(:,:, 99) = rate(:,:, 99) * m(:,:) - rate(:,:,100) = rate(:,:,100) * 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(:,:,117) = rate(:,:,117) * 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(:,:,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(:,:,136) = rate(:,:,136) * 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(:,:,172) = rate(:,:,172) * 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(:,:,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(:,:,226) = rate(:,:,226) * m(:,:) - rate(:,:,227) = rate(:,:,227) * m(:,:) - rate(:,:,228) = rate(:,:,228) * m(:,:) - rate(:,:,231) = rate(:,:,231) * m(:,:) - rate(:,:,232) = rate(:,:,232) * m(:,:) - rate(:,:,237) = rate(:,:,237) * m(:,:) - rate(:,:,238) = rate(:,:,238) * m(:,:) - rate(:,:,239) = rate(:,:,239) * m(:,:) - rate(:,:,240) = rate(:,:,240) * m(:,:) - rate(:,:,242) = rate(:,:,242) * m(:,:) - rate(:,:,243) = rate(:,:,243) * m(:,:) - rate(:,:,244) = rate(:,:,244) * m(:,:) - rate(:,:,245) = rate(:,:,245) * m(:,:) - rate(:,:,246) = rate(:,:,246) * m(:,:) - rate(:,:,247) = rate(:,:,247) * m(:,:) - rate(:,:,248) = rate(:,:,248) * m(:,:) - rate(:,:,249) = rate(:,:,249) * m(:,:) - rate(:,:,251) = rate(:,:,251) * m(:,:) - rate(:,:,252) = rate(:,:,252) * m(:,:) - rate(:,:,253) = rate(:,:,253) * m(:,:) - rate(:,:,254) = rate(:,:,254) * m(:,:) + rate(:,:, 100) = rate(:,:, 100) * 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(:,:, 117) = rate(:,:, 117) * 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(:,:, 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(:,:, 136) = rate(:,:, 136) * 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(:,:, 172) = rate(:,:, 172) * 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(:,:, 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(:,:, 226) = rate(:,:, 226) * m(:,:) + rate(:,:, 227) = rate(:,:, 227) * m(:,:) + rate(:,:, 228) = rate(:,:, 228) * m(:,:) + rate(:,:, 231) = rate(:,:, 231) * m(:,:) + rate(:,:, 232) = rate(:,:, 232) * m(:,:) + rate(:,:, 237) = rate(:,:, 237) * m(:,:) + rate(:,:, 238) = rate(:,:, 238) * m(:,:) + rate(:,:, 239) = rate(:,:, 239) * m(:,:) + rate(:,:, 240) = rate(:,:, 240) * m(:,:) + rate(:,:, 242) = rate(:,:, 242) * m(:,:) + rate(:,:, 243) = rate(:,:, 243) * m(:,:) + rate(:,:, 244) = rate(:,:, 244) * m(:,:) + rate(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * m(:,:) + rate(:,:, 247) = rate(:,:, 247) * m(:,:) + rate(:,:, 248) = rate(:,:, 248) * m(:,:) + rate(:,:, 249) = rate(:,:, 249) * m(:,:) + rate(:,:, 251) = rate(:,:, 251) * m(:,:) + rate(:,:, 252) = rate(:,:, 252) * m(:,:) + rate(:,:, 253) = rate(:,:, 253) * m(:,:) + rate(:,:, 254) = rate(:,:, 254) * m(:,:) end subroutine adjrxt end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_mad/chem_mech.doc b/src/chemistry/pp_waccm_mad/chem_mech.doc index 42516cb8de..652bdc4eb0 100644 --- a/src/chemistry/pp_waccm_mad/chem_mech.doc +++ b/src/chemistry/pp_waccm_mad/chem_mech.doc @@ -1,77 +1,77 @@ Solution species - ( 1) BRCL (BrCl) - ( 2) BRO (BrO) - ( 3) BRONO2 (BrONO2) - ( 4) BRY - ( 5) CCL4 (CCl4) - ( 6) CF2CLBR (CF2ClBr) - ( 7) CF3BR (CF3Br) - ( 8) CFC11 (CFCl3) - ( 9) CFC113 (CCl2FCClF2) - ( 10) CFC114 (CClF2CClF2) - ( 11) CFC115 (CClF2CF3) - ( 12) CFC12 (CF2Cl2) - ( 13) CH2BR2 (CH2Br2) - ( 14) CH2O - ( 15) CH3BR (CH3Br) - ( 16) CH3CCL3 (CH3CCl3) - ( 17) CH3CL (CH3Cl) - ( 18) CH3O2 - ( 19) CH3OOH - ( 20) CH4 - ( 21) CHBR3 (CHBr3) - ( 22) CL2 (Cl2) - ( 23) CL2O2 (Cl2O2) - ( 24) CLO (ClO) - ( 25) CLONO2 (ClONO2) - ( 26) CLY - ( 27) CO - ( 28) CO2 - ( 29) COF2 - ( 30) COFCL (COFCl) - ( 31) F - ( 32) H - ( 33) H2 - ( 34) H2402 (CBrF2CBrF2) - ( 35) H2O2 - ( 36) HBR (HBr) - ( 37) HCFC141B (CH3CCl2F) - ( 38) HCFC142B (CH3CClF2) - ( 39) HCFC22 (CHF2Cl) - ( 40) HCL (HCl) - ( 41) HF - ( 42) HNO3 - ( 43) HO2 - ( 44) HO2NO2 - ( 45) HOBR (HOBr) - ( 46) HOCL (HOCl) - ( 47) HONO - ( 48) N - ( 49) N2O - ( 50) N2O5 - ( 51) NO - ( 52) NO2 - ( 53) NO3 - ( 54) O - ( 55) O2 - ( 56) O3 - ( 57) OCLO (OClO) - ( 58) SF6 - ( 59) BR (Br) - ( 60) CL (Cl) - ( 61) CLm (Cl) - ( 62) CLm_H2O (ClH2O) - ( 63) CLm_HCL (Cl2H) - ( 64) CLOm (ClO) - ( 65) CO3m (CO3) - ( 66) CO3m2H2O (H4CO5) - ( 67) CO3m_H2O (H2CO4) - ( 68) CO4m (CO4) - ( 69) e (E) - ( 70) H3Op_OH (H4O2) - ( 71) HCO3m (HCO3) + ( 1) BR (Br) + ( 2) BRCL (BrCl) + ( 3) BRO (BrO) + ( 4) BRONO2 (BrONO2) + ( 5) BRY + ( 6) CCL4 (CCl4) + ( 7) CF2CLBR (CF2ClBr) + ( 8) CF3BR (CF3Br) + ( 9) CFC11 (CFCl3) + ( 10) CFC113 (CCl2FCClF2) + ( 11) CFC114 (CClF2CClF2) + ( 12) CFC115 (CClF2CF3) + ( 13) CFC12 (CF2Cl2) + ( 14) CH2BR2 (CH2Br2) + ( 15) CH2O + ( 16) CH3BR (CH3Br) + ( 17) CH3CCL3 (CH3CCl3) + ( 18) CH3CL (CH3Cl) + ( 19) CH3O2 + ( 20) CH3OOH + ( 21) CH4 + ( 22) CHBR3 (CHBr3) + ( 23) CL (Cl) + ( 24) CL2 (Cl2) + ( 25) CL2O2 (Cl2O2) + ( 26) CLO (ClO) + ( 27) CLONO2 (ClONO2) + ( 28) CLY + ( 29) CO + ( 30) CO2 + ( 31) COF2 + ( 32) COFCL (COFCl) + ( 33) F + ( 34) H + ( 35) H2 + ( 36) H2402 (CBrF2CBrF2) + ( 37) H2O2 + ( 38) HBR (HBr) + ( 39) HCFC141B (CH3CCl2F) + ( 40) HCFC142B (CH3CClF2) + ( 41) HCFC22 (CHF2Cl) + ( 42) HCL (HCl) + ( 43) HF + ( 44) HNO3 + ( 45) HO2NO2 + ( 46) HOBR (HOBr) + ( 47) HOCL (HOCl) + ( 48) HONO + ( 49) N + ( 50) N2O + ( 51) N2O5 + ( 52) NO + ( 53) NO2 + ( 54) NO3 + ( 55) O + ( 56) O2 + ( 57) O3 + ( 58) OCLO (OClO) + ( 59) SF6 + ( 60) CLm (Cl) + ( 61) CLm_H2O (ClH2O) + ( 62) CLm_HCL (Cl2H) + ( 63) CLOm (ClO) + ( 64) CO3m (CO3) + ( 65) CO3m2H2O (H4CO5) + ( 66) CO3m_H2O (H2CO4) + ( 67) CO4m (CO4) + ( 68) e (E) + ( 69) H3Op_OH (H4O2) + ( 70) HCO3m (HCO3) + ( 71) HO2 ( 72) Hp_2H2O (H5O2) ( 73) Hp_3H2O (H7O3) ( 74) Hp_3N1 (H8NO6) @@ -142,38 +142,39 @@ Class List ( 14) CH4 ( 15) CHBR3 ( 16) CLY - ( 17) H2402 - ( 18) HCFC141B - ( 19) HCFC142B - ( 20) HCFC22 - ( 21) N2O - ( 22) SF6 + ( 17) CO2 + ( 18) H2402 + ( 19) HCFC141B + ( 20) HCFC142B + ( 21) HCFC22 + ( 22) N2O + ( 23) SF6 Implicit -------- - ( 1) BRCL - ( 2) BRO - ( 3) BRONO2 - ( 4) CH2O - ( 5) CH3O2 - ( 6) CH3OOH - ( 7) CL2 - ( 8) CL2O2 - ( 9) CLO - ( 10) CLONO2 - ( 11) CO - ( 12) COF2 - ( 13) COFCL - ( 14) CO2 - ( 15) F - ( 16) H - ( 17) H2 - ( 18) H2O2 - ( 19) HBR - ( 20) HCL - ( 21) HF - ( 22) HNO3 - ( 23) HO2 + ( 1) BR + ( 2) BRCL + ( 3) BRO + ( 4) BRONO2 + ( 5) CH2O + ( 6) CH3O2 + ( 7) CH3OOH + ( 8) CL + ( 9) CL2 + ( 10) CL2O2 + ( 11) CLO + ( 12) CLONO2 + ( 13) CO + ( 14) COF2 + ( 15) COFCL + ( 16) F + ( 17) H + ( 18) H2 + ( 19) H2O2 + ( 20) HBR + ( 21) HCL + ( 22) HF + ( 23) HNO3 ( 24) HO2NO2 ( 25) HOBR ( 26) HOCL @@ -187,58 +188,57 @@ Class List ( 34) O2 ( 35) O3 ( 36) OCLO - ( 37) BR - ( 38) CL - ( 39) CLm - ( 40) CLm_H2O - ( 41) CLm_HCL - ( 42) CLOm - ( 43) CO3m - ( 44) CO3m2H2O - ( 45) CO3m_H2O - ( 46) CO4m - ( 47) e - ( 48) H3Op_OH - ( 49) HCO3m - ( 50) Hp_2H2O - ( 51) Hp_3H2O - ( 52) Hp_3N1 - ( 53) Hp_4H2O - ( 54) Hp_4N1 - ( 55) Hp_5H2O - ( 56) Hp_H2O - ( 57) N2D - ( 58) N2p - ( 59) NO2m - ( 60) NO2m_H2O - ( 61) NO3m - ( 62) NO3m2H2O - ( 63) NO3m_H2O - ( 64) NO3m_HCL - ( 65) NO3mHNO3 - ( 66) NOp - ( 67) NOp_2H2O - ( 68) NOp_3H2O - ( 69) NOp_CO2 - ( 70) NOp_H2O - ( 71) NOp_N2 - ( 72) Np - ( 73) O1D - ( 74) O2_1D - ( 75) O2_1S - ( 76) O2m - ( 77) O2p - ( 78) O2p_H2O - ( 79) O3m - ( 80) O4m - ( 81) O4p - ( 82) OH - ( 83) OHm - ( 84) Om - ( 85) Op - ( 86) Op2D - ( 87) Op2P - ( 88) H2O + ( 37) CLm + ( 38) CLm_H2O + ( 39) CLm_HCL + ( 40) CLOm + ( 41) CO3m + ( 42) CO3m2H2O + ( 43) CO3m_H2O + ( 44) CO4m + ( 45) e + ( 46) H3Op_OH + ( 47) HCO3m + ( 48) HO2 + ( 49) Hp_2H2O + ( 50) Hp_3H2O + ( 51) Hp_3N1 + ( 52) Hp_4H2O + ( 53) Hp_4N1 + ( 54) Hp_5H2O + ( 55) Hp_H2O + ( 56) N2D + ( 57) N2p + ( 58) NO2m + ( 59) NO2m_H2O + ( 60) NO3m + ( 61) NO3m2H2O + ( 62) NO3m_H2O + ( 63) NO3m_HCL + ( 64) NO3mHNO3 + ( 65) NOp + ( 66) NOp_2H2O + ( 67) NOp_3H2O + ( 68) NOp_CO2 + ( 69) NOp_H2O + ( 70) NOp_N2 + ( 71) Np + ( 72) O1D + ( 73) O2_1D + ( 74) O2_1S + ( 75) O2m + ( 76) O2p + ( 77) O2p_H2O + ( 78) O3m + ( 79) O4m + ( 80) O4p + ( 81) OH + ( 82) OHm + ( 83) Om + ( 84) Op + ( 85) Op2D + ( 86) Op2P + ( 87) H2O Photolysis jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) @@ -871,6 +871,13 @@ Extraneous prod/loss species Equation Report + d(BR)/dt = j27*BRCL + j28*BRO + j30*BRONO2 + j32*CF2CLBR + j33*CF3BR + 2*j39*CH2BR2 + j40*CH3BR + + 3*j43*CHBR3 + 2*j51*H2402 + j52*HBR + j58*HOBR + r372*O1D*CF2CLBR + 2*r385*BRO*BRO + + r386*BRO*CLO + r387*BRO*CLO + r390*BRO*NO + r393*BRO*O + r394*BRO*OH + r395*HBR*O + + r396*HBR*OH + r398*O1D*CF3BR + 3*r399*O1D*CHBR3 + 2*r400*O1D*H2402 + r401*O1D*HBR + + 2*r409*CH2BR2*CL + 2*r410*CH2BR2*OH + r411*CH3BR*CL + r412*CH3BR*OH + 3*r416*CHBR3*CL + + 3*r417*CHBR3*OH + 2*r421*O1D*CH2BR2 + r422*O1D*CH3BR + - r382*CH2O*BR - r383*HO2*BR - r384*O3*BR d(BRCL)/dt = r388*BRO*CLO + r450*HOBR*HCL + r455*HOBR*HCL - j27*BRCL d(BRO)/dt = j29*BRONO2 + r384*BR*O3 + r392*BRONO2*O + r397*HOBR*O + r402*O1D*HBR @@ -903,6 +910,23 @@ Extraneous prod/loss species d(CH4)/dt = - j24*CH4 - j25*CH4 - r347*CL*CH4 - r403*F*CH4 - r432*OH*CH4 - r434*O1D*CH4 - r435*O1D*CH4 - r436*O1D*CH4 d(CHBR3)/dt = - j43*CHBR3 - r399*O1D*CHBR3 - r416*CL*CHBR3 - r417*OH*CHBR3 + d(CL)/dt = j27*BRCL + 4*j31*CCL4 + j32*CF2CLBR + 2*j34*CFC11 + 2*j35*CFC113 + 2*j36*CFC114 + j37*CFC115 + + 2*j38*CFC12 + 3*j41*CH3CCL3 + j42*CH3CL + 2*j44*CL2 + 2*j45*CL2O2 + j46*CLO + j47*CLONO2 + + j50*COFCL + j53*HCFC141B + j54*HCFC142B + j55*HCFC22 + j56*HCL + j59*HOCL + r6*CLm*NO2 + + r7*CLOm*NO + r43*CLm*Hp_4H2O + r50*CLm*O2p + r55*O2p*CLm_H2O + r60*CLm_H2O*Hp_4H2O + + r65*CLm_HCL*Hp_5H2O + r73*CLm*Hp_5H2O + r77*CLm_HCL*Hp_4H2O + r78*CLm_H2O*Hp_5H2O + + r83*CLm_HCL*Hp_3H2O + r91*CLm*Hp_3H2O + r95*CLm_H2O*Hp_3H2O + r101*CLm_HCL*NOp_H2O + + r108*CLm*NOp_H2O + r113*CLm_H2O*NOp_H2O + r118*CLm_HCL*NOp_2H2O + r126*CLm*NOp_2H2O + + r130*NOp_2H2O*CLm_H2O + r136*NOp*CLm_HCL + r144*CLm*NOp + r148*CLm_H2O*NOp + r153*O2p*CLm_HCL + + r353*CLO*CH3O2 + 2*r354*CLO*CLO + r356*CLO*CLO + r358*CLO*NO + r363*CLO*O + r364*CLO*OH + + r366*HCL*O + r367*HCL*OH + 4*r371*O1D*CCL4 + r372*O1D*CF2CLBR + 2*r373*O1D*CFC11 + + 2*r374*O1D*CFC113 + 2*r375*O1D*CFC114 + r376*O1D*CFC115 + 2*r377*O1D*CFC12 + r378*O1D*HCL + + r387*BRO*CLO + r408*O1D*COFCL + 3*r413*CH3CCL3*OH + r415*CH3CL*OH + r418*HCFC141B*OH + + r419*HCFC142B*OH + r420*HCFC22*OH + r423*O1D*HCFC141B + r424*O1D*HCFC142B + r425*O1D*HCFC22 + - r10*CO3m*CL - r11*CO3m*CL - r23*CO4m*CL - r181*NO2m*CL - r210*O2m*CL - r237*OHm*CL + - r246*Om*CL - r346*CH2O*CL - r347*CH4*CL - r348*H2*CL - r349*H2O2*CL - r350*HO2*CL + - r351*HO2*CL - r352*O3*CL - r359*CLONO2*CL - r368*HOCL*CL - r409*CH2BR2*CL - r411*CH3BR*CL + - r414*CH3CL*CL - r416*CHBR3*CL d(CL2)/dt = r355*CLO*CLO + r359*CLONO2*CL + r443*HOCL*HCL + r448*CLONO2*HCL + r449*HOCL*HCL + r453*CLONO2*HCL + r454*HOCL*HCL + r458*CLONO2*HCL - j44*CL2 @@ -1003,14 +1027,6 @@ Extraneous prod/loss species - j9*HNO3 - r5*CLm*HNO3 - r20*CO3m*HNO3 - r186*NO2m*HNO3 - r191*NO3m_H2O*HNO3 - r195*NO3m_HCL*HNO3 - r196*M*NO3m*HNO3 - r215*O2m*HNO3 - r253*Om*HNO3 - r343*OH*HNO3 - r406*F*HNO3 - d(HO2)/dt = j11*HO2NO2 + r344*M*HO2NO2 + r26*CO4m*HCL + r213*H*O2m + r214*O2m*HCL + r215*O2m*HNO3 - + r243*OHm*O + r303*H2O2*O + r307*M*H*O2 + r312*OH*H2O2 + r315*OH*O3 + r333*NO3*OH - + r346*CL*CH2O + r349*CL*H2O2 + r353*CLO*CH3O2 + r364*CLO*OH + r382*BR*CH2O + r394*BRO*OH - + r411*CH3BR*CL + r412*CH3BR*OH + r414*CH3CL*CL + r415*CH3CL*OH + r426*CH2O*NO3 + r427*CH2O*O - + r430*CH3O2*NO + r433*M*CO*OH + r435*O1D*CH4 - - r438*HO2 - r206*NOp_H2O*HO2 - r304*H*HO2 - r305*H*HO2 - r306*H*HO2 - r308*O*HO2 - r309*O3*HO2 - - r313*OH*HO2 - 2*r318*HO2*HO2 - r330*NO3*HO2 - r335*NO*HO2 - r340*M*NO2*HO2 - r350*CL*HO2 - - r351*CL*HO2 - r357*CLO*HO2 - r383*BR*HO2 - r389*BRO*HO2 - r429*CH3O2*HO2 d(HO2NO2)/dt = r340*M*NO2*HO2 - j10*HO2NO2 - j11*HO2NO2 - r344*M*HO2NO2 - r319*OH*HO2NO2 d(HOBR)/dt = r444*BRONO2 + r447*BRONO2 + r452*BRONO2 + r389*BRO*HO2 @@ -1120,30 +1136,6 @@ Extraneous prod/loss species d(OCLO)/dt = r356*CLO*CLO + r386*BRO*CLO - j60*OCLO d(SF6)/dt = - j61*SF6 - d(BR)/dt = j27*BRCL + j28*BRO + j30*BRONO2 + j32*CF2CLBR + j33*CF3BR + 2*j39*CH2BR2 + j40*CH3BR - + 3*j43*CHBR3 + 2*j51*H2402 + j52*HBR + j58*HOBR + r372*O1D*CF2CLBR + 2*r385*BRO*BRO - + r386*BRO*CLO + r387*BRO*CLO + r390*BRO*NO + r393*BRO*O + r394*BRO*OH + r395*HBR*O - + r396*HBR*OH + r398*O1D*CF3BR + 3*r399*O1D*CHBR3 + 2*r400*O1D*H2402 + r401*O1D*HBR - + 2*r409*CH2BR2*CL + 2*r410*CH2BR2*OH + r411*CH3BR*CL + r412*CH3BR*OH + 3*r416*CHBR3*CL - + 3*r417*CHBR3*OH + 2*r421*O1D*CH2BR2 + r422*O1D*CH3BR - - r382*CH2O*BR - r383*HO2*BR - r384*O3*BR - d(CL)/dt = j27*BRCL + 4*j31*CCL4 + j32*CF2CLBR + 2*j34*CFC11 + 2*j35*CFC113 + 2*j36*CFC114 + j37*CFC115 - + 2*j38*CFC12 + 3*j41*CH3CCL3 + j42*CH3CL + 2*j44*CL2 + 2*j45*CL2O2 + j46*CLO + j47*CLONO2 - + j50*COFCL + j53*HCFC141B + j54*HCFC142B + j55*HCFC22 + j56*HCL + j59*HOCL + r6*CLm*NO2 - + r7*CLOm*NO + r43*CLm*Hp_4H2O + r50*CLm*O2p + r55*O2p*CLm_H2O + r60*CLm_H2O*Hp_4H2O - + r65*CLm_HCL*Hp_5H2O + r73*CLm*Hp_5H2O + r77*CLm_HCL*Hp_4H2O + r78*CLm_H2O*Hp_5H2O - + r83*CLm_HCL*Hp_3H2O + r91*CLm*Hp_3H2O + r95*CLm_H2O*Hp_3H2O + r101*CLm_HCL*NOp_H2O - + r108*CLm*NOp_H2O + r113*CLm_H2O*NOp_H2O + r118*CLm_HCL*NOp_2H2O + r126*CLm*NOp_2H2O - + r130*NOp_2H2O*CLm_H2O + r136*NOp*CLm_HCL + r144*CLm*NOp + r148*CLm_H2O*NOp + r153*O2p*CLm_HCL - + r353*CLO*CH3O2 + 2*r354*CLO*CLO + r356*CLO*CLO + r358*CLO*NO + r363*CLO*O + r364*CLO*OH - + r366*HCL*O + r367*HCL*OH + 4*r371*O1D*CCL4 + r372*O1D*CF2CLBR + 2*r373*O1D*CFC11 - + 2*r374*O1D*CFC113 + 2*r375*O1D*CFC114 + r376*O1D*CFC115 + 2*r377*O1D*CFC12 + r378*O1D*HCL - + r387*BRO*CLO + r408*O1D*COFCL + 3*r413*CH3CCL3*OH + r415*CH3CL*OH + r418*HCFC141B*OH - + r419*HCFC142B*OH + r420*HCFC22*OH + r423*O1D*HCFC141B + r424*O1D*HCFC142B + r425*O1D*HCFC22 - - r10*CO3m*CL - r11*CO3m*CL - r23*CO4m*CL - r181*NO2m*CL - r210*O2m*CL - r237*OHm*CL - - r246*Om*CL - r346*CH2O*CL - r347*CH4*CL - r348*H2*CL - r349*H2O2*CL - r350*HO2*CL - - r351*HO2*CL - r352*O3*CL - r359*CLONO2*CL - r368*HOCL*CL - r409*CH2BR2*CL - r411*CH3BR*CL - - r414*CH3CL*CL - r416*CHBR3*CL d(CLm)/dt = r281*M*CLm_H2O + r282*M*CLm_HCL + r8*CLOm*NO + r9*CLOm*O + r10*CL*CO3m + r12*CLO*CO3m + r23*CL*CO4m + r26*CO4m*HCL + r181*CL*NO2m + r182*CLO*NO2m + r185*HCL*NO2m + r194*HCL*NO3m + r210*O2m*CL + r214*O2m*HCL + r237*CL*OHm + r241*OHm*HCL + r246*Om*CL + r247*CLO*Om @@ -1194,6 +1186,14 @@ Extraneous prod/loss species d(HCO3m)/dt = r239*M*CO2*OHm - r45*O2p*HCO3m - r68*Hp_5H2O*HCO3m - r85*Hp_3H2O*HCO3m - r99*Hp_4H2O*HCO3m - r103*NOp_H2O*HCO3m - r120*NOp_2H2O*HCO3m - r138*NOp*HCO3m + d(HO2)/dt = j11*HO2NO2 + r344*M*HO2NO2 + r26*CO4m*HCL + r213*H*O2m + r214*O2m*HCL + r215*O2m*HNO3 + + r243*OHm*O + r303*H2O2*O + r307*M*H*O2 + r312*OH*H2O2 + r315*OH*O3 + r333*NO3*OH + + r346*CL*CH2O + r349*CL*H2O2 + r353*CLO*CH3O2 + r364*CLO*OH + r382*BR*CH2O + r394*BRO*OH + + r411*CH3BR*CL + r412*CH3BR*OH + r414*CH3CL*CL + r415*CH3CL*OH + r426*CH2O*NO3 + r427*CH2O*O + + r430*CH3O2*NO + r433*M*CO*OH + r435*O1D*CH4 + - r438*HO2 - r206*NOp_H2O*HO2 - r304*H*HO2 - r305*H*HO2 - r306*H*HO2 - r308*O*HO2 - r309*O3*HO2 + - r313*OH*HO2 - 2*r318*HO2*HO2 - r330*NO3*HO2 - r335*NO*HO2 - r340*M*NO2*HO2 - r350*CL*HO2 + - r351*CL*HO2 - r357*CLO*HO2 - r383*BR*HO2 - r389*BRO*HO2 - r429*CH3O2*HO2 d(Hp_2H2O)/dt = r271*M*Hp_3H2O + r35*H2O*H3Op_OH + r268*M*Hp_H2O*H2O - r269*M*Hp_2H2O - r270*M*H2O*Hp_2H2O - r278*e*Hp_2H2O d(Hp_3H2O)/dt = r273*M*Hp_4H2O + r201*H2O*NOp_3H2O + r270*M*H2O*Hp_2H2O diff --git a/src/chemistry/pp_waccm_mad/chem_mech.in b/src/chemistry/pp_waccm_mad/chem_mech.in index 5b4858565a..30579fbf1f 100644 --- a/src/chemistry/pp_waccm_mad/chem_mech.in +++ b/src/chemistry/pp_waccm_mad/chem_mech.in @@ -1,15 +1,16 @@ * Comments -* User-given Tag Description: MAD_1 -* Tag database identifier : MZ257_MAD_20190128 -* Tag created by : ajc +* User-given Tag Description: WACCM_MAD +* Tag database identifier : MZ281_MAD_20210122 +* Tag created by : lke * Tag created from branch : MAD -* Tag created on : 2019-01-28 16:00:59.18623-07 +* Tag created on : 2021-01-22 15:25:08.160159-07 * Comments for this tag follow: -* ajc : 2019-01-28 : Add ion_Op_N2D +* lke : 2021-01-22 : Middle Atmosphere and D-Region mechanism for WACCM, no aerosols, with BR, CL transported SPECIES Solution + BR -> Br, BRCL -> BrCl, BRO -> BrO, BRONO2 -> BrONO2, @@ -31,6 +32,7 @@ CH3OOH, CH4, CHBR3 -> CHBr3, + CL -> Cl, CL2 -> Cl2, CL2O2 -> Cl2O2, CLO -> ClO, @@ -52,7 +54,6 @@ HCL -> HCl, HF, HNO3, - HO2, HO2NO2, HOBR -> HOBr, HOCL -> HOCl, @@ -68,8 +69,6 @@ O3, OCLO -> OClO, SF6, - BR -> Br, - CL -> Cl, CLm -> Cl, CLm_H2O -> ClH2O, CLm_HCL -> Cl2H, @@ -81,6 +80,7 @@ e -> E, H3Op_OH -> H4O2, HCO3m -> HCO3, + HO2, Hp_2H2O -> H5O2, Hp_3H2O -> H7O3, Hp_3N1 -> H8NO6, @@ -134,8 +134,6 @@ End Col-int Not-Transported - BR, - CL, CLm, CLm_H2O, CLm_HCL, @@ -147,6 +145,7 @@ e, H3Op_OH, HCO3m, + HO2, Hp_2H2O, Hp_3H2O, Hp_3N1, @@ -208,6 +207,7 @@ CH4 CHBR3 CLY + CO2 H2402 HCFC141B HCFC142B @@ -217,12 +217,14 @@ End Explicit Implicit + BR BRCL BRO BRONO2 CH2O CH3O2 CH3OOH + CL CL2 CL2O2 CLO @@ -230,7 +232,6 @@ CO COF2 COFCL - CO2 F H H2 @@ -239,7 +240,6 @@ HCL HF HNO3 - HO2 HO2NO2 HOBR HOCL @@ -253,8 +253,6 @@ O2 O3 OCLO - BR - CL CLm CLm_H2O CLm_HCL @@ -266,6 +264,7 @@ e H3Op_OH HCO3m + HO2 Hp_2H2O Hp_3H2O Hp_3N1 @@ -315,657 +314,657 @@ ********************************* *** odd-oxygen ********************************* -[jh2o_b] H2O + hv -> H2 + O1D -[jh2o_c] H2O + hv -> 2*H + O -[jh2o_a] H2O + hv -> OH + H -[jh2o2] H2O2 + hv -> 2*OH -[jo2_b=userdefined,] O2 + hv -> 2*O -[jo2_a=userdefined,] O2 + hv -> O + O1D -[jo3_a] O3 + hv -> O1D + O2_1D -[jo3_b] O3 + hv -> O + O2 +[jh2o_b] H2O + hv -> H2 + O1D +[jh2o_c] H2O + hv -> 2*H + O +[jh2o_a] H2O + hv -> OH + H +[jh2o2] H2O2 + hv -> 2*OH +[jo2_b=userdefined,] O2 + hv -> 2*O +[jo2_a=userdefined,] O2 + hv -> O + O1D +[jo3_a] O3 + hv -> O1D + O2_1D +[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 -[jhono] HONO + hv -> NO + OH -[jn2o] N2O + hv -> O1D + N2 -[jn2o5_a] N2O5 + hv -> NO2 + NO3 -[jn2o5_b] N2O5 + hv -> NO + O + NO3 -[jno_i] NO + hv -> NOp + e -[jno=userdefined,] NO + hv -> N + O -[jno2] NO2 + hv -> NO + O -[jno3_a] NO3 + hv -> NO2 + O -[jno3_b] NO3 + hv -> NO + O2 +[jhno3] HNO3 + hv -> NO2 + OH +[jho2no2_a] HO2NO2 + hv -> OH + NO3 +[jho2no2_b] HO2NO2 + hv -> NO2 + HO2 +[jhono] HONO + hv -> NO + OH +[jn2o] N2O + hv -> O1D + N2 +[jn2o5_a] N2O5 + hv -> NO2 + NO3 +[jn2o5_b] N2O5 + hv -> NO + O + NO3 +[jno_i] NO + hv -> NOp + e +[jno=userdefined,] NO + hv -> N + O +[jno2] NO2 + hv -> NO + O +[jno3_a] NO3 + hv -> NO2 + O +[jno3_b] NO3 + hv -> NO + O2 ********************************* *** organics ********************************* -[jch2o_a] CH2O + hv -> CO + 2*H -[jch2o_b] CH2O + hv -> CO + H2 -[jch3ooh] CH3OOH + hv -> CH2O + H + OH -[jch4_a] CH4 + hv -> H + CH3O2 -[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 -[jco2] CO2 + hv -> CO + O +[jch2o_a] CH2O + hv -> CO + 2*H +[jch2o_b] CH2O + hv -> CO + H2 +[jch3ooh] CH3OOH + hv -> CH2O + H + OH +[jch4_a] CH4 + hv -> H + CH3O2 +[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 +[jco2] CO2 + hv -> CO + O ********************************* *** 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 -> 2*CL + COFCL -[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 -[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_a] CLONO2 + hv -> CL + NO3 -[jclono2_b] CLONO2 + hv -> CLO + NO2 -[jcof2] COF2 + hv -> 2*F -[jcofcl] COFCL + hv -> F + CL -[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 +[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 -> 2*CL + COFCL +[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 +[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_a] CLONO2 + hv -> CL + NO3 +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jcof2] COF2 + hv -> 2*F +[jcofcl] COFCL + hv -> F + CL +[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 ********************************* *** ions ********************************* -[jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O -[jpni3=userdefined] CO3m + hv -> CO2 + Om -[jpni5=userdefined] CO3m_H2O + hv -> CO3m + H2O -[jpni4=userdefined] CO4m + hv -> CO2 + O2m -[jeuv_4=userdefined,userdefined] N + hv -> Np + e -[jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N -[jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e -[jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N -[jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e -[jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e -[jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e -[jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e -[jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e -[jepn6=userdefined] NO2m + hv -> NO2 + e -[jepn7=userdefined] NO3m + hv -> NO3 + e -[jeuv_16=userdefined,userdefined] O + hv -> Op2P + e -[jeuv_1=userdefined,userdefined] O + hv -> Op + e -[jeuv_14=userdefined,userdefined] O + hv -> Op + e -[jeuv_15=userdefined,userdefined] O + hv -> Op2D + e -[jeuv_2=userdefined,userdefined] O + hv -> Op2D + e -[jeuv_3=userdefined,userdefined] O + hv -> Op2P + e -[jeuv_21=userdefined,userdefined] O2 + hv -> O + Op2P + e -[jeuv_24=userdefined,userdefined] O2 + hv -> 2*O -[jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e -[jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e -[jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e -[jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e -[jeuv_12=userdefined,userdefined] O2 + hv -> 2*O -[jeuv_20=userdefined,userdefined] O2 + hv -> O + Op2D + e -[jeuv_8=userdefined,userdefined] O2 + hv -> O + Op2D + e -[jeuv_9=userdefined,userdefined] O2 + hv -> O + Op2P + e -[jepn2=userdefined] O2m + hv -> O2 + e -[jppi=userdefined] O2p_H2O + hv -> H2O + O2p -[jpni1=userdefined] O3m + hv -> O2 + Om -[jepn3=userdefined] O3m + hv -> O3 + e -[jpni2=userdefined] O4m + hv -> O2 + O2m -[jepn4=userdefined] OHm + hv -> OH + e -[jepn1=userdefined] Om + hv -> O + e +[jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O +[jpni3=userdefined] CO3m + hv -> CO2 + Om +[jpni5=userdefined] CO3m_H2O + hv -> CO3m + H2O +[jpni4=userdefined] CO4m + hv -> CO2 + O2m +[jeuv_4=userdefined,userdefined] N + hv -> Np + e +[jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e +[jepn6=userdefined] NO2m + hv -> NO2 + e +[jepn7=userdefined] NO3m + hv -> NO3 + e +[jeuv_16=userdefined,userdefined] O + hv -> Op2P + e +[jeuv_1=userdefined,userdefined] O + hv -> Op + e +[jeuv_14=userdefined,userdefined] O + hv -> Op + e +[jeuv_15=userdefined,userdefined] O + hv -> Op2D + e +[jeuv_2=userdefined,userdefined] O + hv -> Op2D + e +[jeuv_3=userdefined,userdefined] O + hv -> Op2P + e +[jeuv_21=userdefined,userdefined] O2 + hv -> O + Op2P + e +[jeuv_24=userdefined,userdefined] O2 + hv -> 2*O +[jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_12=userdefined,userdefined] O2 + hv -> 2*O +[jeuv_20=userdefined,userdefined] O2 + hv -> O + Op2D + e +[jeuv_8=userdefined,userdefined] O2 + hv -> O + Op2D + e +[jeuv_9=userdefined,userdefined] O2 + hv -> O + Op2P + e +[jepn2=userdefined] O2m + hv -> O2 + e +[jppi=userdefined] O2p_H2O + hv -> H2O + O2p +[jpni1=userdefined] O3m + hv -> O2 + Om +[jepn3=userdefined] O3m + hv -> O3 + e +[jpni2=userdefined] O4m + hv -> O2 + O2m +[jepn4=userdefined] OHm + hv -> OH + e +[jepn1=userdefined] Om + hv -> O + e End Photolysis Reactions ********************************* *** Not Assigned to a Section ********************************* -[CLm_H] CLm + H -> HCL + e ; 9.6e-10 -[CLmH2O_HCL] CLm_H2O + HCL -> CLm_HCL + H2O ; 1.3e-09 -[CLm_H2O_Ma] CLm + H2O + M -> CLm_H2O + M ; 2e-29 -[CLmHCL_M] HCL + M + CLm -> CLm_HCL + M ; 1e-27 -[CLm_HNO3] CLm + HNO3 -> HCL + NO3m ; 1.6e-09 -[CLm_NO2] CLm + NO2 -> CL + NO2m ; 6e-12 -[CLOm_NOa] CLOm + NO -> CL + NO2m ; 2.9e-12 -[CLOm_NOb] CLOm + NO -> NO2 + CLm ; 2.9e-11 -[CLOm_O] CLOm + O -> CLm + O2 ; 2e-10 -[CO3m_CLa] CL + CO3m -> CLm + CO2 + O ; 1e-10 -[CO3m_CLb] CL + CO3m -> CLOm + CO2 ; 1e-10 -[CO3m_CLO] CLO + CO3m -> CLm + CO2 + O2 ; 1e-11 -[CO3m_H] H + CO3m -> CO2 + OHm ; 1.7e-10 -[CO3mH2O_H2O_M] CO3m_H2O + H2O + M -> CO3m2H2O + M ; 1e-28 -[CO3m_H2O_M] CO3m + H2O + M -> CO3m_H2O + M ; 1e-28 -[CO3mH2O_NO2a] CO3m_H2O + NO2 -> CO2 + H2O + NO3m ; 4e-11 -[CO3mH2O_NO2b] CO3m_H2O + NO2 -> CO2 + NO3m_H2O ; 4e-11 -[CO3mH2O_NOa] CO3m_H2O + NO -> CO2 + NO2m_H2O ; 3.5e-12 -[CO3mH2O_NOb] CO3m_H2O + NO -> CO2 + H2O + NO2m ; 3.5e-12 -[CO3m_HNO3] CO3m + HNO3 -> CO2 + NO3m + OH ; 3.51e-10 -[CO3m_O] CO3m + O -> CO2 + O2m ; 1.1e-10 -[CO3m_O2] O2 + CO3m -> CO2 + O3m ; 6e-15 -[CO4m_CL] CL + CO4m -> CLm + CO2 + O2 ; 1e-10 -[CO4m_CLO] CLO + CO4m -> CLOm + CO2 + O2 ; 1e-10 -[CO4m_H] CO4m + H -> CO3m + OH ; 2.2e-10 -[CO4m_HCL] CO4m + HCL -> CLm + CO2 + HO2 ; 1.2e-09 -[CO4m_O] CO4m + O -> CO3m + O2 ; 1.4e-10 -[CO4m_O3] CO4m + O3 -> CO2 + O2 + O3m ; 1.3e-10 -[ean1] e + O2 + N2 -> N2 + O2m -[ean2] O3 + e -> O2 + Om -[ean3] M + O2 + e -> M + O2m -[edn1] NO + Om -> e + NO2 -[edn2] N2 + O2m -> e + O2 + N2 -[H3OpOH_e] H3Op_OH + e -> H + H2O + OH ; 1.5e-06 -[H3OpOH_H2O] H2O + H3Op_OH -> Hp_2H2O + OH ; 2e-09 -[Hp3N1_H2O] H2O + Hp_3N1 -> HNO3 + Hp_4H2O ; 1e-09 -[Hp4H2O_e] Hp_4H2O + e -> H + 4*H2O ; 3.6e-06 -[Hp4H2O_N2O5] Hp_4H2O + N2O5 -> HNO3 + Hp_3N1 ; 4e-12 -[Hp4N1_H2O] H2O + Hp_4N1 -> HNO3 + Hp_5H2O ; 1e-09 -[Hp5H2O_e] Hp_5H2O + e -> H + 5*H2O ; 5e-06 -[Hp5H2O_N2O5] Hp_5H2O + N2O5 -> HNO3 + Hp_4N1 ; 7e-12 -[iira1] Hp_4H2O + NO3mHNO3 -> 4*H2O + 2*HNO3 -[iira10] CLm + Hp_4H2O -> CL + H + 4*H2O -[iira100] NO3m + O2p -> NO3 + O2 -[iira101] HCO3m + O2p -> CO2 + O2 + OH -[iira102] O2m + O2p -> 2*O2p -[iira103] CO4m + O2p -> CO2 + O2 + O2 -[iira104] NO3m_H2O + O2p -> H2O + NO3 + O2 -[iira105] CO3m2H2O + O2p -> CO2 + 2*H2O + O + O2 -[iira106] CLm + O2p -> CL + O2 -[iira107] CO3m_H2O + O2p -> H2O + O + O2 + CO2 -[iira108] NO2m_H2O + O2p -> H2O + NO2 + O2 -[iira109] NO3m_HCL + O2p -> HCL + NO3 + O2 -[iira11] CO3m_H2O + Hp_4H2O -> CO2 + 5*H2O + O + H -[iira110] O2p + CLm_H2O -> CL + H2O + O2 -[iira111] NO3m2H2O + O2p -> 2*H2O + NO3 + O2 -[iira112] NO2m + O2p -> NO2 + O2 -[iira12] Hp_4H2O + NO2m_H2O -> H + 5*H2O + NO2 -[iira13] Hp_4H2O + NO3m_HCL -> H + 4*H2O + NO3 + HCL -[iira14] CLm_H2O + Hp_4H2O -> H + CL + 5*H2O -[iira15] NO3m2H2O + Hp_4H2O -> H + 6*H2O + NO3 -[iira16] Hp_4H2O + NO2m -> H + NO2 + 4*H2O -[iira17] Hp_5H2O + NO3mHNO3 -> 5*H2O + 2*HNO3 -[iira18] CO3m + Hp_5H2O -> CO2 + 5*H2O + O + H -[iira19] CLm_HCL + Hp_5H2O -> CL + H + 5*H2O + HCL -[iira2] CO3m + Hp_4H2O -> CO2 + H + 4*H2O + O -[iira20] NO3m + Hp_5H2O -> 5*H2O + HNO3 -[iira21] HCO3m + Hp_5H2O -> CO2 + H + 5*H2O + OH -[iira22] Hp_5H2O + O2m -> H + 5*H2O + O2 -[iira23] CO4m + Hp_5H2O -> CO2 + 5*H2O + O2 + H -[iira24] Hp_5H2O + NO3m_H2O -> H + 6*H2O + NO3 -[iira25] CO3m2H2O + Hp_5H2O -> H + CO2 + 7*H2O + O -[iira26] CLm + Hp_5H2O -> CL + H + 5*H2O -[iira27] CO3m_H2O + Hp_5H2O -> CO2 + H + 6*H2O + O -[iira28] NO2m_H2O + Hp_5H2O -> H + 6*H2O + NO2 -[iira29] Hp_5H2O + NO3m_HCL -> H + 5*H2O + HCL + NO3 -[iira3] CLm_HCL + Hp_4H2O -> CL + H + HCL + 4*H2O -[iira30] CLm_H2O + Hp_5H2O -> CL + H + 6*H2O -[iira31] Hp_5H2O + NO3m2H2O -> H + 7*H2O + NO3 -[iira32] Hp_5H2O + NO2m -> 5*H2O + NO2 + H -[iira33] Hp_3H2O + NO3mHNO3 -> 3*H2O + 2*HNO3 -[iira34] Hp_3H2O + CO3m -> CO2 + H + 3*H2O + O -[iira35] CLm_HCL + Hp_3H2O -> CL + H + 3*H2O + HCL -[iira36] Hp_3H2O + NO3m -> 3*H2O + HNO3 -[iira37] HCO3m + Hp_3H2O -> CO2 + H + 3*H2O + OH -[iira38] Hp_3H2O + O2m -> H + 3*H2O + O2 -[iira39] CO4m + Hp_3H2O -> CO2 + H + 3*H2O + O2 -[iira4] Hp_4H2O + NO3m -> 4*H2O + HNO3 -[iira40] Hp_3H2O + NO3m_H2O -> H + 4*H2O + NO3 -[iira41] CO3m2H2O + Hp_3H2O -> CO2 + H + 5*H2O + O -[iira42] CLm + Hp_3H2O -> CL + H + 3*H2O -[iira43] CO3m_H2O + Hp_3H2O -> CO2 + H + O + 4*H2O -[iira44] Hp_3H2O + NO2m_H2O -> H + 4*H2O + NO2 -[iira45] Hp_3H2O + NO3m_HCL -> H + 3*H2O + HCL + NO3 -[iira46] CLm_H2O + Hp_3H2O -> H + 4*H2O + CL -[iira47] Hp_3H2O + NO3m2H2O -> H + 5*H2O + NO3 -[iira48] Hp_3H2O + NO2m -> H + 3*H2O + NO2 -[iira49] NO3mHNO3 + NOp_H2O -> H2O + HNO3 + NO + NO3 -[iira5] HCO3m + Hp_4H2O -> CO2 + H + 4*H2O + OH -[iira50] CO3m + NOp_H2O -> CO2 + H2O + NO + O -[iira51] CLm_HCL + NOp_H2O -> CL + NO + H2O + HCL -[iira52] NO3m + NOp_H2O -> H2O + NO + NO3 -[iira53] HCO3m + NOp_H2O -> OH + CO2 + H2O + NO -[iira54] NOp_H2O + O2m -> H2O + NO + O2 -[iira55] CO4m + NOp_H2O -> O2 + NO + CO2 + H2O -[iira56] NO3m_H2O + NOp_H2O -> 2*H2O + NO + NO3 -[iira57] CO3m2H2O + NOp_H2O -> CO2 + 3*H2O + NO + O -[iira58] CLm + NOp_H2O -> CL + H2O + NO -[iira59] CO3m_H2O + NOp_H2O -> O + CO2 + 2*H2O + NO -[iira6] Hp_4H2O + O2m -> O2 + H + 4*H2O -[iira60] NO2m_H2O + NOp_H2O -> NO + 2*H2O + NO2 -[iira61] NO3m_HCL + NOp_H2O -> H2O + NO + NO3 + HCL -[iira62] CLm_H2O + NOp_H2O -> CL + 2*H2O + NO -[iira63] NO3m2H2O + NOp_H2O -> NO + NO3 + 3*H2O -[iira64] NO2m + NOp_H2O -> NO + H2O + NO2 -[iira65] NO3mHNO3 + NOp_2H2O -> 2*H2O + NO3 + HNO3 + NO -[iira66] CO3m + NOp_2H2O -> 2*H2O + NO + CO2 + O -[iira67] CLm_HCL + NOp_2H2O -> NO + CL + 2*H2O + HCL -[iira68] NOp_2H2O + NO3m -> NO + 2*H2O + NO3 -[iira69] HCO3m + NOp_2H2O -> 2*H2O + OH + NO + CO2 -[iira7] CO4m + Hp_4H2O -> 4*H2O + H + CO2 + O2 -[iira70] NOp_2H2O + O2m -> 2*H2O + NO + O2 -[iira71] NOp_2H2O + CO4m -> O2 + 2*H2O + NO + CO2 -[iira72] NO3m_H2O + NOp_2H2O -> 3*H2O + NO3 + NO -[iira73] CO3m2H2O + NOp_2H2O -> O + CO2 + 4*H2O + NO -[iira74] CLm + NOp_2H2O -> 2*H2O + NO + CL -[iira75] CO3m_H2O + NOp_2H2O -> 3*H2O + CO2 + NO + O -[iira76] NOp_2H2O + NO2m_H2O -> 3*H2O + NO + NO2 -[iira77] NO3m_HCL + NOp_2H2O -> NO + HCL + 2*H2O + NO3 -[iira78] NOp_2H2O + CLm_H2O -> NO + 3*H2O + CL -[iira79] NOp_2H2O + NO3m2H2O -> NO + NO3 + 4*H2O -[iira8] Hp_4H2O + NO3m_H2O -> H + 5*H2O + NO3 -[iira80] NOp_2H2O + NO2m -> 2*H2O + NO2 + NO -[iira81] NOp + NO3mHNO3 -> NO + HNO3 + NO3 -[iira82] NOp + CO3m -> CO2 + NO + O -[iira83] NOp + CLm_HCL -> CL + HCL + NO -[iira84] NO3m + NOp -> NO3 + NO -[iira85] NOp + HCO3m -> NO + CO2 + OH -[iira86] O2m + NOp -> NO + O2 -[iira87] NOp + CO4m -> CO2 + NO + O2 -[iira88] NOp + NO3m_H2O -> H2O + NO + NO3 -[iira89] NOp + CO3m2H2O -> NO + O + CO2 + 2*H2O -[iira9] CO3m2H2O + Hp_4H2O -> CO2 + 6*H2O + O + H -[iira90] CLm + NOp -> CL + NO -[iira91] CO3m_H2O + NOp -> H2O + NO + O + CO2 -[iira92] NO2m_H2O + NOp -> NO + NO2 + H2O -[iira93] NO3m_HCL + NOp -> NO + HCL + NO3 -[iira94] CLm_H2O + NOp -> CL + NO + H2O -[iira95] NOp + NO3m2H2O -> 2*H2O + NO + NO3 -[iira96] NOp + NO2m -> NO2 + NO -[iira97] NO3mHNO3 + O2p -> O2 + NO3 + HNO3 -[iira98] O2p + CO3m -> O + O2 + CO2 -[iira99] O2p + CLm_HCL -> O2 + HCL + CL -[iirb1] Hp_4H2O + CO3m + M -> 4*H2O + O + CO2 + H + M -[iirb10] Hp_5H2O + M + CO3m2H2O -> H + 7*H2O + M + CO2 + O -[iirb11] M + CO3m_H2O + Hp_4H2O -> 5*H2O + M + H + CO2 + O -[iirb12] Hp_5H2O + M + CO3m_H2O -> CO2 + M + O + H + 6*H2O -[iirb13] NO3m_H2O + Hp_4H2O + M -> M + NO3 + H + 5*H2O -[iirb14] NO3m_H2O + Hp_5H2O + M -> M + NO3 + H + 6*H2O -[iirb2] NO3m + M + Hp_4H2O -> 4*H2O + HNO3 + M -[iirb3] Hp_5H2O + M + CO3m -> 5*H2O + M + CO2 + O + H -[iirb4] Hp_5H2O + NO3m + M -> M + HNO3 + 5*H2O -[iirb5] M + CLm_HCL + Hp_4H2O -> M + 2*HCL + 4*H2O -[iirb6] M + Hp_5H2O + CLm_HCL -> M + 5*H2O + 2*HCL -[iirb7] NO3mHNO3 + M + Hp_4H2O -> 4*H2O + M + 2*HNO3 -[iirb8] Hp_5H2O + M + NO3mHNO3 -> M + 5*H2O + 2*HNO3 -[iirb9] M + CO3m2H2O + Hp_4H2O -> CO2 + 6*H2O + H + M + O -[nir1] NO + O3m -> O + NO3m -[nir10] NO2m_H2O + M -> H2O + NO2m + M -[nir11] NO3m2H2O + M -> M + NO3m_H2O + H2O -[nir12] NO3mHNO3 + M -> NO3m + HNO3 + M -[nir13] HCL + M + NO3m -> NO3m_HCL + M -[nir2] NO2 + O3m -> NO3m + O2 -[nir3] NO2 + O3m -> NO2m + O3 -[nir4] NO + O3m -> NO2m + O2 -[nir5] CO3m + NO -> CO2 + NO2m -[nir6] CO3m + NO2 -> NO3m + CO2 -[nir7] M + NO3m_H2O -> M + H2O + NO3m -[nir8] CO3m_H2O + M -> CO3m + M + H2O -[nir9] CO3m2H2O + M -> CO3m_H2O + H2O + M -[NO2m_CL] CL + NO2m -> CLm + NO2 ; 1e-10 -[NO2m_CLO] CLO + NO2m -> CLm + NO3 ; 1e-10 -[NO2m_H] H + NO2m -> NO + OHm ; 3e-10 -[NO2m_H2O_M] NO2m + H2O + M -> M + NO2m_H2O ; 1.6e-28 -[NO2m_HCL] HCL + NO2m -> CLm + HONO ; 1.4e-09 -[NO2m_HNO3] HNO3 + NO2m -> NO3m + HONO ; 1.6e-09 -[NO2m_NO2] NO2 + NO2m -> NO + NO3m ; 2e-13 -[NO2m_O3] NO2m + O3 -> NO3m + O2 ; 1.2e-10 -[NO3m2H2O_N2O5] NO3m2H2O + N2O5 -> H2O + HNO3 + NO3mHNO3 ; 7e-10 -[NO3mH2O_H2O_M] NO3m_H2O + H2O + M -> M + NO3m2H2O ; 1.6e-28 -[NO3mH2O_HNO3] HNO3 + NO3m_H2O -> H2O + NO3mHNO3 ; 1.6e-09 -[NO3m_H2O_M] H2O + M + NO3m -> M + NO3m_H2O ; 1.6e-28 -[NO3mH2O_N2O5] NO3m_H2O + N2O5 -> HNO3 + NO3mHNO3 ; 7e-10 -[NO3m_HCLa] HCL + NO3m -> CLm + HNO3 ; 1e-12 -[NO3mHCL_HNO3] HNO3 + NO3m_HCL -> HCL + NO3mHNO3 ; 7.6e-10 -[NO3m_HNO3_M] NO3m + HNO3 + M -> M + NO3mHNO3 ; 1.45e-26 -[NO3m_O] NO3m + O -> NO2m + O2 ; 5e-12 -[NO3m_O3] O3 + NO3m -> NO2m + 2*O2 ; 1e-13 -[NOp2H2O_e] NOp_2H2O + e -> 2*H2O + NO ; 2e-06 -[NOp3H2O_e] NOp_3H2O + e -> 3*H2O + NO ; 2e-06 -[NOp3H2O_H2O] H2O + NOp_3H2O -> HONO + Hp_3H2O ; 7e-11 -[NOpCO2_e] NOp_CO2 + e -> CO2 + NO ; 1.5e-06 -[NOpCO2_H2O] NOp_CO2 + H2O -> CO2 + NOp_H2O ; 1e-09 -[NOpH2O_e] NOp_H2O + e -> H2O + NO ; 1.5e-06 -[NOpH2O_H] H + NOp_H2O -> NO + Hp_H2O ; 7e-12 -[NOpH2O_HO2] NOp_H2O + HO2 -> Hp_H2O + NO3 ; 5e-10 -[NOpH2O_OH] NOp_H2O + OH -> Hp_H2O + NO2 ; 1e-10 -[NOpN2_CO2] CO2 + NOp_N2 -> N2 + NOp_CO2 ; 1e-09 -[NOpN2_H2O] NOp_N2 + H2O -> N2 + NOp_H2O ; 1e-09 -[O2m_CL] O2m + CL -> CLm + O2 ; 1e-10 -[O2m_CLO] CLO + O2m -> CLOm + O2 ; 1e-10 -[O2m_CO2_M] CO2 + M + O2m -> CO4m + M ; 9.9e-30 -[O2m_H] H + O2m -> HO2 + e ; 1.4e-09 -[O2m_HCL] O2m + HCL -> CLm + HO2 ; 1.6e-09 -[O2m_HNO3] O2m + HNO3 -> HO2 + NO3m ; 2.9e-09 -[O2m_NO2] NO2 + O2m -> NO2m + O2 ; 7e-10 -[O2m_O21D] O2_1D + O2m -> 2*O2 + e ; 2e-10 -[O2m_O2_M] O2 + M + O2m -> M + O4m ; 3.4e-31 -[O2m_O3] O3 + O2m -> O2 + O3m ; 7.8e-10 -[O2m_O_a] O + O2m -> O3 + e ; 1.5e-10 -[O2m_O_b] O2m + O -> O2 + Om ; 1.5e-10 -[O2pH2O_e] O2p_H2O + e -> H2O + O2 ; 2e-06 -[O2pH2O_H2Oa] O2p_H2O + H2O -> H3Op_OH + O2 ; 9e-10 -[O2pH2O_H2Ob] O2p_H2O + H2O -> Hp_H2O + O2 + OH ; 2.4e-10 -[O2p_H2O_M] M + H2O + O2p -> M + O2p_H2O ; 2.8e-28 -[O3m_CO2] O3m + CO2 -> CO3m + O2 ; 5.5e-10 -[O3m_H] O3m + H -> O2 + OHm ; 8.4e-10 -[O3m_O3] O3 + O3m -> 3*O2 + e ; 1e-10 -[O3m_O_a] O3m + O -> 2*O2 + e ; 1e-10 -[O3m_O_b] O + O3m -> O2 + O2m ; 2.5e-10 -[O4m_CO2] CO2 + O4m -> CO4m + O2 ; 4.3e-10 -[O4m_O] O + O4m -> O3m + O2 ; 4e-10 -[O4p_H2O] H2O + O4p -> O2 + O2p_H2O ; 1.7e-09 -[O4p_O] O4p + O -> O2p + O3 ; 3e-10 -[O4p_O21D] O4p + O2_1D -> 2*O2 + O2p ; 1.5e-10 -[OH_HONO] HONO + OH -> H2O + NO2 ; 1.8e-11, 390 -[OHm_CL] CL + OHm -> CLm + OH ; 1e-10 -[OHm_CLO] CLO + OHm -> CLOm + OH ; 1e-10 -[OHm_CO2] CO2 + M + OHm -> M + HCO3m ; 7.6e-28 -[OHm_H] H + OHm -> e + H2O ; 1.4e-09 -[OHm_HCL] OHm + HCL -> CLm + H2O ; 1e-09 -[OHm_NO2] NO2 + OHm -> NO2m + OH ; 1.1e-09 -[OHm_O] OHm + O -> HO2 + e ; 2e-10 -[OHm_O3] OHm + O3 -> O3m + OH ; 9e-10 -[OH_NO_M] OH + NO + M -> HONO + M ; 7e-31, 2.6, 3.6e-11, 0.1, 0.6 -[Om_CL] Om + CL -> CLm + O ; 1e-10 -[Om_CLO] CLO + Om -> CLm + O2 ; 1e-10 -[Om_CO2_M] M + Om + CO2 -> CO3m + M ; 2e-28 -[Om_H2_a] H2 + Om -> H2O + e ; 5.8e-10 -[Om_H2_b] Om + H2 -> H + OHm ; 3.2e-11 -[Om_H2O] Om + H2O -> OHm + OH ; 6e-13 -[Om_HCL] Om + HCL -> CLm + OH ; 2e-09 -[Om_HNO3] Om + HNO3 -> NO3m + OH ; 3.6e-09 -[Om_M] M + Om -> O + M + e ; 5e-13 -[Om_NO2] NO2 + Om -> O + NO2m ; 1e-09 -[Om_O] Om + O -> e + O2 ; 1.9e-10 -[Om_O21D] Om + O2_1D -> O3 + e ; 3e-10 -[Om_O2_M] M + Om + O2 -> M + O3m ; 2.9e-31 -[Om_O3] O3 + Om -> O + O3m ; 8e-10 -[pir1] M + O2p + O2 -> M + O4p -[pir10] H2O + NOp + M -> M + NOp_H2O -[pir11] H2O + M + NOp_H2O -> M + NOp_2H2O -[pir12] H2O + NOp_2H2O + M -> M + NOp_3H2O -[pir13] NOp + CO2 + M -> M + NOp_CO2 -[pir14] NOp_CO2 + M -> M + NOp + CO2 -[pir15] N2 + M + NOp -> NOp_N2 + M -[pir16] NOp_N2 + M -> M + NOp + N2 -[pir2] M + Hp_H2O + H2O -> Hp_2H2O + M -[pir3] Hp_2H2O + M -> H2O + Hp_H2O + M -[pir4] H2O + Hp_2H2O + M -> Hp_3H2O + M -[pir5] Hp_3H2O + M -> M + Hp_2H2O + H2O -[pir6] Hp_3H2O + H2O + M -> M + Hp_4H2O -[pir7] Hp_4H2O + M -> H2O + M + Hp_3H2O -[pir8] Hp_4H2O + M + H2O -> Hp_5H2O + M -[pir9] M + Hp_5H2O -> M + H2O + Hp_4H2O -[rpe1] e + O4p -> 2*O2 -[rpe2] Hp_H2O + e -> H + H2O -[rpe3] Hp_2H2O + e -> 2*H2O + H -[rpe4] Hp_3H2O + e -> H + 3*H2O -[rpe5] e + NOp_N2 -> N2 + NO -[usr_CLm_H2O_M] CLm_H2O + M -> H2O + M + CLm -[usr_CLm_HCL_M] M + CLm_HCL -> CLm + HCL + M +[CLm_H] CLm + H -> HCL + e ; 9.6e-10 +[CLmH2O_HCL] CLm_H2O + HCL -> CLm_HCL + H2O ; 1.3e-09 +[CLm_H2O_Ma] CLm + H2O + M -> CLm_H2O + M ; 2e-29 +[CLmHCL_M] HCL + M + CLm -> CLm_HCL + M ; 1e-27 +[CLm_HNO3] CLm + HNO3 -> HCL + NO3m ; 1.6e-09 +[CLm_NO2] CLm + NO2 -> CL + NO2m ; 6e-12 +[CLOm_NOa] CLOm + NO -> CL + NO2m ; 2.9e-12 +[CLOm_NOb] CLOm + NO -> NO2 + CLm ; 2.9e-11 +[CLOm_O] CLOm + O -> CLm + O2 ; 2e-10 +[CO3m_CLa] CL + CO3m -> CLm + CO2 + O ; 1e-10 +[CO3m_CLb] CL + CO3m -> CLOm + CO2 ; 1e-10 +[CO3m_CLO] CLO + CO3m -> CLm + CO2 + O2 ; 1e-11 +[CO3m_H] H + CO3m -> CO2 + OHm ; 1.7e-10 +[CO3mH2O_H2O_M] CO3m_H2O + H2O + M -> CO3m2H2O + M ; 1e-28 +[CO3m_H2O_M] CO3m + H2O + M -> CO3m_H2O + M ; 1e-28 +[CO3mH2O_NO2a] CO3m_H2O + NO2 -> CO2 + H2O + NO3m ; 4e-11 +[CO3mH2O_NO2b] CO3m_H2O + NO2 -> CO2 + NO3m_H2O ; 4e-11 +[CO3mH2O_NOa] CO3m_H2O + NO -> CO2 + NO2m_H2O ; 3.5e-12 +[CO3mH2O_NOb] CO3m_H2O + NO -> CO2 + H2O + NO2m ; 3.5e-12 +[CO3m_HNO3] CO3m + HNO3 -> CO2 + NO3m + OH ; 3.51e-10 +[CO3m_O] CO3m + O -> CO2 + O2m ; 1.1e-10 +[CO3m_O2] O2 + CO3m -> CO2 + O3m ; 6e-15 +[CO4m_CL] CL + CO4m -> CLm + CO2 + O2 ; 1e-10 +[CO4m_CLO] CLO + CO4m -> CLOm + CO2 + O2 ; 1e-10 +[CO4m_H] CO4m + H -> CO3m + OH ; 2.2e-10 +[CO4m_HCL] CO4m + HCL -> CLm + CO2 + HO2 ; 1.2e-09 +[CO4m_O] CO4m + O -> CO3m + O2 ; 1.4e-10 +[CO4m_O3] CO4m + O3 -> CO2 + O2 + O3m ; 1.3e-10 +[ean1] e + O2 + N2 -> N2 + O2m +[ean2] O3 + e -> O2 + Om +[ean3] M + O2 + e -> M + O2m +[edn1] NO + Om -> e + NO2 +[edn2] N2 + O2m -> e + O2 + N2 +[H3OpOH_e] H3Op_OH + e -> H + H2O + OH ; 1.5e-06 +[H3OpOH_H2O] H2O + H3Op_OH -> Hp_2H2O + OH ; 2e-09 +[Hp3N1_H2O] H2O + Hp_3N1 -> HNO3 + Hp_4H2O ; 1e-09 +[Hp4H2O_e] Hp_4H2O + e -> H + 4*H2O ; 3.6e-06 +[Hp4H2O_N2O5] Hp_4H2O + N2O5 -> HNO3 + Hp_3N1 ; 4e-12 +[Hp4N1_H2O] H2O + Hp_4N1 -> HNO3 + Hp_5H2O ; 1e-09 +[Hp5H2O_e] Hp_5H2O + e -> H + 5*H2O ; 5e-06 +[Hp5H2O_N2O5] Hp_5H2O + N2O5 -> HNO3 + Hp_4N1 ; 7e-12 +[iira1] Hp_4H2O + NO3mHNO3 -> 4*H2O + 2*HNO3 +[iira10] CLm + Hp_4H2O -> CL + H + 4*H2O +[iira100] NO3m + O2p -> NO3 + O2 +[iira101] HCO3m + O2p -> CO2 + O2 + OH +[iira102] O2m + O2p -> 2*O2p +[iira103] CO4m + O2p -> CO2 + O2 + O2 +[iira104] NO3m_H2O + O2p -> H2O + NO3 + O2 +[iira105] CO3m2H2O + O2p -> CO2 + 2*H2O + O + O2 +[iira106] CLm + O2p -> CL + O2 +[iira107] CO3m_H2O + O2p -> H2O + O + O2 + CO2 +[iira108] NO2m_H2O + O2p -> H2O + NO2 + O2 +[iira109] NO3m_HCL + O2p -> HCL + NO3 + O2 +[iira11] CO3m_H2O + Hp_4H2O -> CO2 + 5*H2O + O + H +[iira110] O2p + CLm_H2O -> CL + H2O + O2 +[iira111] NO3m2H2O + O2p -> 2*H2O + NO3 + O2 +[iira112] NO2m + O2p -> NO2 + O2 +[iira12] Hp_4H2O + NO2m_H2O -> H + 5*H2O + NO2 +[iira13] Hp_4H2O + NO3m_HCL -> H + 4*H2O + NO3 + HCL +[iira14] CLm_H2O + Hp_4H2O -> H + CL + 5*H2O +[iira15] NO3m2H2O + Hp_4H2O -> H + 6*H2O + NO3 +[iira16] Hp_4H2O + NO2m -> H + NO2 + 4*H2O +[iira17] Hp_5H2O + NO3mHNO3 -> 5*H2O + 2*HNO3 +[iira18] CO3m + Hp_5H2O -> CO2 + 5*H2O + O + H +[iira19] CLm_HCL + Hp_5H2O -> CL + H + 5*H2O + HCL +[iira2] CO3m + Hp_4H2O -> CO2 + H + 4*H2O + O +[iira20] NO3m + Hp_5H2O -> 5*H2O + HNO3 +[iira21] HCO3m + Hp_5H2O -> CO2 + H + 5*H2O + OH +[iira22] Hp_5H2O + O2m -> H + 5*H2O + O2 +[iira23] CO4m + Hp_5H2O -> CO2 + 5*H2O + O2 + H +[iira24] Hp_5H2O + NO3m_H2O -> H + 6*H2O + NO3 +[iira25] CO3m2H2O + Hp_5H2O -> H + CO2 + 7*H2O + O +[iira26] CLm + Hp_5H2O -> CL + H + 5*H2O +[iira27] CO3m_H2O + Hp_5H2O -> CO2 + H + 6*H2O + O +[iira28] NO2m_H2O + Hp_5H2O -> H + 6*H2O + NO2 +[iira29] Hp_5H2O + NO3m_HCL -> H + 5*H2O + HCL + NO3 +[iira3] CLm_HCL + Hp_4H2O -> CL + H + HCL + 4*H2O +[iira30] CLm_H2O + Hp_5H2O -> CL + H + 6*H2O +[iira31] Hp_5H2O + NO3m2H2O -> H + 7*H2O + NO3 +[iira32] Hp_5H2O + NO2m -> 5*H2O + NO2 + H +[iira33] Hp_3H2O + NO3mHNO3 -> 3*H2O + 2*HNO3 +[iira34] Hp_3H2O + CO3m -> CO2 + H + 3*H2O + O +[iira35] CLm_HCL + Hp_3H2O -> CL + H + 3*H2O + HCL +[iira36] Hp_3H2O + NO3m -> 3*H2O + HNO3 +[iira37] HCO3m + Hp_3H2O -> CO2 + H + 3*H2O + OH +[iira38] Hp_3H2O + O2m -> H + 3*H2O + O2 +[iira39] CO4m + Hp_3H2O -> CO2 + H + 3*H2O + O2 +[iira4] Hp_4H2O + NO3m -> 4*H2O + HNO3 +[iira40] Hp_3H2O + NO3m_H2O -> H + 4*H2O + NO3 +[iira41] CO3m2H2O + Hp_3H2O -> CO2 + H + 5*H2O + O +[iira42] CLm + Hp_3H2O -> CL + H + 3*H2O +[iira43] CO3m_H2O + Hp_3H2O -> CO2 + H + O + 4*H2O +[iira44] Hp_3H2O + NO2m_H2O -> H + 4*H2O + NO2 +[iira45] Hp_3H2O + NO3m_HCL -> H + 3*H2O + HCL + NO3 +[iira46] CLm_H2O + Hp_3H2O -> H + 4*H2O + CL +[iira47] Hp_3H2O + NO3m2H2O -> H + 5*H2O + NO3 +[iira48] Hp_3H2O + NO2m -> H + 3*H2O + NO2 +[iira49] NO3mHNO3 + NOp_H2O -> H2O + HNO3 + NO + NO3 +[iira5] HCO3m + Hp_4H2O -> CO2 + H + 4*H2O + OH +[iira50] CO3m + NOp_H2O -> CO2 + H2O + NO + O +[iira51] CLm_HCL + NOp_H2O -> CL + NO + H2O + HCL +[iira52] NO3m + NOp_H2O -> H2O + NO + NO3 +[iira53] HCO3m + NOp_H2O -> OH + CO2 + H2O + NO +[iira54] NOp_H2O + O2m -> H2O + NO + O2 +[iira55] CO4m + NOp_H2O -> O2 + NO + CO2 + H2O +[iira56] NO3m_H2O + NOp_H2O -> 2*H2O + NO + NO3 +[iira57] CO3m2H2O + NOp_H2O -> CO2 + 3*H2O + NO + O +[iira58] CLm + NOp_H2O -> CL + H2O + NO +[iira59] CO3m_H2O + NOp_H2O -> O + CO2 + 2*H2O + NO +[iira6] Hp_4H2O + O2m -> O2 + H + 4*H2O +[iira60] NO2m_H2O + NOp_H2O -> NO + 2*H2O + NO2 +[iira61] NO3m_HCL + NOp_H2O -> H2O + NO + NO3 + HCL +[iira62] CLm_H2O + NOp_H2O -> CL + 2*H2O + NO +[iira63] NO3m2H2O + NOp_H2O -> NO + NO3 + 3*H2O +[iira64] NO2m + NOp_H2O -> NO + H2O + NO2 +[iira65] NO3mHNO3 + NOp_2H2O -> 2*H2O + NO3 + HNO3 + NO +[iira66] CO3m + NOp_2H2O -> 2*H2O + NO + CO2 + O +[iira67] CLm_HCL + NOp_2H2O -> NO + CL + 2*H2O + HCL +[iira68] NOp_2H2O + NO3m -> NO + 2*H2O + NO3 +[iira69] HCO3m + NOp_2H2O -> 2*H2O + OH + NO + CO2 +[iira7] CO4m + Hp_4H2O -> 4*H2O + H + CO2 + O2 +[iira70] NOp_2H2O + O2m -> 2*H2O + NO + O2 +[iira71] NOp_2H2O + CO4m -> O2 + 2*H2O + NO + CO2 +[iira72] NO3m_H2O + NOp_2H2O -> 3*H2O + NO3 + NO +[iira73] CO3m2H2O + NOp_2H2O -> O + CO2 + 4*H2O + NO +[iira74] CLm + NOp_2H2O -> 2*H2O + NO + CL +[iira75] CO3m_H2O + NOp_2H2O -> 3*H2O + CO2 + NO + O +[iira76] NOp_2H2O + NO2m_H2O -> 3*H2O + NO + NO2 +[iira77] NO3m_HCL + NOp_2H2O -> NO + HCL + 2*H2O + NO3 +[iira78] NOp_2H2O + CLm_H2O -> NO + 3*H2O + CL +[iira79] NOp_2H2O + NO3m2H2O -> NO + NO3 + 4*H2O +[iira8] Hp_4H2O + NO3m_H2O -> H + 5*H2O + NO3 +[iira80] NOp_2H2O + NO2m -> 2*H2O + NO2 + NO +[iira81] NOp + NO3mHNO3 -> NO + HNO3 + NO3 +[iira82] NOp + CO3m -> CO2 + NO + O +[iira83] NOp + CLm_HCL -> CL + HCL + NO +[iira84] NO3m + NOp -> NO3 + NO +[iira85] NOp + HCO3m -> NO + CO2 + OH +[iira86] O2m + NOp -> NO + O2 +[iira87] NOp + CO4m -> CO2 + NO + O2 +[iira88] NOp + NO3m_H2O -> H2O + NO + NO3 +[iira89] NOp + CO3m2H2O -> NO + O + CO2 + 2*H2O +[iira9] CO3m2H2O + Hp_4H2O -> CO2 + 6*H2O + O + H +[iira90] CLm + NOp -> CL + NO +[iira91] CO3m_H2O + NOp -> H2O + NO + O + CO2 +[iira92] NO2m_H2O + NOp -> NO + NO2 + H2O +[iira93] NO3m_HCL + NOp -> NO + HCL + NO3 +[iira94] CLm_H2O + NOp -> CL + NO + H2O +[iira95] NOp + NO3m2H2O -> 2*H2O + NO + NO3 +[iira96] NOp + NO2m -> NO2 + NO +[iira97] NO3mHNO3 + O2p -> O2 + NO3 + HNO3 +[iira98] O2p + CO3m -> O + O2 + CO2 +[iira99] O2p + CLm_HCL -> O2 + HCL + CL +[iirb1] Hp_4H2O + CO3m + M -> 4*H2O + O + CO2 + H + M +[iirb10] Hp_5H2O + M + CO3m2H2O -> H + 7*H2O + M + CO2 + O +[iirb11] M + CO3m_H2O + Hp_4H2O -> 5*H2O + M + H + CO2 + O +[iirb12] Hp_5H2O + M + CO3m_H2O -> CO2 + M + O + H + 6*H2O +[iirb13] NO3m_H2O + Hp_4H2O + M -> M + NO3 + H + 5*H2O +[iirb14] NO3m_H2O + Hp_5H2O + M -> M + NO3 + H + 6*H2O +[iirb2] NO3m + M + Hp_4H2O -> 4*H2O + HNO3 + M +[iirb3] Hp_5H2O + M + CO3m -> 5*H2O + M + CO2 + O + H +[iirb4] Hp_5H2O + NO3m + M -> M + HNO3 + 5*H2O +[iirb5] M + CLm_HCL + Hp_4H2O -> M + 2*HCL + 4*H2O +[iirb6] M + Hp_5H2O + CLm_HCL -> M + 5*H2O + 2*HCL +[iirb7] NO3mHNO3 + M + Hp_4H2O -> 4*H2O + M + 2*HNO3 +[iirb8] Hp_5H2O + M + NO3mHNO3 -> M + 5*H2O + 2*HNO3 +[iirb9] M + CO3m2H2O + Hp_4H2O -> CO2 + 6*H2O + H + M + O +[nir1] NO + O3m -> O + NO3m +[nir10] NO2m_H2O + M -> H2O + NO2m + M +[nir11] NO3m2H2O + M -> M + NO3m_H2O + H2O +[nir12] NO3mHNO3 + M -> NO3m + HNO3 + M +[nir13] HCL + M + NO3m -> NO3m_HCL + M +[nir2] NO2 + O3m -> NO3m + O2 +[nir3] NO2 + O3m -> NO2m + O3 +[nir4] NO + O3m -> NO2m + O2 +[nir5] CO3m + NO -> CO2 + NO2m +[nir6] CO3m + NO2 -> NO3m + CO2 +[nir7] M + NO3m_H2O -> M + H2O + NO3m +[nir8] CO3m_H2O + M -> CO3m + M + H2O +[nir9] CO3m2H2O + M -> CO3m_H2O + H2O + M +[NO2m_CL] CL + NO2m -> CLm + NO2 ; 1e-10 +[NO2m_CLO] CLO + NO2m -> CLm + NO3 ; 1e-10 +[NO2m_H] H + NO2m -> NO + OHm ; 3e-10 +[NO2m_H2O_M] NO2m + H2O + M -> M + NO2m_H2O ; 1.6e-28 +[NO2m_HCL] HCL + NO2m -> CLm + HONO ; 1.4e-09 +[NO2m_HNO3] HNO3 + NO2m -> NO3m + HONO ; 1.6e-09 +[NO2m_NO2] NO2 + NO2m -> NO + NO3m ; 2e-13 +[NO2m_O3] NO2m + O3 -> NO3m + O2 ; 1.2e-10 +[NO3m2H2O_N2O5] NO3m2H2O + N2O5 -> H2O + HNO3 + NO3mHNO3 ; 7e-10 +[NO3mH2O_H2O_M] NO3m_H2O + H2O + M -> M + NO3m2H2O ; 1.6e-28 +[NO3mH2O_HNO3] HNO3 + NO3m_H2O -> H2O + NO3mHNO3 ; 1.6e-09 +[NO3m_H2O_M] H2O + M + NO3m -> M + NO3m_H2O ; 1.6e-28 +[NO3mH2O_N2O5] NO3m_H2O + N2O5 -> HNO3 + NO3mHNO3 ; 7e-10 +[NO3m_HCLa] HCL + NO3m -> CLm + HNO3 ; 1e-12 +[NO3mHCL_HNO3] HNO3 + NO3m_HCL -> HCL + NO3mHNO3 ; 7.6e-10 +[NO3m_HNO3_M] NO3m + HNO3 + M -> M + NO3mHNO3 ; 1.45e-26 +[NO3m_O] NO3m + O -> NO2m + O2 ; 5e-12 +[NO3m_O3] O3 + NO3m -> NO2m + 2*O2 ; 1e-13 +[NOp2H2O_e] NOp_2H2O + e -> 2*H2O + NO ; 2e-06 +[NOp3H2O_e] NOp_3H2O + e -> 3*H2O + NO ; 2e-06 +[NOp3H2O_H2O] H2O + NOp_3H2O -> HONO + Hp_3H2O ; 7e-11 +[NOpCO2_e] NOp_CO2 + e -> CO2 + NO ; 1.5e-06 +[NOpCO2_H2O] NOp_CO2 + H2O -> CO2 + NOp_H2O ; 1e-09 +[NOpH2O_e] NOp_H2O + e -> H2O + NO ; 1.5e-06 +[NOpH2O_H] H + NOp_H2O -> NO + Hp_H2O ; 7e-12 +[NOpH2O_HO2] NOp_H2O + HO2 -> Hp_H2O + NO3 ; 5e-10 +[NOpH2O_OH] NOp_H2O + OH -> Hp_H2O + NO2 ; 1e-10 +[NOpN2_CO2] CO2 + NOp_N2 -> N2 + NOp_CO2 ; 1e-09 +[NOpN2_H2O] NOp_N2 + H2O -> N2 + NOp_H2O ; 1e-09 +[O2m_CL] O2m + CL -> CLm + O2 ; 1e-10 +[O2m_CLO] CLO + O2m -> CLOm + O2 ; 1e-10 +[O2m_CO2_M] CO2 + M + O2m -> CO4m + M ; 9.9e-30 +[O2m_H] H + O2m -> HO2 + e ; 1.4e-09 +[O2m_HCL] O2m + HCL -> CLm + HO2 ; 1.6e-09 +[O2m_HNO3] O2m + HNO3 -> HO2 + NO3m ; 2.9e-09 +[O2m_NO2] NO2 + O2m -> NO2m + O2 ; 7e-10 +[O2m_O21D] O2_1D + O2m -> 2*O2 + e ; 2e-10 +[O2m_O2_M] O2 + M + O2m -> M + O4m ; 3.4e-31 +[O2m_O3] O3 + O2m -> O2 + O3m ; 7.8e-10 +[O2m_O_a] O + O2m -> O3 + e ; 1.5e-10 +[O2m_O_b] O2m + O -> O2 + Om ; 1.5e-10 +[O2pH2O_e] O2p_H2O + e -> H2O + O2 ; 2e-06 +[O2pH2O_H2Oa] O2p_H2O + H2O -> H3Op_OH + O2 ; 9e-10 +[O2pH2O_H2Ob] O2p_H2O + H2O -> Hp_H2O + O2 + OH ; 2.4e-10 +[O2p_H2O_M] M + H2O + O2p -> M + O2p_H2O ; 2.8e-28 +[O3m_CO2] O3m + CO2 -> CO3m + O2 ; 5.5e-10 +[O3m_H] O3m + H -> O2 + OHm ; 8.4e-10 +[O3m_O3] O3 + O3m -> 3*O2 + e ; 1e-10 +[O3m_O_a] O3m + O -> 2*O2 + e ; 1e-10 +[O3m_O_b] O + O3m -> O2 + O2m ; 2.5e-10 +[O4m_CO2] CO2 + O4m -> CO4m + O2 ; 4.3e-10 +[O4m_O] O + O4m -> O3m + O2 ; 4e-10 +[O4p_H2O] H2O + O4p -> O2 + O2p_H2O ; 1.7e-09 +[O4p_O] O4p + O -> O2p + O3 ; 3e-10 +[O4p_O21D] O4p + O2_1D -> 2*O2 + O2p ; 1.5e-10 +[OH_HONO] HONO + OH -> H2O + NO2 ; 1.8e-11, 390 +[OHm_CL] CL + OHm -> CLm + OH ; 1e-10 +[OHm_CLO] CLO + OHm -> CLOm + OH ; 1e-10 +[OHm_CO2] CO2 + M + OHm -> M + HCO3m ; 7.6e-28 +[OHm_H] H + OHm -> e + H2O ; 1.4e-09 +[OHm_HCL] OHm + HCL -> CLm + H2O ; 1e-09 +[OHm_NO2] NO2 + OHm -> NO2m + OH ; 1.1e-09 +[OHm_O] OHm + O -> HO2 + e ; 2e-10 +[OHm_O3] OHm + O3 -> O3m + OH ; 9e-10 +[OH_NO_M] OH + NO + M -> HONO + M ; 7e-31, 2.6, 3.6e-11, 0.1, 0.6 +[Om_CL] Om + CL -> CLm + O ; 1e-10 +[Om_CLO] CLO + Om -> CLm + O2 ; 1e-10 +[Om_CO2_M] M + Om + CO2 -> CO3m + M ; 2e-28 +[Om_H2_a] H2 + Om -> H2O + e ; 5.8e-10 +[Om_H2_b] Om + H2 -> H + OHm ; 3.2e-11 +[Om_H2O] Om + H2O -> OHm + OH ; 6e-13 +[Om_HCL] Om + HCL -> CLm + OH ; 2e-09 +[Om_HNO3] Om + HNO3 -> NO3m + OH ; 3.6e-09 +[Om_M] M + Om -> O + M + e ; 5e-13 +[Om_NO2] NO2 + Om -> O + NO2m ; 1e-09 +[Om_O] Om + O -> e + O2 ; 1.9e-10 +[Om_O21D] Om + O2_1D -> O3 + e ; 3e-10 +[Om_O2_M] M + Om + O2 -> M + O3m ; 2.9e-31 +[Om_O3] O3 + Om -> O + O3m ; 8e-10 +[pir1] M + O2p + O2 -> M + O4p +[pir10] H2O + NOp + M -> M + NOp_H2O +[pir11] H2O + M + NOp_H2O -> M + NOp_2H2O +[pir12] H2O + NOp_2H2O + M -> M + NOp_3H2O +[pir13] NOp + CO2 + M -> M + NOp_CO2 +[pir14] NOp_CO2 + M -> M + NOp + CO2 +[pir15] N2 + M + NOp -> NOp_N2 + M +[pir16] NOp_N2 + M -> M + NOp + N2 +[pir2] M + Hp_H2O + H2O -> Hp_2H2O + M +[pir3] Hp_2H2O + M -> H2O + Hp_H2O + M +[pir4] H2O + Hp_2H2O + M -> Hp_3H2O + M +[pir5] Hp_3H2O + M -> M + Hp_2H2O + H2O +[pir6] Hp_3H2O + H2O + M -> M + Hp_4H2O +[pir7] Hp_4H2O + M -> H2O + M + Hp_3H2O +[pir8] Hp_4H2O + M + H2O -> Hp_5H2O + M +[pir9] M + Hp_5H2O -> M + H2O + Hp_4H2O +[rpe1] e + O4p -> 2*O2 +[rpe2] Hp_H2O + e -> H + H2O +[rpe3] Hp_2H2O + e -> 2*H2O + H +[rpe4] Hp_3H2O + e -> H + 3*H2O +[rpe5] e + NOp_N2 -> N2 + NO +[usr_CLm_H2O_M] CLm_H2O + M -> H2O + M + CLm +[usr_CLm_HCL_M] M + CLm_HCL -> CLm + HCL + M ********************************* *** odd-oxygen ********************************* -[ag1] O2_1D -> O2 ; 0.000258 -[ag2] O2_1S -> O2 ; 0.085 -[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_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 2.64e-11, 55 -[O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 6.6e-12, 55 -[O1D_O3] O1D + O3 -> O2 + O2 ; 1.2e-10 -[O2_1D_N2,cph=94.3] O2_1D + N2 -> O2 + N2 ; 1e-20 -[O2_1D_O,cph=94.3] O2_1D + O -> O2 + O ; 1.3e-16 -[O2_1D_O2,cph=94.3] O2_1D + O2 -> 2*O2 ; 3.6e-18, -220 -[O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13 -[O2_1S_N2,cph=62.6] O2_1S + N2 -> O2_1D + N2 ; 1.8e-15, 45 -[O2_1S_O,cph=62.6] O2_1S + O -> O2_1D + O ; 8e-14 -[O2_1S_O2,cph=62.6] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17 -[O2_1S_O3,cph=62.6] O2_1S + O3 -> O2_1D + O3 ; 3.5e-11, -135 -[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 +[ag1] O2_1D -> O2 ; 0.000258 +[ag2] O2_1S -> O2 ; 0.085 +[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_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 2.64e-11, 55 +[O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 6.6e-12, 55 +[O1D_O3] O1D + O3 -> O2 + O2 ; 1.2e-10 +[O2_1D_N2,cph=94.3] O2_1D + N2 -> O2 + N2 ; 1e-20 +[O2_1D_O,cph=94.3] O2_1D + O -> O2 + O ; 1.3e-16 +[O2_1D_O2,cph=94.3] O2_1D + O2 -> 2*O2 ; 3.6e-18, -220 +[O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13 +[O2_1S_N2,cph=62.6] O2_1S + N2 -> O2_1D + N2 ; 1.8e-15, 45 +[O2_1S_O,cph=62.6] O2_1S + O -> O2_1D + O ; 8e-14 +[O2_1S_O2,cph=62.6] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17 +[O2_1S_O3,cph=62.6] O2_1S + O3 -> O2_1D + O3 ; 3.5e-11, -135 +[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 ; 4.4e-32, 1.3, 7.5e-11, -0.2, 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 +[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 ; 4.4e-32, 1.3, 7.5e-11, -0.2, 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 ; 1.3e-12, 380 -[N2D_O,cph=229.61] N2D + O -> N + O ; 7e-13 -[N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5e-12 -[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 ; 1.5e-11, -3600 -[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.5e-11, 170 -[NO3_O] NO3 + O -> NO2 + O2 ; 1e-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.3e-12, 270 -[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 +[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 +[N2D_O,cph=229.61] N2D + O -> N + O ; 7e-13 +[N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5e-12 +[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 ; 1.5e-11, -3600 +[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.5e-11, 170 +[NO3_O] NO3 + O -> NO2 + O2 ; 1e-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.3e-12, 270 +[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 -> 2*CL + COFCL ; 2.07e-10 -[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 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 +[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 -> 2*CL + COFCL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 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 +[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 ********************************* *** odd-fluorine ********************************* -[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 -[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 -[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 -[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 -[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 -[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 +[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 +[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 +[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 +[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 +[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 +[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 ********************************* *** 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 + COFCL ; 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 + COFCL ; 1.794e-10 -[O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.3e-10 -[O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.65e-11 +[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 + COFCL ; 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 + COFCL ; 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_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750 -[CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 -[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 -[CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.9e-33, 1, 1.1e-12, -1.3, 0.6 -[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_b] CO + OH -> CO2 + H +[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_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750 +[CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 +[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 +[CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.9e-33, 1, 1.1e-12, -1.3, 0.6 +[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_b] CO + OH -> CO2 + H ********************************* *** Tropospheric Aerosol ********************************* -[usr_HO2_aer] HO2 -> 0.5*H2O2 -[usr_N2O5_aer] N2O5 -> 2*HNO3 -[usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 -[usr_NO3_aer] NO3 -> HNO3 +[usr_HO2_aer] HO2 -> 0.5*H2O2 +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 +[usr_NO3_aer] NO3 -> HNO3 ********************************* *** 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 +[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 ********************************* *** Ions ********************************* -[ag247nm,cph=483.39] Op2P -> Op ; 0.047 -[ag373nm,cph=321.3] Op2D -> Op ; 7.7e-05 -[ag732nm,cph=163.06] Op2P -> Op2D ; 0.171 -[elec1,cph=82.389] NOp + e -> 0.2*N + 0.8*N2D + O -[elec2,cph=508.95] O2p + e -> 1.15*O + 0.85*O1D -[elec3,cph=354.83] N2p + e -> 1.1*N + 0.9*N2D -[ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6e-11 -[ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D -[ion_N2p_Ob] N2p + O -> Op + N2 -[ion_Np_O,cph=95.55] Np + O -> Op + N ; 1e-12 -[ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4e-10 -[ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2e-10 -[ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1e-10 -[ion_O2p_N2] O2p + N2 -> NOp + NO ; 5e-16 -[ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 -[ion_Op_CO2] Op + CO2 -> O2p + CO ; 9e-10 -[ion_Op_N2,cph=105.04] Op + N2 -> NOp + N -[ion_Op_N2D,cph=139.9] Op + N2D -> Np + O ; 1.3e-10 -[ion_Op_O2,cph=150.11] Op + O2 -> O2p + O -[Op2D_e,cph=319.37] Op2D + e -> Op + e -[Op2D_N2,cph=128.32] Op2D + N2 -> N2p + O ; 8e-10 -[Op2D_O,cph=319.36] Op2D + O -> Op + O ; 5e-12 -[Op2D_O2,cph=469.4] Op2D + O2 -> O2p + O ; 7e-10 -[Op2P_ea,cph=163.06] Op2P + e -> Op2D + e -[Op2P_eb,cph=482.43] Op2P + e -> Op + e -[Op2P_N2a,cph=291.38] Op2P + N2 -> N2p + O ; 4.8e-10 -[Op2P_N2b,cph=67.54] Op2P + N2 -> Np + NO ; 1e-10 -[Op2P_O,cph=501.72] Op2P + O -> Op + O ; 4e-10 +[ag247nm,cph=483.39] Op2P -> Op ; 0.047 +[ag373nm,cph=321.3] Op2D -> Op ; 7.7e-05 +[ag732nm,cph=163.06] Op2P -> Op2D ; 0.171 +[elec1,cph=82.389] NOp + e -> 0.2*N + 0.8*N2D + O +[elec2,cph=508.95] O2p + e -> 1.15*O + 0.85*O1D +[elec3,cph=354.83] N2p + e -> 1.1*N + 0.9*N2D +[ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6e-11 +[ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D +[ion_N2p_Ob] N2p + O -> Op + N2 +[ion_Np_O,cph=95.55] Np + O -> Op + N ; 1e-12 +[ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4e-10 +[ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2e-10 +[ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1e-10 +[ion_O2p_N2] O2p + N2 -> NOp + NO ; 5e-16 +[ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 +[ion_Op_CO2] Op + CO2 -> O2p + CO ; 9e-10 +[ion_Op_N2,cph=105.04] Op + N2 -> NOp + N +[ion_Op_N2D,cph=139.9] Op + N2D -> Np + O ; 1.3e-10 +[ion_Op_O2,cph=150.11] Op + O2 -> O2p + O +[Op2D_e,cph=319.37] Op2D + e -> Op + e +[Op2D_N2,cph=128.32] Op2D + N2 -> N2p + O ; 8e-10 +[Op2D_O,cph=319.36] Op2D + O -> Op + O ; 5e-12 +[Op2D_O2,cph=469.4] Op2D + O2 -> O2p + O ; 7e-10 +[Op2P_ea,cph=163.06] Op2P + e -> Op2D + e +[Op2P_eb,cph=482.43] Op2P + e -> Op + e +[Op2P_N2a,cph=291.38] Op2P + N2 -> N2p + O ; 4.8e-10 +[Op2P_N2b,cph=67.54] Op2P + N2 -> Np + NO ; 1e-10 +[Op2P_O,cph=501.72] Op2P + O -> Op + O ; 4e-10 End Reactions Ext Forcing - NO2 <- dataset - NO <- dataset - CO <- dataset - N2p - Np - O - O2p - OH - Op - e - N - N2D + NO2 <- dataset + NO <- dataset + CO <- dataset + N2p + Np + O + O2p + OH + Op + e + N + N2D End Ext Forcing End Chemistry @@ -973,13 +972,11 @@ SIMULATION PARAMETERS Version Options - machine = nec + machine = intel model = cam - model_architecture = VECTOR - vector_length = 32 + model_architecture = SCALAR architecture = hybrid namemod = on End Version Options - End Simulation Parameters diff --git a/src/chemistry/pp_waccm_mad/chem_mods.F90 b/src/chemistry/pp_waccm_mad/chem_mods.F90 index 91bf1a1880..c524ffab6b 100644 --- a/src/chemistry/pp_waccm_mad/chem_mods.F90 +++ b/src/chemistry/pp_waccm_mad/chem_mods.F90 @@ -13,19 +13,19 @@ module chem_mods nfs = 2, & ! number of "fixed" species relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members - nzcnt = 1825, & ! number of non-zero matrix entries + nzcnt = 1745, & ! number of non-zero matrix entries extcnt = 12, & ! number of species with external forcing - clscnt1 = 22, & ! number of species in explicit class + clscnt1 = 23, & ! number of species in explicit class clscnt2 = 0, & ! number of species in hov class clscnt3 = 0, & ! number of species in ebi class - clscnt4 = 88, & ! number of species in implicit class + clscnt4 = 87, & ! 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 = 585, & enthalpy_cnt = 54, & - nslvd = 51 + nslvd = 50 integer :: clscnt(5) = 0 integer :: cls_rxt_cnt(4,5) = 0 integer :: clsmap(gas_pcnst,5) = 0 @@ -47,5 +47,4 @@ module chem_mods 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_waccm_mad/m_spc_id.F90 b/src/chemistry/pp_waccm_mad/m_spc_id.F90 index 73b47653e2..721c4c7090 100644 --- a/src/chemistry/pp_waccm_mad/m_spc_id.F90 +++ b/src/chemistry/pp_waccm_mad/m_spc_id.F90 @@ -1,76 +1,76 @@ module m_spc_id implicit none - integer, parameter :: id_BRCL = 1 - integer, parameter :: id_BRO = 2 - integer, parameter :: id_BRONO2 = 3 - integer, parameter :: id_BRY = 4 - integer, parameter :: id_CCL4 = 5 - integer, parameter :: id_CF2CLBR = 6 - integer, parameter :: id_CF3BR = 7 - integer, parameter :: id_CFC11 = 8 - integer, parameter :: id_CFC113 = 9 - integer, parameter :: id_CFC114 = 10 - integer, parameter :: id_CFC115 = 11 - integer, parameter :: id_CFC12 = 12 - integer, parameter :: id_CH2BR2 = 13 - integer, parameter :: id_CH2O = 14 - integer, parameter :: id_CH3BR = 15 - integer, parameter :: id_CH3CCL3 = 16 - integer, parameter :: id_CH3CL = 17 - integer, parameter :: id_CH3O2 = 18 - integer, parameter :: id_CH3OOH = 19 - integer, parameter :: id_CH4 = 20 - integer, parameter :: id_CHBR3 = 21 - integer, parameter :: id_CL2 = 22 - integer, parameter :: id_CL2O2 = 23 - integer, parameter :: id_CLO = 24 - integer, parameter :: id_CLONO2 = 25 - integer, parameter :: id_CLY = 26 - integer, parameter :: id_CO = 27 - integer, parameter :: id_CO2 = 28 - integer, parameter :: id_COF2 = 29 - integer, parameter :: id_COFCL = 30 - integer, parameter :: id_F = 31 - integer, parameter :: id_H = 32 - integer, parameter :: id_H2 = 33 - integer, parameter :: id_H2402 = 34 - integer, parameter :: id_H2O2 = 35 - integer, parameter :: id_HBR = 36 - integer, parameter :: id_HCFC141B = 37 - integer, parameter :: id_HCFC142B = 38 - integer, parameter :: id_HCFC22 = 39 - integer, parameter :: id_HCL = 40 - integer, parameter :: id_HF = 41 - integer, parameter :: id_HNO3 = 42 - integer, parameter :: id_HO2 = 43 - integer, parameter :: id_HO2NO2 = 44 - integer, parameter :: id_HOBR = 45 - integer, parameter :: id_HOCL = 46 - integer, parameter :: id_HONO = 47 - integer, parameter :: id_N = 48 - integer, parameter :: id_N2O = 49 - integer, parameter :: id_N2O5 = 50 - integer, parameter :: id_NO = 51 - integer, parameter :: id_NO2 = 52 - integer, parameter :: id_NO3 = 53 - integer, parameter :: id_O = 54 - integer, parameter :: id_O2 = 55 - integer, parameter :: id_O3 = 56 - integer, parameter :: id_OCLO = 57 - integer, parameter :: id_SF6 = 58 - integer, parameter :: id_BR = 59 - integer, parameter :: id_CL = 60 - integer, parameter :: id_CLm = 61 - integer, parameter :: id_CLm_H2O = 62 - integer, parameter :: id_CLm_HCL = 63 - integer, parameter :: id_CLOm = 64 - integer, parameter :: id_CO3m = 65 - integer, parameter :: id_CO3m2H2O = 66 - integer, parameter :: id_CO3m_H2O = 67 - integer, parameter :: id_CO4m = 68 - integer, parameter :: id_e = 69 - integer, parameter :: id_H3Op_OH = 70 - integer, parameter :: id_HCO3m = 71 + integer, parameter :: id_BR = 1 + integer, parameter :: id_BRCL = 2 + integer, parameter :: id_BRO = 3 + integer, parameter :: id_BRONO2 = 4 + integer, parameter :: id_BRY = 5 + integer, parameter :: id_CCL4 = 6 + integer, parameter :: id_CF2CLBR = 7 + integer, parameter :: id_CF3BR = 8 + integer, parameter :: id_CFC11 = 9 + integer, parameter :: id_CFC113 = 10 + integer, parameter :: id_CFC114 = 11 + integer, parameter :: id_CFC115 = 12 + integer, parameter :: id_CFC12 = 13 + integer, parameter :: id_CH2BR2 = 14 + integer, parameter :: id_CH2O = 15 + integer, parameter :: id_CH3BR = 16 + integer, parameter :: id_CH3CCL3 = 17 + integer, parameter :: id_CH3CL = 18 + integer, parameter :: id_CH3O2 = 19 + integer, parameter :: id_CH3OOH = 20 + integer, parameter :: id_CH4 = 21 + integer, parameter :: id_CHBR3 = 22 + integer, parameter :: id_CL = 23 + integer, parameter :: id_CL2 = 24 + integer, parameter :: id_CL2O2 = 25 + integer, parameter :: id_CLO = 26 + integer, parameter :: id_CLONO2 = 27 + integer, parameter :: id_CLY = 28 + integer, parameter :: id_CO = 29 + integer, parameter :: id_CO2 = 30 + integer, parameter :: id_COF2 = 31 + integer, parameter :: id_COFCL = 32 + integer, parameter :: id_F = 33 + integer, parameter :: id_H = 34 + integer, parameter :: id_H2 = 35 + integer, parameter :: id_H2402 = 36 + integer, parameter :: id_H2O2 = 37 + integer, parameter :: id_HBR = 38 + integer, parameter :: id_HCFC141B = 39 + integer, parameter :: id_HCFC142B = 40 + integer, parameter :: id_HCFC22 = 41 + integer, parameter :: id_HCL = 42 + integer, parameter :: id_HF = 43 + integer, parameter :: id_HNO3 = 44 + integer, parameter :: id_HO2NO2 = 45 + integer, parameter :: id_HOBR = 46 + integer, parameter :: id_HOCL = 47 + integer, parameter :: id_HONO = 48 + integer, parameter :: id_N = 49 + integer, parameter :: id_N2O = 50 + integer, parameter :: id_N2O5 = 51 + integer, parameter :: id_NO = 52 + integer, parameter :: id_NO2 = 53 + integer, parameter :: id_NO3 = 54 + integer, parameter :: id_O = 55 + integer, parameter :: id_O2 = 56 + integer, parameter :: id_O3 = 57 + integer, parameter :: id_OCLO = 58 + integer, parameter :: id_SF6 = 59 + integer, parameter :: id_CLm = 60 + integer, parameter :: id_CLm_H2O = 61 + integer, parameter :: id_CLm_HCL = 62 + integer, parameter :: id_CLOm = 63 + integer, parameter :: id_CO3m = 64 + integer, parameter :: id_CO3m2H2O = 65 + integer, parameter :: id_CO3m_H2O = 66 + integer, parameter :: id_CO4m = 67 + integer, parameter :: id_e = 68 + integer, parameter :: id_H3Op_OH = 69 + integer, parameter :: id_HCO3m = 70 + integer, parameter :: id_HO2 = 71 integer, parameter :: id_Hp_2H2O = 72 integer, parameter :: id_Hp_3H2O = 73 integer, parameter :: id_Hp_3N1 = 74 diff --git a/src/chemistry/pp_waccm_mad/mo_adjrxt.F90 b/src/chemistry/pp_waccm_mad/mo_adjrxt.F90 index 0c441e36df..a4f71579e8 100644 --- a/src/chemistry/pp_waccm_mad/mo_adjrxt.F90 +++ b/src/chemistry/pp_waccm_mad/mo_adjrxt.F90 @@ -13,527 +13,527 @@ subroutine adjrxt( rate, inv, m, 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(:,:,102) = rate(:,:,102) * inv(:,:, 1) - rate(:,:,103) = rate(:,:,103) * inv(:,:, 1) - rate(:,:,113) = rate(:,:,113) * inv(:,:, 1) - rate(:,:,114) = rate(:,:,114) * inv(:,:, 1) - rate(:,:,128) = rate(:,:,128) * inv(:,:, 2) - rate(:,:,130) = rate(:,:,130) * inv(:,:, 1) - rate(:,:,132) = rate(:,:,132) * inv(:,:, 2) - rate(:,:,253) = rate(:,:,253) * inv(:,:, 1) - rate(:,:,254) = rate(:,:,254) * inv(:,:, 1) - rate(:,:,255) = rate(:,:,255) * inv(:,:, 1) - rate(:,:,256) = rate(:,:,256) * inv(:,:, 1) - rate(:,:,257) = rate(:,:,257) * inv(:,:, 1) - rate(:,:,258) = rate(:,:,258) * inv(:,:, 1) - rate(:,:,259) = rate(:,:,259) * inv(:,:, 1) - rate(:,:,260) = rate(:,:,260) * inv(:,:, 1) - rate(:,:,261) = rate(:,:,261) * inv(:,:, 1) - rate(:,:,262) = rate(:,:,262) * inv(:,:, 1) - rate(:,:,263) = rate(:,:,263) * inv(:,:, 1) - rate(:,:,264) = rate(:,:,264) * inv(:,:, 1) - rate(:,:,265) = rate(:,:,265) * inv(:,:, 1) - rate(:,:,266) = rate(:,:,266) * inv(:,:, 1) - rate(:,:,268) = rate(:,:,268) * inv(:,:, 1) - rate(:,:,269) = rate(:,:,269) * inv(:,:, 1) - rate(:,:,270) = rate(:,:,270) * inv(:,:, 1) - rate(:,:,271) = rate(:,:,271) * inv(:,:, 1) - rate(:,:,277) = rate(:,:,277) * inv(:,:, 1) - rate(:,:,278) = rate(:,:,278) * inv(:,:, 1) - rate(:,:,279) = rate(:,:,279) * inv(:,:, 1) - rate(:,:,283) = rate(:,:,283) * inv(:,:, 1) - rate(:,:,289) = rate(:,:,289) * inv(:,:, 1) - rate(:,:,291) = rate(:,:,291) * inv(:,:, 1) - rate(:,:,295) = rate(:,:,295) * inv(:,:, 1) - rate(:,:,311) = rate(:,:,311) * inv(:,:, 1) - rate(:,:,317) = rate(:,:,317) * inv(:,:, 1) - rate(:,:,324) = rate(:,:,324) * inv(:,:, 1) - rate(:,:,338) = rate(:,:,338) * inv(:,:, 1) - rate(:,:,344) = rate(:,:,344) * inv(:,:, 1) - rate(:,:,347) = rate(:,:,347) * inv(:,:, 1) - rate(:,:,353) = rate(:,:,353) * inv(:,:, 1) - rate(:,:,357) = rate(:,:,357) * inv(:,:, 1) - rate(:,:,359) = rate(:,:,359) * inv(:,:, 1) - rate(:,:,360) = rate(:,:,360) * inv(:,:, 1) - rate(:,:,361) = rate(:,:,361) * inv(:,:, 1) - rate(:,:,362) = rate(:,:,362) * inv(:,:, 1) - rate(:,:,363) = rate(:,:,363) * inv(:,:, 1) - rate(:,:,364) = rate(:,:,364) * inv(:,:, 1) - rate(:,:,366) = rate(:,:,366) * inv(:,:, 1) - rate(:,:,367) = rate(:,:,367) * inv(:,:, 1) - rate(:,:,368) = rate(:,:,368) * inv(:,:, 1) - rate(:,:,369) = rate(:,:,369) * inv(:,:, 1) - rate(:,:,370) = rate(:,:,370) * inv(:,:, 1) - rate(:,:,371) = rate(:,:,371) * inv(:,:, 1) - rate(:,:,372) = rate(:,:,372) * inv(:,:, 1) - rate(:,:,373) = rate(:,:,373) * inv(:,:, 1) - rate(:,:,374) = rate(:,:,374) * inv(:,:, 1) - rate(:,:,380) = rate(:,:,380) * inv(:,:, 1) - rate(:,:,381) = rate(:,:,381) * inv(:,:, 1) - rate(:,:,386) = rate(:,:,386) * inv(:,:, 2) - rate(:,:,390) = rate(:,:,390) * inv(:,:, 2) - rate(:,:,394) = rate(:,:,394) * inv(:,:, 2) - rate(:,:,399) = rate(:,:,399) * inv(:,:, 1) - rate(:,:,400) = rate(:,:,400) * inv(:,:, 1) - rate(:,:,406) = rate(:,:,406) * inv(:,:, 1) - rate(:,:,416) = rate(:,:,416) * inv(:,:, 1) - rate(:,:,428) = rate(:,:,428) * inv(:,:, 1) - rate(:,:,436) = rate(:,:,436) * inv(:,:, 1) - rate(:,:,439) = rate(:,:,439) * inv(:,:, 1) - rate(:,:,440) = rate(:,:,440) * inv(:,:, 1) - rate(:,:,441) = rate(:,:,441) * inv(:,:, 1) - rate(:,:,443) = rate(:,:,443) * inv(:,:, 1) - rate(:,:,444) = rate(:,:,444) * inv(:,:, 1) - rate(:,:,459) = rate(:,:,459) * inv(:,:, 1) - rate(:,:,479) = rate(:,:,479) * inv(:,:, 1) - rate(:,:,480) = rate(:,:,480) * inv(:,:, 1) - rate(:,:,490) = rate(:,:,490) * inv(:,:, 1) - rate(:,:,532) = rate(:,:,532) * inv(:,:, 1) - rate(:,:,571) = rate(:,:,571) * inv(:,:, 2) - rate(:,:,574) = rate(:,:,574) * inv(:,:, 2) - rate(:,:,578) = rate(:,:,578) * inv(:,:, 2) - rate(:,:,583) = rate(:,:,583) * inv(:,:, 2) - rate(:,:,584) = rate(:,:,584) * inv(:,:, 2) - rate(:,:,365) = rate(:,:,365) * inv(:,:, 2) * inv(:,:, 1) - rate(:,:,100) = rate(:,:,100) * 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(:,:,117) = rate(:,:,117) * 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(:,:,133) = rate(:,:,133) * m(:,:) - rate(:,:,134) = rate(:,:,134) * m(:,:) - rate(:,:,135) = rate(:,:,135) * m(:,:) - rate(:,:,136) = rate(:,:,136) * 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(:,:,172) = rate(:,:,172) * 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(:,:,245) = rate(:,:,245) * m(:,:) - rate(:,:,246) = rate(:,:,246) * 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(:,:,252) = rate(:,:,252) * 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(:,:,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(:,:,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(:,:,292) = rate(:,:,292) * 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(:,:,322) = rate(:,:,322) * 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(:,:,329) = rate(:,:,329) * 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(:,:,336) = rate(:,:,336) * m(:,:) - rate(:,:,337) = rate(:,:,337) * m(:,:) - rate(:,:,338) = rate(:,:,338) * m(:,:) - rate(:,:,339) = rate(:,:,339) * m(:,:) - rate(:,:,340) = rate(:,:,340) * m(:,:) - rate(:,:,341) = rate(:,:,341) * m(:,:) - rate(:,:,342) = rate(:,:,342) * m(:,:) - rate(:,:,343) = rate(:,:,343) * m(:,:) - rate(:,:,344) = rate(:,:,344) * m(:,:) - rate(:,:,345) = rate(:,:,345) * m(:,:) - rate(:,:,346) = rate(:,:,346) * m(:,:) - rate(:,:,347) = rate(:,:,347) * m(:,:) - rate(:,:,348) = rate(:,:,348) * m(:,:) - rate(:,:,349) = rate(:,:,349) * m(:,:) - rate(:,:,350) = rate(:,:,350) * m(:,:) - rate(:,:,351) = rate(:,:,351) * m(:,:) - rate(:,:,352) = rate(:,:,352) * m(:,:) - rate(:,:,354) = rate(:,:,354) * m(:,:) - rate(:,:,355) = rate(:,:,355) * m(:,:) - rate(:,:,356) = rate(:,:,356) * m(:,:) - rate(:,:,357) = rate(:,:,357) * m(:,:) - rate(:,:,358) = rate(:,:,358) * m(:,:) - rate(:,:,359) = rate(:,:,359) * m(:,:) - rate(:,:,360) = rate(:,:,360) * m(:,:) - rate(:,:,361) = rate(:,:,361) * m(:,:) - rate(:,:,362) = rate(:,:,362) * m(:,:) - rate(:,:,363) = rate(:,:,363) * m(:,:) - rate(:,:,367) = rate(:,:,367) * m(:,:) - rate(:,:,369) = rate(:,:,369) * m(:,:) - rate(:,:,371) = rate(:,:,371) * m(:,:) - rate(:,:,373) = rate(:,:,373) * m(:,:) - rate(:,:,375) = rate(:,:,375) * m(:,:) - rate(:,:,376) = rate(:,:,376) * m(:,:) - rate(:,:,377) = rate(:,:,377) * m(:,:) - rate(:,:,378) = rate(:,:,378) * m(:,:) - rate(:,:,379) = rate(:,:,379) * m(:,:) - rate(:,:,384) = rate(:,:,384) * m(:,:) - rate(:,:,385) = rate(:,:,385) * m(:,:) - rate(:,:,387) = rate(:,:,387) * m(:,:) - rate(:,:,388) = rate(:,:,388) * m(:,:) - rate(:,:,389) = rate(:,:,389) * m(:,:) - rate(:,:,391) = rate(:,:,391) * m(:,:) - rate(:,:,392) = rate(:,:,392) * m(:,:) - rate(:,:,393) = rate(:,:,393) * m(:,:) - rate(:,:,395) = rate(:,:,395) * m(:,:) - rate(:,:,396) = rate(:,:,396) * m(:,:) - rate(:,:,397) = rate(:,:,397) * m(:,:) - rate(:,:,398) = rate(:,:,398) * m(:,:) - rate(:,:,399) = rate(:,:,399) * m(:,:) - rate(:,:,400) = rate(:,:,400) * m(:,:) - rate(:,:,401) = rate(:,:,401) * m(:,:) - rate(:,:,402) = rate(:,:,402) * m(:,:) - rate(:,:,403) = rate(:,:,403) * m(:,:) - rate(:,:,404) = rate(:,:,404) * m(:,:) - rate(:,:,405) = rate(:,:,405) * m(:,:) - rate(:,:,406) = rate(:,:,406) * m(:,:) - rate(:,:,407) = rate(:,:,407) * m(:,:) - rate(:,:,408) = rate(:,:,408) * m(:,:) - rate(:,:,409) = rate(:,:,409) * m(:,:) - rate(:,:,410) = rate(:,:,410) * m(:,:) - rate(:,:,411) = rate(:,:,411) * m(:,:) - rate(:,:,412) = rate(:,:,412) * m(:,:) - rate(:,:,413) = rate(:,:,413) * m(:,:) - rate(:,:,414) = rate(:,:,414) * m(:,:) - rate(:,:,415) = rate(:,:,415) * m(:,:) - rate(:,:,416) = rate(:,:,416) * m(:,:) - rate(:,:,417) = rate(:,:,417) * m(:,:) - rate(:,:,418) = rate(:,:,418) * m(:,:) - rate(:,:,419) = rate(:,:,419) * m(:,:) - rate(:,:,420) = rate(:,:,420) * m(:,:) - rate(:,:,421) = rate(:,:,421) * m(:,:) - rate(:,:,422) = rate(:,:,422) * m(:,:) - rate(:,:,423) = rate(:,:,423) * m(:,:) - rate(:,:,424) = rate(:,:,424) * m(:,:) - rate(:,:,425) = rate(:,:,425) * m(:,:) - rate(:,:,426) = rate(:,:,426) * m(:,:) - rate(:,:,427) = rate(:,:,427) * m(:,:) - rate(:,:,428) = rate(:,:,428) * m(:,:) - rate(:,:,429) = rate(:,:,429) * m(:,:) - rate(:,:,430) = rate(:,:,430) * m(:,:) - rate(:,:,431) = rate(:,:,431) * m(:,:) - rate(:,:,432) = rate(:,:,432) * m(:,:) - rate(:,:,433) = rate(:,:,433) * m(:,:) - rate(:,:,434) = rate(:,:,434) * m(:,:) - rate(:,:,435) = rate(:,:,435) * m(:,:) - rate(:,:,436) = rate(:,:,436) * m(:,:) - rate(:,:,437) = rate(:,:,437) * m(:,:) - rate(:,:,438) = rate(:,:,438) * m(:,:) - rate(:,:,439) = rate(:,:,439) * m(:,:) - rate(:,:,440) = rate(:,:,440) * m(:,:) - rate(:,:,441) = rate(:,:,441) * m(:,:) - rate(:,:,442) = rate(:,:,442) * m(:,:) - rate(:,:,445) = rate(:,:,445) * m(:,:) - rate(:,:,446) = rate(:,:,446) * m(:,:) - rate(:,:,447) = rate(:,:,447) * m(:,:) - rate(:,:,448) = rate(:,:,448) * m(:,:) - rate(:,:,449) = rate(:,:,449) * m(:,:) - rate(:,:,450) = rate(:,:,450) * m(:,:) - rate(:,:,451) = rate(:,:,451) * m(:,:) - rate(:,:,452) = rate(:,:,452) * m(:,:) - rate(:,:,453) = rate(:,:,453) * m(:,:) - rate(:,:,454) = rate(:,:,454) * m(:,:) - rate(:,:,455) = rate(:,:,455) * m(:,:) - rate(:,:,456) = rate(:,:,456) * m(:,:) - rate(:,:,457) = rate(:,:,457) * m(:,:) - rate(:,:,458) = rate(:,:,458) * m(:,:) - rate(:,:,459) = rate(:,:,459) * m(:,:) - rate(:,:,460) = rate(:,:,460) * m(:,:) - rate(:,:,461) = rate(:,:,461) * m(:,:) - rate(:,:,462) = rate(:,:,462) * m(:,:) - rate(:,:,463) = rate(:,:,463) * m(:,:) - rate(:,:,464) = rate(:,:,464) * m(:,:) - rate(:,:,465) = rate(:,:,465) * m(:,:) - rate(:,:,466) = rate(:,:,466) * m(:,:) - rate(:,:,467) = rate(:,:,467) * m(:,:) - rate(:,:,468) = rate(:,:,468) * m(:,:) - rate(:,:,469) = rate(:,:,469) * m(:,:) - rate(:,:,470) = rate(:,:,470) * m(:,:) - rate(:,:,471) = rate(:,:,471) * m(:,:) - rate(:,:,472) = rate(:,:,472) * m(:,:) - rate(:,:,473) = rate(:,:,473) * m(:,:) - rate(:,:,474) = rate(:,:,474) * m(:,:) - rate(:,:,475) = rate(:,:,475) * m(:,:) - rate(:,:,476) = rate(:,:,476) * m(:,:) - rate(:,:,477) = rate(:,:,477) * m(:,:) - rate(:,:,478) = rate(:,:,478) * m(:,:) - rate(:,:,479) = rate(:,:,479) * m(:,:) - rate(:,:,481) = rate(:,:,481) * m(:,:) - rate(:,:,482) = rate(:,:,482) * m(:,:) - rate(:,:,483) = rate(:,:,483) * m(:,:) - rate(:,:,484) = rate(:,:,484) * m(:,:) - rate(:,:,485) = rate(:,:,485) * m(:,:) - rate(:,:,486) = rate(:,:,486) * m(:,:) - rate(:,:,487) = rate(:,:,487) * m(:,:) - rate(:,:,488) = rate(:,:,488) * m(:,:) - rate(:,:,489) = rate(:,:,489) * m(:,:) - rate(:,:,490) = rate(:,:,490) * m(:,:) - rate(:,:,491) = rate(:,:,491) * m(:,:) - rate(:,:,492) = rate(:,:,492) * m(:,:) - rate(:,:,493) = rate(:,:,493) * m(:,:) - rate(:,:,494) = rate(:,:,494) * m(:,:) - rate(:,:,495) = rate(:,:,495) * m(:,:) - rate(:,:,496) = rate(:,:,496) * m(:,:) - rate(:,:,497) = rate(:,:,497) * m(:,:) - rate(:,:,498) = rate(:,:,498) * m(:,:) - rate(:,:,499) = rate(:,:,499) * m(:,:) - rate(:,:,500) = rate(:,:,500) * m(:,:) - rate(:,:,501) = rate(:,:,501) * m(:,:) - rate(:,:,502) = rate(:,:,502) * m(:,:) - rate(:,:,503) = rate(:,:,503) * m(:,:) - rate(:,:,504) = rate(:,:,504) * m(:,:) - rate(:,:,505) = rate(:,:,505) * m(:,:) - rate(:,:,506) = rate(:,:,506) * m(:,:) - rate(:,:,507) = rate(:,:,507) * m(:,:) - rate(:,:,508) = rate(:,:,508) * m(:,:) - rate(:,:,509) = rate(:,:,509) * m(:,:) - rate(:,:,510) = rate(:,:,510) * m(:,:) - rate(:,:,511) = rate(:,:,511) * m(:,:) - rate(:,:,512) = rate(:,:,512) * m(:,:) - rate(:,:,513) = rate(:,:,513) * m(:,:) - rate(:,:,514) = rate(:,:,514) * m(:,:) - rate(:,:,515) = rate(:,:,515) * m(:,:) - rate(:,:,516) = rate(:,:,516) * m(:,:) - rate(:,:,517) = rate(:,:,517) * m(:,:) - rate(:,:,518) = rate(:,:,518) * m(:,:) - rate(:,:,519) = rate(:,:,519) * m(:,:) - rate(:,:,520) = rate(:,:,520) * m(:,:) - rate(:,:,521) = rate(:,:,521) * m(:,:) - rate(:,:,522) = rate(:,:,522) * m(:,:) - rate(:,:,523) = rate(:,:,523) * m(:,:) - rate(:,:,524) = rate(:,:,524) * m(:,:) - rate(:,:,525) = rate(:,:,525) * m(:,:) - rate(:,:,526) = rate(:,:,526) * m(:,:) - rate(:,:,527) = rate(:,:,527) * m(:,:) - rate(:,:,528) = rate(:,:,528) * m(:,:) - rate(:,:,529) = rate(:,:,529) * m(:,:) - rate(:,:,530) = rate(:,:,530) * m(:,:) - rate(:,:,531) = rate(:,:,531) * m(:,:) - rate(:,:,532) = rate(:,:,532) * m(:,:) - rate(:,:,533) = rate(:,:,533) * m(:,:) - rate(:,:,534) = rate(:,:,534) * m(:,:) - rate(:,:,535) = rate(:,:,535) * m(:,:) - rate(:,:,536) = rate(:,:,536) * m(:,:) - rate(:,:,542) = rate(:,:,542) * m(:,:) - rate(:,:,547) = rate(:,:,547) * m(:,:) - rate(:,:,548) = rate(:,:,548) * m(:,:) - rate(:,:,549) = rate(:,:,549) * m(:,:) - rate(:,:,552) = rate(:,:,552) * m(:,:) - rate(:,:,553) = rate(:,:,553) * m(:,:) - rate(:,:,554) = rate(:,:,554) * m(:,:) - rate(:,:,557) = rate(:,:,557) * m(:,:) - rate(:,:,561) = rate(:,:,561) * m(:,:) - rate(:,:,562) = rate(:,:,562) * m(:,:) - rate(:,:,563) = rate(:,:,563) * m(:,:) - rate(:,:,564) = rate(:,:,564) * m(:,:) - rate(:,:,565) = rate(:,:,565) * m(:,:) - rate(:,:,566) = rate(:,:,566) * m(:,:) - rate(:,:,567) = rate(:,:,567) * m(:,:) - rate(:,:,568) = rate(:,:,568) * m(:,:) - rate(:,:,569) = rate(:,:,569) * m(:,:) - rate(:,:,570) = rate(:,:,570) * m(:,:) - rate(:,:,572) = rate(:,:,572) * m(:,:) - rate(:,:,573) = rate(:,:,573) * m(:,:) - rate(:,:,575) = rate(:,:,575) * m(:,:) - rate(:,:,576) = rate(:,:,576) * m(:,:) - rate(:,:,577) = rate(:,:,577) * m(:,:) - rate(:,:,579) = rate(:,:,579) * m(:,:) - rate(:,:,580) = rate(:,:,580) * m(:,:) - rate(:,:,581) = rate(:,:,581) * m(:,:) - rate(:,:,582) = rate(:,:,582) * m(:,:) - rate(:,:,585) = rate(:,:,585) * m(:,:) + rate(:,:, 102) = rate(:,:, 102) * inv(:,:, 1) + rate(:,:, 103) = rate(:,:, 103) * inv(:,:, 1) + rate(:,:, 113) = rate(:,:, 113) * inv(:,:, 1) + rate(:,:, 114) = rate(:,:, 114) * inv(:,:, 1) + rate(:,:, 128) = rate(:,:, 128) * inv(:,:, 2) + rate(:,:, 130) = rate(:,:, 130) * inv(:,:, 1) + rate(:,:, 132) = rate(:,:, 132) * inv(:,:, 2) + rate(:,:, 253) = rate(:,:, 253) * inv(:,:, 1) + rate(:,:, 254) = rate(:,:, 254) * inv(:,:, 1) + rate(:,:, 255) = rate(:,:, 255) * inv(:,:, 1) + rate(:,:, 256) = rate(:,:, 256) * inv(:,:, 1) + rate(:,:, 257) = rate(:,:, 257) * inv(:,:, 1) + rate(:,:, 258) = rate(:,:, 258) * inv(:,:, 1) + rate(:,:, 259) = rate(:,:, 259) * inv(:,:, 1) + rate(:,:, 260) = rate(:,:, 260) * inv(:,:, 1) + rate(:,:, 261) = rate(:,:, 261) * inv(:,:, 1) + rate(:,:, 262) = rate(:,:, 262) * inv(:,:, 1) + rate(:,:, 263) = rate(:,:, 263) * inv(:,:, 1) + rate(:,:, 264) = rate(:,:, 264) * inv(:,:, 1) + rate(:,:, 265) = rate(:,:, 265) * inv(:,:, 1) + rate(:,:, 266) = rate(:,:, 266) * inv(:,:, 1) + rate(:,:, 268) = rate(:,:, 268) * inv(:,:, 1) + rate(:,:, 269) = rate(:,:, 269) * inv(:,:, 1) + rate(:,:, 270) = rate(:,:, 270) * inv(:,:, 1) + rate(:,:, 271) = rate(:,:, 271) * inv(:,:, 1) + rate(:,:, 277) = rate(:,:, 277) * inv(:,:, 1) + rate(:,:, 278) = rate(:,:, 278) * inv(:,:, 1) + rate(:,:, 279) = rate(:,:, 279) * inv(:,:, 1) + rate(:,:, 283) = rate(:,:, 283) * inv(:,:, 1) + rate(:,:, 289) = rate(:,:, 289) * inv(:,:, 1) + rate(:,:, 291) = rate(:,:, 291) * inv(:,:, 1) + rate(:,:, 295) = rate(:,:, 295) * inv(:,:, 1) + rate(:,:, 311) = rate(:,:, 311) * inv(:,:, 1) + rate(:,:, 317) = rate(:,:, 317) * inv(:,:, 1) + rate(:,:, 324) = rate(:,:, 324) * inv(:,:, 1) + rate(:,:, 338) = rate(:,:, 338) * inv(:,:, 1) + rate(:,:, 344) = rate(:,:, 344) * inv(:,:, 1) + rate(:,:, 347) = rate(:,:, 347) * inv(:,:, 1) + rate(:,:, 353) = rate(:,:, 353) * inv(:,:, 1) + rate(:,:, 357) = rate(:,:, 357) * inv(:,:, 1) + rate(:,:, 359) = rate(:,:, 359) * inv(:,:, 1) + rate(:,:, 360) = rate(:,:, 360) * inv(:,:, 1) + rate(:,:, 361) = rate(:,:, 361) * inv(:,:, 1) + rate(:,:, 362) = rate(:,:, 362) * inv(:,:, 1) + rate(:,:, 363) = rate(:,:, 363) * inv(:,:, 1) + rate(:,:, 364) = rate(:,:, 364) * inv(:,:, 1) + rate(:,:, 366) = rate(:,:, 366) * inv(:,:, 1) + rate(:,:, 367) = rate(:,:, 367) * inv(:,:, 1) + rate(:,:, 368) = rate(:,:, 368) * inv(:,:, 1) + rate(:,:, 369) = rate(:,:, 369) * inv(:,:, 1) + rate(:,:, 370) = rate(:,:, 370) * inv(:,:, 1) + rate(:,:, 371) = rate(:,:, 371) * inv(:,:, 1) + rate(:,:, 372) = rate(:,:, 372) * inv(:,:, 1) + rate(:,:, 373) = rate(:,:, 373) * inv(:,:, 1) + rate(:,:, 374) = rate(:,:, 374) * inv(:,:, 1) + rate(:,:, 380) = rate(:,:, 380) * inv(:,:, 1) + rate(:,:, 381) = rate(:,:, 381) * inv(:,:, 1) + rate(:,:, 386) = rate(:,:, 386) * inv(:,:, 2) + rate(:,:, 390) = rate(:,:, 390) * inv(:,:, 2) + rate(:,:, 394) = rate(:,:, 394) * inv(:,:, 2) + rate(:,:, 399) = rate(:,:, 399) * inv(:,:, 1) + rate(:,:, 400) = rate(:,:, 400) * inv(:,:, 1) + rate(:,:, 406) = rate(:,:, 406) * inv(:,:, 1) + rate(:,:, 416) = rate(:,:, 416) * inv(:,:, 1) + rate(:,:, 428) = rate(:,:, 428) * inv(:,:, 1) + rate(:,:, 436) = rate(:,:, 436) * inv(:,:, 1) + rate(:,:, 439) = rate(:,:, 439) * inv(:,:, 1) + rate(:,:, 440) = rate(:,:, 440) * inv(:,:, 1) + rate(:,:, 441) = rate(:,:, 441) * inv(:,:, 1) + rate(:,:, 443) = rate(:,:, 443) * inv(:,:, 1) + rate(:,:, 444) = rate(:,:, 444) * inv(:,:, 1) + rate(:,:, 459) = rate(:,:, 459) * inv(:,:, 1) + rate(:,:, 479) = rate(:,:, 479) * inv(:,:, 1) + rate(:,:, 480) = rate(:,:, 480) * inv(:,:, 1) + rate(:,:, 490) = rate(:,:, 490) * inv(:,:, 1) + rate(:,:, 532) = rate(:,:, 532) * inv(:,:, 1) + rate(:,:, 571) = rate(:,:, 571) * inv(:,:, 2) + rate(:,:, 574) = rate(:,:, 574) * inv(:,:, 2) + rate(:,:, 578) = rate(:,:, 578) * inv(:,:, 2) + rate(:,:, 583) = rate(:,:, 583) * inv(:,:, 2) + rate(:,:, 584) = rate(:,:, 584) * inv(:,:, 2) + rate(:,:, 365) = rate(:,:, 365) * inv(:,:, 2) * inv(:,:, 1) + rate(:,:, 100) = rate(:,:, 100) * 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(:,:, 117) = rate(:,:, 117) * 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(:,:, 133) = rate(:,:, 133) * m(:,:) + rate(:,:, 134) = rate(:,:, 134) * m(:,:) + rate(:,:, 135) = rate(:,:, 135) * m(:,:) + rate(:,:, 136) = rate(:,:, 136) * 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(:,:, 172) = rate(:,:, 172) * 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * 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(:,:, 252) = rate(:,:, 252) * 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(:,:, 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(:,:, 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(:,:, 292) = rate(:,:, 292) * 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(:,:, 322) = rate(:,:, 322) * 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(:,:, 329) = rate(:,:, 329) * 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(:,:, 336) = rate(:,:, 336) * m(:,:) + rate(:,:, 337) = rate(:,:, 337) * m(:,:) + rate(:,:, 338) = rate(:,:, 338) * m(:,:) + rate(:,:, 339) = rate(:,:, 339) * m(:,:) + rate(:,:, 340) = rate(:,:, 340) * m(:,:) + rate(:,:, 341) = rate(:,:, 341) * m(:,:) + rate(:,:, 342) = rate(:,:, 342) * m(:,:) + rate(:,:, 343) = rate(:,:, 343) * m(:,:) + rate(:,:, 344) = rate(:,:, 344) * m(:,:) + rate(:,:, 345) = rate(:,:, 345) * m(:,:) + rate(:,:, 346) = rate(:,:, 346) * m(:,:) + rate(:,:, 347) = rate(:,:, 347) * m(:,:) + rate(:,:, 348) = rate(:,:, 348) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 352) = rate(:,:, 352) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 357) = rate(:,:, 357) * m(:,:) + rate(:,:, 358) = rate(:,:, 358) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + rate(:,:, 360) = rate(:,:, 360) * m(:,:) + rate(:,:, 361) = rate(:,:, 361) * m(:,:) + rate(:,:, 362) = rate(:,:, 362) * m(:,:) + rate(:,:, 363) = rate(:,:, 363) * m(:,:) + rate(:,:, 367) = rate(:,:, 367) * m(:,:) + rate(:,:, 369) = rate(:,:, 369) * m(:,:) + rate(:,:, 371) = rate(:,:, 371) * m(:,:) + rate(:,:, 373) = rate(:,:, 373) * m(:,:) + rate(:,:, 375) = rate(:,:, 375) * m(:,:) + rate(:,:, 376) = rate(:,:, 376) * m(:,:) + rate(:,:, 377) = rate(:,:, 377) * m(:,:) + rate(:,:, 378) = rate(:,:, 378) * m(:,:) + rate(:,:, 379) = rate(:,:, 379) * m(:,:) + rate(:,:, 384) = rate(:,:, 384) * m(:,:) + rate(:,:, 385) = rate(:,:, 385) * m(:,:) + rate(:,:, 387) = rate(:,:, 387) * m(:,:) + rate(:,:, 388) = rate(:,:, 388) * m(:,:) + rate(:,:, 389) = rate(:,:, 389) * m(:,:) + rate(:,:, 391) = rate(:,:, 391) * m(:,:) + rate(:,:, 392) = rate(:,:, 392) * m(:,:) + rate(:,:, 393) = rate(:,:, 393) * m(:,:) + rate(:,:, 395) = rate(:,:, 395) * m(:,:) + rate(:,:, 396) = rate(:,:, 396) * m(:,:) + rate(:,:, 397) = rate(:,:, 397) * m(:,:) + rate(:,:, 398) = rate(:,:, 398) * m(:,:) + rate(:,:, 399) = rate(:,:, 399) * m(:,:) + rate(:,:, 400) = rate(:,:, 400) * m(:,:) + rate(:,:, 401) = rate(:,:, 401) * m(:,:) + rate(:,:, 402) = rate(:,:, 402) * m(:,:) + rate(:,:, 403) = rate(:,:, 403) * m(:,:) + rate(:,:, 404) = rate(:,:, 404) * m(:,:) + rate(:,:, 405) = rate(:,:, 405) * m(:,:) + rate(:,:, 406) = rate(:,:, 406) * m(:,:) + rate(:,:, 407) = rate(:,:, 407) * m(:,:) + rate(:,:, 408) = rate(:,:, 408) * m(:,:) + rate(:,:, 409) = rate(:,:, 409) * m(:,:) + rate(:,:, 410) = rate(:,:, 410) * m(:,:) + rate(:,:, 411) = rate(:,:, 411) * m(:,:) + rate(:,:, 412) = rate(:,:, 412) * m(:,:) + rate(:,:, 413) = rate(:,:, 413) * m(:,:) + rate(:,:, 414) = rate(:,:, 414) * m(:,:) + rate(:,:, 415) = rate(:,:, 415) * m(:,:) + rate(:,:, 416) = rate(:,:, 416) * m(:,:) + rate(:,:, 417) = rate(:,:, 417) * m(:,:) + rate(:,:, 418) = rate(:,:, 418) * m(:,:) + rate(:,:, 419) = rate(:,:, 419) * m(:,:) + rate(:,:, 420) = rate(:,:, 420) * m(:,:) + rate(:,:, 421) = rate(:,:, 421) * m(:,:) + rate(:,:, 422) = rate(:,:, 422) * m(:,:) + rate(:,:, 423) = rate(:,:, 423) * m(:,:) + rate(:,:, 424) = rate(:,:, 424) * m(:,:) + rate(:,:, 425) = rate(:,:, 425) * m(:,:) + rate(:,:, 426) = rate(:,:, 426) * m(:,:) + rate(:,:, 427) = rate(:,:, 427) * m(:,:) + rate(:,:, 428) = rate(:,:, 428) * m(:,:) + rate(:,:, 429) = rate(:,:, 429) * m(:,:) + rate(:,:, 430) = rate(:,:, 430) * m(:,:) + rate(:,:, 431) = rate(:,:, 431) * m(:,:) + rate(:,:, 432) = rate(:,:, 432) * m(:,:) + rate(:,:, 433) = rate(:,:, 433) * m(:,:) + rate(:,:, 434) = rate(:,:, 434) * m(:,:) + rate(:,:, 435) = rate(:,:, 435) * m(:,:) + rate(:,:, 436) = rate(:,:, 436) * m(:,:) + rate(:,:, 437) = rate(:,:, 437) * m(:,:) + rate(:,:, 438) = rate(:,:, 438) * m(:,:) + rate(:,:, 439) = rate(:,:, 439) * m(:,:) + rate(:,:, 440) = rate(:,:, 440) * m(:,:) + rate(:,:, 441) = rate(:,:, 441) * m(:,:) + rate(:,:, 442) = rate(:,:, 442) * m(:,:) + rate(:,:, 445) = rate(:,:, 445) * m(:,:) + rate(:,:, 446) = rate(:,:, 446) * m(:,:) + rate(:,:, 447) = rate(:,:, 447) * m(:,:) + rate(:,:, 448) = rate(:,:, 448) * m(:,:) + rate(:,:, 449) = rate(:,:, 449) * m(:,:) + rate(:,:, 450) = rate(:,:, 450) * m(:,:) + rate(:,:, 451) = rate(:,:, 451) * m(:,:) + rate(:,:, 452) = rate(:,:, 452) * m(:,:) + rate(:,:, 453) = rate(:,:, 453) * m(:,:) + rate(:,:, 454) = rate(:,:, 454) * m(:,:) + rate(:,:, 455) = rate(:,:, 455) * m(:,:) + rate(:,:, 456) = rate(:,:, 456) * m(:,:) + rate(:,:, 457) = rate(:,:, 457) * m(:,:) + rate(:,:, 458) = rate(:,:, 458) * m(:,:) + rate(:,:, 459) = rate(:,:, 459) * m(:,:) + rate(:,:, 460) = rate(:,:, 460) * m(:,:) + rate(:,:, 461) = rate(:,:, 461) * m(:,:) + rate(:,:, 462) = rate(:,:, 462) * m(:,:) + rate(:,:, 463) = rate(:,:, 463) * m(:,:) + rate(:,:, 464) = rate(:,:, 464) * m(:,:) + rate(:,:, 465) = rate(:,:, 465) * m(:,:) + rate(:,:, 466) = rate(:,:, 466) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * m(:,:) + rate(:,:, 468) = rate(:,:, 468) * m(:,:) + rate(:,:, 469) = rate(:,:, 469) * m(:,:) + rate(:,:, 470) = rate(:,:, 470) * m(:,:) + rate(:,:, 471) = rate(:,:, 471) * m(:,:) + rate(:,:, 472) = rate(:,:, 472) * m(:,:) + rate(:,:, 473) = rate(:,:, 473) * m(:,:) + rate(:,:, 474) = rate(:,:, 474) * m(:,:) + rate(:,:, 475) = rate(:,:, 475) * m(:,:) + rate(:,:, 476) = rate(:,:, 476) * m(:,:) + rate(:,:, 477) = rate(:,:, 477) * m(:,:) + rate(:,:, 478) = rate(:,:, 478) * m(:,:) + rate(:,:, 479) = rate(:,:, 479) * m(:,:) + rate(:,:, 481) = rate(:,:, 481) * m(:,:) + rate(:,:, 482) = rate(:,:, 482) * m(:,:) + rate(:,:, 483) = rate(:,:, 483) * m(:,:) + rate(:,:, 484) = rate(:,:, 484) * m(:,:) + rate(:,:, 485) = rate(:,:, 485) * m(:,:) + rate(:,:, 486) = rate(:,:, 486) * m(:,:) + rate(:,:, 487) = rate(:,:, 487) * m(:,:) + rate(:,:, 488) = rate(:,:, 488) * m(:,:) + rate(:,:, 489) = rate(:,:, 489) * m(:,:) + rate(:,:, 490) = rate(:,:, 490) * m(:,:) + rate(:,:, 491) = rate(:,:, 491) * m(:,:) + rate(:,:, 492) = rate(:,:, 492) * m(:,:) + rate(:,:, 493) = rate(:,:, 493) * m(:,:) + rate(:,:, 494) = rate(:,:, 494) * m(:,:) + rate(:,:, 495) = rate(:,:, 495) * m(:,:) + rate(:,:, 496) = rate(:,:, 496) * m(:,:) + rate(:,:, 497) = rate(:,:, 497) * m(:,:) + rate(:,:, 498) = rate(:,:, 498) * m(:,:) + rate(:,:, 499) = rate(:,:, 499) * m(:,:) + rate(:,:, 500) = rate(:,:, 500) * m(:,:) + rate(:,:, 501) = rate(:,:, 501) * m(:,:) + rate(:,:, 502) = rate(:,:, 502) * m(:,:) + rate(:,:, 503) = rate(:,:, 503) * m(:,:) + rate(:,:, 504) = rate(:,:, 504) * m(:,:) + rate(:,:, 505) = rate(:,:, 505) * m(:,:) + rate(:,:, 506) = rate(:,:, 506) * m(:,:) + rate(:,:, 507) = rate(:,:, 507) * m(:,:) + rate(:,:, 508) = rate(:,:, 508) * m(:,:) + rate(:,:, 509) = rate(:,:, 509) * m(:,:) + rate(:,:, 510) = rate(:,:, 510) * m(:,:) + rate(:,:, 511) = rate(:,:, 511) * m(:,:) + rate(:,:, 512) = rate(:,:, 512) * m(:,:) + rate(:,:, 513) = rate(:,:, 513) * m(:,:) + rate(:,:, 514) = rate(:,:, 514) * m(:,:) + rate(:,:, 515) = rate(:,:, 515) * m(:,:) + rate(:,:, 516) = rate(:,:, 516) * m(:,:) + rate(:,:, 517) = rate(:,:, 517) * m(:,:) + rate(:,:, 518) = rate(:,:, 518) * m(:,:) + rate(:,:, 519) = rate(:,:, 519) * m(:,:) + rate(:,:, 520) = rate(:,:, 520) * m(:,:) + rate(:,:, 521) = rate(:,:, 521) * m(:,:) + rate(:,:, 522) = rate(:,:, 522) * m(:,:) + rate(:,:, 523) = rate(:,:, 523) * m(:,:) + rate(:,:, 524) = rate(:,:, 524) * m(:,:) + rate(:,:, 525) = rate(:,:, 525) * m(:,:) + rate(:,:, 526) = rate(:,:, 526) * m(:,:) + rate(:,:, 527) = rate(:,:, 527) * m(:,:) + rate(:,:, 528) = rate(:,:, 528) * m(:,:) + rate(:,:, 529) = rate(:,:, 529) * m(:,:) + rate(:,:, 530) = rate(:,:, 530) * m(:,:) + rate(:,:, 531) = rate(:,:, 531) * m(:,:) + rate(:,:, 532) = rate(:,:, 532) * m(:,:) + rate(:,:, 533) = rate(:,:, 533) * m(:,:) + rate(:,:, 534) = rate(:,:, 534) * m(:,:) + rate(:,:, 535) = rate(:,:, 535) * m(:,:) + rate(:,:, 536) = rate(:,:, 536) * m(:,:) + rate(:,:, 542) = rate(:,:, 542) * m(:,:) + rate(:,:, 547) = rate(:,:, 547) * m(:,:) + rate(:,:, 548) = rate(:,:, 548) * m(:,:) + rate(:,:, 549) = rate(:,:, 549) * m(:,:) + rate(:,:, 552) = rate(:,:, 552) * m(:,:) + rate(:,:, 553) = rate(:,:, 553) * m(:,:) + rate(:,:, 554) = rate(:,:, 554) * m(:,:) + rate(:,:, 557) = rate(:,:, 557) * m(:,:) + rate(:,:, 561) = rate(:,:, 561) * m(:,:) + rate(:,:, 562) = rate(:,:, 562) * m(:,:) + rate(:,:, 563) = rate(:,:, 563) * m(:,:) + rate(:,:, 564) = rate(:,:, 564) * m(:,:) + rate(:,:, 565) = rate(:,:, 565) * m(:,:) + rate(:,:, 566) = rate(:,:, 566) * m(:,:) + rate(:,:, 567) = rate(:,:, 567) * m(:,:) + rate(:,:, 568) = rate(:,:, 568) * m(:,:) + rate(:,:, 569) = rate(:,:, 569) * m(:,:) + rate(:,:, 570) = rate(:,:, 570) * m(:,:) + rate(:,:, 572) = rate(:,:, 572) * m(:,:) + rate(:,:, 573) = rate(:,:, 573) * m(:,:) + rate(:,:, 575) = rate(:,:, 575) * m(:,:) + rate(:,:, 576) = rate(:,:, 576) * m(:,:) + rate(:,:, 577) = rate(:,:, 577) * m(:,:) + rate(:,:, 579) = rate(:,:, 579) * m(:,:) + rate(:,:, 580) = rate(:,:, 580) * m(:,:) + rate(:,:, 581) = rate(:,:, 581) * m(:,:) + rate(:,:, 582) = rate(:,:, 582) * m(:,:) + rate(:,:, 585) = rate(:,:, 585) * m(:,:) end subroutine adjrxt end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_mad/mo_exp_sol.F90 b/src/chemistry/pp_waccm_mad/mo_exp_sol.F90 index c1cde93fa7..cfde22391a 100644 --- a/src/chemistry/pp_waccm_mad/mo_exp_sol.F90 +++ b/src/chemistry/pp_waccm_mad/mo_exp_sol.F90 @@ -6,6 +6,7 @@ module mo_exp_sol subroutine exp_sol_inti use mo_tracname, only : solsym use chem_mods, only : clscnt1, clsmap + use ppgrid, only : pver use cam_history, only : addfld implicit none integer :: i,j @@ -45,23 +46,20 @@ subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, nco ! ... Local variables !----------------------------------------------------------------------- integer :: i, k, l, m - integer :: chnkpnts - real(r8), dimension(ncol,pver,max(1,clscnt1)) :: & + real(r8), dimension(ncol,pver,clscnt1) :: & prod, & - loss - real(r8), dimension(ncol,pver,clscnt1) :: ind_prd + loss, & + 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 ) + reaction_rates, ncol ) !----------------------------------------------------------------------- ! ... Form F(y) !----------------------------------------------------------------------- - call exp_prod_loss( 1, chnkpnts, prod, loss, base_sol, reaction_rates, & - het_rates, chnkpnts ) + call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) !----------------------------------------------------------------------- ! ... Solve for the mixing ratio at t(n+1) !----------------------------------------------------------------------- diff --git a/src/chemistry/pp_waccm_mad/mo_imp_sol.F90 b/src/chemistry/pp_waccm_mad/mo_imp_sol.F90 index 98cadb9050..d885728ba4 100644 --- a/src/chemistry/pp_waccm_mad/mo_imp_sol.F90 +++ b/src/chemistry/pp_waccm_mad/mo_imp_sol.F90 @@ -1,6 +1,6 @@ module mo_imp_sol use shr_kind_mod, only : r8 => shr_kind_r8 - use chem_mods, only : clscnt4, gas_pcnst, clsmap, veclen + use chem_mods, only : clscnt4, gas_pcnst, clsmap use cam_logfile, only : iulog implicit none private @@ -13,7 +13,6 @@ module mo_imp_sol !----------------------------------------------------------------------- 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) @@ -107,12 +106,12 @@ subroutine imp_slv_inti 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 ) + 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 + ! this source is meant for small l1 cache machines such as + ! the intel pentium and itanium cpus !----------------------------------------------------------------------- use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt use mo_tracname, only : solsym @@ -132,304 +131,262 @@ subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, & 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)) + 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 :: nr_iter, & + lev, & + i, & + j, & + k, l, & + m + integer :: fail_cnt, cut_cnt, stp_con_cnt integer :: nstep - real(r8) :: interval_done(veclen) - real(r8) :: dt(veclen) - real(r8) :: dti(veclen) + real(r8) :: interval_done, dt, dti real(r8) :: max_delta(max(1,clscnt4)) - real(r8) :: ind_prd(ncol*nlev,max(1,clscnt4)) + real(r8) :: sys_jac(max(1,nzcnt)) + real(r8) :: lin_jac(max(1,nzcnt)) + real(r8), dimension(max(1,clscnt4)) :: & + solution, & + forcing, & + iter_invariant, & + prod, & + loss + real(r8) :: lrxt(max(1,rxntot)) + real(r8) :: lsol(max(1,gas_pcnst)) + real(r8) :: lhet(max(1,gas_pcnst)) + real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: & + ind_prd 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. + logical :: frc_mask, iter_conv + logical :: converged(max(1,clscnt4)) + solution(:) = 0._r8 !----------------------------------------------------------------------- ! ... 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 ) + reaction_rates, ncol ) else - do m = 1,clscnt4 - ind_prd(:,m) = 0._r8 + do m = 1,max(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) + level_loop : do lev = 1,nlev + column_loop : do i = 1,ncol !----------------------------------------------------------------------- - ! ... transfer from base to class array + ! ... transfer from base to local work arrays !----------------------------------------------------------------------- - 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) + do m = 1,rxntot + lrxt(m) = reaction_rates(i,lev,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 + if( gas_pcnst > 0 ) then + do m = 1,gas_pcnst + lhet(m) = het_rates(i,lev,m) end do end if !----------------------------------------------------------------------- - ! ... the linear component + ! ... time step loop !----------------------------------------------------------------------- - 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 + dt = delt + cut_cnt = 0 + fail_cnt = 0 + stp_con_cnt = 0 + interval_done = 0._r8 + time_step_loop : do + dti = 1._r8 / dt !----------------------------------------------------------------------- - ! ... the non-linear component + ! ... transfer from base to local work arrays !----------------------------------------------------------------------- - 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 + do m = 1,gas_pcnst + lsol(m) = base_sol(i,lev,m) + end do !----------------------------------------------------------------------- - ! ... form f(y) + ! ... transfer from base to class array !----------------------------------------------------------------------- - 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 + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + solution(m) = lsol(j) end do !----------------------------------------------------------------------- - ! ... solve for the mixing ratio at t(n+1) + ! ... set the iteration invariant part of the function f(y) !----------------------------------------------------------------------- - 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 + if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m) end do - end do + else + do m = 1,clscnt4 + iter_invariant(m) = dti * solution(m) + end do + end if !----------------------------------------------------------------------- - ! ... convergence measures and test + ! ... the linear component !----------------------------------------------------------------------- - conv_chk : if( nr_iter > 1 ) then + if( cls_rxt_cnt(2,4) > 0 ) then + call t_startf( 'lin_mat' ) + call linmat( lin_jac, lsol, lrxt, lhet ) + call t_stopf( 'lin_mat' ) + end if + !======================================================================= + ! the newton-raphson iteration for f(y) = 0 + !======================================================================= + iter_loop : do nr_iter = 1,itermax !----------------------------------------------------------------------- - ! ... check for convergence + ! ... the non-linear component !----------------------------------------------------------------------- - 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 + if( factor(nr_iter) ) then + call t_startf( 'nln_mat' ) + call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti ) + call t_stopf( 'nln_mat' ) + !----------------------------------------------------------------------- + ! ... factor the "system" matrix + !----------------------------------------------------------------------- + call t_startf( 'lu_fac' ) + call lu_fac( sys_jac ) + call t_stopf( 'lu_fac' ) end if - else conv_chk -!----------------------------------------------------------------------- -! ... limit iterate -!----------------------------------------------------------------------- + !----------------------------------------------------------------------- + ! ... form f(y) + !----------------------------------------------------------------------- + call t_startf( 'prod_loss' ) + call imp_prod_loss( prod, loss, lsol, lrxt, lhet ) + call t_stopf( 'prod_loss' ) do m = 1,clscnt4 - do i = 1, avec_len - solution_blk(i,m) = max( 0._r8,solution_blk(i,m) ) - end do + forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m)) 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) + !----------------------------------------------------------------------- + ! ... solve for the mixing ratio at t(n+1) + !----------------------------------------------------------------------- + call t_startf( 'lu_slv' ) + call lu_slv( sys_jac, forcing ) + call t_stopf( 'lu_slv' ) + do m = 1,clscnt4 + solution(m) = solution(m) + forcing(m) + end do + !----------------------------------------------------------------------- + ! ... convergence measures + !----------------------------------------------------------------------- + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + if( abs(solution(m)) > 1.e-20_r8 ) then + max_delta(k) = abs( forcing(m)/solution(m) ) + else + max_delta(k) = 0._r8 + end if end do + end if + !----------------------------------------------------------------------- + ! ... limit iterate + !----------------------------------------------------------------------- + where( solution(:) < 0._r8 ) + solution(:) = 0._r8 + endwhere + !----------------------------------------------------------------------- + ! ... transfer latest solution back to work array + !----------------------------------------------------------------------- + do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + lsol(j) = solution(m) 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) + !----------------------------------------------------------------------- + ! ... check for convergence + !----------------------------------------------------------------------- + converged(:) = .true. + if( nr_iter > 1 ) then + do k = 1,clscnt4 + m = permute(k,4) + frc_mask = abs( forcing(m) ) > small + if( frc_mask ) then + converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m)) + else + converged(k) = .true. + end if + end do + convergence = all( converged(:) ) + if( convergence ) then + exit + end if 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 do iter_loop + !----------------------------------------------------------------------- + ! ... check for newton-raphson convergence + !----------------------------------------------------------------------- + if( .not. convergence ) then + !----------------------------------------------------------------------- + ! ... non-convergence + !----------------------------------------------------------------------- + fail_cnt = fail_cnt + 1 + nstep = get_nstep() + write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') & + dt,lchnk,lev,i,nstep + stp_con_cnt = 0 + if( cut_cnt < cut_limit ) then + cut_cnt = cut_cnt + 1 + if( cut_cnt < cut_limit ) then + dt = .5_r8 * dt + else + dt = .1_r8 * dt end if + cycle time_step_loop + else + write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') & + lchnk,lev,i,nstep,dt,interval_done+dt + do m = 1,clscnt4 + if( .not. converged(m) ) then + write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m) + end if + end do + end if + end if + !----------------------------------------------------------------------- + ! ... check for interval done + !----------------------------------------------------------------------- + interval_done = interval_done + dt + if( abs( delt - interval_done ) <= .0001_r8 ) then + if( fail_cnt > 0 ) then + write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times' + end if + exit time_step_loop + else + !----------------------------------------------------------------------- + ! ... transfer latest solution back to base array + !----------------------------------------------------------------------- + if( convergence ) then + stp_con_cnt = stp_con_cnt + 1 + end if + do m = 1,gas_pcnst + base_sol(i,lev,m) = lsol(m) 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 + if( stp_con_cnt >= 2 ) then + dt = 2._r8*dt + stp_con_cnt = 0 + end if + dt = min( dt,delt-interval_done ) + ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt + end if + end do time_step_loop !----------------------------------------------------------------------- - ! ... check for time step done + ! ... Transfer latest solution back to base array !----------------------------------------------------------------------- - 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 + cls_loop: do k = 1,clscnt4 + j = clsmap(k,4) + m = permute(k,4) + base_sol(i,lev,j) = solution(m) + ! output diagnostics + prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k) + loss_out(i,lev,k) = loss(k) + end do cls_loop + end do column_loop + end do level_loop end subroutine imp_sol end module mo_imp_sol diff --git a/src/chemistry/pp_waccm_mad/mo_indprd.F90 b/src/chemistry/pp_waccm_mad/mo_indprd.F90 index b930aea6ab..c2f28519f2 100644 --- a/src/chemistry/pp_waccm_mad/mo_indprd.F90 +++ b/src/chemistry/pp_waccm_mad/mo_indprd.F90 @@ -3,149 +3,187 @@ module mo_indprd private public :: indprd contains - subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) + subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) use chem_mods, only : gas_pcnst, extcnt, rxntot + use ppgrid, only : pver implicit none !-------------------------------------------------------------------- ! ... dummy arguments !-------------------------------------------------------------------- integer, intent(in) :: class - integer, intent(in) :: chnkpnts + integer, intent(in) :: ncol 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) + real(r8), intent(in) :: y(ncol,pver,gas_pcnst) + real(r8), intent(in) :: rxt(ncol,pver,rxntot) + real(r8), intent(in) :: extfrc(ncol,pver,extcnt) + real(r8), intent(inout) :: prod(ncol,pver,nprod) !-------------------------------------------------------------------- ! ... "independent" production for Explicit species !-------------------------------------------------------------------- if( class == 1 ) then - prod(:,1) = 0._r8 - prod(:,2) = 0._r8 - prod(:,3) = 0._r8 - prod(:,4) = 0._r8 - prod(:,5) = 0._r8 - prod(:,6) = 0._r8 - prod(:,7) = 0._r8 - prod(:,8) = 0._r8 - prod(:,9) = 0._r8 - prod(:,10) = 0._r8 - prod(:,11) = 0._r8 - prod(:,12) = 0._r8 - prod(:,13) = 0._r8 - prod(:,14) = 0._r8 - prod(:,15) = 0._r8 - prod(:,16) = 0._r8 - prod(:,17) = 0._r8 - prod(:,18) = 0._r8 - prod(:,19) = 0._r8 - prod(:,20) = 0._r8 - prod(:,21) =rxt(:,422)*y(:,52)*y(:,48) - prod(:,22) = 0._r8 + prod(:,:,1) = 0._r8 + prod(:,:,2) = 0._r8 + prod(:,:,3) = 0._r8 + prod(:,:,4) = 0._r8 + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,17) = (rxt(:,:,63) +rxt(:,:,109)*y(:,:,23) +rxt(:,:,110)*y(:,:,23) + & + rxt(:,:,111)*y(:,:,26) +rxt(:,:,112)*y(:,:,34) + & + rxt(:,:,119)*y(:,:,44) +rxt(:,:,120)*y(:,:,55) + & + rxt(:,:,121)*y(:,:,56) +rxt(:,:,163)*y(:,:,77) + & + rxt(:,:,165)*y(:,:,75) +rxt(:,:,181)*y(:,:,73) + & + rxt(:,:,199)*y(:,:,92) +rxt(:,:,216)*y(:,:,89) + & + rxt(:,:,234)*y(:,:,88) +rxt(:,:,251)*y(:,:,99) + & + rxt(:,:,253)*y(:,:,75) +rxt(:,:,260)*y(:,:,77) + & + rxt(:,:,275)*y(:,:,52) +rxt(:,:,276)*y(:,:,53))*y(:,:,64) & + + (rxt(:,:,115)*y(:,:,53) +rxt(:,:,116)*y(:,:,53) + & + rxt(:,:,117)*y(:,:,52) +rxt(:,:,118)*y(:,:,52) + & + rxt(:,:,150)*y(:,:,99) +rxt(:,:,153)*y(:,:,75) + & + rxt(:,:,173)*y(:,:,77) +rxt(:,:,191)*y(:,:,73) + & + rxt(:,:,208)*y(:,:,92) +rxt(:,:,226)*y(:,:,89) + & + rxt(:,:,244)*y(:,:,88) +rxt(:,:,255)*y(:,:,75) + & + rxt(:,:,256)*y(:,:,77))*y(:,:,66) + (rxt(:,:,65) + & + rxt(:,:,122)*y(:,:,23) +rxt(:,:,123)*y(:,:,26) + & + rxt(:,:,125)*y(:,:,42) +rxt(:,:,127)*y(:,:,57) + & + rxt(:,:,146)*y(:,:,99) +rxt(:,:,169)*y(:,:,77) + & + rxt(:,:,186)*y(:,:,73) +rxt(:,:,204)*y(:,:,92) + & + rxt(:,:,220)*y(:,:,75) +rxt(:,:,222)*y(:,:,89) + & + rxt(:,:,239)*y(:,:,88))*y(:,:,67) + (rxt(:,:,148)*y(:,:,99) + & + rxt(:,:,171)*y(:,:,77) +rxt(:,:,189)*y(:,:,73) + & + rxt(:,:,206)*y(:,:,92) +rxt(:,:,224)*y(:,:,89) + & + rxt(:,:,241)*y(:,:,88) +rxt(:,:,242)*y(:,:,75) + & + rxt(:,:,254)*y(:,:,77) +rxt(:,:,266)*y(:,:,75))*y(:,:,65) & + + (rxt(:,:,144)*y(:,:,99) +rxt(:,:,167)*y(:,:,77) + & + rxt(:,:,184)*y(:,:,73) +rxt(:,:,198)*y(:,:,75) + & + rxt(:,:,202)*y(:,:,92) +rxt(:,:,219)*y(:,:,89) + & + rxt(:,:,237)*y(:,:,88))*y(:,:,70) + (rxt(:,:,364) + & + rxt(:,:,301)*y(:,:,68) +rxt(:,:,302)*y(:,:,110))*y(:,:,91) & + + (rxt(:,:,532)*y(:,:,104) +rxt(:,:,536)*y(:,:,104))*y(:,:,29) + prod(:,:,18) = 0._r8 + prod(:,:,19) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,21) = 0._r8 + prod(:,:,22) =rxt(:,:,422)*y(:,:,53)*y(:,:,49) + prod(:,:,23) = 0._r8 !-------------------------------------------------------------------- ! ... "independent" production for Implicit species !-------------------------------------------------------------------- else if( class == 4 ) then - prod(:,6) = 0._r8 - prod(:,52) = 0._r8 - prod(:,17) = 0._r8 - prod(:,56) =.180_r8*rxt(:,25)*y(:,20) - prod(:,39) =rxt(:,40)*y(:,15) +rxt(:,42)*y(:,17) +rxt(:,24)*y(:,20) - prod(:,12) = 0._r8 - prod(:,4) = 0._r8 - prod(:,1) = 0._r8 - prod(:,81) = 0._r8 - prod(:,34) = 0._r8 - prod(:,25) =.380_r8*rxt(:,25)*y(:,20) + extfrc(:,3) - prod(:,2) =rxt(:,32)*y(:,6) +rxt(:,33)*y(:,7) +rxt(:,35)*y(:,9) & - +2.000_r8*rxt(:,36)*y(:,10) +2.000_r8*rxt(:,37)*y(:,11) +rxt(:,38) & - *y(:,12) +2.000_r8*rxt(:,51)*y(:,34) +rxt(:,54)*y(:,38) +rxt(:,55) & - *y(:,39) - prod(:,5) =rxt(:,34)*y(:,8) +rxt(:,35)*y(:,9) +rxt(:,53)*y(:,37) - prod(:,78) =.440_r8*rxt(:,25)*y(:,20) - prod(:,30) =rxt(:,33)*y(:,7) +rxt(:,37)*y(:,11) - prod(:,86) = (rxt(:,24) +.330_r8*rxt(:,25))*y(:,20) - prod(:,50) =1.440_r8*rxt(:,25)*y(:,20) - prod(:,18) = 0._r8 - prod(:,33) = 0._r8 - prod(:,80) = 0._r8 - prod(:,7) = 0._r8 - prod(:,71) = 0._r8 - prod(:,61) = 0._r8 - prod(:,14) = 0._r8 - prod(:,28) = 0._r8 - prod(:,32) = 0._r8 - prod(:,24) = 0._r8 - prod(:,40) = (.800_r8*rxt(:,67) +.800_r8*rxt(:,69) +rxt(:,73) +rxt(:,74)) & - + extfrc(:,11) - prod(:,37) = 0._r8 - prod(:,87) = + extfrc(:,2) - prod(:,72) = + extfrc(:,1) - prod(:,74) = 0._r8 - prod(:,68) =.180_r8*rxt(:,25)*y(:,20) + extfrc(:,6) - prod(:,75) = 0._r8 - prod(:,79) = 0._r8 - prod(:,3) = 0._r8 - prod(:,44) =rxt(:,32)*y(:,6) +rxt(:,33)*y(:,7) +2.000_r8*rxt(:,39)*y(:,13) & - +rxt(:,40)*y(:,15) +3.000_r8*rxt(:,43)*y(:,21) +2.000_r8*rxt(:,51) & - *y(:,34) - prod(:,85) =4.000_r8*rxt(:,31)*y(:,5) +rxt(:,32)*y(:,6) +2.000_r8*rxt(:,34) & - *y(:,8) +2.000_r8*rxt(:,35)*y(:,9) +2.000_r8*rxt(:,36)*y(:,10) & - +rxt(:,37)*y(:,11) +2.000_r8*rxt(:,38)*y(:,12) +3.000_r8*rxt(:,41) & - *y(:,16) +rxt(:,42)*y(:,17) +rxt(:,53)*y(:,37) +rxt(:,54)*y(:,38) & - +rxt(:,55)*y(:,39) - prod(:,58) = 0._r8 - prod(:,46) = 0._r8 - prod(:,45) = 0._r8 - prod(:,35) = 0._r8 - prod(:,64) = 0._r8 - prod(:,43) = 0._r8 - prod(:,54) = 0._r8 - prod(:,59) = 0._r8 - prod(:,69) = (rxt(:,68) +rxt(:,70) +rxt(:,71) +rxt(:,72) +rxt(:,73) + & - rxt(:,74)) + extfrc(:,10) - prod(:,11) = 0._r8 - prod(:,42) = 0._r8 - prod(:,21) = 0._r8 - prod(:,65) = 0._r8 - prod(:,8) = 0._r8 - prod(:,73) = 0._r8 - prod(:,9) = 0._r8 - prod(:,82) = 0._r8 - prod(:,26) = 0._r8 - prod(:,29) = (1.200_r8*rxt(:,67) +1.200_r8*rxt(:,69) +rxt(:,70) +rxt(:,71)) & - + extfrc(:,12) - prod(:,19) = (rxt(:,68) +rxt(:,72)) + extfrc(:,4) - prod(:,62) = 0._r8 - prod(:,47) = 0._r8 - prod(:,60) = 0._r8 - prod(:,53) = 0._r8 - prod(:,55) = 0._r8 - prod(:,48) = 0._r8 - prod(:,51) = 0._r8 - prod(:,66) = 0._r8 - prod(:,67) = 0._r8 - prod(:,13) = 0._r8 - prod(:,23) = 0._r8 - prod(:,70) = 0._r8 - prod(:,22) = 0._r8 - prod(:,31) = (rxt(:,70) +rxt(:,71) +rxt(:,73) +rxt(:,74)) + extfrc(:,5) - prod(:,57) =rxt(:,13)*y(:,49) - prod(:,36) = 0._r8 - prod(:,10) = 0._r8 - prod(:,76) = 0._r8 - prod(:,77) = + extfrc(:,7) - prod(:,27) = 0._r8 - prod(:,49) = 0._r8 - prod(:,20) = 0._r8 - prod(:,41) = 0._r8 - prod(:,63) =.330_r8*rxt(:,25)*y(:,20) + extfrc(:,8) - prod(:,83) = 0._r8 - prod(:,84) = 0._r8 - prod(:,38) = + extfrc(:,9) - prod(:,16) = 0._r8 - prod(:,15) = 0._r8 - prod(:,88) =.050_r8*rxt(:,25)*y(:,20) + prod(:,:,44) =rxt(:,:,32)*y(:,:,7) +rxt(:,:,33)*y(:,:,8) & + +2.000_r8*rxt(:,:,39)*y(:,:,14) +rxt(:,:,40)*y(:,:,16) & + +3.000_r8*rxt(:,:,43)*y(:,:,22) +2.000_r8*rxt(:,:,51)*y(:,:,36) + prod(:,:,6) = 0._r8 + prod(:,:,50) = 0._r8 + prod(:,:,20) = 0._r8 + prod(:,:,56) =.180_r8*rxt(:,:,25)*y(:,:,21) + prod(:,:,40) =rxt(:,:,40)*y(:,:,16) +rxt(:,:,42)*y(:,:,18) +rxt(:,:,24) & + *y(:,:,21) + prod(:,:,11) = 0._r8 + prod(:,:,74) =4.000_r8*rxt(:,:,31)*y(:,:,6) +rxt(:,:,32)*y(:,:,7) & + +2.000_r8*rxt(:,:,34)*y(:,:,9) +2.000_r8*rxt(:,:,35)*y(:,:,10) & + +2.000_r8*rxt(:,:,36)*y(:,:,11) +rxt(:,:,37)*y(:,:,12) & + +2.000_r8*rxt(:,:,38)*y(:,:,13) +3.000_r8*rxt(:,:,41)*y(:,:,17) & + +rxt(:,:,42)*y(:,:,18) +rxt(:,:,53)*y(:,:,39) +rxt(:,:,54)*y(:,:,40) & + +rxt(:,:,55)*y(:,:,41) + prod(:,:,4) = 0._r8 + prod(:,:,1) = 0._r8 + prod(:,:,72) = 0._r8 + prod(:,:,36) = 0._r8 + prod(:,:,21) = (rxt(:,:,26) +rxt(:,:,62))*y(:,:,30) +.380_r8*rxt(:,:,25) & + *y(:,:,21) + extfrc(:,:,3) + prod(:,:,2) =rxt(:,:,32)*y(:,:,7) +rxt(:,:,33)*y(:,:,8) +rxt(:,:,35) & + *y(:,:,10) +2.000_r8*rxt(:,:,36)*y(:,:,11) +2.000_r8*rxt(:,:,37) & + *y(:,:,12) +rxt(:,:,38)*y(:,:,13) +2.000_r8*rxt(:,:,51)*y(:,:,36) & + +rxt(:,:,54)*y(:,:,40) +rxt(:,:,55)*y(:,:,41) + prod(:,:,5) =rxt(:,:,34)*y(:,:,9) +rxt(:,:,35)*y(:,:,10) +rxt(:,:,53) & + *y(:,:,39) + prod(:,:,29) =rxt(:,:,33)*y(:,:,8) +rxt(:,:,37)*y(:,:,12) + prod(:,:,68) = (rxt(:,:,24) +.330_r8*rxt(:,:,25))*y(:,:,21) + prod(:,:,51) =1.440_r8*rxt(:,:,25)*y(:,:,21) + prod(:,:,23) = 0._r8 + prod(:,:,32) = 0._r8 + prod(:,:,67) = 0._r8 + prod(:,:,7) = 0._r8 + prod(:,:,85) = 0._r8 + prod(:,:,15) = 0._r8 + prod(:,:,30) = 0._r8 + prod(:,:,33) = 0._r8 + prod(:,:,25) = 0._r8 + prod(:,:,39) = (.800_r8*rxt(:,:,67) +.800_r8*rxt(:,:,69) +rxt(:,:,73) + & + rxt(:,:,74)) + extfrc(:,:,11) + prod(:,:,38) = 0._r8 + prod(:,:,77) = + extfrc(:,:,2) + prod(:,:,71) = + extfrc(:,:,1) + prod(:,:,86) = 0._r8 + prod(:,:,81) = (rxt(:,:,26) +rxt(:,:,62))*y(:,:,30) +.180_r8*rxt(:,:,25) & + *y(:,:,21) + extfrc(:,:,6) + prod(:,:,73) = 0._r8 + prod(:,:,84) = 0._r8 + prod(:,:,3) = 0._r8 + prod(:,:,59) = 0._r8 + prod(:,:,46) = 0._r8 + prod(:,:,45) = 0._r8 + prod(:,:,37) = 0._r8 + prod(:,:,63) = 0._r8 + prod(:,:,43) = 0._r8 + prod(:,:,54) = 0._r8 + prod(:,:,58) = 0._r8 + prod(:,:,79) = (rxt(:,:,68) +rxt(:,:,70) +rxt(:,:,71) +rxt(:,:,72) + & + rxt(:,:,73) +rxt(:,:,74)) + extfrc(:,:,10) + prod(:,:,12) = 0._r8 + prod(:,:,41) = 0._r8 + prod(:,:,61) = 0._r8 + prod(:,:,24) = 0._r8 + prod(:,:,70) = 0._r8 + prod(:,:,9) = 0._r8 + prod(:,:,78) = 0._r8 + prod(:,:,10) = 0._r8 + prod(:,:,80) = 0._r8 + prod(:,:,26) = 0._r8 + prod(:,:,28) = (1.200_r8*rxt(:,:,67) +1.200_r8*rxt(:,:,69) +rxt(:,:,70) + & + rxt(:,:,71)) + extfrc(:,:,12) + prod(:,:,22) = (rxt(:,:,68) +rxt(:,:,72)) + extfrc(:,:,4) + prod(:,:,64) = 0._r8 + prod(:,:,47) = 0._r8 + prod(:,:,60) = 0._r8 + prod(:,:,53) = 0._r8 + prod(:,:,55) = 0._r8 + prod(:,:,49) = 0._r8 + prod(:,:,52) = 0._r8 + prod(:,:,65) = 0._r8 + prod(:,:,66) = 0._r8 + prod(:,:,13) = 0._r8 + prod(:,:,17) = 0._r8 + prod(:,:,69) = 0._r8 + prod(:,:,16) = 0._r8 + prod(:,:,31) = (rxt(:,:,70) +rxt(:,:,71) +rxt(:,:,73) +rxt(:,:,74)) & + + extfrc(:,:,5) + prod(:,:,57) =rxt(:,:,13)*y(:,:,50) + prod(:,:,34) = 0._r8 + prod(:,:,8) = 0._r8 + prod(:,:,75) = 0._r8 + prod(:,:,76) = + extfrc(:,:,7) + prod(:,:,27) = 0._r8 + prod(:,:,48) = 0._r8 + prod(:,:,14) = 0._r8 + prod(:,:,42) = 0._r8 + prod(:,:,62) =.330_r8*rxt(:,:,25)*y(:,:,21) + extfrc(:,:,8) + prod(:,:,82) = 0._r8 + prod(:,:,83) = 0._r8 + prod(:,:,35) = + extfrc(:,:,9) + prod(:,:,19) = 0._r8 + prod(:,:,18) = 0._r8 + prod(:,:,87) =.050_r8*rxt(:,:,25)*y(:,:,21) end if end subroutine indprd end module mo_indprd diff --git a/src/chemistry/pp_waccm_mad/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_mad/mo_lin_matrix.F90 index 4ca96f2d3d..fa4cac85c2 100644 --- a/src/chemistry/pp_waccm_mad/mo_lin_matrix.F90 +++ b/src/chemistry/pp_waccm_mad/mo_lin_matrix.F90 @@ -1,9 +1,8 @@ module mo_lin_matrix - use chem_mods, only: veclen private public :: linmat contains - subroutine linmat01( avec_len, mat, y, rxt, het_rates ) + subroutine linmat01( mat, y, rxt, het_rates ) !---------------------------------------------- ! ... linear matrix entries for implicit species !---------------------------------------------- @@ -13,220 +12,213 @@ subroutine linmat01( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- ! ... 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,16) = -( rxt(k,27) + het_rates(k,1) ) - mat(k,457) = -( rxt(k,28) + het_rates(k,2) ) - mat(k,74) = rxt(k,29) - mat(k,71) = -( rxt(k,29) + rxt(k,30) + rxt(k,543) + rxt(k,546) + rxt(k,551) & - + het_rates(k,3) ) - mat(k,541) = -( rxt(k,21) + rxt(k,22) + het_rates(k,14) ) - mat(k,41) = rxt(k,23) - mat(k,572) = rxt(k,534)*y(k,20) + rxt(k,535)*y(k,20) - mat(k,257) = -( het_rates(k,18) ) - mat(k,1658) = rxt(k,446)*y(k,20) - mat(k,169) = rxt(k,502)*y(k,20) - mat(k,747) = rxt(k,531)*y(k,20) - mat(k,567) = rxt(k,533)*y(k,20) - mat(k,39) = -( rxt(k,23) + het_rates(k,19) ) - mat(k,10) = -( rxt(k,44) + het_rates(k,22) ) - mat(k,1) = -( rxt(k,45) + rxt(k,480) + het_rates(k,23) ) - mat(k,1532) = -( rxt(k,46) + het_rates(k,24) ) - mat(k,208) = rxt(k,48) - mat(k,9) = rxt(k,60) - mat(k,2) = 2.000_r8*rxt(k,480) - mat(k,201) = -( rxt(k,47) + rxt(k,48) + rxt(k,545) + rxt(k,550) + rxt(k,556) & - + het_rates(k,25) ) - mat(k,128) = -( het_rates(k,27) ) - mat(k,536) = rxt(k,21) + rxt(k,22) - mat(k,1376) = rxt(k,26) + rxt(k,62) - mat(k,1654) = rxt(k,513)*y(k,17) - mat(k,4) = -( rxt(k,49) + het_rates(k,29) ) - mat(k,561) = rxt(k,471)*y(k,6) + rxt(k,473)*y(k,9) + 2.000_r8*rxt(k,474)*y(k,10) & - + 2.000_r8*rxt(k,475)*y(k,11) + rxt(k,476)*y(k,12) & - + rxt(k,497)*y(k,7) + 2.000_r8*rxt(k,499)*y(k,34) & - + rxt(k,523)*y(k,38) + rxt(k,524)*y(k,39) - mat(k,735) = rxt(k,518)*y(k,38) + rxt(k,519)*y(k,39) - mat(k,12) = -( rxt(k,50) + het_rates(k,30) ) - mat(k,562) = rxt(k,472)*y(k,8) + rxt(k,473)*y(k,9) + rxt(k,522)*y(k,37) - mat(k,736) = rxt(k,517)*y(k,37) - mat(k,1403) = -( rxt(k,26) + rxt(k,62) + het_rates(k,28) ) - mat(k,799) = rxt(k,63) - mat(k,637) = rxt(k,65) - mat(k,120) = rxt(k,364) - mat(k,168) = -( rxt(k,502)*y(k,20) + het_rates(k,31) ) - mat(k,5) = 2.000_r8*rxt(k,49) - mat(k,13) = rxt(k,50) - mat(k,20) = rxt(k,57) - mat(k,564) = rxt(k,475)*y(k,11) + rxt(k,497)*y(k,7) - mat(k,1728) = -( het_rates(k,32) ) - mat(k,1823) = 2.000_r8*rxt(k,2) + rxt(k,3) - mat(k,558) = 2.000_r8*rxt(k,21) - mat(k,43) = rxt(k,23) - mat(k,197) = rxt(k,52) - mat(k,1494) = rxt(k,56) - mat(k,21) = rxt(k,57) - mat(k,592) = rxt(k,534)*y(k,20) - mat(k,419) = -( het_rates(k,33) ) - mat(k,1790) = rxt(k,1) - mat(k,539) = rxt(k,22) - mat(k,570) = rxt(k,535)*y(k,20) - mat(k,79) = -( rxt(k,4) + het_rates(k,35) ) - mat(k,675) = .500_r8*rxt(k,537) - mat(k,191) = -( rxt(k,52) + het_rates(k,36) ) - mat(k,1488) = -( rxt(k,56) + het_rates(k,40) ) - mat(k,349) = rxt(k,381) - mat(k,1686) = rxt(k,446)*y(k,20) + rxt(k,508)*y(k,13) + rxt(k,510)*y(k,15) & - + 2.000_r8*rxt(k,513)*y(k,17) + rxt(k,515)*y(k,21) - mat(k,19) = -( rxt(k,57) + het_rates(k,41) ) - mat(k,167) = rxt(k,502)*y(k,20) - mat(k,1107) = -( rxt(k,9) + het_rates(k,42) ) - mat(k,444) = rxt(k,270) - mat(k,234) = 2.000_r8*rxt(k,538) + 2.000_r8*rxt(k,541) + 2.000_r8*rxt(k,544) & - + 2.000_r8*rxt(k,555) - mat(k,1152) = .500_r8*rxt(k,539) - mat(k,1230) = rxt(k,540) - mat(k,76) = rxt(k,543) + rxt(k,546) + rxt(k,551) - mat(k,204) = rxt(k,545) + rxt(k,550) + rxt(k,556) - mat(k,686) = -( rxt(k,537) + het_rates(k,43) ) - mat(k,52) = rxt(k,11) + rxt(k,443) - mat(k,1667) = rxt(k,510)*y(k,15) + rxt(k,513)*y(k,17) - mat(k,754) = rxt(k,511)*y(k,15) + rxt(k,514)*y(k,17) - mat(k,574) = rxt(k,534)*y(k,20) - mat(k,51) = -( rxt(k,10) + rxt(k,11) + rxt(k,443) + het_rates(k,44) ) - mat(k,151) = -( rxt(k,58) + het_rates(k,45) ) - mat(k,72) = rxt(k,543) + rxt(k,546) + rxt(k,551) - mat(k,184) = -( rxt(k,59) + het_rates(k,46) ) - mat(k,200) = rxt(k,545) + rxt(k,550) + rxt(k,556) - mat(k,123) = -( rxt(k,12) + het_rates(k,47) ) - mat(k,270) = -( rxt(k,66) + het_rates(k,48) ) - mat(k,1734) = rxt(k,17) - mat(k,245) = rxt(k,574) - mat(k,229) = -( rxt(k,14) + rxt(k,15) + rxt(k,444) + rxt(k,538) + rxt(k,541) & - + rxt(k,544) + rxt(k,555) + het_rates(k,50) ) - mat(k,1771) = -( rxt(k,16) + rxt(k,17) + het_rates(k,51) ) - mat(k,126) = rxt(k,12) - mat(k,239) = rxt(k,15) - mat(k,1168) = rxt(k,18) + .500_r8*rxt(k,539) - mat(k,1246) = rxt(k,20) - mat(k,1370) = rxt(k,571) - mat(k,64) = rxt(k,584) - mat(k,593) = 2.000_r8*rxt(k,437)*y(k,49) - mat(k,1153) = -( rxt(k,18) + rxt(k,539) + het_rates(k,52) ) - mat(k,1108) = rxt(k,9) - mat(k,54) = rxt(k,11) + rxt(k,443) - mat(k,235) = rxt(k,14) + rxt(k,444) - mat(k,1231) = rxt(k,19) - mat(k,77) = rxt(k,29) - mat(k,205) = rxt(k,48) - mat(k,721) = rxt(k,75) - mat(k,1233) = -( rxt(k,19) + rxt(k,20) + rxt(k,540) + het_rates(k,53) ) - mat(k,55) = rxt(k,10) - mat(k,237) = rxt(k,14) + rxt(k,15) + rxt(k,444) - mat(k,78) = rxt(k,30) - mat(k,206) = rxt(k,47) - mat(k,663) = rxt(k,76) - mat(k,979) = -( rxt(k,77) + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) & - + rxt(k,82) + het_rates(k,54) ) - mat(k,1805) = rxt(k,2) - mat(k,1270) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,83) + 2.000_r8*rxt(k,84) & - + rxt(k,85) + rxt(k,87) + 2.000_r8*rxt(k,89) + rxt(k,90) + rxt(k,91) & - + rxt(k,92) - mat(k,1431) = rxt(k,8) - mat(k,233) = rxt(k,15) - mat(k,1752) = rxt(k,17) - mat(k,1149) = rxt(k,18) - mat(k,1227) = rxt(k,19) - mat(k,1393) = rxt(k,26) + rxt(k,62) - mat(k,462) = rxt(k,28) - mat(k,1519) = rxt(k,46) - mat(k,8) = rxt(k,60) - mat(k,1631) = rxt(k,99) + rxt(k,353) - mat(k,577) = rxt(k,386) - mat(k,68) = rxt(k,578) - mat(k,63) = rxt(k,583) - mat(k,1277) = -( rxt(k,5) + rxt(k,6) + rxt(k,83) + rxt(k,84) + rxt(k,85) & - + rxt(k,86) + rxt(k,87) + rxt(k,88) + rxt(k,89) + rxt(k,90) & - + rxt(k,91) + rxt(k,92) + het_rates(k,55) ) - mat(k,1438) = rxt(k,8) - mat(k,1234) = rxt(k,20) - mat(k,1313) = rxt(k,93) + rxt(k,132) - mat(k,408) = rxt(k,95) - mat(k,99) = rxt(k,97) - mat(k,222) = rxt(k,382) + rxt(k,390) - mat(k,32) = rxt(k,383) - mat(k,582) = rxt(k,438)*y(k,49) - mat(k,1442) = -( rxt(k,7) + rxt(k,8) + het_rates(k,56) ) - mat(k,411) = rxt(k,96) - mat(k,7) = -( rxt(k,60) + het_rates(k,57) ) - mat(k,328) = -( het_rates(k,59) ) - mat(k,17) = rxt(k,27) - mat(k,456) = rxt(k,28) - mat(k,73) = rxt(k,30) - mat(k,192) = rxt(k,52) - mat(k,152) = rxt(k,58) - mat(k,569) = rxt(k,471)*y(k,6) + rxt(k,497)*y(k,7) + 3.000_r8*rxt(k,498)*y(k,21) & - + 2.000_r8*rxt(k,499)*y(k,34) + 2.000_r8*rxt(k,520)*y(k,13) & - + rxt(k,521)*y(k,15) - mat(k,1659) = 2.000_r8*rxt(k,508)*y(k,13) + rxt(k,510)*y(k,15) & - + 3.000_r8*rxt(k,515)*y(k,21) - mat(k,749) = 2.000_r8*rxt(k,509)*y(k,13) + rxt(k,511)*y(k,15) & - + 3.000_r8*rxt(k,516)*y(k,21) - mat(k,1691) = -( rxt(k,446)*y(k,20) + rxt(k,508)*y(k,13) + rxt(k,510)*y(k,15) & - + rxt(k,513)*y(k,17) + rxt(k,515)*y(k,21) + het_rates(k,60) ) - mat(k,18) = rxt(k,27) - mat(k,11) = 2.000_r8*rxt(k,44) - mat(k,3) = 2.000_r8*rxt(k,45) - mat(k,1536) = rxt(k,46) - mat(k,209) = rxt(k,47) - mat(k,15) = rxt(k,50) - mat(k,1493) = rxt(k,56) - mat(k,189) = rxt(k,59) - mat(k,591) = 4.000_r8*rxt(k,470)*y(k,5) + rxt(k,471)*y(k,6) & - + 2.000_r8*rxt(k,472)*y(k,8) + 2.000_r8*rxt(k,473)*y(k,9) & - + 2.000_r8*rxt(k,474)*y(k,10) + rxt(k,475)*y(k,11) & - + 2.000_r8*rxt(k,476)*y(k,12) + rxt(k,522)*y(k,37) & - + rxt(k,523)*y(k,38) + rxt(k,524)*y(k,39) - mat(k,773) = 3.000_r8*rxt(k,512)*y(k,16) + rxt(k,514)*y(k,17) & - + rxt(k,517)*y(k,37) + rxt(k,518)*y(k,38) + rxt(k,519)*y(k,39) - mat(k,597) = -( het_rates(k,61) ) - mat(k,357) = rxt(k,380) - mat(k,341) = rxt(k,381) - mat(k,356) = -( rxt(k,380) + het_rates(k,62) ) - mat(k,340) = -( rxt(k,381) + het_rates(k,63) ) - mat(k,211) = -( het_rates(k,64) ) - mat(k,785) = -( rxt(k,63) + het_rates(k,65) ) - mat(k,501) = rxt(k,64) + rxt(k,278) - mat(k,311) = -( rxt(k,279) + het_rates(k,66) ) - mat(k,497) = -( rxt(k,64) + rxt(k,278) + het_rates(k,67) ) - mat(k,312) = rxt(k,279) - mat(k,619) = -( rxt(k,65) + het_rates(k,68) ) - mat(k,1023) = -( het_rates(k,69) ) - mat(k,1753) = rxt(k,16) - mat(k,276) = rxt(k,66) - mat(k,718) = rxt(k,75) - mat(k,658) = rxt(k,76) - mat(k,980) = rxt(k,77) + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) & - + rxt(k,82) - mat(k,1271) = rxt(k,83) + rxt(k,85) + rxt(k,86) + rxt(k,87) + rxt(k,88) & - + rxt(k,90) + rxt(k,91) + rxt(k,92) - mat(k,1307) = rxt(k,93) + rxt(k,132) - mat(k,406) = rxt(k,96) - mat(k,1596) = rxt(k,98) - mat(k,1632) = rxt(k,99) + rxt(k,353) - mat(k,33) = -( het_rates(k,70) ) - mat(k,297) = -( het_rates(k,71) ) - end do + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(320) = -( het_rates(1) ) + mat(17) = rxt(27) + mat(410) = rxt(28) + mat(92) = rxt(30) + mat(180) = rxt(52) + mat(165) = rxt(58) + mat(556) = rxt(471)*y(7) + rxt(497)*y(8) + 3.000_r8*rxt(498)*y(22) & + + 2.000_r8*rxt(499)*y(36) + 2.000_r8*rxt(520)*y(14) + rxt(521)*y(16) + mat(1180) = 2.000_r8*rxt(508)*y(14) + rxt(510)*y(16) + 3.000_r8*rxt(515)*y(22) + mat(705) = 2.000_r8*rxt(509)*y(14) + rxt(511)*y(16) + 3.000_r8*rxt(516)*y(22) + mat(16) = -( rxt(27) + het_rates(2) ) + mat(411) = -( rxt(28) + het_rates(3) ) + mat(93) = rxt(29) + mat(90) = -( rxt(29) + rxt(30) + rxt(543) + rxt(546) + rxt(551) + het_rates(4) ) + mat(529) = -( rxt(21) + rxt(22) + het_rates(15) ) + mat(35) = rxt(23) + mat(559) = rxt(534)*y(21) + rxt(535)*y(21) + mat(266) = -( het_rates(19) ) + mat(1179) = rxt(446)*y(21) + mat(156) = rxt(502)*y(21) + mat(704) = rxt(531)*y(21) + mat(554) = rxt(533)*y(21) + mat(33) = -( rxt(23) + het_rates(20) ) + mat(1201) = -( rxt(446)*y(21) + rxt(508)*y(14) + rxt(510)*y(16) + rxt(513)*y(18) & + + rxt(515)*y(22) + het_rates(23) ) + mat(18) = rxt(27) + mat(11) = 2.000_r8*rxt(44) + mat(3) = 2.000_r8*rxt(45) + mat(1116) = rxt(46) + mat(224) = rxt(47) + mat(15) = rxt(50) + mat(912) = rxt(56) + mat(192) = rxt(59) + mat(569) = 4.000_r8*rxt(470)*y(6) + rxt(471)*y(7) + 2.000_r8*rxt(472)*y(9) & + + 2.000_r8*rxt(473)*y(10) + 2.000_r8*rxt(474)*y(11) + rxt(475)*y(12) & + + 2.000_r8*rxt(476)*y(13) + rxt(522)*y(39) + rxt(523)*y(40) & + + rxt(524)*y(41) + mat(720) = 3.000_r8*rxt(512)*y(17) + rxt(514)*y(18) + rxt(517)*y(39) & + + rxt(518)*y(40) + rxt(519)*y(41) + mat(10) = -( rxt(44) + het_rates(24) ) + mat(1) = -( rxt(45) + rxt(480) + het_rates(25) ) + mat(1114) = -( rxt(46) + het_rates(26) ) + mat(223) = rxt(48) + mat(8) = rxt(60) + mat(2) = 2.000_r8*rxt(480) + mat(219) = -( rxt(47) + rxt(48) + rxt(545) + rxt(550) + rxt(556) + het_rates(27) & + ) + mat(98) = -( het_rates(29) ) + mat(524) = rxt(21) + rxt(22) + mat(1174) = rxt(513)*y(18) + mat(203) = rxt(573)*y(30) + mat(4) = -( rxt(49) + het_rates(31) ) + mat(548) = rxt(471)*y(7) + rxt(473)*y(10) + 2.000_r8*rxt(474)*y(11) & + + 2.000_r8*rxt(475)*y(12) + rxt(476)*y(13) + rxt(497)*y(8) & + + 2.000_r8*rxt(499)*y(36) + rxt(523)*y(40) + rxt(524)*y(41) + mat(691) = rxt(518)*y(40) + rxt(519)*y(41) + mat(12) = -( rxt(50) + het_rates(32) ) + mat(549) = rxt(472)*y(9) + rxt(473)*y(10) + rxt(522)*y(39) + mat(692) = rxt(517)*y(39) + mat(155) = -( rxt(502)*y(21) + het_rates(33) ) + mat(5) = 2.000_r8*rxt(49) + mat(13) = rxt(50) + mat(20) = rxt(57) + mat(551) = rxt(475)*y(12) + rxt(497)*y(8) + mat(941) = -( het_rates(34) ) + mat(1726) = 2.000_r8*rxt(2) + rxt(3) + mat(534) = 2.000_r8*rxt(21) + mat(37) = rxt(23) + mat(184) = rxt(52) + mat(906) = rxt(56) + mat(21) = rxt(57) + mat(564) = rxt(534)*y(21) + mat(431) = -( het_rates(35) ) + mat(1711) = rxt(1) + mat(528) = rxt(22) + mat(558) = rxt(535)*y(21) + mat(111) = -( rxt(4) + het_rates(37) ) + mat(659) = .500_r8*rxt(537) + mat(179) = -( rxt(52) + het_rates(38) ) + mat(905) = -( rxt(56) + het_rates(42) ) + mat(335) = rxt(381) + mat(1194) = rxt(446)*y(21) + rxt(508)*y(14) + rxt(510)*y(16) & + + 2.000_r8*rxt(513)*y(18) + rxt(515)*y(22) + mat(19) = -( rxt(57) + het_rates(43) ) + mat(154) = rxt(502)*y(21) + mat(1657) = -( rxt(9) + het_rates(44) ) + mat(461) = rxt(270) + mat(248) = 2.000_r8*rxt(538) + 2.000_r8*rxt(541) + 2.000_r8*rxt(544) & + + 2.000_r8*rxt(555) + mat(1085) = .500_r8*rxt(539) + mat(1691) = rxt(540) + mat(96) = rxt(543) + rxt(546) + rxt(551) + mat(226) = rxt(545) + rxt(550) + rxt(556) + mat(57) = -( rxt(10) + rxt(11) + rxt(443) + het_rates(45) ) + mat(164) = -( rxt(58) + het_rates(46) ) + mat(91) = rxt(543) + rxt(546) + rxt(551) + mat(188) = -( rxt(59) + het_rates(47) ) + mat(218) = rxt(545) + rxt(550) + rxt(556) + mat(124) = -( rxt(12) + het_rates(48) ) + mat(253) = -( rxt(66) + het_rates(49) ) + mat(1296) = rxt(17) + mat(207) = rxt(574) + mat(239) = -( rxt(14) + rxt(15) + rxt(444) + rxt(538) + rxt(541) + rxt(544) & + + rxt(555) + het_rates(51) ) + mat(1324) = -( rxt(16) + rxt(17) + het_rates(52) ) + mat(127) = rxt(12) + mat(244) = rxt(15) + mat(1077) = rxt(18) + .500_r8*rxt(539) + mat(1683) = rxt(20) + mat(1283) = rxt(571) + mat(82) = rxt(584) + mat(572) = 2.000_r8*rxt(437)*y(50) + mat(1071) = -( rxt(18) + rxt(539) + het_rates(53) ) + mat(1643) = rxt(9) + mat(60) = rxt(11) + rxt(443) + mat(243) = rxt(14) + rxt(444) + mat(1677) = rxt(19) + mat(94) = rxt(29) + mat(222) = rxt(48) + mat(776) = rxt(75) + mat(1692) = -( rxt(19) + rxt(20) + rxt(540) + het_rates(54) ) + mat(62) = rxt(10) + mat(249) = rxt(14) + rxt(15) + rxt(444) + mat(97) = rxt(30) + mat(227) = rxt(47) + mat(655) = rxt(76) + mat(1509) = -( rxt(77) + rxt(78) + rxt(79) + rxt(80) + rxt(81) + rxt(82) & + + het_rates(55) ) + mat(1739) = rxt(2) + mat(1166) = 2.000_r8*rxt(5) + rxt(6) + rxt(83) + 2.000_r8*rxt(84) + rxt(85) & + + rxt(87) + 2.000_r8*rxt(89) + rxt(90) + rxt(91) + rxt(92) + mat(1614) = rxt(8) + mat(247) = rxt(15) + mat(1328) = rxt(17) + mat(1081) = rxt(18) + mat(1687) = rxt(19) + mat(423) = rxt(28) + mat(1123) = rxt(46) + mat(9) = rxt(60) + mat(1576) = rxt(99) + rxt(353) + mat(574) = rxt(386) + mat(89) = rxt(578) + mat(83) = rxt(583) + mat(1158) = -( rxt(5) + rxt(6) + rxt(83) + rxt(84) + rxt(85) + rxt(86) + rxt(87) & + + rxt(88) + rxt(89) + rxt(90) + rxt(91) + rxt(92) + het_rates(56) ) + mat(1606) = rxt(8) + mat(1679) = rxt(20) + mat(1235) = rxt(93) + rxt(132) + mat(382) = rxt(95) + rxt(325)*y(30) + mat(54) = rxt(97) + rxt(330)*y(30) + mat(197) = rxt(382) + rxt(390) + mat(24) = rxt(383) + mat(568) = rxt(438)*y(50) + mat(1617) = -( rxt(7) + rxt(8) + het_rates(57) ) + mat(389) = rxt(96) + mat(7) = -( rxt(60) + het_rates(58) ) + mat(613) = -( het_rates(60) ) + mat(348) = rxt(380) + mat(332) = rxt(381) + mat(347) = -( rxt(380) + het_rates(61) ) + mat(331) = -( rxt(381) + het_rates(62) ) + mat(229) = -( het_rates(63) ) + mat(739) = -( rxt(63) + het_rates(64) ) + mat(489) = rxt(64) + rxt(278) + mat(378) = rxt(325)*y(30) + mat(1558) = rxt(347)*y(30) + mat(304) = -( rxt(279) + het_rates(65) ) + mat(486) = -( rxt(64) + rxt(278) + het_rates(66) ) + mat(305) = rxt(279) + mat(583) = -( rxt(65) + het_rates(67) ) + mat(1220) = rxt(311)*y(30) + mat(53) = rxt(330)*y(30) + mat(1410) = -( het_rates(68) ) + mat(1326) = rxt(16) + mat(263) = rxt(66) + mat(784) = rxt(75) + mat(650) = rxt(76) + mat(1507) = rxt(77) + rxt(78) + rxt(79) + rxt(80) + rxt(81) + rxt(82) + mat(1164) = rxt(83) + rxt(85) + rxt(86) + rxt(87) + rxt(88) + rxt(90) + rxt(91) & + + rxt(92) + mat(1241) = rxt(93) + rxt(132) + mat(385) = rxt(96) + mat(1539) = rxt(98) + mat(1574) = rxt(99) + rxt(353) + mat(39) = -( het_rates(69) ) + mat(277) = -( het_rates(70) ) + mat(1517) = rxt(338)*y(30) + mat(670) = -( rxt(537) + het_rates(71) ) + mat(58) = rxt(11) + rxt(443) + mat(1188) = rxt(510)*y(16) + rxt(513)*y(18) + mat(710) = rxt(511)*y(16) + rxt(514)*y(18) + mat(561) = rxt(534)*y(21) + mat(118) = -( rxt(368) + het_rates(72) ) + mat(1002) = rxt(370) + mat(1026) = -( rxt(370) + het_rates(73) ) + mat(1359) = rxt(372) + mat(25) = -( het_rates(74) ) + mat(1367) = -( rxt(372) + het_rates(75) ) + mat(1451) = rxt(374) + mat(29) = -( het_rates(76) ) + mat(1453) = -( rxt(374) + het_rates(77) ) end subroutine linmat01 - subroutine linmat02( avec_len, mat, y, rxt, het_rates ) + subroutine linmat02( mat, y, rxt, het_rates ) !---------------------------------------------- ! ... linear matrix entries for implicit species !---------------------------------------------- @@ -236,131 +228,114 @@ subroutine linmat02( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- ! ... 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,102) = -( rxt(k,368) + het_rates(k,72) ) - mat(k,810) = rxt(k,370) - mat(k,829) = -( rxt(k,370) + het_rates(k,73) ) - mat(k,1189) = rxt(k,372) - mat(k,22) = -( het_rates(k,74) ) - mat(k,1197) = -( rxt(k,372) + het_rates(k,75) ) - mat(k,1567) = rxt(k,374) - mat(k,26) = -( het_rates(k,76) ) - mat(k,1576) = -( rxt(k,374) + het_rates(k,77) ) - mat(k,134) = -( het_rates(k,78) ) - mat(k,103) = rxt(k,368) - mat(k,159) = -( het_rates(k,79) ) - mat(k,86) = -( het_rates(k,80) ) - mat(k,66) = rxt(k,578) - mat(k,60) = rxt(k,583) - mat(k,712) = -( rxt(k,75) + het_rates(k,81) ) - mat(k,372) = rxt(k,268) - mat(k,371) = -( rxt(k,268) + het_rates(k,82) ) - mat(k,652) = -( rxt(k,76) + het_rates(k,83) ) - mat(k,439) = rxt(k,270) - mat(k,520) = rxt(k,277) - mat(k,477) = -( rxt(k,269) + het_rates(k,84) ) - mat(k,519) = -( rxt(k,277) + het_rates(k,85) ) - mat(k,478) = rxt(k,269) - mat(k,385) = -( het_rates(k,86) ) - mat(k,438) = -( rxt(k,270) + het_rates(k,87) ) - mat(k,878) = -( rxt(k,365) + het_rates(k,88) ) - mat(k,1750) = rxt(k,16) - mat(k,117) = rxt(k,364) - mat(k,110) = rxt(k,366) - mat(k,1349) = rxt(k,571) - mat(k,249) = rxt(k,574) - mat(k,922) = -( het_rates(k,89) ) - mat(k,45) = -( het_rates(k,90) ) - mat(k,116) = -( rxt(k,364) + het_rates(k,91) ) - mat(k,1066) = -( het_rates(k,92) ) - mat(k,108) = -( rxt(k,366) + het_rates(k,93) ) - mat(k,853) = rxt(k,365) - mat(k,176) = -( het_rates(k,94) ) - mat(k,268) = rxt(k,66) - mat(k,61) = rxt(k,584) - mat(k,573) = -( rxt(k,386) + rxt(k,437)*y(k,49) + rxt(k,438)*y(k,49) & - + rxt(k,470)*y(k,5) + rxt(k,471)*y(k,6) + rxt(k,472)*y(k,8) & - + rxt(k,473)*y(k,9) + rxt(k,474)*y(k,10) + rxt(k,475)*y(k,11) & - + rxt(k,476)*y(k,12) + rxt(k,497)*y(k,7) + rxt(k,498)*y(k,21) & - + rxt(k,499)*y(k,34) + rxt(k,520)*y(k,13) + rxt(k,521)*y(k,15) & - + rxt(k,522)*y(k,37) + rxt(k,523)*y(k,38) + rxt(k,524)*y(k,39) & - + rxt(k,533)*y(k,20) + rxt(k,534)*y(k,20) + rxt(k,535)*y(k,20) & - + het_rates(k,95) ) - mat(k,1795) = rxt(k,1) - mat(k,1260) = rxt(k,6) - mat(k,1421) = rxt(k,7) - mat(k,219) = -( rxt(k,382) + rxt(k,390) + het_rates(k,96) ) - mat(k,1415) = rxt(k,7) - mat(k,31) = rxt(k,394) - mat(k,30) = -( rxt(k,383) + rxt(k,394) + het_rates(k,97) ) - mat(k,1314) = -( rxt(k,93) + rxt(k,132) + het_rates(k,98) ) - mat(k,635) = rxt(k,65) - mat(k,100) = rxt(k,97) - mat(k,1360) = -( rxt(k,571) + het_rates(k,99) ) - mat(k,1279) = rxt(k,86) + rxt(k,88) - mat(k,147) = rxt(k,94) - mat(k,142) = -( rxt(k,94) + het_rates(k,100) ) - mat(k,401) = -( rxt(k,95) + rxt(k,96) + het_rates(k,101) ) - mat(k,95) = -( rxt(k,97) + het_rates(k,102) ) - mat(k,285) = -( het_rates(k,103) ) - mat(k,755) = -( rxt(k,509)*y(k,13) + rxt(k,511)*y(k,15) + rxt(k,512)*y(k,16) & - + rxt(k,514)*y(k,17) + rxt(k,516)*y(k,21) + rxt(k,517)*y(k,37) & - + rxt(k,518)*y(k,38) + rxt(k,519)*y(k,39) + rxt(k,531)*y(k,20) & - + het_rates(k,104) ) - mat(k,1800) = rxt(k,3) - mat(k,81) = 2.000_r8*rxt(k,4) - mat(k,1099) = rxt(k,9) - mat(k,53) = rxt(k,10) - mat(k,124) = rxt(k,12) - mat(k,42) = rxt(k,23) - mat(k,154) = rxt(k,58) - mat(k,185) = rxt(k,59) - mat(k,1590) = rxt(k,98) - mat(k,1144) = .500_r8*rxt(k,539) - mat(k,575) = rxt(k,533)*y(k,20) - mat(k,1610) = -( rxt(k,98) + het_rates(k,105) ) - mat(k,1647) = -( rxt(k,99) + rxt(k,353) + het_rates(k,106) ) - mat(k,805) = rxt(k,63) - mat(k,413) = rxt(k,95) - mat(k,244) = -( rxt(k,574) + het_rates(k,107) ) - mat(k,960) = rxt(k,78) + rxt(k,79) - mat(k,1256) = rxt(k,85) + rxt(k,87) - mat(k,62) = rxt(k,558) - mat(k,67) = rxt(k,559) - mat(k,65) = -( rxt(k,559) + rxt(k,578) + het_rates(k,108) ) - mat(k,946) = rxt(k,80) + rxt(k,81) - mat(k,1250) = rxt(k,90) + rxt(k,91) - mat(k,59) = rxt(k,560) - mat(k,58) = -( rxt(k,558) + rxt(k,560) + rxt(k,583) + rxt(k,584) & - + het_rates(k,109) ) - mat(k,945) = rxt(k,77) + rxt(k,82) - mat(k,1249) = rxt(k,83) + rxt(k,92) - mat(k,1825) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,110) ) - mat(k,515) = rxt(k,64) + rxt(k,278) - mat(k,149) = rxt(k,94) - mat(k,384) = rxt(k,268) - mat(k,494) = rxt(k,269) - mat(k,535) = rxt(k,277) - mat(k,325) = rxt(k,279) - mat(k,107) = rxt(k,368) - mat(k,852) = rxt(k,370) - mat(k,1212) = rxt(k,372) - mat(k,1582) = rxt(k,374) - mat(k,370) = rxt(k,380) - mat(k,776) = rxt(k,509)*y(k,13) + rxt(k,511)*y(k,15) + rxt(k,512)*y(k,16) & - + rxt(k,514)*y(k,17) + rxt(k,519)*y(k,39) + rxt(k,531)*y(k,20) - end do + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + mat(130) = -( het_rates(78) ) + mat(119) = rxt(368) + mat(146) = -( het_rates(79) ) + mat(102) = -( het_rates(80) ) + mat(85) = rxt(578) + mat(79) = rxt(583) + mat(769) = -( rxt(75) + het_rates(81) ) + mat(363) = rxt(268) + mat(362) = -( rxt(268) + het_rates(82) ) + mat(636) = -( rxt(76) + het_rates(83) ) + mat(451) = rxt(270) + mat(508) = rxt(277) + mat(466) = -( rxt(269) + het_rates(84) ) + mat(507) = -( rxt(277) + het_rates(85) ) + mat(467) = rxt(269) + mat(390) = -( het_rates(86) ) + mat(450) = -( rxt(270) + het_rates(87) ) + mat(817) = -( rxt(365) + rxt(363)*y(30) + het_rates(88) ) + mat(1312) = rxt(16) + mat(72) = rxt(364) + mat(66) = rxt(366) + mat(1271) = rxt(571) + mat(211) = rxt(574) + mat(860) = -( het_rates(89) ) + mat(45) = -( het_rates(90) ) + mat(71) = -( rxt(364) + het_rates(91) ) + mat(65) = rxt(307)*y(30) + mat(794) = rxt(363)*y(30) + mat(983) = -( het_rates(92) ) + mat(64) = -( rxt(366) + rxt(307)*y(30) + het_rates(93) ) + mat(793) = rxt(365) + mat(172) = -( het_rates(94) ) + mat(251) = rxt(66) + mat(80) = rxt(584) + mat(560) = -( rxt(386) + rxt(437)*y(50) + rxt(438)*y(50) + rxt(470)*y(6) & + + rxt(471)*y(7) + rxt(472)*y(9) + rxt(473)*y(10) + rxt(474)*y(11) & + + rxt(475)*y(12) + rxt(476)*y(13) + rxt(497)*y(8) + rxt(498)*y(22) & + + rxt(499)*y(36) + rxt(520)*y(14) + rxt(521)*y(16) + rxt(522)*y(39) & + + rxt(523)*y(40) + rxt(524)*y(41) + rxt(533)*y(21) + rxt(534)*y(21) & + + rxt(535)*y(21) + het_rates(95) ) + mat(1716) = rxt(1) + mat(1142) = rxt(6) + mat(1590) = rxt(7) + mat(195) = -( rxt(382) + rxt(390) + het_rates(96) ) + mat(1584) = rxt(7) + mat(23) = rxt(394) + rxt(393)*y(30) + mat(22) = -( rxt(383) + rxt(394) + rxt(393)*y(30) + het_rates(97) ) + mat(1237) = -( rxt(93) + rxt(132) + rxt(311)*y(30) + het_rates(98) ) + mat(600) = rxt(65) + mat(55) = rxt(97) + mat(1282) = -( rxt(571) + het_rates(99) ) + mat(1161) = rxt(86) + rxt(88) + mat(143) = rxt(94) + mat(214) = rxt(573)*y(30) + mat(138) = -( rxt(94) + het_rates(100) ) + mat(376) = -( rxt(95) + rxt(96) + rxt(325)*y(30) + het_rates(101) ) + mat(51) = -( rxt(97) + rxt(330)*y(30) + het_rates(102) ) + mat(292) = -( het_rates(103) ) + mat(711) = -( rxt(509)*y(14) + rxt(511)*y(16) + rxt(512)*y(17) + rxt(514)*y(18) & + + rxt(516)*y(22) + rxt(517)*y(39) + rxt(518)*y(40) + rxt(519)*y(41) & + + rxt(531)*y(21) + het_rates(104) ) + mat(1720) = rxt(3) + mat(113) = 2.000_r8*rxt(4) + mat(1634) = rxt(9) + mat(59) = rxt(10) + mat(125) = rxt(12) + mat(36) = rxt(23) + mat(167) = rxt(58) + mat(189) = rxt(59) + mat(1522) = rxt(98) + mat(1062) = .500_r8*rxt(539) + mat(562) = rxt(533)*y(21) + mat(1542) = -( rxt(98) + rxt(338)*y(30) + het_rates(105) ) + mat(1578) = -( rxt(99) + rxt(353) + rxt(347)*y(30) + het_rates(106) ) + mat(759) = rxt(63) + mat(388) = rxt(95) + mat(206) = -( rxt(574) + rxt(573)*y(30) + het_rates(107) ) + mat(1475) = rxt(78) + rxt(79) + mat(1138) = rxt(85) + rxt(87) + mat(81) = rxt(558) + mat(86) = rxt(559) + mat(84) = -( rxt(559) + rxt(578) + het_rates(108) ) + mat(1464) = rxt(80) + rxt(81) + mat(1133) = rxt(90) + rxt(91) + mat(78) = rxt(560) + mat(77) = -( rxt(558) + rxt(560) + rxt(583) + rxt(584) + het_rates(109) ) + mat(1463) = rxt(77) + rxt(82) + mat(1132) = rxt(83) + rxt(92) + mat(1745) = -( rxt(1) + rxt(2) + rxt(3) + het_rates(110) ) + mat(503) = rxt(64) + rxt(278) + mat(145) = rxt(94) + mat(375) = rxt(268) + mat(483) = rxt(269) + mat(523) = rxt(277) + mat(317) = rxt(279) + mat(123) = rxt(368) + mat(1043) = rxt(370) + mat(1376) = rxt(372) + mat(1460) = rxt(374) + mat(361) = rxt(380) + mat(731) = rxt(509)*y(14) + rxt(511)*y(16) + rxt(512)*y(17) + rxt(514)*y(18) & + + rxt(519)*y(41) + rxt(531)*y(21) end subroutine linmat02 - subroutine linmat( avec_len, mat, y, rxt, het_rates ) + subroutine linmat( mat, y, rxt, het_rates ) !---------------------------------------------- ! ... linear matrix entries for implicit species !---------------------------------------------- @@ -370,12 +345,11 @@ subroutine linmat( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- ! ... 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 ) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) + real(r8), intent(inout) :: mat(nzcnt) + call linmat01( mat, y, rxt, het_rates ) + call linmat02( mat, y, rxt, het_rates ) end subroutine linmat end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_mad/mo_lu_factor.F90 b/src/chemistry/pp_waccm_mad/mo_lu_factor.F90 index 4030975501..d8a5b66bb1 100644 --- a/src/chemistry/pp_waccm_mad/mo_lu_factor.F90 +++ b/src/chemistry/pp_waccm_mad/mo_lu_factor.F90 @@ -1,13427 +1,12280 @@ 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 + subroutine lu_fac01( lu ) 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) = lu(k,2) * lu(k,1) - lu(k,3) = lu(k,3) * lu(k,1) - lu(k,1532) = lu(k,1532) - lu(k,2) * lu(k,1497) - lu(k,1536) = lu(k,1536) - lu(k,3) * lu(k,1497) - lu(k,4) = 1._r8 / lu(k,4) - lu(k,5) = lu(k,5) * lu(k,4) - lu(k,6) = lu(k,6) * lu(k,4) - lu(k,564) = lu(k,564) - lu(k,5) * lu(k,561) - lu(k,573) = lu(k,573) - lu(k,6) * lu(k,561) - lu(k,743) = - lu(k,5) * lu(k,735) - lu(k,753) = - lu(k,6) * lu(k,735) - lu(k,7) = 1._r8 / lu(k,7) - lu(k,8) = lu(k,8) * lu(k,7) - lu(k,9) = lu(k,9) * lu(k,7) - lu(k,462) = lu(k,462) - lu(k,8) * lu(k,452) - lu(k,470) = lu(k,470) - lu(k,9) * lu(k,452) - lu(k,1519) = lu(k,1519) - lu(k,8) * lu(k,1498) - lu(k,1532) = lu(k,1532) - lu(k,9) * lu(k,1498) - lu(k,10) = 1._r8 / lu(k,10) - lu(k,11) = lu(k,11) * lu(k,10) - lu(k,189) = lu(k,189) - lu(k,11) * lu(k,183) - lu(k,209) = lu(k,209) - lu(k,11) * lu(k,199) - lu(k,1493) = lu(k,1493) - lu(k,11) * lu(k,1452) - lu(k,1536) = lu(k,1536) - lu(k,11) * lu(k,1499) - lu(k,1691) = lu(k,1691) - lu(k,11) * lu(k,1652) - lu(k,12) = 1._r8 / lu(k,12) - lu(k,13) = lu(k,13) * lu(k,12) - lu(k,14) = lu(k,14) * lu(k,12) - lu(k,15) = lu(k,15) * lu(k,12) - lu(k,564) = lu(k,564) - lu(k,13) * lu(k,562) - lu(k,573) = lu(k,573) - lu(k,14) * lu(k,562) - lu(k,591) = lu(k,591) - lu(k,15) * lu(k,562) - lu(k,743) = lu(k,743) - lu(k,13) * lu(k,736) - lu(k,753) = lu(k,753) - lu(k,14) * lu(k,736) - lu(k,773) = lu(k,773) - lu(k,15) * lu(k,736) - lu(k,16) = 1._r8 / lu(k,16) - lu(k,17) = lu(k,17) * lu(k,16) - lu(k,18) = lu(k,18) * lu(k,16) - lu(k,152) = lu(k,152) - lu(k,17) * lu(k,150) - lu(k,157) = - lu(k,18) * lu(k,150) - lu(k,456) = lu(k,456) - lu(k,17) * lu(k,453) - lu(k,471) = lu(k,471) - lu(k,18) * lu(k,453) - lu(k,1458) = - lu(k,17) * lu(k,1453) - lu(k,1493) = lu(k,1493) - lu(k,18) * lu(k,1453) - lu(k,1505) = lu(k,1505) - lu(k,17) * lu(k,1500) - lu(k,1536) = lu(k,1536) - lu(k,18) * lu(k,1500) - lu(k,19) = 1._r8 / lu(k,19) - lu(k,20) = lu(k,20) * lu(k,19) - lu(k,21) = lu(k,21) * lu(k,19) - lu(k,168) = lu(k,168) - lu(k,20) * lu(k,167) - lu(k,174) = lu(k,174) - lu(k,21) * lu(k,167) - lu(k,417) = lu(k,417) - lu(k,20) * lu(k,416) - lu(k,435) = lu(k,435) - lu(k,21) * lu(k,416) - lu(k,1087) = lu(k,1087) - lu(k,20) * lu(k,1085) - lu(k,1122) = - lu(k,21) * lu(k,1085) - lu(k,1784) = lu(k,1784) - lu(k,20) * lu(k,1773) - lu(k,1823) = lu(k,1823) - lu(k,21) * lu(k,1773) - lu(k,22) = 1._r8 / lu(k,22) - lu(k,23) = lu(k,23) * lu(k,22) - lu(k,24) = lu(k,24) * lu(k,22) - lu(k,25) = lu(k,25) * lu(k,22) - lu(k,234) = lu(k,234) - lu(k,23) * lu(k,227) - lu(k,236) = lu(k,236) - lu(k,24) * lu(k,227) - lu(k,240) = lu(k,240) - lu(k,25) * lu(k,227) - lu(k,1195) = lu(k,1195) - lu(k,23) * lu(k,1170) - lu(k,1197) = lu(k,1197) - lu(k,24) * lu(k,1170) - lu(k,1212) = lu(k,1212) - lu(k,25) * lu(k,1170) - lu(k,1808) = lu(k,1808) - lu(k,23) * lu(k,1774) - lu(k,1810) = lu(k,1810) - lu(k,24) * lu(k,1774) - lu(k,1825) = lu(k,1825) - lu(k,25) * lu(k,1774) - lu(k,26) = 1._r8 / lu(k,26) - lu(k,27) = lu(k,27) * lu(k,26) - lu(k,28) = lu(k,28) * lu(k,26) - lu(k,29) = lu(k,29) * lu(k,26) - lu(k,234) = lu(k,234) - lu(k,27) * lu(k,228) - lu(k,238) = lu(k,238) - lu(k,28) * lu(k,228) - lu(k,240) = lu(k,240) - lu(k,29) * lu(k,228) - lu(k,1565) = lu(k,1565) - lu(k,27) * lu(k,1540) - lu(k,1576) = lu(k,1576) - lu(k,28) * lu(k,1540) - lu(k,1582) = lu(k,1582) - lu(k,29) * lu(k,1540) - lu(k,1808) = lu(k,1808) - lu(k,27) * lu(k,1775) - lu(k,1819) = lu(k,1819) - lu(k,28) * lu(k,1775) - lu(k,1825) = lu(k,1825) - lu(k,29) * lu(k,1775) - lu(k,30) = 1._r8 / lu(k,30) - lu(k,31) = lu(k,31) * lu(k,30) - lu(k,32) = lu(k,32) * lu(k,30) - lu(k,566) = - lu(k,31) * lu(k,563) - lu(k,582) = lu(k,582) - lu(k,32) * lu(k,563) - lu(k,959) = lu(k,959) - lu(k,31) * lu(k,944) - lu(k,986) = lu(k,986) - lu(k,32) * lu(k,944) - lu(k,1255) = lu(k,1255) - lu(k,31) * lu(k,1248) - lu(k,1277) = lu(k,1277) - lu(k,32) * lu(k,1248) - lu(k,1377) = lu(k,1377) - lu(k,31) * lu(k,1372) - lu(k,1400) = lu(k,1400) - lu(k,32) * lu(k,1372) - lu(k,1415) = lu(k,1415) - lu(k,31) * lu(k,1414) - lu(k,1438) = lu(k,1438) - lu(k,32) * lu(k,1414) - lu(k,33) = 1._r8 / lu(k,33) - lu(k,34) = lu(k,34) * lu(k,33) - lu(k,35) = lu(k,35) * lu(k,33) - lu(k,36) = lu(k,36) * lu(k,33) - lu(k,37) = lu(k,37) * lu(k,33) - lu(k,38) = lu(k,38) * lu(k,33) - lu(k,140) = - lu(k,34) * lu(k,139) - lu(k,143) = lu(k,143) - lu(k,35) * lu(k,139) - lu(k,145) = lu(k,145) - lu(k,36) * lu(k,139) - lu(k,148) = - lu(k,37) * lu(k,139) - lu(k,149) = lu(k,149) - lu(k,38) * lu(k,139) - lu(k,1005) = lu(k,1005) - lu(k,34) * lu(k,1000) - lu(k,1018) = lu(k,1018) - lu(k,35) * lu(k,1000) - lu(k,1023) = lu(k,1023) - lu(k,36) * lu(k,1000) - lu(k,1040) = lu(k,1040) - lu(k,37) * lu(k,1000) - lu(k,1042) = lu(k,1042) - lu(k,38) * lu(k,1000) - lu(k,1778) = lu(k,1778) - lu(k,34) * lu(k,1776) - lu(k,1800) = lu(k,1800) - lu(k,35) * lu(k,1776) - lu(k,1806) = - lu(k,36) * lu(k,1776) - lu(k,1823) = lu(k,1823) - lu(k,37) * lu(k,1776) - lu(k,1825) = lu(k,1825) - lu(k,38) * lu(k,1776) - 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,42) = lu(k,42) * lu(k,39) - lu(k,43) = lu(k,43) * lu(k,39) - lu(k,44) = lu(k,44) * lu(k,39) - lu(k,257) = lu(k,257) - lu(k,40) * lu(k,256) - lu(k,258) = lu(k,258) - lu(k,41) * lu(k,256) - lu(k,260) = - lu(k,42) * lu(k,256) - lu(k,265) = - lu(k,43) * lu(k,256) - lu(k,267) = - lu(k,44) * lu(k,256) - lu(k,680) = lu(k,680) - lu(k,40) * lu(k,673) - lu(k,684) = - lu(k,41) * lu(k,673) - lu(k,687) = lu(k,687) - lu(k,42) * lu(k,673) - lu(k,705) = lu(k,705) - lu(k,43) * lu(k,673) - lu(k,707) = lu(k,707) - lu(k,44) * lu(k,673) - lu(k,747) = lu(k,747) - lu(k,40) * lu(k,737) - lu(k,752) = lu(k,752) - lu(k,41) * lu(k,737) - lu(k,755) = lu(k,755) - lu(k,42) * lu(k,737) - lu(k,774) = lu(k,774) - lu(k,43) * lu(k,737) - lu(k,776) = lu(k,776) - lu(k,44) * lu(k,737) - end do + real(r8), intent(inout) :: lu(:) + lu(1) = 1._r8 / lu(1) + lu(2) = lu(2) * lu(1) + lu(3) = lu(3) * lu(1) + lu(1114) = lu(1114) - lu(2) * lu(1088) + lu(1116) = lu(1116) - lu(3) * lu(1088) + lu(4) = 1._r8 / lu(4) + lu(5) = lu(5) * lu(4) + lu(6) = lu(6) * lu(4) + lu(551) = lu(551) - lu(5) * lu(548) + lu(560) = lu(560) - lu(6) * lu(548) + lu(699) = - lu(5) * lu(691) + lu(709) = - lu(6) * lu(691) + lu(7) = 1._r8 / lu(7) + lu(8) = lu(8) * lu(7) + lu(9) = lu(9) * lu(7) + lu(419) = lu(419) - lu(8) * lu(406) + lu(423) = lu(423) - lu(9) * lu(406) + lu(1114) = lu(1114) - lu(8) * lu(1089) + lu(1123) = lu(1123) - lu(9) * lu(1089) + lu(10) = 1._r8 / lu(10) + lu(11) = lu(11) * lu(10) + lu(192) = lu(192) - lu(11) * lu(187) + lu(224) = lu(224) - lu(11) * lu(217) + lu(912) = lu(912) - lu(11) * lu(882) + lu(1116) = lu(1116) - lu(11) * lu(1090) + lu(1201) = lu(1201) - lu(11) * lu(1173) + lu(12) = 1._r8 / lu(12) + lu(13) = lu(13) * lu(12) + lu(14) = lu(14) * lu(12) + lu(15) = lu(15) * lu(12) + lu(551) = lu(551) - lu(13) * lu(549) + lu(560) = lu(560) - lu(14) * lu(549) + lu(569) = lu(569) - lu(15) * lu(549) + lu(699) = lu(699) - lu(13) * lu(692) + lu(709) = lu(709) - lu(14) * lu(692) + lu(720) = lu(720) - lu(15) * lu(692) + lu(16) = 1._r8 / lu(16) + lu(17) = lu(17) * lu(16) + lu(18) = lu(18) * lu(16) + lu(165) = lu(165) - lu(17) * lu(163) + lu(169) = - lu(18) * lu(163) + lu(410) = lu(410) - lu(17) * lu(407) + lu(421) = lu(421) - lu(18) * lu(407) + lu(888) = - lu(17) * lu(883) + lu(912) = lu(912) - lu(18) * lu(883) + lu(1096) = lu(1096) - lu(17) * lu(1091) + lu(1116) = lu(1116) - lu(18) * lu(1091) + lu(19) = 1._r8 / lu(19) + lu(20) = lu(20) * lu(19) + lu(21) = lu(21) * lu(19) + lu(155) = lu(155) - lu(20) * lu(154) + lu(159) = lu(159) - lu(21) * lu(154) + lu(429) = lu(429) - lu(20) * lu(428) + lu(437) = lu(437) - lu(21) * lu(428) + lu(1623) = lu(1623) - lu(20) * lu(1621) + lu(1640) = - lu(21) * lu(1621) + lu(1705) = lu(1705) - lu(20) * lu(1694) + lu(1726) = lu(1726) - lu(21) * lu(1694) + lu(22) = 1._r8 / lu(22) + lu(23) = lu(23) * lu(22) + lu(24) = lu(24) * lu(22) + lu(553) = - lu(23) * lu(550) + lu(568) = lu(568) - lu(24) * lu(550) + lu(1137) = lu(1137) - lu(23) * lu(1130) + lu(1158) = lu(1158) - lu(24) * lu(1130) + lu(1474) = lu(1474) - lu(23) * lu(1461) + lu(1501) = lu(1501) - lu(24) * lu(1461) + lu(1584) = lu(1584) - lu(23) * lu(1583) + lu(1606) = lu(1606) - lu(24) * lu(1583) + lu(25) = 1._r8 / lu(25) + lu(26) = lu(26) * lu(25) + lu(27) = lu(27) * lu(25) + lu(28) = lu(28) * lu(25) + lu(245) = lu(245) - lu(26) * lu(237) + lu(248) = lu(248) - lu(27) * lu(237) + lu(250) = lu(250) - lu(28) * lu(237) + lu(1367) = lu(1367) - lu(26) * lu(1335) + lu(1374) = lu(1374) - lu(27) * lu(1335) + lu(1376) = lu(1376) - lu(28) * lu(1335) + lu(1736) = lu(1736) - lu(26) * lu(1695) + lu(1743) = lu(1743) - lu(27) * lu(1695) + lu(1745) = lu(1745) - lu(28) * lu(1695) + lu(29) = 1._r8 / lu(29) + lu(30) = lu(30) * lu(29) + lu(31) = lu(31) * lu(29) + lu(32) = lu(32) * lu(29) + lu(246) = lu(246) - lu(30) * lu(238) + lu(248) = lu(248) - lu(31) * lu(238) + lu(250) = lu(250) - lu(32) * lu(238) + lu(1453) = lu(1453) - lu(30) * lu(1419) + lu(1458) = lu(1458) - lu(31) * lu(1419) + lu(1460) = lu(1460) - lu(32) * lu(1419) + lu(1738) = lu(1738) - lu(30) * lu(1696) + lu(1743) = lu(1743) - lu(31) * lu(1696) + lu(1745) = lu(1745) - lu(32) * lu(1696) + lu(33) = 1._r8 / lu(33) + lu(34) = lu(34) * lu(33) + lu(35) = lu(35) * lu(33) + lu(36) = lu(36) * lu(33) + lu(37) = lu(37) * lu(33) + lu(38) = lu(38) * lu(33) + lu(266) = lu(266) - lu(34) * lu(265) + lu(267) = lu(267) - lu(35) * lu(265) + lu(269) = - lu(36) * lu(265) + lu(270) = - lu(37) * lu(265) + lu(276) = - lu(38) * lu(265) + lu(664) = lu(664) - lu(34) * lu(657) + lu(668) = - lu(35) * lu(657) + lu(671) = lu(671) - lu(36) * lu(657) + lu(673) = lu(673) - lu(37) * lu(657) + lu(690) = lu(690) - lu(38) * lu(657) + lu(704) = lu(704) - lu(34) * lu(693) + lu(708) = lu(708) - lu(35) * lu(693) + lu(711) = lu(711) - lu(36) * lu(693) + lu(714) = lu(714) - lu(37) * lu(693) + lu(731) = lu(731) - lu(38) * lu(693) + lu(39) = 1._r8 / lu(39) + lu(40) = lu(40) * lu(39) + lu(41) = lu(41) * lu(39) + lu(42) = lu(42) * lu(39) + lu(43) = lu(43) * lu(39) + lu(44) = lu(44) * lu(39) + lu(136) = - lu(40) * lu(135) + lu(139) = lu(139) - lu(41) * lu(135) + lu(140) = - lu(42) * lu(135) + lu(144) = lu(144) - lu(43) * lu(135) + lu(145) = lu(145) - lu(44) * lu(135) + lu(1384) = lu(1384) - lu(40) * lu(1377) + lu(1395) = lu(1395) - lu(41) * lu(1377) + lu(1399) = lu(1399) - lu(42) * lu(1377) + lu(1410) = lu(1410) - lu(43) * lu(1377) + lu(1418) = lu(1418) - lu(44) * lu(1377) + lu(1701) = lu(1701) - lu(40) * lu(1697) + lu(1720) = lu(1720) - lu(41) * lu(1697) + lu(1726) = lu(1726) - lu(42) * lu(1697) + lu(1737) = - lu(43) * lu(1697) + lu(1745) = lu(1745) - lu(44) * lu(1697) end subroutine lu_fac01 - subroutine lu_fac02( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac02( lu ) 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,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,48) = lu(k,48) * lu(k,45) - lu(k,49) = lu(k,49) * lu(k,45) - lu(k,50) = lu(k,50) * lu(k,45) - lu(k,902) = - lu(k,46) * lu(k,901) - lu(k,920) = - lu(k,47) * lu(k,901) - lu(k,924) = lu(k,924) - lu(k,48) * lu(k,901) - lu(k,942) = lu(k,942) - lu(k,49) * lu(k,901) - lu(k,943) = lu(k,943) - lu(k,50) * lu(k,901) - lu(k,1008) = - lu(k,46) * lu(k,1001) - lu(k,1019) = lu(k,1019) - lu(k,47) * lu(k,1001) - lu(k,1023) = lu(k,1023) - lu(k,48) * lu(k,1001) - lu(k,1041) = lu(k,1041) - lu(k,49) * lu(k,1001) - lu(k,1042) = lu(k,1042) - lu(k,50) * lu(k,1001) - lu(k,1781) = lu(k,1781) - lu(k,46) * lu(k,1777) - lu(k,1802) = lu(k,1802) - lu(k,47) * lu(k,1777) - lu(k,1806) = lu(k,1806) - lu(k,48) * lu(k,1777) - lu(k,1824) = - lu(k,49) * lu(k,1777) - lu(k,1825) = lu(k,1825) - lu(k,50) * lu(k,1777) - 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,54) = lu(k,54) * lu(k,51) - lu(k,55) = lu(k,55) * lu(k,51) - lu(k,56) = lu(k,56) * lu(k,51) - lu(k,57) = lu(k,57) * lu(k,51) - lu(k,686) = lu(k,686) - lu(k,52) * lu(k,674) - lu(k,687) = lu(k,687) - lu(k,53) * lu(k,674) - lu(k,693) = lu(k,693) - lu(k,54) * lu(k,674) - lu(k,694) = lu(k,694) - lu(k,55) * lu(k,674) - lu(k,695) = lu(k,695) - lu(k,56) * lu(k,674) - lu(k,707) = lu(k,707) - lu(k,57) * lu(k,674) - lu(k,754) = lu(k,754) - lu(k,52) * lu(k,738) - lu(k,755) = lu(k,755) - lu(k,53) * lu(k,738) - lu(k,762) = lu(k,762) - lu(k,54) * lu(k,738) - lu(k,763) = lu(k,763) - lu(k,55) * lu(k,738) - lu(k,764) = lu(k,764) - lu(k,56) * lu(k,738) - lu(k,776) = lu(k,776) - lu(k,57) * lu(k,738) - lu(k,1142) = lu(k,1142) - lu(k,52) * lu(k,1125) - lu(k,1144) = lu(k,1144) - lu(k,53) * lu(k,1125) - lu(k,1153) = lu(k,1153) - lu(k,54) * lu(k,1125) - lu(k,1155) = lu(k,1155) - lu(k,55) * lu(k,1125) - lu(k,1156) = lu(k,1156) - lu(k,56) * lu(k,1125) - lu(k,1169) = lu(k,1169) - lu(k,57) * lu(k,1125) - lu(k,58) = 1._r8 / lu(k,58) - lu(k,59) = lu(k,59) * lu(k,58) - lu(k,60) = lu(k,60) * lu(k,58) - lu(k,61) = lu(k,61) * lu(k,58) - lu(k,62) = lu(k,62) * lu(k,58) - lu(k,63) = lu(k,63) * lu(k,58) - lu(k,64) = lu(k,64) * lu(k,58) - lu(k,946) = lu(k,946) - lu(k,59) * lu(k,945) - lu(k,949) = lu(k,949) - lu(k,60) * lu(k,945) - lu(k,954) = lu(k,954) - lu(k,61) * lu(k,945) - lu(k,960) = lu(k,960) - lu(k,62) * lu(k,945) - lu(k,979) = lu(k,979) - lu(k,63) * lu(k,945) - lu(k,998) = lu(k,998) - lu(k,64) * lu(k,945) - lu(k,1003) = lu(k,1003) - lu(k,59) * lu(k,1002) - lu(k,1004) = lu(k,1004) - lu(k,60) * lu(k,1002) - lu(k,1012) = - lu(k,61) * lu(k,1002) - lu(k,1013) = lu(k,1013) - lu(k,62) * lu(k,1002) - lu(k,1022) = lu(k,1022) - lu(k,63) * lu(k,1002) - lu(k,1041) = lu(k,1041) - lu(k,64) * lu(k,1002) - lu(k,1250) = lu(k,1250) - lu(k,59) * lu(k,1249) - lu(k,1251) = lu(k,1251) - lu(k,60) * lu(k,1249) - lu(k,1254) = lu(k,1254) - lu(k,61) * lu(k,1249) - lu(k,1256) = lu(k,1256) - lu(k,62) * lu(k,1249) - lu(k,1270) = lu(k,1270) - lu(k,63) * lu(k,1249) - lu(k,1289) = lu(k,1289) - lu(k,64) * lu(k,1249) - lu(k,65) = 1._r8 / lu(k,65) - lu(k,66) = lu(k,66) * lu(k,65) - lu(k,67) = lu(k,67) * lu(k,65) - lu(k,68) = lu(k,68) * lu(k,65) - lu(k,69) = lu(k,69) * lu(k,65) - lu(k,70) = lu(k,70) * lu(k,65) - lu(k,949) = lu(k,949) - lu(k,66) * lu(k,946) - lu(k,960) = lu(k,960) - lu(k,67) * lu(k,946) - lu(k,979) = lu(k,979) - lu(k,68) * lu(k,946) - lu(k,986) = lu(k,986) - lu(k,69) * lu(k,946) - lu(k,988) = lu(k,988) - lu(k,70) * lu(k,946) - lu(k,1004) = lu(k,1004) - lu(k,66) * lu(k,1003) - lu(k,1013) = lu(k,1013) - lu(k,67) * lu(k,1003) - lu(k,1022) = lu(k,1022) - lu(k,68) * lu(k,1003) - lu(k,1029) = lu(k,1029) - lu(k,69) * lu(k,1003) - lu(k,1031) = lu(k,1031) - lu(k,70) * lu(k,1003) - lu(k,1251) = lu(k,1251) - lu(k,66) * lu(k,1250) - lu(k,1256) = lu(k,1256) - lu(k,67) * lu(k,1250) - lu(k,1270) = lu(k,1270) - lu(k,68) * lu(k,1250) - lu(k,1277) = lu(k,1277) - lu(k,69) * lu(k,1250) - lu(k,1279) = lu(k,1279) - lu(k,70) * lu(k,1250) - lu(k,71) = 1._r8 / lu(k,71) - lu(k,72) = lu(k,72) * lu(k,71) - lu(k,73) = lu(k,73) * lu(k,71) - lu(k,74) = lu(k,74) * lu(k,71) - lu(k,75) = lu(k,75) * lu(k,71) - lu(k,76) = lu(k,76) * lu(k,71) - lu(k,77) = lu(k,77) * lu(k,71) - lu(k,78) = lu(k,78) * lu(k,71) - lu(k,455) = lu(k,455) - lu(k,72) * lu(k,454) - lu(k,456) = lu(k,456) - lu(k,73) * lu(k,454) - lu(k,457) = lu(k,457) - lu(k,74) * lu(k,454) - lu(k,462) = lu(k,462) - lu(k,75) * lu(k,454) - lu(k,463) = - lu(k,76) * lu(k,454) - lu(k,464) = lu(k,464) - lu(k,77) * lu(k,454) - lu(k,465) = - lu(k,78) * lu(k,454) - lu(k,952) = lu(k,952) - lu(k,72) * lu(k,947) - lu(k,963) = lu(k,963) - lu(k,73) * lu(k,947) - lu(k,966) = lu(k,966) - lu(k,74) * lu(k,947) - lu(k,979) = lu(k,979) - lu(k,75) * lu(k,947) - lu(k,982) = - lu(k,76) * lu(k,947) - lu(k,983) = lu(k,983) - lu(k,77) * lu(k,947) - lu(k,985) = lu(k,985) - lu(k,78) * lu(k,947) - lu(k,1127) = - lu(k,72) * lu(k,1126) - lu(k,1131) = - lu(k,73) * lu(k,1126) - lu(k,1134) = lu(k,1134) - lu(k,74) * lu(k,1126) - lu(k,1149) = lu(k,1149) - lu(k,75) * lu(k,1126) - lu(k,1152) = lu(k,1152) - lu(k,76) * lu(k,1126) - lu(k,1153) = lu(k,1153) - lu(k,77) * lu(k,1126) - lu(k,1155) = lu(k,1155) - lu(k,78) * lu(k,1126) - lu(k,79) = 1._r8 / lu(k,79) - lu(k,80) = lu(k,80) * lu(k,79) - lu(k,81) = lu(k,81) * lu(k,79) - lu(k,82) = lu(k,82) * lu(k,79) - lu(k,83) = lu(k,83) * lu(k,79) - lu(k,84) = lu(k,84) * lu(k,79) - lu(k,85) = lu(k,85) * lu(k,79) - lu(k,686) = lu(k,686) - lu(k,80) * lu(k,675) - lu(k,687) = lu(k,687) - lu(k,81) * lu(k,675) - lu(k,689) = lu(k,689) - lu(k,82) * lu(k,675) - lu(k,700) = lu(k,700) - lu(k,83) * lu(k,675) - lu(k,704) = lu(k,704) - lu(k,84) * lu(k,675) - lu(k,707) = lu(k,707) - lu(k,85) * lu(k,675) - lu(k,754) = lu(k,754) - lu(k,80) * lu(k,739) - lu(k,755) = lu(k,755) - lu(k,81) * lu(k,739) - lu(k,758) = lu(k,758) - lu(k,82) * lu(k,739) - lu(k,769) = lu(k,769) - lu(k,83) * lu(k,739) - lu(k,773) = lu(k,773) - lu(k,84) * lu(k,739) - lu(k,776) = lu(k,776) - lu(k,85) * lu(k,739) - lu(k,972) = lu(k,972) - lu(k,80) * lu(k,948) - lu(k,974) = lu(k,974) - lu(k,81) * lu(k,948) - lu(k,979) = lu(k,979) - lu(k,82) * lu(k,948) - lu(k,991) = lu(k,991) - lu(k,83) * lu(k,948) - lu(k,996) = lu(k,996) - lu(k,84) * lu(k,948) - lu(k,999) = - lu(k,85) * lu(k,948) - lu(k,1667) = lu(k,1667) - lu(k,80) * lu(k,1653) - lu(k,1669) = lu(k,1669) - lu(k,81) * lu(k,1653) - lu(k,1674) = lu(k,1674) - lu(k,82) * lu(k,1653) - lu(k,1686) = lu(k,1686) - lu(k,83) * lu(k,1653) - lu(k,1691) = lu(k,1691) - lu(k,84) * lu(k,1653) - lu(k,1694) = - lu(k,85) * lu(k,1653) - end do + real(r8), intent(inout) :: lu(:) + lu(45) = 1._r8 / lu(45) + lu(46) = lu(46) * lu(45) + lu(47) = lu(47) * lu(45) + lu(48) = lu(48) * lu(45) + lu(49) = lu(49) * lu(45) + lu(50) = lu(50) * lu(45) + lu(841) = - lu(46) * lu(840) + lu(864) = - lu(47) * lu(840) + lu(871) = lu(871) - lu(48) * lu(840) + lu(873) = lu(873) - lu(49) * lu(840) + lu(881) = lu(881) - lu(50) * lu(840) + lu(1385) = - lu(46) * lu(1378) + lu(1401) = lu(1401) - lu(47) * lu(1378) + lu(1408) = lu(1408) - lu(48) * lu(1378) + lu(1410) = lu(1410) - lu(49) * lu(1378) + lu(1418) = lu(1418) - lu(50) * lu(1378) + lu(1702) = lu(1702) - lu(46) * lu(1698) + lu(1728) = lu(1728) - lu(47) * lu(1698) + lu(1735) = - lu(48) * lu(1698) + lu(1737) = lu(1737) - lu(49) * lu(1698) + lu(1745) = lu(1745) - lu(50) * lu(1698) + lu(51) = 1._r8 / lu(51) + lu(52) = lu(52) * lu(51) + lu(53) = lu(53) * lu(51) + lu(54) = lu(54) * lu(51) + lu(55) = lu(55) * lu(51) + lu(56) = lu(56) * lu(51) + lu(1141) = lu(1141) - lu(52) * lu(1131) + lu(1143) = - lu(53) * lu(1131) + lu(1158) = lu(1158) - lu(54) * lu(1131) + lu(1160) = lu(1160) - lu(55) * lu(1131) + lu(1166) = lu(1166) - lu(56) * lu(1131) + lu(1219) = lu(1219) - lu(52) * lu(1215) + lu(1220) = lu(1220) - lu(53) * lu(1215) + lu(1235) = lu(1235) - lu(54) * lu(1215) + lu(1237) = lu(1237) - lu(55) * lu(1215) + lu(1243) = lu(1243) - lu(56) * lu(1215) + lu(1481) = lu(1481) - lu(52) * lu(1462) + lu(1486) = lu(1486) - lu(53) * lu(1462) + lu(1501) = lu(1501) - lu(54) * lu(1462) + lu(1503) = lu(1503) - lu(55) * lu(1462) + lu(1509) = lu(1509) - lu(56) * lu(1462) + lu(57) = 1._r8 / lu(57) + lu(58) = lu(58) * lu(57) + lu(59) = lu(59) * lu(57) + lu(60) = lu(60) * lu(57) + lu(61) = lu(61) * lu(57) + lu(62) = lu(62) * lu(57) + lu(63) = lu(63) * lu(57) + lu(670) = lu(670) - lu(58) * lu(658) + lu(671) = lu(671) - lu(59) * lu(658) + lu(676) = lu(676) - lu(60) * lu(658) + lu(678) = lu(678) - lu(61) * lu(658) + lu(689) = lu(689) - lu(62) * lu(658) + lu(690) = lu(690) - lu(63) * lu(658) + lu(710) = lu(710) - lu(58) * lu(694) + lu(711) = lu(711) - lu(59) * lu(694) + lu(717) = lu(717) - lu(60) * lu(694) + lu(719) = lu(719) - lu(61) * lu(694) + lu(730) = lu(730) - lu(62) * lu(694) + lu(731) = lu(731) - lu(63) * lu(694) + lu(1061) = lu(1061) - lu(58) * lu(1044) + lu(1062) = lu(1062) - lu(59) * lu(1044) + lu(1071) = lu(1071) - lu(60) * lu(1044) + lu(1073) = lu(1073) - lu(61) * lu(1044) + lu(1086) = lu(1086) - lu(62) * lu(1044) + lu(1087) = lu(1087) - lu(63) * lu(1044) + lu(64) = 1._r8 / lu(64) + lu(65) = lu(65) * lu(64) + lu(66) = lu(66) * lu(64) + lu(67) = lu(67) * lu(64) + lu(68) = lu(68) * lu(64) + lu(69) = lu(69) * lu(64) + lu(70) = lu(70) * lu(64) + lu(794) = lu(794) - lu(65) * lu(793) + lu(817) = lu(817) - lu(66) * lu(793) + lu(821) = lu(821) - lu(67) * lu(793) + lu(829) = lu(829) - lu(68) * lu(793) + lu(831) = lu(831) - lu(69) * lu(793) + lu(839) = lu(839) - lu(70) * lu(793) + lu(1380) = lu(1380) - lu(65) * lu(1379) + lu(1396) = lu(1396) - lu(66) * lu(1379) + lu(1400) = lu(1400) - lu(67) * lu(1379) + lu(1408) = lu(1408) - lu(68) * lu(1379) + lu(1410) = lu(1410) - lu(69) * lu(1379) + lu(1418) = lu(1418) - lu(70) * lu(1379) + lu(1700) = lu(1700) - lu(65) * lu(1699) + lu(1723) = lu(1723) - lu(66) * lu(1699) + lu(1727) = lu(1727) - lu(67) * lu(1699) + lu(1735) = lu(1735) - lu(68) * lu(1699) + lu(1737) = lu(1737) - lu(69) * lu(1699) + lu(1745) = lu(1745) - lu(70) * lu(1699) + lu(71) = 1._r8 / lu(71) + lu(72) = lu(72) * lu(71) + lu(73) = lu(73) * lu(71) + lu(74) = lu(74) * lu(71) + lu(75) = lu(75) * lu(71) + lu(76) = lu(76) * lu(71) + lu(817) = lu(817) - lu(72) * lu(794) + lu(821) = lu(821) - lu(73) * lu(794) + lu(829) = lu(829) - lu(74) * lu(794) + lu(831) = lu(831) - lu(75) * lu(794) + lu(839) = lu(839) - lu(76) * lu(794) + lu(1396) = lu(1396) - lu(72) * lu(1380) + lu(1400) = lu(1400) - lu(73) * lu(1380) + lu(1408) = lu(1408) - lu(74) * lu(1380) + lu(1410) = lu(1410) - lu(75) * lu(1380) + lu(1418) = lu(1418) - lu(76) * lu(1380) + lu(1723) = lu(1723) - lu(72) * lu(1700) + lu(1727) = lu(1727) - lu(73) * lu(1700) + lu(1735) = lu(1735) - lu(74) * lu(1700) + lu(1737) = lu(1737) - lu(75) * lu(1700) + lu(1745) = lu(1745) - lu(76) * lu(1700) + lu(77) = 1._r8 / lu(77) + lu(78) = lu(78) * lu(77) + lu(79) = lu(79) * lu(77) + lu(80) = lu(80) * lu(77) + lu(81) = lu(81) * lu(77) + lu(82) = lu(82) * lu(77) + lu(83) = lu(83) * lu(77) + lu(1133) = lu(1133) - lu(78) * lu(1132) + lu(1134) = lu(1134) - lu(79) * lu(1132) + lu(1136) = lu(1136) - lu(80) * lu(1132) + lu(1138) = lu(1138) - lu(81) * lu(1132) + lu(1162) = lu(1162) - lu(82) * lu(1132) + lu(1166) = lu(1166) - lu(83) * lu(1132) + lu(1382) = lu(1382) - lu(78) * lu(1381) + lu(1383) = lu(1383) - lu(79) * lu(1381) + lu(1389) = - lu(80) * lu(1381) + lu(1390) = lu(1390) - lu(81) * lu(1381) + lu(1408) = lu(1408) - lu(82) * lu(1381) + lu(1412) = lu(1412) - lu(83) * lu(1381) + lu(1464) = lu(1464) - lu(78) * lu(1463) + lu(1467) = lu(1467) - lu(79) * lu(1463) + lu(1471) = lu(1471) - lu(80) * lu(1463) + lu(1475) = lu(1475) - lu(81) * lu(1463) + lu(1505) = lu(1505) - lu(82) * lu(1463) + lu(1509) = lu(1509) - lu(83) * lu(1463) + lu(84) = 1._r8 / lu(84) + lu(85) = lu(85) * lu(84) + lu(86) = lu(86) * lu(84) + lu(87) = lu(87) * lu(84) + lu(88) = lu(88) * lu(84) + lu(89) = lu(89) * lu(84) + lu(1134) = lu(1134) - lu(85) * lu(1133) + lu(1138) = lu(1138) - lu(86) * lu(1133) + lu(1158) = lu(1158) - lu(87) * lu(1133) + lu(1161) = lu(1161) - lu(88) * lu(1133) + lu(1166) = lu(1166) - lu(89) * lu(1133) + lu(1383) = lu(1383) - lu(85) * lu(1382) + lu(1390) = lu(1390) - lu(86) * lu(1382) + lu(1404) = lu(1404) - lu(87) * lu(1382) + lu(1407) = lu(1407) - lu(88) * lu(1382) + lu(1412) = lu(1412) - lu(89) * lu(1382) + lu(1467) = lu(1467) - lu(85) * lu(1464) + lu(1475) = lu(1475) - lu(86) * lu(1464) + lu(1501) = lu(1501) - lu(87) * lu(1464) + lu(1504) = lu(1504) - lu(88) * lu(1464) + lu(1509) = lu(1509) - lu(89) * lu(1464) end subroutine lu_fac02 - subroutine lu_fac03( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac03( lu ) 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,86) = 1._r8 / lu(k,86) - lu(k,87) = lu(k,87) * lu(k,86) - lu(k,88) = lu(k,88) * lu(k,86) - lu(k,89) = lu(k,89) * lu(k,86) - lu(k,90) = lu(k,90) * lu(k,86) - lu(k,91) = lu(k,91) * lu(k,86) - lu(k,92) = lu(k,92) * lu(k,86) - lu(k,93) = lu(k,93) * lu(k,86) - lu(k,94) = lu(k,94) * lu(k,86) - lu(k,953) = lu(k,953) - lu(k,87) * lu(k,949) - lu(k,960) = lu(k,960) - lu(k,88) * lu(k,949) - lu(k,961) = lu(k,961) - lu(k,89) * lu(k,949) - lu(k,977) = lu(k,977) - lu(k,90) * lu(k,949) - lu(k,979) = lu(k,979) - lu(k,91) * lu(k,949) - lu(k,980) = lu(k,980) - lu(k,92) * lu(k,949) - lu(k,986) = lu(k,986) - lu(k,93) * lu(k,949) - lu(k,988) = lu(k,988) - lu(k,94) * lu(k,949) - lu(k,1011) = lu(k,1011) - lu(k,87) * lu(k,1004) - lu(k,1013) = lu(k,1013) - lu(k,88) * lu(k,1004) - lu(k,1014) = lu(k,1014) - lu(k,89) * lu(k,1004) - lu(k,1020) = lu(k,1020) - lu(k,90) * lu(k,1004) - lu(k,1022) = lu(k,1022) - lu(k,91) * lu(k,1004) - lu(k,1023) = lu(k,1023) - lu(k,92) * lu(k,1004) - lu(k,1029) = lu(k,1029) - lu(k,93) * lu(k,1004) - lu(k,1031) = lu(k,1031) - lu(k,94) * lu(k,1004) - lu(k,1253) = lu(k,1253) - lu(k,87) * lu(k,1251) - lu(k,1256) = lu(k,1256) - lu(k,88) * lu(k,1251) - lu(k,1257) = lu(k,1257) - lu(k,89) * lu(k,1251) - lu(k,1268) = lu(k,1268) - lu(k,90) * lu(k,1251) - lu(k,1270) = lu(k,1270) - lu(k,91) * lu(k,1251) - lu(k,1271) = lu(k,1271) - lu(k,92) * lu(k,1251) - lu(k,1277) = lu(k,1277) - lu(k,93) * lu(k,1251) - lu(k,1279) = lu(k,1279) - lu(k,94) * lu(k,1251) - lu(k,95) = 1._r8 / lu(k,95) - lu(k,96) = lu(k,96) * lu(k,95) - lu(k,97) = lu(k,97) * lu(k,95) - lu(k,98) = lu(k,98) * lu(k,95) - lu(k,99) = lu(k,99) * lu(k,95) - lu(k,100) = lu(k,100) * lu(k,95) - lu(k,101) = lu(k,101) * lu(k,95) - lu(k,964) = lu(k,964) - lu(k,96) * lu(k,950) - lu(k,970) = lu(k,970) - lu(k,97) * lu(k,950) - lu(k,979) = lu(k,979) - lu(k,98) * lu(k,950) - lu(k,986) = lu(k,986) - lu(k,99) * lu(k,950) - lu(k,987) = lu(k,987) - lu(k,100) * lu(k,950) - lu(k,989) = lu(k,989) - lu(k,101) * lu(k,950) - lu(k,1259) = lu(k,1259) - lu(k,96) * lu(k,1252) - lu(k,1261) = - lu(k,97) * lu(k,1252) - lu(k,1270) = lu(k,1270) - lu(k,98) * lu(k,1252) - lu(k,1277) = lu(k,1277) - lu(k,99) * lu(k,1252) - lu(k,1278) = lu(k,1278) - lu(k,100) * lu(k,1252) - lu(k,1280) = lu(k,1280) - lu(k,101) * lu(k,1252) - lu(k,1295) = lu(k,1295) - lu(k,96) * lu(k,1291) - lu(k,1297) = lu(k,1297) - lu(k,97) * lu(k,1291) - lu(k,1306) = lu(k,1306) - lu(k,98) * lu(k,1291) - lu(k,1313) = lu(k,1313) - lu(k,99) * lu(k,1291) - lu(k,1314) = lu(k,1314) - lu(k,100) * lu(k,1291) - lu(k,1316) = lu(k,1316) - lu(k,101) * lu(k,1291) - lu(k,1382) = lu(k,1382) - lu(k,96) * lu(k,1373) - lu(k,1384) = lu(k,1384) - lu(k,97) * lu(k,1373) - lu(k,1393) = lu(k,1393) - lu(k,98) * lu(k,1373) - lu(k,1400) = lu(k,1400) - lu(k,99) * lu(k,1373) - lu(k,1401) = lu(k,1401) - lu(k,100) * lu(k,1373) - lu(k,1403) = lu(k,1403) - lu(k,101) * lu(k,1373) - lu(k,102) = 1._r8 / lu(k,102) - lu(k,103) = lu(k,103) * lu(k,102) - lu(k,104) = lu(k,104) * lu(k,102) - lu(k,105) = lu(k,105) * lu(k,102) - lu(k,106) = lu(k,106) * lu(k,102) - lu(k,107) = lu(k,107) * lu(k,102) - lu(k,134) = lu(k,134) - lu(k,103) * lu(k,133) - lu(k,135) = - lu(k,104) * lu(k,133) - lu(k,136) = lu(k,136) - lu(k,105) * lu(k,133) - lu(k,137) = lu(k,137) - lu(k,106) * lu(k,133) - lu(k,138) = lu(k,138) - lu(k,107) * lu(k,133) - lu(k,141) = lu(k,141) - lu(k,103) * lu(k,140) - lu(k,144) = - lu(k,104) * lu(k,140) - lu(k,145) = lu(k,145) - lu(k,105) * lu(k,140) - lu(k,148) = lu(k,148) - lu(k,106) * lu(k,140) - lu(k,149) = lu(k,149) - lu(k,107) * lu(k,140) - lu(k,811) = - lu(k,103) * lu(k,810) - lu(k,829) = lu(k,829) - lu(k,104) * lu(k,810) - lu(k,833) = lu(k,833) - lu(k,105) * lu(k,810) - lu(k,850) = lu(k,850) - lu(k,106) * lu(k,810) - lu(k,852) = lu(k,852) - lu(k,107) * lu(k,810) - lu(k,1009) = lu(k,1009) - lu(k,103) * lu(k,1005) - lu(k,1019) = lu(k,1019) - lu(k,104) * lu(k,1005) - lu(k,1023) = lu(k,1023) - lu(k,105) * lu(k,1005) - lu(k,1040) = lu(k,1040) - lu(k,106) * lu(k,1005) - lu(k,1042) = lu(k,1042) - lu(k,107) * lu(k,1005) - lu(k,1782) = lu(k,1782) - lu(k,103) * lu(k,1778) - lu(k,1802) = lu(k,1802) - lu(k,104) * lu(k,1778) - lu(k,1806) = lu(k,1806) - lu(k,105) * lu(k,1778) - lu(k,1823) = lu(k,1823) - lu(k,106) * lu(k,1778) - lu(k,1825) = lu(k,1825) - lu(k,107) * lu(k,1778) - 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,111) = lu(k,111) * lu(k,108) - lu(k,112) = lu(k,112) * lu(k,108) - lu(k,113) = lu(k,113) * lu(k,108) - lu(k,114) = lu(k,114) * lu(k,108) - lu(k,115) = lu(k,115) * lu(k,108) - lu(k,854) = lu(k,854) - lu(k,109) * lu(k,853) - lu(k,878) = lu(k,878) - lu(k,110) * lu(k,853) - lu(k,881) = lu(k,881) - lu(k,111) * lu(k,853) - lu(k,882) = lu(k,882) - lu(k,112) * lu(k,853) - lu(k,890) = lu(k,890) - lu(k,113) * lu(k,853) - lu(k,899) = lu(k,899) - lu(k,114) * lu(k,853) - lu(k,900) = lu(k,900) - lu(k,115) * lu(k,853) - lu(k,1007) = lu(k,1007) - lu(k,109) * lu(k,1006) - lu(k,1020) = lu(k,1020) - lu(k,110) * lu(k,1006) - lu(k,1023) = lu(k,1023) - lu(k,111) * lu(k,1006) - lu(k,1024) = lu(k,1024) - lu(k,112) * lu(k,1006) - lu(k,1032) = lu(k,1032) - lu(k,113) * lu(k,1006) - lu(k,1041) = lu(k,1041) - lu(k,114) * lu(k,1006) - lu(k,1042) = lu(k,1042) - lu(k,115) * lu(k,1006) - lu(k,1375) = lu(k,1375) - lu(k,109) * lu(k,1374) - lu(k,1391) = lu(k,1391) - lu(k,110) * lu(k,1374) - lu(k,1394) = - lu(k,111) * lu(k,1374) - lu(k,1395) = - lu(k,112) * lu(k,1374) - lu(k,1403) = lu(k,1403) - lu(k,113) * lu(k,1374) - lu(k,1412) = - lu(k,114) * lu(k,1374) - lu(k,1413) = - lu(k,115) * lu(k,1374) - lu(k,1780) = lu(k,1780) - lu(k,109) * lu(k,1779) - lu(k,1803) = lu(k,1803) - lu(k,110) * lu(k,1779) - lu(k,1806) = lu(k,1806) - lu(k,111) * lu(k,1779) - lu(k,1807) = lu(k,1807) - lu(k,112) * lu(k,1779) - lu(k,1815) = lu(k,1815) - lu(k,113) * lu(k,1779) - lu(k,1824) = lu(k,1824) - lu(k,114) * lu(k,1779) - lu(k,1825) = lu(k,1825) - lu(k,115) * lu(k,1779) - 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,120) = lu(k,120) * lu(k,116) - lu(k,121) = lu(k,121) * lu(k,116) - lu(k,122) = lu(k,122) * lu(k,116) - lu(k,878) = lu(k,878) - lu(k,117) * lu(k,854) - lu(k,881) = lu(k,881) - lu(k,118) * lu(k,854) - lu(k,882) = lu(k,882) - lu(k,119) * lu(k,854) - lu(k,890) = lu(k,890) - lu(k,120) * lu(k,854) - lu(k,899) = lu(k,899) - lu(k,121) * lu(k,854) - lu(k,900) = lu(k,900) - lu(k,122) * lu(k,854) - lu(k,1020) = lu(k,1020) - lu(k,117) * lu(k,1007) - lu(k,1023) = lu(k,1023) - lu(k,118) * lu(k,1007) - lu(k,1024) = lu(k,1024) - lu(k,119) * lu(k,1007) - lu(k,1032) = lu(k,1032) - lu(k,120) * lu(k,1007) - lu(k,1041) = lu(k,1041) - lu(k,121) * lu(k,1007) - lu(k,1042) = lu(k,1042) - lu(k,122) * lu(k,1007) - lu(k,1391) = lu(k,1391) - lu(k,117) * lu(k,1375) - lu(k,1394) = lu(k,1394) - lu(k,118) * lu(k,1375) - lu(k,1395) = lu(k,1395) - lu(k,119) * lu(k,1375) - lu(k,1403) = lu(k,1403) - lu(k,120) * lu(k,1375) - lu(k,1412) = lu(k,1412) - lu(k,121) * lu(k,1375) - lu(k,1413) = lu(k,1413) - lu(k,122) * lu(k,1375) - lu(k,1803) = lu(k,1803) - lu(k,117) * lu(k,1780) - lu(k,1806) = lu(k,1806) - lu(k,118) * lu(k,1780) - lu(k,1807) = lu(k,1807) - lu(k,119) * lu(k,1780) - lu(k,1815) = lu(k,1815) - lu(k,120) * lu(k,1780) - lu(k,1824) = lu(k,1824) - lu(k,121) * lu(k,1780) - lu(k,1825) = lu(k,1825) - lu(k,122) * lu(k,1780) - lu(k,123) = 1._r8 / lu(k,123) - lu(k,124) = lu(k,124) * lu(k,123) - lu(k,125) = lu(k,125) * lu(k,123) - lu(k,126) = lu(k,126) * lu(k,123) - lu(k,127) = lu(k,127) * lu(k,123) - lu(k,713) = - lu(k,124) * lu(k,708) - lu(k,721) = lu(k,721) - lu(k,125) * lu(k,708) - lu(k,733) = lu(k,733) - lu(k,126) * lu(k,708) - lu(k,734) = lu(k,734) - lu(k,127) * lu(k,708) - lu(k,755) = lu(k,755) - lu(k,124) * lu(k,740) - lu(k,762) = lu(k,762) - lu(k,125) * lu(k,740) - lu(k,775) = lu(k,775) - lu(k,126) * lu(k,740) - lu(k,776) = lu(k,776) - lu(k,127) * lu(k,740) - lu(k,918) = lu(k,918) - lu(k,124) * lu(k,902) - lu(k,927) = lu(k,927) - lu(k,125) * lu(k,902) - lu(k,942) = lu(k,942) - lu(k,126) * lu(k,902) - lu(k,943) = lu(k,943) - lu(k,127) * lu(k,902) - lu(k,1018) = lu(k,1018) - lu(k,124) * lu(k,1008) - lu(k,1026) = - lu(k,125) * lu(k,1008) - lu(k,1041) = lu(k,1041) - lu(k,126) * lu(k,1008) - lu(k,1042) = lu(k,1042) - lu(k,127) * lu(k,1008) - lu(k,1099) = lu(k,1099) - lu(k,124) * lu(k,1086) - lu(k,1108) = lu(k,1108) - lu(k,125) * lu(k,1086) - lu(k,1123) = - lu(k,126) * lu(k,1086) - lu(k,1124) = lu(k,1124) - lu(k,127) * lu(k,1086) - lu(k,1471) = lu(k,1471) - lu(k,124) * lu(k,1454) - lu(k,1480) = - lu(k,125) * lu(k,1454) - lu(k,1495) = - lu(k,126) * lu(k,1454) - lu(k,1496) = lu(k,1496) - lu(k,127) * lu(k,1454) - lu(k,1747) = lu(k,1747) - lu(k,124) * lu(k,1731) - lu(k,1756) = lu(k,1756) - lu(k,125) * lu(k,1731) - lu(k,1771) = lu(k,1771) - lu(k,126) * lu(k,1731) - lu(k,1772) = lu(k,1772) - lu(k,127) * lu(k,1731) - lu(k,1800) = lu(k,1800) - lu(k,124) * lu(k,1781) - lu(k,1809) = - lu(k,125) * lu(k,1781) - lu(k,1824) = lu(k,1824) - lu(k,126) * lu(k,1781) - lu(k,1825) = lu(k,1825) - lu(k,127) * lu(k,1781) - end do + real(r8), intent(inout) :: lu(:) + lu(90) = 1._r8 / lu(90) + lu(91) = lu(91) * lu(90) + lu(92) = lu(92) * lu(90) + lu(93) = lu(93) * lu(90) + lu(94) = lu(94) * lu(90) + lu(95) = lu(95) * lu(90) + lu(96) = lu(96) * lu(90) + lu(97) = lu(97) * lu(90) + lu(409) = lu(409) - lu(91) * lu(408) + lu(410) = lu(410) - lu(92) * lu(408) + lu(411) = lu(411) - lu(93) * lu(408) + lu(418) = lu(418) - lu(94) * lu(408) + lu(423) = lu(423) - lu(95) * lu(408) + lu(425) = - lu(96) * lu(408) + lu(426) = - lu(97) * lu(408) + lu(1046) = - lu(91) * lu(1045) + lu(1050) = - lu(92) * lu(1045) + lu(1052) = lu(1052) - lu(93) * lu(1045) + lu(1071) = lu(1071) - lu(94) * lu(1045) + lu(1081) = lu(1081) - lu(95) * lu(1045) + lu(1085) = lu(1085) - lu(96) * lu(1045) + lu(1086) = lu(1086) - lu(97) * lu(1045) + lu(1470) = lu(1470) - lu(91) * lu(1465) + lu(1480) = lu(1480) - lu(92) * lu(1465) + lu(1482) = lu(1482) - lu(93) * lu(1465) + lu(1499) = lu(1499) - lu(94) * lu(1465) + lu(1509) = lu(1509) - lu(95) * lu(1465) + lu(1513) = - lu(96) * lu(1465) + lu(1514) = lu(1514) - lu(97) * lu(1465) + lu(98) = 1._r8 / lu(98) + lu(99) = lu(99) * lu(98) + lu(100) = lu(100) * lu(98) + lu(101) = lu(101) * lu(98) + lu(209) = - lu(99) * lu(203) + lu(210) = - lu(100) * lu(203) + lu(212) = - lu(101) * lu(203) + lu(324) = lu(324) - lu(99) * lu(318) + lu(325) = - lu(100) * lu(318) + lu(326) = - lu(101) * lu(318) + lu(531) = lu(531) - lu(99) * lu(524) + lu(532) = lu(532) - lu(100) * lu(524) + lu(534) = lu(534) - lu(101) * lu(524) + lu(710) = lu(710) - lu(99) * lu(695) + lu(711) = lu(711) - lu(100) * lu(695) + lu(714) = lu(714) - lu(101) * lu(695) + lu(1188) = lu(1188) - lu(99) * lu(1174) + lu(1189) = lu(1189) - lu(100) * lu(1174) + lu(1195) = lu(1195) - lu(101) * lu(1174) + lu(1489) = lu(1489) - lu(99) * lu(1466) + lu(1490) = lu(1490) - lu(100) * lu(1466) + lu(1496) = lu(1496) - lu(101) * lu(1466) + lu(1668) = lu(1668) - lu(99) * lu(1660) + lu(1669) = lu(1669) - lu(100) * lu(1660) + lu(1674) = - lu(101) * lu(1660) + lu(102) = 1._r8 / lu(102) + lu(103) = lu(103) * lu(102) + lu(104) = lu(104) * lu(102) + lu(105) = lu(105) * lu(102) + lu(106) = lu(106) * lu(102) + lu(107) = lu(107) * lu(102) + lu(108) = lu(108) * lu(102) + lu(109) = lu(109) * lu(102) + lu(110) = lu(110) * lu(102) + lu(1135) = lu(1135) - lu(103) * lu(1134) + lu(1138) = lu(1138) - lu(104) * lu(1134) + lu(1139) = lu(1139) - lu(105) * lu(1134) + lu(1150) = lu(1150) - lu(106) * lu(1134) + lu(1158) = lu(1158) - lu(107) * lu(1134) + lu(1161) = lu(1161) - lu(108) * lu(1134) + lu(1164) = lu(1164) - lu(109) * lu(1134) + lu(1166) = lu(1166) - lu(110) * lu(1134) + lu(1388) = lu(1388) - lu(103) * lu(1383) + lu(1390) = lu(1390) - lu(104) * lu(1383) + lu(1391) = lu(1391) - lu(105) * lu(1383) + lu(1396) = lu(1396) - lu(106) * lu(1383) + lu(1404) = lu(1404) - lu(107) * lu(1383) + lu(1407) = lu(1407) - lu(108) * lu(1383) + lu(1410) = lu(1410) - lu(109) * lu(1383) + lu(1412) = lu(1412) - lu(110) * lu(1383) + lu(1469) = lu(1469) - lu(103) * lu(1467) + lu(1475) = lu(1475) - lu(104) * lu(1467) + lu(1478) = lu(1478) - lu(105) * lu(1467) + lu(1493) = lu(1493) - lu(106) * lu(1467) + lu(1501) = lu(1501) - lu(107) * lu(1467) + lu(1504) = lu(1504) - lu(108) * lu(1467) + lu(1507) = lu(1507) - lu(109) * lu(1467) + lu(1509) = lu(1509) - lu(110) * lu(1467) + lu(111) = 1._r8 / lu(111) + lu(112) = lu(112) * lu(111) + lu(113) = lu(113) * lu(111) + lu(114) = lu(114) * lu(111) + lu(115) = lu(115) * lu(111) + lu(116) = lu(116) * lu(111) + lu(117) = lu(117) * lu(111) + lu(670) = lu(670) - lu(112) * lu(659) + lu(671) = lu(671) - lu(113) * lu(659) + lu(672) = lu(672) - lu(114) * lu(659) + lu(679) = lu(679) - lu(115) * lu(659) + lu(684) = lu(684) - lu(116) * lu(659) + lu(690) = lu(690) - lu(117) * lu(659) + lu(710) = lu(710) - lu(112) * lu(696) + lu(711) = lu(711) - lu(113) * lu(696) + lu(713) = lu(713) - lu(114) * lu(696) + lu(720) = lu(720) - lu(115) * lu(696) + lu(725) = lu(725) - lu(116) * lu(696) + lu(731) = lu(731) - lu(117) * lu(696) + lu(1188) = lu(1188) - lu(112) * lu(1175) + lu(1189) = lu(1189) - lu(113) * lu(1175) + lu(1194) = lu(1194) - lu(114) * lu(1175) + lu(1201) = lu(1201) - lu(115) * lu(1175) + lu(1208) = lu(1208) - lu(116) * lu(1175) + lu(1214) = - lu(117) * lu(1175) + lu(1489) = lu(1489) - lu(112) * lu(1468) + lu(1490) = lu(1490) - lu(113) * lu(1468) + lu(1495) = lu(1495) - lu(114) * lu(1468) + lu(1502) = lu(1502) - lu(115) * lu(1468) + lu(1509) = lu(1509) - lu(116) * lu(1468) + lu(1515) = - lu(117) * lu(1468) + lu(118) = 1._r8 / lu(118) + lu(119) = lu(119) * lu(118) + lu(120) = lu(120) * lu(118) + lu(121) = lu(121) * lu(118) + lu(122) = lu(122) * lu(118) + lu(123) = lu(123) * lu(118) + lu(130) = lu(130) - lu(119) * lu(129) + lu(131) = lu(131) - lu(120) * lu(129) + lu(132) = - lu(121) * lu(129) + lu(133) = lu(133) - lu(122) * lu(129) + lu(134) = lu(134) - lu(123) * lu(129) + lu(137) = lu(137) - lu(119) * lu(136) + lu(140) = lu(140) - lu(120) * lu(136) + lu(141) = - lu(121) * lu(136) + lu(144) = lu(144) - lu(122) * lu(136) + lu(145) = lu(145) - lu(123) * lu(136) + lu(1003) = - lu(119) * lu(1002) + lu(1024) = lu(1024) - lu(120) * lu(1002) + lu(1026) = lu(1026) - lu(121) * lu(1002) + lu(1035) = lu(1035) - lu(122) * lu(1002) + lu(1043) = lu(1043) - lu(123) * lu(1002) + lu(1386) = lu(1386) - lu(119) * lu(1384) + lu(1399) = lu(1399) - lu(120) * lu(1384) + lu(1401) = lu(1401) - lu(121) * lu(1384) + lu(1410) = lu(1410) - lu(122) * lu(1384) + lu(1418) = lu(1418) - lu(123) * lu(1384) + lu(1703) = lu(1703) - lu(119) * lu(1701) + lu(1726) = lu(1726) - lu(120) * lu(1701) + lu(1728) = lu(1728) - lu(121) * lu(1701) + lu(1737) = lu(1737) - lu(122) * lu(1701) + lu(1745) = lu(1745) - lu(123) * lu(1701) + lu(124) = 1._r8 / lu(124) + lu(125) = lu(125) * lu(124) + lu(126) = lu(126) * lu(124) + lu(127) = lu(127) * lu(124) + lu(128) = lu(128) * lu(124) + lu(711) = lu(711) - lu(125) * lu(697) + lu(717) = lu(717) - lu(126) * lu(697) + lu(723) = lu(723) - lu(127) * lu(697) + lu(731) = lu(731) - lu(128) * lu(697) + lu(768) = - lu(125) * lu(764) + lu(776) = lu(776) - lu(126) * lu(764) + lu(782) = lu(782) - lu(127) * lu(764) + lu(792) = lu(792) - lu(128) * lu(764) + lu(856) = lu(856) - lu(125) * lu(841) + lu(865) = lu(865) - lu(126) * lu(841) + lu(871) = lu(871) - lu(127) * lu(841) + lu(881) = lu(881) - lu(128) * lu(841) + lu(900) = lu(900) - lu(125) * lu(884) + lu(909) = - lu(126) * lu(884) + lu(915) = - lu(127) * lu(884) + lu(925) = lu(925) - lu(128) * lu(884) + lu(1309) = lu(1309) - lu(125) * lu(1294) + lu(1318) = lu(1318) - lu(126) * lu(1294) + lu(1324) = lu(1324) - lu(127) * lu(1294) + lu(1334) = lu(1334) - lu(128) * lu(1294) + lu(1395) = lu(1395) - lu(125) * lu(1385) + lu(1402) = - lu(126) * lu(1385) + lu(1408) = lu(1408) - lu(127) * lu(1385) + lu(1418) = lu(1418) - lu(128) * lu(1385) + lu(1634) = lu(1634) - lu(125) * lu(1622) + lu(1643) = lu(1643) - lu(126) * lu(1622) + lu(1649) = - lu(127) * lu(1622) + lu(1659) = lu(1659) - lu(128) * lu(1622) + lu(1720) = lu(1720) - lu(125) * lu(1702) + lu(1729) = - lu(126) * lu(1702) + lu(1735) = lu(1735) - lu(127) * lu(1702) + lu(1745) = lu(1745) - lu(128) * lu(1702) end subroutine lu_fac03 - subroutine lu_fac04( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac04( lu ) 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,128) = 1._r8 / lu(k,128) - lu(k,129) = lu(k,129) * lu(k,128) - lu(k,130) = lu(k,130) * lu(k,128) - lu(k,131) = lu(k,131) * lu(k,128) - lu(k,132) = lu(k,132) * lu(k,128) - lu(k,247) = - lu(k,129) * lu(k,241) - lu(k,248) = - lu(k,130) * lu(k,241) - lu(k,253) = lu(k,253) - lu(k,131) * lu(k,241) - lu(k,254) = - lu(k,132) * lu(k,241) - lu(k,332) = lu(k,332) - lu(k,129) * lu(k,326) - lu(k,333) = - lu(k,130) * lu(k,326) - lu(k,336) = - lu(k,131) * lu(k,326) - lu(k,338) = - lu(k,132) * lu(k,326) - lu(k,543) = lu(k,543) - lu(k,129) * lu(k,536) - lu(k,544) = lu(k,544) - lu(k,130) * lu(k,536) - lu(k,551) = - lu(k,131) * lu(k,536) - lu(k,558) = lu(k,558) - lu(k,132) * lu(k,536) - lu(k,754) = lu(k,754) - lu(k,129) * lu(k,741) - lu(k,755) = lu(k,755) - lu(k,130) * lu(k,741) - lu(k,767) = lu(k,767) - lu(k,131) * lu(k,741) - lu(k,774) = lu(k,774) - lu(k,132) * lu(k,741) - lu(k,972) = lu(k,972) - lu(k,129) * lu(k,951) - lu(k,974) = lu(k,974) - lu(k,130) * lu(k,951) - lu(k,989) = lu(k,989) - lu(k,131) * lu(k,951) - lu(k,997) = lu(k,997) - lu(k,132) * lu(k,951) - lu(k,1221) = lu(k,1221) - lu(k,129) * lu(k,1213) - lu(k,1223) = lu(k,1223) - lu(k,130) * lu(k,1213) - lu(k,1237) = - lu(k,131) * lu(k,1213) - lu(k,1245) = - lu(k,132) * lu(k,1213) - lu(k,1386) = - lu(k,129) * lu(k,1376) - lu(k,1388) = - lu(k,130) * lu(k,1376) - lu(k,1403) = lu(k,1403) - lu(k,131) * lu(k,1376) - lu(k,1411) = - lu(k,132) * lu(k,1376) - lu(k,1667) = lu(k,1667) - lu(k,129) * lu(k,1654) - lu(k,1669) = lu(k,1669) - lu(k,130) * lu(k,1654) - lu(k,1684) = lu(k,1684) - lu(k,131) * lu(k,1654) - lu(k,1692) = lu(k,1692) - lu(k,132) * lu(k,1654) - lu(k,134) = 1._r8 / lu(k,134) - lu(k,135) = lu(k,135) * lu(k,134) - lu(k,136) = lu(k,136) * lu(k,134) - lu(k,137) = lu(k,137) * lu(k,134) - lu(k,138) = lu(k,138) * lu(k,134) - lu(k,144) = lu(k,144) - lu(k,135) * lu(k,141) - lu(k,145) = lu(k,145) - lu(k,136) * lu(k,141) - lu(k,148) = lu(k,148) - lu(k,137) * lu(k,141) - lu(k,149) = lu(k,149) - lu(k,138) * lu(k,141) - lu(k,688) = - lu(k,135) * lu(k,676) - lu(k,690) = - lu(k,136) * lu(k,676) - lu(k,705) = lu(k,705) - lu(k,137) * lu(k,676) - lu(k,707) = lu(k,707) - lu(k,138) * lu(k,676) - lu(k,756) = - lu(k,135) * lu(k,742) - lu(k,759) = - lu(k,136) * lu(k,742) - lu(k,774) = lu(k,774) - lu(k,137) * lu(k,742) - lu(k,776) = lu(k,776) - lu(k,138) * lu(k,742) - lu(k,829) = lu(k,829) - lu(k,135) * lu(k,811) - lu(k,833) = lu(k,833) - lu(k,136) * lu(k,811) - lu(k,850) = lu(k,850) - lu(k,137) * lu(k,811) - lu(k,852) = lu(k,852) - lu(k,138) * lu(k,811) - lu(k,1019) = lu(k,1019) - lu(k,135) * lu(k,1009) - lu(k,1023) = lu(k,1023) - lu(k,136) * lu(k,1009) - lu(k,1040) = lu(k,1040) - lu(k,137) * lu(k,1009) - lu(k,1042) = lu(k,1042) - lu(k,138) * lu(k,1009) - lu(k,1061) = - lu(k,135) * lu(k,1043) - lu(k,1065) = lu(k,1065) - lu(k,136) * lu(k,1043) - lu(k,1082) = lu(k,1082) - lu(k,137) * lu(k,1043) - lu(k,1084) = lu(k,1084) - lu(k,138) * lu(k,1043) - lu(k,1707) = - lu(k,135) * lu(k,1695) - lu(k,1711) = lu(k,1711) - lu(k,136) * lu(k,1695) - lu(k,1728) = lu(k,1728) - lu(k,137) * lu(k,1695) - lu(k,1730) = lu(k,1730) - lu(k,138) * lu(k,1695) - lu(k,1802) = lu(k,1802) - lu(k,135) * lu(k,1782) - lu(k,1806) = lu(k,1806) - lu(k,136) * lu(k,1782) - lu(k,1823) = lu(k,1823) - lu(k,137) * lu(k,1782) - lu(k,1825) = lu(k,1825) - lu(k,138) * lu(k,1782) - 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,147) = lu(k,147) * lu(k,142) - lu(k,148) = lu(k,148) * lu(k,142) - lu(k,149) = lu(k,149) * lu(k,142) - lu(k,286) = - lu(k,143) * lu(k,283) - lu(k,287) = - lu(k,144) * lu(k,283) - lu(k,289) = lu(k,289) - lu(k,145) * lu(k,283) - lu(k,290) = lu(k,290) - lu(k,146) * lu(k,283) - lu(k,292) = lu(k,292) - lu(k,147) * lu(k,283) - lu(k,295) = - lu(k,148) * lu(k,283) - lu(k,296) = lu(k,296) - lu(k,149) * lu(k,283) - lu(k,1018) = lu(k,1018) - lu(k,143) * lu(k,1010) - lu(k,1019) = lu(k,1019) - lu(k,144) * lu(k,1010) - lu(k,1023) = lu(k,1023) - lu(k,145) * lu(k,1010) - lu(k,1029) = lu(k,1029) - lu(k,146) * lu(k,1010) - lu(k,1031) = lu(k,1031) - lu(k,147) * lu(k,1010) - lu(k,1040) = lu(k,1040) - lu(k,148) * lu(k,1010) - lu(k,1042) = lu(k,1042) - lu(k,149) * lu(k,1010) - lu(k,1346) = lu(k,1346) - lu(k,143) * lu(k,1327) - lu(k,1348) = - lu(k,144) * lu(k,1327) - lu(k,1352) = lu(k,1352) - lu(k,145) * lu(k,1327) - lu(k,1358) = lu(k,1358) - lu(k,146) * lu(k,1327) - lu(k,1360) = lu(k,1360) - lu(k,147) * lu(k,1327) - lu(k,1369) = - lu(k,148) * lu(k,1327) - lu(k,1371) = lu(k,1371) - lu(k,149) * lu(k,1327) - lu(k,1800) = lu(k,1800) - lu(k,143) * lu(k,1783) - lu(k,1802) = lu(k,1802) - lu(k,144) * lu(k,1783) - lu(k,1806) = lu(k,1806) - lu(k,145) * lu(k,1783) - lu(k,1812) = lu(k,1812) - lu(k,146) * lu(k,1783) - lu(k,1814) = lu(k,1814) - lu(k,147) * lu(k,1783) - lu(k,1823) = lu(k,1823) - lu(k,148) * lu(k,1783) - lu(k,1825) = lu(k,1825) - lu(k,149) * lu(k,1783) - lu(k,151) = 1._r8 / lu(k,151) - lu(k,152) = lu(k,152) * lu(k,151) - lu(k,153) = lu(k,153) * lu(k,151) - lu(k,154) = lu(k,154) * lu(k,151) - lu(k,155) = lu(k,155) * lu(k,151) - lu(k,156) = lu(k,156) * lu(k,151) - lu(k,157) = lu(k,157) * lu(k,151) - lu(k,158) = lu(k,158) * lu(k,151) - lu(k,456) = lu(k,456) - lu(k,152) * lu(k,455) - lu(k,457) = lu(k,457) - lu(k,153) * lu(k,455) - lu(k,461) = lu(k,461) - lu(k,154) * lu(k,455) - lu(k,462) = lu(k,462) - lu(k,155) * lu(k,455) - lu(k,469) = - lu(k,156) * lu(k,455) - lu(k,471) = lu(k,471) - lu(k,157) * lu(k,455) - lu(k,474) = - lu(k,158) * lu(k,455) - lu(k,681) = lu(k,681) - lu(k,152) * lu(k,677) - lu(k,683) = lu(k,683) - lu(k,153) * lu(k,677) - lu(k,687) = lu(k,687) - lu(k,154) * lu(k,677) - lu(k,689) = lu(k,689) - lu(k,155) * lu(k,677) - lu(k,700) = lu(k,700) - lu(k,156) * lu(k,677) - lu(k,704) = lu(k,704) - lu(k,157) * lu(k,677) - lu(k,707) = lu(k,707) - lu(k,158) * lu(k,677) - lu(k,963) = lu(k,963) - lu(k,152) * lu(k,952) - lu(k,966) = lu(k,966) - lu(k,153) * lu(k,952) - lu(k,974) = lu(k,974) - lu(k,154) * lu(k,952) - lu(k,979) = lu(k,979) - lu(k,155) * lu(k,952) - lu(k,991) = lu(k,991) - lu(k,156) * lu(k,952) - lu(k,996) = lu(k,996) - lu(k,157) * lu(k,952) - lu(k,999) = lu(k,999) - lu(k,158) * lu(k,952) - lu(k,1131) = lu(k,1131) - lu(k,152) * lu(k,1127) - lu(k,1134) = lu(k,1134) - lu(k,153) * lu(k,1127) - lu(k,1144) = lu(k,1144) - lu(k,154) * lu(k,1127) - lu(k,1149) = lu(k,1149) - lu(k,155) * lu(k,1127) - lu(k,1161) = - lu(k,156) * lu(k,1127) - lu(k,1166) = lu(k,1166) - lu(k,157) * lu(k,1127) - lu(k,1169) = lu(k,1169) - lu(k,158) * lu(k,1127) - lu(k,1458) = lu(k,1458) - lu(k,152) * lu(k,1455) - lu(k,1463) = - lu(k,153) * lu(k,1455) - lu(k,1471) = lu(k,1471) - lu(k,154) * lu(k,1455) - lu(k,1476) = lu(k,1476) - lu(k,155) * lu(k,1455) - lu(k,1488) = lu(k,1488) - lu(k,156) * lu(k,1455) - lu(k,1493) = lu(k,1493) - lu(k,157) * lu(k,1455) - lu(k,1496) = lu(k,1496) - lu(k,158) * lu(k,1455) - end do + real(r8), intent(inout) :: lu(:) + lu(130) = 1._r8 / lu(130) + lu(131) = lu(131) * lu(130) + lu(132) = lu(132) * lu(130) + lu(133) = lu(133) * lu(130) + lu(134) = lu(134) * lu(130) + lu(140) = lu(140) - lu(131) * lu(137) + lu(141) = lu(141) - lu(132) * lu(137) + lu(144) = lu(144) - lu(133) * lu(137) + lu(145) = lu(145) - lu(134) * lu(137) + lu(673) = lu(673) - lu(131) * lu(660) + lu(675) = - lu(132) * lu(660) + lu(683) = - lu(133) * lu(660) + lu(690) = lu(690) - lu(134) * lu(660) + lu(714) = lu(714) - lu(131) * lu(698) + lu(716) = - lu(132) * lu(698) + lu(724) = - lu(133) * lu(698) + lu(731) = lu(731) - lu(134) * lu(698) + lu(941) = lu(941) - lu(131) * lu(926) + lu(943) = - lu(132) * lu(926) + lu(952) = lu(952) - lu(133) * lu(926) + lu(960) = lu(960) - lu(134) * lu(926) + lu(982) = lu(982) - lu(131) * lu(961) + lu(984) = - lu(132) * lu(961) + lu(993) = lu(993) - lu(133) * lu(961) + lu(1001) = lu(1001) - lu(134) * lu(961) + lu(1024) = lu(1024) - lu(131) * lu(1003) + lu(1026) = lu(1026) - lu(132) * lu(1003) + lu(1035) = lu(1035) - lu(133) * lu(1003) + lu(1043) = lu(1043) - lu(134) * lu(1003) + lu(1399) = lu(1399) - lu(131) * lu(1386) + lu(1401) = lu(1401) - lu(132) * lu(1386) + lu(1410) = lu(1410) - lu(133) * lu(1386) + lu(1418) = lu(1418) - lu(134) * lu(1386) + lu(1726) = lu(1726) - lu(131) * lu(1703) + lu(1728) = lu(1728) - lu(132) * lu(1703) + lu(1737) = lu(1737) - lu(133) * lu(1703) + lu(1745) = lu(1745) - lu(134) * lu(1703) + lu(138) = 1._r8 / lu(138) + lu(139) = lu(139) * lu(138) + lu(140) = lu(140) * lu(138) + lu(141) = lu(141) * lu(138) + lu(142) = lu(142) * lu(138) + lu(143) = lu(143) * lu(138) + lu(144) = lu(144) * lu(138) + lu(145) = lu(145) * lu(138) + lu(293) = - lu(139) * lu(290) + lu(294) = - lu(140) * lu(290) + lu(295) = - lu(141) * lu(290) + lu(296) = lu(296) - lu(142) * lu(290) + lu(298) = lu(298) - lu(143) * lu(290) + lu(299) = lu(299) - lu(144) * lu(290) + lu(303) = lu(303) - lu(145) * lu(290) + lu(1268) = lu(1268) - lu(139) * lu(1250) + lu(1274) = - lu(140) * lu(1250) + lu(1276) = - lu(141) * lu(1250) + lu(1279) = lu(1279) - lu(142) * lu(1250) + lu(1282) = lu(1282) - lu(143) * lu(1250) + lu(1285) = lu(1285) - lu(144) * lu(1250) + lu(1293) = lu(1293) - lu(145) * lu(1250) + lu(1395) = lu(1395) - lu(139) * lu(1387) + lu(1399) = lu(1399) - lu(140) * lu(1387) + lu(1401) = lu(1401) - lu(141) * lu(1387) + lu(1404) = lu(1404) - lu(142) * lu(1387) + lu(1407) = lu(1407) - lu(143) * lu(1387) + lu(1410) = lu(1410) - lu(144) * lu(1387) + lu(1418) = lu(1418) - lu(145) * lu(1387) + lu(1720) = lu(1720) - lu(139) * lu(1704) + lu(1726) = lu(1726) - lu(140) * lu(1704) + lu(1728) = lu(1728) - lu(141) * lu(1704) + lu(1731) = lu(1731) - lu(142) * lu(1704) + lu(1734) = lu(1734) - lu(143) * lu(1704) + lu(1737) = lu(1737) - lu(144) * lu(1704) + lu(1745) = lu(1745) - lu(145) * lu(1704) + lu(146) = 1._r8 / lu(146) + lu(147) = lu(147) * lu(146) + lu(148) = lu(148) * lu(146) + lu(149) = lu(149) * lu(146) + lu(150) = lu(150) * lu(146) + lu(151) = lu(151) * lu(146) + lu(152) = lu(152) * lu(146) + lu(153) = lu(153) * lu(146) + lu(205) = lu(205) - lu(147) * lu(204) + lu(206) = lu(206) - lu(148) * lu(204) + lu(207) = lu(207) - lu(149) * lu(204) + lu(208) = - lu(150) * lu(204) + lu(213) = lu(213) - lu(151) * lu(204) + lu(215) = - lu(152) * lu(204) + lu(216) = lu(216) - lu(153) * lu(204) + lu(796) = - lu(147) * lu(795) + lu(797) = - lu(148) * lu(795) + lu(798) = lu(798) - lu(149) * lu(795) + lu(809) = - lu(150) * lu(795) + lu(825) = lu(825) - lu(151) * lu(795) + lu(829) = lu(829) - lu(152) * lu(795) + lu(833) = lu(833) - lu(153) * lu(795) + lu(1136) = lu(1136) - lu(147) * lu(1135) + lu(1138) = lu(1138) - lu(148) * lu(1135) + lu(1139) = lu(1139) - lu(149) * lu(1135) + lu(1142) = lu(1142) - lu(150) * lu(1135) + lu(1158) = lu(1158) - lu(151) * lu(1135) + lu(1162) = lu(1162) - lu(152) * lu(1135) + lu(1166) = lu(1166) - lu(153) * lu(1135) + lu(1389) = lu(1389) - lu(147) * lu(1388) + lu(1390) = lu(1390) - lu(148) * lu(1388) + lu(1391) = lu(1391) - lu(149) * lu(1388) + lu(1393) = lu(1393) - lu(150) * lu(1388) + lu(1404) = lu(1404) - lu(151) * lu(1388) + lu(1408) = lu(1408) - lu(152) * lu(1388) + lu(1412) = lu(1412) - lu(153) * lu(1388) + lu(1471) = lu(1471) - lu(147) * lu(1469) + lu(1475) = lu(1475) - lu(148) * lu(1469) + lu(1478) = lu(1478) - lu(149) * lu(1469) + lu(1485) = - lu(150) * lu(1469) + lu(1501) = lu(1501) - lu(151) * lu(1469) + lu(1505) = lu(1505) - lu(152) * lu(1469) + lu(1509) = lu(1509) - lu(153) * lu(1469) + lu(155) = 1._r8 / lu(155) + lu(156) = lu(156) * lu(155) + lu(157) = lu(157) * lu(155) + lu(158) = lu(158) * lu(155) + lu(159) = lu(159) * lu(155) + lu(160) = lu(160) * lu(155) + lu(161) = lu(161) * lu(155) + lu(162) = lu(162) * lu(155) + lu(430) = - lu(156) * lu(429) + lu(431) = lu(431) - lu(157) * lu(429) + lu(435) = lu(435) - lu(158) * lu(429) + lu(437) = lu(437) - lu(159) * lu(429) + lu(447) = - lu(160) * lu(429) + lu(448) = - lu(161) * lu(429) + lu(449) = lu(449) - lu(162) * lu(429) + lu(554) = lu(554) - lu(156) * lu(551) + lu(558) = lu(558) - lu(157) * lu(551) + lu(562) = lu(562) - lu(158) * lu(551) + lu(564) = lu(564) - lu(159) * lu(551) + lu(578) = - lu(160) * lu(551) + lu(579) = - lu(161) * lu(551) + lu(580) = lu(580) - lu(162) * lu(551) + lu(704) = lu(704) - lu(156) * lu(699) + lu(707) = lu(707) - lu(157) * lu(699) + lu(711) = lu(711) - lu(158) * lu(699) + lu(714) = lu(714) - lu(159) * lu(699) + lu(729) = lu(729) - lu(160) * lu(699) + lu(730) = lu(730) - lu(161) * lu(699) + lu(731) = lu(731) - lu(162) * lu(699) + lu(1624) = - lu(156) * lu(1623) + lu(1626) = - lu(157) * lu(1623) + lu(1634) = lu(1634) - lu(158) * lu(1623) + lu(1640) = lu(1640) - lu(159) * lu(1623) + lu(1657) = lu(1657) - lu(160) * lu(1623) + lu(1658) = lu(1658) - lu(161) * lu(1623) + lu(1659) = lu(1659) - lu(162) * lu(1623) + lu(1706) = - lu(156) * lu(1705) + lu(1711) = lu(1711) - lu(157) * lu(1705) + lu(1720) = lu(1720) - lu(158) * lu(1705) + lu(1726) = lu(1726) - lu(159) * lu(1705) + lu(1743) = lu(1743) - lu(160) * lu(1705) + lu(1744) = - lu(161) * lu(1705) + lu(1745) = lu(1745) - lu(162) * lu(1705) end subroutine lu_fac04 - subroutine lu_fac05( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac05( lu ) 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,159) = 1._r8 / lu(k,159) - lu(k,160) = lu(k,160) * lu(k,159) - lu(k,161) = lu(k,161) * lu(k,159) - lu(k,162) = lu(k,162) * lu(k,159) - lu(k,163) = lu(k,163) * lu(k,159) - lu(k,164) = lu(k,164) * lu(k,159) - lu(k,165) = lu(k,165) * lu(k,159) - lu(k,166) = lu(k,166) * lu(k,159) - lu(k,243) = lu(k,243) - lu(k,160) * lu(k,242) - lu(k,244) = lu(k,244) - lu(k,161) * lu(k,242) - lu(k,245) = lu(k,245) - lu(k,162) * lu(k,242) - lu(k,246) = - lu(k,163) * lu(k,242) - lu(k,250) = lu(k,250) - lu(k,164) * lu(k,242) - lu(k,251) = lu(k,251) - lu(k,165) * lu(k,242) - lu(k,255) = - lu(k,166) * lu(k,242) - lu(k,856) = - lu(k,160) * lu(k,855) - lu(k,857) = - lu(k,161) * lu(k,855) - lu(k,858) = lu(k,858) - lu(k,162) * lu(k,855) - lu(k,869) = - lu(k,163) * lu(k,855) - lu(k,880) = lu(k,880) - lu(k,164) * lu(k,855) - lu(k,887) = lu(k,887) - lu(k,165) * lu(k,855) - lu(k,899) = lu(k,899) - lu(k,166) * lu(k,855) - lu(k,954) = lu(k,954) - lu(k,160) * lu(k,953) - lu(k,960) = lu(k,960) - lu(k,161) * lu(k,953) - lu(k,961) = lu(k,961) - lu(k,162) * lu(k,953) - lu(k,968) = - lu(k,163) * lu(k,953) - lu(k,979) = lu(k,979) - lu(k,164) * lu(k,953) - lu(k,986) = lu(k,986) - lu(k,165) * lu(k,953) - lu(k,998) = lu(k,998) - lu(k,166) * lu(k,953) - lu(k,1012) = lu(k,1012) - lu(k,160) * lu(k,1011) - lu(k,1013) = lu(k,1013) - lu(k,161) * lu(k,1011) - lu(k,1014) = lu(k,1014) - lu(k,162) * lu(k,1011) - lu(k,1016) = lu(k,1016) - lu(k,163) * lu(k,1011) - lu(k,1022) = lu(k,1022) - lu(k,164) * lu(k,1011) - lu(k,1029) = lu(k,1029) - lu(k,165) * lu(k,1011) - lu(k,1041) = lu(k,1041) - lu(k,166) * lu(k,1011) - lu(k,1254) = lu(k,1254) - lu(k,160) * lu(k,1253) - lu(k,1256) = lu(k,1256) - lu(k,161) * lu(k,1253) - lu(k,1257) = lu(k,1257) - lu(k,162) * lu(k,1253) - lu(k,1260) = lu(k,1260) - lu(k,163) * lu(k,1253) - lu(k,1270) = lu(k,1270) - lu(k,164) * lu(k,1253) - lu(k,1277) = lu(k,1277) - lu(k,165) * lu(k,1253) - lu(k,1289) = lu(k,1289) - lu(k,166) * lu(k,1253) - 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,418) = - lu(k,169) * lu(k,417) - lu(k,419) = lu(k,419) - lu(k,170) * lu(k,417) - lu(k,423) = lu(k,423) - lu(k,171) * lu(k,417) - lu(k,426) = - lu(k,172) * lu(k,417) - lu(k,428) = - lu(k,173) * lu(k,417) - lu(k,435) = lu(k,435) - lu(k,174) * lu(k,417) - lu(k,437) = lu(k,437) - lu(k,175) * lu(k,417) - lu(k,567) = lu(k,567) - lu(k,169) * lu(k,564) - lu(k,570) = lu(k,570) - lu(k,170) * lu(k,564) - lu(k,575) = lu(k,575) - lu(k,171) * lu(k,564) - lu(k,579) = - lu(k,172) * lu(k,564) - lu(k,581) = - lu(k,173) * lu(k,564) - lu(k,592) = lu(k,592) - lu(k,174) * lu(k,564) - lu(k,594) = lu(k,594) - lu(k,175) * lu(k,564) - lu(k,747) = lu(k,747) - lu(k,169) * lu(k,743) - lu(k,750) = lu(k,750) - lu(k,170) * lu(k,743) - lu(k,755) = lu(k,755) - lu(k,171) * lu(k,743) - lu(k,761) = lu(k,761) - lu(k,172) * lu(k,743) - lu(k,763) = lu(k,763) - lu(k,173) * lu(k,743) - lu(k,774) = lu(k,774) - lu(k,174) * lu(k,743) - lu(k,776) = lu(k,776) - lu(k,175) * lu(k,743) - lu(k,1088) = - lu(k,169) * lu(k,1087) - lu(k,1090) = - lu(k,170) * lu(k,1087) - lu(k,1099) = lu(k,1099) - lu(k,171) * lu(k,1087) - lu(k,1107) = lu(k,1107) - lu(k,172) * lu(k,1087) - lu(k,1110) = lu(k,1110) - lu(k,173) * lu(k,1087) - lu(k,1122) = lu(k,1122) - lu(k,174) * lu(k,1087) - lu(k,1124) = lu(k,1124) - lu(k,175) * lu(k,1087) - lu(k,1785) = - lu(k,169) * lu(k,1784) - lu(k,1790) = lu(k,1790) - lu(k,170) * lu(k,1784) - lu(k,1800) = lu(k,1800) - lu(k,171) * lu(k,1784) - lu(k,1808) = lu(k,1808) - lu(k,172) * lu(k,1784) - lu(k,1811) = - lu(k,173) * lu(k,1784) - lu(k,1823) = lu(k,1823) - lu(k,174) * lu(k,1784) - lu(k,1825) = lu(k,1825) - lu(k,175) * lu(k,1784) - 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,182) = lu(k,182) * lu(k,176) - lu(k,244) = lu(k,244) - lu(k,177) * lu(k,243) - lu(k,245) = lu(k,245) - lu(k,178) * lu(k,243) - lu(k,249) = lu(k,249) - lu(k,179) * lu(k,243) - lu(k,250) = lu(k,250) - lu(k,180) * lu(k,243) - lu(k,251) = lu(k,251) - lu(k,181) * lu(k,243) - lu(k,252) = lu(k,252) - lu(k,182) * lu(k,243) - lu(k,269) = - lu(k,177) * lu(k,268) - lu(k,270) = lu(k,270) - lu(k,178) * lu(k,268) - lu(k,274) = lu(k,274) - lu(k,179) * lu(k,268) - lu(k,275) = lu(k,275) - lu(k,180) * lu(k,268) - lu(k,278) = lu(k,278) - lu(k,181) * lu(k,268) - lu(k,279) = lu(k,279) - lu(k,182) * lu(k,268) - lu(k,857) = lu(k,857) - lu(k,177) * lu(k,856) - lu(k,858) = lu(k,858) - lu(k,178) * lu(k,856) - lu(k,878) = lu(k,878) - lu(k,179) * lu(k,856) - lu(k,880) = lu(k,880) - lu(k,180) * lu(k,856) - lu(k,887) = lu(k,887) - lu(k,181) * lu(k,856) - lu(k,889) = - lu(k,182) * lu(k,856) - lu(k,960) = lu(k,960) - lu(k,177) * lu(k,954) - lu(k,961) = lu(k,961) - lu(k,178) * lu(k,954) - lu(k,977) = lu(k,977) - lu(k,179) * lu(k,954) - lu(k,979) = lu(k,979) - lu(k,180) * lu(k,954) - lu(k,986) = lu(k,986) - lu(k,181) * lu(k,954) - lu(k,988) = lu(k,988) - lu(k,182) * lu(k,954) - lu(k,1013) = lu(k,1013) - lu(k,177) * lu(k,1012) - lu(k,1014) = lu(k,1014) - lu(k,178) * lu(k,1012) - lu(k,1020) = lu(k,1020) - lu(k,179) * lu(k,1012) - lu(k,1022) = lu(k,1022) - lu(k,180) * lu(k,1012) - lu(k,1029) = lu(k,1029) - lu(k,181) * lu(k,1012) - lu(k,1031) = lu(k,1031) - lu(k,182) * lu(k,1012) - lu(k,1256) = lu(k,1256) - lu(k,177) * lu(k,1254) - lu(k,1257) = lu(k,1257) - lu(k,178) * lu(k,1254) - lu(k,1268) = lu(k,1268) - lu(k,179) * lu(k,1254) - lu(k,1270) = lu(k,1270) - lu(k,180) * lu(k,1254) - lu(k,1277) = lu(k,1277) - lu(k,181) * lu(k,1254) - lu(k,1279) = lu(k,1279) - lu(k,182) * lu(k,1254) - lu(k,184) = 1._r8 / lu(k,184) - lu(k,185) = lu(k,185) * lu(k,184) - lu(k,186) = lu(k,186) * lu(k,184) - lu(k,187) = lu(k,187) * lu(k,184) - lu(k,188) = lu(k,188) * lu(k,184) - lu(k,189) = lu(k,189) * lu(k,184) - lu(k,190) = lu(k,190) * lu(k,184) - lu(k,202) = lu(k,202) - lu(k,185) * lu(k,200) - lu(k,203) = lu(k,203) - lu(k,186) * lu(k,200) - lu(k,207) = lu(k,207) - lu(k,187) * lu(k,200) - lu(k,208) = lu(k,208) - lu(k,188) * lu(k,200) - lu(k,209) = lu(k,209) - lu(k,189) * lu(k,200) - lu(k,210) = - lu(k,190) * lu(k,200) - lu(k,687) = lu(k,687) - lu(k,185) * lu(k,678) - lu(k,689) = lu(k,689) - lu(k,186) * lu(k,678) - lu(k,700) = lu(k,700) - lu(k,187) * lu(k,678) - lu(k,701) = lu(k,701) - lu(k,188) * lu(k,678) - lu(k,704) = lu(k,704) - lu(k,189) * lu(k,678) - lu(k,707) = lu(k,707) - lu(k,190) * lu(k,678) - lu(k,755) = lu(k,755) - lu(k,185) * lu(k,744) - lu(k,758) = lu(k,758) - lu(k,186) * lu(k,744) - lu(k,769) = lu(k,769) - lu(k,187) * lu(k,744) - lu(k,770) = lu(k,770) - lu(k,188) * lu(k,744) - lu(k,773) = lu(k,773) - lu(k,189) * lu(k,744) - lu(k,776) = lu(k,776) - lu(k,190) * lu(k,744) - lu(k,974) = lu(k,974) - lu(k,185) * lu(k,955) - lu(k,979) = lu(k,979) - lu(k,186) * lu(k,955) - lu(k,991) = lu(k,991) - lu(k,187) * lu(k,955) - lu(k,992) = lu(k,992) - lu(k,188) * lu(k,955) - lu(k,996) = lu(k,996) - lu(k,189) * lu(k,955) - lu(k,999) = lu(k,999) - lu(k,190) * lu(k,955) - lu(k,1471) = lu(k,1471) - lu(k,185) * lu(k,1456) - lu(k,1476) = lu(k,1476) - lu(k,186) * lu(k,1456) - lu(k,1488) = lu(k,1488) - lu(k,187) * lu(k,1456) - lu(k,1489) = lu(k,1489) - lu(k,188) * lu(k,1456) - lu(k,1493) = lu(k,1493) - lu(k,189) * lu(k,1456) - lu(k,1496) = lu(k,1496) - lu(k,190) * lu(k,1456) - lu(k,1514) = lu(k,1514) - lu(k,185) * lu(k,1501) - lu(k,1519) = lu(k,1519) - lu(k,186) * lu(k,1501) - lu(k,1531) = lu(k,1531) - lu(k,187) * lu(k,1501) - lu(k,1532) = lu(k,1532) - lu(k,188) * lu(k,1501) - lu(k,1536) = lu(k,1536) - lu(k,189) * lu(k,1501) - lu(k,1539) = - lu(k,190) * lu(k,1501) - lu(k,1669) = lu(k,1669) - lu(k,185) * lu(k,1655) - lu(k,1674) = lu(k,1674) - lu(k,186) * lu(k,1655) - lu(k,1686) = lu(k,1686) - lu(k,187) * lu(k,1655) - lu(k,1687) = lu(k,1687) - lu(k,188) * lu(k,1655) - lu(k,1691) = lu(k,1691) - lu(k,189) * lu(k,1655) - lu(k,1694) = lu(k,1694) - lu(k,190) * lu(k,1655) - lu(k,191) = 1._r8 / lu(k,191) - lu(k,192) = lu(k,192) * lu(k,191) - lu(k,193) = lu(k,193) * lu(k,191) - lu(k,194) = lu(k,194) * lu(k,191) - lu(k,195) = lu(k,195) * lu(k,191) - lu(k,196) = lu(k,196) * lu(k,191) - lu(k,197) = lu(k,197) * lu(k,191) - lu(k,198) = lu(k,198) * lu(k,191) - lu(k,328) = lu(k,328) - lu(k,192) * lu(k,327) - lu(k,329) = lu(k,329) - lu(k,193) * lu(k,327) - lu(k,331) = - lu(k,194) * lu(k,327) - lu(k,333) = lu(k,333) - lu(k,195) * lu(k,327) - lu(k,334) = - lu(k,196) * lu(k,327) - lu(k,338) = lu(k,338) - lu(k,197) * lu(k,327) - lu(k,339) = - lu(k,198) * lu(k,327) - lu(k,538) = lu(k,538) - lu(k,192) * lu(k,537) - lu(k,540) = - lu(k,193) * lu(k,537) - lu(k,542) = - lu(k,194) * lu(k,537) - lu(k,544) = lu(k,544) - lu(k,195) * lu(k,537) - lu(k,545) = lu(k,545) - lu(k,196) * lu(k,537) - lu(k,558) = lu(k,558) - lu(k,197) * lu(k,537) - lu(k,560) = lu(k,560) - lu(k,198) * lu(k,537) - lu(k,569) = lu(k,569) - lu(k,192) * lu(k,565) - lu(k,571) = lu(k,571) - lu(k,193) * lu(k,565) - lu(k,573) = lu(k,573) - lu(k,194) * lu(k,565) - lu(k,575) = lu(k,575) - lu(k,195) * lu(k,565) - lu(k,577) = lu(k,577) - lu(k,196) * lu(k,565) - lu(k,592) = lu(k,592) - lu(k,197) * lu(k,565) - lu(k,594) = lu(k,594) - lu(k,198) * lu(k,565) - lu(k,681) = lu(k,681) - lu(k,192) * lu(k,679) - lu(k,683) = lu(k,683) - lu(k,193) * lu(k,679) - lu(k,685) = - lu(k,194) * lu(k,679) - lu(k,687) = lu(k,687) - lu(k,195) * lu(k,679) - lu(k,689) = lu(k,689) - lu(k,196) * lu(k,679) - lu(k,705) = lu(k,705) - lu(k,197) * lu(k,679) - lu(k,707) = lu(k,707) - lu(k,198) * lu(k,679) - lu(k,749) = lu(k,749) - lu(k,192) * lu(k,745) - lu(k,751) = lu(k,751) - lu(k,193) * lu(k,745) - lu(k,753) = lu(k,753) - lu(k,194) * lu(k,745) - lu(k,755) = lu(k,755) - lu(k,195) * lu(k,745) - lu(k,758) = lu(k,758) - lu(k,196) * lu(k,745) - lu(k,774) = lu(k,774) - lu(k,197) * lu(k,745) - lu(k,776) = lu(k,776) - lu(k,198) * lu(k,745) - lu(k,963) = lu(k,963) - lu(k,192) * lu(k,956) - lu(k,966) = lu(k,966) - lu(k,193) * lu(k,956) - lu(k,968) = lu(k,968) - lu(k,194) * lu(k,956) - lu(k,974) = lu(k,974) - lu(k,195) * lu(k,956) - lu(k,979) = lu(k,979) - lu(k,196) * lu(k,956) - lu(k,997) = lu(k,997) - lu(k,197) * lu(k,956) - lu(k,999) = lu(k,999) - lu(k,198) * lu(k,956) - end do + real(r8), intent(inout) :: lu(:) + lu(164) = 1._r8 / lu(164) + lu(165) = lu(165) * lu(164) + lu(166) = lu(166) * lu(164) + lu(167) = lu(167) * lu(164) + lu(168) = lu(168) * lu(164) + lu(169) = lu(169) * lu(164) + lu(170) = lu(170) * lu(164) + lu(171) = lu(171) * lu(164) + lu(410) = lu(410) - lu(165) * lu(409) + lu(411) = lu(411) - lu(166) * lu(409) + lu(415) = lu(415) - lu(167) * lu(409) + lu(416) = - lu(168) * lu(409) + lu(421) = lu(421) - lu(169) * lu(409) + lu(423) = lu(423) - lu(170) * lu(409) + lu(427) = - lu(171) * lu(409) + lu(665) = lu(665) - lu(165) * lu(661) + lu(666) = lu(666) - lu(166) * lu(661) + lu(671) = lu(671) - lu(167) * lu(661) + lu(672) = lu(672) - lu(168) * lu(661) + lu(679) = lu(679) - lu(169) * lu(661) + lu(684) = lu(684) - lu(170) * lu(661) + lu(690) = lu(690) - lu(171) * lu(661) + lu(888) = lu(888) - lu(165) * lu(885) + lu(892) = - lu(166) * lu(885) + lu(900) = lu(900) - lu(167) * lu(885) + lu(905) = lu(905) - lu(168) * lu(885) + lu(912) = lu(912) - lu(169) * lu(885) + lu(919) = lu(919) - lu(170) * lu(885) + lu(925) = lu(925) - lu(171) * lu(885) + lu(1050) = lu(1050) - lu(165) * lu(1046) + lu(1052) = lu(1052) - lu(166) * lu(1046) + lu(1062) = lu(1062) - lu(167) * lu(1046) + lu(1067) = - lu(168) * lu(1046) + lu(1074) = lu(1074) - lu(169) * lu(1046) + lu(1081) = lu(1081) - lu(170) * lu(1046) + lu(1087) = lu(1087) - lu(171) * lu(1046) + lu(1480) = lu(1480) - lu(165) * lu(1470) + lu(1482) = lu(1482) - lu(166) * lu(1470) + lu(1490) = lu(1490) - lu(167) * lu(1470) + lu(1495) = lu(1495) - lu(168) * lu(1470) + lu(1502) = lu(1502) - lu(169) * lu(1470) + lu(1509) = lu(1509) - lu(170) * lu(1470) + lu(1515) = lu(1515) - lu(171) * lu(1470) + lu(172) = 1._r8 / lu(172) + lu(173) = lu(173) * lu(172) + lu(174) = lu(174) * lu(172) + lu(175) = lu(175) * lu(172) + lu(176) = lu(176) * lu(172) + lu(177) = lu(177) * lu(172) + lu(178) = lu(178) * lu(172) + lu(206) = lu(206) - lu(173) * lu(205) + lu(207) = lu(207) - lu(174) * lu(205) + lu(211) = lu(211) - lu(175) * lu(205) + lu(213) = lu(213) - lu(176) * lu(205) + lu(214) = lu(214) - lu(177) * lu(205) + lu(216) = lu(216) - lu(178) * lu(205) + lu(252) = - lu(173) * lu(251) + lu(253) = lu(253) - lu(174) * lu(251) + lu(257) = lu(257) - lu(175) * lu(251) + lu(260) = lu(260) - lu(176) * lu(251) + lu(261) = lu(261) - lu(177) * lu(251) + lu(264) = lu(264) - lu(178) * lu(251) + lu(797) = lu(797) - lu(173) * lu(796) + lu(798) = lu(798) - lu(174) * lu(796) + lu(817) = lu(817) - lu(175) * lu(796) + lu(825) = lu(825) - lu(176) * lu(796) + lu(828) = - lu(177) * lu(796) + lu(833) = lu(833) - lu(178) * lu(796) + lu(1138) = lu(1138) - lu(173) * lu(1136) + lu(1139) = lu(1139) - lu(174) * lu(1136) + lu(1150) = lu(1150) - lu(175) * lu(1136) + lu(1158) = lu(1158) - lu(176) * lu(1136) + lu(1161) = lu(1161) - lu(177) * lu(1136) + lu(1166) = lu(1166) - lu(178) * lu(1136) + lu(1390) = lu(1390) - lu(173) * lu(1389) + lu(1391) = lu(1391) - lu(174) * lu(1389) + lu(1396) = lu(1396) - lu(175) * lu(1389) + lu(1404) = lu(1404) - lu(176) * lu(1389) + lu(1407) = lu(1407) - lu(177) * lu(1389) + lu(1412) = lu(1412) - lu(178) * lu(1389) + lu(1475) = lu(1475) - lu(173) * lu(1471) + lu(1478) = lu(1478) - lu(174) * lu(1471) + lu(1493) = lu(1493) - lu(175) * lu(1471) + lu(1501) = lu(1501) - lu(176) * lu(1471) + lu(1504) = lu(1504) - lu(177) * lu(1471) + lu(1509) = lu(1509) - lu(178) * lu(1471) + lu(179) = 1._r8 / lu(179) + lu(180) = lu(180) * lu(179) + lu(181) = lu(181) * lu(179) + lu(182) = lu(182) * lu(179) + lu(183) = lu(183) * lu(179) + lu(184) = lu(184) * lu(179) + lu(185) = lu(185) * lu(179) + lu(186) = lu(186) * lu(179) + lu(320) = lu(320) - lu(180) * lu(319) + lu(321) = lu(321) - lu(181) * lu(319) + lu(323) = - lu(182) * lu(319) + lu(325) = lu(325) - lu(183) * lu(319) + lu(326) = lu(326) - lu(184) * lu(319) + lu(328) = - lu(185) * lu(319) + lu(330) = - lu(186) * lu(319) + lu(526) = lu(526) - lu(180) * lu(525) + lu(527) = - lu(181) * lu(525) + lu(530) = - lu(182) * lu(525) + lu(532) = lu(532) - lu(183) * lu(525) + lu(534) = lu(534) - lu(184) * lu(525) + lu(541) = lu(541) - lu(185) * lu(525) + lu(547) = lu(547) - lu(186) * lu(525) + lu(556) = lu(556) - lu(180) * lu(552) + lu(557) = lu(557) - lu(181) * lu(552) + lu(560) = lu(560) - lu(182) * lu(552) + lu(562) = lu(562) - lu(183) * lu(552) + lu(564) = lu(564) - lu(184) * lu(552) + lu(574) = lu(574) - lu(185) * lu(552) + lu(580) = lu(580) - lu(186) * lu(552) + lu(665) = lu(665) - lu(180) * lu(662) + lu(666) = lu(666) - lu(181) * lu(662) + lu(669) = - lu(182) * lu(662) + lu(671) = lu(671) - lu(183) * lu(662) + lu(673) = lu(673) - lu(184) * lu(662) + lu(684) = lu(684) - lu(185) * lu(662) + lu(690) = lu(690) - lu(186) * lu(662) + lu(705) = lu(705) - lu(180) * lu(700) + lu(706) = lu(706) - lu(181) * lu(700) + lu(709) = lu(709) - lu(182) * lu(700) + lu(711) = lu(711) - lu(183) * lu(700) + lu(714) = lu(714) - lu(184) * lu(700) + lu(725) = lu(725) - lu(185) * lu(700) + lu(731) = lu(731) - lu(186) * lu(700) + lu(1480) = lu(1480) - lu(180) * lu(1472) + lu(1482) = lu(1482) - lu(181) * lu(1472) + lu(1485) = lu(1485) - lu(182) * lu(1472) + lu(1490) = lu(1490) - lu(183) * lu(1472) + lu(1496) = lu(1496) - lu(184) * lu(1472) + lu(1509) = lu(1509) - lu(185) * lu(1472) + lu(1515) = lu(1515) - lu(186) * lu(1472) + lu(188) = 1._r8 / lu(188) + lu(189) = lu(189) * lu(188) + lu(190) = lu(190) * lu(188) + lu(191) = lu(191) * lu(188) + lu(192) = lu(192) * lu(188) + lu(193) = lu(193) * lu(188) + lu(194) = lu(194) * lu(188) + lu(220) = lu(220) - lu(189) * lu(218) + lu(221) = lu(221) - lu(190) * lu(218) + lu(223) = lu(223) - lu(191) * lu(218) + lu(224) = lu(224) - lu(192) * lu(218) + lu(225) = lu(225) - lu(193) * lu(218) + lu(228) = - lu(194) * lu(218) + lu(671) = lu(671) - lu(189) * lu(663) + lu(672) = lu(672) - lu(190) * lu(663) + lu(677) = lu(677) - lu(191) * lu(663) + lu(679) = lu(679) - lu(192) * lu(663) + lu(684) = lu(684) - lu(193) * lu(663) + lu(690) = lu(690) - lu(194) * lu(663) + lu(711) = lu(711) - lu(189) * lu(701) + lu(713) = lu(713) - lu(190) * lu(701) + lu(718) = lu(718) - lu(191) * lu(701) + lu(720) = lu(720) - lu(192) * lu(701) + lu(725) = lu(725) - lu(193) * lu(701) + lu(731) = lu(731) - lu(194) * lu(701) + lu(900) = lu(900) - lu(189) * lu(886) + lu(905) = lu(905) - lu(190) * lu(886) + lu(910) = lu(910) - lu(191) * lu(886) + lu(912) = lu(912) - lu(192) * lu(886) + lu(919) = lu(919) - lu(193) * lu(886) + lu(925) = lu(925) - lu(194) * lu(886) + lu(1104) = lu(1104) - lu(189) * lu(1092) + lu(1109) = lu(1109) - lu(190) * lu(1092) + lu(1114) = lu(1114) - lu(191) * lu(1092) + lu(1116) = lu(1116) - lu(192) * lu(1092) + lu(1123) = lu(1123) - lu(193) * lu(1092) + lu(1129) = - lu(194) * lu(1092) + lu(1189) = lu(1189) - lu(189) * lu(1176) + lu(1194) = lu(1194) - lu(190) * lu(1176) + lu(1199) = lu(1199) - lu(191) * lu(1176) + lu(1201) = lu(1201) - lu(192) * lu(1176) + lu(1208) = lu(1208) - lu(193) * lu(1176) + lu(1214) = lu(1214) - lu(194) * lu(1176) + lu(1490) = lu(1490) - lu(189) * lu(1473) + lu(1495) = lu(1495) - lu(190) * lu(1473) + lu(1500) = lu(1500) - lu(191) * lu(1473) + lu(1502) = lu(1502) - lu(192) * lu(1473) + lu(1509) = lu(1509) - lu(193) * lu(1473) + lu(1515) = lu(1515) - lu(194) * lu(1473) + lu(195) = 1._r8 / lu(195) + lu(196) = lu(196) * lu(195) + lu(197) = lu(197) * lu(195) + lu(198) = lu(198) * lu(195) + lu(199) = lu(199) * lu(195) + lu(200) = lu(200) * lu(195) + lu(201) = lu(201) * lu(195) + lu(202) = lu(202) * lu(195) + lu(292) = lu(292) - lu(196) * lu(291) + lu(296) = lu(296) - lu(197) * lu(291) + lu(297) = - lu(198) * lu(291) + lu(298) = lu(298) - lu(199) * lu(291) + lu(299) = lu(299) - lu(200) * lu(291) + lu(301) = - lu(201) * lu(291) + lu(302) = lu(302) - lu(202) * lu(291) + lu(555) = - lu(196) * lu(553) + lu(568) = lu(568) - lu(197) * lu(553) + lu(570) = - lu(198) * lu(553) + lu(571) = - lu(199) * lu(553) + lu(573) = - lu(200) * lu(553) + lu(576) = - lu(201) * lu(553) + lu(577) = lu(577) - lu(202) * lu(553) + lu(1140) = lu(1140) - lu(196) * lu(1137) + lu(1158) = lu(1158) - lu(197) * lu(1137) + lu(1160) = lu(1160) - lu(198) * lu(1137) + lu(1161) = lu(1161) - lu(199) * lu(1137) + lu(1164) = lu(1164) - lu(200) * lu(1137) + lu(1168) = lu(1168) - lu(201) * lu(1137) + lu(1169) = lu(1169) - lu(202) * lu(1137) + lu(1218) = - lu(196) * lu(1216) + lu(1235) = lu(1235) - lu(197) * lu(1216) + lu(1237) = lu(1237) - lu(198) * lu(1216) + lu(1238) = lu(1238) - lu(199) * lu(1216) + lu(1241) = lu(1241) - lu(200) * lu(1216) + lu(1245) = lu(1245) - lu(201) * lu(1216) + lu(1246) = lu(1246) - lu(202) * lu(1216) + lu(1479) = lu(1479) - lu(196) * lu(1474) + lu(1501) = lu(1501) - lu(197) * lu(1474) + lu(1503) = lu(1503) - lu(198) * lu(1474) + lu(1504) = lu(1504) - lu(199) * lu(1474) + lu(1507) = lu(1507) - lu(200) * lu(1474) + lu(1511) = lu(1511) - lu(201) * lu(1474) + lu(1512) = lu(1512) - lu(202) * lu(1474) + lu(1549) = - lu(196) * lu(1548) + lu(1568) = lu(1568) - lu(197) * lu(1548) + lu(1570) = - lu(198) * lu(1548) + lu(1571) = - lu(199) * lu(1548) + lu(1574) = lu(1574) - lu(200) * lu(1548) + lu(1578) = lu(1578) - lu(201) * lu(1548) + lu(1579) = lu(1579) - lu(202) * lu(1548) + lu(1585) = - lu(196) * lu(1584) + lu(1606) = lu(1606) - lu(197) * lu(1584) + lu(1608) = lu(1608) - lu(198) * lu(1584) + lu(1609) = - lu(199) * lu(1584) + lu(1612) = lu(1612) - lu(200) * lu(1584) + lu(1616) = lu(1616) - lu(201) * lu(1584) + lu(1617) = lu(1617) - lu(202) * lu(1584) end subroutine lu_fac05 - subroutine lu_fac06( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac06( lu ) 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,201) = 1._r8 / lu(k,201) - lu(k,202) = lu(k,202) * lu(k,201) - lu(k,203) = lu(k,203) * lu(k,201) - lu(k,204) = lu(k,204) * lu(k,201) - lu(k,205) = lu(k,205) * lu(k,201) - lu(k,206) = lu(k,206) * lu(k,201) - lu(k,207) = lu(k,207) * lu(k,201) - lu(k,208) = lu(k,208) * lu(k,201) - lu(k,209) = lu(k,209) * lu(k,201) - lu(k,210) = lu(k,210) * lu(k,201) - lu(k,755) = lu(k,755) - lu(k,202) * lu(k,746) - lu(k,758) = lu(k,758) - lu(k,203) * lu(k,746) - lu(k,761) = lu(k,761) - lu(k,204) * lu(k,746) - lu(k,762) = lu(k,762) - lu(k,205) * lu(k,746) - lu(k,763) = lu(k,763) - lu(k,206) * lu(k,746) - lu(k,769) = lu(k,769) - lu(k,207) * lu(k,746) - lu(k,770) = lu(k,770) - lu(k,208) * lu(k,746) - lu(k,773) = lu(k,773) - lu(k,209) * lu(k,746) - lu(k,776) = lu(k,776) - lu(k,210) * lu(k,746) - lu(k,974) = lu(k,974) - lu(k,202) * lu(k,957) - lu(k,979) = lu(k,979) - lu(k,203) * lu(k,957) - lu(k,982) = lu(k,982) - lu(k,204) * lu(k,957) - lu(k,983) = lu(k,983) - lu(k,205) * lu(k,957) - lu(k,985) = lu(k,985) - lu(k,206) * lu(k,957) - lu(k,991) = lu(k,991) - lu(k,207) * lu(k,957) - lu(k,992) = lu(k,992) - lu(k,208) * lu(k,957) - lu(k,996) = lu(k,996) - lu(k,209) * lu(k,957) - lu(k,999) = lu(k,999) - lu(k,210) * lu(k,957) - lu(k,1144) = lu(k,1144) - lu(k,202) * lu(k,1128) - lu(k,1149) = lu(k,1149) - lu(k,203) * lu(k,1128) - lu(k,1152) = lu(k,1152) - lu(k,204) * lu(k,1128) - lu(k,1153) = lu(k,1153) - lu(k,205) * lu(k,1128) - lu(k,1155) = lu(k,1155) - lu(k,206) * lu(k,1128) - lu(k,1161) = lu(k,1161) - lu(k,207) * lu(k,1128) - lu(k,1162) = lu(k,1162) - lu(k,208) * lu(k,1128) - lu(k,1166) = lu(k,1166) - lu(k,209) * lu(k,1128) - lu(k,1169) = lu(k,1169) - lu(k,210) * lu(k,1128) - lu(k,1471) = lu(k,1471) - lu(k,202) * lu(k,1457) - lu(k,1476) = lu(k,1476) - lu(k,203) * lu(k,1457) - lu(k,1479) = lu(k,1479) - lu(k,204) * lu(k,1457) - lu(k,1480) = lu(k,1480) - lu(k,205) * lu(k,1457) - lu(k,1482) = - lu(k,206) * lu(k,1457) - lu(k,1488) = lu(k,1488) - lu(k,207) * lu(k,1457) - lu(k,1489) = lu(k,1489) - lu(k,208) * lu(k,1457) - lu(k,1493) = lu(k,1493) - lu(k,209) * lu(k,1457) - lu(k,1496) = lu(k,1496) - lu(k,210) * lu(k,1457) - lu(k,1514) = lu(k,1514) - lu(k,202) * lu(k,1502) - lu(k,1519) = lu(k,1519) - lu(k,203) * lu(k,1502) - lu(k,1522) = - lu(k,204) * lu(k,1502) - lu(k,1523) = lu(k,1523) - lu(k,205) * lu(k,1502) - lu(k,1525) = lu(k,1525) - lu(k,206) * lu(k,1502) - lu(k,1531) = lu(k,1531) - lu(k,207) * lu(k,1502) - lu(k,1532) = lu(k,1532) - lu(k,208) * lu(k,1502) - lu(k,1536) = lu(k,1536) - lu(k,209) * lu(k,1502) - lu(k,1539) = lu(k,1539) - lu(k,210) * lu(k,1502) - lu(k,1669) = lu(k,1669) - lu(k,202) * lu(k,1656) - lu(k,1674) = lu(k,1674) - lu(k,203) * lu(k,1656) - lu(k,1677) = - lu(k,204) * lu(k,1656) - lu(k,1678) = lu(k,1678) - lu(k,205) * lu(k,1656) - lu(k,1680) = lu(k,1680) - lu(k,206) * lu(k,1656) - lu(k,1686) = lu(k,1686) - lu(k,207) * lu(k,1656) - lu(k,1687) = lu(k,1687) - lu(k,208) * lu(k,1656) - lu(k,1691) = lu(k,1691) - lu(k,209) * lu(k,1656) - lu(k,1694) = lu(k,1694) - lu(k,210) * lu(k,1656) - lu(k,211) = 1._r8 / lu(k,211) - lu(k,212) = lu(k,212) * lu(k,211) - lu(k,213) = lu(k,213) * lu(k,211) - lu(k,214) = lu(k,214) * lu(k,211) - lu(k,215) = lu(k,215) * lu(k,211) - lu(k,216) = lu(k,216) * lu(k,211) - lu(k,217) = lu(k,217) * lu(k,211) - lu(k,218) = lu(k,218) * lu(k,211) - lu(k,618) = lu(k,618) - lu(k,212) * lu(k,616) - lu(k,622) = - lu(k,213) * lu(k,616) - lu(k,628) = lu(k,628) - lu(k,214) * lu(k,616) - lu(k,632) = - lu(k,215) * lu(k,616) - lu(k,634) = lu(k,634) - lu(k,216) * lu(k,616) - lu(k,644) = lu(k,644) - lu(k,217) * lu(k,616) - lu(k,646) = lu(k,646) - lu(k,218) * lu(k,616) - lu(k,781) = lu(k,781) - lu(k,212) * lu(k,777) - lu(k,783) = lu(k,783) - lu(k,213) * lu(k,777) - lu(k,789) = lu(k,789) - lu(k,214) * lu(k,777) - lu(k,793) = lu(k,793) - lu(k,215) * lu(k,777) - lu(k,796) = lu(k,796) - lu(k,216) * lu(k,777) - lu(k,806) = lu(k,806) - lu(k,217) * lu(k,777) - lu(k,808) = lu(k,808) - lu(k,218) * lu(k,777) - lu(k,969) = lu(k,969) - lu(k,212) * lu(k,958) - lu(k,973) = lu(k,973) - lu(k,213) * lu(k,958) - lu(k,979) = lu(k,979) - lu(k,214) * lu(k,958) - lu(k,983) = lu(k,983) - lu(k,215) * lu(k,958) - lu(k,986) = lu(k,986) - lu(k,216) * lu(k,958) - lu(k,996) = lu(k,996) - lu(k,217) * lu(k,958) - lu(k,998) = lu(k,998) - lu(k,218) * lu(k,958) - lu(k,1296) = lu(k,1296) - lu(k,212) * lu(k,1292) - lu(k,1300) = lu(k,1300) - lu(k,213) * lu(k,1292) - lu(k,1306) = lu(k,1306) - lu(k,214) * lu(k,1292) - lu(k,1310) = lu(k,1310) - lu(k,215) * lu(k,1292) - lu(k,1313) = lu(k,1313) - lu(k,216) * lu(k,1292) - lu(k,1323) = lu(k,1323) - lu(k,217) * lu(k,1292) - lu(k,1325) = lu(k,1325) - lu(k,218) * lu(k,1292) - lu(k,1509) = lu(k,1509) - lu(k,212) * lu(k,1503) - lu(k,1513) = lu(k,1513) - lu(k,213) * lu(k,1503) - lu(k,1519) = lu(k,1519) - lu(k,214) * lu(k,1503) - lu(k,1523) = lu(k,1523) - lu(k,215) * lu(k,1503) - lu(k,1526) = lu(k,1526) - lu(k,216) * lu(k,1503) - lu(k,1536) = lu(k,1536) - lu(k,217) * lu(k,1503) - lu(k,1538) = lu(k,1538) - lu(k,218) * lu(k,1503) - lu(k,1586) = lu(k,1586) - lu(k,212) * lu(k,1583) - lu(k,1589) = lu(k,1589) - lu(k,213) * lu(k,1583) - lu(k,1595) = lu(k,1595) - lu(k,214) * lu(k,1583) - lu(k,1599) = lu(k,1599) - lu(k,215) * lu(k,1583) - lu(k,1602) = - lu(k,216) * lu(k,1583) - lu(k,1612) = lu(k,1612) - lu(k,217) * lu(k,1583) - lu(k,1614) = - lu(k,218) * lu(k,1583) - lu(k,1664) = lu(k,1664) - lu(k,212) * lu(k,1657) - lu(k,1668) = lu(k,1668) - lu(k,213) * lu(k,1657) - lu(k,1674) = lu(k,1674) - lu(k,214) * lu(k,1657) - lu(k,1678) = lu(k,1678) - lu(k,215) * lu(k,1657) - lu(k,1681) = lu(k,1681) - lu(k,216) * lu(k,1657) - lu(k,1691) = lu(k,1691) - lu(k,217) * lu(k,1657) - lu(k,1693) = - lu(k,218) * lu(k,1657) - lu(k,1743) = lu(k,1743) - lu(k,212) * lu(k,1732) - lu(k,1746) = lu(k,1746) - lu(k,213) * lu(k,1732) - lu(k,1752) = lu(k,1752) - lu(k,214) * lu(k,1732) - lu(k,1756) = lu(k,1756) - lu(k,215) * lu(k,1732) - lu(k,1759) = lu(k,1759) - lu(k,216) * lu(k,1732) - lu(k,1769) = lu(k,1769) - lu(k,217) * lu(k,1732) - lu(k,1771) = lu(k,1771) - lu(k,218) * lu(k,1732) - lu(k,219) = 1._r8 / lu(k,219) - lu(k,220) = lu(k,220) * lu(k,219) - lu(k,221) = lu(k,221) * lu(k,219) - lu(k,222) = lu(k,222) * lu(k,219) - lu(k,223) = lu(k,223) * lu(k,219) - lu(k,224) = lu(k,224) * lu(k,219) - lu(k,225) = lu(k,225) * lu(k,219) - lu(k,226) = lu(k,226) * lu(k,219) - lu(k,285) = lu(k,285) - lu(k,220) * lu(k,284) - lu(k,289) = lu(k,289) - lu(k,221) * lu(k,284) - lu(k,290) = lu(k,290) - lu(k,222) * lu(k,284) - lu(k,291) = - lu(k,223) * lu(k,284) - lu(k,292) = lu(k,292) - lu(k,224) * lu(k,284) - lu(k,293) = lu(k,293) - lu(k,225) * lu(k,284) - lu(k,294) = - lu(k,226) * lu(k,284) - lu(k,568) = - lu(k,220) * lu(k,566) - lu(k,578) = - lu(k,221) * lu(k,566) - lu(k,582) = lu(k,582) - lu(k,222) * lu(k,566) - lu(k,583) = - lu(k,223) * lu(k,566) - lu(k,584) = - lu(k,224) * lu(k,566) - lu(k,586) = lu(k,586) - lu(k,225) * lu(k,566) - lu(k,590) = - lu(k,226) * lu(k,566) - lu(k,962) = lu(k,962) - lu(k,220) * lu(k,959) - lu(k,980) = lu(k,980) - lu(k,221) * lu(k,959) - lu(k,986) = lu(k,986) - lu(k,222) * lu(k,959) - lu(k,987) = lu(k,987) - lu(k,223) * lu(k,959) - lu(k,988) = lu(k,988) - lu(k,224) * lu(k,959) - lu(k,990) = lu(k,990) - lu(k,225) * lu(k,959) - lu(k,995) = lu(k,995) - lu(k,226) * lu(k,959) - lu(k,1258) = lu(k,1258) - lu(k,220) * lu(k,1255) - lu(k,1271) = lu(k,1271) - lu(k,221) * lu(k,1255) - lu(k,1277) = lu(k,1277) - lu(k,222) * lu(k,1255) - lu(k,1278) = lu(k,1278) - lu(k,223) * lu(k,1255) - lu(k,1279) = lu(k,1279) - lu(k,224) * lu(k,1255) - lu(k,1281) = lu(k,1281) - lu(k,225) * lu(k,1255) - lu(k,1286) = lu(k,1286) - lu(k,226) * lu(k,1255) - lu(k,1294) = - lu(k,220) * lu(k,1293) - lu(k,1307) = lu(k,1307) - lu(k,221) * lu(k,1293) - lu(k,1313) = lu(k,1313) - lu(k,222) * lu(k,1293) - lu(k,1314) = lu(k,1314) - lu(k,223) * lu(k,1293) - lu(k,1315) = lu(k,1315) - lu(k,224) * lu(k,1293) - lu(k,1317) = lu(k,1317) - lu(k,225) * lu(k,1293) - lu(k,1322) = lu(k,1322) - lu(k,226) * lu(k,1293) - lu(k,1380) = - lu(k,220) * lu(k,1377) - lu(k,1394) = lu(k,1394) - lu(k,221) * lu(k,1377) - lu(k,1400) = lu(k,1400) - lu(k,222) * lu(k,1377) - lu(k,1401) = lu(k,1401) - lu(k,223) * lu(k,1377) - lu(k,1402) = lu(k,1402) - lu(k,224) * lu(k,1377) - lu(k,1404) = - lu(k,225) * lu(k,1377) - lu(k,1409) = lu(k,1409) - lu(k,226) * lu(k,1377) - lu(k,1416) = - lu(k,220) * lu(k,1415) - lu(k,1432) = lu(k,1432) - lu(k,221) * lu(k,1415) - lu(k,1438) = lu(k,1438) - lu(k,222) * lu(k,1415) - lu(k,1439) = lu(k,1439) - lu(k,223) * lu(k,1415) - lu(k,1440) = - lu(k,224) * lu(k,1415) - lu(k,1442) = lu(k,1442) - lu(k,225) * lu(k,1415) - lu(k,1447) = lu(k,1447) - lu(k,226) * lu(k,1415) - lu(k,1617) = - lu(k,220) * lu(k,1616) - lu(k,1632) = lu(k,1632) - lu(k,221) * lu(k,1616) - lu(k,1638) = lu(k,1638) - lu(k,222) * lu(k,1616) - lu(k,1639) = - lu(k,223) * lu(k,1616) - lu(k,1640) = - lu(k,224) * lu(k,1616) - lu(k,1642) = lu(k,1642) - lu(k,225) * lu(k,1616) - lu(k,1647) = lu(k,1647) - lu(k,226) * lu(k,1616) - lu(k,229) = 1._r8 / lu(k,229) - lu(k,230) = lu(k,230) * lu(k,229) - lu(k,231) = lu(k,231) * lu(k,229) - lu(k,232) = lu(k,232) * lu(k,229) - lu(k,233) = lu(k,233) * lu(k,229) - lu(k,234) = lu(k,234) * lu(k,229) - lu(k,235) = lu(k,235) * lu(k,229) - lu(k,236) = lu(k,236) * lu(k,229) - lu(k,237) = lu(k,237) * lu(k,229) - lu(k,238) = lu(k,238) * lu(k,229) - lu(k,239) = lu(k,239) * lu(k,229) - lu(k,240) = lu(k,240) * lu(k,229) - lu(k,476) = lu(k,476) - lu(k,230) * lu(k,475) - lu(k,477) = lu(k,477) - lu(k,231) * lu(k,475) - lu(k,478) = lu(k,478) - lu(k,232) * lu(k,475) - lu(k,483) = - lu(k,233) * lu(k,475) - lu(k,485) = lu(k,485) - lu(k,234) * lu(k,475) - lu(k,486) = - lu(k,235) * lu(k,475) - lu(k,487) = lu(k,487) - lu(k,236) * lu(k,475) - lu(k,488) = lu(k,488) - lu(k,237) * lu(k,475) - lu(k,491) = lu(k,491) - lu(k,238) * lu(k,475) - lu(k,493) = lu(k,493) - lu(k,239) * lu(k,475) - lu(k,494) = lu(k,494) - lu(k,240) * lu(k,475) - lu(k,517) = lu(k,517) - lu(k,230) * lu(k,516) - lu(k,518) = lu(k,518) - lu(k,231) * lu(k,516) - lu(k,519) = lu(k,519) - lu(k,232) * lu(k,516) - lu(k,524) = - lu(k,233) * lu(k,516) - lu(k,526) = lu(k,526) - lu(k,234) * lu(k,516) - lu(k,527) = - lu(k,235) * lu(k,516) - lu(k,528) = lu(k,528) - lu(k,236) * lu(k,516) - lu(k,529) = lu(k,529) - lu(k,237) * lu(k,516) - lu(k,532) = lu(k,532) - lu(k,238) * lu(k,516) - lu(k,534) = lu(k,534) - lu(k,239) * lu(k,516) - lu(k,535) = lu(k,535) - lu(k,240) * lu(k,516) - lu(k,1133) = - lu(k,230) * lu(k,1129) - lu(k,1135) = - lu(k,231) * lu(k,1129) - lu(k,1137) = lu(k,1137) - lu(k,232) * lu(k,1129) - lu(k,1149) = lu(k,1149) - lu(k,233) * lu(k,1129) - lu(k,1152) = lu(k,1152) - lu(k,234) * lu(k,1129) - lu(k,1153) = lu(k,1153) - lu(k,235) * lu(k,1129) - lu(k,1154) = - lu(k,236) * lu(k,1129) - lu(k,1155) = lu(k,1155) - lu(k,237) * lu(k,1129) - lu(k,1163) = - lu(k,238) * lu(k,1129) - lu(k,1168) = lu(k,1168) - lu(k,239) * lu(k,1129) - lu(k,1169) = lu(k,1169) - lu(k,240) * lu(k,1129) - lu(k,1178) = lu(k,1178) - lu(k,230) * lu(k,1171) - lu(k,1179) = lu(k,1179) - lu(k,231) * lu(k,1171) - lu(k,1181) = lu(k,1181) - lu(k,232) * lu(k,1171) - lu(k,1192) = lu(k,1192) - lu(k,233) * lu(k,1171) - lu(k,1195) = lu(k,1195) - lu(k,234) * lu(k,1171) - lu(k,1196) = lu(k,1196) - lu(k,235) * lu(k,1171) - lu(k,1197) = lu(k,1197) - lu(k,236) * lu(k,1171) - lu(k,1198) = lu(k,1198) - lu(k,237) * lu(k,1171) - lu(k,1206) = lu(k,1206) - lu(k,238) * lu(k,1171) - lu(k,1211) = - lu(k,239) * lu(k,1171) - lu(k,1212) = lu(k,1212) - lu(k,240) * lu(k,1171) - lu(k,1215) = - lu(k,230) * lu(k,1214) - lu(k,1216) = - lu(k,231) * lu(k,1214) - lu(k,1217) = - lu(k,232) * lu(k,1214) - lu(k,1227) = lu(k,1227) - lu(k,233) * lu(k,1214) - lu(k,1230) = lu(k,1230) - lu(k,234) * lu(k,1214) - lu(k,1231) = lu(k,1231) - lu(k,235) * lu(k,1214) - lu(k,1232) = - lu(k,236) * lu(k,1214) - lu(k,1233) = lu(k,1233) - lu(k,237) * lu(k,1214) - lu(k,1241) = - lu(k,238) * lu(k,1214) - lu(k,1246) = lu(k,1246) - lu(k,239) * lu(k,1214) - lu(k,1247) = - lu(k,240) * lu(k,1214) - lu(k,1548) = lu(k,1548) - lu(k,230) * lu(k,1541) - lu(k,1549) = lu(k,1549) - lu(k,231) * lu(k,1541) - lu(k,1551) = lu(k,1551) - lu(k,232) * lu(k,1541) - lu(k,1562) = lu(k,1562) - lu(k,233) * lu(k,1541) - lu(k,1565) = lu(k,1565) - lu(k,234) * lu(k,1541) - lu(k,1566) = lu(k,1566) - lu(k,235) * lu(k,1541) - lu(k,1567) = lu(k,1567) - lu(k,236) * lu(k,1541) - lu(k,1568) = lu(k,1568) - lu(k,237) * lu(k,1541) - lu(k,1576) = lu(k,1576) - lu(k,238) * lu(k,1541) - lu(k,1581) = - lu(k,239) * lu(k,1541) - lu(k,1582) = lu(k,1582) - lu(k,240) * lu(k,1541) - end do + real(r8), intent(inout) :: lu(:) + lu(206) = 1._r8 / lu(206) + lu(207) = lu(207) * lu(206) + lu(208) = lu(208) * lu(206) + lu(209) = lu(209) * lu(206) + lu(210) = lu(210) * lu(206) + lu(211) = lu(211) * lu(206) + lu(212) = lu(212) * lu(206) + lu(213) = lu(213) * lu(206) + lu(214) = lu(214) * lu(206) + lu(215) = lu(215) * lu(206) + lu(216) = lu(216) * lu(206) + lu(253) = lu(253) - lu(207) * lu(252) + lu(254) = - lu(208) * lu(252) + lu(255) = - lu(209) * lu(252) + lu(256) = lu(256) - lu(210) * lu(252) + lu(257) = lu(257) - lu(211) * lu(252) + lu(258) = lu(258) - lu(212) * lu(252) + lu(260) = lu(260) - lu(213) * lu(252) + lu(261) = lu(261) - lu(214) * lu(252) + lu(262) = lu(262) - lu(215) * lu(252) + lu(264) = lu(264) - lu(216) * lu(252) + lu(798) = lu(798) - lu(207) * lu(797) + lu(809) = lu(809) - lu(208) * lu(797) + lu(813) = - lu(209) * lu(797) + lu(814) = lu(814) - lu(210) * lu(797) + lu(817) = lu(817) - lu(211) * lu(797) + lu(820) = - lu(212) * lu(797) + lu(825) = lu(825) - lu(213) * lu(797) + lu(828) = lu(828) - lu(214) * lu(797) + lu(829) = lu(829) - lu(215) * lu(797) + lu(833) = lu(833) - lu(216) * lu(797) + lu(1139) = lu(1139) - lu(207) * lu(1138) + lu(1142) = lu(1142) - lu(208) * lu(1138) + lu(1146) = lu(1146) - lu(209) * lu(1138) + lu(1147) = - lu(210) * lu(1138) + lu(1150) = lu(1150) - lu(211) * lu(1138) + lu(1153) = lu(1153) - lu(212) * lu(1138) + lu(1158) = lu(1158) - lu(213) * lu(1138) + lu(1161) = lu(1161) - lu(214) * lu(1138) + lu(1162) = lu(1162) - lu(215) * lu(1138) + lu(1166) = lu(1166) - lu(216) * lu(1138) + lu(1391) = lu(1391) - lu(207) * lu(1390) + lu(1393) = lu(1393) - lu(208) * lu(1390) + lu(1394) = - lu(209) * lu(1390) + lu(1395) = lu(1395) - lu(210) * lu(1390) + lu(1396) = lu(1396) - lu(211) * lu(1390) + lu(1399) = lu(1399) - lu(212) * lu(1390) + lu(1404) = lu(1404) - lu(213) * lu(1390) + lu(1407) = lu(1407) - lu(214) * lu(1390) + lu(1408) = lu(1408) - lu(215) * lu(1390) + lu(1412) = lu(1412) - lu(216) * lu(1390) + lu(1478) = lu(1478) - lu(207) * lu(1475) + lu(1485) = lu(1485) - lu(208) * lu(1475) + lu(1489) = lu(1489) - lu(209) * lu(1475) + lu(1490) = lu(1490) - lu(210) * lu(1475) + lu(1493) = lu(1493) - lu(211) * lu(1475) + lu(1496) = lu(1496) - lu(212) * lu(1475) + lu(1501) = lu(1501) - lu(213) * lu(1475) + lu(1504) = lu(1504) - lu(214) * lu(1475) + lu(1505) = lu(1505) - lu(215) * lu(1475) + lu(1509) = lu(1509) - lu(216) * lu(1475) + lu(219) = 1._r8 / lu(219) + lu(220) = lu(220) * lu(219) + lu(221) = lu(221) * lu(219) + lu(222) = lu(222) * lu(219) + lu(223) = lu(223) * lu(219) + lu(224) = lu(224) * lu(219) + lu(225) = lu(225) * lu(219) + lu(226) = lu(226) * lu(219) + lu(227) = lu(227) * lu(219) + lu(228) = lu(228) * lu(219) + lu(711) = lu(711) - lu(220) * lu(702) + lu(713) = lu(713) - lu(221) * lu(702) + lu(717) = lu(717) - lu(222) * lu(702) + lu(718) = lu(718) - lu(223) * lu(702) + lu(720) = lu(720) - lu(224) * lu(702) + lu(725) = lu(725) - lu(225) * lu(702) + lu(729) = lu(729) - lu(226) * lu(702) + lu(730) = lu(730) - lu(227) * lu(702) + lu(731) = lu(731) - lu(228) * lu(702) + lu(900) = lu(900) - lu(220) * lu(887) + lu(905) = lu(905) - lu(221) * lu(887) + lu(909) = lu(909) - lu(222) * lu(887) + lu(910) = lu(910) - lu(223) * lu(887) + lu(912) = lu(912) - lu(224) * lu(887) + lu(919) = lu(919) - lu(225) * lu(887) + lu(923) = lu(923) - lu(226) * lu(887) + lu(924) = - lu(227) * lu(887) + lu(925) = lu(925) - lu(228) * lu(887) + lu(1062) = lu(1062) - lu(220) * lu(1047) + lu(1067) = lu(1067) - lu(221) * lu(1047) + lu(1071) = lu(1071) - lu(222) * lu(1047) + lu(1072) = lu(1072) - lu(223) * lu(1047) + lu(1074) = lu(1074) - lu(224) * lu(1047) + lu(1081) = lu(1081) - lu(225) * lu(1047) + lu(1085) = lu(1085) - lu(226) * lu(1047) + lu(1086) = lu(1086) - lu(227) * lu(1047) + lu(1087) = lu(1087) - lu(228) * lu(1047) + lu(1104) = lu(1104) - lu(220) * lu(1093) + lu(1109) = lu(1109) - lu(221) * lu(1093) + lu(1113) = lu(1113) - lu(222) * lu(1093) + lu(1114) = lu(1114) - lu(223) * lu(1093) + lu(1116) = lu(1116) - lu(224) * lu(1093) + lu(1123) = lu(1123) - lu(225) * lu(1093) + lu(1127) = - lu(226) * lu(1093) + lu(1128) = lu(1128) - lu(227) * lu(1093) + lu(1129) = lu(1129) - lu(228) * lu(1093) + lu(1189) = lu(1189) - lu(220) * lu(1177) + lu(1194) = lu(1194) - lu(221) * lu(1177) + lu(1198) = lu(1198) - lu(222) * lu(1177) + lu(1199) = lu(1199) - lu(223) * lu(1177) + lu(1201) = lu(1201) - lu(224) * lu(1177) + lu(1208) = lu(1208) - lu(225) * lu(1177) + lu(1212) = - lu(226) * lu(1177) + lu(1213) = lu(1213) - lu(227) * lu(1177) + lu(1214) = lu(1214) - lu(228) * lu(1177) + lu(1490) = lu(1490) - lu(220) * lu(1476) + lu(1495) = lu(1495) - lu(221) * lu(1476) + lu(1499) = lu(1499) - lu(222) * lu(1476) + lu(1500) = lu(1500) - lu(223) * lu(1476) + lu(1502) = lu(1502) - lu(224) * lu(1476) + lu(1509) = lu(1509) - lu(225) * lu(1476) + lu(1513) = lu(1513) - lu(226) * lu(1476) + lu(1514) = lu(1514) - lu(227) * lu(1476) + lu(1515) = lu(1515) - lu(228) * lu(1476) + lu(229) = 1._r8 / lu(229) + lu(230) = lu(230) * lu(229) + lu(231) = lu(231) * lu(229) + lu(232) = lu(232) * lu(229) + lu(233) = lu(233) * lu(229) + lu(234) = lu(234) * lu(229) + lu(235) = lu(235) * lu(229) + lu(236) = lu(236) * lu(229) + lu(584) = lu(584) - lu(230) * lu(581) + lu(589) = - lu(231) * lu(581) + lu(596) = - lu(232) * lu(581) + lu(598) = lu(598) - lu(233) * lu(581) + lu(599) = lu(599) - lu(234) * lu(581) + lu(602) = lu(602) - lu(235) * lu(581) + lu(606) = lu(606) - lu(236) * lu(581) + lu(736) = lu(736) - lu(230) * lu(732) + lu(740) = lu(740) - lu(231) * lu(732) + lu(747) = lu(747) - lu(232) * lu(732) + lu(749) = lu(749) - lu(233) * lu(732) + lu(750) = lu(750) - lu(234) * lu(732) + lu(753) = lu(753) - lu(235) * lu(732) + lu(757) = lu(757) - lu(236) * lu(732) + lu(1101) = lu(1101) - lu(230) * lu(1094) + lu(1106) = lu(1106) - lu(231) * lu(1094) + lu(1113) = lu(1113) - lu(232) * lu(1094) + lu(1115) = lu(1115) - lu(233) * lu(1094) + lu(1116) = lu(1116) - lu(234) * lu(1094) + lu(1119) = lu(1119) - lu(235) * lu(1094) + lu(1123) = lu(1123) - lu(236) * lu(1094) + lu(1186) = lu(1186) - lu(230) * lu(1178) + lu(1191) = lu(1191) - lu(231) * lu(1178) + lu(1198) = lu(1198) - lu(232) * lu(1178) + lu(1200) = lu(1200) - lu(233) * lu(1178) + lu(1201) = lu(1201) - lu(234) * lu(1178) + lu(1204) = - lu(235) * lu(1178) + lu(1208) = lu(1208) - lu(236) * lu(1178) + lu(1221) = lu(1221) - lu(230) * lu(1217) + lu(1226) = lu(1226) - lu(231) * lu(1217) + lu(1233) = lu(1233) - lu(232) * lu(1217) + lu(1235) = lu(1235) - lu(233) * lu(1217) + lu(1236) = lu(1236) - lu(234) * lu(1217) + lu(1239) = lu(1239) - lu(235) * lu(1217) + lu(1243) = lu(1243) - lu(236) * lu(1217) + lu(1306) = lu(1306) - lu(230) * lu(1295) + lu(1311) = lu(1311) - lu(231) * lu(1295) + lu(1318) = lu(1318) - lu(232) * lu(1295) + lu(1320) = lu(1320) - lu(233) * lu(1295) + lu(1321) = lu(1321) - lu(234) * lu(1295) + lu(1324) = lu(1324) - lu(235) * lu(1295) + lu(1328) = lu(1328) - lu(236) * lu(1295) + lu(1487) = lu(1487) - lu(230) * lu(1477) + lu(1492) = lu(1492) - lu(231) * lu(1477) + lu(1499) = lu(1499) - lu(232) * lu(1477) + lu(1501) = lu(1501) - lu(233) * lu(1477) + lu(1502) = lu(1502) - lu(234) * lu(1477) + lu(1505) = lu(1505) - lu(235) * lu(1477) + lu(1509) = lu(1509) - lu(236) * lu(1477) + lu(1519) = lu(1519) - lu(230) * lu(1516) + lu(1524) = lu(1524) - lu(231) * lu(1516) + lu(1531) = lu(1531) - lu(232) * lu(1516) + lu(1533) = - lu(233) * lu(1516) + lu(1534) = lu(1534) - lu(234) * lu(1516) + lu(1537) = - lu(235) * lu(1516) + lu(1541) = lu(1541) - lu(236) * lu(1516) + lu(239) = 1._r8 / lu(239) + lu(240) = lu(240) * lu(239) + lu(241) = lu(241) * lu(239) + lu(242) = lu(242) * lu(239) + lu(243) = lu(243) * lu(239) + lu(244) = lu(244) * lu(239) + lu(245) = lu(245) * lu(239) + lu(246) = lu(246) * lu(239) + lu(247) = lu(247) * lu(239) + lu(248) = lu(248) * lu(239) + lu(249) = lu(249) * lu(239) + lu(250) = lu(250) * lu(239) + lu(465) = lu(465) - lu(240) * lu(464) + lu(466) = lu(466) - lu(241) * lu(464) + lu(467) = lu(467) - lu(242) * lu(464) + lu(474) = - lu(243) * lu(464) + lu(477) = lu(477) - lu(244) * lu(464) + lu(478) = lu(478) - lu(245) * lu(464) + lu(479) = lu(479) - lu(246) * lu(464) + lu(480) = - lu(247) * lu(464) + lu(481) = lu(481) - lu(248) * lu(464) + lu(482) = lu(482) - lu(249) * lu(464) + lu(483) = lu(483) - lu(250) * lu(464) + lu(505) = lu(505) - lu(240) * lu(504) + lu(506) = lu(506) - lu(241) * lu(504) + lu(507) = lu(507) - lu(242) * lu(504) + lu(514) = - lu(243) * lu(504) + lu(517) = lu(517) - lu(244) * lu(504) + lu(518) = lu(518) - lu(245) * lu(504) + lu(519) = lu(519) - lu(246) * lu(504) + lu(520) = - lu(247) * lu(504) + lu(521) = lu(521) - lu(248) * lu(504) + lu(522) = lu(522) - lu(249) * lu(504) + lu(523) = lu(523) - lu(250) * lu(504) + lu(1053) = - lu(240) * lu(1048) + lu(1054) = - lu(241) * lu(1048) + lu(1056) = lu(1056) - lu(242) * lu(1048) + lu(1071) = lu(1071) - lu(243) * lu(1048) + lu(1077) = lu(1077) - lu(244) * lu(1048) + lu(1078) = - lu(245) * lu(1048) + lu(1080) = - lu(246) * lu(1048) + lu(1081) = lu(1081) - lu(247) * lu(1048) + lu(1085) = lu(1085) - lu(248) * lu(1048) + lu(1086) = lu(1086) - lu(249) * lu(1048) + lu(1087) = lu(1087) - lu(250) * lu(1048) + lu(1343) = lu(1343) - lu(240) * lu(1336) + lu(1344) = lu(1344) - lu(241) * lu(1336) + lu(1346) = lu(1346) - lu(242) * lu(1336) + lu(1360) = lu(1360) - lu(243) * lu(1336) + lu(1366) = - lu(244) * lu(1336) + lu(1367) = lu(1367) - lu(245) * lu(1336) + lu(1369) = lu(1369) - lu(246) * lu(1336) + lu(1370) = lu(1370) - lu(247) * lu(1336) + lu(1374) = lu(1374) - lu(248) * lu(1336) + lu(1375) = lu(1375) - lu(249) * lu(1336) + lu(1376) = lu(1376) - lu(250) * lu(1336) + lu(1427) = lu(1427) - lu(240) * lu(1420) + lu(1428) = lu(1428) - lu(241) * lu(1420) + lu(1430) = lu(1430) - lu(242) * lu(1420) + lu(1444) = lu(1444) - lu(243) * lu(1420) + lu(1450) = - lu(244) * lu(1420) + lu(1451) = lu(1451) - lu(245) * lu(1420) + lu(1453) = lu(1453) - lu(246) * lu(1420) + lu(1454) = lu(1454) - lu(247) * lu(1420) + lu(1458) = lu(1458) - lu(248) * lu(1420) + lu(1459) = lu(1459) - lu(249) * lu(1420) + lu(1460) = lu(1460) - lu(250) * lu(1420) + lu(1662) = - lu(240) * lu(1661) + lu(1663) = - lu(241) * lu(1661) + lu(1664) = - lu(242) * lu(1661) + lu(1677) = lu(1677) - lu(243) * lu(1661) + lu(1683) = lu(1683) - lu(244) * lu(1661) + lu(1684) = - lu(245) * lu(1661) + lu(1686) = - lu(246) * lu(1661) + lu(1687) = lu(1687) - lu(247) * lu(1661) + lu(1691) = lu(1691) - lu(248) * lu(1661) + lu(1692) = lu(1692) - lu(249) * lu(1661) + lu(1693) = - lu(250) * lu(1661) end subroutine lu_fac06 - subroutine lu_fac07( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac07( lu ) 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,244) = 1._r8 / lu(k,244) - lu(k,245) = lu(k,245) * lu(k,244) - lu(k,246) = lu(k,246) * lu(k,244) - lu(k,247) = lu(k,247) * lu(k,244) - lu(k,248) = lu(k,248) * lu(k,244) - lu(k,249) = lu(k,249) * lu(k,244) - lu(k,250) = lu(k,250) * lu(k,244) - lu(k,251) = lu(k,251) * lu(k,244) - lu(k,252) = lu(k,252) * lu(k,244) - lu(k,253) = lu(k,253) * lu(k,244) - lu(k,254) = lu(k,254) * lu(k,244) - lu(k,255) = lu(k,255) * lu(k,244) - lu(k,270) = lu(k,270) - lu(k,245) * lu(k,269) - lu(k,271) = - lu(k,246) * lu(k,269) - lu(k,272) = - lu(k,247) * lu(k,269) - lu(k,273) = lu(k,273) - lu(k,248) * lu(k,269) - lu(k,274) = lu(k,274) - lu(k,249) * lu(k,269) - lu(k,275) = lu(k,275) - lu(k,250) * lu(k,269) - lu(k,278) = lu(k,278) - lu(k,251) * lu(k,269) - lu(k,279) = lu(k,279) - lu(k,252) * lu(k,269) - lu(k,280) = - lu(k,253) * lu(k,269) - lu(k,281) = lu(k,281) - lu(k,254) * lu(k,269) - lu(k,282) = lu(k,282) - lu(k,255) * lu(k,269) - lu(k,858) = lu(k,858) - lu(k,245) * lu(k,857) - lu(k,869) = lu(k,869) - lu(k,246) * lu(k,857) - lu(k,873) = - lu(k,247) * lu(k,857) - lu(k,875) = lu(k,875) - lu(k,248) * lu(k,857) - lu(k,878) = lu(k,878) - lu(k,249) * lu(k,857) - lu(k,880) = lu(k,880) - lu(k,250) * lu(k,857) - lu(k,887) = lu(k,887) - lu(k,251) * lu(k,857) - lu(k,889) = lu(k,889) - lu(k,252) * lu(k,857) - lu(k,890) = lu(k,890) - lu(k,253) * lu(k,857) - lu(k,898) = - lu(k,254) * lu(k,857) - lu(k,899) = lu(k,899) - lu(k,255) * lu(k,857) - lu(k,961) = lu(k,961) - lu(k,245) * lu(k,960) - lu(k,968) = lu(k,968) - lu(k,246) * lu(k,960) - lu(k,972) = lu(k,972) - lu(k,247) * lu(k,960) - lu(k,974) = lu(k,974) - lu(k,248) * lu(k,960) - lu(k,977) = lu(k,977) - lu(k,249) * lu(k,960) - lu(k,979) = lu(k,979) - lu(k,250) * lu(k,960) - lu(k,986) = lu(k,986) - lu(k,251) * lu(k,960) - lu(k,988) = lu(k,988) - lu(k,252) * lu(k,960) - lu(k,989) = lu(k,989) - lu(k,253) * lu(k,960) - lu(k,997) = lu(k,997) - lu(k,254) * lu(k,960) - lu(k,998) = lu(k,998) - lu(k,255) * lu(k,960) - lu(k,1014) = lu(k,1014) - lu(k,245) * lu(k,1013) - lu(k,1016) = lu(k,1016) - lu(k,246) * lu(k,1013) - lu(k,1017) = - lu(k,247) * lu(k,1013) - lu(k,1018) = lu(k,1018) - lu(k,248) * lu(k,1013) - lu(k,1020) = lu(k,1020) - lu(k,249) * lu(k,1013) - lu(k,1022) = lu(k,1022) - lu(k,250) * lu(k,1013) - lu(k,1029) = lu(k,1029) - lu(k,251) * lu(k,1013) - lu(k,1031) = lu(k,1031) - lu(k,252) * lu(k,1013) - lu(k,1032) = lu(k,1032) - lu(k,253) * lu(k,1013) - lu(k,1040) = lu(k,1040) - lu(k,254) * lu(k,1013) - lu(k,1041) = lu(k,1041) - lu(k,255) * lu(k,1013) - lu(k,1257) = lu(k,1257) - lu(k,245) * lu(k,1256) - lu(k,1260) = lu(k,1260) - lu(k,246) * lu(k,1256) - lu(k,1263) = lu(k,1263) - lu(k,247) * lu(k,1256) - lu(k,1265) = - lu(k,248) * lu(k,1256) - lu(k,1268) = lu(k,1268) - lu(k,249) * lu(k,1256) - lu(k,1270) = lu(k,1270) - lu(k,250) * lu(k,1256) - lu(k,1277) = lu(k,1277) - lu(k,251) * lu(k,1256) - lu(k,1279) = lu(k,1279) - lu(k,252) * lu(k,1256) - lu(k,1280) = lu(k,1280) - lu(k,253) * lu(k,1256) - lu(k,1288) = lu(k,1288) - lu(k,254) * lu(k,1256) - lu(k,1289) = lu(k,1289) - lu(k,255) * lu(k,1256) - lu(k,1379) = - lu(k,245) * lu(k,1378) - lu(k,1383) = - lu(k,246) * lu(k,1378) - lu(k,1386) = lu(k,1386) - lu(k,247) * lu(k,1378) - lu(k,1388) = lu(k,1388) - lu(k,248) * lu(k,1378) - lu(k,1391) = lu(k,1391) - lu(k,249) * lu(k,1378) - lu(k,1393) = lu(k,1393) - lu(k,250) * lu(k,1378) - lu(k,1400) = lu(k,1400) - lu(k,251) * lu(k,1378) - lu(k,1402) = lu(k,1402) - lu(k,252) * lu(k,1378) - lu(k,1403) = lu(k,1403) - lu(k,253) * lu(k,1378) - lu(k,1411) = lu(k,1411) - lu(k,254) * lu(k,1378) - lu(k,1412) = lu(k,1412) - lu(k,255) * lu(k,1378) - lu(k,257) = 1._r8 / lu(k,257) - lu(k,258) = lu(k,258) * lu(k,257) - lu(k,259) = lu(k,259) * lu(k,257) - lu(k,260) = lu(k,260) * lu(k,257) - lu(k,261) = lu(k,261) * lu(k,257) - lu(k,262) = lu(k,262) * lu(k,257) - lu(k,263) = lu(k,263) * lu(k,257) - lu(k,264) = lu(k,264) * lu(k,257) - lu(k,265) = lu(k,265) * lu(k,257) - lu(k,266) = lu(k,266) * lu(k,257) - lu(k,267) = lu(k,267) * lu(k,257) - lu(k,420) = - lu(k,258) * lu(k,418) - lu(k,422) = - lu(k,259) * lu(k,418) - lu(k,423) = lu(k,423) - lu(k,260) * lu(k,418) - lu(k,427) = - lu(k,261) * lu(k,418) - lu(k,429) = - lu(k,262) * lu(k,418) - lu(k,431) = - lu(k,263) * lu(k,418) - lu(k,434) = lu(k,434) - lu(k,264) * lu(k,418) - lu(k,435) = lu(k,435) - lu(k,265) * lu(k,418) - lu(k,436) = - lu(k,266) * lu(k,418) - lu(k,437) = lu(k,437) - lu(k,267) * lu(k,418) - lu(k,572) = lu(k,572) - lu(k,258) * lu(k,567) - lu(k,574) = lu(k,574) - lu(k,259) * lu(k,567) - lu(k,575) = lu(k,575) - lu(k,260) * lu(k,567) - lu(k,580) = - lu(k,261) * lu(k,567) - lu(k,582) = lu(k,582) - lu(k,262) * lu(k,567) - lu(k,588) = lu(k,588) - lu(k,263) * lu(k,567) - lu(k,591) = lu(k,591) - lu(k,264) * lu(k,567) - lu(k,592) = lu(k,592) - lu(k,265) * lu(k,567) - lu(k,593) = lu(k,593) - lu(k,266) * lu(k,567) - lu(k,594) = lu(k,594) - lu(k,267) * lu(k,567) - lu(k,684) = lu(k,684) - lu(k,258) * lu(k,680) - lu(k,686) = lu(k,686) - lu(k,259) * lu(k,680) - lu(k,687) = lu(k,687) - lu(k,260) * lu(k,680) - lu(k,693) = lu(k,693) - lu(k,261) * lu(k,680) - lu(k,695) = lu(k,695) - lu(k,262) * lu(k,680) - lu(k,701) = lu(k,701) - lu(k,263) * lu(k,680) - lu(k,704) = lu(k,704) - lu(k,264) * lu(k,680) - lu(k,705) = lu(k,705) - lu(k,265) * lu(k,680) - lu(k,706) = lu(k,706) - lu(k,266) * lu(k,680) - lu(k,707) = lu(k,707) - lu(k,267) * lu(k,680) - lu(k,752) = lu(k,752) - lu(k,258) * lu(k,747) - lu(k,754) = lu(k,754) - lu(k,259) * lu(k,747) - lu(k,755) = lu(k,755) - lu(k,260) * lu(k,747) - lu(k,762) = lu(k,762) - lu(k,261) * lu(k,747) - lu(k,764) = lu(k,764) - lu(k,262) * lu(k,747) - lu(k,770) = lu(k,770) - lu(k,263) * lu(k,747) - lu(k,773) = lu(k,773) - lu(k,264) * lu(k,747) - lu(k,774) = lu(k,774) - lu(k,265) * lu(k,747) - lu(k,775) = lu(k,775) - lu(k,266) * lu(k,747) - lu(k,776) = lu(k,776) - lu(k,267) * lu(k,747) - lu(k,1093) = - lu(k,258) * lu(k,1088) - lu(k,1097) = lu(k,1097) - lu(k,259) * lu(k,1088) - lu(k,1099) = lu(k,1099) - lu(k,260) * lu(k,1088) - lu(k,1108) = lu(k,1108) - lu(k,261) * lu(k,1088) - lu(k,1111) = - lu(k,262) * lu(k,1088) - lu(k,1117) = - lu(k,263) * lu(k,1088) - lu(k,1121) = - lu(k,264) * lu(k,1088) - lu(k,1122) = lu(k,1122) - lu(k,265) * lu(k,1088) - lu(k,1123) = lu(k,1123) - lu(k,266) * lu(k,1088) - lu(k,1124) = lu(k,1124) - lu(k,267) * lu(k,1088) - lu(k,1507) = lu(k,1507) - lu(k,258) * lu(k,1504) - lu(k,1512) = lu(k,1512) - lu(k,259) * lu(k,1504) - lu(k,1514) = lu(k,1514) - lu(k,260) * lu(k,1504) - lu(k,1523) = lu(k,1523) - lu(k,261) * lu(k,1504) - lu(k,1526) = lu(k,1526) - lu(k,262) * lu(k,1504) - lu(k,1532) = lu(k,1532) - lu(k,263) * lu(k,1504) - lu(k,1536) = lu(k,1536) - lu(k,264) * lu(k,1504) - lu(k,1537) = - lu(k,265) * lu(k,1504) - lu(k,1538) = lu(k,1538) - lu(k,266) * lu(k,1504) - lu(k,1539) = lu(k,1539) - lu(k,267) * lu(k,1504) - lu(k,1662) = lu(k,1662) - lu(k,258) * lu(k,1658) - lu(k,1667) = lu(k,1667) - lu(k,259) * lu(k,1658) - lu(k,1669) = lu(k,1669) - lu(k,260) * lu(k,1658) - lu(k,1678) = lu(k,1678) - lu(k,261) * lu(k,1658) - lu(k,1681) = lu(k,1681) - lu(k,262) * lu(k,1658) - lu(k,1687) = lu(k,1687) - lu(k,263) * lu(k,1658) - lu(k,1691) = lu(k,1691) - lu(k,264) * lu(k,1658) - lu(k,1692) = lu(k,1692) - lu(k,265) * lu(k,1658) - lu(k,1693) = lu(k,1693) - lu(k,266) * lu(k,1658) - lu(k,1694) = lu(k,1694) - lu(k,267) * lu(k,1658) - lu(k,1741) = lu(k,1741) - lu(k,258) * lu(k,1733) - lu(k,1745) = lu(k,1745) - lu(k,259) * lu(k,1733) - lu(k,1747) = lu(k,1747) - lu(k,260) * lu(k,1733) - lu(k,1756) = lu(k,1756) - lu(k,261) * lu(k,1733) - lu(k,1759) = lu(k,1759) - lu(k,262) * lu(k,1733) - lu(k,1765) = lu(k,1765) - lu(k,263) * lu(k,1733) - lu(k,1769) = lu(k,1769) - lu(k,264) * lu(k,1733) - lu(k,1770) = - lu(k,265) * lu(k,1733) - lu(k,1771) = lu(k,1771) - lu(k,266) * lu(k,1733) - lu(k,1772) = lu(k,1772) - lu(k,267) * lu(k,1733) - lu(k,1794) = - lu(k,258) * lu(k,1785) - lu(k,1798) = - lu(k,259) * lu(k,1785) - lu(k,1800) = lu(k,1800) - lu(k,260) * lu(k,1785) - lu(k,1809) = lu(k,1809) - lu(k,261) * lu(k,1785) - lu(k,1812) = lu(k,1812) - lu(k,262) * lu(k,1785) - lu(k,1818) = - lu(k,263) * lu(k,1785) - lu(k,1822) = - lu(k,264) * lu(k,1785) - lu(k,1823) = lu(k,1823) - lu(k,265) * lu(k,1785) - lu(k,1824) = lu(k,1824) - lu(k,266) * lu(k,1785) - lu(k,1825) = lu(k,1825) - lu(k,267) * lu(k,1785) - lu(k,270) = 1._r8 / lu(k,270) - lu(k,271) = lu(k,271) * lu(k,270) - lu(k,272) = lu(k,272) * lu(k,270) - lu(k,273) = lu(k,273) * lu(k,270) - lu(k,274) = lu(k,274) * lu(k,270) - lu(k,275) = lu(k,275) * lu(k,270) - lu(k,276) = lu(k,276) * lu(k,270) - lu(k,277) = lu(k,277) * lu(k,270) - lu(k,278) = lu(k,278) * lu(k,270) - lu(k,279) = lu(k,279) * lu(k,270) - lu(k,280) = lu(k,280) * lu(k,270) - lu(k,281) = lu(k,281) * lu(k,270) - lu(k,282) = lu(k,282) * lu(k,270) - lu(k,753) = lu(k,753) - lu(k,271) * lu(k,748) - lu(k,754) = lu(k,754) - lu(k,272) * lu(k,748) - lu(k,755) = lu(k,755) - lu(k,273) * lu(k,748) - lu(k,757) = - lu(k,274) * lu(k,748) - lu(k,758) = lu(k,758) - lu(k,275) * lu(k,748) - lu(k,759) = lu(k,759) - lu(k,276) * lu(k,748) - lu(k,762) = lu(k,762) - lu(k,277) * lu(k,748) - lu(k,764) = lu(k,764) - lu(k,278) * lu(k,748) - lu(k,766) = - lu(k,279) * lu(k,748) - lu(k,767) = lu(k,767) - lu(k,280) * lu(k,748) - lu(k,774) = lu(k,774) - lu(k,281) * lu(k,748) - lu(k,775) = lu(k,775) - lu(k,282) * lu(k,748) - lu(k,869) = lu(k,869) - lu(k,271) * lu(k,858) - lu(k,873) = lu(k,873) - lu(k,272) * lu(k,858) - lu(k,875) = lu(k,875) - lu(k,273) * lu(k,858) - lu(k,878) = lu(k,878) - lu(k,274) * lu(k,858) - lu(k,880) = lu(k,880) - lu(k,275) * lu(k,858) - lu(k,881) = lu(k,881) - lu(k,276) * lu(k,858) - lu(k,884) = lu(k,884) - lu(k,277) * lu(k,858) - lu(k,887) = lu(k,887) - lu(k,278) * lu(k,858) - lu(k,889) = lu(k,889) - lu(k,279) * lu(k,858) - lu(k,890) = lu(k,890) - lu(k,280) * lu(k,858) - lu(k,898) = lu(k,898) - lu(k,281) * lu(k,858) - lu(k,899) = lu(k,899) - lu(k,282) * lu(k,858) - lu(k,968) = lu(k,968) - lu(k,271) * lu(k,961) - lu(k,972) = lu(k,972) - lu(k,272) * lu(k,961) - lu(k,974) = lu(k,974) - lu(k,273) * lu(k,961) - lu(k,977) = lu(k,977) - lu(k,274) * lu(k,961) - lu(k,979) = lu(k,979) - lu(k,275) * lu(k,961) - lu(k,980) = lu(k,980) - lu(k,276) * lu(k,961) - lu(k,983) = lu(k,983) - lu(k,277) * lu(k,961) - lu(k,986) = lu(k,986) - lu(k,278) * lu(k,961) - lu(k,988) = lu(k,988) - lu(k,279) * lu(k,961) - lu(k,989) = lu(k,989) - lu(k,280) * lu(k,961) - lu(k,997) = lu(k,997) - lu(k,281) * lu(k,961) - lu(k,998) = lu(k,998) - lu(k,282) * lu(k,961) - lu(k,1016) = lu(k,1016) - lu(k,271) * lu(k,1014) - lu(k,1017) = lu(k,1017) - lu(k,272) * lu(k,1014) - lu(k,1018) = lu(k,1018) - lu(k,273) * lu(k,1014) - lu(k,1020) = lu(k,1020) - lu(k,274) * lu(k,1014) - lu(k,1022) = lu(k,1022) - lu(k,275) * lu(k,1014) - lu(k,1023) = lu(k,1023) - lu(k,276) * lu(k,1014) - lu(k,1026) = lu(k,1026) - lu(k,277) * lu(k,1014) - lu(k,1029) = lu(k,1029) - lu(k,278) * lu(k,1014) - lu(k,1031) = lu(k,1031) - lu(k,279) * lu(k,1014) - lu(k,1032) = lu(k,1032) - lu(k,280) * lu(k,1014) - lu(k,1040) = lu(k,1040) - lu(k,281) * lu(k,1014) - lu(k,1041) = lu(k,1041) - lu(k,282) * lu(k,1014) - lu(k,1139) = - lu(k,271) * lu(k,1130) - lu(k,1142) = lu(k,1142) - lu(k,272) * lu(k,1130) - lu(k,1144) = lu(k,1144) - lu(k,273) * lu(k,1130) - lu(k,1147) = - lu(k,274) * lu(k,1130) - lu(k,1149) = lu(k,1149) - lu(k,275) * lu(k,1130) - lu(k,1150) = - lu(k,276) * lu(k,1130) - lu(k,1153) = lu(k,1153) - lu(k,277) * lu(k,1130) - lu(k,1156) = lu(k,1156) - lu(k,278) * lu(k,1130) - lu(k,1158) = - lu(k,279) * lu(k,1130) - lu(k,1159) = lu(k,1159) - lu(k,280) * lu(k,1130) - lu(k,1167) = - lu(k,281) * lu(k,1130) - lu(k,1168) = lu(k,1168) - lu(k,282) * lu(k,1130) - lu(k,1260) = lu(k,1260) - lu(k,271) * lu(k,1257) - lu(k,1263) = lu(k,1263) - lu(k,272) * lu(k,1257) - lu(k,1265) = lu(k,1265) - lu(k,273) * lu(k,1257) - lu(k,1268) = lu(k,1268) - lu(k,274) * lu(k,1257) - lu(k,1270) = lu(k,1270) - lu(k,275) * lu(k,1257) - lu(k,1271) = lu(k,1271) - lu(k,276) * lu(k,1257) - lu(k,1274) = - lu(k,277) * lu(k,1257) - lu(k,1277) = lu(k,1277) - lu(k,278) * lu(k,1257) - lu(k,1279) = lu(k,1279) - lu(k,279) * lu(k,1257) - lu(k,1280) = lu(k,1280) - lu(k,280) * lu(k,1257) - lu(k,1288) = lu(k,1288) - lu(k,281) * lu(k,1257) - lu(k,1289) = lu(k,1289) - lu(k,282) * lu(k,1257) - lu(k,1340) = lu(k,1340) - lu(k,271) * lu(k,1328) - lu(k,1344) = - lu(k,272) * lu(k,1328) - lu(k,1346) = lu(k,1346) - lu(k,273) * lu(k,1328) - lu(k,1349) = lu(k,1349) - lu(k,274) * lu(k,1328) - lu(k,1351) = lu(k,1351) - lu(k,275) * lu(k,1328) - lu(k,1352) = lu(k,1352) - lu(k,276) * lu(k,1328) - lu(k,1355) = lu(k,1355) - lu(k,277) * lu(k,1328) - lu(k,1358) = lu(k,1358) - lu(k,278) * lu(k,1328) - lu(k,1360) = lu(k,1360) - lu(k,279) * lu(k,1328) - lu(k,1361) = lu(k,1361) - lu(k,280) * lu(k,1328) - lu(k,1369) = lu(k,1369) - lu(k,281) * lu(k,1328) - lu(k,1370) = lu(k,1370) - lu(k,282) * lu(k,1328) - lu(k,1383) = lu(k,1383) - lu(k,271) * lu(k,1379) - lu(k,1386) = lu(k,1386) - lu(k,272) * lu(k,1379) - lu(k,1388) = lu(k,1388) - lu(k,273) * lu(k,1379) - lu(k,1391) = lu(k,1391) - lu(k,274) * lu(k,1379) - lu(k,1393) = lu(k,1393) - lu(k,275) * lu(k,1379) - lu(k,1394) = lu(k,1394) - lu(k,276) * lu(k,1379) - lu(k,1397) = - lu(k,277) * lu(k,1379) - lu(k,1400) = lu(k,1400) - lu(k,278) * lu(k,1379) - lu(k,1402) = lu(k,1402) - lu(k,279) * lu(k,1379) - lu(k,1403) = lu(k,1403) - lu(k,280) * lu(k,1379) - lu(k,1411) = lu(k,1411) - lu(k,281) * lu(k,1379) - lu(k,1412) = lu(k,1412) - lu(k,282) * lu(k,1379) - lu(k,1742) = - lu(k,271) * lu(k,1734) - lu(k,1745) = lu(k,1745) - lu(k,272) * lu(k,1734) - lu(k,1747) = lu(k,1747) - lu(k,273) * lu(k,1734) - lu(k,1750) = lu(k,1750) - lu(k,274) * lu(k,1734) - lu(k,1752) = lu(k,1752) - lu(k,275) * lu(k,1734) - lu(k,1753) = lu(k,1753) - lu(k,276) * lu(k,1734) - lu(k,1756) = lu(k,1756) - lu(k,277) * lu(k,1734) - lu(k,1759) = lu(k,1759) - lu(k,278) * lu(k,1734) - lu(k,1761) = lu(k,1761) - lu(k,279) * lu(k,1734) - lu(k,1762) = lu(k,1762) - lu(k,280) * lu(k,1734) - lu(k,1770) = lu(k,1770) - lu(k,281) * lu(k,1734) - lu(k,1771) = lu(k,1771) - lu(k,282) * lu(k,1734) - end do + real(r8), intent(inout) :: lu(:) + lu(253) = 1._r8 / lu(253) + lu(254) = lu(254) * lu(253) + lu(255) = lu(255) * lu(253) + lu(256) = lu(256) * lu(253) + lu(257) = lu(257) * lu(253) + lu(258) = lu(258) * lu(253) + lu(259) = lu(259) * lu(253) + lu(260) = lu(260) * lu(253) + lu(261) = lu(261) * lu(253) + lu(262) = lu(262) * lu(253) + lu(263) = lu(263) * lu(253) + lu(264) = lu(264) * lu(253) + lu(709) = lu(709) - lu(254) * lu(703) + lu(710) = lu(710) - lu(255) * lu(703) + lu(711) = lu(711) - lu(256) * lu(703) + lu(712) = - lu(257) * lu(703) + lu(714) = lu(714) - lu(258) * lu(703) + lu(717) = lu(717) - lu(259) * lu(703) + lu(719) = lu(719) - lu(260) * lu(703) + lu(722) = - lu(261) * lu(703) + lu(723) = lu(723) - lu(262) * lu(703) + lu(724) = lu(724) - lu(263) * lu(703) + lu(725) = lu(725) - lu(264) * lu(703) + lu(809) = lu(809) - lu(254) * lu(798) + lu(813) = lu(813) - lu(255) * lu(798) + lu(814) = lu(814) - lu(256) * lu(798) + lu(817) = lu(817) - lu(257) * lu(798) + lu(820) = lu(820) - lu(258) * lu(798) + lu(823) = lu(823) - lu(259) * lu(798) + lu(825) = lu(825) - lu(260) * lu(798) + lu(828) = lu(828) - lu(261) * lu(798) + lu(829) = lu(829) - lu(262) * lu(798) + lu(831) = lu(831) - lu(263) * lu(798) + lu(833) = lu(833) - lu(264) * lu(798) + lu(1058) = - lu(254) * lu(1049) + lu(1061) = lu(1061) - lu(255) * lu(1049) + lu(1062) = lu(1062) - lu(256) * lu(1049) + lu(1065) = - lu(257) * lu(1049) + lu(1068) = - lu(258) * lu(1049) + lu(1071) = lu(1071) - lu(259) * lu(1049) + lu(1073) = lu(1073) - lu(260) * lu(1049) + lu(1076) = - lu(261) * lu(1049) + lu(1077) = lu(1077) - lu(262) * lu(1049) + lu(1079) = - lu(263) * lu(1049) + lu(1081) = lu(1081) - lu(264) * lu(1049) + lu(1142) = lu(1142) - lu(254) * lu(1139) + lu(1146) = lu(1146) - lu(255) * lu(1139) + lu(1147) = lu(1147) - lu(256) * lu(1139) + lu(1150) = lu(1150) - lu(257) * lu(1139) + lu(1153) = lu(1153) - lu(258) * lu(1139) + lu(1156) = - lu(259) * lu(1139) + lu(1158) = lu(1158) - lu(260) * lu(1139) + lu(1161) = lu(1161) - lu(261) * lu(1139) + lu(1162) = lu(1162) - lu(262) * lu(1139) + lu(1164) = lu(1164) - lu(263) * lu(1139) + lu(1166) = lu(1166) - lu(264) * lu(1139) + lu(1263) = lu(1263) - lu(254) * lu(1251) + lu(1267) = - lu(255) * lu(1251) + lu(1268) = lu(1268) - lu(256) * lu(1251) + lu(1271) = lu(1271) - lu(257) * lu(1251) + lu(1274) = lu(1274) - lu(258) * lu(1251) + lu(1277) = lu(1277) - lu(259) * lu(1251) + lu(1279) = lu(1279) - lu(260) * lu(1251) + lu(1282) = lu(1282) - lu(261) * lu(1251) + lu(1283) = lu(1283) - lu(262) * lu(1251) + lu(1285) = lu(1285) - lu(263) * lu(1251) + lu(1287) = lu(1287) - lu(264) * lu(1251) + lu(1305) = - lu(254) * lu(1296) + lu(1308) = lu(1308) - lu(255) * lu(1296) + lu(1309) = lu(1309) - lu(256) * lu(1296) + lu(1312) = lu(1312) - lu(257) * lu(1296) + lu(1315) = - lu(258) * lu(1296) + lu(1318) = lu(1318) - lu(259) * lu(1296) + lu(1320) = lu(1320) - lu(260) * lu(1296) + lu(1323) = lu(1323) - lu(261) * lu(1296) + lu(1324) = lu(1324) - lu(262) * lu(1296) + lu(1326) = lu(1326) - lu(263) * lu(1296) + lu(1328) = lu(1328) - lu(264) * lu(1296) + lu(1393) = lu(1393) - lu(254) * lu(1391) + lu(1394) = lu(1394) - lu(255) * lu(1391) + lu(1395) = lu(1395) - lu(256) * lu(1391) + lu(1396) = lu(1396) - lu(257) * lu(1391) + lu(1399) = lu(1399) - lu(258) * lu(1391) + lu(1402) = lu(1402) - lu(259) * lu(1391) + lu(1404) = lu(1404) - lu(260) * lu(1391) + lu(1407) = lu(1407) - lu(261) * lu(1391) + lu(1408) = lu(1408) - lu(262) * lu(1391) + lu(1410) = lu(1410) - lu(263) * lu(1391) + lu(1412) = lu(1412) - lu(264) * lu(1391) + lu(1485) = lu(1485) - lu(254) * lu(1478) + lu(1489) = lu(1489) - lu(255) * lu(1478) + lu(1490) = lu(1490) - lu(256) * lu(1478) + lu(1493) = lu(1493) - lu(257) * lu(1478) + lu(1496) = lu(1496) - lu(258) * lu(1478) + lu(1499) = lu(1499) - lu(259) * lu(1478) + lu(1501) = lu(1501) - lu(260) * lu(1478) + lu(1504) = lu(1504) - lu(261) * lu(1478) + lu(1505) = lu(1505) - lu(262) * lu(1478) + lu(1507) = lu(1507) - lu(263) * lu(1478) + lu(1509) = lu(1509) - lu(264) * lu(1478) + lu(266) = 1._r8 / lu(266) + lu(267) = lu(267) * lu(266) + lu(268) = lu(268) * lu(266) + lu(269) = lu(269) * lu(266) + lu(270) = lu(270) * lu(266) + lu(271) = lu(271) * lu(266) + lu(272) = lu(272) * lu(266) + lu(273) = lu(273) * lu(266) + lu(274) = lu(274) * lu(266) + lu(275) = lu(275) * lu(266) + lu(276) = lu(276) * lu(266) + lu(432) = - lu(267) * lu(430) + lu(434) = - lu(268) * lu(430) + lu(435) = lu(435) - lu(269) * lu(430) + lu(437) = lu(437) - lu(270) * lu(430) + lu(438) = - lu(271) * lu(430) + lu(439) = - lu(272) * lu(430) + lu(440) = - lu(273) * lu(430) + lu(441) = lu(441) - lu(274) * lu(430) + lu(442) = - lu(275) * lu(430) + lu(449) = lu(449) - lu(276) * lu(430) + lu(559) = lu(559) - lu(267) * lu(554) + lu(561) = lu(561) - lu(268) * lu(554) + lu(562) = lu(562) - lu(269) * lu(554) + lu(564) = lu(564) - lu(270) * lu(554) + lu(566) = - lu(271) * lu(554) + lu(567) = lu(567) - lu(272) * lu(554) + lu(568) = lu(568) - lu(273) * lu(554) + lu(569) = lu(569) - lu(274) * lu(554) + lu(572) = lu(572) - lu(275) * lu(554) + lu(580) = lu(580) - lu(276) * lu(554) + lu(668) = lu(668) - lu(267) * lu(664) + lu(670) = lu(670) - lu(268) * lu(664) + lu(671) = lu(671) - lu(269) * lu(664) + lu(673) = lu(673) - lu(270) * lu(664) + lu(676) = lu(676) - lu(271) * lu(664) + lu(677) = lu(677) - lu(272) * lu(664) + lu(678) = lu(678) - lu(273) * lu(664) + lu(679) = lu(679) - lu(274) * lu(664) + lu(682) = lu(682) - lu(275) * lu(664) + lu(690) = lu(690) - lu(276) * lu(664) + lu(708) = lu(708) - lu(267) * lu(704) + lu(710) = lu(710) - lu(268) * lu(704) + lu(711) = lu(711) - lu(269) * lu(704) + lu(714) = lu(714) - lu(270) * lu(704) + lu(717) = lu(717) - lu(271) * lu(704) + lu(718) = lu(718) - lu(272) * lu(704) + lu(719) = lu(719) - lu(273) * lu(704) + lu(720) = lu(720) - lu(274) * lu(704) + lu(723) = lu(723) - lu(275) * lu(704) + lu(731) = lu(731) - lu(276) * lu(704) + lu(1098) = lu(1098) - lu(267) * lu(1095) + lu(1103) = lu(1103) - lu(268) * lu(1095) + lu(1104) = lu(1104) - lu(269) * lu(1095) + lu(1110) = - lu(270) * lu(1095) + lu(1113) = lu(1113) - lu(271) * lu(1095) + lu(1114) = lu(1114) - lu(272) * lu(1095) + lu(1115) = lu(1115) - lu(273) * lu(1095) + lu(1116) = lu(1116) - lu(274) * lu(1095) + lu(1119) = lu(1119) - lu(275) * lu(1095) + lu(1129) = lu(1129) - lu(276) * lu(1095) + lu(1183) = lu(1183) - lu(267) * lu(1179) + lu(1188) = lu(1188) - lu(268) * lu(1179) + lu(1189) = lu(1189) - lu(269) * lu(1179) + lu(1195) = lu(1195) - lu(270) * lu(1179) + lu(1198) = lu(1198) - lu(271) * lu(1179) + lu(1199) = lu(1199) - lu(272) * lu(1179) + lu(1200) = lu(1200) - lu(273) * lu(1179) + lu(1201) = lu(1201) - lu(274) * lu(1179) + lu(1204) = lu(1204) - lu(275) * lu(1179) + lu(1214) = lu(1214) - lu(276) * lu(1179) + lu(1304) = lu(1304) - lu(267) * lu(1297) + lu(1308) = lu(1308) - lu(268) * lu(1297) + lu(1309) = lu(1309) - lu(269) * lu(1297) + lu(1315) = lu(1315) - lu(270) * lu(1297) + lu(1318) = lu(1318) - lu(271) * lu(1297) + lu(1319) = lu(1319) - lu(272) * lu(1297) + lu(1320) = lu(1320) - lu(273) * lu(1297) + lu(1321) = lu(1321) - lu(274) * lu(1297) + lu(1324) = lu(1324) - lu(275) * lu(1297) + lu(1334) = lu(1334) - lu(276) * lu(1297) + lu(1629) = - lu(267) * lu(1624) + lu(1633) = lu(1633) - lu(268) * lu(1624) + lu(1634) = lu(1634) - lu(269) * lu(1624) + lu(1640) = lu(1640) - lu(270) * lu(1624) + lu(1643) = lu(1643) - lu(271) * lu(1624) + lu(1644) = - lu(272) * lu(1624) + lu(1645) = - lu(273) * lu(1624) + lu(1646) = - lu(274) * lu(1624) + lu(1649) = lu(1649) - lu(275) * lu(1624) + lu(1659) = lu(1659) - lu(276) * lu(1624) + lu(1715) = - lu(267) * lu(1706) + lu(1719) = - lu(268) * lu(1706) + lu(1720) = lu(1720) - lu(269) * lu(1706) + lu(1726) = lu(1726) - lu(270) * lu(1706) + lu(1729) = lu(1729) - lu(271) * lu(1706) + lu(1730) = - lu(272) * lu(1706) + lu(1731) = lu(1731) - lu(273) * lu(1706) + lu(1732) = - lu(274) * lu(1706) + lu(1735) = lu(1735) - lu(275) * lu(1706) + lu(1745) = lu(1745) - lu(276) * lu(1706) + lu(277) = 1._r8 / lu(277) + lu(278) = lu(278) * lu(277) + lu(279) = lu(279) * lu(277) + lu(280) = lu(280) * lu(277) + lu(281) = lu(281) * lu(277) + lu(282) = lu(282) * lu(277) + lu(283) = lu(283) * lu(277) + lu(284) = lu(284) * lu(277) + lu(285) = lu(285) * lu(277) + lu(286) = lu(286) * lu(277) + lu(287) = lu(287) * lu(277) + lu(288) = lu(288) * lu(277) + lu(289) = lu(289) * lu(277) + lu(814) = lu(814) - lu(278) * lu(799) + lu(817) = lu(817) - lu(279) * lu(799) + lu(818) = - lu(280) * lu(799) + lu(820) = lu(820) - lu(281) * lu(799) + lu(821) = lu(821) - lu(282) * lu(799) + lu(822) = - lu(283) * lu(799) + lu(825) = lu(825) - lu(284) * lu(799) + lu(828) = lu(828) - lu(285) * lu(799) + lu(829) = lu(829) - lu(286) * lu(799) + lu(830) = - lu(287) * lu(799) + lu(832) = - lu(288) * lu(799) + lu(839) = lu(839) - lu(289) * lu(799) + lu(856) = lu(856) - lu(278) * lu(842) + lu(859) = - lu(279) * lu(842) + lu(860) = lu(860) - lu(280) * lu(842) + lu(862) = - lu(281) * lu(842) + lu(863) = - lu(282) * lu(842) + lu(864) = lu(864) - lu(283) * lu(842) + lu(867) = lu(867) - lu(284) * lu(842) + lu(870) = - lu(285) * lu(842) + lu(871) = lu(871) - lu(286) * lu(842) + lu(872) = - lu(287) * lu(842) + lu(874) = - lu(288) * lu(842) + lu(881) = lu(881) - lu(289) * lu(842) + lu(976) = lu(976) - lu(278) * lu(962) + lu(979) = - lu(279) * lu(962) + lu(980) = lu(980) - lu(280) * lu(962) + lu(982) = lu(982) - lu(281) * lu(962) + lu(983) = lu(983) - lu(282) * lu(962) + lu(984) = lu(984) - lu(283) * lu(962) + lu(987) = lu(987) - lu(284) * lu(962) + lu(990) = - lu(285) * lu(962) + lu(991) = lu(991) - lu(286) * lu(962) + lu(992) = - lu(287) * lu(962) + lu(994) = - lu(288) * lu(962) + lu(1001) = lu(1001) - lu(289) * lu(962) + lu(1018) = lu(1018) - lu(278) * lu(1004) + lu(1021) = - lu(279) * lu(1004) + lu(1022) = - lu(280) * lu(1004) + lu(1024) = lu(1024) - lu(281) * lu(1004) + lu(1025) = - lu(282) * lu(1004) + lu(1026) = lu(1026) - lu(283) * lu(1004) + lu(1029) = lu(1029) - lu(284) * lu(1004) + lu(1032) = - lu(285) * lu(1004) + lu(1033) = - lu(286) * lu(1004) + lu(1034) = lu(1034) - lu(287) * lu(1004) + lu(1036) = - lu(288) * lu(1004) + lu(1043) = lu(1043) - lu(289) * lu(1004) + lu(1268) = lu(1268) - lu(278) * lu(1252) + lu(1271) = lu(1271) - lu(279) * lu(1252) + lu(1272) = - lu(280) * lu(1252) + lu(1274) = lu(1274) - lu(281) * lu(1252) + lu(1275) = - lu(282) * lu(1252) + lu(1276) = lu(1276) - lu(283) * lu(1252) + lu(1279) = lu(1279) - lu(284) * lu(1252) + lu(1282) = lu(1282) - lu(285) * lu(1252) + lu(1283) = lu(1283) - lu(286) * lu(1252) + lu(1284) = - lu(287) * lu(1252) + lu(1286) = - lu(288) * lu(1252) + lu(1293) = lu(1293) - lu(289) * lu(1252) + lu(1351) = lu(1351) - lu(278) * lu(1337) + lu(1354) = - lu(279) * lu(1337) + lu(1355) = - lu(280) * lu(1337) + lu(1357) = lu(1357) - lu(281) * lu(1337) + lu(1358) = - lu(282) * lu(1337) + lu(1359) = lu(1359) - lu(283) * lu(1337) + lu(1362) = lu(1362) - lu(284) * lu(1337) + lu(1365) = - lu(285) * lu(1337) + lu(1366) = lu(1366) - lu(286) * lu(1337) + lu(1367) = lu(1367) - lu(287) * lu(1337) + lu(1369) = lu(1369) - lu(288) * lu(1337) + lu(1376) = lu(1376) - lu(289) * lu(1337) + lu(1435) = lu(1435) - lu(278) * lu(1421) + lu(1438) = - lu(279) * lu(1421) + lu(1439) = - lu(280) * lu(1421) + lu(1441) = lu(1441) - lu(281) * lu(1421) + lu(1442) = - lu(282) * lu(1421) + lu(1443) = - lu(283) * lu(1421) + lu(1446) = lu(1446) - lu(284) * lu(1421) + lu(1449) = - lu(285) * lu(1421) + lu(1450) = lu(1450) - lu(286) * lu(1421) + lu(1451) = lu(1451) - lu(287) * lu(1421) + lu(1453) = lu(1453) - lu(288) * lu(1421) + lu(1460) = lu(1460) - lu(289) * lu(1421) + lu(1522) = lu(1522) - lu(278) * lu(1517) + lu(1525) = - lu(279) * lu(1517) + lu(1526) = - lu(280) * lu(1517) + lu(1528) = lu(1528) - lu(281) * lu(1517) + lu(1529) = - lu(282) * lu(1517) + lu(1530) = - lu(283) * lu(1517) + lu(1533) = lu(1533) - lu(284) * lu(1517) + lu(1536) = - lu(285) * lu(1517) + lu(1537) = lu(1537) - lu(286) * lu(1517) + lu(1538) = - lu(287) * lu(1517) + lu(1540) = - lu(288) * lu(1517) + lu(1547) = lu(1547) - lu(289) * lu(1517) end subroutine lu_fac07 - subroutine lu_fac08( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac08( lu ) 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,285) = 1._r8 / lu(k,285) - lu(k,286) = lu(k,286) * lu(k,285) - lu(k,287) = lu(k,287) * lu(k,285) - lu(k,288) = lu(k,288) * lu(k,285) - lu(k,289) = lu(k,289) * lu(k,285) - lu(k,290) = lu(k,290) * lu(k,285) - lu(k,291) = lu(k,291) * lu(k,285) - lu(k,292) = lu(k,292) * lu(k,285) - lu(k,293) = lu(k,293) * lu(k,285) - lu(k,294) = lu(k,294) * lu(k,285) - lu(k,295) = lu(k,295) * lu(k,285) - lu(k,296) = lu(k,296) * lu(k,285) - lu(k,575) = lu(k,575) - lu(k,286) * lu(k,568) - lu(k,576) = - lu(k,287) * lu(k,568) - lu(k,577) = lu(k,577) - lu(k,288) * lu(k,568) - lu(k,578) = lu(k,578) - lu(k,289) * lu(k,568) - lu(k,582) = lu(k,582) - lu(k,290) * lu(k,568) - lu(k,583) = lu(k,583) - lu(k,291) * lu(k,568) - lu(k,584) = lu(k,584) - lu(k,292) * lu(k,568) - lu(k,586) = lu(k,586) - lu(k,293) * lu(k,568) - lu(k,590) = lu(k,590) - lu(k,294) * lu(k,568) - lu(k,592) = lu(k,592) - lu(k,295) * lu(k,568) - lu(k,594) = lu(k,594) - lu(k,296) * lu(k,568) - lu(k,974) = lu(k,974) - lu(k,286) * lu(k,962) - lu(k,976) = - lu(k,287) * lu(k,962) - lu(k,979) = lu(k,979) - lu(k,288) * lu(k,962) - lu(k,980) = lu(k,980) - lu(k,289) * lu(k,962) - lu(k,986) = lu(k,986) - lu(k,290) * lu(k,962) - lu(k,987) = lu(k,987) - lu(k,291) * lu(k,962) - lu(k,988) = lu(k,988) - lu(k,292) * lu(k,962) - lu(k,990) = lu(k,990) - lu(k,293) * lu(k,962) - lu(k,995) = lu(k,995) - lu(k,294) * lu(k,962) - lu(k,997) = lu(k,997) - lu(k,295) * lu(k,962) - lu(k,999) = lu(k,999) - lu(k,296) * lu(k,962) - lu(k,1018) = lu(k,1018) - lu(k,286) * lu(k,1015) - lu(k,1019) = lu(k,1019) - lu(k,287) * lu(k,1015) - lu(k,1022) = lu(k,1022) - lu(k,288) * lu(k,1015) - lu(k,1023) = lu(k,1023) - lu(k,289) * lu(k,1015) - lu(k,1029) = lu(k,1029) - lu(k,290) * lu(k,1015) - lu(k,1030) = lu(k,1030) - lu(k,291) * lu(k,1015) - lu(k,1031) = lu(k,1031) - lu(k,292) * lu(k,1015) - lu(k,1033) = lu(k,1033) - lu(k,293) * lu(k,1015) - lu(k,1038) = lu(k,1038) - lu(k,294) * lu(k,1015) - lu(k,1040) = lu(k,1040) - lu(k,295) * lu(k,1015) - lu(k,1042) = lu(k,1042) - lu(k,296) * lu(k,1015) - lu(k,1265) = lu(k,1265) - lu(k,286) * lu(k,1258) - lu(k,1267) = - lu(k,287) * lu(k,1258) - lu(k,1270) = lu(k,1270) - lu(k,288) * lu(k,1258) - lu(k,1271) = lu(k,1271) - lu(k,289) * lu(k,1258) - lu(k,1277) = lu(k,1277) - lu(k,290) * lu(k,1258) - lu(k,1278) = lu(k,1278) - lu(k,291) * lu(k,1258) - lu(k,1279) = lu(k,1279) - lu(k,292) * lu(k,1258) - lu(k,1281) = lu(k,1281) - lu(k,293) * lu(k,1258) - lu(k,1286) = lu(k,1286) - lu(k,294) * lu(k,1258) - lu(k,1288) = lu(k,1288) - lu(k,295) * lu(k,1258) - lu(k,1290) = - lu(k,296) * lu(k,1258) - lu(k,1301) = - lu(k,286) * lu(k,1294) - lu(k,1303) = lu(k,1303) - lu(k,287) * lu(k,1294) - lu(k,1306) = lu(k,1306) - lu(k,288) * lu(k,1294) - lu(k,1307) = lu(k,1307) - lu(k,289) * lu(k,1294) - lu(k,1313) = lu(k,1313) - lu(k,290) * lu(k,1294) - lu(k,1314) = lu(k,1314) - lu(k,291) * lu(k,1294) - lu(k,1315) = lu(k,1315) - lu(k,292) * lu(k,1294) - lu(k,1317) = lu(k,1317) - lu(k,293) * lu(k,1294) - lu(k,1322) = lu(k,1322) - lu(k,294) * lu(k,1294) - lu(k,1324) = lu(k,1324) - lu(k,295) * lu(k,1294) - lu(k,1326) = lu(k,1326) - lu(k,296) * lu(k,1294) - lu(k,1346) = lu(k,1346) - lu(k,286) * lu(k,1329) - lu(k,1348) = lu(k,1348) - lu(k,287) * lu(k,1329) - lu(k,1351) = lu(k,1351) - lu(k,288) * lu(k,1329) - lu(k,1352) = lu(k,1352) - lu(k,289) * lu(k,1329) - lu(k,1358) = lu(k,1358) - lu(k,290) * lu(k,1329) - lu(k,1359) = lu(k,1359) - lu(k,291) * lu(k,1329) - lu(k,1360) = lu(k,1360) - lu(k,292) * lu(k,1329) - lu(k,1362) = - lu(k,293) * lu(k,1329) - lu(k,1367) = - lu(k,294) * lu(k,1329) - lu(k,1369) = lu(k,1369) - lu(k,295) * lu(k,1329) - lu(k,1371) = lu(k,1371) - lu(k,296) * lu(k,1329) - lu(k,1388) = lu(k,1388) - lu(k,286) * lu(k,1380) - lu(k,1390) = - lu(k,287) * lu(k,1380) - lu(k,1393) = lu(k,1393) - lu(k,288) * lu(k,1380) - lu(k,1394) = lu(k,1394) - lu(k,289) * lu(k,1380) - lu(k,1400) = lu(k,1400) - lu(k,290) * lu(k,1380) - lu(k,1401) = lu(k,1401) - lu(k,291) * lu(k,1380) - lu(k,1402) = lu(k,1402) - lu(k,292) * lu(k,1380) - lu(k,1404) = lu(k,1404) - lu(k,293) * lu(k,1380) - lu(k,1409) = lu(k,1409) - lu(k,294) * lu(k,1380) - lu(k,1411) = lu(k,1411) - lu(k,295) * lu(k,1380) - lu(k,1413) = lu(k,1413) - lu(k,296) * lu(k,1380) - lu(k,1426) = lu(k,1426) - lu(k,286) * lu(k,1416) - lu(k,1428) = - lu(k,287) * lu(k,1416) - lu(k,1431) = lu(k,1431) - lu(k,288) * lu(k,1416) - lu(k,1432) = lu(k,1432) - lu(k,289) * lu(k,1416) - lu(k,1438) = lu(k,1438) - lu(k,290) * lu(k,1416) - lu(k,1439) = lu(k,1439) - lu(k,291) * lu(k,1416) - lu(k,1440) = lu(k,1440) - lu(k,292) * lu(k,1416) - lu(k,1442) = lu(k,1442) - lu(k,293) * lu(k,1416) - lu(k,1447) = lu(k,1447) - lu(k,294) * lu(k,1416) - lu(k,1449) = lu(k,1449) - lu(k,295) * lu(k,1416) - lu(k,1451) = - lu(k,296) * lu(k,1416) - lu(k,1626) = lu(k,1626) - lu(k,286) * lu(k,1617) - lu(k,1628) = - lu(k,287) * lu(k,1617) - lu(k,1631) = lu(k,1631) - lu(k,288) * lu(k,1617) - lu(k,1632) = lu(k,1632) - lu(k,289) * lu(k,1617) - lu(k,1638) = lu(k,1638) - lu(k,290) * lu(k,1617) - lu(k,1639) = lu(k,1639) - lu(k,291) * lu(k,1617) - lu(k,1640) = lu(k,1640) - lu(k,292) * lu(k,1617) - lu(k,1642) = lu(k,1642) - lu(k,293) * lu(k,1617) - lu(k,1647) = lu(k,1647) - lu(k,294) * lu(k,1617) - lu(k,1649) = lu(k,1649) - lu(k,295) * lu(k,1617) - lu(k,1651) = lu(k,1651) - lu(k,296) * lu(k,1617) - lu(k,1800) = lu(k,1800) - lu(k,286) * lu(k,1786) - lu(k,1802) = lu(k,1802) - lu(k,287) * lu(k,1786) - lu(k,1805) = lu(k,1805) - lu(k,288) * lu(k,1786) - lu(k,1806) = lu(k,1806) - lu(k,289) * lu(k,1786) - lu(k,1812) = lu(k,1812) - lu(k,290) * lu(k,1786) - lu(k,1813) = - lu(k,291) * lu(k,1786) - lu(k,1814) = lu(k,1814) - lu(k,292) * lu(k,1786) - lu(k,1816) = - lu(k,293) * lu(k,1786) - lu(k,1821) = lu(k,1821) - lu(k,294) * lu(k,1786) - lu(k,1823) = lu(k,1823) - lu(k,295) * lu(k,1786) - lu(k,1825) = lu(k,1825) - lu(k,296) * lu(k,1786) - lu(k,297) = 1._r8 / lu(k,297) - lu(k,298) = lu(k,298) * lu(k,297) - lu(k,299) = lu(k,299) * lu(k,297) - lu(k,300) = lu(k,300) * lu(k,297) - lu(k,301) = lu(k,301) * lu(k,297) - lu(k,302) = lu(k,302) * lu(k,297) - lu(k,303) = lu(k,303) * lu(k,297) - lu(k,304) = lu(k,304) * lu(k,297) - lu(k,305) = lu(k,305) * lu(k,297) - lu(k,306) = lu(k,306) * lu(k,297) - lu(k,307) = lu(k,307) * lu(k,297) - lu(k,308) = lu(k,308) * lu(k,297) - lu(k,309) = lu(k,309) * lu(k,297) - lu(k,310) = lu(k,310) * lu(k,297) - lu(k,827) = lu(k,827) - lu(k,298) * lu(k,812) - lu(k,829) = lu(k,829) - lu(k,299) * lu(k,812) - lu(k,830) = - lu(k,300) * lu(k,812) - lu(k,831) = - lu(k,301) * lu(k,812) - lu(k,834) = - lu(k,302) * lu(k,812) - lu(k,837) = lu(k,837) - lu(k,303) * lu(k,812) - lu(k,839) = lu(k,839) - lu(k,304) * lu(k,812) - lu(k,841) = - lu(k,305) * lu(k,812) - lu(k,842) = lu(k,842) - lu(k,306) * lu(k,812) - lu(k,846) = - lu(k,307) * lu(k,812) - lu(k,850) = lu(k,850) - lu(k,308) * lu(k,812) - lu(k,851) = - lu(k,309) * lu(k,812) - lu(k,852) = lu(k,852) - lu(k,310) * lu(k,812) - lu(k,875) = lu(k,875) - lu(k,298) * lu(k,859) - lu(k,877) = - lu(k,299) * lu(k,859) - lu(k,878) = lu(k,878) - lu(k,300) * lu(k,859) - lu(k,879) = - lu(k,301) * lu(k,859) - lu(k,882) = lu(k,882) - lu(k,302) * lu(k,859) - lu(k,885) = - lu(k,303) * lu(k,859) - lu(k,887) = lu(k,887) - lu(k,304) * lu(k,859) - lu(k,889) = lu(k,889) - lu(k,305) * lu(k,859) - lu(k,890) = lu(k,890) - lu(k,306) * lu(k,859) - lu(k,894) = - lu(k,307) * lu(k,859) - lu(k,898) = lu(k,898) - lu(k,308) * lu(k,859) - lu(k,899) = lu(k,899) - lu(k,309) * lu(k,859) - lu(k,900) = lu(k,900) - lu(k,310) * lu(k,859) - lu(k,918) = lu(k,918) - lu(k,298) * lu(k,903) - lu(k,920) = lu(k,920) - lu(k,299) * lu(k,903) - lu(k,921) = - lu(k,300) * lu(k,903) - lu(k,922) = lu(k,922) - lu(k,301) * lu(k,903) - lu(k,925) = - lu(k,302) * lu(k,903) - lu(k,928) = - lu(k,303) * lu(k,903) - lu(k,930) = lu(k,930) - lu(k,304) * lu(k,903) - lu(k,932) = - lu(k,305) * lu(k,903) - lu(k,933) = lu(k,933) - lu(k,306) * lu(k,903) - lu(k,937) = - lu(k,307) * lu(k,903) - lu(k,941) = - lu(k,308) * lu(k,903) - lu(k,942) = lu(k,942) - lu(k,309) * lu(k,903) - lu(k,943) = lu(k,943) - lu(k,310) * lu(k,903) - lu(k,1059) = lu(k,1059) - lu(k,298) * lu(k,1044) - lu(k,1061) = lu(k,1061) - lu(k,299) * lu(k,1044) - lu(k,1062) = - lu(k,300) * lu(k,1044) - lu(k,1063) = lu(k,1063) - lu(k,301) * lu(k,1044) - lu(k,1066) = lu(k,1066) - lu(k,302) * lu(k,1044) - lu(k,1069) = - lu(k,303) * lu(k,1044) - lu(k,1071) = lu(k,1071) - lu(k,304) * lu(k,1044) - lu(k,1073) = - lu(k,305) * lu(k,1044) - lu(k,1074) = lu(k,1074) - lu(k,306) * lu(k,1044) - lu(k,1078) = - lu(k,307) * lu(k,1044) - lu(k,1082) = lu(k,1082) - lu(k,308) * lu(k,1044) - lu(k,1083) = lu(k,1083) - lu(k,309) * lu(k,1044) - lu(k,1084) = lu(k,1084) - lu(k,310) * lu(k,1044) - lu(k,1187) = lu(k,1187) - lu(k,298) * lu(k,1172) - lu(k,1189) = lu(k,1189) - lu(k,299) * lu(k,1172) - lu(k,1190) = - lu(k,300) * lu(k,1172) - lu(k,1191) = - lu(k,301) * lu(k,1172) - lu(k,1194) = - lu(k,302) * lu(k,1172) - lu(k,1197) = lu(k,1197) - lu(k,303) * lu(k,1172) - lu(k,1199) = lu(k,1199) - lu(k,304) * lu(k,1172) - lu(k,1201) = - lu(k,305) * lu(k,1172) - lu(k,1202) = lu(k,1202) - lu(k,306) * lu(k,1172) - lu(k,1206) = lu(k,1206) - lu(k,307) * lu(k,1172) - lu(k,1210) = lu(k,1210) - lu(k,308) * lu(k,1172) - lu(k,1211) = lu(k,1211) - lu(k,309) * lu(k,1172) - lu(k,1212) = lu(k,1212) - lu(k,310) * lu(k,1172) - lu(k,1346) = lu(k,1346) - lu(k,298) * lu(k,1330) - lu(k,1348) = lu(k,1348) - lu(k,299) * lu(k,1330) - lu(k,1349) = lu(k,1349) - lu(k,300) * lu(k,1330) - lu(k,1350) = - lu(k,301) * lu(k,1330) - lu(k,1353) = - lu(k,302) * lu(k,1330) - lu(k,1356) = - lu(k,303) * lu(k,1330) - lu(k,1358) = lu(k,1358) - lu(k,304) * lu(k,1330) - lu(k,1360) = lu(k,1360) - lu(k,305) * lu(k,1330) - lu(k,1361) = lu(k,1361) - lu(k,306) * lu(k,1330) - lu(k,1365) = - lu(k,307) * lu(k,1330) - lu(k,1369) = lu(k,1369) - lu(k,308) * lu(k,1330) - lu(k,1370) = lu(k,1370) - lu(k,309) * lu(k,1330) - lu(k,1371) = lu(k,1371) - lu(k,310) * lu(k,1330) - lu(k,1388) = lu(k,1388) - lu(k,298) * lu(k,1381) - lu(k,1390) = lu(k,1390) - lu(k,299) * lu(k,1381) - lu(k,1391) = lu(k,1391) - lu(k,300) * lu(k,1381) - lu(k,1392) = - lu(k,301) * lu(k,1381) - lu(k,1395) = lu(k,1395) - lu(k,302) * lu(k,1381) - lu(k,1398) = - lu(k,303) * lu(k,1381) - lu(k,1400) = lu(k,1400) - lu(k,304) * lu(k,1381) - lu(k,1402) = lu(k,1402) - lu(k,305) * lu(k,1381) - lu(k,1403) = lu(k,1403) - lu(k,306) * lu(k,1381) - lu(k,1407) = - lu(k,307) * lu(k,1381) - lu(k,1411) = lu(k,1411) - lu(k,308) * lu(k,1381) - lu(k,1412) = lu(k,1412) - lu(k,309) * lu(k,1381) - lu(k,1413) = lu(k,1413) - lu(k,310) * lu(k,1381) - lu(k,1557) = lu(k,1557) - lu(k,298) * lu(k,1542) - lu(k,1559) = - lu(k,299) * lu(k,1542) - lu(k,1560) = - lu(k,300) * lu(k,1542) - lu(k,1561) = - lu(k,301) * lu(k,1542) - lu(k,1564) = - lu(k,302) * lu(k,1542) - lu(k,1567) = lu(k,1567) - lu(k,303) * lu(k,1542) - lu(k,1569) = lu(k,1569) - lu(k,304) * lu(k,1542) - lu(k,1571) = - lu(k,305) * lu(k,1542) - lu(k,1572) = lu(k,1572) - lu(k,306) * lu(k,1542) - lu(k,1576) = lu(k,1576) - lu(k,307) * lu(k,1542) - lu(k,1580) = lu(k,1580) - lu(k,308) * lu(k,1542) - lu(k,1581) = lu(k,1581) - lu(k,309) * lu(k,1542) - lu(k,1582) = lu(k,1582) - lu(k,310) * lu(k,1542) - lu(k,1590) = lu(k,1590) - lu(k,298) * lu(k,1584) - lu(k,1592) = - lu(k,299) * lu(k,1584) - lu(k,1593) = - lu(k,300) * lu(k,1584) - lu(k,1594) = - lu(k,301) * lu(k,1584) - lu(k,1597) = - lu(k,302) * lu(k,1584) - lu(k,1600) = - lu(k,303) * lu(k,1584) - lu(k,1602) = lu(k,1602) - lu(k,304) * lu(k,1584) - lu(k,1604) = - lu(k,305) * lu(k,1584) - lu(k,1605) = lu(k,1605) - lu(k,306) * lu(k,1584) - lu(k,1609) = - lu(k,307) * lu(k,1584) - lu(k,1613) = lu(k,1613) - lu(k,308) * lu(k,1584) - lu(k,1614) = lu(k,1614) - lu(k,309) * lu(k,1584) - lu(k,1615) = lu(k,1615) - lu(k,310) * lu(k,1584) - end do + real(r8), intent(inout) :: lu(:) + lu(292) = 1._r8 / lu(292) + lu(293) = lu(293) * lu(292) + lu(294) = lu(294) * lu(292) + lu(295) = lu(295) * lu(292) + lu(296) = lu(296) * lu(292) + lu(297) = lu(297) * lu(292) + lu(298) = lu(298) * lu(292) + lu(299) = lu(299) * lu(292) + lu(300) = lu(300) * lu(292) + lu(301) = lu(301) * lu(292) + lu(302) = lu(302) * lu(292) + lu(303) = lu(303) * lu(292) + lu(562) = lu(562) - lu(293) * lu(555) + lu(564) = lu(564) - lu(294) * lu(555) + lu(565) = - lu(295) * lu(555) + lu(568) = lu(568) - lu(296) * lu(555) + lu(570) = lu(570) - lu(297) * lu(555) + lu(571) = lu(571) - lu(298) * lu(555) + lu(573) = lu(573) - lu(299) * lu(555) + lu(574) = lu(574) - lu(300) * lu(555) + lu(576) = lu(576) - lu(301) * lu(555) + lu(577) = lu(577) - lu(302) * lu(555) + lu(580) = lu(580) - lu(303) * lu(555) + lu(1147) = lu(1147) - lu(293) * lu(1140) + lu(1153) = lu(1153) - lu(294) * lu(1140) + lu(1155) = - lu(295) * lu(1140) + lu(1158) = lu(1158) - lu(296) * lu(1140) + lu(1160) = lu(1160) - lu(297) * lu(1140) + lu(1161) = lu(1161) - lu(298) * lu(1140) + lu(1164) = lu(1164) - lu(299) * lu(1140) + lu(1166) = lu(1166) - lu(300) * lu(1140) + lu(1168) = lu(1168) - lu(301) * lu(1140) + lu(1169) = lu(1169) - lu(302) * lu(1140) + lu(1172) = - lu(303) * lu(1140) + lu(1224) = - lu(293) * lu(1218) + lu(1230) = lu(1230) - lu(294) * lu(1218) + lu(1232) = lu(1232) - lu(295) * lu(1218) + lu(1235) = lu(1235) - lu(296) * lu(1218) + lu(1237) = lu(1237) - lu(297) * lu(1218) + lu(1238) = lu(1238) - lu(298) * lu(1218) + lu(1241) = lu(1241) - lu(299) * lu(1218) + lu(1243) = lu(1243) - lu(300) * lu(1218) + lu(1245) = lu(1245) - lu(301) * lu(1218) + lu(1246) = lu(1246) - lu(302) * lu(1218) + lu(1249) = lu(1249) - lu(303) * lu(1218) + lu(1268) = lu(1268) - lu(293) * lu(1253) + lu(1274) = lu(1274) - lu(294) * lu(1253) + lu(1276) = lu(1276) - lu(295) * lu(1253) + lu(1279) = lu(1279) - lu(296) * lu(1253) + lu(1281) = lu(1281) - lu(297) * lu(1253) + lu(1282) = lu(1282) - lu(298) * lu(1253) + lu(1285) = lu(1285) - lu(299) * lu(1253) + lu(1287) = lu(1287) - lu(300) * lu(1253) + lu(1289) = - lu(301) * lu(1253) + lu(1290) = - lu(302) * lu(1253) + lu(1293) = lu(1293) - lu(303) * lu(1253) + lu(1395) = lu(1395) - lu(293) * lu(1392) + lu(1399) = lu(1399) - lu(294) * lu(1392) + lu(1401) = lu(1401) - lu(295) * lu(1392) + lu(1404) = lu(1404) - lu(296) * lu(1392) + lu(1406) = lu(1406) - lu(297) * lu(1392) + lu(1407) = lu(1407) - lu(298) * lu(1392) + lu(1410) = lu(1410) - lu(299) * lu(1392) + lu(1412) = lu(1412) - lu(300) * lu(1392) + lu(1414) = lu(1414) - lu(301) * lu(1392) + lu(1415) = lu(1415) - lu(302) * lu(1392) + lu(1418) = lu(1418) - lu(303) * lu(1392) + lu(1490) = lu(1490) - lu(293) * lu(1479) + lu(1496) = lu(1496) - lu(294) * lu(1479) + lu(1498) = - lu(295) * lu(1479) + lu(1501) = lu(1501) - lu(296) * lu(1479) + lu(1503) = lu(1503) - lu(297) * lu(1479) + lu(1504) = lu(1504) - lu(298) * lu(1479) + lu(1507) = lu(1507) - lu(299) * lu(1479) + lu(1509) = lu(1509) - lu(300) * lu(1479) + lu(1511) = lu(1511) - lu(301) * lu(1479) + lu(1512) = lu(1512) - lu(302) * lu(1479) + lu(1515) = lu(1515) - lu(303) * lu(1479) + lu(1557) = lu(1557) - lu(293) * lu(1549) + lu(1563) = lu(1563) - lu(294) * lu(1549) + lu(1565) = - lu(295) * lu(1549) + lu(1568) = lu(1568) - lu(296) * lu(1549) + lu(1570) = lu(1570) - lu(297) * lu(1549) + lu(1571) = lu(1571) - lu(298) * lu(1549) + lu(1574) = lu(1574) - lu(299) * lu(1549) + lu(1576) = lu(1576) - lu(300) * lu(1549) + lu(1578) = lu(1578) - lu(301) * lu(1549) + lu(1579) = lu(1579) - lu(302) * lu(1549) + lu(1582) = lu(1582) - lu(303) * lu(1549) + lu(1595) = lu(1595) - lu(293) * lu(1585) + lu(1601) = lu(1601) - lu(294) * lu(1585) + lu(1603) = - lu(295) * lu(1585) + lu(1606) = lu(1606) - lu(296) * lu(1585) + lu(1608) = lu(1608) - lu(297) * lu(1585) + lu(1609) = lu(1609) - lu(298) * lu(1585) + lu(1612) = lu(1612) - lu(299) * lu(1585) + lu(1614) = lu(1614) - lu(300) * lu(1585) + lu(1616) = lu(1616) - lu(301) * lu(1585) + lu(1617) = lu(1617) - lu(302) * lu(1585) + lu(1620) = - lu(303) * lu(1585) + lu(1720) = lu(1720) - lu(293) * lu(1707) + lu(1726) = lu(1726) - lu(294) * lu(1707) + lu(1728) = lu(1728) - lu(295) * lu(1707) + lu(1731) = lu(1731) - lu(296) * lu(1707) + lu(1733) = - lu(297) * lu(1707) + lu(1734) = lu(1734) - lu(298) * lu(1707) + lu(1737) = lu(1737) - lu(299) * lu(1707) + lu(1739) = lu(1739) - lu(300) * lu(1707) + lu(1741) = lu(1741) - lu(301) * lu(1707) + lu(1742) = - lu(302) * lu(1707) + lu(1745) = lu(1745) - lu(303) * lu(1707) + lu(304) = 1._r8 / lu(304) + lu(305) = lu(305) * lu(304) + lu(306) = lu(306) * lu(304) + lu(307) = lu(307) * lu(304) + lu(308) = lu(308) * lu(304) + lu(309) = lu(309) * lu(304) + lu(310) = lu(310) * lu(304) + lu(311) = lu(311) * lu(304) + lu(312) = lu(312) * lu(304) + lu(313) = lu(313) * lu(304) + lu(314) = lu(314) * lu(304) + lu(315) = lu(315) * lu(304) + lu(316) = lu(316) * lu(304) + lu(317) = lu(317) * lu(304) + lu(486) = lu(486) - lu(305) * lu(484) + lu(491) = lu(491) - lu(306) * lu(484) + lu(492) = lu(492) - lu(307) * lu(484) + lu(493) = lu(493) - lu(308) * lu(484) + lu(494) = lu(494) - lu(309) * lu(484) + lu(495) = lu(495) - lu(310) * lu(484) + lu(497) = lu(497) - lu(311) * lu(484) + lu(498) = lu(498) - lu(312) * lu(484) + lu(499) = lu(499) - lu(313) * lu(484) + lu(500) = lu(500) - lu(314) * lu(484) + lu(501) = lu(501) - lu(315) * lu(484) + lu(502) = lu(502) - lu(316) * lu(484) + lu(503) = lu(503) - lu(317) * lu(484) + lu(807) = lu(807) - lu(305) * lu(800) + lu(817) = lu(817) - lu(306) * lu(800) + lu(818) = lu(818) - lu(307) * lu(800) + lu(820) = lu(820) - lu(308) * lu(800) + lu(821) = lu(821) - lu(309) * lu(800) + lu(822) = lu(822) - lu(310) * lu(800) + lu(825) = lu(825) - lu(311) * lu(800) + lu(828) = lu(828) - lu(312) * lu(800) + lu(829) = lu(829) - lu(313) * lu(800) + lu(830) = lu(830) - lu(314) * lu(800) + lu(832) = lu(832) - lu(315) * lu(800) + lu(833) = lu(833) - lu(316) * lu(800) + lu(839) = lu(839) - lu(317) * lu(800) + lu(850) = lu(850) - lu(305) * lu(843) + lu(859) = lu(859) - lu(306) * lu(843) + lu(860) = lu(860) - lu(307) * lu(843) + lu(862) = lu(862) - lu(308) * lu(843) + lu(863) = lu(863) - lu(309) * lu(843) + lu(864) = lu(864) - lu(310) * lu(843) + lu(867) = lu(867) - lu(311) * lu(843) + lu(870) = lu(870) - lu(312) * lu(843) + lu(871) = lu(871) - lu(313) * lu(843) + lu(872) = lu(872) - lu(314) * lu(843) + lu(874) = lu(874) - lu(315) * lu(843) + lu(875) = lu(875) - lu(316) * lu(843) + lu(881) = lu(881) - lu(317) * lu(843) + lu(970) = lu(970) - lu(305) * lu(963) + lu(979) = lu(979) - lu(306) * lu(963) + lu(980) = lu(980) - lu(307) * lu(963) + lu(982) = lu(982) - lu(308) * lu(963) + lu(983) = lu(983) - lu(309) * lu(963) + lu(984) = lu(984) - lu(310) * lu(963) + lu(987) = lu(987) - lu(311) * lu(963) + lu(990) = lu(990) - lu(312) * lu(963) + lu(991) = lu(991) - lu(313) * lu(963) + lu(992) = lu(992) - lu(314) * lu(963) + lu(994) = lu(994) - lu(315) * lu(963) + lu(995) = lu(995) - lu(316) * lu(963) + lu(1001) = lu(1001) - lu(317) * lu(963) + lu(1012) = lu(1012) - lu(305) * lu(1005) + lu(1021) = lu(1021) - lu(306) * lu(1005) + lu(1022) = lu(1022) - lu(307) * lu(1005) + lu(1024) = lu(1024) - lu(308) * lu(1005) + lu(1025) = lu(1025) - lu(309) * lu(1005) + lu(1026) = lu(1026) - lu(310) * lu(1005) + lu(1029) = lu(1029) - lu(311) * lu(1005) + lu(1032) = lu(1032) - lu(312) * lu(1005) + lu(1033) = lu(1033) - lu(313) * lu(1005) + lu(1034) = lu(1034) - lu(314) * lu(1005) + lu(1036) = lu(1036) - lu(315) * lu(1005) + lu(1037) = lu(1037) - lu(316) * lu(1005) + lu(1043) = lu(1043) - lu(317) * lu(1005) + lu(1261) = lu(1261) - lu(305) * lu(1254) + lu(1271) = lu(1271) - lu(306) * lu(1254) + lu(1272) = lu(1272) - lu(307) * lu(1254) + lu(1274) = lu(1274) - lu(308) * lu(1254) + lu(1275) = lu(1275) - lu(309) * lu(1254) + lu(1276) = lu(1276) - lu(310) * lu(1254) + lu(1279) = lu(1279) - lu(311) * lu(1254) + lu(1282) = lu(1282) - lu(312) * lu(1254) + lu(1283) = lu(1283) - lu(313) * lu(1254) + lu(1284) = lu(1284) - lu(314) * lu(1254) + lu(1286) = lu(1286) - lu(315) * lu(1254) + lu(1287) = lu(1287) - lu(316) * lu(1254) + lu(1293) = lu(1293) - lu(317) * lu(1254) + lu(1345) = lu(1345) - lu(305) * lu(1338) + lu(1354) = lu(1354) - lu(306) * lu(1338) + lu(1355) = lu(1355) - lu(307) * lu(1338) + lu(1357) = lu(1357) - lu(308) * lu(1338) + lu(1358) = lu(1358) - lu(309) * lu(1338) + lu(1359) = lu(1359) - lu(310) * lu(1338) + lu(1362) = lu(1362) - lu(311) * lu(1338) + lu(1365) = lu(1365) - lu(312) * lu(1338) + lu(1366) = lu(1366) - lu(313) * lu(1338) + lu(1367) = lu(1367) - lu(314) * lu(1338) + lu(1369) = lu(1369) - lu(315) * lu(1338) + lu(1370) = lu(1370) - lu(316) * lu(1338) + lu(1376) = lu(1376) - lu(317) * lu(1338) + lu(1429) = lu(1429) - lu(305) * lu(1422) + lu(1438) = lu(1438) - lu(306) * lu(1422) + lu(1439) = lu(1439) - lu(307) * lu(1422) + lu(1441) = lu(1441) - lu(308) * lu(1422) + lu(1442) = lu(1442) - lu(309) * lu(1422) + lu(1443) = lu(1443) - lu(310) * lu(1422) + lu(1446) = lu(1446) - lu(311) * lu(1422) + lu(1449) = lu(1449) - lu(312) * lu(1422) + lu(1450) = lu(1450) - lu(313) * lu(1422) + lu(1451) = lu(1451) - lu(314) * lu(1422) + lu(1453) = lu(1453) - lu(315) * lu(1422) + lu(1454) = lu(1454) - lu(316) * lu(1422) + lu(1460) = lu(1460) - lu(317) * lu(1422) + lu(1713) = lu(1713) - lu(305) * lu(1708) + lu(1723) = lu(1723) - lu(306) * lu(1708) + lu(1724) = lu(1724) - lu(307) * lu(1708) + lu(1726) = lu(1726) - lu(308) * lu(1708) + lu(1727) = lu(1727) - lu(309) * lu(1708) + lu(1728) = lu(1728) - lu(310) * lu(1708) + lu(1731) = lu(1731) - lu(311) * lu(1708) + lu(1734) = lu(1734) - lu(312) * lu(1708) + lu(1735) = lu(1735) - lu(313) * lu(1708) + lu(1736) = lu(1736) - lu(314) * lu(1708) + lu(1738) = lu(1738) - lu(315) * lu(1708) + lu(1739) = lu(1739) - lu(316) * lu(1708) + lu(1745) = lu(1745) - lu(317) * lu(1708) + lu(320) = 1._r8 / lu(320) + lu(321) = lu(321) * lu(320) + lu(322) = lu(322) * lu(320) + lu(323) = lu(323) * lu(320) + lu(324) = lu(324) * lu(320) + lu(325) = lu(325) * lu(320) + lu(326) = lu(326) * lu(320) + lu(327) = lu(327) * lu(320) + lu(328) = lu(328) * lu(320) + lu(329) = lu(329) * lu(320) + lu(330) = lu(330) * lu(320) + lu(411) = lu(411) - lu(321) * lu(410) + lu(412) = - lu(322) * lu(410) + lu(413) = - lu(323) * lu(410) + lu(414) = lu(414) - lu(324) * lu(410) + lu(415) = lu(415) - lu(325) * lu(410) + lu(417) = - lu(326) * lu(410) + lu(420) = lu(420) - lu(327) * lu(410) + lu(423) = lu(423) - lu(328) * lu(410) + lu(424) = - lu(329) * lu(410) + lu(427) = lu(427) - lu(330) * lu(410) + lu(527) = lu(527) - lu(321) * lu(526) + lu(529) = lu(529) - lu(322) * lu(526) + lu(530) = lu(530) - lu(323) * lu(526) + lu(531) = lu(531) - lu(324) * lu(526) + lu(532) = lu(532) - lu(325) * lu(526) + lu(534) = lu(534) - lu(326) * lu(526) + lu(537) = - lu(327) * lu(526) + lu(541) = lu(541) - lu(328) * lu(526) + lu(544) = - lu(329) * lu(526) + lu(547) = lu(547) - lu(330) * lu(526) + lu(557) = lu(557) - lu(321) * lu(556) + lu(559) = lu(559) - lu(322) * lu(556) + lu(560) = lu(560) - lu(323) * lu(556) + lu(561) = lu(561) - lu(324) * lu(556) + lu(562) = lu(562) - lu(325) * lu(556) + lu(564) = lu(564) - lu(326) * lu(556) + lu(568) = lu(568) - lu(327) * lu(556) + lu(574) = lu(574) - lu(328) * lu(556) + lu(577) = lu(577) - lu(329) * lu(556) + lu(580) = lu(580) - lu(330) * lu(556) + lu(666) = lu(666) - lu(321) * lu(665) + lu(668) = lu(668) - lu(322) * lu(665) + lu(669) = lu(669) - lu(323) * lu(665) + lu(670) = lu(670) - lu(324) * lu(665) + lu(671) = lu(671) - lu(325) * lu(665) + lu(673) = lu(673) - lu(326) * lu(665) + lu(678) = lu(678) - lu(327) * lu(665) + lu(684) = lu(684) - lu(328) * lu(665) + lu(687) = lu(687) - lu(329) * lu(665) + lu(690) = lu(690) - lu(330) * lu(665) + lu(706) = lu(706) - lu(321) * lu(705) + lu(708) = lu(708) - lu(322) * lu(705) + lu(709) = lu(709) - lu(323) * lu(705) + lu(710) = lu(710) - lu(324) * lu(705) + lu(711) = lu(711) - lu(325) * lu(705) + lu(714) = lu(714) - lu(326) * lu(705) + lu(719) = lu(719) - lu(327) * lu(705) + lu(725) = lu(725) - lu(328) * lu(705) + lu(728) = lu(728) - lu(329) * lu(705) + lu(731) = lu(731) - lu(330) * lu(705) + lu(892) = lu(892) - lu(321) * lu(888) + lu(894) = - lu(322) * lu(888) + lu(895) = lu(895) - lu(323) * lu(888) + lu(899) = lu(899) - lu(324) * lu(888) + lu(900) = lu(900) - lu(325) * lu(888) + lu(906) = lu(906) - lu(326) * lu(888) + lu(911) = - lu(327) * lu(888) + lu(919) = lu(919) - lu(328) * lu(888) + lu(922) = - lu(329) * lu(888) + lu(925) = lu(925) - lu(330) * lu(888) + lu(1052) = lu(1052) - lu(321) * lu(1050) + lu(1057) = - lu(322) * lu(1050) + lu(1058) = lu(1058) - lu(323) * lu(1050) + lu(1061) = lu(1061) - lu(324) * lu(1050) + lu(1062) = lu(1062) - lu(325) * lu(1050) + lu(1068) = lu(1068) - lu(326) * lu(1050) + lu(1073) = lu(1073) - lu(327) * lu(1050) + lu(1081) = lu(1081) - lu(328) * lu(1050) + lu(1084) = lu(1084) - lu(329) * lu(1050) + lu(1087) = lu(1087) - lu(330) * lu(1050) + lu(1097) = lu(1097) - lu(321) * lu(1096) + lu(1098) = lu(1098) - lu(322) * lu(1096) + lu(1099) = - lu(323) * lu(1096) + lu(1103) = lu(1103) - lu(324) * lu(1096) + lu(1104) = lu(1104) - lu(325) * lu(1096) + lu(1110) = lu(1110) - lu(326) * lu(1096) + lu(1115) = lu(1115) - lu(327) * lu(1096) + lu(1123) = lu(1123) - lu(328) * lu(1096) + lu(1126) = - lu(329) * lu(1096) + lu(1129) = lu(1129) - lu(330) * lu(1096) + lu(1181) = - lu(321) * lu(1180) + lu(1183) = lu(1183) - lu(322) * lu(1180) + lu(1184) = - lu(323) * lu(1180) + lu(1188) = lu(1188) - lu(324) * lu(1180) + lu(1189) = lu(1189) - lu(325) * lu(1180) + lu(1195) = lu(1195) - lu(326) * lu(1180) + lu(1200) = lu(1200) - lu(327) * lu(1180) + lu(1208) = lu(1208) - lu(328) * lu(1180) + lu(1211) = lu(1211) - lu(329) * lu(1180) + lu(1214) = lu(1214) - lu(330) * lu(1180) + lu(1301) = lu(1301) - lu(321) * lu(1298) + lu(1304) = lu(1304) - lu(322) * lu(1298) + lu(1305) = lu(1305) - lu(323) * lu(1298) + lu(1308) = lu(1308) - lu(324) * lu(1298) + lu(1309) = lu(1309) - lu(325) * lu(1298) + lu(1315) = lu(1315) - lu(326) * lu(1298) + lu(1320) = lu(1320) - lu(327) * lu(1298) + lu(1328) = lu(1328) - lu(328) * lu(1298) + lu(1331) = lu(1331) - lu(329) * lu(1298) + lu(1334) = lu(1334) - lu(330) * lu(1298) + lu(1482) = lu(1482) - lu(321) * lu(1480) + lu(1484) = lu(1484) - lu(322) * lu(1480) + lu(1485) = lu(1485) - lu(323) * lu(1480) + lu(1489) = lu(1489) - lu(324) * lu(1480) + lu(1490) = lu(1490) - lu(325) * lu(1480) + lu(1496) = lu(1496) - lu(326) * lu(1480) + lu(1501) = lu(1501) - lu(327) * lu(1480) + lu(1509) = lu(1509) - lu(328) * lu(1480) + lu(1512) = lu(1512) - lu(329) * lu(1480) + lu(1515) = lu(1515) - lu(330) * lu(1480) + lu(1588) = lu(1588) - lu(321) * lu(1586) + lu(1589) = - lu(322) * lu(1586) + lu(1590) = lu(1590) - lu(323) * lu(1586) + lu(1594) = lu(1594) - lu(324) * lu(1586) + lu(1595) = lu(1595) - lu(325) * lu(1586) + lu(1601) = lu(1601) - lu(326) * lu(1586) + lu(1606) = lu(1606) - lu(327) * lu(1586) + lu(1614) = lu(1614) - lu(328) * lu(1586) + lu(1617) = lu(1617) - lu(329) * lu(1586) + lu(1620) = lu(1620) - lu(330) * lu(1586) end subroutine lu_fac08 - subroutine lu_fac09( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac09( lu ) 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,311) = 1._r8 / lu(k,311) - lu(k,312) = lu(k,312) * lu(k,311) - lu(k,313) = lu(k,313) * lu(k,311) - lu(k,314) = lu(k,314) * lu(k,311) - lu(k,315) = lu(k,315) * lu(k,311) - lu(k,316) = lu(k,316) * lu(k,311) - lu(k,317) = lu(k,317) * lu(k,311) - lu(k,318) = lu(k,318) * lu(k,311) - lu(k,319) = lu(k,319) * lu(k,311) - lu(k,320) = lu(k,320) * lu(k,311) - lu(k,321) = lu(k,321) * lu(k,311) - lu(k,322) = lu(k,322) * lu(k,311) - lu(k,323) = lu(k,323) * lu(k,311) - lu(k,324) = lu(k,324) * lu(k,311) - lu(k,325) = lu(k,325) * lu(k,311) - lu(k,497) = lu(k,497) - lu(k,312) * lu(k,495) - lu(k,502) = lu(k,502) - lu(k,313) * lu(k,495) - lu(k,503) = lu(k,503) - lu(k,314) * lu(k,495) - lu(k,504) = lu(k,504) - lu(k,315) * lu(k,495) - lu(k,505) = lu(k,505) - lu(k,316) * lu(k,495) - lu(k,506) = lu(k,506) - lu(k,317) * lu(k,495) - lu(k,508) = lu(k,508) - lu(k,318) * lu(k,495) - lu(k,509) = lu(k,509) - lu(k,319) * lu(k,495) - lu(k,510) = lu(k,510) - lu(k,320) * lu(k,495) - lu(k,511) = lu(k,511) - lu(k,321) * lu(k,495) - lu(k,512) = lu(k,512) - lu(k,322) * lu(k,495) - lu(k,513) = lu(k,513) - lu(k,323) * lu(k,495) - lu(k,514) = lu(k,514) - lu(k,324) * lu(k,495) - lu(k,515) = lu(k,515) - lu(k,325) * lu(k,495) - lu(k,820) = lu(k,820) - lu(k,312) * lu(k,813) - lu(k,829) = lu(k,829) - lu(k,313) * lu(k,813) - lu(k,830) = lu(k,830) - lu(k,314) * lu(k,813) - lu(k,831) = lu(k,831) - lu(k,315) * lu(k,813) - lu(k,832) = lu(k,832) - lu(k,316) * lu(k,813) - lu(k,834) = lu(k,834) - lu(k,317) * lu(k,813) - lu(k,837) = lu(k,837) - lu(k,318) * lu(k,813) - lu(k,839) = lu(k,839) - lu(k,319) * lu(k,813) - lu(k,841) = lu(k,841) - lu(k,320) * lu(k,813) - lu(k,842) = lu(k,842) - lu(k,321) * lu(k,813) - lu(k,846) = lu(k,846) - lu(k,322) * lu(k,813) - lu(k,850) = lu(k,850) - lu(k,323) * lu(k,813) - lu(k,851) = lu(k,851) - lu(k,324) * lu(k,813) - lu(k,852) = lu(k,852) - lu(k,325) * lu(k,813) - lu(k,867) = lu(k,867) - lu(k,312) * lu(k,860) - lu(k,877) = lu(k,877) - lu(k,313) * lu(k,860) - lu(k,878) = lu(k,878) - lu(k,314) * lu(k,860) - lu(k,879) = lu(k,879) - lu(k,315) * lu(k,860) - lu(k,880) = lu(k,880) - lu(k,316) * lu(k,860) - lu(k,882) = lu(k,882) - lu(k,317) * lu(k,860) - lu(k,885) = lu(k,885) - lu(k,318) * lu(k,860) - lu(k,887) = lu(k,887) - lu(k,319) * lu(k,860) - lu(k,889) = lu(k,889) - lu(k,320) * lu(k,860) - lu(k,890) = lu(k,890) - lu(k,321) * lu(k,860) - lu(k,894) = lu(k,894) - lu(k,322) * lu(k,860) - lu(k,898) = lu(k,898) - lu(k,323) * lu(k,860) - lu(k,899) = lu(k,899) - lu(k,324) * lu(k,860) - lu(k,900) = lu(k,900) - lu(k,325) * lu(k,860) - lu(k,911) = lu(k,911) - lu(k,312) * lu(k,904) - lu(k,920) = lu(k,920) - lu(k,313) * lu(k,904) - lu(k,921) = lu(k,921) - lu(k,314) * lu(k,904) - lu(k,922) = lu(k,922) - lu(k,315) * lu(k,904) - lu(k,923) = lu(k,923) - lu(k,316) * lu(k,904) - lu(k,925) = lu(k,925) - lu(k,317) * lu(k,904) - lu(k,928) = lu(k,928) - lu(k,318) * lu(k,904) - lu(k,930) = lu(k,930) - lu(k,319) * lu(k,904) - lu(k,932) = lu(k,932) - lu(k,320) * lu(k,904) - lu(k,933) = lu(k,933) - lu(k,321) * lu(k,904) - lu(k,937) = lu(k,937) - lu(k,322) * lu(k,904) - lu(k,941) = lu(k,941) - lu(k,323) * lu(k,904) - lu(k,942) = lu(k,942) - lu(k,324) * lu(k,904) - lu(k,943) = lu(k,943) - lu(k,325) * lu(k,904) - lu(k,1052) = lu(k,1052) - lu(k,312) * lu(k,1045) - lu(k,1061) = lu(k,1061) - lu(k,313) * lu(k,1045) - lu(k,1062) = lu(k,1062) - lu(k,314) * lu(k,1045) - lu(k,1063) = lu(k,1063) - lu(k,315) * lu(k,1045) - lu(k,1064) = lu(k,1064) - lu(k,316) * lu(k,1045) - lu(k,1066) = lu(k,1066) - lu(k,317) * lu(k,1045) - lu(k,1069) = lu(k,1069) - lu(k,318) * lu(k,1045) - lu(k,1071) = lu(k,1071) - lu(k,319) * lu(k,1045) - lu(k,1073) = lu(k,1073) - lu(k,320) * lu(k,1045) - lu(k,1074) = lu(k,1074) - lu(k,321) * lu(k,1045) - lu(k,1078) = lu(k,1078) - lu(k,322) * lu(k,1045) - lu(k,1082) = lu(k,1082) - lu(k,323) * lu(k,1045) - lu(k,1083) = lu(k,1083) - lu(k,324) * lu(k,1045) - lu(k,1084) = lu(k,1084) - lu(k,325) * lu(k,1045) - lu(k,1180) = lu(k,1180) - lu(k,312) * lu(k,1173) - lu(k,1189) = lu(k,1189) - lu(k,313) * lu(k,1173) - lu(k,1190) = lu(k,1190) - lu(k,314) * lu(k,1173) - lu(k,1191) = lu(k,1191) - lu(k,315) * lu(k,1173) - lu(k,1192) = lu(k,1192) - lu(k,316) * lu(k,1173) - lu(k,1194) = lu(k,1194) - lu(k,317) * lu(k,1173) - lu(k,1197) = lu(k,1197) - lu(k,318) * lu(k,1173) - lu(k,1199) = lu(k,1199) - lu(k,319) * lu(k,1173) - lu(k,1201) = lu(k,1201) - lu(k,320) * lu(k,1173) - lu(k,1202) = lu(k,1202) - lu(k,321) * lu(k,1173) - lu(k,1206) = lu(k,1206) - lu(k,322) * lu(k,1173) - lu(k,1210) = lu(k,1210) - lu(k,323) * lu(k,1173) - lu(k,1211) = lu(k,1211) - lu(k,324) * lu(k,1173) - lu(k,1212) = lu(k,1212) - lu(k,325) * lu(k,1173) - lu(k,1338) = lu(k,1338) - lu(k,312) * lu(k,1331) - lu(k,1348) = lu(k,1348) - lu(k,313) * lu(k,1331) - lu(k,1349) = lu(k,1349) - lu(k,314) * lu(k,1331) - lu(k,1350) = lu(k,1350) - lu(k,315) * lu(k,1331) - lu(k,1351) = lu(k,1351) - lu(k,316) * lu(k,1331) - lu(k,1353) = lu(k,1353) - lu(k,317) * lu(k,1331) - lu(k,1356) = lu(k,1356) - lu(k,318) * lu(k,1331) - lu(k,1358) = lu(k,1358) - lu(k,319) * lu(k,1331) - lu(k,1360) = lu(k,1360) - lu(k,320) * lu(k,1331) - lu(k,1361) = lu(k,1361) - lu(k,321) * lu(k,1331) - lu(k,1365) = lu(k,1365) - lu(k,322) * lu(k,1331) - lu(k,1369) = lu(k,1369) - lu(k,323) * lu(k,1331) - lu(k,1370) = lu(k,1370) - lu(k,324) * lu(k,1331) - lu(k,1371) = lu(k,1371) - lu(k,325) * lu(k,1331) - lu(k,1550) = lu(k,1550) - lu(k,312) * lu(k,1543) - lu(k,1559) = lu(k,1559) - lu(k,313) * lu(k,1543) - lu(k,1560) = lu(k,1560) - lu(k,314) * lu(k,1543) - lu(k,1561) = lu(k,1561) - lu(k,315) * lu(k,1543) - lu(k,1562) = lu(k,1562) - lu(k,316) * lu(k,1543) - lu(k,1564) = lu(k,1564) - lu(k,317) * lu(k,1543) - lu(k,1567) = lu(k,1567) - lu(k,318) * lu(k,1543) - lu(k,1569) = lu(k,1569) - lu(k,319) * lu(k,1543) - lu(k,1571) = lu(k,1571) - lu(k,320) * lu(k,1543) - lu(k,1572) = lu(k,1572) - lu(k,321) * lu(k,1543) - lu(k,1576) = lu(k,1576) - lu(k,322) * lu(k,1543) - lu(k,1580) = lu(k,1580) - lu(k,323) * lu(k,1543) - lu(k,1581) = lu(k,1581) - lu(k,324) * lu(k,1543) - lu(k,1582) = lu(k,1582) - lu(k,325) * lu(k,1543) - lu(k,1792) = lu(k,1792) - lu(k,312) * lu(k,1787) - lu(k,1802) = lu(k,1802) - lu(k,313) * lu(k,1787) - lu(k,1803) = lu(k,1803) - lu(k,314) * lu(k,1787) - lu(k,1804) = lu(k,1804) - lu(k,315) * lu(k,1787) - lu(k,1805) = lu(k,1805) - lu(k,316) * lu(k,1787) - lu(k,1807) = lu(k,1807) - lu(k,317) * lu(k,1787) - lu(k,1810) = lu(k,1810) - lu(k,318) * lu(k,1787) - lu(k,1812) = lu(k,1812) - lu(k,319) * lu(k,1787) - lu(k,1814) = lu(k,1814) - lu(k,320) * lu(k,1787) - lu(k,1815) = lu(k,1815) - lu(k,321) * lu(k,1787) - lu(k,1819) = lu(k,1819) - lu(k,322) * lu(k,1787) - lu(k,1823) = lu(k,1823) - lu(k,323) * lu(k,1787) - lu(k,1824) = lu(k,1824) - lu(k,324) * lu(k,1787) - lu(k,1825) = lu(k,1825) - lu(k,325) * lu(k,1787) - 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,335) = lu(k,335) * lu(k,328) - lu(k,336) = lu(k,336) * lu(k,328) - lu(k,337) = lu(k,337) * lu(k,328) - lu(k,338) = lu(k,338) * lu(k,328) - lu(k,339) = lu(k,339) * lu(k,328) - lu(k,457) = lu(k,457) - lu(k,329) * lu(k,456) - lu(k,458) = - lu(k,330) * lu(k,456) - lu(k,459) = - lu(k,331) * lu(k,456) - lu(k,460) = lu(k,460) - lu(k,332) * lu(k,456) - lu(k,461) = lu(k,461) - lu(k,333) * lu(k,456) - lu(k,462) = lu(k,462) - lu(k,334) * lu(k,456) - lu(k,466) = lu(k,466) - lu(k,335) * lu(k,456) - lu(k,467) = - lu(k,336) * lu(k,456) - lu(k,468) = - lu(k,337) * lu(k,456) - lu(k,472) = - lu(k,338) * lu(k,456) - lu(k,474) = lu(k,474) - lu(k,339) * lu(k,456) - lu(k,540) = lu(k,540) - lu(k,329) * lu(k,538) - lu(k,541) = lu(k,541) - lu(k,330) * lu(k,538) - lu(k,542) = lu(k,542) - lu(k,331) * lu(k,538) - lu(k,543) = lu(k,543) - lu(k,332) * lu(k,538) - lu(k,544) = lu(k,544) - lu(k,333) * lu(k,538) - lu(k,545) = lu(k,545) - lu(k,334) * lu(k,538) - lu(k,550) = - lu(k,335) * lu(k,538) - lu(k,551) = lu(k,551) - lu(k,336) * lu(k,538) - lu(k,552) = - lu(k,337) * lu(k,538) - lu(k,558) = lu(k,558) - lu(k,338) * lu(k,538) - lu(k,560) = lu(k,560) - lu(k,339) * lu(k,538) - lu(k,571) = lu(k,571) - lu(k,329) * lu(k,569) - lu(k,572) = lu(k,572) - lu(k,330) * lu(k,569) - lu(k,573) = lu(k,573) - lu(k,331) * lu(k,569) - lu(k,574) = lu(k,574) - lu(k,332) * lu(k,569) - lu(k,575) = lu(k,575) - lu(k,333) * lu(k,569) - lu(k,577) = lu(k,577) - lu(k,334) * lu(k,569) - lu(k,582) = lu(k,582) - lu(k,335) * lu(k,569) - lu(k,585) = - lu(k,336) * lu(k,569) - lu(k,586) = lu(k,586) - lu(k,337) * lu(k,569) - lu(k,592) = lu(k,592) - lu(k,338) * lu(k,569) - lu(k,594) = lu(k,594) - lu(k,339) * lu(k,569) - lu(k,683) = lu(k,683) - lu(k,329) * lu(k,681) - lu(k,684) = lu(k,684) - lu(k,330) * lu(k,681) - lu(k,685) = lu(k,685) - lu(k,331) * lu(k,681) - lu(k,686) = lu(k,686) - lu(k,332) * lu(k,681) - lu(k,687) = lu(k,687) - lu(k,333) * lu(k,681) - lu(k,689) = lu(k,689) - lu(k,334) * lu(k,681) - lu(k,695) = lu(k,695) - lu(k,335) * lu(k,681) - lu(k,698) = - lu(k,336) * lu(k,681) - lu(k,699) = lu(k,699) - lu(k,337) * lu(k,681) - lu(k,705) = lu(k,705) - lu(k,338) * lu(k,681) - lu(k,707) = lu(k,707) - lu(k,339) * lu(k,681) - lu(k,751) = lu(k,751) - lu(k,329) * lu(k,749) - lu(k,752) = lu(k,752) - lu(k,330) * lu(k,749) - lu(k,753) = lu(k,753) - lu(k,331) * lu(k,749) - lu(k,754) = lu(k,754) - lu(k,332) * lu(k,749) - lu(k,755) = lu(k,755) - lu(k,333) * lu(k,749) - lu(k,758) = lu(k,758) - lu(k,334) * lu(k,749) - lu(k,764) = lu(k,764) - lu(k,335) * lu(k,749) - lu(k,767) = lu(k,767) - lu(k,336) * lu(k,749) - lu(k,768) = lu(k,768) - lu(k,337) * lu(k,749) - lu(k,774) = lu(k,774) - lu(k,338) * lu(k,749) - lu(k,776) = lu(k,776) - lu(k,339) * lu(k,749) - lu(k,966) = lu(k,966) - lu(k,329) * lu(k,963) - lu(k,967) = lu(k,967) - lu(k,330) * lu(k,963) - lu(k,968) = lu(k,968) - lu(k,331) * lu(k,963) - lu(k,972) = lu(k,972) - lu(k,332) * lu(k,963) - lu(k,974) = lu(k,974) - lu(k,333) * lu(k,963) - lu(k,979) = lu(k,979) - lu(k,334) * lu(k,963) - lu(k,986) = lu(k,986) - lu(k,335) * lu(k,963) - lu(k,989) = lu(k,989) - lu(k,336) * lu(k,963) - lu(k,990) = lu(k,990) - lu(k,337) * lu(k,963) - lu(k,997) = lu(k,997) - lu(k,338) * lu(k,963) - lu(k,999) = lu(k,999) - lu(k,339) * lu(k,963) - lu(k,1134) = lu(k,1134) - lu(k,329) * lu(k,1131) - lu(k,1138) = - lu(k,330) * lu(k,1131) - lu(k,1139) = lu(k,1139) - lu(k,331) * lu(k,1131) - lu(k,1142) = lu(k,1142) - lu(k,332) * lu(k,1131) - lu(k,1144) = lu(k,1144) - lu(k,333) * lu(k,1131) - lu(k,1149) = lu(k,1149) - lu(k,334) * lu(k,1131) - lu(k,1156) = lu(k,1156) - lu(k,335) * lu(k,1131) - lu(k,1159) = lu(k,1159) - lu(k,336) * lu(k,1131) - lu(k,1160) = lu(k,1160) - lu(k,337) * lu(k,1131) - lu(k,1167) = lu(k,1167) - lu(k,338) * lu(k,1131) - lu(k,1169) = lu(k,1169) - lu(k,339) * lu(k,1131) - lu(k,1419) = lu(k,1419) - lu(k,329) * lu(k,1417) - lu(k,1420) = - lu(k,330) * lu(k,1417) - lu(k,1421) = lu(k,1421) - lu(k,331) * lu(k,1417) - lu(k,1424) = lu(k,1424) - lu(k,332) * lu(k,1417) - lu(k,1426) = lu(k,1426) - lu(k,333) * lu(k,1417) - lu(k,1431) = lu(k,1431) - lu(k,334) * lu(k,1417) - lu(k,1438) = lu(k,1438) - lu(k,335) * lu(k,1417) - lu(k,1441) = lu(k,1441) - lu(k,336) * lu(k,1417) - lu(k,1442) = lu(k,1442) - lu(k,337) * lu(k,1417) - lu(k,1449) = lu(k,1449) - lu(k,338) * lu(k,1417) - lu(k,1451) = lu(k,1451) - lu(k,339) * lu(k,1417) - lu(k,1463) = lu(k,1463) - lu(k,329) * lu(k,1458) - lu(k,1464) = - lu(k,330) * lu(k,1458) - lu(k,1465) = lu(k,1465) - lu(k,331) * lu(k,1458) - lu(k,1469) = lu(k,1469) - lu(k,332) * lu(k,1458) - lu(k,1471) = lu(k,1471) - lu(k,333) * lu(k,1458) - lu(k,1476) = lu(k,1476) - lu(k,334) * lu(k,1458) - lu(k,1483) = - lu(k,335) * lu(k,1458) - lu(k,1486) = lu(k,1486) - lu(k,336) * lu(k,1458) - lu(k,1487) = - lu(k,337) * lu(k,1458) - lu(k,1494) = lu(k,1494) - lu(k,338) * lu(k,1458) - lu(k,1496) = lu(k,1496) - lu(k,339) * lu(k,1458) - lu(k,1506) = lu(k,1506) - lu(k,329) * lu(k,1505) - lu(k,1507) = lu(k,1507) - lu(k,330) * lu(k,1505) - lu(k,1508) = - lu(k,331) * lu(k,1505) - lu(k,1512) = lu(k,1512) - lu(k,332) * lu(k,1505) - lu(k,1514) = lu(k,1514) - lu(k,333) * lu(k,1505) - lu(k,1519) = lu(k,1519) - lu(k,334) * lu(k,1505) - lu(k,1526) = lu(k,1526) - lu(k,335) * lu(k,1505) - lu(k,1529) = lu(k,1529) - lu(k,336) * lu(k,1505) - lu(k,1530) = - lu(k,337) * lu(k,1505) - lu(k,1537) = lu(k,1537) - lu(k,338) * lu(k,1505) - lu(k,1539) = lu(k,1539) - lu(k,339) * lu(k,1505) - lu(k,1661) = - lu(k,329) * lu(k,1659) - lu(k,1662) = lu(k,1662) - lu(k,330) * lu(k,1659) - lu(k,1663) = - lu(k,331) * lu(k,1659) - lu(k,1667) = lu(k,1667) - lu(k,332) * lu(k,1659) - lu(k,1669) = lu(k,1669) - lu(k,333) * lu(k,1659) - lu(k,1674) = lu(k,1674) - lu(k,334) * lu(k,1659) - lu(k,1681) = lu(k,1681) - lu(k,335) * lu(k,1659) - lu(k,1684) = lu(k,1684) - lu(k,336) * lu(k,1659) - lu(k,1685) = lu(k,1685) - lu(k,337) * lu(k,1659) - lu(k,1692) = lu(k,1692) - lu(k,338) * lu(k,1659) - lu(k,1694) = lu(k,1694) - lu(k,339) * lu(k,1659) - lu(k,1738) = lu(k,1738) - lu(k,329) * lu(k,1735) - lu(k,1741) = lu(k,1741) - lu(k,330) * lu(k,1735) - lu(k,1742) = lu(k,1742) - lu(k,331) * lu(k,1735) - lu(k,1745) = lu(k,1745) - lu(k,332) * lu(k,1735) - lu(k,1747) = lu(k,1747) - lu(k,333) * lu(k,1735) - lu(k,1752) = lu(k,1752) - lu(k,334) * lu(k,1735) - lu(k,1759) = lu(k,1759) - lu(k,335) * lu(k,1735) - lu(k,1762) = lu(k,1762) - lu(k,336) * lu(k,1735) - lu(k,1763) = lu(k,1763) - lu(k,337) * lu(k,1735) - lu(k,1770) = lu(k,1770) - lu(k,338) * lu(k,1735) - lu(k,1772) = lu(k,1772) - lu(k,339) * lu(k,1735) - lu(k,340) = 1._r8 / lu(k,340) - lu(k,341) = lu(k,341) * lu(k,340) - lu(k,342) = lu(k,342) * lu(k,340) - lu(k,343) = lu(k,343) * lu(k,340) - lu(k,344) = lu(k,344) * lu(k,340) - lu(k,345) = lu(k,345) * lu(k,340) - lu(k,346) = lu(k,346) * lu(k,340) - lu(k,347) = lu(k,347) * lu(k,340) - lu(k,348) = lu(k,348) * lu(k,340) - lu(k,349) = lu(k,349) * lu(k,340) - lu(k,350) = lu(k,350) * lu(k,340) - lu(k,351) = lu(k,351) * lu(k,340) - lu(k,352) = lu(k,352) * lu(k,340) - lu(k,353) = lu(k,353) * lu(k,340) - lu(k,354) = lu(k,354) * lu(k,340) - lu(k,357) = lu(k,357) - lu(k,341) * lu(k,355) - lu(k,358) = lu(k,358) - lu(k,342) * lu(k,355) - lu(k,359) = lu(k,359) - lu(k,343) * lu(k,355) - lu(k,360) = lu(k,360) - lu(k,344) * lu(k,355) - lu(k,361) = lu(k,361) - lu(k,345) * lu(k,355) - lu(k,362) = lu(k,362) - lu(k,346) * lu(k,355) - lu(k,363) = lu(k,363) - lu(k,347) * lu(k,355) - lu(k,364) = lu(k,364) - lu(k,348) * lu(k,355) - lu(k,365) = lu(k,365) - lu(k,349) * lu(k,355) - lu(k,366) = lu(k,366) - lu(k,350) * lu(k,355) - lu(k,367) = lu(k,367) - lu(k,351) * lu(k,355) - lu(k,368) = lu(k,368) - lu(k,352) * lu(k,355) - lu(k,369) = lu(k,369) - lu(k,353) * lu(k,355) - lu(k,370) = lu(k,370) - lu(k,354) * lu(k,355) - lu(k,597) = lu(k,597) - lu(k,341) * lu(k,595) - lu(k,600) = lu(k,600) - lu(k,342) * lu(k,595) - lu(k,601) = lu(k,601) - lu(k,343) * lu(k,595) - lu(k,602) = lu(k,602) - lu(k,344) * lu(k,595) - lu(k,604) = lu(k,604) - lu(k,345) * lu(k,595) - lu(k,607) = lu(k,607) - lu(k,346) * lu(k,595) - lu(k,608) = lu(k,608) - lu(k,347) * lu(k,595) - lu(k,609) = lu(k,609) - lu(k,348) * lu(k,595) - lu(k,610) = lu(k,610) - lu(k,349) * lu(k,595) - lu(k,611) = lu(k,611) - lu(k,350) * lu(k,595) - lu(k,612) = lu(k,612) - lu(k,351) * lu(k,595) - lu(k,613) = lu(k,613) - lu(k,352) * lu(k,595) - lu(k,614) = lu(k,614) - lu(k,353) * lu(k,595) - lu(k,615) = lu(k,615) - lu(k,354) * lu(k,595) - lu(k,822) = lu(k,822) - lu(k,341) * lu(k,814) - lu(k,829) = lu(k,829) - lu(k,342) * lu(k,814) - lu(k,830) = lu(k,830) - lu(k,343) * lu(k,814) - lu(k,831) = lu(k,831) - lu(k,344) * lu(k,814) - lu(k,834) = lu(k,834) - lu(k,345) * lu(k,814) - lu(k,837) = lu(k,837) - lu(k,346) * lu(k,814) - lu(k,839) = lu(k,839) - lu(k,347) * lu(k,814) - lu(k,841) = lu(k,841) - lu(k,348) * lu(k,814) - lu(k,844) = lu(k,844) - lu(k,349) * lu(k,814) - lu(k,846) = lu(k,846) - lu(k,350) * lu(k,814) - lu(k,849) = lu(k,849) - lu(k,351) * lu(k,814) - lu(k,850) = lu(k,850) - lu(k,352) * lu(k,814) - lu(k,851) = lu(k,851) - lu(k,353) * lu(k,814) - lu(k,852) = lu(k,852) - lu(k,354) * lu(k,814) - lu(k,870) = lu(k,870) - lu(k,341) * lu(k,861) - lu(k,877) = lu(k,877) - lu(k,342) * lu(k,861) - lu(k,878) = lu(k,878) - lu(k,343) * lu(k,861) - lu(k,879) = lu(k,879) - lu(k,344) * lu(k,861) - lu(k,882) = lu(k,882) - lu(k,345) * lu(k,861) - lu(k,885) = lu(k,885) - lu(k,346) * lu(k,861) - lu(k,887) = lu(k,887) - lu(k,347) * lu(k,861) - lu(k,889) = lu(k,889) - lu(k,348) * lu(k,861) - lu(k,892) = lu(k,892) - lu(k,349) * lu(k,861) - lu(k,894) = lu(k,894) - lu(k,350) * lu(k,861) - lu(k,897) = lu(k,897) - lu(k,351) * lu(k,861) - lu(k,898) = lu(k,898) - lu(k,352) * lu(k,861) - lu(k,899) = lu(k,899) - lu(k,353) * lu(k,861) - lu(k,900) = lu(k,900) - lu(k,354) * lu(k,861) - lu(k,913) = lu(k,913) - lu(k,341) * lu(k,905) - lu(k,920) = lu(k,920) - lu(k,342) * lu(k,905) - lu(k,921) = lu(k,921) - lu(k,343) * lu(k,905) - lu(k,922) = lu(k,922) - lu(k,344) * lu(k,905) - lu(k,925) = lu(k,925) - lu(k,345) * lu(k,905) - lu(k,928) = lu(k,928) - lu(k,346) * lu(k,905) - lu(k,930) = lu(k,930) - lu(k,347) * lu(k,905) - lu(k,932) = lu(k,932) - lu(k,348) * lu(k,905) - lu(k,935) = lu(k,935) - lu(k,349) * lu(k,905) - lu(k,937) = lu(k,937) - lu(k,350) * lu(k,905) - lu(k,940) = lu(k,940) - lu(k,351) * lu(k,905) - lu(k,941) = lu(k,941) - lu(k,352) * lu(k,905) - lu(k,942) = lu(k,942) - lu(k,353) * lu(k,905) - lu(k,943) = lu(k,943) - lu(k,354) * lu(k,905) - lu(k,1054) = lu(k,1054) - lu(k,341) * lu(k,1046) - lu(k,1061) = lu(k,1061) - lu(k,342) * lu(k,1046) - lu(k,1062) = lu(k,1062) - lu(k,343) * lu(k,1046) - lu(k,1063) = lu(k,1063) - lu(k,344) * lu(k,1046) - lu(k,1066) = lu(k,1066) - lu(k,345) * lu(k,1046) - lu(k,1069) = lu(k,1069) - lu(k,346) * lu(k,1046) - lu(k,1071) = lu(k,1071) - lu(k,347) * lu(k,1046) - lu(k,1073) = lu(k,1073) - lu(k,348) * lu(k,1046) - lu(k,1076) = lu(k,1076) - lu(k,349) * lu(k,1046) - lu(k,1078) = lu(k,1078) - lu(k,350) * lu(k,1046) - lu(k,1081) = lu(k,1081) - lu(k,351) * lu(k,1046) - lu(k,1082) = lu(k,1082) - lu(k,352) * lu(k,1046) - lu(k,1083) = lu(k,1083) - lu(k,353) * lu(k,1046) - lu(k,1084) = lu(k,1084) - lu(k,354) * lu(k,1046) - lu(k,1182) = lu(k,1182) - lu(k,341) * lu(k,1174) - lu(k,1189) = lu(k,1189) - lu(k,342) * lu(k,1174) - lu(k,1190) = lu(k,1190) - lu(k,343) * lu(k,1174) - lu(k,1191) = lu(k,1191) - lu(k,344) * lu(k,1174) - lu(k,1194) = lu(k,1194) - lu(k,345) * lu(k,1174) - lu(k,1197) = lu(k,1197) - lu(k,346) * lu(k,1174) - lu(k,1199) = lu(k,1199) - lu(k,347) * lu(k,1174) - lu(k,1201) = lu(k,1201) - lu(k,348) * lu(k,1174) - lu(k,1204) = lu(k,1204) - lu(k,349) * lu(k,1174) - lu(k,1206) = lu(k,1206) - lu(k,350) * lu(k,1174) - lu(k,1209) = lu(k,1209) - lu(k,351) * lu(k,1174) - lu(k,1210) = lu(k,1210) - lu(k,352) * lu(k,1174) - lu(k,1211) = lu(k,1211) - lu(k,353) * lu(k,1174) - lu(k,1212) = lu(k,1212) - lu(k,354) * lu(k,1174) - lu(k,1341) = lu(k,1341) - lu(k,341) * lu(k,1332) - lu(k,1348) = lu(k,1348) - lu(k,342) * lu(k,1332) - lu(k,1349) = lu(k,1349) - lu(k,343) * lu(k,1332) - lu(k,1350) = lu(k,1350) - lu(k,344) * lu(k,1332) - lu(k,1353) = lu(k,1353) - lu(k,345) * lu(k,1332) - lu(k,1356) = lu(k,1356) - lu(k,346) * lu(k,1332) - lu(k,1358) = lu(k,1358) - lu(k,347) * lu(k,1332) - lu(k,1360) = lu(k,1360) - lu(k,348) * lu(k,1332) - lu(k,1363) = lu(k,1363) - lu(k,349) * lu(k,1332) - lu(k,1365) = lu(k,1365) - lu(k,350) * lu(k,1332) - lu(k,1368) = lu(k,1368) - lu(k,351) * lu(k,1332) - lu(k,1369) = lu(k,1369) - lu(k,352) * lu(k,1332) - lu(k,1370) = lu(k,1370) - lu(k,353) * lu(k,1332) - lu(k,1371) = lu(k,1371) - lu(k,354) * lu(k,1332) - lu(k,1466) = lu(k,1466) - lu(k,341) * lu(k,1459) - lu(k,1473) = - lu(k,342) * lu(k,1459) - lu(k,1474) = - lu(k,343) * lu(k,1459) - lu(k,1475) = - lu(k,344) * lu(k,1459) - lu(k,1478) = - lu(k,345) * lu(k,1459) - lu(k,1481) = - lu(k,346) * lu(k,1459) - lu(k,1483) = lu(k,1483) - lu(k,347) * lu(k,1459) - lu(k,1485) = - lu(k,348) * lu(k,1459) - lu(k,1488) = lu(k,1488) - lu(k,349) * lu(k,1459) - lu(k,1490) = - lu(k,350) * lu(k,1459) - lu(k,1493) = lu(k,1493) - lu(k,351) * lu(k,1459) - lu(k,1494) = lu(k,1494) - lu(k,352) * lu(k,1459) - lu(k,1495) = lu(k,1495) - lu(k,353) * lu(k,1459) - lu(k,1496) = lu(k,1496) - lu(k,354) * lu(k,1459) - lu(k,1552) = lu(k,1552) - lu(k,341) * lu(k,1544) - lu(k,1559) = lu(k,1559) - lu(k,342) * lu(k,1544) - lu(k,1560) = lu(k,1560) - lu(k,343) * lu(k,1544) - lu(k,1561) = lu(k,1561) - lu(k,344) * lu(k,1544) - lu(k,1564) = lu(k,1564) - lu(k,345) * lu(k,1544) - lu(k,1567) = lu(k,1567) - lu(k,346) * lu(k,1544) - lu(k,1569) = lu(k,1569) - lu(k,347) * lu(k,1544) - lu(k,1571) = lu(k,1571) - lu(k,348) * lu(k,1544) - lu(k,1574) = lu(k,1574) - lu(k,349) * lu(k,1544) - lu(k,1576) = lu(k,1576) - lu(k,350) * lu(k,1544) - lu(k,1579) = lu(k,1579) - lu(k,351) * lu(k,1544) - lu(k,1580) = lu(k,1580) - lu(k,352) * lu(k,1544) - lu(k,1581) = lu(k,1581) - lu(k,353) * lu(k,1544) - lu(k,1582) = lu(k,1582) - lu(k,354) * lu(k,1544) - end do + real(r8), intent(inout) :: lu(:) + lu(331) = 1._r8 / lu(331) + lu(332) = lu(332) * lu(331) + lu(333) = lu(333) * lu(331) + lu(334) = lu(334) * lu(331) + lu(335) = lu(335) * lu(331) + lu(336) = lu(336) * lu(331) + lu(337) = lu(337) * lu(331) + lu(338) = lu(338) * lu(331) + lu(339) = lu(339) * lu(331) + lu(340) = lu(340) * lu(331) + lu(341) = lu(341) * lu(331) + lu(342) = lu(342) * lu(331) + lu(343) = lu(343) * lu(331) + lu(344) = lu(344) * lu(331) + lu(345) = lu(345) * lu(331) + lu(348) = lu(348) - lu(332) * lu(346) + lu(349) = lu(349) - lu(333) * lu(346) + lu(350) = lu(350) - lu(334) * lu(346) + lu(351) = lu(351) - lu(335) * lu(346) + lu(352) = lu(352) - lu(336) * lu(346) + lu(353) = lu(353) - lu(337) * lu(346) + lu(354) = lu(354) - lu(338) * lu(346) + lu(355) = lu(355) - lu(339) * lu(346) + lu(356) = lu(356) - lu(340) * lu(346) + lu(357) = lu(357) - lu(341) * lu(346) + lu(358) = lu(358) - lu(342) * lu(346) + lu(359) = lu(359) - lu(343) * lu(346) + lu(360) = lu(360) - lu(344) * lu(346) + lu(361) = lu(361) - lu(345) * lu(346) + lu(613) = lu(613) - lu(332) * lu(611) + lu(616) = lu(616) - lu(333) * lu(611) + lu(617) = lu(617) - lu(334) * lu(611) + lu(618) = lu(618) - lu(335) * lu(611) + lu(619) = lu(619) - lu(336) * lu(611) + lu(620) = lu(620) - lu(337) * lu(611) + lu(621) = lu(621) - lu(338) * lu(611) + lu(623) = lu(623) - lu(339) * lu(611) + lu(624) = lu(624) - lu(340) * lu(611) + lu(625) = lu(625) - lu(341) * lu(611) + lu(626) = lu(626) - lu(342) * lu(611) + lu(627) = lu(627) - lu(343) * lu(611) + lu(629) = lu(629) - lu(344) * lu(611) + lu(631) = lu(631) - lu(345) * lu(611) + lu(811) = lu(811) - lu(332) * lu(801) + lu(817) = lu(817) - lu(333) * lu(801) + lu(818) = lu(818) - lu(334) * lu(801) + lu(819) = lu(819) - lu(335) * lu(801) + lu(820) = lu(820) - lu(336) * lu(801) + lu(821) = lu(821) - lu(337) * lu(801) + lu(822) = lu(822) - lu(338) * lu(801) + lu(825) = lu(825) - lu(339) * lu(801) + lu(826) = lu(826) - lu(340) * lu(801) + lu(828) = lu(828) - lu(341) * lu(801) + lu(829) = lu(829) - lu(342) * lu(801) + lu(830) = lu(830) - lu(343) * lu(801) + lu(832) = lu(832) - lu(344) * lu(801) + lu(839) = lu(839) - lu(345) * lu(801) + lu(853) = lu(853) - lu(332) * lu(844) + lu(859) = lu(859) - lu(333) * lu(844) + lu(860) = lu(860) - lu(334) * lu(844) + lu(861) = lu(861) - lu(335) * lu(844) + lu(862) = lu(862) - lu(336) * lu(844) + lu(863) = lu(863) - lu(337) * lu(844) + lu(864) = lu(864) - lu(338) * lu(844) + lu(867) = lu(867) - lu(339) * lu(844) + lu(868) = lu(868) - lu(340) * lu(844) + lu(870) = lu(870) - lu(341) * lu(844) + lu(871) = lu(871) - lu(342) * lu(844) + lu(872) = lu(872) - lu(343) * lu(844) + lu(874) = lu(874) - lu(344) * lu(844) + lu(881) = lu(881) - lu(345) * lu(844) + lu(897) = lu(897) - lu(332) * lu(889) + lu(903) = - lu(333) * lu(889) + lu(904) = - lu(334) * lu(889) + lu(905) = lu(905) - lu(335) * lu(889) + lu(906) = lu(906) - lu(336) * lu(889) + lu(907) = - lu(337) * lu(889) + lu(908) = - lu(338) * lu(889) + lu(911) = lu(911) - lu(339) * lu(889) + lu(912) = lu(912) - lu(340) * lu(889) + lu(914) = - lu(341) * lu(889) + lu(915) = lu(915) - lu(342) * lu(889) + lu(916) = - lu(343) * lu(889) + lu(918) = - lu(344) * lu(889) + lu(925) = lu(925) - lu(345) * lu(889) + lu(973) = lu(973) - lu(332) * lu(964) + lu(979) = lu(979) - lu(333) * lu(964) + lu(980) = lu(980) - lu(334) * lu(964) + lu(981) = lu(981) - lu(335) * lu(964) + lu(982) = lu(982) - lu(336) * lu(964) + lu(983) = lu(983) - lu(337) * lu(964) + lu(984) = lu(984) - lu(338) * lu(964) + lu(987) = lu(987) - lu(339) * lu(964) + lu(988) = lu(988) - lu(340) * lu(964) + lu(990) = lu(990) - lu(341) * lu(964) + lu(991) = lu(991) - lu(342) * lu(964) + lu(992) = lu(992) - lu(343) * lu(964) + lu(994) = lu(994) - lu(344) * lu(964) + lu(1001) = lu(1001) - lu(345) * lu(964) + lu(1015) = lu(1015) - lu(332) * lu(1006) + lu(1021) = lu(1021) - lu(333) * lu(1006) + lu(1022) = lu(1022) - lu(334) * lu(1006) + lu(1023) = lu(1023) - lu(335) * lu(1006) + lu(1024) = lu(1024) - lu(336) * lu(1006) + lu(1025) = lu(1025) - lu(337) * lu(1006) + lu(1026) = lu(1026) - lu(338) * lu(1006) + lu(1029) = lu(1029) - lu(339) * lu(1006) + lu(1030) = lu(1030) - lu(340) * lu(1006) + lu(1032) = lu(1032) - lu(341) * lu(1006) + lu(1033) = lu(1033) - lu(342) * lu(1006) + lu(1034) = lu(1034) - lu(343) * lu(1006) + lu(1036) = lu(1036) - lu(344) * lu(1006) + lu(1043) = lu(1043) - lu(345) * lu(1006) + lu(1265) = lu(1265) - lu(332) * lu(1255) + lu(1271) = lu(1271) - lu(333) * lu(1255) + lu(1272) = lu(1272) - lu(334) * lu(1255) + lu(1273) = lu(1273) - lu(335) * lu(1255) + lu(1274) = lu(1274) - lu(336) * lu(1255) + lu(1275) = lu(1275) - lu(337) * lu(1255) + lu(1276) = lu(1276) - lu(338) * lu(1255) + lu(1279) = lu(1279) - lu(339) * lu(1255) + lu(1280) = lu(1280) - lu(340) * lu(1255) + lu(1282) = lu(1282) - lu(341) * lu(1255) + lu(1283) = lu(1283) - lu(342) * lu(1255) + lu(1284) = lu(1284) - lu(343) * lu(1255) + lu(1286) = lu(1286) - lu(344) * lu(1255) + lu(1293) = lu(1293) - lu(345) * lu(1255) + lu(1348) = lu(1348) - lu(332) * lu(1339) + lu(1354) = lu(1354) - lu(333) * lu(1339) + lu(1355) = lu(1355) - lu(334) * lu(1339) + lu(1356) = lu(1356) - lu(335) * lu(1339) + lu(1357) = lu(1357) - lu(336) * lu(1339) + lu(1358) = lu(1358) - lu(337) * lu(1339) + lu(1359) = lu(1359) - lu(338) * lu(1339) + lu(1362) = lu(1362) - lu(339) * lu(1339) + lu(1363) = lu(1363) - lu(340) * lu(1339) + lu(1365) = lu(1365) - lu(341) * lu(1339) + lu(1366) = lu(1366) - lu(342) * lu(1339) + lu(1367) = lu(1367) - lu(343) * lu(1339) + lu(1369) = lu(1369) - lu(344) * lu(1339) + lu(1376) = lu(1376) - lu(345) * lu(1339) + lu(1432) = lu(1432) - lu(332) * lu(1423) + lu(1438) = lu(1438) - lu(333) * lu(1423) + lu(1439) = lu(1439) - lu(334) * lu(1423) + lu(1440) = lu(1440) - lu(335) * lu(1423) + lu(1441) = lu(1441) - lu(336) * lu(1423) + lu(1442) = lu(1442) - lu(337) * lu(1423) + lu(1443) = lu(1443) - lu(338) * lu(1423) + lu(1446) = lu(1446) - lu(339) * lu(1423) + lu(1447) = lu(1447) - lu(340) * lu(1423) + lu(1449) = lu(1449) - lu(341) * lu(1423) + lu(1450) = lu(1450) - lu(342) * lu(1423) + lu(1451) = lu(1451) - lu(343) * lu(1423) + lu(1453) = lu(1453) - lu(344) * lu(1423) + lu(1460) = lu(1460) - lu(345) * lu(1423) + lu(347) = 1._r8 / lu(347) + lu(348) = lu(348) * lu(347) + lu(349) = lu(349) * lu(347) + lu(350) = lu(350) * lu(347) + lu(351) = lu(351) * lu(347) + lu(352) = lu(352) * lu(347) + lu(353) = lu(353) * lu(347) + lu(354) = lu(354) * lu(347) + lu(355) = lu(355) * lu(347) + lu(356) = lu(356) * lu(347) + lu(357) = lu(357) * lu(347) + lu(358) = lu(358) * lu(347) + lu(359) = lu(359) * lu(347) + lu(360) = lu(360) * lu(347) + lu(361) = lu(361) * lu(347) + lu(613) = lu(613) - lu(348) * lu(612) + lu(616) = lu(616) - lu(349) * lu(612) + lu(617) = lu(617) - lu(350) * lu(612) + lu(618) = lu(618) - lu(351) * lu(612) + lu(619) = lu(619) - lu(352) * lu(612) + lu(620) = lu(620) - lu(353) * lu(612) + lu(621) = lu(621) - lu(354) * lu(612) + lu(623) = lu(623) - lu(355) * lu(612) + lu(624) = lu(624) - lu(356) * lu(612) + lu(625) = lu(625) - lu(357) * lu(612) + lu(626) = lu(626) - lu(358) * lu(612) + lu(627) = lu(627) - lu(359) * lu(612) + lu(629) = lu(629) - lu(360) * lu(612) + lu(631) = lu(631) - lu(361) * lu(612) + lu(811) = lu(811) - lu(348) * lu(802) + lu(817) = lu(817) - lu(349) * lu(802) + lu(818) = lu(818) - lu(350) * lu(802) + lu(819) = lu(819) - lu(351) * lu(802) + lu(820) = lu(820) - lu(352) * lu(802) + lu(821) = lu(821) - lu(353) * lu(802) + lu(822) = lu(822) - lu(354) * lu(802) + lu(825) = lu(825) - lu(355) * lu(802) + lu(826) = lu(826) - lu(356) * lu(802) + lu(828) = lu(828) - lu(357) * lu(802) + lu(829) = lu(829) - lu(358) * lu(802) + lu(830) = lu(830) - lu(359) * lu(802) + lu(832) = lu(832) - lu(360) * lu(802) + lu(839) = lu(839) - lu(361) * lu(802) + lu(853) = lu(853) - lu(348) * lu(845) + lu(859) = lu(859) - lu(349) * lu(845) + lu(860) = lu(860) - lu(350) * lu(845) + lu(861) = lu(861) - lu(351) * lu(845) + lu(862) = lu(862) - lu(352) * lu(845) + lu(863) = lu(863) - lu(353) * lu(845) + lu(864) = lu(864) - lu(354) * lu(845) + lu(867) = lu(867) - lu(355) * lu(845) + lu(868) = lu(868) - lu(356) * lu(845) + lu(870) = lu(870) - lu(357) * lu(845) + lu(871) = lu(871) - lu(358) * lu(845) + lu(872) = lu(872) - lu(359) * lu(845) + lu(874) = lu(874) - lu(360) * lu(845) + lu(881) = lu(881) - lu(361) * lu(845) + lu(897) = lu(897) - lu(348) * lu(890) + lu(903) = lu(903) - lu(349) * lu(890) + lu(904) = lu(904) - lu(350) * lu(890) + lu(905) = lu(905) - lu(351) * lu(890) + lu(906) = lu(906) - lu(352) * lu(890) + lu(907) = lu(907) - lu(353) * lu(890) + lu(908) = lu(908) - lu(354) * lu(890) + lu(911) = lu(911) - lu(355) * lu(890) + lu(912) = lu(912) - lu(356) * lu(890) + lu(914) = lu(914) - lu(357) * lu(890) + lu(915) = lu(915) - lu(358) * lu(890) + lu(916) = lu(916) - lu(359) * lu(890) + lu(918) = lu(918) - lu(360) * lu(890) + lu(925) = lu(925) - lu(361) * lu(890) + lu(973) = lu(973) - lu(348) * lu(965) + lu(979) = lu(979) - lu(349) * lu(965) + lu(980) = lu(980) - lu(350) * lu(965) + lu(981) = lu(981) - lu(351) * lu(965) + lu(982) = lu(982) - lu(352) * lu(965) + lu(983) = lu(983) - lu(353) * lu(965) + lu(984) = lu(984) - lu(354) * lu(965) + lu(987) = lu(987) - lu(355) * lu(965) + lu(988) = lu(988) - lu(356) * lu(965) + lu(990) = lu(990) - lu(357) * lu(965) + lu(991) = lu(991) - lu(358) * lu(965) + lu(992) = lu(992) - lu(359) * lu(965) + lu(994) = lu(994) - lu(360) * lu(965) + lu(1001) = lu(1001) - lu(361) * lu(965) + lu(1015) = lu(1015) - lu(348) * lu(1007) + lu(1021) = lu(1021) - lu(349) * lu(1007) + lu(1022) = lu(1022) - lu(350) * lu(1007) + lu(1023) = lu(1023) - lu(351) * lu(1007) + lu(1024) = lu(1024) - lu(352) * lu(1007) + lu(1025) = lu(1025) - lu(353) * lu(1007) + lu(1026) = lu(1026) - lu(354) * lu(1007) + lu(1029) = lu(1029) - lu(355) * lu(1007) + lu(1030) = lu(1030) - lu(356) * lu(1007) + lu(1032) = lu(1032) - lu(357) * lu(1007) + lu(1033) = lu(1033) - lu(358) * lu(1007) + lu(1034) = lu(1034) - lu(359) * lu(1007) + lu(1036) = lu(1036) - lu(360) * lu(1007) + lu(1043) = lu(1043) - lu(361) * lu(1007) + lu(1265) = lu(1265) - lu(348) * lu(1256) + lu(1271) = lu(1271) - lu(349) * lu(1256) + lu(1272) = lu(1272) - lu(350) * lu(1256) + lu(1273) = lu(1273) - lu(351) * lu(1256) + lu(1274) = lu(1274) - lu(352) * lu(1256) + lu(1275) = lu(1275) - lu(353) * lu(1256) + lu(1276) = lu(1276) - lu(354) * lu(1256) + lu(1279) = lu(1279) - lu(355) * lu(1256) + lu(1280) = lu(1280) - lu(356) * lu(1256) + lu(1282) = lu(1282) - lu(357) * lu(1256) + lu(1283) = lu(1283) - lu(358) * lu(1256) + lu(1284) = lu(1284) - lu(359) * lu(1256) + lu(1286) = lu(1286) - lu(360) * lu(1256) + lu(1293) = lu(1293) - lu(361) * lu(1256) + lu(1348) = lu(1348) - lu(348) * lu(1340) + lu(1354) = lu(1354) - lu(349) * lu(1340) + lu(1355) = lu(1355) - lu(350) * lu(1340) + lu(1356) = lu(1356) - lu(351) * lu(1340) + lu(1357) = lu(1357) - lu(352) * lu(1340) + lu(1358) = lu(1358) - lu(353) * lu(1340) + lu(1359) = lu(1359) - lu(354) * lu(1340) + lu(1362) = lu(1362) - lu(355) * lu(1340) + lu(1363) = lu(1363) - lu(356) * lu(1340) + lu(1365) = lu(1365) - lu(357) * lu(1340) + lu(1366) = lu(1366) - lu(358) * lu(1340) + lu(1367) = lu(1367) - lu(359) * lu(1340) + lu(1369) = lu(1369) - lu(360) * lu(1340) + lu(1376) = lu(1376) - lu(361) * lu(1340) + lu(1432) = lu(1432) - lu(348) * lu(1424) + lu(1438) = lu(1438) - lu(349) * lu(1424) + lu(1439) = lu(1439) - lu(350) * lu(1424) + lu(1440) = lu(1440) - lu(351) * lu(1424) + lu(1441) = lu(1441) - lu(352) * lu(1424) + lu(1442) = lu(1442) - lu(353) * lu(1424) + lu(1443) = lu(1443) - lu(354) * lu(1424) + lu(1446) = lu(1446) - lu(355) * lu(1424) + lu(1447) = lu(1447) - lu(356) * lu(1424) + lu(1449) = lu(1449) - lu(357) * lu(1424) + lu(1450) = lu(1450) - lu(358) * lu(1424) + lu(1451) = lu(1451) - lu(359) * lu(1424) + lu(1453) = lu(1453) - lu(360) * lu(1424) + lu(1460) = lu(1460) - lu(361) * lu(1424) + lu(1717) = lu(1717) - lu(348) * lu(1709) + lu(1723) = lu(1723) - lu(349) * lu(1709) + lu(1724) = lu(1724) - lu(350) * lu(1709) + lu(1725) = - lu(351) * lu(1709) + lu(1726) = lu(1726) - lu(352) * lu(1709) + lu(1727) = lu(1727) - lu(353) * lu(1709) + lu(1728) = lu(1728) - lu(354) * lu(1709) + lu(1731) = lu(1731) - lu(355) * lu(1709) + lu(1732) = lu(1732) - lu(356) * lu(1709) + lu(1734) = lu(1734) - lu(357) * lu(1709) + lu(1735) = lu(1735) - lu(358) * lu(1709) + lu(1736) = lu(1736) - lu(359) * lu(1709) + lu(1738) = lu(1738) - lu(360) * lu(1709) + lu(1745) = lu(1745) - lu(361) * lu(1709) + lu(362) = 1._r8 / lu(362) + lu(363) = lu(363) * lu(362) + lu(364) = lu(364) * lu(362) + lu(365) = lu(365) * lu(362) + lu(366) = lu(366) * lu(362) + lu(367) = lu(367) * lu(362) + lu(368) = lu(368) * lu(362) + lu(369) = lu(369) * lu(362) + lu(370) = lu(370) * lu(362) + lu(371) = lu(371) * lu(362) + lu(372) = lu(372) * lu(362) + lu(373) = lu(373) * lu(362) + lu(374) = lu(374) * lu(362) + lu(375) = lu(375) * lu(362) + lu(490) = lu(490) - lu(363) * lu(485) + lu(491) = lu(491) - lu(364) * lu(485) + lu(492) = lu(492) - lu(365) * lu(485) + lu(493) = lu(493) - lu(366) * lu(485) + lu(494) = lu(494) - lu(367) * lu(485) + lu(495) = lu(495) - lu(368) * lu(485) + lu(496) = lu(496) - lu(369) * lu(485) + lu(497) = lu(497) - lu(370) * lu(485) + lu(498) = lu(498) - lu(371) * lu(485) + lu(499) = lu(499) - lu(372) * lu(485) + lu(500) = lu(500) - lu(373) * lu(485) + lu(501) = lu(501) - lu(374) * lu(485) + lu(503) = lu(503) - lu(375) * lu(485) + lu(769) = lu(769) - lu(363) * lu(765) + lu(770) = lu(770) - lu(364) * lu(765) + lu(771) = lu(771) - lu(365) * lu(765) + lu(773) = lu(773) - lu(366) * lu(765) + lu(774) = lu(774) - lu(367) * lu(765) + lu(775) = lu(775) - lu(368) * lu(765) + lu(776) = lu(776) - lu(369) * lu(765) + lu(778) = lu(778) - lu(370) * lu(765) + lu(781) = lu(781) - lu(371) * lu(765) + lu(782) = lu(782) - lu(372) * lu(765) + lu(783) = lu(783) - lu(373) * lu(765) + lu(785) = lu(785) - lu(374) * lu(765) + lu(792) = lu(792) - lu(375) * lu(765) + lu(816) = lu(816) - lu(363) * lu(803) + lu(817) = lu(817) - lu(364) * lu(803) + lu(818) = lu(818) - lu(365) * lu(803) + lu(820) = lu(820) - lu(366) * lu(803) + lu(821) = lu(821) - lu(367) * lu(803) + lu(822) = lu(822) - lu(368) * lu(803) + lu(823) = lu(823) - lu(369) * lu(803) + lu(825) = lu(825) - lu(370) * lu(803) + lu(828) = lu(828) - lu(371) * lu(803) + lu(829) = lu(829) - lu(372) * lu(803) + lu(830) = lu(830) - lu(373) * lu(803) + lu(832) = lu(832) - lu(374) * lu(803) + lu(839) = lu(839) - lu(375) * lu(803) + lu(858) = lu(858) - lu(363) * lu(846) + lu(859) = lu(859) - lu(364) * lu(846) + lu(860) = lu(860) - lu(365) * lu(846) + lu(862) = lu(862) - lu(366) * lu(846) + lu(863) = lu(863) - lu(367) * lu(846) + lu(864) = lu(864) - lu(368) * lu(846) + lu(865) = lu(865) - lu(369) * lu(846) + lu(867) = lu(867) - lu(370) * lu(846) + lu(870) = lu(870) - lu(371) * lu(846) + lu(871) = lu(871) - lu(372) * lu(846) + lu(872) = lu(872) - lu(373) * lu(846) + lu(874) = lu(874) - lu(374) * lu(846) + lu(881) = lu(881) - lu(375) * lu(846) + lu(978) = lu(978) - lu(363) * lu(966) + lu(979) = lu(979) - lu(364) * lu(966) + lu(980) = lu(980) - lu(365) * lu(966) + lu(982) = lu(982) - lu(366) * lu(966) + lu(983) = lu(983) - lu(367) * lu(966) + lu(984) = lu(984) - lu(368) * lu(966) + lu(985) = lu(985) - lu(369) * lu(966) + lu(987) = lu(987) - lu(370) * lu(966) + lu(990) = lu(990) - lu(371) * lu(966) + lu(991) = lu(991) - lu(372) * lu(966) + lu(992) = lu(992) - lu(373) * lu(966) + lu(994) = lu(994) - lu(374) * lu(966) + lu(1001) = lu(1001) - lu(375) * lu(966) + lu(1020) = lu(1020) - lu(363) * lu(1008) + lu(1021) = lu(1021) - lu(364) * lu(1008) + lu(1022) = lu(1022) - lu(365) * lu(1008) + lu(1024) = lu(1024) - lu(366) * lu(1008) + lu(1025) = lu(1025) - lu(367) * lu(1008) + lu(1026) = lu(1026) - lu(368) * lu(1008) + lu(1027) = lu(1027) - lu(369) * lu(1008) + lu(1029) = lu(1029) - lu(370) * lu(1008) + lu(1032) = lu(1032) - lu(371) * lu(1008) + lu(1033) = lu(1033) - lu(372) * lu(1008) + lu(1034) = lu(1034) - lu(373) * lu(1008) + lu(1036) = lu(1036) - lu(374) * lu(1008) + lu(1043) = lu(1043) - lu(375) * lu(1008) + lu(1270) = lu(1270) - lu(363) * lu(1257) + lu(1271) = lu(1271) - lu(364) * lu(1257) + lu(1272) = lu(1272) - lu(365) * lu(1257) + lu(1274) = lu(1274) - lu(366) * lu(1257) + lu(1275) = lu(1275) - lu(367) * lu(1257) + lu(1276) = lu(1276) - lu(368) * lu(1257) + lu(1277) = lu(1277) - lu(369) * lu(1257) + lu(1279) = lu(1279) - lu(370) * lu(1257) + lu(1282) = lu(1282) - lu(371) * lu(1257) + lu(1283) = lu(1283) - lu(372) * lu(1257) + lu(1284) = lu(1284) - lu(373) * lu(1257) + lu(1286) = lu(1286) - lu(374) * lu(1257) + lu(1293) = lu(1293) - lu(375) * lu(1257) + lu(1311) = lu(1311) - lu(363) * lu(1299) + lu(1312) = lu(1312) - lu(364) * lu(1299) + lu(1313) = - lu(365) * lu(1299) + lu(1315) = lu(1315) - lu(366) * lu(1299) + lu(1316) = - lu(367) * lu(1299) + lu(1317) = - lu(368) * lu(1299) + lu(1318) = lu(1318) - lu(369) * lu(1299) + lu(1320) = lu(1320) - lu(370) * lu(1299) + lu(1323) = lu(1323) - lu(371) * lu(1299) + lu(1324) = lu(1324) - lu(372) * lu(1299) + lu(1325) = - lu(373) * lu(1299) + lu(1327) = - lu(374) * lu(1299) + lu(1334) = lu(1334) - lu(375) * lu(1299) + lu(1353) = lu(1353) - lu(363) * lu(1341) + lu(1354) = lu(1354) - lu(364) * lu(1341) + lu(1355) = lu(1355) - lu(365) * lu(1341) + lu(1357) = lu(1357) - lu(366) * lu(1341) + lu(1358) = lu(1358) - lu(367) * lu(1341) + lu(1359) = lu(1359) - lu(368) * lu(1341) + lu(1360) = lu(1360) - lu(369) * lu(1341) + lu(1362) = lu(1362) - lu(370) * lu(1341) + lu(1365) = lu(1365) - lu(371) * lu(1341) + lu(1366) = lu(1366) - lu(372) * lu(1341) + lu(1367) = lu(1367) - lu(373) * lu(1341) + lu(1369) = lu(1369) - lu(374) * lu(1341) + lu(1376) = lu(1376) - lu(375) * lu(1341) + lu(1437) = lu(1437) - lu(363) * lu(1425) + lu(1438) = lu(1438) - lu(364) * lu(1425) + lu(1439) = lu(1439) - lu(365) * lu(1425) + lu(1441) = lu(1441) - lu(366) * lu(1425) + lu(1442) = lu(1442) - lu(367) * lu(1425) + lu(1443) = lu(1443) - lu(368) * lu(1425) + lu(1444) = lu(1444) - lu(369) * lu(1425) + lu(1446) = lu(1446) - lu(370) * lu(1425) + lu(1449) = lu(1449) - lu(371) * lu(1425) + lu(1450) = lu(1450) - lu(372) * lu(1425) + lu(1451) = lu(1451) - lu(373) * lu(1425) + lu(1453) = lu(1453) - lu(374) * lu(1425) + lu(1460) = lu(1460) - lu(375) * lu(1425) + lu(1722) = lu(1722) - lu(363) * lu(1710) + lu(1723) = lu(1723) - lu(364) * lu(1710) + lu(1724) = lu(1724) - lu(365) * lu(1710) + lu(1726) = lu(1726) - lu(366) * lu(1710) + lu(1727) = lu(1727) - lu(367) * lu(1710) + lu(1728) = lu(1728) - lu(368) * lu(1710) + lu(1729) = lu(1729) - lu(369) * lu(1710) + lu(1731) = lu(1731) - lu(370) * lu(1710) + lu(1734) = lu(1734) - lu(371) * lu(1710) + lu(1735) = lu(1735) - lu(372) * lu(1710) + lu(1736) = lu(1736) - lu(373) * lu(1710) + lu(1738) = lu(1738) - lu(374) * lu(1710) + lu(1745) = lu(1745) - lu(375) * lu(1710) end subroutine lu_fac09 - subroutine lu_fac10( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac10( lu ) 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,356) = 1._r8 / lu(k,356) - lu(k,357) = lu(k,357) * lu(k,356) - lu(k,358) = lu(k,358) * lu(k,356) - lu(k,359) = lu(k,359) * lu(k,356) - lu(k,360) = lu(k,360) * lu(k,356) - lu(k,361) = lu(k,361) * lu(k,356) - lu(k,362) = lu(k,362) * lu(k,356) - lu(k,363) = lu(k,363) * lu(k,356) - lu(k,364) = lu(k,364) * lu(k,356) - lu(k,365) = lu(k,365) * lu(k,356) - lu(k,366) = lu(k,366) * lu(k,356) - lu(k,367) = lu(k,367) * lu(k,356) - lu(k,368) = lu(k,368) * lu(k,356) - lu(k,369) = lu(k,369) * lu(k,356) - lu(k,370) = lu(k,370) * lu(k,356) - lu(k,597) = lu(k,597) - lu(k,357) * lu(k,596) - lu(k,600) = lu(k,600) - lu(k,358) * lu(k,596) - lu(k,601) = lu(k,601) - lu(k,359) * lu(k,596) - lu(k,602) = lu(k,602) - lu(k,360) * lu(k,596) - lu(k,604) = lu(k,604) - lu(k,361) * lu(k,596) - lu(k,607) = lu(k,607) - lu(k,362) * lu(k,596) - lu(k,608) = lu(k,608) - lu(k,363) * lu(k,596) - lu(k,609) = lu(k,609) - lu(k,364) * lu(k,596) - lu(k,610) = lu(k,610) - lu(k,365) * lu(k,596) - lu(k,611) = lu(k,611) - lu(k,366) * lu(k,596) - lu(k,612) = lu(k,612) - lu(k,367) * lu(k,596) - lu(k,613) = lu(k,613) - lu(k,368) * lu(k,596) - lu(k,614) = lu(k,614) - lu(k,369) * lu(k,596) - lu(k,615) = lu(k,615) - lu(k,370) * lu(k,596) - lu(k,822) = lu(k,822) - lu(k,357) * lu(k,815) - lu(k,829) = lu(k,829) - lu(k,358) * lu(k,815) - lu(k,830) = lu(k,830) - lu(k,359) * lu(k,815) - lu(k,831) = lu(k,831) - lu(k,360) * lu(k,815) - lu(k,834) = lu(k,834) - lu(k,361) * lu(k,815) - lu(k,837) = lu(k,837) - lu(k,362) * lu(k,815) - lu(k,839) = lu(k,839) - lu(k,363) * lu(k,815) - lu(k,841) = lu(k,841) - lu(k,364) * lu(k,815) - lu(k,844) = lu(k,844) - lu(k,365) * lu(k,815) - lu(k,846) = lu(k,846) - lu(k,366) * lu(k,815) - lu(k,849) = lu(k,849) - lu(k,367) * lu(k,815) - lu(k,850) = lu(k,850) - lu(k,368) * lu(k,815) - lu(k,851) = lu(k,851) - lu(k,369) * lu(k,815) - lu(k,852) = lu(k,852) - lu(k,370) * lu(k,815) - lu(k,870) = lu(k,870) - lu(k,357) * lu(k,862) - lu(k,877) = lu(k,877) - lu(k,358) * lu(k,862) - lu(k,878) = lu(k,878) - lu(k,359) * lu(k,862) - lu(k,879) = lu(k,879) - lu(k,360) * lu(k,862) - lu(k,882) = lu(k,882) - lu(k,361) * lu(k,862) - lu(k,885) = lu(k,885) - lu(k,362) * lu(k,862) - lu(k,887) = lu(k,887) - lu(k,363) * lu(k,862) - lu(k,889) = lu(k,889) - lu(k,364) * lu(k,862) - lu(k,892) = lu(k,892) - lu(k,365) * lu(k,862) - lu(k,894) = lu(k,894) - lu(k,366) * lu(k,862) - lu(k,897) = lu(k,897) - lu(k,367) * lu(k,862) - lu(k,898) = lu(k,898) - lu(k,368) * lu(k,862) - lu(k,899) = lu(k,899) - lu(k,369) * lu(k,862) - lu(k,900) = lu(k,900) - lu(k,370) * lu(k,862) - lu(k,913) = lu(k,913) - lu(k,357) * lu(k,906) - lu(k,920) = lu(k,920) - lu(k,358) * lu(k,906) - lu(k,921) = lu(k,921) - lu(k,359) * lu(k,906) - lu(k,922) = lu(k,922) - lu(k,360) * lu(k,906) - lu(k,925) = lu(k,925) - lu(k,361) * lu(k,906) - lu(k,928) = lu(k,928) - lu(k,362) * lu(k,906) - lu(k,930) = lu(k,930) - lu(k,363) * lu(k,906) - lu(k,932) = lu(k,932) - lu(k,364) * lu(k,906) - lu(k,935) = lu(k,935) - lu(k,365) * lu(k,906) - lu(k,937) = lu(k,937) - lu(k,366) * lu(k,906) - lu(k,940) = lu(k,940) - lu(k,367) * lu(k,906) - lu(k,941) = lu(k,941) - lu(k,368) * lu(k,906) - lu(k,942) = lu(k,942) - lu(k,369) * lu(k,906) - lu(k,943) = lu(k,943) - lu(k,370) * lu(k,906) - lu(k,1054) = lu(k,1054) - lu(k,357) * lu(k,1047) - lu(k,1061) = lu(k,1061) - lu(k,358) * lu(k,1047) - lu(k,1062) = lu(k,1062) - lu(k,359) * lu(k,1047) - lu(k,1063) = lu(k,1063) - lu(k,360) * lu(k,1047) - lu(k,1066) = lu(k,1066) - lu(k,361) * lu(k,1047) - lu(k,1069) = lu(k,1069) - lu(k,362) * lu(k,1047) - lu(k,1071) = lu(k,1071) - lu(k,363) * lu(k,1047) - lu(k,1073) = lu(k,1073) - lu(k,364) * lu(k,1047) - lu(k,1076) = lu(k,1076) - lu(k,365) * lu(k,1047) - lu(k,1078) = lu(k,1078) - lu(k,366) * lu(k,1047) - lu(k,1081) = lu(k,1081) - lu(k,367) * lu(k,1047) - lu(k,1082) = lu(k,1082) - lu(k,368) * lu(k,1047) - lu(k,1083) = lu(k,1083) - lu(k,369) * lu(k,1047) - lu(k,1084) = lu(k,1084) - lu(k,370) * lu(k,1047) - lu(k,1182) = lu(k,1182) - lu(k,357) * lu(k,1175) - lu(k,1189) = lu(k,1189) - lu(k,358) * lu(k,1175) - lu(k,1190) = lu(k,1190) - lu(k,359) * lu(k,1175) - lu(k,1191) = lu(k,1191) - lu(k,360) * lu(k,1175) - lu(k,1194) = lu(k,1194) - lu(k,361) * lu(k,1175) - lu(k,1197) = lu(k,1197) - lu(k,362) * lu(k,1175) - lu(k,1199) = lu(k,1199) - lu(k,363) * lu(k,1175) - lu(k,1201) = lu(k,1201) - lu(k,364) * lu(k,1175) - lu(k,1204) = lu(k,1204) - lu(k,365) * lu(k,1175) - lu(k,1206) = lu(k,1206) - lu(k,366) * lu(k,1175) - lu(k,1209) = lu(k,1209) - lu(k,367) * lu(k,1175) - lu(k,1210) = lu(k,1210) - lu(k,368) * lu(k,1175) - lu(k,1211) = lu(k,1211) - lu(k,369) * lu(k,1175) - lu(k,1212) = lu(k,1212) - lu(k,370) * lu(k,1175) - lu(k,1341) = lu(k,1341) - lu(k,357) * lu(k,1333) - lu(k,1348) = lu(k,1348) - lu(k,358) * lu(k,1333) - lu(k,1349) = lu(k,1349) - lu(k,359) * lu(k,1333) - lu(k,1350) = lu(k,1350) - lu(k,360) * lu(k,1333) - lu(k,1353) = lu(k,1353) - lu(k,361) * lu(k,1333) - lu(k,1356) = lu(k,1356) - lu(k,362) * lu(k,1333) - lu(k,1358) = lu(k,1358) - lu(k,363) * lu(k,1333) - lu(k,1360) = lu(k,1360) - lu(k,364) * lu(k,1333) - lu(k,1363) = lu(k,1363) - lu(k,365) * lu(k,1333) - lu(k,1365) = lu(k,1365) - lu(k,366) * lu(k,1333) - lu(k,1368) = lu(k,1368) - lu(k,367) * lu(k,1333) - lu(k,1369) = lu(k,1369) - lu(k,368) * lu(k,1333) - lu(k,1370) = lu(k,1370) - lu(k,369) * lu(k,1333) - lu(k,1371) = lu(k,1371) - lu(k,370) * lu(k,1333) - lu(k,1466) = lu(k,1466) - lu(k,357) * lu(k,1460) - lu(k,1473) = lu(k,1473) - lu(k,358) * lu(k,1460) - lu(k,1474) = lu(k,1474) - lu(k,359) * lu(k,1460) - lu(k,1475) = lu(k,1475) - lu(k,360) * lu(k,1460) - lu(k,1478) = lu(k,1478) - lu(k,361) * lu(k,1460) - lu(k,1481) = lu(k,1481) - lu(k,362) * lu(k,1460) - lu(k,1483) = lu(k,1483) - lu(k,363) * lu(k,1460) - lu(k,1485) = lu(k,1485) - lu(k,364) * lu(k,1460) - lu(k,1488) = lu(k,1488) - lu(k,365) * lu(k,1460) - lu(k,1490) = lu(k,1490) - lu(k,366) * lu(k,1460) - lu(k,1493) = lu(k,1493) - lu(k,367) * lu(k,1460) - lu(k,1494) = lu(k,1494) - lu(k,368) * lu(k,1460) - lu(k,1495) = lu(k,1495) - lu(k,369) * lu(k,1460) - lu(k,1496) = lu(k,1496) - lu(k,370) * lu(k,1460) - lu(k,1552) = lu(k,1552) - lu(k,357) * lu(k,1545) - lu(k,1559) = lu(k,1559) - lu(k,358) * lu(k,1545) - lu(k,1560) = lu(k,1560) - lu(k,359) * lu(k,1545) - lu(k,1561) = lu(k,1561) - lu(k,360) * lu(k,1545) - lu(k,1564) = lu(k,1564) - lu(k,361) * lu(k,1545) - lu(k,1567) = lu(k,1567) - lu(k,362) * lu(k,1545) - lu(k,1569) = lu(k,1569) - lu(k,363) * lu(k,1545) - lu(k,1571) = lu(k,1571) - lu(k,364) * lu(k,1545) - lu(k,1574) = lu(k,1574) - lu(k,365) * lu(k,1545) - lu(k,1576) = lu(k,1576) - lu(k,366) * lu(k,1545) - lu(k,1579) = lu(k,1579) - lu(k,367) * lu(k,1545) - lu(k,1580) = lu(k,1580) - lu(k,368) * lu(k,1545) - lu(k,1581) = lu(k,1581) - lu(k,369) * lu(k,1545) - lu(k,1582) = lu(k,1582) - lu(k,370) * lu(k,1545) - lu(k,1796) = lu(k,1796) - lu(k,357) * lu(k,1788) - lu(k,1802) = lu(k,1802) - lu(k,358) * lu(k,1788) - lu(k,1803) = lu(k,1803) - lu(k,359) * lu(k,1788) - lu(k,1804) = lu(k,1804) - lu(k,360) * lu(k,1788) - lu(k,1807) = lu(k,1807) - lu(k,361) * lu(k,1788) - lu(k,1810) = lu(k,1810) - lu(k,362) * lu(k,1788) - lu(k,1812) = lu(k,1812) - lu(k,363) * lu(k,1788) - lu(k,1814) = lu(k,1814) - lu(k,364) * lu(k,1788) - lu(k,1817) = - lu(k,365) * lu(k,1788) - lu(k,1819) = lu(k,1819) - lu(k,366) * lu(k,1788) - lu(k,1822) = lu(k,1822) - lu(k,367) * lu(k,1788) - lu(k,1823) = lu(k,1823) - lu(k,368) * lu(k,1788) - lu(k,1824) = lu(k,1824) - lu(k,369) * lu(k,1788) - lu(k,1825) = lu(k,1825) - lu(k,370) * lu(k,1788) - lu(k,371) = 1._r8 / lu(k,371) - lu(k,372) = lu(k,372) * lu(k,371) - lu(k,373) = lu(k,373) * lu(k,371) - lu(k,374) = lu(k,374) * lu(k,371) - lu(k,375) = lu(k,375) * lu(k,371) - lu(k,376) = lu(k,376) * lu(k,371) - lu(k,377) = lu(k,377) * lu(k,371) - lu(k,378) = lu(k,378) * lu(k,371) - lu(k,379) = lu(k,379) * lu(k,371) - lu(k,380) = lu(k,380) * lu(k,371) - lu(k,381) = lu(k,381) * lu(k,371) - lu(k,382) = lu(k,382) * lu(k,371) - lu(k,383) = lu(k,383) * lu(k,371) - lu(k,384) = lu(k,384) * lu(k,371) - lu(k,500) = lu(k,500) - lu(k,372) * lu(k,496) - lu(k,502) = lu(k,502) - lu(k,373) * lu(k,496) - lu(k,503) = lu(k,503) - lu(k,374) * lu(k,496) - lu(k,504) = lu(k,504) - lu(k,375) * lu(k,496) - lu(k,506) = lu(k,506) - lu(k,376) * lu(k,496) - lu(k,507) = lu(k,507) - lu(k,377) * lu(k,496) - lu(k,508) = lu(k,508) - lu(k,378) * lu(k,496) - lu(k,509) = lu(k,509) - lu(k,379) * lu(k,496) - lu(k,510) = lu(k,510) - lu(k,380) * lu(k,496) - lu(k,512) = lu(k,512) - lu(k,381) * lu(k,496) - lu(k,513) = lu(k,513) - lu(k,382) * lu(k,496) - lu(k,514) = lu(k,514) - lu(k,383) * lu(k,496) - lu(k,515) = lu(k,515) - lu(k,384) * lu(k,496) - lu(k,712) = lu(k,712) - lu(k,372) * lu(k,709) - lu(k,714) = lu(k,714) - lu(k,373) * lu(k,709) - lu(k,715) = lu(k,715) - lu(k,374) * lu(k,709) - lu(k,716) = lu(k,716) - lu(k,375) * lu(k,709) - lu(k,719) = lu(k,719) - lu(k,376) * lu(k,709) - lu(k,721) = lu(k,721) - lu(k,377) * lu(k,709) - lu(k,722) = lu(k,722) - lu(k,378) * lu(k,709) - lu(k,724) = lu(k,724) - lu(k,379) * lu(k,709) - lu(k,725) = lu(k,725) - lu(k,380) * lu(k,709) - lu(k,729) = lu(k,729) - lu(k,381) * lu(k,709) - lu(k,732) = lu(k,732) - lu(k,382) * lu(k,709) - lu(k,733) = lu(k,733) - lu(k,383) * lu(k,709) - lu(k,734) = lu(k,734) - lu(k,384) * lu(k,709) - lu(k,826) = lu(k,826) - lu(k,372) * lu(k,816) - lu(k,829) = lu(k,829) - lu(k,373) * lu(k,816) - lu(k,830) = lu(k,830) - lu(k,374) * lu(k,816) - lu(k,831) = lu(k,831) - lu(k,375) * lu(k,816) - lu(k,834) = lu(k,834) - lu(k,376) * lu(k,816) - lu(k,836) = lu(k,836) - lu(k,377) * lu(k,816) - lu(k,837) = lu(k,837) - lu(k,378) * lu(k,816) - lu(k,839) = lu(k,839) - lu(k,379) * lu(k,816) - lu(k,841) = lu(k,841) - lu(k,380) * lu(k,816) - lu(k,846) = lu(k,846) - lu(k,381) * lu(k,816) - lu(k,850) = lu(k,850) - lu(k,382) * lu(k,816) - lu(k,851) = lu(k,851) - lu(k,383) * lu(k,816) - lu(k,852) = lu(k,852) - lu(k,384) * lu(k,816) - lu(k,874) = lu(k,874) - lu(k,372) * lu(k,863) - lu(k,877) = lu(k,877) - lu(k,373) * lu(k,863) - lu(k,878) = lu(k,878) - lu(k,374) * lu(k,863) - lu(k,879) = lu(k,879) - lu(k,375) * lu(k,863) - lu(k,882) = lu(k,882) - lu(k,376) * lu(k,863) - lu(k,884) = lu(k,884) - lu(k,377) * lu(k,863) - lu(k,885) = lu(k,885) - lu(k,378) * lu(k,863) - lu(k,887) = lu(k,887) - lu(k,379) * lu(k,863) - lu(k,889) = lu(k,889) - lu(k,380) * lu(k,863) - lu(k,894) = lu(k,894) - lu(k,381) * lu(k,863) - lu(k,898) = lu(k,898) - lu(k,382) * lu(k,863) - lu(k,899) = lu(k,899) - lu(k,383) * lu(k,863) - lu(k,900) = lu(k,900) - lu(k,384) * lu(k,863) - lu(k,917) = lu(k,917) - lu(k,372) * lu(k,907) - lu(k,920) = lu(k,920) - lu(k,373) * lu(k,907) - lu(k,921) = lu(k,921) - lu(k,374) * lu(k,907) - lu(k,922) = lu(k,922) - lu(k,375) * lu(k,907) - lu(k,925) = lu(k,925) - lu(k,376) * lu(k,907) - lu(k,927) = lu(k,927) - lu(k,377) * lu(k,907) - lu(k,928) = lu(k,928) - lu(k,378) * lu(k,907) - lu(k,930) = lu(k,930) - lu(k,379) * lu(k,907) - lu(k,932) = lu(k,932) - lu(k,380) * lu(k,907) - lu(k,937) = lu(k,937) - lu(k,381) * lu(k,907) - lu(k,941) = lu(k,941) - lu(k,382) * lu(k,907) - lu(k,942) = lu(k,942) - lu(k,383) * lu(k,907) - lu(k,943) = lu(k,943) - lu(k,384) * lu(k,907) - lu(k,1058) = lu(k,1058) - lu(k,372) * lu(k,1048) - lu(k,1061) = lu(k,1061) - lu(k,373) * lu(k,1048) - lu(k,1062) = lu(k,1062) - lu(k,374) * lu(k,1048) - lu(k,1063) = lu(k,1063) - lu(k,375) * lu(k,1048) - lu(k,1066) = lu(k,1066) - lu(k,376) * lu(k,1048) - lu(k,1068) = lu(k,1068) - lu(k,377) * lu(k,1048) - lu(k,1069) = lu(k,1069) - lu(k,378) * lu(k,1048) - lu(k,1071) = lu(k,1071) - lu(k,379) * lu(k,1048) - lu(k,1073) = lu(k,1073) - lu(k,380) * lu(k,1048) - lu(k,1078) = lu(k,1078) - lu(k,381) * lu(k,1048) - lu(k,1082) = lu(k,1082) - lu(k,382) * lu(k,1048) - lu(k,1083) = lu(k,1083) - lu(k,383) * lu(k,1048) - lu(k,1084) = lu(k,1084) - lu(k,384) * lu(k,1048) - lu(k,1186) = lu(k,1186) - lu(k,372) * lu(k,1176) - lu(k,1189) = lu(k,1189) - lu(k,373) * lu(k,1176) - lu(k,1190) = lu(k,1190) - lu(k,374) * lu(k,1176) - lu(k,1191) = lu(k,1191) - lu(k,375) * lu(k,1176) - lu(k,1194) = lu(k,1194) - lu(k,376) * lu(k,1176) - lu(k,1196) = lu(k,1196) - lu(k,377) * lu(k,1176) - lu(k,1197) = lu(k,1197) - lu(k,378) * lu(k,1176) - lu(k,1199) = lu(k,1199) - lu(k,379) * lu(k,1176) - lu(k,1201) = lu(k,1201) - lu(k,380) * lu(k,1176) - lu(k,1206) = lu(k,1206) - lu(k,381) * lu(k,1176) - lu(k,1210) = lu(k,1210) - lu(k,382) * lu(k,1176) - lu(k,1211) = lu(k,1211) - lu(k,383) * lu(k,1176) - lu(k,1212) = lu(k,1212) - lu(k,384) * lu(k,1176) - lu(k,1345) = lu(k,1345) - lu(k,372) * lu(k,1334) - lu(k,1348) = lu(k,1348) - lu(k,373) * lu(k,1334) - lu(k,1349) = lu(k,1349) - lu(k,374) * lu(k,1334) - lu(k,1350) = lu(k,1350) - lu(k,375) * lu(k,1334) - lu(k,1353) = lu(k,1353) - lu(k,376) * lu(k,1334) - lu(k,1355) = lu(k,1355) - lu(k,377) * lu(k,1334) - lu(k,1356) = lu(k,1356) - lu(k,378) * lu(k,1334) - lu(k,1358) = lu(k,1358) - lu(k,379) * lu(k,1334) - lu(k,1360) = lu(k,1360) - lu(k,380) * lu(k,1334) - lu(k,1365) = lu(k,1365) - lu(k,381) * lu(k,1334) - lu(k,1369) = lu(k,1369) - lu(k,382) * lu(k,1334) - lu(k,1370) = lu(k,1370) - lu(k,383) * lu(k,1334) - lu(k,1371) = lu(k,1371) - lu(k,384) * lu(k,1334) - lu(k,1556) = lu(k,1556) - lu(k,372) * lu(k,1546) - lu(k,1559) = lu(k,1559) - lu(k,373) * lu(k,1546) - lu(k,1560) = lu(k,1560) - lu(k,374) * lu(k,1546) - lu(k,1561) = lu(k,1561) - lu(k,375) * lu(k,1546) - lu(k,1564) = lu(k,1564) - lu(k,376) * lu(k,1546) - lu(k,1566) = lu(k,1566) - lu(k,377) * lu(k,1546) - lu(k,1567) = lu(k,1567) - lu(k,378) * lu(k,1546) - lu(k,1569) = lu(k,1569) - lu(k,379) * lu(k,1546) - lu(k,1571) = lu(k,1571) - lu(k,380) * lu(k,1546) - lu(k,1576) = lu(k,1576) - lu(k,381) * lu(k,1546) - lu(k,1580) = lu(k,1580) - lu(k,382) * lu(k,1546) - lu(k,1581) = lu(k,1581) - lu(k,383) * lu(k,1546) - lu(k,1582) = lu(k,1582) - lu(k,384) * lu(k,1546) - lu(k,1746) = lu(k,1746) - lu(k,372) * lu(k,1736) - lu(k,1749) = - lu(k,373) * lu(k,1736) - lu(k,1750) = lu(k,1750) - lu(k,374) * lu(k,1736) - lu(k,1751) = - lu(k,375) * lu(k,1736) - lu(k,1754) = - lu(k,376) * lu(k,1736) - lu(k,1756) = lu(k,1756) - lu(k,377) * lu(k,1736) - lu(k,1757) = - lu(k,378) * lu(k,1736) - lu(k,1759) = lu(k,1759) - lu(k,379) * lu(k,1736) - lu(k,1761) = lu(k,1761) - lu(k,380) * lu(k,1736) - lu(k,1766) = - lu(k,381) * lu(k,1736) - lu(k,1770) = lu(k,1770) - lu(k,382) * lu(k,1736) - lu(k,1771) = lu(k,1771) - lu(k,383) * lu(k,1736) - lu(k,1772) = lu(k,1772) - lu(k,384) * lu(k,1736) - lu(k,1799) = lu(k,1799) - lu(k,372) * lu(k,1789) - lu(k,1802) = lu(k,1802) - lu(k,373) * lu(k,1789) - lu(k,1803) = lu(k,1803) - lu(k,374) * lu(k,1789) - lu(k,1804) = lu(k,1804) - lu(k,375) * lu(k,1789) - lu(k,1807) = lu(k,1807) - lu(k,376) * lu(k,1789) - lu(k,1809) = lu(k,1809) - lu(k,377) * lu(k,1789) - lu(k,1810) = lu(k,1810) - lu(k,378) * lu(k,1789) - lu(k,1812) = lu(k,1812) - lu(k,379) * lu(k,1789) - lu(k,1814) = lu(k,1814) - lu(k,380) * lu(k,1789) - lu(k,1819) = lu(k,1819) - lu(k,381) * lu(k,1789) - lu(k,1823) = lu(k,1823) - lu(k,382) * lu(k,1789) - lu(k,1824) = lu(k,1824) - lu(k,383) * lu(k,1789) - lu(k,1825) = lu(k,1825) - lu(k,384) * lu(k,1789) - lu(k,385) = 1._r8 / lu(k,385) - lu(k,386) = lu(k,386) * lu(k,385) - lu(k,387) = lu(k,387) * lu(k,385) - lu(k,388) = lu(k,388) * lu(k,385) - lu(k,389) = lu(k,389) * lu(k,385) - lu(k,390) = lu(k,390) * lu(k,385) - lu(k,391) = lu(k,391) * lu(k,385) - lu(k,392) = lu(k,392) * lu(k,385) - lu(k,393) = lu(k,393) * lu(k,385) - lu(k,394) = lu(k,394) * lu(k,385) - lu(k,395) = lu(k,395) * lu(k,385) - lu(k,396) = lu(k,396) * lu(k,385) - lu(k,397) = lu(k,397) * lu(k,385) - lu(k,398) = lu(k,398) * lu(k,385) - lu(k,399) = lu(k,399) * lu(k,385) - lu(k,400) = lu(k,400) * lu(k,385) - lu(k,649) = lu(k,649) - lu(k,386) * lu(k,648) - lu(k,654) = lu(k,654) - lu(k,387) * lu(k,648) - lu(k,655) = lu(k,655) - lu(k,388) * lu(k,648) - lu(k,656) = lu(k,656) - lu(k,389) * lu(k,648) - lu(k,659) = lu(k,659) - lu(k,390) * lu(k,648) - lu(k,660) = lu(k,660) - lu(k,391) * lu(k,648) - lu(k,662) = lu(k,662) - lu(k,392) * lu(k,648) - lu(k,663) = lu(k,663) - lu(k,393) * lu(k,648) - lu(k,664) = lu(k,664) - lu(k,394) * lu(k,648) - lu(k,665) = lu(k,665) - lu(k,395) * lu(k,648) - lu(k,667) = lu(k,667) - lu(k,396) * lu(k,648) - lu(k,668) = lu(k,668) - lu(k,397) * lu(k,648) - lu(k,670) = - lu(k,398) * lu(k,648) - lu(k,671) = lu(k,671) - lu(k,399) * lu(k,648) - lu(k,672) = lu(k,672) - lu(k,400) * lu(k,648) - lu(k,818) = lu(k,818) - lu(k,386) * lu(k,817) - lu(k,829) = lu(k,829) - lu(k,387) * lu(k,817) - lu(k,830) = lu(k,830) - lu(k,388) * lu(k,817) - lu(k,831) = lu(k,831) - lu(k,389) * lu(k,817) - lu(k,834) = lu(k,834) - lu(k,390) * lu(k,817) - lu(k,835) = lu(k,835) - lu(k,391) * lu(k,817) - lu(k,837) = lu(k,837) - lu(k,392) * lu(k,817) - lu(k,838) = lu(k,838) - lu(k,393) * lu(k,817) - lu(k,839) = lu(k,839) - lu(k,394) * lu(k,817) - lu(k,841) = lu(k,841) - lu(k,395) * lu(k,817) - lu(k,844) = lu(k,844) - lu(k,396) * lu(k,817) - lu(k,846) = lu(k,846) - lu(k,397) * lu(k,817) - lu(k,850) = lu(k,850) - lu(k,398) * lu(k,817) - lu(k,851) = lu(k,851) - lu(k,399) * lu(k,817) - lu(k,852) = lu(k,852) - lu(k,400) * lu(k,817) - lu(k,865) = lu(k,865) - lu(k,386) * lu(k,864) - lu(k,877) = lu(k,877) - lu(k,387) * lu(k,864) - lu(k,878) = lu(k,878) - lu(k,388) * lu(k,864) - lu(k,879) = lu(k,879) - lu(k,389) * lu(k,864) - lu(k,882) = lu(k,882) - lu(k,390) * lu(k,864) - lu(k,883) = lu(k,883) - lu(k,391) * lu(k,864) - lu(k,885) = lu(k,885) - lu(k,392) * lu(k,864) - lu(k,886) = lu(k,886) - lu(k,393) * lu(k,864) - lu(k,887) = lu(k,887) - lu(k,394) * lu(k,864) - lu(k,889) = lu(k,889) - lu(k,395) * lu(k,864) - lu(k,892) = lu(k,892) - lu(k,396) * lu(k,864) - lu(k,894) = lu(k,894) - lu(k,397) * lu(k,864) - lu(k,898) = lu(k,898) - lu(k,398) * lu(k,864) - lu(k,899) = lu(k,899) - lu(k,399) * lu(k,864) - lu(k,900) = lu(k,900) - lu(k,400) * lu(k,864) - lu(k,909) = lu(k,909) - lu(k,386) * lu(k,908) - lu(k,920) = lu(k,920) - lu(k,387) * lu(k,908) - lu(k,921) = lu(k,921) - lu(k,388) * lu(k,908) - lu(k,922) = lu(k,922) - lu(k,389) * lu(k,908) - lu(k,925) = lu(k,925) - lu(k,390) * lu(k,908) - lu(k,926) = lu(k,926) - lu(k,391) * lu(k,908) - lu(k,928) = lu(k,928) - lu(k,392) * lu(k,908) - lu(k,929) = lu(k,929) - lu(k,393) * lu(k,908) - lu(k,930) = lu(k,930) - lu(k,394) * lu(k,908) - lu(k,932) = lu(k,932) - lu(k,395) * lu(k,908) - lu(k,935) = lu(k,935) - lu(k,396) * lu(k,908) - lu(k,937) = lu(k,937) - lu(k,397) * lu(k,908) - lu(k,941) = lu(k,941) - lu(k,398) * lu(k,908) - lu(k,942) = lu(k,942) - lu(k,399) * lu(k,908) - lu(k,943) = lu(k,943) - lu(k,400) * lu(k,908) - lu(k,1050) = lu(k,1050) - lu(k,386) * lu(k,1049) - lu(k,1061) = lu(k,1061) - lu(k,387) * lu(k,1049) - lu(k,1062) = lu(k,1062) - lu(k,388) * lu(k,1049) - lu(k,1063) = lu(k,1063) - lu(k,389) * lu(k,1049) - lu(k,1066) = lu(k,1066) - lu(k,390) * lu(k,1049) - lu(k,1067) = lu(k,1067) - lu(k,391) * lu(k,1049) - lu(k,1069) = lu(k,1069) - lu(k,392) * lu(k,1049) - lu(k,1070) = lu(k,1070) - lu(k,393) * lu(k,1049) - lu(k,1071) = lu(k,1071) - lu(k,394) * lu(k,1049) - lu(k,1073) = lu(k,1073) - lu(k,395) * lu(k,1049) - lu(k,1076) = lu(k,1076) - lu(k,396) * lu(k,1049) - lu(k,1078) = lu(k,1078) - lu(k,397) * lu(k,1049) - lu(k,1082) = lu(k,1082) - lu(k,398) * lu(k,1049) - lu(k,1083) = lu(k,1083) - lu(k,399) * lu(k,1049) - lu(k,1084) = lu(k,1084) - lu(k,400) * lu(k,1049) - lu(k,1091) = lu(k,1091) - lu(k,386) * lu(k,1089) - lu(k,1101) = - lu(k,387) * lu(k,1089) - lu(k,1102) = - lu(k,388) * lu(k,1089) - lu(k,1103) = - lu(k,389) * lu(k,1089) - lu(k,1106) = - lu(k,390) * lu(k,1089) - lu(k,1107) = lu(k,1107) - lu(k,391) * lu(k,1089) - lu(k,1109) = - lu(k,392) * lu(k,1089) - lu(k,1110) = lu(k,1110) - lu(k,393) * lu(k,1089) - lu(k,1111) = lu(k,1111) - lu(k,394) * lu(k,1089) - lu(k,1113) = - lu(k,395) * lu(k,1089) - lu(k,1116) = lu(k,1116) - lu(k,396) * lu(k,1089) - lu(k,1118) = - lu(k,397) * lu(k,1089) - lu(k,1122) = lu(k,1122) - lu(k,398) * lu(k,1089) - lu(k,1123) = lu(k,1123) - lu(k,399) * lu(k,1089) - lu(k,1124) = lu(k,1124) - lu(k,400) * lu(k,1089) - lu(k,1178) = lu(k,1178) - lu(k,386) * lu(k,1177) - lu(k,1189) = lu(k,1189) - lu(k,387) * lu(k,1177) - lu(k,1190) = lu(k,1190) - lu(k,388) * lu(k,1177) - lu(k,1191) = lu(k,1191) - lu(k,389) * lu(k,1177) - lu(k,1194) = lu(k,1194) - lu(k,390) * lu(k,1177) - lu(k,1195) = lu(k,1195) - lu(k,391) * lu(k,1177) - lu(k,1197) = lu(k,1197) - lu(k,392) * lu(k,1177) - lu(k,1198) = lu(k,1198) - lu(k,393) * lu(k,1177) - lu(k,1199) = lu(k,1199) - lu(k,394) * lu(k,1177) - lu(k,1201) = lu(k,1201) - lu(k,395) * lu(k,1177) - lu(k,1204) = lu(k,1204) - lu(k,396) * lu(k,1177) - lu(k,1206) = lu(k,1206) - lu(k,397) * lu(k,1177) - lu(k,1210) = lu(k,1210) - lu(k,398) * lu(k,1177) - lu(k,1211) = lu(k,1211) - lu(k,399) * lu(k,1177) - lu(k,1212) = lu(k,1212) - lu(k,400) * lu(k,1177) - lu(k,1336) = lu(k,1336) - lu(k,386) * lu(k,1335) - lu(k,1348) = lu(k,1348) - lu(k,387) * lu(k,1335) - lu(k,1349) = lu(k,1349) - lu(k,388) * lu(k,1335) - lu(k,1350) = lu(k,1350) - lu(k,389) * lu(k,1335) - lu(k,1353) = lu(k,1353) - lu(k,390) * lu(k,1335) - lu(k,1354) = lu(k,1354) - lu(k,391) * lu(k,1335) - lu(k,1356) = lu(k,1356) - lu(k,392) * lu(k,1335) - lu(k,1357) = lu(k,1357) - lu(k,393) * lu(k,1335) - lu(k,1358) = lu(k,1358) - lu(k,394) * lu(k,1335) - lu(k,1360) = lu(k,1360) - lu(k,395) * lu(k,1335) - lu(k,1363) = lu(k,1363) - lu(k,396) * lu(k,1335) - lu(k,1365) = lu(k,1365) - lu(k,397) * lu(k,1335) - lu(k,1369) = lu(k,1369) - lu(k,398) * lu(k,1335) - lu(k,1370) = lu(k,1370) - lu(k,399) * lu(k,1335) - lu(k,1371) = lu(k,1371) - lu(k,400) * lu(k,1335) - lu(k,1462) = - lu(k,386) * lu(k,1461) - lu(k,1473) = lu(k,1473) - lu(k,387) * lu(k,1461) - lu(k,1474) = lu(k,1474) - lu(k,388) * lu(k,1461) - lu(k,1475) = lu(k,1475) - lu(k,389) * lu(k,1461) - lu(k,1478) = lu(k,1478) - lu(k,390) * lu(k,1461) - lu(k,1479) = lu(k,1479) - lu(k,391) * lu(k,1461) - lu(k,1481) = lu(k,1481) - lu(k,392) * lu(k,1461) - lu(k,1482) = lu(k,1482) - lu(k,393) * lu(k,1461) - lu(k,1483) = lu(k,1483) - lu(k,394) * lu(k,1461) - lu(k,1485) = lu(k,1485) - lu(k,395) * lu(k,1461) - lu(k,1488) = lu(k,1488) - lu(k,396) * lu(k,1461) - lu(k,1490) = lu(k,1490) - lu(k,397) * lu(k,1461) - lu(k,1494) = lu(k,1494) - lu(k,398) * lu(k,1461) - lu(k,1495) = lu(k,1495) - lu(k,399) * lu(k,1461) - lu(k,1496) = lu(k,1496) - lu(k,400) * lu(k,1461) - lu(k,1548) = lu(k,1548) - lu(k,386) * lu(k,1547) - lu(k,1559) = lu(k,1559) - lu(k,387) * lu(k,1547) - lu(k,1560) = lu(k,1560) - lu(k,388) * lu(k,1547) - lu(k,1561) = lu(k,1561) - lu(k,389) * lu(k,1547) - lu(k,1564) = lu(k,1564) - lu(k,390) * lu(k,1547) - lu(k,1565) = lu(k,1565) - lu(k,391) * lu(k,1547) - lu(k,1567) = lu(k,1567) - lu(k,392) * lu(k,1547) - lu(k,1568) = lu(k,1568) - lu(k,393) * lu(k,1547) - lu(k,1569) = lu(k,1569) - lu(k,394) * lu(k,1547) - lu(k,1571) = lu(k,1571) - lu(k,395) * lu(k,1547) - lu(k,1574) = lu(k,1574) - lu(k,396) * lu(k,1547) - lu(k,1576) = lu(k,1576) - lu(k,397) * lu(k,1547) - lu(k,1580) = lu(k,1580) - lu(k,398) * lu(k,1547) - lu(k,1581) = lu(k,1581) - lu(k,399) * lu(k,1547) - lu(k,1582) = lu(k,1582) - lu(k,400) * lu(k,1547) - end do + real(r8), intent(inout) :: lu(:) + lu(376) = 1._r8 / lu(376) + lu(377) = lu(377) * lu(376) + lu(378) = lu(378) * lu(376) + lu(379) = lu(379) * lu(376) + lu(380) = lu(380) * lu(376) + lu(381) = lu(381) * lu(376) + lu(382) = lu(382) * lu(376) + lu(383) = lu(383) * lu(376) + lu(384) = lu(384) * lu(376) + lu(385) = lu(385) * lu(376) + lu(386) = lu(386) * lu(376) + lu(387) = lu(387) * lu(376) + lu(388) = lu(388) * lu(376) + lu(389) = lu(389) * lu(376) + lu(585) = - lu(377) * lu(582) + lu(588) = lu(588) - lu(378) * lu(582) + lu(589) = lu(589) - lu(379) * lu(582) + lu(593) = lu(593) - lu(380) * lu(582) + lu(596) = lu(596) - lu(381) * lu(582) + lu(598) = lu(598) - lu(382) * lu(582) + lu(600) = lu(600) - lu(383) * lu(582) + lu(602) = lu(602) - lu(384) * lu(582) + lu(604) = - lu(385) * lu(582) + lu(606) = lu(606) - lu(386) * lu(582) + lu(607) = - lu(387) * lu(582) + lu(608) = - lu(388) * lu(582) + lu(609) = lu(609) - lu(389) * lu(582) + lu(737) = lu(737) - lu(377) * lu(733) + lu(739) = lu(739) - lu(378) * lu(733) + lu(740) = lu(740) - lu(379) * lu(733) + lu(744) = lu(744) - lu(380) * lu(733) + lu(747) = lu(747) - lu(381) * lu(733) + lu(749) = lu(749) - lu(382) * lu(733) + lu(751) = lu(751) - lu(383) * lu(733) + lu(753) = lu(753) - lu(384) * lu(733) + lu(755) = - lu(385) * lu(733) + lu(757) = lu(757) - lu(386) * lu(733) + lu(758) = lu(758) - lu(387) * lu(733) + lu(759) = lu(759) - lu(388) * lu(733) + lu(760) = - lu(389) * lu(733) + lu(933) = - lu(377) * lu(927) + lu(936) = lu(936) - lu(378) * lu(927) + lu(937) = lu(937) - lu(379) * lu(927) + lu(941) = lu(941) - lu(380) * lu(927) + lu(944) = - lu(381) * lu(927) + lu(946) = lu(946) - lu(382) * lu(927) + lu(948) = lu(948) - lu(383) * lu(927) + lu(950) = lu(950) - lu(384) * lu(927) + lu(952) = lu(952) - lu(385) * lu(927) + lu(954) = lu(954) - lu(386) * lu(927) + lu(955) = lu(955) - lu(387) * lu(927) + lu(956) = - lu(388) * lu(927) + lu(957) = lu(957) - lu(389) * lu(927) + lu(1060) = lu(1060) - lu(377) * lu(1051) + lu(1063) = lu(1063) - lu(378) * lu(1051) + lu(1064) = lu(1064) - lu(379) * lu(1051) + lu(1068) = lu(1068) - lu(380) * lu(1051) + lu(1071) = lu(1071) - lu(381) * lu(1051) + lu(1073) = lu(1073) - lu(382) * lu(1051) + lu(1075) = lu(1075) - lu(383) * lu(1051) + lu(1077) = lu(1077) - lu(384) * lu(1051) + lu(1079) = lu(1079) - lu(385) * lu(1051) + lu(1081) = lu(1081) - lu(386) * lu(1051) + lu(1082) = lu(1082) - lu(387) * lu(1051) + lu(1083) = lu(1083) - lu(388) * lu(1051) + lu(1084) = lu(1084) - lu(389) * lu(1051) + lu(1145) = - lu(377) * lu(1141) + lu(1148) = lu(1148) - lu(378) * lu(1141) + lu(1149) = - lu(379) * lu(1141) + lu(1153) = lu(1153) - lu(380) * lu(1141) + lu(1156) = lu(1156) - lu(381) * lu(1141) + lu(1158) = lu(1158) - lu(382) * lu(1141) + lu(1160) = lu(1160) - lu(383) * lu(1141) + lu(1162) = lu(1162) - lu(384) * lu(1141) + lu(1164) = lu(1164) - lu(385) * lu(1141) + lu(1166) = lu(1166) - lu(386) * lu(1141) + lu(1167) = - lu(387) * lu(1141) + lu(1168) = lu(1168) - lu(388) * lu(1141) + lu(1169) = lu(1169) - lu(389) * lu(1141) + lu(1222) = lu(1222) - lu(377) * lu(1219) + lu(1225) = - lu(378) * lu(1219) + lu(1226) = lu(1226) - lu(379) * lu(1219) + lu(1230) = lu(1230) - lu(380) * lu(1219) + lu(1233) = lu(1233) - lu(381) * lu(1219) + lu(1235) = lu(1235) - lu(382) * lu(1219) + lu(1237) = lu(1237) - lu(383) * lu(1219) + lu(1239) = lu(1239) - lu(384) * lu(1219) + lu(1241) = lu(1241) - lu(385) * lu(1219) + lu(1243) = lu(1243) - lu(386) * lu(1219) + lu(1244) = - lu(387) * lu(1219) + lu(1245) = lu(1245) - lu(388) * lu(1219) + lu(1246) = lu(1246) - lu(389) * lu(1219) + lu(1307) = lu(1307) - lu(377) * lu(1300) + lu(1310) = lu(1310) - lu(378) * lu(1300) + lu(1311) = lu(1311) - lu(379) * lu(1300) + lu(1315) = lu(1315) - lu(380) * lu(1300) + lu(1318) = lu(1318) - lu(381) * lu(1300) + lu(1320) = lu(1320) - lu(382) * lu(1300) + lu(1322) = - lu(383) * lu(1300) + lu(1324) = lu(1324) - lu(384) * lu(1300) + lu(1326) = lu(1326) - lu(385) * lu(1300) + lu(1328) = lu(1328) - lu(386) * lu(1300) + lu(1329) = - lu(387) * lu(1300) + lu(1330) = lu(1330) - lu(388) * lu(1300) + lu(1331) = lu(1331) - lu(389) * lu(1300) + lu(1488) = lu(1488) - lu(377) * lu(1481) + lu(1491) = lu(1491) - lu(378) * lu(1481) + lu(1492) = lu(1492) - lu(379) * lu(1481) + lu(1496) = lu(1496) - lu(380) * lu(1481) + lu(1499) = lu(1499) - lu(381) * lu(1481) + lu(1501) = lu(1501) - lu(382) * lu(1481) + lu(1503) = lu(1503) - lu(383) * lu(1481) + lu(1505) = lu(1505) - lu(384) * lu(1481) + lu(1507) = lu(1507) - lu(385) * lu(1481) + lu(1509) = lu(1509) - lu(386) * lu(1481) + lu(1510) = lu(1510) - lu(387) * lu(1481) + lu(1511) = lu(1511) - lu(388) * lu(1481) + lu(1512) = lu(1512) - lu(389) * lu(1481) + lu(1520) = - lu(377) * lu(1518) + lu(1523) = - lu(378) * lu(1518) + lu(1524) = lu(1524) - lu(379) * lu(1518) + lu(1528) = lu(1528) - lu(380) * lu(1518) + lu(1531) = lu(1531) - lu(381) * lu(1518) + lu(1533) = lu(1533) - lu(382) * lu(1518) + lu(1535) = - lu(383) * lu(1518) + lu(1537) = lu(1537) - lu(384) * lu(1518) + lu(1539) = lu(1539) - lu(385) * lu(1518) + lu(1541) = lu(1541) - lu(386) * lu(1518) + lu(1542) = lu(1542) - lu(387) * lu(1518) + lu(1543) = - lu(388) * lu(1518) + lu(1544) = lu(1544) - lu(389) * lu(1518) + lu(1555) = lu(1555) - lu(377) * lu(1550) + lu(1558) = lu(1558) - lu(378) * lu(1550) + lu(1559) = lu(1559) - lu(379) * lu(1550) + lu(1563) = lu(1563) - lu(380) * lu(1550) + lu(1566) = lu(1566) - lu(381) * lu(1550) + lu(1568) = lu(1568) - lu(382) * lu(1550) + lu(1570) = lu(1570) - lu(383) * lu(1550) + lu(1572) = lu(1572) - lu(384) * lu(1550) + lu(1574) = lu(1574) - lu(385) * lu(1550) + lu(1576) = lu(1576) - lu(386) * lu(1550) + lu(1577) = lu(1577) - lu(387) * lu(1550) + lu(1578) = lu(1578) - lu(388) * lu(1550) + lu(1579) = lu(1579) - lu(389) * lu(1550) + lu(1593) = lu(1593) - lu(377) * lu(1587) + lu(1596) = - lu(378) * lu(1587) + lu(1597) = lu(1597) - lu(379) * lu(1587) + lu(1601) = lu(1601) - lu(380) * lu(1587) + lu(1604) = lu(1604) - lu(381) * lu(1587) + lu(1606) = lu(1606) - lu(382) * lu(1587) + lu(1608) = lu(1608) - lu(383) * lu(1587) + lu(1610) = lu(1610) - lu(384) * lu(1587) + lu(1612) = lu(1612) - lu(385) * lu(1587) + lu(1614) = lu(1614) - lu(386) * lu(1587) + lu(1615) = lu(1615) - lu(387) * lu(1587) + lu(1616) = lu(1616) - lu(388) * lu(1587) + lu(1617) = lu(1617) - lu(389) * lu(1587) + lu(390) = 1._r8 / lu(390) + lu(391) = lu(391) * lu(390) + lu(392) = lu(392) * lu(390) + lu(393) = lu(393) * lu(390) + lu(394) = lu(394) * lu(390) + lu(395) = lu(395) * lu(390) + lu(396) = lu(396) * lu(390) + lu(397) = lu(397) * lu(390) + lu(398) = lu(398) * lu(390) + lu(399) = lu(399) * lu(390) + lu(400) = lu(400) * lu(390) + lu(401) = lu(401) * lu(390) + lu(402) = lu(402) * lu(390) + lu(403) = lu(403) * lu(390) + lu(404) = lu(404) * lu(390) + lu(405) = lu(405) * lu(390) + lu(633) = lu(633) - lu(391) * lu(632) + lu(638) = lu(638) - lu(392) * lu(632) + lu(639) = lu(639) - lu(393) * lu(632) + lu(640) = lu(640) - lu(394) * lu(632) + lu(641) = - lu(395) * lu(632) + lu(642) = lu(642) - lu(396) * lu(632) + lu(643) = lu(643) - lu(397) * lu(632) + lu(645) = lu(645) - lu(398) * lu(632) + lu(647) = lu(647) - lu(399) * lu(632) + lu(648) = lu(648) - lu(400) * lu(632) + lu(649) = lu(649) - lu(401) * lu(632) + lu(651) = lu(651) - lu(402) * lu(632) + lu(654) = lu(654) - lu(403) * lu(632) + lu(655) = lu(655) - lu(404) * lu(632) + lu(656) = lu(656) - lu(405) * lu(632) + lu(805) = lu(805) - lu(391) * lu(804) + lu(817) = lu(817) - lu(392) * lu(804) + lu(818) = lu(818) - lu(393) * lu(804) + lu(819) = lu(819) - lu(394) * lu(804) + lu(820) = lu(820) - lu(395) * lu(804) + lu(821) = lu(821) - lu(396) * lu(804) + lu(822) = lu(822) - lu(397) * lu(804) + lu(825) = lu(825) - lu(398) * lu(804) + lu(828) = lu(828) - lu(399) * lu(804) + lu(829) = lu(829) - lu(400) * lu(804) + lu(830) = lu(830) - lu(401) * lu(804) + lu(832) = lu(832) - lu(402) * lu(804) + lu(837) = lu(837) - lu(403) * lu(804) + lu(838) = lu(838) - lu(404) * lu(804) + lu(839) = lu(839) - lu(405) * lu(804) + lu(848) = lu(848) - lu(391) * lu(847) + lu(859) = lu(859) - lu(392) * lu(847) + lu(860) = lu(860) - lu(393) * lu(847) + lu(861) = lu(861) - lu(394) * lu(847) + lu(862) = lu(862) - lu(395) * lu(847) + lu(863) = lu(863) - lu(396) * lu(847) + lu(864) = lu(864) - lu(397) * lu(847) + lu(867) = lu(867) - lu(398) * lu(847) + lu(870) = lu(870) - lu(399) * lu(847) + lu(871) = lu(871) - lu(400) * lu(847) + lu(872) = lu(872) - lu(401) * lu(847) + lu(874) = lu(874) - lu(402) * lu(847) + lu(879) = lu(879) - lu(403) * lu(847) + lu(880) = lu(880) - lu(404) * lu(847) + lu(881) = lu(881) - lu(405) * lu(847) + lu(893) = - lu(391) * lu(891) + lu(903) = lu(903) - lu(392) * lu(891) + lu(904) = lu(904) - lu(393) * lu(891) + lu(905) = lu(905) - lu(394) * lu(891) + lu(906) = lu(906) - lu(395) * lu(891) + lu(907) = lu(907) - lu(396) * lu(891) + lu(908) = lu(908) - lu(397) * lu(891) + lu(911) = lu(911) - lu(398) * lu(891) + lu(914) = lu(914) - lu(399) * lu(891) + lu(915) = lu(915) - lu(400) * lu(891) + lu(916) = lu(916) - lu(401) * lu(891) + lu(918) = lu(918) - lu(402) * lu(891) + lu(923) = lu(923) - lu(403) * lu(891) + lu(924) = lu(924) - lu(404) * lu(891) + lu(925) = lu(925) - lu(405) * lu(891) + lu(968) = lu(968) - lu(391) * lu(967) + lu(979) = lu(979) - lu(392) * lu(967) + lu(980) = lu(980) - lu(393) * lu(967) + lu(981) = lu(981) - lu(394) * lu(967) + lu(982) = lu(982) - lu(395) * lu(967) + lu(983) = lu(983) - lu(396) * lu(967) + lu(984) = lu(984) - lu(397) * lu(967) + lu(987) = lu(987) - lu(398) * lu(967) + lu(990) = lu(990) - lu(399) * lu(967) + lu(991) = lu(991) - lu(400) * lu(967) + lu(992) = lu(992) - lu(401) * lu(967) + lu(994) = lu(994) - lu(402) * lu(967) + lu(999) = lu(999) - lu(403) * lu(967) + lu(1000) = lu(1000) - lu(404) * lu(967) + lu(1001) = lu(1001) - lu(405) * lu(967) + lu(1010) = lu(1010) - lu(391) * lu(1009) + lu(1021) = lu(1021) - lu(392) * lu(1009) + lu(1022) = lu(1022) - lu(393) * lu(1009) + lu(1023) = lu(1023) - lu(394) * lu(1009) + lu(1024) = lu(1024) - lu(395) * lu(1009) + lu(1025) = lu(1025) - lu(396) * lu(1009) + lu(1026) = lu(1026) - lu(397) * lu(1009) + lu(1029) = lu(1029) - lu(398) * lu(1009) + lu(1032) = lu(1032) - lu(399) * lu(1009) + lu(1033) = lu(1033) - lu(400) * lu(1009) + lu(1034) = lu(1034) - lu(401) * lu(1009) + lu(1036) = lu(1036) - lu(402) * lu(1009) + lu(1041) = lu(1041) - lu(403) * lu(1009) + lu(1042) = lu(1042) - lu(404) * lu(1009) + lu(1043) = lu(1043) - lu(405) * lu(1009) + lu(1259) = lu(1259) - lu(391) * lu(1258) + lu(1271) = lu(1271) - lu(392) * lu(1258) + lu(1272) = lu(1272) - lu(393) * lu(1258) + lu(1273) = lu(1273) - lu(394) * lu(1258) + lu(1274) = lu(1274) - lu(395) * lu(1258) + lu(1275) = lu(1275) - lu(396) * lu(1258) + lu(1276) = lu(1276) - lu(397) * lu(1258) + lu(1279) = lu(1279) - lu(398) * lu(1258) + lu(1282) = lu(1282) - lu(399) * lu(1258) + lu(1283) = lu(1283) - lu(400) * lu(1258) + lu(1284) = lu(1284) - lu(401) * lu(1258) + lu(1286) = lu(1286) - lu(402) * lu(1258) + lu(1291) = lu(1291) - lu(403) * lu(1258) + lu(1292) = lu(1292) - lu(404) * lu(1258) + lu(1293) = lu(1293) - lu(405) * lu(1258) + lu(1343) = lu(1343) - lu(391) * lu(1342) + lu(1354) = lu(1354) - lu(392) * lu(1342) + lu(1355) = lu(1355) - lu(393) * lu(1342) + lu(1356) = lu(1356) - lu(394) * lu(1342) + lu(1357) = lu(1357) - lu(395) * lu(1342) + lu(1358) = lu(1358) - lu(396) * lu(1342) + lu(1359) = lu(1359) - lu(397) * lu(1342) + lu(1362) = lu(1362) - lu(398) * lu(1342) + lu(1365) = lu(1365) - lu(399) * lu(1342) + lu(1366) = lu(1366) - lu(400) * lu(1342) + lu(1367) = lu(1367) - lu(401) * lu(1342) + lu(1369) = lu(1369) - lu(402) * lu(1342) + lu(1374) = lu(1374) - lu(403) * lu(1342) + lu(1375) = lu(1375) - lu(404) * lu(1342) + lu(1376) = lu(1376) - lu(405) * lu(1342) + lu(1427) = lu(1427) - lu(391) * lu(1426) + lu(1438) = lu(1438) - lu(392) * lu(1426) + lu(1439) = lu(1439) - lu(393) * lu(1426) + lu(1440) = lu(1440) - lu(394) * lu(1426) + lu(1441) = lu(1441) - lu(395) * lu(1426) + lu(1442) = lu(1442) - lu(396) * lu(1426) + lu(1443) = lu(1443) - lu(397) * lu(1426) + lu(1446) = lu(1446) - lu(398) * lu(1426) + lu(1449) = lu(1449) - lu(399) * lu(1426) + lu(1450) = lu(1450) - lu(400) * lu(1426) + lu(1451) = lu(1451) - lu(401) * lu(1426) + lu(1453) = lu(1453) - lu(402) * lu(1426) + lu(1458) = lu(1458) - lu(403) * lu(1426) + lu(1459) = lu(1459) - lu(404) * lu(1426) + lu(1460) = lu(1460) - lu(405) * lu(1426) + lu(1627) = lu(1627) - lu(391) * lu(1625) + lu(1637) = - lu(392) * lu(1625) + lu(1638) = - lu(393) * lu(1625) + lu(1639) = lu(1639) - lu(394) * lu(1625) + lu(1640) = lu(1640) - lu(395) * lu(1625) + lu(1641) = - lu(396) * lu(1625) + lu(1642) = - lu(397) * lu(1625) + lu(1645) = lu(1645) - lu(398) * lu(1625) + lu(1648) = - lu(399) * lu(1625) + lu(1649) = lu(1649) - lu(400) * lu(1625) + lu(1650) = - lu(401) * lu(1625) + lu(1652) = - lu(402) * lu(1625) + lu(1657) = lu(1657) - lu(403) * lu(1625) + lu(1658) = lu(1658) - lu(404) * lu(1625) + lu(1659) = lu(1659) - lu(405) * lu(1625) end subroutine lu_fac10 - subroutine lu_fac11( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac11( lu ) 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,408) = lu(k,408) * lu(k,401) - lu(k,409) = lu(k,409) * lu(k,401) - lu(k,410) = lu(k,410) * lu(k,401) - lu(k,411) = lu(k,411) * lu(k,401) - lu(k,412) = lu(k,412) * lu(k,401) - lu(k,413) = lu(k,413) * lu(k,401) - lu(k,414) = lu(k,414) * lu(k,401) - lu(k,415) = lu(k,415) * lu(k,401) - lu(k,620) = - lu(k,402) * lu(k,617) - lu(k,622) = lu(k,622) - lu(k,403) * lu(k,617) - lu(k,624) = lu(k,624) - lu(k,404) * lu(k,617) - lu(k,628) = lu(k,628) - lu(k,405) * lu(k,617) - lu(k,629) = - lu(k,406) * lu(k,617) - lu(k,632) = lu(k,632) - lu(k,407) * lu(k,617) - lu(k,634) = lu(k,634) - lu(k,408) * lu(k,617) - lu(k,635) = lu(k,635) - lu(k,409) * lu(k,617) - lu(k,637) = lu(k,637) - lu(k,410) * lu(k,617) - lu(k,638) = lu(k,638) - lu(k,411) * lu(k,617) - lu(k,642) = - lu(k,412) * lu(k,617) - lu(k,643) = - lu(k,413) * lu(k,617) - lu(k,645) = lu(k,645) - lu(k,414) * lu(k,617) - lu(k,646) = lu(k,646) - lu(k,415) * lu(k,617) - lu(k,782) = lu(k,782) - lu(k,402) * lu(k,778) - lu(k,783) = lu(k,783) - lu(k,403) * lu(k,778) - lu(k,785) = lu(k,785) - lu(k,404) * lu(k,778) - lu(k,789) = lu(k,789) - lu(k,405) * lu(k,778) - lu(k,790) = - lu(k,406) * lu(k,778) - lu(k,793) = lu(k,793) - lu(k,407) * lu(k,778) - lu(k,796) = lu(k,796) - lu(k,408) * lu(k,778) - lu(k,797) = lu(k,797) - lu(k,409) * lu(k,778) - lu(k,799) = lu(k,799) - lu(k,410) * lu(k,778) - lu(k,800) = - lu(k,411) * lu(k,778) - lu(k,804) = lu(k,804) - lu(k,412) * lu(k,778) - lu(k,805) = lu(k,805) - lu(k,413) * lu(k,778) - lu(k,807) = lu(k,807) - lu(k,414) * lu(k,778) - lu(k,808) = lu(k,808) - lu(k,415) * lu(k,778) - lu(k,971) = lu(k,971) - lu(k,402) * lu(k,964) - lu(k,973) = lu(k,973) - lu(k,403) * lu(k,964) - lu(k,975) = lu(k,975) - lu(k,404) * lu(k,964) - lu(k,979) = lu(k,979) - lu(k,405) * lu(k,964) - lu(k,980) = lu(k,980) - lu(k,406) * lu(k,964) - lu(k,983) = lu(k,983) - lu(k,407) * lu(k,964) - lu(k,986) = lu(k,986) - lu(k,408) * lu(k,964) - lu(k,987) = lu(k,987) - lu(k,409) * lu(k,964) - lu(k,989) = lu(k,989) - lu(k,410) * lu(k,964) - lu(k,990) = lu(k,990) - lu(k,411) * lu(k,964) - lu(k,994) = lu(k,994) - lu(k,412) * lu(k,964) - lu(k,995) = lu(k,995) - lu(k,413) * lu(k,964) - lu(k,997) = lu(k,997) - lu(k,414) * lu(k,964) - lu(k,998) = lu(k,998) - lu(k,415) * lu(k,964) - lu(k,1141) = lu(k,1141) - lu(k,402) * lu(k,1132) - lu(k,1143) = lu(k,1143) - lu(k,403) * lu(k,1132) - lu(k,1145) = lu(k,1145) - lu(k,404) * lu(k,1132) - lu(k,1149) = lu(k,1149) - lu(k,405) * lu(k,1132) - lu(k,1150) = lu(k,1150) - lu(k,406) * lu(k,1132) - lu(k,1153) = lu(k,1153) - lu(k,407) * lu(k,1132) - lu(k,1156) = lu(k,1156) - lu(k,408) * lu(k,1132) - lu(k,1157) = lu(k,1157) - lu(k,409) * lu(k,1132) - lu(k,1159) = lu(k,1159) - lu(k,410) * lu(k,1132) - lu(k,1160) = lu(k,1160) - lu(k,411) * lu(k,1132) - lu(k,1164) = lu(k,1164) - lu(k,412) * lu(k,1132) - lu(k,1165) = lu(k,1165) - lu(k,413) * lu(k,1132) - lu(k,1167) = lu(k,1167) - lu(k,414) * lu(k,1132) - lu(k,1168) = lu(k,1168) - lu(k,415) * lu(k,1132) - lu(k,1262) = - lu(k,402) * lu(k,1259) - lu(k,1264) = - lu(k,403) * lu(k,1259) - lu(k,1266) = lu(k,1266) - lu(k,404) * lu(k,1259) - lu(k,1270) = lu(k,1270) - lu(k,405) * lu(k,1259) - lu(k,1271) = lu(k,1271) - lu(k,406) * lu(k,1259) - lu(k,1274) = lu(k,1274) - lu(k,407) * lu(k,1259) - lu(k,1277) = lu(k,1277) - lu(k,408) * lu(k,1259) - lu(k,1278) = lu(k,1278) - lu(k,409) * lu(k,1259) - lu(k,1280) = lu(k,1280) - lu(k,410) * lu(k,1259) - lu(k,1281) = lu(k,1281) - lu(k,411) * lu(k,1259) - lu(k,1285) = - lu(k,412) * lu(k,1259) - lu(k,1286) = lu(k,1286) - lu(k,413) * lu(k,1259) - lu(k,1288) = lu(k,1288) - lu(k,414) * lu(k,1259) - lu(k,1289) = lu(k,1289) - lu(k,415) * lu(k,1259) - lu(k,1298) = lu(k,1298) - lu(k,402) * lu(k,1295) - lu(k,1300) = lu(k,1300) - lu(k,403) * lu(k,1295) - lu(k,1302) = - lu(k,404) * lu(k,1295) - lu(k,1306) = lu(k,1306) - lu(k,405) * lu(k,1295) - lu(k,1307) = lu(k,1307) - lu(k,406) * lu(k,1295) - lu(k,1310) = lu(k,1310) - lu(k,407) * lu(k,1295) - lu(k,1313) = lu(k,1313) - lu(k,408) * lu(k,1295) - lu(k,1314) = lu(k,1314) - lu(k,409) * lu(k,1295) - lu(k,1316) = lu(k,1316) - lu(k,410) * lu(k,1295) - lu(k,1317) = lu(k,1317) - lu(k,411) * lu(k,1295) - lu(k,1321) = - lu(k,412) * lu(k,1295) - lu(k,1322) = lu(k,1322) - lu(k,413) * lu(k,1295) - lu(k,1324) = lu(k,1324) - lu(k,414) * lu(k,1295) - lu(k,1325) = lu(k,1325) - lu(k,415) * lu(k,1295) - lu(k,1385) = - lu(k,402) * lu(k,1382) - lu(k,1387) = - lu(k,403) * lu(k,1382) - lu(k,1389) = lu(k,1389) - lu(k,404) * lu(k,1382) - lu(k,1393) = lu(k,1393) - lu(k,405) * lu(k,1382) - lu(k,1394) = lu(k,1394) - lu(k,406) * lu(k,1382) - lu(k,1397) = lu(k,1397) - lu(k,407) * lu(k,1382) - lu(k,1400) = lu(k,1400) - lu(k,408) * lu(k,1382) - lu(k,1401) = lu(k,1401) - lu(k,409) * lu(k,1382) - lu(k,1403) = lu(k,1403) - lu(k,410) * lu(k,1382) - lu(k,1404) = lu(k,1404) - lu(k,411) * lu(k,1382) - lu(k,1408) = lu(k,1408) - lu(k,412) * lu(k,1382) - lu(k,1409) = lu(k,1409) - lu(k,413) * lu(k,1382) - lu(k,1411) = lu(k,1411) - lu(k,414) * lu(k,1382) - lu(k,1412) = lu(k,1412) - lu(k,415) * lu(k,1382) - lu(k,1423) = lu(k,1423) - lu(k,402) * lu(k,1418) - lu(k,1425) = lu(k,1425) - lu(k,403) * lu(k,1418) - lu(k,1427) = - lu(k,404) * lu(k,1418) - lu(k,1431) = lu(k,1431) - lu(k,405) * lu(k,1418) - lu(k,1432) = lu(k,1432) - lu(k,406) * lu(k,1418) - lu(k,1435) = lu(k,1435) - lu(k,407) * lu(k,1418) - lu(k,1438) = lu(k,1438) - lu(k,408) * lu(k,1418) - lu(k,1439) = lu(k,1439) - lu(k,409) * lu(k,1418) - lu(k,1441) = lu(k,1441) - lu(k,410) * lu(k,1418) - lu(k,1442) = lu(k,1442) - lu(k,411) * lu(k,1418) - lu(k,1446) = lu(k,1446) - lu(k,412) * lu(k,1418) - lu(k,1447) = lu(k,1447) - lu(k,413) * lu(k,1418) - lu(k,1449) = lu(k,1449) - lu(k,414) * lu(k,1418) - lu(k,1450) = lu(k,1450) - lu(k,415) * lu(k,1418) - lu(k,1587) = - lu(k,402) * lu(k,1585) - lu(k,1589) = lu(k,1589) - lu(k,403) * lu(k,1585) - lu(k,1591) = - lu(k,404) * lu(k,1585) - lu(k,1595) = lu(k,1595) - lu(k,405) * lu(k,1585) - lu(k,1596) = lu(k,1596) - lu(k,406) * lu(k,1585) - lu(k,1599) = lu(k,1599) - lu(k,407) * lu(k,1585) - lu(k,1602) = lu(k,1602) - lu(k,408) * lu(k,1585) - lu(k,1603) = - lu(k,409) * lu(k,1585) - lu(k,1605) = lu(k,1605) - lu(k,410) * lu(k,1585) - lu(k,1606) = lu(k,1606) - lu(k,411) * lu(k,1585) - lu(k,1610) = lu(k,1610) - lu(k,412) * lu(k,1585) - lu(k,1611) = - lu(k,413) * lu(k,1585) - lu(k,1613) = lu(k,1613) - lu(k,414) * lu(k,1585) - lu(k,1614) = lu(k,1614) - lu(k,415) * lu(k,1585) - lu(k,1623) = lu(k,1623) - lu(k,402) * lu(k,1618) - lu(k,1625) = lu(k,1625) - lu(k,403) * lu(k,1618) - lu(k,1627) = lu(k,1627) - lu(k,404) * lu(k,1618) - lu(k,1631) = lu(k,1631) - lu(k,405) * lu(k,1618) - lu(k,1632) = lu(k,1632) - lu(k,406) * lu(k,1618) - lu(k,1635) = lu(k,1635) - lu(k,407) * lu(k,1618) - lu(k,1638) = lu(k,1638) - lu(k,408) * lu(k,1618) - lu(k,1639) = lu(k,1639) - lu(k,409) * lu(k,1618) - lu(k,1641) = lu(k,1641) - lu(k,410) * lu(k,1618) - lu(k,1642) = lu(k,1642) - lu(k,411) * lu(k,1618) - lu(k,1646) = lu(k,1646) - lu(k,412) * lu(k,1618) - lu(k,1647) = lu(k,1647) - lu(k,413) * lu(k,1618) - lu(k,1649) = lu(k,1649) - lu(k,414) * lu(k,1618) - lu(k,1650) = lu(k,1650) - lu(k,415) * lu(k,1618) - lu(k,1702) = - lu(k,402) * lu(k,1696) - lu(k,1704) = lu(k,1704) - lu(k,403) * lu(k,1696) - lu(k,1706) = lu(k,1706) - lu(k,404) * lu(k,1696) - lu(k,1710) = lu(k,1710) - lu(k,405) * lu(k,1696) - lu(k,1711) = lu(k,1711) - lu(k,406) * lu(k,1696) - lu(k,1714) = - lu(k,407) * lu(k,1696) - lu(k,1717) = lu(k,1717) - lu(k,408) * lu(k,1696) - lu(k,1718) = lu(k,1718) - lu(k,409) * lu(k,1696) - lu(k,1720) = lu(k,1720) - lu(k,410) * lu(k,1696) - lu(k,1721) = lu(k,1721) - lu(k,411) * lu(k,1696) - lu(k,1725) = lu(k,1725) - lu(k,412) * lu(k,1696) - lu(k,1726) = - lu(k,413) * lu(k,1696) - lu(k,1728) = lu(k,1728) - lu(k,414) * lu(k,1696) - lu(k,1729) = lu(k,1729) - lu(k,415) * lu(k,1696) - lu(k,1744) = lu(k,1744) - lu(k,402) * lu(k,1737) - lu(k,1746) = lu(k,1746) - lu(k,403) * lu(k,1737) - lu(k,1748) = lu(k,1748) - lu(k,404) * lu(k,1737) - lu(k,1752) = lu(k,1752) - lu(k,405) * lu(k,1737) - lu(k,1753) = lu(k,1753) - lu(k,406) * lu(k,1737) - lu(k,1756) = lu(k,1756) - lu(k,407) * lu(k,1737) - lu(k,1759) = lu(k,1759) - lu(k,408) * lu(k,1737) - lu(k,1760) = - lu(k,409) * lu(k,1737) - lu(k,1762) = lu(k,1762) - lu(k,410) * lu(k,1737) - lu(k,1763) = lu(k,1763) - lu(k,411) * lu(k,1737) - lu(k,1767) = - lu(k,412) * lu(k,1737) - lu(k,1768) = lu(k,1768) - lu(k,413) * lu(k,1737) - lu(k,1770) = lu(k,1770) - lu(k,414) * lu(k,1737) - lu(k,1771) = lu(k,1771) - lu(k,415) * lu(k,1737) - lu(k,419) = 1._r8 / lu(k,419) - lu(k,420) = lu(k,420) * lu(k,419) - lu(k,421) = lu(k,421) * lu(k,419) - lu(k,422) = lu(k,422) * lu(k,419) - lu(k,423) = lu(k,423) * lu(k,419) - lu(k,424) = lu(k,424) * lu(k,419) - lu(k,425) = lu(k,425) * lu(k,419) - lu(k,426) = lu(k,426) * lu(k,419) - lu(k,427) = lu(k,427) * lu(k,419) - lu(k,428) = lu(k,428) * lu(k,419) - lu(k,429) = lu(k,429) * lu(k,419) - lu(k,430) = lu(k,430) * lu(k,419) - lu(k,431) = lu(k,431) * lu(k,419) - lu(k,432) = lu(k,432) * lu(k,419) - lu(k,433) = lu(k,433) * lu(k,419) - lu(k,434) = lu(k,434) * lu(k,419) - lu(k,435) = lu(k,435) * lu(k,419) - lu(k,436) = lu(k,436) * lu(k,419) - lu(k,437) = lu(k,437) * lu(k,419) - lu(k,541) = lu(k,541) - lu(k,420) * lu(k,539) - lu(k,542) = lu(k,542) - lu(k,421) * lu(k,539) - lu(k,543) = lu(k,543) - lu(k,422) * lu(k,539) - lu(k,544) = lu(k,544) - lu(k,423) * lu(k,539) - lu(k,545) = lu(k,545) - lu(k,424) * lu(k,539) - lu(k,546) = - lu(k,425) * lu(k,539) - lu(k,547) = lu(k,547) - lu(k,426) * lu(k,539) - lu(k,548) = - lu(k,427) * lu(k,539) - lu(k,549) = lu(k,549) - lu(k,428) * lu(k,539) - lu(k,550) = lu(k,550) - lu(k,429) * lu(k,539) - lu(k,553) = lu(k,553) - lu(k,430) * lu(k,539) - lu(k,554) = - lu(k,431) * lu(k,539) - lu(k,555) = - lu(k,432) * lu(k,539) - lu(k,556) = - lu(k,433) * lu(k,539) - lu(k,557) = lu(k,557) - lu(k,434) * lu(k,539) - lu(k,558) = lu(k,558) - lu(k,435) * lu(k,539) - lu(k,559) = - lu(k,436) * lu(k,539) - lu(k,560) = lu(k,560) - lu(k,437) * lu(k,539) - lu(k,572) = lu(k,572) - lu(k,420) * lu(k,570) - lu(k,573) = lu(k,573) - lu(k,421) * lu(k,570) - lu(k,574) = lu(k,574) - lu(k,422) * lu(k,570) - lu(k,575) = lu(k,575) - lu(k,423) * lu(k,570) - lu(k,577) = lu(k,577) - lu(k,424) * lu(k,570) - lu(k,578) = lu(k,578) - lu(k,425) * lu(k,570) - lu(k,579) = lu(k,579) - lu(k,426) * lu(k,570) - lu(k,580) = lu(k,580) - lu(k,427) * lu(k,570) - lu(k,581) = lu(k,581) - lu(k,428) * lu(k,570) - lu(k,582) = lu(k,582) - lu(k,429) * lu(k,570) - lu(k,587) = lu(k,587) - lu(k,430) * lu(k,570) - lu(k,588) = lu(k,588) - lu(k,431) * lu(k,570) - lu(k,589) = - lu(k,432) * lu(k,570) - lu(k,590) = lu(k,590) - lu(k,433) * lu(k,570) - lu(k,591) = lu(k,591) - lu(k,434) * lu(k,570) - lu(k,592) = lu(k,592) - lu(k,435) * lu(k,570) - lu(k,593) = lu(k,593) - lu(k,436) * lu(k,570) - lu(k,594) = lu(k,594) - lu(k,437) * lu(k,570) - lu(k,684) = lu(k,684) - lu(k,420) * lu(k,682) - lu(k,685) = lu(k,685) - lu(k,421) * lu(k,682) - lu(k,686) = lu(k,686) - lu(k,422) * lu(k,682) - lu(k,687) = lu(k,687) - lu(k,423) * lu(k,682) - lu(k,689) = lu(k,689) - lu(k,424) * lu(k,682) - lu(k,690) = lu(k,690) - lu(k,425) * lu(k,682) - lu(k,692) = - lu(k,426) * lu(k,682) - lu(k,693) = lu(k,693) - lu(k,427) * lu(k,682) - lu(k,694) = lu(k,694) - lu(k,428) * lu(k,682) - lu(k,695) = lu(k,695) - lu(k,429) * lu(k,682) - lu(k,700) = lu(k,700) - lu(k,430) * lu(k,682) - lu(k,701) = lu(k,701) - lu(k,431) * lu(k,682) - lu(k,702) = - lu(k,432) * lu(k,682) - lu(k,703) = - lu(k,433) * lu(k,682) - lu(k,704) = lu(k,704) - lu(k,434) * lu(k,682) - lu(k,705) = lu(k,705) - lu(k,435) * lu(k,682) - lu(k,706) = lu(k,706) - lu(k,436) * lu(k,682) - lu(k,707) = lu(k,707) - lu(k,437) * lu(k,682) - lu(k,752) = lu(k,752) - lu(k,420) * lu(k,750) - lu(k,753) = lu(k,753) - lu(k,421) * lu(k,750) - lu(k,754) = lu(k,754) - lu(k,422) * lu(k,750) - lu(k,755) = lu(k,755) - lu(k,423) * lu(k,750) - lu(k,758) = lu(k,758) - lu(k,424) * lu(k,750) - lu(k,759) = lu(k,759) - lu(k,425) * lu(k,750) - lu(k,761) = lu(k,761) - lu(k,426) * lu(k,750) - lu(k,762) = lu(k,762) - lu(k,427) * lu(k,750) - lu(k,763) = lu(k,763) - lu(k,428) * lu(k,750) - lu(k,764) = lu(k,764) - lu(k,429) * lu(k,750) - lu(k,769) = lu(k,769) - lu(k,430) * lu(k,750) - lu(k,770) = lu(k,770) - lu(k,431) * lu(k,750) - lu(k,771) = - lu(k,432) * lu(k,750) - lu(k,772) = - lu(k,433) * lu(k,750) - lu(k,773) = lu(k,773) - lu(k,434) * lu(k,750) - lu(k,774) = lu(k,774) - lu(k,435) * lu(k,750) - lu(k,775) = lu(k,775) - lu(k,436) * lu(k,750) - lu(k,776) = lu(k,776) - lu(k,437) * lu(k,750) - lu(k,967) = lu(k,967) - lu(k,420) * lu(k,965) - lu(k,968) = lu(k,968) - lu(k,421) * lu(k,965) - lu(k,972) = lu(k,972) - lu(k,422) * lu(k,965) - lu(k,974) = lu(k,974) - lu(k,423) * lu(k,965) - lu(k,979) = lu(k,979) - lu(k,424) * lu(k,965) - lu(k,980) = lu(k,980) - lu(k,425) * lu(k,965) - lu(k,982) = lu(k,982) - lu(k,426) * lu(k,965) - lu(k,983) = lu(k,983) - lu(k,427) * lu(k,965) - lu(k,985) = lu(k,985) - lu(k,428) * lu(k,965) - lu(k,986) = lu(k,986) - lu(k,429) * lu(k,965) - lu(k,991) = lu(k,991) - lu(k,430) * lu(k,965) - lu(k,992) = lu(k,992) - lu(k,431) * lu(k,965) - lu(k,994) = lu(k,994) - lu(k,432) * lu(k,965) - lu(k,995) = lu(k,995) - lu(k,433) * lu(k,965) - lu(k,996) = lu(k,996) - lu(k,434) * lu(k,965) - lu(k,997) = lu(k,997) - lu(k,435) * lu(k,965) - lu(k,998) = lu(k,998) - lu(k,436) * lu(k,965) - lu(k,999) = lu(k,999) - lu(k,437) * lu(k,965) - lu(k,1093) = lu(k,1093) - lu(k,420) * lu(k,1090) - lu(k,1094) = - lu(k,421) * lu(k,1090) - lu(k,1097) = lu(k,1097) - lu(k,422) * lu(k,1090) - lu(k,1099) = lu(k,1099) - lu(k,423) * lu(k,1090) - lu(k,1104) = - lu(k,424) * lu(k,1090) - lu(k,1105) = - lu(k,425) * lu(k,1090) - lu(k,1107) = lu(k,1107) - lu(k,426) * lu(k,1090) - lu(k,1108) = lu(k,1108) - lu(k,427) * lu(k,1090) - lu(k,1110) = lu(k,1110) - lu(k,428) * lu(k,1090) - lu(k,1111) = lu(k,1111) - lu(k,429) * lu(k,1090) - lu(k,1116) = lu(k,1116) - lu(k,430) * lu(k,1090) - lu(k,1117) = lu(k,1117) - lu(k,431) * lu(k,1090) - lu(k,1119) = - lu(k,432) * lu(k,1090) - lu(k,1120) = lu(k,1120) - lu(k,433) * lu(k,1090) - lu(k,1121) = lu(k,1121) - lu(k,434) * lu(k,1090) - lu(k,1122) = lu(k,1122) - lu(k,435) * lu(k,1090) - lu(k,1123) = lu(k,1123) - lu(k,436) * lu(k,1090) - lu(k,1124) = lu(k,1124) - lu(k,437) * lu(k,1090) - lu(k,1620) = - lu(k,420) * lu(k,1619) - lu(k,1621) = - lu(k,421) * lu(k,1619) - lu(k,1624) = - lu(k,422) * lu(k,1619) - lu(k,1626) = lu(k,1626) - lu(k,423) * lu(k,1619) - lu(k,1631) = lu(k,1631) - lu(k,424) * lu(k,1619) - lu(k,1632) = lu(k,1632) - lu(k,425) * lu(k,1619) - lu(k,1634) = lu(k,1634) - lu(k,426) * lu(k,1619) - lu(k,1635) = lu(k,1635) - lu(k,427) * lu(k,1619) - lu(k,1637) = - lu(k,428) * lu(k,1619) - lu(k,1638) = lu(k,1638) - lu(k,429) * lu(k,1619) - lu(k,1643) = lu(k,1643) - lu(k,430) * lu(k,1619) - lu(k,1644) = lu(k,1644) - lu(k,431) * lu(k,1619) - lu(k,1646) = lu(k,1646) - lu(k,432) * lu(k,1619) - lu(k,1647) = lu(k,1647) - lu(k,433) * lu(k,1619) - lu(k,1648) = lu(k,1648) - lu(k,434) * lu(k,1619) - lu(k,1649) = lu(k,1649) - lu(k,435) * lu(k,1619) - lu(k,1650) = lu(k,1650) - lu(k,436) * lu(k,1619) - lu(k,1651) = lu(k,1651) - lu(k,437) * lu(k,1619) - lu(k,1662) = lu(k,1662) - lu(k,420) * lu(k,1660) - lu(k,1663) = lu(k,1663) - lu(k,421) * lu(k,1660) - lu(k,1667) = lu(k,1667) - lu(k,422) * lu(k,1660) - lu(k,1669) = lu(k,1669) - lu(k,423) * lu(k,1660) - lu(k,1674) = lu(k,1674) - lu(k,424) * lu(k,1660) - lu(k,1675) = - lu(k,425) * lu(k,1660) - lu(k,1677) = lu(k,1677) - lu(k,426) * lu(k,1660) - lu(k,1678) = lu(k,1678) - lu(k,427) * lu(k,1660) - lu(k,1680) = lu(k,1680) - lu(k,428) * lu(k,1660) - lu(k,1681) = lu(k,1681) - lu(k,429) * lu(k,1660) - lu(k,1686) = lu(k,1686) - lu(k,430) * lu(k,1660) - lu(k,1687) = lu(k,1687) - lu(k,431) * lu(k,1660) - lu(k,1689) = lu(k,1689) - lu(k,432) * lu(k,1660) - lu(k,1690) = lu(k,1690) - lu(k,433) * lu(k,1660) - lu(k,1691) = lu(k,1691) - lu(k,434) * lu(k,1660) - lu(k,1692) = lu(k,1692) - lu(k,435) * lu(k,1660) - lu(k,1693) = lu(k,1693) - lu(k,436) * lu(k,1660) - lu(k,1694) = lu(k,1694) - lu(k,437) * lu(k,1660) - lu(k,1698) = - lu(k,420) * lu(k,1697) - lu(k,1699) = - lu(k,421) * lu(k,1697) - lu(k,1703) = lu(k,1703) - lu(k,422) * lu(k,1697) - lu(k,1705) = lu(k,1705) - lu(k,423) * lu(k,1697) - lu(k,1710) = lu(k,1710) - lu(k,424) * lu(k,1697) - lu(k,1711) = lu(k,1711) - lu(k,425) * lu(k,1697) - lu(k,1713) = - lu(k,426) * lu(k,1697) - lu(k,1714) = lu(k,1714) - lu(k,427) * lu(k,1697) - lu(k,1716) = - lu(k,428) * lu(k,1697) - lu(k,1717) = lu(k,1717) - lu(k,429) * lu(k,1697) - lu(k,1722) = lu(k,1722) - lu(k,430) * lu(k,1697) - lu(k,1723) = - lu(k,431) * lu(k,1697) - lu(k,1725) = lu(k,1725) - lu(k,432) * lu(k,1697) - lu(k,1726) = lu(k,1726) - lu(k,433) * lu(k,1697) - lu(k,1727) = - lu(k,434) * lu(k,1697) - lu(k,1728) = lu(k,1728) - lu(k,435) * lu(k,1697) - lu(k,1729) = lu(k,1729) - lu(k,436) * lu(k,1697) - lu(k,1730) = lu(k,1730) - lu(k,437) * lu(k,1697) - lu(k,1794) = lu(k,1794) - lu(k,420) * lu(k,1790) - lu(k,1795) = lu(k,1795) - lu(k,421) * lu(k,1790) - lu(k,1798) = lu(k,1798) - lu(k,422) * lu(k,1790) - lu(k,1800) = lu(k,1800) - lu(k,423) * lu(k,1790) - lu(k,1805) = lu(k,1805) - lu(k,424) * lu(k,1790) - lu(k,1806) = lu(k,1806) - lu(k,425) * lu(k,1790) - lu(k,1808) = lu(k,1808) - lu(k,426) * lu(k,1790) - lu(k,1809) = lu(k,1809) - lu(k,427) * lu(k,1790) - lu(k,1811) = lu(k,1811) - lu(k,428) * lu(k,1790) - lu(k,1812) = lu(k,1812) - lu(k,429) * lu(k,1790) - lu(k,1817) = lu(k,1817) - lu(k,430) * lu(k,1790) - lu(k,1818) = lu(k,1818) - lu(k,431) * lu(k,1790) - lu(k,1820) = lu(k,1820) - lu(k,432) * lu(k,1790) - lu(k,1821) = lu(k,1821) - lu(k,433) * lu(k,1790) - lu(k,1822) = lu(k,1822) - lu(k,434) * lu(k,1790) - lu(k,1823) = lu(k,1823) - lu(k,435) * lu(k,1790) - lu(k,1824) = lu(k,1824) - lu(k,436) * lu(k,1790) - lu(k,1825) = lu(k,1825) - lu(k,437) * lu(k,1790) - end do + real(r8), intent(inout) :: lu(:) + lu(411) = 1._r8 / lu(411) + lu(412) = lu(412) * lu(411) + lu(413) = lu(413) * lu(411) + lu(414) = lu(414) * lu(411) + lu(415) = lu(415) * lu(411) + lu(416) = lu(416) * lu(411) + lu(417) = lu(417) * lu(411) + lu(418) = lu(418) * lu(411) + lu(419) = lu(419) * lu(411) + lu(420) = lu(420) * lu(411) + lu(421) = lu(421) * lu(411) + lu(422) = lu(422) * lu(411) + lu(423) = lu(423) * lu(411) + lu(424) = lu(424) * lu(411) + lu(425) = lu(425) * lu(411) + lu(426) = lu(426) * lu(411) + lu(427) = lu(427) * lu(411) + lu(529) = lu(529) - lu(412) * lu(527) + lu(530) = lu(530) - lu(413) * lu(527) + lu(531) = lu(531) - lu(414) * lu(527) + lu(532) = lu(532) - lu(415) * lu(527) + lu(533) = lu(533) - lu(416) * lu(527) + lu(534) = lu(534) - lu(417) * lu(527) + lu(535) = - lu(418) * lu(527) + lu(536) = - lu(419) * lu(527) + lu(537) = lu(537) - lu(420) * lu(527) + lu(538) = lu(538) - lu(421) * lu(527) + lu(539) = - lu(422) * lu(527) + lu(541) = lu(541) - lu(423) * lu(527) + lu(544) = lu(544) - lu(424) * lu(527) + lu(545) = lu(545) - lu(425) * lu(527) + lu(546) = lu(546) - lu(426) * lu(527) + lu(547) = lu(547) - lu(427) * lu(527) + lu(559) = lu(559) - lu(412) * lu(557) + lu(560) = lu(560) - lu(413) * lu(557) + lu(561) = lu(561) - lu(414) * lu(557) + lu(562) = lu(562) - lu(415) * lu(557) + lu(563) = lu(563) - lu(416) * lu(557) + lu(564) = lu(564) - lu(417) * lu(557) + lu(566) = lu(566) - lu(418) * lu(557) + lu(567) = lu(567) - lu(419) * lu(557) + lu(568) = lu(568) - lu(420) * lu(557) + lu(569) = lu(569) - lu(421) * lu(557) + lu(572) = lu(572) - lu(422) * lu(557) + lu(574) = lu(574) - lu(423) * lu(557) + lu(577) = lu(577) - lu(424) * lu(557) + lu(578) = lu(578) - lu(425) * lu(557) + lu(579) = lu(579) - lu(426) * lu(557) + lu(580) = lu(580) - lu(427) * lu(557) + lu(668) = lu(668) - lu(412) * lu(666) + lu(669) = lu(669) - lu(413) * lu(666) + lu(670) = lu(670) - lu(414) * lu(666) + lu(671) = lu(671) - lu(415) * lu(666) + lu(672) = lu(672) - lu(416) * lu(666) + lu(673) = lu(673) - lu(417) * lu(666) + lu(676) = lu(676) - lu(418) * lu(666) + lu(677) = lu(677) - lu(419) * lu(666) + lu(678) = lu(678) - lu(420) * lu(666) + lu(679) = lu(679) - lu(421) * lu(666) + lu(682) = lu(682) - lu(422) * lu(666) + lu(684) = lu(684) - lu(423) * lu(666) + lu(687) = lu(687) - lu(424) * lu(666) + lu(688) = - lu(425) * lu(666) + lu(689) = lu(689) - lu(426) * lu(666) + lu(690) = lu(690) - lu(427) * lu(666) + lu(708) = lu(708) - lu(412) * lu(706) + lu(709) = lu(709) - lu(413) * lu(706) + lu(710) = lu(710) - lu(414) * lu(706) + lu(711) = lu(711) - lu(415) * lu(706) + lu(713) = lu(713) - lu(416) * lu(706) + lu(714) = lu(714) - lu(417) * lu(706) + lu(717) = lu(717) - lu(418) * lu(706) + lu(718) = lu(718) - lu(419) * lu(706) + lu(719) = lu(719) - lu(420) * lu(706) + lu(720) = lu(720) - lu(421) * lu(706) + lu(723) = lu(723) - lu(422) * lu(706) + lu(725) = lu(725) - lu(423) * lu(706) + lu(728) = lu(728) - lu(424) * lu(706) + lu(729) = lu(729) - lu(425) * lu(706) + lu(730) = lu(730) - lu(426) * lu(706) + lu(731) = lu(731) - lu(427) * lu(706) + lu(894) = lu(894) - lu(412) * lu(892) + lu(895) = lu(895) - lu(413) * lu(892) + lu(899) = lu(899) - lu(414) * lu(892) + lu(900) = lu(900) - lu(415) * lu(892) + lu(905) = lu(905) - lu(416) * lu(892) + lu(906) = lu(906) - lu(417) * lu(892) + lu(909) = lu(909) - lu(418) * lu(892) + lu(910) = lu(910) - lu(419) * lu(892) + lu(911) = lu(911) - lu(420) * lu(892) + lu(912) = lu(912) - lu(421) * lu(892) + lu(915) = lu(915) - lu(422) * lu(892) + lu(919) = lu(919) - lu(423) * lu(892) + lu(922) = lu(922) - lu(424) * lu(892) + lu(923) = lu(923) - lu(425) * lu(892) + lu(924) = lu(924) - lu(426) * lu(892) + lu(925) = lu(925) - lu(427) * lu(892) + lu(1057) = lu(1057) - lu(412) * lu(1052) + lu(1058) = lu(1058) - lu(413) * lu(1052) + lu(1061) = lu(1061) - lu(414) * lu(1052) + lu(1062) = lu(1062) - lu(415) * lu(1052) + lu(1067) = lu(1067) - lu(416) * lu(1052) + lu(1068) = lu(1068) - lu(417) * lu(1052) + lu(1071) = lu(1071) - lu(418) * lu(1052) + lu(1072) = lu(1072) - lu(419) * lu(1052) + lu(1073) = lu(1073) - lu(420) * lu(1052) + lu(1074) = lu(1074) - lu(421) * lu(1052) + lu(1077) = lu(1077) - lu(422) * lu(1052) + lu(1081) = lu(1081) - lu(423) * lu(1052) + lu(1084) = lu(1084) - lu(424) * lu(1052) + lu(1085) = lu(1085) - lu(425) * lu(1052) + lu(1086) = lu(1086) - lu(426) * lu(1052) + lu(1087) = lu(1087) - lu(427) * lu(1052) + lu(1098) = lu(1098) - lu(412) * lu(1097) + lu(1099) = lu(1099) - lu(413) * lu(1097) + lu(1103) = lu(1103) - lu(414) * lu(1097) + lu(1104) = lu(1104) - lu(415) * lu(1097) + lu(1109) = lu(1109) - lu(416) * lu(1097) + lu(1110) = lu(1110) - lu(417) * lu(1097) + lu(1113) = lu(1113) - lu(418) * lu(1097) + lu(1114) = lu(1114) - lu(419) * lu(1097) + lu(1115) = lu(1115) - lu(420) * lu(1097) + lu(1116) = lu(1116) - lu(421) * lu(1097) + lu(1119) = lu(1119) - lu(422) * lu(1097) + lu(1123) = lu(1123) - lu(423) * lu(1097) + lu(1126) = lu(1126) - lu(424) * lu(1097) + lu(1127) = lu(1127) - lu(425) * lu(1097) + lu(1128) = lu(1128) - lu(426) * lu(1097) + lu(1129) = lu(1129) - lu(427) * lu(1097) + lu(1183) = lu(1183) - lu(412) * lu(1181) + lu(1184) = lu(1184) - lu(413) * lu(1181) + lu(1188) = lu(1188) - lu(414) * lu(1181) + lu(1189) = lu(1189) - lu(415) * lu(1181) + lu(1194) = lu(1194) - lu(416) * lu(1181) + lu(1195) = lu(1195) - lu(417) * lu(1181) + lu(1198) = lu(1198) - lu(418) * lu(1181) + lu(1199) = lu(1199) - lu(419) * lu(1181) + lu(1200) = lu(1200) - lu(420) * lu(1181) + lu(1201) = lu(1201) - lu(421) * lu(1181) + lu(1204) = lu(1204) - lu(422) * lu(1181) + lu(1208) = lu(1208) - lu(423) * lu(1181) + lu(1211) = lu(1211) - lu(424) * lu(1181) + lu(1212) = lu(1212) - lu(425) * lu(1181) + lu(1213) = lu(1213) - lu(426) * lu(1181) + lu(1214) = lu(1214) - lu(427) * lu(1181) + lu(1304) = lu(1304) - lu(412) * lu(1301) + lu(1305) = lu(1305) - lu(413) * lu(1301) + lu(1308) = lu(1308) - lu(414) * lu(1301) + lu(1309) = lu(1309) - lu(415) * lu(1301) + lu(1314) = - lu(416) * lu(1301) + lu(1315) = lu(1315) - lu(417) * lu(1301) + lu(1318) = lu(1318) - lu(418) * lu(1301) + lu(1319) = lu(1319) - lu(419) * lu(1301) + lu(1320) = lu(1320) - lu(420) * lu(1301) + lu(1321) = lu(1321) - lu(421) * lu(1301) + lu(1324) = lu(1324) - lu(422) * lu(1301) + lu(1328) = lu(1328) - lu(423) * lu(1301) + lu(1331) = lu(1331) - lu(424) * lu(1301) + lu(1332) = - lu(425) * lu(1301) + lu(1333) = lu(1333) - lu(426) * lu(1301) + lu(1334) = lu(1334) - lu(427) * lu(1301) + lu(1484) = lu(1484) - lu(412) * lu(1482) + lu(1485) = lu(1485) - lu(413) * lu(1482) + lu(1489) = lu(1489) - lu(414) * lu(1482) + lu(1490) = lu(1490) - lu(415) * lu(1482) + lu(1495) = lu(1495) - lu(416) * lu(1482) + lu(1496) = lu(1496) - lu(417) * lu(1482) + lu(1499) = lu(1499) - lu(418) * lu(1482) + lu(1500) = lu(1500) - lu(419) * lu(1482) + lu(1501) = lu(1501) - lu(420) * lu(1482) + lu(1502) = lu(1502) - lu(421) * lu(1482) + lu(1505) = lu(1505) - lu(422) * lu(1482) + lu(1509) = lu(1509) - lu(423) * lu(1482) + lu(1512) = lu(1512) - lu(424) * lu(1482) + lu(1513) = lu(1513) - lu(425) * lu(1482) + lu(1514) = lu(1514) - lu(426) * lu(1482) + lu(1515) = lu(1515) - lu(427) * lu(1482) + lu(1589) = lu(1589) - lu(412) * lu(1588) + lu(1590) = lu(1590) - lu(413) * lu(1588) + lu(1594) = lu(1594) - lu(414) * lu(1588) + lu(1595) = lu(1595) - lu(415) * lu(1588) + lu(1600) = - lu(416) * lu(1588) + lu(1601) = lu(1601) - lu(417) * lu(1588) + lu(1604) = lu(1604) - lu(418) * lu(1588) + lu(1605) = lu(1605) - lu(419) * lu(1588) + lu(1606) = lu(1606) - lu(420) * lu(1588) + lu(1607) = lu(1607) - lu(421) * lu(1588) + lu(1610) = lu(1610) - lu(422) * lu(1588) + lu(1614) = lu(1614) - lu(423) * lu(1588) + lu(1617) = lu(1617) - lu(424) * lu(1588) + lu(1618) = - lu(425) * lu(1588) + lu(1619) = lu(1619) - lu(426) * lu(1588) + lu(1620) = lu(1620) - lu(427) * lu(1588) + lu(431) = 1._r8 / lu(431) + lu(432) = lu(432) * lu(431) + lu(433) = lu(433) * lu(431) + lu(434) = lu(434) * lu(431) + lu(435) = lu(435) * lu(431) + lu(436) = lu(436) * lu(431) + lu(437) = lu(437) * lu(431) + lu(438) = lu(438) * lu(431) + lu(439) = lu(439) * lu(431) + lu(440) = lu(440) * lu(431) + lu(441) = lu(441) * lu(431) + lu(442) = lu(442) * lu(431) + lu(443) = lu(443) * lu(431) + lu(444) = lu(444) * lu(431) + lu(445) = lu(445) * lu(431) + lu(446) = lu(446) * lu(431) + lu(447) = lu(447) * lu(431) + lu(448) = lu(448) * lu(431) + lu(449) = lu(449) * lu(431) + lu(529) = lu(529) - lu(432) * lu(528) + lu(530) = lu(530) - lu(433) * lu(528) + lu(531) = lu(531) - lu(434) * lu(528) + lu(532) = lu(532) - lu(435) * lu(528) + lu(533) = lu(533) - lu(436) * lu(528) + lu(534) = lu(534) - lu(437) * lu(528) + lu(535) = lu(535) - lu(438) * lu(528) + lu(536) = lu(536) - lu(439) * lu(528) + lu(537) = lu(537) - lu(440) * lu(528) + lu(538) = lu(538) - lu(441) * lu(528) + lu(539) = lu(539) - lu(442) * lu(528) + lu(540) = - lu(443) * lu(528) + lu(541) = lu(541) - lu(444) * lu(528) + lu(542) = - lu(445) * lu(528) + lu(543) = - lu(446) * lu(528) + lu(545) = lu(545) - lu(447) * lu(528) + lu(546) = lu(546) - lu(448) * lu(528) + lu(547) = lu(547) - lu(449) * lu(528) + lu(559) = lu(559) - lu(432) * lu(558) + lu(560) = lu(560) - lu(433) * lu(558) + lu(561) = lu(561) - lu(434) * lu(558) + lu(562) = lu(562) - lu(435) * lu(558) + lu(563) = lu(563) - lu(436) * lu(558) + lu(564) = lu(564) - lu(437) * lu(558) + lu(566) = lu(566) - lu(438) * lu(558) + lu(567) = lu(567) - lu(439) * lu(558) + lu(568) = lu(568) - lu(440) * lu(558) + lu(569) = lu(569) - lu(441) * lu(558) + lu(572) = lu(572) - lu(442) * lu(558) + lu(573) = lu(573) - lu(443) * lu(558) + lu(574) = lu(574) - lu(444) * lu(558) + lu(575) = - lu(445) * lu(558) + lu(576) = lu(576) - lu(446) * lu(558) + lu(578) = lu(578) - lu(447) * lu(558) + lu(579) = lu(579) - lu(448) * lu(558) + lu(580) = lu(580) - lu(449) * lu(558) + lu(668) = lu(668) - lu(432) * lu(667) + lu(669) = lu(669) - lu(433) * lu(667) + lu(670) = lu(670) - lu(434) * lu(667) + lu(671) = lu(671) - lu(435) * lu(667) + lu(672) = lu(672) - lu(436) * lu(667) + lu(673) = lu(673) - lu(437) * lu(667) + lu(676) = lu(676) - lu(438) * lu(667) + lu(677) = lu(677) - lu(439) * lu(667) + lu(678) = lu(678) - lu(440) * lu(667) + lu(679) = lu(679) - lu(441) * lu(667) + lu(682) = lu(682) - lu(442) * lu(667) + lu(683) = lu(683) - lu(443) * lu(667) + lu(684) = lu(684) - lu(444) * lu(667) + lu(685) = - lu(445) * lu(667) + lu(686) = - lu(446) * lu(667) + lu(688) = lu(688) - lu(447) * lu(667) + lu(689) = lu(689) - lu(448) * lu(667) + lu(690) = lu(690) - lu(449) * lu(667) + lu(708) = lu(708) - lu(432) * lu(707) + lu(709) = lu(709) - lu(433) * lu(707) + lu(710) = lu(710) - lu(434) * lu(707) + lu(711) = lu(711) - lu(435) * lu(707) + lu(713) = lu(713) - lu(436) * lu(707) + lu(714) = lu(714) - lu(437) * lu(707) + lu(717) = lu(717) - lu(438) * lu(707) + lu(718) = lu(718) - lu(439) * lu(707) + lu(719) = lu(719) - lu(440) * lu(707) + lu(720) = lu(720) - lu(441) * lu(707) + lu(723) = lu(723) - lu(442) * lu(707) + lu(724) = lu(724) - lu(443) * lu(707) + lu(725) = lu(725) - lu(444) * lu(707) + lu(726) = - lu(445) * lu(707) + lu(727) = - lu(446) * lu(707) + lu(729) = lu(729) - lu(447) * lu(707) + lu(730) = lu(730) - lu(448) * lu(707) + lu(731) = lu(731) - lu(449) * lu(707) + lu(929) = - lu(432) * lu(928) + lu(930) = - lu(433) * lu(928) + lu(934) = lu(934) - lu(434) * lu(928) + lu(935) = lu(935) - lu(435) * lu(928) + lu(940) = lu(940) - lu(436) * lu(928) + lu(941) = lu(941) - lu(437) * lu(928) + lu(944) = lu(944) - lu(438) * lu(928) + lu(945) = - lu(439) * lu(928) + lu(946) = lu(946) - lu(440) * lu(928) + lu(947) = - lu(441) * lu(928) + lu(950) = lu(950) - lu(442) * lu(928) + lu(952) = lu(952) - lu(443) * lu(928) + lu(954) = lu(954) - lu(444) * lu(928) + lu(955) = lu(955) - lu(445) * lu(928) + lu(956) = lu(956) - lu(446) * lu(928) + lu(958) = - lu(447) * lu(928) + lu(959) = - lu(448) * lu(928) + lu(960) = lu(960) - lu(449) * lu(928) + lu(1183) = lu(1183) - lu(432) * lu(1182) + lu(1184) = lu(1184) - lu(433) * lu(1182) + lu(1188) = lu(1188) - lu(434) * lu(1182) + lu(1189) = lu(1189) - lu(435) * lu(1182) + lu(1194) = lu(1194) - lu(436) * lu(1182) + lu(1195) = lu(1195) - lu(437) * lu(1182) + lu(1198) = lu(1198) - lu(438) * lu(1182) + lu(1199) = lu(1199) - lu(439) * lu(1182) + lu(1200) = lu(1200) - lu(440) * lu(1182) + lu(1201) = lu(1201) - lu(441) * lu(1182) + lu(1204) = lu(1204) - lu(442) * lu(1182) + lu(1206) = - lu(443) * lu(1182) + lu(1208) = lu(1208) - lu(444) * lu(1182) + lu(1209) = lu(1209) - lu(445) * lu(1182) + lu(1210) = lu(1210) - lu(446) * lu(1182) + lu(1212) = lu(1212) - lu(447) * lu(1182) + lu(1213) = lu(1213) - lu(448) * lu(1182) + lu(1214) = lu(1214) - lu(449) * lu(1182) + lu(1484) = lu(1484) - lu(432) * lu(1483) + lu(1485) = lu(1485) - lu(433) * lu(1483) + lu(1489) = lu(1489) - lu(434) * lu(1483) + lu(1490) = lu(1490) - lu(435) * lu(1483) + lu(1495) = lu(1495) - lu(436) * lu(1483) + lu(1496) = lu(1496) - lu(437) * lu(1483) + lu(1499) = lu(1499) - lu(438) * lu(1483) + lu(1500) = lu(1500) - lu(439) * lu(1483) + lu(1501) = lu(1501) - lu(440) * lu(1483) + lu(1502) = lu(1502) - lu(441) * lu(1483) + lu(1505) = lu(1505) - lu(442) * lu(1483) + lu(1507) = lu(1507) - lu(443) * lu(1483) + lu(1509) = lu(1509) - lu(444) * lu(1483) + lu(1510) = lu(1510) - lu(445) * lu(1483) + lu(1511) = lu(1511) - lu(446) * lu(1483) + lu(1513) = lu(1513) - lu(447) * lu(1483) + lu(1514) = lu(1514) - lu(448) * lu(1483) + lu(1515) = lu(1515) - lu(449) * lu(1483) + lu(1552) = - lu(432) * lu(1551) + lu(1553) = - lu(433) * lu(1551) + lu(1556) = - lu(434) * lu(1551) + lu(1557) = lu(1557) - lu(435) * lu(1551) + lu(1562) = lu(1562) - lu(436) * lu(1551) + lu(1563) = lu(1563) - lu(437) * lu(1551) + lu(1566) = lu(1566) - lu(438) * lu(1551) + lu(1567) = lu(1567) - lu(439) * lu(1551) + lu(1568) = lu(1568) - lu(440) * lu(1551) + lu(1569) = lu(1569) - lu(441) * lu(1551) + lu(1572) = lu(1572) - lu(442) * lu(1551) + lu(1574) = lu(1574) - lu(443) * lu(1551) + lu(1576) = lu(1576) - lu(444) * lu(1551) + lu(1577) = lu(1577) - lu(445) * lu(1551) + lu(1578) = lu(1578) - lu(446) * lu(1551) + lu(1580) = lu(1580) - lu(447) * lu(1551) + lu(1581) = - lu(448) * lu(1551) + lu(1582) = lu(1582) - lu(449) * lu(1551) + lu(1629) = lu(1629) - lu(432) * lu(1626) + lu(1630) = - lu(433) * lu(1626) + lu(1633) = lu(1633) - lu(434) * lu(1626) + lu(1634) = lu(1634) - lu(435) * lu(1626) + lu(1639) = lu(1639) - lu(436) * lu(1626) + lu(1640) = lu(1640) - lu(437) * lu(1626) + lu(1643) = lu(1643) - lu(438) * lu(1626) + lu(1644) = lu(1644) - lu(439) * lu(1626) + lu(1645) = lu(1645) - lu(440) * lu(1626) + lu(1646) = lu(1646) - lu(441) * lu(1626) + lu(1649) = lu(1649) - lu(442) * lu(1626) + lu(1651) = - lu(443) * lu(1626) + lu(1653) = - lu(444) * lu(1626) + lu(1654) = - lu(445) * lu(1626) + lu(1655) = lu(1655) - lu(446) * lu(1626) + lu(1657) = lu(1657) - lu(447) * lu(1626) + lu(1658) = lu(1658) - lu(448) * lu(1626) + lu(1659) = lu(1659) - lu(449) * lu(1626) + lu(1715) = lu(1715) - lu(432) * lu(1711) + lu(1716) = lu(1716) - lu(433) * lu(1711) + lu(1719) = lu(1719) - lu(434) * lu(1711) + lu(1720) = lu(1720) - lu(435) * lu(1711) + lu(1725) = lu(1725) - lu(436) * lu(1711) + lu(1726) = lu(1726) - lu(437) * lu(1711) + lu(1729) = lu(1729) - lu(438) * lu(1711) + lu(1730) = lu(1730) - lu(439) * lu(1711) + lu(1731) = lu(1731) - lu(440) * lu(1711) + lu(1732) = lu(1732) - lu(441) * lu(1711) + lu(1735) = lu(1735) - lu(442) * lu(1711) + lu(1737) = lu(1737) - lu(443) * lu(1711) + lu(1739) = lu(1739) - lu(444) * lu(1711) + lu(1740) = lu(1740) - lu(445) * lu(1711) + lu(1741) = lu(1741) - lu(446) * lu(1711) + lu(1743) = lu(1743) - lu(447) * lu(1711) + lu(1744) = lu(1744) - lu(448) * lu(1711) + lu(1745) = lu(1745) - lu(449) * lu(1711) end subroutine lu_fac11 - subroutine lu_fac12( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac12( lu ) 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,438) = 1._r8 / lu(k,438) - lu(k,439) = lu(k,439) * lu(k,438) - lu(k,440) = lu(k,440) * lu(k,438) - lu(k,441) = lu(k,441) * lu(k,438) - lu(k,442) = lu(k,442) * lu(k,438) - lu(k,443) = lu(k,443) * lu(k,438) - lu(k,444) = lu(k,444) * lu(k,438) - lu(k,445) = lu(k,445) * lu(k,438) - lu(k,446) = lu(k,446) * lu(k,438) - lu(k,447) = lu(k,447) * lu(k,438) - lu(k,448) = lu(k,448) * lu(k,438) - lu(k,449) = lu(k,449) * lu(k,438) - lu(k,450) = lu(k,450) * lu(k,438) - lu(k,451) = lu(k,451) * lu(k,438) - lu(k,479) = - lu(k,439) * lu(k,476) - lu(k,480) = lu(k,480) - lu(k,440) * lu(k,476) - lu(k,481) = lu(k,481) - lu(k,441) * lu(k,476) - lu(k,482) = lu(k,482) - lu(k,442) * lu(k,476) - lu(k,484) = lu(k,484) - lu(k,443) * lu(k,476) - lu(k,485) = lu(k,485) - lu(k,444) * lu(k,476) - lu(k,487) = lu(k,487) - lu(k,445) * lu(k,476) - lu(k,488) = lu(k,488) - lu(k,446) * lu(k,476) - lu(k,489) = lu(k,489) - lu(k,447) * lu(k,476) - lu(k,490) = lu(k,490) - lu(k,448) * lu(k,476) - lu(k,491) = lu(k,491) - lu(k,449) * lu(k,476) - lu(k,493) = lu(k,493) - lu(k,450) * lu(k,476) - lu(k,494) = lu(k,494) - lu(k,451) * lu(k,476) - lu(k,520) = lu(k,520) - lu(k,439) * lu(k,517) - lu(k,521) = lu(k,521) - lu(k,440) * lu(k,517) - lu(k,522) = lu(k,522) - lu(k,441) * lu(k,517) - lu(k,523) = lu(k,523) - lu(k,442) * lu(k,517) - lu(k,525) = lu(k,525) - lu(k,443) * lu(k,517) - lu(k,526) = lu(k,526) - lu(k,444) * lu(k,517) - lu(k,528) = lu(k,528) - lu(k,445) * lu(k,517) - lu(k,529) = lu(k,529) - lu(k,446) * lu(k,517) - lu(k,530) = lu(k,530) - lu(k,447) * lu(k,517) - lu(k,531) = lu(k,531) - lu(k,448) * lu(k,517) - lu(k,532) = lu(k,532) - lu(k,449) * lu(k,517) - lu(k,534) = lu(k,534) - lu(k,450) * lu(k,517) - lu(k,535) = lu(k,535) - lu(k,451) * lu(k,517) - lu(k,652) = lu(k,652) - lu(k,439) * lu(k,649) - lu(k,654) = lu(k,654) - lu(k,440) * lu(k,649) - lu(k,655) = lu(k,655) - lu(k,441) * lu(k,649) - lu(k,656) = lu(k,656) - lu(k,442) * lu(k,649) - lu(k,659) = lu(k,659) - lu(k,443) * lu(k,649) - lu(k,660) = lu(k,660) - lu(k,444) * lu(k,649) - lu(k,662) = lu(k,662) - lu(k,445) * lu(k,649) - lu(k,663) = lu(k,663) - lu(k,446) * lu(k,649) - lu(k,664) = lu(k,664) - lu(k,447) * lu(k,649) - lu(k,665) = lu(k,665) - lu(k,448) * lu(k,649) - lu(k,668) = lu(k,668) - lu(k,449) * lu(k,649) - lu(k,671) = lu(k,671) - lu(k,450) * lu(k,649) - lu(k,672) = lu(k,672) - lu(k,451) * lu(k,649) - lu(k,824) = lu(k,824) - lu(k,439) * lu(k,818) - lu(k,829) = lu(k,829) - lu(k,440) * lu(k,818) - lu(k,830) = lu(k,830) - lu(k,441) * lu(k,818) - lu(k,831) = lu(k,831) - lu(k,442) * lu(k,818) - lu(k,834) = lu(k,834) - lu(k,443) * lu(k,818) - lu(k,835) = lu(k,835) - lu(k,444) * lu(k,818) - lu(k,837) = lu(k,837) - lu(k,445) * lu(k,818) - lu(k,838) = lu(k,838) - lu(k,446) * lu(k,818) - lu(k,839) = lu(k,839) - lu(k,447) * lu(k,818) - lu(k,841) = lu(k,841) - lu(k,448) * lu(k,818) - lu(k,846) = lu(k,846) - lu(k,449) * lu(k,818) - lu(k,851) = lu(k,851) - lu(k,450) * lu(k,818) - lu(k,852) = lu(k,852) - lu(k,451) * lu(k,818) - lu(k,872) = lu(k,872) - lu(k,439) * lu(k,865) - lu(k,877) = lu(k,877) - lu(k,440) * lu(k,865) - lu(k,878) = lu(k,878) - lu(k,441) * lu(k,865) - lu(k,879) = lu(k,879) - lu(k,442) * lu(k,865) - lu(k,882) = lu(k,882) - lu(k,443) * lu(k,865) - lu(k,883) = lu(k,883) - lu(k,444) * lu(k,865) - lu(k,885) = lu(k,885) - lu(k,445) * lu(k,865) - lu(k,886) = lu(k,886) - lu(k,446) * lu(k,865) - lu(k,887) = lu(k,887) - lu(k,447) * lu(k,865) - lu(k,889) = lu(k,889) - lu(k,448) * lu(k,865) - lu(k,894) = lu(k,894) - lu(k,449) * lu(k,865) - lu(k,899) = lu(k,899) - lu(k,450) * lu(k,865) - lu(k,900) = lu(k,900) - lu(k,451) * lu(k,865) - lu(k,915) = lu(k,915) - lu(k,439) * lu(k,909) - lu(k,920) = lu(k,920) - lu(k,440) * lu(k,909) - lu(k,921) = lu(k,921) - lu(k,441) * lu(k,909) - lu(k,922) = lu(k,922) - lu(k,442) * lu(k,909) - lu(k,925) = lu(k,925) - lu(k,443) * lu(k,909) - lu(k,926) = lu(k,926) - lu(k,444) * lu(k,909) - lu(k,928) = lu(k,928) - lu(k,445) * lu(k,909) - lu(k,929) = lu(k,929) - lu(k,446) * lu(k,909) - lu(k,930) = lu(k,930) - lu(k,447) * lu(k,909) - lu(k,932) = lu(k,932) - lu(k,448) * lu(k,909) - lu(k,937) = lu(k,937) - lu(k,449) * lu(k,909) - lu(k,942) = lu(k,942) - lu(k,450) * lu(k,909) - lu(k,943) = lu(k,943) - lu(k,451) * lu(k,909) - lu(k,1056) = lu(k,1056) - lu(k,439) * lu(k,1050) - lu(k,1061) = lu(k,1061) - lu(k,440) * lu(k,1050) - lu(k,1062) = lu(k,1062) - lu(k,441) * lu(k,1050) - lu(k,1063) = lu(k,1063) - lu(k,442) * lu(k,1050) - lu(k,1066) = lu(k,1066) - lu(k,443) * lu(k,1050) - lu(k,1067) = lu(k,1067) - lu(k,444) * lu(k,1050) - lu(k,1069) = lu(k,1069) - lu(k,445) * lu(k,1050) - lu(k,1070) = lu(k,1070) - lu(k,446) * lu(k,1050) - lu(k,1071) = lu(k,1071) - lu(k,447) * lu(k,1050) - lu(k,1073) = lu(k,1073) - lu(k,448) * lu(k,1050) - lu(k,1078) = lu(k,1078) - lu(k,449) * lu(k,1050) - lu(k,1083) = lu(k,1083) - lu(k,450) * lu(k,1050) - lu(k,1084) = lu(k,1084) - lu(k,451) * lu(k,1050) - lu(k,1096) = lu(k,1096) - lu(k,439) * lu(k,1091) - lu(k,1101) = lu(k,1101) - lu(k,440) * lu(k,1091) - lu(k,1102) = lu(k,1102) - lu(k,441) * lu(k,1091) - lu(k,1103) = lu(k,1103) - lu(k,442) * lu(k,1091) - lu(k,1106) = lu(k,1106) - lu(k,443) * lu(k,1091) - lu(k,1107) = lu(k,1107) - lu(k,444) * lu(k,1091) - lu(k,1109) = lu(k,1109) - lu(k,445) * lu(k,1091) - lu(k,1110) = lu(k,1110) - lu(k,446) * lu(k,1091) - lu(k,1111) = lu(k,1111) - lu(k,447) * lu(k,1091) - lu(k,1113) = lu(k,1113) - lu(k,448) * lu(k,1091) - lu(k,1118) = lu(k,1118) - lu(k,449) * lu(k,1091) - lu(k,1123) = lu(k,1123) - lu(k,450) * lu(k,1091) - lu(k,1124) = lu(k,1124) - lu(k,451) * lu(k,1091) - lu(k,1141) = lu(k,1141) - lu(k,439) * lu(k,1133) - lu(k,1146) = - lu(k,440) * lu(k,1133) - lu(k,1147) = lu(k,1147) - lu(k,441) * lu(k,1133) - lu(k,1148) = - lu(k,442) * lu(k,1133) - lu(k,1151) = - lu(k,443) * lu(k,1133) - lu(k,1152) = lu(k,1152) - lu(k,444) * lu(k,1133) - lu(k,1154) = lu(k,1154) - lu(k,445) * lu(k,1133) - lu(k,1155) = lu(k,1155) - lu(k,446) * lu(k,1133) - lu(k,1156) = lu(k,1156) - lu(k,447) * lu(k,1133) - lu(k,1158) = lu(k,1158) - lu(k,448) * lu(k,1133) - lu(k,1163) = lu(k,1163) - lu(k,449) * lu(k,1133) - lu(k,1168) = lu(k,1168) - lu(k,450) * lu(k,1133) - lu(k,1169) = lu(k,1169) - lu(k,451) * lu(k,1133) - lu(k,1184) = lu(k,1184) - lu(k,439) * lu(k,1178) - lu(k,1189) = lu(k,1189) - lu(k,440) * lu(k,1178) - lu(k,1190) = lu(k,1190) - lu(k,441) * lu(k,1178) - lu(k,1191) = lu(k,1191) - lu(k,442) * lu(k,1178) - lu(k,1194) = lu(k,1194) - lu(k,443) * lu(k,1178) - lu(k,1195) = lu(k,1195) - lu(k,444) * lu(k,1178) - lu(k,1197) = lu(k,1197) - lu(k,445) * lu(k,1178) - lu(k,1198) = lu(k,1198) - lu(k,446) * lu(k,1178) - lu(k,1199) = lu(k,1199) - lu(k,447) * lu(k,1178) - lu(k,1201) = lu(k,1201) - lu(k,448) * lu(k,1178) - lu(k,1206) = lu(k,1206) - lu(k,449) * lu(k,1178) - lu(k,1211) = lu(k,1211) - lu(k,450) * lu(k,1178) - lu(k,1212) = lu(k,1212) - lu(k,451) * lu(k,1178) - lu(k,1220) = - lu(k,439) * lu(k,1215) - lu(k,1224) = - lu(k,440) * lu(k,1215) - lu(k,1225) = - lu(k,441) * lu(k,1215) - lu(k,1226) = - lu(k,442) * lu(k,1215) - lu(k,1229) = - lu(k,443) * lu(k,1215) - lu(k,1230) = lu(k,1230) - lu(k,444) * lu(k,1215) - lu(k,1232) = lu(k,1232) - lu(k,445) * lu(k,1215) - lu(k,1233) = lu(k,1233) - lu(k,446) * lu(k,1215) - lu(k,1234) = lu(k,1234) - lu(k,447) * lu(k,1215) - lu(k,1236) = - lu(k,448) * lu(k,1215) - lu(k,1241) = lu(k,1241) - lu(k,449) * lu(k,1215) - lu(k,1246) = lu(k,1246) - lu(k,450) * lu(k,1215) - lu(k,1247) = lu(k,1247) - lu(k,451) * lu(k,1215) - lu(k,1343) = lu(k,1343) - lu(k,439) * lu(k,1336) - lu(k,1348) = lu(k,1348) - lu(k,440) * lu(k,1336) - lu(k,1349) = lu(k,1349) - lu(k,441) * lu(k,1336) - lu(k,1350) = lu(k,1350) - lu(k,442) * lu(k,1336) - lu(k,1353) = lu(k,1353) - lu(k,443) * lu(k,1336) - lu(k,1354) = lu(k,1354) - lu(k,444) * lu(k,1336) - lu(k,1356) = lu(k,1356) - lu(k,445) * lu(k,1336) - lu(k,1357) = lu(k,1357) - lu(k,446) * lu(k,1336) - lu(k,1358) = lu(k,1358) - lu(k,447) * lu(k,1336) - lu(k,1360) = lu(k,1360) - lu(k,448) * lu(k,1336) - lu(k,1365) = lu(k,1365) - lu(k,449) * lu(k,1336) - lu(k,1370) = lu(k,1370) - lu(k,450) * lu(k,1336) - lu(k,1371) = lu(k,1371) - lu(k,451) * lu(k,1336) - lu(k,1468) = lu(k,1468) - lu(k,439) * lu(k,1462) - lu(k,1473) = lu(k,1473) - lu(k,440) * lu(k,1462) - lu(k,1474) = lu(k,1474) - lu(k,441) * lu(k,1462) - lu(k,1475) = lu(k,1475) - lu(k,442) * lu(k,1462) - lu(k,1478) = lu(k,1478) - lu(k,443) * lu(k,1462) - lu(k,1479) = lu(k,1479) - lu(k,444) * lu(k,1462) - lu(k,1481) = lu(k,1481) - lu(k,445) * lu(k,1462) - lu(k,1482) = lu(k,1482) - lu(k,446) * lu(k,1462) - lu(k,1483) = lu(k,1483) - lu(k,447) * lu(k,1462) - lu(k,1485) = lu(k,1485) - lu(k,448) * lu(k,1462) - lu(k,1490) = lu(k,1490) - lu(k,449) * lu(k,1462) - lu(k,1495) = lu(k,1495) - lu(k,450) * lu(k,1462) - lu(k,1496) = lu(k,1496) - lu(k,451) * lu(k,1462) - lu(k,1554) = lu(k,1554) - lu(k,439) * lu(k,1548) - lu(k,1559) = lu(k,1559) - lu(k,440) * lu(k,1548) - lu(k,1560) = lu(k,1560) - lu(k,441) * lu(k,1548) - lu(k,1561) = lu(k,1561) - lu(k,442) * lu(k,1548) - lu(k,1564) = lu(k,1564) - lu(k,443) * lu(k,1548) - lu(k,1565) = lu(k,1565) - lu(k,444) * lu(k,1548) - lu(k,1567) = lu(k,1567) - lu(k,445) * lu(k,1548) - lu(k,1568) = lu(k,1568) - lu(k,446) * lu(k,1548) - lu(k,1569) = lu(k,1569) - lu(k,447) * lu(k,1548) - lu(k,1571) = lu(k,1571) - lu(k,448) * lu(k,1548) - lu(k,1576) = lu(k,1576) - lu(k,449) * lu(k,1548) - lu(k,1581) = lu(k,1581) - lu(k,450) * lu(k,1548) - lu(k,1582) = lu(k,1582) - lu(k,451) * lu(k,1548) - lu(k,457) = 1._r8 / lu(k,457) - lu(k,458) = lu(k,458) * lu(k,457) - lu(k,459) = lu(k,459) * lu(k,457) - lu(k,460) = lu(k,460) * lu(k,457) - lu(k,461) = lu(k,461) * lu(k,457) - lu(k,462) = lu(k,462) * lu(k,457) - lu(k,463) = lu(k,463) * lu(k,457) - lu(k,464) = lu(k,464) * lu(k,457) - lu(k,465) = lu(k,465) * lu(k,457) - lu(k,466) = lu(k,466) * lu(k,457) - lu(k,467) = lu(k,467) * lu(k,457) - lu(k,468) = lu(k,468) * lu(k,457) - lu(k,469) = lu(k,469) * lu(k,457) - lu(k,470) = lu(k,470) * lu(k,457) - lu(k,471) = lu(k,471) * lu(k,457) - lu(k,472) = lu(k,472) * lu(k,457) - lu(k,473) = lu(k,473) * lu(k,457) - lu(k,474) = lu(k,474) * lu(k,457) - lu(k,541) = lu(k,541) - lu(k,458) * lu(k,540) - lu(k,542) = lu(k,542) - lu(k,459) * lu(k,540) - lu(k,543) = lu(k,543) - lu(k,460) * lu(k,540) - lu(k,544) = lu(k,544) - lu(k,461) * lu(k,540) - lu(k,545) = lu(k,545) - lu(k,462) * lu(k,540) - lu(k,547) = lu(k,547) - lu(k,463) * lu(k,540) - lu(k,548) = lu(k,548) - lu(k,464) * lu(k,540) - lu(k,549) = lu(k,549) - lu(k,465) * lu(k,540) - lu(k,550) = lu(k,550) - lu(k,466) * lu(k,540) - lu(k,551) = lu(k,551) - lu(k,467) * lu(k,540) - lu(k,552) = lu(k,552) - lu(k,468) * lu(k,540) - lu(k,553) = lu(k,553) - lu(k,469) * lu(k,540) - lu(k,554) = lu(k,554) - lu(k,470) * lu(k,540) - lu(k,557) = lu(k,557) - lu(k,471) * lu(k,540) - lu(k,558) = lu(k,558) - lu(k,472) * lu(k,540) - lu(k,559) = lu(k,559) - lu(k,473) * lu(k,540) - lu(k,560) = lu(k,560) - lu(k,474) * lu(k,540) - lu(k,572) = lu(k,572) - lu(k,458) * lu(k,571) - lu(k,573) = lu(k,573) - lu(k,459) * lu(k,571) - lu(k,574) = lu(k,574) - lu(k,460) * lu(k,571) - lu(k,575) = lu(k,575) - lu(k,461) * lu(k,571) - lu(k,577) = lu(k,577) - lu(k,462) * lu(k,571) - lu(k,579) = lu(k,579) - lu(k,463) * lu(k,571) - lu(k,580) = lu(k,580) - lu(k,464) * lu(k,571) - lu(k,581) = lu(k,581) - lu(k,465) * lu(k,571) - lu(k,582) = lu(k,582) - lu(k,466) * lu(k,571) - lu(k,585) = lu(k,585) - lu(k,467) * lu(k,571) - lu(k,586) = lu(k,586) - lu(k,468) * lu(k,571) - lu(k,587) = lu(k,587) - lu(k,469) * lu(k,571) - lu(k,588) = lu(k,588) - lu(k,470) * lu(k,571) - lu(k,591) = lu(k,591) - lu(k,471) * lu(k,571) - lu(k,592) = lu(k,592) - lu(k,472) * lu(k,571) - lu(k,593) = lu(k,593) - lu(k,473) * lu(k,571) - lu(k,594) = lu(k,594) - lu(k,474) * lu(k,571) - lu(k,684) = lu(k,684) - lu(k,458) * lu(k,683) - lu(k,685) = lu(k,685) - lu(k,459) * lu(k,683) - lu(k,686) = lu(k,686) - lu(k,460) * lu(k,683) - lu(k,687) = lu(k,687) - lu(k,461) * lu(k,683) - lu(k,689) = lu(k,689) - lu(k,462) * lu(k,683) - lu(k,692) = lu(k,692) - lu(k,463) * lu(k,683) - lu(k,693) = lu(k,693) - lu(k,464) * lu(k,683) - lu(k,694) = lu(k,694) - lu(k,465) * lu(k,683) - lu(k,695) = lu(k,695) - lu(k,466) * lu(k,683) - lu(k,698) = lu(k,698) - lu(k,467) * lu(k,683) - lu(k,699) = lu(k,699) - lu(k,468) * lu(k,683) - lu(k,700) = lu(k,700) - lu(k,469) * lu(k,683) - lu(k,701) = lu(k,701) - lu(k,470) * lu(k,683) - lu(k,704) = lu(k,704) - lu(k,471) * lu(k,683) - lu(k,705) = lu(k,705) - lu(k,472) * lu(k,683) - lu(k,706) = lu(k,706) - lu(k,473) * lu(k,683) - lu(k,707) = lu(k,707) - lu(k,474) * lu(k,683) - lu(k,752) = lu(k,752) - lu(k,458) * lu(k,751) - lu(k,753) = lu(k,753) - lu(k,459) * lu(k,751) - lu(k,754) = lu(k,754) - lu(k,460) * lu(k,751) - lu(k,755) = lu(k,755) - lu(k,461) * lu(k,751) - lu(k,758) = lu(k,758) - lu(k,462) * lu(k,751) - lu(k,761) = lu(k,761) - lu(k,463) * lu(k,751) - lu(k,762) = lu(k,762) - lu(k,464) * lu(k,751) - lu(k,763) = lu(k,763) - lu(k,465) * lu(k,751) - lu(k,764) = lu(k,764) - lu(k,466) * lu(k,751) - lu(k,767) = lu(k,767) - lu(k,467) * lu(k,751) - lu(k,768) = lu(k,768) - lu(k,468) * lu(k,751) - lu(k,769) = lu(k,769) - lu(k,469) * lu(k,751) - lu(k,770) = lu(k,770) - lu(k,470) * lu(k,751) - lu(k,773) = lu(k,773) - lu(k,471) * lu(k,751) - lu(k,774) = lu(k,774) - lu(k,472) * lu(k,751) - lu(k,775) = lu(k,775) - lu(k,473) * lu(k,751) - lu(k,776) = lu(k,776) - lu(k,474) * lu(k,751) - lu(k,967) = lu(k,967) - lu(k,458) * lu(k,966) - lu(k,968) = lu(k,968) - lu(k,459) * lu(k,966) - lu(k,972) = lu(k,972) - lu(k,460) * lu(k,966) - lu(k,974) = lu(k,974) - lu(k,461) * lu(k,966) - lu(k,979) = lu(k,979) - lu(k,462) * lu(k,966) - lu(k,982) = lu(k,982) - lu(k,463) * lu(k,966) - lu(k,983) = lu(k,983) - lu(k,464) * lu(k,966) - lu(k,985) = lu(k,985) - lu(k,465) * lu(k,966) - lu(k,986) = lu(k,986) - lu(k,466) * lu(k,966) - lu(k,989) = lu(k,989) - lu(k,467) * lu(k,966) - lu(k,990) = lu(k,990) - lu(k,468) * lu(k,966) - lu(k,991) = lu(k,991) - lu(k,469) * lu(k,966) - lu(k,992) = lu(k,992) - lu(k,470) * lu(k,966) - lu(k,996) = lu(k,996) - lu(k,471) * lu(k,966) - lu(k,997) = lu(k,997) - lu(k,472) * lu(k,966) - lu(k,998) = lu(k,998) - lu(k,473) * lu(k,966) - lu(k,999) = lu(k,999) - lu(k,474) * lu(k,966) - lu(k,1138) = lu(k,1138) - lu(k,458) * lu(k,1134) - lu(k,1139) = lu(k,1139) - lu(k,459) * lu(k,1134) - lu(k,1142) = lu(k,1142) - lu(k,460) * lu(k,1134) - lu(k,1144) = lu(k,1144) - lu(k,461) * lu(k,1134) - lu(k,1149) = lu(k,1149) - lu(k,462) * lu(k,1134) - lu(k,1152) = lu(k,1152) - lu(k,463) * lu(k,1134) - lu(k,1153) = lu(k,1153) - lu(k,464) * lu(k,1134) - lu(k,1155) = lu(k,1155) - lu(k,465) * lu(k,1134) - lu(k,1156) = lu(k,1156) - lu(k,466) * lu(k,1134) - lu(k,1159) = lu(k,1159) - lu(k,467) * lu(k,1134) - lu(k,1160) = lu(k,1160) - lu(k,468) * lu(k,1134) - lu(k,1161) = lu(k,1161) - lu(k,469) * lu(k,1134) - lu(k,1162) = lu(k,1162) - lu(k,470) * lu(k,1134) - lu(k,1166) = lu(k,1166) - lu(k,471) * lu(k,1134) - lu(k,1167) = lu(k,1167) - lu(k,472) * lu(k,1134) - lu(k,1168) = lu(k,1168) - lu(k,473) * lu(k,1134) - lu(k,1169) = lu(k,1169) - lu(k,474) * lu(k,1134) - lu(k,1420) = lu(k,1420) - lu(k,458) * lu(k,1419) - lu(k,1421) = lu(k,1421) - lu(k,459) * lu(k,1419) - lu(k,1424) = lu(k,1424) - lu(k,460) * lu(k,1419) - lu(k,1426) = lu(k,1426) - lu(k,461) * lu(k,1419) - lu(k,1431) = lu(k,1431) - lu(k,462) * lu(k,1419) - lu(k,1434) = - lu(k,463) * lu(k,1419) - lu(k,1435) = lu(k,1435) - lu(k,464) * lu(k,1419) - lu(k,1437) = lu(k,1437) - lu(k,465) * lu(k,1419) - lu(k,1438) = lu(k,1438) - lu(k,466) * lu(k,1419) - lu(k,1441) = lu(k,1441) - lu(k,467) * lu(k,1419) - lu(k,1442) = lu(k,1442) - lu(k,468) * lu(k,1419) - lu(k,1443) = - lu(k,469) * lu(k,1419) - lu(k,1444) = lu(k,1444) - lu(k,470) * lu(k,1419) - lu(k,1448) = lu(k,1448) - lu(k,471) * lu(k,1419) - lu(k,1449) = lu(k,1449) - lu(k,472) * lu(k,1419) - lu(k,1450) = lu(k,1450) - lu(k,473) * lu(k,1419) - lu(k,1451) = lu(k,1451) - lu(k,474) * lu(k,1419) - lu(k,1464) = lu(k,1464) - lu(k,458) * lu(k,1463) - lu(k,1465) = lu(k,1465) - lu(k,459) * lu(k,1463) - lu(k,1469) = lu(k,1469) - lu(k,460) * lu(k,1463) - lu(k,1471) = lu(k,1471) - lu(k,461) * lu(k,1463) - lu(k,1476) = lu(k,1476) - lu(k,462) * lu(k,1463) - lu(k,1479) = lu(k,1479) - lu(k,463) * lu(k,1463) - lu(k,1480) = lu(k,1480) - lu(k,464) * lu(k,1463) - lu(k,1482) = lu(k,1482) - lu(k,465) * lu(k,1463) - lu(k,1483) = lu(k,1483) - lu(k,466) * lu(k,1463) - lu(k,1486) = lu(k,1486) - lu(k,467) * lu(k,1463) - lu(k,1487) = lu(k,1487) - lu(k,468) * lu(k,1463) - lu(k,1488) = lu(k,1488) - lu(k,469) * lu(k,1463) - lu(k,1489) = lu(k,1489) - lu(k,470) * lu(k,1463) - lu(k,1493) = lu(k,1493) - lu(k,471) * lu(k,1463) - lu(k,1494) = lu(k,1494) - lu(k,472) * lu(k,1463) - lu(k,1495) = lu(k,1495) - lu(k,473) * lu(k,1463) - lu(k,1496) = lu(k,1496) - lu(k,474) * lu(k,1463) - lu(k,1507) = lu(k,1507) - lu(k,458) * lu(k,1506) - lu(k,1508) = lu(k,1508) - lu(k,459) * lu(k,1506) - lu(k,1512) = lu(k,1512) - lu(k,460) * lu(k,1506) - lu(k,1514) = lu(k,1514) - lu(k,461) * lu(k,1506) - lu(k,1519) = lu(k,1519) - lu(k,462) * lu(k,1506) - lu(k,1522) = lu(k,1522) - lu(k,463) * lu(k,1506) - lu(k,1523) = lu(k,1523) - lu(k,464) * lu(k,1506) - lu(k,1525) = lu(k,1525) - lu(k,465) * lu(k,1506) - lu(k,1526) = lu(k,1526) - lu(k,466) * lu(k,1506) - lu(k,1529) = lu(k,1529) - lu(k,467) * lu(k,1506) - lu(k,1530) = lu(k,1530) - lu(k,468) * lu(k,1506) - lu(k,1531) = lu(k,1531) - lu(k,469) * lu(k,1506) - lu(k,1532) = lu(k,1532) - lu(k,470) * lu(k,1506) - lu(k,1536) = lu(k,1536) - lu(k,471) * lu(k,1506) - lu(k,1537) = lu(k,1537) - lu(k,472) * lu(k,1506) - lu(k,1538) = lu(k,1538) - lu(k,473) * lu(k,1506) - lu(k,1539) = lu(k,1539) - lu(k,474) * lu(k,1506) - lu(k,1662) = lu(k,1662) - lu(k,458) * lu(k,1661) - lu(k,1663) = lu(k,1663) - lu(k,459) * lu(k,1661) - lu(k,1667) = lu(k,1667) - lu(k,460) * lu(k,1661) - lu(k,1669) = lu(k,1669) - lu(k,461) * lu(k,1661) - lu(k,1674) = lu(k,1674) - lu(k,462) * lu(k,1661) - lu(k,1677) = lu(k,1677) - lu(k,463) * lu(k,1661) - lu(k,1678) = lu(k,1678) - lu(k,464) * lu(k,1661) - lu(k,1680) = lu(k,1680) - lu(k,465) * lu(k,1661) - lu(k,1681) = lu(k,1681) - lu(k,466) * lu(k,1661) - lu(k,1684) = lu(k,1684) - lu(k,467) * lu(k,1661) - lu(k,1685) = lu(k,1685) - lu(k,468) * lu(k,1661) - lu(k,1686) = lu(k,1686) - lu(k,469) * lu(k,1661) - lu(k,1687) = lu(k,1687) - lu(k,470) * lu(k,1661) - lu(k,1691) = lu(k,1691) - lu(k,471) * lu(k,1661) - lu(k,1692) = lu(k,1692) - lu(k,472) * lu(k,1661) - lu(k,1693) = lu(k,1693) - lu(k,473) * lu(k,1661) - lu(k,1694) = lu(k,1694) - lu(k,474) * lu(k,1661) - lu(k,1741) = lu(k,1741) - lu(k,458) * lu(k,1738) - lu(k,1742) = lu(k,1742) - lu(k,459) * lu(k,1738) - lu(k,1745) = lu(k,1745) - lu(k,460) * lu(k,1738) - lu(k,1747) = lu(k,1747) - lu(k,461) * lu(k,1738) - lu(k,1752) = lu(k,1752) - lu(k,462) * lu(k,1738) - lu(k,1755) = - lu(k,463) * lu(k,1738) - lu(k,1756) = lu(k,1756) - lu(k,464) * lu(k,1738) - lu(k,1758) = lu(k,1758) - lu(k,465) * lu(k,1738) - lu(k,1759) = lu(k,1759) - lu(k,466) * lu(k,1738) - lu(k,1762) = lu(k,1762) - lu(k,467) * lu(k,1738) - lu(k,1763) = lu(k,1763) - lu(k,468) * lu(k,1738) - lu(k,1764) = - lu(k,469) * lu(k,1738) - lu(k,1765) = lu(k,1765) - lu(k,470) * lu(k,1738) - lu(k,1769) = lu(k,1769) - lu(k,471) * lu(k,1738) - lu(k,1770) = lu(k,1770) - lu(k,472) * lu(k,1738) - lu(k,1771) = lu(k,1771) - lu(k,473) * lu(k,1738) - lu(k,1772) = lu(k,1772) - lu(k,474) * lu(k,1738) - 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,490) = lu(k,490) * lu(k,477) - lu(k,491) = lu(k,491) * lu(k,477) - lu(k,492) = lu(k,492) * lu(k,477) - lu(k,493) = lu(k,493) * lu(k,477) - lu(k,494) = lu(k,494) * lu(k,477) - lu(k,519) = lu(k,519) - lu(k,478) * lu(k,518) - lu(k,520) = lu(k,520) - lu(k,479) * lu(k,518) - lu(k,521) = lu(k,521) - lu(k,480) * lu(k,518) - lu(k,522) = lu(k,522) - lu(k,481) * lu(k,518) - lu(k,523) = lu(k,523) - lu(k,482) * lu(k,518) - lu(k,524) = lu(k,524) - lu(k,483) * lu(k,518) - lu(k,525) = lu(k,525) - lu(k,484) * lu(k,518) - lu(k,526) = lu(k,526) - lu(k,485) * lu(k,518) - lu(k,527) = lu(k,527) - lu(k,486) * lu(k,518) - lu(k,528) = lu(k,528) - lu(k,487) * lu(k,518) - lu(k,529) = lu(k,529) - lu(k,488) * lu(k,518) - lu(k,530) = lu(k,530) - lu(k,489) * lu(k,518) - lu(k,531) = lu(k,531) - lu(k,490) * lu(k,518) - lu(k,532) = lu(k,532) - lu(k,491) * lu(k,518) - lu(k,533) = lu(k,533) - lu(k,492) * lu(k,518) - lu(k,534) = lu(k,534) - lu(k,493) * lu(k,518) - lu(k,535) = lu(k,535) - lu(k,494) * lu(k,518) - lu(k,821) = lu(k,821) - lu(k,478) * lu(k,819) - lu(k,824) = lu(k,824) - lu(k,479) * lu(k,819) - lu(k,829) = lu(k,829) - lu(k,480) * lu(k,819) - lu(k,830) = lu(k,830) - lu(k,481) * lu(k,819) - lu(k,831) = lu(k,831) - lu(k,482) * lu(k,819) - lu(k,832) = lu(k,832) - lu(k,483) * lu(k,819) - lu(k,834) = lu(k,834) - lu(k,484) * lu(k,819) - lu(k,835) = lu(k,835) - lu(k,485) * lu(k,819) - lu(k,836) = lu(k,836) - lu(k,486) * lu(k,819) - lu(k,837) = lu(k,837) - lu(k,487) * lu(k,819) - lu(k,838) = lu(k,838) - lu(k,488) * lu(k,819) - lu(k,839) = lu(k,839) - lu(k,489) * lu(k,819) - lu(k,841) = lu(k,841) - lu(k,490) * lu(k,819) - lu(k,846) = lu(k,846) - lu(k,491) * lu(k,819) - lu(k,850) = lu(k,850) - lu(k,492) * lu(k,819) - lu(k,851) = lu(k,851) - lu(k,493) * lu(k,819) - lu(k,852) = lu(k,852) - lu(k,494) * lu(k,819) - lu(k,868) = lu(k,868) - lu(k,478) * lu(k,866) - lu(k,872) = lu(k,872) - lu(k,479) * lu(k,866) - lu(k,877) = lu(k,877) - lu(k,480) * lu(k,866) - lu(k,878) = lu(k,878) - lu(k,481) * lu(k,866) - lu(k,879) = lu(k,879) - lu(k,482) * lu(k,866) - lu(k,880) = lu(k,880) - lu(k,483) * lu(k,866) - lu(k,882) = lu(k,882) - lu(k,484) * lu(k,866) - lu(k,883) = lu(k,883) - lu(k,485) * lu(k,866) - lu(k,884) = lu(k,884) - lu(k,486) * lu(k,866) - lu(k,885) = lu(k,885) - lu(k,487) * lu(k,866) - lu(k,886) = lu(k,886) - lu(k,488) * lu(k,866) - lu(k,887) = lu(k,887) - lu(k,489) * lu(k,866) - lu(k,889) = lu(k,889) - lu(k,490) * lu(k,866) - lu(k,894) = lu(k,894) - lu(k,491) * lu(k,866) - lu(k,898) = lu(k,898) - lu(k,492) * lu(k,866) - lu(k,899) = lu(k,899) - lu(k,493) * lu(k,866) - lu(k,900) = lu(k,900) - lu(k,494) * lu(k,866) - lu(k,912) = lu(k,912) - lu(k,478) * lu(k,910) - lu(k,915) = lu(k,915) - lu(k,479) * lu(k,910) - lu(k,920) = lu(k,920) - lu(k,480) * lu(k,910) - lu(k,921) = lu(k,921) - lu(k,481) * lu(k,910) - lu(k,922) = lu(k,922) - lu(k,482) * lu(k,910) - lu(k,923) = lu(k,923) - lu(k,483) * lu(k,910) - lu(k,925) = lu(k,925) - lu(k,484) * lu(k,910) - lu(k,926) = lu(k,926) - lu(k,485) * lu(k,910) - lu(k,927) = lu(k,927) - lu(k,486) * lu(k,910) - lu(k,928) = lu(k,928) - lu(k,487) * lu(k,910) - lu(k,929) = lu(k,929) - lu(k,488) * lu(k,910) - lu(k,930) = lu(k,930) - lu(k,489) * lu(k,910) - lu(k,932) = lu(k,932) - lu(k,490) * lu(k,910) - lu(k,937) = lu(k,937) - lu(k,491) * lu(k,910) - lu(k,941) = lu(k,941) - lu(k,492) * lu(k,910) - lu(k,942) = lu(k,942) - lu(k,493) * lu(k,910) - lu(k,943) = lu(k,943) - lu(k,494) * lu(k,910) - lu(k,1053) = lu(k,1053) - lu(k,478) * lu(k,1051) - lu(k,1056) = lu(k,1056) - lu(k,479) * lu(k,1051) - lu(k,1061) = lu(k,1061) - lu(k,480) * lu(k,1051) - lu(k,1062) = lu(k,1062) - lu(k,481) * lu(k,1051) - lu(k,1063) = lu(k,1063) - lu(k,482) * lu(k,1051) - lu(k,1064) = lu(k,1064) - lu(k,483) * lu(k,1051) - lu(k,1066) = lu(k,1066) - lu(k,484) * lu(k,1051) - lu(k,1067) = lu(k,1067) - lu(k,485) * lu(k,1051) - lu(k,1068) = lu(k,1068) - lu(k,486) * lu(k,1051) - lu(k,1069) = lu(k,1069) - lu(k,487) * lu(k,1051) - lu(k,1070) = lu(k,1070) - lu(k,488) * lu(k,1051) - lu(k,1071) = lu(k,1071) - lu(k,489) * lu(k,1051) - lu(k,1073) = lu(k,1073) - lu(k,490) * lu(k,1051) - lu(k,1078) = lu(k,1078) - lu(k,491) * lu(k,1051) - lu(k,1082) = lu(k,1082) - lu(k,492) * lu(k,1051) - lu(k,1083) = lu(k,1083) - lu(k,493) * lu(k,1051) - lu(k,1084) = lu(k,1084) - lu(k,494) * lu(k,1051) - lu(k,1137) = lu(k,1137) - lu(k,478) * lu(k,1135) - lu(k,1141) = lu(k,1141) - lu(k,479) * lu(k,1135) - lu(k,1146) = lu(k,1146) - lu(k,480) * lu(k,1135) - lu(k,1147) = lu(k,1147) - lu(k,481) * lu(k,1135) - lu(k,1148) = lu(k,1148) - lu(k,482) * lu(k,1135) - lu(k,1149) = lu(k,1149) - lu(k,483) * lu(k,1135) - lu(k,1151) = lu(k,1151) - lu(k,484) * lu(k,1135) - lu(k,1152) = lu(k,1152) - lu(k,485) * lu(k,1135) - lu(k,1153) = lu(k,1153) - lu(k,486) * lu(k,1135) - lu(k,1154) = lu(k,1154) - lu(k,487) * lu(k,1135) - lu(k,1155) = lu(k,1155) - lu(k,488) * lu(k,1135) - lu(k,1156) = lu(k,1156) - lu(k,489) * lu(k,1135) - lu(k,1158) = lu(k,1158) - lu(k,490) * lu(k,1135) - lu(k,1163) = lu(k,1163) - lu(k,491) * lu(k,1135) - lu(k,1167) = lu(k,1167) - lu(k,492) * lu(k,1135) - lu(k,1168) = lu(k,1168) - lu(k,493) * lu(k,1135) - lu(k,1169) = lu(k,1169) - lu(k,494) * lu(k,1135) - lu(k,1181) = lu(k,1181) - lu(k,478) * lu(k,1179) - lu(k,1184) = lu(k,1184) - lu(k,479) * lu(k,1179) - lu(k,1189) = lu(k,1189) - lu(k,480) * lu(k,1179) - lu(k,1190) = lu(k,1190) - lu(k,481) * lu(k,1179) - lu(k,1191) = lu(k,1191) - lu(k,482) * lu(k,1179) - lu(k,1192) = lu(k,1192) - lu(k,483) * lu(k,1179) - lu(k,1194) = lu(k,1194) - lu(k,484) * lu(k,1179) - lu(k,1195) = lu(k,1195) - lu(k,485) * lu(k,1179) - lu(k,1196) = lu(k,1196) - lu(k,486) * lu(k,1179) - lu(k,1197) = lu(k,1197) - lu(k,487) * lu(k,1179) - lu(k,1198) = lu(k,1198) - lu(k,488) * lu(k,1179) - lu(k,1199) = lu(k,1199) - lu(k,489) * lu(k,1179) - lu(k,1201) = lu(k,1201) - lu(k,490) * lu(k,1179) - lu(k,1206) = lu(k,1206) - lu(k,491) * lu(k,1179) - lu(k,1210) = lu(k,1210) - lu(k,492) * lu(k,1179) - lu(k,1211) = lu(k,1211) - lu(k,493) * lu(k,1179) - lu(k,1212) = lu(k,1212) - lu(k,494) * lu(k,1179) - lu(k,1217) = lu(k,1217) - lu(k,478) * lu(k,1216) - lu(k,1220) = lu(k,1220) - lu(k,479) * lu(k,1216) - lu(k,1224) = lu(k,1224) - lu(k,480) * lu(k,1216) - lu(k,1225) = lu(k,1225) - lu(k,481) * lu(k,1216) - lu(k,1226) = lu(k,1226) - lu(k,482) * lu(k,1216) - lu(k,1227) = lu(k,1227) - lu(k,483) * lu(k,1216) - lu(k,1229) = lu(k,1229) - lu(k,484) * lu(k,1216) - lu(k,1230) = lu(k,1230) - lu(k,485) * lu(k,1216) - lu(k,1231) = lu(k,1231) - lu(k,486) * lu(k,1216) - lu(k,1232) = lu(k,1232) - lu(k,487) * lu(k,1216) - lu(k,1233) = lu(k,1233) - lu(k,488) * lu(k,1216) - lu(k,1234) = lu(k,1234) - lu(k,489) * lu(k,1216) - lu(k,1236) = lu(k,1236) - lu(k,490) * lu(k,1216) - lu(k,1241) = lu(k,1241) - lu(k,491) * lu(k,1216) - lu(k,1245) = lu(k,1245) - lu(k,492) * lu(k,1216) - lu(k,1246) = lu(k,1246) - lu(k,493) * lu(k,1216) - lu(k,1247) = lu(k,1247) - lu(k,494) * lu(k,1216) - lu(k,1339) = lu(k,1339) - lu(k,478) * lu(k,1337) - lu(k,1343) = lu(k,1343) - lu(k,479) * lu(k,1337) - lu(k,1348) = lu(k,1348) - lu(k,480) * lu(k,1337) - lu(k,1349) = lu(k,1349) - lu(k,481) * lu(k,1337) - lu(k,1350) = lu(k,1350) - lu(k,482) * lu(k,1337) - lu(k,1351) = lu(k,1351) - lu(k,483) * lu(k,1337) - lu(k,1353) = lu(k,1353) - lu(k,484) * lu(k,1337) - lu(k,1354) = lu(k,1354) - lu(k,485) * lu(k,1337) - lu(k,1355) = lu(k,1355) - lu(k,486) * lu(k,1337) - lu(k,1356) = lu(k,1356) - lu(k,487) * lu(k,1337) - lu(k,1357) = lu(k,1357) - lu(k,488) * lu(k,1337) - lu(k,1358) = lu(k,1358) - lu(k,489) * lu(k,1337) - lu(k,1360) = lu(k,1360) - lu(k,490) * lu(k,1337) - lu(k,1365) = lu(k,1365) - lu(k,491) * lu(k,1337) - lu(k,1369) = lu(k,1369) - lu(k,492) * lu(k,1337) - lu(k,1370) = lu(k,1370) - lu(k,493) * lu(k,1337) - lu(k,1371) = lu(k,1371) - lu(k,494) * lu(k,1337) - lu(k,1551) = lu(k,1551) - lu(k,478) * lu(k,1549) - lu(k,1554) = lu(k,1554) - lu(k,479) * lu(k,1549) - lu(k,1559) = lu(k,1559) - lu(k,480) * lu(k,1549) - lu(k,1560) = lu(k,1560) - lu(k,481) * lu(k,1549) - lu(k,1561) = lu(k,1561) - lu(k,482) * lu(k,1549) - lu(k,1562) = lu(k,1562) - lu(k,483) * lu(k,1549) - lu(k,1564) = lu(k,1564) - lu(k,484) * lu(k,1549) - lu(k,1565) = lu(k,1565) - lu(k,485) * lu(k,1549) - lu(k,1566) = lu(k,1566) - lu(k,486) * lu(k,1549) - lu(k,1567) = lu(k,1567) - lu(k,487) * lu(k,1549) - lu(k,1568) = lu(k,1568) - lu(k,488) * lu(k,1549) - lu(k,1569) = lu(k,1569) - lu(k,489) * lu(k,1549) - lu(k,1571) = lu(k,1571) - lu(k,490) * lu(k,1549) - lu(k,1576) = lu(k,1576) - lu(k,491) * lu(k,1549) - lu(k,1580) = lu(k,1580) - lu(k,492) * lu(k,1549) - lu(k,1581) = lu(k,1581) - lu(k,493) * lu(k,1549) - lu(k,1582) = lu(k,1582) - lu(k,494) * lu(k,1549) - lu(k,1793) = lu(k,1793) - lu(k,478) * lu(k,1791) - lu(k,1797) = lu(k,1797) - lu(k,479) * lu(k,1791) - lu(k,1802) = lu(k,1802) - lu(k,480) * lu(k,1791) - lu(k,1803) = lu(k,1803) - lu(k,481) * lu(k,1791) - lu(k,1804) = lu(k,1804) - lu(k,482) * lu(k,1791) - lu(k,1805) = lu(k,1805) - lu(k,483) * lu(k,1791) - lu(k,1807) = lu(k,1807) - lu(k,484) * lu(k,1791) - lu(k,1808) = lu(k,1808) - lu(k,485) * lu(k,1791) - lu(k,1809) = lu(k,1809) - lu(k,486) * lu(k,1791) - lu(k,1810) = lu(k,1810) - lu(k,487) * lu(k,1791) - lu(k,1811) = lu(k,1811) - lu(k,488) * lu(k,1791) - lu(k,1812) = lu(k,1812) - lu(k,489) * lu(k,1791) - lu(k,1814) = lu(k,1814) - lu(k,490) * lu(k,1791) - lu(k,1819) = lu(k,1819) - lu(k,491) * lu(k,1791) - lu(k,1823) = lu(k,1823) - lu(k,492) * lu(k,1791) - lu(k,1824) = lu(k,1824) - lu(k,493) * lu(k,1791) - lu(k,1825) = lu(k,1825) - lu(k,494) * lu(k,1791) - end do + real(r8), intent(inout) :: lu(:) + lu(450) = 1._r8 / lu(450) + lu(451) = lu(451) * lu(450) + lu(452) = lu(452) * lu(450) + lu(453) = lu(453) * lu(450) + lu(454) = lu(454) * lu(450) + lu(455) = lu(455) * lu(450) + lu(456) = lu(456) * lu(450) + lu(457) = lu(457) * lu(450) + lu(458) = lu(458) * lu(450) + lu(459) = lu(459) * lu(450) + lu(460) = lu(460) * lu(450) + lu(461) = lu(461) * lu(450) + lu(462) = lu(462) * lu(450) + lu(463) = lu(463) * lu(450) + lu(468) = - lu(451) * lu(465) + lu(469) = lu(469) - lu(452) * lu(465) + lu(470) = lu(470) - lu(453) * lu(465) + lu(472) = lu(472) - lu(454) * lu(465) + lu(473) = lu(473) - lu(455) * lu(465) + lu(475) = lu(475) - lu(456) * lu(465) + lu(476) = lu(476) - lu(457) * lu(465) + lu(477) = lu(477) - lu(458) * lu(465) + lu(478) = lu(478) - lu(459) * lu(465) + lu(479) = lu(479) - lu(460) * lu(465) + lu(481) = lu(481) - lu(461) * lu(465) + lu(482) = lu(482) - lu(462) * lu(465) + lu(483) = lu(483) - lu(463) * lu(465) + lu(508) = lu(508) - lu(451) * lu(505) + lu(509) = lu(509) - lu(452) * lu(505) + lu(510) = lu(510) - lu(453) * lu(505) + lu(512) = lu(512) - lu(454) * lu(505) + lu(513) = lu(513) - lu(455) * lu(505) + lu(515) = lu(515) - lu(456) * lu(505) + lu(516) = lu(516) - lu(457) * lu(505) + lu(517) = lu(517) - lu(458) * lu(505) + lu(518) = lu(518) - lu(459) * lu(505) + lu(519) = lu(519) - lu(460) * lu(505) + lu(521) = lu(521) - lu(461) * lu(505) + lu(522) = lu(522) - lu(462) * lu(505) + lu(523) = lu(523) - lu(463) * lu(505) + lu(636) = lu(636) - lu(451) * lu(633) + lu(638) = lu(638) - lu(452) * lu(633) + lu(639) = lu(639) - lu(453) * lu(633) + lu(642) = lu(642) - lu(454) * lu(633) + lu(643) = lu(643) - lu(455) * lu(633) + lu(645) = lu(645) - lu(456) * lu(633) + lu(647) = lu(647) - lu(457) * lu(633) + lu(648) = lu(648) - lu(458) * lu(633) + lu(649) = lu(649) - lu(459) * lu(633) + lu(651) = lu(651) - lu(460) * lu(633) + lu(654) = lu(654) - lu(461) * lu(633) + lu(655) = lu(655) - lu(462) * lu(633) + lu(656) = lu(656) - lu(463) * lu(633) + lu(812) = lu(812) - lu(451) * lu(805) + lu(817) = lu(817) - lu(452) * lu(805) + lu(818) = lu(818) - lu(453) * lu(805) + lu(821) = lu(821) - lu(454) * lu(805) + lu(822) = lu(822) - lu(455) * lu(805) + lu(825) = lu(825) - lu(456) * lu(805) + lu(828) = lu(828) - lu(457) * lu(805) + lu(829) = lu(829) - lu(458) * lu(805) + lu(830) = lu(830) - lu(459) * lu(805) + lu(832) = lu(832) - lu(460) * lu(805) + lu(837) = lu(837) - lu(461) * lu(805) + lu(838) = lu(838) - lu(462) * lu(805) + lu(839) = lu(839) - lu(463) * lu(805) + lu(854) = lu(854) - lu(451) * lu(848) + lu(859) = lu(859) - lu(452) * lu(848) + lu(860) = lu(860) - lu(453) * lu(848) + lu(863) = lu(863) - lu(454) * lu(848) + lu(864) = lu(864) - lu(455) * lu(848) + lu(867) = lu(867) - lu(456) * lu(848) + lu(870) = lu(870) - lu(457) * lu(848) + lu(871) = lu(871) - lu(458) * lu(848) + lu(872) = lu(872) - lu(459) * lu(848) + lu(874) = lu(874) - lu(460) * lu(848) + lu(879) = lu(879) - lu(461) * lu(848) + lu(880) = lu(880) - lu(462) * lu(848) + lu(881) = lu(881) - lu(463) * lu(848) + lu(898) = lu(898) - lu(451) * lu(893) + lu(903) = lu(903) - lu(452) * lu(893) + lu(904) = lu(904) - lu(453) * lu(893) + lu(907) = lu(907) - lu(454) * lu(893) + lu(908) = lu(908) - lu(455) * lu(893) + lu(911) = lu(911) - lu(456) * lu(893) + lu(914) = lu(914) - lu(457) * lu(893) + lu(915) = lu(915) - lu(458) * lu(893) + lu(916) = lu(916) - lu(459) * lu(893) + lu(918) = lu(918) - lu(460) * lu(893) + lu(923) = lu(923) - lu(461) * lu(893) + lu(924) = lu(924) - lu(462) * lu(893) + lu(925) = lu(925) - lu(463) * lu(893) + lu(974) = lu(974) - lu(451) * lu(968) + lu(979) = lu(979) - lu(452) * lu(968) + lu(980) = lu(980) - lu(453) * lu(968) + lu(983) = lu(983) - lu(454) * lu(968) + lu(984) = lu(984) - lu(455) * lu(968) + lu(987) = lu(987) - lu(456) * lu(968) + lu(990) = lu(990) - lu(457) * lu(968) + lu(991) = lu(991) - lu(458) * lu(968) + lu(992) = lu(992) - lu(459) * lu(968) + lu(994) = lu(994) - lu(460) * lu(968) + lu(999) = lu(999) - lu(461) * lu(968) + lu(1000) = lu(1000) - lu(462) * lu(968) + lu(1001) = lu(1001) - lu(463) * lu(968) + lu(1016) = lu(1016) - lu(451) * lu(1010) + lu(1021) = lu(1021) - lu(452) * lu(1010) + lu(1022) = lu(1022) - lu(453) * lu(1010) + lu(1025) = lu(1025) - lu(454) * lu(1010) + lu(1026) = lu(1026) - lu(455) * lu(1010) + lu(1029) = lu(1029) - lu(456) * lu(1010) + lu(1032) = lu(1032) - lu(457) * lu(1010) + lu(1033) = lu(1033) - lu(458) * lu(1010) + lu(1034) = lu(1034) - lu(459) * lu(1010) + lu(1036) = lu(1036) - lu(460) * lu(1010) + lu(1041) = lu(1041) - lu(461) * lu(1010) + lu(1042) = lu(1042) - lu(462) * lu(1010) + lu(1043) = lu(1043) - lu(463) * lu(1010) + lu(1060) = lu(1060) - lu(451) * lu(1053) + lu(1065) = lu(1065) - lu(452) * lu(1053) + lu(1066) = - lu(453) * lu(1053) + lu(1069) = - lu(454) * lu(1053) + lu(1070) = - lu(455) * lu(1053) + lu(1073) = lu(1073) - lu(456) * lu(1053) + lu(1076) = lu(1076) - lu(457) * lu(1053) + lu(1077) = lu(1077) - lu(458) * lu(1053) + lu(1078) = lu(1078) - lu(459) * lu(1053) + lu(1080) = lu(1080) - lu(460) * lu(1053) + lu(1085) = lu(1085) - lu(461) * lu(1053) + lu(1086) = lu(1086) - lu(462) * lu(1053) + lu(1087) = lu(1087) - lu(463) * lu(1053) + lu(1266) = lu(1266) - lu(451) * lu(1259) + lu(1271) = lu(1271) - lu(452) * lu(1259) + lu(1272) = lu(1272) - lu(453) * lu(1259) + lu(1275) = lu(1275) - lu(454) * lu(1259) + lu(1276) = lu(1276) - lu(455) * lu(1259) + lu(1279) = lu(1279) - lu(456) * lu(1259) + lu(1282) = lu(1282) - lu(457) * lu(1259) + lu(1283) = lu(1283) - lu(458) * lu(1259) + lu(1284) = lu(1284) - lu(459) * lu(1259) + lu(1286) = lu(1286) - lu(460) * lu(1259) + lu(1291) = lu(1291) - lu(461) * lu(1259) + lu(1292) = lu(1292) - lu(462) * lu(1259) + lu(1293) = lu(1293) - lu(463) * lu(1259) + lu(1349) = lu(1349) - lu(451) * lu(1343) + lu(1354) = lu(1354) - lu(452) * lu(1343) + lu(1355) = lu(1355) - lu(453) * lu(1343) + lu(1358) = lu(1358) - lu(454) * lu(1343) + lu(1359) = lu(1359) - lu(455) * lu(1343) + lu(1362) = lu(1362) - lu(456) * lu(1343) + lu(1365) = lu(1365) - lu(457) * lu(1343) + lu(1366) = lu(1366) - lu(458) * lu(1343) + lu(1367) = lu(1367) - lu(459) * lu(1343) + lu(1369) = lu(1369) - lu(460) * lu(1343) + lu(1374) = lu(1374) - lu(461) * lu(1343) + lu(1375) = lu(1375) - lu(462) * lu(1343) + lu(1376) = lu(1376) - lu(463) * lu(1343) + lu(1433) = lu(1433) - lu(451) * lu(1427) + lu(1438) = lu(1438) - lu(452) * lu(1427) + lu(1439) = lu(1439) - lu(453) * lu(1427) + lu(1442) = lu(1442) - lu(454) * lu(1427) + lu(1443) = lu(1443) - lu(455) * lu(1427) + lu(1446) = lu(1446) - lu(456) * lu(1427) + lu(1449) = lu(1449) - lu(457) * lu(1427) + lu(1450) = lu(1450) - lu(458) * lu(1427) + lu(1451) = lu(1451) - lu(459) * lu(1427) + lu(1453) = lu(1453) - lu(460) * lu(1427) + lu(1458) = lu(1458) - lu(461) * lu(1427) + lu(1459) = lu(1459) - lu(462) * lu(1427) + lu(1460) = lu(1460) - lu(463) * lu(1427) + lu(1632) = lu(1632) - lu(451) * lu(1627) + lu(1637) = lu(1637) - lu(452) * lu(1627) + lu(1638) = lu(1638) - lu(453) * lu(1627) + lu(1641) = lu(1641) - lu(454) * lu(1627) + lu(1642) = lu(1642) - lu(455) * lu(1627) + lu(1645) = lu(1645) - lu(456) * lu(1627) + lu(1648) = lu(1648) - lu(457) * lu(1627) + lu(1649) = lu(1649) - lu(458) * lu(1627) + lu(1650) = lu(1650) - lu(459) * lu(1627) + lu(1652) = lu(1652) - lu(460) * lu(1627) + lu(1657) = lu(1657) - lu(461) * lu(1627) + lu(1658) = lu(1658) - lu(462) * lu(1627) + lu(1659) = lu(1659) - lu(463) * lu(1627) + lu(1667) = - lu(451) * lu(1662) + lu(1671) = - lu(452) * lu(1662) + lu(1672) = - lu(453) * lu(1662) + lu(1675) = - lu(454) * lu(1662) + lu(1676) = - lu(455) * lu(1662) + lu(1679) = lu(1679) - lu(456) * lu(1662) + lu(1682) = - lu(457) * lu(1662) + lu(1683) = lu(1683) - lu(458) * lu(1662) + lu(1684) = lu(1684) - lu(459) * lu(1662) + lu(1686) = lu(1686) - lu(460) * lu(1662) + lu(1691) = lu(1691) - lu(461) * lu(1662) + lu(1692) = lu(1692) - lu(462) * lu(1662) + lu(1693) = lu(1693) - lu(463) * lu(1662) + lu(466) = 1._r8 / lu(466) + lu(467) = lu(467) * lu(466) + lu(468) = lu(468) * lu(466) + lu(469) = lu(469) * lu(466) + lu(470) = lu(470) * lu(466) + lu(471) = lu(471) * lu(466) + lu(472) = lu(472) * lu(466) + lu(473) = lu(473) * lu(466) + lu(474) = lu(474) * lu(466) + lu(475) = lu(475) * lu(466) + lu(476) = lu(476) * lu(466) + lu(477) = lu(477) * lu(466) + lu(478) = lu(478) * lu(466) + lu(479) = lu(479) * lu(466) + lu(480) = lu(480) * lu(466) + lu(481) = lu(481) * lu(466) + lu(482) = lu(482) * lu(466) + lu(483) = lu(483) * lu(466) + lu(507) = lu(507) - lu(467) * lu(506) + lu(508) = lu(508) - lu(468) * lu(506) + lu(509) = lu(509) - lu(469) * lu(506) + lu(510) = lu(510) - lu(470) * lu(506) + lu(511) = lu(511) - lu(471) * lu(506) + lu(512) = lu(512) - lu(472) * lu(506) + lu(513) = lu(513) - lu(473) * lu(506) + lu(514) = lu(514) - lu(474) * lu(506) + lu(515) = lu(515) - lu(475) * lu(506) + lu(516) = lu(516) - lu(476) * lu(506) + lu(517) = lu(517) - lu(477) * lu(506) + lu(518) = lu(518) - lu(478) * lu(506) + lu(519) = lu(519) - lu(479) * lu(506) + lu(520) = lu(520) - lu(480) * lu(506) + lu(521) = lu(521) - lu(481) * lu(506) + lu(522) = lu(522) - lu(482) * lu(506) + lu(523) = lu(523) - lu(483) * lu(506) + lu(808) = lu(808) - lu(467) * lu(806) + lu(812) = lu(812) - lu(468) * lu(806) + lu(817) = lu(817) - lu(469) * lu(806) + lu(818) = lu(818) - lu(470) * lu(806) + lu(820) = lu(820) - lu(471) * lu(806) + lu(821) = lu(821) - lu(472) * lu(806) + lu(822) = lu(822) - lu(473) * lu(806) + lu(823) = lu(823) - lu(474) * lu(806) + lu(825) = lu(825) - lu(475) * lu(806) + lu(828) = lu(828) - lu(476) * lu(806) + lu(829) = lu(829) - lu(477) * lu(806) + lu(830) = lu(830) - lu(478) * lu(806) + lu(832) = lu(832) - lu(479) * lu(806) + lu(833) = lu(833) - lu(480) * lu(806) + lu(837) = lu(837) - lu(481) * lu(806) + lu(838) = lu(838) - lu(482) * lu(806) + lu(839) = lu(839) - lu(483) * lu(806) + lu(851) = lu(851) - lu(467) * lu(849) + lu(854) = lu(854) - lu(468) * lu(849) + lu(859) = lu(859) - lu(469) * lu(849) + lu(860) = lu(860) - lu(470) * lu(849) + lu(862) = lu(862) - lu(471) * lu(849) + lu(863) = lu(863) - lu(472) * lu(849) + lu(864) = lu(864) - lu(473) * lu(849) + lu(865) = lu(865) - lu(474) * lu(849) + lu(867) = lu(867) - lu(475) * lu(849) + lu(870) = lu(870) - lu(476) * lu(849) + lu(871) = lu(871) - lu(477) * lu(849) + lu(872) = lu(872) - lu(478) * lu(849) + lu(874) = lu(874) - lu(479) * lu(849) + lu(875) = lu(875) - lu(480) * lu(849) + lu(879) = lu(879) - lu(481) * lu(849) + lu(880) = lu(880) - lu(482) * lu(849) + lu(881) = lu(881) - lu(483) * lu(849) + lu(971) = lu(971) - lu(467) * lu(969) + lu(974) = lu(974) - lu(468) * lu(969) + lu(979) = lu(979) - lu(469) * lu(969) + lu(980) = lu(980) - lu(470) * lu(969) + lu(982) = lu(982) - lu(471) * lu(969) + lu(983) = lu(983) - lu(472) * lu(969) + lu(984) = lu(984) - lu(473) * lu(969) + lu(985) = lu(985) - lu(474) * lu(969) + lu(987) = lu(987) - lu(475) * lu(969) + lu(990) = lu(990) - lu(476) * lu(969) + lu(991) = lu(991) - lu(477) * lu(969) + lu(992) = lu(992) - lu(478) * lu(969) + lu(994) = lu(994) - lu(479) * lu(969) + lu(995) = lu(995) - lu(480) * lu(969) + lu(999) = lu(999) - lu(481) * lu(969) + lu(1000) = lu(1000) - lu(482) * lu(969) + lu(1001) = lu(1001) - lu(483) * lu(969) + lu(1013) = lu(1013) - lu(467) * lu(1011) + lu(1016) = lu(1016) - lu(468) * lu(1011) + lu(1021) = lu(1021) - lu(469) * lu(1011) + lu(1022) = lu(1022) - lu(470) * lu(1011) + lu(1024) = lu(1024) - lu(471) * lu(1011) + lu(1025) = lu(1025) - lu(472) * lu(1011) + lu(1026) = lu(1026) - lu(473) * lu(1011) + lu(1027) = lu(1027) - lu(474) * lu(1011) + lu(1029) = lu(1029) - lu(475) * lu(1011) + lu(1032) = lu(1032) - lu(476) * lu(1011) + lu(1033) = lu(1033) - lu(477) * lu(1011) + lu(1034) = lu(1034) - lu(478) * lu(1011) + lu(1036) = lu(1036) - lu(479) * lu(1011) + lu(1037) = lu(1037) - lu(480) * lu(1011) + lu(1041) = lu(1041) - lu(481) * lu(1011) + lu(1042) = lu(1042) - lu(482) * lu(1011) + lu(1043) = lu(1043) - lu(483) * lu(1011) + lu(1056) = lu(1056) - lu(467) * lu(1054) + lu(1060) = lu(1060) - lu(468) * lu(1054) + lu(1065) = lu(1065) - lu(469) * lu(1054) + lu(1066) = lu(1066) - lu(470) * lu(1054) + lu(1068) = lu(1068) - lu(471) * lu(1054) + lu(1069) = lu(1069) - lu(472) * lu(1054) + lu(1070) = lu(1070) - lu(473) * lu(1054) + lu(1071) = lu(1071) - lu(474) * lu(1054) + lu(1073) = lu(1073) - lu(475) * lu(1054) + lu(1076) = lu(1076) - lu(476) * lu(1054) + lu(1077) = lu(1077) - lu(477) * lu(1054) + lu(1078) = lu(1078) - lu(478) * lu(1054) + lu(1080) = lu(1080) - lu(479) * lu(1054) + lu(1081) = lu(1081) - lu(480) * lu(1054) + lu(1085) = lu(1085) - lu(481) * lu(1054) + lu(1086) = lu(1086) - lu(482) * lu(1054) + lu(1087) = lu(1087) - lu(483) * lu(1054) + lu(1262) = lu(1262) - lu(467) * lu(1260) + lu(1266) = lu(1266) - lu(468) * lu(1260) + lu(1271) = lu(1271) - lu(469) * lu(1260) + lu(1272) = lu(1272) - lu(470) * lu(1260) + lu(1274) = lu(1274) - lu(471) * lu(1260) + lu(1275) = lu(1275) - lu(472) * lu(1260) + lu(1276) = lu(1276) - lu(473) * lu(1260) + lu(1277) = lu(1277) - lu(474) * lu(1260) + lu(1279) = lu(1279) - lu(475) * lu(1260) + lu(1282) = lu(1282) - lu(476) * lu(1260) + lu(1283) = lu(1283) - lu(477) * lu(1260) + lu(1284) = lu(1284) - lu(478) * lu(1260) + lu(1286) = lu(1286) - lu(479) * lu(1260) + lu(1287) = lu(1287) - lu(480) * lu(1260) + lu(1291) = lu(1291) - lu(481) * lu(1260) + lu(1292) = lu(1292) - lu(482) * lu(1260) + lu(1293) = lu(1293) - lu(483) * lu(1260) + lu(1346) = lu(1346) - lu(467) * lu(1344) + lu(1349) = lu(1349) - lu(468) * lu(1344) + lu(1354) = lu(1354) - lu(469) * lu(1344) + lu(1355) = lu(1355) - lu(470) * lu(1344) + lu(1357) = lu(1357) - lu(471) * lu(1344) + lu(1358) = lu(1358) - lu(472) * lu(1344) + lu(1359) = lu(1359) - lu(473) * lu(1344) + lu(1360) = lu(1360) - lu(474) * lu(1344) + lu(1362) = lu(1362) - lu(475) * lu(1344) + lu(1365) = lu(1365) - lu(476) * lu(1344) + lu(1366) = lu(1366) - lu(477) * lu(1344) + lu(1367) = lu(1367) - lu(478) * lu(1344) + lu(1369) = lu(1369) - lu(479) * lu(1344) + lu(1370) = lu(1370) - lu(480) * lu(1344) + lu(1374) = lu(1374) - lu(481) * lu(1344) + lu(1375) = lu(1375) - lu(482) * lu(1344) + lu(1376) = lu(1376) - lu(483) * lu(1344) + lu(1430) = lu(1430) - lu(467) * lu(1428) + lu(1433) = lu(1433) - lu(468) * lu(1428) + lu(1438) = lu(1438) - lu(469) * lu(1428) + lu(1439) = lu(1439) - lu(470) * lu(1428) + lu(1441) = lu(1441) - lu(471) * lu(1428) + lu(1442) = lu(1442) - lu(472) * lu(1428) + lu(1443) = lu(1443) - lu(473) * lu(1428) + lu(1444) = lu(1444) - lu(474) * lu(1428) + lu(1446) = lu(1446) - lu(475) * lu(1428) + lu(1449) = lu(1449) - lu(476) * lu(1428) + lu(1450) = lu(1450) - lu(477) * lu(1428) + lu(1451) = lu(1451) - lu(478) * lu(1428) + lu(1453) = lu(1453) - lu(479) * lu(1428) + lu(1454) = lu(1454) - lu(480) * lu(1428) + lu(1458) = lu(1458) - lu(481) * lu(1428) + lu(1459) = lu(1459) - lu(482) * lu(1428) + lu(1460) = lu(1460) - lu(483) * lu(1428) + lu(1664) = lu(1664) - lu(467) * lu(1663) + lu(1667) = lu(1667) - lu(468) * lu(1663) + lu(1671) = lu(1671) - lu(469) * lu(1663) + lu(1672) = lu(1672) - lu(470) * lu(1663) + lu(1674) = lu(1674) - lu(471) * lu(1663) + lu(1675) = lu(1675) - lu(472) * lu(1663) + lu(1676) = lu(1676) - lu(473) * lu(1663) + lu(1677) = lu(1677) - lu(474) * lu(1663) + lu(1679) = lu(1679) - lu(475) * lu(1663) + lu(1682) = lu(1682) - lu(476) * lu(1663) + lu(1683) = lu(1683) - lu(477) * lu(1663) + lu(1684) = lu(1684) - lu(478) * lu(1663) + lu(1686) = lu(1686) - lu(479) * lu(1663) + lu(1687) = lu(1687) - lu(480) * lu(1663) + lu(1691) = lu(1691) - lu(481) * lu(1663) + lu(1692) = lu(1692) - lu(482) * lu(1663) + lu(1693) = lu(1693) - lu(483) * lu(1663) + lu(1714) = lu(1714) - lu(467) * lu(1712) + lu(1718) = lu(1718) - lu(468) * lu(1712) + lu(1723) = lu(1723) - lu(469) * lu(1712) + lu(1724) = lu(1724) - lu(470) * lu(1712) + lu(1726) = lu(1726) - lu(471) * lu(1712) + lu(1727) = lu(1727) - lu(472) * lu(1712) + lu(1728) = lu(1728) - lu(473) * lu(1712) + lu(1729) = lu(1729) - lu(474) * lu(1712) + lu(1731) = lu(1731) - lu(475) * lu(1712) + lu(1734) = lu(1734) - lu(476) * lu(1712) + lu(1735) = lu(1735) - lu(477) * lu(1712) + lu(1736) = lu(1736) - lu(478) * lu(1712) + lu(1738) = lu(1738) - lu(479) * lu(1712) + lu(1739) = lu(1739) - lu(480) * lu(1712) + lu(1743) = lu(1743) - lu(481) * lu(1712) + lu(1744) = lu(1744) - lu(482) * lu(1712) + lu(1745) = lu(1745) - lu(483) * lu(1712) + lu(486) = 1._r8 / lu(486) + lu(487) = lu(487) * lu(486) + lu(488) = lu(488) * lu(486) + lu(489) = lu(489) * lu(486) + lu(490) = lu(490) * lu(486) + lu(491) = lu(491) * lu(486) + lu(492) = lu(492) * lu(486) + lu(493) = lu(493) * lu(486) + lu(494) = lu(494) * lu(486) + lu(495) = lu(495) * lu(486) + lu(496) = lu(496) * lu(486) + lu(497) = lu(497) * lu(486) + lu(498) = lu(498) * lu(486) + lu(499) = lu(499) * lu(486) + lu(500) = lu(500) * lu(486) + lu(501) = lu(501) * lu(486) + lu(502) = lu(502) * lu(486) + lu(503) = lu(503) * lu(486) + lu(735) = - lu(487) * lu(734) + lu(737) = lu(737) - lu(488) * lu(734) + lu(739) = lu(739) - lu(489) * lu(734) + lu(740) = lu(740) - lu(490) * lu(734) + lu(741) = lu(741) - lu(491) * lu(734) + lu(742) = lu(742) - lu(492) * lu(734) + lu(744) = lu(744) - lu(493) * lu(734) + lu(745) = lu(745) - lu(494) * lu(734) + lu(746) = lu(746) - lu(495) * lu(734) + lu(747) = lu(747) - lu(496) * lu(734) + lu(749) = lu(749) - lu(497) * lu(734) + lu(752) = lu(752) - lu(498) * lu(734) + lu(753) = lu(753) - lu(499) * lu(734) + lu(754) = lu(754) - lu(500) * lu(734) + lu(756) = lu(756) - lu(501) * lu(734) + lu(757) = lu(757) - lu(502) * lu(734) + lu(763) = lu(763) - lu(503) * lu(734) + lu(808) = lu(808) - lu(487) * lu(807) + lu(812) = lu(812) - lu(488) * lu(807) + lu(815) = lu(815) - lu(489) * lu(807) + lu(816) = lu(816) - lu(490) * lu(807) + lu(817) = lu(817) - lu(491) * lu(807) + lu(818) = lu(818) - lu(492) * lu(807) + lu(820) = lu(820) - lu(493) * lu(807) + lu(821) = lu(821) - lu(494) * lu(807) + lu(822) = lu(822) - lu(495) * lu(807) + lu(823) = lu(823) - lu(496) * lu(807) + lu(825) = lu(825) - lu(497) * lu(807) + lu(828) = lu(828) - lu(498) * lu(807) + lu(829) = lu(829) - lu(499) * lu(807) + lu(830) = lu(830) - lu(500) * lu(807) + lu(832) = lu(832) - lu(501) * lu(807) + lu(833) = lu(833) - lu(502) * lu(807) + lu(839) = lu(839) - lu(503) * lu(807) + lu(851) = lu(851) - lu(487) * lu(850) + lu(854) = lu(854) - lu(488) * lu(850) + lu(857) = lu(857) - lu(489) * lu(850) + lu(858) = lu(858) - lu(490) * lu(850) + lu(859) = lu(859) - lu(491) * lu(850) + lu(860) = lu(860) - lu(492) * lu(850) + lu(862) = lu(862) - lu(493) * lu(850) + lu(863) = lu(863) - lu(494) * lu(850) + lu(864) = lu(864) - lu(495) * lu(850) + lu(865) = lu(865) - lu(496) * lu(850) + lu(867) = lu(867) - lu(497) * lu(850) + lu(870) = lu(870) - lu(498) * lu(850) + lu(871) = lu(871) - lu(499) * lu(850) + lu(872) = lu(872) - lu(500) * lu(850) + lu(874) = lu(874) - lu(501) * lu(850) + lu(875) = lu(875) - lu(502) * lu(850) + lu(881) = lu(881) - lu(503) * lu(850) + lu(971) = lu(971) - lu(487) * lu(970) + lu(974) = lu(974) - lu(488) * lu(970) + lu(977) = lu(977) - lu(489) * lu(970) + lu(978) = lu(978) - lu(490) * lu(970) + lu(979) = lu(979) - lu(491) * lu(970) + lu(980) = lu(980) - lu(492) * lu(970) + lu(982) = lu(982) - lu(493) * lu(970) + lu(983) = lu(983) - lu(494) * lu(970) + lu(984) = lu(984) - lu(495) * lu(970) + lu(985) = lu(985) - lu(496) * lu(970) + lu(987) = lu(987) - lu(497) * lu(970) + lu(990) = lu(990) - lu(498) * lu(970) + lu(991) = lu(991) - lu(499) * lu(970) + lu(992) = lu(992) - lu(500) * lu(970) + lu(994) = lu(994) - lu(501) * lu(970) + lu(995) = lu(995) - lu(502) * lu(970) + lu(1001) = lu(1001) - lu(503) * lu(970) + lu(1013) = lu(1013) - lu(487) * lu(1012) + lu(1016) = lu(1016) - lu(488) * lu(1012) + lu(1019) = lu(1019) - lu(489) * lu(1012) + lu(1020) = lu(1020) - lu(490) * lu(1012) + lu(1021) = lu(1021) - lu(491) * lu(1012) + lu(1022) = lu(1022) - lu(492) * lu(1012) + lu(1024) = lu(1024) - lu(493) * lu(1012) + lu(1025) = lu(1025) - lu(494) * lu(1012) + lu(1026) = lu(1026) - lu(495) * lu(1012) + lu(1027) = lu(1027) - lu(496) * lu(1012) + lu(1029) = lu(1029) - lu(497) * lu(1012) + lu(1032) = lu(1032) - lu(498) * lu(1012) + lu(1033) = lu(1033) - lu(499) * lu(1012) + lu(1034) = lu(1034) - lu(500) * lu(1012) + lu(1036) = lu(1036) - lu(501) * lu(1012) + lu(1037) = lu(1037) - lu(502) * lu(1012) + lu(1043) = lu(1043) - lu(503) * lu(1012) + lu(1056) = lu(1056) - lu(487) * lu(1055) + lu(1060) = lu(1060) - lu(488) * lu(1055) + lu(1063) = lu(1063) - lu(489) * lu(1055) + lu(1064) = lu(1064) - lu(490) * lu(1055) + lu(1065) = lu(1065) - lu(491) * lu(1055) + lu(1066) = lu(1066) - lu(492) * lu(1055) + lu(1068) = lu(1068) - lu(493) * lu(1055) + lu(1069) = lu(1069) - lu(494) * lu(1055) + lu(1070) = lu(1070) - lu(495) * lu(1055) + lu(1071) = lu(1071) - lu(496) * lu(1055) + lu(1073) = lu(1073) - lu(497) * lu(1055) + lu(1076) = lu(1076) - lu(498) * lu(1055) + lu(1077) = lu(1077) - lu(499) * lu(1055) + lu(1078) = lu(1078) - lu(500) * lu(1055) + lu(1080) = lu(1080) - lu(501) * lu(1055) + lu(1081) = lu(1081) - lu(502) * lu(1055) + lu(1087) = lu(1087) - lu(503) * lu(1055) + lu(1262) = lu(1262) - lu(487) * lu(1261) + lu(1266) = lu(1266) - lu(488) * lu(1261) + lu(1269) = lu(1269) - lu(489) * lu(1261) + lu(1270) = lu(1270) - lu(490) * lu(1261) + lu(1271) = lu(1271) - lu(491) * lu(1261) + lu(1272) = lu(1272) - lu(492) * lu(1261) + lu(1274) = lu(1274) - lu(493) * lu(1261) + lu(1275) = lu(1275) - lu(494) * lu(1261) + lu(1276) = lu(1276) - lu(495) * lu(1261) + lu(1277) = lu(1277) - lu(496) * lu(1261) + lu(1279) = lu(1279) - lu(497) * lu(1261) + lu(1282) = lu(1282) - lu(498) * lu(1261) + lu(1283) = lu(1283) - lu(499) * lu(1261) + lu(1284) = lu(1284) - lu(500) * lu(1261) + lu(1286) = lu(1286) - lu(501) * lu(1261) + lu(1287) = lu(1287) - lu(502) * lu(1261) + lu(1293) = lu(1293) - lu(503) * lu(1261) + lu(1303) = - lu(487) * lu(1302) + lu(1307) = lu(1307) - lu(488) * lu(1302) + lu(1310) = lu(1310) - lu(489) * lu(1302) + lu(1311) = lu(1311) - lu(490) * lu(1302) + lu(1312) = lu(1312) - lu(491) * lu(1302) + lu(1313) = lu(1313) - lu(492) * lu(1302) + lu(1315) = lu(1315) - lu(493) * lu(1302) + lu(1316) = lu(1316) - lu(494) * lu(1302) + lu(1317) = lu(1317) - lu(495) * lu(1302) + lu(1318) = lu(1318) - lu(496) * lu(1302) + lu(1320) = lu(1320) - lu(497) * lu(1302) + lu(1323) = lu(1323) - lu(498) * lu(1302) + lu(1324) = lu(1324) - lu(499) * lu(1302) + lu(1325) = lu(1325) - lu(500) * lu(1302) + lu(1327) = lu(1327) - lu(501) * lu(1302) + lu(1328) = lu(1328) - lu(502) * lu(1302) + lu(1334) = lu(1334) - lu(503) * lu(1302) + lu(1346) = lu(1346) - lu(487) * lu(1345) + lu(1349) = lu(1349) - lu(488) * lu(1345) + lu(1352) = lu(1352) - lu(489) * lu(1345) + lu(1353) = lu(1353) - lu(490) * lu(1345) + lu(1354) = lu(1354) - lu(491) * lu(1345) + lu(1355) = lu(1355) - lu(492) * lu(1345) + lu(1357) = lu(1357) - lu(493) * lu(1345) + lu(1358) = lu(1358) - lu(494) * lu(1345) + lu(1359) = lu(1359) - lu(495) * lu(1345) + lu(1360) = lu(1360) - lu(496) * lu(1345) + lu(1362) = lu(1362) - lu(497) * lu(1345) + lu(1365) = lu(1365) - lu(498) * lu(1345) + lu(1366) = lu(1366) - lu(499) * lu(1345) + lu(1367) = lu(1367) - lu(500) * lu(1345) + lu(1369) = lu(1369) - lu(501) * lu(1345) + lu(1370) = lu(1370) - lu(502) * lu(1345) + lu(1376) = lu(1376) - lu(503) * lu(1345) + lu(1430) = lu(1430) - lu(487) * lu(1429) + lu(1433) = lu(1433) - lu(488) * lu(1429) + lu(1436) = lu(1436) - lu(489) * lu(1429) + lu(1437) = lu(1437) - lu(490) * lu(1429) + lu(1438) = lu(1438) - lu(491) * lu(1429) + lu(1439) = lu(1439) - lu(492) * lu(1429) + lu(1441) = lu(1441) - lu(493) * lu(1429) + lu(1442) = lu(1442) - lu(494) * lu(1429) + lu(1443) = lu(1443) - lu(495) * lu(1429) + lu(1444) = lu(1444) - lu(496) * lu(1429) + lu(1446) = lu(1446) - lu(497) * lu(1429) + lu(1449) = lu(1449) - lu(498) * lu(1429) + lu(1450) = lu(1450) - lu(499) * lu(1429) + lu(1451) = lu(1451) - lu(500) * lu(1429) + lu(1453) = lu(1453) - lu(501) * lu(1429) + lu(1454) = lu(1454) - lu(502) * lu(1429) + lu(1460) = lu(1460) - lu(503) * lu(1429) + lu(1714) = lu(1714) - lu(487) * lu(1713) + lu(1718) = lu(1718) - lu(488) * lu(1713) + lu(1721) = lu(1721) - lu(489) * lu(1713) + lu(1722) = lu(1722) - lu(490) * lu(1713) + lu(1723) = lu(1723) - lu(491) * lu(1713) + lu(1724) = lu(1724) - lu(492) * lu(1713) + lu(1726) = lu(1726) - lu(493) * lu(1713) + lu(1727) = lu(1727) - lu(494) * lu(1713) + lu(1728) = lu(1728) - lu(495) * lu(1713) + lu(1729) = lu(1729) - lu(496) * lu(1713) + lu(1731) = lu(1731) - lu(497) * lu(1713) + lu(1734) = lu(1734) - lu(498) * lu(1713) + lu(1735) = lu(1735) - lu(499) * lu(1713) + lu(1736) = lu(1736) - lu(500) * lu(1713) + lu(1738) = lu(1738) - lu(501) * lu(1713) + lu(1739) = lu(1739) - lu(502) * lu(1713) + lu(1745) = lu(1745) - lu(503) * lu(1713) end subroutine lu_fac12 - subroutine lu_fac13( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac13( lu ) 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,497) = 1._r8 / lu(k,497) - lu(k,498) = lu(k,498) * lu(k,497) - lu(k,499) = lu(k,499) * lu(k,497) - lu(k,500) = lu(k,500) * lu(k,497) - lu(k,501) = lu(k,501) * lu(k,497) - lu(k,502) = lu(k,502) * lu(k,497) - lu(k,503) = lu(k,503) * lu(k,497) - lu(k,504) = lu(k,504) * lu(k,497) - lu(k,505) = lu(k,505) * lu(k,497) - lu(k,506) = lu(k,506) * lu(k,497) - lu(k,507) = lu(k,507) * lu(k,497) - lu(k,508) = lu(k,508) * lu(k,497) - lu(k,509) = lu(k,509) * lu(k,497) - lu(k,510) = lu(k,510) * lu(k,497) - lu(k,511) = lu(k,511) * lu(k,497) - lu(k,512) = lu(k,512) * lu(k,497) - lu(k,513) = lu(k,513) * lu(k,497) - lu(k,514) = lu(k,514) * lu(k,497) - lu(k,515) = lu(k,515) * lu(k,497) - lu(k,780) = - lu(k,498) * lu(k,779) - lu(k,782) = lu(k,782) - lu(k,499) * lu(k,779) - lu(k,783) = lu(k,783) - lu(k,500) * lu(k,779) - lu(k,785) = lu(k,785) - lu(k,501) * lu(k,779) - lu(k,786) = lu(k,786) - lu(k,502) * lu(k,779) - lu(k,787) = lu(k,787) - lu(k,503) * lu(k,779) - lu(k,788) = lu(k,788) - lu(k,504) * lu(k,779) - lu(k,789) = lu(k,789) - lu(k,505) * lu(k,779) - lu(k,791) = lu(k,791) - lu(k,506) * lu(k,779) - lu(k,793) = lu(k,793) - lu(k,507) * lu(k,779) - lu(k,794) = lu(k,794) - lu(k,508) * lu(k,779) - lu(k,796) = lu(k,796) - lu(k,509) * lu(k,779) - lu(k,798) = lu(k,798) - lu(k,510) * lu(k,779) - lu(k,799) = lu(k,799) - lu(k,511) * lu(k,779) - lu(k,803) = lu(k,803) - lu(k,512) * lu(k,779) - lu(k,807) = lu(k,807) - lu(k,513) * lu(k,779) - lu(k,808) = lu(k,808) - lu(k,514) * lu(k,779) - lu(k,809) = lu(k,809) - lu(k,515) * lu(k,779) - lu(k,821) = lu(k,821) - lu(k,498) * lu(k,820) - lu(k,824) = lu(k,824) - lu(k,499) * lu(k,820) - lu(k,826) = lu(k,826) - lu(k,500) * lu(k,820) - lu(k,828) = lu(k,828) - lu(k,501) * lu(k,820) - lu(k,829) = lu(k,829) - lu(k,502) * lu(k,820) - lu(k,830) = lu(k,830) - lu(k,503) * lu(k,820) - lu(k,831) = lu(k,831) - lu(k,504) * lu(k,820) - lu(k,832) = lu(k,832) - lu(k,505) * lu(k,820) - lu(k,834) = lu(k,834) - lu(k,506) * lu(k,820) - lu(k,836) = lu(k,836) - lu(k,507) * lu(k,820) - lu(k,837) = lu(k,837) - lu(k,508) * lu(k,820) - lu(k,839) = lu(k,839) - lu(k,509) * lu(k,820) - lu(k,841) = lu(k,841) - lu(k,510) * lu(k,820) - lu(k,842) = lu(k,842) - lu(k,511) * lu(k,820) - lu(k,846) = lu(k,846) - lu(k,512) * lu(k,820) - lu(k,850) = lu(k,850) - lu(k,513) * lu(k,820) - lu(k,851) = lu(k,851) - lu(k,514) * lu(k,820) - lu(k,852) = lu(k,852) - lu(k,515) * lu(k,820) - lu(k,868) = lu(k,868) - lu(k,498) * lu(k,867) - lu(k,872) = lu(k,872) - lu(k,499) * lu(k,867) - lu(k,874) = lu(k,874) - lu(k,500) * lu(k,867) - lu(k,876) = lu(k,876) - lu(k,501) * lu(k,867) - lu(k,877) = lu(k,877) - lu(k,502) * lu(k,867) - lu(k,878) = lu(k,878) - lu(k,503) * lu(k,867) - lu(k,879) = lu(k,879) - lu(k,504) * lu(k,867) - lu(k,880) = lu(k,880) - lu(k,505) * lu(k,867) - lu(k,882) = lu(k,882) - lu(k,506) * lu(k,867) - lu(k,884) = lu(k,884) - lu(k,507) * lu(k,867) - lu(k,885) = lu(k,885) - lu(k,508) * lu(k,867) - lu(k,887) = lu(k,887) - lu(k,509) * lu(k,867) - lu(k,889) = lu(k,889) - lu(k,510) * lu(k,867) - lu(k,890) = lu(k,890) - lu(k,511) * lu(k,867) - lu(k,894) = lu(k,894) - lu(k,512) * lu(k,867) - lu(k,898) = lu(k,898) - lu(k,513) * lu(k,867) - lu(k,899) = lu(k,899) - lu(k,514) * lu(k,867) - lu(k,900) = lu(k,900) - lu(k,515) * lu(k,867) - lu(k,912) = lu(k,912) - lu(k,498) * lu(k,911) - lu(k,915) = lu(k,915) - lu(k,499) * lu(k,911) - lu(k,917) = lu(k,917) - lu(k,500) * lu(k,911) - lu(k,919) = lu(k,919) - lu(k,501) * lu(k,911) - lu(k,920) = lu(k,920) - lu(k,502) * lu(k,911) - lu(k,921) = lu(k,921) - lu(k,503) * lu(k,911) - lu(k,922) = lu(k,922) - lu(k,504) * lu(k,911) - lu(k,923) = lu(k,923) - lu(k,505) * lu(k,911) - lu(k,925) = lu(k,925) - lu(k,506) * lu(k,911) - lu(k,927) = lu(k,927) - lu(k,507) * lu(k,911) - lu(k,928) = lu(k,928) - lu(k,508) * lu(k,911) - lu(k,930) = lu(k,930) - lu(k,509) * lu(k,911) - lu(k,932) = lu(k,932) - lu(k,510) * lu(k,911) - lu(k,933) = lu(k,933) - lu(k,511) * lu(k,911) - lu(k,937) = lu(k,937) - lu(k,512) * lu(k,911) - lu(k,941) = lu(k,941) - lu(k,513) * lu(k,911) - lu(k,942) = lu(k,942) - lu(k,514) * lu(k,911) - lu(k,943) = lu(k,943) - lu(k,515) * lu(k,911) - lu(k,1053) = lu(k,1053) - lu(k,498) * lu(k,1052) - lu(k,1056) = lu(k,1056) - lu(k,499) * lu(k,1052) - lu(k,1058) = lu(k,1058) - lu(k,500) * lu(k,1052) - lu(k,1060) = lu(k,1060) - lu(k,501) * lu(k,1052) - lu(k,1061) = lu(k,1061) - lu(k,502) * lu(k,1052) - lu(k,1062) = lu(k,1062) - lu(k,503) * lu(k,1052) - lu(k,1063) = lu(k,1063) - lu(k,504) * lu(k,1052) - lu(k,1064) = lu(k,1064) - lu(k,505) * lu(k,1052) - lu(k,1066) = lu(k,1066) - lu(k,506) * lu(k,1052) - lu(k,1068) = lu(k,1068) - lu(k,507) * lu(k,1052) - lu(k,1069) = lu(k,1069) - lu(k,508) * lu(k,1052) - lu(k,1071) = lu(k,1071) - lu(k,509) * lu(k,1052) - lu(k,1073) = lu(k,1073) - lu(k,510) * lu(k,1052) - lu(k,1074) = lu(k,1074) - lu(k,511) * lu(k,1052) - lu(k,1078) = lu(k,1078) - lu(k,512) * lu(k,1052) - lu(k,1082) = lu(k,1082) - lu(k,513) * lu(k,1052) - lu(k,1083) = lu(k,1083) - lu(k,514) * lu(k,1052) - lu(k,1084) = lu(k,1084) - lu(k,515) * lu(k,1052) - lu(k,1137) = lu(k,1137) - lu(k,498) * lu(k,1136) - lu(k,1141) = lu(k,1141) - lu(k,499) * lu(k,1136) - lu(k,1143) = lu(k,1143) - lu(k,500) * lu(k,1136) - lu(k,1145) = lu(k,1145) - lu(k,501) * lu(k,1136) - lu(k,1146) = lu(k,1146) - lu(k,502) * lu(k,1136) - lu(k,1147) = lu(k,1147) - lu(k,503) * lu(k,1136) - lu(k,1148) = lu(k,1148) - lu(k,504) * lu(k,1136) - lu(k,1149) = lu(k,1149) - lu(k,505) * lu(k,1136) - lu(k,1151) = lu(k,1151) - lu(k,506) * lu(k,1136) - lu(k,1153) = lu(k,1153) - lu(k,507) * lu(k,1136) - lu(k,1154) = lu(k,1154) - lu(k,508) * lu(k,1136) - lu(k,1156) = lu(k,1156) - lu(k,509) * lu(k,1136) - lu(k,1158) = lu(k,1158) - lu(k,510) * lu(k,1136) - lu(k,1159) = lu(k,1159) - lu(k,511) * lu(k,1136) - lu(k,1163) = lu(k,1163) - lu(k,512) * lu(k,1136) - lu(k,1167) = lu(k,1167) - lu(k,513) * lu(k,1136) - lu(k,1168) = lu(k,1168) - lu(k,514) * lu(k,1136) - lu(k,1169) = lu(k,1169) - lu(k,515) * lu(k,1136) - lu(k,1181) = lu(k,1181) - lu(k,498) * lu(k,1180) - lu(k,1184) = lu(k,1184) - lu(k,499) * lu(k,1180) - lu(k,1186) = lu(k,1186) - lu(k,500) * lu(k,1180) - lu(k,1188) = lu(k,1188) - lu(k,501) * lu(k,1180) - lu(k,1189) = lu(k,1189) - lu(k,502) * lu(k,1180) - lu(k,1190) = lu(k,1190) - lu(k,503) * lu(k,1180) - lu(k,1191) = lu(k,1191) - lu(k,504) * lu(k,1180) - lu(k,1192) = lu(k,1192) - lu(k,505) * lu(k,1180) - lu(k,1194) = lu(k,1194) - lu(k,506) * lu(k,1180) - lu(k,1196) = lu(k,1196) - lu(k,507) * lu(k,1180) - lu(k,1197) = lu(k,1197) - lu(k,508) * lu(k,1180) - lu(k,1199) = lu(k,1199) - lu(k,509) * lu(k,1180) - lu(k,1201) = lu(k,1201) - lu(k,510) * lu(k,1180) - lu(k,1202) = lu(k,1202) - lu(k,511) * lu(k,1180) - lu(k,1206) = lu(k,1206) - lu(k,512) * lu(k,1180) - lu(k,1210) = lu(k,1210) - lu(k,513) * lu(k,1180) - lu(k,1211) = lu(k,1211) - lu(k,514) * lu(k,1180) - lu(k,1212) = lu(k,1212) - lu(k,515) * lu(k,1180) - lu(k,1339) = lu(k,1339) - lu(k,498) * lu(k,1338) - lu(k,1343) = lu(k,1343) - lu(k,499) * lu(k,1338) - lu(k,1345) = lu(k,1345) - lu(k,500) * lu(k,1338) - lu(k,1347) = lu(k,1347) - lu(k,501) * lu(k,1338) - lu(k,1348) = lu(k,1348) - lu(k,502) * lu(k,1338) - lu(k,1349) = lu(k,1349) - lu(k,503) * lu(k,1338) - lu(k,1350) = lu(k,1350) - lu(k,504) * lu(k,1338) - lu(k,1351) = lu(k,1351) - lu(k,505) * lu(k,1338) - lu(k,1353) = lu(k,1353) - lu(k,506) * lu(k,1338) - lu(k,1355) = lu(k,1355) - lu(k,507) * lu(k,1338) - lu(k,1356) = lu(k,1356) - lu(k,508) * lu(k,1338) - lu(k,1358) = lu(k,1358) - lu(k,509) * lu(k,1338) - lu(k,1360) = lu(k,1360) - lu(k,510) * lu(k,1338) - lu(k,1361) = lu(k,1361) - lu(k,511) * lu(k,1338) - lu(k,1365) = lu(k,1365) - lu(k,512) * lu(k,1338) - lu(k,1369) = lu(k,1369) - lu(k,513) * lu(k,1338) - lu(k,1370) = lu(k,1370) - lu(k,514) * lu(k,1338) - lu(k,1371) = lu(k,1371) - lu(k,515) * lu(k,1338) - lu(k,1551) = lu(k,1551) - lu(k,498) * lu(k,1550) - lu(k,1554) = lu(k,1554) - lu(k,499) * lu(k,1550) - lu(k,1556) = lu(k,1556) - lu(k,500) * lu(k,1550) - lu(k,1558) = lu(k,1558) - lu(k,501) * lu(k,1550) - lu(k,1559) = lu(k,1559) - lu(k,502) * lu(k,1550) - lu(k,1560) = lu(k,1560) - lu(k,503) * lu(k,1550) - lu(k,1561) = lu(k,1561) - lu(k,504) * lu(k,1550) - lu(k,1562) = lu(k,1562) - lu(k,505) * lu(k,1550) - lu(k,1564) = lu(k,1564) - lu(k,506) * lu(k,1550) - lu(k,1566) = lu(k,1566) - lu(k,507) * lu(k,1550) - lu(k,1567) = lu(k,1567) - lu(k,508) * lu(k,1550) - lu(k,1569) = lu(k,1569) - lu(k,509) * lu(k,1550) - lu(k,1571) = lu(k,1571) - lu(k,510) * lu(k,1550) - lu(k,1572) = lu(k,1572) - lu(k,511) * lu(k,1550) - lu(k,1576) = lu(k,1576) - lu(k,512) * lu(k,1550) - lu(k,1580) = lu(k,1580) - lu(k,513) * lu(k,1550) - lu(k,1581) = lu(k,1581) - lu(k,514) * lu(k,1550) - lu(k,1582) = lu(k,1582) - lu(k,515) * lu(k,1550) - lu(k,1740) = - lu(k,498) * lu(k,1739) - lu(k,1744) = lu(k,1744) - lu(k,499) * lu(k,1739) - lu(k,1746) = lu(k,1746) - lu(k,500) * lu(k,1739) - lu(k,1748) = lu(k,1748) - lu(k,501) * lu(k,1739) - lu(k,1749) = lu(k,1749) - lu(k,502) * lu(k,1739) - lu(k,1750) = lu(k,1750) - lu(k,503) * lu(k,1739) - lu(k,1751) = lu(k,1751) - lu(k,504) * lu(k,1739) - lu(k,1752) = lu(k,1752) - lu(k,505) * lu(k,1739) - lu(k,1754) = lu(k,1754) - lu(k,506) * lu(k,1739) - lu(k,1756) = lu(k,1756) - lu(k,507) * lu(k,1739) - lu(k,1757) = lu(k,1757) - lu(k,508) * lu(k,1739) - lu(k,1759) = lu(k,1759) - lu(k,509) * lu(k,1739) - lu(k,1761) = lu(k,1761) - lu(k,510) * lu(k,1739) - lu(k,1762) = lu(k,1762) - lu(k,511) * lu(k,1739) - lu(k,1766) = lu(k,1766) - lu(k,512) * lu(k,1739) - lu(k,1770) = lu(k,1770) - lu(k,513) * lu(k,1739) - lu(k,1771) = lu(k,1771) - lu(k,514) * lu(k,1739) - lu(k,1772) = lu(k,1772) - lu(k,515) * lu(k,1739) - lu(k,1793) = lu(k,1793) - lu(k,498) * lu(k,1792) - lu(k,1797) = lu(k,1797) - lu(k,499) * lu(k,1792) - lu(k,1799) = lu(k,1799) - lu(k,500) * lu(k,1792) - lu(k,1801) = lu(k,1801) - lu(k,501) * lu(k,1792) - lu(k,1802) = lu(k,1802) - lu(k,502) * lu(k,1792) - lu(k,1803) = lu(k,1803) - lu(k,503) * lu(k,1792) - lu(k,1804) = lu(k,1804) - lu(k,504) * lu(k,1792) - lu(k,1805) = lu(k,1805) - lu(k,505) * lu(k,1792) - lu(k,1807) = lu(k,1807) - lu(k,506) * lu(k,1792) - lu(k,1809) = lu(k,1809) - lu(k,507) * lu(k,1792) - lu(k,1810) = lu(k,1810) - lu(k,508) * lu(k,1792) - lu(k,1812) = lu(k,1812) - lu(k,509) * lu(k,1792) - lu(k,1814) = lu(k,1814) - lu(k,510) * lu(k,1792) - lu(k,1815) = lu(k,1815) - lu(k,511) * lu(k,1792) - lu(k,1819) = lu(k,1819) - lu(k,512) * lu(k,1792) - lu(k,1823) = lu(k,1823) - lu(k,513) * lu(k,1792) - lu(k,1824) = lu(k,1824) - lu(k,514) * lu(k,1792) - lu(k,1825) = lu(k,1825) - lu(k,515) * lu(k,1792) - lu(k,519) = 1._r8 / lu(k,519) - lu(k,520) = lu(k,520) * lu(k,519) - lu(k,521) = lu(k,521) * lu(k,519) - lu(k,522) = lu(k,522) * lu(k,519) - lu(k,523) = lu(k,523) * lu(k,519) - lu(k,524) = lu(k,524) * lu(k,519) - lu(k,525) = lu(k,525) * lu(k,519) - lu(k,526) = lu(k,526) * lu(k,519) - lu(k,527) = lu(k,527) * lu(k,519) - lu(k,528) = lu(k,528) * lu(k,519) - lu(k,529) = lu(k,529) * lu(k,519) - lu(k,530) = lu(k,530) * lu(k,519) - lu(k,531) = lu(k,531) * lu(k,519) - lu(k,532) = lu(k,532) * lu(k,519) - lu(k,533) = lu(k,533) * lu(k,519) - lu(k,534) = lu(k,534) * lu(k,519) - lu(k,535) = lu(k,535) * lu(k,519) - lu(k,652) = lu(k,652) - lu(k,520) * lu(k,650) - lu(k,654) = lu(k,654) - lu(k,521) * lu(k,650) - lu(k,655) = lu(k,655) - lu(k,522) * lu(k,650) - lu(k,656) = lu(k,656) - lu(k,523) * lu(k,650) - lu(k,657) = lu(k,657) - lu(k,524) * lu(k,650) - lu(k,659) = lu(k,659) - lu(k,525) * lu(k,650) - lu(k,660) = lu(k,660) - lu(k,526) * lu(k,650) - lu(k,661) = - lu(k,527) * lu(k,650) - lu(k,662) = lu(k,662) - lu(k,528) * lu(k,650) - lu(k,663) = lu(k,663) - lu(k,529) * lu(k,650) - lu(k,664) = lu(k,664) - lu(k,530) * lu(k,650) - lu(k,665) = lu(k,665) - lu(k,531) * lu(k,650) - lu(k,668) = lu(k,668) - lu(k,532) * lu(k,650) - lu(k,670) = lu(k,670) - lu(k,533) * lu(k,650) - lu(k,671) = lu(k,671) - lu(k,534) * lu(k,650) - lu(k,672) = lu(k,672) - lu(k,535) * lu(k,650) - lu(k,782) = lu(k,782) - lu(k,520) * lu(k,780) - lu(k,786) = lu(k,786) - lu(k,521) * lu(k,780) - lu(k,787) = lu(k,787) - lu(k,522) * lu(k,780) - lu(k,788) = lu(k,788) - lu(k,523) * lu(k,780) - lu(k,789) = lu(k,789) - lu(k,524) * lu(k,780) - lu(k,791) = lu(k,791) - lu(k,525) * lu(k,780) - lu(k,792) = lu(k,792) - lu(k,526) * lu(k,780) - lu(k,793) = lu(k,793) - lu(k,527) * lu(k,780) - lu(k,794) = lu(k,794) - lu(k,528) * lu(k,780) - lu(k,795) = - lu(k,529) * lu(k,780) - lu(k,796) = lu(k,796) - lu(k,530) * lu(k,780) - lu(k,798) = lu(k,798) - lu(k,531) * lu(k,780) - lu(k,803) = lu(k,803) - lu(k,532) * lu(k,780) - lu(k,807) = lu(k,807) - lu(k,533) * lu(k,780) - lu(k,808) = lu(k,808) - lu(k,534) * lu(k,780) - lu(k,809) = lu(k,809) - lu(k,535) * lu(k,780) - lu(k,824) = lu(k,824) - lu(k,520) * lu(k,821) - lu(k,829) = lu(k,829) - lu(k,521) * lu(k,821) - lu(k,830) = lu(k,830) - lu(k,522) * lu(k,821) - lu(k,831) = lu(k,831) - lu(k,523) * lu(k,821) - lu(k,832) = lu(k,832) - lu(k,524) * lu(k,821) - lu(k,834) = lu(k,834) - lu(k,525) * lu(k,821) - lu(k,835) = lu(k,835) - lu(k,526) * lu(k,821) - lu(k,836) = lu(k,836) - lu(k,527) * lu(k,821) - lu(k,837) = lu(k,837) - lu(k,528) * lu(k,821) - lu(k,838) = lu(k,838) - lu(k,529) * lu(k,821) - lu(k,839) = lu(k,839) - lu(k,530) * lu(k,821) - lu(k,841) = lu(k,841) - lu(k,531) * lu(k,821) - lu(k,846) = lu(k,846) - lu(k,532) * lu(k,821) - lu(k,850) = lu(k,850) - lu(k,533) * lu(k,821) - lu(k,851) = lu(k,851) - lu(k,534) * lu(k,821) - lu(k,852) = lu(k,852) - lu(k,535) * lu(k,821) - lu(k,872) = lu(k,872) - lu(k,520) * lu(k,868) - lu(k,877) = lu(k,877) - lu(k,521) * lu(k,868) - lu(k,878) = lu(k,878) - lu(k,522) * lu(k,868) - lu(k,879) = lu(k,879) - lu(k,523) * lu(k,868) - lu(k,880) = lu(k,880) - lu(k,524) * lu(k,868) - lu(k,882) = lu(k,882) - lu(k,525) * lu(k,868) - lu(k,883) = lu(k,883) - lu(k,526) * lu(k,868) - lu(k,884) = lu(k,884) - lu(k,527) * lu(k,868) - lu(k,885) = lu(k,885) - lu(k,528) * lu(k,868) - lu(k,886) = lu(k,886) - lu(k,529) * lu(k,868) - lu(k,887) = lu(k,887) - lu(k,530) * lu(k,868) - lu(k,889) = lu(k,889) - lu(k,531) * lu(k,868) - lu(k,894) = lu(k,894) - lu(k,532) * lu(k,868) - lu(k,898) = lu(k,898) - lu(k,533) * lu(k,868) - lu(k,899) = lu(k,899) - lu(k,534) * lu(k,868) - lu(k,900) = lu(k,900) - lu(k,535) * lu(k,868) - lu(k,915) = lu(k,915) - lu(k,520) * lu(k,912) - lu(k,920) = lu(k,920) - lu(k,521) * lu(k,912) - lu(k,921) = lu(k,921) - lu(k,522) * lu(k,912) - lu(k,922) = lu(k,922) - lu(k,523) * lu(k,912) - lu(k,923) = lu(k,923) - lu(k,524) * lu(k,912) - lu(k,925) = lu(k,925) - lu(k,525) * lu(k,912) - lu(k,926) = lu(k,926) - lu(k,526) * lu(k,912) - lu(k,927) = lu(k,927) - lu(k,527) * lu(k,912) - lu(k,928) = lu(k,928) - lu(k,528) * lu(k,912) - lu(k,929) = lu(k,929) - lu(k,529) * lu(k,912) - lu(k,930) = lu(k,930) - lu(k,530) * lu(k,912) - lu(k,932) = lu(k,932) - lu(k,531) * lu(k,912) - lu(k,937) = lu(k,937) - lu(k,532) * lu(k,912) - lu(k,941) = lu(k,941) - lu(k,533) * lu(k,912) - lu(k,942) = lu(k,942) - lu(k,534) * lu(k,912) - lu(k,943) = lu(k,943) - lu(k,535) * lu(k,912) - lu(k,1056) = lu(k,1056) - lu(k,520) * lu(k,1053) - lu(k,1061) = lu(k,1061) - lu(k,521) * lu(k,1053) - lu(k,1062) = lu(k,1062) - lu(k,522) * lu(k,1053) - lu(k,1063) = lu(k,1063) - lu(k,523) * lu(k,1053) - lu(k,1064) = lu(k,1064) - lu(k,524) * lu(k,1053) - lu(k,1066) = lu(k,1066) - lu(k,525) * lu(k,1053) - lu(k,1067) = lu(k,1067) - lu(k,526) * lu(k,1053) - lu(k,1068) = lu(k,1068) - lu(k,527) * lu(k,1053) - lu(k,1069) = lu(k,1069) - lu(k,528) * lu(k,1053) - lu(k,1070) = lu(k,1070) - lu(k,529) * lu(k,1053) - lu(k,1071) = lu(k,1071) - lu(k,530) * lu(k,1053) - lu(k,1073) = lu(k,1073) - lu(k,531) * lu(k,1053) - lu(k,1078) = lu(k,1078) - lu(k,532) * lu(k,1053) - lu(k,1082) = lu(k,1082) - lu(k,533) * lu(k,1053) - lu(k,1083) = lu(k,1083) - lu(k,534) * lu(k,1053) - lu(k,1084) = lu(k,1084) - lu(k,535) * lu(k,1053) - lu(k,1096) = lu(k,1096) - lu(k,520) * lu(k,1092) - lu(k,1101) = lu(k,1101) - lu(k,521) * lu(k,1092) - lu(k,1102) = lu(k,1102) - lu(k,522) * lu(k,1092) - lu(k,1103) = lu(k,1103) - lu(k,523) * lu(k,1092) - lu(k,1104) = lu(k,1104) - lu(k,524) * lu(k,1092) - lu(k,1106) = lu(k,1106) - lu(k,525) * lu(k,1092) - lu(k,1107) = lu(k,1107) - lu(k,526) * lu(k,1092) - lu(k,1108) = lu(k,1108) - lu(k,527) * lu(k,1092) - lu(k,1109) = lu(k,1109) - lu(k,528) * lu(k,1092) - lu(k,1110) = lu(k,1110) - lu(k,529) * lu(k,1092) - lu(k,1111) = lu(k,1111) - lu(k,530) * lu(k,1092) - lu(k,1113) = lu(k,1113) - lu(k,531) * lu(k,1092) - lu(k,1118) = lu(k,1118) - lu(k,532) * lu(k,1092) - lu(k,1122) = lu(k,1122) - lu(k,533) * lu(k,1092) - lu(k,1123) = lu(k,1123) - lu(k,534) * lu(k,1092) - lu(k,1124) = lu(k,1124) - lu(k,535) * lu(k,1092) - lu(k,1141) = lu(k,1141) - lu(k,520) * lu(k,1137) - lu(k,1146) = lu(k,1146) - lu(k,521) * lu(k,1137) - lu(k,1147) = lu(k,1147) - lu(k,522) * lu(k,1137) - lu(k,1148) = lu(k,1148) - lu(k,523) * lu(k,1137) - lu(k,1149) = lu(k,1149) - lu(k,524) * lu(k,1137) - lu(k,1151) = lu(k,1151) - lu(k,525) * lu(k,1137) - lu(k,1152) = lu(k,1152) - lu(k,526) * lu(k,1137) - lu(k,1153) = lu(k,1153) - lu(k,527) * lu(k,1137) - lu(k,1154) = lu(k,1154) - lu(k,528) * lu(k,1137) - lu(k,1155) = lu(k,1155) - lu(k,529) * lu(k,1137) - lu(k,1156) = lu(k,1156) - lu(k,530) * lu(k,1137) - lu(k,1158) = lu(k,1158) - lu(k,531) * lu(k,1137) - lu(k,1163) = lu(k,1163) - lu(k,532) * lu(k,1137) - lu(k,1167) = lu(k,1167) - lu(k,533) * lu(k,1137) - lu(k,1168) = lu(k,1168) - lu(k,534) * lu(k,1137) - lu(k,1169) = lu(k,1169) - lu(k,535) * lu(k,1137) - lu(k,1184) = lu(k,1184) - lu(k,520) * lu(k,1181) - lu(k,1189) = lu(k,1189) - lu(k,521) * lu(k,1181) - lu(k,1190) = lu(k,1190) - lu(k,522) * lu(k,1181) - lu(k,1191) = lu(k,1191) - lu(k,523) * lu(k,1181) - lu(k,1192) = lu(k,1192) - lu(k,524) * lu(k,1181) - lu(k,1194) = lu(k,1194) - lu(k,525) * lu(k,1181) - lu(k,1195) = lu(k,1195) - lu(k,526) * lu(k,1181) - lu(k,1196) = lu(k,1196) - lu(k,527) * lu(k,1181) - lu(k,1197) = lu(k,1197) - lu(k,528) * lu(k,1181) - lu(k,1198) = lu(k,1198) - lu(k,529) * lu(k,1181) - lu(k,1199) = lu(k,1199) - lu(k,530) * lu(k,1181) - lu(k,1201) = lu(k,1201) - lu(k,531) * lu(k,1181) - lu(k,1206) = lu(k,1206) - lu(k,532) * lu(k,1181) - lu(k,1210) = lu(k,1210) - lu(k,533) * lu(k,1181) - lu(k,1211) = lu(k,1211) - lu(k,534) * lu(k,1181) - lu(k,1212) = lu(k,1212) - lu(k,535) * lu(k,1181) - lu(k,1220) = lu(k,1220) - lu(k,520) * lu(k,1217) - lu(k,1224) = lu(k,1224) - lu(k,521) * lu(k,1217) - lu(k,1225) = lu(k,1225) - lu(k,522) * lu(k,1217) - lu(k,1226) = lu(k,1226) - lu(k,523) * lu(k,1217) - lu(k,1227) = lu(k,1227) - lu(k,524) * lu(k,1217) - lu(k,1229) = lu(k,1229) - lu(k,525) * lu(k,1217) - lu(k,1230) = lu(k,1230) - lu(k,526) * lu(k,1217) - lu(k,1231) = lu(k,1231) - lu(k,527) * lu(k,1217) - lu(k,1232) = lu(k,1232) - lu(k,528) * lu(k,1217) - lu(k,1233) = lu(k,1233) - lu(k,529) * lu(k,1217) - lu(k,1234) = lu(k,1234) - lu(k,530) * lu(k,1217) - lu(k,1236) = lu(k,1236) - lu(k,531) * lu(k,1217) - lu(k,1241) = lu(k,1241) - lu(k,532) * lu(k,1217) - lu(k,1245) = lu(k,1245) - lu(k,533) * lu(k,1217) - lu(k,1246) = lu(k,1246) - lu(k,534) * lu(k,1217) - lu(k,1247) = lu(k,1247) - lu(k,535) * lu(k,1217) - lu(k,1343) = lu(k,1343) - lu(k,520) * lu(k,1339) - lu(k,1348) = lu(k,1348) - lu(k,521) * lu(k,1339) - lu(k,1349) = lu(k,1349) - lu(k,522) * lu(k,1339) - lu(k,1350) = lu(k,1350) - lu(k,523) * lu(k,1339) - lu(k,1351) = lu(k,1351) - lu(k,524) * lu(k,1339) - lu(k,1353) = lu(k,1353) - lu(k,525) * lu(k,1339) - lu(k,1354) = lu(k,1354) - lu(k,526) * lu(k,1339) - lu(k,1355) = lu(k,1355) - lu(k,527) * lu(k,1339) - lu(k,1356) = lu(k,1356) - lu(k,528) * lu(k,1339) - lu(k,1357) = lu(k,1357) - lu(k,529) * lu(k,1339) - lu(k,1358) = lu(k,1358) - lu(k,530) * lu(k,1339) - lu(k,1360) = lu(k,1360) - lu(k,531) * lu(k,1339) - lu(k,1365) = lu(k,1365) - lu(k,532) * lu(k,1339) - lu(k,1369) = lu(k,1369) - lu(k,533) * lu(k,1339) - lu(k,1370) = lu(k,1370) - lu(k,534) * lu(k,1339) - lu(k,1371) = lu(k,1371) - lu(k,535) * lu(k,1339) - lu(k,1554) = lu(k,1554) - lu(k,520) * lu(k,1551) - lu(k,1559) = lu(k,1559) - lu(k,521) * lu(k,1551) - lu(k,1560) = lu(k,1560) - lu(k,522) * lu(k,1551) - lu(k,1561) = lu(k,1561) - lu(k,523) * lu(k,1551) - lu(k,1562) = lu(k,1562) - lu(k,524) * lu(k,1551) - lu(k,1564) = lu(k,1564) - lu(k,525) * lu(k,1551) - lu(k,1565) = lu(k,1565) - lu(k,526) * lu(k,1551) - lu(k,1566) = lu(k,1566) - lu(k,527) * lu(k,1551) - lu(k,1567) = lu(k,1567) - lu(k,528) * lu(k,1551) - lu(k,1568) = lu(k,1568) - lu(k,529) * lu(k,1551) - lu(k,1569) = lu(k,1569) - lu(k,530) * lu(k,1551) - lu(k,1571) = lu(k,1571) - lu(k,531) * lu(k,1551) - lu(k,1576) = lu(k,1576) - lu(k,532) * lu(k,1551) - lu(k,1580) = lu(k,1580) - lu(k,533) * lu(k,1551) - lu(k,1581) = lu(k,1581) - lu(k,534) * lu(k,1551) - lu(k,1582) = lu(k,1582) - lu(k,535) * lu(k,1551) - lu(k,1744) = lu(k,1744) - lu(k,520) * lu(k,1740) - lu(k,1749) = lu(k,1749) - lu(k,521) * lu(k,1740) - lu(k,1750) = lu(k,1750) - lu(k,522) * lu(k,1740) - lu(k,1751) = lu(k,1751) - lu(k,523) * lu(k,1740) - lu(k,1752) = lu(k,1752) - lu(k,524) * lu(k,1740) - lu(k,1754) = lu(k,1754) - lu(k,525) * lu(k,1740) - lu(k,1755) = lu(k,1755) - lu(k,526) * lu(k,1740) - lu(k,1756) = lu(k,1756) - lu(k,527) * lu(k,1740) - lu(k,1757) = lu(k,1757) - lu(k,528) * lu(k,1740) - lu(k,1758) = lu(k,1758) - lu(k,529) * lu(k,1740) - lu(k,1759) = lu(k,1759) - lu(k,530) * lu(k,1740) - lu(k,1761) = lu(k,1761) - lu(k,531) * lu(k,1740) - lu(k,1766) = lu(k,1766) - lu(k,532) * lu(k,1740) - lu(k,1770) = lu(k,1770) - lu(k,533) * lu(k,1740) - lu(k,1771) = lu(k,1771) - lu(k,534) * lu(k,1740) - lu(k,1772) = lu(k,1772) - lu(k,535) * lu(k,1740) - lu(k,1797) = lu(k,1797) - lu(k,520) * lu(k,1793) - lu(k,1802) = lu(k,1802) - lu(k,521) * lu(k,1793) - lu(k,1803) = lu(k,1803) - lu(k,522) * lu(k,1793) - lu(k,1804) = lu(k,1804) - lu(k,523) * lu(k,1793) - lu(k,1805) = lu(k,1805) - lu(k,524) * lu(k,1793) - lu(k,1807) = lu(k,1807) - lu(k,525) * lu(k,1793) - lu(k,1808) = lu(k,1808) - lu(k,526) * lu(k,1793) - lu(k,1809) = lu(k,1809) - lu(k,527) * lu(k,1793) - lu(k,1810) = lu(k,1810) - lu(k,528) * lu(k,1793) - lu(k,1811) = lu(k,1811) - lu(k,529) * lu(k,1793) - lu(k,1812) = lu(k,1812) - lu(k,530) * lu(k,1793) - lu(k,1814) = lu(k,1814) - lu(k,531) * lu(k,1793) - lu(k,1819) = lu(k,1819) - lu(k,532) * lu(k,1793) - lu(k,1823) = lu(k,1823) - lu(k,533) * lu(k,1793) - lu(k,1824) = lu(k,1824) - lu(k,534) * lu(k,1793) - lu(k,1825) = lu(k,1825) - lu(k,535) * lu(k,1793) - lu(k,541) = 1._r8 / lu(k,541) - lu(k,542) = lu(k,542) * lu(k,541) - lu(k,543) = lu(k,543) * lu(k,541) - lu(k,544) = lu(k,544) * lu(k,541) - lu(k,545) = lu(k,545) * lu(k,541) - lu(k,546) = lu(k,546) * lu(k,541) - lu(k,547) = lu(k,547) * lu(k,541) - lu(k,548) = lu(k,548) * lu(k,541) - lu(k,549) = lu(k,549) * lu(k,541) - lu(k,550) = lu(k,550) * lu(k,541) - lu(k,551) = lu(k,551) * lu(k,541) - lu(k,552) = lu(k,552) * lu(k,541) - lu(k,553) = lu(k,553) * lu(k,541) - lu(k,554) = lu(k,554) * lu(k,541) - lu(k,555) = lu(k,555) * lu(k,541) - lu(k,556) = lu(k,556) * lu(k,541) - lu(k,557) = lu(k,557) * lu(k,541) - lu(k,558) = lu(k,558) * lu(k,541) - lu(k,559) = lu(k,559) * lu(k,541) - lu(k,560) = lu(k,560) * lu(k,541) - lu(k,573) = lu(k,573) - lu(k,542) * lu(k,572) - lu(k,574) = lu(k,574) - lu(k,543) * lu(k,572) - lu(k,575) = lu(k,575) - lu(k,544) * lu(k,572) - lu(k,577) = lu(k,577) - lu(k,545) * lu(k,572) - lu(k,578) = lu(k,578) - lu(k,546) * lu(k,572) - lu(k,579) = lu(k,579) - lu(k,547) * lu(k,572) - lu(k,580) = lu(k,580) - lu(k,548) * lu(k,572) - lu(k,581) = lu(k,581) - lu(k,549) * lu(k,572) - lu(k,582) = lu(k,582) - lu(k,550) * lu(k,572) - lu(k,585) = lu(k,585) - lu(k,551) * lu(k,572) - lu(k,586) = lu(k,586) - lu(k,552) * lu(k,572) - lu(k,587) = lu(k,587) - lu(k,553) * lu(k,572) - lu(k,588) = lu(k,588) - lu(k,554) * lu(k,572) - lu(k,589) = lu(k,589) - lu(k,555) * lu(k,572) - lu(k,590) = lu(k,590) - lu(k,556) * lu(k,572) - lu(k,591) = lu(k,591) - lu(k,557) * lu(k,572) - lu(k,592) = lu(k,592) - lu(k,558) * lu(k,572) - lu(k,593) = lu(k,593) - lu(k,559) * lu(k,572) - lu(k,594) = lu(k,594) - lu(k,560) * lu(k,572) - lu(k,685) = lu(k,685) - lu(k,542) * lu(k,684) - lu(k,686) = lu(k,686) - lu(k,543) * lu(k,684) - lu(k,687) = lu(k,687) - lu(k,544) * lu(k,684) - lu(k,689) = lu(k,689) - lu(k,545) * lu(k,684) - lu(k,690) = lu(k,690) - lu(k,546) * lu(k,684) - lu(k,692) = lu(k,692) - lu(k,547) * lu(k,684) - lu(k,693) = lu(k,693) - lu(k,548) * lu(k,684) - lu(k,694) = lu(k,694) - lu(k,549) * lu(k,684) - lu(k,695) = lu(k,695) - lu(k,550) * lu(k,684) - lu(k,698) = lu(k,698) - lu(k,551) * lu(k,684) - lu(k,699) = lu(k,699) - lu(k,552) * lu(k,684) - lu(k,700) = lu(k,700) - lu(k,553) * lu(k,684) - lu(k,701) = lu(k,701) - lu(k,554) * lu(k,684) - lu(k,702) = lu(k,702) - lu(k,555) * lu(k,684) - lu(k,703) = lu(k,703) - lu(k,556) * lu(k,684) - lu(k,704) = lu(k,704) - lu(k,557) * lu(k,684) - lu(k,705) = lu(k,705) - lu(k,558) * lu(k,684) - lu(k,706) = lu(k,706) - lu(k,559) * lu(k,684) - lu(k,707) = lu(k,707) - lu(k,560) * lu(k,684) - lu(k,753) = lu(k,753) - lu(k,542) * lu(k,752) - lu(k,754) = lu(k,754) - lu(k,543) * lu(k,752) - lu(k,755) = lu(k,755) - lu(k,544) * lu(k,752) - lu(k,758) = lu(k,758) - lu(k,545) * lu(k,752) - lu(k,759) = lu(k,759) - lu(k,546) * lu(k,752) - lu(k,761) = lu(k,761) - lu(k,547) * lu(k,752) - lu(k,762) = lu(k,762) - lu(k,548) * lu(k,752) - lu(k,763) = lu(k,763) - lu(k,549) * lu(k,752) - lu(k,764) = lu(k,764) - lu(k,550) * lu(k,752) - lu(k,767) = lu(k,767) - lu(k,551) * lu(k,752) - lu(k,768) = lu(k,768) - lu(k,552) * lu(k,752) - lu(k,769) = lu(k,769) - lu(k,553) * lu(k,752) - lu(k,770) = lu(k,770) - lu(k,554) * lu(k,752) - lu(k,771) = lu(k,771) - lu(k,555) * lu(k,752) - lu(k,772) = lu(k,772) - lu(k,556) * lu(k,752) - lu(k,773) = lu(k,773) - lu(k,557) * lu(k,752) - lu(k,774) = lu(k,774) - lu(k,558) * lu(k,752) - lu(k,775) = lu(k,775) - lu(k,559) * lu(k,752) - lu(k,776) = lu(k,776) - lu(k,560) * lu(k,752) - lu(k,968) = lu(k,968) - lu(k,542) * lu(k,967) - lu(k,972) = lu(k,972) - lu(k,543) * lu(k,967) - lu(k,974) = lu(k,974) - lu(k,544) * lu(k,967) - lu(k,979) = lu(k,979) - lu(k,545) * lu(k,967) - lu(k,980) = lu(k,980) - lu(k,546) * lu(k,967) - lu(k,982) = lu(k,982) - lu(k,547) * lu(k,967) - lu(k,983) = lu(k,983) - lu(k,548) * lu(k,967) - lu(k,985) = lu(k,985) - lu(k,549) * lu(k,967) - lu(k,986) = lu(k,986) - lu(k,550) * lu(k,967) - lu(k,989) = lu(k,989) - lu(k,551) * lu(k,967) - lu(k,990) = lu(k,990) - lu(k,552) * lu(k,967) - lu(k,991) = lu(k,991) - lu(k,553) * lu(k,967) - lu(k,992) = lu(k,992) - lu(k,554) * lu(k,967) - lu(k,994) = lu(k,994) - lu(k,555) * lu(k,967) - lu(k,995) = lu(k,995) - lu(k,556) * lu(k,967) - lu(k,996) = lu(k,996) - lu(k,557) * lu(k,967) - lu(k,997) = lu(k,997) - lu(k,558) * lu(k,967) - lu(k,998) = lu(k,998) - lu(k,559) * lu(k,967) - lu(k,999) = lu(k,999) - lu(k,560) * lu(k,967) - lu(k,1094) = lu(k,1094) - lu(k,542) * lu(k,1093) - lu(k,1097) = lu(k,1097) - lu(k,543) * lu(k,1093) - lu(k,1099) = lu(k,1099) - lu(k,544) * lu(k,1093) - lu(k,1104) = lu(k,1104) - lu(k,545) * lu(k,1093) - lu(k,1105) = lu(k,1105) - lu(k,546) * lu(k,1093) - lu(k,1107) = lu(k,1107) - lu(k,547) * lu(k,1093) - lu(k,1108) = lu(k,1108) - lu(k,548) * lu(k,1093) - lu(k,1110) = lu(k,1110) - lu(k,549) * lu(k,1093) - lu(k,1111) = lu(k,1111) - lu(k,550) * lu(k,1093) - lu(k,1114) = lu(k,1114) - lu(k,551) * lu(k,1093) - lu(k,1115) = - lu(k,552) * lu(k,1093) - lu(k,1116) = lu(k,1116) - lu(k,553) * lu(k,1093) - lu(k,1117) = lu(k,1117) - lu(k,554) * lu(k,1093) - lu(k,1119) = lu(k,1119) - lu(k,555) * lu(k,1093) - lu(k,1120) = lu(k,1120) - lu(k,556) * lu(k,1093) - lu(k,1121) = lu(k,1121) - lu(k,557) * lu(k,1093) - lu(k,1122) = lu(k,1122) - lu(k,558) * lu(k,1093) - lu(k,1123) = lu(k,1123) - lu(k,559) * lu(k,1093) - lu(k,1124) = lu(k,1124) - lu(k,560) * lu(k,1093) - lu(k,1139) = lu(k,1139) - lu(k,542) * lu(k,1138) - lu(k,1142) = lu(k,1142) - lu(k,543) * lu(k,1138) - lu(k,1144) = lu(k,1144) - lu(k,544) * lu(k,1138) - lu(k,1149) = lu(k,1149) - lu(k,545) * lu(k,1138) - lu(k,1150) = lu(k,1150) - lu(k,546) * lu(k,1138) - lu(k,1152) = lu(k,1152) - lu(k,547) * lu(k,1138) - lu(k,1153) = lu(k,1153) - lu(k,548) * lu(k,1138) - lu(k,1155) = lu(k,1155) - lu(k,549) * lu(k,1138) - lu(k,1156) = lu(k,1156) - lu(k,550) * lu(k,1138) - lu(k,1159) = lu(k,1159) - lu(k,551) * lu(k,1138) - lu(k,1160) = lu(k,1160) - lu(k,552) * lu(k,1138) - lu(k,1161) = lu(k,1161) - lu(k,553) * lu(k,1138) - lu(k,1162) = lu(k,1162) - lu(k,554) * lu(k,1138) - lu(k,1164) = lu(k,1164) - lu(k,555) * lu(k,1138) - lu(k,1165) = lu(k,1165) - lu(k,556) * lu(k,1138) - lu(k,1166) = lu(k,1166) - lu(k,557) * lu(k,1138) - lu(k,1167) = lu(k,1167) - lu(k,558) * lu(k,1138) - lu(k,1168) = lu(k,1168) - lu(k,559) * lu(k,1138) - lu(k,1169) = lu(k,1169) - lu(k,560) * lu(k,1138) - lu(k,1219) = - lu(k,542) * lu(k,1218) - lu(k,1221) = lu(k,1221) - lu(k,543) * lu(k,1218) - lu(k,1223) = lu(k,1223) - lu(k,544) * lu(k,1218) - lu(k,1227) = lu(k,1227) - lu(k,545) * lu(k,1218) - lu(k,1228) = - lu(k,546) * lu(k,1218) - lu(k,1230) = lu(k,1230) - lu(k,547) * lu(k,1218) - lu(k,1231) = lu(k,1231) - lu(k,548) * lu(k,1218) - lu(k,1233) = lu(k,1233) - lu(k,549) * lu(k,1218) - lu(k,1234) = lu(k,1234) - lu(k,550) * lu(k,1218) - lu(k,1237) = lu(k,1237) - lu(k,551) * lu(k,1218) - lu(k,1238) = - lu(k,552) * lu(k,1218) - lu(k,1239) = - lu(k,553) * lu(k,1218) - lu(k,1240) = - lu(k,554) * lu(k,1218) - lu(k,1242) = - lu(k,555) * lu(k,1218) - lu(k,1243) = - lu(k,556) * lu(k,1218) - lu(k,1244) = - lu(k,557) * lu(k,1218) - lu(k,1245) = lu(k,1245) - lu(k,558) * lu(k,1218) - lu(k,1246) = lu(k,1246) - lu(k,559) * lu(k,1218) - lu(k,1247) = lu(k,1247) - lu(k,560) * lu(k,1218) - lu(k,1421) = lu(k,1421) - lu(k,542) * lu(k,1420) - lu(k,1424) = lu(k,1424) - lu(k,543) * lu(k,1420) - lu(k,1426) = lu(k,1426) - lu(k,544) * lu(k,1420) - lu(k,1431) = lu(k,1431) - lu(k,545) * lu(k,1420) - lu(k,1432) = lu(k,1432) - lu(k,546) * lu(k,1420) - lu(k,1434) = lu(k,1434) - lu(k,547) * lu(k,1420) - lu(k,1435) = lu(k,1435) - lu(k,548) * lu(k,1420) - lu(k,1437) = lu(k,1437) - lu(k,549) * lu(k,1420) - lu(k,1438) = lu(k,1438) - lu(k,550) * lu(k,1420) - lu(k,1441) = lu(k,1441) - lu(k,551) * lu(k,1420) - lu(k,1442) = lu(k,1442) - lu(k,552) * lu(k,1420) - lu(k,1443) = lu(k,1443) - lu(k,553) * lu(k,1420) - lu(k,1444) = lu(k,1444) - lu(k,554) * lu(k,1420) - lu(k,1446) = lu(k,1446) - lu(k,555) * lu(k,1420) - lu(k,1447) = lu(k,1447) - lu(k,556) * lu(k,1420) - lu(k,1448) = lu(k,1448) - lu(k,557) * lu(k,1420) - lu(k,1449) = lu(k,1449) - lu(k,558) * lu(k,1420) - lu(k,1450) = lu(k,1450) - lu(k,559) * lu(k,1420) - lu(k,1451) = lu(k,1451) - lu(k,560) * lu(k,1420) - lu(k,1465) = lu(k,1465) - lu(k,542) * lu(k,1464) - lu(k,1469) = lu(k,1469) - lu(k,543) * lu(k,1464) - lu(k,1471) = lu(k,1471) - lu(k,544) * lu(k,1464) - lu(k,1476) = lu(k,1476) - lu(k,545) * lu(k,1464) - lu(k,1477) = - lu(k,546) * lu(k,1464) - lu(k,1479) = lu(k,1479) - lu(k,547) * lu(k,1464) - lu(k,1480) = lu(k,1480) - lu(k,548) * lu(k,1464) - lu(k,1482) = lu(k,1482) - lu(k,549) * lu(k,1464) - lu(k,1483) = lu(k,1483) - lu(k,550) * lu(k,1464) - lu(k,1486) = lu(k,1486) - lu(k,551) * lu(k,1464) - lu(k,1487) = lu(k,1487) - lu(k,552) * lu(k,1464) - lu(k,1488) = lu(k,1488) - lu(k,553) * lu(k,1464) - lu(k,1489) = lu(k,1489) - lu(k,554) * lu(k,1464) - lu(k,1491) = lu(k,1491) - lu(k,555) * lu(k,1464) - lu(k,1492) = lu(k,1492) - lu(k,556) * lu(k,1464) - lu(k,1493) = lu(k,1493) - lu(k,557) * lu(k,1464) - lu(k,1494) = lu(k,1494) - lu(k,558) * lu(k,1464) - lu(k,1495) = lu(k,1495) - lu(k,559) * lu(k,1464) - lu(k,1496) = lu(k,1496) - lu(k,560) * lu(k,1464) - lu(k,1508) = lu(k,1508) - lu(k,542) * lu(k,1507) - lu(k,1512) = lu(k,1512) - lu(k,543) * lu(k,1507) - lu(k,1514) = lu(k,1514) - lu(k,544) * lu(k,1507) - lu(k,1519) = lu(k,1519) - lu(k,545) * lu(k,1507) - lu(k,1520) = - lu(k,546) * lu(k,1507) - lu(k,1522) = lu(k,1522) - lu(k,547) * lu(k,1507) - lu(k,1523) = lu(k,1523) - lu(k,548) * lu(k,1507) - lu(k,1525) = lu(k,1525) - lu(k,549) * lu(k,1507) - lu(k,1526) = lu(k,1526) - lu(k,550) * lu(k,1507) - lu(k,1529) = lu(k,1529) - lu(k,551) * lu(k,1507) - lu(k,1530) = lu(k,1530) - lu(k,552) * lu(k,1507) - lu(k,1531) = lu(k,1531) - lu(k,553) * lu(k,1507) - lu(k,1532) = lu(k,1532) - lu(k,554) * lu(k,1507) - lu(k,1534) = lu(k,1534) - lu(k,555) * lu(k,1507) - lu(k,1535) = lu(k,1535) - lu(k,556) * lu(k,1507) - lu(k,1536) = lu(k,1536) - lu(k,557) * lu(k,1507) - lu(k,1537) = lu(k,1537) - lu(k,558) * lu(k,1507) - lu(k,1538) = lu(k,1538) - lu(k,559) * lu(k,1507) - lu(k,1539) = lu(k,1539) - lu(k,560) * lu(k,1507) - lu(k,1621) = lu(k,1621) - lu(k,542) * lu(k,1620) - lu(k,1624) = lu(k,1624) - lu(k,543) * lu(k,1620) - lu(k,1626) = lu(k,1626) - lu(k,544) * lu(k,1620) - lu(k,1631) = lu(k,1631) - lu(k,545) * lu(k,1620) - lu(k,1632) = lu(k,1632) - lu(k,546) * lu(k,1620) - lu(k,1634) = lu(k,1634) - lu(k,547) * lu(k,1620) - lu(k,1635) = lu(k,1635) - lu(k,548) * lu(k,1620) - lu(k,1637) = lu(k,1637) - lu(k,549) * lu(k,1620) - lu(k,1638) = lu(k,1638) - lu(k,550) * lu(k,1620) - lu(k,1641) = lu(k,1641) - lu(k,551) * lu(k,1620) - lu(k,1642) = lu(k,1642) - lu(k,552) * lu(k,1620) - lu(k,1643) = lu(k,1643) - lu(k,553) * lu(k,1620) - lu(k,1644) = lu(k,1644) - lu(k,554) * lu(k,1620) - lu(k,1646) = lu(k,1646) - lu(k,555) * lu(k,1620) - lu(k,1647) = lu(k,1647) - lu(k,556) * lu(k,1620) - lu(k,1648) = lu(k,1648) - lu(k,557) * lu(k,1620) - lu(k,1649) = lu(k,1649) - lu(k,558) * lu(k,1620) - lu(k,1650) = lu(k,1650) - lu(k,559) * lu(k,1620) - lu(k,1651) = lu(k,1651) - lu(k,560) * lu(k,1620) - lu(k,1663) = lu(k,1663) - lu(k,542) * lu(k,1662) - lu(k,1667) = lu(k,1667) - lu(k,543) * lu(k,1662) - lu(k,1669) = lu(k,1669) - lu(k,544) * lu(k,1662) - lu(k,1674) = lu(k,1674) - lu(k,545) * lu(k,1662) - lu(k,1675) = lu(k,1675) - lu(k,546) * lu(k,1662) - lu(k,1677) = lu(k,1677) - lu(k,547) * lu(k,1662) - lu(k,1678) = lu(k,1678) - lu(k,548) * lu(k,1662) - lu(k,1680) = lu(k,1680) - lu(k,549) * lu(k,1662) - lu(k,1681) = lu(k,1681) - lu(k,550) * lu(k,1662) - lu(k,1684) = lu(k,1684) - lu(k,551) * lu(k,1662) - lu(k,1685) = lu(k,1685) - lu(k,552) * lu(k,1662) - lu(k,1686) = lu(k,1686) - lu(k,553) * lu(k,1662) - lu(k,1687) = lu(k,1687) - lu(k,554) * lu(k,1662) - lu(k,1689) = lu(k,1689) - lu(k,555) * lu(k,1662) - lu(k,1690) = lu(k,1690) - lu(k,556) * lu(k,1662) - lu(k,1691) = lu(k,1691) - lu(k,557) * lu(k,1662) - lu(k,1692) = lu(k,1692) - lu(k,558) * lu(k,1662) - lu(k,1693) = lu(k,1693) - lu(k,559) * lu(k,1662) - lu(k,1694) = lu(k,1694) - lu(k,560) * lu(k,1662) - lu(k,1699) = lu(k,1699) - lu(k,542) * lu(k,1698) - lu(k,1703) = lu(k,1703) - lu(k,543) * lu(k,1698) - lu(k,1705) = lu(k,1705) - lu(k,544) * lu(k,1698) - lu(k,1710) = lu(k,1710) - lu(k,545) * lu(k,1698) - lu(k,1711) = lu(k,1711) - lu(k,546) * lu(k,1698) - lu(k,1713) = lu(k,1713) - lu(k,547) * lu(k,1698) - lu(k,1714) = lu(k,1714) - lu(k,548) * lu(k,1698) - lu(k,1716) = lu(k,1716) - lu(k,549) * lu(k,1698) - lu(k,1717) = lu(k,1717) - lu(k,550) * lu(k,1698) - lu(k,1720) = lu(k,1720) - lu(k,551) * lu(k,1698) - lu(k,1721) = lu(k,1721) - lu(k,552) * lu(k,1698) - lu(k,1722) = lu(k,1722) - lu(k,553) * lu(k,1698) - lu(k,1723) = lu(k,1723) - lu(k,554) * lu(k,1698) - lu(k,1725) = lu(k,1725) - lu(k,555) * lu(k,1698) - lu(k,1726) = lu(k,1726) - lu(k,556) * lu(k,1698) - lu(k,1727) = lu(k,1727) - lu(k,557) * lu(k,1698) - lu(k,1728) = lu(k,1728) - lu(k,558) * lu(k,1698) - lu(k,1729) = lu(k,1729) - lu(k,559) * lu(k,1698) - lu(k,1730) = lu(k,1730) - lu(k,560) * lu(k,1698) - lu(k,1742) = lu(k,1742) - lu(k,542) * lu(k,1741) - lu(k,1745) = lu(k,1745) - lu(k,543) * lu(k,1741) - lu(k,1747) = lu(k,1747) - lu(k,544) * lu(k,1741) - lu(k,1752) = lu(k,1752) - lu(k,545) * lu(k,1741) - lu(k,1753) = lu(k,1753) - lu(k,546) * lu(k,1741) - lu(k,1755) = lu(k,1755) - lu(k,547) * lu(k,1741) - lu(k,1756) = lu(k,1756) - lu(k,548) * lu(k,1741) - lu(k,1758) = lu(k,1758) - lu(k,549) * lu(k,1741) - lu(k,1759) = lu(k,1759) - lu(k,550) * lu(k,1741) - lu(k,1762) = lu(k,1762) - lu(k,551) * lu(k,1741) - lu(k,1763) = lu(k,1763) - lu(k,552) * lu(k,1741) - lu(k,1764) = lu(k,1764) - lu(k,553) * lu(k,1741) - lu(k,1765) = lu(k,1765) - lu(k,554) * lu(k,1741) - lu(k,1767) = lu(k,1767) - lu(k,555) * lu(k,1741) - lu(k,1768) = lu(k,1768) - lu(k,556) * lu(k,1741) - lu(k,1769) = lu(k,1769) - lu(k,557) * lu(k,1741) - lu(k,1770) = lu(k,1770) - lu(k,558) * lu(k,1741) - lu(k,1771) = lu(k,1771) - lu(k,559) * lu(k,1741) - lu(k,1772) = lu(k,1772) - lu(k,560) * lu(k,1741) - lu(k,1795) = lu(k,1795) - lu(k,542) * lu(k,1794) - lu(k,1798) = lu(k,1798) - lu(k,543) * lu(k,1794) - lu(k,1800) = lu(k,1800) - lu(k,544) * lu(k,1794) - lu(k,1805) = lu(k,1805) - lu(k,545) * lu(k,1794) - lu(k,1806) = lu(k,1806) - lu(k,546) * lu(k,1794) - lu(k,1808) = lu(k,1808) - lu(k,547) * lu(k,1794) - lu(k,1809) = lu(k,1809) - lu(k,548) * lu(k,1794) - lu(k,1811) = lu(k,1811) - lu(k,549) * lu(k,1794) - lu(k,1812) = lu(k,1812) - lu(k,550) * lu(k,1794) - lu(k,1815) = lu(k,1815) - lu(k,551) * lu(k,1794) - lu(k,1816) = lu(k,1816) - lu(k,552) * lu(k,1794) - lu(k,1817) = lu(k,1817) - lu(k,553) * lu(k,1794) - lu(k,1818) = lu(k,1818) - lu(k,554) * lu(k,1794) - lu(k,1820) = lu(k,1820) - lu(k,555) * lu(k,1794) - lu(k,1821) = lu(k,1821) - lu(k,556) * lu(k,1794) - lu(k,1822) = lu(k,1822) - lu(k,557) * lu(k,1794) - lu(k,1823) = lu(k,1823) - lu(k,558) * lu(k,1794) - lu(k,1824) = lu(k,1824) - lu(k,559) * lu(k,1794) - lu(k,1825) = lu(k,1825) - lu(k,560) * lu(k,1794) - end do + real(r8), intent(inout) :: lu(:) + lu(507) = 1._r8 / lu(507) + lu(508) = lu(508) * lu(507) + lu(509) = lu(509) * lu(507) + lu(510) = lu(510) * lu(507) + lu(511) = lu(511) * lu(507) + lu(512) = lu(512) * lu(507) + lu(513) = lu(513) * lu(507) + lu(514) = lu(514) * lu(507) + lu(515) = lu(515) * lu(507) + lu(516) = lu(516) * lu(507) + lu(517) = lu(517) * lu(507) + lu(518) = lu(518) * lu(507) + lu(519) = lu(519) * lu(507) + lu(520) = lu(520) * lu(507) + lu(521) = lu(521) * lu(507) + lu(522) = lu(522) * lu(507) + lu(523) = lu(523) * lu(507) + lu(636) = lu(636) - lu(508) * lu(634) + lu(638) = lu(638) - lu(509) * lu(634) + lu(639) = lu(639) - lu(510) * lu(634) + lu(641) = lu(641) - lu(511) * lu(634) + lu(642) = lu(642) - lu(512) * lu(634) + lu(643) = lu(643) - lu(513) * lu(634) + lu(644) = - lu(514) * lu(634) + lu(645) = lu(645) - lu(515) * lu(634) + lu(647) = lu(647) - lu(516) * lu(634) + lu(648) = lu(648) - lu(517) * lu(634) + lu(649) = lu(649) - lu(518) * lu(634) + lu(651) = lu(651) - lu(519) * lu(634) + lu(652) = lu(652) - lu(520) * lu(634) + lu(654) = lu(654) - lu(521) * lu(634) + lu(655) = lu(655) - lu(522) * lu(634) + lu(656) = lu(656) - lu(523) * lu(634) + lu(737) = lu(737) - lu(508) * lu(735) + lu(741) = lu(741) - lu(509) * lu(735) + lu(742) = lu(742) - lu(510) * lu(735) + lu(744) = lu(744) - lu(511) * lu(735) + lu(745) = lu(745) - lu(512) * lu(735) + lu(746) = lu(746) - lu(513) * lu(735) + lu(747) = lu(747) - lu(514) * lu(735) + lu(749) = lu(749) - lu(515) * lu(735) + lu(752) = lu(752) - lu(516) * lu(735) + lu(753) = lu(753) - lu(517) * lu(735) + lu(754) = lu(754) - lu(518) * lu(735) + lu(756) = lu(756) - lu(519) * lu(735) + lu(757) = lu(757) - lu(520) * lu(735) + lu(761) = lu(761) - lu(521) * lu(735) + lu(762) = - lu(522) * lu(735) + lu(763) = lu(763) - lu(523) * lu(735) + lu(812) = lu(812) - lu(508) * lu(808) + lu(817) = lu(817) - lu(509) * lu(808) + lu(818) = lu(818) - lu(510) * lu(808) + lu(820) = lu(820) - lu(511) * lu(808) + lu(821) = lu(821) - lu(512) * lu(808) + lu(822) = lu(822) - lu(513) * lu(808) + lu(823) = lu(823) - lu(514) * lu(808) + lu(825) = lu(825) - lu(515) * lu(808) + lu(828) = lu(828) - lu(516) * lu(808) + lu(829) = lu(829) - lu(517) * lu(808) + lu(830) = lu(830) - lu(518) * lu(808) + lu(832) = lu(832) - lu(519) * lu(808) + lu(833) = lu(833) - lu(520) * lu(808) + lu(837) = lu(837) - lu(521) * lu(808) + lu(838) = lu(838) - lu(522) * lu(808) + lu(839) = lu(839) - lu(523) * lu(808) + lu(854) = lu(854) - lu(508) * lu(851) + lu(859) = lu(859) - lu(509) * lu(851) + lu(860) = lu(860) - lu(510) * lu(851) + lu(862) = lu(862) - lu(511) * lu(851) + lu(863) = lu(863) - lu(512) * lu(851) + lu(864) = lu(864) - lu(513) * lu(851) + lu(865) = lu(865) - lu(514) * lu(851) + lu(867) = lu(867) - lu(515) * lu(851) + lu(870) = lu(870) - lu(516) * lu(851) + lu(871) = lu(871) - lu(517) * lu(851) + lu(872) = lu(872) - lu(518) * lu(851) + lu(874) = lu(874) - lu(519) * lu(851) + lu(875) = lu(875) - lu(520) * lu(851) + lu(879) = lu(879) - lu(521) * lu(851) + lu(880) = lu(880) - lu(522) * lu(851) + lu(881) = lu(881) - lu(523) * lu(851) + lu(974) = lu(974) - lu(508) * lu(971) + lu(979) = lu(979) - lu(509) * lu(971) + lu(980) = lu(980) - lu(510) * lu(971) + lu(982) = lu(982) - lu(511) * lu(971) + lu(983) = lu(983) - lu(512) * lu(971) + lu(984) = lu(984) - lu(513) * lu(971) + lu(985) = lu(985) - lu(514) * lu(971) + lu(987) = lu(987) - lu(515) * lu(971) + lu(990) = lu(990) - lu(516) * lu(971) + lu(991) = lu(991) - lu(517) * lu(971) + lu(992) = lu(992) - lu(518) * lu(971) + lu(994) = lu(994) - lu(519) * lu(971) + lu(995) = lu(995) - lu(520) * lu(971) + lu(999) = lu(999) - lu(521) * lu(971) + lu(1000) = lu(1000) - lu(522) * lu(971) + lu(1001) = lu(1001) - lu(523) * lu(971) + lu(1016) = lu(1016) - lu(508) * lu(1013) + lu(1021) = lu(1021) - lu(509) * lu(1013) + lu(1022) = lu(1022) - lu(510) * lu(1013) + lu(1024) = lu(1024) - lu(511) * lu(1013) + lu(1025) = lu(1025) - lu(512) * lu(1013) + lu(1026) = lu(1026) - lu(513) * lu(1013) + lu(1027) = lu(1027) - lu(514) * lu(1013) + lu(1029) = lu(1029) - lu(515) * lu(1013) + lu(1032) = lu(1032) - lu(516) * lu(1013) + lu(1033) = lu(1033) - lu(517) * lu(1013) + lu(1034) = lu(1034) - lu(518) * lu(1013) + lu(1036) = lu(1036) - lu(519) * lu(1013) + lu(1037) = lu(1037) - lu(520) * lu(1013) + lu(1041) = lu(1041) - lu(521) * lu(1013) + lu(1042) = lu(1042) - lu(522) * lu(1013) + lu(1043) = lu(1043) - lu(523) * lu(1013) + lu(1060) = lu(1060) - lu(508) * lu(1056) + lu(1065) = lu(1065) - lu(509) * lu(1056) + lu(1066) = lu(1066) - lu(510) * lu(1056) + lu(1068) = lu(1068) - lu(511) * lu(1056) + lu(1069) = lu(1069) - lu(512) * lu(1056) + lu(1070) = lu(1070) - lu(513) * lu(1056) + lu(1071) = lu(1071) - lu(514) * lu(1056) + lu(1073) = lu(1073) - lu(515) * lu(1056) + lu(1076) = lu(1076) - lu(516) * lu(1056) + lu(1077) = lu(1077) - lu(517) * lu(1056) + lu(1078) = lu(1078) - lu(518) * lu(1056) + lu(1080) = lu(1080) - lu(519) * lu(1056) + lu(1081) = lu(1081) - lu(520) * lu(1056) + lu(1085) = lu(1085) - lu(521) * lu(1056) + lu(1086) = lu(1086) - lu(522) * lu(1056) + lu(1087) = lu(1087) - lu(523) * lu(1056) + lu(1266) = lu(1266) - lu(508) * lu(1262) + lu(1271) = lu(1271) - lu(509) * lu(1262) + lu(1272) = lu(1272) - lu(510) * lu(1262) + lu(1274) = lu(1274) - lu(511) * lu(1262) + lu(1275) = lu(1275) - lu(512) * lu(1262) + lu(1276) = lu(1276) - lu(513) * lu(1262) + lu(1277) = lu(1277) - lu(514) * lu(1262) + lu(1279) = lu(1279) - lu(515) * lu(1262) + lu(1282) = lu(1282) - lu(516) * lu(1262) + lu(1283) = lu(1283) - lu(517) * lu(1262) + lu(1284) = lu(1284) - lu(518) * lu(1262) + lu(1286) = lu(1286) - lu(519) * lu(1262) + lu(1287) = lu(1287) - lu(520) * lu(1262) + lu(1291) = lu(1291) - lu(521) * lu(1262) + lu(1292) = lu(1292) - lu(522) * lu(1262) + lu(1293) = lu(1293) - lu(523) * lu(1262) + lu(1307) = lu(1307) - lu(508) * lu(1303) + lu(1312) = lu(1312) - lu(509) * lu(1303) + lu(1313) = lu(1313) - lu(510) * lu(1303) + lu(1315) = lu(1315) - lu(511) * lu(1303) + lu(1316) = lu(1316) - lu(512) * lu(1303) + lu(1317) = lu(1317) - lu(513) * lu(1303) + lu(1318) = lu(1318) - lu(514) * lu(1303) + lu(1320) = lu(1320) - lu(515) * lu(1303) + lu(1323) = lu(1323) - lu(516) * lu(1303) + lu(1324) = lu(1324) - lu(517) * lu(1303) + lu(1325) = lu(1325) - lu(518) * lu(1303) + lu(1327) = lu(1327) - lu(519) * lu(1303) + lu(1328) = lu(1328) - lu(520) * lu(1303) + lu(1332) = lu(1332) - lu(521) * lu(1303) + lu(1333) = lu(1333) - lu(522) * lu(1303) + lu(1334) = lu(1334) - lu(523) * lu(1303) + lu(1349) = lu(1349) - lu(508) * lu(1346) + lu(1354) = lu(1354) - lu(509) * lu(1346) + lu(1355) = lu(1355) - lu(510) * lu(1346) + lu(1357) = lu(1357) - lu(511) * lu(1346) + lu(1358) = lu(1358) - lu(512) * lu(1346) + lu(1359) = lu(1359) - lu(513) * lu(1346) + lu(1360) = lu(1360) - lu(514) * lu(1346) + lu(1362) = lu(1362) - lu(515) * lu(1346) + lu(1365) = lu(1365) - lu(516) * lu(1346) + lu(1366) = lu(1366) - lu(517) * lu(1346) + lu(1367) = lu(1367) - lu(518) * lu(1346) + lu(1369) = lu(1369) - lu(519) * lu(1346) + lu(1370) = lu(1370) - lu(520) * lu(1346) + lu(1374) = lu(1374) - lu(521) * lu(1346) + lu(1375) = lu(1375) - lu(522) * lu(1346) + lu(1376) = lu(1376) - lu(523) * lu(1346) + lu(1433) = lu(1433) - lu(508) * lu(1430) + lu(1438) = lu(1438) - lu(509) * lu(1430) + lu(1439) = lu(1439) - lu(510) * lu(1430) + lu(1441) = lu(1441) - lu(511) * lu(1430) + lu(1442) = lu(1442) - lu(512) * lu(1430) + lu(1443) = lu(1443) - lu(513) * lu(1430) + lu(1444) = lu(1444) - lu(514) * lu(1430) + lu(1446) = lu(1446) - lu(515) * lu(1430) + lu(1449) = lu(1449) - lu(516) * lu(1430) + lu(1450) = lu(1450) - lu(517) * lu(1430) + lu(1451) = lu(1451) - lu(518) * lu(1430) + lu(1453) = lu(1453) - lu(519) * lu(1430) + lu(1454) = lu(1454) - lu(520) * lu(1430) + lu(1458) = lu(1458) - lu(521) * lu(1430) + lu(1459) = lu(1459) - lu(522) * lu(1430) + lu(1460) = lu(1460) - lu(523) * lu(1430) + lu(1632) = lu(1632) - lu(508) * lu(1628) + lu(1637) = lu(1637) - lu(509) * lu(1628) + lu(1638) = lu(1638) - lu(510) * lu(1628) + lu(1640) = lu(1640) - lu(511) * lu(1628) + lu(1641) = lu(1641) - lu(512) * lu(1628) + lu(1642) = lu(1642) - lu(513) * lu(1628) + lu(1643) = lu(1643) - lu(514) * lu(1628) + lu(1645) = lu(1645) - lu(515) * lu(1628) + lu(1648) = lu(1648) - lu(516) * lu(1628) + lu(1649) = lu(1649) - lu(517) * lu(1628) + lu(1650) = lu(1650) - lu(518) * lu(1628) + lu(1652) = lu(1652) - lu(519) * lu(1628) + lu(1653) = lu(1653) - lu(520) * lu(1628) + lu(1657) = lu(1657) - lu(521) * lu(1628) + lu(1658) = lu(1658) - lu(522) * lu(1628) + lu(1659) = lu(1659) - lu(523) * lu(1628) + lu(1667) = lu(1667) - lu(508) * lu(1664) + lu(1671) = lu(1671) - lu(509) * lu(1664) + lu(1672) = lu(1672) - lu(510) * lu(1664) + lu(1674) = lu(1674) - lu(511) * lu(1664) + lu(1675) = lu(1675) - lu(512) * lu(1664) + lu(1676) = lu(1676) - lu(513) * lu(1664) + lu(1677) = lu(1677) - lu(514) * lu(1664) + lu(1679) = lu(1679) - lu(515) * lu(1664) + lu(1682) = lu(1682) - lu(516) * lu(1664) + lu(1683) = lu(1683) - lu(517) * lu(1664) + lu(1684) = lu(1684) - lu(518) * lu(1664) + lu(1686) = lu(1686) - lu(519) * lu(1664) + lu(1687) = lu(1687) - lu(520) * lu(1664) + lu(1691) = lu(1691) - lu(521) * lu(1664) + lu(1692) = lu(1692) - lu(522) * lu(1664) + lu(1693) = lu(1693) - lu(523) * lu(1664) + lu(1718) = lu(1718) - lu(508) * lu(1714) + lu(1723) = lu(1723) - lu(509) * lu(1714) + lu(1724) = lu(1724) - lu(510) * lu(1714) + lu(1726) = lu(1726) - lu(511) * lu(1714) + lu(1727) = lu(1727) - lu(512) * lu(1714) + lu(1728) = lu(1728) - lu(513) * lu(1714) + lu(1729) = lu(1729) - lu(514) * lu(1714) + lu(1731) = lu(1731) - lu(515) * lu(1714) + lu(1734) = lu(1734) - lu(516) * lu(1714) + lu(1735) = lu(1735) - lu(517) * lu(1714) + lu(1736) = lu(1736) - lu(518) * lu(1714) + lu(1738) = lu(1738) - lu(519) * lu(1714) + lu(1739) = lu(1739) - lu(520) * lu(1714) + lu(1743) = lu(1743) - lu(521) * lu(1714) + lu(1744) = lu(1744) - lu(522) * lu(1714) + lu(1745) = lu(1745) - lu(523) * lu(1714) + lu(529) = 1._r8 / lu(529) + lu(530) = lu(530) * lu(529) + lu(531) = lu(531) * lu(529) + lu(532) = lu(532) * lu(529) + lu(533) = lu(533) * lu(529) + lu(534) = lu(534) * lu(529) + lu(535) = lu(535) * lu(529) + lu(536) = lu(536) * lu(529) + lu(537) = lu(537) * lu(529) + lu(538) = lu(538) * lu(529) + lu(539) = lu(539) * lu(529) + lu(540) = lu(540) * lu(529) + lu(541) = lu(541) * lu(529) + lu(542) = lu(542) * lu(529) + lu(543) = lu(543) * lu(529) + lu(544) = lu(544) * lu(529) + lu(545) = lu(545) * lu(529) + lu(546) = lu(546) * lu(529) + lu(547) = lu(547) * lu(529) + lu(560) = lu(560) - lu(530) * lu(559) + lu(561) = lu(561) - lu(531) * lu(559) + lu(562) = lu(562) - lu(532) * lu(559) + lu(563) = lu(563) - lu(533) * lu(559) + lu(564) = lu(564) - lu(534) * lu(559) + lu(566) = lu(566) - lu(535) * lu(559) + lu(567) = lu(567) - lu(536) * lu(559) + lu(568) = lu(568) - lu(537) * lu(559) + lu(569) = lu(569) - lu(538) * lu(559) + lu(572) = lu(572) - lu(539) * lu(559) + lu(573) = lu(573) - lu(540) * lu(559) + lu(574) = lu(574) - lu(541) * lu(559) + lu(575) = lu(575) - lu(542) * lu(559) + lu(576) = lu(576) - lu(543) * lu(559) + lu(577) = lu(577) - lu(544) * lu(559) + lu(578) = lu(578) - lu(545) * lu(559) + lu(579) = lu(579) - lu(546) * lu(559) + lu(580) = lu(580) - lu(547) * lu(559) + lu(669) = lu(669) - lu(530) * lu(668) + lu(670) = lu(670) - lu(531) * lu(668) + lu(671) = lu(671) - lu(532) * lu(668) + lu(672) = lu(672) - lu(533) * lu(668) + lu(673) = lu(673) - lu(534) * lu(668) + lu(676) = lu(676) - lu(535) * lu(668) + lu(677) = lu(677) - lu(536) * lu(668) + lu(678) = lu(678) - lu(537) * lu(668) + lu(679) = lu(679) - lu(538) * lu(668) + lu(682) = lu(682) - lu(539) * lu(668) + lu(683) = lu(683) - lu(540) * lu(668) + lu(684) = lu(684) - lu(541) * lu(668) + lu(685) = lu(685) - lu(542) * lu(668) + lu(686) = lu(686) - lu(543) * lu(668) + lu(687) = lu(687) - lu(544) * lu(668) + lu(688) = lu(688) - lu(545) * lu(668) + lu(689) = lu(689) - lu(546) * lu(668) + lu(690) = lu(690) - lu(547) * lu(668) + lu(709) = lu(709) - lu(530) * lu(708) + lu(710) = lu(710) - lu(531) * lu(708) + lu(711) = lu(711) - lu(532) * lu(708) + lu(713) = lu(713) - lu(533) * lu(708) + lu(714) = lu(714) - lu(534) * lu(708) + lu(717) = lu(717) - lu(535) * lu(708) + lu(718) = lu(718) - lu(536) * lu(708) + lu(719) = lu(719) - lu(537) * lu(708) + lu(720) = lu(720) - lu(538) * lu(708) + lu(723) = lu(723) - lu(539) * lu(708) + lu(724) = lu(724) - lu(540) * lu(708) + lu(725) = lu(725) - lu(541) * lu(708) + lu(726) = lu(726) - lu(542) * lu(708) + lu(727) = lu(727) - lu(543) * lu(708) + lu(728) = lu(728) - lu(544) * lu(708) + lu(729) = lu(729) - lu(545) * lu(708) + lu(730) = lu(730) - lu(546) * lu(708) + lu(731) = lu(731) - lu(547) * lu(708) + lu(895) = lu(895) - lu(530) * lu(894) + lu(899) = lu(899) - lu(531) * lu(894) + lu(900) = lu(900) - lu(532) * lu(894) + lu(905) = lu(905) - lu(533) * lu(894) + lu(906) = lu(906) - lu(534) * lu(894) + lu(909) = lu(909) - lu(535) * lu(894) + lu(910) = lu(910) - lu(536) * lu(894) + lu(911) = lu(911) - lu(537) * lu(894) + lu(912) = lu(912) - lu(538) * lu(894) + lu(915) = lu(915) - lu(539) * lu(894) + lu(917) = - lu(540) * lu(894) + lu(919) = lu(919) - lu(541) * lu(894) + lu(920) = lu(920) - lu(542) * lu(894) + lu(921) = lu(921) - lu(543) * lu(894) + lu(922) = lu(922) - lu(544) * lu(894) + lu(923) = lu(923) - lu(545) * lu(894) + lu(924) = lu(924) - lu(546) * lu(894) + lu(925) = lu(925) - lu(547) * lu(894) + lu(930) = lu(930) - lu(530) * lu(929) + lu(934) = lu(934) - lu(531) * lu(929) + lu(935) = lu(935) - lu(532) * lu(929) + lu(940) = lu(940) - lu(533) * lu(929) + lu(941) = lu(941) - lu(534) * lu(929) + lu(944) = lu(944) - lu(535) * lu(929) + lu(945) = lu(945) - lu(536) * lu(929) + lu(946) = lu(946) - lu(537) * lu(929) + lu(947) = lu(947) - lu(538) * lu(929) + lu(950) = lu(950) - lu(539) * lu(929) + lu(952) = lu(952) - lu(540) * lu(929) + lu(954) = lu(954) - lu(541) * lu(929) + lu(955) = lu(955) - lu(542) * lu(929) + lu(956) = lu(956) - lu(543) * lu(929) + lu(957) = lu(957) - lu(544) * lu(929) + lu(958) = lu(958) - lu(545) * lu(929) + lu(959) = lu(959) - lu(546) * lu(929) + lu(960) = lu(960) - lu(547) * lu(929) + lu(1058) = lu(1058) - lu(530) * lu(1057) + lu(1061) = lu(1061) - lu(531) * lu(1057) + lu(1062) = lu(1062) - lu(532) * lu(1057) + lu(1067) = lu(1067) - lu(533) * lu(1057) + lu(1068) = lu(1068) - lu(534) * lu(1057) + lu(1071) = lu(1071) - lu(535) * lu(1057) + lu(1072) = lu(1072) - lu(536) * lu(1057) + lu(1073) = lu(1073) - lu(537) * lu(1057) + lu(1074) = lu(1074) - lu(538) * lu(1057) + lu(1077) = lu(1077) - lu(539) * lu(1057) + lu(1079) = lu(1079) - lu(540) * lu(1057) + lu(1081) = lu(1081) - lu(541) * lu(1057) + lu(1082) = lu(1082) - lu(542) * lu(1057) + lu(1083) = lu(1083) - lu(543) * lu(1057) + lu(1084) = lu(1084) - lu(544) * lu(1057) + lu(1085) = lu(1085) - lu(545) * lu(1057) + lu(1086) = lu(1086) - lu(546) * lu(1057) + lu(1087) = lu(1087) - lu(547) * lu(1057) + lu(1099) = lu(1099) - lu(530) * lu(1098) + lu(1103) = lu(1103) - lu(531) * lu(1098) + lu(1104) = lu(1104) - lu(532) * lu(1098) + lu(1109) = lu(1109) - lu(533) * lu(1098) + lu(1110) = lu(1110) - lu(534) * lu(1098) + lu(1113) = lu(1113) - lu(535) * lu(1098) + lu(1114) = lu(1114) - lu(536) * lu(1098) + lu(1115) = lu(1115) - lu(537) * lu(1098) + lu(1116) = lu(1116) - lu(538) * lu(1098) + lu(1119) = lu(1119) - lu(539) * lu(1098) + lu(1121) = - lu(540) * lu(1098) + lu(1123) = lu(1123) - lu(541) * lu(1098) + lu(1124) = lu(1124) - lu(542) * lu(1098) + lu(1125) = lu(1125) - lu(543) * lu(1098) + lu(1126) = lu(1126) - lu(544) * lu(1098) + lu(1127) = lu(1127) - lu(545) * lu(1098) + lu(1128) = lu(1128) - lu(546) * lu(1098) + lu(1129) = lu(1129) - lu(547) * lu(1098) + lu(1184) = lu(1184) - lu(530) * lu(1183) + lu(1188) = lu(1188) - lu(531) * lu(1183) + lu(1189) = lu(1189) - lu(532) * lu(1183) + lu(1194) = lu(1194) - lu(533) * lu(1183) + lu(1195) = lu(1195) - lu(534) * lu(1183) + lu(1198) = lu(1198) - lu(535) * lu(1183) + lu(1199) = lu(1199) - lu(536) * lu(1183) + lu(1200) = lu(1200) - lu(537) * lu(1183) + lu(1201) = lu(1201) - lu(538) * lu(1183) + lu(1204) = lu(1204) - lu(539) * lu(1183) + lu(1206) = lu(1206) - lu(540) * lu(1183) + lu(1208) = lu(1208) - lu(541) * lu(1183) + lu(1209) = lu(1209) - lu(542) * lu(1183) + lu(1210) = lu(1210) - lu(543) * lu(1183) + lu(1211) = lu(1211) - lu(544) * lu(1183) + lu(1212) = lu(1212) - lu(545) * lu(1183) + lu(1213) = lu(1213) - lu(546) * lu(1183) + lu(1214) = lu(1214) - lu(547) * lu(1183) + lu(1305) = lu(1305) - lu(530) * lu(1304) + lu(1308) = lu(1308) - lu(531) * lu(1304) + lu(1309) = lu(1309) - lu(532) * lu(1304) + lu(1314) = lu(1314) - lu(533) * lu(1304) + lu(1315) = lu(1315) - lu(534) * lu(1304) + lu(1318) = lu(1318) - lu(535) * lu(1304) + lu(1319) = lu(1319) - lu(536) * lu(1304) + lu(1320) = lu(1320) - lu(537) * lu(1304) + lu(1321) = lu(1321) - lu(538) * lu(1304) + lu(1324) = lu(1324) - lu(539) * lu(1304) + lu(1326) = lu(1326) - lu(540) * lu(1304) + lu(1328) = lu(1328) - lu(541) * lu(1304) + lu(1329) = lu(1329) - lu(542) * lu(1304) + lu(1330) = lu(1330) - lu(543) * lu(1304) + lu(1331) = lu(1331) - lu(544) * lu(1304) + lu(1332) = lu(1332) - lu(545) * lu(1304) + lu(1333) = lu(1333) - lu(546) * lu(1304) + lu(1334) = lu(1334) - lu(547) * lu(1304) + lu(1485) = lu(1485) - lu(530) * lu(1484) + lu(1489) = lu(1489) - lu(531) * lu(1484) + lu(1490) = lu(1490) - lu(532) * lu(1484) + lu(1495) = lu(1495) - lu(533) * lu(1484) + lu(1496) = lu(1496) - lu(534) * lu(1484) + lu(1499) = lu(1499) - lu(535) * lu(1484) + lu(1500) = lu(1500) - lu(536) * lu(1484) + lu(1501) = lu(1501) - lu(537) * lu(1484) + lu(1502) = lu(1502) - lu(538) * lu(1484) + lu(1505) = lu(1505) - lu(539) * lu(1484) + lu(1507) = lu(1507) - lu(540) * lu(1484) + lu(1509) = lu(1509) - lu(541) * lu(1484) + lu(1510) = lu(1510) - lu(542) * lu(1484) + lu(1511) = lu(1511) - lu(543) * lu(1484) + lu(1512) = lu(1512) - lu(544) * lu(1484) + lu(1513) = lu(1513) - lu(545) * lu(1484) + lu(1514) = lu(1514) - lu(546) * lu(1484) + lu(1515) = lu(1515) - lu(547) * lu(1484) + lu(1553) = lu(1553) - lu(530) * lu(1552) + lu(1556) = lu(1556) - lu(531) * lu(1552) + lu(1557) = lu(1557) - lu(532) * lu(1552) + lu(1562) = lu(1562) - lu(533) * lu(1552) + lu(1563) = lu(1563) - lu(534) * lu(1552) + lu(1566) = lu(1566) - lu(535) * lu(1552) + lu(1567) = lu(1567) - lu(536) * lu(1552) + lu(1568) = lu(1568) - lu(537) * lu(1552) + lu(1569) = lu(1569) - lu(538) * lu(1552) + lu(1572) = lu(1572) - lu(539) * lu(1552) + lu(1574) = lu(1574) - lu(540) * lu(1552) + lu(1576) = lu(1576) - lu(541) * lu(1552) + lu(1577) = lu(1577) - lu(542) * lu(1552) + lu(1578) = lu(1578) - lu(543) * lu(1552) + lu(1579) = lu(1579) - lu(544) * lu(1552) + lu(1580) = lu(1580) - lu(545) * lu(1552) + lu(1581) = lu(1581) - lu(546) * lu(1552) + lu(1582) = lu(1582) - lu(547) * lu(1552) + lu(1590) = lu(1590) - lu(530) * lu(1589) + lu(1594) = lu(1594) - lu(531) * lu(1589) + lu(1595) = lu(1595) - lu(532) * lu(1589) + lu(1600) = lu(1600) - lu(533) * lu(1589) + lu(1601) = lu(1601) - lu(534) * lu(1589) + lu(1604) = lu(1604) - lu(535) * lu(1589) + lu(1605) = lu(1605) - lu(536) * lu(1589) + lu(1606) = lu(1606) - lu(537) * lu(1589) + lu(1607) = lu(1607) - lu(538) * lu(1589) + lu(1610) = lu(1610) - lu(539) * lu(1589) + lu(1612) = lu(1612) - lu(540) * lu(1589) + lu(1614) = lu(1614) - lu(541) * lu(1589) + lu(1615) = lu(1615) - lu(542) * lu(1589) + lu(1616) = lu(1616) - lu(543) * lu(1589) + lu(1617) = lu(1617) - lu(544) * lu(1589) + lu(1618) = lu(1618) - lu(545) * lu(1589) + lu(1619) = lu(1619) - lu(546) * lu(1589) + lu(1620) = lu(1620) - lu(547) * lu(1589) + lu(1630) = lu(1630) - lu(530) * lu(1629) + lu(1633) = lu(1633) - lu(531) * lu(1629) + lu(1634) = lu(1634) - lu(532) * lu(1629) + lu(1639) = lu(1639) - lu(533) * lu(1629) + lu(1640) = lu(1640) - lu(534) * lu(1629) + lu(1643) = lu(1643) - lu(535) * lu(1629) + lu(1644) = lu(1644) - lu(536) * lu(1629) + lu(1645) = lu(1645) - lu(537) * lu(1629) + lu(1646) = lu(1646) - lu(538) * lu(1629) + lu(1649) = lu(1649) - lu(539) * lu(1629) + lu(1651) = lu(1651) - lu(540) * lu(1629) + lu(1653) = lu(1653) - lu(541) * lu(1629) + lu(1654) = lu(1654) - lu(542) * lu(1629) + lu(1655) = lu(1655) - lu(543) * lu(1629) + lu(1656) = - lu(544) * lu(1629) + lu(1657) = lu(1657) - lu(545) * lu(1629) + lu(1658) = lu(1658) - lu(546) * lu(1629) + lu(1659) = lu(1659) - lu(547) * lu(1629) + lu(1666) = - lu(530) * lu(1665) + lu(1668) = lu(1668) - lu(531) * lu(1665) + lu(1669) = lu(1669) - lu(532) * lu(1665) + lu(1673) = - lu(533) * lu(1665) + lu(1674) = lu(1674) - lu(534) * lu(1665) + lu(1677) = lu(1677) - lu(535) * lu(1665) + lu(1678) = - lu(536) * lu(1665) + lu(1679) = lu(1679) - lu(537) * lu(1665) + lu(1680) = - lu(538) * lu(1665) + lu(1683) = lu(1683) - lu(539) * lu(1665) + lu(1685) = - lu(540) * lu(1665) + lu(1687) = lu(1687) - lu(541) * lu(1665) + lu(1688) = - lu(542) * lu(1665) + lu(1689) = - lu(543) * lu(1665) + lu(1690) = - lu(544) * lu(1665) + lu(1691) = lu(1691) - lu(545) * lu(1665) + lu(1692) = lu(1692) - lu(546) * lu(1665) + lu(1693) = lu(1693) - lu(547) * lu(1665) + lu(1716) = lu(1716) - lu(530) * lu(1715) + lu(1719) = lu(1719) - lu(531) * lu(1715) + lu(1720) = lu(1720) - lu(532) * lu(1715) + lu(1725) = lu(1725) - lu(533) * lu(1715) + lu(1726) = lu(1726) - lu(534) * lu(1715) + lu(1729) = lu(1729) - lu(535) * lu(1715) + lu(1730) = lu(1730) - lu(536) * lu(1715) + lu(1731) = lu(1731) - lu(537) * lu(1715) + lu(1732) = lu(1732) - lu(538) * lu(1715) + lu(1735) = lu(1735) - lu(539) * lu(1715) + lu(1737) = lu(1737) - lu(540) * lu(1715) + lu(1739) = lu(1739) - lu(541) * lu(1715) + lu(1740) = lu(1740) - lu(542) * lu(1715) + lu(1741) = lu(1741) - lu(543) * lu(1715) + lu(1742) = lu(1742) - lu(544) * lu(1715) + lu(1743) = lu(1743) - lu(545) * lu(1715) + lu(1744) = lu(1744) - lu(546) * lu(1715) + lu(1745) = lu(1745) - lu(547) * lu(1715) + lu(560) = 1._r8 / lu(560) + lu(561) = lu(561) * lu(560) + lu(562) = lu(562) * lu(560) + lu(563) = lu(563) * lu(560) + lu(564) = lu(564) * lu(560) + lu(565) = lu(565) * lu(560) + lu(566) = lu(566) * lu(560) + lu(567) = lu(567) * lu(560) + lu(568) = lu(568) * lu(560) + lu(569) = lu(569) * lu(560) + lu(570) = lu(570) * lu(560) + lu(571) = lu(571) * lu(560) + lu(572) = lu(572) * lu(560) + lu(573) = lu(573) * lu(560) + lu(574) = lu(574) * lu(560) + lu(575) = lu(575) * lu(560) + lu(576) = lu(576) * lu(560) + lu(577) = lu(577) * lu(560) + lu(578) = lu(578) * lu(560) + lu(579) = lu(579) * lu(560) + lu(580) = lu(580) * lu(560) + lu(670) = lu(670) - lu(561) * lu(669) + lu(671) = lu(671) - lu(562) * lu(669) + lu(672) = lu(672) - lu(563) * lu(669) + lu(673) = lu(673) - lu(564) * lu(669) + lu(675) = lu(675) - lu(565) * lu(669) + lu(676) = lu(676) - lu(566) * lu(669) + lu(677) = lu(677) - lu(567) * lu(669) + lu(678) = lu(678) - lu(568) * lu(669) + lu(679) = lu(679) - lu(569) * lu(669) + lu(680) = - lu(570) * lu(669) + lu(681) = - lu(571) * lu(669) + lu(682) = lu(682) - lu(572) * lu(669) + lu(683) = lu(683) - lu(573) * lu(669) + lu(684) = lu(684) - lu(574) * lu(669) + lu(685) = lu(685) - lu(575) * lu(669) + lu(686) = lu(686) - lu(576) * lu(669) + lu(687) = lu(687) - lu(577) * lu(669) + lu(688) = lu(688) - lu(578) * lu(669) + lu(689) = lu(689) - lu(579) * lu(669) + lu(690) = lu(690) - lu(580) * lu(669) + lu(710) = lu(710) - lu(561) * lu(709) + lu(711) = lu(711) - lu(562) * lu(709) + lu(713) = lu(713) - lu(563) * lu(709) + lu(714) = lu(714) - lu(564) * lu(709) + lu(716) = lu(716) - lu(565) * lu(709) + lu(717) = lu(717) - lu(566) * lu(709) + lu(718) = lu(718) - lu(567) * lu(709) + lu(719) = lu(719) - lu(568) * lu(709) + lu(720) = lu(720) - lu(569) * lu(709) + lu(721) = - lu(570) * lu(709) + lu(722) = lu(722) - lu(571) * lu(709) + lu(723) = lu(723) - lu(572) * lu(709) + lu(724) = lu(724) - lu(573) * lu(709) + lu(725) = lu(725) - lu(574) * lu(709) + lu(726) = lu(726) - lu(575) * lu(709) + lu(727) = lu(727) - lu(576) * lu(709) + lu(728) = lu(728) - lu(577) * lu(709) + lu(729) = lu(729) - lu(578) * lu(709) + lu(730) = lu(730) - lu(579) * lu(709) + lu(731) = lu(731) - lu(580) * lu(709) + lu(813) = lu(813) - lu(561) * lu(809) + lu(814) = lu(814) - lu(562) * lu(809) + lu(819) = lu(819) - lu(563) * lu(809) + lu(820) = lu(820) - lu(564) * lu(809) + lu(822) = lu(822) - lu(565) * lu(809) + lu(823) = lu(823) - lu(566) * lu(809) + lu(824) = - lu(567) * lu(809) + lu(825) = lu(825) - lu(568) * lu(809) + lu(826) = lu(826) - lu(569) * lu(809) + lu(827) = lu(827) - lu(570) * lu(809) + lu(828) = lu(828) - lu(571) * lu(809) + lu(829) = lu(829) - lu(572) * lu(809) + lu(831) = lu(831) - lu(573) * lu(809) + lu(833) = lu(833) - lu(574) * lu(809) + lu(834) = - lu(575) * lu(809) + lu(835) = - lu(576) * lu(809) + lu(836) = - lu(577) * lu(809) + lu(837) = lu(837) - lu(578) * lu(809) + lu(838) = lu(838) - lu(579) * lu(809) + lu(839) = lu(839) - lu(580) * lu(809) + lu(899) = lu(899) - lu(561) * lu(895) + lu(900) = lu(900) - lu(562) * lu(895) + lu(905) = lu(905) - lu(563) * lu(895) + lu(906) = lu(906) - lu(564) * lu(895) + lu(908) = lu(908) - lu(565) * lu(895) + lu(909) = lu(909) - lu(566) * lu(895) + lu(910) = lu(910) - lu(567) * lu(895) + lu(911) = lu(911) - lu(568) * lu(895) + lu(912) = lu(912) - lu(569) * lu(895) + lu(913) = lu(913) - lu(570) * lu(895) + lu(914) = lu(914) - lu(571) * lu(895) + lu(915) = lu(915) - lu(572) * lu(895) + lu(917) = lu(917) - lu(573) * lu(895) + lu(919) = lu(919) - lu(574) * lu(895) + lu(920) = lu(920) - lu(575) * lu(895) + lu(921) = lu(921) - lu(576) * lu(895) + lu(922) = lu(922) - lu(577) * lu(895) + lu(923) = lu(923) - lu(578) * lu(895) + lu(924) = lu(924) - lu(579) * lu(895) + lu(925) = lu(925) - lu(580) * lu(895) + lu(934) = lu(934) - lu(561) * lu(930) + lu(935) = lu(935) - lu(562) * lu(930) + lu(940) = lu(940) - lu(563) * lu(930) + lu(941) = lu(941) - lu(564) * lu(930) + lu(943) = lu(943) - lu(565) * lu(930) + lu(944) = lu(944) - lu(566) * lu(930) + lu(945) = lu(945) - lu(567) * lu(930) + lu(946) = lu(946) - lu(568) * lu(930) + lu(947) = lu(947) - lu(569) * lu(930) + lu(948) = lu(948) - lu(570) * lu(930) + lu(949) = - lu(571) * lu(930) + lu(950) = lu(950) - lu(572) * lu(930) + lu(952) = lu(952) - lu(573) * lu(930) + lu(954) = lu(954) - lu(574) * lu(930) + lu(955) = lu(955) - lu(575) * lu(930) + lu(956) = lu(956) - lu(576) * lu(930) + lu(957) = lu(957) - lu(577) * lu(930) + lu(958) = lu(958) - lu(578) * lu(930) + lu(959) = lu(959) - lu(579) * lu(930) + lu(960) = lu(960) - lu(580) * lu(930) + lu(1061) = lu(1061) - lu(561) * lu(1058) + lu(1062) = lu(1062) - lu(562) * lu(1058) + lu(1067) = lu(1067) - lu(563) * lu(1058) + lu(1068) = lu(1068) - lu(564) * lu(1058) + lu(1070) = lu(1070) - lu(565) * lu(1058) + lu(1071) = lu(1071) - lu(566) * lu(1058) + lu(1072) = lu(1072) - lu(567) * lu(1058) + lu(1073) = lu(1073) - lu(568) * lu(1058) + lu(1074) = lu(1074) - lu(569) * lu(1058) + lu(1075) = lu(1075) - lu(570) * lu(1058) + lu(1076) = lu(1076) - lu(571) * lu(1058) + lu(1077) = lu(1077) - lu(572) * lu(1058) + lu(1079) = lu(1079) - lu(573) * lu(1058) + lu(1081) = lu(1081) - lu(574) * lu(1058) + lu(1082) = lu(1082) - lu(575) * lu(1058) + lu(1083) = lu(1083) - lu(576) * lu(1058) + lu(1084) = lu(1084) - lu(577) * lu(1058) + lu(1085) = lu(1085) - lu(578) * lu(1058) + lu(1086) = lu(1086) - lu(579) * lu(1058) + lu(1087) = lu(1087) - lu(580) * lu(1058) + lu(1103) = lu(1103) - lu(561) * lu(1099) + lu(1104) = lu(1104) - lu(562) * lu(1099) + lu(1109) = lu(1109) - lu(563) * lu(1099) + lu(1110) = lu(1110) - lu(564) * lu(1099) + lu(1112) = - lu(565) * lu(1099) + lu(1113) = lu(1113) - lu(566) * lu(1099) + lu(1114) = lu(1114) - lu(567) * lu(1099) + lu(1115) = lu(1115) - lu(568) * lu(1099) + lu(1116) = lu(1116) - lu(569) * lu(1099) + lu(1117) = lu(1117) - lu(570) * lu(1099) + lu(1118) = - lu(571) * lu(1099) + lu(1119) = lu(1119) - lu(572) * lu(1099) + lu(1121) = lu(1121) - lu(573) * lu(1099) + lu(1123) = lu(1123) - lu(574) * lu(1099) + lu(1124) = lu(1124) - lu(575) * lu(1099) + lu(1125) = lu(1125) - lu(576) * lu(1099) + lu(1126) = lu(1126) - lu(577) * lu(1099) + lu(1127) = lu(1127) - lu(578) * lu(1099) + lu(1128) = lu(1128) - lu(579) * lu(1099) + lu(1129) = lu(1129) - lu(580) * lu(1099) + lu(1146) = lu(1146) - lu(561) * lu(1142) + lu(1147) = lu(1147) - lu(562) * lu(1142) + lu(1152) = - lu(563) * lu(1142) + lu(1153) = lu(1153) - lu(564) * lu(1142) + lu(1155) = lu(1155) - lu(565) * lu(1142) + lu(1156) = lu(1156) - lu(566) * lu(1142) + lu(1157) = - lu(567) * lu(1142) + lu(1158) = lu(1158) - lu(568) * lu(1142) + lu(1159) = - lu(569) * lu(1142) + lu(1160) = lu(1160) - lu(570) * lu(1142) + lu(1161) = lu(1161) - lu(571) * lu(1142) + lu(1162) = lu(1162) - lu(572) * lu(1142) + lu(1164) = lu(1164) - lu(573) * lu(1142) + lu(1166) = lu(1166) - lu(574) * lu(1142) + lu(1167) = lu(1167) - lu(575) * lu(1142) + lu(1168) = lu(1168) - lu(576) * lu(1142) + lu(1169) = lu(1169) - lu(577) * lu(1142) + lu(1170) = - lu(578) * lu(1142) + lu(1171) = - lu(579) * lu(1142) + lu(1172) = lu(1172) - lu(580) * lu(1142) + lu(1188) = lu(1188) - lu(561) * lu(1184) + lu(1189) = lu(1189) - lu(562) * lu(1184) + lu(1194) = lu(1194) - lu(563) * lu(1184) + lu(1195) = lu(1195) - lu(564) * lu(1184) + lu(1197) = - lu(565) * lu(1184) + lu(1198) = lu(1198) - lu(566) * lu(1184) + lu(1199) = lu(1199) - lu(567) * lu(1184) + lu(1200) = lu(1200) - lu(568) * lu(1184) + lu(1201) = lu(1201) - lu(569) * lu(1184) + lu(1202) = lu(1202) - lu(570) * lu(1184) + lu(1203) = - lu(571) * lu(1184) + lu(1204) = lu(1204) - lu(572) * lu(1184) + lu(1206) = lu(1206) - lu(573) * lu(1184) + lu(1208) = lu(1208) - lu(574) * lu(1184) + lu(1209) = lu(1209) - lu(575) * lu(1184) + lu(1210) = lu(1210) - lu(576) * lu(1184) + lu(1211) = lu(1211) - lu(577) * lu(1184) + lu(1212) = lu(1212) - lu(578) * lu(1184) + lu(1213) = lu(1213) - lu(579) * lu(1184) + lu(1214) = lu(1214) - lu(580) * lu(1184) + lu(1267) = lu(1267) - lu(561) * lu(1263) + lu(1268) = lu(1268) - lu(562) * lu(1263) + lu(1273) = lu(1273) - lu(563) * lu(1263) + lu(1274) = lu(1274) - lu(564) * lu(1263) + lu(1276) = lu(1276) - lu(565) * lu(1263) + lu(1277) = lu(1277) - lu(566) * lu(1263) + lu(1278) = - lu(567) * lu(1263) + lu(1279) = lu(1279) - lu(568) * lu(1263) + lu(1280) = lu(1280) - lu(569) * lu(1263) + lu(1281) = lu(1281) - lu(570) * lu(1263) + lu(1282) = lu(1282) - lu(571) * lu(1263) + lu(1283) = lu(1283) - lu(572) * lu(1263) + lu(1285) = lu(1285) - lu(573) * lu(1263) + lu(1287) = lu(1287) - lu(574) * lu(1263) + lu(1288) = - lu(575) * lu(1263) + lu(1289) = lu(1289) - lu(576) * lu(1263) + lu(1290) = lu(1290) - lu(577) * lu(1263) + lu(1291) = lu(1291) - lu(578) * lu(1263) + lu(1292) = lu(1292) - lu(579) * lu(1263) + lu(1293) = lu(1293) - lu(580) * lu(1263) + lu(1308) = lu(1308) - lu(561) * lu(1305) + lu(1309) = lu(1309) - lu(562) * lu(1305) + lu(1314) = lu(1314) - lu(563) * lu(1305) + lu(1315) = lu(1315) - lu(564) * lu(1305) + lu(1317) = lu(1317) - lu(565) * lu(1305) + lu(1318) = lu(1318) - lu(566) * lu(1305) + lu(1319) = lu(1319) - lu(567) * lu(1305) + lu(1320) = lu(1320) - lu(568) * lu(1305) + lu(1321) = lu(1321) - lu(569) * lu(1305) + lu(1322) = lu(1322) - lu(570) * lu(1305) + lu(1323) = lu(1323) - lu(571) * lu(1305) + lu(1324) = lu(1324) - lu(572) * lu(1305) + lu(1326) = lu(1326) - lu(573) * lu(1305) + lu(1328) = lu(1328) - lu(574) * lu(1305) + lu(1329) = lu(1329) - lu(575) * lu(1305) + lu(1330) = lu(1330) - lu(576) * lu(1305) + lu(1331) = lu(1331) - lu(577) * lu(1305) + lu(1332) = lu(1332) - lu(578) * lu(1305) + lu(1333) = lu(1333) - lu(579) * lu(1305) + lu(1334) = lu(1334) - lu(580) * lu(1305) + lu(1394) = lu(1394) - lu(561) * lu(1393) + lu(1395) = lu(1395) - lu(562) * lu(1393) + lu(1398) = - lu(563) * lu(1393) + lu(1399) = lu(1399) - lu(564) * lu(1393) + lu(1401) = lu(1401) - lu(565) * lu(1393) + lu(1402) = lu(1402) - lu(566) * lu(1393) + lu(1403) = - lu(567) * lu(1393) + lu(1404) = lu(1404) - lu(568) * lu(1393) + lu(1405) = - lu(569) * lu(1393) + lu(1406) = lu(1406) - lu(570) * lu(1393) + lu(1407) = lu(1407) - lu(571) * lu(1393) + lu(1408) = lu(1408) - lu(572) * lu(1393) + lu(1410) = lu(1410) - lu(573) * lu(1393) + lu(1412) = lu(1412) - lu(574) * lu(1393) + lu(1413) = - lu(575) * lu(1393) + lu(1414) = lu(1414) - lu(576) * lu(1393) + lu(1415) = lu(1415) - lu(577) * lu(1393) + lu(1416) = - lu(578) * lu(1393) + lu(1417) = - lu(579) * lu(1393) + lu(1418) = lu(1418) - lu(580) * lu(1393) + lu(1489) = lu(1489) - lu(561) * lu(1485) + lu(1490) = lu(1490) - lu(562) * lu(1485) + lu(1495) = lu(1495) - lu(563) * lu(1485) + lu(1496) = lu(1496) - lu(564) * lu(1485) + lu(1498) = lu(1498) - lu(565) * lu(1485) + lu(1499) = lu(1499) - lu(566) * lu(1485) + lu(1500) = lu(1500) - lu(567) * lu(1485) + lu(1501) = lu(1501) - lu(568) * lu(1485) + lu(1502) = lu(1502) - lu(569) * lu(1485) + lu(1503) = lu(1503) - lu(570) * lu(1485) + lu(1504) = lu(1504) - lu(571) * lu(1485) + lu(1505) = lu(1505) - lu(572) * lu(1485) + lu(1507) = lu(1507) - lu(573) * lu(1485) + lu(1509) = lu(1509) - lu(574) * lu(1485) + lu(1510) = lu(1510) - lu(575) * lu(1485) + lu(1511) = lu(1511) - lu(576) * lu(1485) + lu(1512) = lu(1512) - lu(577) * lu(1485) + lu(1513) = lu(1513) - lu(578) * lu(1485) + lu(1514) = lu(1514) - lu(579) * lu(1485) + lu(1515) = lu(1515) - lu(580) * lu(1485) + lu(1556) = lu(1556) - lu(561) * lu(1553) + lu(1557) = lu(1557) - lu(562) * lu(1553) + lu(1562) = lu(1562) - lu(563) * lu(1553) + lu(1563) = lu(1563) - lu(564) * lu(1553) + lu(1565) = lu(1565) - lu(565) * lu(1553) + lu(1566) = lu(1566) - lu(566) * lu(1553) + lu(1567) = lu(1567) - lu(567) * lu(1553) + lu(1568) = lu(1568) - lu(568) * lu(1553) + lu(1569) = lu(1569) - lu(569) * lu(1553) + lu(1570) = lu(1570) - lu(570) * lu(1553) + lu(1571) = lu(1571) - lu(571) * lu(1553) + lu(1572) = lu(1572) - lu(572) * lu(1553) + lu(1574) = lu(1574) - lu(573) * lu(1553) + lu(1576) = lu(1576) - lu(574) * lu(1553) + lu(1577) = lu(1577) - lu(575) * lu(1553) + lu(1578) = lu(1578) - lu(576) * lu(1553) + lu(1579) = lu(1579) - lu(577) * lu(1553) + lu(1580) = lu(1580) - lu(578) * lu(1553) + lu(1581) = lu(1581) - lu(579) * lu(1553) + lu(1582) = lu(1582) - lu(580) * lu(1553) + lu(1594) = lu(1594) - lu(561) * lu(1590) + lu(1595) = lu(1595) - lu(562) * lu(1590) + lu(1600) = lu(1600) - lu(563) * lu(1590) + lu(1601) = lu(1601) - lu(564) * lu(1590) + lu(1603) = lu(1603) - lu(565) * lu(1590) + lu(1604) = lu(1604) - lu(566) * lu(1590) + lu(1605) = lu(1605) - lu(567) * lu(1590) + lu(1606) = lu(1606) - lu(568) * lu(1590) + lu(1607) = lu(1607) - lu(569) * lu(1590) + lu(1608) = lu(1608) - lu(570) * lu(1590) + lu(1609) = lu(1609) - lu(571) * lu(1590) + lu(1610) = lu(1610) - lu(572) * lu(1590) + lu(1612) = lu(1612) - lu(573) * lu(1590) + lu(1614) = lu(1614) - lu(574) * lu(1590) + lu(1615) = lu(1615) - lu(575) * lu(1590) + lu(1616) = lu(1616) - lu(576) * lu(1590) + lu(1617) = lu(1617) - lu(577) * lu(1590) + lu(1618) = lu(1618) - lu(578) * lu(1590) + lu(1619) = lu(1619) - lu(579) * lu(1590) + lu(1620) = lu(1620) - lu(580) * lu(1590) + lu(1633) = lu(1633) - lu(561) * lu(1630) + lu(1634) = lu(1634) - lu(562) * lu(1630) + lu(1639) = lu(1639) - lu(563) * lu(1630) + lu(1640) = lu(1640) - lu(564) * lu(1630) + lu(1642) = lu(1642) - lu(565) * lu(1630) + lu(1643) = lu(1643) - lu(566) * lu(1630) + lu(1644) = lu(1644) - lu(567) * lu(1630) + lu(1645) = lu(1645) - lu(568) * lu(1630) + lu(1646) = lu(1646) - lu(569) * lu(1630) + lu(1647) = lu(1647) - lu(570) * lu(1630) + lu(1648) = lu(1648) - lu(571) * lu(1630) + lu(1649) = lu(1649) - lu(572) * lu(1630) + lu(1651) = lu(1651) - lu(573) * lu(1630) + lu(1653) = lu(1653) - lu(574) * lu(1630) + lu(1654) = lu(1654) - lu(575) * lu(1630) + lu(1655) = lu(1655) - lu(576) * lu(1630) + lu(1656) = lu(1656) - lu(577) * lu(1630) + lu(1657) = lu(1657) - lu(578) * lu(1630) + lu(1658) = lu(1658) - lu(579) * lu(1630) + lu(1659) = lu(1659) - lu(580) * lu(1630) + lu(1668) = lu(1668) - lu(561) * lu(1666) + lu(1669) = lu(1669) - lu(562) * lu(1666) + lu(1673) = lu(1673) - lu(563) * lu(1666) + lu(1674) = lu(1674) - lu(564) * lu(1666) + lu(1676) = lu(1676) - lu(565) * lu(1666) + lu(1677) = lu(1677) - lu(566) * lu(1666) + lu(1678) = lu(1678) - lu(567) * lu(1666) + lu(1679) = lu(1679) - lu(568) * lu(1666) + lu(1680) = lu(1680) - lu(569) * lu(1666) + lu(1681) = - lu(570) * lu(1666) + lu(1682) = lu(1682) - lu(571) * lu(1666) + lu(1683) = lu(1683) - lu(572) * lu(1666) + lu(1685) = lu(1685) - lu(573) * lu(1666) + lu(1687) = lu(1687) - lu(574) * lu(1666) + lu(1688) = lu(1688) - lu(575) * lu(1666) + lu(1689) = lu(1689) - lu(576) * lu(1666) + lu(1690) = lu(1690) - lu(577) * lu(1666) + lu(1691) = lu(1691) - lu(578) * lu(1666) + lu(1692) = lu(1692) - lu(579) * lu(1666) + lu(1693) = lu(1693) - lu(580) * lu(1666) + lu(1719) = lu(1719) - lu(561) * lu(1716) + lu(1720) = lu(1720) - lu(562) * lu(1716) + lu(1725) = lu(1725) - lu(563) * lu(1716) + lu(1726) = lu(1726) - lu(564) * lu(1716) + lu(1728) = lu(1728) - lu(565) * lu(1716) + lu(1729) = lu(1729) - lu(566) * lu(1716) + lu(1730) = lu(1730) - lu(567) * lu(1716) + lu(1731) = lu(1731) - lu(568) * lu(1716) + lu(1732) = lu(1732) - lu(569) * lu(1716) + lu(1733) = lu(1733) - lu(570) * lu(1716) + lu(1734) = lu(1734) - lu(571) * lu(1716) + lu(1735) = lu(1735) - lu(572) * lu(1716) + lu(1737) = lu(1737) - lu(573) * lu(1716) + lu(1739) = lu(1739) - lu(574) * lu(1716) + lu(1740) = lu(1740) - lu(575) * lu(1716) + lu(1741) = lu(1741) - lu(576) * lu(1716) + lu(1742) = lu(1742) - lu(577) * lu(1716) + lu(1743) = lu(1743) - lu(578) * lu(1716) + lu(1744) = lu(1744) - lu(579) * lu(1716) + lu(1745) = lu(1745) - lu(580) * lu(1716) end subroutine lu_fac13 - subroutine lu_fac14( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac14( lu ) 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,573) = 1._r8 / lu(k,573) - lu(k,574) = lu(k,574) * lu(k,573) - lu(k,575) = lu(k,575) * lu(k,573) - lu(k,576) = lu(k,576) * lu(k,573) - lu(k,577) = lu(k,577) * lu(k,573) - lu(k,578) = lu(k,578) * lu(k,573) - lu(k,579) = lu(k,579) * lu(k,573) - lu(k,580) = lu(k,580) * lu(k,573) - lu(k,581) = lu(k,581) * lu(k,573) - lu(k,582) = lu(k,582) * lu(k,573) - lu(k,583) = lu(k,583) * lu(k,573) - lu(k,584) = lu(k,584) * lu(k,573) - lu(k,585) = lu(k,585) * lu(k,573) - lu(k,586) = lu(k,586) * lu(k,573) - lu(k,587) = lu(k,587) * lu(k,573) - lu(k,588) = lu(k,588) * lu(k,573) - lu(k,589) = lu(k,589) * lu(k,573) - lu(k,590) = lu(k,590) * lu(k,573) - lu(k,591) = lu(k,591) * lu(k,573) - lu(k,592) = lu(k,592) * lu(k,573) - lu(k,593) = lu(k,593) * lu(k,573) - lu(k,594) = lu(k,594) * lu(k,573) - lu(k,686) = lu(k,686) - lu(k,574) * lu(k,685) - lu(k,687) = lu(k,687) - lu(k,575) * lu(k,685) - lu(k,688) = lu(k,688) - lu(k,576) * lu(k,685) - lu(k,689) = lu(k,689) - lu(k,577) * lu(k,685) - lu(k,690) = lu(k,690) - lu(k,578) * lu(k,685) - lu(k,692) = lu(k,692) - lu(k,579) * lu(k,685) - lu(k,693) = lu(k,693) - lu(k,580) * lu(k,685) - lu(k,694) = lu(k,694) - lu(k,581) * lu(k,685) - lu(k,695) = lu(k,695) - lu(k,582) * lu(k,685) - lu(k,696) = - lu(k,583) * lu(k,685) - lu(k,697) = - lu(k,584) * lu(k,685) - lu(k,698) = lu(k,698) - lu(k,585) * lu(k,685) - lu(k,699) = lu(k,699) - lu(k,586) * lu(k,685) - lu(k,700) = lu(k,700) - lu(k,587) * lu(k,685) - lu(k,701) = lu(k,701) - lu(k,588) * lu(k,685) - lu(k,702) = lu(k,702) - lu(k,589) * lu(k,685) - lu(k,703) = lu(k,703) - lu(k,590) * lu(k,685) - lu(k,704) = lu(k,704) - lu(k,591) * lu(k,685) - lu(k,705) = lu(k,705) - lu(k,592) * lu(k,685) - lu(k,706) = lu(k,706) - lu(k,593) * lu(k,685) - lu(k,707) = lu(k,707) - lu(k,594) * lu(k,685) - lu(k,754) = lu(k,754) - lu(k,574) * lu(k,753) - lu(k,755) = lu(k,755) - lu(k,575) * lu(k,753) - lu(k,756) = lu(k,756) - lu(k,576) * lu(k,753) - lu(k,758) = lu(k,758) - lu(k,577) * lu(k,753) - lu(k,759) = lu(k,759) - lu(k,578) * lu(k,753) - lu(k,761) = lu(k,761) - lu(k,579) * lu(k,753) - lu(k,762) = lu(k,762) - lu(k,580) * lu(k,753) - lu(k,763) = lu(k,763) - lu(k,581) * lu(k,753) - lu(k,764) = lu(k,764) - lu(k,582) * lu(k,753) - lu(k,765) = - lu(k,583) * lu(k,753) - lu(k,766) = lu(k,766) - lu(k,584) * lu(k,753) - lu(k,767) = lu(k,767) - lu(k,585) * lu(k,753) - lu(k,768) = lu(k,768) - lu(k,586) * lu(k,753) - lu(k,769) = lu(k,769) - lu(k,587) * lu(k,753) - lu(k,770) = lu(k,770) - lu(k,588) * lu(k,753) - lu(k,771) = lu(k,771) - lu(k,589) * lu(k,753) - lu(k,772) = lu(k,772) - lu(k,590) * lu(k,753) - lu(k,773) = lu(k,773) - lu(k,591) * lu(k,753) - lu(k,774) = lu(k,774) - lu(k,592) * lu(k,753) - lu(k,775) = lu(k,775) - lu(k,593) * lu(k,753) - lu(k,776) = lu(k,776) - lu(k,594) * lu(k,753) - lu(k,873) = lu(k,873) - lu(k,574) * lu(k,869) - lu(k,875) = lu(k,875) - lu(k,575) * lu(k,869) - lu(k,877) = lu(k,877) - lu(k,576) * lu(k,869) - lu(k,880) = lu(k,880) - lu(k,577) * lu(k,869) - lu(k,881) = lu(k,881) - lu(k,578) * lu(k,869) - lu(k,883) = lu(k,883) - lu(k,579) * lu(k,869) - lu(k,884) = lu(k,884) - lu(k,580) * lu(k,869) - lu(k,886) = lu(k,886) - lu(k,581) * lu(k,869) - lu(k,887) = lu(k,887) - lu(k,582) * lu(k,869) - lu(k,888) = lu(k,888) - lu(k,583) * lu(k,869) - lu(k,889) = lu(k,889) - lu(k,584) * lu(k,869) - lu(k,890) = lu(k,890) - lu(k,585) * lu(k,869) - lu(k,891) = - lu(k,586) * lu(k,869) - lu(k,892) = lu(k,892) - lu(k,587) * lu(k,869) - lu(k,893) = - lu(k,588) * lu(k,869) - lu(k,895) = - lu(k,589) * lu(k,869) - lu(k,896) = - lu(k,590) * lu(k,869) - lu(k,897) = lu(k,897) - lu(k,591) * lu(k,869) - lu(k,898) = lu(k,898) - lu(k,592) * lu(k,869) - lu(k,899) = lu(k,899) - lu(k,593) * lu(k,869) - lu(k,900) = lu(k,900) - lu(k,594) * lu(k,869) - lu(k,972) = lu(k,972) - lu(k,574) * lu(k,968) - lu(k,974) = lu(k,974) - lu(k,575) * lu(k,968) - lu(k,976) = lu(k,976) - lu(k,576) * lu(k,968) - lu(k,979) = lu(k,979) - lu(k,577) * lu(k,968) - lu(k,980) = lu(k,980) - lu(k,578) * lu(k,968) - lu(k,982) = lu(k,982) - lu(k,579) * lu(k,968) - lu(k,983) = lu(k,983) - lu(k,580) * lu(k,968) - lu(k,985) = lu(k,985) - lu(k,581) * lu(k,968) - lu(k,986) = lu(k,986) - lu(k,582) * lu(k,968) - lu(k,987) = lu(k,987) - lu(k,583) * lu(k,968) - lu(k,988) = lu(k,988) - lu(k,584) * lu(k,968) - lu(k,989) = lu(k,989) - lu(k,585) * lu(k,968) - lu(k,990) = lu(k,990) - lu(k,586) * lu(k,968) - lu(k,991) = lu(k,991) - lu(k,587) * lu(k,968) - lu(k,992) = lu(k,992) - lu(k,588) * lu(k,968) - lu(k,994) = lu(k,994) - lu(k,589) * lu(k,968) - lu(k,995) = lu(k,995) - lu(k,590) * lu(k,968) - lu(k,996) = lu(k,996) - lu(k,591) * lu(k,968) - lu(k,997) = lu(k,997) - lu(k,592) * lu(k,968) - lu(k,998) = lu(k,998) - lu(k,593) * lu(k,968) - lu(k,999) = lu(k,999) - lu(k,594) * lu(k,968) - lu(k,1017) = lu(k,1017) - lu(k,574) * lu(k,1016) - lu(k,1018) = lu(k,1018) - lu(k,575) * lu(k,1016) - lu(k,1019) = lu(k,1019) - lu(k,576) * lu(k,1016) - lu(k,1022) = lu(k,1022) - lu(k,577) * lu(k,1016) - lu(k,1023) = lu(k,1023) - lu(k,578) * lu(k,1016) - lu(k,1025) = - lu(k,579) * lu(k,1016) - lu(k,1026) = lu(k,1026) - lu(k,580) * lu(k,1016) - lu(k,1028) = - lu(k,581) * lu(k,1016) - lu(k,1029) = lu(k,1029) - lu(k,582) * lu(k,1016) - lu(k,1030) = lu(k,1030) - lu(k,583) * lu(k,1016) - lu(k,1031) = lu(k,1031) - lu(k,584) * lu(k,1016) - lu(k,1032) = lu(k,1032) - lu(k,585) * lu(k,1016) - lu(k,1033) = lu(k,1033) - lu(k,586) * lu(k,1016) - lu(k,1034) = - lu(k,587) * lu(k,1016) - lu(k,1035) = - lu(k,588) * lu(k,1016) - lu(k,1037) = - lu(k,589) * lu(k,1016) - lu(k,1038) = lu(k,1038) - lu(k,590) * lu(k,1016) - lu(k,1039) = - lu(k,591) * lu(k,1016) - lu(k,1040) = lu(k,1040) - lu(k,592) * lu(k,1016) - lu(k,1041) = lu(k,1041) - lu(k,593) * lu(k,1016) - lu(k,1042) = lu(k,1042) - lu(k,594) * lu(k,1016) - lu(k,1097) = lu(k,1097) - lu(k,574) * lu(k,1094) - lu(k,1099) = lu(k,1099) - lu(k,575) * lu(k,1094) - lu(k,1101) = lu(k,1101) - lu(k,576) * lu(k,1094) - lu(k,1104) = lu(k,1104) - lu(k,577) * lu(k,1094) - lu(k,1105) = lu(k,1105) - lu(k,578) * lu(k,1094) - lu(k,1107) = lu(k,1107) - lu(k,579) * lu(k,1094) - lu(k,1108) = lu(k,1108) - lu(k,580) * lu(k,1094) - lu(k,1110) = lu(k,1110) - lu(k,581) * lu(k,1094) - lu(k,1111) = lu(k,1111) - lu(k,582) * lu(k,1094) - lu(k,1112) = lu(k,1112) - lu(k,583) * lu(k,1094) - lu(k,1113) = lu(k,1113) - lu(k,584) * lu(k,1094) - lu(k,1114) = lu(k,1114) - lu(k,585) * lu(k,1094) - lu(k,1115) = lu(k,1115) - lu(k,586) * lu(k,1094) - lu(k,1116) = lu(k,1116) - lu(k,587) * lu(k,1094) - lu(k,1117) = lu(k,1117) - lu(k,588) * lu(k,1094) - lu(k,1119) = lu(k,1119) - lu(k,589) * lu(k,1094) - lu(k,1120) = lu(k,1120) - lu(k,590) * lu(k,1094) - lu(k,1121) = lu(k,1121) - lu(k,591) * lu(k,1094) - lu(k,1122) = lu(k,1122) - lu(k,592) * lu(k,1094) - lu(k,1123) = lu(k,1123) - lu(k,593) * lu(k,1094) - lu(k,1124) = lu(k,1124) - lu(k,594) * lu(k,1094) - lu(k,1142) = lu(k,1142) - lu(k,574) * lu(k,1139) - lu(k,1144) = lu(k,1144) - lu(k,575) * lu(k,1139) - lu(k,1146) = lu(k,1146) - lu(k,576) * lu(k,1139) - lu(k,1149) = lu(k,1149) - lu(k,577) * lu(k,1139) - lu(k,1150) = lu(k,1150) - lu(k,578) * lu(k,1139) - lu(k,1152) = lu(k,1152) - lu(k,579) * lu(k,1139) - lu(k,1153) = lu(k,1153) - lu(k,580) * lu(k,1139) - lu(k,1155) = lu(k,1155) - lu(k,581) * lu(k,1139) - lu(k,1156) = lu(k,1156) - lu(k,582) * lu(k,1139) - lu(k,1157) = lu(k,1157) - lu(k,583) * lu(k,1139) - lu(k,1158) = lu(k,1158) - lu(k,584) * lu(k,1139) - lu(k,1159) = lu(k,1159) - lu(k,585) * lu(k,1139) - lu(k,1160) = lu(k,1160) - lu(k,586) * lu(k,1139) - lu(k,1161) = lu(k,1161) - lu(k,587) * lu(k,1139) - lu(k,1162) = lu(k,1162) - lu(k,588) * lu(k,1139) - lu(k,1164) = lu(k,1164) - lu(k,589) * lu(k,1139) - lu(k,1165) = lu(k,1165) - lu(k,590) * lu(k,1139) - lu(k,1166) = lu(k,1166) - lu(k,591) * lu(k,1139) - lu(k,1167) = lu(k,1167) - lu(k,592) * lu(k,1139) - lu(k,1168) = lu(k,1168) - lu(k,593) * lu(k,1139) - lu(k,1169) = lu(k,1169) - lu(k,594) * lu(k,1139) - lu(k,1221) = lu(k,1221) - lu(k,574) * lu(k,1219) - lu(k,1223) = lu(k,1223) - lu(k,575) * lu(k,1219) - lu(k,1224) = lu(k,1224) - lu(k,576) * lu(k,1219) - lu(k,1227) = lu(k,1227) - lu(k,577) * lu(k,1219) - lu(k,1228) = lu(k,1228) - lu(k,578) * lu(k,1219) - lu(k,1230) = lu(k,1230) - lu(k,579) * lu(k,1219) - lu(k,1231) = lu(k,1231) - lu(k,580) * lu(k,1219) - lu(k,1233) = lu(k,1233) - lu(k,581) * lu(k,1219) - lu(k,1234) = lu(k,1234) - lu(k,582) * lu(k,1219) - lu(k,1235) = - lu(k,583) * lu(k,1219) - lu(k,1236) = lu(k,1236) - lu(k,584) * lu(k,1219) - lu(k,1237) = lu(k,1237) - lu(k,585) * lu(k,1219) - lu(k,1238) = lu(k,1238) - lu(k,586) * lu(k,1219) - lu(k,1239) = lu(k,1239) - lu(k,587) * lu(k,1219) - lu(k,1240) = lu(k,1240) - lu(k,588) * lu(k,1219) - lu(k,1242) = lu(k,1242) - lu(k,589) * lu(k,1219) - lu(k,1243) = lu(k,1243) - lu(k,590) * lu(k,1219) - lu(k,1244) = lu(k,1244) - lu(k,591) * lu(k,1219) - lu(k,1245) = lu(k,1245) - lu(k,592) * lu(k,1219) - lu(k,1246) = lu(k,1246) - lu(k,593) * lu(k,1219) - lu(k,1247) = lu(k,1247) - lu(k,594) * lu(k,1219) - lu(k,1263) = lu(k,1263) - lu(k,574) * lu(k,1260) - lu(k,1265) = lu(k,1265) - lu(k,575) * lu(k,1260) - lu(k,1267) = lu(k,1267) - lu(k,576) * lu(k,1260) - lu(k,1270) = lu(k,1270) - lu(k,577) * lu(k,1260) - lu(k,1271) = lu(k,1271) - lu(k,578) * lu(k,1260) - lu(k,1273) = - lu(k,579) * lu(k,1260) - lu(k,1274) = lu(k,1274) - lu(k,580) * lu(k,1260) - lu(k,1276) = - lu(k,581) * lu(k,1260) - lu(k,1277) = lu(k,1277) - lu(k,582) * lu(k,1260) - lu(k,1278) = lu(k,1278) - lu(k,583) * lu(k,1260) - lu(k,1279) = lu(k,1279) - lu(k,584) * lu(k,1260) - lu(k,1280) = lu(k,1280) - lu(k,585) * lu(k,1260) - lu(k,1281) = lu(k,1281) - lu(k,586) * lu(k,1260) - lu(k,1282) = - lu(k,587) * lu(k,1260) - lu(k,1283) = - lu(k,588) * lu(k,1260) - lu(k,1285) = lu(k,1285) - lu(k,589) * lu(k,1260) - lu(k,1286) = lu(k,1286) - lu(k,590) * lu(k,1260) - lu(k,1287) = - lu(k,591) * lu(k,1260) - lu(k,1288) = lu(k,1288) - lu(k,592) * lu(k,1260) - lu(k,1289) = lu(k,1289) - lu(k,593) * lu(k,1260) - lu(k,1290) = lu(k,1290) - lu(k,594) * lu(k,1260) - lu(k,1344) = lu(k,1344) - lu(k,574) * lu(k,1340) - lu(k,1346) = lu(k,1346) - lu(k,575) * lu(k,1340) - lu(k,1348) = lu(k,1348) - lu(k,576) * lu(k,1340) - lu(k,1351) = lu(k,1351) - lu(k,577) * lu(k,1340) - lu(k,1352) = lu(k,1352) - lu(k,578) * lu(k,1340) - lu(k,1354) = lu(k,1354) - lu(k,579) * lu(k,1340) - lu(k,1355) = lu(k,1355) - lu(k,580) * lu(k,1340) - lu(k,1357) = lu(k,1357) - lu(k,581) * lu(k,1340) - lu(k,1358) = lu(k,1358) - lu(k,582) * lu(k,1340) - lu(k,1359) = lu(k,1359) - lu(k,583) * lu(k,1340) - lu(k,1360) = lu(k,1360) - lu(k,584) * lu(k,1340) - lu(k,1361) = lu(k,1361) - lu(k,585) * lu(k,1340) - lu(k,1362) = lu(k,1362) - lu(k,586) * lu(k,1340) - lu(k,1363) = lu(k,1363) - lu(k,587) * lu(k,1340) - lu(k,1364) = - lu(k,588) * lu(k,1340) - lu(k,1366) = - lu(k,589) * lu(k,1340) - lu(k,1367) = lu(k,1367) - lu(k,590) * lu(k,1340) - lu(k,1368) = lu(k,1368) - lu(k,591) * lu(k,1340) - lu(k,1369) = lu(k,1369) - lu(k,592) * lu(k,1340) - lu(k,1370) = lu(k,1370) - lu(k,593) * lu(k,1340) - lu(k,1371) = lu(k,1371) - lu(k,594) * lu(k,1340) - lu(k,1386) = lu(k,1386) - lu(k,574) * lu(k,1383) - lu(k,1388) = lu(k,1388) - lu(k,575) * lu(k,1383) - lu(k,1390) = lu(k,1390) - lu(k,576) * lu(k,1383) - lu(k,1393) = lu(k,1393) - lu(k,577) * lu(k,1383) - lu(k,1394) = lu(k,1394) - lu(k,578) * lu(k,1383) - lu(k,1396) = - lu(k,579) * lu(k,1383) - lu(k,1397) = lu(k,1397) - lu(k,580) * lu(k,1383) - lu(k,1399) = - lu(k,581) * lu(k,1383) - lu(k,1400) = lu(k,1400) - lu(k,582) * lu(k,1383) - lu(k,1401) = lu(k,1401) - lu(k,583) * lu(k,1383) - lu(k,1402) = lu(k,1402) - lu(k,584) * lu(k,1383) - lu(k,1403) = lu(k,1403) - lu(k,585) * lu(k,1383) - lu(k,1404) = lu(k,1404) - lu(k,586) * lu(k,1383) - lu(k,1405) = - lu(k,587) * lu(k,1383) - lu(k,1406) = - lu(k,588) * lu(k,1383) - lu(k,1408) = lu(k,1408) - lu(k,589) * lu(k,1383) - lu(k,1409) = lu(k,1409) - lu(k,590) * lu(k,1383) - lu(k,1410) = - lu(k,591) * lu(k,1383) - lu(k,1411) = lu(k,1411) - lu(k,592) * lu(k,1383) - lu(k,1412) = lu(k,1412) - lu(k,593) * lu(k,1383) - lu(k,1413) = lu(k,1413) - lu(k,594) * lu(k,1383) - lu(k,1424) = lu(k,1424) - lu(k,574) * lu(k,1421) - lu(k,1426) = lu(k,1426) - lu(k,575) * lu(k,1421) - lu(k,1428) = lu(k,1428) - lu(k,576) * lu(k,1421) - lu(k,1431) = lu(k,1431) - lu(k,577) * lu(k,1421) - lu(k,1432) = lu(k,1432) - lu(k,578) * lu(k,1421) - lu(k,1434) = lu(k,1434) - lu(k,579) * lu(k,1421) - lu(k,1435) = lu(k,1435) - lu(k,580) * lu(k,1421) - lu(k,1437) = lu(k,1437) - lu(k,581) * lu(k,1421) - lu(k,1438) = lu(k,1438) - lu(k,582) * lu(k,1421) - lu(k,1439) = lu(k,1439) - lu(k,583) * lu(k,1421) - lu(k,1440) = lu(k,1440) - lu(k,584) * lu(k,1421) - lu(k,1441) = lu(k,1441) - lu(k,585) * lu(k,1421) - lu(k,1442) = lu(k,1442) - lu(k,586) * lu(k,1421) - lu(k,1443) = lu(k,1443) - lu(k,587) * lu(k,1421) - lu(k,1444) = lu(k,1444) - lu(k,588) * lu(k,1421) - lu(k,1446) = lu(k,1446) - lu(k,589) * lu(k,1421) - lu(k,1447) = lu(k,1447) - lu(k,590) * lu(k,1421) - lu(k,1448) = lu(k,1448) - lu(k,591) * lu(k,1421) - lu(k,1449) = lu(k,1449) - lu(k,592) * lu(k,1421) - lu(k,1450) = lu(k,1450) - lu(k,593) * lu(k,1421) - lu(k,1451) = lu(k,1451) - lu(k,594) * lu(k,1421) - lu(k,1469) = lu(k,1469) - lu(k,574) * lu(k,1465) - lu(k,1471) = lu(k,1471) - lu(k,575) * lu(k,1465) - lu(k,1473) = lu(k,1473) - lu(k,576) * lu(k,1465) - lu(k,1476) = lu(k,1476) - lu(k,577) * lu(k,1465) - lu(k,1477) = lu(k,1477) - lu(k,578) * lu(k,1465) - lu(k,1479) = lu(k,1479) - lu(k,579) * lu(k,1465) - lu(k,1480) = lu(k,1480) - lu(k,580) * lu(k,1465) - lu(k,1482) = lu(k,1482) - lu(k,581) * lu(k,1465) - lu(k,1483) = lu(k,1483) - lu(k,582) * lu(k,1465) - lu(k,1484) = lu(k,1484) - lu(k,583) * lu(k,1465) - lu(k,1485) = lu(k,1485) - lu(k,584) * lu(k,1465) - lu(k,1486) = lu(k,1486) - lu(k,585) * lu(k,1465) - lu(k,1487) = lu(k,1487) - lu(k,586) * lu(k,1465) - lu(k,1488) = lu(k,1488) - lu(k,587) * lu(k,1465) - lu(k,1489) = lu(k,1489) - lu(k,588) * lu(k,1465) - lu(k,1491) = lu(k,1491) - lu(k,589) * lu(k,1465) - lu(k,1492) = lu(k,1492) - lu(k,590) * lu(k,1465) - lu(k,1493) = lu(k,1493) - lu(k,591) * lu(k,1465) - lu(k,1494) = lu(k,1494) - lu(k,592) * lu(k,1465) - lu(k,1495) = lu(k,1495) - lu(k,593) * lu(k,1465) - lu(k,1496) = lu(k,1496) - lu(k,594) * lu(k,1465) - lu(k,1512) = lu(k,1512) - lu(k,574) * lu(k,1508) - lu(k,1514) = lu(k,1514) - lu(k,575) * lu(k,1508) - lu(k,1516) = - lu(k,576) * lu(k,1508) - lu(k,1519) = lu(k,1519) - lu(k,577) * lu(k,1508) - lu(k,1520) = lu(k,1520) - lu(k,578) * lu(k,1508) - lu(k,1522) = lu(k,1522) - lu(k,579) * lu(k,1508) - lu(k,1523) = lu(k,1523) - lu(k,580) * lu(k,1508) - lu(k,1525) = lu(k,1525) - lu(k,581) * lu(k,1508) - lu(k,1526) = lu(k,1526) - lu(k,582) * lu(k,1508) - lu(k,1527) = lu(k,1527) - lu(k,583) * lu(k,1508) - lu(k,1528) = - lu(k,584) * lu(k,1508) - lu(k,1529) = lu(k,1529) - lu(k,585) * lu(k,1508) - lu(k,1530) = lu(k,1530) - lu(k,586) * lu(k,1508) - lu(k,1531) = lu(k,1531) - lu(k,587) * lu(k,1508) - lu(k,1532) = lu(k,1532) - lu(k,588) * lu(k,1508) - lu(k,1534) = lu(k,1534) - lu(k,589) * lu(k,1508) - lu(k,1535) = lu(k,1535) - lu(k,590) * lu(k,1508) - lu(k,1536) = lu(k,1536) - lu(k,591) * lu(k,1508) - lu(k,1537) = lu(k,1537) - lu(k,592) * lu(k,1508) - lu(k,1538) = lu(k,1538) - lu(k,593) * lu(k,1508) - lu(k,1539) = lu(k,1539) - lu(k,594) * lu(k,1508) - lu(k,1624) = lu(k,1624) - lu(k,574) * lu(k,1621) - lu(k,1626) = lu(k,1626) - lu(k,575) * lu(k,1621) - lu(k,1628) = lu(k,1628) - lu(k,576) * lu(k,1621) - lu(k,1631) = lu(k,1631) - lu(k,577) * lu(k,1621) - lu(k,1632) = lu(k,1632) - lu(k,578) * lu(k,1621) - lu(k,1634) = lu(k,1634) - lu(k,579) * lu(k,1621) - lu(k,1635) = lu(k,1635) - lu(k,580) * lu(k,1621) - lu(k,1637) = lu(k,1637) - lu(k,581) * lu(k,1621) - lu(k,1638) = lu(k,1638) - lu(k,582) * lu(k,1621) - lu(k,1639) = lu(k,1639) - lu(k,583) * lu(k,1621) - lu(k,1640) = lu(k,1640) - lu(k,584) * lu(k,1621) - lu(k,1641) = lu(k,1641) - lu(k,585) * lu(k,1621) - lu(k,1642) = lu(k,1642) - lu(k,586) * lu(k,1621) - lu(k,1643) = lu(k,1643) - lu(k,587) * lu(k,1621) - lu(k,1644) = lu(k,1644) - lu(k,588) * lu(k,1621) - lu(k,1646) = lu(k,1646) - lu(k,589) * lu(k,1621) - lu(k,1647) = lu(k,1647) - lu(k,590) * lu(k,1621) - lu(k,1648) = lu(k,1648) - lu(k,591) * lu(k,1621) - lu(k,1649) = lu(k,1649) - lu(k,592) * lu(k,1621) - lu(k,1650) = lu(k,1650) - lu(k,593) * lu(k,1621) - lu(k,1651) = lu(k,1651) - lu(k,594) * lu(k,1621) - lu(k,1667) = lu(k,1667) - lu(k,574) * lu(k,1663) - lu(k,1669) = lu(k,1669) - lu(k,575) * lu(k,1663) - lu(k,1671) = - lu(k,576) * lu(k,1663) - lu(k,1674) = lu(k,1674) - lu(k,577) * lu(k,1663) - lu(k,1675) = lu(k,1675) - lu(k,578) * lu(k,1663) - lu(k,1677) = lu(k,1677) - lu(k,579) * lu(k,1663) - lu(k,1678) = lu(k,1678) - lu(k,580) * lu(k,1663) - lu(k,1680) = lu(k,1680) - lu(k,581) * lu(k,1663) - lu(k,1681) = lu(k,1681) - lu(k,582) * lu(k,1663) - lu(k,1682) = lu(k,1682) - lu(k,583) * lu(k,1663) - lu(k,1683) = - lu(k,584) * lu(k,1663) - lu(k,1684) = lu(k,1684) - lu(k,585) * lu(k,1663) - lu(k,1685) = lu(k,1685) - lu(k,586) * lu(k,1663) - lu(k,1686) = lu(k,1686) - lu(k,587) * lu(k,1663) - lu(k,1687) = lu(k,1687) - lu(k,588) * lu(k,1663) - lu(k,1689) = lu(k,1689) - lu(k,589) * lu(k,1663) - lu(k,1690) = lu(k,1690) - lu(k,590) * lu(k,1663) - lu(k,1691) = lu(k,1691) - lu(k,591) * lu(k,1663) - lu(k,1692) = lu(k,1692) - lu(k,592) * lu(k,1663) - lu(k,1693) = lu(k,1693) - lu(k,593) * lu(k,1663) - lu(k,1694) = lu(k,1694) - lu(k,594) * lu(k,1663) - lu(k,1703) = lu(k,1703) - lu(k,574) * lu(k,1699) - lu(k,1705) = lu(k,1705) - lu(k,575) * lu(k,1699) - lu(k,1707) = lu(k,1707) - lu(k,576) * lu(k,1699) - lu(k,1710) = lu(k,1710) - lu(k,577) * lu(k,1699) - lu(k,1711) = lu(k,1711) - lu(k,578) * lu(k,1699) - lu(k,1713) = lu(k,1713) - lu(k,579) * lu(k,1699) - lu(k,1714) = lu(k,1714) - lu(k,580) * lu(k,1699) - lu(k,1716) = lu(k,1716) - lu(k,581) * lu(k,1699) - lu(k,1717) = lu(k,1717) - lu(k,582) * lu(k,1699) - lu(k,1718) = lu(k,1718) - lu(k,583) * lu(k,1699) - lu(k,1719) = - lu(k,584) * lu(k,1699) - lu(k,1720) = lu(k,1720) - lu(k,585) * lu(k,1699) - lu(k,1721) = lu(k,1721) - lu(k,586) * lu(k,1699) - lu(k,1722) = lu(k,1722) - lu(k,587) * lu(k,1699) - lu(k,1723) = lu(k,1723) - lu(k,588) * lu(k,1699) - lu(k,1725) = lu(k,1725) - lu(k,589) * lu(k,1699) - lu(k,1726) = lu(k,1726) - lu(k,590) * lu(k,1699) - lu(k,1727) = lu(k,1727) - lu(k,591) * lu(k,1699) - lu(k,1728) = lu(k,1728) - lu(k,592) * lu(k,1699) - lu(k,1729) = lu(k,1729) - lu(k,593) * lu(k,1699) - lu(k,1730) = lu(k,1730) - lu(k,594) * lu(k,1699) - lu(k,1745) = lu(k,1745) - lu(k,574) * lu(k,1742) - lu(k,1747) = lu(k,1747) - lu(k,575) * lu(k,1742) - lu(k,1749) = lu(k,1749) - lu(k,576) * lu(k,1742) - lu(k,1752) = lu(k,1752) - lu(k,577) * lu(k,1742) - lu(k,1753) = lu(k,1753) - lu(k,578) * lu(k,1742) - lu(k,1755) = lu(k,1755) - lu(k,579) * lu(k,1742) - lu(k,1756) = lu(k,1756) - lu(k,580) * lu(k,1742) - lu(k,1758) = lu(k,1758) - lu(k,581) * lu(k,1742) - lu(k,1759) = lu(k,1759) - lu(k,582) * lu(k,1742) - lu(k,1760) = lu(k,1760) - lu(k,583) * lu(k,1742) - lu(k,1761) = lu(k,1761) - lu(k,584) * lu(k,1742) - lu(k,1762) = lu(k,1762) - lu(k,585) * lu(k,1742) - lu(k,1763) = lu(k,1763) - lu(k,586) * lu(k,1742) - lu(k,1764) = lu(k,1764) - lu(k,587) * lu(k,1742) - lu(k,1765) = lu(k,1765) - lu(k,588) * lu(k,1742) - lu(k,1767) = lu(k,1767) - lu(k,589) * lu(k,1742) - lu(k,1768) = lu(k,1768) - lu(k,590) * lu(k,1742) - lu(k,1769) = lu(k,1769) - lu(k,591) * lu(k,1742) - lu(k,1770) = lu(k,1770) - lu(k,592) * lu(k,1742) - lu(k,1771) = lu(k,1771) - lu(k,593) * lu(k,1742) - lu(k,1772) = lu(k,1772) - lu(k,594) * lu(k,1742) - lu(k,1798) = lu(k,1798) - lu(k,574) * lu(k,1795) - lu(k,1800) = lu(k,1800) - lu(k,575) * lu(k,1795) - lu(k,1802) = lu(k,1802) - lu(k,576) * lu(k,1795) - lu(k,1805) = lu(k,1805) - lu(k,577) * lu(k,1795) - lu(k,1806) = lu(k,1806) - lu(k,578) * lu(k,1795) - lu(k,1808) = lu(k,1808) - lu(k,579) * lu(k,1795) - lu(k,1809) = lu(k,1809) - lu(k,580) * lu(k,1795) - lu(k,1811) = lu(k,1811) - lu(k,581) * lu(k,1795) - lu(k,1812) = lu(k,1812) - lu(k,582) * lu(k,1795) - lu(k,1813) = lu(k,1813) - lu(k,583) * lu(k,1795) - lu(k,1814) = lu(k,1814) - lu(k,584) * lu(k,1795) - lu(k,1815) = lu(k,1815) - lu(k,585) * lu(k,1795) - lu(k,1816) = lu(k,1816) - lu(k,586) * lu(k,1795) - lu(k,1817) = lu(k,1817) - lu(k,587) * lu(k,1795) - lu(k,1818) = lu(k,1818) - lu(k,588) * lu(k,1795) - lu(k,1820) = lu(k,1820) - lu(k,589) * lu(k,1795) - lu(k,1821) = lu(k,1821) - lu(k,590) * lu(k,1795) - lu(k,1822) = lu(k,1822) - lu(k,591) * lu(k,1795) - lu(k,1823) = lu(k,1823) - lu(k,592) * lu(k,1795) - lu(k,1824) = lu(k,1824) - lu(k,593) * lu(k,1795) - lu(k,1825) = lu(k,1825) - lu(k,594) * lu(k,1795) - end do + real(r8), intent(inout) :: lu(:) + lu(583) = 1._r8 / lu(583) + lu(584) = lu(584) * lu(583) + lu(585) = lu(585) * lu(583) + lu(586) = lu(586) * lu(583) + lu(587) = lu(587) * lu(583) + lu(588) = lu(588) * lu(583) + lu(589) = lu(589) * lu(583) + lu(590) = lu(590) * lu(583) + lu(591) = lu(591) * lu(583) + lu(592) = lu(592) * lu(583) + lu(593) = lu(593) * lu(583) + lu(594) = lu(594) * lu(583) + lu(595) = lu(595) * lu(583) + lu(596) = lu(596) * lu(583) + lu(597) = lu(597) * lu(583) + lu(598) = lu(598) * lu(583) + lu(599) = lu(599) * lu(583) + lu(600) = lu(600) * lu(583) + lu(601) = lu(601) * lu(583) + lu(602) = lu(602) * lu(583) + lu(603) = lu(603) * lu(583) + lu(604) = lu(604) * lu(583) + lu(605) = lu(605) * lu(583) + lu(606) = lu(606) * lu(583) + lu(607) = lu(607) * lu(583) + lu(608) = lu(608) * lu(583) + lu(609) = lu(609) * lu(583) + lu(610) = lu(610) * lu(583) + lu(811) = lu(811) - lu(584) * lu(810) + lu(812) = lu(812) - lu(585) * lu(810) + lu(813) = lu(813) - lu(586) * lu(810) + lu(814) = lu(814) - lu(587) * lu(810) + lu(815) = lu(815) - lu(588) * lu(810) + lu(816) = lu(816) - lu(589) * lu(810) + lu(817) = lu(817) - lu(590) * lu(810) + lu(818) = lu(818) - lu(591) * lu(810) + lu(819) = lu(819) - lu(592) * lu(810) + lu(820) = lu(820) - lu(593) * lu(810) + lu(821) = lu(821) - lu(594) * lu(810) + lu(822) = lu(822) - lu(595) * lu(810) + lu(823) = lu(823) - lu(596) * lu(810) + lu(824) = lu(824) - lu(597) * lu(810) + lu(825) = lu(825) - lu(598) * lu(810) + lu(826) = lu(826) - lu(599) * lu(810) + lu(827) = lu(827) - lu(600) * lu(810) + lu(828) = lu(828) - lu(601) * lu(810) + lu(829) = lu(829) - lu(602) * lu(810) + lu(830) = lu(830) - lu(603) * lu(810) + lu(831) = lu(831) - lu(604) * lu(810) + lu(832) = lu(832) - lu(605) * lu(810) + lu(833) = lu(833) - lu(606) * lu(810) + lu(834) = lu(834) - lu(607) * lu(810) + lu(835) = lu(835) - lu(608) * lu(810) + lu(836) = lu(836) - lu(609) * lu(810) + lu(839) = lu(839) - lu(610) * lu(810) + lu(853) = lu(853) - lu(584) * lu(852) + lu(854) = lu(854) - lu(585) * lu(852) + lu(855) = - lu(586) * lu(852) + lu(856) = lu(856) - lu(587) * lu(852) + lu(857) = lu(857) - lu(588) * lu(852) + lu(858) = lu(858) - lu(589) * lu(852) + lu(859) = lu(859) - lu(590) * lu(852) + lu(860) = lu(860) - lu(591) * lu(852) + lu(861) = lu(861) - lu(592) * lu(852) + lu(862) = lu(862) - lu(593) * lu(852) + lu(863) = lu(863) - lu(594) * lu(852) + lu(864) = lu(864) - lu(595) * lu(852) + lu(865) = lu(865) - lu(596) * lu(852) + lu(866) = - lu(597) * lu(852) + lu(867) = lu(867) - lu(598) * lu(852) + lu(868) = lu(868) - lu(599) * lu(852) + lu(869) = lu(869) - lu(600) * lu(852) + lu(870) = lu(870) - lu(601) * lu(852) + lu(871) = lu(871) - lu(602) * lu(852) + lu(872) = lu(872) - lu(603) * lu(852) + lu(873) = lu(873) - lu(604) * lu(852) + lu(874) = lu(874) - lu(605) * lu(852) + lu(875) = lu(875) - lu(606) * lu(852) + lu(876) = - lu(607) * lu(852) + lu(877) = - lu(608) * lu(852) + lu(878) = - lu(609) * lu(852) + lu(881) = lu(881) - lu(610) * lu(852) + lu(897) = lu(897) - lu(584) * lu(896) + lu(898) = lu(898) - lu(585) * lu(896) + lu(899) = lu(899) - lu(586) * lu(896) + lu(900) = lu(900) - lu(587) * lu(896) + lu(901) = - lu(588) * lu(896) + lu(902) = lu(902) - lu(589) * lu(896) + lu(903) = lu(903) - lu(590) * lu(896) + lu(904) = lu(904) - lu(591) * lu(896) + lu(905) = lu(905) - lu(592) * lu(896) + lu(906) = lu(906) - lu(593) * lu(896) + lu(907) = lu(907) - lu(594) * lu(896) + lu(908) = lu(908) - lu(595) * lu(896) + lu(909) = lu(909) - lu(596) * lu(896) + lu(910) = lu(910) - lu(597) * lu(896) + lu(911) = lu(911) - lu(598) * lu(896) + lu(912) = lu(912) - lu(599) * lu(896) + lu(913) = lu(913) - lu(600) * lu(896) + lu(914) = lu(914) - lu(601) * lu(896) + lu(915) = lu(915) - lu(602) * lu(896) + lu(916) = lu(916) - lu(603) * lu(896) + lu(917) = lu(917) - lu(604) * lu(896) + lu(918) = lu(918) - lu(605) * lu(896) + lu(919) = lu(919) - lu(606) * lu(896) + lu(920) = lu(920) - lu(607) * lu(896) + lu(921) = lu(921) - lu(608) * lu(896) + lu(922) = lu(922) - lu(609) * lu(896) + lu(925) = lu(925) - lu(610) * lu(896) + lu(932) = lu(932) - lu(584) * lu(931) + lu(933) = lu(933) - lu(585) * lu(931) + lu(934) = lu(934) - lu(586) * lu(931) + lu(935) = lu(935) - lu(587) * lu(931) + lu(936) = lu(936) - lu(588) * lu(931) + lu(937) = lu(937) - lu(589) * lu(931) + lu(938) = - lu(590) * lu(931) + lu(939) = - lu(591) * lu(931) + lu(940) = lu(940) - lu(592) * lu(931) + lu(941) = lu(941) - lu(593) * lu(931) + lu(942) = lu(942) - lu(594) * lu(931) + lu(943) = lu(943) - lu(595) * lu(931) + lu(944) = lu(944) - lu(596) * lu(931) + lu(945) = lu(945) - lu(597) * lu(931) + lu(946) = lu(946) - lu(598) * lu(931) + lu(947) = lu(947) - lu(599) * lu(931) + lu(948) = lu(948) - lu(600) * lu(931) + lu(949) = lu(949) - lu(601) * lu(931) + lu(950) = lu(950) - lu(602) * lu(931) + lu(951) = - lu(603) * lu(931) + lu(952) = lu(952) - lu(604) * lu(931) + lu(953) = - lu(605) * lu(931) + lu(954) = lu(954) - lu(606) * lu(931) + lu(955) = lu(955) - lu(607) * lu(931) + lu(956) = lu(956) - lu(608) * lu(931) + lu(957) = lu(957) - lu(609) * lu(931) + lu(960) = lu(960) - lu(610) * lu(931) + lu(973) = lu(973) - lu(584) * lu(972) + lu(974) = lu(974) - lu(585) * lu(972) + lu(975) = lu(975) - lu(586) * lu(972) + lu(976) = lu(976) - lu(587) * lu(972) + lu(977) = lu(977) - lu(588) * lu(972) + lu(978) = lu(978) - lu(589) * lu(972) + lu(979) = lu(979) - lu(590) * lu(972) + lu(980) = lu(980) - lu(591) * lu(972) + lu(981) = lu(981) - lu(592) * lu(972) + lu(982) = lu(982) - lu(593) * lu(972) + lu(983) = lu(983) - lu(594) * lu(972) + lu(984) = lu(984) - lu(595) * lu(972) + lu(985) = lu(985) - lu(596) * lu(972) + lu(986) = - lu(597) * lu(972) + lu(987) = lu(987) - lu(598) * lu(972) + lu(988) = lu(988) - lu(599) * lu(972) + lu(989) = lu(989) - lu(600) * lu(972) + lu(990) = lu(990) - lu(601) * lu(972) + lu(991) = lu(991) - lu(602) * lu(972) + lu(992) = lu(992) - lu(603) * lu(972) + lu(993) = lu(993) - lu(604) * lu(972) + lu(994) = lu(994) - lu(605) * lu(972) + lu(995) = lu(995) - lu(606) * lu(972) + lu(996) = - lu(607) * lu(972) + lu(997) = - lu(608) * lu(972) + lu(998) = - lu(609) * lu(972) + lu(1001) = lu(1001) - lu(610) * lu(972) + lu(1015) = lu(1015) - lu(584) * lu(1014) + lu(1016) = lu(1016) - lu(585) * lu(1014) + lu(1017) = - lu(586) * lu(1014) + lu(1018) = lu(1018) - lu(587) * lu(1014) + lu(1019) = lu(1019) - lu(588) * lu(1014) + lu(1020) = lu(1020) - lu(589) * lu(1014) + lu(1021) = lu(1021) - lu(590) * lu(1014) + lu(1022) = lu(1022) - lu(591) * lu(1014) + lu(1023) = lu(1023) - lu(592) * lu(1014) + lu(1024) = lu(1024) - lu(593) * lu(1014) + lu(1025) = lu(1025) - lu(594) * lu(1014) + lu(1026) = lu(1026) - lu(595) * lu(1014) + lu(1027) = lu(1027) - lu(596) * lu(1014) + lu(1028) = - lu(597) * lu(1014) + lu(1029) = lu(1029) - lu(598) * lu(1014) + lu(1030) = lu(1030) - lu(599) * lu(1014) + lu(1031) = lu(1031) - lu(600) * lu(1014) + lu(1032) = lu(1032) - lu(601) * lu(1014) + lu(1033) = lu(1033) - lu(602) * lu(1014) + lu(1034) = lu(1034) - lu(603) * lu(1014) + lu(1035) = lu(1035) - lu(604) * lu(1014) + lu(1036) = lu(1036) - lu(605) * lu(1014) + lu(1037) = lu(1037) - lu(606) * lu(1014) + lu(1038) = - lu(607) * lu(1014) + lu(1039) = - lu(608) * lu(1014) + lu(1040) = - lu(609) * lu(1014) + lu(1043) = lu(1043) - lu(610) * lu(1014) + lu(1101) = lu(1101) - lu(584) * lu(1100) + lu(1102) = - lu(585) * lu(1100) + lu(1103) = lu(1103) - lu(586) * lu(1100) + lu(1104) = lu(1104) - lu(587) * lu(1100) + lu(1105) = lu(1105) - lu(588) * lu(1100) + lu(1106) = lu(1106) - lu(589) * lu(1100) + lu(1107) = - lu(590) * lu(1100) + lu(1108) = - lu(591) * lu(1100) + lu(1109) = lu(1109) - lu(592) * lu(1100) + lu(1110) = lu(1110) - lu(593) * lu(1100) + lu(1111) = - lu(594) * lu(1100) + lu(1112) = lu(1112) - lu(595) * lu(1100) + lu(1113) = lu(1113) - lu(596) * lu(1100) + lu(1114) = lu(1114) - lu(597) * lu(1100) + lu(1115) = lu(1115) - lu(598) * lu(1100) + lu(1116) = lu(1116) - lu(599) * lu(1100) + lu(1117) = lu(1117) - lu(600) * lu(1100) + lu(1118) = lu(1118) - lu(601) * lu(1100) + lu(1119) = lu(1119) - lu(602) * lu(1100) + lu(1120) = - lu(603) * lu(1100) + lu(1121) = lu(1121) - lu(604) * lu(1100) + lu(1122) = - lu(605) * lu(1100) + lu(1123) = lu(1123) - lu(606) * lu(1100) + lu(1124) = lu(1124) - lu(607) * lu(1100) + lu(1125) = lu(1125) - lu(608) * lu(1100) + lu(1126) = lu(1126) - lu(609) * lu(1100) + lu(1129) = lu(1129) - lu(610) * lu(1100) + lu(1144) = - lu(584) * lu(1143) + lu(1145) = lu(1145) - lu(585) * lu(1143) + lu(1146) = lu(1146) - lu(586) * lu(1143) + lu(1147) = lu(1147) - lu(587) * lu(1143) + lu(1148) = lu(1148) - lu(588) * lu(1143) + lu(1149) = lu(1149) - lu(589) * lu(1143) + lu(1150) = lu(1150) - lu(590) * lu(1143) + lu(1151) = - lu(591) * lu(1143) + lu(1152) = lu(1152) - lu(592) * lu(1143) + lu(1153) = lu(1153) - lu(593) * lu(1143) + lu(1154) = - lu(594) * lu(1143) + lu(1155) = lu(1155) - lu(595) * lu(1143) + lu(1156) = lu(1156) - lu(596) * lu(1143) + lu(1157) = lu(1157) - lu(597) * lu(1143) + lu(1158) = lu(1158) - lu(598) * lu(1143) + lu(1159) = lu(1159) - lu(599) * lu(1143) + lu(1160) = lu(1160) - lu(600) * lu(1143) + lu(1161) = lu(1161) - lu(601) * lu(1143) + lu(1162) = lu(1162) - lu(602) * lu(1143) + lu(1163) = - lu(603) * lu(1143) + lu(1164) = lu(1164) - lu(604) * lu(1143) + lu(1165) = - lu(605) * lu(1143) + lu(1166) = lu(1166) - lu(606) * lu(1143) + lu(1167) = lu(1167) - lu(607) * lu(1143) + lu(1168) = lu(1168) - lu(608) * lu(1143) + lu(1169) = lu(1169) - lu(609) * lu(1143) + lu(1172) = lu(1172) - lu(610) * lu(1143) + lu(1186) = lu(1186) - lu(584) * lu(1185) + lu(1187) = - lu(585) * lu(1185) + lu(1188) = lu(1188) - lu(586) * lu(1185) + lu(1189) = lu(1189) - lu(587) * lu(1185) + lu(1190) = lu(1190) - lu(588) * lu(1185) + lu(1191) = lu(1191) - lu(589) * lu(1185) + lu(1192) = - lu(590) * lu(1185) + lu(1193) = - lu(591) * lu(1185) + lu(1194) = lu(1194) - lu(592) * lu(1185) + lu(1195) = lu(1195) - lu(593) * lu(1185) + lu(1196) = - lu(594) * lu(1185) + lu(1197) = lu(1197) - lu(595) * lu(1185) + lu(1198) = lu(1198) - lu(596) * lu(1185) + lu(1199) = lu(1199) - lu(597) * lu(1185) + lu(1200) = lu(1200) - lu(598) * lu(1185) + lu(1201) = lu(1201) - lu(599) * lu(1185) + lu(1202) = lu(1202) - lu(600) * lu(1185) + lu(1203) = lu(1203) - lu(601) * lu(1185) + lu(1204) = lu(1204) - lu(602) * lu(1185) + lu(1205) = - lu(603) * lu(1185) + lu(1206) = lu(1206) - lu(604) * lu(1185) + lu(1207) = - lu(605) * lu(1185) + lu(1208) = lu(1208) - lu(606) * lu(1185) + lu(1209) = lu(1209) - lu(607) * lu(1185) + lu(1210) = lu(1210) - lu(608) * lu(1185) + lu(1211) = lu(1211) - lu(609) * lu(1185) + lu(1214) = lu(1214) - lu(610) * lu(1185) + lu(1221) = lu(1221) - lu(584) * lu(1220) + lu(1222) = lu(1222) - lu(585) * lu(1220) + lu(1223) = lu(1223) - lu(586) * lu(1220) + lu(1224) = lu(1224) - lu(587) * lu(1220) + lu(1225) = lu(1225) - lu(588) * lu(1220) + lu(1226) = lu(1226) - lu(589) * lu(1220) + lu(1227) = lu(1227) - lu(590) * lu(1220) + lu(1228) = lu(1228) - lu(591) * lu(1220) + lu(1229) = lu(1229) - lu(592) * lu(1220) + lu(1230) = lu(1230) - lu(593) * lu(1220) + lu(1231) = lu(1231) - lu(594) * lu(1220) + lu(1232) = lu(1232) - lu(595) * lu(1220) + lu(1233) = lu(1233) - lu(596) * lu(1220) + lu(1234) = lu(1234) - lu(597) * lu(1220) + lu(1235) = lu(1235) - lu(598) * lu(1220) + lu(1236) = lu(1236) - lu(599) * lu(1220) + lu(1237) = lu(1237) - lu(600) * lu(1220) + lu(1238) = lu(1238) - lu(601) * lu(1220) + lu(1239) = lu(1239) - lu(602) * lu(1220) + lu(1240) = lu(1240) - lu(603) * lu(1220) + lu(1241) = lu(1241) - lu(604) * lu(1220) + lu(1242) = lu(1242) - lu(605) * lu(1220) + lu(1243) = lu(1243) - lu(606) * lu(1220) + lu(1244) = lu(1244) - lu(607) * lu(1220) + lu(1245) = lu(1245) - lu(608) * lu(1220) + lu(1246) = lu(1246) - lu(609) * lu(1220) + lu(1249) = lu(1249) - lu(610) * lu(1220) + lu(1265) = lu(1265) - lu(584) * lu(1264) + lu(1266) = lu(1266) - lu(585) * lu(1264) + lu(1267) = lu(1267) - lu(586) * lu(1264) + lu(1268) = lu(1268) - lu(587) * lu(1264) + lu(1269) = lu(1269) - lu(588) * lu(1264) + lu(1270) = lu(1270) - lu(589) * lu(1264) + lu(1271) = lu(1271) - lu(590) * lu(1264) + lu(1272) = lu(1272) - lu(591) * lu(1264) + lu(1273) = lu(1273) - lu(592) * lu(1264) + lu(1274) = lu(1274) - lu(593) * lu(1264) + lu(1275) = lu(1275) - lu(594) * lu(1264) + lu(1276) = lu(1276) - lu(595) * lu(1264) + lu(1277) = lu(1277) - lu(596) * lu(1264) + lu(1278) = lu(1278) - lu(597) * lu(1264) + lu(1279) = lu(1279) - lu(598) * lu(1264) + lu(1280) = lu(1280) - lu(599) * lu(1264) + lu(1281) = lu(1281) - lu(600) * lu(1264) + lu(1282) = lu(1282) - lu(601) * lu(1264) + lu(1283) = lu(1283) - lu(602) * lu(1264) + lu(1284) = lu(1284) - lu(603) * lu(1264) + lu(1285) = lu(1285) - lu(604) * lu(1264) + lu(1286) = lu(1286) - lu(605) * lu(1264) + lu(1287) = lu(1287) - lu(606) * lu(1264) + lu(1288) = lu(1288) - lu(607) * lu(1264) + lu(1289) = lu(1289) - lu(608) * lu(1264) + lu(1290) = lu(1290) - lu(609) * lu(1264) + lu(1293) = lu(1293) - lu(610) * lu(1264) + lu(1348) = lu(1348) - lu(584) * lu(1347) + lu(1349) = lu(1349) - lu(585) * lu(1347) + lu(1350) = - lu(586) * lu(1347) + lu(1351) = lu(1351) - lu(587) * lu(1347) + lu(1352) = lu(1352) - lu(588) * lu(1347) + lu(1353) = lu(1353) - lu(589) * lu(1347) + lu(1354) = lu(1354) - lu(590) * lu(1347) + lu(1355) = lu(1355) - lu(591) * lu(1347) + lu(1356) = lu(1356) - lu(592) * lu(1347) + lu(1357) = lu(1357) - lu(593) * lu(1347) + lu(1358) = lu(1358) - lu(594) * lu(1347) + lu(1359) = lu(1359) - lu(595) * lu(1347) + lu(1360) = lu(1360) - lu(596) * lu(1347) + lu(1361) = - lu(597) * lu(1347) + lu(1362) = lu(1362) - lu(598) * lu(1347) + lu(1363) = lu(1363) - lu(599) * lu(1347) + lu(1364) = lu(1364) - lu(600) * lu(1347) + lu(1365) = lu(1365) - lu(601) * lu(1347) + lu(1366) = lu(1366) - lu(602) * lu(1347) + lu(1367) = lu(1367) - lu(603) * lu(1347) + lu(1368) = lu(1368) - lu(604) * lu(1347) + lu(1369) = lu(1369) - lu(605) * lu(1347) + lu(1370) = lu(1370) - lu(606) * lu(1347) + lu(1371) = - lu(607) * lu(1347) + lu(1372) = - lu(608) * lu(1347) + lu(1373) = - lu(609) * lu(1347) + lu(1376) = lu(1376) - lu(610) * lu(1347) + lu(1432) = lu(1432) - lu(584) * lu(1431) + lu(1433) = lu(1433) - lu(585) * lu(1431) + lu(1434) = - lu(586) * lu(1431) + lu(1435) = lu(1435) - lu(587) * lu(1431) + lu(1436) = lu(1436) - lu(588) * lu(1431) + lu(1437) = lu(1437) - lu(589) * lu(1431) + lu(1438) = lu(1438) - lu(590) * lu(1431) + lu(1439) = lu(1439) - lu(591) * lu(1431) + lu(1440) = lu(1440) - lu(592) * lu(1431) + lu(1441) = lu(1441) - lu(593) * lu(1431) + lu(1442) = lu(1442) - lu(594) * lu(1431) + lu(1443) = lu(1443) - lu(595) * lu(1431) + lu(1444) = lu(1444) - lu(596) * lu(1431) + lu(1445) = - lu(597) * lu(1431) + lu(1446) = lu(1446) - lu(598) * lu(1431) + lu(1447) = lu(1447) - lu(599) * lu(1431) + lu(1448) = lu(1448) - lu(600) * lu(1431) + lu(1449) = lu(1449) - lu(601) * lu(1431) + lu(1450) = lu(1450) - lu(602) * lu(1431) + lu(1451) = lu(1451) - lu(603) * lu(1431) + lu(1452) = lu(1452) - lu(604) * lu(1431) + lu(1453) = lu(1453) - lu(605) * lu(1431) + lu(1454) = lu(1454) - lu(606) * lu(1431) + lu(1455) = - lu(607) * lu(1431) + lu(1456) = - lu(608) * lu(1431) + lu(1457) = - lu(609) * lu(1431) + lu(1460) = lu(1460) - lu(610) * lu(1431) + lu(1487) = lu(1487) - lu(584) * lu(1486) + lu(1488) = lu(1488) - lu(585) * lu(1486) + lu(1489) = lu(1489) - lu(586) * lu(1486) + lu(1490) = lu(1490) - lu(587) * lu(1486) + lu(1491) = lu(1491) - lu(588) * lu(1486) + lu(1492) = lu(1492) - lu(589) * lu(1486) + lu(1493) = lu(1493) - lu(590) * lu(1486) + lu(1494) = - lu(591) * lu(1486) + lu(1495) = lu(1495) - lu(592) * lu(1486) + lu(1496) = lu(1496) - lu(593) * lu(1486) + lu(1497) = - lu(594) * lu(1486) + lu(1498) = lu(1498) - lu(595) * lu(1486) + lu(1499) = lu(1499) - lu(596) * lu(1486) + lu(1500) = lu(1500) - lu(597) * lu(1486) + lu(1501) = lu(1501) - lu(598) * lu(1486) + lu(1502) = lu(1502) - lu(599) * lu(1486) + lu(1503) = lu(1503) - lu(600) * lu(1486) + lu(1504) = lu(1504) - lu(601) * lu(1486) + lu(1505) = lu(1505) - lu(602) * lu(1486) + lu(1506) = - lu(603) * lu(1486) + lu(1507) = lu(1507) - lu(604) * lu(1486) + lu(1508) = - lu(605) * lu(1486) + lu(1509) = lu(1509) - lu(606) * lu(1486) + lu(1510) = lu(1510) - lu(607) * lu(1486) + lu(1511) = lu(1511) - lu(608) * lu(1486) + lu(1512) = lu(1512) - lu(609) * lu(1486) + lu(1515) = lu(1515) - lu(610) * lu(1486) + lu(1592) = - lu(584) * lu(1591) + lu(1593) = lu(1593) - lu(585) * lu(1591) + lu(1594) = lu(1594) - lu(586) * lu(1591) + lu(1595) = lu(1595) - lu(587) * lu(1591) + lu(1596) = lu(1596) - lu(588) * lu(1591) + lu(1597) = lu(1597) - lu(589) * lu(1591) + lu(1598) = - lu(590) * lu(1591) + lu(1599) = - lu(591) * lu(1591) + lu(1600) = lu(1600) - lu(592) * lu(1591) + lu(1601) = lu(1601) - lu(593) * lu(1591) + lu(1602) = - lu(594) * lu(1591) + lu(1603) = lu(1603) - lu(595) * lu(1591) + lu(1604) = lu(1604) - lu(596) * lu(1591) + lu(1605) = lu(1605) - lu(597) * lu(1591) + lu(1606) = lu(1606) - lu(598) * lu(1591) + lu(1607) = lu(1607) - lu(599) * lu(1591) + lu(1608) = lu(1608) - lu(600) * lu(1591) + lu(1609) = lu(1609) - lu(601) * lu(1591) + lu(1610) = lu(1610) - lu(602) * lu(1591) + lu(1611) = - lu(603) * lu(1591) + lu(1612) = lu(1612) - lu(604) * lu(1591) + lu(1613) = - lu(605) * lu(1591) + lu(1614) = lu(1614) - lu(606) * lu(1591) + lu(1615) = lu(1615) - lu(607) * lu(1591) + lu(1616) = lu(1616) - lu(608) * lu(1591) + lu(1617) = lu(1617) - lu(609) * lu(1591) + lu(1620) = lu(1620) - lu(610) * lu(1591) end subroutine lu_fac14 - subroutine lu_fac15( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac15( lu ) 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,597) = 1._r8 / lu(k,597) - lu(k,598) = lu(k,598) * lu(k,597) - lu(k,599) = lu(k,599) * lu(k,597) - lu(k,600) = lu(k,600) * lu(k,597) - lu(k,601) = lu(k,601) * lu(k,597) - lu(k,602) = lu(k,602) * lu(k,597) - lu(k,603) = lu(k,603) * lu(k,597) - lu(k,604) = lu(k,604) * lu(k,597) - lu(k,605) = lu(k,605) * lu(k,597) - lu(k,606) = lu(k,606) * lu(k,597) - lu(k,607) = lu(k,607) * lu(k,597) - lu(k,608) = lu(k,608) * lu(k,597) - lu(k,609) = lu(k,609) * lu(k,597) - lu(k,610) = lu(k,610) * lu(k,597) - lu(k,611) = lu(k,611) * lu(k,597) - lu(k,612) = lu(k,612) * lu(k,597) - lu(k,613) = lu(k,613) * lu(k,597) - lu(k,614) = lu(k,614) * lu(k,597) - lu(k,615) = lu(k,615) * lu(k,597) - lu(k,620) = lu(k,620) - lu(k,598) * lu(k,618) - lu(k,622) = lu(k,622) - lu(k,599) * lu(k,618) - lu(k,625) = lu(k,625) - lu(k,600) * lu(k,618) - lu(k,626) = lu(k,626) - lu(k,601) * lu(k,618) - lu(k,627) = lu(k,627) - lu(k,602) * lu(k,618) - lu(k,629) = lu(k,629) - lu(k,603) * lu(k,618) - lu(k,630) = lu(k,630) - lu(k,604) * lu(k,618) - lu(k,631) = - lu(k,605) * lu(k,618) - lu(k,632) = lu(k,632) - lu(k,606) * lu(k,618) - lu(k,633) = lu(k,633) - lu(k,607) * lu(k,618) - lu(k,634) = lu(k,634) - lu(k,608) * lu(k,618) - lu(k,636) = lu(k,636) - lu(k,609) * lu(k,618) - lu(k,639) = lu(k,639) - lu(k,610) * lu(k,618) - lu(k,641) = lu(k,641) - lu(k,611) * lu(k,618) - lu(k,644) = lu(k,644) - lu(k,612) * lu(k,618) - lu(k,645) = lu(k,645) - lu(k,613) * lu(k,618) - lu(k,646) = lu(k,646) - lu(k,614) * lu(k,618) - lu(k,647) = lu(k,647) - lu(k,615) * lu(k,618) - lu(k,652) = lu(k,652) - lu(k,598) * lu(k,651) - lu(k,653) = lu(k,653) - lu(k,599) * lu(k,651) - lu(k,654) = lu(k,654) - lu(k,600) * lu(k,651) - lu(k,655) = lu(k,655) - lu(k,601) * lu(k,651) - lu(k,656) = lu(k,656) - lu(k,602) * lu(k,651) - lu(k,658) = lu(k,658) - lu(k,603) * lu(k,651) - lu(k,659) = lu(k,659) - lu(k,604) * lu(k,651) - lu(k,660) = lu(k,660) - lu(k,605) * lu(k,651) - lu(k,661) = lu(k,661) - lu(k,606) * lu(k,651) - lu(k,662) = lu(k,662) - lu(k,607) * lu(k,651) - lu(k,664) = lu(k,664) - lu(k,608) * lu(k,651) - lu(k,665) = lu(k,665) - lu(k,609) * lu(k,651) - lu(k,667) = lu(k,667) - lu(k,610) * lu(k,651) - lu(k,668) = lu(k,668) - lu(k,611) * lu(k,651) - lu(k,669) = - lu(k,612) * lu(k,651) - lu(k,670) = lu(k,670) - lu(k,613) * lu(k,651) - lu(k,671) = lu(k,671) - lu(k,614) * lu(k,651) - lu(k,672) = lu(k,672) - lu(k,615) * lu(k,651) - lu(k,711) = lu(k,711) - lu(k,598) * lu(k,710) - lu(k,712) = lu(k,712) - lu(k,599) * lu(k,710) - lu(k,714) = lu(k,714) - lu(k,600) * lu(k,710) - lu(k,715) = lu(k,715) - lu(k,601) * lu(k,710) - lu(k,716) = lu(k,716) - lu(k,602) * lu(k,710) - lu(k,718) = lu(k,718) - lu(k,603) * lu(k,710) - lu(k,719) = lu(k,719) - lu(k,604) * lu(k,710) - lu(k,720) = lu(k,720) - lu(k,605) * lu(k,710) - lu(k,721) = lu(k,721) - lu(k,606) * lu(k,710) - lu(k,722) = lu(k,722) - lu(k,607) * lu(k,710) - lu(k,724) = lu(k,724) - lu(k,608) * lu(k,710) - lu(k,725) = lu(k,725) - lu(k,609) * lu(k,710) - lu(k,727) = lu(k,727) - lu(k,610) * lu(k,710) - lu(k,729) = lu(k,729) - lu(k,611) * lu(k,710) - lu(k,731) = lu(k,731) - lu(k,612) * lu(k,710) - lu(k,732) = lu(k,732) - lu(k,613) * lu(k,710) - lu(k,733) = lu(k,733) - lu(k,614) * lu(k,710) - lu(k,734) = lu(k,734) - lu(k,615) * lu(k,710) - lu(k,782) = lu(k,782) - lu(k,598) * lu(k,781) - lu(k,783) = lu(k,783) - lu(k,599) * lu(k,781) - lu(k,786) = lu(k,786) - lu(k,600) * lu(k,781) - lu(k,787) = lu(k,787) - lu(k,601) * lu(k,781) - lu(k,788) = lu(k,788) - lu(k,602) * lu(k,781) - lu(k,790) = lu(k,790) - lu(k,603) * lu(k,781) - lu(k,791) = lu(k,791) - lu(k,604) * lu(k,781) - lu(k,792) = lu(k,792) - lu(k,605) * lu(k,781) - lu(k,793) = lu(k,793) - lu(k,606) * lu(k,781) - lu(k,794) = lu(k,794) - lu(k,607) * lu(k,781) - lu(k,796) = lu(k,796) - lu(k,608) * lu(k,781) - lu(k,798) = lu(k,798) - lu(k,609) * lu(k,781) - lu(k,801) = - lu(k,610) * lu(k,781) - lu(k,803) = lu(k,803) - lu(k,611) * lu(k,781) - lu(k,806) = lu(k,806) - lu(k,612) * lu(k,781) - lu(k,807) = lu(k,807) - lu(k,613) * lu(k,781) - lu(k,808) = lu(k,808) - lu(k,614) * lu(k,781) - lu(k,809) = lu(k,809) - lu(k,615) * lu(k,781) - lu(k,824) = lu(k,824) - lu(k,598) * lu(k,822) - lu(k,826) = lu(k,826) - lu(k,599) * lu(k,822) - lu(k,829) = lu(k,829) - lu(k,600) * lu(k,822) - lu(k,830) = lu(k,830) - lu(k,601) * lu(k,822) - lu(k,831) = lu(k,831) - lu(k,602) * lu(k,822) - lu(k,833) = lu(k,833) - lu(k,603) * lu(k,822) - lu(k,834) = lu(k,834) - lu(k,604) * lu(k,822) - lu(k,835) = lu(k,835) - lu(k,605) * lu(k,822) - lu(k,836) = lu(k,836) - lu(k,606) * lu(k,822) - lu(k,837) = lu(k,837) - lu(k,607) * lu(k,822) - lu(k,839) = lu(k,839) - lu(k,608) * lu(k,822) - lu(k,841) = lu(k,841) - lu(k,609) * lu(k,822) - lu(k,844) = lu(k,844) - lu(k,610) * lu(k,822) - lu(k,846) = lu(k,846) - lu(k,611) * lu(k,822) - lu(k,849) = lu(k,849) - lu(k,612) * lu(k,822) - lu(k,850) = lu(k,850) - lu(k,613) * lu(k,822) - lu(k,851) = lu(k,851) - lu(k,614) * lu(k,822) - lu(k,852) = lu(k,852) - lu(k,615) * lu(k,822) - lu(k,872) = lu(k,872) - lu(k,598) * lu(k,870) - lu(k,874) = lu(k,874) - lu(k,599) * lu(k,870) - lu(k,877) = lu(k,877) - lu(k,600) * lu(k,870) - lu(k,878) = lu(k,878) - lu(k,601) * lu(k,870) - lu(k,879) = lu(k,879) - lu(k,602) * lu(k,870) - lu(k,881) = lu(k,881) - lu(k,603) * lu(k,870) - lu(k,882) = lu(k,882) - lu(k,604) * lu(k,870) - lu(k,883) = lu(k,883) - lu(k,605) * lu(k,870) - lu(k,884) = lu(k,884) - lu(k,606) * lu(k,870) - lu(k,885) = lu(k,885) - lu(k,607) * lu(k,870) - lu(k,887) = lu(k,887) - lu(k,608) * lu(k,870) - lu(k,889) = lu(k,889) - lu(k,609) * lu(k,870) - lu(k,892) = lu(k,892) - lu(k,610) * lu(k,870) - lu(k,894) = lu(k,894) - lu(k,611) * lu(k,870) - lu(k,897) = lu(k,897) - lu(k,612) * lu(k,870) - lu(k,898) = lu(k,898) - lu(k,613) * lu(k,870) - lu(k,899) = lu(k,899) - lu(k,614) * lu(k,870) - lu(k,900) = lu(k,900) - lu(k,615) * lu(k,870) - lu(k,915) = lu(k,915) - lu(k,598) * lu(k,913) - lu(k,917) = lu(k,917) - lu(k,599) * lu(k,913) - lu(k,920) = lu(k,920) - lu(k,600) * lu(k,913) - lu(k,921) = lu(k,921) - lu(k,601) * lu(k,913) - lu(k,922) = lu(k,922) - lu(k,602) * lu(k,913) - lu(k,924) = lu(k,924) - lu(k,603) * lu(k,913) - lu(k,925) = lu(k,925) - lu(k,604) * lu(k,913) - lu(k,926) = lu(k,926) - lu(k,605) * lu(k,913) - lu(k,927) = lu(k,927) - lu(k,606) * lu(k,913) - lu(k,928) = lu(k,928) - lu(k,607) * lu(k,913) - lu(k,930) = lu(k,930) - lu(k,608) * lu(k,913) - lu(k,932) = lu(k,932) - lu(k,609) * lu(k,913) - lu(k,935) = lu(k,935) - lu(k,610) * lu(k,913) - lu(k,937) = lu(k,937) - lu(k,611) * lu(k,913) - lu(k,940) = lu(k,940) - lu(k,612) * lu(k,913) - lu(k,941) = lu(k,941) - lu(k,613) * lu(k,913) - lu(k,942) = lu(k,942) - lu(k,614) * lu(k,913) - lu(k,943) = lu(k,943) - lu(k,615) * lu(k,913) - lu(k,971) = lu(k,971) - lu(k,598) * lu(k,969) - lu(k,973) = lu(k,973) - lu(k,599) * lu(k,969) - lu(k,976) = lu(k,976) - lu(k,600) * lu(k,969) - lu(k,977) = lu(k,977) - lu(k,601) * lu(k,969) - lu(k,978) = - lu(k,602) * lu(k,969) - lu(k,980) = lu(k,980) - lu(k,603) * lu(k,969) - lu(k,981) = - lu(k,604) * lu(k,969) - lu(k,982) = lu(k,982) - lu(k,605) * lu(k,969) - lu(k,983) = lu(k,983) - lu(k,606) * lu(k,969) - lu(k,984) = - lu(k,607) * lu(k,969) - lu(k,986) = lu(k,986) - lu(k,608) * lu(k,969) - lu(k,988) = lu(k,988) - lu(k,609) * lu(k,969) - lu(k,991) = lu(k,991) - lu(k,610) * lu(k,969) - lu(k,993) = - lu(k,611) * lu(k,969) - lu(k,996) = lu(k,996) - lu(k,612) * lu(k,969) - lu(k,997) = lu(k,997) - lu(k,613) * lu(k,969) - lu(k,998) = lu(k,998) - lu(k,614) * lu(k,969) - lu(k,999) = lu(k,999) - lu(k,615) * lu(k,969) - lu(k,1056) = lu(k,1056) - lu(k,598) * lu(k,1054) - lu(k,1058) = lu(k,1058) - lu(k,599) * lu(k,1054) - lu(k,1061) = lu(k,1061) - lu(k,600) * lu(k,1054) - lu(k,1062) = lu(k,1062) - lu(k,601) * lu(k,1054) - lu(k,1063) = lu(k,1063) - lu(k,602) * lu(k,1054) - lu(k,1065) = lu(k,1065) - lu(k,603) * lu(k,1054) - lu(k,1066) = lu(k,1066) - lu(k,604) * lu(k,1054) - lu(k,1067) = lu(k,1067) - lu(k,605) * lu(k,1054) - lu(k,1068) = lu(k,1068) - lu(k,606) * lu(k,1054) - lu(k,1069) = lu(k,1069) - lu(k,607) * lu(k,1054) - lu(k,1071) = lu(k,1071) - lu(k,608) * lu(k,1054) - lu(k,1073) = lu(k,1073) - lu(k,609) * lu(k,1054) - lu(k,1076) = lu(k,1076) - lu(k,610) * lu(k,1054) - lu(k,1078) = lu(k,1078) - lu(k,611) * lu(k,1054) - lu(k,1081) = lu(k,1081) - lu(k,612) * lu(k,1054) - lu(k,1082) = lu(k,1082) - lu(k,613) * lu(k,1054) - lu(k,1083) = lu(k,1083) - lu(k,614) * lu(k,1054) - lu(k,1084) = lu(k,1084) - lu(k,615) * lu(k,1054) - lu(k,1096) = lu(k,1096) - lu(k,598) * lu(k,1095) - lu(k,1098) = lu(k,1098) - lu(k,599) * lu(k,1095) - lu(k,1101) = lu(k,1101) - lu(k,600) * lu(k,1095) - lu(k,1102) = lu(k,1102) - lu(k,601) * lu(k,1095) - lu(k,1103) = lu(k,1103) - lu(k,602) * lu(k,1095) - lu(k,1105) = lu(k,1105) - lu(k,603) * lu(k,1095) - lu(k,1106) = lu(k,1106) - lu(k,604) * lu(k,1095) - lu(k,1107) = lu(k,1107) - lu(k,605) * lu(k,1095) - lu(k,1108) = lu(k,1108) - lu(k,606) * lu(k,1095) - lu(k,1109) = lu(k,1109) - lu(k,607) * lu(k,1095) - lu(k,1111) = lu(k,1111) - lu(k,608) * lu(k,1095) - lu(k,1113) = lu(k,1113) - lu(k,609) * lu(k,1095) - lu(k,1116) = lu(k,1116) - lu(k,610) * lu(k,1095) - lu(k,1118) = lu(k,1118) - lu(k,611) * lu(k,1095) - lu(k,1121) = lu(k,1121) - lu(k,612) * lu(k,1095) - lu(k,1122) = lu(k,1122) - lu(k,613) * lu(k,1095) - lu(k,1123) = lu(k,1123) - lu(k,614) * lu(k,1095) - lu(k,1124) = lu(k,1124) - lu(k,615) * lu(k,1095) - lu(k,1141) = lu(k,1141) - lu(k,598) * lu(k,1140) - lu(k,1143) = lu(k,1143) - lu(k,599) * lu(k,1140) - lu(k,1146) = lu(k,1146) - lu(k,600) * lu(k,1140) - lu(k,1147) = lu(k,1147) - lu(k,601) * lu(k,1140) - lu(k,1148) = lu(k,1148) - lu(k,602) * lu(k,1140) - lu(k,1150) = lu(k,1150) - lu(k,603) * lu(k,1140) - lu(k,1151) = lu(k,1151) - lu(k,604) * lu(k,1140) - lu(k,1152) = lu(k,1152) - lu(k,605) * lu(k,1140) - lu(k,1153) = lu(k,1153) - lu(k,606) * lu(k,1140) - lu(k,1154) = lu(k,1154) - lu(k,607) * lu(k,1140) - lu(k,1156) = lu(k,1156) - lu(k,608) * lu(k,1140) - lu(k,1158) = lu(k,1158) - lu(k,609) * lu(k,1140) - lu(k,1161) = lu(k,1161) - lu(k,610) * lu(k,1140) - lu(k,1163) = lu(k,1163) - lu(k,611) * lu(k,1140) - lu(k,1166) = lu(k,1166) - lu(k,612) * lu(k,1140) - lu(k,1167) = lu(k,1167) - lu(k,613) * lu(k,1140) - lu(k,1168) = lu(k,1168) - lu(k,614) * lu(k,1140) - lu(k,1169) = lu(k,1169) - lu(k,615) * lu(k,1140) - lu(k,1184) = lu(k,1184) - lu(k,598) * lu(k,1182) - lu(k,1186) = lu(k,1186) - lu(k,599) * lu(k,1182) - lu(k,1189) = lu(k,1189) - lu(k,600) * lu(k,1182) - lu(k,1190) = lu(k,1190) - lu(k,601) * lu(k,1182) - lu(k,1191) = lu(k,1191) - lu(k,602) * lu(k,1182) - lu(k,1193) = lu(k,1193) - lu(k,603) * lu(k,1182) - lu(k,1194) = lu(k,1194) - lu(k,604) * lu(k,1182) - lu(k,1195) = lu(k,1195) - lu(k,605) * lu(k,1182) - lu(k,1196) = lu(k,1196) - lu(k,606) * lu(k,1182) - lu(k,1197) = lu(k,1197) - lu(k,607) * lu(k,1182) - lu(k,1199) = lu(k,1199) - lu(k,608) * lu(k,1182) - lu(k,1201) = lu(k,1201) - lu(k,609) * lu(k,1182) - lu(k,1204) = lu(k,1204) - lu(k,610) * lu(k,1182) - lu(k,1206) = lu(k,1206) - lu(k,611) * lu(k,1182) - lu(k,1209) = lu(k,1209) - lu(k,612) * lu(k,1182) - lu(k,1210) = lu(k,1210) - lu(k,613) * lu(k,1182) - lu(k,1211) = lu(k,1211) - lu(k,614) * lu(k,1182) - lu(k,1212) = lu(k,1212) - lu(k,615) * lu(k,1182) - lu(k,1298) = lu(k,1298) - lu(k,598) * lu(k,1296) - lu(k,1300) = lu(k,1300) - lu(k,599) * lu(k,1296) - lu(k,1303) = lu(k,1303) - lu(k,600) * lu(k,1296) - lu(k,1304) = lu(k,1304) - lu(k,601) * lu(k,1296) - lu(k,1305) = lu(k,1305) - lu(k,602) * lu(k,1296) - lu(k,1307) = lu(k,1307) - lu(k,603) * lu(k,1296) - lu(k,1308) = lu(k,1308) - lu(k,604) * lu(k,1296) - lu(k,1309) = lu(k,1309) - lu(k,605) * lu(k,1296) - lu(k,1310) = lu(k,1310) - lu(k,606) * lu(k,1296) - lu(k,1311) = lu(k,1311) - lu(k,607) * lu(k,1296) - lu(k,1313) = lu(k,1313) - lu(k,608) * lu(k,1296) - lu(k,1315) = lu(k,1315) - lu(k,609) * lu(k,1296) - lu(k,1318) = lu(k,1318) - lu(k,610) * lu(k,1296) - lu(k,1320) = lu(k,1320) - lu(k,611) * lu(k,1296) - lu(k,1323) = lu(k,1323) - lu(k,612) * lu(k,1296) - lu(k,1324) = lu(k,1324) - lu(k,613) * lu(k,1296) - lu(k,1325) = lu(k,1325) - lu(k,614) * lu(k,1296) - lu(k,1326) = lu(k,1326) - lu(k,615) * lu(k,1296) - lu(k,1343) = lu(k,1343) - lu(k,598) * lu(k,1341) - lu(k,1345) = lu(k,1345) - lu(k,599) * lu(k,1341) - lu(k,1348) = lu(k,1348) - lu(k,600) * lu(k,1341) - lu(k,1349) = lu(k,1349) - lu(k,601) * lu(k,1341) - lu(k,1350) = lu(k,1350) - lu(k,602) * lu(k,1341) - lu(k,1352) = lu(k,1352) - lu(k,603) * lu(k,1341) - lu(k,1353) = lu(k,1353) - lu(k,604) * lu(k,1341) - lu(k,1354) = lu(k,1354) - lu(k,605) * lu(k,1341) - lu(k,1355) = lu(k,1355) - lu(k,606) * lu(k,1341) - lu(k,1356) = lu(k,1356) - lu(k,607) * lu(k,1341) - lu(k,1358) = lu(k,1358) - lu(k,608) * lu(k,1341) - lu(k,1360) = lu(k,1360) - lu(k,609) * lu(k,1341) - lu(k,1363) = lu(k,1363) - lu(k,610) * lu(k,1341) - lu(k,1365) = lu(k,1365) - lu(k,611) * lu(k,1341) - lu(k,1368) = lu(k,1368) - lu(k,612) * lu(k,1341) - lu(k,1369) = lu(k,1369) - lu(k,613) * lu(k,1341) - lu(k,1370) = lu(k,1370) - lu(k,614) * lu(k,1341) - lu(k,1371) = lu(k,1371) - lu(k,615) * lu(k,1341) - lu(k,1468) = lu(k,1468) - lu(k,598) * lu(k,1466) - lu(k,1470) = lu(k,1470) - lu(k,599) * lu(k,1466) - lu(k,1473) = lu(k,1473) - lu(k,600) * lu(k,1466) - lu(k,1474) = lu(k,1474) - lu(k,601) * lu(k,1466) - lu(k,1475) = lu(k,1475) - lu(k,602) * lu(k,1466) - lu(k,1477) = lu(k,1477) - lu(k,603) * lu(k,1466) - lu(k,1478) = lu(k,1478) - lu(k,604) * lu(k,1466) - lu(k,1479) = lu(k,1479) - lu(k,605) * lu(k,1466) - lu(k,1480) = lu(k,1480) - lu(k,606) * lu(k,1466) - lu(k,1481) = lu(k,1481) - lu(k,607) * lu(k,1466) - lu(k,1483) = lu(k,1483) - lu(k,608) * lu(k,1466) - lu(k,1485) = lu(k,1485) - lu(k,609) * lu(k,1466) - lu(k,1488) = lu(k,1488) - lu(k,610) * lu(k,1466) - lu(k,1490) = lu(k,1490) - lu(k,611) * lu(k,1466) - lu(k,1493) = lu(k,1493) - lu(k,612) * lu(k,1466) - lu(k,1494) = lu(k,1494) - lu(k,613) * lu(k,1466) - lu(k,1495) = lu(k,1495) - lu(k,614) * lu(k,1466) - lu(k,1496) = lu(k,1496) - lu(k,615) * lu(k,1466) - lu(k,1511) = - lu(k,598) * lu(k,1509) - lu(k,1513) = lu(k,1513) - lu(k,599) * lu(k,1509) - lu(k,1516) = lu(k,1516) - lu(k,600) * lu(k,1509) - lu(k,1517) = - lu(k,601) * lu(k,1509) - lu(k,1518) = - lu(k,602) * lu(k,1509) - lu(k,1520) = lu(k,1520) - lu(k,603) * lu(k,1509) - lu(k,1521) = - lu(k,604) * lu(k,1509) - lu(k,1522) = lu(k,1522) - lu(k,605) * lu(k,1509) - lu(k,1523) = lu(k,1523) - lu(k,606) * lu(k,1509) - lu(k,1524) = - lu(k,607) * lu(k,1509) - lu(k,1526) = lu(k,1526) - lu(k,608) * lu(k,1509) - lu(k,1528) = lu(k,1528) - lu(k,609) * lu(k,1509) - lu(k,1531) = lu(k,1531) - lu(k,610) * lu(k,1509) - lu(k,1533) = - lu(k,611) * lu(k,1509) - lu(k,1536) = lu(k,1536) - lu(k,612) * lu(k,1509) - lu(k,1537) = lu(k,1537) - lu(k,613) * lu(k,1509) - lu(k,1538) = lu(k,1538) - lu(k,614) * lu(k,1509) - lu(k,1539) = lu(k,1539) - lu(k,615) * lu(k,1509) - lu(k,1554) = lu(k,1554) - lu(k,598) * lu(k,1552) - lu(k,1556) = lu(k,1556) - lu(k,599) * lu(k,1552) - lu(k,1559) = lu(k,1559) - lu(k,600) * lu(k,1552) - lu(k,1560) = lu(k,1560) - lu(k,601) * lu(k,1552) - lu(k,1561) = lu(k,1561) - lu(k,602) * lu(k,1552) - lu(k,1563) = lu(k,1563) - lu(k,603) * lu(k,1552) - lu(k,1564) = lu(k,1564) - lu(k,604) * lu(k,1552) - lu(k,1565) = lu(k,1565) - lu(k,605) * lu(k,1552) - lu(k,1566) = lu(k,1566) - lu(k,606) * lu(k,1552) - lu(k,1567) = lu(k,1567) - lu(k,607) * lu(k,1552) - lu(k,1569) = lu(k,1569) - lu(k,608) * lu(k,1552) - lu(k,1571) = lu(k,1571) - lu(k,609) * lu(k,1552) - lu(k,1574) = lu(k,1574) - lu(k,610) * lu(k,1552) - lu(k,1576) = lu(k,1576) - lu(k,611) * lu(k,1552) - lu(k,1579) = lu(k,1579) - lu(k,612) * lu(k,1552) - lu(k,1580) = lu(k,1580) - lu(k,613) * lu(k,1552) - lu(k,1581) = lu(k,1581) - lu(k,614) * lu(k,1552) - lu(k,1582) = lu(k,1582) - lu(k,615) * lu(k,1552) - lu(k,1587) = lu(k,1587) - lu(k,598) * lu(k,1586) - lu(k,1589) = lu(k,1589) - lu(k,599) * lu(k,1586) - lu(k,1592) = lu(k,1592) - lu(k,600) * lu(k,1586) - lu(k,1593) = lu(k,1593) - lu(k,601) * lu(k,1586) - lu(k,1594) = lu(k,1594) - lu(k,602) * lu(k,1586) - lu(k,1596) = lu(k,1596) - lu(k,603) * lu(k,1586) - lu(k,1597) = lu(k,1597) - lu(k,604) * lu(k,1586) - lu(k,1598) = - lu(k,605) * lu(k,1586) - lu(k,1599) = lu(k,1599) - lu(k,606) * lu(k,1586) - lu(k,1600) = lu(k,1600) - lu(k,607) * lu(k,1586) - lu(k,1602) = lu(k,1602) - lu(k,608) * lu(k,1586) - lu(k,1604) = lu(k,1604) - lu(k,609) * lu(k,1586) - lu(k,1607) = lu(k,1607) - lu(k,610) * lu(k,1586) - lu(k,1609) = lu(k,1609) - lu(k,611) * lu(k,1586) - lu(k,1612) = lu(k,1612) - lu(k,612) * lu(k,1586) - lu(k,1613) = lu(k,1613) - lu(k,613) * lu(k,1586) - lu(k,1614) = lu(k,1614) - lu(k,614) * lu(k,1586) - lu(k,1615) = lu(k,1615) - lu(k,615) * lu(k,1586) - lu(k,1623) = lu(k,1623) - lu(k,598) * lu(k,1622) - lu(k,1625) = lu(k,1625) - lu(k,599) * lu(k,1622) - lu(k,1628) = lu(k,1628) - lu(k,600) * lu(k,1622) - lu(k,1629) = - lu(k,601) * lu(k,1622) - lu(k,1630) = - lu(k,602) * lu(k,1622) - lu(k,1632) = lu(k,1632) - lu(k,603) * lu(k,1622) - lu(k,1633) = - lu(k,604) * lu(k,1622) - lu(k,1634) = lu(k,1634) - lu(k,605) * lu(k,1622) - lu(k,1635) = lu(k,1635) - lu(k,606) * lu(k,1622) - lu(k,1636) = - lu(k,607) * lu(k,1622) - lu(k,1638) = lu(k,1638) - lu(k,608) * lu(k,1622) - lu(k,1640) = lu(k,1640) - lu(k,609) * lu(k,1622) - lu(k,1643) = lu(k,1643) - lu(k,610) * lu(k,1622) - lu(k,1645) = - lu(k,611) * lu(k,1622) - lu(k,1648) = lu(k,1648) - lu(k,612) * lu(k,1622) - lu(k,1649) = lu(k,1649) - lu(k,613) * lu(k,1622) - lu(k,1650) = lu(k,1650) - lu(k,614) * lu(k,1622) - lu(k,1651) = lu(k,1651) - lu(k,615) * lu(k,1622) - lu(k,1666) = - lu(k,598) * lu(k,1664) - lu(k,1668) = lu(k,1668) - lu(k,599) * lu(k,1664) - lu(k,1671) = lu(k,1671) - lu(k,600) * lu(k,1664) - lu(k,1672) = - lu(k,601) * lu(k,1664) - lu(k,1673) = - lu(k,602) * lu(k,1664) - lu(k,1675) = lu(k,1675) - lu(k,603) * lu(k,1664) - lu(k,1676) = - lu(k,604) * lu(k,1664) - lu(k,1677) = lu(k,1677) - lu(k,605) * lu(k,1664) - lu(k,1678) = lu(k,1678) - lu(k,606) * lu(k,1664) - lu(k,1679) = - lu(k,607) * lu(k,1664) - lu(k,1681) = lu(k,1681) - lu(k,608) * lu(k,1664) - lu(k,1683) = lu(k,1683) - lu(k,609) * lu(k,1664) - lu(k,1686) = lu(k,1686) - lu(k,610) * lu(k,1664) - lu(k,1688) = - lu(k,611) * lu(k,1664) - lu(k,1691) = lu(k,1691) - lu(k,612) * lu(k,1664) - lu(k,1692) = lu(k,1692) - lu(k,613) * lu(k,1664) - lu(k,1693) = lu(k,1693) - lu(k,614) * lu(k,1664) - lu(k,1694) = lu(k,1694) - lu(k,615) * lu(k,1664) - lu(k,1702) = lu(k,1702) - lu(k,598) * lu(k,1700) - lu(k,1704) = lu(k,1704) - lu(k,599) * lu(k,1700) - lu(k,1707) = lu(k,1707) - lu(k,600) * lu(k,1700) - lu(k,1708) = - lu(k,601) * lu(k,1700) - lu(k,1709) = - lu(k,602) * lu(k,1700) - lu(k,1711) = lu(k,1711) - lu(k,603) * lu(k,1700) - lu(k,1712) = lu(k,1712) - lu(k,604) * lu(k,1700) - lu(k,1713) = lu(k,1713) - lu(k,605) * lu(k,1700) - lu(k,1714) = lu(k,1714) - lu(k,606) * lu(k,1700) - lu(k,1715) = - lu(k,607) * lu(k,1700) - lu(k,1717) = lu(k,1717) - lu(k,608) * lu(k,1700) - lu(k,1719) = lu(k,1719) - lu(k,609) * lu(k,1700) - lu(k,1722) = lu(k,1722) - lu(k,610) * lu(k,1700) - lu(k,1724) = - lu(k,611) * lu(k,1700) - lu(k,1727) = lu(k,1727) - lu(k,612) * lu(k,1700) - lu(k,1728) = lu(k,1728) - lu(k,613) * lu(k,1700) - lu(k,1729) = lu(k,1729) - lu(k,614) * lu(k,1700) - lu(k,1730) = lu(k,1730) - lu(k,615) * lu(k,1700) - lu(k,1744) = lu(k,1744) - lu(k,598) * lu(k,1743) - lu(k,1746) = lu(k,1746) - lu(k,599) * lu(k,1743) - lu(k,1749) = lu(k,1749) - lu(k,600) * lu(k,1743) - lu(k,1750) = lu(k,1750) - lu(k,601) * lu(k,1743) - lu(k,1751) = lu(k,1751) - lu(k,602) * lu(k,1743) - lu(k,1753) = lu(k,1753) - lu(k,603) * lu(k,1743) - lu(k,1754) = lu(k,1754) - lu(k,604) * lu(k,1743) - lu(k,1755) = lu(k,1755) - lu(k,605) * lu(k,1743) - lu(k,1756) = lu(k,1756) - lu(k,606) * lu(k,1743) - lu(k,1757) = lu(k,1757) - lu(k,607) * lu(k,1743) - lu(k,1759) = lu(k,1759) - lu(k,608) * lu(k,1743) - lu(k,1761) = lu(k,1761) - lu(k,609) * lu(k,1743) - lu(k,1764) = lu(k,1764) - lu(k,610) * lu(k,1743) - lu(k,1766) = lu(k,1766) - lu(k,611) * lu(k,1743) - lu(k,1769) = lu(k,1769) - lu(k,612) * lu(k,1743) - lu(k,1770) = lu(k,1770) - lu(k,613) * lu(k,1743) - lu(k,1771) = lu(k,1771) - lu(k,614) * lu(k,1743) - lu(k,1772) = lu(k,1772) - lu(k,615) * lu(k,1743) - lu(k,1797) = lu(k,1797) - lu(k,598) * lu(k,1796) - lu(k,1799) = lu(k,1799) - lu(k,599) * lu(k,1796) - lu(k,1802) = lu(k,1802) - lu(k,600) * lu(k,1796) - lu(k,1803) = lu(k,1803) - lu(k,601) * lu(k,1796) - lu(k,1804) = lu(k,1804) - lu(k,602) * lu(k,1796) - lu(k,1806) = lu(k,1806) - lu(k,603) * lu(k,1796) - lu(k,1807) = lu(k,1807) - lu(k,604) * lu(k,1796) - lu(k,1808) = lu(k,1808) - lu(k,605) * lu(k,1796) - lu(k,1809) = lu(k,1809) - lu(k,606) * lu(k,1796) - lu(k,1810) = lu(k,1810) - lu(k,607) * lu(k,1796) - lu(k,1812) = lu(k,1812) - lu(k,608) * lu(k,1796) - lu(k,1814) = lu(k,1814) - lu(k,609) * lu(k,1796) - lu(k,1817) = lu(k,1817) - lu(k,610) * lu(k,1796) - lu(k,1819) = lu(k,1819) - lu(k,611) * lu(k,1796) - lu(k,1822) = lu(k,1822) - lu(k,612) * lu(k,1796) - lu(k,1823) = lu(k,1823) - lu(k,613) * lu(k,1796) - lu(k,1824) = lu(k,1824) - lu(k,614) * lu(k,1796) - lu(k,1825) = lu(k,1825) - lu(k,615) * lu(k,1796) - lu(k,619) = 1._r8 / lu(k,619) - lu(k,620) = lu(k,620) * lu(k,619) - lu(k,621) = lu(k,621) * lu(k,619) - lu(k,622) = lu(k,622) * lu(k,619) - lu(k,623) = lu(k,623) * lu(k,619) - lu(k,624) = lu(k,624) * lu(k,619) - lu(k,625) = lu(k,625) * lu(k,619) - lu(k,626) = lu(k,626) * lu(k,619) - lu(k,627) = lu(k,627) * lu(k,619) - lu(k,628) = lu(k,628) * lu(k,619) - lu(k,629) = lu(k,629) * lu(k,619) - lu(k,630) = lu(k,630) * lu(k,619) - lu(k,631) = lu(k,631) * lu(k,619) - lu(k,632) = lu(k,632) * lu(k,619) - lu(k,633) = lu(k,633) * lu(k,619) - lu(k,634) = lu(k,634) * lu(k,619) - lu(k,635) = lu(k,635) * lu(k,619) - lu(k,636) = lu(k,636) * lu(k,619) - lu(k,637) = lu(k,637) * lu(k,619) - lu(k,638) = lu(k,638) * lu(k,619) - lu(k,639) = lu(k,639) * lu(k,619) - lu(k,640) = lu(k,640) * lu(k,619) - lu(k,641) = lu(k,641) * lu(k,619) - lu(k,642) = lu(k,642) * lu(k,619) - lu(k,643) = lu(k,643) * lu(k,619) - lu(k,644) = lu(k,644) * lu(k,619) - lu(k,645) = lu(k,645) * lu(k,619) - lu(k,646) = lu(k,646) * lu(k,619) - lu(k,647) = lu(k,647) * lu(k,619) - lu(k,824) = lu(k,824) - lu(k,620) * lu(k,823) - lu(k,825) = - lu(k,621) * lu(k,823) - lu(k,826) = lu(k,826) - lu(k,622) * lu(k,823) - lu(k,827) = lu(k,827) - lu(k,623) * lu(k,823) - lu(k,828) = lu(k,828) - lu(k,624) * lu(k,823) - lu(k,829) = lu(k,829) - lu(k,625) * lu(k,823) - lu(k,830) = lu(k,830) - lu(k,626) * lu(k,823) - lu(k,831) = lu(k,831) - lu(k,627) * lu(k,823) - lu(k,832) = lu(k,832) - lu(k,628) * lu(k,823) - lu(k,833) = lu(k,833) - lu(k,629) * lu(k,823) - lu(k,834) = lu(k,834) - lu(k,630) * lu(k,823) - lu(k,835) = lu(k,835) - lu(k,631) * lu(k,823) - lu(k,836) = lu(k,836) - lu(k,632) * lu(k,823) - lu(k,837) = lu(k,837) - lu(k,633) * lu(k,823) - lu(k,839) = lu(k,839) - lu(k,634) * lu(k,823) - lu(k,840) = lu(k,840) - lu(k,635) * lu(k,823) - lu(k,841) = lu(k,841) - lu(k,636) * lu(k,823) - lu(k,842) = lu(k,842) - lu(k,637) * lu(k,823) - lu(k,843) = - lu(k,638) * lu(k,823) - lu(k,844) = lu(k,844) - lu(k,639) * lu(k,823) - lu(k,845) = - lu(k,640) * lu(k,823) - lu(k,846) = lu(k,846) - lu(k,641) * lu(k,823) - lu(k,847) = - lu(k,642) * lu(k,823) - lu(k,848) = - lu(k,643) * lu(k,823) - lu(k,849) = lu(k,849) - lu(k,644) * lu(k,823) - lu(k,850) = lu(k,850) - lu(k,645) * lu(k,823) - lu(k,851) = lu(k,851) - lu(k,646) * lu(k,823) - lu(k,852) = lu(k,852) - lu(k,647) * lu(k,823) - lu(k,872) = lu(k,872) - lu(k,620) * lu(k,871) - lu(k,873) = lu(k,873) - lu(k,621) * lu(k,871) - lu(k,874) = lu(k,874) - lu(k,622) * lu(k,871) - lu(k,875) = lu(k,875) - lu(k,623) * lu(k,871) - lu(k,876) = lu(k,876) - lu(k,624) * lu(k,871) - lu(k,877) = lu(k,877) - lu(k,625) * lu(k,871) - lu(k,878) = lu(k,878) - lu(k,626) * lu(k,871) - lu(k,879) = lu(k,879) - lu(k,627) * lu(k,871) - lu(k,880) = lu(k,880) - lu(k,628) * lu(k,871) - lu(k,881) = lu(k,881) - lu(k,629) * lu(k,871) - lu(k,882) = lu(k,882) - lu(k,630) * lu(k,871) - lu(k,883) = lu(k,883) - lu(k,631) * lu(k,871) - lu(k,884) = lu(k,884) - lu(k,632) * lu(k,871) - lu(k,885) = lu(k,885) - lu(k,633) * lu(k,871) - lu(k,887) = lu(k,887) - lu(k,634) * lu(k,871) - lu(k,888) = lu(k,888) - lu(k,635) * lu(k,871) - lu(k,889) = lu(k,889) - lu(k,636) * lu(k,871) - lu(k,890) = lu(k,890) - lu(k,637) * lu(k,871) - lu(k,891) = lu(k,891) - lu(k,638) * lu(k,871) - lu(k,892) = lu(k,892) - lu(k,639) * lu(k,871) - lu(k,893) = lu(k,893) - lu(k,640) * lu(k,871) - lu(k,894) = lu(k,894) - lu(k,641) * lu(k,871) - lu(k,895) = lu(k,895) - lu(k,642) * lu(k,871) - lu(k,896) = lu(k,896) - lu(k,643) * lu(k,871) - lu(k,897) = lu(k,897) - lu(k,644) * lu(k,871) - lu(k,898) = lu(k,898) - lu(k,645) * lu(k,871) - lu(k,899) = lu(k,899) - lu(k,646) * lu(k,871) - lu(k,900) = lu(k,900) - lu(k,647) * lu(k,871) - lu(k,915) = lu(k,915) - lu(k,620) * lu(k,914) - lu(k,916) = - lu(k,621) * lu(k,914) - lu(k,917) = lu(k,917) - lu(k,622) * lu(k,914) - lu(k,918) = lu(k,918) - lu(k,623) * lu(k,914) - lu(k,919) = lu(k,919) - lu(k,624) * lu(k,914) - lu(k,920) = lu(k,920) - lu(k,625) * lu(k,914) - lu(k,921) = lu(k,921) - lu(k,626) * lu(k,914) - lu(k,922) = lu(k,922) - lu(k,627) * lu(k,914) - lu(k,923) = lu(k,923) - lu(k,628) * lu(k,914) - lu(k,924) = lu(k,924) - lu(k,629) * lu(k,914) - lu(k,925) = lu(k,925) - lu(k,630) * lu(k,914) - lu(k,926) = lu(k,926) - lu(k,631) * lu(k,914) - lu(k,927) = lu(k,927) - lu(k,632) * lu(k,914) - lu(k,928) = lu(k,928) - lu(k,633) * lu(k,914) - lu(k,930) = lu(k,930) - lu(k,634) * lu(k,914) - lu(k,931) = lu(k,931) - lu(k,635) * lu(k,914) - lu(k,932) = lu(k,932) - lu(k,636) * lu(k,914) - lu(k,933) = lu(k,933) - lu(k,637) * lu(k,914) - lu(k,934) = - lu(k,638) * lu(k,914) - lu(k,935) = lu(k,935) - lu(k,639) * lu(k,914) - lu(k,936) = - lu(k,640) * lu(k,914) - lu(k,937) = lu(k,937) - lu(k,641) * lu(k,914) - lu(k,938) = - lu(k,642) * lu(k,914) - lu(k,939) = - lu(k,643) * lu(k,914) - lu(k,940) = lu(k,940) - lu(k,644) * lu(k,914) - lu(k,941) = lu(k,941) - lu(k,645) * lu(k,914) - lu(k,942) = lu(k,942) - lu(k,646) * lu(k,914) - lu(k,943) = lu(k,943) - lu(k,647) * lu(k,914) - lu(k,971) = lu(k,971) - lu(k,620) * lu(k,970) - lu(k,972) = lu(k,972) - lu(k,621) * lu(k,970) - lu(k,973) = lu(k,973) - lu(k,622) * lu(k,970) - lu(k,974) = lu(k,974) - lu(k,623) * lu(k,970) - lu(k,975) = lu(k,975) - lu(k,624) * lu(k,970) - lu(k,976) = lu(k,976) - lu(k,625) * lu(k,970) - lu(k,977) = lu(k,977) - lu(k,626) * lu(k,970) - lu(k,978) = lu(k,978) - lu(k,627) * lu(k,970) - lu(k,979) = lu(k,979) - lu(k,628) * lu(k,970) - lu(k,980) = lu(k,980) - lu(k,629) * lu(k,970) - lu(k,981) = lu(k,981) - lu(k,630) * lu(k,970) - lu(k,982) = lu(k,982) - lu(k,631) * lu(k,970) - lu(k,983) = lu(k,983) - lu(k,632) * lu(k,970) - lu(k,984) = lu(k,984) - lu(k,633) * lu(k,970) - lu(k,986) = lu(k,986) - lu(k,634) * lu(k,970) - lu(k,987) = lu(k,987) - lu(k,635) * lu(k,970) - lu(k,988) = lu(k,988) - lu(k,636) * lu(k,970) - lu(k,989) = lu(k,989) - lu(k,637) * lu(k,970) - lu(k,990) = lu(k,990) - lu(k,638) * lu(k,970) - lu(k,991) = lu(k,991) - lu(k,639) * lu(k,970) - lu(k,992) = lu(k,992) - lu(k,640) * lu(k,970) - lu(k,993) = lu(k,993) - lu(k,641) * lu(k,970) - lu(k,994) = lu(k,994) - lu(k,642) * lu(k,970) - lu(k,995) = lu(k,995) - lu(k,643) * lu(k,970) - lu(k,996) = lu(k,996) - lu(k,644) * lu(k,970) - lu(k,997) = lu(k,997) - lu(k,645) * lu(k,970) - lu(k,998) = lu(k,998) - lu(k,646) * lu(k,970) - lu(k,999) = lu(k,999) - lu(k,647) * lu(k,970) - lu(k,1056) = lu(k,1056) - lu(k,620) * lu(k,1055) - lu(k,1057) = lu(k,1057) - lu(k,621) * lu(k,1055) - lu(k,1058) = lu(k,1058) - lu(k,622) * lu(k,1055) - lu(k,1059) = lu(k,1059) - lu(k,623) * lu(k,1055) - lu(k,1060) = lu(k,1060) - lu(k,624) * lu(k,1055) - lu(k,1061) = lu(k,1061) - lu(k,625) * lu(k,1055) - lu(k,1062) = lu(k,1062) - lu(k,626) * lu(k,1055) - lu(k,1063) = lu(k,1063) - lu(k,627) * lu(k,1055) - lu(k,1064) = lu(k,1064) - lu(k,628) * lu(k,1055) - lu(k,1065) = lu(k,1065) - lu(k,629) * lu(k,1055) - lu(k,1066) = lu(k,1066) - lu(k,630) * lu(k,1055) - lu(k,1067) = lu(k,1067) - lu(k,631) * lu(k,1055) - lu(k,1068) = lu(k,1068) - lu(k,632) * lu(k,1055) - lu(k,1069) = lu(k,1069) - lu(k,633) * lu(k,1055) - lu(k,1071) = lu(k,1071) - lu(k,634) * lu(k,1055) - lu(k,1072) = lu(k,1072) - lu(k,635) * lu(k,1055) - lu(k,1073) = lu(k,1073) - lu(k,636) * lu(k,1055) - lu(k,1074) = lu(k,1074) - lu(k,637) * lu(k,1055) - lu(k,1075) = - lu(k,638) * lu(k,1055) - lu(k,1076) = lu(k,1076) - lu(k,639) * lu(k,1055) - lu(k,1077) = - lu(k,640) * lu(k,1055) - lu(k,1078) = lu(k,1078) - lu(k,641) * lu(k,1055) - lu(k,1079) = - lu(k,642) * lu(k,1055) - lu(k,1080) = - lu(k,643) * lu(k,1055) - lu(k,1081) = lu(k,1081) - lu(k,644) * lu(k,1055) - lu(k,1082) = lu(k,1082) - lu(k,645) * lu(k,1055) - lu(k,1083) = lu(k,1083) - lu(k,646) * lu(k,1055) - lu(k,1084) = lu(k,1084) - lu(k,647) * lu(k,1055) - lu(k,1184) = lu(k,1184) - lu(k,620) * lu(k,1183) - lu(k,1185) = - lu(k,621) * lu(k,1183) - lu(k,1186) = lu(k,1186) - lu(k,622) * lu(k,1183) - lu(k,1187) = lu(k,1187) - lu(k,623) * lu(k,1183) - lu(k,1188) = lu(k,1188) - lu(k,624) * lu(k,1183) - lu(k,1189) = lu(k,1189) - lu(k,625) * lu(k,1183) - lu(k,1190) = lu(k,1190) - lu(k,626) * lu(k,1183) - lu(k,1191) = lu(k,1191) - lu(k,627) * lu(k,1183) - lu(k,1192) = lu(k,1192) - lu(k,628) * lu(k,1183) - lu(k,1193) = lu(k,1193) - lu(k,629) * lu(k,1183) - lu(k,1194) = lu(k,1194) - lu(k,630) * lu(k,1183) - lu(k,1195) = lu(k,1195) - lu(k,631) * lu(k,1183) - lu(k,1196) = lu(k,1196) - lu(k,632) * lu(k,1183) - lu(k,1197) = lu(k,1197) - lu(k,633) * lu(k,1183) - lu(k,1199) = lu(k,1199) - lu(k,634) * lu(k,1183) - lu(k,1200) = lu(k,1200) - lu(k,635) * lu(k,1183) - lu(k,1201) = lu(k,1201) - lu(k,636) * lu(k,1183) - lu(k,1202) = lu(k,1202) - lu(k,637) * lu(k,1183) - lu(k,1203) = - lu(k,638) * lu(k,1183) - lu(k,1204) = lu(k,1204) - lu(k,639) * lu(k,1183) - lu(k,1205) = - lu(k,640) * lu(k,1183) - lu(k,1206) = lu(k,1206) - lu(k,641) * lu(k,1183) - lu(k,1207) = - lu(k,642) * lu(k,1183) - lu(k,1208) = - lu(k,643) * lu(k,1183) - lu(k,1209) = lu(k,1209) - lu(k,644) * lu(k,1183) - lu(k,1210) = lu(k,1210) - lu(k,645) * lu(k,1183) - lu(k,1211) = lu(k,1211) - lu(k,646) * lu(k,1183) - lu(k,1212) = lu(k,1212) - lu(k,647) * lu(k,1183) - lu(k,1262) = lu(k,1262) - lu(k,620) * lu(k,1261) - lu(k,1263) = lu(k,1263) - lu(k,621) * lu(k,1261) - lu(k,1264) = lu(k,1264) - lu(k,622) * lu(k,1261) - lu(k,1265) = lu(k,1265) - lu(k,623) * lu(k,1261) - lu(k,1266) = lu(k,1266) - lu(k,624) * lu(k,1261) - lu(k,1267) = lu(k,1267) - lu(k,625) * lu(k,1261) - lu(k,1268) = lu(k,1268) - lu(k,626) * lu(k,1261) - lu(k,1269) = - lu(k,627) * lu(k,1261) - lu(k,1270) = lu(k,1270) - lu(k,628) * lu(k,1261) - lu(k,1271) = lu(k,1271) - lu(k,629) * lu(k,1261) - lu(k,1272) = - lu(k,630) * lu(k,1261) - lu(k,1273) = lu(k,1273) - lu(k,631) * lu(k,1261) - lu(k,1274) = lu(k,1274) - lu(k,632) * lu(k,1261) - lu(k,1275) = - lu(k,633) * lu(k,1261) - lu(k,1277) = lu(k,1277) - lu(k,634) * lu(k,1261) - lu(k,1278) = lu(k,1278) - lu(k,635) * lu(k,1261) - lu(k,1279) = lu(k,1279) - lu(k,636) * lu(k,1261) - lu(k,1280) = lu(k,1280) - lu(k,637) * lu(k,1261) - lu(k,1281) = lu(k,1281) - lu(k,638) * lu(k,1261) - lu(k,1282) = lu(k,1282) - lu(k,639) * lu(k,1261) - lu(k,1283) = lu(k,1283) - lu(k,640) * lu(k,1261) - lu(k,1284) = - lu(k,641) * lu(k,1261) - lu(k,1285) = lu(k,1285) - lu(k,642) * lu(k,1261) - lu(k,1286) = lu(k,1286) - lu(k,643) * lu(k,1261) - lu(k,1287) = lu(k,1287) - lu(k,644) * lu(k,1261) - lu(k,1288) = lu(k,1288) - lu(k,645) * lu(k,1261) - lu(k,1289) = lu(k,1289) - lu(k,646) * lu(k,1261) - lu(k,1290) = lu(k,1290) - lu(k,647) * lu(k,1261) - lu(k,1298) = lu(k,1298) - lu(k,620) * lu(k,1297) - lu(k,1299) = lu(k,1299) - lu(k,621) * lu(k,1297) - lu(k,1300) = lu(k,1300) - lu(k,622) * lu(k,1297) - lu(k,1301) = lu(k,1301) - lu(k,623) * lu(k,1297) - lu(k,1302) = lu(k,1302) - lu(k,624) * lu(k,1297) - lu(k,1303) = lu(k,1303) - lu(k,625) * lu(k,1297) - lu(k,1304) = lu(k,1304) - lu(k,626) * lu(k,1297) - lu(k,1305) = lu(k,1305) - lu(k,627) * lu(k,1297) - lu(k,1306) = lu(k,1306) - lu(k,628) * lu(k,1297) - lu(k,1307) = lu(k,1307) - lu(k,629) * lu(k,1297) - lu(k,1308) = lu(k,1308) - lu(k,630) * lu(k,1297) - lu(k,1309) = lu(k,1309) - lu(k,631) * lu(k,1297) - lu(k,1310) = lu(k,1310) - lu(k,632) * lu(k,1297) - lu(k,1311) = lu(k,1311) - lu(k,633) * lu(k,1297) - lu(k,1313) = lu(k,1313) - lu(k,634) * lu(k,1297) - lu(k,1314) = lu(k,1314) - lu(k,635) * lu(k,1297) - lu(k,1315) = lu(k,1315) - lu(k,636) * lu(k,1297) - lu(k,1316) = lu(k,1316) - lu(k,637) * lu(k,1297) - lu(k,1317) = lu(k,1317) - lu(k,638) * lu(k,1297) - lu(k,1318) = lu(k,1318) - lu(k,639) * lu(k,1297) - lu(k,1319) = lu(k,1319) - lu(k,640) * lu(k,1297) - lu(k,1320) = lu(k,1320) - lu(k,641) * lu(k,1297) - lu(k,1321) = lu(k,1321) - lu(k,642) * lu(k,1297) - lu(k,1322) = lu(k,1322) - lu(k,643) * lu(k,1297) - lu(k,1323) = lu(k,1323) - lu(k,644) * lu(k,1297) - lu(k,1324) = lu(k,1324) - lu(k,645) * lu(k,1297) - lu(k,1325) = lu(k,1325) - lu(k,646) * lu(k,1297) - lu(k,1326) = lu(k,1326) - lu(k,647) * lu(k,1297) - lu(k,1343) = lu(k,1343) - lu(k,620) * lu(k,1342) - lu(k,1344) = lu(k,1344) - lu(k,621) * lu(k,1342) - lu(k,1345) = lu(k,1345) - lu(k,622) * lu(k,1342) - lu(k,1346) = lu(k,1346) - lu(k,623) * lu(k,1342) - lu(k,1347) = lu(k,1347) - lu(k,624) * lu(k,1342) - lu(k,1348) = lu(k,1348) - lu(k,625) * lu(k,1342) - lu(k,1349) = lu(k,1349) - lu(k,626) * lu(k,1342) - lu(k,1350) = lu(k,1350) - lu(k,627) * lu(k,1342) - lu(k,1351) = lu(k,1351) - lu(k,628) * lu(k,1342) - lu(k,1352) = lu(k,1352) - lu(k,629) * lu(k,1342) - lu(k,1353) = lu(k,1353) - lu(k,630) * lu(k,1342) - lu(k,1354) = lu(k,1354) - lu(k,631) * lu(k,1342) - lu(k,1355) = lu(k,1355) - lu(k,632) * lu(k,1342) - lu(k,1356) = lu(k,1356) - lu(k,633) * lu(k,1342) - lu(k,1358) = lu(k,1358) - lu(k,634) * lu(k,1342) - lu(k,1359) = lu(k,1359) - lu(k,635) * lu(k,1342) - lu(k,1360) = lu(k,1360) - lu(k,636) * lu(k,1342) - lu(k,1361) = lu(k,1361) - lu(k,637) * lu(k,1342) - lu(k,1362) = lu(k,1362) - lu(k,638) * lu(k,1342) - lu(k,1363) = lu(k,1363) - lu(k,639) * lu(k,1342) - lu(k,1364) = lu(k,1364) - lu(k,640) * lu(k,1342) - lu(k,1365) = lu(k,1365) - lu(k,641) * lu(k,1342) - lu(k,1366) = lu(k,1366) - lu(k,642) * lu(k,1342) - lu(k,1367) = lu(k,1367) - lu(k,643) * lu(k,1342) - lu(k,1368) = lu(k,1368) - lu(k,644) * lu(k,1342) - lu(k,1369) = lu(k,1369) - lu(k,645) * lu(k,1342) - lu(k,1370) = lu(k,1370) - lu(k,646) * lu(k,1342) - lu(k,1371) = lu(k,1371) - lu(k,647) * lu(k,1342) - lu(k,1385) = lu(k,1385) - lu(k,620) * lu(k,1384) - lu(k,1386) = lu(k,1386) - lu(k,621) * lu(k,1384) - lu(k,1387) = lu(k,1387) - lu(k,622) * lu(k,1384) - lu(k,1388) = lu(k,1388) - lu(k,623) * lu(k,1384) - lu(k,1389) = lu(k,1389) - lu(k,624) * lu(k,1384) - lu(k,1390) = lu(k,1390) - lu(k,625) * lu(k,1384) - lu(k,1391) = lu(k,1391) - lu(k,626) * lu(k,1384) - lu(k,1392) = lu(k,1392) - lu(k,627) * lu(k,1384) - lu(k,1393) = lu(k,1393) - lu(k,628) * lu(k,1384) - lu(k,1394) = lu(k,1394) - lu(k,629) * lu(k,1384) - lu(k,1395) = lu(k,1395) - lu(k,630) * lu(k,1384) - lu(k,1396) = lu(k,1396) - lu(k,631) * lu(k,1384) - lu(k,1397) = lu(k,1397) - lu(k,632) * lu(k,1384) - lu(k,1398) = lu(k,1398) - lu(k,633) * lu(k,1384) - lu(k,1400) = lu(k,1400) - lu(k,634) * lu(k,1384) - lu(k,1401) = lu(k,1401) - lu(k,635) * lu(k,1384) - lu(k,1402) = lu(k,1402) - lu(k,636) * lu(k,1384) - lu(k,1403) = lu(k,1403) - lu(k,637) * lu(k,1384) - lu(k,1404) = lu(k,1404) - lu(k,638) * lu(k,1384) - lu(k,1405) = lu(k,1405) - lu(k,639) * lu(k,1384) - lu(k,1406) = lu(k,1406) - lu(k,640) * lu(k,1384) - lu(k,1407) = lu(k,1407) - lu(k,641) * lu(k,1384) - lu(k,1408) = lu(k,1408) - lu(k,642) * lu(k,1384) - lu(k,1409) = lu(k,1409) - lu(k,643) * lu(k,1384) - lu(k,1410) = lu(k,1410) - lu(k,644) * lu(k,1384) - lu(k,1411) = lu(k,1411) - lu(k,645) * lu(k,1384) - lu(k,1412) = lu(k,1412) - lu(k,646) * lu(k,1384) - lu(k,1413) = lu(k,1413) - lu(k,647) * lu(k,1384) - lu(k,1423) = lu(k,1423) - lu(k,620) * lu(k,1422) - lu(k,1424) = lu(k,1424) - lu(k,621) * lu(k,1422) - lu(k,1425) = lu(k,1425) - lu(k,622) * lu(k,1422) - lu(k,1426) = lu(k,1426) - lu(k,623) * lu(k,1422) - lu(k,1427) = lu(k,1427) - lu(k,624) * lu(k,1422) - lu(k,1428) = lu(k,1428) - lu(k,625) * lu(k,1422) - lu(k,1429) = - lu(k,626) * lu(k,1422) - lu(k,1430) = - lu(k,627) * lu(k,1422) - lu(k,1431) = lu(k,1431) - lu(k,628) * lu(k,1422) - lu(k,1432) = lu(k,1432) - lu(k,629) * lu(k,1422) - lu(k,1433) = - lu(k,630) * lu(k,1422) - lu(k,1434) = lu(k,1434) - lu(k,631) * lu(k,1422) - lu(k,1435) = lu(k,1435) - lu(k,632) * lu(k,1422) - lu(k,1436) = - lu(k,633) * lu(k,1422) - lu(k,1438) = lu(k,1438) - lu(k,634) * lu(k,1422) - lu(k,1439) = lu(k,1439) - lu(k,635) * lu(k,1422) - lu(k,1440) = lu(k,1440) - lu(k,636) * lu(k,1422) - lu(k,1441) = lu(k,1441) - lu(k,637) * lu(k,1422) - lu(k,1442) = lu(k,1442) - lu(k,638) * lu(k,1422) - lu(k,1443) = lu(k,1443) - lu(k,639) * lu(k,1422) - lu(k,1444) = lu(k,1444) - lu(k,640) * lu(k,1422) - lu(k,1445) = - lu(k,641) * lu(k,1422) - lu(k,1446) = lu(k,1446) - lu(k,642) * lu(k,1422) - lu(k,1447) = lu(k,1447) - lu(k,643) * lu(k,1422) - lu(k,1448) = lu(k,1448) - lu(k,644) * lu(k,1422) - lu(k,1449) = lu(k,1449) - lu(k,645) * lu(k,1422) - lu(k,1450) = lu(k,1450) - lu(k,646) * lu(k,1422) - lu(k,1451) = lu(k,1451) - lu(k,647) * lu(k,1422) - lu(k,1468) = lu(k,1468) - lu(k,620) * lu(k,1467) - lu(k,1469) = lu(k,1469) - lu(k,621) * lu(k,1467) - lu(k,1470) = lu(k,1470) - lu(k,622) * lu(k,1467) - lu(k,1471) = lu(k,1471) - lu(k,623) * lu(k,1467) - lu(k,1472) = - lu(k,624) * lu(k,1467) - lu(k,1473) = lu(k,1473) - lu(k,625) * lu(k,1467) - lu(k,1474) = lu(k,1474) - lu(k,626) * lu(k,1467) - lu(k,1475) = lu(k,1475) - lu(k,627) * lu(k,1467) - lu(k,1476) = lu(k,1476) - lu(k,628) * lu(k,1467) - lu(k,1477) = lu(k,1477) - lu(k,629) * lu(k,1467) - lu(k,1478) = lu(k,1478) - lu(k,630) * lu(k,1467) - lu(k,1479) = lu(k,1479) - lu(k,631) * lu(k,1467) - lu(k,1480) = lu(k,1480) - lu(k,632) * lu(k,1467) - lu(k,1481) = lu(k,1481) - lu(k,633) * lu(k,1467) - lu(k,1483) = lu(k,1483) - lu(k,634) * lu(k,1467) - lu(k,1484) = lu(k,1484) - lu(k,635) * lu(k,1467) - lu(k,1485) = lu(k,1485) - lu(k,636) * lu(k,1467) - lu(k,1486) = lu(k,1486) - lu(k,637) * lu(k,1467) - lu(k,1487) = lu(k,1487) - lu(k,638) * lu(k,1467) - lu(k,1488) = lu(k,1488) - lu(k,639) * lu(k,1467) - lu(k,1489) = lu(k,1489) - lu(k,640) * lu(k,1467) - lu(k,1490) = lu(k,1490) - lu(k,641) * lu(k,1467) - lu(k,1491) = lu(k,1491) - lu(k,642) * lu(k,1467) - lu(k,1492) = lu(k,1492) - lu(k,643) * lu(k,1467) - lu(k,1493) = lu(k,1493) - lu(k,644) * lu(k,1467) - lu(k,1494) = lu(k,1494) - lu(k,645) * lu(k,1467) - lu(k,1495) = lu(k,1495) - lu(k,646) * lu(k,1467) - lu(k,1496) = lu(k,1496) - lu(k,647) * lu(k,1467) - lu(k,1511) = lu(k,1511) - lu(k,620) * lu(k,1510) - lu(k,1512) = lu(k,1512) - lu(k,621) * lu(k,1510) - lu(k,1513) = lu(k,1513) - lu(k,622) * lu(k,1510) - lu(k,1514) = lu(k,1514) - lu(k,623) * lu(k,1510) - lu(k,1515) = lu(k,1515) - lu(k,624) * lu(k,1510) - lu(k,1516) = lu(k,1516) - lu(k,625) * lu(k,1510) - lu(k,1517) = lu(k,1517) - lu(k,626) * lu(k,1510) - lu(k,1518) = lu(k,1518) - lu(k,627) * lu(k,1510) - lu(k,1519) = lu(k,1519) - lu(k,628) * lu(k,1510) - lu(k,1520) = lu(k,1520) - lu(k,629) * lu(k,1510) - lu(k,1521) = lu(k,1521) - lu(k,630) * lu(k,1510) - lu(k,1522) = lu(k,1522) - lu(k,631) * lu(k,1510) - lu(k,1523) = lu(k,1523) - lu(k,632) * lu(k,1510) - lu(k,1524) = lu(k,1524) - lu(k,633) * lu(k,1510) - lu(k,1526) = lu(k,1526) - lu(k,634) * lu(k,1510) - lu(k,1527) = lu(k,1527) - lu(k,635) * lu(k,1510) - lu(k,1528) = lu(k,1528) - lu(k,636) * lu(k,1510) - lu(k,1529) = lu(k,1529) - lu(k,637) * lu(k,1510) - lu(k,1530) = lu(k,1530) - lu(k,638) * lu(k,1510) - lu(k,1531) = lu(k,1531) - lu(k,639) * lu(k,1510) - lu(k,1532) = lu(k,1532) - lu(k,640) * lu(k,1510) - lu(k,1533) = lu(k,1533) - lu(k,641) * lu(k,1510) - lu(k,1534) = lu(k,1534) - lu(k,642) * lu(k,1510) - lu(k,1535) = lu(k,1535) - lu(k,643) * lu(k,1510) - lu(k,1536) = lu(k,1536) - lu(k,644) * lu(k,1510) - lu(k,1537) = lu(k,1537) - lu(k,645) * lu(k,1510) - lu(k,1538) = lu(k,1538) - lu(k,646) * lu(k,1510) - lu(k,1539) = lu(k,1539) - lu(k,647) * lu(k,1510) - lu(k,1554) = lu(k,1554) - lu(k,620) * lu(k,1553) - lu(k,1555) = - lu(k,621) * lu(k,1553) - lu(k,1556) = lu(k,1556) - lu(k,622) * lu(k,1553) - lu(k,1557) = lu(k,1557) - lu(k,623) * lu(k,1553) - lu(k,1558) = lu(k,1558) - lu(k,624) * lu(k,1553) - lu(k,1559) = lu(k,1559) - lu(k,625) * lu(k,1553) - lu(k,1560) = lu(k,1560) - lu(k,626) * lu(k,1553) - lu(k,1561) = lu(k,1561) - lu(k,627) * lu(k,1553) - lu(k,1562) = lu(k,1562) - lu(k,628) * lu(k,1553) - lu(k,1563) = lu(k,1563) - lu(k,629) * lu(k,1553) - lu(k,1564) = lu(k,1564) - lu(k,630) * lu(k,1553) - lu(k,1565) = lu(k,1565) - lu(k,631) * lu(k,1553) - lu(k,1566) = lu(k,1566) - lu(k,632) * lu(k,1553) - lu(k,1567) = lu(k,1567) - lu(k,633) * lu(k,1553) - lu(k,1569) = lu(k,1569) - lu(k,634) * lu(k,1553) - lu(k,1570) = lu(k,1570) - lu(k,635) * lu(k,1553) - lu(k,1571) = lu(k,1571) - lu(k,636) * lu(k,1553) - lu(k,1572) = lu(k,1572) - lu(k,637) * lu(k,1553) - lu(k,1573) = - lu(k,638) * lu(k,1553) - lu(k,1574) = lu(k,1574) - lu(k,639) * lu(k,1553) - lu(k,1575) = - lu(k,640) * lu(k,1553) - lu(k,1576) = lu(k,1576) - lu(k,641) * lu(k,1553) - lu(k,1577) = - lu(k,642) * lu(k,1553) - lu(k,1578) = - lu(k,643) * lu(k,1553) - lu(k,1579) = lu(k,1579) - lu(k,644) * lu(k,1553) - lu(k,1580) = lu(k,1580) - lu(k,645) * lu(k,1553) - lu(k,1581) = lu(k,1581) - lu(k,646) * lu(k,1553) - lu(k,1582) = lu(k,1582) - lu(k,647) * lu(k,1553) - lu(k,1666) = lu(k,1666) - lu(k,620) * lu(k,1665) - lu(k,1667) = lu(k,1667) - lu(k,621) * lu(k,1665) - lu(k,1668) = lu(k,1668) - lu(k,622) * lu(k,1665) - lu(k,1669) = lu(k,1669) - lu(k,623) * lu(k,1665) - lu(k,1670) = lu(k,1670) - lu(k,624) * lu(k,1665) - lu(k,1671) = lu(k,1671) - lu(k,625) * lu(k,1665) - lu(k,1672) = lu(k,1672) - lu(k,626) * lu(k,1665) - lu(k,1673) = lu(k,1673) - lu(k,627) * lu(k,1665) - lu(k,1674) = lu(k,1674) - lu(k,628) * lu(k,1665) - lu(k,1675) = lu(k,1675) - lu(k,629) * lu(k,1665) - lu(k,1676) = lu(k,1676) - lu(k,630) * lu(k,1665) - lu(k,1677) = lu(k,1677) - lu(k,631) * lu(k,1665) - lu(k,1678) = lu(k,1678) - lu(k,632) * lu(k,1665) - lu(k,1679) = lu(k,1679) - lu(k,633) * lu(k,1665) - lu(k,1681) = lu(k,1681) - lu(k,634) * lu(k,1665) - lu(k,1682) = lu(k,1682) - lu(k,635) * lu(k,1665) - lu(k,1683) = lu(k,1683) - lu(k,636) * lu(k,1665) - lu(k,1684) = lu(k,1684) - lu(k,637) * lu(k,1665) - lu(k,1685) = lu(k,1685) - lu(k,638) * lu(k,1665) - lu(k,1686) = lu(k,1686) - lu(k,639) * lu(k,1665) - lu(k,1687) = lu(k,1687) - lu(k,640) * lu(k,1665) - lu(k,1688) = lu(k,1688) - lu(k,641) * lu(k,1665) - lu(k,1689) = lu(k,1689) - lu(k,642) * lu(k,1665) - lu(k,1690) = lu(k,1690) - lu(k,643) * lu(k,1665) - lu(k,1691) = lu(k,1691) - lu(k,644) * lu(k,1665) - lu(k,1692) = lu(k,1692) - lu(k,645) * lu(k,1665) - lu(k,1693) = lu(k,1693) - lu(k,646) * lu(k,1665) - lu(k,1694) = lu(k,1694) - lu(k,647) * lu(k,1665) - lu(k,1702) = lu(k,1702) - lu(k,620) * lu(k,1701) - lu(k,1703) = lu(k,1703) - lu(k,621) * lu(k,1701) - lu(k,1704) = lu(k,1704) - lu(k,622) * lu(k,1701) - lu(k,1705) = lu(k,1705) - lu(k,623) * lu(k,1701) - lu(k,1706) = lu(k,1706) - lu(k,624) * lu(k,1701) - lu(k,1707) = lu(k,1707) - lu(k,625) * lu(k,1701) - lu(k,1708) = lu(k,1708) - lu(k,626) * lu(k,1701) - lu(k,1709) = lu(k,1709) - lu(k,627) * lu(k,1701) - lu(k,1710) = lu(k,1710) - lu(k,628) * lu(k,1701) - lu(k,1711) = lu(k,1711) - lu(k,629) * lu(k,1701) - lu(k,1712) = lu(k,1712) - lu(k,630) * lu(k,1701) - lu(k,1713) = lu(k,1713) - lu(k,631) * lu(k,1701) - lu(k,1714) = lu(k,1714) - lu(k,632) * lu(k,1701) - lu(k,1715) = lu(k,1715) - lu(k,633) * lu(k,1701) - lu(k,1717) = lu(k,1717) - lu(k,634) * lu(k,1701) - lu(k,1718) = lu(k,1718) - lu(k,635) * lu(k,1701) - lu(k,1719) = lu(k,1719) - lu(k,636) * lu(k,1701) - lu(k,1720) = lu(k,1720) - lu(k,637) * lu(k,1701) - lu(k,1721) = lu(k,1721) - lu(k,638) * lu(k,1701) - lu(k,1722) = lu(k,1722) - lu(k,639) * lu(k,1701) - lu(k,1723) = lu(k,1723) - lu(k,640) * lu(k,1701) - lu(k,1724) = lu(k,1724) - lu(k,641) * lu(k,1701) - lu(k,1725) = lu(k,1725) - lu(k,642) * lu(k,1701) - lu(k,1726) = lu(k,1726) - lu(k,643) * lu(k,1701) - lu(k,1727) = lu(k,1727) - lu(k,644) * lu(k,1701) - lu(k,1728) = lu(k,1728) - lu(k,645) * lu(k,1701) - lu(k,1729) = lu(k,1729) - lu(k,646) * lu(k,1701) - lu(k,1730) = lu(k,1730) - lu(k,647) * lu(k,1701) - end do + real(r8), intent(inout) :: lu(:) + lu(613) = 1._r8 / lu(613) + lu(614) = lu(614) * lu(613) + lu(615) = lu(615) * lu(613) + lu(616) = lu(616) * lu(613) + lu(617) = lu(617) * lu(613) + lu(618) = lu(618) * lu(613) + lu(619) = lu(619) * lu(613) + lu(620) = lu(620) * lu(613) + lu(621) = lu(621) * lu(613) + lu(622) = lu(622) * lu(613) + lu(623) = lu(623) * lu(613) + lu(624) = lu(624) * lu(613) + lu(625) = lu(625) * lu(613) + lu(626) = lu(626) * lu(613) + lu(627) = lu(627) * lu(613) + lu(628) = lu(628) * lu(613) + lu(629) = lu(629) * lu(613) + lu(630) = lu(630) * lu(613) + lu(631) = lu(631) * lu(613) + lu(636) = lu(636) - lu(614) * lu(635) + lu(637) = lu(637) - lu(615) * lu(635) + lu(638) = lu(638) - lu(616) * lu(635) + lu(639) = lu(639) - lu(617) * lu(635) + lu(640) = lu(640) - lu(618) * lu(635) + lu(641) = lu(641) - lu(619) * lu(635) + lu(642) = lu(642) - lu(620) * lu(635) + lu(643) = lu(643) - lu(621) * lu(635) + lu(644) = lu(644) - lu(622) * lu(635) + lu(645) = lu(645) - lu(623) * lu(635) + lu(646) = - lu(624) * lu(635) + lu(647) = lu(647) - lu(625) * lu(635) + lu(648) = lu(648) - lu(626) * lu(635) + lu(649) = lu(649) - lu(627) * lu(635) + lu(650) = lu(650) - lu(628) * lu(635) + lu(651) = lu(651) - lu(629) * lu(635) + lu(654) = lu(654) - lu(630) * lu(635) + lu(656) = lu(656) - lu(631) * lu(635) + lu(737) = lu(737) - lu(614) * lu(736) + lu(740) = lu(740) - lu(615) * lu(736) + lu(741) = lu(741) - lu(616) * lu(736) + lu(742) = lu(742) - lu(617) * lu(736) + lu(743) = - lu(618) * lu(736) + lu(744) = lu(744) - lu(619) * lu(736) + lu(745) = lu(745) - lu(620) * lu(736) + lu(746) = lu(746) - lu(621) * lu(736) + lu(747) = lu(747) - lu(622) * lu(736) + lu(749) = lu(749) - lu(623) * lu(736) + lu(750) = lu(750) - lu(624) * lu(736) + lu(752) = lu(752) - lu(625) * lu(736) + lu(753) = lu(753) - lu(626) * lu(736) + lu(754) = lu(754) - lu(627) * lu(736) + lu(755) = lu(755) - lu(628) * lu(736) + lu(756) = lu(756) - lu(629) * lu(736) + lu(761) = lu(761) - lu(630) * lu(736) + lu(763) = lu(763) - lu(631) * lu(736) + lu(767) = lu(767) - lu(614) * lu(766) + lu(769) = lu(769) - lu(615) * lu(766) + lu(770) = lu(770) - lu(616) * lu(766) + lu(771) = lu(771) - lu(617) * lu(766) + lu(772) = lu(772) - lu(618) * lu(766) + lu(773) = lu(773) - lu(619) * lu(766) + lu(774) = lu(774) - lu(620) * lu(766) + lu(775) = lu(775) - lu(621) * lu(766) + lu(776) = lu(776) - lu(622) * lu(766) + lu(778) = lu(778) - lu(623) * lu(766) + lu(779) = lu(779) - lu(624) * lu(766) + lu(781) = lu(781) - lu(625) * lu(766) + lu(782) = lu(782) - lu(626) * lu(766) + lu(783) = lu(783) - lu(627) * lu(766) + lu(784) = lu(784) - lu(628) * lu(766) + lu(785) = lu(785) - lu(629) * lu(766) + lu(790) = lu(790) - lu(630) * lu(766) + lu(792) = lu(792) - lu(631) * lu(766) + lu(812) = lu(812) - lu(614) * lu(811) + lu(816) = lu(816) - lu(615) * lu(811) + lu(817) = lu(817) - lu(616) * lu(811) + lu(818) = lu(818) - lu(617) * lu(811) + lu(819) = lu(819) - lu(618) * lu(811) + lu(820) = lu(820) - lu(619) * lu(811) + lu(821) = lu(821) - lu(620) * lu(811) + lu(822) = lu(822) - lu(621) * lu(811) + lu(823) = lu(823) - lu(622) * lu(811) + lu(825) = lu(825) - lu(623) * lu(811) + lu(826) = lu(826) - lu(624) * lu(811) + lu(828) = lu(828) - lu(625) * lu(811) + lu(829) = lu(829) - lu(626) * lu(811) + lu(830) = lu(830) - lu(627) * lu(811) + lu(831) = lu(831) - lu(628) * lu(811) + lu(832) = lu(832) - lu(629) * lu(811) + lu(837) = lu(837) - lu(630) * lu(811) + lu(839) = lu(839) - lu(631) * lu(811) + lu(854) = lu(854) - lu(614) * lu(853) + lu(858) = lu(858) - lu(615) * lu(853) + lu(859) = lu(859) - lu(616) * lu(853) + lu(860) = lu(860) - lu(617) * lu(853) + lu(861) = lu(861) - lu(618) * lu(853) + lu(862) = lu(862) - lu(619) * lu(853) + lu(863) = lu(863) - lu(620) * lu(853) + lu(864) = lu(864) - lu(621) * lu(853) + lu(865) = lu(865) - lu(622) * lu(853) + lu(867) = lu(867) - lu(623) * lu(853) + lu(868) = lu(868) - lu(624) * lu(853) + lu(870) = lu(870) - lu(625) * lu(853) + lu(871) = lu(871) - lu(626) * lu(853) + lu(872) = lu(872) - lu(627) * lu(853) + lu(873) = lu(873) - lu(628) * lu(853) + lu(874) = lu(874) - lu(629) * lu(853) + lu(879) = lu(879) - lu(630) * lu(853) + lu(881) = lu(881) - lu(631) * lu(853) + lu(898) = lu(898) - lu(614) * lu(897) + lu(902) = lu(902) - lu(615) * lu(897) + lu(903) = lu(903) - lu(616) * lu(897) + lu(904) = lu(904) - lu(617) * lu(897) + lu(905) = lu(905) - lu(618) * lu(897) + lu(906) = lu(906) - lu(619) * lu(897) + lu(907) = lu(907) - lu(620) * lu(897) + lu(908) = lu(908) - lu(621) * lu(897) + lu(909) = lu(909) - lu(622) * lu(897) + lu(911) = lu(911) - lu(623) * lu(897) + lu(912) = lu(912) - lu(624) * lu(897) + lu(914) = lu(914) - lu(625) * lu(897) + lu(915) = lu(915) - lu(626) * lu(897) + lu(916) = lu(916) - lu(627) * lu(897) + lu(917) = lu(917) - lu(628) * lu(897) + lu(918) = lu(918) - lu(629) * lu(897) + lu(923) = lu(923) - lu(630) * lu(897) + lu(925) = lu(925) - lu(631) * lu(897) + lu(933) = lu(933) - lu(614) * lu(932) + lu(937) = lu(937) - lu(615) * lu(932) + lu(938) = lu(938) - lu(616) * lu(932) + lu(939) = lu(939) - lu(617) * lu(932) + lu(940) = lu(940) - lu(618) * lu(932) + lu(941) = lu(941) - lu(619) * lu(932) + lu(942) = lu(942) - lu(620) * lu(932) + lu(943) = lu(943) - lu(621) * lu(932) + lu(944) = lu(944) - lu(622) * lu(932) + lu(946) = lu(946) - lu(623) * lu(932) + lu(947) = lu(947) - lu(624) * lu(932) + lu(949) = lu(949) - lu(625) * lu(932) + lu(950) = lu(950) - lu(626) * lu(932) + lu(951) = lu(951) - lu(627) * lu(932) + lu(952) = lu(952) - lu(628) * lu(932) + lu(953) = lu(953) - lu(629) * lu(932) + lu(958) = lu(958) - lu(630) * lu(932) + lu(960) = lu(960) - lu(631) * lu(932) + lu(974) = lu(974) - lu(614) * lu(973) + lu(978) = lu(978) - lu(615) * lu(973) + lu(979) = lu(979) - lu(616) * lu(973) + lu(980) = lu(980) - lu(617) * lu(973) + lu(981) = lu(981) - lu(618) * lu(973) + lu(982) = lu(982) - lu(619) * lu(973) + lu(983) = lu(983) - lu(620) * lu(973) + lu(984) = lu(984) - lu(621) * lu(973) + lu(985) = lu(985) - lu(622) * lu(973) + lu(987) = lu(987) - lu(623) * lu(973) + lu(988) = lu(988) - lu(624) * lu(973) + lu(990) = lu(990) - lu(625) * lu(973) + lu(991) = lu(991) - lu(626) * lu(973) + lu(992) = lu(992) - lu(627) * lu(973) + lu(993) = lu(993) - lu(628) * lu(973) + lu(994) = lu(994) - lu(629) * lu(973) + lu(999) = lu(999) - lu(630) * lu(973) + lu(1001) = lu(1001) - lu(631) * lu(973) + lu(1016) = lu(1016) - lu(614) * lu(1015) + lu(1020) = lu(1020) - lu(615) * lu(1015) + lu(1021) = lu(1021) - lu(616) * lu(1015) + lu(1022) = lu(1022) - lu(617) * lu(1015) + lu(1023) = lu(1023) - lu(618) * lu(1015) + lu(1024) = lu(1024) - lu(619) * lu(1015) + lu(1025) = lu(1025) - lu(620) * lu(1015) + lu(1026) = lu(1026) - lu(621) * lu(1015) + lu(1027) = lu(1027) - lu(622) * lu(1015) + lu(1029) = lu(1029) - lu(623) * lu(1015) + lu(1030) = lu(1030) - lu(624) * lu(1015) + lu(1032) = lu(1032) - lu(625) * lu(1015) + lu(1033) = lu(1033) - lu(626) * lu(1015) + lu(1034) = lu(1034) - lu(627) * lu(1015) + lu(1035) = lu(1035) - lu(628) * lu(1015) + lu(1036) = lu(1036) - lu(629) * lu(1015) + lu(1041) = lu(1041) - lu(630) * lu(1015) + lu(1043) = lu(1043) - lu(631) * lu(1015) + lu(1060) = lu(1060) - lu(614) * lu(1059) + lu(1064) = lu(1064) - lu(615) * lu(1059) + lu(1065) = lu(1065) - lu(616) * lu(1059) + lu(1066) = lu(1066) - lu(617) * lu(1059) + lu(1067) = lu(1067) - lu(618) * lu(1059) + lu(1068) = lu(1068) - lu(619) * lu(1059) + lu(1069) = lu(1069) - lu(620) * lu(1059) + lu(1070) = lu(1070) - lu(621) * lu(1059) + lu(1071) = lu(1071) - lu(622) * lu(1059) + lu(1073) = lu(1073) - lu(623) * lu(1059) + lu(1074) = lu(1074) - lu(624) * lu(1059) + lu(1076) = lu(1076) - lu(625) * lu(1059) + lu(1077) = lu(1077) - lu(626) * lu(1059) + lu(1078) = lu(1078) - lu(627) * lu(1059) + lu(1079) = lu(1079) - lu(628) * lu(1059) + lu(1080) = lu(1080) - lu(629) * lu(1059) + lu(1085) = lu(1085) - lu(630) * lu(1059) + lu(1087) = lu(1087) - lu(631) * lu(1059) + lu(1102) = lu(1102) - lu(614) * lu(1101) + lu(1106) = lu(1106) - lu(615) * lu(1101) + lu(1107) = lu(1107) - lu(616) * lu(1101) + lu(1108) = lu(1108) - lu(617) * lu(1101) + lu(1109) = lu(1109) - lu(618) * lu(1101) + lu(1110) = lu(1110) - lu(619) * lu(1101) + lu(1111) = lu(1111) - lu(620) * lu(1101) + lu(1112) = lu(1112) - lu(621) * lu(1101) + lu(1113) = lu(1113) - lu(622) * lu(1101) + lu(1115) = lu(1115) - lu(623) * lu(1101) + lu(1116) = lu(1116) - lu(624) * lu(1101) + lu(1118) = lu(1118) - lu(625) * lu(1101) + lu(1119) = lu(1119) - lu(626) * lu(1101) + lu(1120) = lu(1120) - lu(627) * lu(1101) + lu(1121) = lu(1121) - lu(628) * lu(1101) + lu(1122) = lu(1122) - lu(629) * lu(1101) + lu(1127) = lu(1127) - lu(630) * lu(1101) + lu(1129) = lu(1129) - lu(631) * lu(1101) + lu(1145) = lu(1145) - lu(614) * lu(1144) + lu(1149) = lu(1149) - lu(615) * lu(1144) + lu(1150) = lu(1150) - lu(616) * lu(1144) + lu(1151) = lu(1151) - lu(617) * lu(1144) + lu(1152) = lu(1152) - lu(618) * lu(1144) + lu(1153) = lu(1153) - lu(619) * lu(1144) + lu(1154) = lu(1154) - lu(620) * lu(1144) + lu(1155) = lu(1155) - lu(621) * lu(1144) + lu(1156) = lu(1156) - lu(622) * lu(1144) + lu(1158) = lu(1158) - lu(623) * lu(1144) + lu(1159) = lu(1159) - lu(624) * lu(1144) + lu(1161) = lu(1161) - lu(625) * lu(1144) + lu(1162) = lu(1162) - lu(626) * lu(1144) + lu(1163) = lu(1163) - lu(627) * lu(1144) + lu(1164) = lu(1164) - lu(628) * lu(1144) + lu(1165) = lu(1165) - lu(629) * lu(1144) + lu(1170) = lu(1170) - lu(630) * lu(1144) + lu(1172) = lu(1172) - lu(631) * lu(1144) + lu(1187) = lu(1187) - lu(614) * lu(1186) + lu(1191) = lu(1191) - lu(615) * lu(1186) + lu(1192) = lu(1192) - lu(616) * lu(1186) + lu(1193) = lu(1193) - lu(617) * lu(1186) + lu(1194) = lu(1194) - lu(618) * lu(1186) + lu(1195) = lu(1195) - lu(619) * lu(1186) + lu(1196) = lu(1196) - lu(620) * lu(1186) + lu(1197) = lu(1197) - lu(621) * lu(1186) + lu(1198) = lu(1198) - lu(622) * lu(1186) + lu(1200) = lu(1200) - lu(623) * lu(1186) + lu(1201) = lu(1201) - lu(624) * lu(1186) + lu(1203) = lu(1203) - lu(625) * lu(1186) + lu(1204) = lu(1204) - lu(626) * lu(1186) + lu(1205) = lu(1205) - lu(627) * lu(1186) + lu(1206) = lu(1206) - lu(628) * lu(1186) + lu(1207) = lu(1207) - lu(629) * lu(1186) + lu(1212) = lu(1212) - lu(630) * lu(1186) + lu(1214) = lu(1214) - lu(631) * lu(1186) + lu(1222) = lu(1222) - lu(614) * lu(1221) + lu(1226) = lu(1226) - lu(615) * lu(1221) + lu(1227) = lu(1227) - lu(616) * lu(1221) + lu(1228) = lu(1228) - lu(617) * lu(1221) + lu(1229) = lu(1229) - lu(618) * lu(1221) + lu(1230) = lu(1230) - lu(619) * lu(1221) + lu(1231) = lu(1231) - lu(620) * lu(1221) + lu(1232) = lu(1232) - lu(621) * lu(1221) + lu(1233) = lu(1233) - lu(622) * lu(1221) + lu(1235) = lu(1235) - lu(623) * lu(1221) + lu(1236) = lu(1236) - lu(624) * lu(1221) + lu(1238) = lu(1238) - lu(625) * lu(1221) + lu(1239) = lu(1239) - lu(626) * lu(1221) + lu(1240) = lu(1240) - lu(627) * lu(1221) + lu(1241) = lu(1241) - lu(628) * lu(1221) + lu(1242) = lu(1242) - lu(629) * lu(1221) + lu(1247) = lu(1247) - lu(630) * lu(1221) + lu(1249) = lu(1249) - lu(631) * lu(1221) + lu(1266) = lu(1266) - lu(614) * lu(1265) + lu(1270) = lu(1270) - lu(615) * lu(1265) + lu(1271) = lu(1271) - lu(616) * lu(1265) + lu(1272) = lu(1272) - lu(617) * lu(1265) + lu(1273) = lu(1273) - lu(618) * lu(1265) + lu(1274) = lu(1274) - lu(619) * lu(1265) + lu(1275) = lu(1275) - lu(620) * lu(1265) + lu(1276) = lu(1276) - lu(621) * lu(1265) + lu(1277) = lu(1277) - lu(622) * lu(1265) + lu(1279) = lu(1279) - lu(623) * lu(1265) + lu(1280) = lu(1280) - lu(624) * lu(1265) + lu(1282) = lu(1282) - lu(625) * lu(1265) + lu(1283) = lu(1283) - lu(626) * lu(1265) + lu(1284) = lu(1284) - lu(627) * lu(1265) + lu(1285) = lu(1285) - lu(628) * lu(1265) + lu(1286) = lu(1286) - lu(629) * lu(1265) + lu(1291) = lu(1291) - lu(630) * lu(1265) + lu(1293) = lu(1293) - lu(631) * lu(1265) + lu(1307) = lu(1307) - lu(614) * lu(1306) + lu(1311) = lu(1311) - lu(615) * lu(1306) + lu(1312) = lu(1312) - lu(616) * lu(1306) + lu(1313) = lu(1313) - lu(617) * lu(1306) + lu(1314) = lu(1314) - lu(618) * lu(1306) + lu(1315) = lu(1315) - lu(619) * lu(1306) + lu(1316) = lu(1316) - lu(620) * lu(1306) + lu(1317) = lu(1317) - lu(621) * lu(1306) + lu(1318) = lu(1318) - lu(622) * lu(1306) + lu(1320) = lu(1320) - lu(623) * lu(1306) + lu(1321) = lu(1321) - lu(624) * lu(1306) + lu(1323) = lu(1323) - lu(625) * lu(1306) + lu(1324) = lu(1324) - lu(626) * lu(1306) + lu(1325) = lu(1325) - lu(627) * lu(1306) + lu(1326) = lu(1326) - lu(628) * lu(1306) + lu(1327) = lu(1327) - lu(629) * lu(1306) + lu(1332) = lu(1332) - lu(630) * lu(1306) + lu(1334) = lu(1334) - lu(631) * lu(1306) + lu(1349) = lu(1349) - lu(614) * lu(1348) + lu(1353) = lu(1353) - lu(615) * lu(1348) + lu(1354) = lu(1354) - lu(616) * lu(1348) + lu(1355) = lu(1355) - lu(617) * lu(1348) + lu(1356) = lu(1356) - lu(618) * lu(1348) + lu(1357) = lu(1357) - lu(619) * lu(1348) + lu(1358) = lu(1358) - lu(620) * lu(1348) + lu(1359) = lu(1359) - lu(621) * lu(1348) + lu(1360) = lu(1360) - lu(622) * lu(1348) + lu(1362) = lu(1362) - lu(623) * lu(1348) + lu(1363) = lu(1363) - lu(624) * lu(1348) + lu(1365) = lu(1365) - lu(625) * lu(1348) + lu(1366) = lu(1366) - lu(626) * lu(1348) + lu(1367) = lu(1367) - lu(627) * lu(1348) + lu(1368) = lu(1368) - lu(628) * lu(1348) + lu(1369) = lu(1369) - lu(629) * lu(1348) + lu(1374) = lu(1374) - lu(630) * lu(1348) + lu(1376) = lu(1376) - lu(631) * lu(1348) + lu(1433) = lu(1433) - lu(614) * lu(1432) + lu(1437) = lu(1437) - lu(615) * lu(1432) + lu(1438) = lu(1438) - lu(616) * lu(1432) + lu(1439) = lu(1439) - lu(617) * lu(1432) + lu(1440) = lu(1440) - lu(618) * lu(1432) + lu(1441) = lu(1441) - lu(619) * lu(1432) + lu(1442) = lu(1442) - lu(620) * lu(1432) + lu(1443) = lu(1443) - lu(621) * lu(1432) + lu(1444) = lu(1444) - lu(622) * lu(1432) + lu(1446) = lu(1446) - lu(623) * lu(1432) + lu(1447) = lu(1447) - lu(624) * lu(1432) + lu(1449) = lu(1449) - lu(625) * lu(1432) + lu(1450) = lu(1450) - lu(626) * lu(1432) + lu(1451) = lu(1451) - lu(627) * lu(1432) + lu(1452) = lu(1452) - lu(628) * lu(1432) + lu(1453) = lu(1453) - lu(629) * lu(1432) + lu(1458) = lu(1458) - lu(630) * lu(1432) + lu(1460) = lu(1460) - lu(631) * lu(1432) + lu(1488) = lu(1488) - lu(614) * lu(1487) + lu(1492) = lu(1492) - lu(615) * lu(1487) + lu(1493) = lu(1493) - lu(616) * lu(1487) + lu(1494) = lu(1494) - lu(617) * lu(1487) + lu(1495) = lu(1495) - lu(618) * lu(1487) + lu(1496) = lu(1496) - lu(619) * lu(1487) + lu(1497) = lu(1497) - lu(620) * lu(1487) + lu(1498) = lu(1498) - lu(621) * lu(1487) + lu(1499) = lu(1499) - lu(622) * lu(1487) + lu(1501) = lu(1501) - lu(623) * lu(1487) + lu(1502) = lu(1502) - lu(624) * lu(1487) + lu(1504) = lu(1504) - lu(625) * lu(1487) + lu(1505) = lu(1505) - lu(626) * lu(1487) + lu(1506) = lu(1506) - lu(627) * lu(1487) + lu(1507) = lu(1507) - lu(628) * lu(1487) + lu(1508) = lu(1508) - lu(629) * lu(1487) + lu(1513) = lu(1513) - lu(630) * lu(1487) + lu(1515) = lu(1515) - lu(631) * lu(1487) + lu(1520) = lu(1520) - lu(614) * lu(1519) + lu(1524) = lu(1524) - lu(615) * lu(1519) + lu(1525) = lu(1525) - lu(616) * lu(1519) + lu(1526) = lu(1526) - lu(617) * lu(1519) + lu(1527) = lu(1527) - lu(618) * lu(1519) + lu(1528) = lu(1528) - lu(619) * lu(1519) + lu(1529) = lu(1529) - lu(620) * lu(1519) + lu(1530) = lu(1530) - lu(621) * lu(1519) + lu(1531) = lu(1531) - lu(622) * lu(1519) + lu(1533) = lu(1533) - lu(623) * lu(1519) + lu(1534) = lu(1534) - lu(624) * lu(1519) + lu(1536) = lu(1536) - lu(625) * lu(1519) + lu(1537) = lu(1537) - lu(626) * lu(1519) + lu(1538) = lu(1538) - lu(627) * lu(1519) + lu(1539) = lu(1539) - lu(628) * lu(1519) + lu(1540) = lu(1540) - lu(629) * lu(1519) + lu(1545) = - lu(630) * lu(1519) + lu(1547) = lu(1547) - lu(631) * lu(1519) + lu(1555) = lu(1555) - lu(614) * lu(1554) + lu(1559) = lu(1559) - lu(615) * lu(1554) + lu(1560) = - lu(616) * lu(1554) + lu(1561) = - lu(617) * lu(1554) + lu(1562) = lu(1562) - lu(618) * lu(1554) + lu(1563) = lu(1563) - lu(619) * lu(1554) + lu(1564) = - lu(620) * lu(1554) + lu(1565) = lu(1565) - lu(621) * lu(1554) + lu(1566) = lu(1566) - lu(622) * lu(1554) + lu(1568) = lu(1568) - lu(623) * lu(1554) + lu(1569) = lu(1569) - lu(624) * lu(1554) + lu(1571) = lu(1571) - lu(625) * lu(1554) + lu(1572) = lu(1572) - lu(626) * lu(1554) + lu(1573) = - lu(627) * lu(1554) + lu(1574) = lu(1574) - lu(628) * lu(1554) + lu(1575) = - lu(629) * lu(1554) + lu(1580) = lu(1580) - lu(630) * lu(1554) + lu(1582) = lu(1582) - lu(631) * lu(1554) + lu(1593) = lu(1593) - lu(614) * lu(1592) + lu(1597) = lu(1597) - lu(615) * lu(1592) + lu(1598) = lu(1598) - lu(616) * lu(1592) + lu(1599) = lu(1599) - lu(617) * lu(1592) + lu(1600) = lu(1600) - lu(618) * lu(1592) + lu(1601) = lu(1601) - lu(619) * lu(1592) + lu(1602) = lu(1602) - lu(620) * lu(1592) + lu(1603) = lu(1603) - lu(621) * lu(1592) + lu(1604) = lu(1604) - lu(622) * lu(1592) + lu(1606) = lu(1606) - lu(623) * lu(1592) + lu(1607) = lu(1607) - lu(624) * lu(1592) + lu(1609) = lu(1609) - lu(625) * lu(1592) + lu(1610) = lu(1610) - lu(626) * lu(1592) + lu(1611) = lu(1611) - lu(627) * lu(1592) + lu(1612) = lu(1612) - lu(628) * lu(1592) + lu(1613) = lu(1613) - lu(629) * lu(1592) + lu(1618) = lu(1618) - lu(630) * lu(1592) + lu(1620) = lu(1620) - lu(631) * lu(1592) + lu(1632) = lu(1632) - lu(614) * lu(1631) + lu(1636) = lu(1636) - lu(615) * lu(1631) + lu(1637) = lu(1637) - lu(616) * lu(1631) + lu(1638) = lu(1638) - lu(617) * lu(1631) + lu(1639) = lu(1639) - lu(618) * lu(1631) + lu(1640) = lu(1640) - lu(619) * lu(1631) + lu(1641) = lu(1641) - lu(620) * lu(1631) + lu(1642) = lu(1642) - lu(621) * lu(1631) + lu(1643) = lu(1643) - lu(622) * lu(1631) + lu(1645) = lu(1645) - lu(623) * lu(1631) + lu(1646) = lu(1646) - lu(624) * lu(1631) + lu(1648) = lu(1648) - lu(625) * lu(1631) + lu(1649) = lu(1649) - lu(626) * lu(1631) + lu(1650) = lu(1650) - lu(627) * lu(1631) + lu(1651) = lu(1651) - lu(628) * lu(1631) + lu(1652) = lu(1652) - lu(629) * lu(1631) + lu(1657) = lu(1657) - lu(630) * lu(1631) + lu(1659) = lu(1659) - lu(631) * lu(1631) + lu(1718) = lu(1718) - lu(614) * lu(1717) + lu(1722) = lu(1722) - lu(615) * lu(1717) + lu(1723) = lu(1723) - lu(616) * lu(1717) + lu(1724) = lu(1724) - lu(617) * lu(1717) + lu(1725) = lu(1725) - lu(618) * lu(1717) + lu(1726) = lu(1726) - lu(619) * lu(1717) + lu(1727) = lu(1727) - lu(620) * lu(1717) + lu(1728) = lu(1728) - lu(621) * lu(1717) + lu(1729) = lu(1729) - lu(622) * lu(1717) + lu(1731) = lu(1731) - lu(623) * lu(1717) + lu(1732) = lu(1732) - lu(624) * lu(1717) + lu(1734) = lu(1734) - lu(625) * lu(1717) + lu(1735) = lu(1735) - lu(626) * lu(1717) + lu(1736) = lu(1736) - lu(627) * lu(1717) + lu(1737) = lu(1737) - lu(628) * lu(1717) + lu(1738) = lu(1738) - lu(629) * lu(1717) + lu(1743) = lu(1743) - lu(630) * lu(1717) + lu(1745) = lu(1745) - lu(631) * lu(1717) + lu(636) = 1._r8 / lu(636) + lu(637) = lu(637) * lu(636) + lu(638) = lu(638) * lu(636) + lu(639) = lu(639) * lu(636) + lu(640) = lu(640) * lu(636) + lu(641) = lu(641) * lu(636) + lu(642) = lu(642) * lu(636) + lu(643) = lu(643) * lu(636) + lu(644) = lu(644) * lu(636) + lu(645) = lu(645) * lu(636) + lu(646) = lu(646) * lu(636) + lu(647) = lu(647) * lu(636) + lu(648) = lu(648) * lu(636) + lu(649) = lu(649) * lu(636) + lu(650) = lu(650) * lu(636) + lu(651) = lu(651) * lu(636) + lu(652) = lu(652) * lu(636) + lu(653) = lu(653) * lu(636) + lu(654) = lu(654) * lu(636) + lu(655) = lu(655) * lu(636) + lu(656) = lu(656) * lu(636) + lu(740) = lu(740) - lu(637) * lu(737) + lu(741) = lu(741) - lu(638) * lu(737) + lu(742) = lu(742) - lu(639) * lu(737) + lu(743) = lu(743) - lu(640) * lu(737) + lu(744) = lu(744) - lu(641) * lu(737) + lu(745) = lu(745) - lu(642) * lu(737) + lu(746) = lu(746) - lu(643) * lu(737) + lu(747) = lu(747) - lu(644) * lu(737) + lu(749) = lu(749) - lu(645) * lu(737) + lu(750) = lu(750) - lu(646) * lu(737) + lu(752) = lu(752) - lu(647) * lu(737) + lu(753) = lu(753) - lu(648) * lu(737) + lu(754) = lu(754) - lu(649) * lu(737) + lu(755) = lu(755) - lu(650) * lu(737) + lu(756) = lu(756) - lu(651) * lu(737) + lu(757) = lu(757) - lu(652) * lu(737) + lu(760) = lu(760) - lu(653) * lu(737) + lu(761) = lu(761) - lu(654) * lu(737) + lu(762) = lu(762) - lu(655) * lu(737) + lu(763) = lu(763) - lu(656) * lu(737) + lu(769) = lu(769) - lu(637) * lu(767) + lu(770) = lu(770) - lu(638) * lu(767) + lu(771) = lu(771) - lu(639) * lu(767) + lu(772) = lu(772) - lu(640) * lu(767) + lu(773) = lu(773) - lu(641) * lu(767) + lu(774) = lu(774) - lu(642) * lu(767) + lu(775) = lu(775) - lu(643) * lu(767) + lu(776) = lu(776) - lu(644) * lu(767) + lu(778) = lu(778) - lu(645) * lu(767) + lu(779) = lu(779) - lu(646) * lu(767) + lu(781) = lu(781) - lu(647) * lu(767) + lu(782) = lu(782) - lu(648) * lu(767) + lu(783) = lu(783) - lu(649) * lu(767) + lu(784) = lu(784) - lu(650) * lu(767) + lu(785) = lu(785) - lu(651) * lu(767) + lu(786) = - lu(652) * lu(767) + lu(789) = lu(789) - lu(653) * lu(767) + lu(790) = lu(790) - lu(654) * lu(767) + lu(791) = lu(791) - lu(655) * lu(767) + lu(792) = lu(792) - lu(656) * lu(767) + lu(816) = lu(816) - lu(637) * lu(812) + lu(817) = lu(817) - lu(638) * lu(812) + lu(818) = lu(818) - lu(639) * lu(812) + lu(819) = lu(819) - lu(640) * lu(812) + lu(820) = lu(820) - lu(641) * lu(812) + lu(821) = lu(821) - lu(642) * lu(812) + lu(822) = lu(822) - lu(643) * lu(812) + lu(823) = lu(823) - lu(644) * lu(812) + lu(825) = lu(825) - lu(645) * lu(812) + lu(826) = lu(826) - lu(646) * lu(812) + lu(828) = lu(828) - lu(647) * lu(812) + lu(829) = lu(829) - lu(648) * lu(812) + lu(830) = lu(830) - lu(649) * lu(812) + lu(831) = lu(831) - lu(650) * lu(812) + lu(832) = lu(832) - lu(651) * lu(812) + lu(833) = lu(833) - lu(652) * lu(812) + lu(836) = lu(836) - lu(653) * lu(812) + lu(837) = lu(837) - lu(654) * lu(812) + lu(838) = lu(838) - lu(655) * lu(812) + lu(839) = lu(839) - lu(656) * lu(812) + lu(858) = lu(858) - lu(637) * lu(854) + lu(859) = lu(859) - lu(638) * lu(854) + lu(860) = lu(860) - lu(639) * lu(854) + lu(861) = lu(861) - lu(640) * lu(854) + lu(862) = lu(862) - lu(641) * lu(854) + lu(863) = lu(863) - lu(642) * lu(854) + lu(864) = lu(864) - lu(643) * lu(854) + lu(865) = lu(865) - lu(644) * lu(854) + lu(867) = lu(867) - lu(645) * lu(854) + lu(868) = lu(868) - lu(646) * lu(854) + lu(870) = lu(870) - lu(647) * lu(854) + lu(871) = lu(871) - lu(648) * lu(854) + lu(872) = lu(872) - lu(649) * lu(854) + lu(873) = lu(873) - lu(650) * lu(854) + lu(874) = lu(874) - lu(651) * lu(854) + lu(875) = lu(875) - lu(652) * lu(854) + lu(878) = lu(878) - lu(653) * lu(854) + lu(879) = lu(879) - lu(654) * lu(854) + lu(880) = lu(880) - lu(655) * lu(854) + lu(881) = lu(881) - lu(656) * lu(854) + lu(902) = lu(902) - lu(637) * lu(898) + lu(903) = lu(903) - lu(638) * lu(898) + lu(904) = lu(904) - lu(639) * lu(898) + lu(905) = lu(905) - lu(640) * lu(898) + lu(906) = lu(906) - lu(641) * lu(898) + lu(907) = lu(907) - lu(642) * lu(898) + lu(908) = lu(908) - lu(643) * lu(898) + lu(909) = lu(909) - lu(644) * lu(898) + lu(911) = lu(911) - lu(645) * lu(898) + lu(912) = lu(912) - lu(646) * lu(898) + lu(914) = lu(914) - lu(647) * lu(898) + lu(915) = lu(915) - lu(648) * lu(898) + lu(916) = lu(916) - lu(649) * lu(898) + lu(917) = lu(917) - lu(650) * lu(898) + lu(918) = lu(918) - lu(651) * lu(898) + lu(919) = lu(919) - lu(652) * lu(898) + lu(922) = lu(922) - lu(653) * lu(898) + lu(923) = lu(923) - lu(654) * lu(898) + lu(924) = lu(924) - lu(655) * lu(898) + lu(925) = lu(925) - lu(656) * lu(898) + lu(937) = lu(937) - lu(637) * lu(933) + lu(938) = lu(938) - lu(638) * lu(933) + lu(939) = lu(939) - lu(639) * lu(933) + lu(940) = lu(940) - lu(640) * lu(933) + lu(941) = lu(941) - lu(641) * lu(933) + lu(942) = lu(942) - lu(642) * lu(933) + lu(943) = lu(943) - lu(643) * lu(933) + lu(944) = lu(944) - lu(644) * lu(933) + lu(946) = lu(946) - lu(645) * lu(933) + lu(947) = lu(947) - lu(646) * lu(933) + lu(949) = lu(949) - lu(647) * lu(933) + lu(950) = lu(950) - lu(648) * lu(933) + lu(951) = lu(951) - lu(649) * lu(933) + lu(952) = lu(952) - lu(650) * lu(933) + lu(953) = lu(953) - lu(651) * lu(933) + lu(954) = lu(954) - lu(652) * lu(933) + lu(957) = lu(957) - lu(653) * lu(933) + lu(958) = lu(958) - lu(654) * lu(933) + lu(959) = lu(959) - lu(655) * lu(933) + lu(960) = lu(960) - lu(656) * lu(933) + lu(978) = lu(978) - lu(637) * lu(974) + lu(979) = lu(979) - lu(638) * lu(974) + lu(980) = lu(980) - lu(639) * lu(974) + lu(981) = lu(981) - lu(640) * lu(974) + lu(982) = lu(982) - lu(641) * lu(974) + lu(983) = lu(983) - lu(642) * lu(974) + lu(984) = lu(984) - lu(643) * lu(974) + lu(985) = lu(985) - lu(644) * lu(974) + lu(987) = lu(987) - lu(645) * lu(974) + lu(988) = lu(988) - lu(646) * lu(974) + lu(990) = lu(990) - lu(647) * lu(974) + lu(991) = lu(991) - lu(648) * lu(974) + lu(992) = lu(992) - lu(649) * lu(974) + lu(993) = lu(993) - lu(650) * lu(974) + lu(994) = lu(994) - lu(651) * lu(974) + lu(995) = lu(995) - lu(652) * lu(974) + lu(998) = lu(998) - lu(653) * lu(974) + lu(999) = lu(999) - lu(654) * lu(974) + lu(1000) = lu(1000) - lu(655) * lu(974) + lu(1001) = lu(1001) - lu(656) * lu(974) + lu(1020) = lu(1020) - lu(637) * lu(1016) + lu(1021) = lu(1021) - lu(638) * lu(1016) + lu(1022) = lu(1022) - lu(639) * lu(1016) + lu(1023) = lu(1023) - lu(640) * lu(1016) + lu(1024) = lu(1024) - lu(641) * lu(1016) + lu(1025) = lu(1025) - lu(642) * lu(1016) + lu(1026) = lu(1026) - lu(643) * lu(1016) + lu(1027) = lu(1027) - lu(644) * lu(1016) + lu(1029) = lu(1029) - lu(645) * lu(1016) + lu(1030) = lu(1030) - lu(646) * lu(1016) + lu(1032) = lu(1032) - lu(647) * lu(1016) + lu(1033) = lu(1033) - lu(648) * lu(1016) + lu(1034) = lu(1034) - lu(649) * lu(1016) + lu(1035) = lu(1035) - lu(650) * lu(1016) + lu(1036) = lu(1036) - lu(651) * lu(1016) + lu(1037) = lu(1037) - lu(652) * lu(1016) + lu(1040) = lu(1040) - lu(653) * lu(1016) + lu(1041) = lu(1041) - lu(654) * lu(1016) + lu(1042) = lu(1042) - lu(655) * lu(1016) + lu(1043) = lu(1043) - lu(656) * lu(1016) + lu(1064) = lu(1064) - lu(637) * lu(1060) + lu(1065) = lu(1065) - lu(638) * lu(1060) + lu(1066) = lu(1066) - lu(639) * lu(1060) + lu(1067) = lu(1067) - lu(640) * lu(1060) + lu(1068) = lu(1068) - lu(641) * lu(1060) + lu(1069) = lu(1069) - lu(642) * lu(1060) + lu(1070) = lu(1070) - lu(643) * lu(1060) + lu(1071) = lu(1071) - lu(644) * lu(1060) + lu(1073) = lu(1073) - lu(645) * lu(1060) + lu(1074) = lu(1074) - lu(646) * lu(1060) + lu(1076) = lu(1076) - lu(647) * lu(1060) + lu(1077) = lu(1077) - lu(648) * lu(1060) + lu(1078) = lu(1078) - lu(649) * lu(1060) + lu(1079) = lu(1079) - lu(650) * lu(1060) + lu(1080) = lu(1080) - lu(651) * lu(1060) + lu(1081) = lu(1081) - lu(652) * lu(1060) + lu(1084) = lu(1084) - lu(653) * lu(1060) + lu(1085) = lu(1085) - lu(654) * lu(1060) + lu(1086) = lu(1086) - lu(655) * lu(1060) + lu(1087) = lu(1087) - lu(656) * lu(1060) + lu(1106) = lu(1106) - lu(637) * lu(1102) + lu(1107) = lu(1107) - lu(638) * lu(1102) + lu(1108) = lu(1108) - lu(639) * lu(1102) + lu(1109) = lu(1109) - lu(640) * lu(1102) + lu(1110) = lu(1110) - lu(641) * lu(1102) + lu(1111) = lu(1111) - lu(642) * lu(1102) + lu(1112) = lu(1112) - lu(643) * lu(1102) + lu(1113) = lu(1113) - lu(644) * lu(1102) + lu(1115) = lu(1115) - lu(645) * lu(1102) + lu(1116) = lu(1116) - lu(646) * lu(1102) + lu(1118) = lu(1118) - lu(647) * lu(1102) + lu(1119) = lu(1119) - lu(648) * lu(1102) + lu(1120) = lu(1120) - lu(649) * lu(1102) + lu(1121) = lu(1121) - lu(650) * lu(1102) + lu(1122) = lu(1122) - lu(651) * lu(1102) + lu(1123) = lu(1123) - lu(652) * lu(1102) + lu(1126) = lu(1126) - lu(653) * lu(1102) + lu(1127) = lu(1127) - lu(654) * lu(1102) + lu(1128) = lu(1128) - lu(655) * lu(1102) + lu(1129) = lu(1129) - lu(656) * lu(1102) + lu(1149) = lu(1149) - lu(637) * lu(1145) + lu(1150) = lu(1150) - lu(638) * lu(1145) + lu(1151) = lu(1151) - lu(639) * lu(1145) + lu(1152) = lu(1152) - lu(640) * lu(1145) + lu(1153) = lu(1153) - lu(641) * lu(1145) + lu(1154) = lu(1154) - lu(642) * lu(1145) + lu(1155) = lu(1155) - lu(643) * lu(1145) + lu(1156) = lu(1156) - lu(644) * lu(1145) + lu(1158) = lu(1158) - lu(645) * lu(1145) + lu(1159) = lu(1159) - lu(646) * lu(1145) + lu(1161) = lu(1161) - lu(647) * lu(1145) + lu(1162) = lu(1162) - lu(648) * lu(1145) + lu(1163) = lu(1163) - lu(649) * lu(1145) + lu(1164) = lu(1164) - lu(650) * lu(1145) + lu(1165) = lu(1165) - lu(651) * lu(1145) + lu(1166) = lu(1166) - lu(652) * lu(1145) + lu(1169) = lu(1169) - lu(653) * lu(1145) + lu(1170) = lu(1170) - lu(654) * lu(1145) + lu(1171) = lu(1171) - lu(655) * lu(1145) + lu(1172) = lu(1172) - lu(656) * lu(1145) + lu(1191) = lu(1191) - lu(637) * lu(1187) + lu(1192) = lu(1192) - lu(638) * lu(1187) + lu(1193) = lu(1193) - lu(639) * lu(1187) + lu(1194) = lu(1194) - lu(640) * lu(1187) + lu(1195) = lu(1195) - lu(641) * lu(1187) + lu(1196) = lu(1196) - lu(642) * lu(1187) + lu(1197) = lu(1197) - lu(643) * lu(1187) + lu(1198) = lu(1198) - lu(644) * lu(1187) + lu(1200) = lu(1200) - lu(645) * lu(1187) + lu(1201) = lu(1201) - lu(646) * lu(1187) + lu(1203) = lu(1203) - lu(647) * lu(1187) + lu(1204) = lu(1204) - lu(648) * lu(1187) + lu(1205) = lu(1205) - lu(649) * lu(1187) + lu(1206) = lu(1206) - lu(650) * lu(1187) + lu(1207) = lu(1207) - lu(651) * lu(1187) + lu(1208) = lu(1208) - lu(652) * lu(1187) + lu(1211) = lu(1211) - lu(653) * lu(1187) + lu(1212) = lu(1212) - lu(654) * lu(1187) + lu(1213) = lu(1213) - lu(655) * lu(1187) + lu(1214) = lu(1214) - lu(656) * lu(1187) + lu(1226) = lu(1226) - lu(637) * lu(1222) + lu(1227) = lu(1227) - lu(638) * lu(1222) + lu(1228) = lu(1228) - lu(639) * lu(1222) + lu(1229) = lu(1229) - lu(640) * lu(1222) + lu(1230) = lu(1230) - lu(641) * lu(1222) + lu(1231) = lu(1231) - lu(642) * lu(1222) + lu(1232) = lu(1232) - lu(643) * lu(1222) + lu(1233) = lu(1233) - lu(644) * lu(1222) + lu(1235) = lu(1235) - lu(645) * lu(1222) + lu(1236) = lu(1236) - lu(646) * lu(1222) + lu(1238) = lu(1238) - lu(647) * lu(1222) + lu(1239) = lu(1239) - lu(648) * lu(1222) + lu(1240) = lu(1240) - lu(649) * lu(1222) + lu(1241) = lu(1241) - lu(650) * lu(1222) + lu(1242) = lu(1242) - lu(651) * lu(1222) + lu(1243) = lu(1243) - lu(652) * lu(1222) + lu(1246) = lu(1246) - lu(653) * lu(1222) + lu(1247) = lu(1247) - lu(654) * lu(1222) + lu(1248) = - lu(655) * lu(1222) + lu(1249) = lu(1249) - lu(656) * lu(1222) + lu(1270) = lu(1270) - lu(637) * lu(1266) + lu(1271) = lu(1271) - lu(638) * lu(1266) + lu(1272) = lu(1272) - lu(639) * lu(1266) + lu(1273) = lu(1273) - lu(640) * lu(1266) + lu(1274) = lu(1274) - lu(641) * lu(1266) + lu(1275) = lu(1275) - lu(642) * lu(1266) + lu(1276) = lu(1276) - lu(643) * lu(1266) + lu(1277) = lu(1277) - lu(644) * lu(1266) + lu(1279) = lu(1279) - lu(645) * lu(1266) + lu(1280) = lu(1280) - lu(646) * lu(1266) + lu(1282) = lu(1282) - lu(647) * lu(1266) + lu(1283) = lu(1283) - lu(648) * lu(1266) + lu(1284) = lu(1284) - lu(649) * lu(1266) + lu(1285) = lu(1285) - lu(650) * lu(1266) + lu(1286) = lu(1286) - lu(651) * lu(1266) + lu(1287) = lu(1287) - lu(652) * lu(1266) + lu(1290) = lu(1290) - lu(653) * lu(1266) + lu(1291) = lu(1291) - lu(654) * lu(1266) + lu(1292) = lu(1292) - lu(655) * lu(1266) + lu(1293) = lu(1293) - lu(656) * lu(1266) + lu(1311) = lu(1311) - lu(637) * lu(1307) + lu(1312) = lu(1312) - lu(638) * lu(1307) + lu(1313) = lu(1313) - lu(639) * lu(1307) + lu(1314) = lu(1314) - lu(640) * lu(1307) + lu(1315) = lu(1315) - lu(641) * lu(1307) + lu(1316) = lu(1316) - lu(642) * lu(1307) + lu(1317) = lu(1317) - lu(643) * lu(1307) + lu(1318) = lu(1318) - lu(644) * lu(1307) + lu(1320) = lu(1320) - lu(645) * lu(1307) + lu(1321) = lu(1321) - lu(646) * lu(1307) + lu(1323) = lu(1323) - lu(647) * lu(1307) + lu(1324) = lu(1324) - lu(648) * lu(1307) + lu(1325) = lu(1325) - lu(649) * lu(1307) + lu(1326) = lu(1326) - lu(650) * lu(1307) + lu(1327) = lu(1327) - lu(651) * lu(1307) + lu(1328) = lu(1328) - lu(652) * lu(1307) + lu(1331) = lu(1331) - lu(653) * lu(1307) + lu(1332) = lu(1332) - lu(654) * lu(1307) + lu(1333) = lu(1333) - lu(655) * lu(1307) + lu(1334) = lu(1334) - lu(656) * lu(1307) + lu(1353) = lu(1353) - lu(637) * lu(1349) + lu(1354) = lu(1354) - lu(638) * lu(1349) + lu(1355) = lu(1355) - lu(639) * lu(1349) + lu(1356) = lu(1356) - lu(640) * lu(1349) + lu(1357) = lu(1357) - lu(641) * lu(1349) + lu(1358) = lu(1358) - lu(642) * lu(1349) + lu(1359) = lu(1359) - lu(643) * lu(1349) + lu(1360) = lu(1360) - lu(644) * lu(1349) + lu(1362) = lu(1362) - lu(645) * lu(1349) + lu(1363) = lu(1363) - lu(646) * lu(1349) + lu(1365) = lu(1365) - lu(647) * lu(1349) + lu(1366) = lu(1366) - lu(648) * lu(1349) + lu(1367) = lu(1367) - lu(649) * lu(1349) + lu(1368) = lu(1368) - lu(650) * lu(1349) + lu(1369) = lu(1369) - lu(651) * lu(1349) + lu(1370) = lu(1370) - lu(652) * lu(1349) + lu(1373) = lu(1373) - lu(653) * lu(1349) + lu(1374) = lu(1374) - lu(654) * lu(1349) + lu(1375) = lu(1375) - lu(655) * lu(1349) + lu(1376) = lu(1376) - lu(656) * lu(1349) + lu(1437) = lu(1437) - lu(637) * lu(1433) + lu(1438) = lu(1438) - lu(638) * lu(1433) + lu(1439) = lu(1439) - lu(639) * lu(1433) + lu(1440) = lu(1440) - lu(640) * lu(1433) + lu(1441) = lu(1441) - lu(641) * lu(1433) + lu(1442) = lu(1442) - lu(642) * lu(1433) + lu(1443) = lu(1443) - lu(643) * lu(1433) + lu(1444) = lu(1444) - lu(644) * lu(1433) + lu(1446) = lu(1446) - lu(645) * lu(1433) + lu(1447) = lu(1447) - lu(646) * lu(1433) + lu(1449) = lu(1449) - lu(647) * lu(1433) + lu(1450) = lu(1450) - lu(648) * lu(1433) + lu(1451) = lu(1451) - lu(649) * lu(1433) + lu(1452) = lu(1452) - lu(650) * lu(1433) + lu(1453) = lu(1453) - lu(651) * lu(1433) + lu(1454) = lu(1454) - lu(652) * lu(1433) + lu(1457) = lu(1457) - lu(653) * lu(1433) + lu(1458) = lu(1458) - lu(654) * lu(1433) + lu(1459) = lu(1459) - lu(655) * lu(1433) + lu(1460) = lu(1460) - lu(656) * lu(1433) + lu(1492) = lu(1492) - lu(637) * lu(1488) + lu(1493) = lu(1493) - lu(638) * lu(1488) + lu(1494) = lu(1494) - lu(639) * lu(1488) + lu(1495) = lu(1495) - lu(640) * lu(1488) + lu(1496) = lu(1496) - lu(641) * lu(1488) + lu(1497) = lu(1497) - lu(642) * lu(1488) + lu(1498) = lu(1498) - lu(643) * lu(1488) + lu(1499) = lu(1499) - lu(644) * lu(1488) + lu(1501) = lu(1501) - lu(645) * lu(1488) + lu(1502) = lu(1502) - lu(646) * lu(1488) + lu(1504) = lu(1504) - lu(647) * lu(1488) + lu(1505) = lu(1505) - lu(648) * lu(1488) + lu(1506) = lu(1506) - lu(649) * lu(1488) + lu(1507) = lu(1507) - lu(650) * lu(1488) + lu(1508) = lu(1508) - lu(651) * lu(1488) + lu(1509) = lu(1509) - lu(652) * lu(1488) + lu(1512) = lu(1512) - lu(653) * lu(1488) + lu(1513) = lu(1513) - lu(654) * lu(1488) + lu(1514) = lu(1514) - lu(655) * lu(1488) + lu(1515) = lu(1515) - lu(656) * lu(1488) + lu(1524) = lu(1524) - lu(637) * lu(1520) + lu(1525) = lu(1525) - lu(638) * lu(1520) + lu(1526) = lu(1526) - lu(639) * lu(1520) + lu(1527) = lu(1527) - lu(640) * lu(1520) + lu(1528) = lu(1528) - lu(641) * lu(1520) + lu(1529) = lu(1529) - lu(642) * lu(1520) + lu(1530) = lu(1530) - lu(643) * lu(1520) + lu(1531) = lu(1531) - lu(644) * lu(1520) + lu(1533) = lu(1533) - lu(645) * lu(1520) + lu(1534) = lu(1534) - lu(646) * lu(1520) + lu(1536) = lu(1536) - lu(647) * lu(1520) + lu(1537) = lu(1537) - lu(648) * lu(1520) + lu(1538) = lu(1538) - lu(649) * lu(1520) + lu(1539) = lu(1539) - lu(650) * lu(1520) + lu(1540) = lu(1540) - lu(651) * lu(1520) + lu(1541) = lu(1541) - lu(652) * lu(1520) + lu(1544) = lu(1544) - lu(653) * lu(1520) + lu(1545) = lu(1545) - lu(654) * lu(1520) + lu(1546) = - lu(655) * lu(1520) + lu(1547) = lu(1547) - lu(656) * lu(1520) + lu(1559) = lu(1559) - lu(637) * lu(1555) + lu(1560) = lu(1560) - lu(638) * lu(1555) + lu(1561) = lu(1561) - lu(639) * lu(1555) + lu(1562) = lu(1562) - lu(640) * lu(1555) + lu(1563) = lu(1563) - lu(641) * lu(1555) + lu(1564) = lu(1564) - lu(642) * lu(1555) + lu(1565) = lu(1565) - lu(643) * lu(1555) + lu(1566) = lu(1566) - lu(644) * lu(1555) + lu(1568) = lu(1568) - lu(645) * lu(1555) + lu(1569) = lu(1569) - lu(646) * lu(1555) + lu(1571) = lu(1571) - lu(647) * lu(1555) + lu(1572) = lu(1572) - lu(648) * lu(1555) + lu(1573) = lu(1573) - lu(649) * lu(1555) + lu(1574) = lu(1574) - lu(650) * lu(1555) + lu(1575) = lu(1575) - lu(651) * lu(1555) + lu(1576) = lu(1576) - lu(652) * lu(1555) + lu(1579) = lu(1579) - lu(653) * lu(1555) + lu(1580) = lu(1580) - lu(654) * lu(1555) + lu(1581) = lu(1581) - lu(655) * lu(1555) + lu(1582) = lu(1582) - lu(656) * lu(1555) + lu(1597) = lu(1597) - lu(637) * lu(1593) + lu(1598) = lu(1598) - lu(638) * lu(1593) + lu(1599) = lu(1599) - lu(639) * lu(1593) + lu(1600) = lu(1600) - lu(640) * lu(1593) + lu(1601) = lu(1601) - lu(641) * lu(1593) + lu(1602) = lu(1602) - lu(642) * lu(1593) + lu(1603) = lu(1603) - lu(643) * lu(1593) + lu(1604) = lu(1604) - lu(644) * lu(1593) + lu(1606) = lu(1606) - lu(645) * lu(1593) + lu(1607) = lu(1607) - lu(646) * lu(1593) + lu(1609) = lu(1609) - lu(647) * lu(1593) + lu(1610) = lu(1610) - lu(648) * lu(1593) + lu(1611) = lu(1611) - lu(649) * lu(1593) + lu(1612) = lu(1612) - lu(650) * lu(1593) + lu(1613) = lu(1613) - lu(651) * lu(1593) + lu(1614) = lu(1614) - lu(652) * lu(1593) + lu(1617) = lu(1617) - lu(653) * lu(1593) + lu(1618) = lu(1618) - lu(654) * lu(1593) + lu(1619) = lu(1619) - lu(655) * lu(1593) + lu(1620) = lu(1620) - lu(656) * lu(1593) + lu(1636) = lu(1636) - lu(637) * lu(1632) + lu(1637) = lu(1637) - lu(638) * lu(1632) + lu(1638) = lu(1638) - lu(639) * lu(1632) + lu(1639) = lu(1639) - lu(640) * lu(1632) + lu(1640) = lu(1640) - lu(641) * lu(1632) + lu(1641) = lu(1641) - lu(642) * lu(1632) + lu(1642) = lu(1642) - lu(643) * lu(1632) + lu(1643) = lu(1643) - lu(644) * lu(1632) + lu(1645) = lu(1645) - lu(645) * lu(1632) + lu(1646) = lu(1646) - lu(646) * lu(1632) + lu(1648) = lu(1648) - lu(647) * lu(1632) + lu(1649) = lu(1649) - lu(648) * lu(1632) + lu(1650) = lu(1650) - lu(649) * lu(1632) + lu(1651) = lu(1651) - lu(650) * lu(1632) + lu(1652) = lu(1652) - lu(651) * lu(1632) + lu(1653) = lu(1653) - lu(652) * lu(1632) + lu(1656) = lu(1656) - lu(653) * lu(1632) + lu(1657) = lu(1657) - lu(654) * lu(1632) + lu(1658) = lu(1658) - lu(655) * lu(1632) + lu(1659) = lu(1659) - lu(656) * lu(1632) + lu(1670) = - lu(637) * lu(1667) + lu(1671) = lu(1671) - lu(638) * lu(1667) + lu(1672) = lu(1672) - lu(639) * lu(1667) + lu(1673) = lu(1673) - lu(640) * lu(1667) + lu(1674) = lu(1674) - lu(641) * lu(1667) + lu(1675) = lu(1675) - lu(642) * lu(1667) + lu(1676) = lu(1676) - lu(643) * lu(1667) + lu(1677) = lu(1677) - lu(644) * lu(1667) + lu(1679) = lu(1679) - lu(645) * lu(1667) + lu(1680) = lu(1680) - lu(646) * lu(1667) + lu(1682) = lu(1682) - lu(647) * lu(1667) + lu(1683) = lu(1683) - lu(648) * lu(1667) + lu(1684) = lu(1684) - lu(649) * lu(1667) + lu(1685) = lu(1685) - lu(650) * lu(1667) + lu(1686) = lu(1686) - lu(651) * lu(1667) + lu(1687) = lu(1687) - lu(652) * lu(1667) + lu(1690) = lu(1690) - lu(653) * lu(1667) + lu(1691) = lu(1691) - lu(654) * lu(1667) + lu(1692) = lu(1692) - lu(655) * lu(1667) + lu(1693) = lu(1693) - lu(656) * lu(1667) + lu(1722) = lu(1722) - lu(637) * lu(1718) + lu(1723) = lu(1723) - lu(638) * lu(1718) + lu(1724) = lu(1724) - lu(639) * lu(1718) + lu(1725) = lu(1725) - lu(640) * lu(1718) + lu(1726) = lu(1726) - lu(641) * lu(1718) + lu(1727) = lu(1727) - lu(642) * lu(1718) + lu(1728) = lu(1728) - lu(643) * lu(1718) + lu(1729) = lu(1729) - lu(644) * lu(1718) + lu(1731) = lu(1731) - lu(645) * lu(1718) + lu(1732) = lu(1732) - lu(646) * lu(1718) + lu(1734) = lu(1734) - lu(647) * lu(1718) + lu(1735) = lu(1735) - lu(648) * lu(1718) + lu(1736) = lu(1736) - lu(649) * lu(1718) + lu(1737) = lu(1737) - lu(650) * lu(1718) + lu(1738) = lu(1738) - lu(651) * lu(1718) + lu(1739) = lu(1739) - lu(652) * lu(1718) + lu(1742) = lu(1742) - lu(653) * lu(1718) + lu(1743) = lu(1743) - lu(654) * lu(1718) + lu(1744) = lu(1744) - lu(655) * lu(1718) + lu(1745) = lu(1745) - lu(656) * lu(1718) end subroutine lu_fac15 - subroutine lu_fac16( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac16( lu ) 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,652) = 1._r8 / lu(k,652) - lu(k,653) = lu(k,653) * lu(k,652) - lu(k,654) = lu(k,654) * lu(k,652) - lu(k,655) = lu(k,655) * lu(k,652) - lu(k,656) = lu(k,656) * lu(k,652) - lu(k,657) = lu(k,657) * lu(k,652) - lu(k,658) = lu(k,658) * lu(k,652) - lu(k,659) = lu(k,659) * lu(k,652) - lu(k,660) = lu(k,660) * lu(k,652) - lu(k,661) = lu(k,661) * lu(k,652) - lu(k,662) = lu(k,662) * lu(k,652) - lu(k,663) = lu(k,663) * lu(k,652) - lu(k,664) = lu(k,664) * lu(k,652) - lu(k,665) = lu(k,665) * lu(k,652) - lu(k,666) = lu(k,666) * lu(k,652) - lu(k,667) = lu(k,667) * lu(k,652) - lu(k,668) = lu(k,668) * lu(k,652) - lu(k,669) = lu(k,669) * lu(k,652) - lu(k,670) = lu(k,670) * lu(k,652) - lu(k,671) = lu(k,671) * lu(k,652) - lu(k,672) = lu(k,672) * lu(k,652) - lu(k,712) = lu(k,712) - lu(k,653) * lu(k,711) - lu(k,714) = lu(k,714) - lu(k,654) * lu(k,711) - lu(k,715) = lu(k,715) - lu(k,655) * lu(k,711) - lu(k,716) = lu(k,716) - lu(k,656) * lu(k,711) - lu(k,717) = - lu(k,657) * lu(k,711) - lu(k,718) = lu(k,718) - lu(k,658) * lu(k,711) - lu(k,719) = lu(k,719) - lu(k,659) * lu(k,711) - lu(k,720) = lu(k,720) - lu(k,660) * lu(k,711) - lu(k,721) = lu(k,721) - lu(k,661) * lu(k,711) - lu(k,722) = lu(k,722) - lu(k,662) * lu(k,711) - lu(k,723) = lu(k,723) - lu(k,663) * lu(k,711) - lu(k,724) = lu(k,724) - lu(k,664) * lu(k,711) - lu(k,725) = lu(k,725) - lu(k,665) * lu(k,711) - lu(k,726) = lu(k,726) - lu(k,666) * lu(k,711) - lu(k,727) = lu(k,727) - lu(k,667) * lu(k,711) - lu(k,729) = lu(k,729) - lu(k,668) * lu(k,711) - lu(k,731) = lu(k,731) - lu(k,669) * lu(k,711) - lu(k,732) = lu(k,732) - lu(k,670) * lu(k,711) - lu(k,733) = lu(k,733) - lu(k,671) * lu(k,711) - lu(k,734) = lu(k,734) - lu(k,672) * lu(k,711) - lu(k,783) = lu(k,783) - lu(k,653) * lu(k,782) - lu(k,786) = lu(k,786) - lu(k,654) * lu(k,782) - lu(k,787) = lu(k,787) - lu(k,655) * lu(k,782) - lu(k,788) = lu(k,788) - lu(k,656) * lu(k,782) - lu(k,789) = lu(k,789) - lu(k,657) * lu(k,782) - lu(k,790) = lu(k,790) - lu(k,658) * lu(k,782) - lu(k,791) = lu(k,791) - lu(k,659) * lu(k,782) - lu(k,792) = lu(k,792) - lu(k,660) * lu(k,782) - lu(k,793) = lu(k,793) - lu(k,661) * lu(k,782) - lu(k,794) = lu(k,794) - lu(k,662) * lu(k,782) - lu(k,795) = lu(k,795) - lu(k,663) * lu(k,782) - lu(k,796) = lu(k,796) - lu(k,664) * lu(k,782) - lu(k,798) = lu(k,798) - lu(k,665) * lu(k,782) - lu(k,800) = lu(k,800) - lu(k,666) * lu(k,782) - lu(k,801) = lu(k,801) - lu(k,667) * lu(k,782) - lu(k,803) = lu(k,803) - lu(k,668) * lu(k,782) - lu(k,806) = lu(k,806) - lu(k,669) * lu(k,782) - lu(k,807) = lu(k,807) - lu(k,670) * lu(k,782) - lu(k,808) = lu(k,808) - lu(k,671) * lu(k,782) - lu(k,809) = lu(k,809) - lu(k,672) * lu(k,782) - lu(k,826) = lu(k,826) - lu(k,653) * lu(k,824) - lu(k,829) = lu(k,829) - lu(k,654) * lu(k,824) - lu(k,830) = lu(k,830) - lu(k,655) * lu(k,824) - lu(k,831) = lu(k,831) - lu(k,656) * lu(k,824) - lu(k,832) = lu(k,832) - lu(k,657) * lu(k,824) - lu(k,833) = lu(k,833) - lu(k,658) * lu(k,824) - lu(k,834) = lu(k,834) - lu(k,659) * lu(k,824) - lu(k,835) = lu(k,835) - lu(k,660) * lu(k,824) - lu(k,836) = lu(k,836) - lu(k,661) * lu(k,824) - lu(k,837) = lu(k,837) - lu(k,662) * lu(k,824) - lu(k,838) = lu(k,838) - lu(k,663) * lu(k,824) - lu(k,839) = lu(k,839) - lu(k,664) * lu(k,824) - lu(k,841) = lu(k,841) - lu(k,665) * lu(k,824) - lu(k,843) = lu(k,843) - lu(k,666) * lu(k,824) - lu(k,844) = lu(k,844) - lu(k,667) * lu(k,824) - lu(k,846) = lu(k,846) - lu(k,668) * lu(k,824) - lu(k,849) = lu(k,849) - lu(k,669) * lu(k,824) - lu(k,850) = lu(k,850) - lu(k,670) * lu(k,824) - lu(k,851) = lu(k,851) - lu(k,671) * lu(k,824) - lu(k,852) = lu(k,852) - lu(k,672) * lu(k,824) - lu(k,874) = lu(k,874) - lu(k,653) * lu(k,872) - lu(k,877) = lu(k,877) - lu(k,654) * lu(k,872) - lu(k,878) = lu(k,878) - lu(k,655) * lu(k,872) - lu(k,879) = lu(k,879) - lu(k,656) * lu(k,872) - lu(k,880) = lu(k,880) - lu(k,657) * lu(k,872) - lu(k,881) = lu(k,881) - lu(k,658) * lu(k,872) - lu(k,882) = lu(k,882) - lu(k,659) * lu(k,872) - lu(k,883) = lu(k,883) - lu(k,660) * lu(k,872) - lu(k,884) = lu(k,884) - lu(k,661) * lu(k,872) - lu(k,885) = lu(k,885) - lu(k,662) * lu(k,872) - lu(k,886) = lu(k,886) - lu(k,663) * lu(k,872) - lu(k,887) = lu(k,887) - lu(k,664) * lu(k,872) - lu(k,889) = lu(k,889) - lu(k,665) * lu(k,872) - lu(k,891) = lu(k,891) - lu(k,666) * lu(k,872) - lu(k,892) = lu(k,892) - lu(k,667) * lu(k,872) - lu(k,894) = lu(k,894) - lu(k,668) * lu(k,872) - lu(k,897) = lu(k,897) - lu(k,669) * lu(k,872) - lu(k,898) = lu(k,898) - lu(k,670) * lu(k,872) - lu(k,899) = lu(k,899) - lu(k,671) * lu(k,872) - lu(k,900) = lu(k,900) - lu(k,672) * lu(k,872) - lu(k,917) = lu(k,917) - lu(k,653) * lu(k,915) - lu(k,920) = lu(k,920) - lu(k,654) * lu(k,915) - lu(k,921) = lu(k,921) - lu(k,655) * lu(k,915) - lu(k,922) = lu(k,922) - lu(k,656) * lu(k,915) - lu(k,923) = lu(k,923) - lu(k,657) * lu(k,915) - lu(k,924) = lu(k,924) - lu(k,658) * lu(k,915) - lu(k,925) = lu(k,925) - lu(k,659) * lu(k,915) - lu(k,926) = lu(k,926) - lu(k,660) * lu(k,915) - lu(k,927) = lu(k,927) - lu(k,661) * lu(k,915) - lu(k,928) = lu(k,928) - lu(k,662) * lu(k,915) - lu(k,929) = lu(k,929) - lu(k,663) * lu(k,915) - lu(k,930) = lu(k,930) - lu(k,664) * lu(k,915) - lu(k,932) = lu(k,932) - lu(k,665) * lu(k,915) - lu(k,934) = lu(k,934) - lu(k,666) * lu(k,915) - lu(k,935) = lu(k,935) - lu(k,667) * lu(k,915) - lu(k,937) = lu(k,937) - lu(k,668) * lu(k,915) - lu(k,940) = lu(k,940) - lu(k,669) * lu(k,915) - lu(k,941) = lu(k,941) - lu(k,670) * lu(k,915) - lu(k,942) = lu(k,942) - lu(k,671) * lu(k,915) - lu(k,943) = lu(k,943) - lu(k,672) * lu(k,915) - lu(k,973) = lu(k,973) - lu(k,653) * lu(k,971) - lu(k,976) = lu(k,976) - lu(k,654) * lu(k,971) - lu(k,977) = lu(k,977) - lu(k,655) * lu(k,971) - lu(k,978) = lu(k,978) - lu(k,656) * lu(k,971) - lu(k,979) = lu(k,979) - lu(k,657) * lu(k,971) - lu(k,980) = lu(k,980) - lu(k,658) * lu(k,971) - lu(k,981) = lu(k,981) - lu(k,659) * lu(k,971) - lu(k,982) = lu(k,982) - lu(k,660) * lu(k,971) - lu(k,983) = lu(k,983) - lu(k,661) * lu(k,971) - lu(k,984) = lu(k,984) - lu(k,662) * lu(k,971) - lu(k,985) = lu(k,985) - lu(k,663) * lu(k,971) - lu(k,986) = lu(k,986) - lu(k,664) * lu(k,971) - lu(k,988) = lu(k,988) - lu(k,665) * lu(k,971) - lu(k,990) = lu(k,990) - lu(k,666) * lu(k,971) - lu(k,991) = lu(k,991) - lu(k,667) * lu(k,971) - lu(k,993) = lu(k,993) - lu(k,668) * lu(k,971) - lu(k,996) = lu(k,996) - lu(k,669) * lu(k,971) - lu(k,997) = lu(k,997) - lu(k,670) * lu(k,971) - lu(k,998) = lu(k,998) - lu(k,671) * lu(k,971) - lu(k,999) = lu(k,999) - lu(k,672) * lu(k,971) - lu(k,1058) = lu(k,1058) - lu(k,653) * lu(k,1056) - lu(k,1061) = lu(k,1061) - lu(k,654) * lu(k,1056) - lu(k,1062) = lu(k,1062) - lu(k,655) * lu(k,1056) - lu(k,1063) = lu(k,1063) - lu(k,656) * lu(k,1056) - lu(k,1064) = lu(k,1064) - lu(k,657) * lu(k,1056) - lu(k,1065) = lu(k,1065) - lu(k,658) * lu(k,1056) - lu(k,1066) = lu(k,1066) - lu(k,659) * lu(k,1056) - lu(k,1067) = lu(k,1067) - lu(k,660) * lu(k,1056) - lu(k,1068) = lu(k,1068) - lu(k,661) * lu(k,1056) - lu(k,1069) = lu(k,1069) - lu(k,662) * lu(k,1056) - lu(k,1070) = lu(k,1070) - lu(k,663) * lu(k,1056) - lu(k,1071) = lu(k,1071) - lu(k,664) * lu(k,1056) - lu(k,1073) = lu(k,1073) - lu(k,665) * lu(k,1056) - lu(k,1075) = lu(k,1075) - lu(k,666) * lu(k,1056) - lu(k,1076) = lu(k,1076) - lu(k,667) * lu(k,1056) - lu(k,1078) = lu(k,1078) - lu(k,668) * lu(k,1056) - lu(k,1081) = lu(k,1081) - lu(k,669) * lu(k,1056) - lu(k,1082) = lu(k,1082) - lu(k,670) * lu(k,1056) - lu(k,1083) = lu(k,1083) - lu(k,671) * lu(k,1056) - lu(k,1084) = lu(k,1084) - lu(k,672) * lu(k,1056) - lu(k,1098) = lu(k,1098) - lu(k,653) * lu(k,1096) - lu(k,1101) = lu(k,1101) - lu(k,654) * lu(k,1096) - lu(k,1102) = lu(k,1102) - lu(k,655) * lu(k,1096) - lu(k,1103) = lu(k,1103) - lu(k,656) * lu(k,1096) - lu(k,1104) = lu(k,1104) - lu(k,657) * lu(k,1096) - lu(k,1105) = lu(k,1105) - lu(k,658) * lu(k,1096) - lu(k,1106) = lu(k,1106) - lu(k,659) * lu(k,1096) - lu(k,1107) = lu(k,1107) - lu(k,660) * lu(k,1096) - lu(k,1108) = lu(k,1108) - lu(k,661) * lu(k,1096) - lu(k,1109) = lu(k,1109) - lu(k,662) * lu(k,1096) - lu(k,1110) = lu(k,1110) - lu(k,663) * lu(k,1096) - lu(k,1111) = lu(k,1111) - lu(k,664) * lu(k,1096) - lu(k,1113) = lu(k,1113) - lu(k,665) * lu(k,1096) - lu(k,1115) = lu(k,1115) - lu(k,666) * lu(k,1096) - lu(k,1116) = lu(k,1116) - lu(k,667) * lu(k,1096) - lu(k,1118) = lu(k,1118) - lu(k,668) * lu(k,1096) - lu(k,1121) = lu(k,1121) - lu(k,669) * lu(k,1096) - lu(k,1122) = lu(k,1122) - lu(k,670) * lu(k,1096) - lu(k,1123) = lu(k,1123) - lu(k,671) * lu(k,1096) - lu(k,1124) = lu(k,1124) - lu(k,672) * lu(k,1096) - lu(k,1143) = lu(k,1143) - lu(k,653) * lu(k,1141) - lu(k,1146) = lu(k,1146) - lu(k,654) * lu(k,1141) - lu(k,1147) = lu(k,1147) - lu(k,655) * lu(k,1141) - lu(k,1148) = lu(k,1148) - lu(k,656) * lu(k,1141) - lu(k,1149) = lu(k,1149) - lu(k,657) * lu(k,1141) - lu(k,1150) = lu(k,1150) - lu(k,658) * lu(k,1141) - lu(k,1151) = lu(k,1151) - lu(k,659) * lu(k,1141) - lu(k,1152) = lu(k,1152) - lu(k,660) * lu(k,1141) - lu(k,1153) = lu(k,1153) - lu(k,661) * lu(k,1141) - lu(k,1154) = lu(k,1154) - lu(k,662) * lu(k,1141) - lu(k,1155) = lu(k,1155) - lu(k,663) * lu(k,1141) - lu(k,1156) = lu(k,1156) - lu(k,664) * lu(k,1141) - lu(k,1158) = lu(k,1158) - lu(k,665) * lu(k,1141) - lu(k,1160) = lu(k,1160) - lu(k,666) * lu(k,1141) - lu(k,1161) = lu(k,1161) - lu(k,667) * lu(k,1141) - lu(k,1163) = lu(k,1163) - lu(k,668) * lu(k,1141) - lu(k,1166) = lu(k,1166) - lu(k,669) * lu(k,1141) - lu(k,1167) = lu(k,1167) - lu(k,670) * lu(k,1141) - lu(k,1168) = lu(k,1168) - lu(k,671) * lu(k,1141) - lu(k,1169) = lu(k,1169) - lu(k,672) * lu(k,1141) - lu(k,1186) = lu(k,1186) - lu(k,653) * lu(k,1184) - lu(k,1189) = lu(k,1189) - lu(k,654) * lu(k,1184) - lu(k,1190) = lu(k,1190) - lu(k,655) * lu(k,1184) - lu(k,1191) = lu(k,1191) - lu(k,656) * lu(k,1184) - lu(k,1192) = lu(k,1192) - lu(k,657) * lu(k,1184) - lu(k,1193) = lu(k,1193) - lu(k,658) * lu(k,1184) - lu(k,1194) = lu(k,1194) - lu(k,659) * lu(k,1184) - lu(k,1195) = lu(k,1195) - lu(k,660) * lu(k,1184) - lu(k,1196) = lu(k,1196) - lu(k,661) * lu(k,1184) - lu(k,1197) = lu(k,1197) - lu(k,662) * lu(k,1184) - lu(k,1198) = lu(k,1198) - lu(k,663) * lu(k,1184) - lu(k,1199) = lu(k,1199) - lu(k,664) * lu(k,1184) - lu(k,1201) = lu(k,1201) - lu(k,665) * lu(k,1184) - lu(k,1203) = lu(k,1203) - lu(k,666) * lu(k,1184) - lu(k,1204) = lu(k,1204) - lu(k,667) * lu(k,1184) - lu(k,1206) = lu(k,1206) - lu(k,668) * lu(k,1184) - lu(k,1209) = lu(k,1209) - lu(k,669) * lu(k,1184) - lu(k,1210) = lu(k,1210) - lu(k,670) * lu(k,1184) - lu(k,1211) = lu(k,1211) - lu(k,671) * lu(k,1184) - lu(k,1212) = lu(k,1212) - lu(k,672) * lu(k,1184) - lu(k,1222) = - lu(k,653) * lu(k,1220) - lu(k,1224) = lu(k,1224) - lu(k,654) * lu(k,1220) - lu(k,1225) = lu(k,1225) - lu(k,655) * lu(k,1220) - lu(k,1226) = lu(k,1226) - lu(k,656) * lu(k,1220) - lu(k,1227) = lu(k,1227) - lu(k,657) * lu(k,1220) - lu(k,1228) = lu(k,1228) - lu(k,658) * lu(k,1220) - lu(k,1229) = lu(k,1229) - lu(k,659) * lu(k,1220) - lu(k,1230) = lu(k,1230) - lu(k,660) * lu(k,1220) - lu(k,1231) = lu(k,1231) - lu(k,661) * lu(k,1220) - lu(k,1232) = lu(k,1232) - lu(k,662) * lu(k,1220) - lu(k,1233) = lu(k,1233) - lu(k,663) * lu(k,1220) - lu(k,1234) = lu(k,1234) - lu(k,664) * lu(k,1220) - lu(k,1236) = lu(k,1236) - lu(k,665) * lu(k,1220) - lu(k,1238) = lu(k,1238) - lu(k,666) * lu(k,1220) - lu(k,1239) = lu(k,1239) - lu(k,667) * lu(k,1220) - lu(k,1241) = lu(k,1241) - lu(k,668) * lu(k,1220) - lu(k,1244) = lu(k,1244) - lu(k,669) * lu(k,1220) - lu(k,1245) = lu(k,1245) - lu(k,670) * lu(k,1220) - lu(k,1246) = lu(k,1246) - lu(k,671) * lu(k,1220) - lu(k,1247) = lu(k,1247) - lu(k,672) * lu(k,1220) - lu(k,1264) = lu(k,1264) - lu(k,653) * lu(k,1262) - lu(k,1267) = lu(k,1267) - lu(k,654) * lu(k,1262) - lu(k,1268) = lu(k,1268) - lu(k,655) * lu(k,1262) - lu(k,1269) = lu(k,1269) - lu(k,656) * lu(k,1262) - lu(k,1270) = lu(k,1270) - lu(k,657) * lu(k,1262) - lu(k,1271) = lu(k,1271) - lu(k,658) * lu(k,1262) - lu(k,1272) = lu(k,1272) - lu(k,659) * lu(k,1262) - lu(k,1273) = lu(k,1273) - lu(k,660) * lu(k,1262) - lu(k,1274) = lu(k,1274) - lu(k,661) * lu(k,1262) - lu(k,1275) = lu(k,1275) - lu(k,662) * lu(k,1262) - lu(k,1276) = lu(k,1276) - lu(k,663) * lu(k,1262) - lu(k,1277) = lu(k,1277) - lu(k,664) * lu(k,1262) - lu(k,1279) = lu(k,1279) - lu(k,665) * lu(k,1262) - lu(k,1281) = lu(k,1281) - lu(k,666) * lu(k,1262) - lu(k,1282) = lu(k,1282) - lu(k,667) * lu(k,1262) - lu(k,1284) = lu(k,1284) - lu(k,668) * lu(k,1262) - lu(k,1287) = lu(k,1287) - lu(k,669) * lu(k,1262) - lu(k,1288) = lu(k,1288) - lu(k,670) * lu(k,1262) - lu(k,1289) = lu(k,1289) - lu(k,671) * lu(k,1262) - lu(k,1290) = lu(k,1290) - lu(k,672) * lu(k,1262) - lu(k,1300) = lu(k,1300) - lu(k,653) * lu(k,1298) - lu(k,1303) = lu(k,1303) - lu(k,654) * lu(k,1298) - lu(k,1304) = lu(k,1304) - lu(k,655) * lu(k,1298) - lu(k,1305) = lu(k,1305) - lu(k,656) * lu(k,1298) - lu(k,1306) = lu(k,1306) - lu(k,657) * lu(k,1298) - lu(k,1307) = lu(k,1307) - lu(k,658) * lu(k,1298) - lu(k,1308) = lu(k,1308) - lu(k,659) * lu(k,1298) - lu(k,1309) = lu(k,1309) - lu(k,660) * lu(k,1298) - lu(k,1310) = lu(k,1310) - lu(k,661) * lu(k,1298) - lu(k,1311) = lu(k,1311) - lu(k,662) * lu(k,1298) - lu(k,1312) = - lu(k,663) * lu(k,1298) - lu(k,1313) = lu(k,1313) - lu(k,664) * lu(k,1298) - lu(k,1315) = lu(k,1315) - lu(k,665) * lu(k,1298) - lu(k,1317) = lu(k,1317) - lu(k,666) * lu(k,1298) - lu(k,1318) = lu(k,1318) - lu(k,667) * lu(k,1298) - lu(k,1320) = lu(k,1320) - lu(k,668) * lu(k,1298) - lu(k,1323) = lu(k,1323) - lu(k,669) * lu(k,1298) - lu(k,1324) = lu(k,1324) - lu(k,670) * lu(k,1298) - lu(k,1325) = lu(k,1325) - lu(k,671) * lu(k,1298) - lu(k,1326) = lu(k,1326) - lu(k,672) * lu(k,1298) - lu(k,1345) = lu(k,1345) - lu(k,653) * lu(k,1343) - lu(k,1348) = lu(k,1348) - lu(k,654) * lu(k,1343) - lu(k,1349) = lu(k,1349) - lu(k,655) * lu(k,1343) - lu(k,1350) = lu(k,1350) - lu(k,656) * lu(k,1343) - lu(k,1351) = lu(k,1351) - lu(k,657) * lu(k,1343) - lu(k,1352) = lu(k,1352) - lu(k,658) * lu(k,1343) - lu(k,1353) = lu(k,1353) - lu(k,659) * lu(k,1343) - lu(k,1354) = lu(k,1354) - lu(k,660) * lu(k,1343) - lu(k,1355) = lu(k,1355) - lu(k,661) * lu(k,1343) - lu(k,1356) = lu(k,1356) - lu(k,662) * lu(k,1343) - lu(k,1357) = lu(k,1357) - lu(k,663) * lu(k,1343) - lu(k,1358) = lu(k,1358) - lu(k,664) * lu(k,1343) - lu(k,1360) = lu(k,1360) - lu(k,665) * lu(k,1343) - lu(k,1362) = lu(k,1362) - lu(k,666) * lu(k,1343) - lu(k,1363) = lu(k,1363) - lu(k,667) * lu(k,1343) - lu(k,1365) = lu(k,1365) - lu(k,668) * lu(k,1343) - lu(k,1368) = lu(k,1368) - lu(k,669) * lu(k,1343) - lu(k,1369) = lu(k,1369) - lu(k,670) * lu(k,1343) - lu(k,1370) = lu(k,1370) - lu(k,671) * lu(k,1343) - lu(k,1371) = lu(k,1371) - lu(k,672) * lu(k,1343) - lu(k,1387) = lu(k,1387) - lu(k,653) * lu(k,1385) - lu(k,1390) = lu(k,1390) - lu(k,654) * lu(k,1385) - lu(k,1391) = lu(k,1391) - lu(k,655) * lu(k,1385) - lu(k,1392) = lu(k,1392) - lu(k,656) * lu(k,1385) - lu(k,1393) = lu(k,1393) - lu(k,657) * lu(k,1385) - lu(k,1394) = lu(k,1394) - lu(k,658) * lu(k,1385) - lu(k,1395) = lu(k,1395) - lu(k,659) * lu(k,1385) - lu(k,1396) = lu(k,1396) - lu(k,660) * lu(k,1385) - lu(k,1397) = lu(k,1397) - lu(k,661) * lu(k,1385) - lu(k,1398) = lu(k,1398) - lu(k,662) * lu(k,1385) - lu(k,1399) = lu(k,1399) - lu(k,663) * lu(k,1385) - lu(k,1400) = lu(k,1400) - lu(k,664) * lu(k,1385) - lu(k,1402) = lu(k,1402) - lu(k,665) * lu(k,1385) - lu(k,1404) = lu(k,1404) - lu(k,666) * lu(k,1385) - lu(k,1405) = lu(k,1405) - lu(k,667) * lu(k,1385) - lu(k,1407) = lu(k,1407) - lu(k,668) * lu(k,1385) - lu(k,1410) = lu(k,1410) - lu(k,669) * lu(k,1385) - lu(k,1411) = lu(k,1411) - lu(k,670) * lu(k,1385) - lu(k,1412) = lu(k,1412) - lu(k,671) * lu(k,1385) - lu(k,1413) = lu(k,1413) - lu(k,672) * lu(k,1385) - lu(k,1425) = lu(k,1425) - lu(k,653) * lu(k,1423) - lu(k,1428) = lu(k,1428) - lu(k,654) * lu(k,1423) - lu(k,1429) = lu(k,1429) - lu(k,655) * lu(k,1423) - lu(k,1430) = lu(k,1430) - lu(k,656) * lu(k,1423) - lu(k,1431) = lu(k,1431) - lu(k,657) * lu(k,1423) - lu(k,1432) = lu(k,1432) - lu(k,658) * lu(k,1423) - lu(k,1433) = lu(k,1433) - lu(k,659) * lu(k,1423) - lu(k,1434) = lu(k,1434) - lu(k,660) * lu(k,1423) - lu(k,1435) = lu(k,1435) - lu(k,661) * lu(k,1423) - lu(k,1436) = lu(k,1436) - lu(k,662) * lu(k,1423) - lu(k,1437) = lu(k,1437) - lu(k,663) * lu(k,1423) - lu(k,1438) = lu(k,1438) - lu(k,664) * lu(k,1423) - lu(k,1440) = lu(k,1440) - lu(k,665) * lu(k,1423) - lu(k,1442) = lu(k,1442) - lu(k,666) * lu(k,1423) - lu(k,1443) = lu(k,1443) - lu(k,667) * lu(k,1423) - lu(k,1445) = lu(k,1445) - lu(k,668) * lu(k,1423) - lu(k,1448) = lu(k,1448) - lu(k,669) * lu(k,1423) - lu(k,1449) = lu(k,1449) - lu(k,670) * lu(k,1423) - lu(k,1450) = lu(k,1450) - lu(k,671) * lu(k,1423) - lu(k,1451) = lu(k,1451) - lu(k,672) * lu(k,1423) - lu(k,1470) = lu(k,1470) - lu(k,653) * lu(k,1468) - lu(k,1473) = lu(k,1473) - lu(k,654) * lu(k,1468) - lu(k,1474) = lu(k,1474) - lu(k,655) * lu(k,1468) - lu(k,1475) = lu(k,1475) - lu(k,656) * lu(k,1468) - lu(k,1476) = lu(k,1476) - lu(k,657) * lu(k,1468) - lu(k,1477) = lu(k,1477) - lu(k,658) * lu(k,1468) - lu(k,1478) = lu(k,1478) - lu(k,659) * lu(k,1468) - lu(k,1479) = lu(k,1479) - lu(k,660) * lu(k,1468) - lu(k,1480) = lu(k,1480) - lu(k,661) * lu(k,1468) - lu(k,1481) = lu(k,1481) - lu(k,662) * lu(k,1468) - lu(k,1482) = lu(k,1482) - lu(k,663) * lu(k,1468) - lu(k,1483) = lu(k,1483) - lu(k,664) * lu(k,1468) - lu(k,1485) = lu(k,1485) - lu(k,665) * lu(k,1468) - lu(k,1487) = lu(k,1487) - lu(k,666) * lu(k,1468) - lu(k,1488) = lu(k,1488) - lu(k,667) * lu(k,1468) - lu(k,1490) = lu(k,1490) - lu(k,668) * lu(k,1468) - lu(k,1493) = lu(k,1493) - lu(k,669) * lu(k,1468) - lu(k,1494) = lu(k,1494) - lu(k,670) * lu(k,1468) - lu(k,1495) = lu(k,1495) - lu(k,671) * lu(k,1468) - lu(k,1496) = lu(k,1496) - lu(k,672) * lu(k,1468) - lu(k,1513) = lu(k,1513) - lu(k,653) * lu(k,1511) - lu(k,1516) = lu(k,1516) - lu(k,654) * lu(k,1511) - lu(k,1517) = lu(k,1517) - lu(k,655) * lu(k,1511) - lu(k,1518) = lu(k,1518) - lu(k,656) * lu(k,1511) - lu(k,1519) = lu(k,1519) - lu(k,657) * lu(k,1511) - lu(k,1520) = lu(k,1520) - lu(k,658) * lu(k,1511) - lu(k,1521) = lu(k,1521) - lu(k,659) * lu(k,1511) - lu(k,1522) = lu(k,1522) - lu(k,660) * lu(k,1511) - lu(k,1523) = lu(k,1523) - lu(k,661) * lu(k,1511) - lu(k,1524) = lu(k,1524) - lu(k,662) * lu(k,1511) - lu(k,1525) = lu(k,1525) - lu(k,663) * lu(k,1511) - lu(k,1526) = lu(k,1526) - lu(k,664) * lu(k,1511) - lu(k,1528) = lu(k,1528) - lu(k,665) * lu(k,1511) - lu(k,1530) = lu(k,1530) - lu(k,666) * lu(k,1511) - lu(k,1531) = lu(k,1531) - lu(k,667) * lu(k,1511) - lu(k,1533) = lu(k,1533) - lu(k,668) * lu(k,1511) - lu(k,1536) = lu(k,1536) - lu(k,669) * lu(k,1511) - lu(k,1537) = lu(k,1537) - lu(k,670) * lu(k,1511) - lu(k,1538) = lu(k,1538) - lu(k,671) * lu(k,1511) - lu(k,1539) = lu(k,1539) - lu(k,672) * lu(k,1511) - lu(k,1556) = lu(k,1556) - lu(k,653) * lu(k,1554) - lu(k,1559) = lu(k,1559) - lu(k,654) * lu(k,1554) - lu(k,1560) = lu(k,1560) - lu(k,655) * lu(k,1554) - lu(k,1561) = lu(k,1561) - lu(k,656) * lu(k,1554) - lu(k,1562) = lu(k,1562) - lu(k,657) * lu(k,1554) - lu(k,1563) = lu(k,1563) - lu(k,658) * lu(k,1554) - lu(k,1564) = lu(k,1564) - lu(k,659) * lu(k,1554) - lu(k,1565) = lu(k,1565) - lu(k,660) * lu(k,1554) - lu(k,1566) = lu(k,1566) - lu(k,661) * lu(k,1554) - lu(k,1567) = lu(k,1567) - lu(k,662) * lu(k,1554) - lu(k,1568) = lu(k,1568) - lu(k,663) * lu(k,1554) - lu(k,1569) = lu(k,1569) - lu(k,664) * lu(k,1554) - lu(k,1571) = lu(k,1571) - lu(k,665) * lu(k,1554) - lu(k,1573) = lu(k,1573) - lu(k,666) * lu(k,1554) - lu(k,1574) = lu(k,1574) - lu(k,667) * lu(k,1554) - lu(k,1576) = lu(k,1576) - lu(k,668) * lu(k,1554) - lu(k,1579) = lu(k,1579) - lu(k,669) * lu(k,1554) - lu(k,1580) = lu(k,1580) - lu(k,670) * lu(k,1554) - lu(k,1581) = lu(k,1581) - lu(k,671) * lu(k,1554) - lu(k,1582) = lu(k,1582) - lu(k,672) * lu(k,1554) - lu(k,1589) = lu(k,1589) - lu(k,653) * lu(k,1587) - lu(k,1592) = lu(k,1592) - lu(k,654) * lu(k,1587) - lu(k,1593) = lu(k,1593) - lu(k,655) * lu(k,1587) - lu(k,1594) = lu(k,1594) - lu(k,656) * lu(k,1587) - lu(k,1595) = lu(k,1595) - lu(k,657) * lu(k,1587) - lu(k,1596) = lu(k,1596) - lu(k,658) * lu(k,1587) - lu(k,1597) = lu(k,1597) - lu(k,659) * lu(k,1587) - lu(k,1598) = lu(k,1598) - lu(k,660) * lu(k,1587) - lu(k,1599) = lu(k,1599) - lu(k,661) * lu(k,1587) - lu(k,1600) = lu(k,1600) - lu(k,662) * lu(k,1587) - lu(k,1601) = - lu(k,663) * lu(k,1587) - lu(k,1602) = lu(k,1602) - lu(k,664) * lu(k,1587) - lu(k,1604) = lu(k,1604) - lu(k,665) * lu(k,1587) - lu(k,1606) = lu(k,1606) - lu(k,666) * lu(k,1587) - lu(k,1607) = lu(k,1607) - lu(k,667) * lu(k,1587) - lu(k,1609) = lu(k,1609) - lu(k,668) * lu(k,1587) - lu(k,1612) = lu(k,1612) - lu(k,669) * lu(k,1587) - lu(k,1613) = lu(k,1613) - lu(k,670) * lu(k,1587) - lu(k,1614) = lu(k,1614) - lu(k,671) * lu(k,1587) - lu(k,1615) = lu(k,1615) - lu(k,672) * lu(k,1587) - lu(k,1625) = lu(k,1625) - lu(k,653) * lu(k,1623) - lu(k,1628) = lu(k,1628) - lu(k,654) * lu(k,1623) - lu(k,1629) = lu(k,1629) - lu(k,655) * lu(k,1623) - lu(k,1630) = lu(k,1630) - lu(k,656) * lu(k,1623) - lu(k,1631) = lu(k,1631) - lu(k,657) * lu(k,1623) - lu(k,1632) = lu(k,1632) - lu(k,658) * lu(k,1623) - lu(k,1633) = lu(k,1633) - lu(k,659) * lu(k,1623) - lu(k,1634) = lu(k,1634) - lu(k,660) * lu(k,1623) - lu(k,1635) = lu(k,1635) - lu(k,661) * lu(k,1623) - lu(k,1636) = lu(k,1636) - lu(k,662) * lu(k,1623) - lu(k,1637) = lu(k,1637) - lu(k,663) * lu(k,1623) - lu(k,1638) = lu(k,1638) - lu(k,664) * lu(k,1623) - lu(k,1640) = lu(k,1640) - lu(k,665) * lu(k,1623) - lu(k,1642) = lu(k,1642) - lu(k,666) * lu(k,1623) - lu(k,1643) = lu(k,1643) - lu(k,667) * lu(k,1623) - lu(k,1645) = lu(k,1645) - lu(k,668) * lu(k,1623) - lu(k,1648) = lu(k,1648) - lu(k,669) * lu(k,1623) - lu(k,1649) = lu(k,1649) - lu(k,670) * lu(k,1623) - lu(k,1650) = lu(k,1650) - lu(k,671) * lu(k,1623) - lu(k,1651) = lu(k,1651) - lu(k,672) * lu(k,1623) - lu(k,1668) = lu(k,1668) - lu(k,653) * lu(k,1666) - lu(k,1671) = lu(k,1671) - lu(k,654) * lu(k,1666) - lu(k,1672) = lu(k,1672) - lu(k,655) * lu(k,1666) - lu(k,1673) = lu(k,1673) - lu(k,656) * lu(k,1666) - lu(k,1674) = lu(k,1674) - lu(k,657) * lu(k,1666) - lu(k,1675) = lu(k,1675) - lu(k,658) * lu(k,1666) - lu(k,1676) = lu(k,1676) - lu(k,659) * lu(k,1666) - lu(k,1677) = lu(k,1677) - lu(k,660) * lu(k,1666) - lu(k,1678) = lu(k,1678) - lu(k,661) * lu(k,1666) - lu(k,1679) = lu(k,1679) - lu(k,662) * lu(k,1666) - lu(k,1680) = lu(k,1680) - lu(k,663) * lu(k,1666) - lu(k,1681) = lu(k,1681) - lu(k,664) * lu(k,1666) - lu(k,1683) = lu(k,1683) - lu(k,665) * lu(k,1666) - lu(k,1685) = lu(k,1685) - lu(k,666) * lu(k,1666) - lu(k,1686) = lu(k,1686) - lu(k,667) * lu(k,1666) - lu(k,1688) = lu(k,1688) - lu(k,668) * lu(k,1666) - lu(k,1691) = lu(k,1691) - lu(k,669) * lu(k,1666) - lu(k,1692) = lu(k,1692) - lu(k,670) * lu(k,1666) - lu(k,1693) = lu(k,1693) - lu(k,671) * lu(k,1666) - lu(k,1694) = lu(k,1694) - lu(k,672) * lu(k,1666) - lu(k,1704) = lu(k,1704) - lu(k,653) * lu(k,1702) - lu(k,1707) = lu(k,1707) - lu(k,654) * lu(k,1702) - lu(k,1708) = lu(k,1708) - lu(k,655) * lu(k,1702) - lu(k,1709) = lu(k,1709) - lu(k,656) * lu(k,1702) - lu(k,1710) = lu(k,1710) - lu(k,657) * lu(k,1702) - lu(k,1711) = lu(k,1711) - lu(k,658) * lu(k,1702) - lu(k,1712) = lu(k,1712) - lu(k,659) * lu(k,1702) - lu(k,1713) = lu(k,1713) - lu(k,660) * lu(k,1702) - lu(k,1714) = lu(k,1714) - lu(k,661) * lu(k,1702) - lu(k,1715) = lu(k,1715) - lu(k,662) * lu(k,1702) - lu(k,1716) = lu(k,1716) - lu(k,663) * lu(k,1702) - lu(k,1717) = lu(k,1717) - lu(k,664) * lu(k,1702) - lu(k,1719) = lu(k,1719) - lu(k,665) * lu(k,1702) - lu(k,1721) = lu(k,1721) - lu(k,666) * lu(k,1702) - lu(k,1722) = lu(k,1722) - lu(k,667) * lu(k,1702) - lu(k,1724) = lu(k,1724) - lu(k,668) * lu(k,1702) - lu(k,1727) = lu(k,1727) - lu(k,669) * lu(k,1702) - lu(k,1728) = lu(k,1728) - lu(k,670) * lu(k,1702) - lu(k,1729) = lu(k,1729) - lu(k,671) * lu(k,1702) - lu(k,1730) = lu(k,1730) - lu(k,672) * lu(k,1702) - lu(k,1746) = lu(k,1746) - lu(k,653) * lu(k,1744) - lu(k,1749) = lu(k,1749) - lu(k,654) * lu(k,1744) - lu(k,1750) = lu(k,1750) - lu(k,655) * lu(k,1744) - lu(k,1751) = lu(k,1751) - lu(k,656) * lu(k,1744) - lu(k,1752) = lu(k,1752) - lu(k,657) * lu(k,1744) - lu(k,1753) = lu(k,1753) - lu(k,658) * lu(k,1744) - lu(k,1754) = lu(k,1754) - lu(k,659) * lu(k,1744) - lu(k,1755) = lu(k,1755) - lu(k,660) * lu(k,1744) - lu(k,1756) = lu(k,1756) - lu(k,661) * lu(k,1744) - lu(k,1757) = lu(k,1757) - lu(k,662) * lu(k,1744) - lu(k,1758) = lu(k,1758) - lu(k,663) * lu(k,1744) - lu(k,1759) = lu(k,1759) - lu(k,664) * lu(k,1744) - lu(k,1761) = lu(k,1761) - lu(k,665) * lu(k,1744) - lu(k,1763) = lu(k,1763) - lu(k,666) * lu(k,1744) - lu(k,1764) = lu(k,1764) - lu(k,667) * lu(k,1744) - lu(k,1766) = lu(k,1766) - lu(k,668) * lu(k,1744) - lu(k,1769) = lu(k,1769) - lu(k,669) * lu(k,1744) - lu(k,1770) = lu(k,1770) - lu(k,670) * lu(k,1744) - lu(k,1771) = lu(k,1771) - lu(k,671) * lu(k,1744) - lu(k,1772) = lu(k,1772) - lu(k,672) * lu(k,1744) - lu(k,1799) = lu(k,1799) - lu(k,653) * lu(k,1797) - lu(k,1802) = lu(k,1802) - lu(k,654) * lu(k,1797) - lu(k,1803) = lu(k,1803) - lu(k,655) * lu(k,1797) - lu(k,1804) = lu(k,1804) - lu(k,656) * lu(k,1797) - lu(k,1805) = lu(k,1805) - lu(k,657) * lu(k,1797) - lu(k,1806) = lu(k,1806) - lu(k,658) * lu(k,1797) - lu(k,1807) = lu(k,1807) - lu(k,659) * lu(k,1797) - lu(k,1808) = lu(k,1808) - lu(k,660) * lu(k,1797) - lu(k,1809) = lu(k,1809) - lu(k,661) * lu(k,1797) - lu(k,1810) = lu(k,1810) - lu(k,662) * lu(k,1797) - lu(k,1811) = lu(k,1811) - lu(k,663) * lu(k,1797) - lu(k,1812) = lu(k,1812) - lu(k,664) * lu(k,1797) - lu(k,1814) = lu(k,1814) - lu(k,665) * lu(k,1797) - lu(k,1816) = lu(k,1816) - lu(k,666) * lu(k,1797) - lu(k,1817) = lu(k,1817) - lu(k,667) * lu(k,1797) - lu(k,1819) = lu(k,1819) - lu(k,668) * lu(k,1797) - lu(k,1822) = lu(k,1822) - lu(k,669) * lu(k,1797) - lu(k,1823) = lu(k,1823) - lu(k,670) * lu(k,1797) - lu(k,1824) = lu(k,1824) - lu(k,671) * lu(k,1797) - lu(k,1825) = lu(k,1825) - lu(k,672) * lu(k,1797) - lu(k,686) = 1._r8 / lu(k,686) - lu(k,687) = lu(k,687) * lu(k,686) - lu(k,688) = lu(k,688) * lu(k,686) - lu(k,689) = lu(k,689) * lu(k,686) - lu(k,690) = lu(k,690) * lu(k,686) - lu(k,691) = lu(k,691) * lu(k,686) - lu(k,692) = lu(k,692) * lu(k,686) - lu(k,693) = lu(k,693) * lu(k,686) - lu(k,694) = lu(k,694) * lu(k,686) - lu(k,695) = lu(k,695) * lu(k,686) - lu(k,696) = lu(k,696) * lu(k,686) - lu(k,697) = lu(k,697) * lu(k,686) - lu(k,698) = lu(k,698) * lu(k,686) - lu(k,699) = lu(k,699) * lu(k,686) - lu(k,700) = lu(k,700) * lu(k,686) - lu(k,701) = lu(k,701) * lu(k,686) - lu(k,702) = lu(k,702) * lu(k,686) - lu(k,703) = lu(k,703) * lu(k,686) - lu(k,704) = lu(k,704) * lu(k,686) - lu(k,705) = lu(k,705) * lu(k,686) - lu(k,706) = lu(k,706) * lu(k,686) - lu(k,707) = lu(k,707) * lu(k,686) - lu(k,755) = lu(k,755) - lu(k,687) * lu(k,754) - lu(k,756) = lu(k,756) - lu(k,688) * lu(k,754) - lu(k,758) = lu(k,758) - lu(k,689) * lu(k,754) - lu(k,759) = lu(k,759) - lu(k,690) * lu(k,754) - lu(k,760) = lu(k,760) - lu(k,691) * lu(k,754) - lu(k,761) = lu(k,761) - lu(k,692) * lu(k,754) - lu(k,762) = lu(k,762) - lu(k,693) * lu(k,754) - lu(k,763) = lu(k,763) - lu(k,694) * lu(k,754) - lu(k,764) = lu(k,764) - lu(k,695) * lu(k,754) - lu(k,765) = lu(k,765) - lu(k,696) * lu(k,754) - lu(k,766) = lu(k,766) - lu(k,697) * lu(k,754) - lu(k,767) = lu(k,767) - lu(k,698) * lu(k,754) - lu(k,768) = lu(k,768) - lu(k,699) * lu(k,754) - lu(k,769) = lu(k,769) - lu(k,700) * lu(k,754) - lu(k,770) = lu(k,770) - lu(k,701) * lu(k,754) - lu(k,771) = lu(k,771) - lu(k,702) * lu(k,754) - lu(k,772) = lu(k,772) - lu(k,703) * lu(k,754) - lu(k,773) = lu(k,773) - lu(k,704) * lu(k,754) - lu(k,774) = lu(k,774) - lu(k,705) * lu(k,754) - lu(k,775) = lu(k,775) - lu(k,706) * lu(k,754) - lu(k,776) = lu(k,776) - lu(k,707) * lu(k,754) - lu(k,827) = lu(k,827) - lu(k,687) * lu(k,825) - lu(k,829) = lu(k,829) - lu(k,688) * lu(k,825) - lu(k,832) = lu(k,832) - lu(k,689) * lu(k,825) - lu(k,833) = lu(k,833) - lu(k,690) * lu(k,825) - lu(k,834) = lu(k,834) - lu(k,691) * lu(k,825) - lu(k,835) = lu(k,835) - lu(k,692) * lu(k,825) - lu(k,836) = lu(k,836) - lu(k,693) * lu(k,825) - lu(k,838) = lu(k,838) - lu(k,694) * lu(k,825) - lu(k,839) = lu(k,839) - lu(k,695) * lu(k,825) - lu(k,840) = lu(k,840) - lu(k,696) * lu(k,825) - lu(k,841) = lu(k,841) - lu(k,697) * lu(k,825) - lu(k,842) = lu(k,842) - lu(k,698) * lu(k,825) - lu(k,843) = lu(k,843) - lu(k,699) * lu(k,825) - lu(k,844) = lu(k,844) - lu(k,700) * lu(k,825) - lu(k,845) = lu(k,845) - lu(k,701) * lu(k,825) - lu(k,847) = lu(k,847) - lu(k,702) * lu(k,825) - lu(k,848) = lu(k,848) - lu(k,703) * lu(k,825) - lu(k,849) = lu(k,849) - lu(k,704) * lu(k,825) - lu(k,850) = lu(k,850) - lu(k,705) * lu(k,825) - lu(k,851) = lu(k,851) - lu(k,706) * lu(k,825) - lu(k,852) = lu(k,852) - lu(k,707) * lu(k,825) - lu(k,875) = lu(k,875) - lu(k,687) * lu(k,873) - lu(k,877) = lu(k,877) - lu(k,688) * lu(k,873) - lu(k,880) = lu(k,880) - lu(k,689) * lu(k,873) - lu(k,881) = lu(k,881) - lu(k,690) * lu(k,873) - lu(k,882) = lu(k,882) - lu(k,691) * lu(k,873) - lu(k,883) = lu(k,883) - lu(k,692) * lu(k,873) - lu(k,884) = lu(k,884) - lu(k,693) * lu(k,873) - lu(k,886) = lu(k,886) - lu(k,694) * lu(k,873) - lu(k,887) = lu(k,887) - lu(k,695) * lu(k,873) - lu(k,888) = lu(k,888) - lu(k,696) * lu(k,873) - lu(k,889) = lu(k,889) - lu(k,697) * lu(k,873) - lu(k,890) = lu(k,890) - lu(k,698) * lu(k,873) - lu(k,891) = lu(k,891) - lu(k,699) * lu(k,873) - lu(k,892) = lu(k,892) - lu(k,700) * lu(k,873) - lu(k,893) = lu(k,893) - lu(k,701) * lu(k,873) - lu(k,895) = lu(k,895) - lu(k,702) * lu(k,873) - lu(k,896) = lu(k,896) - lu(k,703) * lu(k,873) - lu(k,897) = lu(k,897) - lu(k,704) * lu(k,873) - lu(k,898) = lu(k,898) - lu(k,705) * lu(k,873) - lu(k,899) = lu(k,899) - lu(k,706) * lu(k,873) - lu(k,900) = lu(k,900) - lu(k,707) * lu(k,873) - lu(k,918) = lu(k,918) - lu(k,687) * lu(k,916) - lu(k,920) = lu(k,920) - lu(k,688) * lu(k,916) - lu(k,923) = lu(k,923) - lu(k,689) * lu(k,916) - lu(k,924) = lu(k,924) - lu(k,690) * lu(k,916) - lu(k,925) = lu(k,925) - lu(k,691) * lu(k,916) - lu(k,926) = lu(k,926) - lu(k,692) * lu(k,916) - lu(k,927) = lu(k,927) - lu(k,693) * lu(k,916) - lu(k,929) = lu(k,929) - lu(k,694) * lu(k,916) - lu(k,930) = lu(k,930) - lu(k,695) * lu(k,916) - lu(k,931) = lu(k,931) - lu(k,696) * lu(k,916) - lu(k,932) = lu(k,932) - lu(k,697) * lu(k,916) - lu(k,933) = lu(k,933) - lu(k,698) * lu(k,916) - lu(k,934) = lu(k,934) - lu(k,699) * lu(k,916) - lu(k,935) = lu(k,935) - lu(k,700) * lu(k,916) - lu(k,936) = lu(k,936) - lu(k,701) * lu(k,916) - lu(k,938) = lu(k,938) - lu(k,702) * lu(k,916) - lu(k,939) = lu(k,939) - lu(k,703) * lu(k,916) - lu(k,940) = lu(k,940) - lu(k,704) * lu(k,916) - lu(k,941) = lu(k,941) - lu(k,705) * lu(k,916) - lu(k,942) = lu(k,942) - lu(k,706) * lu(k,916) - lu(k,943) = lu(k,943) - lu(k,707) * lu(k,916) - lu(k,974) = lu(k,974) - lu(k,687) * lu(k,972) - lu(k,976) = lu(k,976) - lu(k,688) * lu(k,972) - lu(k,979) = lu(k,979) - lu(k,689) * lu(k,972) - lu(k,980) = lu(k,980) - lu(k,690) * lu(k,972) - lu(k,981) = lu(k,981) - lu(k,691) * lu(k,972) - lu(k,982) = lu(k,982) - lu(k,692) * lu(k,972) - lu(k,983) = lu(k,983) - lu(k,693) * lu(k,972) - lu(k,985) = lu(k,985) - lu(k,694) * lu(k,972) - lu(k,986) = lu(k,986) - lu(k,695) * lu(k,972) - lu(k,987) = lu(k,987) - lu(k,696) * lu(k,972) - lu(k,988) = lu(k,988) - lu(k,697) * lu(k,972) - lu(k,989) = lu(k,989) - lu(k,698) * lu(k,972) - lu(k,990) = lu(k,990) - lu(k,699) * lu(k,972) - lu(k,991) = lu(k,991) - lu(k,700) * lu(k,972) - lu(k,992) = lu(k,992) - lu(k,701) * lu(k,972) - lu(k,994) = lu(k,994) - lu(k,702) * lu(k,972) - lu(k,995) = lu(k,995) - lu(k,703) * lu(k,972) - lu(k,996) = lu(k,996) - lu(k,704) * lu(k,972) - lu(k,997) = lu(k,997) - lu(k,705) * lu(k,972) - lu(k,998) = lu(k,998) - lu(k,706) * lu(k,972) - lu(k,999) = lu(k,999) - lu(k,707) * lu(k,972) - lu(k,1018) = lu(k,1018) - lu(k,687) * lu(k,1017) - lu(k,1019) = lu(k,1019) - lu(k,688) * lu(k,1017) - lu(k,1022) = lu(k,1022) - lu(k,689) * lu(k,1017) - lu(k,1023) = lu(k,1023) - lu(k,690) * lu(k,1017) - lu(k,1024) = lu(k,1024) - lu(k,691) * lu(k,1017) - lu(k,1025) = lu(k,1025) - lu(k,692) * lu(k,1017) - lu(k,1026) = lu(k,1026) - lu(k,693) * lu(k,1017) - lu(k,1028) = lu(k,1028) - lu(k,694) * lu(k,1017) - lu(k,1029) = lu(k,1029) - lu(k,695) * lu(k,1017) - lu(k,1030) = lu(k,1030) - lu(k,696) * lu(k,1017) - lu(k,1031) = lu(k,1031) - lu(k,697) * lu(k,1017) - lu(k,1032) = lu(k,1032) - lu(k,698) * lu(k,1017) - lu(k,1033) = lu(k,1033) - lu(k,699) * lu(k,1017) - lu(k,1034) = lu(k,1034) - lu(k,700) * lu(k,1017) - lu(k,1035) = lu(k,1035) - lu(k,701) * lu(k,1017) - lu(k,1037) = lu(k,1037) - lu(k,702) * lu(k,1017) - lu(k,1038) = lu(k,1038) - lu(k,703) * lu(k,1017) - lu(k,1039) = lu(k,1039) - lu(k,704) * lu(k,1017) - lu(k,1040) = lu(k,1040) - lu(k,705) * lu(k,1017) - lu(k,1041) = lu(k,1041) - lu(k,706) * lu(k,1017) - lu(k,1042) = lu(k,1042) - lu(k,707) * lu(k,1017) - lu(k,1059) = lu(k,1059) - lu(k,687) * lu(k,1057) - lu(k,1061) = lu(k,1061) - lu(k,688) * lu(k,1057) - lu(k,1064) = lu(k,1064) - lu(k,689) * lu(k,1057) - lu(k,1065) = lu(k,1065) - lu(k,690) * lu(k,1057) - lu(k,1066) = lu(k,1066) - lu(k,691) * lu(k,1057) - lu(k,1067) = lu(k,1067) - lu(k,692) * lu(k,1057) - lu(k,1068) = lu(k,1068) - lu(k,693) * lu(k,1057) - lu(k,1070) = lu(k,1070) - lu(k,694) * lu(k,1057) - lu(k,1071) = lu(k,1071) - lu(k,695) * lu(k,1057) - lu(k,1072) = lu(k,1072) - lu(k,696) * lu(k,1057) - lu(k,1073) = lu(k,1073) - lu(k,697) * lu(k,1057) - lu(k,1074) = lu(k,1074) - lu(k,698) * lu(k,1057) - lu(k,1075) = lu(k,1075) - lu(k,699) * lu(k,1057) - lu(k,1076) = lu(k,1076) - lu(k,700) * lu(k,1057) - lu(k,1077) = lu(k,1077) - lu(k,701) * lu(k,1057) - lu(k,1079) = lu(k,1079) - lu(k,702) * lu(k,1057) - lu(k,1080) = lu(k,1080) - lu(k,703) * lu(k,1057) - lu(k,1081) = lu(k,1081) - lu(k,704) * lu(k,1057) - lu(k,1082) = lu(k,1082) - lu(k,705) * lu(k,1057) - lu(k,1083) = lu(k,1083) - lu(k,706) * lu(k,1057) - lu(k,1084) = lu(k,1084) - lu(k,707) * lu(k,1057) - lu(k,1099) = lu(k,1099) - lu(k,687) * lu(k,1097) - lu(k,1101) = lu(k,1101) - lu(k,688) * lu(k,1097) - lu(k,1104) = lu(k,1104) - lu(k,689) * lu(k,1097) - lu(k,1105) = lu(k,1105) - lu(k,690) * lu(k,1097) - lu(k,1106) = lu(k,1106) - lu(k,691) * lu(k,1097) - lu(k,1107) = lu(k,1107) - lu(k,692) * lu(k,1097) - lu(k,1108) = lu(k,1108) - lu(k,693) * lu(k,1097) - lu(k,1110) = lu(k,1110) - lu(k,694) * lu(k,1097) - lu(k,1111) = lu(k,1111) - lu(k,695) * lu(k,1097) - lu(k,1112) = lu(k,1112) - lu(k,696) * lu(k,1097) - lu(k,1113) = lu(k,1113) - lu(k,697) * lu(k,1097) - lu(k,1114) = lu(k,1114) - lu(k,698) * lu(k,1097) - lu(k,1115) = lu(k,1115) - lu(k,699) * lu(k,1097) - lu(k,1116) = lu(k,1116) - lu(k,700) * lu(k,1097) - lu(k,1117) = lu(k,1117) - lu(k,701) * lu(k,1097) - lu(k,1119) = lu(k,1119) - lu(k,702) * lu(k,1097) - lu(k,1120) = lu(k,1120) - lu(k,703) * lu(k,1097) - lu(k,1121) = lu(k,1121) - lu(k,704) * lu(k,1097) - lu(k,1122) = lu(k,1122) - lu(k,705) * lu(k,1097) - lu(k,1123) = lu(k,1123) - lu(k,706) * lu(k,1097) - lu(k,1124) = lu(k,1124) - lu(k,707) * lu(k,1097) - lu(k,1144) = lu(k,1144) - lu(k,687) * lu(k,1142) - lu(k,1146) = lu(k,1146) - lu(k,688) * lu(k,1142) - lu(k,1149) = lu(k,1149) - lu(k,689) * lu(k,1142) - lu(k,1150) = lu(k,1150) - lu(k,690) * lu(k,1142) - lu(k,1151) = lu(k,1151) - lu(k,691) * lu(k,1142) - lu(k,1152) = lu(k,1152) - lu(k,692) * lu(k,1142) - lu(k,1153) = lu(k,1153) - lu(k,693) * lu(k,1142) - lu(k,1155) = lu(k,1155) - lu(k,694) * lu(k,1142) - lu(k,1156) = lu(k,1156) - lu(k,695) * lu(k,1142) - lu(k,1157) = lu(k,1157) - lu(k,696) * lu(k,1142) - lu(k,1158) = lu(k,1158) - lu(k,697) * lu(k,1142) - lu(k,1159) = lu(k,1159) - lu(k,698) * lu(k,1142) - lu(k,1160) = lu(k,1160) - lu(k,699) * lu(k,1142) - lu(k,1161) = lu(k,1161) - lu(k,700) * lu(k,1142) - lu(k,1162) = lu(k,1162) - lu(k,701) * lu(k,1142) - lu(k,1164) = lu(k,1164) - lu(k,702) * lu(k,1142) - lu(k,1165) = lu(k,1165) - lu(k,703) * lu(k,1142) - lu(k,1166) = lu(k,1166) - lu(k,704) * lu(k,1142) - lu(k,1167) = lu(k,1167) - lu(k,705) * lu(k,1142) - lu(k,1168) = lu(k,1168) - lu(k,706) * lu(k,1142) - lu(k,1169) = lu(k,1169) - lu(k,707) * lu(k,1142) - lu(k,1187) = lu(k,1187) - lu(k,687) * lu(k,1185) - lu(k,1189) = lu(k,1189) - lu(k,688) * lu(k,1185) - lu(k,1192) = lu(k,1192) - lu(k,689) * lu(k,1185) - lu(k,1193) = lu(k,1193) - lu(k,690) * lu(k,1185) - lu(k,1194) = lu(k,1194) - lu(k,691) * lu(k,1185) - lu(k,1195) = lu(k,1195) - lu(k,692) * lu(k,1185) - lu(k,1196) = lu(k,1196) - lu(k,693) * lu(k,1185) - lu(k,1198) = lu(k,1198) - lu(k,694) * lu(k,1185) - lu(k,1199) = lu(k,1199) - lu(k,695) * lu(k,1185) - lu(k,1200) = lu(k,1200) - lu(k,696) * lu(k,1185) - lu(k,1201) = lu(k,1201) - lu(k,697) * lu(k,1185) - lu(k,1202) = lu(k,1202) - lu(k,698) * lu(k,1185) - lu(k,1203) = lu(k,1203) - lu(k,699) * lu(k,1185) - lu(k,1204) = lu(k,1204) - lu(k,700) * lu(k,1185) - lu(k,1205) = lu(k,1205) - lu(k,701) * lu(k,1185) - lu(k,1207) = lu(k,1207) - lu(k,702) * lu(k,1185) - lu(k,1208) = lu(k,1208) - lu(k,703) * lu(k,1185) - lu(k,1209) = lu(k,1209) - lu(k,704) * lu(k,1185) - lu(k,1210) = lu(k,1210) - lu(k,705) * lu(k,1185) - lu(k,1211) = lu(k,1211) - lu(k,706) * lu(k,1185) - lu(k,1212) = lu(k,1212) - lu(k,707) * lu(k,1185) - lu(k,1223) = lu(k,1223) - lu(k,687) * lu(k,1221) - lu(k,1224) = lu(k,1224) - lu(k,688) * lu(k,1221) - lu(k,1227) = lu(k,1227) - lu(k,689) * lu(k,1221) - lu(k,1228) = lu(k,1228) - lu(k,690) * lu(k,1221) - lu(k,1229) = lu(k,1229) - lu(k,691) * lu(k,1221) - lu(k,1230) = lu(k,1230) - lu(k,692) * lu(k,1221) - lu(k,1231) = lu(k,1231) - lu(k,693) * lu(k,1221) - lu(k,1233) = lu(k,1233) - lu(k,694) * lu(k,1221) - lu(k,1234) = lu(k,1234) - lu(k,695) * lu(k,1221) - lu(k,1235) = lu(k,1235) - lu(k,696) * lu(k,1221) - lu(k,1236) = lu(k,1236) - lu(k,697) * lu(k,1221) - lu(k,1237) = lu(k,1237) - lu(k,698) * lu(k,1221) - lu(k,1238) = lu(k,1238) - lu(k,699) * lu(k,1221) - lu(k,1239) = lu(k,1239) - lu(k,700) * lu(k,1221) - lu(k,1240) = lu(k,1240) - lu(k,701) * lu(k,1221) - lu(k,1242) = lu(k,1242) - lu(k,702) * lu(k,1221) - lu(k,1243) = lu(k,1243) - lu(k,703) * lu(k,1221) - lu(k,1244) = lu(k,1244) - lu(k,704) * lu(k,1221) - lu(k,1245) = lu(k,1245) - lu(k,705) * lu(k,1221) - lu(k,1246) = lu(k,1246) - lu(k,706) * lu(k,1221) - lu(k,1247) = lu(k,1247) - lu(k,707) * lu(k,1221) - lu(k,1265) = lu(k,1265) - lu(k,687) * lu(k,1263) - lu(k,1267) = lu(k,1267) - lu(k,688) * lu(k,1263) - lu(k,1270) = lu(k,1270) - lu(k,689) * lu(k,1263) - lu(k,1271) = lu(k,1271) - lu(k,690) * lu(k,1263) - lu(k,1272) = lu(k,1272) - lu(k,691) * lu(k,1263) - lu(k,1273) = lu(k,1273) - lu(k,692) * lu(k,1263) - lu(k,1274) = lu(k,1274) - lu(k,693) * lu(k,1263) - lu(k,1276) = lu(k,1276) - lu(k,694) * lu(k,1263) - lu(k,1277) = lu(k,1277) - lu(k,695) * lu(k,1263) - lu(k,1278) = lu(k,1278) - lu(k,696) * lu(k,1263) - lu(k,1279) = lu(k,1279) - lu(k,697) * lu(k,1263) - lu(k,1280) = lu(k,1280) - lu(k,698) * lu(k,1263) - lu(k,1281) = lu(k,1281) - lu(k,699) * lu(k,1263) - lu(k,1282) = lu(k,1282) - lu(k,700) * lu(k,1263) - lu(k,1283) = lu(k,1283) - lu(k,701) * lu(k,1263) - lu(k,1285) = lu(k,1285) - lu(k,702) * lu(k,1263) - lu(k,1286) = lu(k,1286) - lu(k,703) * lu(k,1263) - lu(k,1287) = lu(k,1287) - lu(k,704) * lu(k,1263) - lu(k,1288) = lu(k,1288) - lu(k,705) * lu(k,1263) - lu(k,1289) = lu(k,1289) - lu(k,706) * lu(k,1263) - lu(k,1290) = lu(k,1290) - lu(k,707) * lu(k,1263) - lu(k,1301) = lu(k,1301) - lu(k,687) * lu(k,1299) - lu(k,1303) = lu(k,1303) - lu(k,688) * lu(k,1299) - lu(k,1306) = lu(k,1306) - lu(k,689) * lu(k,1299) - lu(k,1307) = lu(k,1307) - lu(k,690) * lu(k,1299) - lu(k,1308) = lu(k,1308) - lu(k,691) * lu(k,1299) - lu(k,1309) = lu(k,1309) - lu(k,692) * lu(k,1299) - lu(k,1310) = lu(k,1310) - lu(k,693) * lu(k,1299) - lu(k,1312) = lu(k,1312) - lu(k,694) * lu(k,1299) - lu(k,1313) = lu(k,1313) - lu(k,695) * lu(k,1299) - lu(k,1314) = lu(k,1314) - lu(k,696) * lu(k,1299) - lu(k,1315) = lu(k,1315) - lu(k,697) * lu(k,1299) - lu(k,1316) = lu(k,1316) - lu(k,698) * lu(k,1299) - lu(k,1317) = lu(k,1317) - lu(k,699) * lu(k,1299) - lu(k,1318) = lu(k,1318) - lu(k,700) * lu(k,1299) - lu(k,1319) = lu(k,1319) - lu(k,701) * lu(k,1299) - lu(k,1321) = lu(k,1321) - lu(k,702) * lu(k,1299) - lu(k,1322) = lu(k,1322) - lu(k,703) * lu(k,1299) - lu(k,1323) = lu(k,1323) - lu(k,704) * lu(k,1299) - lu(k,1324) = lu(k,1324) - lu(k,705) * lu(k,1299) - lu(k,1325) = lu(k,1325) - lu(k,706) * lu(k,1299) - lu(k,1326) = lu(k,1326) - lu(k,707) * lu(k,1299) - lu(k,1346) = lu(k,1346) - lu(k,687) * lu(k,1344) - lu(k,1348) = lu(k,1348) - lu(k,688) * lu(k,1344) - lu(k,1351) = lu(k,1351) - lu(k,689) * lu(k,1344) - lu(k,1352) = lu(k,1352) - lu(k,690) * lu(k,1344) - lu(k,1353) = lu(k,1353) - lu(k,691) * lu(k,1344) - lu(k,1354) = lu(k,1354) - lu(k,692) * lu(k,1344) - lu(k,1355) = lu(k,1355) - lu(k,693) * lu(k,1344) - lu(k,1357) = lu(k,1357) - lu(k,694) * lu(k,1344) - lu(k,1358) = lu(k,1358) - lu(k,695) * lu(k,1344) - lu(k,1359) = lu(k,1359) - lu(k,696) * lu(k,1344) - lu(k,1360) = lu(k,1360) - lu(k,697) * lu(k,1344) - lu(k,1361) = lu(k,1361) - lu(k,698) * lu(k,1344) - lu(k,1362) = lu(k,1362) - lu(k,699) * lu(k,1344) - lu(k,1363) = lu(k,1363) - lu(k,700) * lu(k,1344) - lu(k,1364) = lu(k,1364) - lu(k,701) * lu(k,1344) - lu(k,1366) = lu(k,1366) - lu(k,702) * lu(k,1344) - lu(k,1367) = lu(k,1367) - lu(k,703) * lu(k,1344) - lu(k,1368) = lu(k,1368) - lu(k,704) * lu(k,1344) - lu(k,1369) = lu(k,1369) - lu(k,705) * lu(k,1344) - lu(k,1370) = lu(k,1370) - lu(k,706) * lu(k,1344) - lu(k,1371) = lu(k,1371) - lu(k,707) * lu(k,1344) - lu(k,1388) = lu(k,1388) - lu(k,687) * lu(k,1386) - lu(k,1390) = lu(k,1390) - lu(k,688) * lu(k,1386) - lu(k,1393) = lu(k,1393) - lu(k,689) * lu(k,1386) - lu(k,1394) = lu(k,1394) - lu(k,690) * lu(k,1386) - lu(k,1395) = lu(k,1395) - lu(k,691) * lu(k,1386) - lu(k,1396) = lu(k,1396) - lu(k,692) * lu(k,1386) - lu(k,1397) = lu(k,1397) - lu(k,693) * lu(k,1386) - lu(k,1399) = lu(k,1399) - lu(k,694) * lu(k,1386) - lu(k,1400) = lu(k,1400) - lu(k,695) * lu(k,1386) - lu(k,1401) = lu(k,1401) - lu(k,696) * lu(k,1386) - lu(k,1402) = lu(k,1402) - lu(k,697) * lu(k,1386) - lu(k,1403) = lu(k,1403) - lu(k,698) * lu(k,1386) - lu(k,1404) = lu(k,1404) - lu(k,699) * lu(k,1386) - lu(k,1405) = lu(k,1405) - lu(k,700) * lu(k,1386) - lu(k,1406) = lu(k,1406) - lu(k,701) * lu(k,1386) - lu(k,1408) = lu(k,1408) - lu(k,702) * lu(k,1386) - lu(k,1409) = lu(k,1409) - lu(k,703) * lu(k,1386) - lu(k,1410) = lu(k,1410) - lu(k,704) * lu(k,1386) - lu(k,1411) = lu(k,1411) - lu(k,705) * lu(k,1386) - lu(k,1412) = lu(k,1412) - lu(k,706) * lu(k,1386) - lu(k,1413) = lu(k,1413) - lu(k,707) * lu(k,1386) - lu(k,1426) = lu(k,1426) - lu(k,687) * lu(k,1424) - lu(k,1428) = lu(k,1428) - lu(k,688) * lu(k,1424) - lu(k,1431) = lu(k,1431) - lu(k,689) * lu(k,1424) - lu(k,1432) = lu(k,1432) - lu(k,690) * lu(k,1424) - lu(k,1433) = lu(k,1433) - lu(k,691) * lu(k,1424) - lu(k,1434) = lu(k,1434) - lu(k,692) * lu(k,1424) - lu(k,1435) = lu(k,1435) - lu(k,693) * lu(k,1424) - lu(k,1437) = lu(k,1437) - lu(k,694) * lu(k,1424) - lu(k,1438) = lu(k,1438) - lu(k,695) * lu(k,1424) - lu(k,1439) = lu(k,1439) - lu(k,696) * lu(k,1424) - lu(k,1440) = lu(k,1440) - lu(k,697) * lu(k,1424) - lu(k,1441) = lu(k,1441) - lu(k,698) * lu(k,1424) - lu(k,1442) = lu(k,1442) - lu(k,699) * lu(k,1424) - lu(k,1443) = lu(k,1443) - lu(k,700) * lu(k,1424) - lu(k,1444) = lu(k,1444) - lu(k,701) * lu(k,1424) - lu(k,1446) = lu(k,1446) - lu(k,702) * lu(k,1424) - lu(k,1447) = lu(k,1447) - lu(k,703) * lu(k,1424) - lu(k,1448) = lu(k,1448) - lu(k,704) * lu(k,1424) - lu(k,1449) = lu(k,1449) - lu(k,705) * lu(k,1424) - lu(k,1450) = lu(k,1450) - lu(k,706) * lu(k,1424) - lu(k,1451) = lu(k,1451) - lu(k,707) * lu(k,1424) - lu(k,1471) = lu(k,1471) - lu(k,687) * lu(k,1469) - lu(k,1473) = lu(k,1473) - lu(k,688) * lu(k,1469) - lu(k,1476) = lu(k,1476) - lu(k,689) * lu(k,1469) - lu(k,1477) = lu(k,1477) - lu(k,690) * lu(k,1469) - lu(k,1478) = lu(k,1478) - lu(k,691) * lu(k,1469) - lu(k,1479) = lu(k,1479) - lu(k,692) * lu(k,1469) - lu(k,1480) = lu(k,1480) - lu(k,693) * lu(k,1469) - lu(k,1482) = lu(k,1482) - lu(k,694) * lu(k,1469) - lu(k,1483) = lu(k,1483) - lu(k,695) * lu(k,1469) - lu(k,1484) = lu(k,1484) - lu(k,696) * lu(k,1469) - lu(k,1485) = lu(k,1485) - lu(k,697) * lu(k,1469) - lu(k,1486) = lu(k,1486) - lu(k,698) * lu(k,1469) - lu(k,1487) = lu(k,1487) - lu(k,699) * lu(k,1469) - lu(k,1488) = lu(k,1488) - lu(k,700) * lu(k,1469) - lu(k,1489) = lu(k,1489) - lu(k,701) * lu(k,1469) - lu(k,1491) = lu(k,1491) - lu(k,702) * lu(k,1469) - lu(k,1492) = lu(k,1492) - lu(k,703) * lu(k,1469) - lu(k,1493) = lu(k,1493) - lu(k,704) * lu(k,1469) - lu(k,1494) = lu(k,1494) - lu(k,705) * lu(k,1469) - lu(k,1495) = lu(k,1495) - lu(k,706) * lu(k,1469) - lu(k,1496) = lu(k,1496) - lu(k,707) * lu(k,1469) - lu(k,1514) = lu(k,1514) - lu(k,687) * lu(k,1512) - lu(k,1516) = lu(k,1516) - lu(k,688) * lu(k,1512) - lu(k,1519) = lu(k,1519) - lu(k,689) * lu(k,1512) - lu(k,1520) = lu(k,1520) - lu(k,690) * lu(k,1512) - lu(k,1521) = lu(k,1521) - lu(k,691) * lu(k,1512) - lu(k,1522) = lu(k,1522) - lu(k,692) * lu(k,1512) - lu(k,1523) = lu(k,1523) - lu(k,693) * lu(k,1512) - lu(k,1525) = lu(k,1525) - lu(k,694) * lu(k,1512) - lu(k,1526) = lu(k,1526) - lu(k,695) * lu(k,1512) - lu(k,1527) = lu(k,1527) - lu(k,696) * lu(k,1512) - lu(k,1528) = lu(k,1528) - lu(k,697) * lu(k,1512) - lu(k,1529) = lu(k,1529) - lu(k,698) * lu(k,1512) - lu(k,1530) = lu(k,1530) - lu(k,699) * lu(k,1512) - lu(k,1531) = lu(k,1531) - lu(k,700) * lu(k,1512) - lu(k,1532) = lu(k,1532) - lu(k,701) * lu(k,1512) - lu(k,1534) = lu(k,1534) - lu(k,702) * lu(k,1512) - lu(k,1535) = lu(k,1535) - lu(k,703) * lu(k,1512) - lu(k,1536) = lu(k,1536) - lu(k,704) * lu(k,1512) - lu(k,1537) = lu(k,1537) - lu(k,705) * lu(k,1512) - lu(k,1538) = lu(k,1538) - lu(k,706) * lu(k,1512) - lu(k,1539) = lu(k,1539) - lu(k,707) * lu(k,1512) - lu(k,1557) = lu(k,1557) - lu(k,687) * lu(k,1555) - lu(k,1559) = lu(k,1559) - lu(k,688) * lu(k,1555) - lu(k,1562) = lu(k,1562) - lu(k,689) * lu(k,1555) - lu(k,1563) = lu(k,1563) - lu(k,690) * lu(k,1555) - lu(k,1564) = lu(k,1564) - lu(k,691) * lu(k,1555) - lu(k,1565) = lu(k,1565) - lu(k,692) * lu(k,1555) - lu(k,1566) = lu(k,1566) - lu(k,693) * lu(k,1555) - lu(k,1568) = lu(k,1568) - lu(k,694) * lu(k,1555) - lu(k,1569) = lu(k,1569) - lu(k,695) * lu(k,1555) - lu(k,1570) = lu(k,1570) - lu(k,696) * lu(k,1555) - lu(k,1571) = lu(k,1571) - lu(k,697) * lu(k,1555) - lu(k,1572) = lu(k,1572) - lu(k,698) * lu(k,1555) - lu(k,1573) = lu(k,1573) - lu(k,699) * lu(k,1555) - lu(k,1574) = lu(k,1574) - lu(k,700) * lu(k,1555) - lu(k,1575) = lu(k,1575) - lu(k,701) * lu(k,1555) - lu(k,1577) = lu(k,1577) - lu(k,702) * lu(k,1555) - lu(k,1578) = lu(k,1578) - lu(k,703) * lu(k,1555) - lu(k,1579) = lu(k,1579) - lu(k,704) * lu(k,1555) - lu(k,1580) = lu(k,1580) - lu(k,705) * lu(k,1555) - lu(k,1581) = lu(k,1581) - lu(k,706) * lu(k,1555) - lu(k,1582) = lu(k,1582) - lu(k,707) * lu(k,1555) - lu(k,1590) = lu(k,1590) - lu(k,687) * lu(k,1588) - lu(k,1592) = lu(k,1592) - lu(k,688) * lu(k,1588) - lu(k,1595) = lu(k,1595) - lu(k,689) * lu(k,1588) - lu(k,1596) = lu(k,1596) - lu(k,690) * lu(k,1588) - lu(k,1597) = lu(k,1597) - lu(k,691) * lu(k,1588) - lu(k,1598) = lu(k,1598) - lu(k,692) * lu(k,1588) - lu(k,1599) = lu(k,1599) - lu(k,693) * lu(k,1588) - lu(k,1601) = lu(k,1601) - lu(k,694) * lu(k,1588) - lu(k,1602) = lu(k,1602) - lu(k,695) * lu(k,1588) - lu(k,1603) = lu(k,1603) - lu(k,696) * lu(k,1588) - lu(k,1604) = lu(k,1604) - lu(k,697) * lu(k,1588) - lu(k,1605) = lu(k,1605) - lu(k,698) * lu(k,1588) - lu(k,1606) = lu(k,1606) - lu(k,699) * lu(k,1588) - lu(k,1607) = lu(k,1607) - lu(k,700) * lu(k,1588) - lu(k,1608) = lu(k,1608) - lu(k,701) * lu(k,1588) - lu(k,1610) = lu(k,1610) - lu(k,702) * lu(k,1588) - lu(k,1611) = lu(k,1611) - lu(k,703) * lu(k,1588) - lu(k,1612) = lu(k,1612) - lu(k,704) * lu(k,1588) - lu(k,1613) = lu(k,1613) - lu(k,705) * lu(k,1588) - lu(k,1614) = lu(k,1614) - lu(k,706) * lu(k,1588) - lu(k,1615) = lu(k,1615) - lu(k,707) * lu(k,1588) - lu(k,1626) = lu(k,1626) - lu(k,687) * lu(k,1624) - lu(k,1628) = lu(k,1628) - lu(k,688) * lu(k,1624) - lu(k,1631) = lu(k,1631) - lu(k,689) * lu(k,1624) - lu(k,1632) = lu(k,1632) - lu(k,690) * lu(k,1624) - lu(k,1633) = lu(k,1633) - lu(k,691) * lu(k,1624) - lu(k,1634) = lu(k,1634) - lu(k,692) * lu(k,1624) - lu(k,1635) = lu(k,1635) - lu(k,693) * lu(k,1624) - lu(k,1637) = lu(k,1637) - lu(k,694) * lu(k,1624) - lu(k,1638) = lu(k,1638) - lu(k,695) * lu(k,1624) - lu(k,1639) = lu(k,1639) - lu(k,696) * lu(k,1624) - lu(k,1640) = lu(k,1640) - lu(k,697) * lu(k,1624) - lu(k,1641) = lu(k,1641) - lu(k,698) * lu(k,1624) - lu(k,1642) = lu(k,1642) - lu(k,699) * lu(k,1624) - lu(k,1643) = lu(k,1643) - lu(k,700) * lu(k,1624) - lu(k,1644) = lu(k,1644) - lu(k,701) * lu(k,1624) - lu(k,1646) = lu(k,1646) - lu(k,702) * lu(k,1624) - lu(k,1647) = lu(k,1647) - lu(k,703) * lu(k,1624) - lu(k,1648) = lu(k,1648) - lu(k,704) * lu(k,1624) - lu(k,1649) = lu(k,1649) - lu(k,705) * lu(k,1624) - lu(k,1650) = lu(k,1650) - lu(k,706) * lu(k,1624) - lu(k,1651) = lu(k,1651) - lu(k,707) * lu(k,1624) - lu(k,1669) = lu(k,1669) - lu(k,687) * lu(k,1667) - lu(k,1671) = lu(k,1671) - lu(k,688) * lu(k,1667) - lu(k,1674) = lu(k,1674) - lu(k,689) * lu(k,1667) - lu(k,1675) = lu(k,1675) - lu(k,690) * lu(k,1667) - lu(k,1676) = lu(k,1676) - lu(k,691) * lu(k,1667) - lu(k,1677) = lu(k,1677) - lu(k,692) * lu(k,1667) - lu(k,1678) = lu(k,1678) - lu(k,693) * lu(k,1667) - lu(k,1680) = lu(k,1680) - lu(k,694) * lu(k,1667) - lu(k,1681) = lu(k,1681) - lu(k,695) * lu(k,1667) - lu(k,1682) = lu(k,1682) - lu(k,696) * lu(k,1667) - lu(k,1683) = lu(k,1683) - lu(k,697) * lu(k,1667) - lu(k,1684) = lu(k,1684) - lu(k,698) * lu(k,1667) - lu(k,1685) = lu(k,1685) - lu(k,699) * lu(k,1667) - lu(k,1686) = lu(k,1686) - lu(k,700) * lu(k,1667) - lu(k,1687) = lu(k,1687) - lu(k,701) * lu(k,1667) - lu(k,1689) = lu(k,1689) - lu(k,702) * lu(k,1667) - lu(k,1690) = lu(k,1690) - lu(k,703) * lu(k,1667) - lu(k,1691) = lu(k,1691) - lu(k,704) * lu(k,1667) - lu(k,1692) = lu(k,1692) - lu(k,705) * lu(k,1667) - lu(k,1693) = lu(k,1693) - lu(k,706) * lu(k,1667) - lu(k,1694) = lu(k,1694) - lu(k,707) * lu(k,1667) - lu(k,1705) = lu(k,1705) - lu(k,687) * lu(k,1703) - lu(k,1707) = lu(k,1707) - lu(k,688) * lu(k,1703) - lu(k,1710) = lu(k,1710) - lu(k,689) * lu(k,1703) - lu(k,1711) = lu(k,1711) - lu(k,690) * lu(k,1703) - lu(k,1712) = lu(k,1712) - lu(k,691) * lu(k,1703) - lu(k,1713) = lu(k,1713) - lu(k,692) * lu(k,1703) - lu(k,1714) = lu(k,1714) - lu(k,693) * lu(k,1703) - lu(k,1716) = lu(k,1716) - lu(k,694) * lu(k,1703) - lu(k,1717) = lu(k,1717) - lu(k,695) * lu(k,1703) - lu(k,1718) = lu(k,1718) - lu(k,696) * lu(k,1703) - lu(k,1719) = lu(k,1719) - lu(k,697) * lu(k,1703) - lu(k,1720) = lu(k,1720) - lu(k,698) * lu(k,1703) - lu(k,1721) = lu(k,1721) - lu(k,699) * lu(k,1703) - lu(k,1722) = lu(k,1722) - lu(k,700) * lu(k,1703) - lu(k,1723) = lu(k,1723) - lu(k,701) * lu(k,1703) - lu(k,1725) = lu(k,1725) - lu(k,702) * lu(k,1703) - lu(k,1726) = lu(k,1726) - lu(k,703) * lu(k,1703) - lu(k,1727) = lu(k,1727) - lu(k,704) * lu(k,1703) - lu(k,1728) = lu(k,1728) - lu(k,705) * lu(k,1703) - lu(k,1729) = lu(k,1729) - lu(k,706) * lu(k,1703) - lu(k,1730) = lu(k,1730) - lu(k,707) * lu(k,1703) - lu(k,1747) = lu(k,1747) - lu(k,687) * lu(k,1745) - lu(k,1749) = lu(k,1749) - lu(k,688) * lu(k,1745) - lu(k,1752) = lu(k,1752) - lu(k,689) * lu(k,1745) - lu(k,1753) = lu(k,1753) - lu(k,690) * lu(k,1745) - lu(k,1754) = lu(k,1754) - lu(k,691) * lu(k,1745) - lu(k,1755) = lu(k,1755) - lu(k,692) * lu(k,1745) - lu(k,1756) = lu(k,1756) - lu(k,693) * lu(k,1745) - lu(k,1758) = lu(k,1758) - lu(k,694) * lu(k,1745) - lu(k,1759) = lu(k,1759) - lu(k,695) * lu(k,1745) - lu(k,1760) = lu(k,1760) - lu(k,696) * lu(k,1745) - lu(k,1761) = lu(k,1761) - lu(k,697) * lu(k,1745) - lu(k,1762) = lu(k,1762) - lu(k,698) * lu(k,1745) - lu(k,1763) = lu(k,1763) - lu(k,699) * lu(k,1745) - lu(k,1764) = lu(k,1764) - lu(k,700) * lu(k,1745) - lu(k,1765) = lu(k,1765) - lu(k,701) * lu(k,1745) - lu(k,1767) = lu(k,1767) - lu(k,702) * lu(k,1745) - lu(k,1768) = lu(k,1768) - lu(k,703) * lu(k,1745) - lu(k,1769) = lu(k,1769) - lu(k,704) * lu(k,1745) - lu(k,1770) = lu(k,1770) - lu(k,705) * lu(k,1745) - lu(k,1771) = lu(k,1771) - lu(k,706) * lu(k,1745) - lu(k,1772) = lu(k,1772) - lu(k,707) * lu(k,1745) - lu(k,1800) = lu(k,1800) - lu(k,687) * lu(k,1798) - lu(k,1802) = lu(k,1802) - lu(k,688) * lu(k,1798) - lu(k,1805) = lu(k,1805) - lu(k,689) * lu(k,1798) - lu(k,1806) = lu(k,1806) - lu(k,690) * lu(k,1798) - lu(k,1807) = lu(k,1807) - lu(k,691) * lu(k,1798) - lu(k,1808) = lu(k,1808) - lu(k,692) * lu(k,1798) - lu(k,1809) = lu(k,1809) - lu(k,693) * lu(k,1798) - lu(k,1811) = lu(k,1811) - lu(k,694) * lu(k,1798) - lu(k,1812) = lu(k,1812) - lu(k,695) * lu(k,1798) - lu(k,1813) = lu(k,1813) - lu(k,696) * lu(k,1798) - lu(k,1814) = lu(k,1814) - lu(k,697) * lu(k,1798) - lu(k,1815) = lu(k,1815) - lu(k,698) * lu(k,1798) - lu(k,1816) = lu(k,1816) - lu(k,699) * lu(k,1798) - lu(k,1817) = lu(k,1817) - lu(k,700) * lu(k,1798) - lu(k,1818) = lu(k,1818) - lu(k,701) * lu(k,1798) - lu(k,1820) = lu(k,1820) - lu(k,702) * lu(k,1798) - lu(k,1821) = lu(k,1821) - lu(k,703) * lu(k,1798) - lu(k,1822) = lu(k,1822) - lu(k,704) * lu(k,1798) - lu(k,1823) = lu(k,1823) - lu(k,705) * lu(k,1798) - lu(k,1824) = lu(k,1824) - lu(k,706) * lu(k,1798) - lu(k,1825) = lu(k,1825) - lu(k,707) * lu(k,1798) - lu(k,712) = 1._r8 / lu(k,712) - lu(k,713) = lu(k,713) * lu(k,712) - lu(k,714) = lu(k,714) * lu(k,712) - lu(k,715) = lu(k,715) * lu(k,712) - lu(k,716) = lu(k,716) * lu(k,712) - lu(k,717) = lu(k,717) * lu(k,712) - lu(k,718) = lu(k,718) * lu(k,712) - lu(k,719) = lu(k,719) * lu(k,712) - lu(k,720) = lu(k,720) * lu(k,712) - lu(k,721) = lu(k,721) * lu(k,712) - lu(k,722) = lu(k,722) * lu(k,712) - lu(k,723) = lu(k,723) * lu(k,712) - lu(k,724) = lu(k,724) * lu(k,712) - lu(k,725) = lu(k,725) * lu(k,712) - lu(k,726) = lu(k,726) * lu(k,712) - lu(k,727) = lu(k,727) * lu(k,712) - lu(k,728) = lu(k,728) * lu(k,712) - lu(k,729) = lu(k,729) * lu(k,712) - lu(k,730) = lu(k,730) * lu(k,712) - lu(k,731) = lu(k,731) * lu(k,712) - lu(k,732) = lu(k,732) * lu(k,712) - lu(k,733) = lu(k,733) * lu(k,712) - lu(k,734) = lu(k,734) * lu(k,712) - lu(k,784) = lu(k,784) - lu(k,713) * lu(k,783) - lu(k,786) = lu(k,786) - lu(k,714) * lu(k,783) - lu(k,787) = lu(k,787) - lu(k,715) * lu(k,783) - lu(k,788) = lu(k,788) - lu(k,716) * lu(k,783) - lu(k,789) = lu(k,789) - lu(k,717) * lu(k,783) - lu(k,790) = lu(k,790) - lu(k,718) * lu(k,783) - lu(k,791) = lu(k,791) - lu(k,719) * lu(k,783) - lu(k,792) = lu(k,792) - lu(k,720) * lu(k,783) - lu(k,793) = lu(k,793) - lu(k,721) * lu(k,783) - lu(k,794) = lu(k,794) - lu(k,722) * lu(k,783) - lu(k,795) = lu(k,795) - lu(k,723) * lu(k,783) - lu(k,796) = lu(k,796) - lu(k,724) * lu(k,783) - lu(k,798) = lu(k,798) - lu(k,725) * lu(k,783) - lu(k,800) = lu(k,800) - lu(k,726) * lu(k,783) - lu(k,801) = lu(k,801) - lu(k,727) * lu(k,783) - lu(k,802) = lu(k,802) - lu(k,728) * lu(k,783) - lu(k,803) = lu(k,803) - lu(k,729) * lu(k,783) - lu(k,804) = lu(k,804) - lu(k,730) * lu(k,783) - lu(k,806) = lu(k,806) - lu(k,731) * lu(k,783) - lu(k,807) = lu(k,807) - lu(k,732) * lu(k,783) - lu(k,808) = lu(k,808) - lu(k,733) * lu(k,783) - lu(k,809) = lu(k,809) - lu(k,734) * lu(k,783) - lu(k,827) = lu(k,827) - lu(k,713) * lu(k,826) - lu(k,829) = lu(k,829) - lu(k,714) * lu(k,826) - lu(k,830) = lu(k,830) - lu(k,715) * lu(k,826) - lu(k,831) = lu(k,831) - lu(k,716) * lu(k,826) - lu(k,832) = lu(k,832) - lu(k,717) * lu(k,826) - lu(k,833) = lu(k,833) - lu(k,718) * lu(k,826) - lu(k,834) = lu(k,834) - lu(k,719) * lu(k,826) - lu(k,835) = lu(k,835) - lu(k,720) * lu(k,826) - lu(k,836) = lu(k,836) - lu(k,721) * lu(k,826) - lu(k,837) = lu(k,837) - lu(k,722) * lu(k,826) - lu(k,838) = lu(k,838) - lu(k,723) * lu(k,826) - lu(k,839) = lu(k,839) - lu(k,724) * lu(k,826) - lu(k,841) = lu(k,841) - lu(k,725) * lu(k,826) - lu(k,843) = lu(k,843) - lu(k,726) * lu(k,826) - lu(k,844) = lu(k,844) - lu(k,727) * lu(k,826) - lu(k,845) = lu(k,845) - lu(k,728) * lu(k,826) - lu(k,846) = lu(k,846) - lu(k,729) * lu(k,826) - lu(k,847) = lu(k,847) - lu(k,730) * lu(k,826) - lu(k,849) = lu(k,849) - lu(k,731) * lu(k,826) - lu(k,850) = lu(k,850) - lu(k,732) * lu(k,826) - lu(k,851) = lu(k,851) - lu(k,733) * lu(k,826) - lu(k,852) = lu(k,852) - lu(k,734) * lu(k,826) - lu(k,875) = lu(k,875) - lu(k,713) * lu(k,874) - lu(k,877) = lu(k,877) - lu(k,714) * lu(k,874) - lu(k,878) = lu(k,878) - lu(k,715) * lu(k,874) - lu(k,879) = lu(k,879) - lu(k,716) * lu(k,874) - lu(k,880) = lu(k,880) - lu(k,717) * lu(k,874) - lu(k,881) = lu(k,881) - lu(k,718) * lu(k,874) - lu(k,882) = lu(k,882) - lu(k,719) * lu(k,874) - lu(k,883) = lu(k,883) - lu(k,720) * lu(k,874) - lu(k,884) = lu(k,884) - lu(k,721) * lu(k,874) - lu(k,885) = lu(k,885) - lu(k,722) * lu(k,874) - lu(k,886) = lu(k,886) - lu(k,723) * lu(k,874) - lu(k,887) = lu(k,887) - lu(k,724) * lu(k,874) - lu(k,889) = lu(k,889) - lu(k,725) * lu(k,874) - lu(k,891) = lu(k,891) - lu(k,726) * lu(k,874) - lu(k,892) = lu(k,892) - lu(k,727) * lu(k,874) - lu(k,893) = lu(k,893) - lu(k,728) * lu(k,874) - lu(k,894) = lu(k,894) - lu(k,729) * lu(k,874) - lu(k,895) = lu(k,895) - lu(k,730) * lu(k,874) - lu(k,897) = lu(k,897) - lu(k,731) * lu(k,874) - lu(k,898) = lu(k,898) - lu(k,732) * lu(k,874) - lu(k,899) = lu(k,899) - lu(k,733) * lu(k,874) - lu(k,900) = lu(k,900) - lu(k,734) * lu(k,874) - lu(k,918) = lu(k,918) - lu(k,713) * lu(k,917) - lu(k,920) = lu(k,920) - lu(k,714) * lu(k,917) - lu(k,921) = lu(k,921) - lu(k,715) * lu(k,917) - lu(k,922) = lu(k,922) - lu(k,716) * lu(k,917) - lu(k,923) = lu(k,923) - lu(k,717) * lu(k,917) - lu(k,924) = lu(k,924) - lu(k,718) * lu(k,917) - lu(k,925) = lu(k,925) - lu(k,719) * lu(k,917) - lu(k,926) = lu(k,926) - lu(k,720) * lu(k,917) - lu(k,927) = lu(k,927) - lu(k,721) * lu(k,917) - lu(k,928) = lu(k,928) - lu(k,722) * lu(k,917) - lu(k,929) = lu(k,929) - lu(k,723) * lu(k,917) - lu(k,930) = lu(k,930) - lu(k,724) * lu(k,917) - lu(k,932) = lu(k,932) - lu(k,725) * lu(k,917) - lu(k,934) = lu(k,934) - lu(k,726) * lu(k,917) - lu(k,935) = lu(k,935) - lu(k,727) * lu(k,917) - lu(k,936) = lu(k,936) - lu(k,728) * lu(k,917) - lu(k,937) = lu(k,937) - lu(k,729) * lu(k,917) - lu(k,938) = lu(k,938) - lu(k,730) * lu(k,917) - lu(k,940) = lu(k,940) - lu(k,731) * lu(k,917) - lu(k,941) = lu(k,941) - lu(k,732) * lu(k,917) - lu(k,942) = lu(k,942) - lu(k,733) * lu(k,917) - lu(k,943) = lu(k,943) - lu(k,734) * lu(k,917) - lu(k,974) = lu(k,974) - lu(k,713) * lu(k,973) - lu(k,976) = lu(k,976) - lu(k,714) * lu(k,973) - lu(k,977) = lu(k,977) - lu(k,715) * lu(k,973) - lu(k,978) = lu(k,978) - lu(k,716) * lu(k,973) - lu(k,979) = lu(k,979) - lu(k,717) * lu(k,973) - lu(k,980) = lu(k,980) - lu(k,718) * lu(k,973) - lu(k,981) = lu(k,981) - lu(k,719) * lu(k,973) - lu(k,982) = lu(k,982) - lu(k,720) * lu(k,973) - lu(k,983) = lu(k,983) - lu(k,721) * lu(k,973) - lu(k,984) = lu(k,984) - lu(k,722) * lu(k,973) - lu(k,985) = lu(k,985) - lu(k,723) * lu(k,973) - lu(k,986) = lu(k,986) - lu(k,724) * lu(k,973) - lu(k,988) = lu(k,988) - lu(k,725) * lu(k,973) - lu(k,990) = lu(k,990) - lu(k,726) * lu(k,973) - lu(k,991) = lu(k,991) - lu(k,727) * lu(k,973) - lu(k,992) = lu(k,992) - lu(k,728) * lu(k,973) - lu(k,993) = lu(k,993) - lu(k,729) * lu(k,973) - lu(k,994) = lu(k,994) - lu(k,730) * lu(k,973) - lu(k,996) = lu(k,996) - lu(k,731) * lu(k,973) - lu(k,997) = lu(k,997) - lu(k,732) * lu(k,973) - lu(k,998) = lu(k,998) - lu(k,733) * lu(k,973) - lu(k,999) = lu(k,999) - lu(k,734) * lu(k,973) - lu(k,1059) = lu(k,1059) - lu(k,713) * lu(k,1058) - lu(k,1061) = lu(k,1061) - lu(k,714) * lu(k,1058) - lu(k,1062) = lu(k,1062) - lu(k,715) * lu(k,1058) - lu(k,1063) = lu(k,1063) - lu(k,716) * lu(k,1058) - lu(k,1064) = lu(k,1064) - lu(k,717) * lu(k,1058) - lu(k,1065) = lu(k,1065) - lu(k,718) * lu(k,1058) - lu(k,1066) = lu(k,1066) - lu(k,719) * lu(k,1058) - lu(k,1067) = lu(k,1067) - lu(k,720) * lu(k,1058) - lu(k,1068) = lu(k,1068) - lu(k,721) * lu(k,1058) - lu(k,1069) = lu(k,1069) - lu(k,722) * lu(k,1058) - lu(k,1070) = lu(k,1070) - lu(k,723) * lu(k,1058) - lu(k,1071) = lu(k,1071) - lu(k,724) * lu(k,1058) - lu(k,1073) = lu(k,1073) - lu(k,725) * lu(k,1058) - lu(k,1075) = lu(k,1075) - lu(k,726) * lu(k,1058) - lu(k,1076) = lu(k,1076) - lu(k,727) * lu(k,1058) - lu(k,1077) = lu(k,1077) - lu(k,728) * lu(k,1058) - lu(k,1078) = lu(k,1078) - lu(k,729) * lu(k,1058) - lu(k,1079) = lu(k,1079) - lu(k,730) * lu(k,1058) - lu(k,1081) = lu(k,1081) - lu(k,731) * lu(k,1058) - lu(k,1082) = lu(k,1082) - lu(k,732) * lu(k,1058) - lu(k,1083) = lu(k,1083) - lu(k,733) * lu(k,1058) - lu(k,1084) = lu(k,1084) - lu(k,734) * lu(k,1058) - lu(k,1099) = lu(k,1099) - lu(k,713) * lu(k,1098) - lu(k,1101) = lu(k,1101) - lu(k,714) * lu(k,1098) - lu(k,1102) = lu(k,1102) - lu(k,715) * lu(k,1098) - lu(k,1103) = lu(k,1103) - lu(k,716) * lu(k,1098) - lu(k,1104) = lu(k,1104) - lu(k,717) * lu(k,1098) - lu(k,1105) = lu(k,1105) - lu(k,718) * lu(k,1098) - lu(k,1106) = lu(k,1106) - lu(k,719) * lu(k,1098) - lu(k,1107) = lu(k,1107) - lu(k,720) * lu(k,1098) - lu(k,1108) = lu(k,1108) - lu(k,721) * lu(k,1098) - lu(k,1109) = lu(k,1109) - lu(k,722) * lu(k,1098) - lu(k,1110) = lu(k,1110) - lu(k,723) * lu(k,1098) - lu(k,1111) = lu(k,1111) - lu(k,724) * lu(k,1098) - lu(k,1113) = lu(k,1113) - lu(k,725) * lu(k,1098) - lu(k,1115) = lu(k,1115) - lu(k,726) * lu(k,1098) - lu(k,1116) = lu(k,1116) - lu(k,727) * lu(k,1098) - lu(k,1117) = lu(k,1117) - lu(k,728) * lu(k,1098) - lu(k,1118) = lu(k,1118) - lu(k,729) * lu(k,1098) - lu(k,1119) = lu(k,1119) - lu(k,730) * lu(k,1098) - lu(k,1121) = lu(k,1121) - lu(k,731) * lu(k,1098) - lu(k,1122) = lu(k,1122) - lu(k,732) * lu(k,1098) - lu(k,1123) = lu(k,1123) - lu(k,733) * lu(k,1098) - lu(k,1124) = lu(k,1124) - lu(k,734) * lu(k,1098) - lu(k,1144) = lu(k,1144) - lu(k,713) * lu(k,1143) - lu(k,1146) = lu(k,1146) - lu(k,714) * lu(k,1143) - lu(k,1147) = lu(k,1147) - lu(k,715) * lu(k,1143) - lu(k,1148) = lu(k,1148) - lu(k,716) * lu(k,1143) - lu(k,1149) = lu(k,1149) - lu(k,717) * lu(k,1143) - lu(k,1150) = lu(k,1150) - lu(k,718) * lu(k,1143) - lu(k,1151) = lu(k,1151) - lu(k,719) * lu(k,1143) - lu(k,1152) = lu(k,1152) - lu(k,720) * lu(k,1143) - lu(k,1153) = lu(k,1153) - lu(k,721) * lu(k,1143) - lu(k,1154) = lu(k,1154) - lu(k,722) * lu(k,1143) - lu(k,1155) = lu(k,1155) - lu(k,723) * lu(k,1143) - lu(k,1156) = lu(k,1156) - lu(k,724) * lu(k,1143) - lu(k,1158) = lu(k,1158) - lu(k,725) * lu(k,1143) - lu(k,1160) = lu(k,1160) - lu(k,726) * lu(k,1143) - lu(k,1161) = lu(k,1161) - lu(k,727) * lu(k,1143) - lu(k,1162) = lu(k,1162) - lu(k,728) * lu(k,1143) - lu(k,1163) = lu(k,1163) - lu(k,729) * lu(k,1143) - lu(k,1164) = lu(k,1164) - lu(k,730) * lu(k,1143) - lu(k,1166) = lu(k,1166) - lu(k,731) * lu(k,1143) - lu(k,1167) = lu(k,1167) - lu(k,732) * lu(k,1143) - lu(k,1168) = lu(k,1168) - lu(k,733) * lu(k,1143) - lu(k,1169) = lu(k,1169) - lu(k,734) * lu(k,1143) - lu(k,1187) = lu(k,1187) - lu(k,713) * lu(k,1186) - lu(k,1189) = lu(k,1189) - lu(k,714) * lu(k,1186) - lu(k,1190) = lu(k,1190) - lu(k,715) * lu(k,1186) - lu(k,1191) = lu(k,1191) - lu(k,716) * lu(k,1186) - lu(k,1192) = lu(k,1192) - lu(k,717) * lu(k,1186) - lu(k,1193) = lu(k,1193) - lu(k,718) * lu(k,1186) - lu(k,1194) = lu(k,1194) - lu(k,719) * lu(k,1186) - lu(k,1195) = lu(k,1195) - lu(k,720) * lu(k,1186) - lu(k,1196) = lu(k,1196) - lu(k,721) * lu(k,1186) - lu(k,1197) = lu(k,1197) - lu(k,722) * lu(k,1186) - lu(k,1198) = lu(k,1198) - lu(k,723) * lu(k,1186) - lu(k,1199) = lu(k,1199) - lu(k,724) * lu(k,1186) - lu(k,1201) = lu(k,1201) - lu(k,725) * lu(k,1186) - lu(k,1203) = lu(k,1203) - lu(k,726) * lu(k,1186) - lu(k,1204) = lu(k,1204) - lu(k,727) * lu(k,1186) - lu(k,1205) = lu(k,1205) - lu(k,728) * lu(k,1186) - lu(k,1206) = lu(k,1206) - lu(k,729) * lu(k,1186) - lu(k,1207) = lu(k,1207) - lu(k,730) * lu(k,1186) - lu(k,1209) = lu(k,1209) - lu(k,731) * lu(k,1186) - lu(k,1210) = lu(k,1210) - lu(k,732) * lu(k,1186) - lu(k,1211) = lu(k,1211) - lu(k,733) * lu(k,1186) - lu(k,1212) = lu(k,1212) - lu(k,734) * lu(k,1186) - lu(k,1223) = lu(k,1223) - lu(k,713) * lu(k,1222) - lu(k,1224) = lu(k,1224) - lu(k,714) * lu(k,1222) - lu(k,1225) = lu(k,1225) - lu(k,715) * lu(k,1222) - lu(k,1226) = lu(k,1226) - lu(k,716) * lu(k,1222) - lu(k,1227) = lu(k,1227) - lu(k,717) * lu(k,1222) - lu(k,1228) = lu(k,1228) - lu(k,718) * lu(k,1222) - lu(k,1229) = lu(k,1229) - lu(k,719) * lu(k,1222) - lu(k,1230) = lu(k,1230) - lu(k,720) * lu(k,1222) - lu(k,1231) = lu(k,1231) - lu(k,721) * lu(k,1222) - lu(k,1232) = lu(k,1232) - lu(k,722) * lu(k,1222) - lu(k,1233) = lu(k,1233) - lu(k,723) * lu(k,1222) - lu(k,1234) = lu(k,1234) - lu(k,724) * lu(k,1222) - lu(k,1236) = lu(k,1236) - lu(k,725) * lu(k,1222) - lu(k,1238) = lu(k,1238) - lu(k,726) * lu(k,1222) - lu(k,1239) = lu(k,1239) - lu(k,727) * lu(k,1222) - lu(k,1240) = lu(k,1240) - lu(k,728) * lu(k,1222) - lu(k,1241) = lu(k,1241) - lu(k,729) * lu(k,1222) - lu(k,1242) = lu(k,1242) - lu(k,730) * lu(k,1222) - lu(k,1244) = lu(k,1244) - lu(k,731) * lu(k,1222) - lu(k,1245) = lu(k,1245) - lu(k,732) * lu(k,1222) - lu(k,1246) = lu(k,1246) - lu(k,733) * lu(k,1222) - lu(k,1247) = lu(k,1247) - lu(k,734) * lu(k,1222) - lu(k,1265) = lu(k,1265) - lu(k,713) * lu(k,1264) - lu(k,1267) = lu(k,1267) - lu(k,714) * lu(k,1264) - lu(k,1268) = lu(k,1268) - lu(k,715) * lu(k,1264) - lu(k,1269) = lu(k,1269) - lu(k,716) * lu(k,1264) - lu(k,1270) = lu(k,1270) - lu(k,717) * lu(k,1264) - lu(k,1271) = lu(k,1271) - lu(k,718) * lu(k,1264) - lu(k,1272) = lu(k,1272) - lu(k,719) * lu(k,1264) - lu(k,1273) = lu(k,1273) - lu(k,720) * lu(k,1264) - lu(k,1274) = lu(k,1274) - lu(k,721) * lu(k,1264) - lu(k,1275) = lu(k,1275) - lu(k,722) * lu(k,1264) - lu(k,1276) = lu(k,1276) - lu(k,723) * lu(k,1264) - lu(k,1277) = lu(k,1277) - lu(k,724) * lu(k,1264) - lu(k,1279) = lu(k,1279) - lu(k,725) * lu(k,1264) - lu(k,1281) = lu(k,1281) - lu(k,726) * lu(k,1264) - lu(k,1282) = lu(k,1282) - lu(k,727) * lu(k,1264) - lu(k,1283) = lu(k,1283) - lu(k,728) * lu(k,1264) - lu(k,1284) = lu(k,1284) - lu(k,729) * lu(k,1264) - lu(k,1285) = lu(k,1285) - lu(k,730) * lu(k,1264) - lu(k,1287) = lu(k,1287) - lu(k,731) * lu(k,1264) - lu(k,1288) = lu(k,1288) - lu(k,732) * lu(k,1264) - lu(k,1289) = lu(k,1289) - lu(k,733) * lu(k,1264) - lu(k,1290) = lu(k,1290) - lu(k,734) * lu(k,1264) - lu(k,1301) = lu(k,1301) - lu(k,713) * lu(k,1300) - lu(k,1303) = lu(k,1303) - lu(k,714) * lu(k,1300) - lu(k,1304) = lu(k,1304) - lu(k,715) * lu(k,1300) - lu(k,1305) = lu(k,1305) - lu(k,716) * lu(k,1300) - lu(k,1306) = lu(k,1306) - lu(k,717) * lu(k,1300) - lu(k,1307) = lu(k,1307) - lu(k,718) * lu(k,1300) - lu(k,1308) = lu(k,1308) - lu(k,719) * lu(k,1300) - lu(k,1309) = lu(k,1309) - lu(k,720) * lu(k,1300) - lu(k,1310) = lu(k,1310) - lu(k,721) * lu(k,1300) - lu(k,1311) = lu(k,1311) - lu(k,722) * lu(k,1300) - lu(k,1312) = lu(k,1312) - lu(k,723) * lu(k,1300) - lu(k,1313) = lu(k,1313) - lu(k,724) * lu(k,1300) - lu(k,1315) = lu(k,1315) - lu(k,725) * lu(k,1300) - lu(k,1317) = lu(k,1317) - lu(k,726) * lu(k,1300) - lu(k,1318) = lu(k,1318) - lu(k,727) * lu(k,1300) - lu(k,1319) = lu(k,1319) - lu(k,728) * lu(k,1300) - lu(k,1320) = lu(k,1320) - lu(k,729) * lu(k,1300) - lu(k,1321) = lu(k,1321) - lu(k,730) * lu(k,1300) - lu(k,1323) = lu(k,1323) - lu(k,731) * lu(k,1300) - lu(k,1324) = lu(k,1324) - lu(k,732) * lu(k,1300) - lu(k,1325) = lu(k,1325) - lu(k,733) * lu(k,1300) - lu(k,1326) = lu(k,1326) - lu(k,734) * lu(k,1300) - lu(k,1346) = lu(k,1346) - lu(k,713) * lu(k,1345) - lu(k,1348) = lu(k,1348) - lu(k,714) * lu(k,1345) - lu(k,1349) = lu(k,1349) - lu(k,715) * lu(k,1345) - lu(k,1350) = lu(k,1350) - lu(k,716) * lu(k,1345) - lu(k,1351) = lu(k,1351) - lu(k,717) * lu(k,1345) - lu(k,1352) = lu(k,1352) - lu(k,718) * lu(k,1345) - lu(k,1353) = lu(k,1353) - lu(k,719) * lu(k,1345) - lu(k,1354) = lu(k,1354) - lu(k,720) * lu(k,1345) - lu(k,1355) = lu(k,1355) - lu(k,721) * lu(k,1345) - lu(k,1356) = lu(k,1356) - lu(k,722) * lu(k,1345) - lu(k,1357) = lu(k,1357) - lu(k,723) * lu(k,1345) - lu(k,1358) = lu(k,1358) - lu(k,724) * lu(k,1345) - lu(k,1360) = lu(k,1360) - lu(k,725) * lu(k,1345) - lu(k,1362) = lu(k,1362) - lu(k,726) * lu(k,1345) - lu(k,1363) = lu(k,1363) - lu(k,727) * lu(k,1345) - lu(k,1364) = lu(k,1364) - lu(k,728) * lu(k,1345) - lu(k,1365) = lu(k,1365) - lu(k,729) * lu(k,1345) - lu(k,1366) = lu(k,1366) - lu(k,730) * lu(k,1345) - lu(k,1368) = lu(k,1368) - lu(k,731) * lu(k,1345) - lu(k,1369) = lu(k,1369) - lu(k,732) * lu(k,1345) - lu(k,1370) = lu(k,1370) - lu(k,733) * lu(k,1345) - lu(k,1371) = lu(k,1371) - lu(k,734) * lu(k,1345) - lu(k,1388) = lu(k,1388) - lu(k,713) * lu(k,1387) - lu(k,1390) = lu(k,1390) - lu(k,714) * lu(k,1387) - lu(k,1391) = lu(k,1391) - lu(k,715) * lu(k,1387) - lu(k,1392) = lu(k,1392) - lu(k,716) * lu(k,1387) - lu(k,1393) = lu(k,1393) - lu(k,717) * lu(k,1387) - lu(k,1394) = lu(k,1394) - lu(k,718) * lu(k,1387) - lu(k,1395) = lu(k,1395) - lu(k,719) * lu(k,1387) - lu(k,1396) = lu(k,1396) - lu(k,720) * lu(k,1387) - lu(k,1397) = lu(k,1397) - lu(k,721) * lu(k,1387) - lu(k,1398) = lu(k,1398) - lu(k,722) * lu(k,1387) - lu(k,1399) = lu(k,1399) - lu(k,723) * lu(k,1387) - lu(k,1400) = lu(k,1400) - lu(k,724) * lu(k,1387) - lu(k,1402) = lu(k,1402) - lu(k,725) * lu(k,1387) - lu(k,1404) = lu(k,1404) - lu(k,726) * lu(k,1387) - lu(k,1405) = lu(k,1405) - lu(k,727) * lu(k,1387) - lu(k,1406) = lu(k,1406) - lu(k,728) * lu(k,1387) - lu(k,1407) = lu(k,1407) - lu(k,729) * lu(k,1387) - lu(k,1408) = lu(k,1408) - lu(k,730) * lu(k,1387) - lu(k,1410) = lu(k,1410) - lu(k,731) * lu(k,1387) - lu(k,1411) = lu(k,1411) - lu(k,732) * lu(k,1387) - lu(k,1412) = lu(k,1412) - lu(k,733) * lu(k,1387) - lu(k,1413) = lu(k,1413) - lu(k,734) * lu(k,1387) - lu(k,1426) = lu(k,1426) - lu(k,713) * lu(k,1425) - lu(k,1428) = lu(k,1428) - lu(k,714) * lu(k,1425) - lu(k,1429) = lu(k,1429) - lu(k,715) * lu(k,1425) - lu(k,1430) = lu(k,1430) - lu(k,716) * lu(k,1425) - lu(k,1431) = lu(k,1431) - lu(k,717) * lu(k,1425) - lu(k,1432) = lu(k,1432) - lu(k,718) * lu(k,1425) - lu(k,1433) = lu(k,1433) - lu(k,719) * lu(k,1425) - lu(k,1434) = lu(k,1434) - lu(k,720) * lu(k,1425) - lu(k,1435) = lu(k,1435) - lu(k,721) * lu(k,1425) - lu(k,1436) = lu(k,1436) - lu(k,722) * lu(k,1425) - lu(k,1437) = lu(k,1437) - lu(k,723) * lu(k,1425) - lu(k,1438) = lu(k,1438) - lu(k,724) * lu(k,1425) - lu(k,1440) = lu(k,1440) - lu(k,725) * lu(k,1425) - lu(k,1442) = lu(k,1442) - lu(k,726) * lu(k,1425) - lu(k,1443) = lu(k,1443) - lu(k,727) * lu(k,1425) - lu(k,1444) = lu(k,1444) - lu(k,728) * lu(k,1425) - lu(k,1445) = lu(k,1445) - lu(k,729) * lu(k,1425) - lu(k,1446) = lu(k,1446) - lu(k,730) * lu(k,1425) - lu(k,1448) = lu(k,1448) - lu(k,731) * lu(k,1425) - lu(k,1449) = lu(k,1449) - lu(k,732) * lu(k,1425) - lu(k,1450) = lu(k,1450) - lu(k,733) * lu(k,1425) - lu(k,1451) = lu(k,1451) - lu(k,734) * lu(k,1425) - lu(k,1471) = lu(k,1471) - lu(k,713) * lu(k,1470) - lu(k,1473) = lu(k,1473) - lu(k,714) * lu(k,1470) - lu(k,1474) = lu(k,1474) - lu(k,715) * lu(k,1470) - lu(k,1475) = lu(k,1475) - lu(k,716) * lu(k,1470) - lu(k,1476) = lu(k,1476) - lu(k,717) * lu(k,1470) - lu(k,1477) = lu(k,1477) - lu(k,718) * lu(k,1470) - lu(k,1478) = lu(k,1478) - lu(k,719) * lu(k,1470) - lu(k,1479) = lu(k,1479) - lu(k,720) * lu(k,1470) - lu(k,1480) = lu(k,1480) - lu(k,721) * lu(k,1470) - lu(k,1481) = lu(k,1481) - lu(k,722) * lu(k,1470) - lu(k,1482) = lu(k,1482) - lu(k,723) * lu(k,1470) - lu(k,1483) = lu(k,1483) - lu(k,724) * lu(k,1470) - lu(k,1485) = lu(k,1485) - lu(k,725) * lu(k,1470) - lu(k,1487) = lu(k,1487) - lu(k,726) * lu(k,1470) - lu(k,1488) = lu(k,1488) - lu(k,727) * lu(k,1470) - lu(k,1489) = lu(k,1489) - lu(k,728) * lu(k,1470) - lu(k,1490) = lu(k,1490) - lu(k,729) * lu(k,1470) - lu(k,1491) = lu(k,1491) - lu(k,730) * lu(k,1470) - lu(k,1493) = lu(k,1493) - lu(k,731) * lu(k,1470) - lu(k,1494) = lu(k,1494) - lu(k,732) * lu(k,1470) - lu(k,1495) = lu(k,1495) - lu(k,733) * lu(k,1470) - lu(k,1496) = lu(k,1496) - lu(k,734) * lu(k,1470) - lu(k,1514) = lu(k,1514) - lu(k,713) * lu(k,1513) - lu(k,1516) = lu(k,1516) - lu(k,714) * lu(k,1513) - lu(k,1517) = lu(k,1517) - lu(k,715) * lu(k,1513) - lu(k,1518) = lu(k,1518) - lu(k,716) * lu(k,1513) - lu(k,1519) = lu(k,1519) - lu(k,717) * lu(k,1513) - lu(k,1520) = lu(k,1520) - lu(k,718) * lu(k,1513) - lu(k,1521) = lu(k,1521) - lu(k,719) * lu(k,1513) - lu(k,1522) = lu(k,1522) - lu(k,720) * lu(k,1513) - lu(k,1523) = lu(k,1523) - lu(k,721) * lu(k,1513) - lu(k,1524) = lu(k,1524) - lu(k,722) * lu(k,1513) - lu(k,1525) = lu(k,1525) - lu(k,723) * lu(k,1513) - lu(k,1526) = lu(k,1526) - lu(k,724) * lu(k,1513) - lu(k,1528) = lu(k,1528) - lu(k,725) * lu(k,1513) - lu(k,1530) = lu(k,1530) - lu(k,726) * lu(k,1513) - lu(k,1531) = lu(k,1531) - lu(k,727) * lu(k,1513) - lu(k,1532) = lu(k,1532) - lu(k,728) * lu(k,1513) - lu(k,1533) = lu(k,1533) - lu(k,729) * lu(k,1513) - lu(k,1534) = lu(k,1534) - lu(k,730) * lu(k,1513) - lu(k,1536) = lu(k,1536) - lu(k,731) * lu(k,1513) - lu(k,1537) = lu(k,1537) - lu(k,732) * lu(k,1513) - lu(k,1538) = lu(k,1538) - lu(k,733) * lu(k,1513) - lu(k,1539) = lu(k,1539) - lu(k,734) * lu(k,1513) - lu(k,1557) = lu(k,1557) - lu(k,713) * lu(k,1556) - lu(k,1559) = lu(k,1559) - lu(k,714) * lu(k,1556) - lu(k,1560) = lu(k,1560) - lu(k,715) * lu(k,1556) - lu(k,1561) = lu(k,1561) - lu(k,716) * lu(k,1556) - lu(k,1562) = lu(k,1562) - lu(k,717) * lu(k,1556) - lu(k,1563) = lu(k,1563) - lu(k,718) * lu(k,1556) - lu(k,1564) = lu(k,1564) - lu(k,719) * lu(k,1556) - lu(k,1565) = lu(k,1565) - lu(k,720) * lu(k,1556) - lu(k,1566) = lu(k,1566) - lu(k,721) * lu(k,1556) - lu(k,1567) = lu(k,1567) - lu(k,722) * lu(k,1556) - lu(k,1568) = lu(k,1568) - lu(k,723) * lu(k,1556) - lu(k,1569) = lu(k,1569) - lu(k,724) * lu(k,1556) - lu(k,1571) = lu(k,1571) - lu(k,725) * lu(k,1556) - lu(k,1573) = lu(k,1573) - lu(k,726) * lu(k,1556) - lu(k,1574) = lu(k,1574) - lu(k,727) * lu(k,1556) - lu(k,1575) = lu(k,1575) - lu(k,728) * lu(k,1556) - lu(k,1576) = lu(k,1576) - lu(k,729) * lu(k,1556) - lu(k,1577) = lu(k,1577) - lu(k,730) * lu(k,1556) - lu(k,1579) = lu(k,1579) - lu(k,731) * lu(k,1556) - lu(k,1580) = lu(k,1580) - lu(k,732) * lu(k,1556) - lu(k,1581) = lu(k,1581) - lu(k,733) * lu(k,1556) - lu(k,1582) = lu(k,1582) - lu(k,734) * lu(k,1556) - lu(k,1590) = lu(k,1590) - lu(k,713) * lu(k,1589) - lu(k,1592) = lu(k,1592) - lu(k,714) * lu(k,1589) - lu(k,1593) = lu(k,1593) - lu(k,715) * lu(k,1589) - lu(k,1594) = lu(k,1594) - lu(k,716) * lu(k,1589) - lu(k,1595) = lu(k,1595) - lu(k,717) * lu(k,1589) - lu(k,1596) = lu(k,1596) - lu(k,718) * lu(k,1589) - lu(k,1597) = lu(k,1597) - lu(k,719) * lu(k,1589) - lu(k,1598) = lu(k,1598) - lu(k,720) * lu(k,1589) - lu(k,1599) = lu(k,1599) - lu(k,721) * lu(k,1589) - lu(k,1600) = lu(k,1600) - lu(k,722) * lu(k,1589) - lu(k,1601) = lu(k,1601) - lu(k,723) * lu(k,1589) - lu(k,1602) = lu(k,1602) - lu(k,724) * lu(k,1589) - lu(k,1604) = lu(k,1604) - lu(k,725) * lu(k,1589) - lu(k,1606) = lu(k,1606) - lu(k,726) * lu(k,1589) - lu(k,1607) = lu(k,1607) - lu(k,727) * lu(k,1589) - lu(k,1608) = lu(k,1608) - lu(k,728) * lu(k,1589) - lu(k,1609) = lu(k,1609) - lu(k,729) * lu(k,1589) - lu(k,1610) = lu(k,1610) - lu(k,730) * lu(k,1589) - lu(k,1612) = lu(k,1612) - lu(k,731) * lu(k,1589) - lu(k,1613) = lu(k,1613) - lu(k,732) * lu(k,1589) - lu(k,1614) = lu(k,1614) - lu(k,733) * lu(k,1589) - lu(k,1615) = lu(k,1615) - lu(k,734) * lu(k,1589) - lu(k,1626) = lu(k,1626) - lu(k,713) * lu(k,1625) - lu(k,1628) = lu(k,1628) - lu(k,714) * lu(k,1625) - lu(k,1629) = lu(k,1629) - lu(k,715) * lu(k,1625) - lu(k,1630) = lu(k,1630) - lu(k,716) * lu(k,1625) - lu(k,1631) = lu(k,1631) - lu(k,717) * lu(k,1625) - lu(k,1632) = lu(k,1632) - lu(k,718) * lu(k,1625) - lu(k,1633) = lu(k,1633) - lu(k,719) * lu(k,1625) - lu(k,1634) = lu(k,1634) - lu(k,720) * lu(k,1625) - lu(k,1635) = lu(k,1635) - lu(k,721) * lu(k,1625) - lu(k,1636) = lu(k,1636) - lu(k,722) * lu(k,1625) - lu(k,1637) = lu(k,1637) - lu(k,723) * lu(k,1625) - lu(k,1638) = lu(k,1638) - lu(k,724) * lu(k,1625) - lu(k,1640) = lu(k,1640) - lu(k,725) * lu(k,1625) - lu(k,1642) = lu(k,1642) - lu(k,726) * lu(k,1625) - lu(k,1643) = lu(k,1643) - lu(k,727) * lu(k,1625) - lu(k,1644) = lu(k,1644) - lu(k,728) * lu(k,1625) - lu(k,1645) = lu(k,1645) - lu(k,729) * lu(k,1625) - lu(k,1646) = lu(k,1646) - lu(k,730) * lu(k,1625) - lu(k,1648) = lu(k,1648) - lu(k,731) * lu(k,1625) - lu(k,1649) = lu(k,1649) - lu(k,732) * lu(k,1625) - lu(k,1650) = lu(k,1650) - lu(k,733) * lu(k,1625) - lu(k,1651) = lu(k,1651) - lu(k,734) * lu(k,1625) - lu(k,1669) = lu(k,1669) - lu(k,713) * lu(k,1668) - lu(k,1671) = lu(k,1671) - lu(k,714) * lu(k,1668) - lu(k,1672) = lu(k,1672) - lu(k,715) * lu(k,1668) - lu(k,1673) = lu(k,1673) - lu(k,716) * lu(k,1668) - lu(k,1674) = lu(k,1674) - lu(k,717) * lu(k,1668) - lu(k,1675) = lu(k,1675) - lu(k,718) * lu(k,1668) - lu(k,1676) = lu(k,1676) - lu(k,719) * lu(k,1668) - lu(k,1677) = lu(k,1677) - lu(k,720) * lu(k,1668) - lu(k,1678) = lu(k,1678) - lu(k,721) * lu(k,1668) - lu(k,1679) = lu(k,1679) - lu(k,722) * lu(k,1668) - lu(k,1680) = lu(k,1680) - lu(k,723) * lu(k,1668) - lu(k,1681) = lu(k,1681) - lu(k,724) * lu(k,1668) - lu(k,1683) = lu(k,1683) - lu(k,725) * lu(k,1668) - lu(k,1685) = lu(k,1685) - lu(k,726) * lu(k,1668) - lu(k,1686) = lu(k,1686) - lu(k,727) * lu(k,1668) - lu(k,1687) = lu(k,1687) - lu(k,728) * lu(k,1668) - lu(k,1688) = lu(k,1688) - lu(k,729) * lu(k,1668) - lu(k,1689) = lu(k,1689) - lu(k,730) * lu(k,1668) - lu(k,1691) = lu(k,1691) - lu(k,731) * lu(k,1668) - lu(k,1692) = lu(k,1692) - lu(k,732) * lu(k,1668) - lu(k,1693) = lu(k,1693) - lu(k,733) * lu(k,1668) - lu(k,1694) = lu(k,1694) - lu(k,734) * lu(k,1668) - lu(k,1705) = lu(k,1705) - lu(k,713) * lu(k,1704) - lu(k,1707) = lu(k,1707) - lu(k,714) * lu(k,1704) - lu(k,1708) = lu(k,1708) - lu(k,715) * lu(k,1704) - lu(k,1709) = lu(k,1709) - lu(k,716) * lu(k,1704) - lu(k,1710) = lu(k,1710) - lu(k,717) * lu(k,1704) - lu(k,1711) = lu(k,1711) - lu(k,718) * lu(k,1704) - lu(k,1712) = lu(k,1712) - lu(k,719) * lu(k,1704) - lu(k,1713) = lu(k,1713) - lu(k,720) * lu(k,1704) - lu(k,1714) = lu(k,1714) - lu(k,721) * lu(k,1704) - lu(k,1715) = lu(k,1715) - lu(k,722) * lu(k,1704) - lu(k,1716) = lu(k,1716) - lu(k,723) * lu(k,1704) - lu(k,1717) = lu(k,1717) - lu(k,724) * lu(k,1704) - lu(k,1719) = lu(k,1719) - lu(k,725) * lu(k,1704) - lu(k,1721) = lu(k,1721) - lu(k,726) * lu(k,1704) - lu(k,1722) = lu(k,1722) - lu(k,727) * lu(k,1704) - lu(k,1723) = lu(k,1723) - lu(k,728) * lu(k,1704) - lu(k,1724) = lu(k,1724) - lu(k,729) * lu(k,1704) - lu(k,1725) = lu(k,1725) - lu(k,730) * lu(k,1704) - lu(k,1727) = lu(k,1727) - lu(k,731) * lu(k,1704) - lu(k,1728) = lu(k,1728) - lu(k,732) * lu(k,1704) - lu(k,1729) = lu(k,1729) - lu(k,733) * lu(k,1704) - lu(k,1730) = lu(k,1730) - lu(k,734) * lu(k,1704) - lu(k,1747) = lu(k,1747) - lu(k,713) * lu(k,1746) - lu(k,1749) = lu(k,1749) - lu(k,714) * lu(k,1746) - lu(k,1750) = lu(k,1750) - lu(k,715) * lu(k,1746) - lu(k,1751) = lu(k,1751) - lu(k,716) * lu(k,1746) - lu(k,1752) = lu(k,1752) - lu(k,717) * lu(k,1746) - lu(k,1753) = lu(k,1753) - lu(k,718) * lu(k,1746) - lu(k,1754) = lu(k,1754) - lu(k,719) * lu(k,1746) - lu(k,1755) = lu(k,1755) - lu(k,720) * lu(k,1746) - lu(k,1756) = lu(k,1756) - lu(k,721) * lu(k,1746) - lu(k,1757) = lu(k,1757) - lu(k,722) * lu(k,1746) - lu(k,1758) = lu(k,1758) - lu(k,723) * lu(k,1746) - lu(k,1759) = lu(k,1759) - lu(k,724) * lu(k,1746) - lu(k,1761) = lu(k,1761) - lu(k,725) * lu(k,1746) - lu(k,1763) = lu(k,1763) - lu(k,726) * lu(k,1746) - lu(k,1764) = lu(k,1764) - lu(k,727) * lu(k,1746) - lu(k,1765) = lu(k,1765) - lu(k,728) * lu(k,1746) - lu(k,1766) = lu(k,1766) - lu(k,729) * lu(k,1746) - lu(k,1767) = lu(k,1767) - lu(k,730) * lu(k,1746) - lu(k,1769) = lu(k,1769) - lu(k,731) * lu(k,1746) - lu(k,1770) = lu(k,1770) - lu(k,732) * lu(k,1746) - lu(k,1771) = lu(k,1771) - lu(k,733) * lu(k,1746) - lu(k,1772) = lu(k,1772) - lu(k,734) * lu(k,1746) - lu(k,1800) = lu(k,1800) - lu(k,713) * lu(k,1799) - lu(k,1802) = lu(k,1802) - lu(k,714) * lu(k,1799) - lu(k,1803) = lu(k,1803) - lu(k,715) * lu(k,1799) - lu(k,1804) = lu(k,1804) - lu(k,716) * lu(k,1799) - lu(k,1805) = lu(k,1805) - lu(k,717) * lu(k,1799) - lu(k,1806) = lu(k,1806) - lu(k,718) * lu(k,1799) - lu(k,1807) = lu(k,1807) - lu(k,719) * lu(k,1799) - lu(k,1808) = lu(k,1808) - lu(k,720) * lu(k,1799) - lu(k,1809) = lu(k,1809) - lu(k,721) * lu(k,1799) - lu(k,1810) = lu(k,1810) - lu(k,722) * lu(k,1799) - lu(k,1811) = lu(k,1811) - lu(k,723) * lu(k,1799) - lu(k,1812) = lu(k,1812) - lu(k,724) * lu(k,1799) - lu(k,1814) = lu(k,1814) - lu(k,725) * lu(k,1799) - lu(k,1816) = lu(k,1816) - lu(k,726) * lu(k,1799) - lu(k,1817) = lu(k,1817) - lu(k,727) * lu(k,1799) - lu(k,1818) = lu(k,1818) - lu(k,728) * lu(k,1799) - lu(k,1819) = lu(k,1819) - lu(k,729) * lu(k,1799) - lu(k,1820) = lu(k,1820) - lu(k,730) * lu(k,1799) - lu(k,1822) = lu(k,1822) - lu(k,731) * lu(k,1799) - lu(k,1823) = lu(k,1823) - lu(k,732) * lu(k,1799) - lu(k,1824) = lu(k,1824) - lu(k,733) * lu(k,1799) - lu(k,1825) = lu(k,1825) - lu(k,734) * lu(k,1799) - end do + real(r8), intent(inout) :: lu(:) + lu(670) = 1._r8 / lu(670) + lu(671) = lu(671) * lu(670) + lu(672) = lu(672) * lu(670) + lu(673) = lu(673) * lu(670) + lu(674) = lu(674) * lu(670) + lu(675) = lu(675) * lu(670) + lu(676) = lu(676) * lu(670) + lu(677) = lu(677) * lu(670) + lu(678) = lu(678) * lu(670) + lu(679) = lu(679) * lu(670) + lu(680) = lu(680) * lu(670) + lu(681) = lu(681) * lu(670) + lu(682) = lu(682) * lu(670) + lu(683) = lu(683) * lu(670) + lu(684) = lu(684) * lu(670) + lu(685) = lu(685) * lu(670) + lu(686) = lu(686) * lu(670) + lu(687) = lu(687) * lu(670) + lu(688) = lu(688) * lu(670) + lu(689) = lu(689) * lu(670) + lu(690) = lu(690) * lu(670) + lu(711) = lu(711) - lu(671) * lu(710) + lu(713) = lu(713) - lu(672) * lu(710) + lu(714) = lu(714) - lu(673) * lu(710) + lu(715) = lu(715) - lu(674) * lu(710) + lu(716) = lu(716) - lu(675) * lu(710) + lu(717) = lu(717) - lu(676) * lu(710) + lu(718) = lu(718) - lu(677) * lu(710) + lu(719) = lu(719) - lu(678) * lu(710) + lu(720) = lu(720) - lu(679) * lu(710) + lu(721) = lu(721) - lu(680) * lu(710) + lu(722) = lu(722) - lu(681) * lu(710) + lu(723) = lu(723) - lu(682) * lu(710) + lu(724) = lu(724) - lu(683) * lu(710) + lu(725) = lu(725) - lu(684) * lu(710) + lu(726) = lu(726) - lu(685) * lu(710) + lu(727) = lu(727) - lu(686) * lu(710) + lu(728) = lu(728) - lu(687) * lu(710) + lu(729) = lu(729) - lu(688) * lu(710) + lu(730) = lu(730) - lu(689) * lu(710) + lu(731) = lu(731) - lu(690) * lu(710) + lu(814) = lu(814) - lu(671) * lu(813) + lu(819) = lu(819) - lu(672) * lu(813) + lu(820) = lu(820) - lu(673) * lu(813) + lu(821) = lu(821) - lu(674) * lu(813) + lu(822) = lu(822) - lu(675) * lu(813) + lu(823) = lu(823) - lu(676) * lu(813) + lu(824) = lu(824) - lu(677) * lu(813) + lu(825) = lu(825) - lu(678) * lu(813) + lu(826) = lu(826) - lu(679) * lu(813) + lu(827) = lu(827) - lu(680) * lu(813) + lu(828) = lu(828) - lu(681) * lu(813) + lu(829) = lu(829) - lu(682) * lu(813) + lu(831) = lu(831) - lu(683) * lu(813) + lu(833) = lu(833) - lu(684) * lu(813) + lu(834) = lu(834) - lu(685) * lu(813) + lu(835) = lu(835) - lu(686) * lu(813) + lu(836) = lu(836) - lu(687) * lu(813) + lu(837) = lu(837) - lu(688) * lu(813) + lu(838) = lu(838) - lu(689) * lu(813) + lu(839) = lu(839) - lu(690) * lu(813) + lu(856) = lu(856) - lu(671) * lu(855) + lu(861) = lu(861) - lu(672) * lu(855) + lu(862) = lu(862) - lu(673) * lu(855) + lu(863) = lu(863) - lu(674) * lu(855) + lu(864) = lu(864) - lu(675) * lu(855) + lu(865) = lu(865) - lu(676) * lu(855) + lu(866) = lu(866) - lu(677) * lu(855) + lu(867) = lu(867) - lu(678) * lu(855) + lu(868) = lu(868) - lu(679) * lu(855) + lu(869) = lu(869) - lu(680) * lu(855) + lu(870) = lu(870) - lu(681) * lu(855) + lu(871) = lu(871) - lu(682) * lu(855) + lu(873) = lu(873) - lu(683) * lu(855) + lu(875) = lu(875) - lu(684) * lu(855) + lu(876) = lu(876) - lu(685) * lu(855) + lu(877) = lu(877) - lu(686) * lu(855) + lu(878) = lu(878) - lu(687) * lu(855) + lu(879) = lu(879) - lu(688) * lu(855) + lu(880) = lu(880) - lu(689) * lu(855) + lu(881) = lu(881) - lu(690) * lu(855) + lu(900) = lu(900) - lu(671) * lu(899) + lu(905) = lu(905) - lu(672) * lu(899) + lu(906) = lu(906) - lu(673) * lu(899) + lu(907) = lu(907) - lu(674) * lu(899) + lu(908) = lu(908) - lu(675) * lu(899) + lu(909) = lu(909) - lu(676) * lu(899) + lu(910) = lu(910) - lu(677) * lu(899) + lu(911) = lu(911) - lu(678) * lu(899) + lu(912) = lu(912) - lu(679) * lu(899) + lu(913) = lu(913) - lu(680) * lu(899) + lu(914) = lu(914) - lu(681) * lu(899) + lu(915) = lu(915) - lu(682) * lu(899) + lu(917) = lu(917) - lu(683) * lu(899) + lu(919) = lu(919) - lu(684) * lu(899) + lu(920) = lu(920) - lu(685) * lu(899) + lu(921) = lu(921) - lu(686) * lu(899) + lu(922) = lu(922) - lu(687) * lu(899) + lu(923) = lu(923) - lu(688) * lu(899) + lu(924) = lu(924) - lu(689) * lu(899) + lu(925) = lu(925) - lu(690) * lu(899) + lu(935) = lu(935) - lu(671) * lu(934) + lu(940) = lu(940) - lu(672) * lu(934) + lu(941) = lu(941) - lu(673) * lu(934) + lu(942) = lu(942) - lu(674) * lu(934) + lu(943) = lu(943) - lu(675) * lu(934) + lu(944) = lu(944) - lu(676) * lu(934) + lu(945) = lu(945) - lu(677) * lu(934) + lu(946) = lu(946) - lu(678) * lu(934) + lu(947) = lu(947) - lu(679) * lu(934) + lu(948) = lu(948) - lu(680) * lu(934) + lu(949) = lu(949) - lu(681) * lu(934) + lu(950) = lu(950) - lu(682) * lu(934) + lu(952) = lu(952) - lu(683) * lu(934) + lu(954) = lu(954) - lu(684) * lu(934) + lu(955) = lu(955) - lu(685) * lu(934) + lu(956) = lu(956) - lu(686) * lu(934) + lu(957) = lu(957) - lu(687) * lu(934) + lu(958) = lu(958) - lu(688) * lu(934) + lu(959) = lu(959) - lu(689) * lu(934) + lu(960) = lu(960) - lu(690) * lu(934) + lu(976) = lu(976) - lu(671) * lu(975) + lu(981) = lu(981) - lu(672) * lu(975) + lu(982) = lu(982) - lu(673) * lu(975) + lu(983) = lu(983) - lu(674) * lu(975) + lu(984) = lu(984) - lu(675) * lu(975) + lu(985) = lu(985) - lu(676) * lu(975) + lu(986) = lu(986) - lu(677) * lu(975) + lu(987) = lu(987) - lu(678) * lu(975) + lu(988) = lu(988) - lu(679) * lu(975) + lu(989) = lu(989) - lu(680) * lu(975) + lu(990) = lu(990) - lu(681) * lu(975) + lu(991) = lu(991) - lu(682) * lu(975) + lu(993) = lu(993) - lu(683) * lu(975) + lu(995) = lu(995) - lu(684) * lu(975) + lu(996) = lu(996) - lu(685) * lu(975) + lu(997) = lu(997) - lu(686) * lu(975) + lu(998) = lu(998) - lu(687) * lu(975) + lu(999) = lu(999) - lu(688) * lu(975) + lu(1000) = lu(1000) - lu(689) * lu(975) + lu(1001) = lu(1001) - lu(690) * lu(975) + lu(1018) = lu(1018) - lu(671) * lu(1017) + lu(1023) = lu(1023) - lu(672) * lu(1017) + lu(1024) = lu(1024) - lu(673) * lu(1017) + lu(1025) = lu(1025) - lu(674) * lu(1017) + lu(1026) = lu(1026) - lu(675) * lu(1017) + lu(1027) = lu(1027) - lu(676) * lu(1017) + lu(1028) = lu(1028) - lu(677) * lu(1017) + lu(1029) = lu(1029) - lu(678) * lu(1017) + lu(1030) = lu(1030) - lu(679) * lu(1017) + lu(1031) = lu(1031) - lu(680) * lu(1017) + lu(1032) = lu(1032) - lu(681) * lu(1017) + lu(1033) = lu(1033) - lu(682) * lu(1017) + lu(1035) = lu(1035) - lu(683) * lu(1017) + lu(1037) = lu(1037) - lu(684) * lu(1017) + lu(1038) = lu(1038) - lu(685) * lu(1017) + lu(1039) = lu(1039) - lu(686) * lu(1017) + lu(1040) = lu(1040) - lu(687) * lu(1017) + lu(1041) = lu(1041) - lu(688) * lu(1017) + lu(1042) = lu(1042) - lu(689) * lu(1017) + lu(1043) = lu(1043) - lu(690) * lu(1017) + lu(1062) = lu(1062) - lu(671) * lu(1061) + lu(1067) = lu(1067) - lu(672) * lu(1061) + lu(1068) = lu(1068) - lu(673) * lu(1061) + lu(1069) = lu(1069) - lu(674) * lu(1061) + lu(1070) = lu(1070) - lu(675) * lu(1061) + lu(1071) = lu(1071) - lu(676) * lu(1061) + lu(1072) = lu(1072) - lu(677) * lu(1061) + lu(1073) = lu(1073) - lu(678) * lu(1061) + lu(1074) = lu(1074) - lu(679) * lu(1061) + lu(1075) = lu(1075) - lu(680) * lu(1061) + lu(1076) = lu(1076) - lu(681) * lu(1061) + lu(1077) = lu(1077) - lu(682) * lu(1061) + lu(1079) = lu(1079) - lu(683) * lu(1061) + lu(1081) = lu(1081) - lu(684) * lu(1061) + lu(1082) = lu(1082) - lu(685) * lu(1061) + lu(1083) = lu(1083) - lu(686) * lu(1061) + lu(1084) = lu(1084) - lu(687) * lu(1061) + lu(1085) = lu(1085) - lu(688) * lu(1061) + lu(1086) = lu(1086) - lu(689) * lu(1061) + lu(1087) = lu(1087) - lu(690) * lu(1061) + lu(1104) = lu(1104) - lu(671) * lu(1103) + lu(1109) = lu(1109) - lu(672) * lu(1103) + lu(1110) = lu(1110) - lu(673) * lu(1103) + lu(1111) = lu(1111) - lu(674) * lu(1103) + lu(1112) = lu(1112) - lu(675) * lu(1103) + lu(1113) = lu(1113) - lu(676) * lu(1103) + lu(1114) = lu(1114) - lu(677) * lu(1103) + lu(1115) = lu(1115) - lu(678) * lu(1103) + lu(1116) = lu(1116) - lu(679) * lu(1103) + lu(1117) = lu(1117) - lu(680) * lu(1103) + lu(1118) = lu(1118) - lu(681) * lu(1103) + lu(1119) = lu(1119) - lu(682) * lu(1103) + lu(1121) = lu(1121) - lu(683) * lu(1103) + lu(1123) = lu(1123) - lu(684) * lu(1103) + lu(1124) = lu(1124) - lu(685) * lu(1103) + lu(1125) = lu(1125) - lu(686) * lu(1103) + lu(1126) = lu(1126) - lu(687) * lu(1103) + lu(1127) = lu(1127) - lu(688) * lu(1103) + lu(1128) = lu(1128) - lu(689) * lu(1103) + lu(1129) = lu(1129) - lu(690) * lu(1103) + lu(1147) = lu(1147) - lu(671) * lu(1146) + lu(1152) = lu(1152) - lu(672) * lu(1146) + lu(1153) = lu(1153) - lu(673) * lu(1146) + lu(1154) = lu(1154) - lu(674) * lu(1146) + lu(1155) = lu(1155) - lu(675) * lu(1146) + lu(1156) = lu(1156) - lu(676) * lu(1146) + lu(1157) = lu(1157) - lu(677) * lu(1146) + lu(1158) = lu(1158) - lu(678) * lu(1146) + lu(1159) = lu(1159) - lu(679) * lu(1146) + lu(1160) = lu(1160) - lu(680) * lu(1146) + lu(1161) = lu(1161) - lu(681) * lu(1146) + lu(1162) = lu(1162) - lu(682) * lu(1146) + lu(1164) = lu(1164) - lu(683) * lu(1146) + lu(1166) = lu(1166) - lu(684) * lu(1146) + lu(1167) = lu(1167) - lu(685) * lu(1146) + lu(1168) = lu(1168) - lu(686) * lu(1146) + lu(1169) = lu(1169) - lu(687) * lu(1146) + lu(1170) = lu(1170) - lu(688) * lu(1146) + lu(1171) = lu(1171) - lu(689) * lu(1146) + lu(1172) = lu(1172) - lu(690) * lu(1146) + lu(1189) = lu(1189) - lu(671) * lu(1188) + lu(1194) = lu(1194) - lu(672) * lu(1188) + lu(1195) = lu(1195) - lu(673) * lu(1188) + lu(1196) = lu(1196) - lu(674) * lu(1188) + lu(1197) = lu(1197) - lu(675) * lu(1188) + lu(1198) = lu(1198) - lu(676) * lu(1188) + lu(1199) = lu(1199) - lu(677) * lu(1188) + lu(1200) = lu(1200) - lu(678) * lu(1188) + lu(1201) = lu(1201) - lu(679) * lu(1188) + lu(1202) = lu(1202) - lu(680) * lu(1188) + lu(1203) = lu(1203) - lu(681) * lu(1188) + lu(1204) = lu(1204) - lu(682) * lu(1188) + lu(1206) = lu(1206) - lu(683) * lu(1188) + lu(1208) = lu(1208) - lu(684) * lu(1188) + lu(1209) = lu(1209) - lu(685) * lu(1188) + lu(1210) = lu(1210) - lu(686) * lu(1188) + lu(1211) = lu(1211) - lu(687) * lu(1188) + lu(1212) = lu(1212) - lu(688) * lu(1188) + lu(1213) = lu(1213) - lu(689) * lu(1188) + lu(1214) = lu(1214) - lu(690) * lu(1188) + lu(1224) = lu(1224) - lu(671) * lu(1223) + lu(1229) = lu(1229) - lu(672) * lu(1223) + lu(1230) = lu(1230) - lu(673) * lu(1223) + lu(1231) = lu(1231) - lu(674) * lu(1223) + lu(1232) = lu(1232) - lu(675) * lu(1223) + lu(1233) = lu(1233) - lu(676) * lu(1223) + lu(1234) = lu(1234) - lu(677) * lu(1223) + lu(1235) = lu(1235) - lu(678) * lu(1223) + lu(1236) = lu(1236) - lu(679) * lu(1223) + lu(1237) = lu(1237) - lu(680) * lu(1223) + lu(1238) = lu(1238) - lu(681) * lu(1223) + lu(1239) = lu(1239) - lu(682) * lu(1223) + lu(1241) = lu(1241) - lu(683) * lu(1223) + lu(1243) = lu(1243) - lu(684) * lu(1223) + lu(1244) = lu(1244) - lu(685) * lu(1223) + lu(1245) = lu(1245) - lu(686) * lu(1223) + lu(1246) = lu(1246) - lu(687) * lu(1223) + lu(1247) = lu(1247) - lu(688) * lu(1223) + lu(1248) = lu(1248) - lu(689) * lu(1223) + lu(1249) = lu(1249) - lu(690) * lu(1223) + lu(1268) = lu(1268) - lu(671) * lu(1267) + lu(1273) = lu(1273) - lu(672) * lu(1267) + lu(1274) = lu(1274) - lu(673) * lu(1267) + lu(1275) = lu(1275) - lu(674) * lu(1267) + lu(1276) = lu(1276) - lu(675) * lu(1267) + lu(1277) = lu(1277) - lu(676) * lu(1267) + lu(1278) = lu(1278) - lu(677) * lu(1267) + lu(1279) = lu(1279) - lu(678) * lu(1267) + lu(1280) = lu(1280) - lu(679) * lu(1267) + lu(1281) = lu(1281) - lu(680) * lu(1267) + lu(1282) = lu(1282) - lu(681) * lu(1267) + lu(1283) = lu(1283) - lu(682) * lu(1267) + lu(1285) = lu(1285) - lu(683) * lu(1267) + lu(1287) = lu(1287) - lu(684) * lu(1267) + lu(1288) = lu(1288) - lu(685) * lu(1267) + lu(1289) = lu(1289) - lu(686) * lu(1267) + lu(1290) = lu(1290) - lu(687) * lu(1267) + lu(1291) = lu(1291) - lu(688) * lu(1267) + lu(1292) = lu(1292) - lu(689) * lu(1267) + lu(1293) = lu(1293) - lu(690) * lu(1267) + lu(1309) = lu(1309) - lu(671) * lu(1308) + lu(1314) = lu(1314) - lu(672) * lu(1308) + lu(1315) = lu(1315) - lu(673) * lu(1308) + lu(1316) = lu(1316) - lu(674) * lu(1308) + lu(1317) = lu(1317) - lu(675) * lu(1308) + lu(1318) = lu(1318) - lu(676) * lu(1308) + lu(1319) = lu(1319) - lu(677) * lu(1308) + lu(1320) = lu(1320) - lu(678) * lu(1308) + lu(1321) = lu(1321) - lu(679) * lu(1308) + lu(1322) = lu(1322) - lu(680) * lu(1308) + lu(1323) = lu(1323) - lu(681) * lu(1308) + lu(1324) = lu(1324) - lu(682) * lu(1308) + lu(1326) = lu(1326) - lu(683) * lu(1308) + lu(1328) = lu(1328) - lu(684) * lu(1308) + lu(1329) = lu(1329) - lu(685) * lu(1308) + lu(1330) = lu(1330) - lu(686) * lu(1308) + lu(1331) = lu(1331) - lu(687) * lu(1308) + lu(1332) = lu(1332) - lu(688) * lu(1308) + lu(1333) = lu(1333) - lu(689) * lu(1308) + lu(1334) = lu(1334) - lu(690) * lu(1308) + lu(1351) = lu(1351) - lu(671) * lu(1350) + lu(1356) = lu(1356) - lu(672) * lu(1350) + lu(1357) = lu(1357) - lu(673) * lu(1350) + lu(1358) = lu(1358) - lu(674) * lu(1350) + lu(1359) = lu(1359) - lu(675) * lu(1350) + lu(1360) = lu(1360) - lu(676) * lu(1350) + lu(1361) = lu(1361) - lu(677) * lu(1350) + lu(1362) = lu(1362) - lu(678) * lu(1350) + lu(1363) = lu(1363) - lu(679) * lu(1350) + lu(1364) = lu(1364) - lu(680) * lu(1350) + lu(1365) = lu(1365) - lu(681) * lu(1350) + lu(1366) = lu(1366) - lu(682) * lu(1350) + lu(1368) = lu(1368) - lu(683) * lu(1350) + lu(1370) = lu(1370) - lu(684) * lu(1350) + lu(1371) = lu(1371) - lu(685) * lu(1350) + lu(1372) = lu(1372) - lu(686) * lu(1350) + lu(1373) = lu(1373) - lu(687) * lu(1350) + lu(1374) = lu(1374) - lu(688) * lu(1350) + lu(1375) = lu(1375) - lu(689) * lu(1350) + lu(1376) = lu(1376) - lu(690) * lu(1350) + lu(1395) = lu(1395) - lu(671) * lu(1394) + lu(1398) = lu(1398) - lu(672) * lu(1394) + lu(1399) = lu(1399) - lu(673) * lu(1394) + lu(1400) = lu(1400) - lu(674) * lu(1394) + lu(1401) = lu(1401) - lu(675) * lu(1394) + lu(1402) = lu(1402) - lu(676) * lu(1394) + lu(1403) = lu(1403) - lu(677) * lu(1394) + lu(1404) = lu(1404) - lu(678) * lu(1394) + lu(1405) = lu(1405) - lu(679) * lu(1394) + lu(1406) = lu(1406) - lu(680) * lu(1394) + lu(1407) = lu(1407) - lu(681) * lu(1394) + lu(1408) = lu(1408) - lu(682) * lu(1394) + lu(1410) = lu(1410) - lu(683) * lu(1394) + lu(1412) = lu(1412) - lu(684) * lu(1394) + lu(1413) = lu(1413) - lu(685) * lu(1394) + lu(1414) = lu(1414) - lu(686) * lu(1394) + lu(1415) = lu(1415) - lu(687) * lu(1394) + lu(1416) = lu(1416) - lu(688) * lu(1394) + lu(1417) = lu(1417) - lu(689) * lu(1394) + lu(1418) = lu(1418) - lu(690) * lu(1394) + lu(1435) = lu(1435) - lu(671) * lu(1434) + lu(1440) = lu(1440) - lu(672) * lu(1434) + lu(1441) = lu(1441) - lu(673) * lu(1434) + lu(1442) = lu(1442) - lu(674) * lu(1434) + lu(1443) = lu(1443) - lu(675) * lu(1434) + lu(1444) = lu(1444) - lu(676) * lu(1434) + lu(1445) = lu(1445) - lu(677) * lu(1434) + lu(1446) = lu(1446) - lu(678) * lu(1434) + lu(1447) = lu(1447) - lu(679) * lu(1434) + lu(1448) = lu(1448) - lu(680) * lu(1434) + lu(1449) = lu(1449) - lu(681) * lu(1434) + lu(1450) = lu(1450) - lu(682) * lu(1434) + lu(1452) = lu(1452) - lu(683) * lu(1434) + lu(1454) = lu(1454) - lu(684) * lu(1434) + lu(1455) = lu(1455) - lu(685) * lu(1434) + lu(1456) = lu(1456) - lu(686) * lu(1434) + lu(1457) = lu(1457) - lu(687) * lu(1434) + lu(1458) = lu(1458) - lu(688) * lu(1434) + lu(1459) = lu(1459) - lu(689) * lu(1434) + lu(1460) = lu(1460) - lu(690) * lu(1434) + lu(1490) = lu(1490) - lu(671) * lu(1489) + lu(1495) = lu(1495) - lu(672) * lu(1489) + lu(1496) = lu(1496) - lu(673) * lu(1489) + lu(1497) = lu(1497) - lu(674) * lu(1489) + lu(1498) = lu(1498) - lu(675) * lu(1489) + lu(1499) = lu(1499) - lu(676) * lu(1489) + lu(1500) = lu(1500) - lu(677) * lu(1489) + lu(1501) = lu(1501) - lu(678) * lu(1489) + lu(1502) = lu(1502) - lu(679) * lu(1489) + lu(1503) = lu(1503) - lu(680) * lu(1489) + lu(1504) = lu(1504) - lu(681) * lu(1489) + lu(1505) = lu(1505) - lu(682) * lu(1489) + lu(1507) = lu(1507) - lu(683) * lu(1489) + lu(1509) = lu(1509) - lu(684) * lu(1489) + lu(1510) = lu(1510) - lu(685) * lu(1489) + lu(1511) = lu(1511) - lu(686) * lu(1489) + lu(1512) = lu(1512) - lu(687) * lu(1489) + lu(1513) = lu(1513) - lu(688) * lu(1489) + lu(1514) = lu(1514) - lu(689) * lu(1489) + lu(1515) = lu(1515) - lu(690) * lu(1489) + lu(1522) = lu(1522) - lu(671) * lu(1521) + lu(1527) = lu(1527) - lu(672) * lu(1521) + lu(1528) = lu(1528) - lu(673) * lu(1521) + lu(1529) = lu(1529) - lu(674) * lu(1521) + lu(1530) = lu(1530) - lu(675) * lu(1521) + lu(1531) = lu(1531) - lu(676) * lu(1521) + lu(1532) = lu(1532) - lu(677) * lu(1521) + lu(1533) = lu(1533) - lu(678) * lu(1521) + lu(1534) = lu(1534) - lu(679) * lu(1521) + lu(1535) = lu(1535) - lu(680) * lu(1521) + lu(1536) = lu(1536) - lu(681) * lu(1521) + lu(1537) = lu(1537) - lu(682) * lu(1521) + lu(1539) = lu(1539) - lu(683) * lu(1521) + lu(1541) = lu(1541) - lu(684) * lu(1521) + lu(1542) = lu(1542) - lu(685) * lu(1521) + lu(1543) = lu(1543) - lu(686) * lu(1521) + lu(1544) = lu(1544) - lu(687) * lu(1521) + lu(1545) = lu(1545) - lu(688) * lu(1521) + lu(1546) = lu(1546) - lu(689) * lu(1521) + lu(1547) = lu(1547) - lu(690) * lu(1521) + lu(1557) = lu(1557) - lu(671) * lu(1556) + lu(1562) = lu(1562) - lu(672) * lu(1556) + lu(1563) = lu(1563) - lu(673) * lu(1556) + lu(1564) = lu(1564) - lu(674) * lu(1556) + lu(1565) = lu(1565) - lu(675) * lu(1556) + lu(1566) = lu(1566) - lu(676) * lu(1556) + lu(1567) = lu(1567) - lu(677) * lu(1556) + lu(1568) = lu(1568) - lu(678) * lu(1556) + lu(1569) = lu(1569) - lu(679) * lu(1556) + lu(1570) = lu(1570) - lu(680) * lu(1556) + lu(1571) = lu(1571) - lu(681) * lu(1556) + lu(1572) = lu(1572) - lu(682) * lu(1556) + lu(1574) = lu(1574) - lu(683) * lu(1556) + lu(1576) = lu(1576) - lu(684) * lu(1556) + lu(1577) = lu(1577) - lu(685) * lu(1556) + lu(1578) = lu(1578) - lu(686) * lu(1556) + lu(1579) = lu(1579) - lu(687) * lu(1556) + lu(1580) = lu(1580) - lu(688) * lu(1556) + lu(1581) = lu(1581) - lu(689) * lu(1556) + lu(1582) = lu(1582) - lu(690) * lu(1556) + lu(1595) = lu(1595) - lu(671) * lu(1594) + lu(1600) = lu(1600) - lu(672) * lu(1594) + lu(1601) = lu(1601) - lu(673) * lu(1594) + lu(1602) = lu(1602) - lu(674) * lu(1594) + lu(1603) = lu(1603) - lu(675) * lu(1594) + lu(1604) = lu(1604) - lu(676) * lu(1594) + lu(1605) = lu(1605) - lu(677) * lu(1594) + lu(1606) = lu(1606) - lu(678) * lu(1594) + lu(1607) = lu(1607) - lu(679) * lu(1594) + lu(1608) = lu(1608) - lu(680) * lu(1594) + lu(1609) = lu(1609) - lu(681) * lu(1594) + lu(1610) = lu(1610) - lu(682) * lu(1594) + lu(1612) = lu(1612) - lu(683) * lu(1594) + lu(1614) = lu(1614) - lu(684) * lu(1594) + lu(1615) = lu(1615) - lu(685) * lu(1594) + lu(1616) = lu(1616) - lu(686) * lu(1594) + lu(1617) = lu(1617) - lu(687) * lu(1594) + lu(1618) = lu(1618) - lu(688) * lu(1594) + lu(1619) = lu(1619) - lu(689) * lu(1594) + lu(1620) = lu(1620) - lu(690) * lu(1594) + lu(1634) = lu(1634) - lu(671) * lu(1633) + lu(1639) = lu(1639) - lu(672) * lu(1633) + lu(1640) = lu(1640) - lu(673) * lu(1633) + lu(1641) = lu(1641) - lu(674) * lu(1633) + lu(1642) = lu(1642) - lu(675) * lu(1633) + lu(1643) = lu(1643) - lu(676) * lu(1633) + lu(1644) = lu(1644) - lu(677) * lu(1633) + lu(1645) = lu(1645) - lu(678) * lu(1633) + lu(1646) = lu(1646) - lu(679) * lu(1633) + lu(1647) = lu(1647) - lu(680) * lu(1633) + lu(1648) = lu(1648) - lu(681) * lu(1633) + lu(1649) = lu(1649) - lu(682) * lu(1633) + lu(1651) = lu(1651) - lu(683) * lu(1633) + lu(1653) = lu(1653) - lu(684) * lu(1633) + lu(1654) = lu(1654) - lu(685) * lu(1633) + lu(1655) = lu(1655) - lu(686) * lu(1633) + lu(1656) = lu(1656) - lu(687) * lu(1633) + lu(1657) = lu(1657) - lu(688) * lu(1633) + lu(1658) = lu(1658) - lu(689) * lu(1633) + lu(1659) = lu(1659) - lu(690) * lu(1633) + lu(1669) = lu(1669) - lu(671) * lu(1668) + lu(1673) = lu(1673) - lu(672) * lu(1668) + lu(1674) = lu(1674) - lu(673) * lu(1668) + lu(1675) = lu(1675) - lu(674) * lu(1668) + lu(1676) = lu(1676) - lu(675) * lu(1668) + lu(1677) = lu(1677) - lu(676) * lu(1668) + lu(1678) = lu(1678) - lu(677) * lu(1668) + lu(1679) = lu(1679) - lu(678) * lu(1668) + lu(1680) = lu(1680) - lu(679) * lu(1668) + lu(1681) = lu(1681) - lu(680) * lu(1668) + lu(1682) = lu(1682) - lu(681) * lu(1668) + lu(1683) = lu(1683) - lu(682) * lu(1668) + lu(1685) = lu(1685) - lu(683) * lu(1668) + lu(1687) = lu(1687) - lu(684) * lu(1668) + lu(1688) = lu(1688) - lu(685) * lu(1668) + lu(1689) = lu(1689) - lu(686) * lu(1668) + lu(1690) = lu(1690) - lu(687) * lu(1668) + lu(1691) = lu(1691) - lu(688) * lu(1668) + lu(1692) = lu(1692) - lu(689) * lu(1668) + lu(1693) = lu(1693) - lu(690) * lu(1668) + lu(1720) = lu(1720) - lu(671) * lu(1719) + lu(1725) = lu(1725) - lu(672) * lu(1719) + lu(1726) = lu(1726) - lu(673) * lu(1719) + lu(1727) = lu(1727) - lu(674) * lu(1719) + lu(1728) = lu(1728) - lu(675) * lu(1719) + lu(1729) = lu(1729) - lu(676) * lu(1719) + lu(1730) = lu(1730) - lu(677) * lu(1719) + lu(1731) = lu(1731) - lu(678) * lu(1719) + lu(1732) = lu(1732) - lu(679) * lu(1719) + lu(1733) = lu(1733) - lu(680) * lu(1719) + lu(1734) = lu(1734) - lu(681) * lu(1719) + lu(1735) = lu(1735) - lu(682) * lu(1719) + lu(1737) = lu(1737) - lu(683) * lu(1719) + lu(1739) = lu(1739) - lu(684) * lu(1719) + lu(1740) = lu(1740) - lu(685) * lu(1719) + lu(1741) = lu(1741) - lu(686) * lu(1719) + lu(1742) = lu(1742) - lu(687) * lu(1719) + lu(1743) = lu(1743) - lu(688) * lu(1719) + lu(1744) = lu(1744) - lu(689) * lu(1719) + lu(1745) = lu(1745) - lu(690) * lu(1719) + lu(711) = 1._r8 / lu(711) + lu(712) = lu(712) * lu(711) + lu(713) = lu(713) * lu(711) + lu(714) = lu(714) * lu(711) + lu(715) = lu(715) * lu(711) + lu(716) = lu(716) * lu(711) + lu(717) = lu(717) * lu(711) + lu(718) = lu(718) * lu(711) + lu(719) = lu(719) * lu(711) + lu(720) = lu(720) * lu(711) + lu(721) = lu(721) * lu(711) + lu(722) = lu(722) * lu(711) + lu(723) = lu(723) * lu(711) + lu(724) = lu(724) * lu(711) + lu(725) = lu(725) * lu(711) + lu(726) = lu(726) * lu(711) + lu(727) = lu(727) * lu(711) + lu(728) = lu(728) * lu(711) + lu(729) = lu(729) * lu(711) + lu(730) = lu(730) * lu(711) + lu(731) = lu(731) * lu(711) + lu(741) = lu(741) - lu(712) * lu(738) + lu(743) = lu(743) - lu(713) * lu(738) + lu(744) = lu(744) - lu(714) * lu(738) + lu(745) = lu(745) - lu(715) * lu(738) + lu(746) = lu(746) - lu(716) * lu(738) + lu(747) = lu(747) - lu(717) * lu(738) + lu(748) = lu(748) - lu(718) * lu(738) + lu(749) = lu(749) - lu(719) * lu(738) + lu(750) = lu(750) - lu(720) * lu(738) + lu(751) = lu(751) - lu(721) * lu(738) + lu(752) = lu(752) - lu(722) * lu(738) + lu(753) = lu(753) - lu(723) * lu(738) + lu(755) = lu(755) - lu(724) * lu(738) + lu(757) = lu(757) - lu(725) * lu(738) + lu(758) = lu(758) - lu(726) * lu(738) + lu(759) = lu(759) - lu(727) * lu(738) + lu(760) = lu(760) - lu(728) * lu(738) + lu(761) = lu(761) - lu(729) * lu(738) + lu(762) = lu(762) - lu(730) * lu(738) + lu(763) = lu(763) - lu(731) * lu(738) + lu(770) = lu(770) - lu(712) * lu(768) + lu(772) = lu(772) - lu(713) * lu(768) + lu(773) = lu(773) - lu(714) * lu(768) + lu(774) = lu(774) - lu(715) * lu(768) + lu(775) = lu(775) - lu(716) * lu(768) + lu(776) = lu(776) - lu(717) * lu(768) + lu(777) = lu(777) - lu(718) * lu(768) + lu(778) = lu(778) - lu(719) * lu(768) + lu(779) = lu(779) - lu(720) * lu(768) + lu(780) = - lu(721) * lu(768) + lu(781) = lu(781) - lu(722) * lu(768) + lu(782) = lu(782) - lu(723) * lu(768) + lu(784) = lu(784) - lu(724) * lu(768) + lu(786) = lu(786) - lu(725) * lu(768) + lu(787) = lu(787) - lu(726) * lu(768) + lu(788) = - lu(727) * lu(768) + lu(789) = lu(789) - lu(728) * lu(768) + lu(790) = lu(790) - lu(729) * lu(768) + lu(791) = lu(791) - lu(730) * lu(768) + lu(792) = lu(792) - lu(731) * lu(768) + lu(817) = lu(817) - lu(712) * lu(814) + lu(819) = lu(819) - lu(713) * lu(814) + lu(820) = lu(820) - lu(714) * lu(814) + lu(821) = lu(821) - lu(715) * lu(814) + lu(822) = lu(822) - lu(716) * lu(814) + lu(823) = lu(823) - lu(717) * lu(814) + lu(824) = lu(824) - lu(718) * lu(814) + lu(825) = lu(825) - lu(719) * lu(814) + lu(826) = lu(826) - lu(720) * lu(814) + lu(827) = lu(827) - lu(721) * lu(814) + lu(828) = lu(828) - lu(722) * lu(814) + lu(829) = lu(829) - lu(723) * lu(814) + lu(831) = lu(831) - lu(724) * lu(814) + lu(833) = lu(833) - lu(725) * lu(814) + lu(834) = lu(834) - lu(726) * lu(814) + lu(835) = lu(835) - lu(727) * lu(814) + lu(836) = lu(836) - lu(728) * lu(814) + lu(837) = lu(837) - lu(729) * lu(814) + lu(838) = lu(838) - lu(730) * lu(814) + lu(839) = lu(839) - lu(731) * lu(814) + lu(859) = lu(859) - lu(712) * lu(856) + lu(861) = lu(861) - lu(713) * lu(856) + lu(862) = lu(862) - lu(714) * lu(856) + lu(863) = lu(863) - lu(715) * lu(856) + lu(864) = lu(864) - lu(716) * lu(856) + lu(865) = lu(865) - lu(717) * lu(856) + lu(866) = lu(866) - lu(718) * lu(856) + lu(867) = lu(867) - lu(719) * lu(856) + lu(868) = lu(868) - lu(720) * lu(856) + lu(869) = lu(869) - lu(721) * lu(856) + lu(870) = lu(870) - lu(722) * lu(856) + lu(871) = lu(871) - lu(723) * lu(856) + lu(873) = lu(873) - lu(724) * lu(856) + lu(875) = lu(875) - lu(725) * lu(856) + lu(876) = lu(876) - lu(726) * lu(856) + lu(877) = lu(877) - lu(727) * lu(856) + lu(878) = lu(878) - lu(728) * lu(856) + lu(879) = lu(879) - lu(729) * lu(856) + lu(880) = lu(880) - lu(730) * lu(856) + lu(881) = lu(881) - lu(731) * lu(856) + lu(903) = lu(903) - lu(712) * lu(900) + lu(905) = lu(905) - lu(713) * lu(900) + lu(906) = lu(906) - lu(714) * lu(900) + lu(907) = lu(907) - lu(715) * lu(900) + lu(908) = lu(908) - lu(716) * lu(900) + lu(909) = lu(909) - lu(717) * lu(900) + lu(910) = lu(910) - lu(718) * lu(900) + lu(911) = lu(911) - lu(719) * lu(900) + lu(912) = lu(912) - lu(720) * lu(900) + lu(913) = lu(913) - lu(721) * lu(900) + lu(914) = lu(914) - lu(722) * lu(900) + lu(915) = lu(915) - lu(723) * lu(900) + lu(917) = lu(917) - lu(724) * lu(900) + lu(919) = lu(919) - lu(725) * lu(900) + lu(920) = lu(920) - lu(726) * lu(900) + lu(921) = lu(921) - lu(727) * lu(900) + lu(922) = lu(922) - lu(728) * lu(900) + lu(923) = lu(923) - lu(729) * lu(900) + lu(924) = lu(924) - lu(730) * lu(900) + lu(925) = lu(925) - lu(731) * lu(900) + lu(938) = lu(938) - lu(712) * lu(935) + lu(940) = lu(940) - lu(713) * lu(935) + lu(941) = lu(941) - lu(714) * lu(935) + lu(942) = lu(942) - lu(715) * lu(935) + lu(943) = lu(943) - lu(716) * lu(935) + lu(944) = lu(944) - lu(717) * lu(935) + lu(945) = lu(945) - lu(718) * lu(935) + lu(946) = lu(946) - lu(719) * lu(935) + lu(947) = lu(947) - lu(720) * lu(935) + lu(948) = lu(948) - lu(721) * lu(935) + lu(949) = lu(949) - lu(722) * lu(935) + lu(950) = lu(950) - lu(723) * lu(935) + lu(952) = lu(952) - lu(724) * lu(935) + lu(954) = lu(954) - lu(725) * lu(935) + lu(955) = lu(955) - lu(726) * lu(935) + lu(956) = lu(956) - lu(727) * lu(935) + lu(957) = lu(957) - lu(728) * lu(935) + lu(958) = lu(958) - lu(729) * lu(935) + lu(959) = lu(959) - lu(730) * lu(935) + lu(960) = lu(960) - lu(731) * lu(935) + lu(979) = lu(979) - lu(712) * lu(976) + lu(981) = lu(981) - lu(713) * lu(976) + lu(982) = lu(982) - lu(714) * lu(976) + lu(983) = lu(983) - lu(715) * lu(976) + lu(984) = lu(984) - lu(716) * lu(976) + lu(985) = lu(985) - lu(717) * lu(976) + lu(986) = lu(986) - lu(718) * lu(976) + lu(987) = lu(987) - lu(719) * lu(976) + lu(988) = lu(988) - lu(720) * lu(976) + lu(989) = lu(989) - lu(721) * lu(976) + lu(990) = lu(990) - lu(722) * lu(976) + lu(991) = lu(991) - lu(723) * lu(976) + lu(993) = lu(993) - lu(724) * lu(976) + lu(995) = lu(995) - lu(725) * lu(976) + lu(996) = lu(996) - lu(726) * lu(976) + lu(997) = lu(997) - lu(727) * lu(976) + lu(998) = lu(998) - lu(728) * lu(976) + lu(999) = lu(999) - lu(729) * lu(976) + lu(1000) = lu(1000) - lu(730) * lu(976) + lu(1001) = lu(1001) - lu(731) * lu(976) + lu(1021) = lu(1021) - lu(712) * lu(1018) + lu(1023) = lu(1023) - lu(713) * lu(1018) + lu(1024) = lu(1024) - lu(714) * lu(1018) + lu(1025) = lu(1025) - lu(715) * lu(1018) + lu(1026) = lu(1026) - lu(716) * lu(1018) + lu(1027) = lu(1027) - lu(717) * lu(1018) + lu(1028) = lu(1028) - lu(718) * lu(1018) + lu(1029) = lu(1029) - lu(719) * lu(1018) + lu(1030) = lu(1030) - lu(720) * lu(1018) + lu(1031) = lu(1031) - lu(721) * lu(1018) + lu(1032) = lu(1032) - lu(722) * lu(1018) + lu(1033) = lu(1033) - lu(723) * lu(1018) + lu(1035) = lu(1035) - lu(724) * lu(1018) + lu(1037) = lu(1037) - lu(725) * lu(1018) + lu(1038) = lu(1038) - lu(726) * lu(1018) + lu(1039) = lu(1039) - lu(727) * lu(1018) + lu(1040) = lu(1040) - lu(728) * lu(1018) + lu(1041) = lu(1041) - lu(729) * lu(1018) + lu(1042) = lu(1042) - lu(730) * lu(1018) + lu(1043) = lu(1043) - lu(731) * lu(1018) + lu(1065) = lu(1065) - lu(712) * lu(1062) + lu(1067) = lu(1067) - lu(713) * lu(1062) + lu(1068) = lu(1068) - lu(714) * lu(1062) + lu(1069) = lu(1069) - lu(715) * lu(1062) + lu(1070) = lu(1070) - lu(716) * lu(1062) + lu(1071) = lu(1071) - lu(717) * lu(1062) + lu(1072) = lu(1072) - lu(718) * lu(1062) + lu(1073) = lu(1073) - lu(719) * lu(1062) + lu(1074) = lu(1074) - lu(720) * lu(1062) + lu(1075) = lu(1075) - lu(721) * lu(1062) + lu(1076) = lu(1076) - lu(722) * lu(1062) + lu(1077) = lu(1077) - lu(723) * lu(1062) + lu(1079) = lu(1079) - lu(724) * lu(1062) + lu(1081) = lu(1081) - lu(725) * lu(1062) + lu(1082) = lu(1082) - lu(726) * lu(1062) + lu(1083) = lu(1083) - lu(727) * lu(1062) + lu(1084) = lu(1084) - lu(728) * lu(1062) + lu(1085) = lu(1085) - lu(729) * lu(1062) + lu(1086) = lu(1086) - lu(730) * lu(1062) + lu(1087) = lu(1087) - lu(731) * lu(1062) + lu(1107) = lu(1107) - lu(712) * lu(1104) + lu(1109) = lu(1109) - lu(713) * lu(1104) + lu(1110) = lu(1110) - lu(714) * lu(1104) + lu(1111) = lu(1111) - lu(715) * lu(1104) + lu(1112) = lu(1112) - lu(716) * lu(1104) + lu(1113) = lu(1113) - lu(717) * lu(1104) + lu(1114) = lu(1114) - lu(718) * lu(1104) + lu(1115) = lu(1115) - lu(719) * lu(1104) + lu(1116) = lu(1116) - lu(720) * lu(1104) + lu(1117) = lu(1117) - lu(721) * lu(1104) + lu(1118) = lu(1118) - lu(722) * lu(1104) + lu(1119) = lu(1119) - lu(723) * lu(1104) + lu(1121) = lu(1121) - lu(724) * lu(1104) + lu(1123) = lu(1123) - lu(725) * lu(1104) + lu(1124) = lu(1124) - lu(726) * lu(1104) + lu(1125) = lu(1125) - lu(727) * lu(1104) + lu(1126) = lu(1126) - lu(728) * lu(1104) + lu(1127) = lu(1127) - lu(729) * lu(1104) + lu(1128) = lu(1128) - lu(730) * lu(1104) + lu(1129) = lu(1129) - lu(731) * lu(1104) + lu(1150) = lu(1150) - lu(712) * lu(1147) + lu(1152) = lu(1152) - lu(713) * lu(1147) + lu(1153) = lu(1153) - lu(714) * lu(1147) + lu(1154) = lu(1154) - lu(715) * lu(1147) + lu(1155) = lu(1155) - lu(716) * lu(1147) + lu(1156) = lu(1156) - lu(717) * lu(1147) + lu(1157) = lu(1157) - lu(718) * lu(1147) + lu(1158) = lu(1158) - lu(719) * lu(1147) + lu(1159) = lu(1159) - lu(720) * lu(1147) + lu(1160) = lu(1160) - lu(721) * lu(1147) + lu(1161) = lu(1161) - lu(722) * lu(1147) + lu(1162) = lu(1162) - lu(723) * lu(1147) + lu(1164) = lu(1164) - lu(724) * lu(1147) + lu(1166) = lu(1166) - lu(725) * lu(1147) + lu(1167) = lu(1167) - lu(726) * lu(1147) + lu(1168) = lu(1168) - lu(727) * lu(1147) + lu(1169) = lu(1169) - lu(728) * lu(1147) + lu(1170) = lu(1170) - lu(729) * lu(1147) + lu(1171) = lu(1171) - lu(730) * lu(1147) + lu(1172) = lu(1172) - lu(731) * lu(1147) + lu(1192) = lu(1192) - lu(712) * lu(1189) + lu(1194) = lu(1194) - lu(713) * lu(1189) + lu(1195) = lu(1195) - lu(714) * lu(1189) + lu(1196) = lu(1196) - lu(715) * lu(1189) + lu(1197) = lu(1197) - lu(716) * lu(1189) + lu(1198) = lu(1198) - lu(717) * lu(1189) + lu(1199) = lu(1199) - lu(718) * lu(1189) + lu(1200) = lu(1200) - lu(719) * lu(1189) + lu(1201) = lu(1201) - lu(720) * lu(1189) + lu(1202) = lu(1202) - lu(721) * lu(1189) + lu(1203) = lu(1203) - lu(722) * lu(1189) + lu(1204) = lu(1204) - lu(723) * lu(1189) + lu(1206) = lu(1206) - lu(724) * lu(1189) + lu(1208) = lu(1208) - lu(725) * lu(1189) + lu(1209) = lu(1209) - lu(726) * lu(1189) + lu(1210) = lu(1210) - lu(727) * lu(1189) + lu(1211) = lu(1211) - lu(728) * lu(1189) + lu(1212) = lu(1212) - lu(729) * lu(1189) + lu(1213) = lu(1213) - lu(730) * lu(1189) + lu(1214) = lu(1214) - lu(731) * lu(1189) + lu(1227) = lu(1227) - lu(712) * lu(1224) + lu(1229) = lu(1229) - lu(713) * lu(1224) + lu(1230) = lu(1230) - lu(714) * lu(1224) + lu(1231) = lu(1231) - lu(715) * lu(1224) + lu(1232) = lu(1232) - lu(716) * lu(1224) + lu(1233) = lu(1233) - lu(717) * lu(1224) + lu(1234) = lu(1234) - lu(718) * lu(1224) + lu(1235) = lu(1235) - lu(719) * lu(1224) + lu(1236) = lu(1236) - lu(720) * lu(1224) + lu(1237) = lu(1237) - lu(721) * lu(1224) + lu(1238) = lu(1238) - lu(722) * lu(1224) + lu(1239) = lu(1239) - lu(723) * lu(1224) + lu(1241) = lu(1241) - lu(724) * lu(1224) + lu(1243) = lu(1243) - lu(725) * lu(1224) + lu(1244) = lu(1244) - lu(726) * lu(1224) + lu(1245) = lu(1245) - lu(727) * lu(1224) + lu(1246) = lu(1246) - lu(728) * lu(1224) + lu(1247) = lu(1247) - lu(729) * lu(1224) + lu(1248) = lu(1248) - lu(730) * lu(1224) + lu(1249) = lu(1249) - lu(731) * lu(1224) + lu(1271) = lu(1271) - lu(712) * lu(1268) + lu(1273) = lu(1273) - lu(713) * lu(1268) + lu(1274) = lu(1274) - lu(714) * lu(1268) + lu(1275) = lu(1275) - lu(715) * lu(1268) + lu(1276) = lu(1276) - lu(716) * lu(1268) + lu(1277) = lu(1277) - lu(717) * lu(1268) + lu(1278) = lu(1278) - lu(718) * lu(1268) + lu(1279) = lu(1279) - lu(719) * lu(1268) + lu(1280) = lu(1280) - lu(720) * lu(1268) + lu(1281) = lu(1281) - lu(721) * lu(1268) + lu(1282) = lu(1282) - lu(722) * lu(1268) + lu(1283) = lu(1283) - lu(723) * lu(1268) + lu(1285) = lu(1285) - lu(724) * lu(1268) + lu(1287) = lu(1287) - lu(725) * lu(1268) + lu(1288) = lu(1288) - lu(726) * lu(1268) + lu(1289) = lu(1289) - lu(727) * lu(1268) + lu(1290) = lu(1290) - lu(728) * lu(1268) + lu(1291) = lu(1291) - lu(729) * lu(1268) + lu(1292) = lu(1292) - lu(730) * lu(1268) + lu(1293) = lu(1293) - lu(731) * lu(1268) + lu(1312) = lu(1312) - lu(712) * lu(1309) + lu(1314) = lu(1314) - lu(713) * lu(1309) + lu(1315) = lu(1315) - lu(714) * lu(1309) + lu(1316) = lu(1316) - lu(715) * lu(1309) + lu(1317) = lu(1317) - lu(716) * lu(1309) + lu(1318) = lu(1318) - lu(717) * lu(1309) + lu(1319) = lu(1319) - lu(718) * lu(1309) + lu(1320) = lu(1320) - lu(719) * lu(1309) + lu(1321) = lu(1321) - lu(720) * lu(1309) + lu(1322) = lu(1322) - lu(721) * lu(1309) + lu(1323) = lu(1323) - lu(722) * lu(1309) + lu(1324) = lu(1324) - lu(723) * lu(1309) + lu(1326) = lu(1326) - lu(724) * lu(1309) + lu(1328) = lu(1328) - lu(725) * lu(1309) + lu(1329) = lu(1329) - lu(726) * lu(1309) + lu(1330) = lu(1330) - lu(727) * lu(1309) + lu(1331) = lu(1331) - lu(728) * lu(1309) + lu(1332) = lu(1332) - lu(729) * lu(1309) + lu(1333) = lu(1333) - lu(730) * lu(1309) + lu(1334) = lu(1334) - lu(731) * lu(1309) + lu(1354) = lu(1354) - lu(712) * lu(1351) + lu(1356) = lu(1356) - lu(713) * lu(1351) + lu(1357) = lu(1357) - lu(714) * lu(1351) + lu(1358) = lu(1358) - lu(715) * lu(1351) + lu(1359) = lu(1359) - lu(716) * lu(1351) + lu(1360) = lu(1360) - lu(717) * lu(1351) + lu(1361) = lu(1361) - lu(718) * lu(1351) + lu(1362) = lu(1362) - lu(719) * lu(1351) + lu(1363) = lu(1363) - lu(720) * lu(1351) + lu(1364) = lu(1364) - lu(721) * lu(1351) + lu(1365) = lu(1365) - lu(722) * lu(1351) + lu(1366) = lu(1366) - lu(723) * lu(1351) + lu(1368) = lu(1368) - lu(724) * lu(1351) + lu(1370) = lu(1370) - lu(725) * lu(1351) + lu(1371) = lu(1371) - lu(726) * lu(1351) + lu(1372) = lu(1372) - lu(727) * lu(1351) + lu(1373) = lu(1373) - lu(728) * lu(1351) + lu(1374) = lu(1374) - lu(729) * lu(1351) + lu(1375) = lu(1375) - lu(730) * lu(1351) + lu(1376) = lu(1376) - lu(731) * lu(1351) + lu(1396) = lu(1396) - lu(712) * lu(1395) + lu(1398) = lu(1398) - lu(713) * lu(1395) + lu(1399) = lu(1399) - lu(714) * lu(1395) + lu(1400) = lu(1400) - lu(715) * lu(1395) + lu(1401) = lu(1401) - lu(716) * lu(1395) + lu(1402) = lu(1402) - lu(717) * lu(1395) + lu(1403) = lu(1403) - lu(718) * lu(1395) + lu(1404) = lu(1404) - lu(719) * lu(1395) + lu(1405) = lu(1405) - lu(720) * lu(1395) + lu(1406) = lu(1406) - lu(721) * lu(1395) + lu(1407) = lu(1407) - lu(722) * lu(1395) + lu(1408) = lu(1408) - lu(723) * lu(1395) + lu(1410) = lu(1410) - lu(724) * lu(1395) + lu(1412) = lu(1412) - lu(725) * lu(1395) + lu(1413) = lu(1413) - lu(726) * lu(1395) + lu(1414) = lu(1414) - lu(727) * lu(1395) + lu(1415) = lu(1415) - lu(728) * lu(1395) + lu(1416) = lu(1416) - lu(729) * lu(1395) + lu(1417) = lu(1417) - lu(730) * lu(1395) + lu(1418) = lu(1418) - lu(731) * lu(1395) + lu(1438) = lu(1438) - lu(712) * lu(1435) + lu(1440) = lu(1440) - lu(713) * lu(1435) + lu(1441) = lu(1441) - lu(714) * lu(1435) + lu(1442) = lu(1442) - lu(715) * lu(1435) + lu(1443) = lu(1443) - lu(716) * lu(1435) + lu(1444) = lu(1444) - lu(717) * lu(1435) + lu(1445) = lu(1445) - lu(718) * lu(1435) + lu(1446) = lu(1446) - lu(719) * lu(1435) + lu(1447) = lu(1447) - lu(720) * lu(1435) + lu(1448) = lu(1448) - lu(721) * lu(1435) + lu(1449) = lu(1449) - lu(722) * lu(1435) + lu(1450) = lu(1450) - lu(723) * lu(1435) + lu(1452) = lu(1452) - lu(724) * lu(1435) + lu(1454) = lu(1454) - lu(725) * lu(1435) + lu(1455) = lu(1455) - lu(726) * lu(1435) + lu(1456) = lu(1456) - lu(727) * lu(1435) + lu(1457) = lu(1457) - lu(728) * lu(1435) + lu(1458) = lu(1458) - lu(729) * lu(1435) + lu(1459) = lu(1459) - lu(730) * lu(1435) + lu(1460) = lu(1460) - lu(731) * lu(1435) + lu(1493) = lu(1493) - lu(712) * lu(1490) + lu(1495) = lu(1495) - lu(713) * lu(1490) + lu(1496) = lu(1496) - lu(714) * lu(1490) + lu(1497) = lu(1497) - lu(715) * lu(1490) + lu(1498) = lu(1498) - lu(716) * lu(1490) + lu(1499) = lu(1499) - lu(717) * lu(1490) + lu(1500) = lu(1500) - lu(718) * lu(1490) + lu(1501) = lu(1501) - lu(719) * lu(1490) + lu(1502) = lu(1502) - lu(720) * lu(1490) + lu(1503) = lu(1503) - lu(721) * lu(1490) + lu(1504) = lu(1504) - lu(722) * lu(1490) + lu(1505) = lu(1505) - lu(723) * lu(1490) + lu(1507) = lu(1507) - lu(724) * lu(1490) + lu(1509) = lu(1509) - lu(725) * lu(1490) + lu(1510) = lu(1510) - lu(726) * lu(1490) + lu(1511) = lu(1511) - lu(727) * lu(1490) + lu(1512) = lu(1512) - lu(728) * lu(1490) + lu(1513) = lu(1513) - lu(729) * lu(1490) + lu(1514) = lu(1514) - lu(730) * lu(1490) + lu(1515) = lu(1515) - lu(731) * lu(1490) + lu(1525) = lu(1525) - lu(712) * lu(1522) + lu(1527) = lu(1527) - lu(713) * lu(1522) + lu(1528) = lu(1528) - lu(714) * lu(1522) + lu(1529) = lu(1529) - lu(715) * lu(1522) + lu(1530) = lu(1530) - lu(716) * lu(1522) + lu(1531) = lu(1531) - lu(717) * lu(1522) + lu(1532) = lu(1532) - lu(718) * lu(1522) + lu(1533) = lu(1533) - lu(719) * lu(1522) + lu(1534) = lu(1534) - lu(720) * lu(1522) + lu(1535) = lu(1535) - lu(721) * lu(1522) + lu(1536) = lu(1536) - lu(722) * lu(1522) + lu(1537) = lu(1537) - lu(723) * lu(1522) + lu(1539) = lu(1539) - lu(724) * lu(1522) + lu(1541) = lu(1541) - lu(725) * lu(1522) + lu(1542) = lu(1542) - lu(726) * lu(1522) + lu(1543) = lu(1543) - lu(727) * lu(1522) + lu(1544) = lu(1544) - lu(728) * lu(1522) + lu(1545) = lu(1545) - lu(729) * lu(1522) + lu(1546) = lu(1546) - lu(730) * lu(1522) + lu(1547) = lu(1547) - lu(731) * lu(1522) + lu(1560) = lu(1560) - lu(712) * lu(1557) + lu(1562) = lu(1562) - lu(713) * lu(1557) + lu(1563) = lu(1563) - lu(714) * lu(1557) + lu(1564) = lu(1564) - lu(715) * lu(1557) + lu(1565) = lu(1565) - lu(716) * lu(1557) + lu(1566) = lu(1566) - lu(717) * lu(1557) + lu(1567) = lu(1567) - lu(718) * lu(1557) + lu(1568) = lu(1568) - lu(719) * lu(1557) + lu(1569) = lu(1569) - lu(720) * lu(1557) + lu(1570) = lu(1570) - lu(721) * lu(1557) + lu(1571) = lu(1571) - lu(722) * lu(1557) + lu(1572) = lu(1572) - lu(723) * lu(1557) + lu(1574) = lu(1574) - lu(724) * lu(1557) + lu(1576) = lu(1576) - lu(725) * lu(1557) + lu(1577) = lu(1577) - lu(726) * lu(1557) + lu(1578) = lu(1578) - lu(727) * lu(1557) + lu(1579) = lu(1579) - lu(728) * lu(1557) + lu(1580) = lu(1580) - lu(729) * lu(1557) + lu(1581) = lu(1581) - lu(730) * lu(1557) + lu(1582) = lu(1582) - lu(731) * lu(1557) + lu(1598) = lu(1598) - lu(712) * lu(1595) + lu(1600) = lu(1600) - lu(713) * lu(1595) + lu(1601) = lu(1601) - lu(714) * lu(1595) + lu(1602) = lu(1602) - lu(715) * lu(1595) + lu(1603) = lu(1603) - lu(716) * lu(1595) + lu(1604) = lu(1604) - lu(717) * lu(1595) + lu(1605) = lu(1605) - lu(718) * lu(1595) + lu(1606) = lu(1606) - lu(719) * lu(1595) + lu(1607) = lu(1607) - lu(720) * lu(1595) + lu(1608) = lu(1608) - lu(721) * lu(1595) + lu(1609) = lu(1609) - lu(722) * lu(1595) + lu(1610) = lu(1610) - lu(723) * lu(1595) + lu(1612) = lu(1612) - lu(724) * lu(1595) + lu(1614) = lu(1614) - lu(725) * lu(1595) + lu(1615) = lu(1615) - lu(726) * lu(1595) + lu(1616) = lu(1616) - lu(727) * lu(1595) + lu(1617) = lu(1617) - lu(728) * lu(1595) + lu(1618) = lu(1618) - lu(729) * lu(1595) + lu(1619) = lu(1619) - lu(730) * lu(1595) + lu(1620) = lu(1620) - lu(731) * lu(1595) + lu(1637) = lu(1637) - lu(712) * lu(1634) + lu(1639) = lu(1639) - lu(713) * lu(1634) + lu(1640) = lu(1640) - lu(714) * lu(1634) + lu(1641) = lu(1641) - lu(715) * lu(1634) + lu(1642) = lu(1642) - lu(716) * lu(1634) + lu(1643) = lu(1643) - lu(717) * lu(1634) + lu(1644) = lu(1644) - lu(718) * lu(1634) + lu(1645) = lu(1645) - lu(719) * lu(1634) + lu(1646) = lu(1646) - lu(720) * lu(1634) + lu(1647) = lu(1647) - lu(721) * lu(1634) + lu(1648) = lu(1648) - lu(722) * lu(1634) + lu(1649) = lu(1649) - lu(723) * lu(1634) + lu(1651) = lu(1651) - lu(724) * lu(1634) + lu(1653) = lu(1653) - lu(725) * lu(1634) + lu(1654) = lu(1654) - lu(726) * lu(1634) + lu(1655) = lu(1655) - lu(727) * lu(1634) + lu(1656) = lu(1656) - lu(728) * lu(1634) + lu(1657) = lu(1657) - lu(729) * lu(1634) + lu(1658) = lu(1658) - lu(730) * lu(1634) + lu(1659) = lu(1659) - lu(731) * lu(1634) + lu(1671) = lu(1671) - lu(712) * lu(1669) + lu(1673) = lu(1673) - lu(713) * lu(1669) + lu(1674) = lu(1674) - lu(714) * lu(1669) + lu(1675) = lu(1675) - lu(715) * lu(1669) + lu(1676) = lu(1676) - lu(716) * lu(1669) + lu(1677) = lu(1677) - lu(717) * lu(1669) + lu(1678) = lu(1678) - lu(718) * lu(1669) + lu(1679) = lu(1679) - lu(719) * lu(1669) + lu(1680) = lu(1680) - lu(720) * lu(1669) + lu(1681) = lu(1681) - lu(721) * lu(1669) + lu(1682) = lu(1682) - lu(722) * lu(1669) + lu(1683) = lu(1683) - lu(723) * lu(1669) + lu(1685) = lu(1685) - lu(724) * lu(1669) + lu(1687) = lu(1687) - lu(725) * lu(1669) + lu(1688) = lu(1688) - lu(726) * lu(1669) + lu(1689) = lu(1689) - lu(727) * lu(1669) + lu(1690) = lu(1690) - lu(728) * lu(1669) + lu(1691) = lu(1691) - lu(729) * lu(1669) + lu(1692) = lu(1692) - lu(730) * lu(1669) + lu(1693) = lu(1693) - lu(731) * lu(1669) + lu(1723) = lu(1723) - lu(712) * lu(1720) + lu(1725) = lu(1725) - lu(713) * lu(1720) + lu(1726) = lu(1726) - lu(714) * lu(1720) + lu(1727) = lu(1727) - lu(715) * lu(1720) + lu(1728) = lu(1728) - lu(716) * lu(1720) + lu(1729) = lu(1729) - lu(717) * lu(1720) + lu(1730) = lu(1730) - lu(718) * lu(1720) + lu(1731) = lu(1731) - lu(719) * lu(1720) + lu(1732) = lu(1732) - lu(720) * lu(1720) + lu(1733) = lu(1733) - lu(721) * lu(1720) + lu(1734) = lu(1734) - lu(722) * lu(1720) + lu(1735) = lu(1735) - lu(723) * lu(1720) + lu(1737) = lu(1737) - lu(724) * lu(1720) + lu(1739) = lu(1739) - lu(725) * lu(1720) + lu(1740) = lu(1740) - lu(726) * lu(1720) + lu(1741) = lu(1741) - lu(727) * lu(1720) + lu(1742) = lu(1742) - lu(728) * lu(1720) + lu(1743) = lu(1743) - lu(729) * lu(1720) + lu(1744) = lu(1744) - lu(730) * lu(1720) + lu(1745) = lu(1745) - lu(731) * lu(1720) + lu(739) = 1._r8 / lu(739) + lu(740) = lu(740) * lu(739) + lu(741) = lu(741) * lu(739) + lu(742) = lu(742) * lu(739) + lu(743) = lu(743) * lu(739) + lu(744) = lu(744) * lu(739) + lu(745) = lu(745) * lu(739) + lu(746) = lu(746) * lu(739) + lu(747) = lu(747) * lu(739) + lu(748) = lu(748) * lu(739) + lu(749) = lu(749) * lu(739) + lu(750) = lu(750) * lu(739) + lu(751) = lu(751) * lu(739) + lu(752) = lu(752) * lu(739) + lu(753) = lu(753) * lu(739) + lu(754) = lu(754) * lu(739) + lu(755) = lu(755) * lu(739) + lu(756) = lu(756) * lu(739) + lu(757) = lu(757) * lu(739) + lu(758) = lu(758) * lu(739) + lu(759) = lu(759) * lu(739) + lu(760) = lu(760) * lu(739) + lu(761) = lu(761) * lu(739) + lu(762) = lu(762) * lu(739) + lu(763) = lu(763) * lu(739) + lu(816) = lu(816) - lu(740) * lu(815) + lu(817) = lu(817) - lu(741) * lu(815) + lu(818) = lu(818) - lu(742) * lu(815) + lu(819) = lu(819) - lu(743) * lu(815) + lu(820) = lu(820) - lu(744) * lu(815) + lu(821) = lu(821) - lu(745) * lu(815) + lu(822) = lu(822) - lu(746) * lu(815) + lu(823) = lu(823) - lu(747) * lu(815) + lu(824) = lu(824) - lu(748) * lu(815) + lu(825) = lu(825) - lu(749) * lu(815) + lu(826) = lu(826) - lu(750) * lu(815) + lu(827) = lu(827) - lu(751) * lu(815) + lu(828) = lu(828) - lu(752) * lu(815) + lu(829) = lu(829) - lu(753) * lu(815) + lu(830) = lu(830) - lu(754) * lu(815) + lu(831) = lu(831) - lu(755) * lu(815) + lu(832) = lu(832) - lu(756) * lu(815) + lu(833) = lu(833) - lu(757) * lu(815) + lu(834) = lu(834) - lu(758) * lu(815) + lu(835) = lu(835) - lu(759) * lu(815) + lu(836) = lu(836) - lu(760) * lu(815) + lu(837) = lu(837) - lu(761) * lu(815) + lu(838) = lu(838) - lu(762) * lu(815) + lu(839) = lu(839) - lu(763) * lu(815) + lu(858) = lu(858) - lu(740) * lu(857) + lu(859) = lu(859) - lu(741) * lu(857) + lu(860) = lu(860) - lu(742) * lu(857) + lu(861) = lu(861) - lu(743) * lu(857) + lu(862) = lu(862) - lu(744) * lu(857) + lu(863) = lu(863) - lu(745) * lu(857) + lu(864) = lu(864) - lu(746) * lu(857) + lu(865) = lu(865) - lu(747) * lu(857) + lu(866) = lu(866) - lu(748) * lu(857) + lu(867) = lu(867) - lu(749) * lu(857) + lu(868) = lu(868) - lu(750) * lu(857) + lu(869) = lu(869) - lu(751) * lu(857) + lu(870) = lu(870) - lu(752) * lu(857) + lu(871) = lu(871) - lu(753) * lu(857) + lu(872) = lu(872) - lu(754) * lu(857) + lu(873) = lu(873) - lu(755) * lu(857) + lu(874) = lu(874) - lu(756) * lu(857) + lu(875) = lu(875) - lu(757) * lu(857) + lu(876) = lu(876) - lu(758) * lu(857) + lu(877) = lu(877) - lu(759) * lu(857) + lu(878) = lu(878) - lu(760) * lu(857) + lu(879) = lu(879) - lu(761) * lu(857) + lu(880) = lu(880) - lu(762) * lu(857) + lu(881) = lu(881) - lu(763) * lu(857) + lu(902) = lu(902) - lu(740) * lu(901) + lu(903) = lu(903) - lu(741) * lu(901) + lu(904) = lu(904) - lu(742) * lu(901) + lu(905) = lu(905) - lu(743) * lu(901) + lu(906) = lu(906) - lu(744) * lu(901) + lu(907) = lu(907) - lu(745) * lu(901) + lu(908) = lu(908) - lu(746) * lu(901) + lu(909) = lu(909) - lu(747) * lu(901) + lu(910) = lu(910) - lu(748) * lu(901) + lu(911) = lu(911) - lu(749) * lu(901) + lu(912) = lu(912) - lu(750) * lu(901) + lu(913) = lu(913) - lu(751) * lu(901) + lu(914) = lu(914) - lu(752) * lu(901) + lu(915) = lu(915) - lu(753) * lu(901) + lu(916) = lu(916) - lu(754) * lu(901) + lu(917) = lu(917) - lu(755) * lu(901) + lu(918) = lu(918) - lu(756) * lu(901) + lu(919) = lu(919) - lu(757) * lu(901) + lu(920) = lu(920) - lu(758) * lu(901) + lu(921) = lu(921) - lu(759) * lu(901) + lu(922) = lu(922) - lu(760) * lu(901) + lu(923) = lu(923) - lu(761) * lu(901) + lu(924) = lu(924) - lu(762) * lu(901) + lu(925) = lu(925) - lu(763) * lu(901) + lu(937) = lu(937) - lu(740) * lu(936) + lu(938) = lu(938) - lu(741) * lu(936) + lu(939) = lu(939) - lu(742) * lu(936) + lu(940) = lu(940) - lu(743) * lu(936) + lu(941) = lu(941) - lu(744) * lu(936) + lu(942) = lu(942) - lu(745) * lu(936) + lu(943) = lu(943) - lu(746) * lu(936) + lu(944) = lu(944) - lu(747) * lu(936) + lu(945) = lu(945) - lu(748) * lu(936) + lu(946) = lu(946) - lu(749) * lu(936) + lu(947) = lu(947) - lu(750) * lu(936) + lu(948) = lu(948) - lu(751) * lu(936) + lu(949) = lu(949) - lu(752) * lu(936) + lu(950) = lu(950) - lu(753) * lu(936) + lu(951) = lu(951) - lu(754) * lu(936) + lu(952) = lu(952) - lu(755) * lu(936) + lu(953) = lu(953) - lu(756) * lu(936) + lu(954) = lu(954) - lu(757) * lu(936) + lu(955) = lu(955) - lu(758) * lu(936) + lu(956) = lu(956) - lu(759) * lu(936) + lu(957) = lu(957) - lu(760) * lu(936) + lu(958) = lu(958) - lu(761) * lu(936) + lu(959) = lu(959) - lu(762) * lu(936) + lu(960) = lu(960) - lu(763) * lu(936) + lu(978) = lu(978) - lu(740) * lu(977) + lu(979) = lu(979) - lu(741) * lu(977) + lu(980) = lu(980) - lu(742) * lu(977) + lu(981) = lu(981) - lu(743) * lu(977) + lu(982) = lu(982) - lu(744) * lu(977) + lu(983) = lu(983) - lu(745) * lu(977) + lu(984) = lu(984) - lu(746) * lu(977) + lu(985) = lu(985) - lu(747) * lu(977) + lu(986) = lu(986) - lu(748) * lu(977) + lu(987) = lu(987) - lu(749) * lu(977) + lu(988) = lu(988) - lu(750) * lu(977) + lu(989) = lu(989) - lu(751) * lu(977) + lu(990) = lu(990) - lu(752) * lu(977) + lu(991) = lu(991) - lu(753) * lu(977) + lu(992) = lu(992) - lu(754) * lu(977) + lu(993) = lu(993) - lu(755) * lu(977) + lu(994) = lu(994) - lu(756) * lu(977) + lu(995) = lu(995) - lu(757) * lu(977) + lu(996) = lu(996) - lu(758) * lu(977) + lu(997) = lu(997) - lu(759) * lu(977) + lu(998) = lu(998) - lu(760) * lu(977) + lu(999) = lu(999) - lu(761) * lu(977) + lu(1000) = lu(1000) - lu(762) * lu(977) + lu(1001) = lu(1001) - lu(763) * lu(977) + lu(1020) = lu(1020) - lu(740) * lu(1019) + lu(1021) = lu(1021) - lu(741) * lu(1019) + lu(1022) = lu(1022) - lu(742) * lu(1019) + lu(1023) = lu(1023) - lu(743) * lu(1019) + lu(1024) = lu(1024) - lu(744) * lu(1019) + lu(1025) = lu(1025) - lu(745) * lu(1019) + lu(1026) = lu(1026) - lu(746) * lu(1019) + lu(1027) = lu(1027) - lu(747) * lu(1019) + lu(1028) = lu(1028) - lu(748) * lu(1019) + lu(1029) = lu(1029) - lu(749) * lu(1019) + lu(1030) = lu(1030) - lu(750) * lu(1019) + lu(1031) = lu(1031) - lu(751) * lu(1019) + lu(1032) = lu(1032) - lu(752) * lu(1019) + lu(1033) = lu(1033) - lu(753) * lu(1019) + lu(1034) = lu(1034) - lu(754) * lu(1019) + lu(1035) = lu(1035) - lu(755) * lu(1019) + lu(1036) = lu(1036) - lu(756) * lu(1019) + lu(1037) = lu(1037) - lu(757) * lu(1019) + lu(1038) = lu(1038) - lu(758) * lu(1019) + lu(1039) = lu(1039) - lu(759) * lu(1019) + lu(1040) = lu(1040) - lu(760) * lu(1019) + lu(1041) = lu(1041) - lu(761) * lu(1019) + lu(1042) = lu(1042) - lu(762) * lu(1019) + lu(1043) = lu(1043) - lu(763) * lu(1019) + lu(1064) = lu(1064) - lu(740) * lu(1063) + lu(1065) = lu(1065) - lu(741) * lu(1063) + lu(1066) = lu(1066) - lu(742) * lu(1063) + lu(1067) = lu(1067) - lu(743) * lu(1063) + lu(1068) = lu(1068) - lu(744) * lu(1063) + lu(1069) = lu(1069) - lu(745) * lu(1063) + lu(1070) = lu(1070) - lu(746) * lu(1063) + lu(1071) = lu(1071) - lu(747) * lu(1063) + lu(1072) = lu(1072) - lu(748) * lu(1063) + lu(1073) = lu(1073) - lu(749) * lu(1063) + lu(1074) = lu(1074) - lu(750) * lu(1063) + lu(1075) = lu(1075) - lu(751) * lu(1063) + lu(1076) = lu(1076) - lu(752) * lu(1063) + lu(1077) = lu(1077) - lu(753) * lu(1063) + lu(1078) = lu(1078) - lu(754) * lu(1063) + lu(1079) = lu(1079) - lu(755) * lu(1063) + lu(1080) = lu(1080) - lu(756) * lu(1063) + lu(1081) = lu(1081) - lu(757) * lu(1063) + lu(1082) = lu(1082) - lu(758) * lu(1063) + lu(1083) = lu(1083) - lu(759) * lu(1063) + lu(1084) = lu(1084) - lu(760) * lu(1063) + lu(1085) = lu(1085) - lu(761) * lu(1063) + lu(1086) = lu(1086) - lu(762) * lu(1063) + lu(1087) = lu(1087) - lu(763) * lu(1063) + lu(1106) = lu(1106) - lu(740) * lu(1105) + lu(1107) = lu(1107) - lu(741) * lu(1105) + lu(1108) = lu(1108) - lu(742) * lu(1105) + lu(1109) = lu(1109) - lu(743) * lu(1105) + lu(1110) = lu(1110) - lu(744) * lu(1105) + lu(1111) = lu(1111) - lu(745) * lu(1105) + lu(1112) = lu(1112) - lu(746) * lu(1105) + lu(1113) = lu(1113) - lu(747) * lu(1105) + lu(1114) = lu(1114) - lu(748) * lu(1105) + lu(1115) = lu(1115) - lu(749) * lu(1105) + lu(1116) = lu(1116) - lu(750) * lu(1105) + lu(1117) = lu(1117) - lu(751) * lu(1105) + lu(1118) = lu(1118) - lu(752) * lu(1105) + lu(1119) = lu(1119) - lu(753) * lu(1105) + lu(1120) = lu(1120) - lu(754) * lu(1105) + lu(1121) = lu(1121) - lu(755) * lu(1105) + lu(1122) = lu(1122) - lu(756) * lu(1105) + lu(1123) = lu(1123) - lu(757) * lu(1105) + lu(1124) = lu(1124) - lu(758) * lu(1105) + lu(1125) = lu(1125) - lu(759) * lu(1105) + lu(1126) = lu(1126) - lu(760) * lu(1105) + lu(1127) = lu(1127) - lu(761) * lu(1105) + lu(1128) = lu(1128) - lu(762) * lu(1105) + lu(1129) = lu(1129) - lu(763) * lu(1105) + lu(1149) = lu(1149) - lu(740) * lu(1148) + lu(1150) = lu(1150) - lu(741) * lu(1148) + lu(1151) = lu(1151) - lu(742) * lu(1148) + lu(1152) = lu(1152) - lu(743) * lu(1148) + lu(1153) = lu(1153) - lu(744) * lu(1148) + lu(1154) = lu(1154) - lu(745) * lu(1148) + lu(1155) = lu(1155) - lu(746) * lu(1148) + lu(1156) = lu(1156) - lu(747) * lu(1148) + lu(1157) = lu(1157) - lu(748) * lu(1148) + lu(1158) = lu(1158) - lu(749) * lu(1148) + lu(1159) = lu(1159) - lu(750) * lu(1148) + lu(1160) = lu(1160) - lu(751) * lu(1148) + lu(1161) = lu(1161) - lu(752) * lu(1148) + lu(1162) = lu(1162) - lu(753) * lu(1148) + lu(1163) = lu(1163) - lu(754) * lu(1148) + lu(1164) = lu(1164) - lu(755) * lu(1148) + lu(1165) = lu(1165) - lu(756) * lu(1148) + lu(1166) = lu(1166) - lu(757) * lu(1148) + lu(1167) = lu(1167) - lu(758) * lu(1148) + lu(1168) = lu(1168) - lu(759) * lu(1148) + lu(1169) = lu(1169) - lu(760) * lu(1148) + lu(1170) = lu(1170) - lu(761) * lu(1148) + lu(1171) = lu(1171) - lu(762) * lu(1148) + lu(1172) = lu(1172) - lu(763) * lu(1148) + lu(1191) = lu(1191) - lu(740) * lu(1190) + lu(1192) = lu(1192) - lu(741) * lu(1190) + lu(1193) = lu(1193) - lu(742) * lu(1190) + lu(1194) = lu(1194) - lu(743) * lu(1190) + lu(1195) = lu(1195) - lu(744) * lu(1190) + lu(1196) = lu(1196) - lu(745) * lu(1190) + lu(1197) = lu(1197) - lu(746) * lu(1190) + lu(1198) = lu(1198) - lu(747) * lu(1190) + lu(1199) = lu(1199) - lu(748) * lu(1190) + lu(1200) = lu(1200) - lu(749) * lu(1190) + lu(1201) = lu(1201) - lu(750) * lu(1190) + lu(1202) = lu(1202) - lu(751) * lu(1190) + lu(1203) = lu(1203) - lu(752) * lu(1190) + lu(1204) = lu(1204) - lu(753) * lu(1190) + lu(1205) = lu(1205) - lu(754) * lu(1190) + lu(1206) = lu(1206) - lu(755) * lu(1190) + lu(1207) = lu(1207) - lu(756) * lu(1190) + lu(1208) = lu(1208) - lu(757) * lu(1190) + lu(1209) = lu(1209) - lu(758) * lu(1190) + lu(1210) = lu(1210) - lu(759) * lu(1190) + lu(1211) = lu(1211) - lu(760) * lu(1190) + lu(1212) = lu(1212) - lu(761) * lu(1190) + lu(1213) = lu(1213) - lu(762) * lu(1190) + lu(1214) = lu(1214) - lu(763) * lu(1190) + lu(1226) = lu(1226) - lu(740) * lu(1225) + lu(1227) = lu(1227) - lu(741) * lu(1225) + lu(1228) = lu(1228) - lu(742) * lu(1225) + lu(1229) = lu(1229) - lu(743) * lu(1225) + lu(1230) = lu(1230) - lu(744) * lu(1225) + lu(1231) = lu(1231) - lu(745) * lu(1225) + lu(1232) = lu(1232) - lu(746) * lu(1225) + lu(1233) = lu(1233) - lu(747) * lu(1225) + lu(1234) = lu(1234) - lu(748) * lu(1225) + lu(1235) = lu(1235) - lu(749) * lu(1225) + lu(1236) = lu(1236) - lu(750) * lu(1225) + lu(1237) = lu(1237) - lu(751) * lu(1225) + lu(1238) = lu(1238) - lu(752) * lu(1225) + lu(1239) = lu(1239) - lu(753) * lu(1225) + lu(1240) = lu(1240) - lu(754) * lu(1225) + lu(1241) = lu(1241) - lu(755) * lu(1225) + lu(1242) = lu(1242) - lu(756) * lu(1225) + lu(1243) = lu(1243) - lu(757) * lu(1225) + lu(1244) = lu(1244) - lu(758) * lu(1225) + lu(1245) = lu(1245) - lu(759) * lu(1225) + lu(1246) = lu(1246) - lu(760) * lu(1225) + lu(1247) = lu(1247) - lu(761) * lu(1225) + lu(1248) = lu(1248) - lu(762) * lu(1225) + lu(1249) = lu(1249) - lu(763) * lu(1225) + lu(1270) = lu(1270) - lu(740) * lu(1269) + lu(1271) = lu(1271) - lu(741) * lu(1269) + lu(1272) = lu(1272) - lu(742) * lu(1269) + lu(1273) = lu(1273) - lu(743) * lu(1269) + lu(1274) = lu(1274) - lu(744) * lu(1269) + lu(1275) = lu(1275) - lu(745) * lu(1269) + lu(1276) = lu(1276) - lu(746) * lu(1269) + lu(1277) = lu(1277) - lu(747) * lu(1269) + lu(1278) = lu(1278) - lu(748) * lu(1269) + lu(1279) = lu(1279) - lu(749) * lu(1269) + lu(1280) = lu(1280) - lu(750) * lu(1269) + lu(1281) = lu(1281) - lu(751) * lu(1269) + lu(1282) = lu(1282) - lu(752) * lu(1269) + lu(1283) = lu(1283) - lu(753) * lu(1269) + lu(1284) = lu(1284) - lu(754) * lu(1269) + lu(1285) = lu(1285) - lu(755) * lu(1269) + lu(1286) = lu(1286) - lu(756) * lu(1269) + lu(1287) = lu(1287) - lu(757) * lu(1269) + lu(1288) = lu(1288) - lu(758) * lu(1269) + lu(1289) = lu(1289) - lu(759) * lu(1269) + lu(1290) = lu(1290) - lu(760) * lu(1269) + lu(1291) = lu(1291) - lu(761) * lu(1269) + lu(1292) = lu(1292) - lu(762) * lu(1269) + lu(1293) = lu(1293) - lu(763) * lu(1269) + lu(1311) = lu(1311) - lu(740) * lu(1310) + lu(1312) = lu(1312) - lu(741) * lu(1310) + lu(1313) = lu(1313) - lu(742) * lu(1310) + lu(1314) = lu(1314) - lu(743) * lu(1310) + lu(1315) = lu(1315) - lu(744) * lu(1310) + lu(1316) = lu(1316) - lu(745) * lu(1310) + lu(1317) = lu(1317) - lu(746) * lu(1310) + lu(1318) = lu(1318) - lu(747) * lu(1310) + lu(1319) = lu(1319) - lu(748) * lu(1310) + lu(1320) = lu(1320) - lu(749) * lu(1310) + lu(1321) = lu(1321) - lu(750) * lu(1310) + lu(1322) = lu(1322) - lu(751) * lu(1310) + lu(1323) = lu(1323) - lu(752) * lu(1310) + lu(1324) = lu(1324) - lu(753) * lu(1310) + lu(1325) = lu(1325) - lu(754) * lu(1310) + lu(1326) = lu(1326) - lu(755) * lu(1310) + lu(1327) = lu(1327) - lu(756) * lu(1310) + lu(1328) = lu(1328) - lu(757) * lu(1310) + lu(1329) = lu(1329) - lu(758) * lu(1310) + lu(1330) = lu(1330) - lu(759) * lu(1310) + lu(1331) = lu(1331) - lu(760) * lu(1310) + lu(1332) = lu(1332) - lu(761) * lu(1310) + lu(1333) = lu(1333) - lu(762) * lu(1310) + lu(1334) = lu(1334) - lu(763) * lu(1310) + lu(1353) = lu(1353) - lu(740) * lu(1352) + lu(1354) = lu(1354) - lu(741) * lu(1352) + lu(1355) = lu(1355) - lu(742) * lu(1352) + lu(1356) = lu(1356) - lu(743) * lu(1352) + lu(1357) = lu(1357) - lu(744) * lu(1352) + lu(1358) = lu(1358) - lu(745) * lu(1352) + lu(1359) = lu(1359) - lu(746) * lu(1352) + lu(1360) = lu(1360) - lu(747) * lu(1352) + lu(1361) = lu(1361) - lu(748) * lu(1352) + lu(1362) = lu(1362) - lu(749) * lu(1352) + lu(1363) = lu(1363) - lu(750) * lu(1352) + lu(1364) = lu(1364) - lu(751) * lu(1352) + lu(1365) = lu(1365) - lu(752) * lu(1352) + lu(1366) = lu(1366) - lu(753) * lu(1352) + lu(1367) = lu(1367) - lu(754) * lu(1352) + lu(1368) = lu(1368) - lu(755) * lu(1352) + lu(1369) = lu(1369) - lu(756) * lu(1352) + lu(1370) = lu(1370) - lu(757) * lu(1352) + lu(1371) = lu(1371) - lu(758) * lu(1352) + lu(1372) = lu(1372) - lu(759) * lu(1352) + lu(1373) = lu(1373) - lu(760) * lu(1352) + lu(1374) = lu(1374) - lu(761) * lu(1352) + lu(1375) = lu(1375) - lu(762) * lu(1352) + lu(1376) = lu(1376) - lu(763) * lu(1352) + lu(1437) = lu(1437) - lu(740) * lu(1436) + lu(1438) = lu(1438) - lu(741) * lu(1436) + lu(1439) = lu(1439) - lu(742) * lu(1436) + lu(1440) = lu(1440) - lu(743) * lu(1436) + lu(1441) = lu(1441) - lu(744) * lu(1436) + lu(1442) = lu(1442) - lu(745) * lu(1436) + lu(1443) = lu(1443) - lu(746) * lu(1436) + lu(1444) = lu(1444) - lu(747) * lu(1436) + lu(1445) = lu(1445) - lu(748) * lu(1436) + lu(1446) = lu(1446) - lu(749) * lu(1436) + lu(1447) = lu(1447) - lu(750) * lu(1436) + lu(1448) = lu(1448) - lu(751) * lu(1436) + lu(1449) = lu(1449) - lu(752) * lu(1436) + lu(1450) = lu(1450) - lu(753) * lu(1436) + lu(1451) = lu(1451) - lu(754) * lu(1436) + lu(1452) = lu(1452) - lu(755) * lu(1436) + lu(1453) = lu(1453) - lu(756) * lu(1436) + lu(1454) = lu(1454) - lu(757) * lu(1436) + lu(1455) = lu(1455) - lu(758) * lu(1436) + lu(1456) = lu(1456) - lu(759) * lu(1436) + lu(1457) = lu(1457) - lu(760) * lu(1436) + lu(1458) = lu(1458) - lu(761) * lu(1436) + lu(1459) = lu(1459) - lu(762) * lu(1436) + lu(1460) = lu(1460) - lu(763) * lu(1436) + lu(1492) = lu(1492) - lu(740) * lu(1491) + lu(1493) = lu(1493) - lu(741) * lu(1491) + lu(1494) = lu(1494) - lu(742) * lu(1491) + lu(1495) = lu(1495) - lu(743) * lu(1491) + lu(1496) = lu(1496) - lu(744) * lu(1491) + lu(1497) = lu(1497) - lu(745) * lu(1491) + lu(1498) = lu(1498) - lu(746) * lu(1491) + lu(1499) = lu(1499) - lu(747) * lu(1491) + lu(1500) = lu(1500) - lu(748) * lu(1491) + lu(1501) = lu(1501) - lu(749) * lu(1491) + lu(1502) = lu(1502) - lu(750) * lu(1491) + lu(1503) = lu(1503) - lu(751) * lu(1491) + lu(1504) = lu(1504) - lu(752) * lu(1491) + lu(1505) = lu(1505) - lu(753) * lu(1491) + lu(1506) = lu(1506) - lu(754) * lu(1491) + lu(1507) = lu(1507) - lu(755) * lu(1491) + lu(1508) = lu(1508) - lu(756) * lu(1491) + lu(1509) = lu(1509) - lu(757) * lu(1491) + lu(1510) = lu(1510) - lu(758) * lu(1491) + lu(1511) = lu(1511) - lu(759) * lu(1491) + lu(1512) = lu(1512) - lu(760) * lu(1491) + lu(1513) = lu(1513) - lu(761) * lu(1491) + lu(1514) = lu(1514) - lu(762) * lu(1491) + lu(1515) = lu(1515) - lu(763) * lu(1491) + lu(1524) = lu(1524) - lu(740) * lu(1523) + lu(1525) = lu(1525) - lu(741) * lu(1523) + lu(1526) = lu(1526) - lu(742) * lu(1523) + lu(1527) = lu(1527) - lu(743) * lu(1523) + lu(1528) = lu(1528) - lu(744) * lu(1523) + lu(1529) = lu(1529) - lu(745) * lu(1523) + lu(1530) = lu(1530) - lu(746) * lu(1523) + lu(1531) = lu(1531) - lu(747) * lu(1523) + lu(1532) = lu(1532) - lu(748) * lu(1523) + lu(1533) = lu(1533) - lu(749) * lu(1523) + lu(1534) = lu(1534) - lu(750) * lu(1523) + lu(1535) = lu(1535) - lu(751) * lu(1523) + lu(1536) = lu(1536) - lu(752) * lu(1523) + lu(1537) = lu(1537) - lu(753) * lu(1523) + lu(1538) = lu(1538) - lu(754) * lu(1523) + lu(1539) = lu(1539) - lu(755) * lu(1523) + lu(1540) = lu(1540) - lu(756) * lu(1523) + lu(1541) = lu(1541) - lu(757) * lu(1523) + lu(1542) = lu(1542) - lu(758) * lu(1523) + lu(1543) = lu(1543) - lu(759) * lu(1523) + lu(1544) = lu(1544) - lu(760) * lu(1523) + lu(1545) = lu(1545) - lu(761) * lu(1523) + lu(1546) = lu(1546) - lu(762) * lu(1523) + lu(1547) = lu(1547) - lu(763) * lu(1523) + lu(1559) = lu(1559) - lu(740) * lu(1558) + lu(1560) = lu(1560) - lu(741) * lu(1558) + lu(1561) = lu(1561) - lu(742) * lu(1558) + lu(1562) = lu(1562) - lu(743) * lu(1558) + lu(1563) = lu(1563) - lu(744) * lu(1558) + lu(1564) = lu(1564) - lu(745) * lu(1558) + lu(1565) = lu(1565) - lu(746) * lu(1558) + lu(1566) = lu(1566) - lu(747) * lu(1558) + lu(1567) = lu(1567) - lu(748) * lu(1558) + lu(1568) = lu(1568) - lu(749) * lu(1558) + lu(1569) = lu(1569) - lu(750) * lu(1558) + lu(1570) = lu(1570) - lu(751) * lu(1558) + lu(1571) = lu(1571) - lu(752) * lu(1558) + lu(1572) = lu(1572) - lu(753) * lu(1558) + lu(1573) = lu(1573) - lu(754) * lu(1558) + lu(1574) = lu(1574) - lu(755) * lu(1558) + lu(1575) = lu(1575) - lu(756) * lu(1558) + lu(1576) = lu(1576) - lu(757) * lu(1558) + lu(1577) = lu(1577) - lu(758) * lu(1558) + lu(1578) = lu(1578) - lu(759) * lu(1558) + lu(1579) = lu(1579) - lu(760) * lu(1558) + lu(1580) = lu(1580) - lu(761) * lu(1558) + lu(1581) = lu(1581) - lu(762) * lu(1558) + lu(1582) = lu(1582) - lu(763) * lu(1558) + lu(1597) = lu(1597) - lu(740) * lu(1596) + lu(1598) = lu(1598) - lu(741) * lu(1596) + lu(1599) = lu(1599) - lu(742) * lu(1596) + lu(1600) = lu(1600) - lu(743) * lu(1596) + lu(1601) = lu(1601) - lu(744) * lu(1596) + lu(1602) = lu(1602) - lu(745) * lu(1596) + lu(1603) = lu(1603) - lu(746) * lu(1596) + lu(1604) = lu(1604) - lu(747) * lu(1596) + lu(1605) = lu(1605) - lu(748) * lu(1596) + lu(1606) = lu(1606) - lu(749) * lu(1596) + lu(1607) = lu(1607) - lu(750) * lu(1596) + lu(1608) = lu(1608) - lu(751) * lu(1596) + lu(1609) = lu(1609) - lu(752) * lu(1596) + lu(1610) = lu(1610) - lu(753) * lu(1596) + lu(1611) = lu(1611) - lu(754) * lu(1596) + lu(1612) = lu(1612) - lu(755) * lu(1596) + lu(1613) = lu(1613) - lu(756) * lu(1596) + lu(1614) = lu(1614) - lu(757) * lu(1596) + lu(1615) = lu(1615) - lu(758) * lu(1596) + lu(1616) = lu(1616) - lu(759) * lu(1596) + lu(1617) = lu(1617) - lu(760) * lu(1596) + lu(1618) = lu(1618) - lu(761) * lu(1596) + lu(1619) = lu(1619) - lu(762) * lu(1596) + lu(1620) = lu(1620) - lu(763) * lu(1596) + lu(1636) = lu(1636) - lu(740) * lu(1635) + lu(1637) = lu(1637) - lu(741) * lu(1635) + lu(1638) = lu(1638) - lu(742) * lu(1635) + lu(1639) = lu(1639) - lu(743) * lu(1635) + lu(1640) = lu(1640) - lu(744) * lu(1635) + lu(1641) = lu(1641) - lu(745) * lu(1635) + lu(1642) = lu(1642) - lu(746) * lu(1635) + lu(1643) = lu(1643) - lu(747) * lu(1635) + lu(1644) = lu(1644) - lu(748) * lu(1635) + lu(1645) = lu(1645) - lu(749) * lu(1635) + lu(1646) = lu(1646) - lu(750) * lu(1635) + lu(1647) = lu(1647) - lu(751) * lu(1635) + lu(1648) = lu(1648) - lu(752) * lu(1635) + lu(1649) = lu(1649) - lu(753) * lu(1635) + lu(1650) = lu(1650) - lu(754) * lu(1635) + lu(1651) = lu(1651) - lu(755) * lu(1635) + lu(1652) = lu(1652) - lu(756) * lu(1635) + lu(1653) = lu(1653) - lu(757) * lu(1635) + lu(1654) = lu(1654) - lu(758) * lu(1635) + lu(1655) = lu(1655) - lu(759) * lu(1635) + lu(1656) = lu(1656) - lu(760) * lu(1635) + lu(1657) = lu(1657) - lu(761) * lu(1635) + lu(1658) = lu(1658) - lu(762) * lu(1635) + lu(1659) = lu(1659) - lu(763) * lu(1635) + lu(1722) = lu(1722) - lu(740) * lu(1721) + lu(1723) = lu(1723) - lu(741) * lu(1721) + lu(1724) = lu(1724) - lu(742) * lu(1721) + lu(1725) = lu(1725) - lu(743) * lu(1721) + lu(1726) = lu(1726) - lu(744) * lu(1721) + lu(1727) = lu(1727) - lu(745) * lu(1721) + lu(1728) = lu(1728) - lu(746) * lu(1721) + lu(1729) = lu(1729) - lu(747) * lu(1721) + lu(1730) = lu(1730) - lu(748) * lu(1721) + lu(1731) = lu(1731) - lu(749) * lu(1721) + lu(1732) = lu(1732) - lu(750) * lu(1721) + lu(1733) = lu(1733) - lu(751) * lu(1721) + lu(1734) = lu(1734) - lu(752) * lu(1721) + lu(1735) = lu(1735) - lu(753) * lu(1721) + lu(1736) = lu(1736) - lu(754) * lu(1721) + lu(1737) = lu(1737) - lu(755) * lu(1721) + lu(1738) = lu(1738) - lu(756) * lu(1721) + lu(1739) = lu(1739) - lu(757) * lu(1721) + lu(1740) = lu(1740) - lu(758) * lu(1721) + lu(1741) = lu(1741) - lu(759) * lu(1721) + lu(1742) = lu(1742) - lu(760) * lu(1721) + lu(1743) = lu(1743) - lu(761) * lu(1721) + lu(1744) = lu(1744) - lu(762) * lu(1721) + lu(1745) = lu(1745) - lu(763) * lu(1721) end subroutine lu_fac16 - subroutine lu_fac17( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac17( lu ) 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,755) = 1._r8 / lu(k,755) - lu(k,756) = lu(k,756) * lu(k,755) - lu(k,757) = lu(k,757) * lu(k,755) - lu(k,758) = lu(k,758) * lu(k,755) - lu(k,759) = lu(k,759) * lu(k,755) - lu(k,760) = lu(k,760) * lu(k,755) - lu(k,761) = lu(k,761) * lu(k,755) - lu(k,762) = lu(k,762) * lu(k,755) - lu(k,763) = lu(k,763) * lu(k,755) - lu(k,764) = lu(k,764) * lu(k,755) - lu(k,765) = lu(k,765) * lu(k,755) - lu(k,766) = lu(k,766) * lu(k,755) - lu(k,767) = lu(k,767) * lu(k,755) - lu(k,768) = lu(k,768) * lu(k,755) - lu(k,769) = lu(k,769) * lu(k,755) - lu(k,770) = lu(k,770) * lu(k,755) - lu(k,771) = lu(k,771) * lu(k,755) - lu(k,772) = lu(k,772) * lu(k,755) - lu(k,773) = lu(k,773) * lu(k,755) - lu(k,774) = lu(k,774) * lu(k,755) - lu(k,775) = lu(k,775) * lu(k,755) - lu(k,776) = lu(k,776) * lu(k,755) - lu(k,786) = lu(k,786) - lu(k,756) * lu(k,784) - lu(k,787) = lu(k,787) - lu(k,757) * lu(k,784) - lu(k,789) = lu(k,789) - lu(k,758) * lu(k,784) - lu(k,790) = lu(k,790) - lu(k,759) * lu(k,784) - lu(k,791) = lu(k,791) - lu(k,760) * lu(k,784) - lu(k,792) = lu(k,792) - lu(k,761) * lu(k,784) - lu(k,793) = lu(k,793) - lu(k,762) * lu(k,784) - lu(k,795) = lu(k,795) - lu(k,763) * lu(k,784) - lu(k,796) = lu(k,796) - lu(k,764) * lu(k,784) - lu(k,797) = lu(k,797) - lu(k,765) * lu(k,784) - lu(k,798) = lu(k,798) - lu(k,766) * lu(k,784) - lu(k,799) = lu(k,799) - lu(k,767) * lu(k,784) - lu(k,800) = lu(k,800) - lu(k,768) * lu(k,784) - lu(k,801) = lu(k,801) - lu(k,769) * lu(k,784) - lu(k,802) = lu(k,802) - lu(k,770) * lu(k,784) - lu(k,804) = lu(k,804) - lu(k,771) * lu(k,784) - lu(k,805) = lu(k,805) - lu(k,772) * lu(k,784) - lu(k,806) = lu(k,806) - lu(k,773) * lu(k,784) - lu(k,807) = lu(k,807) - lu(k,774) * lu(k,784) - lu(k,808) = lu(k,808) - lu(k,775) * lu(k,784) - lu(k,809) = lu(k,809) - lu(k,776) * lu(k,784) - lu(k,829) = lu(k,829) - lu(k,756) * lu(k,827) - lu(k,830) = lu(k,830) - lu(k,757) * lu(k,827) - lu(k,832) = lu(k,832) - lu(k,758) * lu(k,827) - lu(k,833) = lu(k,833) - lu(k,759) * lu(k,827) - lu(k,834) = lu(k,834) - lu(k,760) * lu(k,827) - lu(k,835) = lu(k,835) - lu(k,761) * lu(k,827) - lu(k,836) = lu(k,836) - lu(k,762) * lu(k,827) - lu(k,838) = lu(k,838) - lu(k,763) * lu(k,827) - lu(k,839) = lu(k,839) - lu(k,764) * lu(k,827) - lu(k,840) = lu(k,840) - lu(k,765) * lu(k,827) - lu(k,841) = lu(k,841) - lu(k,766) * lu(k,827) - lu(k,842) = lu(k,842) - lu(k,767) * lu(k,827) - lu(k,843) = lu(k,843) - lu(k,768) * lu(k,827) - lu(k,844) = lu(k,844) - lu(k,769) * lu(k,827) - lu(k,845) = lu(k,845) - lu(k,770) * lu(k,827) - lu(k,847) = lu(k,847) - lu(k,771) * lu(k,827) - lu(k,848) = lu(k,848) - lu(k,772) * lu(k,827) - lu(k,849) = lu(k,849) - lu(k,773) * lu(k,827) - lu(k,850) = lu(k,850) - lu(k,774) * lu(k,827) - lu(k,851) = lu(k,851) - lu(k,775) * lu(k,827) - lu(k,852) = lu(k,852) - lu(k,776) * lu(k,827) - lu(k,877) = lu(k,877) - lu(k,756) * lu(k,875) - lu(k,878) = lu(k,878) - lu(k,757) * lu(k,875) - lu(k,880) = lu(k,880) - lu(k,758) * lu(k,875) - lu(k,881) = lu(k,881) - lu(k,759) * lu(k,875) - lu(k,882) = lu(k,882) - lu(k,760) * lu(k,875) - lu(k,883) = lu(k,883) - lu(k,761) * lu(k,875) - lu(k,884) = lu(k,884) - lu(k,762) * lu(k,875) - lu(k,886) = lu(k,886) - lu(k,763) * lu(k,875) - lu(k,887) = lu(k,887) - lu(k,764) * lu(k,875) - lu(k,888) = lu(k,888) - lu(k,765) * lu(k,875) - lu(k,889) = lu(k,889) - lu(k,766) * lu(k,875) - lu(k,890) = lu(k,890) - lu(k,767) * lu(k,875) - lu(k,891) = lu(k,891) - lu(k,768) * lu(k,875) - lu(k,892) = lu(k,892) - lu(k,769) * lu(k,875) - lu(k,893) = lu(k,893) - lu(k,770) * lu(k,875) - lu(k,895) = lu(k,895) - lu(k,771) * lu(k,875) - lu(k,896) = lu(k,896) - lu(k,772) * lu(k,875) - lu(k,897) = lu(k,897) - lu(k,773) * lu(k,875) - lu(k,898) = lu(k,898) - lu(k,774) * lu(k,875) - lu(k,899) = lu(k,899) - lu(k,775) * lu(k,875) - lu(k,900) = lu(k,900) - lu(k,776) * lu(k,875) - lu(k,920) = lu(k,920) - lu(k,756) * lu(k,918) - lu(k,921) = lu(k,921) - lu(k,757) * lu(k,918) - lu(k,923) = lu(k,923) - lu(k,758) * lu(k,918) - lu(k,924) = lu(k,924) - lu(k,759) * lu(k,918) - lu(k,925) = lu(k,925) - lu(k,760) * lu(k,918) - lu(k,926) = lu(k,926) - lu(k,761) * lu(k,918) - lu(k,927) = lu(k,927) - lu(k,762) * lu(k,918) - lu(k,929) = lu(k,929) - lu(k,763) * lu(k,918) - lu(k,930) = lu(k,930) - lu(k,764) * lu(k,918) - lu(k,931) = lu(k,931) - lu(k,765) * lu(k,918) - lu(k,932) = lu(k,932) - lu(k,766) * lu(k,918) - lu(k,933) = lu(k,933) - lu(k,767) * lu(k,918) - lu(k,934) = lu(k,934) - lu(k,768) * lu(k,918) - lu(k,935) = lu(k,935) - lu(k,769) * lu(k,918) - lu(k,936) = lu(k,936) - lu(k,770) * lu(k,918) - lu(k,938) = lu(k,938) - lu(k,771) * lu(k,918) - lu(k,939) = lu(k,939) - lu(k,772) * lu(k,918) - lu(k,940) = lu(k,940) - lu(k,773) * lu(k,918) - lu(k,941) = lu(k,941) - lu(k,774) * lu(k,918) - lu(k,942) = lu(k,942) - lu(k,775) * lu(k,918) - lu(k,943) = lu(k,943) - lu(k,776) * lu(k,918) - lu(k,976) = lu(k,976) - lu(k,756) * lu(k,974) - lu(k,977) = lu(k,977) - lu(k,757) * lu(k,974) - lu(k,979) = lu(k,979) - lu(k,758) * lu(k,974) - lu(k,980) = lu(k,980) - lu(k,759) * lu(k,974) - lu(k,981) = lu(k,981) - lu(k,760) * lu(k,974) - lu(k,982) = lu(k,982) - lu(k,761) * lu(k,974) - lu(k,983) = lu(k,983) - lu(k,762) * lu(k,974) - lu(k,985) = lu(k,985) - lu(k,763) * lu(k,974) - lu(k,986) = lu(k,986) - lu(k,764) * lu(k,974) - lu(k,987) = lu(k,987) - lu(k,765) * lu(k,974) - lu(k,988) = lu(k,988) - lu(k,766) * lu(k,974) - lu(k,989) = lu(k,989) - lu(k,767) * lu(k,974) - lu(k,990) = lu(k,990) - lu(k,768) * lu(k,974) - lu(k,991) = lu(k,991) - lu(k,769) * lu(k,974) - lu(k,992) = lu(k,992) - lu(k,770) * lu(k,974) - lu(k,994) = lu(k,994) - lu(k,771) * lu(k,974) - lu(k,995) = lu(k,995) - lu(k,772) * lu(k,974) - lu(k,996) = lu(k,996) - lu(k,773) * lu(k,974) - lu(k,997) = lu(k,997) - lu(k,774) * lu(k,974) - lu(k,998) = lu(k,998) - lu(k,775) * lu(k,974) - lu(k,999) = lu(k,999) - lu(k,776) * lu(k,974) - lu(k,1019) = lu(k,1019) - lu(k,756) * lu(k,1018) - lu(k,1020) = lu(k,1020) - lu(k,757) * lu(k,1018) - lu(k,1022) = lu(k,1022) - lu(k,758) * lu(k,1018) - lu(k,1023) = lu(k,1023) - lu(k,759) * lu(k,1018) - lu(k,1024) = lu(k,1024) - lu(k,760) * lu(k,1018) - lu(k,1025) = lu(k,1025) - lu(k,761) * lu(k,1018) - lu(k,1026) = lu(k,1026) - lu(k,762) * lu(k,1018) - lu(k,1028) = lu(k,1028) - lu(k,763) * lu(k,1018) - lu(k,1029) = lu(k,1029) - lu(k,764) * lu(k,1018) - lu(k,1030) = lu(k,1030) - lu(k,765) * lu(k,1018) - lu(k,1031) = lu(k,1031) - lu(k,766) * lu(k,1018) - lu(k,1032) = lu(k,1032) - lu(k,767) * lu(k,1018) - lu(k,1033) = lu(k,1033) - lu(k,768) * lu(k,1018) - lu(k,1034) = lu(k,1034) - lu(k,769) * lu(k,1018) - lu(k,1035) = lu(k,1035) - lu(k,770) * lu(k,1018) - lu(k,1037) = lu(k,1037) - lu(k,771) * lu(k,1018) - lu(k,1038) = lu(k,1038) - lu(k,772) * lu(k,1018) - lu(k,1039) = lu(k,1039) - lu(k,773) * lu(k,1018) - lu(k,1040) = lu(k,1040) - lu(k,774) * lu(k,1018) - lu(k,1041) = lu(k,1041) - lu(k,775) * lu(k,1018) - lu(k,1042) = lu(k,1042) - lu(k,776) * lu(k,1018) - lu(k,1061) = lu(k,1061) - lu(k,756) * lu(k,1059) - lu(k,1062) = lu(k,1062) - lu(k,757) * lu(k,1059) - lu(k,1064) = lu(k,1064) - lu(k,758) * lu(k,1059) - lu(k,1065) = lu(k,1065) - lu(k,759) * lu(k,1059) - lu(k,1066) = lu(k,1066) - lu(k,760) * lu(k,1059) - lu(k,1067) = lu(k,1067) - lu(k,761) * lu(k,1059) - lu(k,1068) = lu(k,1068) - lu(k,762) * lu(k,1059) - lu(k,1070) = lu(k,1070) - lu(k,763) * lu(k,1059) - lu(k,1071) = lu(k,1071) - lu(k,764) * lu(k,1059) - lu(k,1072) = lu(k,1072) - lu(k,765) * lu(k,1059) - lu(k,1073) = lu(k,1073) - lu(k,766) * lu(k,1059) - lu(k,1074) = lu(k,1074) - lu(k,767) * lu(k,1059) - lu(k,1075) = lu(k,1075) - lu(k,768) * lu(k,1059) - lu(k,1076) = lu(k,1076) - lu(k,769) * lu(k,1059) - lu(k,1077) = lu(k,1077) - lu(k,770) * lu(k,1059) - lu(k,1079) = lu(k,1079) - lu(k,771) * lu(k,1059) - lu(k,1080) = lu(k,1080) - lu(k,772) * lu(k,1059) - lu(k,1081) = lu(k,1081) - lu(k,773) * lu(k,1059) - lu(k,1082) = lu(k,1082) - lu(k,774) * lu(k,1059) - lu(k,1083) = lu(k,1083) - lu(k,775) * lu(k,1059) - lu(k,1084) = lu(k,1084) - lu(k,776) * lu(k,1059) - lu(k,1101) = lu(k,1101) - lu(k,756) * lu(k,1099) - lu(k,1102) = lu(k,1102) - lu(k,757) * lu(k,1099) - lu(k,1104) = lu(k,1104) - lu(k,758) * lu(k,1099) - lu(k,1105) = lu(k,1105) - lu(k,759) * lu(k,1099) - lu(k,1106) = lu(k,1106) - lu(k,760) * lu(k,1099) - lu(k,1107) = lu(k,1107) - lu(k,761) * lu(k,1099) - lu(k,1108) = lu(k,1108) - lu(k,762) * lu(k,1099) - lu(k,1110) = lu(k,1110) - lu(k,763) * lu(k,1099) - lu(k,1111) = lu(k,1111) - lu(k,764) * lu(k,1099) - lu(k,1112) = lu(k,1112) - lu(k,765) * lu(k,1099) - lu(k,1113) = lu(k,1113) - lu(k,766) * lu(k,1099) - lu(k,1114) = lu(k,1114) - lu(k,767) * lu(k,1099) - lu(k,1115) = lu(k,1115) - lu(k,768) * lu(k,1099) - lu(k,1116) = lu(k,1116) - lu(k,769) * lu(k,1099) - lu(k,1117) = lu(k,1117) - lu(k,770) * lu(k,1099) - lu(k,1119) = lu(k,1119) - lu(k,771) * lu(k,1099) - lu(k,1120) = lu(k,1120) - lu(k,772) * lu(k,1099) - lu(k,1121) = lu(k,1121) - lu(k,773) * lu(k,1099) - lu(k,1122) = lu(k,1122) - lu(k,774) * lu(k,1099) - lu(k,1123) = lu(k,1123) - lu(k,775) * lu(k,1099) - lu(k,1124) = lu(k,1124) - lu(k,776) * lu(k,1099) - lu(k,1146) = lu(k,1146) - lu(k,756) * lu(k,1144) - lu(k,1147) = lu(k,1147) - lu(k,757) * lu(k,1144) - lu(k,1149) = lu(k,1149) - lu(k,758) * lu(k,1144) - lu(k,1150) = lu(k,1150) - lu(k,759) * lu(k,1144) - lu(k,1151) = lu(k,1151) - lu(k,760) * lu(k,1144) - lu(k,1152) = lu(k,1152) - lu(k,761) * lu(k,1144) - lu(k,1153) = lu(k,1153) - lu(k,762) * lu(k,1144) - lu(k,1155) = lu(k,1155) - lu(k,763) * lu(k,1144) - lu(k,1156) = lu(k,1156) - lu(k,764) * lu(k,1144) - lu(k,1157) = lu(k,1157) - lu(k,765) * lu(k,1144) - lu(k,1158) = lu(k,1158) - lu(k,766) * lu(k,1144) - lu(k,1159) = lu(k,1159) - lu(k,767) * lu(k,1144) - lu(k,1160) = lu(k,1160) - lu(k,768) * lu(k,1144) - lu(k,1161) = lu(k,1161) - lu(k,769) * lu(k,1144) - lu(k,1162) = lu(k,1162) - lu(k,770) * lu(k,1144) - lu(k,1164) = lu(k,1164) - lu(k,771) * lu(k,1144) - lu(k,1165) = lu(k,1165) - lu(k,772) * lu(k,1144) - lu(k,1166) = lu(k,1166) - lu(k,773) * lu(k,1144) - lu(k,1167) = lu(k,1167) - lu(k,774) * lu(k,1144) - lu(k,1168) = lu(k,1168) - lu(k,775) * lu(k,1144) - lu(k,1169) = lu(k,1169) - lu(k,776) * lu(k,1144) - lu(k,1189) = lu(k,1189) - lu(k,756) * lu(k,1187) - lu(k,1190) = lu(k,1190) - lu(k,757) * lu(k,1187) - lu(k,1192) = lu(k,1192) - lu(k,758) * lu(k,1187) - lu(k,1193) = lu(k,1193) - lu(k,759) * lu(k,1187) - lu(k,1194) = lu(k,1194) - lu(k,760) * lu(k,1187) - lu(k,1195) = lu(k,1195) - lu(k,761) * lu(k,1187) - lu(k,1196) = lu(k,1196) - lu(k,762) * lu(k,1187) - lu(k,1198) = lu(k,1198) - lu(k,763) * lu(k,1187) - lu(k,1199) = lu(k,1199) - lu(k,764) * lu(k,1187) - lu(k,1200) = lu(k,1200) - lu(k,765) * lu(k,1187) - lu(k,1201) = lu(k,1201) - lu(k,766) * lu(k,1187) - lu(k,1202) = lu(k,1202) - lu(k,767) * lu(k,1187) - lu(k,1203) = lu(k,1203) - lu(k,768) * lu(k,1187) - lu(k,1204) = lu(k,1204) - lu(k,769) * lu(k,1187) - lu(k,1205) = lu(k,1205) - lu(k,770) * lu(k,1187) - lu(k,1207) = lu(k,1207) - lu(k,771) * lu(k,1187) - lu(k,1208) = lu(k,1208) - lu(k,772) * lu(k,1187) - lu(k,1209) = lu(k,1209) - lu(k,773) * lu(k,1187) - lu(k,1210) = lu(k,1210) - lu(k,774) * lu(k,1187) - lu(k,1211) = lu(k,1211) - lu(k,775) * lu(k,1187) - lu(k,1212) = lu(k,1212) - lu(k,776) * lu(k,1187) - lu(k,1224) = lu(k,1224) - lu(k,756) * lu(k,1223) - lu(k,1225) = lu(k,1225) - lu(k,757) * lu(k,1223) - lu(k,1227) = lu(k,1227) - lu(k,758) * lu(k,1223) - lu(k,1228) = lu(k,1228) - lu(k,759) * lu(k,1223) - lu(k,1229) = lu(k,1229) - lu(k,760) * lu(k,1223) - lu(k,1230) = lu(k,1230) - lu(k,761) * lu(k,1223) - lu(k,1231) = lu(k,1231) - lu(k,762) * lu(k,1223) - lu(k,1233) = lu(k,1233) - lu(k,763) * lu(k,1223) - lu(k,1234) = lu(k,1234) - lu(k,764) * lu(k,1223) - lu(k,1235) = lu(k,1235) - lu(k,765) * lu(k,1223) - lu(k,1236) = lu(k,1236) - lu(k,766) * lu(k,1223) - lu(k,1237) = lu(k,1237) - lu(k,767) * lu(k,1223) - lu(k,1238) = lu(k,1238) - lu(k,768) * lu(k,1223) - lu(k,1239) = lu(k,1239) - lu(k,769) * lu(k,1223) - lu(k,1240) = lu(k,1240) - lu(k,770) * lu(k,1223) - lu(k,1242) = lu(k,1242) - lu(k,771) * lu(k,1223) - lu(k,1243) = lu(k,1243) - lu(k,772) * lu(k,1223) - lu(k,1244) = lu(k,1244) - lu(k,773) * lu(k,1223) - lu(k,1245) = lu(k,1245) - lu(k,774) * lu(k,1223) - lu(k,1246) = lu(k,1246) - lu(k,775) * lu(k,1223) - lu(k,1247) = lu(k,1247) - lu(k,776) * lu(k,1223) - lu(k,1267) = lu(k,1267) - lu(k,756) * lu(k,1265) - lu(k,1268) = lu(k,1268) - lu(k,757) * lu(k,1265) - lu(k,1270) = lu(k,1270) - lu(k,758) * lu(k,1265) - lu(k,1271) = lu(k,1271) - lu(k,759) * lu(k,1265) - lu(k,1272) = lu(k,1272) - lu(k,760) * lu(k,1265) - lu(k,1273) = lu(k,1273) - lu(k,761) * lu(k,1265) - lu(k,1274) = lu(k,1274) - lu(k,762) * lu(k,1265) - lu(k,1276) = lu(k,1276) - lu(k,763) * lu(k,1265) - lu(k,1277) = lu(k,1277) - lu(k,764) * lu(k,1265) - lu(k,1278) = lu(k,1278) - lu(k,765) * lu(k,1265) - lu(k,1279) = lu(k,1279) - lu(k,766) * lu(k,1265) - lu(k,1280) = lu(k,1280) - lu(k,767) * lu(k,1265) - lu(k,1281) = lu(k,1281) - lu(k,768) * lu(k,1265) - lu(k,1282) = lu(k,1282) - lu(k,769) * lu(k,1265) - lu(k,1283) = lu(k,1283) - lu(k,770) * lu(k,1265) - lu(k,1285) = lu(k,1285) - lu(k,771) * lu(k,1265) - lu(k,1286) = lu(k,1286) - lu(k,772) * lu(k,1265) - lu(k,1287) = lu(k,1287) - lu(k,773) * lu(k,1265) - lu(k,1288) = lu(k,1288) - lu(k,774) * lu(k,1265) - lu(k,1289) = lu(k,1289) - lu(k,775) * lu(k,1265) - lu(k,1290) = lu(k,1290) - lu(k,776) * lu(k,1265) - lu(k,1303) = lu(k,1303) - lu(k,756) * lu(k,1301) - lu(k,1304) = lu(k,1304) - lu(k,757) * lu(k,1301) - lu(k,1306) = lu(k,1306) - lu(k,758) * lu(k,1301) - lu(k,1307) = lu(k,1307) - lu(k,759) * lu(k,1301) - lu(k,1308) = lu(k,1308) - lu(k,760) * lu(k,1301) - lu(k,1309) = lu(k,1309) - lu(k,761) * lu(k,1301) - lu(k,1310) = lu(k,1310) - lu(k,762) * lu(k,1301) - lu(k,1312) = lu(k,1312) - lu(k,763) * lu(k,1301) - lu(k,1313) = lu(k,1313) - lu(k,764) * lu(k,1301) - lu(k,1314) = lu(k,1314) - lu(k,765) * lu(k,1301) - lu(k,1315) = lu(k,1315) - lu(k,766) * lu(k,1301) - lu(k,1316) = lu(k,1316) - lu(k,767) * lu(k,1301) - lu(k,1317) = lu(k,1317) - lu(k,768) * lu(k,1301) - lu(k,1318) = lu(k,1318) - lu(k,769) * lu(k,1301) - lu(k,1319) = lu(k,1319) - lu(k,770) * lu(k,1301) - lu(k,1321) = lu(k,1321) - lu(k,771) * lu(k,1301) - lu(k,1322) = lu(k,1322) - lu(k,772) * lu(k,1301) - lu(k,1323) = lu(k,1323) - lu(k,773) * lu(k,1301) - lu(k,1324) = lu(k,1324) - lu(k,774) * lu(k,1301) - lu(k,1325) = lu(k,1325) - lu(k,775) * lu(k,1301) - lu(k,1326) = lu(k,1326) - lu(k,776) * lu(k,1301) - lu(k,1348) = lu(k,1348) - lu(k,756) * lu(k,1346) - lu(k,1349) = lu(k,1349) - lu(k,757) * lu(k,1346) - lu(k,1351) = lu(k,1351) - lu(k,758) * lu(k,1346) - lu(k,1352) = lu(k,1352) - lu(k,759) * lu(k,1346) - lu(k,1353) = lu(k,1353) - lu(k,760) * lu(k,1346) - lu(k,1354) = lu(k,1354) - lu(k,761) * lu(k,1346) - lu(k,1355) = lu(k,1355) - lu(k,762) * lu(k,1346) - lu(k,1357) = lu(k,1357) - lu(k,763) * lu(k,1346) - lu(k,1358) = lu(k,1358) - lu(k,764) * lu(k,1346) - lu(k,1359) = lu(k,1359) - lu(k,765) * lu(k,1346) - lu(k,1360) = lu(k,1360) - lu(k,766) * lu(k,1346) - lu(k,1361) = lu(k,1361) - lu(k,767) * lu(k,1346) - lu(k,1362) = lu(k,1362) - lu(k,768) * lu(k,1346) - lu(k,1363) = lu(k,1363) - lu(k,769) * lu(k,1346) - lu(k,1364) = lu(k,1364) - lu(k,770) * lu(k,1346) - lu(k,1366) = lu(k,1366) - lu(k,771) * lu(k,1346) - lu(k,1367) = lu(k,1367) - lu(k,772) * lu(k,1346) - lu(k,1368) = lu(k,1368) - lu(k,773) * lu(k,1346) - lu(k,1369) = lu(k,1369) - lu(k,774) * lu(k,1346) - lu(k,1370) = lu(k,1370) - lu(k,775) * lu(k,1346) - lu(k,1371) = lu(k,1371) - lu(k,776) * lu(k,1346) - lu(k,1390) = lu(k,1390) - lu(k,756) * lu(k,1388) - lu(k,1391) = lu(k,1391) - lu(k,757) * lu(k,1388) - lu(k,1393) = lu(k,1393) - lu(k,758) * lu(k,1388) - lu(k,1394) = lu(k,1394) - lu(k,759) * lu(k,1388) - lu(k,1395) = lu(k,1395) - lu(k,760) * lu(k,1388) - lu(k,1396) = lu(k,1396) - lu(k,761) * lu(k,1388) - lu(k,1397) = lu(k,1397) - lu(k,762) * lu(k,1388) - lu(k,1399) = lu(k,1399) - lu(k,763) * lu(k,1388) - lu(k,1400) = lu(k,1400) - lu(k,764) * lu(k,1388) - lu(k,1401) = lu(k,1401) - lu(k,765) * lu(k,1388) - lu(k,1402) = lu(k,1402) - lu(k,766) * lu(k,1388) - lu(k,1403) = lu(k,1403) - lu(k,767) * lu(k,1388) - lu(k,1404) = lu(k,1404) - lu(k,768) * lu(k,1388) - lu(k,1405) = lu(k,1405) - lu(k,769) * lu(k,1388) - lu(k,1406) = lu(k,1406) - lu(k,770) * lu(k,1388) - lu(k,1408) = lu(k,1408) - lu(k,771) * lu(k,1388) - lu(k,1409) = lu(k,1409) - lu(k,772) * lu(k,1388) - lu(k,1410) = lu(k,1410) - lu(k,773) * lu(k,1388) - lu(k,1411) = lu(k,1411) - lu(k,774) * lu(k,1388) - lu(k,1412) = lu(k,1412) - lu(k,775) * lu(k,1388) - lu(k,1413) = lu(k,1413) - lu(k,776) * lu(k,1388) - lu(k,1428) = lu(k,1428) - lu(k,756) * lu(k,1426) - lu(k,1429) = lu(k,1429) - lu(k,757) * lu(k,1426) - lu(k,1431) = lu(k,1431) - lu(k,758) * lu(k,1426) - lu(k,1432) = lu(k,1432) - lu(k,759) * lu(k,1426) - lu(k,1433) = lu(k,1433) - lu(k,760) * lu(k,1426) - lu(k,1434) = lu(k,1434) - lu(k,761) * lu(k,1426) - lu(k,1435) = lu(k,1435) - lu(k,762) * lu(k,1426) - lu(k,1437) = lu(k,1437) - lu(k,763) * lu(k,1426) - lu(k,1438) = lu(k,1438) - lu(k,764) * lu(k,1426) - lu(k,1439) = lu(k,1439) - lu(k,765) * lu(k,1426) - lu(k,1440) = lu(k,1440) - lu(k,766) * lu(k,1426) - lu(k,1441) = lu(k,1441) - lu(k,767) * lu(k,1426) - lu(k,1442) = lu(k,1442) - lu(k,768) * lu(k,1426) - lu(k,1443) = lu(k,1443) - lu(k,769) * lu(k,1426) - lu(k,1444) = lu(k,1444) - lu(k,770) * lu(k,1426) - lu(k,1446) = lu(k,1446) - lu(k,771) * lu(k,1426) - lu(k,1447) = lu(k,1447) - lu(k,772) * lu(k,1426) - lu(k,1448) = lu(k,1448) - lu(k,773) * lu(k,1426) - lu(k,1449) = lu(k,1449) - lu(k,774) * lu(k,1426) - lu(k,1450) = lu(k,1450) - lu(k,775) * lu(k,1426) - lu(k,1451) = lu(k,1451) - lu(k,776) * lu(k,1426) - lu(k,1473) = lu(k,1473) - lu(k,756) * lu(k,1471) - lu(k,1474) = lu(k,1474) - lu(k,757) * lu(k,1471) - lu(k,1476) = lu(k,1476) - lu(k,758) * lu(k,1471) - lu(k,1477) = lu(k,1477) - lu(k,759) * lu(k,1471) - lu(k,1478) = lu(k,1478) - lu(k,760) * lu(k,1471) - lu(k,1479) = lu(k,1479) - lu(k,761) * lu(k,1471) - lu(k,1480) = lu(k,1480) - lu(k,762) * lu(k,1471) - lu(k,1482) = lu(k,1482) - lu(k,763) * lu(k,1471) - lu(k,1483) = lu(k,1483) - lu(k,764) * lu(k,1471) - lu(k,1484) = lu(k,1484) - lu(k,765) * lu(k,1471) - lu(k,1485) = lu(k,1485) - lu(k,766) * lu(k,1471) - lu(k,1486) = lu(k,1486) - lu(k,767) * lu(k,1471) - lu(k,1487) = lu(k,1487) - lu(k,768) * lu(k,1471) - lu(k,1488) = lu(k,1488) - lu(k,769) * lu(k,1471) - lu(k,1489) = lu(k,1489) - lu(k,770) * lu(k,1471) - lu(k,1491) = lu(k,1491) - lu(k,771) * lu(k,1471) - lu(k,1492) = lu(k,1492) - lu(k,772) * lu(k,1471) - lu(k,1493) = lu(k,1493) - lu(k,773) * lu(k,1471) - lu(k,1494) = lu(k,1494) - lu(k,774) * lu(k,1471) - lu(k,1495) = lu(k,1495) - lu(k,775) * lu(k,1471) - lu(k,1496) = lu(k,1496) - lu(k,776) * lu(k,1471) - lu(k,1516) = lu(k,1516) - lu(k,756) * lu(k,1514) - lu(k,1517) = lu(k,1517) - lu(k,757) * lu(k,1514) - lu(k,1519) = lu(k,1519) - lu(k,758) * lu(k,1514) - lu(k,1520) = lu(k,1520) - lu(k,759) * lu(k,1514) - lu(k,1521) = lu(k,1521) - lu(k,760) * lu(k,1514) - lu(k,1522) = lu(k,1522) - lu(k,761) * lu(k,1514) - lu(k,1523) = lu(k,1523) - lu(k,762) * lu(k,1514) - lu(k,1525) = lu(k,1525) - lu(k,763) * lu(k,1514) - lu(k,1526) = lu(k,1526) - lu(k,764) * lu(k,1514) - lu(k,1527) = lu(k,1527) - lu(k,765) * lu(k,1514) - lu(k,1528) = lu(k,1528) - lu(k,766) * lu(k,1514) - lu(k,1529) = lu(k,1529) - lu(k,767) * lu(k,1514) - lu(k,1530) = lu(k,1530) - lu(k,768) * lu(k,1514) - lu(k,1531) = lu(k,1531) - lu(k,769) * lu(k,1514) - lu(k,1532) = lu(k,1532) - lu(k,770) * lu(k,1514) - lu(k,1534) = lu(k,1534) - lu(k,771) * lu(k,1514) - lu(k,1535) = lu(k,1535) - lu(k,772) * lu(k,1514) - lu(k,1536) = lu(k,1536) - lu(k,773) * lu(k,1514) - lu(k,1537) = lu(k,1537) - lu(k,774) * lu(k,1514) - lu(k,1538) = lu(k,1538) - lu(k,775) * lu(k,1514) - lu(k,1539) = lu(k,1539) - lu(k,776) * lu(k,1514) - lu(k,1559) = lu(k,1559) - lu(k,756) * lu(k,1557) - lu(k,1560) = lu(k,1560) - lu(k,757) * lu(k,1557) - lu(k,1562) = lu(k,1562) - lu(k,758) * lu(k,1557) - lu(k,1563) = lu(k,1563) - lu(k,759) * lu(k,1557) - lu(k,1564) = lu(k,1564) - lu(k,760) * lu(k,1557) - lu(k,1565) = lu(k,1565) - lu(k,761) * lu(k,1557) - lu(k,1566) = lu(k,1566) - lu(k,762) * lu(k,1557) - lu(k,1568) = lu(k,1568) - lu(k,763) * lu(k,1557) - lu(k,1569) = lu(k,1569) - lu(k,764) * lu(k,1557) - lu(k,1570) = lu(k,1570) - lu(k,765) * lu(k,1557) - lu(k,1571) = lu(k,1571) - lu(k,766) * lu(k,1557) - lu(k,1572) = lu(k,1572) - lu(k,767) * lu(k,1557) - lu(k,1573) = lu(k,1573) - lu(k,768) * lu(k,1557) - lu(k,1574) = lu(k,1574) - lu(k,769) * lu(k,1557) - lu(k,1575) = lu(k,1575) - lu(k,770) * lu(k,1557) - lu(k,1577) = lu(k,1577) - lu(k,771) * lu(k,1557) - lu(k,1578) = lu(k,1578) - lu(k,772) * lu(k,1557) - lu(k,1579) = lu(k,1579) - lu(k,773) * lu(k,1557) - lu(k,1580) = lu(k,1580) - lu(k,774) * lu(k,1557) - lu(k,1581) = lu(k,1581) - lu(k,775) * lu(k,1557) - lu(k,1582) = lu(k,1582) - lu(k,776) * lu(k,1557) - lu(k,1592) = lu(k,1592) - lu(k,756) * lu(k,1590) - lu(k,1593) = lu(k,1593) - lu(k,757) * lu(k,1590) - lu(k,1595) = lu(k,1595) - lu(k,758) * lu(k,1590) - lu(k,1596) = lu(k,1596) - lu(k,759) * lu(k,1590) - lu(k,1597) = lu(k,1597) - lu(k,760) * lu(k,1590) - lu(k,1598) = lu(k,1598) - lu(k,761) * lu(k,1590) - lu(k,1599) = lu(k,1599) - lu(k,762) * lu(k,1590) - lu(k,1601) = lu(k,1601) - lu(k,763) * lu(k,1590) - lu(k,1602) = lu(k,1602) - lu(k,764) * lu(k,1590) - lu(k,1603) = lu(k,1603) - lu(k,765) * lu(k,1590) - lu(k,1604) = lu(k,1604) - lu(k,766) * lu(k,1590) - lu(k,1605) = lu(k,1605) - lu(k,767) * lu(k,1590) - lu(k,1606) = lu(k,1606) - lu(k,768) * lu(k,1590) - lu(k,1607) = lu(k,1607) - lu(k,769) * lu(k,1590) - lu(k,1608) = lu(k,1608) - lu(k,770) * lu(k,1590) - lu(k,1610) = lu(k,1610) - lu(k,771) * lu(k,1590) - lu(k,1611) = lu(k,1611) - lu(k,772) * lu(k,1590) - lu(k,1612) = lu(k,1612) - lu(k,773) * lu(k,1590) - lu(k,1613) = lu(k,1613) - lu(k,774) * lu(k,1590) - lu(k,1614) = lu(k,1614) - lu(k,775) * lu(k,1590) - lu(k,1615) = lu(k,1615) - lu(k,776) * lu(k,1590) - lu(k,1628) = lu(k,1628) - lu(k,756) * lu(k,1626) - lu(k,1629) = lu(k,1629) - lu(k,757) * lu(k,1626) - lu(k,1631) = lu(k,1631) - lu(k,758) * lu(k,1626) - lu(k,1632) = lu(k,1632) - lu(k,759) * lu(k,1626) - lu(k,1633) = lu(k,1633) - lu(k,760) * lu(k,1626) - lu(k,1634) = lu(k,1634) - lu(k,761) * lu(k,1626) - lu(k,1635) = lu(k,1635) - lu(k,762) * lu(k,1626) - lu(k,1637) = lu(k,1637) - lu(k,763) * lu(k,1626) - lu(k,1638) = lu(k,1638) - lu(k,764) * lu(k,1626) - lu(k,1639) = lu(k,1639) - lu(k,765) * lu(k,1626) - lu(k,1640) = lu(k,1640) - lu(k,766) * lu(k,1626) - lu(k,1641) = lu(k,1641) - lu(k,767) * lu(k,1626) - lu(k,1642) = lu(k,1642) - lu(k,768) * lu(k,1626) - lu(k,1643) = lu(k,1643) - lu(k,769) * lu(k,1626) - lu(k,1644) = lu(k,1644) - lu(k,770) * lu(k,1626) - lu(k,1646) = lu(k,1646) - lu(k,771) * lu(k,1626) - lu(k,1647) = lu(k,1647) - lu(k,772) * lu(k,1626) - lu(k,1648) = lu(k,1648) - lu(k,773) * lu(k,1626) - lu(k,1649) = lu(k,1649) - lu(k,774) * lu(k,1626) - lu(k,1650) = lu(k,1650) - lu(k,775) * lu(k,1626) - lu(k,1651) = lu(k,1651) - lu(k,776) * lu(k,1626) - lu(k,1671) = lu(k,1671) - lu(k,756) * lu(k,1669) - lu(k,1672) = lu(k,1672) - lu(k,757) * lu(k,1669) - lu(k,1674) = lu(k,1674) - lu(k,758) * lu(k,1669) - lu(k,1675) = lu(k,1675) - lu(k,759) * lu(k,1669) - lu(k,1676) = lu(k,1676) - lu(k,760) * lu(k,1669) - lu(k,1677) = lu(k,1677) - lu(k,761) * lu(k,1669) - lu(k,1678) = lu(k,1678) - lu(k,762) * lu(k,1669) - lu(k,1680) = lu(k,1680) - lu(k,763) * lu(k,1669) - lu(k,1681) = lu(k,1681) - lu(k,764) * lu(k,1669) - lu(k,1682) = lu(k,1682) - lu(k,765) * lu(k,1669) - lu(k,1683) = lu(k,1683) - lu(k,766) * lu(k,1669) - lu(k,1684) = lu(k,1684) - lu(k,767) * lu(k,1669) - lu(k,1685) = lu(k,1685) - lu(k,768) * lu(k,1669) - lu(k,1686) = lu(k,1686) - lu(k,769) * lu(k,1669) - lu(k,1687) = lu(k,1687) - lu(k,770) * lu(k,1669) - lu(k,1689) = lu(k,1689) - lu(k,771) * lu(k,1669) - lu(k,1690) = lu(k,1690) - lu(k,772) * lu(k,1669) - lu(k,1691) = lu(k,1691) - lu(k,773) * lu(k,1669) - lu(k,1692) = lu(k,1692) - lu(k,774) * lu(k,1669) - lu(k,1693) = lu(k,1693) - lu(k,775) * lu(k,1669) - lu(k,1694) = lu(k,1694) - lu(k,776) * lu(k,1669) - lu(k,1707) = lu(k,1707) - lu(k,756) * lu(k,1705) - lu(k,1708) = lu(k,1708) - lu(k,757) * lu(k,1705) - lu(k,1710) = lu(k,1710) - lu(k,758) * lu(k,1705) - lu(k,1711) = lu(k,1711) - lu(k,759) * lu(k,1705) - lu(k,1712) = lu(k,1712) - lu(k,760) * lu(k,1705) - lu(k,1713) = lu(k,1713) - lu(k,761) * lu(k,1705) - lu(k,1714) = lu(k,1714) - lu(k,762) * lu(k,1705) - lu(k,1716) = lu(k,1716) - lu(k,763) * lu(k,1705) - lu(k,1717) = lu(k,1717) - lu(k,764) * lu(k,1705) - lu(k,1718) = lu(k,1718) - lu(k,765) * lu(k,1705) - lu(k,1719) = lu(k,1719) - lu(k,766) * lu(k,1705) - lu(k,1720) = lu(k,1720) - lu(k,767) * lu(k,1705) - lu(k,1721) = lu(k,1721) - lu(k,768) * lu(k,1705) - lu(k,1722) = lu(k,1722) - lu(k,769) * lu(k,1705) - lu(k,1723) = lu(k,1723) - lu(k,770) * lu(k,1705) - lu(k,1725) = lu(k,1725) - lu(k,771) * lu(k,1705) - lu(k,1726) = lu(k,1726) - lu(k,772) * lu(k,1705) - lu(k,1727) = lu(k,1727) - lu(k,773) * lu(k,1705) - lu(k,1728) = lu(k,1728) - lu(k,774) * lu(k,1705) - lu(k,1729) = lu(k,1729) - lu(k,775) * lu(k,1705) - lu(k,1730) = lu(k,1730) - lu(k,776) * lu(k,1705) - lu(k,1749) = lu(k,1749) - lu(k,756) * lu(k,1747) - lu(k,1750) = lu(k,1750) - lu(k,757) * lu(k,1747) - lu(k,1752) = lu(k,1752) - lu(k,758) * lu(k,1747) - lu(k,1753) = lu(k,1753) - lu(k,759) * lu(k,1747) - lu(k,1754) = lu(k,1754) - lu(k,760) * lu(k,1747) - lu(k,1755) = lu(k,1755) - lu(k,761) * lu(k,1747) - lu(k,1756) = lu(k,1756) - lu(k,762) * lu(k,1747) - lu(k,1758) = lu(k,1758) - lu(k,763) * lu(k,1747) - lu(k,1759) = lu(k,1759) - lu(k,764) * lu(k,1747) - lu(k,1760) = lu(k,1760) - lu(k,765) * lu(k,1747) - lu(k,1761) = lu(k,1761) - lu(k,766) * lu(k,1747) - lu(k,1762) = lu(k,1762) - lu(k,767) * lu(k,1747) - lu(k,1763) = lu(k,1763) - lu(k,768) * lu(k,1747) - lu(k,1764) = lu(k,1764) - lu(k,769) * lu(k,1747) - lu(k,1765) = lu(k,1765) - lu(k,770) * lu(k,1747) - lu(k,1767) = lu(k,1767) - lu(k,771) * lu(k,1747) - lu(k,1768) = lu(k,1768) - lu(k,772) * lu(k,1747) - lu(k,1769) = lu(k,1769) - lu(k,773) * lu(k,1747) - lu(k,1770) = lu(k,1770) - lu(k,774) * lu(k,1747) - lu(k,1771) = lu(k,1771) - lu(k,775) * lu(k,1747) - lu(k,1772) = lu(k,1772) - lu(k,776) * lu(k,1747) - lu(k,1802) = lu(k,1802) - lu(k,756) * lu(k,1800) - lu(k,1803) = lu(k,1803) - lu(k,757) * lu(k,1800) - lu(k,1805) = lu(k,1805) - lu(k,758) * lu(k,1800) - lu(k,1806) = lu(k,1806) - lu(k,759) * lu(k,1800) - lu(k,1807) = lu(k,1807) - lu(k,760) * lu(k,1800) - lu(k,1808) = lu(k,1808) - lu(k,761) * lu(k,1800) - lu(k,1809) = lu(k,1809) - lu(k,762) * lu(k,1800) - lu(k,1811) = lu(k,1811) - lu(k,763) * lu(k,1800) - lu(k,1812) = lu(k,1812) - lu(k,764) * lu(k,1800) - lu(k,1813) = lu(k,1813) - lu(k,765) * lu(k,1800) - lu(k,1814) = lu(k,1814) - lu(k,766) * lu(k,1800) - lu(k,1815) = lu(k,1815) - lu(k,767) * lu(k,1800) - lu(k,1816) = lu(k,1816) - lu(k,768) * lu(k,1800) - lu(k,1817) = lu(k,1817) - lu(k,769) * lu(k,1800) - lu(k,1818) = lu(k,1818) - lu(k,770) * lu(k,1800) - lu(k,1820) = lu(k,1820) - lu(k,771) * lu(k,1800) - lu(k,1821) = lu(k,1821) - lu(k,772) * lu(k,1800) - lu(k,1822) = lu(k,1822) - lu(k,773) * lu(k,1800) - lu(k,1823) = lu(k,1823) - lu(k,774) * lu(k,1800) - lu(k,1824) = lu(k,1824) - lu(k,775) * lu(k,1800) - lu(k,1825) = lu(k,1825) - lu(k,776) * lu(k,1800) - lu(k,785) = 1._r8 / lu(k,785) - lu(k,786) = lu(k,786) * lu(k,785) - lu(k,787) = lu(k,787) * lu(k,785) - lu(k,788) = lu(k,788) * lu(k,785) - lu(k,789) = lu(k,789) * lu(k,785) - lu(k,790) = lu(k,790) * lu(k,785) - lu(k,791) = lu(k,791) * lu(k,785) - lu(k,792) = lu(k,792) * lu(k,785) - lu(k,793) = lu(k,793) * lu(k,785) - lu(k,794) = lu(k,794) * lu(k,785) - lu(k,795) = lu(k,795) * lu(k,785) - lu(k,796) = lu(k,796) * lu(k,785) - lu(k,797) = lu(k,797) * lu(k,785) - lu(k,798) = lu(k,798) * lu(k,785) - lu(k,799) = lu(k,799) * lu(k,785) - lu(k,800) = lu(k,800) * lu(k,785) - lu(k,801) = lu(k,801) * lu(k,785) - lu(k,802) = lu(k,802) * lu(k,785) - lu(k,803) = lu(k,803) * lu(k,785) - lu(k,804) = lu(k,804) * lu(k,785) - lu(k,805) = lu(k,805) * lu(k,785) - lu(k,806) = lu(k,806) * lu(k,785) - lu(k,807) = lu(k,807) * lu(k,785) - lu(k,808) = lu(k,808) * lu(k,785) - lu(k,809) = lu(k,809) * lu(k,785) - lu(k,829) = lu(k,829) - lu(k,786) * lu(k,828) - lu(k,830) = lu(k,830) - lu(k,787) * lu(k,828) - lu(k,831) = lu(k,831) - lu(k,788) * lu(k,828) - lu(k,832) = lu(k,832) - lu(k,789) * lu(k,828) - lu(k,833) = lu(k,833) - lu(k,790) * lu(k,828) - lu(k,834) = lu(k,834) - lu(k,791) * lu(k,828) - lu(k,835) = lu(k,835) - lu(k,792) * lu(k,828) - lu(k,836) = lu(k,836) - lu(k,793) * lu(k,828) - lu(k,837) = lu(k,837) - lu(k,794) * lu(k,828) - lu(k,838) = lu(k,838) - lu(k,795) * lu(k,828) - lu(k,839) = lu(k,839) - lu(k,796) * lu(k,828) - lu(k,840) = lu(k,840) - lu(k,797) * lu(k,828) - lu(k,841) = lu(k,841) - lu(k,798) * lu(k,828) - lu(k,842) = lu(k,842) - lu(k,799) * lu(k,828) - lu(k,843) = lu(k,843) - lu(k,800) * lu(k,828) - lu(k,844) = lu(k,844) - lu(k,801) * lu(k,828) - lu(k,845) = lu(k,845) - lu(k,802) * lu(k,828) - lu(k,846) = lu(k,846) - lu(k,803) * lu(k,828) - lu(k,847) = lu(k,847) - lu(k,804) * lu(k,828) - lu(k,848) = lu(k,848) - lu(k,805) * lu(k,828) - lu(k,849) = lu(k,849) - lu(k,806) * lu(k,828) - lu(k,850) = lu(k,850) - lu(k,807) * lu(k,828) - lu(k,851) = lu(k,851) - lu(k,808) * lu(k,828) - lu(k,852) = lu(k,852) - lu(k,809) * lu(k,828) - lu(k,877) = lu(k,877) - lu(k,786) * lu(k,876) - lu(k,878) = lu(k,878) - lu(k,787) * lu(k,876) - lu(k,879) = lu(k,879) - lu(k,788) * lu(k,876) - lu(k,880) = lu(k,880) - lu(k,789) * lu(k,876) - lu(k,881) = lu(k,881) - lu(k,790) * lu(k,876) - lu(k,882) = lu(k,882) - lu(k,791) * lu(k,876) - lu(k,883) = lu(k,883) - lu(k,792) * lu(k,876) - lu(k,884) = lu(k,884) - lu(k,793) * lu(k,876) - lu(k,885) = lu(k,885) - lu(k,794) * lu(k,876) - lu(k,886) = lu(k,886) - lu(k,795) * lu(k,876) - lu(k,887) = lu(k,887) - lu(k,796) * lu(k,876) - lu(k,888) = lu(k,888) - lu(k,797) * lu(k,876) - lu(k,889) = lu(k,889) - lu(k,798) * lu(k,876) - lu(k,890) = lu(k,890) - lu(k,799) * lu(k,876) - lu(k,891) = lu(k,891) - lu(k,800) * lu(k,876) - lu(k,892) = lu(k,892) - lu(k,801) * lu(k,876) - lu(k,893) = lu(k,893) - lu(k,802) * lu(k,876) - lu(k,894) = lu(k,894) - lu(k,803) * lu(k,876) - lu(k,895) = lu(k,895) - lu(k,804) * lu(k,876) - lu(k,896) = lu(k,896) - lu(k,805) * lu(k,876) - lu(k,897) = lu(k,897) - lu(k,806) * lu(k,876) - lu(k,898) = lu(k,898) - lu(k,807) * lu(k,876) - lu(k,899) = lu(k,899) - lu(k,808) * lu(k,876) - lu(k,900) = lu(k,900) - lu(k,809) * lu(k,876) - lu(k,920) = lu(k,920) - lu(k,786) * lu(k,919) - lu(k,921) = lu(k,921) - lu(k,787) * lu(k,919) - lu(k,922) = lu(k,922) - lu(k,788) * lu(k,919) - lu(k,923) = lu(k,923) - lu(k,789) * lu(k,919) - lu(k,924) = lu(k,924) - lu(k,790) * lu(k,919) - lu(k,925) = lu(k,925) - lu(k,791) * lu(k,919) - lu(k,926) = lu(k,926) - lu(k,792) * lu(k,919) - lu(k,927) = lu(k,927) - lu(k,793) * lu(k,919) - lu(k,928) = lu(k,928) - lu(k,794) * lu(k,919) - lu(k,929) = lu(k,929) - lu(k,795) * lu(k,919) - lu(k,930) = lu(k,930) - lu(k,796) * lu(k,919) - lu(k,931) = lu(k,931) - lu(k,797) * lu(k,919) - lu(k,932) = lu(k,932) - lu(k,798) * lu(k,919) - lu(k,933) = lu(k,933) - lu(k,799) * lu(k,919) - lu(k,934) = lu(k,934) - lu(k,800) * lu(k,919) - lu(k,935) = lu(k,935) - lu(k,801) * lu(k,919) - lu(k,936) = lu(k,936) - lu(k,802) * lu(k,919) - lu(k,937) = lu(k,937) - lu(k,803) * lu(k,919) - lu(k,938) = lu(k,938) - lu(k,804) * lu(k,919) - lu(k,939) = lu(k,939) - lu(k,805) * lu(k,919) - lu(k,940) = lu(k,940) - lu(k,806) * lu(k,919) - lu(k,941) = lu(k,941) - lu(k,807) * lu(k,919) - lu(k,942) = lu(k,942) - lu(k,808) * lu(k,919) - lu(k,943) = lu(k,943) - lu(k,809) * lu(k,919) - lu(k,976) = lu(k,976) - lu(k,786) * lu(k,975) - lu(k,977) = lu(k,977) - lu(k,787) * lu(k,975) - lu(k,978) = lu(k,978) - lu(k,788) * lu(k,975) - lu(k,979) = lu(k,979) - lu(k,789) * lu(k,975) - lu(k,980) = lu(k,980) - lu(k,790) * lu(k,975) - lu(k,981) = lu(k,981) - lu(k,791) * lu(k,975) - lu(k,982) = lu(k,982) - lu(k,792) * lu(k,975) - lu(k,983) = lu(k,983) - lu(k,793) * lu(k,975) - lu(k,984) = lu(k,984) - lu(k,794) * lu(k,975) - lu(k,985) = lu(k,985) - lu(k,795) * lu(k,975) - lu(k,986) = lu(k,986) - lu(k,796) * lu(k,975) - lu(k,987) = lu(k,987) - lu(k,797) * lu(k,975) - lu(k,988) = lu(k,988) - lu(k,798) * lu(k,975) - lu(k,989) = lu(k,989) - lu(k,799) * lu(k,975) - lu(k,990) = lu(k,990) - lu(k,800) * lu(k,975) - lu(k,991) = lu(k,991) - lu(k,801) * lu(k,975) - lu(k,992) = lu(k,992) - lu(k,802) * lu(k,975) - lu(k,993) = lu(k,993) - lu(k,803) * lu(k,975) - lu(k,994) = lu(k,994) - lu(k,804) * lu(k,975) - lu(k,995) = lu(k,995) - lu(k,805) * lu(k,975) - lu(k,996) = lu(k,996) - lu(k,806) * lu(k,975) - lu(k,997) = lu(k,997) - lu(k,807) * lu(k,975) - lu(k,998) = lu(k,998) - lu(k,808) * lu(k,975) - lu(k,999) = lu(k,999) - lu(k,809) * lu(k,975) - lu(k,1061) = lu(k,1061) - lu(k,786) * lu(k,1060) - lu(k,1062) = lu(k,1062) - lu(k,787) * lu(k,1060) - lu(k,1063) = lu(k,1063) - lu(k,788) * lu(k,1060) - lu(k,1064) = lu(k,1064) - lu(k,789) * lu(k,1060) - lu(k,1065) = lu(k,1065) - lu(k,790) * lu(k,1060) - lu(k,1066) = lu(k,1066) - lu(k,791) * lu(k,1060) - lu(k,1067) = lu(k,1067) - lu(k,792) * lu(k,1060) - lu(k,1068) = lu(k,1068) - lu(k,793) * lu(k,1060) - lu(k,1069) = lu(k,1069) - lu(k,794) * lu(k,1060) - lu(k,1070) = lu(k,1070) - lu(k,795) * lu(k,1060) - lu(k,1071) = lu(k,1071) - lu(k,796) * lu(k,1060) - lu(k,1072) = lu(k,1072) - lu(k,797) * lu(k,1060) - lu(k,1073) = lu(k,1073) - lu(k,798) * lu(k,1060) - lu(k,1074) = lu(k,1074) - lu(k,799) * lu(k,1060) - lu(k,1075) = lu(k,1075) - lu(k,800) * lu(k,1060) - lu(k,1076) = lu(k,1076) - lu(k,801) * lu(k,1060) - lu(k,1077) = lu(k,1077) - lu(k,802) * lu(k,1060) - lu(k,1078) = lu(k,1078) - lu(k,803) * lu(k,1060) - lu(k,1079) = lu(k,1079) - lu(k,804) * lu(k,1060) - lu(k,1080) = lu(k,1080) - lu(k,805) * lu(k,1060) - lu(k,1081) = lu(k,1081) - lu(k,806) * lu(k,1060) - lu(k,1082) = lu(k,1082) - lu(k,807) * lu(k,1060) - lu(k,1083) = lu(k,1083) - lu(k,808) * lu(k,1060) - lu(k,1084) = lu(k,1084) - lu(k,809) * lu(k,1060) - lu(k,1101) = lu(k,1101) - lu(k,786) * lu(k,1100) - lu(k,1102) = lu(k,1102) - lu(k,787) * lu(k,1100) - lu(k,1103) = lu(k,1103) - lu(k,788) * lu(k,1100) - lu(k,1104) = lu(k,1104) - lu(k,789) * lu(k,1100) - lu(k,1105) = lu(k,1105) - lu(k,790) * lu(k,1100) - lu(k,1106) = lu(k,1106) - lu(k,791) * lu(k,1100) - lu(k,1107) = lu(k,1107) - lu(k,792) * lu(k,1100) - lu(k,1108) = lu(k,1108) - lu(k,793) * lu(k,1100) - lu(k,1109) = lu(k,1109) - lu(k,794) * lu(k,1100) - lu(k,1110) = lu(k,1110) - lu(k,795) * lu(k,1100) - lu(k,1111) = lu(k,1111) - lu(k,796) * lu(k,1100) - lu(k,1112) = lu(k,1112) - lu(k,797) * lu(k,1100) - lu(k,1113) = lu(k,1113) - lu(k,798) * lu(k,1100) - lu(k,1114) = lu(k,1114) - lu(k,799) * lu(k,1100) - lu(k,1115) = lu(k,1115) - lu(k,800) * lu(k,1100) - lu(k,1116) = lu(k,1116) - lu(k,801) * lu(k,1100) - lu(k,1117) = lu(k,1117) - lu(k,802) * lu(k,1100) - lu(k,1118) = lu(k,1118) - lu(k,803) * lu(k,1100) - lu(k,1119) = lu(k,1119) - lu(k,804) * lu(k,1100) - lu(k,1120) = lu(k,1120) - lu(k,805) * lu(k,1100) - lu(k,1121) = lu(k,1121) - lu(k,806) * lu(k,1100) - lu(k,1122) = lu(k,1122) - lu(k,807) * lu(k,1100) - lu(k,1123) = lu(k,1123) - lu(k,808) * lu(k,1100) - lu(k,1124) = lu(k,1124) - lu(k,809) * lu(k,1100) - lu(k,1146) = lu(k,1146) - lu(k,786) * lu(k,1145) - lu(k,1147) = lu(k,1147) - lu(k,787) * lu(k,1145) - lu(k,1148) = lu(k,1148) - lu(k,788) * lu(k,1145) - lu(k,1149) = lu(k,1149) - lu(k,789) * lu(k,1145) - lu(k,1150) = lu(k,1150) - lu(k,790) * lu(k,1145) - lu(k,1151) = lu(k,1151) - lu(k,791) * lu(k,1145) - lu(k,1152) = lu(k,1152) - lu(k,792) * lu(k,1145) - lu(k,1153) = lu(k,1153) - lu(k,793) * lu(k,1145) - lu(k,1154) = lu(k,1154) - lu(k,794) * lu(k,1145) - lu(k,1155) = lu(k,1155) - lu(k,795) * lu(k,1145) - lu(k,1156) = lu(k,1156) - lu(k,796) * lu(k,1145) - lu(k,1157) = lu(k,1157) - lu(k,797) * lu(k,1145) - lu(k,1158) = lu(k,1158) - lu(k,798) * lu(k,1145) - lu(k,1159) = lu(k,1159) - lu(k,799) * lu(k,1145) - lu(k,1160) = lu(k,1160) - lu(k,800) * lu(k,1145) - lu(k,1161) = lu(k,1161) - lu(k,801) * lu(k,1145) - lu(k,1162) = lu(k,1162) - lu(k,802) * lu(k,1145) - lu(k,1163) = lu(k,1163) - lu(k,803) * lu(k,1145) - lu(k,1164) = lu(k,1164) - lu(k,804) * lu(k,1145) - lu(k,1165) = lu(k,1165) - lu(k,805) * lu(k,1145) - lu(k,1166) = lu(k,1166) - lu(k,806) * lu(k,1145) - lu(k,1167) = lu(k,1167) - lu(k,807) * lu(k,1145) - lu(k,1168) = lu(k,1168) - lu(k,808) * lu(k,1145) - lu(k,1169) = lu(k,1169) - lu(k,809) * lu(k,1145) - lu(k,1189) = lu(k,1189) - lu(k,786) * lu(k,1188) - lu(k,1190) = lu(k,1190) - lu(k,787) * lu(k,1188) - lu(k,1191) = lu(k,1191) - lu(k,788) * lu(k,1188) - lu(k,1192) = lu(k,1192) - lu(k,789) * lu(k,1188) - lu(k,1193) = lu(k,1193) - lu(k,790) * lu(k,1188) - lu(k,1194) = lu(k,1194) - lu(k,791) * lu(k,1188) - lu(k,1195) = lu(k,1195) - lu(k,792) * lu(k,1188) - lu(k,1196) = lu(k,1196) - lu(k,793) * lu(k,1188) - lu(k,1197) = lu(k,1197) - lu(k,794) * lu(k,1188) - lu(k,1198) = lu(k,1198) - lu(k,795) * lu(k,1188) - lu(k,1199) = lu(k,1199) - lu(k,796) * lu(k,1188) - lu(k,1200) = lu(k,1200) - lu(k,797) * lu(k,1188) - lu(k,1201) = lu(k,1201) - lu(k,798) * lu(k,1188) - lu(k,1202) = lu(k,1202) - lu(k,799) * lu(k,1188) - lu(k,1203) = lu(k,1203) - lu(k,800) * lu(k,1188) - lu(k,1204) = lu(k,1204) - lu(k,801) * lu(k,1188) - lu(k,1205) = lu(k,1205) - lu(k,802) * lu(k,1188) - lu(k,1206) = lu(k,1206) - lu(k,803) * lu(k,1188) - lu(k,1207) = lu(k,1207) - lu(k,804) * lu(k,1188) - lu(k,1208) = lu(k,1208) - lu(k,805) * lu(k,1188) - lu(k,1209) = lu(k,1209) - lu(k,806) * lu(k,1188) - lu(k,1210) = lu(k,1210) - lu(k,807) * lu(k,1188) - lu(k,1211) = lu(k,1211) - lu(k,808) * lu(k,1188) - lu(k,1212) = lu(k,1212) - lu(k,809) * lu(k,1188) - lu(k,1267) = lu(k,1267) - lu(k,786) * lu(k,1266) - lu(k,1268) = lu(k,1268) - lu(k,787) * lu(k,1266) - lu(k,1269) = lu(k,1269) - lu(k,788) * lu(k,1266) - lu(k,1270) = lu(k,1270) - lu(k,789) * lu(k,1266) - lu(k,1271) = lu(k,1271) - lu(k,790) * lu(k,1266) - lu(k,1272) = lu(k,1272) - lu(k,791) * lu(k,1266) - lu(k,1273) = lu(k,1273) - lu(k,792) * lu(k,1266) - lu(k,1274) = lu(k,1274) - lu(k,793) * lu(k,1266) - lu(k,1275) = lu(k,1275) - lu(k,794) * lu(k,1266) - lu(k,1276) = lu(k,1276) - lu(k,795) * lu(k,1266) - lu(k,1277) = lu(k,1277) - lu(k,796) * lu(k,1266) - lu(k,1278) = lu(k,1278) - lu(k,797) * lu(k,1266) - lu(k,1279) = lu(k,1279) - lu(k,798) * lu(k,1266) - lu(k,1280) = lu(k,1280) - lu(k,799) * lu(k,1266) - lu(k,1281) = lu(k,1281) - lu(k,800) * lu(k,1266) - lu(k,1282) = lu(k,1282) - lu(k,801) * lu(k,1266) - lu(k,1283) = lu(k,1283) - lu(k,802) * lu(k,1266) - lu(k,1284) = lu(k,1284) - lu(k,803) * lu(k,1266) - lu(k,1285) = lu(k,1285) - lu(k,804) * lu(k,1266) - lu(k,1286) = lu(k,1286) - lu(k,805) * lu(k,1266) - lu(k,1287) = lu(k,1287) - lu(k,806) * lu(k,1266) - lu(k,1288) = lu(k,1288) - lu(k,807) * lu(k,1266) - lu(k,1289) = lu(k,1289) - lu(k,808) * lu(k,1266) - lu(k,1290) = lu(k,1290) - lu(k,809) * lu(k,1266) - lu(k,1303) = lu(k,1303) - lu(k,786) * lu(k,1302) - lu(k,1304) = lu(k,1304) - lu(k,787) * lu(k,1302) - lu(k,1305) = lu(k,1305) - lu(k,788) * lu(k,1302) - lu(k,1306) = lu(k,1306) - lu(k,789) * lu(k,1302) - lu(k,1307) = lu(k,1307) - lu(k,790) * lu(k,1302) - lu(k,1308) = lu(k,1308) - lu(k,791) * lu(k,1302) - lu(k,1309) = lu(k,1309) - lu(k,792) * lu(k,1302) - lu(k,1310) = lu(k,1310) - lu(k,793) * lu(k,1302) - lu(k,1311) = lu(k,1311) - lu(k,794) * lu(k,1302) - lu(k,1312) = lu(k,1312) - lu(k,795) * lu(k,1302) - lu(k,1313) = lu(k,1313) - lu(k,796) * lu(k,1302) - lu(k,1314) = lu(k,1314) - lu(k,797) * lu(k,1302) - lu(k,1315) = lu(k,1315) - lu(k,798) * lu(k,1302) - lu(k,1316) = lu(k,1316) - lu(k,799) * lu(k,1302) - lu(k,1317) = lu(k,1317) - lu(k,800) * lu(k,1302) - lu(k,1318) = lu(k,1318) - lu(k,801) * lu(k,1302) - lu(k,1319) = lu(k,1319) - lu(k,802) * lu(k,1302) - lu(k,1320) = lu(k,1320) - lu(k,803) * lu(k,1302) - lu(k,1321) = lu(k,1321) - lu(k,804) * lu(k,1302) - lu(k,1322) = lu(k,1322) - lu(k,805) * lu(k,1302) - lu(k,1323) = lu(k,1323) - lu(k,806) * lu(k,1302) - lu(k,1324) = lu(k,1324) - lu(k,807) * lu(k,1302) - lu(k,1325) = lu(k,1325) - lu(k,808) * lu(k,1302) - lu(k,1326) = lu(k,1326) - lu(k,809) * lu(k,1302) - lu(k,1348) = lu(k,1348) - lu(k,786) * lu(k,1347) - lu(k,1349) = lu(k,1349) - lu(k,787) * lu(k,1347) - lu(k,1350) = lu(k,1350) - lu(k,788) * lu(k,1347) - lu(k,1351) = lu(k,1351) - lu(k,789) * lu(k,1347) - lu(k,1352) = lu(k,1352) - lu(k,790) * lu(k,1347) - lu(k,1353) = lu(k,1353) - lu(k,791) * lu(k,1347) - lu(k,1354) = lu(k,1354) - lu(k,792) * lu(k,1347) - lu(k,1355) = lu(k,1355) - lu(k,793) * lu(k,1347) - lu(k,1356) = lu(k,1356) - lu(k,794) * lu(k,1347) - lu(k,1357) = lu(k,1357) - lu(k,795) * lu(k,1347) - lu(k,1358) = lu(k,1358) - lu(k,796) * lu(k,1347) - lu(k,1359) = lu(k,1359) - lu(k,797) * lu(k,1347) - lu(k,1360) = lu(k,1360) - lu(k,798) * lu(k,1347) - lu(k,1361) = lu(k,1361) - lu(k,799) * lu(k,1347) - lu(k,1362) = lu(k,1362) - lu(k,800) * lu(k,1347) - lu(k,1363) = lu(k,1363) - lu(k,801) * lu(k,1347) - lu(k,1364) = lu(k,1364) - lu(k,802) * lu(k,1347) - lu(k,1365) = lu(k,1365) - lu(k,803) * lu(k,1347) - lu(k,1366) = lu(k,1366) - lu(k,804) * lu(k,1347) - lu(k,1367) = lu(k,1367) - lu(k,805) * lu(k,1347) - lu(k,1368) = lu(k,1368) - lu(k,806) * lu(k,1347) - lu(k,1369) = lu(k,1369) - lu(k,807) * lu(k,1347) - lu(k,1370) = lu(k,1370) - lu(k,808) * lu(k,1347) - lu(k,1371) = lu(k,1371) - lu(k,809) * lu(k,1347) - lu(k,1390) = lu(k,1390) - lu(k,786) * lu(k,1389) - lu(k,1391) = lu(k,1391) - lu(k,787) * lu(k,1389) - lu(k,1392) = lu(k,1392) - lu(k,788) * lu(k,1389) - lu(k,1393) = lu(k,1393) - lu(k,789) * lu(k,1389) - lu(k,1394) = lu(k,1394) - lu(k,790) * lu(k,1389) - lu(k,1395) = lu(k,1395) - lu(k,791) * lu(k,1389) - lu(k,1396) = lu(k,1396) - lu(k,792) * lu(k,1389) - lu(k,1397) = lu(k,1397) - lu(k,793) * lu(k,1389) - lu(k,1398) = lu(k,1398) - lu(k,794) * lu(k,1389) - lu(k,1399) = lu(k,1399) - lu(k,795) * lu(k,1389) - lu(k,1400) = lu(k,1400) - lu(k,796) * lu(k,1389) - lu(k,1401) = lu(k,1401) - lu(k,797) * lu(k,1389) - lu(k,1402) = lu(k,1402) - lu(k,798) * lu(k,1389) - lu(k,1403) = lu(k,1403) - lu(k,799) * lu(k,1389) - lu(k,1404) = lu(k,1404) - lu(k,800) * lu(k,1389) - lu(k,1405) = lu(k,1405) - lu(k,801) * lu(k,1389) - lu(k,1406) = lu(k,1406) - lu(k,802) * lu(k,1389) - lu(k,1407) = lu(k,1407) - lu(k,803) * lu(k,1389) - lu(k,1408) = lu(k,1408) - lu(k,804) * lu(k,1389) - lu(k,1409) = lu(k,1409) - lu(k,805) * lu(k,1389) - lu(k,1410) = lu(k,1410) - lu(k,806) * lu(k,1389) - lu(k,1411) = lu(k,1411) - lu(k,807) * lu(k,1389) - lu(k,1412) = lu(k,1412) - lu(k,808) * lu(k,1389) - lu(k,1413) = lu(k,1413) - lu(k,809) * lu(k,1389) - lu(k,1428) = lu(k,1428) - lu(k,786) * lu(k,1427) - lu(k,1429) = lu(k,1429) - lu(k,787) * lu(k,1427) - lu(k,1430) = lu(k,1430) - lu(k,788) * lu(k,1427) - lu(k,1431) = lu(k,1431) - lu(k,789) * lu(k,1427) - lu(k,1432) = lu(k,1432) - lu(k,790) * lu(k,1427) - lu(k,1433) = lu(k,1433) - lu(k,791) * lu(k,1427) - lu(k,1434) = lu(k,1434) - lu(k,792) * lu(k,1427) - lu(k,1435) = lu(k,1435) - lu(k,793) * lu(k,1427) - lu(k,1436) = lu(k,1436) - lu(k,794) * lu(k,1427) - lu(k,1437) = lu(k,1437) - lu(k,795) * lu(k,1427) - lu(k,1438) = lu(k,1438) - lu(k,796) * lu(k,1427) - lu(k,1439) = lu(k,1439) - lu(k,797) * lu(k,1427) - lu(k,1440) = lu(k,1440) - lu(k,798) * lu(k,1427) - lu(k,1441) = lu(k,1441) - lu(k,799) * lu(k,1427) - lu(k,1442) = lu(k,1442) - lu(k,800) * lu(k,1427) - lu(k,1443) = lu(k,1443) - lu(k,801) * lu(k,1427) - lu(k,1444) = lu(k,1444) - lu(k,802) * lu(k,1427) - lu(k,1445) = lu(k,1445) - lu(k,803) * lu(k,1427) - lu(k,1446) = lu(k,1446) - lu(k,804) * lu(k,1427) - lu(k,1447) = lu(k,1447) - lu(k,805) * lu(k,1427) - lu(k,1448) = lu(k,1448) - lu(k,806) * lu(k,1427) - lu(k,1449) = lu(k,1449) - lu(k,807) * lu(k,1427) - lu(k,1450) = lu(k,1450) - lu(k,808) * lu(k,1427) - lu(k,1451) = lu(k,1451) - lu(k,809) * lu(k,1427) - lu(k,1473) = lu(k,1473) - lu(k,786) * lu(k,1472) - lu(k,1474) = lu(k,1474) - lu(k,787) * lu(k,1472) - lu(k,1475) = lu(k,1475) - lu(k,788) * lu(k,1472) - lu(k,1476) = lu(k,1476) - lu(k,789) * lu(k,1472) - lu(k,1477) = lu(k,1477) - lu(k,790) * lu(k,1472) - lu(k,1478) = lu(k,1478) - lu(k,791) * lu(k,1472) - lu(k,1479) = lu(k,1479) - lu(k,792) * lu(k,1472) - lu(k,1480) = lu(k,1480) - lu(k,793) * lu(k,1472) - lu(k,1481) = lu(k,1481) - lu(k,794) * lu(k,1472) - lu(k,1482) = lu(k,1482) - lu(k,795) * lu(k,1472) - lu(k,1483) = lu(k,1483) - lu(k,796) * lu(k,1472) - lu(k,1484) = lu(k,1484) - lu(k,797) * lu(k,1472) - lu(k,1485) = lu(k,1485) - lu(k,798) * lu(k,1472) - lu(k,1486) = lu(k,1486) - lu(k,799) * lu(k,1472) - lu(k,1487) = lu(k,1487) - lu(k,800) * lu(k,1472) - lu(k,1488) = lu(k,1488) - lu(k,801) * lu(k,1472) - lu(k,1489) = lu(k,1489) - lu(k,802) * lu(k,1472) - lu(k,1490) = lu(k,1490) - lu(k,803) * lu(k,1472) - lu(k,1491) = lu(k,1491) - lu(k,804) * lu(k,1472) - lu(k,1492) = lu(k,1492) - lu(k,805) * lu(k,1472) - lu(k,1493) = lu(k,1493) - lu(k,806) * lu(k,1472) - lu(k,1494) = lu(k,1494) - lu(k,807) * lu(k,1472) - lu(k,1495) = lu(k,1495) - lu(k,808) * lu(k,1472) - lu(k,1496) = lu(k,1496) - lu(k,809) * lu(k,1472) - lu(k,1516) = lu(k,1516) - lu(k,786) * lu(k,1515) - lu(k,1517) = lu(k,1517) - lu(k,787) * lu(k,1515) - lu(k,1518) = lu(k,1518) - lu(k,788) * lu(k,1515) - lu(k,1519) = lu(k,1519) - lu(k,789) * lu(k,1515) - lu(k,1520) = lu(k,1520) - lu(k,790) * lu(k,1515) - lu(k,1521) = lu(k,1521) - lu(k,791) * lu(k,1515) - lu(k,1522) = lu(k,1522) - lu(k,792) * lu(k,1515) - lu(k,1523) = lu(k,1523) - lu(k,793) * lu(k,1515) - lu(k,1524) = lu(k,1524) - lu(k,794) * lu(k,1515) - lu(k,1525) = lu(k,1525) - lu(k,795) * lu(k,1515) - lu(k,1526) = lu(k,1526) - lu(k,796) * lu(k,1515) - lu(k,1527) = lu(k,1527) - lu(k,797) * lu(k,1515) - lu(k,1528) = lu(k,1528) - lu(k,798) * lu(k,1515) - lu(k,1529) = lu(k,1529) - lu(k,799) * lu(k,1515) - lu(k,1530) = lu(k,1530) - lu(k,800) * lu(k,1515) - lu(k,1531) = lu(k,1531) - lu(k,801) * lu(k,1515) - lu(k,1532) = lu(k,1532) - lu(k,802) * lu(k,1515) - lu(k,1533) = lu(k,1533) - lu(k,803) * lu(k,1515) - lu(k,1534) = lu(k,1534) - lu(k,804) * lu(k,1515) - lu(k,1535) = lu(k,1535) - lu(k,805) * lu(k,1515) - lu(k,1536) = lu(k,1536) - lu(k,806) * lu(k,1515) - lu(k,1537) = lu(k,1537) - lu(k,807) * lu(k,1515) - lu(k,1538) = lu(k,1538) - lu(k,808) * lu(k,1515) - lu(k,1539) = lu(k,1539) - lu(k,809) * lu(k,1515) - lu(k,1559) = lu(k,1559) - lu(k,786) * lu(k,1558) - lu(k,1560) = lu(k,1560) - lu(k,787) * lu(k,1558) - lu(k,1561) = lu(k,1561) - lu(k,788) * lu(k,1558) - lu(k,1562) = lu(k,1562) - lu(k,789) * lu(k,1558) - lu(k,1563) = lu(k,1563) - lu(k,790) * lu(k,1558) - lu(k,1564) = lu(k,1564) - lu(k,791) * lu(k,1558) - lu(k,1565) = lu(k,1565) - lu(k,792) * lu(k,1558) - lu(k,1566) = lu(k,1566) - lu(k,793) * lu(k,1558) - lu(k,1567) = lu(k,1567) - lu(k,794) * lu(k,1558) - lu(k,1568) = lu(k,1568) - lu(k,795) * lu(k,1558) - lu(k,1569) = lu(k,1569) - lu(k,796) * lu(k,1558) - lu(k,1570) = lu(k,1570) - lu(k,797) * lu(k,1558) - lu(k,1571) = lu(k,1571) - lu(k,798) * lu(k,1558) - lu(k,1572) = lu(k,1572) - lu(k,799) * lu(k,1558) - lu(k,1573) = lu(k,1573) - lu(k,800) * lu(k,1558) - lu(k,1574) = lu(k,1574) - lu(k,801) * lu(k,1558) - lu(k,1575) = lu(k,1575) - lu(k,802) * lu(k,1558) - lu(k,1576) = lu(k,1576) - lu(k,803) * lu(k,1558) - lu(k,1577) = lu(k,1577) - lu(k,804) * lu(k,1558) - lu(k,1578) = lu(k,1578) - lu(k,805) * lu(k,1558) - lu(k,1579) = lu(k,1579) - lu(k,806) * lu(k,1558) - lu(k,1580) = lu(k,1580) - lu(k,807) * lu(k,1558) - lu(k,1581) = lu(k,1581) - lu(k,808) * lu(k,1558) - lu(k,1582) = lu(k,1582) - lu(k,809) * lu(k,1558) - lu(k,1592) = lu(k,1592) - lu(k,786) * lu(k,1591) - lu(k,1593) = lu(k,1593) - lu(k,787) * lu(k,1591) - lu(k,1594) = lu(k,1594) - lu(k,788) * lu(k,1591) - lu(k,1595) = lu(k,1595) - lu(k,789) * lu(k,1591) - lu(k,1596) = lu(k,1596) - lu(k,790) * lu(k,1591) - lu(k,1597) = lu(k,1597) - lu(k,791) * lu(k,1591) - lu(k,1598) = lu(k,1598) - lu(k,792) * lu(k,1591) - lu(k,1599) = lu(k,1599) - lu(k,793) * lu(k,1591) - lu(k,1600) = lu(k,1600) - lu(k,794) * lu(k,1591) - lu(k,1601) = lu(k,1601) - lu(k,795) * lu(k,1591) - lu(k,1602) = lu(k,1602) - lu(k,796) * lu(k,1591) - lu(k,1603) = lu(k,1603) - lu(k,797) * lu(k,1591) - lu(k,1604) = lu(k,1604) - lu(k,798) * lu(k,1591) - lu(k,1605) = lu(k,1605) - lu(k,799) * lu(k,1591) - lu(k,1606) = lu(k,1606) - lu(k,800) * lu(k,1591) - lu(k,1607) = lu(k,1607) - lu(k,801) * lu(k,1591) - lu(k,1608) = lu(k,1608) - lu(k,802) * lu(k,1591) - lu(k,1609) = lu(k,1609) - lu(k,803) * lu(k,1591) - lu(k,1610) = lu(k,1610) - lu(k,804) * lu(k,1591) - lu(k,1611) = lu(k,1611) - lu(k,805) * lu(k,1591) - lu(k,1612) = lu(k,1612) - lu(k,806) * lu(k,1591) - lu(k,1613) = lu(k,1613) - lu(k,807) * lu(k,1591) - lu(k,1614) = lu(k,1614) - lu(k,808) * lu(k,1591) - lu(k,1615) = lu(k,1615) - lu(k,809) * lu(k,1591) - lu(k,1628) = lu(k,1628) - lu(k,786) * lu(k,1627) - lu(k,1629) = lu(k,1629) - lu(k,787) * lu(k,1627) - lu(k,1630) = lu(k,1630) - lu(k,788) * lu(k,1627) - lu(k,1631) = lu(k,1631) - lu(k,789) * lu(k,1627) - lu(k,1632) = lu(k,1632) - lu(k,790) * lu(k,1627) - lu(k,1633) = lu(k,1633) - lu(k,791) * lu(k,1627) - lu(k,1634) = lu(k,1634) - lu(k,792) * lu(k,1627) - lu(k,1635) = lu(k,1635) - lu(k,793) * lu(k,1627) - lu(k,1636) = lu(k,1636) - lu(k,794) * lu(k,1627) - lu(k,1637) = lu(k,1637) - lu(k,795) * lu(k,1627) - lu(k,1638) = lu(k,1638) - lu(k,796) * lu(k,1627) - lu(k,1639) = lu(k,1639) - lu(k,797) * lu(k,1627) - lu(k,1640) = lu(k,1640) - lu(k,798) * lu(k,1627) - lu(k,1641) = lu(k,1641) - lu(k,799) * lu(k,1627) - lu(k,1642) = lu(k,1642) - lu(k,800) * lu(k,1627) - lu(k,1643) = lu(k,1643) - lu(k,801) * lu(k,1627) - lu(k,1644) = lu(k,1644) - lu(k,802) * lu(k,1627) - lu(k,1645) = lu(k,1645) - lu(k,803) * lu(k,1627) - lu(k,1646) = lu(k,1646) - lu(k,804) * lu(k,1627) - lu(k,1647) = lu(k,1647) - lu(k,805) * lu(k,1627) - lu(k,1648) = lu(k,1648) - lu(k,806) * lu(k,1627) - lu(k,1649) = lu(k,1649) - lu(k,807) * lu(k,1627) - lu(k,1650) = lu(k,1650) - lu(k,808) * lu(k,1627) - lu(k,1651) = lu(k,1651) - lu(k,809) * lu(k,1627) - lu(k,1671) = lu(k,1671) - lu(k,786) * lu(k,1670) - lu(k,1672) = lu(k,1672) - lu(k,787) * lu(k,1670) - lu(k,1673) = lu(k,1673) - lu(k,788) * lu(k,1670) - lu(k,1674) = lu(k,1674) - lu(k,789) * lu(k,1670) - lu(k,1675) = lu(k,1675) - lu(k,790) * lu(k,1670) - lu(k,1676) = lu(k,1676) - lu(k,791) * lu(k,1670) - lu(k,1677) = lu(k,1677) - lu(k,792) * lu(k,1670) - lu(k,1678) = lu(k,1678) - lu(k,793) * lu(k,1670) - lu(k,1679) = lu(k,1679) - lu(k,794) * lu(k,1670) - lu(k,1680) = lu(k,1680) - lu(k,795) * lu(k,1670) - lu(k,1681) = lu(k,1681) - lu(k,796) * lu(k,1670) - lu(k,1682) = lu(k,1682) - lu(k,797) * lu(k,1670) - lu(k,1683) = lu(k,1683) - lu(k,798) * lu(k,1670) - lu(k,1684) = lu(k,1684) - lu(k,799) * lu(k,1670) - lu(k,1685) = lu(k,1685) - lu(k,800) * lu(k,1670) - lu(k,1686) = lu(k,1686) - lu(k,801) * lu(k,1670) - lu(k,1687) = lu(k,1687) - lu(k,802) * lu(k,1670) - lu(k,1688) = lu(k,1688) - lu(k,803) * lu(k,1670) - lu(k,1689) = lu(k,1689) - lu(k,804) * lu(k,1670) - lu(k,1690) = lu(k,1690) - lu(k,805) * lu(k,1670) - lu(k,1691) = lu(k,1691) - lu(k,806) * lu(k,1670) - lu(k,1692) = lu(k,1692) - lu(k,807) * lu(k,1670) - lu(k,1693) = lu(k,1693) - lu(k,808) * lu(k,1670) - lu(k,1694) = lu(k,1694) - lu(k,809) * lu(k,1670) - lu(k,1707) = lu(k,1707) - lu(k,786) * lu(k,1706) - lu(k,1708) = lu(k,1708) - lu(k,787) * lu(k,1706) - lu(k,1709) = lu(k,1709) - lu(k,788) * lu(k,1706) - lu(k,1710) = lu(k,1710) - lu(k,789) * lu(k,1706) - lu(k,1711) = lu(k,1711) - lu(k,790) * lu(k,1706) - lu(k,1712) = lu(k,1712) - lu(k,791) * lu(k,1706) - lu(k,1713) = lu(k,1713) - lu(k,792) * lu(k,1706) - lu(k,1714) = lu(k,1714) - lu(k,793) * lu(k,1706) - lu(k,1715) = lu(k,1715) - lu(k,794) * lu(k,1706) - lu(k,1716) = lu(k,1716) - lu(k,795) * lu(k,1706) - lu(k,1717) = lu(k,1717) - lu(k,796) * lu(k,1706) - lu(k,1718) = lu(k,1718) - lu(k,797) * lu(k,1706) - lu(k,1719) = lu(k,1719) - lu(k,798) * lu(k,1706) - lu(k,1720) = lu(k,1720) - lu(k,799) * lu(k,1706) - lu(k,1721) = lu(k,1721) - lu(k,800) * lu(k,1706) - lu(k,1722) = lu(k,1722) - lu(k,801) * lu(k,1706) - lu(k,1723) = lu(k,1723) - lu(k,802) * lu(k,1706) - lu(k,1724) = lu(k,1724) - lu(k,803) * lu(k,1706) - lu(k,1725) = lu(k,1725) - lu(k,804) * lu(k,1706) - lu(k,1726) = lu(k,1726) - lu(k,805) * lu(k,1706) - lu(k,1727) = lu(k,1727) - lu(k,806) * lu(k,1706) - lu(k,1728) = lu(k,1728) - lu(k,807) * lu(k,1706) - lu(k,1729) = lu(k,1729) - lu(k,808) * lu(k,1706) - lu(k,1730) = lu(k,1730) - lu(k,809) * lu(k,1706) - lu(k,1749) = lu(k,1749) - lu(k,786) * lu(k,1748) - lu(k,1750) = lu(k,1750) - lu(k,787) * lu(k,1748) - lu(k,1751) = lu(k,1751) - lu(k,788) * lu(k,1748) - lu(k,1752) = lu(k,1752) - lu(k,789) * lu(k,1748) - lu(k,1753) = lu(k,1753) - lu(k,790) * lu(k,1748) - lu(k,1754) = lu(k,1754) - lu(k,791) * lu(k,1748) - lu(k,1755) = lu(k,1755) - lu(k,792) * lu(k,1748) - lu(k,1756) = lu(k,1756) - lu(k,793) * lu(k,1748) - lu(k,1757) = lu(k,1757) - lu(k,794) * lu(k,1748) - lu(k,1758) = lu(k,1758) - lu(k,795) * lu(k,1748) - lu(k,1759) = lu(k,1759) - lu(k,796) * lu(k,1748) - lu(k,1760) = lu(k,1760) - lu(k,797) * lu(k,1748) - lu(k,1761) = lu(k,1761) - lu(k,798) * lu(k,1748) - lu(k,1762) = lu(k,1762) - lu(k,799) * lu(k,1748) - lu(k,1763) = lu(k,1763) - lu(k,800) * lu(k,1748) - lu(k,1764) = lu(k,1764) - lu(k,801) * lu(k,1748) - lu(k,1765) = lu(k,1765) - lu(k,802) * lu(k,1748) - lu(k,1766) = lu(k,1766) - lu(k,803) * lu(k,1748) - lu(k,1767) = lu(k,1767) - lu(k,804) * lu(k,1748) - lu(k,1768) = lu(k,1768) - lu(k,805) * lu(k,1748) - lu(k,1769) = lu(k,1769) - lu(k,806) * lu(k,1748) - lu(k,1770) = lu(k,1770) - lu(k,807) * lu(k,1748) - lu(k,1771) = lu(k,1771) - lu(k,808) * lu(k,1748) - lu(k,1772) = lu(k,1772) - lu(k,809) * lu(k,1748) - lu(k,1802) = lu(k,1802) - lu(k,786) * lu(k,1801) - lu(k,1803) = lu(k,1803) - lu(k,787) * lu(k,1801) - lu(k,1804) = lu(k,1804) - lu(k,788) * lu(k,1801) - lu(k,1805) = lu(k,1805) - lu(k,789) * lu(k,1801) - lu(k,1806) = lu(k,1806) - lu(k,790) * lu(k,1801) - lu(k,1807) = lu(k,1807) - lu(k,791) * lu(k,1801) - lu(k,1808) = lu(k,1808) - lu(k,792) * lu(k,1801) - lu(k,1809) = lu(k,1809) - lu(k,793) * lu(k,1801) - lu(k,1810) = lu(k,1810) - lu(k,794) * lu(k,1801) - lu(k,1811) = lu(k,1811) - lu(k,795) * lu(k,1801) - lu(k,1812) = lu(k,1812) - lu(k,796) * lu(k,1801) - lu(k,1813) = lu(k,1813) - lu(k,797) * lu(k,1801) - lu(k,1814) = lu(k,1814) - lu(k,798) * lu(k,1801) - lu(k,1815) = lu(k,1815) - lu(k,799) * lu(k,1801) - lu(k,1816) = lu(k,1816) - lu(k,800) * lu(k,1801) - lu(k,1817) = lu(k,1817) - lu(k,801) * lu(k,1801) - lu(k,1818) = lu(k,1818) - lu(k,802) * lu(k,1801) - lu(k,1819) = lu(k,1819) - lu(k,803) * lu(k,1801) - lu(k,1820) = lu(k,1820) - lu(k,804) * lu(k,1801) - lu(k,1821) = lu(k,1821) - lu(k,805) * lu(k,1801) - lu(k,1822) = lu(k,1822) - lu(k,806) * lu(k,1801) - lu(k,1823) = lu(k,1823) - lu(k,807) * lu(k,1801) - lu(k,1824) = lu(k,1824) - lu(k,808) * lu(k,1801) - lu(k,1825) = lu(k,1825) - lu(k,809) * lu(k,1801) - lu(k,829) = 1._r8 / lu(k,829) - lu(k,830) = lu(k,830) * lu(k,829) - lu(k,831) = lu(k,831) * lu(k,829) - lu(k,832) = lu(k,832) * lu(k,829) - lu(k,833) = lu(k,833) * lu(k,829) - lu(k,834) = lu(k,834) * lu(k,829) - lu(k,835) = lu(k,835) * lu(k,829) - lu(k,836) = lu(k,836) * lu(k,829) - lu(k,837) = lu(k,837) * lu(k,829) - lu(k,838) = lu(k,838) * lu(k,829) - lu(k,839) = lu(k,839) * lu(k,829) - lu(k,840) = lu(k,840) * lu(k,829) - lu(k,841) = lu(k,841) * lu(k,829) - lu(k,842) = lu(k,842) * lu(k,829) - lu(k,843) = lu(k,843) * lu(k,829) - lu(k,844) = lu(k,844) * lu(k,829) - lu(k,845) = lu(k,845) * lu(k,829) - lu(k,846) = lu(k,846) * lu(k,829) - lu(k,847) = lu(k,847) * lu(k,829) - lu(k,848) = lu(k,848) * lu(k,829) - lu(k,849) = lu(k,849) * lu(k,829) - lu(k,850) = lu(k,850) * lu(k,829) - lu(k,851) = lu(k,851) * lu(k,829) - lu(k,852) = lu(k,852) * lu(k,829) - lu(k,878) = lu(k,878) - lu(k,830) * lu(k,877) - lu(k,879) = lu(k,879) - lu(k,831) * lu(k,877) - lu(k,880) = lu(k,880) - lu(k,832) * lu(k,877) - lu(k,881) = lu(k,881) - lu(k,833) * lu(k,877) - lu(k,882) = lu(k,882) - lu(k,834) * lu(k,877) - lu(k,883) = lu(k,883) - lu(k,835) * lu(k,877) - lu(k,884) = lu(k,884) - lu(k,836) * lu(k,877) - lu(k,885) = lu(k,885) - lu(k,837) * lu(k,877) - lu(k,886) = lu(k,886) - lu(k,838) * lu(k,877) - lu(k,887) = lu(k,887) - lu(k,839) * lu(k,877) - lu(k,888) = lu(k,888) - lu(k,840) * lu(k,877) - lu(k,889) = lu(k,889) - lu(k,841) * lu(k,877) - lu(k,890) = lu(k,890) - lu(k,842) * lu(k,877) - lu(k,891) = lu(k,891) - lu(k,843) * lu(k,877) - lu(k,892) = lu(k,892) - lu(k,844) * lu(k,877) - lu(k,893) = lu(k,893) - lu(k,845) * lu(k,877) - lu(k,894) = lu(k,894) - lu(k,846) * lu(k,877) - lu(k,895) = lu(k,895) - lu(k,847) * lu(k,877) - lu(k,896) = lu(k,896) - lu(k,848) * lu(k,877) - lu(k,897) = lu(k,897) - lu(k,849) * lu(k,877) - lu(k,898) = lu(k,898) - lu(k,850) * lu(k,877) - lu(k,899) = lu(k,899) - lu(k,851) * lu(k,877) - lu(k,900) = lu(k,900) - lu(k,852) * lu(k,877) - lu(k,921) = lu(k,921) - lu(k,830) * lu(k,920) - lu(k,922) = lu(k,922) - lu(k,831) * lu(k,920) - lu(k,923) = lu(k,923) - lu(k,832) * lu(k,920) - lu(k,924) = lu(k,924) - lu(k,833) * lu(k,920) - lu(k,925) = lu(k,925) - lu(k,834) * lu(k,920) - lu(k,926) = lu(k,926) - lu(k,835) * lu(k,920) - lu(k,927) = lu(k,927) - lu(k,836) * lu(k,920) - lu(k,928) = lu(k,928) - lu(k,837) * lu(k,920) - lu(k,929) = lu(k,929) - lu(k,838) * lu(k,920) - lu(k,930) = lu(k,930) - lu(k,839) * lu(k,920) - lu(k,931) = lu(k,931) - lu(k,840) * lu(k,920) - lu(k,932) = lu(k,932) - lu(k,841) * lu(k,920) - lu(k,933) = lu(k,933) - lu(k,842) * lu(k,920) - lu(k,934) = lu(k,934) - lu(k,843) * lu(k,920) - lu(k,935) = lu(k,935) - lu(k,844) * lu(k,920) - lu(k,936) = lu(k,936) - lu(k,845) * lu(k,920) - lu(k,937) = lu(k,937) - lu(k,846) * lu(k,920) - lu(k,938) = lu(k,938) - lu(k,847) * lu(k,920) - lu(k,939) = lu(k,939) - lu(k,848) * lu(k,920) - lu(k,940) = lu(k,940) - lu(k,849) * lu(k,920) - lu(k,941) = lu(k,941) - lu(k,850) * lu(k,920) - lu(k,942) = lu(k,942) - lu(k,851) * lu(k,920) - lu(k,943) = lu(k,943) - lu(k,852) * lu(k,920) - lu(k,977) = lu(k,977) - lu(k,830) * lu(k,976) - lu(k,978) = lu(k,978) - lu(k,831) * lu(k,976) - lu(k,979) = lu(k,979) - lu(k,832) * lu(k,976) - lu(k,980) = lu(k,980) - lu(k,833) * lu(k,976) - lu(k,981) = lu(k,981) - lu(k,834) * lu(k,976) - lu(k,982) = lu(k,982) - lu(k,835) * lu(k,976) - lu(k,983) = lu(k,983) - lu(k,836) * lu(k,976) - lu(k,984) = lu(k,984) - lu(k,837) * lu(k,976) - lu(k,985) = lu(k,985) - lu(k,838) * lu(k,976) - lu(k,986) = lu(k,986) - lu(k,839) * lu(k,976) - lu(k,987) = lu(k,987) - lu(k,840) * lu(k,976) - lu(k,988) = lu(k,988) - lu(k,841) * lu(k,976) - lu(k,989) = lu(k,989) - lu(k,842) * lu(k,976) - lu(k,990) = lu(k,990) - lu(k,843) * lu(k,976) - lu(k,991) = lu(k,991) - lu(k,844) * lu(k,976) - lu(k,992) = lu(k,992) - lu(k,845) * lu(k,976) - lu(k,993) = lu(k,993) - lu(k,846) * lu(k,976) - lu(k,994) = lu(k,994) - lu(k,847) * lu(k,976) - lu(k,995) = lu(k,995) - lu(k,848) * lu(k,976) - lu(k,996) = lu(k,996) - lu(k,849) * lu(k,976) - lu(k,997) = lu(k,997) - lu(k,850) * lu(k,976) - lu(k,998) = lu(k,998) - lu(k,851) * lu(k,976) - lu(k,999) = lu(k,999) - lu(k,852) * lu(k,976) - lu(k,1020) = lu(k,1020) - lu(k,830) * lu(k,1019) - lu(k,1021) = lu(k,1021) - lu(k,831) * lu(k,1019) - lu(k,1022) = lu(k,1022) - lu(k,832) * lu(k,1019) - lu(k,1023) = lu(k,1023) - lu(k,833) * lu(k,1019) - lu(k,1024) = lu(k,1024) - lu(k,834) * lu(k,1019) - lu(k,1025) = lu(k,1025) - lu(k,835) * lu(k,1019) - lu(k,1026) = lu(k,1026) - lu(k,836) * lu(k,1019) - lu(k,1027) = lu(k,1027) - lu(k,837) * lu(k,1019) - lu(k,1028) = lu(k,1028) - lu(k,838) * lu(k,1019) - lu(k,1029) = lu(k,1029) - lu(k,839) * lu(k,1019) - lu(k,1030) = lu(k,1030) - lu(k,840) * lu(k,1019) - lu(k,1031) = lu(k,1031) - lu(k,841) * lu(k,1019) - lu(k,1032) = lu(k,1032) - lu(k,842) * lu(k,1019) - lu(k,1033) = lu(k,1033) - lu(k,843) * lu(k,1019) - lu(k,1034) = lu(k,1034) - lu(k,844) * lu(k,1019) - lu(k,1035) = lu(k,1035) - lu(k,845) * lu(k,1019) - lu(k,1036) = lu(k,1036) - lu(k,846) * lu(k,1019) - lu(k,1037) = lu(k,1037) - lu(k,847) * lu(k,1019) - lu(k,1038) = lu(k,1038) - lu(k,848) * lu(k,1019) - lu(k,1039) = lu(k,1039) - lu(k,849) * lu(k,1019) - lu(k,1040) = lu(k,1040) - lu(k,850) * lu(k,1019) - lu(k,1041) = lu(k,1041) - lu(k,851) * lu(k,1019) - lu(k,1042) = lu(k,1042) - lu(k,852) * lu(k,1019) - lu(k,1062) = lu(k,1062) - lu(k,830) * lu(k,1061) - lu(k,1063) = lu(k,1063) - lu(k,831) * lu(k,1061) - lu(k,1064) = lu(k,1064) - lu(k,832) * lu(k,1061) - lu(k,1065) = lu(k,1065) - lu(k,833) * lu(k,1061) - lu(k,1066) = lu(k,1066) - lu(k,834) * lu(k,1061) - lu(k,1067) = lu(k,1067) - lu(k,835) * lu(k,1061) - lu(k,1068) = lu(k,1068) - lu(k,836) * lu(k,1061) - lu(k,1069) = lu(k,1069) - lu(k,837) * lu(k,1061) - lu(k,1070) = lu(k,1070) - lu(k,838) * lu(k,1061) - lu(k,1071) = lu(k,1071) - lu(k,839) * lu(k,1061) - lu(k,1072) = lu(k,1072) - lu(k,840) * lu(k,1061) - lu(k,1073) = lu(k,1073) - lu(k,841) * lu(k,1061) - lu(k,1074) = lu(k,1074) - lu(k,842) * lu(k,1061) - lu(k,1075) = lu(k,1075) - lu(k,843) * lu(k,1061) - lu(k,1076) = lu(k,1076) - lu(k,844) * lu(k,1061) - lu(k,1077) = lu(k,1077) - lu(k,845) * lu(k,1061) - lu(k,1078) = lu(k,1078) - lu(k,846) * lu(k,1061) - lu(k,1079) = lu(k,1079) - lu(k,847) * lu(k,1061) - lu(k,1080) = lu(k,1080) - lu(k,848) * lu(k,1061) - lu(k,1081) = lu(k,1081) - lu(k,849) * lu(k,1061) - lu(k,1082) = lu(k,1082) - lu(k,850) * lu(k,1061) - lu(k,1083) = lu(k,1083) - lu(k,851) * lu(k,1061) - lu(k,1084) = lu(k,1084) - lu(k,852) * lu(k,1061) - lu(k,1102) = lu(k,1102) - lu(k,830) * lu(k,1101) - lu(k,1103) = lu(k,1103) - lu(k,831) * lu(k,1101) - lu(k,1104) = lu(k,1104) - lu(k,832) * lu(k,1101) - lu(k,1105) = lu(k,1105) - lu(k,833) * lu(k,1101) - lu(k,1106) = lu(k,1106) - lu(k,834) * lu(k,1101) - lu(k,1107) = lu(k,1107) - lu(k,835) * lu(k,1101) - lu(k,1108) = lu(k,1108) - lu(k,836) * lu(k,1101) - lu(k,1109) = lu(k,1109) - lu(k,837) * lu(k,1101) - lu(k,1110) = lu(k,1110) - lu(k,838) * lu(k,1101) - lu(k,1111) = lu(k,1111) - lu(k,839) * lu(k,1101) - lu(k,1112) = lu(k,1112) - lu(k,840) * lu(k,1101) - lu(k,1113) = lu(k,1113) - lu(k,841) * lu(k,1101) - lu(k,1114) = lu(k,1114) - lu(k,842) * lu(k,1101) - lu(k,1115) = lu(k,1115) - lu(k,843) * lu(k,1101) - lu(k,1116) = lu(k,1116) - lu(k,844) * lu(k,1101) - lu(k,1117) = lu(k,1117) - lu(k,845) * lu(k,1101) - lu(k,1118) = lu(k,1118) - lu(k,846) * lu(k,1101) - lu(k,1119) = lu(k,1119) - lu(k,847) * lu(k,1101) - lu(k,1120) = lu(k,1120) - lu(k,848) * lu(k,1101) - lu(k,1121) = lu(k,1121) - lu(k,849) * lu(k,1101) - lu(k,1122) = lu(k,1122) - lu(k,850) * lu(k,1101) - lu(k,1123) = lu(k,1123) - lu(k,851) * lu(k,1101) - lu(k,1124) = lu(k,1124) - lu(k,852) * lu(k,1101) - lu(k,1147) = lu(k,1147) - lu(k,830) * lu(k,1146) - lu(k,1148) = lu(k,1148) - lu(k,831) * lu(k,1146) - lu(k,1149) = lu(k,1149) - lu(k,832) * lu(k,1146) - lu(k,1150) = lu(k,1150) - lu(k,833) * lu(k,1146) - lu(k,1151) = lu(k,1151) - lu(k,834) * lu(k,1146) - lu(k,1152) = lu(k,1152) - lu(k,835) * lu(k,1146) - lu(k,1153) = lu(k,1153) - lu(k,836) * lu(k,1146) - lu(k,1154) = lu(k,1154) - lu(k,837) * lu(k,1146) - lu(k,1155) = lu(k,1155) - lu(k,838) * lu(k,1146) - lu(k,1156) = lu(k,1156) - lu(k,839) * lu(k,1146) - lu(k,1157) = lu(k,1157) - lu(k,840) * lu(k,1146) - lu(k,1158) = lu(k,1158) - lu(k,841) * lu(k,1146) - lu(k,1159) = lu(k,1159) - lu(k,842) * lu(k,1146) - lu(k,1160) = lu(k,1160) - lu(k,843) * lu(k,1146) - lu(k,1161) = lu(k,1161) - lu(k,844) * lu(k,1146) - lu(k,1162) = lu(k,1162) - lu(k,845) * lu(k,1146) - lu(k,1163) = lu(k,1163) - lu(k,846) * lu(k,1146) - lu(k,1164) = lu(k,1164) - lu(k,847) * lu(k,1146) - lu(k,1165) = lu(k,1165) - lu(k,848) * lu(k,1146) - lu(k,1166) = lu(k,1166) - lu(k,849) * lu(k,1146) - lu(k,1167) = lu(k,1167) - lu(k,850) * lu(k,1146) - lu(k,1168) = lu(k,1168) - lu(k,851) * lu(k,1146) - lu(k,1169) = lu(k,1169) - lu(k,852) * lu(k,1146) - lu(k,1190) = lu(k,1190) - lu(k,830) * lu(k,1189) - lu(k,1191) = lu(k,1191) - lu(k,831) * lu(k,1189) - lu(k,1192) = lu(k,1192) - lu(k,832) * lu(k,1189) - lu(k,1193) = lu(k,1193) - lu(k,833) * lu(k,1189) - lu(k,1194) = lu(k,1194) - lu(k,834) * lu(k,1189) - lu(k,1195) = lu(k,1195) - lu(k,835) * lu(k,1189) - lu(k,1196) = lu(k,1196) - lu(k,836) * lu(k,1189) - lu(k,1197) = lu(k,1197) - lu(k,837) * lu(k,1189) - lu(k,1198) = lu(k,1198) - lu(k,838) * lu(k,1189) - lu(k,1199) = lu(k,1199) - lu(k,839) * lu(k,1189) - lu(k,1200) = lu(k,1200) - lu(k,840) * lu(k,1189) - lu(k,1201) = lu(k,1201) - lu(k,841) * lu(k,1189) - lu(k,1202) = lu(k,1202) - lu(k,842) * lu(k,1189) - lu(k,1203) = lu(k,1203) - lu(k,843) * lu(k,1189) - lu(k,1204) = lu(k,1204) - lu(k,844) * lu(k,1189) - lu(k,1205) = lu(k,1205) - lu(k,845) * lu(k,1189) - lu(k,1206) = lu(k,1206) - lu(k,846) * lu(k,1189) - lu(k,1207) = lu(k,1207) - lu(k,847) * lu(k,1189) - lu(k,1208) = lu(k,1208) - lu(k,848) * lu(k,1189) - lu(k,1209) = lu(k,1209) - lu(k,849) * lu(k,1189) - lu(k,1210) = lu(k,1210) - lu(k,850) * lu(k,1189) - lu(k,1211) = lu(k,1211) - lu(k,851) * lu(k,1189) - lu(k,1212) = lu(k,1212) - lu(k,852) * lu(k,1189) - lu(k,1225) = lu(k,1225) - lu(k,830) * lu(k,1224) - lu(k,1226) = lu(k,1226) - lu(k,831) * lu(k,1224) - lu(k,1227) = lu(k,1227) - lu(k,832) * lu(k,1224) - lu(k,1228) = lu(k,1228) - lu(k,833) * lu(k,1224) - lu(k,1229) = lu(k,1229) - lu(k,834) * lu(k,1224) - lu(k,1230) = lu(k,1230) - lu(k,835) * lu(k,1224) - lu(k,1231) = lu(k,1231) - lu(k,836) * lu(k,1224) - lu(k,1232) = lu(k,1232) - lu(k,837) * lu(k,1224) - lu(k,1233) = lu(k,1233) - lu(k,838) * lu(k,1224) - lu(k,1234) = lu(k,1234) - lu(k,839) * lu(k,1224) - lu(k,1235) = lu(k,1235) - lu(k,840) * lu(k,1224) - lu(k,1236) = lu(k,1236) - lu(k,841) * lu(k,1224) - lu(k,1237) = lu(k,1237) - lu(k,842) * lu(k,1224) - lu(k,1238) = lu(k,1238) - lu(k,843) * lu(k,1224) - lu(k,1239) = lu(k,1239) - lu(k,844) * lu(k,1224) - lu(k,1240) = lu(k,1240) - lu(k,845) * lu(k,1224) - lu(k,1241) = lu(k,1241) - lu(k,846) * lu(k,1224) - lu(k,1242) = lu(k,1242) - lu(k,847) * lu(k,1224) - lu(k,1243) = lu(k,1243) - lu(k,848) * lu(k,1224) - lu(k,1244) = lu(k,1244) - lu(k,849) * lu(k,1224) - lu(k,1245) = lu(k,1245) - lu(k,850) * lu(k,1224) - lu(k,1246) = lu(k,1246) - lu(k,851) * lu(k,1224) - lu(k,1247) = lu(k,1247) - lu(k,852) * lu(k,1224) - lu(k,1268) = lu(k,1268) - lu(k,830) * lu(k,1267) - lu(k,1269) = lu(k,1269) - lu(k,831) * lu(k,1267) - lu(k,1270) = lu(k,1270) - lu(k,832) * lu(k,1267) - lu(k,1271) = lu(k,1271) - lu(k,833) * lu(k,1267) - lu(k,1272) = lu(k,1272) - lu(k,834) * lu(k,1267) - lu(k,1273) = lu(k,1273) - lu(k,835) * lu(k,1267) - lu(k,1274) = lu(k,1274) - lu(k,836) * lu(k,1267) - lu(k,1275) = lu(k,1275) - lu(k,837) * lu(k,1267) - lu(k,1276) = lu(k,1276) - lu(k,838) * lu(k,1267) - lu(k,1277) = lu(k,1277) - lu(k,839) * lu(k,1267) - lu(k,1278) = lu(k,1278) - lu(k,840) * lu(k,1267) - lu(k,1279) = lu(k,1279) - lu(k,841) * lu(k,1267) - lu(k,1280) = lu(k,1280) - lu(k,842) * lu(k,1267) - lu(k,1281) = lu(k,1281) - lu(k,843) * lu(k,1267) - lu(k,1282) = lu(k,1282) - lu(k,844) * lu(k,1267) - lu(k,1283) = lu(k,1283) - lu(k,845) * lu(k,1267) - lu(k,1284) = lu(k,1284) - lu(k,846) * lu(k,1267) - lu(k,1285) = lu(k,1285) - lu(k,847) * lu(k,1267) - lu(k,1286) = lu(k,1286) - lu(k,848) * lu(k,1267) - lu(k,1287) = lu(k,1287) - lu(k,849) * lu(k,1267) - lu(k,1288) = lu(k,1288) - lu(k,850) * lu(k,1267) - lu(k,1289) = lu(k,1289) - lu(k,851) * lu(k,1267) - lu(k,1290) = lu(k,1290) - lu(k,852) * lu(k,1267) - lu(k,1304) = lu(k,1304) - lu(k,830) * lu(k,1303) - lu(k,1305) = lu(k,1305) - lu(k,831) * lu(k,1303) - lu(k,1306) = lu(k,1306) - lu(k,832) * lu(k,1303) - lu(k,1307) = lu(k,1307) - lu(k,833) * lu(k,1303) - lu(k,1308) = lu(k,1308) - lu(k,834) * lu(k,1303) - lu(k,1309) = lu(k,1309) - lu(k,835) * lu(k,1303) - lu(k,1310) = lu(k,1310) - lu(k,836) * lu(k,1303) - lu(k,1311) = lu(k,1311) - lu(k,837) * lu(k,1303) - lu(k,1312) = lu(k,1312) - lu(k,838) * lu(k,1303) - lu(k,1313) = lu(k,1313) - lu(k,839) * lu(k,1303) - lu(k,1314) = lu(k,1314) - lu(k,840) * lu(k,1303) - lu(k,1315) = lu(k,1315) - lu(k,841) * lu(k,1303) - lu(k,1316) = lu(k,1316) - lu(k,842) * lu(k,1303) - lu(k,1317) = lu(k,1317) - lu(k,843) * lu(k,1303) - lu(k,1318) = lu(k,1318) - lu(k,844) * lu(k,1303) - lu(k,1319) = lu(k,1319) - lu(k,845) * lu(k,1303) - lu(k,1320) = lu(k,1320) - lu(k,846) * lu(k,1303) - lu(k,1321) = lu(k,1321) - lu(k,847) * lu(k,1303) - lu(k,1322) = lu(k,1322) - lu(k,848) * lu(k,1303) - lu(k,1323) = lu(k,1323) - lu(k,849) * lu(k,1303) - lu(k,1324) = lu(k,1324) - lu(k,850) * lu(k,1303) - lu(k,1325) = lu(k,1325) - lu(k,851) * lu(k,1303) - lu(k,1326) = lu(k,1326) - lu(k,852) * lu(k,1303) - lu(k,1349) = lu(k,1349) - lu(k,830) * lu(k,1348) - lu(k,1350) = lu(k,1350) - lu(k,831) * lu(k,1348) - lu(k,1351) = lu(k,1351) - lu(k,832) * lu(k,1348) - lu(k,1352) = lu(k,1352) - lu(k,833) * lu(k,1348) - lu(k,1353) = lu(k,1353) - lu(k,834) * lu(k,1348) - lu(k,1354) = lu(k,1354) - lu(k,835) * lu(k,1348) - lu(k,1355) = lu(k,1355) - lu(k,836) * lu(k,1348) - lu(k,1356) = lu(k,1356) - lu(k,837) * lu(k,1348) - lu(k,1357) = lu(k,1357) - lu(k,838) * lu(k,1348) - lu(k,1358) = lu(k,1358) - lu(k,839) * lu(k,1348) - lu(k,1359) = lu(k,1359) - lu(k,840) * lu(k,1348) - lu(k,1360) = lu(k,1360) - lu(k,841) * lu(k,1348) - lu(k,1361) = lu(k,1361) - lu(k,842) * lu(k,1348) - lu(k,1362) = lu(k,1362) - lu(k,843) * lu(k,1348) - lu(k,1363) = lu(k,1363) - lu(k,844) * lu(k,1348) - lu(k,1364) = lu(k,1364) - lu(k,845) * lu(k,1348) - lu(k,1365) = lu(k,1365) - lu(k,846) * lu(k,1348) - lu(k,1366) = lu(k,1366) - lu(k,847) * lu(k,1348) - lu(k,1367) = lu(k,1367) - lu(k,848) * lu(k,1348) - lu(k,1368) = lu(k,1368) - lu(k,849) * lu(k,1348) - lu(k,1369) = lu(k,1369) - lu(k,850) * lu(k,1348) - lu(k,1370) = lu(k,1370) - lu(k,851) * lu(k,1348) - lu(k,1371) = lu(k,1371) - lu(k,852) * lu(k,1348) - lu(k,1391) = lu(k,1391) - lu(k,830) * lu(k,1390) - lu(k,1392) = lu(k,1392) - lu(k,831) * lu(k,1390) - lu(k,1393) = lu(k,1393) - lu(k,832) * lu(k,1390) - lu(k,1394) = lu(k,1394) - lu(k,833) * lu(k,1390) - lu(k,1395) = lu(k,1395) - lu(k,834) * lu(k,1390) - lu(k,1396) = lu(k,1396) - lu(k,835) * lu(k,1390) - lu(k,1397) = lu(k,1397) - lu(k,836) * lu(k,1390) - lu(k,1398) = lu(k,1398) - lu(k,837) * lu(k,1390) - lu(k,1399) = lu(k,1399) - lu(k,838) * lu(k,1390) - lu(k,1400) = lu(k,1400) - lu(k,839) * lu(k,1390) - lu(k,1401) = lu(k,1401) - lu(k,840) * lu(k,1390) - lu(k,1402) = lu(k,1402) - lu(k,841) * lu(k,1390) - lu(k,1403) = lu(k,1403) - lu(k,842) * lu(k,1390) - lu(k,1404) = lu(k,1404) - lu(k,843) * lu(k,1390) - lu(k,1405) = lu(k,1405) - lu(k,844) * lu(k,1390) - lu(k,1406) = lu(k,1406) - lu(k,845) * lu(k,1390) - lu(k,1407) = lu(k,1407) - lu(k,846) * lu(k,1390) - lu(k,1408) = lu(k,1408) - lu(k,847) * lu(k,1390) - lu(k,1409) = lu(k,1409) - lu(k,848) * lu(k,1390) - lu(k,1410) = lu(k,1410) - lu(k,849) * lu(k,1390) - lu(k,1411) = lu(k,1411) - lu(k,850) * lu(k,1390) - lu(k,1412) = lu(k,1412) - lu(k,851) * lu(k,1390) - lu(k,1413) = lu(k,1413) - lu(k,852) * lu(k,1390) - lu(k,1429) = lu(k,1429) - lu(k,830) * lu(k,1428) - lu(k,1430) = lu(k,1430) - lu(k,831) * lu(k,1428) - lu(k,1431) = lu(k,1431) - lu(k,832) * lu(k,1428) - lu(k,1432) = lu(k,1432) - lu(k,833) * lu(k,1428) - lu(k,1433) = lu(k,1433) - lu(k,834) * lu(k,1428) - lu(k,1434) = lu(k,1434) - lu(k,835) * lu(k,1428) - lu(k,1435) = lu(k,1435) - lu(k,836) * lu(k,1428) - lu(k,1436) = lu(k,1436) - lu(k,837) * lu(k,1428) - lu(k,1437) = lu(k,1437) - lu(k,838) * lu(k,1428) - lu(k,1438) = lu(k,1438) - lu(k,839) * lu(k,1428) - lu(k,1439) = lu(k,1439) - lu(k,840) * lu(k,1428) - lu(k,1440) = lu(k,1440) - lu(k,841) * lu(k,1428) - lu(k,1441) = lu(k,1441) - lu(k,842) * lu(k,1428) - lu(k,1442) = lu(k,1442) - lu(k,843) * lu(k,1428) - lu(k,1443) = lu(k,1443) - lu(k,844) * lu(k,1428) - lu(k,1444) = lu(k,1444) - lu(k,845) * lu(k,1428) - lu(k,1445) = lu(k,1445) - lu(k,846) * lu(k,1428) - lu(k,1446) = lu(k,1446) - lu(k,847) * lu(k,1428) - lu(k,1447) = lu(k,1447) - lu(k,848) * lu(k,1428) - lu(k,1448) = lu(k,1448) - lu(k,849) * lu(k,1428) - lu(k,1449) = lu(k,1449) - lu(k,850) * lu(k,1428) - lu(k,1450) = lu(k,1450) - lu(k,851) * lu(k,1428) - lu(k,1451) = lu(k,1451) - lu(k,852) * lu(k,1428) - lu(k,1474) = lu(k,1474) - lu(k,830) * lu(k,1473) - lu(k,1475) = lu(k,1475) - lu(k,831) * lu(k,1473) - lu(k,1476) = lu(k,1476) - lu(k,832) * lu(k,1473) - lu(k,1477) = lu(k,1477) - lu(k,833) * lu(k,1473) - lu(k,1478) = lu(k,1478) - lu(k,834) * lu(k,1473) - lu(k,1479) = lu(k,1479) - lu(k,835) * lu(k,1473) - lu(k,1480) = lu(k,1480) - lu(k,836) * lu(k,1473) - lu(k,1481) = lu(k,1481) - lu(k,837) * lu(k,1473) - lu(k,1482) = lu(k,1482) - lu(k,838) * lu(k,1473) - lu(k,1483) = lu(k,1483) - lu(k,839) * lu(k,1473) - lu(k,1484) = lu(k,1484) - lu(k,840) * lu(k,1473) - lu(k,1485) = lu(k,1485) - lu(k,841) * lu(k,1473) - lu(k,1486) = lu(k,1486) - lu(k,842) * lu(k,1473) - lu(k,1487) = lu(k,1487) - lu(k,843) * lu(k,1473) - lu(k,1488) = lu(k,1488) - lu(k,844) * lu(k,1473) - lu(k,1489) = lu(k,1489) - lu(k,845) * lu(k,1473) - lu(k,1490) = lu(k,1490) - lu(k,846) * lu(k,1473) - lu(k,1491) = lu(k,1491) - lu(k,847) * lu(k,1473) - lu(k,1492) = lu(k,1492) - lu(k,848) * lu(k,1473) - lu(k,1493) = lu(k,1493) - lu(k,849) * lu(k,1473) - lu(k,1494) = lu(k,1494) - lu(k,850) * lu(k,1473) - lu(k,1495) = lu(k,1495) - lu(k,851) * lu(k,1473) - lu(k,1496) = lu(k,1496) - lu(k,852) * lu(k,1473) - lu(k,1517) = lu(k,1517) - lu(k,830) * lu(k,1516) - lu(k,1518) = lu(k,1518) - lu(k,831) * lu(k,1516) - lu(k,1519) = lu(k,1519) - lu(k,832) * lu(k,1516) - lu(k,1520) = lu(k,1520) - lu(k,833) * lu(k,1516) - lu(k,1521) = lu(k,1521) - lu(k,834) * lu(k,1516) - lu(k,1522) = lu(k,1522) - lu(k,835) * lu(k,1516) - lu(k,1523) = lu(k,1523) - lu(k,836) * lu(k,1516) - lu(k,1524) = lu(k,1524) - lu(k,837) * lu(k,1516) - lu(k,1525) = lu(k,1525) - lu(k,838) * lu(k,1516) - lu(k,1526) = lu(k,1526) - lu(k,839) * lu(k,1516) - lu(k,1527) = lu(k,1527) - lu(k,840) * lu(k,1516) - lu(k,1528) = lu(k,1528) - lu(k,841) * lu(k,1516) - lu(k,1529) = lu(k,1529) - lu(k,842) * lu(k,1516) - lu(k,1530) = lu(k,1530) - lu(k,843) * lu(k,1516) - lu(k,1531) = lu(k,1531) - lu(k,844) * lu(k,1516) - lu(k,1532) = lu(k,1532) - lu(k,845) * lu(k,1516) - lu(k,1533) = lu(k,1533) - lu(k,846) * lu(k,1516) - lu(k,1534) = lu(k,1534) - lu(k,847) * lu(k,1516) - lu(k,1535) = lu(k,1535) - lu(k,848) * lu(k,1516) - lu(k,1536) = lu(k,1536) - lu(k,849) * lu(k,1516) - lu(k,1537) = lu(k,1537) - lu(k,850) * lu(k,1516) - lu(k,1538) = lu(k,1538) - lu(k,851) * lu(k,1516) - lu(k,1539) = lu(k,1539) - lu(k,852) * lu(k,1516) - lu(k,1560) = lu(k,1560) - lu(k,830) * lu(k,1559) - lu(k,1561) = lu(k,1561) - lu(k,831) * lu(k,1559) - lu(k,1562) = lu(k,1562) - lu(k,832) * lu(k,1559) - lu(k,1563) = lu(k,1563) - lu(k,833) * lu(k,1559) - lu(k,1564) = lu(k,1564) - lu(k,834) * lu(k,1559) - lu(k,1565) = lu(k,1565) - lu(k,835) * lu(k,1559) - lu(k,1566) = lu(k,1566) - lu(k,836) * lu(k,1559) - lu(k,1567) = lu(k,1567) - lu(k,837) * lu(k,1559) - lu(k,1568) = lu(k,1568) - lu(k,838) * lu(k,1559) - lu(k,1569) = lu(k,1569) - lu(k,839) * lu(k,1559) - lu(k,1570) = lu(k,1570) - lu(k,840) * lu(k,1559) - lu(k,1571) = lu(k,1571) - lu(k,841) * lu(k,1559) - lu(k,1572) = lu(k,1572) - lu(k,842) * lu(k,1559) - lu(k,1573) = lu(k,1573) - lu(k,843) * lu(k,1559) - lu(k,1574) = lu(k,1574) - lu(k,844) * lu(k,1559) - lu(k,1575) = lu(k,1575) - lu(k,845) * lu(k,1559) - lu(k,1576) = lu(k,1576) - lu(k,846) * lu(k,1559) - lu(k,1577) = lu(k,1577) - lu(k,847) * lu(k,1559) - lu(k,1578) = lu(k,1578) - lu(k,848) * lu(k,1559) - lu(k,1579) = lu(k,1579) - lu(k,849) * lu(k,1559) - lu(k,1580) = lu(k,1580) - lu(k,850) * lu(k,1559) - lu(k,1581) = lu(k,1581) - lu(k,851) * lu(k,1559) - lu(k,1582) = lu(k,1582) - lu(k,852) * lu(k,1559) - lu(k,1593) = lu(k,1593) - lu(k,830) * lu(k,1592) - lu(k,1594) = lu(k,1594) - lu(k,831) * lu(k,1592) - lu(k,1595) = lu(k,1595) - lu(k,832) * lu(k,1592) - lu(k,1596) = lu(k,1596) - lu(k,833) * lu(k,1592) - lu(k,1597) = lu(k,1597) - lu(k,834) * lu(k,1592) - lu(k,1598) = lu(k,1598) - lu(k,835) * lu(k,1592) - lu(k,1599) = lu(k,1599) - lu(k,836) * lu(k,1592) - lu(k,1600) = lu(k,1600) - lu(k,837) * lu(k,1592) - lu(k,1601) = lu(k,1601) - lu(k,838) * lu(k,1592) - lu(k,1602) = lu(k,1602) - lu(k,839) * lu(k,1592) - lu(k,1603) = lu(k,1603) - lu(k,840) * lu(k,1592) - lu(k,1604) = lu(k,1604) - lu(k,841) * lu(k,1592) - lu(k,1605) = lu(k,1605) - lu(k,842) * lu(k,1592) - lu(k,1606) = lu(k,1606) - lu(k,843) * lu(k,1592) - lu(k,1607) = lu(k,1607) - lu(k,844) * lu(k,1592) - lu(k,1608) = lu(k,1608) - lu(k,845) * lu(k,1592) - lu(k,1609) = lu(k,1609) - lu(k,846) * lu(k,1592) - lu(k,1610) = lu(k,1610) - lu(k,847) * lu(k,1592) - lu(k,1611) = lu(k,1611) - lu(k,848) * lu(k,1592) - lu(k,1612) = lu(k,1612) - lu(k,849) * lu(k,1592) - lu(k,1613) = lu(k,1613) - lu(k,850) * lu(k,1592) - lu(k,1614) = lu(k,1614) - lu(k,851) * lu(k,1592) - lu(k,1615) = lu(k,1615) - lu(k,852) * lu(k,1592) - lu(k,1629) = lu(k,1629) - lu(k,830) * lu(k,1628) - lu(k,1630) = lu(k,1630) - lu(k,831) * lu(k,1628) - lu(k,1631) = lu(k,1631) - lu(k,832) * lu(k,1628) - lu(k,1632) = lu(k,1632) - lu(k,833) * lu(k,1628) - lu(k,1633) = lu(k,1633) - lu(k,834) * lu(k,1628) - lu(k,1634) = lu(k,1634) - lu(k,835) * lu(k,1628) - lu(k,1635) = lu(k,1635) - lu(k,836) * lu(k,1628) - lu(k,1636) = lu(k,1636) - lu(k,837) * lu(k,1628) - lu(k,1637) = lu(k,1637) - lu(k,838) * lu(k,1628) - lu(k,1638) = lu(k,1638) - lu(k,839) * lu(k,1628) - lu(k,1639) = lu(k,1639) - lu(k,840) * lu(k,1628) - lu(k,1640) = lu(k,1640) - lu(k,841) * lu(k,1628) - lu(k,1641) = lu(k,1641) - lu(k,842) * lu(k,1628) - lu(k,1642) = lu(k,1642) - lu(k,843) * lu(k,1628) - lu(k,1643) = lu(k,1643) - lu(k,844) * lu(k,1628) - lu(k,1644) = lu(k,1644) - lu(k,845) * lu(k,1628) - lu(k,1645) = lu(k,1645) - lu(k,846) * lu(k,1628) - lu(k,1646) = lu(k,1646) - lu(k,847) * lu(k,1628) - lu(k,1647) = lu(k,1647) - lu(k,848) * lu(k,1628) - lu(k,1648) = lu(k,1648) - lu(k,849) * lu(k,1628) - lu(k,1649) = lu(k,1649) - lu(k,850) * lu(k,1628) - lu(k,1650) = lu(k,1650) - lu(k,851) * lu(k,1628) - lu(k,1651) = lu(k,1651) - lu(k,852) * lu(k,1628) - lu(k,1672) = lu(k,1672) - lu(k,830) * lu(k,1671) - lu(k,1673) = lu(k,1673) - lu(k,831) * lu(k,1671) - lu(k,1674) = lu(k,1674) - lu(k,832) * lu(k,1671) - lu(k,1675) = lu(k,1675) - lu(k,833) * lu(k,1671) - lu(k,1676) = lu(k,1676) - lu(k,834) * lu(k,1671) - lu(k,1677) = lu(k,1677) - lu(k,835) * lu(k,1671) - lu(k,1678) = lu(k,1678) - lu(k,836) * lu(k,1671) - lu(k,1679) = lu(k,1679) - lu(k,837) * lu(k,1671) - lu(k,1680) = lu(k,1680) - lu(k,838) * lu(k,1671) - lu(k,1681) = lu(k,1681) - lu(k,839) * lu(k,1671) - lu(k,1682) = lu(k,1682) - lu(k,840) * lu(k,1671) - lu(k,1683) = lu(k,1683) - lu(k,841) * lu(k,1671) - lu(k,1684) = lu(k,1684) - lu(k,842) * lu(k,1671) - lu(k,1685) = lu(k,1685) - lu(k,843) * lu(k,1671) - lu(k,1686) = lu(k,1686) - lu(k,844) * lu(k,1671) - lu(k,1687) = lu(k,1687) - lu(k,845) * lu(k,1671) - lu(k,1688) = lu(k,1688) - lu(k,846) * lu(k,1671) - lu(k,1689) = lu(k,1689) - lu(k,847) * lu(k,1671) - lu(k,1690) = lu(k,1690) - lu(k,848) * lu(k,1671) - lu(k,1691) = lu(k,1691) - lu(k,849) * lu(k,1671) - lu(k,1692) = lu(k,1692) - lu(k,850) * lu(k,1671) - lu(k,1693) = lu(k,1693) - lu(k,851) * lu(k,1671) - lu(k,1694) = lu(k,1694) - lu(k,852) * lu(k,1671) - lu(k,1708) = lu(k,1708) - lu(k,830) * lu(k,1707) - lu(k,1709) = lu(k,1709) - lu(k,831) * lu(k,1707) - lu(k,1710) = lu(k,1710) - lu(k,832) * lu(k,1707) - lu(k,1711) = lu(k,1711) - lu(k,833) * lu(k,1707) - lu(k,1712) = lu(k,1712) - lu(k,834) * lu(k,1707) - lu(k,1713) = lu(k,1713) - lu(k,835) * lu(k,1707) - lu(k,1714) = lu(k,1714) - lu(k,836) * lu(k,1707) - lu(k,1715) = lu(k,1715) - lu(k,837) * lu(k,1707) - lu(k,1716) = lu(k,1716) - lu(k,838) * lu(k,1707) - lu(k,1717) = lu(k,1717) - lu(k,839) * lu(k,1707) - lu(k,1718) = lu(k,1718) - lu(k,840) * lu(k,1707) - lu(k,1719) = lu(k,1719) - lu(k,841) * lu(k,1707) - lu(k,1720) = lu(k,1720) - lu(k,842) * lu(k,1707) - lu(k,1721) = lu(k,1721) - lu(k,843) * lu(k,1707) - lu(k,1722) = lu(k,1722) - lu(k,844) * lu(k,1707) - lu(k,1723) = lu(k,1723) - lu(k,845) * lu(k,1707) - lu(k,1724) = lu(k,1724) - lu(k,846) * lu(k,1707) - lu(k,1725) = lu(k,1725) - lu(k,847) * lu(k,1707) - lu(k,1726) = lu(k,1726) - lu(k,848) * lu(k,1707) - lu(k,1727) = lu(k,1727) - lu(k,849) * lu(k,1707) - lu(k,1728) = lu(k,1728) - lu(k,850) * lu(k,1707) - lu(k,1729) = lu(k,1729) - lu(k,851) * lu(k,1707) - lu(k,1730) = lu(k,1730) - lu(k,852) * lu(k,1707) - lu(k,1750) = lu(k,1750) - lu(k,830) * lu(k,1749) - lu(k,1751) = lu(k,1751) - lu(k,831) * lu(k,1749) - lu(k,1752) = lu(k,1752) - lu(k,832) * lu(k,1749) - lu(k,1753) = lu(k,1753) - lu(k,833) * lu(k,1749) - lu(k,1754) = lu(k,1754) - lu(k,834) * lu(k,1749) - lu(k,1755) = lu(k,1755) - lu(k,835) * lu(k,1749) - lu(k,1756) = lu(k,1756) - lu(k,836) * lu(k,1749) - lu(k,1757) = lu(k,1757) - lu(k,837) * lu(k,1749) - lu(k,1758) = lu(k,1758) - lu(k,838) * lu(k,1749) - lu(k,1759) = lu(k,1759) - lu(k,839) * lu(k,1749) - lu(k,1760) = lu(k,1760) - lu(k,840) * lu(k,1749) - lu(k,1761) = lu(k,1761) - lu(k,841) * lu(k,1749) - lu(k,1762) = lu(k,1762) - lu(k,842) * lu(k,1749) - lu(k,1763) = lu(k,1763) - lu(k,843) * lu(k,1749) - lu(k,1764) = lu(k,1764) - lu(k,844) * lu(k,1749) - lu(k,1765) = lu(k,1765) - lu(k,845) * lu(k,1749) - lu(k,1766) = lu(k,1766) - lu(k,846) * lu(k,1749) - lu(k,1767) = lu(k,1767) - lu(k,847) * lu(k,1749) - lu(k,1768) = lu(k,1768) - lu(k,848) * lu(k,1749) - lu(k,1769) = lu(k,1769) - lu(k,849) * lu(k,1749) - lu(k,1770) = lu(k,1770) - lu(k,850) * lu(k,1749) - lu(k,1771) = lu(k,1771) - lu(k,851) * lu(k,1749) - lu(k,1772) = lu(k,1772) - lu(k,852) * lu(k,1749) - lu(k,1803) = lu(k,1803) - lu(k,830) * lu(k,1802) - lu(k,1804) = lu(k,1804) - lu(k,831) * lu(k,1802) - lu(k,1805) = lu(k,1805) - lu(k,832) * lu(k,1802) - lu(k,1806) = lu(k,1806) - lu(k,833) * lu(k,1802) - lu(k,1807) = lu(k,1807) - lu(k,834) * lu(k,1802) - lu(k,1808) = lu(k,1808) - lu(k,835) * lu(k,1802) - lu(k,1809) = lu(k,1809) - lu(k,836) * lu(k,1802) - lu(k,1810) = lu(k,1810) - lu(k,837) * lu(k,1802) - lu(k,1811) = lu(k,1811) - lu(k,838) * lu(k,1802) - lu(k,1812) = lu(k,1812) - lu(k,839) * lu(k,1802) - lu(k,1813) = lu(k,1813) - lu(k,840) * lu(k,1802) - lu(k,1814) = lu(k,1814) - lu(k,841) * lu(k,1802) - lu(k,1815) = lu(k,1815) - lu(k,842) * lu(k,1802) - lu(k,1816) = lu(k,1816) - lu(k,843) * lu(k,1802) - lu(k,1817) = lu(k,1817) - lu(k,844) * lu(k,1802) - lu(k,1818) = lu(k,1818) - lu(k,845) * lu(k,1802) - lu(k,1819) = lu(k,1819) - lu(k,846) * lu(k,1802) - lu(k,1820) = lu(k,1820) - lu(k,847) * lu(k,1802) - lu(k,1821) = lu(k,1821) - lu(k,848) * lu(k,1802) - lu(k,1822) = lu(k,1822) - lu(k,849) * lu(k,1802) - lu(k,1823) = lu(k,1823) - lu(k,850) * lu(k,1802) - lu(k,1824) = lu(k,1824) - lu(k,851) * lu(k,1802) - lu(k,1825) = lu(k,1825) - lu(k,852) * lu(k,1802) - end do + real(r8), intent(inout) :: lu(:) + lu(769) = 1._r8 / lu(769) + lu(770) = lu(770) * lu(769) + lu(771) = lu(771) * lu(769) + lu(772) = lu(772) * lu(769) + lu(773) = lu(773) * lu(769) + lu(774) = lu(774) * lu(769) + lu(775) = lu(775) * lu(769) + lu(776) = lu(776) * lu(769) + lu(777) = lu(777) * lu(769) + lu(778) = lu(778) * lu(769) + lu(779) = lu(779) * lu(769) + lu(780) = lu(780) * lu(769) + lu(781) = lu(781) * lu(769) + lu(782) = lu(782) * lu(769) + lu(783) = lu(783) * lu(769) + lu(784) = lu(784) * lu(769) + lu(785) = lu(785) * lu(769) + lu(786) = lu(786) * lu(769) + lu(787) = lu(787) * lu(769) + lu(788) = lu(788) * lu(769) + lu(789) = lu(789) * lu(769) + lu(790) = lu(790) * lu(769) + lu(791) = lu(791) * lu(769) + lu(792) = lu(792) * lu(769) + lu(817) = lu(817) - lu(770) * lu(816) + lu(818) = lu(818) - lu(771) * lu(816) + lu(819) = lu(819) - lu(772) * lu(816) + lu(820) = lu(820) - lu(773) * lu(816) + lu(821) = lu(821) - lu(774) * lu(816) + lu(822) = lu(822) - lu(775) * lu(816) + lu(823) = lu(823) - lu(776) * lu(816) + lu(824) = lu(824) - lu(777) * lu(816) + lu(825) = lu(825) - lu(778) * lu(816) + lu(826) = lu(826) - lu(779) * lu(816) + lu(827) = lu(827) - lu(780) * lu(816) + lu(828) = lu(828) - lu(781) * lu(816) + lu(829) = lu(829) - lu(782) * lu(816) + lu(830) = lu(830) - lu(783) * lu(816) + lu(831) = lu(831) - lu(784) * lu(816) + lu(832) = lu(832) - lu(785) * lu(816) + lu(833) = lu(833) - lu(786) * lu(816) + lu(834) = lu(834) - lu(787) * lu(816) + lu(835) = lu(835) - lu(788) * lu(816) + lu(836) = lu(836) - lu(789) * lu(816) + lu(837) = lu(837) - lu(790) * lu(816) + lu(838) = lu(838) - lu(791) * lu(816) + lu(839) = lu(839) - lu(792) * lu(816) + lu(859) = lu(859) - lu(770) * lu(858) + lu(860) = lu(860) - lu(771) * lu(858) + lu(861) = lu(861) - lu(772) * lu(858) + lu(862) = lu(862) - lu(773) * lu(858) + lu(863) = lu(863) - lu(774) * lu(858) + lu(864) = lu(864) - lu(775) * lu(858) + lu(865) = lu(865) - lu(776) * lu(858) + lu(866) = lu(866) - lu(777) * lu(858) + lu(867) = lu(867) - lu(778) * lu(858) + lu(868) = lu(868) - lu(779) * lu(858) + lu(869) = lu(869) - lu(780) * lu(858) + lu(870) = lu(870) - lu(781) * lu(858) + lu(871) = lu(871) - lu(782) * lu(858) + lu(872) = lu(872) - lu(783) * lu(858) + lu(873) = lu(873) - lu(784) * lu(858) + lu(874) = lu(874) - lu(785) * lu(858) + lu(875) = lu(875) - lu(786) * lu(858) + lu(876) = lu(876) - lu(787) * lu(858) + lu(877) = lu(877) - lu(788) * lu(858) + lu(878) = lu(878) - lu(789) * lu(858) + lu(879) = lu(879) - lu(790) * lu(858) + lu(880) = lu(880) - lu(791) * lu(858) + lu(881) = lu(881) - lu(792) * lu(858) + lu(903) = lu(903) - lu(770) * lu(902) + lu(904) = lu(904) - lu(771) * lu(902) + lu(905) = lu(905) - lu(772) * lu(902) + lu(906) = lu(906) - lu(773) * lu(902) + lu(907) = lu(907) - lu(774) * lu(902) + lu(908) = lu(908) - lu(775) * lu(902) + lu(909) = lu(909) - lu(776) * lu(902) + lu(910) = lu(910) - lu(777) * lu(902) + lu(911) = lu(911) - lu(778) * lu(902) + lu(912) = lu(912) - lu(779) * lu(902) + lu(913) = lu(913) - lu(780) * lu(902) + lu(914) = lu(914) - lu(781) * lu(902) + lu(915) = lu(915) - lu(782) * lu(902) + lu(916) = lu(916) - lu(783) * lu(902) + lu(917) = lu(917) - lu(784) * lu(902) + lu(918) = lu(918) - lu(785) * lu(902) + lu(919) = lu(919) - lu(786) * lu(902) + lu(920) = lu(920) - lu(787) * lu(902) + lu(921) = lu(921) - lu(788) * lu(902) + lu(922) = lu(922) - lu(789) * lu(902) + lu(923) = lu(923) - lu(790) * lu(902) + lu(924) = lu(924) - lu(791) * lu(902) + lu(925) = lu(925) - lu(792) * lu(902) + lu(938) = lu(938) - lu(770) * lu(937) + lu(939) = lu(939) - lu(771) * lu(937) + lu(940) = lu(940) - lu(772) * lu(937) + lu(941) = lu(941) - lu(773) * lu(937) + lu(942) = lu(942) - lu(774) * lu(937) + lu(943) = lu(943) - lu(775) * lu(937) + lu(944) = lu(944) - lu(776) * lu(937) + lu(945) = lu(945) - lu(777) * lu(937) + lu(946) = lu(946) - lu(778) * lu(937) + lu(947) = lu(947) - lu(779) * lu(937) + lu(948) = lu(948) - lu(780) * lu(937) + lu(949) = lu(949) - lu(781) * lu(937) + lu(950) = lu(950) - lu(782) * lu(937) + lu(951) = lu(951) - lu(783) * lu(937) + lu(952) = lu(952) - lu(784) * lu(937) + lu(953) = lu(953) - lu(785) * lu(937) + lu(954) = lu(954) - lu(786) * lu(937) + lu(955) = lu(955) - lu(787) * lu(937) + lu(956) = lu(956) - lu(788) * lu(937) + lu(957) = lu(957) - lu(789) * lu(937) + lu(958) = lu(958) - lu(790) * lu(937) + lu(959) = lu(959) - lu(791) * lu(937) + lu(960) = lu(960) - lu(792) * lu(937) + lu(979) = lu(979) - lu(770) * lu(978) + lu(980) = lu(980) - lu(771) * lu(978) + lu(981) = lu(981) - lu(772) * lu(978) + lu(982) = lu(982) - lu(773) * lu(978) + lu(983) = lu(983) - lu(774) * lu(978) + lu(984) = lu(984) - lu(775) * lu(978) + lu(985) = lu(985) - lu(776) * lu(978) + lu(986) = lu(986) - lu(777) * lu(978) + lu(987) = lu(987) - lu(778) * lu(978) + lu(988) = lu(988) - lu(779) * lu(978) + lu(989) = lu(989) - lu(780) * lu(978) + lu(990) = lu(990) - lu(781) * lu(978) + lu(991) = lu(991) - lu(782) * lu(978) + lu(992) = lu(992) - lu(783) * lu(978) + lu(993) = lu(993) - lu(784) * lu(978) + lu(994) = lu(994) - lu(785) * lu(978) + lu(995) = lu(995) - lu(786) * lu(978) + lu(996) = lu(996) - lu(787) * lu(978) + lu(997) = lu(997) - lu(788) * lu(978) + lu(998) = lu(998) - lu(789) * lu(978) + lu(999) = lu(999) - lu(790) * lu(978) + lu(1000) = lu(1000) - lu(791) * lu(978) + lu(1001) = lu(1001) - lu(792) * lu(978) + lu(1021) = lu(1021) - lu(770) * lu(1020) + lu(1022) = lu(1022) - lu(771) * lu(1020) + lu(1023) = lu(1023) - lu(772) * lu(1020) + lu(1024) = lu(1024) - lu(773) * lu(1020) + lu(1025) = lu(1025) - lu(774) * lu(1020) + lu(1026) = lu(1026) - lu(775) * lu(1020) + lu(1027) = lu(1027) - lu(776) * lu(1020) + lu(1028) = lu(1028) - lu(777) * lu(1020) + lu(1029) = lu(1029) - lu(778) * lu(1020) + lu(1030) = lu(1030) - lu(779) * lu(1020) + lu(1031) = lu(1031) - lu(780) * lu(1020) + lu(1032) = lu(1032) - lu(781) * lu(1020) + lu(1033) = lu(1033) - lu(782) * lu(1020) + lu(1034) = lu(1034) - lu(783) * lu(1020) + lu(1035) = lu(1035) - lu(784) * lu(1020) + lu(1036) = lu(1036) - lu(785) * lu(1020) + lu(1037) = lu(1037) - lu(786) * lu(1020) + lu(1038) = lu(1038) - lu(787) * lu(1020) + lu(1039) = lu(1039) - lu(788) * lu(1020) + lu(1040) = lu(1040) - lu(789) * lu(1020) + lu(1041) = lu(1041) - lu(790) * lu(1020) + lu(1042) = lu(1042) - lu(791) * lu(1020) + lu(1043) = lu(1043) - lu(792) * lu(1020) + lu(1065) = lu(1065) - lu(770) * lu(1064) + lu(1066) = lu(1066) - lu(771) * lu(1064) + lu(1067) = lu(1067) - lu(772) * lu(1064) + lu(1068) = lu(1068) - lu(773) * lu(1064) + lu(1069) = lu(1069) - lu(774) * lu(1064) + lu(1070) = lu(1070) - lu(775) * lu(1064) + lu(1071) = lu(1071) - lu(776) * lu(1064) + lu(1072) = lu(1072) - lu(777) * lu(1064) + lu(1073) = lu(1073) - lu(778) * lu(1064) + lu(1074) = lu(1074) - lu(779) * lu(1064) + lu(1075) = lu(1075) - lu(780) * lu(1064) + lu(1076) = lu(1076) - lu(781) * lu(1064) + lu(1077) = lu(1077) - lu(782) * lu(1064) + lu(1078) = lu(1078) - lu(783) * lu(1064) + lu(1079) = lu(1079) - lu(784) * lu(1064) + lu(1080) = lu(1080) - lu(785) * lu(1064) + lu(1081) = lu(1081) - lu(786) * lu(1064) + lu(1082) = lu(1082) - lu(787) * lu(1064) + lu(1083) = lu(1083) - lu(788) * lu(1064) + lu(1084) = lu(1084) - lu(789) * lu(1064) + lu(1085) = lu(1085) - lu(790) * lu(1064) + lu(1086) = lu(1086) - lu(791) * lu(1064) + lu(1087) = lu(1087) - lu(792) * lu(1064) + lu(1107) = lu(1107) - lu(770) * lu(1106) + lu(1108) = lu(1108) - lu(771) * lu(1106) + lu(1109) = lu(1109) - lu(772) * lu(1106) + lu(1110) = lu(1110) - lu(773) * lu(1106) + lu(1111) = lu(1111) - lu(774) * lu(1106) + lu(1112) = lu(1112) - lu(775) * lu(1106) + lu(1113) = lu(1113) - lu(776) * lu(1106) + lu(1114) = lu(1114) - lu(777) * lu(1106) + lu(1115) = lu(1115) - lu(778) * lu(1106) + lu(1116) = lu(1116) - lu(779) * lu(1106) + lu(1117) = lu(1117) - lu(780) * lu(1106) + lu(1118) = lu(1118) - lu(781) * lu(1106) + lu(1119) = lu(1119) - lu(782) * lu(1106) + lu(1120) = lu(1120) - lu(783) * lu(1106) + lu(1121) = lu(1121) - lu(784) * lu(1106) + lu(1122) = lu(1122) - lu(785) * lu(1106) + lu(1123) = lu(1123) - lu(786) * lu(1106) + lu(1124) = lu(1124) - lu(787) * lu(1106) + lu(1125) = lu(1125) - lu(788) * lu(1106) + lu(1126) = lu(1126) - lu(789) * lu(1106) + lu(1127) = lu(1127) - lu(790) * lu(1106) + lu(1128) = lu(1128) - lu(791) * lu(1106) + lu(1129) = lu(1129) - lu(792) * lu(1106) + lu(1150) = lu(1150) - lu(770) * lu(1149) + lu(1151) = lu(1151) - lu(771) * lu(1149) + lu(1152) = lu(1152) - lu(772) * lu(1149) + lu(1153) = lu(1153) - lu(773) * lu(1149) + lu(1154) = lu(1154) - lu(774) * lu(1149) + lu(1155) = lu(1155) - lu(775) * lu(1149) + lu(1156) = lu(1156) - lu(776) * lu(1149) + lu(1157) = lu(1157) - lu(777) * lu(1149) + lu(1158) = lu(1158) - lu(778) * lu(1149) + lu(1159) = lu(1159) - lu(779) * lu(1149) + lu(1160) = lu(1160) - lu(780) * lu(1149) + lu(1161) = lu(1161) - lu(781) * lu(1149) + lu(1162) = lu(1162) - lu(782) * lu(1149) + lu(1163) = lu(1163) - lu(783) * lu(1149) + lu(1164) = lu(1164) - lu(784) * lu(1149) + lu(1165) = lu(1165) - lu(785) * lu(1149) + lu(1166) = lu(1166) - lu(786) * lu(1149) + lu(1167) = lu(1167) - lu(787) * lu(1149) + lu(1168) = lu(1168) - lu(788) * lu(1149) + lu(1169) = lu(1169) - lu(789) * lu(1149) + lu(1170) = lu(1170) - lu(790) * lu(1149) + lu(1171) = lu(1171) - lu(791) * lu(1149) + lu(1172) = lu(1172) - lu(792) * lu(1149) + lu(1192) = lu(1192) - lu(770) * lu(1191) + lu(1193) = lu(1193) - lu(771) * lu(1191) + lu(1194) = lu(1194) - lu(772) * lu(1191) + lu(1195) = lu(1195) - lu(773) * lu(1191) + lu(1196) = lu(1196) - lu(774) * lu(1191) + lu(1197) = lu(1197) - lu(775) * lu(1191) + lu(1198) = lu(1198) - lu(776) * lu(1191) + lu(1199) = lu(1199) - lu(777) * lu(1191) + lu(1200) = lu(1200) - lu(778) * lu(1191) + lu(1201) = lu(1201) - lu(779) * lu(1191) + lu(1202) = lu(1202) - lu(780) * lu(1191) + lu(1203) = lu(1203) - lu(781) * lu(1191) + lu(1204) = lu(1204) - lu(782) * lu(1191) + lu(1205) = lu(1205) - lu(783) * lu(1191) + lu(1206) = lu(1206) - lu(784) * lu(1191) + lu(1207) = lu(1207) - lu(785) * lu(1191) + lu(1208) = lu(1208) - lu(786) * lu(1191) + lu(1209) = lu(1209) - lu(787) * lu(1191) + lu(1210) = lu(1210) - lu(788) * lu(1191) + lu(1211) = lu(1211) - lu(789) * lu(1191) + lu(1212) = lu(1212) - lu(790) * lu(1191) + lu(1213) = lu(1213) - lu(791) * lu(1191) + lu(1214) = lu(1214) - lu(792) * lu(1191) + lu(1227) = lu(1227) - lu(770) * lu(1226) + lu(1228) = lu(1228) - lu(771) * lu(1226) + lu(1229) = lu(1229) - lu(772) * lu(1226) + lu(1230) = lu(1230) - lu(773) * lu(1226) + lu(1231) = lu(1231) - lu(774) * lu(1226) + lu(1232) = lu(1232) - lu(775) * lu(1226) + lu(1233) = lu(1233) - lu(776) * lu(1226) + lu(1234) = lu(1234) - lu(777) * lu(1226) + lu(1235) = lu(1235) - lu(778) * lu(1226) + lu(1236) = lu(1236) - lu(779) * lu(1226) + lu(1237) = lu(1237) - lu(780) * lu(1226) + lu(1238) = lu(1238) - lu(781) * lu(1226) + lu(1239) = lu(1239) - lu(782) * lu(1226) + lu(1240) = lu(1240) - lu(783) * lu(1226) + lu(1241) = lu(1241) - lu(784) * lu(1226) + lu(1242) = lu(1242) - lu(785) * lu(1226) + lu(1243) = lu(1243) - lu(786) * lu(1226) + lu(1244) = lu(1244) - lu(787) * lu(1226) + lu(1245) = lu(1245) - lu(788) * lu(1226) + lu(1246) = lu(1246) - lu(789) * lu(1226) + lu(1247) = lu(1247) - lu(790) * lu(1226) + lu(1248) = lu(1248) - lu(791) * lu(1226) + lu(1249) = lu(1249) - lu(792) * lu(1226) + lu(1271) = lu(1271) - lu(770) * lu(1270) + lu(1272) = lu(1272) - lu(771) * lu(1270) + lu(1273) = lu(1273) - lu(772) * lu(1270) + lu(1274) = lu(1274) - lu(773) * lu(1270) + lu(1275) = lu(1275) - lu(774) * lu(1270) + lu(1276) = lu(1276) - lu(775) * lu(1270) + lu(1277) = lu(1277) - lu(776) * lu(1270) + lu(1278) = lu(1278) - lu(777) * lu(1270) + lu(1279) = lu(1279) - lu(778) * lu(1270) + lu(1280) = lu(1280) - lu(779) * lu(1270) + lu(1281) = lu(1281) - lu(780) * lu(1270) + lu(1282) = lu(1282) - lu(781) * lu(1270) + lu(1283) = lu(1283) - lu(782) * lu(1270) + lu(1284) = lu(1284) - lu(783) * lu(1270) + lu(1285) = lu(1285) - lu(784) * lu(1270) + lu(1286) = lu(1286) - lu(785) * lu(1270) + lu(1287) = lu(1287) - lu(786) * lu(1270) + lu(1288) = lu(1288) - lu(787) * lu(1270) + lu(1289) = lu(1289) - lu(788) * lu(1270) + lu(1290) = lu(1290) - lu(789) * lu(1270) + lu(1291) = lu(1291) - lu(790) * lu(1270) + lu(1292) = lu(1292) - lu(791) * lu(1270) + lu(1293) = lu(1293) - lu(792) * lu(1270) + lu(1312) = lu(1312) - lu(770) * lu(1311) + lu(1313) = lu(1313) - lu(771) * lu(1311) + lu(1314) = lu(1314) - lu(772) * lu(1311) + lu(1315) = lu(1315) - lu(773) * lu(1311) + lu(1316) = lu(1316) - lu(774) * lu(1311) + lu(1317) = lu(1317) - lu(775) * lu(1311) + lu(1318) = lu(1318) - lu(776) * lu(1311) + lu(1319) = lu(1319) - lu(777) * lu(1311) + lu(1320) = lu(1320) - lu(778) * lu(1311) + lu(1321) = lu(1321) - lu(779) * lu(1311) + lu(1322) = lu(1322) - lu(780) * lu(1311) + lu(1323) = lu(1323) - lu(781) * lu(1311) + lu(1324) = lu(1324) - lu(782) * lu(1311) + lu(1325) = lu(1325) - lu(783) * lu(1311) + lu(1326) = lu(1326) - lu(784) * lu(1311) + lu(1327) = lu(1327) - lu(785) * lu(1311) + lu(1328) = lu(1328) - lu(786) * lu(1311) + lu(1329) = lu(1329) - lu(787) * lu(1311) + lu(1330) = lu(1330) - lu(788) * lu(1311) + lu(1331) = lu(1331) - lu(789) * lu(1311) + lu(1332) = lu(1332) - lu(790) * lu(1311) + lu(1333) = lu(1333) - lu(791) * lu(1311) + lu(1334) = lu(1334) - lu(792) * lu(1311) + lu(1354) = lu(1354) - lu(770) * lu(1353) + lu(1355) = lu(1355) - lu(771) * lu(1353) + lu(1356) = lu(1356) - lu(772) * lu(1353) + lu(1357) = lu(1357) - lu(773) * lu(1353) + lu(1358) = lu(1358) - lu(774) * lu(1353) + lu(1359) = lu(1359) - lu(775) * lu(1353) + lu(1360) = lu(1360) - lu(776) * lu(1353) + lu(1361) = lu(1361) - lu(777) * lu(1353) + lu(1362) = lu(1362) - lu(778) * lu(1353) + lu(1363) = lu(1363) - lu(779) * lu(1353) + lu(1364) = lu(1364) - lu(780) * lu(1353) + lu(1365) = lu(1365) - lu(781) * lu(1353) + lu(1366) = lu(1366) - lu(782) * lu(1353) + lu(1367) = lu(1367) - lu(783) * lu(1353) + lu(1368) = lu(1368) - lu(784) * lu(1353) + lu(1369) = lu(1369) - lu(785) * lu(1353) + lu(1370) = lu(1370) - lu(786) * lu(1353) + lu(1371) = lu(1371) - lu(787) * lu(1353) + lu(1372) = lu(1372) - lu(788) * lu(1353) + lu(1373) = lu(1373) - lu(789) * lu(1353) + lu(1374) = lu(1374) - lu(790) * lu(1353) + lu(1375) = lu(1375) - lu(791) * lu(1353) + lu(1376) = lu(1376) - lu(792) * lu(1353) + lu(1438) = lu(1438) - lu(770) * lu(1437) + lu(1439) = lu(1439) - lu(771) * lu(1437) + lu(1440) = lu(1440) - lu(772) * lu(1437) + lu(1441) = lu(1441) - lu(773) * lu(1437) + lu(1442) = lu(1442) - lu(774) * lu(1437) + lu(1443) = lu(1443) - lu(775) * lu(1437) + lu(1444) = lu(1444) - lu(776) * lu(1437) + lu(1445) = lu(1445) - lu(777) * lu(1437) + lu(1446) = lu(1446) - lu(778) * lu(1437) + lu(1447) = lu(1447) - lu(779) * lu(1437) + lu(1448) = lu(1448) - lu(780) * lu(1437) + lu(1449) = lu(1449) - lu(781) * lu(1437) + lu(1450) = lu(1450) - lu(782) * lu(1437) + lu(1451) = lu(1451) - lu(783) * lu(1437) + lu(1452) = lu(1452) - lu(784) * lu(1437) + lu(1453) = lu(1453) - lu(785) * lu(1437) + lu(1454) = lu(1454) - lu(786) * lu(1437) + lu(1455) = lu(1455) - lu(787) * lu(1437) + lu(1456) = lu(1456) - lu(788) * lu(1437) + lu(1457) = lu(1457) - lu(789) * lu(1437) + lu(1458) = lu(1458) - lu(790) * lu(1437) + lu(1459) = lu(1459) - lu(791) * lu(1437) + lu(1460) = lu(1460) - lu(792) * lu(1437) + lu(1493) = lu(1493) - lu(770) * lu(1492) + lu(1494) = lu(1494) - lu(771) * lu(1492) + lu(1495) = lu(1495) - lu(772) * lu(1492) + lu(1496) = lu(1496) - lu(773) * lu(1492) + lu(1497) = lu(1497) - lu(774) * lu(1492) + lu(1498) = lu(1498) - lu(775) * lu(1492) + lu(1499) = lu(1499) - lu(776) * lu(1492) + lu(1500) = lu(1500) - lu(777) * lu(1492) + lu(1501) = lu(1501) - lu(778) * lu(1492) + lu(1502) = lu(1502) - lu(779) * lu(1492) + lu(1503) = lu(1503) - lu(780) * lu(1492) + lu(1504) = lu(1504) - lu(781) * lu(1492) + lu(1505) = lu(1505) - lu(782) * lu(1492) + lu(1506) = lu(1506) - lu(783) * lu(1492) + lu(1507) = lu(1507) - lu(784) * lu(1492) + lu(1508) = lu(1508) - lu(785) * lu(1492) + lu(1509) = lu(1509) - lu(786) * lu(1492) + lu(1510) = lu(1510) - lu(787) * lu(1492) + lu(1511) = lu(1511) - lu(788) * lu(1492) + lu(1512) = lu(1512) - lu(789) * lu(1492) + lu(1513) = lu(1513) - lu(790) * lu(1492) + lu(1514) = lu(1514) - lu(791) * lu(1492) + lu(1515) = lu(1515) - lu(792) * lu(1492) + lu(1525) = lu(1525) - lu(770) * lu(1524) + lu(1526) = lu(1526) - lu(771) * lu(1524) + lu(1527) = lu(1527) - lu(772) * lu(1524) + lu(1528) = lu(1528) - lu(773) * lu(1524) + lu(1529) = lu(1529) - lu(774) * lu(1524) + lu(1530) = lu(1530) - lu(775) * lu(1524) + lu(1531) = lu(1531) - lu(776) * lu(1524) + lu(1532) = lu(1532) - lu(777) * lu(1524) + lu(1533) = lu(1533) - lu(778) * lu(1524) + lu(1534) = lu(1534) - lu(779) * lu(1524) + lu(1535) = lu(1535) - lu(780) * lu(1524) + lu(1536) = lu(1536) - lu(781) * lu(1524) + lu(1537) = lu(1537) - lu(782) * lu(1524) + lu(1538) = lu(1538) - lu(783) * lu(1524) + lu(1539) = lu(1539) - lu(784) * lu(1524) + lu(1540) = lu(1540) - lu(785) * lu(1524) + lu(1541) = lu(1541) - lu(786) * lu(1524) + lu(1542) = lu(1542) - lu(787) * lu(1524) + lu(1543) = lu(1543) - lu(788) * lu(1524) + lu(1544) = lu(1544) - lu(789) * lu(1524) + lu(1545) = lu(1545) - lu(790) * lu(1524) + lu(1546) = lu(1546) - lu(791) * lu(1524) + lu(1547) = lu(1547) - lu(792) * lu(1524) + lu(1560) = lu(1560) - lu(770) * lu(1559) + lu(1561) = lu(1561) - lu(771) * lu(1559) + lu(1562) = lu(1562) - lu(772) * lu(1559) + lu(1563) = lu(1563) - lu(773) * lu(1559) + lu(1564) = lu(1564) - lu(774) * lu(1559) + lu(1565) = lu(1565) - lu(775) * lu(1559) + lu(1566) = lu(1566) - lu(776) * lu(1559) + lu(1567) = lu(1567) - lu(777) * lu(1559) + lu(1568) = lu(1568) - lu(778) * lu(1559) + lu(1569) = lu(1569) - lu(779) * lu(1559) + lu(1570) = lu(1570) - lu(780) * lu(1559) + lu(1571) = lu(1571) - lu(781) * lu(1559) + lu(1572) = lu(1572) - lu(782) * lu(1559) + lu(1573) = lu(1573) - lu(783) * lu(1559) + lu(1574) = lu(1574) - lu(784) * lu(1559) + lu(1575) = lu(1575) - lu(785) * lu(1559) + lu(1576) = lu(1576) - lu(786) * lu(1559) + lu(1577) = lu(1577) - lu(787) * lu(1559) + lu(1578) = lu(1578) - lu(788) * lu(1559) + lu(1579) = lu(1579) - lu(789) * lu(1559) + lu(1580) = lu(1580) - lu(790) * lu(1559) + lu(1581) = lu(1581) - lu(791) * lu(1559) + lu(1582) = lu(1582) - lu(792) * lu(1559) + lu(1598) = lu(1598) - lu(770) * lu(1597) + lu(1599) = lu(1599) - lu(771) * lu(1597) + lu(1600) = lu(1600) - lu(772) * lu(1597) + lu(1601) = lu(1601) - lu(773) * lu(1597) + lu(1602) = lu(1602) - lu(774) * lu(1597) + lu(1603) = lu(1603) - lu(775) * lu(1597) + lu(1604) = lu(1604) - lu(776) * lu(1597) + lu(1605) = lu(1605) - lu(777) * lu(1597) + lu(1606) = lu(1606) - lu(778) * lu(1597) + lu(1607) = lu(1607) - lu(779) * lu(1597) + lu(1608) = lu(1608) - lu(780) * lu(1597) + lu(1609) = lu(1609) - lu(781) * lu(1597) + lu(1610) = lu(1610) - lu(782) * lu(1597) + lu(1611) = lu(1611) - lu(783) * lu(1597) + lu(1612) = lu(1612) - lu(784) * lu(1597) + lu(1613) = lu(1613) - lu(785) * lu(1597) + lu(1614) = lu(1614) - lu(786) * lu(1597) + lu(1615) = lu(1615) - lu(787) * lu(1597) + lu(1616) = lu(1616) - lu(788) * lu(1597) + lu(1617) = lu(1617) - lu(789) * lu(1597) + lu(1618) = lu(1618) - lu(790) * lu(1597) + lu(1619) = lu(1619) - lu(791) * lu(1597) + lu(1620) = lu(1620) - lu(792) * lu(1597) + lu(1637) = lu(1637) - lu(770) * lu(1636) + lu(1638) = lu(1638) - lu(771) * lu(1636) + lu(1639) = lu(1639) - lu(772) * lu(1636) + lu(1640) = lu(1640) - lu(773) * lu(1636) + lu(1641) = lu(1641) - lu(774) * lu(1636) + lu(1642) = lu(1642) - lu(775) * lu(1636) + lu(1643) = lu(1643) - lu(776) * lu(1636) + lu(1644) = lu(1644) - lu(777) * lu(1636) + lu(1645) = lu(1645) - lu(778) * lu(1636) + lu(1646) = lu(1646) - lu(779) * lu(1636) + lu(1647) = lu(1647) - lu(780) * lu(1636) + lu(1648) = lu(1648) - lu(781) * lu(1636) + lu(1649) = lu(1649) - lu(782) * lu(1636) + lu(1650) = lu(1650) - lu(783) * lu(1636) + lu(1651) = lu(1651) - lu(784) * lu(1636) + lu(1652) = lu(1652) - lu(785) * lu(1636) + lu(1653) = lu(1653) - lu(786) * lu(1636) + lu(1654) = lu(1654) - lu(787) * lu(1636) + lu(1655) = lu(1655) - lu(788) * lu(1636) + lu(1656) = lu(1656) - lu(789) * lu(1636) + lu(1657) = lu(1657) - lu(790) * lu(1636) + lu(1658) = lu(1658) - lu(791) * lu(1636) + lu(1659) = lu(1659) - lu(792) * lu(1636) + lu(1671) = lu(1671) - lu(770) * lu(1670) + lu(1672) = lu(1672) - lu(771) * lu(1670) + lu(1673) = lu(1673) - lu(772) * lu(1670) + lu(1674) = lu(1674) - lu(773) * lu(1670) + lu(1675) = lu(1675) - lu(774) * lu(1670) + lu(1676) = lu(1676) - lu(775) * lu(1670) + lu(1677) = lu(1677) - lu(776) * lu(1670) + lu(1678) = lu(1678) - lu(777) * lu(1670) + lu(1679) = lu(1679) - lu(778) * lu(1670) + lu(1680) = lu(1680) - lu(779) * lu(1670) + lu(1681) = lu(1681) - lu(780) * lu(1670) + lu(1682) = lu(1682) - lu(781) * lu(1670) + lu(1683) = lu(1683) - lu(782) * lu(1670) + lu(1684) = lu(1684) - lu(783) * lu(1670) + lu(1685) = lu(1685) - lu(784) * lu(1670) + lu(1686) = lu(1686) - lu(785) * lu(1670) + lu(1687) = lu(1687) - lu(786) * lu(1670) + lu(1688) = lu(1688) - lu(787) * lu(1670) + lu(1689) = lu(1689) - lu(788) * lu(1670) + lu(1690) = lu(1690) - lu(789) * lu(1670) + lu(1691) = lu(1691) - lu(790) * lu(1670) + lu(1692) = lu(1692) - lu(791) * lu(1670) + lu(1693) = lu(1693) - lu(792) * lu(1670) + lu(1723) = lu(1723) - lu(770) * lu(1722) + lu(1724) = lu(1724) - lu(771) * lu(1722) + lu(1725) = lu(1725) - lu(772) * lu(1722) + lu(1726) = lu(1726) - lu(773) * lu(1722) + lu(1727) = lu(1727) - lu(774) * lu(1722) + lu(1728) = lu(1728) - lu(775) * lu(1722) + lu(1729) = lu(1729) - lu(776) * lu(1722) + lu(1730) = lu(1730) - lu(777) * lu(1722) + lu(1731) = lu(1731) - lu(778) * lu(1722) + lu(1732) = lu(1732) - lu(779) * lu(1722) + lu(1733) = lu(1733) - lu(780) * lu(1722) + lu(1734) = lu(1734) - lu(781) * lu(1722) + lu(1735) = lu(1735) - lu(782) * lu(1722) + lu(1736) = lu(1736) - lu(783) * lu(1722) + lu(1737) = lu(1737) - lu(784) * lu(1722) + lu(1738) = lu(1738) - lu(785) * lu(1722) + lu(1739) = lu(1739) - lu(786) * lu(1722) + lu(1740) = lu(1740) - lu(787) * lu(1722) + lu(1741) = lu(1741) - lu(788) * lu(1722) + lu(1742) = lu(1742) - lu(789) * lu(1722) + lu(1743) = lu(1743) - lu(790) * lu(1722) + lu(1744) = lu(1744) - lu(791) * lu(1722) + lu(1745) = lu(1745) - lu(792) * lu(1722) + lu(817) = 1._r8 / lu(817) + lu(818) = lu(818) * lu(817) + lu(819) = lu(819) * lu(817) + lu(820) = lu(820) * lu(817) + lu(821) = lu(821) * lu(817) + lu(822) = lu(822) * lu(817) + lu(823) = lu(823) * lu(817) + lu(824) = lu(824) * lu(817) + lu(825) = lu(825) * lu(817) + lu(826) = lu(826) * lu(817) + lu(827) = lu(827) * lu(817) + lu(828) = lu(828) * lu(817) + lu(829) = lu(829) * lu(817) + lu(830) = lu(830) * lu(817) + lu(831) = lu(831) * lu(817) + lu(832) = lu(832) * lu(817) + lu(833) = lu(833) * lu(817) + lu(834) = lu(834) * lu(817) + lu(835) = lu(835) * lu(817) + lu(836) = lu(836) * lu(817) + lu(837) = lu(837) * lu(817) + lu(838) = lu(838) * lu(817) + lu(839) = lu(839) * lu(817) + lu(860) = lu(860) - lu(818) * lu(859) + lu(861) = lu(861) - lu(819) * lu(859) + lu(862) = lu(862) - lu(820) * lu(859) + lu(863) = lu(863) - lu(821) * lu(859) + lu(864) = lu(864) - lu(822) * lu(859) + lu(865) = lu(865) - lu(823) * lu(859) + lu(866) = lu(866) - lu(824) * lu(859) + lu(867) = lu(867) - lu(825) * lu(859) + lu(868) = lu(868) - lu(826) * lu(859) + lu(869) = lu(869) - lu(827) * lu(859) + lu(870) = lu(870) - lu(828) * lu(859) + lu(871) = lu(871) - lu(829) * lu(859) + lu(872) = lu(872) - lu(830) * lu(859) + lu(873) = lu(873) - lu(831) * lu(859) + lu(874) = lu(874) - lu(832) * lu(859) + lu(875) = lu(875) - lu(833) * lu(859) + lu(876) = lu(876) - lu(834) * lu(859) + lu(877) = lu(877) - lu(835) * lu(859) + lu(878) = lu(878) - lu(836) * lu(859) + lu(879) = lu(879) - lu(837) * lu(859) + lu(880) = lu(880) - lu(838) * lu(859) + lu(881) = lu(881) - lu(839) * lu(859) + lu(904) = lu(904) - lu(818) * lu(903) + lu(905) = lu(905) - lu(819) * lu(903) + lu(906) = lu(906) - lu(820) * lu(903) + lu(907) = lu(907) - lu(821) * lu(903) + lu(908) = lu(908) - lu(822) * lu(903) + lu(909) = lu(909) - lu(823) * lu(903) + lu(910) = lu(910) - lu(824) * lu(903) + lu(911) = lu(911) - lu(825) * lu(903) + lu(912) = lu(912) - lu(826) * lu(903) + lu(913) = lu(913) - lu(827) * lu(903) + lu(914) = lu(914) - lu(828) * lu(903) + lu(915) = lu(915) - lu(829) * lu(903) + lu(916) = lu(916) - lu(830) * lu(903) + lu(917) = lu(917) - lu(831) * lu(903) + lu(918) = lu(918) - lu(832) * lu(903) + lu(919) = lu(919) - lu(833) * lu(903) + lu(920) = lu(920) - lu(834) * lu(903) + lu(921) = lu(921) - lu(835) * lu(903) + lu(922) = lu(922) - lu(836) * lu(903) + lu(923) = lu(923) - lu(837) * lu(903) + lu(924) = lu(924) - lu(838) * lu(903) + lu(925) = lu(925) - lu(839) * lu(903) + lu(939) = lu(939) - lu(818) * lu(938) + lu(940) = lu(940) - lu(819) * lu(938) + lu(941) = lu(941) - lu(820) * lu(938) + lu(942) = lu(942) - lu(821) * lu(938) + lu(943) = lu(943) - lu(822) * lu(938) + lu(944) = lu(944) - lu(823) * lu(938) + lu(945) = lu(945) - lu(824) * lu(938) + lu(946) = lu(946) - lu(825) * lu(938) + lu(947) = lu(947) - lu(826) * lu(938) + lu(948) = lu(948) - lu(827) * lu(938) + lu(949) = lu(949) - lu(828) * lu(938) + lu(950) = lu(950) - lu(829) * lu(938) + lu(951) = lu(951) - lu(830) * lu(938) + lu(952) = lu(952) - lu(831) * lu(938) + lu(953) = lu(953) - lu(832) * lu(938) + lu(954) = lu(954) - lu(833) * lu(938) + lu(955) = lu(955) - lu(834) * lu(938) + lu(956) = lu(956) - lu(835) * lu(938) + lu(957) = lu(957) - lu(836) * lu(938) + lu(958) = lu(958) - lu(837) * lu(938) + lu(959) = lu(959) - lu(838) * lu(938) + lu(960) = lu(960) - lu(839) * lu(938) + lu(980) = lu(980) - lu(818) * lu(979) + lu(981) = lu(981) - lu(819) * lu(979) + lu(982) = lu(982) - lu(820) * lu(979) + lu(983) = lu(983) - lu(821) * lu(979) + lu(984) = lu(984) - lu(822) * lu(979) + lu(985) = lu(985) - lu(823) * lu(979) + lu(986) = lu(986) - lu(824) * lu(979) + lu(987) = lu(987) - lu(825) * lu(979) + lu(988) = lu(988) - lu(826) * lu(979) + lu(989) = lu(989) - lu(827) * lu(979) + lu(990) = lu(990) - lu(828) * lu(979) + lu(991) = lu(991) - lu(829) * lu(979) + lu(992) = lu(992) - lu(830) * lu(979) + lu(993) = lu(993) - lu(831) * lu(979) + lu(994) = lu(994) - lu(832) * lu(979) + lu(995) = lu(995) - lu(833) * lu(979) + lu(996) = lu(996) - lu(834) * lu(979) + lu(997) = lu(997) - lu(835) * lu(979) + lu(998) = lu(998) - lu(836) * lu(979) + lu(999) = lu(999) - lu(837) * lu(979) + lu(1000) = lu(1000) - lu(838) * lu(979) + lu(1001) = lu(1001) - lu(839) * lu(979) + lu(1022) = lu(1022) - lu(818) * lu(1021) + lu(1023) = lu(1023) - lu(819) * lu(1021) + lu(1024) = lu(1024) - lu(820) * lu(1021) + lu(1025) = lu(1025) - lu(821) * lu(1021) + lu(1026) = lu(1026) - lu(822) * lu(1021) + lu(1027) = lu(1027) - lu(823) * lu(1021) + lu(1028) = lu(1028) - lu(824) * lu(1021) + lu(1029) = lu(1029) - lu(825) * lu(1021) + lu(1030) = lu(1030) - lu(826) * lu(1021) + lu(1031) = lu(1031) - lu(827) * lu(1021) + lu(1032) = lu(1032) - lu(828) * lu(1021) + lu(1033) = lu(1033) - lu(829) * lu(1021) + lu(1034) = lu(1034) - lu(830) * lu(1021) + lu(1035) = lu(1035) - lu(831) * lu(1021) + lu(1036) = lu(1036) - lu(832) * lu(1021) + lu(1037) = lu(1037) - lu(833) * lu(1021) + lu(1038) = lu(1038) - lu(834) * lu(1021) + lu(1039) = lu(1039) - lu(835) * lu(1021) + lu(1040) = lu(1040) - lu(836) * lu(1021) + lu(1041) = lu(1041) - lu(837) * lu(1021) + lu(1042) = lu(1042) - lu(838) * lu(1021) + lu(1043) = lu(1043) - lu(839) * lu(1021) + lu(1066) = lu(1066) - lu(818) * lu(1065) + lu(1067) = lu(1067) - lu(819) * lu(1065) + lu(1068) = lu(1068) - lu(820) * lu(1065) + lu(1069) = lu(1069) - lu(821) * lu(1065) + lu(1070) = lu(1070) - lu(822) * lu(1065) + lu(1071) = lu(1071) - lu(823) * lu(1065) + lu(1072) = lu(1072) - lu(824) * lu(1065) + lu(1073) = lu(1073) - lu(825) * lu(1065) + lu(1074) = lu(1074) - lu(826) * lu(1065) + lu(1075) = lu(1075) - lu(827) * lu(1065) + lu(1076) = lu(1076) - lu(828) * lu(1065) + lu(1077) = lu(1077) - lu(829) * lu(1065) + lu(1078) = lu(1078) - lu(830) * lu(1065) + lu(1079) = lu(1079) - lu(831) * lu(1065) + lu(1080) = lu(1080) - lu(832) * lu(1065) + lu(1081) = lu(1081) - lu(833) * lu(1065) + lu(1082) = lu(1082) - lu(834) * lu(1065) + lu(1083) = lu(1083) - lu(835) * lu(1065) + lu(1084) = lu(1084) - lu(836) * lu(1065) + lu(1085) = lu(1085) - lu(837) * lu(1065) + lu(1086) = lu(1086) - lu(838) * lu(1065) + lu(1087) = lu(1087) - lu(839) * lu(1065) + lu(1108) = lu(1108) - lu(818) * lu(1107) + lu(1109) = lu(1109) - lu(819) * lu(1107) + lu(1110) = lu(1110) - lu(820) * lu(1107) + lu(1111) = lu(1111) - lu(821) * lu(1107) + lu(1112) = lu(1112) - lu(822) * lu(1107) + lu(1113) = lu(1113) - lu(823) * lu(1107) + lu(1114) = lu(1114) - lu(824) * lu(1107) + lu(1115) = lu(1115) - lu(825) * lu(1107) + lu(1116) = lu(1116) - lu(826) * lu(1107) + lu(1117) = lu(1117) - lu(827) * lu(1107) + lu(1118) = lu(1118) - lu(828) * lu(1107) + lu(1119) = lu(1119) - lu(829) * lu(1107) + lu(1120) = lu(1120) - lu(830) * lu(1107) + lu(1121) = lu(1121) - lu(831) * lu(1107) + lu(1122) = lu(1122) - lu(832) * lu(1107) + lu(1123) = lu(1123) - lu(833) * lu(1107) + lu(1124) = lu(1124) - lu(834) * lu(1107) + lu(1125) = lu(1125) - lu(835) * lu(1107) + lu(1126) = lu(1126) - lu(836) * lu(1107) + lu(1127) = lu(1127) - lu(837) * lu(1107) + lu(1128) = lu(1128) - lu(838) * lu(1107) + lu(1129) = lu(1129) - lu(839) * lu(1107) + lu(1151) = lu(1151) - lu(818) * lu(1150) + lu(1152) = lu(1152) - lu(819) * lu(1150) + lu(1153) = lu(1153) - lu(820) * lu(1150) + lu(1154) = lu(1154) - lu(821) * lu(1150) + lu(1155) = lu(1155) - lu(822) * lu(1150) + lu(1156) = lu(1156) - lu(823) * lu(1150) + lu(1157) = lu(1157) - lu(824) * lu(1150) + lu(1158) = lu(1158) - lu(825) * lu(1150) + lu(1159) = lu(1159) - lu(826) * lu(1150) + lu(1160) = lu(1160) - lu(827) * lu(1150) + lu(1161) = lu(1161) - lu(828) * lu(1150) + lu(1162) = lu(1162) - lu(829) * lu(1150) + lu(1163) = lu(1163) - lu(830) * lu(1150) + lu(1164) = lu(1164) - lu(831) * lu(1150) + lu(1165) = lu(1165) - lu(832) * lu(1150) + lu(1166) = lu(1166) - lu(833) * lu(1150) + lu(1167) = lu(1167) - lu(834) * lu(1150) + lu(1168) = lu(1168) - lu(835) * lu(1150) + lu(1169) = lu(1169) - lu(836) * lu(1150) + lu(1170) = lu(1170) - lu(837) * lu(1150) + lu(1171) = lu(1171) - lu(838) * lu(1150) + lu(1172) = lu(1172) - lu(839) * lu(1150) + lu(1193) = lu(1193) - lu(818) * lu(1192) + lu(1194) = lu(1194) - lu(819) * lu(1192) + lu(1195) = lu(1195) - lu(820) * lu(1192) + lu(1196) = lu(1196) - lu(821) * lu(1192) + lu(1197) = lu(1197) - lu(822) * lu(1192) + lu(1198) = lu(1198) - lu(823) * lu(1192) + lu(1199) = lu(1199) - lu(824) * lu(1192) + lu(1200) = lu(1200) - lu(825) * lu(1192) + lu(1201) = lu(1201) - lu(826) * lu(1192) + lu(1202) = lu(1202) - lu(827) * lu(1192) + lu(1203) = lu(1203) - lu(828) * lu(1192) + lu(1204) = lu(1204) - lu(829) * lu(1192) + lu(1205) = lu(1205) - lu(830) * lu(1192) + lu(1206) = lu(1206) - lu(831) * lu(1192) + lu(1207) = lu(1207) - lu(832) * lu(1192) + lu(1208) = lu(1208) - lu(833) * lu(1192) + lu(1209) = lu(1209) - lu(834) * lu(1192) + lu(1210) = lu(1210) - lu(835) * lu(1192) + lu(1211) = lu(1211) - lu(836) * lu(1192) + lu(1212) = lu(1212) - lu(837) * lu(1192) + lu(1213) = lu(1213) - lu(838) * lu(1192) + lu(1214) = lu(1214) - lu(839) * lu(1192) + lu(1228) = lu(1228) - lu(818) * lu(1227) + lu(1229) = lu(1229) - lu(819) * lu(1227) + lu(1230) = lu(1230) - lu(820) * lu(1227) + lu(1231) = lu(1231) - lu(821) * lu(1227) + lu(1232) = lu(1232) - lu(822) * lu(1227) + lu(1233) = lu(1233) - lu(823) * lu(1227) + lu(1234) = lu(1234) - lu(824) * lu(1227) + lu(1235) = lu(1235) - lu(825) * lu(1227) + lu(1236) = lu(1236) - lu(826) * lu(1227) + lu(1237) = lu(1237) - lu(827) * lu(1227) + lu(1238) = lu(1238) - lu(828) * lu(1227) + lu(1239) = lu(1239) - lu(829) * lu(1227) + lu(1240) = lu(1240) - lu(830) * lu(1227) + lu(1241) = lu(1241) - lu(831) * lu(1227) + lu(1242) = lu(1242) - lu(832) * lu(1227) + lu(1243) = lu(1243) - lu(833) * lu(1227) + lu(1244) = lu(1244) - lu(834) * lu(1227) + lu(1245) = lu(1245) - lu(835) * lu(1227) + lu(1246) = lu(1246) - lu(836) * lu(1227) + lu(1247) = lu(1247) - lu(837) * lu(1227) + lu(1248) = lu(1248) - lu(838) * lu(1227) + lu(1249) = lu(1249) - lu(839) * lu(1227) + lu(1272) = lu(1272) - lu(818) * lu(1271) + lu(1273) = lu(1273) - lu(819) * lu(1271) + lu(1274) = lu(1274) - lu(820) * lu(1271) + lu(1275) = lu(1275) - lu(821) * lu(1271) + lu(1276) = lu(1276) - lu(822) * lu(1271) + lu(1277) = lu(1277) - lu(823) * lu(1271) + lu(1278) = lu(1278) - lu(824) * lu(1271) + lu(1279) = lu(1279) - lu(825) * lu(1271) + lu(1280) = lu(1280) - lu(826) * lu(1271) + lu(1281) = lu(1281) - lu(827) * lu(1271) + lu(1282) = lu(1282) - lu(828) * lu(1271) + lu(1283) = lu(1283) - lu(829) * lu(1271) + lu(1284) = lu(1284) - lu(830) * lu(1271) + lu(1285) = lu(1285) - lu(831) * lu(1271) + lu(1286) = lu(1286) - lu(832) * lu(1271) + lu(1287) = lu(1287) - lu(833) * lu(1271) + lu(1288) = lu(1288) - lu(834) * lu(1271) + lu(1289) = lu(1289) - lu(835) * lu(1271) + lu(1290) = lu(1290) - lu(836) * lu(1271) + lu(1291) = lu(1291) - lu(837) * lu(1271) + lu(1292) = lu(1292) - lu(838) * lu(1271) + lu(1293) = lu(1293) - lu(839) * lu(1271) + lu(1313) = lu(1313) - lu(818) * lu(1312) + lu(1314) = lu(1314) - lu(819) * lu(1312) + lu(1315) = lu(1315) - lu(820) * lu(1312) + lu(1316) = lu(1316) - lu(821) * lu(1312) + lu(1317) = lu(1317) - lu(822) * lu(1312) + lu(1318) = lu(1318) - lu(823) * lu(1312) + lu(1319) = lu(1319) - lu(824) * lu(1312) + lu(1320) = lu(1320) - lu(825) * lu(1312) + lu(1321) = lu(1321) - lu(826) * lu(1312) + lu(1322) = lu(1322) - lu(827) * lu(1312) + lu(1323) = lu(1323) - lu(828) * lu(1312) + lu(1324) = lu(1324) - lu(829) * lu(1312) + lu(1325) = lu(1325) - lu(830) * lu(1312) + lu(1326) = lu(1326) - lu(831) * lu(1312) + lu(1327) = lu(1327) - lu(832) * lu(1312) + lu(1328) = lu(1328) - lu(833) * lu(1312) + lu(1329) = lu(1329) - lu(834) * lu(1312) + lu(1330) = lu(1330) - lu(835) * lu(1312) + lu(1331) = lu(1331) - lu(836) * lu(1312) + lu(1332) = lu(1332) - lu(837) * lu(1312) + lu(1333) = lu(1333) - lu(838) * lu(1312) + lu(1334) = lu(1334) - lu(839) * lu(1312) + lu(1355) = lu(1355) - lu(818) * lu(1354) + lu(1356) = lu(1356) - lu(819) * lu(1354) + lu(1357) = lu(1357) - lu(820) * lu(1354) + lu(1358) = lu(1358) - lu(821) * lu(1354) + lu(1359) = lu(1359) - lu(822) * lu(1354) + lu(1360) = lu(1360) - lu(823) * lu(1354) + lu(1361) = lu(1361) - lu(824) * lu(1354) + lu(1362) = lu(1362) - lu(825) * lu(1354) + lu(1363) = lu(1363) - lu(826) * lu(1354) + lu(1364) = lu(1364) - lu(827) * lu(1354) + lu(1365) = lu(1365) - lu(828) * lu(1354) + lu(1366) = lu(1366) - lu(829) * lu(1354) + lu(1367) = lu(1367) - lu(830) * lu(1354) + lu(1368) = lu(1368) - lu(831) * lu(1354) + lu(1369) = lu(1369) - lu(832) * lu(1354) + lu(1370) = lu(1370) - lu(833) * lu(1354) + lu(1371) = lu(1371) - lu(834) * lu(1354) + lu(1372) = lu(1372) - lu(835) * lu(1354) + lu(1373) = lu(1373) - lu(836) * lu(1354) + lu(1374) = lu(1374) - lu(837) * lu(1354) + lu(1375) = lu(1375) - lu(838) * lu(1354) + lu(1376) = lu(1376) - lu(839) * lu(1354) + lu(1397) = lu(1397) - lu(818) * lu(1396) + lu(1398) = lu(1398) - lu(819) * lu(1396) + lu(1399) = lu(1399) - lu(820) * lu(1396) + lu(1400) = lu(1400) - lu(821) * lu(1396) + lu(1401) = lu(1401) - lu(822) * lu(1396) + lu(1402) = lu(1402) - lu(823) * lu(1396) + lu(1403) = lu(1403) - lu(824) * lu(1396) + lu(1404) = lu(1404) - lu(825) * lu(1396) + lu(1405) = lu(1405) - lu(826) * lu(1396) + lu(1406) = lu(1406) - lu(827) * lu(1396) + lu(1407) = lu(1407) - lu(828) * lu(1396) + lu(1408) = lu(1408) - lu(829) * lu(1396) + lu(1409) = lu(1409) - lu(830) * lu(1396) + lu(1410) = lu(1410) - lu(831) * lu(1396) + lu(1411) = lu(1411) - lu(832) * lu(1396) + lu(1412) = lu(1412) - lu(833) * lu(1396) + lu(1413) = lu(1413) - lu(834) * lu(1396) + lu(1414) = lu(1414) - lu(835) * lu(1396) + lu(1415) = lu(1415) - lu(836) * lu(1396) + lu(1416) = lu(1416) - lu(837) * lu(1396) + lu(1417) = lu(1417) - lu(838) * lu(1396) + lu(1418) = lu(1418) - lu(839) * lu(1396) + lu(1439) = lu(1439) - lu(818) * lu(1438) + lu(1440) = lu(1440) - lu(819) * lu(1438) + lu(1441) = lu(1441) - lu(820) * lu(1438) + lu(1442) = lu(1442) - lu(821) * lu(1438) + lu(1443) = lu(1443) - lu(822) * lu(1438) + lu(1444) = lu(1444) - lu(823) * lu(1438) + lu(1445) = lu(1445) - lu(824) * lu(1438) + lu(1446) = lu(1446) - lu(825) * lu(1438) + lu(1447) = lu(1447) - lu(826) * lu(1438) + lu(1448) = lu(1448) - lu(827) * lu(1438) + lu(1449) = lu(1449) - lu(828) * lu(1438) + lu(1450) = lu(1450) - lu(829) * lu(1438) + lu(1451) = lu(1451) - lu(830) * lu(1438) + lu(1452) = lu(1452) - lu(831) * lu(1438) + lu(1453) = lu(1453) - lu(832) * lu(1438) + lu(1454) = lu(1454) - lu(833) * lu(1438) + lu(1455) = lu(1455) - lu(834) * lu(1438) + lu(1456) = lu(1456) - lu(835) * lu(1438) + lu(1457) = lu(1457) - lu(836) * lu(1438) + lu(1458) = lu(1458) - lu(837) * lu(1438) + lu(1459) = lu(1459) - lu(838) * lu(1438) + lu(1460) = lu(1460) - lu(839) * lu(1438) + lu(1494) = lu(1494) - lu(818) * lu(1493) + lu(1495) = lu(1495) - lu(819) * lu(1493) + lu(1496) = lu(1496) - lu(820) * lu(1493) + lu(1497) = lu(1497) - lu(821) * lu(1493) + lu(1498) = lu(1498) - lu(822) * lu(1493) + lu(1499) = lu(1499) - lu(823) * lu(1493) + lu(1500) = lu(1500) - lu(824) * lu(1493) + lu(1501) = lu(1501) - lu(825) * lu(1493) + lu(1502) = lu(1502) - lu(826) * lu(1493) + lu(1503) = lu(1503) - lu(827) * lu(1493) + lu(1504) = lu(1504) - lu(828) * lu(1493) + lu(1505) = lu(1505) - lu(829) * lu(1493) + lu(1506) = lu(1506) - lu(830) * lu(1493) + lu(1507) = lu(1507) - lu(831) * lu(1493) + lu(1508) = lu(1508) - lu(832) * lu(1493) + lu(1509) = lu(1509) - lu(833) * lu(1493) + lu(1510) = lu(1510) - lu(834) * lu(1493) + lu(1511) = lu(1511) - lu(835) * lu(1493) + lu(1512) = lu(1512) - lu(836) * lu(1493) + lu(1513) = lu(1513) - lu(837) * lu(1493) + lu(1514) = lu(1514) - lu(838) * lu(1493) + lu(1515) = lu(1515) - lu(839) * lu(1493) + lu(1526) = lu(1526) - lu(818) * lu(1525) + lu(1527) = lu(1527) - lu(819) * lu(1525) + lu(1528) = lu(1528) - lu(820) * lu(1525) + lu(1529) = lu(1529) - lu(821) * lu(1525) + lu(1530) = lu(1530) - lu(822) * lu(1525) + lu(1531) = lu(1531) - lu(823) * lu(1525) + lu(1532) = lu(1532) - lu(824) * lu(1525) + lu(1533) = lu(1533) - lu(825) * lu(1525) + lu(1534) = lu(1534) - lu(826) * lu(1525) + lu(1535) = lu(1535) - lu(827) * lu(1525) + lu(1536) = lu(1536) - lu(828) * lu(1525) + lu(1537) = lu(1537) - lu(829) * lu(1525) + lu(1538) = lu(1538) - lu(830) * lu(1525) + lu(1539) = lu(1539) - lu(831) * lu(1525) + lu(1540) = lu(1540) - lu(832) * lu(1525) + lu(1541) = lu(1541) - lu(833) * lu(1525) + lu(1542) = lu(1542) - lu(834) * lu(1525) + lu(1543) = lu(1543) - lu(835) * lu(1525) + lu(1544) = lu(1544) - lu(836) * lu(1525) + lu(1545) = lu(1545) - lu(837) * lu(1525) + lu(1546) = lu(1546) - lu(838) * lu(1525) + lu(1547) = lu(1547) - lu(839) * lu(1525) + lu(1561) = lu(1561) - lu(818) * lu(1560) + lu(1562) = lu(1562) - lu(819) * lu(1560) + lu(1563) = lu(1563) - lu(820) * lu(1560) + lu(1564) = lu(1564) - lu(821) * lu(1560) + lu(1565) = lu(1565) - lu(822) * lu(1560) + lu(1566) = lu(1566) - lu(823) * lu(1560) + lu(1567) = lu(1567) - lu(824) * lu(1560) + lu(1568) = lu(1568) - lu(825) * lu(1560) + lu(1569) = lu(1569) - lu(826) * lu(1560) + lu(1570) = lu(1570) - lu(827) * lu(1560) + lu(1571) = lu(1571) - lu(828) * lu(1560) + lu(1572) = lu(1572) - lu(829) * lu(1560) + lu(1573) = lu(1573) - lu(830) * lu(1560) + lu(1574) = lu(1574) - lu(831) * lu(1560) + lu(1575) = lu(1575) - lu(832) * lu(1560) + lu(1576) = lu(1576) - lu(833) * lu(1560) + lu(1577) = lu(1577) - lu(834) * lu(1560) + lu(1578) = lu(1578) - lu(835) * lu(1560) + lu(1579) = lu(1579) - lu(836) * lu(1560) + lu(1580) = lu(1580) - lu(837) * lu(1560) + lu(1581) = lu(1581) - lu(838) * lu(1560) + lu(1582) = lu(1582) - lu(839) * lu(1560) + lu(1599) = lu(1599) - lu(818) * lu(1598) + lu(1600) = lu(1600) - lu(819) * lu(1598) + lu(1601) = lu(1601) - lu(820) * lu(1598) + lu(1602) = lu(1602) - lu(821) * lu(1598) + lu(1603) = lu(1603) - lu(822) * lu(1598) + lu(1604) = lu(1604) - lu(823) * lu(1598) + lu(1605) = lu(1605) - lu(824) * lu(1598) + lu(1606) = lu(1606) - lu(825) * lu(1598) + lu(1607) = lu(1607) - lu(826) * lu(1598) + lu(1608) = lu(1608) - lu(827) * lu(1598) + lu(1609) = lu(1609) - lu(828) * lu(1598) + lu(1610) = lu(1610) - lu(829) * lu(1598) + lu(1611) = lu(1611) - lu(830) * lu(1598) + lu(1612) = lu(1612) - lu(831) * lu(1598) + lu(1613) = lu(1613) - lu(832) * lu(1598) + lu(1614) = lu(1614) - lu(833) * lu(1598) + lu(1615) = lu(1615) - lu(834) * lu(1598) + lu(1616) = lu(1616) - lu(835) * lu(1598) + lu(1617) = lu(1617) - lu(836) * lu(1598) + lu(1618) = lu(1618) - lu(837) * lu(1598) + lu(1619) = lu(1619) - lu(838) * lu(1598) + lu(1620) = lu(1620) - lu(839) * lu(1598) + lu(1638) = lu(1638) - lu(818) * lu(1637) + lu(1639) = lu(1639) - lu(819) * lu(1637) + lu(1640) = lu(1640) - lu(820) * lu(1637) + lu(1641) = lu(1641) - lu(821) * lu(1637) + lu(1642) = lu(1642) - lu(822) * lu(1637) + lu(1643) = lu(1643) - lu(823) * lu(1637) + lu(1644) = lu(1644) - lu(824) * lu(1637) + lu(1645) = lu(1645) - lu(825) * lu(1637) + lu(1646) = lu(1646) - lu(826) * lu(1637) + lu(1647) = lu(1647) - lu(827) * lu(1637) + lu(1648) = lu(1648) - lu(828) * lu(1637) + lu(1649) = lu(1649) - lu(829) * lu(1637) + lu(1650) = lu(1650) - lu(830) * lu(1637) + lu(1651) = lu(1651) - lu(831) * lu(1637) + lu(1652) = lu(1652) - lu(832) * lu(1637) + lu(1653) = lu(1653) - lu(833) * lu(1637) + lu(1654) = lu(1654) - lu(834) * lu(1637) + lu(1655) = lu(1655) - lu(835) * lu(1637) + lu(1656) = lu(1656) - lu(836) * lu(1637) + lu(1657) = lu(1657) - lu(837) * lu(1637) + lu(1658) = lu(1658) - lu(838) * lu(1637) + lu(1659) = lu(1659) - lu(839) * lu(1637) + lu(1672) = lu(1672) - lu(818) * lu(1671) + lu(1673) = lu(1673) - lu(819) * lu(1671) + lu(1674) = lu(1674) - lu(820) * lu(1671) + lu(1675) = lu(1675) - lu(821) * lu(1671) + lu(1676) = lu(1676) - lu(822) * lu(1671) + lu(1677) = lu(1677) - lu(823) * lu(1671) + lu(1678) = lu(1678) - lu(824) * lu(1671) + lu(1679) = lu(1679) - lu(825) * lu(1671) + lu(1680) = lu(1680) - lu(826) * lu(1671) + lu(1681) = lu(1681) - lu(827) * lu(1671) + lu(1682) = lu(1682) - lu(828) * lu(1671) + lu(1683) = lu(1683) - lu(829) * lu(1671) + lu(1684) = lu(1684) - lu(830) * lu(1671) + lu(1685) = lu(1685) - lu(831) * lu(1671) + lu(1686) = lu(1686) - lu(832) * lu(1671) + lu(1687) = lu(1687) - lu(833) * lu(1671) + lu(1688) = lu(1688) - lu(834) * lu(1671) + lu(1689) = lu(1689) - lu(835) * lu(1671) + lu(1690) = lu(1690) - lu(836) * lu(1671) + lu(1691) = lu(1691) - lu(837) * lu(1671) + lu(1692) = lu(1692) - lu(838) * lu(1671) + lu(1693) = lu(1693) - lu(839) * lu(1671) + lu(1724) = lu(1724) - lu(818) * lu(1723) + lu(1725) = lu(1725) - lu(819) * lu(1723) + lu(1726) = lu(1726) - lu(820) * lu(1723) + lu(1727) = lu(1727) - lu(821) * lu(1723) + lu(1728) = lu(1728) - lu(822) * lu(1723) + lu(1729) = lu(1729) - lu(823) * lu(1723) + lu(1730) = lu(1730) - lu(824) * lu(1723) + lu(1731) = lu(1731) - lu(825) * lu(1723) + lu(1732) = lu(1732) - lu(826) * lu(1723) + lu(1733) = lu(1733) - lu(827) * lu(1723) + lu(1734) = lu(1734) - lu(828) * lu(1723) + lu(1735) = lu(1735) - lu(829) * lu(1723) + lu(1736) = lu(1736) - lu(830) * lu(1723) + lu(1737) = lu(1737) - lu(831) * lu(1723) + lu(1738) = lu(1738) - lu(832) * lu(1723) + lu(1739) = lu(1739) - lu(833) * lu(1723) + lu(1740) = lu(1740) - lu(834) * lu(1723) + lu(1741) = lu(1741) - lu(835) * lu(1723) + lu(1742) = lu(1742) - lu(836) * lu(1723) + lu(1743) = lu(1743) - lu(837) * lu(1723) + lu(1744) = lu(1744) - lu(838) * lu(1723) + lu(1745) = lu(1745) - lu(839) * lu(1723) + lu(860) = 1._r8 / lu(860) + lu(861) = lu(861) * lu(860) + lu(862) = lu(862) * lu(860) + lu(863) = lu(863) * lu(860) + lu(864) = lu(864) * lu(860) + lu(865) = lu(865) * lu(860) + lu(866) = lu(866) * lu(860) + lu(867) = lu(867) * lu(860) + lu(868) = lu(868) * lu(860) + lu(869) = lu(869) * lu(860) + lu(870) = lu(870) * lu(860) + lu(871) = lu(871) * lu(860) + lu(872) = lu(872) * lu(860) + lu(873) = lu(873) * lu(860) + lu(874) = lu(874) * lu(860) + lu(875) = lu(875) * lu(860) + lu(876) = lu(876) * lu(860) + lu(877) = lu(877) * lu(860) + lu(878) = lu(878) * lu(860) + lu(879) = lu(879) * lu(860) + lu(880) = lu(880) * lu(860) + lu(881) = lu(881) * lu(860) + lu(905) = lu(905) - lu(861) * lu(904) + lu(906) = lu(906) - lu(862) * lu(904) + lu(907) = lu(907) - lu(863) * lu(904) + lu(908) = lu(908) - lu(864) * lu(904) + lu(909) = lu(909) - lu(865) * lu(904) + lu(910) = lu(910) - lu(866) * lu(904) + lu(911) = lu(911) - lu(867) * lu(904) + lu(912) = lu(912) - lu(868) * lu(904) + lu(913) = lu(913) - lu(869) * lu(904) + lu(914) = lu(914) - lu(870) * lu(904) + lu(915) = lu(915) - lu(871) * lu(904) + lu(916) = lu(916) - lu(872) * lu(904) + lu(917) = lu(917) - lu(873) * lu(904) + lu(918) = lu(918) - lu(874) * lu(904) + lu(919) = lu(919) - lu(875) * lu(904) + lu(920) = lu(920) - lu(876) * lu(904) + lu(921) = lu(921) - lu(877) * lu(904) + lu(922) = lu(922) - lu(878) * lu(904) + lu(923) = lu(923) - lu(879) * lu(904) + lu(924) = lu(924) - lu(880) * lu(904) + lu(925) = lu(925) - lu(881) * lu(904) + lu(940) = lu(940) - lu(861) * lu(939) + lu(941) = lu(941) - lu(862) * lu(939) + lu(942) = lu(942) - lu(863) * lu(939) + lu(943) = lu(943) - lu(864) * lu(939) + lu(944) = lu(944) - lu(865) * lu(939) + lu(945) = lu(945) - lu(866) * lu(939) + lu(946) = lu(946) - lu(867) * lu(939) + lu(947) = lu(947) - lu(868) * lu(939) + lu(948) = lu(948) - lu(869) * lu(939) + lu(949) = lu(949) - lu(870) * lu(939) + lu(950) = lu(950) - lu(871) * lu(939) + lu(951) = lu(951) - lu(872) * lu(939) + lu(952) = lu(952) - lu(873) * lu(939) + lu(953) = lu(953) - lu(874) * lu(939) + lu(954) = lu(954) - lu(875) * lu(939) + lu(955) = lu(955) - lu(876) * lu(939) + lu(956) = lu(956) - lu(877) * lu(939) + lu(957) = lu(957) - lu(878) * lu(939) + lu(958) = lu(958) - lu(879) * lu(939) + lu(959) = lu(959) - lu(880) * lu(939) + lu(960) = lu(960) - lu(881) * lu(939) + lu(981) = lu(981) - lu(861) * lu(980) + lu(982) = lu(982) - lu(862) * lu(980) + lu(983) = lu(983) - lu(863) * lu(980) + lu(984) = lu(984) - lu(864) * lu(980) + lu(985) = lu(985) - lu(865) * lu(980) + lu(986) = lu(986) - lu(866) * lu(980) + lu(987) = lu(987) - lu(867) * lu(980) + lu(988) = lu(988) - lu(868) * lu(980) + lu(989) = lu(989) - lu(869) * lu(980) + lu(990) = lu(990) - lu(870) * lu(980) + lu(991) = lu(991) - lu(871) * lu(980) + lu(992) = lu(992) - lu(872) * lu(980) + lu(993) = lu(993) - lu(873) * lu(980) + lu(994) = lu(994) - lu(874) * lu(980) + lu(995) = lu(995) - lu(875) * lu(980) + lu(996) = lu(996) - lu(876) * lu(980) + lu(997) = lu(997) - lu(877) * lu(980) + lu(998) = lu(998) - lu(878) * lu(980) + lu(999) = lu(999) - lu(879) * lu(980) + lu(1000) = lu(1000) - lu(880) * lu(980) + lu(1001) = lu(1001) - lu(881) * lu(980) + lu(1023) = lu(1023) - lu(861) * lu(1022) + lu(1024) = lu(1024) - lu(862) * lu(1022) + lu(1025) = lu(1025) - lu(863) * lu(1022) + lu(1026) = lu(1026) - lu(864) * lu(1022) + lu(1027) = lu(1027) - lu(865) * lu(1022) + lu(1028) = lu(1028) - lu(866) * lu(1022) + lu(1029) = lu(1029) - lu(867) * lu(1022) + lu(1030) = lu(1030) - lu(868) * lu(1022) + lu(1031) = lu(1031) - lu(869) * lu(1022) + lu(1032) = lu(1032) - lu(870) * lu(1022) + lu(1033) = lu(1033) - lu(871) * lu(1022) + lu(1034) = lu(1034) - lu(872) * lu(1022) + lu(1035) = lu(1035) - lu(873) * lu(1022) + lu(1036) = lu(1036) - lu(874) * lu(1022) + lu(1037) = lu(1037) - lu(875) * lu(1022) + lu(1038) = lu(1038) - lu(876) * lu(1022) + lu(1039) = lu(1039) - lu(877) * lu(1022) + lu(1040) = lu(1040) - lu(878) * lu(1022) + lu(1041) = lu(1041) - lu(879) * lu(1022) + lu(1042) = lu(1042) - lu(880) * lu(1022) + lu(1043) = lu(1043) - lu(881) * lu(1022) + lu(1067) = lu(1067) - lu(861) * lu(1066) + lu(1068) = lu(1068) - lu(862) * lu(1066) + lu(1069) = lu(1069) - lu(863) * lu(1066) + lu(1070) = lu(1070) - lu(864) * lu(1066) + lu(1071) = lu(1071) - lu(865) * lu(1066) + lu(1072) = lu(1072) - lu(866) * lu(1066) + lu(1073) = lu(1073) - lu(867) * lu(1066) + lu(1074) = lu(1074) - lu(868) * lu(1066) + lu(1075) = lu(1075) - lu(869) * lu(1066) + lu(1076) = lu(1076) - lu(870) * lu(1066) + lu(1077) = lu(1077) - lu(871) * lu(1066) + lu(1078) = lu(1078) - lu(872) * lu(1066) + lu(1079) = lu(1079) - lu(873) * lu(1066) + lu(1080) = lu(1080) - lu(874) * lu(1066) + lu(1081) = lu(1081) - lu(875) * lu(1066) + lu(1082) = lu(1082) - lu(876) * lu(1066) + lu(1083) = lu(1083) - lu(877) * lu(1066) + lu(1084) = lu(1084) - lu(878) * lu(1066) + lu(1085) = lu(1085) - lu(879) * lu(1066) + lu(1086) = lu(1086) - lu(880) * lu(1066) + lu(1087) = lu(1087) - lu(881) * lu(1066) + lu(1109) = lu(1109) - lu(861) * lu(1108) + lu(1110) = lu(1110) - lu(862) * lu(1108) + lu(1111) = lu(1111) - lu(863) * lu(1108) + lu(1112) = lu(1112) - lu(864) * lu(1108) + lu(1113) = lu(1113) - lu(865) * lu(1108) + lu(1114) = lu(1114) - lu(866) * lu(1108) + lu(1115) = lu(1115) - lu(867) * lu(1108) + lu(1116) = lu(1116) - lu(868) * lu(1108) + lu(1117) = lu(1117) - lu(869) * lu(1108) + lu(1118) = lu(1118) - lu(870) * lu(1108) + lu(1119) = lu(1119) - lu(871) * lu(1108) + lu(1120) = lu(1120) - lu(872) * lu(1108) + lu(1121) = lu(1121) - lu(873) * lu(1108) + lu(1122) = lu(1122) - lu(874) * lu(1108) + lu(1123) = lu(1123) - lu(875) * lu(1108) + lu(1124) = lu(1124) - lu(876) * lu(1108) + lu(1125) = lu(1125) - lu(877) * lu(1108) + lu(1126) = lu(1126) - lu(878) * lu(1108) + lu(1127) = lu(1127) - lu(879) * lu(1108) + lu(1128) = lu(1128) - lu(880) * lu(1108) + lu(1129) = lu(1129) - lu(881) * lu(1108) + lu(1152) = lu(1152) - lu(861) * lu(1151) + lu(1153) = lu(1153) - lu(862) * lu(1151) + lu(1154) = lu(1154) - lu(863) * lu(1151) + lu(1155) = lu(1155) - lu(864) * lu(1151) + lu(1156) = lu(1156) - lu(865) * lu(1151) + lu(1157) = lu(1157) - lu(866) * lu(1151) + lu(1158) = lu(1158) - lu(867) * lu(1151) + lu(1159) = lu(1159) - lu(868) * lu(1151) + lu(1160) = lu(1160) - lu(869) * lu(1151) + lu(1161) = lu(1161) - lu(870) * lu(1151) + lu(1162) = lu(1162) - lu(871) * lu(1151) + lu(1163) = lu(1163) - lu(872) * lu(1151) + lu(1164) = lu(1164) - lu(873) * lu(1151) + lu(1165) = lu(1165) - lu(874) * lu(1151) + lu(1166) = lu(1166) - lu(875) * lu(1151) + lu(1167) = lu(1167) - lu(876) * lu(1151) + lu(1168) = lu(1168) - lu(877) * lu(1151) + lu(1169) = lu(1169) - lu(878) * lu(1151) + lu(1170) = lu(1170) - lu(879) * lu(1151) + lu(1171) = lu(1171) - lu(880) * lu(1151) + lu(1172) = lu(1172) - lu(881) * lu(1151) + lu(1194) = lu(1194) - lu(861) * lu(1193) + lu(1195) = lu(1195) - lu(862) * lu(1193) + lu(1196) = lu(1196) - lu(863) * lu(1193) + lu(1197) = lu(1197) - lu(864) * lu(1193) + lu(1198) = lu(1198) - lu(865) * lu(1193) + lu(1199) = lu(1199) - lu(866) * lu(1193) + lu(1200) = lu(1200) - lu(867) * lu(1193) + lu(1201) = lu(1201) - lu(868) * lu(1193) + lu(1202) = lu(1202) - lu(869) * lu(1193) + lu(1203) = lu(1203) - lu(870) * lu(1193) + lu(1204) = lu(1204) - lu(871) * lu(1193) + lu(1205) = lu(1205) - lu(872) * lu(1193) + lu(1206) = lu(1206) - lu(873) * lu(1193) + lu(1207) = lu(1207) - lu(874) * lu(1193) + lu(1208) = lu(1208) - lu(875) * lu(1193) + lu(1209) = lu(1209) - lu(876) * lu(1193) + lu(1210) = lu(1210) - lu(877) * lu(1193) + lu(1211) = lu(1211) - lu(878) * lu(1193) + lu(1212) = lu(1212) - lu(879) * lu(1193) + lu(1213) = lu(1213) - lu(880) * lu(1193) + lu(1214) = lu(1214) - lu(881) * lu(1193) + lu(1229) = lu(1229) - lu(861) * lu(1228) + lu(1230) = lu(1230) - lu(862) * lu(1228) + lu(1231) = lu(1231) - lu(863) * lu(1228) + lu(1232) = lu(1232) - lu(864) * lu(1228) + lu(1233) = lu(1233) - lu(865) * lu(1228) + lu(1234) = lu(1234) - lu(866) * lu(1228) + lu(1235) = lu(1235) - lu(867) * lu(1228) + lu(1236) = lu(1236) - lu(868) * lu(1228) + lu(1237) = lu(1237) - lu(869) * lu(1228) + lu(1238) = lu(1238) - lu(870) * lu(1228) + lu(1239) = lu(1239) - lu(871) * lu(1228) + lu(1240) = lu(1240) - lu(872) * lu(1228) + lu(1241) = lu(1241) - lu(873) * lu(1228) + lu(1242) = lu(1242) - lu(874) * lu(1228) + lu(1243) = lu(1243) - lu(875) * lu(1228) + lu(1244) = lu(1244) - lu(876) * lu(1228) + lu(1245) = lu(1245) - lu(877) * lu(1228) + lu(1246) = lu(1246) - lu(878) * lu(1228) + lu(1247) = lu(1247) - lu(879) * lu(1228) + lu(1248) = lu(1248) - lu(880) * lu(1228) + lu(1249) = lu(1249) - lu(881) * lu(1228) + lu(1273) = lu(1273) - lu(861) * lu(1272) + lu(1274) = lu(1274) - lu(862) * lu(1272) + lu(1275) = lu(1275) - lu(863) * lu(1272) + lu(1276) = lu(1276) - lu(864) * lu(1272) + lu(1277) = lu(1277) - lu(865) * lu(1272) + lu(1278) = lu(1278) - lu(866) * lu(1272) + lu(1279) = lu(1279) - lu(867) * lu(1272) + lu(1280) = lu(1280) - lu(868) * lu(1272) + lu(1281) = lu(1281) - lu(869) * lu(1272) + lu(1282) = lu(1282) - lu(870) * lu(1272) + lu(1283) = lu(1283) - lu(871) * lu(1272) + lu(1284) = lu(1284) - lu(872) * lu(1272) + lu(1285) = lu(1285) - lu(873) * lu(1272) + lu(1286) = lu(1286) - lu(874) * lu(1272) + lu(1287) = lu(1287) - lu(875) * lu(1272) + lu(1288) = lu(1288) - lu(876) * lu(1272) + lu(1289) = lu(1289) - lu(877) * lu(1272) + lu(1290) = lu(1290) - lu(878) * lu(1272) + lu(1291) = lu(1291) - lu(879) * lu(1272) + lu(1292) = lu(1292) - lu(880) * lu(1272) + lu(1293) = lu(1293) - lu(881) * lu(1272) + lu(1314) = lu(1314) - lu(861) * lu(1313) + lu(1315) = lu(1315) - lu(862) * lu(1313) + lu(1316) = lu(1316) - lu(863) * lu(1313) + lu(1317) = lu(1317) - lu(864) * lu(1313) + lu(1318) = lu(1318) - lu(865) * lu(1313) + lu(1319) = lu(1319) - lu(866) * lu(1313) + lu(1320) = lu(1320) - lu(867) * lu(1313) + lu(1321) = lu(1321) - lu(868) * lu(1313) + lu(1322) = lu(1322) - lu(869) * lu(1313) + lu(1323) = lu(1323) - lu(870) * lu(1313) + lu(1324) = lu(1324) - lu(871) * lu(1313) + lu(1325) = lu(1325) - lu(872) * lu(1313) + lu(1326) = lu(1326) - lu(873) * lu(1313) + lu(1327) = lu(1327) - lu(874) * lu(1313) + lu(1328) = lu(1328) - lu(875) * lu(1313) + lu(1329) = lu(1329) - lu(876) * lu(1313) + lu(1330) = lu(1330) - lu(877) * lu(1313) + lu(1331) = lu(1331) - lu(878) * lu(1313) + lu(1332) = lu(1332) - lu(879) * lu(1313) + lu(1333) = lu(1333) - lu(880) * lu(1313) + lu(1334) = lu(1334) - lu(881) * lu(1313) + lu(1356) = lu(1356) - lu(861) * lu(1355) + lu(1357) = lu(1357) - lu(862) * lu(1355) + lu(1358) = lu(1358) - lu(863) * lu(1355) + lu(1359) = lu(1359) - lu(864) * lu(1355) + lu(1360) = lu(1360) - lu(865) * lu(1355) + lu(1361) = lu(1361) - lu(866) * lu(1355) + lu(1362) = lu(1362) - lu(867) * lu(1355) + lu(1363) = lu(1363) - lu(868) * lu(1355) + lu(1364) = lu(1364) - lu(869) * lu(1355) + lu(1365) = lu(1365) - lu(870) * lu(1355) + lu(1366) = lu(1366) - lu(871) * lu(1355) + lu(1367) = lu(1367) - lu(872) * lu(1355) + lu(1368) = lu(1368) - lu(873) * lu(1355) + lu(1369) = lu(1369) - lu(874) * lu(1355) + lu(1370) = lu(1370) - lu(875) * lu(1355) + lu(1371) = lu(1371) - lu(876) * lu(1355) + lu(1372) = lu(1372) - lu(877) * lu(1355) + lu(1373) = lu(1373) - lu(878) * lu(1355) + lu(1374) = lu(1374) - lu(879) * lu(1355) + lu(1375) = lu(1375) - lu(880) * lu(1355) + lu(1376) = lu(1376) - lu(881) * lu(1355) + lu(1398) = lu(1398) - lu(861) * lu(1397) + lu(1399) = lu(1399) - lu(862) * lu(1397) + lu(1400) = lu(1400) - lu(863) * lu(1397) + lu(1401) = lu(1401) - lu(864) * lu(1397) + lu(1402) = lu(1402) - lu(865) * lu(1397) + lu(1403) = lu(1403) - lu(866) * lu(1397) + lu(1404) = lu(1404) - lu(867) * lu(1397) + lu(1405) = lu(1405) - lu(868) * lu(1397) + lu(1406) = lu(1406) - lu(869) * lu(1397) + lu(1407) = lu(1407) - lu(870) * lu(1397) + lu(1408) = lu(1408) - lu(871) * lu(1397) + lu(1409) = lu(1409) - lu(872) * lu(1397) + lu(1410) = lu(1410) - lu(873) * lu(1397) + lu(1411) = lu(1411) - lu(874) * lu(1397) + lu(1412) = lu(1412) - lu(875) * lu(1397) + lu(1413) = lu(1413) - lu(876) * lu(1397) + lu(1414) = lu(1414) - lu(877) * lu(1397) + lu(1415) = lu(1415) - lu(878) * lu(1397) + lu(1416) = lu(1416) - lu(879) * lu(1397) + lu(1417) = lu(1417) - lu(880) * lu(1397) + lu(1418) = lu(1418) - lu(881) * lu(1397) + lu(1440) = lu(1440) - lu(861) * lu(1439) + lu(1441) = lu(1441) - lu(862) * lu(1439) + lu(1442) = lu(1442) - lu(863) * lu(1439) + lu(1443) = lu(1443) - lu(864) * lu(1439) + lu(1444) = lu(1444) - lu(865) * lu(1439) + lu(1445) = lu(1445) - lu(866) * lu(1439) + lu(1446) = lu(1446) - lu(867) * lu(1439) + lu(1447) = lu(1447) - lu(868) * lu(1439) + lu(1448) = lu(1448) - lu(869) * lu(1439) + lu(1449) = lu(1449) - lu(870) * lu(1439) + lu(1450) = lu(1450) - lu(871) * lu(1439) + lu(1451) = lu(1451) - lu(872) * lu(1439) + lu(1452) = lu(1452) - lu(873) * lu(1439) + lu(1453) = lu(1453) - lu(874) * lu(1439) + lu(1454) = lu(1454) - lu(875) * lu(1439) + lu(1455) = lu(1455) - lu(876) * lu(1439) + lu(1456) = lu(1456) - lu(877) * lu(1439) + lu(1457) = lu(1457) - lu(878) * lu(1439) + lu(1458) = lu(1458) - lu(879) * lu(1439) + lu(1459) = lu(1459) - lu(880) * lu(1439) + lu(1460) = lu(1460) - lu(881) * lu(1439) + lu(1495) = lu(1495) - lu(861) * lu(1494) + lu(1496) = lu(1496) - lu(862) * lu(1494) + lu(1497) = lu(1497) - lu(863) * lu(1494) + lu(1498) = lu(1498) - lu(864) * lu(1494) + lu(1499) = lu(1499) - lu(865) * lu(1494) + lu(1500) = lu(1500) - lu(866) * lu(1494) + lu(1501) = lu(1501) - lu(867) * lu(1494) + lu(1502) = lu(1502) - lu(868) * lu(1494) + lu(1503) = lu(1503) - lu(869) * lu(1494) + lu(1504) = lu(1504) - lu(870) * lu(1494) + lu(1505) = lu(1505) - lu(871) * lu(1494) + lu(1506) = lu(1506) - lu(872) * lu(1494) + lu(1507) = lu(1507) - lu(873) * lu(1494) + lu(1508) = lu(1508) - lu(874) * lu(1494) + lu(1509) = lu(1509) - lu(875) * lu(1494) + lu(1510) = lu(1510) - lu(876) * lu(1494) + lu(1511) = lu(1511) - lu(877) * lu(1494) + lu(1512) = lu(1512) - lu(878) * lu(1494) + lu(1513) = lu(1513) - lu(879) * lu(1494) + lu(1514) = lu(1514) - lu(880) * lu(1494) + lu(1515) = lu(1515) - lu(881) * lu(1494) + lu(1527) = lu(1527) - lu(861) * lu(1526) + lu(1528) = lu(1528) - lu(862) * lu(1526) + lu(1529) = lu(1529) - lu(863) * lu(1526) + lu(1530) = lu(1530) - lu(864) * lu(1526) + lu(1531) = lu(1531) - lu(865) * lu(1526) + lu(1532) = lu(1532) - lu(866) * lu(1526) + lu(1533) = lu(1533) - lu(867) * lu(1526) + lu(1534) = lu(1534) - lu(868) * lu(1526) + lu(1535) = lu(1535) - lu(869) * lu(1526) + lu(1536) = lu(1536) - lu(870) * lu(1526) + lu(1537) = lu(1537) - lu(871) * lu(1526) + lu(1538) = lu(1538) - lu(872) * lu(1526) + lu(1539) = lu(1539) - lu(873) * lu(1526) + lu(1540) = lu(1540) - lu(874) * lu(1526) + lu(1541) = lu(1541) - lu(875) * lu(1526) + lu(1542) = lu(1542) - lu(876) * lu(1526) + lu(1543) = lu(1543) - lu(877) * lu(1526) + lu(1544) = lu(1544) - lu(878) * lu(1526) + lu(1545) = lu(1545) - lu(879) * lu(1526) + lu(1546) = lu(1546) - lu(880) * lu(1526) + lu(1547) = lu(1547) - lu(881) * lu(1526) + lu(1562) = lu(1562) - lu(861) * lu(1561) + lu(1563) = lu(1563) - lu(862) * lu(1561) + lu(1564) = lu(1564) - lu(863) * lu(1561) + lu(1565) = lu(1565) - lu(864) * lu(1561) + lu(1566) = lu(1566) - lu(865) * lu(1561) + lu(1567) = lu(1567) - lu(866) * lu(1561) + lu(1568) = lu(1568) - lu(867) * lu(1561) + lu(1569) = lu(1569) - lu(868) * lu(1561) + lu(1570) = lu(1570) - lu(869) * lu(1561) + lu(1571) = lu(1571) - lu(870) * lu(1561) + lu(1572) = lu(1572) - lu(871) * lu(1561) + lu(1573) = lu(1573) - lu(872) * lu(1561) + lu(1574) = lu(1574) - lu(873) * lu(1561) + lu(1575) = lu(1575) - lu(874) * lu(1561) + lu(1576) = lu(1576) - lu(875) * lu(1561) + lu(1577) = lu(1577) - lu(876) * lu(1561) + lu(1578) = lu(1578) - lu(877) * lu(1561) + lu(1579) = lu(1579) - lu(878) * lu(1561) + lu(1580) = lu(1580) - lu(879) * lu(1561) + lu(1581) = lu(1581) - lu(880) * lu(1561) + lu(1582) = lu(1582) - lu(881) * lu(1561) + lu(1600) = lu(1600) - lu(861) * lu(1599) + lu(1601) = lu(1601) - lu(862) * lu(1599) + lu(1602) = lu(1602) - lu(863) * lu(1599) + lu(1603) = lu(1603) - lu(864) * lu(1599) + lu(1604) = lu(1604) - lu(865) * lu(1599) + lu(1605) = lu(1605) - lu(866) * lu(1599) + lu(1606) = lu(1606) - lu(867) * lu(1599) + lu(1607) = lu(1607) - lu(868) * lu(1599) + lu(1608) = lu(1608) - lu(869) * lu(1599) + lu(1609) = lu(1609) - lu(870) * lu(1599) + lu(1610) = lu(1610) - lu(871) * lu(1599) + lu(1611) = lu(1611) - lu(872) * lu(1599) + lu(1612) = lu(1612) - lu(873) * lu(1599) + lu(1613) = lu(1613) - lu(874) * lu(1599) + lu(1614) = lu(1614) - lu(875) * lu(1599) + lu(1615) = lu(1615) - lu(876) * lu(1599) + lu(1616) = lu(1616) - lu(877) * lu(1599) + lu(1617) = lu(1617) - lu(878) * lu(1599) + lu(1618) = lu(1618) - lu(879) * lu(1599) + lu(1619) = lu(1619) - lu(880) * lu(1599) + lu(1620) = lu(1620) - lu(881) * lu(1599) + lu(1639) = lu(1639) - lu(861) * lu(1638) + lu(1640) = lu(1640) - lu(862) * lu(1638) + lu(1641) = lu(1641) - lu(863) * lu(1638) + lu(1642) = lu(1642) - lu(864) * lu(1638) + lu(1643) = lu(1643) - lu(865) * lu(1638) + lu(1644) = lu(1644) - lu(866) * lu(1638) + lu(1645) = lu(1645) - lu(867) * lu(1638) + lu(1646) = lu(1646) - lu(868) * lu(1638) + lu(1647) = lu(1647) - lu(869) * lu(1638) + lu(1648) = lu(1648) - lu(870) * lu(1638) + lu(1649) = lu(1649) - lu(871) * lu(1638) + lu(1650) = lu(1650) - lu(872) * lu(1638) + lu(1651) = lu(1651) - lu(873) * lu(1638) + lu(1652) = lu(1652) - lu(874) * lu(1638) + lu(1653) = lu(1653) - lu(875) * lu(1638) + lu(1654) = lu(1654) - lu(876) * lu(1638) + lu(1655) = lu(1655) - lu(877) * lu(1638) + lu(1656) = lu(1656) - lu(878) * lu(1638) + lu(1657) = lu(1657) - lu(879) * lu(1638) + lu(1658) = lu(1658) - lu(880) * lu(1638) + lu(1659) = lu(1659) - lu(881) * lu(1638) + lu(1673) = lu(1673) - lu(861) * lu(1672) + lu(1674) = lu(1674) - lu(862) * lu(1672) + lu(1675) = lu(1675) - lu(863) * lu(1672) + lu(1676) = lu(1676) - lu(864) * lu(1672) + lu(1677) = lu(1677) - lu(865) * lu(1672) + lu(1678) = lu(1678) - lu(866) * lu(1672) + lu(1679) = lu(1679) - lu(867) * lu(1672) + lu(1680) = lu(1680) - lu(868) * lu(1672) + lu(1681) = lu(1681) - lu(869) * lu(1672) + lu(1682) = lu(1682) - lu(870) * lu(1672) + lu(1683) = lu(1683) - lu(871) * lu(1672) + lu(1684) = lu(1684) - lu(872) * lu(1672) + lu(1685) = lu(1685) - lu(873) * lu(1672) + lu(1686) = lu(1686) - lu(874) * lu(1672) + lu(1687) = lu(1687) - lu(875) * lu(1672) + lu(1688) = lu(1688) - lu(876) * lu(1672) + lu(1689) = lu(1689) - lu(877) * lu(1672) + lu(1690) = lu(1690) - lu(878) * lu(1672) + lu(1691) = lu(1691) - lu(879) * lu(1672) + lu(1692) = lu(1692) - lu(880) * lu(1672) + lu(1693) = lu(1693) - lu(881) * lu(1672) + lu(1725) = lu(1725) - lu(861) * lu(1724) + lu(1726) = lu(1726) - lu(862) * lu(1724) + lu(1727) = lu(1727) - lu(863) * lu(1724) + lu(1728) = lu(1728) - lu(864) * lu(1724) + lu(1729) = lu(1729) - lu(865) * lu(1724) + lu(1730) = lu(1730) - lu(866) * lu(1724) + lu(1731) = lu(1731) - lu(867) * lu(1724) + lu(1732) = lu(1732) - lu(868) * lu(1724) + lu(1733) = lu(1733) - lu(869) * lu(1724) + lu(1734) = lu(1734) - lu(870) * lu(1724) + lu(1735) = lu(1735) - lu(871) * lu(1724) + lu(1736) = lu(1736) - lu(872) * lu(1724) + lu(1737) = lu(1737) - lu(873) * lu(1724) + lu(1738) = lu(1738) - lu(874) * lu(1724) + lu(1739) = lu(1739) - lu(875) * lu(1724) + lu(1740) = lu(1740) - lu(876) * lu(1724) + lu(1741) = lu(1741) - lu(877) * lu(1724) + lu(1742) = lu(1742) - lu(878) * lu(1724) + lu(1743) = lu(1743) - lu(879) * lu(1724) + lu(1744) = lu(1744) - lu(880) * lu(1724) + lu(1745) = lu(1745) - lu(881) * lu(1724) end subroutine lu_fac17 - subroutine lu_fac18( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac18( lu ) 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,878) = 1._r8 / lu(k,878) - lu(k,879) = lu(k,879) * lu(k,878) - lu(k,880) = lu(k,880) * lu(k,878) - lu(k,881) = lu(k,881) * lu(k,878) - lu(k,882) = lu(k,882) * lu(k,878) - lu(k,883) = lu(k,883) * lu(k,878) - lu(k,884) = lu(k,884) * lu(k,878) - lu(k,885) = lu(k,885) * lu(k,878) - lu(k,886) = lu(k,886) * lu(k,878) - lu(k,887) = lu(k,887) * lu(k,878) - lu(k,888) = lu(k,888) * lu(k,878) - lu(k,889) = lu(k,889) * lu(k,878) - lu(k,890) = lu(k,890) * lu(k,878) - lu(k,891) = lu(k,891) * lu(k,878) - lu(k,892) = lu(k,892) * lu(k,878) - lu(k,893) = lu(k,893) * lu(k,878) - lu(k,894) = lu(k,894) * lu(k,878) - lu(k,895) = lu(k,895) * lu(k,878) - lu(k,896) = lu(k,896) * lu(k,878) - lu(k,897) = lu(k,897) * lu(k,878) - lu(k,898) = lu(k,898) * lu(k,878) - lu(k,899) = lu(k,899) * lu(k,878) - lu(k,900) = lu(k,900) * lu(k,878) - lu(k,922) = lu(k,922) - lu(k,879) * lu(k,921) - lu(k,923) = lu(k,923) - lu(k,880) * lu(k,921) - lu(k,924) = lu(k,924) - lu(k,881) * lu(k,921) - lu(k,925) = lu(k,925) - lu(k,882) * lu(k,921) - lu(k,926) = lu(k,926) - lu(k,883) * lu(k,921) - lu(k,927) = lu(k,927) - lu(k,884) * lu(k,921) - lu(k,928) = lu(k,928) - lu(k,885) * lu(k,921) - lu(k,929) = lu(k,929) - lu(k,886) * lu(k,921) - lu(k,930) = lu(k,930) - lu(k,887) * lu(k,921) - lu(k,931) = lu(k,931) - lu(k,888) * lu(k,921) - lu(k,932) = lu(k,932) - lu(k,889) * lu(k,921) - lu(k,933) = lu(k,933) - lu(k,890) * lu(k,921) - lu(k,934) = lu(k,934) - lu(k,891) * lu(k,921) - lu(k,935) = lu(k,935) - lu(k,892) * lu(k,921) - lu(k,936) = lu(k,936) - lu(k,893) * lu(k,921) - lu(k,937) = lu(k,937) - lu(k,894) * lu(k,921) - lu(k,938) = lu(k,938) - lu(k,895) * lu(k,921) - lu(k,939) = lu(k,939) - lu(k,896) * lu(k,921) - lu(k,940) = lu(k,940) - lu(k,897) * lu(k,921) - lu(k,941) = lu(k,941) - lu(k,898) * lu(k,921) - lu(k,942) = lu(k,942) - lu(k,899) * lu(k,921) - lu(k,943) = lu(k,943) - lu(k,900) * lu(k,921) - lu(k,978) = lu(k,978) - lu(k,879) * lu(k,977) - lu(k,979) = lu(k,979) - lu(k,880) * lu(k,977) - lu(k,980) = lu(k,980) - lu(k,881) * lu(k,977) - lu(k,981) = lu(k,981) - lu(k,882) * lu(k,977) - lu(k,982) = lu(k,982) - lu(k,883) * lu(k,977) - lu(k,983) = lu(k,983) - lu(k,884) * lu(k,977) - lu(k,984) = lu(k,984) - lu(k,885) * lu(k,977) - lu(k,985) = lu(k,985) - lu(k,886) * lu(k,977) - lu(k,986) = lu(k,986) - lu(k,887) * lu(k,977) - lu(k,987) = lu(k,987) - lu(k,888) * lu(k,977) - lu(k,988) = lu(k,988) - lu(k,889) * lu(k,977) - lu(k,989) = lu(k,989) - lu(k,890) * lu(k,977) - lu(k,990) = lu(k,990) - lu(k,891) * lu(k,977) - lu(k,991) = lu(k,991) - lu(k,892) * lu(k,977) - lu(k,992) = lu(k,992) - lu(k,893) * lu(k,977) - lu(k,993) = lu(k,993) - lu(k,894) * lu(k,977) - lu(k,994) = lu(k,994) - lu(k,895) * lu(k,977) - lu(k,995) = lu(k,995) - lu(k,896) * lu(k,977) - lu(k,996) = lu(k,996) - lu(k,897) * lu(k,977) - lu(k,997) = lu(k,997) - lu(k,898) * lu(k,977) - lu(k,998) = lu(k,998) - lu(k,899) * lu(k,977) - lu(k,999) = lu(k,999) - lu(k,900) * lu(k,977) - lu(k,1021) = lu(k,1021) - lu(k,879) * lu(k,1020) - lu(k,1022) = lu(k,1022) - lu(k,880) * lu(k,1020) - lu(k,1023) = lu(k,1023) - lu(k,881) * lu(k,1020) - lu(k,1024) = lu(k,1024) - lu(k,882) * lu(k,1020) - lu(k,1025) = lu(k,1025) - lu(k,883) * lu(k,1020) - lu(k,1026) = lu(k,1026) - lu(k,884) * lu(k,1020) - lu(k,1027) = lu(k,1027) - lu(k,885) * lu(k,1020) - lu(k,1028) = lu(k,1028) - lu(k,886) * lu(k,1020) - lu(k,1029) = lu(k,1029) - lu(k,887) * lu(k,1020) - lu(k,1030) = lu(k,1030) - lu(k,888) * lu(k,1020) - lu(k,1031) = lu(k,1031) - lu(k,889) * lu(k,1020) - lu(k,1032) = lu(k,1032) - lu(k,890) * lu(k,1020) - lu(k,1033) = lu(k,1033) - lu(k,891) * lu(k,1020) - lu(k,1034) = lu(k,1034) - lu(k,892) * lu(k,1020) - lu(k,1035) = lu(k,1035) - lu(k,893) * lu(k,1020) - lu(k,1036) = lu(k,1036) - lu(k,894) * lu(k,1020) - lu(k,1037) = lu(k,1037) - lu(k,895) * lu(k,1020) - lu(k,1038) = lu(k,1038) - lu(k,896) * lu(k,1020) - lu(k,1039) = lu(k,1039) - lu(k,897) * lu(k,1020) - lu(k,1040) = lu(k,1040) - lu(k,898) * lu(k,1020) - lu(k,1041) = lu(k,1041) - lu(k,899) * lu(k,1020) - lu(k,1042) = lu(k,1042) - lu(k,900) * lu(k,1020) - lu(k,1063) = lu(k,1063) - lu(k,879) * lu(k,1062) - lu(k,1064) = lu(k,1064) - lu(k,880) * lu(k,1062) - lu(k,1065) = lu(k,1065) - lu(k,881) * lu(k,1062) - lu(k,1066) = lu(k,1066) - lu(k,882) * lu(k,1062) - lu(k,1067) = lu(k,1067) - lu(k,883) * lu(k,1062) - lu(k,1068) = lu(k,1068) - lu(k,884) * lu(k,1062) - lu(k,1069) = lu(k,1069) - lu(k,885) * lu(k,1062) - lu(k,1070) = lu(k,1070) - lu(k,886) * lu(k,1062) - lu(k,1071) = lu(k,1071) - lu(k,887) * lu(k,1062) - lu(k,1072) = lu(k,1072) - lu(k,888) * lu(k,1062) - lu(k,1073) = lu(k,1073) - lu(k,889) * lu(k,1062) - lu(k,1074) = lu(k,1074) - lu(k,890) * lu(k,1062) - lu(k,1075) = lu(k,1075) - lu(k,891) * lu(k,1062) - lu(k,1076) = lu(k,1076) - lu(k,892) * lu(k,1062) - lu(k,1077) = lu(k,1077) - lu(k,893) * lu(k,1062) - lu(k,1078) = lu(k,1078) - lu(k,894) * lu(k,1062) - lu(k,1079) = lu(k,1079) - lu(k,895) * lu(k,1062) - lu(k,1080) = lu(k,1080) - lu(k,896) * lu(k,1062) - lu(k,1081) = lu(k,1081) - lu(k,897) * lu(k,1062) - lu(k,1082) = lu(k,1082) - lu(k,898) * lu(k,1062) - lu(k,1083) = lu(k,1083) - lu(k,899) * lu(k,1062) - lu(k,1084) = lu(k,1084) - lu(k,900) * lu(k,1062) - lu(k,1103) = lu(k,1103) - lu(k,879) * lu(k,1102) - lu(k,1104) = lu(k,1104) - lu(k,880) * lu(k,1102) - lu(k,1105) = lu(k,1105) - lu(k,881) * lu(k,1102) - lu(k,1106) = lu(k,1106) - lu(k,882) * lu(k,1102) - lu(k,1107) = lu(k,1107) - lu(k,883) * lu(k,1102) - lu(k,1108) = lu(k,1108) - lu(k,884) * lu(k,1102) - lu(k,1109) = lu(k,1109) - lu(k,885) * lu(k,1102) - lu(k,1110) = lu(k,1110) - lu(k,886) * lu(k,1102) - lu(k,1111) = lu(k,1111) - lu(k,887) * lu(k,1102) - lu(k,1112) = lu(k,1112) - lu(k,888) * lu(k,1102) - lu(k,1113) = lu(k,1113) - lu(k,889) * lu(k,1102) - lu(k,1114) = lu(k,1114) - lu(k,890) * lu(k,1102) - lu(k,1115) = lu(k,1115) - lu(k,891) * lu(k,1102) - lu(k,1116) = lu(k,1116) - lu(k,892) * lu(k,1102) - lu(k,1117) = lu(k,1117) - lu(k,893) * lu(k,1102) - lu(k,1118) = lu(k,1118) - lu(k,894) * lu(k,1102) - lu(k,1119) = lu(k,1119) - lu(k,895) * lu(k,1102) - lu(k,1120) = lu(k,1120) - lu(k,896) * lu(k,1102) - lu(k,1121) = lu(k,1121) - lu(k,897) * lu(k,1102) - lu(k,1122) = lu(k,1122) - lu(k,898) * lu(k,1102) - lu(k,1123) = lu(k,1123) - lu(k,899) * lu(k,1102) - lu(k,1124) = lu(k,1124) - lu(k,900) * lu(k,1102) - lu(k,1148) = lu(k,1148) - lu(k,879) * lu(k,1147) - lu(k,1149) = lu(k,1149) - lu(k,880) * lu(k,1147) - lu(k,1150) = lu(k,1150) - lu(k,881) * lu(k,1147) - lu(k,1151) = lu(k,1151) - lu(k,882) * lu(k,1147) - lu(k,1152) = lu(k,1152) - lu(k,883) * lu(k,1147) - lu(k,1153) = lu(k,1153) - lu(k,884) * lu(k,1147) - lu(k,1154) = lu(k,1154) - lu(k,885) * lu(k,1147) - lu(k,1155) = lu(k,1155) - lu(k,886) * lu(k,1147) - lu(k,1156) = lu(k,1156) - lu(k,887) * lu(k,1147) - lu(k,1157) = lu(k,1157) - lu(k,888) * lu(k,1147) - lu(k,1158) = lu(k,1158) - lu(k,889) * lu(k,1147) - lu(k,1159) = lu(k,1159) - lu(k,890) * lu(k,1147) - lu(k,1160) = lu(k,1160) - lu(k,891) * lu(k,1147) - lu(k,1161) = lu(k,1161) - lu(k,892) * lu(k,1147) - lu(k,1162) = lu(k,1162) - lu(k,893) * lu(k,1147) - lu(k,1163) = lu(k,1163) - lu(k,894) * lu(k,1147) - lu(k,1164) = lu(k,1164) - lu(k,895) * lu(k,1147) - lu(k,1165) = lu(k,1165) - lu(k,896) * lu(k,1147) - lu(k,1166) = lu(k,1166) - lu(k,897) * lu(k,1147) - lu(k,1167) = lu(k,1167) - lu(k,898) * lu(k,1147) - lu(k,1168) = lu(k,1168) - lu(k,899) * lu(k,1147) - lu(k,1169) = lu(k,1169) - lu(k,900) * lu(k,1147) - lu(k,1191) = lu(k,1191) - lu(k,879) * lu(k,1190) - lu(k,1192) = lu(k,1192) - lu(k,880) * lu(k,1190) - lu(k,1193) = lu(k,1193) - lu(k,881) * lu(k,1190) - lu(k,1194) = lu(k,1194) - lu(k,882) * lu(k,1190) - lu(k,1195) = lu(k,1195) - lu(k,883) * lu(k,1190) - lu(k,1196) = lu(k,1196) - lu(k,884) * lu(k,1190) - lu(k,1197) = lu(k,1197) - lu(k,885) * lu(k,1190) - lu(k,1198) = lu(k,1198) - lu(k,886) * lu(k,1190) - lu(k,1199) = lu(k,1199) - lu(k,887) * lu(k,1190) - lu(k,1200) = lu(k,1200) - lu(k,888) * lu(k,1190) - lu(k,1201) = lu(k,1201) - lu(k,889) * lu(k,1190) - lu(k,1202) = lu(k,1202) - lu(k,890) * lu(k,1190) - lu(k,1203) = lu(k,1203) - lu(k,891) * lu(k,1190) - lu(k,1204) = lu(k,1204) - lu(k,892) * lu(k,1190) - lu(k,1205) = lu(k,1205) - lu(k,893) * lu(k,1190) - lu(k,1206) = lu(k,1206) - lu(k,894) * lu(k,1190) - lu(k,1207) = lu(k,1207) - lu(k,895) * lu(k,1190) - lu(k,1208) = lu(k,1208) - lu(k,896) * lu(k,1190) - lu(k,1209) = lu(k,1209) - lu(k,897) * lu(k,1190) - lu(k,1210) = lu(k,1210) - lu(k,898) * lu(k,1190) - lu(k,1211) = lu(k,1211) - lu(k,899) * lu(k,1190) - lu(k,1212) = lu(k,1212) - lu(k,900) * lu(k,1190) - lu(k,1226) = lu(k,1226) - lu(k,879) * lu(k,1225) - lu(k,1227) = lu(k,1227) - lu(k,880) * lu(k,1225) - lu(k,1228) = lu(k,1228) - lu(k,881) * lu(k,1225) - lu(k,1229) = lu(k,1229) - lu(k,882) * lu(k,1225) - lu(k,1230) = lu(k,1230) - lu(k,883) * lu(k,1225) - lu(k,1231) = lu(k,1231) - lu(k,884) * lu(k,1225) - lu(k,1232) = lu(k,1232) - lu(k,885) * lu(k,1225) - lu(k,1233) = lu(k,1233) - lu(k,886) * lu(k,1225) - lu(k,1234) = lu(k,1234) - lu(k,887) * lu(k,1225) - lu(k,1235) = lu(k,1235) - lu(k,888) * lu(k,1225) - lu(k,1236) = lu(k,1236) - lu(k,889) * lu(k,1225) - lu(k,1237) = lu(k,1237) - lu(k,890) * lu(k,1225) - lu(k,1238) = lu(k,1238) - lu(k,891) * lu(k,1225) - lu(k,1239) = lu(k,1239) - lu(k,892) * lu(k,1225) - lu(k,1240) = lu(k,1240) - lu(k,893) * lu(k,1225) - lu(k,1241) = lu(k,1241) - lu(k,894) * lu(k,1225) - lu(k,1242) = lu(k,1242) - lu(k,895) * lu(k,1225) - lu(k,1243) = lu(k,1243) - lu(k,896) * lu(k,1225) - lu(k,1244) = lu(k,1244) - lu(k,897) * lu(k,1225) - lu(k,1245) = lu(k,1245) - lu(k,898) * lu(k,1225) - lu(k,1246) = lu(k,1246) - lu(k,899) * lu(k,1225) - lu(k,1247) = lu(k,1247) - lu(k,900) * lu(k,1225) - lu(k,1269) = lu(k,1269) - lu(k,879) * lu(k,1268) - lu(k,1270) = lu(k,1270) - lu(k,880) * lu(k,1268) - lu(k,1271) = lu(k,1271) - lu(k,881) * lu(k,1268) - lu(k,1272) = lu(k,1272) - lu(k,882) * lu(k,1268) - lu(k,1273) = lu(k,1273) - lu(k,883) * lu(k,1268) - lu(k,1274) = lu(k,1274) - lu(k,884) * lu(k,1268) - lu(k,1275) = lu(k,1275) - lu(k,885) * lu(k,1268) - lu(k,1276) = lu(k,1276) - lu(k,886) * lu(k,1268) - lu(k,1277) = lu(k,1277) - lu(k,887) * lu(k,1268) - lu(k,1278) = lu(k,1278) - lu(k,888) * lu(k,1268) - lu(k,1279) = lu(k,1279) - lu(k,889) * lu(k,1268) - lu(k,1280) = lu(k,1280) - lu(k,890) * lu(k,1268) - lu(k,1281) = lu(k,1281) - lu(k,891) * lu(k,1268) - lu(k,1282) = lu(k,1282) - lu(k,892) * lu(k,1268) - lu(k,1283) = lu(k,1283) - lu(k,893) * lu(k,1268) - lu(k,1284) = lu(k,1284) - lu(k,894) * lu(k,1268) - lu(k,1285) = lu(k,1285) - lu(k,895) * lu(k,1268) - lu(k,1286) = lu(k,1286) - lu(k,896) * lu(k,1268) - lu(k,1287) = lu(k,1287) - lu(k,897) * lu(k,1268) - lu(k,1288) = lu(k,1288) - lu(k,898) * lu(k,1268) - lu(k,1289) = lu(k,1289) - lu(k,899) * lu(k,1268) - lu(k,1290) = lu(k,1290) - lu(k,900) * lu(k,1268) - lu(k,1305) = lu(k,1305) - lu(k,879) * lu(k,1304) - lu(k,1306) = lu(k,1306) - lu(k,880) * lu(k,1304) - lu(k,1307) = lu(k,1307) - lu(k,881) * lu(k,1304) - lu(k,1308) = lu(k,1308) - lu(k,882) * lu(k,1304) - lu(k,1309) = lu(k,1309) - lu(k,883) * lu(k,1304) - lu(k,1310) = lu(k,1310) - lu(k,884) * lu(k,1304) - lu(k,1311) = lu(k,1311) - lu(k,885) * lu(k,1304) - lu(k,1312) = lu(k,1312) - lu(k,886) * lu(k,1304) - lu(k,1313) = lu(k,1313) - lu(k,887) * lu(k,1304) - lu(k,1314) = lu(k,1314) - lu(k,888) * lu(k,1304) - lu(k,1315) = lu(k,1315) - lu(k,889) * lu(k,1304) - lu(k,1316) = lu(k,1316) - lu(k,890) * lu(k,1304) - lu(k,1317) = lu(k,1317) - lu(k,891) * lu(k,1304) - lu(k,1318) = lu(k,1318) - lu(k,892) * lu(k,1304) - lu(k,1319) = lu(k,1319) - lu(k,893) * lu(k,1304) - lu(k,1320) = lu(k,1320) - lu(k,894) * lu(k,1304) - lu(k,1321) = lu(k,1321) - lu(k,895) * lu(k,1304) - lu(k,1322) = lu(k,1322) - lu(k,896) * lu(k,1304) - lu(k,1323) = lu(k,1323) - lu(k,897) * lu(k,1304) - lu(k,1324) = lu(k,1324) - lu(k,898) * lu(k,1304) - lu(k,1325) = lu(k,1325) - lu(k,899) * lu(k,1304) - lu(k,1326) = lu(k,1326) - lu(k,900) * lu(k,1304) - lu(k,1350) = lu(k,1350) - lu(k,879) * lu(k,1349) - lu(k,1351) = lu(k,1351) - lu(k,880) * lu(k,1349) - lu(k,1352) = lu(k,1352) - lu(k,881) * lu(k,1349) - lu(k,1353) = lu(k,1353) - lu(k,882) * lu(k,1349) - lu(k,1354) = lu(k,1354) - lu(k,883) * lu(k,1349) - lu(k,1355) = lu(k,1355) - lu(k,884) * lu(k,1349) - lu(k,1356) = lu(k,1356) - lu(k,885) * lu(k,1349) - lu(k,1357) = lu(k,1357) - lu(k,886) * lu(k,1349) - lu(k,1358) = lu(k,1358) - lu(k,887) * lu(k,1349) - lu(k,1359) = lu(k,1359) - lu(k,888) * lu(k,1349) - lu(k,1360) = lu(k,1360) - lu(k,889) * lu(k,1349) - lu(k,1361) = lu(k,1361) - lu(k,890) * lu(k,1349) - lu(k,1362) = lu(k,1362) - lu(k,891) * lu(k,1349) - lu(k,1363) = lu(k,1363) - lu(k,892) * lu(k,1349) - lu(k,1364) = lu(k,1364) - lu(k,893) * lu(k,1349) - lu(k,1365) = lu(k,1365) - lu(k,894) * lu(k,1349) - lu(k,1366) = lu(k,1366) - lu(k,895) * lu(k,1349) - lu(k,1367) = lu(k,1367) - lu(k,896) * lu(k,1349) - lu(k,1368) = lu(k,1368) - lu(k,897) * lu(k,1349) - lu(k,1369) = lu(k,1369) - lu(k,898) * lu(k,1349) - lu(k,1370) = lu(k,1370) - lu(k,899) * lu(k,1349) - lu(k,1371) = lu(k,1371) - lu(k,900) * lu(k,1349) - lu(k,1392) = lu(k,1392) - lu(k,879) * lu(k,1391) - lu(k,1393) = lu(k,1393) - lu(k,880) * lu(k,1391) - lu(k,1394) = lu(k,1394) - lu(k,881) * lu(k,1391) - lu(k,1395) = lu(k,1395) - lu(k,882) * lu(k,1391) - lu(k,1396) = lu(k,1396) - lu(k,883) * lu(k,1391) - lu(k,1397) = lu(k,1397) - lu(k,884) * lu(k,1391) - lu(k,1398) = lu(k,1398) - lu(k,885) * lu(k,1391) - lu(k,1399) = lu(k,1399) - lu(k,886) * lu(k,1391) - lu(k,1400) = lu(k,1400) - lu(k,887) * lu(k,1391) - lu(k,1401) = lu(k,1401) - lu(k,888) * lu(k,1391) - lu(k,1402) = lu(k,1402) - lu(k,889) * lu(k,1391) - lu(k,1403) = lu(k,1403) - lu(k,890) * lu(k,1391) - lu(k,1404) = lu(k,1404) - lu(k,891) * lu(k,1391) - lu(k,1405) = lu(k,1405) - lu(k,892) * lu(k,1391) - lu(k,1406) = lu(k,1406) - lu(k,893) * lu(k,1391) - lu(k,1407) = lu(k,1407) - lu(k,894) * lu(k,1391) - lu(k,1408) = lu(k,1408) - lu(k,895) * lu(k,1391) - lu(k,1409) = lu(k,1409) - lu(k,896) * lu(k,1391) - lu(k,1410) = lu(k,1410) - lu(k,897) * lu(k,1391) - lu(k,1411) = lu(k,1411) - lu(k,898) * lu(k,1391) - lu(k,1412) = lu(k,1412) - lu(k,899) * lu(k,1391) - lu(k,1413) = lu(k,1413) - lu(k,900) * lu(k,1391) - lu(k,1430) = lu(k,1430) - lu(k,879) * lu(k,1429) - lu(k,1431) = lu(k,1431) - lu(k,880) * lu(k,1429) - lu(k,1432) = lu(k,1432) - lu(k,881) * lu(k,1429) - lu(k,1433) = lu(k,1433) - lu(k,882) * lu(k,1429) - lu(k,1434) = lu(k,1434) - lu(k,883) * lu(k,1429) - lu(k,1435) = lu(k,1435) - lu(k,884) * lu(k,1429) - lu(k,1436) = lu(k,1436) - lu(k,885) * lu(k,1429) - lu(k,1437) = lu(k,1437) - lu(k,886) * lu(k,1429) - lu(k,1438) = lu(k,1438) - lu(k,887) * lu(k,1429) - lu(k,1439) = lu(k,1439) - lu(k,888) * lu(k,1429) - lu(k,1440) = lu(k,1440) - lu(k,889) * lu(k,1429) - lu(k,1441) = lu(k,1441) - lu(k,890) * lu(k,1429) - lu(k,1442) = lu(k,1442) - lu(k,891) * lu(k,1429) - lu(k,1443) = lu(k,1443) - lu(k,892) * lu(k,1429) - lu(k,1444) = lu(k,1444) - lu(k,893) * lu(k,1429) - lu(k,1445) = lu(k,1445) - lu(k,894) * lu(k,1429) - lu(k,1446) = lu(k,1446) - lu(k,895) * lu(k,1429) - lu(k,1447) = lu(k,1447) - lu(k,896) * lu(k,1429) - lu(k,1448) = lu(k,1448) - lu(k,897) * lu(k,1429) - lu(k,1449) = lu(k,1449) - lu(k,898) * lu(k,1429) - lu(k,1450) = lu(k,1450) - lu(k,899) * lu(k,1429) - lu(k,1451) = lu(k,1451) - lu(k,900) * lu(k,1429) - lu(k,1475) = lu(k,1475) - lu(k,879) * lu(k,1474) - lu(k,1476) = lu(k,1476) - lu(k,880) * lu(k,1474) - lu(k,1477) = lu(k,1477) - lu(k,881) * lu(k,1474) - lu(k,1478) = lu(k,1478) - lu(k,882) * lu(k,1474) - lu(k,1479) = lu(k,1479) - lu(k,883) * lu(k,1474) - lu(k,1480) = lu(k,1480) - lu(k,884) * lu(k,1474) - lu(k,1481) = lu(k,1481) - lu(k,885) * lu(k,1474) - lu(k,1482) = lu(k,1482) - lu(k,886) * lu(k,1474) - lu(k,1483) = lu(k,1483) - lu(k,887) * lu(k,1474) - lu(k,1484) = lu(k,1484) - lu(k,888) * lu(k,1474) - lu(k,1485) = lu(k,1485) - lu(k,889) * lu(k,1474) - lu(k,1486) = lu(k,1486) - lu(k,890) * lu(k,1474) - lu(k,1487) = lu(k,1487) - lu(k,891) * lu(k,1474) - lu(k,1488) = lu(k,1488) - lu(k,892) * lu(k,1474) - lu(k,1489) = lu(k,1489) - lu(k,893) * lu(k,1474) - lu(k,1490) = lu(k,1490) - lu(k,894) * lu(k,1474) - lu(k,1491) = lu(k,1491) - lu(k,895) * lu(k,1474) - lu(k,1492) = lu(k,1492) - lu(k,896) * lu(k,1474) - lu(k,1493) = lu(k,1493) - lu(k,897) * lu(k,1474) - lu(k,1494) = lu(k,1494) - lu(k,898) * lu(k,1474) - lu(k,1495) = lu(k,1495) - lu(k,899) * lu(k,1474) - lu(k,1496) = lu(k,1496) - lu(k,900) * lu(k,1474) - lu(k,1518) = lu(k,1518) - lu(k,879) * lu(k,1517) - lu(k,1519) = lu(k,1519) - lu(k,880) * lu(k,1517) - lu(k,1520) = lu(k,1520) - lu(k,881) * lu(k,1517) - lu(k,1521) = lu(k,1521) - lu(k,882) * lu(k,1517) - lu(k,1522) = lu(k,1522) - lu(k,883) * lu(k,1517) - lu(k,1523) = lu(k,1523) - lu(k,884) * lu(k,1517) - lu(k,1524) = lu(k,1524) - lu(k,885) * lu(k,1517) - lu(k,1525) = lu(k,1525) - lu(k,886) * lu(k,1517) - lu(k,1526) = lu(k,1526) - lu(k,887) * lu(k,1517) - lu(k,1527) = lu(k,1527) - lu(k,888) * lu(k,1517) - lu(k,1528) = lu(k,1528) - lu(k,889) * lu(k,1517) - lu(k,1529) = lu(k,1529) - lu(k,890) * lu(k,1517) - lu(k,1530) = lu(k,1530) - lu(k,891) * lu(k,1517) - lu(k,1531) = lu(k,1531) - lu(k,892) * lu(k,1517) - lu(k,1532) = lu(k,1532) - lu(k,893) * lu(k,1517) - lu(k,1533) = lu(k,1533) - lu(k,894) * lu(k,1517) - lu(k,1534) = lu(k,1534) - lu(k,895) * lu(k,1517) - lu(k,1535) = lu(k,1535) - lu(k,896) * lu(k,1517) - lu(k,1536) = lu(k,1536) - lu(k,897) * lu(k,1517) - lu(k,1537) = lu(k,1537) - lu(k,898) * lu(k,1517) - lu(k,1538) = lu(k,1538) - lu(k,899) * lu(k,1517) - lu(k,1539) = lu(k,1539) - lu(k,900) * lu(k,1517) - lu(k,1561) = lu(k,1561) - lu(k,879) * lu(k,1560) - lu(k,1562) = lu(k,1562) - lu(k,880) * lu(k,1560) - lu(k,1563) = lu(k,1563) - lu(k,881) * lu(k,1560) - lu(k,1564) = lu(k,1564) - lu(k,882) * lu(k,1560) - lu(k,1565) = lu(k,1565) - lu(k,883) * lu(k,1560) - lu(k,1566) = lu(k,1566) - lu(k,884) * lu(k,1560) - lu(k,1567) = lu(k,1567) - lu(k,885) * lu(k,1560) - lu(k,1568) = lu(k,1568) - lu(k,886) * lu(k,1560) - lu(k,1569) = lu(k,1569) - lu(k,887) * lu(k,1560) - lu(k,1570) = lu(k,1570) - lu(k,888) * lu(k,1560) - lu(k,1571) = lu(k,1571) - lu(k,889) * lu(k,1560) - lu(k,1572) = lu(k,1572) - lu(k,890) * lu(k,1560) - lu(k,1573) = lu(k,1573) - lu(k,891) * lu(k,1560) - lu(k,1574) = lu(k,1574) - lu(k,892) * lu(k,1560) - lu(k,1575) = lu(k,1575) - lu(k,893) * lu(k,1560) - lu(k,1576) = lu(k,1576) - lu(k,894) * lu(k,1560) - lu(k,1577) = lu(k,1577) - lu(k,895) * lu(k,1560) - lu(k,1578) = lu(k,1578) - lu(k,896) * lu(k,1560) - lu(k,1579) = lu(k,1579) - lu(k,897) * lu(k,1560) - lu(k,1580) = lu(k,1580) - lu(k,898) * lu(k,1560) - lu(k,1581) = lu(k,1581) - lu(k,899) * lu(k,1560) - lu(k,1582) = lu(k,1582) - lu(k,900) * lu(k,1560) - lu(k,1594) = lu(k,1594) - lu(k,879) * lu(k,1593) - lu(k,1595) = lu(k,1595) - lu(k,880) * lu(k,1593) - lu(k,1596) = lu(k,1596) - lu(k,881) * lu(k,1593) - lu(k,1597) = lu(k,1597) - lu(k,882) * lu(k,1593) - lu(k,1598) = lu(k,1598) - lu(k,883) * lu(k,1593) - lu(k,1599) = lu(k,1599) - lu(k,884) * lu(k,1593) - lu(k,1600) = lu(k,1600) - lu(k,885) * lu(k,1593) - lu(k,1601) = lu(k,1601) - lu(k,886) * lu(k,1593) - lu(k,1602) = lu(k,1602) - lu(k,887) * lu(k,1593) - lu(k,1603) = lu(k,1603) - lu(k,888) * lu(k,1593) - lu(k,1604) = lu(k,1604) - lu(k,889) * lu(k,1593) - lu(k,1605) = lu(k,1605) - lu(k,890) * lu(k,1593) - lu(k,1606) = lu(k,1606) - lu(k,891) * lu(k,1593) - lu(k,1607) = lu(k,1607) - lu(k,892) * lu(k,1593) - lu(k,1608) = lu(k,1608) - lu(k,893) * lu(k,1593) - lu(k,1609) = lu(k,1609) - lu(k,894) * lu(k,1593) - lu(k,1610) = lu(k,1610) - lu(k,895) * lu(k,1593) - lu(k,1611) = lu(k,1611) - lu(k,896) * lu(k,1593) - lu(k,1612) = lu(k,1612) - lu(k,897) * lu(k,1593) - lu(k,1613) = lu(k,1613) - lu(k,898) * lu(k,1593) - lu(k,1614) = lu(k,1614) - lu(k,899) * lu(k,1593) - lu(k,1615) = lu(k,1615) - lu(k,900) * lu(k,1593) - lu(k,1630) = lu(k,1630) - lu(k,879) * lu(k,1629) - lu(k,1631) = lu(k,1631) - lu(k,880) * lu(k,1629) - lu(k,1632) = lu(k,1632) - lu(k,881) * lu(k,1629) - lu(k,1633) = lu(k,1633) - lu(k,882) * lu(k,1629) - lu(k,1634) = lu(k,1634) - lu(k,883) * lu(k,1629) - lu(k,1635) = lu(k,1635) - lu(k,884) * lu(k,1629) - lu(k,1636) = lu(k,1636) - lu(k,885) * lu(k,1629) - lu(k,1637) = lu(k,1637) - lu(k,886) * lu(k,1629) - lu(k,1638) = lu(k,1638) - lu(k,887) * lu(k,1629) - lu(k,1639) = lu(k,1639) - lu(k,888) * lu(k,1629) - lu(k,1640) = lu(k,1640) - lu(k,889) * lu(k,1629) - lu(k,1641) = lu(k,1641) - lu(k,890) * lu(k,1629) - lu(k,1642) = lu(k,1642) - lu(k,891) * lu(k,1629) - lu(k,1643) = lu(k,1643) - lu(k,892) * lu(k,1629) - lu(k,1644) = lu(k,1644) - lu(k,893) * lu(k,1629) - lu(k,1645) = lu(k,1645) - lu(k,894) * lu(k,1629) - lu(k,1646) = lu(k,1646) - lu(k,895) * lu(k,1629) - lu(k,1647) = lu(k,1647) - lu(k,896) * lu(k,1629) - lu(k,1648) = lu(k,1648) - lu(k,897) * lu(k,1629) - lu(k,1649) = lu(k,1649) - lu(k,898) * lu(k,1629) - lu(k,1650) = lu(k,1650) - lu(k,899) * lu(k,1629) - lu(k,1651) = lu(k,1651) - lu(k,900) * lu(k,1629) - lu(k,1673) = lu(k,1673) - lu(k,879) * lu(k,1672) - lu(k,1674) = lu(k,1674) - lu(k,880) * lu(k,1672) - lu(k,1675) = lu(k,1675) - lu(k,881) * lu(k,1672) - lu(k,1676) = lu(k,1676) - lu(k,882) * lu(k,1672) - lu(k,1677) = lu(k,1677) - lu(k,883) * lu(k,1672) - lu(k,1678) = lu(k,1678) - lu(k,884) * lu(k,1672) - lu(k,1679) = lu(k,1679) - lu(k,885) * lu(k,1672) - lu(k,1680) = lu(k,1680) - lu(k,886) * lu(k,1672) - lu(k,1681) = lu(k,1681) - lu(k,887) * lu(k,1672) - lu(k,1682) = lu(k,1682) - lu(k,888) * lu(k,1672) - lu(k,1683) = lu(k,1683) - lu(k,889) * lu(k,1672) - lu(k,1684) = lu(k,1684) - lu(k,890) * lu(k,1672) - lu(k,1685) = lu(k,1685) - lu(k,891) * lu(k,1672) - lu(k,1686) = lu(k,1686) - lu(k,892) * lu(k,1672) - lu(k,1687) = lu(k,1687) - lu(k,893) * lu(k,1672) - lu(k,1688) = lu(k,1688) - lu(k,894) * lu(k,1672) - lu(k,1689) = lu(k,1689) - lu(k,895) * lu(k,1672) - lu(k,1690) = lu(k,1690) - lu(k,896) * lu(k,1672) - lu(k,1691) = lu(k,1691) - lu(k,897) * lu(k,1672) - lu(k,1692) = lu(k,1692) - lu(k,898) * lu(k,1672) - lu(k,1693) = lu(k,1693) - lu(k,899) * lu(k,1672) - lu(k,1694) = lu(k,1694) - lu(k,900) * lu(k,1672) - lu(k,1709) = lu(k,1709) - lu(k,879) * lu(k,1708) - lu(k,1710) = lu(k,1710) - lu(k,880) * lu(k,1708) - lu(k,1711) = lu(k,1711) - lu(k,881) * lu(k,1708) - lu(k,1712) = lu(k,1712) - lu(k,882) * lu(k,1708) - lu(k,1713) = lu(k,1713) - lu(k,883) * lu(k,1708) - lu(k,1714) = lu(k,1714) - lu(k,884) * lu(k,1708) - lu(k,1715) = lu(k,1715) - lu(k,885) * lu(k,1708) - lu(k,1716) = lu(k,1716) - lu(k,886) * lu(k,1708) - lu(k,1717) = lu(k,1717) - lu(k,887) * lu(k,1708) - lu(k,1718) = lu(k,1718) - lu(k,888) * lu(k,1708) - lu(k,1719) = lu(k,1719) - lu(k,889) * lu(k,1708) - lu(k,1720) = lu(k,1720) - lu(k,890) * lu(k,1708) - lu(k,1721) = lu(k,1721) - lu(k,891) * lu(k,1708) - lu(k,1722) = lu(k,1722) - lu(k,892) * lu(k,1708) - lu(k,1723) = lu(k,1723) - lu(k,893) * lu(k,1708) - lu(k,1724) = lu(k,1724) - lu(k,894) * lu(k,1708) - lu(k,1725) = lu(k,1725) - lu(k,895) * lu(k,1708) - lu(k,1726) = lu(k,1726) - lu(k,896) * lu(k,1708) - lu(k,1727) = lu(k,1727) - lu(k,897) * lu(k,1708) - lu(k,1728) = lu(k,1728) - lu(k,898) * lu(k,1708) - lu(k,1729) = lu(k,1729) - lu(k,899) * lu(k,1708) - lu(k,1730) = lu(k,1730) - lu(k,900) * lu(k,1708) - lu(k,1751) = lu(k,1751) - lu(k,879) * lu(k,1750) - lu(k,1752) = lu(k,1752) - lu(k,880) * lu(k,1750) - lu(k,1753) = lu(k,1753) - lu(k,881) * lu(k,1750) - lu(k,1754) = lu(k,1754) - lu(k,882) * lu(k,1750) - lu(k,1755) = lu(k,1755) - lu(k,883) * lu(k,1750) - lu(k,1756) = lu(k,1756) - lu(k,884) * lu(k,1750) - lu(k,1757) = lu(k,1757) - lu(k,885) * lu(k,1750) - lu(k,1758) = lu(k,1758) - lu(k,886) * lu(k,1750) - lu(k,1759) = lu(k,1759) - lu(k,887) * lu(k,1750) - lu(k,1760) = lu(k,1760) - lu(k,888) * lu(k,1750) - lu(k,1761) = lu(k,1761) - lu(k,889) * lu(k,1750) - lu(k,1762) = lu(k,1762) - lu(k,890) * lu(k,1750) - lu(k,1763) = lu(k,1763) - lu(k,891) * lu(k,1750) - lu(k,1764) = lu(k,1764) - lu(k,892) * lu(k,1750) - lu(k,1765) = lu(k,1765) - lu(k,893) * lu(k,1750) - lu(k,1766) = lu(k,1766) - lu(k,894) * lu(k,1750) - lu(k,1767) = lu(k,1767) - lu(k,895) * lu(k,1750) - lu(k,1768) = lu(k,1768) - lu(k,896) * lu(k,1750) - lu(k,1769) = lu(k,1769) - lu(k,897) * lu(k,1750) - lu(k,1770) = lu(k,1770) - lu(k,898) * lu(k,1750) - lu(k,1771) = lu(k,1771) - lu(k,899) * lu(k,1750) - lu(k,1772) = lu(k,1772) - lu(k,900) * lu(k,1750) - lu(k,1804) = lu(k,1804) - lu(k,879) * lu(k,1803) - lu(k,1805) = lu(k,1805) - lu(k,880) * lu(k,1803) - lu(k,1806) = lu(k,1806) - lu(k,881) * lu(k,1803) - lu(k,1807) = lu(k,1807) - lu(k,882) * lu(k,1803) - lu(k,1808) = lu(k,1808) - lu(k,883) * lu(k,1803) - lu(k,1809) = lu(k,1809) - lu(k,884) * lu(k,1803) - lu(k,1810) = lu(k,1810) - lu(k,885) * lu(k,1803) - lu(k,1811) = lu(k,1811) - lu(k,886) * lu(k,1803) - lu(k,1812) = lu(k,1812) - lu(k,887) * lu(k,1803) - lu(k,1813) = lu(k,1813) - lu(k,888) * lu(k,1803) - lu(k,1814) = lu(k,1814) - lu(k,889) * lu(k,1803) - lu(k,1815) = lu(k,1815) - lu(k,890) * lu(k,1803) - lu(k,1816) = lu(k,1816) - lu(k,891) * lu(k,1803) - lu(k,1817) = lu(k,1817) - lu(k,892) * lu(k,1803) - lu(k,1818) = lu(k,1818) - lu(k,893) * lu(k,1803) - lu(k,1819) = lu(k,1819) - lu(k,894) * lu(k,1803) - lu(k,1820) = lu(k,1820) - lu(k,895) * lu(k,1803) - lu(k,1821) = lu(k,1821) - lu(k,896) * lu(k,1803) - lu(k,1822) = lu(k,1822) - lu(k,897) * lu(k,1803) - lu(k,1823) = lu(k,1823) - lu(k,898) * lu(k,1803) - lu(k,1824) = lu(k,1824) - lu(k,899) * lu(k,1803) - lu(k,1825) = lu(k,1825) - lu(k,900) * lu(k,1803) - lu(k,922) = 1._r8 / lu(k,922) - lu(k,923) = lu(k,923) * lu(k,922) - lu(k,924) = lu(k,924) * lu(k,922) - lu(k,925) = lu(k,925) * lu(k,922) - lu(k,926) = lu(k,926) * lu(k,922) - lu(k,927) = lu(k,927) * lu(k,922) - lu(k,928) = lu(k,928) * lu(k,922) - lu(k,929) = lu(k,929) * lu(k,922) - lu(k,930) = lu(k,930) * lu(k,922) - lu(k,931) = lu(k,931) * lu(k,922) - lu(k,932) = lu(k,932) * lu(k,922) - lu(k,933) = lu(k,933) * lu(k,922) - lu(k,934) = lu(k,934) * lu(k,922) - lu(k,935) = lu(k,935) * lu(k,922) - lu(k,936) = lu(k,936) * lu(k,922) - lu(k,937) = lu(k,937) * lu(k,922) - lu(k,938) = lu(k,938) * lu(k,922) - lu(k,939) = lu(k,939) * lu(k,922) - lu(k,940) = lu(k,940) * lu(k,922) - lu(k,941) = lu(k,941) * lu(k,922) - lu(k,942) = lu(k,942) * lu(k,922) - lu(k,943) = lu(k,943) * lu(k,922) - lu(k,979) = lu(k,979) - lu(k,923) * lu(k,978) - lu(k,980) = lu(k,980) - lu(k,924) * lu(k,978) - lu(k,981) = lu(k,981) - lu(k,925) * lu(k,978) - lu(k,982) = lu(k,982) - lu(k,926) * lu(k,978) - lu(k,983) = lu(k,983) - lu(k,927) * lu(k,978) - lu(k,984) = lu(k,984) - lu(k,928) * lu(k,978) - lu(k,985) = lu(k,985) - lu(k,929) * lu(k,978) - lu(k,986) = lu(k,986) - lu(k,930) * lu(k,978) - lu(k,987) = lu(k,987) - lu(k,931) * lu(k,978) - lu(k,988) = lu(k,988) - lu(k,932) * lu(k,978) - lu(k,989) = lu(k,989) - lu(k,933) * lu(k,978) - lu(k,990) = lu(k,990) - lu(k,934) * lu(k,978) - lu(k,991) = lu(k,991) - lu(k,935) * lu(k,978) - lu(k,992) = lu(k,992) - lu(k,936) * lu(k,978) - lu(k,993) = lu(k,993) - lu(k,937) * lu(k,978) - lu(k,994) = lu(k,994) - lu(k,938) * lu(k,978) - lu(k,995) = lu(k,995) - lu(k,939) * lu(k,978) - lu(k,996) = lu(k,996) - lu(k,940) * lu(k,978) - lu(k,997) = lu(k,997) - lu(k,941) * lu(k,978) - lu(k,998) = lu(k,998) - lu(k,942) * lu(k,978) - lu(k,999) = lu(k,999) - lu(k,943) * lu(k,978) - lu(k,1022) = lu(k,1022) - lu(k,923) * lu(k,1021) - lu(k,1023) = lu(k,1023) - lu(k,924) * lu(k,1021) - lu(k,1024) = lu(k,1024) - lu(k,925) * lu(k,1021) - lu(k,1025) = lu(k,1025) - lu(k,926) * lu(k,1021) - lu(k,1026) = lu(k,1026) - lu(k,927) * lu(k,1021) - lu(k,1027) = lu(k,1027) - lu(k,928) * lu(k,1021) - lu(k,1028) = lu(k,1028) - lu(k,929) * lu(k,1021) - lu(k,1029) = lu(k,1029) - lu(k,930) * lu(k,1021) - lu(k,1030) = lu(k,1030) - lu(k,931) * lu(k,1021) - lu(k,1031) = lu(k,1031) - lu(k,932) * lu(k,1021) - lu(k,1032) = lu(k,1032) - lu(k,933) * lu(k,1021) - lu(k,1033) = lu(k,1033) - lu(k,934) * lu(k,1021) - lu(k,1034) = lu(k,1034) - lu(k,935) * lu(k,1021) - lu(k,1035) = lu(k,1035) - lu(k,936) * lu(k,1021) - lu(k,1036) = lu(k,1036) - lu(k,937) * lu(k,1021) - lu(k,1037) = lu(k,1037) - lu(k,938) * lu(k,1021) - lu(k,1038) = lu(k,1038) - lu(k,939) * lu(k,1021) - lu(k,1039) = lu(k,1039) - lu(k,940) * lu(k,1021) - lu(k,1040) = lu(k,1040) - lu(k,941) * lu(k,1021) - lu(k,1041) = lu(k,1041) - lu(k,942) * lu(k,1021) - lu(k,1042) = lu(k,1042) - lu(k,943) * lu(k,1021) - lu(k,1064) = lu(k,1064) - lu(k,923) * lu(k,1063) - lu(k,1065) = lu(k,1065) - lu(k,924) * lu(k,1063) - lu(k,1066) = lu(k,1066) - lu(k,925) * lu(k,1063) - lu(k,1067) = lu(k,1067) - lu(k,926) * lu(k,1063) - lu(k,1068) = lu(k,1068) - lu(k,927) * lu(k,1063) - lu(k,1069) = lu(k,1069) - lu(k,928) * lu(k,1063) - lu(k,1070) = lu(k,1070) - lu(k,929) * lu(k,1063) - lu(k,1071) = lu(k,1071) - lu(k,930) * lu(k,1063) - lu(k,1072) = lu(k,1072) - lu(k,931) * lu(k,1063) - lu(k,1073) = lu(k,1073) - lu(k,932) * lu(k,1063) - lu(k,1074) = lu(k,1074) - lu(k,933) * lu(k,1063) - lu(k,1075) = lu(k,1075) - lu(k,934) * lu(k,1063) - lu(k,1076) = lu(k,1076) - lu(k,935) * lu(k,1063) - lu(k,1077) = lu(k,1077) - lu(k,936) * lu(k,1063) - lu(k,1078) = lu(k,1078) - lu(k,937) * lu(k,1063) - lu(k,1079) = lu(k,1079) - lu(k,938) * lu(k,1063) - lu(k,1080) = lu(k,1080) - lu(k,939) * lu(k,1063) - lu(k,1081) = lu(k,1081) - lu(k,940) * lu(k,1063) - lu(k,1082) = lu(k,1082) - lu(k,941) * lu(k,1063) - lu(k,1083) = lu(k,1083) - lu(k,942) * lu(k,1063) - lu(k,1084) = lu(k,1084) - lu(k,943) * lu(k,1063) - lu(k,1104) = lu(k,1104) - lu(k,923) * lu(k,1103) - lu(k,1105) = lu(k,1105) - lu(k,924) * lu(k,1103) - lu(k,1106) = lu(k,1106) - lu(k,925) * lu(k,1103) - lu(k,1107) = lu(k,1107) - lu(k,926) * lu(k,1103) - lu(k,1108) = lu(k,1108) - lu(k,927) * lu(k,1103) - lu(k,1109) = lu(k,1109) - lu(k,928) * lu(k,1103) - lu(k,1110) = lu(k,1110) - lu(k,929) * lu(k,1103) - lu(k,1111) = lu(k,1111) - lu(k,930) * lu(k,1103) - lu(k,1112) = lu(k,1112) - lu(k,931) * lu(k,1103) - lu(k,1113) = lu(k,1113) - lu(k,932) * lu(k,1103) - lu(k,1114) = lu(k,1114) - lu(k,933) * lu(k,1103) - lu(k,1115) = lu(k,1115) - lu(k,934) * lu(k,1103) - lu(k,1116) = lu(k,1116) - lu(k,935) * lu(k,1103) - lu(k,1117) = lu(k,1117) - lu(k,936) * lu(k,1103) - lu(k,1118) = lu(k,1118) - lu(k,937) * lu(k,1103) - lu(k,1119) = lu(k,1119) - lu(k,938) * lu(k,1103) - lu(k,1120) = lu(k,1120) - lu(k,939) * lu(k,1103) - lu(k,1121) = lu(k,1121) - lu(k,940) * lu(k,1103) - lu(k,1122) = lu(k,1122) - lu(k,941) * lu(k,1103) - lu(k,1123) = lu(k,1123) - lu(k,942) * lu(k,1103) - lu(k,1124) = lu(k,1124) - lu(k,943) * lu(k,1103) - lu(k,1149) = lu(k,1149) - lu(k,923) * lu(k,1148) - lu(k,1150) = lu(k,1150) - lu(k,924) * lu(k,1148) - lu(k,1151) = lu(k,1151) - lu(k,925) * lu(k,1148) - lu(k,1152) = lu(k,1152) - lu(k,926) * lu(k,1148) - lu(k,1153) = lu(k,1153) - lu(k,927) * lu(k,1148) - lu(k,1154) = lu(k,1154) - lu(k,928) * lu(k,1148) - lu(k,1155) = lu(k,1155) - lu(k,929) * lu(k,1148) - lu(k,1156) = lu(k,1156) - lu(k,930) * lu(k,1148) - lu(k,1157) = lu(k,1157) - lu(k,931) * lu(k,1148) - lu(k,1158) = lu(k,1158) - lu(k,932) * lu(k,1148) - lu(k,1159) = lu(k,1159) - lu(k,933) * lu(k,1148) - lu(k,1160) = lu(k,1160) - lu(k,934) * lu(k,1148) - lu(k,1161) = lu(k,1161) - lu(k,935) * lu(k,1148) - lu(k,1162) = lu(k,1162) - lu(k,936) * lu(k,1148) - lu(k,1163) = lu(k,1163) - lu(k,937) * lu(k,1148) - lu(k,1164) = lu(k,1164) - lu(k,938) * lu(k,1148) - lu(k,1165) = lu(k,1165) - lu(k,939) * lu(k,1148) - lu(k,1166) = lu(k,1166) - lu(k,940) * lu(k,1148) - lu(k,1167) = lu(k,1167) - lu(k,941) * lu(k,1148) - lu(k,1168) = lu(k,1168) - lu(k,942) * lu(k,1148) - lu(k,1169) = lu(k,1169) - lu(k,943) * lu(k,1148) - lu(k,1192) = lu(k,1192) - lu(k,923) * lu(k,1191) - lu(k,1193) = lu(k,1193) - lu(k,924) * lu(k,1191) - lu(k,1194) = lu(k,1194) - lu(k,925) * lu(k,1191) - lu(k,1195) = lu(k,1195) - lu(k,926) * lu(k,1191) - lu(k,1196) = lu(k,1196) - lu(k,927) * lu(k,1191) - lu(k,1197) = lu(k,1197) - lu(k,928) * lu(k,1191) - lu(k,1198) = lu(k,1198) - lu(k,929) * lu(k,1191) - lu(k,1199) = lu(k,1199) - lu(k,930) * lu(k,1191) - lu(k,1200) = lu(k,1200) - lu(k,931) * lu(k,1191) - lu(k,1201) = lu(k,1201) - lu(k,932) * lu(k,1191) - lu(k,1202) = lu(k,1202) - lu(k,933) * lu(k,1191) - lu(k,1203) = lu(k,1203) - lu(k,934) * lu(k,1191) - lu(k,1204) = lu(k,1204) - lu(k,935) * lu(k,1191) - lu(k,1205) = lu(k,1205) - lu(k,936) * lu(k,1191) - lu(k,1206) = lu(k,1206) - lu(k,937) * lu(k,1191) - lu(k,1207) = lu(k,1207) - lu(k,938) * lu(k,1191) - lu(k,1208) = lu(k,1208) - lu(k,939) * lu(k,1191) - lu(k,1209) = lu(k,1209) - lu(k,940) * lu(k,1191) - lu(k,1210) = lu(k,1210) - lu(k,941) * lu(k,1191) - lu(k,1211) = lu(k,1211) - lu(k,942) * lu(k,1191) - lu(k,1212) = lu(k,1212) - lu(k,943) * lu(k,1191) - lu(k,1227) = lu(k,1227) - lu(k,923) * lu(k,1226) - lu(k,1228) = lu(k,1228) - lu(k,924) * lu(k,1226) - lu(k,1229) = lu(k,1229) - lu(k,925) * lu(k,1226) - lu(k,1230) = lu(k,1230) - lu(k,926) * lu(k,1226) - lu(k,1231) = lu(k,1231) - lu(k,927) * lu(k,1226) - lu(k,1232) = lu(k,1232) - lu(k,928) * lu(k,1226) - lu(k,1233) = lu(k,1233) - lu(k,929) * lu(k,1226) - lu(k,1234) = lu(k,1234) - lu(k,930) * lu(k,1226) - lu(k,1235) = lu(k,1235) - lu(k,931) * lu(k,1226) - lu(k,1236) = lu(k,1236) - lu(k,932) * lu(k,1226) - lu(k,1237) = lu(k,1237) - lu(k,933) * lu(k,1226) - lu(k,1238) = lu(k,1238) - lu(k,934) * lu(k,1226) - lu(k,1239) = lu(k,1239) - lu(k,935) * lu(k,1226) - lu(k,1240) = lu(k,1240) - lu(k,936) * lu(k,1226) - lu(k,1241) = lu(k,1241) - lu(k,937) * lu(k,1226) - lu(k,1242) = lu(k,1242) - lu(k,938) * lu(k,1226) - lu(k,1243) = lu(k,1243) - lu(k,939) * lu(k,1226) - lu(k,1244) = lu(k,1244) - lu(k,940) * lu(k,1226) - lu(k,1245) = lu(k,1245) - lu(k,941) * lu(k,1226) - lu(k,1246) = lu(k,1246) - lu(k,942) * lu(k,1226) - lu(k,1247) = lu(k,1247) - lu(k,943) * lu(k,1226) - lu(k,1270) = lu(k,1270) - lu(k,923) * lu(k,1269) - lu(k,1271) = lu(k,1271) - lu(k,924) * lu(k,1269) - lu(k,1272) = lu(k,1272) - lu(k,925) * lu(k,1269) - lu(k,1273) = lu(k,1273) - lu(k,926) * lu(k,1269) - lu(k,1274) = lu(k,1274) - lu(k,927) * lu(k,1269) - lu(k,1275) = lu(k,1275) - lu(k,928) * lu(k,1269) - lu(k,1276) = lu(k,1276) - lu(k,929) * lu(k,1269) - lu(k,1277) = lu(k,1277) - lu(k,930) * lu(k,1269) - lu(k,1278) = lu(k,1278) - lu(k,931) * lu(k,1269) - lu(k,1279) = lu(k,1279) - lu(k,932) * lu(k,1269) - lu(k,1280) = lu(k,1280) - lu(k,933) * lu(k,1269) - lu(k,1281) = lu(k,1281) - lu(k,934) * lu(k,1269) - lu(k,1282) = lu(k,1282) - lu(k,935) * lu(k,1269) - lu(k,1283) = lu(k,1283) - lu(k,936) * lu(k,1269) - lu(k,1284) = lu(k,1284) - lu(k,937) * lu(k,1269) - lu(k,1285) = lu(k,1285) - lu(k,938) * lu(k,1269) - lu(k,1286) = lu(k,1286) - lu(k,939) * lu(k,1269) - lu(k,1287) = lu(k,1287) - lu(k,940) * lu(k,1269) - lu(k,1288) = lu(k,1288) - lu(k,941) * lu(k,1269) - lu(k,1289) = lu(k,1289) - lu(k,942) * lu(k,1269) - lu(k,1290) = lu(k,1290) - lu(k,943) * lu(k,1269) - lu(k,1306) = lu(k,1306) - lu(k,923) * lu(k,1305) - lu(k,1307) = lu(k,1307) - lu(k,924) * lu(k,1305) - lu(k,1308) = lu(k,1308) - lu(k,925) * lu(k,1305) - lu(k,1309) = lu(k,1309) - lu(k,926) * lu(k,1305) - lu(k,1310) = lu(k,1310) - lu(k,927) * lu(k,1305) - lu(k,1311) = lu(k,1311) - lu(k,928) * lu(k,1305) - lu(k,1312) = lu(k,1312) - lu(k,929) * lu(k,1305) - lu(k,1313) = lu(k,1313) - lu(k,930) * lu(k,1305) - lu(k,1314) = lu(k,1314) - lu(k,931) * lu(k,1305) - lu(k,1315) = lu(k,1315) - lu(k,932) * lu(k,1305) - lu(k,1316) = lu(k,1316) - lu(k,933) * lu(k,1305) - lu(k,1317) = lu(k,1317) - lu(k,934) * lu(k,1305) - lu(k,1318) = lu(k,1318) - lu(k,935) * lu(k,1305) - lu(k,1319) = lu(k,1319) - lu(k,936) * lu(k,1305) - lu(k,1320) = lu(k,1320) - lu(k,937) * lu(k,1305) - lu(k,1321) = lu(k,1321) - lu(k,938) * lu(k,1305) - lu(k,1322) = lu(k,1322) - lu(k,939) * lu(k,1305) - lu(k,1323) = lu(k,1323) - lu(k,940) * lu(k,1305) - lu(k,1324) = lu(k,1324) - lu(k,941) * lu(k,1305) - lu(k,1325) = lu(k,1325) - lu(k,942) * lu(k,1305) - lu(k,1326) = lu(k,1326) - lu(k,943) * lu(k,1305) - lu(k,1351) = lu(k,1351) - lu(k,923) * lu(k,1350) - lu(k,1352) = lu(k,1352) - lu(k,924) * lu(k,1350) - lu(k,1353) = lu(k,1353) - lu(k,925) * lu(k,1350) - lu(k,1354) = lu(k,1354) - lu(k,926) * lu(k,1350) - lu(k,1355) = lu(k,1355) - lu(k,927) * lu(k,1350) - lu(k,1356) = lu(k,1356) - lu(k,928) * lu(k,1350) - lu(k,1357) = lu(k,1357) - lu(k,929) * lu(k,1350) - lu(k,1358) = lu(k,1358) - lu(k,930) * lu(k,1350) - lu(k,1359) = lu(k,1359) - lu(k,931) * lu(k,1350) - lu(k,1360) = lu(k,1360) - lu(k,932) * lu(k,1350) - lu(k,1361) = lu(k,1361) - lu(k,933) * lu(k,1350) - lu(k,1362) = lu(k,1362) - lu(k,934) * lu(k,1350) - lu(k,1363) = lu(k,1363) - lu(k,935) * lu(k,1350) - lu(k,1364) = lu(k,1364) - lu(k,936) * lu(k,1350) - lu(k,1365) = lu(k,1365) - lu(k,937) * lu(k,1350) - lu(k,1366) = lu(k,1366) - lu(k,938) * lu(k,1350) - lu(k,1367) = lu(k,1367) - lu(k,939) * lu(k,1350) - lu(k,1368) = lu(k,1368) - lu(k,940) * lu(k,1350) - lu(k,1369) = lu(k,1369) - lu(k,941) * lu(k,1350) - lu(k,1370) = lu(k,1370) - lu(k,942) * lu(k,1350) - lu(k,1371) = lu(k,1371) - lu(k,943) * lu(k,1350) - lu(k,1393) = lu(k,1393) - lu(k,923) * lu(k,1392) - lu(k,1394) = lu(k,1394) - lu(k,924) * lu(k,1392) - lu(k,1395) = lu(k,1395) - lu(k,925) * lu(k,1392) - lu(k,1396) = lu(k,1396) - lu(k,926) * lu(k,1392) - lu(k,1397) = lu(k,1397) - lu(k,927) * lu(k,1392) - lu(k,1398) = lu(k,1398) - lu(k,928) * lu(k,1392) - lu(k,1399) = lu(k,1399) - lu(k,929) * lu(k,1392) - lu(k,1400) = lu(k,1400) - lu(k,930) * lu(k,1392) - lu(k,1401) = lu(k,1401) - lu(k,931) * lu(k,1392) - lu(k,1402) = lu(k,1402) - lu(k,932) * lu(k,1392) - lu(k,1403) = lu(k,1403) - lu(k,933) * lu(k,1392) - lu(k,1404) = lu(k,1404) - lu(k,934) * lu(k,1392) - lu(k,1405) = lu(k,1405) - lu(k,935) * lu(k,1392) - lu(k,1406) = lu(k,1406) - lu(k,936) * lu(k,1392) - lu(k,1407) = lu(k,1407) - lu(k,937) * lu(k,1392) - lu(k,1408) = lu(k,1408) - lu(k,938) * lu(k,1392) - lu(k,1409) = lu(k,1409) - lu(k,939) * lu(k,1392) - lu(k,1410) = lu(k,1410) - lu(k,940) * lu(k,1392) - lu(k,1411) = lu(k,1411) - lu(k,941) * lu(k,1392) - lu(k,1412) = lu(k,1412) - lu(k,942) * lu(k,1392) - lu(k,1413) = lu(k,1413) - lu(k,943) * lu(k,1392) - lu(k,1431) = lu(k,1431) - lu(k,923) * lu(k,1430) - lu(k,1432) = lu(k,1432) - lu(k,924) * lu(k,1430) - lu(k,1433) = lu(k,1433) - lu(k,925) * lu(k,1430) - lu(k,1434) = lu(k,1434) - lu(k,926) * lu(k,1430) - lu(k,1435) = lu(k,1435) - lu(k,927) * lu(k,1430) - lu(k,1436) = lu(k,1436) - lu(k,928) * lu(k,1430) - lu(k,1437) = lu(k,1437) - lu(k,929) * lu(k,1430) - lu(k,1438) = lu(k,1438) - lu(k,930) * lu(k,1430) - lu(k,1439) = lu(k,1439) - lu(k,931) * lu(k,1430) - lu(k,1440) = lu(k,1440) - lu(k,932) * lu(k,1430) - lu(k,1441) = lu(k,1441) - lu(k,933) * lu(k,1430) - lu(k,1442) = lu(k,1442) - lu(k,934) * lu(k,1430) - lu(k,1443) = lu(k,1443) - lu(k,935) * lu(k,1430) - lu(k,1444) = lu(k,1444) - lu(k,936) * lu(k,1430) - lu(k,1445) = lu(k,1445) - lu(k,937) * lu(k,1430) - lu(k,1446) = lu(k,1446) - lu(k,938) * lu(k,1430) - lu(k,1447) = lu(k,1447) - lu(k,939) * lu(k,1430) - lu(k,1448) = lu(k,1448) - lu(k,940) * lu(k,1430) - lu(k,1449) = lu(k,1449) - lu(k,941) * lu(k,1430) - lu(k,1450) = lu(k,1450) - lu(k,942) * lu(k,1430) - lu(k,1451) = lu(k,1451) - lu(k,943) * lu(k,1430) - lu(k,1476) = lu(k,1476) - lu(k,923) * lu(k,1475) - lu(k,1477) = lu(k,1477) - lu(k,924) * lu(k,1475) - lu(k,1478) = lu(k,1478) - lu(k,925) * lu(k,1475) - lu(k,1479) = lu(k,1479) - lu(k,926) * lu(k,1475) - lu(k,1480) = lu(k,1480) - lu(k,927) * lu(k,1475) - lu(k,1481) = lu(k,1481) - lu(k,928) * lu(k,1475) - lu(k,1482) = lu(k,1482) - lu(k,929) * lu(k,1475) - lu(k,1483) = lu(k,1483) - lu(k,930) * lu(k,1475) - lu(k,1484) = lu(k,1484) - lu(k,931) * lu(k,1475) - lu(k,1485) = lu(k,1485) - lu(k,932) * lu(k,1475) - lu(k,1486) = lu(k,1486) - lu(k,933) * lu(k,1475) - lu(k,1487) = lu(k,1487) - lu(k,934) * lu(k,1475) - lu(k,1488) = lu(k,1488) - lu(k,935) * lu(k,1475) - lu(k,1489) = lu(k,1489) - lu(k,936) * lu(k,1475) - lu(k,1490) = lu(k,1490) - lu(k,937) * lu(k,1475) - lu(k,1491) = lu(k,1491) - lu(k,938) * lu(k,1475) - lu(k,1492) = lu(k,1492) - lu(k,939) * lu(k,1475) - lu(k,1493) = lu(k,1493) - lu(k,940) * lu(k,1475) - lu(k,1494) = lu(k,1494) - lu(k,941) * lu(k,1475) - lu(k,1495) = lu(k,1495) - lu(k,942) * lu(k,1475) - lu(k,1496) = lu(k,1496) - lu(k,943) * lu(k,1475) - lu(k,1519) = lu(k,1519) - lu(k,923) * lu(k,1518) - lu(k,1520) = lu(k,1520) - lu(k,924) * lu(k,1518) - lu(k,1521) = lu(k,1521) - lu(k,925) * lu(k,1518) - lu(k,1522) = lu(k,1522) - lu(k,926) * lu(k,1518) - lu(k,1523) = lu(k,1523) - lu(k,927) * lu(k,1518) - lu(k,1524) = lu(k,1524) - lu(k,928) * lu(k,1518) - lu(k,1525) = lu(k,1525) - lu(k,929) * lu(k,1518) - lu(k,1526) = lu(k,1526) - lu(k,930) * lu(k,1518) - lu(k,1527) = lu(k,1527) - lu(k,931) * lu(k,1518) - lu(k,1528) = lu(k,1528) - lu(k,932) * lu(k,1518) - lu(k,1529) = lu(k,1529) - lu(k,933) * lu(k,1518) - lu(k,1530) = lu(k,1530) - lu(k,934) * lu(k,1518) - lu(k,1531) = lu(k,1531) - lu(k,935) * lu(k,1518) - lu(k,1532) = lu(k,1532) - lu(k,936) * lu(k,1518) - lu(k,1533) = lu(k,1533) - lu(k,937) * lu(k,1518) - lu(k,1534) = lu(k,1534) - lu(k,938) * lu(k,1518) - lu(k,1535) = lu(k,1535) - lu(k,939) * lu(k,1518) - lu(k,1536) = lu(k,1536) - lu(k,940) * lu(k,1518) - lu(k,1537) = lu(k,1537) - lu(k,941) * lu(k,1518) - lu(k,1538) = lu(k,1538) - lu(k,942) * lu(k,1518) - lu(k,1539) = lu(k,1539) - lu(k,943) * lu(k,1518) - lu(k,1562) = lu(k,1562) - lu(k,923) * lu(k,1561) - lu(k,1563) = lu(k,1563) - lu(k,924) * lu(k,1561) - lu(k,1564) = lu(k,1564) - lu(k,925) * lu(k,1561) - lu(k,1565) = lu(k,1565) - lu(k,926) * lu(k,1561) - lu(k,1566) = lu(k,1566) - lu(k,927) * lu(k,1561) - lu(k,1567) = lu(k,1567) - lu(k,928) * lu(k,1561) - lu(k,1568) = lu(k,1568) - lu(k,929) * lu(k,1561) - lu(k,1569) = lu(k,1569) - lu(k,930) * lu(k,1561) - lu(k,1570) = lu(k,1570) - lu(k,931) * lu(k,1561) - lu(k,1571) = lu(k,1571) - lu(k,932) * lu(k,1561) - lu(k,1572) = lu(k,1572) - lu(k,933) * lu(k,1561) - lu(k,1573) = lu(k,1573) - lu(k,934) * lu(k,1561) - lu(k,1574) = lu(k,1574) - lu(k,935) * lu(k,1561) - lu(k,1575) = lu(k,1575) - lu(k,936) * lu(k,1561) - lu(k,1576) = lu(k,1576) - lu(k,937) * lu(k,1561) - lu(k,1577) = lu(k,1577) - lu(k,938) * lu(k,1561) - lu(k,1578) = lu(k,1578) - lu(k,939) * lu(k,1561) - lu(k,1579) = lu(k,1579) - lu(k,940) * lu(k,1561) - lu(k,1580) = lu(k,1580) - lu(k,941) * lu(k,1561) - lu(k,1581) = lu(k,1581) - lu(k,942) * lu(k,1561) - lu(k,1582) = lu(k,1582) - lu(k,943) * lu(k,1561) - lu(k,1595) = lu(k,1595) - lu(k,923) * lu(k,1594) - lu(k,1596) = lu(k,1596) - lu(k,924) * lu(k,1594) - lu(k,1597) = lu(k,1597) - lu(k,925) * lu(k,1594) - lu(k,1598) = lu(k,1598) - lu(k,926) * lu(k,1594) - lu(k,1599) = lu(k,1599) - lu(k,927) * lu(k,1594) - lu(k,1600) = lu(k,1600) - lu(k,928) * lu(k,1594) - lu(k,1601) = lu(k,1601) - lu(k,929) * lu(k,1594) - lu(k,1602) = lu(k,1602) - lu(k,930) * lu(k,1594) - lu(k,1603) = lu(k,1603) - lu(k,931) * lu(k,1594) - lu(k,1604) = lu(k,1604) - lu(k,932) * lu(k,1594) - lu(k,1605) = lu(k,1605) - lu(k,933) * lu(k,1594) - lu(k,1606) = lu(k,1606) - lu(k,934) * lu(k,1594) - lu(k,1607) = lu(k,1607) - lu(k,935) * lu(k,1594) - lu(k,1608) = lu(k,1608) - lu(k,936) * lu(k,1594) - lu(k,1609) = lu(k,1609) - lu(k,937) * lu(k,1594) - lu(k,1610) = lu(k,1610) - lu(k,938) * lu(k,1594) - lu(k,1611) = lu(k,1611) - lu(k,939) * lu(k,1594) - lu(k,1612) = lu(k,1612) - lu(k,940) * lu(k,1594) - lu(k,1613) = lu(k,1613) - lu(k,941) * lu(k,1594) - lu(k,1614) = lu(k,1614) - lu(k,942) * lu(k,1594) - lu(k,1615) = lu(k,1615) - lu(k,943) * lu(k,1594) - lu(k,1631) = lu(k,1631) - lu(k,923) * lu(k,1630) - lu(k,1632) = lu(k,1632) - lu(k,924) * lu(k,1630) - lu(k,1633) = lu(k,1633) - lu(k,925) * lu(k,1630) - lu(k,1634) = lu(k,1634) - lu(k,926) * lu(k,1630) - lu(k,1635) = lu(k,1635) - lu(k,927) * lu(k,1630) - lu(k,1636) = lu(k,1636) - lu(k,928) * lu(k,1630) - lu(k,1637) = lu(k,1637) - lu(k,929) * lu(k,1630) - lu(k,1638) = lu(k,1638) - lu(k,930) * lu(k,1630) - lu(k,1639) = lu(k,1639) - lu(k,931) * lu(k,1630) - lu(k,1640) = lu(k,1640) - lu(k,932) * lu(k,1630) - lu(k,1641) = lu(k,1641) - lu(k,933) * lu(k,1630) - lu(k,1642) = lu(k,1642) - lu(k,934) * lu(k,1630) - lu(k,1643) = lu(k,1643) - lu(k,935) * lu(k,1630) - lu(k,1644) = lu(k,1644) - lu(k,936) * lu(k,1630) - lu(k,1645) = lu(k,1645) - lu(k,937) * lu(k,1630) - lu(k,1646) = lu(k,1646) - lu(k,938) * lu(k,1630) - lu(k,1647) = lu(k,1647) - lu(k,939) * lu(k,1630) - lu(k,1648) = lu(k,1648) - lu(k,940) * lu(k,1630) - lu(k,1649) = lu(k,1649) - lu(k,941) * lu(k,1630) - lu(k,1650) = lu(k,1650) - lu(k,942) * lu(k,1630) - lu(k,1651) = lu(k,1651) - lu(k,943) * lu(k,1630) - lu(k,1674) = lu(k,1674) - lu(k,923) * lu(k,1673) - lu(k,1675) = lu(k,1675) - lu(k,924) * lu(k,1673) - lu(k,1676) = lu(k,1676) - lu(k,925) * lu(k,1673) - lu(k,1677) = lu(k,1677) - lu(k,926) * lu(k,1673) - lu(k,1678) = lu(k,1678) - lu(k,927) * lu(k,1673) - lu(k,1679) = lu(k,1679) - lu(k,928) * lu(k,1673) - lu(k,1680) = lu(k,1680) - lu(k,929) * lu(k,1673) - lu(k,1681) = lu(k,1681) - lu(k,930) * lu(k,1673) - lu(k,1682) = lu(k,1682) - lu(k,931) * lu(k,1673) - lu(k,1683) = lu(k,1683) - lu(k,932) * lu(k,1673) - lu(k,1684) = lu(k,1684) - lu(k,933) * lu(k,1673) - lu(k,1685) = lu(k,1685) - lu(k,934) * lu(k,1673) - lu(k,1686) = lu(k,1686) - lu(k,935) * lu(k,1673) - lu(k,1687) = lu(k,1687) - lu(k,936) * lu(k,1673) - lu(k,1688) = lu(k,1688) - lu(k,937) * lu(k,1673) - lu(k,1689) = lu(k,1689) - lu(k,938) * lu(k,1673) - lu(k,1690) = lu(k,1690) - lu(k,939) * lu(k,1673) - lu(k,1691) = lu(k,1691) - lu(k,940) * lu(k,1673) - lu(k,1692) = lu(k,1692) - lu(k,941) * lu(k,1673) - lu(k,1693) = lu(k,1693) - lu(k,942) * lu(k,1673) - lu(k,1694) = lu(k,1694) - lu(k,943) * lu(k,1673) - lu(k,1710) = lu(k,1710) - lu(k,923) * lu(k,1709) - lu(k,1711) = lu(k,1711) - lu(k,924) * lu(k,1709) - lu(k,1712) = lu(k,1712) - lu(k,925) * lu(k,1709) - lu(k,1713) = lu(k,1713) - lu(k,926) * lu(k,1709) - lu(k,1714) = lu(k,1714) - lu(k,927) * lu(k,1709) - lu(k,1715) = lu(k,1715) - lu(k,928) * lu(k,1709) - lu(k,1716) = lu(k,1716) - lu(k,929) * lu(k,1709) - lu(k,1717) = lu(k,1717) - lu(k,930) * lu(k,1709) - lu(k,1718) = lu(k,1718) - lu(k,931) * lu(k,1709) - lu(k,1719) = lu(k,1719) - lu(k,932) * lu(k,1709) - lu(k,1720) = lu(k,1720) - lu(k,933) * lu(k,1709) - lu(k,1721) = lu(k,1721) - lu(k,934) * lu(k,1709) - lu(k,1722) = lu(k,1722) - lu(k,935) * lu(k,1709) - lu(k,1723) = lu(k,1723) - lu(k,936) * lu(k,1709) - lu(k,1724) = lu(k,1724) - lu(k,937) * lu(k,1709) - lu(k,1725) = lu(k,1725) - lu(k,938) * lu(k,1709) - lu(k,1726) = lu(k,1726) - lu(k,939) * lu(k,1709) - lu(k,1727) = lu(k,1727) - lu(k,940) * lu(k,1709) - lu(k,1728) = lu(k,1728) - lu(k,941) * lu(k,1709) - lu(k,1729) = lu(k,1729) - lu(k,942) * lu(k,1709) - lu(k,1730) = lu(k,1730) - lu(k,943) * lu(k,1709) - lu(k,1752) = lu(k,1752) - lu(k,923) * lu(k,1751) - lu(k,1753) = lu(k,1753) - lu(k,924) * lu(k,1751) - lu(k,1754) = lu(k,1754) - lu(k,925) * lu(k,1751) - lu(k,1755) = lu(k,1755) - lu(k,926) * lu(k,1751) - lu(k,1756) = lu(k,1756) - lu(k,927) * lu(k,1751) - lu(k,1757) = lu(k,1757) - lu(k,928) * lu(k,1751) - lu(k,1758) = lu(k,1758) - lu(k,929) * lu(k,1751) - lu(k,1759) = lu(k,1759) - lu(k,930) * lu(k,1751) - lu(k,1760) = lu(k,1760) - lu(k,931) * lu(k,1751) - lu(k,1761) = lu(k,1761) - lu(k,932) * lu(k,1751) - lu(k,1762) = lu(k,1762) - lu(k,933) * lu(k,1751) - lu(k,1763) = lu(k,1763) - lu(k,934) * lu(k,1751) - lu(k,1764) = lu(k,1764) - lu(k,935) * lu(k,1751) - lu(k,1765) = lu(k,1765) - lu(k,936) * lu(k,1751) - lu(k,1766) = lu(k,1766) - lu(k,937) * lu(k,1751) - lu(k,1767) = lu(k,1767) - lu(k,938) * lu(k,1751) - lu(k,1768) = lu(k,1768) - lu(k,939) * lu(k,1751) - lu(k,1769) = lu(k,1769) - lu(k,940) * lu(k,1751) - lu(k,1770) = lu(k,1770) - lu(k,941) * lu(k,1751) - lu(k,1771) = lu(k,1771) - lu(k,942) * lu(k,1751) - lu(k,1772) = lu(k,1772) - lu(k,943) * lu(k,1751) - lu(k,1805) = lu(k,1805) - lu(k,923) * lu(k,1804) - lu(k,1806) = lu(k,1806) - lu(k,924) * lu(k,1804) - lu(k,1807) = lu(k,1807) - lu(k,925) * lu(k,1804) - lu(k,1808) = lu(k,1808) - lu(k,926) * lu(k,1804) - lu(k,1809) = lu(k,1809) - lu(k,927) * lu(k,1804) - lu(k,1810) = lu(k,1810) - lu(k,928) * lu(k,1804) - lu(k,1811) = lu(k,1811) - lu(k,929) * lu(k,1804) - lu(k,1812) = lu(k,1812) - lu(k,930) * lu(k,1804) - lu(k,1813) = lu(k,1813) - lu(k,931) * lu(k,1804) - lu(k,1814) = lu(k,1814) - lu(k,932) * lu(k,1804) - lu(k,1815) = lu(k,1815) - lu(k,933) * lu(k,1804) - lu(k,1816) = lu(k,1816) - lu(k,934) * lu(k,1804) - lu(k,1817) = lu(k,1817) - lu(k,935) * lu(k,1804) - lu(k,1818) = lu(k,1818) - lu(k,936) * lu(k,1804) - lu(k,1819) = lu(k,1819) - lu(k,937) * lu(k,1804) - lu(k,1820) = lu(k,1820) - lu(k,938) * lu(k,1804) - lu(k,1821) = lu(k,1821) - lu(k,939) * lu(k,1804) - lu(k,1822) = lu(k,1822) - lu(k,940) * lu(k,1804) - lu(k,1823) = lu(k,1823) - lu(k,941) * lu(k,1804) - lu(k,1824) = lu(k,1824) - lu(k,942) * lu(k,1804) - lu(k,1825) = lu(k,1825) - lu(k,943) * lu(k,1804) - lu(k,979) = 1._r8 / lu(k,979) - lu(k,980) = lu(k,980) * lu(k,979) - lu(k,981) = lu(k,981) * lu(k,979) - lu(k,982) = lu(k,982) * lu(k,979) - lu(k,983) = lu(k,983) * lu(k,979) - lu(k,984) = lu(k,984) * lu(k,979) - lu(k,985) = lu(k,985) * lu(k,979) - lu(k,986) = lu(k,986) * lu(k,979) - lu(k,987) = lu(k,987) * lu(k,979) - lu(k,988) = lu(k,988) * lu(k,979) - lu(k,989) = lu(k,989) * lu(k,979) - lu(k,990) = lu(k,990) * lu(k,979) - lu(k,991) = lu(k,991) * lu(k,979) - lu(k,992) = lu(k,992) * lu(k,979) - lu(k,993) = lu(k,993) * lu(k,979) - lu(k,994) = lu(k,994) * lu(k,979) - lu(k,995) = lu(k,995) * lu(k,979) - lu(k,996) = lu(k,996) * lu(k,979) - lu(k,997) = lu(k,997) * lu(k,979) - lu(k,998) = lu(k,998) * lu(k,979) - lu(k,999) = lu(k,999) * lu(k,979) - lu(k,1023) = lu(k,1023) - lu(k,980) * lu(k,1022) - lu(k,1024) = lu(k,1024) - lu(k,981) * lu(k,1022) - lu(k,1025) = lu(k,1025) - lu(k,982) * lu(k,1022) - lu(k,1026) = lu(k,1026) - lu(k,983) * lu(k,1022) - lu(k,1027) = lu(k,1027) - lu(k,984) * lu(k,1022) - lu(k,1028) = lu(k,1028) - lu(k,985) * lu(k,1022) - lu(k,1029) = lu(k,1029) - lu(k,986) * lu(k,1022) - lu(k,1030) = lu(k,1030) - lu(k,987) * lu(k,1022) - lu(k,1031) = lu(k,1031) - lu(k,988) * lu(k,1022) - lu(k,1032) = lu(k,1032) - lu(k,989) * lu(k,1022) - lu(k,1033) = lu(k,1033) - lu(k,990) * lu(k,1022) - lu(k,1034) = lu(k,1034) - lu(k,991) * lu(k,1022) - lu(k,1035) = lu(k,1035) - lu(k,992) * lu(k,1022) - lu(k,1036) = lu(k,1036) - lu(k,993) * lu(k,1022) - lu(k,1037) = lu(k,1037) - lu(k,994) * lu(k,1022) - lu(k,1038) = lu(k,1038) - lu(k,995) * lu(k,1022) - lu(k,1039) = lu(k,1039) - lu(k,996) * lu(k,1022) - lu(k,1040) = lu(k,1040) - lu(k,997) * lu(k,1022) - lu(k,1041) = lu(k,1041) - lu(k,998) * lu(k,1022) - lu(k,1042) = lu(k,1042) - lu(k,999) * lu(k,1022) - lu(k,1065) = lu(k,1065) - lu(k,980) * lu(k,1064) - lu(k,1066) = lu(k,1066) - lu(k,981) * lu(k,1064) - lu(k,1067) = lu(k,1067) - lu(k,982) * lu(k,1064) - lu(k,1068) = lu(k,1068) - lu(k,983) * lu(k,1064) - lu(k,1069) = lu(k,1069) - lu(k,984) * lu(k,1064) - lu(k,1070) = lu(k,1070) - lu(k,985) * lu(k,1064) - lu(k,1071) = lu(k,1071) - lu(k,986) * lu(k,1064) - lu(k,1072) = lu(k,1072) - lu(k,987) * lu(k,1064) - lu(k,1073) = lu(k,1073) - lu(k,988) * lu(k,1064) - lu(k,1074) = lu(k,1074) - lu(k,989) * lu(k,1064) - lu(k,1075) = lu(k,1075) - lu(k,990) * lu(k,1064) - lu(k,1076) = lu(k,1076) - lu(k,991) * lu(k,1064) - lu(k,1077) = lu(k,1077) - lu(k,992) * lu(k,1064) - lu(k,1078) = lu(k,1078) - lu(k,993) * lu(k,1064) - lu(k,1079) = lu(k,1079) - lu(k,994) * lu(k,1064) - lu(k,1080) = lu(k,1080) - lu(k,995) * lu(k,1064) - lu(k,1081) = lu(k,1081) - lu(k,996) * lu(k,1064) - lu(k,1082) = lu(k,1082) - lu(k,997) * lu(k,1064) - lu(k,1083) = lu(k,1083) - lu(k,998) * lu(k,1064) - lu(k,1084) = lu(k,1084) - lu(k,999) * lu(k,1064) - lu(k,1105) = lu(k,1105) - lu(k,980) * lu(k,1104) - lu(k,1106) = lu(k,1106) - lu(k,981) * lu(k,1104) - lu(k,1107) = lu(k,1107) - lu(k,982) * lu(k,1104) - lu(k,1108) = lu(k,1108) - lu(k,983) * lu(k,1104) - lu(k,1109) = lu(k,1109) - lu(k,984) * lu(k,1104) - lu(k,1110) = lu(k,1110) - lu(k,985) * lu(k,1104) - lu(k,1111) = lu(k,1111) - lu(k,986) * lu(k,1104) - lu(k,1112) = lu(k,1112) - lu(k,987) * lu(k,1104) - lu(k,1113) = lu(k,1113) - lu(k,988) * lu(k,1104) - lu(k,1114) = lu(k,1114) - lu(k,989) * lu(k,1104) - lu(k,1115) = lu(k,1115) - lu(k,990) * lu(k,1104) - lu(k,1116) = lu(k,1116) - lu(k,991) * lu(k,1104) - lu(k,1117) = lu(k,1117) - lu(k,992) * lu(k,1104) - lu(k,1118) = lu(k,1118) - lu(k,993) * lu(k,1104) - lu(k,1119) = lu(k,1119) - lu(k,994) * lu(k,1104) - lu(k,1120) = lu(k,1120) - lu(k,995) * lu(k,1104) - lu(k,1121) = lu(k,1121) - lu(k,996) * lu(k,1104) - lu(k,1122) = lu(k,1122) - lu(k,997) * lu(k,1104) - lu(k,1123) = lu(k,1123) - lu(k,998) * lu(k,1104) - lu(k,1124) = lu(k,1124) - lu(k,999) * lu(k,1104) - lu(k,1150) = lu(k,1150) - lu(k,980) * lu(k,1149) - lu(k,1151) = lu(k,1151) - lu(k,981) * lu(k,1149) - lu(k,1152) = lu(k,1152) - lu(k,982) * lu(k,1149) - lu(k,1153) = lu(k,1153) - lu(k,983) * lu(k,1149) - lu(k,1154) = lu(k,1154) - lu(k,984) * lu(k,1149) - lu(k,1155) = lu(k,1155) - lu(k,985) * lu(k,1149) - lu(k,1156) = lu(k,1156) - lu(k,986) * lu(k,1149) - lu(k,1157) = lu(k,1157) - lu(k,987) * lu(k,1149) - lu(k,1158) = lu(k,1158) - lu(k,988) * lu(k,1149) - lu(k,1159) = lu(k,1159) - lu(k,989) * lu(k,1149) - lu(k,1160) = lu(k,1160) - lu(k,990) * lu(k,1149) - lu(k,1161) = lu(k,1161) - lu(k,991) * lu(k,1149) - lu(k,1162) = lu(k,1162) - lu(k,992) * lu(k,1149) - lu(k,1163) = lu(k,1163) - lu(k,993) * lu(k,1149) - lu(k,1164) = lu(k,1164) - lu(k,994) * lu(k,1149) - lu(k,1165) = lu(k,1165) - lu(k,995) * lu(k,1149) - lu(k,1166) = lu(k,1166) - lu(k,996) * lu(k,1149) - lu(k,1167) = lu(k,1167) - lu(k,997) * lu(k,1149) - lu(k,1168) = lu(k,1168) - lu(k,998) * lu(k,1149) - lu(k,1169) = lu(k,1169) - lu(k,999) * lu(k,1149) - lu(k,1193) = lu(k,1193) - lu(k,980) * lu(k,1192) - lu(k,1194) = lu(k,1194) - lu(k,981) * lu(k,1192) - lu(k,1195) = lu(k,1195) - lu(k,982) * lu(k,1192) - lu(k,1196) = lu(k,1196) - lu(k,983) * lu(k,1192) - lu(k,1197) = lu(k,1197) - lu(k,984) * lu(k,1192) - lu(k,1198) = lu(k,1198) - lu(k,985) * lu(k,1192) - lu(k,1199) = lu(k,1199) - lu(k,986) * lu(k,1192) - lu(k,1200) = lu(k,1200) - lu(k,987) * lu(k,1192) - lu(k,1201) = lu(k,1201) - lu(k,988) * lu(k,1192) - lu(k,1202) = lu(k,1202) - lu(k,989) * lu(k,1192) - lu(k,1203) = lu(k,1203) - lu(k,990) * lu(k,1192) - lu(k,1204) = lu(k,1204) - lu(k,991) * lu(k,1192) - lu(k,1205) = lu(k,1205) - lu(k,992) * lu(k,1192) - lu(k,1206) = lu(k,1206) - lu(k,993) * lu(k,1192) - lu(k,1207) = lu(k,1207) - lu(k,994) * lu(k,1192) - lu(k,1208) = lu(k,1208) - lu(k,995) * lu(k,1192) - lu(k,1209) = lu(k,1209) - lu(k,996) * lu(k,1192) - lu(k,1210) = lu(k,1210) - lu(k,997) * lu(k,1192) - lu(k,1211) = lu(k,1211) - lu(k,998) * lu(k,1192) - lu(k,1212) = lu(k,1212) - lu(k,999) * lu(k,1192) - lu(k,1228) = lu(k,1228) - lu(k,980) * lu(k,1227) - lu(k,1229) = lu(k,1229) - lu(k,981) * lu(k,1227) - lu(k,1230) = lu(k,1230) - lu(k,982) * lu(k,1227) - lu(k,1231) = lu(k,1231) - lu(k,983) * lu(k,1227) - lu(k,1232) = lu(k,1232) - lu(k,984) * lu(k,1227) - lu(k,1233) = lu(k,1233) - lu(k,985) * lu(k,1227) - lu(k,1234) = lu(k,1234) - lu(k,986) * lu(k,1227) - lu(k,1235) = lu(k,1235) - lu(k,987) * lu(k,1227) - lu(k,1236) = lu(k,1236) - lu(k,988) * lu(k,1227) - lu(k,1237) = lu(k,1237) - lu(k,989) * lu(k,1227) - lu(k,1238) = lu(k,1238) - lu(k,990) * lu(k,1227) - lu(k,1239) = lu(k,1239) - lu(k,991) * lu(k,1227) - lu(k,1240) = lu(k,1240) - lu(k,992) * lu(k,1227) - lu(k,1241) = lu(k,1241) - lu(k,993) * lu(k,1227) - lu(k,1242) = lu(k,1242) - lu(k,994) * lu(k,1227) - lu(k,1243) = lu(k,1243) - lu(k,995) * lu(k,1227) - lu(k,1244) = lu(k,1244) - lu(k,996) * lu(k,1227) - lu(k,1245) = lu(k,1245) - lu(k,997) * lu(k,1227) - lu(k,1246) = lu(k,1246) - lu(k,998) * lu(k,1227) - lu(k,1247) = lu(k,1247) - lu(k,999) * lu(k,1227) - lu(k,1271) = lu(k,1271) - lu(k,980) * lu(k,1270) - lu(k,1272) = lu(k,1272) - lu(k,981) * lu(k,1270) - lu(k,1273) = lu(k,1273) - lu(k,982) * lu(k,1270) - lu(k,1274) = lu(k,1274) - lu(k,983) * lu(k,1270) - lu(k,1275) = lu(k,1275) - lu(k,984) * lu(k,1270) - lu(k,1276) = lu(k,1276) - lu(k,985) * lu(k,1270) - lu(k,1277) = lu(k,1277) - lu(k,986) * lu(k,1270) - lu(k,1278) = lu(k,1278) - lu(k,987) * lu(k,1270) - lu(k,1279) = lu(k,1279) - lu(k,988) * lu(k,1270) - lu(k,1280) = lu(k,1280) - lu(k,989) * lu(k,1270) - lu(k,1281) = lu(k,1281) - lu(k,990) * lu(k,1270) - lu(k,1282) = lu(k,1282) - lu(k,991) * lu(k,1270) - lu(k,1283) = lu(k,1283) - lu(k,992) * lu(k,1270) - lu(k,1284) = lu(k,1284) - lu(k,993) * lu(k,1270) - lu(k,1285) = lu(k,1285) - lu(k,994) * lu(k,1270) - lu(k,1286) = lu(k,1286) - lu(k,995) * lu(k,1270) - lu(k,1287) = lu(k,1287) - lu(k,996) * lu(k,1270) - lu(k,1288) = lu(k,1288) - lu(k,997) * lu(k,1270) - lu(k,1289) = lu(k,1289) - lu(k,998) * lu(k,1270) - lu(k,1290) = lu(k,1290) - lu(k,999) * lu(k,1270) - lu(k,1307) = lu(k,1307) - lu(k,980) * lu(k,1306) - lu(k,1308) = lu(k,1308) - lu(k,981) * lu(k,1306) - lu(k,1309) = lu(k,1309) - lu(k,982) * lu(k,1306) - lu(k,1310) = lu(k,1310) - lu(k,983) * lu(k,1306) - lu(k,1311) = lu(k,1311) - lu(k,984) * lu(k,1306) - lu(k,1312) = lu(k,1312) - lu(k,985) * lu(k,1306) - lu(k,1313) = lu(k,1313) - lu(k,986) * lu(k,1306) - lu(k,1314) = lu(k,1314) - lu(k,987) * lu(k,1306) - lu(k,1315) = lu(k,1315) - lu(k,988) * lu(k,1306) - lu(k,1316) = lu(k,1316) - lu(k,989) * lu(k,1306) - lu(k,1317) = lu(k,1317) - lu(k,990) * lu(k,1306) - lu(k,1318) = lu(k,1318) - lu(k,991) * lu(k,1306) - lu(k,1319) = lu(k,1319) - lu(k,992) * lu(k,1306) - lu(k,1320) = lu(k,1320) - lu(k,993) * lu(k,1306) - lu(k,1321) = lu(k,1321) - lu(k,994) * lu(k,1306) - lu(k,1322) = lu(k,1322) - lu(k,995) * lu(k,1306) - lu(k,1323) = lu(k,1323) - lu(k,996) * lu(k,1306) - lu(k,1324) = lu(k,1324) - lu(k,997) * lu(k,1306) - lu(k,1325) = lu(k,1325) - lu(k,998) * lu(k,1306) - lu(k,1326) = lu(k,1326) - lu(k,999) * lu(k,1306) - lu(k,1352) = lu(k,1352) - lu(k,980) * lu(k,1351) - lu(k,1353) = lu(k,1353) - lu(k,981) * lu(k,1351) - lu(k,1354) = lu(k,1354) - lu(k,982) * lu(k,1351) - lu(k,1355) = lu(k,1355) - lu(k,983) * lu(k,1351) - lu(k,1356) = lu(k,1356) - lu(k,984) * lu(k,1351) - lu(k,1357) = lu(k,1357) - lu(k,985) * lu(k,1351) - lu(k,1358) = lu(k,1358) - lu(k,986) * lu(k,1351) - lu(k,1359) = lu(k,1359) - lu(k,987) * lu(k,1351) - lu(k,1360) = lu(k,1360) - lu(k,988) * lu(k,1351) - lu(k,1361) = lu(k,1361) - lu(k,989) * lu(k,1351) - lu(k,1362) = lu(k,1362) - lu(k,990) * lu(k,1351) - lu(k,1363) = lu(k,1363) - lu(k,991) * lu(k,1351) - lu(k,1364) = lu(k,1364) - lu(k,992) * lu(k,1351) - lu(k,1365) = lu(k,1365) - lu(k,993) * lu(k,1351) - lu(k,1366) = lu(k,1366) - lu(k,994) * lu(k,1351) - lu(k,1367) = lu(k,1367) - lu(k,995) * lu(k,1351) - lu(k,1368) = lu(k,1368) - lu(k,996) * lu(k,1351) - lu(k,1369) = lu(k,1369) - lu(k,997) * lu(k,1351) - lu(k,1370) = lu(k,1370) - lu(k,998) * lu(k,1351) - lu(k,1371) = lu(k,1371) - lu(k,999) * lu(k,1351) - lu(k,1394) = lu(k,1394) - lu(k,980) * lu(k,1393) - lu(k,1395) = lu(k,1395) - lu(k,981) * lu(k,1393) - lu(k,1396) = lu(k,1396) - lu(k,982) * lu(k,1393) - lu(k,1397) = lu(k,1397) - lu(k,983) * lu(k,1393) - lu(k,1398) = lu(k,1398) - lu(k,984) * lu(k,1393) - lu(k,1399) = lu(k,1399) - lu(k,985) * lu(k,1393) - lu(k,1400) = lu(k,1400) - lu(k,986) * lu(k,1393) - lu(k,1401) = lu(k,1401) - lu(k,987) * lu(k,1393) - lu(k,1402) = lu(k,1402) - lu(k,988) * lu(k,1393) - lu(k,1403) = lu(k,1403) - lu(k,989) * lu(k,1393) - lu(k,1404) = lu(k,1404) - lu(k,990) * lu(k,1393) - lu(k,1405) = lu(k,1405) - lu(k,991) * lu(k,1393) - lu(k,1406) = lu(k,1406) - lu(k,992) * lu(k,1393) - lu(k,1407) = lu(k,1407) - lu(k,993) * lu(k,1393) - lu(k,1408) = lu(k,1408) - lu(k,994) * lu(k,1393) - lu(k,1409) = lu(k,1409) - lu(k,995) * lu(k,1393) - lu(k,1410) = lu(k,1410) - lu(k,996) * lu(k,1393) - lu(k,1411) = lu(k,1411) - lu(k,997) * lu(k,1393) - lu(k,1412) = lu(k,1412) - lu(k,998) * lu(k,1393) - lu(k,1413) = lu(k,1413) - lu(k,999) * lu(k,1393) - lu(k,1432) = lu(k,1432) - lu(k,980) * lu(k,1431) - lu(k,1433) = lu(k,1433) - lu(k,981) * lu(k,1431) - lu(k,1434) = lu(k,1434) - lu(k,982) * lu(k,1431) - lu(k,1435) = lu(k,1435) - lu(k,983) * lu(k,1431) - lu(k,1436) = lu(k,1436) - lu(k,984) * lu(k,1431) - lu(k,1437) = lu(k,1437) - lu(k,985) * lu(k,1431) - lu(k,1438) = lu(k,1438) - lu(k,986) * lu(k,1431) - lu(k,1439) = lu(k,1439) - lu(k,987) * lu(k,1431) - lu(k,1440) = lu(k,1440) - lu(k,988) * lu(k,1431) - lu(k,1441) = lu(k,1441) - lu(k,989) * lu(k,1431) - lu(k,1442) = lu(k,1442) - lu(k,990) * lu(k,1431) - lu(k,1443) = lu(k,1443) - lu(k,991) * lu(k,1431) - lu(k,1444) = lu(k,1444) - lu(k,992) * lu(k,1431) - lu(k,1445) = lu(k,1445) - lu(k,993) * lu(k,1431) - lu(k,1446) = lu(k,1446) - lu(k,994) * lu(k,1431) - lu(k,1447) = lu(k,1447) - lu(k,995) * lu(k,1431) - lu(k,1448) = lu(k,1448) - lu(k,996) * lu(k,1431) - lu(k,1449) = lu(k,1449) - lu(k,997) * lu(k,1431) - lu(k,1450) = lu(k,1450) - lu(k,998) * lu(k,1431) - lu(k,1451) = lu(k,1451) - lu(k,999) * lu(k,1431) - lu(k,1477) = lu(k,1477) - lu(k,980) * lu(k,1476) - lu(k,1478) = lu(k,1478) - lu(k,981) * lu(k,1476) - lu(k,1479) = lu(k,1479) - lu(k,982) * lu(k,1476) - lu(k,1480) = lu(k,1480) - lu(k,983) * lu(k,1476) - lu(k,1481) = lu(k,1481) - lu(k,984) * lu(k,1476) - lu(k,1482) = lu(k,1482) - lu(k,985) * lu(k,1476) - lu(k,1483) = lu(k,1483) - lu(k,986) * lu(k,1476) - lu(k,1484) = lu(k,1484) - lu(k,987) * lu(k,1476) - lu(k,1485) = lu(k,1485) - lu(k,988) * lu(k,1476) - lu(k,1486) = lu(k,1486) - lu(k,989) * lu(k,1476) - lu(k,1487) = lu(k,1487) - lu(k,990) * lu(k,1476) - lu(k,1488) = lu(k,1488) - lu(k,991) * lu(k,1476) - lu(k,1489) = lu(k,1489) - lu(k,992) * lu(k,1476) - lu(k,1490) = lu(k,1490) - lu(k,993) * lu(k,1476) - lu(k,1491) = lu(k,1491) - lu(k,994) * lu(k,1476) - lu(k,1492) = lu(k,1492) - lu(k,995) * lu(k,1476) - lu(k,1493) = lu(k,1493) - lu(k,996) * lu(k,1476) - lu(k,1494) = lu(k,1494) - lu(k,997) * lu(k,1476) - lu(k,1495) = lu(k,1495) - lu(k,998) * lu(k,1476) - lu(k,1496) = lu(k,1496) - lu(k,999) * lu(k,1476) - lu(k,1520) = lu(k,1520) - lu(k,980) * lu(k,1519) - lu(k,1521) = lu(k,1521) - lu(k,981) * lu(k,1519) - lu(k,1522) = lu(k,1522) - lu(k,982) * lu(k,1519) - lu(k,1523) = lu(k,1523) - lu(k,983) * lu(k,1519) - lu(k,1524) = lu(k,1524) - lu(k,984) * lu(k,1519) - lu(k,1525) = lu(k,1525) - lu(k,985) * lu(k,1519) - lu(k,1526) = lu(k,1526) - lu(k,986) * lu(k,1519) - lu(k,1527) = lu(k,1527) - lu(k,987) * lu(k,1519) - lu(k,1528) = lu(k,1528) - lu(k,988) * lu(k,1519) - lu(k,1529) = lu(k,1529) - lu(k,989) * lu(k,1519) - lu(k,1530) = lu(k,1530) - lu(k,990) * lu(k,1519) - lu(k,1531) = lu(k,1531) - lu(k,991) * lu(k,1519) - lu(k,1532) = lu(k,1532) - lu(k,992) * lu(k,1519) - lu(k,1533) = lu(k,1533) - lu(k,993) * lu(k,1519) - lu(k,1534) = lu(k,1534) - lu(k,994) * lu(k,1519) - lu(k,1535) = lu(k,1535) - lu(k,995) * lu(k,1519) - lu(k,1536) = lu(k,1536) - lu(k,996) * lu(k,1519) - lu(k,1537) = lu(k,1537) - lu(k,997) * lu(k,1519) - lu(k,1538) = lu(k,1538) - lu(k,998) * lu(k,1519) - lu(k,1539) = lu(k,1539) - lu(k,999) * lu(k,1519) - lu(k,1563) = lu(k,1563) - lu(k,980) * lu(k,1562) - lu(k,1564) = lu(k,1564) - lu(k,981) * lu(k,1562) - lu(k,1565) = lu(k,1565) - lu(k,982) * lu(k,1562) - lu(k,1566) = lu(k,1566) - lu(k,983) * lu(k,1562) - lu(k,1567) = lu(k,1567) - lu(k,984) * lu(k,1562) - lu(k,1568) = lu(k,1568) - lu(k,985) * lu(k,1562) - lu(k,1569) = lu(k,1569) - lu(k,986) * lu(k,1562) - lu(k,1570) = lu(k,1570) - lu(k,987) * lu(k,1562) - lu(k,1571) = lu(k,1571) - lu(k,988) * lu(k,1562) - lu(k,1572) = lu(k,1572) - lu(k,989) * lu(k,1562) - lu(k,1573) = lu(k,1573) - lu(k,990) * lu(k,1562) - lu(k,1574) = lu(k,1574) - lu(k,991) * lu(k,1562) - lu(k,1575) = lu(k,1575) - lu(k,992) * lu(k,1562) - lu(k,1576) = lu(k,1576) - lu(k,993) * lu(k,1562) - lu(k,1577) = lu(k,1577) - lu(k,994) * lu(k,1562) - lu(k,1578) = lu(k,1578) - lu(k,995) * lu(k,1562) - lu(k,1579) = lu(k,1579) - lu(k,996) * lu(k,1562) - lu(k,1580) = lu(k,1580) - lu(k,997) * lu(k,1562) - lu(k,1581) = lu(k,1581) - lu(k,998) * lu(k,1562) - lu(k,1582) = lu(k,1582) - lu(k,999) * lu(k,1562) - lu(k,1596) = lu(k,1596) - lu(k,980) * lu(k,1595) - lu(k,1597) = lu(k,1597) - lu(k,981) * lu(k,1595) - lu(k,1598) = lu(k,1598) - lu(k,982) * lu(k,1595) - lu(k,1599) = lu(k,1599) - lu(k,983) * lu(k,1595) - lu(k,1600) = lu(k,1600) - lu(k,984) * lu(k,1595) - lu(k,1601) = lu(k,1601) - lu(k,985) * lu(k,1595) - lu(k,1602) = lu(k,1602) - lu(k,986) * lu(k,1595) - lu(k,1603) = lu(k,1603) - lu(k,987) * lu(k,1595) - lu(k,1604) = lu(k,1604) - lu(k,988) * lu(k,1595) - lu(k,1605) = lu(k,1605) - lu(k,989) * lu(k,1595) - lu(k,1606) = lu(k,1606) - lu(k,990) * lu(k,1595) - lu(k,1607) = lu(k,1607) - lu(k,991) * lu(k,1595) - lu(k,1608) = lu(k,1608) - lu(k,992) * lu(k,1595) - lu(k,1609) = lu(k,1609) - lu(k,993) * lu(k,1595) - lu(k,1610) = lu(k,1610) - lu(k,994) * lu(k,1595) - lu(k,1611) = lu(k,1611) - lu(k,995) * lu(k,1595) - lu(k,1612) = lu(k,1612) - lu(k,996) * lu(k,1595) - lu(k,1613) = lu(k,1613) - lu(k,997) * lu(k,1595) - lu(k,1614) = lu(k,1614) - lu(k,998) * lu(k,1595) - lu(k,1615) = lu(k,1615) - lu(k,999) * lu(k,1595) - lu(k,1632) = lu(k,1632) - lu(k,980) * lu(k,1631) - lu(k,1633) = lu(k,1633) - lu(k,981) * lu(k,1631) - lu(k,1634) = lu(k,1634) - lu(k,982) * lu(k,1631) - lu(k,1635) = lu(k,1635) - lu(k,983) * lu(k,1631) - lu(k,1636) = lu(k,1636) - lu(k,984) * lu(k,1631) - lu(k,1637) = lu(k,1637) - lu(k,985) * lu(k,1631) - lu(k,1638) = lu(k,1638) - lu(k,986) * lu(k,1631) - lu(k,1639) = lu(k,1639) - lu(k,987) * lu(k,1631) - lu(k,1640) = lu(k,1640) - lu(k,988) * lu(k,1631) - lu(k,1641) = lu(k,1641) - lu(k,989) * lu(k,1631) - lu(k,1642) = lu(k,1642) - lu(k,990) * lu(k,1631) - lu(k,1643) = lu(k,1643) - lu(k,991) * lu(k,1631) - lu(k,1644) = lu(k,1644) - lu(k,992) * lu(k,1631) - lu(k,1645) = lu(k,1645) - lu(k,993) * lu(k,1631) - lu(k,1646) = lu(k,1646) - lu(k,994) * lu(k,1631) - lu(k,1647) = lu(k,1647) - lu(k,995) * lu(k,1631) - lu(k,1648) = lu(k,1648) - lu(k,996) * lu(k,1631) - lu(k,1649) = lu(k,1649) - lu(k,997) * lu(k,1631) - lu(k,1650) = lu(k,1650) - lu(k,998) * lu(k,1631) - lu(k,1651) = lu(k,1651) - lu(k,999) * lu(k,1631) - lu(k,1675) = lu(k,1675) - lu(k,980) * lu(k,1674) - lu(k,1676) = lu(k,1676) - lu(k,981) * lu(k,1674) - lu(k,1677) = lu(k,1677) - lu(k,982) * lu(k,1674) - lu(k,1678) = lu(k,1678) - lu(k,983) * lu(k,1674) - lu(k,1679) = lu(k,1679) - lu(k,984) * lu(k,1674) - lu(k,1680) = lu(k,1680) - lu(k,985) * lu(k,1674) - lu(k,1681) = lu(k,1681) - lu(k,986) * lu(k,1674) - lu(k,1682) = lu(k,1682) - lu(k,987) * lu(k,1674) - lu(k,1683) = lu(k,1683) - lu(k,988) * lu(k,1674) - lu(k,1684) = lu(k,1684) - lu(k,989) * lu(k,1674) - lu(k,1685) = lu(k,1685) - lu(k,990) * lu(k,1674) - lu(k,1686) = lu(k,1686) - lu(k,991) * lu(k,1674) - lu(k,1687) = lu(k,1687) - lu(k,992) * lu(k,1674) - lu(k,1688) = lu(k,1688) - lu(k,993) * lu(k,1674) - lu(k,1689) = lu(k,1689) - lu(k,994) * lu(k,1674) - lu(k,1690) = lu(k,1690) - lu(k,995) * lu(k,1674) - lu(k,1691) = lu(k,1691) - lu(k,996) * lu(k,1674) - lu(k,1692) = lu(k,1692) - lu(k,997) * lu(k,1674) - lu(k,1693) = lu(k,1693) - lu(k,998) * lu(k,1674) - lu(k,1694) = lu(k,1694) - lu(k,999) * lu(k,1674) - lu(k,1711) = lu(k,1711) - lu(k,980) * lu(k,1710) - lu(k,1712) = lu(k,1712) - lu(k,981) * lu(k,1710) - lu(k,1713) = lu(k,1713) - lu(k,982) * lu(k,1710) - lu(k,1714) = lu(k,1714) - lu(k,983) * lu(k,1710) - lu(k,1715) = lu(k,1715) - lu(k,984) * lu(k,1710) - lu(k,1716) = lu(k,1716) - lu(k,985) * lu(k,1710) - lu(k,1717) = lu(k,1717) - lu(k,986) * lu(k,1710) - lu(k,1718) = lu(k,1718) - lu(k,987) * lu(k,1710) - lu(k,1719) = lu(k,1719) - lu(k,988) * lu(k,1710) - lu(k,1720) = lu(k,1720) - lu(k,989) * lu(k,1710) - lu(k,1721) = lu(k,1721) - lu(k,990) * lu(k,1710) - lu(k,1722) = lu(k,1722) - lu(k,991) * lu(k,1710) - lu(k,1723) = lu(k,1723) - lu(k,992) * lu(k,1710) - lu(k,1724) = lu(k,1724) - lu(k,993) * lu(k,1710) - lu(k,1725) = lu(k,1725) - lu(k,994) * lu(k,1710) - lu(k,1726) = lu(k,1726) - lu(k,995) * lu(k,1710) - lu(k,1727) = lu(k,1727) - lu(k,996) * lu(k,1710) - lu(k,1728) = lu(k,1728) - lu(k,997) * lu(k,1710) - lu(k,1729) = lu(k,1729) - lu(k,998) * lu(k,1710) - lu(k,1730) = lu(k,1730) - lu(k,999) * lu(k,1710) - lu(k,1753) = lu(k,1753) - lu(k,980) * lu(k,1752) - lu(k,1754) = lu(k,1754) - lu(k,981) * lu(k,1752) - lu(k,1755) = lu(k,1755) - lu(k,982) * lu(k,1752) - lu(k,1756) = lu(k,1756) - lu(k,983) * lu(k,1752) - lu(k,1757) = lu(k,1757) - lu(k,984) * lu(k,1752) - lu(k,1758) = lu(k,1758) - lu(k,985) * lu(k,1752) - lu(k,1759) = lu(k,1759) - lu(k,986) * lu(k,1752) - lu(k,1760) = lu(k,1760) - lu(k,987) * lu(k,1752) - lu(k,1761) = lu(k,1761) - lu(k,988) * lu(k,1752) - lu(k,1762) = lu(k,1762) - lu(k,989) * lu(k,1752) - lu(k,1763) = lu(k,1763) - lu(k,990) * lu(k,1752) - lu(k,1764) = lu(k,1764) - lu(k,991) * lu(k,1752) - lu(k,1765) = lu(k,1765) - lu(k,992) * lu(k,1752) - lu(k,1766) = lu(k,1766) - lu(k,993) * lu(k,1752) - lu(k,1767) = lu(k,1767) - lu(k,994) * lu(k,1752) - lu(k,1768) = lu(k,1768) - lu(k,995) * lu(k,1752) - lu(k,1769) = lu(k,1769) - lu(k,996) * lu(k,1752) - lu(k,1770) = lu(k,1770) - lu(k,997) * lu(k,1752) - lu(k,1771) = lu(k,1771) - lu(k,998) * lu(k,1752) - lu(k,1772) = lu(k,1772) - lu(k,999) * lu(k,1752) - lu(k,1806) = lu(k,1806) - lu(k,980) * lu(k,1805) - lu(k,1807) = lu(k,1807) - lu(k,981) * lu(k,1805) - lu(k,1808) = lu(k,1808) - lu(k,982) * lu(k,1805) - lu(k,1809) = lu(k,1809) - lu(k,983) * lu(k,1805) - lu(k,1810) = lu(k,1810) - lu(k,984) * lu(k,1805) - lu(k,1811) = lu(k,1811) - lu(k,985) * lu(k,1805) - lu(k,1812) = lu(k,1812) - lu(k,986) * lu(k,1805) - lu(k,1813) = lu(k,1813) - lu(k,987) * lu(k,1805) - lu(k,1814) = lu(k,1814) - lu(k,988) * lu(k,1805) - lu(k,1815) = lu(k,1815) - lu(k,989) * lu(k,1805) - lu(k,1816) = lu(k,1816) - lu(k,990) * lu(k,1805) - lu(k,1817) = lu(k,1817) - lu(k,991) * lu(k,1805) - lu(k,1818) = lu(k,1818) - lu(k,992) * lu(k,1805) - lu(k,1819) = lu(k,1819) - lu(k,993) * lu(k,1805) - lu(k,1820) = lu(k,1820) - lu(k,994) * lu(k,1805) - lu(k,1821) = lu(k,1821) - lu(k,995) * lu(k,1805) - lu(k,1822) = lu(k,1822) - lu(k,996) * lu(k,1805) - lu(k,1823) = lu(k,1823) - lu(k,997) * lu(k,1805) - lu(k,1824) = lu(k,1824) - lu(k,998) * lu(k,1805) - lu(k,1825) = lu(k,1825) - lu(k,999) * lu(k,1805) - end do + real(r8), intent(inout) :: lu(:) + lu(905) = 1._r8 / lu(905) + lu(906) = lu(906) * lu(905) + lu(907) = lu(907) * lu(905) + lu(908) = lu(908) * lu(905) + lu(909) = lu(909) * lu(905) + lu(910) = lu(910) * lu(905) + lu(911) = lu(911) * lu(905) + lu(912) = lu(912) * lu(905) + lu(913) = lu(913) * lu(905) + lu(914) = lu(914) * lu(905) + lu(915) = lu(915) * lu(905) + lu(916) = lu(916) * lu(905) + lu(917) = lu(917) * lu(905) + lu(918) = lu(918) * lu(905) + lu(919) = lu(919) * lu(905) + lu(920) = lu(920) * lu(905) + lu(921) = lu(921) * lu(905) + lu(922) = lu(922) * lu(905) + lu(923) = lu(923) * lu(905) + lu(924) = lu(924) * lu(905) + lu(925) = lu(925) * lu(905) + lu(941) = lu(941) - lu(906) * lu(940) + lu(942) = lu(942) - lu(907) * lu(940) + lu(943) = lu(943) - lu(908) * lu(940) + lu(944) = lu(944) - lu(909) * lu(940) + lu(945) = lu(945) - lu(910) * lu(940) + lu(946) = lu(946) - lu(911) * lu(940) + lu(947) = lu(947) - lu(912) * lu(940) + lu(948) = lu(948) - lu(913) * lu(940) + lu(949) = lu(949) - lu(914) * lu(940) + lu(950) = lu(950) - lu(915) * lu(940) + lu(951) = lu(951) - lu(916) * lu(940) + lu(952) = lu(952) - lu(917) * lu(940) + lu(953) = lu(953) - lu(918) * lu(940) + lu(954) = lu(954) - lu(919) * lu(940) + lu(955) = lu(955) - lu(920) * lu(940) + lu(956) = lu(956) - lu(921) * lu(940) + lu(957) = lu(957) - lu(922) * lu(940) + lu(958) = lu(958) - lu(923) * lu(940) + lu(959) = lu(959) - lu(924) * lu(940) + lu(960) = lu(960) - lu(925) * lu(940) + lu(982) = lu(982) - lu(906) * lu(981) + lu(983) = lu(983) - lu(907) * lu(981) + lu(984) = lu(984) - lu(908) * lu(981) + lu(985) = lu(985) - lu(909) * lu(981) + lu(986) = lu(986) - lu(910) * lu(981) + lu(987) = lu(987) - lu(911) * lu(981) + lu(988) = lu(988) - lu(912) * lu(981) + lu(989) = lu(989) - lu(913) * lu(981) + lu(990) = lu(990) - lu(914) * lu(981) + lu(991) = lu(991) - lu(915) * lu(981) + lu(992) = lu(992) - lu(916) * lu(981) + lu(993) = lu(993) - lu(917) * lu(981) + lu(994) = lu(994) - lu(918) * lu(981) + lu(995) = lu(995) - lu(919) * lu(981) + lu(996) = lu(996) - lu(920) * lu(981) + lu(997) = lu(997) - lu(921) * lu(981) + lu(998) = lu(998) - lu(922) * lu(981) + lu(999) = lu(999) - lu(923) * lu(981) + lu(1000) = lu(1000) - lu(924) * lu(981) + lu(1001) = lu(1001) - lu(925) * lu(981) + lu(1024) = lu(1024) - lu(906) * lu(1023) + lu(1025) = lu(1025) - lu(907) * lu(1023) + lu(1026) = lu(1026) - lu(908) * lu(1023) + lu(1027) = lu(1027) - lu(909) * lu(1023) + lu(1028) = lu(1028) - lu(910) * lu(1023) + lu(1029) = lu(1029) - lu(911) * lu(1023) + lu(1030) = lu(1030) - lu(912) * lu(1023) + lu(1031) = lu(1031) - lu(913) * lu(1023) + lu(1032) = lu(1032) - lu(914) * lu(1023) + lu(1033) = lu(1033) - lu(915) * lu(1023) + lu(1034) = lu(1034) - lu(916) * lu(1023) + lu(1035) = lu(1035) - lu(917) * lu(1023) + lu(1036) = lu(1036) - lu(918) * lu(1023) + lu(1037) = lu(1037) - lu(919) * lu(1023) + lu(1038) = lu(1038) - lu(920) * lu(1023) + lu(1039) = lu(1039) - lu(921) * lu(1023) + lu(1040) = lu(1040) - lu(922) * lu(1023) + lu(1041) = lu(1041) - lu(923) * lu(1023) + lu(1042) = lu(1042) - lu(924) * lu(1023) + lu(1043) = lu(1043) - lu(925) * lu(1023) + lu(1068) = lu(1068) - lu(906) * lu(1067) + lu(1069) = lu(1069) - lu(907) * lu(1067) + lu(1070) = lu(1070) - lu(908) * lu(1067) + lu(1071) = lu(1071) - lu(909) * lu(1067) + lu(1072) = lu(1072) - lu(910) * lu(1067) + lu(1073) = lu(1073) - lu(911) * lu(1067) + lu(1074) = lu(1074) - lu(912) * lu(1067) + lu(1075) = lu(1075) - lu(913) * lu(1067) + lu(1076) = lu(1076) - lu(914) * lu(1067) + lu(1077) = lu(1077) - lu(915) * lu(1067) + lu(1078) = lu(1078) - lu(916) * lu(1067) + lu(1079) = lu(1079) - lu(917) * lu(1067) + lu(1080) = lu(1080) - lu(918) * lu(1067) + lu(1081) = lu(1081) - lu(919) * lu(1067) + lu(1082) = lu(1082) - lu(920) * lu(1067) + lu(1083) = lu(1083) - lu(921) * lu(1067) + lu(1084) = lu(1084) - lu(922) * lu(1067) + lu(1085) = lu(1085) - lu(923) * lu(1067) + lu(1086) = lu(1086) - lu(924) * lu(1067) + lu(1087) = lu(1087) - lu(925) * lu(1067) + lu(1110) = lu(1110) - lu(906) * lu(1109) + lu(1111) = lu(1111) - lu(907) * lu(1109) + lu(1112) = lu(1112) - lu(908) * lu(1109) + lu(1113) = lu(1113) - lu(909) * lu(1109) + lu(1114) = lu(1114) - lu(910) * lu(1109) + lu(1115) = lu(1115) - lu(911) * lu(1109) + lu(1116) = lu(1116) - lu(912) * lu(1109) + lu(1117) = lu(1117) - lu(913) * lu(1109) + lu(1118) = lu(1118) - lu(914) * lu(1109) + lu(1119) = lu(1119) - lu(915) * lu(1109) + lu(1120) = lu(1120) - lu(916) * lu(1109) + lu(1121) = lu(1121) - lu(917) * lu(1109) + lu(1122) = lu(1122) - lu(918) * lu(1109) + lu(1123) = lu(1123) - lu(919) * lu(1109) + lu(1124) = lu(1124) - lu(920) * lu(1109) + lu(1125) = lu(1125) - lu(921) * lu(1109) + lu(1126) = lu(1126) - lu(922) * lu(1109) + lu(1127) = lu(1127) - lu(923) * lu(1109) + lu(1128) = lu(1128) - lu(924) * lu(1109) + lu(1129) = lu(1129) - lu(925) * lu(1109) + lu(1153) = lu(1153) - lu(906) * lu(1152) + lu(1154) = lu(1154) - lu(907) * lu(1152) + lu(1155) = lu(1155) - lu(908) * lu(1152) + lu(1156) = lu(1156) - lu(909) * lu(1152) + lu(1157) = lu(1157) - lu(910) * lu(1152) + lu(1158) = lu(1158) - lu(911) * lu(1152) + lu(1159) = lu(1159) - lu(912) * lu(1152) + lu(1160) = lu(1160) - lu(913) * lu(1152) + lu(1161) = lu(1161) - lu(914) * lu(1152) + lu(1162) = lu(1162) - lu(915) * lu(1152) + lu(1163) = lu(1163) - lu(916) * lu(1152) + lu(1164) = lu(1164) - lu(917) * lu(1152) + lu(1165) = lu(1165) - lu(918) * lu(1152) + lu(1166) = lu(1166) - lu(919) * lu(1152) + lu(1167) = lu(1167) - lu(920) * lu(1152) + lu(1168) = lu(1168) - lu(921) * lu(1152) + lu(1169) = lu(1169) - lu(922) * lu(1152) + lu(1170) = lu(1170) - lu(923) * lu(1152) + lu(1171) = lu(1171) - lu(924) * lu(1152) + lu(1172) = lu(1172) - lu(925) * lu(1152) + lu(1195) = lu(1195) - lu(906) * lu(1194) + lu(1196) = lu(1196) - lu(907) * lu(1194) + lu(1197) = lu(1197) - lu(908) * lu(1194) + lu(1198) = lu(1198) - lu(909) * lu(1194) + lu(1199) = lu(1199) - lu(910) * lu(1194) + lu(1200) = lu(1200) - lu(911) * lu(1194) + lu(1201) = lu(1201) - lu(912) * lu(1194) + lu(1202) = lu(1202) - lu(913) * lu(1194) + lu(1203) = lu(1203) - lu(914) * lu(1194) + lu(1204) = lu(1204) - lu(915) * lu(1194) + lu(1205) = lu(1205) - lu(916) * lu(1194) + lu(1206) = lu(1206) - lu(917) * lu(1194) + lu(1207) = lu(1207) - lu(918) * lu(1194) + lu(1208) = lu(1208) - lu(919) * lu(1194) + lu(1209) = lu(1209) - lu(920) * lu(1194) + lu(1210) = lu(1210) - lu(921) * lu(1194) + lu(1211) = lu(1211) - lu(922) * lu(1194) + lu(1212) = lu(1212) - lu(923) * lu(1194) + lu(1213) = lu(1213) - lu(924) * lu(1194) + lu(1214) = lu(1214) - lu(925) * lu(1194) + lu(1230) = lu(1230) - lu(906) * lu(1229) + lu(1231) = lu(1231) - lu(907) * lu(1229) + lu(1232) = lu(1232) - lu(908) * lu(1229) + lu(1233) = lu(1233) - lu(909) * lu(1229) + lu(1234) = lu(1234) - lu(910) * lu(1229) + lu(1235) = lu(1235) - lu(911) * lu(1229) + lu(1236) = lu(1236) - lu(912) * lu(1229) + lu(1237) = lu(1237) - lu(913) * lu(1229) + lu(1238) = lu(1238) - lu(914) * lu(1229) + lu(1239) = lu(1239) - lu(915) * lu(1229) + lu(1240) = lu(1240) - lu(916) * lu(1229) + lu(1241) = lu(1241) - lu(917) * lu(1229) + lu(1242) = lu(1242) - lu(918) * lu(1229) + lu(1243) = lu(1243) - lu(919) * lu(1229) + lu(1244) = lu(1244) - lu(920) * lu(1229) + lu(1245) = lu(1245) - lu(921) * lu(1229) + lu(1246) = lu(1246) - lu(922) * lu(1229) + lu(1247) = lu(1247) - lu(923) * lu(1229) + lu(1248) = lu(1248) - lu(924) * lu(1229) + lu(1249) = lu(1249) - lu(925) * lu(1229) + lu(1274) = lu(1274) - lu(906) * lu(1273) + lu(1275) = lu(1275) - lu(907) * lu(1273) + lu(1276) = lu(1276) - lu(908) * lu(1273) + lu(1277) = lu(1277) - lu(909) * lu(1273) + lu(1278) = lu(1278) - lu(910) * lu(1273) + lu(1279) = lu(1279) - lu(911) * lu(1273) + lu(1280) = lu(1280) - lu(912) * lu(1273) + lu(1281) = lu(1281) - lu(913) * lu(1273) + lu(1282) = lu(1282) - lu(914) * lu(1273) + lu(1283) = lu(1283) - lu(915) * lu(1273) + lu(1284) = lu(1284) - lu(916) * lu(1273) + lu(1285) = lu(1285) - lu(917) * lu(1273) + lu(1286) = lu(1286) - lu(918) * lu(1273) + lu(1287) = lu(1287) - lu(919) * lu(1273) + lu(1288) = lu(1288) - lu(920) * lu(1273) + lu(1289) = lu(1289) - lu(921) * lu(1273) + lu(1290) = lu(1290) - lu(922) * lu(1273) + lu(1291) = lu(1291) - lu(923) * lu(1273) + lu(1292) = lu(1292) - lu(924) * lu(1273) + lu(1293) = lu(1293) - lu(925) * lu(1273) + lu(1315) = lu(1315) - lu(906) * lu(1314) + lu(1316) = lu(1316) - lu(907) * lu(1314) + lu(1317) = lu(1317) - lu(908) * lu(1314) + lu(1318) = lu(1318) - lu(909) * lu(1314) + lu(1319) = lu(1319) - lu(910) * lu(1314) + lu(1320) = lu(1320) - lu(911) * lu(1314) + lu(1321) = lu(1321) - lu(912) * lu(1314) + lu(1322) = lu(1322) - lu(913) * lu(1314) + lu(1323) = lu(1323) - lu(914) * lu(1314) + lu(1324) = lu(1324) - lu(915) * lu(1314) + lu(1325) = lu(1325) - lu(916) * lu(1314) + lu(1326) = lu(1326) - lu(917) * lu(1314) + lu(1327) = lu(1327) - lu(918) * lu(1314) + lu(1328) = lu(1328) - lu(919) * lu(1314) + lu(1329) = lu(1329) - lu(920) * lu(1314) + lu(1330) = lu(1330) - lu(921) * lu(1314) + lu(1331) = lu(1331) - lu(922) * lu(1314) + lu(1332) = lu(1332) - lu(923) * lu(1314) + lu(1333) = lu(1333) - lu(924) * lu(1314) + lu(1334) = lu(1334) - lu(925) * lu(1314) + lu(1357) = lu(1357) - lu(906) * lu(1356) + lu(1358) = lu(1358) - lu(907) * lu(1356) + lu(1359) = lu(1359) - lu(908) * lu(1356) + lu(1360) = lu(1360) - lu(909) * lu(1356) + lu(1361) = lu(1361) - lu(910) * lu(1356) + lu(1362) = lu(1362) - lu(911) * lu(1356) + lu(1363) = lu(1363) - lu(912) * lu(1356) + lu(1364) = lu(1364) - lu(913) * lu(1356) + lu(1365) = lu(1365) - lu(914) * lu(1356) + lu(1366) = lu(1366) - lu(915) * lu(1356) + lu(1367) = lu(1367) - lu(916) * lu(1356) + lu(1368) = lu(1368) - lu(917) * lu(1356) + lu(1369) = lu(1369) - lu(918) * lu(1356) + lu(1370) = lu(1370) - lu(919) * lu(1356) + lu(1371) = lu(1371) - lu(920) * lu(1356) + lu(1372) = lu(1372) - lu(921) * lu(1356) + lu(1373) = lu(1373) - lu(922) * lu(1356) + lu(1374) = lu(1374) - lu(923) * lu(1356) + lu(1375) = lu(1375) - lu(924) * lu(1356) + lu(1376) = lu(1376) - lu(925) * lu(1356) + lu(1399) = lu(1399) - lu(906) * lu(1398) + lu(1400) = lu(1400) - lu(907) * lu(1398) + lu(1401) = lu(1401) - lu(908) * lu(1398) + lu(1402) = lu(1402) - lu(909) * lu(1398) + lu(1403) = lu(1403) - lu(910) * lu(1398) + lu(1404) = lu(1404) - lu(911) * lu(1398) + lu(1405) = lu(1405) - lu(912) * lu(1398) + lu(1406) = lu(1406) - lu(913) * lu(1398) + lu(1407) = lu(1407) - lu(914) * lu(1398) + lu(1408) = lu(1408) - lu(915) * lu(1398) + lu(1409) = lu(1409) - lu(916) * lu(1398) + lu(1410) = lu(1410) - lu(917) * lu(1398) + lu(1411) = lu(1411) - lu(918) * lu(1398) + lu(1412) = lu(1412) - lu(919) * lu(1398) + lu(1413) = lu(1413) - lu(920) * lu(1398) + lu(1414) = lu(1414) - lu(921) * lu(1398) + lu(1415) = lu(1415) - lu(922) * lu(1398) + lu(1416) = lu(1416) - lu(923) * lu(1398) + lu(1417) = lu(1417) - lu(924) * lu(1398) + lu(1418) = lu(1418) - lu(925) * lu(1398) + lu(1441) = lu(1441) - lu(906) * lu(1440) + lu(1442) = lu(1442) - lu(907) * lu(1440) + lu(1443) = lu(1443) - lu(908) * lu(1440) + lu(1444) = lu(1444) - lu(909) * lu(1440) + lu(1445) = lu(1445) - lu(910) * lu(1440) + lu(1446) = lu(1446) - lu(911) * lu(1440) + lu(1447) = lu(1447) - lu(912) * lu(1440) + lu(1448) = lu(1448) - lu(913) * lu(1440) + lu(1449) = lu(1449) - lu(914) * lu(1440) + lu(1450) = lu(1450) - lu(915) * lu(1440) + lu(1451) = lu(1451) - lu(916) * lu(1440) + lu(1452) = lu(1452) - lu(917) * lu(1440) + lu(1453) = lu(1453) - lu(918) * lu(1440) + lu(1454) = lu(1454) - lu(919) * lu(1440) + lu(1455) = lu(1455) - lu(920) * lu(1440) + lu(1456) = lu(1456) - lu(921) * lu(1440) + lu(1457) = lu(1457) - lu(922) * lu(1440) + lu(1458) = lu(1458) - lu(923) * lu(1440) + lu(1459) = lu(1459) - lu(924) * lu(1440) + lu(1460) = lu(1460) - lu(925) * lu(1440) + lu(1496) = lu(1496) - lu(906) * lu(1495) + lu(1497) = lu(1497) - lu(907) * lu(1495) + lu(1498) = lu(1498) - lu(908) * lu(1495) + lu(1499) = lu(1499) - lu(909) * lu(1495) + lu(1500) = lu(1500) - lu(910) * lu(1495) + lu(1501) = lu(1501) - lu(911) * lu(1495) + lu(1502) = lu(1502) - lu(912) * lu(1495) + lu(1503) = lu(1503) - lu(913) * lu(1495) + lu(1504) = lu(1504) - lu(914) * lu(1495) + lu(1505) = lu(1505) - lu(915) * lu(1495) + lu(1506) = lu(1506) - lu(916) * lu(1495) + lu(1507) = lu(1507) - lu(917) * lu(1495) + lu(1508) = lu(1508) - lu(918) * lu(1495) + lu(1509) = lu(1509) - lu(919) * lu(1495) + lu(1510) = lu(1510) - lu(920) * lu(1495) + lu(1511) = lu(1511) - lu(921) * lu(1495) + lu(1512) = lu(1512) - lu(922) * lu(1495) + lu(1513) = lu(1513) - lu(923) * lu(1495) + lu(1514) = lu(1514) - lu(924) * lu(1495) + lu(1515) = lu(1515) - lu(925) * lu(1495) + lu(1528) = lu(1528) - lu(906) * lu(1527) + lu(1529) = lu(1529) - lu(907) * lu(1527) + lu(1530) = lu(1530) - lu(908) * lu(1527) + lu(1531) = lu(1531) - lu(909) * lu(1527) + lu(1532) = lu(1532) - lu(910) * lu(1527) + lu(1533) = lu(1533) - lu(911) * lu(1527) + lu(1534) = lu(1534) - lu(912) * lu(1527) + lu(1535) = lu(1535) - lu(913) * lu(1527) + lu(1536) = lu(1536) - lu(914) * lu(1527) + lu(1537) = lu(1537) - lu(915) * lu(1527) + lu(1538) = lu(1538) - lu(916) * lu(1527) + lu(1539) = lu(1539) - lu(917) * lu(1527) + lu(1540) = lu(1540) - lu(918) * lu(1527) + lu(1541) = lu(1541) - lu(919) * lu(1527) + lu(1542) = lu(1542) - lu(920) * lu(1527) + lu(1543) = lu(1543) - lu(921) * lu(1527) + lu(1544) = lu(1544) - lu(922) * lu(1527) + lu(1545) = lu(1545) - lu(923) * lu(1527) + lu(1546) = lu(1546) - lu(924) * lu(1527) + lu(1547) = lu(1547) - lu(925) * lu(1527) + lu(1563) = lu(1563) - lu(906) * lu(1562) + lu(1564) = lu(1564) - lu(907) * lu(1562) + lu(1565) = lu(1565) - lu(908) * lu(1562) + lu(1566) = lu(1566) - lu(909) * lu(1562) + lu(1567) = lu(1567) - lu(910) * lu(1562) + lu(1568) = lu(1568) - lu(911) * lu(1562) + lu(1569) = lu(1569) - lu(912) * lu(1562) + lu(1570) = lu(1570) - lu(913) * lu(1562) + lu(1571) = lu(1571) - lu(914) * lu(1562) + lu(1572) = lu(1572) - lu(915) * lu(1562) + lu(1573) = lu(1573) - lu(916) * lu(1562) + lu(1574) = lu(1574) - lu(917) * lu(1562) + lu(1575) = lu(1575) - lu(918) * lu(1562) + lu(1576) = lu(1576) - lu(919) * lu(1562) + lu(1577) = lu(1577) - lu(920) * lu(1562) + lu(1578) = lu(1578) - lu(921) * lu(1562) + lu(1579) = lu(1579) - lu(922) * lu(1562) + lu(1580) = lu(1580) - lu(923) * lu(1562) + lu(1581) = lu(1581) - lu(924) * lu(1562) + lu(1582) = lu(1582) - lu(925) * lu(1562) + lu(1601) = lu(1601) - lu(906) * lu(1600) + lu(1602) = lu(1602) - lu(907) * lu(1600) + lu(1603) = lu(1603) - lu(908) * lu(1600) + lu(1604) = lu(1604) - lu(909) * lu(1600) + lu(1605) = lu(1605) - lu(910) * lu(1600) + lu(1606) = lu(1606) - lu(911) * lu(1600) + lu(1607) = lu(1607) - lu(912) * lu(1600) + lu(1608) = lu(1608) - lu(913) * lu(1600) + lu(1609) = lu(1609) - lu(914) * lu(1600) + lu(1610) = lu(1610) - lu(915) * lu(1600) + lu(1611) = lu(1611) - lu(916) * lu(1600) + lu(1612) = lu(1612) - lu(917) * lu(1600) + lu(1613) = lu(1613) - lu(918) * lu(1600) + lu(1614) = lu(1614) - lu(919) * lu(1600) + lu(1615) = lu(1615) - lu(920) * lu(1600) + lu(1616) = lu(1616) - lu(921) * lu(1600) + lu(1617) = lu(1617) - lu(922) * lu(1600) + lu(1618) = lu(1618) - lu(923) * lu(1600) + lu(1619) = lu(1619) - lu(924) * lu(1600) + lu(1620) = lu(1620) - lu(925) * lu(1600) + lu(1640) = lu(1640) - lu(906) * lu(1639) + lu(1641) = lu(1641) - lu(907) * lu(1639) + lu(1642) = lu(1642) - lu(908) * lu(1639) + lu(1643) = lu(1643) - lu(909) * lu(1639) + lu(1644) = lu(1644) - lu(910) * lu(1639) + lu(1645) = lu(1645) - lu(911) * lu(1639) + lu(1646) = lu(1646) - lu(912) * lu(1639) + lu(1647) = lu(1647) - lu(913) * lu(1639) + lu(1648) = lu(1648) - lu(914) * lu(1639) + lu(1649) = lu(1649) - lu(915) * lu(1639) + lu(1650) = lu(1650) - lu(916) * lu(1639) + lu(1651) = lu(1651) - lu(917) * lu(1639) + lu(1652) = lu(1652) - lu(918) * lu(1639) + lu(1653) = lu(1653) - lu(919) * lu(1639) + lu(1654) = lu(1654) - lu(920) * lu(1639) + lu(1655) = lu(1655) - lu(921) * lu(1639) + lu(1656) = lu(1656) - lu(922) * lu(1639) + lu(1657) = lu(1657) - lu(923) * lu(1639) + lu(1658) = lu(1658) - lu(924) * lu(1639) + lu(1659) = lu(1659) - lu(925) * lu(1639) + lu(1674) = lu(1674) - lu(906) * lu(1673) + lu(1675) = lu(1675) - lu(907) * lu(1673) + lu(1676) = lu(1676) - lu(908) * lu(1673) + lu(1677) = lu(1677) - lu(909) * lu(1673) + lu(1678) = lu(1678) - lu(910) * lu(1673) + lu(1679) = lu(1679) - lu(911) * lu(1673) + lu(1680) = lu(1680) - lu(912) * lu(1673) + lu(1681) = lu(1681) - lu(913) * lu(1673) + lu(1682) = lu(1682) - lu(914) * lu(1673) + lu(1683) = lu(1683) - lu(915) * lu(1673) + lu(1684) = lu(1684) - lu(916) * lu(1673) + lu(1685) = lu(1685) - lu(917) * lu(1673) + lu(1686) = lu(1686) - lu(918) * lu(1673) + lu(1687) = lu(1687) - lu(919) * lu(1673) + lu(1688) = lu(1688) - lu(920) * lu(1673) + lu(1689) = lu(1689) - lu(921) * lu(1673) + lu(1690) = lu(1690) - lu(922) * lu(1673) + lu(1691) = lu(1691) - lu(923) * lu(1673) + lu(1692) = lu(1692) - lu(924) * lu(1673) + lu(1693) = lu(1693) - lu(925) * lu(1673) + lu(1726) = lu(1726) - lu(906) * lu(1725) + lu(1727) = lu(1727) - lu(907) * lu(1725) + lu(1728) = lu(1728) - lu(908) * lu(1725) + lu(1729) = lu(1729) - lu(909) * lu(1725) + lu(1730) = lu(1730) - lu(910) * lu(1725) + lu(1731) = lu(1731) - lu(911) * lu(1725) + lu(1732) = lu(1732) - lu(912) * lu(1725) + lu(1733) = lu(1733) - lu(913) * lu(1725) + lu(1734) = lu(1734) - lu(914) * lu(1725) + lu(1735) = lu(1735) - lu(915) * lu(1725) + lu(1736) = lu(1736) - lu(916) * lu(1725) + lu(1737) = lu(1737) - lu(917) * lu(1725) + lu(1738) = lu(1738) - lu(918) * lu(1725) + lu(1739) = lu(1739) - lu(919) * lu(1725) + lu(1740) = lu(1740) - lu(920) * lu(1725) + lu(1741) = lu(1741) - lu(921) * lu(1725) + lu(1742) = lu(1742) - lu(922) * lu(1725) + lu(1743) = lu(1743) - lu(923) * lu(1725) + lu(1744) = lu(1744) - lu(924) * lu(1725) + lu(1745) = lu(1745) - lu(925) * lu(1725) + lu(941) = 1._r8 / lu(941) + lu(942) = lu(942) * lu(941) + lu(943) = lu(943) * lu(941) + lu(944) = lu(944) * lu(941) + lu(945) = lu(945) * lu(941) + lu(946) = lu(946) * lu(941) + lu(947) = lu(947) * lu(941) + lu(948) = lu(948) * lu(941) + lu(949) = lu(949) * lu(941) + lu(950) = lu(950) * lu(941) + lu(951) = lu(951) * lu(941) + lu(952) = lu(952) * lu(941) + lu(953) = lu(953) * lu(941) + lu(954) = lu(954) * lu(941) + lu(955) = lu(955) * lu(941) + lu(956) = lu(956) * lu(941) + lu(957) = lu(957) * lu(941) + lu(958) = lu(958) * lu(941) + lu(959) = lu(959) * lu(941) + lu(960) = lu(960) * lu(941) + lu(983) = lu(983) - lu(942) * lu(982) + lu(984) = lu(984) - lu(943) * lu(982) + lu(985) = lu(985) - lu(944) * lu(982) + lu(986) = lu(986) - lu(945) * lu(982) + lu(987) = lu(987) - lu(946) * lu(982) + lu(988) = lu(988) - lu(947) * lu(982) + lu(989) = lu(989) - lu(948) * lu(982) + lu(990) = lu(990) - lu(949) * lu(982) + lu(991) = lu(991) - lu(950) * lu(982) + lu(992) = lu(992) - lu(951) * lu(982) + lu(993) = lu(993) - lu(952) * lu(982) + lu(994) = lu(994) - lu(953) * lu(982) + lu(995) = lu(995) - lu(954) * lu(982) + lu(996) = lu(996) - lu(955) * lu(982) + lu(997) = lu(997) - lu(956) * lu(982) + lu(998) = lu(998) - lu(957) * lu(982) + lu(999) = lu(999) - lu(958) * lu(982) + lu(1000) = lu(1000) - lu(959) * lu(982) + lu(1001) = lu(1001) - lu(960) * lu(982) + lu(1025) = lu(1025) - lu(942) * lu(1024) + lu(1026) = lu(1026) - lu(943) * lu(1024) + lu(1027) = lu(1027) - lu(944) * lu(1024) + lu(1028) = lu(1028) - lu(945) * lu(1024) + lu(1029) = lu(1029) - lu(946) * lu(1024) + lu(1030) = lu(1030) - lu(947) * lu(1024) + lu(1031) = lu(1031) - lu(948) * lu(1024) + lu(1032) = lu(1032) - lu(949) * lu(1024) + lu(1033) = lu(1033) - lu(950) * lu(1024) + lu(1034) = lu(1034) - lu(951) * lu(1024) + lu(1035) = lu(1035) - lu(952) * lu(1024) + lu(1036) = lu(1036) - lu(953) * lu(1024) + lu(1037) = lu(1037) - lu(954) * lu(1024) + lu(1038) = lu(1038) - lu(955) * lu(1024) + lu(1039) = lu(1039) - lu(956) * lu(1024) + lu(1040) = lu(1040) - lu(957) * lu(1024) + lu(1041) = lu(1041) - lu(958) * lu(1024) + lu(1042) = lu(1042) - lu(959) * lu(1024) + lu(1043) = lu(1043) - lu(960) * lu(1024) + lu(1069) = lu(1069) - lu(942) * lu(1068) + lu(1070) = lu(1070) - lu(943) * lu(1068) + lu(1071) = lu(1071) - lu(944) * lu(1068) + lu(1072) = lu(1072) - lu(945) * lu(1068) + lu(1073) = lu(1073) - lu(946) * lu(1068) + lu(1074) = lu(1074) - lu(947) * lu(1068) + lu(1075) = lu(1075) - lu(948) * lu(1068) + lu(1076) = lu(1076) - lu(949) * lu(1068) + lu(1077) = lu(1077) - lu(950) * lu(1068) + lu(1078) = lu(1078) - lu(951) * lu(1068) + lu(1079) = lu(1079) - lu(952) * lu(1068) + lu(1080) = lu(1080) - lu(953) * lu(1068) + lu(1081) = lu(1081) - lu(954) * lu(1068) + lu(1082) = lu(1082) - lu(955) * lu(1068) + lu(1083) = lu(1083) - lu(956) * lu(1068) + lu(1084) = lu(1084) - lu(957) * lu(1068) + lu(1085) = lu(1085) - lu(958) * lu(1068) + lu(1086) = lu(1086) - lu(959) * lu(1068) + lu(1087) = lu(1087) - lu(960) * lu(1068) + lu(1111) = lu(1111) - lu(942) * lu(1110) + lu(1112) = lu(1112) - lu(943) * lu(1110) + lu(1113) = lu(1113) - lu(944) * lu(1110) + lu(1114) = lu(1114) - lu(945) * lu(1110) + lu(1115) = lu(1115) - lu(946) * lu(1110) + lu(1116) = lu(1116) - lu(947) * lu(1110) + lu(1117) = lu(1117) - lu(948) * lu(1110) + lu(1118) = lu(1118) - lu(949) * lu(1110) + lu(1119) = lu(1119) - lu(950) * lu(1110) + lu(1120) = lu(1120) - lu(951) * lu(1110) + lu(1121) = lu(1121) - lu(952) * lu(1110) + lu(1122) = lu(1122) - lu(953) * lu(1110) + lu(1123) = lu(1123) - lu(954) * lu(1110) + lu(1124) = lu(1124) - lu(955) * lu(1110) + lu(1125) = lu(1125) - lu(956) * lu(1110) + lu(1126) = lu(1126) - lu(957) * lu(1110) + lu(1127) = lu(1127) - lu(958) * lu(1110) + lu(1128) = lu(1128) - lu(959) * lu(1110) + lu(1129) = lu(1129) - lu(960) * lu(1110) + lu(1154) = lu(1154) - lu(942) * lu(1153) + lu(1155) = lu(1155) - lu(943) * lu(1153) + lu(1156) = lu(1156) - lu(944) * lu(1153) + lu(1157) = lu(1157) - lu(945) * lu(1153) + lu(1158) = lu(1158) - lu(946) * lu(1153) + lu(1159) = lu(1159) - lu(947) * lu(1153) + lu(1160) = lu(1160) - lu(948) * lu(1153) + lu(1161) = lu(1161) - lu(949) * lu(1153) + lu(1162) = lu(1162) - lu(950) * lu(1153) + lu(1163) = lu(1163) - lu(951) * lu(1153) + lu(1164) = lu(1164) - lu(952) * lu(1153) + lu(1165) = lu(1165) - lu(953) * lu(1153) + lu(1166) = lu(1166) - lu(954) * lu(1153) + lu(1167) = lu(1167) - lu(955) * lu(1153) + lu(1168) = lu(1168) - lu(956) * lu(1153) + lu(1169) = lu(1169) - lu(957) * lu(1153) + lu(1170) = lu(1170) - lu(958) * lu(1153) + lu(1171) = lu(1171) - lu(959) * lu(1153) + lu(1172) = lu(1172) - lu(960) * lu(1153) + lu(1196) = lu(1196) - lu(942) * lu(1195) + lu(1197) = lu(1197) - lu(943) * lu(1195) + lu(1198) = lu(1198) - lu(944) * lu(1195) + lu(1199) = lu(1199) - lu(945) * lu(1195) + lu(1200) = lu(1200) - lu(946) * lu(1195) + lu(1201) = lu(1201) - lu(947) * lu(1195) + lu(1202) = lu(1202) - lu(948) * lu(1195) + lu(1203) = lu(1203) - lu(949) * lu(1195) + lu(1204) = lu(1204) - lu(950) * lu(1195) + lu(1205) = lu(1205) - lu(951) * lu(1195) + lu(1206) = lu(1206) - lu(952) * lu(1195) + lu(1207) = lu(1207) - lu(953) * lu(1195) + lu(1208) = lu(1208) - lu(954) * lu(1195) + lu(1209) = lu(1209) - lu(955) * lu(1195) + lu(1210) = lu(1210) - lu(956) * lu(1195) + lu(1211) = lu(1211) - lu(957) * lu(1195) + lu(1212) = lu(1212) - lu(958) * lu(1195) + lu(1213) = lu(1213) - lu(959) * lu(1195) + lu(1214) = lu(1214) - lu(960) * lu(1195) + lu(1231) = lu(1231) - lu(942) * lu(1230) + lu(1232) = lu(1232) - lu(943) * lu(1230) + lu(1233) = lu(1233) - lu(944) * lu(1230) + lu(1234) = lu(1234) - lu(945) * lu(1230) + lu(1235) = lu(1235) - lu(946) * lu(1230) + lu(1236) = lu(1236) - lu(947) * lu(1230) + lu(1237) = lu(1237) - lu(948) * lu(1230) + lu(1238) = lu(1238) - lu(949) * lu(1230) + lu(1239) = lu(1239) - lu(950) * lu(1230) + lu(1240) = lu(1240) - lu(951) * lu(1230) + lu(1241) = lu(1241) - lu(952) * lu(1230) + lu(1242) = lu(1242) - lu(953) * lu(1230) + lu(1243) = lu(1243) - lu(954) * lu(1230) + lu(1244) = lu(1244) - lu(955) * lu(1230) + lu(1245) = lu(1245) - lu(956) * lu(1230) + lu(1246) = lu(1246) - lu(957) * lu(1230) + lu(1247) = lu(1247) - lu(958) * lu(1230) + lu(1248) = lu(1248) - lu(959) * lu(1230) + lu(1249) = lu(1249) - lu(960) * lu(1230) + lu(1275) = lu(1275) - lu(942) * lu(1274) + lu(1276) = lu(1276) - lu(943) * lu(1274) + lu(1277) = lu(1277) - lu(944) * lu(1274) + lu(1278) = lu(1278) - lu(945) * lu(1274) + lu(1279) = lu(1279) - lu(946) * lu(1274) + lu(1280) = lu(1280) - lu(947) * lu(1274) + lu(1281) = lu(1281) - lu(948) * lu(1274) + lu(1282) = lu(1282) - lu(949) * lu(1274) + lu(1283) = lu(1283) - lu(950) * lu(1274) + lu(1284) = lu(1284) - lu(951) * lu(1274) + lu(1285) = lu(1285) - lu(952) * lu(1274) + lu(1286) = lu(1286) - lu(953) * lu(1274) + lu(1287) = lu(1287) - lu(954) * lu(1274) + lu(1288) = lu(1288) - lu(955) * lu(1274) + lu(1289) = lu(1289) - lu(956) * lu(1274) + lu(1290) = lu(1290) - lu(957) * lu(1274) + lu(1291) = lu(1291) - lu(958) * lu(1274) + lu(1292) = lu(1292) - lu(959) * lu(1274) + lu(1293) = lu(1293) - lu(960) * lu(1274) + lu(1316) = lu(1316) - lu(942) * lu(1315) + lu(1317) = lu(1317) - lu(943) * lu(1315) + lu(1318) = lu(1318) - lu(944) * lu(1315) + lu(1319) = lu(1319) - lu(945) * lu(1315) + lu(1320) = lu(1320) - lu(946) * lu(1315) + lu(1321) = lu(1321) - lu(947) * lu(1315) + lu(1322) = lu(1322) - lu(948) * lu(1315) + lu(1323) = lu(1323) - lu(949) * lu(1315) + lu(1324) = lu(1324) - lu(950) * lu(1315) + lu(1325) = lu(1325) - lu(951) * lu(1315) + lu(1326) = lu(1326) - lu(952) * lu(1315) + lu(1327) = lu(1327) - lu(953) * lu(1315) + lu(1328) = lu(1328) - lu(954) * lu(1315) + lu(1329) = lu(1329) - lu(955) * lu(1315) + lu(1330) = lu(1330) - lu(956) * lu(1315) + lu(1331) = lu(1331) - lu(957) * lu(1315) + lu(1332) = lu(1332) - lu(958) * lu(1315) + lu(1333) = lu(1333) - lu(959) * lu(1315) + lu(1334) = lu(1334) - lu(960) * lu(1315) + lu(1358) = lu(1358) - lu(942) * lu(1357) + lu(1359) = lu(1359) - lu(943) * lu(1357) + lu(1360) = lu(1360) - lu(944) * lu(1357) + lu(1361) = lu(1361) - lu(945) * lu(1357) + lu(1362) = lu(1362) - lu(946) * lu(1357) + lu(1363) = lu(1363) - lu(947) * lu(1357) + lu(1364) = lu(1364) - lu(948) * lu(1357) + lu(1365) = lu(1365) - lu(949) * lu(1357) + lu(1366) = lu(1366) - lu(950) * lu(1357) + lu(1367) = lu(1367) - lu(951) * lu(1357) + lu(1368) = lu(1368) - lu(952) * lu(1357) + lu(1369) = lu(1369) - lu(953) * lu(1357) + lu(1370) = lu(1370) - lu(954) * lu(1357) + lu(1371) = lu(1371) - lu(955) * lu(1357) + lu(1372) = lu(1372) - lu(956) * lu(1357) + lu(1373) = lu(1373) - lu(957) * lu(1357) + lu(1374) = lu(1374) - lu(958) * lu(1357) + lu(1375) = lu(1375) - lu(959) * lu(1357) + lu(1376) = lu(1376) - lu(960) * lu(1357) + lu(1400) = lu(1400) - lu(942) * lu(1399) + lu(1401) = lu(1401) - lu(943) * lu(1399) + lu(1402) = lu(1402) - lu(944) * lu(1399) + lu(1403) = lu(1403) - lu(945) * lu(1399) + lu(1404) = lu(1404) - lu(946) * lu(1399) + lu(1405) = lu(1405) - lu(947) * lu(1399) + lu(1406) = lu(1406) - lu(948) * lu(1399) + lu(1407) = lu(1407) - lu(949) * lu(1399) + lu(1408) = lu(1408) - lu(950) * lu(1399) + lu(1409) = lu(1409) - lu(951) * lu(1399) + lu(1410) = lu(1410) - lu(952) * lu(1399) + lu(1411) = lu(1411) - lu(953) * lu(1399) + lu(1412) = lu(1412) - lu(954) * lu(1399) + lu(1413) = lu(1413) - lu(955) * lu(1399) + lu(1414) = lu(1414) - lu(956) * lu(1399) + lu(1415) = lu(1415) - lu(957) * lu(1399) + lu(1416) = lu(1416) - lu(958) * lu(1399) + lu(1417) = lu(1417) - lu(959) * lu(1399) + lu(1418) = lu(1418) - lu(960) * lu(1399) + lu(1442) = lu(1442) - lu(942) * lu(1441) + lu(1443) = lu(1443) - lu(943) * lu(1441) + lu(1444) = lu(1444) - lu(944) * lu(1441) + lu(1445) = lu(1445) - lu(945) * lu(1441) + lu(1446) = lu(1446) - lu(946) * lu(1441) + lu(1447) = lu(1447) - lu(947) * lu(1441) + lu(1448) = lu(1448) - lu(948) * lu(1441) + lu(1449) = lu(1449) - lu(949) * lu(1441) + lu(1450) = lu(1450) - lu(950) * lu(1441) + lu(1451) = lu(1451) - lu(951) * lu(1441) + lu(1452) = lu(1452) - lu(952) * lu(1441) + lu(1453) = lu(1453) - lu(953) * lu(1441) + lu(1454) = lu(1454) - lu(954) * lu(1441) + lu(1455) = lu(1455) - lu(955) * lu(1441) + lu(1456) = lu(1456) - lu(956) * lu(1441) + lu(1457) = lu(1457) - lu(957) * lu(1441) + lu(1458) = lu(1458) - lu(958) * lu(1441) + lu(1459) = lu(1459) - lu(959) * lu(1441) + lu(1460) = lu(1460) - lu(960) * lu(1441) + lu(1497) = lu(1497) - lu(942) * lu(1496) + lu(1498) = lu(1498) - lu(943) * lu(1496) + lu(1499) = lu(1499) - lu(944) * lu(1496) + lu(1500) = lu(1500) - lu(945) * lu(1496) + lu(1501) = lu(1501) - lu(946) * lu(1496) + lu(1502) = lu(1502) - lu(947) * lu(1496) + lu(1503) = lu(1503) - lu(948) * lu(1496) + lu(1504) = lu(1504) - lu(949) * lu(1496) + lu(1505) = lu(1505) - lu(950) * lu(1496) + lu(1506) = lu(1506) - lu(951) * lu(1496) + lu(1507) = lu(1507) - lu(952) * lu(1496) + lu(1508) = lu(1508) - lu(953) * lu(1496) + lu(1509) = lu(1509) - lu(954) * lu(1496) + lu(1510) = lu(1510) - lu(955) * lu(1496) + lu(1511) = lu(1511) - lu(956) * lu(1496) + lu(1512) = lu(1512) - lu(957) * lu(1496) + lu(1513) = lu(1513) - lu(958) * lu(1496) + lu(1514) = lu(1514) - lu(959) * lu(1496) + lu(1515) = lu(1515) - lu(960) * lu(1496) + lu(1529) = lu(1529) - lu(942) * lu(1528) + lu(1530) = lu(1530) - lu(943) * lu(1528) + lu(1531) = lu(1531) - lu(944) * lu(1528) + lu(1532) = lu(1532) - lu(945) * lu(1528) + lu(1533) = lu(1533) - lu(946) * lu(1528) + lu(1534) = lu(1534) - lu(947) * lu(1528) + lu(1535) = lu(1535) - lu(948) * lu(1528) + lu(1536) = lu(1536) - lu(949) * lu(1528) + lu(1537) = lu(1537) - lu(950) * lu(1528) + lu(1538) = lu(1538) - lu(951) * lu(1528) + lu(1539) = lu(1539) - lu(952) * lu(1528) + lu(1540) = lu(1540) - lu(953) * lu(1528) + lu(1541) = lu(1541) - lu(954) * lu(1528) + lu(1542) = lu(1542) - lu(955) * lu(1528) + lu(1543) = lu(1543) - lu(956) * lu(1528) + lu(1544) = lu(1544) - lu(957) * lu(1528) + lu(1545) = lu(1545) - lu(958) * lu(1528) + lu(1546) = lu(1546) - lu(959) * lu(1528) + lu(1547) = lu(1547) - lu(960) * lu(1528) + lu(1564) = lu(1564) - lu(942) * lu(1563) + lu(1565) = lu(1565) - lu(943) * lu(1563) + lu(1566) = lu(1566) - lu(944) * lu(1563) + lu(1567) = lu(1567) - lu(945) * lu(1563) + lu(1568) = lu(1568) - lu(946) * lu(1563) + lu(1569) = lu(1569) - lu(947) * lu(1563) + lu(1570) = lu(1570) - lu(948) * lu(1563) + lu(1571) = lu(1571) - lu(949) * lu(1563) + lu(1572) = lu(1572) - lu(950) * lu(1563) + lu(1573) = lu(1573) - lu(951) * lu(1563) + lu(1574) = lu(1574) - lu(952) * lu(1563) + lu(1575) = lu(1575) - lu(953) * lu(1563) + lu(1576) = lu(1576) - lu(954) * lu(1563) + lu(1577) = lu(1577) - lu(955) * lu(1563) + lu(1578) = lu(1578) - lu(956) * lu(1563) + lu(1579) = lu(1579) - lu(957) * lu(1563) + lu(1580) = lu(1580) - lu(958) * lu(1563) + lu(1581) = lu(1581) - lu(959) * lu(1563) + lu(1582) = lu(1582) - lu(960) * lu(1563) + lu(1602) = lu(1602) - lu(942) * lu(1601) + lu(1603) = lu(1603) - lu(943) * lu(1601) + lu(1604) = lu(1604) - lu(944) * lu(1601) + lu(1605) = lu(1605) - lu(945) * lu(1601) + lu(1606) = lu(1606) - lu(946) * lu(1601) + lu(1607) = lu(1607) - lu(947) * lu(1601) + lu(1608) = lu(1608) - lu(948) * lu(1601) + lu(1609) = lu(1609) - lu(949) * lu(1601) + lu(1610) = lu(1610) - lu(950) * lu(1601) + lu(1611) = lu(1611) - lu(951) * lu(1601) + lu(1612) = lu(1612) - lu(952) * lu(1601) + lu(1613) = lu(1613) - lu(953) * lu(1601) + lu(1614) = lu(1614) - lu(954) * lu(1601) + lu(1615) = lu(1615) - lu(955) * lu(1601) + lu(1616) = lu(1616) - lu(956) * lu(1601) + lu(1617) = lu(1617) - lu(957) * lu(1601) + lu(1618) = lu(1618) - lu(958) * lu(1601) + lu(1619) = lu(1619) - lu(959) * lu(1601) + lu(1620) = lu(1620) - lu(960) * lu(1601) + lu(1641) = lu(1641) - lu(942) * lu(1640) + lu(1642) = lu(1642) - lu(943) * lu(1640) + lu(1643) = lu(1643) - lu(944) * lu(1640) + lu(1644) = lu(1644) - lu(945) * lu(1640) + lu(1645) = lu(1645) - lu(946) * lu(1640) + lu(1646) = lu(1646) - lu(947) * lu(1640) + lu(1647) = lu(1647) - lu(948) * lu(1640) + lu(1648) = lu(1648) - lu(949) * lu(1640) + lu(1649) = lu(1649) - lu(950) * lu(1640) + lu(1650) = lu(1650) - lu(951) * lu(1640) + lu(1651) = lu(1651) - lu(952) * lu(1640) + lu(1652) = lu(1652) - lu(953) * lu(1640) + lu(1653) = lu(1653) - lu(954) * lu(1640) + lu(1654) = lu(1654) - lu(955) * lu(1640) + lu(1655) = lu(1655) - lu(956) * lu(1640) + lu(1656) = lu(1656) - lu(957) * lu(1640) + lu(1657) = lu(1657) - lu(958) * lu(1640) + lu(1658) = lu(1658) - lu(959) * lu(1640) + lu(1659) = lu(1659) - lu(960) * lu(1640) + lu(1675) = lu(1675) - lu(942) * lu(1674) + lu(1676) = lu(1676) - lu(943) * lu(1674) + lu(1677) = lu(1677) - lu(944) * lu(1674) + lu(1678) = lu(1678) - lu(945) * lu(1674) + lu(1679) = lu(1679) - lu(946) * lu(1674) + lu(1680) = lu(1680) - lu(947) * lu(1674) + lu(1681) = lu(1681) - lu(948) * lu(1674) + lu(1682) = lu(1682) - lu(949) * lu(1674) + lu(1683) = lu(1683) - lu(950) * lu(1674) + lu(1684) = lu(1684) - lu(951) * lu(1674) + lu(1685) = lu(1685) - lu(952) * lu(1674) + lu(1686) = lu(1686) - lu(953) * lu(1674) + lu(1687) = lu(1687) - lu(954) * lu(1674) + lu(1688) = lu(1688) - lu(955) * lu(1674) + lu(1689) = lu(1689) - lu(956) * lu(1674) + lu(1690) = lu(1690) - lu(957) * lu(1674) + lu(1691) = lu(1691) - lu(958) * lu(1674) + lu(1692) = lu(1692) - lu(959) * lu(1674) + lu(1693) = lu(1693) - lu(960) * lu(1674) + lu(1727) = lu(1727) - lu(942) * lu(1726) + lu(1728) = lu(1728) - lu(943) * lu(1726) + lu(1729) = lu(1729) - lu(944) * lu(1726) + lu(1730) = lu(1730) - lu(945) * lu(1726) + lu(1731) = lu(1731) - lu(946) * lu(1726) + lu(1732) = lu(1732) - lu(947) * lu(1726) + lu(1733) = lu(1733) - lu(948) * lu(1726) + lu(1734) = lu(1734) - lu(949) * lu(1726) + lu(1735) = lu(1735) - lu(950) * lu(1726) + lu(1736) = lu(1736) - lu(951) * lu(1726) + lu(1737) = lu(1737) - lu(952) * lu(1726) + lu(1738) = lu(1738) - lu(953) * lu(1726) + lu(1739) = lu(1739) - lu(954) * lu(1726) + lu(1740) = lu(1740) - lu(955) * lu(1726) + lu(1741) = lu(1741) - lu(956) * lu(1726) + lu(1742) = lu(1742) - lu(957) * lu(1726) + lu(1743) = lu(1743) - lu(958) * lu(1726) + lu(1744) = lu(1744) - lu(959) * lu(1726) + lu(1745) = lu(1745) - lu(960) * lu(1726) + lu(983) = 1._r8 / lu(983) + lu(984) = lu(984) * lu(983) + lu(985) = lu(985) * lu(983) + lu(986) = lu(986) * lu(983) + lu(987) = lu(987) * lu(983) + lu(988) = lu(988) * lu(983) + lu(989) = lu(989) * lu(983) + lu(990) = lu(990) * lu(983) + lu(991) = lu(991) * lu(983) + lu(992) = lu(992) * lu(983) + lu(993) = lu(993) * lu(983) + lu(994) = lu(994) * lu(983) + lu(995) = lu(995) * lu(983) + lu(996) = lu(996) * lu(983) + lu(997) = lu(997) * lu(983) + lu(998) = lu(998) * lu(983) + lu(999) = lu(999) * lu(983) + lu(1000) = lu(1000) * lu(983) + lu(1001) = lu(1001) * lu(983) + lu(1026) = lu(1026) - lu(984) * lu(1025) + lu(1027) = lu(1027) - lu(985) * lu(1025) + lu(1028) = lu(1028) - lu(986) * lu(1025) + lu(1029) = lu(1029) - lu(987) * lu(1025) + lu(1030) = lu(1030) - lu(988) * lu(1025) + lu(1031) = lu(1031) - lu(989) * lu(1025) + lu(1032) = lu(1032) - lu(990) * lu(1025) + lu(1033) = lu(1033) - lu(991) * lu(1025) + lu(1034) = lu(1034) - lu(992) * lu(1025) + lu(1035) = lu(1035) - lu(993) * lu(1025) + lu(1036) = lu(1036) - lu(994) * lu(1025) + lu(1037) = lu(1037) - lu(995) * lu(1025) + lu(1038) = lu(1038) - lu(996) * lu(1025) + lu(1039) = lu(1039) - lu(997) * lu(1025) + lu(1040) = lu(1040) - lu(998) * lu(1025) + lu(1041) = lu(1041) - lu(999) * lu(1025) + lu(1042) = lu(1042) - lu(1000) * lu(1025) + lu(1043) = lu(1043) - lu(1001) * lu(1025) + lu(1070) = lu(1070) - lu(984) * lu(1069) + lu(1071) = lu(1071) - lu(985) * lu(1069) + lu(1072) = lu(1072) - lu(986) * lu(1069) + lu(1073) = lu(1073) - lu(987) * lu(1069) + lu(1074) = lu(1074) - lu(988) * lu(1069) + lu(1075) = lu(1075) - lu(989) * lu(1069) + lu(1076) = lu(1076) - lu(990) * lu(1069) + lu(1077) = lu(1077) - lu(991) * lu(1069) + lu(1078) = lu(1078) - lu(992) * lu(1069) + lu(1079) = lu(1079) - lu(993) * lu(1069) + lu(1080) = lu(1080) - lu(994) * lu(1069) + lu(1081) = lu(1081) - lu(995) * lu(1069) + lu(1082) = lu(1082) - lu(996) * lu(1069) + lu(1083) = lu(1083) - lu(997) * lu(1069) + lu(1084) = lu(1084) - lu(998) * lu(1069) + lu(1085) = lu(1085) - lu(999) * lu(1069) + lu(1086) = lu(1086) - lu(1000) * lu(1069) + lu(1087) = lu(1087) - lu(1001) * lu(1069) + lu(1112) = lu(1112) - lu(984) * lu(1111) + lu(1113) = lu(1113) - lu(985) * lu(1111) + lu(1114) = lu(1114) - lu(986) * lu(1111) + lu(1115) = lu(1115) - lu(987) * lu(1111) + lu(1116) = lu(1116) - lu(988) * lu(1111) + lu(1117) = lu(1117) - lu(989) * lu(1111) + lu(1118) = lu(1118) - lu(990) * lu(1111) + lu(1119) = lu(1119) - lu(991) * lu(1111) + lu(1120) = lu(1120) - lu(992) * lu(1111) + lu(1121) = lu(1121) - lu(993) * lu(1111) + lu(1122) = lu(1122) - lu(994) * lu(1111) + lu(1123) = lu(1123) - lu(995) * lu(1111) + lu(1124) = lu(1124) - lu(996) * lu(1111) + lu(1125) = lu(1125) - lu(997) * lu(1111) + lu(1126) = lu(1126) - lu(998) * lu(1111) + lu(1127) = lu(1127) - lu(999) * lu(1111) + lu(1128) = lu(1128) - lu(1000) * lu(1111) + lu(1129) = lu(1129) - lu(1001) * lu(1111) + lu(1155) = lu(1155) - lu(984) * lu(1154) + lu(1156) = lu(1156) - lu(985) * lu(1154) + lu(1157) = lu(1157) - lu(986) * lu(1154) + lu(1158) = lu(1158) - lu(987) * lu(1154) + lu(1159) = lu(1159) - lu(988) * lu(1154) + lu(1160) = lu(1160) - lu(989) * lu(1154) + lu(1161) = lu(1161) - lu(990) * lu(1154) + lu(1162) = lu(1162) - lu(991) * lu(1154) + lu(1163) = lu(1163) - lu(992) * lu(1154) + lu(1164) = lu(1164) - lu(993) * lu(1154) + lu(1165) = lu(1165) - lu(994) * lu(1154) + lu(1166) = lu(1166) - lu(995) * lu(1154) + lu(1167) = lu(1167) - lu(996) * lu(1154) + lu(1168) = lu(1168) - lu(997) * lu(1154) + lu(1169) = lu(1169) - lu(998) * lu(1154) + lu(1170) = lu(1170) - lu(999) * lu(1154) + lu(1171) = lu(1171) - lu(1000) * lu(1154) + lu(1172) = lu(1172) - lu(1001) * lu(1154) + lu(1197) = lu(1197) - lu(984) * lu(1196) + lu(1198) = lu(1198) - lu(985) * lu(1196) + lu(1199) = lu(1199) - lu(986) * lu(1196) + lu(1200) = lu(1200) - lu(987) * lu(1196) + lu(1201) = lu(1201) - lu(988) * lu(1196) + lu(1202) = lu(1202) - lu(989) * lu(1196) + lu(1203) = lu(1203) - lu(990) * lu(1196) + lu(1204) = lu(1204) - lu(991) * lu(1196) + lu(1205) = lu(1205) - lu(992) * lu(1196) + lu(1206) = lu(1206) - lu(993) * lu(1196) + lu(1207) = lu(1207) - lu(994) * lu(1196) + lu(1208) = lu(1208) - lu(995) * lu(1196) + lu(1209) = lu(1209) - lu(996) * lu(1196) + lu(1210) = lu(1210) - lu(997) * lu(1196) + lu(1211) = lu(1211) - lu(998) * lu(1196) + lu(1212) = lu(1212) - lu(999) * lu(1196) + lu(1213) = lu(1213) - lu(1000) * lu(1196) + lu(1214) = lu(1214) - lu(1001) * lu(1196) + lu(1232) = lu(1232) - lu(984) * lu(1231) + lu(1233) = lu(1233) - lu(985) * lu(1231) + lu(1234) = lu(1234) - lu(986) * lu(1231) + lu(1235) = lu(1235) - lu(987) * lu(1231) + lu(1236) = lu(1236) - lu(988) * lu(1231) + lu(1237) = lu(1237) - lu(989) * lu(1231) + lu(1238) = lu(1238) - lu(990) * lu(1231) + lu(1239) = lu(1239) - lu(991) * lu(1231) + lu(1240) = lu(1240) - lu(992) * lu(1231) + lu(1241) = lu(1241) - lu(993) * lu(1231) + lu(1242) = lu(1242) - lu(994) * lu(1231) + lu(1243) = lu(1243) - lu(995) * lu(1231) + lu(1244) = lu(1244) - lu(996) * lu(1231) + lu(1245) = lu(1245) - lu(997) * lu(1231) + lu(1246) = lu(1246) - lu(998) * lu(1231) + lu(1247) = lu(1247) - lu(999) * lu(1231) + lu(1248) = lu(1248) - lu(1000) * lu(1231) + lu(1249) = lu(1249) - lu(1001) * lu(1231) + lu(1276) = lu(1276) - lu(984) * lu(1275) + lu(1277) = lu(1277) - lu(985) * lu(1275) + lu(1278) = lu(1278) - lu(986) * lu(1275) + lu(1279) = lu(1279) - lu(987) * lu(1275) + lu(1280) = lu(1280) - lu(988) * lu(1275) + lu(1281) = lu(1281) - lu(989) * lu(1275) + lu(1282) = lu(1282) - lu(990) * lu(1275) + lu(1283) = lu(1283) - lu(991) * lu(1275) + lu(1284) = lu(1284) - lu(992) * lu(1275) + lu(1285) = lu(1285) - lu(993) * lu(1275) + lu(1286) = lu(1286) - lu(994) * lu(1275) + lu(1287) = lu(1287) - lu(995) * lu(1275) + lu(1288) = lu(1288) - lu(996) * lu(1275) + lu(1289) = lu(1289) - lu(997) * lu(1275) + lu(1290) = lu(1290) - lu(998) * lu(1275) + lu(1291) = lu(1291) - lu(999) * lu(1275) + lu(1292) = lu(1292) - lu(1000) * lu(1275) + lu(1293) = lu(1293) - lu(1001) * lu(1275) + lu(1317) = lu(1317) - lu(984) * lu(1316) + lu(1318) = lu(1318) - lu(985) * lu(1316) + lu(1319) = lu(1319) - lu(986) * lu(1316) + lu(1320) = lu(1320) - lu(987) * lu(1316) + lu(1321) = lu(1321) - lu(988) * lu(1316) + lu(1322) = lu(1322) - lu(989) * lu(1316) + lu(1323) = lu(1323) - lu(990) * lu(1316) + lu(1324) = lu(1324) - lu(991) * lu(1316) + lu(1325) = lu(1325) - lu(992) * lu(1316) + lu(1326) = lu(1326) - lu(993) * lu(1316) + lu(1327) = lu(1327) - lu(994) * lu(1316) + lu(1328) = lu(1328) - lu(995) * lu(1316) + lu(1329) = lu(1329) - lu(996) * lu(1316) + lu(1330) = lu(1330) - lu(997) * lu(1316) + lu(1331) = lu(1331) - lu(998) * lu(1316) + lu(1332) = lu(1332) - lu(999) * lu(1316) + lu(1333) = lu(1333) - lu(1000) * lu(1316) + lu(1334) = lu(1334) - lu(1001) * lu(1316) + lu(1359) = lu(1359) - lu(984) * lu(1358) + lu(1360) = lu(1360) - lu(985) * lu(1358) + lu(1361) = lu(1361) - lu(986) * lu(1358) + lu(1362) = lu(1362) - lu(987) * lu(1358) + lu(1363) = lu(1363) - lu(988) * lu(1358) + lu(1364) = lu(1364) - lu(989) * lu(1358) + lu(1365) = lu(1365) - lu(990) * lu(1358) + lu(1366) = lu(1366) - lu(991) * lu(1358) + lu(1367) = lu(1367) - lu(992) * lu(1358) + lu(1368) = lu(1368) - lu(993) * lu(1358) + lu(1369) = lu(1369) - lu(994) * lu(1358) + lu(1370) = lu(1370) - lu(995) * lu(1358) + lu(1371) = lu(1371) - lu(996) * lu(1358) + lu(1372) = lu(1372) - lu(997) * lu(1358) + lu(1373) = lu(1373) - lu(998) * lu(1358) + lu(1374) = lu(1374) - lu(999) * lu(1358) + lu(1375) = lu(1375) - lu(1000) * lu(1358) + lu(1376) = lu(1376) - lu(1001) * lu(1358) + lu(1401) = lu(1401) - lu(984) * lu(1400) + lu(1402) = lu(1402) - lu(985) * lu(1400) + lu(1403) = lu(1403) - lu(986) * lu(1400) + lu(1404) = lu(1404) - lu(987) * lu(1400) + lu(1405) = lu(1405) - lu(988) * lu(1400) + lu(1406) = lu(1406) - lu(989) * lu(1400) + lu(1407) = lu(1407) - lu(990) * lu(1400) + lu(1408) = lu(1408) - lu(991) * lu(1400) + lu(1409) = lu(1409) - lu(992) * lu(1400) + lu(1410) = lu(1410) - lu(993) * lu(1400) + lu(1411) = lu(1411) - lu(994) * lu(1400) + lu(1412) = lu(1412) - lu(995) * lu(1400) + lu(1413) = lu(1413) - lu(996) * lu(1400) + lu(1414) = lu(1414) - lu(997) * lu(1400) + lu(1415) = lu(1415) - lu(998) * lu(1400) + lu(1416) = lu(1416) - lu(999) * lu(1400) + lu(1417) = lu(1417) - lu(1000) * lu(1400) + lu(1418) = lu(1418) - lu(1001) * lu(1400) + lu(1443) = lu(1443) - lu(984) * lu(1442) + lu(1444) = lu(1444) - lu(985) * lu(1442) + lu(1445) = lu(1445) - lu(986) * lu(1442) + lu(1446) = lu(1446) - lu(987) * lu(1442) + lu(1447) = lu(1447) - lu(988) * lu(1442) + lu(1448) = lu(1448) - lu(989) * lu(1442) + lu(1449) = lu(1449) - lu(990) * lu(1442) + lu(1450) = lu(1450) - lu(991) * lu(1442) + lu(1451) = lu(1451) - lu(992) * lu(1442) + lu(1452) = lu(1452) - lu(993) * lu(1442) + lu(1453) = lu(1453) - lu(994) * lu(1442) + lu(1454) = lu(1454) - lu(995) * lu(1442) + lu(1455) = lu(1455) - lu(996) * lu(1442) + lu(1456) = lu(1456) - lu(997) * lu(1442) + lu(1457) = lu(1457) - lu(998) * lu(1442) + lu(1458) = lu(1458) - lu(999) * lu(1442) + lu(1459) = lu(1459) - lu(1000) * lu(1442) + lu(1460) = lu(1460) - lu(1001) * lu(1442) + lu(1498) = lu(1498) - lu(984) * lu(1497) + lu(1499) = lu(1499) - lu(985) * lu(1497) + lu(1500) = lu(1500) - lu(986) * lu(1497) + lu(1501) = lu(1501) - lu(987) * lu(1497) + lu(1502) = lu(1502) - lu(988) * lu(1497) + lu(1503) = lu(1503) - lu(989) * lu(1497) + lu(1504) = lu(1504) - lu(990) * lu(1497) + lu(1505) = lu(1505) - lu(991) * lu(1497) + lu(1506) = lu(1506) - lu(992) * lu(1497) + lu(1507) = lu(1507) - lu(993) * lu(1497) + lu(1508) = lu(1508) - lu(994) * lu(1497) + lu(1509) = lu(1509) - lu(995) * lu(1497) + lu(1510) = lu(1510) - lu(996) * lu(1497) + lu(1511) = lu(1511) - lu(997) * lu(1497) + lu(1512) = lu(1512) - lu(998) * lu(1497) + lu(1513) = lu(1513) - lu(999) * lu(1497) + lu(1514) = lu(1514) - lu(1000) * lu(1497) + lu(1515) = lu(1515) - lu(1001) * lu(1497) + lu(1530) = lu(1530) - lu(984) * lu(1529) + lu(1531) = lu(1531) - lu(985) * lu(1529) + lu(1532) = lu(1532) - lu(986) * lu(1529) + lu(1533) = lu(1533) - lu(987) * lu(1529) + lu(1534) = lu(1534) - lu(988) * lu(1529) + lu(1535) = lu(1535) - lu(989) * lu(1529) + lu(1536) = lu(1536) - lu(990) * lu(1529) + lu(1537) = lu(1537) - lu(991) * lu(1529) + lu(1538) = lu(1538) - lu(992) * lu(1529) + lu(1539) = lu(1539) - lu(993) * lu(1529) + lu(1540) = lu(1540) - lu(994) * lu(1529) + lu(1541) = lu(1541) - lu(995) * lu(1529) + lu(1542) = lu(1542) - lu(996) * lu(1529) + lu(1543) = lu(1543) - lu(997) * lu(1529) + lu(1544) = lu(1544) - lu(998) * lu(1529) + lu(1545) = lu(1545) - lu(999) * lu(1529) + lu(1546) = lu(1546) - lu(1000) * lu(1529) + lu(1547) = lu(1547) - lu(1001) * lu(1529) + lu(1565) = lu(1565) - lu(984) * lu(1564) + lu(1566) = lu(1566) - lu(985) * lu(1564) + lu(1567) = lu(1567) - lu(986) * lu(1564) + lu(1568) = lu(1568) - lu(987) * lu(1564) + lu(1569) = lu(1569) - lu(988) * lu(1564) + lu(1570) = lu(1570) - lu(989) * lu(1564) + lu(1571) = lu(1571) - lu(990) * lu(1564) + lu(1572) = lu(1572) - lu(991) * lu(1564) + lu(1573) = lu(1573) - lu(992) * lu(1564) + lu(1574) = lu(1574) - lu(993) * lu(1564) + lu(1575) = lu(1575) - lu(994) * lu(1564) + lu(1576) = lu(1576) - lu(995) * lu(1564) + lu(1577) = lu(1577) - lu(996) * lu(1564) + lu(1578) = lu(1578) - lu(997) * lu(1564) + lu(1579) = lu(1579) - lu(998) * lu(1564) + lu(1580) = lu(1580) - lu(999) * lu(1564) + lu(1581) = lu(1581) - lu(1000) * lu(1564) + lu(1582) = lu(1582) - lu(1001) * lu(1564) + lu(1603) = lu(1603) - lu(984) * lu(1602) + lu(1604) = lu(1604) - lu(985) * lu(1602) + lu(1605) = lu(1605) - lu(986) * lu(1602) + lu(1606) = lu(1606) - lu(987) * lu(1602) + lu(1607) = lu(1607) - lu(988) * lu(1602) + lu(1608) = lu(1608) - lu(989) * lu(1602) + lu(1609) = lu(1609) - lu(990) * lu(1602) + lu(1610) = lu(1610) - lu(991) * lu(1602) + lu(1611) = lu(1611) - lu(992) * lu(1602) + lu(1612) = lu(1612) - lu(993) * lu(1602) + lu(1613) = lu(1613) - lu(994) * lu(1602) + lu(1614) = lu(1614) - lu(995) * lu(1602) + lu(1615) = lu(1615) - lu(996) * lu(1602) + lu(1616) = lu(1616) - lu(997) * lu(1602) + lu(1617) = lu(1617) - lu(998) * lu(1602) + lu(1618) = lu(1618) - lu(999) * lu(1602) + lu(1619) = lu(1619) - lu(1000) * lu(1602) + lu(1620) = lu(1620) - lu(1001) * lu(1602) + lu(1642) = lu(1642) - lu(984) * lu(1641) + lu(1643) = lu(1643) - lu(985) * lu(1641) + lu(1644) = lu(1644) - lu(986) * lu(1641) + lu(1645) = lu(1645) - lu(987) * lu(1641) + lu(1646) = lu(1646) - lu(988) * lu(1641) + lu(1647) = lu(1647) - lu(989) * lu(1641) + lu(1648) = lu(1648) - lu(990) * lu(1641) + lu(1649) = lu(1649) - lu(991) * lu(1641) + lu(1650) = lu(1650) - lu(992) * lu(1641) + lu(1651) = lu(1651) - lu(993) * lu(1641) + lu(1652) = lu(1652) - lu(994) * lu(1641) + lu(1653) = lu(1653) - lu(995) * lu(1641) + lu(1654) = lu(1654) - lu(996) * lu(1641) + lu(1655) = lu(1655) - lu(997) * lu(1641) + lu(1656) = lu(1656) - lu(998) * lu(1641) + lu(1657) = lu(1657) - lu(999) * lu(1641) + lu(1658) = lu(1658) - lu(1000) * lu(1641) + lu(1659) = lu(1659) - lu(1001) * lu(1641) + lu(1676) = lu(1676) - lu(984) * lu(1675) + lu(1677) = lu(1677) - lu(985) * lu(1675) + lu(1678) = lu(1678) - lu(986) * lu(1675) + lu(1679) = lu(1679) - lu(987) * lu(1675) + lu(1680) = lu(1680) - lu(988) * lu(1675) + lu(1681) = lu(1681) - lu(989) * lu(1675) + lu(1682) = lu(1682) - lu(990) * lu(1675) + lu(1683) = lu(1683) - lu(991) * lu(1675) + lu(1684) = lu(1684) - lu(992) * lu(1675) + lu(1685) = lu(1685) - lu(993) * lu(1675) + lu(1686) = lu(1686) - lu(994) * lu(1675) + lu(1687) = lu(1687) - lu(995) * lu(1675) + lu(1688) = lu(1688) - lu(996) * lu(1675) + lu(1689) = lu(1689) - lu(997) * lu(1675) + lu(1690) = lu(1690) - lu(998) * lu(1675) + lu(1691) = lu(1691) - lu(999) * lu(1675) + lu(1692) = lu(1692) - lu(1000) * lu(1675) + lu(1693) = lu(1693) - lu(1001) * lu(1675) + lu(1728) = lu(1728) - lu(984) * lu(1727) + lu(1729) = lu(1729) - lu(985) * lu(1727) + lu(1730) = lu(1730) - lu(986) * lu(1727) + lu(1731) = lu(1731) - lu(987) * lu(1727) + lu(1732) = lu(1732) - lu(988) * lu(1727) + lu(1733) = lu(1733) - lu(989) * lu(1727) + lu(1734) = lu(1734) - lu(990) * lu(1727) + lu(1735) = lu(1735) - lu(991) * lu(1727) + lu(1736) = lu(1736) - lu(992) * lu(1727) + lu(1737) = lu(1737) - lu(993) * lu(1727) + lu(1738) = lu(1738) - lu(994) * lu(1727) + lu(1739) = lu(1739) - lu(995) * lu(1727) + lu(1740) = lu(1740) - lu(996) * lu(1727) + lu(1741) = lu(1741) - lu(997) * lu(1727) + lu(1742) = lu(1742) - lu(998) * lu(1727) + lu(1743) = lu(1743) - lu(999) * lu(1727) + lu(1744) = lu(1744) - lu(1000) * lu(1727) + lu(1745) = lu(1745) - lu(1001) * lu(1727) end subroutine lu_fac18 - subroutine lu_fac19( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac19( lu ) 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,1023) = 1._r8 / lu(k,1023) - lu(k,1024) = lu(k,1024) * lu(k,1023) - lu(k,1025) = lu(k,1025) * lu(k,1023) - lu(k,1026) = lu(k,1026) * lu(k,1023) - lu(k,1027) = lu(k,1027) * lu(k,1023) - lu(k,1028) = lu(k,1028) * lu(k,1023) - lu(k,1029) = lu(k,1029) * lu(k,1023) - lu(k,1030) = lu(k,1030) * lu(k,1023) - lu(k,1031) = lu(k,1031) * lu(k,1023) - lu(k,1032) = lu(k,1032) * lu(k,1023) - lu(k,1033) = lu(k,1033) * lu(k,1023) - lu(k,1034) = lu(k,1034) * lu(k,1023) - lu(k,1035) = lu(k,1035) * lu(k,1023) - lu(k,1036) = lu(k,1036) * lu(k,1023) - lu(k,1037) = lu(k,1037) * lu(k,1023) - lu(k,1038) = lu(k,1038) * lu(k,1023) - lu(k,1039) = lu(k,1039) * lu(k,1023) - lu(k,1040) = lu(k,1040) * lu(k,1023) - lu(k,1041) = lu(k,1041) * lu(k,1023) - lu(k,1042) = lu(k,1042) * lu(k,1023) - lu(k,1066) = lu(k,1066) - lu(k,1024) * lu(k,1065) - lu(k,1067) = lu(k,1067) - lu(k,1025) * lu(k,1065) - lu(k,1068) = lu(k,1068) - lu(k,1026) * lu(k,1065) - lu(k,1069) = lu(k,1069) - lu(k,1027) * lu(k,1065) - lu(k,1070) = lu(k,1070) - lu(k,1028) * lu(k,1065) - lu(k,1071) = lu(k,1071) - lu(k,1029) * lu(k,1065) - lu(k,1072) = lu(k,1072) - lu(k,1030) * lu(k,1065) - lu(k,1073) = lu(k,1073) - lu(k,1031) * lu(k,1065) - lu(k,1074) = lu(k,1074) - lu(k,1032) * lu(k,1065) - lu(k,1075) = lu(k,1075) - lu(k,1033) * lu(k,1065) - lu(k,1076) = lu(k,1076) - lu(k,1034) * lu(k,1065) - lu(k,1077) = lu(k,1077) - lu(k,1035) * lu(k,1065) - lu(k,1078) = lu(k,1078) - lu(k,1036) * lu(k,1065) - lu(k,1079) = lu(k,1079) - lu(k,1037) * lu(k,1065) - lu(k,1080) = lu(k,1080) - lu(k,1038) * lu(k,1065) - lu(k,1081) = lu(k,1081) - lu(k,1039) * lu(k,1065) - lu(k,1082) = lu(k,1082) - lu(k,1040) * lu(k,1065) - lu(k,1083) = lu(k,1083) - lu(k,1041) * lu(k,1065) - lu(k,1084) = lu(k,1084) - lu(k,1042) * lu(k,1065) - lu(k,1106) = lu(k,1106) - lu(k,1024) * lu(k,1105) - lu(k,1107) = lu(k,1107) - lu(k,1025) * lu(k,1105) - lu(k,1108) = lu(k,1108) - lu(k,1026) * lu(k,1105) - lu(k,1109) = lu(k,1109) - lu(k,1027) * lu(k,1105) - lu(k,1110) = lu(k,1110) - lu(k,1028) * lu(k,1105) - lu(k,1111) = lu(k,1111) - lu(k,1029) * lu(k,1105) - lu(k,1112) = lu(k,1112) - lu(k,1030) * lu(k,1105) - lu(k,1113) = lu(k,1113) - lu(k,1031) * lu(k,1105) - lu(k,1114) = lu(k,1114) - lu(k,1032) * lu(k,1105) - lu(k,1115) = lu(k,1115) - lu(k,1033) * lu(k,1105) - lu(k,1116) = lu(k,1116) - lu(k,1034) * lu(k,1105) - lu(k,1117) = lu(k,1117) - lu(k,1035) * lu(k,1105) - lu(k,1118) = lu(k,1118) - lu(k,1036) * lu(k,1105) - lu(k,1119) = lu(k,1119) - lu(k,1037) * lu(k,1105) - lu(k,1120) = lu(k,1120) - lu(k,1038) * lu(k,1105) - lu(k,1121) = lu(k,1121) - lu(k,1039) * lu(k,1105) - lu(k,1122) = lu(k,1122) - lu(k,1040) * lu(k,1105) - lu(k,1123) = lu(k,1123) - lu(k,1041) * lu(k,1105) - lu(k,1124) = lu(k,1124) - lu(k,1042) * lu(k,1105) - lu(k,1151) = lu(k,1151) - lu(k,1024) * lu(k,1150) - lu(k,1152) = lu(k,1152) - lu(k,1025) * lu(k,1150) - lu(k,1153) = lu(k,1153) - lu(k,1026) * lu(k,1150) - lu(k,1154) = lu(k,1154) - lu(k,1027) * lu(k,1150) - lu(k,1155) = lu(k,1155) - lu(k,1028) * lu(k,1150) - lu(k,1156) = lu(k,1156) - lu(k,1029) * lu(k,1150) - lu(k,1157) = lu(k,1157) - lu(k,1030) * lu(k,1150) - lu(k,1158) = lu(k,1158) - lu(k,1031) * lu(k,1150) - lu(k,1159) = lu(k,1159) - lu(k,1032) * lu(k,1150) - lu(k,1160) = lu(k,1160) - lu(k,1033) * lu(k,1150) - lu(k,1161) = lu(k,1161) - lu(k,1034) * lu(k,1150) - lu(k,1162) = lu(k,1162) - lu(k,1035) * lu(k,1150) - lu(k,1163) = lu(k,1163) - lu(k,1036) * lu(k,1150) - lu(k,1164) = lu(k,1164) - lu(k,1037) * lu(k,1150) - lu(k,1165) = lu(k,1165) - lu(k,1038) * lu(k,1150) - lu(k,1166) = lu(k,1166) - lu(k,1039) * lu(k,1150) - lu(k,1167) = lu(k,1167) - lu(k,1040) * lu(k,1150) - lu(k,1168) = lu(k,1168) - lu(k,1041) * lu(k,1150) - lu(k,1169) = lu(k,1169) - lu(k,1042) * lu(k,1150) - lu(k,1194) = lu(k,1194) - lu(k,1024) * lu(k,1193) - lu(k,1195) = lu(k,1195) - lu(k,1025) * lu(k,1193) - lu(k,1196) = lu(k,1196) - lu(k,1026) * lu(k,1193) - lu(k,1197) = lu(k,1197) - lu(k,1027) * lu(k,1193) - lu(k,1198) = lu(k,1198) - lu(k,1028) * lu(k,1193) - lu(k,1199) = lu(k,1199) - lu(k,1029) * lu(k,1193) - lu(k,1200) = lu(k,1200) - lu(k,1030) * lu(k,1193) - lu(k,1201) = lu(k,1201) - lu(k,1031) * lu(k,1193) - lu(k,1202) = lu(k,1202) - lu(k,1032) * lu(k,1193) - lu(k,1203) = lu(k,1203) - lu(k,1033) * lu(k,1193) - lu(k,1204) = lu(k,1204) - lu(k,1034) * lu(k,1193) - lu(k,1205) = lu(k,1205) - lu(k,1035) * lu(k,1193) - lu(k,1206) = lu(k,1206) - lu(k,1036) * lu(k,1193) - lu(k,1207) = lu(k,1207) - lu(k,1037) * lu(k,1193) - lu(k,1208) = lu(k,1208) - lu(k,1038) * lu(k,1193) - lu(k,1209) = lu(k,1209) - lu(k,1039) * lu(k,1193) - lu(k,1210) = lu(k,1210) - lu(k,1040) * lu(k,1193) - lu(k,1211) = lu(k,1211) - lu(k,1041) * lu(k,1193) - lu(k,1212) = lu(k,1212) - lu(k,1042) * lu(k,1193) - lu(k,1229) = lu(k,1229) - lu(k,1024) * lu(k,1228) - lu(k,1230) = lu(k,1230) - lu(k,1025) * lu(k,1228) - lu(k,1231) = lu(k,1231) - lu(k,1026) * lu(k,1228) - lu(k,1232) = lu(k,1232) - lu(k,1027) * lu(k,1228) - lu(k,1233) = lu(k,1233) - lu(k,1028) * lu(k,1228) - lu(k,1234) = lu(k,1234) - lu(k,1029) * lu(k,1228) - lu(k,1235) = lu(k,1235) - lu(k,1030) * lu(k,1228) - lu(k,1236) = lu(k,1236) - lu(k,1031) * lu(k,1228) - lu(k,1237) = lu(k,1237) - lu(k,1032) * lu(k,1228) - lu(k,1238) = lu(k,1238) - lu(k,1033) * lu(k,1228) - lu(k,1239) = lu(k,1239) - lu(k,1034) * lu(k,1228) - lu(k,1240) = lu(k,1240) - lu(k,1035) * lu(k,1228) - lu(k,1241) = lu(k,1241) - lu(k,1036) * lu(k,1228) - lu(k,1242) = lu(k,1242) - lu(k,1037) * lu(k,1228) - lu(k,1243) = lu(k,1243) - lu(k,1038) * lu(k,1228) - lu(k,1244) = lu(k,1244) - lu(k,1039) * lu(k,1228) - lu(k,1245) = lu(k,1245) - lu(k,1040) * lu(k,1228) - lu(k,1246) = lu(k,1246) - lu(k,1041) * lu(k,1228) - lu(k,1247) = lu(k,1247) - lu(k,1042) * lu(k,1228) - lu(k,1272) = lu(k,1272) - lu(k,1024) * lu(k,1271) - lu(k,1273) = lu(k,1273) - lu(k,1025) * lu(k,1271) - lu(k,1274) = lu(k,1274) - lu(k,1026) * lu(k,1271) - lu(k,1275) = lu(k,1275) - lu(k,1027) * lu(k,1271) - lu(k,1276) = lu(k,1276) - lu(k,1028) * lu(k,1271) - lu(k,1277) = lu(k,1277) - lu(k,1029) * lu(k,1271) - lu(k,1278) = lu(k,1278) - lu(k,1030) * lu(k,1271) - lu(k,1279) = lu(k,1279) - lu(k,1031) * lu(k,1271) - lu(k,1280) = lu(k,1280) - lu(k,1032) * lu(k,1271) - lu(k,1281) = lu(k,1281) - lu(k,1033) * lu(k,1271) - lu(k,1282) = lu(k,1282) - lu(k,1034) * lu(k,1271) - lu(k,1283) = lu(k,1283) - lu(k,1035) * lu(k,1271) - lu(k,1284) = lu(k,1284) - lu(k,1036) * lu(k,1271) - lu(k,1285) = lu(k,1285) - lu(k,1037) * lu(k,1271) - lu(k,1286) = lu(k,1286) - lu(k,1038) * lu(k,1271) - lu(k,1287) = lu(k,1287) - lu(k,1039) * lu(k,1271) - lu(k,1288) = lu(k,1288) - lu(k,1040) * lu(k,1271) - lu(k,1289) = lu(k,1289) - lu(k,1041) * lu(k,1271) - lu(k,1290) = lu(k,1290) - lu(k,1042) * lu(k,1271) - lu(k,1308) = lu(k,1308) - lu(k,1024) * lu(k,1307) - lu(k,1309) = lu(k,1309) - lu(k,1025) * lu(k,1307) - lu(k,1310) = lu(k,1310) - lu(k,1026) * lu(k,1307) - lu(k,1311) = lu(k,1311) - lu(k,1027) * lu(k,1307) - lu(k,1312) = lu(k,1312) - lu(k,1028) * lu(k,1307) - lu(k,1313) = lu(k,1313) - lu(k,1029) * lu(k,1307) - lu(k,1314) = lu(k,1314) - lu(k,1030) * lu(k,1307) - lu(k,1315) = lu(k,1315) - lu(k,1031) * lu(k,1307) - lu(k,1316) = lu(k,1316) - lu(k,1032) * lu(k,1307) - lu(k,1317) = lu(k,1317) - lu(k,1033) * lu(k,1307) - lu(k,1318) = lu(k,1318) - lu(k,1034) * lu(k,1307) - lu(k,1319) = lu(k,1319) - lu(k,1035) * lu(k,1307) - lu(k,1320) = lu(k,1320) - lu(k,1036) * lu(k,1307) - lu(k,1321) = lu(k,1321) - lu(k,1037) * lu(k,1307) - lu(k,1322) = lu(k,1322) - lu(k,1038) * lu(k,1307) - lu(k,1323) = lu(k,1323) - lu(k,1039) * lu(k,1307) - lu(k,1324) = lu(k,1324) - lu(k,1040) * lu(k,1307) - lu(k,1325) = lu(k,1325) - lu(k,1041) * lu(k,1307) - lu(k,1326) = lu(k,1326) - lu(k,1042) * lu(k,1307) - lu(k,1353) = lu(k,1353) - lu(k,1024) * lu(k,1352) - lu(k,1354) = lu(k,1354) - lu(k,1025) * lu(k,1352) - lu(k,1355) = lu(k,1355) - lu(k,1026) * lu(k,1352) - lu(k,1356) = lu(k,1356) - lu(k,1027) * lu(k,1352) - lu(k,1357) = lu(k,1357) - lu(k,1028) * lu(k,1352) - lu(k,1358) = lu(k,1358) - lu(k,1029) * lu(k,1352) - lu(k,1359) = lu(k,1359) - lu(k,1030) * lu(k,1352) - lu(k,1360) = lu(k,1360) - lu(k,1031) * lu(k,1352) - lu(k,1361) = lu(k,1361) - lu(k,1032) * lu(k,1352) - lu(k,1362) = lu(k,1362) - lu(k,1033) * lu(k,1352) - lu(k,1363) = lu(k,1363) - lu(k,1034) * lu(k,1352) - lu(k,1364) = lu(k,1364) - lu(k,1035) * lu(k,1352) - lu(k,1365) = lu(k,1365) - lu(k,1036) * lu(k,1352) - lu(k,1366) = lu(k,1366) - lu(k,1037) * lu(k,1352) - lu(k,1367) = lu(k,1367) - lu(k,1038) * lu(k,1352) - lu(k,1368) = lu(k,1368) - lu(k,1039) * lu(k,1352) - lu(k,1369) = lu(k,1369) - lu(k,1040) * lu(k,1352) - lu(k,1370) = lu(k,1370) - lu(k,1041) * lu(k,1352) - lu(k,1371) = lu(k,1371) - lu(k,1042) * lu(k,1352) - lu(k,1395) = lu(k,1395) - lu(k,1024) * lu(k,1394) - lu(k,1396) = lu(k,1396) - lu(k,1025) * lu(k,1394) - lu(k,1397) = lu(k,1397) - lu(k,1026) * lu(k,1394) - lu(k,1398) = lu(k,1398) - lu(k,1027) * lu(k,1394) - lu(k,1399) = lu(k,1399) - lu(k,1028) * lu(k,1394) - lu(k,1400) = lu(k,1400) - lu(k,1029) * lu(k,1394) - lu(k,1401) = lu(k,1401) - lu(k,1030) * lu(k,1394) - lu(k,1402) = lu(k,1402) - lu(k,1031) * lu(k,1394) - lu(k,1403) = lu(k,1403) - lu(k,1032) * lu(k,1394) - lu(k,1404) = lu(k,1404) - lu(k,1033) * lu(k,1394) - lu(k,1405) = lu(k,1405) - lu(k,1034) * lu(k,1394) - lu(k,1406) = lu(k,1406) - lu(k,1035) * lu(k,1394) - lu(k,1407) = lu(k,1407) - lu(k,1036) * lu(k,1394) - lu(k,1408) = lu(k,1408) - lu(k,1037) * lu(k,1394) - lu(k,1409) = lu(k,1409) - lu(k,1038) * lu(k,1394) - lu(k,1410) = lu(k,1410) - lu(k,1039) * lu(k,1394) - lu(k,1411) = lu(k,1411) - lu(k,1040) * lu(k,1394) - lu(k,1412) = lu(k,1412) - lu(k,1041) * lu(k,1394) - lu(k,1413) = lu(k,1413) - lu(k,1042) * lu(k,1394) - lu(k,1433) = lu(k,1433) - lu(k,1024) * lu(k,1432) - lu(k,1434) = lu(k,1434) - lu(k,1025) * lu(k,1432) - lu(k,1435) = lu(k,1435) - lu(k,1026) * lu(k,1432) - lu(k,1436) = lu(k,1436) - lu(k,1027) * lu(k,1432) - lu(k,1437) = lu(k,1437) - lu(k,1028) * lu(k,1432) - lu(k,1438) = lu(k,1438) - lu(k,1029) * lu(k,1432) - lu(k,1439) = lu(k,1439) - lu(k,1030) * lu(k,1432) - lu(k,1440) = lu(k,1440) - lu(k,1031) * lu(k,1432) - lu(k,1441) = lu(k,1441) - lu(k,1032) * lu(k,1432) - lu(k,1442) = lu(k,1442) - lu(k,1033) * lu(k,1432) - lu(k,1443) = lu(k,1443) - lu(k,1034) * lu(k,1432) - lu(k,1444) = lu(k,1444) - lu(k,1035) * lu(k,1432) - lu(k,1445) = lu(k,1445) - lu(k,1036) * lu(k,1432) - lu(k,1446) = lu(k,1446) - lu(k,1037) * lu(k,1432) - lu(k,1447) = lu(k,1447) - lu(k,1038) * lu(k,1432) - lu(k,1448) = lu(k,1448) - lu(k,1039) * lu(k,1432) - lu(k,1449) = lu(k,1449) - lu(k,1040) * lu(k,1432) - lu(k,1450) = lu(k,1450) - lu(k,1041) * lu(k,1432) - lu(k,1451) = lu(k,1451) - lu(k,1042) * lu(k,1432) - lu(k,1478) = lu(k,1478) - lu(k,1024) * lu(k,1477) - lu(k,1479) = lu(k,1479) - lu(k,1025) * lu(k,1477) - lu(k,1480) = lu(k,1480) - lu(k,1026) * lu(k,1477) - lu(k,1481) = lu(k,1481) - lu(k,1027) * lu(k,1477) - lu(k,1482) = lu(k,1482) - lu(k,1028) * lu(k,1477) - lu(k,1483) = lu(k,1483) - lu(k,1029) * lu(k,1477) - lu(k,1484) = lu(k,1484) - lu(k,1030) * lu(k,1477) - lu(k,1485) = lu(k,1485) - lu(k,1031) * lu(k,1477) - lu(k,1486) = lu(k,1486) - lu(k,1032) * lu(k,1477) - lu(k,1487) = lu(k,1487) - lu(k,1033) * lu(k,1477) - lu(k,1488) = lu(k,1488) - lu(k,1034) * lu(k,1477) - lu(k,1489) = lu(k,1489) - lu(k,1035) * lu(k,1477) - lu(k,1490) = lu(k,1490) - lu(k,1036) * lu(k,1477) - lu(k,1491) = lu(k,1491) - lu(k,1037) * lu(k,1477) - lu(k,1492) = lu(k,1492) - lu(k,1038) * lu(k,1477) - lu(k,1493) = lu(k,1493) - lu(k,1039) * lu(k,1477) - lu(k,1494) = lu(k,1494) - lu(k,1040) * lu(k,1477) - lu(k,1495) = lu(k,1495) - lu(k,1041) * lu(k,1477) - lu(k,1496) = lu(k,1496) - lu(k,1042) * lu(k,1477) - lu(k,1521) = lu(k,1521) - lu(k,1024) * lu(k,1520) - lu(k,1522) = lu(k,1522) - lu(k,1025) * lu(k,1520) - lu(k,1523) = lu(k,1523) - lu(k,1026) * lu(k,1520) - lu(k,1524) = lu(k,1524) - lu(k,1027) * lu(k,1520) - lu(k,1525) = lu(k,1525) - lu(k,1028) * lu(k,1520) - lu(k,1526) = lu(k,1526) - lu(k,1029) * lu(k,1520) - lu(k,1527) = lu(k,1527) - lu(k,1030) * lu(k,1520) - lu(k,1528) = lu(k,1528) - lu(k,1031) * lu(k,1520) - lu(k,1529) = lu(k,1529) - lu(k,1032) * lu(k,1520) - lu(k,1530) = lu(k,1530) - lu(k,1033) * lu(k,1520) - lu(k,1531) = lu(k,1531) - lu(k,1034) * lu(k,1520) - lu(k,1532) = lu(k,1532) - lu(k,1035) * lu(k,1520) - lu(k,1533) = lu(k,1533) - lu(k,1036) * lu(k,1520) - lu(k,1534) = lu(k,1534) - lu(k,1037) * lu(k,1520) - lu(k,1535) = lu(k,1535) - lu(k,1038) * lu(k,1520) - lu(k,1536) = lu(k,1536) - lu(k,1039) * lu(k,1520) - lu(k,1537) = lu(k,1537) - lu(k,1040) * lu(k,1520) - lu(k,1538) = lu(k,1538) - lu(k,1041) * lu(k,1520) - lu(k,1539) = lu(k,1539) - lu(k,1042) * lu(k,1520) - lu(k,1564) = lu(k,1564) - lu(k,1024) * lu(k,1563) - lu(k,1565) = lu(k,1565) - lu(k,1025) * lu(k,1563) - lu(k,1566) = lu(k,1566) - lu(k,1026) * lu(k,1563) - lu(k,1567) = lu(k,1567) - lu(k,1027) * lu(k,1563) - lu(k,1568) = lu(k,1568) - lu(k,1028) * lu(k,1563) - lu(k,1569) = lu(k,1569) - lu(k,1029) * lu(k,1563) - lu(k,1570) = lu(k,1570) - lu(k,1030) * lu(k,1563) - lu(k,1571) = lu(k,1571) - lu(k,1031) * lu(k,1563) - lu(k,1572) = lu(k,1572) - lu(k,1032) * lu(k,1563) - lu(k,1573) = lu(k,1573) - lu(k,1033) * lu(k,1563) - lu(k,1574) = lu(k,1574) - lu(k,1034) * lu(k,1563) - lu(k,1575) = lu(k,1575) - lu(k,1035) * lu(k,1563) - lu(k,1576) = lu(k,1576) - lu(k,1036) * lu(k,1563) - lu(k,1577) = lu(k,1577) - lu(k,1037) * lu(k,1563) - lu(k,1578) = lu(k,1578) - lu(k,1038) * lu(k,1563) - lu(k,1579) = lu(k,1579) - lu(k,1039) * lu(k,1563) - lu(k,1580) = lu(k,1580) - lu(k,1040) * lu(k,1563) - lu(k,1581) = lu(k,1581) - lu(k,1041) * lu(k,1563) - lu(k,1582) = lu(k,1582) - lu(k,1042) * lu(k,1563) - lu(k,1597) = lu(k,1597) - lu(k,1024) * lu(k,1596) - lu(k,1598) = lu(k,1598) - lu(k,1025) * lu(k,1596) - lu(k,1599) = lu(k,1599) - lu(k,1026) * lu(k,1596) - lu(k,1600) = lu(k,1600) - lu(k,1027) * lu(k,1596) - lu(k,1601) = lu(k,1601) - lu(k,1028) * lu(k,1596) - lu(k,1602) = lu(k,1602) - lu(k,1029) * lu(k,1596) - lu(k,1603) = lu(k,1603) - lu(k,1030) * lu(k,1596) - lu(k,1604) = lu(k,1604) - lu(k,1031) * lu(k,1596) - lu(k,1605) = lu(k,1605) - lu(k,1032) * lu(k,1596) - lu(k,1606) = lu(k,1606) - lu(k,1033) * lu(k,1596) - lu(k,1607) = lu(k,1607) - lu(k,1034) * lu(k,1596) - lu(k,1608) = lu(k,1608) - lu(k,1035) * lu(k,1596) - lu(k,1609) = lu(k,1609) - lu(k,1036) * lu(k,1596) - lu(k,1610) = lu(k,1610) - lu(k,1037) * lu(k,1596) - lu(k,1611) = lu(k,1611) - lu(k,1038) * lu(k,1596) - lu(k,1612) = lu(k,1612) - lu(k,1039) * lu(k,1596) - lu(k,1613) = lu(k,1613) - lu(k,1040) * lu(k,1596) - lu(k,1614) = lu(k,1614) - lu(k,1041) * lu(k,1596) - lu(k,1615) = lu(k,1615) - lu(k,1042) * lu(k,1596) - lu(k,1633) = lu(k,1633) - lu(k,1024) * lu(k,1632) - lu(k,1634) = lu(k,1634) - lu(k,1025) * lu(k,1632) - lu(k,1635) = lu(k,1635) - lu(k,1026) * lu(k,1632) - lu(k,1636) = lu(k,1636) - lu(k,1027) * lu(k,1632) - lu(k,1637) = lu(k,1637) - lu(k,1028) * lu(k,1632) - lu(k,1638) = lu(k,1638) - lu(k,1029) * lu(k,1632) - lu(k,1639) = lu(k,1639) - lu(k,1030) * lu(k,1632) - lu(k,1640) = lu(k,1640) - lu(k,1031) * lu(k,1632) - lu(k,1641) = lu(k,1641) - lu(k,1032) * lu(k,1632) - lu(k,1642) = lu(k,1642) - lu(k,1033) * lu(k,1632) - lu(k,1643) = lu(k,1643) - lu(k,1034) * lu(k,1632) - lu(k,1644) = lu(k,1644) - lu(k,1035) * lu(k,1632) - lu(k,1645) = lu(k,1645) - lu(k,1036) * lu(k,1632) - lu(k,1646) = lu(k,1646) - lu(k,1037) * lu(k,1632) - lu(k,1647) = lu(k,1647) - lu(k,1038) * lu(k,1632) - lu(k,1648) = lu(k,1648) - lu(k,1039) * lu(k,1632) - lu(k,1649) = lu(k,1649) - lu(k,1040) * lu(k,1632) - lu(k,1650) = lu(k,1650) - lu(k,1041) * lu(k,1632) - lu(k,1651) = lu(k,1651) - lu(k,1042) * lu(k,1632) - lu(k,1676) = lu(k,1676) - lu(k,1024) * lu(k,1675) - lu(k,1677) = lu(k,1677) - lu(k,1025) * lu(k,1675) - lu(k,1678) = lu(k,1678) - lu(k,1026) * lu(k,1675) - lu(k,1679) = lu(k,1679) - lu(k,1027) * lu(k,1675) - lu(k,1680) = lu(k,1680) - lu(k,1028) * lu(k,1675) - lu(k,1681) = lu(k,1681) - lu(k,1029) * lu(k,1675) - lu(k,1682) = lu(k,1682) - lu(k,1030) * lu(k,1675) - lu(k,1683) = lu(k,1683) - lu(k,1031) * lu(k,1675) - lu(k,1684) = lu(k,1684) - lu(k,1032) * lu(k,1675) - lu(k,1685) = lu(k,1685) - lu(k,1033) * lu(k,1675) - lu(k,1686) = lu(k,1686) - lu(k,1034) * lu(k,1675) - lu(k,1687) = lu(k,1687) - lu(k,1035) * lu(k,1675) - lu(k,1688) = lu(k,1688) - lu(k,1036) * lu(k,1675) - lu(k,1689) = lu(k,1689) - lu(k,1037) * lu(k,1675) - lu(k,1690) = lu(k,1690) - lu(k,1038) * lu(k,1675) - lu(k,1691) = lu(k,1691) - lu(k,1039) * lu(k,1675) - lu(k,1692) = lu(k,1692) - lu(k,1040) * lu(k,1675) - lu(k,1693) = lu(k,1693) - lu(k,1041) * lu(k,1675) - lu(k,1694) = lu(k,1694) - lu(k,1042) * lu(k,1675) - lu(k,1712) = lu(k,1712) - lu(k,1024) * lu(k,1711) - lu(k,1713) = lu(k,1713) - lu(k,1025) * lu(k,1711) - lu(k,1714) = lu(k,1714) - lu(k,1026) * lu(k,1711) - lu(k,1715) = lu(k,1715) - lu(k,1027) * lu(k,1711) - lu(k,1716) = lu(k,1716) - lu(k,1028) * lu(k,1711) - lu(k,1717) = lu(k,1717) - lu(k,1029) * lu(k,1711) - lu(k,1718) = lu(k,1718) - lu(k,1030) * lu(k,1711) - lu(k,1719) = lu(k,1719) - lu(k,1031) * lu(k,1711) - lu(k,1720) = lu(k,1720) - lu(k,1032) * lu(k,1711) - lu(k,1721) = lu(k,1721) - lu(k,1033) * lu(k,1711) - lu(k,1722) = lu(k,1722) - lu(k,1034) * lu(k,1711) - lu(k,1723) = lu(k,1723) - lu(k,1035) * lu(k,1711) - lu(k,1724) = lu(k,1724) - lu(k,1036) * lu(k,1711) - lu(k,1725) = lu(k,1725) - lu(k,1037) * lu(k,1711) - lu(k,1726) = lu(k,1726) - lu(k,1038) * lu(k,1711) - lu(k,1727) = lu(k,1727) - lu(k,1039) * lu(k,1711) - lu(k,1728) = lu(k,1728) - lu(k,1040) * lu(k,1711) - lu(k,1729) = lu(k,1729) - lu(k,1041) * lu(k,1711) - lu(k,1730) = lu(k,1730) - lu(k,1042) * lu(k,1711) - lu(k,1754) = lu(k,1754) - lu(k,1024) * lu(k,1753) - lu(k,1755) = lu(k,1755) - lu(k,1025) * lu(k,1753) - lu(k,1756) = lu(k,1756) - lu(k,1026) * lu(k,1753) - lu(k,1757) = lu(k,1757) - lu(k,1027) * lu(k,1753) - lu(k,1758) = lu(k,1758) - lu(k,1028) * lu(k,1753) - lu(k,1759) = lu(k,1759) - lu(k,1029) * lu(k,1753) - lu(k,1760) = lu(k,1760) - lu(k,1030) * lu(k,1753) - lu(k,1761) = lu(k,1761) - lu(k,1031) * lu(k,1753) - lu(k,1762) = lu(k,1762) - lu(k,1032) * lu(k,1753) - lu(k,1763) = lu(k,1763) - lu(k,1033) * lu(k,1753) - lu(k,1764) = lu(k,1764) - lu(k,1034) * lu(k,1753) - lu(k,1765) = lu(k,1765) - lu(k,1035) * lu(k,1753) - lu(k,1766) = lu(k,1766) - lu(k,1036) * lu(k,1753) - lu(k,1767) = lu(k,1767) - lu(k,1037) * lu(k,1753) - lu(k,1768) = lu(k,1768) - lu(k,1038) * lu(k,1753) - lu(k,1769) = lu(k,1769) - lu(k,1039) * lu(k,1753) - lu(k,1770) = lu(k,1770) - lu(k,1040) * lu(k,1753) - lu(k,1771) = lu(k,1771) - lu(k,1041) * lu(k,1753) - lu(k,1772) = lu(k,1772) - lu(k,1042) * lu(k,1753) - lu(k,1807) = lu(k,1807) - lu(k,1024) * lu(k,1806) - lu(k,1808) = lu(k,1808) - lu(k,1025) * lu(k,1806) - lu(k,1809) = lu(k,1809) - lu(k,1026) * lu(k,1806) - lu(k,1810) = lu(k,1810) - lu(k,1027) * lu(k,1806) - lu(k,1811) = lu(k,1811) - lu(k,1028) * lu(k,1806) - lu(k,1812) = lu(k,1812) - lu(k,1029) * lu(k,1806) - lu(k,1813) = lu(k,1813) - lu(k,1030) * lu(k,1806) - lu(k,1814) = lu(k,1814) - lu(k,1031) * lu(k,1806) - lu(k,1815) = lu(k,1815) - lu(k,1032) * lu(k,1806) - lu(k,1816) = lu(k,1816) - lu(k,1033) * lu(k,1806) - lu(k,1817) = lu(k,1817) - lu(k,1034) * lu(k,1806) - lu(k,1818) = lu(k,1818) - lu(k,1035) * lu(k,1806) - lu(k,1819) = lu(k,1819) - lu(k,1036) * lu(k,1806) - lu(k,1820) = lu(k,1820) - lu(k,1037) * lu(k,1806) - lu(k,1821) = lu(k,1821) - lu(k,1038) * lu(k,1806) - lu(k,1822) = lu(k,1822) - lu(k,1039) * lu(k,1806) - lu(k,1823) = lu(k,1823) - lu(k,1040) * lu(k,1806) - lu(k,1824) = lu(k,1824) - lu(k,1041) * lu(k,1806) - lu(k,1825) = lu(k,1825) - lu(k,1042) * lu(k,1806) - lu(k,1066) = 1._r8 / lu(k,1066) - lu(k,1067) = lu(k,1067) * lu(k,1066) - lu(k,1068) = lu(k,1068) * lu(k,1066) - lu(k,1069) = lu(k,1069) * lu(k,1066) - lu(k,1070) = lu(k,1070) * lu(k,1066) - lu(k,1071) = lu(k,1071) * lu(k,1066) - lu(k,1072) = lu(k,1072) * lu(k,1066) - lu(k,1073) = lu(k,1073) * lu(k,1066) - lu(k,1074) = lu(k,1074) * lu(k,1066) - lu(k,1075) = lu(k,1075) * lu(k,1066) - lu(k,1076) = lu(k,1076) * lu(k,1066) - lu(k,1077) = lu(k,1077) * lu(k,1066) - lu(k,1078) = lu(k,1078) * lu(k,1066) - lu(k,1079) = lu(k,1079) * lu(k,1066) - lu(k,1080) = lu(k,1080) * lu(k,1066) - lu(k,1081) = lu(k,1081) * lu(k,1066) - lu(k,1082) = lu(k,1082) * lu(k,1066) - lu(k,1083) = lu(k,1083) * lu(k,1066) - lu(k,1084) = lu(k,1084) * lu(k,1066) - lu(k,1107) = lu(k,1107) - lu(k,1067) * lu(k,1106) - lu(k,1108) = lu(k,1108) - lu(k,1068) * lu(k,1106) - lu(k,1109) = lu(k,1109) - lu(k,1069) * lu(k,1106) - lu(k,1110) = lu(k,1110) - lu(k,1070) * lu(k,1106) - lu(k,1111) = lu(k,1111) - lu(k,1071) * lu(k,1106) - lu(k,1112) = lu(k,1112) - lu(k,1072) * lu(k,1106) - lu(k,1113) = lu(k,1113) - lu(k,1073) * lu(k,1106) - lu(k,1114) = lu(k,1114) - lu(k,1074) * lu(k,1106) - lu(k,1115) = lu(k,1115) - lu(k,1075) * lu(k,1106) - lu(k,1116) = lu(k,1116) - lu(k,1076) * lu(k,1106) - lu(k,1117) = lu(k,1117) - lu(k,1077) * lu(k,1106) - lu(k,1118) = lu(k,1118) - lu(k,1078) * lu(k,1106) - lu(k,1119) = lu(k,1119) - lu(k,1079) * lu(k,1106) - lu(k,1120) = lu(k,1120) - lu(k,1080) * lu(k,1106) - lu(k,1121) = lu(k,1121) - lu(k,1081) * lu(k,1106) - lu(k,1122) = lu(k,1122) - lu(k,1082) * lu(k,1106) - lu(k,1123) = lu(k,1123) - lu(k,1083) * lu(k,1106) - lu(k,1124) = lu(k,1124) - lu(k,1084) * lu(k,1106) - lu(k,1152) = lu(k,1152) - lu(k,1067) * lu(k,1151) - lu(k,1153) = lu(k,1153) - lu(k,1068) * lu(k,1151) - lu(k,1154) = lu(k,1154) - lu(k,1069) * lu(k,1151) - lu(k,1155) = lu(k,1155) - lu(k,1070) * lu(k,1151) - lu(k,1156) = lu(k,1156) - lu(k,1071) * lu(k,1151) - lu(k,1157) = lu(k,1157) - lu(k,1072) * lu(k,1151) - lu(k,1158) = lu(k,1158) - lu(k,1073) * lu(k,1151) - lu(k,1159) = lu(k,1159) - lu(k,1074) * lu(k,1151) - lu(k,1160) = lu(k,1160) - lu(k,1075) * lu(k,1151) - lu(k,1161) = lu(k,1161) - lu(k,1076) * lu(k,1151) - lu(k,1162) = lu(k,1162) - lu(k,1077) * lu(k,1151) - lu(k,1163) = lu(k,1163) - lu(k,1078) * lu(k,1151) - lu(k,1164) = lu(k,1164) - lu(k,1079) * lu(k,1151) - lu(k,1165) = lu(k,1165) - lu(k,1080) * lu(k,1151) - lu(k,1166) = lu(k,1166) - lu(k,1081) * lu(k,1151) - lu(k,1167) = lu(k,1167) - lu(k,1082) * lu(k,1151) - lu(k,1168) = lu(k,1168) - lu(k,1083) * lu(k,1151) - lu(k,1169) = lu(k,1169) - lu(k,1084) * lu(k,1151) - lu(k,1195) = lu(k,1195) - lu(k,1067) * lu(k,1194) - lu(k,1196) = lu(k,1196) - lu(k,1068) * lu(k,1194) - lu(k,1197) = lu(k,1197) - lu(k,1069) * lu(k,1194) - lu(k,1198) = lu(k,1198) - lu(k,1070) * lu(k,1194) - lu(k,1199) = lu(k,1199) - lu(k,1071) * lu(k,1194) - lu(k,1200) = lu(k,1200) - lu(k,1072) * lu(k,1194) - lu(k,1201) = lu(k,1201) - lu(k,1073) * lu(k,1194) - lu(k,1202) = lu(k,1202) - lu(k,1074) * lu(k,1194) - lu(k,1203) = lu(k,1203) - lu(k,1075) * lu(k,1194) - lu(k,1204) = lu(k,1204) - lu(k,1076) * lu(k,1194) - lu(k,1205) = lu(k,1205) - lu(k,1077) * lu(k,1194) - lu(k,1206) = lu(k,1206) - lu(k,1078) * lu(k,1194) - lu(k,1207) = lu(k,1207) - lu(k,1079) * lu(k,1194) - lu(k,1208) = lu(k,1208) - lu(k,1080) * lu(k,1194) - lu(k,1209) = lu(k,1209) - lu(k,1081) * lu(k,1194) - lu(k,1210) = lu(k,1210) - lu(k,1082) * lu(k,1194) - lu(k,1211) = lu(k,1211) - lu(k,1083) * lu(k,1194) - lu(k,1212) = lu(k,1212) - lu(k,1084) * lu(k,1194) - lu(k,1230) = lu(k,1230) - lu(k,1067) * lu(k,1229) - lu(k,1231) = lu(k,1231) - lu(k,1068) * lu(k,1229) - lu(k,1232) = lu(k,1232) - lu(k,1069) * lu(k,1229) - lu(k,1233) = lu(k,1233) - lu(k,1070) * lu(k,1229) - lu(k,1234) = lu(k,1234) - lu(k,1071) * lu(k,1229) - lu(k,1235) = lu(k,1235) - lu(k,1072) * lu(k,1229) - lu(k,1236) = lu(k,1236) - lu(k,1073) * lu(k,1229) - lu(k,1237) = lu(k,1237) - lu(k,1074) * lu(k,1229) - lu(k,1238) = lu(k,1238) - lu(k,1075) * lu(k,1229) - lu(k,1239) = lu(k,1239) - lu(k,1076) * lu(k,1229) - lu(k,1240) = lu(k,1240) - lu(k,1077) * lu(k,1229) - lu(k,1241) = lu(k,1241) - lu(k,1078) * lu(k,1229) - lu(k,1242) = lu(k,1242) - lu(k,1079) * lu(k,1229) - lu(k,1243) = lu(k,1243) - lu(k,1080) * lu(k,1229) - lu(k,1244) = lu(k,1244) - lu(k,1081) * lu(k,1229) - lu(k,1245) = lu(k,1245) - lu(k,1082) * lu(k,1229) - lu(k,1246) = lu(k,1246) - lu(k,1083) * lu(k,1229) - lu(k,1247) = lu(k,1247) - lu(k,1084) * lu(k,1229) - lu(k,1273) = lu(k,1273) - lu(k,1067) * lu(k,1272) - lu(k,1274) = lu(k,1274) - lu(k,1068) * lu(k,1272) - lu(k,1275) = lu(k,1275) - lu(k,1069) * lu(k,1272) - lu(k,1276) = lu(k,1276) - lu(k,1070) * lu(k,1272) - lu(k,1277) = lu(k,1277) - lu(k,1071) * lu(k,1272) - lu(k,1278) = lu(k,1278) - lu(k,1072) * lu(k,1272) - lu(k,1279) = lu(k,1279) - lu(k,1073) * lu(k,1272) - lu(k,1280) = lu(k,1280) - lu(k,1074) * lu(k,1272) - lu(k,1281) = lu(k,1281) - lu(k,1075) * lu(k,1272) - lu(k,1282) = lu(k,1282) - lu(k,1076) * lu(k,1272) - lu(k,1283) = lu(k,1283) - lu(k,1077) * lu(k,1272) - lu(k,1284) = lu(k,1284) - lu(k,1078) * lu(k,1272) - lu(k,1285) = lu(k,1285) - lu(k,1079) * lu(k,1272) - lu(k,1286) = lu(k,1286) - lu(k,1080) * lu(k,1272) - lu(k,1287) = lu(k,1287) - lu(k,1081) * lu(k,1272) - lu(k,1288) = lu(k,1288) - lu(k,1082) * lu(k,1272) - lu(k,1289) = lu(k,1289) - lu(k,1083) * lu(k,1272) - lu(k,1290) = lu(k,1290) - lu(k,1084) * lu(k,1272) - lu(k,1309) = lu(k,1309) - lu(k,1067) * lu(k,1308) - lu(k,1310) = lu(k,1310) - lu(k,1068) * lu(k,1308) - lu(k,1311) = lu(k,1311) - lu(k,1069) * lu(k,1308) - lu(k,1312) = lu(k,1312) - lu(k,1070) * lu(k,1308) - lu(k,1313) = lu(k,1313) - lu(k,1071) * lu(k,1308) - lu(k,1314) = lu(k,1314) - lu(k,1072) * lu(k,1308) - lu(k,1315) = lu(k,1315) - lu(k,1073) * lu(k,1308) - lu(k,1316) = lu(k,1316) - lu(k,1074) * lu(k,1308) - lu(k,1317) = lu(k,1317) - lu(k,1075) * lu(k,1308) - lu(k,1318) = lu(k,1318) - lu(k,1076) * lu(k,1308) - lu(k,1319) = lu(k,1319) - lu(k,1077) * lu(k,1308) - lu(k,1320) = lu(k,1320) - lu(k,1078) * lu(k,1308) - lu(k,1321) = lu(k,1321) - lu(k,1079) * lu(k,1308) - lu(k,1322) = lu(k,1322) - lu(k,1080) * lu(k,1308) - lu(k,1323) = lu(k,1323) - lu(k,1081) * lu(k,1308) - lu(k,1324) = lu(k,1324) - lu(k,1082) * lu(k,1308) - lu(k,1325) = lu(k,1325) - lu(k,1083) * lu(k,1308) - lu(k,1326) = lu(k,1326) - lu(k,1084) * lu(k,1308) - lu(k,1354) = lu(k,1354) - lu(k,1067) * lu(k,1353) - lu(k,1355) = lu(k,1355) - lu(k,1068) * lu(k,1353) - lu(k,1356) = lu(k,1356) - lu(k,1069) * lu(k,1353) - lu(k,1357) = lu(k,1357) - lu(k,1070) * lu(k,1353) - lu(k,1358) = lu(k,1358) - lu(k,1071) * lu(k,1353) - lu(k,1359) = lu(k,1359) - lu(k,1072) * lu(k,1353) - lu(k,1360) = lu(k,1360) - lu(k,1073) * lu(k,1353) - lu(k,1361) = lu(k,1361) - lu(k,1074) * lu(k,1353) - lu(k,1362) = lu(k,1362) - lu(k,1075) * lu(k,1353) - lu(k,1363) = lu(k,1363) - lu(k,1076) * lu(k,1353) - lu(k,1364) = lu(k,1364) - lu(k,1077) * lu(k,1353) - lu(k,1365) = lu(k,1365) - lu(k,1078) * lu(k,1353) - lu(k,1366) = lu(k,1366) - lu(k,1079) * lu(k,1353) - lu(k,1367) = lu(k,1367) - lu(k,1080) * lu(k,1353) - lu(k,1368) = lu(k,1368) - lu(k,1081) * lu(k,1353) - lu(k,1369) = lu(k,1369) - lu(k,1082) * lu(k,1353) - lu(k,1370) = lu(k,1370) - lu(k,1083) * lu(k,1353) - lu(k,1371) = lu(k,1371) - lu(k,1084) * lu(k,1353) - lu(k,1396) = lu(k,1396) - lu(k,1067) * lu(k,1395) - lu(k,1397) = lu(k,1397) - lu(k,1068) * lu(k,1395) - lu(k,1398) = lu(k,1398) - lu(k,1069) * lu(k,1395) - lu(k,1399) = lu(k,1399) - lu(k,1070) * lu(k,1395) - lu(k,1400) = lu(k,1400) - lu(k,1071) * lu(k,1395) - lu(k,1401) = lu(k,1401) - lu(k,1072) * lu(k,1395) - lu(k,1402) = lu(k,1402) - lu(k,1073) * lu(k,1395) - lu(k,1403) = lu(k,1403) - lu(k,1074) * lu(k,1395) - lu(k,1404) = lu(k,1404) - lu(k,1075) * lu(k,1395) - lu(k,1405) = lu(k,1405) - lu(k,1076) * lu(k,1395) - lu(k,1406) = lu(k,1406) - lu(k,1077) * lu(k,1395) - lu(k,1407) = lu(k,1407) - lu(k,1078) * lu(k,1395) - lu(k,1408) = lu(k,1408) - lu(k,1079) * lu(k,1395) - lu(k,1409) = lu(k,1409) - lu(k,1080) * lu(k,1395) - lu(k,1410) = lu(k,1410) - lu(k,1081) * lu(k,1395) - lu(k,1411) = lu(k,1411) - lu(k,1082) * lu(k,1395) - lu(k,1412) = lu(k,1412) - lu(k,1083) * lu(k,1395) - lu(k,1413) = lu(k,1413) - lu(k,1084) * lu(k,1395) - lu(k,1434) = lu(k,1434) - lu(k,1067) * lu(k,1433) - lu(k,1435) = lu(k,1435) - lu(k,1068) * lu(k,1433) - lu(k,1436) = lu(k,1436) - lu(k,1069) * lu(k,1433) - lu(k,1437) = lu(k,1437) - lu(k,1070) * lu(k,1433) - lu(k,1438) = lu(k,1438) - lu(k,1071) * lu(k,1433) - lu(k,1439) = lu(k,1439) - lu(k,1072) * lu(k,1433) - lu(k,1440) = lu(k,1440) - lu(k,1073) * lu(k,1433) - lu(k,1441) = lu(k,1441) - lu(k,1074) * lu(k,1433) - lu(k,1442) = lu(k,1442) - lu(k,1075) * lu(k,1433) - lu(k,1443) = lu(k,1443) - lu(k,1076) * lu(k,1433) - lu(k,1444) = lu(k,1444) - lu(k,1077) * lu(k,1433) - lu(k,1445) = lu(k,1445) - lu(k,1078) * lu(k,1433) - lu(k,1446) = lu(k,1446) - lu(k,1079) * lu(k,1433) - lu(k,1447) = lu(k,1447) - lu(k,1080) * lu(k,1433) - lu(k,1448) = lu(k,1448) - lu(k,1081) * lu(k,1433) - lu(k,1449) = lu(k,1449) - lu(k,1082) * lu(k,1433) - lu(k,1450) = lu(k,1450) - lu(k,1083) * lu(k,1433) - lu(k,1451) = lu(k,1451) - lu(k,1084) * lu(k,1433) - lu(k,1479) = lu(k,1479) - lu(k,1067) * lu(k,1478) - lu(k,1480) = lu(k,1480) - lu(k,1068) * lu(k,1478) - lu(k,1481) = lu(k,1481) - lu(k,1069) * lu(k,1478) - lu(k,1482) = lu(k,1482) - lu(k,1070) * lu(k,1478) - lu(k,1483) = lu(k,1483) - lu(k,1071) * lu(k,1478) - lu(k,1484) = lu(k,1484) - lu(k,1072) * lu(k,1478) - lu(k,1485) = lu(k,1485) - lu(k,1073) * lu(k,1478) - lu(k,1486) = lu(k,1486) - lu(k,1074) * lu(k,1478) - lu(k,1487) = lu(k,1487) - lu(k,1075) * lu(k,1478) - lu(k,1488) = lu(k,1488) - lu(k,1076) * lu(k,1478) - lu(k,1489) = lu(k,1489) - lu(k,1077) * lu(k,1478) - lu(k,1490) = lu(k,1490) - lu(k,1078) * lu(k,1478) - lu(k,1491) = lu(k,1491) - lu(k,1079) * lu(k,1478) - lu(k,1492) = lu(k,1492) - lu(k,1080) * lu(k,1478) - lu(k,1493) = lu(k,1493) - lu(k,1081) * lu(k,1478) - lu(k,1494) = lu(k,1494) - lu(k,1082) * lu(k,1478) - lu(k,1495) = lu(k,1495) - lu(k,1083) * lu(k,1478) - lu(k,1496) = lu(k,1496) - lu(k,1084) * lu(k,1478) - lu(k,1522) = lu(k,1522) - lu(k,1067) * lu(k,1521) - lu(k,1523) = lu(k,1523) - lu(k,1068) * lu(k,1521) - lu(k,1524) = lu(k,1524) - lu(k,1069) * lu(k,1521) - lu(k,1525) = lu(k,1525) - lu(k,1070) * lu(k,1521) - lu(k,1526) = lu(k,1526) - lu(k,1071) * lu(k,1521) - lu(k,1527) = lu(k,1527) - lu(k,1072) * lu(k,1521) - lu(k,1528) = lu(k,1528) - lu(k,1073) * lu(k,1521) - lu(k,1529) = lu(k,1529) - lu(k,1074) * lu(k,1521) - lu(k,1530) = lu(k,1530) - lu(k,1075) * lu(k,1521) - lu(k,1531) = lu(k,1531) - lu(k,1076) * lu(k,1521) - lu(k,1532) = lu(k,1532) - lu(k,1077) * lu(k,1521) - lu(k,1533) = lu(k,1533) - lu(k,1078) * lu(k,1521) - lu(k,1534) = lu(k,1534) - lu(k,1079) * lu(k,1521) - lu(k,1535) = lu(k,1535) - lu(k,1080) * lu(k,1521) - lu(k,1536) = lu(k,1536) - lu(k,1081) * lu(k,1521) - lu(k,1537) = lu(k,1537) - lu(k,1082) * lu(k,1521) - lu(k,1538) = lu(k,1538) - lu(k,1083) * lu(k,1521) - lu(k,1539) = lu(k,1539) - lu(k,1084) * lu(k,1521) - lu(k,1565) = lu(k,1565) - lu(k,1067) * lu(k,1564) - lu(k,1566) = lu(k,1566) - lu(k,1068) * lu(k,1564) - lu(k,1567) = lu(k,1567) - lu(k,1069) * lu(k,1564) - lu(k,1568) = lu(k,1568) - lu(k,1070) * lu(k,1564) - lu(k,1569) = lu(k,1569) - lu(k,1071) * lu(k,1564) - lu(k,1570) = lu(k,1570) - lu(k,1072) * lu(k,1564) - lu(k,1571) = lu(k,1571) - lu(k,1073) * lu(k,1564) - lu(k,1572) = lu(k,1572) - lu(k,1074) * lu(k,1564) - lu(k,1573) = lu(k,1573) - lu(k,1075) * lu(k,1564) - lu(k,1574) = lu(k,1574) - lu(k,1076) * lu(k,1564) - lu(k,1575) = lu(k,1575) - lu(k,1077) * lu(k,1564) - lu(k,1576) = lu(k,1576) - lu(k,1078) * lu(k,1564) - lu(k,1577) = lu(k,1577) - lu(k,1079) * lu(k,1564) - lu(k,1578) = lu(k,1578) - lu(k,1080) * lu(k,1564) - lu(k,1579) = lu(k,1579) - lu(k,1081) * lu(k,1564) - lu(k,1580) = lu(k,1580) - lu(k,1082) * lu(k,1564) - lu(k,1581) = lu(k,1581) - lu(k,1083) * lu(k,1564) - lu(k,1582) = lu(k,1582) - lu(k,1084) * lu(k,1564) - lu(k,1598) = lu(k,1598) - lu(k,1067) * lu(k,1597) - lu(k,1599) = lu(k,1599) - lu(k,1068) * lu(k,1597) - lu(k,1600) = lu(k,1600) - lu(k,1069) * lu(k,1597) - lu(k,1601) = lu(k,1601) - lu(k,1070) * lu(k,1597) - lu(k,1602) = lu(k,1602) - lu(k,1071) * lu(k,1597) - lu(k,1603) = lu(k,1603) - lu(k,1072) * lu(k,1597) - lu(k,1604) = lu(k,1604) - lu(k,1073) * lu(k,1597) - lu(k,1605) = lu(k,1605) - lu(k,1074) * lu(k,1597) - lu(k,1606) = lu(k,1606) - lu(k,1075) * lu(k,1597) - lu(k,1607) = lu(k,1607) - lu(k,1076) * lu(k,1597) - lu(k,1608) = lu(k,1608) - lu(k,1077) * lu(k,1597) - lu(k,1609) = lu(k,1609) - lu(k,1078) * lu(k,1597) - lu(k,1610) = lu(k,1610) - lu(k,1079) * lu(k,1597) - lu(k,1611) = lu(k,1611) - lu(k,1080) * lu(k,1597) - lu(k,1612) = lu(k,1612) - lu(k,1081) * lu(k,1597) - lu(k,1613) = lu(k,1613) - lu(k,1082) * lu(k,1597) - lu(k,1614) = lu(k,1614) - lu(k,1083) * lu(k,1597) - lu(k,1615) = lu(k,1615) - lu(k,1084) * lu(k,1597) - lu(k,1634) = lu(k,1634) - lu(k,1067) * lu(k,1633) - lu(k,1635) = lu(k,1635) - lu(k,1068) * lu(k,1633) - lu(k,1636) = lu(k,1636) - lu(k,1069) * lu(k,1633) - lu(k,1637) = lu(k,1637) - lu(k,1070) * lu(k,1633) - lu(k,1638) = lu(k,1638) - lu(k,1071) * lu(k,1633) - lu(k,1639) = lu(k,1639) - lu(k,1072) * lu(k,1633) - lu(k,1640) = lu(k,1640) - lu(k,1073) * lu(k,1633) - lu(k,1641) = lu(k,1641) - lu(k,1074) * lu(k,1633) - lu(k,1642) = lu(k,1642) - lu(k,1075) * lu(k,1633) - lu(k,1643) = lu(k,1643) - lu(k,1076) * lu(k,1633) - lu(k,1644) = lu(k,1644) - lu(k,1077) * lu(k,1633) - lu(k,1645) = lu(k,1645) - lu(k,1078) * lu(k,1633) - lu(k,1646) = lu(k,1646) - lu(k,1079) * lu(k,1633) - lu(k,1647) = lu(k,1647) - lu(k,1080) * lu(k,1633) - lu(k,1648) = lu(k,1648) - lu(k,1081) * lu(k,1633) - lu(k,1649) = lu(k,1649) - lu(k,1082) * lu(k,1633) - lu(k,1650) = lu(k,1650) - lu(k,1083) * lu(k,1633) - lu(k,1651) = lu(k,1651) - lu(k,1084) * lu(k,1633) - lu(k,1677) = lu(k,1677) - lu(k,1067) * lu(k,1676) - lu(k,1678) = lu(k,1678) - lu(k,1068) * lu(k,1676) - lu(k,1679) = lu(k,1679) - lu(k,1069) * lu(k,1676) - lu(k,1680) = lu(k,1680) - lu(k,1070) * lu(k,1676) - lu(k,1681) = lu(k,1681) - lu(k,1071) * lu(k,1676) - lu(k,1682) = lu(k,1682) - lu(k,1072) * lu(k,1676) - lu(k,1683) = lu(k,1683) - lu(k,1073) * lu(k,1676) - lu(k,1684) = lu(k,1684) - lu(k,1074) * lu(k,1676) - lu(k,1685) = lu(k,1685) - lu(k,1075) * lu(k,1676) - lu(k,1686) = lu(k,1686) - lu(k,1076) * lu(k,1676) - lu(k,1687) = lu(k,1687) - lu(k,1077) * lu(k,1676) - lu(k,1688) = lu(k,1688) - lu(k,1078) * lu(k,1676) - lu(k,1689) = lu(k,1689) - lu(k,1079) * lu(k,1676) - lu(k,1690) = lu(k,1690) - lu(k,1080) * lu(k,1676) - lu(k,1691) = lu(k,1691) - lu(k,1081) * lu(k,1676) - lu(k,1692) = lu(k,1692) - lu(k,1082) * lu(k,1676) - lu(k,1693) = lu(k,1693) - lu(k,1083) * lu(k,1676) - lu(k,1694) = lu(k,1694) - lu(k,1084) * lu(k,1676) - lu(k,1713) = lu(k,1713) - lu(k,1067) * lu(k,1712) - lu(k,1714) = lu(k,1714) - lu(k,1068) * lu(k,1712) - lu(k,1715) = lu(k,1715) - lu(k,1069) * lu(k,1712) - lu(k,1716) = lu(k,1716) - lu(k,1070) * lu(k,1712) - lu(k,1717) = lu(k,1717) - lu(k,1071) * lu(k,1712) - lu(k,1718) = lu(k,1718) - lu(k,1072) * lu(k,1712) - lu(k,1719) = lu(k,1719) - lu(k,1073) * lu(k,1712) - lu(k,1720) = lu(k,1720) - lu(k,1074) * lu(k,1712) - lu(k,1721) = lu(k,1721) - lu(k,1075) * lu(k,1712) - lu(k,1722) = lu(k,1722) - lu(k,1076) * lu(k,1712) - lu(k,1723) = lu(k,1723) - lu(k,1077) * lu(k,1712) - lu(k,1724) = lu(k,1724) - lu(k,1078) * lu(k,1712) - lu(k,1725) = lu(k,1725) - lu(k,1079) * lu(k,1712) - lu(k,1726) = lu(k,1726) - lu(k,1080) * lu(k,1712) - lu(k,1727) = lu(k,1727) - lu(k,1081) * lu(k,1712) - lu(k,1728) = lu(k,1728) - lu(k,1082) * lu(k,1712) - lu(k,1729) = lu(k,1729) - lu(k,1083) * lu(k,1712) - lu(k,1730) = lu(k,1730) - lu(k,1084) * lu(k,1712) - lu(k,1755) = lu(k,1755) - lu(k,1067) * lu(k,1754) - lu(k,1756) = lu(k,1756) - lu(k,1068) * lu(k,1754) - lu(k,1757) = lu(k,1757) - lu(k,1069) * lu(k,1754) - lu(k,1758) = lu(k,1758) - lu(k,1070) * lu(k,1754) - lu(k,1759) = lu(k,1759) - lu(k,1071) * lu(k,1754) - lu(k,1760) = lu(k,1760) - lu(k,1072) * lu(k,1754) - lu(k,1761) = lu(k,1761) - lu(k,1073) * lu(k,1754) - lu(k,1762) = lu(k,1762) - lu(k,1074) * lu(k,1754) - lu(k,1763) = lu(k,1763) - lu(k,1075) * lu(k,1754) - lu(k,1764) = lu(k,1764) - lu(k,1076) * lu(k,1754) - lu(k,1765) = lu(k,1765) - lu(k,1077) * lu(k,1754) - lu(k,1766) = lu(k,1766) - lu(k,1078) * lu(k,1754) - lu(k,1767) = lu(k,1767) - lu(k,1079) * lu(k,1754) - lu(k,1768) = lu(k,1768) - lu(k,1080) * lu(k,1754) - lu(k,1769) = lu(k,1769) - lu(k,1081) * lu(k,1754) - lu(k,1770) = lu(k,1770) - lu(k,1082) * lu(k,1754) - lu(k,1771) = lu(k,1771) - lu(k,1083) * lu(k,1754) - lu(k,1772) = lu(k,1772) - lu(k,1084) * lu(k,1754) - lu(k,1808) = lu(k,1808) - lu(k,1067) * lu(k,1807) - lu(k,1809) = lu(k,1809) - lu(k,1068) * lu(k,1807) - lu(k,1810) = lu(k,1810) - lu(k,1069) * lu(k,1807) - lu(k,1811) = lu(k,1811) - lu(k,1070) * lu(k,1807) - lu(k,1812) = lu(k,1812) - lu(k,1071) * lu(k,1807) - lu(k,1813) = lu(k,1813) - lu(k,1072) * lu(k,1807) - lu(k,1814) = lu(k,1814) - lu(k,1073) * lu(k,1807) - lu(k,1815) = lu(k,1815) - lu(k,1074) * lu(k,1807) - lu(k,1816) = lu(k,1816) - lu(k,1075) * lu(k,1807) - lu(k,1817) = lu(k,1817) - lu(k,1076) * lu(k,1807) - lu(k,1818) = lu(k,1818) - lu(k,1077) * lu(k,1807) - lu(k,1819) = lu(k,1819) - lu(k,1078) * lu(k,1807) - lu(k,1820) = lu(k,1820) - lu(k,1079) * lu(k,1807) - lu(k,1821) = lu(k,1821) - lu(k,1080) * lu(k,1807) - lu(k,1822) = lu(k,1822) - lu(k,1081) * lu(k,1807) - lu(k,1823) = lu(k,1823) - lu(k,1082) * lu(k,1807) - lu(k,1824) = lu(k,1824) - lu(k,1083) * lu(k,1807) - lu(k,1825) = lu(k,1825) - lu(k,1084) * lu(k,1807) - lu(k,1107) = 1._r8 / lu(k,1107) - lu(k,1108) = lu(k,1108) * lu(k,1107) - lu(k,1109) = lu(k,1109) * lu(k,1107) - lu(k,1110) = lu(k,1110) * lu(k,1107) - lu(k,1111) = lu(k,1111) * lu(k,1107) - lu(k,1112) = lu(k,1112) * lu(k,1107) - lu(k,1113) = lu(k,1113) * lu(k,1107) - lu(k,1114) = lu(k,1114) * lu(k,1107) - lu(k,1115) = lu(k,1115) * lu(k,1107) - lu(k,1116) = lu(k,1116) * lu(k,1107) - lu(k,1117) = lu(k,1117) * lu(k,1107) - lu(k,1118) = lu(k,1118) * lu(k,1107) - lu(k,1119) = lu(k,1119) * lu(k,1107) - lu(k,1120) = lu(k,1120) * lu(k,1107) - lu(k,1121) = lu(k,1121) * lu(k,1107) - lu(k,1122) = lu(k,1122) * lu(k,1107) - lu(k,1123) = lu(k,1123) * lu(k,1107) - lu(k,1124) = lu(k,1124) * lu(k,1107) - lu(k,1153) = lu(k,1153) - lu(k,1108) * lu(k,1152) - lu(k,1154) = lu(k,1154) - lu(k,1109) * lu(k,1152) - lu(k,1155) = lu(k,1155) - lu(k,1110) * lu(k,1152) - lu(k,1156) = lu(k,1156) - lu(k,1111) * lu(k,1152) - lu(k,1157) = lu(k,1157) - lu(k,1112) * lu(k,1152) - lu(k,1158) = lu(k,1158) - lu(k,1113) * lu(k,1152) - lu(k,1159) = lu(k,1159) - lu(k,1114) * lu(k,1152) - lu(k,1160) = lu(k,1160) - lu(k,1115) * lu(k,1152) - lu(k,1161) = lu(k,1161) - lu(k,1116) * lu(k,1152) - lu(k,1162) = lu(k,1162) - lu(k,1117) * lu(k,1152) - lu(k,1163) = lu(k,1163) - lu(k,1118) * lu(k,1152) - lu(k,1164) = lu(k,1164) - lu(k,1119) * lu(k,1152) - lu(k,1165) = lu(k,1165) - lu(k,1120) * lu(k,1152) - lu(k,1166) = lu(k,1166) - lu(k,1121) * lu(k,1152) - lu(k,1167) = lu(k,1167) - lu(k,1122) * lu(k,1152) - lu(k,1168) = lu(k,1168) - lu(k,1123) * lu(k,1152) - lu(k,1169) = lu(k,1169) - lu(k,1124) * lu(k,1152) - lu(k,1196) = lu(k,1196) - lu(k,1108) * lu(k,1195) - lu(k,1197) = lu(k,1197) - lu(k,1109) * lu(k,1195) - lu(k,1198) = lu(k,1198) - lu(k,1110) * lu(k,1195) - lu(k,1199) = lu(k,1199) - lu(k,1111) * lu(k,1195) - lu(k,1200) = lu(k,1200) - lu(k,1112) * lu(k,1195) - lu(k,1201) = lu(k,1201) - lu(k,1113) * lu(k,1195) - lu(k,1202) = lu(k,1202) - lu(k,1114) * lu(k,1195) - lu(k,1203) = lu(k,1203) - lu(k,1115) * lu(k,1195) - lu(k,1204) = lu(k,1204) - lu(k,1116) * lu(k,1195) - lu(k,1205) = lu(k,1205) - lu(k,1117) * lu(k,1195) - lu(k,1206) = lu(k,1206) - lu(k,1118) * lu(k,1195) - lu(k,1207) = lu(k,1207) - lu(k,1119) * lu(k,1195) - lu(k,1208) = lu(k,1208) - lu(k,1120) * lu(k,1195) - lu(k,1209) = lu(k,1209) - lu(k,1121) * lu(k,1195) - lu(k,1210) = lu(k,1210) - lu(k,1122) * lu(k,1195) - lu(k,1211) = lu(k,1211) - lu(k,1123) * lu(k,1195) - lu(k,1212) = lu(k,1212) - lu(k,1124) * lu(k,1195) - lu(k,1231) = lu(k,1231) - lu(k,1108) * lu(k,1230) - lu(k,1232) = lu(k,1232) - lu(k,1109) * lu(k,1230) - lu(k,1233) = lu(k,1233) - lu(k,1110) * lu(k,1230) - lu(k,1234) = lu(k,1234) - lu(k,1111) * lu(k,1230) - lu(k,1235) = lu(k,1235) - lu(k,1112) * lu(k,1230) - lu(k,1236) = lu(k,1236) - lu(k,1113) * lu(k,1230) - lu(k,1237) = lu(k,1237) - lu(k,1114) * lu(k,1230) - lu(k,1238) = lu(k,1238) - lu(k,1115) * lu(k,1230) - lu(k,1239) = lu(k,1239) - lu(k,1116) * lu(k,1230) - lu(k,1240) = lu(k,1240) - lu(k,1117) * lu(k,1230) - lu(k,1241) = lu(k,1241) - lu(k,1118) * lu(k,1230) - lu(k,1242) = lu(k,1242) - lu(k,1119) * lu(k,1230) - lu(k,1243) = lu(k,1243) - lu(k,1120) * lu(k,1230) - lu(k,1244) = lu(k,1244) - lu(k,1121) * lu(k,1230) - lu(k,1245) = lu(k,1245) - lu(k,1122) * lu(k,1230) - lu(k,1246) = lu(k,1246) - lu(k,1123) * lu(k,1230) - lu(k,1247) = lu(k,1247) - lu(k,1124) * lu(k,1230) - lu(k,1274) = lu(k,1274) - lu(k,1108) * lu(k,1273) - lu(k,1275) = lu(k,1275) - lu(k,1109) * lu(k,1273) - lu(k,1276) = lu(k,1276) - lu(k,1110) * lu(k,1273) - lu(k,1277) = lu(k,1277) - lu(k,1111) * lu(k,1273) - lu(k,1278) = lu(k,1278) - lu(k,1112) * lu(k,1273) - lu(k,1279) = lu(k,1279) - lu(k,1113) * lu(k,1273) - lu(k,1280) = lu(k,1280) - lu(k,1114) * lu(k,1273) - lu(k,1281) = lu(k,1281) - lu(k,1115) * lu(k,1273) - lu(k,1282) = lu(k,1282) - lu(k,1116) * lu(k,1273) - lu(k,1283) = lu(k,1283) - lu(k,1117) * lu(k,1273) - lu(k,1284) = lu(k,1284) - lu(k,1118) * lu(k,1273) - lu(k,1285) = lu(k,1285) - lu(k,1119) * lu(k,1273) - lu(k,1286) = lu(k,1286) - lu(k,1120) * lu(k,1273) - lu(k,1287) = lu(k,1287) - lu(k,1121) * lu(k,1273) - lu(k,1288) = lu(k,1288) - lu(k,1122) * lu(k,1273) - lu(k,1289) = lu(k,1289) - lu(k,1123) * lu(k,1273) - lu(k,1290) = lu(k,1290) - lu(k,1124) * lu(k,1273) - lu(k,1310) = lu(k,1310) - lu(k,1108) * lu(k,1309) - lu(k,1311) = lu(k,1311) - lu(k,1109) * lu(k,1309) - lu(k,1312) = lu(k,1312) - lu(k,1110) * lu(k,1309) - lu(k,1313) = lu(k,1313) - lu(k,1111) * lu(k,1309) - lu(k,1314) = lu(k,1314) - lu(k,1112) * lu(k,1309) - lu(k,1315) = lu(k,1315) - lu(k,1113) * lu(k,1309) - lu(k,1316) = lu(k,1316) - lu(k,1114) * lu(k,1309) - lu(k,1317) = lu(k,1317) - lu(k,1115) * lu(k,1309) - lu(k,1318) = lu(k,1318) - lu(k,1116) * lu(k,1309) - lu(k,1319) = lu(k,1319) - lu(k,1117) * lu(k,1309) - lu(k,1320) = lu(k,1320) - lu(k,1118) * lu(k,1309) - lu(k,1321) = lu(k,1321) - lu(k,1119) * lu(k,1309) - lu(k,1322) = lu(k,1322) - lu(k,1120) * lu(k,1309) - lu(k,1323) = lu(k,1323) - lu(k,1121) * lu(k,1309) - lu(k,1324) = lu(k,1324) - lu(k,1122) * lu(k,1309) - lu(k,1325) = lu(k,1325) - lu(k,1123) * lu(k,1309) - lu(k,1326) = lu(k,1326) - lu(k,1124) * lu(k,1309) - lu(k,1355) = lu(k,1355) - lu(k,1108) * lu(k,1354) - lu(k,1356) = lu(k,1356) - lu(k,1109) * lu(k,1354) - lu(k,1357) = lu(k,1357) - lu(k,1110) * lu(k,1354) - lu(k,1358) = lu(k,1358) - lu(k,1111) * lu(k,1354) - lu(k,1359) = lu(k,1359) - lu(k,1112) * lu(k,1354) - lu(k,1360) = lu(k,1360) - lu(k,1113) * lu(k,1354) - lu(k,1361) = lu(k,1361) - lu(k,1114) * lu(k,1354) - lu(k,1362) = lu(k,1362) - lu(k,1115) * lu(k,1354) - lu(k,1363) = lu(k,1363) - lu(k,1116) * lu(k,1354) - lu(k,1364) = lu(k,1364) - lu(k,1117) * lu(k,1354) - lu(k,1365) = lu(k,1365) - lu(k,1118) * lu(k,1354) - lu(k,1366) = lu(k,1366) - lu(k,1119) * lu(k,1354) - lu(k,1367) = lu(k,1367) - lu(k,1120) * lu(k,1354) - lu(k,1368) = lu(k,1368) - lu(k,1121) * lu(k,1354) - lu(k,1369) = lu(k,1369) - lu(k,1122) * lu(k,1354) - lu(k,1370) = lu(k,1370) - lu(k,1123) * lu(k,1354) - lu(k,1371) = lu(k,1371) - lu(k,1124) * lu(k,1354) - lu(k,1397) = lu(k,1397) - lu(k,1108) * lu(k,1396) - lu(k,1398) = lu(k,1398) - lu(k,1109) * lu(k,1396) - lu(k,1399) = lu(k,1399) - lu(k,1110) * lu(k,1396) - lu(k,1400) = lu(k,1400) - lu(k,1111) * lu(k,1396) - lu(k,1401) = lu(k,1401) - lu(k,1112) * lu(k,1396) - lu(k,1402) = lu(k,1402) - lu(k,1113) * lu(k,1396) - lu(k,1403) = lu(k,1403) - lu(k,1114) * lu(k,1396) - lu(k,1404) = lu(k,1404) - lu(k,1115) * lu(k,1396) - lu(k,1405) = lu(k,1405) - lu(k,1116) * lu(k,1396) - lu(k,1406) = lu(k,1406) - lu(k,1117) * lu(k,1396) - lu(k,1407) = lu(k,1407) - lu(k,1118) * lu(k,1396) - lu(k,1408) = lu(k,1408) - lu(k,1119) * lu(k,1396) - lu(k,1409) = lu(k,1409) - lu(k,1120) * lu(k,1396) - lu(k,1410) = lu(k,1410) - lu(k,1121) * lu(k,1396) - lu(k,1411) = lu(k,1411) - lu(k,1122) * lu(k,1396) - lu(k,1412) = lu(k,1412) - lu(k,1123) * lu(k,1396) - lu(k,1413) = lu(k,1413) - lu(k,1124) * lu(k,1396) - lu(k,1435) = lu(k,1435) - lu(k,1108) * lu(k,1434) - lu(k,1436) = lu(k,1436) - lu(k,1109) * lu(k,1434) - lu(k,1437) = lu(k,1437) - lu(k,1110) * lu(k,1434) - lu(k,1438) = lu(k,1438) - lu(k,1111) * lu(k,1434) - lu(k,1439) = lu(k,1439) - lu(k,1112) * lu(k,1434) - lu(k,1440) = lu(k,1440) - lu(k,1113) * lu(k,1434) - lu(k,1441) = lu(k,1441) - lu(k,1114) * lu(k,1434) - lu(k,1442) = lu(k,1442) - lu(k,1115) * lu(k,1434) - lu(k,1443) = lu(k,1443) - lu(k,1116) * lu(k,1434) - lu(k,1444) = lu(k,1444) - lu(k,1117) * lu(k,1434) - lu(k,1445) = lu(k,1445) - lu(k,1118) * lu(k,1434) - lu(k,1446) = lu(k,1446) - lu(k,1119) * lu(k,1434) - lu(k,1447) = lu(k,1447) - lu(k,1120) * lu(k,1434) - lu(k,1448) = lu(k,1448) - lu(k,1121) * lu(k,1434) - lu(k,1449) = lu(k,1449) - lu(k,1122) * lu(k,1434) - lu(k,1450) = lu(k,1450) - lu(k,1123) * lu(k,1434) - lu(k,1451) = lu(k,1451) - lu(k,1124) * lu(k,1434) - lu(k,1480) = lu(k,1480) - lu(k,1108) * lu(k,1479) - lu(k,1481) = lu(k,1481) - lu(k,1109) * lu(k,1479) - lu(k,1482) = lu(k,1482) - lu(k,1110) * lu(k,1479) - lu(k,1483) = lu(k,1483) - lu(k,1111) * lu(k,1479) - lu(k,1484) = lu(k,1484) - lu(k,1112) * lu(k,1479) - lu(k,1485) = lu(k,1485) - lu(k,1113) * lu(k,1479) - lu(k,1486) = lu(k,1486) - lu(k,1114) * lu(k,1479) - lu(k,1487) = lu(k,1487) - lu(k,1115) * lu(k,1479) - lu(k,1488) = lu(k,1488) - lu(k,1116) * lu(k,1479) - lu(k,1489) = lu(k,1489) - lu(k,1117) * lu(k,1479) - lu(k,1490) = lu(k,1490) - lu(k,1118) * lu(k,1479) - lu(k,1491) = lu(k,1491) - lu(k,1119) * lu(k,1479) - lu(k,1492) = lu(k,1492) - lu(k,1120) * lu(k,1479) - lu(k,1493) = lu(k,1493) - lu(k,1121) * lu(k,1479) - lu(k,1494) = lu(k,1494) - lu(k,1122) * lu(k,1479) - lu(k,1495) = lu(k,1495) - lu(k,1123) * lu(k,1479) - lu(k,1496) = lu(k,1496) - lu(k,1124) * lu(k,1479) - lu(k,1523) = lu(k,1523) - lu(k,1108) * lu(k,1522) - lu(k,1524) = lu(k,1524) - lu(k,1109) * lu(k,1522) - lu(k,1525) = lu(k,1525) - lu(k,1110) * lu(k,1522) - lu(k,1526) = lu(k,1526) - lu(k,1111) * lu(k,1522) - lu(k,1527) = lu(k,1527) - lu(k,1112) * lu(k,1522) - lu(k,1528) = lu(k,1528) - lu(k,1113) * lu(k,1522) - lu(k,1529) = lu(k,1529) - lu(k,1114) * lu(k,1522) - lu(k,1530) = lu(k,1530) - lu(k,1115) * lu(k,1522) - lu(k,1531) = lu(k,1531) - lu(k,1116) * lu(k,1522) - lu(k,1532) = lu(k,1532) - lu(k,1117) * lu(k,1522) - lu(k,1533) = lu(k,1533) - lu(k,1118) * lu(k,1522) - lu(k,1534) = lu(k,1534) - lu(k,1119) * lu(k,1522) - lu(k,1535) = lu(k,1535) - lu(k,1120) * lu(k,1522) - lu(k,1536) = lu(k,1536) - lu(k,1121) * lu(k,1522) - lu(k,1537) = lu(k,1537) - lu(k,1122) * lu(k,1522) - lu(k,1538) = lu(k,1538) - lu(k,1123) * lu(k,1522) - lu(k,1539) = lu(k,1539) - lu(k,1124) * lu(k,1522) - lu(k,1566) = lu(k,1566) - lu(k,1108) * lu(k,1565) - lu(k,1567) = lu(k,1567) - lu(k,1109) * lu(k,1565) - lu(k,1568) = lu(k,1568) - lu(k,1110) * lu(k,1565) - lu(k,1569) = lu(k,1569) - lu(k,1111) * lu(k,1565) - lu(k,1570) = lu(k,1570) - lu(k,1112) * lu(k,1565) - lu(k,1571) = lu(k,1571) - lu(k,1113) * lu(k,1565) - lu(k,1572) = lu(k,1572) - lu(k,1114) * lu(k,1565) - lu(k,1573) = lu(k,1573) - lu(k,1115) * lu(k,1565) - lu(k,1574) = lu(k,1574) - lu(k,1116) * lu(k,1565) - lu(k,1575) = lu(k,1575) - lu(k,1117) * lu(k,1565) - lu(k,1576) = lu(k,1576) - lu(k,1118) * lu(k,1565) - lu(k,1577) = lu(k,1577) - lu(k,1119) * lu(k,1565) - lu(k,1578) = lu(k,1578) - lu(k,1120) * lu(k,1565) - lu(k,1579) = lu(k,1579) - lu(k,1121) * lu(k,1565) - lu(k,1580) = lu(k,1580) - lu(k,1122) * lu(k,1565) - lu(k,1581) = lu(k,1581) - lu(k,1123) * lu(k,1565) - lu(k,1582) = lu(k,1582) - lu(k,1124) * lu(k,1565) - lu(k,1599) = lu(k,1599) - lu(k,1108) * lu(k,1598) - lu(k,1600) = lu(k,1600) - lu(k,1109) * lu(k,1598) - lu(k,1601) = lu(k,1601) - lu(k,1110) * lu(k,1598) - lu(k,1602) = lu(k,1602) - lu(k,1111) * lu(k,1598) - lu(k,1603) = lu(k,1603) - lu(k,1112) * lu(k,1598) - lu(k,1604) = lu(k,1604) - lu(k,1113) * lu(k,1598) - lu(k,1605) = lu(k,1605) - lu(k,1114) * lu(k,1598) - lu(k,1606) = lu(k,1606) - lu(k,1115) * lu(k,1598) - lu(k,1607) = lu(k,1607) - lu(k,1116) * lu(k,1598) - lu(k,1608) = lu(k,1608) - lu(k,1117) * lu(k,1598) - lu(k,1609) = lu(k,1609) - lu(k,1118) * lu(k,1598) - lu(k,1610) = lu(k,1610) - lu(k,1119) * lu(k,1598) - lu(k,1611) = lu(k,1611) - lu(k,1120) * lu(k,1598) - lu(k,1612) = lu(k,1612) - lu(k,1121) * lu(k,1598) - lu(k,1613) = lu(k,1613) - lu(k,1122) * lu(k,1598) - lu(k,1614) = lu(k,1614) - lu(k,1123) * lu(k,1598) - lu(k,1615) = lu(k,1615) - lu(k,1124) * lu(k,1598) - lu(k,1635) = lu(k,1635) - lu(k,1108) * lu(k,1634) - lu(k,1636) = lu(k,1636) - lu(k,1109) * lu(k,1634) - lu(k,1637) = lu(k,1637) - lu(k,1110) * lu(k,1634) - lu(k,1638) = lu(k,1638) - lu(k,1111) * lu(k,1634) - lu(k,1639) = lu(k,1639) - lu(k,1112) * lu(k,1634) - lu(k,1640) = lu(k,1640) - lu(k,1113) * lu(k,1634) - lu(k,1641) = lu(k,1641) - lu(k,1114) * lu(k,1634) - lu(k,1642) = lu(k,1642) - lu(k,1115) * lu(k,1634) - lu(k,1643) = lu(k,1643) - lu(k,1116) * lu(k,1634) - lu(k,1644) = lu(k,1644) - lu(k,1117) * lu(k,1634) - lu(k,1645) = lu(k,1645) - lu(k,1118) * lu(k,1634) - lu(k,1646) = lu(k,1646) - lu(k,1119) * lu(k,1634) - lu(k,1647) = lu(k,1647) - lu(k,1120) * lu(k,1634) - lu(k,1648) = lu(k,1648) - lu(k,1121) * lu(k,1634) - lu(k,1649) = lu(k,1649) - lu(k,1122) * lu(k,1634) - lu(k,1650) = lu(k,1650) - lu(k,1123) * lu(k,1634) - lu(k,1651) = lu(k,1651) - lu(k,1124) * lu(k,1634) - lu(k,1678) = lu(k,1678) - lu(k,1108) * lu(k,1677) - lu(k,1679) = lu(k,1679) - lu(k,1109) * lu(k,1677) - lu(k,1680) = lu(k,1680) - lu(k,1110) * lu(k,1677) - lu(k,1681) = lu(k,1681) - lu(k,1111) * lu(k,1677) - lu(k,1682) = lu(k,1682) - lu(k,1112) * lu(k,1677) - lu(k,1683) = lu(k,1683) - lu(k,1113) * lu(k,1677) - lu(k,1684) = lu(k,1684) - lu(k,1114) * lu(k,1677) - lu(k,1685) = lu(k,1685) - lu(k,1115) * lu(k,1677) - lu(k,1686) = lu(k,1686) - lu(k,1116) * lu(k,1677) - lu(k,1687) = lu(k,1687) - lu(k,1117) * lu(k,1677) - lu(k,1688) = lu(k,1688) - lu(k,1118) * lu(k,1677) - lu(k,1689) = lu(k,1689) - lu(k,1119) * lu(k,1677) - lu(k,1690) = lu(k,1690) - lu(k,1120) * lu(k,1677) - lu(k,1691) = lu(k,1691) - lu(k,1121) * lu(k,1677) - lu(k,1692) = lu(k,1692) - lu(k,1122) * lu(k,1677) - lu(k,1693) = lu(k,1693) - lu(k,1123) * lu(k,1677) - lu(k,1694) = lu(k,1694) - lu(k,1124) * lu(k,1677) - lu(k,1714) = lu(k,1714) - lu(k,1108) * lu(k,1713) - lu(k,1715) = lu(k,1715) - lu(k,1109) * lu(k,1713) - lu(k,1716) = lu(k,1716) - lu(k,1110) * lu(k,1713) - lu(k,1717) = lu(k,1717) - lu(k,1111) * lu(k,1713) - lu(k,1718) = lu(k,1718) - lu(k,1112) * lu(k,1713) - lu(k,1719) = lu(k,1719) - lu(k,1113) * lu(k,1713) - lu(k,1720) = lu(k,1720) - lu(k,1114) * lu(k,1713) - lu(k,1721) = lu(k,1721) - lu(k,1115) * lu(k,1713) - lu(k,1722) = lu(k,1722) - lu(k,1116) * lu(k,1713) - lu(k,1723) = lu(k,1723) - lu(k,1117) * lu(k,1713) - lu(k,1724) = lu(k,1724) - lu(k,1118) * lu(k,1713) - lu(k,1725) = lu(k,1725) - lu(k,1119) * lu(k,1713) - lu(k,1726) = lu(k,1726) - lu(k,1120) * lu(k,1713) - lu(k,1727) = lu(k,1727) - lu(k,1121) * lu(k,1713) - lu(k,1728) = lu(k,1728) - lu(k,1122) * lu(k,1713) - lu(k,1729) = lu(k,1729) - lu(k,1123) * lu(k,1713) - lu(k,1730) = lu(k,1730) - lu(k,1124) * lu(k,1713) - lu(k,1756) = lu(k,1756) - lu(k,1108) * lu(k,1755) - lu(k,1757) = lu(k,1757) - lu(k,1109) * lu(k,1755) - lu(k,1758) = lu(k,1758) - lu(k,1110) * lu(k,1755) - lu(k,1759) = lu(k,1759) - lu(k,1111) * lu(k,1755) - lu(k,1760) = lu(k,1760) - lu(k,1112) * lu(k,1755) - lu(k,1761) = lu(k,1761) - lu(k,1113) * lu(k,1755) - lu(k,1762) = lu(k,1762) - lu(k,1114) * lu(k,1755) - lu(k,1763) = lu(k,1763) - lu(k,1115) * lu(k,1755) - lu(k,1764) = lu(k,1764) - lu(k,1116) * lu(k,1755) - lu(k,1765) = lu(k,1765) - lu(k,1117) * lu(k,1755) - lu(k,1766) = lu(k,1766) - lu(k,1118) * lu(k,1755) - lu(k,1767) = lu(k,1767) - lu(k,1119) * lu(k,1755) - lu(k,1768) = lu(k,1768) - lu(k,1120) * lu(k,1755) - lu(k,1769) = lu(k,1769) - lu(k,1121) * lu(k,1755) - lu(k,1770) = lu(k,1770) - lu(k,1122) * lu(k,1755) - lu(k,1771) = lu(k,1771) - lu(k,1123) * lu(k,1755) - lu(k,1772) = lu(k,1772) - lu(k,1124) * lu(k,1755) - lu(k,1809) = lu(k,1809) - lu(k,1108) * lu(k,1808) - lu(k,1810) = lu(k,1810) - lu(k,1109) * lu(k,1808) - lu(k,1811) = lu(k,1811) - lu(k,1110) * lu(k,1808) - lu(k,1812) = lu(k,1812) - lu(k,1111) * lu(k,1808) - lu(k,1813) = lu(k,1813) - lu(k,1112) * lu(k,1808) - lu(k,1814) = lu(k,1814) - lu(k,1113) * lu(k,1808) - lu(k,1815) = lu(k,1815) - lu(k,1114) * lu(k,1808) - lu(k,1816) = lu(k,1816) - lu(k,1115) * lu(k,1808) - lu(k,1817) = lu(k,1817) - lu(k,1116) * lu(k,1808) - lu(k,1818) = lu(k,1818) - lu(k,1117) * lu(k,1808) - lu(k,1819) = lu(k,1819) - lu(k,1118) * lu(k,1808) - lu(k,1820) = lu(k,1820) - lu(k,1119) * lu(k,1808) - lu(k,1821) = lu(k,1821) - lu(k,1120) * lu(k,1808) - lu(k,1822) = lu(k,1822) - lu(k,1121) * lu(k,1808) - lu(k,1823) = lu(k,1823) - lu(k,1122) * lu(k,1808) - lu(k,1824) = lu(k,1824) - lu(k,1123) * lu(k,1808) - lu(k,1825) = lu(k,1825) - lu(k,1124) * lu(k,1808) - end do + real(r8), intent(inout) :: lu(:) + lu(1026) = 1._r8 / lu(1026) + lu(1027) = lu(1027) * lu(1026) + lu(1028) = lu(1028) * lu(1026) + lu(1029) = lu(1029) * lu(1026) + lu(1030) = lu(1030) * lu(1026) + lu(1031) = lu(1031) * lu(1026) + lu(1032) = lu(1032) * lu(1026) + lu(1033) = lu(1033) * lu(1026) + lu(1034) = lu(1034) * lu(1026) + lu(1035) = lu(1035) * lu(1026) + lu(1036) = lu(1036) * lu(1026) + lu(1037) = lu(1037) * lu(1026) + lu(1038) = lu(1038) * lu(1026) + lu(1039) = lu(1039) * lu(1026) + lu(1040) = lu(1040) * lu(1026) + lu(1041) = lu(1041) * lu(1026) + lu(1042) = lu(1042) * lu(1026) + lu(1043) = lu(1043) * lu(1026) + lu(1071) = lu(1071) - lu(1027) * lu(1070) + lu(1072) = lu(1072) - lu(1028) * lu(1070) + lu(1073) = lu(1073) - lu(1029) * lu(1070) + lu(1074) = lu(1074) - lu(1030) * lu(1070) + lu(1075) = lu(1075) - lu(1031) * lu(1070) + lu(1076) = lu(1076) - lu(1032) * lu(1070) + lu(1077) = lu(1077) - lu(1033) * lu(1070) + lu(1078) = lu(1078) - lu(1034) * lu(1070) + lu(1079) = lu(1079) - lu(1035) * lu(1070) + lu(1080) = lu(1080) - lu(1036) * lu(1070) + lu(1081) = lu(1081) - lu(1037) * lu(1070) + lu(1082) = lu(1082) - lu(1038) * lu(1070) + lu(1083) = lu(1083) - lu(1039) * lu(1070) + lu(1084) = lu(1084) - lu(1040) * lu(1070) + lu(1085) = lu(1085) - lu(1041) * lu(1070) + lu(1086) = lu(1086) - lu(1042) * lu(1070) + lu(1087) = lu(1087) - lu(1043) * lu(1070) + lu(1113) = lu(1113) - lu(1027) * lu(1112) + lu(1114) = lu(1114) - lu(1028) * lu(1112) + lu(1115) = lu(1115) - lu(1029) * lu(1112) + lu(1116) = lu(1116) - lu(1030) * lu(1112) + lu(1117) = lu(1117) - lu(1031) * lu(1112) + lu(1118) = lu(1118) - lu(1032) * lu(1112) + lu(1119) = lu(1119) - lu(1033) * lu(1112) + lu(1120) = lu(1120) - lu(1034) * lu(1112) + lu(1121) = lu(1121) - lu(1035) * lu(1112) + lu(1122) = lu(1122) - lu(1036) * lu(1112) + lu(1123) = lu(1123) - lu(1037) * lu(1112) + lu(1124) = lu(1124) - lu(1038) * lu(1112) + lu(1125) = lu(1125) - lu(1039) * lu(1112) + lu(1126) = lu(1126) - lu(1040) * lu(1112) + lu(1127) = lu(1127) - lu(1041) * lu(1112) + lu(1128) = lu(1128) - lu(1042) * lu(1112) + lu(1129) = lu(1129) - lu(1043) * lu(1112) + lu(1156) = lu(1156) - lu(1027) * lu(1155) + lu(1157) = lu(1157) - lu(1028) * lu(1155) + lu(1158) = lu(1158) - lu(1029) * lu(1155) + lu(1159) = lu(1159) - lu(1030) * lu(1155) + lu(1160) = lu(1160) - lu(1031) * lu(1155) + lu(1161) = lu(1161) - lu(1032) * lu(1155) + lu(1162) = lu(1162) - lu(1033) * lu(1155) + lu(1163) = lu(1163) - lu(1034) * lu(1155) + lu(1164) = lu(1164) - lu(1035) * lu(1155) + lu(1165) = lu(1165) - lu(1036) * lu(1155) + lu(1166) = lu(1166) - lu(1037) * lu(1155) + lu(1167) = lu(1167) - lu(1038) * lu(1155) + lu(1168) = lu(1168) - lu(1039) * lu(1155) + lu(1169) = lu(1169) - lu(1040) * lu(1155) + lu(1170) = lu(1170) - lu(1041) * lu(1155) + lu(1171) = lu(1171) - lu(1042) * lu(1155) + lu(1172) = lu(1172) - lu(1043) * lu(1155) + lu(1198) = lu(1198) - lu(1027) * lu(1197) + lu(1199) = lu(1199) - lu(1028) * lu(1197) + lu(1200) = lu(1200) - lu(1029) * lu(1197) + lu(1201) = lu(1201) - lu(1030) * lu(1197) + lu(1202) = lu(1202) - lu(1031) * lu(1197) + lu(1203) = lu(1203) - lu(1032) * lu(1197) + lu(1204) = lu(1204) - lu(1033) * lu(1197) + lu(1205) = lu(1205) - lu(1034) * lu(1197) + lu(1206) = lu(1206) - lu(1035) * lu(1197) + lu(1207) = lu(1207) - lu(1036) * lu(1197) + lu(1208) = lu(1208) - lu(1037) * lu(1197) + lu(1209) = lu(1209) - lu(1038) * lu(1197) + lu(1210) = lu(1210) - lu(1039) * lu(1197) + lu(1211) = lu(1211) - lu(1040) * lu(1197) + lu(1212) = lu(1212) - lu(1041) * lu(1197) + lu(1213) = lu(1213) - lu(1042) * lu(1197) + lu(1214) = lu(1214) - lu(1043) * lu(1197) + lu(1233) = lu(1233) - lu(1027) * lu(1232) + lu(1234) = lu(1234) - lu(1028) * lu(1232) + lu(1235) = lu(1235) - lu(1029) * lu(1232) + lu(1236) = lu(1236) - lu(1030) * lu(1232) + lu(1237) = lu(1237) - lu(1031) * lu(1232) + lu(1238) = lu(1238) - lu(1032) * lu(1232) + lu(1239) = lu(1239) - lu(1033) * lu(1232) + lu(1240) = lu(1240) - lu(1034) * lu(1232) + lu(1241) = lu(1241) - lu(1035) * lu(1232) + lu(1242) = lu(1242) - lu(1036) * lu(1232) + lu(1243) = lu(1243) - lu(1037) * lu(1232) + lu(1244) = lu(1244) - lu(1038) * lu(1232) + lu(1245) = lu(1245) - lu(1039) * lu(1232) + lu(1246) = lu(1246) - lu(1040) * lu(1232) + lu(1247) = lu(1247) - lu(1041) * lu(1232) + lu(1248) = lu(1248) - lu(1042) * lu(1232) + lu(1249) = lu(1249) - lu(1043) * lu(1232) + lu(1277) = lu(1277) - lu(1027) * lu(1276) + lu(1278) = lu(1278) - lu(1028) * lu(1276) + lu(1279) = lu(1279) - lu(1029) * lu(1276) + lu(1280) = lu(1280) - lu(1030) * lu(1276) + lu(1281) = lu(1281) - lu(1031) * lu(1276) + lu(1282) = lu(1282) - lu(1032) * lu(1276) + lu(1283) = lu(1283) - lu(1033) * lu(1276) + lu(1284) = lu(1284) - lu(1034) * lu(1276) + lu(1285) = lu(1285) - lu(1035) * lu(1276) + lu(1286) = lu(1286) - lu(1036) * lu(1276) + lu(1287) = lu(1287) - lu(1037) * lu(1276) + lu(1288) = lu(1288) - lu(1038) * lu(1276) + lu(1289) = lu(1289) - lu(1039) * lu(1276) + lu(1290) = lu(1290) - lu(1040) * lu(1276) + lu(1291) = lu(1291) - lu(1041) * lu(1276) + lu(1292) = lu(1292) - lu(1042) * lu(1276) + lu(1293) = lu(1293) - lu(1043) * lu(1276) + lu(1318) = lu(1318) - lu(1027) * lu(1317) + lu(1319) = lu(1319) - lu(1028) * lu(1317) + lu(1320) = lu(1320) - lu(1029) * lu(1317) + lu(1321) = lu(1321) - lu(1030) * lu(1317) + lu(1322) = lu(1322) - lu(1031) * lu(1317) + lu(1323) = lu(1323) - lu(1032) * lu(1317) + lu(1324) = lu(1324) - lu(1033) * lu(1317) + lu(1325) = lu(1325) - lu(1034) * lu(1317) + lu(1326) = lu(1326) - lu(1035) * lu(1317) + lu(1327) = lu(1327) - lu(1036) * lu(1317) + lu(1328) = lu(1328) - lu(1037) * lu(1317) + lu(1329) = lu(1329) - lu(1038) * lu(1317) + lu(1330) = lu(1330) - lu(1039) * lu(1317) + lu(1331) = lu(1331) - lu(1040) * lu(1317) + lu(1332) = lu(1332) - lu(1041) * lu(1317) + lu(1333) = lu(1333) - lu(1042) * lu(1317) + lu(1334) = lu(1334) - lu(1043) * lu(1317) + lu(1360) = lu(1360) - lu(1027) * lu(1359) + lu(1361) = lu(1361) - lu(1028) * lu(1359) + lu(1362) = lu(1362) - lu(1029) * lu(1359) + lu(1363) = lu(1363) - lu(1030) * lu(1359) + lu(1364) = lu(1364) - lu(1031) * lu(1359) + lu(1365) = lu(1365) - lu(1032) * lu(1359) + lu(1366) = lu(1366) - lu(1033) * lu(1359) + lu(1367) = lu(1367) - lu(1034) * lu(1359) + lu(1368) = lu(1368) - lu(1035) * lu(1359) + lu(1369) = lu(1369) - lu(1036) * lu(1359) + lu(1370) = lu(1370) - lu(1037) * lu(1359) + lu(1371) = lu(1371) - lu(1038) * lu(1359) + lu(1372) = lu(1372) - lu(1039) * lu(1359) + lu(1373) = lu(1373) - lu(1040) * lu(1359) + lu(1374) = lu(1374) - lu(1041) * lu(1359) + lu(1375) = lu(1375) - lu(1042) * lu(1359) + lu(1376) = lu(1376) - lu(1043) * lu(1359) + lu(1402) = lu(1402) - lu(1027) * lu(1401) + lu(1403) = lu(1403) - lu(1028) * lu(1401) + lu(1404) = lu(1404) - lu(1029) * lu(1401) + lu(1405) = lu(1405) - lu(1030) * lu(1401) + lu(1406) = lu(1406) - lu(1031) * lu(1401) + lu(1407) = lu(1407) - lu(1032) * lu(1401) + lu(1408) = lu(1408) - lu(1033) * lu(1401) + lu(1409) = lu(1409) - lu(1034) * lu(1401) + lu(1410) = lu(1410) - lu(1035) * lu(1401) + lu(1411) = lu(1411) - lu(1036) * lu(1401) + lu(1412) = lu(1412) - lu(1037) * lu(1401) + lu(1413) = lu(1413) - lu(1038) * lu(1401) + lu(1414) = lu(1414) - lu(1039) * lu(1401) + lu(1415) = lu(1415) - lu(1040) * lu(1401) + lu(1416) = lu(1416) - lu(1041) * lu(1401) + lu(1417) = lu(1417) - lu(1042) * lu(1401) + lu(1418) = lu(1418) - lu(1043) * lu(1401) + lu(1444) = lu(1444) - lu(1027) * lu(1443) + lu(1445) = lu(1445) - lu(1028) * lu(1443) + lu(1446) = lu(1446) - lu(1029) * lu(1443) + lu(1447) = lu(1447) - lu(1030) * lu(1443) + lu(1448) = lu(1448) - lu(1031) * lu(1443) + lu(1449) = lu(1449) - lu(1032) * lu(1443) + lu(1450) = lu(1450) - lu(1033) * lu(1443) + lu(1451) = lu(1451) - lu(1034) * lu(1443) + lu(1452) = lu(1452) - lu(1035) * lu(1443) + lu(1453) = lu(1453) - lu(1036) * lu(1443) + lu(1454) = lu(1454) - lu(1037) * lu(1443) + lu(1455) = lu(1455) - lu(1038) * lu(1443) + lu(1456) = lu(1456) - lu(1039) * lu(1443) + lu(1457) = lu(1457) - lu(1040) * lu(1443) + lu(1458) = lu(1458) - lu(1041) * lu(1443) + lu(1459) = lu(1459) - lu(1042) * lu(1443) + lu(1460) = lu(1460) - lu(1043) * lu(1443) + lu(1499) = lu(1499) - lu(1027) * lu(1498) + lu(1500) = lu(1500) - lu(1028) * lu(1498) + lu(1501) = lu(1501) - lu(1029) * lu(1498) + lu(1502) = lu(1502) - lu(1030) * lu(1498) + lu(1503) = lu(1503) - lu(1031) * lu(1498) + lu(1504) = lu(1504) - lu(1032) * lu(1498) + lu(1505) = lu(1505) - lu(1033) * lu(1498) + lu(1506) = lu(1506) - lu(1034) * lu(1498) + lu(1507) = lu(1507) - lu(1035) * lu(1498) + lu(1508) = lu(1508) - lu(1036) * lu(1498) + lu(1509) = lu(1509) - lu(1037) * lu(1498) + lu(1510) = lu(1510) - lu(1038) * lu(1498) + lu(1511) = lu(1511) - lu(1039) * lu(1498) + lu(1512) = lu(1512) - lu(1040) * lu(1498) + lu(1513) = lu(1513) - lu(1041) * lu(1498) + lu(1514) = lu(1514) - lu(1042) * lu(1498) + lu(1515) = lu(1515) - lu(1043) * lu(1498) + lu(1531) = lu(1531) - lu(1027) * lu(1530) + lu(1532) = lu(1532) - lu(1028) * lu(1530) + lu(1533) = lu(1533) - lu(1029) * lu(1530) + lu(1534) = lu(1534) - lu(1030) * lu(1530) + lu(1535) = lu(1535) - lu(1031) * lu(1530) + lu(1536) = lu(1536) - lu(1032) * lu(1530) + lu(1537) = lu(1537) - lu(1033) * lu(1530) + lu(1538) = lu(1538) - lu(1034) * lu(1530) + lu(1539) = lu(1539) - lu(1035) * lu(1530) + lu(1540) = lu(1540) - lu(1036) * lu(1530) + lu(1541) = lu(1541) - lu(1037) * lu(1530) + lu(1542) = lu(1542) - lu(1038) * lu(1530) + lu(1543) = lu(1543) - lu(1039) * lu(1530) + lu(1544) = lu(1544) - lu(1040) * lu(1530) + lu(1545) = lu(1545) - lu(1041) * lu(1530) + lu(1546) = lu(1546) - lu(1042) * lu(1530) + lu(1547) = lu(1547) - lu(1043) * lu(1530) + lu(1566) = lu(1566) - lu(1027) * lu(1565) + lu(1567) = lu(1567) - lu(1028) * lu(1565) + lu(1568) = lu(1568) - lu(1029) * lu(1565) + lu(1569) = lu(1569) - lu(1030) * lu(1565) + lu(1570) = lu(1570) - lu(1031) * lu(1565) + lu(1571) = lu(1571) - lu(1032) * lu(1565) + lu(1572) = lu(1572) - lu(1033) * lu(1565) + lu(1573) = lu(1573) - lu(1034) * lu(1565) + lu(1574) = lu(1574) - lu(1035) * lu(1565) + lu(1575) = lu(1575) - lu(1036) * lu(1565) + lu(1576) = lu(1576) - lu(1037) * lu(1565) + lu(1577) = lu(1577) - lu(1038) * lu(1565) + lu(1578) = lu(1578) - lu(1039) * lu(1565) + lu(1579) = lu(1579) - lu(1040) * lu(1565) + lu(1580) = lu(1580) - lu(1041) * lu(1565) + lu(1581) = lu(1581) - lu(1042) * lu(1565) + lu(1582) = lu(1582) - lu(1043) * lu(1565) + lu(1604) = lu(1604) - lu(1027) * lu(1603) + lu(1605) = lu(1605) - lu(1028) * lu(1603) + lu(1606) = lu(1606) - lu(1029) * lu(1603) + lu(1607) = lu(1607) - lu(1030) * lu(1603) + lu(1608) = lu(1608) - lu(1031) * lu(1603) + lu(1609) = lu(1609) - lu(1032) * lu(1603) + lu(1610) = lu(1610) - lu(1033) * lu(1603) + lu(1611) = lu(1611) - lu(1034) * lu(1603) + lu(1612) = lu(1612) - lu(1035) * lu(1603) + lu(1613) = lu(1613) - lu(1036) * lu(1603) + lu(1614) = lu(1614) - lu(1037) * lu(1603) + lu(1615) = lu(1615) - lu(1038) * lu(1603) + lu(1616) = lu(1616) - lu(1039) * lu(1603) + lu(1617) = lu(1617) - lu(1040) * lu(1603) + lu(1618) = lu(1618) - lu(1041) * lu(1603) + lu(1619) = lu(1619) - lu(1042) * lu(1603) + lu(1620) = lu(1620) - lu(1043) * lu(1603) + lu(1643) = lu(1643) - lu(1027) * lu(1642) + lu(1644) = lu(1644) - lu(1028) * lu(1642) + lu(1645) = lu(1645) - lu(1029) * lu(1642) + lu(1646) = lu(1646) - lu(1030) * lu(1642) + lu(1647) = lu(1647) - lu(1031) * lu(1642) + lu(1648) = lu(1648) - lu(1032) * lu(1642) + lu(1649) = lu(1649) - lu(1033) * lu(1642) + lu(1650) = lu(1650) - lu(1034) * lu(1642) + lu(1651) = lu(1651) - lu(1035) * lu(1642) + lu(1652) = lu(1652) - lu(1036) * lu(1642) + lu(1653) = lu(1653) - lu(1037) * lu(1642) + lu(1654) = lu(1654) - lu(1038) * lu(1642) + lu(1655) = lu(1655) - lu(1039) * lu(1642) + lu(1656) = lu(1656) - lu(1040) * lu(1642) + lu(1657) = lu(1657) - lu(1041) * lu(1642) + lu(1658) = lu(1658) - lu(1042) * lu(1642) + lu(1659) = lu(1659) - lu(1043) * lu(1642) + lu(1677) = lu(1677) - lu(1027) * lu(1676) + lu(1678) = lu(1678) - lu(1028) * lu(1676) + lu(1679) = lu(1679) - lu(1029) * lu(1676) + lu(1680) = lu(1680) - lu(1030) * lu(1676) + lu(1681) = lu(1681) - lu(1031) * lu(1676) + lu(1682) = lu(1682) - lu(1032) * lu(1676) + lu(1683) = lu(1683) - lu(1033) * lu(1676) + lu(1684) = lu(1684) - lu(1034) * lu(1676) + lu(1685) = lu(1685) - lu(1035) * lu(1676) + lu(1686) = lu(1686) - lu(1036) * lu(1676) + lu(1687) = lu(1687) - lu(1037) * lu(1676) + lu(1688) = lu(1688) - lu(1038) * lu(1676) + lu(1689) = lu(1689) - lu(1039) * lu(1676) + lu(1690) = lu(1690) - lu(1040) * lu(1676) + lu(1691) = lu(1691) - lu(1041) * lu(1676) + lu(1692) = lu(1692) - lu(1042) * lu(1676) + lu(1693) = lu(1693) - lu(1043) * lu(1676) + lu(1729) = lu(1729) - lu(1027) * lu(1728) + lu(1730) = lu(1730) - lu(1028) * lu(1728) + lu(1731) = lu(1731) - lu(1029) * lu(1728) + lu(1732) = lu(1732) - lu(1030) * lu(1728) + lu(1733) = lu(1733) - lu(1031) * lu(1728) + lu(1734) = lu(1734) - lu(1032) * lu(1728) + lu(1735) = lu(1735) - lu(1033) * lu(1728) + lu(1736) = lu(1736) - lu(1034) * lu(1728) + lu(1737) = lu(1737) - lu(1035) * lu(1728) + lu(1738) = lu(1738) - lu(1036) * lu(1728) + lu(1739) = lu(1739) - lu(1037) * lu(1728) + lu(1740) = lu(1740) - lu(1038) * lu(1728) + lu(1741) = lu(1741) - lu(1039) * lu(1728) + lu(1742) = lu(1742) - lu(1040) * lu(1728) + lu(1743) = lu(1743) - lu(1041) * lu(1728) + lu(1744) = lu(1744) - lu(1042) * lu(1728) + lu(1745) = lu(1745) - lu(1043) * lu(1728) + lu(1071) = 1._r8 / lu(1071) + lu(1072) = lu(1072) * lu(1071) + lu(1073) = lu(1073) * lu(1071) + lu(1074) = lu(1074) * lu(1071) + lu(1075) = lu(1075) * lu(1071) + lu(1076) = lu(1076) * lu(1071) + lu(1077) = lu(1077) * lu(1071) + lu(1078) = lu(1078) * lu(1071) + lu(1079) = lu(1079) * lu(1071) + lu(1080) = lu(1080) * lu(1071) + lu(1081) = lu(1081) * lu(1071) + lu(1082) = lu(1082) * lu(1071) + lu(1083) = lu(1083) * lu(1071) + lu(1084) = lu(1084) * lu(1071) + lu(1085) = lu(1085) * lu(1071) + lu(1086) = lu(1086) * lu(1071) + lu(1087) = lu(1087) * lu(1071) + lu(1114) = lu(1114) - lu(1072) * lu(1113) + lu(1115) = lu(1115) - lu(1073) * lu(1113) + lu(1116) = lu(1116) - lu(1074) * lu(1113) + lu(1117) = lu(1117) - lu(1075) * lu(1113) + lu(1118) = lu(1118) - lu(1076) * lu(1113) + lu(1119) = lu(1119) - lu(1077) * lu(1113) + lu(1120) = lu(1120) - lu(1078) * lu(1113) + lu(1121) = lu(1121) - lu(1079) * lu(1113) + lu(1122) = lu(1122) - lu(1080) * lu(1113) + lu(1123) = lu(1123) - lu(1081) * lu(1113) + lu(1124) = lu(1124) - lu(1082) * lu(1113) + lu(1125) = lu(1125) - lu(1083) * lu(1113) + lu(1126) = lu(1126) - lu(1084) * lu(1113) + lu(1127) = lu(1127) - lu(1085) * lu(1113) + lu(1128) = lu(1128) - lu(1086) * lu(1113) + lu(1129) = lu(1129) - lu(1087) * lu(1113) + lu(1157) = lu(1157) - lu(1072) * lu(1156) + lu(1158) = lu(1158) - lu(1073) * lu(1156) + lu(1159) = lu(1159) - lu(1074) * lu(1156) + lu(1160) = lu(1160) - lu(1075) * lu(1156) + lu(1161) = lu(1161) - lu(1076) * lu(1156) + lu(1162) = lu(1162) - lu(1077) * lu(1156) + lu(1163) = lu(1163) - lu(1078) * lu(1156) + lu(1164) = lu(1164) - lu(1079) * lu(1156) + lu(1165) = lu(1165) - lu(1080) * lu(1156) + lu(1166) = lu(1166) - lu(1081) * lu(1156) + lu(1167) = lu(1167) - lu(1082) * lu(1156) + lu(1168) = lu(1168) - lu(1083) * lu(1156) + lu(1169) = lu(1169) - lu(1084) * lu(1156) + lu(1170) = lu(1170) - lu(1085) * lu(1156) + lu(1171) = lu(1171) - lu(1086) * lu(1156) + lu(1172) = lu(1172) - lu(1087) * lu(1156) + lu(1199) = lu(1199) - lu(1072) * lu(1198) + lu(1200) = lu(1200) - lu(1073) * lu(1198) + lu(1201) = lu(1201) - lu(1074) * lu(1198) + lu(1202) = lu(1202) - lu(1075) * lu(1198) + lu(1203) = lu(1203) - lu(1076) * lu(1198) + lu(1204) = lu(1204) - lu(1077) * lu(1198) + lu(1205) = lu(1205) - lu(1078) * lu(1198) + lu(1206) = lu(1206) - lu(1079) * lu(1198) + lu(1207) = lu(1207) - lu(1080) * lu(1198) + lu(1208) = lu(1208) - lu(1081) * lu(1198) + lu(1209) = lu(1209) - lu(1082) * lu(1198) + lu(1210) = lu(1210) - lu(1083) * lu(1198) + lu(1211) = lu(1211) - lu(1084) * lu(1198) + lu(1212) = lu(1212) - lu(1085) * lu(1198) + lu(1213) = lu(1213) - lu(1086) * lu(1198) + lu(1214) = lu(1214) - lu(1087) * lu(1198) + lu(1234) = lu(1234) - lu(1072) * lu(1233) + lu(1235) = lu(1235) - lu(1073) * lu(1233) + lu(1236) = lu(1236) - lu(1074) * lu(1233) + lu(1237) = lu(1237) - lu(1075) * lu(1233) + lu(1238) = lu(1238) - lu(1076) * lu(1233) + lu(1239) = lu(1239) - lu(1077) * lu(1233) + lu(1240) = lu(1240) - lu(1078) * lu(1233) + lu(1241) = lu(1241) - lu(1079) * lu(1233) + lu(1242) = lu(1242) - lu(1080) * lu(1233) + lu(1243) = lu(1243) - lu(1081) * lu(1233) + lu(1244) = lu(1244) - lu(1082) * lu(1233) + lu(1245) = lu(1245) - lu(1083) * lu(1233) + lu(1246) = lu(1246) - lu(1084) * lu(1233) + lu(1247) = lu(1247) - lu(1085) * lu(1233) + lu(1248) = lu(1248) - lu(1086) * lu(1233) + lu(1249) = lu(1249) - lu(1087) * lu(1233) + lu(1278) = lu(1278) - lu(1072) * lu(1277) + lu(1279) = lu(1279) - lu(1073) * lu(1277) + lu(1280) = lu(1280) - lu(1074) * lu(1277) + lu(1281) = lu(1281) - lu(1075) * lu(1277) + lu(1282) = lu(1282) - lu(1076) * lu(1277) + lu(1283) = lu(1283) - lu(1077) * lu(1277) + lu(1284) = lu(1284) - lu(1078) * lu(1277) + lu(1285) = lu(1285) - lu(1079) * lu(1277) + lu(1286) = lu(1286) - lu(1080) * lu(1277) + lu(1287) = lu(1287) - lu(1081) * lu(1277) + lu(1288) = lu(1288) - lu(1082) * lu(1277) + lu(1289) = lu(1289) - lu(1083) * lu(1277) + lu(1290) = lu(1290) - lu(1084) * lu(1277) + lu(1291) = lu(1291) - lu(1085) * lu(1277) + lu(1292) = lu(1292) - lu(1086) * lu(1277) + lu(1293) = lu(1293) - lu(1087) * lu(1277) + lu(1319) = lu(1319) - lu(1072) * lu(1318) + lu(1320) = lu(1320) - lu(1073) * lu(1318) + lu(1321) = lu(1321) - lu(1074) * lu(1318) + lu(1322) = lu(1322) - lu(1075) * lu(1318) + lu(1323) = lu(1323) - lu(1076) * lu(1318) + lu(1324) = lu(1324) - lu(1077) * lu(1318) + lu(1325) = lu(1325) - lu(1078) * lu(1318) + lu(1326) = lu(1326) - lu(1079) * lu(1318) + lu(1327) = lu(1327) - lu(1080) * lu(1318) + lu(1328) = lu(1328) - lu(1081) * lu(1318) + lu(1329) = lu(1329) - lu(1082) * lu(1318) + lu(1330) = lu(1330) - lu(1083) * lu(1318) + lu(1331) = lu(1331) - lu(1084) * lu(1318) + lu(1332) = lu(1332) - lu(1085) * lu(1318) + lu(1333) = lu(1333) - lu(1086) * lu(1318) + lu(1334) = lu(1334) - lu(1087) * lu(1318) + lu(1361) = lu(1361) - lu(1072) * lu(1360) + lu(1362) = lu(1362) - lu(1073) * lu(1360) + lu(1363) = lu(1363) - lu(1074) * lu(1360) + lu(1364) = lu(1364) - lu(1075) * lu(1360) + lu(1365) = lu(1365) - lu(1076) * lu(1360) + lu(1366) = lu(1366) - lu(1077) * lu(1360) + lu(1367) = lu(1367) - lu(1078) * lu(1360) + lu(1368) = lu(1368) - lu(1079) * lu(1360) + lu(1369) = lu(1369) - lu(1080) * lu(1360) + lu(1370) = lu(1370) - lu(1081) * lu(1360) + lu(1371) = lu(1371) - lu(1082) * lu(1360) + lu(1372) = lu(1372) - lu(1083) * lu(1360) + lu(1373) = lu(1373) - lu(1084) * lu(1360) + lu(1374) = lu(1374) - lu(1085) * lu(1360) + lu(1375) = lu(1375) - lu(1086) * lu(1360) + lu(1376) = lu(1376) - lu(1087) * lu(1360) + lu(1403) = lu(1403) - lu(1072) * lu(1402) + lu(1404) = lu(1404) - lu(1073) * lu(1402) + lu(1405) = lu(1405) - lu(1074) * lu(1402) + lu(1406) = lu(1406) - lu(1075) * lu(1402) + lu(1407) = lu(1407) - lu(1076) * lu(1402) + lu(1408) = lu(1408) - lu(1077) * lu(1402) + lu(1409) = lu(1409) - lu(1078) * lu(1402) + lu(1410) = lu(1410) - lu(1079) * lu(1402) + lu(1411) = lu(1411) - lu(1080) * lu(1402) + lu(1412) = lu(1412) - lu(1081) * lu(1402) + lu(1413) = lu(1413) - lu(1082) * lu(1402) + lu(1414) = lu(1414) - lu(1083) * lu(1402) + lu(1415) = lu(1415) - lu(1084) * lu(1402) + lu(1416) = lu(1416) - lu(1085) * lu(1402) + lu(1417) = lu(1417) - lu(1086) * lu(1402) + lu(1418) = lu(1418) - lu(1087) * lu(1402) + lu(1445) = lu(1445) - lu(1072) * lu(1444) + lu(1446) = lu(1446) - lu(1073) * lu(1444) + lu(1447) = lu(1447) - lu(1074) * lu(1444) + lu(1448) = lu(1448) - lu(1075) * lu(1444) + lu(1449) = lu(1449) - lu(1076) * lu(1444) + lu(1450) = lu(1450) - lu(1077) * lu(1444) + lu(1451) = lu(1451) - lu(1078) * lu(1444) + lu(1452) = lu(1452) - lu(1079) * lu(1444) + lu(1453) = lu(1453) - lu(1080) * lu(1444) + lu(1454) = lu(1454) - lu(1081) * lu(1444) + lu(1455) = lu(1455) - lu(1082) * lu(1444) + lu(1456) = lu(1456) - lu(1083) * lu(1444) + lu(1457) = lu(1457) - lu(1084) * lu(1444) + lu(1458) = lu(1458) - lu(1085) * lu(1444) + lu(1459) = lu(1459) - lu(1086) * lu(1444) + lu(1460) = lu(1460) - lu(1087) * lu(1444) + lu(1500) = lu(1500) - lu(1072) * lu(1499) + lu(1501) = lu(1501) - lu(1073) * lu(1499) + lu(1502) = lu(1502) - lu(1074) * lu(1499) + lu(1503) = lu(1503) - lu(1075) * lu(1499) + lu(1504) = lu(1504) - lu(1076) * lu(1499) + lu(1505) = lu(1505) - lu(1077) * lu(1499) + lu(1506) = lu(1506) - lu(1078) * lu(1499) + lu(1507) = lu(1507) - lu(1079) * lu(1499) + lu(1508) = lu(1508) - lu(1080) * lu(1499) + lu(1509) = lu(1509) - lu(1081) * lu(1499) + lu(1510) = lu(1510) - lu(1082) * lu(1499) + lu(1511) = lu(1511) - lu(1083) * lu(1499) + lu(1512) = lu(1512) - lu(1084) * lu(1499) + lu(1513) = lu(1513) - lu(1085) * lu(1499) + lu(1514) = lu(1514) - lu(1086) * lu(1499) + lu(1515) = lu(1515) - lu(1087) * lu(1499) + lu(1532) = lu(1532) - lu(1072) * lu(1531) + lu(1533) = lu(1533) - lu(1073) * lu(1531) + lu(1534) = lu(1534) - lu(1074) * lu(1531) + lu(1535) = lu(1535) - lu(1075) * lu(1531) + lu(1536) = lu(1536) - lu(1076) * lu(1531) + lu(1537) = lu(1537) - lu(1077) * lu(1531) + lu(1538) = lu(1538) - lu(1078) * lu(1531) + lu(1539) = lu(1539) - lu(1079) * lu(1531) + lu(1540) = lu(1540) - lu(1080) * lu(1531) + lu(1541) = lu(1541) - lu(1081) * lu(1531) + lu(1542) = lu(1542) - lu(1082) * lu(1531) + lu(1543) = lu(1543) - lu(1083) * lu(1531) + lu(1544) = lu(1544) - lu(1084) * lu(1531) + lu(1545) = lu(1545) - lu(1085) * lu(1531) + lu(1546) = lu(1546) - lu(1086) * lu(1531) + lu(1547) = lu(1547) - lu(1087) * lu(1531) + lu(1567) = lu(1567) - lu(1072) * lu(1566) + lu(1568) = lu(1568) - lu(1073) * lu(1566) + lu(1569) = lu(1569) - lu(1074) * lu(1566) + lu(1570) = lu(1570) - lu(1075) * lu(1566) + lu(1571) = lu(1571) - lu(1076) * lu(1566) + lu(1572) = lu(1572) - lu(1077) * lu(1566) + lu(1573) = lu(1573) - lu(1078) * lu(1566) + lu(1574) = lu(1574) - lu(1079) * lu(1566) + lu(1575) = lu(1575) - lu(1080) * lu(1566) + lu(1576) = lu(1576) - lu(1081) * lu(1566) + lu(1577) = lu(1577) - lu(1082) * lu(1566) + lu(1578) = lu(1578) - lu(1083) * lu(1566) + lu(1579) = lu(1579) - lu(1084) * lu(1566) + lu(1580) = lu(1580) - lu(1085) * lu(1566) + lu(1581) = lu(1581) - lu(1086) * lu(1566) + lu(1582) = lu(1582) - lu(1087) * lu(1566) + lu(1605) = lu(1605) - lu(1072) * lu(1604) + lu(1606) = lu(1606) - lu(1073) * lu(1604) + lu(1607) = lu(1607) - lu(1074) * lu(1604) + lu(1608) = lu(1608) - lu(1075) * lu(1604) + lu(1609) = lu(1609) - lu(1076) * lu(1604) + lu(1610) = lu(1610) - lu(1077) * lu(1604) + lu(1611) = lu(1611) - lu(1078) * lu(1604) + lu(1612) = lu(1612) - lu(1079) * lu(1604) + lu(1613) = lu(1613) - lu(1080) * lu(1604) + lu(1614) = lu(1614) - lu(1081) * lu(1604) + lu(1615) = lu(1615) - lu(1082) * lu(1604) + lu(1616) = lu(1616) - lu(1083) * lu(1604) + lu(1617) = lu(1617) - lu(1084) * lu(1604) + lu(1618) = lu(1618) - lu(1085) * lu(1604) + lu(1619) = lu(1619) - lu(1086) * lu(1604) + lu(1620) = lu(1620) - lu(1087) * lu(1604) + lu(1644) = lu(1644) - lu(1072) * lu(1643) + lu(1645) = lu(1645) - lu(1073) * lu(1643) + lu(1646) = lu(1646) - lu(1074) * lu(1643) + lu(1647) = lu(1647) - lu(1075) * lu(1643) + lu(1648) = lu(1648) - lu(1076) * lu(1643) + lu(1649) = lu(1649) - lu(1077) * lu(1643) + lu(1650) = lu(1650) - lu(1078) * lu(1643) + lu(1651) = lu(1651) - lu(1079) * lu(1643) + lu(1652) = lu(1652) - lu(1080) * lu(1643) + lu(1653) = lu(1653) - lu(1081) * lu(1643) + lu(1654) = lu(1654) - lu(1082) * lu(1643) + lu(1655) = lu(1655) - lu(1083) * lu(1643) + lu(1656) = lu(1656) - lu(1084) * lu(1643) + lu(1657) = lu(1657) - lu(1085) * lu(1643) + lu(1658) = lu(1658) - lu(1086) * lu(1643) + lu(1659) = lu(1659) - lu(1087) * lu(1643) + lu(1678) = lu(1678) - lu(1072) * lu(1677) + lu(1679) = lu(1679) - lu(1073) * lu(1677) + lu(1680) = lu(1680) - lu(1074) * lu(1677) + lu(1681) = lu(1681) - lu(1075) * lu(1677) + lu(1682) = lu(1682) - lu(1076) * lu(1677) + lu(1683) = lu(1683) - lu(1077) * lu(1677) + lu(1684) = lu(1684) - lu(1078) * lu(1677) + lu(1685) = lu(1685) - lu(1079) * lu(1677) + lu(1686) = lu(1686) - lu(1080) * lu(1677) + lu(1687) = lu(1687) - lu(1081) * lu(1677) + lu(1688) = lu(1688) - lu(1082) * lu(1677) + lu(1689) = lu(1689) - lu(1083) * lu(1677) + lu(1690) = lu(1690) - lu(1084) * lu(1677) + lu(1691) = lu(1691) - lu(1085) * lu(1677) + lu(1692) = lu(1692) - lu(1086) * lu(1677) + lu(1693) = lu(1693) - lu(1087) * lu(1677) + lu(1730) = lu(1730) - lu(1072) * lu(1729) + lu(1731) = lu(1731) - lu(1073) * lu(1729) + lu(1732) = lu(1732) - lu(1074) * lu(1729) + lu(1733) = lu(1733) - lu(1075) * lu(1729) + lu(1734) = lu(1734) - lu(1076) * lu(1729) + lu(1735) = lu(1735) - lu(1077) * lu(1729) + lu(1736) = lu(1736) - lu(1078) * lu(1729) + lu(1737) = lu(1737) - lu(1079) * lu(1729) + lu(1738) = lu(1738) - lu(1080) * lu(1729) + lu(1739) = lu(1739) - lu(1081) * lu(1729) + lu(1740) = lu(1740) - lu(1082) * lu(1729) + lu(1741) = lu(1741) - lu(1083) * lu(1729) + lu(1742) = lu(1742) - lu(1084) * lu(1729) + lu(1743) = lu(1743) - lu(1085) * lu(1729) + lu(1744) = lu(1744) - lu(1086) * lu(1729) + lu(1745) = lu(1745) - lu(1087) * lu(1729) + lu(1114) = 1._r8 / lu(1114) + lu(1115) = lu(1115) * lu(1114) + lu(1116) = lu(1116) * lu(1114) + lu(1117) = lu(1117) * lu(1114) + lu(1118) = lu(1118) * lu(1114) + lu(1119) = lu(1119) * lu(1114) + lu(1120) = lu(1120) * lu(1114) + lu(1121) = lu(1121) * lu(1114) + lu(1122) = lu(1122) * lu(1114) + lu(1123) = lu(1123) * lu(1114) + lu(1124) = lu(1124) * lu(1114) + lu(1125) = lu(1125) * lu(1114) + lu(1126) = lu(1126) * lu(1114) + lu(1127) = lu(1127) * lu(1114) + lu(1128) = lu(1128) * lu(1114) + lu(1129) = lu(1129) * lu(1114) + lu(1158) = lu(1158) - lu(1115) * lu(1157) + lu(1159) = lu(1159) - lu(1116) * lu(1157) + lu(1160) = lu(1160) - lu(1117) * lu(1157) + lu(1161) = lu(1161) - lu(1118) * lu(1157) + lu(1162) = lu(1162) - lu(1119) * lu(1157) + lu(1163) = lu(1163) - lu(1120) * lu(1157) + lu(1164) = lu(1164) - lu(1121) * lu(1157) + lu(1165) = lu(1165) - lu(1122) * lu(1157) + lu(1166) = lu(1166) - lu(1123) * lu(1157) + lu(1167) = lu(1167) - lu(1124) * lu(1157) + lu(1168) = lu(1168) - lu(1125) * lu(1157) + lu(1169) = lu(1169) - lu(1126) * lu(1157) + lu(1170) = lu(1170) - lu(1127) * lu(1157) + lu(1171) = lu(1171) - lu(1128) * lu(1157) + lu(1172) = lu(1172) - lu(1129) * lu(1157) + lu(1200) = lu(1200) - lu(1115) * lu(1199) + lu(1201) = lu(1201) - lu(1116) * lu(1199) + lu(1202) = lu(1202) - lu(1117) * lu(1199) + lu(1203) = lu(1203) - lu(1118) * lu(1199) + lu(1204) = lu(1204) - lu(1119) * lu(1199) + lu(1205) = lu(1205) - lu(1120) * lu(1199) + lu(1206) = lu(1206) - lu(1121) * lu(1199) + lu(1207) = lu(1207) - lu(1122) * lu(1199) + lu(1208) = lu(1208) - lu(1123) * lu(1199) + lu(1209) = lu(1209) - lu(1124) * lu(1199) + lu(1210) = lu(1210) - lu(1125) * lu(1199) + lu(1211) = lu(1211) - lu(1126) * lu(1199) + lu(1212) = lu(1212) - lu(1127) * lu(1199) + lu(1213) = lu(1213) - lu(1128) * lu(1199) + lu(1214) = lu(1214) - lu(1129) * lu(1199) + lu(1235) = lu(1235) - lu(1115) * lu(1234) + lu(1236) = lu(1236) - lu(1116) * lu(1234) + lu(1237) = lu(1237) - lu(1117) * lu(1234) + lu(1238) = lu(1238) - lu(1118) * lu(1234) + lu(1239) = lu(1239) - lu(1119) * lu(1234) + lu(1240) = lu(1240) - lu(1120) * lu(1234) + lu(1241) = lu(1241) - lu(1121) * lu(1234) + lu(1242) = lu(1242) - lu(1122) * lu(1234) + lu(1243) = lu(1243) - lu(1123) * lu(1234) + lu(1244) = lu(1244) - lu(1124) * lu(1234) + lu(1245) = lu(1245) - lu(1125) * lu(1234) + lu(1246) = lu(1246) - lu(1126) * lu(1234) + lu(1247) = lu(1247) - lu(1127) * lu(1234) + lu(1248) = lu(1248) - lu(1128) * lu(1234) + lu(1249) = lu(1249) - lu(1129) * lu(1234) + lu(1279) = lu(1279) - lu(1115) * lu(1278) + lu(1280) = lu(1280) - lu(1116) * lu(1278) + lu(1281) = lu(1281) - lu(1117) * lu(1278) + lu(1282) = lu(1282) - lu(1118) * lu(1278) + lu(1283) = lu(1283) - lu(1119) * lu(1278) + lu(1284) = lu(1284) - lu(1120) * lu(1278) + lu(1285) = lu(1285) - lu(1121) * lu(1278) + lu(1286) = lu(1286) - lu(1122) * lu(1278) + lu(1287) = lu(1287) - lu(1123) * lu(1278) + lu(1288) = lu(1288) - lu(1124) * lu(1278) + lu(1289) = lu(1289) - lu(1125) * lu(1278) + lu(1290) = lu(1290) - lu(1126) * lu(1278) + lu(1291) = lu(1291) - lu(1127) * lu(1278) + lu(1292) = lu(1292) - lu(1128) * lu(1278) + lu(1293) = lu(1293) - lu(1129) * lu(1278) + lu(1320) = lu(1320) - lu(1115) * lu(1319) + lu(1321) = lu(1321) - lu(1116) * lu(1319) + lu(1322) = lu(1322) - lu(1117) * lu(1319) + lu(1323) = lu(1323) - lu(1118) * lu(1319) + lu(1324) = lu(1324) - lu(1119) * lu(1319) + lu(1325) = lu(1325) - lu(1120) * lu(1319) + lu(1326) = lu(1326) - lu(1121) * lu(1319) + lu(1327) = lu(1327) - lu(1122) * lu(1319) + lu(1328) = lu(1328) - lu(1123) * lu(1319) + lu(1329) = lu(1329) - lu(1124) * lu(1319) + lu(1330) = lu(1330) - lu(1125) * lu(1319) + lu(1331) = lu(1331) - lu(1126) * lu(1319) + lu(1332) = lu(1332) - lu(1127) * lu(1319) + lu(1333) = lu(1333) - lu(1128) * lu(1319) + lu(1334) = lu(1334) - lu(1129) * lu(1319) + lu(1362) = lu(1362) - lu(1115) * lu(1361) + lu(1363) = lu(1363) - lu(1116) * lu(1361) + lu(1364) = lu(1364) - lu(1117) * lu(1361) + lu(1365) = lu(1365) - lu(1118) * lu(1361) + lu(1366) = lu(1366) - lu(1119) * lu(1361) + lu(1367) = lu(1367) - lu(1120) * lu(1361) + lu(1368) = lu(1368) - lu(1121) * lu(1361) + lu(1369) = lu(1369) - lu(1122) * lu(1361) + lu(1370) = lu(1370) - lu(1123) * lu(1361) + lu(1371) = lu(1371) - lu(1124) * lu(1361) + lu(1372) = lu(1372) - lu(1125) * lu(1361) + lu(1373) = lu(1373) - lu(1126) * lu(1361) + lu(1374) = lu(1374) - lu(1127) * lu(1361) + lu(1375) = lu(1375) - lu(1128) * lu(1361) + lu(1376) = lu(1376) - lu(1129) * lu(1361) + lu(1404) = lu(1404) - lu(1115) * lu(1403) + lu(1405) = lu(1405) - lu(1116) * lu(1403) + lu(1406) = lu(1406) - lu(1117) * lu(1403) + lu(1407) = lu(1407) - lu(1118) * lu(1403) + lu(1408) = lu(1408) - lu(1119) * lu(1403) + lu(1409) = lu(1409) - lu(1120) * lu(1403) + lu(1410) = lu(1410) - lu(1121) * lu(1403) + lu(1411) = lu(1411) - lu(1122) * lu(1403) + lu(1412) = lu(1412) - lu(1123) * lu(1403) + lu(1413) = lu(1413) - lu(1124) * lu(1403) + lu(1414) = lu(1414) - lu(1125) * lu(1403) + lu(1415) = lu(1415) - lu(1126) * lu(1403) + lu(1416) = lu(1416) - lu(1127) * lu(1403) + lu(1417) = lu(1417) - lu(1128) * lu(1403) + lu(1418) = lu(1418) - lu(1129) * lu(1403) + lu(1446) = lu(1446) - lu(1115) * lu(1445) + lu(1447) = lu(1447) - lu(1116) * lu(1445) + lu(1448) = lu(1448) - lu(1117) * lu(1445) + lu(1449) = lu(1449) - lu(1118) * lu(1445) + lu(1450) = lu(1450) - lu(1119) * lu(1445) + lu(1451) = lu(1451) - lu(1120) * lu(1445) + lu(1452) = lu(1452) - lu(1121) * lu(1445) + lu(1453) = lu(1453) - lu(1122) * lu(1445) + lu(1454) = lu(1454) - lu(1123) * lu(1445) + lu(1455) = lu(1455) - lu(1124) * lu(1445) + lu(1456) = lu(1456) - lu(1125) * lu(1445) + lu(1457) = lu(1457) - lu(1126) * lu(1445) + lu(1458) = lu(1458) - lu(1127) * lu(1445) + lu(1459) = lu(1459) - lu(1128) * lu(1445) + lu(1460) = lu(1460) - lu(1129) * lu(1445) + lu(1501) = lu(1501) - lu(1115) * lu(1500) + lu(1502) = lu(1502) - lu(1116) * lu(1500) + lu(1503) = lu(1503) - lu(1117) * lu(1500) + lu(1504) = lu(1504) - lu(1118) * lu(1500) + lu(1505) = lu(1505) - lu(1119) * lu(1500) + lu(1506) = lu(1506) - lu(1120) * lu(1500) + lu(1507) = lu(1507) - lu(1121) * lu(1500) + lu(1508) = lu(1508) - lu(1122) * lu(1500) + lu(1509) = lu(1509) - lu(1123) * lu(1500) + lu(1510) = lu(1510) - lu(1124) * lu(1500) + lu(1511) = lu(1511) - lu(1125) * lu(1500) + lu(1512) = lu(1512) - lu(1126) * lu(1500) + lu(1513) = lu(1513) - lu(1127) * lu(1500) + lu(1514) = lu(1514) - lu(1128) * lu(1500) + lu(1515) = lu(1515) - lu(1129) * lu(1500) + lu(1533) = lu(1533) - lu(1115) * lu(1532) + lu(1534) = lu(1534) - lu(1116) * lu(1532) + lu(1535) = lu(1535) - lu(1117) * lu(1532) + lu(1536) = lu(1536) - lu(1118) * lu(1532) + lu(1537) = lu(1537) - lu(1119) * lu(1532) + lu(1538) = lu(1538) - lu(1120) * lu(1532) + lu(1539) = lu(1539) - lu(1121) * lu(1532) + lu(1540) = lu(1540) - lu(1122) * lu(1532) + lu(1541) = lu(1541) - lu(1123) * lu(1532) + lu(1542) = lu(1542) - lu(1124) * lu(1532) + lu(1543) = lu(1543) - lu(1125) * lu(1532) + lu(1544) = lu(1544) - lu(1126) * lu(1532) + lu(1545) = lu(1545) - lu(1127) * lu(1532) + lu(1546) = lu(1546) - lu(1128) * lu(1532) + lu(1547) = lu(1547) - lu(1129) * lu(1532) + lu(1568) = lu(1568) - lu(1115) * lu(1567) + lu(1569) = lu(1569) - lu(1116) * lu(1567) + lu(1570) = lu(1570) - lu(1117) * lu(1567) + lu(1571) = lu(1571) - lu(1118) * lu(1567) + lu(1572) = lu(1572) - lu(1119) * lu(1567) + lu(1573) = lu(1573) - lu(1120) * lu(1567) + lu(1574) = lu(1574) - lu(1121) * lu(1567) + lu(1575) = lu(1575) - lu(1122) * lu(1567) + lu(1576) = lu(1576) - lu(1123) * lu(1567) + lu(1577) = lu(1577) - lu(1124) * lu(1567) + lu(1578) = lu(1578) - lu(1125) * lu(1567) + lu(1579) = lu(1579) - lu(1126) * lu(1567) + lu(1580) = lu(1580) - lu(1127) * lu(1567) + lu(1581) = lu(1581) - lu(1128) * lu(1567) + lu(1582) = lu(1582) - lu(1129) * lu(1567) + lu(1606) = lu(1606) - lu(1115) * lu(1605) + lu(1607) = lu(1607) - lu(1116) * lu(1605) + lu(1608) = lu(1608) - lu(1117) * lu(1605) + lu(1609) = lu(1609) - lu(1118) * lu(1605) + lu(1610) = lu(1610) - lu(1119) * lu(1605) + lu(1611) = lu(1611) - lu(1120) * lu(1605) + lu(1612) = lu(1612) - lu(1121) * lu(1605) + lu(1613) = lu(1613) - lu(1122) * lu(1605) + lu(1614) = lu(1614) - lu(1123) * lu(1605) + lu(1615) = lu(1615) - lu(1124) * lu(1605) + lu(1616) = lu(1616) - lu(1125) * lu(1605) + lu(1617) = lu(1617) - lu(1126) * lu(1605) + lu(1618) = lu(1618) - lu(1127) * lu(1605) + lu(1619) = lu(1619) - lu(1128) * lu(1605) + lu(1620) = lu(1620) - lu(1129) * lu(1605) + lu(1645) = lu(1645) - lu(1115) * lu(1644) + lu(1646) = lu(1646) - lu(1116) * lu(1644) + lu(1647) = lu(1647) - lu(1117) * lu(1644) + lu(1648) = lu(1648) - lu(1118) * lu(1644) + lu(1649) = lu(1649) - lu(1119) * lu(1644) + lu(1650) = lu(1650) - lu(1120) * lu(1644) + lu(1651) = lu(1651) - lu(1121) * lu(1644) + lu(1652) = lu(1652) - lu(1122) * lu(1644) + lu(1653) = lu(1653) - lu(1123) * lu(1644) + lu(1654) = lu(1654) - lu(1124) * lu(1644) + lu(1655) = lu(1655) - lu(1125) * lu(1644) + lu(1656) = lu(1656) - lu(1126) * lu(1644) + lu(1657) = lu(1657) - lu(1127) * lu(1644) + lu(1658) = lu(1658) - lu(1128) * lu(1644) + lu(1659) = lu(1659) - lu(1129) * lu(1644) + lu(1679) = lu(1679) - lu(1115) * lu(1678) + lu(1680) = lu(1680) - lu(1116) * lu(1678) + lu(1681) = lu(1681) - lu(1117) * lu(1678) + lu(1682) = lu(1682) - lu(1118) * lu(1678) + lu(1683) = lu(1683) - lu(1119) * lu(1678) + lu(1684) = lu(1684) - lu(1120) * lu(1678) + lu(1685) = lu(1685) - lu(1121) * lu(1678) + lu(1686) = lu(1686) - lu(1122) * lu(1678) + lu(1687) = lu(1687) - lu(1123) * lu(1678) + lu(1688) = lu(1688) - lu(1124) * lu(1678) + lu(1689) = lu(1689) - lu(1125) * lu(1678) + lu(1690) = lu(1690) - lu(1126) * lu(1678) + lu(1691) = lu(1691) - lu(1127) * lu(1678) + lu(1692) = lu(1692) - lu(1128) * lu(1678) + lu(1693) = lu(1693) - lu(1129) * lu(1678) + lu(1731) = lu(1731) - lu(1115) * lu(1730) + lu(1732) = lu(1732) - lu(1116) * lu(1730) + lu(1733) = lu(1733) - lu(1117) * lu(1730) + lu(1734) = lu(1734) - lu(1118) * lu(1730) + lu(1735) = lu(1735) - lu(1119) * lu(1730) + lu(1736) = lu(1736) - lu(1120) * lu(1730) + lu(1737) = lu(1737) - lu(1121) * lu(1730) + lu(1738) = lu(1738) - lu(1122) * lu(1730) + lu(1739) = lu(1739) - lu(1123) * lu(1730) + lu(1740) = lu(1740) - lu(1124) * lu(1730) + lu(1741) = lu(1741) - lu(1125) * lu(1730) + lu(1742) = lu(1742) - lu(1126) * lu(1730) + lu(1743) = lu(1743) - lu(1127) * lu(1730) + lu(1744) = lu(1744) - lu(1128) * lu(1730) + lu(1745) = lu(1745) - lu(1129) * lu(1730) end subroutine lu_fac19 - subroutine lu_fac20( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac20( lu ) 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,1153) = 1._r8 / lu(k,1153) - lu(k,1154) = lu(k,1154) * lu(k,1153) - lu(k,1155) = lu(k,1155) * lu(k,1153) - lu(k,1156) = lu(k,1156) * lu(k,1153) - lu(k,1157) = lu(k,1157) * lu(k,1153) - lu(k,1158) = lu(k,1158) * lu(k,1153) - lu(k,1159) = lu(k,1159) * lu(k,1153) - lu(k,1160) = lu(k,1160) * lu(k,1153) - lu(k,1161) = lu(k,1161) * lu(k,1153) - lu(k,1162) = lu(k,1162) * lu(k,1153) - lu(k,1163) = lu(k,1163) * lu(k,1153) - lu(k,1164) = lu(k,1164) * lu(k,1153) - lu(k,1165) = lu(k,1165) * lu(k,1153) - lu(k,1166) = lu(k,1166) * lu(k,1153) - lu(k,1167) = lu(k,1167) * lu(k,1153) - lu(k,1168) = lu(k,1168) * lu(k,1153) - lu(k,1169) = lu(k,1169) * lu(k,1153) - lu(k,1197) = lu(k,1197) - lu(k,1154) * lu(k,1196) - lu(k,1198) = lu(k,1198) - lu(k,1155) * lu(k,1196) - lu(k,1199) = lu(k,1199) - lu(k,1156) * lu(k,1196) - lu(k,1200) = lu(k,1200) - lu(k,1157) * lu(k,1196) - lu(k,1201) = lu(k,1201) - lu(k,1158) * lu(k,1196) - lu(k,1202) = lu(k,1202) - lu(k,1159) * lu(k,1196) - lu(k,1203) = lu(k,1203) - lu(k,1160) * lu(k,1196) - lu(k,1204) = lu(k,1204) - lu(k,1161) * lu(k,1196) - lu(k,1205) = lu(k,1205) - lu(k,1162) * lu(k,1196) - lu(k,1206) = lu(k,1206) - lu(k,1163) * lu(k,1196) - lu(k,1207) = lu(k,1207) - lu(k,1164) * lu(k,1196) - lu(k,1208) = lu(k,1208) - lu(k,1165) * lu(k,1196) - lu(k,1209) = lu(k,1209) - lu(k,1166) * lu(k,1196) - lu(k,1210) = lu(k,1210) - lu(k,1167) * lu(k,1196) - lu(k,1211) = lu(k,1211) - lu(k,1168) * lu(k,1196) - lu(k,1212) = lu(k,1212) - lu(k,1169) * lu(k,1196) - lu(k,1232) = lu(k,1232) - lu(k,1154) * lu(k,1231) - lu(k,1233) = lu(k,1233) - lu(k,1155) * lu(k,1231) - lu(k,1234) = lu(k,1234) - lu(k,1156) * lu(k,1231) - lu(k,1235) = lu(k,1235) - lu(k,1157) * lu(k,1231) - lu(k,1236) = lu(k,1236) - lu(k,1158) * lu(k,1231) - lu(k,1237) = lu(k,1237) - lu(k,1159) * lu(k,1231) - lu(k,1238) = lu(k,1238) - lu(k,1160) * lu(k,1231) - lu(k,1239) = lu(k,1239) - lu(k,1161) * lu(k,1231) - lu(k,1240) = lu(k,1240) - lu(k,1162) * lu(k,1231) - lu(k,1241) = lu(k,1241) - lu(k,1163) * lu(k,1231) - lu(k,1242) = lu(k,1242) - lu(k,1164) * lu(k,1231) - lu(k,1243) = lu(k,1243) - lu(k,1165) * lu(k,1231) - lu(k,1244) = lu(k,1244) - lu(k,1166) * lu(k,1231) - lu(k,1245) = lu(k,1245) - lu(k,1167) * lu(k,1231) - lu(k,1246) = lu(k,1246) - lu(k,1168) * lu(k,1231) - lu(k,1247) = lu(k,1247) - lu(k,1169) * lu(k,1231) - lu(k,1275) = lu(k,1275) - lu(k,1154) * lu(k,1274) - lu(k,1276) = lu(k,1276) - lu(k,1155) * lu(k,1274) - lu(k,1277) = lu(k,1277) - lu(k,1156) * lu(k,1274) - lu(k,1278) = lu(k,1278) - lu(k,1157) * lu(k,1274) - lu(k,1279) = lu(k,1279) - lu(k,1158) * lu(k,1274) - lu(k,1280) = lu(k,1280) - lu(k,1159) * lu(k,1274) - lu(k,1281) = lu(k,1281) - lu(k,1160) * lu(k,1274) - lu(k,1282) = lu(k,1282) - lu(k,1161) * lu(k,1274) - lu(k,1283) = lu(k,1283) - lu(k,1162) * lu(k,1274) - lu(k,1284) = lu(k,1284) - lu(k,1163) * lu(k,1274) - lu(k,1285) = lu(k,1285) - lu(k,1164) * lu(k,1274) - lu(k,1286) = lu(k,1286) - lu(k,1165) * lu(k,1274) - lu(k,1287) = lu(k,1287) - lu(k,1166) * lu(k,1274) - lu(k,1288) = lu(k,1288) - lu(k,1167) * lu(k,1274) - lu(k,1289) = lu(k,1289) - lu(k,1168) * lu(k,1274) - lu(k,1290) = lu(k,1290) - lu(k,1169) * lu(k,1274) - lu(k,1311) = lu(k,1311) - lu(k,1154) * lu(k,1310) - lu(k,1312) = lu(k,1312) - lu(k,1155) * lu(k,1310) - lu(k,1313) = lu(k,1313) - lu(k,1156) * lu(k,1310) - lu(k,1314) = lu(k,1314) - lu(k,1157) * lu(k,1310) - lu(k,1315) = lu(k,1315) - lu(k,1158) * lu(k,1310) - lu(k,1316) = lu(k,1316) - lu(k,1159) * lu(k,1310) - lu(k,1317) = lu(k,1317) - lu(k,1160) * lu(k,1310) - lu(k,1318) = lu(k,1318) - lu(k,1161) * lu(k,1310) - lu(k,1319) = lu(k,1319) - lu(k,1162) * lu(k,1310) - lu(k,1320) = lu(k,1320) - lu(k,1163) * lu(k,1310) - lu(k,1321) = lu(k,1321) - lu(k,1164) * lu(k,1310) - lu(k,1322) = lu(k,1322) - lu(k,1165) * lu(k,1310) - lu(k,1323) = lu(k,1323) - lu(k,1166) * lu(k,1310) - lu(k,1324) = lu(k,1324) - lu(k,1167) * lu(k,1310) - lu(k,1325) = lu(k,1325) - lu(k,1168) * lu(k,1310) - lu(k,1326) = lu(k,1326) - lu(k,1169) * lu(k,1310) - lu(k,1356) = lu(k,1356) - lu(k,1154) * lu(k,1355) - lu(k,1357) = lu(k,1357) - lu(k,1155) * lu(k,1355) - lu(k,1358) = lu(k,1358) - lu(k,1156) * lu(k,1355) - lu(k,1359) = lu(k,1359) - lu(k,1157) * lu(k,1355) - lu(k,1360) = lu(k,1360) - lu(k,1158) * lu(k,1355) - lu(k,1361) = lu(k,1361) - lu(k,1159) * lu(k,1355) - lu(k,1362) = lu(k,1362) - lu(k,1160) * lu(k,1355) - lu(k,1363) = lu(k,1363) - lu(k,1161) * lu(k,1355) - lu(k,1364) = lu(k,1364) - lu(k,1162) * lu(k,1355) - lu(k,1365) = lu(k,1365) - lu(k,1163) * lu(k,1355) - lu(k,1366) = lu(k,1366) - lu(k,1164) * lu(k,1355) - lu(k,1367) = lu(k,1367) - lu(k,1165) * lu(k,1355) - lu(k,1368) = lu(k,1368) - lu(k,1166) * lu(k,1355) - lu(k,1369) = lu(k,1369) - lu(k,1167) * lu(k,1355) - lu(k,1370) = lu(k,1370) - lu(k,1168) * lu(k,1355) - lu(k,1371) = lu(k,1371) - lu(k,1169) * lu(k,1355) - lu(k,1398) = lu(k,1398) - lu(k,1154) * lu(k,1397) - lu(k,1399) = lu(k,1399) - lu(k,1155) * lu(k,1397) - lu(k,1400) = lu(k,1400) - lu(k,1156) * lu(k,1397) - lu(k,1401) = lu(k,1401) - lu(k,1157) * lu(k,1397) - lu(k,1402) = lu(k,1402) - lu(k,1158) * lu(k,1397) - lu(k,1403) = lu(k,1403) - lu(k,1159) * lu(k,1397) - lu(k,1404) = lu(k,1404) - lu(k,1160) * lu(k,1397) - lu(k,1405) = lu(k,1405) - lu(k,1161) * lu(k,1397) - lu(k,1406) = lu(k,1406) - lu(k,1162) * lu(k,1397) - lu(k,1407) = lu(k,1407) - lu(k,1163) * lu(k,1397) - lu(k,1408) = lu(k,1408) - lu(k,1164) * lu(k,1397) - lu(k,1409) = lu(k,1409) - lu(k,1165) * lu(k,1397) - lu(k,1410) = lu(k,1410) - lu(k,1166) * lu(k,1397) - lu(k,1411) = lu(k,1411) - lu(k,1167) * lu(k,1397) - lu(k,1412) = lu(k,1412) - lu(k,1168) * lu(k,1397) - lu(k,1413) = lu(k,1413) - lu(k,1169) * lu(k,1397) - lu(k,1436) = lu(k,1436) - lu(k,1154) * lu(k,1435) - lu(k,1437) = lu(k,1437) - lu(k,1155) * lu(k,1435) - lu(k,1438) = lu(k,1438) - lu(k,1156) * lu(k,1435) - lu(k,1439) = lu(k,1439) - lu(k,1157) * lu(k,1435) - lu(k,1440) = lu(k,1440) - lu(k,1158) * lu(k,1435) - lu(k,1441) = lu(k,1441) - lu(k,1159) * lu(k,1435) - lu(k,1442) = lu(k,1442) - lu(k,1160) * lu(k,1435) - lu(k,1443) = lu(k,1443) - lu(k,1161) * lu(k,1435) - lu(k,1444) = lu(k,1444) - lu(k,1162) * lu(k,1435) - lu(k,1445) = lu(k,1445) - lu(k,1163) * lu(k,1435) - lu(k,1446) = lu(k,1446) - lu(k,1164) * lu(k,1435) - lu(k,1447) = lu(k,1447) - lu(k,1165) * lu(k,1435) - lu(k,1448) = lu(k,1448) - lu(k,1166) * lu(k,1435) - lu(k,1449) = lu(k,1449) - lu(k,1167) * lu(k,1435) - lu(k,1450) = lu(k,1450) - lu(k,1168) * lu(k,1435) - lu(k,1451) = lu(k,1451) - lu(k,1169) * lu(k,1435) - lu(k,1481) = lu(k,1481) - lu(k,1154) * lu(k,1480) - lu(k,1482) = lu(k,1482) - lu(k,1155) * lu(k,1480) - lu(k,1483) = lu(k,1483) - lu(k,1156) * lu(k,1480) - lu(k,1484) = lu(k,1484) - lu(k,1157) * lu(k,1480) - lu(k,1485) = lu(k,1485) - lu(k,1158) * lu(k,1480) - lu(k,1486) = lu(k,1486) - lu(k,1159) * lu(k,1480) - lu(k,1487) = lu(k,1487) - lu(k,1160) * lu(k,1480) - lu(k,1488) = lu(k,1488) - lu(k,1161) * lu(k,1480) - lu(k,1489) = lu(k,1489) - lu(k,1162) * lu(k,1480) - lu(k,1490) = lu(k,1490) - lu(k,1163) * lu(k,1480) - lu(k,1491) = lu(k,1491) - lu(k,1164) * lu(k,1480) - lu(k,1492) = lu(k,1492) - lu(k,1165) * lu(k,1480) - lu(k,1493) = lu(k,1493) - lu(k,1166) * lu(k,1480) - lu(k,1494) = lu(k,1494) - lu(k,1167) * lu(k,1480) - lu(k,1495) = lu(k,1495) - lu(k,1168) * lu(k,1480) - lu(k,1496) = lu(k,1496) - lu(k,1169) * lu(k,1480) - lu(k,1524) = lu(k,1524) - lu(k,1154) * lu(k,1523) - lu(k,1525) = lu(k,1525) - lu(k,1155) * lu(k,1523) - lu(k,1526) = lu(k,1526) - lu(k,1156) * lu(k,1523) - lu(k,1527) = lu(k,1527) - lu(k,1157) * lu(k,1523) - lu(k,1528) = lu(k,1528) - lu(k,1158) * lu(k,1523) - lu(k,1529) = lu(k,1529) - lu(k,1159) * lu(k,1523) - lu(k,1530) = lu(k,1530) - lu(k,1160) * lu(k,1523) - lu(k,1531) = lu(k,1531) - lu(k,1161) * lu(k,1523) - lu(k,1532) = lu(k,1532) - lu(k,1162) * lu(k,1523) - lu(k,1533) = lu(k,1533) - lu(k,1163) * lu(k,1523) - lu(k,1534) = lu(k,1534) - lu(k,1164) * lu(k,1523) - lu(k,1535) = lu(k,1535) - lu(k,1165) * lu(k,1523) - lu(k,1536) = lu(k,1536) - lu(k,1166) * lu(k,1523) - lu(k,1537) = lu(k,1537) - lu(k,1167) * lu(k,1523) - lu(k,1538) = lu(k,1538) - lu(k,1168) * lu(k,1523) - lu(k,1539) = lu(k,1539) - lu(k,1169) * lu(k,1523) - lu(k,1567) = lu(k,1567) - lu(k,1154) * lu(k,1566) - lu(k,1568) = lu(k,1568) - lu(k,1155) * lu(k,1566) - lu(k,1569) = lu(k,1569) - lu(k,1156) * lu(k,1566) - lu(k,1570) = lu(k,1570) - lu(k,1157) * lu(k,1566) - lu(k,1571) = lu(k,1571) - lu(k,1158) * lu(k,1566) - lu(k,1572) = lu(k,1572) - lu(k,1159) * lu(k,1566) - lu(k,1573) = lu(k,1573) - lu(k,1160) * lu(k,1566) - lu(k,1574) = lu(k,1574) - lu(k,1161) * lu(k,1566) - lu(k,1575) = lu(k,1575) - lu(k,1162) * lu(k,1566) - lu(k,1576) = lu(k,1576) - lu(k,1163) * lu(k,1566) - lu(k,1577) = lu(k,1577) - lu(k,1164) * lu(k,1566) - lu(k,1578) = lu(k,1578) - lu(k,1165) * lu(k,1566) - lu(k,1579) = lu(k,1579) - lu(k,1166) * lu(k,1566) - lu(k,1580) = lu(k,1580) - lu(k,1167) * lu(k,1566) - lu(k,1581) = lu(k,1581) - lu(k,1168) * lu(k,1566) - lu(k,1582) = lu(k,1582) - lu(k,1169) * lu(k,1566) - lu(k,1600) = lu(k,1600) - lu(k,1154) * lu(k,1599) - lu(k,1601) = lu(k,1601) - lu(k,1155) * lu(k,1599) - lu(k,1602) = lu(k,1602) - lu(k,1156) * lu(k,1599) - lu(k,1603) = lu(k,1603) - lu(k,1157) * lu(k,1599) - lu(k,1604) = lu(k,1604) - lu(k,1158) * lu(k,1599) - lu(k,1605) = lu(k,1605) - lu(k,1159) * lu(k,1599) - lu(k,1606) = lu(k,1606) - lu(k,1160) * lu(k,1599) - lu(k,1607) = lu(k,1607) - lu(k,1161) * lu(k,1599) - lu(k,1608) = lu(k,1608) - lu(k,1162) * lu(k,1599) - lu(k,1609) = lu(k,1609) - lu(k,1163) * lu(k,1599) - lu(k,1610) = lu(k,1610) - lu(k,1164) * lu(k,1599) - lu(k,1611) = lu(k,1611) - lu(k,1165) * lu(k,1599) - lu(k,1612) = lu(k,1612) - lu(k,1166) * lu(k,1599) - lu(k,1613) = lu(k,1613) - lu(k,1167) * lu(k,1599) - lu(k,1614) = lu(k,1614) - lu(k,1168) * lu(k,1599) - lu(k,1615) = lu(k,1615) - lu(k,1169) * lu(k,1599) - lu(k,1636) = lu(k,1636) - lu(k,1154) * lu(k,1635) - lu(k,1637) = lu(k,1637) - lu(k,1155) * lu(k,1635) - lu(k,1638) = lu(k,1638) - lu(k,1156) * lu(k,1635) - lu(k,1639) = lu(k,1639) - lu(k,1157) * lu(k,1635) - lu(k,1640) = lu(k,1640) - lu(k,1158) * lu(k,1635) - lu(k,1641) = lu(k,1641) - lu(k,1159) * lu(k,1635) - lu(k,1642) = lu(k,1642) - lu(k,1160) * lu(k,1635) - lu(k,1643) = lu(k,1643) - lu(k,1161) * lu(k,1635) - lu(k,1644) = lu(k,1644) - lu(k,1162) * lu(k,1635) - lu(k,1645) = lu(k,1645) - lu(k,1163) * lu(k,1635) - lu(k,1646) = lu(k,1646) - lu(k,1164) * lu(k,1635) - lu(k,1647) = lu(k,1647) - lu(k,1165) * lu(k,1635) - lu(k,1648) = lu(k,1648) - lu(k,1166) * lu(k,1635) - lu(k,1649) = lu(k,1649) - lu(k,1167) * lu(k,1635) - lu(k,1650) = lu(k,1650) - lu(k,1168) * lu(k,1635) - lu(k,1651) = lu(k,1651) - lu(k,1169) * lu(k,1635) - lu(k,1679) = lu(k,1679) - lu(k,1154) * lu(k,1678) - lu(k,1680) = lu(k,1680) - lu(k,1155) * lu(k,1678) - lu(k,1681) = lu(k,1681) - lu(k,1156) * lu(k,1678) - lu(k,1682) = lu(k,1682) - lu(k,1157) * lu(k,1678) - lu(k,1683) = lu(k,1683) - lu(k,1158) * lu(k,1678) - lu(k,1684) = lu(k,1684) - lu(k,1159) * lu(k,1678) - lu(k,1685) = lu(k,1685) - lu(k,1160) * lu(k,1678) - lu(k,1686) = lu(k,1686) - lu(k,1161) * lu(k,1678) - lu(k,1687) = lu(k,1687) - lu(k,1162) * lu(k,1678) - lu(k,1688) = lu(k,1688) - lu(k,1163) * lu(k,1678) - lu(k,1689) = lu(k,1689) - lu(k,1164) * lu(k,1678) - lu(k,1690) = lu(k,1690) - lu(k,1165) * lu(k,1678) - lu(k,1691) = lu(k,1691) - lu(k,1166) * lu(k,1678) - lu(k,1692) = lu(k,1692) - lu(k,1167) * lu(k,1678) - lu(k,1693) = lu(k,1693) - lu(k,1168) * lu(k,1678) - lu(k,1694) = lu(k,1694) - lu(k,1169) * lu(k,1678) - lu(k,1715) = lu(k,1715) - lu(k,1154) * lu(k,1714) - lu(k,1716) = lu(k,1716) - lu(k,1155) * lu(k,1714) - lu(k,1717) = lu(k,1717) - lu(k,1156) * lu(k,1714) - lu(k,1718) = lu(k,1718) - lu(k,1157) * lu(k,1714) - lu(k,1719) = lu(k,1719) - lu(k,1158) * lu(k,1714) - lu(k,1720) = lu(k,1720) - lu(k,1159) * lu(k,1714) - lu(k,1721) = lu(k,1721) - lu(k,1160) * lu(k,1714) - lu(k,1722) = lu(k,1722) - lu(k,1161) * lu(k,1714) - lu(k,1723) = lu(k,1723) - lu(k,1162) * lu(k,1714) - lu(k,1724) = lu(k,1724) - lu(k,1163) * lu(k,1714) - lu(k,1725) = lu(k,1725) - lu(k,1164) * lu(k,1714) - lu(k,1726) = lu(k,1726) - lu(k,1165) * lu(k,1714) - lu(k,1727) = lu(k,1727) - lu(k,1166) * lu(k,1714) - lu(k,1728) = lu(k,1728) - lu(k,1167) * lu(k,1714) - lu(k,1729) = lu(k,1729) - lu(k,1168) * lu(k,1714) - lu(k,1730) = lu(k,1730) - lu(k,1169) * lu(k,1714) - lu(k,1757) = lu(k,1757) - lu(k,1154) * lu(k,1756) - lu(k,1758) = lu(k,1758) - lu(k,1155) * lu(k,1756) - lu(k,1759) = lu(k,1759) - lu(k,1156) * lu(k,1756) - lu(k,1760) = lu(k,1760) - lu(k,1157) * lu(k,1756) - lu(k,1761) = lu(k,1761) - lu(k,1158) * lu(k,1756) - lu(k,1762) = lu(k,1762) - lu(k,1159) * lu(k,1756) - lu(k,1763) = lu(k,1763) - lu(k,1160) * lu(k,1756) - lu(k,1764) = lu(k,1764) - lu(k,1161) * lu(k,1756) - lu(k,1765) = lu(k,1765) - lu(k,1162) * lu(k,1756) - lu(k,1766) = lu(k,1766) - lu(k,1163) * lu(k,1756) - lu(k,1767) = lu(k,1767) - lu(k,1164) * lu(k,1756) - lu(k,1768) = lu(k,1768) - lu(k,1165) * lu(k,1756) - lu(k,1769) = lu(k,1769) - lu(k,1166) * lu(k,1756) - lu(k,1770) = lu(k,1770) - lu(k,1167) * lu(k,1756) - lu(k,1771) = lu(k,1771) - lu(k,1168) * lu(k,1756) - lu(k,1772) = lu(k,1772) - lu(k,1169) * lu(k,1756) - lu(k,1810) = lu(k,1810) - lu(k,1154) * lu(k,1809) - lu(k,1811) = lu(k,1811) - lu(k,1155) * lu(k,1809) - lu(k,1812) = lu(k,1812) - lu(k,1156) * lu(k,1809) - lu(k,1813) = lu(k,1813) - lu(k,1157) * lu(k,1809) - lu(k,1814) = lu(k,1814) - lu(k,1158) * lu(k,1809) - lu(k,1815) = lu(k,1815) - lu(k,1159) * lu(k,1809) - lu(k,1816) = lu(k,1816) - lu(k,1160) * lu(k,1809) - lu(k,1817) = lu(k,1817) - lu(k,1161) * lu(k,1809) - lu(k,1818) = lu(k,1818) - lu(k,1162) * lu(k,1809) - lu(k,1819) = lu(k,1819) - lu(k,1163) * lu(k,1809) - lu(k,1820) = lu(k,1820) - lu(k,1164) * lu(k,1809) - lu(k,1821) = lu(k,1821) - lu(k,1165) * lu(k,1809) - lu(k,1822) = lu(k,1822) - lu(k,1166) * lu(k,1809) - lu(k,1823) = lu(k,1823) - lu(k,1167) * lu(k,1809) - lu(k,1824) = lu(k,1824) - lu(k,1168) * lu(k,1809) - lu(k,1825) = lu(k,1825) - lu(k,1169) * lu(k,1809) - lu(k,1197) = 1._r8 / lu(k,1197) - lu(k,1198) = lu(k,1198) * lu(k,1197) - lu(k,1199) = lu(k,1199) * lu(k,1197) - lu(k,1200) = lu(k,1200) * lu(k,1197) - lu(k,1201) = lu(k,1201) * lu(k,1197) - lu(k,1202) = lu(k,1202) * lu(k,1197) - lu(k,1203) = lu(k,1203) * lu(k,1197) - lu(k,1204) = lu(k,1204) * lu(k,1197) - lu(k,1205) = lu(k,1205) * lu(k,1197) - lu(k,1206) = lu(k,1206) * lu(k,1197) - lu(k,1207) = lu(k,1207) * lu(k,1197) - lu(k,1208) = lu(k,1208) * lu(k,1197) - lu(k,1209) = lu(k,1209) * lu(k,1197) - lu(k,1210) = lu(k,1210) * lu(k,1197) - lu(k,1211) = lu(k,1211) * lu(k,1197) - lu(k,1212) = lu(k,1212) * lu(k,1197) - lu(k,1233) = lu(k,1233) - lu(k,1198) * lu(k,1232) - lu(k,1234) = lu(k,1234) - lu(k,1199) * lu(k,1232) - lu(k,1235) = lu(k,1235) - lu(k,1200) * lu(k,1232) - lu(k,1236) = lu(k,1236) - lu(k,1201) * lu(k,1232) - lu(k,1237) = lu(k,1237) - lu(k,1202) * lu(k,1232) - lu(k,1238) = lu(k,1238) - lu(k,1203) * lu(k,1232) - lu(k,1239) = lu(k,1239) - lu(k,1204) * lu(k,1232) - lu(k,1240) = lu(k,1240) - lu(k,1205) * lu(k,1232) - lu(k,1241) = lu(k,1241) - lu(k,1206) * lu(k,1232) - lu(k,1242) = lu(k,1242) - lu(k,1207) * lu(k,1232) - lu(k,1243) = lu(k,1243) - lu(k,1208) * lu(k,1232) - lu(k,1244) = lu(k,1244) - lu(k,1209) * lu(k,1232) - lu(k,1245) = lu(k,1245) - lu(k,1210) * lu(k,1232) - lu(k,1246) = lu(k,1246) - lu(k,1211) * lu(k,1232) - lu(k,1247) = lu(k,1247) - lu(k,1212) * lu(k,1232) - lu(k,1276) = lu(k,1276) - lu(k,1198) * lu(k,1275) - lu(k,1277) = lu(k,1277) - lu(k,1199) * lu(k,1275) - lu(k,1278) = lu(k,1278) - lu(k,1200) * lu(k,1275) - lu(k,1279) = lu(k,1279) - lu(k,1201) * lu(k,1275) - lu(k,1280) = lu(k,1280) - lu(k,1202) * lu(k,1275) - lu(k,1281) = lu(k,1281) - lu(k,1203) * lu(k,1275) - lu(k,1282) = lu(k,1282) - lu(k,1204) * lu(k,1275) - lu(k,1283) = lu(k,1283) - lu(k,1205) * lu(k,1275) - lu(k,1284) = lu(k,1284) - lu(k,1206) * lu(k,1275) - lu(k,1285) = lu(k,1285) - lu(k,1207) * lu(k,1275) - lu(k,1286) = lu(k,1286) - lu(k,1208) * lu(k,1275) - lu(k,1287) = lu(k,1287) - lu(k,1209) * lu(k,1275) - lu(k,1288) = lu(k,1288) - lu(k,1210) * lu(k,1275) - lu(k,1289) = lu(k,1289) - lu(k,1211) * lu(k,1275) - lu(k,1290) = lu(k,1290) - lu(k,1212) * lu(k,1275) - lu(k,1312) = lu(k,1312) - lu(k,1198) * lu(k,1311) - lu(k,1313) = lu(k,1313) - lu(k,1199) * lu(k,1311) - lu(k,1314) = lu(k,1314) - lu(k,1200) * lu(k,1311) - lu(k,1315) = lu(k,1315) - lu(k,1201) * lu(k,1311) - lu(k,1316) = lu(k,1316) - lu(k,1202) * lu(k,1311) - lu(k,1317) = lu(k,1317) - lu(k,1203) * lu(k,1311) - lu(k,1318) = lu(k,1318) - lu(k,1204) * lu(k,1311) - lu(k,1319) = lu(k,1319) - lu(k,1205) * lu(k,1311) - lu(k,1320) = lu(k,1320) - lu(k,1206) * lu(k,1311) - lu(k,1321) = lu(k,1321) - lu(k,1207) * lu(k,1311) - lu(k,1322) = lu(k,1322) - lu(k,1208) * lu(k,1311) - lu(k,1323) = lu(k,1323) - lu(k,1209) * lu(k,1311) - lu(k,1324) = lu(k,1324) - lu(k,1210) * lu(k,1311) - lu(k,1325) = lu(k,1325) - lu(k,1211) * lu(k,1311) - lu(k,1326) = lu(k,1326) - lu(k,1212) * lu(k,1311) - lu(k,1357) = lu(k,1357) - lu(k,1198) * lu(k,1356) - lu(k,1358) = lu(k,1358) - lu(k,1199) * lu(k,1356) - lu(k,1359) = lu(k,1359) - lu(k,1200) * lu(k,1356) - lu(k,1360) = lu(k,1360) - lu(k,1201) * lu(k,1356) - lu(k,1361) = lu(k,1361) - lu(k,1202) * lu(k,1356) - lu(k,1362) = lu(k,1362) - lu(k,1203) * lu(k,1356) - lu(k,1363) = lu(k,1363) - lu(k,1204) * lu(k,1356) - lu(k,1364) = lu(k,1364) - lu(k,1205) * lu(k,1356) - lu(k,1365) = lu(k,1365) - lu(k,1206) * lu(k,1356) - lu(k,1366) = lu(k,1366) - lu(k,1207) * lu(k,1356) - lu(k,1367) = lu(k,1367) - lu(k,1208) * lu(k,1356) - lu(k,1368) = lu(k,1368) - lu(k,1209) * lu(k,1356) - lu(k,1369) = lu(k,1369) - lu(k,1210) * lu(k,1356) - lu(k,1370) = lu(k,1370) - lu(k,1211) * lu(k,1356) - lu(k,1371) = lu(k,1371) - lu(k,1212) * lu(k,1356) - lu(k,1399) = lu(k,1399) - lu(k,1198) * lu(k,1398) - lu(k,1400) = lu(k,1400) - lu(k,1199) * lu(k,1398) - lu(k,1401) = lu(k,1401) - lu(k,1200) * lu(k,1398) - lu(k,1402) = lu(k,1402) - lu(k,1201) * lu(k,1398) - lu(k,1403) = lu(k,1403) - lu(k,1202) * lu(k,1398) - lu(k,1404) = lu(k,1404) - lu(k,1203) * lu(k,1398) - lu(k,1405) = lu(k,1405) - lu(k,1204) * lu(k,1398) - lu(k,1406) = lu(k,1406) - lu(k,1205) * lu(k,1398) - lu(k,1407) = lu(k,1407) - lu(k,1206) * lu(k,1398) - lu(k,1408) = lu(k,1408) - lu(k,1207) * lu(k,1398) - lu(k,1409) = lu(k,1409) - lu(k,1208) * lu(k,1398) - lu(k,1410) = lu(k,1410) - lu(k,1209) * lu(k,1398) - lu(k,1411) = lu(k,1411) - lu(k,1210) * lu(k,1398) - lu(k,1412) = lu(k,1412) - lu(k,1211) * lu(k,1398) - lu(k,1413) = lu(k,1413) - lu(k,1212) * lu(k,1398) - lu(k,1437) = lu(k,1437) - lu(k,1198) * lu(k,1436) - lu(k,1438) = lu(k,1438) - lu(k,1199) * lu(k,1436) - lu(k,1439) = lu(k,1439) - lu(k,1200) * lu(k,1436) - lu(k,1440) = lu(k,1440) - lu(k,1201) * lu(k,1436) - lu(k,1441) = lu(k,1441) - lu(k,1202) * lu(k,1436) - lu(k,1442) = lu(k,1442) - lu(k,1203) * lu(k,1436) - lu(k,1443) = lu(k,1443) - lu(k,1204) * lu(k,1436) - lu(k,1444) = lu(k,1444) - lu(k,1205) * lu(k,1436) - lu(k,1445) = lu(k,1445) - lu(k,1206) * lu(k,1436) - lu(k,1446) = lu(k,1446) - lu(k,1207) * lu(k,1436) - lu(k,1447) = lu(k,1447) - lu(k,1208) * lu(k,1436) - lu(k,1448) = lu(k,1448) - lu(k,1209) * lu(k,1436) - lu(k,1449) = lu(k,1449) - lu(k,1210) * lu(k,1436) - lu(k,1450) = lu(k,1450) - lu(k,1211) * lu(k,1436) - lu(k,1451) = lu(k,1451) - lu(k,1212) * lu(k,1436) - lu(k,1482) = lu(k,1482) - lu(k,1198) * lu(k,1481) - lu(k,1483) = lu(k,1483) - lu(k,1199) * lu(k,1481) - lu(k,1484) = lu(k,1484) - lu(k,1200) * lu(k,1481) - lu(k,1485) = lu(k,1485) - lu(k,1201) * lu(k,1481) - lu(k,1486) = lu(k,1486) - lu(k,1202) * lu(k,1481) - lu(k,1487) = lu(k,1487) - lu(k,1203) * lu(k,1481) - lu(k,1488) = lu(k,1488) - lu(k,1204) * lu(k,1481) - lu(k,1489) = lu(k,1489) - lu(k,1205) * lu(k,1481) - lu(k,1490) = lu(k,1490) - lu(k,1206) * lu(k,1481) - lu(k,1491) = lu(k,1491) - lu(k,1207) * lu(k,1481) - lu(k,1492) = lu(k,1492) - lu(k,1208) * lu(k,1481) - lu(k,1493) = lu(k,1493) - lu(k,1209) * lu(k,1481) - lu(k,1494) = lu(k,1494) - lu(k,1210) * lu(k,1481) - lu(k,1495) = lu(k,1495) - lu(k,1211) * lu(k,1481) - lu(k,1496) = lu(k,1496) - lu(k,1212) * lu(k,1481) - lu(k,1525) = lu(k,1525) - lu(k,1198) * lu(k,1524) - lu(k,1526) = lu(k,1526) - lu(k,1199) * lu(k,1524) - lu(k,1527) = lu(k,1527) - lu(k,1200) * lu(k,1524) - lu(k,1528) = lu(k,1528) - lu(k,1201) * lu(k,1524) - lu(k,1529) = lu(k,1529) - lu(k,1202) * lu(k,1524) - lu(k,1530) = lu(k,1530) - lu(k,1203) * lu(k,1524) - lu(k,1531) = lu(k,1531) - lu(k,1204) * lu(k,1524) - lu(k,1532) = lu(k,1532) - lu(k,1205) * lu(k,1524) - lu(k,1533) = lu(k,1533) - lu(k,1206) * lu(k,1524) - lu(k,1534) = lu(k,1534) - lu(k,1207) * lu(k,1524) - lu(k,1535) = lu(k,1535) - lu(k,1208) * lu(k,1524) - lu(k,1536) = lu(k,1536) - lu(k,1209) * lu(k,1524) - lu(k,1537) = lu(k,1537) - lu(k,1210) * lu(k,1524) - lu(k,1538) = lu(k,1538) - lu(k,1211) * lu(k,1524) - lu(k,1539) = lu(k,1539) - lu(k,1212) * lu(k,1524) - lu(k,1568) = lu(k,1568) - lu(k,1198) * lu(k,1567) - lu(k,1569) = lu(k,1569) - lu(k,1199) * lu(k,1567) - lu(k,1570) = lu(k,1570) - lu(k,1200) * lu(k,1567) - lu(k,1571) = lu(k,1571) - lu(k,1201) * lu(k,1567) - lu(k,1572) = lu(k,1572) - lu(k,1202) * lu(k,1567) - lu(k,1573) = lu(k,1573) - lu(k,1203) * lu(k,1567) - lu(k,1574) = lu(k,1574) - lu(k,1204) * lu(k,1567) - lu(k,1575) = lu(k,1575) - lu(k,1205) * lu(k,1567) - lu(k,1576) = lu(k,1576) - lu(k,1206) * lu(k,1567) - lu(k,1577) = lu(k,1577) - lu(k,1207) * lu(k,1567) - lu(k,1578) = lu(k,1578) - lu(k,1208) * lu(k,1567) - lu(k,1579) = lu(k,1579) - lu(k,1209) * lu(k,1567) - lu(k,1580) = lu(k,1580) - lu(k,1210) * lu(k,1567) - lu(k,1581) = lu(k,1581) - lu(k,1211) * lu(k,1567) - lu(k,1582) = lu(k,1582) - lu(k,1212) * lu(k,1567) - lu(k,1601) = lu(k,1601) - lu(k,1198) * lu(k,1600) - lu(k,1602) = lu(k,1602) - lu(k,1199) * lu(k,1600) - lu(k,1603) = lu(k,1603) - lu(k,1200) * lu(k,1600) - lu(k,1604) = lu(k,1604) - lu(k,1201) * lu(k,1600) - lu(k,1605) = lu(k,1605) - lu(k,1202) * lu(k,1600) - lu(k,1606) = lu(k,1606) - lu(k,1203) * lu(k,1600) - lu(k,1607) = lu(k,1607) - lu(k,1204) * lu(k,1600) - lu(k,1608) = lu(k,1608) - lu(k,1205) * lu(k,1600) - lu(k,1609) = lu(k,1609) - lu(k,1206) * lu(k,1600) - lu(k,1610) = lu(k,1610) - lu(k,1207) * lu(k,1600) - lu(k,1611) = lu(k,1611) - lu(k,1208) * lu(k,1600) - lu(k,1612) = lu(k,1612) - lu(k,1209) * lu(k,1600) - lu(k,1613) = lu(k,1613) - lu(k,1210) * lu(k,1600) - lu(k,1614) = lu(k,1614) - lu(k,1211) * lu(k,1600) - lu(k,1615) = lu(k,1615) - lu(k,1212) * lu(k,1600) - lu(k,1637) = lu(k,1637) - lu(k,1198) * lu(k,1636) - lu(k,1638) = lu(k,1638) - lu(k,1199) * lu(k,1636) - lu(k,1639) = lu(k,1639) - lu(k,1200) * lu(k,1636) - lu(k,1640) = lu(k,1640) - lu(k,1201) * lu(k,1636) - lu(k,1641) = lu(k,1641) - lu(k,1202) * lu(k,1636) - lu(k,1642) = lu(k,1642) - lu(k,1203) * lu(k,1636) - lu(k,1643) = lu(k,1643) - lu(k,1204) * lu(k,1636) - lu(k,1644) = lu(k,1644) - lu(k,1205) * lu(k,1636) - lu(k,1645) = lu(k,1645) - lu(k,1206) * lu(k,1636) - lu(k,1646) = lu(k,1646) - lu(k,1207) * lu(k,1636) - lu(k,1647) = lu(k,1647) - lu(k,1208) * lu(k,1636) - lu(k,1648) = lu(k,1648) - lu(k,1209) * lu(k,1636) - lu(k,1649) = lu(k,1649) - lu(k,1210) * lu(k,1636) - lu(k,1650) = lu(k,1650) - lu(k,1211) * lu(k,1636) - lu(k,1651) = lu(k,1651) - lu(k,1212) * lu(k,1636) - lu(k,1680) = lu(k,1680) - lu(k,1198) * lu(k,1679) - lu(k,1681) = lu(k,1681) - lu(k,1199) * lu(k,1679) - lu(k,1682) = lu(k,1682) - lu(k,1200) * lu(k,1679) - lu(k,1683) = lu(k,1683) - lu(k,1201) * lu(k,1679) - lu(k,1684) = lu(k,1684) - lu(k,1202) * lu(k,1679) - lu(k,1685) = lu(k,1685) - lu(k,1203) * lu(k,1679) - lu(k,1686) = lu(k,1686) - lu(k,1204) * lu(k,1679) - lu(k,1687) = lu(k,1687) - lu(k,1205) * lu(k,1679) - lu(k,1688) = lu(k,1688) - lu(k,1206) * lu(k,1679) - lu(k,1689) = lu(k,1689) - lu(k,1207) * lu(k,1679) - lu(k,1690) = lu(k,1690) - lu(k,1208) * lu(k,1679) - lu(k,1691) = lu(k,1691) - lu(k,1209) * lu(k,1679) - lu(k,1692) = lu(k,1692) - lu(k,1210) * lu(k,1679) - lu(k,1693) = lu(k,1693) - lu(k,1211) * lu(k,1679) - lu(k,1694) = lu(k,1694) - lu(k,1212) * lu(k,1679) - lu(k,1716) = lu(k,1716) - lu(k,1198) * lu(k,1715) - lu(k,1717) = lu(k,1717) - lu(k,1199) * lu(k,1715) - lu(k,1718) = lu(k,1718) - lu(k,1200) * lu(k,1715) - lu(k,1719) = lu(k,1719) - lu(k,1201) * lu(k,1715) - lu(k,1720) = lu(k,1720) - lu(k,1202) * lu(k,1715) - lu(k,1721) = lu(k,1721) - lu(k,1203) * lu(k,1715) - lu(k,1722) = lu(k,1722) - lu(k,1204) * lu(k,1715) - lu(k,1723) = lu(k,1723) - lu(k,1205) * lu(k,1715) - lu(k,1724) = lu(k,1724) - lu(k,1206) * lu(k,1715) - lu(k,1725) = lu(k,1725) - lu(k,1207) * lu(k,1715) - lu(k,1726) = lu(k,1726) - lu(k,1208) * lu(k,1715) - lu(k,1727) = lu(k,1727) - lu(k,1209) * lu(k,1715) - lu(k,1728) = lu(k,1728) - lu(k,1210) * lu(k,1715) - lu(k,1729) = lu(k,1729) - lu(k,1211) * lu(k,1715) - lu(k,1730) = lu(k,1730) - lu(k,1212) * lu(k,1715) - lu(k,1758) = lu(k,1758) - lu(k,1198) * lu(k,1757) - lu(k,1759) = lu(k,1759) - lu(k,1199) * lu(k,1757) - lu(k,1760) = lu(k,1760) - lu(k,1200) * lu(k,1757) - lu(k,1761) = lu(k,1761) - lu(k,1201) * lu(k,1757) - lu(k,1762) = lu(k,1762) - lu(k,1202) * lu(k,1757) - lu(k,1763) = lu(k,1763) - lu(k,1203) * lu(k,1757) - lu(k,1764) = lu(k,1764) - lu(k,1204) * lu(k,1757) - lu(k,1765) = lu(k,1765) - lu(k,1205) * lu(k,1757) - lu(k,1766) = lu(k,1766) - lu(k,1206) * lu(k,1757) - lu(k,1767) = lu(k,1767) - lu(k,1207) * lu(k,1757) - lu(k,1768) = lu(k,1768) - lu(k,1208) * lu(k,1757) - lu(k,1769) = lu(k,1769) - lu(k,1209) * lu(k,1757) - lu(k,1770) = lu(k,1770) - lu(k,1210) * lu(k,1757) - lu(k,1771) = lu(k,1771) - lu(k,1211) * lu(k,1757) - lu(k,1772) = lu(k,1772) - lu(k,1212) * lu(k,1757) - lu(k,1811) = lu(k,1811) - lu(k,1198) * lu(k,1810) - lu(k,1812) = lu(k,1812) - lu(k,1199) * lu(k,1810) - lu(k,1813) = lu(k,1813) - lu(k,1200) * lu(k,1810) - lu(k,1814) = lu(k,1814) - lu(k,1201) * lu(k,1810) - lu(k,1815) = lu(k,1815) - lu(k,1202) * lu(k,1810) - lu(k,1816) = lu(k,1816) - lu(k,1203) * lu(k,1810) - lu(k,1817) = lu(k,1817) - lu(k,1204) * lu(k,1810) - lu(k,1818) = lu(k,1818) - lu(k,1205) * lu(k,1810) - lu(k,1819) = lu(k,1819) - lu(k,1206) * lu(k,1810) - lu(k,1820) = lu(k,1820) - lu(k,1207) * lu(k,1810) - lu(k,1821) = lu(k,1821) - lu(k,1208) * lu(k,1810) - lu(k,1822) = lu(k,1822) - lu(k,1209) * lu(k,1810) - lu(k,1823) = lu(k,1823) - lu(k,1210) * lu(k,1810) - lu(k,1824) = lu(k,1824) - lu(k,1211) * lu(k,1810) - lu(k,1825) = lu(k,1825) - lu(k,1212) * lu(k,1810) - lu(k,1233) = 1._r8 / lu(k,1233) - lu(k,1234) = lu(k,1234) * lu(k,1233) - lu(k,1235) = lu(k,1235) * lu(k,1233) - lu(k,1236) = lu(k,1236) * lu(k,1233) - lu(k,1237) = lu(k,1237) * lu(k,1233) - lu(k,1238) = lu(k,1238) * lu(k,1233) - lu(k,1239) = lu(k,1239) * lu(k,1233) - lu(k,1240) = lu(k,1240) * lu(k,1233) - lu(k,1241) = lu(k,1241) * lu(k,1233) - lu(k,1242) = lu(k,1242) * lu(k,1233) - lu(k,1243) = lu(k,1243) * lu(k,1233) - lu(k,1244) = lu(k,1244) * lu(k,1233) - lu(k,1245) = lu(k,1245) * lu(k,1233) - lu(k,1246) = lu(k,1246) * lu(k,1233) - lu(k,1247) = lu(k,1247) * lu(k,1233) - lu(k,1277) = lu(k,1277) - lu(k,1234) * lu(k,1276) - lu(k,1278) = lu(k,1278) - lu(k,1235) * lu(k,1276) - lu(k,1279) = lu(k,1279) - lu(k,1236) * lu(k,1276) - lu(k,1280) = lu(k,1280) - lu(k,1237) * lu(k,1276) - lu(k,1281) = lu(k,1281) - lu(k,1238) * lu(k,1276) - lu(k,1282) = lu(k,1282) - lu(k,1239) * lu(k,1276) - lu(k,1283) = lu(k,1283) - lu(k,1240) * lu(k,1276) - lu(k,1284) = lu(k,1284) - lu(k,1241) * lu(k,1276) - lu(k,1285) = lu(k,1285) - lu(k,1242) * lu(k,1276) - lu(k,1286) = lu(k,1286) - lu(k,1243) * lu(k,1276) - lu(k,1287) = lu(k,1287) - lu(k,1244) * lu(k,1276) - lu(k,1288) = lu(k,1288) - lu(k,1245) * lu(k,1276) - lu(k,1289) = lu(k,1289) - lu(k,1246) * lu(k,1276) - lu(k,1290) = lu(k,1290) - lu(k,1247) * lu(k,1276) - lu(k,1313) = lu(k,1313) - lu(k,1234) * lu(k,1312) - lu(k,1314) = lu(k,1314) - lu(k,1235) * lu(k,1312) - lu(k,1315) = lu(k,1315) - lu(k,1236) * lu(k,1312) - lu(k,1316) = lu(k,1316) - lu(k,1237) * lu(k,1312) - lu(k,1317) = lu(k,1317) - lu(k,1238) * lu(k,1312) - lu(k,1318) = lu(k,1318) - lu(k,1239) * lu(k,1312) - lu(k,1319) = lu(k,1319) - lu(k,1240) * lu(k,1312) - lu(k,1320) = lu(k,1320) - lu(k,1241) * lu(k,1312) - lu(k,1321) = lu(k,1321) - lu(k,1242) * lu(k,1312) - lu(k,1322) = lu(k,1322) - lu(k,1243) * lu(k,1312) - lu(k,1323) = lu(k,1323) - lu(k,1244) * lu(k,1312) - lu(k,1324) = lu(k,1324) - lu(k,1245) * lu(k,1312) - lu(k,1325) = lu(k,1325) - lu(k,1246) * lu(k,1312) - lu(k,1326) = lu(k,1326) - lu(k,1247) * lu(k,1312) - lu(k,1358) = lu(k,1358) - lu(k,1234) * lu(k,1357) - lu(k,1359) = lu(k,1359) - lu(k,1235) * lu(k,1357) - lu(k,1360) = lu(k,1360) - lu(k,1236) * lu(k,1357) - lu(k,1361) = lu(k,1361) - lu(k,1237) * lu(k,1357) - lu(k,1362) = lu(k,1362) - lu(k,1238) * lu(k,1357) - lu(k,1363) = lu(k,1363) - lu(k,1239) * lu(k,1357) - lu(k,1364) = lu(k,1364) - lu(k,1240) * lu(k,1357) - lu(k,1365) = lu(k,1365) - lu(k,1241) * lu(k,1357) - lu(k,1366) = lu(k,1366) - lu(k,1242) * lu(k,1357) - lu(k,1367) = lu(k,1367) - lu(k,1243) * lu(k,1357) - lu(k,1368) = lu(k,1368) - lu(k,1244) * lu(k,1357) - lu(k,1369) = lu(k,1369) - lu(k,1245) * lu(k,1357) - lu(k,1370) = lu(k,1370) - lu(k,1246) * lu(k,1357) - lu(k,1371) = lu(k,1371) - lu(k,1247) * lu(k,1357) - lu(k,1400) = lu(k,1400) - lu(k,1234) * lu(k,1399) - lu(k,1401) = lu(k,1401) - lu(k,1235) * lu(k,1399) - lu(k,1402) = lu(k,1402) - lu(k,1236) * lu(k,1399) - lu(k,1403) = lu(k,1403) - lu(k,1237) * lu(k,1399) - lu(k,1404) = lu(k,1404) - lu(k,1238) * lu(k,1399) - lu(k,1405) = lu(k,1405) - lu(k,1239) * lu(k,1399) - lu(k,1406) = lu(k,1406) - lu(k,1240) * lu(k,1399) - lu(k,1407) = lu(k,1407) - lu(k,1241) * lu(k,1399) - lu(k,1408) = lu(k,1408) - lu(k,1242) * lu(k,1399) - lu(k,1409) = lu(k,1409) - lu(k,1243) * lu(k,1399) - lu(k,1410) = lu(k,1410) - lu(k,1244) * lu(k,1399) - lu(k,1411) = lu(k,1411) - lu(k,1245) * lu(k,1399) - lu(k,1412) = lu(k,1412) - lu(k,1246) * lu(k,1399) - lu(k,1413) = lu(k,1413) - lu(k,1247) * lu(k,1399) - lu(k,1438) = lu(k,1438) - lu(k,1234) * lu(k,1437) - lu(k,1439) = lu(k,1439) - lu(k,1235) * lu(k,1437) - lu(k,1440) = lu(k,1440) - lu(k,1236) * lu(k,1437) - lu(k,1441) = lu(k,1441) - lu(k,1237) * lu(k,1437) - lu(k,1442) = lu(k,1442) - lu(k,1238) * lu(k,1437) - lu(k,1443) = lu(k,1443) - lu(k,1239) * lu(k,1437) - lu(k,1444) = lu(k,1444) - lu(k,1240) * lu(k,1437) - lu(k,1445) = lu(k,1445) - lu(k,1241) * lu(k,1437) - lu(k,1446) = lu(k,1446) - lu(k,1242) * lu(k,1437) - lu(k,1447) = lu(k,1447) - lu(k,1243) * lu(k,1437) - lu(k,1448) = lu(k,1448) - lu(k,1244) * lu(k,1437) - lu(k,1449) = lu(k,1449) - lu(k,1245) * lu(k,1437) - lu(k,1450) = lu(k,1450) - lu(k,1246) * lu(k,1437) - lu(k,1451) = lu(k,1451) - lu(k,1247) * lu(k,1437) - lu(k,1483) = lu(k,1483) - lu(k,1234) * lu(k,1482) - lu(k,1484) = lu(k,1484) - lu(k,1235) * lu(k,1482) - lu(k,1485) = lu(k,1485) - lu(k,1236) * lu(k,1482) - lu(k,1486) = lu(k,1486) - lu(k,1237) * lu(k,1482) - lu(k,1487) = lu(k,1487) - lu(k,1238) * lu(k,1482) - lu(k,1488) = lu(k,1488) - lu(k,1239) * lu(k,1482) - lu(k,1489) = lu(k,1489) - lu(k,1240) * lu(k,1482) - lu(k,1490) = lu(k,1490) - lu(k,1241) * lu(k,1482) - lu(k,1491) = lu(k,1491) - lu(k,1242) * lu(k,1482) - lu(k,1492) = lu(k,1492) - lu(k,1243) * lu(k,1482) - lu(k,1493) = lu(k,1493) - lu(k,1244) * lu(k,1482) - lu(k,1494) = lu(k,1494) - lu(k,1245) * lu(k,1482) - lu(k,1495) = lu(k,1495) - lu(k,1246) * lu(k,1482) - lu(k,1496) = lu(k,1496) - lu(k,1247) * lu(k,1482) - lu(k,1526) = lu(k,1526) - lu(k,1234) * lu(k,1525) - lu(k,1527) = lu(k,1527) - lu(k,1235) * lu(k,1525) - lu(k,1528) = lu(k,1528) - lu(k,1236) * lu(k,1525) - lu(k,1529) = lu(k,1529) - lu(k,1237) * lu(k,1525) - lu(k,1530) = lu(k,1530) - lu(k,1238) * lu(k,1525) - lu(k,1531) = lu(k,1531) - lu(k,1239) * lu(k,1525) - lu(k,1532) = lu(k,1532) - lu(k,1240) * lu(k,1525) - lu(k,1533) = lu(k,1533) - lu(k,1241) * lu(k,1525) - lu(k,1534) = lu(k,1534) - lu(k,1242) * lu(k,1525) - lu(k,1535) = lu(k,1535) - lu(k,1243) * lu(k,1525) - lu(k,1536) = lu(k,1536) - lu(k,1244) * lu(k,1525) - lu(k,1537) = lu(k,1537) - lu(k,1245) * lu(k,1525) - lu(k,1538) = lu(k,1538) - lu(k,1246) * lu(k,1525) - lu(k,1539) = lu(k,1539) - lu(k,1247) * lu(k,1525) - lu(k,1569) = lu(k,1569) - lu(k,1234) * lu(k,1568) - lu(k,1570) = lu(k,1570) - lu(k,1235) * lu(k,1568) - lu(k,1571) = lu(k,1571) - lu(k,1236) * lu(k,1568) - lu(k,1572) = lu(k,1572) - lu(k,1237) * lu(k,1568) - lu(k,1573) = lu(k,1573) - lu(k,1238) * lu(k,1568) - lu(k,1574) = lu(k,1574) - lu(k,1239) * lu(k,1568) - lu(k,1575) = lu(k,1575) - lu(k,1240) * lu(k,1568) - lu(k,1576) = lu(k,1576) - lu(k,1241) * lu(k,1568) - lu(k,1577) = lu(k,1577) - lu(k,1242) * lu(k,1568) - lu(k,1578) = lu(k,1578) - lu(k,1243) * lu(k,1568) - lu(k,1579) = lu(k,1579) - lu(k,1244) * lu(k,1568) - lu(k,1580) = lu(k,1580) - lu(k,1245) * lu(k,1568) - lu(k,1581) = lu(k,1581) - lu(k,1246) * lu(k,1568) - lu(k,1582) = lu(k,1582) - lu(k,1247) * lu(k,1568) - lu(k,1602) = lu(k,1602) - lu(k,1234) * lu(k,1601) - lu(k,1603) = lu(k,1603) - lu(k,1235) * lu(k,1601) - lu(k,1604) = lu(k,1604) - lu(k,1236) * lu(k,1601) - lu(k,1605) = lu(k,1605) - lu(k,1237) * lu(k,1601) - lu(k,1606) = lu(k,1606) - lu(k,1238) * lu(k,1601) - lu(k,1607) = lu(k,1607) - lu(k,1239) * lu(k,1601) - lu(k,1608) = lu(k,1608) - lu(k,1240) * lu(k,1601) - lu(k,1609) = lu(k,1609) - lu(k,1241) * lu(k,1601) - lu(k,1610) = lu(k,1610) - lu(k,1242) * lu(k,1601) - lu(k,1611) = lu(k,1611) - lu(k,1243) * lu(k,1601) - lu(k,1612) = lu(k,1612) - lu(k,1244) * lu(k,1601) - lu(k,1613) = lu(k,1613) - lu(k,1245) * lu(k,1601) - lu(k,1614) = lu(k,1614) - lu(k,1246) * lu(k,1601) - lu(k,1615) = lu(k,1615) - lu(k,1247) * lu(k,1601) - lu(k,1638) = lu(k,1638) - lu(k,1234) * lu(k,1637) - lu(k,1639) = lu(k,1639) - lu(k,1235) * lu(k,1637) - lu(k,1640) = lu(k,1640) - lu(k,1236) * lu(k,1637) - lu(k,1641) = lu(k,1641) - lu(k,1237) * lu(k,1637) - lu(k,1642) = lu(k,1642) - lu(k,1238) * lu(k,1637) - lu(k,1643) = lu(k,1643) - lu(k,1239) * lu(k,1637) - lu(k,1644) = lu(k,1644) - lu(k,1240) * lu(k,1637) - lu(k,1645) = lu(k,1645) - lu(k,1241) * lu(k,1637) - lu(k,1646) = lu(k,1646) - lu(k,1242) * lu(k,1637) - lu(k,1647) = lu(k,1647) - lu(k,1243) * lu(k,1637) - lu(k,1648) = lu(k,1648) - lu(k,1244) * lu(k,1637) - lu(k,1649) = lu(k,1649) - lu(k,1245) * lu(k,1637) - lu(k,1650) = lu(k,1650) - lu(k,1246) * lu(k,1637) - lu(k,1651) = lu(k,1651) - lu(k,1247) * lu(k,1637) - lu(k,1681) = lu(k,1681) - lu(k,1234) * lu(k,1680) - lu(k,1682) = lu(k,1682) - lu(k,1235) * lu(k,1680) - lu(k,1683) = lu(k,1683) - lu(k,1236) * lu(k,1680) - lu(k,1684) = lu(k,1684) - lu(k,1237) * lu(k,1680) - lu(k,1685) = lu(k,1685) - lu(k,1238) * lu(k,1680) - lu(k,1686) = lu(k,1686) - lu(k,1239) * lu(k,1680) - lu(k,1687) = lu(k,1687) - lu(k,1240) * lu(k,1680) - lu(k,1688) = lu(k,1688) - lu(k,1241) * lu(k,1680) - lu(k,1689) = lu(k,1689) - lu(k,1242) * lu(k,1680) - lu(k,1690) = lu(k,1690) - lu(k,1243) * lu(k,1680) - lu(k,1691) = lu(k,1691) - lu(k,1244) * lu(k,1680) - lu(k,1692) = lu(k,1692) - lu(k,1245) * lu(k,1680) - lu(k,1693) = lu(k,1693) - lu(k,1246) * lu(k,1680) - lu(k,1694) = lu(k,1694) - lu(k,1247) * lu(k,1680) - lu(k,1717) = lu(k,1717) - lu(k,1234) * lu(k,1716) - lu(k,1718) = lu(k,1718) - lu(k,1235) * lu(k,1716) - lu(k,1719) = lu(k,1719) - lu(k,1236) * lu(k,1716) - lu(k,1720) = lu(k,1720) - lu(k,1237) * lu(k,1716) - lu(k,1721) = lu(k,1721) - lu(k,1238) * lu(k,1716) - lu(k,1722) = lu(k,1722) - lu(k,1239) * lu(k,1716) - lu(k,1723) = lu(k,1723) - lu(k,1240) * lu(k,1716) - lu(k,1724) = lu(k,1724) - lu(k,1241) * lu(k,1716) - lu(k,1725) = lu(k,1725) - lu(k,1242) * lu(k,1716) - lu(k,1726) = lu(k,1726) - lu(k,1243) * lu(k,1716) - lu(k,1727) = lu(k,1727) - lu(k,1244) * lu(k,1716) - lu(k,1728) = lu(k,1728) - lu(k,1245) * lu(k,1716) - lu(k,1729) = lu(k,1729) - lu(k,1246) * lu(k,1716) - lu(k,1730) = lu(k,1730) - lu(k,1247) * lu(k,1716) - lu(k,1759) = lu(k,1759) - lu(k,1234) * lu(k,1758) - lu(k,1760) = lu(k,1760) - lu(k,1235) * lu(k,1758) - lu(k,1761) = lu(k,1761) - lu(k,1236) * lu(k,1758) - lu(k,1762) = lu(k,1762) - lu(k,1237) * lu(k,1758) - lu(k,1763) = lu(k,1763) - lu(k,1238) * lu(k,1758) - lu(k,1764) = lu(k,1764) - lu(k,1239) * lu(k,1758) - lu(k,1765) = lu(k,1765) - lu(k,1240) * lu(k,1758) - lu(k,1766) = lu(k,1766) - lu(k,1241) * lu(k,1758) - lu(k,1767) = lu(k,1767) - lu(k,1242) * lu(k,1758) - lu(k,1768) = lu(k,1768) - lu(k,1243) * lu(k,1758) - lu(k,1769) = lu(k,1769) - lu(k,1244) * lu(k,1758) - lu(k,1770) = lu(k,1770) - lu(k,1245) * lu(k,1758) - lu(k,1771) = lu(k,1771) - lu(k,1246) * lu(k,1758) - lu(k,1772) = lu(k,1772) - lu(k,1247) * lu(k,1758) - lu(k,1812) = lu(k,1812) - lu(k,1234) * lu(k,1811) - lu(k,1813) = lu(k,1813) - lu(k,1235) * lu(k,1811) - lu(k,1814) = lu(k,1814) - lu(k,1236) * lu(k,1811) - lu(k,1815) = lu(k,1815) - lu(k,1237) * lu(k,1811) - lu(k,1816) = lu(k,1816) - lu(k,1238) * lu(k,1811) - lu(k,1817) = lu(k,1817) - lu(k,1239) * lu(k,1811) - lu(k,1818) = lu(k,1818) - lu(k,1240) * lu(k,1811) - lu(k,1819) = lu(k,1819) - lu(k,1241) * lu(k,1811) - lu(k,1820) = lu(k,1820) - lu(k,1242) * lu(k,1811) - lu(k,1821) = lu(k,1821) - lu(k,1243) * lu(k,1811) - lu(k,1822) = lu(k,1822) - lu(k,1244) * lu(k,1811) - lu(k,1823) = lu(k,1823) - lu(k,1245) * lu(k,1811) - lu(k,1824) = lu(k,1824) - lu(k,1246) * lu(k,1811) - lu(k,1825) = lu(k,1825) - lu(k,1247) * lu(k,1811) - lu(k,1277) = 1._r8 / lu(k,1277) - lu(k,1278) = lu(k,1278) * lu(k,1277) - lu(k,1279) = lu(k,1279) * lu(k,1277) - lu(k,1280) = lu(k,1280) * lu(k,1277) - lu(k,1281) = lu(k,1281) * lu(k,1277) - lu(k,1282) = lu(k,1282) * lu(k,1277) - lu(k,1283) = lu(k,1283) * lu(k,1277) - lu(k,1284) = lu(k,1284) * lu(k,1277) - lu(k,1285) = lu(k,1285) * lu(k,1277) - lu(k,1286) = lu(k,1286) * lu(k,1277) - lu(k,1287) = lu(k,1287) * lu(k,1277) - lu(k,1288) = lu(k,1288) * lu(k,1277) - lu(k,1289) = lu(k,1289) * lu(k,1277) - lu(k,1290) = lu(k,1290) * lu(k,1277) - lu(k,1314) = lu(k,1314) - lu(k,1278) * lu(k,1313) - lu(k,1315) = lu(k,1315) - lu(k,1279) * lu(k,1313) - lu(k,1316) = lu(k,1316) - lu(k,1280) * lu(k,1313) - lu(k,1317) = lu(k,1317) - lu(k,1281) * lu(k,1313) - lu(k,1318) = lu(k,1318) - lu(k,1282) * lu(k,1313) - lu(k,1319) = lu(k,1319) - lu(k,1283) * lu(k,1313) - lu(k,1320) = lu(k,1320) - lu(k,1284) * lu(k,1313) - lu(k,1321) = lu(k,1321) - lu(k,1285) * lu(k,1313) - lu(k,1322) = lu(k,1322) - lu(k,1286) * lu(k,1313) - lu(k,1323) = lu(k,1323) - lu(k,1287) * lu(k,1313) - lu(k,1324) = lu(k,1324) - lu(k,1288) * lu(k,1313) - lu(k,1325) = lu(k,1325) - lu(k,1289) * lu(k,1313) - lu(k,1326) = lu(k,1326) - lu(k,1290) * lu(k,1313) - lu(k,1359) = lu(k,1359) - lu(k,1278) * lu(k,1358) - lu(k,1360) = lu(k,1360) - lu(k,1279) * lu(k,1358) - lu(k,1361) = lu(k,1361) - lu(k,1280) * lu(k,1358) - lu(k,1362) = lu(k,1362) - lu(k,1281) * lu(k,1358) - lu(k,1363) = lu(k,1363) - lu(k,1282) * lu(k,1358) - lu(k,1364) = lu(k,1364) - lu(k,1283) * lu(k,1358) - lu(k,1365) = lu(k,1365) - lu(k,1284) * lu(k,1358) - lu(k,1366) = lu(k,1366) - lu(k,1285) * lu(k,1358) - lu(k,1367) = lu(k,1367) - lu(k,1286) * lu(k,1358) - lu(k,1368) = lu(k,1368) - lu(k,1287) * lu(k,1358) - lu(k,1369) = lu(k,1369) - lu(k,1288) * lu(k,1358) - lu(k,1370) = lu(k,1370) - lu(k,1289) * lu(k,1358) - lu(k,1371) = lu(k,1371) - lu(k,1290) * lu(k,1358) - lu(k,1401) = lu(k,1401) - lu(k,1278) * lu(k,1400) - lu(k,1402) = lu(k,1402) - lu(k,1279) * lu(k,1400) - lu(k,1403) = lu(k,1403) - lu(k,1280) * lu(k,1400) - lu(k,1404) = lu(k,1404) - lu(k,1281) * lu(k,1400) - lu(k,1405) = lu(k,1405) - lu(k,1282) * lu(k,1400) - lu(k,1406) = lu(k,1406) - lu(k,1283) * lu(k,1400) - lu(k,1407) = lu(k,1407) - lu(k,1284) * lu(k,1400) - lu(k,1408) = lu(k,1408) - lu(k,1285) * lu(k,1400) - lu(k,1409) = lu(k,1409) - lu(k,1286) * lu(k,1400) - lu(k,1410) = lu(k,1410) - lu(k,1287) * lu(k,1400) - lu(k,1411) = lu(k,1411) - lu(k,1288) * lu(k,1400) - lu(k,1412) = lu(k,1412) - lu(k,1289) * lu(k,1400) - lu(k,1413) = lu(k,1413) - lu(k,1290) * lu(k,1400) - lu(k,1439) = lu(k,1439) - lu(k,1278) * lu(k,1438) - lu(k,1440) = lu(k,1440) - lu(k,1279) * lu(k,1438) - lu(k,1441) = lu(k,1441) - lu(k,1280) * lu(k,1438) - lu(k,1442) = lu(k,1442) - lu(k,1281) * lu(k,1438) - lu(k,1443) = lu(k,1443) - lu(k,1282) * lu(k,1438) - lu(k,1444) = lu(k,1444) - lu(k,1283) * lu(k,1438) - lu(k,1445) = lu(k,1445) - lu(k,1284) * lu(k,1438) - lu(k,1446) = lu(k,1446) - lu(k,1285) * lu(k,1438) - lu(k,1447) = lu(k,1447) - lu(k,1286) * lu(k,1438) - lu(k,1448) = lu(k,1448) - lu(k,1287) * lu(k,1438) - lu(k,1449) = lu(k,1449) - lu(k,1288) * lu(k,1438) - lu(k,1450) = lu(k,1450) - lu(k,1289) * lu(k,1438) - lu(k,1451) = lu(k,1451) - lu(k,1290) * lu(k,1438) - lu(k,1484) = lu(k,1484) - lu(k,1278) * lu(k,1483) - lu(k,1485) = lu(k,1485) - lu(k,1279) * lu(k,1483) - lu(k,1486) = lu(k,1486) - lu(k,1280) * lu(k,1483) - lu(k,1487) = lu(k,1487) - lu(k,1281) * lu(k,1483) - lu(k,1488) = lu(k,1488) - lu(k,1282) * lu(k,1483) - lu(k,1489) = lu(k,1489) - lu(k,1283) * lu(k,1483) - lu(k,1490) = lu(k,1490) - lu(k,1284) * lu(k,1483) - lu(k,1491) = lu(k,1491) - lu(k,1285) * lu(k,1483) - lu(k,1492) = lu(k,1492) - lu(k,1286) * lu(k,1483) - lu(k,1493) = lu(k,1493) - lu(k,1287) * lu(k,1483) - lu(k,1494) = lu(k,1494) - lu(k,1288) * lu(k,1483) - lu(k,1495) = lu(k,1495) - lu(k,1289) * lu(k,1483) - lu(k,1496) = lu(k,1496) - lu(k,1290) * lu(k,1483) - lu(k,1527) = lu(k,1527) - lu(k,1278) * lu(k,1526) - lu(k,1528) = lu(k,1528) - lu(k,1279) * lu(k,1526) - lu(k,1529) = lu(k,1529) - lu(k,1280) * lu(k,1526) - lu(k,1530) = lu(k,1530) - lu(k,1281) * lu(k,1526) - lu(k,1531) = lu(k,1531) - lu(k,1282) * lu(k,1526) - lu(k,1532) = lu(k,1532) - lu(k,1283) * lu(k,1526) - lu(k,1533) = lu(k,1533) - lu(k,1284) * lu(k,1526) - lu(k,1534) = lu(k,1534) - lu(k,1285) * lu(k,1526) - lu(k,1535) = lu(k,1535) - lu(k,1286) * lu(k,1526) - lu(k,1536) = lu(k,1536) - lu(k,1287) * lu(k,1526) - lu(k,1537) = lu(k,1537) - lu(k,1288) * lu(k,1526) - lu(k,1538) = lu(k,1538) - lu(k,1289) * lu(k,1526) - lu(k,1539) = lu(k,1539) - lu(k,1290) * lu(k,1526) - lu(k,1570) = lu(k,1570) - lu(k,1278) * lu(k,1569) - lu(k,1571) = lu(k,1571) - lu(k,1279) * lu(k,1569) - lu(k,1572) = lu(k,1572) - lu(k,1280) * lu(k,1569) - lu(k,1573) = lu(k,1573) - lu(k,1281) * lu(k,1569) - lu(k,1574) = lu(k,1574) - lu(k,1282) * lu(k,1569) - lu(k,1575) = lu(k,1575) - lu(k,1283) * lu(k,1569) - lu(k,1576) = lu(k,1576) - lu(k,1284) * lu(k,1569) - lu(k,1577) = lu(k,1577) - lu(k,1285) * lu(k,1569) - lu(k,1578) = lu(k,1578) - lu(k,1286) * lu(k,1569) - lu(k,1579) = lu(k,1579) - lu(k,1287) * lu(k,1569) - lu(k,1580) = lu(k,1580) - lu(k,1288) * lu(k,1569) - lu(k,1581) = lu(k,1581) - lu(k,1289) * lu(k,1569) - lu(k,1582) = lu(k,1582) - lu(k,1290) * lu(k,1569) - lu(k,1603) = lu(k,1603) - lu(k,1278) * lu(k,1602) - lu(k,1604) = lu(k,1604) - lu(k,1279) * lu(k,1602) - lu(k,1605) = lu(k,1605) - lu(k,1280) * lu(k,1602) - lu(k,1606) = lu(k,1606) - lu(k,1281) * lu(k,1602) - lu(k,1607) = lu(k,1607) - lu(k,1282) * lu(k,1602) - lu(k,1608) = lu(k,1608) - lu(k,1283) * lu(k,1602) - lu(k,1609) = lu(k,1609) - lu(k,1284) * lu(k,1602) - lu(k,1610) = lu(k,1610) - lu(k,1285) * lu(k,1602) - lu(k,1611) = lu(k,1611) - lu(k,1286) * lu(k,1602) - lu(k,1612) = lu(k,1612) - lu(k,1287) * lu(k,1602) - lu(k,1613) = lu(k,1613) - lu(k,1288) * lu(k,1602) - lu(k,1614) = lu(k,1614) - lu(k,1289) * lu(k,1602) - lu(k,1615) = lu(k,1615) - lu(k,1290) * lu(k,1602) - lu(k,1639) = lu(k,1639) - lu(k,1278) * lu(k,1638) - lu(k,1640) = lu(k,1640) - lu(k,1279) * lu(k,1638) - lu(k,1641) = lu(k,1641) - lu(k,1280) * lu(k,1638) - lu(k,1642) = lu(k,1642) - lu(k,1281) * lu(k,1638) - lu(k,1643) = lu(k,1643) - lu(k,1282) * lu(k,1638) - lu(k,1644) = lu(k,1644) - lu(k,1283) * lu(k,1638) - lu(k,1645) = lu(k,1645) - lu(k,1284) * lu(k,1638) - lu(k,1646) = lu(k,1646) - lu(k,1285) * lu(k,1638) - lu(k,1647) = lu(k,1647) - lu(k,1286) * lu(k,1638) - lu(k,1648) = lu(k,1648) - lu(k,1287) * lu(k,1638) - lu(k,1649) = lu(k,1649) - lu(k,1288) * lu(k,1638) - lu(k,1650) = lu(k,1650) - lu(k,1289) * lu(k,1638) - lu(k,1651) = lu(k,1651) - lu(k,1290) * lu(k,1638) - lu(k,1682) = lu(k,1682) - lu(k,1278) * lu(k,1681) - lu(k,1683) = lu(k,1683) - lu(k,1279) * lu(k,1681) - lu(k,1684) = lu(k,1684) - lu(k,1280) * lu(k,1681) - lu(k,1685) = lu(k,1685) - lu(k,1281) * lu(k,1681) - lu(k,1686) = lu(k,1686) - lu(k,1282) * lu(k,1681) - lu(k,1687) = lu(k,1687) - lu(k,1283) * lu(k,1681) - lu(k,1688) = lu(k,1688) - lu(k,1284) * lu(k,1681) - lu(k,1689) = lu(k,1689) - lu(k,1285) * lu(k,1681) - lu(k,1690) = lu(k,1690) - lu(k,1286) * lu(k,1681) - lu(k,1691) = lu(k,1691) - lu(k,1287) * lu(k,1681) - lu(k,1692) = lu(k,1692) - lu(k,1288) * lu(k,1681) - lu(k,1693) = lu(k,1693) - lu(k,1289) * lu(k,1681) - lu(k,1694) = lu(k,1694) - lu(k,1290) * lu(k,1681) - lu(k,1718) = lu(k,1718) - lu(k,1278) * lu(k,1717) - lu(k,1719) = lu(k,1719) - lu(k,1279) * lu(k,1717) - lu(k,1720) = lu(k,1720) - lu(k,1280) * lu(k,1717) - lu(k,1721) = lu(k,1721) - lu(k,1281) * lu(k,1717) - lu(k,1722) = lu(k,1722) - lu(k,1282) * lu(k,1717) - lu(k,1723) = lu(k,1723) - lu(k,1283) * lu(k,1717) - lu(k,1724) = lu(k,1724) - lu(k,1284) * lu(k,1717) - lu(k,1725) = lu(k,1725) - lu(k,1285) * lu(k,1717) - lu(k,1726) = lu(k,1726) - lu(k,1286) * lu(k,1717) - lu(k,1727) = lu(k,1727) - lu(k,1287) * lu(k,1717) - lu(k,1728) = lu(k,1728) - lu(k,1288) * lu(k,1717) - lu(k,1729) = lu(k,1729) - lu(k,1289) * lu(k,1717) - lu(k,1730) = lu(k,1730) - lu(k,1290) * lu(k,1717) - lu(k,1760) = lu(k,1760) - lu(k,1278) * lu(k,1759) - lu(k,1761) = lu(k,1761) - lu(k,1279) * lu(k,1759) - lu(k,1762) = lu(k,1762) - lu(k,1280) * lu(k,1759) - lu(k,1763) = lu(k,1763) - lu(k,1281) * lu(k,1759) - lu(k,1764) = lu(k,1764) - lu(k,1282) * lu(k,1759) - lu(k,1765) = lu(k,1765) - lu(k,1283) * lu(k,1759) - lu(k,1766) = lu(k,1766) - lu(k,1284) * lu(k,1759) - lu(k,1767) = lu(k,1767) - lu(k,1285) * lu(k,1759) - lu(k,1768) = lu(k,1768) - lu(k,1286) * lu(k,1759) - lu(k,1769) = lu(k,1769) - lu(k,1287) * lu(k,1759) - lu(k,1770) = lu(k,1770) - lu(k,1288) * lu(k,1759) - lu(k,1771) = lu(k,1771) - lu(k,1289) * lu(k,1759) - lu(k,1772) = lu(k,1772) - lu(k,1290) * lu(k,1759) - lu(k,1813) = lu(k,1813) - lu(k,1278) * lu(k,1812) - lu(k,1814) = lu(k,1814) - lu(k,1279) * lu(k,1812) - lu(k,1815) = lu(k,1815) - lu(k,1280) * lu(k,1812) - lu(k,1816) = lu(k,1816) - lu(k,1281) * lu(k,1812) - lu(k,1817) = lu(k,1817) - lu(k,1282) * lu(k,1812) - lu(k,1818) = lu(k,1818) - lu(k,1283) * lu(k,1812) - lu(k,1819) = lu(k,1819) - lu(k,1284) * lu(k,1812) - lu(k,1820) = lu(k,1820) - lu(k,1285) * lu(k,1812) - lu(k,1821) = lu(k,1821) - lu(k,1286) * lu(k,1812) - lu(k,1822) = lu(k,1822) - lu(k,1287) * lu(k,1812) - lu(k,1823) = lu(k,1823) - lu(k,1288) * lu(k,1812) - lu(k,1824) = lu(k,1824) - lu(k,1289) * lu(k,1812) - lu(k,1825) = lu(k,1825) - lu(k,1290) * lu(k,1812) - end do + real(r8), intent(inout) :: lu(:) + lu(1158) = 1._r8 / lu(1158) + lu(1159) = lu(1159) * lu(1158) + lu(1160) = lu(1160) * lu(1158) + lu(1161) = lu(1161) * lu(1158) + lu(1162) = lu(1162) * lu(1158) + lu(1163) = lu(1163) * lu(1158) + lu(1164) = lu(1164) * lu(1158) + lu(1165) = lu(1165) * lu(1158) + lu(1166) = lu(1166) * lu(1158) + lu(1167) = lu(1167) * lu(1158) + lu(1168) = lu(1168) * lu(1158) + lu(1169) = lu(1169) * lu(1158) + lu(1170) = lu(1170) * lu(1158) + lu(1171) = lu(1171) * lu(1158) + lu(1172) = lu(1172) * lu(1158) + lu(1201) = lu(1201) - lu(1159) * lu(1200) + lu(1202) = lu(1202) - lu(1160) * lu(1200) + lu(1203) = lu(1203) - lu(1161) * lu(1200) + lu(1204) = lu(1204) - lu(1162) * lu(1200) + lu(1205) = lu(1205) - lu(1163) * lu(1200) + lu(1206) = lu(1206) - lu(1164) * lu(1200) + lu(1207) = lu(1207) - lu(1165) * lu(1200) + lu(1208) = lu(1208) - lu(1166) * lu(1200) + lu(1209) = lu(1209) - lu(1167) * lu(1200) + lu(1210) = lu(1210) - lu(1168) * lu(1200) + lu(1211) = lu(1211) - lu(1169) * lu(1200) + lu(1212) = lu(1212) - lu(1170) * lu(1200) + lu(1213) = lu(1213) - lu(1171) * lu(1200) + lu(1214) = lu(1214) - lu(1172) * lu(1200) + lu(1236) = lu(1236) - lu(1159) * lu(1235) + lu(1237) = lu(1237) - lu(1160) * lu(1235) + lu(1238) = lu(1238) - lu(1161) * lu(1235) + lu(1239) = lu(1239) - lu(1162) * lu(1235) + lu(1240) = lu(1240) - lu(1163) * lu(1235) + lu(1241) = lu(1241) - lu(1164) * lu(1235) + lu(1242) = lu(1242) - lu(1165) * lu(1235) + lu(1243) = lu(1243) - lu(1166) * lu(1235) + lu(1244) = lu(1244) - lu(1167) * lu(1235) + lu(1245) = lu(1245) - lu(1168) * lu(1235) + lu(1246) = lu(1246) - lu(1169) * lu(1235) + lu(1247) = lu(1247) - lu(1170) * lu(1235) + lu(1248) = lu(1248) - lu(1171) * lu(1235) + lu(1249) = lu(1249) - lu(1172) * lu(1235) + lu(1280) = lu(1280) - lu(1159) * lu(1279) + lu(1281) = lu(1281) - lu(1160) * lu(1279) + lu(1282) = lu(1282) - lu(1161) * lu(1279) + lu(1283) = lu(1283) - lu(1162) * lu(1279) + lu(1284) = lu(1284) - lu(1163) * lu(1279) + lu(1285) = lu(1285) - lu(1164) * lu(1279) + lu(1286) = lu(1286) - lu(1165) * lu(1279) + lu(1287) = lu(1287) - lu(1166) * lu(1279) + lu(1288) = lu(1288) - lu(1167) * lu(1279) + lu(1289) = lu(1289) - lu(1168) * lu(1279) + lu(1290) = lu(1290) - lu(1169) * lu(1279) + lu(1291) = lu(1291) - lu(1170) * lu(1279) + lu(1292) = lu(1292) - lu(1171) * lu(1279) + lu(1293) = lu(1293) - lu(1172) * lu(1279) + lu(1321) = lu(1321) - lu(1159) * lu(1320) + lu(1322) = lu(1322) - lu(1160) * lu(1320) + lu(1323) = lu(1323) - lu(1161) * lu(1320) + lu(1324) = lu(1324) - lu(1162) * lu(1320) + lu(1325) = lu(1325) - lu(1163) * lu(1320) + lu(1326) = lu(1326) - lu(1164) * lu(1320) + lu(1327) = lu(1327) - lu(1165) * lu(1320) + lu(1328) = lu(1328) - lu(1166) * lu(1320) + lu(1329) = lu(1329) - lu(1167) * lu(1320) + lu(1330) = lu(1330) - lu(1168) * lu(1320) + lu(1331) = lu(1331) - lu(1169) * lu(1320) + lu(1332) = lu(1332) - lu(1170) * lu(1320) + lu(1333) = lu(1333) - lu(1171) * lu(1320) + lu(1334) = lu(1334) - lu(1172) * lu(1320) + lu(1363) = lu(1363) - lu(1159) * lu(1362) + lu(1364) = lu(1364) - lu(1160) * lu(1362) + lu(1365) = lu(1365) - lu(1161) * lu(1362) + lu(1366) = lu(1366) - lu(1162) * lu(1362) + lu(1367) = lu(1367) - lu(1163) * lu(1362) + lu(1368) = lu(1368) - lu(1164) * lu(1362) + lu(1369) = lu(1369) - lu(1165) * lu(1362) + lu(1370) = lu(1370) - lu(1166) * lu(1362) + lu(1371) = lu(1371) - lu(1167) * lu(1362) + lu(1372) = lu(1372) - lu(1168) * lu(1362) + lu(1373) = lu(1373) - lu(1169) * lu(1362) + lu(1374) = lu(1374) - lu(1170) * lu(1362) + lu(1375) = lu(1375) - lu(1171) * lu(1362) + lu(1376) = lu(1376) - lu(1172) * lu(1362) + lu(1405) = lu(1405) - lu(1159) * lu(1404) + lu(1406) = lu(1406) - lu(1160) * lu(1404) + lu(1407) = lu(1407) - lu(1161) * lu(1404) + lu(1408) = lu(1408) - lu(1162) * lu(1404) + lu(1409) = lu(1409) - lu(1163) * lu(1404) + lu(1410) = lu(1410) - lu(1164) * lu(1404) + lu(1411) = lu(1411) - lu(1165) * lu(1404) + lu(1412) = lu(1412) - lu(1166) * lu(1404) + lu(1413) = lu(1413) - lu(1167) * lu(1404) + lu(1414) = lu(1414) - lu(1168) * lu(1404) + lu(1415) = lu(1415) - lu(1169) * lu(1404) + lu(1416) = lu(1416) - lu(1170) * lu(1404) + lu(1417) = lu(1417) - lu(1171) * lu(1404) + lu(1418) = lu(1418) - lu(1172) * lu(1404) + lu(1447) = lu(1447) - lu(1159) * lu(1446) + lu(1448) = lu(1448) - lu(1160) * lu(1446) + lu(1449) = lu(1449) - lu(1161) * lu(1446) + lu(1450) = lu(1450) - lu(1162) * lu(1446) + lu(1451) = lu(1451) - lu(1163) * lu(1446) + lu(1452) = lu(1452) - lu(1164) * lu(1446) + lu(1453) = lu(1453) - lu(1165) * lu(1446) + lu(1454) = lu(1454) - lu(1166) * lu(1446) + lu(1455) = lu(1455) - lu(1167) * lu(1446) + lu(1456) = lu(1456) - lu(1168) * lu(1446) + lu(1457) = lu(1457) - lu(1169) * lu(1446) + lu(1458) = lu(1458) - lu(1170) * lu(1446) + lu(1459) = lu(1459) - lu(1171) * lu(1446) + lu(1460) = lu(1460) - lu(1172) * lu(1446) + lu(1502) = lu(1502) - lu(1159) * lu(1501) + lu(1503) = lu(1503) - lu(1160) * lu(1501) + lu(1504) = lu(1504) - lu(1161) * lu(1501) + lu(1505) = lu(1505) - lu(1162) * lu(1501) + lu(1506) = lu(1506) - lu(1163) * lu(1501) + lu(1507) = lu(1507) - lu(1164) * lu(1501) + lu(1508) = lu(1508) - lu(1165) * lu(1501) + lu(1509) = lu(1509) - lu(1166) * lu(1501) + lu(1510) = lu(1510) - lu(1167) * lu(1501) + lu(1511) = lu(1511) - lu(1168) * lu(1501) + lu(1512) = lu(1512) - lu(1169) * lu(1501) + lu(1513) = lu(1513) - lu(1170) * lu(1501) + lu(1514) = lu(1514) - lu(1171) * lu(1501) + lu(1515) = lu(1515) - lu(1172) * lu(1501) + lu(1534) = lu(1534) - lu(1159) * lu(1533) + lu(1535) = lu(1535) - lu(1160) * lu(1533) + lu(1536) = lu(1536) - lu(1161) * lu(1533) + lu(1537) = lu(1537) - lu(1162) * lu(1533) + lu(1538) = lu(1538) - lu(1163) * lu(1533) + lu(1539) = lu(1539) - lu(1164) * lu(1533) + lu(1540) = lu(1540) - lu(1165) * lu(1533) + lu(1541) = lu(1541) - lu(1166) * lu(1533) + lu(1542) = lu(1542) - lu(1167) * lu(1533) + lu(1543) = lu(1543) - lu(1168) * lu(1533) + lu(1544) = lu(1544) - lu(1169) * lu(1533) + lu(1545) = lu(1545) - lu(1170) * lu(1533) + lu(1546) = lu(1546) - lu(1171) * lu(1533) + lu(1547) = lu(1547) - lu(1172) * lu(1533) + lu(1569) = lu(1569) - lu(1159) * lu(1568) + lu(1570) = lu(1570) - lu(1160) * lu(1568) + lu(1571) = lu(1571) - lu(1161) * lu(1568) + lu(1572) = lu(1572) - lu(1162) * lu(1568) + lu(1573) = lu(1573) - lu(1163) * lu(1568) + lu(1574) = lu(1574) - lu(1164) * lu(1568) + lu(1575) = lu(1575) - lu(1165) * lu(1568) + lu(1576) = lu(1576) - lu(1166) * lu(1568) + lu(1577) = lu(1577) - lu(1167) * lu(1568) + lu(1578) = lu(1578) - lu(1168) * lu(1568) + lu(1579) = lu(1579) - lu(1169) * lu(1568) + lu(1580) = lu(1580) - lu(1170) * lu(1568) + lu(1581) = lu(1581) - lu(1171) * lu(1568) + lu(1582) = lu(1582) - lu(1172) * lu(1568) + lu(1607) = lu(1607) - lu(1159) * lu(1606) + lu(1608) = lu(1608) - lu(1160) * lu(1606) + lu(1609) = lu(1609) - lu(1161) * lu(1606) + lu(1610) = lu(1610) - lu(1162) * lu(1606) + lu(1611) = lu(1611) - lu(1163) * lu(1606) + lu(1612) = lu(1612) - lu(1164) * lu(1606) + lu(1613) = lu(1613) - lu(1165) * lu(1606) + lu(1614) = lu(1614) - lu(1166) * lu(1606) + lu(1615) = lu(1615) - lu(1167) * lu(1606) + lu(1616) = lu(1616) - lu(1168) * lu(1606) + lu(1617) = lu(1617) - lu(1169) * lu(1606) + lu(1618) = lu(1618) - lu(1170) * lu(1606) + lu(1619) = lu(1619) - lu(1171) * lu(1606) + lu(1620) = lu(1620) - lu(1172) * lu(1606) + lu(1646) = lu(1646) - lu(1159) * lu(1645) + lu(1647) = lu(1647) - lu(1160) * lu(1645) + lu(1648) = lu(1648) - lu(1161) * lu(1645) + lu(1649) = lu(1649) - lu(1162) * lu(1645) + lu(1650) = lu(1650) - lu(1163) * lu(1645) + lu(1651) = lu(1651) - lu(1164) * lu(1645) + lu(1652) = lu(1652) - lu(1165) * lu(1645) + lu(1653) = lu(1653) - lu(1166) * lu(1645) + lu(1654) = lu(1654) - lu(1167) * lu(1645) + lu(1655) = lu(1655) - lu(1168) * lu(1645) + lu(1656) = lu(1656) - lu(1169) * lu(1645) + lu(1657) = lu(1657) - lu(1170) * lu(1645) + lu(1658) = lu(1658) - lu(1171) * lu(1645) + lu(1659) = lu(1659) - lu(1172) * lu(1645) + lu(1680) = lu(1680) - lu(1159) * lu(1679) + lu(1681) = lu(1681) - lu(1160) * lu(1679) + lu(1682) = lu(1682) - lu(1161) * lu(1679) + lu(1683) = lu(1683) - lu(1162) * lu(1679) + lu(1684) = lu(1684) - lu(1163) * lu(1679) + lu(1685) = lu(1685) - lu(1164) * lu(1679) + lu(1686) = lu(1686) - lu(1165) * lu(1679) + lu(1687) = lu(1687) - lu(1166) * lu(1679) + lu(1688) = lu(1688) - lu(1167) * lu(1679) + lu(1689) = lu(1689) - lu(1168) * lu(1679) + lu(1690) = lu(1690) - lu(1169) * lu(1679) + lu(1691) = lu(1691) - lu(1170) * lu(1679) + lu(1692) = lu(1692) - lu(1171) * lu(1679) + lu(1693) = lu(1693) - lu(1172) * lu(1679) + lu(1732) = lu(1732) - lu(1159) * lu(1731) + lu(1733) = lu(1733) - lu(1160) * lu(1731) + lu(1734) = lu(1734) - lu(1161) * lu(1731) + lu(1735) = lu(1735) - lu(1162) * lu(1731) + lu(1736) = lu(1736) - lu(1163) * lu(1731) + lu(1737) = lu(1737) - lu(1164) * lu(1731) + lu(1738) = lu(1738) - lu(1165) * lu(1731) + lu(1739) = lu(1739) - lu(1166) * lu(1731) + lu(1740) = lu(1740) - lu(1167) * lu(1731) + lu(1741) = lu(1741) - lu(1168) * lu(1731) + lu(1742) = lu(1742) - lu(1169) * lu(1731) + lu(1743) = lu(1743) - lu(1170) * lu(1731) + lu(1744) = lu(1744) - lu(1171) * lu(1731) + lu(1745) = lu(1745) - lu(1172) * lu(1731) + lu(1201) = 1._r8 / lu(1201) + lu(1202) = lu(1202) * lu(1201) + lu(1203) = lu(1203) * lu(1201) + lu(1204) = lu(1204) * lu(1201) + lu(1205) = lu(1205) * lu(1201) + lu(1206) = lu(1206) * lu(1201) + lu(1207) = lu(1207) * lu(1201) + lu(1208) = lu(1208) * lu(1201) + lu(1209) = lu(1209) * lu(1201) + lu(1210) = lu(1210) * lu(1201) + lu(1211) = lu(1211) * lu(1201) + lu(1212) = lu(1212) * lu(1201) + lu(1213) = lu(1213) * lu(1201) + lu(1214) = lu(1214) * lu(1201) + lu(1237) = lu(1237) - lu(1202) * lu(1236) + lu(1238) = lu(1238) - lu(1203) * lu(1236) + lu(1239) = lu(1239) - lu(1204) * lu(1236) + lu(1240) = lu(1240) - lu(1205) * lu(1236) + lu(1241) = lu(1241) - lu(1206) * lu(1236) + lu(1242) = lu(1242) - lu(1207) * lu(1236) + lu(1243) = lu(1243) - lu(1208) * lu(1236) + lu(1244) = lu(1244) - lu(1209) * lu(1236) + lu(1245) = lu(1245) - lu(1210) * lu(1236) + lu(1246) = lu(1246) - lu(1211) * lu(1236) + lu(1247) = lu(1247) - lu(1212) * lu(1236) + lu(1248) = lu(1248) - lu(1213) * lu(1236) + lu(1249) = lu(1249) - lu(1214) * lu(1236) + lu(1281) = lu(1281) - lu(1202) * lu(1280) + lu(1282) = lu(1282) - lu(1203) * lu(1280) + lu(1283) = lu(1283) - lu(1204) * lu(1280) + lu(1284) = lu(1284) - lu(1205) * lu(1280) + lu(1285) = lu(1285) - lu(1206) * lu(1280) + lu(1286) = lu(1286) - lu(1207) * lu(1280) + lu(1287) = lu(1287) - lu(1208) * lu(1280) + lu(1288) = lu(1288) - lu(1209) * lu(1280) + lu(1289) = lu(1289) - lu(1210) * lu(1280) + lu(1290) = lu(1290) - lu(1211) * lu(1280) + lu(1291) = lu(1291) - lu(1212) * lu(1280) + lu(1292) = lu(1292) - lu(1213) * lu(1280) + lu(1293) = lu(1293) - lu(1214) * lu(1280) + lu(1322) = lu(1322) - lu(1202) * lu(1321) + lu(1323) = lu(1323) - lu(1203) * lu(1321) + lu(1324) = lu(1324) - lu(1204) * lu(1321) + lu(1325) = lu(1325) - lu(1205) * lu(1321) + lu(1326) = lu(1326) - lu(1206) * lu(1321) + lu(1327) = lu(1327) - lu(1207) * lu(1321) + lu(1328) = lu(1328) - lu(1208) * lu(1321) + lu(1329) = lu(1329) - lu(1209) * lu(1321) + lu(1330) = lu(1330) - lu(1210) * lu(1321) + lu(1331) = lu(1331) - lu(1211) * lu(1321) + lu(1332) = lu(1332) - lu(1212) * lu(1321) + lu(1333) = lu(1333) - lu(1213) * lu(1321) + lu(1334) = lu(1334) - lu(1214) * lu(1321) + lu(1364) = lu(1364) - lu(1202) * lu(1363) + lu(1365) = lu(1365) - lu(1203) * lu(1363) + lu(1366) = lu(1366) - lu(1204) * lu(1363) + lu(1367) = lu(1367) - lu(1205) * lu(1363) + lu(1368) = lu(1368) - lu(1206) * lu(1363) + lu(1369) = lu(1369) - lu(1207) * lu(1363) + lu(1370) = lu(1370) - lu(1208) * lu(1363) + lu(1371) = lu(1371) - lu(1209) * lu(1363) + lu(1372) = lu(1372) - lu(1210) * lu(1363) + lu(1373) = lu(1373) - lu(1211) * lu(1363) + lu(1374) = lu(1374) - lu(1212) * lu(1363) + lu(1375) = lu(1375) - lu(1213) * lu(1363) + lu(1376) = lu(1376) - lu(1214) * lu(1363) + lu(1406) = lu(1406) - lu(1202) * lu(1405) + lu(1407) = lu(1407) - lu(1203) * lu(1405) + lu(1408) = lu(1408) - lu(1204) * lu(1405) + lu(1409) = lu(1409) - lu(1205) * lu(1405) + lu(1410) = lu(1410) - lu(1206) * lu(1405) + lu(1411) = lu(1411) - lu(1207) * lu(1405) + lu(1412) = lu(1412) - lu(1208) * lu(1405) + lu(1413) = lu(1413) - lu(1209) * lu(1405) + lu(1414) = lu(1414) - lu(1210) * lu(1405) + lu(1415) = lu(1415) - lu(1211) * lu(1405) + lu(1416) = lu(1416) - lu(1212) * lu(1405) + lu(1417) = lu(1417) - lu(1213) * lu(1405) + lu(1418) = lu(1418) - lu(1214) * lu(1405) + lu(1448) = lu(1448) - lu(1202) * lu(1447) + lu(1449) = lu(1449) - lu(1203) * lu(1447) + lu(1450) = lu(1450) - lu(1204) * lu(1447) + lu(1451) = lu(1451) - lu(1205) * lu(1447) + lu(1452) = lu(1452) - lu(1206) * lu(1447) + lu(1453) = lu(1453) - lu(1207) * lu(1447) + lu(1454) = lu(1454) - lu(1208) * lu(1447) + lu(1455) = lu(1455) - lu(1209) * lu(1447) + lu(1456) = lu(1456) - lu(1210) * lu(1447) + lu(1457) = lu(1457) - lu(1211) * lu(1447) + lu(1458) = lu(1458) - lu(1212) * lu(1447) + lu(1459) = lu(1459) - lu(1213) * lu(1447) + lu(1460) = lu(1460) - lu(1214) * lu(1447) + lu(1503) = lu(1503) - lu(1202) * lu(1502) + lu(1504) = lu(1504) - lu(1203) * lu(1502) + lu(1505) = lu(1505) - lu(1204) * lu(1502) + lu(1506) = lu(1506) - lu(1205) * lu(1502) + lu(1507) = lu(1507) - lu(1206) * lu(1502) + lu(1508) = lu(1508) - lu(1207) * lu(1502) + lu(1509) = lu(1509) - lu(1208) * lu(1502) + lu(1510) = lu(1510) - lu(1209) * lu(1502) + lu(1511) = lu(1511) - lu(1210) * lu(1502) + lu(1512) = lu(1512) - lu(1211) * lu(1502) + lu(1513) = lu(1513) - lu(1212) * lu(1502) + lu(1514) = lu(1514) - lu(1213) * lu(1502) + lu(1515) = lu(1515) - lu(1214) * lu(1502) + lu(1535) = lu(1535) - lu(1202) * lu(1534) + lu(1536) = lu(1536) - lu(1203) * lu(1534) + lu(1537) = lu(1537) - lu(1204) * lu(1534) + lu(1538) = lu(1538) - lu(1205) * lu(1534) + lu(1539) = lu(1539) - lu(1206) * lu(1534) + lu(1540) = lu(1540) - lu(1207) * lu(1534) + lu(1541) = lu(1541) - lu(1208) * lu(1534) + lu(1542) = lu(1542) - lu(1209) * lu(1534) + lu(1543) = lu(1543) - lu(1210) * lu(1534) + lu(1544) = lu(1544) - lu(1211) * lu(1534) + lu(1545) = lu(1545) - lu(1212) * lu(1534) + lu(1546) = lu(1546) - lu(1213) * lu(1534) + lu(1547) = lu(1547) - lu(1214) * lu(1534) + lu(1570) = lu(1570) - lu(1202) * lu(1569) + lu(1571) = lu(1571) - lu(1203) * lu(1569) + lu(1572) = lu(1572) - lu(1204) * lu(1569) + lu(1573) = lu(1573) - lu(1205) * lu(1569) + lu(1574) = lu(1574) - lu(1206) * lu(1569) + lu(1575) = lu(1575) - lu(1207) * lu(1569) + lu(1576) = lu(1576) - lu(1208) * lu(1569) + lu(1577) = lu(1577) - lu(1209) * lu(1569) + lu(1578) = lu(1578) - lu(1210) * lu(1569) + lu(1579) = lu(1579) - lu(1211) * lu(1569) + lu(1580) = lu(1580) - lu(1212) * lu(1569) + lu(1581) = lu(1581) - lu(1213) * lu(1569) + lu(1582) = lu(1582) - lu(1214) * lu(1569) + lu(1608) = lu(1608) - lu(1202) * lu(1607) + lu(1609) = lu(1609) - lu(1203) * lu(1607) + lu(1610) = lu(1610) - lu(1204) * lu(1607) + lu(1611) = lu(1611) - lu(1205) * lu(1607) + lu(1612) = lu(1612) - lu(1206) * lu(1607) + lu(1613) = lu(1613) - lu(1207) * lu(1607) + lu(1614) = lu(1614) - lu(1208) * lu(1607) + lu(1615) = lu(1615) - lu(1209) * lu(1607) + lu(1616) = lu(1616) - lu(1210) * lu(1607) + lu(1617) = lu(1617) - lu(1211) * lu(1607) + lu(1618) = lu(1618) - lu(1212) * lu(1607) + lu(1619) = lu(1619) - lu(1213) * lu(1607) + lu(1620) = lu(1620) - lu(1214) * lu(1607) + lu(1647) = lu(1647) - lu(1202) * lu(1646) + lu(1648) = lu(1648) - lu(1203) * lu(1646) + lu(1649) = lu(1649) - lu(1204) * lu(1646) + lu(1650) = lu(1650) - lu(1205) * lu(1646) + lu(1651) = lu(1651) - lu(1206) * lu(1646) + lu(1652) = lu(1652) - lu(1207) * lu(1646) + lu(1653) = lu(1653) - lu(1208) * lu(1646) + lu(1654) = lu(1654) - lu(1209) * lu(1646) + lu(1655) = lu(1655) - lu(1210) * lu(1646) + lu(1656) = lu(1656) - lu(1211) * lu(1646) + lu(1657) = lu(1657) - lu(1212) * lu(1646) + lu(1658) = lu(1658) - lu(1213) * lu(1646) + lu(1659) = lu(1659) - lu(1214) * lu(1646) + lu(1681) = lu(1681) - lu(1202) * lu(1680) + lu(1682) = lu(1682) - lu(1203) * lu(1680) + lu(1683) = lu(1683) - lu(1204) * lu(1680) + lu(1684) = lu(1684) - lu(1205) * lu(1680) + lu(1685) = lu(1685) - lu(1206) * lu(1680) + lu(1686) = lu(1686) - lu(1207) * lu(1680) + lu(1687) = lu(1687) - lu(1208) * lu(1680) + lu(1688) = lu(1688) - lu(1209) * lu(1680) + lu(1689) = lu(1689) - lu(1210) * lu(1680) + lu(1690) = lu(1690) - lu(1211) * lu(1680) + lu(1691) = lu(1691) - lu(1212) * lu(1680) + lu(1692) = lu(1692) - lu(1213) * lu(1680) + lu(1693) = lu(1693) - lu(1214) * lu(1680) + lu(1733) = lu(1733) - lu(1202) * lu(1732) + lu(1734) = lu(1734) - lu(1203) * lu(1732) + lu(1735) = lu(1735) - lu(1204) * lu(1732) + lu(1736) = lu(1736) - lu(1205) * lu(1732) + lu(1737) = lu(1737) - lu(1206) * lu(1732) + lu(1738) = lu(1738) - lu(1207) * lu(1732) + lu(1739) = lu(1739) - lu(1208) * lu(1732) + lu(1740) = lu(1740) - lu(1209) * lu(1732) + lu(1741) = lu(1741) - lu(1210) * lu(1732) + lu(1742) = lu(1742) - lu(1211) * lu(1732) + lu(1743) = lu(1743) - lu(1212) * lu(1732) + lu(1744) = lu(1744) - lu(1213) * lu(1732) + lu(1745) = lu(1745) - lu(1214) * lu(1732) + lu(1237) = 1._r8 / lu(1237) + lu(1238) = lu(1238) * lu(1237) + lu(1239) = lu(1239) * lu(1237) + lu(1240) = lu(1240) * lu(1237) + lu(1241) = lu(1241) * lu(1237) + lu(1242) = lu(1242) * lu(1237) + lu(1243) = lu(1243) * lu(1237) + lu(1244) = lu(1244) * lu(1237) + lu(1245) = lu(1245) * lu(1237) + lu(1246) = lu(1246) * lu(1237) + lu(1247) = lu(1247) * lu(1237) + lu(1248) = lu(1248) * lu(1237) + lu(1249) = lu(1249) * lu(1237) + lu(1282) = lu(1282) - lu(1238) * lu(1281) + lu(1283) = lu(1283) - lu(1239) * lu(1281) + lu(1284) = lu(1284) - lu(1240) * lu(1281) + lu(1285) = lu(1285) - lu(1241) * lu(1281) + lu(1286) = lu(1286) - lu(1242) * lu(1281) + lu(1287) = lu(1287) - lu(1243) * lu(1281) + lu(1288) = lu(1288) - lu(1244) * lu(1281) + lu(1289) = lu(1289) - lu(1245) * lu(1281) + lu(1290) = lu(1290) - lu(1246) * lu(1281) + lu(1291) = lu(1291) - lu(1247) * lu(1281) + lu(1292) = lu(1292) - lu(1248) * lu(1281) + lu(1293) = lu(1293) - lu(1249) * lu(1281) + lu(1323) = lu(1323) - lu(1238) * lu(1322) + lu(1324) = lu(1324) - lu(1239) * lu(1322) + lu(1325) = lu(1325) - lu(1240) * lu(1322) + lu(1326) = lu(1326) - lu(1241) * lu(1322) + lu(1327) = lu(1327) - lu(1242) * lu(1322) + lu(1328) = lu(1328) - lu(1243) * lu(1322) + lu(1329) = lu(1329) - lu(1244) * lu(1322) + lu(1330) = lu(1330) - lu(1245) * lu(1322) + lu(1331) = lu(1331) - lu(1246) * lu(1322) + lu(1332) = lu(1332) - lu(1247) * lu(1322) + lu(1333) = lu(1333) - lu(1248) * lu(1322) + lu(1334) = lu(1334) - lu(1249) * lu(1322) + lu(1365) = lu(1365) - lu(1238) * lu(1364) + lu(1366) = lu(1366) - lu(1239) * lu(1364) + lu(1367) = lu(1367) - lu(1240) * lu(1364) + lu(1368) = lu(1368) - lu(1241) * lu(1364) + lu(1369) = lu(1369) - lu(1242) * lu(1364) + lu(1370) = lu(1370) - lu(1243) * lu(1364) + lu(1371) = lu(1371) - lu(1244) * lu(1364) + lu(1372) = lu(1372) - lu(1245) * lu(1364) + lu(1373) = lu(1373) - lu(1246) * lu(1364) + lu(1374) = lu(1374) - lu(1247) * lu(1364) + lu(1375) = lu(1375) - lu(1248) * lu(1364) + lu(1376) = lu(1376) - lu(1249) * lu(1364) + lu(1407) = lu(1407) - lu(1238) * lu(1406) + lu(1408) = lu(1408) - lu(1239) * lu(1406) + lu(1409) = lu(1409) - lu(1240) * lu(1406) + lu(1410) = lu(1410) - lu(1241) * lu(1406) + lu(1411) = lu(1411) - lu(1242) * lu(1406) + lu(1412) = lu(1412) - lu(1243) * lu(1406) + lu(1413) = lu(1413) - lu(1244) * lu(1406) + lu(1414) = lu(1414) - lu(1245) * lu(1406) + lu(1415) = lu(1415) - lu(1246) * lu(1406) + lu(1416) = lu(1416) - lu(1247) * lu(1406) + lu(1417) = lu(1417) - lu(1248) * lu(1406) + lu(1418) = lu(1418) - lu(1249) * lu(1406) + lu(1449) = lu(1449) - lu(1238) * lu(1448) + lu(1450) = lu(1450) - lu(1239) * lu(1448) + lu(1451) = lu(1451) - lu(1240) * lu(1448) + lu(1452) = lu(1452) - lu(1241) * lu(1448) + lu(1453) = lu(1453) - lu(1242) * lu(1448) + lu(1454) = lu(1454) - lu(1243) * lu(1448) + lu(1455) = lu(1455) - lu(1244) * lu(1448) + lu(1456) = lu(1456) - lu(1245) * lu(1448) + lu(1457) = lu(1457) - lu(1246) * lu(1448) + lu(1458) = lu(1458) - lu(1247) * lu(1448) + lu(1459) = lu(1459) - lu(1248) * lu(1448) + lu(1460) = lu(1460) - lu(1249) * lu(1448) + lu(1504) = lu(1504) - lu(1238) * lu(1503) + lu(1505) = lu(1505) - lu(1239) * lu(1503) + lu(1506) = lu(1506) - lu(1240) * lu(1503) + lu(1507) = lu(1507) - lu(1241) * lu(1503) + lu(1508) = lu(1508) - lu(1242) * lu(1503) + lu(1509) = lu(1509) - lu(1243) * lu(1503) + lu(1510) = lu(1510) - lu(1244) * lu(1503) + lu(1511) = lu(1511) - lu(1245) * lu(1503) + lu(1512) = lu(1512) - lu(1246) * lu(1503) + lu(1513) = lu(1513) - lu(1247) * lu(1503) + lu(1514) = lu(1514) - lu(1248) * lu(1503) + lu(1515) = lu(1515) - lu(1249) * lu(1503) + lu(1536) = lu(1536) - lu(1238) * lu(1535) + lu(1537) = lu(1537) - lu(1239) * lu(1535) + lu(1538) = lu(1538) - lu(1240) * lu(1535) + lu(1539) = lu(1539) - lu(1241) * lu(1535) + lu(1540) = lu(1540) - lu(1242) * lu(1535) + lu(1541) = lu(1541) - lu(1243) * lu(1535) + lu(1542) = lu(1542) - lu(1244) * lu(1535) + lu(1543) = lu(1543) - lu(1245) * lu(1535) + lu(1544) = lu(1544) - lu(1246) * lu(1535) + lu(1545) = lu(1545) - lu(1247) * lu(1535) + lu(1546) = lu(1546) - lu(1248) * lu(1535) + lu(1547) = lu(1547) - lu(1249) * lu(1535) + lu(1571) = lu(1571) - lu(1238) * lu(1570) + lu(1572) = lu(1572) - lu(1239) * lu(1570) + lu(1573) = lu(1573) - lu(1240) * lu(1570) + lu(1574) = lu(1574) - lu(1241) * lu(1570) + lu(1575) = lu(1575) - lu(1242) * lu(1570) + lu(1576) = lu(1576) - lu(1243) * lu(1570) + lu(1577) = lu(1577) - lu(1244) * lu(1570) + lu(1578) = lu(1578) - lu(1245) * lu(1570) + lu(1579) = lu(1579) - lu(1246) * lu(1570) + lu(1580) = lu(1580) - lu(1247) * lu(1570) + lu(1581) = lu(1581) - lu(1248) * lu(1570) + lu(1582) = lu(1582) - lu(1249) * lu(1570) + lu(1609) = lu(1609) - lu(1238) * lu(1608) + lu(1610) = lu(1610) - lu(1239) * lu(1608) + lu(1611) = lu(1611) - lu(1240) * lu(1608) + lu(1612) = lu(1612) - lu(1241) * lu(1608) + lu(1613) = lu(1613) - lu(1242) * lu(1608) + lu(1614) = lu(1614) - lu(1243) * lu(1608) + lu(1615) = lu(1615) - lu(1244) * lu(1608) + lu(1616) = lu(1616) - lu(1245) * lu(1608) + lu(1617) = lu(1617) - lu(1246) * lu(1608) + lu(1618) = lu(1618) - lu(1247) * lu(1608) + lu(1619) = lu(1619) - lu(1248) * lu(1608) + lu(1620) = lu(1620) - lu(1249) * lu(1608) + lu(1648) = lu(1648) - lu(1238) * lu(1647) + lu(1649) = lu(1649) - lu(1239) * lu(1647) + lu(1650) = lu(1650) - lu(1240) * lu(1647) + lu(1651) = lu(1651) - lu(1241) * lu(1647) + lu(1652) = lu(1652) - lu(1242) * lu(1647) + lu(1653) = lu(1653) - lu(1243) * lu(1647) + lu(1654) = lu(1654) - lu(1244) * lu(1647) + lu(1655) = lu(1655) - lu(1245) * lu(1647) + lu(1656) = lu(1656) - lu(1246) * lu(1647) + lu(1657) = lu(1657) - lu(1247) * lu(1647) + lu(1658) = lu(1658) - lu(1248) * lu(1647) + lu(1659) = lu(1659) - lu(1249) * lu(1647) + lu(1682) = lu(1682) - lu(1238) * lu(1681) + lu(1683) = lu(1683) - lu(1239) * lu(1681) + lu(1684) = lu(1684) - lu(1240) * lu(1681) + lu(1685) = lu(1685) - lu(1241) * lu(1681) + lu(1686) = lu(1686) - lu(1242) * lu(1681) + lu(1687) = lu(1687) - lu(1243) * lu(1681) + lu(1688) = lu(1688) - lu(1244) * lu(1681) + lu(1689) = lu(1689) - lu(1245) * lu(1681) + lu(1690) = lu(1690) - lu(1246) * lu(1681) + lu(1691) = lu(1691) - lu(1247) * lu(1681) + lu(1692) = lu(1692) - lu(1248) * lu(1681) + lu(1693) = lu(1693) - lu(1249) * lu(1681) + lu(1734) = lu(1734) - lu(1238) * lu(1733) + lu(1735) = lu(1735) - lu(1239) * lu(1733) + lu(1736) = lu(1736) - lu(1240) * lu(1733) + lu(1737) = lu(1737) - lu(1241) * lu(1733) + lu(1738) = lu(1738) - lu(1242) * lu(1733) + lu(1739) = lu(1739) - lu(1243) * lu(1733) + lu(1740) = lu(1740) - lu(1244) * lu(1733) + lu(1741) = lu(1741) - lu(1245) * lu(1733) + lu(1742) = lu(1742) - lu(1246) * lu(1733) + lu(1743) = lu(1743) - lu(1247) * lu(1733) + lu(1744) = lu(1744) - lu(1248) * lu(1733) + lu(1745) = lu(1745) - lu(1249) * lu(1733) + lu(1282) = 1._r8 / lu(1282) + lu(1283) = lu(1283) * lu(1282) + lu(1284) = lu(1284) * lu(1282) + lu(1285) = lu(1285) * lu(1282) + lu(1286) = lu(1286) * lu(1282) + lu(1287) = lu(1287) * lu(1282) + lu(1288) = lu(1288) * lu(1282) + lu(1289) = lu(1289) * lu(1282) + lu(1290) = lu(1290) * lu(1282) + lu(1291) = lu(1291) * lu(1282) + lu(1292) = lu(1292) * lu(1282) + lu(1293) = lu(1293) * lu(1282) + lu(1324) = lu(1324) - lu(1283) * lu(1323) + lu(1325) = lu(1325) - lu(1284) * lu(1323) + lu(1326) = lu(1326) - lu(1285) * lu(1323) + lu(1327) = lu(1327) - lu(1286) * lu(1323) + lu(1328) = lu(1328) - lu(1287) * lu(1323) + lu(1329) = lu(1329) - lu(1288) * lu(1323) + lu(1330) = lu(1330) - lu(1289) * lu(1323) + lu(1331) = lu(1331) - lu(1290) * lu(1323) + lu(1332) = lu(1332) - lu(1291) * lu(1323) + lu(1333) = lu(1333) - lu(1292) * lu(1323) + lu(1334) = lu(1334) - lu(1293) * lu(1323) + lu(1366) = lu(1366) - lu(1283) * lu(1365) + lu(1367) = lu(1367) - lu(1284) * lu(1365) + lu(1368) = lu(1368) - lu(1285) * lu(1365) + lu(1369) = lu(1369) - lu(1286) * lu(1365) + lu(1370) = lu(1370) - lu(1287) * lu(1365) + lu(1371) = lu(1371) - lu(1288) * lu(1365) + lu(1372) = lu(1372) - lu(1289) * lu(1365) + lu(1373) = lu(1373) - lu(1290) * lu(1365) + lu(1374) = lu(1374) - lu(1291) * lu(1365) + lu(1375) = lu(1375) - lu(1292) * lu(1365) + lu(1376) = lu(1376) - lu(1293) * lu(1365) + lu(1408) = lu(1408) - lu(1283) * lu(1407) + lu(1409) = lu(1409) - lu(1284) * lu(1407) + lu(1410) = lu(1410) - lu(1285) * lu(1407) + lu(1411) = lu(1411) - lu(1286) * lu(1407) + lu(1412) = lu(1412) - lu(1287) * lu(1407) + lu(1413) = lu(1413) - lu(1288) * lu(1407) + lu(1414) = lu(1414) - lu(1289) * lu(1407) + lu(1415) = lu(1415) - lu(1290) * lu(1407) + lu(1416) = lu(1416) - lu(1291) * lu(1407) + lu(1417) = lu(1417) - lu(1292) * lu(1407) + lu(1418) = lu(1418) - lu(1293) * lu(1407) + lu(1450) = lu(1450) - lu(1283) * lu(1449) + lu(1451) = lu(1451) - lu(1284) * lu(1449) + lu(1452) = lu(1452) - lu(1285) * lu(1449) + lu(1453) = lu(1453) - lu(1286) * lu(1449) + lu(1454) = lu(1454) - lu(1287) * lu(1449) + lu(1455) = lu(1455) - lu(1288) * lu(1449) + lu(1456) = lu(1456) - lu(1289) * lu(1449) + lu(1457) = lu(1457) - lu(1290) * lu(1449) + lu(1458) = lu(1458) - lu(1291) * lu(1449) + lu(1459) = lu(1459) - lu(1292) * lu(1449) + lu(1460) = lu(1460) - lu(1293) * lu(1449) + lu(1505) = lu(1505) - lu(1283) * lu(1504) + lu(1506) = lu(1506) - lu(1284) * lu(1504) + lu(1507) = lu(1507) - lu(1285) * lu(1504) + lu(1508) = lu(1508) - lu(1286) * lu(1504) + lu(1509) = lu(1509) - lu(1287) * lu(1504) + lu(1510) = lu(1510) - lu(1288) * lu(1504) + lu(1511) = lu(1511) - lu(1289) * lu(1504) + lu(1512) = lu(1512) - lu(1290) * lu(1504) + lu(1513) = lu(1513) - lu(1291) * lu(1504) + lu(1514) = lu(1514) - lu(1292) * lu(1504) + lu(1515) = lu(1515) - lu(1293) * lu(1504) + lu(1537) = lu(1537) - lu(1283) * lu(1536) + lu(1538) = lu(1538) - lu(1284) * lu(1536) + lu(1539) = lu(1539) - lu(1285) * lu(1536) + lu(1540) = lu(1540) - lu(1286) * lu(1536) + lu(1541) = lu(1541) - lu(1287) * lu(1536) + lu(1542) = lu(1542) - lu(1288) * lu(1536) + lu(1543) = lu(1543) - lu(1289) * lu(1536) + lu(1544) = lu(1544) - lu(1290) * lu(1536) + lu(1545) = lu(1545) - lu(1291) * lu(1536) + lu(1546) = lu(1546) - lu(1292) * lu(1536) + lu(1547) = lu(1547) - lu(1293) * lu(1536) + lu(1572) = lu(1572) - lu(1283) * lu(1571) + lu(1573) = lu(1573) - lu(1284) * lu(1571) + lu(1574) = lu(1574) - lu(1285) * lu(1571) + lu(1575) = lu(1575) - lu(1286) * lu(1571) + lu(1576) = lu(1576) - lu(1287) * lu(1571) + lu(1577) = lu(1577) - lu(1288) * lu(1571) + lu(1578) = lu(1578) - lu(1289) * lu(1571) + lu(1579) = lu(1579) - lu(1290) * lu(1571) + lu(1580) = lu(1580) - lu(1291) * lu(1571) + lu(1581) = lu(1581) - lu(1292) * lu(1571) + lu(1582) = lu(1582) - lu(1293) * lu(1571) + lu(1610) = lu(1610) - lu(1283) * lu(1609) + lu(1611) = lu(1611) - lu(1284) * lu(1609) + lu(1612) = lu(1612) - lu(1285) * lu(1609) + lu(1613) = lu(1613) - lu(1286) * lu(1609) + lu(1614) = lu(1614) - lu(1287) * lu(1609) + lu(1615) = lu(1615) - lu(1288) * lu(1609) + lu(1616) = lu(1616) - lu(1289) * lu(1609) + lu(1617) = lu(1617) - lu(1290) * lu(1609) + lu(1618) = lu(1618) - lu(1291) * lu(1609) + lu(1619) = lu(1619) - lu(1292) * lu(1609) + lu(1620) = lu(1620) - lu(1293) * lu(1609) + lu(1649) = lu(1649) - lu(1283) * lu(1648) + lu(1650) = lu(1650) - lu(1284) * lu(1648) + lu(1651) = lu(1651) - lu(1285) * lu(1648) + lu(1652) = lu(1652) - lu(1286) * lu(1648) + lu(1653) = lu(1653) - lu(1287) * lu(1648) + lu(1654) = lu(1654) - lu(1288) * lu(1648) + lu(1655) = lu(1655) - lu(1289) * lu(1648) + lu(1656) = lu(1656) - lu(1290) * lu(1648) + lu(1657) = lu(1657) - lu(1291) * lu(1648) + lu(1658) = lu(1658) - lu(1292) * lu(1648) + lu(1659) = lu(1659) - lu(1293) * lu(1648) + lu(1683) = lu(1683) - lu(1283) * lu(1682) + lu(1684) = lu(1684) - lu(1284) * lu(1682) + lu(1685) = lu(1685) - lu(1285) * lu(1682) + lu(1686) = lu(1686) - lu(1286) * lu(1682) + lu(1687) = lu(1687) - lu(1287) * lu(1682) + lu(1688) = lu(1688) - lu(1288) * lu(1682) + lu(1689) = lu(1689) - lu(1289) * lu(1682) + lu(1690) = lu(1690) - lu(1290) * lu(1682) + lu(1691) = lu(1691) - lu(1291) * lu(1682) + lu(1692) = lu(1692) - lu(1292) * lu(1682) + lu(1693) = lu(1693) - lu(1293) * lu(1682) + lu(1735) = lu(1735) - lu(1283) * lu(1734) + lu(1736) = lu(1736) - lu(1284) * lu(1734) + lu(1737) = lu(1737) - lu(1285) * lu(1734) + lu(1738) = lu(1738) - lu(1286) * lu(1734) + lu(1739) = lu(1739) - lu(1287) * lu(1734) + lu(1740) = lu(1740) - lu(1288) * lu(1734) + lu(1741) = lu(1741) - lu(1289) * lu(1734) + lu(1742) = lu(1742) - lu(1290) * lu(1734) + lu(1743) = lu(1743) - lu(1291) * lu(1734) + lu(1744) = lu(1744) - lu(1292) * lu(1734) + lu(1745) = lu(1745) - lu(1293) * lu(1734) end subroutine lu_fac20 - subroutine lu_fac21( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac21( lu ) 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,1314) = 1._r8 / lu(k,1314) - lu(k,1315) = lu(k,1315) * lu(k,1314) - lu(k,1316) = lu(k,1316) * lu(k,1314) - lu(k,1317) = lu(k,1317) * lu(k,1314) - lu(k,1318) = lu(k,1318) * lu(k,1314) - lu(k,1319) = lu(k,1319) * lu(k,1314) - lu(k,1320) = lu(k,1320) * lu(k,1314) - lu(k,1321) = lu(k,1321) * lu(k,1314) - lu(k,1322) = lu(k,1322) * lu(k,1314) - lu(k,1323) = lu(k,1323) * lu(k,1314) - lu(k,1324) = lu(k,1324) * lu(k,1314) - lu(k,1325) = lu(k,1325) * lu(k,1314) - lu(k,1326) = lu(k,1326) * lu(k,1314) - lu(k,1360) = lu(k,1360) - lu(k,1315) * lu(k,1359) - lu(k,1361) = lu(k,1361) - lu(k,1316) * lu(k,1359) - lu(k,1362) = lu(k,1362) - lu(k,1317) * lu(k,1359) - lu(k,1363) = lu(k,1363) - lu(k,1318) * lu(k,1359) - lu(k,1364) = lu(k,1364) - lu(k,1319) * lu(k,1359) - lu(k,1365) = lu(k,1365) - lu(k,1320) * lu(k,1359) - lu(k,1366) = lu(k,1366) - lu(k,1321) * lu(k,1359) - lu(k,1367) = lu(k,1367) - lu(k,1322) * lu(k,1359) - lu(k,1368) = lu(k,1368) - lu(k,1323) * lu(k,1359) - lu(k,1369) = lu(k,1369) - lu(k,1324) * lu(k,1359) - lu(k,1370) = lu(k,1370) - lu(k,1325) * lu(k,1359) - lu(k,1371) = lu(k,1371) - lu(k,1326) * lu(k,1359) - lu(k,1402) = lu(k,1402) - lu(k,1315) * lu(k,1401) - lu(k,1403) = lu(k,1403) - lu(k,1316) * lu(k,1401) - lu(k,1404) = lu(k,1404) - lu(k,1317) * lu(k,1401) - lu(k,1405) = lu(k,1405) - lu(k,1318) * lu(k,1401) - lu(k,1406) = lu(k,1406) - lu(k,1319) * lu(k,1401) - lu(k,1407) = lu(k,1407) - lu(k,1320) * lu(k,1401) - lu(k,1408) = lu(k,1408) - lu(k,1321) * lu(k,1401) - lu(k,1409) = lu(k,1409) - lu(k,1322) * lu(k,1401) - lu(k,1410) = lu(k,1410) - lu(k,1323) * lu(k,1401) - lu(k,1411) = lu(k,1411) - lu(k,1324) * lu(k,1401) - lu(k,1412) = lu(k,1412) - lu(k,1325) * lu(k,1401) - lu(k,1413) = lu(k,1413) - lu(k,1326) * lu(k,1401) - lu(k,1440) = lu(k,1440) - lu(k,1315) * lu(k,1439) - lu(k,1441) = lu(k,1441) - lu(k,1316) * lu(k,1439) - lu(k,1442) = lu(k,1442) - lu(k,1317) * lu(k,1439) - lu(k,1443) = lu(k,1443) - lu(k,1318) * lu(k,1439) - lu(k,1444) = lu(k,1444) - lu(k,1319) * lu(k,1439) - lu(k,1445) = lu(k,1445) - lu(k,1320) * lu(k,1439) - lu(k,1446) = lu(k,1446) - lu(k,1321) * lu(k,1439) - lu(k,1447) = lu(k,1447) - lu(k,1322) * lu(k,1439) - lu(k,1448) = lu(k,1448) - lu(k,1323) * lu(k,1439) - lu(k,1449) = lu(k,1449) - lu(k,1324) * lu(k,1439) - lu(k,1450) = lu(k,1450) - lu(k,1325) * lu(k,1439) - lu(k,1451) = lu(k,1451) - lu(k,1326) * lu(k,1439) - lu(k,1485) = lu(k,1485) - lu(k,1315) * lu(k,1484) - lu(k,1486) = lu(k,1486) - lu(k,1316) * lu(k,1484) - lu(k,1487) = lu(k,1487) - lu(k,1317) * lu(k,1484) - lu(k,1488) = lu(k,1488) - lu(k,1318) * lu(k,1484) - lu(k,1489) = lu(k,1489) - lu(k,1319) * lu(k,1484) - lu(k,1490) = lu(k,1490) - lu(k,1320) * lu(k,1484) - lu(k,1491) = lu(k,1491) - lu(k,1321) * lu(k,1484) - lu(k,1492) = lu(k,1492) - lu(k,1322) * lu(k,1484) - lu(k,1493) = lu(k,1493) - lu(k,1323) * lu(k,1484) - lu(k,1494) = lu(k,1494) - lu(k,1324) * lu(k,1484) - lu(k,1495) = lu(k,1495) - lu(k,1325) * lu(k,1484) - lu(k,1496) = lu(k,1496) - lu(k,1326) * lu(k,1484) - lu(k,1528) = lu(k,1528) - lu(k,1315) * lu(k,1527) - lu(k,1529) = lu(k,1529) - lu(k,1316) * lu(k,1527) - lu(k,1530) = lu(k,1530) - lu(k,1317) * lu(k,1527) - lu(k,1531) = lu(k,1531) - lu(k,1318) * lu(k,1527) - lu(k,1532) = lu(k,1532) - lu(k,1319) * lu(k,1527) - lu(k,1533) = lu(k,1533) - lu(k,1320) * lu(k,1527) - lu(k,1534) = lu(k,1534) - lu(k,1321) * lu(k,1527) - lu(k,1535) = lu(k,1535) - lu(k,1322) * lu(k,1527) - lu(k,1536) = lu(k,1536) - lu(k,1323) * lu(k,1527) - lu(k,1537) = lu(k,1537) - lu(k,1324) * lu(k,1527) - lu(k,1538) = lu(k,1538) - lu(k,1325) * lu(k,1527) - lu(k,1539) = lu(k,1539) - lu(k,1326) * lu(k,1527) - lu(k,1571) = lu(k,1571) - lu(k,1315) * lu(k,1570) - lu(k,1572) = lu(k,1572) - lu(k,1316) * lu(k,1570) - lu(k,1573) = lu(k,1573) - lu(k,1317) * lu(k,1570) - lu(k,1574) = lu(k,1574) - lu(k,1318) * lu(k,1570) - lu(k,1575) = lu(k,1575) - lu(k,1319) * lu(k,1570) - lu(k,1576) = lu(k,1576) - lu(k,1320) * lu(k,1570) - lu(k,1577) = lu(k,1577) - lu(k,1321) * lu(k,1570) - lu(k,1578) = lu(k,1578) - lu(k,1322) * lu(k,1570) - lu(k,1579) = lu(k,1579) - lu(k,1323) * lu(k,1570) - lu(k,1580) = lu(k,1580) - lu(k,1324) * lu(k,1570) - lu(k,1581) = lu(k,1581) - lu(k,1325) * lu(k,1570) - lu(k,1582) = lu(k,1582) - lu(k,1326) * lu(k,1570) - lu(k,1604) = lu(k,1604) - lu(k,1315) * lu(k,1603) - lu(k,1605) = lu(k,1605) - lu(k,1316) * lu(k,1603) - lu(k,1606) = lu(k,1606) - lu(k,1317) * lu(k,1603) - lu(k,1607) = lu(k,1607) - lu(k,1318) * lu(k,1603) - lu(k,1608) = lu(k,1608) - lu(k,1319) * lu(k,1603) - lu(k,1609) = lu(k,1609) - lu(k,1320) * lu(k,1603) - lu(k,1610) = lu(k,1610) - lu(k,1321) * lu(k,1603) - lu(k,1611) = lu(k,1611) - lu(k,1322) * lu(k,1603) - lu(k,1612) = lu(k,1612) - lu(k,1323) * lu(k,1603) - lu(k,1613) = lu(k,1613) - lu(k,1324) * lu(k,1603) - lu(k,1614) = lu(k,1614) - lu(k,1325) * lu(k,1603) - lu(k,1615) = lu(k,1615) - lu(k,1326) * lu(k,1603) - lu(k,1640) = lu(k,1640) - lu(k,1315) * lu(k,1639) - lu(k,1641) = lu(k,1641) - lu(k,1316) * lu(k,1639) - lu(k,1642) = lu(k,1642) - lu(k,1317) * lu(k,1639) - lu(k,1643) = lu(k,1643) - lu(k,1318) * lu(k,1639) - lu(k,1644) = lu(k,1644) - lu(k,1319) * lu(k,1639) - lu(k,1645) = lu(k,1645) - lu(k,1320) * lu(k,1639) - lu(k,1646) = lu(k,1646) - lu(k,1321) * lu(k,1639) - lu(k,1647) = lu(k,1647) - lu(k,1322) * lu(k,1639) - lu(k,1648) = lu(k,1648) - lu(k,1323) * lu(k,1639) - lu(k,1649) = lu(k,1649) - lu(k,1324) * lu(k,1639) - lu(k,1650) = lu(k,1650) - lu(k,1325) * lu(k,1639) - lu(k,1651) = lu(k,1651) - lu(k,1326) * lu(k,1639) - lu(k,1683) = lu(k,1683) - lu(k,1315) * lu(k,1682) - lu(k,1684) = lu(k,1684) - lu(k,1316) * lu(k,1682) - lu(k,1685) = lu(k,1685) - lu(k,1317) * lu(k,1682) - lu(k,1686) = lu(k,1686) - lu(k,1318) * lu(k,1682) - lu(k,1687) = lu(k,1687) - lu(k,1319) * lu(k,1682) - lu(k,1688) = lu(k,1688) - lu(k,1320) * lu(k,1682) - lu(k,1689) = lu(k,1689) - lu(k,1321) * lu(k,1682) - lu(k,1690) = lu(k,1690) - lu(k,1322) * lu(k,1682) - lu(k,1691) = lu(k,1691) - lu(k,1323) * lu(k,1682) - lu(k,1692) = lu(k,1692) - lu(k,1324) * lu(k,1682) - lu(k,1693) = lu(k,1693) - lu(k,1325) * lu(k,1682) - lu(k,1694) = lu(k,1694) - lu(k,1326) * lu(k,1682) - lu(k,1719) = lu(k,1719) - lu(k,1315) * lu(k,1718) - lu(k,1720) = lu(k,1720) - lu(k,1316) * lu(k,1718) - lu(k,1721) = lu(k,1721) - lu(k,1317) * lu(k,1718) - lu(k,1722) = lu(k,1722) - lu(k,1318) * lu(k,1718) - lu(k,1723) = lu(k,1723) - lu(k,1319) * lu(k,1718) - lu(k,1724) = lu(k,1724) - lu(k,1320) * lu(k,1718) - lu(k,1725) = lu(k,1725) - lu(k,1321) * lu(k,1718) - lu(k,1726) = lu(k,1726) - lu(k,1322) * lu(k,1718) - lu(k,1727) = lu(k,1727) - lu(k,1323) * lu(k,1718) - lu(k,1728) = lu(k,1728) - lu(k,1324) * lu(k,1718) - lu(k,1729) = lu(k,1729) - lu(k,1325) * lu(k,1718) - lu(k,1730) = lu(k,1730) - lu(k,1326) * lu(k,1718) - lu(k,1761) = lu(k,1761) - lu(k,1315) * lu(k,1760) - lu(k,1762) = lu(k,1762) - lu(k,1316) * lu(k,1760) - lu(k,1763) = lu(k,1763) - lu(k,1317) * lu(k,1760) - lu(k,1764) = lu(k,1764) - lu(k,1318) * lu(k,1760) - lu(k,1765) = lu(k,1765) - lu(k,1319) * lu(k,1760) - lu(k,1766) = lu(k,1766) - lu(k,1320) * lu(k,1760) - lu(k,1767) = lu(k,1767) - lu(k,1321) * lu(k,1760) - lu(k,1768) = lu(k,1768) - lu(k,1322) * lu(k,1760) - lu(k,1769) = lu(k,1769) - lu(k,1323) * lu(k,1760) - lu(k,1770) = lu(k,1770) - lu(k,1324) * lu(k,1760) - lu(k,1771) = lu(k,1771) - lu(k,1325) * lu(k,1760) - lu(k,1772) = lu(k,1772) - lu(k,1326) * lu(k,1760) - lu(k,1814) = lu(k,1814) - lu(k,1315) * lu(k,1813) - lu(k,1815) = lu(k,1815) - lu(k,1316) * lu(k,1813) - lu(k,1816) = lu(k,1816) - lu(k,1317) * lu(k,1813) - lu(k,1817) = lu(k,1817) - lu(k,1318) * lu(k,1813) - lu(k,1818) = lu(k,1818) - lu(k,1319) * lu(k,1813) - lu(k,1819) = lu(k,1819) - lu(k,1320) * lu(k,1813) - lu(k,1820) = lu(k,1820) - lu(k,1321) * lu(k,1813) - lu(k,1821) = lu(k,1821) - lu(k,1322) * lu(k,1813) - lu(k,1822) = lu(k,1822) - lu(k,1323) * lu(k,1813) - lu(k,1823) = lu(k,1823) - lu(k,1324) * lu(k,1813) - lu(k,1824) = lu(k,1824) - lu(k,1325) * lu(k,1813) - lu(k,1825) = lu(k,1825) - lu(k,1326) * lu(k,1813) - lu(k,1360) = 1._r8 / lu(k,1360) - lu(k,1361) = lu(k,1361) * lu(k,1360) - lu(k,1362) = lu(k,1362) * lu(k,1360) - lu(k,1363) = lu(k,1363) * lu(k,1360) - lu(k,1364) = lu(k,1364) * lu(k,1360) - lu(k,1365) = lu(k,1365) * lu(k,1360) - lu(k,1366) = lu(k,1366) * lu(k,1360) - lu(k,1367) = lu(k,1367) * lu(k,1360) - lu(k,1368) = lu(k,1368) * lu(k,1360) - lu(k,1369) = lu(k,1369) * lu(k,1360) - lu(k,1370) = lu(k,1370) * lu(k,1360) - lu(k,1371) = lu(k,1371) * lu(k,1360) - lu(k,1403) = lu(k,1403) - lu(k,1361) * lu(k,1402) - lu(k,1404) = lu(k,1404) - lu(k,1362) * lu(k,1402) - lu(k,1405) = lu(k,1405) - lu(k,1363) * lu(k,1402) - lu(k,1406) = lu(k,1406) - lu(k,1364) * lu(k,1402) - lu(k,1407) = lu(k,1407) - lu(k,1365) * lu(k,1402) - lu(k,1408) = lu(k,1408) - lu(k,1366) * lu(k,1402) - lu(k,1409) = lu(k,1409) - lu(k,1367) * lu(k,1402) - lu(k,1410) = lu(k,1410) - lu(k,1368) * lu(k,1402) - lu(k,1411) = lu(k,1411) - lu(k,1369) * lu(k,1402) - lu(k,1412) = lu(k,1412) - lu(k,1370) * lu(k,1402) - lu(k,1413) = lu(k,1413) - lu(k,1371) * lu(k,1402) - lu(k,1441) = lu(k,1441) - lu(k,1361) * lu(k,1440) - lu(k,1442) = lu(k,1442) - lu(k,1362) * lu(k,1440) - lu(k,1443) = lu(k,1443) - lu(k,1363) * lu(k,1440) - lu(k,1444) = lu(k,1444) - lu(k,1364) * lu(k,1440) - lu(k,1445) = lu(k,1445) - lu(k,1365) * lu(k,1440) - lu(k,1446) = lu(k,1446) - lu(k,1366) * lu(k,1440) - lu(k,1447) = lu(k,1447) - lu(k,1367) * lu(k,1440) - lu(k,1448) = lu(k,1448) - lu(k,1368) * lu(k,1440) - lu(k,1449) = lu(k,1449) - lu(k,1369) * lu(k,1440) - lu(k,1450) = lu(k,1450) - lu(k,1370) * lu(k,1440) - lu(k,1451) = lu(k,1451) - lu(k,1371) * lu(k,1440) - lu(k,1486) = lu(k,1486) - lu(k,1361) * lu(k,1485) - lu(k,1487) = lu(k,1487) - lu(k,1362) * lu(k,1485) - lu(k,1488) = lu(k,1488) - lu(k,1363) * lu(k,1485) - lu(k,1489) = lu(k,1489) - lu(k,1364) * lu(k,1485) - lu(k,1490) = lu(k,1490) - lu(k,1365) * lu(k,1485) - lu(k,1491) = lu(k,1491) - lu(k,1366) * lu(k,1485) - lu(k,1492) = lu(k,1492) - lu(k,1367) * lu(k,1485) - lu(k,1493) = lu(k,1493) - lu(k,1368) * lu(k,1485) - lu(k,1494) = lu(k,1494) - lu(k,1369) * lu(k,1485) - lu(k,1495) = lu(k,1495) - lu(k,1370) * lu(k,1485) - lu(k,1496) = lu(k,1496) - lu(k,1371) * lu(k,1485) - lu(k,1529) = lu(k,1529) - lu(k,1361) * lu(k,1528) - lu(k,1530) = lu(k,1530) - lu(k,1362) * lu(k,1528) - lu(k,1531) = lu(k,1531) - lu(k,1363) * lu(k,1528) - lu(k,1532) = lu(k,1532) - lu(k,1364) * lu(k,1528) - lu(k,1533) = lu(k,1533) - lu(k,1365) * lu(k,1528) - lu(k,1534) = lu(k,1534) - lu(k,1366) * lu(k,1528) - lu(k,1535) = lu(k,1535) - lu(k,1367) * lu(k,1528) - lu(k,1536) = lu(k,1536) - lu(k,1368) * lu(k,1528) - lu(k,1537) = lu(k,1537) - lu(k,1369) * lu(k,1528) - lu(k,1538) = lu(k,1538) - lu(k,1370) * lu(k,1528) - lu(k,1539) = lu(k,1539) - lu(k,1371) * lu(k,1528) - lu(k,1572) = lu(k,1572) - lu(k,1361) * lu(k,1571) - lu(k,1573) = lu(k,1573) - lu(k,1362) * lu(k,1571) - lu(k,1574) = lu(k,1574) - lu(k,1363) * lu(k,1571) - lu(k,1575) = lu(k,1575) - lu(k,1364) * lu(k,1571) - lu(k,1576) = lu(k,1576) - lu(k,1365) * lu(k,1571) - lu(k,1577) = lu(k,1577) - lu(k,1366) * lu(k,1571) - lu(k,1578) = lu(k,1578) - lu(k,1367) * lu(k,1571) - lu(k,1579) = lu(k,1579) - lu(k,1368) * lu(k,1571) - lu(k,1580) = lu(k,1580) - lu(k,1369) * lu(k,1571) - lu(k,1581) = lu(k,1581) - lu(k,1370) * lu(k,1571) - lu(k,1582) = lu(k,1582) - lu(k,1371) * lu(k,1571) - lu(k,1605) = lu(k,1605) - lu(k,1361) * lu(k,1604) - lu(k,1606) = lu(k,1606) - lu(k,1362) * lu(k,1604) - lu(k,1607) = lu(k,1607) - lu(k,1363) * lu(k,1604) - lu(k,1608) = lu(k,1608) - lu(k,1364) * lu(k,1604) - lu(k,1609) = lu(k,1609) - lu(k,1365) * lu(k,1604) - lu(k,1610) = lu(k,1610) - lu(k,1366) * lu(k,1604) - lu(k,1611) = lu(k,1611) - lu(k,1367) * lu(k,1604) - lu(k,1612) = lu(k,1612) - lu(k,1368) * lu(k,1604) - lu(k,1613) = lu(k,1613) - lu(k,1369) * lu(k,1604) - lu(k,1614) = lu(k,1614) - lu(k,1370) * lu(k,1604) - lu(k,1615) = lu(k,1615) - lu(k,1371) * lu(k,1604) - lu(k,1641) = lu(k,1641) - lu(k,1361) * lu(k,1640) - lu(k,1642) = lu(k,1642) - lu(k,1362) * lu(k,1640) - lu(k,1643) = lu(k,1643) - lu(k,1363) * lu(k,1640) - lu(k,1644) = lu(k,1644) - lu(k,1364) * lu(k,1640) - lu(k,1645) = lu(k,1645) - lu(k,1365) * lu(k,1640) - lu(k,1646) = lu(k,1646) - lu(k,1366) * lu(k,1640) - lu(k,1647) = lu(k,1647) - lu(k,1367) * lu(k,1640) - lu(k,1648) = lu(k,1648) - lu(k,1368) * lu(k,1640) - lu(k,1649) = lu(k,1649) - lu(k,1369) * lu(k,1640) - lu(k,1650) = lu(k,1650) - lu(k,1370) * lu(k,1640) - lu(k,1651) = lu(k,1651) - lu(k,1371) * lu(k,1640) - lu(k,1684) = lu(k,1684) - lu(k,1361) * lu(k,1683) - lu(k,1685) = lu(k,1685) - lu(k,1362) * lu(k,1683) - lu(k,1686) = lu(k,1686) - lu(k,1363) * lu(k,1683) - lu(k,1687) = lu(k,1687) - lu(k,1364) * lu(k,1683) - lu(k,1688) = lu(k,1688) - lu(k,1365) * lu(k,1683) - lu(k,1689) = lu(k,1689) - lu(k,1366) * lu(k,1683) - lu(k,1690) = lu(k,1690) - lu(k,1367) * lu(k,1683) - lu(k,1691) = lu(k,1691) - lu(k,1368) * lu(k,1683) - lu(k,1692) = lu(k,1692) - lu(k,1369) * lu(k,1683) - lu(k,1693) = lu(k,1693) - lu(k,1370) * lu(k,1683) - lu(k,1694) = lu(k,1694) - lu(k,1371) * lu(k,1683) - lu(k,1720) = lu(k,1720) - lu(k,1361) * lu(k,1719) - lu(k,1721) = lu(k,1721) - lu(k,1362) * lu(k,1719) - lu(k,1722) = lu(k,1722) - lu(k,1363) * lu(k,1719) - lu(k,1723) = lu(k,1723) - lu(k,1364) * lu(k,1719) - lu(k,1724) = lu(k,1724) - lu(k,1365) * lu(k,1719) - lu(k,1725) = lu(k,1725) - lu(k,1366) * lu(k,1719) - lu(k,1726) = lu(k,1726) - lu(k,1367) * lu(k,1719) - lu(k,1727) = lu(k,1727) - lu(k,1368) * lu(k,1719) - lu(k,1728) = lu(k,1728) - lu(k,1369) * lu(k,1719) - lu(k,1729) = lu(k,1729) - lu(k,1370) * lu(k,1719) - lu(k,1730) = lu(k,1730) - lu(k,1371) * lu(k,1719) - lu(k,1762) = lu(k,1762) - lu(k,1361) * lu(k,1761) - lu(k,1763) = lu(k,1763) - lu(k,1362) * lu(k,1761) - lu(k,1764) = lu(k,1764) - lu(k,1363) * lu(k,1761) - lu(k,1765) = lu(k,1765) - lu(k,1364) * lu(k,1761) - lu(k,1766) = lu(k,1766) - lu(k,1365) * lu(k,1761) - lu(k,1767) = lu(k,1767) - lu(k,1366) * lu(k,1761) - lu(k,1768) = lu(k,1768) - lu(k,1367) * lu(k,1761) - lu(k,1769) = lu(k,1769) - lu(k,1368) * lu(k,1761) - lu(k,1770) = lu(k,1770) - lu(k,1369) * lu(k,1761) - lu(k,1771) = lu(k,1771) - lu(k,1370) * lu(k,1761) - lu(k,1772) = lu(k,1772) - lu(k,1371) * lu(k,1761) - lu(k,1815) = lu(k,1815) - lu(k,1361) * lu(k,1814) - lu(k,1816) = lu(k,1816) - lu(k,1362) * lu(k,1814) - lu(k,1817) = lu(k,1817) - lu(k,1363) * lu(k,1814) - lu(k,1818) = lu(k,1818) - lu(k,1364) * lu(k,1814) - lu(k,1819) = lu(k,1819) - lu(k,1365) * lu(k,1814) - lu(k,1820) = lu(k,1820) - lu(k,1366) * lu(k,1814) - lu(k,1821) = lu(k,1821) - lu(k,1367) * lu(k,1814) - lu(k,1822) = lu(k,1822) - lu(k,1368) * lu(k,1814) - lu(k,1823) = lu(k,1823) - lu(k,1369) * lu(k,1814) - lu(k,1824) = lu(k,1824) - lu(k,1370) * lu(k,1814) - lu(k,1825) = lu(k,1825) - lu(k,1371) * lu(k,1814) - lu(k,1403) = 1._r8 / lu(k,1403) - lu(k,1404) = lu(k,1404) * lu(k,1403) - lu(k,1405) = lu(k,1405) * lu(k,1403) - lu(k,1406) = lu(k,1406) * lu(k,1403) - lu(k,1407) = lu(k,1407) * lu(k,1403) - lu(k,1408) = lu(k,1408) * lu(k,1403) - lu(k,1409) = lu(k,1409) * lu(k,1403) - lu(k,1410) = lu(k,1410) * lu(k,1403) - lu(k,1411) = lu(k,1411) * lu(k,1403) - lu(k,1412) = lu(k,1412) * lu(k,1403) - lu(k,1413) = lu(k,1413) * lu(k,1403) - lu(k,1442) = lu(k,1442) - lu(k,1404) * lu(k,1441) - lu(k,1443) = lu(k,1443) - lu(k,1405) * lu(k,1441) - lu(k,1444) = lu(k,1444) - lu(k,1406) * lu(k,1441) - lu(k,1445) = lu(k,1445) - lu(k,1407) * lu(k,1441) - lu(k,1446) = lu(k,1446) - lu(k,1408) * lu(k,1441) - lu(k,1447) = lu(k,1447) - lu(k,1409) * lu(k,1441) - lu(k,1448) = lu(k,1448) - lu(k,1410) * lu(k,1441) - lu(k,1449) = lu(k,1449) - lu(k,1411) * lu(k,1441) - lu(k,1450) = lu(k,1450) - lu(k,1412) * lu(k,1441) - lu(k,1451) = lu(k,1451) - lu(k,1413) * lu(k,1441) - lu(k,1487) = lu(k,1487) - lu(k,1404) * lu(k,1486) - lu(k,1488) = lu(k,1488) - lu(k,1405) * lu(k,1486) - lu(k,1489) = lu(k,1489) - lu(k,1406) * lu(k,1486) - lu(k,1490) = lu(k,1490) - lu(k,1407) * lu(k,1486) - lu(k,1491) = lu(k,1491) - lu(k,1408) * lu(k,1486) - lu(k,1492) = lu(k,1492) - lu(k,1409) * lu(k,1486) - lu(k,1493) = lu(k,1493) - lu(k,1410) * lu(k,1486) - lu(k,1494) = lu(k,1494) - lu(k,1411) * lu(k,1486) - lu(k,1495) = lu(k,1495) - lu(k,1412) * lu(k,1486) - lu(k,1496) = lu(k,1496) - lu(k,1413) * lu(k,1486) - lu(k,1530) = lu(k,1530) - lu(k,1404) * lu(k,1529) - lu(k,1531) = lu(k,1531) - lu(k,1405) * lu(k,1529) - lu(k,1532) = lu(k,1532) - lu(k,1406) * lu(k,1529) - lu(k,1533) = lu(k,1533) - lu(k,1407) * lu(k,1529) - lu(k,1534) = lu(k,1534) - lu(k,1408) * lu(k,1529) - lu(k,1535) = lu(k,1535) - lu(k,1409) * lu(k,1529) - lu(k,1536) = lu(k,1536) - lu(k,1410) * lu(k,1529) - lu(k,1537) = lu(k,1537) - lu(k,1411) * lu(k,1529) - lu(k,1538) = lu(k,1538) - lu(k,1412) * lu(k,1529) - lu(k,1539) = lu(k,1539) - lu(k,1413) * lu(k,1529) - lu(k,1573) = lu(k,1573) - lu(k,1404) * lu(k,1572) - lu(k,1574) = lu(k,1574) - lu(k,1405) * lu(k,1572) - lu(k,1575) = lu(k,1575) - lu(k,1406) * lu(k,1572) - lu(k,1576) = lu(k,1576) - lu(k,1407) * lu(k,1572) - lu(k,1577) = lu(k,1577) - lu(k,1408) * lu(k,1572) - lu(k,1578) = lu(k,1578) - lu(k,1409) * lu(k,1572) - lu(k,1579) = lu(k,1579) - lu(k,1410) * lu(k,1572) - lu(k,1580) = lu(k,1580) - lu(k,1411) * lu(k,1572) - lu(k,1581) = lu(k,1581) - lu(k,1412) * lu(k,1572) - lu(k,1582) = lu(k,1582) - lu(k,1413) * lu(k,1572) - lu(k,1606) = lu(k,1606) - lu(k,1404) * lu(k,1605) - lu(k,1607) = lu(k,1607) - lu(k,1405) * lu(k,1605) - lu(k,1608) = lu(k,1608) - lu(k,1406) * lu(k,1605) - lu(k,1609) = lu(k,1609) - lu(k,1407) * lu(k,1605) - lu(k,1610) = lu(k,1610) - lu(k,1408) * lu(k,1605) - lu(k,1611) = lu(k,1611) - lu(k,1409) * lu(k,1605) - lu(k,1612) = lu(k,1612) - lu(k,1410) * lu(k,1605) - lu(k,1613) = lu(k,1613) - lu(k,1411) * lu(k,1605) - lu(k,1614) = lu(k,1614) - lu(k,1412) * lu(k,1605) - lu(k,1615) = lu(k,1615) - lu(k,1413) * lu(k,1605) - lu(k,1642) = lu(k,1642) - lu(k,1404) * lu(k,1641) - lu(k,1643) = lu(k,1643) - lu(k,1405) * lu(k,1641) - lu(k,1644) = lu(k,1644) - lu(k,1406) * lu(k,1641) - lu(k,1645) = lu(k,1645) - lu(k,1407) * lu(k,1641) - lu(k,1646) = lu(k,1646) - lu(k,1408) * lu(k,1641) - lu(k,1647) = lu(k,1647) - lu(k,1409) * lu(k,1641) - lu(k,1648) = lu(k,1648) - lu(k,1410) * lu(k,1641) - lu(k,1649) = lu(k,1649) - lu(k,1411) * lu(k,1641) - lu(k,1650) = lu(k,1650) - lu(k,1412) * lu(k,1641) - lu(k,1651) = lu(k,1651) - lu(k,1413) * lu(k,1641) - lu(k,1685) = lu(k,1685) - lu(k,1404) * lu(k,1684) - lu(k,1686) = lu(k,1686) - lu(k,1405) * lu(k,1684) - lu(k,1687) = lu(k,1687) - lu(k,1406) * lu(k,1684) - lu(k,1688) = lu(k,1688) - lu(k,1407) * lu(k,1684) - lu(k,1689) = lu(k,1689) - lu(k,1408) * lu(k,1684) - lu(k,1690) = lu(k,1690) - lu(k,1409) * lu(k,1684) - lu(k,1691) = lu(k,1691) - lu(k,1410) * lu(k,1684) - lu(k,1692) = lu(k,1692) - lu(k,1411) * lu(k,1684) - lu(k,1693) = lu(k,1693) - lu(k,1412) * lu(k,1684) - lu(k,1694) = lu(k,1694) - lu(k,1413) * lu(k,1684) - lu(k,1721) = lu(k,1721) - lu(k,1404) * lu(k,1720) - lu(k,1722) = lu(k,1722) - lu(k,1405) * lu(k,1720) - lu(k,1723) = lu(k,1723) - lu(k,1406) * lu(k,1720) - lu(k,1724) = lu(k,1724) - lu(k,1407) * lu(k,1720) - lu(k,1725) = lu(k,1725) - lu(k,1408) * lu(k,1720) - lu(k,1726) = lu(k,1726) - lu(k,1409) * lu(k,1720) - lu(k,1727) = lu(k,1727) - lu(k,1410) * lu(k,1720) - lu(k,1728) = lu(k,1728) - lu(k,1411) * lu(k,1720) - lu(k,1729) = lu(k,1729) - lu(k,1412) * lu(k,1720) - lu(k,1730) = lu(k,1730) - lu(k,1413) * lu(k,1720) - lu(k,1763) = lu(k,1763) - lu(k,1404) * lu(k,1762) - lu(k,1764) = lu(k,1764) - lu(k,1405) * lu(k,1762) - lu(k,1765) = lu(k,1765) - lu(k,1406) * lu(k,1762) - lu(k,1766) = lu(k,1766) - lu(k,1407) * lu(k,1762) - lu(k,1767) = lu(k,1767) - lu(k,1408) * lu(k,1762) - lu(k,1768) = lu(k,1768) - lu(k,1409) * lu(k,1762) - lu(k,1769) = lu(k,1769) - lu(k,1410) * lu(k,1762) - lu(k,1770) = lu(k,1770) - lu(k,1411) * lu(k,1762) - lu(k,1771) = lu(k,1771) - lu(k,1412) * lu(k,1762) - lu(k,1772) = lu(k,1772) - lu(k,1413) * lu(k,1762) - lu(k,1816) = lu(k,1816) - lu(k,1404) * lu(k,1815) - lu(k,1817) = lu(k,1817) - lu(k,1405) * lu(k,1815) - lu(k,1818) = lu(k,1818) - lu(k,1406) * lu(k,1815) - lu(k,1819) = lu(k,1819) - lu(k,1407) * lu(k,1815) - lu(k,1820) = lu(k,1820) - lu(k,1408) * lu(k,1815) - lu(k,1821) = lu(k,1821) - lu(k,1409) * lu(k,1815) - lu(k,1822) = lu(k,1822) - lu(k,1410) * lu(k,1815) - lu(k,1823) = lu(k,1823) - lu(k,1411) * lu(k,1815) - lu(k,1824) = lu(k,1824) - lu(k,1412) * lu(k,1815) - lu(k,1825) = lu(k,1825) - lu(k,1413) * lu(k,1815) - lu(k,1442) = 1._r8 / lu(k,1442) - lu(k,1443) = lu(k,1443) * lu(k,1442) - lu(k,1444) = lu(k,1444) * lu(k,1442) - lu(k,1445) = lu(k,1445) * lu(k,1442) - lu(k,1446) = lu(k,1446) * lu(k,1442) - lu(k,1447) = lu(k,1447) * lu(k,1442) - lu(k,1448) = lu(k,1448) * lu(k,1442) - lu(k,1449) = lu(k,1449) * lu(k,1442) - lu(k,1450) = lu(k,1450) * lu(k,1442) - lu(k,1451) = lu(k,1451) * lu(k,1442) - lu(k,1488) = lu(k,1488) - lu(k,1443) * lu(k,1487) - lu(k,1489) = lu(k,1489) - lu(k,1444) * lu(k,1487) - lu(k,1490) = lu(k,1490) - lu(k,1445) * lu(k,1487) - lu(k,1491) = lu(k,1491) - lu(k,1446) * lu(k,1487) - lu(k,1492) = lu(k,1492) - lu(k,1447) * lu(k,1487) - lu(k,1493) = lu(k,1493) - lu(k,1448) * lu(k,1487) - lu(k,1494) = lu(k,1494) - lu(k,1449) * lu(k,1487) - lu(k,1495) = lu(k,1495) - lu(k,1450) * lu(k,1487) - lu(k,1496) = lu(k,1496) - lu(k,1451) * lu(k,1487) - lu(k,1531) = lu(k,1531) - lu(k,1443) * lu(k,1530) - lu(k,1532) = lu(k,1532) - lu(k,1444) * lu(k,1530) - lu(k,1533) = lu(k,1533) - lu(k,1445) * lu(k,1530) - lu(k,1534) = lu(k,1534) - lu(k,1446) * lu(k,1530) - lu(k,1535) = lu(k,1535) - lu(k,1447) * lu(k,1530) - lu(k,1536) = lu(k,1536) - lu(k,1448) * lu(k,1530) - lu(k,1537) = lu(k,1537) - lu(k,1449) * lu(k,1530) - lu(k,1538) = lu(k,1538) - lu(k,1450) * lu(k,1530) - lu(k,1539) = lu(k,1539) - lu(k,1451) * lu(k,1530) - lu(k,1574) = lu(k,1574) - lu(k,1443) * lu(k,1573) - lu(k,1575) = lu(k,1575) - lu(k,1444) * lu(k,1573) - lu(k,1576) = lu(k,1576) - lu(k,1445) * lu(k,1573) - lu(k,1577) = lu(k,1577) - lu(k,1446) * lu(k,1573) - lu(k,1578) = lu(k,1578) - lu(k,1447) * lu(k,1573) - lu(k,1579) = lu(k,1579) - lu(k,1448) * lu(k,1573) - lu(k,1580) = lu(k,1580) - lu(k,1449) * lu(k,1573) - lu(k,1581) = lu(k,1581) - lu(k,1450) * lu(k,1573) - lu(k,1582) = lu(k,1582) - lu(k,1451) * lu(k,1573) - lu(k,1607) = lu(k,1607) - lu(k,1443) * lu(k,1606) - lu(k,1608) = lu(k,1608) - lu(k,1444) * lu(k,1606) - lu(k,1609) = lu(k,1609) - lu(k,1445) * lu(k,1606) - lu(k,1610) = lu(k,1610) - lu(k,1446) * lu(k,1606) - lu(k,1611) = lu(k,1611) - lu(k,1447) * lu(k,1606) - lu(k,1612) = lu(k,1612) - lu(k,1448) * lu(k,1606) - lu(k,1613) = lu(k,1613) - lu(k,1449) * lu(k,1606) - lu(k,1614) = lu(k,1614) - lu(k,1450) * lu(k,1606) - lu(k,1615) = lu(k,1615) - lu(k,1451) * lu(k,1606) - lu(k,1643) = lu(k,1643) - lu(k,1443) * lu(k,1642) - lu(k,1644) = lu(k,1644) - lu(k,1444) * lu(k,1642) - lu(k,1645) = lu(k,1645) - lu(k,1445) * lu(k,1642) - lu(k,1646) = lu(k,1646) - lu(k,1446) * lu(k,1642) - lu(k,1647) = lu(k,1647) - lu(k,1447) * lu(k,1642) - lu(k,1648) = lu(k,1648) - lu(k,1448) * lu(k,1642) - lu(k,1649) = lu(k,1649) - lu(k,1449) * lu(k,1642) - lu(k,1650) = lu(k,1650) - lu(k,1450) * lu(k,1642) - lu(k,1651) = lu(k,1651) - lu(k,1451) * lu(k,1642) - lu(k,1686) = lu(k,1686) - lu(k,1443) * lu(k,1685) - lu(k,1687) = lu(k,1687) - lu(k,1444) * lu(k,1685) - lu(k,1688) = lu(k,1688) - lu(k,1445) * lu(k,1685) - lu(k,1689) = lu(k,1689) - lu(k,1446) * lu(k,1685) - lu(k,1690) = lu(k,1690) - lu(k,1447) * lu(k,1685) - lu(k,1691) = lu(k,1691) - lu(k,1448) * lu(k,1685) - lu(k,1692) = lu(k,1692) - lu(k,1449) * lu(k,1685) - lu(k,1693) = lu(k,1693) - lu(k,1450) * lu(k,1685) - lu(k,1694) = lu(k,1694) - lu(k,1451) * lu(k,1685) - lu(k,1722) = lu(k,1722) - lu(k,1443) * lu(k,1721) - lu(k,1723) = lu(k,1723) - lu(k,1444) * lu(k,1721) - lu(k,1724) = lu(k,1724) - lu(k,1445) * lu(k,1721) - lu(k,1725) = lu(k,1725) - lu(k,1446) * lu(k,1721) - lu(k,1726) = lu(k,1726) - lu(k,1447) * lu(k,1721) - lu(k,1727) = lu(k,1727) - lu(k,1448) * lu(k,1721) - lu(k,1728) = lu(k,1728) - lu(k,1449) * lu(k,1721) - lu(k,1729) = lu(k,1729) - lu(k,1450) * lu(k,1721) - lu(k,1730) = lu(k,1730) - lu(k,1451) * lu(k,1721) - lu(k,1764) = lu(k,1764) - lu(k,1443) * lu(k,1763) - lu(k,1765) = lu(k,1765) - lu(k,1444) * lu(k,1763) - lu(k,1766) = lu(k,1766) - lu(k,1445) * lu(k,1763) - lu(k,1767) = lu(k,1767) - lu(k,1446) * lu(k,1763) - lu(k,1768) = lu(k,1768) - lu(k,1447) * lu(k,1763) - lu(k,1769) = lu(k,1769) - lu(k,1448) * lu(k,1763) - lu(k,1770) = lu(k,1770) - lu(k,1449) * lu(k,1763) - lu(k,1771) = lu(k,1771) - lu(k,1450) * lu(k,1763) - lu(k,1772) = lu(k,1772) - lu(k,1451) * lu(k,1763) - lu(k,1817) = lu(k,1817) - lu(k,1443) * lu(k,1816) - lu(k,1818) = lu(k,1818) - lu(k,1444) * lu(k,1816) - lu(k,1819) = lu(k,1819) - lu(k,1445) * lu(k,1816) - lu(k,1820) = lu(k,1820) - lu(k,1446) * lu(k,1816) - lu(k,1821) = lu(k,1821) - lu(k,1447) * lu(k,1816) - lu(k,1822) = lu(k,1822) - lu(k,1448) * lu(k,1816) - lu(k,1823) = lu(k,1823) - lu(k,1449) * lu(k,1816) - lu(k,1824) = lu(k,1824) - lu(k,1450) * lu(k,1816) - lu(k,1825) = lu(k,1825) - lu(k,1451) * lu(k,1816) - lu(k,1488) = 1._r8 / lu(k,1488) - lu(k,1489) = lu(k,1489) * lu(k,1488) - lu(k,1490) = lu(k,1490) * lu(k,1488) - lu(k,1491) = lu(k,1491) * lu(k,1488) - lu(k,1492) = lu(k,1492) * lu(k,1488) - lu(k,1493) = lu(k,1493) * lu(k,1488) - lu(k,1494) = lu(k,1494) * lu(k,1488) - lu(k,1495) = lu(k,1495) * lu(k,1488) - lu(k,1496) = lu(k,1496) * lu(k,1488) - lu(k,1532) = lu(k,1532) - lu(k,1489) * lu(k,1531) - lu(k,1533) = lu(k,1533) - lu(k,1490) * lu(k,1531) - lu(k,1534) = lu(k,1534) - lu(k,1491) * lu(k,1531) - lu(k,1535) = lu(k,1535) - lu(k,1492) * lu(k,1531) - lu(k,1536) = lu(k,1536) - lu(k,1493) * lu(k,1531) - lu(k,1537) = lu(k,1537) - lu(k,1494) * lu(k,1531) - lu(k,1538) = lu(k,1538) - lu(k,1495) * lu(k,1531) - lu(k,1539) = lu(k,1539) - lu(k,1496) * lu(k,1531) - lu(k,1575) = lu(k,1575) - lu(k,1489) * lu(k,1574) - lu(k,1576) = lu(k,1576) - lu(k,1490) * lu(k,1574) - lu(k,1577) = lu(k,1577) - lu(k,1491) * lu(k,1574) - lu(k,1578) = lu(k,1578) - lu(k,1492) * lu(k,1574) - lu(k,1579) = lu(k,1579) - lu(k,1493) * lu(k,1574) - lu(k,1580) = lu(k,1580) - lu(k,1494) * lu(k,1574) - lu(k,1581) = lu(k,1581) - lu(k,1495) * lu(k,1574) - lu(k,1582) = lu(k,1582) - lu(k,1496) * lu(k,1574) - lu(k,1608) = lu(k,1608) - lu(k,1489) * lu(k,1607) - lu(k,1609) = lu(k,1609) - lu(k,1490) * lu(k,1607) - lu(k,1610) = lu(k,1610) - lu(k,1491) * lu(k,1607) - lu(k,1611) = lu(k,1611) - lu(k,1492) * lu(k,1607) - lu(k,1612) = lu(k,1612) - lu(k,1493) * lu(k,1607) - lu(k,1613) = lu(k,1613) - lu(k,1494) * lu(k,1607) - lu(k,1614) = lu(k,1614) - lu(k,1495) * lu(k,1607) - lu(k,1615) = lu(k,1615) - lu(k,1496) * lu(k,1607) - lu(k,1644) = lu(k,1644) - lu(k,1489) * lu(k,1643) - lu(k,1645) = lu(k,1645) - lu(k,1490) * lu(k,1643) - lu(k,1646) = lu(k,1646) - lu(k,1491) * lu(k,1643) - lu(k,1647) = lu(k,1647) - lu(k,1492) * lu(k,1643) - lu(k,1648) = lu(k,1648) - lu(k,1493) * lu(k,1643) - lu(k,1649) = lu(k,1649) - lu(k,1494) * lu(k,1643) - lu(k,1650) = lu(k,1650) - lu(k,1495) * lu(k,1643) - lu(k,1651) = lu(k,1651) - lu(k,1496) * lu(k,1643) - lu(k,1687) = lu(k,1687) - lu(k,1489) * lu(k,1686) - lu(k,1688) = lu(k,1688) - lu(k,1490) * lu(k,1686) - lu(k,1689) = lu(k,1689) - lu(k,1491) * lu(k,1686) - lu(k,1690) = lu(k,1690) - lu(k,1492) * lu(k,1686) - lu(k,1691) = lu(k,1691) - lu(k,1493) * lu(k,1686) - lu(k,1692) = lu(k,1692) - lu(k,1494) * lu(k,1686) - lu(k,1693) = lu(k,1693) - lu(k,1495) * lu(k,1686) - lu(k,1694) = lu(k,1694) - lu(k,1496) * lu(k,1686) - lu(k,1723) = lu(k,1723) - lu(k,1489) * lu(k,1722) - lu(k,1724) = lu(k,1724) - lu(k,1490) * lu(k,1722) - lu(k,1725) = lu(k,1725) - lu(k,1491) * lu(k,1722) - lu(k,1726) = lu(k,1726) - lu(k,1492) * lu(k,1722) - lu(k,1727) = lu(k,1727) - lu(k,1493) * lu(k,1722) - lu(k,1728) = lu(k,1728) - lu(k,1494) * lu(k,1722) - lu(k,1729) = lu(k,1729) - lu(k,1495) * lu(k,1722) - lu(k,1730) = lu(k,1730) - lu(k,1496) * lu(k,1722) - lu(k,1765) = lu(k,1765) - lu(k,1489) * lu(k,1764) - lu(k,1766) = lu(k,1766) - lu(k,1490) * lu(k,1764) - lu(k,1767) = lu(k,1767) - lu(k,1491) * lu(k,1764) - lu(k,1768) = lu(k,1768) - lu(k,1492) * lu(k,1764) - lu(k,1769) = lu(k,1769) - lu(k,1493) * lu(k,1764) - lu(k,1770) = lu(k,1770) - lu(k,1494) * lu(k,1764) - lu(k,1771) = lu(k,1771) - lu(k,1495) * lu(k,1764) - lu(k,1772) = lu(k,1772) - lu(k,1496) * lu(k,1764) - lu(k,1818) = lu(k,1818) - lu(k,1489) * lu(k,1817) - lu(k,1819) = lu(k,1819) - lu(k,1490) * lu(k,1817) - lu(k,1820) = lu(k,1820) - lu(k,1491) * lu(k,1817) - lu(k,1821) = lu(k,1821) - lu(k,1492) * lu(k,1817) - lu(k,1822) = lu(k,1822) - lu(k,1493) * lu(k,1817) - lu(k,1823) = lu(k,1823) - lu(k,1494) * lu(k,1817) - lu(k,1824) = lu(k,1824) - lu(k,1495) * lu(k,1817) - lu(k,1825) = lu(k,1825) - lu(k,1496) * lu(k,1817) - end do + real(r8), intent(inout) :: lu(:) + lu(1324) = 1._r8 / lu(1324) + lu(1325) = lu(1325) * lu(1324) + lu(1326) = lu(1326) * lu(1324) + lu(1327) = lu(1327) * lu(1324) + lu(1328) = lu(1328) * lu(1324) + lu(1329) = lu(1329) * lu(1324) + lu(1330) = lu(1330) * lu(1324) + lu(1331) = lu(1331) * lu(1324) + lu(1332) = lu(1332) * lu(1324) + lu(1333) = lu(1333) * lu(1324) + lu(1334) = lu(1334) * lu(1324) + lu(1367) = lu(1367) - lu(1325) * lu(1366) + lu(1368) = lu(1368) - lu(1326) * lu(1366) + lu(1369) = lu(1369) - lu(1327) * lu(1366) + lu(1370) = lu(1370) - lu(1328) * lu(1366) + lu(1371) = lu(1371) - lu(1329) * lu(1366) + lu(1372) = lu(1372) - lu(1330) * lu(1366) + lu(1373) = lu(1373) - lu(1331) * lu(1366) + lu(1374) = lu(1374) - lu(1332) * lu(1366) + lu(1375) = lu(1375) - lu(1333) * lu(1366) + lu(1376) = lu(1376) - lu(1334) * lu(1366) + lu(1409) = lu(1409) - lu(1325) * lu(1408) + lu(1410) = lu(1410) - lu(1326) * lu(1408) + lu(1411) = lu(1411) - lu(1327) * lu(1408) + lu(1412) = lu(1412) - lu(1328) * lu(1408) + lu(1413) = lu(1413) - lu(1329) * lu(1408) + lu(1414) = lu(1414) - lu(1330) * lu(1408) + lu(1415) = lu(1415) - lu(1331) * lu(1408) + lu(1416) = lu(1416) - lu(1332) * lu(1408) + lu(1417) = lu(1417) - lu(1333) * lu(1408) + lu(1418) = lu(1418) - lu(1334) * lu(1408) + lu(1451) = lu(1451) - lu(1325) * lu(1450) + lu(1452) = lu(1452) - lu(1326) * lu(1450) + lu(1453) = lu(1453) - lu(1327) * lu(1450) + lu(1454) = lu(1454) - lu(1328) * lu(1450) + lu(1455) = lu(1455) - lu(1329) * lu(1450) + lu(1456) = lu(1456) - lu(1330) * lu(1450) + lu(1457) = lu(1457) - lu(1331) * lu(1450) + lu(1458) = lu(1458) - lu(1332) * lu(1450) + lu(1459) = lu(1459) - lu(1333) * lu(1450) + lu(1460) = lu(1460) - lu(1334) * lu(1450) + lu(1506) = lu(1506) - lu(1325) * lu(1505) + lu(1507) = lu(1507) - lu(1326) * lu(1505) + lu(1508) = lu(1508) - lu(1327) * lu(1505) + lu(1509) = lu(1509) - lu(1328) * lu(1505) + lu(1510) = lu(1510) - lu(1329) * lu(1505) + lu(1511) = lu(1511) - lu(1330) * lu(1505) + lu(1512) = lu(1512) - lu(1331) * lu(1505) + lu(1513) = lu(1513) - lu(1332) * lu(1505) + lu(1514) = lu(1514) - lu(1333) * lu(1505) + lu(1515) = lu(1515) - lu(1334) * lu(1505) + lu(1538) = lu(1538) - lu(1325) * lu(1537) + lu(1539) = lu(1539) - lu(1326) * lu(1537) + lu(1540) = lu(1540) - lu(1327) * lu(1537) + lu(1541) = lu(1541) - lu(1328) * lu(1537) + lu(1542) = lu(1542) - lu(1329) * lu(1537) + lu(1543) = lu(1543) - lu(1330) * lu(1537) + lu(1544) = lu(1544) - lu(1331) * lu(1537) + lu(1545) = lu(1545) - lu(1332) * lu(1537) + lu(1546) = lu(1546) - lu(1333) * lu(1537) + lu(1547) = lu(1547) - lu(1334) * lu(1537) + lu(1573) = lu(1573) - lu(1325) * lu(1572) + lu(1574) = lu(1574) - lu(1326) * lu(1572) + lu(1575) = lu(1575) - lu(1327) * lu(1572) + lu(1576) = lu(1576) - lu(1328) * lu(1572) + lu(1577) = lu(1577) - lu(1329) * lu(1572) + lu(1578) = lu(1578) - lu(1330) * lu(1572) + lu(1579) = lu(1579) - lu(1331) * lu(1572) + lu(1580) = lu(1580) - lu(1332) * lu(1572) + lu(1581) = lu(1581) - lu(1333) * lu(1572) + lu(1582) = lu(1582) - lu(1334) * lu(1572) + lu(1611) = lu(1611) - lu(1325) * lu(1610) + lu(1612) = lu(1612) - lu(1326) * lu(1610) + lu(1613) = lu(1613) - lu(1327) * lu(1610) + lu(1614) = lu(1614) - lu(1328) * lu(1610) + lu(1615) = lu(1615) - lu(1329) * lu(1610) + lu(1616) = lu(1616) - lu(1330) * lu(1610) + lu(1617) = lu(1617) - lu(1331) * lu(1610) + lu(1618) = lu(1618) - lu(1332) * lu(1610) + lu(1619) = lu(1619) - lu(1333) * lu(1610) + lu(1620) = lu(1620) - lu(1334) * lu(1610) + lu(1650) = lu(1650) - lu(1325) * lu(1649) + lu(1651) = lu(1651) - lu(1326) * lu(1649) + lu(1652) = lu(1652) - lu(1327) * lu(1649) + lu(1653) = lu(1653) - lu(1328) * lu(1649) + lu(1654) = lu(1654) - lu(1329) * lu(1649) + lu(1655) = lu(1655) - lu(1330) * lu(1649) + lu(1656) = lu(1656) - lu(1331) * lu(1649) + lu(1657) = lu(1657) - lu(1332) * lu(1649) + lu(1658) = lu(1658) - lu(1333) * lu(1649) + lu(1659) = lu(1659) - lu(1334) * lu(1649) + lu(1684) = lu(1684) - lu(1325) * lu(1683) + lu(1685) = lu(1685) - lu(1326) * lu(1683) + lu(1686) = lu(1686) - lu(1327) * lu(1683) + lu(1687) = lu(1687) - lu(1328) * lu(1683) + lu(1688) = lu(1688) - lu(1329) * lu(1683) + lu(1689) = lu(1689) - lu(1330) * lu(1683) + lu(1690) = lu(1690) - lu(1331) * lu(1683) + lu(1691) = lu(1691) - lu(1332) * lu(1683) + lu(1692) = lu(1692) - lu(1333) * lu(1683) + lu(1693) = lu(1693) - lu(1334) * lu(1683) + lu(1736) = lu(1736) - lu(1325) * lu(1735) + lu(1737) = lu(1737) - lu(1326) * lu(1735) + lu(1738) = lu(1738) - lu(1327) * lu(1735) + lu(1739) = lu(1739) - lu(1328) * lu(1735) + lu(1740) = lu(1740) - lu(1329) * lu(1735) + lu(1741) = lu(1741) - lu(1330) * lu(1735) + lu(1742) = lu(1742) - lu(1331) * lu(1735) + lu(1743) = lu(1743) - lu(1332) * lu(1735) + lu(1744) = lu(1744) - lu(1333) * lu(1735) + lu(1745) = lu(1745) - lu(1334) * lu(1735) + lu(1367) = 1._r8 / lu(1367) + lu(1368) = lu(1368) * lu(1367) + lu(1369) = lu(1369) * lu(1367) + lu(1370) = lu(1370) * lu(1367) + lu(1371) = lu(1371) * lu(1367) + lu(1372) = lu(1372) * lu(1367) + lu(1373) = lu(1373) * lu(1367) + lu(1374) = lu(1374) * lu(1367) + lu(1375) = lu(1375) * lu(1367) + lu(1376) = lu(1376) * lu(1367) + lu(1410) = lu(1410) - lu(1368) * lu(1409) + lu(1411) = lu(1411) - lu(1369) * lu(1409) + lu(1412) = lu(1412) - lu(1370) * lu(1409) + lu(1413) = lu(1413) - lu(1371) * lu(1409) + lu(1414) = lu(1414) - lu(1372) * lu(1409) + lu(1415) = lu(1415) - lu(1373) * lu(1409) + lu(1416) = lu(1416) - lu(1374) * lu(1409) + lu(1417) = lu(1417) - lu(1375) * lu(1409) + lu(1418) = lu(1418) - lu(1376) * lu(1409) + lu(1452) = lu(1452) - lu(1368) * lu(1451) + lu(1453) = lu(1453) - lu(1369) * lu(1451) + lu(1454) = lu(1454) - lu(1370) * lu(1451) + lu(1455) = lu(1455) - lu(1371) * lu(1451) + lu(1456) = lu(1456) - lu(1372) * lu(1451) + lu(1457) = lu(1457) - lu(1373) * lu(1451) + lu(1458) = lu(1458) - lu(1374) * lu(1451) + lu(1459) = lu(1459) - lu(1375) * lu(1451) + lu(1460) = lu(1460) - lu(1376) * lu(1451) + lu(1507) = lu(1507) - lu(1368) * lu(1506) + lu(1508) = lu(1508) - lu(1369) * lu(1506) + lu(1509) = lu(1509) - lu(1370) * lu(1506) + lu(1510) = lu(1510) - lu(1371) * lu(1506) + lu(1511) = lu(1511) - lu(1372) * lu(1506) + lu(1512) = lu(1512) - lu(1373) * lu(1506) + lu(1513) = lu(1513) - lu(1374) * lu(1506) + lu(1514) = lu(1514) - lu(1375) * lu(1506) + lu(1515) = lu(1515) - lu(1376) * lu(1506) + lu(1539) = lu(1539) - lu(1368) * lu(1538) + lu(1540) = lu(1540) - lu(1369) * lu(1538) + lu(1541) = lu(1541) - lu(1370) * lu(1538) + lu(1542) = lu(1542) - lu(1371) * lu(1538) + lu(1543) = lu(1543) - lu(1372) * lu(1538) + lu(1544) = lu(1544) - lu(1373) * lu(1538) + lu(1545) = lu(1545) - lu(1374) * lu(1538) + lu(1546) = lu(1546) - lu(1375) * lu(1538) + lu(1547) = lu(1547) - lu(1376) * lu(1538) + lu(1574) = lu(1574) - lu(1368) * lu(1573) + lu(1575) = lu(1575) - lu(1369) * lu(1573) + lu(1576) = lu(1576) - lu(1370) * lu(1573) + lu(1577) = lu(1577) - lu(1371) * lu(1573) + lu(1578) = lu(1578) - lu(1372) * lu(1573) + lu(1579) = lu(1579) - lu(1373) * lu(1573) + lu(1580) = lu(1580) - lu(1374) * lu(1573) + lu(1581) = lu(1581) - lu(1375) * lu(1573) + lu(1582) = lu(1582) - lu(1376) * lu(1573) + lu(1612) = lu(1612) - lu(1368) * lu(1611) + lu(1613) = lu(1613) - lu(1369) * lu(1611) + lu(1614) = lu(1614) - lu(1370) * lu(1611) + lu(1615) = lu(1615) - lu(1371) * lu(1611) + lu(1616) = lu(1616) - lu(1372) * lu(1611) + lu(1617) = lu(1617) - lu(1373) * lu(1611) + lu(1618) = lu(1618) - lu(1374) * lu(1611) + lu(1619) = lu(1619) - lu(1375) * lu(1611) + lu(1620) = lu(1620) - lu(1376) * lu(1611) + lu(1651) = lu(1651) - lu(1368) * lu(1650) + lu(1652) = lu(1652) - lu(1369) * lu(1650) + lu(1653) = lu(1653) - lu(1370) * lu(1650) + lu(1654) = lu(1654) - lu(1371) * lu(1650) + lu(1655) = lu(1655) - lu(1372) * lu(1650) + lu(1656) = lu(1656) - lu(1373) * lu(1650) + lu(1657) = lu(1657) - lu(1374) * lu(1650) + lu(1658) = lu(1658) - lu(1375) * lu(1650) + lu(1659) = lu(1659) - lu(1376) * lu(1650) + lu(1685) = lu(1685) - lu(1368) * lu(1684) + lu(1686) = lu(1686) - lu(1369) * lu(1684) + lu(1687) = lu(1687) - lu(1370) * lu(1684) + lu(1688) = lu(1688) - lu(1371) * lu(1684) + lu(1689) = lu(1689) - lu(1372) * lu(1684) + lu(1690) = lu(1690) - lu(1373) * lu(1684) + lu(1691) = lu(1691) - lu(1374) * lu(1684) + lu(1692) = lu(1692) - lu(1375) * lu(1684) + lu(1693) = lu(1693) - lu(1376) * lu(1684) + lu(1737) = lu(1737) - lu(1368) * lu(1736) + lu(1738) = lu(1738) - lu(1369) * lu(1736) + lu(1739) = lu(1739) - lu(1370) * lu(1736) + lu(1740) = lu(1740) - lu(1371) * lu(1736) + lu(1741) = lu(1741) - lu(1372) * lu(1736) + lu(1742) = lu(1742) - lu(1373) * lu(1736) + lu(1743) = lu(1743) - lu(1374) * lu(1736) + lu(1744) = lu(1744) - lu(1375) * lu(1736) + lu(1745) = lu(1745) - lu(1376) * lu(1736) + lu(1410) = 1._r8 / lu(1410) + lu(1411) = lu(1411) * lu(1410) + lu(1412) = lu(1412) * lu(1410) + lu(1413) = lu(1413) * lu(1410) + lu(1414) = lu(1414) * lu(1410) + lu(1415) = lu(1415) * lu(1410) + lu(1416) = lu(1416) * lu(1410) + lu(1417) = lu(1417) * lu(1410) + lu(1418) = lu(1418) * lu(1410) + lu(1453) = lu(1453) - lu(1411) * lu(1452) + lu(1454) = lu(1454) - lu(1412) * lu(1452) + lu(1455) = lu(1455) - lu(1413) * lu(1452) + lu(1456) = lu(1456) - lu(1414) * lu(1452) + lu(1457) = lu(1457) - lu(1415) * lu(1452) + lu(1458) = lu(1458) - lu(1416) * lu(1452) + lu(1459) = lu(1459) - lu(1417) * lu(1452) + lu(1460) = lu(1460) - lu(1418) * lu(1452) + lu(1508) = lu(1508) - lu(1411) * lu(1507) + lu(1509) = lu(1509) - lu(1412) * lu(1507) + lu(1510) = lu(1510) - lu(1413) * lu(1507) + lu(1511) = lu(1511) - lu(1414) * lu(1507) + lu(1512) = lu(1512) - lu(1415) * lu(1507) + lu(1513) = lu(1513) - lu(1416) * lu(1507) + lu(1514) = lu(1514) - lu(1417) * lu(1507) + lu(1515) = lu(1515) - lu(1418) * lu(1507) + lu(1540) = lu(1540) - lu(1411) * lu(1539) + lu(1541) = lu(1541) - lu(1412) * lu(1539) + lu(1542) = lu(1542) - lu(1413) * lu(1539) + lu(1543) = lu(1543) - lu(1414) * lu(1539) + lu(1544) = lu(1544) - lu(1415) * lu(1539) + lu(1545) = lu(1545) - lu(1416) * lu(1539) + lu(1546) = lu(1546) - lu(1417) * lu(1539) + lu(1547) = lu(1547) - lu(1418) * lu(1539) + lu(1575) = lu(1575) - lu(1411) * lu(1574) + lu(1576) = lu(1576) - lu(1412) * lu(1574) + lu(1577) = lu(1577) - lu(1413) * lu(1574) + lu(1578) = lu(1578) - lu(1414) * lu(1574) + lu(1579) = lu(1579) - lu(1415) * lu(1574) + lu(1580) = lu(1580) - lu(1416) * lu(1574) + lu(1581) = lu(1581) - lu(1417) * lu(1574) + lu(1582) = lu(1582) - lu(1418) * lu(1574) + lu(1613) = lu(1613) - lu(1411) * lu(1612) + lu(1614) = lu(1614) - lu(1412) * lu(1612) + lu(1615) = lu(1615) - lu(1413) * lu(1612) + lu(1616) = lu(1616) - lu(1414) * lu(1612) + lu(1617) = lu(1617) - lu(1415) * lu(1612) + lu(1618) = lu(1618) - lu(1416) * lu(1612) + lu(1619) = lu(1619) - lu(1417) * lu(1612) + lu(1620) = lu(1620) - lu(1418) * lu(1612) + lu(1652) = lu(1652) - lu(1411) * lu(1651) + lu(1653) = lu(1653) - lu(1412) * lu(1651) + lu(1654) = lu(1654) - lu(1413) * lu(1651) + lu(1655) = lu(1655) - lu(1414) * lu(1651) + lu(1656) = lu(1656) - lu(1415) * lu(1651) + lu(1657) = lu(1657) - lu(1416) * lu(1651) + lu(1658) = lu(1658) - lu(1417) * lu(1651) + lu(1659) = lu(1659) - lu(1418) * lu(1651) + lu(1686) = lu(1686) - lu(1411) * lu(1685) + lu(1687) = lu(1687) - lu(1412) * lu(1685) + lu(1688) = lu(1688) - lu(1413) * lu(1685) + lu(1689) = lu(1689) - lu(1414) * lu(1685) + lu(1690) = lu(1690) - lu(1415) * lu(1685) + lu(1691) = lu(1691) - lu(1416) * lu(1685) + lu(1692) = lu(1692) - lu(1417) * lu(1685) + lu(1693) = lu(1693) - lu(1418) * lu(1685) + lu(1738) = lu(1738) - lu(1411) * lu(1737) + lu(1739) = lu(1739) - lu(1412) * lu(1737) + lu(1740) = lu(1740) - lu(1413) * lu(1737) + lu(1741) = lu(1741) - lu(1414) * lu(1737) + lu(1742) = lu(1742) - lu(1415) * lu(1737) + lu(1743) = lu(1743) - lu(1416) * lu(1737) + lu(1744) = lu(1744) - lu(1417) * lu(1737) + lu(1745) = lu(1745) - lu(1418) * lu(1737) + lu(1453) = 1._r8 / lu(1453) + lu(1454) = lu(1454) * lu(1453) + lu(1455) = lu(1455) * lu(1453) + lu(1456) = lu(1456) * lu(1453) + lu(1457) = lu(1457) * lu(1453) + lu(1458) = lu(1458) * lu(1453) + lu(1459) = lu(1459) * lu(1453) + lu(1460) = lu(1460) * lu(1453) + lu(1509) = lu(1509) - lu(1454) * lu(1508) + lu(1510) = lu(1510) - lu(1455) * lu(1508) + lu(1511) = lu(1511) - lu(1456) * lu(1508) + lu(1512) = lu(1512) - lu(1457) * lu(1508) + lu(1513) = lu(1513) - lu(1458) * lu(1508) + lu(1514) = lu(1514) - lu(1459) * lu(1508) + lu(1515) = lu(1515) - lu(1460) * lu(1508) + lu(1541) = lu(1541) - lu(1454) * lu(1540) + lu(1542) = lu(1542) - lu(1455) * lu(1540) + lu(1543) = lu(1543) - lu(1456) * lu(1540) + lu(1544) = lu(1544) - lu(1457) * lu(1540) + lu(1545) = lu(1545) - lu(1458) * lu(1540) + lu(1546) = lu(1546) - lu(1459) * lu(1540) + lu(1547) = lu(1547) - lu(1460) * lu(1540) + lu(1576) = lu(1576) - lu(1454) * lu(1575) + lu(1577) = lu(1577) - lu(1455) * lu(1575) + lu(1578) = lu(1578) - lu(1456) * lu(1575) + lu(1579) = lu(1579) - lu(1457) * lu(1575) + lu(1580) = lu(1580) - lu(1458) * lu(1575) + lu(1581) = lu(1581) - lu(1459) * lu(1575) + lu(1582) = lu(1582) - lu(1460) * lu(1575) + lu(1614) = lu(1614) - lu(1454) * lu(1613) + lu(1615) = lu(1615) - lu(1455) * lu(1613) + lu(1616) = lu(1616) - lu(1456) * lu(1613) + lu(1617) = lu(1617) - lu(1457) * lu(1613) + lu(1618) = lu(1618) - lu(1458) * lu(1613) + lu(1619) = lu(1619) - lu(1459) * lu(1613) + lu(1620) = lu(1620) - lu(1460) * lu(1613) + lu(1653) = lu(1653) - lu(1454) * lu(1652) + lu(1654) = lu(1654) - lu(1455) * lu(1652) + lu(1655) = lu(1655) - lu(1456) * lu(1652) + lu(1656) = lu(1656) - lu(1457) * lu(1652) + lu(1657) = lu(1657) - lu(1458) * lu(1652) + lu(1658) = lu(1658) - lu(1459) * lu(1652) + lu(1659) = lu(1659) - lu(1460) * lu(1652) + lu(1687) = lu(1687) - lu(1454) * lu(1686) + lu(1688) = lu(1688) - lu(1455) * lu(1686) + lu(1689) = lu(1689) - lu(1456) * lu(1686) + lu(1690) = lu(1690) - lu(1457) * lu(1686) + lu(1691) = lu(1691) - lu(1458) * lu(1686) + lu(1692) = lu(1692) - lu(1459) * lu(1686) + lu(1693) = lu(1693) - lu(1460) * lu(1686) + lu(1739) = lu(1739) - lu(1454) * lu(1738) + lu(1740) = lu(1740) - lu(1455) * lu(1738) + lu(1741) = lu(1741) - lu(1456) * lu(1738) + lu(1742) = lu(1742) - lu(1457) * lu(1738) + lu(1743) = lu(1743) - lu(1458) * lu(1738) + lu(1744) = lu(1744) - lu(1459) * lu(1738) + lu(1745) = lu(1745) - lu(1460) * lu(1738) + lu(1509) = 1._r8 / lu(1509) + lu(1510) = lu(1510) * lu(1509) + lu(1511) = lu(1511) * lu(1509) + lu(1512) = lu(1512) * lu(1509) + lu(1513) = lu(1513) * lu(1509) + lu(1514) = lu(1514) * lu(1509) + lu(1515) = lu(1515) * lu(1509) + lu(1542) = lu(1542) - lu(1510) * lu(1541) + lu(1543) = lu(1543) - lu(1511) * lu(1541) + lu(1544) = lu(1544) - lu(1512) * lu(1541) + lu(1545) = lu(1545) - lu(1513) * lu(1541) + lu(1546) = lu(1546) - lu(1514) * lu(1541) + lu(1547) = lu(1547) - lu(1515) * lu(1541) + lu(1577) = lu(1577) - lu(1510) * lu(1576) + lu(1578) = lu(1578) - lu(1511) * lu(1576) + lu(1579) = lu(1579) - lu(1512) * lu(1576) + lu(1580) = lu(1580) - lu(1513) * lu(1576) + lu(1581) = lu(1581) - lu(1514) * lu(1576) + lu(1582) = lu(1582) - lu(1515) * lu(1576) + lu(1615) = lu(1615) - lu(1510) * lu(1614) + lu(1616) = lu(1616) - lu(1511) * lu(1614) + lu(1617) = lu(1617) - lu(1512) * lu(1614) + lu(1618) = lu(1618) - lu(1513) * lu(1614) + lu(1619) = lu(1619) - lu(1514) * lu(1614) + lu(1620) = lu(1620) - lu(1515) * lu(1614) + lu(1654) = lu(1654) - lu(1510) * lu(1653) + lu(1655) = lu(1655) - lu(1511) * lu(1653) + lu(1656) = lu(1656) - lu(1512) * lu(1653) + lu(1657) = lu(1657) - lu(1513) * lu(1653) + lu(1658) = lu(1658) - lu(1514) * lu(1653) + lu(1659) = lu(1659) - lu(1515) * lu(1653) + lu(1688) = lu(1688) - lu(1510) * lu(1687) + lu(1689) = lu(1689) - lu(1511) * lu(1687) + lu(1690) = lu(1690) - lu(1512) * lu(1687) + lu(1691) = lu(1691) - lu(1513) * lu(1687) + lu(1692) = lu(1692) - lu(1514) * lu(1687) + lu(1693) = lu(1693) - lu(1515) * lu(1687) + lu(1740) = lu(1740) - lu(1510) * lu(1739) + lu(1741) = lu(1741) - lu(1511) * lu(1739) + lu(1742) = lu(1742) - lu(1512) * lu(1739) + lu(1743) = lu(1743) - lu(1513) * lu(1739) + lu(1744) = lu(1744) - lu(1514) * lu(1739) + lu(1745) = lu(1745) - lu(1515) * lu(1739) + lu(1542) = 1._r8 / lu(1542) + lu(1543) = lu(1543) * lu(1542) + lu(1544) = lu(1544) * lu(1542) + lu(1545) = lu(1545) * lu(1542) + lu(1546) = lu(1546) * lu(1542) + lu(1547) = lu(1547) * lu(1542) + lu(1578) = lu(1578) - lu(1543) * lu(1577) + lu(1579) = lu(1579) - lu(1544) * lu(1577) + lu(1580) = lu(1580) - lu(1545) * lu(1577) + lu(1581) = lu(1581) - lu(1546) * lu(1577) + lu(1582) = lu(1582) - lu(1547) * lu(1577) + lu(1616) = lu(1616) - lu(1543) * lu(1615) + lu(1617) = lu(1617) - lu(1544) * lu(1615) + lu(1618) = lu(1618) - lu(1545) * lu(1615) + lu(1619) = lu(1619) - lu(1546) * lu(1615) + lu(1620) = lu(1620) - lu(1547) * lu(1615) + lu(1655) = lu(1655) - lu(1543) * lu(1654) + lu(1656) = lu(1656) - lu(1544) * lu(1654) + lu(1657) = lu(1657) - lu(1545) * lu(1654) + lu(1658) = lu(1658) - lu(1546) * lu(1654) + lu(1659) = lu(1659) - lu(1547) * lu(1654) + lu(1689) = lu(1689) - lu(1543) * lu(1688) + lu(1690) = lu(1690) - lu(1544) * lu(1688) + lu(1691) = lu(1691) - lu(1545) * lu(1688) + lu(1692) = lu(1692) - lu(1546) * lu(1688) + lu(1693) = lu(1693) - lu(1547) * lu(1688) + lu(1741) = lu(1741) - lu(1543) * lu(1740) + lu(1742) = lu(1742) - lu(1544) * lu(1740) + lu(1743) = lu(1743) - lu(1545) * lu(1740) + lu(1744) = lu(1744) - lu(1546) * lu(1740) + lu(1745) = lu(1745) - lu(1547) * lu(1740) end subroutine lu_fac21 - subroutine lu_fac22( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac22( lu ) 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,1532) = 1._r8 / lu(k,1532) - lu(k,1533) = lu(k,1533) * lu(k,1532) - lu(k,1534) = lu(k,1534) * lu(k,1532) - lu(k,1535) = lu(k,1535) * lu(k,1532) - lu(k,1536) = lu(k,1536) * lu(k,1532) - lu(k,1537) = lu(k,1537) * lu(k,1532) - lu(k,1538) = lu(k,1538) * lu(k,1532) - lu(k,1539) = lu(k,1539) * lu(k,1532) - lu(k,1576) = lu(k,1576) - lu(k,1533) * lu(k,1575) - lu(k,1577) = lu(k,1577) - lu(k,1534) * lu(k,1575) - lu(k,1578) = lu(k,1578) - lu(k,1535) * lu(k,1575) - lu(k,1579) = lu(k,1579) - lu(k,1536) * lu(k,1575) - lu(k,1580) = lu(k,1580) - lu(k,1537) * lu(k,1575) - lu(k,1581) = lu(k,1581) - lu(k,1538) * lu(k,1575) - lu(k,1582) = lu(k,1582) - lu(k,1539) * lu(k,1575) - lu(k,1609) = lu(k,1609) - lu(k,1533) * lu(k,1608) - lu(k,1610) = lu(k,1610) - lu(k,1534) * lu(k,1608) - lu(k,1611) = lu(k,1611) - lu(k,1535) * lu(k,1608) - lu(k,1612) = lu(k,1612) - lu(k,1536) * lu(k,1608) - lu(k,1613) = lu(k,1613) - lu(k,1537) * lu(k,1608) - lu(k,1614) = lu(k,1614) - lu(k,1538) * lu(k,1608) - lu(k,1615) = lu(k,1615) - lu(k,1539) * lu(k,1608) - lu(k,1645) = lu(k,1645) - lu(k,1533) * lu(k,1644) - lu(k,1646) = lu(k,1646) - lu(k,1534) * lu(k,1644) - lu(k,1647) = lu(k,1647) - lu(k,1535) * lu(k,1644) - lu(k,1648) = lu(k,1648) - lu(k,1536) * lu(k,1644) - lu(k,1649) = lu(k,1649) - lu(k,1537) * lu(k,1644) - lu(k,1650) = lu(k,1650) - lu(k,1538) * lu(k,1644) - lu(k,1651) = lu(k,1651) - lu(k,1539) * lu(k,1644) - lu(k,1688) = lu(k,1688) - lu(k,1533) * lu(k,1687) - lu(k,1689) = lu(k,1689) - lu(k,1534) * lu(k,1687) - lu(k,1690) = lu(k,1690) - lu(k,1535) * lu(k,1687) - lu(k,1691) = lu(k,1691) - lu(k,1536) * lu(k,1687) - lu(k,1692) = lu(k,1692) - lu(k,1537) * lu(k,1687) - lu(k,1693) = lu(k,1693) - lu(k,1538) * lu(k,1687) - lu(k,1694) = lu(k,1694) - lu(k,1539) * lu(k,1687) - lu(k,1724) = lu(k,1724) - lu(k,1533) * lu(k,1723) - lu(k,1725) = lu(k,1725) - lu(k,1534) * lu(k,1723) - lu(k,1726) = lu(k,1726) - lu(k,1535) * lu(k,1723) - lu(k,1727) = lu(k,1727) - lu(k,1536) * lu(k,1723) - lu(k,1728) = lu(k,1728) - lu(k,1537) * lu(k,1723) - lu(k,1729) = lu(k,1729) - lu(k,1538) * lu(k,1723) - lu(k,1730) = lu(k,1730) - lu(k,1539) * lu(k,1723) - lu(k,1766) = lu(k,1766) - lu(k,1533) * lu(k,1765) - lu(k,1767) = lu(k,1767) - lu(k,1534) * lu(k,1765) - lu(k,1768) = lu(k,1768) - lu(k,1535) * lu(k,1765) - lu(k,1769) = lu(k,1769) - lu(k,1536) * lu(k,1765) - lu(k,1770) = lu(k,1770) - lu(k,1537) * lu(k,1765) - lu(k,1771) = lu(k,1771) - lu(k,1538) * lu(k,1765) - lu(k,1772) = lu(k,1772) - lu(k,1539) * lu(k,1765) - lu(k,1819) = lu(k,1819) - lu(k,1533) * lu(k,1818) - lu(k,1820) = lu(k,1820) - lu(k,1534) * lu(k,1818) - lu(k,1821) = lu(k,1821) - lu(k,1535) * lu(k,1818) - lu(k,1822) = lu(k,1822) - lu(k,1536) * lu(k,1818) - lu(k,1823) = lu(k,1823) - lu(k,1537) * lu(k,1818) - lu(k,1824) = lu(k,1824) - lu(k,1538) * lu(k,1818) - lu(k,1825) = lu(k,1825) - lu(k,1539) * lu(k,1818) - lu(k,1576) = 1._r8 / lu(k,1576) - lu(k,1577) = lu(k,1577) * lu(k,1576) - lu(k,1578) = lu(k,1578) * lu(k,1576) - lu(k,1579) = lu(k,1579) * lu(k,1576) - lu(k,1580) = lu(k,1580) * lu(k,1576) - lu(k,1581) = lu(k,1581) * lu(k,1576) - lu(k,1582) = lu(k,1582) * lu(k,1576) - lu(k,1610) = lu(k,1610) - lu(k,1577) * lu(k,1609) - lu(k,1611) = lu(k,1611) - lu(k,1578) * lu(k,1609) - lu(k,1612) = lu(k,1612) - lu(k,1579) * lu(k,1609) - lu(k,1613) = lu(k,1613) - lu(k,1580) * lu(k,1609) - lu(k,1614) = lu(k,1614) - lu(k,1581) * lu(k,1609) - lu(k,1615) = lu(k,1615) - lu(k,1582) * lu(k,1609) - lu(k,1646) = lu(k,1646) - lu(k,1577) * lu(k,1645) - lu(k,1647) = lu(k,1647) - lu(k,1578) * lu(k,1645) - lu(k,1648) = lu(k,1648) - lu(k,1579) * lu(k,1645) - lu(k,1649) = lu(k,1649) - lu(k,1580) * lu(k,1645) - lu(k,1650) = lu(k,1650) - lu(k,1581) * lu(k,1645) - lu(k,1651) = lu(k,1651) - lu(k,1582) * lu(k,1645) - lu(k,1689) = lu(k,1689) - lu(k,1577) * lu(k,1688) - lu(k,1690) = lu(k,1690) - lu(k,1578) * lu(k,1688) - lu(k,1691) = lu(k,1691) - lu(k,1579) * lu(k,1688) - lu(k,1692) = lu(k,1692) - lu(k,1580) * lu(k,1688) - lu(k,1693) = lu(k,1693) - lu(k,1581) * lu(k,1688) - lu(k,1694) = lu(k,1694) - lu(k,1582) * lu(k,1688) - lu(k,1725) = lu(k,1725) - lu(k,1577) * lu(k,1724) - lu(k,1726) = lu(k,1726) - lu(k,1578) * lu(k,1724) - lu(k,1727) = lu(k,1727) - lu(k,1579) * lu(k,1724) - lu(k,1728) = lu(k,1728) - lu(k,1580) * lu(k,1724) - lu(k,1729) = lu(k,1729) - lu(k,1581) * lu(k,1724) - lu(k,1730) = lu(k,1730) - lu(k,1582) * lu(k,1724) - lu(k,1767) = lu(k,1767) - lu(k,1577) * lu(k,1766) - lu(k,1768) = lu(k,1768) - lu(k,1578) * lu(k,1766) - lu(k,1769) = lu(k,1769) - lu(k,1579) * lu(k,1766) - lu(k,1770) = lu(k,1770) - lu(k,1580) * lu(k,1766) - lu(k,1771) = lu(k,1771) - lu(k,1581) * lu(k,1766) - lu(k,1772) = lu(k,1772) - lu(k,1582) * lu(k,1766) - lu(k,1820) = lu(k,1820) - lu(k,1577) * lu(k,1819) - lu(k,1821) = lu(k,1821) - lu(k,1578) * lu(k,1819) - lu(k,1822) = lu(k,1822) - lu(k,1579) * lu(k,1819) - lu(k,1823) = lu(k,1823) - lu(k,1580) * lu(k,1819) - lu(k,1824) = lu(k,1824) - lu(k,1581) * lu(k,1819) - lu(k,1825) = lu(k,1825) - lu(k,1582) * lu(k,1819) - lu(k,1610) = 1._r8 / lu(k,1610) - lu(k,1611) = lu(k,1611) * lu(k,1610) - lu(k,1612) = lu(k,1612) * lu(k,1610) - lu(k,1613) = lu(k,1613) * lu(k,1610) - lu(k,1614) = lu(k,1614) * lu(k,1610) - lu(k,1615) = lu(k,1615) * lu(k,1610) - lu(k,1647) = lu(k,1647) - lu(k,1611) * lu(k,1646) - lu(k,1648) = lu(k,1648) - lu(k,1612) * lu(k,1646) - lu(k,1649) = lu(k,1649) - lu(k,1613) * lu(k,1646) - lu(k,1650) = lu(k,1650) - lu(k,1614) * lu(k,1646) - lu(k,1651) = lu(k,1651) - lu(k,1615) * lu(k,1646) - lu(k,1690) = lu(k,1690) - lu(k,1611) * lu(k,1689) - lu(k,1691) = lu(k,1691) - lu(k,1612) * lu(k,1689) - lu(k,1692) = lu(k,1692) - lu(k,1613) * lu(k,1689) - lu(k,1693) = lu(k,1693) - lu(k,1614) * lu(k,1689) - lu(k,1694) = lu(k,1694) - lu(k,1615) * lu(k,1689) - lu(k,1726) = lu(k,1726) - lu(k,1611) * lu(k,1725) - lu(k,1727) = lu(k,1727) - lu(k,1612) * lu(k,1725) - lu(k,1728) = lu(k,1728) - lu(k,1613) * lu(k,1725) - lu(k,1729) = lu(k,1729) - lu(k,1614) * lu(k,1725) - lu(k,1730) = lu(k,1730) - lu(k,1615) * lu(k,1725) - lu(k,1768) = lu(k,1768) - lu(k,1611) * lu(k,1767) - lu(k,1769) = lu(k,1769) - lu(k,1612) * lu(k,1767) - lu(k,1770) = lu(k,1770) - lu(k,1613) * lu(k,1767) - lu(k,1771) = lu(k,1771) - lu(k,1614) * lu(k,1767) - lu(k,1772) = lu(k,1772) - lu(k,1615) * lu(k,1767) - lu(k,1821) = lu(k,1821) - lu(k,1611) * lu(k,1820) - lu(k,1822) = lu(k,1822) - lu(k,1612) * lu(k,1820) - lu(k,1823) = lu(k,1823) - lu(k,1613) * lu(k,1820) - lu(k,1824) = lu(k,1824) - lu(k,1614) * lu(k,1820) - lu(k,1825) = lu(k,1825) - lu(k,1615) * lu(k,1820) - lu(k,1647) = 1._r8 / lu(k,1647) - lu(k,1648) = lu(k,1648) * lu(k,1647) - lu(k,1649) = lu(k,1649) * lu(k,1647) - lu(k,1650) = lu(k,1650) * lu(k,1647) - lu(k,1651) = lu(k,1651) * lu(k,1647) - lu(k,1691) = lu(k,1691) - lu(k,1648) * lu(k,1690) - lu(k,1692) = lu(k,1692) - lu(k,1649) * lu(k,1690) - lu(k,1693) = lu(k,1693) - lu(k,1650) * lu(k,1690) - lu(k,1694) = lu(k,1694) - lu(k,1651) * lu(k,1690) - lu(k,1727) = lu(k,1727) - lu(k,1648) * lu(k,1726) - lu(k,1728) = lu(k,1728) - lu(k,1649) * lu(k,1726) - lu(k,1729) = lu(k,1729) - lu(k,1650) * lu(k,1726) - lu(k,1730) = lu(k,1730) - lu(k,1651) * lu(k,1726) - lu(k,1769) = lu(k,1769) - lu(k,1648) * lu(k,1768) - lu(k,1770) = lu(k,1770) - lu(k,1649) * lu(k,1768) - lu(k,1771) = lu(k,1771) - lu(k,1650) * lu(k,1768) - lu(k,1772) = lu(k,1772) - lu(k,1651) * lu(k,1768) - lu(k,1822) = lu(k,1822) - lu(k,1648) * lu(k,1821) - lu(k,1823) = lu(k,1823) - lu(k,1649) * lu(k,1821) - lu(k,1824) = lu(k,1824) - lu(k,1650) * lu(k,1821) - lu(k,1825) = lu(k,1825) - lu(k,1651) * lu(k,1821) - lu(k,1691) = 1._r8 / lu(k,1691) - lu(k,1692) = lu(k,1692) * lu(k,1691) - lu(k,1693) = lu(k,1693) * lu(k,1691) - lu(k,1694) = lu(k,1694) * lu(k,1691) - lu(k,1728) = lu(k,1728) - lu(k,1692) * lu(k,1727) - lu(k,1729) = lu(k,1729) - lu(k,1693) * lu(k,1727) - lu(k,1730) = lu(k,1730) - lu(k,1694) * lu(k,1727) - lu(k,1770) = lu(k,1770) - lu(k,1692) * lu(k,1769) - lu(k,1771) = lu(k,1771) - lu(k,1693) * lu(k,1769) - lu(k,1772) = lu(k,1772) - lu(k,1694) * lu(k,1769) - lu(k,1823) = lu(k,1823) - lu(k,1692) * lu(k,1822) - lu(k,1824) = lu(k,1824) - lu(k,1693) * lu(k,1822) - lu(k,1825) = lu(k,1825) - lu(k,1694) * lu(k,1822) - lu(k,1728) = 1._r8 / lu(k,1728) - lu(k,1729) = lu(k,1729) * lu(k,1728) - lu(k,1730) = lu(k,1730) * lu(k,1728) - lu(k,1771) = lu(k,1771) - lu(k,1729) * lu(k,1770) - lu(k,1772) = lu(k,1772) - lu(k,1730) * lu(k,1770) - lu(k,1824) = lu(k,1824) - lu(k,1729) * lu(k,1823) - lu(k,1825) = lu(k,1825) - lu(k,1730) * lu(k,1823) - lu(k,1771) = 1._r8 / lu(k,1771) - lu(k,1772) = lu(k,1772) * lu(k,1771) - lu(k,1825) = lu(k,1825) - lu(k,1772) * lu(k,1824) - lu(k,1825) = 1._r8 / lu(k,1825) - end do + real(r8), intent(inout) :: lu(:) + lu(1578) = 1._r8 / lu(1578) + lu(1579) = lu(1579) * lu(1578) + lu(1580) = lu(1580) * lu(1578) + lu(1581) = lu(1581) * lu(1578) + lu(1582) = lu(1582) * lu(1578) + lu(1617) = lu(1617) - lu(1579) * lu(1616) + lu(1618) = lu(1618) - lu(1580) * lu(1616) + lu(1619) = lu(1619) - lu(1581) * lu(1616) + lu(1620) = lu(1620) - lu(1582) * lu(1616) + lu(1656) = lu(1656) - lu(1579) * lu(1655) + lu(1657) = lu(1657) - lu(1580) * lu(1655) + lu(1658) = lu(1658) - lu(1581) * lu(1655) + lu(1659) = lu(1659) - lu(1582) * lu(1655) + lu(1690) = lu(1690) - lu(1579) * lu(1689) + lu(1691) = lu(1691) - lu(1580) * lu(1689) + lu(1692) = lu(1692) - lu(1581) * lu(1689) + lu(1693) = lu(1693) - lu(1582) * lu(1689) + lu(1742) = lu(1742) - lu(1579) * lu(1741) + lu(1743) = lu(1743) - lu(1580) * lu(1741) + lu(1744) = lu(1744) - lu(1581) * lu(1741) + lu(1745) = lu(1745) - lu(1582) * lu(1741) + lu(1617) = 1._r8 / lu(1617) + lu(1618) = lu(1618) * lu(1617) + lu(1619) = lu(1619) * lu(1617) + lu(1620) = lu(1620) * lu(1617) + lu(1657) = lu(1657) - lu(1618) * lu(1656) + lu(1658) = lu(1658) - lu(1619) * lu(1656) + lu(1659) = lu(1659) - lu(1620) * lu(1656) + lu(1691) = lu(1691) - lu(1618) * lu(1690) + lu(1692) = lu(1692) - lu(1619) * lu(1690) + lu(1693) = lu(1693) - lu(1620) * lu(1690) + lu(1743) = lu(1743) - lu(1618) * lu(1742) + lu(1744) = lu(1744) - lu(1619) * lu(1742) + lu(1745) = lu(1745) - lu(1620) * lu(1742) + lu(1657) = 1._r8 / lu(1657) + lu(1658) = lu(1658) * lu(1657) + lu(1659) = lu(1659) * lu(1657) + lu(1692) = lu(1692) - lu(1658) * lu(1691) + lu(1693) = lu(1693) - lu(1659) * lu(1691) + lu(1744) = lu(1744) - lu(1658) * lu(1743) + lu(1745) = lu(1745) - lu(1659) * lu(1743) + lu(1692) = 1._r8 / lu(1692) + lu(1693) = lu(1693) * lu(1692) + lu(1745) = lu(1745) - lu(1693) * lu(1744) + lu(1745) = 1._r8 / lu(1745) end subroutine lu_fac22 - subroutine lu_fac( avec_len, lu ) - use chem_mods, only : nzcnt + subroutine lu_fac( lu ) 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 ) - call lu_fac19( avec_len, lu ) - call lu_fac20( avec_len, lu ) - call lu_fac21( avec_len, lu ) - call lu_fac22( avec_len, lu ) + real(r8), intent(inout) :: lu(:) + call lu_fac01( lu ) + call lu_fac02( lu ) + call lu_fac03( lu ) + call lu_fac04( lu ) + call lu_fac05( lu ) + call lu_fac06( lu ) + call lu_fac07( lu ) + call lu_fac08( lu ) + call lu_fac09( lu ) + call lu_fac10( lu ) + call lu_fac11( lu ) + call lu_fac12( lu ) + call lu_fac13( lu ) + call lu_fac14( lu ) + call lu_fac15( lu ) + call lu_fac16( lu ) + call lu_fac17( lu ) + call lu_fac18( lu ) + call lu_fac19( lu ) + call lu_fac20( lu ) + call lu_fac21( lu ) + call lu_fac22( lu ) end subroutine lu_fac end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_mad/mo_lu_solve.F90 b/src/chemistry/pp_waccm_mad/mo_lu_solve.F90 index 2e836d6031..8a583fcd40 100644 --- a/src/chemistry/pp_waccm_mad/mo_lu_solve.F90 +++ b/src/chemistry/pp_waccm_mad/mo_lu_solve.F90 @@ -1,2055 +1,1933 @@ module mo_lu_solve - use chem_mods, only: veclen private public :: lu_slv contains - subroutine lu_slv01( avec_len, lu, b ) + subroutine lu_slv01( 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) + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) !----------------------------------------------------------------------- ! ... Local variables !----------------------------------------------------------------------- - integer :: k !----------------------------------------------------------------------- ! ... solve L * y = b !----------------------------------------------------------------------- - do k = 1,avec_len - b(k,81) = b(k,81) - lu(k,2) * b(k,1) - b(k,85) = b(k,85) - lu(k,3) * b(k,1) - b(k,30) = b(k,30) - lu(k,5) * b(k,2) - b(k,57) = b(k,57) - lu(k,6) * b(k,2) - b(k,68) = b(k,68) - lu(k,8) * b(k,3) - b(k,81) = b(k,81) - lu(k,9) * b(k,3) - b(k,85) = b(k,85) - lu(k,11) * b(k,4) - b(k,30) = b(k,30) - lu(k,13) * b(k,5) - b(k,57) = b(k,57) - lu(k,14) * b(k,5) - b(k,85) = b(k,85) - lu(k,15) * b(k,5) - b(k,44) = b(k,44) - lu(k,17) * b(k,6) - b(k,85) = b(k,85) - lu(k,18) * b(k,6) - b(k,30) = b(k,30) - lu(k,20) * b(k,7) - b(k,86) = b(k,86) - lu(k,21) * b(k,7) - b(k,71) = b(k,71) - lu(k,23) * b(k,8) - b(k,73) = b(k,73) - lu(k,24) * b(k,8) - b(k,88) = b(k,88) - lu(k,25) * b(k,8) - b(k,71) = b(k,71) - lu(k,27) * b(k,9) - b(k,82) = b(k,82) - lu(k,28) * b(k,9) - b(k,88) = b(k,88) - lu(k,29) * b(k,9) - b(k,36) = b(k,36) - lu(k,31) * b(k,10) - b(k,75) = b(k,75) - lu(k,32) * b(k,10) - b(k,21) = b(k,21) - lu(k,34) * b(k,11) - b(k,63) = b(k,63) - lu(k,35) * b(k,11) - b(k,69) = b(k,69) - lu(k,36) * b(k,11) - b(k,86) = b(k,86) - lu(k,37) * b(k,11) - b(k,88) = b(k,88) - lu(k,38) * b(k,11) - b(k,39) = b(k,39) - lu(k,40) * b(k,12) - b(k,56) = b(k,56) - lu(k,41) * b(k,12) - b(k,63) = b(k,63) - lu(k,42) * b(k,12) - b(k,86) = b(k,86) - lu(k,43) * b(k,12) - b(k,88) = b(k,88) - lu(k,44) * b(k,12) - b(k,24) = b(k,24) - lu(k,46) * b(k,13) - b(k,65) = b(k,65) - lu(k,47) * b(k,13) - b(k,69) = b(k,69) - lu(k,48) * b(k,13) - b(k,87) = b(k,87) - lu(k,49) * b(k,13) - b(k,88) = b(k,88) - lu(k,50) * b(k,13) - b(k,61) = b(k,61) - lu(k,52) * b(k,14) - b(k,63) = b(k,63) - lu(k,53) * b(k,14) - b(k,72) = b(k,72) - lu(k,54) * b(k,14) - b(k,74) = b(k,74) - lu(k,55) * b(k,14) - b(k,75) = b(k,75) - lu(k,56) * b(k,14) - b(k,88) = b(k,88) - lu(k,57) * b(k,14) - b(k,16) = b(k,16) - lu(k,59) * b(k,15) - b(k,19) = b(k,19) - lu(k,60) * b(k,15) - b(k,31) = b(k,31) - lu(k,61) * b(k,15) - b(k,38) = b(k,38) - lu(k,62) * b(k,15) - b(k,68) = b(k,68) - lu(k,63) * b(k,15) - b(k,87) = b(k,87) - lu(k,64) * b(k,15) - b(k,19) = b(k,19) - lu(k,66) * b(k,16) - b(k,38) = b(k,38) - lu(k,67) * b(k,16) - b(k,68) = b(k,68) - lu(k,68) * b(k,16) - b(k,75) = b(k,75) - lu(k,69) * b(k,16) - b(k,77) = b(k,77) - lu(k,70) * b(k,16) - b(k,28) = b(k,28) - lu(k,72) * b(k,17) - b(k,44) = b(k,44) - lu(k,73) * b(k,17) - b(k,52) = b(k,52) - lu(k,74) * b(k,17) - b(k,68) = b(k,68) - lu(k,75) * b(k,17) - b(k,71) = b(k,71) - lu(k,76) * b(k,17) - b(k,72) = b(k,72) - lu(k,77) * b(k,17) - b(k,74) = b(k,74) - lu(k,78) * b(k,17) - b(k,61) = b(k,61) - lu(k,80) * b(k,18) - b(k,63) = b(k,63) - lu(k,81) * b(k,18) - b(k,68) = b(k,68) - lu(k,82) * b(k,18) - b(k,80) = b(k,80) - lu(k,83) * b(k,18) - b(k,85) = b(k,85) - lu(k,84) * b(k,18) - b(k,88) = b(k,88) - lu(k,85) * b(k,18) - b(k,29) = b(k,29) - lu(k,87) * b(k,19) - b(k,38) = b(k,38) - lu(k,88) * b(k,19) - b(k,40) = b(k,40) - lu(k,89) * b(k,19) - b(k,66) = b(k,66) - lu(k,90) * b(k,19) - b(k,68) = b(k,68) - lu(k,91) * b(k,19) - b(k,69) = b(k,69) - lu(k,92) * b(k,19) - b(k,75) = b(k,75) - lu(k,93) * b(k,19) - b(k,77) = b(k,77) - lu(k,94) * b(k,19) - b(k,49) = b(k,49) - lu(k,96) * b(k,20) - b(k,59) = b(k,59) - lu(k,97) * b(k,20) - b(k,68) = b(k,68) - lu(k,98) * b(k,20) - b(k,75) = b(k,75) - lu(k,99) * b(k,20) - b(k,76) = b(k,76) - lu(k,100) * b(k,20) - b(k,78) = b(k,78) - lu(k,101) * b(k,20) - b(k,26) = b(k,26) - lu(k,103) * b(k,21) - b(k,65) = b(k,65) - lu(k,104) * b(k,21) - b(k,69) = b(k,69) - lu(k,105) * b(k,21) - b(k,86) = b(k,86) - lu(k,106) * b(k,21) - b(k,88) = b(k,88) - lu(k,107) * b(k,21) - b(k,23) = b(k,23) - lu(k,109) * b(k,22) - b(k,66) = b(k,66) - lu(k,110) * b(k,22) - b(k,69) = b(k,69) - lu(k,111) * b(k,22) - b(k,70) = b(k,70) - lu(k,112) * b(k,22) - b(k,78) = b(k,78) - lu(k,113) * b(k,22) - b(k,87) = b(k,87) - lu(k,114) * b(k,22) - b(k,88) = b(k,88) - lu(k,115) * b(k,22) - b(k,66) = b(k,66) - lu(k,117) * b(k,23) - b(k,69) = b(k,69) - lu(k,118) * b(k,23) - b(k,70) = b(k,70) - lu(k,119) * b(k,23) - b(k,78) = b(k,78) - lu(k,120) * b(k,23) - b(k,87) = b(k,87) - lu(k,121) * b(k,23) - b(k,88) = b(k,88) - lu(k,122) * b(k,23) - b(k,63) = b(k,63) - lu(k,124) * b(k,24) - b(k,72) = b(k,72) - lu(k,125) * b(k,24) - b(k,87) = b(k,87) - lu(k,126) * b(k,24) - b(k,88) = b(k,88) - lu(k,127) * b(k,24) - b(k,61) = b(k,61) - lu(k,129) * b(k,25) - b(k,63) = b(k,63) - lu(k,130) * b(k,25) - b(k,78) = b(k,78) - lu(k,131) * b(k,25) - b(k,86) = b(k,86) - lu(k,132) * b(k,25) - b(k,65) = b(k,65) - lu(k,135) * b(k,26) - b(k,69) = b(k,69) - lu(k,136) * b(k,26) - b(k,86) = b(k,86) - lu(k,137) * b(k,26) - b(k,88) = b(k,88) - lu(k,138) * b(k,26) - b(k,63) = b(k,63) - lu(k,143) * b(k,27) - b(k,65) = b(k,65) - lu(k,144) * b(k,27) - b(k,69) = b(k,69) - lu(k,145) * b(k,27) - b(k,75) = b(k,75) - lu(k,146) * b(k,27) - b(k,77) = b(k,77) - lu(k,147) * b(k,27) - b(k,86) = b(k,86) - lu(k,148) * b(k,27) - b(k,88) = b(k,88) - lu(k,149) * b(k,27) - b(k,44) = b(k,44) - lu(k,152) * b(k,28) - b(k,52) = b(k,52) - lu(k,153) * b(k,28) - b(k,63) = b(k,63) - lu(k,154) * b(k,28) - b(k,68) = b(k,68) - lu(k,155) * b(k,28) - b(k,80) = b(k,80) - lu(k,156) * b(k,28) - b(k,85) = b(k,85) - lu(k,157) * b(k,28) - b(k,88) = b(k,88) - lu(k,158) * b(k,28) - b(k,31) = b(k,31) - lu(k,160) * b(k,29) - b(k,38) = b(k,38) - lu(k,161) * b(k,29) - b(k,40) = b(k,40) - lu(k,162) * b(k,29) - b(k,57) = b(k,57) - lu(k,163) * b(k,29) - b(k,68) = b(k,68) - lu(k,164) * b(k,29) - b(k,75) = b(k,75) - lu(k,165) * b(k,29) - b(k,87) = b(k,87) - lu(k,166) * b(k,29) - b(k,39) = b(k,39) - lu(k,169) * b(k,30) - b(k,50) = b(k,50) - lu(k,170) * b(k,30) - b(k,63) = b(k,63) - lu(k,171) * b(k,30) - b(k,71) = b(k,71) - lu(k,172) * b(k,30) - b(k,74) = b(k,74) - lu(k,173) * b(k,30) - b(k,86) = b(k,86) - lu(k,174) * b(k,30) - b(k,88) = b(k,88) - lu(k,175) * b(k,30) - b(k,38) = b(k,38) - lu(k,177) * b(k,31) - b(k,40) = b(k,40) - lu(k,178) * b(k,31) - b(k,66) = b(k,66) - lu(k,179) * b(k,31) - b(k,68) = b(k,68) - lu(k,180) * b(k,31) - b(k,75) = b(k,75) - lu(k,181) * b(k,31) - b(k,77) = b(k,77) - lu(k,182) * b(k,31) - b(k,63) = b(k,63) - lu(k,185) * b(k,32) - b(k,68) = b(k,68) - lu(k,186) * b(k,32) - b(k,80) = b(k,80) - lu(k,187) * b(k,32) - b(k,81) = b(k,81) - lu(k,188) * b(k,32) - b(k,85) = b(k,85) - lu(k,189) * b(k,32) - b(k,88) = b(k,88) - lu(k,190) * b(k,32) - b(k,44) = b(k,44) - lu(k,192) * b(k,33) - b(k,52) = b(k,52) - lu(k,193) * b(k,33) - b(k,57) = b(k,57) - lu(k,194) * b(k,33) - b(k,63) = b(k,63) - lu(k,195) * b(k,33) - b(k,68) = b(k,68) - lu(k,196) * b(k,33) - b(k,86) = b(k,86) - lu(k,197) * b(k,33) - b(k,88) = b(k,88) - lu(k,198) * b(k,33) - b(k,63) = b(k,63) - lu(k,202) * b(k,34) - b(k,68) = b(k,68) - lu(k,203) * b(k,34) - b(k,71) = b(k,71) - lu(k,204) * b(k,34) - b(k,72) = b(k,72) - lu(k,205) * b(k,34) - b(k,74) = b(k,74) - lu(k,206) * b(k,34) - b(k,80) = b(k,80) - lu(k,207) * b(k,34) - b(k,81) = b(k,81) - lu(k,208) * b(k,34) - b(k,85) = b(k,85) - lu(k,209) * b(k,34) - b(k,88) = b(k,88) - lu(k,210) * b(k,34) - b(k,58) = b(k,58) - lu(k,212) * b(k,35) - b(k,62) = b(k,62) - lu(k,213) * b(k,35) - b(k,68) = b(k,68) - lu(k,214) * b(k,35) - b(k,72) = b(k,72) - lu(k,215) * b(k,35) - b(k,75) = b(k,75) - lu(k,216) * b(k,35) - b(k,85) = b(k,85) - lu(k,217) * b(k,35) - b(k,87) = b(k,87) - lu(k,218) * b(k,35) - b(k,41) = b(k,41) - lu(k,220) * b(k,36) - b(k,69) = b(k,69) - lu(k,221) * b(k,36) - b(k,75) = b(k,75) - lu(k,222) * b(k,36) - b(k,76) = b(k,76) - lu(k,223) * b(k,36) - b(k,77) = b(k,77) - lu(k,224) * b(k,36) - b(k,79) = b(k,79) - lu(k,225) * b(k,36) - b(k,84) = b(k,84) - lu(k,226) * b(k,36) - b(k,51) = b(k,51) - lu(k,230) * b(k,37) - b(k,53) = b(k,53) - lu(k,231) * b(k,37) - b(k,55) = b(k,55) - lu(k,232) * b(k,37) - b(k,68) = b(k,68) - lu(k,233) * b(k,37) - b(k,71) = b(k,71) - lu(k,234) * b(k,37) - b(k,72) = b(k,72) - lu(k,235) * b(k,37) - b(k,73) = b(k,73) - lu(k,236) * b(k,37) - b(k,74) = b(k,74) - lu(k,237) * b(k,37) - b(k,82) = b(k,82) - lu(k,238) * b(k,37) - b(k,87) = b(k,87) - lu(k,239) * b(k,37) - b(k,88) = b(k,88) - lu(k,240) * b(k,37) - b(k,40) = b(k,40) - lu(k,245) * b(k,38) - b(k,57) = b(k,57) - lu(k,246) * b(k,38) - b(k,61) = b(k,61) - lu(k,247) * b(k,38) - b(k,63) = b(k,63) - lu(k,248) * b(k,38) - b(k,66) = b(k,66) - lu(k,249) * b(k,38) - b(k,68) = b(k,68) - lu(k,250) * b(k,38) - b(k,75) = b(k,75) - lu(k,251) * b(k,38) - b(k,77) = b(k,77) - lu(k,252) * b(k,38) - b(k,78) = b(k,78) - lu(k,253) * b(k,38) - b(k,86) = b(k,86) - lu(k,254) * b(k,38) - b(k,87) = b(k,87) - lu(k,255) * b(k,38) - end do + b(72) = b(72) - lu(2) * b(1) + b(74) = b(74) - lu(3) * b(1) + b(29) = b(29) - lu(5) * b(2) + b(57) = b(57) - lu(6) * b(2) + b(72) = b(72) - lu(8) * b(3) + b(81) = b(81) - lu(9) * b(3) + b(74) = b(74) - lu(11) * b(4) + b(29) = b(29) - lu(13) * b(5) + b(57) = b(57) - lu(14) * b(5) + b(74) = b(74) - lu(15) * b(5) + b(44) = b(44) - lu(17) * b(6) + b(74) = b(74) - lu(18) * b(6) + b(29) = b(29) - lu(20) * b(7) + b(68) = b(68) - lu(21) * b(7) + b(34) = b(34) - lu(23) * b(8) + b(73) = b(73) - lu(24) * b(8) + b(78) = b(78) - lu(26) * b(9) + b(85) = b(85) - lu(27) * b(9) + b(87) = b(87) - lu(28) * b(9) + b(80) = b(80) - lu(30) * b(10) + b(85) = b(85) - lu(31) * b(10) + b(87) = b(87) - lu(32) * b(10) + b(40) = b(40) - lu(34) * b(11) + b(56) = b(56) - lu(35) * b(11) + b(62) = b(62) - lu(36) * b(11) + b(68) = b(68) - lu(37) * b(11) + b(87) = b(87) - lu(38) * b(11) + b(24) = b(24) - lu(40) * b(12) + b(62) = b(62) - lu(41) * b(12) + b(68) = b(68) - lu(42) * b(12) + b(79) = b(79) - lu(43) * b(12) + b(87) = b(87) - lu(44) * b(12) + b(25) = b(25) - lu(46) * b(13) + b(70) = b(70) - lu(47) * b(13) + b(77) = b(77) - lu(48) * b(13) + b(79) = b(79) - lu(49) * b(13) + b(87) = b(87) - lu(50) * b(13) + b(48) = b(48) - lu(52) * b(14) + b(58) = b(58) - lu(53) * b(14) + b(73) = b(73) - lu(54) * b(14) + b(75) = b(75) - lu(55) * b(14) + b(81) = b(81) - lu(56) * b(14) + b(61) = b(61) - lu(58) * b(15) + b(62) = b(62) - lu(59) * b(15) + b(71) = b(71) - lu(60) * b(15) + b(73) = b(73) - lu(61) * b(15) + b(86) = b(86) - lu(62) * b(15) + b(87) = b(87) - lu(63) * b(15) + b(17) = b(17) - lu(65) * b(16) + b(65) = b(65) - lu(66) * b(16) + b(69) = b(69) - lu(67) * b(16) + b(77) = b(77) - lu(68) * b(16) + b(79) = b(79) - lu(69) * b(16) + b(87) = b(87) - lu(70) * b(16) + b(65) = b(65) - lu(72) * b(17) + b(69) = b(69) - lu(73) * b(17) + b(77) = b(77) - lu(74) * b(17) + b(79) = b(79) - lu(75) * b(17) + b(87) = b(87) - lu(76) * b(17) + b(19) = b(19) - lu(78) * b(18) + b(22) = b(22) - lu(79) * b(18) + b(31) = b(31) - lu(80) * b(18) + b(35) = b(35) - lu(81) * b(18) + b(77) = b(77) - lu(82) * b(18) + b(81) = b(81) - lu(83) * b(18) + b(22) = b(22) - lu(85) * b(19) + b(35) = b(35) - lu(86) * b(19) + b(73) = b(73) - lu(87) * b(19) + b(76) = b(76) - lu(88) * b(19) + b(81) = b(81) - lu(89) * b(19) + b(30) = b(30) - lu(91) * b(20) + b(44) = b(44) - lu(92) * b(20) + b(50) = b(50) - lu(93) * b(20) + b(71) = b(71) - lu(94) * b(20) + b(81) = b(81) - lu(95) * b(20) + b(85) = b(85) - lu(96) * b(20) + b(86) = b(86) - lu(97) * b(20) + b(61) = b(61) - lu(99) * b(21) + b(62) = b(62) - lu(100) * b(21) + b(68) = b(68) - lu(101) * b(21) + b(28) = b(28) - lu(103) * b(22) + b(35) = b(35) - lu(104) * b(22) + b(39) = b(39) - lu(105) * b(22) + b(65) = b(65) - lu(106) * b(22) + b(73) = b(73) - lu(107) * b(22) + b(76) = b(76) - lu(108) * b(22) + b(79) = b(79) - lu(109) * b(22) + b(81) = b(81) - lu(110) * b(22) + b(61) = b(61) - lu(112) * b(23) + b(62) = b(62) - lu(113) * b(23) + b(67) = b(67) - lu(114) * b(23) + b(74) = b(74) - lu(115) * b(23) + b(81) = b(81) - lu(116) * b(23) + b(87) = b(87) - lu(117) * b(23) + b(26) = b(26) - lu(119) * b(24) + b(68) = b(68) - lu(120) * b(24) + b(70) = b(70) - lu(121) * b(24) + b(79) = b(79) - lu(122) * b(24) + b(87) = b(87) - lu(123) * b(24) + b(62) = b(62) - lu(125) * b(25) + b(71) = b(71) - lu(126) * b(25) + b(77) = b(77) - lu(127) * b(25) + b(87) = b(87) - lu(128) * b(25) + b(68) = b(68) - lu(131) * b(26) + b(70) = b(70) - lu(132) * b(26) + b(79) = b(79) - lu(133) * b(26) + b(87) = b(87) - lu(134) * b(26) + b(62) = b(62) - lu(139) * b(27) + b(68) = b(68) - lu(140) * b(27) + b(70) = b(70) - lu(141) * b(27) + b(73) = b(73) - lu(142) * b(27) + b(76) = b(76) - lu(143) * b(27) + b(79) = b(79) - lu(144) * b(27) + b(87) = b(87) - lu(145) * b(27) + b(31) = b(31) - lu(147) * b(28) + b(35) = b(35) - lu(148) * b(28) + b(39) = b(39) - lu(149) * b(28) + b(57) = b(57) - lu(150) * b(28) + b(73) = b(73) - lu(151) * b(28) + b(77) = b(77) - lu(152) * b(28) + b(81) = b(81) - lu(153) * b(28) + b(40) = b(40) - lu(156) * b(29) + b(51) = b(51) - lu(157) * b(29) + b(62) = b(62) - lu(158) * b(29) + b(68) = b(68) - lu(159) * b(29) + b(85) = b(85) - lu(160) * b(29) + b(86) = b(86) - lu(161) * b(29) + b(87) = b(87) - lu(162) * b(29) + b(44) = b(44) - lu(165) * b(30) + b(50) = b(50) - lu(166) * b(30) + b(62) = b(62) - lu(167) * b(30) + b(67) = b(67) - lu(168) * b(30) + b(74) = b(74) - lu(169) * b(30) + b(81) = b(81) - lu(170) * b(30) + b(87) = b(87) - lu(171) * b(30) + b(35) = b(35) - lu(173) * b(31) + b(39) = b(39) - lu(174) * b(31) + b(65) = b(65) - lu(175) * b(31) + b(73) = b(73) - lu(176) * b(31) + b(76) = b(76) - lu(177) * b(31) + b(81) = b(81) - lu(178) * b(31) + b(44) = b(44) - lu(180) * b(32) + b(50) = b(50) - lu(181) * b(32) + b(57) = b(57) - lu(182) * b(32) + b(62) = b(62) - lu(183) * b(32) + b(68) = b(68) - lu(184) * b(32) + b(81) = b(81) - lu(185) * b(32) + b(87) = b(87) - lu(186) * b(32) + b(62) = b(62) - lu(189) * b(33) + b(67) = b(67) - lu(190) * b(33) + b(72) = b(72) - lu(191) * b(33) + b(74) = b(74) - lu(192) * b(33) + b(81) = b(81) - lu(193) * b(33) + b(87) = b(87) - lu(194) * b(33) + b(42) = b(42) - lu(196) * b(34) + b(73) = b(73) - lu(197) * b(34) + b(75) = b(75) - lu(198) * b(34) + b(76) = b(76) - lu(199) * b(34) + b(79) = b(79) - lu(200) * b(34) + b(83) = b(83) - lu(201) * b(34) + b(84) = b(84) - lu(202) * b(34) + b(39) = b(39) - lu(207) * b(35) + b(57) = b(57) - lu(208) * b(35) + b(61) = b(61) - lu(209) * b(35) + b(62) = b(62) - lu(210) * b(35) + b(65) = b(65) - lu(211) * b(35) + b(68) = b(68) - lu(212) * b(35) + b(73) = b(73) - lu(213) * b(35) + b(76) = b(76) - lu(214) * b(35) + b(77) = b(77) - lu(215) * b(35) + b(81) = b(81) - lu(216) * b(35) + b(62) = b(62) - lu(220) * b(36) + b(67) = b(67) - lu(221) * b(36) + b(71) = b(71) - lu(222) * b(36) + b(72) = b(72) - lu(223) * b(36) + b(74) = b(74) - lu(224) * b(36) + b(81) = b(81) - lu(225) * b(36) + b(85) = b(85) - lu(226) * b(36) + b(86) = b(86) - lu(227) * b(36) + b(87) = b(87) - lu(228) * b(36) + b(59) = b(59) - lu(230) * b(37) + b(64) = b(64) - lu(231) * b(37) + b(71) = b(71) - lu(232) * b(37) + b(73) = b(73) - lu(233) * b(37) + b(74) = b(74) - lu(234) * b(37) + b(77) = b(77) - lu(235) * b(37) + b(81) = b(81) - lu(236) * b(37) + b(52) = b(52) - lu(240) * b(38) + b(53) = b(53) - lu(241) * b(38) + b(55) = b(55) - lu(242) * b(38) + b(71) = b(71) - lu(243) * b(38) + b(77) = b(77) - lu(244) * b(38) + b(78) = b(78) - lu(245) * b(38) + b(80) = b(80) - lu(246) * b(38) + b(81) = b(81) - lu(247) * b(38) + b(85) = b(85) - lu(248) * b(38) + b(86) = b(86) - lu(249) * b(38) + b(87) = b(87) - lu(250) * b(38) + b(57) = b(57) - lu(254) * b(39) + b(61) = b(61) - lu(255) * b(39) + b(62) = b(62) - lu(256) * b(39) + b(65) = b(65) - lu(257) * b(39) + b(68) = b(68) - lu(258) * b(39) + b(71) = b(71) - lu(259) * b(39) + b(73) = b(73) - lu(260) * b(39) + b(76) = b(76) - lu(261) * b(39) + b(77) = b(77) - lu(262) * b(39) + b(79) = b(79) - lu(263) * b(39) + b(81) = b(81) - lu(264) * b(39) end subroutine lu_slv01 - subroutine lu_slv02( avec_len, lu, b ) + subroutine lu_slv02( 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) + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) !----------------------------------------------------------------------- ! ... Local variables !----------------------------------------------------------------------- - integer :: k !----------------------------------------------------------------------- ! ... solve L * y = b !----------------------------------------------------------------------- - do k = 1,avec_len - b(k,56) = b(k,56) - lu(k,258) * b(k,39) - b(k,61) = b(k,61) - lu(k,259) * b(k,39) - b(k,63) = b(k,63) - lu(k,260) * b(k,39) - b(k,72) = b(k,72) - lu(k,261) * b(k,39) - b(k,75) = b(k,75) - lu(k,262) * b(k,39) - b(k,81) = b(k,81) - lu(k,263) * b(k,39) - b(k,85) = b(k,85) - lu(k,264) * b(k,39) - b(k,86) = b(k,86) - lu(k,265) * b(k,39) - b(k,87) = b(k,87) - lu(k,266) * b(k,39) - b(k,88) = b(k,88) - lu(k,267) * b(k,39) - b(k,57) = b(k,57) - lu(k,271) * b(k,40) - b(k,61) = b(k,61) - lu(k,272) * b(k,40) - b(k,63) = b(k,63) - lu(k,273) * b(k,40) - b(k,66) = b(k,66) - lu(k,274) * b(k,40) - b(k,68) = b(k,68) - lu(k,275) * b(k,40) - b(k,69) = b(k,69) - lu(k,276) * b(k,40) - b(k,72) = b(k,72) - lu(k,277) * b(k,40) - b(k,75) = b(k,75) - lu(k,278) * b(k,40) - b(k,77) = b(k,77) - lu(k,279) * b(k,40) - b(k,78) = b(k,78) - lu(k,280) * b(k,40) - b(k,86) = b(k,86) - lu(k,281) * b(k,40) - b(k,87) = b(k,87) - lu(k,282) * b(k,40) - b(k,63) = b(k,63) - lu(k,286) * b(k,41) - b(k,65) = b(k,65) - lu(k,287) * b(k,41) - b(k,68) = b(k,68) - lu(k,288) * b(k,41) - b(k,69) = b(k,69) - lu(k,289) * b(k,41) - b(k,75) = b(k,75) - lu(k,290) * b(k,41) - b(k,76) = b(k,76) - lu(k,291) * b(k,41) - b(k,77) = b(k,77) - lu(k,292) * b(k,41) - b(k,79) = b(k,79) - lu(k,293) * b(k,41) - b(k,84) = b(k,84) - lu(k,294) * b(k,41) - b(k,86) = b(k,86) - lu(k,295) * b(k,41) - b(k,88) = b(k,88) - lu(k,296) * b(k,41) - b(k,63) = b(k,63) - lu(k,298) * b(k,42) - b(k,65) = b(k,65) - lu(k,299) * b(k,42) - b(k,66) = b(k,66) - lu(k,300) * b(k,42) - b(k,67) = b(k,67) - lu(k,301) * b(k,42) - b(k,70) = b(k,70) - lu(k,302) * b(k,42) - b(k,73) = b(k,73) - lu(k,303) * b(k,42) - b(k,75) = b(k,75) - lu(k,304) * b(k,42) - b(k,77) = b(k,77) - lu(k,305) * b(k,42) - b(k,78) = b(k,78) - lu(k,306) * b(k,42) - b(k,82) = b(k,82) - lu(k,307) * b(k,42) - b(k,86) = b(k,86) - lu(k,308) * b(k,42) - b(k,87) = b(k,87) - lu(k,309) * b(k,42) - b(k,88) = b(k,88) - lu(k,310) * b(k,42) - b(k,54) = b(k,54) - lu(k,312) * b(k,43) - b(k,65) = b(k,65) - lu(k,313) * b(k,43) - b(k,66) = b(k,66) - lu(k,314) * b(k,43) - b(k,67) = b(k,67) - lu(k,315) * b(k,43) - b(k,68) = b(k,68) - lu(k,316) * b(k,43) - b(k,70) = b(k,70) - lu(k,317) * b(k,43) - b(k,73) = b(k,73) - lu(k,318) * b(k,43) - b(k,75) = b(k,75) - lu(k,319) * b(k,43) - b(k,77) = b(k,77) - lu(k,320) * b(k,43) - b(k,78) = b(k,78) - lu(k,321) * b(k,43) - b(k,82) = b(k,82) - lu(k,322) * b(k,43) - b(k,86) = b(k,86) - lu(k,323) * b(k,43) - b(k,87) = b(k,87) - lu(k,324) * b(k,43) - b(k,88) = b(k,88) - lu(k,325) * b(k,43) - b(k,52) = b(k,52) - lu(k,329) * b(k,44) - b(k,56) = b(k,56) - lu(k,330) * b(k,44) - b(k,57) = b(k,57) - lu(k,331) * b(k,44) - b(k,61) = b(k,61) - lu(k,332) * b(k,44) - b(k,63) = b(k,63) - lu(k,333) * b(k,44) - b(k,68) = b(k,68) - lu(k,334) * b(k,44) - b(k,75) = b(k,75) - lu(k,335) * b(k,44) - b(k,78) = b(k,78) - lu(k,336) * b(k,44) - b(k,79) = b(k,79) - lu(k,337) * b(k,44) - b(k,86) = b(k,86) - lu(k,338) * b(k,44) - b(k,88) = b(k,88) - lu(k,339) * b(k,44) - b(k,58) = b(k,58) - lu(k,341) * b(k,45) - b(k,65) = b(k,65) - lu(k,342) * b(k,45) - b(k,66) = b(k,66) - lu(k,343) * b(k,45) - b(k,67) = b(k,67) - lu(k,344) * b(k,45) - b(k,70) = b(k,70) - lu(k,345) * b(k,45) - b(k,73) = b(k,73) - lu(k,346) * b(k,45) - b(k,75) = b(k,75) - lu(k,347) * b(k,45) - b(k,77) = b(k,77) - lu(k,348) * b(k,45) - b(k,80) = b(k,80) - lu(k,349) * b(k,45) - b(k,82) = b(k,82) - lu(k,350) * b(k,45) - b(k,85) = b(k,85) - lu(k,351) * b(k,45) - b(k,86) = b(k,86) - lu(k,352) * b(k,45) - b(k,87) = b(k,87) - lu(k,353) * b(k,45) - b(k,88) = b(k,88) - lu(k,354) * b(k,45) - b(k,58) = b(k,58) - lu(k,357) * b(k,46) - b(k,65) = b(k,65) - lu(k,358) * b(k,46) - b(k,66) = b(k,66) - lu(k,359) * b(k,46) - b(k,67) = b(k,67) - lu(k,360) * b(k,46) - b(k,70) = b(k,70) - lu(k,361) * b(k,46) - b(k,73) = b(k,73) - lu(k,362) * b(k,46) - b(k,75) = b(k,75) - lu(k,363) * b(k,46) - b(k,77) = b(k,77) - lu(k,364) * b(k,46) - b(k,80) = b(k,80) - lu(k,365) * b(k,46) - b(k,82) = b(k,82) - lu(k,366) * b(k,46) - b(k,85) = b(k,85) - lu(k,367) * b(k,46) - b(k,86) = b(k,86) - lu(k,368) * b(k,46) - b(k,87) = b(k,87) - lu(k,369) * b(k,46) - b(k,88) = b(k,88) - lu(k,370) * b(k,46) - b(k,62) = b(k,62) - lu(k,372) * b(k,47) - b(k,65) = b(k,65) - lu(k,373) * b(k,47) - b(k,66) = b(k,66) - lu(k,374) * b(k,47) - b(k,67) = b(k,67) - lu(k,375) * b(k,47) - b(k,70) = b(k,70) - lu(k,376) * b(k,47) - b(k,72) = b(k,72) - lu(k,377) * b(k,47) - b(k,73) = b(k,73) - lu(k,378) * b(k,47) - b(k,75) = b(k,75) - lu(k,379) * b(k,47) - b(k,77) = b(k,77) - lu(k,380) * b(k,47) - b(k,82) = b(k,82) - lu(k,381) * b(k,47) - b(k,86) = b(k,86) - lu(k,382) * b(k,47) - b(k,87) = b(k,87) - lu(k,383) * b(k,47) - b(k,88) = b(k,88) - lu(k,384) * b(k,47) - b(k,51) = b(k,51) - lu(k,386) * b(k,48) - b(k,65) = b(k,65) - lu(k,387) * b(k,48) - b(k,66) = b(k,66) - lu(k,388) * b(k,48) - b(k,67) = b(k,67) - lu(k,389) * b(k,48) - b(k,70) = b(k,70) - lu(k,390) * b(k,48) - b(k,71) = b(k,71) - lu(k,391) * b(k,48) - b(k,73) = b(k,73) - lu(k,392) * b(k,48) - b(k,74) = b(k,74) - lu(k,393) * b(k,48) - b(k,75) = b(k,75) - lu(k,394) * b(k,48) - b(k,77) = b(k,77) - lu(k,395) * b(k,48) - b(k,80) = b(k,80) - lu(k,396) * b(k,48) - b(k,82) = b(k,82) - lu(k,397) * b(k,48) - b(k,86) = b(k,86) - lu(k,398) * b(k,48) - b(k,87) = b(k,87) - lu(k,399) * b(k,48) - b(k,88) = b(k,88) - lu(k,400) * b(k,48) - b(k,60) = b(k,60) - lu(k,402) * b(k,49) - b(k,62) = b(k,62) - lu(k,403) * b(k,49) - b(k,64) = b(k,64) - lu(k,404) * b(k,49) - b(k,68) = b(k,68) - lu(k,405) * b(k,49) - b(k,69) = b(k,69) - lu(k,406) * b(k,49) - b(k,72) = b(k,72) - lu(k,407) * b(k,49) - b(k,75) = b(k,75) - lu(k,408) * b(k,49) - b(k,76) = b(k,76) - lu(k,409) * b(k,49) - b(k,78) = b(k,78) - lu(k,410) * b(k,49) - b(k,79) = b(k,79) - lu(k,411) * b(k,49) - b(k,83) = b(k,83) - lu(k,412) * b(k,49) - b(k,84) = b(k,84) - lu(k,413) * b(k,49) - b(k,86) = b(k,86) - lu(k,414) * b(k,49) - b(k,87) = b(k,87) - lu(k,415) * b(k,49) - b(k,56) = b(k,56) - lu(k,420) * b(k,50) - b(k,57) = b(k,57) - lu(k,421) * b(k,50) - b(k,61) = b(k,61) - lu(k,422) * b(k,50) - b(k,63) = b(k,63) - lu(k,423) * b(k,50) - b(k,68) = b(k,68) - lu(k,424) * b(k,50) - b(k,69) = b(k,69) - lu(k,425) * b(k,50) - b(k,71) = b(k,71) - lu(k,426) * b(k,50) - b(k,72) = b(k,72) - lu(k,427) * b(k,50) - b(k,74) = b(k,74) - lu(k,428) * b(k,50) - b(k,75) = b(k,75) - lu(k,429) * b(k,50) - b(k,80) = b(k,80) - lu(k,430) * b(k,50) - b(k,81) = b(k,81) - lu(k,431) * b(k,50) - b(k,83) = b(k,83) - lu(k,432) * b(k,50) - b(k,84) = b(k,84) - lu(k,433) * b(k,50) - b(k,85) = b(k,85) - lu(k,434) * b(k,50) - b(k,86) = b(k,86) - lu(k,435) * b(k,50) - b(k,87) = b(k,87) - lu(k,436) * b(k,50) - b(k,88) = b(k,88) - lu(k,437) * b(k,50) - b(k,60) = b(k,60) - lu(k,439) * b(k,51) - b(k,65) = b(k,65) - lu(k,440) * b(k,51) - b(k,66) = b(k,66) - lu(k,441) * b(k,51) - b(k,67) = b(k,67) - lu(k,442) * b(k,51) - b(k,70) = b(k,70) - lu(k,443) * b(k,51) - b(k,71) = b(k,71) - lu(k,444) * b(k,51) - b(k,73) = b(k,73) - lu(k,445) * b(k,51) - b(k,74) = b(k,74) - lu(k,446) * b(k,51) - b(k,75) = b(k,75) - lu(k,447) * b(k,51) - b(k,77) = b(k,77) - lu(k,448) * b(k,51) - b(k,82) = b(k,82) - lu(k,449) * b(k,51) - b(k,87) = b(k,87) - lu(k,450) * b(k,51) - b(k,88) = b(k,88) - lu(k,451) * b(k,51) - b(k,56) = b(k,56) - lu(k,458) * b(k,52) - b(k,57) = b(k,57) - lu(k,459) * b(k,52) - b(k,61) = b(k,61) - lu(k,460) * b(k,52) - b(k,63) = b(k,63) - lu(k,461) * b(k,52) - b(k,68) = b(k,68) - lu(k,462) * b(k,52) - b(k,71) = b(k,71) - lu(k,463) * b(k,52) - b(k,72) = b(k,72) - lu(k,464) * b(k,52) - b(k,74) = b(k,74) - lu(k,465) * b(k,52) - b(k,75) = b(k,75) - lu(k,466) * b(k,52) - b(k,78) = b(k,78) - lu(k,467) * b(k,52) - b(k,79) = b(k,79) - lu(k,468) * b(k,52) - b(k,80) = b(k,80) - lu(k,469) * b(k,52) - b(k,81) = b(k,81) - lu(k,470) * b(k,52) - b(k,85) = b(k,85) - lu(k,471) * b(k,52) - b(k,86) = b(k,86) - lu(k,472) * b(k,52) - b(k,87) = b(k,87) - lu(k,473) * b(k,52) - b(k,88) = b(k,88) - lu(k,474) * b(k,52) - b(k,55) = b(k,55) - lu(k,478) * b(k,53) - b(k,60) = b(k,60) - lu(k,479) * b(k,53) - b(k,65) = b(k,65) - lu(k,480) * b(k,53) - b(k,66) = b(k,66) - lu(k,481) * b(k,53) - b(k,67) = b(k,67) - lu(k,482) * b(k,53) - b(k,68) = b(k,68) - lu(k,483) * b(k,53) - b(k,70) = b(k,70) - lu(k,484) * b(k,53) - b(k,71) = b(k,71) - lu(k,485) * b(k,53) - b(k,72) = b(k,72) - lu(k,486) * b(k,53) - b(k,73) = b(k,73) - lu(k,487) * b(k,53) - b(k,74) = b(k,74) - lu(k,488) * b(k,53) - b(k,75) = b(k,75) - lu(k,489) * b(k,53) - b(k,77) = b(k,77) - lu(k,490) * b(k,53) - b(k,82) = b(k,82) - lu(k,491) * b(k,53) - b(k,86) = b(k,86) - lu(k,492) * b(k,53) - b(k,87) = b(k,87) - lu(k,493) * b(k,53) - b(k,88) = b(k,88) - lu(k,494) * b(k,53) - end do + b(56) = b(56) - lu(267) * b(40) + b(61) = b(61) - lu(268) * b(40) + b(62) = b(62) - lu(269) * b(40) + b(68) = b(68) - lu(270) * b(40) + b(71) = b(71) - lu(271) * b(40) + b(72) = b(72) - lu(272) * b(40) + b(73) = b(73) - lu(273) * b(40) + b(74) = b(74) - lu(274) * b(40) + b(77) = b(77) - lu(275) * b(40) + b(87) = b(87) - lu(276) * b(40) + b(62) = b(62) - lu(278) * b(41) + b(65) = b(65) - lu(279) * b(41) + b(66) = b(66) - lu(280) * b(41) + b(68) = b(68) - lu(281) * b(41) + b(69) = b(69) - lu(282) * b(41) + b(70) = b(70) - lu(283) * b(41) + b(73) = b(73) - lu(284) * b(41) + b(76) = b(76) - lu(285) * b(41) + b(77) = b(77) - lu(286) * b(41) + b(78) = b(78) - lu(287) * b(41) + b(80) = b(80) - lu(288) * b(41) + b(87) = b(87) - lu(289) * b(41) + b(62) = b(62) - lu(293) * b(42) + b(68) = b(68) - lu(294) * b(42) + b(70) = b(70) - lu(295) * b(42) + b(73) = b(73) - lu(296) * b(42) + b(75) = b(75) - lu(297) * b(42) + b(76) = b(76) - lu(298) * b(42) + b(79) = b(79) - lu(299) * b(42) + b(81) = b(81) - lu(300) * b(42) + b(83) = b(83) - lu(301) * b(42) + b(84) = b(84) - lu(302) * b(42) + b(87) = b(87) - lu(303) * b(42) + b(54) = b(54) - lu(305) * b(43) + b(65) = b(65) - lu(306) * b(43) + b(66) = b(66) - lu(307) * b(43) + b(68) = b(68) - lu(308) * b(43) + b(69) = b(69) - lu(309) * b(43) + b(70) = b(70) - lu(310) * b(43) + b(73) = b(73) - lu(311) * b(43) + b(76) = b(76) - lu(312) * b(43) + b(77) = b(77) - lu(313) * b(43) + b(78) = b(78) - lu(314) * b(43) + b(80) = b(80) - lu(315) * b(43) + b(81) = b(81) - lu(316) * b(43) + b(87) = b(87) - lu(317) * b(43) + b(50) = b(50) - lu(321) * b(44) + b(56) = b(56) - lu(322) * b(44) + b(57) = b(57) - lu(323) * b(44) + b(61) = b(61) - lu(324) * b(44) + b(62) = b(62) - lu(325) * b(44) + b(68) = b(68) - lu(326) * b(44) + b(73) = b(73) - lu(327) * b(44) + b(81) = b(81) - lu(328) * b(44) + b(84) = b(84) - lu(329) * b(44) + b(87) = b(87) - lu(330) * b(44) + b(59) = b(59) - lu(332) * b(45) + b(65) = b(65) - lu(333) * b(45) + b(66) = b(66) - lu(334) * b(45) + b(67) = b(67) - lu(335) * b(45) + b(68) = b(68) - lu(336) * b(45) + b(69) = b(69) - lu(337) * b(45) + b(70) = b(70) - lu(338) * b(45) + b(73) = b(73) - lu(339) * b(45) + b(74) = b(74) - lu(340) * b(45) + b(76) = b(76) - lu(341) * b(45) + b(77) = b(77) - lu(342) * b(45) + b(78) = b(78) - lu(343) * b(45) + b(80) = b(80) - lu(344) * b(45) + b(87) = b(87) - lu(345) * b(45) + b(59) = b(59) - lu(348) * b(46) + b(65) = b(65) - lu(349) * b(46) + b(66) = b(66) - lu(350) * b(46) + b(67) = b(67) - lu(351) * b(46) + b(68) = b(68) - lu(352) * b(46) + b(69) = b(69) - lu(353) * b(46) + b(70) = b(70) - lu(354) * b(46) + b(73) = b(73) - lu(355) * b(46) + b(74) = b(74) - lu(356) * b(46) + b(76) = b(76) - lu(357) * b(46) + b(77) = b(77) - lu(358) * b(46) + b(78) = b(78) - lu(359) * b(46) + b(80) = b(80) - lu(360) * b(46) + b(87) = b(87) - lu(361) * b(46) + b(64) = b(64) - lu(363) * b(47) + b(65) = b(65) - lu(364) * b(47) + b(66) = b(66) - lu(365) * b(47) + b(68) = b(68) - lu(366) * b(47) + b(69) = b(69) - lu(367) * b(47) + b(70) = b(70) - lu(368) * b(47) + b(71) = b(71) - lu(369) * b(47) + b(73) = b(73) - lu(370) * b(47) + b(76) = b(76) - lu(371) * b(47) + b(77) = b(77) - lu(372) * b(47) + b(78) = b(78) - lu(373) * b(47) + b(80) = b(80) - lu(374) * b(47) + b(87) = b(87) - lu(375) * b(47) + b(60) = b(60) - lu(377) * b(48) + b(63) = b(63) - lu(378) * b(48) + b(64) = b(64) - lu(379) * b(48) + b(68) = b(68) - lu(380) * b(48) + b(71) = b(71) - lu(381) * b(48) + b(73) = b(73) - lu(382) * b(48) + b(75) = b(75) - lu(383) * b(48) + b(77) = b(77) - lu(384) * b(48) + b(79) = b(79) - lu(385) * b(48) + b(81) = b(81) - lu(386) * b(48) + b(82) = b(82) - lu(387) * b(48) + b(83) = b(83) - lu(388) * b(48) + b(84) = b(84) - lu(389) * b(48) + b(52) = b(52) - lu(391) * b(49) + b(65) = b(65) - lu(392) * b(49) + b(66) = b(66) - lu(393) * b(49) + b(67) = b(67) - lu(394) * b(49) + b(68) = b(68) - lu(395) * b(49) + b(69) = b(69) - lu(396) * b(49) + b(70) = b(70) - lu(397) * b(49) + b(73) = b(73) - lu(398) * b(49) + b(76) = b(76) - lu(399) * b(49) + b(77) = b(77) - lu(400) * b(49) + b(78) = b(78) - lu(401) * b(49) + b(80) = b(80) - lu(402) * b(49) + b(85) = b(85) - lu(403) * b(49) + b(86) = b(86) - lu(404) * b(49) + b(87) = b(87) - lu(405) * b(49) + b(56) = b(56) - lu(412) * b(50) + b(57) = b(57) - lu(413) * b(50) + b(61) = b(61) - lu(414) * b(50) + b(62) = b(62) - lu(415) * b(50) + b(67) = b(67) - lu(416) * b(50) + b(68) = b(68) - lu(417) * b(50) + b(71) = b(71) - lu(418) * b(50) + b(72) = b(72) - lu(419) * b(50) + b(73) = b(73) - lu(420) * b(50) + b(74) = b(74) - lu(421) * b(50) + b(77) = b(77) - lu(422) * b(50) + b(81) = b(81) - lu(423) * b(50) + b(84) = b(84) - lu(424) * b(50) + b(85) = b(85) - lu(425) * b(50) + b(86) = b(86) - lu(426) * b(50) + b(87) = b(87) - lu(427) * b(50) + b(56) = b(56) - lu(432) * b(51) + b(57) = b(57) - lu(433) * b(51) + b(61) = b(61) - lu(434) * b(51) + b(62) = b(62) - lu(435) * b(51) + b(67) = b(67) - lu(436) * b(51) + b(68) = b(68) - lu(437) * b(51) + b(71) = b(71) - lu(438) * b(51) + b(72) = b(72) - lu(439) * b(51) + b(73) = b(73) - lu(440) * b(51) + b(74) = b(74) - lu(441) * b(51) + b(77) = b(77) - lu(442) * b(51) + b(79) = b(79) - lu(443) * b(51) + b(81) = b(81) - lu(444) * b(51) + b(82) = b(82) - lu(445) * b(51) + b(83) = b(83) - lu(446) * b(51) + b(85) = b(85) - lu(447) * b(51) + b(86) = b(86) - lu(448) * b(51) + b(87) = b(87) - lu(449) * b(51) + b(60) = b(60) - lu(451) * b(52) + b(65) = b(65) - lu(452) * b(52) + b(66) = b(66) - lu(453) * b(52) + b(69) = b(69) - lu(454) * b(52) + b(70) = b(70) - lu(455) * b(52) + b(73) = b(73) - lu(456) * b(52) + b(76) = b(76) - lu(457) * b(52) + b(77) = b(77) - lu(458) * b(52) + b(78) = b(78) - lu(459) * b(52) + b(80) = b(80) - lu(460) * b(52) + b(85) = b(85) - lu(461) * b(52) + b(86) = b(86) - lu(462) * b(52) + b(87) = b(87) - lu(463) * b(52) + b(55) = b(55) - lu(467) * b(53) + b(60) = b(60) - lu(468) * b(53) + b(65) = b(65) - lu(469) * b(53) + b(66) = b(66) - lu(470) * b(53) + b(68) = b(68) - lu(471) * b(53) + b(69) = b(69) - lu(472) * b(53) + b(70) = b(70) - lu(473) * b(53) + b(71) = b(71) - lu(474) * b(53) + b(73) = b(73) - lu(475) * b(53) + b(76) = b(76) - lu(476) * b(53) + b(77) = b(77) - lu(477) * b(53) + b(78) = b(78) - lu(478) * b(53) + b(80) = b(80) - lu(479) * b(53) + b(81) = b(81) - lu(480) * b(53) + b(85) = b(85) - lu(481) * b(53) + b(86) = b(86) - lu(482) * b(53) + b(87) = b(87) - lu(483) * b(53) + b(55) = b(55) - lu(487) * b(54) + b(60) = b(60) - lu(488) * b(54) + b(63) = b(63) - lu(489) * b(54) + b(64) = b(64) - lu(490) * b(54) + b(65) = b(65) - lu(491) * b(54) + b(66) = b(66) - lu(492) * b(54) + b(68) = b(68) - lu(493) * b(54) + b(69) = b(69) - lu(494) * b(54) + b(70) = b(70) - lu(495) * b(54) + b(71) = b(71) - lu(496) * b(54) + b(73) = b(73) - lu(497) * b(54) + b(76) = b(76) - lu(498) * b(54) + b(77) = b(77) - lu(499) * b(54) + b(78) = b(78) - lu(500) * b(54) + b(80) = b(80) - lu(501) * b(54) + b(81) = b(81) - lu(502) * b(54) + b(87) = b(87) - lu(503) * b(54) end subroutine lu_slv02 - subroutine lu_slv03( avec_len, lu, b ) + subroutine lu_slv03( 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) + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) !----------------------------------------------------------------------- ! ... Local variables !----------------------------------------------------------------------- - integer :: k !----------------------------------------------------------------------- ! ... solve L * y = b !----------------------------------------------------------------------- - do k = 1,avec_len - b(k,55) = b(k,55) - lu(k,498) * b(k,54) - b(k,60) = b(k,60) - lu(k,499) * b(k,54) - b(k,62) = b(k,62) - lu(k,500) * b(k,54) - b(k,64) = b(k,64) - lu(k,501) * b(k,54) - b(k,65) = b(k,65) - lu(k,502) * b(k,54) - b(k,66) = b(k,66) - lu(k,503) * b(k,54) - b(k,67) = b(k,67) - lu(k,504) * b(k,54) - b(k,68) = b(k,68) - lu(k,505) * b(k,54) - b(k,70) = b(k,70) - lu(k,506) * b(k,54) - b(k,72) = b(k,72) - lu(k,507) * b(k,54) - b(k,73) = b(k,73) - lu(k,508) * b(k,54) - b(k,75) = b(k,75) - lu(k,509) * b(k,54) - b(k,77) = b(k,77) - lu(k,510) * b(k,54) - b(k,78) = b(k,78) - lu(k,511) * b(k,54) - b(k,82) = b(k,82) - lu(k,512) * b(k,54) - b(k,86) = b(k,86) - lu(k,513) * b(k,54) - b(k,87) = b(k,87) - lu(k,514) * b(k,54) - b(k,88) = b(k,88) - lu(k,515) * b(k,54) - b(k,60) = b(k,60) - lu(k,520) * b(k,55) - b(k,65) = b(k,65) - lu(k,521) * b(k,55) - b(k,66) = b(k,66) - lu(k,522) * b(k,55) - b(k,67) = b(k,67) - lu(k,523) * b(k,55) - b(k,68) = b(k,68) - lu(k,524) * b(k,55) - b(k,70) = b(k,70) - lu(k,525) * b(k,55) - b(k,71) = b(k,71) - lu(k,526) * b(k,55) - b(k,72) = b(k,72) - lu(k,527) * b(k,55) - b(k,73) = b(k,73) - lu(k,528) * b(k,55) - b(k,74) = b(k,74) - lu(k,529) * b(k,55) - b(k,75) = b(k,75) - lu(k,530) * b(k,55) - b(k,77) = b(k,77) - lu(k,531) * b(k,55) - b(k,82) = b(k,82) - lu(k,532) * b(k,55) - b(k,86) = b(k,86) - lu(k,533) * b(k,55) - b(k,87) = b(k,87) - lu(k,534) * b(k,55) - b(k,88) = b(k,88) - lu(k,535) * b(k,55) - b(k,57) = b(k,57) - lu(k,542) * b(k,56) - b(k,61) = b(k,61) - lu(k,543) * b(k,56) - b(k,63) = b(k,63) - lu(k,544) * b(k,56) - b(k,68) = b(k,68) - lu(k,545) * b(k,56) - b(k,69) = b(k,69) - lu(k,546) * b(k,56) - b(k,71) = b(k,71) - lu(k,547) * b(k,56) - b(k,72) = b(k,72) - lu(k,548) * b(k,56) - b(k,74) = b(k,74) - lu(k,549) * b(k,56) - b(k,75) = b(k,75) - lu(k,550) * b(k,56) - b(k,78) = b(k,78) - lu(k,551) * b(k,56) - b(k,79) = b(k,79) - lu(k,552) * b(k,56) - b(k,80) = b(k,80) - lu(k,553) * b(k,56) - b(k,81) = b(k,81) - lu(k,554) * b(k,56) - b(k,83) = b(k,83) - lu(k,555) * b(k,56) - b(k,84) = b(k,84) - lu(k,556) * b(k,56) - b(k,85) = b(k,85) - lu(k,557) * b(k,56) - b(k,86) = b(k,86) - lu(k,558) * b(k,56) - b(k,87) = b(k,87) - lu(k,559) * b(k,56) - b(k,88) = b(k,88) - lu(k,560) * b(k,56) - b(k,61) = b(k,61) - lu(k,574) * b(k,57) - b(k,63) = b(k,63) - lu(k,575) * b(k,57) - b(k,65) = b(k,65) - lu(k,576) * b(k,57) - b(k,68) = b(k,68) - lu(k,577) * b(k,57) - b(k,69) = b(k,69) - lu(k,578) * b(k,57) - b(k,71) = b(k,71) - lu(k,579) * b(k,57) - b(k,72) = b(k,72) - lu(k,580) * b(k,57) - b(k,74) = b(k,74) - lu(k,581) * b(k,57) - b(k,75) = b(k,75) - lu(k,582) * b(k,57) - b(k,76) = b(k,76) - lu(k,583) * b(k,57) - b(k,77) = b(k,77) - lu(k,584) * b(k,57) - b(k,78) = b(k,78) - lu(k,585) * b(k,57) - b(k,79) = b(k,79) - lu(k,586) * b(k,57) - b(k,80) = b(k,80) - lu(k,587) * b(k,57) - b(k,81) = b(k,81) - lu(k,588) * b(k,57) - b(k,83) = b(k,83) - lu(k,589) * b(k,57) - b(k,84) = b(k,84) - lu(k,590) * b(k,57) - b(k,85) = b(k,85) - lu(k,591) * b(k,57) - b(k,86) = b(k,86) - lu(k,592) * b(k,57) - b(k,87) = b(k,87) - lu(k,593) * b(k,57) - b(k,88) = b(k,88) - lu(k,594) * b(k,57) - b(k,60) = b(k,60) - lu(k,598) * b(k,58) - b(k,62) = b(k,62) - lu(k,599) * b(k,58) - b(k,65) = b(k,65) - lu(k,600) * b(k,58) - b(k,66) = b(k,66) - lu(k,601) * b(k,58) - b(k,67) = b(k,67) - lu(k,602) * b(k,58) - b(k,69) = b(k,69) - lu(k,603) * b(k,58) - b(k,70) = b(k,70) - lu(k,604) * b(k,58) - b(k,71) = b(k,71) - lu(k,605) * b(k,58) - b(k,72) = b(k,72) - lu(k,606) * b(k,58) - b(k,73) = b(k,73) - lu(k,607) * b(k,58) - b(k,75) = b(k,75) - lu(k,608) * b(k,58) - b(k,77) = b(k,77) - lu(k,609) * b(k,58) - b(k,80) = b(k,80) - lu(k,610) * b(k,58) - b(k,82) = b(k,82) - lu(k,611) * b(k,58) - b(k,85) = b(k,85) - lu(k,612) * b(k,58) - b(k,86) = b(k,86) - lu(k,613) * b(k,58) - b(k,87) = b(k,87) - lu(k,614) * b(k,58) - b(k,88) = b(k,88) - lu(k,615) * b(k,58) - b(k,60) = b(k,60) - lu(k,620) * b(k,59) - b(k,61) = b(k,61) - lu(k,621) * b(k,59) - b(k,62) = b(k,62) - lu(k,622) * b(k,59) - b(k,63) = b(k,63) - lu(k,623) * b(k,59) - b(k,64) = b(k,64) - lu(k,624) * b(k,59) - b(k,65) = b(k,65) - lu(k,625) * b(k,59) - b(k,66) = b(k,66) - lu(k,626) * b(k,59) - b(k,67) = b(k,67) - lu(k,627) * b(k,59) - b(k,68) = b(k,68) - lu(k,628) * b(k,59) - b(k,69) = b(k,69) - lu(k,629) * b(k,59) - b(k,70) = b(k,70) - lu(k,630) * b(k,59) - b(k,71) = b(k,71) - lu(k,631) * b(k,59) - b(k,72) = b(k,72) - lu(k,632) * b(k,59) - b(k,73) = b(k,73) - lu(k,633) * b(k,59) - b(k,75) = b(k,75) - lu(k,634) * b(k,59) - b(k,76) = b(k,76) - lu(k,635) * b(k,59) - b(k,77) = b(k,77) - lu(k,636) * b(k,59) - b(k,78) = b(k,78) - lu(k,637) * b(k,59) - b(k,79) = b(k,79) - lu(k,638) * b(k,59) - b(k,80) = b(k,80) - lu(k,639) * b(k,59) - b(k,81) = b(k,81) - lu(k,640) * b(k,59) - b(k,82) = b(k,82) - lu(k,641) * b(k,59) - b(k,83) = b(k,83) - lu(k,642) * b(k,59) - b(k,84) = b(k,84) - lu(k,643) * b(k,59) - b(k,85) = b(k,85) - lu(k,644) * b(k,59) - b(k,86) = b(k,86) - lu(k,645) * b(k,59) - b(k,87) = b(k,87) - lu(k,646) * b(k,59) - b(k,88) = b(k,88) - lu(k,647) * b(k,59) - b(k,62) = b(k,62) - lu(k,653) * b(k,60) - b(k,65) = b(k,65) - lu(k,654) * b(k,60) - b(k,66) = b(k,66) - lu(k,655) * b(k,60) - b(k,67) = b(k,67) - lu(k,656) * b(k,60) - b(k,68) = b(k,68) - lu(k,657) * b(k,60) - b(k,69) = b(k,69) - lu(k,658) * b(k,60) - b(k,70) = b(k,70) - lu(k,659) * b(k,60) - b(k,71) = b(k,71) - lu(k,660) * b(k,60) - b(k,72) = b(k,72) - lu(k,661) * b(k,60) - b(k,73) = b(k,73) - lu(k,662) * b(k,60) - b(k,74) = b(k,74) - lu(k,663) * b(k,60) - b(k,75) = b(k,75) - lu(k,664) * b(k,60) - b(k,77) = b(k,77) - lu(k,665) * b(k,60) - b(k,79) = b(k,79) - lu(k,666) * b(k,60) - b(k,80) = b(k,80) - lu(k,667) * b(k,60) - b(k,82) = b(k,82) - lu(k,668) * b(k,60) - b(k,85) = b(k,85) - lu(k,669) * b(k,60) - b(k,86) = b(k,86) - lu(k,670) * b(k,60) - b(k,87) = b(k,87) - lu(k,671) * b(k,60) - b(k,88) = b(k,88) - lu(k,672) * b(k,60) - b(k,63) = b(k,63) - lu(k,687) * b(k,61) - b(k,65) = b(k,65) - lu(k,688) * b(k,61) - b(k,68) = b(k,68) - lu(k,689) * b(k,61) - b(k,69) = b(k,69) - lu(k,690) * b(k,61) - b(k,70) = b(k,70) - lu(k,691) * b(k,61) - b(k,71) = b(k,71) - lu(k,692) * b(k,61) - b(k,72) = b(k,72) - lu(k,693) * b(k,61) - b(k,74) = b(k,74) - lu(k,694) * b(k,61) - b(k,75) = b(k,75) - lu(k,695) * b(k,61) - b(k,76) = b(k,76) - lu(k,696) * b(k,61) - b(k,77) = b(k,77) - lu(k,697) * b(k,61) - b(k,78) = b(k,78) - lu(k,698) * b(k,61) - b(k,79) = b(k,79) - lu(k,699) * b(k,61) - b(k,80) = b(k,80) - lu(k,700) * b(k,61) - b(k,81) = b(k,81) - lu(k,701) * b(k,61) - b(k,83) = b(k,83) - lu(k,702) * b(k,61) - b(k,84) = b(k,84) - lu(k,703) * b(k,61) - b(k,85) = b(k,85) - lu(k,704) * b(k,61) - b(k,86) = b(k,86) - lu(k,705) * b(k,61) - b(k,87) = b(k,87) - lu(k,706) * b(k,61) - b(k,88) = b(k,88) - lu(k,707) * b(k,61) - b(k,63) = b(k,63) - lu(k,713) * b(k,62) - b(k,65) = b(k,65) - lu(k,714) * b(k,62) - b(k,66) = b(k,66) - lu(k,715) * b(k,62) - b(k,67) = b(k,67) - lu(k,716) * b(k,62) - b(k,68) = b(k,68) - lu(k,717) * b(k,62) - b(k,69) = b(k,69) - lu(k,718) * b(k,62) - b(k,70) = b(k,70) - lu(k,719) * b(k,62) - b(k,71) = b(k,71) - lu(k,720) * b(k,62) - b(k,72) = b(k,72) - lu(k,721) * b(k,62) - b(k,73) = b(k,73) - lu(k,722) * b(k,62) - b(k,74) = b(k,74) - lu(k,723) * b(k,62) - b(k,75) = b(k,75) - lu(k,724) * b(k,62) - b(k,77) = b(k,77) - lu(k,725) * b(k,62) - b(k,79) = b(k,79) - lu(k,726) * b(k,62) - b(k,80) = b(k,80) - lu(k,727) * b(k,62) - b(k,81) = b(k,81) - lu(k,728) * b(k,62) - b(k,82) = b(k,82) - lu(k,729) * b(k,62) - b(k,83) = b(k,83) - lu(k,730) * b(k,62) - b(k,85) = b(k,85) - lu(k,731) * b(k,62) - b(k,86) = b(k,86) - lu(k,732) * b(k,62) - b(k,87) = b(k,87) - lu(k,733) * b(k,62) - b(k,88) = b(k,88) - lu(k,734) * b(k,62) - b(k,65) = b(k,65) - lu(k,756) * b(k,63) - b(k,66) = b(k,66) - lu(k,757) * b(k,63) - b(k,68) = b(k,68) - lu(k,758) * b(k,63) - b(k,69) = b(k,69) - lu(k,759) * b(k,63) - b(k,70) = b(k,70) - lu(k,760) * b(k,63) - b(k,71) = b(k,71) - lu(k,761) * b(k,63) - b(k,72) = b(k,72) - lu(k,762) * b(k,63) - b(k,74) = b(k,74) - lu(k,763) * b(k,63) - b(k,75) = b(k,75) - lu(k,764) * b(k,63) - b(k,76) = b(k,76) - lu(k,765) * b(k,63) - b(k,77) = b(k,77) - lu(k,766) * b(k,63) - b(k,78) = b(k,78) - lu(k,767) * b(k,63) - b(k,79) = b(k,79) - lu(k,768) * b(k,63) - b(k,80) = b(k,80) - lu(k,769) * b(k,63) - b(k,81) = b(k,81) - lu(k,770) * b(k,63) - b(k,83) = b(k,83) - lu(k,771) * b(k,63) - b(k,84) = b(k,84) - lu(k,772) * b(k,63) - b(k,85) = b(k,85) - lu(k,773) * b(k,63) - b(k,86) = b(k,86) - lu(k,774) * b(k,63) - b(k,87) = b(k,87) - lu(k,775) * b(k,63) - b(k,88) = b(k,88) - lu(k,776) * b(k,63) - end do + b(60) = b(60) - lu(508) * b(55) + b(65) = b(65) - lu(509) * b(55) + b(66) = b(66) - lu(510) * b(55) + b(68) = b(68) - lu(511) * b(55) + b(69) = b(69) - lu(512) * b(55) + b(70) = b(70) - lu(513) * b(55) + b(71) = b(71) - lu(514) * b(55) + b(73) = b(73) - lu(515) * b(55) + b(76) = b(76) - lu(516) * b(55) + b(77) = b(77) - lu(517) * b(55) + b(78) = b(78) - lu(518) * b(55) + b(80) = b(80) - lu(519) * b(55) + b(81) = b(81) - lu(520) * b(55) + b(85) = b(85) - lu(521) * b(55) + b(86) = b(86) - lu(522) * b(55) + b(87) = b(87) - lu(523) * b(55) + b(57) = b(57) - lu(530) * b(56) + b(61) = b(61) - lu(531) * b(56) + b(62) = b(62) - lu(532) * b(56) + b(67) = b(67) - lu(533) * b(56) + b(68) = b(68) - lu(534) * b(56) + b(71) = b(71) - lu(535) * b(56) + b(72) = b(72) - lu(536) * b(56) + b(73) = b(73) - lu(537) * b(56) + b(74) = b(74) - lu(538) * b(56) + b(77) = b(77) - lu(539) * b(56) + b(79) = b(79) - lu(540) * b(56) + b(81) = b(81) - lu(541) * b(56) + b(82) = b(82) - lu(542) * b(56) + b(83) = b(83) - lu(543) * b(56) + b(84) = b(84) - lu(544) * b(56) + b(85) = b(85) - lu(545) * b(56) + b(86) = b(86) - lu(546) * b(56) + b(87) = b(87) - lu(547) * b(56) + b(61) = b(61) - lu(561) * b(57) + b(62) = b(62) - lu(562) * b(57) + b(67) = b(67) - lu(563) * b(57) + b(68) = b(68) - lu(564) * b(57) + b(70) = b(70) - lu(565) * b(57) + b(71) = b(71) - lu(566) * b(57) + b(72) = b(72) - lu(567) * b(57) + b(73) = b(73) - lu(568) * b(57) + b(74) = b(74) - lu(569) * b(57) + b(75) = b(75) - lu(570) * b(57) + b(76) = b(76) - lu(571) * b(57) + b(77) = b(77) - lu(572) * b(57) + b(79) = b(79) - lu(573) * b(57) + b(81) = b(81) - lu(574) * b(57) + b(82) = b(82) - lu(575) * b(57) + b(83) = b(83) - lu(576) * b(57) + b(84) = b(84) - lu(577) * b(57) + b(85) = b(85) - lu(578) * b(57) + b(86) = b(86) - lu(579) * b(57) + b(87) = b(87) - lu(580) * b(57) + b(59) = b(59) - lu(584) * b(58) + b(60) = b(60) - lu(585) * b(58) + b(61) = b(61) - lu(586) * b(58) + b(62) = b(62) - lu(587) * b(58) + b(63) = b(63) - lu(588) * b(58) + b(64) = b(64) - lu(589) * b(58) + b(65) = b(65) - lu(590) * b(58) + b(66) = b(66) - lu(591) * b(58) + b(67) = b(67) - lu(592) * b(58) + b(68) = b(68) - lu(593) * b(58) + b(69) = b(69) - lu(594) * b(58) + b(70) = b(70) - lu(595) * b(58) + b(71) = b(71) - lu(596) * b(58) + b(72) = b(72) - lu(597) * b(58) + b(73) = b(73) - lu(598) * b(58) + b(74) = b(74) - lu(599) * b(58) + b(75) = b(75) - lu(600) * b(58) + b(76) = b(76) - lu(601) * b(58) + b(77) = b(77) - lu(602) * b(58) + b(78) = b(78) - lu(603) * b(58) + b(79) = b(79) - lu(604) * b(58) + b(80) = b(80) - lu(605) * b(58) + b(81) = b(81) - lu(606) * b(58) + b(82) = b(82) - lu(607) * b(58) + b(83) = b(83) - lu(608) * b(58) + b(84) = b(84) - lu(609) * b(58) + b(87) = b(87) - lu(610) * b(58) + b(60) = b(60) - lu(614) * b(59) + b(64) = b(64) - lu(615) * b(59) + b(65) = b(65) - lu(616) * b(59) + b(66) = b(66) - lu(617) * b(59) + b(67) = b(67) - lu(618) * b(59) + b(68) = b(68) - lu(619) * b(59) + b(69) = b(69) - lu(620) * b(59) + b(70) = b(70) - lu(621) * b(59) + b(71) = b(71) - lu(622) * b(59) + b(73) = b(73) - lu(623) * b(59) + b(74) = b(74) - lu(624) * b(59) + b(76) = b(76) - lu(625) * b(59) + b(77) = b(77) - lu(626) * b(59) + b(78) = b(78) - lu(627) * b(59) + b(79) = b(79) - lu(628) * b(59) + b(80) = b(80) - lu(629) * b(59) + b(85) = b(85) - lu(630) * b(59) + b(87) = b(87) - lu(631) * b(59) + b(64) = b(64) - lu(637) * b(60) + b(65) = b(65) - lu(638) * b(60) + b(66) = b(66) - lu(639) * b(60) + b(67) = b(67) - lu(640) * b(60) + b(68) = b(68) - lu(641) * b(60) + b(69) = b(69) - lu(642) * b(60) + b(70) = b(70) - lu(643) * b(60) + b(71) = b(71) - lu(644) * b(60) + b(73) = b(73) - lu(645) * b(60) + b(74) = b(74) - lu(646) * b(60) + b(76) = b(76) - lu(647) * b(60) + b(77) = b(77) - lu(648) * b(60) + b(78) = b(78) - lu(649) * b(60) + b(79) = b(79) - lu(650) * b(60) + b(80) = b(80) - lu(651) * b(60) + b(81) = b(81) - lu(652) * b(60) + b(84) = b(84) - lu(653) * b(60) + b(85) = b(85) - lu(654) * b(60) + b(86) = b(86) - lu(655) * b(60) + b(87) = b(87) - lu(656) * b(60) + b(62) = b(62) - lu(671) * b(61) + b(67) = b(67) - lu(672) * b(61) + b(68) = b(68) - lu(673) * b(61) + b(69) = b(69) - lu(674) * b(61) + b(70) = b(70) - lu(675) * b(61) + b(71) = b(71) - lu(676) * b(61) + b(72) = b(72) - lu(677) * b(61) + b(73) = b(73) - lu(678) * b(61) + b(74) = b(74) - lu(679) * b(61) + b(75) = b(75) - lu(680) * b(61) + b(76) = b(76) - lu(681) * b(61) + b(77) = b(77) - lu(682) * b(61) + b(79) = b(79) - lu(683) * b(61) + b(81) = b(81) - lu(684) * b(61) + b(82) = b(82) - lu(685) * b(61) + b(83) = b(83) - lu(686) * b(61) + b(84) = b(84) - lu(687) * b(61) + b(85) = b(85) - lu(688) * b(61) + b(86) = b(86) - lu(689) * b(61) + b(87) = b(87) - lu(690) * b(61) + b(65) = b(65) - lu(712) * b(62) + b(67) = b(67) - lu(713) * b(62) + b(68) = b(68) - lu(714) * b(62) + b(69) = b(69) - lu(715) * b(62) + b(70) = b(70) - lu(716) * b(62) + b(71) = b(71) - lu(717) * b(62) + b(72) = b(72) - lu(718) * b(62) + b(73) = b(73) - lu(719) * b(62) + b(74) = b(74) - lu(720) * b(62) + b(75) = b(75) - lu(721) * b(62) + b(76) = b(76) - lu(722) * b(62) + b(77) = b(77) - lu(723) * b(62) + b(79) = b(79) - lu(724) * b(62) + b(81) = b(81) - lu(725) * b(62) + b(82) = b(82) - lu(726) * b(62) + b(83) = b(83) - lu(727) * b(62) + b(84) = b(84) - lu(728) * b(62) + b(85) = b(85) - lu(729) * b(62) + b(86) = b(86) - lu(730) * b(62) + b(87) = b(87) - lu(731) * b(62) + b(64) = b(64) - lu(740) * b(63) + b(65) = b(65) - lu(741) * b(63) + b(66) = b(66) - lu(742) * b(63) + b(67) = b(67) - lu(743) * b(63) + b(68) = b(68) - lu(744) * b(63) + b(69) = b(69) - lu(745) * b(63) + b(70) = b(70) - lu(746) * b(63) + b(71) = b(71) - lu(747) * b(63) + b(72) = b(72) - lu(748) * b(63) + b(73) = b(73) - lu(749) * b(63) + b(74) = b(74) - lu(750) * b(63) + b(75) = b(75) - lu(751) * b(63) + b(76) = b(76) - lu(752) * b(63) + b(77) = b(77) - lu(753) * b(63) + b(78) = b(78) - lu(754) * b(63) + b(79) = b(79) - lu(755) * b(63) + b(80) = b(80) - lu(756) * b(63) + b(81) = b(81) - lu(757) * b(63) + b(82) = b(82) - lu(758) * b(63) + b(83) = b(83) - lu(759) * b(63) + b(84) = b(84) - lu(760) * b(63) + b(85) = b(85) - lu(761) * b(63) + b(86) = b(86) - lu(762) * b(63) + b(87) = b(87) - lu(763) * b(63) + b(65) = b(65) - lu(770) * b(64) + b(66) = b(66) - lu(771) * b(64) + b(67) = b(67) - lu(772) * b(64) + b(68) = b(68) - lu(773) * b(64) + b(69) = b(69) - lu(774) * b(64) + b(70) = b(70) - lu(775) * b(64) + b(71) = b(71) - lu(776) * b(64) + b(72) = b(72) - lu(777) * b(64) + b(73) = b(73) - lu(778) * b(64) + b(74) = b(74) - lu(779) * b(64) + b(75) = b(75) - lu(780) * b(64) + b(76) = b(76) - lu(781) * b(64) + b(77) = b(77) - lu(782) * b(64) + b(78) = b(78) - lu(783) * b(64) + b(79) = b(79) - lu(784) * b(64) + b(80) = b(80) - lu(785) * b(64) + b(81) = b(81) - lu(786) * b(64) + b(82) = b(82) - lu(787) * b(64) + b(83) = b(83) - lu(788) * b(64) + b(84) = b(84) - lu(789) * b(64) + b(85) = b(85) - lu(790) * b(64) + b(86) = b(86) - lu(791) * b(64) + b(87) = b(87) - lu(792) * b(64) end subroutine lu_slv03 - subroutine lu_slv04( avec_len, lu, b ) + subroutine lu_slv04( 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) + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) !----------------------------------------------------------------------- ! ... Local variables !----------------------------------------------------------------------- - integer :: k !----------------------------------------------------------------------- ! ... solve L * y = b !----------------------------------------------------------------------- - do k = 1,avec_len - b(k,65) = b(k,65) - lu(k,786) * b(k,64) - b(k,66) = b(k,66) - lu(k,787) * b(k,64) - b(k,67) = b(k,67) - lu(k,788) * b(k,64) - b(k,68) = b(k,68) - lu(k,789) * b(k,64) - b(k,69) = b(k,69) - lu(k,790) * b(k,64) - b(k,70) = b(k,70) - lu(k,791) * b(k,64) - b(k,71) = b(k,71) - lu(k,792) * b(k,64) - b(k,72) = b(k,72) - lu(k,793) * b(k,64) - b(k,73) = b(k,73) - lu(k,794) * b(k,64) - b(k,74) = b(k,74) - lu(k,795) * b(k,64) - b(k,75) = b(k,75) - lu(k,796) * b(k,64) - b(k,76) = b(k,76) - lu(k,797) * b(k,64) - b(k,77) = b(k,77) - lu(k,798) * b(k,64) - b(k,78) = b(k,78) - lu(k,799) * b(k,64) - b(k,79) = b(k,79) - lu(k,800) * b(k,64) - b(k,80) = b(k,80) - lu(k,801) * b(k,64) - b(k,81) = b(k,81) - lu(k,802) * b(k,64) - b(k,82) = b(k,82) - lu(k,803) * b(k,64) - b(k,83) = b(k,83) - lu(k,804) * b(k,64) - b(k,84) = b(k,84) - lu(k,805) * b(k,64) - b(k,85) = b(k,85) - lu(k,806) * b(k,64) - b(k,86) = b(k,86) - lu(k,807) * b(k,64) - b(k,87) = b(k,87) - lu(k,808) * b(k,64) - b(k,88) = b(k,88) - lu(k,809) * b(k,64) - b(k,66) = b(k,66) - lu(k,830) * b(k,65) - b(k,67) = b(k,67) - lu(k,831) * b(k,65) - b(k,68) = b(k,68) - lu(k,832) * b(k,65) - b(k,69) = b(k,69) - lu(k,833) * b(k,65) - b(k,70) = b(k,70) - lu(k,834) * b(k,65) - b(k,71) = b(k,71) - lu(k,835) * b(k,65) - b(k,72) = b(k,72) - lu(k,836) * b(k,65) - b(k,73) = b(k,73) - lu(k,837) * b(k,65) - b(k,74) = b(k,74) - lu(k,838) * b(k,65) - b(k,75) = b(k,75) - lu(k,839) * b(k,65) - b(k,76) = b(k,76) - lu(k,840) * b(k,65) - b(k,77) = b(k,77) - lu(k,841) * b(k,65) - b(k,78) = b(k,78) - lu(k,842) * b(k,65) - b(k,79) = b(k,79) - lu(k,843) * b(k,65) - b(k,80) = b(k,80) - lu(k,844) * b(k,65) - b(k,81) = b(k,81) - lu(k,845) * b(k,65) - b(k,82) = b(k,82) - lu(k,846) * b(k,65) - b(k,83) = b(k,83) - lu(k,847) * b(k,65) - b(k,84) = b(k,84) - lu(k,848) * b(k,65) - b(k,85) = b(k,85) - lu(k,849) * b(k,65) - b(k,86) = b(k,86) - lu(k,850) * b(k,65) - b(k,87) = b(k,87) - lu(k,851) * b(k,65) - b(k,88) = b(k,88) - lu(k,852) * b(k,65) - b(k,67) = b(k,67) - lu(k,879) * b(k,66) - b(k,68) = b(k,68) - lu(k,880) * b(k,66) - b(k,69) = b(k,69) - lu(k,881) * b(k,66) - b(k,70) = b(k,70) - lu(k,882) * b(k,66) - b(k,71) = b(k,71) - lu(k,883) * b(k,66) - b(k,72) = b(k,72) - lu(k,884) * b(k,66) - b(k,73) = b(k,73) - lu(k,885) * b(k,66) - b(k,74) = b(k,74) - lu(k,886) * b(k,66) - b(k,75) = b(k,75) - lu(k,887) * b(k,66) - b(k,76) = b(k,76) - lu(k,888) * b(k,66) - b(k,77) = b(k,77) - lu(k,889) * b(k,66) - b(k,78) = b(k,78) - lu(k,890) * b(k,66) - b(k,79) = b(k,79) - lu(k,891) * b(k,66) - b(k,80) = b(k,80) - lu(k,892) * b(k,66) - b(k,81) = b(k,81) - lu(k,893) * b(k,66) - b(k,82) = b(k,82) - lu(k,894) * b(k,66) - b(k,83) = b(k,83) - lu(k,895) * b(k,66) - b(k,84) = b(k,84) - lu(k,896) * b(k,66) - b(k,85) = b(k,85) - lu(k,897) * b(k,66) - b(k,86) = b(k,86) - lu(k,898) * b(k,66) - b(k,87) = b(k,87) - lu(k,899) * b(k,66) - b(k,88) = b(k,88) - lu(k,900) * b(k,66) - b(k,68) = b(k,68) - lu(k,923) * b(k,67) - b(k,69) = b(k,69) - lu(k,924) * b(k,67) - b(k,70) = b(k,70) - lu(k,925) * b(k,67) - b(k,71) = b(k,71) - lu(k,926) * b(k,67) - b(k,72) = b(k,72) - lu(k,927) * b(k,67) - b(k,73) = b(k,73) - lu(k,928) * b(k,67) - b(k,74) = b(k,74) - lu(k,929) * b(k,67) - b(k,75) = b(k,75) - lu(k,930) * b(k,67) - b(k,76) = b(k,76) - lu(k,931) * b(k,67) - b(k,77) = b(k,77) - lu(k,932) * b(k,67) - b(k,78) = b(k,78) - lu(k,933) * b(k,67) - b(k,79) = b(k,79) - lu(k,934) * b(k,67) - b(k,80) = b(k,80) - lu(k,935) * b(k,67) - b(k,81) = b(k,81) - lu(k,936) * b(k,67) - b(k,82) = b(k,82) - lu(k,937) * b(k,67) - b(k,83) = b(k,83) - lu(k,938) * b(k,67) - b(k,84) = b(k,84) - lu(k,939) * b(k,67) - b(k,85) = b(k,85) - lu(k,940) * b(k,67) - b(k,86) = b(k,86) - lu(k,941) * b(k,67) - b(k,87) = b(k,87) - lu(k,942) * b(k,67) - b(k,88) = b(k,88) - lu(k,943) * b(k,67) - b(k,69) = b(k,69) - lu(k,980) * b(k,68) - b(k,70) = b(k,70) - lu(k,981) * b(k,68) - b(k,71) = b(k,71) - lu(k,982) * b(k,68) - b(k,72) = b(k,72) - lu(k,983) * b(k,68) - b(k,73) = b(k,73) - lu(k,984) * b(k,68) - b(k,74) = b(k,74) - lu(k,985) * b(k,68) - b(k,75) = b(k,75) - lu(k,986) * b(k,68) - b(k,76) = b(k,76) - lu(k,987) * b(k,68) - b(k,77) = b(k,77) - lu(k,988) * b(k,68) - b(k,78) = b(k,78) - lu(k,989) * b(k,68) - b(k,79) = b(k,79) - lu(k,990) * b(k,68) - b(k,80) = b(k,80) - lu(k,991) * b(k,68) - b(k,81) = b(k,81) - lu(k,992) * b(k,68) - b(k,82) = b(k,82) - lu(k,993) * b(k,68) - b(k,83) = b(k,83) - lu(k,994) * b(k,68) - b(k,84) = b(k,84) - lu(k,995) * b(k,68) - b(k,85) = b(k,85) - lu(k,996) * b(k,68) - b(k,86) = b(k,86) - lu(k,997) * b(k,68) - b(k,87) = b(k,87) - lu(k,998) * b(k,68) - b(k,88) = b(k,88) - lu(k,999) * b(k,68) - b(k,70) = b(k,70) - lu(k,1024) * b(k,69) - b(k,71) = b(k,71) - lu(k,1025) * b(k,69) - b(k,72) = b(k,72) - lu(k,1026) * b(k,69) - b(k,73) = b(k,73) - lu(k,1027) * b(k,69) - b(k,74) = b(k,74) - lu(k,1028) * b(k,69) - b(k,75) = b(k,75) - lu(k,1029) * b(k,69) - b(k,76) = b(k,76) - lu(k,1030) * b(k,69) - b(k,77) = b(k,77) - lu(k,1031) * b(k,69) - b(k,78) = b(k,78) - lu(k,1032) * b(k,69) - b(k,79) = b(k,79) - lu(k,1033) * b(k,69) - b(k,80) = b(k,80) - lu(k,1034) * b(k,69) - b(k,81) = b(k,81) - lu(k,1035) * b(k,69) - b(k,82) = b(k,82) - lu(k,1036) * b(k,69) - b(k,83) = b(k,83) - lu(k,1037) * b(k,69) - b(k,84) = b(k,84) - lu(k,1038) * b(k,69) - b(k,85) = b(k,85) - lu(k,1039) * b(k,69) - b(k,86) = b(k,86) - lu(k,1040) * b(k,69) - b(k,87) = b(k,87) - lu(k,1041) * b(k,69) - b(k,88) = b(k,88) - lu(k,1042) * b(k,69) - b(k,71) = b(k,71) - lu(k,1067) * b(k,70) - b(k,72) = b(k,72) - lu(k,1068) * b(k,70) - b(k,73) = b(k,73) - lu(k,1069) * b(k,70) - b(k,74) = b(k,74) - lu(k,1070) * b(k,70) - b(k,75) = b(k,75) - lu(k,1071) * b(k,70) - b(k,76) = b(k,76) - lu(k,1072) * b(k,70) - b(k,77) = b(k,77) - lu(k,1073) * b(k,70) - b(k,78) = b(k,78) - lu(k,1074) * b(k,70) - b(k,79) = b(k,79) - lu(k,1075) * b(k,70) - b(k,80) = b(k,80) - lu(k,1076) * b(k,70) - b(k,81) = b(k,81) - lu(k,1077) * b(k,70) - b(k,82) = b(k,82) - lu(k,1078) * b(k,70) - b(k,83) = b(k,83) - lu(k,1079) * b(k,70) - b(k,84) = b(k,84) - lu(k,1080) * b(k,70) - b(k,85) = b(k,85) - lu(k,1081) * b(k,70) - b(k,86) = b(k,86) - lu(k,1082) * b(k,70) - b(k,87) = b(k,87) - lu(k,1083) * b(k,70) - b(k,88) = b(k,88) - lu(k,1084) * b(k,70) - b(k,72) = b(k,72) - lu(k,1108) * b(k,71) - b(k,73) = b(k,73) - lu(k,1109) * b(k,71) - b(k,74) = b(k,74) - lu(k,1110) * b(k,71) - b(k,75) = b(k,75) - lu(k,1111) * b(k,71) - b(k,76) = b(k,76) - lu(k,1112) * b(k,71) - b(k,77) = b(k,77) - lu(k,1113) * b(k,71) - b(k,78) = b(k,78) - lu(k,1114) * b(k,71) - b(k,79) = b(k,79) - lu(k,1115) * b(k,71) - b(k,80) = b(k,80) - lu(k,1116) * b(k,71) - b(k,81) = b(k,81) - lu(k,1117) * b(k,71) - b(k,82) = b(k,82) - lu(k,1118) * b(k,71) - b(k,83) = b(k,83) - lu(k,1119) * b(k,71) - b(k,84) = b(k,84) - lu(k,1120) * b(k,71) - b(k,85) = b(k,85) - lu(k,1121) * b(k,71) - b(k,86) = b(k,86) - lu(k,1122) * b(k,71) - b(k,87) = b(k,87) - lu(k,1123) * b(k,71) - b(k,88) = b(k,88) - lu(k,1124) * b(k,71) - b(k,73) = b(k,73) - lu(k,1154) * b(k,72) - b(k,74) = b(k,74) - lu(k,1155) * b(k,72) - b(k,75) = b(k,75) - lu(k,1156) * b(k,72) - b(k,76) = b(k,76) - lu(k,1157) * b(k,72) - b(k,77) = b(k,77) - lu(k,1158) * b(k,72) - b(k,78) = b(k,78) - lu(k,1159) * b(k,72) - b(k,79) = b(k,79) - lu(k,1160) * b(k,72) - b(k,80) = b(k,80) - lu(k,1161) * b(k,72) - b(k,81) = b(k,81) - lu(k,1162) * b(k,72) - b(k,82) = b(k,82) - lu(k,1163) * b(k,72) - b(k,83) = b(k,83) - lu(k,1164) * b(k,72) - b(k,84) = b(k,84) - lu(k,1165) * b(k,72) - b(k,85) = b(k,85) - lu(k,1166) * b(k,72) - b(k,86) = b(k,86) - lu(k,1167) * b(k,72) - b(k,87) = b(k,87) - lu(k,1168) * b(k,72) - b(k,88) = b(k,88) - lu(k,1169) * b(k,72) - b(k,74) = b(k,74) - lu(k,1198) * b(k,73) - b(k,75) = b(k,75) - lu(k,1199) * b(k,73) - b(k,76) = b(k,76) - lu(k,1200) * b(k,73) - b(k,77) = b(k,77) - lu(k,1201) * b(k,73) - b(k,78) = b(k,78) - lu(k,1202) * b(k,73) - b(k,79) = b(k,79) - lu(k,1203) * b(k,73) - b(k,80) = b(k,80) - lu(k,1204) * b(k,73) - b(k,81) = b(k,81) - lu(k,1205) * b(k,73) - b(k,82) = b(k,82) - lu(k,1206) * b(k,73) - b(k,83) = b(k,83) - lu(k,1207) * b(k,73) - b(k,84) = b(k,84) - lu(k,1208) * b(k,73) - b(k,85) = b(k,85) - lu(k,1209) * b(k,73) - b(k,86) = b(k,86) - lu(k,1210) * b(k,73) - b(k,87) = b(k,87) - lu(k,1211) * b(k,73) - b(k,88) = b(k,88) - lu(k,1212) * b(k,73) - b(k,75) = b(k,75) - lu(k,1234) * b(k,74) - b(k,76) = b(k,76) - lu(k,1235) * b(k,74) - b(k,77) = b(k,77) - lu(k,1236) * b(k,74) - b(k,78) = b(k,78) - lu(k,1237) * b(k,74) - b(k,79) = b(k,79) - lu(k,1238) * b(k,74) - b(k,80) = b(k,80) - lu(k,1239) * b(k,74) - b(k,81) = b(k,81) - lu(k,1240) * b(k,74) - b(k,82) = b(k,82) - lu(k,1241) * b(k,74) - b(k,83) = b(k,83) - lu(k,1242) * b(k,74) - b(k,84) = b(k,84) - lu(k,1243) * b(k,74) - b(k,85) = b(k,85) - lu(k,1244) * b(k,74) - b(k,86) = b(k,86) - lu(k,1245) * b(k,74) - b(k,87) = b(k,87) - lu(k,1246) * b(k,74) - b(k,88) = b(k,88) - lu(k,1247) * b(k,74) - end do + b(66) = b(66) - lu(818) * b(65) + b(67) = b(67) - lu(819) * b(65) + b(68) = b(68) - lu(820) * b(65) + b(69) = b(69) - lu(821) * b(65) + b(70) = b(70) - lu(822) * b(65) + b(71) = b(71) - lu(823) * b(65) + b(72) = b(72) - lu(824) * b(65) + b(73) = b(73) - lu(825) * b(65) + b(74) = b(74) - lu(826) * b(65) + b(75) = b(75) - lu(827) * b(65) + b(76) = b(76) - lu(828) * b(65) + b(77) = b(77) - lu(829) * b(65) + b(78) = b(78) - lu(830) * b(65) + b(79) = b(79) - lu(831) * b(65) + b(80) = b(80) - lu(832) * b(65) + b(81) = b(81) - lu(833) * b(65) + b(82) = b(82) - lu(834) * b(65) + b(83) = b(83) - lu(835) * b(65) + b(84) = b(84) - lu(836) * b(65) + b(85) = b(85) - lu(837) * b(65) + b(86) = b(86) - lu(838) * b(65) + b(87) = b(87) - lu(839) * b(65) + b(67) = b(67) - lu(861) * b(66) + b(68) = b(68) - lu(862) * b(66) + b(69) = b(69) - lu(863) * b(66) + b(70) = b(70) - lu(864) * b(66) + b(71) = b(71) - lu(865) * b(66) + b(72) = b(72) - lu(866) * b(66) + b(73) = b(73) - lu(867) * b(66) + b(74) = b(74) - lu(868) * b(66) + b(75) = b(75) - lu(869) * b(66) + b(76) = b(76) - lu(870) * b(66) + b(77) = b(77) - lu(871) * b(66) + b(78) = b(78) - lu(872) * b(66) + b(79) = b(79) - lu(873) * b(66) + b(80) = b(80) - lu(874) * b(66) + b(81) = b(81) - lu(875) * b(66) + b(82) = b(82) - lu(876) * b(66) + b(83) = b(83) - lu(877) * b(66) + b(84) = b(84) - lu(878) * b(66) + b(85) = b(85) - lu(879) * b(66) + b(86) = b(86) - lu(880) * b(66) + b(87) = b(87) - lu(881) * b(66) + b(68) = b(68) - lu(906) * b(67) + b(69) = b(69) - lu(907) * b(67) + b(70) = b(70) - lu(908) * b(67) + b(71) = b(71) - lu(909) * b(67) + b(72) = b(72) - lu(910) * b(67) + b(73) = b(73) - lu(911) * b(67) + b(74) = b(74) - lu(912) * b(67) + b(75) = b(75) - lu(913) * b(67) + b(76) = b(76) - lu(914) * b(67) + b(77) = b(77) - lu(915) * b(67) + b(78) = b(78) - lu(916) * b(67) + b(79) = b(79) - lu(917) * b(67) + b(80) = b(80) - lu(918) * b(67) + b(81) = b(81) - lu(919) * b(67) + b(82) = b(82) - lu(920) * b(67) + b(83) = b(83) - lu(921) * b(67) + b(84) = b(84) - lu(922) * b(67) + b(85) = b(85) - lu(923) * b(67) + b(86) = b(86) - lu(924) * b(67) + b(87) = b(87) - lu(925) * b(67) + b(69) = b(69) - lu(942) * b(68) + b(70) = b(70) - lu(943) * b(68) + b(71) = b(71) - lu(944) * b(68) + b(72) = b(72) - lu(945) * b(68) + b(73) = b(73) - lu(946) * b(68) + b(74) = b(74) - lu(947) * b(68) + b(75) = b(75) - lu(948) * b(68) + b(76) = b(76) - lu(949) * b(68) + b(77) = b(77) - lu(950) * b(68) + b(78) = b(78) - lu(951) * b(68) + b(79) = b(79) - lu(952) * b(68) + b(80) = b(80) - lu(953) * b(68) + b(81) = b(81) - lu(954) * b(68) + b(82) = b(82) - lu(955) * b(68) + b(83) = b(83) - lu(956) * b(68) + b(84) = b(84) - lu(957) * b(68) + b(85) = b(85) - lu(958) * b(68) + b(86) = b(86) - lu(959) * b(68) + b(87) = b(87) - lu(960) * b(68) + b(70) = b(70) - lu(984) * b(69) + b(71) = b(71) - lu(985) * b(69) + b(72) = b(72) - lu(986) * b(69) + b(73) = b(73) - lu(987) * b(69) + b(74) = b(74) - lu(988) * b(69) + b(75) = b(75) - lu(989) * b(69) + b(76) = b(76) - lu(990) * b(69) + b(77) = b(77) - lu(991) * b(69) + b(78) = b(78) - lu(992) * b(69) + b(79) = b(79) - lu(993) * b(69) + b(80) = b(80) - lu(994) * b(69) + b(81) = b(81) - lu(995) * b(69) + b(82) = b(82) - lu(996) * b(69) + b(83) = b(83) - lu(997) * b(69) + b(84) = b(84) - lu(998) * b(69) + b(85) = b(85) - lu(999) * b(69) + b(86) = b(86) - lu(1000) * b(69) + b(87) = b(87) - lu(1001) * b(69) + b(71) = b(71) - lu(1027) * b(70) + b(72) = b(72) - lu(1028) * b(70) + b(73) = b(73) - lu(1029) * b(70) + b(74) = b(74) - lu(1030) * b(70) + b(75) = b(75) - lu(1031) * b(70) + b(76) = b(76) - lu(1032) * b(70) + b(77) = b(77) - lu(1033) * b(70) + b(78) = b(78) - lu(1034) * b(70) + b(79) = b(79) - lu(1035) * b(70) + b(80) = b(80) - lu(1036) * b(70) + b(81) = b(81) - lu(1037) * b(70) + b(82) = b(82) - lu(1038) * b(70) + b(83) = b(83) - lu(1039) * b(70) + b(84) = b(84) - lu(1040) * b(70) + b(85) = b(85) - lu(1041) * b(70) + b(86) = b(86) - lu(1042) * b(70) + b(87) = b(87) - lu(1043) * b(70) + b(72) = b(72) - lu(1072) * b(71) + b(73) = b(73) - lu(1073) * b(71) + b(74) = b(74) - lu(1074) * b(71) + b(75) = b(75) - lu(1075) * b(71) + b(76) = b(76) - lu(1076) * b(71) + b(77) = b(77) - lu(1077) * b(71) + b(78) = b(78) - lu(1078) * b(71) + b(79) = b(79) - lu(1079) * b(71) + b(80) = b(80) - lu(1080) * b(71) + b(81) = b(81) - lu(1081) * b(71) + b(82) = b(82) - lu(1082) * b(71) + b(83) = b(83) - lu(1083) * b(71) + b(84) = b(84) - lu(1084) * b(71) + b(85) = b(85) - lu(1085) * b(71) + b(86) = b(86) - lu(1086) * b(71) + b(87) = b(87) - lu(1087) * b(71) + b(73) = b(73) - lu(1115) * b(72) + b(74) = b(74) - lu(1116) * b(72) + b(75) = b(75) - lu(1117) * b(72) + b(76) = b(76) - lu(1118) * b(72) + b(77) = b(77) - lu(1119) * b(72) + b(78) = b(78) - lu(1120) * b(72) + b(79) = b(79) - lu(1121) * b(72) + b(80) = b(80) - lu(1122) * b(72) + b(81) = b(81) - lu(1123) * b(72) + b(82) = b(82) - lu(1124) * b(72) + b(83) = b(83) - lu(1125) * b(72) + b(84) = b(84) - lu(1126) * b(72) + b(85) = b(85) - lu(1127) * b(72) + b(86) = b(86) - lu(1128) * b(72) + b(87) = b(87) - lu(1129) * b(72) + b(74) = b(74) - lu(1159) * b(73) + b(75) = b(75) - lu(1160) * b(73) + b(76) = b(76) - lu(1161) * b(73) + b(77) = b(77) - lu(1162) * b(73) + b(78) = b(78) - lu(1163) * b(73) + b(79) = b(79) - lu(1164) * b(73) + b(80) = b(80) - lu(1165) * b(73) + b(81) = b(81) - lu(1166) * b(73) + b(82) = b(82) - lu(1167) * b(73) + b(83) = b(83) - lu(1168) * b(73) + b(84) = b(84) - lu(1169) * b(73) + b(85) = b(85) - lu(1170) * b(73) + b(86) = b(86) - lu(1171) * b(73) + b(87) = b(87) - lu(1172) * b(73) + b(75) = b(75) - lu(1202) * b(74) + b(76) = b(76) - lu(1203) * b(74) + b(77) = b(77) - lu(1204) * b(74) + b(78) = b(78) - lu(1205) * b(74) + b(79) = b(79) - lu(1206) * b(74) + b(80) = b(80) - lu(1207) * b(74) + b(81) = b(81) - lu(1208) * b(74) + b(82) = b(82) - lu(1209) * b(74) + b(83) = b(83) - lu(1210) * b(74) + b(84) = b(84) - lu(1211) * b(74) + b(85) = b(85) - lu(1212) * b(74) + b(86) = b(86) - lu(1213) * b(74) + b(87) = b(87) - lu(1214) * b(74) + b(76) = b(76) - lu(1238) * b(75) + b(77) = b(77) - lu(1239) * b(75) + b(78) = b(78) - lu(1240) * b(75) + b(79) = b(79) - lu(1241) * b(75) + b(80) = b(80) - lu(1242) * b(75) + b(81) = b(81) - lu(1243) * b(75) + b(82) = b(82) - lu(1244) * b(75) + b(83) = b(83) - lu(1245) * b(75) + b(84) = b(84) - lu(1246) * b(75) + b(85) = b(85) - lu(1247) * b(75) + b(86) = b(86) - lu(1248) * b(75) + b(87) = b(87) - lu(1249) * b(75) + b(77) = b(77) - lu(1283) * b(76) + b(78) = b(78) - lu(1284) * b(76) + b(79) = b(79) - lu(1285) * b(76) + b(80) = b(80) - lu(1286) * b(76) + b(81) = b(81) - lu(1287) * b(76) + b(82) = b(82) - lu(1288) * b(76) + b(83) = b(83) - lu(1289) * b(76) + b(84) = b(84) - lu(1290) * b(76) + b(85) = b(85) - lu(1291) * b(76) + b(86) = b(86) - lu(1292) * b(76) + b(87) = b(87) - lu(1293) * b(76) + b(78) = b(78) - lu(1325) * b(77) + b(79) = b(79) - lu(1326) * b(77) + b(80) = b(80) - lu(1327) * b(77) + b(81) = b(81) - lu(1328) * b(77) + b(82) = b(82) - lu(1329) * b(77) + b(83) = b(83) - lu(1330) * b(77) + b(84) = b(84) - lu(1331) * b(77) + b(85) = b(85) - lu(1332) * b(77) + b(86) = b(86) - lu(1333) * b(77) + b(87) = b(87) - lu(1334) * b(77) end subroutine lu_slv04 - subroutine lu_slv05( avec_len, lu, b ) + subroutine lu_slv05( 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) + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) !----------------------------------------------------------------------- ! ... Local variables !----------------------------------------------------------------------- - integer :: k !----------------------------------------------------------------------- ! ... solve L * y = b !----------------------------------------------------------------------- - do k = 1,avec_len - b(k,76) = b(k,76) - lu(k,1278) * b(k,75) - b(k,77) = b(k,77) - lu(k,1279) * b(k,75) - b(k,78) = b(k,78) - lu(k,1280) * b(k,75) - b(k,79) = b(k,79) - lu(k,1281) * b(k,75) - b(k,80) = b(k,80) - lu(k,1282) * b(k,75) - b(k,81) = b(k,81) - lu(k,1283) * b(k,75) - b(k,82) = b(k,82) - lu(k,1284) * b(k,75) - b(k,83) = b(k,83) - lu(k,1285) * b(k,75) - b(k,84) = b(k,84) - lu(k,1286) * b(k,75) - b(k,85) = b(k,85) - lu(k,1287) * b(k,75) - b(k,86) = b(k,86) - lu(k,1288) * b(k,75) - b(k,87) = b(k,87) - lu(k,1289) * b(k,75) - b(k,88) = b(k,88) - lu(k,1290) * b(k,75) - b(k,77) = b(k,77) - lu(k,1315) * b(k,76) - b(k,78) = b(k,78) - lu(k,1316) * b(k,76) - b(k,79) = b(k,79) - lu(k,1317) * b(k,76) - b(k,80) = b(k,80) - lu(k,1318) * b(k,76) - b(k,81) = b(k,81) - lu(k,1319) * b(k,76) - b(k,82) = b(k,82) - lu(k,1320) * b(k,76) - b(k,83) = b(k,83) - lu(k,1321) * b(k,76) - b(k,84) = b(k,84) - lu(k,1322) * b(k,76) - b(k,85) = b(k,85) - lu(k,1323) * b(k,76) - b(k,86) = b(k,86) - lu(k,1324) * b(k,76) - b(k,87) = b(k,87) - lu(k,1325) * b(k,76) - b(k,88) = b(k,88) - lu(k,1326) * b(k,76) - b(k,78) = b(k,78) - lu(k,1361) * b(k,77) - b(k,79) = b(k,79) - lu(k,1362) * b(k,77) - b(k,80) = b(k,80) - lu(k,1363) * b(k,77) - b(k,81) = b(k,81) - lu(k,1364) * b(k,77) - b(k,82) = b(k,82) - lu(k,1365) * b(k,77) - b(k,83) = b(k,83) - lu(k,1366) * b(k,77) - b(k,84) = b(k,84) - lu(k,1367) * b(k,77) - b(k,85) = b(k,85) - lu(k,1368) * b(k,77) - b(k,86) = b(k,86) - lu(k,1369) * b(k,77) - b(k,87) = b(k,87) - lu(k,1370) * b(k,77) - b(k,88) = b(k,88) - lu(k,1371) * b(k,77) - b(k,79) = b(k,79) - lu(k,1404) * b(k,78) - b(k,80) = b(k,80) - lu(k,1405) * b(k,78) - b(k,81) = b(k,81) - lu(k,1406) * b(k,78) - b(k,82) = b(k,82) - lu(k,1407) * b(k,78) - b(k,83) = b(k,83) - lu(k,1408) * b(k,78) - b(k,84) = b(k,84) - lu(k,1409) * b(k,78) - b(k,85) = b(k,85) - lu(k,1410) * b(k,78) - b(k,86) = b(k,86) - lu(k,1411) * b(k,78) - b(k,87) = b(k,87) - lu(k,1412) * b(k,78) - b(k,88) = b(k,88) - lu(k,1413) * b(k,78) - b(k,80) = b(k,80) - lu(k,1443) * b(k,79) - b(k,81) = b(k,81) - lu(k,1444) * b(k,79) - b(k,82) = b(k,82) - lu(k,1445) * b(k,79) - b(k,83) = b(k,83) - lu(k,1446) * b(k,79) - b(k,84) = b(k,84) - lu(k,1447) * b(k,79) - b(k,85) = b(k,85) - lu(k,1448) * b(k,79) - b(k,86) = b(k,86) - lu(k,1449) * b(k,79) - b(k,87) = b(k,87) - lu(k,1450) * b(k,79) - b(k,88) = b(k,88) - lu(k,1451) * b(k,79) - b(k,81) = b(k,81) - lu(k,1489) * b(k,80) - b(k,82) = b(k,82) - lu(k,1490) * b(k,80) - b(k,83) = b(k,83) - lu(k,1491) * b(k,80) - b(k,84) = b(k,84) - lu(k,1492) * b(k,80) - b(k,85) = b(k,85) - lu(k,1493) * b(k,80) - b(k,86) = b(k,86) - lu(k,1494) * b(k,80) - b(k,87) = b(k,87) - lu(k,1495) * b(k,80) - b(k,88) = b(k,88) - lu(k,1496) * b(k,80) - b(k,82) = b(k,82) - lu(k,1533) * b(k,81) - b(k,83) = b(k,83) - lu(k,1534) * b(k,81) - b(k,84) = b(k,84) - lu(k,1535) * b(k,81) - b(k,85) = b(k,85) - lu(k,1536) * b(k,81) - b(k,86) = b(k,86) - lu(k,1537) * b(k,81) - b(k,87) = b(k,87) - lu(k,1538) * b(k,81) - b(k,88) = b(k,88) - lu(k,1539) * b(k,81) - b(k,83) = b(k,83) - lu(k,1577) * b(k,82) - b(k,84) = b(k,84) - lu(k,1578) * b(k,82) - b(k,85) = b(k,85) - lu(k,1579) * b(k,82) - b(k,86) = b(k,86) - lu(k,1580) * b(k,82) - b(k,87) = b(k,87) - lu(k,1581) * b(k,82) - b(k,88) = b(k,88) - lu(k,1582) * b(k,82) - b(k,84) = b(k,84) - lu(k,1611) * b(k,83) - b(k,85) = b(k,85) - lu(k,1612) * b(k,83) - b(k,86) = b(k,86) - lu(k,1613) * b(k,83) - b(k,87) = b(k,87) - lu(k,1614) * b(k,83) - b(k,88) = b(k,88) - lu(k,1615) * b(k,83) - b(k,85) = b(k,85) - lu(k,1648) * b(k,84) - b(k,86) = b(k,86) - lu(k,1649) * b(k,84) - b(k,87) = b(k,87) - lu(k,1650) * b(k,84) - b(k,88) = b(k,88) - lu(k,1651) * b(k,84) - b(k,86) = b(k,86) - lu(k,1692) * b(k,85) - b(k,87) = b(k,87) - lu(k,1693) * b(k,85) - b(k,88) = b(k,88) - lu(k,1694) * b(k,85) - b(k,87) = b(k,87) - lu(k,1729) * b(k,86) - b(k,88) = b(k,88) - lu(k,1730) * b(k,86) - b(k,88) = b(k,88) - lu(k,1772) * b(k,87) - end do + b(79) = b(79) - lu(1368) * b(78) + b(80) = b(80) - lu(1369) * b(78) + b(81) = b(81) - lu(1370) * b(78) + b(82) = b(82) - lu(1371) * b(78) + b(83) = b(83) - lu(1372) * b(78) + b(84) = b(84) - lu(1373) * b(78) + b(85) = b(85) - lu(1374) * b(78) + b(86) = b(86) - lu(1375) * b(78) + b(87) = b(87) - lu(1376) * b(78) + b(80) = b(80) - lu(1411) * b(79) + b(81) = b(81) - lu(1412) * b(79) + b(82) = b(82) - lu(1413) * b(79) + b(83) = b(83) - lu(1414) * b(79) + b(84) = b(84) - lu(1415) * b(79) + b(85) = b(85) - lu(1416) * b(79) + b(86) = b(86) - lu(1417) * b(79) + b(87) = b(87) - lu(1418) * b(79) + b(81) = b(81) - lu(1454) * b(80) + b(82) = b(82) - lu(1455) * b(80) + b(83) = b(83) - lu(1456) * b(80) + b(84) = b(84) - lu(1457) * b(80) + b(85) = b(85) - lu(1458) * b(80) + b(86) = b(86) - lu(1459) * b(80) + b(87) = b(87) - lu(1460) * b(80) + b(82) = b(82) - lu(1510) * b(81) + b(83) = b(83) - lu(1511) * b(81) + b(84) = b(84) - lu(1512) * b(81) + b(85) = b(85) - lu(1513) * b(81) + b(86) = b(86) - lu(1514) * b(81) + b(87) = b(87) - lu(1515) * b(81) + b(83) = b(83) - lu(1543) * b(82) + b(84) = b(84) - lu(1544) * b(82) + b(85) = b(85) - lu(1545) * b(82) + b(86) = b(86) - lu(1546) * b(82) + b(87) = b(87) - lu(1547) * b(82) + b(84) = b(84) - lu(1579) * b(83) + b(85) = b(85) - lu(1580) * b(83) + b(86) = b(86) - lu(1581) * b(83) + b(87) = b(87) - lu(1582) * b(83) + b(85) = b(85) - lu(1618) * b(84) + b(86) = b(86) - lu(1619) * b(84) + b(87) = b(87) - lu(1620) * b(84) + b(86) = b(86) - lu(1658) * b(85) + b(87) = b(87) - lu(1659) * b(85) + b(87) = b(87) - lu(1693) * b(86) end subroutine lu_slv05 - subroutine lu_slv06( avec_len, lu, b ) + subroutine lu_slv06( 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) + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) !----------------------------------------------------------------------- ! ... Local variables !----------------------------------------------------------------------- - integer :: k !----------------------------------------------------------------------- ! ... solve L * y = b !----------------------------------------------------------------------- - do k = 1,avec_len !----------------------------------------------------------------------- ! ... Solve U * x = y !----------------------------------------------------------------------- - b(k,88) = b(k,88) * lu(k,1825) - b(k,87) = b(k,87) - lu(k,1824) * b(k,88) - b(k,86) = b(k,86) - lu(k,1823) * b(k,88) - b(k,85) = b(k,85) - lu(k,1822) * b(k,88) - b(k,84) = b(k,84) - lu(k,1821) * b(k,88) - b(k,83) = b(k,83) - lu(k,1820) * b(k,88) - b(k,82) = b(k,82) - lu(k,1819) * b(k,88) - b(k,81) = b(k,81) - lu(k,1818) * b(k,88) - b(k,80) = b(k,80) - lu(k,1817) * b(k,88) - b(k,79) = b(k,79) - lu(k,1816) * b(k,88) - b(k,78) = b(k,78) - lu(k,1815) * b(k,88) - b(k,77) = b(k,77) - lu(k,1814) * b(k,88) - b(k,76) = b(k,76) - lu(k,1813) * b(k,88) - b(k,75) = b(k,75) - lu(k,1812) * b(k,88) - b(k,74) = b(k,74) - lu(k,1811) * b(k,88) - b(k,73) = b(k,73) - lu(k,1810) * b(k,88) - b(k,72) = b(k,72) - lu(k,1809) * b(k,88) - b(k,71) = b(k,71) - lu(k,1808) * b(k,88) - b(k,70) = b(k,70) - lu(k,1807) * b(k,88) - b(k,69) = b(k,69) - lu(k,1806) * b(k,88) - b(k,68) = b(k,68) - lu(k,1805) * b(k,88) - b(k,67) = b(k,67) - lu(k,1804) * b(k,88) - b(k,66) = b(k,66) - lu(k,1803) * b(k,88) - b(k,65) = b(k,65) - lu(k,1802) * b(k,88) - b(k,64) = b(k,64) - lu(k,1801) * b(k,88) - b(k,63) = b(k,63) - lu(k,1800) * b(k,88) - b(k,62) = b(k,62) - lu(k,1799) * b(k,88) - b(k,61) = b(k,61) - lu(k,1798) * b(k,88) - b(k,60) = b(k,60) - lu(k,1797) * b(k,88) - b(k,58) = b(k,58) - lu(k,1796) * b(k,88) - b(k,57) = b(k,57) - lu(k,1795) * b(k,88) - b(k,56) = b(k,56) - lu(k,1794) * b(k,88) - b(k,55) = b(k,55) - lu(k,1793) * b(k,88) - b(k,54) = b(k,54) - lu(k,1792) * b(k,88) - b(k,53) = b(k,53) - lu(k,1791) * b(k,88) - b(k,50) = b(k,50) - lu(k,1790) * b(k,88) - b(k,47) = b(k,47) - lu(k,1789) * b(k,88) - b(k,46) = b(k,46) - lu(k,1788) * b(k,88) - b(k,43) = b(k,43) - lu(k,1787) * b(k,88) - b(k,41) = b(k,41) - lu(k,1786) * b(k,88) - b(k,39) = b(k,39) - lu(k,1785) * b(k,88) - b(k,30) = b(k,30) - lu(k,1784) * b(k,88) - b(k,27) = b(k,27) - lu(k,1783) * b(k,88) - b(k,26) = b(k,26) - lu(k,1782) * b(k,88) - b(k,24) = b(k,24) - lu(k,1781) * b(k,88) - b(k,23) = b(k,23) - lu(k,1780) * b(k,88) - b(k,22) = b(k,22) - lu(k,1779) * b(k,88) - b(k,21) = b(k,21) - lu(k,1778) * b(k,88) - b(k,13) = b(k,13) - lu(k,1777) * b(k,88) - b(k,11) = b(k,11) - lu(k,1776) * b(k,88) - b(k,9) = b(k,9) - lu(k,1775) * b(k,88) - b(k,8) = b(k,8) - lu(k,1774) * b(k,88) - b(k,7) = b(k,7) - lu(k,1773) * b(k,88) - b(k,87) = b(k,87) * lu(k,1771) - b(k,86) = b(k,86) - lu(k,1770) * b(k,87) - b(k,85) = b(k,85) - lu(k,1769) * b(k,87) - b(k,84) = b(k,84) - lu(k,1768) * b(k,87) - b(k,83) = b(k,83) - lu(k,1767) * b(k,87) - b(k,82) = b(k,82) - lu(k,1766) * b(k,87) - b(k,81) = b(k,81) - lu(k,1765) * b(k,87) - b(k,80) = b(k,80) - lu(k,1764) * b(k,87) - b(k,79) = b(k,79) - lu(k,1763) * b(k,87) - b(k,78) = b(k,78) - lu(k,1762) * b(k,87) - b(k,77) = b(k,77) - lu(k,1761) * b(k,87) - b(k,76) = b(k,76) - lu(k,1760) * b(k,87) - b(k,75) = b(k,75) - lu(k,1759) * b(k,87) - b(k,74) = b(k,74) - lu(k,1758) * b(k,87) - b(k,73) = b(k,73) - lu(k,1757) * b(k,87) - b(k,72) = b(k,72) - lu(k,1756) * b(k,87) - b(k,71) = b(k,71) - lu(k,1755) * b(k,87) - b(k,70) = b(k,70) - lu(k,1754) * b(k,87) - b(k,69) = b(k,69) - lu(k,1753) * b(k,87) - b(k,68) = b(k,68) - lu(k,1752) * b(k,87) - b(k,67) = b(k,67) - lu(k,1751) * b(k,87) - b(k,66) = b(k,66) - lu(k,1750) * b(k,87) - b(k,65) = b(k,65) - lu(k,1749) * b(k,87) - b(k,64) = b(k,64) - lu(k,1748) * b(k,87) - b(k,63) = b(k,63) - lu(k,1747) * b(k,87) - b(k,62) = b(k,62) - lu(k,1746) * b(k,87) - b(k,61) = b(k,61) - lu(k,1745) * b(k,87) - b(k,60) = b(k,60) - lu(k,1744) * b(k,87) - b(k,58) = b(k,58) - lu(k,1743) * b(k,87) - b(k,57) = b(k,57) - lu(k,1742) * b(k,87) - b(k,56) = b(k,56) - lu(k,1741) * b(k,87) - b(k,55) = b(k,55) - lu(k,1740) * b(k,87) - b(k,54) = b(k,54) - lu(k,1739) * b(k,87) - b(k,52) = b(k,52) - lu(k,1738) * b(k,87) - b(k,49) = b(k,49) - lu(k,1737) * b(k,87) - b(k,47) = b(k,47) - lu(k,1736) * b(k,87) - b(k,44) = b(k,44) - lu(k,1735) * b(k,87) - b(k,40) = b(k,40) - lu(k,1734) * b(k,87) - b(k,39) = b(k,39) - lu(k,1733) * b(k,87) - b(k,35) = b(k,35) - lu(k,1732) * b(k,87) - b(k,24) = b(k,24) - lu(k,1731) * b(k,87) - b(k,86) = b(k,86) * lu(k,1728) - b(k,85) = b(k,85) - lu(k,1727) * b(k,86) - b(k,84) = b(k,84) - lu(k,1726) * b(k,86) - b(k,83) = b(k,83) - lu(k,1725) * b(k,86) - b(k,82) = b(k,82) - lu(k,1724) * b(k,86) - b(k,81) = b(k,81) - lu(k,1723) * b(k,86) - b(k,80) = b(k,80) - lu(k,1722) * b(k,86) - b(k,79) = b(k,79) - lu(k,1721) * b(k,86) - b(k,78) = b(k,78) - lu(k,1720) * b(k,86) - b(k,77) = b(k,77) - lu(k,1719) * b(k,86) - b(k,76) = b(k,76) - lu(k,1718) * b(k,86) - b(k,75) = b(k,75) - lu(k,1717) * b(k,86) - b(k,74) = b(k,74) - lu(k,1716) * b(k,86) - b(k,73) = b(k,73) - lu(k,1715) * b(k,86) - b(k,72) = b(k,72) - lu(k,1714) * b(k,86) - b(k,71) = b(k,71) - lu(k,1713) * b(k,86) - b(k,70) = b(k,70) - lu(k,1712) * b(k,86) - b(k,69) = b(k,69) - lu(k,1711) * b(k,86) - b(k,68) = b(k,68) - lu(k,1710) * b(k,86) - b(k,67) = b(k,67) - lu(k,1709) * b(k,86) - b(k,66) = b(k,66) - lu(k,1708) * b(k,86) - b(k,65) = b(k,65) - lu(k,1707) * b(k,86) - b(k,64) = b(k,64) - lu(k,1706) * b(k,86) - b(k,63) = b(k,63) - lu(k,1705) * b(k,86) - b(k,62) = b(k,62) - lu(k,1704) * b(k,86) - b(k,61) = b(k,61) - lu(k,1703) * b(k,86) - b(k,60) = b(k,60) - lu(k,1702) * b(k,86) - b(k,59) = b(k,59) - lu(k,1701) * b(k,86) - b(k,58) = b(k,58) - lu(k,1700) * b(k,86) - b(k,57) = b(k,57) - lu(k,1699) * b(k,86) - b(k,56) = b(k,56) - lu(k,1698) * b(k,86) - b(k,50) = b(k,50) - lu(k,1697) * b(k,86) - b(k,49) = b(k,49) - lu(k,1696) * b(k,86) - b(k,26) = b(k,26) - lu(k,1695) * b(k,86) - b(k,85) = b(k,85) * lu(k,1691) - b(k,84) = b(k,84) - lu(k,1690) * b(k,85) - b(k,83) = b(k,83) - lu(k,1689) * b(k,85) - b(k,82) = b(k,82) - lu(k,1688) * b(k,85) - b(k,81) = b(k,81) - lu(k,1687) * b(k,85) - b(k,80) = b(k,80) - lu(k,1686) * b(k,85) - b(k,79) = b(k,79) - lu(k,1685) * b(k,85) - b(k,78) = b(k,78) - lu(k,1684) * b(k,85) - b(k,77) = b(k,77) - lu(k,1683) * b(k,85) - b(k,76) = b(k,76) - lu(k,1682) * b(k,85) - b(k,75) = b(k,75) - lu(k,1681) * b(k,85) - b(k,74) = b(k,74) - lu(k,1680) * b(k,85) - b(k,73) = b(k,73) - lu(k,1679) * b(k,85) - b(k,72) = b(k,72) - lu(k,1678) * b(k,85) - b(k,71) = b(k,71) - lu(k,1677) * b(k,85) - b(k,70) = b(k,70) - lu(k,1676) * b(k,85) - b(k,69) = b(k,69) - lu(k,1675) * b(k,85) - b(k,68) = b(k,68) - lu(k,1674) * b(k,85) - b(k,67) = b(k,67) - lu(k,1673) * b(k,85) - b(k,66) = b(k,66) - lu(k,1672) * b(k,85) - b(k,65) = b(k,65) - lu(k,1671) * b(k,85) - b(k,64) = b(k,64) - lu(k,1670) * b(k,85) - b(k,63) = b(k,63) - lu(k,1669) * b(k,85) - b(k,62) = b(k,62) - lu(k,1668) * b(k,85) - b(k,61) = b(k,61) - lu(k,1667) * b(k,85) - b(k,60) = b(k,60) - lu(k,1666) * b(k,85) - b(k,59) = b(k,59) - lu(k,1665) * b(k,85) - b(k,58) = b(k,58) - lu(k,1664) * b(k,85) - b(k,57) = b(k,57) - lu(k,1663) * b(k,85) - b(k,56) = b(k,56) - lu(k,1662) * b(k,85) - b(k,52) = b(k,52) - lu(k,1661) * b(k,85) - b(k,50) = b(k,50) - lu(k,1660) * b(k,85) - b(k,44) = b(k,44) - lu(k,1659) * b(k,85) - b(k,39) = b(k,39) - lu(k,1658) * b(k,85) - b(k,35) = b(k,35) - lu(k,1657) * b(k,85) - b(k,34) = b(k,34) - lu(k,1656) * b(k,85) - b(k,32) = b(k,32) - lu(k,1655) * b(k,85) - b(k,25) = b(k,25) - lu(k,1654) * b(k,85) - b(k,18) = b(k,18) - lu(k,1653) * b(k,85) - b(k,4) = b(k,4) - lu(k,1652) * b(k,85) - b(k,84) = b(k,84) * lu(k,1647) - b(k,83) = b(k,83) - lu(k,1646) * b(k,84) - b(k,82) = b(k,82) - lu(k,1645) * b(k,84) - b(k,81) = b(k,81) - lu(k,1644) * b(k,84) - b(k,80) = b(k,80) - lu(k,1643) * b(k,84) - b(k,79) = b(k,79) - lu(k,1642) * b(k,84) - b(k,78) = b(k,78) - lu(k,1641) * b(k,84) - b(k,77) = b(k,77) - lu(k,1640) * b(k,84) - b(k,76) = b(k,76) - lu(k,1639) * b(k,84) - b(k,75) = b(k,75) - lu(k,1638) * b(k,84) - b(k,74) = b(k,74) - lu(k,1637) * b(k,84) - b(k,73) = b(k,73) - lu(k,1636) * b(k,84) - b(k,72) = b(k,72) - lu(k,1635) * b(k,84) - b(k,71) = b(k,71) - lu(k,1634) * b(k,84) - b(k,70) = b(k,70) - lu(k,1633) * b(k,84) - b(k,69) = b(k,69) - lu(k,1632) * b(k,84) - b(k,68) = b(k,68) - lu(k,1631) * b(k,84) - b(k,67) = b(k,67) - lu(k,1630) * b(k,84) - b(k,66) = b(k,66) - lu(k,1629) * b(k,84) - b(k,65) = b(k,65) - lu(k,1628) * b(k,84) - b(k,64) = b(k,64) - lu(k,1627) * b(k,84) - b(k,63) = b(k,63) - lu(k,1626) * b(k,84) - b(k,62) = b(k,62) - lu(k,1625) * b(k,84) - b(k,61) = b(k,61) - lu(k,1624) * b(k,84) - b(k,60) = b(k,60) - lu(k,1623) * b(k,84) - b(k,58) = b(k,58) - lu(k,1622) * b(k,84) - b(k,57) = b(k,57) - lu(k,1621) * b(k,84) - b(k,56) = b(k,56) - lu(k,1620) * b(k,84) - b(k,50) = b(k,50) - lu(k,1619) * b(k,84) - b(k,49) = b(k,49) - lu(k,1618) * b(k,84) - b(k,41) = b(k,41) - lu(k,1617) * b(k,84) - b(k,36) = b(k,36) - lu(k,1616) * b(k,84) - b(k,83) = b(k,83) * lu(k,1610) - b(k,82) = b(k,82) - lu(k,1609) * b(k,83) - b(k,81) = b(k,81) - lu(k,1608) * b(k,83) - b(k,80) = b(k,80) - lu(k,1607) * b(k,83) - b(k,79) = b(k,79) - lu(k,1606) * b(k,83) - b(k,78) = b(k,78) - lu(k,1605) * b(k,83) - b(k,77) = b(k,77) - lu(k,1604) * b(k,83) - b(k,76) = b(k,76) - lu(k,1603) * b(k,83) - b(k,75) = b(k,75) - lu(k,1602) * b(k,83) - b(k,74) = b(k,74) - lu(k,1601) * b(k,83) - b(k,73) = b(k,73) - lu(k,1600) * b(k,83) - b(k,72) = b(k,72) - lu(k,1599) * b(k,83) - b(k,71) = b(k,71) - lu(k,1598) * b(k,83) - b(k,70) = b(k,70) - lu(k,1597) * b(k,83) - b(k,69) = b(k,69) - lu(k,1596) * b(k,83) - b(k,68) = b(k,68) - lu(k,1595) * b(k,83) - b(k,67) = b(k,67) - lu(k,1594) * b(k,83) - b(k,66) = b(k,66) - lu(k,1593) * b(k,83) - b(k,65) = b(k,65) - lu(k,1592) * b(k,83) - b(k,64) = b(k,64) - lu(k,1591) * b(k,83) - b(k,63) = b(k,63) - lu(k,1590) * b(k,83) - b(k,62) = b(k,62) - lu(k,1589) * b(k,83) - b(k,61) = b(k,61) - lu(k,1588) * b(k,83) - b(k,60) = b(k,60) - lu(k,1587) * b(k,83) - b(k,58) = b(k,58) - lu(k,1586) * b(k,83) - b(k,49) = b(k,49) - lu(k,1585) * b(k,83) - b(k,42) = b(k,42) - lu(k,1584) * b(k,83) - b(k,35) = b(k,35) - lu(k,1583) * b(k,83) - end do + b(87) = b(87) * lu(1745) + b(86) = b(86) - lu(1744) * b(87) + b(85) = b(85) - lu(1743) * b(87) + b(84) = b(84) - lu(1742) * b(87) + b(83) = b(83) - lu(1741) * b(87) + b(82) = b(82) - lu(1740) * b(87) + b(81) = b(81) - lu(1739) * b(87) + b(80) = b(80) - lu(1738) * b(87) + b(79) = b(79) - lu(1737) * b(87) + b(78) = b(78) - lu(1736) * b(87) + b(77) = b(77) - lu(1735) * b(87) + b(76) = b(76) - lu(1734) * b(87) + b(75) = b(75) - lu(1733) * b(87) + b(74) = b(74) - lu(1732) * b(87) + b(73) = b(73) - lu(1731) * b(87) + b(72) = b(72) - lu(1730) * b(87) + b(71) = b(71) - lu(1729) * b(87) + b(70) = b(70) - lu(1728) * b(87) + b(69) = b(69) - lu(1727) * b(87) + b(68) = b(68) - lu(1726) * b(87) + b(67) = b(67) - lu(1725) * b(87) + b(66) = b(66) - lu(1724) * b(87) + b(65) = b(65) - lu(1723) * b(87) + b(64) = b(64) - lu(1722) * b(87) + b(63) = b(63) - lu(1721) * b(87) + b(62) = b(62) - lu(1720) * b(87) + b(61) = b(61) - lu(1719) * b(87) + b(60) = b(60) - lu(1718) * b(87) + b(59) = b(59) - lu(1717) * b(87) + b(57) = b(57) - lu(1716) * b(87) + b(56) = b(56) - lu(1715) * b(87) + b(55) = b(55) - lu(1714) * b(87) + b(54) = b(54) - lu(1713) * b(87) + b(53) = b(53) - lu(1712) * b(87) + b(51) = b(51) - lu(1711) * b(87) + b(47) = b(47) - lu(1710) * b(87) + b(46) = b(46) - lu(1709) * b(87) + b(43) = b(43) - lu(1708) * b(87) + b(42) = b(42) - lu(1707) * b(87) + b(40) = b(40) - lu(1706) * b(87) + b(29) = b(29) - lu(1705) * b(87) + b(27) = b(27) - lu(1704) * b(87) + b(26) = b(26) - lu(1703) * b(87) + b(25) = b(25) - lu(1702) * b(87) + b(24) = b(24) - lu(1701) * b(87) + b(17) = b(17) - lu(1700) * b(87) + b(16) = b(16) - lu(1699) * b(87) + b(13) = b(13) - lu(1698) * b(87) + b(12) = b(12) - lu(1697) * b(87) + b(10) = b(10) - lu(1696) * b(87) + b(9) = b(9) - lu(1695) * b(87) + b(7) = b(7) - lu(1694) * b(87) + b(86) = b(86) * lu(1692) + b(85) = b(85) - lu(1691) * b(86) + b(84) = b(84) - lu(1690) * b(86) + b(83) = b(83) - lu(1689) * b(86) + b(82) = b(82) - lu(1688) * b(86) + b(81) = b(81) - lu(1687) * b(86) + b(80) = b(80) - lu(1686) * b(86) + b(79) = b(79) - lu(1685) * b(86) + b(78) = b(78) - lu(1684) * b(86) + b(77) = b(77) - lu(1683) * b(86) + b(76) = b(76) - lu(1682) * b(86) + b(75) = b(75) - lu(1681) * b(86) + b(74) = b(74) - lu(1680) * b(86) + b(73) = b(73) - lu(1679) * b(86) + b(72) = b(72) - lu(1678) * b(86) + b(71) = b(71) - lu(1677) * b(86) + b(70) = b(70) - lu(1676) * b(86) + b(69) = b(69) - lu(1675) * b(86) + b(68) = b(68) - lu(1674) * b(86) + b(67) = b(67) - lu(1673) * b(86) + b(66) = b(66) - lu(1672) * b(86) + b(65) = b(65) - lu(1671) * b(86) + b(64) = b(64) - lu(1670) * b(86) + b(62) = b(62) - lu(1669) * b(86) + b(61) = b(61) - lu(1668) * b(86) + b(60) = b(60) - lu(1667) * b(86) + b(57) = b(57) - lu(1666) * b(86) + b(56) = b(56) - lu(1665) * b(86) + b(55) = b(55) - lu(1664) * b(86) + b(53) = b(53) - lu(1663) * b(86) + b(52) = b(52) - lu(1662) * b(86) + b(38) = b(38) - lu(1661) * b(86) + b(21) = b(21) - lu(1660) * b(86) + b(85) = b(85) * lu(1657) + b(84) = b(84) - lu(1656) * b(85) + b(83) = b(83) - lu(1655) * b(85) + b(82) = b(82) - lu(1654) * b(85) + b(81) = b(81) - lu(1653) * b(85) + b(80) = b(80) - lu(1652) * b(85) + b(79) = b(79) - lu(1651) * b(85) + b(78) = b(78) - lu(1650) * b(85) + b(77) = b(77) - lu(1649) * b(85) + b(76) = b(76) - lu(1648) * b(85) + b(75) = b(75) - lu(1647) * b(85) + b(74) = b(74) - lu(1646) * b(85) + b(73) = b(73) - lu(1645) * b(85) + b(72) = b(72) - lu(1644) * b(85) + b(71) = b(71) - lu(1643) * b(85) + b(70) = b(70) - lu(1642) * b(85) + b(69) = b(69) - lu(1641) * b(85) + b(68) = b(68) - lu(1640) * b(85) + b(67) = b(67) - lu(1639) * b(85) + b(66) = b(66) - lu(1638) * b(85) + b(65) = b(65) - lu(1637) * b(85) + b(64) = b(64) - lu(1636) * b(85) + b(63) = b(63) - lu(1635) * b(85) + b(62) = b(62) - lu(1634) * b(85) + b(61) = b(61) - lu(1633) * b(85) + b(60) = b(60) - lu(1632) * b(85) + b(59) = b(59) - lu(1631) * b(85) + b(57) = b(57) - lu(1630) * b(85) + b(56) = b(56) - lu(1629) * b(85) + b(55) = b(55) - lu(1628) * b(85) + b(52) = b(52) - lu(1627) * b(85) + b(51) = b(51) - lu(1626) * b(85) + b(49) = b(49) - lu(1625) * b(85) + b(40) = b(40) - lu(1624) * b(85) + b(29) = b(29) - lu(1623) * b(85) + b(25) = b(25) - lu(1622) * b(85) + b(7) = b(7) - lu(1621) * b(85) + b(84) = b(84) * lu(1617) + b(83) = b(83) - lu(1616) * b(84) + b(82) = b(82) - lu(1615) * b(84) + b(81) = b(81) - lu(1614) * b(84) + b(80) = b(80) - lu(1613) * b(84) + b(79) = b(79) - lu(1612) * b(84) + b(78) = b(78) - lu(1611) * b(84) + b(77) = b(77) - lu(1610) * b(84) + b(76) = b(76) - lu(1609) * b(84) + b(75) = b(75) - lu(1608) * b(84) + b(74) = b(74) - lu(1607) * b(84) + b(73) = b(73) - lu(1606) * b(84) + b(72) = b(72) - lu(1605) * b(84) + b(71) = b(71) - lu(1604) * b(84) + b(70) = b(70) - lu(1603) * b(84) + b(69) = b(69) - lu(1602) * b(84) + b(68) = b(68) - lu(1601) * b(84) + b(67) = b(67) - lu(1600) * b(84) + b(66) = b(66) - lu(1599) * b(84) + b(65) = b(65) - lu(1598) * b(84) + b(64) = b(64) - lu(1597) * b(84) + b(63) = b(63) - lu(1596) * b(84) + b(62) = b(62) - lu(1595) * b(84) + b(61) = b(61) - lu(1594) * b(84) + b(60) = b(60) - lu(1593) * b(84) + b(59) = b(59) - lu(1592) * b(84) + b(58) = b(58) - lu(1591) * b(84) + b(57) = b(57) - lu(1590) * b(84) + b(56) = b(56) - lu(1589) * b(84) + b(50) = b(50) - lu(1588) * b(84) + b(48) = b(48) - lu(1587) * b(84) + b(44) = b(44) - lu(1586) * b(84) + b(42) = b(42) - lu(1585) * b(84) + b(34) = b(34) - lu(1584) * b(84) + b(8) = b(8) - lu(1583) * b(84) + b(83) = b(83) * lu(1578) + b(82) = b(82) - lu(1577) * b(83) + b(81) = b(81) - lu(1576) * b(83) + b(80) = b(80) - lu(1575) * b(83) + b(79) = b(79) - lu(1574) * b(83) + b(78) = b(78) - lu(1573) * b(83) + b(77) = b(77) - lu(1572) * b(83) + b(76) = b(76) - lu(1571) * b(83) + b(75) = b(75) - lu(1570) * b(83) + b(74) = b(74) - lu(1569) * b(83) + b(73) = b(73) - lu(1568) * b(83) + b(72) = b(72) - lu(1567) * b(83) + b(71) = b(71) - lu(1566) * b(83) + b(70) = b(70) - lu(1565) * b(83) + b(69) = b(69) - lu(1564) * b(83) + b(68) = b(68) - lu(1563) * b(83) + b(67) = b(67) - lu(1562) * b(83) + b(66) = b(66) - lu(1561) * b(83) + b(65) = b(65) - lu(1560) * b(83) + b(64) = b(64) - lu(1559) * b(83) + b(63) = b(63) - lu(1558) * b(83) + b(62) = b(62) - lu(1557) * b(83) + b(61) = b(61) - lu(1556) * b(83) + b(60) = b(60) - lu(1555) * b(83) + b(59) = b(59) - lu(1554) * b(83) + b(57) = b(57) - lu(1553) * b(83) + b(56) = b(56) - lu(1552) * b(83) + b(51) = b(51) - lu(1551) * b(83) + b(48) = b(48) - lu(1550) * b(83) + b(42) = b(42) - lu(1549) * b(83) + b(34) = b(34) - lu(1548) * b(83) + b(82) = b(82) * lu(1542) + b(81) = b(81) - lu(1541) * b(82) + b(80) = b(80) - lu(1540) * b(82) + b(79) = b(79) - lu(1539) * b(82) + b(78) = b(78) - lu(1538) * b(82) + b(77) = b(77) - lu(1537) * b(82) + b(76) = b(76) - lu(1536) * b(82) + b(75) = b(75) - lu(1535) * b(82) + b(74) = b(74) - lu(1534) * b(82) + b(73) = b(73) - lu(1533) * b(82) + b(72) = b(72) - lu(1532) * b(82) + b(71) = b(71) - lu(1531) * b(82) + b(70) = b(70) - lu(1530) * b(82) + b(69) = b(69) - lu(1529) * b(82) + b(68) = b(68) - lu(1528) * b(82) + b(67) = b(67) - lu(1527) * b(82) + b(66) = b(66) - lu(1526) * b(82) + b(65) = b(65) - lu(1525) * b(82) + b(64) = b(64) - lu(1524) * b(82) + b(63) = b(63) - lu(1523) * b(82) + b(62) = b(62) - lu(1522) * b(82) + b(61) = b(61) - lu(1521) * b(82) + b(60) = b(60) - lu(1520) * b(82) + b(59) = b(59) - lu(1519) * b(82) + b(48) = b(48) - lu(1518) * b(82) + b(41) = b(41) - lu(1517) * b(82) + b(37) = b(37) - lu(1516) * b(82) end subroutine lu_slv06 - subroutine lu_slv07( avec_len, lu, b ) + subroutine lu_slv07( 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) + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) !----------------------------------------------------------------------- ! ... Local variables !----------------------------------------------------------------------- - integer :: k !----------------------------------------------------------------------- ! ... solve L * y = b !----------------------------------------------------------------------- - do k = 1,avec_len - b(k,82) = b(k,82) * lu(k,1576) - b(k,81) = b(k,81) - lu(k,1575) * b(k,82) - b(k,80) = b(k,80) - lu(k,1574) * b(k,82) - b(k,79) = b(k,79) - lu(k,1573) * b(k,82) - b(k,78) = b(k,78) - lu(k,1572) * b(k,82) - b(k,77) = b(k,77) - lu(k,1571) * b(k,82) - b(k,76) = b(k,76) - lu(k,1570) * b(k,82) - b(k,75) = b(k,75) - lu(k,1569) * b(k,82) - b(k,74) = b(k,74) - lu(k,1568) * b(k,82) - b(k,73) = b(k,73) - lu(k,1567) * b(k,82) - b(k,72) = b(k,72) - lu(k,1566) * b(k,82) - b(k,71) = b(k,71) - lu(k,1565) * b(k,82) - b(k,70) = b(k,70) - lu(k,1564) * b(k,82) - b(k,69) = b(k,69) - lu(k,1563) * b(k,82) - b(k,68) = b(k,68) - lu(k,1562) * b(k,82) - b(k,67) = b(k,67) - lu(k,1561) * b(k,82) - b(k,66) = b(k,66) - lu(k,1560) * b(k,82) - b(k,65) = b(k,65) - lu(k,1559) * b(k,82) - b(k,64) = b(k,64) - lu(k,1558) * b(k,82) - b(k,63) = b(k,63) - lu(k,1557) * b(k,82) - b(k,62) = b(k,62) - lu(k,1556) * b(k,82) - b(k,61) = b(k,61) - lu(k,1555) * b(k,82) - b(k,60) = b(k,60) - lu(k,1554) * b(k,82) - b(k,59) = b(k,59) - lu(k,1553) * b(k,82) - b(k,58) = b(k,58) - lu(k,1552) * b(k,82) - b(k,55) = b(k,55) - lu(k,1551) * b(k,82) - b(k,54) = b(k,54) - lu(k,1550) * b(k,82) - b(k,53) = b(k,53) - lu(k,1549) * b(k,82) - b(k,51) = b(k,51) - lu(k,1548) * b(k,82) - b(k,48) = b(k,48) - lu(k,1547) * b(k,82) - b(k,47) = b(k,47) - lu(k,1546) * b(k,82) - b(k,46) = b(k,46) - lu(k,1545) * b(k,82) - b(k,45) = b(k,45) - lu(k,1544) * b(k,82) - b(k,43) = b(k,43) - lu(k,1543) * b(k,82) - b(k,42) = b(k,42) - lu(k,1542) * b(k,82) - b(k,37) = b(k,37) - lu(k,1541) * b(k,82) - b(k,9) = b(k,9) - lu(k,1540) * b(k,82) - b(k,81) = b(k,81) * lu(k,1532) - b(k,80) = b(k,80) - lu(k,1531) * b(k,81) - b(k,79) = b(k,79) - lu(k,1530) * b(k,81) - b(k,78) = b(k,78) - lu(k,1529) * b(k,81) - b(k,77) = b(k,77) - lu(k,1528) * b(k,81) - b(k,76) = b(k,76) - lu(k,1527) * b(k,81) - b(k,75) = b(k,75) - lu(k,1526) * b(k,81) - b(k,74) = b(k,74) - lu(k,1525) * b(k,81) - b(k,73) = b(k,73) - lu(k,1524) * b(k,81) - b(k,72) = b(k,72) - lu(k,1523) * b(k,81) - b(k,71) = b(k,71) - lu(k,1522) * b(k,81) - b(k,70) = b(k,70) - lu(k,1521) * b(k,81) - b(k,69) = b(k,69) - lu(k,1520) * b(k,81) - b(k,68) = b(k,68) - lu(k,1519) * b(k,81) - b(k,67) = b(k,67) - lu(k,1518) * b(k,81) - b(k,66) = b(k,66) - lu(k,1517) * b(k,81) - b(k,65) = b(k,65) - lu(k,1516) * b(k,81) - b(k,64) = b(k,64) - lu(k,1515) * b(k,81) - b(k,63) = b(k,63) - lu(k,1514) * b(k,81) - b(k,62) = b(k,62) - lu(k,1513) * b(k,81) - b(k,61) = b(k,61) - lu(k,1512) * b(k,81) - b(k,60) = b(k,60) - lu(k,1511) * b(k,81) - b(k,59) = b(k,59) - lu(k,1510) * b(k,81) - b(k,58) = b(k,58) - lu(k,1509) * b(k,81) - b(k,57) = b(k,57) - lu(k,1508) * b(k,81) - b(k,56) = b(k,56) - lu(k,1507) * b(k,81) - b(k,52) = b(k,52) - lu(k,1506) * b(k,81) - b(k,44) = b(k,44) - lu(k,1505) * b(k,81) - b(k,39) = b(k,39) - lu(k,1504) * b(k,81) - b(k,35) = b(k,35) - lu(k,1503) * b(k,81) - b(k,34) = b(k,34) - lu(k,1502) * b(k,81) - b(k,32) = b(k,32) - lu(k,1501) * b(k,81) - b(k,6) = b(k,6) - lu(k,1500) * b(k,81) - b(k,4) = b(k,4) - lu(k,1499) * b(k,81) - b(k,3) = b(k,3) - lu(k,1498) * b(k,81) - b(k,1) = b(k,1) - lu(k,1497) * b(k,81) - b(k,80) = b(k,80) * lu(k,1488) - b(k,79) = b(k,79) - lu(k,1487) * b(k,80) - b(k,78) = b(k,78) - lu(k,1486) * b(k,80) - b(k,77) = b(k,77) - lu(k,1485) * b(k,80) - b(k,76) = b(k,76) - lu(k,1484) * b(k,80) - b(k,75) = b(k,75) - lu(k,1483) * b(k,80) - b(k,74) = b(k,74) - lu(k,1482) * b(k,80) - b(k,73) = b(k,73) - lu(k,1481) * b(k,80) - b(k,72) = b(k,72) - lu(k,1480) * b(k,80) - b(k,71) = b(k,71) - lu(k,1479) * b(k,80) - b(k,70) = b(k,70) - lu(k,1478) * b(k,80) - b(k,69) = b(k,69) - lu(k,1477) * b(k,80) - b(k,68) = b(k,68) - lu(k,1476) * b(k,80) - b(k,67) = b(k,67) - lu(k,1475) * b(k,80) - b(k,66) = b(k,66) - lu(k,1474) * b(k,80) - b(k,65) = b(k,65) - lu(k,1473) * b(k,80) - b(k,64) = b(k,64) - lu(k,1472) * b(k,80) - b(k,63) = b(k,63) - lu(k,1471) * b(k,80) - b(k,62) = b(k,62) - lu(k,1470) * b(k,80) - b(k,61) = b(k,61) - lu(k,1469) * b(k,80) - b(k,60) = b(k,60) - lu(k,1468) * b(k,80) - b(k,59) = b(k,59) - lu(k,1467) * b(k,80) - b(k,58) = b(k,58) - lu(k,1466) * b(k,80) - b(k,57) = b(k,57) - lu(k,1465) * b(k,80) - b(k,56) = b(k,56) - lu(k,1464) * b(k,80) - b(k,52) = b(k,52) - lu(k,1463) * b(k,80) - b(k,51) = b(k,51) - lu(k,1462) * b(k,80) - b(k,48) = b(k,48) - lu(k,1461) * b(k,80) - b(k,46) = b(k,46) - lu(k,1460) * b(k,80) - b(k,45) = b(k,45) - lu(k,1459) * b(k,80) - b(k,44) = b(k,44) - lu(k,1458) * b(k,80) - b(k,34) = b(k,34) - lu(k,1457) * b(k,80) - b(k,32) = b(k,32) - lu(k,1456) * b(k,80) - b(k,28) = b(k,28) - lu(k,1455) * b(k,80) - b(k,24) = b(k,24) - lu(k,1454) * b(k,80) - b(k,6) = b(k,6) - lu(k,1453) * b(k,80) - b(k,4) = b(k,4) - lu(k,1452) * b(k,80) - b(k,79) = b(k,79) * lu(k,1442) - b(k,78) = b(k,78) - lu(k,1441) * b(k,79) - b(k,77) = b(k,77) - lu(k,1440) * b(k,79) - b(k,76) = b(k,76) - lu(k,1439) * b(k,79) - b(k,75) = b(k,75) - lu(k,1438) * b(k,79) - b(k,74) = b(k,74) - lu(k,1437) * b(k,79) - b(k,73) = b(k,73) - lu(k,1436) * b(k,79) - b(k,72) = b(k,72) - lu(k,1435) * b(k,79) - b(k,71) = b(k,71) - lu(k,1434) * b(k,79) - b(k,70) = b(k,70) - lu(k,1433) * b(k,79) - b(k,69) = b(k,69) - lu(k,1432) * b(k,79) - b(k,68) = b(k,68) - lu(k,1431) * b(k,79) - b(k,67) = b(k,67) - lu(k,1430) * b(k,79) - b(k,66) = b(k,66) - lu(k,1429) * b(k,79) - b(k,65) = b(k,65) - lu(k,1428) * b(k,79) - b(k,64) = b(k,64) - lu(k,1427) * b(k,79) - b(k,63) = b(k,63) - lu(k,1426) * b(k,79) - b(k,62) = b(k,62) - lu(k,1425) * b(k,79) - b(k,61) = b(k,61) - lu(k,1424) * b(k,79) - b(k,60) = b(k,60) - lu(k,1423) * b(k,79) - b(k,59) = b(k,59) - lu(k,1422) * b(k,79) - b(k,57) = b(k,57) - lu(k,1421) * b(k,79) - b(k,56) = b(k,56) - lu(k,1420) * b(k,79) - b(k,52) = b(k,52) - lu(k,1419) * b(k,79) - b(k,49) = b(k,49) - lu(k,1418) * b(k,79) - b(k,44) = b(k,44) - lu(k,1417) * b(k,79) - b(k,41) = b(k,41) - lu(k,1416) * b(k,79) - b(k,36) = b(k,36) - lu(k,1415) * b(k,79) - b(k,10) = b(k,10) - lu(k,1414) * b(k,79) - b(k,78) = b(k,78) * lu(k,1403) - b(k,77) = b(k,77) - lu(k,1402) * b(k,78) - b(k,76) = b(k,76) - lu(k,1401) * b(k,78) - b(k,75) = b(k,75) - lu(k,1400) * b(k,78) - b(k,74) = b(k,74) - lu(k,1399) * b(k,78) - b(k,73) = b(k,73) - lu(k,1398) * b(k,78) - b(k,72) = b(k,72) - lu(k,1397) * b(k,78) - b(k,71) = b(k,71) - lu(k,1396) * b(k,78) - b(k,70) = b(k,70) - lu(k,1395) * b(k,78) - b(k,69) = b(k,69) - lu(k,1394) * b(k,78) - b(k,68) = b(k,68) - lu(k,1393) * b(k,78) - b(k,67) = b(k,67) - lu(k,1392) * b(k,78) - b(k,66) = b(k,66) - lu(k,1391) * b(k,78) - b(k,65) = b(k,65) - lu(k,1390) * b(k,78) - b(k,64) = b(k,64) - lu(k,1389) * b(k,78) - b(k,63) = b(k,63) - lu(k,1388) * b(k,78) - b(k,62) = b(k,62) - lu(k,1387) * b(k,78) - b(k,61) = b(k,61) - lu(k,1386) * b(k,78) - b(k,60) = b(k,60) - lu(k,1385) * b(k,78) - b(k,59) = b(k,59) - lu(k,1384) * b(k,78) - b(k,57) = b(k,57) - lu(k,1383) * b(k,78) - b(k,49) = b(k,49) - lu(k,1382) * b(k,78) - b(k,42) = b(k,42) - lu(k,1381) * b(k,78) - b(k,41) = b(k,41) - lu(k,1380) * b(k,78) - b(k,40) = b(k,40) - lu(k,1379) * b(k,78) - b(k,38) = b(k,38) - lu(k,1378) * b(k,78) - b(k,36) = b(k,36) - lu(k,1377) * b(k,78) - b(k,25) = b(k,25) - lu(k,1376) * b(k,78) - b(k,23) = b(k,23) - lu(k,1375) * b(k,78) - b(k,22) = b(k,22) - lu(k,1374) * b(k,78) - b(k,20) = b(k,20) - lu(k,1373) * b(k,78) - b(k,10) = b(k,10) - lu(k,1372) * b(k,78) - b(k,77) = b(k,77) * lu(k,1360) - b(k,76) = b(k,76) - lu(k,1359) * b(k,77) - b(k,75) = b(k,75) - lu(k,1358) * b(k,77) - b(k,74) = b(k,74) - lu(k,1357) * b(k,77) - b(k,73) = b(k,73) - lu(k,1356) * b(k,77) - b(k,72) = b(k,72) - lu(k,1355) * b(k,77) - b(k,71) = b(k,71) - lu(k,1354) * b(k,77) - b(k,70) = b(k,70) - lu(k,1353) * b(k,77) - b(k,69) = b(k,69) - lu(k,1352) * b(k,77) - b(k,68) = b(k,68) - lu(k,1351) * b(k,77) - b(k,67) = b(k,67) - lu(k,1350) * b(k,77) - b(k,66) = b(k,66) - lu(k,1349) * b(k,77) - b(k,65) = b(k,65) - lu(k,1348) * b(k,77) - b(k,64) = b(k,64) - lu(k,1347) * b(k,77) - b(k,63) = b(k,63) - lu(k,1346) * b(k,77) - b(k,62) = b(k,62) - lu(k,1345) * b(k,77) - b(k,61) = b(k,61) - lu(k,1344) * b(k,77) - b(k,60) = b(k,60) - lu(k,1343) * b(k,77) - b(k,59) = b(k,59) - lu(k,1342) * b(k,77) - b(k,58) = b(k,58) - lu(k,1341) * b(k,77) - b(k,57) = b(k,57) - lu(k,1340) * b(k,77) - b(k,55) = b(k,55) - lu(k,1339) * b(k,77) - b(k,54) = b(k,54) - lu(k,1338) * b(k,77) - b(k,53) = b(k,53) - lu(k,1337) * b(k,77) - b(k,51) = b(k,51) - lu(k,1336) * b(k,77) - b(k,48) = b(k,48) - lu(k,1335) * b(k,77) - b(k,47) = b(k,47) - lu(k,1334) * b(k,77) - b(k,46) = b(k,46) - lu(k,1333) * b(k,77) - b(k,45) = b(k,45) - lu(k,1332) * b(k,77) - b(k,43) = b(k,43) - lu(k,1331) * b(k,77) - b(k,42) = b(k,42) - lu(k,1330) * b(k,77) - b(k,41) = b(k,41) - lu(k,1329) * b(k,77) - b(k,40) = b(k,40) - lu(k,1328) * b(k,77) - b(k,27) = b(k,27) - lu(k,1327) * b(k,77) - end do + b(81) = b(81) * lu(1509) + b(80) = b(80) - lu(1508) * b(81) + b(79) = b(79) - lu(1507) * b(81) + b(78) = b(78) - lu(1506) * b(81) + b(77) = b(77) - lu(1505) * b(81) + b(76) = b(76) - lu(1504) * b(81) + b(75) = b(75) - lu(1503) * b(81) + b(74) = b(74) - lu(1502) * b(81) + b(73) = b(73) - lu(1501) * b(81) + b(72) = b(72) - lu(1500) * b(81) + b(71) = b(71) - lu(1499) * b(81) + b(70) = b(70) - lu(1498) * b(81) + b(69) = b(69) - lu(1497) * b(81) + b(68) = b(68) - lu(1496) * b(81) + b(67) = b(67) - lu(1495) * b(81) + b(66) = b(66) - lu(1494) * b(81) + b(65) = b(65) - lu(1493) * b(81) + b(64) = b(64) - lu(1492) * b(81) + b(63) = b(63) - lu(1491) * b(81) + b(62) = b(62) - lu(1490) * b(81) + b(61) = b(61) - lu(1489) * b(81) + b(60) = b(60) - lu(1488) * b(81) + b(59) = b(59) - lu(1487) * b(81) + b(58) = b(58) - lu(1486) * b(81) + b(57) = b(57) - lu(1485) * b(81) + b(56) = b(56) - lu(1484) * b(81) + b(51) = b(51) - lu(1483) * b(81) + b(50) = b(50) - lu(1482) * b(81) + b(48) = b(48) - lu(1481) * b(81) + b(44) = b(44) - lu(1480) * b(81) + b(42) = b(42) - lu(1479) * b(81) + b(39) = b(39) - lu(1478) * b(81) + b(37) = b(37) - lu(1477) * b(81) + b(36) = b(36) - lu(1476) * b(81) + b(35) = b(35) - lu(1475) * b(81) + b(34) = b(34) - lu(1474) * b(81) + b(33) = b(33) - lu(1473) * b(81) + b(32) = b(32) - lu(1472) * b(81) + b(31) = b(31) - lu(1471) * b(81) + b(30) = b(30) - lu(1470) * b(81) + b(28) = b(28) - lu(1469) * b(81) + b(23) = b(23) - lu(1468) * b(81) + b(22) = b(22) - lu(1467) * b(81) + b(21) = b(21) - lu(1466) * b(81) + b(20) = b(20) - lu(1465) * b(81) + b(19) = b(19) - lu(1464) * b(81) + b(18) = b(18) - lu(1463) * b(81) + b(14) = b(14) - lu(1462) * b(81) + b(8) = b(8) - lu(1461) * b(81) + b(80) = b(80) * lu(1453) + b(79) = b(79) - lu(1452) * b(80) + b(78) = b(78) - lu(1451) * b(80) + b(77) = b(77) - lu(1450) * b(80) + b(76) = b(76) - lu(1449) * b(80) + b(75) = b(75) - lu(1448) * b(80) + b(74) = b(74) - lu(1447) * b(80) + b(73) = b(73) - lu(1446) * b(80) + b(72) = b(72) - lu(1445) * b(80) + b(71) = b(71) - lu(1444) * b(80) + b(70) = b(70) - lu(1443) * b(80) + b(69) = b(69) - lu(1442) * b(80) + b(68) = b(68) - lu(1441) * b(80) + b(67) = b(67) - lu(1440) * b(80) + b(66) = b(66) - lu(1439) * b(80) + b(65) = b(65) - lu(1438) * b(80) + b(64) = b(64) - lu(1437) * b(80) + b(63) = b(63) - lu(1436) * b(80) + b(62) = b(62) - lu(1435) * b(80) + b(61) = b(61) - lu(1434) * b(80) + b(60) = b(60) - lu(1433) * b(80) + b(59) = b(59) - lu(1432) * b(80) + b(58) = b(58) - lu(1431) * b(80) + b(55) = b(55) - lu(1430) * b(80) + b(54) = b(54) - lu(1429) * b(80) + b(53) = b(53) - lu(1428) * b(80) + b(52) = b(52) - lu(1427) * b(80) + b(49) = b(49) - lu(1426) * b(80) + b(47) = b(47) - lu(1425) * b(80) + b(46) = b(46) - lu(1424) * b(80) + b(45) = b(45) - lu(1423) * b(80) + b(43) = b(43) - lu(1422) * b(80) + b(41) = b(41) - lu(1421) * b(80) + b(38) = b(38) - lu(1420) * b(80) + b(10) = b(10) - lu(1419) * b(80) + b(79) = b(79) * lu(1410) + b(78) = b(78) - lu(1409) * b(79) + b(77) = b(77) - lu(1408) * b(79) + b(76) = b(76) - lu(1407) * b(79) + b(75) = b(75) - lu(1406) * b(79) + b(74) = b(74) - lu(1405) * b(79) + b(73) = b(73) - lu(1404) * b(79) + b(72) = b(72) - lu(1403) * b(79) + b(71) = b(71) - lu(1402) * b(79) + b(70) = b(70) - lu(1401) * b(79) + b(69) = b(69) - lu(1400) * b(79) + b(68) = b(68) - lu(1399) * b(79) + b(67) = b(67) - lu(1398) * b(79) + b(66) = b(66) - lu(1397) * b(79) + b(65) = b(65) - lu(1396) * b(79) + b(62) = b(62) - lu(1395) * b(79) + b(61) = b(61) - lu(1394) * b(79) + b(57) = b(57) - lu(1393) * b(79) + b(42) = b(42) - lu(1392) * b(79) + b(39) = b(39) - lu(1391) * b(79) + b(35) = b(35) - lu(1390) * b(79) + b(31) = b(31) - lu(1389) * b(79) + b(28) = b(28) - lu(1388) * b(79) + b(27) = b(27) - lu(1387) * b(79) + b(26) = b(26) - lu(1386) * b(79) + b(25) = b(25) - lu(1385) * b(79) + b(24) = b(24) - lu(1384) * b(79) + b(22) = b(22) - lu(1383) * b(79) + b(19) = b(19) - lu(1382) * b(79) + b(18) = b(18) - lu(1381) * b(79) + b(17) = b(17) - lu(1380) * b(79) + b(16) = b(16) - lu(1379) * b(79) + b(13) = b(13) - lu(1378) * b(79) + b(12) = b(12) - lu(1377) * b(79) + b(78) = b(78) * lu(1367) + b(77) = b(77) - lu(1366) * b(78) + b(76) = b(76) - lu(1365) * b(78) + b(75) = b(75) - lu(1364) * b(78) + b(74) = b(74) - lu(1363) * b(78) + b(73) = b(73) - lu(1362) * b(78) + b(72) = b(72) - lu(1361) * b(78) + b(71) = b(71) - lu(1360) * b(78) + b(70) = b(70) - lu(1359) * b(78) + b(69) = b(69) - lu(1358) * b(78) + b(68) = b(68) - lu(1357) * b(78) + b(67) = b(67) - lu(1356) * b(78) + b(66) = b(66) - lu(1355) * b(78) + b(65) = b(65) - lu(1354) * b(78) + b(64) = b(64) - lu(1353) * b(78) + b(63) = b(63) - lu(1352) * b(78) + b(62) = b(62) - lu(1351) * b(78) + b(61) = b(61) - lu(1350) * b(78) + b(60) = b(60) - lu(1349) * b(78) + b(59) = b(59) - lu(1348) * b(78) + b(58) = b(58) - lu(1347) * b(78) + b(55) = b(55) - lu(1346) * b(78) + b(54) = b(54) - lu(1345) * b(78) + b(53) = b(53) - lu(1344) * b(78) + b(52) = b(52) - lu(1343) * b(78) + b(49) = b(49) - lu(1342) * b(78) + b(47) = b(47) - lu(1341) * b(78) + b(46) = b(46) - lu(1340) * b(78) + b(45) = b(45) - lu(1339) * b(78) + b(43) = b(43) - lu(1338) * b(78) + b(41) = b(41) - lu(1337) * b(78) + b(38) = b(38) - lu(1336) * b(78) + b(9) = b(9) - lu(1335) * b(78) + b(77) = b(77) * lu(1324) + b(76) = b(76) - lu(1323) * b(77) + b(75) = b(75) - lu(1322) * b(77) + b(74) = b(74) - lu(1321) * b(77) + b(73) = b(73) - lu(1320) * b(77) + b(72) = b(72) - lu(1319) * b(77) + b(71) = b(71) - lu(1318) * b(77) + b(70) = b(70) - lu(1317) * b(77) + b(69) = b(69) - lu(1316) * b(77) + b(68) = b(68) - lu(1315) * b(77) + b(67) = b(67) - lu(1314) * b(77) + b(66) = b(66) - lu(1313) * b(77) + b(65) = b(65) - lu(1312) * b(77) + b(64) = b(64) - lu(1311) * b(77) + b(63) = b(63) - lu(1310) * b(77) + b(62) = b(62) - lu(1309) * b(77) + b(61) = b(61) - lu(1308) * b(77) + b(60) = b(60) - lu(1307) * b(77) + b(59) = b(59) - lu(1306) * b(77) + b(57) = b(57) - lu(1305) * b(77) + b(56) = b(56) - lu(1304) * b(77) + b(55) = b(55) - lu(1303) * b(77) + b(54) = b(54) - lu(1302) * b(77) + b(50) = b(50) - lu(1301) * b(77) + b(48) = b(48) - lu(1300) * b(77) + b(47) = b(47) - lu(1299) * b(77) + b(44) = b(44) - lu(1298) * b(77) + b(40) = b(40) - lu(1297) * b(77) + b(39) = b(39) - lu(1296) * b(77) + b(37) = b(37) - lu(1295) * b(77) + b(25) = b(25) - lu(1294) * b(77) + b(76) = b(76) * lu(1282) + b(75) = b(75) - lu(1281) * b(76) + b(74) = b(74) - lu(1280) * b(76) + b(73) = b(73) - lu(1279) * b(76) + b(72) = b(72) - lu(1278) * b(76) + b(71) = b(71) - lu(1277) * b(76) + b(70) = b(70) - lu(1276) * b(76) + b(69) = b(69) - lu(1275) * b(76) + b(68) = b(68) - lu(1274) * b(76) + b(67) = b(67) - lu(1273) * b(76) + b(66) = b(66) - lu(1272) * b(76) + b(65) = b(65) - lu(1271) * b(76) + b(64) = b(64) - lu(1270) * b(76) + b(63) = b(63) - lu(1269) * b(76) + b(62) = b(62) - lu(1268) * b(76) + b(61) = b(61) - lu(1267) * b(76) + b(60) = b(60) - lu(1266) * b(76) + b(59) = b(59) - lu(1265) * b(76) + b(58) = b(58) - lu(1264) * b(76) + b(57) = b(57) - lu(1263) * b(76) + b(55) = b(55) - lu(1262) * b(76) + b(54) = b(54) - lu(1261) * b(76) + b(53) = b(53) - lu(1260) * b(76) + b(52) = b(52) - lu(1259) * b(76) + b(49) = b(49) - lu(1258) * b(76) + b(47) = b(47) - lu(1257) * b(76) + b(46) = b(46) - lu(1256) * b(76) + b(45) = b(45) - lu(1255) * b(76) + b(43) = b(43) - lu(1254) * b(76) + b(42) = b(42) - lu(1253) * b(76) + b(41) = b(41) - lu(1252) * b(76) + b(39) = b(39) - lu(1251) * b(76) + b(27) = b(27) - lu(1250) * b(76) end subroutine lu_slv07 - subroutine lu_slv08( avec_len, lu, b ) + subroutine lu_slv08( 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) + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) !----------------------------------------------------------------------- ! ... Local variables !----------------------------------------------------------------------- - integer :: k !----------------------------------------------------------------------- ! ... solve L * y = b !----------------------------------------------------------------------- - do k = 1,avec_len - b(k,76) = b(k,76) * lu(k,1314) - b(k,75) = b(k,75) - lu(k,1313) * b(k,76) - b(k,74) = b(k,74) - lu(k,1312) * b(k,76) - b(k,73) = b(k,73) - lu(k,1311) * b(k,76) - b(k,72) = b(k,72) - lu(k,1310) * b(k,76) - b(k,71) = b(k,71) - lu(k,1309) * b(k,76) - b(k,70) = b(k,70) - lu(k,1308) * b(k,76) - b(k,69) = b(k,69) - lu(k,1307) * b(k,76) - b(k,68) = b(k,68) - lu(k,1306) * b(k,76) - b(k,67) = b(k,67) - lu(k,1305) * b(k,76) - b(k,66) = b(k,66) - lu(k,1304) * b(k,76) - b(k,65) = b(k,65) - lu(k,1303) * b(k,76) - b(k,64) = b(k,64) - lu(k,1302) * b(k,76) - b(k,63) = b(k,63) - lu(k,1301) * b(k,76) - b(k,62) = b(k,62) - lu(k,1300) * b(k,76) - b(k,61) = b(k,61) - lu(k,1299) * b(k,76) - b(k,60) = b(k,60) - lu(k,1298) * b(k,76) - b(k,59) = b(k,59) - lu(k,1297) * b(k,76) - b(k,58) = b(k,58) - lu(k,1296) * b(k,76) - b(k,49) = b(k,49) - lu(k,1295) * b(k,76) - b(k,41) = b(k,41) - lu(k,1294) * b(k,76) - b(k,36) = b(k,36) - lu(k,1293) * b(k,76) - b(k,35) = b(k,35) - lu(k,1292) * b(k,76) - b(k,20) = b(k,20) - lu(k,1291) * b(k,76) - b(k,75) = b(k,75) * lu(k,1277) - b(k,74) = b(k,74) - lu(k,1276) * b(k,75) - b(k,73) = b(k,73) - lu(k,1275) * b(k,75) - b(k,72) = b(k,72) - lu(k,1274) * b(k,75) - b(k,71) = b(k,71) - lu(k,1273) * b(k,75) - b(k,70) = b(k,70) - lu(k,1272) * b(k,75) - b(k,69) = b(k,69) - lu(k,1271) * b(k,75) - b(k,68) = b(k,68) - lu(k,1270) * b(k,75) - b(k,67) = b(k,67) - lu(k,1269) * b(k,75) - b(k,66) = b(k,66) - lu(k,1268) * b(k,75) - b(k,65) = b(k,65) - lu(k,1267) * b(k,75) - b(k,64) = b(k,64) - lu(k,1266) * b(k,75) - b(k,63) = b(k,63) - lu(k,1265) * b(k,75) - b(k,62) = b(k,62) - lu(k,1264) * b(k,75) - b(k,61) = b(k,61) - lu(k,1263) * b(k,75) - b(k,60) = b(k,60) - lu(k,1262) * b(k,75) - b(k,59) = b(k,59) - lu(k,1261) * b(k,75) - b(k,57) = b(k,57) - lu(k,1260) * b(k,75) - b(k,49) = b(k,49) - lu(k,1259) * b(k,75) - b(k,41) = b(k,41) - lu(k,1258) * b(k,75) - b(k,40) = b(k,40) - lu(k,1257) * b(k,75) - b(k,38) = b(k,38) - lu(k,1256) * b(k,75) - b(k,36) = b(k,36) - lu(k,1255) * b(k,75) - b(k,31) = b(k,31) - lu(k,1254) * b(k,75) - b(k,29) = b(k,29) - lu(k,1253) * b(k,75) - b(k,20) = b(k,20) - lu(k,1252) * b(k,75) - b(k,19) = b(k,19) - lu(k,1251) * b(k,75) - b(k,16) = b(k,16) - lu(k,1250) * b(k,75) - b(k,15) = b(k,15) - lu(k,1249) * b(k,75) - b(k,10) = b(k,10) - lu(k,1248) * b(k,75) - b(k,74) = b(k,74) * lu(k,1233) - b(k,73) = b(k,73) - lu(k,1232) * b(k,74) - b(k,72) = b(k,72) - lu(k,1231) * b(k,74) - b(k,71) = b(k,71) - lu(k,1230) * b(k,74) - b(k,70) = b(k,70) - lu(k,1229) * b(k,74) - b(k,69) = b(k,69) - lu(k,1228) * b(k,74) - b(k,68) = b(k,68) - lu(k,1227) * b(k,74) - b(k,67) = b(k,67) - lu(k,1226) * b(k,74) - b(k,66) = b(k,66) - lu(k,1225) * b(k,74) - b(k,65) = b(k,65) - lu(k,1224) * b(k,74) - b(k,63) = b(k,63) - lu(k,1223) * b(k,74) - b(k,62) = b(k,62) - lu(k,1222) * b(k,74) - b(k,61) = b(k,61) - lu(k,1221) * b(k,74) - b(k,60) = b(k,60) - lu(k,1220) * b(k,74) - b(k,57) = b(k,57) - lu(k,1219) * b(k,74) - b(k,56) = b(k,56) - lu(k,1218) * b(k,74) - b(k,55) = b(k,55) - lu(k,1217) * b(k,74) - b(k,53) = b(k,53) - lu(k,1216) * b(k,74) - b(k,51) = b(k,51) - lu(k,1215) * b(k,74) - b(k,37) = b(k,37) - lu(k,1214) * b(k,74) - b(k,25) = b(k,25) - lu(k,1213) * b(k,74) - b(k,73) = b(k,73) * lu(k,1197) - b(k,72) = b(k,72) - lu(k,1196) * b(k,73) - b(k,71) = b(k,71) - lu(k,1195) * b(k,73) - b(k,70) = b(k,70) - lu(k,1194) * b(k,73) - b(k,69) = b(k,69) - lu(k,1193) * b(k,73) - b(k,68) = b(k,68) - lu(k,1192) * b(k,73) - b(k,67) = b(k,67) - lu(k,1191) * b(k,73) - b(k,66) = b(k,66) - lu(k,1190) * b(k,73) - b(k,65) = b(k,65) - lu(k,1189) * b(k,73) - b(k,64) = b(k,64) - lu(k,1188) * b(k,73) - b(k,63) = b(k,63) - lu(k,1187) * b(k,73) - b(k,62) = b(k,62) - lu(k,1186) * b(k,73) - b(k,61) = b(k,61) - lu(k,1185) * b(k,73) - b(k,60) = b(k,60) - lu(k,1184) * b(k,73) - b(k,59) = b(k,59) - lu(k,1183) * b(k,73) - b(k,58) = b(k,58) - lu(k,1182) * b(k,73) - b(k,55) = b(k,55) - lu(k,1181) * b(k,73) - b(k,54) = b(k,54) - lu(k,1180) * b(k,73) - b(k,53) = b(k,53) - lu(k,1179) * b(k,73) - b(k,51) = b(k,51) - lu(k,1178) * b(k,73) - b(k,48) = b(k,48) - lu(k,1177) * b(k,73) - b(k,47) = b(k,47) - lu(k,1176) * b(k,73) - b(k,46) = b(k,46) - lu(k,1175) * b(k,73) - b(k,45) = b(k,45) - lu(k,1174) * b(k,73) - b(k,43) = b(k,43) - lu(k,1173) * b(k,73) - b(k,42) = b(k,42) - lu(k,1172) * b(k,73) - b(k,37) = b(k,37) - lu(k,1171) * b(k,73) - b(k,8) = b(k,8) - lu(k,1170) * b(k,73) - b(k,72) = b(k,72) * lu(k,1153) - b(k,71) = b(k,71) - lu(k,1152) * b(k,72) - b(k,70) = b(k,70) - lu(k,1151) * b(k,72) - b(k,69) = b(k,69) - lu(k,1150) * b(k,72) - b(k,68) = b(k,68) - lu(k,1149) * b(k,72) - b(k,67) = b(k,67) - lu(k,1148) * b(k,72) - b(k,66) = b(k,66) - lu(k,1147) * b(k,72) - b(k,65) = b(k,65) - lu(k,1146) * b(k,72) - b(k,64) = b(k,64) - lu(k,1145) * b(k,72) - b(k,63) = b(k,63) - lu(k,1144) * b(k,72) - b(k,62) = b(k,62) - lu(k,1143) * b(k,72) - b(k,61) = b(k,61) - lu(k,1142) * b(k,72) - b(k,60) = b(k,60) - lu(k,1141) * b(k,72) - b(k,58) = b(k,58) - lu(k,1140) * b(k,72) - b(k,57) = b(k,57) - lu(k,1139) * b(k,72) - b(k,56) = b(k,56) - lu(k,1138) * b(k,72) - b(k,55) = b(k,55) - lu(k,1137) * b(k,72) - b(k,54) = b(k,54) - lu(k,1136) * b(k,72) - b(k,53) = b(k,53) - lu(k,1135) * b(k,72) - b(k,52) = b(k,52) - lu(k,1134) * b(k,72) - b(k,51) = b(k,51) - lu(k,1133) * b(k,72) - b(k,49) = b(k,49) - lu(k,1132) * b(k,72) - b(k,44) = b(k,44) - lu(k,1131) * b(k,72) - b(k,40) = b(k,40) - lu(k,1130) * b(k,72) - b(k,37) = b(k,37) - lu(k,1129) * b(k,72) - b(k,34) = b(k,34) - lu(k,1128) * b(k,72) - b(k,28) = b(k,28) - lu(k,1127) * b(k,72) - b(k,17) = b(k,17) - lu(k,1126) * b(k,72) - b(k,14) = b(k,14) - lu(k,1125) * b(k,72) - b(k,71) = b(k,71) * lu(k,1107) - b(k,70) = b(k,70) - lu(k,1106) * b(k,71) - b(k,69) = b(k,69) - lu(k,1105) * b(k,71) - b(k,68) = b(k,68) - lu(k,1104) * b(k,71) - b(k,67) = b(k,67) - lu(k,1103) * b(k,71) - b(k,66) = b(k,66) - lu(k,1102) * b(k,71) - b(k,65) = b(k,65) - lu(k,1101) * b(k,71) - b(k,64) = b(k,64) - lu(k,1100) * b(k,71) - b(k,63) = b(k,63) - lu(k,1099) * b(k,71) - b(k,62) = b(k,62) - lu(k,1098) * b(k,71) - b(k,61) = b(k,61) - lu(k,1097) * b(k,71) - b(k,60) = b(k,60) - lu(k,1096) * b(k,71) - b(k,58) = b(k,58) - lu(k,1095) * b(k,71) - b(k,57) = b(k,57) - lu(k,1094) * b(k,71) - b(k,56) = b(k,56) - lu(k,1093) * b(k,71) - b(k,55) = b(k,55) - lu(k,1092) * b(k,71) - b(k,51) = b(k,51) - lu(k,1091) * b(k,71) - b(k,50) = b(k,50) - lu(k,1090) * b(k,71) - b(k,48) = b(k,48) - lu(k,1089) * b(k,71) - b(k,39) = b(k,39) - lu(k,1088) * b(k,71) - b(k,30) = b(k,30) - lu(k,1087) * b(k,71) - b(k,24) = b(k,24) - lu(k,1086) * b(k,71) - b(k,7) = b(k,7) - lu(k,1085) * b(k,71) - b(k,70) = b(k,70) * lu(k,1066) - b(k,69) = b(k,69) - lu(k,1065) * b(k,70) - b(k,68) = b(k,68) - lu(k,1064) * b(k,70) - b(k,67) = b(k,67) - lu(k,1063) * b(k,70) - b(k,66) = b(k,66) - lu(k,1062) * b(k,70) - b(k,65) = b(k,65) - lu(k,1061) * b(k,70) - b(k,64) = b(k,64) - lu(k,1060) * b(k,70) - b(k,63) = b(k,63) - lu(k,1059) * b(k,70) - b(k,62) = b(k,62) - lu(k,1058) * b(k,70) - b(k,61) = b(k,61) - lu(k,1057) * b(k,70) - b(k,60) = b(k,60) - lu(k,1056) * b(k,70) - b(k,59) = b(k,59) - lu(k,1055) * b(k,70) - b(k,58) = b(k,58) - lu(k,1054) * b(k,70) - b(k,55) = b(k,55) - lu(k,1053) * b(k,70) - b(k,54) = b(k,54) - lu(k,1052) * b(k,70) - b(k,53) = b(k,53) - lu(k,1051) * b(k,70) - b(k,51) = b(k,51) - lu(k,1050) * b(k,70) - b(k,48) = b(k,48) - lu(k,1049) * b(k,70) - b(k,47) = b(k,47) - lu(k,1048) * b(k,70) - b(k,46) = b(k,46) - lu(k,1047) * b(k,70) - b(k,45) = b(k,45) - lu(k,1046) * b(k,70) - b(k,43) = b(k,43) - lu(k,1045) * b(k,70) - b(k,42) = b(k,42) - lu(k,1044) * b(k,70) - b(k,26) = b(k,26) - lu(k,1043) * b(k,70) - b(k,69) = b(k,69) * lu(k,1023) - b(k,68) = b(k,68) - lu(k,1022) * b(k,69) - b(k,67) = b(k,67) - lu(k,1021) * b(k,69) - b(k,66) = b(k,66) - lu(k,1020) * b(k,69) - b(k,65) = b(k,65) - lu(k,1019) * b(k,69) - b(k,63) = b(k,63) - lu(k,1018) * b(k,69) - b(k,61) = b(k,61) - lu(k,1017) * b(k,69) - b(k,57) = b(k,57) - lu(k,1016) * b(k,69) - b(k,41) = b(k,41) - lu(k,1015) * b(k,69) - b(k,40) = b(k,40) - lu(k,1014) * b(k,69) - b(k,38) = b(k,38) - lu(k,1013) * b(k,69) - b(k,31) = b(k,31) - lu(k,1012) * b(k,69) - b(k,29) = b(k,29) - lu(k,1011) * b(k,69) - b(k,27) = b(k,27) - lu(k,1010) * b(k,69) - b(k,26) = b(k,26) - lu(k,1009) * b(k,69) - b(k,24) = b(k,24) - lu(k,1008) * b(k,69) - b(k,23) = b(k,23) - lu(k,1007) * b(k,69) - b(k,22) = b(k,22) - lu(k,1006) * b(k,69) - b(k,21) = b(k,21) - lu(k,1005) * b(k,69) - b(k,19) = b(k,19) - lu(k,1004) * b(k,69) - b(k,16) = b(k,16) - lu(k,1003) * b(k,69) - b(k,15) = b(k,15) - lu(k,1002) * b(k,69) - b(k,13) = b(k,13) - lu(k,1001) * b(k,69) - b(k,11) = b(k,11) - lu(k,1000) * b(k,69) - end do + b(75) = b(75) * lu(1237) + b(74) = b(74) - lu(1236) * b(75) + b(73) = b(73) - lu(1235) * b(75) + b(72) = b(72) - lu(1234) * b(75) + b(71) = b(71) - lu(1233) * b(75) + b(70) = b(70) - lu(1232) * b(75) + b(69) = b(69) - lu(1231) * b(75) + b(68) = b(68) - lu(1230) * b(75) + b(67) = b(67) - lu(1229) * b(75) + b(66) = b(66) - lu(1228) * b(75) + b(65) = b(65) - lu(1227) * b(75) + b(64) = b(64) - lu(1226) * b(75) + b(63) = b(63) - lu(1225) * b(75) + b(62) = b(62) - lu(1224) * b(75) + b(61) = b(61) - lu(1223) * b(75) + b(60) = b(60) - lu(1222) * b(75) + b(59) = b(59) - lu(1221) * b(75) + b(58) = b(58) - lu(1220) * b(75) + b(48) = b(48) - lu(1219) * b(75) + b(42) = b(42) - lu(1218) * b(75) + b(37) = b(37) - lu(1217) * b(75) + b(34) = b(34) - lu(1216) * b(75) + b(14) = b(14) - lu(1215) * b(75) + b(74) = b(74) * lu(1201) + b(73) = b(73) - lu(1200) * b(74) + b(72) = b(72) - lu(1199) * b(74) + b(71) = b(71) - lu(1198) * b(74) + b(70) = b(70) - lu(1197) * b(74) + b(69) = b(69) - lu(1196) * b(74) + b(68) = b(68) - lu(1195) * b(74) + b(67) = b(67) - lu(1194) * b(74) + b(66) = b(66) - lu(1193) * b(74) + b(65) = b(65) - lu(1192) * b(74) + b(64) = b(64) - lu(1191) * b(74) + b(63) = b(63) - lu(1190) * b(74) + b(62) = b(62) - lu(1189) * b(74) + b(61) = b(61) - lu(1188) * b(74) + b(60) = b(60) - lu(1187) * b(74) + b(59) = b(59) - lu(1186) * b(74) + b(58) = b(58) - lu(1185) * b(74) + b(57) = b(57) - lu(1184) * b(74) + b(56) = b(56) - lu(1183) * b(74) + b(51) = b(51) - lu(1182) * b(74) + b(50) = b(50) - lu(1181) * b(74) + b(44) = b(44) - lu(1180) * b(74) + b(40) = b(40) - lu(1179) * b(74) + b(37) = b(37) - lu(1178) * b(74) + b(36) = b(36) - lu(1177) * b(74) + b(33) = b(33) - lu(1176) * b(74) + b(23) = b(23) - lu(1175) * b(74) + b(21) = b(21) - lu(1174) * b(74) + b(4) = b(4) - lu(1173) * b(74) + b(73) = b(73) * lu(1158) + b(72) = b(72) - lu(1157) * b(73) + b(71) = b(71) - lu(1156) * b(73) + b(70) = b(70) - lu(1155) * b(73) + b(69) = b(69) - lu(1154) * b(73) + b(68) = b(68) - lu(1153) * b(73) + b(67) = b(67) - lu(1152) * b(73) + b(66) = b(66) - lu(1151) * b(73) + b(65) = b(65) - lu(1150) * b(73) + b(64) = b(64) - lu(1149) * b(73) + b(63) = b(63) - lu(1148) * b(73) + b(62) = b(62) - lu(1147) * b(73) + b(61) = b(61) - lu(1146) * b(73) + b(60) = b(60) - lu(1145) * b(73) + b(59) = b(59) - lu(1144) * b(73) + b(58) = b(58) - lu(1143) * b(73) + b(57) = b(57) - lu(1142) * b(73) + b(48) = b(48) - lu(1141) * b(73) + b(42) = b(42) - lu(1140) * b(73) + b(39) = b(39) - lu(1139) * b(73) + b(35) = b(35) - lu(1138) * b(73) + b(34) = b(34) - lu(1137) * b(73) + b(31) = b(31) - lu(1136) * b(73) + b(28) = b(28) - lu(1135) * b(73) + b(22) = b(22) - lu(1134) * b(73) + b(19) = b(19) - lu(1133) * b(73) + b(18) = b(18) - lu(1132) * b(73) + b(14) = b(14) - lu(1131) * b(73) + b(8) = b(8) - lu(1130) * b(73) + b(72) = b(72) * lu(1114) + b(71) = b(71) - lu(1113) * b(72) + b(70) = b(70) - lu(1112) * b(72) + b(69) = b(69) - lu(1111) * b(72) + b(68) = b(68) - lu(1110) * b(72) + b(67) = b(67) - lu(1109) * b(72) + b(66) = b(66) - lu(1108) * b(72) + b(65) = b(65) - lu(1107) * b(72) + b(64) = b(64) - lu(1106) * b(72) + b(63) = b(63) - lu(1105) * b(72) + b(62) = b(62) - lu(1104) * b(72) + b(61) = b(61) - lu(1103) * b(72) + b(60) = b(60) - lu(1102) * b(72) + b(59) = b(59) - lu(1101) * b(72) + b(58) = b(58) - lu(1100) * b(72) + b(57) = b(57) - lu(1099) * b(72) + b(56) = b(56) - lu(1098) * b(72) + b(50) = b(50) - lu(1097) * b(72) + b(44) = b(44) - lu(1096) * b(72) + b(40) = b(40) - lu(1095) * b(72) + b(37) = b(37) - lu(1094) * b(72) + b(36) = b(36) - lu(1093) * b(72) + b(33) = b(33) - lu(1092) * b(72) + b(6) = b(6) - lu(1091) * b(72) + b(4) = b(4) - lu(1090) * b(72) + b(3) = b(3) - lu(1089) * b(72) + b(1) = b(1) - lu(1088) * b(72) + b(71) = b(71) * lu(1071) + b(70) = b(70) - lu(1070) * b(71) + b(69) = b(69) - lu(1069) * b(71) + b(68) = b(68) - lu(1068) * b(71) + b(67) = b(67) - lu(1067) * b(71) + b(66) = b(66) - lu(1066) * b(71) + b(65) = b(65) - lu(1065) * b(71) + b(64) = b(64) - lu(1064) * b(71) + b(63) = b(63) - lu(1063) * b(71) + b(62) = b(62) - lu(1062) * b(71) + b(61) = b(61) - lu(1061) * b(71) + b(60) = b(60) - lu(1060) * b(71) + b(59) = b(59) - lu(1059) * b(71) + b(57) = b(57) - lu(1058) * b(71) + b(56) = b(56) - lu(1057) * b(71) + b(55) = b(55) - lu(1056) * b(71) + b(54) = b(54) - lu(1055) * b(71) + b(53) = b(53) - lu(1054) * b(71) + b(52) = b(52) - lu(1053) * b(71) + b(50) = b(50) - lu(1052) * b(71) + b(48) = b(48) - lu(1051) * b(71) + b(44) = b(44) - lu(1050) * b(71) + b(39) = b(39) - lu(1049) * b(71) + b(38) = b(38) - lu(1048) * b(71) + b(36) = b(36) - lu(1047) * b(71) + b(30) = b(30) - lu(1046) * b(71) + b(20) = b(20) - lu(1045) * b(71) + b(15) = b(15) - lu(1044) * b(71) + b(70) = b(70) * lu(1026) + b(69) = b(69) - lu(1025) * b(70) + b(68) = b(68) - lu(1024) * b(70) + b(67) = b(67) - lu(1023) * b(70) + b(66) = b(66) - lu(1022) * b(70) + b(65) = b(65) - lu(1021) * b(70) + b(64) = b(64) - lu(1020) * b(70) + b(63) = b(63) - lu(1019) * b(70) + b(62) = b(62) - lu(1018) * b(70) + b(61) = b(61) - lu(1017) * b(70) + b(60) = b(60) - lu(1016) * b(70) + b(59) = b(59) - lu(1015) * b(70) + b(58) = b(58) - lu(1014) * b(70) + b(55) = b(55) - lu(1013) * b(70) + b(54) = b(54) - lu(1012) * b(70) + b(53) = b(53) - lu(1011) * b(70) + b(52) = b(52) - lu(1010) * b(70) + b(49) = b(49) - lu(1009) * b(70) + b(47) = b(47) - lu(1008) * b(70) + b(46) = b(46) - lu(1007) * b(70) + b(45) = b(45) - lu(1006) * b(70) + b(43) = b(43) - lu(1005) * b(70) + b(41) = b(41) - lu(1004) * b(70) + b(26) = b(26) - lu(1003) * b(70) + b(24) = b(24) - lu(1002) * b(70) + b(69) = b(69) * lu(983) + b(68) = b(68) - lu(982) * b(69) + b(67) = b(67) - lu(981) * b(69) + b(66) = b(66) - lu(980) * b(69) + b(65) = b(65) - lu(979) * b(69) + b(64) = b(64) - lu(978) * b(69) + b(63) = b(63) - lu(977) * b(69) + b(62) = b(62) - lu(976) * b(69) + b(61) = b(61) - lu(975) * b(69) + b(60) = b(60) - lu(974) * b(69) + b(59) = b(59) - lu(973) * b(69) + b(58) = b(58) - lu(972) * b(69) + b(55) = b(55) - lu(971) * b(69) + b(54) = b(54) - lu(970) * b(69) + b(53) = b(53) - lu(969) * b(69) + b(52) = b(52) - lu(968) * b(69) + b(49) = b(49) - lu(967) * b(69) + b(47) = b(47) - lu(966) * b(69) + b(46) = b(46) - lu(965) * b(69) + b(45) = b(45) - lu(964) * b(69) + b(43) = b(43) - lu(963) * b(69) + b(41) = b(41) - lu(962) * b(69) + b(26) = b(26) - lu(961) * b(69) + b(68) = b(68) * lu(941) + b(67) = b(67) - lu(940) * b(68) + b(66) = b(66) - lu(939) * b(68) + b(65) = b(65) - lu(938) * b(68) + b(64) = b(64) - lu(937) * b(68) + b(63) = b(63) - lu(936) * b(68) + b(62) = b(62) - lu(935) * b(68) + b(61) = b(61) - lu(934) * b(68) + b(60) = b(60) - lu(933) * b(68) + b(59) = b(59) - lu(932) * b(68) + b(58) = b(58) - lu(931) * b(68) + b(57) = b(57) - lu(930) * b(68) + b(56) = b(56) - lu(929) * b(68) + b(51) = b(51) - lu(928) * b(68) + b(48) = b(48) - lu(927) * b(68) + b(26) = b(26) - lu(926) * b(68) + b(67) = b(67) * lu(905) + b(66) = b(66) - lu(904) * b(67) + b(65) = b(65) - lu(903) * b(67) + b(64) = b(64) - lu(902) * b(67) + b(63) = b(63) - lu(901) * b(67) + b(62) = b(62) - lu(900) * b(67) + b(61) = b(61) - lu(899) * b(67) + b(60) = b(60) - lu(898) * b(67) + b(59) = b(59) - lu(897) * b(67) + b(58) = b(58) - lu(896) * b(67) + b(57) = b(57) - lu(895) * b(67) + b(56) = b(56) - lu(894) * b(67) + b(52) = b(52) - lu(893) * b(67) + b(50) = b(50) - lu(892) * b(67) + b(49) = b(49) - lu(891) * b(67) + b(46) = b(46) - lu(890) * b(67) + b(45) = b(45) - lu(889) * b(67) + b(44) = b(44) - lu(888) * b(67) + b(36) = b(36) - lu(887) * b(67) + b(33) = b(33) - lu(886) * b(67) + b(30) = b(30) - lu(885) * b(67) + b(25) = b(25) - lu(884) * b(67) + b(6) = b(6) - lu(883) * b(67) + b(4) = b(4) - lu(882) * b(67) end subroutine lu_slv08 - subroutine lu_slv09( avec_len, lu, b ) + subroutine lu_slv09( 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) + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) !----------------------------------------------------------------------- ! ... Local variables !----------------------------------------------------------------------- - integer :: k !----------------------------------------------------------------------- ! ... solve L * y = b !----------------------------------------------------------------------- - do k = 1,avec_len - b(k,68) = b(k,68) * lu(k,979) - b(k,67) = b(k,67) - lu(k,978) * b(k,68) - b(k,66) = b(k,66) - lu(k,977) * b(k,68) - b(k,65) = b(k,65) - lu(k,976) * b(k,68) - b(k,64) = b(k,64) - lu(k,975) * b(k,68) - b(k,63) = b(k,63) - lu(k,974) * b(k,68) - b(k,62) = b(k,62) - lu(k,973) * b(k,68) - b(k,61) = b(k,61) - lu(k,972) * b(k,68) - b(k,60) = b(k,60) - lu(k,971) * b(k,68) - b(k,59) = b(k,59) - lu(k,970) * b(k,68) - b(k,58) = b(k,58) - lu(k,969) * b(k,68) - b(k,57) = b(k,57) - lu(k,968) * b(k,68) - b(k,56) = b(k,56) - lu(k,967) * b(k,68) - b(k,52) = b(k,52) - lu(k,966) * b(k,68) - b(k,50) = b(k,50) - lu(k,965) * b(k,68) - b(k,49) = b(k,49) - lu(k,964) * b(k,68) - b(k,44) = b(k,44) - lu(k,963) * b(k,68) - b(k,41) = b(k,41) - lu(k,962) * b(k,68) - b(k,40) = b(k,40) - lu(k,961) * b(k,68) - b(k,38) = b(k,38) - lu(k,960) * b(k,68) - b(k,36) = b(k,36) - lu(k,959) * b(k,68) - b(k,35) = b(k,35) - lu(k,958) * b(k,68) - b(k,34) = b(k,34) - lu(k,957) * b(k,68) - b(k,33) = b(k,33) - lu(k,956) * b(k,68) - b(k,32) = b(k,32) - lu(k,955) * b(k,68) - b(k,31) = b(k,31) - lu(k,954) * b(k,68) - b(k,29) = b(k,29) - lu(k,953) * b(k,68) - b(k,28) = b(k,28) - lu(k,952) * b(k,68) - b(k,25) = b(k,25) - lu(k,951) * b(k,68) - b(k,20) = b(k,20) - lu(k,950) * b(k,68) - b(k,19) = b(k,19) - lu(k,949) * b(k,68) - b(k,18) = b(k,18) - lu(k,948) * b(k,68) - b(k,17) = b(k,17) - lu(k,947) * b(k,68) - b(k,16) = b(k,16) - lu(k,946) * b(k,68) - b(k,15) = b(k,15) - lu(k,945) * b(k,68) - b(k,10) = b(k,10) - lu(k,944) * b(k,68) - b(k,67) = b(k,67) * lu(k,922) - b(k,66) = b(k,66) - lu(k,921) * b(k,67) - b(k,65) = b(k,65) - lu(k,920) * b(k,67) - b(k,64) = b(k,64) - lu(k,919) * b(k,67) - b(k,63) = b(k,63) - lu(k,918) * b(k,67) - b(k,62) = b(k,62) - lu(k,917) * b(k,67) - b(k,61) = b(k,61) - lu(k,916) * b(k,67) - b(k,60) = b(k,60) - lu(k,915) * b(k,67) - b(k,59) = b(k,59) - lu(k,914) * b(k,67) - b(k,58) = b(k,58) - lu(k,913) * b(k,67) - b(k,55) = b(k,55) - lu(k,912) * b(k,67) - b(k,54) = b(k,54) - lu(k,911) * b(k,67) - b(k,53) = b(k,53) - lu(k,910) * b(k,67) - b(k,51) = b(k,51) - lu(k,909) * b(k,67) - b(k,48) = b(k,48) - lu(k,908) * b(k,67) - b(k,47) = b(k,47) - lu(k,907) * b(k,67) - b(k,46) = b(k,46) - lu(k,906) * b(k,67) - b(k,45) = b(k,45) - lu(k,905) * b(k,67) - b(k,43) = b(k,43) - lu(k,904) * b(k,67) - b(k,42) = b(k,42) - lu(k,903) * b(k,67) - b(k,24) = b(k,24) - lu(k,902) * b(k,67) - b(k,13) = b(k,13) - lu(k,901) * b(k,67) - b(k,66) = b(k,66) * lu(k,878) - b(k,65) = b(k,65) - lu(k,877) * b(k,66) - b(k,64) = b(k,64) - lu(k,876) * b(k,66) - b(k,63) = b(k,63) - lu(k,875) * b(k,66) - b(k,62) = b(k,62) - lu(k,874) * b(k,66) - b(k,61) = b(k,61) - lu(k,873) * b(k,66) - b(k,60) = b(k,60) - lu(k,872) * b(k,66) - b(k,59) = b(k,59) - lu(k,871) * b(k,66) - b(k,58) = b(k,58) - lu(k,870) * b(k,66) - b(k,57) = b(k,57) - lu(k,869) * b(k,66) - b(k,55) = b(k,55) - lu(k,868) * b(k,66) - b(k,54) = b(k,54) - lu(k,867) * b(k,66) - b(k,53) = b(k,53) - lu(k,866) * b(k,66) - b(k,51) = b(k,51) - lu(k,865) * b(k,66) - b(k,48) = b(k,48) - lu(k,864) * b(k,66) - b(k,47) = b(k,47) - lu(k,863) * b(k,66) - b(k,46) = b(k,46) - lu(k,862) * b(k,66) - b(k,45) = b(k,45) - lu(k,861) * b(k,66) - b(k,43) = b(k,43) - lu(k,860) * b(k,66) - b(k,42) = b(k,42) - lu(k,859) * b(k,66) - b(k,40) = b(k,40) - lu(k,858) * b(k,66) - b(k,38) = b(k,38) - lu(k,857) * b(k,66) - b(k,31) = b(k,31) - lu(k,856) * b(k,66) - b(k,29) = b(k,29) - lu(k,855) * b(k,66) - b(k,23) = b(k,23) - lu(k,854) * b(k,66) - b(k,22) = b(k,22) - lu(k,853) * b(k,66) - b(k,65) = b(k,65) * lu(k,829) - b(k,64) = b(k,64) - lu(k,828) * b(k,65) - b(k,63) = b(k,63) - lu(k,827) * b(k,65) - b(k,62) = b(k,62) - lu(k,826) * b(k,65) - b(k,61) = b(k,61) - lu(k,825) * b(k,65) - b(k,60) = b(k,60) - lu(k,824) * b(k,65) - b(k,59) = b(k,59) - lu(k,823) * b(k,65) - b(k,58) = b(k,58) - lu(k,822) * b(k,65) - b(k,55) = b(k,55) - lu(k,821) * b(k,65) - b(k,54) = b(k,54) - lu(k,820) * b(k,65) - b(k,53) = b(k,53) - lu(k,819) * b(k,65) - b(k,51) = b(k,51) - lu(k,818) * b(k,65) - b(k,48) = b(k,48) - lu(k,817) * b(k,65) - b(k,47) = b(k,47) - lu(k,816) * b(k,65) - b(k,46) = b(k,46) - lu(k,815) * b(k,65) - b(k,45) = b(k,45) - lu(k,814) * b(k,65) - b(k,43) = b(k,43) - lu(k,813) * b(k,65) - b(k,42) = b(k,42) - lu(k,812) * b(k,65) - b(k,26) = b(k,26) - lu(k,811) * b(k,65) - b(k,21) = b(k,21) - lu(k,810) * b(k,65) - b(k,64) = b(k,64) * lu(k,785) - b(k,63) = b(k,63) - lu(k,784) * b(k,64) - b(k,62) = b(k,62) - lu(k,783) * b(k,64) - b(k,60) = b(k,60) - lu(k,782) * b(k,64) - b(k,58) = b(k,58) - lu(k,781) * b(k,64) - b(k,55) = b(k,55) - lu(k,780) * b(k,64) - b(k,54) = b(k,54) - lu(k,779) * b(k,64) - b(k,49) = b(k,49) - lu(k,778) * b(k,64) - b(k,35) = b(k,35) - lu(k,777) * b(k,64) - b(k,63) = b(k,63) * lu(k,755) - b(k,61) = b(k,61) - lu(k,754) * b(k,63) - b(k,57) = b(k,57) - lu(k,753) * b(k,63) - b(k,56) = b(k,56) - lu(k,752) * b(k,63) - b(k,52) = b(k,52) - lu(k,751) * b(k,63) - b(k,50) = b(k,50) - lu(k,750) * b(k,63) - b(k,44) = b(k,44) - lu(k,749) * b(k,63) - b(k,40) = b(k,40) - lu(k,748) * b(k,63) - b(k,39) = b(k,39) - lu(k,747) * b(k,63) - b(k,34) = b(k,34) - lu(k,746) * b(k,63) - b(k,33) = b(k,33) - lu(k,745) * b(k,63) - b(k,32) = b(k,32) - lu(k,744) * b(k,63) - b(k,30) = b(k,30) - lu(k,743) * b(k,63) - b(k,26) = b(k,26) - lu(k,742) * b(k,63) - b(k,25) = b(k,25) - lu(k,741) * b(k,63) - b(k,24) = b(k,24) - lu(k,740) * b(k,63) - b(k,18) = b(k,18) - lu(k,739) * b(k,63) - b(k,14) = b(k,14) - lu(k,738) * b(k,63) - b(k,12) = b(k,12) - lu(k,737) * b(k,63) - b(k,5) = b(k,5) - lu(k,736) * b(k,63) - b(k,2) = b(k,2) - lu(k,735) * b(k,63) - b(k,62) = b(k,62) * lu(k,712) - b(k,60) = b(k,60) - lu(k,711) * b(k,62) - b(k,58) = b(k,58) - lu(k,710) * b(k,62) - b(k,47) = b(k,47) - lu(k,709) * b(k,62) - b(k,24) = b(k,24) - lu(k,708) * b(k,62) - b(k,61) = b(k,61) * lu(k,686) - b(k,57) = b(k,57) - lu(k,685) * b(k,61) - b(k,56) = b(k,56) - lu(k,684) * b(k,61) - b(k,52) = b(k,52) - lu(k,683) * b(k,61) - b(k,50) = b(k,50) - lu(k,682) * b(k,61) - b(k,44) = b(k,44) - lu(k,681) * b(k,61) - b(k,39) = b(k,39) - lu(k,680) * b(k,61) - b(k,33) = b(k,33) - lu(k,679) * b(k,61) - b(k,32) = b(k,32) - lu(k,678) * b(k,61) - b(k,28) = b(k,28) - lu(k,677) * b(k,61) - b(k,26) = b(k,26) - lu(k,676) * b(k,61) - b(k,18) = b(k,18) - lu(k,675) * b(k,61) - b(k,14) = b(k,14) - lu(k,674) * b(k,61) - b(k,12) = b(k,12) - lu(k,673) * b(k,61) - b(k,60) = b(k,60) * lu(k,652) - b(k,58) = b(k,58) - lu(k,651) * b(k,60) - b(k,55) = b(k,55) - lu(k,650) * b(k,60) - b(k,51) = b(k,51) - lu(k,649) * b(k,60) - b(k,48) = b(k,48) - lu(k,648) * b(k,60) - b(k,59) = b(k,59) * lu(k,619) - b(k,58) = b(k,58) - lu(k,618) * b(k,59) - b(k,49) = b(k,49) - lu(k,617) * b(k,59) - b(k,35) = b(k,35) - lu(k,616) * b(k,59) - b(k,58) = b(k,58) * lu(k,597) - b(k,46) = b(k,46) - lu(k,596) * b(k,58) - b(k,45) = b(k,45) - lu(k,595) * b(k,58) - b(k,57) = b(k,57) * lu(k,573) - b(k,56) = b(k,56) - lu(k,572) * b(k,57) - b(k,52) = b(k,52) - lu(k,571) * b(k,57) - b(k,50) = b(k,50) - lu(k,570) * b(k,57) - b(k,44) = b(k,44) - lu(k,569) * b(k,57) - b(k,41) = b(k,41) - lu(k,568) * b(k,57) - b(k,39) = b(k,39) - lu(k,567) * b(k,57) - b(k,36) = b(k,36) - lu(k,566) * b(k,57) - b(k,33) = b(k,33) - lu(k,565) * b(k,57) - b(k,30) = b(k,30) - lu(k,564) * b(k,57) - b(k,10) = b(k,10) - lu(k,563) * b(k,57) - b(k,5) = b(k,5) - lu(k,562) * b(k,57) - b(k,2) = b(k,2) - lu(k,561) * b(k,57) - b(k,56) = b(k,56) * lu(k,541) - b(k,52) = b(k,52) - lu(k,540) * b(k,56) - b(k,50) = b(k,50) - lu(k,539) * b(k,56) - b(k,44) = b(k,44) - lu(k,538) * b(k,56) - b(k,33) = b(k,33) - lu(k,537) * b(k,56) - b(k,25) = b(k,25) - lu(k,536) * b(k,56) - b(k,55) = b(k,55) * lu(k,519) - b(k,53) = b(k,53) - lu(k,518) * b(k,55) - b(k,51) = b(k,51) - lu(k,517) * b(k,55) - b(k,37) = b(k,37) - lu(k,516) * b(k,55) - b(k,54) = b(k,54) * lu(k,497) - b(k,47) = b(k,47) - lu(k,496) * b(k,54) - b(k,43) = b(k,43) - lu(k,495) * b(k,54) - b(k,53) = b(k,53) * lu(k,477) - b(k,51) = b(k,51) - lu(k,476) * b(k,53) - b(k,37) = b(k,37) - lu(k,475) * b(k,53) - b(k,52) = b(k,52) * lu(k,457) - b(k,44) = b(k,44) - lu(k,456) * b(k,52) - b(k,28) = b(k,28) - lu(k,455) * b(k,52) - b(k,17) = b(k,17) - lu(k,454) * b(k,52) - b(k,6) = b(k,6) - lu(k,453) * b(k,52) - b(k,3) = b(k,3) - lu(k,452) * b(k,52) - b(k,51) = b(k,51) * lu(k,438) - end do + b(66) = b(66) * lu(860) + b(65) = b(65) - lu(859) * b(66) + b(64) = b(64) - lu(858) * b(66) + b(63) = b(63) - lu(857) * b(66) + b(62) = b(62) - lu(856) * b(66) + b(61) = b(61) - lu(855) * b(66) + b(60) = b(60) - lu(854) * b(66) + b(59) = b(59) - lu(853) * b(66) + b(58) = b(58) - lu(852) * b(66) + b(55) = b(55) - lu(851) * b(66) + b(54) = b(54) - lu(850) * b(66) + b(53) = b(53) - lu(849) * b(66) + b(52) = b(52) - lu(848) * b(66) + b(49) = b(49) - lu(847) * b(66) + b(47) = b(47) - lu(846) * b(66) + b(46) = b(46) - lu(845) * b(66) + b(45) = b(45) - lu(844) * b(66) + b(43) = b(43) - lu(843) * b(66) + b(41) = b(41) - lu(842) * b(66) + b(25) = b(25) - lu(841) * b(66) + b(13) = b(13) - lu(840) * b(66) + b(65) = b(65) * lu(817) + b(64) = b(64) - lu(816) * b(65) + b(63) = b(63) - lu(815) * b(65) + b(62) = b(62) - lu(814) * b(65) + b(61) = b(61) - lu(813) * b(65) + b(60) = b(60) - lu(812) * b(65) + b(59) = b(59) - lu(811) * b(65) + b(58) = b(58) - lu(810) * b(65) + b(57) = b(57) - lu(809) * b(65) + b(55) = b(55) - lu(808) * b(65) + b(54) = b(54) - lu(807) * b(65) + b(53) = b(53) - lu(806) * b(65) + b(52) = b(52) - lu(805) * b(65) + b(49) = b(49) - lu(804) * b(65) + b(47) = b(47) - lu(803) * b(65) + b(46) = b(46) - lu(802) * b(65) + b(45) = b(45) - lu(801) * b(65) + b(43) = b(43) - lu(800) * b(65) + b(41) = b(41) - lu(799) * b(65) + b(39) = b(39) - lu(798) * b(65) + b(35) = b(35) - lu(797) * b(65) + b(31) = b(31) - lu(796) * b(65) + b(28) = b(28) - lu(795) * b(65) + b(17) = b(17) - lu(794) * b(65) + b(16) = b(16) - lu(793) * b(65) + b(64) = b(64) * lu(769) + b(62) = b(62) - lu(768) * b(64) + b(60) = b(60) - lu(767) * b(64) + b(59) = b(59) - lu(766) * b(64) + b(47) = b(47) - lu(765) * b(64) + b(25) = b(25) - lu(764) * b(64) + b(63) = b(63) * lu(739) + b(62) = b(62) - lu(738) * b(63) + b(60) = b(60) - lu(737) * b(63) + b(59) = b(59) - lu(736) * b(63) + b(55) = b(55) - lu(735) * b(63) + b(54) = b(54) - lu(734) * b(63) + b(48) = b(48) - lu(733) * b(63) + b(37) = b(37) - lu(732) * b(63) + b(62) = b(62) * lu(711) + b(61) = b(61) - lu(710) * b(62) + b(57) = b(57) - lu(709) * b(62) + b(56) = b(56) - lu(708) * b(62) + b(51) = b(51) - lu(707) * b(62) + b(50) = b(50) - lu(706) * b(62) + b(44) = b(44) - lu(705) * b(62) + b(40) = b(40) - lu(704) * b(62) + b(39) = b(39) - lu(703) * b(62) + b(36) = b(36) - lu(702) * b(62) + b(33) = b(33) - lu(701) * b(62) + b(32) = b(32) - lu(700) * b(62) + b(29) = b(29) - lu(699) * b(62) + b(26) = b(26) - lu(698) * b(62) + b(25) = b(25) - lu(697) * b(62) + b(23) = b(23) - lu(696) * b(62) + b(21) = b(21) - lu(695) * b(62) + b(15) = b(15) - lu(694) * b(62) + b(11) = b(11) - lu(693) * b(62) + b(5) = b(5) - lu(692) * b(62) + b(2) = b(2) - lu(691) * b(62) + b(61) = b(61) * lu(670) + b(57) = b(57) - lu(669) * b(61) + b(56) = b(56) - lu(668) * b(61) + b(51) = b(51) - lu(667) * b(61) + b(50) = b(50) - lu(666) * b(61) + b(44) = b(44) - lu(665) * b(61) + b(40) = b(40) - lu(664) * b(61) + b(33) = b(33) - lu(663) * b(61) + b(32) = b(32) - lu(662) * b(61) + b(30) = b(30) - lu(661) * b(61) + b(26) = b(26) - lu(660) * b(61) + b(23) = b(23) - lu(659) * b(61) + b(15) = b(15) - lu(658) * b(61) + b(11) = b(11) - lu(657) * b(61) + b(60) = b(60) * lu(636) + b(59) = b(59) - lu(635) * b(60) + b(55) = b(55) - lu(634) * b(60) + b(52) = b(52) - lu(633) * b(60) + b(49) = b(49) - lu(632) * b(60) + b(59) = b(59) * lu(613) + b(46) = b(46) - lu(612) * b(59) + b(45) = b(45) - lu(611) * b(59) + b(58) = b(58) * lu(583) + b(48) = b(48) - lu(582) * b(58) + b(37) = b(37) - lu(581) * b(58) + b(57) = b(57) * lu(560) + b(56) = b(56) - lu(559) * b(57) + b(51) = b(51) - lu(558) * b(57) + b(50) = b(50) - lu(557) * b(57) + b(44) = b(44) - lu(556) * b(57) + b(42) = b(42) - lu(555) * b(57) + b(40) = b(40) - lu(554) * b(57) + b(34) = b(34) - lu(553) * b(57) + b(32) = b(32) - lu(552) * b(57) + b(29) = b(29) - lu(551) * b(57) + b(8) = b(8) - lu(550) * b(57) + b(5) = b(5) - lu(549) * b(57) + b(2) = b(2) - lu(548) * b(57) + b(56) = b(56) * lu(529) + b(51) = b(51) - lu(528) * b(56) + b(50) = b(50) - lu(527) * b(56) + b(44) = b(44) - lu(526) * b(56) + b(32) = b(32) - lu(525) * b(56) + b(21) = b(21) - lu(524) * b(56) + b(55) = b(55) * lu(507) + b(53) = b(53) - lu(506) * b(55) + b(52) = b(52) - lu(505) * b(55) + b(38) = b(38) - lu(504) * b(55) + b(54) = b(54) * lu(486) + b(47) = b(47) - lu(485) * b(54) + b(43) = b(43) - lu(484) * b(54) + b(53) = b(53) * lu(466) + b(52) = b(52) - lu(465) * b(53) + b(38) = b(38) - lu(464) * b(53) + b(52) = b(52) * lu(450) + b(51) = b(51) * lu(431) + b(40) = b(40) - lu(430) * b(51) + b(29) = b(29) - lu(429) * b(51) + b(7) = b(7) - lu(428) * b(51) + b(50) = b(50) * lu(411) + b(44) = b(44) - lu(410) * b(50) + b(30) = b(30) - lu(409) * b(50) + b(20) = b(20) - lu(408) * b(50) + b(6) = b(6) - lu(407) * b(50) + b(3) = b(3) - lu(406) * b(50) + b(49) = b(49) * lu(390) + b(48) = b(48) * lu(376) + b(47) = b(47) * lu(362) + b(46) = b(46) * lu(347) + b(45) = b(45) - lu(346) * b(46) + b(45) = b(45) * lu(331) + b(44) = b(44) * lu(320) + b(32) = b(32) - lu(319) * b(44) + b(21) = b(21) - lu(318) * b(44) + b(43) = b(43) * lu(304) + b(42) = b(42) * lu(292) + b(34) = b(34) - lu(291) * b(42) + b(27) = b(27) - lu(290) * b(42) + b(41) = b(41) * lu(277) + b(40) = b(40) * lu(266) + b(11) = b(11) - lu(265) * b(40) + b(39) = b(39) * lu(253) + b(35) = b(35) - lu(252) * b(39) + b(31) = b(31) - lu(251) * b(39) + b(38) = b(38) * lu(239) + b(10) = b(10) - lu(238) * b(38) + b(9) = b(9) - lu(237) * b(38) + b(37) = b(37) * lu(229) + b(36) = b(36) * lu(219) + b(33) = b(33) - lu(218) * b(36) + b(4) = b(4) - lu(217) * b(36) + b(35) = b(35) * lu(206) + b(31) = b(31) - lu(205) * b(35) + b(28) = b(28) - lu(204) * b(35) + b(21) = b(21) - lu(203) * b(35) + b(34) = b(34) * lu(195) + b(33) = b(33) * lu(188) + b(4) = b(4) - lu(187) * b(33) + b(32) = b(32) * lu(179) + b(31) = b(31) * lu(172) + b(30) = b(30) * lu(164) + b(6) = b(6) - lu(163) * b(30) + b(29) = b(29) * lu(155) + b(7) = b(7) - lu(154) * b(29) + b(28) = b(28) * lu(146) + b(27) = b(27) * lu(138) + b(26) = b(26) - lu(137) * b(27) + b(24) = b(24) - lu(136) * b(27) + b(12) = b(12) - lu(135) * b(27) + b(26) = b(26) * lu(130) + b(24) = b(24) - lu(129) * b(26) + b(25) = b(25) * lu(124) + b(24) = b(24) * lu(118) + b(23) = b(23) * lu(111) + b(22) = b(22) * lu(102) + b(21) = b(21) * lu(98) + b(20) = b(20) * lu(90) + b(19) = b(19) * lu(84) + b(18) = b(18) * lu(77) + b(17) = b(17) * lu(71) end subroutine lu_slv09 - subroutine lu_slv10( avec_len, lu, b ) + subroutine lu_slv10( 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) + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) !----------------------------------------------------------------------- ! ... Local variables !----------------------------------------------------------------------- - integer :: k !----------------------------------------------------------------------- ! ... solve L * y = b !----------------------------------------------------------------------- - do k = 1,avec_len - b(k,50) = b(k,50) * lu(k,419) - b(k,39) = b(k,39) - lu(k,418) * b(k,50) - b(k,30) = b(k,30) - lu(k,417) * b(k,50) - b(k,7) = b(k,7) - lu(k,416) * b(k,50) - b(k,49) = b(k,49) * lu(k,401) - b(k,48) = b(k,48) * lu(k,385) - b(k,47) = b(k,47) * lu(k,371) - b(k,46) = b(k,46) * lu(k,356) - b(k,45) = b(k,45) - lu(k,355) * b(k,46) - b(k,45) = b(k,45) * lu(k,340) - b(k,44) = b(k,44) * lu(k,328) - b(k,33) = b(k,33) - lu(k,327) * b(k,44) - b(k,25) = b(k,25) - lu(k,326) * b(k,44) - b(k,43) = b(k,43) * lu(k,311) - b(k,42) = b(k,42) * lu(k,297) - b(k,41) = b(k,41) * lu(k,285) - b(k,36) = b(k,36) - lu(k,284) * b(k,41) - b(k,27) = b(k,27) - lu(k,283) * b(k,41) - b(k,40) = b(k,40) * lu(k,270) - b(k,38) = b(k,38) - lu(k,269) * b(k,40) - b(k,31) = b(k,31) - lu(k,268) * b(k,40) - b(k,39) = b(k,39) * lu(k,257) - b(k,12) = b(k,12) - lu(k,256) * b(k,39) - b(k,38) = b(k,38) * lu(k,244) - b(k,31) = b(k,31) - lu(k,243) * b(k,38) - b(k,29) = b(k,29) - lu(k,242) * b(k,38) - b(k,25) = b(k,25) - lu(k,241) * b(k,38) - b(k,37) = b(k,37) * lu(k,229) - b(k,9) = b(k,9) - lu(k,228) * b(k,37) - b(k,8) = b(k,8) - lu(k,227) * b(k,37) - b(k,36) = b(k,36) * lu(k,219) - b(k,35) = b(k,35) * lu(k,211) - b(k,34) = b(k,34) * lu(k,201) - b(k,32) = b(k,32) - lu(k,200) * b(k,34) - b(k,4) = b(k,4) - lu(k,199) * b(k,34) - b(k,33) = b(k,33) * lu(k,191) - b(k,32) = b(k,32) * lu(k,184) - b(k,4) = b(k,4) - lu(k,183) * b(k,32) - b(k,31) = b(k,31) * lu(k,176) - b(k,30) = b(k,30) * lu(k,168) - b(k,7) = b(k,7) - lu(k,167) * b(k,30) - b(k,29) = b(k,29) * lu(k,159) - b(k,28) = b(k,28) * lu(k,151) - b(k,6) = b(k,6) - lu(k,150) * b(k,28) - b(k,27) = b(k,27) * lu(k,142) - b(k,26) = b(k,26) - lu(k,141) * b(k,27) - b(k,21) = b(k,21) - lu(k,140) * b(k,27) - b(k,11) = b(k,11) - lu(k,139) * b(k,27) - b(k,26) = b(k,26) * lu(k,134) - b(k,21) = b(k,21) - lu(k,133) * b(k,26) - b(k,25) = b(k,25) * lu(k,128) - b(k,24) = b(k,24) * lu(k,123) - b(k,23) = b(k,23) * lu(k,116) - b(k,22) = b(k,22) * lu(k,108) - b(k,21) = b(k,21) * lu(k,102) - b(k,20) = b(k,20) * lu(k,95) - b(k,19) = b(k,19) * lu(k,86) - b(k,18) = b(k,18) * lu(k,79) - b(k,17) = b(k,17) * lu(k,71) - b(k,16) = b(k,16) * lu(k,65) - b(k,15) = b(k,15) * lu(k,58) - b(k,14) = b(k,14) * lu(k,51) - b(k,13) = b(k,13) * lu(k,45) - b(k,12) = b(k,12) * lu(k,39) - b(k,11) = b(k,11) * lu(k,33) - b(k,10) = b(k,10) * lu(k,30) - b(k,9) = b(k,9) * lu(k,26) - b(k,8) = b(k,8) * lu(k,22) - b(k,7) = b(k,7) * lu(k,19) - b(k,6) = b(k,6) * lu(k,16) - b(k,5) = b(k,5) * lu(k,12) - b(k,4) = b(k,4) * lu(k,10) - b(k,3) = b(k,3) * lu(k,7) - b(k,2) = b(k,2) * lu(k,4) - b(k,1) = b(k,1) * lu(k,1) - end do + b(16) = b(16) * lu(64) + b(15) = b(15) * lu(57) + b(14) = b(14) * lu(51) + b(13) = b(13) * lu(45) + b(12) = b(12) * lu(39) + b(11) = b(11) * lu(33) + b(10) = b(10) * lu(29) + b(9) = b(9) * lu(25) + b(8) = b(8) * lu(22) + b(7) = b(7) * lu(19) + b(6) = b(6) * lu(16) + b(5) = b(5) * lu(12) + b(4) = b(4) * lu(10) + b(3) = b(3) * lu(7) + b(2) = b(2) * lu(4) + b(1) = b(1) * lu(1) end subroutine lu_slv10 - subroutine lu_slv( avec_len, lu, b ) + subroutine lu_slv( 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 ) - call lu_slv09( avec_len, lu, b ) - call lu_slv10( avec_len, lu, b ) + real(r8), intent(in) :: lu(:) + real(r8), intent(inout) :: b(:) + call lu_slv01( lu, b ) + call lu_slv02( lu, b ) + call lu_slv03( lu, b ) + call lu_slv04( lu, b ) + call lu_slv05( lu, b ) + call lu_slv06( lu, b ) + call lu_slv07( lu, b ) + call lu_slv08( lu, b ) + call lu_slv09( lu, b ) + call lu_slv10( lu, b ) end subroutine lu_slv end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_mad/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_mad/mo_nln_matrix.F90 index 757cd5b451..e099d488d2 100644 --- a/src/chemistry/pp_waccm_mad/mo_nln_matrix.F90 +++ b/src/chemistry/pp_waccm_mad/mo_nln_matrix.F90 @@ -1,3006 +1,2730 @@ 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 ) + subroutine nlnmat01( 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) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) !---------------------------------------------- ! ... local variables !---------------------------------------------- - integer :: k !---------------------------------------------- ! ... complete matrix entries implicit species !---------------------------------------------- - do k = 1,avec_len - mat(k,453) = rxt(k,487)*y(k,24) - mat(k,1500) = rxt(k,487)*y(k,2) - mat(k,1453) = (rxt(k,549)+rxt(k,554))*y(k,45) - mat(k,150) = (rxt(k,549)+rxt(k,554))*y(k,40) - mat(k,457) = -(4._r8*rxt(k,484)*y(k,2) + (rxt(k,485) + rxt(k,486) + rxt(k,487) & - ) * y(k,24) + rxt(k,488)*y(k,43) + rxt(k,489)*y(k,51) + rxt(k,490) & - *y(k,52) + rxt(k,492)*y(k,54) + rxt(k,493)*y(k,104)) - mat(k,1506) = -(rxt(k,485) + rxt(k,486) + rxt(k,487)) * y(k,2) - mat(k,683) = -rxt(k,488)*y(k,2) - mat(k,1738) = -rxt(k,489)*y(k,2) - mat(k,1134) = -rxt(k,490)*y(k,2) - mat(k,966) = -rxt(k,492)*y(k,2) - mat(k,751) = -rxt(k,493)*y(k,2) - mat(k,74) = rxt(k,491)*y(k,54) - mat(k,193) = rxt(k,501)*y(k,95) - mat(k,153) = rxt(k,496)*y(k,54) - mat(k,966) = mat(k,966) + rxt(k,491)*y(k,3) + rxt(k,496)*y(k,45) - mat(k,1419) = rxt(k,483)*y(k,59) - mat(k,329) = rxt(k,483)*y(k,56) - mat(k,571) = rxt(k,501)*y(k,36) - mat(k,71) = -(rxt(k,491)*y(k,54)) - mat(k,947) = -rxt(k,491)*y(k,3) - mat(k,454) = rxt(k,490)*y(k,52) - mat(k,1126) = rxt(k,490)*y(k,2) - mat(k,541) = -(rxt(k,445)*y(k,60) + rxt(k,481)*y(k,59) + rxt(k,525)*y(k,53) & - + rxt(k,526)*y(k,54) + rxt(k,527)*y(k,104)) - mat(k,1662) = -rxt(k,445)*y(k,14) - mat(k,330) = -rxt(k,481)*y(k,14) - mat(k,1218) = -rxt(k,525)*y(k,14) - mat(k,967) = -rxt(k,526)*y(k,14) - mat(k,752) = -rxt(k,527)*y(k,14) - mat(k,258) = rxt(k,452)*y(k,24) + rxt(k,529)*y(k,51) - mat(k,41) = .300_r8*rxt(k,530)*y(k,104) - mat(k,1507) = rxt(k,452)*y(k,18) - mat(k,1741) = rxt(k,529)*y(k,18) - mat(k,752) = mat(k,752) + .300_r8*rxt(k,530)*y(k,19) - mat(k,257) = -(rxt(k,452)*y(k,24) + rxt(k,528)*y(k,43) + rxt(k,529)*y(k,51)) - mat(k,1504) = -rxt(k,452)*y(k,18) - mat(k,680) = -rxt(k,528)*y(k,18) - mat(k,1733) = -rxt(k,529)*y(k,18) - mat(k,40) = .700_r8*rxt(k,530)*y(k,104) - mat(k,747) = .700_r8*rxt(k,530)*y(k,19) - mat(k,39) = -(rxt(k,530)*y(k,104)) - mat(k,737) = -rxt(k,530)*y(k,19) - mat(k,256) = rxt(k,528)*y(k,43) - mat(k,673) = rxt(k,528)*y(k,18) - mat(k,1499) = 2.000_r8*rxt(k,454)*y(k,24) - mat(k,199) = (rxt(k,547)+rxt(k,552)+rxt(k,557))*y(k,40) + rxt(k,458)*y(k,60) - mat(k,1452) = (rxt(k,547)+rxt(k,552)+rxt(k,557))*y(k,25) + (rxt(k,542) & - +rxt(k,548)+rxt(k,553))*y(k,46) - mat(k,183) = (rxt(k,542)+rxt(k,548)+rxt(k,553))*y(k,40) - mat(k,1652) = rxt(k,458)*y(k,25) - mat(k,1497) = 2.000_r8*rxt(k,479)*y(k,24) - mat(k,1532) = -(rxt(k,111)*y(k,65) + rxt(k,123)*y(k,68) + rxt(k,281)*y(k,81) & - + rxt(k,310)*y(k,98) + rxt(k,337)*y(k,105) + rxt(k,346)*y(k,106) & - + rxt(k,452)*y(k,18) + (4._r8*rxt(k,453) + 4._r8*rxt(k,454) & - + 4._r8*rxt(k,455) + 4._r8*rxt(k,479)) * y(k,24) + rxt(k,456) & - *y(k,43) + rxt(k,457)*y(k,51) + rxt(k,459)*y(k,52) + rxt(k,462) & - *y(k,54) + (rxt(k,463) + rxt(k,464)) * y(k,104) + (rxt(k,485) & - + rxt(k,486) + rxt(k,487)) * y(k,2)) - mat(k,802) = -rxt(k,111)*y(k,24) - mat(k,640) = -rxt(k,123)*y(k,24) - mat(k,728) = -rxt(k,281)*y(k,24) - mat(k,1319) = -rxt(k,310)*y(k,24) - mat(k,1608) = -rxt(k,337)*y(k,24) - mat(k,1644) = -rxt(k,346)*y(k,24) - mat(k,263) = -rxt(k,452)*y(k,24) - mat(k,701) = -rxt(k,456)*y(k,24) - mat(k,1765) = -rxt(k,457)*y(k,24) - mat(k,1162) = -rxt(k,459)*y(k,24) - mat(k,992) = -rxt(k,462)*y(k,24) - mat(k,770) = -(rxt(k,463) + rxt(k,464)) * y(k,24) - mat(k,470) = -(rxt(k,485) + rxt(k,486) + rxt(k,487)) * y(k,24) - mat(k,208) = rxt(k,460)*y(k,54) - mat(k,1489) = rxt(k,478)*y(k,95) - mat(k,701) = mat(k,701) + rxt(k,450)*y(k,60) - mat(k,188) = rxt(k,468)*y(k,54) + rxt(k,467)*y(k,60) + rxt(k,469)*y(k,104) - mat(k,992) = mat(k,992) + rxt(k,460)*y(k,25) + rxt(k,468)*y(k,46) - mat(k,1444) = rxt(k,451)*y(k,60) - mat(k,1687) = rxt(k,450)*y(k,43) + rxt(k,467)*y(k,46) + rxt(k,451)*y(k,56) - mat(k,588) = rxt(k,478)*y(k,40) - mat(k,770) = mat(k,770) + rxt(k,469)*y(k,46) - mat(k,201) = -(rxt(k,458)*y(k,60) + rxt(k,460)*y(k,54) + rxt(k,461)*y(k,104) & - + (rxt(k,547) + rxt(k,552) + rxt(k,557)) * y(k,40)) - mat(k,1656) = -rxt(k,458)*y(k,25) - mat(k,957) = -rxt(k,460)*y(k,25) - mat(k,746) = -rxt(k,461)*y(k,25) - mat(k,1457) = -(rxt(k,547) + rxt(k,552) + rxt(k,557)) * y(k,25) - mat(k,1502) = rxt(k,459)*y(k,52) - mat(k,1128) = rxt(k,459)*y(k,24) - mat(k,128) = -((rxt(k,532) + rxt(k,536)) * y(k,104)) - mat(k,741) = -(rxt(k,532) + rxt(k,536)) * y(k,27) - mat(k,536) = rxt(k,525)*y(k,53) + rxt(k,526)*y(k,54) + rxt(k,481)*y(k,59) & - + rxt(k,445)*y(k,60) + rxt(k,527)*y(k,104) - mat(k,1376) = rxt(k,573)*y(k,107) - mat(k,1213) = rxt(k,525)*y(k,14) - mat(k,951) = rxt(k,526)*y(k,14) - mat(k,326) = rxt(k,481)*y(k,14) - mat(k,1654) = rxt(k,445)*y(k,14) - mat(k,741) = mat(k,741) + rxt(k,527)*y(k,14) - mat(k,241) = rxt(k,573)*y(k,28) - mat(k,4) = -(rxt(k,506)*y(k,95)) - mat(k,561) = -rxt(k,506)*y(k,29) - mat(k,12) = -(rxt(k,507)*y(k,95)) - mat(k,562) = -rxt(k,507)*y(k,30) - mat(k,1403) = -(rxt(k,307)*y(k,93) + rxt(k,311)*y(k,98) + rxt(k,325)*y(k,101) & - + rxt(k,330)*y(k,102) + rxt(k,338)*y(k,105) + rxt(k,347) & - *y(k,106) + rxt(k,363)*y(k,88) + rxt(k,573)*y(k,107)) - mat(k,113) = -rxt(k,307)*y(k,28) - mat(k,1316) = -rxt(k,311)*y(k,28) - mat(k,410) = -rxt(k,325)*y(k,28) - mat(k,101) = -rxt(k,330)*y(k,28) - mat(k,1605) = -rxt(k,338)*y(k,28) - mat(k,1641) = -rxt(k,347)*y(k,28) - mat(k,890) = -rxt(k,363)*y(k,28) - mat(k,253) = -rxt(k,573)*y(k,28) - mat(k,1529) = rxt(k,111)*y(k,65) + rxt(k,123)*y(k,68) - mat(k,131) = (rxt(k,532)+rxt(k,536))*y(k,104) - mat(k,1720) = rxt(k,112)*y(k,65) - mat(k,1486) = rxt(k,125)*y(k,68) - mat(k,1114) = rxt(k,119)*y(k,65) - mat(k,1762) = rxt(k,275)*y(k,65) + (rxt(k,117)+rxt(k,118))*y(k,67) - mat(k,1159) = rxt(k,276)*y(k,65) + (rxt(k,115)+rxt(k,116))*y(k,67) - mat(k,989) = rxt(k,120)*y(k,65) - mat(k,1280) = rxt(k,121)*y(k,65) - mat(k,1441) = rxt(k,127)*y(k,68) - mat(k,1684) = (rxt(k,109)+rxt(k,110))*y(k,65) + rxt(k,122)*y(k,68) - mat(k,799) = rxt(k,111)*y(k,24) + rxt(k,112)*y(k,32) + rxt(k,119)*y(k,42) & - + rxt(k,275)*y(k,51) + rxt(k,276)*y(k,52) + rxt(k,120)*y(k,54) & - + rxt(k,121)*y(k,55) + (rxt(k,109)+rxt(k,110))*y(k,60) & - + rxt(k,181)*y(k,73) + (rxt(k,165)+rxt(k,253))*y(k,75) + ( & - + rxt(k,163)+rxt(k,260))*y(k,77) + rxt(k,234)*y(k,88) & - + rxt(k,216)*y(k,89) + rxt(k,199)*y(k,92) + rxt(k,251)*y(k,99) - mat(k,321) = rxt(k,189)*y(k,73) + (rxt(k,242)+rxt(k,266))*y(k,75) + ( & - + rxt(k,171)+rxt(k,254))*y(k,77) + rxt(k,241)*y(k,88) & - + rxt(k,224)*y(k,89) + rxt(k,206)*y(k,92) + rxt(k,148)*y(k,99) - mat(k,511) = (rxt(k,117)+rxt(k,118))*y(k,51) + (rxt(k,115)+rxt(k,116)) & - *y(k,52) + rxt(k,191)*y(k,73) + (rxt(k,153)+rxt(k,255))*y(k,75) + ( & - + rxt(k,173)+rxt(k,256))*y(k,77) + rxt(k,244)*y(k,88) & - + rxt(k,226)*y(k,89) + rxt(k,208)*y(k,92) + rxt(k,150)*y(k,99) - mat(k,637) = rxt(k,123)*y(k,24) + rxt(k,125)*y(k,40) + rxt(k,127)*y(k,56) & - + rxt(k,122)*y(k,60) + rxt(k,186)*y(k,73) + rxt(k,220)*y(k,75) & - + rxt(k,169)*y(k,77) + rxt(k,239)*y(k,88) + rxt(k,222)*y(k,89) & - + rxt(k,204)*y(k,92) + rxt(k,146)*y(k,99) - mat(k,1032) = rxt(k,301)*y(k,91) - mat(k,306) = rxt(k,184)*y(k,73) + rxt(k,198)*y(k,75) + rxt(k,167)*y(k,77) & - + rxt(k,237)*y(k,88) + rxt(k,219)*y(k,89) + rxt(k,202)*y(k,92) & - + rxt(k,144)*y(k,99) - mat(k,842) = rxt(k,181)*y(k,65) + rxt(k,189)*y(k,66) + rxt(k,191)*y(k,67) & - + rxt(k,186)*y(k,68) + rxt(k,184)*y(k,71) - mat(k,1202) = (rxt(k,165)+rxt(k,253))*y(k,65) + (rxt(k,242)+rxt(k,266)) & - *y(k,66) + (rxt(k,153)+rxt(k,255))*y(k,67) + rxt(k,220)*y(k,68) & - + rxt(k,198)*y(k,71) - mat(k,1572) = (rxt(k,163)+rxt(k,260))*y(k,65) + (rxt(k,171)+rxt(k,254)) & - *y(k,66) + (rxt(k,173)+rxt(k,256))*y(k,67) + rxt(k,169)*y(k,68) & - + rxt(k,167)*y(k,71) - mat(k,890) = mat(k,890) + rxt(k,234)*y(k,65) + rxt(k,241)*y(k,66) & - + rxt(k,244)*y(k,67) + rxt(k,239)*y(k,68) + rxt(k,237)*y(k,71) - mat(k,933) = rxt(k,216)*y(k,65) + rxt(k,224)*y(k,66) + rxt(k,226)*y(k,67) & - + rxt(k,222)*y(k,68) + rxt(k,219)*y(k,71) - mat(k,120) = rxt(k,301)*y(k,69) + rxt(k,302)*y(k,110) - mat(k,1074) = rxt(k,199)*y(k,65) + rxt(k,206)*y(k,66) + rxt(k,208)*y(k,67) & - + rxt(k,204)*y(k,68) + rxt(k,202)*y(k,71) - mat(k,1361) = rxt(k,251)*y(k,65) + rxt(k,148)*y(k,66) + rxt(k,150)*y(k,67) & - + rxt(k,146)*y(k,68) + rxt(k,144)*y(k,71) - mat(k,767) = (rxt(k,532)+rxt(k,536))*y(k,27) - mat(k,1815) = rxt(k,302)*y(k,91) - mat(k,168) = -(rxt(k,503)*y(k,33) + rxt(k,504)*y(k,110) + rxt(k,505)*y(k,42)) - mat(k,417) = -rxt(k,503)*y(k,31) - mat(k,1784) = -rxt(k,504)*y(k,31) - mat(k,1087) = -rxt(k,505)*y(k,31) - mat(k,5) = 2.000_r8*rxt(k,506)*y(k,95) - mat(k,13) = rxt(k,507)*y(k,95) - mat(k,564) = 2.000_r8*rxt(k,506)*y(k,29) + rxt(k,507)*y(k,30) - mat(k,1728) = -(rxt(k,100)*y(k,61) + rxt(k,112)*y(k,65) + rxt(k,124)*y(k,68) & - + rxt(k,282)*y(k,81) + rxt(k,304)*y(k,92) + rxt(k,312)*y(k,98) & - + rxt(k,326)*y(k,101) + rxt(k,339)*y(k,105) + (rxt(k,403) & - + rxt(k,404) + rxt(k,405)) * y(k,43) + rxt(k,406)*y(k,55) & - + rxt(k,409)*y(k,56)) - mat(k,613) = -rxt(k,100)*y(k,32) - mat(k,807) = -rxt(k,112)*y(k,32) - mat(k,645) = -rxt(k,124)*y(k,32) - mat(k,732) = -rxt(k,282)*y(k,32) - mat(k,1082) = -rxt(k,304)*y(k,32) - mat(k,1324) = -rxt(k,312)*y(k,32) - mat(k,414) = -rxt(k,326)*y(k,32) - mat(k,1613) = -rxt(k,339)*y(k,32) - mat(k,705) = -(rxt(k,403) + rxt(k,404) + rxt(k,405)) * y(k,32) - mat(k,1288) = -rxt(k,406)*y(k,32) - mat(k,1449) = -rxt(k,409)*y(k,32) - mat(k,558) = rxt(k,527)*y(k,104) - mat(k,132) = rxt(k,536)*y(k,104) - mat(k,174) = rxt(k,503)*y(k,33) - mat(k,435) = rxt(k,503)*y(k,31) + rxt(k,401)*y(k,54) + rxt(k,447)*y(k,60) & - + rxt(k,384)*y(k,95) + rxt(k,410)*y(k,104) + rxt(k,349)*y(k,106) - mat(k,197) = rxt(k,501)*y(k,95) - mat(k,1494) = rxt(k,478)*y(k,95) - mat(k,281) = rxt(k,433)*y(k,104) - mat(k,997) = rxt(k,401)*y(k,33) + rxt(k,413)*y(k,104) - mat(k,1692) = rxt(k,447)*y(k,33) - mat(k,613) = mat(k,613) + rxt(k,190)*y(k,73) + rxt(k,142)*y(k,75) & - + rxt(k,172)*y(k,77) - mat(k,368) = rxt(k,194)*y(k,73) + rxt(k,159)*y(k,75) + rxt(k,177)*y(k,77) - mat(k,352) = rxt(k,182)*y(k,73) + rxt(k,176)*y(k,75) + rxt(k,164)*y(k,77) - mat(k,807) = mat(k,807) + rxt(k,181)*y(k,73) + (rxt(k,165)+rxt(k,253)) & - *y(k,75) + (rxt(k,163)+rxt(k,260))*y(k,77) - mat(k,323) = rxt(k,189)*y(k,73) + (rxt(k,242)+rxt(k,266))*y(k,75) + ( & - + rxt(k,171)+rxt(k,254))*y(k,77) - mat(k,513) = rxt(k,191)*y(k,73) + (rxt(k,153)+rxt(k,255))*y(k,75) + ( & - + rxt(k,173)+rxt(k,256))*y(k,77) - mat(k,645) = mat(k,645) + rxt(k,186)*y(k,73) + rxt(k,220)*y(k,75) & - + rxt(k,169)*y(k,77) - mat(k,1040) = rxt(k,133)*y(k,70) + rxt(k,377)*y(k,72) + rxt(k,378)*y(k,73) & - + rxt(k,136)*y(k,75) + rxt(k,139)*y(k,77) + rxt(k,376)*y(k,78) - mat(k,37) = rxt(k,133)*y(k,69) - mat(k,308) = rxt(k,184)*y(k,73) + rxt(k,198)*y(k,75) + rxt(k,167)*y(k,77) - mat(k,106) = rxt(k,377)*y(k,69) - mat(k,850) = rxt(k,190)*y(k,61) + rxt(k,194)*y(k,62) + rxt(k,182)*y(k,63) & - + rxt(k,181)*y(k,65) + rxt(k,189)*y(k,66) + rxt(k,191)*y(k,67) & - + rxt(k,186)*y(k,68) + rxt(k,378)*y(k,69) + rxt(k,184)*y(k,71) & - + rxt(k,196)*y(k,81) + rxt(k,192)*y(k,82) + rxt(k,195)*y(k,84) & - + rxt(k,188)*y(k,85) + rxt(k,193)*y(k,86) + rxt(k,185)*y(k,98) - mat(k,1210) = rxt(k,142)*y(k,61) + rxt(k,159)*y(k,62) + rxt(k,176)*y(k,63) + ( & - + rxt(k,165)+rxt(k,253))*y(k,65) + (rxt(k,242)+rxt(k,266)) & - *y(k,66) + (rxt(k,153)+rxt(k,255))*y(k,67) + rxt(k,220)*y(k,68) & - + rxt(k,136)*y(k,69) + rxt(k,198)*y(k,71) + rxt(k,161)*y(k,81) & - + rxt(k,157)*y(k,82) + rxt(k,160)*y(k,84) + (rxt(k,231) & - +rxt(k,257))*y(k,85) + rxt(k,158)*y(k,86) + rxt(k,209)*y(k,98) - mat(k,1580) = rxt(k,172)*y(k,61) + rxt(k,177)*y(k,62) + rxt(k,164)*y(k,63) + ( & - + rxt(k,163)+rxt(k,260))*y(k,65) + (rxt(k,171)+rxt(k,254)) & - *y(k,66) + (rxt(k,173)+rxt(k,256))*y(k,67) + rxt(k,169)*y(k,68) & - + rxt(k,139)*y(k,69) + rxt(k,167)*y(k,71) + rxt(k,179)*y(k,81) & - + rxt(k,174)*y(k,82) + rxt(k,178)*y(k,84) + (rxt(k,170) & - +rxt(k,258))*y(k,85) + rxt(k,175)*y(k,86) + rxt(k,168)*y(k,98) - mat(k,137) = rxt(k,376)*y(k,69) - mat(k,732) = mat(k,732) + rxt(k,196)*y(k,73) + rxt(k,161)*y(k,75) & - + rxt(k,179)*y(k,77) - mat(k,382) = rxt(k,192)*y(k,73) + rxt(k,157)*y(k,75) + rxt(k,174)*y(k,77) - mat(k,492) = rxt(k,195)*y(k,73) + rxt(k,160)*y(k,75) + rxt(k,178)*y(k,77) - mat(k,533) = rxt(k,188)*y(k,73) + (rxt(k,231)+rxt(k,257))*y(k,75) + ( & - + rxt(k,170)+rxt(k,258))*y(k,77) - mat(k,398) = rxt(k,193)*y(k,73) + rxt(k,158)*y(k,75) + rxt(k,175)*y(k,77) - mat(k,592) = rxt(k,384)*y(k,33) + rxt(k,501)*y(k,36) + rxt(k,478)*y(k,40) - mat(k,1324) = mat(k,1324) + rxt(k,185)*y(k,73) + rxt(k,209)*y(k,75) & - + rxt(k,168)*y(k,77) - mat(k,774) = rxt(k,527)*y(k,14) + rxt(k,536)*y(k,27) + rxt(k,410)*y(k,33) & - + rxt(k,433)*y(k,48) + rxt(k,413)*y(k,54) - mat(k,1649) = rxt(k,349)*y(k,33) - end do + mat(320) = -(rxt(481)*y(15) + rxt(482)*y(71) + rxt(483)*y(57)) + mat(526) = -rxt(481)*y(1) + mat(665) = -rxt(482)*y(1) + mat(1586) = -rxt(483)*y(1) + mat(410) = 4.000_r8*rxt(484)*y(3) + (rxt(485)+rxt(486))*y(26) + rxt(489) & + *y(52) + rxt(492)*y(55) + rxt(493)*y(104) + mat(1096) = (rxt(485)+rxt(486))*y(3) + mat(180) = rxt(494)*y(55) + rxt(500)*y(95) + rxt(495)*y(104) + mat(1298) = rxt(489)*y(3) + mat(1480) = rxt(492)*y(3) + rxt(494)*y(38) + mat(556) = rxt(500)*y(38) + mat(705) = rxt(493)*y(3) + rxt(495)*y(38) + mat(407) = rxt(487)*y(26) + mat(1091) = rxt(487)*y(3) + mat(883) = (rxt(549)+rxt(554))*y(46) + mat(163) = (rxt(549)+rxt(554))*y(42) + mat(411) = -(4._r8*rxt(484)*y(3) + (rxt(485) + rxt(486) + rxt(487)) * y(26) & + + rxt(488)*y(71) + rxt(489)*y(52) + rxt(490)*y(53) + rxt(492) & + *y(55) + rxt(493)*y(104)) + mat(1097) = -(rxt(485) + rxt(486) + rxt(487)) * y(3) + mat(666) = -rxt(488)*y(3) + mat(1301) = -rxt(489)*y(3) + mat(1052) = -rxt(490)*y(3) + mat(1482) = -rxt(492)*y(3) + mat(706) = -rxt(493)*y(3) + mat(321) = rxt(483)*y(57) + mat(93) = rxt(491)*y(55) + mat(181) = rxt(501)*y(95) + mat(166) = rxt(496)*y(55) + mat(1482) = mat(1482) + rxt(491)*y(4) + rxt(496)*y(46) + mat(1588) = rxt(483)*y(1) + mat(557) = rxt(501)*y(38) + mat(90) = -(rxt(491)*y(55)) + mat(1465) = -rxt(491)*y(4) + mat(408) = rxt(490)*y(53) + mat(1045) = rxt(490)*y(3) + mat(529) = -(rxt(445)*y(23) + rxt(481)*y(1) + rxt(525)*y(54) + rxt(526)*y(55) & + + rxt(527)*y(104)) + mat(1183) = -rxt(445)*y(15) + mat(322) = -rxt(481)*y(15) + mat(1665) = -rxt(525)*y(15) + mat(1484) = -rxt(526)*y(15) + mat(708) = -rxt(527)*y(15) + mat(267) = rxt(452)*y(26) + rxt(529)*y(52) + mat(35) = .300_r8*rxt(530)*y(104) + mat(1098) = rxt(452)*y(19) + mat(1304) = rxt(529)*y(19) + mat(708) = mat(708) + .300_r8*rxt(530)*y(20) + mat(266) = -(rxt(452)*y(26) + rxt(528)*y(71) + rxt(529)*y(52)) + mat(1095) = -rxt(452)*y(19) + mat(664) = -rxt(528)*y(19) + mat(1297) = -rxt(529)*y(19) + mat(34) = .700_r8*rxt(530)*y(104) + mat(704) = .700_r8*rxt(530)*y(20) + mat(33) = -(rxt(530)*y(104)) + mat(693) = -rxt(530)*y(20) + mat(265) = rxt(528)*y(71) + mat(657) = rxt(528)*y(19) + mat(1201) = -((rxt(109) + rxt(110)) * y(64) + rxt(122)*y(67) + rxt(280)*y(81) & + + rxt(309)*y(98) + rxt(336)*y(105) + rxt(345)*y(106) + rxt(445) & + *y(15) + rxt(447)*y(35) + rxt(448)*y(37) + (rxt(449) + rxt(450) & + ) * y(71) + rxt(451)*y(57) + rxt(458)*y(27) + rxt(467)*y(47)) + mat(750) = -(rxt(109) + rxt(110)) * y(23) + mat(599) = -rxt(122)*y(23) + mat(779) = -rxt(280)*y(23) + mat(1236) = -rxt(309)*y(23) + mat(1534) = -rxt(336)*y(23) + mat(1569) = -rxt(345)*y(23) + mat(538) = -rxt(445)*y(23) + mat(441) = -rxt(447)*y(23) + mat(115) = -rxt(448)*y(23) + mat(679) = -(rxt(449) + rxt(450)) * y(23) + mat(1607) = -rxt(451)*y(23) + mat(224) = -rxt(458)*y(23) + mat(192) = -rxt(467)*y(23) + mat(421) = rxt(486)*y(26) + mat(274) = rxt(452)*y(26) + mat(1116) = rxt(486)*y(3) + rxt(452)*y(19) + (4.000_r8*rxt(453) & + +2.000_r8*rxt(455))*y(26) + rxt(457)*y(52) + rxt(462)*y(55) & + + rxt(463)*y(104) + mat(15) = rxt(507)*y(95) + mat(912) = rxt(465)*y(55) + rxt(477)*y(95) + rxt(466)*y(104) + mat(1321) = rxt(457)*y(26) + rxt(106)*y(63) + mat(1074) = rxt(105)*y(60) + mat(1502) = rxt(462)*y(26) + rxt(465)*y(42) + mat(624) = rxt(105)*y(53) + rxt(190)*y(73) + rxt(142)*y(75) + rxt(172)*y(77) & + + rxt(243)*y(88) + rxt(225)*y(89) + rxt(207)*y(92) + rxt(149) & + *y(99) + mat(356) = rxt(194)*y(73) + rxt(159)*y(75) + rxt(177)*y(77) + rxt(247)*y(88) & + + rxt(229)*y(89) + rxt(212)*y(92) + rxt(154)*y(99) + mat(340) = rxt(182)*y(73) + rxt(176)*y(75) + rxt(164)*y(77) + rxt(235)*y(88) & + + rxt(217)*y(89) + rxt(200)*y(92) + rxt(252)*y(99) + mat(234) = rxt(106)*y(52) + mat(1030) = rxt(190)*y(60) + rxt(194)*y(61) + rxt(182)*y(62) + mat(1363) = rxt(142)*y(60) + rxt(159)*y(61) + rxt(176)*y(62) + mat(1447) = rxt(172)*y(60) + rxt(177)*y(61) + rxt(164)*y(62) + mat(826) = rxt(243)*y(60) + rxt(247)*y(61) + rxt(235)*y(62) + mat(868) = rxt(225)*y(60) + rxt(229)*y(61) + rxt(217)*y(62) + mat(988) = rxt(207)*y(60) + rxt(212)*y(61) + rxt(200)*y(62) + mat(569) = rxt(507)*y(32) + rxt(477)*y(42) + mat(1280) = rxt(149)*y(60) + rxt(154)*y(61) + rxt(252)*y(62) + mat(720) = rxt(463)*y(26) + rxt(466)*y(42) + mat(1173) = rxt(458)*y(27) + mat(1090) = 2.000_r8*rxt(454)*y(26) + mat(217) = rxt(458)*y(23) + (rxt(547)+rxt(552)+rxt(557))*y(42) + mat(882) = (rxt(547)+rxt(552)+rxt(557))*y(27) + (rxt(542)+rxt(548)+rxt(553)) & + *y(47) + mat(187) = (rxt(542)+rxt(548)+rxt(553))*y(42) + mat(1088) = 2.000_r8*rxt(479)*y(26) + mat(1114) = -(rxt(111)*y(64) + rxt(123)*y(67) + rxt(281)*y(81) + rxt(310) & + *y(98) + rxt(337)*y(105) + rxt(346)*y(106) + rxt(452)*y(19) & + + (4._r8*rxt(453) + 4._r8*rxt(454) + 4._r8*rxt(455) & + + 4._r8*rxt(479)) * y(26) + rxt(456)*y(71) + rxt(457)*y(52) & + + rxt(459)*y(53) + rxt(462)*y(55) + (rxt(463) + rxt(464) & + ) * y(104) + (rxt(485) + rxt(486) + rxt(487)) * y(3)) + mat(748) = -rxt(111)*y(26) + mat(597) = -rxt(123)*y(26) + mat(777) = -rxt(281)*y(26) + mat(1234) = -rxt(310)*y(26) + mat(1532) = -rxt(337)*y(26) + mat(1567) = -rxt(346)*y(26) + mat(272) = -rxt(452)*y(26) + mat(677) = -rxt(456)*y(26) + mat(1319) = -rxt(457)*y(26) + mat(1072) = -rxt(459)*y(26) + mat(1500) = -rxt(462)*y(26) + mat(718) = -(rxt(463) + rxt(464)) * y(26) + mat(419) = -(rxt(485) + rxt(486) + rxt(487)) * y(26) + mat(1199) = rxt(467)*y(47) + rxt(451)*y(57) + rxt(450)*y(71) + mat(223) = rxt(460)*y(55) + mat(910) = rxt(478)*y(95) + mat(191) = rxt(467)*y(23) + rxt(468)*y(55) + rxt(469)*y(104) + mat(1500) = mat(1500) + rxt(460)*y(27) + rxt(468)*y(47) + mat(1605) = rxt(451)*y(23) + mat(677) = mat(677) + rxt(450)*y(23) + mat(567) = rxt(478)*y(42) + mat(718) = mat(718) + rxt(469)*y(47) + mat(219) = -(rxt(458)*y(23) + rxt(460)*y(55) + rxt(461)*y(104) + (rxt(547) & + + rxt(552) + rxt(557)) * y(42)) + mat(1177) = -rxt(458)*y(27) + mat(1476) = -rxt(460)*y(27) + mat(702) = -rxt(461)*y(27) + mat(887) = -(rxt(547) + rxt(552) + rxt(557)) * y(27) + mat(1093) = rxt(459)*y(53) + mat(1047) = rxt(459)*y(26) + mat(98) = -((rxt(532) + rxt(536)) * y(104)) + mat(695) = -(rxt(532) + rxt(536)) * y(29) + mat(318) = rxt(481)*y(15) + mat(524) = rxt(481)*y(1) + rxt(445)*y(23) + rxt(525)*y(54) + rxt(526)*y(55) & + + rxt(527)*y(104) + mat(1174) = rxt(445)*y(15) + mat(1660) = rxt(525)*y(15) + mat(1466) = rxt(526)*y(15) + mat(695) = mat(695) + rxt(527)*y(15) + mat(4) = -(rxt(506)*y(95)) + mat(548) = -rxt(506)*y(31) + mat(12) = -(rxt(507)*y(95)) + mat(549) = -rxt(507)*y(32) + mat(155) = -(rxt(503)*y(35) + rxt(504)*y(110) + rxt(505)*y(44)) + mat(429) = -rxt(503)*y(33) + mat(1705) = -rxt(504)*y(33) + mat(1623) = -rxt(505)*y(33) + mat(5) = 2.000_r8*rxt(506)*y(95) + mat(13) = rxt(507)*y(95) + mat(551) = 2.000_r8*rxt(506)*y(31) + rxt(507)*y(32) + mat(941) = -(rxt(100)*y(60) + rxt(112)*y(64) + rxt(124)*y(67) + rxt(282) & + *y(81) + rxt(304)*y(92) + rxt(312)*y(98) + rxt(326)*y(101) & + + rxt(339)*y(105) + (rxt(403) + rxt(404) + rxt(405)) * y(71) & + + rxt(406)*y(56) + rxt(409)*y(57)) + mat(619) = -rxt(100)*y(34) + mat(744) = -rxt(112)*y(34) + mat(593) = -rxt(124)*y(34) + mat(773) = -rxt(282)*y(34) + mat(982) = -rxt(304)*y(34) + mat(1230) = -rxt(312)*y(34) + mat(380) = -rxt(326)*y(34) + mat(1528) = -rxt(339)*y(34) + mat(673) = -(rxt(403) + rxt(404) + rxt(405)) * y(34) + mat(1153) = -rxt(406)*y(34) + mat(1601) = -rxt(409)*y(34) + mat(534) = rxt(527)*y(104) + mat(1195) = rxt(447)*y(35) + mat(101) = rxt(536)*y(104) + mat(159) = rxt(503)*y(35) + mat(437) = rxt(447)*y(23) + rxt(503)*y(33) + rxt(401)*y(55) + rxt(384)*y(95) & + + rxt(410)*y(104) + rxt(349)*y(106) + mat(184) = rxt(501)*y(95) + mat(906) = rxt(478)*y(95) + mat(258) = rxt(433)*y(104) + mat(1496) = rxt(401)*y(35) + rxt(413)*y(104) + mat(619) = mat(619) + rxt(190)*y(73) + rxt(142)*y(75) + rxt(172)*y(77) + mat(352) = rxt(194)*y(73) + rxt(159)*y(75) + rxt(177)*y(77) + mat(336) = rxt(182)*y(73) + rxt(176)*y(75) + rxt(164)*y(77) + mat(744) = mat(744) + rxt(181)*y(73) + (rxt(165)+rxt(253))*y(75) + (rxt(163) & + +rxt(260))*y(77) + mat(308) = rxt(189)*y(73) + (rxt(242)+rxt(266))*y(75) + (rxt(171)+rxt(254)) & + *y(77) + mat(493) = rxt(191)*y(73) + (rxt(153)+rxt(255))*y(75) + (rxt(173)+rxt(256)) & + *y(77) + mat(593) = mat(593) + rxt(186)*y(73) + rxt(220)*y(75) + rxt(169)*y(77) + mat(1399) = rxt(133)*y(69) + rxt(377)*y(72) + rxt(378)*y(73) + rxt(136)*y(75) & + + rxt(139)*y(77) + rxt(376)*y(78) + mat(42) = rxt(133)*y(68) + mat(281) = rxt(184)*y(73) + rxt(198)*y(75) + rxt(167)*y(77) + mat(120) = rxt(377)*y(68) + mat(1024) = rxt(190)*y(60) + rxt(194)*y(61) + rxt(182)*y(62) + rxt(181)*y(64) & + + rxt(189)*y(65) + rxt(191)*y(66) + rxt(186)*y(67) + rxt(378) & + *y(68) + rxt(184)*y(70) + rxt(196)*y(81) + rxt(192)*y(82) & + + rxt(195)*y(84) + rxt(188)*y(85) + rxt(193)*y(86) + rxt(185) & + *y(98) + mat(1357) = rxt(142)*y(60) + rxt(159)*y(61) + rxt(176)*y(62) + (rxt(165) & + +rxt(253))*y(64) + (rxt(242)+rxt(266))*y(65) + (rxt(153) & + +rxt(255))*y(66) + rxt(220)*y(67) + rxt(136)*y(68) + rxt(198) & + *y(70) + rxt(161)*y(81) + rxt(157)*y(82) + rxt(160)*y(84) + ( & + + rxt(231)+rxt(257))*y(85) + rxt(158)*y(86) + rxt(209)*y(98) + mat(1441) = rxt(172)*y(60) + rxt(177)*y(61) + rxt(164)*y(62) + (rxt(163) & + +rxt(260))*y(64) + (rxt(171)+rxt(254))*y(65) + (rxt(173) & + +rxt(256))*y(66) + rxt(169)*y(67) + rxt(139)*y(68) + rxt(167) & + *y(70) + rxt(179)*y(81) + rxt(174)*y(82) + rxt(178)*y(84) + ( & + + rxt(170)+rxt(258))*y(85) + rxt(175)*y(86) + rxt(168)*y(98) + mat(131) = rxt(376)*y(68) + mat(773) = mat(773) + rxt(196)*y(73) + rxt(161)*y(75) + rxt(179)*y(77) + mat(366) = rxt(192)*y(73) + rxt(157)*y(75) + rxt(174)*y(77) + mat(471) = rxt(195)*y(73) + rxt(160)*y(75) + rxt(178)*y(77) + mat(511) = rxt(188)*y(73) + (rxt(231)+rxt(257))*y(75) + (rxt(170)+rxt(258)) & + *y(77) + mat(395) = rxt(193)*y(73) + rxt(158)*y(75) + rxt(175)*y(77) + mat(564) = rxt(384)*y(35) + rxt(501)*y(38) + rxt(478)*y(42) + mat(1230) = mat(1230) + rxt(185)*y(73) + rxt(209)*y(75) + rxt(168)*y(77) + mat(714) = rxt(527)*y(15) + rxt(536)*y(29) + rxt(410)*y(35) + rxt(433)*y(49) & + + rxt(413)*y(55) + mat(1563) = rxt(349)*y(35) end subroutine nlnmat01 - subroutine nlnmat02( avec_len, mat, y, rxt ) + subroutine nlnmat02( 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) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) !---------------------------------------------- ! ... local variables !---------------------------------------------- - integer :: k !---------------------------------------------- ! ... complete matrix entries implicit species !---------------------------------------------- - do k = 1,avec_len - mat(k,419) = -((rxt(k,348) + rxt(k,349)) * y(k,106) + rxt(k,384)*y(k,95) & - + rxt(k,401)*y(k,54) + rxt(k,410)*y(k,104) + rxt(k,447)*y(k,60) & - + rxt(k,503)*y(k,31)) - mat(k,1619) = -(rxt(k,348) + rxt(k,349)) * y(k,33) - mat(k,570) = -rxt(k,384)*y(k,33) - mat(k,965) = -rxt(k,401)*y(k,33) - mat(k,750) = -rxt(k,410)*y(k,33) - mat(k,1660) = -rxt(k,447)*y(k,33) - mat(k,170) = -rxt(k,503)*y(k,33) - mat(k,1697) = rxt(k,403)*y(k,43) - mat(k,682) = rxt(k,403)*y(k,32) - mat(k,79) = -(rxt(k,402)*y(k,54) + rxt(k,411)*y(k,104) + rxt(k,448)*y(k,60)) - mat(k,948) = -rxt(k,402)*y(k,35) - mat(k,739) = -rxt(k,411)*y(k,35) - mat(k,1653) = -rxt(k,448)*y(k,35) - mat(k,675) = 2.000_r8*rxt(k,417)*y(k,43) - mat(k,739) = mat(k,739) + 2.000_r8*rxt(k,416)*y(k,104) - mat(k,191) = -(rxt(k,494)*y(k,54) + rxt(k,495)*y(k,104) + (rxt(k,500) & - + rxt(k,501)) * y(k,95)) - mat(k,956) = -rxt(k,494)*y(k,36) - mat(k,745) = -rxt(k,495)*y(k,36) - mat(k,565) = -(rxt(k,500) + rxt(k,501)) * y(k,36) - mat(k,537) = rxt(k,481)*y(k,59) - mat(k,679) = rxt(k,482)*y(k,59) - mat(k,327) = rxt(k,481)*y(k,14) + rxt(k,482)*y(k,43) - mat(k,1488) = -(rxt(k,101)*y(k,62) + rxt(k,103)*y(k,61) + rxt(k,125)*y(k,68) & - + (rxt(k,271) + rxt(k,293)) * y(k,83) + rxt(k,284)*y(k,81) & - + rxt(k,313)*y(k,98) + rxt(k,340)*y(k,105) + rxt(k,351)*y(k,106) & - + rxt(k,465)*y(k,54) + rxt(k,466)*y(k,104) + (rxt(k,477) & - + rxt(k,478)) * y(k,95) + (rxt(k,542) + rxt(k,548) + rxt(k,553) & - ) * y(k,46) + (rxt(k,547) + rxt(k,552) + rxt(k,557)) * y(k,25) & - + (rxt(k,549) + rxt(k,554)) * y(k,45)) - mat(k,365) = -rxt(k,101)*y(k,40) - mat(k,610) = -rxt(k,103)*y(k,40) - mat(k,639) = -rxt(k,125)*y(k,40) - mat(k,667) = -(rxt(k,271) + rxt(k,293)) * y(k,40) - mat(k,727) = -rxt(k,284)*y(k,40) - mat(k,1318) = -rxt(k,313)*y(k,40) - mat(k,1607) = -rxt(k,340)*y(k,40) - mat(k,1643) = -rxt(k,351)*y(k,40) - mat(k,991) = -rxt(k,465)*y(k,40) - mat(k,769) = -rxt(k,466)*y(k,40) - mat(k,587) = -(rxt(k,477) + rxt(k,478)) * y(k,40) - mat(k,187) = -(rxt(k,542) + rxt(k,548) + rxt(k,553)) * y(k,40) - mat(k,207) = -(rxt(k,547) + rxt(k,552) + rxt(k,557)) * y(k,40) - mat(k,156) = -(rxt(k,549) + rxt(k,554)) * y(k,40) - mat(k,553) = rxt(k,445)*y(k,60) - mat(k,1531) = rxt(k,464)*y(k,104) - mat(k,1722) = rxt(k,100)*y(k,61) - mat(k,430) = rxt(k,447)*y(k,60) - mat(k,83) = rxt(k,448)*y(k,60) - mat(k,1116) = rxt(k,104)*y(k,61) + rxt(k,294)*y(k,86) - mat(k,700) = rxt(k,449)*y(k,60) - mat(k,187) = mat(k,187) + rxt(k,467)*y(k,60) - mat(k,1686) = rxt(k,445)*y(k,14) + rxt(k,447)*y(k,33) + rxt(k,448)*y(k,35) & - + rxt(k,449)*y(k,43) + rxt(k,467)*y(k,46) - mat(k,610) = mat(k,610) + rxt(k,100)*y(k,32) + rxt(k,104)*y(k,42) - mat(k,349) = rxt(k,182)*y(k,73) + (rxt(k,176)+2.000_r8*rxt(k,262))*y(k,75) + ( & - + rxt(k,164)+2.000_r8*rxt(k,263))*y(k,77) + rxt(k,235)*y(k,88) & - + rxt(k,217)*y(k,89) + rxt(k,200)*y(k,92) + rxt(k,252)*y(k,99) - mat(k,844) = rxt(k,182)*y(k,63) + rxt(k,193)*y(k,86) - mat(k,1204) = (rxt(k,176)+2.000_r8*rxt(k,262))*y(k,63) + rxt(k,158)*y(k,86) - mat(k,1574) = (rxt(k,164)+2.000_r8*rxt(k,263))*y(k,63) + rxt(k,175)*y(k,86) - mat(k,396) = rxt(k,294)*y(k,42) + rxt(k,193)*y(k,73) + rxt(k,158)*y(k,75) & - + rxt(k,175)*y(k,77) + rxt(k,246)*y(k,88) + rxt(k,228)*y(k,89) & - + rxt(k,211)*y(k,92) + rxt(k,152)*y(k,99) - mat(k,892) = rxt(k,235)*y(k,63) + rxt(k,246)*y(k,86) - mat(k,935) = rxt(k,217)*y(k,63) + rxt(k,228)*y(k,86) - mat(k,1076) = rxt(k,200)*y(k,63) + rxt(k,211)*y(k,86) - mat(k,1363) = rxt(k,252)*y(k,63) + rxt(k,152)*y(k,86) - mat(k,769) = mat(k,769) + rxt(k,464)*y(k,24) - mat(k,167) = rxt(k,503)*y(k,33) + rxt(k,505)*y(k,42) + rxt(k,504)*y(k,110) - mat(k,416) = rxt(k,503)*y(k,31) - mat(k,1085) = rxt(k,505)*y(k,31) - mat(k,1773) = rxt(k,504)*y(k,31) - mat(k,1107) = -(rxt(k,104)*y(k,61) + rxt(k,119)*y(k,65) + rxt(k,285)*y(k,81) & - + rxt(k,290)*y(k,85) + rxt(k,294)*y(k,86) + rxt(k,295)*y(k,83) & - + rxt(k,314)*y(k,98) + rxt(k,352)*y(k,106) + rxt(k,442)*y(k,104) & - + rxt(k,505)*y(k,31)) - mat(k,605) = -rxt(k,104)*y(k,42) - mat(k,792) = -rxt(k,119)*y(k,42) - mat(k,720) = -rxt(k,285)*y(k,42) - mat(k,526) = -rxt(k,290)*y(k,42) - mat(k,391) = -rxt(k,294)*y(k,42) - mat(k,660) = -rxt(k,295)*y(k,42) - mat(k,1309) = -rxt(k,314)*y(k,42) - mat(k,1634) = -rxt(k,352)*y(k,42) - mat(k,761) = -rxt(k,442)*y(k,42) - mat(k,172) = -rxt(k,505)*y(k,42) - mat(k,547) = rxt(k,525)*y(k,53) - mat(k,204) = (rxt(k,547)+rxt(k,552)+rxt(k,557))*y(k,40) - mat(k,1479) = (rxt(k,547)+rxt(k,552)+rxt(k,557))*y(k,25) + rxt(k,293)*y(k,83) - mat(k,234) = rxt(k,137)*y(k,75) + rxt(k,140)*y(k,77) + rxt(k,288)*y(k,84) & - + rxt(k,292)*y(k,85) - mat(k,1152) = rxt(k,441)*y(k,104) - mat(k,1230) = rxt(k,525)*y(k,14) - mat(k,835) = rxt(k,183)*y(k,83) + 2.000_r8*rxt(k,180)*y(k,87) - mat(k,23) = rxt(k,135)*y(k,110) - mat(k,1195) = rxt(k,137)*y(k,50) + (rxt(k,187)+rxt(k,259))*y(k,83) + ( & - + 2.000_r8*rxt(k,141)+2.000_r8*rxt(k,264))*y(k,87) - mat(k,27) = rxt(k,138)*y(k,110) - mat(k,1565) = rxt(k,140)*y(k,50) + (rxt(k,166)+rxt(k,261))*y(k,83) + ( & - + 2.000_r8*rxt(k,162)+2.000_r8*rxt(k,265))*y(k,87) - mat(k,660) = mat(k,660) + rxt(k,293)*y(k,40) + rxt(k,183)*y(k,73) + ( & - + rxt(k,187)+rxt(k,259))*y(k,75) + (rxt(k,166)+rxt(k,261)) & - *y(k,77) - mat(k,485) = rxt(k,288)*y(k,50) - mat(k,526) = mat(k,526) + rxt(k,292)*y(k,50) - mat(k,444) = 2.000_r8*rxt(k,180)*y(k,73) + (2.000_r8*rxt(k,141) & - +2.000_r8*rxt(k,264))*y(k,75) + (2.000_r8*rxt(k,162) & - +2.000_r8*rxt(k,265))*y(k,77) + rxt(k,233)*y(k,88) + rxt(k,215) & - *y(k,89) + rxt(k,197)*y(k,92) + rxt(k,250)*y(k,99) - mat(k,883) = rxt(k,233)*y(k,87) - mat(k,926) = rxt(k,215)*y(k,87) - mat(k,1067) = rxt(k,197)*y(k,87) - mat(k,1354) = rxt(k,250)*y(k,87) - mat(k,761) = mat(k,761) + rxt(k,441)*y(k,52) - mat(k,1808) = rxt(k,135)*y(k,74) + rxt(k,138)*y(k,76) - mat(k,686) = -(rxt(k,305)*y(k,92) + (rxt(k,403) + rxt(k,404) + rxt(k,405) & - ) * y(k,32) + rxt(k,407)*y(k,54) + rxt(k,408)*y(k,56) + rxt(k,412) & - *y(k,104) + 4._r8*rxt(k,417)*y(k,43) + rxt(k,429)*y(k,53) & - + rxt(k,434)*y(k,51) + rxt(k,439)*y(k,52) + (rxt(k,449) & - + rxt(k,450)) * y(k,60) + rxt(k,456)*y(k,24) + rxt(k,482) & - *y(k,59) + rxt(k,488)*y(k,2) + rxt(k,528)*y(k,18)) - mat(k,1057) = -rxt(k,305)*y(k,43) - mat(k,1703) = -(rxt(k,403) + rxt(k,404) + rxt(k,405)) * y(k,43) - mat(k,972) = -rxt(k,407)*y(k,43) - mat(k,1424) = -rxt(k,408)*y(k,43) - mat(k,754) = -rxt(k,412)*y(k,43) - mat(k,1221) = -rxt(k,429)*y(k,43) - mat(k,1745) = -rxt(k,434)*y(k,43) - mat(k,1142) = -rxt(k,439)*y(k,43) - mat(k,1667) = -(rxt(k,449) + rxt(k,450)) * y(k,43) - mat(k,1512) = -rxt(k,456)*y(k,43) - mat(k,332) = -rxt(k,482)*y(k,43) - mat(k,460) = -rxt(k,488)*y(k,43) - mat(k,259) = -rxt(k,528)*y(k,43) - mat(k,460) = mat(k,460) + rxt(k,493)*y(k,104) - mat(k,543) = rxt(k,525)*y(k,53) + rxt(k,526)*y(k,54) + rxt(k,481)*y(k,59) & - + rxt(k,445)*y(k,60) - mat(k,259) = mat(k,259) + rxt(k,452)*y(k,24) + rxt(k,529)*y(k,51) - mat(k,1512) = mat(k,1512) + rxt(k,452)*y(k,18) + rxt(k,463)*y(k,104) - mat(k,129) = rxt(k,532)*y(k,104) - mat(k,1703) = mat(k,1703) + rxt(k,406)*y(k,55) + rxt(k,312)*y(k,98) - mat(k,80) = rxt(k,402)*y(k,54) + rxt(k,448)*y(k,60) + rxt(k,411)*y(k,104) - mat(k,1469) = rxt(k,125)*y(k,68) + rxt(k,313)*y(k,98) - mat(k,1097) = rxt(k,314)*y(k,98) - mat(k,1745) = mat(k,1745) + rxt(k,529)*y(k,18) - mat(k,1221) = mat(k,1221) + rxt(k,525)*y(k,14) + rxt(k,432)*y(k,104) - mat(k,972) = mat(k,972) + rxt(k,526)*y(k,14) + rxt(k,402)*y(k,35) & - + rxt(k,342)*y(k,105) - mat(k,1263) = rxt(k,406)*y(k,32) - mat(k,1424) = mat(k,1424) + rxt(k,414)*y(k,104) - mat(k,332) = mat(k,332) + rxt(k,481)*y(k,14) - mat(k,1667) = mat(k,1667) + rxt(k,445)*y(k,14) + rxt(k,448)*y(k,35) - mat(k,621) = rxt(k,125)*y(k,40) - mat(k,1299) = rxt(k,312)*y(k,32) + rxt(k,313)*y(k,40) + rxt(k,314)*y(k,42) - mat(k,754) = mat(k,754) + rxt(k,493)*y(k,2) + rxt(k,463)*y(k,24) + rxt(k,532) & - *y(k,27) + rxt(k,411)*y(k,35) + rxt(k,432)*y(k,53) + rxt(k,414) & - *y(k,56) - mat(k,1588) = rxt(k,342)*y(k,54) - mat(k,51) = -(rxt(k,418)*y(k,104)) - mat(k,738) = -rxt(k,418)*y(k,44) - mat(k,674) = rxt(k,439)*y(k,52) - mat(k,1125) = rxt(k,439)*y(k,43) - mat(k,151) = -(rxt(k,496)*y(k,54) + (rxt(k,549) + rxt(k,554)) * y(k,40)) - mat(k,952) = -rxt(k,496)*y(k,45) - mat(k,1455) = -(rxt(k,549) + rxt(k,554)) * y(k,45) - mat(k,455) = rxt(k,488)*y(k,43) - mat(k,677) = rxt(k,488)*y(k,2) - mat(k,184) = -(rxt(k,467)*y(k,60) + rxt(k,468)*y(k,54) + rxt(k,469)*y(k,104) & - + (rxt(k,542) + rxt(k,548) + rxt(k,553)) * y(k,40)) - mat(k,1655) = -rxt(k,467)*y(k,46) - mat(k,955) = -rxt(k,468)*y(k,46) - mat(k,744) = -rxt(k,469)*y(k,46) - mat(k,1456) = -(rxt(k,542) + rxt(k,548) + rxt(k,553)) * y(k,46) - mat(k,1501) = rxt(k,456)*y(k,43) - mat(k,200) = rxt(k,461)*y(k,104) - mat(k,678) = rxt(k,456)*y(k,24) - mat(k,744) = mat(k,744) + rxt(k,461)*y(k,25) - mat(k,123) = -(rxt(k,335)*y(k,104)) - mat(k,740) = -rxt(k,335)*y(k,47) - mat(k,1454) = rxt(k,284)*y(k,81) - mat(k,1086) = rxt(k,285)*y(k,81) - mat(k,1731) = rxt(k,344)*y(k,104) - mat(k,708) = rxt(k,284)*y(k,40) + rxt(k,285)*y(k,42) - mat(k,46) = rxt(k,300)*y(k,110) - mat(k,740) = mat(k,740) + rxt(k,344)*y(k,51) - mat(k,1781) = rxt(k,300)*y(k,90) - mat(k,270) = -(rxt(k,421)*y(k,51) + (rxt(k,422) + rxt(k,423) + rxt(k,424) & - ) * y(k,52) + rxt(k,425)*y(k,55) + rxt(k,433)*y(k,104) + rxt(k,570) & - *y(k,99)) - mat(k,1734) = -rxt(k,421)*y(k,48) - mat(k,1130) = -(rxt(k,422) + rxt(k,423) + rxt(k,424)) * y(k,48) - mat(k,1257) = -rxt(k,425)*y(k,48) - mat(k,748) = -rxt(k,433)*y(k,48) - mat(k,1328) = -rxt(k,570)*y(k,48) - mat(k,961) = rxt(k,419)*y(k,79) + rxt(k,567)*y(k,94) - mat(k,1257) = mat(k,1257) + rxt(k,568)*y(k,94) - mat(k,1014) = 1.100_r8*rxt(k,563)*y(k,80) + .200_r8*rxt(k,561)*y(k,88) - mat(k,162) = rxt(k,419)*y(k,54) - mat(k,89) = 1.100_r8*rxt(k,563)*y(k,69) - mat(k,858) = .200_r8*rxt(k,561)*y(k,69) - mat(k,178) = rxt(k,567)*y(k,54) + rxt(k,568)*y(k,55) - end do + mat(431) = -((rxt(348) + rxt(349)) * y(106) + rxt(384)*y(95) + rxt(401)*y(55) & + + rxt(410)*y(104) + rxt(447)*y(23) + rxt(503)*y(33)) + mat(1551) = -(rxt(348) + rxt(349)) * y(35) + mat(558) = -rxt(384)*y(35) + mat(1483) = -rxt(401)*y(35) + mat(707) = -rxt(410)*y(35) + mat(1182) = -rxt(447)*y(35) + mat(157) = -rxt(503)*y(35) + mat(928) = rxt(403)*y(71) + mat(667) = rxt(403)*y(34) + mat(111) = -(rxt(402)*y(55) + rxt(411)*y(104) + rxt(448)*y(23)) + mat(1468) = -rxt(402)*y(37) + mat(696) = -rxt(411)*y(37) + mat(1175) = -rxt(448)*y(37) + mat(659) = 2.000_r8*rxt(417)*y(71) + mat(696) = mat(696) + 2.000_r8*rxt(416)*y(104) + mat(179) = -(rxt(494)*y(55) + rxt(495)*y(104) + (rxt(500) + rxt(501)) * y(95)) + mat(1472) = -rxt(494)*y(38) + mat(700) = -rxt(495)*y(38) + mat(552) = -(rxt(500) + rxt(501)) * y(38) + mat(319) = rxt(481)*y(15) + rxt(482)*y(71) + mat(525) = rxt(481)*y(1) + mat(662) = rxt(482)*y(1) + mat(905) = -(rxt(101)*y(61) + rxt(103)*y(60) + rxt(125)*y(67) + (rxt(271) & + + rxt(293)) * y(83) + rxt(284)*y(81) + rxt(313)*y(98) + rxt(340) & + *y(105) + rxt(351)*y(106) + rxt(465)*y(55) + rxt(466)*y(104) & + + (rxt(477) + rxt(478)) * y(95) + (rxt(542) + rxt(548) + rxt(553) & + ) * y(47) + (rxt(547) + rxt(552) + rxt(557)) * y(27) + (rxt(549) & + + rxt(554)) * y(46)) + mat(351) = -rxt(101)*y(42) + mat(618) = -rxt(103)*y(42) + mat(592) = -rxt(125)*y(42) + mat(640) = -(rxt(271) + rxt(293)) * y(42) + mat(772) = -rxt(284)*y(42) + mat(1229) = -rxt(313)*y(42) + mat(1527) = -rxt(340)*y(42) + mat(1562) = -rxt(351)*y(42) + mat(1495) = -rxt(465)*y(42) + mat(713) = -rxt(466)*y(42) + mat(563) = -(rxt(477) + rxt(478)) * y(42) + mat(190) = -(rxt(542) + rxt(548) + rxt(553)) * y(42) + mat(221) = -(rxt(547) + rxt(552) + rxt(557)) * y(42) + mat(168) = -(rxt(549) + rxt(554)) * y(42) + mat(533) = rxt(445)*y(23) + mat(1194) = rxt(445)*y(15) + rxt(447)*y(35) + rxt(448)*y(37) + rxt(467)*y(47) & + + rxt(449)*y(71) + mat(1109) = rxt(464)*y(104) + mat(940) = rxt(100)*y(60) + mat(436) = rxt(447)*y(23) + mat(114) = rxt(448)*y(23) + mat(1639) = rxt(104)*y(60) + rxt(294)*y(86) + mat(190) = mat(190) + rxt(467)*y(23) + mat(618) = mat(618) + rxt(100)*y(34) + rxt(104)*y(44) + mat(335) = rxt(182)*y(73) + (rxt(176)+2.000_r8*rxt(262))*y(75) + (rxt(164) & + +2.000_r8*rxt(263))*y(77) + rxt(235)*y(88) + rxt(217)*y(89) & + + rxt(200)*y(92) + rxt(252)*y(99) + mat(672) = rxt(449)*y(23) + mat(1023) = rxt(182)*y(62) + rxt(193)*y(86) + mat(1356) = (rxt(176)+2.000_r8*rxt(262))*y(62) + rxt(158)*y(86) + mat(1440) = (rxt(164)+2.000_r8*rxt(263))*y(62) + rxt(175)*y(86) + mat(394) = rxt(294)*y(44) + rxt(193)*y(73) + rxt(158)*y(75) + rxt(175)*y(77) & + + rxt(246)*y(88) + rxt(228)*y(89) + rxt(211)*y(92) + rxt(152) & + *y(99) + mat(819) = rxt(235)*y(62) + rxt(246)*y(86) + mat(861) = rxt(217)*y(62) + rxt(228)*y(86) + mat(981) = rxt(200)*y(62) + rxt(211)*y(86) + mat(1273) = rxt(252)*y(62) + rxt(152)*y(86) + mat(713) = mat(713) + rxt(464)*y(26) + mat(154) = rxt(503)*y(35) + rxt(505)*y(44) + rxt(504)*y(110) + mat(428) = rxt(503)*y(33) + mat(1621) = rxt(505)*y(33) + mat(1694) = rxt(504)*y(33) + mat(1657) = -(rxt(104)*y(60) + rxt(119)*y(64) + rxt(285)*y(81) + rxt(290) & + *y(85) + rxt(294)*y(86) + rxt(295)*y(83) + rxt(314)*y(98) & + + rxt(352)*y(106) + rxt(442)*y(104) + rxt(505)*y(33)) + mat(630) = -rxt(104)*y(44) + mat(761) = -rxt(119)*y(44) + mat(790) = -rxt(285)*y(44) + mat(521) = -rxt(290)*y(44) + mat(403) = -rxt(294)*y(44) + mat(654) = -rxt(295)*y(44) + mat(1247) = -rxt(314)*y(44) + mat(1580) = -rxt(352)*y(44) + mat(729) = -rxt(442)*y(44) + mat(160) = -rxt(505)*y(44) + mat(545) = rxt(525)*y(54) + mat(226) = (rxt(547)+rxt(552)+rxt(557))*y(42) + mat(923) = (rxt(547)+rxt(552)+rxt(557))*y(27) + rxt(293)*y(83) + mat(248) = rxt(137)*y(75) + rxt(140)*y(77) + rxt(288)*y(84) + rxt(292)*y(85) + mat(1085) = rxt(441)*y(104) + mat(1691) = rxt(525)*y(15) + mat(1041) = rxt(183)*y(83) + 2.000_r8*rxt(180)*y(87) + mat(27) = rxt(135)*y(110) + mat(1374) = rxt(137)*y(51) + (rxt(187)+rxt(259))*y(83) + (2.000_r8*rxt(141) & + +2.000_r8*rxt(264))*y(87) + mat(31) = rxt(138)*y(110) + mat(1458) = rxt(140)*y(51) + (rxt(166)+rxt(261))*y(83) + (2.000_r8*rxt(162) & + +2.000_r8*rxt(265))*y(87) + mat(654) = mat(654) + rxt(293)*y(42) + rxt(183)*y(73) + (rxt(187)+rxt(259)) & + *y(75) + (rxt(166)+rxt(261))*y(77) + mat(481) = rxt(288)*y(51) + mat(521) = mat(521) + rxt(292)*y(51) + mat(461) = 2.000_r8*rxt(180)*y(73) + (2.000_r8*rxt(141)+2.000_r8*rxt(264)) & + *y(75) + (2.000_r8*rxt(162)+2.000_r8*rxt(265))*y(77) + rxt(233) & + *y(88) + rxt(215)*y(89) + rxt(197)*y(92) + rxt(250)*y(99) + mat(837) = rxt(233)*y(87) + mat(879) = rxt(215)*y(87) + mat(999) = rxt(197)*y(87) + mat(1291) = rxt(250)*y(87) + mat(729) = mat(729) + rxt(441)*y(53) + mat(1743) = rxt(135)*y(74) + rxt(138)*y(76) + mat(57) = -(rxt(418)*y(104)) + mat(694) = -rxt(418)*y(45) + mat(1044) = rxt(439)*y(71) + mat(658) = rxt(439)*y(53) + mat(164) = -(rxt(496)*y(55) + (rxt(549) + rxt(554)) * y(42)) + mat(1470) = -rxt(496)*y(46) + mat(885) = -(rxt(549) + rxt(554)) * y(46) + mat(409) = rxt(488)*y(71) + mat(661) = rxt(488)*y(3) + mat(188) = -(rxt(467)*y(23) + rxt(468)*y(55) + rxt(469)*y(104) + (rxt(542) & + + rxt(548) + rxt(553)) * y(42)) + mat(1176) = -rxt(467)*y(47) + mat(1473) = -rxt(468)*y(47) + mat(701) = -rxt(469)*y(47) + mat(886) = -(rxt(542) + rxt(548) + rxt(553)) * y(47) + mat(1092) = rxt(456)*y(71) + mat(218) = rxt(461)*y(104) + mat(663) = rxt(456)*y(26) + mat(701) = mat(701) + rxt(461)*y(27) + mat(124) = -(rxt(335)*y(104)) + mat(697) = -rxt(335)*y(48) + mat(884) = rxt(284)*y(81) + mat(1622) = rxt(285)*y(81) + mat(1294) = rxt(344)*y(104) + mat(764) = rxt(284)*y(42) + rxt(285)*y(44) + mat(46) = rxt(300)*y(110) + mat(697) = mat(697) + rxt(344)*y(52) + mat(1702) = rxt(300)*y(90) + mat(253) = -(rxt(421)*y(52) + (rxt(422) + rxt(423) + rxt(424)) * y(53) & + + rxt(425)*y(56) + rxt(433)*y(104) + rxt(570)*y(99)) + mat(1296) = -rxt(421)*y(49) + mat(1049) = -(rxt(422) + rxt(423) + rxt(424)) * y(49) + mat(1139) = -rxt(425)*y(49) + mat(703) = -rxt(433)*y(49) + mat(1251) = -rxt(570)*y(49) + mat(1478) = rxt(419)*y(79) + rxt(567)*y(94) + mat(1139) = mat(1139) + rxt(568)*y(94) + mat(1391) = 1.100_r8*rxt(563)*y(80) + .200_r8*rxt(561)*y(88) + mat(149) = rxt(419)*y(55) + mat(105) = 1.100_r8*rxt(563)*y(68) + mat(798) = .200_r8*rxt(561)*y(68) + mat(174) = rxt(567)*y(55) + rxt(568)*y(56) + mat(239) = -(rxt(137)*y(75) + rxt(140)*y(77) + rxt(288)*y(84) + rxt(292) & + *y(85)) + mat(1336) = -rxt(137)*y(51) + mat(1420) = -rxt(140)*y(51) + mat(464) = -rxt(288)*y(51) + mat(504) = -rxt(292)*y(51) + mat(1048) = rxt(440)*y(54) + mat(1661) = rxt(440)*y(53) + mat(1324) = -((rxt(106) + rxt(107)) * y(63) + (rxt(117) + rxt(118)) * y(66) & + + rxt(131)*y(106) + (rxt(267) + rxt(274)) * y(101) + rxt(275) & + *y(64) + rxt(344)*y(104) + rxt(421)*y(49) + rxt(430)*y(54) & + + rxt(434)*y(71) + rxt(435)*y(57) + rxt(436)*y(55) + rxt(457) & + *y(26) + rxt(489)*y(3) + rxt(529)*y(19) + rxt(572)*y(99)) + mat(235) = -(rxt(106) + rxt(107)) * y(52) + mat(499) = -(rxt(117) + rxt(118)) * y(52) + mat(1572) = -rxt(131)*y(52) + mat(384) = -(rxt(267) + rxt(274)) * y(52) + mat(753) = -rxt(275)*y(52) + mat(723) = -rxt(344)*y(52) + mat(262) = -rxt(421)*y(52) + mat(1683) = -rxt(430)*y(52) + mat(682) = -rxt(434)*y(52) + mat(1610) = -rxt(435)*y(52) + mat(1505) = -rxt(436)*y(52) + mat(1119) = -rxt(457)*y(52) + mat(422) = -rxt(489)*y(52) + mat(275) = -rxt(529)*y(52) + mat(1283) = -rxt(572)*y(52) + mat(950) = rxt(282)*y(81) + rxt(304)*y(92) + mat(262) = mat(262) + 2.000_r8*rxt(423)*y(53) + rxt(425)*y(56) + rxt(433) & + *y(104) + mat(1077) = 2.000_r8*rxt(423)*y(49) + rxt(426)*y(55) + rxt(286)*y(81) + mat(1505) = mat(1505) + rxt(426)*y(53) + mat(1162) = rxt(425)*y(49) + rxt(420)*y(79) + mat(626) = rxt(243)*y(88) + rxt(225)*y(89) + rxt(207)*y(92) + mat(358) = rxt(247)*y(88) + rxt(229)*y(89) + rxt(212)*y(92) + mat(342) = rxt(235)*y(88) + rxt(217)*y(89) + rxt(200)*y(92) + mat(753) = mat(753) + rxt(234)*y(88) + rxt(216)*y(89) + rxt(199)*y(92) + mat(313) = rxt(241)*y(88) + rxt(224)*y(89) + rxt(206)*y(92) + mat(499) = mat(499) + rxt(244)*y(88) + rxt(226)*y(89) + rxt(208)*y(92) + mat(602) = rxt(239)*y(88) + rxt(222)*y(89) + rxt(204)*y(92) + mat(1408) = rxt(298)*y(89) + rxt(299)*y(90) + rxt(301)*y(91) + rxt(303)*y(92) & + + rxt(379)*y(93) + mat(286) = rxt(237)*y(88) + rxt(219)*y(89) + rxt(202)*y(92) + mat(152) = rxt(420)*y(56) + mat(782) = rxt(282)*y(34) + rxt(286)*y(53) + rxt(249)*y(88) + rxt(232)*y(89) & + + rxt(214)*y(92) + mat(372) = rxt(245)*y(88) + rxt(227)*y(89) + rxt(210)*y(92) + mat(648) = rxt(236)*y(88) + rxt(218)*y(89) + rxt(201)*y(92) + mat(477) = rxt(248)*y(88) + rxt(230)*y(89) + rxt(213)*y(92) + mat(517) = rxt(240)*y(88) + rxt(223)*y(89) + rxt(205)*y(92) + mat(400) = rxt(246)*y(88) + rxt(228)*y(89) + rxt(211)*y(92) + mat(458) = rxt(233)*y(88) + rxt(215)*y(89) + rxt(197)*y(92) + mat(829) = rxt(243)*y(60) + rxt(247)*y(61) + rxt(235)*y(62) + rxt(234)*y(64) & + + rxt(241)*y(65) + rxt(244)*y(66) + rxt(239)*y(67) + rxt(237) & + *y(70) + rxt(249)*y(81) + rxt(245)*y(82) + rxt(236)*y(83) & + + rxt(248)*y(84) + rxt(240)*y(85) + rxt(246)*y(86) + rxt(233) & + *y(87) + rxt(238)*y(98) + mat(871) = rxt(225)*y(60) + rxt(229)*y(61) + rxt(217)*y(62) + rxt(216)*y(64) & + + rxt(224)*y(65) + rxt(226)*y(66) + rxt(222)*y(67) + rxt(298) & + *y(68) + rxt(219)*y(70) + rxt(232)*y(81) + rxt(227)*y(82) & + + rxt(218)*y(83) + rxt(230)*y(84) + rxt(223)*y(85) + rxt(228) & + *y(86) + rxt(215)*y(87) + rxt(221)*y(98) + mat(48) = rxt(299)*y(68) + mat(74) = rxt(301)*y(68) + mat(991) = rxt(304)*y(34) + rxt(207)*y(60) + rxt(212)*y(61) + rxt(200)*y(62) & + + rxt(199)*y(64) + rxt(206)*y(65) + rxt(208)*y(66) + rxt(204) & + *y(67) + rxt(303)*y(68) + rxt(202)*y(70) + rxt(214)*y(81) & + + rxt(210)*y(82) + rxt(201)*y(83) + rxt(213)*y(84) + rxt(205) & + *y(85) + rxt(211)*y(86) + rxt(197)*y(87) + rxt(203)*y(98) + mat(68) = rxt(379)*y(68) + mat(1239) = rxt(238)*y(88) + rxt(221)*y(89) + rxt(203)*y(92) + mat(723) = mat(723) + rxt(433)*y(49) end subroutine nlnmat02 - subroutine nlnmat03( avec_len, mat, y, rxt ) + subroutine nlnmat03( 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) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) !---------------------------------------------- ! ... local variables !---------------------------------------------- - integer :: k !---------------------------------------------- ! ... complete matrix entries implicit species !---------------------------------------------- - do k = 1,avec_len - mat(k,229) = -(rxt(k,137)*y(k,75) + rxt(k,140)*y(k,77) + rxt(k,288)*y(k,84) & - + rxt(k,292)*y(k,85)) - mat(k,1171) = -rxt(k,137)*y(k,50) - mat(k,1541) = -rxt(k,140)*y(k,50) - mat(k,475) = -rxt(k,288)*y(k,50) - mat(k,516) = -rxt(k,292)*y(k,50) - mat(k,1129) = rxt(k,440)*y(k,53) - mat(k,1214) = rxt(k,440)*y(k,52) - mat(k,1771) = -((rxt(k,106) + rxt(k,107)) * y(k,64) + (rxt(k,117) + rxt(k,118) & - ) * y(k,67) + rxt(k,131)*y(k,106) + (rxt(k,267) + rxt(k,274) & - ) * y(k,101) + rxt(k,275)*y(k,65) + rxt(k,344)*y(k,104) & - + rxt(k,421)*y(k,48) + rxt(k,430)*y(k,53) + rxt(k,434)*y(k,43) & - + rxt(k,435)*y(k,56) + rxt(k,436)*y(k,54) + rxt(k,457)*y(k,24) & - + rxt(k,489)*y(k,2) + rxt(k,529)*y(k,18) + rxt(k,572)*y(k,99)) - mat(k,218) = -(rxt(k,106) + rxt(k,107)) * y(k,51) - mat(k,514) = -(rxt(k,117) + rxt(k,118)) * y(k,51) - mat(k,1650) = -rxt(k,131)*y(k,51) - mat(k,415) = -(rxt(k,267) + rxt(k,274)) * y(k,51) - mat(k,808) = -rxt(k,275)*y(k,51) - mat(k,775) = -rxt(k,344)*y(k,51) - mat(k,282) = -rxt(k,421)*y(k,51) - mat(k,1246) = -rxt(k,430)*y(k,51) - mat(k,706) = -rxt(k,434)*y(k,51) - mat(k,1450) = -rxt(k,435)*y(k,51) - mat(k,998) = -rxt(k,436)*y(k,51) - mat(k,1538) = -rxt(k,457)*y(k,51) - mat(k,473) = -rxt(k,489)*y(k,51) - mat(k,266) = -rxt(k,529)*y(k,51) - mat(k,1370) = -rxt(k,572)*y(k,51) - mat(k,1729) = rxt(k,282)*y(k,81) + rxt(k,304)*y(k,92) - mat(k,282) = mat(k,282) + 2.000_r8*rxt(k,423)*y(k,52) + rxt(k,425)*y(k,55) & - + rxt(k,433)*y(k,104) - mat(k,1168) = 2.000_r8*rxt(k,423)*y(k,48) + rxt(k,426)*y(k,54) + rxt(k,286) & - *y(k,81) - mat(k,998) = mat(k,998) + rxt(k,426)*y(k,52) - mat(k,1289) = rxt(k,425)*y(k,48) + rxt(k,420)*y(k,79) - mat(k,614) = rxt(k,243)*y(k,88) + rxt(k,225)*y(k,89) + rxt(k,207)*y(k,92) - mat(k,369) = rxt(k,247)*y(k,88) + rxt(k,229)*y(k,89) + rxt(k,212)*y(k,92) - mat(k,353) = rxt(k,235)*y(k,88) + rxt(k,217)*y(k,89) + rxt(k,200)*y(k,92) - mat(k,808) = mat(k,808) + rxt(k,234)*y(k,88) + rxt(k,216)*y(k,89) & - + rxt(k,199)*y(k,92) - mat(k,324) = rxt(k,241)*y(k,88) + rxt(k,224)*y(k,89) + rxt(k,206)*y(k,92) - mat(k,514) = mat(k,514) + rxt(k,244)*y(k,88) + rxt(k,226)*y(k,89) & - + rxt(k,208)*y(k,92) - mat(k,646) = rxt(k,239)*y(k,88) + rxt(k,222)*y(k,89) + rxt(k,204)*y(k,92) - mat(k,1041) = rxt(k,298)*y(k,89) + rxt(k,299)*y(k,90) + rxt(k,301)*y(k,91) & - + rxt(k,303)*y(k,92) + rxt(k,379)*y(k,93) - mat(k,309) = rxt(k,237)*y(k,88) + rxt(k,219)*y(k,89) + rxt(k,202)*y(k,92) - mat(k,166) = rxt(k,420)*y(k,55) - mat(k,733) = rxt(k,282)*y(k,32) + rxt(k,286)*y(k,52) + rxt(k,249)*y(k,88) & - + rxt(k,232)*y(k,89) + rxt(k,214)*y(k,92) - mat(k,383) = rxt(k,245)*y(k,88) + rxt(k,227)*y(k,89) + rxt(k,210)*y(k,92) - mat(k,671) = rxt(k,236)*y(k,88) + rxt(k,218)*y(k,89) + rxt(k,201)*y(k,92) - mat(k,493) = rxt(k,248)*y(k,88) + rxt(k,230)*y(k,89) + rxt(k,213)*y(k,92) - mat(k,534) = rxt(k,240)*y(k,88) + rxt(k,223)*y(k,89) + rxt(k,205)*y(k,92) - mat(k,399) = rxt(k,246)*y(k,88) + rxt(k,228)*y(k,89) + rxt(k,211)*y(k,92) - mat(k,450) = rxt(k,233)*y(k,88) + rxt(k,215)*y(k,89) + rxt(k,197)*y(k,92) - mat(k,899) = rxt(k,243)*y(k,61) + rxt(k,247)*y(k,62) + rxt(k,235)*y(k,63) & - + rxt(k,234)*y(k,65) + rxt(k,241)*y(k,66) + rxt(k,244)*y(k,67) & - + rxt(k,239)*y(k,68) + rxt(k,237)*y(k,71) + rxt(k,249)*y(k,81) & - + rxt(k,245)*y(k,82) + rxt(k,236)*y(k,83) + rxt(k,248)*y(k,84) & - + rxt(k,240)*y(k,85) + rxt(k,246)*y(k,86) + rxt(k,233)*y(k,87) & - + rxt(k,238)*y(k,98) - mat(k,942) = rxt(k,225)*y(k,61) + rxt(k,229)*y(k,62) + rxt(k,217)*y(k,63) & - + rxt(k,216)*y(k,65) + rxt(k,224)*y(k,66) + rxt(k,226)*y(k,67) & - + rxt(k,222)*y(k,68) + rxt(k,298)*y(k,69) + rxt(k,219)*y(k,71) & - + rxt(k,232)*y(k,81) + rxt(k,227)*y(k,82) + rxt(k,218)*y(k,83) & - + rxt(k,230)*y(k,84) + rxt(k,223)*y(k,85) + rxt(k,228)*y(k,86) & - + rxt(k,215)*y(k,87) + rxt(k,221)*y(k,98) - mat(k,49) = rxt(k,299)*y(k,69) - mat(k,121) = rxt(k,301)*y(k,69) - mat(k,1083) = rxt(k,304)*y(k,32) + rxt(k,207)*y(k,61) + rxt(k,212)*y(k,62) & - + rxt(k,200)*y(k,63) + rxt(k,199)*y(k,65) + rxt(k,206)*y(k,66) & - + rxt(k,208)*y(k,67) + rxt(k,204)*y(k,68) + rxt(k,303)*y(k,69) & - + rxt(k,202)*y(k,71) + rxt(k,214)*y(k,81) + rxt(k,210)*y(k,82) & - + rxt(k,201)*y(k,83) + rxt(k,213)*y(k,84) + rxt(k,205)*y(k,85) & - + rxt(k,211)*y(k,86) + rxt(k,197)*y(k,87) + rxt(k,203)*y(k,98) - mat(k,114) = rxt(k,379)*y(k,69) - mat(k,1325) = rxt(k,238)*y(k,88) + rxt(k,221)*y(k,89) + rxt(k,203)*y(k,92) - mat(k,775) = mat(k,775) + rxt(k,433)*y(k,48) - mat(k,1153) = -(rxt(k,105)*y(k,61) + (rxt(k,115) + rxt(k,116)) * y(k,67) & - + (rxt(k,272) + rxt(k,273)) * y(k,101) + rxt(k,276)*y(k,65) & - + rxt(k,286)*y(k,81) + rxt(k,315)*y(k,98) + rxt(k,341)*y(k,105) & - + rxt(k,354)*y(k,106) + (rxt(k,422) + rxt(k,423) + rxt(k,424) & - ) * y(k,48) + (rxt(k,426) + rxt(k,428)) * y(k,54) + rxt(k,427) & - *y(k,56) + rxt(k,439)*y(k,43) + rxt(k,440)*y(k,53) + rxt(k,441) & - *y(k,104) + rxt(k,459)*y(k,24) + rxt(k,490)*y(k,2)) - mat(k,606) = -rxt(k,105)*y(k,52) - mat(k,507) = -(rxt(k,115) + rxt(k,116)) * y(k,52) - mat(k,407) = -(rxt(k,272) + rxt(k,273)) * y(k,52) - mat(k,793) = -rxt(k,276)*y(k,52) - mat(k,721) = -rxt(k,286)*y(k,52) - mat(k,1310) = -rxt(k,315)*y(k,52) - mat(k,1599) = -rxt(k,341)*y(k,52) - mat(k,1635) = -rxt(k,354)*y(k,52) - mat(k,277) = -(rxt(k,422) + rxt(k,423) + rxt(k,424)) * y(k,52) - mat(k,983) = -(rxt(k,426) + rxt(k,428)) * y(k,52) - mat(k,1435) = -rxt(k,427)*y(k,52) - mat(k,693) = -rxt(k,439)*y(k,52) - mat(k,1231) = -rxt(k,440)*y(k,52) - mat(k,762) = -rxt(k,441)*y(k,52) - mat(k,1523) = -rxt(k,459)*y(k,52) - mat(k,464) = -rxt(k,490)*y(k,52) - mat(k,464) = mat(k,464) + rxt(k,489)*y(k,51) - mat(k,261) = rxt(k,529)*y(k,51) - mat(k,1523) = mat(k,1523) + rxt(k,457)*y(k,51) - mat(k,693) = mat(k,693) + rxt(k,434)*y(k,51) + rxt(k,429)*y(k,53) - mat(k,54) = rxt(k,418)*y(k,104) - mat(k,125) = rxt(k,335)*y(k,104) - mat(k,1756) = rxt(k,489)*y(k,2) + rxt(k,529)*y(k,18) + rxt(k,457)*y(k,24) & - + rxt(k,434)*y(k,43) + 2.000_r8*rxt(k,430)*y(k,53) + rxt(k,436) & - *y(k,54) + rxt(k,435)*y(k,56) + rxt(k,107)*y(k,64) + rxt(k,131) & - *y(k,106) - mat(k,1231) = mat(k,1231) + rxt(k,429)*y(k,43) + 2.000_r8*rxt(k,430)*y(k,51) & - + rxt(k,431)*y(k,54) + rxt(k,432)*y(k,104) - mat(k,983) = mat(k,983) + rxt(k,436)*y(k,51) + rxt(k,431)*y(k,53) - mat(k,1435) = mat(k,1435) + rxt(k,435)*y(k,51) - mat(k,1678) = rxt(k,280)*y(k,81) - mat(k,215) = rxt(k,107)*y(k,51) - mat(k,836) = rxt(k,196)*y(k,81) + rxt(k,192)*y(k,82) - mat(k,1196) = rxt(k,161)*y(k,81) + rxt(k,157)*y(k,82) - mat(k,1566) = rxt(k,179)*y(k,81) + rxt(k,174)*y(k,82) - mat(k,721) = mat(k,721) + rxt(k,280)*y(k,60) + rxt(k,196)*y(k,73) & - + rxt(k,161)*y(k,75) + rxt(k,179)*y(k,77) + rxt(k,249)*y(k,88) & - + rxt(k,232)*y(k,89) + rxt(k,214)*y(k,92) + rxt(k,156)*y(k,99) - mat(k,377) = rxt(k,192)*y(k,73) + rxt(k,157)*y(k,75) + rxt(k,174)*y(k,77) & - + rxt(k,245)*y(k,88) + rxt(k,227)*y(k,89) + rxt(k,210)*y(k,92) & - + rxt(k,151)*y(k,99) - mat(k,884) = rxt(k,249)*y(k,81) + rxt(k,245)*y(k,82) - mat(k,927) = rxt(k,232)*y(k,81) + rxt(k,227)*y(k,82) - mat(k,1068) = rxt(k,214)*y(k,81) + rxt(k,210)*y(k,82) + rxt(k,306)*y(k,104) - mat(k,1355) = rxt(k,156)*y(k,81) + rxt(k,151)*y(k,82) - mat(k,762) = mat(k,762) + rxt(k,418)*y(k,44) + rxt(k,335)*y(k,47) & - + rxt(k,432)*y(k,53) + rxt(k,306)*y(k,92) - mat(k,1635) = mat(k,1635) + rxt(k,131)*y(k,51) - mat(k,1233) = -(rxt(k,429)*y(k,43) + rxt(k,430)*y(k,51) + rxt(k,431)*y(k,54) & - + rxt(k,432)*y(k,104) + rxt(k,440)*y(k,52) + rxt(k,525)*y(k,14)) - mat(k,694) = -rxt(k,429)*y(k,53) - mat(k,1758) = -rxt(k,430)*y(k,53) - mat(k,985) = -rxt(k,431)*y(k,53) - mat(k,763) = -rxt(k,432)*y(k,53) - mat(k,1155) = -rxt(k,440)*y(k,53) - mat(k,549) = -rxt(k,525)*y(k,53) - mat(k,78) = rxt(k,491)*y(k,54) - mat(k,1525) = rxt(k,281)*y(k,81) - mat(k,206) = rxt(k,460)*y(k,54) + rxt(k,458)*y(k,60) + rxt(k,461)*y(k,104) - mat(k,173) = rxt(k,505)*y(k,42) - mat(k,1110) = rxt(k,505)*y(k,31) + rxt(k,442)*y(k,104) - mat(k,694) = mat(k,694) + rxt(k,305)*y(k,92) - mat(k,1155) = mat(k,1155) + rxt(k,428)*y(k,54) + rxt(k,427)*y(k,56) - mat(k,985) = mat(k,985) + rxt(k,491)*y(k,3) + rxt(k,460)*y(k,25) + rxt(k,428) & - *y(k,52) - mat(k,1437) = rxt(k,427)*y(k,52) - mat(k,1680) = rxt(k,458)*y(k,25) - mat(k,838) = rxt(k,195)*y(k,84) + rxt(k,188)*y(k,85) + rxt(k,193)*y(k,86) - mat(k,1198) = rxt(k,160)*y(k,84) + (rxt(k,231)+rxt(k,257))*y(k,85) & - + rxt(k,158)*y(k,86) - mat(k,1568) = rxt(k,178)*y(k,84) + (rxt(k,170)+rxt(k,258))*y(k,85) & - + rxt(k,175)*y(k,86) - mat(k,723) = rxt(k,281)*y(k,24) - mat(k,663) = rxt(k,236)*y(k,88) + rxt(k,218)*y(k,89) + rxt(k,201)*y(k,92) & - + rxt(k,143)*y(k,99) - mat(k,488) = rxt(k,195)*y(k,73) + rxt(k,160)*y(k,75) + rxt(k,178)*y(k,77) & - + rxt(k,248)*y(k,88) + rxt(k,230)*y(k,89) + rxt(k,213)*y(k,92) & - + rxt(k,155)*y(k,99) - mat(k,529) = rxt(k,188)*y(k,73) + (rxt(k,231)+rxt(k,257))*y(k,75) + ( & - + rxt(k,170)+rxt(k,258))*y(k,77) + rxt(k,240)*y(k,88) & - + rxt(k,223)*y(k,89) + rxt(k,205)*y(k,92) + rxt(k,147)*y(k,99) - mat(k,393) = rxt(k,193)*y(k,73) + rxt(k,158)*y(k,75) + rxt(k,175)*y(k,77) & - + rxt(k,246)*y(k,88) + rxt(k,228)*y(k,89) + rxt(k,211)*y(k,92) & - + rxt(k,152)*y(k,99) - mat(k,446) = rxt(k,233)*y(k,88) + rxt(k,215)*y(k,89) + rxt(k,197)*y(k,92) & - + rxt(k,250)*y(k,99) - mat(k,886) = rxt(k,236)*y(k,83) + rxt(k,248)*y(k,84) + rxt(k,240)*y(k,85) & - + rxt(k,246)*y(k,86) + rxt(k,233)*y(k,87) - mat(k,929) = rxt(k,218)*y(k,83) + rxt(k,230)*y(k,84) + rxt(k,223)*y(k,85) & - + rxt(k,228)*y(k,86) + rxt(k,215)*y(k,87) - mat(k,1070) = rxt(k,305)*y(k,43) + rxt(k,201)*y(k,83) + rxt(k,213)*y(k,84) & - + rxt(k,205)*y(k,85) + rxt(k,211)*y(k,86) + rxt(k,197)*y(k,87) - mat(k,1357) = rxt(k,143)*y(k,83) + rxt(k,155)*y(k,84) + rxt(k,147)*y(k,85) & - + rxt(k,152)*y(k,86) + rxt(k,250)*y(k,87) - mat(k,763) = mat(k,763) + rxt(k,461)*y(k,25) + rxt(k,442)*y(k,42) - mat(k,979) = -(rxt(k,108)*y(k,64) + rxt(k,120)*y(k,65) + rxt(k,126)*y(k,68) & - + rxt(k,296)*y(k,83) + (rxt(k,319) + rxt(k,320)) * y(k,98) & - + (rxt(k,328) + rxt(k,329)) * y(k,101) + rxt(k,331)*y(k,102) & - + rxt(k,333)*y(k,103) + rxt(k,342)*y(k,105) + rxt(k,355) & - *y(k,106) + rxt(k,398)*y(k,56) + 4._r8*rxt(k,399)*y(k,54) & - + rxt(k,400)*y(k,55) + rxt(k,401)*y(k,33) + rxt(k,402)*y(k,35) & - + rxt(k,407)*y(k,43) + rxt(k,413)*y(k,104) + (rxt(k,426) & - + rxt(k,428)) * y(k,52) + rxt(k,431)*y(k,53) + rxt(k,436) & - *y(k,51) + rxt(k,460)*y(k,25) + rxt(k,462)*y(k,24) + rxt(k,465) & - *y(k,40) + rxt(k,468)*y(k,46) + rxt(k,491)*y(k,3) + rxt(k,492) & - *y(k,2) + rxt(k,494)*y(k,36) + rxt(k,496)*y(k,45) + rxt(k,526) & - *y(k,14) + (rxt(k,565) + rxt(k,566)) * y(k,80) + rxt(k,567) & - *y(k,94)) - mat(k,214) = -rxt(k,108)*y(k,54) - mat(k,789) = -rxt(k,120)*y(k,54) - mat(k,628) = -rxt(k,126)*y(k,54) - mat(k,657) = -rxt(k,296)*y(k,54) - mat(k,1306) = -(rxt(k,319) + rxt(k,320)) * y(k,54) - mat(k,405) = -(rxt(k,328) + rxt(k,329)) * y(k,54) - mat(k,98) = -rxt(k,331)*y(k,54) - mat(k,288) = -rxt(k,333)*y(k,54) - mat(k,1595) = -rxt(k,342)*y(k,54) - mat(k,1631) = -rxt(k,355)*y(k,54) - mat(k,1431) = -rxt(k,398)*y(k,54) - mat(k,1270) = -rxt(k,400)*y(k,54) - mat(k,424) = -rxt(k,401)*y(k,54) - mat(k,82) = -rxt(k,402)*y(k,54) - mat(k,689) = -rxt(k,407)*y(k,54) - mat(k,758) = -rxt(k,413)*y(k,54) - mat(k,1149) = -(rxt(k,426) + rxt(k,428)) * y(k,54) - mat(k,1227) = -rxt(k,431)*y(k,54) - mat(k,1752) = -rxt(k,436)*y(k,54) - mat(k,203) = -rxt(k,460)*y(k,54) - mat(k,1519) = -rxt(k,462)*y(k,54) - mat(k,1476) = -rxt(k,465)*y(k,54) - mat(k,186) = -rxt(k,468)*y(k,54) - mat(k,75) = -rxt(k,491)*y(k,54) - mat(k,462) = -rxt(k,492)*y(k,54) - mat(k,196) = -rxt(k,494)*y(k,54) - mat(k,155) = -rxt(k,496)*y(k,54) - mat(k,545) = -rxt(k,526)*y(k,54) - mat(k,91) = -(rxt(k,565) + rxt(k,566)) * y(k,54) - mat(k,180) = -rxt(k,567)*y(k,54) - mat(k,1710) = rxt(k,405)*y(k,43) - mat(k,689) = mat(k,689) + rxt(k,405)*y(k,32) - mat(k,275) = rxt(k,421)*y(k,51) + rxt(k,422)*y(k,52) + rxt(k,425)*y(k,55) & - + rxt(k,570)*y(k,99) - mat(k,1752) = mat(k,1752) + rxt(k,421)*y(k,48) + rxt(k,267)*y(k,101) - mat(k,1149) = mat(k,1149) + rxt(k,422)*y(k,48) + rxt(k,354)*y(k,106) - mat(k,1270) = mat(k,1270) + rxt(k,425)*y(k,48) + rxt(k,569)*y(k,94) + ( & - + rxt(k,387)+rxt(k,388))*y(k,95) + rxt(k,576)*y(k,107) & - + rxt(k,580)*y(k,108) - mat(k,1431) = mat(k,1431) + rxt(k,358)*y(k,106) - mat(k,1674) = rxt(k,109)*y(k,65) + rxt(k,345)*y(k,106) - mat(k,789) = mat(k,789) + rxt(k,109)*y(k,60) + rxt(k,181)*y(k,73) + ( & - + rxt(k,165)+rxt(k,253))*y(k,75) + (rxt(k,163)+rxt(k,260)) & - *y(k,77) + rxt(k,234)*y(k,88) + rxt(k,216)*y(k,89) + rxt(k,199) & - *y(k,92) + rxt(k,251)*y(k,99) - mat(k,316) = rxt(k,189)*y(k,73) + (rxt(k,242)+rxt(k,266))*y(k,75) + ( & - + rxt(k,171)+rxt(k,254))*y(k,77) + rxt(k,241)*y(k,88) & - + rxt(k,224)*y(k,89) + rxt(k,206)*y(k,92) + rxt(k,148)*y(k,99) - mat(k,505) = rxt(k,191)*y(k,73) + (rxt(k,153)+rxt(k,255))*y(k,75) + ( & - + rxt(k,173)+rxt(k,256))*y(k,77) + rxt(k,244)*y(k,88) & - + rxt(k,226)*y(k,89) + rxt(k,208)*y(k,92) + rxt(k,150)*y(k,99) - mat(k,1022) = rxt(k,561)*y(k,88) + 1.150_r8*rxt(k,562)*y(k,99) - mat(k,832) = rxt(k,181)*y(k,65) + rxt(k,189)*y(k,66) + rxt(k,191)*y(k,67) - mat(k,1192) = (rxt(k,165)+rxt(k,253))*y(k,65) + (rxt(k,242)+rxt(k,266)) & - *y(k,66) + (rxt(k,153)+rxt(k,255))*y(k,67) - mat(k,1562) = (rxt(k,163)+rxt(k,260))*y(k,65) + (rxt(k,171)+rxt(k,254)) & - *y(k,66) + (rxt(k,173)+rxt(k,256))*y(k,67) - mat(k,164) = rxt(k,575)*y(k,107) - mat(k,880) = rxt(k,234)*y(k,65) + rxt(k,241)*y(k,66) + rxt(k,244)*y(k,67) & - + rxt(k,561)*y(k,69) - mat(k,923) = rxt(k,216)*y(k,65) + rxt(k,224)*y(k,66) + rxt(k,226)*y(k,67) - mat(k,1064) = rxt(k,199)*y(k,65) + rxt(k,206)*y(k,66) + rxt(k,208)*y(k,67) - mat(k,180) = mat(k,180) + rxt(k,569)*y(k,55) - mat(k,577) = (rxt(k,387)+rxt(k,388))*y(k,55) - mat(k,1351) = rxt(k,570)*y(k,48) + rxt(k,251)*y(k,65) + rxt(k,148)*y(k,66) & - + rxt(k,150)*y(k,67) + 1.150_r8*rxt(k,562)*y(k,69) - mat(k,405) = mat(k,405) + rxt(k,267)*y(k,51) - mat(k,758) = mat(k,758) + 2.000_r8*rxt(k,415)*y(k,104) - mat(k,1631) = mat(k,1631) + rxt(k,354)*y(k,52) + rxt(k,358)*y(k,56) & - + rxt(k,345)*y(k,60) - mat(k,250) = rxt(k,576)*y(k,55) + rxt(k,575)*y(k,79) - mat(k,68) = rxt(k,580)*y(k,55) - end do + mat(1071) = -(rxt(105)*y(60) + (rxt(115) + rxt(116)) * y(66) + (rxt(272) & + + rxt(273)) * y(101) + rxt(276)*y(64) + rxt(286)*y(81) + rxt(315) & + *y(98) + rxt(341)*y(105) + rxt(354)*y(106) + (rxt(422) + rxt(423) & + + rxt(424)) * y(49) + (rxt(426) + rxt(428)) * y(55) + rxt(427) & + *y(57) + rxt(439)*y(71) + rxt(440)*y(54) + rxt(441)*y(104) & + + rxt(459)*y(26) + rxt(490)*y(3)) + mat(622) = -rxt(105)*y(53) + mat(496) = -(rxt(115) + rxt(116)) * y(53) + mat(381) = -(rxt(272) + rxt(273)) * y(53) + mat(747) = -rxt(276)*y(53) + mat(776) = -rxt(286)*y(53) + mat(1233) = -rxt(315)*y(53) + mat(1531) = -rxt(341)*y(53) + mat(1566) = -rxt(354)*y(53) + mat(259) = -(rxt(422) + rxt(423) + rxt(424)) * y(53) + mat(1499) = -(rxt(426) + rxt(428)) * y(53) + mat(1604) = -rxt(427)*y(53) + mat(676) = -rxt(439)*y(53) + mat(1677) = -rxt(440)*y(53) + mat(717) = -rxt(441)*y(53) + mat(1113) = -rxt(459)*y(53) + mat(418) = -rxt(490)*y(53) + mat(418) = mat(418) + rxt(489)*y(52) + mat(271) = rxt(529)*y(52) + mat(1198) = rxt(280)*y(81) + mat(1113) = mat(1113) + rxt(457)*y(52) + mat(60) = rxt(418)*y(104) + mat(126) = rxt(335)*y(104) + mat(1318) = rxt(489)*y(3) + rxt(529)*y(19) + rxt(457)*y(26) & + + 2.000_r8*rxt(430)*y(54) + rxt(436)*y(55) + rxt(435)*y(57) & + + rxt(107)*y(63) + rxt(434)*y(71) + rxt(131)*y(106) + mat(1677) = mat(1677) + 2.000_r8*rxt(430)*y(52) + rxt(431)*y(55) + rxt(429) & + *y(71) + rxt(432)*y(104) + mat(1499) = mat(1499) + rxt(436)*y(52) + rxt(431)*y(54) + mat(1604) = mat(1604) + rxt(435)*y(52) + mat(232) = rxt(107)*y(52) + mat(676) = mat(676) + rxt(434)*y(52) + rxt(429)*y(54) + mat(1027) = rxt(196)*y(81) + rxt(192)*y(82) + mat(1360) = rxt(161)*y(81) + rxt(157)*y(82) + mat(1444) = rxt(179)*y(81) + rxt(174)*y(82) + mat(776) = mat(776) + rxt(280)*y(23) + rxt(196)*y(73) + rxt(161)*y(75) & + + rxt(179)*y(77) + rxt(249)*y(88) + rxt(232)*y(89) + rxt(214) & + *y(92) + rxt(156)*y(99) + mat(369) = rxt(192)*y(73) + rxt(157)*y(75) + rxt(174)*y(77) + rxt(245)*y(88) & + + rxt(227)*y(89) + rxt(210)*y(92) + rxt(151)*y(99) + mat(823) = rxt(249)*y(81) + rxt(245)*y(82) + mat(865) = rxt(232)*y(81) + rxt(227)*y(82) + mat(985) = rxt(214)*y(81) + rxt(210)*y(82) + rxt(306)*y(104) + mat(1277) = rxt(156)*y(81) + rxt(151)*y(82) + mat(717) = mat(717) + rxt(418)*y(45) + rxt(335)*y(48) + rxt(432)*y(54) & + + rxt(306)*y(92) + mat(1566) = mat(1566) + rxt(131)*y(52) + mat(1692) = -(rxt(429)*y(71) + rxt(430)*y(52) + rxt(431)*y(55) + rxt(432) & + *y(104) + rxt(440)*y(53) + rxt(525)*y(15)) + mat(689) = -rxt(429)*y(54) + mat(1333) = -rxt(430)*y(54) + mat(1514) = -rxt(431)*y(54) + mat(730) = -rxt(432)*y(54) + mat(1086) = -rxt(440)*y(54) + mat(546) = -rxt(525)*y(54) + mat(97) = rxt(491)*y(55) + mat(1213) = rxt(458)*y(27) + mat(1128) = rxt(281)*y(81) + mat(227) = rxt(458)*y(23) + rxt(460)*y(55) + rxt(461)*y(104) + mat(161) = rxt(505)*y(44) + mat(1658) = rxt(505)*y(33) + rxt(442)*y(104) + mat(1086) = mat(1086) + rxt(428)*y(55) + rxt(427)*y(57) + mat(1514) = mat(1514) + rxt(491)*y(4) + rxt(460)*y(27) + rxt(428)*y(53) + mat(1619) = rxt(427)*y(53) + mat(689) = mat(689) + rxt(305)*y(92) + mat(1042) = rxt(195)*y(84) + rxt(188)*y(85) + rxt(193)*y(86) + mat(1375) = rxt(160)*y(84) + (rxt(231)+rxt(257))*y(85) + rxt(158)*y(86) + mat(1459) = rxt(178)*y(84) + (rxt(170)+rxt(258))*y(85) + rxt(175)*y(86) + mat(791) = rxt(281)*y(26) + mat(655) = rxt(236)*y(88) + rxt(218)*y(89) + rxt(201)*y(92) + rxt(143)*y(99) + mat(482) = rxt(195)*y(73) + rxt(160)*y(75) + rxt(178)*y(77) + rxt(248)*y(88) & + + rxt(230)*y(89) + rxt(213)*y(92) + rxt(155)*y(99) + mat(522) = rxt(188)*y(73) + (rxt(231)+rxt(257))*y(75) + (rxt(170)+rxt(258)) & + *y(77) + rxt(240)*y(88) + rxt(223)*y(89) + rxt(205)*y(92) & + + rxt(147)*y(99) + mat(404) = rxt(193)*y(73) + rxt(158)*y(75) + rxt(175)*y(77) + rxt(246)*y(88) & + + rxt(228)*y(89) + rxt(211)*y(92) + rxt(152)*y(99) + mat(462) = rxt(233)*y(88) + rxt(215)*y(89) + rxt(197)*y(92) + rxt(250)*y(99) + mat(838) = rxt(236)*y(83) + rxt(248)*y(84) + rxt(240)*y(85) + rxt(246)*y(86) & + + rxt(233)*y(87) + mat(880) = rxt(218)*y(83) + rxt(230)*y(84) + rxt(223)*y(85) + rxt(228)*y(86) & + + rxt(215)*y(87) + mat(1000) = rxt(305)*y(71) + rxt(201)*y(83) + rxt(213)*y(84) + rxt(205)*y(85) & + + rxt(211)*y(86) + rxt(197)*y(87) + mat(1292) = rxt(143)*y(83) + rxt(155)*y(84) + rxt(147)*y(85) + rxt(152)*y(86) & + + rxt(250)*y(87) + mat(730) = mat(730) + rxt(461)*y(27) + rxt(442)*y(44) + mat(1509) = -(rxt(108)*y(63) + rxt(120)*y(64) + rxt(126)*y(67) + rxt(296) & + *y(83) + (rxt(319) + rxt(320)) * y(98) + (rxt(328) + rxt(329) & + ) * y(101) + rxt(331)*y(102) + rxt(333)*y(103) + rxt(342)*y(105) & + + rxt(355)*y(106) + rxt(398)*y(57) + 4._r8*rxt(399)*y(55) & + + rxt(400)*y(56) + rxt(401)*y(35) + rxt(402)*y(37) + rxt(407) & + *y(71) + rxt(413)*y(104) + (rxt(426) + rxt(428)) * y(53) + rxt(431) & + *y(54) + rxt(436)*y(52) + rxt(460)*y(27) + rxt(462)*y(26) & + + rxt(465)*y(42) + rxt(468)*y(47) + rxt(491)*y(4) + rxt(492) & + *y(3) + rxt(494)*y(38) + rxt(496)*y(46) + rxt(526)*y(15) & + + (rxt(565) + rxt(566)) * y(80) + rxt(567)*y(94)) + mat(236) = -rxt(108)*y(55) + mat(757) = -rxt(120)*y(55) + mat(606) = -rxt(126)*y(55) + mat(652) = -rxt(296)*y(55) + mat(1243) = -(rxt(319) + rxt(320)) * y(55) + mat(386) = -(rxt(328) + rxt(329)) * y(55) + mat(56) = -rxt(331)*y(55) + mat(300) = -rxt(333)*y(55) + mat(1541) = -rxt(342)*y(55) + mat(1576) = -rxt(355)*y(55) + mat(1614) = -rxt(398)*y(55) + mat(1166) = -rxt(400)*y(55) + mat(444) = -rxt(401)*y(55) + mat(116) = -rxt(402)*y(55) + mat(684) = -rxt(407)*y(55) + mat(725) = -rxt(413)*y(55) + mat(1081) = -(rxt(426) + rxt(428)) * y(55) + mat(1687) = -rxt(431)*y(55) + mat(1328) = -rxt(436)*y(55) + mat(225) = -rxt(460)*y(55) + mat(1123) = -rxt(462)*y(55) + mat(919) = -rxt(465)*y(55) + mat(193) = -rxt(468)*y(55) + mat(95) = -rxt(491)*y(55) + mat(423) = -rxt(492)*y(55) + mat(185) = -rxt(494)*y(55) + mat(170) = -rxt(496)*y(55) + mat(541) = -rxt(526)*y(55) + mat(110) = -(rxt(565) + rxt(566)) * y(55) + mat(178) = -rxt(567)*y(55) + mat(1208) = rxt(109)*y(64) + rxt(345)*y(106) + mat(954) = rxt(405)*y(71) + mat(264) = rxt(421)*y(52) + rxt(422)*y(53) + rxt(425)*y(56) + rxt(570)*y(99) + mat(1328) = mat(1328) + rxt(421)*y(49) + rxt(267)*y(101) + mat(1081) = mat(1081) + rxt(422)*y(49) + rxt(354)*y(106) + mat(1166) = mat(1166) + rxt(425)*y(49) + rxt(569)*y(94) + (rxt(387)+rxt(388)) & + *y(95) + rxt(576)*y(107) + rxt(580)*y(108) + mat(1614) = mat(1614) + rxt(358)*y(106) + mat(757) = mat(757) + rxt(109)*y(23) + rxt(181)*y(73) + (rxt(165)+rxt(253)) & + *y(75) + (rxt(163)+rxt(260))*y(77) + rxt(234)*y(88) + rxt(216) & + *y(89) + rxt(199)*y(92) + rxt(251)*y(99) + mat(316) = rxt(189)*y(73) + (rxt(242)+rxt(266))*y(75) + (rxt(171)+rxt(254)) & + *y(77) + rxt(241)*y(88) + rxt(224)*y(89) + rxt(206)*y(92) & + + rxt(148)*y(99) + mat(502) = rxt(191)*y(73) + (rxt(153)+rxt(255))*y(75) + (rxt(173)+rxt(256)) & + *y(77) + rxt(244)*y(88) + rxt(226)*y(89) + rxt(208)*y(92) & + + rxt(150)*y(99) + mat(1412) = rxt(561)*y(88) + 1.150_r8*rxt(562)*y(99) + mat(684) = mat(684) + rxt(405)*y(34) + mat(1037) = rxt(181)*y(64) + rxt(189)*y(65) + rxt(191)*y(66) + mat(1370) = (rxt(165)+rxt(253))*y(64) + (rxt(242)+rxt(266))*y(65) + (rxt(153) & + +rxt(255))*y(66) + mat(1454) = (rxt(163)+rxt(260))*y(64) + (rxt(171)+rxt(254))*y(65) + (rxt(173) & + +rxt(256))*y(66) + mat(153) = rxt(575)*y(107) + mat(833) = rxt(234)*y(64) + rxt(241)*y(65) + rxt(244)*y(66) + rxt(561)*y(68) + mat(875) = rxt(216)*y(64) + rxt(224)*y(65) + rxt(226)*y(66) + mat(995) = rxt(199)*y(64) + rxt(206)*y(65) + rxt(208)*y(66) + mat(178) = mat(178) + rxt(569)*y(56) + mat(574) = (rxt(387)+rxt(388))*y(56) + mat(1287) = rxt(570)*y(49) + rxt(251)*y(64) + rxt(148)*y(65) + rxt(150)*y(66) & + + 1.150_r8*rxt(562)*y(68) + mat(386) = mat(386) + rxt(267)*y(52) + mat(725) = mat(725) + 2.000_r8*rxt(415)*y(104) + mat(1576) = mat(1576) + rxt(345)*y(23) + rxt(354)*y(53) + rxt(358)*y(57) + mat(216) = rxt(576)*y(56) + rxt(575)*y(79) + mat(89) = rxt(580)*y(56) + mat(1158) = -(rxt(121)*y(64) + (rxt(128) + rxt(130)) * y(68) + rxt(317)*y(98) & + + rxt(357)*y(106) + rxt(359)*y(99) + rxt(387)*y(95) + rxt(392) & + *y(96) + rxt(400)*y(55) + rxt(406)*y(34) + rxt(420)*y(79) & + + rxt(425)*y(49) + rxt(564)*y(80) + (rxt(568) + rxt(569) & + ) * y(94) + rxt(576)*y(107) + rxt(580)*y(108)) + mat(749) = -rxt(121)*y(56) + mat(1404) = -(rxt(128) + rxt(130)) * y(56) + mat(1235) = -rxt(317)*y(56) + mat(1568) = -rxt(357)*y(56) + mat(1279) = -rxt(359)*y(56) + mat(568) = -rxt(387)*y(56) + mat(197) = -rxt(392)*y(56) + mat(1501) = -rxt(400)*y(56) + mat(946) = -rxt(406)*y(56) + mat(151) = -rxt(420)*y(56) + mat(260) = -rxt(425)*y(56) + mat(107) = -rxt(564)*y(56) + mat(176) = -(rxt(568) + rxt(569)) * y(56) + mat(213) = -rxt(576)*y(56) + mat(87) = -rxt(580)*y(56) + mat(327) = rxt(483)*y(57) + rxt(482)*y(71) + mat(420) = 2.000_r8*rxt(484)*y(3) + (rxt(486)+rxt(487))*y(26) + rxt(492) & + *y(55) + rxt(488)*y(71) + mat(273) = rxt(528)*y(71) + mat(1200) = rxt(451)*y(57) + rxt(122)*y(67) + rxt(449)*y(71) + rxt(309)*y(98) + mat(1115) = (rxt(486)+rxt(487))*y(3) + (2.000_r8*rxt(453)+2.000_r8*rxt(454)) & + *y(26) + rxt(462)*y(55) + rxt(111)*y(64) + rxt(123)*y(67) & + + rxt(456)*y(71) + rxt(310)*y(98) + rxt(464)*y(104) + rxt(346) & + *y(106) + mat(946) = mat(946) + rxt(409)*y(57) + rxt(403)*y(71) + rxt(326)*y(101) + mat(61) = rxt(418)*y(104) + mat(260) = mat(260) + rxt(424)*y(53) + mat(1320) = rxt(435)*y(57) + rxt(572)*y(99) + rxt(274)*y(101) + mat(1073) = rxt(424)*y(49) + rxt(426)*y(55) + rxt(427)*y(57) + rxt(315)*y(98) & + + rxt(272)*y(101) + mat(1679) = rxt(431)*y(55) + rxt(429)*y(71) + mat(1501) = mat(1501) + rxt(492)*y(3) + rxt(462)*y(26) + rxt(426)*y(53) & + + rxt(431)*y(54) + 2.000_r8*rxt(399)*y(55) + 2.000_r8*rxt(398) & + *y(57) + rxt(108)*y(63) + rxt(126)*y(67) + rxt(407)*y(71) & + + rxt(296)*y(83) + rxt(391)*y(96) + rxt(320)*y(98) + ( & + + 2.000_r8*rxt(328)+rxt(329))*y(101) + rxt(331)*y(102) & + + rxt(413)*y(104) + rxt(355)*y(106) + mat(1158) = mat(1158) + 2.000_r8*rxt(392)*y(96) + mat(1606) = rxt(483)*y(1) + rxt(451)*y(23) + rxt(409)*y(34) + rxt(435)*y(52) & + + rxt(427)*y(53) + 2.000_r8*rxt(398)*y(55) + rxt(127)*y(67) & + + rxt(129)*y(68) + 2.000_r8*rxt(408)*y(71) + rxt(287)*y(81) & + + 2.000_r8*rxt(297)*y(83) + 2.000_r8*rxt(389)*y(95) + rxt(318) & + *y(98) + 3.000_r8*rxt(327)*y(101) + rxt(414)*y(104) + mat(623) = rxt(149)*y(99) + mat(355) = rxt(154)*y(99) + mat(339) = rxt(252)*y(99) + mat(233) = rxt(108)*y(55) + mat(749) = mat(749) + rxt(111)*y(26) + rxt(251)*y(99) + mat(311) = rxt(148)*y(99) + mat(497) = rxt(150)*y(99) + mat(598) = rxt(122)*y(23) + rxt(123)*y(26) + rxt(126)*y(55) + rxt(127)*y(57) & + + rxt(186)*y(73) + rxt(220)*y(75) + rxt(169)*y(77) + rxt(239) & + *y(88) + rxt(222)*y(89) + rxt(204)*y(92) + 2.000_r8*rxt(146) & + *y(99) + mat(1404) = mat(1404) + rxt(129)*y(57) + rxt(321)*y(100) + 2.000_r8*rxt(375) & + *y(103) + mat(284) = rxt(144)*y(99) + mat(678) = rxt(482)*y(1) + rxt(488)*y(3) + rxt(528)*y(19) + rxt(449)*y(23) & + + rxt(456)*y(26) + rxt(403)*y(34) + rxt(429)*y(54) + rxt(407) & + *y(55) + 2.000_r8*rxt(408)*y(57) + 2.000_r8*rxt(417)*y(71) & + + rxt(412)*y(104) + mat(1029) = rxt(186)*y(67) + rxt(185)*y(98) + mat(1362) = rxt(220)*y(67) + rxt(209)*y(98) + mat(1446) = rxt(169)*y(67) + rxt(168)*y(98) + mat(778) = rxt(287)*y(57) + rxt(156)*y(99) + mat(370) = rxt(151)*y(99) + mat(645) = rxt(296)*y(55) + 2.000_r8*rxt(297)*y(57) + rxt(143)*y(99) + mat(475) = rxt(155)*y(99) + mat(515) = rxt(147)*y(99) + mat(398) = rxt(152)*y(99) + mat(456) = rxt(250)*y(99) + mat(825) = rxt(239)*y(67) + rxt(238)*y(98) + mat(867) = rxt(222)*y(67) + rxt(221)*y(98) + mat(987) = rxt(204)*y(67) + rxt(203)*y(98) + mat(568) = mat(568) + 2.000_r8*rxt(389)*y(57) + mat(197) = mat(197) + rxt(391)*y(55) + 2.000_r8*rxt(392)*y(56) & + + 2.000_r8*rxt(316)*y(98) + 2.000_r8*rxt(334)*y(103) + mat(1235) = mat(1235) + rxt(309)*y(23) + rxt(310)*y(26) + rxt(315)*y(53) & + + rxt(320)*y(55) + rxt(318)*y(57) + rxt(185)*y(73) + rxt(209) & + *y(75) + rxt(168)*y(77) + rxt(238)*y(88) + rxt(221)*y(89) & + + rxt(203)*y(92) + 2.000_r8*rxt(316)*y(96) + mat(1279) = mat(1279) + rxt(572)*y(52) + rxt(149)*y(60) + rxt(154)*y(61) & + + rxt(252)*y(62) + rxt(251)*y(64) + rxt(148)*y(65) + rxt(150) & + *y(66) + 2.000_r8*rxt(146)*y(67) + rxt(144)*y(70) + rxt(156) & + *y(81) + rxt(151)*y(82) + rxt(143)*y(83) + rxt(155)*y(84) & + + rxt(147)*y(85) + rxt(152)*y(86) + rxt(250)*y(87) + mat(142) = rxt(321)*y(68) + (rxt(322)+rxt(323))*y(110) + mat(382) = rxt(326)*y(34) + rxt(274)*y(52) + rxt(272)*y(53) + ( & + + 2.000_r8*rxt(328)+rxt(329))*y(55) + 3.000_r8*rxt(327)*y(57) + mat(54) = rxt(331)*y(55) + mat(296) = 2.000_r8*rxt(375)*y(68) + 2.000_r8*rxt(334)*y(96) + rxt(332) & + *y(110) + mat(719) = rxt(464)*y(26) + rxt(418)*y(45) + rxt(413)*y(55) + rxt(414)*y(57) & + + rxt(412)*y(71) + mat(1568) = mat(1568) + rxt(346)*y(26) + rxt(355)*y(55) + mat(1731) = (rxt(322)+rxt(323))*y(100) + rxt(332)*y(103) end subroutine nlnmat03 - subroutine nlnmat04( avec_len, mat, y, rxt ) + subroutine nlnmat04( 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) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) !---------------------------------------------- ! ... local variables !---------------------------------------------- - integer :: k !---------------------------------------------- ! ... complete matrix entries implicit species !---------------------------------------------- - do k = 1,avec_len - mat(k,1277) = -(rxt(k,121)*y(k,65) + (rxt(k,128) + rxt(k,130)) * y(k,69) & - + rxt(k,317)*y(k,98) + rxt(k,357)*y(k,106) + rxt(k,359)*y(k,99) & - + rxt(k,387)*y(k,95) + rxt(k,392)*y(k,96) + rxt(k,400)*y(k,54) & - + rxt(k,406)*y(k,32) + rxt(k,420)*y(k,79) + rxt(k,425)*y(k,48) & - + rxt(k,564)*y(k,80) + (rxt(k,568) + rxt(k,569)) * y(k,94) & - + rxt(k,576)*y(k,107) + rxt(k,580)*y(k,108)) - mat(k,796) = -rxt(k,121)*y(k,55) - mat(k,1029) = -(rxt(k,128) + rxt(k,130)) * y(k,55) - mat(k,1313) = -rxt(k,317)*y(k,55) - mat(k,1638) = -rxt(k,357)*y(k,55) - mat(k,1358) = -rxt(k,359)*y(k,55) - mat(k,582) = -rxt(k,387)*y(k,55) - mat(k,222) = -rxt(k,392)*y(k,55) - mat(k,986) = -rxt(k,400)*y(k,55) - mat(k,1717) = -rxt(k,406)*y(k,55) - mat(k,165) = -rxt(k,420)*y(k,55) - mat(k,278) = -rxt(k,425)*y(k,55) - mat(k,93) = -rxt(k,564)*y(k,55) - mat(k,181) = -(rxt(k,568) + rxt(k,569)) * y(k,55) - mat(k,251) = -rxt(k,576)*y(k,55) - mat(k,69) = -rxt(k,580)*y(k,55) - mat(k,466) = 2.000_r8*rxt(k,484)*y(k,2) + (rxt(k,486)+rxt(k,487))*y(k,24) & - + rxt(k,488)*y(k,43) + rxt(k,492)*y(k,54) - mat(k,262) = rxt(k,528)*y(k,43) - mat(k,1526) = (rxt(k,486)+rxt(k,487))*y(k,2) + (2.000_r8*rxt(k,453) & - +2.000_r8*rxt(k,454))*y(k,24) + rxt(k,456)*y(k,43) + rxt(k,462) & - *y(k,54) + rxt(k,111)*y(k,65) + rxt(k,123)*y(k,68) + rxt(k,310) & - *y(k,98) + rxt(k,464)*y(k,104) + rxt(k,346)*y(k,106) - mat(k,1400) = rxt(k,325)*y(k,101) + rxt(k,330)*y(k,102) - mat(k,1717) = mat(k,1717) + rxt(k,403)*y(k,43) + rxt(k,409)*y(k,56) & - + rxt(k,326)*y(k,101) - mat(k,695) = rxt(k,488)*y(k,2) + rxt(k,528)*y(k,18) + rxt(k,456)*y(k,24) & - + rxt(k,403)*y(k,32) + 2.000_r8*rxt(k,417)*y(k,43) + rxt(k,429) & - *y(k,53) + rxt(k,407)*y(k,54) + 2.000_r8*rxt(k,408)*y(k,56) & - + rxt(k,482)*y(k,59) + rxt(k,449)*y(k,60) + rxt(k,412)*y(k,104) - mat(k,56) = rxt(k,418)*y(k,104) - mat(k,278) = mat(k,278) + rxt(k,424)*y(k,52) - mat(k,1759) = rxt(k,435)*y(k,56) + rxt(k,572)*y(k,99) + rxt(k,274)*y(k,101) - mat(k,1156) = rxt(k,424)*y(k,48) + rxt(k,426)*y(k,54) + rxt(k,427)*y(k,56) & - + rxt(k,315)*y(k,98) + rxt(k,272)*y(k,101) - mat(k,1234) = rxt(k,429)*y(k,43) + rxt(k,431)*y(k,54) - mat(k,986) = mat(k,986) + rxt(k,492)*y(k,2) + rxt(k,462)*y(k,24) + rxt(k,407) & - *y(k,43) + rxt(k,426)*y(k,52) + rxt(k,431)*y(k,53) & - + 2.000_r8*rxt(k,399)*y(k,54) + 2.000_r8*rxt(k,398)*y(k,56) & - + rxt(k,108)*y(k,64) + rxt(k,126)*y(k,68) + rxt(k,296)*y(k,83) & - + rxt(k,391)*y(k,96) + rxt(k,320)*y(k,98) + (2.000_r8*rxt(k,328) & - +rxt(k,329))*y(k,101) + rxt(k,331)*y(k,102) + rxt(k,413) & - *y(k,104) + rxt(k,355)*y(k,106) - mat(k,1277) = mat(k,1277) + 2.000_r8*rxt(k,392)*y(k,96) - mat(k,1438) = rxt(k,409)*y(k,32) + 2.000_r8*rxt(k,408)*y(k,43) + rxt(k,435) & - *y(k,51) + rxt(k,427)*y(k,52) + 2.000_r8*rxt(k,398)*y(k,54) & - + rxt(k,483)*y(k,59) + rxt(k,451)*y(k,60) + rxt(k,127)*y(k,68) & - + rxt(k,129)*y(k,69) + rxt(k,287)*y(k,81) + 2.000_r8*rxt(k,297) & - *y(k,83) + 2.000_r8*rxt(k,389)*y(k,95) + rxt(k,318)*y(k,98) & - + 3.000_r8*rxt(k,327)*y(k,101) + rxt(k,414)*y(k,104) - mat(k,335) = rxt(k,482)*y(k,43) + rxt(k,483)*y(k,56) - mat(k,1681) = rxt(k,449)*y(k,43) + rxt(k,451)*y(k,56) + rxt(k,122)*y(k,68) & - + rxt(k,309)*y(k,98) - mat(k,608) = rxt(k,149)*y(k,99) - mat(k,363) = rxt(k,154)*y(k,99) - mat(k,347) = rxt(k,252)*y(k,99) - mat(k,216) = rxt(k,108)*y(k,54) - mat(k,796) = mat(k,796) + rxt(k,111)*y(k,24) + rxt(k,251)*y(k,99) - mat(k,319) = rxt(k,148)*y(k,99) - mat(k,509) = rxt(k,150)*y(k,99) - mat(k,634) = rxt(k,123)*y(k,24) + rxt(k,126)*y(k,54) + rxt(k,127)*y(k,56) & - + rxt(k,122)*y(k,60) + rxt(k,186)*y(k,73) + rxt(k,220)*y(k,75) & - + rxt(k,169)*y(k,77) + rxt(k,239)*y(k,88) + rxt(k,222)*y(k,89) & - + rxt(k,204)*y(k,92) + 2.000_r8*rxt(k,146)*y(k,99) - mat(k,1029) = mat(k,1029) + rxt(k,129)*y(k,56) + rxt(k,321)*y(k,100) & - + 2.000_r8*rxt(k,375)*y(k,103) - mat(k,304) = rxt(k,144)*y(k,99) - mat(k,839) = rxt(k,186)*y(k,68) + rxt(k,185)*y(k,98) - mat(k,1199) = rxt(k,220)*y(k,68) + rxt(k,209)*y(k,98) - mat(k,1569) = rxt(k,169)*y(k,68) + rxt(k,168)*y(k,98) - mat(k,724) = rxt(k,287)*y(k,56) + rxt(k,156)*y(k,99) - mat(k,379) = rxt(k,151)*y(k,99) - mat(k,664) = rxt(k,296)*y(k,54) + 2.000_r8*rxt(k,297)*y(k,56) + rxt(k,143) & - *y(k,99) - mat(k,489) = rxt(k,155)*y(k,99) - mat(k,530) = rxt(k,147)*y(k,99) - mat(k,394) = rxt(k,152)*y(k,99) - mat(k,447) = rxt(k,250)*y(k,99) - mat(k,887) = rxt(k,239)*y(k,68) + rxt(k,238)*y(k,98) - mat(k,930) = rxt(k,222)*y(k,68) + rxt(k,221)*y(k,98) - mat(k,1071) = rxt(k,204)*y(k,68) + rxt(k,203)*y(k,98) - mat(k,582) = mat(k,582) + 2.000_r8*rxt(k,389)*y(k,56) - mat(k,222) = mat(k,222) + rxt(k,391)*y(k,54) + 2.000_r8*rxt(k,392)*y(k,55) & - + 2.000_r8*rxt(k,316)*y(k,98) + 2.000_r8*rxt(k,334)*y(k,103) - mat(k,1313) = mat(k,1313) + rxt(k,310)*y(k,24) + rxt(k,315)*y(k,52) & - + rxt(k,320)*y(k,54) + rxt(k,318)*y(k,56) + rxt(k,309)*y(k,60) & - + rxt(k,185)*y(k,73) + rxt(k,209)*y(k,75) + rxt(k,168)*y(k,77) & - + rxt(k,238)*y(k,88) + rxt(k,221)*y(k,89) + rxt(k,203)*y(k,92) & - + 2.000_r8*rxt(k,316)*y(k,96) - mat(k,1358) = mat(k,1358) + rxt(k,572)*y(k,51) + rxt(k,149)*y(k,61) & - + rxt(k,154)*y(k,62) + rxt(k,252)*y(k,63) + rxt(k,251)*y(k,65) & - + rxt(k,148)*y(k,66) + rxt(k,150)*y(k,67) + 2.000_r8*rxt(k,146) & - *y(k,68) + rxt(k,144)*y(k,71) + rxt(k,156)*y(k,81) + rxt(k,151) & - *y(k,82) + rxt(k,143)*y(k,83) + rxt(k,155)*y(k,84) + rxt(k,147) & - *y(k,85) + rxt(k,152)*y(k,86) + rxt(k,250)*y(k,87) - mat(k,146) = rxt(k,321)*y(k,69) + (rxt(k,322)+rxt(k,323))*y(k,110) - mat(k,408) = rxt(k,325)*y(k,28) + rxt(k,326)*y(k,32) + rxt(k,274)*y(k,51) & - + rxt(k,272)*y(k,52) + (2.000_r8*rxt(k,328)+rxt(k,329))*y(k,54) & - + 3.000_r8*rxt(k,327)*y(k,56) - mat(k,99) = rxt(k,330)*y(k,28) + rxt(k,331)*y(k,54) - mat(k,290) = 2.000_r8*rxt(k,375)*y(k,69) + 2.000_r8*rxt(k,334)*y(k,96) & - + rxt(k,332)*y(k,110) - mat(k,764) = rxt(k,464)*y(k,24) + rxt(k,412)*y(k,43) + rxt(k,418)*y(k,44) & - + rxt(k,413)*y(k,54) + rxt(k,414)*y(k,56) - mat(k,1638) = mat(k,1638) + rxt(k,346)*y(k,24) + rxt(k,355)*y(k,54) - mat(k,1812) = (rxt(k,322)+rxt(k,323))*y(k,100) + rxt(k,332)*y(k,103) - mat(k,1442) = -(rxt(k,127)*y(k,68) + rxt(k,129)*y(k,69) + rxt(k,287)*y(k,81) & - + rxt(k,297)*y(k,83) + rxt(k,318)*y(k,98) + rxt(k,327)*y(k,101) & - + rxt(k,343)*y(k,105) + rxt(k,358)*y(k,106) + rxt(k,389)*y(k,95) & - + rxt(k,398)*y(k,54) + rxt(k,408)*y(k,43) + rxt(k,409)*y(k,32) & - + rxt(k,414)*y(k,104) + rxt(k,427)*y(k,52) + rxt(k,435)*y(k,51) & - + rxt(k,451)*y(k,60) + rxt(k,483)*y(k,59)) - mat(k,638) = -rxt(k,127)*y(k,56) - mat(k,1033) = -rxt(k,129)*y(k,56) - mat(k,726) = -rxt(k,287)*y(k,56) - mat(k,666) = -rxt(k,297)*y(k,56) - mat(k,1317) = -rxt(k,318)*y(k,56) - mat(k,411) = -rxt(k,327)*y(k,56) - mat(k,1606) = -rxt(k,343)*y(k,56) - mat(k,1642) = -rxt(k,358)*y(k,56) - mat(k,586) = -rxt(k,389)*y(k,56) - mat(k,990) = -rxt(k,398)*y(k,56) - mat(k,699) = -rxt(k,408)*y(k,56) - mat(k,1721) = -rxt(k,409)*y(k,56) - mat(k,768) = -rxt(k,414)*y(k,56) - mat(k,1160) = -rxt(k,427)*y(k,56) - mat(k,1763) = -rxt(k,435)*y(k,56) - mat(k,1685) = -rxt(k,451)*y(k,56) - mat(k,337) = -rxt(k,483)*y(k,56) - mat(k,1160) = mat(k,1160) + rxt(k,273)*y(k,101) - mat(k,990) = mat(k,990) + rxt(k,400)*y(k,55) + rxt(k,319)*y(k,98) & - + rxt(k,333)*y(k,103) - mat(k,1281) = rxt(k,400)*y(k,54) - mat(k,225) = rxt(k,356)*y(k,106) - mat(k,1317) = mat(k,1317) + rxt(k,319)*y(k,54) - mat(k,411) = mat(k,411) + rxt(k,273)*y(k,52) - mat(k,293) = rxt(k,333)*y(k,54) - mat(k,1642) = mat(k,1642) + rxt(k,356)*y(k,96) - mat(k,452) = rxt(k,485)*y(k,24) - mat(k,1498) = rxt(k,485)*y(k,2) + 2.000_r8*rxt(k,455)*y(k,24) - mat(k,328) = -(rxt(k,481)*y(k,14) + rxt(k,482)*y(k,43) + rxt(k,483)*y(k,56)) - mat(k,538) = -rxt(k,481)*y(k,59) - mat(k,681) = -rxt(k,482)*y(k,59) - mat(k,1417) = -rxt(k,483)*y(k,59) - mat(k,456) = 4.000_r8*rxt(k,484)*y(k,2) + (rxt(k,485)+rxt(k,486))*y(k,24) & - + rxt(k,489)*y(k,51) + rxt(k,492)*y(k,54) + rxt(k,493)*y(k,104) - mat(k,1505) = (rxt(k,485)+rxt(k,486))*y(k,2) - mat(k,192) = rxt(k,494)*y(k,54) + rxt(k,500)*y(k,95) + rxt(k,495)*y(k,104) - mat(k,1735) = rxt(k,489)*y(k,2) - mat(k,963) = rxt(k,492)*y(k,2) + rxt(k,494)*y(k,36) - mat(k,569) = rxt(k,500)*y(k,36) - mat(k,749) = rxt(k,493)*y(k,2) + rxt(k,495)*y(k,36) - mat(k,1691) = -((rxt(k,109) + rxt(k,110)) * y(k,65) + rxt(k,122)*y(k,68) & - + rxt(k,280)*y(k,81) + rxt(k,309)*y(k,98) + rxt(k,336)*y(k,105) & - + rxt(k,345)*y(k,106) + rxt(k,445)*y(k,14) + rxt(k,447)*y(k,33) & - + rxt(k,448)*y(k,35) + (rxt(k,449) + rxt(k,450)) * y(k,43) & - + rxt(k,451)*y(k,56) + rxt(k,458)*y(k,25) + rxt(k,467)*y(k,46)) - mat(k,806) = -(rxt(k,109) + rxt(k,110)) * y(k,60) - mat(k,644) = -rxt(k,122)*y(k,60) - mat(k,731) = -rxt(k,280)*y(k,60) - mat(k,1323) = -rxt(k,309)*y(k,60) - mat(k,1612) = -rxt(k,336)*y(k,60) - mat(k,1648) = -rxt(k,345)*y(k,60) - mat(k,557) = -rxt(k,445)*y(k,60) - mat(k,434) = -rxt(k,447)*y(k,60) - mat(k,84) = -rxt(k,448)*y(k,60) - mat(k,704) = -(rxt(k,449) + rxt(k,450)) * y(k,60) - mat(k,1448) = -rxt(k,451)*y(k,60) - mat(k,209) = -rxt(k,458)*y(k,60) - mat(k,189) = -rxt(k,467)*y(k,60) - mat(k,471) = rxt(k,486)*y(k,24) - mat(k,264) = rxt(k,452)*y(k,24) - mat(k,1536) = rxt(k,486)*y(k,2) + rxt(k,452)*y(k,18) + (4.000_r8*rxt(k,453) & - +2.000_r8*rxt(k,455))*y(k,24) + rxt(k,457)*y(k,51) + rxt(k,462) & - *y(k,54) + rxt(k,463)*y(k,104) - mat(k,15) = rxt(k,507)*y(k,95) - mat(k,1493) = rxt(k,465)*y(k,54) + rxt(k,477)*y(k,95) + rxt(k,466)*y(k,104) - mat(k,1769) = rxt(k,457)*y(k,24) + rxt(k,106)*y(k,64) - mat(k,1166) = rxt(k,105)*y(k,61) - mat(k,996) = rxt(k,462)*y(k,24) + rxt(k,465)*y(k,40) - mat(k,612) = rxt(k,105)*y(k,52) + rxt(k,190)*y(k,73) + rxt(k,142)*y(k,75) & - + rxt(k,172)*y(k,77) + rxt(k,243)*y(k,88) + rxt(k,225)*y(k,89) & - + rxt(k,207)*y(k,92) + rxt(k,149)*y(k,99) - mat(k,367) = rxt(k,194)*y(k,73) + rxt(k,159)*y(k,75) + rxt(k,177)*y(k,77) & - + rxt(k,247)*y(k,88) + rxt(k,229)*y(k,89) + rxt(k,212)*y(k,92) & - + rxt(k,154)*y(k,99) - mat(k,351) = rxt(k,182)*y(k,73) + rxt(k,176)*y(k,75) + rxt(k,164)*y(k,77) & - + rxt(k,235)*y(k,88) + rxt(k,217)*y(k,89) + rxt(k,200)*y(k,92) & - + rxt(k,252)*y(k,99) - mat(k,217) = rxt(k,106)*y(k,51) - mat(k,849) = rxt(k,190)*y(k,61) + rxt(k,194)*y(k,62) + rxt(k,182)*y(k,63) - mat(k,1209) = rxt(k,142)*y(k,61) + rxt(k,159)*y(k,62) + rxt(k,176)*y(k,63) - mat(k,1579) = rxt(k,172)*y(k,61) + rxt(k,177)*y(k,62) + rxt(k,164)*y(k,63) - mat(k,897) = rxt(k,243)*y(k,61) + rxt(k,247)*y(k,62) + rxt(k,235)*y(k,63) - mat(k,940) = rxt(k,225)*y(k,61) + rxt(k,229)*y(k,62) + rxt(k,217)*y(k,63) - mat(k,1081) = rxt(k,207)*y(k,61) + rxt(k,212)*y(k,62) + rxt(k,200)*y(k,63) - mat(k,591) = rxt(k,507)*y(k,30) + rxt(k,477)*y(k,40) - mat(k,1368) = rxt(k,149)*y(k,61) + rxt(k,154)*y(k,62) + rxt(k,252)*y(k,63) - mat(k,773) = rxt(k,463)*y(k,24) + rxt(k,466)*y(k,40) - end do + mat(1617) = -(rxt(127)*y(67) + rxt(129)*y(68) + rxt(287)*y(81) + rxt(297) & + *y(83) + rxt(318)*y(98) + rxt(327)*y(101) + rxt(343)*y(105) & + + rxt(358)*y(106) + rxt(389)*y(95) + rxt(398)*y(55) + rxt(408) & + *y(71) + rxt(409)*y(34) + rxt(414)*y(104) + rxt(427)*y(53) & + + rxt(435)*y(52) + rxt(451)*y(23) + rxt(483)*y(1)) + mat(609) = -rxt(127)*y(57) + mat(1415) = -rxt(129)*y(57) + mat(789) = -rxt(287)*y(57) + mat(653) = -rxt(297)*y(57) + mat(1246) = -rxt(318)*y(57) + mat(389) = -rxt(327)*y(57) + mat(1544) = -rxt(343)*y(57) + mat(1579) = -rxt(358)*y(57) + mat(577) = -rxt(389)*y(57) + mat(1512) = -rxt(398)*y(57) + mat(687) = -rxt(408)*y(57) + mat(957) = -rxt(409)*y(57) + mat(728) = -rxt(414)*y(57) + mat(1084) = -rxt(427)*y(57) + mat(1331) = -rxt(435)*y(57) + mat(1211) = -rxt(451)*y(57) + mat(329) = -rxt(483)*y(57) + mat(1084) = mat(1084) + rxt(273)*y(101) + mat(1512) = mat(1512) + rxt(400)*y(56) + rxt(319)*y(98) + rxt(333)*y(103) + mat(1169) = rxt(400)*y(55) + mat(202) = rxt(356)*y(106) + mat(1246) = mat(1246) + rxt(319)*y(55) + mat(389) = mat(389) + rxt(273)*y(53) + mat(302) = rxt(333)*y(55) + mat(1579) = mat(1579) + rxt(356)*y(96) + mat(406) = rxt(485)*y(26) + mat(1089) = rxt(485)*y(3) + 2.000_r8*rxt(455)*y(26) + mat(613) = -(rxt(100)*y(34) + rxt(102)*y(110) + rxt(103)*y(42) + rxt(104) & + *y(44) + rxt(105)*y(53) + rxt(142)*y(75) + rxt(149)*y(99) & + + rxt(172)*y(77) + rxt(190)*y(73) + rxt(207)*y(92) + rxt(225) & + *y(89) + rxt(243)*y(88)) + mat(932) = -rxt(100)*y(60) + mat(1717) = -rxt(102)*y(60) + mat(897) = -rxt(103)*y(60) + mat(1631) = -rxt(104)*y(60) + mat(1059) = -rxt(105)*y(60) + mat(1348) = -rxt(142)*y(60) + mat(1265) = -rxt(149)*y(60) + mat(1432) = -rxt(172)*y(60) + mat(1015) = -rxt(190)*y(60) + mat(973) = -rxt(207)*y(60) + mat(853) = -rxt(225)*y(60) + mat(811) = -rxt(243)*y(60) + mat(1186) = rxt(109)*y(64) + rxt(122)*y(67) + rxt(280)*y(81) + rxt(309)*y(98) & + + rxt(336)*y(105) + rxt(345)*y(106) + mat(1101) = rxt(111)*y(64) + rxt(281)*y(81) + rxt(346)*y(106) + mat(897) = mat(897) + rxt(125)*y(67) + rxt(284)*y(81) + rxt(293)*y(83) & + + rxt(313)*y(98) + rxt(340)*y(105) + rxt(351)*y(106) + mat(1306) = rxt(107)*y(63) + mat(1487) = rxt(108)*y(63) + mat(230) = rxt(107)*y(52) + rxt(108)*y(55) + mat(736) = rxt(109)*y(23) + rxt(111)*y(26) + mat(584) = rxt(122)*y(23) + rxt(125)*y(42) + mat(766) = rxt(280)*y(23) + rxt(281)*y(26) + rxt(284)*y(42) + mat(635) = rxt(293)*y(42) + mat(1221) = rxt(309)*y(23) + rxt(313)*y(42) + mat(1519) = rxt(336)*y(23) + rxt(340)*y(42) + mat(1554) = rxt(345)*y(23) + rxt(346)*y(26) + rxt(351)*y(42) + mat(347) = -(rxt(101)*y(42) + rxt(154)*y(99) + rxt(159)*y(75) + rxt(177) & + *y(77) + rxt(194)*y(73) + rxt(212)*y(92) + rxt(229)*y(89) & + + rxt(247)*y(88)) + mat(890) = -rxt(101)*y(61) + mat(1256) = -rxt(154)*y(61) + mat(1340) = -rxt(159)*y(61) + mat(1424) = -rxt(177)*y(61) + mat(1007) = -rxt(194)*y(61) + mat(965) = -rxt(212)*y(61) + mat(845) = -rxt(229)*y(61) + mat(802) = -rxt(247)*y(61) + mat(612) = rxt(102)*y(110) + mat(1709) = rxt(102)*y(60) + mat(331) = -((rxt(164) + rxt(263)) * y(77) + (rxt(176) + rxt(262)) * y(75) & + + rxt(182)*y(73) + rxt(200)*y(92) + rxt(217)*y(89) + rxt(235) & + *y(88) + rxt(252)*y(99)) + mat(1423) = -(rxt(164) + rxt(263)) * y(62) + mat(1339) = -(rxt(176) + rxt(262)) * y(62) + mat(1006) = -rxt(182)*y(62) + mat(964) = -rxt(200)*y(62) + mat(844) = -rxt(217)*y(62) + mat(801) = -rxt(235)*y(62) + mat(1255) = -rxt(252)*y(62) + mat(889) = rxt(103)*y(60) + rxt(101)*y(61) + mat(611) = rxt(103)*y(42) + mat(346) = rxt(101)*y(42) + mat(229) = -((rxt(106) + rxt(107)) * y(52) + rxt(108)*y(55)) + mat(1295) = -(rxt(106) + rxt(107)) * y(63) + mat(1477) = -rxt(108)*y(63) + mat(1178) = rxt(110)*y(64) + mat(1094) = rxt(123)*y(67) + rxt(310)*y(98) + rxt(337)*y(105) + mat(732) = rxt(110)*y(23) + mat(581) = rxt(123)*y(26) + mat(1217) = rxt(310)*y(26) + mat(1516) = rxt(337)*y(26) + mat(739) = -((rxt(109) + rxt(110)) * y(23) + rxt(111)*y(26) + rxt(112)*y(34) & + + rxt(114)*y(110) + rxt(119)*y(44) + rxt(120)*y(55) + rxt(121) & + *y(56) + (rxt(163) + rxt(260)) * y(77) + (rxt(165) + rxt(253) & + ) * y(75) + rxt(181)*y(73) + rxt(199)*y(92) + rxt(216)*y(89) & + + rxt(234)*y(88) + rxt(251)*y(99) + rxt(275)*y(52) + rxt(276) & + *y(53)) + mat(1190) = -(rxt(109) + rxt(110)) * y(64) + mat(1105) = -rxt(111)*y(64) + mat(936) = -rxt(112)*y(64) + mat(1721) = -rxt(114)*y(64) + mat(1635) = -rxt(119)*y(64) + mat(1491) = -rxt(120)*y(64) + mat(1148) = -rxt(121)*y(64) + mat(1436) = -(rxt(163) + rxt(260)) * y(64) + mat(1352) = -(rxt(165) + rxt(253)) * y(64) + mat(1019) = -rxt(181)*y(64) + mat(977) = -rxt(199)*y(64) + mat(857) = -rxt(216)*y(64) + mat(815) = -rxt(234)*y(64) + mat(1269) = -rxt(251)*y(64) + mat(1310) = -rxt(275)*y(64) + mat(1063) = -rxt(276)*y(64) + mat(936) = mat(936) + rxt(124)*y(67) + mat(1491) = mat(1491) + rxt(126)*y(67) + mat(588) = rxt(124)*y(34) + rxt(126)*y(55) + mat(304) = -(rxt(148)*y(99) + (rxt(171) + rxt(254)) * y(77) + rxt(189)*y(73) & + + rxt(206)*y(92) + rxt(224)*y(89) + rxt(241)*y(88) + (rxt(242) & + + rxt(266)) * y(75)) + mat(1254) = -rxt(148)*y(65) + mat(1422) = -(rxt(171) + rxt(254)) * y(65) + mat(1005) = -rxt(189)*y(65) + mat(963) = -rxt(206)*y(65) + mat(843) = -rxt(224)*y(65) + mat(800) = -rxt(241)*y(65) + mat(1338) = -(rxt(242) + rxt(266)) * y(65) + mat(484) = rxt(113)*y(110) + mat(1708) = rxt(113)*y(66) + mat(486) = -(rxt(113)*y(110) + (rxt(115) + rxt(116)) * y(53) + (rxt(117) & + + rxt(118)) * y(52) + rxt(150)*y(99) + (rxt(153) + rxt(255) & + ) * y(75) + (rxt(173) + rxt(256)) * y(77) + rxt(191)*y(73) & + + rxt(208)*y(92) + rxt(226)*y(89) + rxt(244)*y(88)) + mat(1713) = -rxt(113)*y(66) + mat(1055) = -(rxt(115) + rxt(116)) * y(66) + mat(1302) = -(rxt(117) + rxt(118)) * y(66) + mat(1261) = -rxt(150)*y(66) + mat(1345) = -(rxt(153) + rxt(255)) * y(66) + mat(1429) = -(rxt(173) + rxt(256)) * y(66) + mat(1012) = -rxt(191)*y(66) + mat(970) = -rxt(208)*y(66) + mat(850) = -rxt(226)*y(66) + mat(807) = -rxt(244)*y(66) + mat(734) = rxt(114)*y(110) + mat(1713) = mat(1713) + rxt(114)*y(64) + mat(583) = -(rxt(122)*y(23) + rxt(123)*y(26) + rxt(124)*y(34) + rxt(125) & + *y(42) + rxt(126)*y(55) + rxt(127)*y(57) + rxt(146)*y(99) & + + rxt(169)*y(77) + rxt(186)*y(73) + rxt(204)*y(92) + rxt(220) & + *y(75) + rxt(222)*y(89) + rxt(239)*y(88)) + mat(1185) = -rxt(122)*y(67) + mat(1100) = -rxt(123)*y(67) + mat(931) = -rxt(124)*y(67) + mat(896) = -rxt(125)*y(67) + mat(1486) = -rxt(126)*y(67) + mat(1591) = -rxt(127)*y(67) + mat(1264) = -rxt(146)*y(67) + mat(1431) = -rxt(169)*y(67) + mat(1014) = -rxt(186)*y(67) + mat(972) = -rxt(204)*y(67) + mat(1347) = -rxt(220)*y(67) + mat(852) = -rxt(222)*y(67) + mat(810) = -rxt(239)*y(67) + mat(1410) = -((rxt(128) + rxt(130)) * y(56) + rxt(129)*y(57) + rxt(133)*y(69) & + + rxt(136)*y(75) + rxt(139)*y(77) + rxt(298)*y(89) + rxt(299) & + *y(90) + rxt(301)*y(91) + rxt(303)*y(92) + rxt(321)*y(100) & + + rxt(375)*y(103) + rxt(376)*y(78) + rxt(377)*y(72) + rxt(378) & + *y(73) + rxt(379)*y(93) + rxt(561)*y(88) + rxt(562)*y(99) & + + rxt(563)*y(80)) + mat(1164) = -(rxt(128) + rxt(130)) * y(68) + mat(1612) = -rxt(129)*y(68) + mat(43) = -rxt(133)*y(68) + mat(1368) = -rxt(136)*y(68) + mat(1452) = -rxt(139)*y(68) + mat(873) = -rxt(298)*y(68) + mat(49) = -rxt(299)*y(68) + mat(75) = -rxt(301)*y(68) + mat(993) = -rxt(303)*y(68) + mat(144) = -rxt(321)*y(68) + mat(299) = -rxt(375)*y(68) + mat(133) = -rxt(376)*y(68) + mat(122) = -rxt(377)*y(68) + mat(1035) = -rxt(378)*y(68) + mat(69) = -rxt(379)*y(68) + mat(831) = -rxt(561)*y(68) + mat(1285) = -rxt(562)*y(68) + mat(109) = -rxt(563)*y(68) + mat(952) = rxt(100)*y(60) + rxt(312)*y(98) + rxt(339)*y(105) + mat(443) = rxt(348)*y(106) + mat(1326) = rxt(131)*y(106) + mat(1507) = rxt(319)*y(98) + rxt(328)*y(101) + rxt(342)*y(105) + rxt(355) & + *y(106) + mat(1612) = mat(1612) + rxt(327)*y(101) + mat(628) = rxt(100)*y(34) + mat(200) = rxt(316)*y(98) + rxt(356)*y(106) + mat(1241) = rxt(312)*y(34) + rxt(319)*y(55) + rxt(316)*y(96) + mat(385) = rxt(328)*y(55) + rxt(327)*y(57) + mat(1539) = rxt(339)*y(34) + rxt(342)*y(55) + mat(1574) = rxt(348)*y(35) + rxt(131)*y(52) + rxt(355)*y(55) + rxt(356)*y(96) end subroutine nlnmat04 - subroutine nlnmat05( avec_len, mat, y, rxt ) + subroutine nlnmat05( 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) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) !---------------------------------------------- ! ... local variables !---------------------------------------------- - integer :: k !---------------------------------------------- ! ... complete matrix entries implicit species !---------------------------------------------- - do k = 1,avec_len - mat(k,597) = -(rxt(k,100)*y(k,32) + rxt(k,102)*y(k,110) + rxt(k,103)*y(k,40) & - + rxt(k,104)*y(k,42) + rxt(k,105)*y(k,52) + rxt(k,142)*y(k,75) & - + rxt(k,149)*y(k,99) + rxt(k,172)*y(k,77) + rxt(k,190)*y(k,73) & - + rxt(k,207)*y(k,92) + rxt(k,225)*y(k,89) + rxt(k,243)*y(k,88)) - mat(k,1700) = -rxt(k,100)*y(k,61) - mat(k,1796) = -rxt(k,102)*y(k,61) - mat(k,1466) = -rxt(k,103)*y(k,61) - mat(k,1095) = -rxt(k,104)*y(k,61) - mat(k,1140) = -rxt(k,105)*y(k,61) - mat(k,1182) = -rxt(k,142)*y(k,61) - mat(k,1341) = -rxt(k,149)*y(k,61) - mat(k,1552) = -rxt(k,172)*y(k,61) - mat(k,822) = -rxt(k,190)*y(k,61) - mat(k,1054) = -rxt(k,207)*y(k,61) - mat(k,913) = -rxt(k,225)*y(k,61) - mat(k,870) = -rxt(k,243)*y(k,61) - mat(k,1509) = rxt(k,111)*y(k,65) + rxt(k,281)*y(k,81) + rxt(k,346)*y(k,106) - mat(k,1466) = mat(k,1466) + rxt(k,125)*y(k,68) + rxt(k,284)*y(k,81) & - + rxt(k,293)*y(k,83) + rxt(k,313)*y(k,98) + rxt(k,340)*y(k,105) & - + rxt(k,351)*y(k,106) - mat(k,1743) = rxt(k,107)*y(k,64) - mat(k,969) = rxt(k,108)*y(k,64) - mat(k,1664) = rxt(k,109)*y(k,65) + rxt(k,122)*y(k,68) + rxt(k,280)*y(k,81) & - + rxt(k,309)*y(k,98) + rxt(k,336)*y(k,105) + rxt(k,345)*y(k,106) - mat(k,212) = rxt(k,107)*y(k,51) + rxt(k,108)*y(k,54) - mat(k,781) = rxt(k,111)*y(k,24) + rxt(k,109)*y(k,60) - mat(k,618) = rxt(k,125)*y(k,40) + rxt(k,122)*y(k,60) - mat(k,710) = rxt(k,281)*y(k,24) + rxt(k,284)*y(k,40) + rxt(k,280)*y(k,60) - mat(k,651) = rxt(k,293)*y(k,40) - mat(k,1296) = rxt(k,313)*y(k,40) + rxt(k,309)*y(k,60) - mat(k,1586) = rxt(k,340)*y(k,40) + rxt(k,336)*y(k,60) - mat(k,1622) = rxt(k,346)*y(k,24) + rxt(k,351)*y(k,40) + rxt(k,345)*y(k,60) - mat(k,356) = -(rxt(k,101)*y(k,40) + rxt(k,154)*y(k,99) + rxt(k,159)*y(k,75) & - + rxt(k,177)*y(k,77) + rxt(k,194)*y(k,73) + rxt(k,212)*y(k,92) & - + rxt(k,229)*y(k,89) + rxt(k,247)*y(k,88)) - mat(k,1460) = -rxt(k,101)*y(k,62) - mat(k,1333) = -rxt(k,154)*y(k,62) - mat(k,1175) = -rxt(k,159)*y(k,62) - mat(k,1545) = -rxt(k,177)*y(k,62) - mat(k,815) = -rxt(k,194)*y(k,62) - mat(k,1047) = -rxt(k,212)*y(k,62) - mat(k,906) = -rxt(k,229)*y(k,62) - mat(k,862) = -rxt(k,247)*y(k,62) - mat(k,596) = rxt(k,102)*y(k,110) - mat(k,1788) = rxt(k,102)*y(k,61) - mat(k,340) = -((rxt(k,164) + rxt(k,263)) * y(k,77) + (rxt(k,176) + rxt(k,262) & - ) * y(k,75) + rxt(k,182)*y(k,73) + rxt(k,200)*y(k,92) + rxt(k,217) & - *y(k,89) + rxt(k,235)*y(k,88) + rxt(k,252)*y(k,99)) - mat(k,1544) = -(rxt(k,164) + rxt(k,263)) * y(k,63) - mat(k,1174) = -(rxt(k,176) + rxt(k,262)) * y(k,63) - mat(k,814) = -rxt(k,182)*y(k,63) - mat(k,1046) = -rxt(k,200)*y(k,63) - mat(k,905) = -rxt(k,217)*y(k,63) - mat(k,861) = -rxt(k,235)*y(k,63) - mat(k,1332) = -rxt(k,252)*y(k,63) - mat(k,1459) = rxt(k,103)*y(k,61) + rxt(k,101)*y(k,62) - mat(k,595) = rxt(k,103)*y(k,40) - mat(k,355) = rxt(k,101)*y(k,40) - mat(k,211) = -((rxt(k,106) + rxt(k,107)) * y(k,51) + rxt(k,108)*y(k,54)) - mat(k,1732) = -(rxt(k,106) + rxt(k,107)) * y(k,64) - mat(k,958) = -rxt(k,108)*y(k,64) - mat(k,1503) = rxt(k,123)*y(k,68) + rxt(k,310)*y(k,98) + rxt(k,337)*y(k,105) - mat(k,1657) = rxt(k,110)*y(k,65) - mat(k,777) = rxt(k,110)*y(k,60) - mat(k,616) = rxt(k,123)*y(k,24) - mat(k,1292) = rxt(k,310)*y(k,24) - mat(k,1583) = rxt(k,337)*y(k,24) - mat(k,785) = -((rxt(k,109) + rxt(k,110)) * y(k,60) + rxt(k,111)*y(k,24) & - + rxt(k,112)*y(k,32) + rxt(k,114)*y(k,110) + rxt(k,119)*y(k,42) & - + rxt(k,120)*y(k,54) + rxt(k,121)*y(k,55) + (rxt(k,163) & - + rxt(k,260)) * y(k,77) + (rxt(k,165) + rxt(k,253)) * y(k,75) & - + rxt(k,181)*y(k,73) + rxt(k,199)*y(k,92) + rxt(k,216)*y(k,89) & - + rxt(k,234)*y(k,88) + rxt(k,251)*y(k,99) + rxt(k,275)*y(k,51) & - + rxt(k,276)*y(k,52)) - mat(k,1670) = -(rxt(k,109) + rxt(k,110)) * y(k,65) - mat(k,1515) = -rxt(k,111)*y(k,65) - mat(k,1706) = -rxt(k,112)*y(k,65) - mat(k,1801) = -rxt(k,114)*y(k,65) - mat(k,1100) = -rxt(k,119)*y(k,65) - mat(k,975) = -rxt(k,120)*y(k,65) - mat(k,1266) = -rxt(k,121)*y(k,65) - mat(k,1558) = -(rxt(k,163) + rxt(k,260)) * y(k,65) - mat(k,1188) = -(rxt(k,165) + rxt(k,253)) * y(k,65) - mat(k,828) = -rxt(k,181)*y(k,65) - mat(k,1060) = -rxt(k,199)*y(k,65) - mat(k,919) = -rxt(k,216)*y(k,65) - mat(k,876) = -rxt(k,234)*y(k,65) - mat(k,1347) = -rxt(k,251)*y(k,65) - mat(k,1748) = -rxt(k,275)*y(k,65) - mat(k,1145) = -rxt(k,276)*y(k,65) - mat(k,1389) = rxt(k,325)*y(k,101) + rxt(k,347)*y(k,106) - mat(k,1706) = mat(k,1706) + rxt(k,124)*y(k,68) - mat(k,975) = mat(k,975) + rxt(k,126)*y(k,68) - mat(k,624) = rxt(k,124)*y(k,32) + rxt(k,126)*y(k,54) - mat(k,404) = rxt(k,325)*y(k,28) - mat(k,1627) = rxt(k,347)*y(k,28) - mat(k,311) = -(rxt(k,148)*y(k,99) + (rxt(k,171) + rxt(k,254)) * y(k,77) & - + rxt(k,189)*y(k,73) + rxt(k,206)*y(k,92) + rxt(k,224)*y(k,89) & - + rxt(k,241)*y(k,88) + (rxt(k,242) + rxt(k,266)) * y(k,75)) - mat(k,1331) = -rxt(k,148)*y(k,66) - mat(k,1543) = -(rxt(k,171) + rxt(k,254)) * y(k,66) - mat(k,813) = -rxt(k,189)*y(k,66) - mat(k,1045) = -rxt(k,206)*y(k,66) - mat(k,904) = -rxt(k,224)*y(k,66) - mat(k,860) = -rxt(k,241)*y(k,66) - mat(k,1173) = -(rxt(k,242) + rxt(k,266)) * y(k,66) - mat(k,495) = rxt(k,113)*y(k,110) - mat(k,1787) = rxt(k,113)*y(k,67) - mat(k,497) = -(rxt(k,113)*y(k,110) + (rxt(k,115) + rxt(k,116)) * y(k,52) & - + (rxt(k,117) + rxt(k,118)) * y(k,51) + rxt(k,150)*y(k,99) & - + (rxt(k,153) + rxt(k,255)) * y(k,75) + (rxt(k,173) + rxt(k,256) & - ) * y(k,77) + rxt(k,191)*y(k,73) + rxt(k,208)*y(k,92) + rxt(k,226) & - *y(k,89) + rxt(k,244)*y(k,88)) - mat(k,1792) = -rxt(k,113)*y(k,67) - mat(k,1136) = -(rxt(k,115) + rxt(k,116)) * y(k,67) - mat(k,1739) = -(rxt(k,117) + rxt(k,118)) * y(k,67) - mat(k,1338) = -rxt(k,150)*y(k,67) - mat(k,1180) = -(rxt(k,153) + rxt(k,255)) * y(k,67) - mat(k,1550) = -(rxt(k,173) + rxt(k,256)) * y(k,67) - mat(k,820) = -rxt(k,191)*y(k,67) - mat(k,1052) = -rxt(k,208)*y(k,67) - mat(k,911) = -rxt(k,226)*y(k,67) - mat(k,867) = -rxt(k,244)*y(k,67) - mat(k,779) = rxt(k,114)*y(k,110) - mat(k,1792) = mat(k,1792) + rxt(k,114)*y(k,65) - mat(k,619) = -(rxt(k,122)*y(k,60) + rxt(k,123)*y(k,24) + rxt(k,124)*y(k,32) & - + rxt(k,125)*y(k,40) + rxt(k,126)*y(k,54) + rxt(k,127)*y(k,56) & - + rxt(k,146)*y(k,99) + rxt(k,169)*y(k,77) + rxt(k,186)*y(k,73) & - + rxt(k,204)*y(k,92) + rxt(k,220)*y(k,75) + rxt(k,222)*y(k,89) & - + rxt(k,239)*y(k,88)) - mat(k,1665) = -rxt(k,122)*y(k,68) - mat(k,1510) = -rxt(k,123)*y(k,68) - mat(k,1701) = -rxt(k,124)*y(k,68) - mat(k,1467) = -rxt(k,125)*y(k,68) - mat(k,970) = -rxt(k,126)*y(k,68) - mat(k,1422) = -rxt(k,127)*y(k,68) - mat(k,1342) = -rxt(k,146)*y(k,68) - mat(k,1553) = -rxt(k,169)*y(k,68) - mat(k,823) = -rxt(k,186)*y(k,68) - mat(k,1055) = -rxt(k,204)*y(k,68) - mat(k,1183) = -rxt(k,220)*y(k,68) - mat(k,914) = -rxt(k,222)*y(k,68) - mat(k,871) = -rxt(k,239)*y(k,68) - mat(k,1384) = rxt(k,311)*y(k,98) + rxt(k,330)*y(k,102) - mat(k,1297) = rxt(k,311)*y(k,28) - mat(k,97) = rxt(k,330)*y(k,28) - mat(k,1023) = -((rxt(k,128) + rxt(k,130)) * y(k,55) + rxt(k,129)*y(k,56) & - + rxt(k,133)*y(k,70) + rxt(k,136)*y(k,75) + rxt(k,139)*y(k,77) & - + rxt(k,298)*y(k,89) + rxt(k,299)*y(k,90) + rxt(k,301)*y(k,91) & - + rxt(k,303)*y(k,92) + rxt(k,321)*y(k,100) + rxt(k,375)*y(k,103) & - + rxt(k,376)*y(k,78) + rxt(k,377)*y(k,72) + rxt(k,378)*y(k,73) & - + rxt(k,379)*y(k,93) + rxt(k,561)*y(k,88) + rxt(k,562)*y(k,99) & - + rxt(k,563)*y(k,80)) - mat(k,1271) = -(rxt(k,128) + rxt(k,130)) * y(k,69) - mat(k,1432) = -rxt(k,129)*y(k,69) - mat(k,36) = -rxt(k,133)*y(k,69) - mat(k,1193) = -rxt(k,136)*y(k,69) - mat(k,1563) = -rxt(k,139)*y(k,69) - mat(k,924) = -rxt(k,298)*y(k,69) - mat(k,48) = -rxt(k,299)*y(k,69) - mat(k,118) = -rxt(k,301)*y(k,69) - mat(k,1065) = -rxt(k,303)*y(k,69) - mat(k,145) = -rxt(k,321)*y(k,69) - mat(k,289) = -rxt(k,375)*y(k,69) - mat(k,136) = -rxt(k,376)*y(k,69) - mat(k,105) = -rxt(k,377)*y(k,69) - mat(k,833) = -rxt(k,378)*y(k,69) - mat(k,111) = -rxt(k,379)*y(k,69) - mat(k,881) = -rxt(k,561)*y(k,69) - mat(k,1352) = -rxt(k,562)*y(k,69) - mat(k,92) = -rxt(k,563)*y(k,69) - mat(k,1711) = rxt(k,100)*y(k,61) + rxt(k,312)*y(k,98) + rxt(k,339)*y(k,105) - mat(k,425) = rxt(k,348)*y(k,106) - mat(k,1753) = rxt(k,131)*y(k,106) - mat(k,980) = rxt(k,319)*y(k,98) + rxt(k,328)*y(k,101) + rxt(k,342)*y(k,105) & - + rxt(k,355)*y(k,106) - mat(k,1432) = mat(k,1432) + rxt(k,327)*y(k,101) - mat(k,603) = rxt(k,100)*y(k,32) - mat(k,221) = rxt(k,316)*y(k,98) + rxt(k,356)*y(k,106) - mat(k,1307) = rxt(k,312)*y(k,32) + rxt(k,319)*y(k,54) + rxt(k,316)*y(k,96) - mat(k,406) = rxt(k,328)*y(k,54) + rxt(k,327)*y(k,56) - mat(k,1596) = rxt(k,339)*y(k,32) + rxt(k,342)*y(k,54) - mat(k,1632) = rxt(k,348)*y(k,33) + rxt(k,131)*y(k,51) + rxt(k,355)*y(k,54) & - + rxt(k,356)*y(k,96) - mat(k,33) = -(rxt(k,133)*y(k,69) + rxt(k,134)*y(k,110)) - mat(k,1000) = -rxt(k,133)*y(k,70) - mat(k,1776) = -rxt(k,134)*y(k,70) - mat(k,139) = rxt(k,322)*y(k,110) - mat(k,1776) = mat(k,1776) + rxt(k,322)*y(k,100) - mat(k,297) = -(rxt(k,144)*y(k,99) + rxt(k,167)*y(k,77) + rxt(k,184)*y(k,73) & - + rxt(k,198)*y(k,75) + rxt(k,202)*y(k,92) + rxt(k,219)*y(k,89) & - + rxt(k,237)*y(k,88)) - mat(k,1330) = -rxt(k,144)*y(k,71) - mat(k,1542) = -rxt(k,167)*y(k,71) - mat(k,812) = -rxt(k,184)*y(k,71) - mat(k,1172) = -rxt(k,198)*y(k,71) - mat(k,1044) = -rxt(k,202)*y(k,71) - mat(k,903) = -rxt(k,219)*y(k,71) - mat(k,859) = -rxt(k,237)*y(k,71) - mat(k,1381) = rxt(k,338)*y(k,105) - mat(k,1584) = rxt(k,338)*y(k,28) - end do + mat(39) = -(rxt(133)*y(68) + rxt(134)*y(110)) + mat(1377) = -rxt(133)*y(69) + mat(1697) = -rxt(134)*y(69) + mat(135) = rxt(322)*y(110) + mat(1697) = mat(1697) + rxt(322)*y(100) + mat(277) = -(rxt(144)*y(99) + rxt(167)*y(77) + rxt(184)*y(73) + rxt(198) & + *y(75) + rxt(202)*y(92) + rxt(219)*y(89) + rxt(237)*y(88)) + mat(1252) = -rxt(144)*y(70) + mat(1421) = -rxt(167)*y(70) + mat(1004) = -rxt(184)*y(70) + mat(1337) = -rxt(198)*y(70) + mat(962) = -rxt(202)*y(70) + mat(842) = -rxt(219)*y(70) + mat(799) = -rxt(237)*y(70) + mat(670) = -(rxt(305)*y(92) + (rxt(403) + rxt(404) + rxt(405)) * y(34) & + + rxt(407)*y(55) + rxt(408)*y(57) + rxt(412)*y(104) & + + 4._r8*rxt(417)*y(71) + rxt(429)*y(54) + rxt(434)*y(52) + rxt(439) & + *y(53) + (rxt(449) + rxt(450)) * y(23) + rxt(456)*y(26) + rxt(482) & + *y(1) + rxt(488)*y(3) + rxt(528)*y(19)) + mat(975) = -rxt(305)*y(71) + mat(934) = -(rxt(403) + rxt(404) + rxt(405)) * y(71) + mat(1489) = -rxt(407)*y(71) + mat(1594) = -rxt(408)*y(71) + mat(710) = -rxt(412)*y(71) + mat(1668) = -rxt(429)*y(71) + mat(1308) = -rxt(434)*y(71) + mat(1061) = -rxt(439)*y(71) + mat(1188) = -(rxt(449) + rxt(450)) * y(71) + mat(1103) = -rxt(456)*y(71) + mat(324) = -rxt(482)*y(71) + mat(414) = -rxt(488)*y(71) + mat(268) = -rxt(528)*y(71) + mat(324) = mat(324) + rxt(481)*y(15) + mat(414) = mat(414) + rxt(493)*y(104) + mat(531) = rxt(481)*y(1) + rxt(445)*y(23) + rxt(525)*y(54) + rxt(526)*y(55) + mat(268) = mat(268) + rxt(452)*y(26) + rxt(529)*y(52) + mat(1188) = mat(1188) + rxt(445)*y(15) + rxt(448)*y(37) + mat(1103) = mat(1103) + rxt(452)*y(19) + rxt(463)*y(104) + mat(99) = rxt(532)*y(104) + mat(934) = mat(934) + rxt(406)*y(56) + rxt(312)*y(98) + mat(112) = rxt(448)*y(23) + rxt(402)*y(55) + rxt(411)*y(104) + mat(899) = rxt(125)*y(67) + rxt(313)*y(98) + mat(1633) = rxt(314)*y(98) + mat(1308) = mat(1308) + rxt(529)*y(19) + mat(1668) = mat(1668) + rxt(525)*y(15) + rxt(432)*y(104) + mat(1489) = mat(1489) + rxt(526)*y(15) + rxt(402)*y(37) + rxt(342)*y(105) + mat(1146) = rxt(406)*y(34) + mat(1594) = mat(1594) + rxt(414)*y(104) + mat(586) = rxt(125)*y(42) + mat(1223) = rxt(312)*y(34) + rxt(313)*y(42) + rxt(314)*y(44) + mat(710) = mat(710) + rxt(493)*y(3) + rxt(463)*y(26) + rxt(532)*y(29) & + + rxt(411)*y(37) + rxt(432)*y(54) + rxt(414)*y(57) + mat(1521) = rxt(342)*y(55) + mat(118) = -(rxt(369)*y(110) + rxt(377)*y(68)) + mat(1701) = -rxt(369)*y(72) + mat(1384) = -rxt(377)*y(72) + mat(40) = rxt(134)*y(110) + mat(129) = rxt(367)*y(110) + mat(1701) = mat(1701) + rxt(134)*y(69) + rxt(367)*y(78) + mat(1026) = -(rxt(180)*y(87) + rxt(181)*y(64) + rxt(182)*y(62) + rxt(183) & + *y(83) + rxt(184)*y(70) + rxt(185)*y(98) + rxt(186)*y(67) & + + rxt(188)*y(85) + rxt(189)*y(65) + rxt(190)*y(60) + rxt(191) & + *y(66) + rxt(192)*y(82) + rxt(193)*y(86) + rxt(194)*y(61) & + + rxt(195)*y(84) + rxt(196)*y(81) + rxt(371)*y(110) + rxt(378) & + *y(68)) + mat(455) = -rxt(180)*y(73) + mat(746) = -rxt(181)*y(73) + mat(338) = -rxt(182)*y(73) + mat(643) = -rxt(183)*y(73) + mat(283) = -rxt(184)*y(73) + mat(1232) = -rxt(185)*y(73) + mat(595) = -rxt(186)*y(73) + mat(513) = -rxt(188)*y(73) + mat(310) = -rxt(189)*y(73) + mat(621) = -rxt(190)*y(73) + mat(495) = -rxt(191)*y(73) + mat(368) = -rxt(192)*y(73) + mat(397) = -rxt(193)*y(73) + mat(354) = -rxt(194)*y(73) + mat(473) = -rxt(195)*y(73) + mat(775) = -rxt(196)*y(73) + mat(1728) = -rxt(371)*y(73) + mat(1401) = -rxt(378)*y(73) + mat(121) = rxt(369)*y(110) + mat(47) = rxt(300)*y(110) + mat(1728) = mat(1728) + rxt(369)*y(72) + rxt(300)*y(90) + mat(25) = -(rxt(135)*y(110)) + mat(1695) = -rxt(135)*y(74) + mat(237) = rxt(137)*y(75) + mat(1335) = rxt(137)*y(51) + mat(1367) = -(rxt(136)*y(68) + rxt(137)*y(51) + (rxt(141) + rxt(264)) * y(87) & + + rxt(142)*y(60) + (rxt(153) + rxt(255)) * y(66) + rxt(157) & + *y(82) + rxt(158)*y(86) + rxt(159)*y(61) + rxt(160)*y(84) & + + rxt(161)*y(81) + (rxt(165) + rxt(253)) * y(64) + (rxt(176) & + + rxt(262)) * y(62) + (rxt(187) + rxt(259)) * y(83) + rxt(198) & + *y(70) + rxt(209)*y(98) + rxt(220)*y(67) + (rxt(231) + rxt(257) & + ) * y(85) + (rxt(242) + rxt(266)) * y(65) + rxt(373)*y(110)) + mat(1409) = -rxt(136)*y(75) + mat(245) = -rxt(137)*y(75) + mat(459) = -(rxt(141) + rxt(264)) * y(75) + mat(627) = -rxt(142)*y(75) + mat(500) = -(rxt(153) + rxt(255)) * y(75) + mat(373) = -rxt(157)*y(75) + mat(401) = -rxt(158)*y(75) + mat(359) = -rxt(159)*y(75) + mat(478) = -rxt(160)*y(75) + mat(783) = -rxt(161)*y(75) + mat(754) = -(rxt(165) + rxt(253)) * y(75) + mat(343) = -(rxt(176) + rxt(262)) * y(75) + mat(649) = -(rxt(187) + rxt(259)) * y(75) + mat(287) = -rxt(198)*y(75) + mat(1240) = -rxt(209)*y(75) + mat(603) = -rxt(220)*y(75) + mat(518) = -(rxt(231) + rxt(257)) * y(75) + mat(314) = -(rxt(242) + rxt(266)) * y(75) + mat(1736) = -rxt(373)*y(75) + mat(1034) = rxt(371)*y(110) + mat(26) = rxt(135)*y(110) + mat(1736) = mat(1736) + rxt(371)*y(73) + rxt(135)*y(74) + mat(29) = -(rxt(138)*y(110)) + mat(1696) = -rxt(138)*y(76) + mat(238) = rxt(140)*y(77) + mat(1419) = rxt(140)*y(51) + mat(1453) = -(rxt(139)*y(68) + rxt(140)*y(51) + (rxt(162) + rxt(265)) * y(87) & + + (rxt(163) + rxt(260)) * y(64) + (rxt(164) + rxt(263)) * y(62) & + + (rxt(166) + rxt(261)) * y(83) + rxt(167)*y(70) + rxt(168) & + *y(98) + rxt(169)*y(67) + (rxt(170) + rxt(258)) * y(85) + (rxt(171) & + + rxt(254)) * y(65) + rxt(172)*y(60) + (rxt(173) + rxt(256) & + ) * y(66) + rxt(174)*y(82) + rxt(175)*y(86) + rxt(177)*y(61) & + + rxt(178)*y(84) + rxt(179)*y(81)) + mat(1411) = -rxt(139)*y(77) + mat(246) = -rxt(140)*y(77) + mat(460) = -(rxt(162) + rxt(265)) * y(77) + mat(756) = -(rxt(163) + rxt(260)) * y(77) + mat(344) = -(rxt(164) + rxt(263)) * y(77) + mat(651) = -(rxt(166) + rxt(261)) * y(77) + mat(288) = -rxt(167)*y(77) + mat(1242) = -rxt(168)*y(77) + mat(605) = -rxt(169)*y(77) + mat(519) = -(rxt(170) + rxt(258)) * y(77) + mat(315) = -(rxt(171) + rxt(254)) * y(77) + mat(629) = -rxt(172)*y(77) + mat(501) = -(rxt(173) + rxt(256)) * y(77) + mat(374) = -rxt(174)*y(77) + mat(402) = -rxt(175)*y(77) + mat(360) = -rxt(177)*y(77) + mat(479) = -rxt(178)*y(77) + mat(785) = -rxt(179)*y(77) + mat(1369) = rxt(373)*y(110) + mat(30) = rxt(138)*y(110) + mat(1738) = rxt(373)*y(75) + rxt(138)*y(76) + mat(130) = -(rxt(367)*y(110) + rxt(376)*y(68)) + mat(1703) = -rxt(367)*y(78) + mat(1386) = -rxt(376)*y(78) + mat(926) = rxt(304)*y(92) + mat(660) = rxt(305)*y(92) + mat(961) = rxt(304)*y(34) + rxt(305)*y(71) + rxt(306)*y(104) + mat(137) = rxt(323)*y(110) + mat(698) = rxt(306)*y(92) + mat(1703) = mat(1703) + rxt(323)*y(100) + mat(146) = -(rxt(419)*y(55) + rxt(420)*y(56) + rxt(575)*y(107)) + mat(1469) = -rxt(419)*y(79) + mat(1135) = -rxt(420)*y(79) + mat(204) = -rxt(575)*y(79) + mat(1469) = mat(1469) + rxt(565)*y(80) + mat(1388) = .900_r8*rxt(563)*y(80) + .800_r8*rxt(561)*y(88) + mat(103) = rxt(565)*y(55) + .900_r8*rxt(563)*y(68) + mat(795) = .800_r8*rxt(561)*y(68) + mat(102) = -(rxt(563)*y(68) + rxt(564)*y(56) + (rxt(565) + rxt(566)) * y(55)) + mat(1383) = -rxt(563)*y(80) + mat(1134) = -rxt(564)*y(80) + mat(1467) = -(rxt(565) + rxt(566)) * y(80) + mat(769) = -(rxt(156)*y(99) + rxt(161)*y(75) + rxt(179)*y(77) + rxt(196) & + *y(73) + rxt(214)*y(92) + rxt(232)*y(89) + rxt(249)*y(88) & + + rxt(280)*y(23) + rxt(281)*y(26) + rxt(282)*y(34) + rxt(283) & + *y(110) + rxt(284)*y(42) + rxt(285)*y(44) + rxt(286)*y(53) & + + rxt(287)*y(57)) + mat(1270) = -rxt(156)*y(81) + mat(1353) = -rxt(161)*y(81) + mat(1437) = -rxt(179)*y(81) + mat(1020) = -rxt(196)*y(81) + mat(978) = -rxt(214)*y(81) + mat(858) = -rxt(232)*y(81) + mat(816) = -rxt(249)*y(81) + mat(1191) = -rxt(280)*y(81) + mat(1106) = -rxt(281)*y(81) + mat(937) = -rxt(282)*y(81) + mat(1722) = -rxt(283)*y(81) + mat(902) = -rxt(284)*y(81) + mat(1636) = -rxt(285)*y(81) + mat(1064) = -rxt(286)*y(81) + mat(1597) = -rxt(287)*y(81) + mat(1311) = rxt(106)*y(63) + rxt(275)*y(64) + rxt(118)*y(66) + rxt(274) & + *y(101) + mat(1064) = mat(1064) + rxt(105)*y(60) + rxt(315)*y(98) + rxt(273)*y(101) & + + rxt(341)*y(105) + rxt(354)*y(106) + mat(1492) = rxt(296)*y(83) + mat(1597) = mat(1597) + rxt(297)*y(83) + mat(615) = rxt(105)*y(53) + mat(231) = rxt(106)*y(52) + mat(740) = rxt(275)*y(52) + mat(490) = rxt(118)*y(52) + mat(637) = rxt(296)*y(55) + rxt(297)*y(57) + mat(1226) = rxt(315)*y(53) + mat(379) = rxt(274)*y(52) + rxt(273)*y(53) + mat(1524) = rxt(341)*y(53) + mat(1559) = rxt(354)*y(53) end subroutine nlnmat05 - subroutine nlnmat06( avec_len, mat, y, rxt ) + subroutine nlnmat06( 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) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) !---------------------------------------------- ! ... local variables !---------------------------------------------- - integer :: k !---------------------------------------------- ! ... complete matrix entries implicit species !---------------------------------------------- - do k = 1,avec_len - mat(k,102) = -(rxt(k,369)*y(k,110) + rxt(k,377)*y(k,69)) - mat(k,1778) = -rxt(k,369)*y(k,72) - mat(k,1005) = -rxt(k,377)*y(k,72) - mat(k,34) = rxt(k,134)*y(k,110) - mat(k,133) = rxt(k,367)*y(k,110) - mat(k,1778) = mat(k,1778) + rxt(k,134)*y(k,70) + rxt(k,367)*y(k,78) - mat(k,829) = -(rxt(k,180)*y(k,87) + rxt(k,181)*y(k,65) + rxt(k,182)*y(k,63) & - + rxt(k,183)*y(k,83) + rxt(k,184)*y(k,71) + rxt(k,185)*y(k,98) & - + rxt(k,186)*y(k,68) + rxt(k,188)*y(k,85) + rxt(k,189)*y(k,66) & - + rxt(k,190)*y(k,61) + rxt(k,191)*y(k,67) + rxt(k,192)*y(k,82) & - + rxt(k,193)*y(k,86) + rxt(k,194)*y(k,62) + rxt(k,195)*y(k,84) & - + rxt(k,196)*y(k,81) + rxt(k,371)*y(k,110) + rxt(k,378)*y(k,69)) - mat(k,440) = -rxt(k,180)*y(k,73) - mat(k,786) = -rxt(k,181)*y(k,73) - mat(k,342) = -rxt(k,182)*y(k,73) - mat(k,654) = -rxt(k,183)*y(k,73) - mat(k,299) = -rxt(k,184)*y(k,73) - mat(k,1303) = -rxt(k,185)*y(k,73) - mat(k,625) = -rxt(k,186)*y(k,73) - mat(k,521) = -rxt(k,188)*y(k,73) - mat(k,313) = -rxt(k,189)*y(k,73) - mat(k,600) = -rxt(k,190)*y(k,73) - mat(k,502) = -rxt(k,191)*y(k,73) - mat(k,373) = -rxt(k,192)*y(k,73) - mat(k,387) = -rxt(k,193)*y(k,73) - mat(k,358) = -rxt(k,194)*y(k,73) - mat(k,480) = -rxt(k,195)*y(k,73) - mat(k,714) = -rxt(k,196)*y(k,73) - mat(k,1802) = -rxt(k,371)*y(k,73) - mat(k,1019) = -rxt(k,378)*y(k,73) - mat(k,104) = rxt(k,369)*y(k,110) - mat(k,47) = rxt(k,300)*y(k,110) - mat(k,1802) = mat(k,1802) + rxt(k,369)*y(k,72) + rxt(k,300)*y(k,90) - mat(k,22) = -(rxt(k,135)*y(k,110)) - mat(k,1774) = -rxt(k,135)*y(k,74) - mat(k,227) = rxt(k,137)*y(k,75) - mat(k,1170) = rxt(k,137)*y(k,50) - mat(k,1197) = -(rxt(k,136)*y(k,69) + rxt(k,137)*y(k,50) + (rxt(k,141) & - + rxt(k,264)) * y(k,87) + rxt(k,142)*y(k,61) + (rxt(k,153) & - + rxt(k,255)) * y(k,67) + rxt(k,157)*y(k,82) + rxt(k,158) & - *y(k,86) + rxt(k,159)*y(k,62) + rxt(k,160)*y(k,84) + rxt(k,161) & - *y(k,81) + (rxt(k,165) + rxt(k,253)) * y(k,65) + (rxt(k,176) & - + rxt(k,262)) * y(k,63) + (rxt(k,187) + rxt(k,259)) * y(k,83) & - + rxt(k,198)*y(k,71) + rxt(k,209)*y(k,98) + rxt(k,220)*y(k,68) & - + (rxt(k,231) + rxt(k,257)) * y(k,85) + (rxt(k,242) + rxt(k,266) & - ) * y(k,66) + rxt(k,373)*y(k,110)) - mat(k,1027) = -rxt(k,136)*y(k,75) - mat(k,236) = -rxt(k,137)*y(k,75) - mat(k,445) = -(rxt(k,141) + rxt(k,264)) * y(k,75) - mat(k,607) = -rxt(k,142)*y(k,75) - mat(k,508) = -(rxt(k,153) + rxt(k,255)) * y(k,75) - mat(k,378) = -rxt(k,157)*y(k,75) - mat(k,392) = -rxt(k,158)*y(k,75) - mat(k,362) = -rxt(k,159)*y(k,75) - mat(k,487) = -rxt(k,160)*y(k,75) - mat(k,722) = -rxt(k,161)*y(k,75) - mat(k,794) = -(rxt(k,165) + rxt(k,253)) * y(k,75) - mat(k,346) = -(rxt(k,176) + rxt(k,262)) * y(k,75) - mat(k,662) = -(rxt(k,187) + rxt(k,259)) * y(k,75) - mat(k,303) = -rxt(k,198)*y(k,75) - mat(k,1311) = -rxt(k,209)*y(k,75) - mat(k,633) = -rxt(k,220)*y(k,75) - mat(k,528) = -(rxt(k,231) + rxt(k,257)) * y(k,75) - mat(k,318) = -(rxt(k,242) + rxt(k,266)) * y(k,75) - mat(k,1810) = -rxt(k,373)*y(k,75) - mat(k,837) = rxt(k,371)*y(k,110) - mat(k,24) = rxt(k,135)*y(k,110) - mat(k,1810) = mat(k,1810) + rxt(k,371)*y(k,73) + rxt(k,135)*y(k,74) - mat(k,26) = -(rxt(k,138)*y(k,110)) - mat(k,1775) = -rxt(k,138)*y(k,76) - mat(k,228) = rxt(k,140)*y(k,77) - mat(k,1540) = rxt(k,140)*y(k,50) - mat(k,1576) = -(rxt(k,139)*y(k,69) + rxt(k,140)*y(k,50) + (rxt(k,162) & - + rxt(k,265)) * y(k,87) + (rxt(k,163) + rxt(k,260)) * y(k,65) & - + (rxt(k,164) + rxt(k,263)) * y(k,63) + (rxt(k,166) + rxt(k,261) & - ) * y(k,83) + rxt(k,167)*y(k,71) + rxt(k,168)*y(k,98) + rxt(k,169) & - *y(k,68) + (rxt(k,170) + rxt(k,258)) * y(k,85) + (rxt(k,171) & - + rxt(k,254)) * y(k,66) + rxt(k,172)*y(k,61) + (rxt(k,173) & - + rxt(k,256)) * y(k,67) + rxt(k,174)*y(k,82) + rxt(k,175) & - *y(k,86) + rxt(k,177)*y(k,62) + rxt(k,178)*y(k,84) + rxt(k,179) & - *y(k,81)) - mat(k,1036) = -rxt(k,139)*y(k,77) - mat(k,238) = -rxt(k,140)*y(k,77) - mat(k,449) = -(rxt(k,162) + rxt(k,265)) * y(k,77) - mat(k,803) = -(rxt(k,163) + rxt(k,260)) * y(k,77) - mat(k,350) = -(rxt(k,164) + rxt(k,263)) * y(k,77) - mat(k,668) = -(rxt(k,166) + rxt(k,261)) * y(k,77) - mat(k,307) = -rxt(k,167)*y(k,77) - mat(k,1320) = -rxt(k,168)*y(k,77) - mat(k,641) = -rxt(k,169)*y(k,77) - mat(k,532) = -(rxt(k,170) + rxt(k,258)) * y(k,77) - mat(k,322) = -(rxt(k,171) + rxt(k,254)) * y(k,77) - mat(k,611) = -rxt(k,172)*y(k,77) - mat(k,512) = -(rxt(k,173) + rxt(k,256)) * y(k,77) - mat(k,381) = -rxt(k,174)*y(k,77) - mat(k,397) = -rxt(k,175)*y(k,77) - mat(k,366) = -rxt(k,177)*y(k,77) - mat(k,491) = -rxt(k,178)*y(k,77) - mat(k,729) = -rxt(k,179)*y(k,77) - mat(k,1206) = rxt(k,373)*y(k,110) - mat(k,28) = rxt(k,138)*y(k,110) - mat(k,1819) = rxt(k,373)*y(k,75) + rxt(k,138)*y(k,76) - mat(k,134) = -(rxt(k,367)*y(k,110) + rxt(k,376)*y(k,69)) - mat(k,1782) = -rxt(k,367)*y(k,78) - mat(k,1009) = -rxt(k,376)*y(k,78) - mat(k,1695) = rxt(k,304)*y(k,92) - mat(k,676) = rxt(k,305)*y(k,92) - mat(k,1043) = rxt(k,304)*y(k,32) + rxt(k,305)*y(k,43) + rxt(k,306)*y(k,104) - mat(k,141) = rxt(k,323)*y(k,110) - mat(k,742) = rxt(k,306)*y(k,92) - mat(k,1782) = mat(k,1782) + rxt(k,323)*y(k,100) - mat(k,159) = -(rxt(k,419)*y(k,54) + rxt(k,420)*y(k,55) + rxt(k,575)*y(k,107)) - mat(k,953) = -rxt(k,419)*y(k,79) - mat(k,1253) = -rxt(k,420)*y(k,79) - mat(k,242) = -rxt(k,575)*y(k,79) - mat(k,953) = mat(k,953) + rxt(k,565)*y(k,80) - mat(k,1011) = .900_r8*rxt(k,563)*y(k,80) + .800_r8*rxt(k,561)*y(k,88) - mat(k,87) = rxt(k,565)*y(k,54) + .900_r8*rxt(k,563)*y(k,69) - mat(k,855) = .800_r8*rxt(k,561)*y(k,69) - mat(k,86) = -(rxt(k,563)*y(k,69) + rxt(k,564)*y(k,55) + (rxt(k,565) + rxt(k,566) & - ) * y(k,54)) - mat(k,1004) = -rxt(k,563)*y(k,80) - mat(k,1251) = -rxt(k,564)*y(k,80) - mat(k,949) = -(rxt(k,565) + rxt(k,566)) * y(k,80) - mat(k,712) = -(rxt(k,156)*y(k,99) + rxt(k,161)*y(k,75) + rxt(k,179)*y(k,77) & - + rxt(k,196)*y(k,73) + rxt(k,214)*y(k,92) + rxt(k,232)*y(k,89) & - + rxt(k,249)*y(k,88) + rxt(k,280)*y(k,60) + rxt(k,281)*y(k,24) & - + rxt(k,282)*y(k,32) + rxt(k,283)*y(k,110) + rxt(k,284)*y(k,40) & - + rxt(k,285)*y(k,42) + rxt(k,286)*y(k,52) + rxt(k,287)*y(k,56)) - mat(k,1345) = -rxt(k,156)*y(k,81) - mat(k,1186) = -rxt(k,161)*y(k,81) - mat(k,1556) = -rxt(k,179)*y(k,81) - mat(k,826) = -rxt(k,196)*y(k,81) - mat(k,1058) = -rxt(k,214)*y(k,81) - mat(k,917) = -rxt(k,232)*y(k,81) - mat(k,874) = -rxt(k,249)*y(k,81) - mat(k,1668) = -rxt(k,280)*y(k,81) - mat(k,1513) = -rxt(k,281)*y(k,81) - mat(k,1704) = -rxt(k,282)*y(k,81) - mat(k,1799) = -rxt(k,283)*y(k,81) - mat(k,1470) = -rxt(k,284)*y(k,81) - mat(k,1098) = -rxt(k,285)*y(k,81) - mat(k,1143) = -rxt(k,286)*y(k,81) - mat(k,1425) = -rxt(k,287)*y(k,81) - mat(k,1746) = rxt(k,106)*y(k,64) + rxt(k,275)*y(k,65) + rxt(k,118)*y(k,67) & - + rxt(k,274)*y(k,101) - mat(k,1143) = mat(k,1143) + rxt(k,105)*y(k,61) + rxt(k,315)*y(k,98) & - + rxt(k,273)*y(k,101) + rxt(k,341)*y(k,105) + rxt(k,354) & - *y(k,106) - mat(k,973) = rxt(k,296)*y(k,83) - mat(k,1425) = mat(k,1425) + rxt(k,297)*y(k,83) - mat(k,599) = rxt(k,105)*y(k,52) - mat(k,213) = rxt(k,106)*y(k,51) - mat(k,783) = rxt(k,275)*y(k,51) - mat(k,500) = rxt(k,118)*y(k,51) - mat(k,653) = rxt(k,296)*y(k,54) + rxt(k,297)*y(k,56) - mat(k,1300) = rxt(k,315)*y(k,52) - mat(k,403) = rxt(k,274)*y(k,51) + rxt(k,273)*y(k,52) - mat(k,1589) = rxt(k,341)*y(k,52) - mat(k,1625) = rxt(k,354)*y(k,52) - mat(k,371) = -(rxt(k,151)*y(k,99) + rxt(k,157)*y(k,75) + rxt(k,174)*y(k,77) & - + rxt(k,192)*y(k,73) + rxt(k,210)*y(k,92) + rxt(k,227)*y(k,89) & - + rxt(k,245)*y(k,88)) - mat(k,1334) = -rxt(k,151)*y(k,82) - mat(k,1176) = -rxt(k,157)*y(k,82) - mat(k,1546) = -rxt(k,174)*y(k,82) - mat(k,816) = -rxt(k,192)*y(k,82) - mat(k,1048) = -rxt(k,210)*y(k,82) - mat(k,907) = -rxt(k,227)*y(k,82) - mat(k,863) = -rxt(k,245)*y(k,82) - mat(k,1736) = rxt(k,117)*y(k,67) - mat(k,496) = rxt(k,117)*y(k,51) - mat(k,709) = rxt(k,283)*y(k,110) - mat(k,1789) = rxt(k,283)*y(k,81) - mat(k,652) = -(rxt(k,143)*y(k,99) + (rxt(k,166) + rxt(k,261)) * y(k,77) & - + rxt(k,183)*y(k,73) + (rxt(k,187) + rxt(k,259)) * y(k,75) & - + rxt(k,201)*y(k,92) + rxt(k,218)*y(k,89) + rxt(k,236)*y(k,88) & - + (rxt(k,271) + rxt(k,293)) * y(k,40) + rxt(k,291)*y(k,110) & - + rxt(k,295)*y(k,42) + rxt(k,296)*y(k,54) + rxt(k,297)*y(k,56)) - mat(k,1343) = -rxt(k,143)*y(k,83) - mat(k,1554) = -(rxt(k,166) + rxt(k,261)) * y(k,83) - mat(k,824) = -rxt(k,183)*y(k,83) - mat(k,1184) = -(rxt(k,187) + rxt(k,259)) * y(k,83) - mat(k,1056) = -rxt(k,201)*y(k,83) - mat(k,915) = -rxt(k,218)*y(k,83) - mat(k,872) = -rxt(k,236)*y(k,83) - mat(k,1468) = -(rxt(k,271) + rxt(k,293)) * y(k,83) - mat(k,1797) = -rxt(k,291)*y(k,83) - mat(k,1096) = -rxt(k,295)*y(k,83) - mat(k,971) = -rxt(k,296)*y(k,83) - mat(k,1423) = -rxt(k,297)*y(k,83) - mat(k,1096) = mat(k,1096) + rxt(k,104)*y(k,61) + rxt(k,119)*y(k,65) & - + rxt(k,285)*y(k,81) + rxt(k,314)*y(k,98) + rxt(k,352)*y(k,106) - mat(k,1744) = rxt(k,267)*y(k,101) - mat(k,1141) = rxt(k,276)*y(k,65) + rxt(k,115)*y(k,67) + rxt(k,286)*y(k,81) & - + rxt(k,272)*y(k,101) - mat(k,1423) = mat(k,1423) + rxt(k,287)*y(k,81) - mat(k,598) = rxt(k,104)*y(k,42) - mat(k,782) = rxt(k,119)*y(k,42) + rxt(k,276)*y(k,52) - mat(k,499) = rxt(k,115)*y(k,52) - mat(k,711) = rxt(k,285)*y(k,42) + rxt(k,286)*y(k,52) + rxt(k,287)*y(k,56) - mat(k,1298) = rxt(k,314)*y(k,42) - mat(k,402) = rxt(k,267)*y(k,51) + rxt(k,272)*y(k,52) - mat(k,1623) = rxt(k,352)*y(k,42) - end do + mat(362) = -(rxt(151)*y(99) + rxt(157)*y(75) + rxt(174)*y(77) + rxt(192) & + *y(73) + rxt(210)*y(92) + rxt(227)*y(89) + rxt(245)*y(88)) + mat(1257) = -rxt(151)*y(82) + mat(1341) = -rxt(157)*y(82) + mat(1425) = -rxt(174)*y(82) + mat(1008) = -rxt(192)*y(82) + mat(966) = -rxt(210)*y(82) + mat(846) = -rxt(227)*y(82) + mat(803) = -rxt(245)*y(82) + mat(1299) = rxt(117)*y(66) + mat(485) = rxt(117)*y(52) + mat(765) = rxt(283)*y(110) + mat(1710) = rxt(283)*y(81) + mat(636) = -(rxt(143)*y(99) + (rxt(166) + rxt(261)) * y(77) + rxt(183)*y(73) & + + (rxt(187) + rxt(259)) * y(75) + rxt(201)*y(92) + rxt(218) & + *y(89) + rxt(236)*y(88) + (rxt(271) + rxt(293)) * y(42) + rxt(291) & + *y(110) + rxt(295)*y(44) + rxt(296)*y(55) + rxt(297)*y(57)) + mat(1266) = -rxt(143)*y(83) + mat(1433) = -(rxt(166) + rxt(261)) * y(83) + mat(1016) = -rxt(183)*y(83) + mat(1349) = -(rxt(187) + rxt(259)) * y(83) + mat(974) = -rxt(201)*y(83) + mat(854) = -rxt(218)*y(83) + mat(812) = -rxt(236)*y(83) + mat(898) = -(rxt(271) + rxt(293)) * y(83) + mat(1718) = -rxt(291)*y(83) + mat(1632) = -rxt(295)*y(83) + mat(1488) = -rxt(296)*y(83) + mat(1593) = -rxt(297)*y(83) + mat(1632) = mat(1632) + rxt(104)*y(60) + rxt(119)*y(64) + rxt(285)*y(81) & + + rxt(314)*y(98) + rxt(352)*y(106) + mat(1307) = rxt(267)*y(101) + mat(1060) = rxt(276)*y(64) + rxt(115)*y(66) + rxt(286)*y(81) + rxt(272) & + *y(101) + mat(1593) = mat(1593) + rxt(287)*y(81) + mat(614) = rxt(104)*y(44) + mat(737) = rxt(119)*y(44) + rxt(276)*y(53) + mat(488) = rxt(115)*y(53) + mat(767) = rxt(285)*y(44) + rxt(286)*y(53) + rxt(287)*y(57) + mat(1222) = rxt(314)*y(44) + mat(377) = rxt(267)*y(52) + rxt(272)*y(53) + mat(1555) = rxt(352)*y(44) + mat(466) = -(rxt(155)*y(99) + rxt(160)*y(75) + rxt(178)*y(77) + rxt(195) & + *y(73) + rxt(213)*y(92) + rxt(230)*y(89) + rxt(248)*y(88) & + + rxt(288)*y(51)) + mat(1260) = -rxt(155)*y(84) + mat(1344) = -rxt(160)*y(84) + mat(1428) = -rxt(178)*y(84) + mat(1011) = -rxt(195)*y(84) + mat(969) = -rxt(213)*y(84) + mat(849) = -rxt(230)*y(84) + mat(806) = -rxt(248)*y(84) + mat(241) = -rxt(288)*y(84) + mat(506) = rxt(289)*y(110) + mat(1712) = rxt(289)*y(85) + mat(507) = -(rxt(147)*y(99) + (rxt(170) + rxt(258)) * y(77) + rxt(188)*y(73) & + + rxt(205)*y(92) + rxt(223)*y(89) + (rxt(231) + rxt(257) & + ) * y(75) + rxt(240)*y(88) + rxt(289)*y(110) + rxt(290)*y(44) & + + rxt(292)*y(51)) + mat(1262) = -rxt(147)*y(85) + mat(1430) = -(rxt(170) + rxt(258)) * y(85) + mat(1013) = -rxt(188)*y(85) + mat(971) = -rxt(205)*y(85) + mat(851) = -rxt(223)*y(85) + mat(1346) = -(rxt(231) + rxt(257)) * y(85) + mat(808) = -rxt(240)*y(85) + mat(1714) = -rxt(289)*y(85) + mat(1628) = -rxt(290)*y(85) + mat(242) = -rxt(292)*y(85) + mat(1056) = rxt(116)*y(66) + mat(487) = rxt(116)*y(53) + mat(634) = rxt(291)*y(110) + mat(1714) = mat(1714) + rxt(291)*y(83) + mat(390) = -(rxt(152)*y(99) + rxt(158)*y(75) + rxt(175)*y(77) + rxt(193) & + *y(73) + rxt(211)*y(92) + rxt(228)*y(89) + rxt(246)*y(88) & + + rxt(294)*y(44)) + mat(1258) = -rxt(152)*y(86) + mat(1342) = -rxt(158)*y(86) + mat(1426) = -rxt(175)*y(86) + mat(1009) = -rxt(193)*y(86) + mat(967) = -rxt(211)*y(86) + mat(847) = -rxt(228)*y(86) + mat(804) = -rxt(246)*y(86) + mat(1625) = -rxt(294)*y(86) + mat(891) = rxt(271)*y(83) + mat(632) = rxt(271)*y(42) + mat(450) = -((rxt(141) + rxt(264)) * y(75) + (rxt(162) + rxt(265)) * y(77) & + + rxt(180)*y(73) + rxt(197)*y(92) + rxt(215)*y(89) + rxt(233) & + *y(88) + rxt(250)*y(99)) + mat(1343) = -(rxt(141) + rxt(264)) * y(87) + mat(1427) = -(rxt(162) + rxt(265)) * y(87) + mat(1010) = -rxt(180)*y(87) + mat(968) = -rxt(197)*y(87) + mat(848) = -rxt(215)*y(87) + mat(805) = -rxt(233)*y(87) + mat(1259) = -rxt(250)*y(87) + mat(1627) = rxt(295)*y(83) + rxt(290)*y(85) + rxt(294)*y(86) + mat(240) = rxt(288)*y(84) + rxt(292)*y(85) + mat(633) = rxt(295)*y(44) + mat(465) = rxt(288)*y(51) + mat(505) = rxt(290)*y(44) + rxt(292)*y(51) + mat(391) = rxt(294)*y(44) + mat(817) = -(rxt(233)*y(87) + rxt(234)*y(64) + rxt(235)*y(62) + rxt(236) & + *y(83) + rxt(237)*y(70) + rxt(238)*y(98) + rxt(239)*y(67) & + + rxt(240)*y(85) + rxt(241)*y(65) + rxt(243)*y(60) + rxt(244) & + *y(66) + rxt(245)*y(82) + rxt(246)*y(86) + rxt(247)*y(61) & + + rxt(248)*y(84) + rxt(249)*y(81) + rxt(360)*y(110) + rxt(561) & + *y(68)) + mat(452) = -rxt(233)*y(88) + mat(741) = -rxt(234)*y(88) + mat(333) = -rxt(235)*y(88) + mat(638) = -rxt(236)*y(88) + mat(279) = -rxt(237)*y(88) + mat(1227) = -rxt(238)*y(88) + mat(590) = -rxt(239)*y(88) + mat(509) = -rxt(240)*y(88) + mat(306) = -rxt(241)*y(88) + mat(616) = -rxt(243)*y(88) + mat(491) = -rxt(244)*y(88) + mat(364) = -rxt(245)*y(88) + mat(392) = -rxt(246)*y(88) + mat(349) = -rxt(247)*y(88) + mat(469) = -rxt(248)*y(88) + mat(770) = -rxt(249)*y(88) + mat(1723) = -rxt(360)*y(88) + mat(1396) = -rxt(561)*y(88) + mat(257) = rxt(570)*y(99) + mat(1312) = rxt(572)*y(99) + mat(1493) = rxt(565)*y(80) + mat(1150) = rxt(569)*y(94) + mat(106) = rxt(565)*y(55) + mat(175) = rxt(569)*y(56) + mat(1271) = rxt(570)*y(49) + rxt(572)*y(52) + mat(860) = -(rxt(215)*y(87) + rxt(216)*y(64) + rxt(217)*y(62) + rxt(218) & + *y(83) + rxt(219)*y(70) + rxt(221)*y(98) + rxt(222)*y(67) & + + rxt(223)*y(85) + rxt(224)*y(65) + rxt(225)*y(60) + rxt(226) & + *y(66) + rxt(227)*y(82) + rxt(228)*y(86) + rxt(229)*y(61) & + + rxt(230)*y(84) + rxt(232)*y(81) + rxt(298)*y(68) + rxt(362) & + *y(110)) + mat(453) = -rxt(215)*y(89) + mat(742) = -rxt(216)*y(89) + mat(334) = -rxt(217)*y(89) + mat(639) = -rxt(218)*y(89) + mat(280) = -rxt(219)*y(89) + mat(1228) = -rxt(221)*y(89) + mat(591) = -rxt(222)*y(89) + mat(510) = -rxt(223)*y(89) + mat(307) = -rxt(224)*y(89) + mat(617) = -rxt(225)*y(89) + mat(492) = -rxt(226)*y(89) + mat(365) = -rxt(227)*y(89) + mat(393) = -rxt(228)*y(89) + mat(350) = -rxt(229)*y(89) + mat(470) = -rxt(230)*y(89) + mat(771) = -rxt(232)*y(89) + mat(1397) = -rxt(298)*y(89) + mat(1724) = -rxt(362)*y(89) + mat(980) = rxt(361)*y(110) + mat(1724) = mat(1724) + rxt(361)*y(92) + mat(45) = -(rxt(299)*y(68) + rxt(300)*y(110)) + mat(1378) = -rxt(299)*y(90) + mat(1698) = -rxt(300)*y(90) + mat(840) = rxt(362)*y(110) + mat(1698) = mat(1698) + rxt(362)*y(89) + mat(71) = -(rxt(301)*y(68) + rxt(302)*y(110)) + mat(1380) = -rxt(301)*y(91) + mat(1700) = -rxt(302)*y(91) + mat(983) = -(rxt(197)*y(87) + rxt(199)*y(64) + rxt(200)*y(62) + rxt(201) & + *y(83) + rxt(202)*y(70) + rxt(203)*y(98) + rxt(204)*y(67) & + + rxt(205)*y(85) + rxt(206)*y(65) + rxt(207)*y(60) + rxt(208) & + *y(66) + rxt(210)*y(82) + rxt(211)*y(86) + rxt(212)*y(61) & + + rxt(213)*y(84) + rxt(214)*y(81) + rxt(303)*y(68) + rxt(304) & + *y(34) + rxt(305)*y(71) + rxt(306)*y(104) + rxt(361)*y(110)) + mat(454) = -rxt(197)*y(92) + mat(745) = -rxt(199)*y(92) + mat(337) = -rxt(200)*y(92) + mat(642) = -rxt(201)*y(92) + mat(282) = -rxt(202)*y(92) + mat(1231) = -rxt(203)*y(92) + mat(594) = -rxt(204)*y(92) + mat(512) = -rxt(205)*y(92) + mat(309) = -rxt(206)*y(92) + mat(620) = -rxt(207)*y(92) + mat(494) = -rxt(208)*y(92) + mat(367) = -rxt(210)*y(92) + mat(396) = -rxt(211)*y(92) + mat(353) = -rxt(212)*y(92) + mat(472) = -rxt(213)*y(92) + mat(774) = -rxt(214)*y(92) + mat(1400) = -rxt(303)*y(92) + mat(942) = -rxt(304)*y(92) + mat(674) = -rxt(305)*y(92) + mat(715) = -rxt(306)*y(92) + mat(1727) = -rxt(361)*y(92) + mat(821) = rxt(360)*y(110) + mat(73) = rxt(302)*y(110) + mat(67) = rxt(308)*y(110) + mat(1727) = mat(1727) + rxt(360)*y(88) + rxt(302)*y(91) + rxt(308)*y(93) + mat(64) = -(rxt(308)*y(110) + rxt(379)*y(68)) + mat(1699) = -rxt(308)*y(93) + mat(1379) = -rxt(379)*y(93) + mat(172) = -(rxt(567)*y(55) + (rxt(568) + rxt(569)) * y(56)) + mat(1471) = -rxt(567)*y(94) + mat(1136) = -(rxt(568) + rxt(569)) * y(94) + mat(147) = rxt(575)*y(107) + mat(205) = rxt(575)*y(79) end subroutine nlnmat06 - subroutine nlnmat07( avec_len, mat, y, rxt ) + subroutine nlnmat07( 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) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) !---------------------------------------------- ! ... local variables !---------------------------------------------- - integer :: k !---------------------------------------------- ! ... complete matrix entries implicit species !---------------------------------------------- - do k = 1,avec_len - mat(k,477) = -(rxt(k,155)*y(k,99) + rxt(k,160)*y(k,75) + rxt(k,178)*y(k,77) & - + rxt(k,195)*y(k,73) + rxt(k,213)*y(k,92) + rxt(k,230)*y(k,89) & - + rxt(k,248)*y(k,88) + rxt(k,288)*y(k,50)) - mat(k,1337) = -rxt(k,155)*y(k,84) - mat(k,1179) = -rxt(k,160)*y(k,84) - mat(k,1549) = -rxt(k,178)*y(k,84) - mat(k,819) = -rxt(k,195)*y(k,84) - mat(k,1051) = -rxt(k,213)*y(k,84) - mat(k,910) = -rxt(k,230)*y(k,84) - mat(k,866) = -rxt(k,248)*y(k,84) - mat(k,231) = -rxt(k,288)*y(k,84) - mat(k,518) = rxt(k,289)*y(k,110) - mat(k,1791) = rxt(k,289)*y(k,85) - mat(k,519) = -(rxt(k,147)*y(k,99) + (rxt(k,170) + rxt(k,258)) * y(k,77) & - + rxt(k,188)*y(k,73) + rxt(k,205)*y(k,92) + rxt(k,223)*y(k,89) & - + (rxt(k,231) + rxt(k,257)) * y(k,75) + rxt(k,240)*y(k,88) & - + rxt(k,289)*y(k,110) + rxt(k,290)*y(k,42) + rxt(k,292)*y(k,50)) - mat(k,1339) = -rxt(k,147)*y(k,85) - mat(k,1551) = -(rxt(k,170) + rxt(k,258)) * y(k,85) - mat(k,821) = -rxt(k,188)*y(k,85) - mat(k,1053) = -rxt(k,205)*y(k,85) - mat(k,912) = -rxt(k,223)*y(k,85) - mat(k,1181) = -(rxt(k,231) + rxt(k,257)) * y(k,85) - mat(k,868) = -rxt(k,240)*y(k,85) - mat(k,1793) = -rxt(k,289)*y(k,85) - mat(k,1092) = -rxt(k,290)*y(k,85) - mat(k,232) = -rxt(k,292)*y(k,85) - mat(k,1137) = rxt(k,116)*y(k,67) - mat(k,498) = rxt(k,116)*y(k,52) - mat(k,650) = rxt(k,291)*y(k,110) - mat(k,1793) = mat(k,1793) + rxt(k,291)*y(k,83) - mat(k,385) = -(rxt(k,152)*y(k,99) + rxt(k,158)*y(k,75) + rxt(k,175)*y(k,77) & - + rxt(k,193)*y(k,73) + rxt(k,211)*y(k,92) + rxt(k,228)*y(k,89) & - + rxt(k,246)*y(k,88) + rxt(k,294)*y(k,42)) - mat(k,1335) = -rxt(k,152)*y(k,86) - mat(k,1177) = -rxt(k,158)*y(k,86) - mat(k,1547) = -rxt(k,175)*y(k,86) - mat(k,817) = -rxt(k,193)*y(k,86) - mat(k,1049) = -rxt(k,211)*y(k,86) - mat(k,908) = -rxt(k,228)*y(k,86) - mat(k,864) = -rxt(k,246)*y(k,86) - mat(k,1089) = -rxt(k,294)*y(k,86) - mat(k,1461) = rxt(k,271)*y(k,83) - mat(k,648) = rxt(k,271)*y(k,40) - mat(k,438) = -((rxt(k,141) + rxt(k,264)) * y(k,75) + (rxt(k,162) + rxt(k,265) & - ) * y(k,77) + rxt(k,180)*y(k,73) + rxt(k,197)*y(k,92) + rxt(k,215) & - *y(k,89) + rxt(k,233)*y(k,88) + rxt(k,250)*y(k,99)) - mat(k,1178) = -(rxt(k,141) + rxt(k,264)) * y(k,87) - mat(k,1548) = -(rxt(k,162) + rxt(k,265)) * y(k,87) - mat(k,818) = -rxt(k,180)*y(k,87) - mat(k,1050) = -rxt(k,197)*y(k,87) - mat(k,909) = -rxt(k,215)*y(k,87) - mat(k,865) = -rxt(k,233)*y(k,87) - mat(k,1336) = -rxt(k,250)*y(k,87) - mat(k,1091) = rxt(k,295)*y(k,83) + rxt(k,290)*y(k,85) + rxt(k,294)*y(k,86) - mat(k,230) = rxt(k,288)*y(k,84) + rxt(k,292)*y(k,85) - mat(k,649) = rxt(k,295)*y(k,42) - mat(k,476) = rxt(k,288)*y(k,50) - mat(k,517) = rxt(k,290)*y(k,42) + rxt(k,292)*y(k,50) - mat(k,386) = rxt(k,294)*y(k,42) - mat(k,878) = -(rxt(k,233)*y(k,87) + rxt(k,234)*y(k,65) + rxt(k,235)*y(k,63) & - + rxt(k,236)*y(k,83) + rxt(k,237)*y(k,71) + rxt(k,238)*y(k,98) & - + rxt(k,239)*y(k,68) + rxt(k,240)*y(k,85) + rxt(k,241)*y(k,66) & - + rxt(k,243)*y(k,61) + rxt(k,244)*y(k,67) + rxt(k,245)*y(k,82) & - + rxt(k,246)*y(k,86) + rxt(k,247)*y(k,62) + rxt(k,248)*y(k,84) & - + rxt(k,249)*y(k,81) + rxt(k,360)*y(k,110) + rxt(k,363)*y(k,28) & - + rxt(k,561)*y(k,69)) - mat(k,441) = -rxt(k,233)*y(k,88) - mat(k,787) = -rxt(k,234)*y(k,88) - mat(k,343) = -rxt(k,235)*y(k,88) - mat(k,655) = -rxt(k,236)*y(k,88) - mat(k,300) = -rxt(k,237)*y(k,88) - mat(k,1304) = -rxt(k,238)*y(k,88) - mat(k,626) = -rxt(k,239)*y(k,88) - mat(k,522) = -rxt(k,240)*y(k,88) - mat(k,314) = -rxt(k,241)*y(k,88) - mat(k,601) = -rxt(k,243)*y(k,88) - mat(k,503) = -rxt(k,244)*y(k,88) - mat(k,374) = -rxt(k,245)*y(k,88) - mat(k,388) = -rxt(k,246)*y(k,88) - mat(k,359) = -rxt(k,247)*y(k,88) - mat(k,481) = -rxt(k,248)*y(k,88) - mat(k,715) = -rxt(k,249)*y(k,88) - mat(k,1803) = -rxt(k,360)*y(k,88) - mat(k,1391) = -rxt(k,363)*y(k,88) - mat(k,1020) = -rxt(k,561)*y(k,88) - mat(k,274) = rxt(k,570)*y(k,99) - mat(k,1750) = rxt(k,572)*y(k,99) - mat(k,977) = rxt(k,565)*y(k,80) - mat(k,1268) = rxt(k,569)*y(k,94) - mat(k,90) = rxt(k,565)*y(k,54) - mat(k,179) = rxt(k,569)*y(k,55) - mat(k,1349) = rxt(k,570)*y(k,48) + rxt(k,572)*y(k,51) - mat(k,922) = -(rxt(k,215)*y(k,87) + rxt(k,216)*y(k,65) + rxt(k,217)*y(k,63) & - + rxt(k,218)*y(k,83) + rxt(k,219)*y(k,71) + rxt(k,221)*y(k,98) & - + rxt(k,222)*y(k,68) + rxt(k,223)*y(k,85) + rxt(k,224)*y(k,66) & - + rxt(k,225)*y(k,61) + rxt(k,226)*y(k,67) + rxt(k,227)*y(k,82) & - + rxt(k,228)*y(k,86) + rxt(k,229)*y(k,62) + rxt(k,230)*y(k,84) & - + rxt(k,232)*y(k,81) + rxt(k,298)*y(k,69) + rxt(k,362)*y(k,110)) - mat(k,442) = -rxt(k,215)*y(k,89) - mat(k,788) = -rxt(k,216)*y(k,89) - mat(k,344) = -rxt(k,217)*y(k,89) - mat(k,656) = -rxt(k,218)*y(k,89) - mat(k,301) = -rxt(k,219)*y(k,89) - mat(k,1305) = -rxt(k,221)*y(k,89) - mat(k,627) = -rxt(k,222)*y(k,89) - mat(k,523) = -rxt(k,223)*y(k,89) - mat(k,315) = -rxt(k,224)*y(k,89) - mat(k,602) = -rxt(k,225)*y(k,89) - mat(k,504) = -rxt(k,226)*y(k,89) - mat(k,375) = -rxt(k,227)*y(k,89) - mat(k,389) = -rxt(k,228)*y(k,89) - mat(k,360) = -rxt(k,229)*y(k,89) - mat(k,482) = -rxt(k,230)*y(k,89) - mat(k,716) = -rxt(k,232)*y(k,89) - mat(k,1021) = -rxt(k,298)*y(k,89) - mat(k,1804) = -rxt(k,362)*y(k,89) - mat(k,1063) = rxt(k,361)*y(k,110) - mat(k,1804) = mat(k,1804) + rxt(k,361)*y(k,92) - mat(k,45) = -(rxt(k,299)*y(k,69) + rxt(k,300)*y(k,110)) - mat(k,1001) = -rxt(k,299)*y(k,90) - mat(k,1777) = -rxt(k,300)*y(k,90) - mat(k,901) = rxt(k,362)*y(k,110) - mat(k,1777) = mat(k,1777) + rxt(k,362)*y(k,89) - mat(k,116) = -(rxt(k,301)*y(k,69) + rxt(k,302)*y(k,110)) - mat(k,1007) = -rxt(k,301)*y(k,91) - mat(k,1780) = -rxt(k,302)*y(k,91) - mat(k,1375) = rxt(k,363)*y(k,88) + rxt(k,307)*y(k,93) - mat(k,854) = rxt(k,363)*y(k,28) - mat(k,109) = rxt(k,307)*y(k,28) - mat(k,1066) = -(rxt(k,197)*y(k,87) + rxt(k,199)*y(k,65) + rxt(k,200)*y(k,63) & - + rxt(k,201)*y(k,83) + rxt(k,202)*y(k,71) + rxt(k,203)*y(k,98) & - + rxt(k,204)*y(k,68) + rxt(k,205)*y(k,85) + rxt(k,206)*y(k,66) & - + rxt(k,207)*y(k,61) + rxt(k,208)*y(k,67) + rxt(k,210)*y(k,82) & - + rxt(k,211)*y(k,86) + rxt(k,212)*y(k,62) + rxt(k,213)*y(k,84) & - + rxt(k,214)*y(k,81) + rxt(k,303)*y(k,69) + rxt(k,304)*y(k,32) & - + rxt(k,305)*y(k,43) + rxt(k,306)*y(k,104) + rxt(k,361)*y(k,110)) - mat(k,443) = -rxt(k,197)*y(k,92) - mat(k,791) = -rxt(k,199)*y(k,92) - mat(k,345) = -rxt(k,200)*y(k,92) - mat(k,659) = -rxt(k,201)*y(k,92) - mat(k,302) = -rxt(k,202)*y(k,92) - mat(k,1308) = -rxt(k,203)*y(k,92) - mat(k,630) = -rxt(k,204)*y(k,92) - mat(k,525) = -rxt(k,205)*y(k,92) - mat(k,317) = -rxt(k,206)*y(k,92) - mat(k,604) = -rxt(k,207)*y(k,92) - mat(k,506) = -rxt(k,208)*y(k,92) - mat(k,376) = -rxt(k,210)*y(k,92) - mat(k,390) = -rxt(k,211)*y(k,92) - mat(k,361) = -rxt(k,212)*y(k,92) - mat(k,484) = -rxt(k,213)*y(k,92) - mat(k,719) = -rxt(k,214)*y(k,92) - mat(k,1024) = -rxt(k,303)*y(k,92) - mat(k,1712) = -rxt(k,304)*y(k,92) - mat(k,691) = -rxt(k,305)*y(k,92) - mat(k,760) = -rxt(k,306)*y(k,92) - mat(k,1807) = -rxt(k,361)*y(k,92) - mat(k,882) = rxt(k,360)*y(k,110) - mat(k,119) = rxt(k,302)*y(k,110) - mat(k,112) = rxt(k,308)*y(k,110) - mat(k,1807) = mat(k,1807) + rxt(k,360)*y(k,88) + rxt(k,302)*y(k,91) & - + rxt(k,308)*y(k,93) - mat(k,108) = -(rxt(k,307)*y(k,28) + rxt(k,308)*y(k,110) + rxt(k,379)*y(k,69)) - mat(k,1374) = -rxt(k,307)*y(k,93) - mat(k,1779) = -rxt(k,308)*y(k,93) - mat(k,1006) = -rxt(k,379)*y(k,93) - mat(k,176) = -(rxt(k,567)*y(k,54) + (rxt(k,568) + rxt(k,569)) * y(k,55)) - mat(k,954) = -rxt(k,567)*y(k,94) - mat(k,1254) = -(rxt(k,568) + rxt(k,569)) * y(k,94) - mat(k,160) = rxt(k,575)*y(k,107) - mat(k,243) = rxt(k,575)*y(k,79) - mat(k,573) = -(rxt(k,384)*y(k,33) + rxt(k,385)*y(k,110) + (rxt(k,387) & - + rxt(k,388)) * y(k,55) + rxt(k,389)*y(k,56) + (rxt(k,477) & - + rxt(k,478)) * y(k,40) + (rxt(k,500) + rxt(k,501)) * y(k,36) & - + rxt(k,506)*y(k,29) + rxt(k,507)*y(k,30)) - mat(k,421) = -rxt(k,384)*y(k,95) - mat(k,1795) = -rxt(k,385)*y(k,95) - mat(k,1260) = -(rxt(k,387) + rxt(k,388)) * y(k,95) - mat(k,1421) = -rxt(k,389)*y(k,95) - mat(k,1465) = -(rxt(k,477) + rxt(k,478)) * y(k,95) - mat(k,194) = -(rxt(k,500) + rxt(k,501)) * y(k,95) - mat(k,6) = -rxt(k,506)*y(k,95) - mat(k,14) = -rxt(k,507)*y(k,95) - mat(k,1260) = mat(k,1260) + rxt(k,420)*y(k,79) - mat(k,1016) = .850_r8*rxt(k,562)*y(k,99) - mat(k,163) = rxt(k,420)*y(k,55) - mat(k,1340) = .850_r8*rxt(k,562)*y(k,69) - mat(k,219) = -(rxt(k,316)*y(k,98) + rxt(k,334)*y(k,103) + rxt(k,356)*y(k,106) & - + rxt(k,391)*y(k,54) + rxt(k,392)*y(k,55)) - mat(k,1293) = -rxt(k,316)*y(k,96) - mat(k,284) = -rxt(k,334)*y(k,96) - mat(k,1616) = -rxt(k,356)*y(k,96) - mat(k,959) = -rxt(k,391)*y(k,96) - mat(k,1255) = -rxt(k,392)*y(k,96) - mat(k,1377) = rxt(k,393)*y(k,97) - mat(k,959) = mat(k,959) + rxt(k,395)*y(k,97) - mat(k,1255) = mat(k,1255) + rxt(k,396)*y(k,97) - mat(k,1415) = rxt(k,397)*y(k,97) - mat(k,31) = rxt(k,393)*y(k,28) + rxt(k,395)*y(k,54) + rxt(k,396)*y(k,55) & - + rxt(k,397)*y(k,56) - end do + mat(560) = -(rxt(384)*y(35) + rxt(385)*y(110) + (rxt(387) + rxt(388)) * y(56) & + + rxt(389)*y(57) + (rxt(477) + rxt(478)) * y(42) + (rxt(500) & + + rxt(501)) * y(38) + rxt(506)*y(31) + rxt(507)*y(32)) + mat(433) = -rxt(384)*y(95) + mat(1716) = -rxt(385)*y(95) + mat(1142) = -(rxt(387) + rxt(388)) * y(95) + mat(1590) = -rxt(389)*y(95) + mat(895) = -(rxt(477) + rxt(478)) * y(95) + mat(182) = -(rxt(500) + rxt(501)) * y(95) + mat(6) = -rxt(506)*y(95) + mat(14) = -rxt(507)*y(95) + mat(1142) = mat(1142) + rxt(420)*y(79) + mat(1393) = .850_r8*rxt(562)*y(99) + mat(150) = rxt(420)*y(56) + mat(1263) = .850_r8*rxt(562)*y(68) + mat(195) = -(rxt(316)*y(98) + rxt(334)*y(103) + rxt(356)*y(106) + rxt(391) & + *y(55) + rxt(392)*y(56)) + mat(1216) = -rxt(316)*y(96) + mat(291) = -rxt(334)*y(96) + mat(1548) = -rxt(356)*y(96) + mat(1474) = -rxt(391)*y(96) + mat(1137) = -rxt(392)*y(96) + mat(1474) = mat(1474) + rxt(395)*y(97) + mat(1137) = mat(1137) + rxt(396)*y(97) + mat(1584) = rxt(397)*y(97) + mat(23) = rxt(395)*y(55) + rxt(396)*y(56) + rxt(397)*y(57) + mat(22) = -(rxt(395)*y(55) + rxt(396)*y(56) + rxt(397)*y(57)) + mat(1461) = -rxt(395)*y(97) + mat(1130) = -rxt(396)*y(97) + mat(1583) = -rxt(397)*y(97) + mat(1130) = mat(1130) + rxt(387)*y(95) + mat(550) = rxt(387)*y(56) + mat(1237) = -(rxt(145)*y(99) + rxt(168)*y(77) + rxt(185)*y(73) + rxt(203) & + *y(92) + rxt(209)*y(75) + rxt(221)*y(89) + rxt(238)*y(88) & + + rxt(309)*y(23) + rxt(310)*y(26) + rxt(312)*y(34) + rxt(313) & + *y(42) + rxt(314)*y(44) + rxt(315)*y(53) + rxt(316)*y(96) & + + rxt(317)*y(56) + rxt(318)*y(57) + (rxt(319) + rxt(320) & + ) * y(55)) + mat(1281) = -rxt(145)*y(98) + mat(1448) = -rxt(168)*y(98) + mat(1031) = -rxt(185)*y(98) + mat(989) = -rxt(203)*y(98) + mat(1364) = -rxt(209)*y(98) + mat(869) = -rxt(221)*y(98) + mat(827) = -rxt(238)*y(98) + mat(1202) = -rxt(309)*y(98) + mat(1117) = -rxt(310)*y(98) + mat(948) = -rxt(312)*y(98) + mat(913) = -rxt(313)*y(98) + mat(1647) = -rxt(314)*y(98) + mat(1075) = -rxt(315)*y(98) + mat(198) = -rxt(316)*y(98) + mat(1160) = -rxt(317)*y(98) + mat(1608) = -rxt(318)*y(98) + mat(1503) = -(rxt(319) + rxt(320)) * y(98) + mat(1503) = mat(1503) + rxt(120)*y(64) + rxt(329)*y(101) + mat(1160) = mat(1160) + (rxt(128)+rxt(130))*y(68) + mat(751) = rxt(120)*y(55) + mat(1406) = (rxt(128)+rxt(130))*y(56) + mat(383) = rxt(329)*y(55) + mat(1282) = -(rxt(143)*y(83) + rxt(144)*y(70) + rxt(145)*y(98) + rxt(146) & + *y(67) + rxt(147)*y(85) + rxt(148)*y(65) + rxt(149)*y(60) & + + rxt(150)*y(66) + rxt(151)*y(82) + rxt(152)*y(86) + rxt(154) & + *y(61) + rxt(155)*y(84) + rxt(156)*y(81) + rxt(250)*y(87) & + + rxt(251)*y(64) + rxt(252)*y(62) + rxt(324)*y(110) + rxt(359) & + *y(56) + rxt(562)*y(68) + rxt(570)*y(49) + rxt(572)*y(52)) + mat(647) = -rxt(143)*y(99) + mat(285) = -rxt(144)*y(99) + mat(1238) = -rxt(145)*y(99) + mat(601) = -rxt(146)*y(99) + mat(516) = -rxt(147)*y(99) + mat(312) = -rxt(148)*y(99) + mat(625) = -rxt(149)*y(99) + mat(498) = -rxt(150)*y(99) + mat(371) = -rxt(151)*y(99) + mat(399) = -rxt(152)*y(99) + mat(357) = -rxt(154)*y(99) + mat(476) = -rxt(155)*y(99) + mat(781) = -rxt(156)*y(99) + mat(457) = -rxt(250)*y(99) + mat(752) = -rxt(251)*y(99) + mat(341) = -rxt(252)*y(99) + mat(1734) = -rxt(324)*y(99) + mat(1161) = -rxt(359)*y(99) + mat(1407) = -rxt(562)*y(99) + mat(261) = -rxt(570)*y(99) + mat(1323) = -rxt(572)*y(99) + mat(1504) = rxt(333)*y(103) + mat(1161) = mat(1161) + rxt(564)*y(80) + rxt(568)*y(94) + rxt(576)*y(107) & + + rxt(580)*y(108) + mat(108) = rxt(564)*y(56) + mat(177) = rxt(568)*y(56) + mat(199) = rxt(334)*y(103) + mat(1238) = mat(1238) + 2.000_r8*rxt(145)*y(99) + mat(1282) = mat(1282) + 2.000_r8*rxt(145)*y(98) + mat(298) = rxt(333)*y(55) + rxt(334)*y(96) + mat(214) = rxt(576)*y(56) + mat(88) = rxt(580)*y(56) + mat(138) = -(rxt(321)*y(68) + (rxt(322) + rxt(323)) * y(110)) + mat(1387) = -rxt(321)*y(100) + mat(1704) = -(rxt(322) + rxt(323)) * y(100) + mat(1250) = rxt(324)*y(110) + mat(290) = rxt(332)*y(110) + mat(1704) = mat(1704) + rxt(324)*y(99) + rxt(332)*y(103) + mat(376) = -((rxt(267) + rxt(274)) * y(52) + (rxt(272) + rxt(273)) * y(53) & + + rxt(326)*y(34) + rxt(327)*y(57) + (rxt(328) + rxt(329) & + ) * y(55)) + mat(1300) = -(rxt(267) + rxt(274)) * y(101) + mat(1051) = -(rxt(272) + rxt(273)) * y(101) + mat(927) = -rxt(326)*y(101) + mat(1587) = -rxt(327)*y(101) + mat(1481) = -(rxt(328) + rxt(329)) * y(101) + mat(1481) = mat(1481) + rxt(331)*y(102) + mat(1141) = rxt(121)*y(64) + rxt(357)*y(106) + mat(1587) = mat(1587) + rxt(127)*y(67) + rxt(318)*y(98) + rxt(343)*y(105) & + + rxt(358)*y(106) + mat(733) = rxt(121)*y(56) + mat(582) = rxt(127)*y(57) + mat(1219) = rxt(318)*y(57) + mat(52) = rxt(331)*y(55) + mat(1518) = rxt(343)*y(57) + mat(1550) = rxt(357)*y(56) + rxt(358)*y(57) + mat(51) = -(rxt(331)*y(55)) + mat(1462) = -rxt(331)*y(102) + mat(1131) = rxt(317)*y(98) + mat(1215) = rxt(317)*y(56) + mat(292) = -(rxt(332)*y(110) + rxt(333)*y(55) + rxt(334)*y(96) + rxt(375) & + *y(68)) + mat(1707) = -rxt(332)*y(103) + mat(1479) = -rxt(333)*y(103) + mat(196) = -rxt(334)*y(103) + mat(1392) = -rxt(375)*y(103) + mat(1140) = rxt(359)*y(99) + mat(1253) = rxt(359)*y(56) + mat(711) = -(rxt(306)*y(92) + rxt(335)*y(48) + rxt(344)*y(52) + rxt(410) & + *y(35) + rxt(411)*y(37) + rxt(412)*y(71) + rxt(413)*y(55) & + + rxt(414)*y(57) + (4._r8*rxt(415) + 4._r8*rxt(416)) * y(104) & + + rxt(418)*y(45) + rxt(432)*y(54) + rxt(433)*y(49) + rxt(441) & + *y(53) + rxt(442)*y(44) + rxt(461)*y(27) + (rxt(463) + rxt(464) & + ) * y(26) + rxt(466)*y(42) + rxt(469)*y(47) + rxt(493)*y(3) & + + rxt(495)*y(38) + rxt(527)*y(15) + rxt(530)*y(20) + (rxt(532) & + + rxt(536)) * y(29)) + mat(976) = -rxt(306)*y(104) + mat(125) = -rxt(335)*y(104) + mat(1309) = -rxt(344)*y(104) + mat(435) = -rxt(410)*y(104) + mat(113) = -rxt(411)*y(104) + mat(671) = -rxt(412)*y(104) + mat(1490) = -rxt(413)*y(104) + mat(1595) = -rxt(414)*y(104) + mat(59) = -rxt(418)*y(104) + mat(1669) = -rxt(432)*y(104) + mat(256) = -rxt(433)*y(104) + mat(1062) = -rxt(441)*y(104) + mat(1634) = -rxt(442)*y(104) + mat(220) = -rxt(461)*y(104) + mat(1104) = -(rxt(463) + rxt(464)) * y(104) + mat(900) = -rxt(466)*y(104) + mat(189) = -rxt(469)*y(104) + mat(415) = -rxt(493)*y(104) + mat(183) = -rxt(495)*y(104) + mat(532) = -rxt(527)*y(104) + mat(36) = -rxt(530)*y(104) + mat(100) = -(rxt(532) + rxt(536)) * y(104) + mat(532) = mat(532) + rxt(526)*y(55) + mat(36) = mat(36) + .300_r8*rxt(530)*y(104) + mat(1189) = rxt(450)*y(71) + rxt(336)*y(105) + mat(1104) = mat(1104) + rxt(337)*y(105) + mat(158) = rxt(504)*y(110) + mat(935) = rxt(409)*y(57) + rxt(124)*y(67) + 2.000_r8*rxt(404)*y(71) + mat(435) = mat(435) + rxt(401)*y(55) + rxt(384)*y(95) + mat(113) = mat(113) + rxt(402)*y(55) + mat(183) = mat(183) + rxt(494)*y(55) + rxt(500)*y(95) + mat(900) = mat(900) + rxt(465)*y(55) + rxt(477)*y(95) + rxt(351)*y(106) + mat(1634) = mat(1634) + rxt(119)*y(64) + rxt(352)*y(106) + mat(167) = rxt(496)*y(55) + mat(189) = mat(189) + rxt(468)*y(55) + mat(1309) = mat(1309) + rxt(434)*y(71) + mat(1062) = mat(1062) + rxt(341)*y(105) + mat(1669) = mat(1669) + rxt(429)*y(71) + mat(1490) = mat(1490) + rxt(526)*y(15) + rxt(401)*y(35) + rxt(402)*y(37) & + + rxt(494)*y(38) + rxt(465)*y(42) + rxt(496)*y(46) + rxt(468) & + *y(47) + rxt(407)*y(71) + mat(1595) = mat(1595) + rxt(409)*y(34) + rxt(408)*y(71) + rxt(343)*y(105) + mat(738) = rxt(119)*y(44) + mat(587) = rxt(124)*y(34) + mat(1395) = rxt(133)*y(69) + mat(41) = rxt(133)*y(68) + rxt(134)*y(110) + mat(278) = rxt(184)*y(73) + rxt(198)*y(75) + rxt(167)*y(77) + rxt(237)*y(88) & + + rxt(219)*y(89) + rxt(202)*y(92) + rxt(144)*y(99) + mat(671) = mat(671) + rxt(450)*y(23) + 2.000_r8*rxt(404)*y(34) + rxt(434) & + *y(52) + rxt(429)*y(54) + rxt(407)*y(55) + rxt(408)*y(57) + mat(1018) = rxt(184)*y(70) + mat(1351) = rxt(198)*y(70) + mat(1435) = rxt(167)*y(70) + mat(814) = rxt(237)*y(70) + mat(856) = rxt(219)*y(70) + mat(976) = mat(976) + rxt(202)*y(70) + mat(562) = rxt(384)*y(35) + rxt(500)*y(38) + rxt(477)*y(42) & + + 2.000_r8*rxt(385)*y(110) + mat(1268) = rxt(144)*y(70) + mat(139) = rxt(323)*y(110) + mat(711) = mat(711) + .300_r8*rxt(530)*y(20) + mat(1522) = rxt(336)*y(23) + rxt(337)*y(26) + rxt(341)*y(53) + rxt(343)*y(57) + mat(1557) = rxt(351)*y(42) + rxt(352)*y(44) + rxt(350)*y(110) + mat(1720) = rxt(504)*y(33) + rxt(134)*y(69) + 2.000_r8*rxt(385)*y(95) & + + rxt(323)*y(100) + rxt(350)*y(106) end subroutine nlnmat07 - subroutine nlnmat08( avec_len, mat, y, rxt ) + subroutine nlnmat08( 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) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) !---------------------------------------------- ! ... local variables !---------------------------------------------- - integer :: k !---------------------------------------------- ! ... complete matrix entries implicit species !---------------------------------------------- - do k = 1,avec_len - mat(k,30) = -(rxt(k,393)*y(k,28) + rxt(k,395)*y(k,54) + rxt(k,396)*y(k,55) & - + rxt(k,397)*y(k,56)) - mat(k,1372) = -rxt(k,393)*y(k,97) - mat(k,944) = -rxt(k,395)*y(k,97) - mat(k,1248) = -rxt(k,396)*y(k,97) - mat(k,1414) = -rxt(k,397)*y(k,97) - mat(k,1248) = mat(k,1248) + rxt(k,387)*y(k,95) - mat(k,563) = rxt(k,387)*y(k,55) - mat(k,1314) = -(rxt(k,145)*y(k,99) + rxt(k,168)*y(k,77) + rxt(k,185)*y(k,73) & - + rxt(k,203)*y(k,92) + rxt(k,209)*y(k,75) + rxt(k,221)*y(k,89) & - + rxt(k,238)*y(k,88) + rxt(k,309)*y(k,60) + rxt(k,310)*y(k,24) & - + rxt(k,311)*y(k,28) + rxt(k,312)*y(k,32) + rxt(k,313)*y(k,40) & - + rxt(k,314)*y(k,42) + rxt(k,315)*y(k,52) + rxt(k,316)*y(k,96) & - + rxt(k,317)*y(k,55) + rxt(k,318)*y(k,56) + (rxt(k,319) & - + rxt(k,320)) * y(k,54)) - mat(k,1359) = -rxt(k,145)*y(k,98) - mat(k,1570) = -rxt(k,168)*y(k,98) - mat(k,840) = -rxt(k,185)*y(k,98) - mat(k,1072) = -rxt(k,203)*y(k,98) - mat(k,1200) = -rxt(k,209)*y(k,98) - mat(k,931) = -rxt(k,221)*y(k,98) - mat(k,888) = -rxt(k,238)*y(k,98) - mat(k,1682) = -rxt(k,309)*y(k,98) - mat(k,1527) = -rxt(k,310)*y(k,98) - mat(k,1401) = -rxt(k,311)*y(k,98) - mat(k,1718) = -rxt(k,312)*y(k,98) - mat(k,1484) = -rxt(k,313)*y(k,98) - mat(k,1112) = -rxt(k,314)*y(k,98) - mat(k,1157) = -rxt(k,315)*y(k,98) - mat(k,223) = -rxt(k,316)*y(k,98) - mat(k,1278) = -rxt(k,317)*y(k,98) - mat(k,1439) = -rxt(k,318)*y(k,98) - mat(k,987) = -(rxt(k,319) + rxt(k,320)) * y(k,98) - mat(k,987) = mat(k,987) + rxt(k,120)*y(k,65) + rxt(k,329)*y(k,101) - mat(k,1278) = mat(k,1278) + (rxt(k,128)+rxt(k,130))*y(k,69) - mat(k,797) = rxt(k,120)*y(k,54) - mat(k,1030) = (rxt(k,128)+rxt(k,130))*y(k,55) - mat(k,409) = rxt(k,329)*y(k,54) - mat(k,1360) = -(rxt(k,143)*y(k,83) + rxt(k,144)*y(k,71) + rxt(k,145)*y(k,98) & - + rxt(k,146)*y(k,68) + rxt(k,147)*y(k,85) + rxt(k,148)*y(k,66) & - + rxt(k,149)*y(k,61) + rxt(k,150)*y(k,67) + rxt(k,151)*y(k,82) & - + rxt(k,152)*y(k,86) + rxt(k,154)*y(k,62) + rxt(k,155)*y(k,84) & - + rxt(k,156)*y(k,81) + rxt(k,250)*y(k,87) + rxt(k,251)*y(k,65) & - + rxt(k,252)*y(k,63) + rxt(k,324)*y(k,110) + rxt(k,359)*y(k,55) & - + rxt(k,562)*y(k,69) + rxt(k,570)*y(k,48) + rxt(k,572)*y(k,51)) - mat(k,665) = -rxt(k,143)*y(k,99) - mat(k,305) = -rxt(k,144)*y(k,99) - mat(k,1315) = -rxt(k,145)*y(k,99) - mat(k,636) = -rxt(k,146)*y(k,99) - mat(k,531) = -rxt(k,147)*y(k,99) - mat(k,320) = -rxt(k,148)*y(k,99) - mat(k,609) = -rxt(k,149)*y(k,99) - mat(k,510) = -rxt(k,150)*y(k,99) - mat(k,380) = -rxt(k,151)*y(k,99) - mat(k,395) = -rxt(k,152)*y(k,99) - mat(k,364) = -rxt(k,154)*y(k,99) - mat(k,490) = -rxt(k,155)*y(k,99) - mat(k,725) = -rxt(k,156)*y(k,99) - mat(k,448) = -rxt(k,250)*y(k,99) - mat(k,798) = -rxt(k,251)*y(k,99) - mat(k,348) = -rxt(k,252)*y(k,99) - mat(k,1814) = -rxt(k,324)*y(k,99) - mat(k,1279) = -rxt(k,359)*y(k,99) - mat(k,1031) = -rxt(k,562)*y(k,99) - mat(k,279) = -rxt(k,570)*y(k,99) - mat(k,1761) = -rxt(k,572)*y(k,99) - mat(k,1402) = rxt(k,573)*y(k,107) - mat(k,988) = rxt(k,333)*y(k,103) - mat(k,1279) = mat(k,1279) + rxt(k,564)*y(k,80) + rxt(k,568)*y(k,94) & - + rxt(k,576)*y(k,107) + rxt(k,580)*y(k,108) - mat(k,94) = rxt(k,564)*y(k,55) - mat(k,182) = rxt(k,568)*y(k,55) - mat(k,224) = rxt(k,334)*y(k,103) - mat(k,1315) = mat(k,1315) + 2.000_r8*rxt(k,145)*y(k,99) - mat(k,1360) = mat(k,1360) + 2.000_r8*rxt(k,145)*y(k,98) - mat(k,292) = rxt(k,333)*y(k,54) + rxt(k,334)*y(k,96) - mat(k,252) = rxt(k,573)*y(k,28) + rxt(k,576)*y(k,55) - mat(k,70) = rxt(k,580)*y(k,55) - mat(k,142) = -(rxt(k,321)*y(k,69) + (rxt(k,322) + rxt(k,323)) * y(k,110)) - mat(k,1010) = -rxt(k,321)*y(k,100) - mat(k,1783) = -(rxt(k,322) + rxt(k,323)) * y(k,100) - mat(k,1327) = rxt(k,324)*y(k,110) - mat(k,283) = rxt(k,332)*y(k,110) - mat(k,1783) = mat(k,1783) + rxt(k,324)*y(k,99) + rxt(k,332)*y(k,103) - mat(k,401) = -((rxt(k,267) + rxt(k,274)) * y(k,51) + (rxt(k,272) + rxt(k,273) & - ) * y(k,52) + rxt(k,325)*y(k,28) + rxt(k,326)*y(k,32) + rxt(k,327) & - *y(k,56) + (rxt(k,328) + rxt(k,329)) * y(k,54)) - mat(k,1737) = -(rxt(k,267) + rxt(k,274)) * y(k,101) - mat(k,1132) = -(rxt(k,272) + rxt(k,273)) * y(k,101) - mat(k,1382) = -rxt(k,325)*y(k,101) - mat(k,1696) = -rxt(k,326)*y(k,101) - mat(k,1418) = -rxt(k,327)*y(k,101) - mat(k,964) = -(rxt(k,328) + rxt(k,329)) * y(k,101) - mat(k,964) = mat(k,964) + rxt(k,331)*y(k,102) - mat(k,1259) = rxt(k,121)*y(k,65) + rxt(k,357)*y(k,106) - mat(k,1418) = mat(k,1418) + rxt(k,127)*y(k,68) + rxt(k,318)*y(k,98) & - + rxt(k,343)*y(k,105) + rxt(k,358)*y(k,106) - mat(k,778) = rxt(k,121)*y(k,55) - mat(k,617) = rxt(k,127)*y(k,56) - mat(k,1295) = rxt(k,318)*y(k,56) - mat(k,96) = rxt(k,331)*y(k,54) - mat(k,1585) = rxt(k,343)*y(k,56) - mat(k,1618) = rxt(k,357)*y(k,55) + rxt(k,358)*y(k,56) - mat(k,95) = -(rxt(k,330)*y(k,28) + rxt(k,331)*y(k,54)) - mat(k,1373) = -rxt(k,330)*y(k,102) - mat(k,950) = -rxt(k,331)*y(k,102) - mat(k,1252) = rxt(k,317)*y(k,98) - mat(k,1291) = rxt(k,317)*y(k,55) - mat(k,285) = -(rxt(k,332)*y(k,110) + rxt(k,333)*y(k,54) + rxt(k,334)*y(k,96) & - + rxt(k,375)*y(k,69)) - mat(k,1786) = -rxt(k,332)*y(k,103) - mat(k,962) = -rxt(k,333)*y(k,103) - mat(k,220) = -rxt(k,334)*y(k,103) - mat(k,1015) = -rxt(k,375)*y(k,103) - mat(k,1258) = rxt(k,359)*y(k,99) - mat(k,1329) = rxt(k,359)*y(k,55) - mat(k,755) = -(rxt(k,306)*y(k,92) + rxt(k,335)*y(k,47) + rxt(k,344)*y(k,51) & - + rxt(k,410)*y(k,33) + rxt(k,411)*y(k,35) + rxt(k,412)*y(k,43) & - + rxt(k,413)*y(k,54) + rxt(k,414)*y(k,56) + (4._r8*rxt(k,415) & - + 4._r8*rxt(k,416)) * y(k,104) + rxt(k,418)*y(k,44) + rxt(k,432) & - *y(k,53) + rxt(k,433)*y(k,48) + rxt(k,441)*y(k,52) + rxt(k,442) & - *y(k,42) + rxt(k,461)*y(k,25) + (rxt(k,463) + rxt(k,464) & - ) * y(k,24) + rxt(k,466)*y(k,40) + rxt(k,469)*y(k,46) + rxt(k,493) & - *y(k,2) + rxt(k,495)*y(k,36) + rxt(k,527)*y(k,14) + rxt(k,530) & - *y(k,19) + (rxt(k,532) + rxt(k,536)) * y(k,27)) - mat(k,1059) = -rxt(k,306)*y(k,104) - mat(k,124) = -rxt(k,335)*y(k,104) - mat(k,1747) = -rxt(k,344)*y(k,104) - mat(k,423) = -rxt(k,410)*y(k,104) - mat(k,81) = -rxt(k,411)*y(k,104) - mat(k,687) = -rxt(k,412)*y(k,104) - mat(k,974) = -rxt(k,413)*y(k,104) - mat(k,1426) = -rxt(k,414)*y(k,104) - mat(k,53) = -rxt(k,418)*y(k,104) - mat(k,1223) = -rxt(k,432)*y(k,104) - mat(k,273) = -rxt(k,433)*y(k,104) - mat(k,1144) = -rxt(k,441)*y(k,104) - mat(k,1099) = -rxt(k,442)*y(k,104) - mat(k,202) = -rxt(k,461)*y(k,104) - mat(k,1514) = -(rxt(k,463) + rxt(k,464)) * y(k,104) - mat(k,1471) = -rxt(k,466)*y(k,104) - mat(k,185) = -rxt(k,469)*y(k,104) - mat(k,461) = -rxt(k,493)*y(k,104) - mat(k,195) = -rxt(k,495)*y(k,104) - mat(k,544) = -rxt(k,527)*y(k,104) - mat(k,42) = -rxt(k,530)*y(k,104) - mat(k,130) = -(rxt(k,532) + rxt(k,536)) * y(k,104) - mat(k,544) = mat(k,544) + rxt(k,526)*y(k,54) - mat(k,42) = mat(k,42) + .300_r8*rxt(k,530)*y(k,104) - mat(k,1514) = mat(k,1514) + rxt(k,337)*y(k,105) - mat(k,171) = rxt(k,504)*y(k,110) - mat(k,1705) = 2.000_r8*rxt(k,404)*y(k,43) + rxt(k,409)*y(k,56) + rxt(k,124) & - *y(k,68) - mat(k,423) = mat(k,423) + rxt(k,401)*y(k,54) + rxt(k,384)*y(k,95) - mat(k,81) = mat(k,81) + rxt(k,402)*y(k,54) - mat(k,195) = mat(k,195) + rxt(k,494)*y(k,54) + rxt(k,500)*y(k,95) - mat(k,1471) = mat(k,1471) + rxt(k,465)*y(k,54) + rxt(k,477)*y(k,95) & - + rxt(k,351)*y(k,106) - mat(k,1099) = mat(k,1099) + rxt(k,119)*y(k,65) + rxt(k,352)*y(k,106) - mat(k,687) = mat(k,687) + 2.000_r8*rxt(k,404)*y(k,32) + rxt(k,434)*y(k,51) & - + rxt(k,429)*y(k,53) + rxt(k,407)*y(k,54) + rxt(k,408)*y(k,56) & - + rxt(k,450)*y(k,60) - mat(k,154) = rxt(k,496)*y(k,54) - mat(k,185) = mat(k,185) + rxt(k,468)*y(k,54) - mat(k,1747) = mat(k,1747) + rxt(k,434)*y(k,43) - mat(k,1144) = mat(k,1144) + rxt(k,341)*y(k,105) - mat(k,1223) = mat(k,1223) + rxt(k,429)*y(k,43) - mat(k,974) = mat(k,974) + rxt(k,526)*y(k,14) + rxt(k,401)*y(k,33) & - + rxt(k,402)*y(k,35) + rxt(k,494)*y(k,36) + rxt(k,465)*y(k,40) & - + rxt(k,407)*y(k,43) + rxt(k,496)*y(k,45) + rxt(k,468)*y(k,46) - mat(k,1426) = mat(k,1426) + rxt(k,409)*y(k,32) + rxt(k,408)*y(k,43) & - + rxt(k,343)*y(k,105) - mat(k,1669) = rxt(k,450)*y(k,43) + rxt(k,336)*y(k,105) - mat(k,784) = rxt(k,119)*y(k,42) - mat(k,623) = rxt(k,124)*y(k,32) - mat(k,1018) = rxt(k,133)*y(k,70) - mat(k,35) = rxt(k,133)*y(k,69) + rxt(k,134)*y(k,110) - mat(k,298) = rxt(k,184)*y(k,73) + rxt(k,198)*y(k,75) + rxt(k,167)*y(k,77) & - + rxt(k,237)*y(k,88) + rxt(k,219)*y(k,89) + rxt(k,202)*y(k,92) & - + rxt(k,144)*y(k,99) - mat(k,827) = rxt(k,184)*y(k,71) - mat(k,1187) = rxt(k,198)*y(k,71) - mat(k,1557) = rxt(k,167)*y(k,71) - mat(k,875) = rxt(k,237)*y(k,71) - mat(k,918) = rxt(k,219)*y(k,71) - mat(k,1059) = mat(k,1059) + rxt(k,202)*y(k,71) - mat(k,575) = rxt(k,384)*y(k,33) + rxt(k,500)*y(k,36) + rxt(k,477)*y(k,40) & - + 2.000_r8*rxt(k,385)*y(k,110) - mat(k,1346) = rxt(k,144)*y(k,71) - mat(k,143) = rxt(k,323)*y(k,110) - mat(k,755) = mat(k,755) + .300_r8*rxt(k,530)*y(k,19) - mat(k,1590) = rxt(k,337)*y(k,24) + rxt(k,341)*y(k,52) + rxt(k,343)*y(k,56) & - + rxt(k,336)*y(k,60) - mat(k,1626) = rxt(k,351)*y(k,40) + rxt(k,352)*y(k,42) + rxt(k,350)*y(k,110) - mat(k,1800) = rxt(k,504)*y(k,31) + rxt(k,134)*y(k,70) + 2.000_r8*rxt(k,385) & - *y(k,95) + rxt(k,323)*y(k,100) + rxt(k,350)*y(k,106) - mat(k,1610) = -(rxt(k,336)*y(k,60) + rxt(k,337)*y(k,24) + rxt(k,338)*y(k,28) & - + rxt(k,339)*y(k,32) + rxt(k,340)*y(k,40) + rxt(k,341)*y(k,52) & - + rxt(k,342)*y(k,54) + rxt(k,343)*y(k,56)) - mat(k,1689) = -rxt(k,336)*y(k,105) - mat(k,1534) = -rxt(k,337)*y(k,105) - mat(k,1408) = -rxt(k,338)*y(k,105) - mat(k,1725) = -rxt(k,339)*y(k,105) - mat(k,1491) = -rxt(k,340)*y(k,105) - mat(k,1164) = -rxt(k,341)*y(k,105) - mat(k,994) = -rxt(k,342)*y(k,105) - mat(k,1446) = -rxt(k,343)*y(k,105) - mat(k,1725) = mat(k,1725) + rxt(k,112)*y(k,65) + rxt(k,282)*y(k,81) & - + rxt(k,326)*y(k,101) - mat(k,432) = rxt(k,349)*y(k,106) - mat(k,804) = rxt(k,112)*y(k,32) - mat(k,730) = rxt(k,282)*y(k,32) - mat(k,412) = rxt(k,326)*y(k,32) - mat(k,1646) = rxt(k,349)*y(k,33) + rxt(k,350)*y(k,110) - mat(k,1820) = rxt(k,350)*y(k,106) - end do + mat(1542) = -(rxt(336)*y(23) + rxt(337)*y(26) + rxt(339)*y(34) + rxt(340) & + *y(42) + rxt(341)*y(53) + rxt(342)*y(55) + rxt(343)*y(57)) + mat(1209) = -rxt(336)*y(105) + mat(1124) = -rxt(337)*y(105) + mat(955) = -rxt(339)*y(105) + mat(920) = -rxt(340)*y(105) + mat(1082) = -rxt(341)*y(105) + mat(1510) = -rxt(342)*y(105) + mat(1615) = -rxt(343)*y(105) + mat(955) = mat(955) + rxt(112)*y(64) + rxt(282)*y(81) + rxt(326)*y(101) + mat(445) = rxt(349)*y(106) + mat(758) = rxt(112)*y(34) + mat(787) = rxt(282)*y(34) + mat(387) = rxt(326)*y(34) + mat(1577) = rxt(349)*y(35) + rxt(350)*y(110) + mat(1740) = rxt(350)*y(106) + mat(1578) = -(rxt(131)*y(52) + rxt(345)*y(23) + rxt(346)*y(26) + (rxt(348) & + + rxt(349)) * y(35) + rxt(350)*y(110) + rxt(351)*y(42) + rxt(352) & + *y(44) + rxt(354)*y(53) + rxt(355)*y(55) + rxt(356)*y(96) & + + rxt(357)*y(56) + rxt(358)*y(57)) + mat(1330) = -rxt(131)*y(106) + mat(1210) = -rxt(345)*y(106) + mat(1125) = -rxt(346)*y(106) + mat(446) = -(rxt(348) + rxt(349)) * y(106) + mat(1741) = -rxt(350)*y(106) + mat(921) = -rxt(351)*y(106) + mat(1655) = -rxt(352)*y(106) + mat(1083) = -rxt(354)*y(106) + mat(1511) = -rxt(355)*y(106) + mat(201) = -rxt(356)*y(106) + mat(1168) = -rxt(357)*y(106) + mat(1616) = -rxt(358)*y(106) + mat(1511) = mat(1511) + rxt(320)*y(98) + mat(1616) = mat(1616) + rxt(129)*y(68) + mat(1414) = rxt(129)*y(57) + mat(1245) = rxt(320)*y(55) + mat(206) = -(rxt(575)*y(79) + rxt(576)*y(56)) + mat(148) = -rxt(575)*y(107) + mat(1138) = -rxt(576)*y(107) + mat(1475) = rxt(566)*y(80) + rxt(567)*y(94) + rxt(579)*y(108) + rxt(585) & + *y(109) + mat(1390) = rxt(577)*y(108) + rxt(582)*y(109) + mat(104) = rxt(566)*y(55) + mat(173) = rxt(567)*y(55) + mat(86) = rxt(579)*y(55) + rxt(577)*y(68) + mat(81) = rxt(585)*y(55) + rxt(582)*y(68) + mat(84) = -(rxt(577)*y(68) + rxt(579)*y(55) + rxt(580)*y(56)) + mat(1382) = -rxt(577)*y(108) + mat(1464) = -rxt(579)*y(108) + mat(1133) = -rxt(580)*y(108) + mat(1382) = mat(1382) + rxt(581)*y(109) + mat(78) = rxt(581)*y(68) + mat(77) = -((rxt(581) + rxt(582)) * y(68) + rxt(585)*y(55)) + mat(1381) = -(rxt(581) + rxt(582)) * y(109) + mat(1463) = -rxt(585)*y(109) + mat(1745) = -(rxt(102)*y(60) + rxt(113)*y(66) + rxt(114)*y(64) + rxt(134) & + *y(69) + rxt(135)*y(74) + rxt(138)*y(76) + rxt(283)*y(81) & + + rxt(289)*y(85) + rxt(291)*y(83) + rxt(300)*y(90) + rxt(302) & + *y(91) + rxt(308)*y(93) + (rxt(322) + rxt(323)) * y(100) + rxt(324) & + *y(99) + rxt(332)*y(103) + rxt(350)*y(106) + rxt(360)*y(88) & + + rxt(361)*y(92) + rxt(362)*y(89) + rxt(367)*y(78) + rxt(369) & + *y(72) + rxt(371)*y(73) + rxt(373)*y(75) + rxt(385)*y(95) & + + rxt(504)*y(33)) + mat(631) = -rxt(102)*y(110) + mat(503) = -rxt(113)*y(110) + mat(763) = -rxt(114)*y(110) + mat(44) = -rxt(134)*y(110) + mat(28) = -rxt(135)*y(110) + mat(32) = -rxt(138)*y(110) + mat(792) = -rxt(283)*y(110) + mat(523) = -rxt(289)*y(110) + mat(656) = -rxt(291)*y(110) + mat(50) = -rxt(300)*y(110) + mat(76) = -rxt(302)*y(110) + mat(70) = -rxt(308)*y(110) + mat(145) = -(rxt(322) + rxt(323)) * y(110) + mat(1293) = -rxt(324)*y(110) + mat(303) = -rxt(332)*y(110) + mat(1582) = -rxt(350)*y(110) + mat(839) = -rxt(360)*y(110) + mat(1001) = -rxt(361)*y(110) + mat(881) = -rxt(362)*y(110) + mat(134) = -rxt(367)*y(110) + mat(123) = -rxt(369)*y(110) + mat(1043) = -rxt(371)*y(110) + mat(1376) = -rxt(373)*y(110) + mat(580) = -rxt(385)*y(110) + mat(162) = -rxt(504)*y(110) + mat(547) = rxt(527)*y(104) + mat(38) = rxt(530)*y(104) + mat(960) = rxt(405)*y(71) + rxt(339)*y(105) + mat(449) = rxt(410)*y(104) + rxt(348)*y(106) + mat(117) = rxt(411)*y(104) + mat(186) = rxt(495)*y(104) + mat(925) = (rxt(549)+rxt(554))*y(46) + (rxt(542)+rxt(548)+rxt(553))*y(47) & + + rxt(101)*y(61) + rxt(466)*y(104) + rxt(340)*y(105) + mat(1659) = rxt(290)*y(85) + rxt(442)*y(104) + mat(63) = rxt(418)*y(104) + mat(171) = (rxt(549)+rxt(554))*y(42) + mat(194) = (rxt(542)+rxt(548)+rxt(553))*y(42) + rxt(469)*y(104) + mat(128) = rxt(335)*y(104) + mat(250) = rxt(288)*y(84) + mat(1334) = rxt(118)*y(66) + mat(1087) = rxt(115)*y(66) + mat(631) = mat(631) + 3.000_r8*rxt(190)*y(73) + 4.000_r8*rxt(142)*y(75) & + + 5.000_r8*rxt(172)*y(77) + 2.000_r8*rxt(225)*y(89) + rxt(207) & + *y(92) + mat(361) = rxt(101)*y(42) + 4.000_r8*rxt(194)*y(73) + 5.000_r8*rxt(159)*y(75) & + + 6.000_r8*rxt(177)*y(77) + rxt(247)*y(88) + 3.000_r8*rxt(229) & + *y(89) + 2.000_r8*rxt(212)*y(92) + rxt(154)*y(99) + mat(345) = 3.000_r8*rxt(182)*y(73) + (4.000_r8*rxt(176)+4.000_r8*rxt(262)) & + *y(75) + (5.000_r8*rxt(164)+5.000_r8*rxt(263))*y(77) & + + 2.000_r8*rxt(217)*y(89) + rxt(200)*y(92) + mat(763) = mat(763) + 3.000_r8*rxt(181)*y(73) + (4.000_r8*rxt(165) & + +4.000_r8*rxt(253))*y(75) + (5.000_r8*rxt(163) & + +5.000_r8*rxt(260))*y(77) + 2.000_r8*rxt(216)*y(89) + rxt(199) & + *y(92) + mat(317) = 5.000_r8*rxt(189)*y(73) + (6.000_r8*rxt(242)+6.000_r8*rxt(266)) & + *y(75) + (7.000_r8*rxt(171)+7.000_r8*rxt(254))*y(77) & + + 2.000_r8*rxt(241)*y(88) + 4.000_r8*rxt(224)*y(89) & + + 3.000_r8*rxt(206)*y(92) + 2.000_r8*rxt(148)*y(99) + mat(503) = mat(503) + rxt(118)*y(52) + rxt(115)*y(53) + 4.000_r8*rxt(191) & + *y(73) + (5.000_r8*rxt(153)+5.000_r8*rxt(255))*y(75) + ( & + + 6.000_r8*rxt(173)+6.000_r8*rxt(256))*y(77) + rxt(244)*y(88) & + + 3.000_r8*rxt(226)*y(89) + 2.000_r8*rxt(208)*y(92) + rxt(150) & + *y(99) + mat(610) = 3.000_r8*rxt(186)*y(73) + 4.000_r8*rxt(220)*y(75) & + + 5.000_r8*rxt(169)*y(77) + 2.000_r8*rxt(222)*y(89) + rxt(204) & + *y(92) + mat(1418) = rxt(133)*y(69) + 2.000_r8*rxt(377)*y(72) + 3.000_r8*rxt(378) & + *y(73) + 4.000_r8*rxt(136)*y(75) + 5.000_r8*rxt(139)*y(77) & + + rxt(376)*y(78) + 2.000_r8*rxt(298)*y(89) + 3.000_r8*rxt(299) & + *y(90) + rxt(303)*y(92) + rxt(321)*y(100) + mat(44) = mat(44) + rxt(133)*y(68) + mat(289) = 3.000_r8*rxt(184)*y(73) + 4.000_r8*rxt(198)*y(75) & + + 5.000_r8*rxt(167)*y(77) + 2.000_r8*rxt(219)*y(89) + rxt(202) & + *y(92) + mat(690) = rxt(405)*y(34) + rxt(412)*y(104) + mat(123) = mat(123) + 2.000_r8*rxt(377)*y(68) + mat(1043) = mat(1043) + 3.000_r8*rxt(190)*y(60) + 4.000_r8*rxt(194)*y(61) & + + 3.000_r8*rxt(182)*y(62) + 3.000_r8*rxt(181)*y(64) & + + 5.000_r8*rxt(189)*y(65) + 4.000_r8*rxt(191)*y(66) & + + 3.000_r8*rxt(186)*y(67) + 3.000_r8*rxt(378)*y(68) & + + 3.000_r8*rxt(184)*y(70) + 3.000_r8*rxt(196)*y(81) & + + 4.000_r8*rxt(192)*y(82) + 3.000_r8*rxt(183)*y(83) & + + 5.000_r8*rxt(195)*y(84) + 4.000_r8*rxt(188)*y(85) & + + 3.000_r8*rxt(193)*y(86) + 3.000_r8*rxt(180)*y(87) & + + 3.000_r8*rxt(185)*y(98) + mat(1376) = mat(1376) + 4.000_r8*rxt(142)*y(60) + 5.000_r8*rxt(159)*y(61) + ( & + + 4.000_r8*rxt(176)+4.000_r8*rxt(262))*y(62) + ( & + + 4.000_r8*rxt(165)+4.000_r8*rxt(253))*y(64) + ( & + + 6.000_r8*rxt(242)+6.000_r8*rxt(266))*y(65) + ( & + + 5.000_r8*rxt(153)+5.000_r8*rxt(255))*y(66) + 4.000_r8*rxt(220) & + *y(67) + 4.000_r8*rxt(136)*y(68) + 4.000_r8*rxt(198)*y(70) & + + 4.000_r8*rxt(161)*y(81) + 5.000_r8*rxt(157)*y(82) + ( & + + 4.000_r8*rxt(187)+4.000_r8*rxt(259))*y(83) + 6.000_r8*rxt(160) & + *y(84) + (5.000_r8*rxt(231)+5.000_r8*rxt(257))*y(85) & + + 4.000_r8*rxt(158)*y(86) + (4.000_r8*rxt(141)+4.000_r8*rxt(264)) & + *y(87) + 4.000_r8*rxt(209)*y(98) + mat(1460) = 5.000_r8*rxt(172)*y(60) + 6.000_r8*rxt(177)*y(61) + ( & + + 5.000_r8*rxt(164)+5.000_r8*rxt(263))*y(62) + ( & + + 5.000_r8*rxt(163)+5.000_r8*rxt(260))*y(64) + ( & + + 7.000_r8*rxt(171)+7.000_r8*rxt(254))*y(65) + ( & + + 6.000_r8*rxt(173)+6.000_r8*rxt(256))*y(66) + 5.000_r8*rxt(169) & + *y(67) + 5.000_r8*rxt(139)*y(68) + 5.000_r8*rxt(167)*y(70) & + + 5.000_r8*rxt(179)*y(81) + 6.000_r8*rxt(174)*y(82) + ( & + + 5.000_r8*rxt(166)+5.000_r8*rxt(261))*y(83) + 7.000_r8*rxt(178) & + *y(84) + (6.000_r8*rxt(170)+6.000_r8*rxt(258))*y(85) & + + 5.000_r8*rxt(175)*y(86) + (5.000_r8*rxt(162)+5.000_r8*rxt(265)) & + *y(87) + 5.000_r8*rxt(168)*y(98) + mat(134) = mat(134) + rxt(376)*y(68) + mat(792) = mat(792) + 3.000_r8*rxt(196)*y(73) + 4.000_r8*rxt(161)*y(75) & + + 5.000_r8*rxt(179)*y(77) + 2.000_r8*rxt(232)*y(89) + rxt(214) & + *y(92) + mat(375) = 4.000_r8*rxt(192)*y(73) + 5.000_r8*rxt(157)*y(75) & + + 6.000_r8*rxt(174)*y(77) + rxt(245)*y(88) + 3.000_r8*rxt(227) & + *y(89) + 2.000_r8*rxt(210)*y(92) + rxt(151)*y(99) + mat(656) = mat(656) + 3.000_r8*rxt(183)*y(73) + (4.000_r8*rxt(187) & + +4.000_r8*rxt(259))*y(75) + (5.000_r8*rxt(166) & + +5.000_r8*rxt(261))*y(77) + 2.000_r8*rxt(218)*y(89) + rxt(201) & + *y(92) + mat(483) = rxt(288)*y(51) + 5.000_r8*rxt(195)*y(73) + 6.000_r8*rxt(160)*y(75) & + + 7.000_r8*rxt(178)*y(77) + 2.000_r8*rxt(248)*y(88) & + + 4.000_r8*rxt(230)*y(89) + 3.000_r8*rxt(213)*y(92) & + + 2.000_r8*rxt(155)*y(99) + mat(523) = mat(523) + rxt(290)*y(44) + 4.000_r8*rxt(188)*y(73) + ( & + + 5.000_r8*rxt(231)+5.000_r8*rxt(257))*y(75) + ( & + + 6.000_r8*rxt(170)+6.000_r8*rxt(258))*y(77) + rxt(240)*y(88) & + + 3.000_r8*rxt(223)*y(89) + 2.000_r8*rxt(205)*y(92) + rxt(147) & + *y(99) + mat(405) = 3.000_r8*rxt(193)*y(73) + 4.000_r8*rxt(158)*y(75) & + + 5.000_r8*rxt(175)*y(77) + 2.000_r8*rxt(228)*y(89) + rxt(211) & + *y(92) + mat(463) = 3.000_r8*rxt(180)*y(73) + (4.000_r8*rxt(141)+4.000_r8*rxt(264)) & + *y(75) + (5.000_r8*rxt(162)+5.000_r8*rxt(265))*y(77) & + + 2.000_r8*rxt(215)*y(89) + rxt(197)*y(92) + mat(839) = mat(839) + rxt(247)*y(61) + 2.000_r8*rxt(241)*y(65) + rxt(244) & + *y(66) + rxt(245)*y(82) + 2.000_r8*rxt(248)*y(84) + rxt(240) & + *y(85) + mat(881) = mat(881) + 2.000_r8*rxt(225)*y(60) + 3.000_r8*rxt(229)*y(61) & + + 2.000_r8*rxt(217)*y(62) + 2.000_r8*rxt(216)*y(64) & + + 4.000_r8*rxt(224)*y(65) + 3.000_r8*rxt(226)*y(66) & + + 2.000_r8*rxt(222)*y(67) + 2.000_r8*rxt(298)*y(68) & + + 2.000_r8*rxt(219)*y(70) + 2.000_r8*rxt(232)*y(81) & + + 3.000_r8*rxt(227)*y(82) + 2.000_r8*rxt(218)*y(83) & + + 4.000_r8*rxt(230)*y(84) + 3.000_r8*rxt(223)*y(85) & + + 2.000_r8*rxt(228)*y(86) + 2.000_r8*rxt(215)*y(87) & + + 2.000_r8*rxt(221)*y(98) + mat(50) = mat(50) + 3.000_r8*rxt(299)*y(68) + mat(1001) = mat(1001) + rxt(207)*y(60) + 2.000_r8*rxt(212)*y(61) + rxt(200) & + *y(62) + rxt(199)*y(64) + 3.000_r8*rxt(206)*y(65) & + + 2.000_r8*rxt(208)*y(66) + rxt(204)*y(67) + rxt(303)*y(68) & + + rxt(202)*y(70) + rxt(214)*y(81) + 2.000_r8*rxt(210)*y(82) & + + rxt(201)*y(83) + 3.000_r8*rxt(213)*y(84) + 2.000_r8*rxt(205) & + *y(85) + rxt(211)*y(86) + rxt(197)*y(87) + rxt(203)*y(98) + mat(1249) = 3.000_r8*rxt(185)*y(73) + 4.000_r8*rxt(209)*y(75) & + + 5.000_r8*rxt(168)*y(77) + 2.000_r8*rxt(221)*y(89) + rxt(203) & + *y(92) + mat(1293) = mat(1293) + rxt(154)*y(61) + 2.000_r8*rxt(148)*y(65) + rxt(150) & + *y(66) + rxt(151)*y(82) + 2.000_r8*rxt(155)*y(84) + rxt(147) & + *y(85) + mat(145) = mat(145) + rxt(321)*y(68) + mat(731) = rxt(527)*y(15) + rxt(530)*y(20) + rxt(410)*y(35) + rxt(411)*y(37) & + + rxt(495)*y(38) + rxt(466)*y(42) + rxt(442)*y(44) + rxt(418) & + *y(45) + rxt(469)*y(47) + rxt(335)*y(48) + rxt(412)*y(71) & + + 2.000_r8*rxt(415)*y(104) + mat(1547) = rxt(339)*y(34) + rxt(340)*y(42) + mat(1582) = mat(1582) + rxt(348)*y(35) end subroutine nlnmat08 - subroutine nlnmat09( avec_len, mat, y, rxt ) + subroutine nlnmat_finit( mat, lmat, dti ) 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) + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(inout) :: mat(nzcnt) !---------------------------------------------- ! ... local variables !---------------------------------------------- - integer :: k !---------------------------------------------- ! ... complete matrix entries implicit species !---------------------------------------------- - do k = 1,avec_len - mat(k,1647) = -(rxt(k,131)*y(k,51) + rxt(k,345)*y(k,60) + rxt(k,346)*y(k,24) & - + rxt(k,347)*y(k,28) + (rxt(k,348) + rxt(k,349)) * y(k,33) & - + rxt(k,350)*y(k,110) + rxt(k,351)*y(k,40) + rxt(k,352)*y(k,42) & - + rxt(k,354)*y(k,52) + rxt(k,355)*y(k,54) + rxt(k,356)*y(k,96) & - + rxt(k,357)*y(k,55) + rxt(k,358)*y(k,56)) - mat(k,1768) = -rxt(k,131)*y(k,106) - mat(k,1690) = -rxt(k,345)*y(k,106) - mat(k,1535) = -rxt(k,346)*y(k,106) - mat(k,1409) = -rxt(k,347)*y(k,106) - mat(k,433) = -(rxt(k,348) + rxt(k,349)) * y(k,106) - mat(k,1821) = -rxt(k,350)*y(k,106) - mat(k,1492) = -rxt(k,351)*y(k,106) - mat(k,1120) = -rxt(k,352)*y(k,106) - mat(k,1165) = -rxt(k,354)*y(k,106) - mat(k,995) = -rxt(k,355)*y(k,106) - mat(k,226) = -rxt(k,356)*y(k,106) - mat(k,1286) = -rxt(k,357)*y(k,106) - mat(k,1447) = -rxt(k,358)*y(k,106) - mat(k,995) = mat(k,995) + rxt(k,320)*y(k,98) - mat(k,1447) = mat(k,1447) + rxt(k,129)*y(k,69) - mat(k,1038) = rxt(k,129)*y(k,56) - mat(k,1322) = rxt(k,320)*y(k,54) - mat(k,244) = -(rxt(k,573)*y(k,28) + rxt(k,575)*y(k,79) + rxt(k,576)*y(k,55)) - mat(k,1378) = -rxt(k,573)*y(k,107) - mat(k,161) = -rxt(k,575)*y(k,107) - mat(k,1256) = -rxt(k,576)*y(k,107) - mat(k,960) = rxt(k,566)*y(k,80) + rxt(k,567)*y(k,94) + rxt(k,579)*y(k,108) & - + rxt(k,585)*y(k,109) - mat(k,1013) = rxt(k,577)*y(k,108) + rxt(k,582)*y(k,109) - mat(k,88) = rxt(k,566)*y(k,54) - mat(k,177) = rxt(k,567)*y(k,54) - mat(k,67) = rxt(k,579)*y(k,54) + rxt(k,577)*y(k,69) - mat(k,62) = rxt(k,585)*y(k,54) + rxt(k,582)*y(k,69) - mat(k,65) = -(rxt(k,577)*y(k,69) + rxt(k,579)*y(k,54) + rxt(k,580)*y(k,55)) - mat(k,1003) = -rxt(k,577)*y(k,108) - mat(k,946) = -rxt(k,579)*y(k,108) - mat(k,1250) = -rxt(k,580)*y(k,108) - mat(k,1003) = mat(k,1003) + rxt(k,581)*y(k,109) - mat(k,59) = rxt(k,581)*y(k,69) - mat(k,58) = -((rxt(k,581) + rxt(k,582)) * y(k,69) + rxt(k,585)*y(k,54)) - mat(k,1002) = -(rxt(k,581) + rxt(k,582)) * y(k,109) - mat(k,945) = -rxt(k,585)*y(k,109) - mat(k,1825) = -(rxt(k,102)*y(k,61) + rxt(k,113)*y(k,67) + rxt(k,114)*y(k,65) & - + rxt(k,134)*y(k,70) + rxt(k,135)*y(k,74) + rxt(k,138)*y(k,76) & - + rxt(k,283)*y(k,81) + rxt(k,289)*y(k,85) + rxt(k,291)*y(k,83) & - + rxt(k,300)*y(k,90) + rxt(k,302)*y(k,91) + rxt(k,308)*y(k,93) & - + (rxt(k,322) + rxt(k,323)) * y(k,100) + rxt(k,324)*y(k,99) & - + rxt(k,332)*y(k,103) + rxt(k,350)*y(k,106) + rxt(k,360)*y(k,88) & - + rxt(k,361)*y(k,92) + rxt(k,362)*y(k,89) + rxt(k,367)*y(k,78) & - + rxt(k,369)*y(k,72) + rxt(k,371)*y(k,73) + rxt(k,373)*y(k,75) & - + rxt(k,385)*y(k,95) + rxt(k,504)*y(k,31)) - mat(k,615) = -rxt(k,102)*y(k,110) - mat(k,515) = -rxt(k,113)*y(k,110) - mat(k,809) = -rxt(k,114)*y(k,110) - mat(k,38) = -rxt(k,134)*y(k,110) - mat(k,25) = -rxt(k,135)*y(k,110) - mat(k,29) = -rxt(k,138)*y(k,110) - mat(k,734) = -rxt(k,283)*y(k,110) - mat(k,535) = -rxt(k,289)*y(k,110) - mat(k,672) = -rxt(k,291)*y(k,110) - mat(k,50) = -rxt(k,300)*y(k,110) - mat(k,122) = -rxt(k,302)*y(k,110) - mat(k,115) = -rxt(k,308)*y(k,110) - mat(k,149) = -(rxt(k,322) + rxt(k,323)) * y(k,110) - mat(k,1371) = -rxt(k,324)*y(k,110) - mat(k,296) = -rxt(k,332)*y(k,110) - mat(k,1651) = -rxt(k,350)*y(k,110) - mat(k,900) = -rxt(k,360)*y(k,110) - mat(k,1084) = -rxt(k,361)*y(k,110) - mat(k,943) = -rxt(k,362)*y(k,110) - mat(k,138) = -rxt(k,367)*y(k,110) - mat(k,107) = -rxt(k,369)*y(k,110) - mat(k,852) = -rxt(k,371)*y(k,110) - mat(k,1212) = -rxt(k,373)*y(k,110) - mat(k,594) = -rxt(k,385)*y(k,110) - mat(k,175) = -rxt(k,504)*y(k,110) - mat(k,560) = rxt(k,527)*y(k,104) - mat(k,44) = rxt(k,530)*y(k,104) - mat(k,1730) = rxt(k,405)*y(k,43) + rxt(k,339)*y(k,105) - mat(k,437) = rxt(k,410)*y(k,104) + rxt(k,348)*y(k,106) - mat(k,85) = rxt(k,411)*y(k,104) - mat(k,198) = rxt(k,495)*y(k,104) - mat(k,1496) = (rxt(k,549)+rxt(k,554))*y(k,45) + (rxt(k,542)+rxt(k,548) & - +rxt(k,553))*y(k,46) + rxt(k,101)*y(k,62) + rxt(k,466)*y(k,104) & - + rxt(k,340)*y(k,105) - mat(k,1124) = rxt(k,290)*y(k,85) + rxt(k,442)*y(k,104) - mat(k,707) = rxt(k,405)*y(k,32) + rxt(k,412)*y(k,104) - mat(k,57) = rxt(k,418)*y(k,104) - mat(k,158) = (rxt(k,549)+rxt(k,554))*y(k,40) - mat(k,190) = (rxt(k,542)+rxt(k,548)+rxt(k,553))*y(k,40) + rxt(k,469)*y(k,104) - mat(k,127) = rxt(k,335)*y(k,104) - mat(k,240) = rxt(k,288)*y(k,84) - mat(k,1772) = rxt(k,118)*y(k,67) - mat(k,1169) = rxt(k,115)*y(k,67) - mat(k,615) = mat(k,615) + 3.000_r8*rxt(k,190)*y(k,73) + 4.000_r8*rxt(k,142) & - *y(k,75) + 5.000_r8*rxt(k,172)*y(k,77) + 2.000_r8*rxt(k,225) & - *y(k,89) + rxt(k,207)*y(k,92) - mat(k,370) = rxt(k,101)*y(k,40) + 4.000_r8*rxt(k,194)*y(k,73) & - + 5.000_r8*rxt(k,159)*y(k,75) + 6.000_r8*rxt(k,177)*y(k,77) & - + rxt(k,247)*y(k,88) + 3.000_r8*rxt(k,229)*y(k,89) & - + 2.000_r8*rxt(k,212)*y(k,92) + rxt(k,154)*y(k,99) - mat(k,354) = 3.000_r8*rxt(k,182)*y(k,73) + (4.000_r8*rxt(k,176) & - +4.000_r8*rxt(k,262))*y(k,75) + (5.000_r8*rxt(k,164) & - +5.000_r8*rxt(k,263))*y(k,77) + 2.000_r8*rxt(k,217)*y(k,89) & - + rxt(k,200)*y(k,92) - mat(k,809) = mat(k,809) + 3.000_r8*rxt(k,181)*y(k,73) + (4.000_r8*rxt(k,165) & - +4.000_r8*rxt(k,253))*y(k,75) + (5.000_r8*rxt(k,163) & - +5.000_r8*rxt(k,260))*y(k,77) + 2.000_r8*rxt(k,216)*y(k,89) & - + rxt(k,199)*y(k,92) - mat(k,325) = 5.000_r8*rxt(k,189)*y(k,73) + (6.000_r8*rxt(k,242) & - +6.000_r8*rxt(k,266))*y(k,75) + (7.000_r8*rxt(k,171) & - +7.000_r8*rxt(k,254))*y(k,77) + 2.000_r8*rxt(k,241)*y(k,88) & - + 4.000_r8*rxt(k,224)*y(k,89) + 3.000_r8*rxt(k,206)*y(k,92) & - + 2.000_r8*rxt(k,148)*y(k,99) - mat(k,515) = mat(k,515) + rxt(k,118)*y(k,51) + rxt(k,115)*y(k,52) & - + 4.000_r8*rxt(k,191)*y(k,73) + (5.000_r8*rxt(k,153) & - +5.000_r8*rxt(k,255))*y(k,75) + (6.000_r8*rxt(k,173) & - +6.000_r8*rxt(k,256))*y(k,77) + rxt(k,244)*y(k,88) & - + 3.000_r8*rxt(k,226)*y(k,89) + 2.000_r8*rxt(k,208)*y(k,92) & - + rxt(k,150)*y(k,99) - mat(k,647) = 3.000_r8*rxt(k,186)*y(k,73) + 4.000_r8*rxt(k,220)*y(k,75) & - + 5.000_r8*rxt(k,169)*y(k,77) + 2.000_r8*rxt(k,222)*y(k,89) & - + rxt(k,204)*y(k,92) - mat(k,1042) = rxt(k,133)*y(k,70) + 2.000_r8*rxt(k,377)*y(k,72) & - + 3.000_r8*rxt(k,378)*y(k,73) + 4.000_r8*rxt(k,136)*y(k,75) & - + 5.000_r8*rxt(k,139)*y(k,77) + rxt(k,376)*y(k,78) & - + 2.000_r8*rxt(k,298)*y(k,89) + 3.000_r8*rxt(k,299)*y(k,90) & - + rxt(k,303)*y(k,92) + rxt(k,321)*y(k,100) - mat(k,38) = mat(k,38) + rxt(k,133)*y(k,69) - mat(k,310) = 3.000_r8*rxt(k,184)*y(k,73) + 4.000_r8*rxt(k,198)*y(k,75) & - + 5.000_r8*rxt(k,167)*y(k,77) + 2.000_r8*rxt(k,219)*y(k,89) & - + rxt(k,202)*y(k,92) - mat(k,107) = mat(k,107) + 2.000_r8*rxt(k,377)*y(k,69) - mat(k,852) = mat(k,852) + 3.000_r8*rxt(k,190)*y(k,61) + 4.000_r8*rxt(k,194) & - *y(k,62) + 3.000_r8*rxt(k,182)*y(k,63) + 3.000_r8*rxt(k,181) & - *y(k,65) + 5.000_r8*rxt(k,189)*y(k,66) + 4.000_r8*rxt(k,191) & - *y(k,67) + 3.000_r8*rxt(k,186)*y(k,68) + 3.000_r8*rxt(k,378) & - *y(k,69) + 3.000_r8*rxt(k,184)*y(k,71) + 3.000_r8*rxt(k,196) & - *y(k,81) + 4.000_r8*rxt(k,192)*y(k,82) + 3.000_r8*rxt(k,183) & - *y(k,83) + 5.000_r8*rxt(k,195)*y(k,84) + 4.000_r8*rxt(k,188) & - *y(k,85) + 3.000_r8*rxt(k,193)*y(k,86) + 3.000_r8*rxt(k,180) & - *y(k,87) + 3.000_r8*rxt(k,185)*y(k,98) - mat(k,1212) = mat(k,1212) + 4.000_r8*rxt(k,142)*y(k,61) + 5.000_r8*rxt(k,159) & - *y(k,62) + (4.000_r8*rxt(k,176)+4.000_r8*rxt(k,262))*y(k,63) + ( & - + 4.000_r8*rxt(k,165)+4.000_r8*rxt(k,253))*y(k,65) + ( & - + 6.000_r8*rxt(k,242)+6.000_r8*rxt(k,266))*y(k,66) + ( & - + 5.000_r8*rxt(k,153)+5.000_r8*rxt(k,255))*y(k,67) & - + 4.000_r8*rxt(k,220)*y(k,68) + 4.000_r8*rxt(k,136)*y(k,69) & - + 4.000_r8*rxt(k,198)*y(k,71) + 4.000_r8*rxt(k,161)*y(k,81) & - + 5.000_r8*rxt(k,157)*y(k,82) + (4.000_r8*rxt(k,187) & - +4.000_r8*rxt(k,259))*y(k,83) + 6.000_r8*rxt(k,160)*y(k,84) + ( & - + 5.000_r8*rxt(k,231)+5.000_r8*rxt(k,257))*y(k,85) & - + 4.000_r8*rxt(k,158)*y(k,86) + (4.000_r8*rxt(k,141) & - +4.000_r8*rxt(k,264))*y(k,87) + 4.000_r8*rxt(k,209)*y(k,98) - mat(k,1582) = 5.000_r8*rxt(k,172)*y(k,61) + 6.000_r8*rxt(k,177)*y(k,62) + ( & - + 5.000_r8*rxt(k,164)+5.000_r8*rxt(k,263))*y(k,63) + ( & - + 5.000_r8*rxt(k,163)+5.000_r8*rxt(k,260))*y(k,65) + ( & - + 7.000_r8*rxt(k,171)+7.000_r8*rxt(k,254))*y(k,66) + ( & - + 6.000_r8*rxt(k,173)+6.000_r8*rxt(k,256))*y(k,67) & - + 5.000_r8*rxt(k,169)*y(k,68) + 5.000_r8*rxt(k,139)*y(k,69) & - + 5.000_r8*rxt(k,167)*y(k,71) + 5.000_r8*rxt(k,179)*y(k,81) & - + 6.000_r8*rxt(k,174)*y(k,82) + (5.000_r8*rxt(k,166) & - +5.000_r8*rxt(k,261))*y(k,83) + 7.000_r8*rxt(k,178)*y(k,84) + ( & - + 6.000_r8*rxt(k,170)+6.000_r8*rxt(k,258))*y(k,85) & - + 5.000_r8*rxt(k,175)*y(k,86) + (5.000_r8*rxt(k,162) & - +5.000_r8*rxt(k,265))*y(k,87) + 5.000_r8*rxt(k,168)*y(k,98) - mat(k,138) = mat(k,138) + rxt(k,376)*y(k,69) - mat(k,734) = mat(k,734) + 3.000_r8*rxt(k,196)*y(k,73) + 4.000_r8*rxt(k,161) & - *y(k,75) + 5.000_r8*rxt(k,179)*y(k,77) + 2.000_r8*rxt(k,232) & - *y(k,89) + rxt(k,214)*y(k,92) - mat(k,384) = 4.000_r8*rxt(k,192)*y(k,73) + 5.000_r8*rxt(k,157)*y(k,75) & - + 6.000_r8*rxt(k,174)*y(k,77) + rxt(k,245)*y(k,88) & - + 3.000_r8*rxt(k,227)*y(k,89) + 2.000_r8*rxt(k,210)*y(k,92) & - + rxt(k,151)*y(k,99) - mat(k,672) = mat(k,672) + 3.000_r8*rxt(k,183)*y(k,73) + (4.000_r8*rxt(k,187) & - +4.000_r8*rxt(k,259))*y(k,75) + (5.000_r8*rxt(k,166) & - +5.000_r8*rxt(k,261))*y(k,77) + 2.000_r8*rxt(k,218)*y(k,89) & - + rxt(k,201)*y(k,92) - mat(k,494) = rxt(k,288)*y(k,50) + 5.000_r8*rxt(k,195)*y(k,73) & - + 6.000_r8*rxt(k,160)*y(k,75) + 7.000_r8*rxt(k,178)*y(k,77) & - + 2.000_r8*rxt(k,248)*y(k,88) + 4.000_r8*rxt(k,230)*y(k,89) & - + 3.000_r8*rxt(k,213)*y(k,92) + 2.000_r8*rxt(k,155)*y(k,99) - mat(k,535) = mat(k,535) + rxt(k,290)*y(k,42) + 4.000_r8*rxt(k,188)*y(k,73) + ( & - + 5.000_r8*rxt(k,231)+5.000_r8*rxt(k,257))*y(k,75) + ( & - + 6.000_r8*rxt(k,170)+6.000_r8*rxt(k,258))*y(k,77) + rxt(k,240) & - *y(k,88) + 3.000_r8*rxt(k,223)*y(k,89) + 2.000_r8*rxt(k,205) & - *y(k,92) + rxt(k,147)*y(k,99) - mat(k,400) = 3.000_r8*rxt(k,193)*y(k,73) + 4.000_r8*rxt(k,158)*y(k,75) & - + 5.000_r8*rxt(k,175)*y(k,77) + 2.000_r8*rxt(k,228)*y(k,89) & - + rxt(k,211)*y(k,92) - mat(k,451) = 3.000_r8*rxt(k,180)*y(k,73) + (4.000_r8*rxt(k,141) & - +4.000_r8*rxt(k,264))*y(k,75) + (5.000_r8*rxt(k,162) & - +5.000_r8*rxt(k,265))*y(k,77) + 2.000_r8*rxt(k,215)*y(k,89) & - + rxt(k,197)*y(k,92) - mat(k,900) = mat(k,900) + rxt(k,247)*y(k,62) + 2.000_r8*rxt(k,241)*y(k,66) & - + rxt(k,244)*y(k,67) + rxt(k,245)*y(k,82) + 2.000_r8*rxt(k,248) & - *y(k,84) + rxt(k,240)*y(k,85) - mat(k,943) = mat(k,943) + 2.000_r8*rxt(k,225)*y(k,61) + 3.000_r8*rxt(k,229) & - *y(k,62) + 2.000_r8*rxt(k,217)*y(k,63) + 2.000_r8*rxt(k,216) & - *y(k,65) + 4.000_r8*rxt(k,224)*y(k,66) + 3.000_r8*rxt(k,226) & - *y(k,67) + 2.000_r8*rxt(k,222)*y(k,68) + 2.000_r8*rxt(k,298) & - *y(k,69) + 2.000_r8*rxt(k,219)*y(k,71) + 2.000_r8*rxt(k,232) & - *y(k,81) + 3.000_r8*rxt(k,227)*y(k,82) + 2.000_r8*rxt(k,218) & - *y(k,83) + 4.000_r8*rxt(k,230)*y(k,84) + 3.000_r8*rxt(k,223) & - *y(k,85) + 2.000_r8*rxt(k,228)*y(k,86) + 2.000_r8*rxt(k,215) & - *y(k,87) + 2.000_r8*rxt(k,221)*y(k,98) - mat(k,50) = mat(k,50) + 3.000_r8*rxt(k,299)*y(k,69) - mat(k,1084) = mat(k,1084) + rxt(k,207)*y(k,61) + 2.000_r8*rxt(k,212)*y(k,62) & - + rxt(k,200)*y(k,63) + rxt(k,199)*y(k,65) + 3.000_r8*rxt(k,206) & - *y(k,66) + 2.000_r8*rxt(k,208)*y(k,67) + rxt(k,204)*y(k,68) & - + rxt(k,303)*y(k,69) + rxt(k,202)*y(k,71) + rxt(k,214)*y(k,81) & - + 2.000_r8*rxt(k,210)*y(k,82) + rxt(k,201)*y(k,83) & - + 3.000_r8*rxt(k,213)*y(k,84) + 2.000_r8*rxt(k,205)*y(k,85) & - + rxt(k,211)*y(k,86) + rxt(k,197)*y(k,87) + rxt(k,203)*y(k,98) - mat(k,1326) = 3.000_r8*rxt(k,185)*y(k,73) + 4.000_r8*rxt(k,209)*y(k,75) & - + 5.000_r8*rxt(k,168)*y(k,77) + 2.000_r8*rxt(k,221)*y(k,89) & - + rxt(k,203)*y(k,92) - mat(k,1371) = mat(k,1371) + rxt(k,154)*y(k,62) + 2.000_r8*rxt(k,148)*y(k,66) & - + rxt(k,150)*y(k,67) + rxt(k,151)*y(k,82) + 2.000_r8*rxt(k,155) & - *y(k,84) + rxt(k,147)*y(k,85) - mat(k,149) = mat(k,149) + rxt(k,321)*y(k,69) - mat(k,776) = rxt(k,527)*y(k,14) + rxt(k,530)*y(k,19) + rxt(k,410)*y(k,33) & - + rxt(k,411)*y(k,35) + rxt(k,495)*y(k,36) + rxt(k,466)*y(k,40) & - + rxt(k,442)*y(k,42) + rxt(k,412)*y(k,43) + rxt(k,418)*y(k,44) & - + rxt(k,469)*y(k,46) + rxt(k,335)*y(k,47) + 2.000_r8*rxt(k,415) & - *y(k,104) - mat(k,1615) = rxt(k,339)*y(k,32) + rxt(k,340)*y(k,40) - mat(k,1651) = mat(k,1651) + rxt(k,348)*y(k,33) - end do - end subroutine nlnmat09 - 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) = mat(k, 4) + lmat(k, 4) - mat(k, 5) = mat(k, 5) + lmat(k, 5) - 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) = mat(k, 12) + lmat(k, 12) - mat(k, 13) = mat(k, 13) + lmat(k, 13) - mat(k, 15) = 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) = mat(k, 22) + lmat(k, 22) - mat(k, 26) = mat(k, 26) + lmat(k, 26) - mat(k, 30) = mat(k, 30) + lmat(k, 30) - mat(k, 31) = mat(k, 31) + lmat(k, 31) - mat(k, 32) = lmat(k, 32) - mat(k, 33) = mat(k, 33) + lmat(k, 33) - mat(k, 39) = mat(k, 39) + lmat(k, 39) - mat(k, 41) = mat(k, 41) + lmat(k, 41) - mat(k, 42) = mat(k, 42) + lmat(k, 42) - mat(k, 43) = lmat(k, 43) - mat(k, 45) = mat(k, 45) + lmat(k, 45) - mat(k, 51) = mat(k, 51) + lmat(k, 51) - mat(k, 52) = lmat(k, 52) - mat(k, 53) = mat(k, 53) + lmat(k, 53) - mat(k, 54) = mat(k, 54) + lmat(k, 54) - mat(k, 55) = lmat(k, 55) - mat(k, 58) = mat(k, 58) + lmat(k, 58) - mat(k, 59) = mat(k, 59) + lmat(k, 59) - mat(k, 60) = lmat(k, 60) - mat(k, 61) = lmat(k, 61) - mat(k, 62) = mat(k, 62) + lmat(k, 62) - mat(k, 63) = lmat(k, 63) - mat(k, 64) = lmat(k, 64) - mat(k, 65) = mat(k, 65) + lmat(k, 65) - mat(k, 66) = lmat(k, 66) - mat(k, 67) = mat(k, 67) + lmat(k, 67) - mat(k, 68) = mat(k, 68) + lmat(k, 68) - mat(k, 71) = mat(k, 71) + lmat(k, 71) - mat(k, 72) = lmat(k, 72) - mat(k, 73) = lmat(k, 73) - mat(k, 74) = mat(k, 74) + lmat(k, 74) - mat(k, 76) = lmat(k, 76) - mat(k, 77) = lmat(k, 77) - mat(k, 78) = mat(k, 78) + lmat(k, 78) - mat(k, 79) = mat(k, 79) + lmat(k, 79) - mat(k, 81) = mat(k, 81) + lmat(k, 81) - mat(k, 86) = mat(k, 86) + lmat(k, 86) - mat(k, 95) = mat(k, 95) + lmat(k, 95) - mat(k, 99) = mat(k, 99) + lmat(k, 99) - mat(k, 100) = lmat(k, 100) - mat(k, 102) = mat(k, 102) + lmat(k, 102) - mat(k, 103) = lmat(k, 103) - mat(k, 107) = mat(k, 107) + lmat(k, 107) - mat(k, 108) = mat(k, 108) + lmat(k, 108) - mat(k, 110) = lmat(k, 110) - mat(k, 116) = mat(k, 116) + lmat(k, 116) - mat(k, 117) = lmat(k, 117) - mat(k, 120) = mat(k, 120) + lmat(k, 120) - mat(k, 123) = mat(k, 123) + lmat(k, 123) - mat(k, 124) = mat(k, 124) + lmat(k, 124) - mat(k, 126) = lmat(k, 126) - mat(k, 128) = mat(k, 128) + lmat(k, 128) - mat(k, 134) = mat(k, 134) + lmat(k, 134) - mat(k, 142) = mat(k, 142) + lmat(k, 142) - mat(k, 147) = lmat(k, 147) - mat(k, 149) = mat(k, 149) + lmat(k, 149) - mat(k, 151) = mat(k, 151) + lmat(k, 151) - mat(k, 152) = lmat(k, 152) - mat(k, 154) = mat(k, 154) + lmat(k, 154) - mat(k, 159) = mat(k, 159) + lmat(k, 159) - mat(k, 167) = mat(k, 167) + lmat(k, 167) - mat(k, 168) = mat(k, 168) + lmat(k, 168) - mat(k, 169) = lmat(k, 169) - mat(k, 176) = mat(k, 176) + lmat(k, 176) - mat(k, 184) = mat(k, 184) + lmat(k, 184) - mat(k, 185) = mat(k, 185) + lmat(k, 185) - mat(k, 189) = mat(k, 189) + lmat(k, 189) - mat(k, 191) = mat(k, 191) + lmat(k, 191) - mat(k, 192) = mat(k, 192) + lmat(k, 192) - mat(k, 197) = mat(k, 197) + lmat(k, 197) - mat(k, 200) = mat(k, 200) + lmat(k, 200) - mat(k, 201) = mat(k, 201) + lmat(k, 201) - mat(k, 204) = mat(k, 204) + lmat(k, 204) - mat(k, 205) = lmat(k, 205) - mat(k, 206) = mat(k, 206) + lmat(k, 206) - mat(k, 208) = mat(k, 208) + lmat(k, 208) - mat(k, 209) = mat(k, 209) + lmat(k, 209) - mat(k, 211) = mat(k, 211) + lmat(k, 211) - mat(k, 219) = mat(k, 219) + lmat(k, 219) - mat(k, 222) = mat(k, 222) + lmat(k, 222) - mat(k, 229) = mat(k, 229) + lmat(k, 229) - mat(k, 233) = lmat(k, 233) - mat(k, 234) = mat(k, 234) + lmat(k, 234) - mat(k, 235) = lmat(k, 235) - mat(k, 237) = lmat(k, 237) - mat(k, 239) = lmat(k, 239) - mat(k, 244) = mat(k, 244) + lmat(k, 244) - mat(k, 245) = lmat(k, 245) - mat(k, 249) = lmat(k, 249) - mat(k, 257) = mat(k, 257) + lmat(k, 257) - mat(k, 268) = lmat(k, 268) - mat(k, 270) = mat(k, 270) + lmat(k, 270) - mat(k, 276) = lmat(k, 276) - mat(k, 285) = mat(k, 285) + lmat(k, 285) - mat(k, 297) = mat(k, 297) + lmat(k, 297) - mat(k, 311) = mat(k, 311) + lmat(k, 311) - mat(k, 312) = lmat(k, 312) - mat(k, 325) = mat(k, 325) + lmat(k, 325) - mat(k, 328) = mat(k, 328) + lmat(k, 328) - mat(k, 340) = mat(k, 340) + lmat(k, 340) - mat(k, 341) = lmat(k, 341) - mat(k, 349) = mat(k, 349) + lmat(k, 349) - mat(k, 356) = mat(k, 356) + lmat(k, 356) - mat(k, 357) = lmat(k, 357) - mat(k, 370) = mat(k, 370) + lmat(k, 370) - mat(k, 371) = mat(k, 371) + lmat(k, 371) - mat(k, 372) = lmat(k, 372) - mat(k, 384) = mat(k, 384) + lmat(k, 384) - mat(k, 385) = mat(k, 385) + lmat(k, 385) - mat(k, 401) = mat(k, 401) + lmat(k, 401) - mat(k, 406) = mat(k, 406) + lmat(k, 406) - mat(k, 408) = mat(k, 408) + lmat(k, 408) - mat(k, 411) = mat(k, 411) + lmat(k, 411) - mat(k, 413) = lmat(k, 413) - mat(k, 419) = mat(k, 419) + lmat(k, 419) - mat(k, 438) = mat(k, 438) + lmat(k, 438) - mat(k, 439) = lmat(k, 439) - mat(k, 444) = mat(k, 444) + lmat(k, 444) - mat(k, 456) = mat(k, 456) + lmat(k, 456) - mat(k, 457) = mat(k, 457) + lmat(k, 457) - mat(k, 462) = mat(k, 462) + lmat(k, 462) - mat(k, 477) = mat(k, 477) + lmat(k, 477) - mat(k, 478) = lmat(k, 478) - mat(k, 494) = mat(k, 494) + lmat(k, 494) - mat(k, 497) = mat(k, 497) + lmat(k, 497) - mat(k, 501) = lmat(k, 501) - mat(k, 515) = mat(k, 515) + lmat(k, 515) - mat(k, 519) = mat(k, 519) + lmat(k, 519) - mat(k, 520) = lmat(k, 520) - mat(k, 535) = mat(k, 535) + lmat(k, 535) - mat(k, 536) = mat(k, 536) + lmat(k, 536) - mat(k, 539) = lmat(k, 539) - mat(k, 541) = mat(k, 541) + lmat(k, 541) - mat(k, 558) = mat(k, 558) + lmat(k, 558) - mat(k, 561) = mat(k, 561) + lmat(k, 561) - mat(k, 562) = mat(k, 562) + lmat(k, 562) - mat(k, 564) = mat(k, 564) + lmat(k, 564) - mat(k, 567) = lmat(k, 567) - mat(k, 569) = mat(k, 569) + lmat(k, 569) - mat(k, 570) = mat(k, 570) + lmat(k, 570) - mat(k, 572) = lmat(k, 572) - mat(k, 573) = mat(k, 573) + lmat(k, 573) - mat(k, 574) = lmat(k, 574) - mat(k, 575) = mat(k, 575) + lmat(k, 575) - mat(k, 577) = mat(k, 577) + lmat(k, 577) - mat(k, 582) = mat(k, 582) + lmat(k, 582) - mat(k, 591) = mat(k, 591) + lmat(k, 591) - mat(k, 592) = mat(k, 592) + lmat(k, 592) - mat(k, 593) = lmat(k, 593) - mat(k, 597) = mat(k, 597) + lmat(k, 597) - mat(k, 619) = mat(k, 619) + lmat(k, 619) - mat(k, 635) = lmat(k, 635) - mat(k, 637) = mat(k, 637) + lmat(k, 637) - mat(k, 652) = mat(k, 652) + lmat(k, 652) - mat(k, 658) = lmat(k, 658) - mat(k, 663) = mat(k, 663) + lmat(k, 663) - mat(k, 675) = mat(k, 675) + lmat(k, 675) - mat(k, 686) = mat(k, 686) + lmat(k, 686) - mat(k, 712) = mat(k, 712) + lmat(k, 712) - mat(k, 718) = lmat(k, 718) - mat(k, 721) = mat(k, 721) + lmat(k, 721) - mat(k, 735) = lmat(k, 735) - mat(k, 736) = lmat(k, 736) - mat(k, 747) = mat(k, 747) + lmat(k, 747) - mat(k, 749) = mat(k, 749) + lmat(k, 749) - mat(k, 754) = mat(k, 754) + lmat(k, 754) - mat(k, 755) = mat(k, 755) + lmat(k, 755) - mat(k, 773) = mat(k, 773) + lmat(k, 773) - mat(k, 776) = mat(k, 776) + lmat(k, 776) - mat(k, 785) = mat(k, 785) + lmat(k, 785) - mat(k, 799) = mat(k, 799) + lmat(k, 799) - mat(k, 805) = lmat(k, 805) - mat(k, 810) = lmat(k, 810) - mat(k, 829) = mat(k, 829) + lmat(k, 829) - mat(k, 852) = mat(k, 852) + lmat(k, 852) - mat(k, 853) = lmat(k, 853) - mat(k, 878) = mat(k, 878) + lmat(k, 878) - mat(k, 922) = mat(k, 922) + lmat(k, 922) - mat(k, 945) = mat(k, 945) + lmat(k, 945) - mat(k, 946) = mat(k, 946) + lmat(k, 946) - mat(k, 960) = mat(k, 960) + lmat(k, 960) - mat(k, 979) = mat(k, 979) + lmat(k, 979) - mat(k, 980) = mat(k, 980) + lmat(k, 980) - mat(k,1023) = mat(k,1023) + lmat(k,1023) - mat(k,1066) = mat(k,1066) + lmat(k,1066) - mat(k,1099) = mat(k,1099) + lmat(k,1099) - mat(k,1107) = mat(k,1107) + lmat(k,1107) - mat(k,1108) = lmat(k,1108) - mat(k,1144) = mat(k,1144) + lmat(k,1144) - mat(k,1149) = mat(k,1149) + lmat(k,1149) - mat(k,1152) = mat(k,1152) + lmat(k,1152) - mat(k,1153) = mat(k,1153) + lmat(k,1153) - mat(k,1168) = mat(k,1168) + lmat(k,1168) - mat(k,1189) = lmat(k,1189) - mat(k,1197) = mat(k,1197) + lmat(k,1197) - mat(k,1212) = mat(k,1212) + lmat(k,1212) - mat(k,1227) = mat(k,1227) + lmat(k,1227) - mat(k,1230) = mat(k,1230) + lmat(k,1230) - mat(k,1231) = mat(k,1231) + lmat(k,1231) - mat(k,1233) = mat(k,1233) + lmat(k,1233) - mat(k,1234) = mat(k,1234) + lmat(k,1234) - mat(k,1246) = mat(k,1246) + lmat(k,1246) - mat(k,1249) = lmat(k,1249) - mat(k,1250) = mat(k,1250) + lmat(k,1250) - mat(k,1256) = mat(k,1256) + lmat(k,1256) - mat(k,1260) = mat(k,1260) + lmat(k,1260) - mat(k,1270) = mat(k,1270) + lmat(k,1270) - mat(k,1271) = mat(k,1271) + lmat(k,1271) - mat(k,1277) = mat(k,1277) + lmat(k,1277) - mat(k,1279) = mat(k,1279) + lmat(k,1279) - mat(k,1307) = mat(k,1307) + lmat(k,1307) - mat(k,1313) = mat(k,1313) + lmat(k,1313) - mat(k,1314) = mat(k,1314) + lmat(k,1314) - mat(k,1349) = mat(k,1349) + lmat(k,1349) - mat(k,1360) = mat(k,1360) + lmat(k,1360) - mat(k,1370) = mat(k,1370) + lmat(k,1370) - mat(k,1376) = mat(k,1376) + lmat(k,1376) - mat(k,1393) = lmat(k,1393) - mat(k,1403) = mat(k,1403) + lmat(k,1403) - mat(k,1415) = mat(k,1415) + lmat(k,1415) - mat(k,1421) = mat(k,1421) + lmat(k,1421) - mat(k,1431) = mat(k,1431) + lmat(k,1431) - mat(k,1438) = mat(k,1438) + lmat(k,1438) - mat(k,1442) = mat(k,1442) + lmat(k,1442) - mat(k,1488) = mat(k,1488) + lmat(k,1488) - mat(k,1493) = mat(k,1493) + lmat(k,1493) - mat(k,1494) = mat(k,1494) + lmat(k,1494) - mat(k,1519) = mat(k,1519) + lmat(k,1519) - mat(k,1532) = mat(k,1532) + lmat(k,1532) - mat(k,1536) = mat(k,1536) + lmat(k,1536) - mat(k,1567) = lmat(k,1567) - mat(k,1576) = mat(k,1576) + lmat(k,1576) - mat(k,1582) = mat(k,1582) + lmat(k,1582) - mat(k,1590) = mat(k,1590) + lmat(k,1590) - mat(k,1596) = mat(k,1596) + lmat(k,1596) - mat(k,1610) = mat(k,1610) + lmat(k,1610) - mat(k,1631) = mat(k,1631) + lmat(k,1631) - mat(k,1632) = mat(k,1632) + lmat(k,1632) - mat(k,1647) = mat(k,1647) + lmat(k,1647) - mat(k,1654) = mat(k,1654) + lmat(k,1654) - mat(k,1658) = lmat(k,1658) - mat(k,1659) = lmat(k,1659) - mat(k,1667) = mat(k,1667) + lmat(k,1667) - mat(k,1686) = mat(k,1686) + lmat(k,1686) - mat(k,1691) = mat(k,1691) + lmat(k,1691) - mat(k,1728) = mat(k,1728) + lmat(k,1728) - mat(k,1734) = mat(k,1734) + lmat(k,1734) - mat(k,1750) = mat(k,1750) + lmat(k,1750) - mat(k,1752) = mat(k,1752) + lmat(k,1752) - mat(k,1753) = mat(k,1753) + lmat(k,1753) - mat(k,1771) = mat(k,1771) + lmat(k,1771) - mat(k,1790) = lmat(k,1790) - mat(k,1795) = mat(k,1795) + lmat(k,1795) - mat(k,1800) = mat(k,1800) + lmat(k,1800) - mat(k,1805) = lmat(k,1805) - mat(k,1823) = lmat(k,1823) - mat(k,1825) = mat(k,1825) + lmat(k,1825) - mat(k, 135) = 0._r8 - mat(k, 140) = 0._r8 - mat(k, 144) = 0._r8 - mat(k, 148) = 0._r8 - mat(k, 157) = 0._r8 - mat(k, 210) = 0._r8 - mat(k, 246) = 0._r8 - mat(k, 247) = 0._r8 - mat(k, 248) = 0._r8 - mat(k, 254) = 0._r8 - mat(k, 255) = 0._r8 - mat(k, 260) = 0._r8 - mat(k, 265) = 0._r8 - mat(k, 267) = 0._r8 - mat(k, 269) = 0._r8 - mat(k, 271) = 0._r8 - mat(k, 272) = 0._r8 - mat(k, 280) = 0._r8 - mat(k, 286) = 0._r8 - mat(k, 287) = 0._r8 - mat(k, 291) = 0._r8 - mat(k, 294) = 0._r8 - mat(k, 295) = 0._r8 - mat(k, 331) = 0._r8 - mat(k, 333) = 0._r8 - mat(k, 334) = 0._r8 - mat(k, 336) = 0._r8 - mat(k, 338) = 0._r8 - mat(k, 339) = 0._r8 - mat(k, 418) = 0._r8 - mat(k, 420) = 0._r8 - mat(k, 422) = 0._r8 - mat(k, 426) = 0._r8 - mat(k, 427) = 0._r8 - mat(k, 428) = 0._r8 - mat(k, 429) = 0._r8 - mat(k, 431) = 0._r8 - mat(k, 436) = 0._r8 - mat(k, 458) = 0._r8 - mat(k, 459) = 0._r8 - mat(k, 463) = 0._r8 - mat(k, 465) = 0._r8 - mat(k, 467) = 0._r8 - mat(k, 468) = 0._r8 - mat(k, 469) = 0._r8 - mat(k, 472) = 0._r8 - mat(k, 474) = 0._r8 - mat(k, 479) = 0._r8 - mat(k, 483) = 0._r8 - mat(k, 486) = 0._r8 - mat(k, 524) = 0._r8 - mat(k, 527) = 0._r8 - mat(k, 540) = 0._r8 - mat(k, 542) = 0._r8 - mat(k, 546) = 0._r8 - mat(k, 548) = 0._r8 - mat(k, 550) = 0._r8 - mat(k, 551) = 0._r8 - mat(k, 552) = 0._r8 - mat(k, 554) = 0._r8 - mat(k, 555) = 0._r8 - mat(k, 556) = 0._r8 - mat(k, 559) = 0._r8 - mat(k, 566) = 0._r8 - mat(k, 568) = 0._r8 - mat(k, 576) = 0._r8 - mat(k, 578) = 0._r8 - mat(k, 579) = 0._r8 - mat(k, 580) = 0._r8 - mat(k, 581) = 0._r8 - mat(k, 583) = 0._r8 - mat(k, 584) = 0._r8 - mat(k, 585) = 0._r8 - mat(k, 589) = 0._r8 - mat(k, 590) = 0._r8 - mat(k, 620) = 0._r8 - mat(k, 622) = 0._r8 - mat(k, 629) = 0._r8 - mat(k, 631) = 0._r8 - mat(k, 632) = 0._r8 - mat(k, 642) = 0._r8 - mat(k, 643) = 0._r8 - mat(k, 661) = 0._r8 - mat(k, 669) = 0._r8 - mat(k, 670) = 0._r8 - mat(k, 684) = 0._r8 - mat(k, 685) = 0._r8 - mat(k, 688) = 0._r8 - mat(k, 690) = 0._r8 - mat(k, 692) = 0._r8 - mat(k, 696) = 0._r8 - mat(k, 697) = 0._r8 - mat(k, 698) = 0._r8 - mat(k, 702) = 0._r8 - mat(k, 703) = 0._r8 - mat(k, 713) = 0._r8 - mat(k, 717) = 0._r8 - mat(k, 743) = 0._r8 - mat(k, 753) = 0._r8 - mat(k, 756) = 0._r8 - mat(k, 757) = 0._r8 - mat(k, 759) = 0._r8 - mat(k, 765) = 0._r8 - mat(k, 766) = 0._r8 - mat(k, 771) = 0._r8 - mat(k, 772) = 0._r8 - mat(k, 780) = 0._r8 - mat(k, 790) = 0._r8 - mat(k, 795) = 0._r8 - mat(k, 800) = 0._r8 - mat(k, 801) = 0._r8 - mat(k, 811) = 0._r8 - mat(k, 825) = 0._r8 - mat(k, 830) = 0._r8 - mat(k, 831) = 0._r8 - mat(k, 834) = 0._r8 - mat(k, 841) = 0._r8 - mat(k, 843) = 0._r8 - mat(k, 845) = 0._r8 - mat(k, 846) = 0._r8 - mat(k, 847) = 0._r8 - mat(k, 848) = 0._r8 - mat(k, 851) = 0._r8 - mat(k, 856) = 0._r8 - mat(k, 857) = 0._r8 - mat(k, 869) = 0._r8 - mat(k, 873) = 0._r8 - mat(k, 877) = 0._r8 - mat(k, 879) = 0._r8 - mat(k, 885) = 0._r8 - mat(k, 889) = 0._r8 - mat(k, 891) = 0._r8 - mat(k, 893) = 0._r8 - mat(k, 894) = 0._r8 - mat(k, 895) = 0._r8 - mat(k, 896) = 0._r8 - mat(k, 898) = 0._r8 - mat(k, 902) = 0._r8 - mat(k, 916) = 0._r8 - mat(k, 920) = 0._r8 - mat(k, 921) = 0._r8 - mat(k, 925) = 0._r8 - mat(k, 928) = 0._r8 - mat(k, 932) = 0._r8 - mat(k, 934) = 0._r8 - mat(k, 936) = 0._r8 - mat(k, 937) = 0._r8 - mat(k, 938) = 0._r8 - mat(k, 939) = 0._r8 - mat(k, 941) = 0._r8 - mat(k, 968) = 0._r8 - mat(k, 976) = 0._r8 - mat(k, 978) = 0._r8 - mat(k, 981) = 0._r8 - mat(k, 982) = 0._r8 - mat(k, 984) = 0._r8 - mat(k, 993) = 0._r8 - mat(k, 999) = 0._r8 - mat(k,1008) = 0._r8 - mat(k,1012) = 0._r8 - mat(k,1017) = 0._r8 - mat(k,1025) = 0._r8 - mat(k,1026) = 0._r8 - mat(k,1028) = 0._r8 - mat(k,1034) = 0._r8 - mat(k,1035) = 0._r8 - mat(k,1037) = 0._r8 - mat(k,1039) = 0._r8 - mat(k,1061) = 0._r8 - mat(k,1062) = 0._r8 - mat(k,1069) = 0._r8 - mat(k,1073) = 0._r8 - mat(k,1075) = 0._r8 - mat(k,1077) = 0._r8 - mat(k,1078) = 0._r8 - mat(k,1079) = 0._r8 - mat(k,1080) = 0._r8 - mat(k,1088) = 0._r8 - mat(k,1090) = 0._r8 - mat(k,1093) = 0._r8 - mat(k,1094) = 0._r8 - mat(k,1101) = 0._r8 - mat(k,1102) = 0._r8 - mat(k,1103) = 0._r8 - mat(k,1104) = 0._r8 - mat(k,1105) = 0._r8 - mat(k,1106) = 0._r8 - mat(k,1109) = 0._r8 - mat(k,1111) = 0._r8 - mat(k,1113) = 0._r8 - mat(k,1115) = 0._r8 - mat(k,1117) = 0._r8 - mat(k,1118) = 0._r8 - mat(k,1119) = 0._r8 - mat(k,1121) = 0._r8 - mat(k,1122) = 0._r8 - mat(k,1123) = 0._r8 - mat(k,1127) = 0._r8 - mat(k,1131) = 0._r8 - mat(k,1133) = 0._r8 - mat(k,1135) = 0._r8 - mat(k,1138) = 0._r8 - mat(k,1139) = 0._r8 - mat(k,1146) = 0._r8 - mat(k,1147) = 0._r8 - mat(k,1148) = 0._r8 - mat(k,1150) = 0._r8 - mat(k,1151) = 0._r8 - mat(k,1154) = 0._r8 - mat(k,1158) = 0._r8 - mat(k,1161) = 0._r8 - mat(k,1163) = 0._r8 - mat(k,1167) = 0._r8 - mat(k,1185) = 0._r8 - mat(k,1190) = 0._r8 - mat(k,1191) = 0._r8 - mat(k,1194) = 0._r8 - mat(k,1201) = 0._r8 - mat(k,1203) = 0._r8 - mat(k,1205) = 0._r8 - mat(k,1207) = 0._r8 - mat(k,1208) = 0._r8 - mat(k,1211) = 0._r8 - mat(k,1215) = 0._r8 - mat(k,1216) = 0._r8 - mat(k,1217) = 0._r8 - mat(k,1219) = 0._r8 - mat(k,1220) = 0._r8 - mat(k,1222) = 0._r8 - mat(k,1224) = 0._r8 - mat(k,1225) = 0._r8 - mat(k,1226) = 0._r8 - mat(k,1228) = 0._r8 - mat(k,1229) = 0._r8 - mat(k,1232) = 0._r8 - mat(k,1235) = 0._r8 - mat(k,1236) = 0._r8 - mat(k,1237) = 0._r8 - mat(k,1238) = 0._r8 - mat(k,1239) = 0._r8 - mat(k,1240) = 0._r8 - mat(k,1241) = 0._r8 - mat(k,1242) = 0._r8 - mat(k,1243) = 0._r8 - mat(k,1244) = 0._r8 - mat(k,1245) = 0._r8 - mat(k,1247) = 0._r8 - mat(k,1261) = 0._r8 - mat(k,1262) = 0._r8 - mat(k,1264) = 0._r8 - mat(k,1265) = 0._r8 - mat(k,1267) = 0._r8 - mat(k,1269) = 0._r8 - mat(k,1272) = 0._r8 - mat(k,1273) = 0._r8 - mat(k,1274) = 0._r8 - mat(k,1275) = 0._r8 - mat(k,1276) = 0._r8 - mat(k,1282) = 0._r8 - mat(k,1283) = 0._r8 - mat(k,1284) = 0._r8 - mat(k,1285) = 0._r8 - mat(k,1287) = 0._r8 - mat(k,1290) = 0._r8 - mat(k,1294) = 0._r8 - mat(k,1301) = 0._r8 - mat(k,1302) = 0._r8 - mat(k,1312) = 0._r8 - mat(k,1321) = 0._r8 - mat(k,1344) = 0._r8 - mat(k,1348) = 0._r8 - mat(k,1350) = 0._r8 - mat(k,1353) = 0._r8 - mat(k,1356) = 0._r8 - mat(k,1362) = 0._r8 - mat(k,1364) = 0._r8 - mat(k,1365) = 0._r8 - mat(k,1366) = 0._r8 - mat(k,1367) = 0._r8 - mat(k,1369) = 0._r8 - mat(k,1379) = 0._r8 - mat(k,1380) = 0._r8 - mat(k,1383) = 0._r8 - mat(k,1385) = 0._r8 - mat(k,1386) = 0._r8 - mat(k,1387) = 0._r8 - mat(k,1388) = 0._r8 - mat(k,1390) = 0._r8 - mat(k,1392) = 0._r8 - mat(k,1394) = 0._r8 - mat(k,1395) = 0._r8 - mat(k,1396) = 0._r8 - mat(k,1397) = 0._r8 - mat(k,1398) = 0._r8 - mat(k,1399) = 0._r8 - mat(k,1404) = 0._r8 - mat(k,1405) = 0._r8 - mat(k,1406) = 0._r8 - mat(k,1407) = 0._r8 - mat(k,1410) = 0._r8 - mat(k,1411) = 0._r8 - mat(k,1412) = 0._r8 - mat(k,1413) = 0._r8 - mat(k,1416) = 0._r8 - mat(k,1420) = 0._r8 - mat(k,1427) = 0._r8 - mat(k,1428) = 0._r8 - mat(k,1429) = 0._r8 - mat(k,1430) = 0._r8 - mat(k,1433) = 0._r8 - mat(k,1434) = 0._r8 - mat(k,1436) = 0._r8 - mat(k,1440) = 0._r8 - mat(k,1443) = 0._r8 - mat(k,1445) = 0._r8 - mat(k,1451) = 0._r8 - mat(k,1458) = 0._r8 - mat(k,1462) = 0._r8 - mat(k,1463) = 0._r8 - mat(k,1464) = 0._r8 - mat(k,1472) = 0._r8 - mat(k,1473) = 0._r8 - mat(k,1474) = 0._r8 - mat(k,1475) = 0._r8 - mat(k,1477) = 0._r8 - mat(k,1478) = 0._r8 - mat(k,1480) = 0._r8 - mat(k,1481) = 0._r8 - mat(k,1482) = 0._r8 - mat(k,1483) = 0._r8 - mat(k,1485) = 0._r8 - mat(k,1487) = 0._r8 - mat(k,1490) = 0._r8 - mat(k,1495) = 0._r8 - mat(k,1508) = 0._r8 - mat(k,1511) = 0._r8 - mat(k,1516) = 0._r8 - mat(k,1517) = 0._r8 - mat(k,1518) = 0._r8 - mat(k,1520) = 0._r8 - mat(k,1521) = 0._r8 - mat(k,1522) = 0._r8 - mat(k,1524) = 0._r8 - mat(k,1528) = 0._r8 - mat(k,1530) = 0._r8 - mat(k,1533) = 0._r8 - mat(k,1537) = 0._r8 - mat(k,1539) = 0._r8 - mat(k,1555) = 0._r8 - mat(k,1559) = 0._r8 - mat(k,1560) = 0._r8 - mat(k,1561) = 0._r8 - mat(k,1564) = 0._r8 - mat(k,1571) = 0._r8 - mat(k,1573) = 0._r8 - mat(k,1575) = 0._r8 - mat(k,1577) = 0._r8 - mat(k,1578) = 0._r8 - mat(k,1581) = 0._r8 - mat(k,1587) = 0._r8 - mat(k,1591) = 0._r8 - mat(k,1592) = 0._r8 - mat(k,1593) = 0._r8 - mat(k,1594) = 0._r8 - mat(k,1597) = 0._r8 - mat(k,1598) = 0._r8 - mat(k,1600) = 0._r8 - mat(k,1601) = 0._r8 - mat(k,1602) = 0._r8 - mat(k,1603) = 0._r8 - mat(k,1604) = 0._r8 - mat(k,1609) = 0._r8 - mat(k,1611) = 0._r8 - mat(k,1614) = 0._r8 - mat(k,1617) = 0._r8 - mat(k,1620) = 0._r8 - mat(k,1621) = 0._r8 - mat(k,1624) = 0._r8 - mat(k,1628) = 0._r8 - mat(k,1629) = 0._r8 - mat(k,1630) = 0._r8 - mat(k,1633) = 0._r8 - mat(k,1636) = 0._r8 - mat(k,1637) = 0._r8 - mat(k,1639) = 0._r8 - mat(k,1640) = 0._r8 - mat(k,1645) = 0._r8 - mat(k,1661) = 0._r8 - mat(k,1663) = 0._r8 - mat(k,1666) = 0._r8 - mat(k,1671) = 0._r8 - mat(k,1672) = 0._r8 - mat(k,1673) = 0._r8 - mat(k,1675) = 0._r8 - mat(k,1676) = 0._r8 - mat(k,1677) = 0._r8 - mat(k,1679) = 0._r8 - mat(k,1683) = 0._r8 - mat(k,1688) = 0._r8 - mat(k,1693) = 0._r8 - mat(k,1694) = 0._r8 - mat(k,1698) = 0._r8 - mat(k,1699) = 0._r8 - mat(k,1702) = 0._r8 - mat(k,1707) = 0._r8 - mat(k,1708) = 0._r8 - mat(k,1709) = 0._r8 - mat(k,1713) = 0._r8 - mat(k,1714) = 0._r8 - mat(k,1715) = 0._r8 - mat(k,1716) = 0._r8 - mat(k,1719) = 0._r8 - mat(k,1723) = 0._r8 - mat(k,1724) = 0._r8 - mat(k,1726) = 0._r8 - mat(k,1727) = 0._r8 - mat(k,1740) = 0._r8 - mat(k,1742) = 0._r8 - mat(k,1749) = 0._r8 - mat(k,1751) = 0._r8 - mat(k,1754) = 0._r8 - mat(k,1755) = 0._r8 - mat(k,1757) = 0._r8 - mat(k,1760) = 0._r8 - mat(k,1764) = 0._r8 - mat(k,1766) = 0._r8 - mat(k,1767) = 0._r8 - mat(k,1770) = 0._r8 - mat(k,1785) = 0._r8 - mat(k,1794) = 0._r8 - mat(k,1798) = 0._r8 - mat(k,1806) = 0._r8 - mat(k,1809) = 0._r8 - mat(k,1811) = 0._r8 - mat(k,1813) = 0._r8 - mat(k,1816) = 0._r8 - mat(k,1817) = 0._r8 - mat(k,1818) = 0._r8 - mat(k,1822) = 0._r8 - mat(k,1824) = 0._r8 - mat(k, 1) = mat(k, 1) - dti(k) - mat(k, 4) = mat(k, 4) - dti(k) - mat(k, 7) = mat(k, 7) - dti(k) - mat(k, 10) = mat(k, 10) - dti(k) - mat(k, 12) = mat(k, 12) - dti(k) - mat(k, 16) = mat(k, 16) - dti(k) - mat(k, 19) = mat(k, 19) - dti(k) - mat(k, 22) = mat(k, 22) - dti(k) - mat(k, 26) = mat(k, 26) - dti(k) - mat(k, 30) = mat(k, 30) - dti(k) - mat(k, 33) = mat(k, 33) - dti(k) - mat(k, 39) = mat(k, 39) - dti(k) - mat(k, 45) = mat(k, 45) - dti(k) - mat(k, 51) = mat(k, 51) - dti(k) - mat(k, 58) = mat(k, 58) - dti(k) - mat(k, 65) = mat(k, 65) - dti(k) - mat(k, 71) = mat(k, 71) - dti(k) - mat(k, 79) = mat(k, 79) - dti(k) - mat(k, 86) = mat(k, 86) - dti(k) - mat(k, 95) = mat(k, 95) - dti(k) - mat(k, 102) = mat(k, 102) - dti(k) - mat(k, 108) = mat(k, 108) - dti(k) - mat(k, 116) = mat(k, 116) - dti(k) - mat(k, 123) = mat(k, 123) - dti(k) - mat(k, 128) = mat(k, 128) - dti(k) - mat(k, 134) = mat(k, 134) - dti(k) - mat(k, 142) = mat(k, 142) - dti(k) - mat(k, 151) = mat(k, 151) - dti(k) - mat(k, 159) = mat(k, 159) - dti(k) - mat(k, 168) = mat(k, 168) - dti(k) - mat(k, 176) = mat(k, 176) - dti(k) - mat(k, 184) = mat(k, 184) - dti(k) - mat(k, 191) = mat(k, 191) - dti(k) - mat(k, 201) = mat(k, 201) - dti(k) - mat(k, 211) = mat(k, 211) - dti(k) - mat(k, 219) = mat(k, 219) - dti(k) - mat(k, 229) = mat(k, 229) - dti(k) - mat(k, 244) = mat(k, 244) - dti(k) - mat(k, 257) = mat(k, 257) - dti(k) - mat(k, 270) = mat(k, 270) - dti(k) - mat(k, 285) = mat(k, 285) - dti(k) - mat(k, 297) = mat(k, 297) - dti(k) - mat(k, 311) = mat(k, 311) - dti(k) - mat(k, 328) = mat(k, 328) - dti(k) - mat(k, 340) = mat(k, 340) - dti(k) - mat(k, 356) = mat(k, 356) - dti(k) - mat(k, 371) = mat(k, 371) - dti(k) - mat(k, 385) = mat(k, 385) - dti(k) - mat(k, 401) = mat(k, 401) - dti(k) - mat(k, 419) = mat(k, 419) - dti(k) - mat(k, 438) = mat(k, 438) - dti(k) - mat(k, 457) = mat(k, 457) - dti(k) - mat(k, 477) = mat(k, 477) - dti(k) - mat(k, 497) = mat(k, 497) - dti(k) - mat(k, 519) = mat(k, 519) - dti(k) - mat(k, 541) = mat(k, 541) - dti(k) - mat(k, 573) = mat(k, 573) - dti(k) - mat(k, 597) = mat(k, 597) - dti(k) - mat(k, 619) = mat(k, 619) - dti(k) - mat(k, 652) = mat(k, 652) - dti(k) - mat(k, 686) = mat(k, 686) - dti(k) - mat(k, 712) = mat(k, 712) - dti(k) - mat(k, 755) = mat(k, 755) - dti(k) - mat(k, 785) = mat(k, 785) - dti(k) - mat(k, 829) = mat(k, 829) - dti(k) - mat(k, 878) = mat(k, 878) - dti(k) - mat(k, 922) = mat(k, 922) - dti(k) - mat(k, 979) = mat(k, 979) - dti(k) - mat(k,1023) = mat(k,1023) - dti(k) - mat(k,1066) = mat(k,1066) - dti(k) - mat(k,1107) = mat(k,1107) - dti(k) - mat(k,1153) = mat(k,1153) - dti(k) - mat(k,1197) = mat(k,1197) - dti(k) - mat(k,1233) = mat(k,1233) - dti(k) - mat(k,1277) = mat(k,1277) - dti(k) - mat(k,1314) = mat(k,1314) - dti(k) - mat(k,1360) = mat(k,1360) - dti(k) - mat(k,1403) = mat(k,1403) - dti(k) - mat(k,1442) = mat(k,1442) - dti(k) - mat(k,1488) = mat(k,1488) - dti(k) - mat(k,1532) = mat(k,1532) - dti(k) - mat(k,1576) = mat(k,1576) - dti(k) - mat(k,1610) = mat(k,1610) - dti(k) - mat(k,1647) = mat(k,1647) - dti(k) - mat(k,1691) = mat(k,1691) - dti(k) - mat(k,1728) = mat(k,1728) - dti(k) - mat(k,1771) = mat(k,1771) - dti(k) - mat(k,1825) = mat(k,1825) - dti(k) - end do + mat( 1) = lmat( 1) + mat( 2) = lmat( 2) + mat( 3) = lmat( 3) + mat( 4) = mat( 4) + lmat( 4) + mat( 5) = mat( 5) + lmat( 5) + mat( 7) = lmat( 7) + mat( 8) = lmat( 8) + mat( 9) = lmat( 9) + mat( 10) = lmat( 10) + mat( 11) = lmat( 11) + mat( 12) = mat( 12) + lmat( 12) + mat( 13) = mat( 13) + lmat( 13) + mat( 15) = mat( 15) + lmat( 15) + mat( 16) = lmat( 16) + mat( 17) = lmat( 17) + mat( 18) = lmat( 18) + mat( 19) = lmat( 19) + mat( 20) = lmat( 20) + mat( 21) = lmat( 21) + mat( 22) = mat( 22) + lmat( 22) + mat( 23) = mat( 23) + lmat( 23) + mat( 24) = lmat( 24) + mat( 25) = mat( 25) + lmat( 25) + mat( 29) = mat( 29) + lmat( 29) + mat( 33) = mat( 33) + lmat( 33) + mat( 35) = mat( 35) + lmat( 35) + mat( 36) = mat( 36) + lmat( 36) + mat( 37) = lmat( 37) + mat( 39) = mat( 39) + lmat( 39) + mat( 45) = mat( 45) + lmat( 45) + mat( 51) = mat( 51) + lmat( 51) + mat( 53) = lmat( 53) + mat( 54) = mat( 54) + lmat( 54) + mat( 55) = lmat( 55) + mat( 57) = mat( 57) + lmat( 57) + mat( 58) = lmat( 58) + mat( 59) = mat( 59) + lmat( 59) + mat( 60) = mat( 60) + lmat( 60) + mat( 62) = lmat( 62) + mat( 64) = mat( 64) + lmat( 64) + mat( 65) = lmat( 65) + mat( 66) = lmat( 66) + mat( 71) = mat( 71) + lmat( 71) + mat( 72) = lmat( 72) + mat( 77) = mat( 77) + lmat( 77) + mat( 78) = mat( 78) + lmat( 78) + mat( 79) = lmat( 79) + mat( 80) = lmat( 80) + mat( 81) = mat( 81) + lmat( 81) + mat( 82) = lmat( 82) + mat( 83) = lmat( 83) + mat( 84) = mat( 84) + lmat( 84) + mat( 85) = lmat( 85) + mat( 86) = mat( 86) + lmat( 86) + mat( 89) = mat( 89) + lmat( 89) + mat( 90) = mat( 90) + lmat( 90) + mat( 91) = lmat( 91) + mat( 92) = lmat( 92) + mat( 93) = mat( 93) + lmat( 93) + mat( 94) = lmat( 94) + mat( 96) = lmat( 96) + mat( 97) = mat( 97) + lmat( 97) + mat( 98) = mat( 98) + lmat( 98) + mat( 102) = mat( 102) + lmat( 102) + mat( 111) = mat( 111) + lmat( 111) + mat( 113) = mat( 113) + lmat( 113) + mat( 118) = mat( 118) + lmat( 118) + mat( 119) = lmat( 119) + mat( 123) = mat( 123) + lmat( 123) + mat( 124) = mat( 124) + lmat( 124) + mat( 125) = mat( 125) + lmat( 125) + mat( 127) = lmat( 127) + mat( 130) = mat( 130) + lmat( 130) + mat( 138) = mat( 138) + lmat( 138) + mat( 143) = lmat( 143) + mat( 145) = mat( 145) + lmat( 145) + mat( 146) = mat( 146) + lmat( 146) + mat( 154) = mat( 154) + lmat( 154) + mat( 155) = mat( 155) + lmat( 155) + mat( 156) = lmat( 156) + mat( 164) = mat( 164) + lmat( 164) + mat( 165) = lmat( 165) + mat( 167) = mat( 167) + lmat( 167) + mat( 172) = mat( 172) + lmat( 172) + mat( 179) = mat( 179) + lmat( 179) + mat( 180) = mat( 180) + lmat( 180) + mat( 184) = mat( 184) + lmat( 184) + mat( 188) = mat( 188) + lmat( 188) + mat( 189) = mat( 189) + lmat( 189) + mat( 192) = mat( 192) + lmat( 192) + mat( 195) = mat( 195) + lmat( 195) + mat( 197) = mat( 197) + lmat( 197) + mat( 203) = lmat( 203) + mat( 206) = mat( 206) + lmat( 206) + mat( 207) = lmat( 207) + mat( 211) = lmat( 211) + mat( 214) = mat( 214) + lmat( 214) + mat( 218) = mat( 218) + lmat( 218) + mat( 219) = mat( 219) + lmat( 219) + mat( 222) = lmat( 222) + mat( 223) = mat( 223) + lmat( 223) + mat( 224) = mat( 224) + lmat( 224) + mat( 226) = mat( 226) + lmat( 226) + mat( 227) = mat( 227) + lmat( 227) + mat( 229) = mat( 229) + lmat( 229) + mat( 239) = mat( 239) + lmat( 239) + mat( 243) = lmat( 243) + mat( 244) = lmat( 244) + mat( 247) = lmat( 247) + mat( 248) = mat( 248) + lmat( 248) + mat( 249) = lmat( 249) + mat( 251) = lmat( 251) + mat( 253) = mat( 253) + lmat( 253) + mat( 263) = lmat( 263) + mat( 266) = mat( 266) + lmat( 266) + mat( 277) = mat( 277) + lmat( 277) + mat( 292) = mat( 292) + lmat( 292) + mat( 304) = mat( 304) + lmat( 304) + mat( 305) = lmat( 305) + mat( 317) = mat( 317) + lmat( 317) + mat( 320) = mat( 320) + lmat( 320) + mat( 331) = mat( 331) + lmat( 331) + mat( 332) = lmat( 332) + mat( 335) = mat( 335) + lmat( 335) + mat( 347) = mat( 347) + lmat( 347) + mat( 348) = lmat( 348) + mat( 361) = mat( 361) + lmat( 361) + mat( 362) = mat( 362) + lmat( 362) + mat( 363) = lmat( 363) + mat( 375) = mat( 375) + lmat( 375) + mat( 376) = mat( 376) + lmat( 376) + mat( 378) = lmat( 378) + mat( 382) = mat( 382) + lmat( 382) + mat( 385) = mat( 385) + lmat( 385) + mat( 388) = lmat( 388) + mat( 389) = mat( 389) + lmat( 389) + mat( 390) = mat( 390) + lmat( 390) + mat( 410) = mat( 410) + lmat( 410) + mat( 411) = mat( 411) + lmat( 411) + mat( 423) = mat( 423) + lmat( 423) + mat( 431) = mat( 431) + lmat( 431) + mat( 450) = mat( 450) + lmat( 450) + mat( 451) = lmat( 451) + mat( 461) = mat( 461) + lmat( 461) + mat( 466) = mat( 466) + lmat( 466) + mat( 467) = lmat( 467) + mat( 483) = mat( 483) + lmat( 483) + mat( 486) = mat( 486) + lmat( 486) + mat( 489) = lmat( 489) + mat( 503) = mat( 503) + lmat( 503) + mat( 507) = mat( 507) + lmat( 507) + mat( 508) = lmat( 508) + mat( 523) = mat( 523) + lmat( 523) + mat( 524) = mat( 524) + lmat( 524) + mat( 528) = lmat( 528) + mat( 529) = mat( 529) + lmat( 529) + mat( 534) = mat( 534) + lmat( 534) + mat( 548) = mat( 548) + lmat( 548) + mat( 549) = mat( 549) + lmat( 549) + mat( 551) = mat( 551) + lmat( 551) + mat( 554) = lmat( 554) + mat( 556) = mat( 556) + lmat( 556) + mat( 558) = mat( 558) + lmat( 558) + mat( 559) = lmat( 559) + mat( 560) = mat( 560) + lmat( 560) + mat( 561) = lmat( 561) + mat( 562) = mat( 562) + lmat( 562) + mat( 564) = mat( 564) + lmat( 564) + mat( 568) = mat( 568) + lmat( 568) + mat( 569) = mat( 569) + lmat( 569) + mat( 572) = lmat( 572) + mat( 574) = mat( 574) + lmat( 574) + mat( 583) = mat( 583) + lmat( 583) + mat( 600) = lmat( 600) + mat( 613) = mat( 613) + lmat( 613) + mat( 636) = mat( 636) + lmat( 636) + mat( 650) = lmat( 650) + mat( 655) = mat( 655) + lmat( 655) + mat( 659) = mat( 659) + lmat( 659) + mat( 670) = mat( 670) + lmat( 670) + mat( 691) = lmat( 691) + mat( 692) = lmat( 692) + mat( 704) = mat( 704) + lmat( 704) + mat( 705) = mat( 705) + lmat( 705) + mat( 710) = mat( 710) + lmat( 710) + mat( 711) = mat( 711) + lmat( 711) + mat( 720) = mat( 720) + lmat( 720) + mat( 731) = mat( 731) + lmat( 731) + mat( 739) = mat( 739) + lmat( 739) + mat( 759) = lmat( 759) + mat( 769) = mat( 769) + lmat( 769) + mat( 776) = mat( 776) + lmat( 776) + mat( 784) = lmat( 784) + mat( 793) = lmat( 793) + mat( 794) = lmat( 794) + mat( 817) = mat( 817) + lmat( 817) + mat( 860) = mat( 860) + lmat( 860) + mat( 905) = mat( 905) + lmat( 905) + mat( 906) = mat( 906) + lmat( 906) + mat( 912) = mat( 912) + lmat( 912) + mat( 941) = mat( 941) + lmat( 941) + mat( 983) = mat( 983) + lmat( 983) + mat(1002) = lmat(1002) + mat(1026) = mat(1026) + lmat(1026) + mat(1043) = mat(1043) + lmat(1043) + mat(1062) = mat(1062) + lmat(1062) + mat(1071) = mat(1071) + lmat(1071) + mat(1077) = mat(1077) + lmat(1077) + mat(1081) = mat(1081) + lmat(1081) + mat(1085) = mat(1085) + lmat(1085) + mat(1114) = mat(1114) + lmat(1114) + mat(1116) = mat(1116) + lmat(1116) + mat(1123) = mat(1123) + lmat(1123) + mat(1132) = lmat(1132) + mat(1133) = mat(1133) + lmat(1133) + mat(1138) = mat(1138) + lmat(1138) + mat(1142) = mat(1142) + lmat(1142) + mat(1158) = mat(1158) + lmat(1158) + mat(1161) = mat(1161) + lmat(1161) + mat(1164) = mat(1164) + lmat(1164) + mat(1166) = mat(1166) + lmat(1166) + mat(1174) = mat(1174) + lmat(1174) + mat(1179) = lmat(1179) + mat(1180) = lmat(1180) + mat(1188) = mat(1188) + lmat(1188) + mat(1194) = mat(1194) + lmat(1194) + mat(1201) = mat(1201) + lmat(1201) + mat(1220) = lmat(1220) + mat(1235) = mat(1235) + lmat(1235) + mat(1237) = mat(1237) + lmat(1237) + mat(1241) = mat(1241) + lmat(1241) + mat(1271) = mat(1271) + lmat(1271) + mat(1282) = mat(1282) + lmat(1282) + mat(1283) = mat(1283) + lmat(1283) + mat(1296) = mat(1296) + lmat(1296) + mat(1312) = mat(1312) + lmat(1312) + mat(1324) = mat(1324) + lmat(1324) + mat(1326) = mat(1326) + lmat(1326) + mat(1328) = mat(1328) + lmat(1328) + mat(1359) = lmat(1359) + mat(1367) = mat(1367) + lmat(1367) + mat(1376) = mat(1376) + lmat(1376) + mat(1410) = mat(1410) + lmat(1410) + mat(1451) = lmat(1451) + mat(1453) = mat(1453) + lmat(1453) + mat(1460) = mat(1460) + lmat(1460) + mat(1463) = mat(1463) + lmat(1463) + mat(1464) = mat(1464) + lmat(1464) + mat(1475) = mat(1475) + lmat(1475) + mat(1507) = mat(1507) + lmat(1507) + mat(1509) = mat(1509) + lmat(1509) + mat(1517) = lmat(1517) + mat(1522) = mat(1522) + lmat(1522) + mat(1539) = mat(1539) + lmat(1539) + mat(1542) = mat(1542) + lmat(1542) + mat(1558) = lmat(1558) + mat(1574) = mat(1574) + lmat(1574) + mat(1576) = mat(1576) + lmat(1576) + mat(1578) = mat(1578) + lmat(1578) + mat(1584) = mat(1584) + lmat(1584) + mat(1590) = mat(1590) + lmat(1590) + mat(1606) = mat(1606) + lmat(1606) + mat(1614) = mat(1614) + lmat(1614) + mat(1617) = mat(1617) + lmat(1617) + mat(1634) = mat(1634) + lmat(1634) + mat(1643) = lmat(1643) + mat(1657) = mat(1657) + lmat(1657) + mat(1677) = mat(1677) + lmat(1677) + mat(1679) = mat(1679) + lmat(1679) + mat(1683) = mat(1683) + lmat(1683) + mat(1687) = mat(1687) + lmat(1687) + mat(1691) = mat(1691) + lmat(1691) + mat(1692) = mat(1692) + lmat(1692) + mat(1711) = lmat(1711) + mat(1716) = mat(1716) + lmat(1716) + mat(1720) = mat(1720) + lmat(1720) + mat(1726) = lmat(1726) + mat(1739) = lmat(1739) + mat(1745) = mat(1745) + lmat(1745) + mat( 132) = 0._r8 + mat( 136) = 0._r8 + mat( 140) = 0._r8 + mat( 141) = 0._r8 + mat( 169) = 0._r8 + mat( 208) = 0._r8 + mat( 209) = 0._r8 + mat( 210) = 0._r8 + mat( 212) = 0._r8 + mat( 215) = 0._r8 + mat( 228) = 0._r8 + mat( 252) = 0._r8 + mat( 254) = 0._r8 + mat( 255) = 0._r8 + mat( 269) = 0._r8 + mat( 270) = 0._r8 + mat( 276) = 0._r8 + mat( 293) = 0._r8 + mat( 294) = 0._r8 + mat( 295) = 0._r8 + mat( 297) = 0._r8 + mat( 301) = 0._r8 + mat( 323) = 0._r8 + mat( 325) = 0._r8 + mat( 326) = 0._r8 + mat( 328) = 0._r8 + mat( 330) = 0._r8 + mat( 412) = 0._r8 + mat( 413) = 0._r8 + mat( 416) = 0._r8 + mat( 417) = 0._r8 + mat( 424) = 0._r8 + mat( 425) = 0._r8 + mat( 426) = 0._r8 + mat( 427) = 0._r8 + mat( 430) = 0._r8 + mat( 432) = 0._r8 + mat( 434) = 0._r8 + mat( 438) = 0._r8 + mat( 439) = 0._r8 + mat( 440) = 0._r8 + mat( 442) = 0._r8 + mat( 447) = 0._r8 + mat( 448) = 0._r8 + mat( 468) = 0._r8 + mat( 474) = 0._r8 + mat( 480) = 0._r8 + mat( 514) = 0._r8 + mat( 520) = 0._r8 + mat( 527) = 0._r8 + mat( 530) = 0._r8 + mat( 535) = 0._r8 + mat( 536) = 0._r8 + mat( 537) = 0._r8 + mat( 539) = 0._r8 + mat( 540) = 0._r8 + mat( 542) = 0._r8 + mat( 543) = 0._r8 + mat( 544) = 0._r8 + mat( 553) = 0._r8 + mat( 555) = 0._r8 + mat( 565) = 0._r8 + mat( 566) = 0._r8 + mat( 570) = 0._r8 + mat( 571) = 0._r8 + mat( 573) = 0._r8 + mat( 575) = 0._r8 + mat( 576) = 0._r8 + mat( 578) = 0._r8 + mat( 579) = 0._r8 + mat( 585) = 0._r8 + mat( 589) = 0._r8 + mat( 596) = 0._r8 + mat( 604) = 0._r8 + mat( 607) = 0._r8 + mat( 608) = 0._r8 + mat( 641) = 0._r8 + mat( 644) = 0._r8 + mat( 646) = 0._r8 + mat( 668) = 0._r8 + mat( 669) = 0._r8 + mat( 675) = 0._r8 + mat( 680) = 0._r8 + mat( 681) = 0._r8 + mat( 683) = 0._r8 + mat( 685) = 0._r8 + mat( 686) = 0._r8 + mat( 688) = 0._r8 + mat( 699) = 0._r8 + mat( 709) = 0._r8 + mat( 712) = 0._r8 + mat( 716) = 0._r8 + mat( 721) = 0._r8 + mat( 722) = 0._r8 + mat( 724) = 0._r8 + mat( 726) = 0._r8 + mat( 727) = 0._r8 + mat( 735) = 0._r8 + mat( 743) = 0._r8 + mat( 755) = 0._r8 + mat( 760) = 0._r8 + mat( 762) = 0._r8 + mat( 768) = 0._r8 + mat( 780) = 0._r8 + mat( 786) = 0._r8 + mat( 788) = 0._r8 + mat( 796) = 0._r8 + mat( 797) = 0._r8 + mat( 809) = 0._r8 + mat( 813) = 0._r8 + mat( 818) = 0._r8 + mat( 820) = 0._r8 + mat( 822) = 0._r8 + mat( 824) = 0._r8 + mat( 828) = 0._r8 + mat( 830) = 0._r8 + mat( 832) = 0._r8 + mat( 834) = 0._r8 + mat( 835) = 0._r8 + mat( 836) = 0._r8 + mat( 841) = 0._r8 + mat( 855) = 0._r8 + mat( 859) = 0._r8 + mat( 862) = 0._r8 + mat( 863) = 0._r8 + mat( 864) = 0._r8 + mat( 866) = 0._r8 + mat( 870) = 0._r8 + mat( 872) = 0._r8 + mat( 874) = 0._r8 + mat( 876) = 0._r8 + mat( 877) = 0._r8 + mat( 878) = 0._r8 + mat( 888) = 0._r8 + mat( 892) = 0._r8 + mat( 893) = 0._r8 + mat( 894) = 0._r8 + mat( 901) = 0._r8 + mat( 903) = 0._r8 + mat( 904) = 0._r8 + mat( 907) = 0._r8 + mat( 908) = 0._r8 + mat( 909) = 0._r8 + mat( 911) = 0._r8 + mat( 914) = 0._r8 + mat( 915) = 0._r8 + mat( 916) = 0._r8 + mat( 917) = 0._r8 + mat( 918) = 0._r8 + mat( 922) = 0._r8 + mat( 924) = 0._r8 + mat( 929) = 0._r8 + mat( 930) = 0._r8 + mat( 933) = 0._r8 + mat( 938) = 0._r8 + mat( 939) = 0._r8 + mat( 943) = 0._r8 + mat( 944) = 0._r8 + mat( 945) = 0._r8 + mat( 947) = 0._r8 + mat( 949) = 0._r8 + mat( 951) = 0._r8 + mat( 953) = 0._r8 + mat( 956) = 0._r8 + mat( 958) = 0._r8 + mat( 959) = 0._r8 + mat( 979) = 0._r8 + mat( 984) = 0._r8 + mat( 986) = 0._r8 + mat( 990) = 0._r8 + mat( 992) = 0._r8 + mat( 994) = 0._r8 + mat( 996) = 0._r8 + mat( 997) = 0._r8 + mat( 998) = 0._r8 + mat(1003) = 0._r8 + mat(1017) = 0._r8 + mat(1021) = 0._r8 + mat(1022) = 0._r8 + mat(1025) = 0._r8 + mat(1028) = 0._r8 + mat(1032) = 0._r8 + mat(1033) = 0._r8 + mat(1036) = 0._r8 + mat(1038) = 0._r8 + mat(1039) = 0._r8 + mat(1040) = 0._r8 + mat(1046) = 0._r8 + mat(1050) = 0._r8 + mat(1053) = 0._r8 + mat(1054) = 0._r8 + mat(1057) = 0._r8 + mat(1058) = 0._r8 + mat(1065) = 0._r8 + mat(1066) = 0._r8 + mat(1067) = 0._r8 + mat(1068) = 0._r8 + mat(1069) = 0._r8 + mat(1070) = 0._r8 + mat(1076) = 0._r8 + mat(1078) = 0._r8 + mat(1079) = 0._r8 + mat(1080) = 0._r8 + mat(1099) = 0._r8 + mat(1102) = 0._r8 + mat(1107) = 0._r8 + mat(1108) = 0._r8 + mat(1110) = 0._r8 + mat(1111) = 0._r8 + mat(1112) = 0._r8 + mat(1118) = 0._r8 + mat(1120) = 0._r8 + mat(1121) = 0._r8 + mat(1122) = 0._r8 + mat(1126) = 0._r8 + mat(1127) = 0._r8 + mat(1129) = 0._r8 + mat(1143) = 0._r8 + mat(1144) = 0._r8 + mat(1145) = 0._r8 + mat(1147) = 0._r8 + mat(1149) = 0._r8 + mat(1151) = 0._r8 + mat(1152) = 0._r8 + mat(1154) = 0._r8 + mat(1155) = 0._r8 + mat(1156) = 0._r8 + mat(1157) = 0._r8 + mat(1159) = 0._r8 + mat(1163) = 0._r8 + mat(1165) = 0._r8 + mat(1167) = 0._r8 + mat(1170) = 0._r8 + mat(1171) = 0._r8 + mat(1172) = 0._r8 + mat(1181) = 0._r8 + mat(1184) = 0._r8 + mat(1187) = 0._r8 + mat(1192) = 0._r8 + mat(1193) = 0._r8 + mat(1196) = 0._r8 + mat(1197) = 0._r8 + mat(1203) = 0._r8 + mat(1204) = 0._r8 + mat(1205) = 0._r8 + mat(1206) = 0._r8 + mat(1207) = 0._r8 + mat(1212) = 0._r8 + mat(1214) = 0._r8 + mat(1218) = 0._r8 + mat(1224) = 0._r8 + mat(1225) = 0._r8 + mat(1244) = 0._r8 + mat(1248) = 0._r8 + mat(1267) = 0._r8 + mat(1272) = 0._r8 + mat(1274) = 0._r8 + mat(1275) = 0._r8 + mat(1276) = 0._r8 + mat(1278) = 0._r8 + mat(1284) = 0._r8 + mat(1286) = 0._r8 + mat(1288) = 0._r8 + mat(1289) = 0._r8 + mat(1290) = 0._r8 + mat(1303) = 0._r8 + mat(1305) = 0._r8 + mat(1313) = 0._r8 + mat(1314) = 0._r8 + mat(1315) = 0._r8 + mat(1316) = 0._r8 + mat(1317) = 0._r8 + mat(1322) = 0._r8 + mat(1325) = 0._r8 + mat(1327) = 0._r8 + mat(1329) = 0._r8 + mat(1332) = 0._r8 + mat(1350) = 0._r8 + mat(1354) = 0._r8 + mat(1355) = 0._r8 + mat(1358) = 0._r8 + mat(1361) = 0._r8 + mat(1365) = 0._r8 + mat(1366) = 0._r8 + mat(1371) = 0._r8 + mat(1372) = 0._r8 + mat(1373) = 0._r8 + mat(1385) = 0._r8 + mat(1389) = 0._r8 + mat(1394) = 0._r8 + mat(1398) = 0._r8 + mat(1402) = 0._r8 + mat(1403) = 0._r8 + mat(1405) = 0._r8 + mat(1413) = 0._r8 + mat(1416) = 0._r8 + mat(1417) = 0._r8 + mat(1434) = 0._r8 + mat(1438) = 0._r8 + mat(1439) = 0._r8 + mat(1442) = 0._r8 + mat(1443) = 0._r8 + mat(1445) = 0._r8 + mat(1449) = 0._r8 + mat(1450) = 0._r8 + mat(1455) = 0._r8 + mat(1456) = 0._r8 + mat(1457) = 0._r8 + mat(1485) = 0._r8 + mat(1494) = 0._r8 + mat(1497) = 0._r8 + mat(1498) = 0._r8 + mat(1506) = 0._r8 + mat(1508) = 0._r8 + mat(1513) = 0._r8 + mat(1515) = 0._r8 + mat(1520) = 0._r8 + mat(1523) = 0._r8 + mat(1525) = 0._r8 + mat(1526) = 0._r8 + mat(1529) = 0._r8 + mat(1530) = 0._r8 + mat(1533) = 0._r8 + mat(1535) = 0._r8 + mat(1536) = 0._r8 + mat(1537) = 0._r8 + mat(1538) = 0._r8 + mat(1540) = 0._r8 + mat(1543) = 0._r8 + mat(1545) = 0._r8 + mat(1546) = 0._r8 + mat(1549) = 0._r8 + mat(1552) = 0._r8 + mat(1553) = 0._r8 + mat(1556) = 0._r8 + mat(1560) = 0._r8 + mat(1561) = 0._r8 + mat(1564) = 0._r8 + mat(1565) = 0._r8 + mat(1570) = 0._r8 + mat(1571) = 0._r8 + mat(1573) = 0._r8 + mat(1575) = 0._r8 + mat(1581) = 0._r8 + mat(1585) = 0._r8 + mat(1589) = 0._r8 + mat(1592) = 0._r8 + mat(1596) = 0._r8 + mat(1598) = 0._r8 + mat(1599) = 0._r8 + mat(1600) = 0._r8 + mat(1602) = 0._r8 + mat(1603) = 0._r8 + mat(1609) = 0._r8 + mat(1611) = 0._r8 + mat(1613) = 0._r8 + mat(1618) = 0._r8 + mat(1620) = 0._r8 + mat(1624) = 0._r8 + mat(1626) = 0._r8 + mat(1629) = 0._r8 + mat(1630) = 0._r8 + mat(1637) = 0._r8 + mat(1638) = 0._r8 + mat(1640) = 0._r8 + mat(1641) = 0._r8 + mat(1642) = 0._r8 + mat(1644) = 0._r8 + mat(1645) = 0._r8 + mat(1646) = 0._r8 + mat(1648) = 0._r8 + mat(1649) = 0._r8 + mat(1650) = 0._r8 + mat(1651) = 0._r8 + mat(1652) = 0._r8 + mat(1653) = 0._r8 + mat(1654) = 0._r8 + mat(1656) = 0._r8 + mat(1662) = 0._r8 + mat(1663) = 0._r8 + mat(1664) = 0._r8 + mat(1666) = 0._r8 + mat(1667) = 0._r8 + mat(1670) = 0._r8 + mat(1671) = 0._r8 + mat(1672) = 0._r8 + mat(1673) = 0._r8 + mat(1674) = 0._r8 + mat(1675) = 0._r8 + mat(1676) = 0._r8 + mat(1678) = 0._r8 + mat(1680) = 0._r8 + mat(1681) = 0._r8 + mat(1682) = 0._r8 + mat(1684) = 0._r8 + mat(1685) = 0._r8 + mat(1686) = 0._r8 + mat(1688) = 0._r8 + mat(1689) = 0._r8 + mat(1690) = 0._r8 + mat(1693) = 0._r8 + mat(1706) = 0._r8 + mat(1715) = 0._r8 + mat(1719) = 0._r8 + mat(1725) = 0._r8 + mat(1729) = 0._r8 + mat(1730) = 0._r8 + mat(1732) = 0._r8 + mat(1733) = 0._r8 + mat(1735) = 0._r8 + mat(1737) = 0._r8 + mat(1742) = 0._r8 + mat(1744) = 0._r8 + mat( 1) = mat( 1) - dti + mat( 4) = mat( 4) - dti + mat( 7) = mat( 7) - dti + mat( 10) = mat( 10) - dti + mat( 12) = mat( 12) - dti + mat( 16) = mat( 16) - dti + mat( 19) = mat( 19) - dti + mat( 22) = mat( 22) - dti + mat( 25) = mat( 25) - dti + mat( 29) = mat( 29) - dti + mat( 33) = mat( 33) - dti + mat( 39) = mat( 39) - dti + mat( 45) = mat( 45) - dti + mat( 51) = mat( 51) - dti + mat( 57) = mat( 57) - dti + mat( 64) = mat( 64) - dti + mat( 71) = mat( 71) - dti + mat( 77) = mat( 77) - dti + mat( 84) = mat( 84) - dti + mat( 90) = mat( 90) - dti + mat( 98) = mat( 98) - dti + mat( 102) = mat( 102) - dti + mat( 111) = mat( 111) - dti + mat( 118) = mat( 118) - dti + mat( 124) = mat( 124) - dti + mat( 130) = mat( 130) - dti + mat( 138) = mat( 138) - dti + mat( 146) = mat( 146) - dti + mat( 155) = mat( 155) - dti + mat( 164) = mat( 164) - dti + mat( 172) = mat( 172) - dti + mat( 179) = mat( 179) - dti + mat( 188) = mat( 188) - dti + mat( 195) = mat( 195) - dti + mat( 206) = mat( 206) - dti + mat( 219) = mat( 219) - dti + mat( 229) = mat( 229) - dti + mat( 239) = mat( 239) - dti + mat( 253) = mat( 253) - dti + mat( 266) = mat( 266) - dti + mat( 277) = mat( 277) - dti + mat( 292) = mat( 292) - dti + mat( 304) = mat( 304) - dti + mat( 320) = mat( 320) - dti + mat( 331) = mat( 331) - dti + mat( 347) = mat( 347) - dti + mat( 362) = mat( 362) - dti + mat( 376) = mat( 376) - dti + mat( 390) = mat( 390) - dti + mat( 411) = mat( 411) - dti + mat( 431) = mat( 431) - dti + mat( 450) = mat( 450) - dti + mat( 466) = mat( 466) - dti + mat( 486) = mat( 486) - dti + mat( 507) = mat( 507) - dti + mat( 529) = mat( 529) - dti + mat( 560) = mat( 560) - dti + mat( 583) = mat( 583) - dti + mat( 613) = mat( 613) - dti + mat( 636) = mat( 636) - dti + mat( 670) = mat( 670) - dti + mat( 711) = mat( 711) - dti + mat( 739) = mat( 739) - dti + mat( 769) = mat( 769) - dti + mat( 817) = mat( 817) - dti + mat( 860) = mat( 860) - dti + mat( 905) = mat( 905) - dti + mat( 941) = mat( 941) - dti + mat( 983) = mat( 983) - dti + mat(1026) = mat(1026) - dti + mat(1071) = mat(1071) - dti + mat(1114) = mat(1114) - dti + mat(1158) = mat(1158) - dti + mat(1201) = mat(1201) - dti + mat(1237) = mat(1237) - dti + mat(1282) = mat(1282) - dti + mat(1324) = mat(1324) - dti + mat(1367) = mat(1367) - dti + mat(1410) = mat(1410) - dti + mat(1453) = mat(1453) - dti + mat(1509) = mat(1509) - dti + mat(1542) = mat(1542) - dti + mat(1578) = mat(1578) - dti + mat(1617) = mat(1617) - dti + mat(1657) = mat(1657) - dti + mat(1692) = mat(1692) - dti + mat(1745) = mat(1745) - dti end subroutine nlnmat_finit - subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) + subroutine nlnmat( 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 nlnmat08( avec_len, mat, y, rxt ) - call nlnmat09( avec_len, mat, y, rxt ) - call nlnmat_finit( avec_len, mat, lmat, dti ) + real(r8), intent(in) :: dti + real(r8), intent(in) :: lmat(nzcnt) + real(r8), intent(in) :: y(gas_pcnst) + real(r8), intent(in) :: rxt(rxntot) + real(r8), intent(inout) :: mat(nzcnt) + call nlnmat01( mat, y, rxt ) + call nlnmat02( mat, y, rxt ) + call nlnmat03( mat, y, rxt ) + call nlnmat04( mat, y, rxt ) + call nlnmat05( mat, y, rxt ) + call nlnmat06( mat, y, rxt ) + call nlnmat07( mat, y, rxt ) + call nlnmat08( mat, y, rxt ) + call nlnmat_finit( mat, lmat, dti ) end subroutine nlnmat end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_mad/mo_prod_loss.F90 b/src/chemistry/pp_waccm_mad/mo_prod_loss.F90 index 9777a954f9..0134310ac7 100644 --- a/src/chemistry/pp_waccm_mad/mo_prod_loss.F90 +++ b/src/chemistry/pp_waccm_mad/mo_prod_loss.F90 @@ -1,963 +1,799 @@ 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 + subroutine exp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver implicit none !-------------------------------------------------------------------- ! ... dummy args !-------------------------------------------------------------------- - integer, intent(in) :: ofl, ofu, chnkpnts - real(r8), dimension(chnkpnts,max(1,clscnt1)), intent(out) :: & + real(r8), dimension(:,:,:), 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 + real(r8), intent(in) :: y(:,:,:) + real(r8), intent(in) :: rxt(:,:,:) + real(r8), intent(in) :: het_rates(:,:,:) !-------------------------------------------------------------------- ! ... loss and production for Explicit method !-------------------------------------------------------------------- - do k = ofl,ofu - loss(k,1) = ( + het_rates(k,4))* y(k,4) - prod(k,1) = 0._r8 - loss(k,2) = (rxt(k,470)* y(k,95) + rxt(k,31) + het_rates(k,5))* y(k,5) - prod(k,2) = 0._r8 - loss(k,3) = (rxt(k,471)* y(k,95) + rxt(k,32) + het_rates(k,6))* y(k,6) - prod(k,3) = 0._r8 - loss(k,4) = (rxt(k,497)* y(k,95) + rxt(k,33) + het_rates(k,7))* y(k,7) - prod(k,4) = 0._r8 - loss(k,5) = (rxt(k,472)* y(k,95) + rxt(k,34) + het_rates(k,8))* y(k,8) - prod(k,5) = 0._r8 - loss(k,6) = (rxt(k,473)* y(k,95) + rxt(k,35) + het_rates(k,9))* y(k,9) - prod(k,6) = 0._r8 - loss(k,7) = (rxt(k,474)* y(k,95) + rxt(k,36) + het_rates(k,10))* y(k,10) - prod(k,7) = 0._r8 - loss(k,8) = (rxt(k,475)* y(k,95) + rxt(k,37) + het_rates(k,11))* y(k,11) - prod(k,8) = 0._r8 - loss(k,9) = (rxt(k,476)* y(k,95) + rxt(k,38) + het_rates(k,12))* y(k,12) - prod(k,9) = 0._r8 - loss(k,10) = (rxt(k,508)* y(k,60) +rxt(k,520)* y(k,95) +rxt(k,509)* y(k,104) & - + rxt(k,39) + het_rates(k,13))* y(k,13) - prod(k,10) = 0._r8 - loss(k,11) = (rxt(k,510)* y(k,60) +rxt(k,521)* y(k,95) +rxt(k,511)* y(k,104) & - + rxt(k,40) + het_rates(k,15))* y(k,15) - prod(k,11) = 0._r8 - loss(k,12) = (rxt(k,512)* y(k,104) + rxt(k,41) + het_rates(k,16))* y(k,16) - prod(k,12) = 0._r8 - loss(k,13) = (rxt(k,513)* y(k,60) +rxt(k,514)* y(k,104) + rxt(k,42) & - + het_rates(k,17))* y(k,17) - prod(k,13) = 0._r8 - loss(k,14) = (rxt(k,502)* y(k,31) +rxt(k,446)* y(k,60) + (rxt(k,533) + & - rxt(k,534) +rxt(k,535))* y(k,95) +rxt(k,531)* y(k,104) + rxt(k,24) & - + rxt(k,25) + het_rates(k,20))* y(k,20) - prod(k,14) = 0._r8 - loss(k,15) = (rxt(k,515)* y(k,60) +rxt(k,498)* y(k,95) +rxt(k,516)* y(k,104) & - + rxt(k,43) + het_rates(k,21))* y(k,21) - prod(k,15) = 0._r8 - loss(k,16) = ( + het_rates(k,26))* y(k,26) - prod(k,16) = 0._r8 - loss(k,17) = (rxt(k,499)* y(k,95) + rxt(k,51) + het_rates(k,34))* y(k,34) - prod(k,17) = 0._r8 - loss(k,18) = (rxt(k,522)* y(k,95) +rxt(k,517)* y(k,104) + rxt(k,53) & - + het_rates(k,37))* y(k,37) - prod(k,18) = 0._r8 - loss(k,19) = (rxt(k,523)* y(k,95) +rxt(k,518)* y(k,104) + rxt(k,54) & - + het_rates(k,38))* y(k,38) - prod(k,19) = 0._r8 - loss(k,20) = (rxt(k,524)* y(k,95) +rxt(k,519)* y(k,104) + rxt(k,55) & - + het_rates(k,39))* y(k,39) - prod(k,20) = 0._r8 - loss(k,21) = ((rxt(k,437) +rxt(k,438))* y(k,95) + rxt(k,13) & - + het_rates(k,49))* y(k,49) - prod(k,21) = 0._r8 - loss(k,22) = ( + rxt(k,61) + het_rates(k,58))* y(k,58) - prod(k,22) = 0._r8 - end do + loss(:,:,1) = ( + het_rates(:,:,5))* y(:,:,5) + prod(:,:,1) = 0._r8 + loss(:,:,2) = (rxt(:,:,470)* y(:,:,95) + rxt(:,:,31) + het_rates(:,:,6)) & + * y(:,:,6) + prod(:,:,2) = 0._r8 + loss(:,:,3) = (rxt(:,:,471)* y(:,:,95) + rxt(:,:,32) + het_rates(:,:,7)) & + * y(:,:,7) + prod(:,:,3) = 0._r8 + loss(:,:,4) = (rxt(:,:,497)* y(:,:,95) + rxt(:,:,33) + het_rates(:,:,8)) & + * y(:,:,8) + prod(:,:,4) = 0._r8 + loss(:,:,5) = (rxt(:,:,472)* y(:,:,95) + rxt(:,:,34) + het_rates(:,:,9)) & + * y(:,:,9) + prod(:,:,5) = 0._r8 + loss(:,:,6) = (rxt(:,:,473)* y(:,:,95) + rxt(:,:,35) + het_rates(:,:,10)) & + * y(:,:,10) + prod(:,:,6) = 0._r8 + loss(:,:,7) = (rxt(:,:,474)* y(:,:,95) + rxt(:,:,36) + het_rates(:,:,11)) & + * y(:,:,11) + prod(:,:,7) = 0._r8 + loss(:,:,8) = (rxt(:,:,475)* y(:,:,95) + rxt(:,:,37) + het_rates(:,:,12)) & + * y(:,:,12) + prod(:,:,8) = 0._r8 + loss(:,:,9) = (rxt(:,:,476)* y(:,:,95) + rxt(:,:,38) + het_rates(:,:,13)) & + * y(:,:,13) + prod(:,:,9) = 0._r8 + loss(:,:,10) = (rxt(:,:,508)* y(:,:,23) +rxt(:,:,520)* y(:,:,95) & + +rxt(:,:,509)* y(:,:,104) + rxt(:,:,39) + het_rates(:,:,14)) & + * y(:,:,14) + prod(:,:,10) = 0._r8 + loss(:,:,11) = (rxt(:,:,510)* y(:,:,23) +rxt(:,:,521)* y(:,:,95) & + +rxt(:,:,511)* y(:,:,104) + rxt(:,:,40) + het_rates(:,:,16)) & + * y(:,:,16) + prod(:,:,11) = 0._r8 + loss(:,:,12) = (rxt(:,:,512)* y(:,:,104) + rxt(:,:,41) + het_rates(:,:,17)) & + * y(:,:,17) + prod(:,:,12) = 0._r8 + loss(:,:,13) = (rxt(:,:,513)* y(:,:,23) +rxt(:,:,514)* y(:,:,104) & + + rxt(:,:,42) + het_rates(:,:,18))* y(:,:,18) + prod(:,:,13) = 0._r8 + loss(:,:,14) = (rxt(:,:,446)* y(:,:,23) +rxt(:,:,502)* y(:,:,33) & + + (rxt(:,:,533) +rxt(:,:,534) +rxt(:,:,535))* y(:,:,95) & + +rxt(:,:,531)* y(:,:,104) + rxt(:,:,24) + rxt(:,:,25) & + + het_rates(:,:,21))* y(:,:,21) + prod(:,:,14) = 0._r8 + loss(:,:,15) = (rxt(:,:,515)* y(:,:,23) +rxt(:,:,498)* y(:,:,95) & + +rxt(:,:,516)* y(:,:,104) + rxt(:,:,43) + het_rates(:,:,22)) & + * y(:,:,22) + prod(:,:,15) = 0._r8 + loss(:,:,16) = ( + het_rates(:,:,28))* y(:,:,28) + prod(:,:,16) = 0._r8 + loss(:,:,17) = (rxt(:,:,363)* y(:,:,88) +rxt(:,:,307)* y(:,:,93) & + +rxt(:,:,311)* y(:,:,98) +rxt(:,:,325)* y(:,:,101) +rxt(:,:,330) & + * y(:,:,102) +rxt(:,:,338)* y(:,:,105) +rxt(:,:,347)* y(:,:,106) & + +rxt(:,:,573)* y(:,:,107) + rxt(:,:,26) + rxt(:,:,62) & + + het_rates(:,:,30))* y(:,:,30) + prod(:,:,17) =.440_r8*rxt(:,:,25)*y(:,:,21) + loss(:,:,18) = (rxt(:,:,499)* y(:,:,95) + rxt(:,:,51) + het_rates(:,:,36)) & + * y(:,:,36) + prod(:,:,18) = 0._r8 + loss(:,:,19) = (rxt(:,:,522)* y(:,:,95) +rxt(:,:,517)* y(:,:,104) & + + rxt(:,:,53) + het_rates(:,:,39))* y(:,:,39) + prod(:,:,19) = 0._r8 + loss(:,:,20) = (rxt(:,:,523)* y(:,:,95) +rxt(:,:,518)* y(:,:,104) & + + rxt(:,:,54) + het_rates(:,:,40))* y(:,:,40) + prod(:,:,20) = 0._r8 + loss(:,:,21) = (rxt(:,:,524)* y(:,:,95) +rxt(:,:,519)* y(:,:,104) & + + rxt(:,:,55) + het_rates(:,:,41))* y(:,:,41) + prod(:,:,21) = 0._r8 + loss(:,:,22) = ((rxt(:,:,437) +rxt(:,:,438))* y(:,:,95) + rxt(:,:,13) & + + het_rates(:,:,50))* y(:,:,50) + prod(:,:,22) = 0._r8 + loss(:,:,23) = ( + rxt(:,:,61) + het_rates(:,:,59))* y(:,:,59) + prod(:,:,23) = 0._r8 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 + subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) + use ppgrid, only : pver implicit none !-------------------------------------------------------------------- ! ... dummy args !-------------------------------------------------------------------- - integer, intent(in) :: avec_len - real(r8), dimension(veclen,clscnt4), intent(out) :: & + real(r8), dimension(:), 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 + real(r8), intent(in) :: y(:) + real(r8), intent(in) :: rxt(:) + real(r8), intent(in) :: het_rates(:) !-------------------------------------------------------------------- ! ... loss and production for Implicit method !-------------------------------------------------------------------- - do k = 1,avec_len - loss(k,6) = ( + rxt(k,27) + het_rates(k,1))* y(k,1) - prod(k,6) = (rxt(k,549)*y(k,45) +rxt(k,554)*y(k,45))*y(k,40) & - +rxt(k,487)*y(k,24)*y(k,2) - loss(k,52) = (2._r8*rxt(k,484)* y(k,2) + (rxt(k,485) +rxt(k,486) +rxt(k,487)) & - * y(k,24) +rxt(k,488)* y(k,43) +rxt(k,489)* y(k,51) +rxt(k,490) & - * y(k,52) +rxt(k,492)* y(k,54) +rxt(k,493)* y(k,104) + rxt(k,28) & - + het_rates(k,2))* y(k,2) - prod(k,52) = (rxt(k,29) +rxt(k,491)*y(k,54))*y(k,3) +rxt(k,501)*y(k,95) & - *y(k,36) +rxt(k,496)*y(k,54)*y(k,45) +rxt(k,483)*y(k,59)*y(k,56) - loss(k,17) = (rxt(k,491)* y(k,54) + rxt(k,29) + rxt(k,30) + rxt(k,543) & - + rxt(k,546) + rxt(k,551) + het_rates(k,3))* y(k,3) - prod(k,17) =rxt(k,490)*y(k,52)*y(k,2) - loss(k,56) = (rxt(k,525)* y(k,53) +rxt(k,526)* y(k,54) +rxt(k,481)* y(k,59) & - +rxt(k,445)* y(k,60) +rxt(k,527)* y(k,104) + rxt(k,21) + rxt(k,22) & - + het_rates(k,14))* y(k,14) - prod(k,56) = (rxt(k,452)*y(k,24) +rxt(k,529)*y(k,51))*y(k,18) + (rxt(k,23) + & - .300_r8*rxt(k,530)*y(k,104))*y(k,19) + (rxt(k,534)*y(k,95) + & - rxt(k,535)*y(k,95))*y(k,20) - loss(k,39) = (rxt(k,452)* y(k,24) +rxt(k,528)* y(k,43) +rxt(k,529)* y(k,51) & - + het_rates(k,18))* y(k,18) - prod(k,39) = (rxt(k,446)*y(k,60) +rxt(k,502)*y(k,31) +rxt(k,531)*y(k,104) + & - rxt(k,533)*y(k,95))*y(k,20) +.700_r8*rxt(k,530)*y(k,104)*y(k,19) - loss(k,12) = (rxt(k,530)* y(k,104) + rxt(k,23) + het_rates(k,19))* y(k,19) - prod(k,12) =rxt(k,528)*y(k,43)*y(k,18) - loss(k,4) = ( + rxt(k,44) + het_rates(k,22))* y(k,22) - prod(k,4) = (rxt(k,542)*y(k,46) +rxt(k,547)*y(k,25) +rxt(k,548)*y(k,46) + & - rxt(k,552)*y(k,25) +rxt(k,553)*y(k,46) +rxt(k,557)*y(k,25))*y(k,40) & - +rxt(k,454)*y(k,24)*y(k,24) +rxt(k,458)*y(k,60)*y(k,25) - loss(k,1) = ( + rxt(k,45) + rxt(k,480) + het_rates(k,23))* y(k,23) - prod(k,1) =rxt(k,479)*y(k,24)*y(k,24) - loss(k,81) = ((rxt(k,485) +rxt(k,486) +rxt(k,487))* y(k,2) +rxt(k,452) & - * y(k,18) + 2._r8*(rxt(k,453) +rxt(k,454) +rxt(k,455) +rxt(k,479)) & - * y(k,24) +rxt(k,456)* y(k,43) +rxt(k,457)* y(k,51) +rxt(k,459) & - * y(k,52) +rxt(k,462)* y(k,54) +rxt(k,111)* y(k,65) +rxt(k,123) & - * y(k,68) +rxt(k,281)* y(k,81) +rxt(k,310)* y(k,98) + (rxt(k,463) + & - rxt(k,464))* y(k,104) +rxt(k,337)* y(k,105) +rxt(k,346)* y(k,106) & - + rxt(k,46) + het_rates(k,24))* y(k,24) - prod(k,81) = (rxt(k,467)*y(k,60) +rxt(k,468)*y(k,54) +rxt(k,469)*y(k,104)) & - *y(k,46) + (rxt(k,48) +rxt(k,460)*y(k,54))*y(k,25) & - + (rxt(k,450)*y(k,43) +rxt(k,451)*y(k,56))*y(k,60) & - +2.000_r8*rxt(k,480)*y(k,23) +rxt(k,478)*y(k,95)*y(k,40) +rxt(k,60) & - *y(k,57) - loss(k,34) = ((rxt(k,547) +rxt(k,552) +rxt(k,557))* y(k,40) +rxt(k,460) & - * y(k,54) +rxt(k,458)* y(k,60) +rxt(k,461)* y(k,104) + rxt(k,47) & - + rxt(k,48) + rxt(k,545) + rxt(k,550) + rxt(k,556) & - + het_rates(k,25))* y(k,25) - prod(k,34) =rxt(k,459)*y(k,52)*y(k,24) - loss(k,25) = ((rxt(k,532) +rxt(k,536))* y(k,104) + het_rates(k,27))* y(k,27) - prod(k,25) = (rxt(k,21) +rxt(k,22) +rxt(k,445)*y(k,60) +rxt(k,481)*y(k,59) + & - rxt(k,525)*y(k,53) +rxt(k,526)*y(k,54) +rxt(k,527)*y(k,104))*y(k,14) & - + (rxt(k,26) +rxt(k,62) +rxt(k,573)*y(k,107))*y(k,28) & - +rxt(k,513)*y(k,60)*y(k,17) - loss(k,2) = (rxt(k,506)* y(k,95) + rxt(k,49) + het_rates(k,29))* y(k,29) - prod(k,2) = (rxt(k,471)*y(k,6) +rxt(k,473)*y(k,9) + & - 2.000_r8*rxt(k,474)*y(k,10) +2.000_r8*rxt(k,475)*y(k,11) + & - rxt(k,476)*y(k,12) +rxt(k,497)*y(k,7) +2.000_r8*rxt(k,499)*y(k,34) + & - rxt(k,523)*y(k,38) +rxt(k,524)*y(k,39))*y(k,95) & - + (rxt(k,518)*y(k,38) +rxt(k,519)*y(k,39))*y(k,104) - loss(k,5) = (rxt(k,507)* y(k,95) + rxt(k,50) + het_rates(k,30))* y(k,30) - prod(k,5) = (rxt(k,472)*y(k,8) +rxt(k,473)*y(k,9) +rxt(k,522)*y(k,37)) & - *y(k,95) +rxt(k,517)*y(k,104)*y(k,37) - loss(k,78) = (rxt(k,363)* y(k,88) +rxt(k,307)* y(k,93) +rxt(k,311)* y(k,98) & - +rxt(k,325)* y(k,101) +rxt(k,330)* y(k,102) +rxt(k,338)* y(k,105) & - +rxt(k,347)* y(k,106) +rxt(k,573)* y(k,107) + rxt(k,26) + rxt(k,62) & - + het_rates(k,28))* y(k,28) - prod(k,78) = (rxt(k,63) +rxt(k,109)*y(k,60) +rxt(k,110)*y(k,60) + & - rxt(k,111)*y(k,24) +rxt(k,112)*y(k,32) +rxt(k,119)*y(k,42) + & - rxt(k,120)*y(k,54) +rxt(k,121)*y(k,55) +rxt(k,163)*y(k,77) + & - rxt(k,165)*y(k,75) +rxt(k,181)*y(k,73) +rxt(k,199)*y(k,92) + & - rxt(k,216)*y(k,89) +rxt(k,234)*y(k,88) +rxt(k,251)*y(k,99) + & - rxt(k,253)*y(k,75) +rxt(k,260)*y(k,77) +rxt(k,275)*y(k,51) + & - rxt(k,276)*y(k,52))*y(k,65) + (rxt(k,115)*y(k,52) + & - rxt(k,116)*y(k,52) +rxt(k,117)*y(k,51) +rxt(k,118)*y(k,51) + & - rxt(k,150)*y(k,99) +rxt(k,153)*y(k,75) +rxt(k,173)*y(k,77) + & - rxt(k,191)*y(k,73) +rxt(k,208)*y(k,92) +rxt(k,226)*y(k,89) + & - rxt(k,244)*y(k,88) +rxt(k,255)*y(k,75) +rxt(k,256)*y(k,77))*y(k,67) & - + (rxt(k,65) +rxt(k,122)*y(k,60) +rxt(k,123)*y(k,24) + & - rxt(k,125)*y(k,40) +rxt(k,127)*y(k,56) +rxt(k,146)*y(k,99) + & - rxt(k,169)*y(k,77) +rxt(k,186)*y(k,73) +rxt(k,204)*y(k,92) + & - rxt(k,220)*y(k,75) +rxt(k,222)*y(k,89) +rxt(k,239)*y(k,88))*y(k,68) & - + (rxt(k,148)*y(k,99) +rxt(k,171)*y(k,77) +rxt(k,189)*y(k,73) + & - rxt(k,206)*y(k,92) +rxt(k,224)*y(k,89) +rxt(k,241)*y(k,88) + & - rxt(k,242)*y(k,75) +rxt(k,254)*y(k,77) +rxt(k,266)*y(k,75))*y(k,66) & - + (rxt(k,144)*y(k,99) +rxt(k,167)*y(k,77) +rxt(k,184)*y(k,73) + & - rxt(k,198)*y(k,75) +rxt(k,202)*y(k,92) +rxt(k,219)*y(k,89) + & - rxt(k,237)*y(k,88))*y(k,71) + (rxt(k,364) +rxt(k,301)*y(k,69) + & - rxt(k,302)*y(k,110))*y(k,91) + (rxt(k,532)*y(k,104) + & - rxt(k,536)*y(k,104))*y(k,27) - loss(k,30) = (rxt(k,502)* y(k,20) +rxt(k,503)* y(k,33) +rxt(k,505)* y(k,42) & - +rxt(k,504)* y(k,110) + het_rates(k,31))* y(k,31) - prod(k,30) = (rxt(k,475)*y(k,11) +rxt(k,497)*y(k,7) + & - 2.000_r8*rxt(k,506)*y(k,29) +rxt(k,507)*y(k,30))*y(k,95) & - +2.000_r8*rxt(k,49)*y(k,29) +rxt(k,50)*y(k,30) +rxt(k,57)*y(k,41) - loss(k,86) = ((rxt(k,403) +rxt(k,404) +rxt(k,405))* y(k,43) +rxt(k,406) & - * y(k,55) +rxt(k,409)* y(k,56) +rxt(k,100)* y(k,61) +rxt(k,112) & - * y(k,65) +rxt(k,124)* y(k,68) +rxt(k,282)* y(k,81) +rxt(k,304) & - * y(k,92) +rxt(k,312)* y(k,98) +rxt(k,326)* y(k,101) +rxt(k,339) & - * y(k,105) + het_rates(k,32))* y(k,32) - prod(k,86) = (rxt(k,136)*y(k,69) +rxt(k,142)*y(k,61) +rxt(k,153)*y(k,67) + & - rxt(k,157)*y(k,82) +rxt(k,158)*y(k,86) +rxt(k,159)*y(k,62) + & - rxt(k,160)*y(k,84) +rxt(k,161)*y(k,81) +rxt(k,165)*y(k,65) + & - rxt(k,176)*y(k,63) +rxt(k,198)*y(k,71) +rxt(k,209)*y(k,98) + & - rxt(k,220)*y(k,68) +rxt(k,231)*y(k,85) +rxt(k,242)*y(k,66) + & - rxt(k,253)*y(k,65) +rxt(k,255)*y(k,67) +rxt(k,257)*y(k,85) + & - rxt(k,266)*y(k,66))*y(k,75) + (rxt(k,139)*y(k,69) + & - rxt(k,163)*y(k,65) +rxt(k,164)*y(k,63) +rxt(k,167)*y(k,71) + & - rxt(k,168)*y(k,98) +rxt(k,169)*y(k,68) +rxt(k,170)*y(k,85) + & - rxt(k,171)*y(k,66) +rxt(k,172)*y(k,61) +rxt(k,173)*y(k,67) + & - rxt(k,174)*y(k,82) +rxt(k,175)*y(k,86) +rxt(k,177)*y(k,62) + & - rxt(k,178)*y(k,84) +rxt(k,179)*y(k,81) +rxt(k,254)*y(k,66) + & - rxt(k,256)*y(k,67) +rxt(k,258)*y(k,85) +rxt(k,260)*y(k,65))*y(k,77) & - + (rxt(k,181)*y(k,65) +rxt(k,182)*y(k,63) +rxt(k,184)*y(k,71) + & - rxt(k,185)*y(k,98) +rxt(k,186)*y(k,68) +rxt(k,188)*y(k,85) + & - rxt(k,189)*y(k,66) +rxt(k,190)*y(k,61) +rxt(k,191)*y(k,67) + & - rxt(k,192)*y(k,82) +rxt(k,193)*y(k,86) +rxt(k,194)*y(k,62) + & - rxt(k,195)*y(k,84) +rxt(k,196)*y(k,81) +rxt(k,378)*y(k,69))*y(k,73) & - + (rxt(k,349)*y(k,106) +rxt(k,384)*y(k,95) +rxt(k,401)*y(k,54) + & - rxt(k,410)*y(k,104) +rxt(k,447)*y(k,60) +rxt(k,503)*y(k,31))*y(k,33) & - + (rxt(k,413)*y(k,54) +rxt(k,433)*y(k,48) +rxt(k,527)*y(k,14) + & - rxt(k,536)*y(k,27))*y(k,104) + (rxt(k,133)*y(k,70) + & - rxt(k,376)*y(k,78) +rxt(k,377)*y(k,72))*y(k,69) & - + (rxt(k,534)*y(k,20) +rxt(k,478)*y(k,40) +rxt(k,501)*y(k,36)) & - *y(k,95) + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,110) +2.000_r8*rxt(k,21) & - *y(k,14) +rxt(k,23)*y(k,19) +rxt(k,52)*y(k,36) +rxt(k,56)*y(k,40) & - +rxt(k,57)*y(k,41) - loss(k,50) = (rxt(k,503)* y(k,31) +rxt(k,401)* y(k,54) +rxt(k,447)* y(k,60) & - +rxt(k,384)* y(k,95) +rxt(k,410)* y(k,104) + (rxt(k,348) + & - rxt(k,349))* y(k,106) + het_rates(k,33))* y(k,33) - prod(k,50) =rxt(k,22)*y(k,14) +rxt(k,535)*y(k,95)*y(k,20) +rxt(k,403)*y(k,43) & - *y(k,32) +rxt(k,1)*y(k,110) - loss(k,18) = (rxt(k,402)* y(k,54) +rxt(k,448)* y(k,60) +rxt(k,411)* y(k,104) & - + rxt(k,4) + het_rates(k,35))* y(k,35) - prod(k,18) = (.500_r8*rxt(k,537) +rxt(k,417)*y(k,43))*y(k,43) & - +rxt(k,416)*y(k,104)*y(k,104) - loss(k,33) = (rxt(k,494)* y(k,54) + (rxt(k,500) +rxt(k,501))* y(k,95) & - +rxt(k,495)* y(k,104) + rxt(k,52) + het_rates(k,36))* y(k,36) - prod(k,33) = (rxt(k,481)*y(k,14) +rxt(k,482)*y(k,43))*y(k,59) - loss(k,80) = ((rxt(k,547) +rxt(k,552) +rxt(k,557))* y(k,25) + (rxt(k,549) + & - rxt(k,554))* y(k,45) + (rxt(k,542) +rxt(k,548) +rxt(k,553))* y(k,46) & - +rxt(k,465)* y(k,54) +rxt(k,103)* y(k,61) +rxt(k,101)* y(k,62) & - +rxt(k,125)* y(k,68) +rxt(k,284)* y(k,81) + (rxt(k,271) +rxt(k,293)) & - * y(k,83) + (rxt(k,477) +rxt(k,478))* y(k,95) +rxt(k,313)* y(k,98) & - +rxt(k,466)* y(k,104) +rxt(k,340)* y(k,105) +rxt(k,351)* y(k,106) & - + rxt(k,56) + het_rates(k,40))* y(k,40) - prod(k,80) = (rxt(k,446)*y(k,20) +rxt(k,508)*y(k,13) +rxt(k,510)*y(k,15) + & - 2.000_r8*rxt(k,513)*y(k,17) +rxt(k,515)*y(k,21) +rxt(k,445)*y(k,14) + & - rxt(k,447)*y(k,33) +rxt(k,448)*y(k,35) +rxt(k,449)*y(k,43) + & - rxt(k,467)*y(k,46))*y(k,60) + (rxt(k,381) +rxt(k,164)*y(k,77) + & - rxt(k,176)*y(k,75) +rxt(k,182)*y(k,73) +rxt(k,200)*y(k,92) + & - rxt(k,217)*y(k,89) +rxt(k,235)*y(k,88) +rxt(k,252)*y(k,99) + & - 2.000_r8*rxt(k,262)*y(k,75) +2.000_r8*rxt(k,263)*y(k,77))*y(k,63) & - + (rxt(k,152)*y(k,99) +rxt(k,158)*y(k,75) +rxt(k,175)*y(k,77) + & - rxt(k,193)*y(k,73) +rxt(k,211)*y(k,92) +rxt(k,228)*y(k,89) + & - rxt(k,246)*y(k,88) +rxt(k,294)*y(k,42))*y(k,86) & - + (rxt(k,100)*y(k,32) +rxt(k,104)*y(k,42))*y(k,61) & - +rxt(k,464)*y(k,104)*y(k,24) - loss(k,7) = ( + rxt(k,57) + het_rates(k,41))* y(k,41) - prod(k,7) = (rxt(k,502)*y(k,20) +rxt(k,503)*y(k,33) +rxt(k,504)*y(k,110) + & - rxt(k,505)*y(k,42))*y(k,31) - loss(k,71) = (rxt(k,505)* y(k,31) +rxt(k,104)* y(k,61) +rxt(k,119)* y(k,65) & - +rxt(k,285)* y(k,81) +rxt(k,295)* y(k,83) +rxt(k,290)* y(k,85) & - +rxt(k,294)* y(k,86) +rxt(k,314)* y(k,98) +rxt(k,442)* y(k,104) & - +rxt(k,352)* y(k,106) + rxt(k,9) + het_rates(k,42))* y(k,42) - prod(k,71) = (rxt(k,270) +2.000_r8*rxt(k,141)*y(k,75) + & - 2.000_r8*rxt(k,162)*y(k,77) +2.000_r8*rxt(k,180)*y(k,73) + & - rxt(k,197)*y(k,92) +rxt(k,215)*y(k,89) +rxt(k,233)*y(k,88) + & - rxt(k,250)*y(k,99) +2.000_r8*rxt(k,264)*y(k,75) + & - 2.000_r8*rxt(k,265)*y(k,77))*y(k,87) + (2.000_r8*rxt(k,538) + & - 2.000_r8*rxt(k,541) +2.000_r8*rxt(k,544) +2.000_r8*rxt(k,555) + & - rxt(k,137)*y(k,75) +rxt(k,140)*y(k,77) +rxt(k,288)*y(k,84) + & - rxt(k,292)*y(k,85))*y(k,50) + (rxt(k,545) +rxt(k,550) +rxt(k,556) + & - rxt(k,547)*y(k,40) +rxt(k,552)*y(k,40) +rxt(k,557)*y(k,40))*y(k,25) & - + (rxt(k,166)*y(k,77) +rxt(k,183)*y(k,73) +rxt(k,187)*y(k,75) + & - rxt(k,259)*y(k,75) +rxt(k,261)*y(k,77) +rxt(k,293)*y(k,40))*y(k,83) & - + (rxt(k,543) +rxt(k,546) +rxt(k,551))*y(k,3) & - + (.500_r8*rxt(k,539) +rxt(k,441)*y(k,104))*y(k,52) + (rxt(k,540) + & - rxt(k,525)*y(k,14))*y(k,53) + (rxt(k,135)*y(k,74) + & - rxt(k,138)*y(k,76))*y(k,110) - loss(k,61) = (rxt(k,488)* y(k,2) +rxt(k,528)* y(k,18) +rxt(k,456)* y(k,24) & - + (rxt(k,403) +rxt(k,404) +rxt(k,405))* y(k,32) + 2._r8*rxt(k,417) & - * y(k,43) +rxt(k,434)* y(k,51) +rxt(k,439)* y(k,52) +rxt(k,429) & - * y(k,53) +rxt(k,407)* y(k,54) +rxt(k,408)* y(k,56) +rxt(k,482) & - * y(k,59) + (rxt(k,449) +rxt(k,450))* y(k,60) +rxt(k,305)* y(k,92) & - +rxt(k,412)* y(k,104) + rxt(k,537) + het_rates(k,43))* y(k,43) - prod(k,61) = (rxt(k,511)*y(k,15) +rxt(k,514)*y(k,17) +rxt(k,411)*y(k,35) + & - rxt(k,414)*y(k,56) +rxt(k,432)*y(k,53) +rxt(k,463)*y(k,24) + & - rxt(k,493)*y(k,2) +rxt(k,532)*y(k,27))*y(k,104) & - + (rxt(k,445)*y(k,60) +rxt(k,481)*y(k,59) +rxt(k,525)*y(k,53) + & - rxt(k,526)*y(k,54))*y(k,14) + (rxt(k,510)*y(k,15) + & - rxt(k,513)*y(k,17) +rxt(k,448)*y(k,35))*y(k,60) & - + (rxt(k,312)*y(k,32) +rxt(k,313)*y(k,40) +rxt(k,314)*y(k,42)) & - *y(k,98) + (rxt(k,452)*y(k,24) +rxt(k,529)*y(k,51))*y(k,18) & - + (rxt(k,11) +rxt(k,443))*y(k,44) + (rxt(k,342)*y(k,105) + & - rxt(k,402)*y(k,35))*y(k,54) +rxt(k,534)*y(k,95)*y(k,20) & - +rxt(k,406)*y(k,55)*y(k,32) +rxt(k,125)*y(k,68)*y(k,40) - loss(k,14) = (rxt(k,418)* y(k,104) + rxt(k,10) + rxt(k,11) + rxt(k,443) & - + het_rates(k,44))* y(k,44) - prod(k,14) =rxt(k,439)*y(k,52)*y(k,43) - loss(k,28) = ((rxt(k,549) +rxt(k,554))* y(k,40) +rxt(k,496)* y(k,54) & - + rxt(k,58) + het_rates(k,45))* y(k,45) - prod(k,28) = (rxt(k,543) +rxt(k,546) +rxt(k,551))*y(k,3) +rxt(k,488)*y(k,43) & - *y(k,2) - loss(k,32) = ((rxt(k,542) +rxt(k,548) +rxt(k,553))* y(k,40) +rxt(k,468) & - * y(k,54) +rxt(k,467)* y(k,60) +rxt(k,469)* y(k,104) + rxt(k,59) & - + het_rates(k,46))* y(k,46) - prod(k,32) = (rxt(k,545) +rxt(k,550) +rxt(k,556) +rxt(k,461)*y(k,104)) & - *y(k,25) +rxt(k,456)*y(k,43)*y(k,24) - loss(k,24) = (rxt(k,335)* y(k,104) + rxt(k,12) + het_rates(k,47))* y(k,47) - prod(k,24) = (rxt(k,284)*y(k,40) +rxt(k,285)*y(k,42))*y(k,81) & - +rxt(k,344)*y(k,104)*y(k,51) +rxt(k,300)*y(k,110)*y(k,90) - loss(k,40) = (rxt(k,421)* y(k,51) + (rxt(k,422) +rxt(k,423) +rxt(k,424)) & - * y(k,52) +rxt(k,425)* y(k,55) +rxt(k,570)* y(k,99) +rxt(k,433) & - * y(k,104) + rxt(k,66) + het_rates(k,48))* y(k,48) - prod(k,40) = (rxt(k,419)*y(k,79) +rxt(k,567)*y(k,94))*y(k,54) & - + (.200_r8*rxt(k,561)*y(k,88) +1.100_r8*rxt(k,563)*y(k,80))*y(k,69) & - +rxt(k,17)*y(k,51) +rxt(k,568)*y(k,94)*y(k,55) +rxt(k,574)*y(k,107) - loss(k,37) = (rxt(k,137)* y(k,75) +rxt(k,140)* y(k,77) +rxt(k,288)* y(k,84) & - +rxt(k,292)* y(k,85) + rxt(k,14) + rxt(k,15) + rxt(k,444) & - + rxt(k,538) + rxt(k,541) + rxt(k,544) + rxt(k,555) & - + het_rates(k,50))* y(k,50) - prod(k,37) =rxt(k,440)*y(k,53)*y(k,52) - loss(k,87) = (rxt(k,489)* y(k,2) +rxt(k,529)* y(k,18) +rxt(k,457)* y(k,24) & - +rxt(k,434)* y(k,43) +rxt(k,421)* y(k,48) +rxt(k,430)* y(k,53) & - +rxt(k,436)* y(k,54) +rxt(k,435)* y(k,56) + (rxt(k,106) +rxt(k,107)) & - * y(k,64) +rxt(k,275)* y(k,65) + (rxt(k,117) +rxt(k,118))* y(k,67) & - +rxt(k,572)* y(k,99) + (rxt(k,267) +rxt(k,274))* y(k,101) & - +rxt(k,344)* y(k,104) +rxt(k,131)* y(k,106) + rxt(k,16) + rxt(k,17) & - + het_rates(k,51))* y(k,51) - prod(k,87) = (rxt(k,197)*y(k,87) +rxt(k,199)*y(k,65) +rxt(k,200)*y(k,63) + & - rxt(k,201)*y(k,83) +rxt(k,202)*y(k,71) +rxt(k,203)*y(k,98) + & - rxt(k,204)*y(k,68) +rxt(k,205)*y(k,85) +rxt(k,206)*y(k,66) + & - rxt(k,207)*y(k,61) +rxt(k,208)*y(k,67) +rxt(k,210)*y(k,82) + & - rxt(k,211)*y(k,86) +rxt(k,212)*y(k,62) +rxt(k,213)*y(k,84) + & - rxt(k,214)*y(k,81) +rxt(k,303)*y(k,69) +rxt(k,304)*y(k,32))*y(k,92) & - + (rxt(k,215)*y(k,87) +rxt(k,216)*y(k,65) +rxt(k,217)*y(k,63) + & - rxt(k,218)*y(k,83) +rxt(k,219)*y(k,71) +rxt(k,221)*y(k,98) + & - rxt(k,222)*y(k,68) +rxt(k,223)*y(k,85) +rxt(k,224)*y(k,66) + & - rxt(k,225)*y(k,61) +rxt(k,226)*y(k,67) +rxt(k,227)*y(k,82) + & - rxt(k,228)*y(k,86) +rxt(k,229)*y(k,62) +rxt(k,230)*y(k,84) + & - rxt(k,232)*y(k,81) +rxt(k,298)*y(k,69))*y(k,89) & - + (rxt(k,233)*y(k,87) +rxt(k,234)*y(k,65) +rxt(k,235)*y(k,63) + & - rxt(k,236)*y(k,83) +rxt(k,237)*y(k,71) +rxt(k,238)*y(k,98) + & - rxt(k,239)*y(k,68) +rxt(k,240)*y(k,85) +rxt(k,241)*y(k,66) + & - rxt(k,243)*y(k,61) +rxt(k,244)*y(k,67) +rxt(k,245)*y(k,82) + & - rxt(k,246)*y(k,86) +rxt(k,247)*y(k,62) +rxt(k,248)*y(k,84) + & - rxt(k,249)*y(k,81))*y(k,88) + (rxt(k,18) +.500_r8*rxt(k,539) + & - rxt(k,286)*y(k,81) +2.000_r8*rxt(k,423)*y(k,48) +rxt(k,426)*y(k,54)) & - *y(k,52) + (rxt(k,299)*y(k,90) +rxt(k,301)*y(k,91) + & - rxt(k,379)*y(k,93))*y(k,69) + (rxt(k,425)*y(k,55) + & - rxt(k,433)*y(k,104))*y(k,48) +rxt(k,282)*y(k,81)*y(k,32) +rxt(k,12) & - *y(k,47) +2.000_r8*rxt(k,437)*y(k,95)*y(k,49) +rxt(k,15)*y(k,50) & - +rxt(k,20)*y(k,53) +rxt(k,420)*y(k,79)*y(k,55) +rxt(k,571)*y(k,99) & - +rxt(k,584)*y(k,109) - loss(k,72) = (rxt(k,490)* y(k,2) +rxt(k,459)* y(k,24) +rxt(k,439)* y(k,43) & - + (rxt(k,422) +rxt(k,423) +rxt(k,424))* y(k,48) +rxt(k,440)* y(k,53) & - + (rxt(k,426) +rxt(k,428))* y(k,54) +rxt(k,427)* y(k,56) +rxt(k,105) & - * y(k,61) +rxt(k,276)* y(k,65) + (rxt(k,115) +rxt(k,116))* y(k,67) & - +rxt(k,286)* y(k,81) +rxt(k,315)* y(k,98) + (rxt(k,272) +rxt(k,273)) & - * y(k,101) +rxt(k,441)* y(k,104) +rxt(k,341)* y(k,105) +rxt(k,354) & - * y(k,106) + rxt(k,18) + rxt(k,539) + het_rates(k,52))* y(k,52) - prod(k,72) = (rxt(k,107)*y(k,64) +rxt(k,131)*y(k,106) + & - 2.000_r8*rxt(k,430)*y(k,53) +rxt(k,434)*y(k,43) +rxt(k,435)*y(k,56) + & - rxt(k,436)*y(k,54) +rxt(k,457)*y(k,24) +rxt(k,489)*y(k,2) + & - rxt(k,529)*y(k,18))*y(k,51) + (rxt(k,75) +rxt(k,156)*y(k,99) + & - rxt(k,161)*y(k,75) +rxt(k,179)*y(k,77) +rxt(k,196)*y(k,73) + & - rxt(k,214)*y(k,92) +rxt(k,232)*y(k,89) +rxt(k,249)*y(k,88) + & - rxt(k,280)*y(k,60))*y(k,81) + (rxt(k,151)*y(k,99) + & - rxt(k,157)*y(k,75) +rxt(k,174)*y(k,77) +rxt(k,192)*y(k,73) + & - rxt(k,210)*y(k,92) +rxt(k,227)*y(k,89) +rxt(k,245)*y(k,88))*y(k,82) & - + (rxt(k,19) +rxt(k,429)*y(k,43) +rxt(k,431)*y(k,54) + & - rxt(k,432)*y(k,104))*y(k,53) + (rxt(k,11) +rxt(k,443) + & - rxt(k,418)*y(k,104))*y(k,44) + (rxt(k,14) +rxt(k,444))*y(k,50) & - + (rxt(k,306)*y(k,92) +rxt(k,335)*y(k,47))*y(k,104) +rxt(k,29) & - *y(k,3) +rxt(k,48)*y(k,25) +rxt(k,9)*y(k,42) - loss(k,74) = (rxt(k,525)* y(k,14) +rxt(k,429)* y(k,43) +rxt(k,430)* y(k,51) & - +rxt(k,440)* y(k,52) +rxt(k,431)* y(k,54) +rxt(k,432)* y(k,104) & - + rxt(k,19) + rxt(k,20) + rxt(k,540) + het_rates(k,53))* y(k,53) - prod(k,74) = (rxt(k,147)*y(k,99) +rxt(k,170)*y(k,77) +rxt(k,188)*y(k,73) + & - rxt(k,205)*y(k,92) +rxt(k,223)*y(k,89) +rxt(k,231)*y(k,75) + & - rxt(k,240)*y(k,88) +rxt(k,257)*y(k,75) +rxt(k,258)*y(k,77))*y(k,85) & - + (rxt(k,155)*y(k,99) +rxt(k,160)*y(k,75) +rxt(k,178)*y(k,77) + & - rxt(k,195)*y(k,73) +rxt(k,213)*y(k,92) +rxt(k,230)*y(k,89) + & - rxt(k,248)*y(k,88))*y(k,84) + (rxt(k,152)*y(k,99) + & - rxt(k,158)*y(k,75) +rxt(k,175)*y(k,77) +rxt(k,193)*y(k,73) + & - rxt(k,211)*y(k,92) +rxt(k,228)*y(k,89) +rxt(k,246)*y(k,88))*y(k,86) & - + (rxt(k,76) +rxt(k,143)*y(k,99) +rxt(k,201)*y(k,92) + & - rxt(k,218)*y(k,89) +rxt(k,236)*y(k,88))*y(k,83) + (rxt(k,47) + & - rxt(k,458)*y(k,60) +rxt(k,460)*y(k,54) +rxt(k,461)*y(k,104))*y(k,25) & - + (rxt(k,197)*y(k,92) +rxt(k,215)*y(k,89) +rxt(k,233)*y(k,88) + & - rxt(k,250)*y(k,99))*y(k,87) + (rxt(k,14) +rxt(k,15) +rxt(k,444)) & - *y(k,50) + (rxt(k,30) +rxt(k,491)*y(k,54))*y(k,3) & - + (rxt(k,442)*y(k,104) +rxt(k,505)*y(k,31))*y(k,42) & - + (rxt(k,427)*y(k,56) +rxt(k,428)*y(k,54))*y(k,52) & - +rxt(k,281)*y(k,81)*y(k,24) +rxt(k,305)*y(k,92)*y(k,43) +rxt(k,10) & - *y(k,44) - loss(k,68) = (rxt(k,492)* y(k,2) +rxt(k,491)* y(k,3) +rxt(k,526)* y(k,14) & - +rxt(k,462)* y(k,24) +rxt(k,460)* y(k,25) +rxt(k,401)* y(k,33) & - +rxt(k,402)* y(k,35) +rxt(k,494)* y(k,36) +rxt(k,465)* y(k,40) & - +rxt(k,407)* y(k,43) +rxt(k,496)* y(k,45) +rxt(k,468)* y(k,46) & - +rxt(k,436)* y(k,51) + (rxt(k,426) +rxt(k,428))* y(k,52) +rxt(k,431) & - * y(k,53) + 2._r8*rxt(k,399)* y(k,54) +rxt(k,400)* y(k,55) & - +rxt(k,398)* y(k,56) +rxt(k,108)* y(k,64) +rxt(k,120)* y(k,65) & - +rxt(k,126)* y(k,68) + (rxt(k,565) +rxt(k,566))* y(k,80) +rxt(k,296) & - * y(k,83) +rxt(k,567)* y(k,94) + (rxt(k,319) +rxt(k,320))* y(k,98) & - + (rxt(k,328) +rxt(k,329))* y(k,101) +rxt(k,331)* y(k,102) & - +rxt(k,333)* y(k,103) +rxt(k,413)* y(k,104) +rxt(k,342)* y(k,105) & - +rxt(k,355)* y(k,106) + rxt(k,77) + rxt(k,78) + rxt(k,79) & - + rxt(k,80) + rxt(k,81) + rxt(k,82) + het_rates(k,54))* y(k,54) - prod(k,68) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,83) +2.000_r8*rxt(k,84) + & - rxt(k,85) +rxt(k,87) +2.000_r8*rxt(k,89) +rxt(k,90) +rxt(k,91) + & - rxt(k,92) +rxt(k,387)*y(k,95) +rxt(k,388)*y(k,95) + & - rxt(k,425)*y(k,48) +rxt(k,569)*y(k,94) +rxt(k,576)*y(k,107) + & - rxt(k,580)*y(k,108))*y(k,55) + (rxt(k,109)*y(k,60) + & - rxt(k,163)*y(k,77) +rxt(k,165)*y(k,75) +rxt(k,181)*y(k,73) + & - rxt(k,199)*y(k,92) +rxt(k,216)*y(k,89) +rxt(k,234)*y(k,88) + & - rxt(k,251)*y(k,99) +rxt(k,253)*y(k,75) +rxt(k,260)*y(k,77))*y(k,65) & - + (rxt(k,148)*y(k,99) +rxt(k,171)*y(k,77) +rxt(k,189)*y(k,73) + & - rxt(k,206)*y(k,92) +rxt(k,224)*y(k,89) +rxt(k,241)*y(k,88) + & - rxt(k,242)*y(k,75) +rxt(k,254)*y(k,77) +rxt(k,266)*y(k,75))*y(k,66) & - + (rxt(k,150)*y(k,99) +rxt(k,153)*y(k,75) +rxt(k,173)*y(k,77) + & - rxt(k,191)*y(k,73) +rxt(k,208)*y(k,92) +rxt(k,226)*y(k,89) + & - rxt(k,244)*y(k,88) +rxt(k,255)*y(k,75) +rxt(k,256)*y(k,77))*y(k,67) & - + (rxt(k,99) +rxt(k,353) +rxt(k,345)*y(k,60) +rxt(k,354)*y(k,52) + & - rxt(k,358)*y(k,56))*y(k,106) + (rxt(k,421)*y(k,51) + & - rxt(k,422)*y(k,52) +rxt(k,570)*y(k,99))*y(k,48) + (rxt(k,26) + & - rxt(k,62))*y(k,28) + (rxt(k,17) +rxt(k,267)*y(k,101))*y(k,51) & - + (rxt(k,561)*y(k,88) +1.150_r8*rxt(k,562)*y(k,99))*y(k,69) & - +rxt(k,28)*y(k,2) +rxt(k,46)*y(k,24) +rxt(k,405)*y(k,43)*y(k,32) & - +rxt(k,15)*y(k,50) +rxt(k,18)*y(k,52) +rxt(k,19)*y(k,53) +rxt(k,8) & - *y(k,56) +rxt(k,60)*y(k,57) +rxt(k,575)*y(k,107)*y(k,79) +rxt(k,386) & - *y(k,95) +rxt(k,415)*y(k,104)*y(k,104) +rxt(k,578)*y(k,108) & - +rxt(k,583)*y(k,109) +rxt(k,2)*y(k,110) - loss(k,75) = (rxt(k,406)* y(k,32) +rxt(k,425)* y(k,48) +rxt(k,400)* y(k,54) & - +rxt(k,121)* y(k,65) + (rxt(k,128) +rxt(k,130))* y(k,69) +rxt(k,420) & - * y(k,79) +rxt(k,564)* y(k,80) + (rxt(k,568) +rxt(k,569))* y(k,94) & - +rxt(k,387)* y(k,95) +rxt(k,392)* y(k,96) +rxt(k,317)* y(k,98) & - +rxt(k,359)* y(k,99) +rxt(k,357)* y(k,106) +rxt(k,576)* y(k,107) & - +rxt(k,580)* y(k,108) + rxt(k,5) + rxt(k,6) + rxt(k,83) + rxt(k,84) & - + rxt(k,85) + rxt(k,86) + rxt(k,87) + rxt(k,88) + rxt(k,89) & - + rxt(k,90) + rxt(k,91) + rxt(k,92) + het_rates(k,55))* y(k,55) - prod(k,75) = (rxt(k,108)*y(k,64) +rxt(k,126)*y(k,68) +rxt(k,296)*y(k,83) + & - rxt(k,320)*y(k,98) +2.000_r8*rxt(k,328)*y(k,101) + & - rxt(k,329)*y(k,101) +rxt(k,331)*y(k,102) +rxt(k,355)*y(k,106) + & - rxt(k,391)*y(k,96) +2.000_r8*rxt(k,398)*y(k,56) +rxt(k,399)*y(k,54) + & - rxt(k,407)*y(k,43) +rxt(k,413)*y(k,104) +rxt(k,426)*y(k,52) + & - rxt(k,431)*y(k,53) +rxt(k,462)*y(k,24) +rxt(k,492)*y(k,2))*y(k,54) & - + (rxt(k,143)*y(k,83) +rxt(k,144)*y(k,71) + & - 2.000_r8*rxt(k,146)*y(k,68) +rxt(k,147)*y(k,85) +rxt(k,148)*y(k,66) + & - rxt(k,149)*y(k,61) +rxt(k,150)*y(k,67) +rxt(k,151)*y(k,82) + & - rxt(k,152)*y(k,86) +rxt(k,154)*y(k,62) +rxt(k,155)*y(k,84) + & - rxt(k,156)*y(k,81) +rxt(k,250)*y(k,87) +rxt(k,251)*y(k,65) + & - rxt(k,252)*y(k,63) +rxt(k,572)*y(k,51))*y(k,99) + (rxt(k,8) + & - rxt(k,127)*y(k,68) +rxt(k,129)*y(k,69) +rxt(k,287)*y(k,81) + & - 2.000_r8*rxt(k,297)*y(k,83) +rxt(k,318)*y(k,98) + & - 3.000_r8*rxt(k,327)*y(k,101) +2.000_r8*rxt(k,389)*y(k,95) + & - 2.000_r8*rxt(k,408)*y(k,43) +rxt(k,409)*y(k,32) + & - rxt(k,414)*y(k,104) +rxt(k,427)*y(k,52) +rxt(k,435)*y(k,51) + & - rxt(k,451)*y(k,60) +rxt(k,483)*y(k,59))*y(k,56) + (rxt(k,93) + & - rxt(k,132) +rxt(k,168)*y(k,77) +rxt(k,185)*y(k,73) + & - rxt(k,203)*y(k,92) +rxt(k,209)*y(k,75) +rxt(k,221)*y(k,89) + & - rxt(k,238)*y(k,88) +rxt(k,309)*y(k,60) +rxt(k,310)*y(k,24) + & - rxt(k,315)*y(k,52) +2.000_r8*rxt(k,316)*y(k,96))*y(k,98) & - + (rxt(k,111)*y(k,65) +rxt(k,123)*y(k,68) +rxt(k,346)*y(k,106) + & - rxt(k,453)*y(k,24) +rxt(k,454)*y(k,24) +rxt(k,456)*y(k,43) + & - rxt(k,464)*y(k,104) +rxt(k,486)*y(k,2) +rxt(k,487)*y(k,2))*y(k,24) & - + (rxt(k,403)*y(k,32) +rxt(k,412)*y(k,104) +rxt(k,417)*y(k,43) + & - rxt(k,429)*y(k,53) +rxt(k,449)*y(k,60) +rxt(k,482)*y(k,59) + & - rxt(k,488)*y(k,2) +rxt(k,528)*y(k,18))*y(k,43) & - + (rxt(k,122)*y(k,60) +rxt(k,169)*y(k,77) +rxt(k,186)*y(k,73) + & - rxt(k,204)*y(k,92) +rxt(k,220)*y(k,75) +rxt(k,222)*y(k,89) + & - rxt(k,239)*y(k,88))*y(k,68) + (rxt(k,95) +rxt(k,272)*y(k,52) + & - rxt(k,274)*y(k,51) +rxt(k,325)*y(k,28) +rxt(k,326)*y(k,32))*y(k,101) & - + (rxt(k,382) +rxt(k,390) +2.000_r8*rxt(k,334)*y(k,103) + & - 2.000_r8*rxt(k,392)*y(k,55))*y(k,96) + (rxt(k,321)*y(k,69) + & - rxt(k,322)*y(k,110) +rxt(k,323)*y(k,110))*y(k,100) + (rxt(k,97) + & - rxt(k,330)*y(k,28))*y(k,102) + (rxt(k,332)*y(k,110) + & - 2.000_r8*rxt(k,375)*y(k,69))*y(k,103) +rxt(k,484)*y(k,2)*y(k,2) & - +rxt(k,418)*y(k,104)*y(k,44) +rxt(k,424)*y(k,52)*y(k,48) & - +rxt(k,438)*y(k,95)*y(k,49) +rxt(k,20)*y(k,53) +rxt(k,383)*y(k,97) - loss(k,79) = (rxt(k,409)* y(k,32) +rxt(k,408)* y(k,43) +rxt(k,435)* y(k,51) & - +rxt(k,427)* y(k,52) +rxt(k,398)* y(k,54) +rxt(k,483)* y(k,59) & - +rxt(k,451)* y(k,60) +rxt(k,127)* y(k,68) +rxt(k,129)* y(k,69) & - +rxt(k,287)* y(k,81) +rxt(k,297)* y(k,83) +rxt(k,389)* y(k,95) & - +rxt(k,318)* y(k,98) +rxt(k,327)* y(k,101) +rxt(k,414)* y(k,104) & - +rxt(k,343)* y(k,105) +rxt(k,358)* y(k,106) + rxt(k,7) + rxt(k,8) & - + het_rates(k,56))* y(k,56) - prod(k,79) = (rxt(k,319)*y(k,98) +rxt(k,333)*y(k,103) +rxt(k,400)*y(k,55)) & - *y(k,54) + (rxt(k,96) +rxt(k,273)*y(k,52))*y(k,101) & - +rxt(k,356)*y(k,106)*y(k,96) - loss(k,3) = ( + rxt(k,60) + het_rates(k,57))* y(k,57) - prod(k,3) = (rxt(k,455)*y(k,24) +rxt(k,485)*y(k,2))*y(k,24) - loss(k,44) = (rxt(k,481)* y(k,14) +rxt(k,482)* y(k,43) +rxt(k,483)* y(k,56) & - + het_rates(k,59))* y(k,59) - prod(k,44) = (rxt(k,28) +2.000_r8*rxt(k,484)*y(k,2) +rxt(k,485)*y(k,24) + & - rxt(k,486)*y(k,24) +rxt(k,489)*y(k,51) +rxt(k,492)*y(k,54) + & - rxt(k,493)*y(k,104))*y(k,2) + (rxt(k,471)*y(k,6) +rxt(k,497)*y(k,7) + & - 3.000_r8*rxt(k,498)*y(k,21) +2.000_r8*rxt(k,499)*y(k,34) + & - 2.000_r8*rxt(k,520)*y(k,13) +rxt(k,521)*y(k,15) +rxt(k,500)*y(k,36)) & - *y(k,95) + (2.000_r8*rxt(k,509)*y(k,13) +rxt(k,511)*y(k,15) + & - 3.000_r8*rxt(k,516)*y(k,21) +rxt(k,495)*y(k,36))*y(k,104) & - + (2.000_r8*rxt(k,508)*y(k,13) +rxt(k,510)*y(k,15) + & - 3.000_r8*rxt(k,515)*y(k,21))*y(k,60) + (rxt(k,52) + & - rxt(k,494)*y(k,54))*y(k,36) +rxt(k,27)*y(k,1) +rxt(k,30)*y(k,3) & - +rxt(k,58)*y(k,45) - loss(k,85) = (rxt(k,508)* y(k,13) +rxt(k,445)* y(k,14) +rxt(k,510)* y(k,15) & - +rxt(k,513)* y(k,17) +rxt(k,446)* y(k,20) +rxt(k,515)* y(k,21) & - +rxt(k,458)* y(k,25) +rxt(k,447)* y(k,33) +rxt(k,448)* y(k,35) & - + (rxt(k,449) +rxt(k,450))* y(k,43) +rxt(k,467)* y(k,46) +rxt(k,451) & - * y(k,56) + (rxt(k,109) +rxt(k,110))* y(k,65) +rxt(k,122)* y(k,68) & - +rxt(k,280)* y(k,81) +rxt(k,309)* y(k,98) +rxt(k,336)* y(k,105) & - +rxt(k,345)* y(k,106) + het_rates(k,60))* y(k,60) - prod(k,85) = (4.000_r8*rxt(k,470)*y(k,5) +rxt(k,471)*y(k,6) + & - 2.000_r8*rxt(k,472)*y(k,8) +2.000_r8*rxt(k,473)*y(k,9) + & - 2.000_r8*rxt(k,474)*y(k,10) +rxt(k,475)*y(k,11) + & - 2.000_r8*rxt(k,476)*y(k,12) +rxt(k,522)*y(k,37) +rxt(k,523)*y(k,38) + & - rxt(k,524)*y(k,39) +rxt(k,477)*y(k,40) +rxt(k,507)*y(k,30))*y(k,95) & - + (rxt(k,46) +rxt(k,452)*y(k,18) +2.000_r8*rxt(k,453)*y(k,24) + & - rxt(k,455)*y(k,24) +rxt(k,457)*y(k,51) +rxt(k,462)*y(k,54) + & - rxt(k,463)*y(k,104) +rxt(k,486)*y(k,2))*y(k,24) & - + (rxt(k,105)*y(k,52) +rxt(k,142)*y(k,75) +rxt(k,149)*y(k,99) + & - rxt(k,172)*y(k,77) +rxt(k,190)*y(k,73) +rxt(k,207)*y(k,92) + & - rxt(k,225)*y(k,89) +rxt(k,243)*y(k,88))*y(k,61) & - + (rxt(k,154)*y(k,99) +rxt(k,159)*y(k,75) +rxt(k,177)*y(k,77) + & - rxt(k,194)*y(k,73) +rxt(k,212)*y(k,92) +rxt(k,229)*y(k,89) + & - rxt(k,247)*y(k,88))*y(k,62) + (rxt(k,164)*y(k,77) + & - rxt(k,176)*y(k,75) +rxt(k,182)*y(k,73) +rxt(k,200)*y(k,92) + & - rxt(k,217)*y(k,89) +rxt(k,235)*y(k,88) +rxt(k,252)*y(k,99))*y(k,63) & - + (3.000_r8*rxt(k,512)*y(k,16) +rxt(k,514)*y(k,17) + & - rxt(k,517)*y(k,37) +rxt(k,518)*y(k,38) +rxt(k,519)*y(k,39) + & - rxt(k,466)*y(k,40))*y(k,104) + (rxt(k,56) +rxt(k,465)*y(k,54)) & - *y(k,40) +rxt(k,27)*y(k,1) +2.000_r8*rxt(k,44)*y(k,22) & - +2.000_r8*rxt(k,45)*y(k,23) +rxt(k,47)*y(k,25) +rxt(k,50)*y(k,30) & - +rxt(k,59)*y(k,46) +rxt(k,106)*y(k,64)*y(k,51) - loss(k,58) = (rxt(k,100)* y(k,32) +rxt(k,103)* y(k,40) +rxt(k,104)* y(k,42) & - +rxt(k,105)* y(k,52) +rxt(k,190)* y(k,73) +rxt(k,142)* y(k,75) & - +rxt(k,172)* y(k,77) +rxt(k,243)* y(k,88) +rxt(k,225)* y(k,89) & - +rxt(k,207)* y(k,92) +rxt(k,149)* y(k,99) +rxt(k,102)* y(k,110) & - + het_rates(k,61))* y(k,61) - prod(k,58) = (rxt(k,125)*y(k,68) +rxt(k,284)*y(k,81) +rxt(k,293)*y(k,83) + & - rxt(k,313)*y(k,98) +rxt(k,340)*y(k,105) +rxt(k,351)*y(k,106))*y(k,40) & - + (rxt(k,109)*y(k,65) +rxt(k,122)*y(k,68) +rxt(k,280)*y(k,81) + & - rxt(k,309)*y(k,98) +rxt(k,336)*y(k,105) +rxt(k,345)*y(k,106))*y(k,60) & - + (rxt(k,111)*y(k,65) +rxt(k,281)*y(k,81) +rxt(k,346)*y(k,106)) & - *y(k,24) + (rxt(k,107)*y(k,51) +rxt(k,108)*y(k,54))*y(k,64) & - +rxt(k,380)*y(k,62) +rxt(k,381)*y(k,63) - loss(k,46) = (rxt(k,101)* y(k,40) +rxt(k,194)* y(k,73) +rxt(k,159)* y(k,75) & - +rxt(k,177)* y(k,77) +rxt(k,247)* y(k,88) +rxt(k,229)* y(k,89) & - +rxt(k,212)* y(k,92) +rxt(k,154)* y(k,99) + rxt(k,380) & - + het_rates(k,62))* y(k,62) - prod(k,46) =rxt(k,102)*y(k,110)*y(k,61) - loss(k,45) = (rxt(k,182)* y(k,73) + (rxt(k,176) +rxt(k,262))* y(k,75) & - + (rxt(k,164) +rxt(k,263))* y(k,77) +rxt(k,235)* y(k,88) +rxt(k,217) & - * y(k,89) +rxt(k,200)* y(k,92) +rxt(k,252)* y(k,99) + rxt(k,381) & - + het_rates(k,63))* y(k,63) - prod(k,45) = (rxt(k,101)*y(k,62) +rxt(k,103)*y(k,61))*y(k,40) - loss(k,35) = ((rxt(k,106) +rxt(k,107))* y(k,51) +rxt(k,108)* y(k,54) & - + het_rates(k,64))* y(k,64) - prod(k,35) = (rxt(k,123)*y(k,68) +rxt(k,310)*y(k,98) +rxt(k,337)*y(k,105)) & - *y(k,24) +rxt(k,110)*y(k,65)*y(k,60) - loss(k,64) = (rxt(k,111)* y(k,24) +rxt(k,112)* y(k,32) +rxt(k,119)* y(k,42) & - +rxt(k,275)* y(k,51) +rxt(k,276)* y(k,52) +rxt(k,120)* y(k,54) & - +rxt(k,121)* y(k,55) + (rxt(k,109) +rxt(k,110))* y(k,60) +rxt(k,181) & - * y(k,73) + (rxt(k,165) +rxt(k,253))* y(k,75) + (rxt(k,163) + & - rxt(k,260))* y(k,77) +rxt(k,234)* y(k,88) +rxt(k,216)* y(k,89) & - +rxt(k,199)* y(k,92) +rxt(k,251)* y(k,99) +rxt(k,114)* y(k,110) & - + rxt(k,63) + het_rates(k,65))* y(k,65) - prod(k,64) = (rxt(k,325)*y(k,101) +rxt(k,347)*y(k,106))*y(k,28) & - + (rxt(k,64) +rxt(k,278))*y(k,67) + (rxt(k,124)*y(k,32) + & - rxt(k,126)*y(k,54))*y(k,68) - loss(k,43) = (rxt(k,189)* y(k,73) + (rxt(k,242) +rxt(k,266))* y(k,75) & - + (rxt(k,171) +rxt(k,254))* y(k,77) +rxt(k,241)* y(k,88) +rxt(k,224) & - * y(k,89) +rxt(k,206)* y(k,92) +rxt(k,148)* y(k,99) + rxt(k,279) & - + het_rates(k,66))* y(k,66) - prod(k,43) =rxt(k,113)*y(k,110)*y(k,67) - loss(k,54) = ((rxt(k,117) +rxt(k,118))* y(k,51) + (rxt(k,115) +rxt(k,116)) & - * y(k,52) +rxt(k,191)* y(k,73) + (rxt(k,153) +rxt(k,255))* y(k,75) & - + (rxt(k,173) +rxt(k,256))* y(k,77) +rxt(k,244)* y(k,88) +rxt(k,226) & - * y(k,89) +rxt(k,208)* y(k,92) +rxt(k,150)* y(k,99) +rxt(k,113) & - * y(k,110) + rxt(k,64) + rxt(k,278) + het_rates(k,67))* y(k,67) - prod(k,54) =rxt(k,114)*y(k,110)*y(k,65) +rxt(k,279)*y(k,66) - loss(k,59) = (rxt(k,123)* y(k,24) +rxt(k,124)* y(k,32) +rxt(k,125)* y(k,40) & - +rxt(k,126)* y(k,54) +rxt(k,127)* y(k,56) +rxt(k,122)* y(k,60) & - +rxt(k,186)* y(k,73) +rxt(k,220)* y(k,75) +rxt(k,169)* y(k,77) & - +rxt(k,239)* y(k,88) +rxt(k,222)* y(k,89) +rxt(k,204)* y(k,92) & - +rxt(k,146)* y(k,99) + rxt(k,65) + het_rates(k,68))* y(k,68) - prod(k,59) = (rxt(k,311)*y(k,98) +rxt(k,330)*y(k,102))*y(k,28) - loss(k,69) = ((rxt(k,128) +rxt(k,130))* y(k,55) +rxt(k,129)* y(k,56) & - +rxt(k,133)* y(k,70) +rxt(k,377)* y(k,72) +rxt(k,378)* y(k,73) & - +rxt(k,136)* y(k,75) +rxt(k,139)* y(k,77) +rxt(k,376)* y(k,78) & - +rxt(k,563)* y(k,80) +rxt(k,561)* y(k,88) +rxt(k,298)* y(k,89) & - +rxt(k,299)* y(k,90) +rxt(k,301)* y(k,91) +rxt(k,303)* y(k,92) & - +rxt(k,379)* y(k,93) +rxt(k,562)* y(k,99) +rxt(k,321)* y(k,100) & - +rxt(k,375)* y(k,103) + het_rates(k,69))* y(k,69) - prod(k,69) = (rxt(k,77) +rxt(k,78) +rxt(k,79) +rxt(k,80) +rxt(k,81) + & - rxt(k,82) +rxt(k,319)*y(k,98) +rxt(k,328)*y(k,101) + & - rxt(k,342)*y(k,105) +rxt(k,355)*y(k,106))*y(k,54) + (rxt(k,83) + & - rxt(k,85) +rxt(k,86) +rxt(k,87) +rxt(k,88) +rxt(k,90) +rxt(k,91) + & - rxt(k,92))*y(k,55) + (rxt(k,99) +rxt(k,353) +rxt(k,131)*y(k,51) + & - rxt(k,348)*y(k,33) +rxt(k,356)*y(k,96))*y(k,106) + (rxt(k,93) + & - rxt(k,132) +rxt(k,312)*y(k,32) +rxt(k,316)*y(k,96))*y(k,98) & - + (rxt(k,100)*y(k,61) +rxt(k,339)*y(k,105))*y(k,32) + (rxt(k,96) + & - rxt(k,327)*y(k,56))*y(k,101) +rxt(k,66)*y(k,48) +rxt(k,16)*y(k,51) & - +rxt(k,75)*y(k,81) +rxt(k,76)*y(k,83) +rxt(k,98)*y(k,105) - loss(k,11) = (rxt(k,133)* y(k,69) +rxt(k,134)* y(k,110) + het_rates(k,70)) & - * y(k,70) - prod(k,11) =rxt(k,322)*y(k,110)*y(k,100) - loss(k,42) = (rxt(k,184)* y(k,73) +rxt(k,198)* y(k,75) +rxt(k,167)* y(k,77) & - +rxt(k,237)* y(k,88) +rxt(k,219)* y(k,89) +rxt(k,202)* y(k,92) & - +rxt(k,144)* y(k,99) + het_rates(k,71))* y(k,71) - prod(k,42) =rxt(k,338)*y(k,105)*y(k,28) - loss(k,21) = (rxt(k,377)* y(k,69) +rxt(k,369)* y(k,110) + rxt(k,368) & - + het_rates(k,72))* y(k,72) - prod(k,21) = (rxt(k,134)*y(k,70) +rxt(k,367)*y(k,78))*y(k,110) +rxt(k,370) & - *y(k,73) - loss(k,65) = (rxt(k,190)* y(k,61) +rxt(k,194)* y(k,62) +rxt(k,182)* y(k,63) & - +rxt(k,181)* y(k,65) +rxt(k,189)* y(k,66) +rxt(k,191)* y(k,67) & - +rxt(k,186)* y(k,68) +rxt(k,378)* y(k,69) +rxt(k,184)* y(k,71) & - +rxt(k,196)* y(k,81) +rxt(k,192)* y(k,82) +rxt(k,183)* y(k,83) & - +rxt(k,195)* y(k,84) +rxt(k,188)* y(k,85) +rxt(k,193)* y(k,86) & - +rxt(k,180)* y(k,87) +rxt(k,185)* y(k,98) +rxt(k,371)* y(k,110) & - + rxt(k,370) + het_rates(k,73))* y(k,73) - prod(k,65) = (rxt(k,300)*y(k,90) +rxt(k,369)*y(k,72))*y(k,110) +rxt(k,372) & - *y(k,75) - loss(k,8) = (rxt(k,135)* y(k,110) + het_rates(k,74))* y(k,74) - prod(k,8) =rxt(k,137)*y(k,75)*y(k,50) - loss(k,73) = (rxt(k,137)* y(k,50) +rxt(k,142)* y(k,61) +rxt(k,159)* y(k,62) & - + (rxt(k,176) +rxt(k,262))* y(k,63) + (rxt(k,165) +rxt(k,253)) & - * y(k,65) + (rxt(k,242) +rxt(k,266))* y(k,66) + (rxt(k,153) + & - rxt(k,255))* y(k,67) +rxt(k,220)* y(k,68) +rxt(k,136)* y(k,69) & - +rxt(k,198)* y(k,71) +rxt(k,161)* y(k,81) +rxt(k,157)* y(k,82) & - + (rxt(k,187) +rxt(k,259))* y(k,83) +rxt(k,160)* y(k,84) & - + (rxt(k,231) +rxt(k,257))* y(k,85) +rxt(k,158)* y(k,86) & - + (rxt(k,141) +rxt(k,264))* y(k,87) +rxt(k,209)* y(k,98) +rxt(k,373) & - * y(k,110) + rxt(k,372) + het_rates(k,75))* y(k,75) - prod(k,73) = (rxt(k,135)*y(k,74) +rxt(k,371)*y(k,73))*y(k,110) +rxt(k,374) & - *y(k,77) - loss(k,9) = (rxt(k,138)* y(k,110) + het_rates(k,76))* y(k,76) - prod(k,9) =rxt(k,140)*y(k,77)*y(k,50) - loss(k,82) = (rxt(k,140)* y(k,50) +rxt(k,172)* y(k,61) +rxt(k,177)* y(k,62) & - + (rxt(k,164) +rxt(k,263))* y(k,63) + (rxt(k,163) +rxt(k,260)) & - * y(k,65) + (rxt(k,171) +rxt(k,254))* y(k,66) + (rxt(k,173) + & - rxt(k,256))* y(k,67) +rxt(k,169)* y(k,68) +rxt(k,139)* y(k,69) & - +rxt(k,167)* y(k,71) +rxt(k,179)* y(k,81) +rxt(k,174)* y(k,82) & - + (rxt(k,166) +rxt(k,261))* y(k,83) +rxt(k,178)* y(k,84) & - + (rxt(k,170) +rxt(k,258))* y(k,85) +rxt(k,175)* y(k,86) & - + (rxt(k,162) +rxt(k,265))* y(k,87) +rxt(k,168)* y(k,98) & - + rxt(k,374) + het_rates(k,77))* y(k,77) - prod(k,82) = (rxt(k,138)*y(k,76) +rxt(k,373)*y(k,75))*y(k,110) - loss(k,26) = (rxt(k,376)* y(k,69) +rxt(k,367)* y(k,110) + het_rates(k,78)) & - * y(k,78) - prod(k,26) = (rxt(k,304)*y(k,32) +rxt(k,305)*y(k,43) +rxt(k,306)*y(k,104)) & - *y(k,92) +rxt(k,368)*y(k,72) +rxt(k,323)*y(k,110)*y(k,100) - loss(k,29) = (rxt(k,419)* y(k,54) +rxt(k,420)* y(k,55) +rxt(k,575)* y(k,107) & - + het_rates(k,79))* y(k,79) - prod(k,29) = (.800_r8*rxt(k,561)*y(k,88) +.900_r8*rxt(k,563)*y(k,80))*y(k,69) & - +rxt(k,565)*y(k,80)*y(k,54) - loss(k,19) = ((rxt(k,565) +rxt(k,566))* y(k,54) +rxt(k,564)* y(k,55) & - +rxt(k,563)* y(k,69) + het_rates(k,80))* y(k,80) - prod(k,19) =rxt(k,578)*y(k,108) +rxt(k,583)*y(k,109) - loss(k,62) = (rxt(k,281)* y(k,24) +rxt(k,282)* y(k,32) +rxt(k,284)* y(k,40) & - +rxt(k,285)* y(k,42) +rxt(k,286)* y(k,52) +rxt(k,287)* y(k,56) & - +rxt(k,280)* y(k,60) +rxt(k,196)* y(k,73) +rxt(k,161)* y(k,75) & - +rxt(k,179)* y(k,77) +rxt(k,249)* y(k,88) +rxt(k,232)* y(k,89) & - +rxt(k,214)* y(k,92) +rxt(k,156)* y(k,99) +rxt(k,283)* y(k,110) & - + rxt(k,75) + het_rates(k,81))* y(k,81) - prod(k,62) = (rxt(k,105)*y(k,61) +rxt(k,273)*y(k,101) +rxt(k,315)*y(k,98) + & - rxt(k,341)*y(k,105) +rxt(k,354)*y(k,106))*y(k,52) & - + (rxt(k,106)*y(k,64) +rxt(k,118)*y(k,67) +rxt(k,274)*y(k,101) + & - rxt(k,275)*y(k,65))*y(k,51) + (rxt(k,296)*y(k,54) + & - rxt(k,297)*y(k,56))*y(k,83) +rxt(k,268)*y(k,82) - loss(k,47) = (rxt(k,192)* y(k,73) +rxt(k,157)* y(k,75) +rxt(k,174)* y(k,77) & - +rxt(k,245)* y(k,88) +rxt(k,227)* y(k,89) +rxt(k,210)* y(k,92) & - +rxt(k,151)* y(k,99) + rxt(k,268) + het_rates(k,82))* y(k,82) - prod(k,47) =rxt(k,117)*y(k,67)*y(k,51) +rxt(k,283)*y(k,110)*y(k,81) - loss(k,60) = ((rxt(k,271) +rxt(k,293))* y(k,40) +rxt(k,295)* y(k,42) & - +rxt(k,296)* y(k,54) +rxt(k,297)* y(k,56) +rxt(k,183)* y(k,73) & - + (rxt(k,187) +rxt(k,259))* y(k,75) + (rxt(k,166) +rxt(k,261)) & - * y(k,77) +rxt(k,236)* y(k,88) +rxt(k,218)* y(k,89) +rxt(k,201) & - * y(k,92) +rxt(k,143)* y(k,99) +rxt(k,291)* y(k,110) + rxt(k,76) & - + het_rates(k,83))* y(k,83) - prod(k,60) = (rxt(k,104)*y(k,61) +rxt(k,119)*y(k,65) +rxt(k,285)*y(k,81) + & - rxt(k,314)*y(k,98) +rxt(k,352)*y(k,106))*y(k,42) & - + (rxt(k,115)*y(k,67) +rxt(k,272)*y(k,101) +rxt(k,276)*y(k,65) + & - rxt(k,286)*y(k,81))*y(k,52) +rxt(k,267)*y(k,101)*y(k,51) & - +rxt(k,287)*y(k,81)*y(k,56) +rxt(k,277)*y(k,85) +rxt(k,270)*y(k,87) - loss(k,53) = (rxt(k,288)* y(k,50) +rxt(k,195)* y(k,73) +rxt(k,160)* y(k,75) & - +rxt(k,178)* y(k,77) +rxt(k,248)* y(k,88) +rxt(k,230)* y(k,89) & - +rxt(k,213)* y(k,92) +rxt(k,155)* y(k,99) + rxt(k,269) & - + het_rates(k,84))* y(k,84) - prod(k,53) =rxt(k,289)*y(k,110)*y(k,85) - loss(k,55) = (rxt(k,290)* y(k,42) +rxt(k,292)* y(k,50) +rxt(k,188)* y(k,73) & - + (rxt(k,231) +rxt(k,257))* y(k,75) + (rxt(k,170) +rxt(k,258)) & - * y(k,77) +rxt(k,240)* y(k,88) +rxt(k,223)* y(k,89) +rxt(k,205) & - * y(k,92) +rxt(k,147)* y(k,99) +rxt(k,289)* y(k,110) + rxt(k,277) & - + het_rates(k,85))* y(k,85) - prod(k,55) =rxt(k,116)*y(k,67)*y(k,52) +rxt(k,291)*y(k,110)*y(k,83) & - +rxt(k,269)*y(k,84) - loss(k,48) = (rxt(k,294)* y(k,42) +rxt(k,193)* y(k,73) +rxt(k,158)* y(k,75) & - +rxt(k,175)* y(k,77) +rxt(k,246)* y(k,88) +rxt(k,228)* y(k,89) & - +rxt(k,211)* y(k,92) +rxt(k,152)* y(k,99) + het_rates(k,86)) & - * y(k,86) - prod(k,48) =rxt(k,271)*y(k,83)*y(k,40) - loss(k,51) = (rxt(k,180)* y(k,73) + (rxt(k,141) +rxt(k,264))* y(k,75) & - + (rxt(k,162) +rxt(k,265))* y(k,77) +rxt(k,233)* y(k,88) +rxt(k,215) & - * y(k,89) +rxt(k,197)* y(k,92) +rxt(k,250)* y(k,99) + rxt(k,270) & - + het_rates(k,87))* y(k,87) - prod(k,51) = (rxt(k,290)*y(k,85) +rxt(k,294)*y(k,86) +rxt(k,295)*y(k,83)) & - *y(k,42) + (rxt(k,288)*y(k,84) +rxt(k,292)*y(k,85))*y(k,50) - loss(k,66) = (rxt(k,363)* y(k,28) +rxt(k,243)* y(k,61) +rxt(k,247)* y(k,62) & - +rxt(k,235)* y(k,63) +rxt(k,234)* y(k,65) +rxt(k,241)* y(k,66) & - +rxt(k,244)* y(k,67) +rxt(k,239)* y(k,68) +rxt(k,561)* y(k,69) & - +rxt(k,237)* y(k,71) +rxt(k,249)* y(k,81) +rxt(k,245)* y(k,82) & - +rxt(k,236)* y(k,83) +rxt(k,248)* y(k,84) +rxt(k,240)* y(k,85) & - +rxt(k,246)* y(k,86) +rxt(k,233)* y(k,87) +rxt(k,238)* y(k,98) & - +rxt(k,360)* y(k,110) + rxt(k,365) + het_rates(k,88))* y(k,88) - prod(k,66) = (rxt(k,571) +rxt(k,570)*y(k,48) +rxt(k,572)*y(k,51))*y(k,99) & - +rxt(k,16)*y(k,51) +rxt(k,565)*y(k,80)*y(k,54) +rxt(k,569)*y(k,94) & - *y(k,55) +rxt(k,364)*y(k,91) +rxt(k,366)*y(k,93) +rxt(k,574)*y(k,107) - loss(k,67) = (rxt(k,225)* y(k,61) +rxt(k,229)* y(k,62) +rxt(k,217)* y(k,63) & - +rxt(k,216)* y(k,65) +rxt(k,224)* y(k,66) +rxt(k,226)* y(k,67) & - +rxt(k,222)* y(k,68) +rxt(k,298)* y(k,69) +rxt(k,219)* y(k,71) & - +rxt(k,232)* y(k,81) +rxt(k,227)* y(k,82) +rxt(k,218)* y(k,83) & - +rxt(k,230)* y(k,84) +rxt(k,223)* y(k,85) +rxt(k,228)* y(k,86) & - +rxt(k,215)* y(k,87) +rxt(k,221)* y(k,98) +rxt(k,362)* y(k,110) & - + het_rates(k,89))* y(k,89) - prod(k,67) =rxt(k,361)*y(k,110)*y(k,92) - loss(k,13) = (rxt(k,299)* y(k,69) +rxt(k,300)* y(k,110) + het_rates(k,90)) & - * y(k,90) - prod(k,13) =rxt(k,362)*y(k,110)*y(k,89) - loss(k,23) = (rxt(k,301)* y(k,69) +rxt(k,302)* y(k,110) + rxt(k,364) & - + het_rates(k,91))* y(k,91) - prod(k,23) = (rxt(k,307)*y(k,93) +rxt(k,363)*y(k,88))*y(k,28) - loss(k,70) = (rxt(k,304)* y(k,32) +rxt(k,305)* y(k,43) +rxt(k,207)* y(k,61) & - +rxt(k,212)* y(k,62) +rxt(k,200)* y(k,63) +rxt(k,199)* y(k,65) & - +rxt(k,206)* y(k,66) +rxt(k,208)* y(k,67) +rxt(k,204)* y(k,68) & - +rxt(k,303)* y(k,69) +rxt(k,202)* y(k,71) +rxt(k,214)* y(k,81) & - +rxt(k,210)* y(k,82) +rxt(k,201)* y(k,83) +rxt(k,213)* y(k,84) & - +rxt(k,205)* y(k,85) +rxt(k,211)* y(k,86) +rxt(k,197)* y(k,87) & - +rxt(k,203)* y(k,98) +rxt(k,306)* y(k,104) +rxt(k,361)* y(k,110) & - + het_rates(k,92))* y(k,92) - prod(k,70) = (rxt(k,302)*y(k,91) +rxt(k,308)*y(k,93) +rxt(k,360)*y(k,88)) & - *y(k,110) - loss(k,22) = (rxt(k,307)* y(k,28) +rxt(k,379)* y(k,69) +rxt(k,308)* y(k,110) & - + rxt(k,366) + het_rates(k,93))* y(k,93) - prod(k,22) =rxt(k,365)*y(k,88) - loss(k,31) = (rxt(k,567)* y(k,54) + (rxt(k,568) +rxt(k,569))* y(k,55) & - + het_rates(k,94))* y(k,94) - prod(k,31) =rxt(k,66)*y(k,48) +rxt(k,575)*y(k,107)*y(k,79) +rxt(k,584) & - *y(k,109) - loss(k,57) = (rxt(k,470)* y(k,5) +rxt(k,471)* y(k,6) +rxt(k,497)* y(k,7) & - +rxt(k,472)* y(k,8) +rxt(k,473)* y(k,9) +rxt(k,474)* y(k,10) & - +rxt(k,475)* y(k,11) +rxt(k,476)* y(k,12) +rxt(k,520)* y(k,13) & - +rxt(k,521)* y(k,15) + (rxt(k,533) +rxt(k,534) +rxt(k,535))* y(k,20) & - +rxt(k,498)* y(k,21) +rxt(k,506)* y(k,29) +rxt(k,507)* y(k,30) & - +rxt(k,384)* y(k,33) +rxt(k,499)* y(k,34) + (rxt(k,500) +rxt(k,501)) & - * y(k,36) +rxt(k,522)* y(k,37) +rxt(k,523)* y(k,38) +rxt(k,524) & - * y(k,39) + (rxt(k,477) +rxt(k,478))* y(k,40) + (rxt(k,437) + & - rxt(k,438))* y(k,49) + (rxt(k,387) +rxt(k,388))* y(k,55) +rxt(k,389) & - * y(k,56) +rxt(k,385)* y(k,110) + rxt(k,386) + het_rates(k,95)) & - * y(k,95) - prod(k,57) = (rxt(k,6) +rxt(k,420)*y(k,79))*y(k,55) +rxt(k,7)*y(k,56) & - +.850_r8*rxt(k,562)*y(k,99)*y(k,69) +rxt(k,1)*y(k,110) - loss(k,36) = (rxt(k,391)* y(k,54) +rxt(k,392)* y(k,55) +rxt(k,316)* y(k,98) & - +rxt(k,334)* y(k,103) +rxt(k,356)* y(k,106) + rxt(k,382) & - + rxt(k,390) + het_rates(k,96))* y(k,96) - prod(k,36) = (rxt(k,394) +rxt(k,393)*y(k,28) +rxt(k,395)*y(k,54) + & - rxt(k,396)*y(k,55) +rxt(k,397)*y(k,56))*y(k,97) +rxt(k,7)*y(k,56) - loss(k,10) = (rxt(k,393)* y(k,28) +rxt(k,395)* y(k,54) +rxt(k,396)* y(k,55) & - +rxt(k,397)* y(k,56) + rxt(k,383) + rxt(k,394) + het_rates(k,97)) & - * y(k,97) - prod(k,10) =rxt(k,387)*y(k,95)*y(k,55) - loss(k,76) = (rxt(k,310)* y(k,24) +rxt(k,311)* y(k,28) +rxt(k,312)* y(k,32) & - +rxt(k,313)* y(k,40) +rxt(k,314)* y(k,42) +rxt(k,315)* y(k,52) & - + (rxt(k,319) +rxt(k,320))* y(k,54) +rxt(k,317)* y(k,55) +rxt(k,318) & - * y(k,56) +rxt(k,309)* y(k,60) +rxt(k,185)* y(k,73) +rxt(k,209) & - * y(k,75) +rxt(k,168)* y(k,77) +rxt(k,238)* y(k,88) +rxt(k,221) & - * y(k,89) +rxt(k,203)* y(k,92) +rxt(k,316)* y(k,96) +rxt(k,145) & - * y(k,99) + rxt(k,93) + rxt(k,132) + het_rates(k,98))* y(k,98) - prod(k,76) = (rxt(k,120)*y(k,65) +rxt(k,329)*y(k,101))*y(k,54) & - + (rxt(k,128)*y(k,69) +rxt(k,130)*y(k,69))*y(k,55) +rxt(k,65) & - *y(k,68) +rxt(k,97)*y(k,102) - loss(k,77) = (rxt(k,570)* y(k,48) +rxt(k,572)* y(k,51) +rxt(k,359)* y(k,55) & - +rxt(k,149)* y(k,61) +rxt(k,154)* y(k,62) +rxt(k,252)* y(k,63) & - +rxt(k,251)* y(k,65) +rxt(k,148)* y(k,66) +rxt(k,150)* y(k,67) & - +rxt(k,146)* y(k,68) +rxt(k,562)* y(k,69) +rxt(k,144)* y(k,71) & - +rxt(k,156)* y(k,81) +rxt(k,151)* y(k,82) +rxt(k,143)* y(k,83) & - +rxt(k,155)* y(k,84) +rxt(k,147)* y(k,85) +rxt(k,152)* y(k,86) & - +rxt(k,250)* y(k,87) +rxt(k,145)* y(k,98) +rxt(k,324)* y(k,110) & - + rxt(k,571) + het_rates(k,99))* y(k,99) - prod(k,77) = (rxt(k,86) +rxt(k,88) +rxt(k,564)*y(k,80) +rxt(k,568)*y(k,94) + & - rxt(k,576)*y(k,107) +rxt(k,580)*y(k,108))*y(k,55) & - + (rxt(k,333)*y(k,54) +rxt(k,334)*y(k,96))*y(k,103) & - +rxt(k,573)*y(k,107)*y(k,28) +2.000_r8*rxt(k,145)*y(k,99)*y(k,98) & - +rxt(k,94)*y(k,100) - loss(k,27) = (rxt(k,321)* y(k,69) + (rxt(k,322) +rxt(k,323))* y(k,110) & - + rxt(k,94) + het_rates(k,100))* y(k,100) - prod(k,27) = (rxt(k,324)*y(k,99) +rxt(k,332)*y(k,103))*y(k,110) - loss(k,49) = (rxt(k,325)* y(k,28) +rxt(k,326)* y(k,32) + (rxt(k,267) + & - rxt(k,274))* y(k,51) + (rxt(k,272) +rxt(k,273))* y(k,52) & - + (rxt(k,328) +rxt(k,329))* y(k,54) +rxt(k,327)* y(k,56) + rxt(k,95) & - + rxt(k,96) + het_rates(k,101))* y(k,101) - prod(k,49) = (rxt(k,127)*y(k,68) +rxt(k,318)*y(k,98) +rxt(k,343)*y(k,105) + & - rxt(k,358)*y(k,106))*y(k,56) + (rxt(k,121)*y(k,65) + & - rxt(k,357)*y(k,106))*y(k,55) +rxt(k,331)*y(k,102)*y(k,54) - loss(k,20) = (rxt(k,330)* y(k,28) +rxt(k,331)* y(k,54) + rxt(k,97) & - + het_rates(k,102))* y(k,102) - prod(k,20) =rxt(k,317)*y(k,98)*y(k,55) - loss(k,41) = (rxt(k,333)* y(k,54) +rxt(k,375)* y(k,69) +rxt(k,334)* y(k,96) & - +rxt(k,332)* y(k,110) + het_rates(k,103))* y(k,103) - prod(k,41) =rxt(k,359)*y(k,99)*y(k,55) - loss(k,63) = (rxt(k,493)* y(k,2) +rxt(k,509)* y(k,13) +rxt(k,527)* y(k,14) & - +rxt(k,511)* y(k,15) +rxt(k,512)* y(k,16) +rxt(k,514)* y(k,17) & - +rxt(k,530)* y(k,19) +rxt(k,531)* y(k,20) +rxt(k,516)* y(k,21) & - + (rxt(k,463) +rxt(k,464))* y(k,24) +rxt(k,461)* y(k,25) & - + (rxt(k,532) +rxt(k,536))* y(k,27) +rxt(k,410)* y(k,33) +rxt(k,411) & - * y(k,35) +rxt(k,495)* y(k,36) +rxt(k,517)* y(k,37) +rxt(k,518) & - * y(k,38) +rxt(k,519)* y(k,39) +rxt(k,466)* y(k,40) +rxt(k,442) & - * y(k,42) +rxt(k,412)* y(k,43) +rxt(k,418)* y(k,44) +rxt(k,469) & - * y(k,46) +rxt(k,335)* y(k,47) +rxt(k,433)* y(k,48) +rxt(k,344) & - * y(k,51) +rxt(k,441)* y(k,52) +rxt(k,432)* y(k,53) +rxt(k,413) & - * y(k,54) +rxt(k,414)* y(k,56) +rxt(k,306)* y(k,92) & - + 2._r8*(rxt(k,415) +rxt(k,416))* y(k,104) + het_rates(k,104)) & - * y(k,104) - prod(k,63) = (rxt(k,401)*y(k,33) +rxt(k,402)*y(k,35) +rxt(k,407)*y(k,43) + & - rxt(k,465)*y(k,40) +rxt(k,468)*y(k,46) +rxt(k,494)*y(k,36) + & - rxt(k,496)*y(k,45) +rxt(k,526)*y(k,14))*y(k,54) & - + (rxt(k,144)*y(k,99) +rxt(k,167)*y(k,77) +rxt(k,184)*y(k,73) + & - rxt(k,198)*y(k,75) +rxt(k,202)*y(k,92) +rxt(k,219)*y(k,89) + & - rxt(k,237)*y(k,88))*y(k,71) + (rxt(k,3) +rxt(k,134)*y(k,70) + & - rxt(k,323)*y(k,100) +rxt(k,350)*y(k,106) + & - 2.000_r8*rxt(k,385)*y(k,95) +rxt(k,504)*y(k,31))*y(k,110) & - + (2.000_r8*rxt(k,404)*y(k,32) +rxt(k,408)*y(k,56) + & - rxt(k,429)*y(k,53) +rxt(k,434)*y(k,51) +rxt(k,450)*y(k,60))*y(k,43) & - + (rxt(k,98) +rxt(k,336)*y(k,60) +rxt(k,337)*y(k,24) + & - rxt(k,341)*y(k,52) +rxt(k,343)*y(k,56))*y(k,105) & - + (rxt(k,533)*y(k,20) +rxt(k,384)*y(k,33) +rxt(k,477)*y(k,40) + & - rxt(k,500)*y(k,36))*y(k,95) + (rxt(k,9) +rxt(k,119)*y(k,65) + & - rxt(k,352)*y(k,106))*y(k,42) + (rxt(k,23) + & - .300_r8*rxt(k,530)*y(k,104))*y(k,19) + (rxt(k,124)*y(k,68) + & - rxt(k,409)*y(k,56))*y(k,32) +2.000_r8*rxt(k,4)*y(k,35) & - +rxt(k,351)*y(k,106)*y(k,40) +rxt(k,10)*y(k,44) +rxt(k,58)*y(k,45) & - +rxt(k,59)*y(k,46) +rxt(k,12)*y(k,47) +.500_r8*rxt(k,539)*y(k,52) & - +rxt(k,133)*y(k,70)*y(k,69) - loss(k,83) = (rxt(k,337)* y(k,24) +rxt(k,338)* y(k,28) +rxt(k,339)* y(k,32) & - +rxt(k,340)* y(k,40) +rxt(k,341)* y(k,52) +rxt(k,342)* y(k,54) & - +rxt(k,343)* y(k,56) +rxt(k,336)* y(k,60) + rxt(k,98) & - + het_rates(k,105))* y(k,105) - prod(k,83) = (rxt(k,112)*y(k,65) +rxt(k,282)*y(k,81) +rxt(k,326)*y(k,101)) & - *y(k,32) + (rxt(k,349)*y(k,33) +rxt(k,350)*y(k,110))*y(k,106) - loss(k,84) = (rxt(k,346)* y(k,24) +rxt(k,347)* y(k,28) + (rxt(k,348) + & - rxt(k,349))* y(k,33) +rxt(k,351)* y(k,40) +rxt(k,352)* y(k,42) & - +rxt(k,131)* y(k,51) +rxt(k,354)* y(k,52) +rxt(k,355)* y(k,54) & - +rxt(k,357)* y(k,55) +rxt(k,358)* y(k,56) +rxt(k,345)* y(k,60) & - +rxt(k,356)* y(k,96) +rxt(k,350)* y(k,110) + rxt(k,99) + rxt(k,353) & - + het_rates(k,106))* y(k,106) - prod(k,84) =rxt(k,320)*y(k,98)*y(k,54) +rxt(k,129)*y(k,69)*y(k,56) +rxt(k,63) & - *y(k,65) +rxt(k,95)*y(k,101) - loss(k,38) = (rxt(k,573)* y(k,28) +rxt(k,576)* y(k,55) +rxt(k,575)* y(k,79) & - + rxt(k,574) + het_rates(k,107))* y(k,107) - prod(k,38) = (rxt(k,78) +rxt(k,79) +rxt(k,566)*y(k,80) +rxt(k,567)*y(k,94) + & - rxt(k,579)*y(k,108) +rxt(k,585)*y(k,109))*y(k,54) + (rxt(k,85) + & - rxt(k,87))*y(k,55) + (rxt(k,577)*y(k,108) +rxt(k,582)*y(k,109)) & - *y(k,69) +rxt(k,559)*y(k,108) +rxt(k,558)*y(k,109) - loss(k,16) = (rxt(k,579)* y(k,54) +rxt(k,580)* y(k,55) +rxt(k,577)* y(k,69) & - + rxt(k,559) + rxt(k,578) + het_rates(k,108))* y(k,108) - prod(k,16) = (rxt(k,80) +rxt(k,81))*y(k,54) + (rxt(k,90) +rxt(k,91))*y(k,55) & - + (rxt(k,560) +rxt(k,581)*y(k,69))*y(k,109) - loss(k,15) = (rxt(k,585)* y(k,54) + (rxt(k,581) +rxt(k,582))* y(k,69) & - + rxt(k,558) + rxt(k,560) + rxt(k,583) + rxt(k,584) & - + het_rates(k,109))* y(k,109) - prod(k,15) = (rxt(k,77) +rxt(k,82))*y(k,54) + (rxt(k,83) +rxt(k,92))*y(k,55) - loss(k,88) = (rxt(k,504)* y(k,31) +rxt(k,102)* y(k,61) +rxt(k,114)* y(k,65) & - +rxt(k,113)* y(k,67) +rxt(k,134)* y(k,70) +rxt(k,369)* y(k,72) & - +rxt(k,371)* y(k,73) +rxt(k,135)* y(k,74) +rxt(k,373)* y(k,75) & - +rxt(k,138)* y(k,76) +rxt(k,367)* y(k,78) +rxt(k,283)* y(k,81) & - +rxt(k,291)* y(k,83) +rxt(k,289)* y(k,85) +rxt(k,360)* y(k,88) & - +rxt(k,362)* y(k,89) +rxt(k,300)* y(k,90) +rxt(k,302)* y(k,91) & - +rxt(k,361)* y(k,92) +rxt(k,308)* y(k,93) +rxt(k,385)* y(k,95) & - +rxt(k,324)* y(k,99) + (rxt(k,322) +rxt(k,323))* y(k,100) & - +rxt(k,332)* y(k,103) +rxt(k,350)* y(k,106) + rxt(k,1) + rxt(k,2) & - + rxt(k,3) + het_rates(k,110))* y(k,110) - prod(k,88) = (rxt(k,372) +4.000_r8*rxt(k,136)*y(k,69) + & - 4.000_r8*rxt(k,141)*y(k,87) +4.000_r8*rxt(k,142)*y(k,61) + & - 5.000_r8*rxt(k,153)*y(k,67) +5.000_r8*rxt(k,157)*y(k,82) + & - 4.000_r8*rxt(k,158)*y(k,86) +5.000_r8*rxt(k,159)*y(k,62) + & - 6.000_r8*rxt(k,160)*y(k,84) +4.000_r8*rxt(k,161)*y(k,81) + & - 4.000_r8*rxt(k,165)*y(k,65) +4.000_r8*rxt(k,176)*y(k,63) + & - 4.000_r8*rxt(k,187)*y(k,83) +4.000_r8*rxt(k,198)*y(k,71) + & - 4.000_r8*rxt(k,209)*y(k,98) +4.000_r8*rxt(k,220)*y(k,68) + & - 5.000_r8*rxt(k,231)*y(k,85) +6.000_r8*rxt(k,242)*y(k,66) + & - 4.000_r8*rxt(k,253)*y(k,65) +5.000_r8*rxt(k,255)*y(k,67) + & - 5.000_r8*rxt(k,257)*y(k,85) +4.000_r8*rxt(k,259)*y(k,83) + & - 4.000_r8*rxt(k,262)*y(k,63) +4.000_r8*rxt(k,264)*y(k,87) + & - 6.000_r8*rxt(k,266)*y(k,66))*y(k,75) + (rxt(k,374) + & - 5.000_r8*rxt(k,139)*y(k,69) +5.000_r8*rxt(k,162)*y(k,87) + & - 5.000_r8*rxt(k,163)*y(k,65) +5.000_r8*rxt(k,164)*y(k,63) + & - 5.000_r8*rxt(k,166)*y(k,83) +5.000_r8*rxt(k,167)*y(k,71) + & - 5.000_r8*rxt(k,168)*y(k,98) +5.000_r8*rxt(k,169)*y(k,68) + & - 6.000_r8*rxt(k,170)*y(k,85) +7.000_r8*rxt(k,171)*y(k,66) + & - 5.000_r8*rxt(k,172)*y(k,61) +6.000_r8*rxt(k,173)*y(k,67) + & - 6.000_r8*rxt(k,174)*y(k,82) +5.000_r8*rxt(k,175)*y(k,86) + & - 6.000_r8*rxt(k,177)*y(k,62) +7.000_r8*rxt(k,178)*y(k,84) + & - 5.000_r8*rxt(k,179)*y(k,81) +7.000_r8*rxt(k,254)*y(k,66) + & - 6.000_r8*rxt(k,256)*y(k,67) +6.000_r8*rxt(k,258)*y(k,85) + & - 5.000_r8*rxt(k,260)*y(k,65) +5.000_r8*rxt(k,261)*y(k,83) + & - 5.000_r8*rxt(k,263)*y(k,63) +5.000_r8*rxt(k,265)*y(k,87))*y(k,77) & - + (rxt(k,370) +3.000_r8*rxt(k,180)*y(k,87) + & - 3.000_r8*rxt(k,181)*y(k,65) +3.000_r8*rxt(k,182)*y(k,63) + & - 3.000_r8*rxt(k,183)*y(k,83) +3.000_r8*rxt(k,184)*y(k,71) + & - 3.000_r8*rxt(k,185)*y(k,98) +3.000_r8*rxt(k,186)*y(k,68) + & - 4.000_r8*rxt(k,188)*y(k,85) +5.000_r8*rxt(k,189)*y(k,66) + & - 3.000_r8*rxt(k,190)*y(k,61) +4.000_r8*rxt(k,191)*y(k,67) + & - 4.000_r8*rxt(k,192)*y(k,82) +3.000_r8*rxt(k,193)*y(k,86) + & - 4.000_r8*rxt(k,194)*y(k,62) +5.000_r8*rxt(k,195)*y(k,84) + & - 3.000_r8*rxt(k,196)*y(k,81) +3.000_r8*rxt(k,378)*y(k,69))*y(k,73) & - + (rxt(k,509)*y(k,13) +rxt(k,511)*y(k,15) +rxt(k,512)*y(k,16) + & - rxt(k,514)*y(k,17) +rxt(k,519)*y(k,39) +rxt(k,531)*y(k,20) + & - rxt(k,335)*y(k,47) +rxt(k,410)*y(k,33) +rxt(k,411)*y(k,35) + & - rxt(k,412)*y(k,43) +rxt(k,415)*y(k,104) +rxt(k,418)*y(k,44) + & - rxt(k,442)*y(k,42) +rxt(k,466)*y(k,40) +rxt(k,469)*y(k,46) + & - rxt(k,495)*y(k,36) +rxt(k,527)*y(k,14) +rxt(k,530)*y(k,19))*y(k,104) & - + (2.000_r8*rxt(k,215)*y(k,87) +2.000_r8*rxt(k,216)*y(k,65) + & - 2.000_r8*rxt(k,217)*y(k,63) +2.000_r8*rxt(k,218)*y(k,83) + & - 2.000_r8*rxt(k,219)*y(k,71) +2.000_r8*rxt(k,221)*y(k,98) + & - 2.000_r8*rxt(k,222)*y(k,68) +3.000_r8*rxt(k,223)*y(k,85) + & - 4.000_r8*rxt(k,224)*y(k,66) +2.000_r8*rxt(k,225)*y(k,61) + & - 3.000_r8*rxt(k,226)*y(k,67) +3.000_r8*rxt(k,227)*y(k,82) + & - 2.000_r8*rxt(k,228)*y(k,86) +3.000_r8*rxt(k,229)*y(k,62) + & - 4.000_r8*rxt(k,230)*y(k,84) +2.000_r8*rxt(k,232)*y(k,81) + & - 2.000_r8*rxt(k,298)*y(k,69))*y(k,89) + (rxt(k,197)*y(k,87) + & - rxt(k,199)*y(k,65) +rxt(k,200)*y(k,63) +rxt(k,201)*y(k,83) + & - rxt(k,202)*y(k,71) +rxt(k,203)*y(k,98) +rxt(k,204)*y(k,68) + & - 2.000_r8*rxt(k,205)*y(k,85) +3.000_r8*rxt(k,206)*y(k,66) + & - rxt(k,207)*y(k,61) +2.000_r8*rxt(k,208)*y(k,67) + & - 2.000_r8*rxt(k,210)*y(k,82) +rxt(k,211)*y(k,86) + & - 2.000_r8*rxt(k,212)*y(k,62) +3.000_r8*rxt(k,213)*y(k,84) + & - rxt(k,214)*y(k,81) +rxt(k,303)*y(k,69))*y(k,92) & - + (rxt(k,101)*y(k,62) +rxt(k,340)*y(k,105) +rxt(k,542)*y(k,46) + & - rxt(k,548)*y(k,46) +rxt(k,549)*y(k,45) +rxt(k,553)*y(k,46) + & - rxt(k,554)*y(k,45))*y(k,40) + (rxt(k,64) +rxt(k,278) + & - rxt(k,115)*y(k,52) +rxt(k,118)*y(k,51) +rxt(k,150)*y(k,99) + & - rxt(k,244)*y(k,88))*y(k,67) + (rxt(k,133)*y(k,70) + & - 3.000_r8*rxt(k,299)*y(k,90) +rxt(k,321)*y(k,100) + & - rxt(k,376)*y(k,78) +2.000_r8*rxt(k,377)*y(k,72))*y(k,69) & - + (rxt(k,240)*y(k,85) +2.000_r8*rxt(k,241)*y(k,66) + & - rxt(k,245)*y(k,82) +rxt(k,247)*y(k,62) +2.000_r8*rxt(k,248)*y(k,84)) & - *y(k,88) + (rxt(k,147)*y(k,85) +2.000_r8*rxt(k,148)*y(k,66) + & - rxt(k,151)*y(k,82) +rxt(k,154)*y(k,62) +2.000_r8*rxt(k,155)*y(k,84)) & - *y(k,99) + (rxt(k,339)*y(k,105) +rxt(k,405)*y(k,43))*y(k,32) & - + (rxt(k,269) +rxt(k,288)*y(k,50))*y(k,84) + (rxt(k,277) + & - rxt(k,290)*y(k,42))*y(k,85) +rxt(k,348)*y(k,106)*y(k,33) +rxt(k,380) & - *y(k,62) +rxt(k,279)*y(k,66) +rxt(k,368)*y(k,72) +rxt(k,268)*y(k,82) & - +rxt(k,94)*y(k,100) - end do + loss(44) = (rxt(481)* y(15) +rxt(483)* y(57) +rxt(482)* y(71) + het_rates(1)) & + * y(1) + prod(44) = (rxt(28) +2.000_r8*rxt(484)*y(3) +rxt(485)*y(26) +rxt(486)*y(26) + & + rxt(489)*y(52) +rxt(492)*y(55) +rxt(493)*y(104))*y(3) & + + (rxt(471)*y(7) +rxt(497)*y(8) +3.000_r8*rxt(498)*y(22) + & + 2.000_r8*rxt(499)*y(36) +2.000_r8*rxt(520)*y(14) +rxt(521)*y(16) + & + rxt(500)*y(38))*y(95) + (2.000_r8*rxt(509)*y(14) +rxt(511)*y(16) + & + 3.000_r8*rxt(516)*y(22) +rxt(495)*y(38))*y(104) & + + (2.000_r8*rxt(508)*y(14) +rxt(510)*y(16) +3.000_r8*rxt(515)*y(22)) & + *y(23) + (rxt(52) +rxt(494)*y(55))*y(38) +rxt(27)*y(2) +rxt(30)*y(4) & + +rxt(58)*y(46) + loss(6) = ( + rxt(27) + het_rates(2))* y(2) + prod(6) = (rxt(549)*y(46) +rxt(554)*y(46))*y(42) +rxt(487)*y(26)*y(3) + loss(50) = (2._r8*rxt(484)* y(3) + (rxt(485) +rxt(486) +rxt(487))* y(26) & + +rxt(489)* y(52) +rxt(490)* y(53) +rxt(492)* y(55) +rxt(488)* y(71) & + +rxt(493)* y(104) + rxt(28) + het_rates(3))* y(3) + prod(50) = (rxt(29) +rxt(491)*y(55))*y(4) +rxt(483)*y(57)*y(1) & + +rxt(501)*y(95)*y(38) +rxt(496)*y(55)*y(46) + loss(20) = (rxt(491)* y(55) + rxt(29) + rxt(30) + rxt(543) + rxt(546) & + + rxt(551) + het_rates(4))* y(4) + prod(20) =rxt(490)*y(53)*y(3) + loss(56) = (rxt(481)* y(1) +rxt(445)* y(23) +rxt(525)* y(54) +rxt(526)* y(55) & + +rxt(527)* y(104) + rxt(21) + rxt(22) + het_rates(15))* y(15) + prod(56) = (rxt(452)*y(26) +rxt(529)*y(52))*y(19) + (rxt(23) + & + .300_r8*rxt(530)*y(104))*y(20) + (rxt(534)*y(95) +rxt(535)*y(95)) & + *y(21) + loss(40) = (rxt(452)* y(26) +rxt(529)* y(52) +rxt(528)* y(71) & + + het_rates(19))* y(19) + prod(40) = (rxt(446)*y(23) +rxt(502)*y(33) +rxt(531)*y(104) +rxt(533)*y(95)) & + *y(21) +.700_r8*rxt(530)*y(104)*y(20) + loss(11) = (rxt(530)* y(104) + rxt(23) + het_rates(20))* y(20) + prod(11) =rxt(528)*y(71)*y(19) + loss(74) = (rxt(508)* y(14) +rxt(445)* y(15) +rxt(510)* y(16) +rxt(513) & + * y(18) +rxt(446)* y(21) +rxt(515)* y(22) +rxt(458)* y(27) +rxt(447) & + * y(35) +rxt(448)* y(37) +rxt(467)* y(47) +rxt(451)* y(57) & + + (rxt(109) +rxt(110))* y(64) +rxt(122)* y(67) + (rxt(449) + & + rxt(450))* y(71) +rxt(280)* y(81) +rxt(309)* y(98) +rxt(336)* y(105) & + +rxt(345)* y(106) + het_rates(23))* y(23) + prod(74) = (4.000_r8*rxt(470)*y(6) +rxt(471)*y(7) +2.000_r8*rxt(472)*y(9) + & + 2.000_r8*rxt(473)*y(10) +2.000_r8*rxt(474)*y(11) +rxt(475)*y(12) + & + 2.000_r8*rxt(476)*y(13) +rxt(522)*y(39) +rxt(523)*y(40) + & + rxt(524)*y(41) +rxt(477)*y(42) +rxt(507)*y(32))*y(95) + (rxt(46) + & + rxt(452)*y(19) +2.000_r8*rxt(453)*y(26) +rxt(455)*y(26) + & + rxt(457)*y(52) +rxt(462)*y(55) +rxt(463)*y(104) +rxt(486)*y(3))*y(26) & + + (rxt(105)*y(53) +rxt(142)*y(75) +rxt(149)*y(99) +rxt(172)*y(77) + & + rxt(190)*y(73) +rxt(207)*y(92) +rxt(225)*y(89) +rxt(243)*y(88))*y(60) & + + (rxt(154)*y(99) +rxt(159)*y(75) +rxt(177)*y(77) +rxt(194)*y(73) + & + rxt(212)*y(92) +rxt(229)*y(89) +rxt(247)*y(88))*y(61) & + + (rxt(164)*y(77) +rxt(176)*y(75) +rxt(182)*y(73) +rxt(200)*y(92) + & + rxt(217)*y(89) +rxt(235)*y(88) +rxt(252)*y(99))*y(62) & + + (3.000_r8*rxt(512)*y(17) +rxt(514)*y(18) +rxt(517)*y(39) + & + rxt(518)*y(40) +rxt(519)*y(41) +rxt(466)*y(42))*y(104) + (rxt(56) + & + rxt(465)*y(55))*y(42) +rxt(27)*y(2) +2.000_r8*rxt(44)*y(24) & + +2.000_r8*rxt(45)*y(25) +rxt(47)*y(27) +rxt(50)*y(32) +rxt(59)*y(47) & + +rxt(106)*y(63)*y(52) + loss(4) = ( + rxt(44) + het_rates(24))* y(24) + prod(4) = (rxt(542)*y(47) +rxt(547)*y(27) +rxt(548)*y(47) +rxt(552)*y(27) + & + rxt(553)*y(47) +rxt(557)*y(27))*y(42) +rxt(458)*y(27)*y(23) & + +rxt(454)*y(26)*y(26) + loss(1) = ( + rxt(45) + rxt(480) + het_rates(25))* y(25) + prod(1) =rxt(479)*y(26)*y(26) + loss(72) = ((rxt(485) +rxt(486) +rxt(487))* y(3) +rxt(452)* y(19) & + + 2._r8*(rxt(453) +rxt(454) +rxt(455) +rxt(479))* y(26) +rxt(457) & + * y(52) +rxt(459)* y(53) +rxt(462)* y(55) +rxt(111)* y(64) +rxt(123) & + * y(67) +rxt(456)* y(71) +rxt(281)* y(81) +rxt(310)* y(98) & + + (rxt(463) +rxt(464))* y(104) +rxt(337)* y(105) +rxt(346)* y(106) & + + rxt(46) + het_rates(26))* y(26) + prod(72) = (rxt(450)*y(71) +rxt(451)*y(57) +rxt(467)*y(47))*y(23) & + + (rxt(48) +rxt(460)*y(55))*y(27) + (rxt(468)*y(55) + & + rxt(469)*y(104))*y(47) +2.000_r8*rxt(480)*y(25) +rxt(478)*y(95)*y(42) & + +rxt(60)*y(58) + loss(36) = (rxt(458)* y(23) + (rxt(547) +rxt(552) +rxt(557))* y(42) +rxt(460) & + * y(55) +rxt(461)* y(104) + rxt(47) + rxt(48) + rxt(545) + rxt(550) & + + rxt(556) + het_rates(27))* y(27) + prod(36) =rxt(459)*y(53)*y(26) + loss(21) = ((rxt(532) +rxt(536))* y(104) + het_rates(29))* y(29) + prod(21) = (rxt(21) +rxt(22) +rxt(445)*y(23) +rxt(481)*y(1) +rxt(525)*y(54) + & + rxt(526)*y(55) +rxt(527)*y(104))*y(15) +rxt(513)*y(23)*y(18) & + +rxt(573)*y(107)*y(30) + loss(2) = (rxt(506)* y(95) + rxt(49) + het_rates(31))* y(31) + prod(2) = (rxt(471)*y(7) +rxt(473)*y(10) +2.000_r8*rxt(474)*y(11) + & + 2.000_r8*rxt(475)*y(12) +rxt(476)*y(13) +rxt(497)*y(8) + & + 2.000_r8*rxt(499)*y(36) +rxt(523)*y(40) +rxt(524)*y(41))*y(95) & + + (rxt(518)*y(40) +rxt(519)*y(41))*y(104) + loss(5) = (rxt(507)* y(95) + rxt(50) + het_rates(32))* y(32) + prod(5) = (rxt(472)*y(9) +rxt(473)*y(10) +rxt(522)*y(39))*y(95) & + +rxt(517)*y(104)*y(39) + loss(29) = (rxt(502)* y(21) +rxt(503)* y(35) +rxt(505)* y(44) +rxt(504) & + * y(110) + het_rates(33))* y(33) + prod(29) = (rxt(475)*y(12) +rxt(497)*y(8) +2.000_r8*rxt(506)*y(31) + & + rxt(507)*y(32))*y(95) +2.000_r8*rxt(49)*y(31) +rxt(50)*y(32) +rxt(57) & + *y(43) + loss(68) = (rxt(406)* y(56) +rxt(409)* y(57) +rxt(100)* y(60) +rxt(112) & + * y(64) +rxt(124)* y(67) + (rxt(403) +rxt(404) +rxt(405))* y(71) & + +rxt(282)* y(81) +rxt(304)* y(92) +rxt(312)* y(98) +rxt(326)* y(101) & + +rxt(339)* y(105) + het_rates(34))* y(34) + prod(68) = (rxt(136)*y(68) +rxt(142)*y(60) +rxt(153)*y(66) +rxt(157)*y(82) + & + rxt(158)*y(86) +rxt(159)*y(61) +rxt(160)*y(84) +rxt(161)*y(81) + & + rxt(165)*y(64) +rxt(176)*y(62) +rxt(198)*y(70) +rxt(209)*y(98) + & + rxt(220)*y(67) +rxt(231)*y(85) +rxt(242)*y(65) +rxt(253)*y(64) + & + rxt(255)*y(66) +rxt(257)*y(85) +rxt(266)*y(65))*y(75) & + + (rxt(139)*y(68) +rxt(163)*y(64) +rxt(164)*y(62) +rxt(167)*y(70) + & + rxt(168)*y(98) +rxt(169)*y(67) +rxt(170)*y(85) +rxt(171)*y(65) + & + rxt(172)*y(60) +rxt(173)*y(66) +rxt(174)*y(82) +rxt(175)*y(86) + & + rxt(177)*y(61) +rxt(178)*y(84) +rxt(179)*y(81) +rxt(254)*y(65) + & + rxt(256)*y(66) +rxt(258)*y(85) +rxt(260)*y(64))*y(77) & + + (rxt(181)*y(64) +rxt(182)*y(62) +rxt(184)*y(70) +rxt(185)*y(98) + & + rxt(186)*y(67) +rxt(188)*y(85) +rxt(189)*y(65) +rxt(190)*y(60) + & + rxt(191)*y(66) +rxt(192)*y(82) +rxt(193)*y(86) +rxt(194)*y(61) + & + rxt(195)*y(84) +rxt(196)*y(81) +rxt(378)*y(68))*y(73) & + + (rxt(349)*y(106) +rxt(384)*y(95) +rxt(401)*y(55) + & + rxt(410)*y(104) +rxt(447)*y(23) +rxt(503)*y(33))*y(35) & + + (rxt(413)*y(55) +rxt(433)*y(49) +rxt(527)*y(15) +rxt(536)*y(29)) & + *y(104) + (rxt(133)*y(69) +rxt(376)*y(78) +rxt(377)*y(72))*y(68) & + + (rxt(534)*y(21) +rxt(478)*y(42) +rxt(501)*y(38))*y(95) & + + (2.000_r8*rxt(2) +rxt(3))*y(110) +2.000_r8*rxt(21)*y(15) +rxt(23) & + *y(20) +rxt(52)*y(38) +rxt(56)*y(42) +rxt(57)*y(43) + loss(51) = (rxt(447)* y(23) +rxt(503)* y(33) +rxt(401)* y(55) +rxt(384) & + * y(95) +rxt(410)* y(104) + (rxt(348) +rxt(349))* y(106) & + + het_rates(35))* y(35) + prod(51) =rxt(22)*y(15) +rxt(535)*y(95)*y(21) +rxt(403)*y(71)*y(34) +rxt(1) & + *y(110) + loss(23) = (rxt(448)* y(23) +rxt(402)* y(55) +rxt(411)* y(104) + rxt(4) & + + het_rates(37))* y(37) + prod(23) = (.500_r8*rxt(537) +rxt(417)*y(71))*y(71) +rxt(416)*y(104)*y(104) + loss(32) = (rxt(494)* y(55) + (rxt(500) +rxt(501))* y(95) +rxt(495)* y(104) & + + rxt(52) + het_rates(38))* y(38) + prod(32) = (rxt(481)*y(15) +rxt(482)*y(71))*y(1) + loss(67) = ((rxt(547) +rxt(552) +rxt(557))* y(27) + (rxt(549) +rxt(554)) & + * y(46) + (rxt(542) +rxt(548) +rxt(553))* y(47) +rxt(465)* y(55) & + +rxt(103)* y(60) +rxt(101)* y(61) +rxt(125)* y(67) +rxt(284)* y(81) & + + (rxt(271) +rxt(293))* y(83) + (rxt(477) +rxt(478))* y(95) & + +rxt(313)* y(98) +rxt(466)* y(104) +rxt(340)* y(105) +rxt(351) & + * y(106) + rxt(56) + het_rates(42))* y(42) + prod(67) = (rxt(446)*y(21) +rxt(508)*y(14) +rxt(510)*y(16) + & + 2.000_r8*rxt(513)*y(18) +rxt(515)*y(22) +rxt(445)*y(15) + & + rxt(447)*y(35) +rxt(448)*y(37) +rxt(449)*y(71) +rxt(467)*y(47))*y(23) & + + (rxt(381) +rxt(164)*y(77) +rxt(176)*y(75) +rxt(182)*y(73) + & + rxt(200)*y(92) +rxt(217)*y(89) +rxt(235)*y(88) +rxt(252)*y(99) + & + 2.000_r8*rxt(262)*y(75) +2.000_r8*rxt(263)*y(77))*y(62) & + + (rxt(152)*y(99) +rxt(158)*y(75) +rxt(175)*y(77) +rxt(193)*y(73) + & + rxt(211)*y(92) +rxt(228)*y(89) +rxt(246)*y(88) +rxt(294)*y(44))*y(86) & + + (rxt(100)*y(34) +rxt(104)*y(44))*y(60) +rxt(464)*y(104)*y(26) + loss(7) = ( + rxt(57) + het_rates(43))* y(43) + prod(7) = (rxt(502)*y(21) +rxt(503)*y(35) +rxt(504)*y(110) +rxt(505)*y(44)) & + *y(33) + loss(85) = (rxt(505)* y(33) +rxt(104)* y(60) +rxt(119)* y(64) +rxt(285) & + * y(81) +rxt(295)* y(83) +rxt(290)* y(85) +rxt(294)* y(86) +rxt(314) & + * y(98) +rxt(442)* y(104) +rxt(352)* y(106) + rxt(9) + het_rates(44)) & + * y(44) + prod(85) = (rxt(270) +2.000_r8*rxt(141)*y(75) +2.000_r8*rxt(162)*y(77) + & + 2.000_r8*rxt(180)*y(73) +rxt(197)*y(92) +rxt(215)*y(89) + & + rxt(233)*y(88) +rxt(250)*y(99) +2.000_r8*rxt(264)*y(75) + & + 2.000_r8*rxt(265)*y(77))*y(87) + (2.000_r8*rxt(538) + & + 2.000_r8*rxt(541) +2.000_r8*rxt(544) +2.000_r8*rxt(555) + & + rxt(137)*y(75) +rxt(140)*y(77) +rxt(288)*y(84) +rxt(292)*y(85))*y(51) & + + (rxt(545) +rxt(550) +rxt(556) +rxt(547)*y(42) +rxt(552)*y(42) + & + rxt(557)*y(42))*y(27) + (rxt(166)*y(77) +rxt(183)*y(73) + & + rxt(187)*y(75) +rxt(259)*y(75) +rxt(261)*y(77) +rxt(293)*y(42))*y(83) & + + (rxt(543) +rxt(546) +rxt(551))*y(4) + (.500_r8*rxt(539) + & + rxt(441)*y(104))*y(53) + (rxt(540) +rxt(525)*y(15))*y(54) & + + (rxt(135)*y(74) +rxt(138)*y(76))*y(110) + loss(15) = (rxt(418)* y(104) + rxt(10) + rxt(11) + rxt(443) + het_rates(45)) & + * y(45) + prod(15) =rxt(439)*y(71)*y(53) + loss(30) = ((rxt(549) +rxt(554))* y(42) +rxt(496)* y(55) + rxt(58) & + + het_rates(46))* y(46) + prod(30) = (rxt(543) +rxt(546) +rxt(551))*y(4) +rxt(488)*y(71)*y(3) + loss(33) = (rxt(467)* y(23) + (rxt(542) +rxt(548) +rxt(553))* y(42) +rxt(468) & + * y(55) +rxt(469)* y(104) + rxt(59) + het_rates(47))* y(47) + prod(33) = (rxt(545) +rxt(550) +rxt(556) +rxt(461)*y(104))*y(27) & + +rxt(456)*y(71)*y(26) + loss(25) = (rxt(335)* y(104) + rxt(12) + het_rates(48))* y(48) + prod(25) = (rxt(284)*y(42) +rxt(285)*y(44))*y(81) +rxt(344)*y(104)*y(52) & + +rxt(300)*y(110)*y(90) + loss(39) = (rxt(421)* y(52) + (rxt(422) +rxt(423) +rxt(424))* y(53) +rxt(425) & + * y(56) +rxt(570)* y(99) +rxt(433)* y(104) + rxt(66) + het_rates(49)) & + * y(49) + prod(39) = (rxt(419)*y(79) +rxt(567)*y(94))*y(55) + (.200_r8*rxt(561)*y(88) + & + 1.100_r8*rxt(563)*y(80))*y(68) +rxt(17)*y(52) +rxt(568)*y(94)*y(56) & + +rxt(574)*y(107) + loss(38) = (rxt(137)* y(75) +rxt(140)* y(77) +rxt(288)* y(84) +rxt(292) & + * y(85) + rxt(14) + rxt(15) + rxt(444) + rxt(538) + rxt(541) & + + rxt(544) + rxt(555) + het_rates(51))* y(51) + prod(38) =rxt(440)*y(54)*y(53) + loss(77) = (rxt(489)* y(3) +rxt(529)* y(19) +rxt(457)* y(26) +rxt(421)* y(49) & + +rxt(430)* y(54) +rxt(436)* y(55) +rxt(435)* y(57) + (rxt(106) + & + rxt(107))* y(63) +rxt(275)* y(64) + (rxt(117) +rxt(118))* y(66) & + +rxt(434)* y(71) +rxt(572)* y(99) + (rxt(267) +rxt(274))* y(101) & + +rxt(344)* y(104) +rxt(131)* y(106) + rxt(16) + rxt(17) & + + het_rates(52))* y(52) + prod(77) = (rxt(197)*y(87) +rxt(199)*y(64) +rxt(200)*y(62) +rxt(201)*y(83) + & + rxt(202)*y(70) +rxt(203)*y(98) +rxt(204)*y(67) +rxt(205)*y(85) + & + rxt(206)*y(65) +rxt(207)*y(60) +rxt(208)*y(66) +rxt(210)*y(82) + & + rxt(211)*y(86) +rxt(212)*y(61) +rxt(213)*y(84) +rxt(214)*y(81) + & + rxt(303)*y(68) +rxt(304)*y(34))*y(92) + (rxt(215)*y(87) + & + rxt(216)*y(64) +rxt(217)*y(62) +rxt(218)*y(83) +rxt(219)*y(70) + & + rxt(221)*y(98) +rxt(222)*y(67) +rxt(223)*y(85) +rxt(224)*y(65) + & + rxt(225)*y(60) +rxt(226)*y(66) +rxt(227)*y(82) +rxt(228)*y(86) + & + rxt(229)*y(61) +rxt(230)*y(84) +rxt(232)*y(81) +rxt(298)*y(68))*y(89) & + + (rxt(233)*y(87) +rxt(234)*y(64) +rxt(235)*y(62) +rxt(236)*y(83) + & + rxt(237)*y(70) +rxt(238)*y(98) +rxt(239)*y(67) +rxt(240)*y(85) + & + rxt(241)*y(65) +rxt(243)*y(60) +rxt(244)*y(66) +rxt(245)*y(82) + & + rxt(246)*y(86) +rxt(247)*y(61) +rxt(248)*y(84) +rxt(249)*y(81))*y(88) & + + (rxt(18) +.500_r8*rxt(539) +rxt(286)*y(81) + & + 2.000_r8*rxt(423)*y(49) +rxt(426)*y(55))*y(53) + (rxt(299)*y(90) + & + rxt(301)*y(91) +rxt(379)*y(93))*y(68) + (rxt(425)*y(56) + & + rxt(433)*y(104))*y(49) +rxt(282)*y(81)*y(34) +rxt(12)*y(48) & + +2.000_r8*rxt(437)*y(95)*y(50) +rxt(15)*y(51) +rxt(20)*y(54) & + +rxt(420)*y(79)*y(56) +rxt(571)*y(99) +rxt(584)*y(109) + loss(71) = (rxt(490)* y(3) +rxt(459)* y(26) + (rxt(422) +rxt(423) +rxt(424)) & + * y(49) +rxt(440)* y(54) + (rxt(426) +rxt(428))* y(55) +rxt(427) & + * y(57) +rxt(105)* y(60) +rxt(276)* y(64) + (rxt(115) +rxt(116)) & + * y(66) +rxt(439)* y(71) +rxt(286)* y(81) +rxt(315)* y(98) & + + (rxt(272) +rxt(273))* y(101) +rxt(441)* y(104) +rxt(341)* y(105) & + +rxt(354)* y(106) + rxt(18) + rxt(539) + het_rates(53))* y(53) + prod(71) = (rxt(107)*y(63) +rxt(131)*y(106) +2.000_r8*rxt(430)*y(54) + & + rxt(434)*y(71) +rxt(435)*y(57) +rxt(436)*y(55) +rxt(457)*y(26) + & + rxt(489)*y(3) +rxt(529)*y(19))*y(52) + (rxt(75) +rxt(156)*y(99) + & + rxt(161)*y(75) +rxt(179)*y(77) +rxt(196)*y(73) +rxt(214)*y(92) + & + rxt(232)*y(89) +rxt(249)*y(88) +rxt(280)*y(23))*y(81) & + + (rxt(151)*y(99) +rxt(157)*y(75) +rxt(174)*y(77) +rxt(192)*y(73) + & + rxt(210)*y(92) +rxt(227)*y(89) +rxt(245)*y(88))*y(82) + (rxt(19) + & + rxt(429)*y(71) +rxt(431)*y(55) +rxt(432)*y(104))*y(54) + (rxt(11) + & + rxt(443) +rxt(418)*y(104))*y(45) + (rxt(14) +rxt(444))*y(51) & + + (rxt(306)*y(92) +rxt(335)*y(48))*y(104) +rxt(29)*y(4) +rxt(48) & + *y(27) +rxt(9)*y(44) + loss(86) = (rxt(525)* y(15) +rxt(430)* y(52) +rxt(440)* y(53) +rxt(431) & + * y(55) +rxt(429)* y(71) +rxt(432)* y(104) + rxt(19) + rxt(20) & + + rxt(540) + het_rates(54))* y(54) + prod(86) = (rxt(147)*y(99) +rxt(170)*y(77) +rxt(188)*y(73) +rxt(205)*y(92) + & + rxt(223)*y(89) +rxt(231)*y(75) +rxt(240)*y(88) +rxt(257)*y(75) + & + rxt(258)*y(77))*y(85) + (rxt(155)*y(99) +rxt(160)*y(75) + & + rxt(178)*y(77) +rxt(195)*y(73) +rxt(213)*y(92) +rxt(230)*y(89) + & + rxt(248)*y(88))*y(84) + (rxt(152)*y(99) +rxt(158)*y(75) + & + rxt(175)*y(77) +rxt(193)*y(73) +rxt(211)*y(92) +rxt(228)*y(89) + & + rxt(246)*y(88))*y(86) + (rxt(76) +rxt(143)*y(99) +rxt(201)*y(92) + & + rxt(218)*y(89) +rxt(236)*y(88))*y(83) + (rxt(47) +rxt(458)*y(23) + & + rxt(460)*y(55) +rxt(461)*y(104))*y(27) + (rxt(197)*y(92) + & + rxt(215)*y(89) +rxt(233)*y(88) +rxt(250)*y(99))*y(87) + (rxt(14) + & + rxt(15) +rxt(444))*y(51) + (rxt(30) +rxt(491)*y(55))*y(4) & + + (rxt(442)*y(104) +rxt(505)*y(33))*y(44) + (rxt(427)*y(57) + & + rxt(428)*y(55))*y(53) +rxt(281)*y(81)*y(26) +rxt(10)*y(45) & + +rxt(305)*y(92)*y(71) + loss(81) = (rxt(492)* y(3) +rxt(491)* y(4) +rxt(526)* y(15) +rxt(462)* y(26) & + +rxt(460)* y(27) +rxt(401)* y(35) +rxt(402)* y(37) +rxt(494)* y(38) & + +rxt(465)* y(42) +rxt(496)* y(46) +rxt(468)* y(47) +rxt(436)* y(52) & + + (rxt(426) +rxt(428))* y(53) +rxt(431)* y(54) + 2._r8*rxt(399) & + * y(55) +rxt(400)* y(56) +rxt(398)* y(57) +rxt(108)* y(63) +rxt(120) & + * y(64) +rxt(126)* y(67) +rxt(407)* y(71) + (rxt(565) +rxt(566)) & + * y(80) +rxt(296)* y(83) +rxt(567)* y(94) + (rxt(319) +rxt(320)) & + * y(98) + (rxt(328) +rxt(329))* y(101) +rxt(331)* y(102) +rxt(333) & + * y(103) +rxt(413)* y(104) +rxt(342)* y(105) +rxt(355)* y(106) & + + rxt(77) + rxt(78) + rxt(79) + rxt(80) + rxt(81) + rxt(82) & + + het_rates(55))* y(55) + prod(81) = (2.000_r8*rxt(5) +rxt(6) +rxt(83) +2.000_r8*rxt(84) +rxt(85) + & + rxt(87) +2.000_r8*rxt(89) +rxt(90) +rxt(91) +rxt(92) + & + rxt(387)*y(95) +rxt(388)*y(95) +rxt(425)*y(49) +rxt(569)*y(94) + & + rxt(576)*y(107) +rxt(580)*y(108))*y(56) + (rxt(109)*y(23) + & + rxt(163)*y(77) +rxt(165)*y(75) +rxt(181)*y(73) +rxt(199)*y(92) + & + rxt(216)*y(89) +rxt(234)*y(88) +rxt(251)*y(99) +rxt(253)*y(75) + & + rxt(260)*y(77))*y(64) + (rxt(148)*y(99) +rxt(171)*y(77) + & + rxt(189)*y(73) +rxt(206)*y(92) +rxt(224)*y(89) +rxt(241)*y(88) + & + rxt(242)*y(75) +rxt(254)*y(77) +rxt(266)*y(75))*y(65) & + + (rxt(150)*y(99) +rxt(153)*y(75) +rxt(173)*y(77) +rxt(191)*y(73) + & + rxt(208)*y(92) +rxt(226)*y(89) +rxt(244)*y(88) +rxt(255)*y(75) + & + rxt(256)*y(77))*y(66) + (rxt(99) +rxt(353) +rxt(345)*y(23) + & + rxt(354)*y(53) +rxt(358)*y(57))*y(106) + (rxt(421)*y(52) + & + rxt(422)*y(53) +rxt(570)*y(99))*y(49) + (rxt(17) +rxt(267)*y(101)) & + *y(52) + (rxt(561)*y(88) +1.150_r8*rxt(562)*y(99))*y(68) +rxt(28) & + *y(3) +rxt(46)*y(26) +rxt(405)*y(71)*y(34) +rxt(15)*y(51) +rxt(18) & + *y(53) +rxt(19)*y(54) +rxt(8)*y(57) +rxt(60)*y(58) +rxt(575)*y(107) & + *y(79) +rxt(386)*y(95) +rxt(415)*y(104)*y(104) +rxt(578)*y(108) & + +rxt(583)*y(109) +rxt(2)*y(110) + loss(73) = (rxt(406)* y(34) +rxt(425)* y(49) +rxt(400)* y(55) +rxt(121) & + * y(64) + (rxt(128) +rxt(130))* y(68) +rxt(420)* y(79) +rxt(564) & + * y(80) + (rxt(568) +rxt(569))* y(94) +rxt(387)* y(95) +rxt(392) & + * y(96) +rxt(317)* y(98) +rxt(359)* y(99) +rxt(357)* y(106) +rxt(576) & + * y(107) +rxt(580)* y(108) + rxt(5) + rxt(6) + rxt(83) + rxt(84) & + + rxt(85) + rxt(86) + rxt(87) + rxt(88) + rxt(89) + rxt(90) & + + rxt(91) + rxt(92) + het_rates(56))* y(56) + prod(73) = (rxt(108)*y(63) +rxt(126)*y(67) +rxt(296)*y(83) +rxt(320)*y(98) + & + 2.000_r8*rxt(328)*y(101) +rxt(329)*y(101) +rxt(331)*y(102) + & + rxt(355)*y(106) +rxt(391)*y(96) +2.000_r8*rxt(398)*y(57) + & + rxt(399)*y(55) +rxt(407)*y(71) +rxt(413)*y(104) +rxt(426)*y(53) + & + rxt(431)*y(54) +rxt(462)*y(26) +rxt(492)*y(3))*y(55) & + + (rxt(143)*y(83) +rxt(144)*y(70) +2.000_r8*rxt(146)*y(67) + & + rxt(147)*y(85) +rxt(148)*y(65) +rxt(149)*y(60) +rxt(150)*y(66) + & + rxt(151)*y(82) +rxt(152)*y(86) +rxt(154)*y(61) +rxt(155)*y(84) + & + rxt(156)*y(81) +rxt(250)*y(87) +rxt(251)*y(64) +rxt(252)*y(62) + & + rxt(572)*y(52))*y(99) + (rxt(8) +rxt(127)*y(67) +rxt(129)*y(68) + & + rxt(287)*y(81) +2.000_r8*rxt(297)*y(83) +rxt(318)*y(98) + & + 3.000_r8*rxt(327)*y(101) +2.000_r8*rxt(389)*y(95) + & + 2.000_r8*rxt(408)*y(71) +rxt(409)*y(34) +rxt(414)*y(104) + & + rxt(427)*y(53) +rxt(435)*y(52) +rxt(451)*y(23) +rxt(483)*y(1))*y(57) & + + (rxt(93) +rxt(132) +rxt(168)*y(77) +rxt(185)*y(73) + & + rxt(203)*y(92) +rxt(209)*y(75) +rxt(221)*y(89) +rxt(238)*y(88) + & + rxt(309)*y(23) +rxt(310)*y(26) +rxt(315)*y(53) + & + 2.000_r8*rxt(316)*y(96))*y(98) + (rxt(111)*y(64) +rxt(123)*y(67) + & + rxt(346)*y(106) +rxt(453)*y(26) +rxt(454)*y(26) +rxt(456)*y(71) + & + rxt(464)*y(104) +rxt(486)*y(3) +rxt(487)*y(3))*y(26) & + + (rxt(403)*y(34) +rxt(412)*y(104) +rxt(417)*y(71) +rxt(429)*y(54) + & + rxt(449)*y(23) +rxt(482)*y(1) +rxt(488)*y(3) +rxt(528)*y(19))*y(71) & + + (rxt(122)*y(23) +rxt(169)*y(77) +rxt(186)*y(73) +rxt(204)*y(92) + & + rxt(220)*y(75) +rxt(222)*y(89) +rxt(239)*y(88))*y(67) + (rxt(95) + & + rxt(325)*y(30) +rxt(272)*y(53) +rxt(274)*y(52) +rxt(326)*y(34)) & + *y(101) + (rxt(382) +rxt(390) +2.000_r8*rxt(334)*y(103) + & + 2.000_r8*rxt(392)*y(56))*y(96) + (rxt(321)*y(68) +rxt(322)*y(110) + & + rxt(323)*y(110))*y(100) + (rxt(97) +rxt(330)*y(30))*y(102) & + + (rxt(332)*y(110) +2.000_r8*rxt(375)*y(68))*y(103) +rxt(484)*y(3) & + *y(3) +rxt(418)*y(104)*y(45) +rxt(424)*y(53)*y(49) +rxt(438)*y(95) & + *y(50) +rxt(20)*y(54) +rxt(383)*y(97) + loss(84) = (rxt(483)* y(1) +rxt(451)* y(23) +rxt(409)* y(34) +rxt(435)* y(52) & + +rxt(427)* y(53) +rxt(398)* y(55) +rxt(127)* y(67) +rxt(129)* y(68) & + +rxt(408)* y(71) +rxt(287)* y(81) +rxt(297)* y(83) +rxt(389)* y(95) & + +rxt(318)* y(98) +rxt(327)* y(101) +rxt(414)* y(104) +rxt(343) & + * y(105) +rxt(358)* y(106) + rxt(7) + rxt(8) + het_rates(57))* y(57) + prod(84) = (rxt(319)*y(98) +rxt(333)*y(103) +rxt(400)*y(56))*y(55) & + + (rxt(96) +rxt(273)*y(53))*y(101) +rxt(356)*y(106)*y(96) + loss(3) = ( + rxt(60) + het_rates(58))* y(58) + prod(3) = (rxt(455)*y(26) +rxt(485)*y(3))*y(26) + loss(59) = (rxt(100)* y(34) +rxt(103)* y(42) +rxt(104)* y(44) +rxt(105) & + * y(53) +rxt(190)* y(73) +rxt(142)* y(75) +rxt(172)* y(77) +rxt(243) & + * y(88) +rxt(225)* y(89) +rxt(207)* y(92) +rxt(149)* y(99) +rxt(102) & + * y(110) + het_rates(60))* y(60) + prod(59) = (rxt(109)*y(64) +rxt(122)*y(67) +rxt(280)*y(81) +rxt(309)*y(98) + & + rxt(336)*y(105) +rxt(345)*y(106))*y(23) + (rxt(125)*y(67) + & + rxt(284)*y(81) +rxt(293)*y(83) +rxt(313)*y(98) +rxt(340)*y(105) + & + rxt(351)*y(106))*y(42) + (rxt(111)*y(64) +rxt(281)*y(81) + & + rxt(346)*y(106))*y(26) + (rxt(107)*y(52) +rxt(108)*y(55))*y(63) & + +rxt(380)*y(61) +rxt(381)*y(62) + loss(46) = (rxt(101)* y(42) +rxt(194)* y(73) +rxt(159)* y(75) +rxt(177) & + * y(77) +rxt(247)* y(88) +rxt(229)* y(89) +rxt(212)* y(92) +rxt(154) & + * y(99) + rxt(380) + het_rates(61))* y(61) + prod(46) =rxt(102)*y(110)*y(60) + loss(45) = (rxt(182)* y(73) + (rxt(176) +rxt(262))* y(75) + (rxt(164) + & + rxt(263))* y(77) +rxt(235)* y(88) +rxt(217)* y(89) +rxt(200)* y(92) & + +rxt(252)* y(99) + rxt(381) + het_rates(62))* y(62) + prod(45) = (rxt(101)*y(61) +rxt(103)*y(60))*y(42) + loss(37) = ((rxt(106) +rxt(107))* y(52) +rxt(108)* y(55) + het_rates(63)) & + * y(63) + prod(37) = (rxt(123)*y(67) +rxt(310)*y(98) +rxt(337)*y(105))*y(26) & + +rxt(110)*y(64)*y(23) + loss(63) = ((rxt(109) +rxt(110))* y(23) +rxt(111)* y(26) +rxt(112)* y(34) & + +rxt(119)* y(44) +rxt(275)* y(52) +rxt(276)* y(53) +rxt(120)* y(55) & + +rxt(121)* y(56) +rxt(181)* y(73) + (rxt(165) +rxt(253))* y(75) & + + (rxt(163) +rxt(260))* y(77) +rxt(234)* y(88) +rxt(216)* y(89) & + +rxt(199)* y(92) +rxt(251)* y(99) +rxt(114)* y(110) + rxt(63) & + + het_rates(64))* y(64) + prod(63) = (rxt(325)*y(101) +rxt(347)*y(106))*y(30) + (rxt(64) +rxt(278)) & + *y(66) + (rxt(124)*y(34) +rxt(126)*y(55))*y(67) + loss(43) = (rxt(189)* y(73) + (rxt(242) +rxt(266))* y(75) + (rxt(171) + & + rxt(254))* y(77) +rxt(241)* y(88) +rxt(224)* y(89) +rxt(206)* y(92) & + +rxt(148)* y(99) + rxt(279) + het_rates(65))* y(65) + prod(43) =rxt(113)*y(110)*y(66) + loss(54) = ((rxt(117) +rxt(118))* y(52) + (rxt(115) +rxt(116))* y(53) & + +rxt(191)* y(73) + (rxt(153) +rxt(255))* y(75) + (rxt(173) + & + rxt(256))* y(77) +rxt(244)* y(88) +rxt(226)* y(89) +rxt(208)* y(92) & + +rxt(150)* y(99) +rxt(113)* y(110) + rxt(64) + rxt(278) & + + het_rates(66))* y(66) + prod(54) =rxt(114)*y(110)*y(64) +rxt(279)*y(65) + loss(58) = (rxt(122)* y(23) +rxt(123)* y(26) +rxt(124)* y(34) +rxt(125) & + * y(42) +rxt(126)* y(55) +rxt(127)* y(57) +rxt(186)* y(73) +rxt(220) & + * y(75) +rxt(169)* y(77) +rxt(239)* y(88) +rxt(222)* y(89) +rxt(204) & + * y(92) +rxt(146)* y(99) + rxt(65) + het_rates(67))* y(67) + prod(58) = (rxt(311)*y(98) +rxt(330)*y(102))*y(30) + loss(79) = ((rxt(128) +rxt(130))* y(56) +rxt(129)* y(57) +rxt(133)* y(69) & + +rxt(377)* y(72) +rxt(378)* y(73) +rxt(136)* y(75) +rxt(139)* y(77) & + +rxt(376)* y(78) +rxt(563)* y(80) +rxt(561)* y(88) +rxt(298)* y(89) & + +rxt(299)* y(90) +rxt(301)* y(91) +rxt(303)* y(92) +rxt(379)* y(93) & + +rxt(562)* y(99) +rxt(321)* y(100) +rxt(375)* y(103) & + + het_rates(68))* y(68) + prod(79) = (rxt(77) +rxt(78) +rxt(79) +rxt(80) +rxt(81) +rxt(82) + & + rxt(319)*y(98) +rxt(328)*y(101) +rxt(342)*y(105) +rxt(355)*y(106)) & + *y(55) + (rxt(83) +rxt(85) +rxt(86) +rxt(87) +rxt(88) +rxt(90) + & + rxt(91) +rxt(92))*y(56) + (rxt(99) +rxt(353) +rxt(131)*y(52) + & + rxt(348)*y(35) +rxt(356)*y(96))*y(106) + (rxt(93) +rxt(132) + & + rxt(312)*y(34) +rxt(316)*y(96))*y(98) + (rxt(100)*y(60) + & + rxt(339)*y(105))*y(34) + (rxt(96) +rxt(327)*y(57))*y(101) +rxt(66) & + *y(49) +rxt(16)*y(52) +rxt(75)*y(81) +rxt(76)*y(83) +rxt(98)*y(105) + loss(12) = (rxt(133)* y(68) +rxt(134)* y(110) + het_rates(69))* y(69) + prod(12) =rxt(322)*y(110)*y(100) + loss(41) = (rxt(184)* y(73) +rxt(198)* y(75) +rxt(167)* y(77) +rxt(237) & + * y(88) +rxt(219)* y(89) +rxt(202)* y(92) +rxt(144)* y(99) & + + het_rates(70))* y(70) + prod(41) =rxt(338)*y(105)*y(30) + loss(61) = (rxt(482)* y(1) +rxt(488)* y(3) +rxt(528)* y(19) + (rxt(449) + & + rxt(450))* y(23) +rxt(456)* y(26) + (rxt(403) +rxt(404) +rxt(405)) & + * y(34) +rxt(434)* y(52) +rxt(439)* y(53) +rxt(429)* y(54) +rxt(407) & + * y(55) +rxt(408)* y(57) + 2._r8*rxt(417)* y(71) +rxt(305)* y(92) & + +rxt(412)* y(104) + rxt(537) + het_rates(71))* y(71) + prod(61) = (rxt(511)*y(16) +rxt(514)*y(18) +rxt(411)*y(37) +rxt(414)*y(57) + & + rxt(432)*y(54) +rxt(463)*y(26) +rxt(493)*y(3) +rxt(532)*y(29))*y(104) & + + (rxt(445)*y(23) +rxt(481)*y(1) +rxt(525)*y(54) +rxt(526)*y(55)) & + *y(15) + (rxt(510)*y(16) +rxt(513)*y(18) +rxt(448)*y(37))*y(23) & + + (rxt(312)*y(34) +rxt(313)*y(42) +rxt(314)*y(44))*y(98) & + + (rxt(452)*y(26) +rxt(529)*y(52))*y(19) + (rxt(11) +rxt(443))*y(45) & + + (rxt(342)*y(105) +rxt(402)*y(37))*y(55) +rxt(534)*y(95)*y(21) & + +rxt(406)*y(56)*y(34) +rxt(125)*y(67)*y(42) + loss(24) = (rxt(377)* y(68) +rxt(369)* y(110) + rxt(368) + het_rates(72)) & + * y(72) + prod(24) = (rxt(134)*y(69) +rxt(367)*y(78))*y(110) +rxt(370)*y(73) + loss(70) = (rxt(190)* y(60) +rxt(194)* y(61) +rxt(182)* y(62) +rxt(181) & + * y(64) +rxt(189)* y(65) +rxt(191)* y(66) +rxt(186)* y(67) +rxt(378) & + * y(68) +rxt(184)* y(70) +rxt(196)* y(81) +rxt(192)* y(82) +rxt(183) & + * y(83) +rxt(195)* y(84) +rxt(188)* y(85) +rxt(193)* y(86) +rxt(180) & + * y(87) +rxt(185)* y(98) +rxt(371)* y(110) + rxt(370) & + + het_rates(73))* y(73) + prod(70) = (rxt(300)*y(90) +rxt(369)*y(72))*y(110) +rxt(372)*y(75) + loss(9) = (rxt(135)* y(110) + het_rates(74))* y(74) + prod(9) =rxt(137)*y(75)*y(51) + loss(78) = (rxt(137)* y(51) +rxt(142)* y(60) +rxt(159)* y(61) + (rxt(176) + & + rxt(262))* y(62) + (rxt(165) +rxt(253))* y(64) + (rxt(242) +rxt(266)) & + * y(65) + (rxt(153) +rxt(255))* y(66) +rxt(220)* y(67) +rxt(136) & + * y(68) +rxt(198)* y(70) +rxt(161)* y(81) +rxt(157)* y(82) & + + (rxt(187) +rxt(259))* y(83) +rxt(160)* y(84) + (rxt(231) + & + rxt(257))* y(85) +rxt(158)* y(86) + (rxt(141) +rxt(264))* y(87) & + +rxt(209)* y(98) +rxt(373)* y(110) + rxt(372) + het_rates(75)) & + * y(75) + prod(78) = (rxt(135)*y(74) +rxt(371)*y(73))*y(110) +rxt(374)*y(77) + loss(10) = (rxt(138)* y(110) + het_rates(76))* y(76) + prod(10) =rxt(140)*y(77)*y(51) + loss(80) = (rxt(140)* y(51) +rxt(172)* y(60) +rxt(177)* y(61) + (rxt(164) + & + rxt(263))* y(62) + (rxt(163) +rxt(260))* y(64) + (rxt(171) +rxt(254)) & + * y(65) + (rxt(173) +rxt(256))* y(66) +rxt(169)* y(67) +rxt(139) & + * y(68) +rxt(167)* y(70) +rxt(179)* y(81) +rxt(174)* y(82) & + + (rxt(166) +rxt(261))* y(83) +rxt(178)* y(84) + (rxt(170) + & + rxt(258))* y(85) +rxt(175)* y(86) + (rxt(162) +rxt(265))* y(87) & + +rxt(168)* y(98) + rxt(374) + het_rates(77))* y(77) + prod(80) = (rxt(138)*y(76) +rxt(373)*y(75))*y(110) + loss(26) = (rxt(376)* y(68) +rxt(367)* y(110) + het_rates(78))* y(78) + prod(26) = (rxt(304)*y(34) +rxt(305)*y(71) +rxt(306)*y(104))*y(92) +rxt(368) & + *y(72) +rxt(323)*y(110)*y(100) + loss(28) = (rxt(419)* y(55) +rxt(420)* y(56) +rxt(575)* y(107) & + + het_rates(79))* y(79) + prod(28) = (.800_r8*rxt(561)*y(88) +.900_r8*rxt(563)*y(80))*y(68) & + +rxt(565)*y(80)*y(55) + loss(22) = ((rxt(565) +rxt(566))* y(55) +rxt(564)* y(56) +rxt(563)* y(68) & + + het_rates(80))* y(80) + prod(22) =rxt(578)*y(108) +rxt(583)*y(109) + loss(64) = (rxt(280)* y(23) +rxt(281)* y(26) +rxt(282)* y(34) +rxt(284) & + * y(42) +rxt(285)* y(44) +rxt(286)* y(53) +rxt(287)* y(57) +rxt(196) & + * y(73) +rxt(161)* y(75) +rxt(179)* y(77) +rxt(249)* y(88) +rxt(232) & + * y(89) +rxt(214)* y(92) +rxt(156)* y(99) +rxt(283)* y(110) + rxt(75) & + + het_rates(81))* y(81) + prod(64) = (rxt(105)*y(60) +rxt(273)*y(101) +rxt(315)*y(98) + & + rxt(341)*y(105) +rxt(354)*y(106))*y(53) + (rxt(106)*y(63) + & + rxt(118)*y(66) +rxt(274)*y(101) +rxt(275)*y(64))*y(52) & + + (rxt(296)*y(55) +rxt(297)*y(57))*y(83) +rxt(268)*y(82) + loss(47) = (rxt(192)* y(73) +rxt(157)* y(75) +rxt(174)* y(77) +rxt(245) & + * y(88) +rxt(227)* y(89) +rxt(210)* y(92) +rxt(151)* y(99) + rxt(268) & + + het_rates(82))* y(82) + prod(47) =rxt(117)*y(66)*y(52) +rxt(283)*y(110)*y(81) + loss(60) = ((rxt(271) +rxt(293))* y(42) +rxt(295)* y(44) +rxt(296)* y(55) & + +rxt(297)* y(57) +rxt(183)* y(73) + (rxt(187) +rxt(259))* y(75) & + + (rxt(166) +rxt(261))* y(77) +rxt(236)* y(88) +rxt(218)* y(89) & + +rxt(201)* y(92) +rxt(143)* y(99) +rxt(291)* y(110) + rxt(76) & + + het_rates(83))* y(83) + prod(60) = (rxt(104)*y(60) +rxt(119)*y(64) +rxt(285)*y(81) +rxt(314)*y(98) + & + rxt(352)*y(106))*y(44) + (rxt(115)*y(66) +rxt(272)*y(101) + & + rxt(276)*y(64) +rxt(286)*y(81))*y(53) +rxt(267)*y(101)*y(52) & + +rxt(287)*y(81)*y(57) +rxt(277)*y(85) +rxt(270)*y(87) + loss(53) = (rxt(288)* y(51) +rxt(195)* y(73) +rxt(160)* y(75) +rxt(178) & + * y(77) +rxt(248)* y(88) +rxt(230)* y(89) +rxt(213)* y(92) +rxt(155) & + * y(99) + rxt(269) + het_rates(84))* y(84) + prod(53) =rxt(289)*y(110)*y(85) + loss(55) = (rxt(290)* y(44) +rxt(292)* y(51) +rxt(188)* y(73) + (rxt(231) + & + rxt(257))* y(75) + (rxt(170) +rxt(258))* y(77) +rxt(240)* y(88) & + +rxt(223)* y(89) +rxt(205)* y(92) +rxt(147)* y(99) +rxt(289)* y(110) & + + rxt(277) + het_rates(85))* y(85) + prod(55) =rxt(116)*y(66)*y(53) +rxt(291)*y(110)*y(83) +rxt(269)*y(84) + loss(49) = (rxt(294)* y(44) +rxt(193)* y(73) +rxt(158)* y(75) +rxt(175) & + * y(77) +rxt(246)* y(88) +rxt(228)* y(89) +rxt(211)* y(92) +rxt(152) & + * y(99) + het_rates(86))* y(86) + prod(49) =rxt(271)*y(83)*y(42) + loss(52) = (rxt(180)* y(73) + (rxt(141) +rxt(264))* y(75) + (rxt(162) + & + rxt(265))* y(77) +rxt(233)* y(88) +rxt(215)* y(89) +rxt(197)* y(92) & + +rxt(250)* y(99) + rxt(270) + het_rates(87))* y(87) + prod(52) = (rxt(290)*y(85) +rxt(294)*y(86) +rxt(295)*y(83))*y(44) & + + (rxt(288)*y(84) +rxt(292)*y(85))*y(51) + loss(65) = (rxt(363)* y(30) +rxt(243)* y(60) +rxt(247)* y(61) +rxt(235) & + * y(62) +rxt(234)* y(64) +rxt(241)* y(65) +rxt(244)* y(66) +rxt(239) & + * y(67) +rxt(561)* y(68) +rxt(237)* y(70) +rxt(249)* y(81) +rxt(245) & + * y(82) +rxt(236)* y(83) +rxt(248)* y(84) +rxt(240)* y(85) +rxt(246) & + * y(86) +rxt(233)* y(87) +rxt(238)* y(98) +rxt(360)* y(110) & + + rxt(365) + het_rates(88))* y(88) + prod(65) = (rxt(571) +rxt(570)*y(49) +rxt(572)*y(52))*y(99) +rxt(16)*y(52) & + +rxt(565)*y(80)*y(55) +rxt(569)*y(94)*y(56) +rxt(364)*y(91) & + +rxt(366)*y(93) +rxt(574)*y(107) + loss(66) = (rxt(225)* y(60) +rxt(229)* y(61) +rxt(217)* y(62) +rxt(216) & + * y(64) +rxt(224)* y(65) +rxt(226)* y(66) +rxt(222)* y(67) +rxt(298) & + * y(68) +rxt(219)* y(70) +rxt(232)* y(81) +rxt(227)* y(82) +rxt(218) & + * y(83) +rxt(230)* y(84) +rxt(223)* y(85) +rxt(228)* y(86) +rxt(215) & + * y(87) +rxt(221)* y(98) +rxt(362)* y(110) + het_rates(89))* y(89) + prod(66) =rxt(361)*y(110)*y(92) + loss(13) = (rxt(299)* y(68) +rxt(300)* y(110) + het_rates(90))* y(90) + prod(13) =rxt(362)*y(110)*y(89) + loss(17) = (rxt(301)* y(68) +rxt(302)* y(110) + rxt(364) + het_rates(91)) & + * y(91) + prod(17) = (rxt(307)*y(93) +rxt(363)*y(88))*y(30) + loss(69) = (rxt(304)* y(34) +rxt(207)* y(60) +rxt(212)* y(61) +rxt(200) & + * y(62) +rxt(199)* y(64) +rxt(206)* y(65) +rxt(208)* y(66) +rxt(204) & + * y(67) +rxt(303)* y(68) +rxt(202)* y(70) +rxt(305)* y(71) +rxt(214) & + * y(81) +rxt(210)* y(82) +rxt(201)* y(83) +rxt(213)* y(84) +rxt(205) & + * y(85) +rxt(211)* y(86) +rxt(197)* y(87) +rxt(203)* y(98) +rxt(306) & + * y(104) +rxt(361)* y(110) + het_rates(92))* y(92) + prod(69) = (rxt(302)*y(91) +rxt(308)*y(93) +rxt(360)*y(88))*y(110) + loss(16) = (rxt(307)* y(30) +rxt(379)* y(68) +rxt(308)* y(110) + rxt(366) & + + het_rates(93))* y(93) + prod(16) =rxt(365)*y(88) + loss(31) = (rxt(567)* y(55) + (rxt(568) +rxt(569))* y(56) + het_rates(94)) & + * y(94) + prod(31) =rxt(66)*y(49) +rxt(575)*y(107)*y(79) +rxt(584)*y(109) + loss(57) = (rxt(470)* y(6) +rxt(471)* y(7) +rxt(497)* y(8) +rxt(472)* y(9) & + +rxt(473)* y(10) +rxt(474)* y(11) +rxt(475)* y(12) +rxt(476)* y(13) & + +rxt(520)* y(14) +rxt(521)* y(16) + (rxt(533) +rxt(534) +rxt(535)) & + * y(21) +rxt(498)* y(22) +rxt(506)* y(31) +rxt(507)* y(32) +rxt(384) & + * y(35) +rxt(499)* y(36) + (rxt(500) +rxt(501))* y(38) +rxt(522) & + * y(39) +rxt(523)* y(40) +rxt(524)* y(41) + (rxt(477) +rxt(478)) & + * y(42) + (rxt(437) +rxt(438))* y(50) + (rxt(387) +rxt(388))* y(56) & + +rxt(389)* y(57) +rxt(385)* y(110) + rxt(386) + het_rates(95)) & + * y(95) + prod(57) = (rxt(6) +rxt(420)*y(79))*y(56) +rxt(7)*y(57) & + +.850_r8*rxt(562)*y(99)*y(68) +rxt(1)*y(110) + loss(34) = (rxt(391)* y(55) +rxt(392)* y(56) +rxt(316)* y(98) +rxt(334) & + * y(103) +rxt(356)* y(106) + rxt(382) + rxt(390) + het_rates(96)) & + * y(96) + prod(34) = (rxt(394) +rxt(393)*y(30) +rxt(395)*y(55) +rxt(396)*y(56) + & + rxt(397)*y(57))*y(97) +rxt(7)*y(57) + loss(8) = (rxt(393)* y(30) +rxt(395)* y(55) +rxt(396)* y(56) +rxt(397)* y(57) & + + rxt(383) + rxt(394) + het_rates(97))* y(97) + prod(8) =rxt(387)*y(95)*y(56) + loss(75) = (rxt(309)* y(23) +rxt(310)* y(26) +rxt(311)* y(30) +rxt(312) & + * y(34) +rxt(313)* y(42) +rxt(314)* y(44) +rxt(315)* y(53) & + + (rxt(319) +rxt(320))* y(55) +rxt(317)* y(56) +rxt(318)* y(57) & + +rxt(185)* y(73) +rxt(209)* y(75) +rxt(168)* y(77) +rxt(238)* y(88) & + +rxt(221)* y(89) +rxt(203)* y(92) +rxt(316)* y(96) +rxt(145)* y(99) & + + rxt(93) + rxt(132) + het_rates(98))* y(98) + prod(75) = (rxt(120)*y(64) +rxt(329)*y(101))*y(55) + (rxt(128)*y(68) + & + rxt(130)*y(68))*y(56) +rxt(65)*y(67) +rxt(97)*y(102) + loss(76) = (rxt(570)* y(49) +rxt(572)* y(52) +rxt(359)* y(56) +rxt(149) & + * y(60) +rxt(154)* y(61) +rxt(252)* y(62) +rxt(251)* y(64) +rxt(148) & + * y(65) +rxt(150)* y(66) +rxt(146)* y(67) +rxt(562)* y(68) +rxt(144) & + * y(70) +rxt(156)* y(81) +rxt(151)* y(82) +rxt(143)* y(83) +rxt(155) & + * y(84) +rxt(147)* y(85) +rxt(152)* y(86) +rxt(250)* y(87) +rxt(145) & + * y(98) +rxt(324)* y(110) + rxt(571) + het_rates(99))* y(99) + prod(76) = (rxt(86) +rxt(88) +rxt(564)*y(80) +rxt(568)*y(94) + & + rxt(576)*y(107) +rxt(580)*y(108))*y(56) + (rxt(333)*y(55) + & + rxt(334)*y(96))*y(103) +rxt(573)*y(107)*y(30) & + +2.000_r8*rxt(145)*y(99)*y(98) +rxt(94)*y(100) + loss(27) = (rxt(321)* y(68) + (rxt(322) +rxt(323))* y(110) + rxt(94) & + + het_rates(100))* y(100) + prod(27) = (rxt(324)*y(99) +rxt(332)*y(103))*y(110) + loss(48) = (rxt(325)* y(30) +rxt(326)* y(34) + (rxt(267) +rxt(274))* y(52) & + + (rxt(272) +rxt(273))* y(53) + (rxt(328) +rxt(329))* y(55) & + +rxt(327)* y(57) + rxt(95) + rxt(96) + het_rates(101))* y(101) + prod(48) = (rxt(127)*y(67) +rxt(318)*y(98) +rxt(343)*y(105) +rxt(358)*y(106)) & + *y(57) + (rxt(121)*y(64) +rxt(357)*y(106))*y(56) +rxt(331)*y(102) & + *y(55) + loss(14) = (rxt(330)* y(30) +rxt(331)* y(55) + rxt(97) + het_rates(102)) & + * y(102) + prod(14) =rxt(317)*y(98)*y(56) + loss(42) = (rxt(333)* y(55) +rxt(375)* y(68) +rxt(334)* y(96) +rxt(332) & + * y(110) + het_rates(103))* y(103) + prod(42) =rxt(359)*y(99)*y(56) + loss(62) = (rxt(493)* y(3) +rxt(509)* y(14) +rxt(527)* y(15) +rxt(511)* y(16) & + +rxt(512)* y(17) +rxt(514)* y(18) +rxt(530)* y(20) +rxt(531)* y(21) & + +rxt(516)* y(22) + (rxt(463) +rxt(464))* y(26) +rxt(461)* y(27) & + + (rxt(532) +rxt(536))* y(29) +rxt(410)* y(35) +rxt(411)* y(37) & + +rxt(495)* y(38) +rxt(517)* y(39) +rxt(518)* y(40) +rxt(519)* y(41) & + +rxt(466)* y(42) +rxt(442)* y(44) +rxt(418)* y(45) +rxt(469)* y(47) & + +rxt(335)* y(48) +rxt(433)* y(49) +rxt(344)* y(52) +rxt(441)* y(53) & + +rxt(432)* y(54) +rxt(413)* y(55) +rxt(414)* y(57) +rxt(412)* y(71) & + +rxt(306)* y(92) + 2._r8*(rxt(415) +rxt(416))* y(104) & + + het_rates(104))* y(104) + prod(62) = (rxt(401)*y(35) +rxt(402)*y(37) +rxt(407)*y(71) +rxt(465)*y(42) + & + rxt(468)*y(47) +rxt(494)*y(38) +rxt(496)*y(46) +rxt(526)*y(15))*y(55) & + + (rxt(144)*y(99) +rxt(167)*y(77) +rxt(184)*y(73) +rxt(198)*y(75) + & + rxt(202)*y(92) +rxt(219)*y(89) +rxt(237)*y(88))*y(70) + (rxt(3) + & + rxt(134)*y(69) +rxt(323)*y(100) +rxt(350)*y(106) + & + 2.000_r8*rxt(385)*y(95) +rxt(504)*y(33))*y(110) & + + (2.000_r8*rxt(404)*y(34) +rxt(408)*y(57) +rxt(429)*y(54) + & + rxt(434)*y(52) +rxt(450)*y(23))*y(71) + (rxt(98) +rxt(336)*y(23) + & + rxt(337)*y(26) +rxt(341)*y(53) +rxt(343)*y(57))*y(105) & + + (rxt(533)*y(21) +rxt(384)*y(35) +rxt(477)*y(42) +rxt(500)*y(38)) & + *y(95) + (rxt(9) +rxt(119)*y(64) +rxt(352)*y(106))*y(44) + (rxt(23) + & + .300_r8*rxt(530)*y(104))*y(20) + (rxt(124)*y(67) +rxt(409)*y(57)) & + *y(34) +2.000_r8*rxt(4)*y(37) +rxt(351)*y(106)*y(42) +rxt(10)*y(45) & + +rxt(58)*y(46) +rxt(59)*y(47) +rxt(12)*y(48) +.500_r8*rxt(539)*y(53) & + +rxt(133)*y(69)*y(68) + loss(82) = (rxt(336)* y(23) +rxt(337)* y(26) +rxt(338)* y(30) +rxt(339) & + * y(34) +rxt(340)* y(42) +rxt(341)* y(53) +rxt(342)* y(55) +rxt(343) & + * y(57) + rxt(98) + het_rates(105))* y(105) + prod(82) = (rxt(112)*y(64) +rxt(282)*y(81) +rxt(326)*y(101))*y(34) & + + (rxt(349)*y(35) +rxt(350)*y(110))*y(106) + loss(83) = (rxt(345)* y(23) +rxt(346)* y(26) +rxt(347)* y(30) + (rxt(348) + & + rxt(349))* y(35) +rxt(351)* y(42) +rxt(352)* y(44) +rxt(131)* y(52) & + +rxt(354)* y(53) +rxt(355)* y(55) +rxt(357)* y(56) +rxt(358)* y(57) & + +rxt(356)* y(96) +rxt(350)* y(110) + rxt(99) + rxt(353) & + + het_rates(106))* y(106) + prod(83) =rxt(320)*y(98)*y(55) +rxt(129)*y(68)*y(57) +rxt(63)*y(64) +rxt(95) & + *y(101) + loss(35) = (rxt(573)* y(30) +rxt(576)* y(56) +rxt(575)* y(79) + rxt(574) & + + het_rates(107))* y(107) + prod(35) = (rxt(78) +rxt(79) +rxt(566)*y(80) +rxt(567)*y(94) + & + rxt(579)*y(108) +rxt(585)*y(109))*y(55) + (rxt(85) +rxt(87))*y(56) & + + (rxt(577)*y(108) +rxt(582)*y(109))*y(68) +rxt(559)*y(108) & + +rxt(558)*y(109) + loss(19) = (rxt(579)* y(55) +rxt(580)* y(56) +rxt(577)* y(68) + rxt(559) & + + rxt(578) + het_rates(108))* y(108) + prod(19) = (rxt(80) +rxt(81))*y(55) + (rxt(90) +rxt(91))*y(56) + (rxt(560) + & + rxt(581)*y(68))*y(109) + loss(18) = (rxt(585)* y(55) + (rxt(581) +rxt(582))* y(68) + rxt(558) & + + rxt(560) + rxt(583) + rxt(584) + het_rates(109))* y(109) + prod(18) = (rxt(77) +rxt(82))*y(55) + (rxt(83) +rxt(92))*y(56) + loss(87) = (rxt(504)* y(33) +rxt(102)* y(60) +rxt(114)* y(64) +rxt(113) & + * y(66) +rxt(134)* y(69) +rxt(369)* y(72) +rxt(371)* y(73) +rxt(135) & + * y(74) +rxt(373)* y(75) +rxt(138)* y(76) +rxt(367)* y(78) +rxt(283) & + * y(81) +rxt(291)* y(83) +rxt(289)* y(85) +rxt(360)* y(88) +rxt(362) & + * y(89) +rxt(300)* y(90) +rxt(302)* y(91) +rxt(361)* y(92) +rxt(308) & + * y(93) +rxt(385)* y(95) +rxt(324)* y(99) + (rxt(322) +rxt(323)) & + * y(100) +rxt(332)* y(103) +rxt(350)* y(106) + rxt(1) + rxt(2) & + + rxt(3) + het_rates(110))* y(110) + prod(87) = (rxt(372) +4.000_r8*rxt(136)*y(68) +4.000_r8*rxt(141)*y(87) + & + 4.000_r8*rxt(142)*y(60) +5.000_r8*rxt(153)*y(66) + & + 5.000_r8*rxt(157)*y(82) +4.000_r8*rxt(158)*y(86) + & + 5.000_r8*rxt(159)*y(61) +6.000_r8*rxt(160)*y(84) + & + 4.000_r8*rxt(161)*y(81) +4.000_r8*rxt(165)*y(64) + & + 4.000_r8*rxt(176)*y(62) +4.000_r8*rxt(187)*y(83) + & + 4.000_r8*rxt(198)*y(70) +4.000_r8*rxt(209)*y(98) + & + 4.000_r8*rxt(220)*y(67) +5.000_r8*rxt(231)*y(85) + & + 6.000_r8*rxt(242)*y(65) +4.000_r8*rxt(253)*y(64) + & + 5.000_r8*rxt(255)*y(66) +5.000_r8*rxt(257)*y(85) + & + 4.000_r8*rxt(259)*y(83) +4.000_r8*rxt(262)*y(62) + & + 4.000_r8*rxt(264)*y(87) +6.000_r8*rxt(266)*y(65))*y(75) + (rxt(374) + & + 5.000_r8*rxt(139)*y(68) +5.000_r8*rxt(162)*y(87) + & + 5.000_r8*rxt(163)*y(64) +5.000_r8*rxt(164)*y(62) + & + 5.000_r8*rxt(166)*y(83) +5.000_r8*rxt(167)*y(70) + & + 5.000_r8*rxt(168)*y(98) +5.000_r8*rxt(169)*y(67) + & + 6.000_r8*rxt(170)*y(85) +7.000_r8*rxt(171)*y(65) + & + 5.000_r8*rxt(172)*y(60) +6.000_r8*rxt(173)*y(66) + & + 6.000_r8*rxt(174)*y(82) +5.000_r8*rxt(175)*y(86) + & + 6.000_r8*rxt(177)*y(61) +7.000_r8*rxt(178)*y(84) + & + 5.000_r8*rxt(179)*y(81) +7.000_r8*rxt(254)*y(65) + & + 6.000_r8*rxt(256)*y(66) +6.000_r8*rxt(258)*y(85) + & + 5.000_r8*rxt(260)*y(64) +5.000_r8*rxt(261)*y(83) + & + 5.000_r8*rxt(263)*y(62) +5.000_r8*rxt(265)*y(87))*y(77) + (rxt(370) + & + 3.000_r8*rxt(180)*y(87) +3.000_r8*rxt(181)*y(64) + & + 3.000_r8*rxt(182)*y(62) +3.000_r8*rxt(183)*y(83) + & + 3.000_r8*rxt(184)*y(70) +3.000_r8*rxt(185)*y(98) + & + 3.000_r8*rxt(186)*y(67) +4.000_r8*rxt(188)*y(85) + & + 5.000_r8*rxt(189)*y(65) +3.000_r8*rxt(190)*y(60) + & + 4.000_r8*rxt(191)*y(66) +4.000_r8*rxt(192)*y(82) + & + 3.000_r8*rxt(193)*y(86) +4.000_r8*rxt(194)*y(61) + & + 5.000_r8*rxt(195)*y(84) +3.000_r8*rxt(196)*y(81) + & + 3.000_r8*rxt(378)*y(68))*y(73) + (rxt(509)*y(14) +rxt(511)*y(16) + & + rxt(512)*y(17) +rxt(514)*y(18) +rxt(519)*y(41) +rxt(531)*y(21) + & + rxt(335)*y(48) +rxt(410)*y(35) +rxt(411)*y(37) +rxt(412)*y(71) + & + rxt(415)*y(104) +rxt(418)*y(45) +rxt(442)*y(44) +rxt(466)*y(42) + & + rxt(469)*y(47) +rxt(495)*y(38) +rxt(527)*y(15) +rxt(530)*y(20)) & + *y(104) + (2.000_r8*rxt(215)*y(87) +2.000_r8*rxt(216)*y(64) + & + 2.000_r8*rxt(217)*y(62) +2.000_r8*rxt(218)*y(83) + & + 2.000_r8*rxt(219)*y(70) +2.000_r8*rxt(221)*y(98) + & + 2.000_r8*rxt(222)*y(67) +3.000_r8*rxt(223)*y(85) + & + 4.000_r8*rxt(224)*y(65) +2.000_r8*rxt(225)*y(60) + & + 3.000_r8*rxt(226)*y(66) +3.000_r8*rxt(227)*y(82) + & + 2.000_r8*rxt(228)*y(86) +3.000_r8*rxt(229)*y(61) + & + 4.000_r8*rxt(230)*y(84) +2.000_r8*rxt(232)*y(81) + & + 2.000_r8*rxt(298)*y(68))*y(89) + (rxt(197)*y(87) +rxt(199)*y(64) + & + rxt(200)*y(62) +rxt(201)*y(83) +rxt(202)*y(70) +rxt(203)*y(98) + & + rxt(204)*y(67) +2.000_r8*rxt(205)*y(85) +3.000_r8*rxt(206)*y(65) + & + rxt(207)*y(60) +2.000_r8*rxt(208)*y(66) +2.000_r8*rxt(210)*y(82) + & + rxt(211)*y(86) +2.000_r8*rxt(212)*y(61) +3.000_r8*rxt(213)*y(84) + & + rxt(214)*y(81) +rxt(303)*y(68))*y(92) + (rxt(101)*y(61) + & + rxt(340)*y(105) +rxt(542)*y(47) +rxt(548)*y(47) +rxt(549)*y(46) + & + rxt(553)*y(47) +rxt(554)*y(46))*y(42) + (rxt(64) +rxt(278) + & + rxt(115)*y(53) +rxt(118)*y(52) +rxt(150)*y(99) +rxt(244)*y(88))*y(66) & + + (rxt(133)*y(69) +3.000_r8*rxt(299)*y(90) +rxt(321)*y(100) + & + rxt(376)*y(78) +2.000_r8*rxt(377)*y(72))*y(68) + (rxt(240)*y(85) + & + 2.000_r8*rxt(241)*y(65) +rxt(245)*y(82) +rxt(247)*y(61) + & + 2.000_r8*rxt(248)*y(84))*y(88) + (rxt(147)*y(85) + & + 2.000_r8*rxt(148)*y(65) +rxt(151)*y(82) +rxt(154)*y(61) + & + 2.000_r8*rxt(155)*y(84))*y(99) + (rxt(339)*y(105) +rxt(405)*y(71)) & + *y(34) + (rxt(269) +rxt(288)*y(51))*y(84) + (rxt(277) + & + rxt(290)*y(44))*y(85) +rxt(348)*y(106)*y(35) +rxt(380)*y(61) & + +rxt(279)*y(65) +rxt(368)*y(72) +rxt(268)*y(82) +rxt(94)*y(100) end subroutine imp_prod_loss end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_mad/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_mad/mo_rxt_rates_conv.F90 index f13926d22e..8276f8a82f 100644 --- a/src/chemistry/pp_waccm_mad/mo_rxt_rates_conv.F90 +++ b/src/chemistry/pp_waccm_mad/mo_rxt_rates_conv.F90 @@ -11,69 +11,69 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 110) ! rate_const*H2O rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 110) ! rate_const*H2O rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 110) ! rate_const*H2O - rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 35) ! rate_const*H2O2 - rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 55) ! rate_const*O2 - rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 55) ! rate_const*O2 - rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 56) ! rate_const*O3 - rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 56) ! rate_const*O3 - rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 42) ! rate_const*HNO3 - rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 44) ! rate_const*HO2NO2 - rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 44) ! rate_const*HO2NO2 - rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 47) ! rate_const*HONO - rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 49) ! rate_const*N2O - rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 50) ! rate_const*N2O5 - rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 50) ! rate_const*N2O5 - rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 51) ! rate_const*NO - rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 51) ! rate_const*NO - rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 52) ! rate_const*NO2 - rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 53) ! rate_const*NO3 - rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 53) ! rate_const*NO3 - rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 14) ! rate_const*CH2O - rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 14) ! rate_const*CH2O - rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 19) ! rate_const*CH3OOH - rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 20) ! rate_const*CH4 - rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 20) ! rate_const*CH4 - rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 28) ! rate_const*CO2 - rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 1) ! rate_const*BRCL - rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 2) ! rate_const*BRO - rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 3) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 3) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 5) ! rate_const*CCL4 - rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 6) ! rate_const*CF2CLBR - rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 7) ! rate_const*CF3BR - rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 8) ! rate_const*CFC11 - rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 9) ! rate_const*CFC113 - rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 10) ! rate_const*CFC114 - rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 11) ! rate_const*CFC115 - rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 12) ! rate_const*CFC12 - rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 13) ! rate_const*CH2BR2 - rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 15) ! rate_const*CH3BR - rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 16) ! rate_const*CH3CCL3 - rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 17) ! rate_const*CH3CL - rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 21) ! rate_const*CHBR3 - rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 22) ! rate_const*CL2 - rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 23) ! rate_const*CL2O2 - rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 24) ! rate_const*CLO - rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 25) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 25) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 29) ! rate_const*COF2 - rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 30) ! rate_const*COFCL - rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 34) ! rate_const*H2402 - rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 36) ! rate_const*HBR - rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 37) ! rate_const*HCFC141B - rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 38) ! rate_const*HCFC142B - rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 39) ! rate_const*HCFC22 - rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 40) ! rate_const*HCL - rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 41) ! rate_const*HF - rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 45) ! rate_const*HOBR - rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 46) ! rate_const*HOCL - rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 57) ! rate_const*OCLO - rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 58) ! rate_const*SF6 - rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 28) ! rate_const*CO2 - rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 65) ! rate_const*CO3m - rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 67) ! rate_const*CO3m_H2O - rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 68) ! rate_const*CO4m - rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 48) ! rate_const*N + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 37) ! rate_const*H2O2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 56) ! rate_const*O2 + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 56) ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 57) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 57) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 44) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 45) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 45) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 48) ! rate_const*HONO + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 50) ! rate_const*N2O + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 51) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 51) ! rate_const*N2O5 + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 52) ! rate_const*NO + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 52) ! rate_const*NO + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 53) ! rate_const*NO2 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 54) ! rate_const*NO3 + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 54) ! rate_const*NO3 + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 15) ! rate_const*CH2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 15) ! rate_const*CH2O + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 20) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 21) ! rate_const*CH4 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 21) ! rate_const*CH4 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 30) ! rate_const*CO2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 2) ! rate_const*BRCL + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 3) ! rate_const*BRO + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 6) ! rate_const*CCL4 + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 7) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 8) ! rate_const*CF3BR + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 9) ! rate_const*CFC11 + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 10) ! rate_const*CFC113 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 11) ! rate_const*CFC114 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 12) ! rate_const*CFC115 + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 13) ! rate_const*CFC12 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 14) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 16) ! rate_const*CH3BR + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 17) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 18) ! rate_const*CH3CL + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 22) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 24) ! rate_const*CL2 + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 25) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 26) ! rate_const*CLO + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 31) ! rate_const*COF2 + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 32) ! rate_const*COFCL + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 36) ! rate_const*H2402 + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 38) ! rate_const*HBR + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 39) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 40) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 41) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 42) ! rate_const*HCL + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 43) ! rate_const*HF + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 46) ! rate_const*HOBR + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 47) ! rate_const*HOCL + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 58) ! rate_const*OCLO + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 59) ! rate_const*SF6 + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 30) ! rate_const*CO2 + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 64) ! rate_const*CO3m + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 66) ! rate_const*CO3m_H2O + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 67) ! rate_const*CO4m + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 49) ! rate_const*N ! rate_const*N2 ! rate_const*N2 ! rate_const*N2 @@ -84,22 +84,22 @@ subroutine set_rates( rxt_rates, sol, ncol ) ! rate_const*N2 rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 81) ! rate_const*NO2m rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 83) ! rate_const*NO3m - rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 54) ! rate_const*O - rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 54) ! rate_const*O - rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 54) ! rate_const*O - rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 54) ! rate_const*O - rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 54) ! rate_const*O - rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 54) ! rate_const*O - rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 55) ! rate_const*O2 - rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 55) ! rate_const*O2 - rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 55) ! rate_const*O2 - rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 55) ! rate_const*O2 - rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 55) ! rate_const*O2 - rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 55) ! rate_const*O2 - rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 55) ! rate_const*O2 - rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 55) ! rate_const*O2 - rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 55) ! rate_const*O2 - rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 55) ! rate_const*O2 + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 55) ! rate_const*O + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 55) ! rate_const*O + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 55) ! rate_const*O + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 55) ! rate_const*O + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 55) ! rate_const*O + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 55) ! rate_const*O + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 56) ! rate_const*O2 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 56) ! rate_const*O2 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 56) ! rate_const*O2 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 56) ! rate_const*O2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 56) ! rate_const*O2 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 56) ! rate_const*O2 + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 56) ! rate_const*O2 + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 56) ! rate_const*O2 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 56) ! rate_const*O2 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 56) ! rate_const*O2 rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 98) ! rate_const*O2m rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 100) ! rate_const*O2p_H2O rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 101) ! rate_const*O3m @@ -107,270 +107,270 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 102) ! rate_const*O4m rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 105) ! rate_const*OHm rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 106) ! rate_const*Om - rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 61)*sol(:ncol,:, 32) ! rate_const*CLm*H - rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 62)*sol(:ncol,:, 40) ! rate_const*CLm_H2O*HCL - rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 61)*sol(:ncol,:, 110) ! rate_const*M*CLm*H2O - rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 40)*sol(:ncol,:, 61) ! rate_const*M*HCL*CLm - rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 61)*sol(:ncol,:, 42) ! rate_const*CLm*HNO3 - rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 61)*sol(:ncol,:, 52) ! rate_const*CLm*NO2 - rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 64)*sol(:ncol,:, 51) ! rate_const*CLOm*NO - rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 64)*sol(:ncol,:, 51) ! rate_const*CLOm*NO - rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 64)*sol(:ncol,:, 54) ! rate_const*CLOm*O - rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 60)*sol(:ncol,:, 65) ! rate_const*CL*CO3m - rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 60)*sol(:ncol,:, 65) ! rate_const*CL*CO3m - rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 24)*sol(:ncol,:, 65) ! rate_const*CLO*CO3m - rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 32)*sol(:ncol,:, 65) ! rate_const*H*CO3m - rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 67)*sol(:ncol,:, 110) ! rate_const*M*CO3m_H2O*H2O - rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 65)*sol(:ncol,:, 110) ! rate_const*M*CO3m*H2O - rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 67)*sol(:ncol,:, 52) ! rate_const*CO3m_H2O*NO2 - rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 67)*sol(:ncol,:, 52) ! rate_const*CO3m_H2O*NO2 - rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 67)*sol(:ncol,:, 51) ! rate_const*CO3m_H2O*NO - rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 67)*sol(:ncol,:, 51) ! rate_const*CO3m_H2O*NO - rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 65)*sol(:ncol,:, 42) ! rate_const*CO3m*HNO3 - rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 65)*sol(:ncol,:, 54) ! rate_const*CO3m*O - rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 55)*sol(:ncol,:, 65) ! rate_const*O2*CO3m - rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 60)*sol(:ncol,:, 68) ! rate_const*CL*CO4m - rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 24)*sol(:ncol,:, 68) ! rate_const*CLO*CO4m - rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 68)*sol(:ncol,:, 32) ! rate_const*CO4m*H - rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 68)*sol(:ncol,:, 40) ! rate_const*CO4m*HCL - rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 68)*sol(:ncol,:, 54) ! rate_const*CO4m*O - rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 68)*sol(:ncol,:, 56) ! rate_const*CO4m*O3 - rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 69)*sol(:ncol,:, 55) ! rate_const*N2*e*O2 - rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 56)*sol(:ncol,:, 69) ! rate_const*O3*e - rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 55)*sol(:ncol,:, 69) ! rate_const*M*O2*e - rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 51)*sol(:ncol,:, 106) ! rate_const*NO*Om + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 60)*sol(:ncol,:, 34) ! rate_const*CLm*H + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 61)*sol(:ncol,:, 42) ! rate_const*CLm_H2O*HCL + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 60)*sol(:ncol,:, 110) ! rate_const*M*CLm*H2O + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 42)*sol(:ncol,:, 60) ! rate_const*M*HCL*CLm + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 60)*sol(:ncol,:, 44) ! rate_const*CLm*HNO3 + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 60)*sol(:ncol,:, 53) ! rate_const*CLm*NO2 + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 63)*sol(:ncol,:, 52) ! rate_const*CLOm*NO + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 63)*sol(:ncol,:, 52) ! rate_const*CLOm*NO + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 63)*sol(:ncol,:, 55) ! rate_const*CLOm*O + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 23)*sol(:ncol,:, 64) ! rate_const*CL*CO3m + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 23)*sol(:ncol,:, 64) ! rate_const*CL*CO3m + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 26)*sol(:ncol,:, 64) ! rate_const*CLO*CO3m + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 34)*sol(:ncol,:, 64) ! rate_const*H*CO3m + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 66)*sol(:ncol,:, 110) ! rate_const*M*CO3m_H2O*H2O + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 64)*sol(:ncol,:, 110) ! rate_const*M*CO3m*H2O + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 66)*sol(:ncol,:, 53) ! rate_const*CO3m_H2O*NO2 + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 66)*sol(:ncol,:, 53) ! rate_const*CO3m_H2O*NO2 + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 66)*sol(:ncol,:, 52) ! rate_const*CO3m_H2O*NO + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 66)*sol(:ncol,:, 52) ! rate_const*CO3m_H2O*NO + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 64)*sol(:ncol,:, 44) ! rate_const*CO3m*HNO3 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 64)*sol(:ncol,:, 55) ! rate_const*CO3m*O + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 56)*sol(:ncol,:, 64) ! rate_const*O2*CO3m + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 23)*sol(:ncol,:, 67) ! rate_const*CL*CO4m + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 26)*sol(:ncol,:, 67) ! rate_const*CLO*CO4m + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 67)*sol(:ncol,:, 34) ! rate_const*CO4m*H + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 67)*sol(:ncol,:, 42) ! rate_const*CO4m*HCL + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 67)*sol(:ncol,:, 55) ! rate_const*CO4m*O + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 67)*sol(:ncol,:, 57) ! rate_const*CO4m*O3 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 68)*sol(:ncol,:, 56) ! rate_const*N2*e*O2 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 57)*sol(:ncol,:, 68) ! rate_const*O3*e + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 56)*sol(:ncol,:, 68) ! rate_const*M*O2*e + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 52)*sol(:ncol,:, 106) ! rate_const*NO*Om rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 98) ! rate_const*N2*O2m - rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 70)*sol(:ncol,:, 69) ! rate_const*H3Op_OH*e - rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 110)*sol(:ncol,:, 70) ! rate_const*H2O*H3Op_OH + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 69)*sol(:ncol,:, 68) ! rate_const*H3Op_OH*e + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 110)*sol(:ncol,:, 69) ! rate_const*H2O*H3Op_OH rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 110)*sol(:ncol,:, 74) ! rate_const*H2O*Hp_3N1 - rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 75)*sol(:ncol,:, 69) ! rate_const*Hp_4H2O*e - rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 75)*sol(:ncol,:, 50) ! rate_const*Hp_4H2O*N2O5 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 75)*sol(:ncol,:, 68) ! rate_const*Hp_4H2O*e + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 75)*sol(:ncol,:, 51) ! rate_const*Hp_4H2O*N2O5 rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 110)*sol(:ncol,:, 76) ! rate_const*H2O*Hp_4N1 - rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 77)*sol(:ncol,:, 69) ! rate_const*Hp_5H2O*e - rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 77)*sol(:ncol,:, 50) ! rate_const*Hp_5H2O*N2O5 + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 77)*sol(:ncol,:, 68) ! rate_const*Hp_5H2O*e + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 77)*sol(:ncol,:, 51) ! rate_const*Hp_5H2O*N2O5 rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 75)*sol(:ncol,:, 87) ! rate_const*Hp_4H2O*NO3mHNO3 - rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 61)*sol(:ncol,:, 75) ! rate_const*CLm*Hp_4H2O + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 60)*sol(:ncol,:, 75) ! rate_const*CLm*Hp_4H2O rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 83)*sol(:ncol,:, 99) ! rate_const*NO3m*O2p - rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 71)*sol(:ncol,:, 99) ! rate_const*HCO3m*O2p + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 70)*sol(:ncol,:, 99) ! rate_const*HCO3m*O2p rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 98)*sol(:ncol,:, 99) ! rate_const*O2m*O2p - rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 68)*sol(:ncol,:, 99) ! rate_const*CO4m*O2p + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 67)*sol(:ncol,:, 99) ! rate_const*CO4m*O2p rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 85)*sol(:ncol,:, 99) ! rate_const*NO3m_H2O*O2p - rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 66)*sol(:ncol,:, 99) ! rate_const*CO3m2H2O*O2p - rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 61)*sol(:ncol,:, 99) ! rate_const*CLm*O2p - rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 67)*sol(:ncol,:, 99) ! rate_const*CO3m_H2O*O2p + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 65)*sol(:ncol,:, 99) ! rate_const*CO3m2H2O*O2p + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 60)*sol(:ncol,:, 99) ! rate_const*CLm*O2p + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 66)*sol(:ncol,:, 99) ! rate_const*CO3m_H2O*O2p rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 82)*sol(:ncol,:, 99) ! rate_const*NO2m_H2O*O2p rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 86)*sol(:ncol,:, 99) ! rate_const*NO3m_HCL*O2p - rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 67)*sol(:ncol,:, 75) ! rate_const*CO3m_H2O*Hp_4H2O - rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 99)*sol(:ncol,:, 62) ! rate_const*O2p*CLm_H2O + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 66)*sol(:ncol,:, 75) ! rate_const*CO3m_H2O*Hp_4H2O + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 99)*sol(:ncol,:, 61) ! rate_const*O2p*CLm_H2O rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 84)*sol(:ncol,:, 99) ! rate_const*NO3m2H2O*O2p rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 81)*sol(:ncol,:, 99) ! rate_const*NO2m*O2p rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 75)*sol(:ncol,:, 82) ! rate_const*Hp_4H2O*NO2m_H2O rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 75)*sol(:ncol,:, 86) ! rate_const*Hp_4H2O*NO3m_HCL - rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 62)*sol(:ncol,:, 75) ! rate_const*CLm_H2O*Hp_4H2O + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 61)*sol(:ncol,:, 75) ! rate_const*CLm_H2O*Hp_4H2O rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 84)*sol(:ncol,:, 75) ! rate_const*NO3m2H2O*Hp_4H2O rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 75)*sol(:ncol,:, 81) ! rate_const*Hp_4H2O*NO2m rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 77)*sol(:ncol,:, 87) ! rate_const*Hp_5H2O*NO3mHNO3 - rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 65)*sol(:ncol,:, 77) ! rate_const*CO3m*Hp_5H2O - rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 63)*sol(:ncol,:, 77) ! rate_const*CLm_HCL*Hp_5H2O - rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 65)*sol(:ncol,:, 75) ! rate_const*CO3m*Hp_4H2O + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 64)*sol(:ncol,:, 77) ! rate_const*CO3m*Hp_5H2O + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 62)*sol(:ncol,:, 77) ! rate_const*CLm_HCL*Hp_5H2O + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 64)*sol(:ncol,:, 75) ! rate_const*CO3m*Hp_4H2O rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 83)*sol(:ncol,:, 77) ! rate_const*NO3m*Hp_5H2O - rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 71)*sol(:ncol,:, 77) ! rate_const*HCO3m*Hp_5H2O + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 70)*sol(:ncol,:, 77) ! rate_const*HCO3m*Hp_5H2O rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 77)*sol(:ncol,:, 98) ! rate_const*Hp_5H2O*O2m - rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 68)*sol(:ncol,:, 77) ! rate_const*CO4m*Hp_5H2O + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 67)*sol(:ncol,:, 77) ! rate_const*CO4m*Hp_5H2O rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 77)*sol(:ncol,:, 85) ! rate_const*Hp_5H2O*NO3m_H2O - rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 66)*sol(:ncol,:, 77) ! rate_const*CO3m2H2O*Hp_5H2O - rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 61)*sol(:ncol,:, 77) ! rate_const*CLm*Hp_5H2O - rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 67)*sol(:ncol,:, 77) ! rate_const*CO3m_H2O*Hp_5H2O + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 65)*sol(:ncol,:, 77) ! rate_const*CO3m2H2O*Hp_5H2O + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 60)*sol(:ncol,:, 77) ! rate_const*CLm*Hp_5H2O + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 66)*sol(:ncol,:, 77) ! rate_const*CO3m_H2O*Hp_5H2O rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 82)*sol(:ncol,:, 77) ! rate_const*NO2m_H2O*Hp_5H2O rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 77)*sol(:ncol,:, 86) ! rate_const*Hp_5H2O*NO3m_HCL - rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 63)*sol(:ncol,:, 75) ! rate_const*CLm_HCL*Hp_4H2O - rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 62)*sol(:ncol,:, 77) ! rate_const*CLm_H2O*Hp_5H2O + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 62)*sol(:ncol,:, 75) ! rate_const*CLm_HCL*Hp_4H2O + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 61)*sol(:ncol,:, 77) ! rate_const*CLm_H2O*Hp_5H2O rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 77)*sol(:ncol,:, 84) ! rate_const*Hp_5H2O*NO3m2H2O rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 77)*sol(:ncol,:, 81) ! rate_const*Hp_5H2O*NO2m rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 73)*sol(:ncol,:, 87) ! rate_const*Hp_3H2O*NO3mHNO3 - rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 73)*sol(:ncol,:, 65) ! rate_const*Hp_3H2O*CO3m - rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 63)*sol(:ncol,:, 73) ! rate_const*CLm_HCL*Hp_3H2O + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 73)*sol(:ncol,:, 64) ! rate_const*Hp_3H2O*CO3m + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 62)*sol(:ncol,:, 73) ! rate_const*CLm_HCL*Hp_3H2O rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 73)*sol(:ncol,:, 83) ! rate_const*Hp_3H2O*NO3m - rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 71)*sol(:ncol,:, 73) ! rate_const*HCO3m*Hp_3H2O + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 70)*sol(:ncol,:, 73) ! rate_const*HCO3m*Hp_3H2O rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 73)*sol(:ncol,:, 98) ! rate_const*Hp_3H2O*O2m - rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 68)*sol(:ncol,:, 73) ! rate_const*CO4m*Hp_3H2O + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 67)*sol(:ncol,:, 73) ! rate_const*CO4m*Hp_3H2O rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 75)*sol(:ncol,:, 83) ! rate_const*Hp_4H2O*NO3m rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 73)*sol(:ncol,:, 85) ! rate_const*Hp_3H2O*NO3m_H2O - rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 66)*sol(:ncol,:, 73) ! rate_const*CO3m2H2O*Hp_3H2O - rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 61)*sol(:ncol,:, 73) ! rate_const*CLm*Hp_3H2O - rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 67)*sol(:ncol,:, 73) ! rate_const*CO3m_H2O*Hp_3H2O + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 65)*sol(:ncol,:, 73) ! rate_const*CO3m2H2O*Hp_3H2O + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 60)*sol(:ncol,:, 73) ! rate_const*CLm*Hp_3H2O + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 66)*sol(:ncol,:, 73) ! rate_const*CO3m_H2O*Hp_3H2O rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 73)*sol(:ncol,:, 82) ! rate_const*Hp_3H2O*NO2m_H2O rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 73)*sol(:ncol,:, 86) ! rate_const*Hp_3H2O*NO3m_HCL - rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 62)*sol(:ncol,:, 73) ! rate_const*CLm_H2O*Hp_3H2O + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 61)*sol(:ncol,:, 73) ! rate_const*CLm_H2O*Hp_3H2O rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 73)*sol(:ncol,:, 84) ! rate_const*Hp_3H2O*NO3m2H2O rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 73)*sol(:ncol,:, 81) ! rate_const*Hp_3H2O*NO2m rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 87)*sol(:ncol,:, 92) ! rate_const*NO3mHNO3*NOp_H2O - rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 71)*sol(:ncol,:, 75) ! rate_const*HCO3m*Hp_4H2O - rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 65)*sol(:ncol,:, 92) ! rate_const*CO3m*NOp_H2O - rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 63)*sol(:ncol,:, 92) ! rate_const*CLm_HCL*NOp_H2O + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 70)*sol(:ncol,:, 75) ! rate_const*HCO3m*Hp_4H2O + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 64)*sol(:ncol,:, 92) ! rate_const*CO3m*NOp_H2O + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 62)*sol(:ncol,:, 92) ! rate_const*CLm_HCL*NOp_H2O rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 83)*sol(:ncol,:, 92) ! rate_const*NO3m*NOp_H2O - rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 71)*sol(:ncol,:, 92) ! rate_const*HCO3m*NOp_H2O + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 70)*sol(:ncol,:, 92) ! rate_const*HCO3m*NOp_H2O rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 92)*sol(:ncol,:, 98) ! rate_const*NOp_H2O*O2m - rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 68)*sol(:ncol,:, 92) ! rate_const*CO4m*NOp_H2O + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 67)*sol(:ncol,:, 92) ! rate_const*CO4m*NOp_H2O rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 85)*sol(:ncol,:, 92) ! rate_const*NO3m_H2O*NOp_H2O - rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 66)*sol(:ncol,:, 92) ! rate_const*CO3m2H2O*NOp_H2O - rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 61)*sol(:ncol,:, 92) ! rate_const*CLm*NOp_H2O - rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 67)*sol(:ncol,:, 92) ! rate_const*CO3m_H2O*NOp_H2O + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 65)*sol(:ncol,:, 92) ! rate_const*CO3m2H2O*NOp_H2O + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 60)*sol(:ncol,:, 92) ! rate_const*CLm*NOp_H2O + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 66)*sol(:ncol,:, 92) ! rate_const*CO3m_H2O*NOp_H2O rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 75)*sol(:ncol,:, 98) ! rate_const*Hp_4H2O*O2m rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 82)*sol(:ncol,:, 92) ! rate_const*NO2m_H2O*NOp_H2O rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 86)*sol(:ncol,:, 92) ! rate_const*NO3m_HCL*NOp_H2O - rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 62)*sol(:ncol,:, 92) ! rate_const*CLm_H2O*NOp_H2O + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 61)*sol(:ncol,:, 92) ! rate_const*CLm_H2O*NOp_H2O rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 84)*sol(:ncol,:, 92) ! rate_const*NO3m2H2O*NOp_H2O rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 81)*sol(:ncol,:, 92) ! rate_const*NO2m*NOp_H2O rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 87)*sol(:ncol,:, 89) ! rate_const*NO3mHNO3*NOp_2H2O - rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 65)*sol(:ncol,:, 89) ! rate_const*CO3m*NOp_2H2O - rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 63)*sol(:ncol,:, 89) ! rate_const*CLm_HCL*NOp_2H2O + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 64)*sol(:ncol,:, 89) ! rate_const*CO3m*NOp_2H2O + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 62)*sol(:ncol,:, 89) ! rate_const*CLm_HCL*NOp_2H2O rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 89)*sol(:ncol,:, 83) ! rate_const*NOp_2H2O*NO3m - rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 71)*sol(:ncol,:, 89) ! rate_const*HCO3m*NOp_2H2O - rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 68)*sol(:ncol,:, 75) ! rate_const*CO4m*Hp_4H2O + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 70)*sol(:ncol,:, 89) ! rate_const*HCO3m*NOp_2H2O + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 67)*sol(:ncol,:, 75) ! rate_const*CO4m*Hp_4H2O rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 89)*sol(:ncol,:, 98) ! rate_const*NOp_2H2O*O2m - rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 89)*sol(:ncol,:, 68) ! rate_const*NOp_2H2O*CO4m + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 89)*sol(:ncol,:, 67) ! rate_const*NOp_2H2O*CO4m rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 85)*sol(:ncol,:, 89) ! rate_const*NO3m_H2O*NOp_2H2O - rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 66)*sol(:ncol,:, 89) ! rate_const*CO3m2H2O*NOp_2H2O - rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 61)*sol(:ncol,:, 89) ! rate_const*CLm*NOp_2H2O - rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 67)*sol(:ncol,:, 89) ! rate_const*CO3m_H2O*NOp_2H2O + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 65)*sol(:ncol,:, 89) ! rate_const*CO3m2H2O*NOp_2H2O + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 60)*sol(:ncol,:, 89) ! rate_const*CLm*NOp_2H2O + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 66)*sol(:ncol,:, 89) ! rate_const*CO3m_H2O*NOp_2H2O rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 89)*sol(:ncol,:, 82) ! rate_const*NOp_2H2O*NO2m_H2O rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 86)*sol(:ncol,:, 89) ! rate_const*NO3m_HCL*NOp_2H2O - rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 89)*sol(:ncol,:, 62) ! rate_const*NOp_2H2O*CLm_H2O + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 89)*sol(:ncol,:, 61) ! rate_const*NOp_2H2O*CLm_H2O rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 89)*sol(:ncol,:, 84) ! rate_const*NOp_2H2O*NO3m2H2O rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 75)*sol(:ncol,:, 85) ! rate_const*Hp_4H2O*NO3m_H2O rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 89)*sol(:ncol,:, 81) ! rate_const*NOp_2H2O*NO2m rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 88)*sol(:ncol,:, 87) ! rate_const*NOp*NO3mHNO3 - rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 88)*sol(:ncol,:, 65) ! rate_const*NOp*CO3m - rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 88)*sol(:ncol,:, 63) ! rate_const*NOp*CLm_HCL + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 88)*sol(:ncol,:, 64) ! rate_const*NOp*CO3m + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 88)*sol(:ncol,:, 62) ! rate_const*NOp*CLm_HCL rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 83)*sol(:ncol,:, 88) ! rate_const*NO3m*NOp - rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 88)*sol(:ncol,:, 71) ! rate_const*NOp*HCO3m + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 88)*sol(:ncol,:, 70) ! rate_const*NOp*HCO3m rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 98)*sol(:ncol,:, 88) ! rate_const*O2m*NOp - rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 88)*sol(:ncol,:, 68) ! rate_const*NOp*CO4m + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 88)*sol(:ncol,:, 67) ! rate_const*NOp*CO4m rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 88)*sol(:ncol,:, 85) ! rate_const*NOp*NO3m_H2O - rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 88)*sol(:ncol,:, 66) ! rate_const*NOp*CO3m2H2O - rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 66)*sol(:ncol,:, 75) ! rate_const*CO3m2H2O*Hp_4H2O - rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 61)*sol(:ncol,:, 88) ! rate_const*CLm*NOp - rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 67)*sol(:ncol,:, 88) ! rate_const*CO3m_H2O*NOp + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 88)*sol(:ncol,:, 65) ! rate_const*NOp*CO3m2H2O + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 65)*sol(:ncol,:, 75) ! rate_const*CO3m2H2O*Hp_4H2O + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 60)*sol(:ncol,:, 88) ! rate_const*CLm*NOp + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 66)*sol(:ncol,:, 88) ! rate_const*CO3m_H2O*NOp rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 82)*sol(:ncol,:, 88) ! rate_const*NO2m_H2O*NOp rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 86)*sol(:ncol,:, 88) ! rate_const*NO3m_HCL*NOp - rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 62)*sol(:ncol,:, 88) ! rate_const*CLm_H2O*NOp + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 61)*sol(:ncol,:, 88) ! rate_const*CLm_H2O*NOp rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 88)*sol(:ncol,:, 84) ! rate_const*NOp*NO3m2H2O rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 88)*sol(:ncol,:, 81) ! rate_const*NOp*NO2m rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 87)*sol(:ncol,:, 99) ! rate_const*NO3mHNO3*O2p - rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 99)*sol(:ncol,:, 65) ! rate_const*O2p*CO3m - rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 99)*sol(:ncol,:, 63) ! rate_const*O2p*CLm_HCL - rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 75)*sol(:ncol,:, 65) ! rate_const*M*Hp_4H2O*CO3m - rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 77)*sol(:ncol,:, 66) ! rate_const*M*Hp_5H2O*CO3m2H2O - rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 67)*sol(:ncol,:, 75) ! rate_const*M*CO3m_H2O*Hp_4H2O - rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 77)*sol(:ncol,:, 67) ! rate_const*M*Hp_5H2O*CO3m_H2O + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 99)*sol(:ncol,:, 64) ! rate_const*O2p*CO3m + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 99)*sol(:ncol,:, 62) ! rate_const*O2p*CLm_HCL + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 75)*sol(:ncol,:, 64) ! rate_const*M*Hp_4H2O*CO3m + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 77)*sol(:ncol,:, 65) ! rate_const*M*Hp_5H2O*CO3m2H2O + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 66)*sol(:ncol,:, 75) ! rate_const*M*CO3m_H2O*Hp_4H2O + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 77)*sol(:ncol,:, 66) ! rate_const*M*Hp_5H2O*CO3m_H2O rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 85)*sol(:ncol,:, 75) ! rate_const*M*NO3m_H2O*Hp_4H2O rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 85)*sol(:ncol,:, 77) ! rate_const*M*NO3m_H2O*Hp_5H2O rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 83)*sol(:ncol,:, 75) ! rate_const*M*NO3m*Hp_4H2O - rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 77)*sol(:ncol,:, 65) ! rate_const*M*Hp_5H2O*CO3m + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 77)*sol(:ncol,:, 64) ! rate_const*M*Hp_5H2O*CO3m rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 77)*sol(:ncol,:, 83) ! rate_const*M*Hp_5H2O*NO3m - rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 63)*sol(:ncol,:, 75) ! rate_const*M*CLm_HCL*Hp_4H2O - rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 77)*sol(:ncol,:, 63) ! rate_const*M*Hp_5H2O*CLm_HCL + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 62)*sol(:ncol,:, 75) ! rate_const*M*CLm_HCL*Hp_4H2O + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 77)*sol(:ncol,:, 62) ! rate_const*M*Hp_5H2O*CLm_HCL rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 87)*sol(:ncol,:, 75) ! rate_const*M*NO3mHNO3*Hp_4H2O rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 77)*sol(:ncol,:, 87) ! rate_const*M*Hp_5H2O*NO3mHNO3 - rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 66)*sol(:ncol,:, 75) ! rate_const*M*CO3m2H2O*Hp_4H2O - rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 51)*sol(:ncol,:, 101) ! rate_const*NO*O3m + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 65)*sol(:ncol,:, 75) ! rate_const*M*CO3m2H2O*Hp_4H2O + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 52)*sol(:ncol,:, 101) ! rate_const*NO*O3m rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 82) ! rate_const*M*NO2m_H2O rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 84) ! rate_const*M*NO3m2H2O rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 87) ! rate_const*M*NO3mHNO3 - rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 40)*sol(:ncol,:, 83) ! rate_const*M*HCL*NO3m - rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 52)*sol(:ncol,:, 101) ! rate_const*NO2*O3m - rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 52)*sol(:ncol,:, 101) ! rate_const*NO2*O3m - rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 51)*sol(:ncol,:, 101) ! rate_const*NO*O3m - rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 65)*sol(:ncol,:, 51) ! rate_const*CO3m*NO - rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 65)*sol(:ncol,:, 52) ! rate_const*CO3m*NO2 + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 42)*sol(:ncol,:, 83) ! rate_const*M*HCL*NO3m + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 53)*sol(:ncol,:, 101) ! rate_const*NO2*O3m + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 53)*sol(:ncol,:, 101) ! rate_const*NO2*O3m + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 52)*sol(:ncol,:, 101) ! rate_const*NO*O3m + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 64)*sol(:ncol,:, 52) ! rate_const*CO3m*NO + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 64)*sol(:ncol,:, 53) ! rate_const*CO3m*NO2 rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 85) ! rate_const*M*NO3m_H2O - rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 67) ! rate_const*M*CO3m_H2O - rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 66) ! rate_const*M*CO3m2H2O - rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 60)*sol(:ncol,:, 81) ! rate_const*CL*NO2m - rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 24)*sol(:ncol,:, 81) ! rate_const*CLO*NO2m - rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 32)*sol(:ncol,:, 81) ! rate_const*H*NO2m + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 66) ! rate_const*M*CO3m_H2O + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 65) ! rate_const*M*CO3m2H2O + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 23)*sol(:ncol,:, 81) ! rate_const*CL*NO2m + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 26)*sol(:ncol,:, 81) ! rate_const*CLO*NO2m + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 34)*sol(:ncol,:, 81) ! rate_const*H*NO2m rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 81)*sol(:ncol,:, 110) ! rate_const*M*NO2m*H2O - rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 40)*sol(:ncol,:, 81) ! rate_const*HCL*NO2m - rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 42)*sol(:ncol,:, 81) ! rate_const*HNO3*NO2m - rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 52)*sol(:ncol,:, 81) ! rate_const*NO2*NO2m - rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 81)*sol(:ncol,:, 56) ! rate_const*NO2m*O3 - rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 84)*sol(:ncol,:, 50) ! rate_const*NO3m2H2O*N2O5 + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 42)*sol(:ncol,:, 81) ! rate_const*HCL*NO2m + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 44)*sol(:ncol,:, 81) ! rate_const*HNO3*NO2m + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 53)*sol(:ncol,:, 81) ! rate_const*NO2*NO2m + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 81)*sol(:ncol,:, 57) ! rate_const*NO2m*O3 + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 84)*sol(:ncol,:, 51) ! rate_const*NO3m2H2O*N2O5 rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 85)*sol(:ncol,:, 110) ! rate_const*M*NO3m_H2O*H2O - rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 42)*sol(:ncol,:, 85) ! rate_const*HNO3*NO3m_H2O + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 44)*sol(:ncol,:, 85) ! rate_const*HNO3*NO3m_H2O rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 110)*sol(:ncol,:, 83) ! rate_const*M*H2O*NO3m - rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 85)*sol(:ncol,:, 50) ! rate_const*NO3m_H2O*N2O5 - rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 40)*sol(:ncol,:, 83) ! rate_const*HCL*NO3m - rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 42)*sol(:ncol,:, 86) ! rate_const*HNO3*NO3m_HCL - rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 83)*sol(:ncol,:, 42) ! rate_const*M*NO3m*HNO3 - rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 83)*sol(:ncol,:, 54) ! rate_const*NO3m*O - rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 56)*sol(:ncol,:, 83) ! rate_const*O3*NO3m - rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 89)*sol(:ncol,:, 69) ! rate_const*NOp_2H2O*e - rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 90)*sol(:ncol,:, 69) ! rate_const*NOp_3H2O*e + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 85)*sol(:ncol,:, 51) ! rate_const*NO3m_H2O*N2O5 + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 42)*sol(:ncol,:, 83) ! rate_const*HCL*NO3m + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 44)*sol(:ncol,:, 86) ! rate_const*HNO3*NO3m_HCL + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 83)*sol(:ncol,:, 44) ! rate_const*M*NO3m*HNO3 + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 83)*sol(:ncol,:, 55) ! rate_const*NO3m*O + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 57)*sol(:ncol,:, 83) ! rate_const*O3*NO3m + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 89)*sol(:ncol,:, 68) ! rate_const*NOp_2H2O*e + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 90)*sol(:ncol,:, 68) ! rate_const*NOp_3H2O*e rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 110)*sol(:ncol,:, 90) ! rate_const*H2O*NOp_3H2O - rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 91)*sol(:ncol,:, 69) ! rate_const*NOp_CO2*e + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 91)*sol(:ncol,:, 68) ! rate_const*NOp_CO2*e rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 91)*sol(:ncol,:, 110) ! rate_const*NOp_CO2*H2O - rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 92)*sol(:ncol,:, 69) ! rate_const*NOp_H2O*e - rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 32)*sol(:ncol,:, 92) ! rate_const*H*NOp_H2O - rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 92)*sol(:ncol,:, 43) ! rate_const*NOp_H2O*HO2 + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 92)*sol(:ncol,:, 68) ! rate_const*NOp_H2O*e + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 34)*sol(:ncol,:, 92) ! rate_const*H*NOp_H2O + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 92)*sol(:ncol,:, 71) ! rate_const*NOp_H2O*HO2 rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 92)*sol(:ncol,:, 104) ! rate_const*NOp_H2O*OH - rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 28)*sol(:ncol,:, 93) ! rate_const*CO2*NOp_N2 + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 30)*sol(:ncol,:, 93) ! rate_const*CO2*NOp_N2 rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 93)*sol(:ncol,:, 110) ! rate_const*NOp_N2*H2O - rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 98)*sol(:ncol,:, 60) ! rate_const*O2m*CL - rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 24)*sol(:ncol,:, 98) ! rate_const*CLO*O2m - rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 28)*sol(:ncol,:, 98) ! rate_const*M*CO2*O2m - rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 32)*sol(:ncol,:, 98) ! rate_const*H*O2m - rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 98)*sol(:ncol,:, 40) ! rate_const*O2m*HCL - rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 98)*sol(:ncol,:, 42) ! rate_const*O2m*HNO3 - rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 52)*sol(:ncol,:, 98) ! rate_const*NO2*O2m + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 98)*sol(:ncol,:, 23) ! rate_const*O2m*CL + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 26)*sol(:ncol,:, 98) ! rate_const*CLO*O2m + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 30)*sol(:ncol,:, 98) ! rate_const*M*CO2*O2m + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 34)*sol(:ncol,:, 98) ! rate_const*H*O2m + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 98)*sol(:ncol,:, 42) ! rate_const*O2m*HCL + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 98)*sol(:ncol,:, 44) ! rate_const*O2m*HNO3 + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 53)*sol(:ncol,:, 98) ! rate_const*NO2*O2m rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 96)*sol(:ncol,:, 98) ! rate_const*O2_1D*O2m - rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 55)*sol(:ncol,:, 98) ! rate_const*M*O2*O2m - rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 56)*sol(:ncol,:, 98) ! rate_const*O3*O2m - rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 54)*sol(:ncol,:, 98) ! rate_const*O*O2m - rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 98)*sol(:ncol,:, 54) ! rate_const*O2m*O - rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 100)*sol(:ncol,:, 69) ! rate_const*O2p_H2O*e + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 56)*sol(:ncol,:, 98) ! rate_const*M*O2*O2m + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 57)*sol(:ncol,:, 98) ! rate_const*O3*O2m + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 55)*sol(:ncol,:, 98) ! rate_const*O*O2m + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 98)*sol(:ncol,:, 55) ! rate_const*O2m*O + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 100)*sol(:ncol,:, 68) ! rate_const*O2p_H2O*e rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 100)*sol(:ncol,:, 110) ! rate_const*O2p_H2O*H2O rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 100)*sol(:ncol,:, 110) ! rate_const*O2p_H2O*H2O rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 110)*sol(:ncol,:, 99) ! rate_const*M*H2O*O2p - rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 101)*sol(:ncol,:, 28) ! rate_const*O3m*CO2 - rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 101)*sol(:ncol,:, 32) ! rate_const*O3m*H - rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 56)*sol(:ncol,:, 101) ! rate_const*O3*O3m - rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 101)*sol(:ncol,:, 54) ! rate_const*O3m*O - rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 54)*sol(:ncol,:, 101) ! rate_const*O*O3m - rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 28)*sol(:ncol,:, 102) ! rate_const*CO2*O4m - rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 54)*sol(:ncol,:, 102) ! rate_const*O*O4m + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 101)*sol(:ncol,:, 30) ! rate_const*O3m*CO2 + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 101)*sol(:ncol,:, 34) ! rate_const*O3m*H + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 57)*sol(:ncol,:, 101) ! rate_const*O3*O3m + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 101)*sol(:ncol,:, 55) ! rate_const*O3m*O + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 55)*sol(:ncol,:, 101) ! rate_const*O*O3m + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 30)*sol(:ncol,:, 102) ! rate_const*CO2*O4m + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 55)*sol(:ncol,:, 102) ! rate_const*O*O4m rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 110)*sol(:ncol,:, 103) ! rate_const*H2O*O4p - rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 103)*sol(:ncol,:, 54) ! rate_const*O4p*O + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 103)*sol(:ncol,:, 55) ! rate_const*O4p*O rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 103)*sol(:ncol,:, 96) ! rate_const*O4p*O2_1D - rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 47)*sol(:ncol,:, 104) ! rate_const*HONO*OH - rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 60)*sol(:ncol,:, 105) ! rate_const*CL*OHm - rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 24)*sol(:ncol,:, 105) ! rate_const*CLO*OHm - rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 28)*sol(:ncol,:, 105) ! rate_const*M*CO2*OHm - rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 32)*sol(:ncol,:, 105) ! rate_const*H*OHm - rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 105)*sol(:ncol,:, 40) ! rate_const*OHm*HCL - rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 52)*sol(:ncol,:, 105) ! rate_const*NO2*OHm - rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 105)*sol(:ncol,:, 54) ! rate_const*OHm*O - rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 105)*sol(:ncol,:, 56) ! rate_const*OHm*O3 - rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 104)*sol(:ncol,:, 51) ! rate_const*M*OH*NO - rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 106)*sol(:ncol,:, 60) ! rate_const*Om*CL - rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 24)*sol(:ncol,:, 106) ! rate_const*CLO*Om - rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 106)*sol(:ncol,:, 28) ! rate_const*M*Om*CO2 - rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 33)*sol(:ncol,:, 106) ! rate_const*H2*Om - rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 106)*sol(:ncol,:, 33) ! rate_const*Om*H2 + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 48)*sol(:ncol,:, 104) ! rate_const*HONO*OH + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 23)*sol(:ncol,:, 105) ! rate_const*CL*OHm + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 26)*sol(:ncol,:, 105) ! rate_const*CLO*OHm + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 30)*sol(:ncol,:, 105) ! rate_const*M*CO2*OHm + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 34)*sol(:ncol,:, 105) ! rate_const*H*OHm + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 105)*sol(:ncol,:, 42) ! rate_const*OHm*HCL + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 53)*sol(:ncol,:, 105) ! rate_const*NO2*OHm + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 105)*sol(:ncol,:, 55) ! rate_const*OHm*O + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 105)*sol(:ncol,:, 57) ! rate_const*OHm*O3 + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 104)*sol(:ncol,:, 52) ! rate_const*M*OH*NO + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 106)*sol(:ncol,:, 23) ! rate_const*Om*CL + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 26)*sol(:ncol,:, 106) ! rate_const*CLO*Om + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 106)*sol(:ncol,:, 30) ! rate_const*M*Om*CO2 + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 35)*sol(:ncol,:, 106) ! rate_const*H2*Om + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 106)*sol(:ncol,:, 35) ! rate_const*Om*H2 rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 106)*sol(:ncol,:, 110) ! rate_const*Om*H2O - rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 106)*sol(:ncol,:, 40) ! rate_const*Om*HCL - rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 106)*sol(:ncol,:, 42) ! rate_const*Om*HNO3 + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 106)*sol(:ncol,:, 42) ! rate_const*Om*HCL + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 106)*sol(:ncol,:, 44) ! rate_const*Om*HNO3 rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 106) ! rate_const*M*Om - rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 52)*sol(:ncol,:, 106) ! rate_const*NO2*Om - rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 106)*sol(:ncol,:, 54) ! rate_const*Om*O + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 53)*sol(:ncol,:, 106) ! rate_const*NO2*Om + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 106)*sol(:ncol,:, 55) ! rate_const*Om*O rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 106)*sol(:ncol,:, 96) ! rate_const*Om*O2_1D - rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 106)*sol(:ncol,:, 55) ! rate_const*M*Om*O2 - rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 56)*sol(:ncol,:, 106) ! rate_const*O3*Om - rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 99)*sol(:ncol,:, 55) ! rate_const*M*O2p*O2 + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 106)*sol(:ncol,:, 56) ! rate_const*M*Om*O2 + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 57)*sol(:ncol,:, 106) ! rate_const*O3*Om + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 99)*sol(:ncol,:, 56) ! rate_const*M*O2p*O2 rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 110)*sol(:ncol,:, 88) ! rate_const*M*H2O*NOp rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 110)*sol(:ncol,:, 92) ! rate_const*M*H2O*NOp_H2O rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 110)*sol(:ncol,:, 89) ! rate_const*M*H2O*NOp_2H2O - rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 88)*sol(:ncol,:, 28) ! rate_const*M*NOp*CO2 + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 88)*sol(:ncol,:, 30) ! rate_const*M*NOp*CO2 rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 91) ! rate_const*M*NOp_CO2 rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 88) ! rate_const*N2*M*NOp rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 93) ! rate_const*M*NOp_N2 @@ -382,216 +382,216 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 75) ! rate_const*M*Hp_4H2O rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 75)*sol(:ncol,:, 110) ! rate_const*M*Hp_4H2O*H2O rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 77) ! rate_const*M*Hp_5H2O - rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 69)*sol(:ncol,:, 103) ! rate_const*e*O4p - rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 78)*sol(:ncol,:, 69) ! rate_const*Hp_H2O*e - rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 72)*sol(:ncol,:, 69) ! rate_const*Hp_2H2O*e - rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 73)*sol(:ncol,:, 69) ! rate_const*Hp_3H2O*e - rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 69)*sol(:ncol,:, 93) ! rate_const*e*NOp_N2 - rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 62) ! rate_const*M*CLm_H2O - rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 63) ! rate_const*M*CLm_HCL + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 68)*sol(:ncol,:, 103) ! rate_const*e*O4p + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 78)*sol(:ncol,:, 68) ! rate_const*Hp_H2O*e + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 72)*sol(:ncol,:, 68) ! rate_const*Hp_2H2O*e + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 73)*sol(:ncol,:, 68) ! rate_const*Hp_3H2O*e + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 68)*sol(:ncol,:, 93) ! rate_const*e*NOp_N2 + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 61) ! rate_const*M*CLm_H2O + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 62) ! rate_const*M*CLm_HCL rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 96) ! rate_const*O2_1D rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 97) ! rate_const*O2_1S - rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 95)*sol(:ncol,:, 33) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 95)*sol(:ncol,:, 35) ! rate_const*O1D*H2 rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 95)*sol(:ncol,:, 110) ! rate_const*O1D*H2O rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 95) ! rate_const*N2*O1D - rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 95)*sol(:ncol,:, 55) ! rate_const*O1D*O2 - rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 95)*sol(:ncol,:, 55) ! rate_const*O1D*O2 - rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 95)*sol(:ncol,:, 56) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 95)*sol(:ncol,:, 56) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 95)*sol(:ncol,:, 56) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 95)*sol(:ncol,:, 57) ! rate_const*O1D*O3 rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 96) ! rate_const*N2*O2_1D - rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 96)*sol(:ncol,:, 54) ! rate_const*O2_1D*O - rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 96)*sol(:ncol,:, 55) ! rate_const*O2_1D*O2 - rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 97)*sol(:ncol,:, 28) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 96)*sol(:ncol,:, 55) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 96)*sol(:ncol,:, 56) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 97)*sol(:ncol,:, 30) ! rate_const*O2_1S*CO2 rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 97) ! rate_const*N2*O2_1S - rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 97)*sol(:ncol,:, 54) ! rate_const*O2_1S*O - rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 97)*sol(:ncol,:, 55) ! rate_const*O2_1S*O2 - rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 97)*sol(:ncol,:, 56) ! rate_const*O2_1S*O3 - rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 54)*sol(:ncol,:, 56) ! rate_const*O*O3 - rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 54)*sol(:ncol,:, 54) ! rate_const*M*O*O - rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 54)*sol(:ncol,:, 55) ! rate_const*M*O*O2 - rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 33)*sol(:ncol,:, 54) ! rate_const*H2*O - rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 35)*sol(:ncol,:, 54) ! rate_const*H2O2*O - rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 32)*sol(:ncol,:, 43) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 32)*sol(:ncol,:, 43) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 32)*sol(:ncol,:, 43) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 32)*sol(:ncol,:, 55) ! rate_const*M*H*O2 - rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 43)*sol(:ncol,:, 54) ! rate_const*HO2*O - rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 43)*sol(:ncol,:, 56) ! rate_const*HO2*O3 - rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 32)*sol(:ncol,:, 56) ! rate_const*H*O3 - rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 104)*sol(:ncol,:, 33) ! rate_const*OH*H2 - rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 104)*sol(:ncol,:, 35) ! rate_const*OH*H2O2 - rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 104)*sol(:ncol,:, 43) ! rate_const*OH*HO2 - rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 104)*sol(:ncol,:, 54) ! rate_const*OH*O - rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 104)*sol(:ncol,:, 56) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 97)*sol(:ncol,:, 55) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 97)*sol(:ncol,:, 56) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 97)*sol(:ncol,:, 57) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 55)*sol(:ncol,:, 57) ! rate_const*O*O3 + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 55)*sol(:ncol,:, 55) ! rate_const*M*O*O + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 55)*sol(:ncol,:, 56) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 35)*sol(:ncol,:, 55) ! rate_const*H2*O + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 37)*sol(:ncol,:, 55) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 34)*sol(:ncol,:, 71) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 34)*sol(:ncol,:, 71) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 34)*sol(:ncol,:, 71) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 34)*sol(:ncol,:, 56) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 71)*sol(:ncol,:, 55) ! rate_const*HO2*O + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 71)*sol(:ncol,:, 57) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 34)*sol(:ncol,:, 57) ! rate_const*H*O3 + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 104)*sol(:ncol,:, 35) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 104)*sol(:ncol,:, 37) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 104)*sol(:ncol,:, 71) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 104)*sol(:ncol,:, 55) ! rate_const*OH*O + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 104)*sol(:ncol,:, 57) ! rate_const*OH*O3 rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 104)*sol(:ncol,:, 104) ! rate_const*OH*OH rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 104)*sol(:ncol,:, 104) ! rate_const*M*OH*OH - rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 43)*sol(:ncol,:, 43) ! rate_const*HO2*HO2 - rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 44)*sol(:ncol,:, 104) ! rate_const*HO2NO2*OH - rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 79)*sol(:ncol,:, 54) ! rate_const*N2D*O - rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 79)*sol(:ncol,:, 55) ! rate_const*N2D*O2 - rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 48)*sol(:ncol,:, 51) ! rate_const*N*NO - rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 48)*sol(:ncol,:, 52) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 48)*sol(:ncol,:, 52) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 48)*sol(:ncol,:, 52) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 48)*sol(:ncol,:, 55) ! rate_const*N*O2 - rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 52)*sol(:ncol,:, 54) ! rate_const*NO2*O - rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 52)*sol(:ncol,:, 56) ! rate_const*NO2*O3 - rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 52)*sol(:ncol,:, 54) ! rate_const*M*NO2*O - rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 53)*sol(:ncol,:, 43) ! rate_const*NO3*HO2 - rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 53)*sol(:ncol,:, 51) ! rate_const*NO3*NO - rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 53)*sol(:ncol,:, 54) ! rate_const*NO3*O - rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 53)*sol(:ncol,:, 104) ! rate_const*NO3*OH - rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 48)*sol(:ncol,:, 104) ! rate_const*N*OH - rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 51)*sol(:ncol,:, 43) ! rate_const*NO*HO2 - rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 51)*sol(:ncol,:, 56) ! rate_const*NO*O3 - rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 51)*sol(:ncol,:, 54) ! rate_const*M*NO*O - rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 95)*sol(:ncol,:, 49) ! rate_const*O1D*N2O - rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 95)*sol(:ncol,:, 49) ! rate_const*O1D*N2O - rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 52)*sol(:ncol,:, 43) ! rate_const*M*NO2*HO2 - rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 52)*sol(:ncol,:, 53) ! rate_const*M*NO2*NO3 - rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 52)*sol(:ncol,:, 104) ! rate_const*M*NO2*OH - rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 42)*sol(:ncol,:, 104) ! rate_const*HNO3*OH - rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 44) ! rate_const*M*HO2NO2 - rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 50) ! rate_const*M*N2O5 - rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 60)*sol(:ncol,:, 14) ! rate_const*CL*CH2O - rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 60)*sol(:ncol,:, 20) ! rate_const*CL*CH4 - rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 60)*sol(:ncol,:, 33) ! rate_const*CL*H2 - rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 60)*sol(:ncol,:, 35) ! rate_const*CL*H2O2 - rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 60)*sol(:ncol,:, 43) ! rate_const*CL*HO2 - rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 60)*sol(:ncol,:, 43) ! rate_const*CL*HO2 - rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 60)*sol(:ncol,:, 56) ! rate_const*CL*O3 - rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 24)*sol(:ncol,:, 18) ! rate_const*CLO*CH3O2 - rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 24)*sol(:ncol,:, 43) ! rate_const*CLO*HO2 - rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 24)*sol(:ncol,:, 51) ! rate_const*CLO*NO - rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 25)*sol(:ncol,:, 60) ! rate_const*CLONO2*CL - rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 24)*sol(:ncol,:, 52) ! rate_const*M*CLO*NO2 - rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 25)*sol(:ncol,:, 54) ! rate_const*CLONO2*O - rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 25)*sol(:ncol,:, 104) ! rate_const*CLONO2*OH - rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 24)*sol(:ncol,:, 54) ! rate_const*CLO*O - rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 24)*sol(:ncol,:, 104) ! rate_const*CLO*OH - rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 24)*sol(:ncol,:, 104) ! rate_const*CLO*OH - rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 40)*sol(:ncol,:, 54) ! rate_const*HCL*O - rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 40)*sol(:ncol,:, 104) ! rate_const*HCL*OH - rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 46)*sol(:ncol,:, 60) ! rate_const*HOCL*CL - rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 46)*sol(:ncol,:, 54) ! rate_const*HOCL*O - rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 46)*sol(:ncol,:, 104) ! rate_const*HOCL*OH - rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 95)*sol(:ncol,:, 5) ! rate_const*O1D*CCL4 - rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 95)*sol(:ncol,:, 6) ! rate_const*O1D*CF2CLBR - rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 95)*sol(:ncol,:, 8) ! rate_const*O1D*CFC11 - rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 95)*sol(:ncol,:, 9) ! rate_const*O1D*CFC113 - rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 95)*sol(:ncol,:, 10) ! rate_const*O1D*CFC114 - rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 95)*sol(:ncol,:, 11) ! rate_const*O1D*CFC115 - rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 95)*sol(:ncol,:, 12) ! rate_const*O1D*CFC12 - rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 95)*sol(:ncol,:, 40) ! rate_const*O1D*HCL - rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 95)*sol(:ncol,:, 40) ! rate_const*O1D*HCL - rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 24)*sol(:ncol,:, 24) ! rate_const*M*CLO*CLO - rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 23) ! rate_const*M*CL2O2 - rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 59)*sol(:ncol,:, 14) ! rate_const*BR*CH2O - rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 59)*sol(:ncol,:, 43) ! rate_const*BR*HO2 - rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 59)*sol(:ncol,:, 56) ! rate_const*BR*O3 - rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 2)*sol(:ncol,:, 2) ! rate_const*BRO*BRO - rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 2)*sol(:ncol,:, 24) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 2)*sol(:ncol,:, 24) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 2)*sol(:ncol,:, 24) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 2)*sol(:ncol,:, 43) ! rate_const*BRO*HO2 - rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 2)*sol(:ncol,:, 51) ! rate_const*BRO*NO - rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 2)*sol(:ncol,:, 52) ! rate_const*M*BRO*NO2 - rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 3)*sol(:ncol,:, 54) ! rate_const*BRONO2*O - rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 2)*sol(:ncol,:, 54) ! rate_const*BRO*O - rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 2)*sol(:ncol,:, 104) ! rate_const*BRO*OH - rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 36)*sol(:ncol,:, 54) ! rate_const*HBR*O - rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 36)*sol(:ncol,:, 104) ! rate_const*HBR*OH - rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 45)*sol(:ncol,:, 54) ! rate_const*HOBR*O - rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 95)*sol(:ncol,:, 7) ! rate_const*O1D*CF3BR - rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 95)*sol(:ncol,:, 21) ! rate_const*O1D*CHBR3 - rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 95)*sol(:ncol,:, 34) ! rate_const*O1D*H2402 - rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 95)*sol(:ncol,:, 36) ! rate_const*O1D*HBR - rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 95)*sol(:ncol,:, 36) ! rate_const*O1D*HBR - rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 31)*sol(:ncol,:, 20) ! rate_const*F*CH4 - rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 31)*sol(:ncol,:, 33) ! rate_const*F*H2 - rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 31)*sol(:ncol,:, 110) ! rate_const*F*H2O - rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 31)*sol(:ncol,:, 42) ! rate_const*F*HNO3 - rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 95)*sol(:ncol,:, 29) ! rate_const*O1D*COF2 - rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 95)*sol(:ncol,:, 30) ! rate_const*O1D*COFCL - rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 13)*sol(:ncol,:, 60) ! rate_const*CH2BR2*CL - rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 13)*sol(:ncol,:, 104) ! rate_const*CH2BR2*OH - rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 15)*sol(:ncol,:, 60) ! rate_const*CH3BR*CL - rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 15)*sol(:ncol,:, 104) ! rate_const*CH3BR*OH - rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 16)*sol(:ncol,:, 104) ! rate_const*CH3CCL3*OH - rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 17)*sol(:ncol,:, 60) ! rate_const*CH3CL*CL - rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 17)*sol(:ncol,:, 104) ! rate_const*CH3CL*OH - rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 21)*sol(:ncol,:, 60) ! rate_const*CHBR3*CL - rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 21)*sol(:ncol,:, 104) ! rate_const*CHBR3*OH - rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 37)*sol(:ncol,:, 104) ! rate_const*HCFC141B*OH - rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 38)*sol(:ncol,:, 104) ! rate_const*HCFC142B*OH - rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 39)*sol(:ncol,:, 104) ! rate_const*HCFC22*OH - rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 95)*sol(:ncol,:, 13) ! rate_const*O1D*CH2BR2 - rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 95)*sol(:ncol,:, 15) ! rate_const*O1D*CH3BR - rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 95)*sol(:ncol,:, 37) ! rate_const*O1D*HCFC141B - rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 95)*sol(:ncol,:, 38) ! rate_const*O1D*HCFC142B - rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 95)*sol(:ncol,:, 39) ! rate_const*O1D*HCFC22 - rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 14)*sol(:ncol,:, 53) ! rate_const*CH2O*NO3 - rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 14)*sol(:ncol,:, 54) ! rate_const*CH2O*O - rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 14)*sol(:ncol,:, 104) ! rate_const*CH2O*OH - rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 18)*sol(:ncol,:, 43) ! rate_const*CH3O2*HO2 - rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 18)*sol(:ncol,:, 51) ! rate_const*CH3O2*NO - rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 19)*sol(:ncol,:, 104) ! rate_const*CH3OOH*OH - rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 20)*sol(:ncol,:, 104) ! rate_const*CH4*OH - rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 27)*sol(:ncol,:, 104) ! rate_const*M*CO*OH - rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 95)*sol(:ncol,:, 20) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 95)*sol(:ncol,:, 20) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 95)*sol(:ncol,:, 20) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 27)*sol(:ncol,:, 104) ! rate_const*CO*OH - rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 43) ! rate_const*HO2 - rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 50) ! rate_const*N2O5 - rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 52) ! rate_const*NO2 - rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 53) ! rate_const*NO3 - rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 50) ! rate_const*N2O5 - rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 46)*sol(:ncol,:, 40) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 3) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 50) ! rate_const*N2O5 - rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 25) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 3) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 25)*sol(:ncol,:, 40) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 46)*sol(:ncol,:, 40) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 45)*sol(:ncol,:, 40) ! rate_const*HOBR*HCL - rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 25) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 3) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 25)*sol(:ncol,:, 40) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 46)*sol(:ncol,:, 40) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 45)*sol(:ncol,:, 40) ! rate_const*HOBR*HCL - rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 50) ! rate_const*N2O5 - rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 25) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 25)*sol(:ncol,:, 40) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 71)*sol(:ncol,:, 71) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 45)*sol(:ncol,:, 104) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 79)*sol(:ncol,:, 55) ! rate_const*N2D*O + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 79)*sol(:ncol,:, 56) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 49)*sol(:ncol,:, 52) ! rate_const*N*NO + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 49)*sol(:ncol,:, 53) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 49)*sol(:ncol,:, 53) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 49)*sol(:ncol,:, 53) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 49)*sol(:ncol,:, 56) ! rate_const*N*O2 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 53)*sol(:ncol,:, 55) ! rate_const*NO2*O + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 53)*sol(:ncol,:, 57) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 53)*sol(:ncol,:, 55) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 54)*sol(:ncol,:, 71) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 54)*sol(:ncol,:, 52) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 54)*sol(:ncol,:, 55) ! rate_const*NO3*O + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 54)*sol(:ncol,:, 104) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 49)*sol(:ncol,:, 104) ! rate_const*N*OH + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 52)*sol(:ncol,:, 71) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 52)*sol(:ncol,:, 57) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 52)*sol(:ncol,:, 55) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 95)*sol(:ncol,:, 50) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 95)*sol(:ncol,:, 50) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 53)*sol(:ncol,:, 71) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 53)*sol(:ncol,:, 54) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 53)*sol(:ncol,:, 104) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 44)*sol(:ncol,:, 104) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 45) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 51) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 23)*sol(:ncol,:, 15) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 23)*sol(:ncol,:, 21) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 23)*sol(:ncol,:, 35) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 23)*sol(:ncol,:, 37) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 23)*sol(:ncol,:, 71) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 23)*sol(:ncol,:, 71) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 23)*sol(:ncol,:, 57) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 26)*sol(:ncol,:, 19) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 26)*sol(:ncol,:, 71) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 26)*sol(:ncol,:, 52) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 27)*sol(:ncol,:, 23) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 26)*sol(:ncol,:, 53) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 27)*sol(:ncol,:, 55) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 27)*sol(:ncol,:, 104) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 26)*sol(:ncol,:, 55) ! rate_const*CLO*O + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 26)*sol(:ncol,:, 104) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 26)*sol(:ncol,:, 104) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 42)*sol(:ncol,:, 55) ! rate_const*HCL*O + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 42)*sol(:ncol,:, 104) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 47)*sol(:ncol,:, 23) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 47)*sol(:ncol,:, 55) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 47)*sol(:ncol,:, 104) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 95)*sol(:ncol,:, 6) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 95)*sol(:ncol,:, 7) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 95)*sol(:ncol,:, 9) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 95)*sol(:ncol,:, 10) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 95)*sol(:ncol,:, 11) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 95)*sol(:ncol,:, 12) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 95)*sol(:ncol,:, 13) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 95)*sol(:ncol,:, 42) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 95)*sol(:ncol,:, 42) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 25) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 1)*sol(:ncol,:, 15) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 1)*sol(:ncol,:, 71) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 1)*sol(:ncol,:, 57) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 3)*sol(:ncol,:, 3) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 3)*sol(:ncol,:, 26) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 3)*sol(:ncol,:, 26) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 3)*sol(:ncol,:, 26) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 3)*sol(:ncol,:, 71) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 3)*sol(:ncol,:, 52) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 3)*sol(:ncol,:, 53) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 4)*sol(:ncol,:, 55) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 3)*sol(:ncol,:, 55) ! rate_const*BRO*O + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 3)*sol(:ncol,:, 104) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 38)*sol(:ncol,:, 55) ! rate_const*HBR*O + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 38)*sol(:ncol,:, 104) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 46)*sol(:ncol,:, 55) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 95)*sol(:ncol,:, 8) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 95)*sol(:ncol,:, 22) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 95)*sol(:ncol,:, 36) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 95)*sol(:ncol,:, 38) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 95)*sol(:ncol,:, 38) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 33)*sol(:ncol,:, 21) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 33)*sol(:ncol,:, 35) ! rate_const*F*H2 + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 33)*sol(:ncol,:, 110) ! rate_const*F*H2O + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 33)*sol(:ncol,:, 44) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 95)*sol(:ncol,:, 31) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 95)*sol(:ncol,:, 32) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 14)*sol(:ncol,:, 23) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 14)*sol(:ncol,:, 104) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 16)*sol(:ncol,:, 23) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 16)*sol(:ncol,:, 104) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 17)*sol(:ncol,:, 104) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 18)*sol(:ncol,:, 23) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 18)*sol(:ncol,:, 104) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 22)*sol(:ncol,:, 23) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 22)*sol(:ncol,:, 104) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 39)*sol(:ncol,:, 104) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 40)*sol(:ncol,:, 104) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 41)*sol(:ncol,:, 104) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 95)*sol(:ncol,:, 14) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 95)*sol(:ncol,:, 16) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 95)*sol(:ncol,:, 39) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 95)*sol(:ncol,:, 40) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 95)*sol(:ncol,:, 41) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 15)*sol(:ncol,:, 54) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 15)*sol(:ncol,:, 55) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 15)*sol(:ncol,:, 104) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 19)*sol(:ncol,:, 71) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 19)*sol(:ncol,:, 52) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 20)*sol(:ncol,:, 104) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 21)*sol(:ncol,:, 104) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 29)*sol(:ncol,:, 104) ! rate_const*M*CO*OH + rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 95)*sol(:ncol,:, 21) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 95)*sol(:ncol,:, 21) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 95)*sol(:ncol,:, 21) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 29)*sol(:ncol,:, 104) ! rate_const*CO*OH + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 71) ! rate_const*HO2 + rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 51) ! rate_const*N2O5 + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 53) ! rate_const*NO2 + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 54) ! rate_const*NO3 + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 51) ! rate_const*N2O5 + rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 47)*sol(:ncol,:, 42) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 51) ! rate_const*N2O5 + rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 27)*sol(:ncol,:, 42) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 47)*sol(:ncol,:, 42) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 46)*sol(:ncol,:, 42) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 4) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 27)*sol(:ncol,:, 42) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 47)*sol(:ncol,:, 42) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 46)*sol(:ncol,:, 42) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 51) ! rate_const*N2O5 + rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 27) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 27)*sol(:ncol,:, 42) ! rate_const*CLONO2*HCL rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 109) ! rate_const*Op2P rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 108) ! rate_const*Op2D rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 109) ! rate_const*Op2P - rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 88)*sol(:ncol,:, 69) ! rate_const*NOp*e - rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 99)*sol(:ncol,:, 69) ! rate_const*O2p*e - rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 80)*sol(:ncol,:, 69) ! rate_const*N2p*e - rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 80)*sol(:ncol,:, 55) ! rate_const*N2p*O2 - rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 80)*sol(:ncol,:, 54) ! rate_const*N2p*O - rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 80)*sol(:ncol,:, 54) ! rate_const*N2p*O - rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 94)*sol(:ncol,:, 54) ! rate_const*Np*O - rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 94)*sol(:ncol,:, 55) ! rate_const*Np*O2 - rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 94)*sol(:ncol,:, 55) ! rate_const*Np*O2 - rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 99)*sol(:ncol,:, 48) ! rate_const*O2p*N + rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 88)*sol(:ncol,:, 68) ! rate_const*NOp*e + rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 99)*sol(:ncol,:, 68) ! rate_const*O2p*e + rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 80)*sol(:ncol,:, 68) ! rate_const*N2p*e + rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 80)*sol(:ncol,:, 56) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 80)*sol(:ncol,:, 55) ! rate_const*N2p*O + rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 80)*sol(:ncol,:, 55) ! rate_const*N2p*O + rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 94)*sol(:ncol,:, 55) ! rate_const*Np*O + rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 94)*sol(:ncol,:, 56) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 94)*sol(:ncol,:, 56) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 99)*sol(:ncol,:, 49) ! rate_const*O2p*N rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 99) ! rate_const*N2*O2p - rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 99)*sol(:ncol,:, 51) ! rate_const*O2p*NO - rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 107)*sol(:ncol,:, 28) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 99)*sol(:ncol,:, 52) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 107)*sol(:ncol,:, 30) ! rate_const*Op*CO2 rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 107) ! rate_const*N2*Op rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 107)*sol(:ncol,:, 79) ! rate_const*Op*N2D - rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 107)*sol(:ncol,:, 55) ! rate_const*Op*O2 - rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 108)*sol(:ncol,:, 69) ! rate_const*Op2D*e + rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 107)*sol(:ncol,:, 56) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 108)*sol(:ncol,:, 68) ! rate_const*Op2D*e rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 108) ! rate_const*N2*Op2D - rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 108)*sol(:ncol,:, 54) ! rate_const*Op2D*O - rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 108)*sol(:ncol,:, 55) ! rate_const*Op2D*O2 - rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 109)*sol(:ncol,:, 69) ! rate_const*Op2P*e - rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 109)*sol(:ncol,:, 69) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 108)*sol(:ncol,:, 55) ! rate_const*Op2D*O + rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 108)*sol(:ncol,:, 56) ! rate_const*Op2D*O2 + rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 109)*sol(:ncol,:, 68) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 109)*sol(:ncol,:, 68) ! rate_const*Op2P*e rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 109) ! rate_const*N2*Op2P rxt_rates(:ncol,:, 584) = rxt_rates(:ncol,:, 584)*sol(:ncol,:, 109) ! rate_const*N2*Op2P - rxt_rates(:ncol,:, 585) = rxt_rates(:ncol,:, 585)*sol(:ncol,:, 109)*sol(:ncol,:, 54) ! rate_const*Op2P*O + rxt_rates(:ncol,:, 585) = rxt_rates(:ncol,:, 585)*sol(:ncol,:, 109)*sol(:ncol,:, 55) ! rate_const*Op2P*O end subroutine set_rates end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_mad/mo_setrxt.F90 b/src/chemistry/pp_waccm_mad/mo_setrxt.F90 index 250d7e275c..5b169a80c7 100644 --- a/src/chemistry/pp_waccm_mad/mo_setrxt.F90 +++ b/src/chemistry/pp_waccm_mad/mo_setrxt.F90 @@ -10,10 +10,9 @@ module mo_setrxt contains subroutine setrxt( rate, temp, m, ncol ) - - use ppgrid, only : pcols, pver - + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 use chem_mods, only : rxntot use mo_jpl, only : jpl @@ -24,398 +23,390 @@ subroutine setrxt( rate, temp, m, ncol ) !------------------------------------------------------- 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)) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,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(:,100) = 9.6e-10_r8 - rate(:,101) = 1.3e-09_r8 - rate(:,102) = 2e-29_r8 - rate(:,103) = 1e-27_r8 - rate(:,104) = 1.6e-09_r8 - rate(:,105) = 6e-12_r8 - rate(:,106) = 2.9e-12_r8 - rate(:,107) = 2.9e-11_r8 - rate(:,108) = 2e-10_r8 - rate(:,109) = 1e-10_r8 - rate(:,110) = 1e-10_r8 - rate(:,111) = 1e-11_r8 - rate(:,112) = 1.7e-10_r8 - rate(:,113) = 1e-28_r8 - rate(:,114) = 1e-28_r8 - rate(:,115) = 4e-11_r8 - rate(:,116) = 4e-11_r8 - rate(:,117) = 3.5e-12_r8 - rate(:,118) = 3.5e-12_r8 - rate(:,119) = 3.51e-10_r8 - rate(:,120) = 1.1e-10_r8 - rate(:,121) = 6e-15_r8 - rate(:,122) = 1e-10_r8 - rate(:,123) = 1e-10_r8 - rate(:,124) = 2.2e-10_r8 - rate(:,125) = 1.2e-09_r8 - rate(:,126) = 1.4e-10_r8 - rate(:,127) = 1.3e-10_r8 - rate(:,133) = 1.5e-06_r8 - rate(:,134) = 2e-09_r8 - rate(:,135) = 1e-09_r8 - rate(:,136) = 3.6e-06_r8 - rate(:,137) = 4e-12_r8 - rate(:,138) = 1e-09_r8 - rate(:,139) = 5e-06_r8 - rate(:,140) = 7e-12_r8 - rate(:,280) = 1e-10_r8 - rate(:,281) = 1e-10_r8 - rate(:,282) = 3e-10_r8 - rate(:,283) = 1.6e-28_r8 - rate(:,284) = 1.4e-09_r8 - rate(:,285) = 1.6e-09_r8 - rate(:,286) = 2e-13_r8 - rate(:,287) = 1.2e-10_r8 - rate(:,288) = 7e-10_r8 - rate(:,289) = 1.6e-28_r8 - rate(:,290) = 1.6e-09_r8 - rate(:,291) = 1.6e-28_r8 - rate(:,292) = 7e-10_r8 - rate(:,293) = 1e-12_r8 - rate(:,294) = 7.6e-10_r8 - rate(:,295) = 1.45e-26_r8 - rate(:,296) = 5e-12_r8 - rate(:,297) = 1e-13_r8 - rate(:,298) = 2e-06_r8 - rate(:,299) = 2e-06_r8 - rate(:,300) = 7e-11_r8 - rate(:,301) = 1.5e-06_r8 - rate(:,302) = 1e-09_r8 - rate(:,303) = 1.5e-06_r8 - rate(:,304) = 7e-12_r8 - rate(:,305) = 5e-10_r8 - rate(:,306) = 1e-10_r8 - rate(:,307) = 1e-09_r8 - rate(:,308) = 1e-09_r8 - rate(:,309) = 1e-10_r8 - rate(:,310) = 1e-10_r8 - rate(:,311) = 9.9e-30_r8 - rate(:,312) = 1.4e-09_r8 - rate(:,313) = 1.6e-09_r8 - rate(:,314) = 2.9e-09_r8 - rate(:,315) = 7e-10_r8 - rate(:,316) = 2e-10_r8 - rate(:,317) = 3.4e-31_r8 - rate(:,318) = 7.8e-10_r8 - rate(:,319) = 1.5e-10_r8 - rate(:,320) = 1.5e-10_r8 - rate(:,321) = 2e-06_r8 - rate(:,322) = 9e-10_r8 - rate(:,323) = 2.4e-10_r8 - rate(:,324) = 2.8e-28_r8 - rate(:,325) = 5.5e-10_r8 - rate(:,326) = 8.4e-10_r8 - rate(:,327) = 1e-10_r8 - rate(:,328) = 1e-10_r8 - rate(:,329) = 2.5e-10_r8 - rate(:,330) = 4.3e-10_r8 - rate(:,331) = 4e-10_r8 - rate(:,332) = 1.7e-09_r8 - rate(:,333) = 3e-10_r8 - rate(:,334) = 1.5e-10_r8 - rate(:,336) = 1e-10_r8 - rate(:,337) = 1e-10_r8 - rate(:,338) = 7.6e-28_r8 - rate(:,339) = 1.4e-09_r8 - rate(:,340) = 1e-09_r8 - rate(:,341) = 1.1e-09_r8 - rate(:,342) = 2e-10_r8 - rate(:,343) = 9e-10_r8 - rate(:,345) = 1e-10_r8 - rate(:,346) = 1e-10_r8 - rate(:,347) = 2e-28_r8 - rate(:,348) = 5.8e-10_r8 - rate(:,349) = 3.2e-11_r8 - rate(:,350) = 6e-13_r8 - rate(:,351) = 2e-09_r8 - rate(:,352) = 3.6e-09_r8 - rate(:,353) = 5e-13_r8 - rate(:,354) = 1e-09_r8 - rate(:,355) = 1.9e-10_r8 - rate(:,356) = 3e-10_r8 - rate(:,357) = 2.9e-31_r8 - rate(:,358) = 8e-10_r8 - rate(:,382) = 0.000258_r8 - rate(:,383) = 0.085_r8 - rate(:,384) = 1.2e-10_r8 - rate(:,389) = 1.2e-10_r8 - rate(:,390) = 1e-20_r8 - rate(:,391) = 1.3e-16_r8 - rate(:,393) = 4.2e-13_r8 - rate(:,395) = 8e-14_r8 - rate(:,396) = 3.9e-17_r8 - rate(:,403) = 6.9e-12_r8 - rate(:,404) = 7.2e-11_r8 - rate(:,405) = 1.6e-12_r8 - rate(:,411) = 1.8e-12_r8 - rate(:,415) = 1.8e-12_r8 - rate(:,419) = 7e-13_r8 - rate(:,420) = 5e-12_r8 - rate(:,429) = 3.5e-12_r8 - rate(:,431) = 1e-11_r8 - rate(:,432) = 2.2e-11_r8 - rate(:,433) = 5e-11_r8 - rate(:,468) = 1.7e-13_r8 - rate(:,470) = 2.607e-10_r8 - rate(:,471) = 9.75e-11_r8 - rate(:,472) = 2.07e-10_r8 - rate(:,473) = 2.088e-10_r8 - rate(:,474) = 1.17e-10_r8 - rate(:,475) = 4.644e-11_r8 - rate(:,476) = 1.204e-10_r8 - rate(:,477) = 9.9e-11_r8 - rate(:,478) = 3.3e-12_r8 - rate(:,497) = 4.5e-11_r8 - rate(:,498) = 4.62e-10_r8 - rate(:,499) = 1.2e-10_r8 - rate(:,500) = 9e-11_r8 - rate(:,501) = 3e-11_r8 - rate(:,506) = 2.14e-11_r8 - rate(:,507) = 1.9e-10_r8 - rate(:,520) = 2.57e-10_r8 - rate(:,521) = 1.8e-10_r8 - rate(:,522) = 1.794e-10_r8 - rate(:,523) = 1.3e-10_r8 - rate(:,524) = 7.65e-11_r8 - rate(:,533) = 1.31e-10_r8 - rate(:,534) = 3.5e-11_r8 - rate(:,535) = 9e-12_r8 - rate(:,558) = 0.047_r8 - rate(:,559) = 7.7e-05_r8 - rate(:,560) = 0.171_r8 - rate(:,564) = 6e-11_r8 - rate(:,567) = 1e-12_r8 - rate(:,568) = 4e-10_r8 - rate(:,569) = 2e-10_r8 - rate(:,570) = 1e-10_r8 - rate(:,571) = 5e-16_r8 - rate(:,572) = 4.4e-10_r8 - rate(:,573) = 9e-10_r8 - rate(:,575) = 1.3e-10_r8 - rate(:,578) = 8e-10_r8 - rate(:,579) = 5e-12_r8 - rate(:,580) = 7e-10_r8 - rate(:,583) = 4.8e-10_r8 - rate(:,584) = 1e-10_r8 - rate(:,585) = 4e-10_r8 - - do n = 1,pver - offset = (n-1)*ncol - itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,n) - end do - - rate(:,335) = 1.8e-11_r8 * exp( 390._r8 * itemp(:) ) - rate(:,385) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) - rate(:,386) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) - exp_fac(:) = exp( 55._r8 * itemp(:) ) - rate(:,387) = 2.64e-11_r8 * exp_fac(:) - rate(:,388) = 6.6e-12_r8 * exp_fac(:) - rate(:,392) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) - rate(:,394) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) - rate(:,397) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) - rate(:,398) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) - rate(:,401) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) - rate(:,402) = 1.4e-12_r8 * exp( -2000._r8 * itemp(:) ) - exp_fac(:) = exp( 200._r8 * itemp(:) ) - rate(:,407) = 3e-11_r8 * exp_fac(:) - rate(:,495) = 5.5e-12_r8 * exp_fac(:) - rate(:,530) = 3.8e-12_r8 * exp_fac(:) - rate(:,408) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) - rate(:,409) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) - rate(:,410) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) - exp_fac(:) = exp( 250._r8 * itemp(:) ) - rate(:,412) = 4.8e-11_r8 * exp_fac(:) - rate(:,493) = 1.7e-11_r8 * exp_fac(:) - rate(:,413) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) - rate(:,414) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) - rate(:,418) = 1.3e-12_r8 * exp( 380._r8 * itemp(:) ) - rate(:,421) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) - exp_fac(:) = exp( 220._r8 * itemp(:) ) - rate(:,422) = 2.9e-12_r8 * exp_fac(:) - rate(:,423) = 1.45e-12_r8 * exp_fac(:) - rate(:,424) = 1.45e-12_r8 * exp_fac(:) - rate(:,425) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) - rate(:,426) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) - exp_fac(:) = exp( -2450._r8 * itemp(:) ) - rate(:,427) = 1.2e-13_r8 * exp_fac(:) - rate(:,453) = 3e-11_r8 * exp_fac(:) - rate(:,430) = 1.5e-11_r8 * exp( 170._r8 * itemp(:) ) - exp_fac(:) = exp( 270._r8 * itemp(:) ) - rate(:,434) = 3.3e-12_r8 * exp_fac(:) - rate(:,449) = 1.4e-11_r8 * exp_fac(:) - rate(:,463) = 7.4e-12_r8 * exp_fac(:) - exp_fac(:) = exp( -1500._r8 * itemp(:) ) - rate(:,435) = 3e-12_r8 * exp_fac(:) - rate(:,494) = 5.8e-12_r8 * exp_fac(:) - exp_fac(:) = exp( 20._r8 * itemp(:) ) - rate(:,437) = 7.26e-11_r8 * exp_fac(:) - rate(:,438) = 4.64e-11_r8 * exp_fac(:) - rate(:,445) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) - rate(:,446) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) - rate(:,447) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) - rate(:,448) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) - rate(:,450) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) - rate(:,451) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) - rate(:,452) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) - rate(:,454) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) - rate(:,455) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) - exp_fac(:) = exp( 290._r8 * itemp(:) ) - rate(:,456) = 2.6e-12_r8 * exp_fac(:) - rate(:,457) = 6.4e-12_r8 * exp_fac(:) - rate(:,487) = 4.1e-13_r8 * exp_fac(:) - rate(:,458) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) - exp_fac(:) = exp( -840._r8 * itemp(:) ) - rate(:,460) = 3.6e-12_r8 * exp_fac(:) - rate(:,509) = 2e-12_r8 * exp_fac(:) - rate(:,461) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) - rate(:,462) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) - exp_fac(:) = exp( 230._r8 * itemp(:) ) - rate(:,464) = 6e-13_r8 * exp_fac(:) - rate(:,484) = 1.5e-12_r8 * exp_fac(:) - rate(:,492) = 1.9e-11_r8 * exp_fac(:) - rate(:,465) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) - rate(:,466) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) - rate(:,467) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) - exp_fac(:) = exp( -500._r8 * itemp(:) ) - rate(:,469) = 3e-12_r8 * exp_fac(:) - rate(:,503) = 1.4e-10_r8 * exp_fac(:) - exp_fac(:) = exp( -800._r8 * itemp(:) ) - rate(:,481) = 1.7e-11_r8 * exp_fac(:) - rate(:,508) = 6.3e-12_r8 * exp_fac(:) - rate(:,482) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) - rate(:,483) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) - rate(:,485) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) - exp_fac(:) = exp( 260._r8 * itemp(:) ) - rate(:,486) = 2.3e-12_r8 * exp_fac(:) - rate(:,489) = 8.8e-12_r8 * exp_fac(:) - rate(:,488) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) - rate(:,491) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) - rate(:,496) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) - rate(:,502) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) - exp_fac(:) = exp( 0._r8 * itemp(:) ) - rate(:,504) = 1.4e-11_r8 * exp_fac(:) - rate(:,506) = 2.14e-11_r8 * exp_fac(:) - rate(:,507) = 1.9e-10_r8 * exp_fac(:) - rate(:,520) = 2.57e-10_r8 * exp_fac(:) - rate(:,521) = 1.8e-10_r8 * exp_fac(:) - rate(:,522) = 1.794e-10_r8 * exp_fac(:) - rate(:,523) = 1.3e-10_r8 * exp_fac(:) - rate(:,524) = 7.65e-11_r8 * exp_fac(:) - rate(:,533) = 1.31e-10_r8 * exp_fac(:) - rate(:,534) = 3.5e-11_r8 * exp_fac(:) - rate(:,535) = 9e-12_r8 * exp_fac(:) - rate(:,558) = 0.047_r8 * exp_fac(:) - rate(:,559) = 7.7e-05_r8 * exp_fac(:) - rate(:,560) = 0.171_r8 * exp_fac(:) - rate(:,564) = 6e-11_r8 * exp_fac(:) - rate(:,567) = 1e-12_r8 * exp_fac(:) - rate(:,568) = 4e-10_r8 * exp_fac(:) - rate(:,569) = 2e-10_r8 * exp_fac(:) - rate(:,570) = 1e-10_r8 * exp_fac(:) - rate(:,571) = 5e-16_r8 * exp_fac(:) - rate(:,572) = 4.4e-10_r8 * exp_fac(:) - rate(:,573) = 9e-10_r8 * exp_fac(:) - rate(:,575) = 1.3e-10_r8 * exp_fac(:) - rate(:,578) = 8e-10_r8 * exp_fac(:) - rate(:,579) = 5e-12_r8 * exp_fac(:) - rate(:,580) = 7e-10_r8 * exp_fac(:) - rate(:,583) = 4.8e-10_r8 * exp_fac(:) - rate(:,584) = 1e-10_r8 * exp_fac(:) - rate(:,585) = 4e-10_r8 * exp_fac(:) - rate(:,505) = 6e-12_r8 * exp( 400._r8 * itemp(:) ) - rate(:,510) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) - rate(:,511) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) - rate(:,512) = 1.64e-12_r8 * exp( -1520._r8 * itemp(:) ) - rate(:,513) = 2.03e-11_r8 * exp( -1100._r8 * itemp(:) ) - rate(:,514) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) - rate(:,515) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) - rate(:,516) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) - exp_fac(:) = exp( -1600._r8 * itemp(:) ) - rate(:,517) = 1.25e-12_r8 * exp_fac(:) - rate(:,526) = 3.4e-11_r8 * exp_fac(:) - rate(:,518) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) - rate(:,519) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) - rate(:,525) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) - rate(:,527) = 5.5e-12_r8 * exp( 125._r8 * itemp(:) ) - rate(:,528) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) - rate(:,529) = 2.8e-12_r8 * exp( 300._r8 * itemp(:) ) - rate(:,531) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) - - itemp(:) = 300._r8 * itemp(:) - + real(r8) :: itemp(ncol,pver) + real(r8) :: exp_fac(ncol,pver) + real(r8) :: ko(ncol,pver) + real(r8) :: kinf(ncol,pver) + + rate(:,:,100) = 9.6e-10_r8 + rate(:,:,101) = 1.3e-09_r8 + rate(:,:,102) = 2e-29_r8 + rate(:,:,103) = 1e-27_r8 + rate(:,:,104) = 1.6e-09_r8 + rate(:,:,105) = 6e-12_r8 + rate(:,:,106) = 2.9e-12_r8 + rate(:,:,107) = 2.9e-11_r8 + rate(:,:,108) = 2e-10_r8 + rate(:,:,109) = 1e-10_r8 + rate(:,:,110) = 1e-10_r8 + rate(:,:,111) = 1e-11_r8 + rate(:,:,112) = 1.7e-10_r8 + rate(:,:,113) = 1e-28_r8 + rate(:,:,114) = 1e-28_r8 + rate(:,:,115) = 4e-11_r8 + rate(:,:,116) = 4e-11_r8 + rate(:,:,117) = 3.5e-12_r8 + rate(:,:,118) = 3.5e-12_r8 + rate(:,:,119) = 3.51e-10_r8 + rate(:,:,120) = 1.1e-10_r8 + rate(:,:,121) = 6e-15_r8 + rate(:,:,122) = 1e-10_r8 + rate(:,:,123) = 1e-10_r8 + rate(:,:,124) = 2.2e-10_r8 + rate(:,:,125) = 1.2e-09_r8 + rate(:,:,126) = 1.4e-10_r8 + rate(:,:,127) = 1.3e-10_r8 + rate(:,:,133) = 1.5e-06_r8 + rate(:,:,134) = 2e-09_r8 + rate(:,:,135) = 1e-09_r8 + rate(:,:,136) = 3.6e-06_r8 + rate(:,:,137) = 4e-12_r8 + rate(:,:,138) = 1e-09_r8 + rate(:,:,139) = 5e-06_r8 + rate(:,:,140) = 7e-12_r8 + rate(:,:,280) = 1e-10_r8 + rate(:,:,281) = 1e-10_r8 + rate(:,:,282) = 3e-10_r8 + rate(:,:,283) = 1.6e-28_r8 + rate(:,:,284) = 1.4e-09_r8 + rate(:,:,285) = 1.6e-09_r8 + rate(:,:,286) = 2e-13_r8 + rate(:,:,287) = 1.2e-10_r8 + rate(:,:,288) = 7e-10_r8 + rate(:,:,289) = 1.6e-28_r8 + rate(:,:,290) = 1.6e-09_r8 + rate(:,:,291) = 1.6e-28_r8 + rate(:,:,292) = 7e-10_r8 + rate(:,:,293) = 1e-12_r8 + rate(:,:,294) = 7.6e-10_r8 + rate(:,:,295) = 1.45e-26_r8 + rate(:,:,296) = 5e-12_r8 + rate(:,:,297) = 1e-13_r8 + rate(:,:,298) = 2e-06_r8 + rate(:,:,299) = 2e-06_r8 + rate(:,:,300) = 7e-11_r8 + rate(:,:,301) = 1.5e-06_r8 + rate(:,:,302) = 1e-09_r8 + rate(:,:,303) = 1.5e-06_r8 + rate(:,:,304) = 7e-12_r8 + rate(:,:,305) = 5e-10_r8 + rate(:,:,306) = 1e-10_r8 + rate(:,:,307) = 1e-09_r8 + rate(:,:,308) = 1e-09_r8 + rate(:,:,309) = 1e-10_r8 + rate(:,:,310) = 1e-10_r8 + rate(:,:,311) = 9.9e-30_r8 + rate(:,:,312) = 1.4e-09_r8 + rate(:,:,313) = 1.6e-09_r8 + rate(:,:,314) = 2.9e-09_r8 + rate(:,:,315) = 7e-10_r8 + rate(:,:,316) = 2e-10_r8 + rate(:,:,317) = 3.4e-31_r8 + rate(:,:,318) = 7.8e-10_r8 + rate(:,:,319) = 1.5e-10_r8 + rate(:,:,320) = 1.5e-10_r8 + rate(:,:,321) = 2e-06_r8 + rate(:,:,322) = 9e-10_r8 + rate(:,:,323) = 2.4e-10_r8 + rate(:,:,324) = 2.8e-28_r8 + rate(:,:,325) = 5.5e-10_r8 + rate(:,:,326) = 8.4e-10_r8 + rate(:,:,327) = 1e-10_r8 + rate(:,:,328) = 1e-10_r8 + rate(:,:,329) = 2.5e-10_r8 + rate(:,:,330) = 4.3e-10_r8 + rate(:,:,331) = 4e-10_r8 + rate(:,:,332) = 1.7e-09_r8 + rate(:,:,333) = 3e-10_r8 + rate(:,:,334) = 1.5e-10_r8 + rate(:,:,336) = 1e-10_r8 + rate(:,:,337) = 1e-10_r8 + rate(:,:,338) = 7.6e-28_r8 + rate(:,:,339) = 1.4e-09_r8 + rate(:,:,340) = 1e-09_r8 + rate(:,:,341) = 1.1e-09_r8 + rate(:,:,342) = 2e-10_r8 + rate(:,:,343) = 9e-10_r8 + rate(:,:,345) = 1e-10_r8 + rate(:,:,346) = 1e-10_r8 + rate(:,:,347) = 2e-28_r8 + rate(:,:,348) = 5.8e-10_r8 + rate(:,:,349) = 3.2e-11_r8 + rate(:,:,350) = 6e-13_r8 + rate(:,:,351) = 2e-09_r8 + rate(:,:,352) = 3.6e-09_r8 + rate(:,:,353) = 5e-13_r8 + rate(:,:,354) = 1e-09_r8 + rate(:,:,355) = 1.9e-10_r8 + rate(:,:,356) = 3e-10_r8 + rate(:,:,357) = 2.9e-31_r8 + rate(:,:,358) = 8e-10_r8 + rate(:,:,382) = 0.000258_r8 + rate(:,:,383) = 0.085_r8 + rate(:,:,384) = 1.2e-10_r8 + rate(:,:,389) = 1.2e-10_r8 + rate(:,:,390) = 1e-20_r8 + rate(:,:,391) = 1.3e-16_r8 + rate(:,:,393) = 4.2e-13_r8 + rate(:,:,395) = 8e-14_r8 + rate(:,:,396) = 3.9e-17_r8 + rate(:,:,403) = 6.9e-12_r8 + rate(:,:,404) = 7.2e-11_r8 + rate(:,:,405) = 1.6e-12_r8 + rate(:,:,411) = 1.8e-12_r8 + rate(:,:,415) = 1.8e-12_r8 + rate(:,:,419) = 7e-13_r8 + rate(:,:,420) = 5e-12_r8 + rate(:,:,429) = 3.5e-12_r8 + rate(:,:,431) = 1e-11_r8 + rate(:,:,432) = 2.2e-11_r8 + rate(:,:,433) = 5e-11_r8 + rate(:,:,468) = 1.7e-13_r8 + rate(:,:,470) = 2.607e-10_r8 + rate(:,:,471) = 9.75e-11_r8 + rate(:,:,472) = 2.07e-10_r8 + rate(:,:,473) = 2.088e-10_r8 + rate(:,:,474) = 1.17e-10_r8 + rate(:,:,475) = 4.644e-11_r8 + rate(:,:,476) = 1.204e-10_r8 + rate(:,:,477) = 9.9e-11_r8 + rate(:,:,478) = 3.3e-12_r8 + rate(:,:,497) = 4.5e-11_r8 + rate(:,:,498) = 4.62e-10_r8 + rate(:,:,499) = 1.2e-10_r8 + rate(:,:,500) = 9e-11_r8 + rate(:,:,501) = 3e-11_r8 + rate(:,:,506) = 2.14e-11_r8 + rate(:,:,507) = 1.9e-10_r8 + rate(:,:,520) = 2.57e-10_r8 + rate(:,:,521) = 1.8e-10_r8 + rate(:,:,522) = 1.794e-10_r8 + rate(:,:,523) = 1.3e-10_r8 + rate(:,:,524) = 7.65e-11_r8 + rate(:,:,533) = 1.31e-10_r8 + rate(:,:,534) = 3.5e-11_r8 + rate(:,:,535) = 9e-12_r8 + rate(:,:,558) = 0.047_r8 + rate(:,:,559) = 7.7e-05_r8 + rate(:,:,560) = 0.171_r8 + rate(:,:,564) = 6e-11_r8 + rate(:,:,567) = 1e-12_r8 + rate(:,:,568) = 4e-10_r8 + rate(:,:,569) = 2e-10_r8 + rate(:,:,570) = 1e-10_r8 + rate(:,:,571) = 5e-16_r8 + rate(:,:,572) = 4.4e-10_r8 + rate(:,:,573) = 9e-10_r8 + rate(:,:,575) = 1.3e-10_r8 + rate(:,:,578) = 8e-10_r8 + rate(:,:,579) = 5e-12_r8 + rate(:,:,580) = 7e-10_r8 + rate(:,:,583) = 4.8e-10_r8 + rate(:,:,584) = 1e-10_r8 + rate(:,:,585) = 4e-10_r8 + itemp(:ncol,:) = 1._r8 / temp(:ncol,:) n = ncol*pver - - ko(:) = 7e-31_r8 * itemp(:)**2.6_r8 - kinf(:) = 3.6e-11_r8 * itemp(:)**0.1_r8 - call jpl( rate(:,344), m, 0.6_r8, ko, kinf, n ) - - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) - call jpl( rate(:,406), m, 0.6_r8, ko, kinf, n ) - - ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 - kinf(:) = 2.6e-11_r8 - call jpl( rate(:,416), 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(:,428), m, 0.6_r8, ko, kinf, n ) - - ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 - kinf(:) = 3e-11_r8 - call jpl( rate(:,436), 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(:,439), 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(:,440), m, 0.6_r8, ko, kinf, n ) - - ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 - kinf(:) = 2.8e-11_r8 - call jpl( rate(:,441), 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(:,459), 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(:,479), 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(:,490), m, 0.6_r8, ko, kinf, n ) - - ko(:) = 5.9e-33_r8 * itemp(:)**1._r8 - kinf(:) = 1.1e-12_r8 * itemp(:)**(-1.3_r8) - call jpl( rate(:,532), m, 0.6_r8, ko, kinf, n ) + rate(:,:,335) = 1.8e-11_r8 * exp( 390._r8 * itemp(:,:) ) + rate(:,:,385) = 1.63e-10_r8 * exp( 60._r8 * itemp(:,:) ) + rate(:,:,386) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:,387) = 2.64e-11_r8 * exp_fac(:,:) + rate(:,:,388) = 6.6e-12_r8 * exp_fac(:,:) + rate(:,:,392) = 3.6e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:,394) = 1.8e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:,397) = 3.5e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:,398) = 8e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:,401) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:,:) ) + rate(:,:,402) = 1.4e-12_r8 * exp( -2000._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 200._r8 * itemp(:,:) ) + rate(:,:,407) = 3e-11_r8 * exp_fac(:,:) + rate(:,:,495) = 5.5e-12_r8 * exp_fac(:,:) + rate(:,:,530) = 3.8e-12_r8 * exp_fac(:,:) + rate(:,:,408) = 1e-14_r8 * exp( -490._r8 * itemp(:,:) ) + rate(:,:,409) = 1.4e-10_r8 * exp( -470._r8 * itemp(:,:) ) + rate(:,:,410) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 250._r8 * itemp(:,:) ) + rate(:,:,412) = 4.8e-11_r8 * exp_fac(:,:) + rate(:,:,493) = 1.7e-11_r8 * exp_fac(:,:) + rate(:,:,413) = 1.8e-11_r8 * exp( 180._r8 * itemp(:,:) ) + rate(:,:,414) = 1.7e-12_r8 * exp( -940._r8 * itemp(:,:) ) + rate(:,:,418) = 1.3e-12_r8 * exp( 380._r8 * itemp(:,:) ) + rate(:,:,421) = 2.1e-11_r8 * exp( 100._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 220._r8 * itemp(:,:) ) + rate(:,:,422) = 2.9e-12_r8 * exp_fac(:,:) + rate(:,:,423) = 1.45e-12_r8 * exp_fac(:,:) + rate(:,:,424) = 1.45e-12_r8 * exp_fac(:,:) + rate(:,:,425) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + rate(:,:,426) = 5.1e-12_r8 * exp( 210._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -2450._r8 * itemp(:,:) ) + rate(:,:,427) = 1.2e-13_r8 * exp_fac(:,:) + rate(:,:,453) = 3e-11_r8 * exp_fac(:,:) + rate(:,:,430) = 1.5e-11_r8 * exp( 170._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 270._r8 * itemp(:,:) ) + rate(:,:,434) = 3.3e-12_r8 * exp_fac(:,:) + rate(:,:,449) = 1.4e-11_r8 * exp_fac(:,:) + rate(:,:,463) = 7.4e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -1500._r8 * itemp(:,:) ) + rate(:,:,435) = 3e-12_r8 * exp_fac(:,:) + rate(:,:,494) = 5.8e-12_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( 20._r8 * itemp(:,:) ) + rate(:,:,437) = 7.26e-11_r8 * exp_fac(:,:) + rate(:,:,438) = 4.64e-11_r8 * exp_fac(:,:) + rate(:,:,445) = 8.1e-11_r8 * exp( -30._r8 * itemp(:,:) ) + rate(:,:,446) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:,:) ) + rate(:,:,447) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:,:) ) + rate(:,:,448) = 1.1e-11_r8 * exp( -980._r8 * itemp(:,:) ) + rate(:,:,450) = 3.6e-11_r8 * exp( -375._r8 * itemp(:,:) ) + rate(:,:,451) = 2.3e-11_r8 * exp( -200._r8 * itemp(:,:) ) + rate(:,:,452) = 3.3e-12_r8 * exp( -115._r8 * itemp(:,:) ) + rate(:,:,454) = 1e-12_r8 * exp( -1590._r8 * itemp(:,:) ) + rate(:,:,455) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 290._r8 * itemp(:,:) ) + rate(:,:,456) = 2.6e-12_r8 * exp_fac(:,:) + rate(:,:,457) = 6.4e-12_r8 * exp_fac(:,:) + rate(:,:,487) = 4.1e-13_r8 * exp_fac(:,:) + rate(:,:,458) = 6.5e-12_r8 * exp( 135._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -840._r8 * itemp(:,:) ) + rate(:,:,460) = 3.6e-12_r8 * exp_fac(:,:) + rate(:,:,509) = 2e-12_r8 * exp_fac(:,:) + rate(:,:,461) = 1.2e-12_r8 * exp( -330._r8 * itemp(:,:) ) + rate(:,:,462) = 2.8e-11_r8 * exp( 85._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 230._r8 * itemp(:,:) ) + rate(:,:,464) = 6e-13_r8 * exp_fac(:,:) + rate(:,:,484) = 1.5e-12_r8 * exp_fac(:,:) + rate(:,:,492) = 1.9e-11_r8 * exp_fac(:,:) + rate(:,:,465) = 1e-11_r8 * exp( -3300._r8 * itemp(:,:) ) + rate(:,:,466) = 1.8e-12_r8 * exp( -250._r8 * itemp(:,:) ) + rate(:,:,467) = 3.4e-12_r8 * exp( -130._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -500._r8 * itemp(:,:) ) + rate(:,:,469) = 3e-12_r8 * exp_fac(:,:) + rate(:,:,503) = 1.4e-10_r8 * exp_fac(:,:) + exp_fac(:,:) = exp( -800._r8 * itemp(:,:) ) + rate(:,:,481) = 1.7e-11_r8 * exp_fac(:,:) + rate(:,:,508) = 6.3e-12_r8 * exp_fac(:,:) + rate(:,:,482) = 4.8e-12_r8 * exp( -310._r8 * itemp(:,:) ) + rate(:,:,483) = 1.6e-11_r8 * exp( -780._r8 * itemp(:,:) ) + rate(:,:,485) = 9.5e-13_r8 * exp( 550._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 260._r8 * itemp(:,:) ) + rate(:,:,486) = 2.3e-12_r8 * exp_fac(:,:) + rate(:,:,489) = 8.8e-12_r8 * exp_fac(:,:) + rate(:,:,488) = 4.5e-12_r8 * exp( 460._r8 * itemp(:,:) ) + rate(:,:,491) = 1.9e-11_r8 * exp( 215._r8 * itemp(:,:) ) + rate(:,:,496) = 1.2e-10_r8 * exp( -430._r8 * itemp(:,:) ) + rate(:,:,502) = 1.6e-10_r8 * exp( -260._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 0._r8 * itemp(:,:) ) + rate(:,:,504) = 1.4e-11_r8 * exp_fac(:,:) + rate(:,:,506) = 2.14e-11_r8 * exp_fac(:,:) + rate(:,:,507) = 1.9e-10_r8 * exp_fac(:,:) + rate(:,:,520) = 2.57e-10_r8 * exp_fac(:,:) + rate(:,:,521) = 1.8e-10_r8 * exp_fac(:,:) + rate(:,:,522) = 1.794e-10_r8 * exp_fac(:,:) + rate(:,:,523) = 1.3e-10_r8 * exp_fac(:,:) + rate(:,:,524) = 7.65e-11_r8 * exp_fac(:,:) + rate(:,:,533) = 1.31e-10_r8 * exp_fac(:,:) + rate(:,:,534) = 3.5e-11_r8 * exp_fac(:,:) + rate(:,:,535) = 9e-12_r8 * exp_fac(:,:) + rate(:,:,558) = 0.047_r8 * exp_fac(:,:) + rate(:,:,559) = 7.7e-05_r8 * exp_fac(:,:) + rate(:,:,560) = 0.171_r8 * exp_fac(:,:) + rate(:,:,564) = 6e-11_r8 * exp_fac(:,:) + rate(:,:,567) = 1e-12_r8 * exp_fac(:,:) + rate(:,:,568) = 4e-10_r8 * exp_fac(:,:) + rate(:,:,569) = 2e-10_r8 * exp_fac(:,:) + rate(:,:,570) = 1e-10_r8 * exp_fac(:,:) + rate(:,:,571) = 5e-16_r8 * exp_fac(:,:) + rate(:,:,572) = 4.4e-10_r8 * exp_fac(:,:) + rate(:,:,573) = 9e-10_r8 * exp_fac(:,:) + rate(:,:,575) = 1.3e-10_r8 * exp_fac(:,:) + rate(:,:,578) = 8e-10_r8 * exp_fac(:,:) + rate(:,:,579) = 5e-12_r8 * exp_fac(:,:) + rate(:,:,580) = 7e-10_r8 * exp_fac(:,:) + rate(:,:,583) = 4.8e-10_r8 * exp_fac(:,:) + rate(:,:,584) = 1e-10_r8 * exp_fac(:,:) + rate(:,:,585) = 4e-10_r8 * exp_fac(:,:) + rate(:,:,505) = 6e-12_r8 * exp( 400._r8 * itemp(:,:) ) + rate(:,:,510) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:,:) ) + rate(:,:,511) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:,:) ) + rate(:,:,512) = 1.64e-12_r8 * exp( -1520._r8 * itemp(:,:) ) + rate(:,:,513) = 2.03e-11_r8 * exp( -1100._r8 * itemp(:,:) ) + rate(:,:,514) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:,:) ) + rate(:,:,515) = 4.85e-12_r8 * exp( -850._r8 * itemp(:,:) ) + rate(:,:,516) = 9e-13_r8 * exp( -360._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( -1600._r8 * itemp(:,:) ) + rate(:,:,517) = 1.25e-12_r8 * exp_fac(:,:) + rate(:,:,526) = 3.4e-11_r8 * exp_fac(:,:) + rate(:,:,518) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:,:) ) + rate(:,:,519) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:,:) ) + rate(:,:,525) = 6e-13_r8 * exp( -2058._r8 * itemp(:,:) ) + rate(:,:,527) = 5.5e-12_r8 * exp( 125._r8 * itemp(:,:) ) + rate(:,:,528) = 4.1e-13_r8 * exp( 750._r8 * itemp(:,:) ) + rate(:,:,529) = 2.8e-12_r8 * exp( 300._r8 * itemp(:,:) ) + rate(:,:,531) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 7e-31_r8 * itemp(:,:)**2.6_r8 + kinf(:,:) = 3.6e-11_r8 * itemp(:,:)**0.1_r8 + call jpl( rate(1,1,344), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 4.4e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 7.5e-11_r8 * itemp(:,:)**(-0.2_r8) + call jpl( rate(1,1,406), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 6.9e-31_r8 * itemp(:,:)**1._r8 + kinf(:,:) = 2.6e-11_r8 + call jpl( rate(1,1,416), 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(1,1,428), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 9e-32_r8 * itemp(:,:)**1.5_r8 + kinf(:,:) = 3e-11_r8 + call jpl( rate(1,1,436), 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(1,1,439), 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(1,1,440), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 1.8e-30_r8 * itemp(:,:)**3._r8 + kinf(:,:) = 2.8e-11_r8 + call jpl( rate(1,1,441), 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(1,1,459), 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(1,1,479), 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(1,1,490), m, 0.6_r8, ko, kinf, n ) + + ko(:,:) = 5.9e-33_r8 * itemp(:,:)**1._r8 + kinf(:,:) = 1.1e-12_r8 * itemp(:,:)**(-1.3_r8) + call jpl( rate(1,1,532), m, 0.6_r8, ko, kinf, n ) end subroutine setrxt subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) - - use ppgrid, only : pcols, pver - + use ppgrid, only : pver, pcols + use shr_kind_mod, only : r8 => shr_kind_r8 use chem_mods, only : rxntot use mo_jpl, only : jpl @@ -427,79 +418,71 @@ subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) 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)) + real(r8), intent(in) :: m(ncol,pver) + real(r8), intent(inout) :: rate(ncol,pver,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) - + 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) + + rate(:,:kbot,390) = 1e-20_r8 + rate(:,:kbot,391) = 1.3e-16_r8 + rate(:,:kbot,395) = 8e-14_r8 + rate(:,:kbot,396) = 3.9e-17_r8 + rate(:,:kbot,403) = 6.9e-12_r8 + rate(:,:kbot,419) = 7e-13_r8 + rate(:,:kbot,420) = 5e-12_r8 + rate(:,:kbot,558) = 0.047_r8 + rate(:,:kbot,559) = 7.7e-05_r8 + rate(:,:kbot,560) = 0.171_r8 + rate(:,:kbot,564) = 6e-11_r8 + rate(:,:kbot,567) = 1e-12_r8 + rate(:,:kbot,568) = 4e-10_r8 + rate(:,:kbot,569) = 2e-10_r8 + rate(:,:kbot,570) = 1e-10_r8 + rate(:,:kbot,572) = 4.4e-10_r8 + rate(:,:kbot,575) = 1.3e-10_r8 + rate(:,:kbot,578) = 8e-10_r8 + rate(:,:kbot,579) = 5e-12_r8 + rate(:,:kbot,580) = 7e-10_r8 + rate(:,:kbot,583) = 4.8e-10_r8 + rate(:,:kbot,584) = 1e-10_r8 + rate(:,:kbot,585) = 4e-10_r8 + itemp(:ncol,:kbot) = 1._r8 / temp(:ncol,:kbot) n = ncol*kbot - - rate(:n,390) = 1e-20_r8 - rate(:n,391) = 1.3e-16_r8 - rate(:n,395) = 8e-14_r8 - rate(:n,396) = 3.9e-17_r8 - rate(:n,403) = 6.9e-12_r8 - rate(:n,419) = 7e-13_r8 - rate(:n,420) = 5e-12_r8 - rate(:n,558) = 0.047_r8 - rate(:n,559) = 7.7e-05_r8 - rate(:n,560) = 0.171_r8 - rate(:n,564) = 6e-11_r8 - rate(:n,567) = 1e-12_r8 - rate(:n,568) = 4e-10_r8 - rate(:n,569) = 2e-10_r8 - rate(:n,570) = 1e-10_r8 - rate(:n,572) = 4.4e-10_r8 - rate(:n,575) = 1.3e-10_r8 - rate(:n,578) = 8e-10_r8 - rate(:n,579) = 5e-12_r8 - rate(:n,580) = 7e-10_r8 - rate(:n,583) = 4.8e-10_r8 - rate(:n,584) = 1e-10_r8 - rate(:n,585) = 4e-10_r8 - - do k = 1,kbot - offset = (k-1)*ncol - itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,k) - end do - - rate(:n,386) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) - exp_fac(:) = exp( 55._r8 * itemp(:) ) - rate(:n,387) = 2.64e-11_r8 * exp_fac(:) - rate(:n,388) = 6.6e-12_r8 * exp_fac(:) - rate(:n,392) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) - rate(:n,394) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) - rate(:n,397) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) - rate(:n,398) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) - rate(:n,407) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) - rate(:n,408) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) - rate(:n,409) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) - rate(:n,412) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) - rate(:n,413) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) - rate(:n,414) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) - rate(:n,421) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) - rate(:n,425) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) - rate(:n,426) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) - rate(:n,434) = 3.3e-12_r8 * exp( 270._r8 * itemp(:) ) - rate(:n,435) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) - - itemp(:) = 300._r8 * itemp(:) - - - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + rate(:,:kbot,386) = 2.15e-11_r8 * exp( 110._r8 * itemp(:,:) ) + exp_fac(:,:) = exp( 55._r8 * itemp(:,:) ) + rate(:,:kbot,387) = 2.64e-11_r8 * exp_fac(:,:) + rate(:,:kbot,388) = 6.6e-12_r8 * exp_fac(:,:) + rate(:,:kbot,392) = 3.6e-18_r8 * exp( -220._r8 * itemp(:,:) ) + rate(:,:kbot,394) = 1.8e-15_r8 * exp( 45._r8 * itemp(:,:) ) + rate(:,:kbot,397) = 3.5e-11_r8 * exp( -135._r8 * itemp(:,:) ) + rate(:,:kbot,398) = 8e-12_r8 * exp( -2060._r8 * itemp(:,:) ) + rate(:,:kbot,407) = 3e-11_r8 * exp( 200._r8 * itemp(:,:) ) + rate(:,:kbot,408) = 1e-14_r8 * exp( -490._r8 * itemp(:,:) ) + rate(:,:kbot,409) = 1.4e-10_r8 * exp( -470._r8 * itemp(:,:) ) + rate(:,:kbot,412) = 4.8e-11_r8 * exp( 250._r8 * itemp(:,:) ) + rate(:,:kbot,413) = 1.8e-11_r8 * exp( 180._r8 * itemp(:,:) ) + rate(:,:kbot,414) = 1.7e-12_r8 * exp( -940._r8 * itemp(:,:) ) + rate(:,:kbot,421) = 2.1e-11_r8 * exp( 100._r8 * itemp(:,:) ) + rate(:,:kbot,425) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:,:) ) + rate(:,:kbot,426) = 5.1e-12_r8 * exp( 210._r8 * itemp(:,:) ) + rate(:,:kbot,434) = 3.3e-12_r8 * exp( 270._r8 * itemp(:,:) ) + rate(:,:kbot,435) = 3e-12_r8 * exp( -1500._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + + ko(:,:) = 4.4e-32_r8 * itemp(:,:)**1.3_r8 + kinf(:,:) = 7.5e-11_r8 * itemp(:,:)**(-0.2_r8) call jpl( wrk, m, 0.6_r8, ko, kinf, n ) - rate(:n,406) = wrk(:) + rate(:,:kbot,406) = wrk(:,:) diff --git a/src/chemistry/pp_waccm_mad/mo_sim_dat.F90 b/src/chemistry/pp_waccm_mad/mo_sim_dat.F90 index bf157d0e10..6a19249967 100644 --- a/src/chemistry/pp_waccm_mad/mo_sim_dat.F90 +++ b/src/chemistry/pp_waccm_mad/mo_sim_dat.F90 @@ -28,29 +28,29 @@ subroutine set_sim_dat !-------------------------------------------------------------- integer :: ios - is_scalar = .false. - is_vector = .true. + is_scalar = .true. + is_vector = .false. - clscnt(:) = (/ 22, 0, 0, 88, 0 /) + clscnt(:) = (/ 23, 0, 0, 87, 0 /) - cls_rxt_cnt(:,1) = (/ 1, 56, 0, 22 /) - cls_rxt_cnt(:,4) = (/ 28, 151, 405, 88 /) + cls_rxt_cnt(:,1) = (/ 66, 66, 0, 23 /) + cls_rxt_cnt(:,4) = (/ 30, 158, 396, 87 /) - solsym(:110) = (/ 'BRCL ','BRO ','BRONO2 ','BRY ','CCL4 ', & - 'CF2CLBR ','CF3BR ','CFC11 ','CFC113 ','CFC114 ', & - 'CFC115 ','CFC12 ','CH2BR2 ','CH2O ','CH3BR ', & - 'CH3CCL3 ','CH3CL ','CH3O2 ','CH3OOH ','CH4 ', & - 'CHBR3 ','CL2 ','CL2O2 ','CLO ','CLONO2 ', & - 'CLY ','CO ','CO2 ','COF2 ','COFCL ', & - 'F ','H ','H2 ','H2402 ','H2O2 ', & - 'HBR ','HCFC141B ','HCFC142B ','HCFC22 ','HCL ', & - 'HF ','HNO3 ','HO2 ','HO2NO2 ','HOBR ', & - 'HOCL ','HONO ','N ','N2O ','N2O5 ', & - 'NO ','NO2 ','NO3 ','O ','O2 ', & - 'O3 ','OCLO ','SF6 ','BR ','CL ', & - 'CLm ','CLm_H2O ','CLm_HCL ','CLOm ','CO3m ', & - 'CO3m2H2O ','CO3m_H2O ','CO4m ','e ','H3Op_OH ', & - 'HCO3m ','Hp_2H2O ','Hp_3H2O ','Hp_3N1 ','Hp_4H2O ', & + solsym(:110) = (/ 'BR ','BRCL ','BRO ','BRONO2 ','BRY ', & + 'CCL4 ','CF2CLBR ','CF3BR ','CFC11 ','CFC113 ', & + 'CFC114 ','CFC115 ','CFC12 ','CH2BR2 ','CH2O ', & + 'CH3BR ','CH3CCL3 ','CH3CL ','CH3O2 ','CH3OOH ', & + 'CH4 ','CHBR3 ','CL ','CL2 ','CL2O2 ', & + 'CLO ','CLONO2 ','CLY ','CO ','CO2 ', & + 'COF2 ','COFCL ','F ','H ','H2 ', & + 'H2402 ','H2O2 ','HBR ','HCFC141B ','HCFC142B ', & + 'HCFC22 ','HCL ','HF ','HNO3 ','HO2NO2 ', & + 'HOBR ','HOCL ','HONO ','N ','N2O ', & + 'N2O5 ','NO ','NO2 ','NO3 ','O ', & + 'O2 ','O3 ','OCLO ','SF6 ','CLm ', & + 'CLm_H2O ','CLm_HCL ','CLOm ','CO3m ','CO3m2H2O ', & + 'CO3m_H2O ','CO4m ','e ','H3Op_OH ','HCO3m ', & + 'HO2 ','Hp_2H2O ','Hp_3H2O ','Hp_3N1 ','Hp_4H2O ', & 'Hp_4N1 ','Hp_5H2O ','Hp_H2O ','N2D ','N2p ', & 'NO2m ','NO2m_H2O ','NO3m ','NO3m2H2O ','NO3m_H2O ', & 'NO3m_HCL ','NO3mHNO3 ','NOp ','NOp_2H2O ','NOp_3H2O ', & @@ -59,21 +59,21 @@ subroutine set_sim_dat 'O3m ','O4m ','O4p ','OH ','OHm ', & 'Om ','Op ','Op2D ','Op2P ','H2O ' /) - adv_mass(:110) = (/ 115.356700_r8, 95.903400_r8, 141.908940_r8, 99.716850_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, 50.485900_r8, 47.032000_r8, 48.039400_r8, 16.040600_r8, & - 252.730400_r8, 70.905400_r8, 102.904200_r8, 51.452100_r8, 97.457640_r8, & - 100.916850_r8, 28.010400_r8, 44.009800_r8, 66.007206_r8, 82.461503_r8, & - 18.998403_r8, 1.007400_r8, 2.014800_r8, 259.823613_r8, 34.013600_r8, & - 80.911400_r8, 116.948003_r8, 100.493706_r8, 86.467906_r8, 36.460100_r8, & - 20.005803_r8, 63.012340_r8, 33.006200_r8, 79.011740_r8, 96.910800_r8, & - 52.459500_r8, 47.012940_r8, 14.006740_r8, 44.012880_r8, 108.010480_r8, & - 30.006140_r8, 46.005540_r8, 62.004940_r8, 15.999400_r8, 31.998800_r8, & - 47.998200_r8, 67.451500_r8, 146.056419_r8, 79.904000_r8, 35.452700_r8, & - 35.452700_r8, 53.466900_r8, 71.912800_r8, 51.452100_r8, 60.009200_r8, & - 96.037600_r8, 78.023400_r8, 76.008600_r8, 0.548567E-03_r8, 36.028400_r8, & - 61.016600_r8, 37.035800_r8, 55.050000_r8, 118.062340_r8, 73.064200_r8, & + adv_mass(:110) = (/ 79.904000_r8, 115.356700_r8, 95.903400_r8, 141.908940_r8, 99.716850_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, 50.485900_r8, 47.032000_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, & + 66.007206_r8, 82.461503_r8, 18.998403_r8, 1.007400_r8, 2.014800_r8, & + 259.823613_r8, 34.013600_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, 47.012940_r8, 14.006740_r8, 44.012880_r8, & + 108.010480_r8, 30.006140_r8, 46.005540_r8, 62.004940_r8, 15.999400_r8, & + 31.998800_r8, 47.998200_r8, 67.451500_r8, 146.056419_r8, 35.452700_r8, & + 53.466900_r8, 71.912800_r8, 51.452100_r8, 60.009200_r8, 96.037600_r8, & + 78.023400_r8, 76.008600_r8, 0.548567E-03_r8, 36.028400_r8, 61.016600_r8, & + 33.006200_r8, 37.035800_r8, 55.050000_r8, 118.062340_r8, 73.064200_r8, & 136.076540_r8, 91.078400_r8, 19.021600_r8, 14.006740_r8, 28.013480_r8, & 46.005540_r8, 64.019740_r8, 62.004940_r8, 98.033340_r8, 80.019140_r8, & 98.465040_r8, 125.017280_r8, 30.006140_r8, 66.034540_r8, 68.049340_r8, & @@ -82,21 +82,21 @@ subroutine set_sim_dat 47.998200_r8, 63.997600_r8, 63.997600_r8, 17.006800_r8, 17.006800_r8, & 15.999400_r8, 15.999400_r8, 15.999400_r8, 15.999400_r8, 18.014200_r8 /) - crb_mass(:110) = (/ 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_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, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + crb_mass(:110) = (/ 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, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 24.022000_r8, 12.011000_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, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 24.022000_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, & - 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & - 0.000000_r8, 0.000000_r8, 0.000000_r8, 24.022000_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, & 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, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 12.011000_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, 0.000000_r8, 0.000000_r8, & - 12.011000_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, & 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, 0.000000_r8, & @@ -107,38 +107,38 @@ subroutine set_sim_dat fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) - clsmap(: 22,1) = (/ 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, & - 15, 16, 17, 20, 21, 26, 34, 37, 38, 39, & - 49, 58 /) - clsmap(: 88,4) = (/ 1, 2, 3, 14, 18, 19, 22, 23, 24, 25, & - 27, 29, 30, 28, 31, 32, 33, 35, 36, 40, & - 41, 42, 43, 44, 45, 46, 47, 48, 50, 51, & - 52, 53, 54, 55, 56, 57, 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 /) + clsmap(: 23,1) = (/ 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, & + 16, 17, 18, 21, 22, 28, 30, 36, 39, 40, & + 41, 50, 59 /) + clsmap(: 87,4) = (/ 1, 2, 3, 4, 15, 19, 20, 23, 24, 25, & + 26, 27, 29, 31, 32, 33, 34, 35, 37, 38, & + 42, 43, 44, 45, 46, 47, 48, 49, 51, 52, & + 53, 54, 55, 56, 57, 58, 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 /) - permute(: 88,4) = (/ 6, 52, 17, 56, 39, 12, 4, 1, 81, 34, & - 25, 2, 5, 78, 30, 86, 50, 18, 33, 80, & - 7, 71, 61, 14, 28, 32, 24, 40, 37, 87, & - 72, 74, 68, 75, 79, 3, 44, 85, 58, 46, & - 45, 35, 64, 43, 54, 59, 69, 11, 42, 21, & - 65, 8, 73, 9, 82, 26, 29, 19, 62, 47, & - 60, 53, 55, 48, 51, 66, 67, 13, 23, 70, & - 22, 31, 57, 36, 10, 76, 77, 27, 49, 20, & - 41, 63, 83, 84, 38, 16, 15, 88 /) + permute(: 87,4) = (/ 44, 6, 50, 20, 56, 40, 11, 74, 4, 1, & + 72, 36, 21, 2, 5, 29, 68, 51, 23, 32, & + 67, 7, 85, 15, 30, 33, 25, 39, 38, 77, & + 71, 86, 81, 73, 84, 3, 59, 46, 45, 37, & + 63, 43, 54, 58, 79, 12, 41, 61, 24, 70, & + 9, 78, 10, 80, 26, 28, 22, 64, 47, 60, & + 53, 55, 49, 52, 65, 66, 13, 17, 69, 16, & + 31, 57, 34, 8, 75, 76, 27, 48, 14, 42, & + 62, 82, 83, 35, 19, 18, 87 /) - diag_map(: 88) = (/ 1, 4, 7, 10, 12, 16, 19, 22, 26, 30, & - 33, 39, 45, 51, 58, 65, 71, 79, 86, 95, & - 102, 108, 116, 123, 128, 134, 142, 151, 159, 168, & - 176, 184, 191, 201, 211, 219, 229, 244, 257, 270, & - 285, 297, 311, 328, 340, 356, 371, 385, 401, 419, & - 438, 457, 477, 497, 519, 541, 573, 597, 619, 652, & - 686, 712, 755, 785, 829, 878, 922, 979,1023,1066, & - 1107,1153,1197,1233,1277,1314,1360,1403,1442,1488, & - 1532,1576,1610,1647,1691,1728,1771,1825 /) + diag_map(: 87) = (/ 1, 4, 7, 10, 12, 16, 19, 22, 25, 29, & + 33, 39, 45, 51, 57, 64, 71, 77, 84, 90, & + 98, 102, 111, 118, 124, 130, 138, 146, 155, 164, & + 172, 179, 188, 195, 206, 219, 229, 239, 253, 266, & + 277, 292, 304, 320, 331, 347, 362, 376, 390, 411, & + 431, 450, 466, 486, 507, 529, 560, 583, 613, 636, & + 670, 711, 739, 769, 817, 860, 905, 941, 983,1026, & + 1071,1114,1158,1201,1237,1282,1324,1367,1410,1453, & + 1509,1542,1578,1617,1657,1692,1745 /) extfrc_lst(: 12) = (/ 'NO2 ','NO ','CO ','N2p ','Np ', & 'O ','O2p ','OH ','Op ','e ', & @@ -150,17 +150,16 @@ subroutine set_sim_dat inv_lst(: 2) = (/ 'M ', 'N2 ' /) - slvd_lst(: 51) = (/ 'BR ', 'CL ', 'CLm ', 'CLm_H2O ', 'CLm_HCL ', & - 'CLOm ', 'CO3m ', 'CO3m2H2O ', 'CO3m_H2O ', 'CO4m ', & - 'e ', 'H3Op_OH ', 'HCO3m ', 'Hp_2H2O ', 'Hp_3H2O ', & - 'Hp_3N1 ', 'Hp_4H2O ', 'Hp_4N1 ', 'Hp_5H2O ', 'Hp_H2O ', & - 'N2D ', 'N2p ', 'NO2m ', 'NO2m_H2O ', 'NO3m ', & - 'NO3m2H2O ', 'NO3m_H2O ', 'NO3m_HCL ', 'NO3mHNO3 ', 'NOp ', & - 'NOp_2H2O ', 'NOp_3H2O ', 'NOp_CO2 ', 'NOp_H2O ', 'NOp_N2 ', & - 'Np ', 'O1D ', 'O2_1D ', 'O2_1S ', 'O2m ', & - 'O2p ', 'O2p_H2O ', 'O3m ', 'O4m ', 'O4p ', & - 'OH ', 'OHm ', 'Om ', 'Op ', 'Op2D ', & - 'Op2P ' /) + slvd_lst(: 50) = (/ 'CLm ', 'CLm_H2O ', 'CLm_HCL ', 'CLOm ', 'CO3m ', & + 'CO3m2H2O ', 'CO3m_H2O ', 'CO4m ', 'e ', 'H3Op_OH ', & + 'HCO3m ', 'HO2 ', 'Hp_2H2O ', 'Hp_3H2O ', 'Hp_3N1 ', & + 'Hp_4H2O ', 'Hp_4N1 ', 'Hp_5H2O ', 'Hp_H2O ', 'N2D ', & + 'N2p ', 'NO2m ', 'NO2m_H2O ', 'NO3m ', 'NO3m2H2O ', & + 'NO3m_H2O ', 'NO3m_HCL ', 'NO3mHNO3 ', 'NOp ', 'NOp_2H2O ', & + 'NOp_3H2O ', 'NOp_CO2 ', 'NOp_H2O ', 'NOp_N2 ', 'Np ', & + 'O1D ', 'O2_1D ', 'O2_1S ', 'O2m ', 'O2p ', & + 'O2p_H2O ', 'O3m ', 'O4m ', 'O4p ', 'OH ', & + 'OHm ', 'Om ', 'Op ', 'Op2D ', 'Op2P ' /) if( allocated( rxt_tag_lst ) ) then deallocate( rxt_tag_lst ) diff --git a/src/chemistry/pp_waccm_mad_mam4/chem_mech.doc b/src/chemistry/pp_waccm_mad_mam4/chem_mech.doc index 5c3f0e5286..011c594762 100644 --- a/src/chemistry/pp_waccm_mad_mam4/chem_mech.doc +++ b/src/chemistry/pp_waccm_mad_mam4/chem_mech.doc @@ -3,126 +3,126 @@ Solution species ( 1) bc_a1 (C) ( 2) bc_a4 (C) - ( 3) BRCL (BrCl) - ( 4) BRO (BrO) - ( 5) BRONO2 (BrONO2) - ( 6) BRY - ( 7) CCL4 (CCl4) - ( 8) CF2CLBR (CF2ClBr) - ( 9) CF3BR (CF3Br) - ( 10) CFC11 (CFCl3) - ( 11) CFC113 (CCl2FCClF2) - ( 12) CFC114 (CClF2CClF2) - ( 13) CFC115 (CClF2CF3) - ( 14) CFC12 (CF2Cl2) - ( 15) CH2BR2 (CH2Br2) - ( 16) CH2O - ( 17) CH3BR (CH3Br) - ( 18) CH3CCL3 (CH3CCl3) - ( 19) CH3CL (CH3Cl) - ( 20) CH3O2 - ( 21) CH3OOH - ( 22) CH4 - ( 23) CHBR3 (CHBr3) - ( 24) CL2 (Cl2) - ( 25) CL2O2 (Cl2O2) - ( 26) CLO (ClO) - ( 27) CLONO2 (ClONO2) - ( 28) CLY - ( 29) CO - ( 30) CO2 - ( 31) COF2 - ( 32) COFCL (COFCl) - ( 33) DMS (CH3SCH3) - ( 34) dst_a1 (AlSiO5) - ( 35) dst_a2 (AlSiO5) - ( 36) dst_a3 (AlSiO5) - ( 37) F - ( 38) H - ( 39) H2 - ( 40) H2402 (CBrF2CBrF2) - ( 41) H2O2 - ( 42) H2SO4 (H2SO4) - ( 43) HBR (HBr) - ( 44) HCFC141B (CH3CCl2F) - ( 45) HCFC142B (CH3CClF2) - ( 46) HCFC22 (CHF2Cl) - ( 47) HCL (HCl) - ( 48) HF - ( 49) HNO3 - ( 50) HO2NO2 - ( 51) HOBR (HOBr) - ( 52) HOCL (HOCl) - ( 53) HONO - ( 54) N - ( 55) N2O - ( 56) N2O5 - ( 57) ncl_a1 (NaCl) - ( 58) ncl_a2 (NaCl) - ( 59) ncl_a3 (NaCl) - ( 60) NO - ( 61) NO2 - ( 62) NO3 - ( 63) num_a1 (H) - ( 64) num_a2 (H) - ( 65) num_a3 (H) - ( 66) num_a4 (H) - ( 67) O - ( 68) O2 - ( 69) O3 - ( 70) OCLO (OClO) - ( 71) OCS (OCS) - ( 72) pom_a1 (C) - ( 73) pom_a4 (C) - ( 74) S (S) - ( 75) SF6 - ( 76) SO (SO) - ( 77) SO2 - ( 78) SO3 (SO3) - ( 79) so4_a1 (NH4HSO4) - ( 80) so4_a2 (NH4HSO4) - ( 81) so4_a3 (NH4HSO4) - ( 82) soa_a1 (C) - ( 83) soa_a2 (C) - ( 84) SOAG (C) - ( 85) BR (Br) - ( 86) CL (Cl) - ( 87) CLm (Cl) - ( 88) CLm_H2O (ClH2O) - ( 89) CLm_HCL (Cl2H) - ( 90) CLOm (ClO) - ( 91) CO3m (CO3) - ( 92) CO3m2H2O (H4CO5) - ( 93) CO3m_H2O (H2CO4) - ( 94) CO4m (CO4) - ( 95) e (E) - ( 96) H3Op_OH (H4O2) - ( 97) HCO3m (HCO3) - ( 98) HO2 - ( 99) Hp_2H2O (H5O2) - (100) Hp_3H2O (H7O3) - (101) Hp_3N1 (H8NO6) - (102) Hp_4H2O (H9O4) - (103) Hp_4N1 (H10NO7) - (104) Hp_5H2O (H11O5) - (105) Hp_H2O (H3O) - (106) N2D (N) - (107) N2p (N2) - (108) NO2m (NO2) - (109) NO2m_H2O (H2NO3) - (110) NO3m (NO3) - (111) NO3m2H2O (H4NO5) - (112) NO3m_H2O (H2NO4) - (113) NO3m_HCL (NO3HCl) - (114) NO3mHNO3 (HN2O6) - (115) NOp (NO) - (116) NOp_2H2O (H4NO3) - (117) NOp_3H2O (H6NO3) - (118) NOp_CO2 (NCO3) - (119) NOp_H2O (H2NO2) - (120) NOp_N2 (N3O) - (121) Np (N) - (122) O1D (O) + ( 3) BR (Br) + ( 4) BRCL (BrCl) + ( 5) BRO (BrO) + ( 6) BRONO2 (BrONO2) + ( 7) BRY + ( 8) CCL4 (CCl4) + ( 9) CF2CLBR (CF2ClBr) + ( 10) CF3BR (CF3Br) + ( 11) CFC11 (CFCl3) + ( 12) CFC113 (CCl2FCClF2) + ( 13) CFC114 (CClF2CClF2) + ( 14) CFC115 (CClF2CF3) + ( 15) CFC12 (CF2Cl2) + ( 16) CH2BR2 (CH2Br2) + ( 17) CH2O + ( 18) CH3BR (CH3Br) + ( 19) CH3CCL3 (CH3CCl3) + ( 20) CH3CL (CH3Cl) + ( 21) CH3O2 + ( 22) CH3OOH + ( 23) CH4 + ( 24) CHBR3 (CHBr3) + ( 25) CL (Cl) + ( 26) CL2 (Cl2) + ( 27) CL2O2 (Cl2O2) + ( 28) CLO (ClO) + ( 29) CLONO2 (ClONO2) + ( 30) CLY + ( 31) CO + ( 32) CO2 + ( 33) COF2 + ( 34) COFCL (COFCl) + ( 35) DMS (CH3SCH3) + ( 36) dst_a1 (AlSiO5) + ( 37) dst_a2 (AlSiO5) + ( 38) dst_a3 (AlSiO5) + ( 39) F + ( 40) H + ( 41) H2 + ( 42) H2402 (CBrF2CBrF2) + ( 43) H2O2 + ( 44) H2SO4 (H2SO4) + ( 45) HBR (HBr) + ( 46) HCFC141B (CH3CCl2F) + ( 47) HCFC142B (CH3CClF2) + ( 48) HCFC22 (CHF2Cl) + ( 49) HCL (HCl) + ( 50) HF + ( 51) HNO3 + ( 52) HO2NO2 + ( 53) HOBR (HOBr) + ( 54) HOCL (HOCl) + ( 55) HONO + ( 56) N + ( 57) N2O + ( 58) N2O5 + ( 59) ncl_a1 (NaCl) + ( 60) ncl_a2 (NaCl) + ( 61) ncl_a3 (NaCl) + ( 62) NO + ( 63) NO2 + ( 64) NO3 + ( 65) num_a1 (H) + ( 66) num_a2 (H) + ( 67) num_a3 (H) + ( 68) num_a4 (H) + ( 69) O + ( 70) O1D (O) + ( 71) O2 + ( 72) O3 + ( 73) OCLO (OClO) + ( 74) OCS (OCS) + ( 75) pom_a1 (C) + ( 76) pom_a4 (C) + ( 77) S (S) + ( 78) SF6 + ( 79) SO (SO) + ( 80) SO2 + ( 81) SO3 (SO3) + ( 82) so4_a1 (NH4HSO4) + ( 83) so4_a2 (NH4HSO4) + ( 84) so4_a3 (NH4HSO4) + ( 85) soa_a1 (C) + ( 86) soa_a2 (C) + ( 87) SOAG (C) + ( 88) CLm (Cl) + ( 89) CLm_H2O (ClH2O) + ( 90) CLm_HCL (Cl2H) + ( 91) CLOm (ClO) + ( 92) CO3m (CO3) + ( 93) CO3m2H2O (H4CO5) + ( 94) CO3m_H2O (H2CO4) + ( 95) CO4m (CO4) + ( 96) e (E) + ( 97) H3Op_OH (H4O2) + ( 98) HCO3m (HCO3) + ( 99) HO2 + (100) Hp_2H2O (H5O2) + (101) Hp_3H2O (H7O3) + (102) Hp_3N1 (H8NO6) + (103) Hp_4H2O (H9O4) + (104) Hp_4N1 (H10NO7) + (105) Hp_5H2O (H11O5) + (106) Hp_H2O (H3O) + (107) N2D (N) + (108) N2p (N2) + (109) NO2m (NO2) + (110) NO2m_H2O (H2NO3) + (111) NO3m (NO3) + (112) NO3m2H2O (H4NO5) + (113) NO3m_H2O (H2NO4) + (114) NO3m_HCL (NO3HCl) + (115) NO3mHNO3 (HN2O6) + (116) NOp (NO) + (117) NOp_2H2O (H4NO3) + (118) NOp_3H2O (H6NO3) + (119) NOp_CO2 (NCO3) + (120) NOp_H2O (H2NO2) + (121) NOp_N2 (N3O) + (122) Np (N) (123) O2_1D (O2) (124) O2_1S (O2) (125) O2m (O2) @@ -151,148 +151,146 @@ Class List ========== - Explicit - -------- - ( 1) BRY - ( 2) CCL4 - ( 3) CF2CLBR - ( 4) CF3BR - ( 5) CFC11 - ( 6) CFC113 - ( 7) CFC114 - ( 8) CFC115 - ( 9) CFC12 - ( 10) CH2BR2 - ( 11) CH3BR - ( 12) CH3CCL3 - ( 13) CH3CL - ( 14) CH4 - ( 15) CHBR3 - ( 16) CLY - ( 17) CO2 - ( 18) H2402 - ( 19) HCFC141B - ( 20) HCFC142B - ( 21) HCFC22 - ( 22) N2O - ( 23) SF6 Implicit -------- ( 1) bc_a1 ( 2) bc_a4 - ( 3) BRCL - ( 4) BRO - ( 5) BRONO2 - ( 6) CH2O - ( 7) CH3O2 - ( 8) CH3OOH - ( 9) CL2 - ( 10) CL2O2 - ( 11) CLO - ( 12) CLONO2 - ( 13) CO - ( 14) COF2 - ( 15) COFCL - ( 16) DMS - ( 17) dst_a1 - ( 18) dst_a2 - ( 19) dst_a3 - ( 20) F - ( 21) H - ( 22) H2 - ( 23) H2O2 - ( 24) H2SO4 - ( 25) HBR - ( 26) HCL - ( 27) HF - ( 28) HNO3 - ( 29) HO2NO2 - ( 30) HOBR - ( 31) HOCL - ( 32) HONO - ( 33) N - ( 34) N2O5 - ( 35) ncl_a1 - ( 36) ncl_a2 - ( 37) ncl_a3 - ( 38) NO - ( 39) NO2 - ( 40) NO3 - ( 41) num_a1 - ( 42) num_a2 - ( 43) num_a3 - ( 44) num_a4 - ( 45) O - ( 46) O2 - ( 47) O3 - ( 48) OCLO - ( 49) OCS - ( 50) pom_a1 - ( 51) pom_a4 - ( 52) S - ( 53) SO - ( 54) SO2 - ( 55) SO3 - ( 56) so4_a1 - ( 57) so4_a2 - ( 58) so4_a3 - ( 59) soa_a1 - ( 60) soa_a2 - ( 61) SOAG - ( 62) BR - ( 63) CL - ( 64) CLm - ( 65) CLm_H2O - ( 66) CLm_HCL - ( 67) CLOm - ( 68) CO3m - ( 69) CO3m2H2O - ( 70) CO3m_H2O - ( 71) CO4m - ( 72) e - ( 73) H3Op_OH - ( 74) HCO3m - ( 75) HO2 - ( 76) Hp_2H2O - ( 77) Hp_3H2O - ( 78) Hp_3N1 - ( 79) Hp_4H2O - ( 80) Hp_4N1 - ( 81) Hp_5H2O - ( 82) Hp_H2O - ( 83) N2D - ( 84) N2p - ( 85) NO2m - ( 86) NO2m_H2O - ( 87) NO3m - ( 88) NO3m2H2O - ( 89) NO3m_H2O - ( 90) NO3m_HCL - ( 91) NO3mHNO3 - ( 92) NOp - ( 93) NOp_2H2O - ( 94) NOp_3H2O - ( 95) NOp_CO2 - ( 96) NOp_H2O - ( 97) NOp_N2 - ( 98) Np - ( 99) O1D - (100) O2_1D - (101) O2_1S - (102) O2m - (103) O2p - (104) O2p_H2O - (105) O3m - (106) O4m - (107) O4p - (108) OH - (109) OHm - (110) Om - (111) Op - (112) Op2D - (113) Op2P - (114) H2O + ( 3) BR + ( 4) BRCL + ( 5) BRO + ( 6) BRONO2 + ( 7) BRY + ( 8) CCL4 + ( 9) CF2CLBR + ( 10) CF3BR + ( 11) CFC11 + ( 12) CFC113 + ( 13) CFC114 + ( 14) CFC115 + ( 15) CFC12 + ( 16) CH2BR2 + ( 17) CH2O + ( 18) CH3BR + ( 19) CH3CCL3 + ( 20) CH3CL + ( 21) CH3O2 + ( 22) CH3OOH + ( 23) CH4 + ( 24) CHBR3 + ( 25) CL + ( 26) CL2 + ( 27) CL2O2 + ( 28) CLO + ( 29) CLONO2 + ( 30) CLY + ( 31) CO + ( 32) CO2 + ( 33) COF2 + ( 34) COFCL + ( 35) DMS + ( 36) dst_a1 + ( 37) dst_a2 + ( 38) dst_a3 + ( 39) F + ( 40) H + ( 41) H2 + ( 42) H2402 + ( 43) H2O2 + ( 44) H2SO4 + ( 45) HBR + ( 46) HCFC141B + ( 47) HCFC142B + ( 48) HCFC22 + ( 49) HCL + ( 50) HF + ( 51) HNO3 + ( 52) HO2NO2 + ( 53) HOBR + ( 54) HOCL + ( 55) HONO + ( 56) N + ( 57) N2O + ( 58) N2O5 + ( 59) ncl_a1 + ( 60) ncl_a2 + ( 61) ncl_a3 + ( 62) NO + ( 63) NO2 + ( 64) NO3 + ( 65) num_a1 + ( 66) num_a2 + ( 67) num_a3 + ( 68) num_a4 + ( 69) O + ( 70) O1D + ( 71) O2 + ( 72) O3 + ( 73) OCLO + ( 74) OCS + ( 75) pom_a1 + ( 76) pom_a4 + ( 77) S + ( 78) SF6 + ( 79) SO + ( 80) SO2 + ( 81) SO3 + ( 82) so4_a1 + ( 83) so4_a2 + ( 84) so4_a3 + ( 85) soa_a1 + ( 86) soa_a2 + ( 87) SOAG + ( 88) CLm + ( 89) CLm_H2O + ( 90) CLm_HCL + ( 91) CLOm + ( 92) CO3m + ( 93) CO3m2H2O + ( 94) CO3m_H2O + ( 95) CO4m + ( 96) e + ( 97) H3Op_OH + ( 98) HCO3m + ( 99) HO2 + (100) Hp_2H2O + (101) Hp_3H2O + (102) Hp_3N1 + (103) Hp_4H2O + (104) Hp_4N1 + (105) Hp_5H2O + (106) Hp_H2O + (107) N2D + (108) N2p + (109) NO2m + (110) NO2m_H2O + (111) NO3m + (112) NO3m2H2O + (113) NO3m_H2O + (114) NO3m_HCL + (115) NO3mHNO3 + (116) NOp + (117) NOp_2H2O + (118) NOp_3H2O + (119) NOp_CO2 + (120) NOp_H2O + (121) NOp_N2 + (122) Np + (123) O2_1D + (124) O2_1S + (125) O2m + (126) O2p + (127) O2p_H2O + (128) O3m + (129) O4m + (130) O4p + (131) OH + (132) OHm + (133) Om + (134) Op + (135) Op2D + (136) Op2P + (137) H2O Photolysis jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) @@ -637,7 +635,7 @@ Class List O4p_H2O (233) H2O + O4p -> O2 + O2p_H2O rate = 1.70E-09 (337) O4p_O (234) O4p + O -> O2p + O3 rate = 3.00E-10 (338) O4p_O21D (235) O4p + O2_1D -> 2*O2 + O2p rate = 1.50E-10 (339) - OH_HONO (236) HONO + OH -> H2O + NO2 rate = 1.80E-11*exp( 390./t) (340) + OH_HONO (236) HONO + OH -> H2O + NO2 rate = 3.00E-12*exp( 250./t) (340) OHm_CL (237) CL + OHm -> CLm + OH rate = 1.00E-10 (341) OHm_CLO (238) CLO + OHm -> CLOm + OH rate = 1.00E-10 (342) OHm_CO2 (239) CO2 + M + OHm -> M + HCO3m rate = 7.60E-28 (343) @@ -710,8 +708,8 @@ Class List H_HO2 (304) H + HO2 -> H2 + O2 rate = 6.90E-12 (408) H_HO2a (305) H + HO2 -> 2*OH rate = 7.20E-11 (409) H_HO2b (306) H + HO2 -> H2O + O rate = 1.60E-12 (410) - H_O2 (307) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (411) - ki=7.50E-11*(300/t)**-0.20 + H_O2 (307) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (411) + ki=9.50E-11*(300/t)**-0.40 f=0.60 HO2_O (308) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (412) HO2_O3 (309) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (413) @@ -726,25 +724,25 @@ Class List ki=2.60E-11 f=0.60 usr_HO2_HO2 (318) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (422) - HO2NO2_OH (319) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (423) + HO2NO2_OH (319) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (423) N2D_O (320) N2D + O -> N + O rate = 7.00E-13 (424) N2D_O2 (321) N2D + O2 -> NO + O1D rate = 5.00E-12 (425) N_NO (322) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (426) N_NO2a (323) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (427) N_NO2b (324) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (428) N_NO2c (325) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (429) - N_O2 (326) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (430) + N_O2 (326) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (430) NO2_O (327) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (431) NO2_O3 (328) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (432) NO2_O_M (329) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (433) ki=2.20E-11*(300/t)**0.70 f=0.60 NO3_HO2 (330) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (434) - NO3_NO (331) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (435) - NO3_O (332) NO3 + O -> NO2 + O2 rate = 1.00E-11 (436) + NO3_NO (331) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (435) + NO3_O (332) NO3 + O -> NO2 + O2 rate = 1.30E-11 (436) NO3_OH (333) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (437) N_OH (334) N + OH -> NO + H rate = 5.00E-11 (438) - NO_HO2 (335) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (439) + NO_HO2 (335) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (439) NO_O3 (336) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (440) NO_O_M (337) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (441) ki=3.00E-11 @@ -837,7 +835,7 @@ Class List CH3BR_CL (411) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (515) CH3BR_OH (412) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (516) CH3CCL3_OH (413) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (517) - CH3CL_CL (414) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (518) + CH3CL_CL (414) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1110./t) (518) CH3CL_OH (415) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (519) CHBR3_CL (416) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (520) CHBR3_OH (417) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (521) @@ -856,79 +854,78 @@ Class List CH3O2_NO (430) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (534) CH3OOH_OH (431) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (535) CH4_OH (432) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (536) - CO_OH_M (433) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.00 (537) - ki=1.10E-12*(300/t)**-1.30 + O1D_CH4a (433) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (537) + O1D_CH4b (434) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (538) + O1D_CH4c (435) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (539) + usr_CO_OH (436) CO + OH -> CO2 + HO2 rate = ** User defined ** (540) + DMS_NO3 (437) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (541) + DMS_OHa (438) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (542) + OCS_O (439) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (543) + OCS_OH (440) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (544) + S_O2 (441) S + O2 -> SO + O rate = 2.30E-12 (545) + SO2_OH_M (442) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (546) + ki=1.70E-12*(300/t)**-0.20 f=0.60 - O1D_CH4a (434) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (538) - O1D_CH4b (435) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (539) - O1D_CH4c (436) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (540) - usr_CO_OH_b (437) CO + OH -> CO2 + H rate = ** User defined ** (541) - OCS_O (438) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (542) - OCS_OH (439) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (543) - S_O2 (440) S + O2 -> SO + O rate = 2.30E-12 (544) - S_O3 (441) S + O3 -> SO + O2 rate = 1.20E-11 (545) - SO_BRO (442) SO + BRO -> SO2 + BR rate = 5.70E-11 (546) - SO_CLO (443) SO + CLO -> SO2 + CL rate = 2.80E-11 (547) - S_OH (444) S + OH -> SO + H rate = 6.60E-11 (548) - SO_NO2 (445) SO + NO2 -> SO2 + NO rate = 1.40E-11 (549) - SO_O2 (446) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (550) - SO_O3 (447) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (551) - SO_OCLO (448) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (552) - SO_OH (449) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (553) - usr_SO2_OH (450) SO2 + OH -> SO3 + HO2 rate = ** User defined ** (554) - usr_SO3_H2O (451) SO3 + H2O -> H2SO4 rate = ** User defined ** (555) - DMS_NO3 (452) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (556) - DMS_OHa (453) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (557) - usr_DMS_OH (454) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (558) - usr_HO2_aer (455) HO2 -> 0.5*H2O2 rate = ** User defined ** (559) - usr_N2O5_aer (456) N2O5 -> 2*HNO3 rate = ** User defined ** (560) - usr_NO2_aer (457) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (561) - usr_NO3_aer (458) NO3 -> HNO3 rate = ** User defined ** (562) - het1 (459) N2O5 -> 2*HNO3 rate = ** User defined ** (563) - het10 (460) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (564) - het11 (461) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (565) - het12 (462) N2O5 -> 2*HNO3 rate = ** User defined ** (566) - het13 (463) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (567) - het14 (464) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (568) - het15 (465) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (569) - het16 (466) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (570) - het17 (467) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (571) - het2 (468) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (572) - het3 (469) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (573) - het4 (470) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (574) - het5 (471) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (575) - het6 (472) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (576) - het7 (473) N2O5 -> 2*HNO3 rate = ** User defined ** (577) - het8 (474) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (578) - het9 (475) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (579) - ag247nm (476) Op2P -> Op rate = 4.70E-02 (580) - ag373nm (477) Op2D -> Op rate = 7.70E-05 (581) - ag732nm (478) Op2P -> Op2D rate = 1.71E-01 (582) - elec1 (479) NOp + e -> 0.2*N + 0.8*N2D + O rate = ** User defined ** (583) - elec2 (480) O2p + e -> 1.15*O + 0.85*O1D rate = ** User defined ** (584) - elec3 (481) N2p + e -> 1.1*N + 0.9*N2D rate = ** User defined ** (585) - ion_N2p_O2 (482) N2p + O2 -> O2p + N2 rate = 6.00E-11 (586) - ion_N2p_Oa (483) N2p + O -> NOp + N2D rate = ** User defined ** (587) - ion_N2p_Ob (484) N2p + O -> Op + N2 rate = ** User defined ** (588) - ion_Np_O (485) Np + O -> Op + N rate = 1.00E-12 (589) - ion_Np_O2a (486) Np + O2 -> O2p + N rate = 4.00E-10 (590) - ion_Np_O2b (487) Np + O2 -> NOp + O rate = 2.00E-10 (591) - ion_O2p_N (488) O2p + N -> NOp + O rate = 1.00E-10 (592) - ion_O2p_N2 (489) O2p + N2 -> NOp + NO rate = 5.00E-16 (593) - ion_O2p_NO (490) O2p + NO -> NOp + O2 rate = 4.40E-10 (594) - ion_Op_CO2 (491) Op + CO2 -> O2p + CO rate = 9.00E-10 (595) - ion_Op_N2 (492) Op + N2 -> NOp + N rate = ** User defined ** (596) - ion_Op_N2D (493) Op + N2D -> Np + O rate = 1.30E-10 (597) - ion_Op_O2 (494) Op + O2 -> O2p + O rate = ** User defined ** (598) - Op2D_e (495) Op2D + e -> Op + e rate = ** User defined ** (599) - Op2D_N2 (496) Op2D + N2 -> N2p + O rate = 8.00E-10 (600) - Op2D_O (497) Op2D + O -> Op + O rate = 5.00E-12 (601) - Op2D_O2 (498) Op2D + O2 -> O2p + O rate = 7.00E-10 (602) - Op2P_ea (499) Op2P + e -> Op2D + e rate = ** User defined ** (603) - Op2P_eb (500) Op2P + e -> Op + e rate = ** User defined ** (604) - Op2P_N2a (501) Op2P + N2 -> N2p + O rate = 4.80E-10 (605) - Op2P_N2b (502) Op2P + N2 -> Np + NO rate = 1.00E-10 (606) - Op2P_O (503) Op2P + O -> Op + O rate = 4.00E-10 (607) + S_O3 (443) S + O3 -> SO + O2 rate = 1.20E-11 (547) + SO_BRO (444) SO + BRO -> SO2 + BR rate = 5.70E-11 (548) + SO_CLO (445) SO + CLO -> SO2 + CL rate = 2.80E-11 (549) + S_OH (446) S + OH -> SO + H rate = 6.60E-11 (550) + SO_NO2 (447) SO + NO2 -> SO2 + NO rate = 1.40E-11 (551) + SO_O2 (448) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (552) + SO_O3 (449) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (553) + SO_OCLO (450) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (554) + SO_OH (451) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (555) + usr_DMS_OH (452) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (556) + usr_SO3_H2O (453) SO3 + H2O -> H2SO4 rate = ** User defined ** (557) + usr_HO2_aer (454) HO2 -> 0.5*H2O2 rate = ** User defined ** (558) + usr_N2O5_aer (455) N2O5 -> 2*HNO3 rate = ** User defined ** (559) + usr_NO2_aer (456) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (560) + usr_NO3_aer (457) NO3 -> HNO3 rate = ** User defined ** (561) + het1 (458) N2O5 -> 2*HNO3 rate = ** User defined ** (562) + het10 (459) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (563) + het11 (460) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (564) + het12 (461) N2O5 -> 2*HNO3 rate = ** User defined ** (565) + het13 (462) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (566) + het14 (463) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (567) + het15 (464) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (568) + het16 (465) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (569) + het17 (466) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (570) + het2 (467) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (571) + het3 (468) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (572) + het4 (469) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (573) + het5 (470) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (574) + het6 (471) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (575) + het7 (472) N2O5 -> 2*HNO3 rate = ** User defined ** (576) + het8 (473) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (577) + het9 (474) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (578) + ag247nm (475) Op2P -> Op rate = 4.70E-02 (579) + ag373nm (476) Op2D -> Op rate = 7.70E-05 (580) + ag732nm (477) Op2P -> Op2D rate = 1.71E-01 (581) + elec1 (478) NOp + e -> 0.2*N + 0.8*N2D + O rate = ** User defined ** (582) + elec2 (479) O2p + e -> 1.15*O + 0.85*O1D rate = ** User defined ** (583) + elec3 (480) N2p + e -> 1.1*N + 0.9*N2D rate = ** User defined ** (584) + ion_N2p_O2 (481) N2p + O2 -> O2p + N2 rate = 6.00E-11 (585) + ion_N2p_Oa (482) N2p + O -> NOp + N2D rate = ** User defined ** (586) + ion_N2p_Ob (483) N2p + O -> Op + N2 rate = ** User defined ** (587) + ion_Np_O (484) Np + O -> Op + N rate = 1.00E-12 (588) + ion_Np_O2a (485) Np + O2 -> O2p + N rate = 4.00E-10 (589) + ion_Np_O2b (486) Np + O2 -> NOp + O rate = 2.00E-10 (590) + ion_O2p_N (487) O2p + N -> NOp + O rate = 1.00E-10 (591) + ion_O2p_N2 (488) O2p + N2 -> NOp + NO rate = 5.00E-16 (592) + ion_O2p_NO (489) O2p + NO -> NOp + O2 rate = 4.40E-10 (593) + ion_Op_CO2 (490) Op + CO2 -> O2p + CO rate = 9.00E-10 (594) + ion_Op_N2 (491) Op + N2 -> NOp + N rate = ** User defined ** (595) + ion_Op_N2D (492) Op + N2D -> Np + O rate = 1.30E-10 (596) + ion_Op_O2 (493) Op + O2 -> O2p + O rate = ** User defined ** (597) + Op2D_e (494) Op2D + e -> Op + e rate = ** User defined ** (598) + Op2D_N2 (495) Op2D + N2 -> N2p + O rate = 8.00E-10 (599) + Op2D_O (496) Op2D + O -> Op + O rate = 5.00E-12 (600) + Op2D_O2 (497) Op2D + O2 -> O2p + O rate = 7.00E-10 (601) + Op2P_ea (498) Op2P + e -> Op2D + e rate = ** User defined ** (602) + Op2P_eb (499) Op2P + e -> Op + e rate = ** User defined ** (603) + Op2P_N2a (500) Op2P + N2 -> N2p + O rate = 4.80E-10 (604) + Op2P_N2b (501) Op2P + N2 -> Np + NO rate = 1.00E-10 (605) + Op2P_O (502) Op2P + O -> Op + O rate = 4.00E-10 (606) Extraneous prod/loss species ( 1) so4_a2 (dataset) @@ -960,13 +957,20 @@ Extraneous prod/loss species d(bc_a1)/dt = 0 d(bc_a4)/dt = 0 - d(BRCL)/dt = r388*BRO*CLO + r467*HOBR*HCL + r472*HOBR*HCL + d(BR)/dt = j27*BRCL + j28*BRO + j30*BRONO2 + j32*CF2CLBR + j33*CF3BR + 2*j39*CH2BR2 + j40*CH3BR + + 3*j43*CHBR3 + 2*j51*H2402 + j52*HBR + j58*HOBR + r372*O1D*CF2CLBR + 2*r385*BRO*BRO + + r386*BRO*CLO + r387*BRO*CLO + r390*BRO*NO + r393*BRO*O + r394*BRO*OH + r395*HBR*O + + r396*HBR*OH + r398*O1D*CF3BR + 3*r399*O1D*CHBR3 + 2*r400*O1D*H2402 + r401*O1D*HBR + + 2*r409*CH2BR2*CL + 2*r410*CH2BR2*OH + r411*CH3BR*CL + r412*CH3BR*OH + 3*r416*CHBR3*CL + + 3*r417*CHBR3*OH + 2*r421*O1D*CH2BR2 + r422*O1D*CH3BR + r444*SO*BRO + - r382*CH2O*BR - r383*HO2*BR - r384*O3*BR + d(BRCL)/dt = r388*BRO*CLO + r466*HOBR*HCL + r471*HOBR*HCL - j27*BRCL d(BRO)/dt = j29*BRONO2 + r384*BR*O3 + r392*BRONO2*O + r397*HOBR*O + r402*O1D*HBR - j28*BRO - 2*r385*BRO*BRO - r386*CLO*BRO - r387*CLO*BRO - r388*CLO*BRO - r389*HO2*BRO - - r390*NO*BRO - r391*M*NO2*BRO - r393*O*BRO - r394*OH*BRO - r442*SO*BRO + - r390*NO*BRO - r391*M*NO2*BRO - r393*O*BRO - r394*OH*BRO - r444*SO*BRO d(BRONO2)/dt = r391*M*BRO*NO2 - - j29*BRONO2 - j30*BRONO2 - r461*BRONO2 - r464*BRONO2 - r469*BRONO2 - r392*O*BRONO2 + - j29*BRONO2 - j30*BRONO2 - r460*BRONO2 - r463*BRONO2 - r468*BRONO2 - r392*O*BRONO2 d(BRY)/dt = 0 d(CCL4)/dt = - j31*CCL4 - r371*O1D*CCL4 d(CF2CLBR)/dt = - j32*CF2CLBR - r372*O1D*CF2CLBR @@ -977,40 +981,58 @@ Extraneous prod/loss species d(CFC115)/dt = - j37*CFC115 - r376*O1D*CFC115 d(CFC12)/dt = - j38*CFC12 - r377*O1D*CFC12 d(CH2BR2)/dt = - j39*CH2BR2 - r409*CL*CH2BR2 - r410*OH*CH2BR2 - r421*O1D*CH2BR2 - d(CH2O)/dt = j23*CH3OOH + .18*j25*CH4 + r353*CLO*CH3O2 + r430*CH3O2*NO + .3*r431*CH3OOH*OH + r435*O1D*CH4 - + r436*O1D*CH4 + d(CH2O)/dt = j23*CH3OOH + .18*j25*CH4 + r353*CLO*CH3O2 + r430*CH3O2*NO + .3*r431*CH3OOH*OH + r434*O1D*CH4 + + r435*O1D*CH4 - j21*CH2O - j22*CH2O - r346*CL*CH2O - r382*BR*CH2O - r426*NO3*CH2O - r427*O*CH2O - r428*OH*CH2O d(CH3BR)/dt = - j40*CH3BR - r411*CL*CH3BR - r412*OH*CH3BR - r422*O1D*CH3BR d(CH3CCL3)/dt = - j41*CH3CCL3 - r413*OH*CH3CCL3 d(CH3CL)/dt = - j42*CH3CL - r414*CL*CH3CL - r415*OH*CH3CL d(CH3O2)/dt = j24*CH4 + j40*CH3BR + j42*CH3CL + r347*CL*CH4 + r403*F*CH4 + .7*r431*CH3OOH*OH + r432*CH4*OH - + r434*O1D*CH4 + + r433*O1D*CH4 - r353*CLO*CH3O2 - r429*HO2*CH3O2 - r430*NO*CH3O2 d(CH3OOH)/dt = r429*CH3O2*HO2 - j23*CH3OOH - r431*OH*CH3OOH - d(CH4)/dt = - j24*CH4 - j25*CH4 - r347*CL*CH4 - r403*F*CH4 - r432*OH*CH4 - r434*O1D*CH4 - r435*O1D*CH4 - - r436*O1D*CH4 + d(CH4)/dt = - j24*CH4 - j25*CH4 - r347*CL*CH4 - r403*F*CH4 - r432*OH*CH4 - r433*O1D*CH4 - r434*O1D*CH4 + - r435*O1D*CH4 d(CHBR3)/dt = - j43*CHBR3 - r399*O1D*CHBR3 - r416*CL*CHBR3 - r417*OH*CHBR3 - d(CL2)/dt = r355*CLO*CLO + r359*CLONO2*CL + r460*HOCL*HCL + r465*CLONO2*HCL + r466*HOCL*HCL + r470*CLONO2*HCL - + r471*HOCL*HCL + r475*CLONO2*HCL + d(CL)/dt = j27*BRCL + 4*j31*CCL4 + j32*CF2CLBR + 2*j34*CFC11 + 2*j35*CFC113 + 2*j36*CFC114 + j37*CFC115 + + 2*j38*CFC12 + 3*j41*CH3CCL3 + j42*CH3CL + 2*j44*CL2 + 2*j45*CL2O2 + j46*CLO + j47*CLONO2 + + j50*COFCL + j53*HCFC141B + j54*HCFC142B + j55*HCFC22 + j56*HCL + j59*HOCL + r6*CLm*NO2 + + r7*CLOm*NO + r43*CLm*Hp_4H2O + r50*CLm*O2p + r55*O2p*CLm_H2O + r60*CLm_H2O*Hp_4H2O + + r65*CLm_HCL*Hp_5H2O + r73*CLm*Hp_5H2O + r77*CLm_HCL*Hp_4H2O + r78*CLm_H2O*Hp_5H2O + + r83*CLm_HCL*Hp_3H2O + r91*CLm*Hp_3H2O + r95*CLm_H2O*Hp_3H2O + r101*CLm_HCL*NOp_H2O + + r108*CLm*NOp_H2O + r113*CLm_H2O*NOp_H2O + r118*CLm_HCL*NOp_2H2O + r126*CLm*NOp_2H2O + + r130*NOp_2H2O*CLm_H2O + r136*NOp*CLm_HCL + r144*CLm*NOp + r148*CLm_H2O*NOp + r153*O2p*CLm_HCL + + r353*CLO*CH3O2 + 2*r354*CLO*CLO + r356*CLO*CLO + r358*CLO*NO + r363*CLO*O + r364*CLO*OH + + r366*HCL*O + r367*HCL*OH + 4*r371*O1D*CCL4 + r372*O1D*CF2CLBR + 2*r373*O1D*CFC11 + + 2*r374*O1D*CFC113 + 2*r375*O1D*CFC114 + r376*O1D*CFC115 + 2*r377*O1D*CFC12 + r378*O1D*HCL + + r387*BRO*CLO + r408*O1D*COFCL + 3*r413*CH3CCL3*OH + r415*CH3CL*OH + r418*HCFC141B*OH + + r419*HCFC142B*OH + r420*HCFC22*OH + r423*O1D*HCFC141B + r424*O1D*HCFC142B + r425*O1D*HCFC22 + + r445*SO*CLO + - r10*CO3m*CL - r11*CO3m*CL - r23*CO4m*CL - r181*NO2m*CL - r210*O2m*CL - r237*OHm*CL + - r246*Om*CL - r346*CH2O*CL - r347*CH4*CL - r348*H2*CL - r349*H2O2*CL - r350*HO2*CL + - r351*HO2*CL - r352*O3*CL - r359*CLONO2*CL - r368*HOCL*CL - r409*CH2BR2*CL - r411*CH3BR*CL + - r414*CH3CL*CL - r416*CHBR3*CL + d(CL2)/dt = r355*CLO*CLO + r359*CLONO2*CL + r459*HOCL*HCL + r464*CLONO2*HCL + r465*HOCL*HCL + r469*CLONO2*HCL + + r470*HOCL*HCL + r474*CLONO2*HCL - j44*CL2 d(CL2O2)/dt = r380*M*CLO*CLO - j45*CL2O2 - r381*M*CL2O2 d(CLO)/dt = j48*CLONO2 + j60*OCLO + r381*M*CL2O2 + r381*M*CL2O2 + r351*CL*HO2 + r352*CL*O3 + r361*CLONO2*O - + r368*HOCL*CL + r369*HOCL*O + r370*HOCL*OH + r379*O1D*HCL + r448*SO*OCLO + + r368*HOCL*CL + r369*HOCL*O + r370*HOCL*OH + r379*O1D*HCL + r450*SO*OCLO - j46*CLO - r12*CO3m*CLO - r24*CO4m*CLO - r182*NO2m*CLO - r211*O2m*CLO - r238*OHm*CLO - r247*Om*CLO - r353*CH3O2*CLO - 2*r354*CLO*CLO - 2*r355*CLO*CLO - 2*r356*CLO*CLO - r357*HO2*CLO - r358*NO*CLO - r360*M*NO2*CLO - r363*O*CLO - r364*OH*CLO - r365*OH*CLO - 2*r380*M*CLO*CLO - - r386*BRO*CLO - r387*BRO*CLO - r388*BRO*CLO - r443*SO*CLO + - r386*BRO*CLO - r387*BRO*CLO - r388*BRO*CLO - r445*SO*CLO d(CLONO2)/dt = r360*M*CLO*NO2 - - j47*CLONO2 - j48*CLONO2 - r463*CLONO2 - r468*CLONO2 - r474*CLONO2 - r359*CL*CLONO2 - - r361*O*CLONO2 - r362*OH*CLONO2 - r465*HCL*CLONO2 - r470*HCL*CLONO2 - r475*HCL*CLONO2 + - j47*CLONO2 - j48*CLONO2 - r462*CLONO2 - r467*CLONO2 - r473*CLONO2 - r359*CL*CLONO2 + - r361*O*CLONO2 - r362*OH*CLONO2 - r464*HCL*CLONO2 - r469*HCL*CLONO2 - r474*HCL*CLONO2 d(CLY)/dt = 0 d(CO)/dt = j21*CH2O + j22*CH2O + .38*j25*CH4 + j26*CO2 + j62*CO2 + j101*OCS + r346*CL*CH2O + r382*BR*CH2O - + r414*CH3CL*CL + r426*CH2O*NO3 + r427*CH2O*O + r428*CH2O*OH + r438*OCS*O + r439*OCS*OH - + r491*Op*CO2 - - r433*M*OH*CO - r437*OH*CO + + r414*CH3CL*CL + r426*CH2O*NO3 + r427*CH2O*O + r428*CH2O*OH + r439*OCS*O + r440*OCS*OH + + r490*Op*CO2 + - r436*OH*CO d(CO2)/dt = .44*j25*CH4 + j63*CO3m + j65*CO4m + r265*M*NOp_CO2 + r10*CL*CO3m + r11*CL*CO3m + r12*CLO*CO3m + r13*H*CO3m + r16*CO3m_H2O*NO2 + r17*CO3m_H2O*NO2 + r18*CO3m_H2O*NO + r19*CO3m_H2O*NO + r20*CO3m*HNO3 + r21*CO3m*O + r22*O2*CO3m + r23*CL*CO4m + r24*CLO*CO4m + r26*CO4m*HCL @@ -1025,9 +1047,9 @@ Extraneous prod/loss species + r145*CO3m_H2O*NOp + r152*O2p*CO3m + r154*M*Hp_4H2O*CO3m + r155*M*Hp_5H2O*CO3m2H2O + r156*M*CO3m_H2O*Hp_4H2O + r157*M*Hp_5H2O*CO3m_H2O + r161*M*Hp_5H2O*CO3m + r167*M*CO3m2H2O*Hp_4H2O + r176*CO3m*NO + r177*CO3m*NO2 + r202*NOp_CO2*e + r203*NOp_CO2*H2O - + r433*M*CO*OH + r437*CO*OH + + r436*CO*OH - j26*CO2 - j62*CO2 - r208*NOp_N2*CO2 - r212*M*O2m*CO2 - r226*O3m*CO2 - r231*O4m*CO2 - - r239*M*OHm*CO2 - r248*M*Om*CO2 - r264*M*NOp*CO2 - r491*Op*CO2 + - r239*M*OHm*CO2 - r248*M*Om*CO2 - r264*M*NOp*CO2 - r490*Op*CO2 d(COF2)/dt = j32*CF2CLBR + j33*CF3BR + j35*CFC113 + 2*j36*CFC114 + 2*j37*CFC115 + j38*CFC12 + 2*j51*H2402 + j54*HCFC142B + j55*HCFC22 + r372*O1D*CF2CLBR + r374*O1D*CFC113 + 2*r375*O1D*CFC114 + 2*r376*O1D*CFC115 + r377*O1D*CFC12 + r398*O1D*CF3BR + 2*r400*O1D*H2402 + r419*HCFC142B*OH @@ -1036,7 +1058,7 @@ Extraneous prod/loss species d(COFCL)/dt = j34*CFC11 + j35*CFC113 + j53*HCFC141B + r373*O1D*CFC11 + r374*O1D*CFC113 + r418*HCFC141B*OH + r423*O1D*HCFC141B - j50*COFCL - r408*O1D*COFCL - d(DMS)/dt = - r452*NO3*DMS - r453*OH*DMS - r454*OH*DMS + d(DMS)/dt = - r437*NO3*DMS - r438*OH*DMS - r452*OH*DMS d(dst_a1)/dt = 0 d(dst_a2)/dt = 0 d(dst_a3)/dt = 0 @@ -1059,15 +1081,15 @@ Extraneous prod/loss species + r159*M*NO3m_H2O*Hp_5H2O + r161*M*Hp_5H2O*CO3m + r167*M*CO3m2H2O*Hp_4H2O + r250*Om*H2 + r277*Hp_H2O*e + r278*Hp_2H2O*e + r279*Hp_3H2O*e + r285*O1D*H2 + r302*H2*O + r311*OH*H2 + r314*OH*O + r334*N*OH + r348*CL*H2 + r379*O1D*HCL + r402*O1D*HBR + r404*F*H2 + r428*CH2O*OH - + r435*O1D*CH4 + r437*CO*OH + r439*OCS*OH + r444*S*OH + r449*SO*OH + + r434*O1D*CH4 + r440*OCS*OH + r446*S*OH + r451*SO*OH - r1*CLm*H - r13*CO3m*H - r25*CO4m*H - r183*NO2m*H - r205*NOp_H2O*H - r213*O2m*H - r227*O3m*H - r240*OHm*H - r304*HO2*H - r305*HO2*H - r306*HO2*H - r307*M*O2*H - r310*O3*H - d(H2)/dt = j1*H2O + j22*CH2O + 1.4400001*j25*CH4 + r304*H*HO2 + r436*O1D*CH4 + d(H2)/dt = j1*H2O + j22*CH2O + 1.4400001*j25*CH4 + r304*H*HO2 + r435*O1D*CH4 - r249*Om*H2 - r250*Om*H2 - r285*O1D*H2 - r302*O*H2 - r311*OH*H2 - r348*CL*H2 - r404*F*H2 d(H2402)/dt = - j51*H2402 - r400*O1D*H2402 - d(H2O2)/dt = .5*r455*HO2 + r317*M*OH*OH + r318*HO2*HO2 + d(H2O2)/dt = .5*r454*HO2 + r317*M*OH*OH + r318*HO2*HO2 - j4*H2O2 - r303*O*H2O2 - r312*OH*H2O2 - r349*CL*H2O2 - d(H2SO4)/dt = r451*SO3*H2O + d(H2SO4)/dt = r453*SO3*H2O - j100*H2SO4 d(HBR)/dt = r382*BR*CH2O + r383*BR*HO2 - j52*HBR - r395*O*HBR - r396*OH*HBR - r401*O1D*HBR - r402*O1D*HBR @@ -1083,43 +1105,43 @@ Extraneous prod/loss species + r409*CH2BR2*CL + r411*CH3BR*CL + 2*r414*CH3CL*CL + r416*CHBR3*CL - j56*HCL - r2*CLm_H2O*HCL - r4*M*CLm*HCL - r26*CO4m*HCL - r172*M*NO3m*HCL - r185*NO2m*HCL - r194*NO3m*HCL - r214*O2m*HCL - r241*OHm*HCL - r252*Om*HCL - r366*O*HCL - r367*OH*HCL - - r378*O1D*HCL - r379*O1D*HCL - r460*HOCL*HCL - r465*CLONO2*HCL - r466*HOCL*HCL - r467*HOBR*HCL - - r470*CLONO2*HCL - r471*HOCL*HCL - r472*HOBR*HCL - r475*CLONO2*HCL + - r378*O1D*HCL - r379*O1D*HCL - r459*HOCL*HCL - r464*CLONO2*HCL - r465*HOCL*HCL - r466*HOBR*HCL + - r469*CLONO2*HCL - r470*HOCL*HCL - r471*HOBR*HCL - r474*CLONO2*HCL d(HF)/dt = r403*F*CH4 + r404*F*H2 + r405*F*H2O + r406*F*HNO3 - j57*HF - d(HNO3)/dt = r171*M*NO3mHNO3 + 2*r456*N2O5 + .5*r457*NO2 + r458*NO3 + 2*r459*N2O5 + r461*BRONO2 - + 2*r462*N2O5 + r463*CLONO2 + r464*BRONO2 + r468*CLONO2 + r469*BRONO2 + 2*r473*N2O5 - + r474*CLONO2 + r36*H2O*Hp_3N1 + r38*Hp_4H2O*N2O5 + r39*H2O*Hp_4N1 + r41*Hp_5H2O*N2O5 + d(HNO3)/dt = r171*M*NO3mHNO3 + 2*r455*N2O5 + .5*r456*NO2 + r457*NO3 + 2*r458*N2O5 + r460*BRONO2 + + 2*r461*N2O5 + r462*CLONO2 + r463*BRONO2 + r467*CLONO2 + r468*BRONO2 + 2*r472*N2O5 + + r473*CLONO2 + r36*H2O*Hp_3N1 + r38*Hp_4H2O*N2O5 + r39*H2O*Hp_4N1 + r41*Hp_5H2O*N2O5 + 2*r42*Hp_4H2O*NO3mHNO3 + 2*r63*Hp_5H2O*NO3mHNO3 + r67*NO3m*Hp_5H2O + 2*r81*Hp_3H2O*NO3mHNO3 + r84*Hp_3H2O*NO3m + r88*Hp_4H2O*NO3m + r98*NO3mHNO3*NOp_H2O + r116*NO3mHNO3*NOp_2H2O + r134*NOp*NO3mHNO3 + r151*NO3mHNO3*O2p + r160*M*NO3m*Hp_4H2O + r162*M*Hp_5H2O*NO3m + 2*r165*M*NO3mHNO3*Hp_4H2O + 2*r166*M*Hp_5H2O*NO3mHNO3 + r189*NO3m2H2O*N2O5 + r193*NO3m_H2O*N2O5 - + r194*HCL*NO3m + r342*M*NO2*OH + r426*CH2O*NO3 + r452*DMS*NO3 + r465*CLONO2*HCL - + r470*CLONO2*HCL + r475*CLONO2*HCL + + r194*HCL*NO3m + r342*M*NO2*OH + r426*CH2O*NO3 + r437*DMS*NO3 + r464*CLONO2*HCL + + r469*CLONO2*HCL + r474*CLONO2*HCL - j9*HNO3 - r5*CLm*HNO3 - r20*CO3m*HNO3 - r186*NO2m*HNO3 - r191*NO3m_H2O*HNO3 - r195*NO3m_HCL*HNO3 - r196*M*NO3m*HNO3 - r215*O2m*HNO3 - r253*Om*HNO3 - r343*OH*HNO3 - r406*F*HNO3 d(HO2NO2)/dt = r340*M*NO2*HO2 - j10*HO2NO2 - j11*HO2NO2 - r344*M*HO2NO2 - r319*OH*HO2NO2 - d(HOBR)/dt = r461*BRONO2 + r464*BRONO2 + r469*BRONO2 + r389*BRO*HO2 - - j58*HOBR - r397*O*HOBR - r467*HCL*HOBR - r472*HCL*HOBR - d(HOCL)/dt = r463*CLONO2 + r468*CLONO2 + r474*CLONO2 + r357*CLO*HO2 + r362*CLONO2*OH - - j59*HOCL - r368*CL*HOCL - r369*O*HOCL - r370*OH*HOCL - r460*HCL*HOCL - r466*HCL*HOCL - - r471*HCL*HOCL + d(HOBR)/dt = r460*BRONO2 + r463*BRONO2 + r468*BRONO2 + r389*BRO*HO2 + - j58*HOBR - r397*O*HOBR - r466*HCL*HOBR - r471*HCL*HOBR + d(HOCL)/dt = r462*CLONO2 + r467*CLONO2 + r473*CLONO2 + r357*CLO*HO2 + r362*CLONO2*OH + - j59*HOCL - r368*CL*HOCL - r369*O*HOCL - r370*OH*HOCL - r459*HCL*HOCL - r465*HCL*HOCL + - r470*HCL*HOCL d(HONO)/dt = r185*HCL*NO2m + r186*HNO3*NO2m + r201*H2O*NOp_3H2O + r245*M*OH*NO - j12*HONO - r236*OH*HONO - d(N)/dt = j69*N2 + j70*N2 + .8*j72*N2 + .8*j73*N2 + j17*NO + r492*N2*Op + r320*N2D*O + .2*r479*NOp*e - + 1.1*r481*N2p*e + r485*Np*O + r486*Np*O2 - - j66*N - r322*NO*N - r323*NO2*N - r324*NO2*N - r325*NO2*N - r326*O2*N - r334*OH*N - r488*O2p*N + d(N)/dt = j69*N2 + j70*N2 + .8*j72*N2 + .8*j73*N2 + j17*NO + r491*N2*Op + r320*N2D*O + .2*r478*NOp*e + + 1.1*r480*N2p*e + r484*Np*O + r485*Np*O2 + - j66*N - r322*NO*N - r323*NO2*N - r324*NO2*N - r325*NO2*N - r326*O2*N - r334*OH*N - r487*O2p*N d(N2O)/dt = r323*N*NO2 - j13*N2O - r338*O1D*N2O - r339*O1D*N2O d(N2O5)/dt = r341*M*NO2*NO3 - - j14*N2O5 - j15*N2O5 - r345*M*N2O5 - r456*N2O5 - r459*N2O5 - r462*N2O5 - r473*N2O5 + - j14*N2O5 - j15*N2O5 - r345*M*N2O5 - r455*N2O5 - r458*N2O5 - r461*N2O5 - r472*N2O5 - r38*Hp_4H2O*N2O5 - r41*Hp_5H2O*N2O5 - r189*NO3m2H2O*N2O5 - r193*NO3m_H2O*N2O5 d(ncl_a1)/dt = 0 d(ncl_a2)/dt = 0 d(ncl_a3)/dt = 0 - d(NO)/dt = j12*HONO + j15*N2O5 + j18*NO2 + j20*NO3 + .5*r457*NO2 + r489*N2*O2p + r502*N2*Op2P + d(NO)/dt = j12*HONO + j15*N2O5 + j18*NO2 + j20*NO3 + .5*r456*NO2 + r488*N2*O2p + r501*N2*Op2P + r98*NO3mHNO3*NOp_H2O + r100*CO3m*NOp_H2O + r101*CLm_HCL*NOp_H2O + r102*NO3m*NOp_H2O + r103*HCO3m*NOp_H2O + r104*NOp_H2O*O2m + r105*CO4m*NOp_H2O + r106*NO3m_H2O*NOp_H2O + r107*CO3m2H2O*NOp_H2O + r108*CLm*NOp_H2O + r109*CO3m_H2O*NOp_H2O + r111*NO2m_H2O*NOp_H2O @@ -1133,11 +1155,11 @@ Extraneous prod/loss species + r145*CO3m_H2O*NOp + r146*NO2m_H2O*NOp + r147*NO3m_HCL*NOp + r148*CLm_H2O*NOp + r149*NOp*NO3m2H2O + r150*NOp*NO2m + r183*H*NO2m + r187*NO2*NO2m + r199*NOp_2H2O*e + r200*NOp_3H2O*e + r202*NOp_CO2*e + r204*NOp_H2O*e + r205*H*NOp_H2O + r280*e*NOp_N2 + r321*N2D*O2 + 2*r324*N*NO2 - + r326*N*O2 + r327*NO2*O + r334*N*OH + 2*r338*O1D*N2O + r445*SO*NO2 + + r326*N*O2 + r327*NO2*O + r334*N*OH + 2*r338*O1D*N2O + r447*SO*NO2 - j16*NO - j17*NO - r7*CLOm*NO - r8*CLOm*NO - r18*CO3m_H2O*NO - r19*CO3m_H2O*NO - r32*Om*NO - r168*O3m*NO - r175*O3m*NO - r176*CO3m*NO - r245*M*OH*NO - r322*N*NO - r331*NO3*NO - r335*HO2*NO - r336*O3*NO - r337*M*O*NO - r358*CLO*NO - r390*BRO*NO - r430*CH3O2*NO - - r490*O2p*NO + - r489*O2p*NO d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j14*N2O5 + j19*NO3 + j29*BRONO2 + j48*CLONO2 + j75*NO2m + r344*M*HO2NO2 + r345*M*N2O5 + r8*CLOm*NO + r32*NO*Om + r52*NO2m_H2O*O2p + r57*NO2m*O2p + r58*Hp_4H2O*NO2m_H2O + r62*Hp_4H2O*NO2m + r75*NO2m_H2O*Hp_5H2O + r80*Hp_5H2O*NO2m + r93*Hp_3H2O*NO2m_H2O @@ -1145,11 +1167,11 @@ Extraneous prod/loss species + r133*NOp_2H2O*NO2m + r146*NO2m_H2O*NOp + r150*NOp*NO2m + r181*CL*NO2m + r207*NOp_H2O*OH + r236*HONO*OH + r319*HO2NO2*OH + r330*NO3*HO2 + 2*r331*NO3*NO + r332*NO3*O + r333*NO3*OH + r335*NO*HO2 + r336*NO*O3 + r337*M*NO*O + r358*CLO*NO + r390*BRO*NO + r430*CH3O2*NO - - j18*NO2 - r457*NO2 - r6*CLm*NO2 - r16*CO3m_H2O*NO2 - r17*CO3m_H2O*NO2 - r173*O3m*NO2 + - j18*NO2 - r456*NO2 - r6*CLm*NO2 - r16*CO3m_H2O*NO2 - r17*CO3m_H2O*NO2 - r173*O3m*NO2 - r174*O3m*NO2 - r177*CO3m*NO2 - r187*NO2m*NO2 - r216*O2m*NO2 - r242*OHm*NO2 - r255*Om*NO2 - r323*N*NO2 - r324*N*NO2 - r325*N*NO2 - r327*O*NO2 - r328*O3*NO2 - r329*M*O*NO2 - r340*M*HO2*NO2 - r341*M*NO3*NO2 - r342*M*OH*NO2 - r360*M*CLO*NO2 - r391*M*BRO*NO2 - - r445*SO*NO2 + - r447*SO*NO2 d(NO3)/dt = j10*HO2NO2 + j14*N2O5 + j15*N2O5 + j30*BRONO2 + j47*CLONO2 + j76*NO3m + r345*M*N2O5 + r44*NO3m*O2p + r48*NO3m_H2O*O2p + r53*NO3m_HCL*O2p + r56*NO3m2H2O*O2p + r59*Hp_4H2O*NO3m_HCL + r61*NO3m2H2O*Hp_4H2O + r71*Hp_5H2O*NO3m_H2O + r76*Hp_5H2O*NO3m_HCL + r79*Hp_5H2O*NO3m2H2O @@ -1161,8 +1183,8 @@ Extraneous prod/loss species + r158*M*NO3m_H2O*Hp_4H2O + r159*M*NO3m_H2O*Hp_5H2O + r182*CLO*NO2m + r206*NOp_H2O*HO2 + r328*NO2*O3 + r329*M*NO2*O + r343*HNO3*OH + r359*CLONO2*CL + r361*CLONO2*O + r362*CLONO2*OH + r392*BRONO2*O + r406*F*HNO3 - - j19*NO3 - j20*NO3 - r458*NO3 - r330*HO2*NO3 - r331*NO*NO3 - r332*O*NO3 - r333*OH*NO3 - - r341*M*NO2*NO3 - r426*CH2O*NO3 - r452*DMS*NO3 + - j19*NO3 - j20*NO3 - r457*NO3 - r330*HO2*NO3 - r331*NO*NO3 - r332*O*NO3 - r333*OH*NO3 + - r341*M*NO2*NO3 - r426*CH2O*NO3 - r437*DMS*NO3 d(num_a1)/dt = 0 d(num_a2)/dt = 0 d(num_a3)/dt = 0 @@ -1170,7 +1192,7 @@ Extraneous prod/loss species d(O)/dt = j2*H2O + 2*j5*O2 + j6*O2 + j8*O3 + j15*N2O5 + j17*NO + j18*NO2 + j19*NO3 + .18*j25*CH4 + j26*CO2 + j28*BRO + j46*CLO + j60*OCLO + j62*CO2 + j83*O2 + j85*O2 + j87*O2 + 2*j88*O2 + 2*j89*O2 + j90*O2 + j91*O2 + j92*O2 + j99*Om + j102*SO + j103*SO2 + j104*SO3 + r254*M*Om - + r287*N2*O1D + r496*N2*Op2D + r501*N2*Op2P + r10*CL*CO3m + r49*CO3m2H2O*O2p + r51*CO3m_H2O*O2p + + r287*N2*O1D + r495*N2*Op2D + r500*N2*Op2P + r10*CL*CO3m + r49*CO3m2H2O*O2p + r51*CO3m_H2O*O2p + r54*CO3m_H2O*Hp_4H2O + r64*CO3m*Hp_5H2O + r66*CO3m*Hp_4H2O + r72*CO3m2H2O*Hp_5H2O + r74*CO3m_H2O*Hp_5H2O + r82*Hp_3H2O*CO3m + r90*CO3m2H2O*Hp_3H2O + r92*CO3m_H2O*Hp_3H2O + r100*CO3m*NOp_H2O + r107*CO3m2H2O*NOp_H2O + r109*CO3m_H2O*NOp_H2O + r117*CO3m*NOp_2H2O @@ -1178,15 +1200,22 @@ Extraneous prod/loss species + r143*CO3m2H2O*Hp_4H2O + r145*CO3m_H2O*NOp + r152*O2p*CO3m + r154*M*Hp_4H2O*CO3m + r155*M*Hp_5H2O*CO3m2H2O + r156*M*CO3m_H2O*Hp_4H2O + r157*M*Hp_5H2O*CO3m_H2O + r161*M*Hp_5H2O*CO3m + r167*M*CO3m2H2O*Hp_4H2O + r168*NO*O3m + r246*Om*CL + r255*NO2*Om + r259*O3*Om + r288*O1D*O2 - + r289*O1D*O2 + r306*H*HO2 + r316*OH*OH + r322*N*NO + r323*N*NO2 + r326*N*O2 + r440*S*O2 - + r446*SO*O2 + r479*NOp*e + 1.15*r480*O2p*e + r487*Np*O2 + r488*O2p*N + r493*Op*N2D + r494*Op*O2 - + r498*Op2D*O2 + + r289*O1D*O2 + r306*H*HO2 + r316*OH*OH + r322*N*NO + r323*N*NO2 + r326*N*O2 + r441*S*O2 + + r448*SO*O2 + r478*NOp*e + 1.15*r479*O2p*e + r486*Np*O2 + r487*O2p*N + r492*Op*N2D + r493*Op*O2 + + r497*Op2D*O2 - j77*O - j78*O - j79*O - j80*O - j81*O - j82*O - r9*CLOm*O - r21*CO3m*O - r27*CO4m*O - r197*NO3m*O - r220*O2m*O - r221*O2m*O - r229*O3m*O - r230*O3m*O - r232*O4m*O - r234*O4p*O - r243*OHm*O - r256*Om*O - r299*O3*O - 2*r300*M*O*O - r301*M*O2*O - r302*H2*O - r303*H2O2*O - r308*HO2*O - r314*OH*O - r327*NO2*O - r329*M*NO2*O - r332*NO3*O - r337*M*NO*O - r361*CLONO2*O - r363*CLO*O - r366*HCL*O - r369*HOCL*O - r392*BRONO2*O - r393*BRO*O - r395*HBR*O - r397*HOBR*O - - r427*CH2O*O - r438*OCS*O - r483*N2p*O - r484*N2p*O - r485*Np*O + - r427*CH2O*O - r439*OCS*O - r482*N2p*O - r483*N2p*O - r484*Np*O + d(O1D)/dt = j1*H2O + j6*O2 + j7*O3 + j13*N2O + r321*N2D*O2 + .85*r479*O2p*e + - r287*N2*O1D - r285*H2*O1D - r286*H2O*O1D - r288*O2*O1D - r289*O2*O1D - r290*O3*O1D + - r338*N2O*O1D - r339*N2O*O1D - r371*CCL4*O1D - r372*CF2CLBR*O1D - r373*CFC11*O1D + - r374*CFC113*O1D - r375*CFC114*O1D - r376*CFC115*O1D - r377*CFC12*O1D - r378*HCL*O1D + - r379*HCL*O1D - r398*CF3BR*O1D - r399*CHBR3*O1D - r400*H2402*O1D - r401*HBR*O1D - r402*HBR*O1D + - r407*COF2*O1D - r408*COFCL*O1D - r421*CH2BR2*O1D - r422*CH3BR*O1D - r423*HCFC141B*O1D + - r424*HCFC142B*O1D - r425*HCFC22*O1D - r433*CH4*O1D - r434*CH4*O1D - r435*CH4*O1D d(O2)/dt = j8*O3 + j20*NO3 + j93*O2m + j95*O3m + j97*O4m + r33*N2*O2m + r283*O2_1D + r284*O2_1S + r291*N2*O2_1D + r9*CLOm*O + r12*CLO*CO3m + r23*CL*CO4m + r24*CLO*CO4m + r27*CO4m*O + r28*CO4m*O3 + r30*O3*e + r44*NO3m*O2p + r45*HCO3m*O2p + r47*CO4m*O2p + r47*CO4m*O2p @@ -1205,63 +1234,38 @@ Extraneous prod/loss species + r330*NO3*HO2 + r332*NO3*O + r336*NO*O3 + r339*O1D*N2O + r350*CL*HO2 + r352*CL*O3 + r354*CLO*CLO + r355*CLO*CLO + r357*CLO*HO2 + r363*CLO*O + r365*CLO*OH + r383*BR*HO2 + r384*BR*O3 + r385*BRO*BRO + r387*BRO*CLO + r388*BRO*CLO + r389*BRO*HO2 + r393*BRO*O - + r429*CH3O2*HO2 + r441*S*O3 + r447*SO*O3 + r490*O2p*NO + + r429*CH3O2*HO2 + r443*S*O3 + r449*SO*O3 + r489*O2p*NO - j5*O2 - j6*O2 - j83*O2 - j84*O2 - j85*O2 - j86*O2 - j87*O2 - j88*O2 - j89*O2 - j90*O2 - j91*O2 - j92*O2 - r22*CO3m*O2 - r29*N2*e*O2 - r31*M*e*O2 - r218*M*O2m*O2 - r258*M*Om*O2 - r260*M*O2p*O2 - r288*O1D*O2 - r293*O2_1D*O2 - r301*M*O*O2 - r307*M*H*O2 - r321*N2D*O2 - - r326*N*O2 - r440*S*O2 - r446*SO*O2 - r482*N2p*O2 - r486*Np*O2 - r487*Np*O2 - r494*Op*O2 - - r498*Op2D*O2 + - r326*N*O2 - r441*S*O2 - r448*SO*O2 - r481*N2p*O2 - r485*Np*O2 - r486*Np*O2 - r493*Op*O2 + - r497*Op2D*O2 d(O3)/dt = j96*O3m + r174*NO2*O3m + r220*O*O2m + r234*O4p*O + r257*Om*O2_1D + r301*M*O*O2 - j7*O3 - j8*O3 - r28*CO4m*O3 - r30*e*O3 - r188*NO2m*O3 - r198*NO3m*O3 - r219*O2m*O3 - r228*O3m*O3 - r244*OHm*O3 - r259*Om*O3 - r290*O1D*O3 - r299*O*O3 - r309*HO2*O3 - r310*H*O3 - - r315*OH*O3 - r328*NO2*O3 - r336*NO*O3 - r352*CL*O3 - r384*BR*O3 - r441*S*O3 - r447*SO*O3 + - r315*OH*O3 - r328*NO2*O3 - r336*NO*O3 - r352*CL*O3 - r384*BR*O3 - r443*S*O3 - r449*SO*O3 d(OCLO)/dt = r356*CLO*CLO + r386*BRO*CLO - - j60*OCLO - r448*SO*OCLO - d(OCS)/dt = - j101*OCS - r438*O*OCS - r439*OH*OCS + - j60*OCLO - r450*SO*OCLO + d(OCS)/dt = - j101*OCS - r439*O*OCS - r440*OH*OCS d(pom_a1)/dt = 0 d(pom_a4)/dt = 0 d(S)/dt = j101*OCS + j102*SO - - r440*O2*S - r441*O3*S - r444*OH*S + - r441*O2*S - r443*O3*S - r446*OH*S d(SF6)/dt = - j61*SF6 - d(SO)/dt = j103*SO2 + r438*OCS*O + r440*S*O2 + r441*S*O3 + r444*S*OH - - j102*SO - r442*BRO*SO - r443*CLO*SO - r445*NO2*SO - r446*O2*SO - r447*O3*SO - r448*OCLO*SO - - r449*OH*SO - d(SO2)/dt = j104*SO3 + r439*OCS*OH + r442*SO*BRO + r443*SO*CLO + r445*SO*NO2 + r446*SO*O2 + r447*SO*O3 - + r448*SO*OCLO + r449*SO*OH + r452*DMS*NO3 + r453*DMS*OH + .5*r454*DMS*OH - - j103*SO2 - r450*OH*SO2 - d(SO3)/dt = j100*H2SO4 + r450*SO2*OH - - j104*SO3 - r451*H2O*SO3 + d(SO)/dt = j103*SO2 + r439*OCS*O + r441*S*O2 + r443*S*O3 + r446*S*OH + - j102*SO - r444*BRO*SO - r445*CLO*SO - r447*NO2*SO - r448*O2*SO - r449*O3*SO - r450*OCLO*SO + - r451*OH*SO + d(SO2)/dt = j104*SO3 + r437*DMS*NO3 + r438*DMS*OH + r440*OCS*OH + r444*SO*BRO + r445*SO*CLO + r447*SO*NO2 + + r448*SO*O2 + r449*SO*O3 + r450*SO*OCLO + r451*SO*OH + .5*r452*DMS*OH + - j103*SO2 - r442*M*OH*SO2 + d(SO3)/dt = j100*H2SO4 + r442*M*SO2*OH + - j104*SO3 - r453*H2O*SO3 d(so4_a1)/dt = 0 d(so4_a2)/dt = 0 d(so4_a3)/dt = 0 d(soa_a1)/dt = 0 d(soa_a2)/dt = 0 d(SOAG)/dt = 0 - d(BR)/dt = j27*BRCL + j28*BRO + j30*BRONO2 + j32*CF2CLBR + j33*CF3BR + 2*j39*CH2BR2 + j40*CH3BR - + 3*j43*CHBR3 + 2*j51*H2402 + j52*HBR + j58*HOBR + r372*O1D*CF2CLBR + 2*r385*BRO*BRO - + r386*BRO*CLO + r387*BRO*CLO + r390*BRO*NO + r393*BRO*O + r394*BRO*OH + r395*HBR*O - + r396*HBR*OH + r398*O1D*CF3BR + 3*r399*O1D*CHBR3 + 2*r400*O1D*H2402 + r401*O1D*HBR - + 2*r409*CH2BR2*CL + 2*r410*CH2BR2*OH + r411*CH3BR*CL + r412*CH3BR*OH + 3*r416*CHBR3*CL - + 3*r417*CHBR3*OH + 2*r421*O1D*CH2BR2 + r422*O1D*CH3BR + r442*SO*BRO - - r382*CH2O*BR - r383*HO2*BR - r384*O3*BR - d(CL)/dt = j27*BRCL + 4*j31*CCL4 + j32*CF2CLBR + 2*j34*CFC11 + 2*j35*CFC113 + 2*j36*CFC114 + j37*CFC115 - + 2*j38*CFC12 + 3*j41*CH3CCL3 + j42*CH3CL + 2*j44*CL2 + 2*j45*CL2O2 + j46*CLO + j47*CLONO2 - + j50*COFCL + j53*HCFC141B + j54*HCFC142B + j55*HCFC22 + j56*HCL + j59*HOCL + r6*CLm*NO2 - + r7*CLOm*NO + r43*CLm*Hp_4H2O + r50*CLm*O2p + r55*O2p*CLm_H2O + r60*CLm_H2O*Hp_4H2O - + r65*CLm_HCL*Hp_5H2O + r73*CLm*Hp_5H2O + r77*CLm_HCL*Hp_4H2O + r78*CLm_H2O*Hp_5H2O - + r83*CLm_HCL*Hp_3H2O + r91*CLm*Hp_3H2O + r95*CLm_H2O*Hp_3H2O + r101*CLm_HCL*NOp_H2O - + r108*CLm*NOp_H2O + r113*CLm_H2O*NOp_H2O + r118*CLm_HCL*NOp_2H2O + r126*CLm*NOp_2H2O - + r130*NOp_2H2O*CLm_H2O + r136*NOp*CLm_HCL + r144*CLm*NOp + r148*CLm_H2O*NOp + r153*O2p*CLm_HCL - + r353*CLO*CH3O2 + 2*r354*CLO*CLO + r356*CLO*CLO + r358*CLO*NO + r363*CLO*O + r364*CLO*OH - + r366*HCL*O + r367*HCL*OH + 4*r371*O1D*CCL4 + r372*O1D*CF2CLBR + 2*r373*O1D*CFC11 - + 2*r374*O1D*CFC113 + 2*r375*O1D*CFC114 + r376*O1D*CFC115 + 2*r377*O1D*CFC12 + r378*O1D*HCL - + r387*BRO*CLO + r408*O1D*COFCL + 3*r413*CH3CCL3*OH + r415*CH3CL*OH + r418*HCFC141B*OH - + r419*HCFC142B*OH + r420*HCFC22*OH + r423*O1D*HCFC141B + r424*O1D*HCFC142B + r425*O1D*HCFC22 - + r443*SO*CLO - - r10*CO3m*CL - r11*CO3m*CL - r23*CO4m*CL - r181*NO2m*CL - r210*O2m*CL - r237*OHm*CL - - r246*Om*CL - r346*CH2O*CL - r347*CH4*CL - r348*H2*CL - r349*H2O2*CL - r350*HO2*CL - - r351*HO2*CL - r352*O3*CL - r359*CLONO2*CL - r368*HOCL*CL - r409*CH2BR2*CL - r411*CH3BR*CL - - r414*CH3CL*CL - r416*CHBR3*CL d(CLm)/dt = r281*M*CLm_H2O + r282*M*CLm_HCL + r8*CLOm*NO + r9*CLOm*O + r10*CL*CO3m + r12*CLO*CO3m + r23*CL*CO4m + r26*CO4m*HCL + r181*CL*NO2m + r182*CLO*NO2m + r185*HCL*NO2m + r194*HCL*NO3m + r210*O2m*CL + r214*O2m*HCL + r237*CL*OHm + r241*OHm*HCL + r246*Om*CL + r247*CLO*Om @@ -1305,8 +1309,8 @@ Extraneous prod/loss species + r240*H*OHm + r243*OHm*O + r249*H2*Om + r256*Om*O + r257*Om*O2_1D - r29*N2*O2*e - r30*O3*e - r31*M*O2*e - r34*H3Op_OH*e - r37*Hp_4H2O*e - r40*Hp_5H2O*e - r199*NOp_2H2O*e - r200*NOp_3H2O*e - r202*NOp_CO2*e - r204*NOp_H2O*e - r222*O2p_H2O*e - - r276*O4p*e - r277*Hp_H2O*e - r278*Hp_2H2O*e - r279*Hp_3H2O*e - r280*NOp_N2*e - r479*NOp*e - - r480*O2p*e - r481*N2p*e + - r276*O4p*e - r277*Hp_H2O*e - r278*Hp_2H2O*e - r279*Hp_3H2O*e - r280*NOp_N2*e - r478*NOp*e + - r479*O2p*e - r480*N2p*e d(H3Op_OH)/dt = r223*O2p_H2O*H2O - r34*e*H3Op_OH - r35*H2O*H3Op_OH d(HCO3m)/dt = r239*M*CO2*OHm @@ -1316,8 +1320,8 @@ Extraneous prod/loss species + r243*OHm*O + r303*H2O2*O + r307*M*H*O2 + r312*OH*H2O2 + r315*OH*O3 + r333*NO3*OH + r346*CL*CH2O + r349*CL*H2O2 + r353*CLO*CH3O2 + r364*CLO*OH + r382*BR*CH2O + r394*BRO*OH + r411*CH3BR*CL + r412*CH3BR*OH + r414*CH3CL*CL + r415*CH3CL*OH + r426*CH2O*NO3 + r427*CH2O*O - + r430*CH3O2*NO + r433*M*CO*OH + r435*O1D*CH4 + r450*SO2*OH + .5*r454*DMS*OH - - r455*HO2 - r206*NOp_H2O*HO2 - r304*H*HO2 - r305*H*HO2 - r306*H*HO2 - r308*O*HO2 - r309*O3*HO2 + + r430*CH3O2*NO + r434*O1D*CH4 + r436*CO*OH + r442*M*SO2*OH + .5*r452*DMS*OH + - r454*HO2 - r206*NOp_H2O*HO2 - r304*H*HO2 - r305*H*HO2 - r306*H*HO2 - r308*O*HO2 - r309*O3*HO2 - r313*OH*HO2 - 2*r318*HO2*HO2 - r330*NO3*HO2 - r335*NO*HO2 - r340*M*NO2*HO2 - r350*CL*HO2 - r351*CL*HO2 - r357*CLO*HO2 - r383*BR*HO2 - r389*BRO*HO2 - r429*CH3O2*HO2 d(Hp_2H2O)/dt = r271*M*Hp_3H2O + r35*H2O*H3Op_OH + r268*M*Hp_H2O*H2O @@ -1351,10 +1355,10 @@ Extraneous prod/loss species - r166*M*NO3mHNO3*Hp_5H2O d(Hp_H2O)/dt = r269*M*Hp_2H2O + r205*H*NOp_H2O + r206*NOp_H2O*HO2 + r207*NOp_H2O*OH + r224*O2p_H2O*H2O - r268*M*H2O*Hp_H2O - r277*e*Hp_H2O - d(N2D)/dt = j68*N2 + j71*N2 + 1.2*j72*N2 + 1.2*j73*N2 + .8*r479*NOp*e + .9*r481*N2p*e + r483*N2p*O - - r320*O*N2D - r321*O2*N2D - r493*Op*N2D - d(N2p)/dt = j67*N2 + j74*N2 + r496*N2*Op2D + r501*N2*Op2P - - r481*e*N2p - r482*O2*N2p - r483*O*N2p - r484*O*N2p + d(N2D)/dt = j68*N2 + j71*N2 + 1.2*j72*N2 + 1.2*j73*N2 + .8*r478*NOp*e + .9*r480*N2p*e + r482*N2p*O + - r320*O*N2D - r321*O2*N2D - r492*Op*N2D + d(N2p)/dt = j67*N2 + j74*N2 + r495*N2*Op2D + r500*N2*Op2P + - r480*e*N2p - r481*O2*N2p - r482*O*N2p - r483*O*N2p d(NO2m)/dt = r169*M*NO2m_H2O + r6*CLm*NO2 + r7*CLOm*NO + r19*CO3m_H2O*NO + r174*NO2*O3m + r175*NO*O3m + r176*CO3m*NO + r197*NO3m*O + r198*O3*NO3m + r216*NO2*O2m + r242*NO2*OHm + r255*NO2*Om - j75*NO2m - r57*O2p*NO2m - r62*Hp_4H2O*NO2m - r80*Hp_5H2O*NO2m - r97*Hp_3H2O*NO2m @@ -1387,12 +1391,12 @@ Extraneous prod/loss species - r171*M*NO3mHNO3 - r42*Hp_4H2O*NO3mHNO3 - r63*Hp_5H2O*NO3mHNO3 - r81*Hp_3H2O*NO3mHNO3 - r98*NOp_H2O*NO3mHNO3 - r116*NOp_2H2O*NO3mHNO3 - r134*NOp*NO3mHNO3 - r151*O2p*NO3mHNO3 - r165*M*Hp_4H2O*NO3mHNO3 - r166*M*Hp_5H2O*NO3mHNO3 - d(NOp)/dt = j16*NO + r265*M*NOp_CO2 + r267*M*NOp_N2 + r489*N2*O2p + r492*N2*Op + r483*N2p*O + r487*Np*O2 - + r488*O2p*N + r490*O2p*NO + d(NOp)/dt = j16*NO + r265*M*NOp_CO2 + r267*M*NOp_N2 + r488*N2*O2p + r491*N2*Op + r482*N2p*O + r486*Np*O2 + + r487*O2p*N + r489*O2p*NO - r266*N2*M*NOp - r134*NO3mHNO3*NOp - r135*CO3m*NOp - r136*CLm_HCL*NOp - r137*NO3m*NOp - r138*HCO3m*NOp - r139*O2m*NOp - r140*CO4m*NOp - r141*NO3m_H2O*NOp - r142*CO3m2H2O*NOp - r144*CLm*NOp - r145*CO3m_H2O*NOp - r146*NO2m_H2O*NOp - r147*NO3m_HCL*NOp - r148*CLm_H2O*NOp - - r149*NO3m2H2O*NOp - r150*NO2m*NOp - r261*M*H2O*NOp - r264*M*CO2*NOp - r479*e*NOp + - r149*NO3m2H2O*NOp - r150*NO2m*NOp - r261*M*H2O*NOp - r264*M*CO2*NOp - r478*e*NOp d(NOp_2H2O)/dt = r262*M*H2O*NOp_H2O - r116*NO3mHNO3*NOp_2H2O - r117*CO3m*NOp_2H2O - r118*CLm_HCL*NOp_2H2O - r119*NO3m*NOp_2H2O - r120*HCO3m*NOp_2H2O - r122*O2m*NOp_2H2O - r123*CO4m*NOp_2H2O - r124*NO3m_H2O*NOp_2H2O @@ -1411,15 +1415,8 @@ Extraneous prod/loss species - r204*e*NOp_H2O - r205*H*NOp_H2O - r206*HO2*NOp_H2O - r207*OH*NOp_H2O - r262*M*H2O*NOp_H2O d(NOp_N2)/dt = r266*N2*M*NOp - r267*M*NOp_N2 - r208*CO2*NOp_N2 - r209*H2O*NOp_N2 - r280*e*NOp_N2 - d(Np)/dt = j68*N2 + j69*N2 + j70*N2 + j71*N2 + j66*N + r502*N2*Op2P + r493*Op*N2D - - r485*O*Np - r486*O2*Np - r487*O2*Np - d(O1D)/dt = j1*H2O + j6*O2 + j7*O3 + j13*N2O + r321*N2D*O2 + .85*r480*O2p*e - - r287*N2*O1D - r285*H2*O1D - r286*H2O*O1D - r288*O2*O1D - r289*O2*O1D - r290*O3*O1D - - r338*N2O*O1D - r339*N2O*O1D - r371*CCL4*O1D - r372*CF2CLBR*O1D - r373*CFC11*O1D - - r374*CFC113*O1D - r375*CFC114*O1D - r376*CFC115*O1D - r377*CFC12*O1D - r378*HCL*O1D - - r379*HCL*O1D - r398*CF3BR*O1D - r399*CHBR3*O1D - r400*H2402*O1D - r401*HBR*O1D - r402*HBR*O1D - - r407*COF2*O1D - r408*COFCL*O1D - r421*CH2BR2*O1D - r422*CH3BR*O1D - r423*HCFC141B*O1D - - r424*HCFC142B*O1D - r425*HCFC22*O1D - r434*CH4*O1D - r435*CH4*O1D - r436*CH4*O1D + d(Np)/dt = j68*N2 + j69*N2 + j70*N2 + j71*N2 + j66*N + r501*N2*Op2P + r492*Op*N2D + - r484*O*Np - r485*O2*Np - r486*O2*Np d(O2_1D)/dt = j7*O3 + r295*N2*O2_1S + r294*O2_1S*CO2 + r296*O2_1S*O + r297*O2_1S*O2 + r298*O2_1S*O3 - r283*O2_1D - r291*N2*O2_1D - r217*O2m*O2_1D - r235*O4p*O2_1D - r257*Om*O2_1D - r292*O*O2_1D - r293*O2*O2_1D @@ -1430,12 +1427,12 @@ Extraneous prod/loss species - r110*Hp_4H2O*O2m - r122*NOp_2H2O*O2m - r139*NOp*O2m - r210*CL*O2m - r211*CLO*O2m - r212*M*CO2*O2m - r213*H*O2m - r214*HCL*O2m - r215*HNO3*O2m - r216*NO2*O2m - r217*O2_1D*O2m - r218*M*O2*O2m - r219*O3*O2m - r220*O*O2m - r221*O*O2m - d(O2p)/dt = j84*O2 + j86*O2 + j94*O2p_H2O + 2*r46*O2m*O2p + r234*O4p*O + r235*O4p*O2_1D + r482*N2p*O2 - + r486*Np*O2 + r491*Op*CO2 + r494*Op*O2 + r498*Op2D*O2 - - r489*N2*O2p - r44*NO3m*O2p - r45*HCO3m*O2p - r46*O2m*O2p - r47*CO4m*O2p - r48*NO3m_H2O*O2p + d(O2p)/dt = j84*O2 + j86*O2 + j94*O2p_H2O + 2*r46*O2m*O2p + r234*O4p*O + r235*O4p*O2_1D + r481*N2p*O2 + + r485*Np*O2 + r490*Op*CO2 + r493*Op*O2 + r497*Op2D*O2 + - r488*N2*O2p - r44*NO3m*O2p - r45*HCO3m*O2p - r46*O2m*O2p - r47*CO4m*O2p - r48*NO3m_H2O*O2p - r49*CO3m2H2O*O2p - r50*CLm*O2p - r51*CO3m_H2O*O2p - r52*NO2m_H2O*O2p - r53*NO3m_HCL*O2p - r55*CLm_H2O*O2p - r56*NO3m2H2O*O2p - r57*NO2m*O2p - r151*NO3mHNO3*O2p - r152*CO3m*O2p - - r153*CLm_HCL*O2p - r225*M*H2O*O2p - r260*M*O2*O2p - r480*e*O2p - r488*N*O2p - r490*NO*O2p + - r153*CLm_HCL*O2p - r225*M*H2O*O2p - r260*M*O2*O2p - r479*e*O2p - r487*N*O2p - r489*NO*O2p d(O2p_H2O)/dt = r225*M*H2O*O2p + r233*H2O*O4p - j94*O2p_H2O - r222*e*O2p_H2O - r223*H2O*O2p_H2O - r224*H2O*O2p_H2O d(O3m)/dt = r22*O2*CO3m + r28*CO4m*O3 + r219*O3*O2m + r232*O*O4m + r244*OHm*O3 + r258*M*Om*O2 + r259*O3*Om @@ -1446,21 +1443,21 @@ Extraneous prod/loss species d(O4p)/dt = r260*M*O2p*O2 - r233*H2O*O4p - r234*O*O4p - r235*O2_1D*O4p - r276*e*O4p d(OH)/dt = j3*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j12*HONO + j23*CH3OOH + .33*j25*CH4 + j58*HOBR - + j59*HOCL + j98*OHm + .5*r457*NO2 + r20*CO3m*HNO3 + r25*CO4m*H + r34*H3Op_OH*e + + j59*HOCL + j98*OHm + .5*r456*NO2 + r20*CO3m*HNO3 + r25*CO4m*H + r34*H3Op_OH*e + r35*H2O*H3Op_OH + r45*HCO3m*O2p + r68*HCO3m*Hp_5H2O + r85*HCO3m*Hp_3H2O + r99*HCO3m*Hp_4H2O + r103*HCO3m*NOp_H2O + r120*HCO3m*NOp_2H2O + r138*NOp*HCO3m + r224*O2p_H2O*H2O + r237*CL*OHm + r238*CLO*OHm + r242*NO2*OHm + r244*OHm*O3 + r251*Om*H2O + r252*Om*HCL + r253*Om*HNO3 + r285*O1D*H2 + 2*r286*O1D*H2O + r302*H2*O + r303*H2O2*O + 2*r305*H*HO2 + r308*HO2*O + r309*HO2*O3 + r310*H*O3 + r330*NO3*HO2 + r335*NO*HO2 + r351*CL*HO2 + r366*HCL*O + r369*HOCL*O + r378*O1D*HCL + r395*HBR*O + r397*HOBR*O + r401*O1D*HBR + r405*F*H2O + r427*CH2O*O - + .3*r431*CH3OOH*OH + r434*O1D*CH4 + + .3*r431*CH3OOH*OH + r433*O1D*CH4 - r207*NOp_H2O*OH - r236*HONO*OH - r245*M*NO*OH - r311*H2*OH - r312*H2O2*OH - r313*HO2*OH - r314*O*OH - r315*O3*OH - 2*r316*OH*OH - 2*r317*M*OH*OH - r319*HO2NO2*OH - r333*NO3*OH - r334*N*OH - r342*M*NO2*OH - r343*HNO3*OH - r362*CLONO2*OH - r364*CLO*OH - r365*CLO*OH - r367*HCL*OH - r370*HOCL*OH - r394*BRO*OH - r396*HBR*OH - r410*CH2BR2*OH - r412*CH3BR*OH - r413*CH3CCL3*OH - r415*CH3CL*OH - r417*CHBR3*OH - r418*HCFC141B*OH - r419*HCFC142B*OH - - r420*HCFC22*OH - r428*CH2O*OH - r431*CH3OOH*OH - r432*CH4*OH - r433*M*CO*OH - r437*CO*OH - - r439*OCS*OH - r444*S*OH - r449*SO*OH - r450*SO2*OH - r453*DMS*OH - r454*DMS*OH + - r420*HCFC22*OH - r428*CH2O*OH - r431*CH3OOH*OH - r432*CH4*OH - r436*CO*OH - r438*DMS*OH + - r440*OCS*OH - r442*M*SO2*OH - r446*S*OH - r451*SO*OH - r452*DMS*OH d(OHm)/dt = r13*H*CO3m + r183*H*NO2m + r227*O3m*H + r250*Om*H2 + r251*Om*H2O - j98*OHm - r237*CL*OHm - r238*CLO*OHm - r239*M*CO2*OHm - r240*H*OHm - r241*HCL*OHm - r242*NO2*OHm - r243*O*OHm - r244*O3*OHm @@ -1468,14 +1465,14 @@ Extraneous prod/loss species - j99*Om - r254*M*Om - r32*NO*Om - r246*CL*Om - r247*CLO*Om - r248*M*CO2*Om - r249*H2*Om - r250*H2*Om - r251*H2O*Om - r252*HCL*Om - r253*HNO3*Om - r255*NO2*Om - r256*O*Om - r257*O2_1D*Om - r258*M*O2*Om - r259*O3*Om - d(Op)/dt = j77*O + j81*O + j85*O2 + j87*O2 + r476*Op2P + r477*Op2D + r484*N2p*O + r485*Np*O + r495*Op2D*e - + r497*Op2D*O + r500*Op2P*e + r503*Op2P*O - - r492*N2*Op - r491*CO2*Op - r493*N2D*Op - r494*O2*Op - d(Op2D)/dt = j78*O + j82*O + j83*O2 + j92*O2 + r478*Op2P + r499*Op2P*e - - r477*Op2D - r496*N2*Op2D - r495*e*Op2D - r497*O*Op2D - r498*O2*Op2D + d(Op)/dt = j77*O + j81*O + j85*O2 + j87*O2 + r475*Op2P + r476*Op2D + r483*N2p*O + r484*Np*O + r494*Op2D*e + + r496*Op2D*O + r499*Op2P*e + r502*Op2P*O + - r491*N2*Op - r490*CO2*Op - r492*N2D*Op - r493*O2*Op + d(Op2D)/dt = j78*O + j82*O + j83*O2 + j92*O2 + r477*Op2P + r498*Op2P*e + - r476*Op2D - r495*N2*Op2D - r494*e*Op2D - r496*O*Op2D - r497*O2*Op2D d(Op2P)/dt = j79*O + j80*O + j90*O2 + j91*O2 - - r476*Op2P - r478*Op2P - r501*N2*Op2P - r502*N2*Op2P - r499*e*Op2P - r500*e*Op2P - - r503*O*Op2P + - r475*Op2P - r477*Op2P - r500*N2*Op2P - r501*N2*Op2P - r498*e*Op2P - r499*e*Op2P + - r502*O*Op2P d(H2O)/dt = .05*j25*CH4 + j64*CO3m_H2O + j94*O2p_H2O + j100*H2SO4 + r169*M*NO2m_H2O + r170*M*NO3m2H2O + r178*M*NO3m_H2O + r179*M*CO3m_H2O + r180*M*CO3m2H2O + r269*M*Hp_2H2O + r271*M*Hp_3H2O + r273*M*Hp_4H2O + r275*M*Hp_5H2O + r281*M*CLm_H2O + r2*CLm_H2O*HCL + r16*CO3m_H2O*NO2 @@ -1513,11 +1510,11 @@ Extraneous prod/loss species + r277*Hp_H2O*e + 2*r278*Hp_2H2O*e + 3*r279*Hp_3H2O*e + r306*H*HO2 + r311*OH*H2 + r312*OH*H2O2 + r313*OH*HO2 + r316*OH*OH + r319*HO2NO2*OH + r343*HNO3*OH + r367*HCL*OH + r370*HOCL*OH + r396*HBR*OH + r410*CH2BR2*OH + r412*CH3BR*OH + r413*CH3CCL3*OH + r415*CH3CL*OH - + r420*HCFC22*OH + r428*CH2O*OH + r431*CH3OOH*OH + r432*CH4*OH + r460*HOCL*HCL + r466*HOCL*HCL - + r467*HOBR*HCL + r471*HOCL*HCL + r472*HOBR*HCL + + r420*HCFC22*OH + r428*CH2O*OH + r431*CH3OOH*OH + r432*CH4*OH + r459*HOCL*HCL + r465*HOCL*HCL + + r466*HOBR*HCL + r470*HOCL*HCL + r471*HOBR*HCL - j1*H2O - j2*H2O - j3*H2O - r3*M*CLm*H2O - r14*M*CO3m_H2O*H2O - r15*M*CO3m*H2O - r35*H3Op_OH*H2O - r36*Hp_3N1*H2O - r39*Hp_4N1*H2O - r184*M*NO2m*H2O - r190*M*NO3m_H2O*H2O - r192*M*NO3m*H2O - r201*NOp_3H2O*H2O - r203*NOp_CO2*H2O - r209*NOp_N2*H2O - r223*O2p_H2O*H2O - r224*O2p_H2O*H2O - r225*M*O2p*H2O - r233*O4p*H2O - r251*Om*H2O - r261*M*NOp*H2O - r262*M*NOp_H2O*H2O - r263*M*NOp_2H2O*H2O - r268*M*Hp_H2O*H2O - r270*M*Hp_2H2O*H2O - - r272*M*Hp_3H2O*H2O - r274*M*Hp_4H2O*H2O - r286*O1D*H2O - r405*F*H2O - r451*SO3*H2O + - r272*M*Hp_3H2O*H2O - r274*M*Hp_4H2O*H2O - r286*O1D*H2O - r405*F*H2O - r453*SO3*H2O diff --git a/src/chemistry/pp_waccm_mad_mam4/chem_mech.in b/src/chemistry/pp_waccm_mad_mam4/chem_mech.in index 71171f5365..0792e2f429 100644 --- a/src/chemistry/pp_waccm_mad_mam4/chem_mech.in +++ b/src/chemistry/pp_waccm_mad_mam4/chem_mech.in @@ -1,17 +1,18 @@ * Comments -* User-given Tag Description: MAD_MAM4_1 -* Tag database identifier : MZ256_MAD_MAM4_20190128 -* Tag created by : ajc +* User-given Tag Description: WACCM_MAD_MAM4_JPL19 +* Tag database identifier : MZ322_MAD_MAM4_20221220 +* Tag created by : lke * Tag created from branch : MAD_MAM4 -* Tag created on : 2019-01-28 15:49:11.9369-07 +* Tag created on : 2022-12-20 14:37:15.595223-07 * Comments for this tag follow: -* ajc : 2019-01-28 : add sf6 and Op2P Op2D and N2D +* lke : 2022-12-20 : WACCM Middle Atmosphere and D-region mechanism, updated to JPL19 SPECIES Solution bc_a1 -> C, bc_a4 -> C, + BR -> Br, BRCL -> BrCl, BRO -> BrO, BRONO2 -> BrONO2, @@ -33,6 +34,7 @@ CH3OOH, CH4, CHBR3 -> CHBr3, + CL -> Cl, CL2 -> Cl2, CL2O2 -> Cl2O2, CLO -> ClO, @@ -77,6 +79,7 @@ num_a3 -> H, num_a4 -> H, O, + O1D -> O, O2, O3, OCLO -> OClO, @@ -94,8 +97,6 @@ soa_a1 -> C, soa_a2 -> C, SOAG -> C, - BR -> Br, - CL -> Cl, CLm -> Cl, CLm_H2O -> ClH2O, CLm_HCL -> Cl2H, @@ -131,7 +132,6 @@ NOp_H2O -> H2NO2, NOp_N2 -> N3O, Np -> N, - O1D -> O, O2_1D -> O2, O2_1S -> O2, O2m -> O2, @@ -161,8 +161,6 @@ End Col-int Not-Transported - BR, - CL, CLm, CLm_H2O, CLm_HCL, @@ -198,7 +196,6 @@ NOp_H2O, NOp_N2, Np, - O1D, O2_1D, O2_1S, O2m, @@ -220,6 +217,16 @@ Solution classes Explicit + + End Explicit + + Implicit + bc_a1 + bc_a4 + BR + BRCL + BRO + BRONO2 BRY CCL4 CF2CLBR @@ -230,35 +237,22 @@ CFC115 CFC12 CH2BR2 + CH2O CH3BR CH3CCL3 CH3CL - CH4 - CHBR3 - CLY - CO2 - H2402 - HCFC141B - HCFC142B - HCFC22 - N2O - SF6 - End Explicit - - Implicit - bc_a1 - bc_a4 - BRCL - BRO - BRONO2 - CH2O CH3O2 CH3OOH + CH4 + CHBR3 + CL CL2 CL2O2 CLO CLONO2 + CLY CO + CO2 COF2 COFCL DMS @@ -268,9 +262,13 @@ F H H2 + H2402 H2O2 H2SO4 HBR + HCFC141B + HCFC142B + HCFC22 HCL HF HNO3 @@ -279,6 +277,7 @@ HOCL HONO N + N2O N2O5 ncl_a1 ncl_a2 @@ -291,6 +290,7 @@ num_a3 num_a4 O + O1D O2 O3 OCLO @@ -298,6 +298,7 @@ pom_a1 pom_a4 S + SF6 SO SO2 SO3 @@ -307,8 +308,6 @@ soa_a1 soa_a2 SOAG - BR - CL CLm CLm_H2O CLm_HCL @@ -344,7 +343,6 @@ NOp_H2O NOp_N2 Np - O1D O2_1D O2_1S O2m @@ -730,7 +728,7 @@ [O4p_H2O] H2O + O4p -> O2 + O2p_H2O ; 1.7e-09 [O4p_O] O4p + O -> O2p + O3 ; 3e-10 [O4p_O21D] O4p + O2_1D -> 2*O2 + O2p ; 1.5e-10 -[OH_HONO] HONO + OH -> H2O + NO2 ; 1.8e-11, 390 +[OH_HONO] HONO + OH -> H2O + NO2 ; 3e-12, 250 [OHm_CL] CL + OHm -> CLm + OH ; 1e-10 [OHm_CLO] CLO + OHm -> CLOm + OH ; 1e-10 [OHm_CO2] CO2 + M + OHm -> M + HCO3m ; 7.6e-28 @@ -807,7 +805,7 @@ [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 ; 4.4e-32, 1.3, 7.5e-11, -0.2, 0.6 +[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 @@ -822,23 +820,23 @@ ********************************* *** odd-nitrogen ********************************* -[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 +[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 4.5e-13, 610 [N2D_O,cph=229.61] N2D + O -> N + O ; 7e-13 [N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5e-12 [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 ; 1.5e-11, -3600 +[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.5e-11, 170 -[NO3_O] NO3 + O -> NO2 + O2 ; 1e-11 +[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.3e-12, 270 +[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 @@ -929,7 +927,7 @@ [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_CL] CH3CL + CL -> HO2 + CO + 2*HCL ; 2.03e-11, -1110 [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 @@ -951,17 +949,19 @@ [CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 [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 -[CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.9e-33, 1, 1.1e-12, -1.3, 0.6 [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_b] CO + OH -> CO2 + H +[usr_CO_OH] CO + OH -> CO2 + HO2 ********************************* *** 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 @@ -970,15 +970,12 @@ [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.7e-11, 335 -[usr_SO2_OH] SO2 + OH -> SO3 + HO2 +[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 ********************************* -[DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 -[DMS_OHa] DMS + OH -> SO2 ; 9.6e-12, -234 -[usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 [usr_HO2_aer] HO2 -> 0.5*H2O2 [usr_N2O5_aer] N2O5 -> 2*HNO3 [usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 diff --git a/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 index d64fbb509c..266b841a0e 100644 --- a/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/chem_mods.F90 @@ -6,26 +6,26 @@ module chem_mods implicit none save integer, parameter :: phtcnt = 104, & ! number of photolysis reactions - rxntot = 607, & ! number of total reactions - gascnt = 503, & ! number of gas phase reactions + rxntot = 606, & ! number of total reactions + gascnt = 502, & ! number of gas phase reactions nabscol = 2, & ! number of absorbing column densities gas_pcnst = 137, & ! number of "gas phase" species nfs = 2, & ! number of "fixed" species relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members - nzcnt = 1856, & ! number of non-zero matrix entries + nzcnt = 2087, & ! number of non-zero matrix entries extcnt = 23, & ! number of species with external forcing - clscnt1 = 23, & ! number of species in explicit class + clscnt1 = 0, & ! number of species in explicit class clscnt2 = 0, & ! number of species in hov class clscnt3 = 0, & ! number of species in ebi class - clscnt4 = 114, & ! number of species in implicit class + clscnt4 = 137, & ! 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 = 607, & + rxt_tag_cnt = 606, & enthalpy_cnt = 54, & - nslvd = 52 + nslvd = 49 integer :: clscnt(5) = 0 integer :: cls_rxt_cnt(4,5) = 0 integer :: clsmap(gas_pcnst,5) = 0 diff --git a/src/chemistry/pp_waccm_mad_mam4/m_rxt_id.F90 b/src/chemistry/pp_waccm_mad_mam4/m_rxt_id.F90 index b5a9a3f766..b0906a4849 100644 --- a/src/chemistry/pp_waccm_mad_mam4/m_rxt_id.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/m_rxt_id.F90 @@ -536,75 +536,74 @@ module m_rxt_id integer, parameter :: rid_CH3O2_NO = 534 integer, parameter :: rid_CH3OOH_OH = 535 integer, parameter :: rid_CH4_OH = 536 - integer, parameter :: rid_CO_OH_M = 537 - integer, parameter :: rid_O1D_CH4a = 538 - integer, parameter :: rid_O1D_CH4b = 539 - integer, parameter :: rid_O1D_CH4c = 540 - integer, parameter :: rid_usr_CO_OH_b = 541 - integer, parameter :: rid_OCS_O = 542 - integer, parameter :: rid_OCS_OH = 543 - integer, parameter :: rid_S_O2 = 544 - integer, parameter :: rid_S_O3 = 545 - integer, parameter :: rid_SO_BRO = 546 - integer, parameter :: rid_SO_CLO = 547 - integer, parameter :: rid_S_OH = 548 - integer, parameter :: rid_SO_NO2 = 549 - integer, parameter :: rid_SO_O2 = 550 - integer, parameter :: rid_SO_O3 = 551 - integer, parameter :: rid_SO_OCLO = 552 - integer, parameter :: rid_SO_OH = 553 - integer, parameter :: rid_usr_SO2_OH = 554 - integer, parameter :: rid_usr_SO3_H2O = 555 - integer, parameter :: rid_DMS_NO3 = 556 - integer, parameter :: rid_DMS_OHa = 557 - integer, parameter :: rid_usr_DMS_OH = 558 - integer, parameter :: rid_usr_HO2_aer = 559 - integer, parameter :: rid_usr_N2O5_aer = 560 - integer, parameter :: rid_usr_NO2_aer = 561 - integer, parameter :: rid_usr_NO3_aer = 562 - integer, parameter :: rid_het1 = 563 - integer, parameter :: rid_het10 = 564 - integer, parameter :: rid_het11 = 565 - integer, parameter :: rid_het12 = 566 - integer, parameter :: rid_het13 = 567 - integer, parameter :: rid_het14 = 568 - integer, parameter :: rid_het15 = 569 - integer, parameter :: rid_het16 = 570 - integer, parameter :: rid_het17 = 571 - integer, parameter :: rid_het2 = 572 - integer, parameter :: rid_het3 = 573 - integer, parameter :: rid_het4 = 574 - integer, parameter :: rid_het5 = 575 - integer, parameter :: rid_het6 = 576 - integer, parameter :: rid_het7 = 577 - integer, parameter :: rid_het8 = 578 - integer, parameter :: rid_het9 = 579 - integer, parameter :: rid_ag247nm = 580 - integer, parameter :: rid_ag373nm = 581 - integer, parameter :: rid_ag732nm = 582 - integer, parameter :: rid_elec1 = 583 - integer, parameter :: rid_elec2 = 584 - integer, parameter :: rid_elec3 = 585 - integer, parameter :: rid_ion_N2p_O2 = 586 - integer, parameter :: rid_ion_N2p_Oa = 587 - integer, parameter :: rid_ion_N2p_Ob = 588 - integer, parameter :: rid_ion_Np_O = 589 - integer, parameter :: rid_ion_Np_O2a = 590 - integer, parameter :: rid_ion_Np_O2b = 591 - integer, parameter :: rid_ion_O2p_N = 592 - integer, parameter :: rid_ion_O2p_N2 = 593 - integer, parameter :: rid_ion_O2p_NO = 594 - integer, parameter :: rid_ion_Op_CO2 = 595 - integer, parameter :: rid_ion_Op_N2 = 596 - integer, parameter :: rid_ion_Op_N2D = 597 - integer, parameter :: rid_ion_Op_O2 = 598 - integer, parameter :: rid_Op2D_e = 599 - integer, parameter :: rid_Op2D_N2 = 600 - integer, parameter :: rid_Op2D_O = 601 - integer, parameter :: rid_Op2D_O2 = 602 - integer, parameter :: rid_Op2P_ea = 603 - integer, parameter :: rid_Op2P_eb = 604 - integer, parameter :: rid_Op2P_N2a = 605 - integer, parameter :: rid_Op2P_N2b = 606 - integer, parameter :: rid_Op2P_O = 607 + integer, parameter :: rid_O1D_CH4a = 537 + integer, parameter :: rid_O1D_CH4b = 538 + integer, parameter :: rid_O1D_CH4c = 539 + integer, parameter :: rid_usr_CO_OH = 540 + integer, parameter :: rid_DMS_NO3 = 541 + integer, parameter :: rid_DMS_OHa = 542 + integer, parameter :: rid_OCS_O = 543 + integer, parameter :: rid_OCS_OH = 544 + integer, parameter :: rid_S_O2 = 545 + integer, parameter :: rid_SO2_OH_M = 546 + integer, parameter :: rid_S_O3 = 547 + integer, parameter :: rid_SO_BRO = 548 + integer, parameter :: rid_SO_CLO = 549 + integer, parameter :: rid_S_OH = 550 + integer, parameter :: rid_SO_NO2 = 551 + integer, parameter :: rid_SO_O2 = 552 + integer, parameter :: rid_SO_O3 = 553 + integer, parameter :: rid_SO_OCLO = 554 + integer, parameter :: rid_SO_OH = 555 + integer, parameter :: rid_usr_DMS_OH = 556 + integer, parameter :: rid_usr_SO3_H2O = 557 + integer, parameter :: rid_usr_HO2_aer = 558 + integer, parameter :: rid_usr_N2O5_aer = 559 + integer, parameter :: rid_usr_NO2_aer = 560 + integer, parameter :: rid_usr_NO3_aer = 561 + integer, parameter :: rid_het1 = 562 + integer, parameter :: rid_het10 = 563 + integer, parameter :: rid_het11 = 564 + integer, parameter :: rid_het12 = 565 + integer, parameter :: rid_het13 = 566 + integer, parameter :: rid_het14 = 567 + integer, parameter :: rid_het15 = 568 + integer, parameter :: rid_het16 = 569 + integer, parameter :: rid_het17 = 570 + integer, parameter :: rid_het2 = 571 + integer, parameter :: rid_het3 = 572 + integer, parameter :: rid_het4 = 573 + integer, parameter :: rid_het5 = 574 + integer, parameter :: rid_het6 = 575 + integer, parameter :: rid_het7 = 576 + integer, parameter :: rid_het8 = 577 + integer, parameter :: rid_het9 = 578 + integer, parameter :: rid_ag247nm = 579 + integer, parameter :: rid_ag373nm = 580 + integer, parameter :: rid_ag732nm = 581 + integer, parameter :: rid_elec1 = 582 + integer, parameter :: rid_elec2 = 583 + integer, parameter :: rid_elec3 = 584 + integer, parameter :: rid_ion_N2p_O2 = 585 + integer, parameter :: rid_ion_N2p_Oa = 586 + integer, parameter :: rid_ion_N2p_Ob = 587 + integer, parameter :: rid_ion_Np_O = 588 + integer, parameter :: rid_ion_Np_O2a = 589 + integer, parameter :: rid_ion_Np_O2b = 590 + integer, parameter :: rid_ion_O2p_N = 591 + integer, parameter :: rid_ion_O2p_N2 = 592 + integer, parameter :: rid_ion_O2p_NO = 593 + integer, parameter :: rid_ion_Op_CO2 = 594 + integer, parameter :: rid_ion_Op_N2 = 595 + integer, parameter :: rid_ion_Op_N2D = 596 + integer, parameter :: rid_ion_Op_O2 = 597 + integer, parameter :: rid_Op2D_e = 598 + integer, parameter :: rid_Op2D_N2 = 599 + integer, parameter :: rid_Op2D_O = 600 + integer, parameter :: rid_Op2D_O2 = 601 + integer, parameter :: rid_Op2P_ea = 602 + integer, parameter :: rid_Op2P_eb = 603 + integer, parameter :: rid_Op2P_N2a = 604 + integer, parameter :: rid_Op2P_N2b = 605 + integer, parameter :: rid_Op2P_O = 606 end module m_rxt_id diff --git a/src/chemistry/pp_waccm_mad_mam4/m_spc_id.F90 b/src/chemistry/pp_waccm_mad_mam4/m_spc_id.F90 index 1b440e4e28..64f1a68583 100644 --- a/src/chemistry/pp_waccm_mad_mam4/m_spc_id.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/m_spc_id.F90 @@ -2,126 +2,126 @@ module m_spc_id implicit none integer, parameter :: id_bc_a1 = 1 integer, parameter :: id_bc_a4 = 2 - integer, parameter :: id_BRCL = 3 - integer, parameter :: id_BRO = 4 - integer, parameter :: id_BRONO2 = 5 - integer, parameter :: id_BRY = 6 - integer, parameter :: id_CCL4 = 7 - integer, parameter :: id_CF2CLBR = 8 - integer, parameter :: id_CF3BR = 9 - integer, parameter :: id_CFC11 = 10 - integer, parameter :: id_CFC113 = 11 - integer, parameter :: id_CFC114 = 12 - integer, parameter :: id_CFC115 = 13 - integer, parameter :: id_CFC12 = 14 - integer, parameter :: id_CH2BR2 = 15 - integer, parameter :: id_CH2O = 16 - integer, parameter :: id_CH3BR = 17 - integer, parameter :: id_CH3CCL3 = 18 - integer, parameter :: id_CH3CL = 19 - integer, parameter :: id_CH3O2 = 20 - integer, parameter :: id_CH3OOH = 21 - integer, parameter :: id_CH4 = 22 - integer, parameter :: id_CHBR3 = 23 - integer, parameter :: id_CL2 = 24 - integer, parameter :: id_CL2O2 = 25 - integer, parameter :: id_CLO = 26 - integer, parameter :: id_CLONO2 = 27 - integer, parameter :: id_CLY = 28 - integer, parameter :: id_CO = 29 - integer, parameter :: id_CO2 = 30 - integer, parameter :: id_COF2 = 31 - integer, parameter :: id_COFCL = 32 - integer, parameter :: id_DMS = 33 - integer, parameter :: id_dst_a1 = 34 - integer, parameter :: id_dst_a2 = 35 - integer, parameter :: id_dst_a3 = 36 - integer, parameter :: id_F = 37 - integer, parameter :: id_H = 38 - integer, parameter :: id_H2 = 39 - integer, parameter :: id_H2402 = 40 - integer, parameter :: id_H2O2 = 41 - integer, parameter :: id_H2SO4 = 42 - integer, parameter :: id_HBR = 43 - integer, parameter :: id_HCFC141B = 44 - integer, parameter :: id_HCFC142B = 45 - integer, parameter :: id_HCFC22 = 46 - integer, parameter :: id_HCL = 47 - integer, parameter :: id_HF = 48 - integer, parameter :: id_HNO3 = 49 - integer, parameter :: id_HO2NO2 = 50 - integer, parameter :: id_HOBR = 51 - integer, parameter :: id_HOCL = 52 - integer, parameter :: id_HONO = 53 - integer, parameter :: id_N = 54 - integer, parameter :: id_N2O = 55 - integer, parameter :: id_N2O5 = 56 - integer, parameter :: id_ncl_a1 = 57 - integer, parameter :: id_ncl_a2 = 58 - integer, parameter :: id_ncl_a3 = 59 - integer, parameter :: id_NO = 60 - integer, parameter :: id_NO2 = 61 - integer, parameter :: id_NO3 = 62 - integer, parameter :: id_num_a1 = 63 - integer, parameter :: id_num_a2 = 64 - integer, parameter :: id_num_a3 = 65 - integer, parameter :: id_num_a4 = 66 - integer, parameter :: id_O = 67 - integer, parameter :: id_O2 = 68 - integer, parameter :: id_O3 = 69 - integer, parameter :: id_OCLO = 70 - integer, parameter :: id_OCS = 71 - integer, parameter :: id_pom_a1 = 72 - integer, parameter :: id_pom_a4 = 73 - integer, parameter :: id_S = 74 - integer, parameter :: id_SF6 = 75 - integer, parameter :: id_SO = 76 - integer, parameter :: id_SO2 = 77 - integer, parameter :: id_SO3 = 78 - integer, parameter :: id_so4_a1 = 79 - integer, parameter :: id_so4_a2 = 80 - integer, parameter :: id_so4_a3 = 81 - integer, parameter :: id_soa_a1 = 82 - integer, parameter :: id_soa_a2 = 83 - integer, parameter :: id_SOAG = 84 - integer, parameter :: id_BR = 85 - integer, parameter :: id_CL = 86 - integer, parameter :: id_CLm = 87 - integer, parameter :: id_CLm_H2O = 88 - integer, parameter :: id_CLm_HCL = 89 - integer, parameter :: id_CLOm = 90 - integer, parameter :: id_CO3m = 91 - integer, parameter :: id_CO3m2H2O = 92 - integer, parameter :: id_CO3m_H2O = 93 - integer, parameter :: id_CO4m = 94 - integer, parameter :: id_e = 95 - integer, parameter :: id_H3Op_OH = 96 - integer, parameter :: id_HCO3m = 97 - integer, parameter :: id_HO2 = 98 - integer, parameter :: id_Hp_2H2O = 99 - integer, parameter :: id_Hp_3H2O = 100 - integer, parameter :: id_Hp_3N1 = 101 - integer, parameter :: id_Hp_4H2O = 102 - integer, parameter :: id_Hp_4N1 = 103 - integer, parameter :: id_Hp_5H2O = 104 - integer, parameter :: id_Hp_H2O = 105 - integer, parameter :: id_N2D = 106 - integer, parameter :: id_N2p = 107 - integer, parameter :: id_NO2m = 108 - integer, parameter :: id_NO2m_H2O = 109 - integer, parameter :: id_NO3m = 110 - integer, parameter :: id_NO3m2H2O = 111 - integer, parameter :: id_NO3m_H2O = 112 - integer, parameter :: id_NO3m_HCL = 113 - integer, parameter :: id_NO3mHNO3 = 114 - integer, parameter :: id_NOp = 115 - integer, parameter :: id_NOp_2H2O = 116 - integer, parameter :: id_NOp_3H2O = 117 - integer, parameter :: id_NOp_CO2 = 118 - integer, parameter :: id_NOp_H2O = 119 - integer, parameter :: id_NOp_N2 = 120 - integer, parameter :: id_Np = 121 - integer, parameter :: id_O1D = 122 + integer, parameter :: id_BR = 3 + integer, parameter :: id_BRCL = 4 + integer, parameter :: id_BRO = 5 + integer, parameter :: id_BRONO2 = 6 + integer, parameter :: id_BRY = 7 + integer, parameter :: id_CCL4 = 8 + integer, parameter :: id_CF2CLBR = 9 + integer, parameter :: id_CF3BR = 10 + integer, parameter :: id_CFC11 = 11 + integer, parameter :: id_CFC113 = 12 + integer, parameter :: id_CFC114 = 13 + integer, parameter :: id_CFC115 = 14 + integer, parameter :: id_CFC12 = 15 + integer, parameter :: id_CH2BR2 = 16 + integer, parameter :: id_CH2O = 17 + integer, parameter :: id_CH3BR = 18 + integer, parameter :: id_CH3CCL3 = 19 + integer, parameter :: id_CH3CL = 20 + integer, parameter :: id_CH3O2 = 21 + integer, parameter :: id_CH3OOH = 22 + integer, parameter :: id_CH4 = 23 + integer, parameter :: id_CHBR3 = 24 + integer, parameter :: id_CL = 25 + integer, parameter :: id_CL2 = 26 + integer, parameter :: id_CL2O2 = 27 + integer, parameter :: id_CLO = 28 + integer, parameter :: id_CLONO2 = 29 + integer, parameter :: id_CLY = 30 + integer, parameter :: id_CO = 31 + integer, parameter :: id_CO2 = 32 + integer, parameter :: id_COF2 = 33 + integer, parameter :: id_COFCL = 34 + integer, parameter :: id_DMS = 35 + integer, parameter :: id_dst_a1 = 36 + integer, parameter :: id_dst_a2 = 37 + integer, parameter :: id_dst_a3 = 38 + integer, parameter :: id_F = 39 + integer, parameter :: id_H = 40 + integer, parameter :: id_H2 = 41 + integer, parameter :: id_H2402 = 42 + integer, parameter :: id_H2O2 = 43 + integer, parameter :: id_H2SO4 = 44 + integer, parameter :: id_HBR = 45 + integer, parameter :: id_HCFC141B = 46 + integer, parameter :: id_HCFC142B = 47 + integer, parameter :: id_HCFC22 = 48 + integer, parameter :: id_HCL = 49 + integer, parameter :: id_HF = 50 + integer, parameter :: id_HNO3 = 51 + integer, parameter :: id_HO2NO2 = 52 + integer, parameter :: id_HOBR = 53 + integer, parameter :: id_HOCL = 54 + integer, parameter :: id_HONO = 55 + integer, parameter :: id_N = 56 + integer, parameter :: id_N2O = 57 + integer, parameter :: id_N2O5 = 58 + integer, parameter :: id_ncl_a1 = 59 + integer, parameter :: id_ncl_a2 = 60 + integer, parameter :: id_ncl_a3 = 61 + integer, parameter :: id_NO = 62 + integer, parameter :: id_NO2 = 63 + integer, parameter :: id_NO3 = 64 + integer, parameter :: id_num_a1 = 65 + integer, parameter :: id_num_a2 = 66 + integer, parameter :: id_num_a3 = 67 + integer, parameter :: id_num_a4 = 68 + integer, parameter :: id_O = 69 + integer, parameter :: id_O1D = 70 + integer, parameter :: id_O2 = 71 + integer, parameter :: id_O3 = 72 + integer, parameter :: id_OCLO = 73 + integer, parameter :: id_OCS = 74 + integer, parameter :: id_pom_a1 = 75 + integer, parameter :: id_pom_a4 = 76 + integer, parameter :: id_S = 77 + integer, parameter :: id_SF6 = 78 + integer, parameter :: id_SO = 79 + integer, parameter :: id_SO2 = 80 + integer, parameter :: id_SO3 = 81 + integer, parameter :: id_so4_a1 = 82 + integer, parameter :: id_so4_a2 = 83 + integer, parameter :: id_so4_a3 = 84 + integer, parameter :: id_soa_a1 = 85 + integer, parameter :: id_soa_a2 = 86 + integer, parameter :: id_SOAG = 87 + integer, parameter :: id_CLm = 88 + integer, parameter :: id_CLm_H2O = 89 + integer, parameter :: id_CLm_HCL = 90 + integer, parameter :: id_CLOm = 91 + integer, parameter :: id_CO3m = 92 + integer, parameter :: id_CO3m2H2O = 93 + integer, parameter :: id_CO3m_H2O = 94 + integer, parameter :: id_CO4m = 95 + integer, parameter :: id_e = 96 + integer, parameter :: id_H3Op_OH = 97 + integer, parameter :: id_HCO3m = 98 + integer, parameter :: id_HO2 = 99 + integer, parameter :: id_Hp_2H2O = 100 + integer, parameter :: id_Hp_3H2O = 101 + integer, parameter :: id_Hp_3N1 = 102 + integer, parameter :: id_Hp_4H2O = 103 + integer, parameter :: id_Hp_4N1 = 104 + integer, parameter :: id_Hp_5H2O = 105 + integer, parameter :: id_Hp_H2O = 106 + integer, parameter :: id_N2D = 107 + integer, parameter :: id_N2p = 108 + integer, parameter :: id_NO2m = 109 + integer, parameter :: id_NO2m_H2O = 110 + integer, parameter :: id_NO3m = 111 + integer, parameter :: id_NO3m2H2O = 112 + integer, parameter :: id_NO3m_H2O = 113 + integer, parameter :: id_NO3m_HCL = 114 + integer, parameter :: id_NO3mHNO3 = 115 + integer, parameter :: id_NOp = 116 + integer, parameter :: id_NOp_2H2O = 117 + integer, parameter :: id_NOp_3H2O = 118 + integer, parameter :: id_NOp_CO2 = 119 + integer, parameter :: id_NOp_H2O = 120 + integer, parameter :: id_NOp_N2 = 121 + integer, parameter :: id_Np = 122 integer, parameter :: id_O2_1D = 123 integer, parameter :: id_O2_1S = 124 integer, parameter :: id_O2m = 125 diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_adjrxt.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_adjrxt.F90 index 6fb7387436..4b4f607089 100644 --- a/src/chemistry/pp_waccm_mad_mam4/mo_adjrxt.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/mo_adjrxt.F90 @@ -13,544 +13,543 @@ subroutine adjrxt( rate, inv, m, 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(:,:,107) = rate(:,:,107) * inv(:,:, 1) - rate(:,:,108) = rate(:,:,108) * inv(:,:, 1) - rate(:,:,118) = rate(:,:,118) * inv(:,:, 1) - rate(:,:,119) = rate(:,:,119) * inv(:,:, 1) - rate(:,:,133) = rate(:,:,133) * inv(:,:, 2) - rate(:,:,135) = rate(:,:,135) * inv(:,:, 1) - rate(:,:,137) = rate(:,:,137) * inv(:,:, 2) - rate(:,:,258) = rate(:,:,258) * inv(:,:, 1) - rate(:,:,259) = rate(:,:,259) * inv(:,:, 1) - rate(:,:,260) = rate(:,:,260) * inv(:,:, 1) - rate(:,:,261) = rate(:,:,261) * inv(:,:, 1) - rate(:,:,262) = rate(:,:,262) * inv(:,:, 1) - rate(:,:,263) = rate(:,:,263) * inv(:,:, 1) - rate(:,:,264) = rate(:,:,264) * inv(:,:, 1) - rate(:,:,265) = rate(:,:,265) * inv(:,:, 1) - rate(:,:,266) = rate(:,:,266) * inv(:,:, 1) - rate(:,:,267) = rate(:,:,267) * inv(:,:, 1) - rate(:,:,268) = rate(:,:,268) * inv(:,:, 1) - rate(:,:,269) = rate(:,:,269) * inv(:,:, 1) - rate(:,:,270) = rate(:,:,270) * inv(:,:, 1) - rate(:,:,271) = rate(:,:,271) * inv(:,:, 1) - rate(:,:,273) = rate(:,:,273) * inv(:,:, 1) - rate(:,:,274) = rate(:,:,274) * inv(:,:, 1) - rate(:,:,275) = rate(:,:,275) * inv(:,:, 1) - rate(:,:,276) = rate(:,:,276) * inv(:,:, 1) - rate(:,:,282) = rate(:,:,282) * inv(:,:, 1) - rate(:,:,283) = rate(:,:,283) * inv(:,:, 1) - rate(:,:,284) = rate(:,:,284) * inv(:,:, 1) - rate(:,:,288) = rate(:,:,288) * inv(:,:, 1) - rate(:,:,294) = rate(:,:,294) * inv(:,:, 1) - rate(:,:,296) = rate(:,:,296) * inv(:,:, 1) - rate(:,:,300) = rate(:,:,300) * inv(:,:, 1) - rate(:,:,316) = rate(:,:,316) * inv(:,:, 1) - rate(:,:,322) = rate(:,:,322) * inv(:,:, 1) - rate(:,:,329) = rate(:,:,329) * inv(:,:, 1) - rate(:,:,343) = rate(:,:,343) * inv(:,:, 1) - rate(:,:,349) = rate(:,:,349) * inv(:,:, 1) - rate(:,:,352) = rate(:,:,352) * inv(:,:, 1) - rate(:,:,358) = rate(:,:,358) * inv(:,:, 1) - rate(:,:,362) = rate(:,:,362) * inv(:,:, 1) - rate(:,:,364) = rate(:,:,364) * inv(:,:, 1) - rate(:,:,365) = rate(:,:,365) * inv(:,:, 1) - rate(:,:,366) = rate(:,:,366) * inv(:,:, 1) - rate(:,:,367) = rate(:,:,367) * inv(:,:, 1) - rate(:,:,368) = rate(:,:,368) * inv(:,:, 1) - rate(:,:,369) = rate(:,:,369) * inv(:,:, 1) - rate(:,:,371) = rate(:,:,371) * inv(:,:, 1) - rate(:,:,372) = rate(:,:,372) * inv(:,:, 1) - rate(:,:,373) = rate(:,:,373) * inv(:,:, 1) - rate(:,:,374) = rate(:,:,374) * inv(:,:, 1) - rate(:,:,375) = rate(:,:,375) * inv(:,:, 1) - rate(:,:,376) = rate(:,:,376) * inv(:,:, 1) - rate(:,:,377) = rate(:,:,377) * inv(:,:, 1) - rate(:,:,378) = rate(:,:,378) * inv(:,:, 1) - rate(:,:,379) = rate(:,:,379) * inv(:,:, 1) - rate(:,:,385) = rate(:,:,385) * inv(:,:, 1) - rate(:,:,386) = rate(:,:,386) * inv(:,:, 1) - rate(:,:,391) = rate(:,:,391) * inv(:,:, 2) - rate(:,:,395) = rate(:,:,395) * inv(:,:, 2) - rate(:,:,399) = rate(:,:,399) * inv(:,:, 2) - rate(:,:,404) = rate(:,:,404) * inv(:,:, 1) - rate(:,:,405) = rate(:,:,405) * inv(:,:, 1) - rate(:,:,411) = rate(:,:,411) * inv(:,:, 1) - rate(:,:,421) = rate(:,:,421) * inv(:,:, 1) - rate(:,:,433) = rate(:,:,433) * inv(:,:, 1) - rate(:,:,441) = rate(:,:,441) * inv(:,:, 1) - rate(:,:,444) = rate(:,:,444) * inv(:,:, 1) - rate(:,:,445) = rate(:,:,445) * inv(:,:, 1) - rate(:,:,446) = rate(:,:,446) * inv(:,:, 1) - rate(:,:,448) = rate(:,:,448) * inv(:,:, 1) - rate(:,:,449) = rate(:,:,449) * inv(:,:, 1) - rate(:,:,464) = rate(:,:,464) * inv(:,:, 1) - rate(:,:,484) = rate(:,:,484) * inv(:,:, 1) - rate(:,:,485) = rate(:,:,485) * inv(:,:, 1) - rate(:,:,495) = rate(:,:,495) * inv(:,:, 1) - rate(:,:,537) = rate(:,:,537) * inv(:,:, 1) - rate(:,:,593) = rate(:,:,593) * inv(:,:, 2) - rate(:,:,596) = rate(:,:,596) * inv(:,:, 2) - rate(:,:,600) = rate(:,:,600) * inv(:,:, 2) - rate(:,:,605) = rate(:,:,605) * inv(:,:, 2) - rate(:,:,606) = rate(:,:,606) * inv(:,:, 2) - rate(:,:,370) = rate(:,:,370) * inv(:,:, 2) * inv(:,:, 1) - 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(:,:,117) = rate(:,:,117) * 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(:,:,135) = rate(:,:,135) * m(:,:) - rate(:,:,136) = rate(:,:,136) * 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(:,:,172) = rate(:,:,172) * 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(:,:,245) = rate(:,:,245) * m(:,:) - rate(:,:,246) = rate(:,:,246) * 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(:,:,252) = rate(:,:,252) * 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(:,:,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(:,:,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(:,:,292) = rate(:,:,292) * 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(:,:,322) = rate(:,:,322) * 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(:,:,329) = rate(:,:,329) * 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(:,:,336) = rate(:,:,336) * m(:,:) - rate(:,:,337) = rate(:,:,337) * m(:,:) - rate(:,:,338) = rate(:,:,338) * m(:,:) - rate(:,:,339) = rate(:,:,339) * m(:,:) - rate(:,:,340) = rate(:,:,340) * m(:,:) - rate(:,:,341) = rate(:,:,341) * m(:,:) - rate(:,:,342) = rate(:,:,342) * m(:,:) - rate(:,:,343) = rate(:,:,343) * m(:,:) - rate(:,:,344) = rate(:,:,344) * m(:,:) - rate(:,:,345) = rate(:,:,345) * m(:,:) - rate(:,:,346) = rate(:,:,346) * m(:,:) - rate(:,:,347) = rate(:,:,347) * m(:,:) - rate(:,:,348) = rate(:,:,348) * m(:,:) - rate(:,:,349) = rate(:,:,349) * m(:,:) - rate(:,:,350) = rate(:,:,350) * m(:,:) - rate(:,:,351) = rate(:,:,351) * m(:,:) - rate(:,:,352) = rate(:,:,352) * m(:,:) - rate(:,:,353) = rate(:,:,353) * m(:,:) - rate(:,:,354) = rate(:,:,354) * m(:,:) - rate(:,:,355) = rate(:,:,355) * m(:,:) - rate(:,:,356) = rate(:,:,356) * m(:,:) - rate(:,:,357) = rate(:,:,357) * m(:,:) - rate(:,:,359) = rate(:,:,359) * m(:,:) - rate(:,:,360) = rate(:,:,360) * m(:,:) - rate(:,:,361) = rate(:,:,361) * m(:,:) - rate(:,:,362) = rate(:,:,362) * m(:,:) - rate(:,:,363) = rate(:,:,363) * m(:,:) - rate(:,:,364) = rate(:,:,364) * m(:,:) - rate(:,:,365) = rate(:,:,365) * m(:,:) - rate(:,:,366) = rate(:,:,366) * m(:,:) - rate(:,:,367) = rate(:,:,367) * m(:,:) - rate(:,:,368) = rate(:,:,368) * m(:,:) - rate(:,:,372) = rate(:,:,372) * m(:,:) - rate(:,:,374) = rate(:,:,374) * m(:,:) - rate(:,:,376) = rate(:,:,376) * m(:,:) - rate(:,:,378) = rate(:,:,378) * m(:,:) - rate(:,:,380) = rate(:,:,380) * m(:,:) - rate(:,:,381) = rate(:,:,381) * m(:,:) - rate(:,:,382) = rate(:,:,382) * m(:,:) - rate(:,:,383) = rate(:,:,383) * m(:,:) - rate(:,:,384) = rate(:,:,384) * m(:,:) - rate(:,:,389) = rate(:,:,389) * m(:,:) - rate(:,:,390) = rate(:,:,390) * m(:,:) - rate(:,:,392) = rate(:,:,392) * m(:,:) - rate(:,:,393) = rate(:,:,393) * m(:,:) - rate(:,:,394) = rate(:,:,394) * m(:,:) - rate(:,:,396) = rate(:,:,396) * m(:,:) - rate(:,:,397) = rate(:,:,397) * m(:,:) - rate(:,:,398) = rate(:,:,398) * m(:,:) - rate(:,:,400) = rate(:,:,400) * m(:,:) - rate(:,:,401) = rate(:,:,401) * m(:,:) - rate(:,:,402) = rate(:,:,402) * m(:,:) - rate(:,:,403) = rate(:,:,403) * m(:,:) - rate(:,:,404) = rate(:,:,404) * m(:,:) - rate(:,:,405) = rate(:,:,405) * m(:,:) - rate(:,:,406) = rate(:,:,406) * m(:,:) - rate(:,:,407) = rate(:,:,407) * m(:,:) - rate(:,:,408) = rate(:,:,408) * m(:,:) - rate(:,:,409) = rate(:,:,409) * m(:,:) - rate(:,:,410) = rate(:,:,410) * m(:,:) - rate(:,:,411) = rate(:,:,411) * m(:,:) - rate(:,:,412) = rate(:,:,412) * m(:,:) - rate(:,:,413) = rate(:,:,413) * m(:,:) - rate(:,:,414) = rate(:,:,414) * m(:,:) - rate(:,:,415) = rate(:,:,415) * m(:,:) - rate(:,:,416) = rate(:,:,416) * m(:,:) - rate(:,:,417) = rate(:,:,417) * m(:,:) - rate(:,:,418) = rate(:,:,418) * m(:,:) - rate(:,:,419) = rate(:,:,419) * m(:,:) - rate(:,:,420) = rate(:,:,420) * m(:,:) - rate(:,:,421) = rate(:,:,421) * m(:,:) - rate(:,:,422) = rate(:,:,422) * m(:,:) - rate(:,:,423) = rate(:,:,423) * m(:,:) - rate(:,:,424) = rate(:,:,424) * m(:,:) - rate(:,:,425) = rate(:,:,425) * m(:,:) - rate(:,:,426) = rate(:,:,426) * m(:,:) - rate(:,:,427) = rate(:,:,427) * m(:,:) - rate(:,:,428) = rate(:,:,428) * m(:,:) - rate(:,:,429) = rate(:,:,429) * m(:,:) - rate(:,:,430) = rate(:,:,430) * m(:,:) - rate(:,:,431) = rate(:,:,431) * m(:,:) - rate(:,:,432) = rate(:,:,432) * m(:,:) - rate(:,:,433) = rate(:,:,433) * m(:,:) - rate(:,:,434) = rate(:,:,434) * m(:,:) - rate(:,:,435) = rate(:,:,435) * m(:,:) - rate(:,:,436) = rate(:,:,436) * m(:,:) - rate(:,:,437) = rate(:,:,437) * m(:,:) - rate(:,:,438) = rate(:,:,438) * m(:,:) - rate(:,:,439) = rate(:,:,439) * m(:,:) - rate(:,:,440) = rate(:,:,440) * m(:,:) - rate(:,:,441) = rate(:,:,441) * m(:,:) - rate(:,:,442) = rate(:,:,442) * m(:,:) - rate(:,:,443) = rate(:,:,443) * m(:,:) - rate(:,:,444) = rate(:,:,444) * m(:,:) - rate(:,:,445) = rate(:,:,445) * m(:,:) - rate(:,:,446) = rate(:,:,446) * m(:,:) - rate(:,:,447) = rate(:,:,447) * m(:,:) - rate(:,:,450) = rate(:,:,450) * m(:,:) - rate(:,:,451) = rate(:,:,451) * m(:,:) - rate(:,:,452) = rate(:,:,452) * m(:,:) - rate(:,:,453) = rate(:,:,453) * m(:,:) - rate(:,:,454) = rate(:,:,454) * m(:,:) - rate(:,:,455) = rate(:,:,455) * m(:,:) - rate(:,:,456) = rate(:,:,456) * m(:,:) - rate(:,:,457) = rate(:,:,457) * m(:,:) - rate(:,:,458) = rate(:,:,458) * m(:,:) - rate(:,:,459) = rate(:,:,459) * m(:,:) - rate(:,:,460) = rate(:,:,460) * m(:,:) - rate(:,:,461) = rate(:,:,461) * m(:,:) - rate(:,:,462) = rate(:,:,462) * m(:,:) - rate(:,:,463) = rate(:,:,463) * m(:,:) - rate(:,:,464) = rate(:,:,464) * m(:,:) - rate(:,:,465) = rate(:,:,465) * m(:,:) - rate(:,:,466) = rate(:,:,466) * m(:,:) - rate(:,:,467) = rate(:,:,467) * m(:,:) - rate(:,:,468) = rate(:,:,468) * m(:,:) - rate(:,:,469) = rate(:,:,469) * m(:,:) - rate(:,:,470) = rate(:,:,470) * m(:,:) - rate(:,:,471) = rate(:,:,471) * m(:,:) - rate(:,:,472) = rate(:,:,472) * m(:,:) - rate(:,:,473) = rate(:,:,473) * m(:,:) - rate(:,:,474) = rate(:,:,474) * m(:,:) - rate(:,:,475) = rate(:,:,475) * m(:,:) - rate(:,:,476) = rate(:,:,476) * m(:,:) - rate(:,:,477) = rate(:,:,477) * m(:,:) - rate(:,:,478) = rate(:,:,478) * m(:,:) - rate(:,:,479) = rate(:,:,479) * m(:,:) - rate(:,:,480) = rate(:,:,480) * m(:,:) - rate(:,:,481) = rate(:,:,481) * m(:,:) - rate(:,:,482) = rate(:,:,482) * m(:,:) - rate(:,:,483) = rate(:,:,483) * m(:,:) - rate(:,:,484) = rate(:,:,484) * m(:,:) - rate(:,:,486) = rate(:,:,486) * m(:,:) - rate(:,:,487) = rate(:,:,487) * m(:,:) - rate(:,:,488) = rate(:,:,488) * m(:,:) - rate(:,:,489) = rate(:,:,489) * m(:,:) - rate(:,:,490) = rate(:,:,490) * m(:,:) - rate(:,:,491) = rate(:,:,491) * m(:,:) - rate(:,:,492) = rate(:,:,492) * m(:,:) - rate(:,:,493) = rate(:,:,493) * m(:,:) - rate(:,:,494) = rate(:,:,494) * m(:,:) - rate(:,:,495) = rate(:,:,495) * m(:,:) - rate(:,:,496) = rate(:,:,496) * m(:,:) - rate(:,:,497) = rate(:,:,497) * m(:,:) - rate(:,:,498) = rate(:,:,498) * m(:,:) - rate(:,:,499) = rate(:,:,499) * m(:,:) - rate(:,:,500) = rate(:,:,500) * m(:,:) - rate(:,:,501) = rate(:,:,501) * m(:,:) - rate(:,:,502) = rate(:,:,502) * m(:,:) - rate(:,:,503) = rate(:,:,503) * m(:,:) - rate(:,:,504) = rate(:,:,504) * m(:,:) - rate(:,:,505) = rate(:,:,505) * m(:,:) - rate(:,:,506) = rate(:,:,506) * m(:,:) - rate(:,:,507) = rate(:,:,507) * m(:,:) - rate(:,:,508) = rate(:,:,508) * m(:,:) - rate(:,:,509) = rate(:,:,509) * m(:,:) - rate(:,:,510) = rate(:,:,510) * m(:,:) - rate(:,:,511) = rate(:,:,511) * m(:,:) - rate(:,:,512) = rate(:,:,512) * m(:,:) - rate(:,:,513) = rate(:,:,513) * m(:,:) - rate(:,:,514) = rate(:,:,514) * m(:,:) - rate(:,:,515) = rate(:,:,515) * m(:,:) - rate(:,:,516) = rate(:,:,516) * m(:,:) - rate(:,:,517) = rate(:,:,517) * m(:,:) - rate(:,:,518) = rate(:,:,518) * m(:,:) - rate(:,:,519) = rate(:,:,519) * m(:,:) - rate(:,:,520) = rate(:,:,520) * m(:,:) - rate(:,:,521) = rate(:,:,521) * m(:,:) - rate(:,:,522) = rate(:,:,522) * m(:,:) - rate(:,:,523) = rate(:,:,523) * m(:,:) - rate(:,:,524) = rate(:,:,524) * m(:,:) - rate(:,:,525) = rate(:,:,525) * m(:,:) - rate(:,:,526) = rate(:,:,526) * m(:,:) - rate(:,:,527) = rate(:,:,527) * m(:,:) - rate(:,:,528) = rate(:,:,528) * m(:,:) - rate(:,:,529) = rate(:,:,529) * m(:,:) - rate(:,:,530) = rate(:,:,530) * m(:,:) - rate(:,:,531) = rate(:,:,531) * m(:,:) - rate(:,:,532) = rate(:,:,532) * m(:,:) - rate(:,:,533) = rate(:,:,533) * m(:,:) - rate(:,:,534) = rate(:,:,534) * m(:,:) - rate(:,:,535) = rate(:,:,535) * m(:,:) - rate(:,:,536) = rate(:,:,536) * m(:,:) - rate(:,:,537) = rate(:,:,537) * m(:,:) - rate(:,:,538) = rate(:,:,538) * m(:,:) - rate(:,:,539) = rate(:,:,539) * m(:,:) - rate(:,:,540) = rate(:,:,540) * m(:,:) - rate(:,:,541) = rate(:,:,541) * m(:,:) - rate(:,:,542) = rate(:,:,542) * m(:,:) - rate(:,:,543) = rate(:,:,543) * m(:,:) - rate(:,:,544) = rate(:,:,544) * m(:,:) - rate(:,:,545) = rate(:,:,545) * m(:,:) - rate(:,:,546) = rate(:,:,546) * m(:,:) - rate(:,:,547) = rate(:,:,547) * m(:,:) - rate(:,:,548) = rate(:,:,548) * m(:,:) - rate(:,:,549) = rate(:,:,549) * m(:,:) - rate(:,:,550) = rate(:,:,550) * m(:,:) - rate(:,:,551) = rate(:,:,551) * m(:,:) - rate(:,:,552) = rate(:,:,552) * m(:,:) - rate(:,:,553) = rate(:,:,553) * m(:,:) - rate(:,:,554) = rate(:,:,554) * m(:,:) - rate(:,:,555) = rate(:,:,555) * m(:,:) - rate(:,:,556) = rate(:,:,556) * m(:,:) - rate(:,:,557) = rate(:,:,557) * m(:,:) - rate(:,:,558) = rate(:,:,558) * m(:,:) - rate(:,:,564) = rate(:,:,564) * m(:,:) - rate(:,:,569) = rate(:,:,569) * m(:,:) - rate(:,:,570) = rate(:,:,570) * m(:,:) - rate(:,:,571) = rate(:,:,571) * m(:,:) - rate(:,:,574) = rate(:,:,574) * m(:,:) - rate(:,:,575) = rate(:,:,575) * m(:,:) - rate(:,:,576) = rate(:,:,576) * m(:,:) - rate(:,:,579) = rate(:,:,579) * m(:,:) - rate(:,:,583) = rate(:,:,583) * m(:,:) - rate(:,:,584) = rate(:,:,584) * m(:,:) - rate(:,:,585) = rate(:,:,585) * m(:,:) - rate(:,:,586) = rate(:,:,586) * m(:,:) - rate(:,:,587) = rate(:,:,587) * m(:,:) - rate(:,:,588) = rate(:,:,588) * m(:,:) - rate(:,:,589) = rate(:,:,589) * m(:,:) - rate(:,:,590) = rate(:,:,590) * m(:,:) - rate(:,:,591) = rate(:,:,591) * m(:,:) - rate(:,:,592) = rate(:,:,592) * m(:,:) - rate(:,:,594) = rate(:,:,594) * m(:,:) - rate(:,:,595) = rate(:,:,595) * m(:,:) - rate(:,:,597) = rate(:,:,597) * m(:,:) - rate(:,:,598) = rate(:,:,598) * m(:,:) - rate(:,:,599) = rate(:,:,599) * m(:,:) - rate(:,:,601) = rate(:,:,601) * m(:,:) - rate(:,:,602) = rate(:,:,602) * m(:,:) - rate(:,:,603) = rate(:,:,603) * m(:,:) - rate(:,:,604) = rate(:,:,604) * m(:,:) - rate(:,:,607) = rate(:,:,607) * m(:,:) + rate(:,:, 107) = rate(:,:, 107) * inv(:,:, 1) + rate(:,:, 108) = rate(:,:, 108) * inv(:,:, 1) + rate(:,:, 118) = rate(:,:, 118) * inv(:,:, 1) + rate(:,:, 119) = rate(:,:, 119) * inv(:,:, 1) + rate(:,:, 133) = rate(:,:, 133) * inv(:,:, 2) + rate(:,:, 135) = rate(:,:, 135) * inv(:,:, 1) + rate(:,:, 137) = rate(:,:, 137) * inv(:,:, 2) + rate(:,:, 258) = rate(:,:, 258) * inv(:,:, 1) + rate(:,:, 259) = rate(:,:, 259) * inv(:,:, 1) + rate(:,:, 260) = rate(:,:, 260) * inv(:,:, 1) + rate(:,:, 261) = rate(:,:, 261) * inv(:,:, 1) + rate(:,:, 262) = rate(:,:, 262) * inv(:,:, 1) + rate(:,:, 263) = rate(:,:, 263) * inv(:,:, 1) + rate(:,:, 264) = rate(:,:, 264) * inv(:,:, 1) + rate(:,:, 265) = rate(:,:, 265) * inv(:,:, 1) + rate(:,:, 266) = rate(:,:, 266) * inv(:,:, 1) + rate(:,:, 267) = rate(:,:, 267) * inv(:,:, 1) + rate(:,:, 268) = rate(:,:, 268) * inv(:,:, 1) + rate(:,:, 269) = rate(:,:, 269) * inv(:,:, 1) + rate(:,:, 270) = rate(:,:, 270) * inv(:,:, 1) + rate(:,:, 271) = rate(:,:, 271) * inv(:,:, 1) + rate(:,:, 273) = rate(:,:, 273) * inv(:,:, 1) + rate(:,:, 274) = rate(:,:, 274) * inv(:,:, 1) + rate(:,:, 275) = rate(:,:, 275) * inv(:,:, 1) + rate(:,:, 276) = rate(:,:, 276) * inv(:,:, 1) + rate(:,:, 282) = rate(:,:, 282) * inv(:,:, 1) + rate(:,:, 283) = rate(:,:, 283) * inv(:,:, 1) + rate(:,:, 284) = rate(:,:, 284) * inv(:,:, 1) + rate(:,:, 288) = rate(:,:, 288) * inv(:,:, 1) + rate(:,:, 294) = rate(:,:, 294) * inv(:,:, 1) + rate(:,:, 296) = rate(:,:, 296) * inv(:,:, 1) + rate(:,:, 300) = rate(:,:, 300) * inv(:,:, 1) + rate(:,:, 316) = rate(:,:, 316) * inv(:,:, 1) + rate(:,:, 322) = rate(:,:, 322) * inv(:,:, 1) + rate(:,:, 329) = rate(:,:, 329) * inv(:,:, 1) + rate(:,:, 343) = rate(:,:, 343) * inv(:,:, 1) + rate(:,:, 349) = rate(:,:, 349) * inv(:,:, 1) + rate(:,:, 352) = rate(:,:, 352) * inv(:,:, 1) + rate(:,:, 358) = rate(:,:, 358) * inv(:,:, 1) + rate(:,:, 362) = rate(:,:, 362) * inv(:,:, 1) + rate(:,:, 364) = rate(:,:, 364) * inv(:,:, 1) + rate(:,:, 365) = rate(:,:, 365) * inv(:,:, 1) + rate(:,:, 366) = rate(:,:, 366) * inv(:,:, 1) + rate(:,:, 367) = rate(:,:, 367) * inv(:,:, 1) + rate(:,:, 368) = rate(:,:, 368) * inv(:,:, 1) + rate(:,:, 369) = rate(:,:, 369) * inv(:,:, 1) + rate(:,:, 371) = rate(:,:, 371) * inv(:,:, 1) + rate(:,:, 372) = rate(:,:, 372) * inv(:,:, 1) + rate(:,:, 373) = rate(:,:, 373) * inv(:,:, 1) + rate(:,:, 374) = rate(:,:, 374) * inv(:,:, 1) + rate(:,:, 375) = rate(:,:, 375) * inv(:,:, 1) + rate(:,:, 376) = rate(:,:, 376) * inv(:,:, 1) + rate(:,:, 377) = rate(:,:, 377) * inv(:,:, 1) + rate(:,:, 378) = rate(:,:, 378) * inv(:,:, 1) + rate(:,:, 379) = rate(:,:, 379) * inv(:,:, 1) + rate(:,:, 385) = rate(:,:, 385) * inv(:,:, 1) + rate(:,:, 386) = rate(:,:, 386) * inv(:,:, 1) + rate(:,:, 391) = rate(:,:, 391) * inv(:,:, 2) + rate(:,:, 395) = rate(:,:, 395) * inv(:,:, 2) + rate(:,:, 399) = rate(:,:, 399) * inv(:,:, 2) + rate(:,:, 404) = rate(:,:, 404) * inv(:,:, 1) + rate(:,:, 405) = rate(:,:, 405) * inv(:,:, 1) + rate(:,:, 411) = rate(:,:, 411) * inv(:,:, 1) + rate(:,:, 421) = rate(:,:, 421) * inv(:,:, 1) + rate(:,:, 433) = rate(:,:, 433) * inv(:,:, 1) + rate(:,:, 441) = rate(:,:, 441) * inv(:,:, 1) + rate(:,:, 444) = rate(:,:, 444) * inv(:,:, 1) + rate(:,:, 445) = rate(:,:, 445) * inv(:,:, 1) + rate(:,:, 446) = rate(:,:, 446) * inv(:,:, 1) + rate(:,:, 448) = rate(:,:, 448) * inv(:,:, 1) + rate(:,:, 449) = rate(:,:, 449) * inv(:,:, 1) + rate(:,:, 464) = rate(:,:, 464) * inv(:,:, 1) + rate(:,:, 484) = rate(:,:, 484) * inv(:,:, 1) + rate(:,:, 485) = rate(:,:, 485) * inv(:,:, 1) + rate(:,:, 495) = rate(:,:, 495) * inv(:,:, 1) + rate(:,:, 546) = rate(:,:, 546) * inv(:,:, 1) + rate(:,:, 592) = rate(:,:, 592) * inv(:,:, 2) + rate(:,:, 595) = rate(:,:, 595) * inv(:,:, 2) + rate(:,:, 599) = rate(:,:, 599) * inv(:,:, 2) + rate(:,:, 604) = rate(:,:, 604) * inv(:,:, 2) + rate(:,:, 605) = rate(:,:, 605) * inv(:,:, 2) + rate(:,:, 370) = rate(:,:, 370) * inv(:,:, 2) * inv(:,:, 1) + 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(:,:, 117) = rate(:,:, 117) * 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(:,:, 135) = rate(:,:, 135) * m(:,:) + rate(:,:, 136) = rate(:,:, 136) * 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(:,:, 172) = rate(:,:, 172) * 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * 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(:,:, 252) = rate(:,:, 252) * 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(:,:, 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(:,:, 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(:,:, 292) = rate(:,:, 292) * 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(:,:, 322) = rate(:,:, 322) * 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(:,:, 329) = rate(:,:, 329) * 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(:,:, 336) = rate(:,:, 336) * m(:,:) + rate(:,:, 337) = rate(:,:, 337) * m(:,:) + rate(:,:, 338) = rate(:,:, 338) * m(:,:) + rate(:,:, 339) = rate(:,:, 339) * m(:,:) + rate(:,:, 340) = rate(:,:, 340) * m(:,:) + rate(:,:, 341) = rate(:,:, 341) * m(:,:) + rate(:,:, 342) = rate(:,:, 342) * m(:,:) + rate(:,:, 343) = rate(:,:, 343) * m(:,:) + rate(:,:, 344) = rate(:,:, 344) * m(:,:) + rate(:,:, 345) = rate(:,:, 345) * m(:,:) + rate(:,:, 346) = rate(:,:, 346) * m(:,:) + rate(:,:, 347) = rate(:,:, 347) * m(:,:) + rate(:,:, 348) = rate(:,:, 348) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 352) = rate(:,:, 352) * m(:,:) + rate(:,:, 353) = rate(:,:, 353) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 357) = rate(:,:, 357) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + rate(:,:, 360) = rate(:,:, 360) * m(:,:) + rate(:,:, 361) = rate(:,:, 361) * m(:,:) + rate(:,:, 362) = rate(:,:, 362) * m(:,:) + rate(:,:, 363) = rate(:,:, 363) * m(:,:) + rate(:,:, 364) = rate(:,:, 364) * m(:,:) + rate(:,:, 365) = rate(:,:, 365) * m(:,:) + rate(:,:, 366) = rate(:,:, 366) * m(:,:) + rate(:,:, 367) = rate(:,:, 367) * m(:,:) + rate(:,:, 368) = rate(:,:, 368) * m(:,:) + rate(:,:, 372) = rate(:,:, 372) * m(:,:) + rate(:,:, 374) = rate(:,:, 374) * m(:,:) + rate(:,:, 376) = rate(:,:, 376) * m(:,:) + rate(:,:, 378) = rate(:,:, 378) * m(:,:) + rate(:,:, 380) = rate(:,:, 380) * m(:,:) + rate(:,:, 381) = rate(:,:, 381) * m(:,:) + rate(:,:, 382) = rate(:,:, 382) * m(:,:) + rate(:,:, 383) = rate(:,:, 383) * m(:,:) + rate(:,:, 384) = rate(:,:, 384) * m(:,:) + rate(:,:, 389) = rate(:,:, 389) * m(:,:) + rate(:,:, 390) = rate(:,:, 390) * m(:,:) + rate(:,:, 392) = rate(:,:, 392) * m(:,:) + rate(:,:, 393) = rate(:,:, 393) * m(:,:) + rate(:,:, 394) = rate(:,:, 394) * m(:,:) + rate(:,:, 396) = rate(:,:, 396) * m(:,:) + rate(:,:, 397) = rate(:,:, 397) * m(:,:) + rate(:,:, 398) = rate(:,:, 398) * m(:,:) + rate(:,:, 400) = rate(:,:, 400) * m(:,:) + rate(:,:, 401) = rate(:,:, 401) * m(:,:) + rate(:,:, 402) = rate(:,:, 402) * m(:,:) + rate(:,:, 403) = rate(:,:, 403) * m(:,:) + rate(:,:, 404) = rate(:,:, 404) * m(:,:) + rate(:,:, 405) = rate(:,:, 405) * m(:,:) + rate(:,:, 406) = rate(:,:, 406) * m(:,:) + rate(:,:, 407) = rate(:,:, 407) * m(:,:) + rate(:,:, 408) = rate(:,:, 408) * m(:,:) + rate(:,:, 409) = rate(:,:, 409) * m(:,:) + rate(:,:, 410) = rate(:,:, 410) * m(:,:) + rate(:,:, 411) = rate(:,:, 411) * m(:,:) + rate(:,:, 412) = rate(:,:, 412) * m(:,:) + rate(:,:, 413) = rate(:,:, 413) * m(:,:) + rate(:,:, 414) = rate(:,:, 414) * m(:,:) + rate(:,:, 415) = rate(:,:, 415) * m(:,:) + rate(:,:, 416) = rate(:,:, 416) * m(:,:) + rate(:,:, 417) = rate(:,:, 417) * m(:,:) + rate(:,:, 418) = rate(:,:, 418) * m(:,:) + rate(:,:, 419) = rate(:,:, 419) * m(:,:) + rate(:,:, 420) = rate(:,:, 420) * m(:,:) + rate(:,:, 421) = rate(:,:, 421) * m(:,:) + rate(:,:, 422) = rate(:,:, 422) * m(:,:) + rate(:,:, 423) = rate(:,:, 423) * m(:,:) + rate(:,:, 424) = rate(:,:, 424) * m(:,:) + rate(:,:, 425) = rate(:,:, 425) * m(:,:) + rate(:,:, 426) = rate(:,:, 426) * m(:,:) + rate(:,:, 427) = rate(:,:, 427) * m(:,:) + rate(:,:, 428) = rate(:,:, 428) * m(:,:) + rate(:,:, 429) = rate(:,:, 429) * m(:,:) + rate(:,:, 430) = rate(:,:, 430) * m(:,:) + rate(:,:, 431) = rate(:,:, 431) * m(:,:) + rate(:,:, 432) = rate(:,:, 432) * m(:,:) + rate(:,:, 433) = rate(:,:, 433) * m(:,:) + rate(:,:, 434) = rate(:,:, 434) * m(:,:) + rate(:,:, 435) = rate(:,:, 435) * m(:,:) + rate(:,:, 436) = rate(:,:, 436) * m(:,:) + rate(:,:, 437) = rate(:,:, 437) * m(:,:) + rate(:,:, 438) = rate(:,:, 438) * m(:,:) + rate(:,:, 439) = rate(:,:, 439) * m(:,:) + rate(:,:, 440) = rate(:,:, 440) * m(:,:) + rate(:,:, 441) = rate(:,:, 441) * m(:,:) + rate(:,:, 442) = rate(:,:, 442) * m(:,:) + rate(:,:, 443) = rate(:,:, 443) * m(:,:) + rate(:,:, 444) = rate(:,:, 444) * m(:,:) + rate(:,:, 445) = rate(:,:, 445) * m(:,:) + rate(:,:, 446) = rate(:,:, 446) * m(:,:) + rate(:,:, 447) = rate(:,:, 447) * m(:,:) + rate(:,:, 450) = rate(:,:, 450) * m(:,:) + rate(:,:, 451) = rate(:,:, 451) * m(:,:) + rate(:,:, 452) = rate(:,:, 452) * m(:,:) + rate(:,:, 453) = rate(:,:, 453) * m(:,:) + rate(:,:, 454) = rate(:,:, 454) * m(:,:) + rate(:,:, 455) = rate(:,:, 455) * m(:,:) + rate(:,:, 456) = rate(:,:, 456) * m(:,:) + rate(:,:, 457) = rate(:,:, 457) * m(:,:) + rate(:,:, 458) = rate(:,:, 458) * m(:,:) + rate(:,:, 459) = rate(:,:, 459) * m(:,:) + rate(:,:, 460) = rate(:,:, 460) * m(:,:) + rate(:,:, 461) = rate(:,:, 461) * m(:,:) + rate(:,:, 462) = rate(:,:, 462) * m(:,:) + rate(:,:, 463) = rate(:,:, 463) * m(:,:) + rate(:,:, 464) = rate(:,:, 464) * m(:,:) + rate(:,:, 465) = rate(:,:, 465) * m(:,:) + rate(:,:, 466) = rate(:,:, 466) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * m(:,:) + rate(:,:, 468) = rate(:,:, 468) * m(:,:) + rate(:,:, 469) = rate(:,:, 469) * m(:,:) + rate(:,:, 470) = rate(:,:, 470) * m(:,:) + rate(:,:, 471) = rate(:,:, 471) * m(:,:) + rate(:,:, 472) = rate(:,:, 472) * m(:,:) + rate(:,:, 473) = rate(:,:, 473) * m(:,:) + rate(:,:, 474) = rate(:,:, 474) * m(:,:) + rate(:,:, 475) = rate(:,:, 475) * m(:,:) + rate(:,:, 476) = rate(:,:, 476) * m(:,:) + rate(:,:, 477) = rate(:,:, 477) * m(:,:) + rate(:,:, 478) = rate(:,:, 478) * m(:,:) + rate(:,:, 479) = rate(:,:, 479) * m(:,:) + rate(:,:, 480) = rate(:,:, 480) * m(:,:) + rate(:,:, 481) = rate(:,:, 481) * m(:,:) + rate(:,:, 482) = rate(:,:, 482) * m(:,:) + rate(:,:, 483) = rate(:,:, 483) * m(:,:) + rate(:,:, 484) = rate(:,:, 484) * m(:,:) + rate(:,:, 486) = rate(:,:, 486) * m(:,:) + rate(:,:, 487) = rate(:,:, 487) * m(:,:) + rate(:,:, 488) = rate(:,:, 488) * m(:,:) + rate(:,:, 489) = rate(:,:, 489) * m(:,:) + rate(:,:, 490) = rate(:,:, 490) * m(:,:) + rate(:,:, 491) = rate(:,:, 491) * m(:,:) + rate(:,:, 492) = rate(:,:, 492) * m(:,:) + rate(:,:, 493) = rate(:,:, 493) * m(:,:) + rate(:,:, 494) = rate(:,:, 494) * m(:,:) + rate(:,:, 495) = rate(:,:, 495) * m(:,:) + rate(:,:, 496) = rate(:,:, 496) * m(:,:) + rate(:,:, 497) = rate(:,:, 497) * m(:,:) + rate(:,:, 498) = rate(:,:, 498) * m(:,:) + rate(:,:, 499) = rate(:,:, 499) * m(:,:) + rate(:,:, 500) = rate(:,:, 500) * m(:,:) + rate(:,:, 501) = rate(:,:, 501) * m(:,:) + rate(:,:, 502) = rate(:,:, 502) * m(:,:) + rate(:,:, 503) = rate(:,:, 503) * m(:,:) + rate(:,:, 504) = rate(:,:, 504) * m(:,:) + rate(:,:, 505) = rate(:,:, 505) * m(:,:) + rate(:,:, 506) = rate(:,:, 506) * m(:,:) + rate(:,:, 507) = rate(:,:, 507) * m(:,:) + rate(:,:, 508) = rate(:,:, 508) * m(:,:) + rate(:,:, 509) = rate(:,:, 509) * m(:,:) + rate(:,:, 510) = rate(:,:, 510) * m(:,:) + rate(:,:, 511) = rate(:,:, 511) * m(:,:) + rate(:,:, 512) = rate(:,:, 512) * m(:,:) + rate(:,:, 513) = rate(:,:, 513) * m(:,:) + rate(:,:, 514) = rate(:,:, 514) * m(:,:) + rate(:,:, 515) = rate(:,:, 515) * m(:,:) + rate(:,:, 516) = rate(:,:, 516) * m(:,:) + rate(:,:, 517) = rate(:,:, 517) * m(:,:) + rate(:,:, 518) = rate(:,:, 518) * m(:,:) + rate(:,:, 519) = rate(:,:, 519) * m(:,:) + rate(:,:, 520) = rate(:,:, 520) * m(:,:) + rate(:,:, 521) = rate(:,:, 521) * m(:,:) + rate(:,:, 522) = rate(:,:, 522) * m(:,:) + rate(:,:, 523) = rate(:,:, 523) * m(:,:) + rate(:,:, 524) = rate(:,:, 524) * m(:,:) + rate(:,:, 525) = rate(:,:, 525) * m(:,:) + rate(:,:, 526) = rate(:,:, 526) * m(:,:) + rate(:,:, 527) = rate(:,:, 527) * m(:,:) + rate(:,:, 528) = rate(:,:, 528) * m(:,:) + rate(:,:, 529) = rate(:,:, 529) * m(:,:) + rate(:,:, 530) = rate(:,:, 530) * m(:,:) + rate(:,:, 531) = rate(:,:, 531) * m(:,:) + rate(:,:, 532) = rate(:,:, 532) * m(:,:) + rate(:,:, 533) = rate(:,:, 533) * m(:,:) + rate(:,:, 534) = rate(:,:, 534) * m(:,:) + rate(:,:, 535) = rate(:,:, 535) * m(:,:) + rate(:,:, 536) = rate(:,:, 536) * m(:,:) + rate(:,:, 537) = rate(:,:, 537) * m(:,:) + rate(:,:, 538) = rate(:,:, 538) * m(:,:) + rate(:,:, 539) = rate(:,:, 539) * m(:,:) + rate(:,:, 540) = rate(:,:, 540) * m(:,:) + rate(:,:, 541) = rate(:,:, 541) * m(:,:) + rate(:,:, 542) = rate(:,:, 542) * m(:,:) + rate(:,:, 543) = rate(:,:, 543) * m(:,:) + rate(:,:, 544) = rate(:,:, 544) * m(:,:) + rate(:,:, 545) = rate(:,:, 545) * m(:,:) + rate(:,:, 546) = rate(:,:, 546) * m(:,:) + rate(:,:, 547) = rate(:,:, 547) * m(:,:) + rate(:,:, 548) = rate(:,:, 548) * m(:,:) + rate(:,:, 549) = rate(:,:, 549) * m(:,:) + rate(:,:, 550) = rate(:,:, 550) * m(:,:) + rate(:,:, 551) = rate(:,:, 551) * m(:,:) + rate(:,:, 552) = rate(:,:, 552) * m(:,:) + rate(:,:, 553) = rate(:,:, 553) * m(:,:) + rate(:,:, 554) = rate(:,:, 554) * m(:,:) + rate(:,:, 555) = rate(:,:, 555) * m(:,:) + rate(:,:, 556) = rate(:,:, 556) * m(:,:) + rate(:,:, 557) = rate(:,:, 557) * m(:,:) + rate(:,:, 563) = rate(:,:, 563) * m(:,:) + rate(:,:, 568) = rate(:,:, 568) * m(:,:) + rate(:,:, 569) = rate(:,:, 569) * m(:,:) + rate(:,:, 570) = rate(:,:, 570) * m(:,:) + rate(:,:, 573) = rate(:,:, 573) * m(:,:) + rate(:,:, 574) = rate(:,:, 574) * m(:,:) + rate(:,:, 575) = rate(:,:, 575) * m(:,:) + rate(:,:, 578) = rate(:,:, 578) * m(:,:) + rate(:,:, 582) = rate(:,:, 582) * m(:,:) + rate(:,:, 583) = rate(:,:, 583) * m(:,:) + rate(:,:, 584) = rate(:,:, 584) * m(:,:) + rate(:,:, 585) = rate(:,:, 585) * m(:,:) + rate(:,:, 586) = rate(:,:, 586) * m(:,:) + rate(:,:, 587) = rate(:,:, 587) * m(:,:) + rate(:,:, 588) = rate(:,:, 588) * m(:,:) + rate(:,:, 589) = rate(:,:, 589) * m(:,:) + rate(:,:, 590) = rate(:,:, 590) * m(:,:) + rate(:,:, 591) = rate(:,:, 591) * m(:,:) + rate(:,:, 593) = rate(:,:, 593) * m(:,:) + rate(:,:, 594) = rate(:,:, 594) * m(:,:) + rate(:,:, 596) = rate(:,:, 596) * m(:,:) + rate(:,:, 597) = rate(:,:, 597) * m(:,:) + rate(:,:, 598) = rate(:,:, 598) * m(:,:) + rate(:,:, 600) = rate(:,:, 600) * m(:,:) + rate(:,:, 601) = rate(:,:, 601) * m(:,:) + rate(:,:, 602) = rate(:,:, 602) * m(:,:) + rate(:,:, 603) = rate(:,:, 603) * m(:,:) + rate(:,:, 606) = rate(:,:, 606) * m(:,:) end subroutine adjrxt end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 index 9291c4068e..a4f5ffa3eb 100644 --- a/src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/mo_indprd.F90 @@ -17,186 +17,149 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) 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) = 0._r8 - prod(:,2) = 0._r8 - prod(:,3) = 0._r8 - prod(:,4) = 0._r8 - prod(:,5) = 0._r8 - prod(:,6) = 0._r8 - prod(:,7) = 0._r8 - prod(:,8) = 0._r8 - prod(:,9) = 0._r8 - prod(:,10) = 0._r8 - prod(:,11) = 0._r8 - prod(:,12) = 0._r8 - prod(:,13) = 0._r8 - prod(:,14) = 0._r8 - prod(:,15) = 0._r8 - prod(:,16) = 0._r8 - prod(:,17) = (rxt(:,63) +rxt(:,114)*y(:,86) +rxt(:,115)*y(:,86) + & - rxt(:,116)*y(:,26) +rxt(:,117)*y(:,38) +rxt(:,124)*y(:,49) + & - rxt(:,125)*y(:,67) +rxt(:,126)*y(:,68) +rxt(:,168)*y(:,104) + & - rxt(:,170)*y(:,102) +rxt(:,186)*y(:,100) +rxt(:,204)*y(:,119) + & - rxt(:,221)*y(:,116) +rxt(:,239)*y(:,115) +rxt(:,256)*y(:,126) + & - rxt(:,258)*y(:,102) +rxt(:,265)*y(:,104) +rxt(:,280)*y(:,60) + & - rxt(:,281)*y(:,61))*y(:,91) + (rxt(:,120)*y(:,61) + & - rxt(:,121)*y(:,61) +rxt(:,122)*y(:,60) +rxt(:,123)*y(:,60) + & - rxt(:,155)*y(:,126) +rxt(:,158)*y(:,102) +rxt(:,178)*y(:,104) + & - rxt(:,196)*y(:,100) +rxt(:,213)*y(:,119) +rxt(:,231)*y(:,116) + & - rxt(:,249)*y(:,115) +rxt(:,260)*y(:,102) +rxt(:,261)*y(:,104)) & - *y(:,93) + (rxt(:,65) +rxt(:,127)*y(:,86) +rxt(:,128)*y(:,26) + & - rxt(:,130)*y(:,47) +rxt(:,132)*y(:,69) +rxt(:,151)*y(:,126) + & - rxt(:,174)*y(:,104) +rxt(:,191)*y(:,100) +rxt(:,209)*y(:,119) + & - rxt(:,225)*y(:,102) +rxt(:,227)*y(:,116) +rxt(:,244)*y(:,115)) & - *y(:,94) + (rxt(:,153)*y(:,126) +rxt(:,176)*y(:,104) + & - rxt(:,194)*y(:,100) +rxt(:,211)*y(:,119) +rxt(:,229)*y(:,116) + & - rxt(:,246)*y(:,115) +rxt(:,247)*y(:,102) +rxt(:,259)*y(:,104) + & - rxt(:,271)*y(:,102))*y(:,92) + (rxt(:,149)*y(:,126) + & - rxt(:,172)*y(:,104) +rxt(:,189)*y(:,100) +rxt(:,203)*y(:,102) + & - rxt(:,207)*y(:,119) +rxt(:,224)*y(:,116) +rxt(:,242)*y(:,115)) & - *y(:,97) + (rxt(:,369) +rxt(:,306)*y(:,95) +rxt(:,307)*y(:,137)) & - *y(:,118) + (rxt(:,537)*y(:,131) +rxt(:,541)*y(:,131))*y(:,29) - prod(:,18) = 0._r8 - prod(:,19) = 0._r8 - prod(:,20) = 0._r8 - prod(:,21) = 0._r8 - prod(:,22) =rxt(:,427)*y(:,61)*y(:,54) - prod(:,23) = 0._r8 -!-------------------------------------------------------------------- ! ... "independent" production for Implicit species !-------------------------------------------------------------------- - else if( class == 4 ) then + if( class == 4 ) then prod(:,1) = + extfrc(:,5) prod(:,2) = + extfrc(:,6) + prod(:,97) = 0._r8 + prod(:,41) = 0._r8 + prod(:,104) = 0._r8 + prod(:,61) = 0._r8 + prod(:,3) = 0._r8 + prod(:,25) = 0._r8 + prod(:,32) = 0._r8 + prod(:,33) = 0._r8 prod(:,27) = 0._r8 - prod(:,82) = 0._r8 - prod(:,45) = 0._r8 - prod(:,83) =.180_r8*rxt(:,25)*y(:,22) - prod(:,66) =rxt(:,40)*y(:,17) +rxt(:,42)*y(:,19) +rxt(:,24)*y(:,22) + prod(:,34) = 0._r8 + prod(:,28) = 0._r8 prod(:,35) = 0._r8 + prod(:,29) = 0._r8 + prod(:,57) = 0._r8 + prod(:,105) = 0._r8 + prod(:,63) = 0._r8 + prod(:,30) = 0._r8 + prod(:,52) = 0._r8 + prod(:,87) = 0._r8 + prod(:,54) = 0._r8 + prod(:,86) = 0._r8 + prod(:,53) = 0._r8 + prod(:,136) = 0._r8 + prod(:,36) = 0._r8 prod(:,24) = 0._r8 - prod(:,21) = 0._r8 - prod(:,112) = 0._r8 - prod(:,62) = 0._r8 - prod(:,44) = (rxt(:,26) +rxt(:,62))*y(:,30) +.380_r8*rxt(:,25)*y(:,22) & - + extfrc(:,13) - prod(:,23) =rxt(:,32)*y(:,8) +rxt(:,33)*y(:,9) +rxt(:,35)*y(:,11) & - +2.000_r8*rxt(:,36)*y(:,12) +2.000_r8*rxt(:,37)*y(:,13) +rxt(:,38) & - *y(:,14) +2.000_r8*rxt(:,51)*y(:,40) +rxt(:,54)*y(:,45) +rxt(:,55) & - *y(:,46) - prod(:,25) =rxt(:,34)*y(:,10) +rxt(:,35)*y(:,11) +rxt(:,53)*y(:,44) - prod(:,32) = + extfrc(:,2) - prod(:,3) = 0._r8 + prod(:,130) = 0._r8 + prod(:,81) = 0._r8 prod(:,4) = 0._r8 + prod(:,67) = + extfrc(:,13) + prod(:,135) = 0._r8 + prod(:,40) = 0._r8 + prod(:,38) = 0._r8 + prod(:,48) = + extfrc(:,2) prod(:,5) = 0._r8 - prod(:,53) =rxt(:,33)*y(:,9) +rxt(:,37)*y(:,13) - prod(:,113) = (rxt(:,24) +.330_r8*rxt(:,25))*y(:,22) - prod(:,77) =1.440_r8*rxt(:,25)*y(:,22) - prod(:,46) = 0._r8 - prod(:,22) = 0._r8 - prod(:,58) = 0._r8 - prod(:,98) = 0._r8 - prod(:,26) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,79) = 0._r8 + prod(:,121) = 0._r8 prod(:,101) = 0._r8 + prod(:,26) = 0._r8 + prod(:,62) = 0._r8 + prod(:,31) = 0._r8 + prod(:,78) = 0._r8 + prod(:,37) = 0._r8 prod(:,39) = 0._r8 - prod(:,54) = 0._r8 - prod(:,57) = 0._r8 - prod(:,50) = 0._r8 - prod(:,65) = (rxt(:,69) +rxt(:,70) +.800_r8*rxt(:,72) +.800_r8*rxt(:,73)) & + prod(:,46) = 0._r8 + prod(:,124) = 0._r8 + prod(:,47) = 0._r8 + prod(:,118) = 0._r8 + prod(:,58) = 0._r8 + prod(:,75) = 0._r8 + prod(:,77) = 0._r8 + prod(:,71) = 0._r8 + prod(:,88) = (rxt(:,69) +rxt(:,70) +.800_r8*rxt(:,72) +.800_r8*rxt(:,73)) & + extfrc(:,15) - prod(:,64) = 0._r8 - prod(:,6) = 0._r8 - prod(:,7) = 0._r8 + prod(:,42) = 0._r8 + prod(:,85) = 0._r8 prod(:,8) = 0._r8 - prod(:,106) = + extfrc(:,14) - prod(:,94) = + extfrc(:,3) - prod(:,97) = 0._r8 - prod(:,9) = + extfrc(:,7) - prod(:,10) = + extfrc(:,8) - prod(:,11) = 0._r8 - prod(:,12) = + extfrc(:,9) - prod(:,104) = (rxt(:,26) +rxt(:,62))*y(:,30) +.180_r8*rxt(:,25)*y(:,22) & - + extfrc(:,22) - prod(:,100) = 0._r8 - prod(:,99) = 0._r8 - prod(:,33) = 0._r8 - prod(:,34) = 0._r8 - prod(:,13) = + extfrc(:,10) - prod(:,14) = + extfrc(:,11) - prod(:,49) = 0._r8 + prod(:,9) = 0._r8 + prod(:,10) = 0._r8 + prod(:,129) = + extfrc(:,14) + prod(:,127) = + extfrc(:,3) + prod(:,115) = 0._r8 + prod(:,11) = + extfrc(:,7) + prod(:,12) = + extfrc(:,8) + prod(:,13) = 0._r8 + prod(:,14) = + extfrc(:,9) + prod(:,119) = + extfrc(:,22) + prod(:,106) = 0._r8 + prod(:,131) = 0._r8 + prod(:,134) = 0._r8 + prod(:,50) = 0._r8 + prod(:,51) = 0._r8 + prod(:,15) = + extfrc(:,10) + prod(:,16) = + extfrc(:,11) prod(:,70) = 0._r8 - prod(:,60) = + extfrc(:,4) - prod(:,29) = 0._r8 - prod(:,15) = + extfrc(:,12) - prod(:,16) = + extfrc(:,1) prod(:,17) = 0._r8 - prod(:,18) = 0._r8 - prod(:,19) = 0._r8 + prod(:,91) = 0._r8 + prod(:,80) = + extfrc(:,4) + prod(:,43) = 0._r8 + prod(:,18) = + extfrc(:,12) + prod(:,19) = + extfrc(:,1) prod(:,20) = 0._r8 - prod(:,75) =rxt(:,32)*y(:,8) +rxt(:,33)*y(:,9) +2.000_r8*rxt(:,39)*y(:,15) & - +rxt(:,40)*y(:,17) +3.000_r8*rxt(:,43)*y(:,23) +2.000_r8*rxt(:,51) & - *y(:,40) - prod(:,105) =4.000_r8*rxt(:,31)*y(:,7) +rxt(:,32)*y(:,8) +2.000_r8*rxt(:,34) & - *y(:,10) +2.000_r8*rxt(:,35)*y(:,11) +2.000_r8*rxt(:,36)*y(:,12) & - +rxt(:,37)*y(:,13) +2.000_r8*rxt(:,38)*y(:,14) +3.000_r8*rxt(:,41) & - *y(:,18) +rxt(:,42)*y(:,19) +rxt(:,53)*y(:,44) +rxt(:,54)*y(:,45) & - +rxt(:,55)*y(:,46) - prod(:,86) = 0._r8 - prod(:,72) = 0._r8 - prod(:,71) = 0._r8 - prod(:,63) = 0._r8 - prod(:,90) = 0._r8 - prod(:,69) = 0._r8 - prod(:,80) = 0._r8 - prod(:,85) = 0._r8 - prod(:,107) = (rxt(:,67) +rxt(:,68) +rxt(:,69) +rxt(:,70) +rxt(:,71) + & - rxt(:,74)) + extfrc(:,20) - prod(:,36) = 0._r8 - prod(:,67) = 0._r8 - prod(:,88) = 0._r8 - prod(:,48) = 0._r8 - prod(:,95) = 0._r8 - prod(:,30) = 0._r8 - prod(:,111) = 0._r8 - prod(:,31) = 0._r8 + prod(:,21) = 0._r8 + prod(:,22) = 0._r8 + prod(:,23) = 0._r8 + prod(:,107) = 0._r8 + prod(:,94) = 0._r8 + prod(:,93) = 0._r8 + prod(:,82) = 0._r8 + prod(:,113) = 0._r8 + prod(:,92) = 0._r8 + prod(:,102) = 0._r8 prod(:,108) = 0._r8 - prod(:,51) = 0._r8 - prod(:,55) = (rxt(:,68) +rxt(:,71) +1.200_r8*rxt(:,72) +1.200_r8*rxt(:,73)) & + prod(:,114) = (rxt(:,67) +rxt(:,68) +rxt(:,69) +rxt(:,70) +rxt(:,71) + & + rxt(:,74)) + extfrc(:,20) + prod(:,55) = 0._r8 + prod(:,90) = 0._r8 + prod(:,110) = 0._r8 + prod(:,66) = 0._r8 + prod(:,123) = 0._r8 + prod(:,44) = 0._r8 + prod(:,128) = 0._r8 + prod(:,45) = 0._r8 + prod(:,122) = 0._r8 + prod(:,72) = 0._r8 + prod(:,74) = (rxt(:,68) +rxt(:,71) +1.200_r8*rxt(:,72) +1.200_r8*rxt(:,73)) & + extfrc(:,16) - prod(:,47) = (rxt(:,67) +rxt(:,74)) + extfrc(:,17) - prod(:,91) = 0._r8 - prod(:,73) = 0._r8 - prod(:,87) = 0._r8 - prod(:,79) = 0._r8 - prod(:,81) = 0._r8 - prod(:,76) = 0._r8 - prod(:,78) = 0._r8 - prod(:,92) = 0._r8 - prod(:,93) = 0._r8 - prod(:,37) = 0._r8 - prod(:,41) = 0._r8 + prod(:,64) = (rxt(:,67) +rxt(:,74)) + extfrc(:,17) + prod(:,111) = 0._r8 + prod(:,95) = 0._r8 + prod(:,109) = 0._r8 + prod(:,100) = 0._r8 + prod(:,103) = 0._r8 prod(:,96) = 0._r8 - prod(:,40) = 0._r8 - prod(:,56) = (rxt(:,68) +rxt(:,69) +rxt(:,70) +rxt(:,71)) + extfrc(:,21) - prod(:,84) =rxt(:,13)*y(:,55) - prod(:,59) = 0._r8 - prod(:,28) = 0._r8 - prod(:,102) = 0._r8 - prod(:,103) = + extfrc(:,23) - prod(:,52) = 0._r8 - prod(:,74) = 0._r8 - prod(:,38) = 0._r8 + prod(:,99) = 0._r8 + prod(:,116) = 0._r8 + prod(:,117) = 0._r8 + prod(:,56) = 0._r8 + prod(:,69) = 0._r8 + prod(:,120) = 0._r8 prod(:,68) = 0._r8 - prod(:,89) =.330_r8*rxt(:,25)*y(:,22) + extfrc(:,18) - prod(:,109) = 0._r8 - prod(:,110) = 0._r8 - prod(:,61) = + extfrc(:,19) - prod(:,43) = 0._r8 - prod(:,42) = 0._r8 - prod(:,114) =.050_r8*rxt(:,25)*y(:,22) + prod(:,76) = (rxt(:,68) +rxt(:,69) +rxt(:,70) +rxt(:,71)) + extfrc(:,21) + prod(:,83) = 0._r8 + prod(:,49) = 0._r8 + prod(:,125) = 0._r8 + prod(:,126) = + extfrc(:,23) + prod(:,73) = 0._r8 + prod(:,98) = 0._r8 + prod(:,65) = 0._r8 + prod(:,89) = 0._r8 + prod(:,112) = + extfrc(:,18) + prod(:,132) = 0._r8 + prod(:,133) = 0._r8 + prod(:,84) = + extfrc(:,19) + prod(:,60) = 0._r8 + prod(:,59) = 0._r8 + prod(:,137) = 0._r8 end if end subroutine indprd end module mo_indprd diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_lin_matrix.F90 index 3f9d706f25..275f1577da 100644 --- a/src/chemistry/pp_waccm_mad_mam4/mo_lin_matrix.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/mo_lin_matrix.F90 @@ -25,207 +25,209 @@ subroutine linmat01( avec_len, mat, y, rxt, het_rates ) do k = 1,avec_len mat(k,1) = -( het_rates(k,1) ) mat(k,2) = -( het_rates(k,2) ) - mat(k,39) = -( rxt(k,27) + het_rates(k,3) ) - mat(k,584) = -( rxt(k,28) + het_rates(k,4) ) - mat(k,141) = rxt(k,29) - mat(k,138) = -( rxt(k,29) + rxt(k,30) + rxt(k,565) + rxt(k,568) + rxt(k,573) & - + het_rates(k,5) ) - mat(k,606) = -( rxt(k,21) + rxt(k,22) + het_rates(k,16) ) - mat(k,79) = rxt(k,23) - mat(k,636) = rxt(k,539)*y(k,22) + rxt(k,540)*y(k,22) - mat(k,324) = -( het_rates(k,20) ) - mat(k,1450) = rxt(k,451)*y(k,22) - mat(k,199) = rxt(k,507)*y(k,22) - mat(k,786) = rxt(k,536)*y(k,22) - mat(k,631) = rxt(k,538)*y(k,22) - mat(k,77) = -( rxt(k,23) + het_rates(k,21) ) - mat(k,30) = -( rxt(k,44) + het_rates(k,24) ) - mat(k,21) = -( rxt(k,45) + rxt(k,485) + het_rates(k,25) ) - mat(k,1761) = -( rxt(k,46) + het_rates(k,26) ) - mat(k,285) = rxt(k,48) - mat(k,68) = rxt(k,60) - mat(k,23) = 2.000_r8*rxt(k,485) - mat(k,277) = -( rxt(k,47) + rxt(k,48) + rxt(k,567) + rxt(k,572) + rxt(k,578) & - + het_rates(k,27) ) - mat(k,134) = -( het_rates(k,29) ) - mat(k,601) = rxt(k,21) + rxt(k,22) - mat(k,70) = rxt(k,101) - mat(k,1445) = rxt(k,518)*y(k,19) - mat(k,261) = rxt(k,595)*y(k,30) - mat(k,27) = -( rxt(k,49) + het_rates(k,31) ) - mat(k,625) = rxt(k,476)*y(k,8) + rxt(k,478)*y(k,11) + 2.000_r8*rxt(k,479)*y(k,12) & - + 2.000_r8*rxt(k,480)*y(k,13) + rxt(k,481)*y(k,14) & - + rxt(k,502)*y(k,9) + 2.000_r8*rxt(k,504)*y(k,40) & - + rxt(k,528)*y(k,45) + rxt(k,529)*y(k,46) - mat(k,768) = rxt(k,523)*y(k,45) + rxt(k,524)*y(k,46) - mat(k,32) = -( rxt(k,50) + het_rates(k,32) ) - mat(k,626) = rxt(k,477)*y(k,10) + rxt(k,478)*y(k,11) + rxt(k,527)*y(k,44) - mat(k,769) = rxt(k,522)*y(k,44) - mat(k,58) = -( het_rates(k,33) ) - mat(k,3) = -( het_rates(k,34) ) - mat(k,4) = -( het_rates(k,35) ) + mat(k,579) = -( het_rates(k,3) ) + mat(k,93) = rxt(k,27) + mat(k,711) = rxt(k,28) + mat(k,205) = rxt(k,30) + mat(k,55) = rxt(k,32) + mat(k,61) = rxt(k,33) + mat(k,177) = 2.000_r8*rxt(k,39) + mat(k,220) = rxt(k,40) + mat(k,153) = 3.000_r8*rxt(k,43) + mat(k,32) = 2.000_r8*rxt(k,51) + mat(k,330) = rxt(k,52) + mat(k,307) = rxt(k,58) + mat(k,92) = -( rxt(k,27) + het_rates(k,4) ) + mat(k,712) = -( rxt(k,28) + het_rates(k,5) ) + mat(k,206) = rxt(k,29) + mat(k,203) = -( rxt(k,29) + rxt(k,30) + rxt(k,564) + rxt(k,567) + rxt(k,572) & + + het_rates(k,6) ) + mat(k,3) = -( het_rates(k,7) ) + mat(k,27) = -( rxt(k,31) + het_rates(k,8) ) + mat(k,53) = -( rxt(k,32) + het_rates(k,9) ) + mat(k,58) = -( rxt(k,33) + het_rates(k,10) ) + mat(k,34) = -( rxt(k,34) + het_rates(k,11) ) + mat(k,63) = -( rxt(k,35) + het_rates(k,12) ) + mat(k,38) = -( rxt(k,36) + het_rates(k,13) ) + mat(k,68) = -( rxt(k,37) + het_rates(k,14) ) + mat(k,42) = -( rxt(k,38) + het_rates(k,15) ) + mat(k,176) = -( rxt(k,39) + het_rates(k,16) ) + mat(k,735) = -( rxt(k,21) + rxt(k,22) + het_rates(k,17) ) + mat(k,160) = rxt(k,23) + mat(k,416) = .180_r8*rxt(k,25) + mat(k,218) = -( rxt(k,40) + het_rates(k,18) ) + mat(k,46) = -( rxt(k,41) + het_rates(k,19) ) + mat(k,144) = -( rxt(k,42) + het_rates(k,20) ) + mat(k,429) = -( het_rates(k,21) ) + mat(k,414) = rxt(k,24) + mat(k,219) = rxt(k,40) + mat(k,146) = rxt(k,42) + mat(k,158) = -( rxt(k,23) + het_rates(k,22) ) + mat(k,413) = -( rxt(k,24) + rxt(k,25) + het_rates(k,23) ) + mat(k,152) = -( rxt(k,43) + het_rates(k,24) ) + mat(k,2026) = -( het_rates(k,25) ) + mat(k,94) = rxt(k,27) + mat(k,29) = 4.000_r8*rxt(k,31) + mat(k,57) = rxt(k,32) + mat(k,37) = 2.000_r8*rxt(k,34) + mat(k,67) = 2.000_r8*rxt(k,35) + mat(k,41) = 2.000_r8*rxt(k,36) + mat(k,72) = rxt(k,37) + mat(k,45) = 2.000_r8*rxt(k,38) + mat(k,48) = 3.000_r8*rxt(k,41) + mat(k,150) = rxt(k,42) + mat(k,74) = 2.000_r8*rxt(k,44) + mat(k,26) = 2.000_r8*rxt(k,45) + mat(k,1777) = rxt(k,46) + mat(k,364) = rxt(k,47) + mat(k,83) = rxt(k,50) + mat(k,79) = rxt(k,53) + mat(k,88) = rxt(k,54) + mat(k,117) = rxt(k,55) + mat(k,1518) = rxt(k,56) + mat(k,327) = rxt(k,59) + mat(k,73) = -( rxt(k,44) + het_rates(k,26) ) + mat(k,24) = -( rxt(k,45) + rxt(k,485) + het_rates(k,27) ) + mat(k,1771) = -( rxt(k,46) + het_rates(k,28) ) + mat(k,363) = rxt(k,48) + mat(k,135) = rxt(k,60) + mat(k,25) = 2.000_r8*rxt(k,485) + mat(k,356) = -( rxt(k,47) + rxt(k,48) + rxt(k,566) + rxt(k,571) + rxt(k,577) & + + het_rates(k,29) ) + mat(k,4) = -( het_rates(k,30) ) + mat(k,249) = -( het_rates(k,31) ) + mat(k,730) = rxt(k,21) + rxt(k,22) + mat(k,411) = .380_r8*rxt(k,25) + mat(k,1940) = rxt(k,26) + rxt(k,62) + mat(k,137) = rxt(k,101) + mat(k,1977) = -( rxt(k,26) + rxt(k,62) + het_rates(k,32) ) + mat(k,425) = .440_r8*rxt(k,25) + mat(k,1033) = rxt(k,63) + mat(k,856) = rxt(k,65) + mat(k,266) = rxt(k,369) + mat(k,89) = -( rxt(k,49) + het_rates(k,33) ) + mat(k,54) = rxt(k,32) + mat(k,59) = rxt(k,33) + mat(k,65) = rxt(k,35) + mat(k,39) = 2.000_r8*rxt(k,36) + mat(k,69) = 2.000_r8*rxt(k,37) + mat(k,43) = rxt(k,38) + mat(k,31) = 2.000_r8*rxt(k,51) + mat(k,85) = rxt(k,54) + mat(k,112) = rxt(k,55) + mat(k,80) = -( rxt(k,50) + het_rates(k,34) ) + mat(k,35) = rxt(k,34) + mat(k,64) = rxt(k,35) + mat(k,76) = rxt(k,53) + mat(k,122) = -( het_rates(k,35) ) mat(k,5) = -( het_rates(k,36) ) - mat(k,198) = -( rxt(k,507)*y(k,22) + het_rates(k,37) ) - mat(k,28) = 2.000_r8*rxt(k,49) - mat(k,33) = rxt(k,50) - mat(k,37) = rxt(k,57) - mat(k,628) = rxt(k,480)*y(k,13) + rxt(k,502)*y(k,9) - mat(k,1797) = -( het_rates(k,38) ) - mat(k,1855) = 2.000_r8*rxt(k,2) + rxt(k,3) - mat(k,623) = 2.000_r8*rxt(k,21) - mat(k,81) = rxt(k,23) - mat(k,244) = rxt(k,52) - mat(k,1175) = rxt(k,56) - mat(k,38) = rxt(k,57) - mat(k,656) = rxt(k,539)*y(k,22) - mat(k,484) = -( het_rates(k,39) ) - mat(k,1821) = rxt(k,1) - mat(k,604) = rxt(k,22) - mat(k,634) = rxt(k,540)*y(k,22) - mat(k,146) = -( rxt(k,4) + het_rates(k,41) ) - mat(k,736) = .500_r8*rxt(k,559) - mat(k,24) = -( rxt(k,100) + het_rates(k,42) ) - mat(k,238) = -( rxt(k,52) + het_rates(k,43) ) - mat(k,1160) = -( rxt(k,56) + het_rates(k,47) ) - mat(k,399) = rxt(k,386) - mat(k,1469) = rxt(k,451)*y(k,22) + rxt(k,513)*y(k,15) + rxt(k,515)*y(k,17) & - + 2.000_r8*rxt(k,518)*y(k,19) + rxt(k,520)*y(k,23) - mat(k,36) = -( rxt(k,57) + het_rates(k,48) ) - mat(k,197) = rxt(k,507)*y(k,22) - mat(k,1292) = -( rxt(k,9) + het_rates(k,49) ) - mat(k,511) = rxt(k,275) - mat(k,303) = 2.000_r8*rxt(k,560) + 2.000_r8*rxt(k,563) + 2.000_r8*rxt(k,566) & - + 2.000_r8*rxt(k,577) - mat(k,997) = .500_r8*rxt(k,561) - mat(k,1119) = rxt(k,562) - mat(k,144) = rxt(k,565) + rxt(k,568) + rxt(k,573) - mat(k,282) = rxt(k,567) + rxt(k,572) + rxt(k,578) - mat(k,101) = -( rxt(k,10) + rxt(k,11) + rxt(k,448) + het_rates(k,50) ) - mat(k,207) = -( rxt(k,58) + het_rates(k,51) ) - mat(k,139) = rxt(k,565) + rxt(k,568) + rxt(k,573) - mat(k,231) = -( rxt(k,59) + het_rates(k,52) ) - mat(k,276) = rxt(k,567) + rxt(k,572) + rxt(k,578) - mat(k,175) = -( rxt(k,12) + het_rates(k,53) ) - mat(k,311) = -( rxt(k,66) + het_rates(k,54) ) - mat(k,1488) = rxt(k,17) - mat(k,265) = rxt(k,596) - mat(k,297) = -( rxt(k,14) + rxt(k,15) + rxt(k,449) + rxt(k,560) + rxt(k,563) & - + rxt(k,566) + rxt(k,577) + het_rates(k,56) ) - mat(k,6) = -( het_rates(k,57) ) - mat(k,7) = -( het_rates(k,58) ) + mat(k,6) = -( het_rates(k,37) ) + mat(k,7) = -( het_rates(k,38) ) + mat(k,338) = -( het_rates(k,39) ) + mat(k,60) = rxt(k,33) + mat(k,70) = rxt(k,37) + mat(k,90) = 2.000_r8*rxt(k,49) + mat(k,81) = rxt(k,50) + mat(k,120) = rxt(k,57) + mat(k,1372) = -( het_rates(k,40) ) + mat(k,2071) = 2.000_r8*rxt(k,2) + rxt(k,3) + mat(k,743) = 2.000_r8*rxt(k,21) + mat(k,162) = rxt(k,23) + mat(k,423) = rxt(k,24) + .330_r8*rxt(k,25) + mat(k,335) = rxt(k,52) + mat(k,1503) = rxt(k,56) + mat(k,121) = rxt(k,57) + mat(k,644) = -( het_rates(k,41) ) + mat(k,2052) = rxt(k,1) + mat(k,733) = rxt(k,22) + mat(k,415) = 1.440_r8*rxt(k,25) + mat(k,30) = -( rxt(k,51) + het_rates(k,42) ) + mat(k,211) = -( rxt(k,4) + het_rates(k,43) ) + mat(k,886) = .500_r8*rxt(k,558) + mat(k,50) = -( rxt(k,100) + het_rates(k,44) ) + mat(k,329) = -( rxt(k,52) + het_rates(k,45) ) + mat(k,75) = -( rxt(k,53) + het_rates(k,46) ) + mat(k,84) = -( rxt(k,54) + het_rates(k,47) ) + mat(k,113) = -( rxt(k,55) + het_rates(k,48) ) + mat(k,1506) = -( rxt(k,56) + het_rates(k,49) ) + mat(k,524) = rxt(k,386) + mat(k,119) = -( rxt(k,57) + het_rates(k,50) ) + mat(k,1231) = -( rxt(k,9) + het_rates(k,51) ) + mat(k,611) = rxt(k,275) + mat(k,403) = 2.000_r8*rxt(k,559) + 2.000_r8*rxt(k,562) + 2.000_r8*rxt(k,565) & + + 2.000_r8*rxt(k,576) + mat(k,1629) = .500_r8*rxt(k,560) + mat(k,1099) = rxt(k,561) + mat(k,208) = rxt(k,564) + rxt(k,567) + rxt(k,572) + mat(k,359) = rxt(k,566) + rxt(k,571) + rxt(k,577) + mat(k,183) = -( rxt(k,10) + rxt(k,11) + rxt(k,448) + het_rates(k,52) ) + mat(k,306) = -( rxt(k,58) + het_rates(k,53) ) + mat(k,204) = rxt(k,564) + rxt(k,567) + rxt(k,572) + mat(k,322) = -( rxt(k,59) + het_rates(k,54) ) + mat(k,355) = rxt(k,566) + rxt(k,571) + rxt(k,577) + mat(k,275) = -( rxt(k,12) + het_rates(k,55) ) + mat(k,443) = -( rxt(k,66) + het_rates(k,56) ) + mat(k,1695) = rxt(k,17) + mat(k,386) = rxt(k,595) + mat(k,95) = -( rxt(k,13) + het_rates(k,57) ) + mat(k,398) = -( rxt(k,14) + rxt(k,15) + rxt(k,449) + rxt(k,559) + rxt(k,562) & + + rxt(k,565) + rxt(k,576) + het_rates(k,58) ) mat(k,8) = -( het_rates(k,59) ) - mat(k,1518) = -( rxt(k,16) + rxt(k,17) + het_rates(k,60) ) - mat(k,178) = rxt(k,12) - mat(k,305) = rxt(k,15) - mat(k,1002) = rxt(k,18) + .500_r8*rxt(k,561) - mat(k,1124) = rxt(k,20) - mat(k,1376) = rxt(k,593) - mat(k,127) = rxt(k,606) - mat(k,651) = 2.000_r8*rxt(k,442)*y(k,55) - mat(k,990) = -( rxt(k,18) + rxt(k,561) + het_rates(k,61) ) - mat(k,1285) = rxt(k,9) - mat(k,104) = rxt(k,11) + rxt(k,448) - mat(k,301) = rxt(k,14) + rxt(k,449) - mat(k,1112) = rxt(k,19) - mat(k,142) = rxt(k,29) - mat(k,279) = rxt(k,48) - mat(k,855) = rxt(k,75) - mat(k,1115) = -( rxt(k,19) + rxt(k,20) + rxt(k,562) + het_rates(k,62) ) - mat(k,105) = rxt(k,10) - mat(k,302) = rxt(k,14) + rxt(k,15) + rxt(k,449) - mat(k,143) = rxt(k,30) - mat(k,280) = rxt(k,47) - mat(k,720) = rxt(k,76) - mat(k,9) = -( het_rates(k,63) ) - mat(k,10) = -( het_rates(k,64) ) + mat(k,9) = -( het_rates(k,60) ) + mat(k,10) = -( het_rates(k,61) ) + mat(k,1725) = -( rxt(k,16) + rxt(k,17) + het_rates(k,62) ) + mat(k,278) = rxt(k,12) + mat(k,408) = rxt(k,15) + mat(k,1640) = rxt(k,18) + .500_r8*rxt(k,560) + mat(k,1110) = rxt(k,20) + mat(k,1592) = rxt(k,592) + mat(k,196) = rxt(k,605) + mat(k,1638) = -( rxt(k,18) + rxt(k,560) + het_rates(k,63) ) + mat(k,1240) = rxt(k,9) + mat(k,187) = rxt(k,11) + rxt(k,448) + mat(k,406) = rxt(k,14) + rxt(k,449) + mat(k,1108) = rxt(k,19) + mat(k,210) = rxt(k,29) + mat(k,362) = rxt(k,48) + mat(k,937) = rxt(k,75) + mat(k,1096) = -( rxt(k,19) + rxt(k,20) + rxt(k,561) + het_rates(k,64) ) + mat(k,186) = rxt(k,10) + mat(k,402) = rxt(k,14) + rxt(k,15) + rxt(k,449) + mat(k,207) = rxt(k,30) + mat(k,358) = rxt(k,47) + mat(k,866) = rxt(k,76) mat(k,11) = -( het_rates(k,65) ) mat(k,12) = -( het_rates(k,66) ) - mat(k,1433) = -( rxt(k,77) + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) & - + rxt(k,82) + het_rates(k,67) ) - mat(k,1846) = rxt(k,2) - mat(k,1256) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,83) + rxt(k,85) + rxt(k,87) & + mat(k,13) = -( het_rates(k,67) ) + mat(k,14) = -( het_rates(k,68) ) + mat(k,1292) = -( rxt(k,77) + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) & + + rxt(k,82) + het_rates(k,69) ) + mat(k,2069) = rxt(k,2) + mat(k,1809) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,83) + rxt(k,85) + rxt(k,87) & + 2.000_r8*rxt(k,88) + 2.000_r8*rxt(k,89) + rxt(k,90) + rxt(k,91) & + rxt(k,92) - mat(k,1207) = rxt(k,8) - mat(k,304) = rxt(k,15) - mat(k,1516) = rxt(k,17) - mat(k,1000) = rxt(k,18) - mat(k,1122) = rxt(k,19) - mat(k,595) = rxt(k,28) - mat(k,1753) = rxt(k,46) - mat(k,67) = rxt(k,60) - mat(k,1667) = rxt(k,99) + rxt(k,358) - mat(k,387) = rxt(k,102) - mat(k,259) = rxt(k,103) - mat(k,48) = rxt(k,104) - mat(k,649) = rxt(k,391) - mat(k,133) = rxt(k,600) - mat(k,126) = rxt(k,605) - mat(k,1252) = -( rxt(k,5) + rxt(k,6) + rxt(k,83) + rxt(k,84) + rxt(k,85) & - + rxt(k,86) + rxt(k,87) + rxt(k,88) + rxt(k,89) + rxt(k,90) & - + rxt(k,91) + rxt(k,92) + het_rates(k,68) ) - mat(k,1203) = rxt(k,8) - mat(k,1118) = rxt(k,20) - mat(k,1326) = rxt(k,93) + rxt(k,137) - mat(k,444) = rxt(k,95) + rxt(k,330)*y(k,30) - mat(k,98) = rxt(k,97) + rxt(k,335)*y(k,30) - mat(k,249) = rxt(k,387) + rxt(k,395) - mat(k,44) = rxt(k,388) - mat(k,645) = rxt(k,443)*y(k,55) - mat(k,1202) = -( rxt(k,7) + rxt(k,8) + het_rates(k,69) ) - mat(k,443) = rxt(k,96) - mat(k,64) = -( rxt(k,60) + het_rates(k,70) ) - mat(k,69) = -( rxt(k,101) + het_rates(k,71) ) - mat(k,13) = -( het_rates(k,72) ) - mat(k,14) = -( het_rates(k,73) ) - mat(k,168) = -( het_rates(k,74) ) - mat(k,71) = rxt(k,101) - mat(k,377) = rxt(k,102) - mat(k,379) = -( rxt(k,102) + het_rates(k,76) ) - mat(k,256) = rxt(k,103) - mat(k,255) = -( rxt(k,103) + het_rates(k,77) ) - mat(k,47) = rxt(k,104) - mat(k,46) = -( rxt(k,104) + het_rates(k,78) ) - mat(k,25) = rxt(k,100) - mat(k,15) = -( het_rates(k,79) ) - mat(k,16) = -( het_rates(k,80) ) - mat(k,17) = -( het_rates(k,81) ) - mat(k,18) = -( het_rates(k,82) ) - mat(k,19) = -( het_rates(k,83) ) - mat(k,20) = -( het_rates(k,84) ) - mat(k,454) = -( het_rates(k,85) ) - mat(k,40) = rxt(k,27) - mat(k,583) = rxt(k,28) - mat(k,140) = rxt(k,30) - mat(k,239) = rxt(k,52) - mat(k,208) = rxt(k,58) - mat(k,633) = rxt(k,476)*y(k,8) + rxt(k,502)*y(k,9) + 3.000_r8*rxt(k,503)*y(k,23) & - + 2.000_r8*rxt(k,504)*y(k,40) + 2.000_r8*rxt(k,525)*y(k,15) & - + rxt(k,526)*y(k,17) - mat(k,1451) = 2.000_r8*rxt(k,513)*y(k,15) + rxt(k,515)*y(k,17) & - + 3.000_r8*rxt(k,520)*y(k,23) - mat(k,788) = 2.000_r8*rxt(k,514)*y(k,15) + rxt(k,516)*y(k,17) & - + 3.000_r8*rxt(k,521)*y(k,23) - mat(k,1476) = -( rxt(k,451)*y(k,22) + rxt(k,513)*y(k,15) + rxt(k,515)*y(k,17) & - + rxt(k,518)*y(k,19) + rxt(k,520)*y(k,23) + het_rates(k,86) ) - mat(k,41) = rxt(k,27) - mat(k,31) = 2.000_r8*rxt(k,44) - mat(k,22) = 2.000_r8*rxt(k,45) - mat(k,1754) = rxt(k,46) - mat(k,284) = rxt(k,47) - mat(k,35) = rxt(k,50) - mat(k,1167) = rxt(k,56) - mat(k,235) = rxt(k,59) - mat(k,650) = 4.000_r8*rxt(k,475)*y(k,7) + rxt(k,476)*y(k,8) & - + 2.000_r8*rxt(k,477)*y(k,10) + 2.000_r8*rxt(k,478)*y(k,11) & - + 2.000_r8*rxt(k,479)*y(k,12) + rxt(k,480)*y(k,13) & - + 2.000_r8*rxt(k,481)*y(k,14) + rxt(k,527)*y(k,44) & - + rxt(k,528)*y(k,45) + rxt(k,529)*y(k,46) - mat(k,807) = 3.000_r8*rxt(k,517)*y(k,18) + rxt(k,519)*y(k,19) & - + rxt(k,522)*y(k,44) + rxt(k,523)*y(k,45) + rxt(k,524)*y(k,46) - mat(k,690) = -( het_rates(k,87) ) - mat(k,410) = rxt(k,385) - mat(k,394) = rxt(k,386) + mat(k,1919) = rxt(k,8) + mat(k,404) = rxt(k,15) + mat(k,1715) = rxt(k,17) + mat(k,1630) = rxt(k,18) + mat(k,1100) = rxt(k,19) + mat(k,422) = .180_r8*rxt(k,25) + mat(k,1961) = rxt(k,26) + rxt(k,62) + mat(k,719) = rxt(k,28) + mat(k,1760) = rxt(k,46) + mat(k,134) = rxt(k,60) + mat(k,1878) = rxt(k,99) + rxt(k,358) + mat(k,492) = rxt(k,102) + mat(k,352) = rxt(k,103) + mat(k,102) = rxt(k,104) + mat(k,790) = rxt(k,391) + mat(k,200) = rxt(k,599) + mat(k,195) = rxt(k,604) + mat(k,784) = -( rxt(k,391) + het_rates(k,70) ) + mat(k,2057) = rxt(k,1) + mat(k,1797) = rxt(k,6) + mat(k,1907) = rxt(k,7) + mat(k,96) = rxt(k,13) end do end subroutine linmat01 subroutine linmat02( avec_len, mat, y, rxt, het_rates ) @@ -248,158 +250,165 @@ subroutine linmat02( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,409) = -( rxt(k,385) + het_rates(k,88) ) - mat(k,393) = -( rxt(k,386) + het_rates(k,89) ) - mat(k,287) = -( het_rates(k,90) ) - mat(k,822) = -( rxt(k,63) + het_rates(k,91) ) - mat(k,542) = rxt(k,64) + rxt(k,283) - mat(k,440) = rxt(k,330)*y(k,30) - mat(k,1653) = rxt(k,352)*y(k,30) - mat(k,362) = -( rxt(k,284) + het_rates(k,92) ) - mat(k,539) = -( rxt(k,64) + rxt(k,283) + het_rates(k,93) ) - mat(k,363) = rxt(k,284) - mat(k,660) = -( rxt(k,65) + het_rates(k,94) ) - mat(k,1311) = rxt(k,316)*y(k,30) - mat(k,97) = rxt(k,335)*y(k,30) - mat(k,1561) = -( het_rates(k,95) ) - mat(k,1519) = rxt(k,16) - mat(k,321) = rxt(k,66) - mat(k,868) = rxt(k,75) - mat(k,729) = rxt(k,76) - mat(k,1436) = rxt(k,77) + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) & + mat(k,1821) = -( rxt(k,5) + rxt(k,6) + rxt(k,83) + rxt(k,84) + rxt(k,85) & + + rxt(k,86) + rxt(k,87) + rxt(k,88) + rxt(k,89) + rxt(k,90) & + + rxt(k,91) + rxt(k,92) + het_rates(k,71) ) + mat(k,1931) = rxt(k,8) + mat(k,1112) = rxt(k,20) + mat(k,1549) = rxt(k,93) + rxt(k,137) + mat(k,601) = rxt(k,95) + mat(k,241) = rxt(k,97) + mat(k,379) = rxt(k,387) + rxt(k,395) + mat(k,130) = rxt(k,388) + mat(k,1934) = -( rxt(k,7) + rxt(k,8) + het_rates(k,72) ) + mat(k,604) = rxt(k,96) + mat(k,131) = -( rxt(k,60) + het_rates(k,73) ) + mat(k,136) = -( rxt(k,101) + het_rates(k,74) ) + mat(k,15) = -( het_rates(k,75) ) + mat(k,16) = -( het_rates(k,76) ) + mat(k,268) = -( het_rates(k,77) ) + mat(k,138) = rxt(k,101) + mat(k,485) = rxt(k,102) + mat(k,17) = -( rxt(k,61) + het_rates(k,78) ) + mat(k,487) = -( rxt(k,102) + het_rates(k,79) ) + mat(k,349) = rxt(k,103) + mat(k,348) = -( rxt(k,103) + het_rates(k,80) ) + mat(k,101) = rxt(k,104) + mat(k,100) = -( rxt(k,104) + het_rates(k,81) ) + mat(k,51) = rxt(k,100) + mat(k,18) = -( het_rates(k,82) ) + mat(k,19) = -( het_rates(k,83) ) + mat(k,20) = -( het_rates(k,84) ) + mat(k,21) = -( het_rates(k,85) ) + mat(k,22) = -( het_rates(k,86) ) + mat(k,23) = -( het_rates(k,87) ) + mat(k,808) = -( het_rates(k,88) ) + mat(k,533) = rxt(k,385) + mat(k,517) = rxt(k,386) + mat(k,532) = -( rxt(k,385) + het_rates(k,89) ) + mat(k,516) = -( rxt(k,386) + het_rates(k,90) ) + mat(k,366) = -( het_rates(k,91) ) + mat(k,1011) = -( rxt(k,63) + het_rates(k,92) ) + mat(k,670) = rxt(k,64) + rxt(k,283) + mat(k,501) = -( rxt(k,284) + het_rates(k,93) ) + mat(k,666) = -( rxt(k,64) + rxt(k,283) + het_rates(k,94) ) + mat(k,502) = rxt(k,284) + mat(k,830) = -( rxt(k,65) + het_rates(k,95) ) + mat(k,1055) = -( het_rates(k,96) ) + mat(k,1710) = rxt(k,16) + mat(k,447) = rxt(k,66) + mat(k,925) = rxt(k,75) + mat(k,865) = rxt(k,76) + mat(k,1287) = rxt(k,77) + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) & + rxt(k,82) - mat(k,1259) = rxt(k,83) + rxt(k,84) + rxt(k,85) + rxt(k,86) + rxt(k,87) & + mat(k,1804) = rxt(k,83) + rxt(k,84) + rxt(k,85) + rxt(k,86) + rxt(k,87) & + rxt(k,90) + rxt(k,91) + rxt(k,92) - mat(k,1333) = rxt(k,93) + rxt(k,137) - mat(k,448) = rxt(k,96) - mat(k,1635) = rxt(k,98) - mat(k,1670) = rxt(k,99) + rxt(k,358) - mat(k,83) = -( het_rates(k,96) ) - mat(k,335) = -( het_rates(k,97) ) - mat(k,1612) = rxt(k,343)*y(k,30) - mat(k,747) = -( rxt(k,559) + het_rates(k,98) ) - mat(k,102) = rxt(k,11) + rxt(k,448) - mat(k,1459) = rxt(k,515)*y(k,17) + rxt(k,518)*y(k,19) - mat(k,793) = rxt(k,516)*y(k,17) + rxt(k,519)*y(k,19) - mat(k,638) = rxt(k,539)*y(k,22) - mat(k,162) = -( rxt(k,373) + het_rates(k,99) ) - mat(k,1011) = rxt(k,375) - mat(k,1033) = -( rxt(k,375) + het_rates(k,100) ) - mat(k,1700) = rxt(k,377) - mat(k,50) = -( het_rates(k,101) ) - mat(k,1716) = -( rxt(k,377) + het_rates(k,102) ) - mat(k,1607) = rxt(k,379) - mat(k,54) = -( het_rates(k,103) ) - mat(k,1604) = -( rxt(k,379) + het_rates(k,104) ) - mat(k,181) = -( het_rates(k,105) ) - mat(k,163) = rxt(k,373) - mat(k,215) = -( het_rates(k,106) ) - mat(k,153) = -( het_rates(k,107) ) - mat(k,129) = rxt(k,600) - mat(k,123) = rxt(k,605) - mat(k,852) = -( rxt(k,75) + het_rates(k,108) ) - mat(k,425) = rxt(k,273) - mat(k,424) = -( rxt(k,273) + het_rates(k,109) ) - mat(k,713) = -( rxt(k,76) + het_rates(k,110) ) - mat(k,504) = rxt(k,275) - mat(k,561) = rxt(k,282) - mat(k,519) = -( rxt(k,274) + het_rates(k,111) ) - mat(k,560) = -( rxt(k,282) + het_rates(k,112) ) - mat(k,520) = rxt(k,274) - mat(k,465) = -( het_rates(k,113) ) - mat(k,503) = -( rxt(k,275) + het_rates(k,114) ) - mat(k,900) = -( rxt(k,370) + rxt(k,368)*y(k,30) + het_rates(k,115) ) - mat(k,1504) = rxt(k,16) - mat(k,116) = rxt(k,369) - mat(k,110) = rxt(k,371) - mat(k,1362) = rxt(k,593) - mat(k,269) = rxt(k,596) - mat(k,943) = -( het_rates(k,116) ) - mat(k,89) = -( het_rates(k,117) ) - mat(k,115) = -( rxt(k,369) + het_rates(k,118) ) - mat(k,109) = rxt(k,312)*y(k,30) - mat(k,877) = rxt(k,368)*y(k,30) - mat(k,1075) = -( het_rates(k,119) ) - mat(k,108) = -( rxt(k,371) + rxt(k,312)*y(k,30) + het_rates(k,120) ) - mat(k,876) = rxt(k,370) - mat(k,223) = -( het_rates(k,121) ) - mat(k,309) = rxt(k,66) - mat(k,124) = rxt(k,606) - mat(k,637) = -( rxt(k,391) + rxt(k,442)*y(k,55) + rxt(k,443)*y(k,55) & - + rxt(k,475)*y(k,7) + rxt(k,476)*y(k,8) + rxt(k,477)*y(k,10) & - + rxt(k,478)*y(k,11) + rxt(k,479)*y(k,12) + rxt(k,480)*y(k,13) & - + rxt(k,481)*y(k,14) + rxt(k,502)*y(k,9) + rxt(k,503)*y(k,23) & - + rxt(k,504)*y(k,40) + rxt(k,525)*y(k,15) + rxt(k,526)*y(k,17) & - + rxt(k,527)*y(k,44) + rxt(k,528)*y(k,45) + rxt(k,529)*y(k,46) & - + rxt(k,538)*y(k,22) + rxt(k,539)*y(k,22) + rxt(k,540)*y(k,22) & - + het_rates(k,122) ) - mat(k,1827) = rxt(k,1) - mat(k,1236) = rxt(k,6) - mat(k,1187) = rxt(k,7) - mat(k,246) = -( rxt(k,387) + rxt(k,395) + het_rates(k,123) ) - mat(k,1179) = rxt(k,7) - mat(k,43) = rxt(k,399) + rxt(k,398)*y(k,30) - mat(k,42) = -( rxt(k,388) + rxt(k,399) + rxt(k,398)*y(k,30) + het_rates(k,124) ) - mat(k,1328) = -( rxt(k,93) + rxt(k,137) + rxt(k,316)*y(k,30) + het_rates(k,125) & - ) - mat(k,675) = rxt(k,65) - mat(k,99) = rxt(k,97) - mat(k,1373) = -( rxt(k,593) + het_rates(k,126) ) - mat(k,1255) = rxt(k,84) + rxt(k,86) - mat(k,193) = rxt(k,94) - mat(k,271) = rxt(k,595)*y(k,30) - mat(k,189) = -( rxt(k,94) + het_rates(k,127) ) - mat(k,438) = -( rxt(k,95) + rxt(k,96) + rxt(k,330)*y(k,30) + het_rates(k,128) ) - mat(k,95) = -( rxt(k,97) + rxt(k,335)*y(k,30) + het_rates(k,129) ) - mat(k,350) = -( het_rates(k,130) ) - mat(k,794) = -( rxt(k,514)*y(k,15) + rxt(k,516)*y(k,17) + rxt(k,517)*y(k,18) & - + rxt(k,519)*y(k,19) + rxt(k,521)*y(k,23) + rxt(k,522)*y(k,44) & - + rxt(k,523)*y(k,45) + rxt(k,524)*y(k,46) + rxt(k,536)*y(k,22) & - + het_rates(k,131) ) - mat(k,1831) = rxt(k,3) - mat(k,148) = 2.000_r8*rxt(k,4) - mat(k,1280) = rxt(k,9) - mat(k,103) = rxt(k,10) - mat(k,176) = rxt(k,12) - mat(k,80) = rxt(k,23) - mat(k,210) = rxt(k,58) - mat(k,232) = rxt(k,59) - mat(k,1617) = rxt(k,98) - mat(k,985) = .500_r8*rxt(k,561) - mat(k,639) = rxt(k,538)*y(k,22) - mat(k,1637) = -( rxt(k,98) + rxt(k,343)*y(k,30) + het_rates(k,132) ) - mat(k,1673) = -( rxt(k,99) + rxt(k,358) + rxt(k,352)*y(k,30) + het_rates(k,133) & - ) - mat(k,842) = rxt(k,63) - mat(k,450) = rxt(k,95) - mat(k,264) = -( rxt(k,596) + rxt(k,595)*y(k,30) + het_rates(k,134) ) - mat(k,1402) = rxt(k,77) + rxt(k,81) - mat(k,1228) = rxt(k,85) + rxt(k,87) - mat(k,125) = rxt(k,580) - mat(k,130) = rxt(k,581) - mat(k,128) = -( rxt(k,581) + rxt(k,600) + het_rates(k,135) ) - mat(k,1389) = rxt(k,78) + rxt(k,82) - mat(k,1221) = rxt(k,83) + rxt(k,92) - mat(k,122) = rxt(k,582) - mat(k,121) = -( rxt(k,580) + rxt(k,582) + rxt(k,605) + rxt(k,606) & + mat(k,1532) = rxt(k,93) + rxt(k,137) + mat(k,595) = rxt(k,96) + mat(k,1837) = rxt(k,98) + mat(k,1873) = rxt(k,99) + rxt(k,358) + mat(k,164) = -( het_rates(k,97) ) + mat(k,470) = -( het_rates(k,98) ) + mat(k,897) = -( rxt(k,558) + het_rates(k,99) ) + mat(k,184) = rxt(k,11) + rxt(k,448) + mat(k,243) = -( rxt(k,373) + het_rates(k,100) ) + mat(k,1432) = rxt(k,375) + mat(k,1460) = -( rxt(k,375) + het_rates(k,101) ) + mat(k,1677) = rxt(k,377) + mat(k,104) = -( het_rates(k,102) ) + mat(k,1682) = -( rxt(k,377) + het_rates(k,103) ) + mat(k,1422) = rxt(k,379) + mat(k,108) = -( het_rates(k,104) ) + mat(k,1416) = -( rxt(k,379) + het_rates(k,105) ) + mat(k,281) = -( het_rates(k,106) ) + mat(k,244) = rxt(k,373) + mat(k,297) = -( het_rates(k,107) ) + mat(k,227) = -( het_rates(k,108) ) + mat(k,198) = rxt(k,599) + mat(k,192) = rxt(k,604) + mat(k,923) = -( rxt(k,75) + het_rates(k,109) ) + mat(k,548) = rxt(k,273) + mat(k,547) = -( rxt(k,273) + het_rates(k,110) ) + mat(k,863) = -( rxt(k,76) + het_rates(k,111) ) + mat(k,607) = rxt(k,275) + mat(k,689) = rxt(k,282) + mat(k,622) = -( rxt(k,274) + het_rates(k,112) ) + mat(k,688) = -( rxt(k,282) + het_rates(k,113) ) + mat(k,623) = rxt(k,274) + mat(k,561) = -( het_rates(k,114) ) + mat(k,606) = -( rxt(k,275) + het_rates(k,115) ) + mat(k,1145) = -( rxt(k,370) + het_rates(k,116) ) + mat(k,1712) = rxt(k,16) + mat(k,263) = rxt(k,369) + mat(k,256) = rxt(k,371) + mat(k,1579) = rxt(k,592) + mat(k,390) = rxt(k,595) + mat(k,1189) = -( het_rates(k,117) ) + mat(k,170) = -( het_rates(k,118) ) + mat(k,261) = -( rxt(k,369) + het_rates(k,119) ) + mat(k,1335) = -( het_rates(k,120) ) + mat(k,253) = -( rxt(k,371) + het_rates(k,121) ) + mat(k,1119) = rxt(k,370) + mat(k,314) = -( het_rates(k,122) ) + mat(k,441) = rxt(k,66) + mat(k,193) = rxt(k,605) + mat(k,374) = -( rxt(k,387) + rxt(k,395) + het_rates(k,123) ) + mat(k,1900) = rxt(k,7) + mat(k,129) = rxt(k,399) + mat(k,128) = -( rxt(k,388) + rxt(k,399) + het_rates(k,124) ) + mat(k,1543) = -( rxt(k,93) + rxt(k,137) + het_rates(k,125) ) + mat(k,846) = rxt(k,65) + mat(k,240) = rxt(k,97) + mat(k,1589) = -( rxt(k,592) + het_rates(k,126) ) + mat(k,1816) = rxt(k,84) + rxt(k,86) + mat(k,294) = rxt(k,94) + mat(k,289) = -( rxt(k,94) + het_rates(k,127) ) + mat(k,591) = -( rxt(k,95) + rxt(k,96) + het_rates(k,128) ) + mat(k,236) = -( rxt(k,97) + het_rates(k,129) ) + mat(k,458) = -( het_rates(k,130) ) + mat(k,981) = -( het_rates(k,131) ) + mat(k,2062) = rxt(k,3) + mat(k,213) = 2.000_r8*rxt(k,4) + mat(k,1225) = rxt(k,9) + mat(k,185) = rxt(k,10) + mat(k,276) = rxt(k,12) + mat(k,161) = rxt(k,23) + mat(k,419) = .330_r8*rxt(k,25) + mat(k,309) = rxt(k,58) + mat(k,323) = rxt(k,59) + mat(k,1835) = rxt(k,98) + mat(k,1623) = .500_r8*rxt(k,560) + mat(k,1855) = -( rxt(k,98) + het_rates(k,132) ) + mat(k,1892) = -( rxt(k,99) + rxt(k,358) + het_rates(k,133) ) + mat(k,1031) = rxt(k,63) + mat(k,603) = rxt(k,95) + mat(k,385) = -( rxt(k,595) + het_rates(k,134) ) + mat(k,1270) = rxt(k,77) + rxt(k,81) + mat(k,1789) = rxt(k,85) + rxt(k,87) + mat(k,194) = rxt(k,579) + mat(k,199) = rxt(k,580) + mat(k,197) = -( rxt(k,580) + rxt(k,599) + het_rates(k,135) ) + mat(k,1254) = rxt(k,78) + rxt(k,82) + mat(k,1781) = rxt(k,83) + rxt(k,92) + mat(k,191) = rxt(k,581) + mat(k,190) = -( rxt(k,579) + rxt(k,581) + rxt(k,604) + rxt(k,605) & + het_rates(k,136) ) - mat(k,1388) = rxt(k,79) + rxt(k,80) - mat(k,1220) = rxt(k,90) + rxt(k,91) - mat(k,1856) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,137) ) - mat(k,556) = rxt(k,64) + rxt(k,283) - mat(k,196) = rxt(k,94) - mat(k,26) = rxt(k,100) - mat(k,437) = rxt(k,273) - mat(k,536) = rxt(k,274) - mat(k,576) = rxt(k,282) - mat(k,375) = rxt(k,284) - mat(k,167) = rxt(k,373) - mat(k,1052) = rxt(k,375) - mat(k,1719) = rxt(k,377) - mat(k,1610) = rxt(k,379) - mat(k,423) = rxt(k,385) - mat(k,814) = rxt(k,514)*y(k,15) + rxt(k,516)*y(k,17) + rxt(k,517)*y(k,18) & - + rxt(k,519)*y(k,19) + rxt(k,524)*y(k,46) + rxt(k,536)*y(k,22) + mat(k,1253) = rxt(k,79) + rxt(k,80) + mat(k,1780) = rxt(k,90) + rxt(k,91) + mat(k,2087) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,137) ) + mat(k,427) = .050_r8*rxt(k,25) + mat(k,684) = rxt(k,64) + rxt(k,283) + mat(k,296) = rxt(k,94) + mat(k,52) = rxt(k,100) + mat(k,560) = rxt(k,273) + mat(k,639) = rxt(k,274) + mat(k,704) = rxt(k,282) + mat(k,515) = rxt(k,284) + mat(k,248) = rxt(k,373) + mat(k,1474) = rxt(k,375) + mat(k,1691) = rxt(k,377) + mat(k,1431) = rxt(k,379) + mat(k,546) = rxt(k,385) end do end subroutine linmat02 subroutine linmat( avec_len, mat, y, rxt, het_rates ) diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_lu_factor.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_lu_factor.F90 index 054b0dbf34..1ac3f3cfb6 100644 --- a/src/chemistry/pp_waccm_mad_mam4/mo_lu_factor.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/mo_lu_factor.F90 @@ -38,87 +38,60 @@ subroutine lu_fac01( avec_len, lu ) 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) = lu(k,22) * lu(k,21) - lu(k,23) = lu(k,23) * lu(k,21) - lu(k,1754) = lu(k,1754) - lu(k,22) * lu(k,1720) - lu(k,1761) = lu(k,1761) - lu(k,23) * lu(k,1720) + 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) = lu(k,25) * lu(k,24) lu(k,26) = lu(k,26) * lu(k,24) - lu(k,46) = lu(k,46) - lu(k,25) * lu(k,45) - lu(k,49) = lu(k,49) - lu(k,26) * lu(k,45) - lu(k,1801) = lu(k,1801) - lu(k,25) * lu(k,1799) - lu(k,1856) = lu(k,1856) - lu(k,26) * lu(k,1799) + lu(k,1771) = lu(k,1771) - lu(k,25) * lu(k,1734) + lu(k,1777) = lu(k,1777) - lu(k,26) * lu(k,1734) lu(k,27) = 1._r8 / lu(k,27) lu(k,28) = lu(k,28) * lu(k,27) lu(k,29) = lu(k,29) * lu(k,27) - lu(k,628) = lu(k,628) - lu(k,28) * lu(k,625) - lu(k,637) = lu(k,637) - lu(k,29) * lu(k,625) - lu(k,780) = - lu(k,28) * lu(k,768) - lu(k,792) = - lu(k,29) * lu(k,768) + lu(k,784) = lu(k,784) - lu(k,28) * lu(k,755) + lu(k,804) = lu(k,804) - lu(k,29) * lu(k,755) lu(k,30) = 1._r8 / lu(k,30) lu(k,31) = lu(k,31) * lu(k,30) - lu(k,235) = lu(k,235) - lu(k,31) * lu(k,230) - lu(k,284) = lu(k,284) - lu(k,31) * lu(k,275) - lu(k,1167) = lu(k,1167) - lu(k,31) * lu(k,1133) - lu(k,1476) = lu(k,1476) - lu(k,31) * lu(k,1444) - lu(k,1754) = lu(k,1754) - lu(k,31) * lu(k,1721) - lu(k,32) = 1._r8 / lu(k,32) - lu(k,33) = lu(k,33) * lu(k,32) - lu(k,34) = lu(k,34) * lu(k,32) - lu(k,35) = lu(k,35) * lu(k,32) - lu(k,628) = lu(k,628) - lu(k,33) * lu(k,626) - lu(k,637) = lu(k,637) - lu(k,34) * lu(k,626) - lu(k,650) = lu(k,650) - lu(k,35) * lu(k,626) - lu(k,780) = lu(k,780) - lu(k,33) * lu(k,769) - lu(k,792) = lu(k,792) - lu(k,34) * lu(k,769) - lu(k,807) = lu(k,807) - lu(k,35) * lu(k,769) - 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,198) = lu(k,198) - lu(k,37) * lu(k,197) - lu(k,204) = lu(k,204) - lu(k,38) * lu(k,197) - lu(k,482) = lu(k,482) - lu(k,37) * lu(k,481) - lu(k,501) = lu(k,501) - lu(k,38) * lu(k,481) - lu(k,1269) = lu(k,1269) - lu(k,37) * lu(k,1267) - lu(k,1304) = - lu(k,38) * lu(k,1267) - lu(k,1812) = lu(k,1812) - lu(k,37) * lu(k,1800) - lu(k,1855) = lu(k,1855) - lu(k,38) * lu(k,1800) - 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,208) = lu(k,208) - lu(k,40) * lu(k,206) - lu(k,213) = - lu(k,41) * lu(k,206) - lu(k,583) = lu(k,583) - lu(k,40) * lu(k,577) - lu(k,596) = lu(k,596) - lu(k,41) * lu(k,577) - lu(k,1141) = - lu(k,40) * lu(k,1134) - lu(k,1167) = lu(k,1167) - lu(k,41) * lu(k,1134) - lu(k,1730) = lu(k,1730) - lu(k,40) * lu(k,1722) - lu(k,1754) = lu(k,1754) - lu(k,41) * lu(k,1722) + lu(k,32) = lu(k,32) * lu(k,30) + lu(k,33) = lu(k,33) * lu(k,30) + lu(k,767) = lu(k,767) - lu(k,31) * lu(k,756) + lu(k,780) = lu(k,780) - lu(k,32) * lu(k,756) + lu(k,784) = lu(k,784) - lu(k,33) * lu(k,756) + lu(k,34) = 1._r8 / lu(k,34) + lu(k,35) = lu(k,35) * lu(k,34) + lu(k,36) = lu(k,36) * lu(k,34) + lu(k,37) = lu(k,37) * lu(k,34) + lu(k,765) = lu(k,765) - lu(k,35) * lu(k,757) + lu(k,784) = lu(k,784) - lu(k,36) * lu(k,757) + lu(k,804) = lu(k,804) - lu(k,37) * lu(k,757) + lu(k,38) = 1._r8 / lu(k,38) + lu(k,39) = lu(k,39) * lu(k,38) + lu(k,40) = lu(k,40) * lu(k,38) + lu(k,41) = lu(k,41) * lu(k,38) + lu(k,767) = lu(k,767) - lu(k,39) * lu(k,758) + lu(k,784) = lu(k,784) - lu(k,40) * lu(k,758) + lu(k,804) = lu(k,804) - lu(k,41) * lu(k,758) 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,630) = - lu(k,43) * lu(k,627) - lu(k,645) = lu(k,645) - lu(k,44) * lu(k,627) - lu(k,1179) = lu(k,1179) - lu(k,43) * lu(k,1177) - lu(k,1203) = lu(k,1203) - lu(k,44) * lu(k,1177) - lu(k,1226) = lu(k,1226) - lu(k,43) * lu(k,1218) - lu(k,1252) = lu(k,1252) - lu(k,44) * lu(k,1218) - lu(k,1400) = lu(k,1400) - lu(k,43) * lu(k,1385) - lu(k,1429) = lu(k,1429) - lu(k,44) * lu(k,1385) + lu(k,45) = lu(k,45) * lu(k,42) + lu(k,767) = lu(k,767) - lu(k,43) * lu(k,759) + lu(k,784) = lu(k,784) - lu(k,44) * lu(k,759) + lu(k,804) = lu(k,804) - lu(k,45) * lu(k,759) lu(k,46) = 1._r8 / lu(k,46) lu(k,47) = lu(k,47) * lu(k,46) lu(k,48) = lu(k,48) * lu(k,46) lu(k,49) = lu(k,49) * lu(k,46) - lu(k,255) = lu(k,255) - lu(k,47) * lu(k,254) - lu(k,259) = lu(k,259) - lu(k,48) * lu(k,254) - lu(k,260) = - lu(k,49) * lu(k,254) - lu(k,783) = lu(k,783) - lu(k,47) * lu(k,770) - lu(k,806) = lu(k,806) - lu(k,48) * lu(k,770) - lu(k,814) = lu(k,814) - lu(k,49) * lu(k,770) - lu(k,1813) = - lu(k,47) * lu(k,1801) - lu(k,1846) = lu(k,1846) - lu(k,48) * lu(k,1801) - lu(k,1856) = lu(k,1856) - lu(k,49) * lu(k,1801) + lu(k,981) = lu(k,981) - lu(k,47) * lu(k,946) + lu(k,1001) = lu(k,1001) - lu(k,48) * lu(k,946) + lu(k,1002) = lu(k,1002) - lu(k,49) * lu(k,946) + lu(k,50) = 1._r8 / lu(k,50) + lu(k,51) = lu(k,51) * lu(k,50) + lu(k,52) = lu(k,52) * lu(k,50) + lu(k,100) = lu(k,100) - lu(k,51) * lu(k,99) + lu(k,103) = lu(k,103) - lu(k,52) * lu(k,99) + lu(k,2029) = lu(k,2029) - lu(k,51) * lu(k,2028) + lu(k,2087) = lu(k,2087) - lu(k,52) * lu(k,2028) end do end subroutine lu_fac01 subroutine lu_fac02( avec_len, lu ) @@ -135,150 +108,118 @@ subroutine lu_fac02( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,50) = 1._r8 / lu(k,50) - lu(k,51) = lu(k,51) * lu(k,50) - lu(k,52) = lu(k,52) * lu(k,50) - lu(k,53) = lu(k,53) * lu(k,50) - lu(k,303) = lu(k,303) - lu(k,51) * lu(k,295) - lu(k,307) = lu(k,307) - lu(k,52) * lu(k,295) - lu(k,308) = lu(k,308) - lu(k,53) * lu(k,295) - lu(k,1706) = lu(k,1706) - lu(k,51) * lu(k,1678) - lu(k,1716) = lu(k,1716) - lu(k,52) * lu(k,1678) - lu(k,1719) = lu(k,1719) - lu(k,53) * lu(k,1678) - lu(k,1843) = lu(k,1843) - lu(k,51) * lu(k,1802) - lu(k,1853) = lu(k,1853) - lu(k,52) * lu(k,1802) - lu(k,1856) = lu(k,1856) - lu(k,53) * lu(k,1802) - 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,57) = lu(k,57) * lu(k,54) - lu(k,303) = lu(k,303) - lu(k,55) * lu(k,296) - lu(k,306) = lu(k,306) - lu(k,56) * lu(k,296) - lu(k,308) = lu(k,308) - lu(k,57) * lu(k,296) - lu(k,1597) = lu(k,1597) - lu(k,55) * lu(k,1569) - lu(k,1604) = lu(k,1604) - lu(k,56) * lu(k,1569) - lu(k,1610) = lu(k,1610) - lu(k,57) * lu(k,1569) - lu(k,1843) = lu(k,1843) - lu(k,55) * lu(k,1803) - lu(k,1850) = lu(k,1850) - lu(k,56) * lu(k,1803) - lu(k,1856) = lu(k,1856) - lu(k,57) * lu(k,1803) + lu(k,53) = 1._r8 / lu(k,53) + lu(k,54) = lu(k,54) * lu(k,53) + lu(k,55) = lu(k,55) * lu(k,53) + lu(k,56) = lu(k,56) * lu(k,53) + lu(k,57) = lu(k,57) * lu(k,53) + lu(k,767) = lu(k,767) - lu(k,54) * lu(k,760) + lu(k,780) = lu(k,780) - lu(k,55) * lu(k,760) + lu(k,784) = lu(k,784) - lu(k,56) * lu(k,760) + lu(k,804) = lu(k,804) - lu(k,57) * lu(k,760) lu(k,58) = 1._r8 / lu(k,58) lu(k,59) = lu(k,59) * lu(k,58) lu(k,60) = lu(k,60) * lu(k,58) lu(k,61) = lu(k,61) * lu(k,58) lu(k,62) = lu(k,62) * lu(k,58) - lu(k,63) = lu(k,63) * lu(k,58) - lu(k,783) = lu(k,783) - lu(k,59) * lu(k,771) - lu(k,793) = lu(k,793) - lu(k,60) * lu(k,771) - lu(k,794) = lu(k,794) - lu(k,61) * lu(k,771) - lu(k,799) = lu(k,799) - lu(k,62) * lu(k,771) - lu(k,803) = lu(k,803) - lu(k,63) * lu(k,771) - lu(k,1096) = lu(k,1096) - lu(k,59) * lu(k,1094) - lu(k,1107) = lu(k,1107) - lu(k,60) * lu(k,1094) - lu(k,1108) = lu(k,1108) - lu(k,61) * lu(k,1094) - lu(k,1115) = lu(k,1115) - lu(k,62) * lu(k,1094) - lu(k,1119) = lu(k,1119) - lu(k,63) * lu(k,1094) - lu(k,64) = 1._r8 / lu(k,64) - lu(k,65) = lu(k,65) * lu(k,64) - lu(k,66) = lu(k,66) * lu(k,64) - lu(k,67) = lu(k,67) * lu(k,64) - lu(k,68) = lu(k,68) * lu(k,64) - lu(k,378) = lu(k,378) - lu(k,65) * lu(k,376) - lu(k,379) = lu(k,379) - lu(k,66) * lu(k,376) - lu(k,387) = lu(k,387) - lu(k,67) * lu(k,376) - lu(k,390) = lu(k,390) - lu(k,68) * lu(k,376) - lu(k,581) = lu(k,581) - lu(k,65) * lu(k,578) - lu(k,582) = lu(k,582) - lu(k,66) * lu(k,578) - lu(k,595) = lu(k,595) - lu(k,67) * lu(k,578) - lu(k,598) = lu(k,598) - lu(k,68) * lu(k,578) - lu(k,1725) = lu(k,1725) - lu(k,65) * lu(k,1723) - lu(k,1729) = lu(k,1729) - lu(k,66) * lu(k,1723) - lu(k,1753) = lu(k,1753) - lu(k,67) * lu(k,1723) - lu(k,1761) = lu(k,1761) - lu(k,68) * lu(k,1723) - 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,73) = lu(k,73) * lu(k,69) - lu(k,74) = lu(k,74) * lu(k,69) - lu(k,75) = lu(k,75) * lu(k,69) - lu(k,76) = lu(k,76) * lu(k,69) - lu(k,775) = lu(k,775) - lu(k,70) * lu(k,772) - lu(k,777) = lu(k,777) - lu(k,71) * lu(k,772) - lu(k,783) = lu(k,783) - lu(k,72) * lu(k,772) - lu(k,787) = lu(k,787) - lu(k,73) * lu(k,772) - lu(k,794) = lu(k,794) - lu(k,74) * lu(k,772) - lu(k,806) = lu(k,806) - lu(k,75) * lu(k,772) - lu(k,813) = lu(k,813) - lu(k,76) * lu(k,772) - lu(k,1390) = lu(k,1390) - lu(k,70) * lu(k,1386) - lu(k,1394) = - lu(k,71) * lu(k,1386) - lu(k,1401) = - lu(k,72) * lu(k,1386) - lu(k,1407) = lu(k,1407) - lu(k,73) * lu(k,1386) - lu(k,1418) = lu(k,1418) - lu(k,74) * lu(k,1386) - lu(k,1433) = lu(k,1433) - lu(k,75) * lu(k,1386) - lu(k,1442) = lu(k,1442) - lu(k,76) * lu(k,1386) - 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,81) = lu(k,81) * lu(k,77) - lu(k,82) = lu(k,82) * lu(k,77) - lu(k,324) = lu(k,324) - lu(k,78) * lu(k,323) - lu(k,325) = lu(k,325) - lu(k,79) * lu(k,323) - lu(k,327) = - lu(k,80) * lu(k,323) - lu(k,333) = - lu(k,81) * lu(k,323) - lu(k,334) = - lu(k,82) * lu(k,323) - lu(k,741) = lu(k,741) - lu(k,78) * lu(k,734) - lu(k,745) = - lu(k,79) * lu(k,734) - lu(k,748) = lu(k,748) - lu(k,80) * lu(k,734) - lu(k,766) = lu(k,766) - lu(k,81) * lu(k,734) - lu(k,767) = lu(k,767) - lu(k,82) * lu(k,734) - lu(k,786) = lu(k,786) - lu(k,78) * lu(k,773) - lu(k,791) = lu(k,791) - lu(k,79) * lu(k,773) - lu(k,794) = lu(k,794) - lu(k,80) * lu(k,773) - lu(k,813) = lu(k,813) - lu(k,81) * lu(k,773) - lu(k,814) = lu(k,814) - lu(k,82) * lu(k,773) - lu(k,83) = 1._r8 / lu(k,83) - lu(k,84) = lu(k,84) * lu(k,83) - lu(k,85) = lu(k,85) * lu(k,83) - lu(k,86) = lu(k,86) * lu(k,83) - lu(k,87) = lu(k,87) * lu(k,83) - lu(k,88) = lu(k,88) * lu(k,83) - lu(k,187) = - lu(k,84) * lu(k,186) - lu(k,190) = lu(k,190) - lu(k,85) * lu(k,186) - lu(k,194) = lu(k,194) - lu(k,86) * lu(k,186) - lu(k,195) = - lu(k,87) * lu(k,186) - lu(k,196) = lu(k,196) - lu(k,88) * lu(k,186) - lu(k,1534) = lu(k,1534) - lu(k,84) * lu(k,1527) - lu(k,1545) = lu(k,1545) - lu(k,85) * lu(k,1527) - lu(k,1561) = lu(k,1561) - lu(k,86) * lu(k,1527) - lu(k,1567) = lu(k,1567) - lu(k,87) * lu(k,1527) - lu(k,1568) = lu(k,1568) - lu(k,88) * lu(k,1527) - lu(k,1808) = lu(k,1808) - lu(k,84) * lu(k,1804) - lu(k,1831) = lu(k,1831) - lu(k,85) * lu(k,1804) - lu(k,1849) = - lu(k,86) * lu(k,1804) - lu(k,1855) = lu(k,1855) - lu(k,87) * lu(k,1804) - lu(k,1856) = lu(k,1856) - lu(k,88) * lu(k,1804) + lu(k,767) = lu(k,767) - lu(k,59) * lu(k,761) + lu(k,775) = lu(k,775) - lu(k,60) * lu(k,761) + lu(k,780) = lu(k,780) - lu(k,61) * lu(k,761) + lu(k,784) = lu(k,784) - lu(k,62) * lu(k,761) + 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,66) = lu(k,66) * lu(k,63) + lu(k,67) = lu(k,67) * lu(k,63) + lu(k,765) = lu(k,765) - lu(k,64) * lu(k,762) + lu(k,767) = lu(k,767) - lu(k,65) * lu(k,762) + lu(k,784) = lu(k,784) - lu(k,66) * lu(k,762) + lu(k,804) = lu(k,804) - lu(k,67) * lu(k,762) + lu(k,68) = 1._r8 / lu(k,68) + lu(k,69) = lu(k,69) * lu(k,68) + lu(k,70) = lu(k,70) * lu(k,68) + lu(k,71) = lu(k,71) * lu(k,68) + lu(k,72) = lu(k,72) * lu(k,68) + lu(k,767) = lu(k,767) - lu(k,69) * lu(k,763) + lu(k,775) = lu(k,775) - lu(k,70) * lu(k,763) + lu(k,784) = lu(k,784) - lu(k,71) * lu(k,763) + lu(k,804) = lu(k,804) - lu(k,72) * lu(k,763) + lu(k,73) = 1._r8 / lu(k,73) + lu(k,74) = lu(k,74) * lu(k,73) + lu(k,327) = lu(k,327) - lu(k,74) * lu(k,321) + lu(k,364) = lu(k,364) - lu(k,74) * lu(k,354) + lu(k,1518) = lu(k,1518) - lu(k,74) * lu(k,1475) + lu(k,1777) = lu(k,1777) - lu(k,74) * lu(k,1735) + lu(k,2026) = lu(k,2026) - lu(k,74) * lu(k,1980) + lu(k,75) = 1._r8 / lu(k,75) + lu(k,76) = lu(k,76) * lu(k,75) + lu(k,77) = lu(k,77) * lu(k,75) + lu(k,78) = lu(k,78) * lu(k,75) + lu(k,79) = lu(k,79) * lu(k,75) + lu(k,765) = lu(k,765) - lu(k,76) * lu(k,764) + lu(k,784) = lu(k,784) - lu(k,77) * lu(k,764) + lu(k,786) = lu(k,786) - lu(k,78) * lu(k,764) + lu(k,804) = lu(k,804) - lu(k,79) * lu(k,764) + lu(k,948) = lu(k,948) - lu(k,76) * lu(k,947) + lu(k,979) = - lu(k,77) * lu(k,947) + lu(k,981) = lu(k,981) - lu(k,78) * lu(k,947) + lu(k,1001) = lu(k,1001) - lu(k,79) * lu(k,947) + lu(k,80) = 1._r8 / lu(k,80) + lu(k,81) = lu(k,81) * lu(k,80) + lu(k,82) = lu(k,82) * lu(k,80) + lu(k,83) = lu(k,83) * lu(k,80) + lu(k,775) = lu(k,775) - lu(k,81) * lu(k,765) + lu(k,784) = lu(k,784) - lu(k,82) * lu(k,765) + lu(k,804) = lu(k,804) - lu(k,83) * lu(k,765) + lu(k,968) = - lu(k,81) * lu(k,948) + lu(k,979) = lu(k,979) - lu(k,82) * lu(k,948) + lu(k,1001) = lu(k,1001) - lu(k,83) * lu(k,948) + 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,87) = lu(k,87) * lu(k,84) + lu(k,88) = lu(k,88) * lu(k,84) + lu(k,767) = lu(k,767) - lu(k,85) * lu(k,766) + lu(k,784) = lu(k,784) - lu(k,86) * lu(k,766) + lu(k,786) = lu(k,786) - lu(k,87) * lu(k,766) + lu(k,804) = lu(k,804) - lu(k,88) * lu(k,766) + lu(k,950) = lu(k,950) - lu(k,85) * lu(k,949) + lu(k,979) = lu(k,979) - lu(k,86) * lu(k,949) + lu(k,981) = lu(k,981) - lu(k,87) * lu(k,949) + lu(k,1001) = lu(k,1001) - lu(k,88) * lu(k,949) 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,93) = lu(k,93) * lu(k,89) - lu(k,94) = lu(k,94) * lu(k,89) - lu(k,924) = - lu(k,90) * lu(k,923) - lu(k,945) = - lu(k,91) * lu(k,923) - lu(k,956) = lu(k,956) - lu(k,92) * lu(k,923) - lu(k,957) = lu(k,957) - lu(k,93) * lu(k,923) - lu(k,964) = lu(k,964) - lu(k,94) * lu(k,923) - lu(k,1535) = - lu(k,90) * lu(k,1528) - lu(k,1549) = lu(k,1549) - lu(k,91) * lu(k,1528) - lu(k,1560) = lu(k,1560) - lu(k,92) * lu(k,1528) - lu(k,1561) = lu(k,1561) - lu(k,93) * lu(k,1528) - lu(k,1568) = lu(k,1568) - lu(k,94) * lu(k,1528) - lu(k,1809) = lu(k,1809) - lu(k,90) * lu(k,1805) - lu(k,1837) = lu(k,1837) - lu(k,91) * lu(k,1805) - lu(k,1848) = - lu(k,92) * lu(k,1805) - lu(k,1849) = lu(k,1849) - lu(k,93) * lu(k,1805) - lu(k,1856) = lu(k,1856) - lu(k,94) * lu(k,1805) + lu(k,114) = - lu(k,90) * lu(k,112) + lu(k,115) = lu(k,115) - lu(k,91) * lu(k,112) + lu(k,775) = lu(k,775) - lu(k,90) * lu(k,767) + lu(k,784) = lu(k,784) - lu(k,91) * lu(k,767) + lu(k,968) = lu(k,968) - lu(k,90) * lu(k,950) + lu(k,979) = lu(k,979) - lu(k,91) * lu(k,950) + lu(k,92) = 1._r8 / lu(k,92) + lu(k,93) = lu(k,93) * lu(k,92) + lu(k,94) = lu(k,94) * lu(k,92) + lu(k,307) = lu(k,307) - lu(k,93) * lu(k,305) + lu(k,312) = - lu(k,94) * lu(k,305) + lu(k,711) = lu(k,711) - lu(k,93) * lu(k,705) + lu(k,728) = lu(k,728) - lu(k,94) * lu(k,705) + lu(k,1484) = - lu(k,93) * lu(k,1476) + lu(k,1518) = lu(k,1518) - lu(k,94) * lu(k,1476) + lu(k,1744) = lu(k,1744) - lu(k,93) * lu(k,1736) + lu(k,1777) = lu(k,1777) - lu(k,94) * lu(k,1736) + lu(k,95) = 1._r8 / lu(k,95) + lu(k,96) = lu(k,96) * lu(k,95) + lu(k,97) = lu(k,97) * lu(k,95) + lu(k,98) = lu(k,98) * lu(k,95) + lu(k,444) = - lu(k,96) * lu(k,440) + lu(k,453) = lu(k,453) - lu(k,97) * lu(k,440) + lu(k,454) = lu(k,454) - lu(k,98) * lu(k,440) + lu(k,784) = lu(k,784) - lu(k,96) * lu(k,768) + lu(k,797) = lu(k,797) - lu(k,97) * lu(k,768) + lu(k,799) = lu(k,799) - lu(k,98) * lu(k,768) + lu(k,1618) = - lu(k,96) * lu(k,1601) + lu(k,1640) = lu(k,1640) - lu(k,97) * lu(k,1601) + lu(k,1642) = lu(k,1642) - lu(k,98) * lu(k,1601) end do end subroutine lu_fac02 subroutine lu_fac03( avec_len, lu ) @@ -295,169 +236,164 @@ subroutine lu_fac03( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,95) = 1._r8 / lu(k,95) - lu(k,96) = lu(k,96) * lu(k,95) - lu(k,97) = lu(k,97) * lu(k,95) - lu(k,98) = lu(k,98) * lu(k,95) - lu(k,99) = lu(k,99) * lu(k,95) - lu(k,100) = lu(k,100) * lu(k,95) - lu(k,1232) = lu(k,1232) - lu(k,96) * lu(k,1219) - lu(k,1237) = - lu(k,97) * lu(k,1219) - lu(k,1252) = lu(k,1252) - lu(k,98) * lu(k,1219) - lu(k,1254) = lu(k,1254) - lu(k,99) * lu(k,1219) - lu(k,1256) = lu(k,1256) - lu(k,100) * lu(k,1219) - lu(k,1310) = lu(k,1310) - lu(k,96) * lu(k,1306) - lu(k,1311) = lu(k,1311) - lu(k,97) * lu(k,1306) - lu(k,1326) = lu(k,1326) - lu(k,98) * lu(k,1306) - lu(k,1328) = lu(k,1328) - lu(k,99) * lu(k,1306) - lu(k,1330) = lu(k,1330) - lu(k,100) * lu(k,1306) - lu(k,1408) = lu(k,1408) - lu(k,96) * lu(k,1387) - lu(k,1414) = lu(k,1414) - lu(k,97) * lu(k,1387) - lu(k,1429) = lu(k,1429) - lu(k,98) * lu(k,1387) - lu(k,1431) = lu(k,1431) - lu(k,99) * lu(k,1387) - lu(k,1433) = lu(k,1433) - lu(k,100) * lu(k,1387) - lu(k,101) = 1._r8 / lu(k,101) - lu(k,102) = lu(k,102) * lu(k,101) - lu(k,103) = lu(k,103) * lu(k,101) - lu(k,104) = lu(k,104) * lu(k,101) - lu(k,105) = lu(k,105) * lu(k,101) - lu(k,106) = lu(k,106) * lu(k,101) - lu(k,107) = lu(k,107) * lu(k,101) - lu(k,747) = lu(k,747) - lu(k,102) * lu(k,735) - lu(k,748) = lu(k,748) - lu(k,103) * lu(k,735) - lu(k,749) = lu(k,749) - lu(k,104) * lu(k,735) - lu(k,752) = lu(k,752) - lu(k,105) * lu(k,735) - lu(k,755) = lu(k,755) - lu(k,106) * lu(k,735) - lu(k,767) = lu(k,767) - lu(k,107) * lu(k,735) - lu(k,793) = lu(k,793) - lu(k,102) * lu(k,774) - lu(k,794) = lu(k,794) - lu(k,103) * lu(k,774) - lu(k,796) = lu(k,796) - lu(k,104) * lu(k,774) - lu(k,799) = lu(k,799) - lu(k,105) * lu(k,774) - lu(k,802) = lu(k,802) - lu(k,106) * lu(k,774) - lu(k,814) = lu(k,814) - lu(k,107) * lu(k,774) - lu(k,984) = lu(k,984) - lu(k,102) * lu(k,965) - lu(k,985) = lu(k,985) - lu(k,103) * lu(k,965) - lu(k,990) = lu(k,990) - lu(k,104) * lu(k,965) - lu(k,993) = lu(k,993) - lu(k,105) * lu(k,965) - lu(k,996) = lu(k,996) - lu(k,106) * lu(k,965) - lu(k,1010) = lu(k,1010) - lu(k,107) * lu(k,965) + 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,103) = lu(k,103) * lu(k,100) + lu(k,348) = lu(k,348) - lu(k,101) * lu(k,347) + lu(k,352) = lu(k,352) - lu(k,102) * lu(k,347) + lu(k,353) = - lu(k,103) * lu(k,347) + lu(k,969) = lu(k,969) - lu(k,101) * lu(k,951) + lu(k,986) = lu(k,986) - lu(k,102) * lu(k,951) + lu(k,1002) = lu(k,1002) - lu(k,103) * lu(k,951) + lu(k,2042) = - lu(k,101) * lu(k,2029) + lu(k,2069) = lu(k,2069) - lu(k,102) * lu(k,2029) + lu(k,2087) = lu(k,2087) - lu(k,103) * lu(k,2029) + lu(k,104) = 1._r8 / lu(k,104) + lu(k,105) = lu(k,105) * lu(k,104) + lu(k,106) = lu(k,106) * lu(k,104) + lu(k,107) = lu(k,107) * lu(k,104) + lu(k,403) = lu(k,403) - lu(k,105) * lu(k,396) + lu(k,407) = lu(k,407) - lu(k,106) * lu(k,396) + lu(k,409) = lu(k,409) - lu(k,107) * lu(k,396) + lu(k,1672) = lu(k,1672) - lu(k,105) * lu(k,1649) + lu(k,1682) = lu(k,1682) - lu(k,106) * lu(k,1649) + lu(k,1691) = lu(k,1691) - lu(k,107) * lu(k,1649) + lu(k,2068) = lu(k,2068) - lu(k,105) * lu(k,2030) + lu(k,2078) = lu(k,2078) - lu(k,106) * lu(k,2030) + lu(k,2087) = lu(k,2087) - lu(k,107) * lu(k,2030) 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,111) = lu(k,111) * lu(k,108) - lu(k,112) = lu(k,112) * lu(k,108) - lu(k,113) = lu(k,113) * lu(k,108) - lu(k,114) = lu(k,114) * lu(k,108) - lu(k,877) = lu(k,877) - lu(k,109) * lu(k,876) - lu(k,900) = lu(k,900) - lu(k,110) * lu(k,876) - lu(k,904) = lu(k,904) - lu(k,111) * lu(k,876) - lu(k,914) = lu(k,914) - lu(k,112) * lu(k,876) - lu(k,915) = lu(k,915) - lu(k,113) * lu(k,876) - lu(k,922) = lu(k,922) - lu(k,114) * lu(k,876) - lu(k,1530) = lu(k,1530) - lu(k,109) * lu(k,1529) - lu(k,1546) = lu(k,1546) - lu(k,110) * lu(k,1529) - lu(k,1550) = lu(k,1550) - lu(k,111) * lu(k,1529) - lu(k,1560) = lu(k,1560) - lu(k,112) * lu(k,1529) - lu(k,1561) = lu(k,1561) - lu(k,113) * lu(k,1529) - lu(k,1568) = lu(k,1568) - lu(k,114) * lu(k,1529) - lu(k,1807) = lu(k,1807) - lu(k,109) * lu(k,1806) - lu(k,1834) = lu(k,1834) - lu(k,110) * lu(k,1806) - lu(k,1838) = lu(k,1838) - lu(k,111) * lu(k,1806) - lu(k,1848) = lu(k,1848) - lu(k,112) * lu(k,1806) - lu(k,1849) = lu(k,1849) - lu(k,113) * lu(k,1806) - lu(k,1856) = lu(k,1856) - lu(k,114) * lu(k,1806) - lu(k,115) = 1._r8 / lu(k,115) - lu(k,116) = lu(k,116) * lu(k,115) - lu(k,117) = lu(k,117) * lu(k,115) - lu(k,118) = lu(k,118) * lu(k,115) - lu(k,119) = lu(k,119) * lu(k,115) - lu(k,120) = lu(k,120) * lu(k,115) - lu(k,900) = lu(k,900) - lu(k,116) * lu(k,877) - lu(k,904) = lu(k,904) - lu(k,117) * lu(k,877) - lu(k,914) = lu(k,914) - lu(k,118) * lu(k,877) - lu(k,915) = lu(k,915) - lu(k,119) * lu(k,877) - lu(k,922) = lu(k,922) - lu(k,120) * lu(k,877) - lu(k,1546) = lu(k,1546) - lu(k,116) * lu(k,1530) - lu(k,1550) = lu(k,1550) - lu(k,117) * lu(k,1530) - lu(k,1560) = lu(k,1560) - lu(k,118) * lu(k,1530) - lu(k,1561) = lu(k,1561) - lu(k,119) * lu(k,1530) - lu(k,1568) = lu(k,1568) - lu(k,120) * lu(k,1530) - lu(k,1834) = lu(k,1834) - lu(k,116) * lu(k,1807) - lu(k,1838) = lu(k,1838) - lu(k,117) * lu(k,1807) - lu(k,1848) = lu(k,1848) - lu(k,118) * lu(k,1807) - lu(k,1849) = lu(k,1849) - lu(k,119) * lu(k,1807) - lu(k,1856) = lu(k,1856) - lu(k,120) * lu(k,1807) - lu(k,121) = 1._r8 / lu(k,121) - lu(k,122) = lu(k,122) * lu(k,121) - lu(k,123) = lu(k,123) * lu(k,121) - lu(k,124) = lu(k,124) * lu(k,121) - lu(k,125) = lu(k,125) * lu(k,121) - lu(k,126) = lu(k,126) * lu(k,121) - lu(k,127) = lu(k,127) * lu(k,121) - lu(k,1221) = lu(k,1221) - lu(k,122) * lu(k,1220) - lu(k,1222) = lu(k,1222) - lu(k,123) * lu(k,1220) - lu(k,1225) = lu(k,1225) - lu(k,124) * lu(k,1220) - lu(k,1228) = lu(k,1228) - lu(k,125) * lu(k,1220) - lu(k,1256) = lu(k,1256) - lu(k,126) * lu(k,1220) - lu(k,1258) = lu(k,1258) - lu(k,127) * lu(k,1220) - lu(k,1389) = lu(k,1389) - lu(k,122) * lu(k,1388) - lu(k,1393) = lu(k,1393) - lu(k,123) * lu(k,1388) - lu(k,1397) = lu(k,1397) - lu(k,124) * lu(k,1388) - lu(k,1402) = lu(k,1402) - lu(k,125) * lu(k,1388) - lu(k,1433) = lu(k,1433) - lu(k,126) * lu(k,1388) - lu(k,1435) = lu(k,1435) - lu(k,127) * lu(k,1388) - lu(k,1532) = lu(k,1532) - lu(k,122) * lu(k,1531) - lu(k,1533) = lu(k,1533) - lu(k,123) * lu(k,1531) - lu(k,1539) = - lu(k,124) * lu(k,1531) - lu(k,1540) = lu(k,1540) - lu(k,125) * lu(k,1531) - lu(k,1558) = lu(k,1558) - lu(k,126) * lu(k,1531) - lu(k,1560) = lu(k,1560) - lu(k,127) * lu(k,1531) + lu(k,403) = lu(k,403) - lu(k,109) * lu(k,397) + lu(k,405) = lu(k,405) - lu(k,110) * lu(k,397) + lu(k,409) = lu(k,409) - lu(k,111) * lu(k,397) + lu(k,1412) = lu(k,1412) - lu(k,109) * lu(k,1389) + lu(k,1416) = lu(k,1416) - lu(k,110) * lu(k,1389) + lu(k,1431) = lu(k,1431) - lu(k,111) * lu(k,1389) + lu(k,2068) = lu(k,2068) - lu(k,109) * lu(k,2031) + lu(k,2072) = lu(k,2072) - lu(k,110) * lu(k,2031) + lu(k,2087) = lu(k,2087) - lu(k,111) * lu(k,2031) + lu(k,113) = 1._r8 / lu(k,113) + lu(k,114) = lu(k,114) * lu(k,113) + lu(k,115) = lu(k,115) * lu(k,113) + lu(k,116) = lu(k,116) * lu(k,113) + lu(k,117) = lu(k,117) * lu(k,113) + lu(k,118) = lu(k,118) * lu(k,113) + lu(k,775) = lu(k,775) - lu(k,114) * lu(k,769) + lu(k,784) = lu(k,784) - lu(k,115) * lu(k,769) + lu(k,786) = lu(k,786) - lu(k,116) * lu(k,769) + lu(k,804) = lu(k,804) - lu(k,117) * lu(k,769) + lu(k,805) = lu(k,805) - lu(k,118) * lu(k,769) + lu(k,968) = lu(k,968) - lu(k,114) * lu(k,952) + lu(k,979) = lu(k,979) - lu(k,115) * lu(k,952) + lu(k,981) = lu(k,981) - lu(k,116) * lu(k,952) + lu(k,1001) = lu(k,1001) - lu(k,117) * lu(k,952) + lu(k,1002) = lu(k,1002) - lu(k,118) * lu(k,952) + lu(k,119) = 1._r8 / lu(k,119) + lu(k,120) = lu(k,120) * lu(k,119) + lu(k,121) = lu(k,121) * lu(k,119) + lu(k,338) = lu(k,338) - lu(k,120) * lu(k,337) + lu(k,345) = lu(k,345) - lu(k,121) * lu(k,337) + lu(k,412) = lu(k,412) - lu(k,120) * lu(k,410) + lu(k,423) = lu(k,423) - lu(k,121) * lu(k,410) + lu(k,641) = lu(k,641) - lu(k,120) * lu(k,640) + lu(k,653) = lu(k,653) - lu(k,121) * lu(k,640) + lu(k,1212) = lu(k,1212) - lu(k,120) * lu(k,1210) + lu(k,1234) = - lu(k,121) * lu(k,1210) + lu(k,2041) = lu(k,2041) - lu(k,120) * lu(k,2032) + lu(k,2071) = lu(k,2071) - lu(k,121) * lu(k,2032) + lu(k,122) = 1._r8 / lu(k,122) + lu(k,123) = lu(k,123) * lu(k,122) + lu(k,124) = lu(k,124) * lu(k,122) + lu(k,125) = lu(k,125) * lu(k,122) + lu(k,126) = lu(k,126) * lu(k,122) + lu(k,127) = lu(k,127) * lu(k,122) + lu(k,969) = lu(k,969) - lu(k,123) * lu(k,953) + lu(k,980) = lu(k,980) - lu(k,124) * lu(k,953) + lu(k,981) = lu(k,981) - lu(k,125) * lu(k,953) + lu(k,983) = lu(k,983) - lu(k,126) * lu(k,953) + lu(k,985) = lu(k,985) - lu(k,127) * lu(k,953) + lu(k,1081) = lu(k,1081) - lu(k,123) * lu(k,1079) + lu(k,1092) = lu(k,1092) - lu(k,124) * lu(k,1079) + lu(k,1094) = lu(k,1094) - lu(k,125) * lu(k,1079) + lu(k,1096) = lu(k,1096) - lu(k,126) * lu(k,1079) + lu(k,1099) = lu(k,1099) - lu(k,127) * lu(k,1079) lu(k,128) = 1._r8 / lu(k,128) lu(k,129) = lu(k,129) * lu(k,128) lu(k,130) = lu(k,130) * lu(k,128) - lu(k,131) = lu(k,131) * lu(k,128) - lu(k,132) = lu(k,132) * lu(k,128) - lu(k,133) = lu(k,133) * lu(k,128) - lu(k,1222) = lu(k,1222) - lu(k,129) * lu(k,1221) - lu(k,1228) = lu(k,1228) - lu(k,130) * lu(k,1221) - lu(k,1252) = lu(k,1252) - lu(k,131) * lu(k,1221) - lu(k,1255) = lu(k,1255) - lu(k,132) * lu(k,1221) - lu(k,1256) = lu(k,1256) - lu(k,133) * lu(k,1221) - lu(k,1393) = lu(k,1393) - lu(k,129) * lu(k,1389) - lu(k,1402) = lu(k,1402) - lu(k,130) * lu(k,1389) - lu(k,1429) = lu(k,1429) - lu(k,131) * lu(k,1389) - lu(k,1432) = lu(k,1432) - lu(k,132) * lu(k,1389) - lu(k,1433) = lu(k,1433) - lu(k,133) * lu(k,1389) - lu(k,1533) = lu(k,1533) - lu(k,129) * lu(k,1532) - lu(k,1540) = lu(k,1540) - lu(k,130) * lu(k,1532) - lu(k,1554) = lu(k,1554) - lu(k,131) * lu(k,1532) - lu(k,1557) = lu(k,1557) - lu(k,132) * lu(k,1532) - lu(k,1558) = lu(k,1558) - lu(k,133) * lu(k,1532) - lu(k,134) = 1._r8 / lu(k,134) - lu(k,135) = lu(k,135) * lu(k,134) - lu(k,136) = lu(k,136) * lu(k,134) - lu(k,137) = lu(k,137) * lu(k,134) - lu(k,267) = - lu(k,135) * lu(k,261) - lu(k,268) = - lu(k,136) * lu(k,261) - lu(k,274) = - lu(k,137) * lu(k,261) - lu(k,458) = lu(k,458) - lu(k,135) * lu(k,452) - lu(k,459) = - lu(k,136) * lu(k,452) - lu(k,463) = - lu(k,137) * lu(k,452) - lu(k,608) = lu(k,608) - lu(k,135) * lu(k,601) - lu(k,609) = lu(k,609) - lu(k,136) * lu(k,601) - lu(k,623) = lu(k,623) - lu(k,137) * lu(k,601) - lu(k,793) = lu(k,793) - lu(k,135) * lu(k,775) - lu(k,794) = lu(k,794) - lu(k,136) * lu(k,775) - lu(k,813) = lu(k,813) - lu(k,137) * lu(k,775) - lu(k,1107) = lu(k,1107) - lu(k,135) * lu(k,1095) - lu(k,1108) = lu(k,1108) - lu(k,136) * lu(k,1095) - lu(k,1131) = - lu(k,137) * lu(k,1095) - lu(k,1417) = lu(k,1417) - lu(k,135) * lu(k,1390) - lu(k,1418) = lu(k,1418) - lu(k,136) * lu(k,1390) - lu(k,1442) = lu(k,1442) - lu(k,137) * lu(k,1390) - lu(k,1459) = lu(k,1459) - lu(k,135) * lu(k,1445) - lu(k,1460) = lu(k,1460) - lu(k,136) * lu(k,1445) - lu(k,1484) = lu(k,1484) - lu(k,137) * lu(k,1445) + lu(k,776) = - lu(k,129) * lu(k,770) + lu(k,799) = lu(k,799) - lu(k,130) * lu(k,770) + lu(k,1269) = lu(k,1269) - lu(k,129) * lu(k,1251) + lu(k,1304) = lu(k,1304) - lu(k,130) * lu(k,1251) + lu(k,1788) = lu(k,1788) - lu(k,129) * lu(k,1779) + lu(k,1821) = lu(k,1821) - lu(k,130) * lu(k,1779) + lu(k,1900) = lu(k,1900) - lu(k,129) * lu(k,1897) + lu(k,1931) = lu(k,1931) - lu(k,130) * lu(k,1897) + lu(k,1943) = lu(k,1943) - lu(k,129) * lu(k,1938) + lu(k,1973) = lu(k,1973) - lu(k,130) * lu(k,1938) + lu(k,131) = 1._r8 / lu(k,131) + lu(k,132) = lu(k,132) * lu(k,131) + lu(k,133) = lu(k,133) * lu(k,131) + lu(k,134) = lu(k,134) * lu(k,131) + lu(k,135) = lu(k,135) * lu(k,131) + lu(k,486) = lu(k,486) - lu(k,132) * lu(k,484) + lu(k,487) = lu(k,487) - lu(k,133) * lu(k,484) + lu(k,492) = lu(k,492) - lu(k,134) * lu(k,484) + lu(k,496) = lu(k,496) - lu(k,135) * lu(k,484) + lu(k,709) = lu(k,709) - lu(k,132) * lu(k,706) + lu(k,710) = lu(k,710) - lu(k,133) * lu(k,706) + lu(k,719) = lu(k,719) - lu(k,134) * lu(k,706) + lu(k,724) = lu(k,724) - lu(k,135) * lu(k,706) + lu(k,1739) = lu(k,1739) - lu(k,132) * lu(k,1737) + lu(k,1743) = lu(k,1743) - lu(k,133) * lu(k,1737) + lu(k,1760) = lu(k,1760) - lu(k,134) * lu(k,1737) + lu(k,1771) = lu(k,1771) - lu(k,135) * lu(k,1737) + 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,142) = lu(k,142) * lu(k,136) + lu(k,143) = lu(k,143) * lu(k,136) + lu(k,962) = lu(k,962) - lu(k,137) * lu(k,954) + lu(k,963) = lu(k,963) - lu(k,138) * lu(k,954) + lu(k,969) = lu(k,969) - lu(k,139) * lu(k,954) + lu(k,974) = lu(k,974) - lu(k,140) * lu(k,954) + lu(k,981) = lu(k,981) - lu(k,141) * lu(k,954) + lu(k,986) = lu(k,986) - lu(k,142) * lu(k,954) + lu(k,988) = lu(k,988) - lu(k,143) * lu(k,954) + lu(k,1259) = lu(k,1259) - lu(k,137) * lu(k,1252) + lu(k,1260) = - lu(k,138) * lu(k,1252) + lu(k,1266) = - lu(k,139) * lu(k,1252) + lu(k,1273) = lu(k,1273) - lu(k,140) * lu(k,1252) + lu(k,1285) = lu(k,1285) - lu(k,141) * lu(k,1252) + lu(k,1292) = lu(k,1292) - lu(k,142) * lu(k,1252) + lu(k,1294) = lu(k,1294) - lu(k,143) * lu(k,1252) + lu(k,144) = 1._r8 / lu(k,144) + lu(k,145) = lu(k,145) * lu(k,144) + lu(k,146) = lu(k,146) * lu(k,144) + lu(k,147) = lu(k,147) * lu(k,144) + lu(k,148) = lu(k,148) * lu(k,144) + lu(k,149) = lu(k,149) * lu(k,144) + lu(k,150) = lu(k,150) * lu(k,144) + lu(k,151) = lu(k,151) * lu(k,144) + lu(k,962) = lu(k,962) - lu(k,145) * lu(k,955) + lu(k,972) = lu(k,972) - lu(k,146) * lu(k,955) + lu(k,980) = lu(k,980) - lu(k,147) * lu(k,955) + lu(k,981) = lu(k,981) - lu(k,148) * lu(k,955) + lu(k,990) = lu(k,990) - lu(k,149) * lu(k,955) + lu(k,1001) = lu(k,1001) - lu(k,150) * lu(k,955) + lu(k,1002) = lu(k,1002) - lu(k,151) * lu(k,955) + lu(k,1986) = lu(k,1986) - lu(k,145) * lu(k,1981) + lu(k,1991) = lu(k,1991) - lu(k,146) * lu(k,1981) + lu(k,2000) = lu(k,2000) - lu(k,147) * lu(k,1981) + lu(k,2002) = lu(k,2002) - lu(k,148) * lu(k,1981) + lu(k,2014) = lu(k,2014) - lu(k,149) * lu(k,1981) + lu(k,2026) = lu(k,2026) - lu(k,150) * lu(k,1981) + lu(k,2027) = - lu(k,151) * lu(k,1981) end do end subroutine lu_fac03 subroutine lu_fac04( avec_len, lu ) @@ -474,204 +410,165 @@ subroutine lu_fac04( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,138) = 1._r8 / lu(k,138) - lu(k,139) = lu(k,139) * lu(k,138) - lu(k,140) = lu(k,140) * lu(k,138) - lu(k,141) = lu(k,141) * lu(k,138) - lu(k,142) = lu(k,142) * lu(k,138) - lu(k,143) = lu(k,143) * lu(k,138) - lu(k,144) = lu(k,144) * lu(k,138) - lu(k,145) = lu(k,145) * lu(k,138) - lu(k,580) = lu(k,580) - lu(k,139) * lu(k,579) - lu(k,583) = lu(k,583) - lu(k,140) * lu(k,579) - lu(k,584) = lu(k,584) - lu(k,141) * lu(k,579) - lu(k,589) = lu(k,589) - lu(k,142) * lu(k,579) - lu(k,590) = - lu(k,143) * lu(k,579) - lu(k,594) = - lu(k,144) * lu(k,579) - lu(k,595) = lu(k,595) - lu(k,145) * lu(k,579) - lu(k,967) = - lu(k,139) * lu(k,966) - lu(k,974) = - lu(k,140) * lu(k,966) - lu(k,979) = lu(k,979) - lu(k,141) * lu(k,966) - lu(k,990) = lu(k,990) - lu(k,142) * lu(k,966) - lu(k,993) = lu(k,993) - lu(k,143) * lu(k,966) - lu(k,997) = lu(k,997) - lu(k,144) * lu(k,966) - lu(k,1000) = lu(k,1000) - lu(k,145) * lu(k,966) - lu(k,1395) = lu(k,1395) - lu(k,139) * lu(k,1391) - lu(k,1409) = lu(k,1409) - lu(k,140) * lu(k,1391) - lu(k,1411) = lu(k,1411) - lu(k,141) * lu(k,1391) - lu(k,1423) = lu(k,1423) - lu(k,142) * lu(k,1391) - lu(k,1426) = lu(k,1426) - lu(k,143) * lu(k,1391) - lu(k,1430) = - lu(k,144) * lu(k,1391) - lu(k,1433) = lu(k,1433) - lu(k,145) * lu(k,1391) - lu(k,146) = 1._r8 / lu(k,146) - lu(k,147) = lu(k,147) * lu(k,146) - lu(k,148) = lu(k,148) * lu(k,146) - lu(k,149) = lu(k,149) * lu(k,146) - lu(k,150) = lu(k,150) * lu(k,146) - lu(k,151) = lu(k,151) * lu(k,146) - lu(k,152) = lu(k,152) * lu(k,146) - lu(k,747) = lu(k,747) - lu(k,147) * lu(k,736) - lu(k,748) = lu(k,748) - lu(k,148) * lu(k,736) - lu(k,753) = lu(k,753) - lu(k,149) * lu(k,736) - lu(k,759) = lu(k,759) - lu(k,150) * lu(k,736) - lu(k,760) = lu(k,760) - lu(k,151) * lu(k,736) - lu(k,767) = lu(k,767) - lu(k,152) * lu(k,736) - lu(k,793) = lu(k,793) - lu(k,147) * lu(k,776) - lu(k,794) = lu(k,794) - lu(k,148) * lu(k,776) - lu(k,800) = lu(k,800) - lu(k,149) * lu(k,776) - lu(k,806) = lu(k,806) - lu(k,150) * lu(k,776) - lu(k,807) = lu(k,807) - lu(k,151) * lu(k,776) - lu(k,814) = lu(k,814) - lu(k,152) * lu(k,776) - lu(k,1417) = lu(k,1417) - lu(k,147) * lu(k,1392) - lu(k,1418) = lu(k,1418) - lu(k,148) * lu(k,1392) - lu(k,1427) = lu(k,1427) - lu(k,149) * lu(k,1392) - lu(k,1433) = lu(k,1433) - lu(k,150) * lu(k,1392) - lu(k,1434) = lu(k,1434) - lu(k,151) * lu(k,1392) - lu(k,1443) = - lu(k,152) * lu(k,1392) - lu(k,1459) = lu(k,1459) - lu(k,147) * lu(k,1446) - lu(k,1460) = lu(k,1460) - lu(k,148) * lu(k,1446) - lu(k,1469) = lu(k,1469) - lu(k,149) * lu(k,1446) - lu(k,1475) = lu(k,1475) - lu(k,150) * lu(k,1446) - lu(k,1476) = lu(k,1476) - lu(k,151) * lu(k,1446) - lu(k,1485) = - lu(k,152) * lu(k,1446) - lu(k,153) = 1._r8 / lu(k,153) - lu(k,154) = lu(k,154) * lu(k,153) - lu(k,155) = lu(k,155) * lu(k,153) - lu(k,156) = lu(k,156) * lu(k,153) - lu(k,157) = lu(k,157) * lu(k,153) - lu(k,158) = lu(k,158) * lu(k,153) - lu(k,159) = lu(k,159) * lu(k,153) - lu(k,160) = lu(k,160) * lu(k,153) - lu(k,161) = lu(k,161) * lu(k,153) - lu(k,1224) = lu(k,1224) - lu(k,154) * lu(k,1222) - lu(k,1228) = lu(k,1228) - lu(k,155) * lu(k,1222) - lu(k,1229) = lu(k,1229) - lu(k,156) * lu(k,1222) - lu(k,1244) = lu(k,1244) - lu(k,157) * lu(k,1222) - lu(k,1252) = lu(k,1252) - lu(k,158) * lu(k,1222) - lu(k,1255) = lu(k,1255) - lu(k,159) * lu(k,1222) - lu(k,1256) = lu(k,1256) - lu(k,160) * lu(k,1222) - lu(k,1259) = lu(k,1259) - lu(k,161) * lu(k,1222) - lu(k,1396) = lu(k,1396) - lu(k,154) * lu(k,1393) - lu(k,1402) = lu(k,1402) - lu(k,155) * lu(k,1393) - lu(k,1405) = lu(k,1405) - lu(k,156) * lu(k,1393) - lu(k,1421) = lu(k,1421) - lu(k,157) * lu(k,1393) - lu(k,1429) = lu(k,1429) - lu(k,158) * lu(k,1393) - lu(k,1432) = lu(k,1432) - lu(k,159) * lu(k,1393) - lu(k,1433) = lu(k,1433) - lu(k,160) * lu(k,1393) - lu(k,1436) = lu(k,1436) - lu(k,161) * lu(k,1393) - lu(k,1538) = lu(k,1538) - lu(k,154) * lu(k,1533) - lu(k,1540) = lu(k,1540) - lu(k,155) * lu(k,1533) - lu(k,1541) = lu(k,1541) - lu(k,156) * lu(k,1533) - lu(k,1546) = lu(k,1546) - lu(k,157) * lu(k,1533) - lu(k,1554) = lu(k,1554) - lu(k,158) * lu(k,1533) - lu(k,1557) = lu(k,1557) - lu(k,159) * lu(k,1533) - lu(k,1558) = lu(k,1558) - lu(k,160) * lu(k,1533) - lu(k,1561) = lu(k,1561) - lu(k,161) * lu(k,1533) - lu(k,162) = 1._r8 / lu(k,162) - lu(k,163) = lu(k,163) * lu(k,162) - lu(k,164) = lu(k,164) * lu(k,162) - lu(k,165) = lu(k,165) * lu(k,162) - lu(k,166) = lu(k,166) * lu(k,162) - lu(k,167) = lu(k,167) * lu(k,162) - lu(k,181) = lu(k,181) - lu(k,163) * lu(k,180) - lu(k,182) = - lu(k,164) * lu(k,180) - lu(k,183) = lu(k,183) - lu(k,165) * lu(k,180) - lu(k,184) = lu(k,184) - lu(k,166) * lu(k,180) - lu(k,185) = lu(k,185) - lu(k,167) * lu(k,180) - lu(k,188) = lu(k,188) - lu(k,163) * lu(k,187) - lu(k,191) = - lu(k,164) * lu(k,187) - lu(k,194) = lu(k,194) - lu(k,165) * lu(k,187) - lu(k,195) = lu(k,195) - lu(k,166) * lu(k,187) - lu(k,196) = lu(k,196) - lu(k,167) * lu(k,187) - lu(k,1012) = - lu(k,163) * lu(k,1011) - lu(k,1033) = lu(k,1033) - lu(k,164) * lu(k,1011) - lu(k,1045) = lu(k,1045) - lu(k,165) * lu(k,1011) - lu(k,1051) = lu(k,1051) - lu(k,166) * lu(k,1011) - lu(k,1052) = lu(k,1052) - lu(k,167) * lu(k,1011) - lu(k,1536) = lu(k,1536) - lu(k,163) * lu(k,1534) - lu(k,1549) = lu(k,1549) - lu(k,164) * lu(k,1534) - lu(k,1561) = lu(k,1561) - lu(k,165) * lu(k,1534) - lu(k,1567) = lu(k,1567) - lu(k,166) * lu(k,1534) - lu(k,1568) = lu(k,1568) - lu(k,167) * lu(k,1534) - lu(k,1810) = lu(k,1810) - lu(k,163) * lu(k,1808) - lu(k,1837) = lu(k,1837) - lu(k,164) * lu(k,1808) - lu(k,1849) = lu(k,1849) - lu(k,165) * lu(k,1808) - lu(k,1855) = lu(k,1855) - lu(k,166) * lu(k,1808) - lu(k,1856) = lu(k,1856) - lu(k,167) * lu(k,1808) - 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,379) = lu(k,379) - lu(k,169) * lu(k,377) - lu(k,383) = lu(k,383) - lu(k,170) * lu(k,377) - lu(k,385) = lu(k,385) - lu(k,171) * lu(k,377) - lu(k,386) = lu(k,386) - lu(k,172) * lu(k,377) - lu(k,387) = lu(k,387) - lu(k,173) * lu(k,377) - lu(k,391) = lu(k,391) - lu(k,174) * lu(k,377) - lu(k,787) = lu(k,787) - lu(k,169) * lu(k,777) - lu(k,794) = lu(k,794) - lu(k,170) * lu(k,777) - lu(k,801) = lu(k,801) - lu(k,171) * lu(k,777) - lu(k,802) = lu(k,802) - lu(k,172) * lu(k,777) - lu(k,806) = lu(k,806) - lu(k,173) * lu(k,777) - lu(k,813) = lu(k,813) - lu(k,174) * lu(k,777) - lu(k,1182) = lu(k,1182) - lu(k,169) * lu(k,1178) - lu(k,1192) = lu(k,1192) - lu(k,170) * lu(k,1178) - lu(k,1202) = lu(k,1202) - lu(k,171) * lu(k,1178) - lu(k,1203) = lu(k,1203) - lu(k,172) * lu(k,1178) - lu(k,1207) = lu(k,1207) - lu(k,173) * lu(k,1178) - lu(k,1216) = lu(k,1216) - lu(k,174) * lu(k,1178) - lu(k,1231) = lu(k,1231) - lu(k,169) * lu(k,1223) - lu(k,1241) = - lu(k,170) * lu(k,1223) - lu(k,1251) = lu(k,1251) - lu(k,171) * lu(k,1223) - lu(k,1252) = lu(k,1252) - lu(k,172) * lu(k,1223) - lu(k,1256) = lu(k,1256) - lu(k,173) * lu(k,1223) - lu(k,1265) = lu(k,1265) - lu(k,174) * lu(k,1223) - lu(k,1407) = lu(k,1407) - lu(k,169) * lu(k,1394) - lu(k,1418) = lu(k,1418) - lu(k,170) * lu(k,1394) - lu(k,1428) = lu(k,1428) - lu(k,171) * lu(k,1394) - lu(k,1429) = lu(k,1429) - lu(k,172) * lu(k,1394) - lu(k,1433) = lu(k,1433) - lu(k,173) * lu(k,1394) - lu(k,1442) = lu(k,1442) - lu(k,174) * lu(k,1394) - lu(k,175) = 1._r8 / lu(k,175) - lu(k,176) = lu(k,176) * lu(k,175) - lu(k,177) = lu(k,177) * lu(k,175) - lu(k,178) = lu(k,178) * lu(k,175) - lu(k,179) = lu(k,179) * lu(k,175) - lu(k,794) = lu(k,794) - lu(k,176) * lu(k,778) - lu(k,796) = lu(k,796) - lu(k,177) * lu(k,778) - lu(k,808) = lu(k,808) - lu(k,178) * lu(k,778) - lu(k,814) = lu(k,814) - lu(k,179) * lu(k,778) - lu(k,851) = - lu(k,176) * lu(k,847) - lu(k,855) = lu(k,855) - lu(k,177) * lu(k,847) - lu(k,867) = lu(k,867) - lu(k,178) * lu(k,847) - lu(k,875) = lu(k,875) - lu(k,179) * lu(k,847) - lu(k,939) = lu(k,939) - lu(k,176) * lu(k,924) - lu(k,944) = lu(k,944) - lu(k,177) * lu(k,924) - lu(k,956) = lu(k,956) - lu(k,178) * lu(k,924) - lu(k,964) = lu(k,964) - lu(k,179) * lu(k,924) - lu(k,1151) = lu(k,1151) - lu(k,176) * lu(k,1135) - lu(k,1156) = - lu(k,177) * lu(k,1135) - lu(k,1168) = - lu(k,178) * lu(k,1135) - lu(k,1176) = lu(k,1176) - lu(k,179) * lu(k,1135) - lu(k,1280) = lu(k,1280) - lu(k,176) * lu(k,1268) - lu(k,1285) = lu(k,1285) - lu(k,177) * lu(k,1268) - lu(k,1297) = - lu(k,178) * lu(k,1268) - lu(k,1305) = lu(k,1305) - lu(k,179) * lu(k,1268) - lu(k,1501) = lu(k,1501) - lu(k,176) * lu(k,1486) - lu(k,1506) = lu(k,1506) - lu(k,177) * lu(k,1486) - lu(k,1518) = lu(k,1518) - lu(k,178) * lu(k,1486) - lu(k,1526) = lu(k,1526) - lu(k,179) * lu(k,1486) - lu(k,1545) = lu(k,1545) - lu(k,176) * lu(k,1535) - lu(k,1548) = - lu(k,177) * lu(k,1535) - lu(k,1560) = lu(k,1560) - lu(k,178) * lu(k,1535) - lu(k,1568) = lu(k,1568) - lu(k,179) * lu(k,1535) - lu(k,1831) = lu(k,1831) - lu(k,176) * lu(k,1809) - lu(k,1836) = - lu(k,177) * lu(k,1809) - lu(k,1848) = lu(k,1848) - lu(k,178) * lu(k,1809) - lu(k,1856) = lu(k,1856) - lu(k,179) * lu(k,1809) + 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,157) = lu(k,157) * lu(k,152) + lu(k,780) = lu(k,780) - lu(k,153) * lu(k,771) + lu(k,784) = lu(k,784) - lu(k,154) * lu(k,771) + lu(k,786) = lu(k,786) - lu(k,155) * lu(k,771) + lu(k,793) = lu(k,793) - lu(k,156) * lu(k,771) + lu(k,804) = lu(k,804) - lu(k,157) * lu(k,771) + lu(k,975) = lu(k,975) - lu(k,153) * lu(k,956) + lu(k,979) = lu(k,979) - lu(k,154) * lu(k,956) + lu(k,981) = lu(k,981) - lu(k,155) * lu(k,956) + lu(k,990) = lu(k,990) - lu(k,156) * lu(k,956) + lu(k,1001) = lu(k,1001) - lu(k,157) * lu(k,956) + lu(k,1992) = lu(k,1992) - lu(k,153) * lu(k,1982) + lu(k,1996) = - lu(k,154) * lu(k,1982) + lu(k,2002) = lu(k,2002) - lu(k,155) * lu(k,1982) + lu(k,2014) = lu(k,2014) - lu(k,156) * lu(k,1982) + lu(k,2026) = lu(k,2026) - lu(k,157) * lu(k,1982) + lu(k,158) = 1._r8 / lu(k,158) + lu(k,159) = lu(k,159) * lu(k,158) + lu(k,160) = lu(k,160) * lu(k,158) + lu(k,161) = lu(k,161) * lu(k,158) + lu(k,162) = lu(k,162) * lu(k,158) + lu(k,163) = lu(k,163) * lu(k,158) + lu(k,429) = lu(k,429) - lu(k,159) * lu(k,428) + lu(k,430) = lu(k,430) - lu(k,160) * lu(k,428) + lu(k,432) = - lu(k,161) * lu(k,428) + lu(k,433) = - lu(k,162) * lu(k,428) + lu(k,439) = - lu(k,163) * lu(k,428) + lu(k,891) = lu(k,891) - lu(k,159) * lu(k,884) + lu(k,895) = - lu(k,160) * lu(k,884) + lu(k,898) = lu(k,898) - lu(k,161) * lu(k,884) + lu(k,904) = lu(k,904) - lu(k,162) * lu(k,884) + lu(k,918) = lu(k,918) - lu(k,163) * lu(k,884) + lu(k,972) = lu(k,972) - lu(k,159) * lu(k,957) + lu(k,978) = lu(k,978) - lu(k,160) * lu(k,957) + lu(k,981) = lu(k,981) - lu(k,161) * lu(k,957) + lu(k,988) = lu(k,988) - lu(k,162) * lu(k,957) + lu(k,1002) = lu(k,1002) - lu(k,163) * lu(k,957) + lu(k,164) = 1._r8 / lu(k,164) + lu(k,165) = lu(k,165) * lu(k,164) + lu(k,166) = lu(k,166) * lu(k,164) + lu(k,167) = lu(k,167) * lu(k,164) + lu(k,168) = lu(k,168) * lu(k,164) + lu(k,169) = lu(k,169) * lu(k,164) + lu(k,287) = - lu(k,165) * lu(k,286) + lu(k,290) = lu(k,290) - lu(k,166) * lu(k,286) + lu(k,291) = lu(k,291) - lu(k,167) * lu(k,286) + lu(k,292) = - lu(k,168) * lu(k,286) + lu(k,296) = lu(k,296) - lu(k,169) * lu(k,286) + lu(k,1041) = lu(k,1041) - lu(k,165) * lu(k,1036) + lu(k,1054) = lu(k,1054) - lu(k,166) * lu(k,1036) + lu(k,1055) = lu(k,1055) - lu(k,167) * lu(k,1036) + lu(k,1062) = lu(k,1062) - lu(k,168) * lu(k,1036) + lu(k,1078) = lu(k,1078) - lu(k,169) * lu(k,1036) + lu(k,2035) = lu(k,2035) - lu(k,165) * lu(k,2033) + lu(k,2062) = lu(k,2062) - lu(k,166) * lu(k,2033) + lu(k,2064) = - lu(k,167) * lu(k,2033) + lu(k,2071) = lu(k,2071) - lu(k,168) * lu(k,2033) + lu(k,2087) = lu(k,2087) - lu(k,169) * lu(k,2033) + lu(k,170) = 1._r8 / lu(k,170) + lu(k,171) = lu(k,171) * lu(k,170) + lu(k,172) = lu(k,172) * lu(k,170) + lu(k,173) = lu(k,173) * lu(k,170) + lu(k,174) = lu(k,174) * lu(k,170) + lu(k,175) = lu(k,175) * lu(k,170) + lu(k,1044) = - lu(k,171) * lu(k,1037) + lu(k,1055) = lu(k,1055) - lu(k,172) * lu(k,1037) + lu(k,1064) = lu(k,1064) - lu(k,173) * lu(k,1037) + lu(k,1070) = lu(k,1070) - lu(k,174) * lu(k,1037) + lu(k,1078) = lu(k,1078) - lu(k,175) * lu(k,1037) + lu(k,1168) = - lu(k,171) * lu(k,1167) + lu(k,1186) = lu(k,1186) - lu(k,172) * lu(k,1167) + lu(k,1195) = - lu(k,173) * lu(k,1167) + lu(k,1201) = lu(k,1201) - lu(k,174) * lu(k,1167) + lu(k,1209) = lu(k,1209) - lu(k,175) * lu(k,1167) + lu(k,2038) = lu(k,2038) - lu(k,171) * lu(k,2034) + lu(k,2064) = lu(k,2064) - lu(k,172) * lu(k,2034) + lu(k,2073) = lu(k,2073) - lu(k,173) * lu(k,2034) + lu(k,2079) = - lu(k,174) * lu(k,2034) + lu(k,2087) = lu(k,2087) - lu(k,175) * lu(k,2034) + 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,182) = lu(k,182) * lu(k,176) + lu(k,780) = lu(k,780) - lu(k,177) * lu(k,772) + lu(k,784) = lu(k,784) - lu(k,178) * lu(k,772) + lu(k,786) = lu(k,786) - lu(k,179) * lu(k,772) + lu(k,793) = lu(k,793) - lu(k,180) * lu(k,772) + lu(k,804) = lu(k,804) - lu(k,181) * lu(k,772) + lu(k,805) = lu(k,805) - lu(k,182) * lu(k,772) + lu(k,975) = lu(k,975) - lu(k,177) * lu(k,958) + lu(k,979) = lu(k,979) - lu(k,178) * lu(k,958) + lu(k,981) = lu(k,981) - lu(k,179) * lu(k,958) + lu(k,990) = lu(k,990) - lu(k,180) * lu(k,958) + lu(k,1001) = lu(k,1001) - lu(k,181) * lu(k,958) + lu(k,1002) = lu(k,1002) - lu(k,182) * lu(k,958) + lu(k,1992) = lu(k,1992) - lu(k,177) * lu(k,1983) + lu(k,1996) = lu(k,1996) - lu(k,178) * lu(k,1983) + lu(k,2002) = lu(k,2002) - lu(k,179) * lu(k,1983) + lu(k,2014) = lu(k,2014) - lu(k,180) * lu(k,1983) + lu(k,2026) = lu(k,2026) - lu(k,181) * lu(k,1983) + lu(k,2027) = lu(k,2027) - lu(k,182) * lu(k,1983) + lu(k,183) = 1._r8 / lu(k,183) + lu(k,184) = lu(k,184) * lu(k,183) + lu(k,185) = lu(k,185) * lu(k,183) + lu(k,186) = lu(k,186) * lu(k,183) + lu(k,187) = lu(k,187) * lu(k,183) + lu(k,188) = lu(k,188) * lu(k,183) + lu(k,189) = lu(k,189) * lu(k,183) + lu(k,897) = lu(k,897) - lu(k,184) * lu(k,885) + lu(k,898) = lu(k,898) - lu(k,185) * lu(k,885) + lu(k,900) = lu(k,900) - lu(k,186) * lu(k,885) + lu(k,909) = lu(k,909) - lu(k,187) * lu(k,885) + lu(k,912) = lu(k,912) - lu(k,188) * lu(k,885) + lu(k,918) = lu(k,918) - lu(k,189) * lu(k,885) + lu(k,980) = lu(k,980) - lu(k,184) * lu(k,959) + lu(k,981) = lu(k,981) - lu(k,185) * lu(k,959) + lu(k,983) = lu(k,983) - lu(k,186) * lu(k,959) + lu(k,993) = lu(k,993) - lu(k,187) * lu(k,959) + lu(k,996) = lu(k,996) - lu(k,188) * lu(k,959) + lu(k,1002) = lu(k,1002) - lu(k,189) * lu(k,959) + lu(k,1621) = lu(k,1621) - lu(k,184) * lu(k,1602) + lu(k,1623) = lu(k,1623) - lu(k,185) * lu(k,1602) + lu(k,1626) = lu(k,1626) - lu(k,186) * lu(k,1602) + lu(k,1638) = lu(k,1638) - lu(k,187) * lu(k,1602) + lu(k,1642) = lu(k,1642) - lu(k,188) * lu(k,1602) + lu(k,1648) = lu(k,1648) - lu(k,189) * lu(k,1602) + lu(k,190) = 1._r8 / lu(k,190) + lu(k,191) = lu(k,191) * lu(k,190) + lu(k,192) = lu(k,192) * lu(k,190) + lu(k,193) = lu(k,193) * lu(k,190) + lu(k,194) = lu(k,194) * lu(k,190) + lu(k,195) = lu(k,195) * lu(k,190) + lu(k,196) = lu(k,196) * lu(k,190) + lu(k,1039) = lu(k,1039) - lu(k,191) * lu(k,1038) + lu(k,1040) = lu(k,1040) - lu(k,192) * lu(k,1038) + lu(k,1048) = - lu(k,193) * lu(k,1038) + lu(k,1049) = lu(k,1049) - lu(k,194) * lu(k,1038) + lu(k,1060) = lu(k,1060) - lu(k,195) * lu(k,1038) + lu(k,1070) = lu(k,1070) - lu(k,196) * lu(k,1038) + lu(k,1254) = lu(k,1254) - lu(k,191) * lu(k,1253) + lu(k,1257) = lu(k,1257) - lu(k,192) * lu(k,1253) + lu(k,1263) = lu(k,1263) - lu(k,193) * lu(k,1253) + lu(k,1270) = lu(k,1270) - lu(k,194) * lu(k,1253) + lu(k,1292) = lu(k,1292) - lu(k,195) * lu(k,1253) + lu(k,1302) = lu(k,1302) - lu(k,196) * lu(k,1253) + lu(k,1781) = lu(k,1781) - lu(k,191) * lu(k,1780) + lu(k,1782) = lu(k,1782) - lu(k,192) * lu(k,1780) + lu(k,1786) = lu(k,1786) - lu(k,193) * lu(k,1780) + lu(k,1789) = lu(k,1789) - lu(k,194) * lu(k,1780) + lu(k,1809) = lu(k,1809) - lu(k,195) * lu(k,1780) + lu(k,1819) = lu(k,1819) - lu(k,196) * lu(k,1780) end do end subroutine lu_fac04 subroutine lu_fac05( avec_len, lu ) @@ -688,165 +585,184 @@ subroutine lu_fac05( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,181) = 1._r8 / lu(k,181) - lu(k,182) = lu(k,182) * lu(k,181) - lu(k,183) = lu(k,183) * lu(k,181) - lu(k,184) = lu(k,184) * lu(k,181) - lu(k,185) = lu(k,185) * lu(k,181) - lu(k,191) = lu(k,191) - lu(k,182) * lu(k,188) - lu(k,194) = lu(k,194) - lu(k,183) * lu(k,188) - lu(k,195) = lu(k,195) - lu(k,184) * lu(k,188) - lu(k,196) = lu(k,196) - lu(k,185) * lu(k,188) - lu(k,750) = - lu(k,182) * lu(k,737) - lu(k,762) = - lu(k,183) * lu(k,737) - lu(k,766) = lu(k,766) - lu(k,184) * lu(k,737) - lu(k,767) = lu(k,767) - lu(k,185) * lu(k,737) - lu(k,797) = - lu(k,182) * lu(k,779) - lu(k,809) = - lu(k,183) * lu(k,779) - lu(k,813) = lu(k,813) - lu(k,184) * lu(k,779) - lu(k,814) = lu(k,814) - lu(k,185) * lu(k,779) - lu(k,1033) = lu(k,1033) - lu(k,182) * lu(k,1012) - lu(k,1045) = lu(k,1045) - lu(k,183) * lu(k,1012) - lu(k,1051) = lu(k,1051) - lu(k,184) * lu(k,1012) - lu(k,1052) = lu(k,1052) - lu(k,185) * lu(k,1012) - lu(k,1074) = - lu(k,182) * lu(k,1053) - lu(k,1086) = lu(k,1086) - lu(k,183) * lu(k,1053) - lu(k,1092) = lu(k,1092) - lu(k,184) * lu(k,1053) - lu(k,1093) = lu(k,1093) - lu(k,185) * lu(k,1053) - lu(k,1549) = lu(k,1549) - lu(k,182) * lu(k,1536) - lu(k,1561) = lu(k,1561) - lu(k,183) * lu(k,1536) - lu(k,1567) = lu(k,1567) - lu(k,184) * lu(k,1536) - lu(k,1568) = lu(k,1568) - lu(k,185) * lu(k,1536) - lu(k,1779) = - lu(k,182) * lu(k,1764) - lu(k,1791) = lu(k,1791) - lu(k,183) * lu(k,1764) - lu(k,1797) = lu(k,1797) - lu(k,184) * lu(k,1764) - lu(k,1798) = lu(k,1798) - lu(k,185) * lu(k,1764) - lu(k,1837) = lu(k,1837) - lu(k,182) * lu(k,1810) - lu(k,1849) = lu(k,1849) - lu(k,183) * lu(k,1810) - lu(k,1855) = lu(k,1855) - lu(k,184) * lu(k,1810) - lu(k,1856) = lu(k,1856) - lu(k,185) * lu(k,1810) - lu(k,189) = 1._r8 / lu(k,189) - lu(k,190) = lu(k,190) * lu(k,189) - lu(k,191) = lu(k,191) * lu(k,189) - lu(k,192) = lu(k,192) * lu(k,189) - lu(k,193) = lu(k,193) * lu(k,189) - lu(k,194) = lu(k,194) * lu(k,189) - lu(k,195) = lu(k,195) * lu(k,189) - lu(k,196) = lu(k,196) * lu(k,189) - lu(k,351) = - lu(k,190) * lu(k,348) - lu(k,352) = - lu(k,191) * lu(k,348) - lu(k,354) = lu(k,354) - lu(k,192) * lu(k,348) - lu(k,356) = lu(k,356) - lu(k,193) * lu(k,348) - lu(k,358) = lu(k,358) - lu(k,194) * lu(k,348) - lu(k,360) = - lu(k,195) * lu(k,348) - lu(k,361) = lu(k,361) - lu(k,196) * lu(k,348) - lu(k,1359) = lu(k,1359) - lu(k,190) * lu(k,1341) - lu(k,1365) = - lu(k,191) * lu(k,1341) - lu(k,1370) = lu(k,1370) - lu(k,192) * lu(k,1341) - lu(k,1373) = lu(k,1373) - lu(k,193) * lu(k,1341) - lu(k,1377) = lu(k,1377) - lu(k,194) * lu(k,1341) - lu(k,1383) = - lu(k,195) * lu(k,1341) - lu(k,1384) = lu(k,1384) - lu(k,196) * lu(k,1341) - lu(k,1545) = lu(k,1545) - lu(k,190) * lu(k,1537) - lu(k,1549) = lu(k,1549) - lu(k,191) * lu(k,1537) - lu(k,1554) = lu(k,1554) - lu(k,192) * lu(k,1537) - lu(k,1557) = lu(k,1557) - lu(k,193) * lu(k,1537) - lu(k,1561) = lu(k,1561) - lu(k,194) * lu(k,1537) - lu(k,1567) = lu(k,1567) - lu(k,195) * lu(k,1537) - lu(k,1568) = lu(k,1568) - lu(k,196) * lu(k,1537) - lu(k,1831) = lu(k,1831) - lu(k,190) * lu(k,1811) - lu(k,1837) = lu(k,1837) - lu(k,191) * lu(k,1811) - lu(k,1842) = lu(k,1842) - lu(k,192) * lu(k,1811) - lu(k,1845) = lu(k,1845) - lu(k,193) * lu(k,1811) - lu(k,1849) = lu(k,1849) - lu(k,194) * lu(k,1811) - lu(k,1855) = lu(k,1855) - lu(k,195) * lu(k,1811) - lu(k,1856) = lu(k,1856) - lu(k,196) * lu(k,1811) - lu(k,198) = 1._r8 / lu(k,198) - lu(k,199) = lu(k,199) * lu(k,198) - lu(k,200) = lu(k,200) * lu(k,198) - lu(k,201) = lu(k,201) * lu(k,198) - lu(k,202) = lu(k,202) * lu(k,198) - lu(k,203) = lu(k,203) * lu(k,198) - lu(k,204) = lu(k,204) * lu(k,198) - lu(k,205) = lu(k,205) * lu(k,198) - lu(k,483) = - lu(k,199) * lu(k,482) - lu(k,484) = lu(k,484) - lu(k,200) * lu(k,482) - lu(k,488) = lu(k,488) - lu(k,201) * lu(k,482) - lu(k,490) = - lu(k,202) * lu(k,482) - lu(k,493) = - lu(k,203) * lu(k,482) - lu(k,501) = lu(k,501) - lu(k,204) * lu(k,482) - lu(k,502) = lu(k,502) - lu(k,205) * lu(k,482) - lu(k,631) = lu(k,631) - lu(k,199) * lu(k,628) - lu(k,634) = lu(k,634) - lu(k,200) * lu(k,628) - lu(k,639) = lu(k,639) - lu(k,201) * lu(k,628) - lu(k,642) = - lu(k,202) * lu(k,628) - lu(k,646) = - lu(k,203) * lu(k,628) - lu(k,656) = lu(k,656) - lu(k,204) * lu(k,628) - lu(k,657) = lu(k,657) - lu(k,205) * lu(k,628) - lu(k,786) = lu(k,786) - lu(k,199) * lu(k,780) - lu(k,789) = lu(k,789) - lu(k,200) * lu(k,780) - lu(k,794) = lu(k,794) - lu(k,201) * lu(k,780) - lu(k,799) = lu(k,799) - lu(k,202) * lu(k,780) - lu(k,803) = lu(k,803) - lu(k,203) * lu(k,780) - lu(k,813) = lu(k,813) - lu(k,204) * lu(k,780) - lu(k,814) = lu(k,814) - lu(k,205) * lu(k,780) - lu(k,1270) = - lu(k,199) * lu(k,1269) - lu(k,1272) = - lu(k,200) * lu(k,1269) - lu(k,1280) = lu(k,1280) - lu(k,201) * lu(k,1269) - lu(k,1288) = lu(k,1288) - lu(k,202) * lu(k,1269) - lu(k,1292) = lu(k,1292) - lu(k,203) * lu(k,1269) - lu(k,1304) = lu(k,1304) - lu(k,204) * lu(k,1269) - lu(k,1305) = lu(k,1305) - lu(k,205) * lu(k,1269) - lu(k,1814) = - lu(k,199) * lu(k,1812) - lu(k,1821) = lu(k,1821) - lu(k,200) * lu(k,1812) - lu(k,1831) = lu(k,1831) - lu(k,201) * lu(k,1812) - lu(k,1839) = - lu(k,202) * lu(k,1812) - lu(k,1843) = lu(k,1843) - lu(k,203) * lu(k,1812) - lu(k,1855) = lu(k,1855) - lu(k,204) * lu(k,1812) - lu(k,1856) = lu(k,1856) - lu(k,205) * lu(k,1812) - lu(k,207) = 1._r8 / lu(k,207) - lu(k,208) = lu(k,208) * lu(k,207) - lu(k,209) = lu(k,209) * lu(k,207) - lu(k,210) = lu(k,210) * lu(k,207) - lu(k,211) = lu(k,211) * lu(k,207) - lu(k,212) = lu(k,212) * lu(k,207) - lu(k,213) = lu(k,213) * lu(k,207) - lu(k,214) = lu(k,214) * lu(k,207) - lu(k,583) = lu(k,583) - lu(k,208) * lu(k,580) - lu(k,584) = lu(k,584) - lu(k,209) * lu(k,580) - lu(k,588) = lu(k,588) - lu(k,210) * lu(k,580) - lu(k,591) = - lu(k,211) * lu(k,580) - lu(k,595) = lu(k,595) - lu(k,212) * lu(k,580) - lu(k,596) = lu(k,596) - lu(k,213) * lu(k,580) - lu(k,600) = - lu(k,214) * lu(k,580) - lu(k,742) = lu(k,742) - lu(k,208) * lu(k,738) - lu(k,744) = lu(k,744) - lu(k,209) * lu(k,738) - lu(k,748) = lu(k,748) - lu(k,210) * lu(k,738) - lu(k,753) = lu(k,753) - lu(k,211) * lu(k,738) - lu(k,759) = lu(k,759) - lu(k,212) * lu(k,738) - lu(k,760) = lu(k,760) - lu(k,213) * lu(k,738) - lu(k,767) = lu(k,767) - lu(k,214) * lu(k,738) - lu(k,974) = lu(k,974) - lu(k,208) * lu(k,967) - lu(k,979) = lu(k,979) - lu(k,209) * lu(k,967) - lu(k,985) = lu(k,985) - lu(k,210) * lu(k,967) - lu(k,994) = - lu(k,211) * lu(k,967) - lu(k,1000) = lu(k,1000) - lu(k,212) * lu(k,967) - lu(k,1001) = lu(k,1001) - lu(k,213) * lu(k,967) - lu(k,1010) = lu(k,1010) - lu(k,214) * lu(k,967) - lu(k,1141) = lu(k,1141) - lu(k,208) * lu(k,1136) - lu(k,1144) = - lu(k,209) * lu(k,1136) - lu(k,1151) = lu(k,1151) - lu(k,210) * lu(k,1136) - lu(k,1160) = lu(k,1160) - lu(k,211) * lu(k,1136) - lu(k,1166) = lu(k,1166) - lu(k,212) * lu(k,1136) - lu(k,1167) = lu(k,1167) - lu(k,213) * lu(k,1136) - lu(k,1176) = lu(k,1176) - lu(k,214) * lu(k,1136) - lu(k,1409) = lu(k,1409) - lu(k,208) * lu(k,1395) - lu(k,1411) = lu(k,1411) - lu(k,209) * lu(k,1395) - lu(k,1418) = lu(k,1418) - lu(k,210) * lu(k,1395) - lu(k,1427) = lu(k,1427) - lu(k,211) * lu(k,1395) - lu(k,1433) = lu(k,1433) - lu(k,212) * lu(k,1395) - lu(k,1434) = lu(k,1434) - lu(k,213) * lu(k,1395) - lu(k,1443) = lu(k,1443) - lu(k,214) * lu(k,1395) + lu(k,197) = 1._r8 / lu(k,197) + lu(k,198) = lu(k,198) * lu(k,197) + lu(k,199) = lu(k,199) * lu(k,197) + lu(k,200) = lu(k,200) * lu(k,197) + lu(k,201) = lu(k,201) * lu(k,197) + lu(k,202) = lu(k,202) * lu(k,197) + lu(k,1040) = lu(k,1040) - lu(k,198) * lu(k,1039) + lu(k,1049) = lu(k,1049) - lu(k,199) * lu(k,1039) + lu(k,1060) = lu(k,1060) - lu(k,200) * lu(k,1039) + lu(k,1067) = lu(k,1067) - lu(k,201) * lu(k,1039) + lu(k,1072) = lu(k,1072) - lu(k,202) * lu(k,1039) + lu(k,1257) = lu(k,1257) - lu(k,198) * lu(k,1254) + lu(k,1270) = lu(k,1270) - lu(k,199) * lu(k,1254) + lu(k,1292) = lu(k,1292) - lu(k,200) * lu(k,1254) + lu(k,1299) = lu(k,1299) - lu(k,201) * lu(k,1254) + lu(k,1304) = lu(k,1304) - lu(k,202) * lu(k,1254) + lu(k,1782) = lu(k,1782) - lu(k,198) * lu(k,1781) + lu(k,1789) = lu(k,1789) - lu(k,199) * lu(k,1781) + lu(k,1809) = lu(k,1809) - lu(k,200) * lu(k,1781) + lu(k,1816) = lu(k,1816) - lu(k,201) * lu(k,1781) + lu(k,1821) = lu(k,1821) - lu(k,202) * lu(k,1781) + lu(k,203) = 1._r8 / lu(k,203) + lu(k,204) = lu(k,204) * lu(k,203) + lu(k,205) = lu(k,205) * lu(k,203) + lu(k,206) = lu(k,206) * lu(k,203) + lu(k,207) = lu(k,207) * lu(k,203) + lu(k,208) = lu(k,208) * lu(k,203) + lu(k,209) = lu(k,209) * lu(k,203) + lu(k,210) = lu(k,210) * lu(k,203) + lu(k,708) = lu(k,708) - lu(k,204) * lu(k,707) + lu(k,711) = lu(k,711) - lu(k,205) * lu(k,707) + lu(k,712) = lu(k,712) - lu(k,206) * lu(k,707) + lu(k,717) = - lu(k,207) * lu(k,707) + lu(k,718) = - lu(k,208) * lu(k,707) + lu(k,719) = lu(k,719) - lu(k,209) * lu(k,707) + lu(k,722) = lu(k,722) - lu(k,210) * lu(k,707) + lu(k,1262) = lu(k,1262) - lu(k,204) * lu(k,1255) + lu(k,1274) = lu(k,1274) - lu(k,205) * lu(k,1255) + lu(k,1277) = lu(k,1277) - lu(k,206) * lu(k,1255) + lu(k,1288) = lu(k,1288) - lu(k,207) * lu(k,1255) + lu(k,1291) = - lu(k,208) * lu(k,1255) + lu(k,1292) = lu(k,1292) - lu(k,209) * lu(k,1255) + lu(k,1300) = lu(k,1300) - lu(k,210) * lu(k,1255) + lu(k,1604) = - lu(k,204) * lu(k,1603) + lu(k,1610) = - lu(k,205) * lu(k,1603) + lu(k,1616) = lu(k,1616) - lu(k,206) * lu(k,1603) + lu(k,1626) = lu(k,1626) - lu(k,207) * lu(k,1603) + lu(k,1629) = lu(k,1629) - lu(k,208) * lu(k,1603) + lu(k,1630) = lu(k,1630) - lu(k,209) * lu(k,1603) + lu(k,1638) = lu(k,1638) - lu(k,210) * lu(k,1603) + lu(k,211) = 1._r8 / lu(k,211) + lu(k,212) = lu(k,212) * lu(k,211) + lu(k,213) = lu(k,213) * lu(k,211) + lu(k,214) = lu(k,214) * lu(k,211) + lu(k,215) = lu(k,215) * lu(k,211) + lu(k,216) = lu(k,216) * lu(k,211) + lu(k,217) = lu(k,217) * lu(k,211) + lu(k,897) = lu(k,897) - lu(k,212) * lu(k,886) + lu(k,898) = lu(k,898) - lu(k,213) * lu(k,886) + lu(k,902) = lu(k,902) - lu(k,214) * lu(k,886) + lu(k,906) = lu(k,906) - lu(k,215) * lu(k,886) + lu(k,917) = lu(k,917) - lu(k,216) * lu(k,886) + lu(k,918) = lu(k,918) - lu(k,217) * lu(k,886) + lu(k,980) = lu(k,980) - lu(k,212) * lu(k,960) + lu(k,981) = lu(k,981) - lu(k,213) * lu(k,960) + lu(k,986) = lu(k,986) - lu(k,214) * lu(k,960) + lu(k,990) = lu(k,990) - lu(k,215) * lu(k,960) + lu(k,1001) = lu(k,1001) - lu(k,216) * lu(k,960) + lu(k,1002) = lu(k,1002) - lu(k,217) * lu(k,960) + lu(k,1283) = lu(k,1283) - lu(k,212) * lu(k,1256) + lu(k,1285) = lu(k,1285) - lu(k,213) * lu(k,1256) + lu(k,1292) = lu(k,1292) - lu(k,214) * lu(k,1256) + lu(k,1297) = lu(k,1297) - lu(k,215) * lu(k,1256) + lu(k,1309) = lu(k,1309) - lu(k,216) * lu(k,1256) + lu(k,1310) = - lu(k,217) * lu(k,1256) + lu(k,2000) = lu(k,2000) - lu(k,212) * lu(k,1984) + lu(k,2002) = lu(k,2002) - lu(k,213) * lu(k,1984) + lu(k,2009) = lu(k,2009) - lu(k,214) * lu(k,1984) + lu(k,2014) = lu(k,2014) - lu(k,215) * lu(k,1984) + lu(k,2026) = lu(k,2026) - lu(k,216) * lu(k,1984) + lu(k,2027) = lu(k,2027) - lu(k,217) * lu(k,1984) + lu(k,218) = 1._r8 / lu(k,218) + lu(k,219) = lu(k,219) * lu(k,218) + lu(k,220) = lu(k,220) * lu(k,218) + lu(k,221) = lu(k,221) * lu(k,218) + lu(k,222) = lu(k,222) * lu(k,218) + lu(k,223) = lu(k,223) * lu(k,218) + lu(k,224) = lu(k,224) * lu(k,218) + lu(k,225) = lu(k,225) * lu(k,218) + lu(k,226) = lu(k,226) * lu(k,218) + lu(k,778) = lu(k,778) - lu(k,219) * lu(k,773) + lu(k,780) = lu(k,780) - lu(k,220) * lu(k,773) + lu(k,784) = lu(k,784) - lu(k,221) * lu(k,773) + lu(k,785) = lu(k,785) - lu(k,222) * lu(k,773) + lu(k,786) = lu(k,786) - lu(k,223) * lu(k,773) + lu(k,793) = lu(k,793) - lu(k,224) * lu(k,773) + lu(k,804) = lu(k,804) - lu(k,225) * lu(k,773) + lu(k,805) = lu(k,805) - lu(k,226) * lu(k,773) + lu(k,972) = lu(k,972) - lu(k,219) * lu(k,961) + lu(k,975) = lu(k,975) - lu(k,220) * lu(k,961) + lu(k,979) = lu(k,979) - lu(k,221) * lu(k,961) + lu(k,980) = lu(k,980) - lu(k,222) * lu(k,961) + lu(k,981) = lu(k,981) - lu(k,223) * lu(k,961) + lu(k,990) = lu(k,990) - lu(k,224) * lu(k,961) + lu(k,1001) = lu(k,1001) - lu(k,225) * lu(k,961) + lu(k,1002) = lu(k,1002) - lu(k,226) * lu(k,961) + lu(k,1991) = lu(k,1991) - lu(k,219) * lu(k,1985) + lu(k,1992) = lu(k,1992) - lu(k,220) * lu(k,1985) + lu(k,1996) = lu(k,1996) - lu(k,221) * lu(k,1985) + lu(k,2000) = lu(k,2000) - lu(k,222) * lu(k,1985) + lu(k,2002) = lu(k,2002) - lu(k,223) * lu(k,1985) + lu(k,2014) = lu(k,2014) - lu(k,224) * lu(k,1985) + lu(k,2026) = lu(k,2026) - lu(k,225) * lu(k,1985) + lu(k,2027) = lu(k,2027) - lu(k,226) * lu(k,1985) + 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,234) = lu(k,234) * lu(k,227) + lu(k,235) = lu(k,235) * lu(k,227) + lu(k,1047) = lu(k,1047) - lu(k,228) * lu(k,1040) + lu(k,1049) = lu(k,1049) - lu(k,229) * lu(k,1040) + lu(k,1050) = lu(k,1050) - lu(k,230) * lu(k,1040) + lu(k,1055) = lu(k,1055) - lu(k,231) * lu(k,1040) + lu(k,1057) = lu(k,1057) - lu(k,232) * lu(k,1040) + lu(k,1060) = lu(k,1060) - lu(k,233) * lu(k,1040) + lu(k,1067) = lu(k,1067) - lu(k,234) * lu(k,1040) + lu(k,1072) = lu(k,1072) - lu(k,235) * lu(k,1040) + lu(k,1261) = lu(k,1261) - lu(k,228) * lu(k,1257) + lu(k,1270) = lu(k,1270) - lu(k,229) * lu(k,1257) + lu(k,1271) = lu(k,1271) - lu(k,230) * lu(k,1257) + lu(k,1287) = lu(k,1287) - lu(k,231) * lu(k,1257) + lu(k,1289) = lu(k,1289) - lu(k,232) * lu(k,1257) + lu(k,1292) = lu(k,1292) - lu(k,233) * lu(k,1257) + lu(k,1299) = lu(k,1299) - lu(k,234) * lu(k,1257) + lu(k,1304) = lu(k,1304) - lu(k,235) * lu(k,1257) + lu(k,1785) = lu(k,1785) - lu(k,228) * lu(k,1782) + lu(k,1789) = lu(k,1789) - lu(k,229) * lu(k,1782) + lu(k,1790) = lu(k,1790) - lu(k,230) * lu(k,1782) + lu(k,1804) = lu(k,1804) - lu(k,231) * lu(k,1782) + lu(k,1806) = lu(k,1806) - lu(k,232) * lu(k,1782) + lu(k,1809) = lu(k,1809) - lu(k,233) * lu(k,1782) + lu(k,1816) = lu(k,1816) - lu(k,234) * lu(k,1782) + lu(k,1821) = lu(k,1821) - lu(k,235) * lu(k,1782) + lu(k,236) = 1._r8 / lu(k,236) + lu(k,237) = lu(k,237) * lu(k,236) + lu(k,238) = lu(k,238) * lu(k,236) + lu(k,239) = lu(k,239) * lu(k,236) + lu(k,240) = lu(k,240) * lu(k,236) + lu(k,241) = lu(k,241) * lu(k,236) + lu(k,242) = lu(k,242) * lu(k,236) + lu(k,1275) = lu(k,1275) - lu(k,237) * lu(k,1258) + lu(k,1281) = lu(k,1281) - lu(k,238) * lu(k,1258) + lu(k,1292) = lu(k,1292) - lu(k,239) * lu(k,1258) + lu(k,1298) = lu(k,1298) - lu(k,240) * lu(k,1258) + lu(k,1304) = lu(k,1304) - lu(k,241) * lu(k,1258) + lu(k,1308) = lu(k,1308) - lu(k,242) * lu(k,1258) + lu(k,1524) = lu(k,1524) - lu(k,237) * lu(k,1520) + lu(k,1526) = lu(k,1526) - lu(k,238) * lu(k,1520) + lu(k,1537) = lu(k,1537) - lu(k,239) * lu(k,1520) + lu(k,1543) = lu(k,1543) - lu(k,240) * lu(k,1520) + lu(k,1549) = lu(k,1549) - lu(k,241) * lu(k,1520) + lu(k,1553) = lu(k,1553) - lu(k,242) * lu(k,1520) + lu(k,1794) = lu(k,1794) - lu(k,237) * lu(k,1783) + lu(k,1798) = - lu(k,238) * lu(k,1783) + lu(k,1809) = lu(k,1809) - lu(k,239) * lu(k,1783) + lu(k,1815) = lu(k,1815) - lu(k,240) * lu(k,1783) + lu(k,1821) = lu(k,1821) - lu(k,241) * lu(k,1783) + lu(k,1825) = lu(k,1825) - lu(k,242) * lu(k,1783) + lu(k,1948) = lu(k,1948) - lu(k,237) * lu(k,1939) + lu(k,1950) = lu(k,1950) - lu(k,238) * lu(k,1939) + lu(k,1961) = lu(k,1961) - lu(k,239) * lu(k,1939) + lu(k,1967) = lu(k,1967) - lu(k,240) * lu(k,1939) + lu(k,1973) = lu(k,1973) - lu(k,241) * lu(k,1939) + lu(k,1977) = lu(k,1977) - lu(k,242) * lu(k,1939) end do end subroutine lu_fac05 subroutine lu_fac06( avec_len, lu ) @@ -863,248 +779,209 @@ subroutine lu_fac06( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,215) = 1._r8 / lu(k,215) - lu(k,216) = lu(k,216) * lu(k,215) - lu(k,217) = lu(k,217) * lu(k,215) - lu(k,218) = lu(k,218) * lu(k,215) - lu(k,219) = lu(k,219) * lu(k,215) - lu(k,220) = lu(k,220) * lu(k,215) - lu(k,221) = lu(k,221) * lu(k,215) - lu(k,222) = lu(k,222) * lu(k,215) - lu(k,263) = lu(k,263) - lu(k,216) * lu(k,262) - lu(k,264) = lu(k,264) - lu(k,217) * lu(k,262) - lu(k,265) = lu(k,265) - lu(k,218) * lu(k,262) - lu(k,266) = - lu(k,219) * lu(k,262) - lu(k,270) = lu(k,270) - lu(k,220) * lu(k,262) - lu(k,272) = lu(k,272) - lu(k,221) * lu(k,262) - lu(k,273) = - lu(k,222) * lu(k,262) - lu(k,879) = - lu(k,216) * lu(k,878) - lu(k,880) = - lu(k,217) * lu(k,878) - lu(k,881) = lu(k,881) - lu(k,218) * lu(k,878) - lu(k,892) = - lu(k,219) * lu(k,878) - lu(k,908) = lu(k,908) - lu(k,220) * lu(k,878) - lu(k,912) = lu(k,912) - lu(k,221) * lu(k,878) - lu(k,914) = lu(k,914) - lu(k,222) * lu(k,878) - lu(k,1225) = lu(k,1225) - lu(k,216) * lu(k,1224) - lu(k,1228) = lu(k,1228) - lu(k,217) * lu(k,1224) - lu(k,1229) = lu(k,1229) - lu(k,218) * lu(k,1224) - lu(k,1236) = lu(k,1236) - lu(k,219) * lu(k,1224) - lu(k,1252) = lu(k,1252) - lu(k,220) * lu(k,1224) - lu(k,1256) = lu(k,1256) - lu(k,221) * lu(k,1224) - lu(k,1258) = lu(k,1258) - lu(k,222) * lu(k,1224) - lu(k,1397) = lu(k,1397) - lu(k,216) * lu(k,1396) - lu(k,1402) = lu(k,1402) - lu(k,217) * lu(k,1396) - lu(k,1405) = lu(k,1405) - lu(k,218) * lu(k,1396) - lu(k,1413) = - lu(k,219) * lu(k,1396) - lu(k,1429) = lu(k,1429) - lu(k,220) * lu(k,1396) - lu(k,1433) = lu(k,1433) - lu(k,221) * lu(k,1396) - lu(k,1435) = lu(k,1435) - lu(k,222) * lu(k,1396) - lu(k,1539) = lu(k,1539) - lu(k,216) * lu(k,1538) - lu(k,1540) = lu(k,1540) - lu(k,217) * lu(k,1538) - lu(k,1541) = lu(k,1541) - lu(k,218) * lu(k,1538) - lu(k,1543) = lu(k,1543) - lu(k,219) * lu(k,1538) - lu(k,1554) = lu(k,1554) - lu(k,220) * lu(k,1538) - lu(k,1558) = lu(k,1558) - lu(k,221) * lu(k,1538) - lu(k,1560) = lu(k,1560) - lu(k,222) * lu(k,1538) - lu(k,223) = 1._r8 / lu(k,223) - lu(k,224) = lu(k,224) * lu(k,223) - lu(k,225) = lu(k,225) * lu(k,223) - lu(k,226) = lu(k,226) * lu(k,223) - lu(k,227) = lu(k,227) * lu(k,223) - lu(k,228) = lu(k,228) * lu(k,223) - lu(k,229) = lu(k,229) * lu(k,223) - lu(k,264) = lu(k,264) - lu(k,224) * lu(k,263) - lu(k,265) = lu(k,265) - lu(k,225) * lu(k,263) - lu(k,269) = lu(k,269) - lu(k,226) * lu(k,263) - lu(k,270) = lu(k,270) - lu(k,227) * lu(k,263) - lu(k,271) = lu(k,271) - lu(k,228) * lu(k,263) - lu(k,272) = lu(k,272) - lu(k,229) * lu(k,263) - lu(k,310) = - lu(k,224) * lu(k,309) - lu(k,311) = lu(k,311) - lu(k,225) * lu(k,309) - lu(k,315) = lu(k,315) - lu(k,226) * lu(k,309) - lu(k,317) = lu(k,317) - lu(k,227) * lu(k,309) - lu(k,318) = lu(k,318) - lu(k,228) * lu(k,309) - lu(k,319) = lu(k,319) - lu(k,229) * lu(k,309) - lu(k,880) = lu(k,880) - lu(k,224) * lu(k,879) - lu(k,881) = lu(k,881) - lu(k,225) * lu(k,879) - lu(k,900) = lu(k,900) - lu(k,226) * lu(k,879) - lu(k,908) = lu(k,908) - lu(k,227) * lu(k,879) - lu(k,911) = - lu(k,228) * lu(k,879) - lu(k,912) = lu(k,912) - lu(k,229) * lu(k,879) - lu(k,1228) = lu(k,1228) - lu(k,224) * lu(k,1225) - lu(k,1229) = lu(k,1229) - lu(k,225) * lu(k,1225) - lu(k,1244) = lu(k,1244) - lu(k,226) * lu(k,1225) - lu(k,1252) = lu(k,1252) - lu(k,227) * lu(k,1225) - lu(k,1255) = lu(k,1255) - lu(k,228) * lu(k,1225) - lu(k,1256) = lu(k,1256) - lu(k,229) * lu(k,1225) - lu(k,1402) = lu(k,1402) - lu(k,224) * lu(k,1397) - lu(k,1405) = lu(k,1405) - lu(k,225) * lu(k,1397) - lu(k,1421) = lu(k,1421) - lu(k,226) * lu(k,1397) - lu(k,1429) = lu(k,1429) - lu(k,227) * lu(k,1397) - lu(k,1432) = lu(k,1432) - lu(k,228) * lu(k,1397) - lu(k,1433) = lu(k,1433) - lu(k,229) * lu(k,1397) - lu(k,1540) = lu(k,1540) - lu(k,224) * lu(k,1539) - lu(k,1541) = lu(k,1541) - lu(k,225) * lu(k,1539) - lu(k,1546) = lu(k,1546) - lu(k,226) * lu(k,1539) - lu(k,1554) = lu(k,1554) - lu(k,227) * lu(k,1539) - lu(k,1557) = lu(k,1557) - lu(k,228) * lu(k,1539) - lu(k,1558) = lu(k,1558) - lu(k,229) * lu(k,1539) - lu(k,231) = 1._r8 / lu(k,231) - lu(k,232) = lu(k,232) * lu(k,231) - lu(k,233) = lu(k,233) * lu(k,231) - lu(k,234) = lu(k,234) * lu(k,231) - lu(k,235) = lu(k,235) * lu(k,231) - lu(k,236) = lu(k,236) * lu(k,231) - lu(k,237) = lu(k,237) * lu(k,231) - lu(k,278) = lu(k,278) - lu(k,232) * lu(k,276) - lu(k,281) = lu(k,281) - lu(k,233) * lu(k,276) - lu(k,283) = lu(k,283) - lu(k,234) * lu(k,276) - lu(k,284) = lu(k,284) - lu(k,235) * lu(k,276) - lu(k,285) = lu(k,285) - lu(k,236) * lu(k,276) - lu(k,286) = - lu(k,237) * lu(k,276) - lu(k,748) = lu(k,748) - lu(k,232) * lu(k,739) - lu(k,753) = lu(k,753) - lu(k,233) * lu(k,739) - lu(k,759) = lu(k,759) - lu(k,234) * lu(k,739) - lu(k,760) = lu(k,760) - lu(k,235) * lu(k,739) - lu(k,765) = lu(k,765) - lu(k,236) * lu(k,739) - lu(k,767) = lu(k,767) - lu(k,237) * lu(k,739) - lu(k,794) = lu(k,794) - lu(k,232) * lu(k,781) - lu(k,800) = lu(k,800) - lu(k,233) * lu(k,781) - lu(k,806) = lu(k,806) - lu(k,234) * lu(k,781) - lu(k,807) = lu(k,807) - lu(k,235) * lu(k,781) - lu(k,812) = lu(k,812) - lu(k,236) * lu(k,781) - lu(k,814) = lu(k,814) - lu(k,237) * lu(k,781) - lu(k,1151) = lu(k,1151) - lu(k,232) * lu(k,1137) - lu(k,1160) = lu(k,1160) - lu(k,233) * lu(k,1137) - lu(k,1166) = lu(k,1166) - lu(k,234) * lu(k,1137) - lu(k,1167) = lu(k,1167) - lu(k,235) * lu(k,1137) - lu(k,1174) = lu(k,1174) - lu(k,236) * lu(k,1137) - lu(k,1176) = lu(k,1176) - lu(k,237) * lu(k,1137) - lu(k,1418) = lu(k,1418) - lu(k,232) * lu(k,1398) - lu(k,1427) = lu(k,1427) - lu(k,233) * lu(k,1398) - lu(k,1433) = lu(k,1433) - lu(k,234) * lu(k,1398) - lu(k,1434) = lu(k,1434) - lu(k,235) * lu(k,1398) - lu(k,1441) = lu(k,1441) - lu(k,236) * lu(k,1398) - lu(k,1443) = lu(k,1443) - lu(k,237) * lu(k,1398) - lu(k,1460) = lu(k,1460) - lu(k,232) * lu(k,1447) - lu(k,1469) = lu(k,1469) - lu(k,233) * lu(k,1447) - lu(k,1475) = lu(k,1475) - lu(k,234) * lu(k,1447) - lu(k,1476) = lu(k,1476) - lu(k,235) * lu(k,1447) - lu(k,1483) = lu(k,1483) - lu(k,236) * lu(k,1447) - lu(k,1485) = lu(k,1485) - lu(k,237) * lu(k,1447) - lu(k,1738) = lu(k,1738) - lu(k,232) * lu(k,1724) - lu(k,1747) = lu(k,1747) - lu(k,233) * lu(k,1724) - lu(k,1753) = lu(k,1753) - lu(k,234) * lu(k,1724) - lu(k,1754) = lu(k,1754) - lu(k,235) * lu(k,1724) - lu(k,1761) = lu(k,1761) - lu(k,236) * lu(k,1724) - lu(k,1763) = - lu(k,237) * lu(k,1724) - lu(k,238) = 1._r8 / lu(k,238) - lu(k,239) = lu(k,239) * lu(k,238) - lu(k,240) = lu(k,240) * lu(k,238) - lu(k,241) = lu(k,241) * lu(k,238) - lu(k,242) = lu(k,242) * lu(k,238) - lu(k,243) = lu(k,243) * lu(k,238) - lu(k,244) = lu(k,244) * lu(k,238) - lu(k,245) = lu(k,245) * lu(k,238) - lu(k,454) = lu(k,454) - lu(k,239) * lu(k,453) - lu(k,455) = lu(k,455) - lu(k,240) * lu(k,453) - lu(k,457) = - lu(k,241) * lu(k,453) - lu(k,459) = lu(k,459) - lu(k,242) * lu(k,453) - lu(k,462) = - lu(k,243) * lu(k,453) - lu(k,463) = lu(k,463) - lu(k,244) * lu(k,453) - lu(k,464) = - lu(k,245) * lu(k,453) - lu(k,603) = lu(k,603) - lu(k,239) * lu(k,602) - lu(k,605) = - lu(k,240) * lu(k,602) - lu(k,607) = - lu(k,241) * lu(k,602) - lu(k,609) = lu(k,609) - lu(k,242) * lu(k,602) - lu(k,616) = lu(k,616) - lu(k,243) * lu(k,602) - lu(k,623) = lu(k,623) - lu(k,244) * lu(k,602) - lu(k,624) = lu(k,624) - lu(k,245) * lu(k,602) - lu(k,633) = lu(k,633) - lu(k,239) * lu(k,629) - lu(k,635) = lu(k,635) - lu(k,240) * lu(k,629) - lu(k,637) = lu(k,637) - lu(k,241) * lu(k,629) - lu(k,639) = lu(k,639) - lu(k,242) * lu(k,629) - lu(k,649) = lu(k,649) - lu(k,243) * lu(k,629) - lu(k,656) = lu(k,656) - lu(k,244) * lu(k,629) - lu(k,657) = lu(k,657) - lu(k,245) * lu(k,629) - lu(k,742) = lu(k,742) - lu(k,239) * lu(k,740) - lu(k,744) = lu(k,744) - lu(k,240) * lu(k,740) - lu(k,746) = - lu(k,241) * lu(k,740) - lu(k,748) = lu(k,748) - lu(k,242) * lu(k,740) - lu(k,759) = lu(k,759) - lu(k,243) * lu(k,740) - lu(k,766) = lu(k,766) - lu(k,244) * lu(k,740) - lu(k,767) = lu(k,767) - lu(k,245) * lu(k,740) - lu(k,788) = lu(k,788) - lu(k,239) * lu(k,782) - lu(k,790) = lu(k,790) - lu(k,240) * lu(k,782) - lu(k,792) = lu(k,792) - lu(k,241) * lu(k,782) - lu(k,794) = lu(k,794) - lu(k,242) * lu(k,782) - lu(k,806) = lu(k,806) - lu(k,243) * lu(k,782) - lu(k,813) = lu(k,813) - lu(k,244) * lu(k,782) - lu(k,814) = lu(k,814) - lu(k,245) * lu(k,782) - lu(k,1409) = lu(k,1409) - lu(k,239) * lu(k,1399) - lu(k,1411) = lu(k,1411) - lu(k,240) * lu(k,1399) - lu(k,1413) = lu(k,1413) - lu(k,241) * lu(k,1399) - lu(k,1418) = lu(k,1418) - lu(k,242) * lu(k,1399) - lu(k,1433) = lu(k,1433) - lu(k,243) * lu(k,1399) - lu(k,1442) = lu(k,1442) - lu(k,244) * lu(k,1399) - lu(k,1443) = lu(k,1443) - lu(k,245) * lu(k,1399) - lu(k,246) = 1._r8 / lu(k,246) - lu(k,247) = lu(k,247) * lu(k,246) - lu(k,248) = lu(k,248) * lu(k,246) - lu(k,249) = lu(k,249) * lu(k,246) - lu(k,250) = lu(k,250) * lu(k,246) - lu(k,251) = lu(k,251) * lu(k,246) - lu(k,252) = lu(k,252) * lu(k,246) - lu(k,253) = lu(k,253) * lu(k,246) - lu(k,350) = lu(k,350) - lu(k,247) * lu(k,349) - lu(k,353) = lu(k,353) - lu(k,248) * lu(k,349) - lu(k,354) = lu(k,354) - lu(k,249) * lu(k,349) - lu(k,355) = - lu(k,250) * lu(k,349) - lu(k,356) = lu(k,356) - lu(k,251) * lu(k,349) - lu(k,358) = lu(k,358) - lu(k,252) * lu(k,349) - lu(k,359) = - lu(k,253) * lu(k,349) - lu(k,632) = - lu(k,247) * lu(k,630) - lu(k,644) = lu(k,644) - lu(k,248) * lu(k,630) - lu(k,645) = lu(k,645) - lu(k,249) * lu(k,630) - lu(k,647) = - lu(k,250) * lu(k,630) - lu(k,648) = - lu(k,251) * lu(k,630) - lu(k,652) = - lu(k,252) * lu(k,630) - lu(k,654) = - lu(k,253) * lu(k,630) - lu(k,1181) = - lu(k,247) * lu(k,1179) - lu(k,1202) = lu(k,1202) - lu(k,248) * lu(k,1179) - lu(k,1203) = lu(k,1203) - lu(k,249) * lu(k,1179) - lu(k,1205) = lu(k,1205) - lu(k,250) * lu(k,1179) - lu(k,1206) = - lu(k,251) * lu(k,1179) - lu(k,1210) = lu(k,1210) - lu(k,252) * lu(k,1179) - lu(k,1213) = lu(k,1213) - lu(k,253) * lu(k,1179) - lu(k,1230) = lu(k,1230) - lu(k,247) * lu(k,1226) - lu(k,1251) = lu(k,1251) - lu(k,248) * lu(k,1226) - lu(k,1252) = lu(k,1252) - lu(k,249) * lu(k,1226) - lu(k,1254) = lu(k,1254) - lu(k,250) * lu(k,1226) - lu(k,1255) = lu(k,1255) - lu(k,251) * lu(k,1226) - lu(k,1259) = lu(k,1259) - lu(k,252) * lu(k,1226) - lu(k,1262) = lu(k,1262) - lu(k,253) * lu(k,1226) - lu(k,1309) = - lu(k,247) * lu(k,1307) - lu(k,1325) = lu(k,1325) - lu(k,248) * lu(k,1307) - lu(k,1326) = lu(k,1326) - lu(k,249) * lu(k,1307) - lu(k,1328) = lu(k,1328) - lu(k,250) * lu(k,1307) - lu(k,1329) = lu(k,1329) - lu(k,251) * lu(k,1307) - lu(k,1333) = lu(k,1333) - lu(k,252) * lu(k,1307) - lu(k,1336) = lu(k,1336) - lu(k,253) * lu(k,1307) - lu(k,1406) = lu(k,1406) - lu(k,247) * lu(k,1400) - lu(k,1428) = lu(k,1428) - lu(k,248) * lu(k,1400) - lu(k,1429) = lu(k,1429) - lu(k,249) * lu(k,1400) - lu(k,1431) = lu(k,1431) - lu(k,250) * lu(k,1400) - lu(k,1432) = lu(k,1432) - lu(k,251) * lu(k,1400) - lu(k,1436) = lu(k,1436) - lu(k,252) * lu(k,1400) - lu(k,1439) = lu(k,1439) - lu(k,253) * lu(k,1400) - lu(k,1644) = - lu(k,247) * lu(k,1643) - lu(k,1662) = lu(k,1662) - lu(k,248) * lu(k,1643) - lu(k,1663) = lu(k,1663) - lu(k,249) * lu(k,1643) - lu(k,1665) = - lu(k,250) * lu(k,1643) - lu(k,1666) = - lu(k,251) * lu(k,1643) - lu(k,1670) = lu(k,1670) - lu(k,252) * lu(k,1643) - lu(k,1673) = lu(k,1673) - lu(k,253) * lu(k,1643) + lu(k,243) = 1._r8 / lu(k,243) + lu(k,244) = lu(k,244) * lu(k,243) + lu(k,245) = lu(k,245) * lu(k,243) + lu(k,246) = lu(k,246) * lu(k,243) + lu(k,247) = lu(k,247) * lu(k,243) + lu(k,248) = lu(k,248) * lu(k,243) + lu(k,281) = lu(k,281) - lu(k,244) * lu(k,280) + lu(k,282) = lu(k,282) - lu(k,245) * lu(k,280) + lu(k,283) = lu(k,283) - lu(k,246) * lu(k,280) + lu(k,284) = - lu(k,247) * lu(k,280) + lu(k,285) = lu(k,285) - lu(k,248) * lu(k,280) + lu(k,288) = lu(k,288) - lu(k,244) * lu(k,287) + lu(k,291) = lu(k,291) - lu(k,245) * lu(k,287) + lu(k,292) = lu(k,292) - lu(k,246) * lu(k,287) + lu(k,293) = - lu(k,247) * lu(k,287) + lu(k,296) = lu(k,296) - lu(k,248) * lu(k,287) + lu(k,1045) = lu(k,1045) - lu(k,244) * lu(k,1041) + lu(k,1055) = lu(k,1055) - lu(k,245) * lu(k,1041) + lu(k,1062) = lu(k,1062) - lu(k,246) * lu(k,1041) + lu(k,1064) = lu(k,1064) - lu(k,247) * lu(k,1041) + lu(k,1078) = lu(k,1078) - lu(k,248) * lu(k,1041) + lu(k,1433) = - lu(k,244) * lu(k,1432) + lu(k,1451) = lu(k,1451) - lu(k,245) * lu(k,1432) + lu(k,1458) = lu(k,1458) - lu(k,246) * lu(k,1432) + lu(k,1460) = lu(k,1460) - lu(k,247) * lu(k,1432) + lu(k,1474) = lu(k,1474) - lu(k,248) * lu(k,1432) + lu(k,2039) = lu(k,2039) - lu(k,244) * lu(k,2035) + lu(k,2064) = lu(k,2064) - lu(k,245) * lu(k,2035) + lu(k,2071) = lu(k,2071) - lu(k,246) * lu(k,2035) + lu(k,2073) = lu(k,2073) - lu(k,247) * lu(k,2035) + lu(k,2087) = lu(k,2087) - lu(k,248) * lu(k,2035) + lu(k,249) = 1._r8 / lu(k,249) + lu(k,250) = lu(k,250) * lu(k,249) + lu(k,251) = lu(k,251) * lu(k,249) + lu(k,252) = lu(k,252) * lu(k,249) + lu(k,388) = - lu(k,250) * lu(k,382) + lu(k,389) = - lu(k,251) * lu(k,382) + lu(k,395) = lu(k,395) - lu(k,252) * lu(k,382) + lu(k,418) = lu(k,418) - lu(k,250) * lu(k,411) + lu(k,419) = lu(k,419) - lu(k,251) * lu(k,411) + lu(k,425) = lu(k,425) - lu(k,252) * lu(k,411) + lu(k,583) = lu(k,583) - lu(k,250) * lu(k,577) + lu(k,584) = - lu(k,251) * lu(k,577) + lu(k,589) = - lu(k,252) * lu(k,577) + lu(k,737) = lu(k,737) - lu(k,250) * lu(k,730) + lu(k,738) = lu(k,738) - lu(k,251) * lu(k,730) + lu(k,752) = - lu(k,252) * lu(k,730) + lu(k,980) = lu(k,980) - lu(k,250) * lu(k,962) + lu(k,981) = lu(k,981) - lu(k,251) * lu(k,962) + lu(k,1000) = lu(k,1000) - lu(k,252) * lu(k,962) + lu(k,1092) = lu(k,1092) - lu(k,250) * lu(k,1080) + lu(k,1094) = lu(k,1094) - lu(k,251) * lu(k,1080) + lu(k,1116) = - lu(k,252) * lu(k,1080) + lu(k,1283) = lu(k,1283) - lu(k,250) * lu(k,1259) + lu(k,1285) = lu(k,1285) - lu(k,251) * lu(k,1259) + lu(k,1308) = lu(k,1308) - lu(k,252) * lu(k,1259) + lu(k,1952) = - lu(k,250) * lu(k,1940) + lu(k,1954) = - lu(k,251) * lu(k,1940) + lu(k,1977) = lu(k,1977) - lu(k,252) * lu(k,1940) + lu(k,2000) = lu(k,2000) - lu(k,250) * lu(k,1986) + lu(k,2002) = lu(k,2002) - lu(k,251) * lu(k,1986) + lu(k,2025) = lu(k,2025) - lu(k,252) * lu(k,1986) + lu(k,253) = 1._r8 / lu(k,253) + lu(k,254) = lu(k,254) * lu(k,253) + lu(k,255) = lu(k,255) * lu(k,253) + lu(k,256) = lu(k,256) * lu(k,253) + lu(k,257) = lu(k,257) * lu(k,253) + lu(k,258) = lu(k,258) * lu(k,253) + lu(k,259) = lu(k,259) * lu(k,253) + lu(k,260) = lu(k,260) * lu(k,253) + lu(k,1043) = lu(k,1043) - lu(k,254) * lu(k,1042) + lu(k,1055) = lu(k,1055) - lu(k,255) * lu(k,1042) + lu(k,1057) = lu(k,1057) - lu(k,256) * lu(k,1042) + lu(k,1061) = lu(k,1061) - lu(k,257) * lu(k,1042) + lu(k,1070) = lu(k,1070) - lu(k,258) * lu(k,1042) + lu(k,1076) = lu(k,1076) - lu(k,259) * lu(k,1042) + lu(k,1078) = lu(k,1078) - lu(k,260) * lu(k,1042) + lu(k,1120) = lu(k,1120) - lu(k,254) * lu(k,1119) + lu(k,1143) = lu(k,1143) - lu(k,255) * lu(k,1119) + lu(k,1145) = lu(k,1145) - lu(k,256) * lu(k,1119) + lu(k,1149) = lu(k,1149) - lu(k,257) * lu(k,1119) + lu(k,1158) = lu(k,1158) - lu(k,258) * lu(k,1119) + lu(k,1164) = lu(k,1164) - lu(k,259) * lu(k,1119) + lu(k,1166) = lu(k,1166) - lu(k,260) * lu(k,1119) + lu(k,1942) = lu(k,1942) - lu(k,254) * lu(k,1941) + lu(k,1956) = - lu(k,255) * lu(k,1941) + lu(k,1958) = lu(k,1958) - lu(k,256) * lu(k,1941) + lu(k,1962) = - lu(k,257) * lu(k,1941) + lu(k,1971) = - lu(k,258) * lu(k,1941) + lu(k,1977) = lu(k,1977) - lu(k,259) * lu(k,1941) + lu(k,1979) = - lu(k,260) * lu(k,1941) + lu(k,2037) = lu(k,2037) - lu(k,254) * lu(k,2036) + lu(k,2064) = lu(k,2064) - lu(k,255) * lu(k,2036) + lu(k,2066) = lu(k,2066) - lu(k,256) * lu(k,2036) + lu(k,2070) = lu(k,2070) - lu(k,257) * lu(k,2036) + lu(k,2079) = lu(k,2079) - lu(k,258) * lu(k,2036) + lu(k,2085) = lu(k,2085) - lu(k,259) * lu(k,2036) + lu(k,2087) = lu(k,2087) - lu(k,260) * lu(k,2036) + lu(k,261) = 1._r8 / lu(k,261) + lu(k,262) = lu(k,262) * lu(k,261) + lu(k,263) = lu(k,263) * lu(k,261) + lu(k,264) = lu(k,264) * lu(k,261) + lu(k,265) = lu(k,265) * lu(k,261) + lu(k,266) = lu(k,266) * lu(k,261) + lu(k,267) = lu(k,267) * lu(k,261) + lu(k,1055) = lu(k,1055) - lu(k,262) * lu(k,1043) + lu(k,1057) = lu(k,1057) - lu(k,263) * lu(k,1043) + lu(k,1061) = lu(k,1061) - lu(k,264) * lu(k,1043) + lu(k,1070) = lu(k,1070) - lu(k,265) * lu(k,1043) + lu(k,1076) = lu(k,1076) - lu(k,266) * lu(k,1043) + lu(k,1078) = lu(k,1078) - lu(k,267) * lu(k,1043) + lu(k,1143) = lu(k,1143) - lu(k,262) * lu(k,1120) + lu(k,1145) = lu(k,1145) - lu(k,263) * lu(k,1120) + lu(k,1149) = lu(k,1149) - lu(k,264) * lu(k,1120) + lu(k,1158) = lu(k,1158) - lu(k,265) * lu(k,1120) + lu(k,1164) = lu(k,1164) - lu(k,266) * lu(k,1120) + lu(k,1166) = lu(k,1166) - lu(k,267) * lu(k,1120) + lu(k,1956) = lu(k,1956) - lu(k,262) * lu(k,1942) + lu(k,1958) = lu(k,1958) - lu(k,263) * lu(k,1942) + lu(k,1962) = lu(k,1962) - lu(k,264) * lu(k,1942) + lu(k,1971) = lu(k,1971) - lu(k,265) * lu(k,1942) + lu(k,1977) = lu(k,1977) - lu(k,266) * lu(k,1942) + lu(k,1979) = lu(k,1979) - lu(k,267) * lu(k,1942) + lu(k,2064) = lu(k,2064) - lu(k,262) * lu(k,2037) + lu(k,2066) = lu(k,2066) - lu(k,263) * lu(k,2037) + lu(k,2070) = lu(k,2070) - lu(k,264) * lu(k,2037) + lu(k,2079) = lu(k,2079) - lu(k,265) * lu(k,2037) + lu(k,2085) = lu(k,2085) - lu(k,266) * lu(k,2037) + lu(k,2087) = lu(k,2087) - lu(k,267) * lu(k,2037) + 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,487) = lu(k,487) - lu(k,269) * lu(k,485) + lu(k,491) = lu(k,491) - lu(k,270) * lu(k,485) + lu(k,492) = lu(k,492) - lu(k,271) * lu(k,485) + lu(k,493) = lu(k,493) - lu(k,272) * lu(k,485) + lu(k,497) = lu(k,497) - lu(k,273) * lu(k,485) + lu(k,498) = lu(k,498) - lu(k,274) * lu(k,485) + lu(k,974) = lu(k,974) - lu(k,269) * lu(k,963) + lu(k,981) = lu(k,981) - lu(k,270) * lu(k,963) + lu(k,986) = lu(k,986) - lu(k,271) * lu(k,963) + lu(k,988) = lu(k,988) - lu(k,272) * lu(k,963) + lu(k,996) = lu(k,996) - lu(k,273) * lu(k,963) + lu(k,999) = lu(k,999) - lu(k,274) * lu(k,963) + lu(k,1273) = lu(k,1273) - lu(k,269) * lu(k,1260) + lu(k,1285) = lu(k,1285) - lu(k,270) * lu(k,1260) + lu(k,1292) = lu(k,1292) - lu(k,271) * lu(k,1260) + lu(k,1294) = lu(k,1294) - lu(k,272) * lu(k,1260) + lu(k,1304) = lu(k,1304) - lu(k,273) * lu(k,1260) + lu(k,1307) = lu(k,1307) - lu(k,274) * lu(k,1260) + lu(k,1792) = lu(k,1792) - lu(k,269) * lu(k,1784) + lu(k,1802) = - lu(k,270) * lu(k,1784) + lu(k,1809) = lu(k,1809) - lu(k,271) * lu(k,1784) + lu(k,1811) = lu(k,1811) - lu(k,272) * lu(k,1784) + lu(k,1821) = lu(k,1821) - lu(k,273) * lu(k,1784) + lu(k,1824) = lu(k,1824) - lu(k,274) * lu(k,1784) + lu(k,1902) = lu(k,1902) - lu(k,269) * lu(k,1898) + lu(k,1912) = lu(k,1912) - lu(k,270) * lu(k,1898) + lu(k,1919) = lu(k,1919) - lu(k,271) * lu(k,1898) + lu(k,1921) = lu(k,1921) - lu(k,272) * lu(k,1898) + lu(k,1931) = lu(k,1931) - lu(k,273) * lu(k,1898) + lu(k,1934) = lu(k,1934) - lu(k,274) * lu(k,1898) + lu(k,275) = 1._r8 / lu(k,275) + lu(k,276) = lu(k,276) * lu(k,275) + lu(k,277) = lu(k,277) * lu(k,275) + lu(k,278) = lu(k,278) * lu(k,275) + lu(k,279) = lu(k,279) * lu(k,275) + lu(k,924) = - lu(k,276) * lu(k,919) + lu(k,937) = lu(k,937) - lu(k,277) * lu(k,919) + lu(k,939) = lu(k,939) - lu(k,278) * lu(k,919) + lu(k,945) = lu(k,945) - lu(k,279) * lu(k,919) + lu(k,981) = lu(k,981) - lu(k,276) * lu(k,964) + lu(k,993) = lu(k,993) - lu(k,277) * lu(k,964) + lu(k,994) = lu(k,994) - lu(k,278) * lu(k,964) + lu(k,1002) = lu(k,1002) - lu(k,279) * lu(k,964) + lu(k,1054) = lu(k,1054) - lu(k,276) * lu(k,1044) + lu(k,1068) = - lu(k,277) * lu(k,1044) + lu(k,1070) = lu(k,1070) - lu(k,278) * lu(k,1044) + lu(k,1078) = lu(k,1078) - lu(k,279) * lu(k,1044) + lu(k,1184) = lu(k,1184) - lu(k,276) * lu(k,1168) + lu(k,1199) = lu(k,1199) - lu(k,277) * lu(k,1168) + lu(k,1201) = lu(k,1201) - lu(k,278) * lu(k,1168) + lu(k,1209) = lu(k,1209) - lu(k,279) * lu(k,1168) + lu(k,1225) = lu(k,1225) - lu(k,276) * lu(k,1211) + lu(k,1240) = lu(k,1240) - lu(k,277) * lu(k,1211) + lu(k,1242) = - lu(k,278) * lu(k,1211) + lu(k,1250) = lu(k,1250) - lu(k,279) * lu(k,1211) + lu(k,1494) = lu(k,1494) - lu(k,276) * lu(k,1477) + lu(k,1509) = - lu(k,277) * lu(k,1477) + lu(k,1511) = - lu(k,278) * lu(k,1477) + lu(k,1519) = lu(k,1519) - lu(k,279) * lu(k,1477) + lu(k,1708) = lu(k,1708) - lu(k,276) * lu(k,1692) + lu(k,1723) = lu(k,1723) - lu(k,277) * lu(k,1692) + lu(k,1725) = lu(k,1725) - lu(k,278) * lu(k,1692) + lu(k,1733) = lu(k,1733) - lu(k,279) * lu(k,1692) + lu(k,2062) = lu(k,2062) - lu(k,276) * lu(k,2038) + lu(k,2077) = - lu(k,277) * lu(k,2038) + lu(k,2079) = lu(k,2079) - lu(k,278) * lu(k,2038) + lu(k,2087) = lu(k,2087) - lu(k,279) * lu(k,2038) end do end subroutine lu_fac06 subroutine lu_fac07( avec_len, lu ) @@ -1121,251 +998,208 @@ subroutine lu_fac07( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,255) = 1._r8 / lu(k,255) - lu(k,256) = lu(k,256) * lu(k,255) - lu(k,257) = lu(k,257) * lu(k,255) - lu(k,258) = lu(k,258) * lu(k,255) - lu(k,259) = lu(k,259) * lu(k,255) - lu(k,260) = lu(k,260) * lu(k,255) - lu(k,379) = lu(k,379) - lu(k,256) * lu(k,378) - lu(k,382) = - lu(k,257) * lu(k,378) - lu(k,383) = lu(k,383) - lu(k,258) * lu(k,378) - lu(k,387) = lu(k,387) - lu(k,259) * lu(k,378) - lu(k,392) = - lu(k,260) * lu(k,378) - lu(k,582) = lu(k,582) - lu(k,256) * lu(k,581) - lu(k,587) = lu(k,587) - lu(k,257) * lu(k,581) - lu(k,588) = lu(k,588) - lu(k,258) * lu(k,581) - lu(k,595) = lu(k,595) - lu(k,259) * lu(k,581) - lu(k,600) = lu(k,600) - lu(k,260) * lu(k,581) - lu(k,787) = lu(k,787) - lu(k,256) * lu(k,783) - lu(k,793) = lu(k,793) - lu(k,257) * lu(k,783) - lu(k,794) = lu(k,794) - lu(k,258) * lu(k,783) - lu(k,806) = lu(k,806) - lu(k,259) * lu(k,783) - lu(k,814) = lu(k,814) - lu(k,260) * lu(k,783) - lu(k,972) = lu(k,972) - lu(k,256) * lu(k,968) - lu(k,984) = lu(k,984) - lu(k,257) * lu(k,968) - lu(k,985) = lu(k,985) - lu(k,258) * lu(k,968) - lu(k,1000) = lu(k,1000) - lu(k,259) * lu(k,968) - lu(k,1010) = lu(k,1010) - lu(k,260) * lu(k,968) - lu(k,1098) = - lu(k,256) * lu(k,1096) - lu(k,1107) = lu(k,1107) - lu(k,257) * lu(k,1096) - lu(k,1108) = lu(k,1108) - lu(k,258) * lu(k,1096) - lu(k,1122) = lu(k,1122) - lu(k,259) * lu(k,1096) - lu(k,1132) = - lu(k,260) * lu(k,1096) - lu(k,1182) = lu(k,1182) - lu(k,256) * lu(k,1180) - lu(k,1191) = lu(k,1191) - lu(k,257) * lu(k,1180) - lu(k,1192) = lu(k,1192) - lu(k,258) * lu(k,1180) - lu(k,1207) = lu(k,1207) - lu(k,259) * lu(k,1180) - lu(k,1217) = - lu(k,260) * lu(k,1180) - lu(k,1231) = lu(k,1231) - lu(k,256) * lu(k,1227) - lu(k,1240) = lu(k,1240) - lu(k,257) * lu(k,1227) - lu(k,1241) = lu(k,1241) - lu(k,258) * lu(k,1227) - lu(k,1256) = lu(k,1256) - lu(k,259) * lu(k,1227) - lu(k,1266) = - lu(k,260) * lu(k,1227) - lu(k,1407) = lu(k,1407) - lu(k,256) * lu(k,1401) - lu(k,1417) = lu(k,1417) - lu(k,257) * lu(k,1401) - lu(k,1418) = lu(k,1418) - lu(k,258) * lu(k,1401) - lu(k,1433) = lu(k,1433) - lu(k,259) * lu(k,1401) - lu(k,1443) = lu(k,1443) - lu(k,260) * lu(k,1401) - lu(k,1729) = lu(k,1729) - lu(k,256) * lu(k,1725) - lu(k,1737) = lu(k,1737) - lu(k,257) * lu(k,1725) - lu(k,1738) = lu(k,1738) - lu(k,258) * lu(k,1725) - lu(k,1753) = lu(k,1753) - lu(k,259) * lu(k,1725) - lu(k,1763) = lu(k,1763) - lu(k,260) * lu(k,1725) - lu(k,1817) = - lu(k,256) * lu(k,1813) - lu(k,1830) = - lu(k,257) * lu(k,1813) - lu(k,1831) = lu(k,1831) - lu(k,258) * lu(k,1813) - lu(k,1846) = lu(k,1846) - lu(k,259) * lu(k,1813) - lu(k,1856) = lu(k,1856) - lu(k,260) * lu(k,1813) - lu(k,264) = 1._r8 / lu(k,264) - lu(k,265) = lu(k,265) * lu(k,264) - lu(k,266) = lu(k,266) * lu(k,264) - lu(k,267) = lu(k,267) * lu(k,264) - lu(k,268) = lu(k,268) * lu(k,264) - lu(k,269) = lu(k,269) * lu(k,264) - lu(k,270) = lu(k,270) * lu(k,264) - lu(k,271) = lu(k,271) * lu(k,264) - lu(k,272) = lu(k,272) * lu(k,264) - lu(k,273) = lu(k,273) * lu(k,264) - lu(k,274) = lu(k,274) * lu(k,264) - lu(k,311) = lu(k,311) - lu(k,265) * lu(k,310) - lu(k,312) = - lu(k,266) * lu(k,310) - lu(k,313) = - lu(k,267) * lu(k,310) - lu(k,314) = lu(k,314) - lu(k,268) * lu(k,310) - lu(k,315) = lu(k,315) - lu(k,269) * lu(k,310) - lu(k,317) = lu(k,317) - lu(k,270) * lu(k,310) - lu(k,318) = lu(k,318) - lu(k,271) * lu(k,310) - lu(k,319) = lu(k,319) - lu(k,272) * lu(k,310) - lu(k,320) = lu(k,320) - lu(k,273) * lu(k,310) - lu(k,322) = lu(k,322) - lu(k,274) * lu(k,310) - lu(k,881) = lu(k,881) - lu(k,265) * lu(k,880) - lu(k,892) = lu(k,892) - lu(k,266) * lu(k,880) - lu(k,896) = - lu(k,267) * lu(k,880) - lu(k,897) = lu(k,897) - lu(k,268) * lu(k,880) - lu(k,900) = lu(k,900) - lu(k,269) * lu(k,880) - lu(k,908) = lu(k,908) - lu(k,270) * lu(k,880) - lu(k,911) = lu(k,911) - lu(k,271) * lu(k,880) - lu(k,912) = lu(k,912) - lu(k,272) * lu(k,880) - lu(k,914) = lu(k,914) - lu(k,273) * lu(k,880) - lu(k,921) = - lu(k,274) * lu(k,880) - lu(k,1229) = lu(k,1229) - lu(k,265) * lu(k,1228) - lu(k,1236) = lu(k,1236) - lu(k,266) * lu(k,1228) - lu(k,1240) = lu(k,1240) - lu(k,267) * lu(k,1228) - lu(k,1241) = lu(k,1241) - lu(k,268) * lu(k,1228) - lu(k,1244) = lu(k,1244) - lu(k,269) * lu(k,1228) - lu(k,1252) = lu(k,1252) - lu(k,270) * lu(k,1228) - lu(k,1255) = lu(k,1255) - lu(k,271) * lu(k,1228) - lu(k,1256) = lu(k,1256) - lu(k,272) * lu(k,1228) - lu(k,1258) = lu(k,1258) - lu(k,273) * lu(k,1228) - lu(k,1265) = lu(k,1265) - lu(k,274) * lu(k,1228) - lu(k,1405) = lu(k,1405) - lu(k,265) * lu(k,1402) - lu(k,1413) = lu(k,1413) - lu(k,266) * lu(k,1402) - lu(k,1417) = lu(k,1417) - lu(k,267) * lu(k,1402) - lu(k,1418) = lu(k,1418) - lu(k,268) * lu(k,1402) - lu(k,1421) = lu(k,1421) - lu(k,269) * lu(k,1402) - lu(k,1429) = lu(k,1429) - lu(k,270) * lu(k,1402) - lu(k,1432) = lu(k,1432) - lu(k,271) * lu(k,1402) - lu(k,1433) = lu(k,1433) - lu(k,272) * lu(k,1402) - lu(k,1435) = lu(k,1435) - lu(k,273) * lu(k,1402) - lu(k,1442) = lu(k,1442) - lu(k,274) * lu(k,1402) - lu(k,1541) = lu(k,1541) - lu(k,265) * lu(k,1540) - lu(k,1543) = lu(k,1543) - lu(k,266) * lu(k,1540) - lu(k,1544) = - lu(k,267) * lu(k,1540) - lu(k,1545) = lu(k,1545) - lu(k,268) * lu(k,1540) - lu(k,1546) = lu(k,1546) - lu(k,269) * lu(k,1540) - lu(k,1554) = lu(k,1554) - lu(k,270) * lu(k,1540) - lu(k,1557) = lu(k,1557) - lu(k,271) * lu(k,1540) - lu(k,1558) = lu(k,1558) - lu(k,272) * lu(k,1540) - lu(k,1560) = lu(k,1560) - lu(k,273) * lu(k,1540) - lu(k,1567) = lu(k,1567) - lu(k,274) * lu(k,1540) - lu(k,277) = 1._r8 / lu(k,277) - lu(k,278) = lu(k,278) * lu(k,277) - lu(k,279) = lu(k,279) * lu(k,277) - lu(k,280) = lu(k,280) * lu(k,277) - lu(k,281) = lu(k,281) * lu(k,277) - lu(k,282) = lu(k,282) * lu(k,277) - lu(k,283) = lu(k,283) * lu(k,277) - lu(k,284) = lu(k,284) * lu(k,277) - lu(k,285) = lu(k,285) * lu(k,277) - lu(k,286) = lu(k,286) * lu(k,277) - lu(k,794) = lu(k,794) - lu(k,278) * lu(k,784) - lu(k,796) = lu(k,796) - lu(k,279) * lu(k,784) - lu(k,799) = lu(k,799) - lu(k,280) * lu(k,784) - lu(k,800) = lu(k,800) - lu(k,281) * lu(k,784) - lu(k,803) = lu(k,803) - lu(k,282) * lu(k,784) - lu(k,806) = lu(k,806) - lu(k,283) * lu(k,784) - lu(k,807) = lu(k,807) - lu(k,284) * lu(k,784) - lu(k,812) = lu(k,812) - lu(k,285) * lu(k,784) - lu(k,814) = lu(k,814) - lu(k,286) * lu(k,784) - lu(k,985) = lu(k,985) - lu(k,278) * lu(k,969) - lu(k,990) = lu(k,990) - lu(k,279) * lu(k,969) - lu(k,993) = lu(k,993) - lu(k,280) * lu(k,969) - lu(k,994) = lu(k,994) - lu(k,281) * lu(k,969) - lu(k,997) = lu(k,997) - lu(k,282) * lu(k,969) - lu(k,1000) = lu(k,1000) - lu(k,283) * lu(k,969) - lu(k,1001) = lu(k,1001) - lu(k,284) * lu(k,969) - lu(k,1008) = lu(k,1008) - lu(k,285) * lu(k,969) - lu(k,1010) = lu(k,1010) - lu(k,286) * lu(k,969) - lu(k,1151) = lu(k,1151) - lu(k,278) * lu(k,1138) - lu(k,1156) = lu(k,1156) - lu(k,279) * lu(k,1138) - lu(k,1159) = - lu(k,280) * lu(k,1138) - lu(k,1160) = lu(k,1160) - lu(k,281) * lu(k,1138) - lu(k,1163) = lu(k,1163) - lu(k,282) * lu(k,1138) - lu(k,1166) = lu(k,1166) - lu(k,283) * lu(k,1138) - lu(k,1167) = lu(k,1167) - lu(k,284) * lu(k,1138) - lu(k,1174) = lu(k,1174) - lu(k,285) * lu(k,1138) - lu(k,1176) = lu(k,1176) - lu(k,286) * lu(k,1138) - lu(k,1418) = lu(k,1418) - lu(k,278) * lu(k,1403) - lu(k,1423) = lu(k,1423) - lu(k,279) * lu(k,1403) - lu(k,1426) = lu(k,1426) - lu(k,280) * lu(k,1403) - lu(k,1427) = lu(k,1427) - lu(k,281) * lu(k,1403) - lu(k,1430) = lu(k,1430) - lu(k,282) * lu(k,1403) - lu(k,1433) = lu(k,1433) - lu(k,283) * lu(k,1403) - lu(k,1434) = lu(k,1434) - lu(k,284) * lu(k,1403) - lu(k,1441) = lu(k,1441) - lu(k,285) * lu(k,1403) - lu(k,1443) = lu(k,1443) - lu(k,286) * lu(k,1403) - lu(k,1460) = lu(k,1460) - lu(k,278) * lu(k,1448) - lu(k,1465) = lu(k,1465) - lu(k,279) * lu(k,1448) - lu(k,1468) = lu(k,1468) - lu(k,280) * lu(k,1448) - lu(k,1469) = lu(k,1469) - lu(k,281) * lu(k,1448) - lu(k,1472) = - lu(k,282) * lu(k,1448) - lu(k,1475) = lu(k,1475) - lu(k,283) * lu(k,1448) - lu(k,1476) = lu(k,1476) - lu(k,284) * lu(k,1448) - lu(k,1483) = lu(k,1483) - lu(k,285) * lu(k,1448) - lu(k,1485) = lu(k,1485) - lu(k,286) * lu(k,1448) - lu(k,1738) = lu(k,1738) - lu(k,278) * lu(k,1726) - lu(k,1743) = lu(k,1743) - lu(k,279) * lu(k,1726) - lu(k,1746) = lu(k,1746) - lu(k,280) * lu(k,1726) - lu(k,1747) = lu(k,1747) - lu(k,281) * lu(k,1726) - lu(k,1750) = - lu(k,282) * lu(k,1726) - lu(k,1753) = lu(k,1753) - lu(k,283) * lu(k,1726) - lu(k,1754) = lu(k,1754) - lu(k,284) * lu(k,1726) - lu(k,1761) = lu(k,1761) - lu(k,285) * lu(k,1726) - lu(k,1763) = lu(k,1763) - lu(k,286) * lu(k,1726) - lu(k,287) = 1._r8 / lu(k,287) - lu(k,288) = lu(k,288) * lu(k,287) - lu(k,289) = lu(k,289) * lu(k,287) - lu(k,290) = lu(k,290) * lu(k,287) - lu(k,291) = lu(k,291) * lu(k,287) - lu(k,292) = lu(k,292) * lu(k,287) - lu(k,293) = lu(k,293) * lu(k,287) - lu(k,294) = lu(k,294) * lu(k,287) - lu(k,661) = lu(k,661) - lu(k,288) * lu(k,658) - lu(k,666) = - lu(k,289) * lu(k,658) - lu(k,669) = - lu(k,290) * lu(k,658) - lu(k,674) = lu(k,674) - lu(k,291) * lu(k,658) - lu(k,677) = lu(k,677) - lu(k,292) * lu(k,658) - lu(k,678) = lu(k,678) - lu(k,293) * lu(k,658) - lu(k,679) = lu(k,679) - lu(k,294) * lu(k,658) - lu(k,819) = lu(k,819) - lu(k,288) * lu(k,815) - lu(k,823) = lu(k,823) - lu(k,289) * lu(k,815) - lu(k,826) = lu(k,826) - lu(k,290) * lu(k,815) - lu(k,832) = lu(k,832) - lu(k,291) * lu(k,815) - lu(k,836) = lu(k,836) - lu(k,292) * lu(k,815) - lu(k,837) = lu(k,837) - lu(k,293) * lu(k,815) - lu(k,838) = lu(k,838) - lu(k,294) * lu(k,815) - lu(k,1312) = lu(k,1312) - lu(k,288) * lu(k,1308) - lu(k,1317) = lu(k,1317) - lu(k,289) * lu(k,1308) - lu(k,1320) = lu(k,1320) - lu(k,290) * lu(k,1308) - lu(k,1326) = lu(k,1326) - lu(k,291) * lu(k,1308) - lu(k,1330) = lu(k,1330) - lu(k,292) * lu(k,1308) - lu(k,1331) = lu(k,1331) - lu(k,293) * lu(k,1308) - lu(k,1332) = lu(k,1332) - lu(k,294) * lu(k,1308) - lu(k,1415) = lu(k,1415) - lu(k,288) * lu(k,1404) - lu(k,1420) = lu(k,1420) - lu(k,289) * lu(k,1404) - lu(k,1423) = lu(k,1423) - lu(k,290) * lu(k,1404) - lu(k,1429) = lu(k,1429) - lu(k,291) * lu(k,1404) - lu(k,1433) = lu(k,1433) - lu(k,292) * lu(k,1404) - lu(k,1434) = lu(k,1434) - lu(k,293) * lu(k,1404) - lu(k,1435) = lu(k,1435) - lu(k,294) * lu(k,1404) - lu(k,1457) = lu(k,1457) - lu(k,288) * lu(k,1449) - lu(k,1462) = lu(k,1462) - lu(k,289) * lu(k,1449) - lu(k,1465) = lu(k,1465) - lu(k,290) * lu(k,1449) - lu(k,1471) = lu(k,1471) - lu(k,291) * lu(k,1449) - lu(k,1475) = lu(k,1475) - lu(k,292) * lu(k,1449) - lu(k,1476) = lu(k,1476) - lu(k,293) * lu(k,1449) - lu(k,1477) = - lu(k,294) * lu(k,1449) - lu(k,1498) = lu(k,1498) - lu(k,288) * lu(k,1487) - lu(k,1503) = lu(k,1503) - lu(k,289) * lu(k,1487) - lu(k,1506) = lu(k,1506) - lu(k,290) * lu(k,1487) - lu(k,1512) = lu(k,1512) - lu(k,291) * lu(k,1487) - lu(k,1516) = lu(k,1516) - lu(k,292) * lu(k,1487) - lu(k,1517) = lu(k,1517) - lu(k,293) * lu(k,1487) - lu(k,1518) = lu(k,1518) - lu(k,294) * lu(k,1487) - lu(k,1614) = lu(k,1614) - lu(k,288) * lu(k,1611) - lu(k,1619) = lu(k,1619) - lu(k,289) * lu(k,1611) - lu(k,1622) = lu(k,1622) - lu(k,290) * lu(k,1611) - lu(k,1628) = - lu(k,291) * lu(k,1611) - lu(k,1632) = lu(k,1632) - lu(k,292) * lu(k,1611) - lu(k,1633) = lu(k,1633) - lu(k,293) * lu(k,1611) - lu(k,1634) = - lu(k,294) * lu(k,1611) - lu(k,1735) = lu(k,1735) - lu(k,288) * lu(k,1727) - lu(k,1740) = lu(k,1740) - lu(k,289) * lu(k,1727) - lu(k,1743) = lu(k,1743) - lu(k,290) * lu(k,1727) - lu(k,1749) = lu(k,1749) - lu(k,291) * lu(k,1727) - lu(k,1753) = lu(k,1753) - lu(k,292) * lu(k,1727) - lu(k,1754) = lu(k,1754) - lu(k,293) * lu(k,1727) - lu(k,1755) = lu(k,1755) - lu(k,294) * lu(k,1727) + lu(k,281) = 1._r8 / lu(k,281) + lu(k,282) = lu(k,282) * lu(k,281) + lu(k,283) = lu(k,283) * lu(k,281) + lu(k,284) = lu(k,284) * lu(k,281) + lu(k,285) = lu(k,285) * lu(k,281) + lu(k,291) = lu(k,291) - lu(k,282) * lu(k,288) + lu(k,292) = lu(k,292) - lu(k,283) * lu(k,288) + lu(k,293) = lu(k,293) - lu(k,284) * lu(k,288) + lu(k,296) = lu(k,296) - lu(k,285) * lu(k,288) + lu(k,899) = - lu(k,282) * lu(k,887) + lu(k,904) = lu(k,904) - lu(k,283) * lu(k,887) + lu(k,905) = - lu(k,284) * lu(k,887) + lu(k,918) = lu(k,918) - lu(k,285) * lu(k,887) + lu(k,982) = - lu(k,282) * lu(k,965) + lu(k,988) = lu(k,988) - lu(k,283) * lu(k,965) + lu(k,989) = - lu(k,284) * lu(k,965) + lu(k,1002) = lu(k,1002) - lu(k,285) * lu(k,965) + lu(k,1055) = lu(k,1055) - lu(k,282) * lu(k,1045) + lu(k,1062) = lu(k,1062) - lu(k,283) * lu(k,1045) + lu(k,1064) = lu(k,1064) - lu(k,284) * lu(k,1045) + lu(k,1078) = lu(k,1078) - lu(k,285) * lu(k,1045) + lu(k,1329) = lu(k,1329) - lu(k,282) * lu(k,1311) + lu(k,1336) = lu(k,1336) - lu(k,283) * lu(k,1311) + lu(k,1338) = - lu(k,284) * lu(k,1311) + lu(k,1352) = lu(k,1352) - lu(k,285) * lu(k,1311) + lu(k,1365) = lu(k,1365) - lu(k,282) * lu(k,1353) + lu(k,1372) = lu(k,1372) - lu(k,283) * lu(k,1353) + lu(k,1374) = - lu(k,284) * lu(k,1353) + lu(k,1388) = lu(k,1388) - lu(k,285) * lu(k,1353) + lu(k,1451) = lu(k,1451) - lu(k,282) * lu(k,1433) + lu(k,1458) = lu(k,1458) - lu(k,283) * lu(k,1433) + lu(k,1460) = lu(k,1460) - lu(k,284) * lu(k,1433) + lu(k,1474) = lu(k,1474) - lu(k,285) * lu(k,1433) + lu(k,2064) = lu(k,2064) - lu(k,282) * lu(k,2039) + lu(k,2071) = lu(k,2071) - lu(k,283) * lu(k,2039) + lu(k,2073) = lu(k,2073) - lu(k,284) * lu(k,2039) + lu(k,2087) = lu(k,2087) - lu(k,285) * lu(k,2039) + lu(k,289) = 1._r8 / lu(k,289) + lu(k,290) = lu(k,290) * lu(k,289) + lu(k,291) = lu(k,291) * lu(k,289) + lu(k,292) = lu(k,292) * lu(k,289) + lu(k,293) = lu(k,293) * lu(k,289) + lu(k,294) = lu(k,294) * lu(k,289) + lu(k,295) = lu(k,295) * lu(k,289) + lu(k,296) = lu(k,296) * lu(k,289) + lu(k,459) = - lu(k,290) * lu(k,456) + lu(k,460) = lu(k,460) - lu(k,291) * lu(k,456) + lu(k,462) = - lu(k,292) * lu(k,456) + lu(k,463) = - lu(k,293) * lu(k,456) + lu(k,465) = lu(k,465) - lu(k,294) * lu(k,456) + lu(k,466) = lu(k,466) - lu(k,295) * lu(k,456) + lu(k,469) = lu(k,469) - lu(k,296) * lu(k,456) + lu(k,1054) = lu(k,1054) - lu(k,290) * lu(k,1046) + lu(k,1055) = lu(k,1055) - lu(k,291) * lu(k,1046) + lu(k,1062) = lu(k,1062) - lu(k,292) * lu(k,1046) + lu(k,1064) = lu(k,1064) - lu(k,293) * lu(k,1046) + lu(k,1067) = lu(k,1067) - lu(k,294) * lu(k,1046) + lu(k,1072) = lu(k,1072) - lu(k,295) * lu(k,1046) + lu(k,1078) = lu(k,1078) - lu(k,296) * lu(k,1046) + lu(k,1575) = lu(k,1575) - lu(k,290) * lu(k,1556) + lu(k,1577) = lu(k,1577) - lu(k,291) * lu(k,1556) + lu(k,1584) = - lu(k,292) * lu(k,1556) + lu(k,1586) = - lu(k,293) * lu(k,1556) + lu(k,1589) = lu(k,1589) - lu(k,294) * lu(k,1556) + lu(k,1594) = lu(k,1594) - lu(k,295) * lu(k,1556) + lu(k,1600) = lu(k,1600) - lu(k,296) * lu(k,1556) + lu(k,2062) = lu(k,2062) - lu(k,290) * lu(k,2040) + lu(k,2064) = lu(k,2064) - lu(k,291) * lu(k,2040) + lu(k,2071) = lu(k,2071) - lu(k,292) * lu(k,2040) + lu(k,2073) = lu(k,2073) - lu(k,293) * lu(k,2040) + lu(k,2076) = lu(k,2076) - lu(k,294) * lu(k,2040) + lu(k,2081) = lu(k,2081) - lu(k,295) * lu(k,2040) + lu(k,2087) = lu(k,2087) - lu(k,296) * lu(k,2040) + lu(k,297) = 1._r8 / lu(k,297) + lu(k,298) = lu(k,298) * lu(k,297) + lu(k,299) = lu(k,299) * lu(k,297) + lu(k,300) = lu(k,300) * lu(k,297) + lu(k,301) = lu(k,301) * lu(k,297) + lu(k,302) = lu(k,302) * lu(k,297) + lu(k,303) = lu(k,303) * lu(k,297) + lu(k,304) = lu(k,304) * lu(k,297) + lu(k,384) = lu(k,384) - lu(k,298) * lu(k,383) + lu(k,385) = lu(k,385) - lu(k,299) * lu(k,383) + lu(k,386) = lu(k,386) - lu(k,300) * lu(k,383) + lu(k,387) = - lu(k,301) * lu(k,383) + lu(k,391) = lu(k,391) - lu(k,302) * lu(k,383) + lu(k,393) = - lu(k,303) * lu(k,383) + lu(k,394) = lu(k,394) - lu(k,304) * lu(k,383) + lu(k,1048) = lu(k,1048) - lu(k,298) * lu(k,1047) + lu(k,1049) = lu(k,1049) - lu(k,299) * lu(k,1047) + lu(k,1050) = lu(k,1050) - lu(k,300) * lu(k,1047) + lu(k,1052) = lu(k,1052) - lu(k,301) * lu(k,1047) + lu(k,1060) = lu(k,1060) - lu(k,302) * lu(k,1047) + lu(k,1070) = lu(k,1070) - lu(k,303) * lu(k,1047) + lu(k,1072) = lu(k,1072) - lu(k,304) * lu(k,1047) + lu(k,1122) = - lu(k,298) * lu(k,1121) + lu(k,1123) = - lu(k,299) * lu(k,1121) + lu(k,1124) = lu(k,1124) - lu(k,300) * lu(k,1121) + lu(k,1135) = - lu(k,301) * lu(k,1121) + lu(k,1148) = lu(k,1148) - lu(k,302) * lu(k,1121) + lu(k,1158) = lu(k,1158) - lu(k,303) * lu(k,1121) + lu(k,1160) = lu(k,1160) - lu(k,304) * lu(k,1121) + lu(k,1263) = lu(k,1263) - lu(k,298) * lu(k,1261) + lu(k,1270) = lu(k,1270) - lu(k,299) * lu(k,1261) + lu(k,1271) = lu(k,1271) - lu(k,300) * lu(k,1261) + lu(k,1279) = - lu(k,301) * lu(k,1261) + lu(k,1292) = lu(k,1292) - lu(k,302) * lu(k,1261) + lu(k,1302) = lu(k,1302) - lu(k,303) * lu(k,1261) + lu(k,1304) = lu(k,1304) - lu(k,304) * lu(k,1261) + lu(k,1786) = lu(k,1786) - lu(k,298) * lu(k,1785) + lu(k,1789) = lu(k,1789) - lu(k,299) * lu(k,1785) + lu(k,1790) = lu(k,1790) - lu(k,300) * lu(k,1785) + lu(k,1797) = lu(k,1797) - lu(k,301) * lu(k,1785) + lu(k,1809) = lu(k,1809) - lu(k,302) * lu(k,1785) + lu(k,1819) = lu(k,1819) - lu(k,303) * lu(k,1785) + lu(k,1821) = lu(k,1821) - lu(k,304) * lu(k,1785) + lu(k,306) = 1._r8 / lu(k,306) + lu(k,307) = lu(k,307) * lu(k,306) + lu(k,308) = lu(k,308) * lu(k,306) + lu(k,309) = lu(k,309) * lu(k,306) + lu(k,310) = lu(k,310) * lu(k,306) + lu(k,311) = lu(k,311) * lu(k,306) + lu(k,312) = lu(k,312) * lu(k,306) + lu(k,313) = lu(k,313) * lu(k,306) + lu(k,711) = lu(k,711) - lu(k,307) * lu(k,708) + lu(k,712) = lu(k,712) - lu(k,308) * lu(k,708) + lu(k,716) = lu(k,716) - lu(k,309) * lu(k,708) + lu(k,719) = lu(k,719) - lu(k,310) * lu(k,708) + lu(k,721) = - lu(k,311) * lu(k,708) + lu(k,728) = lu(k,728) - lu(k,312) * lu(k,708) + lu(k,729) = - lu(k,313) * lu(k,708) + lu(k,892) = lu(k,892) - lu(k,307) * lu(k,888) + lu(k,894) = lu(k,894) - lu(k,308) * lu(k,888) + lu(k,898) = lu(k,898) - lu(k,309) * lu(k,888) + lu(k,902) = lu(k,902) - lu(k,310) * lu(k,888) + lu(k,906) = lu(k,906) - lu(k,311) * lu(k,888) + lu(k,917) = lu(k,917) - lu(k,312) * lu(k,888) + lu(k,918) = lu(k,918) - lu(k,313) * lu(k,888) + lu(k,1274) = lu(k,1274) - lu(k,307) * lu(k,1262) + lu(k,1277) = lu(k,1277) - lu(k,308) * lu(k,1262) + lu(k,1285) = lu(k,1285) - lu(k,309) * lu(k,1262) + lu(k,1292) = lu(k,1292) - lu(k,310) * lu(k,1262) + lu(k,1297) = lu(k,1297) - lu(k,311) * lu(k,1262) + lu(k,1309) = lu(k,1309) - lu(k,312) * lu(k,1262) + lu(k,1310) = lu(k,1310) - lu(k,313) * lu(k,1262) + lu(k,1484) = lu(k,1484) - lu(k,307) * lu(k,1478) + lu(k,1486) = - lu(k,308) * lu(k,1478) + lu(k,1494) = lu(k,1494) - lu(k,309) * lu(k,1478) + lu(k,1501) = lu(k,1501) - lu(k,310) * lu(k,1478) + lu(k,1506) = lu(k,1506) - lu(k,311) * lu(k,1478) + lu(k,1518) = lu(k,1518) - lu(k,312) * lu(k,1478) + lu(k,1519) = lu(k,1519) - lu(k,313) * lu(k,1478) + lu(k,1610) = lu(k,1610) - lu(k,307) * lu(k,1604) + lu(k,1616) = lu(k,1616) - lu(k,308) * lu(k,1604) + lu(k,1623) = lu(k,1623) - lu(k,309) * lu(k,1604) + lu(k,1630) = lu(k,1630) - lu(k,310) * lu(k,1604) + lu(k,1635) = - lu(k,311) * lu(k,1604) + lu(k,1647) = lu(k,1647) - lu(k,312) * lu(k,1604) + lu(k,1648) = lu(k,1648) - lu(k,313) * lu(k,1604) + lu(k,314) = 1._r8 / lu(k,314) + lu(k,315) = lu(k,315) * lu(k,314) + lu(k,316) = lu(k,316) * lu(k,314) + lu(k,317) = lu(k,317) * lu(k,314) + lu(k,318) = lu(k,318) * lu(k,314) + lu(k,319) = lu(k,319) * lu(k,314) + lu(k,320) = lu(k,320) * lu(k,314) + lu(k,385) = lu(k,385) - lu(k,315) * lu(k,384) + lu(k,386) = lu(k,386) - lu(k,316) * lu(k,384) + lu(k,390) = lu(k,390) - lu(k,317) * lu(k,384) + lu(k,391) = lu(k,391) - lu(k,318) * lu(k,384) + lu(k,392) = lu(k,392) - lu(k,319) * lu(k,384) + lu(k,394) = lu(k,394) - lu(k,320) * lu(k,384) + lu(k,442) = - lu(k,315) * lu(k,441) + lu(k,443) = lu(k,443) - lu(k,316) * lu(k,441) + lu(k,448) = lu(k,448) - lu(k,317) * lu(k,441) + lu(k,449) = lu(k,449) - lu(k,318) * lu(k,441) + lu(k,451) = lu(k,451) - lu(k,319) * lu(k,441) + lu(k,454) = lu(k,454) - lu(k,320) * lu(k,441) + lu(k,1049) = lu(k,1049) - lu(k,315) * lu(k,1048) + lu(k,1050) = lu(k,1050) - lu(k,316) * lu(k,1048) + lu(k,1057) = lu(k,1057) - lu(k,317) * lu(k,1048) + lu(k,1060) = lu(k,1060) - lu(k,318) * lu(k,1048) + lu(k,1067) = lu(k,1067) - lu(k,319) * lu(k,1048) + lu(k,1072) = lu(k,1072) - lu(k,320) * lu(k,1048) + lu(k,1123) = lu(k,1123) - lu(k,315) * lu(k,1122) + lu(k,1124) = lu(k,1124) - lu(k,316) * lu(k,1122) + lu(k,1145) = lu(k,1145) - lu(k,317) * lu(k,1122) + lu(k,1148) = lu(k,1148) - lu(k,318) * lu(k,1122) + lu(k,1155) = - lu(k,319) * lu(k,1122) + lu(k,1160) = lu(k,1160) - lu(k,320) * lu(k,1122) + lu(k,1270) = lu(k,1270) - lu(k,315) * lu(k,1263) + lu(k,1271) = lu(k,1271) - lu(k,316) * lu(k,1263) + lu(k,1289) = lu(k,1289) - lu(k,317) * lu(k,1263) + lu(k,1292) = lu(k,1292) - lu(k,318) * lu(k,1263) + lu(k,1299) = lu(k,1299) - lu(k,319) * lu(k,1263) + lu(k,1304) = lu(k,1304) - lu(k,320) * lu(k,1263) + lu(k,1789) = lu(k,1789) - lu(k,315) * lu(k,1786) + lu(k,1790) = lu(k,1790) - lu(k,316) * lu(k,1786) + lu(k,1806) = lu(k,1806) - lu(k,317) * lu(k,1786) + lu(k,1809) = lu(k,1809) - lu(k,318) * lu(k,1786) + lu(k,1816) = lu(k,1816) - lu(k,319) * lu(k,1786) + lu(k,1821) = lu(k,1821) - lu(k,320) * lu(k,1786) end do end subroutine lu_fac07 subroutine lu_fac08( avec_len, lu ) @@ -1382,285 +1216,218 @@ subroutine lu_fac08( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,297) = 1._r8 / lu(k,297) - lu(k,298) = lu(k,298) * lu(k,297) - lu(k,299) = lu(k,299) * lu(k,297) - lu(k,300) = lu(k,300) * lu(k,297) - lu(k,301) = lu(k,301) * lu(k,297) - lu(k,302) = lu(k,302) * lu(k,297) - lu(k,303) = lu(k,303) * lu(k,297) - lu(k,304) = lu(k,304) * lu(k,297) - lu(k,305) = lu(k,305) * lu(k,297) - lu(k,306) = lu(k,306) * lu(k,297) - lu(k,307) = lu(k,307) * lu(k,297) - lu(k,308) = lu(k,308) * lu(k,297) - lu(k,518) = lu(k,518) - lu(k,298) * lu(k,517) - lu(k,519) = lu(k,519) - lu(k,299) * lu(k,517) - lu(k,520) = lu(k,520) - lu(k,300) * lu(k,517) - lu(k,524) = - lu(k,301) * lu(k,517) - lu(k,527) = lu(k,527) - lu(k,302) * lu(k,517) - lu(k,529) = lu(k,529) - lu(k,303) * lu(k,517) - lu(k,531) = - lu(k,304) * lu(k,517) - lu(k,532) = lu(k,532) - lu(k,305) * lu(k,517) - lu(k,533) = lu(k,533) - lu(k,306) * lu(k,517) - lu(k,534) = lu(k,534) - lu(k,307) * lu(k,517) - lu(k,536) = lu(k,536) - lu(k,308) * lu(k,517) - lu(k,558) = lu(k,558) - lu(k,298) * lu(k,557) - lu(k,559) = lu(k,559) - lu(k,299) * lu(k,557) - lu(k,560) = lu(k,560) - lu(k,300) * lu(k,557) - lu(k,564) = - lu(k,301) * lu(k,557) - lu(k,567) = lu(k,567) - lu(k,302) * lu(k,557) - lu(k,569) = lu(k,569) - lu(k,303) * lu(k,557) - lu(k,571) = - lu(k,304) * lu(k,557) - lu(k,572) = lu(k,572) - lu(k,305) * lu(k,557) - lu(k,573) = lu(k,573) - lu(k,306) * lu(k,557) - lu(k,574) = lu(k,574) - lu(k,307) * lu(k,557) - lu(k,576) = lu(k,576) - lu(k,308) * lu(k,557) - lu(k,975) = - lu(k,298) * lu(k,970) - lu(k,976) = - lu(k,299) * lu(k,970) - lu(k,978) = lu(k,978) - lu(k,300) * lu(k,970) - lu(k,990) = lu(k,990) - lu(k,301) * lu(k,970) - lu(k,993) = lu(k,993) - lu(k,302) * lu(k,970) - lu(k,997) = lu(k,997) - lu(k,303) * lu(k,970) - lu(k,1000) = lu(k,1000) - lu(k,304) * lu(k,970) - lu(k,1002) = lu(k,1002) - lu(k,305) * lu(k,970) - lu(k,1004) = - lu(k,306) * lu(k,970) - lu(k,1007) = - lu(k,307) * lu(k,970) - lu(k,1010) = lu(k,1010) - lu(k,308) * lu(k,970) - lu(k,1100) = - lu(k,298) * lu(k,1097) - lu(k,1101) = - lu(k,299) * lu(k,1097) - lu(k,1102) = - lu(k,300) * lu(k,1097) - lu(k,1112) = lu(k,1112) - lu(k,301) * lu(k,1097) - lu(k,1115) = lu(k,1115) - lu(k,302) * lu(k,1097) - lu(k,1119) = lu(k,1119) - lu(k,303) * lu(k,1097) - lu(k,1122) = lu(k,1122) - lu(k,304) * lu(k,1097) - lu(k,1124) = lu(k,1124) - lu(k,305) * lu(k,1097) - lu(k,1126) = - lu(k,306) * lu(k,1097) - lu(k,1129) = - lu(k,307) * lu(k,1097) - lu(k,1132) = lu(k,1132) - lu(k,308) * lu(k,1097) - lu(k,1577) = lu(k,1577) - lu(k,298) * lu(k,1570) - lu(k,1578) = lu(k,1578) - lu(k,299) * lu(k,1570) - lu(k,1580) = lu(k,1580) - lu(k,300) * lu(k,1570) - lu(k,1590) = lu(k,1590) - lu(k,301) * lu(k,1570) - lu(k,1593) = lu(k,1593) - lu(k,302) * lu(k,1570) - lu(k,1597) = lu(k,1597) - lu(k,303) * lu(k,1570) - lu(k,1600) = lu(k,1600) - lu(k,304) * lu(k,1570) - lu(k,1602) = - lu(k,305) * lu(k,1570) - lu(k,1604) = lu(k,1604) - lu(k,306) * lu(k,1570) - lu(k,1607) = lu(k,1607) - lu(k,307) * lu(k,1570) - lu(k,1610) = lu(k,1610) - lu(k,308) * lu(k,1570) - lu(k,1686) = lu(k,1686) - lu(k,298) * lu(k,1679) - lu(k,1687) = lu(k,1687) - lu(k,299) * lu(k,1679) - lu(k,1689) = lu(k,1689) - lu(k,300) * lu(k,1679) - lu(k,1699) = lu(k,1699) - lu(k,301) * lu(k,1679) - lu(k,1702) = lu(k,1702) - lu(k,302) * lu(k,1679) - lu(k,1706) = lu(k,1706) - lu(k,303) * lu(k,1679) - lu(k,1709) = lu(k,1709) - lu(k,304) * lu(k,1679) - lu(k,1711) = - lu(k,305) * lu(k,1679) - lu(k,1713) = lu(k,1713) - lu(k,306) * lu(k,1679) - lu(k,1716) = lu(k,1716) - lu(k,307) * lu(k,1679) - lu(k,1719) = lu(k,1719) - lu(k,308) * lu(k,1679) - lu(k,311) = 1._r8 / lu(k,311) - lu(k,312) = lu(k,312) * lu(k,311) - lu(k,313) = lu(k,313) * lu(k,311) - lu(k,314) = lu(k,314) * lu(k,311) - lu(k,315) = lu(k,315) * lu(k,311) - lu(k,316) = lu(k,316) * lu(k,311) - lu(k,317) = lu(k,317) * lu(k,311) - lu(k,318) = lu(k,318) * lu(k,311) - lu(k,319) = lu(k,319) * lu(k,311) - lu(k,320) = lu(k,320) * lu(k,311) - lu(k,321) = lu(k,321) * lu(k,311) - lu(k,322) = lu(k,322) * lu(k,311) - lu(k,792) = lu(k,792) - lu(k,312) * lu(k,785) - lu(k,793) = lu(k,793) - lu(k,313) * lu(k,785) - lu(k,794) = lu(k,794) - lu(k,314) * lu(k,785) - lu(k,795) = - lu(k,315) * lu(k,785) - lu(k,796) = lu(k,796) - lu(k,316) * lu(k,785) - lu(k,802) = lu(k,802) - lu(k,317) * lu(k,785) - lu(k,805) = - lu(k,318) * lu(k,785) - lu(k,806) = lu(k,806) - lu(k,319) * lu(k,785) - lu(k,808) = lu(k,808) - lu(k,320) * lu(k,785) - lu(k,809) = lu(k,809) - lu(k,321) * lu(k,785) - lu(k,813) = lu(k,813) - lu(k,322) * lu(k,785) - lu(k,892) = lu(k,892) - lu(k,312) * lu(k,881) - lu(k,896) = lu(k,896) - lu(k,313) * lu(k,881) - lu(k,897) = lu(k,897) - lu(k,314) * lu(k,881) - lu(k,900) = lu(k,900) - lu(k,315) * lu(k,881) - lu(k,902) = lu(k,902) - lu(k,316) * lu(k,881) - lu(k,908) = lu(k,908) - lu(k,317) * lu(k,881) - lu(k,911) = lu(k,911) - lu(k,318) * lu(k,881) - lu(k,912) = lu(k,912) - lu(k,319) * lu(k,881) - lu(k,914) = lu(k,914) - lu(k,320) * lu(k,881) - lu(k,915) = lu(k,915) - lu(k,321) * lu(k,881) - lu(k,921) = lu(k,921) - lu(k,322) * lu(k,881) - lu(k,981) = - lu(k,312) * lu(k,971) - lu(k,984) = lu(k,984) - lu(k,313) * lu(k,971) - lu(k,985) = lu(k,985) - lu(k,314) * lu(k,971) - lu(k,988) = - lu(k,315) * lu(k,971) - lu(k,990) = lu(k,990) - lu(k,316) * lu(k,971) - lu(k,996) = lu(k,996) - lu(k,317) * lu(k,971) - lu(k,999) = - lu(k,318) * lu(k,971) - lu(k,1000) = lu(k,1000) - lu(k,319) * lu(k,971) - lu(k,1002) = lu(k,1002) - lu(k,320) * lu(k,971) - lu(k,1003) = - lu(k,321) * lu(k,971) - lu(k,1009) = - lu(k,322) * lu(k,971) - lu(k,1236) = lu(k,1236) - lu(k,312) * lu(k,1229) - lu(k,1240) = lu(k,1240) - lu(k,313) * lu(k,1229) - lu(k,1241) = lu(k,1241) - lu(k,314) * lu(k,1229) - lu(k,1244) = lu(k,1244) - lu(k,315) * lu(k,1229) - lu(k,1246) = - lu(k,316) * lu(k,1229) - lu(k,1252) = lu(k,1252) - lu(k,317) * lu(k,1229) - lu(k,1255) = lu(k,1255) - lu(k,318) * lu(k,1229) - lu(k,1256) = lu(k,1256) - lu(k,319) * lu(k,1229) - lu(k,1258) = lu(k,1258) - lu(k,320) * lu(k,1229) - lu(k,1259) = lu(k,1259) - lu(k,321) * lu(k,1229) - lu(k,1265) = lu(k,1265) - lu(k,322) * lu(k,1229) - lu(k,1354) = lu(k,1354) - lu(k,312) * lu(k,1342) - lu(k,1358) = - lu(k,313) * lu(k,1342) - lu(k,1359) = lu(k,1359) - lu(k,314) * lu(k,1342) - lu(k,1362) = lu(k,1362) - lu(k,315) * lu(k,1342) - lu(k,1364) = lu(k,1364) - lu(k,316) * lu(k,1342) - lu(k,1370) = lu(k,1370) - lu(k,317) * lu(k,1342) - lu(k,1373) = lu(k,1373) - lu(k,318) * lu(k,1342) - lu(k,1374) = lu(k,1374) - lu(k,319) * lu(k,1342) - lu(k,1376) = lu(k,1376) - lu(k,320) * lu(k,1342) - lu(k,1377) = lu(k,1377) - lu(k,321) * lu(k,1342) - lu(k,1383) = lu(k,1383) - lu(k,322) * lu(k,1342) - lu(k,1413) = lu(k,1413) - lu(k,312) * lu(k,1405) - lu(k,1417) = lu(k,1417) - lu(k,313) * lu(k,1405) - lu(k,1418) = lu(k,1418) - lu(k,314) * lu(k,1405) - lu(k,1421) = lu(k,1421) - lu(k,315) * lu(k,1405) - lu(k,1423) = lu(k,1423) - lu(k,316) * lu(k,1405) - lu(k,1429) = lu(k,1429) - lu(k,317) * lu(k,1405) - lu(k,1432) = lu(k,1432) - lu(k,318) * lu(k,1405) - lu(k,1433) = lu(k,1433) - lu(k,319) * lu(k,1405) - lu(k,1435) = lu(k,1435) - lu(k,320) * lu(k,1405) - lu(k,1436) = lu(k,1436) - lu(k,321) * lu(k,1405) - lu(k,1442) = lu(k,1442) - lu(k,322) * lu(k,1405) - lu(k,1497) = - lu(k,312) * lu(k,1488) - lu(k,1500) = lu(k,1500) - lu(k,313) * lu(k,1488) - lu(k,1501) = lu(k,1501) - lu(k,314) * lu(k,1488) - lu(k,1504) = lu(k,1504) - lu(k,315) * lu(k,1488) - lu(k,1506) = lu(k,1506) - lu(k,316) * lu(k,1488) - lu(k,1512) = lu(k,1512) - lu(k,317) * lu(k,1488) - lu(k,1515) = lu(k,1515) - lu(k,318) * lu(k,1488) - lu(k,1516) = lu(k,1516) - lu(k,319) * lu(k,1488) - lu(k,1518) = lu(k,1518) - lu(k,320) * lu(k,1488) - lu(k,1519) = lu(k,1519) - lu(k,321) * lu(k,1488) - lu(k,1525) = - lu(k,322) * lu(k,1488) - lu(k,1543) = lu(k,1543) - lu(k,312) * lu(k,1541) - lu(k,1544) = lu(k,1544) - lu(k,313) * lu(k,1541) - lu(k,1545) = lu(k,1545) - lu(k,314) * lu(k,1541) - lu(k,1546) = lu(k,1546) - lu(k,315) * lu(k,1541) - lu(k,1548) = lu(k,1548) - lu(k,316) * lu(k,1541) - lu(k,1554) = lu(k,1554) - lu(k,317) * lu(k,1541) - lu(k,1557) = lu(k,1557) - lu(k,318) * lu(k,1541) - lu(k,1558) = lu(k,1558) - lu(k,319) * lu(k,1541) - lu(k,1560) = lu(k,1560) - lu(k,320) * lu(k,1541) - lu(k,1561) = lu(k,1561) - lu(k,321) * lu(k,1541) - lu(k,1567) = lu(k,1567) - lu(k,322) * lu(k,1541) - lu(k,324) = 1._r8 / lu(k,324) - lu(k,325) = lu(k,325) * lu(k,324) - lu(k,326) = lu(k,326) * lu(k,324) - lu(k,327) = lu(k,327) * lu(k,324) - lu(k,328) = lu(k,328) * lu(k,324) - lu(k,329) = lu(k,329) * lu(k,324) - lu(k,330) = lu(k,330) * lu(k,324) - lu(k,331) = lu(k,331) * lu(k,324) - lu(k,332) = lu(k,332) * lu(k,324) - lu(k,333) = lu(k,333) * lu(k,324) - lu(k,334) = lu(k,334) * lu(k,324) - lu(k,485) = - lu(k,325) * lu(k,483) - lu(k,487) = - lu(k,326) * lu(k,483) - lu(k,488) = lu(k,488) - lu(k,327) * lu(k,483) - lu(k,489) = - lu(k,328) * lu(k,483) - lu(k,492) = - lu(k,329) * lu(k,483) - lu(k,495) = lu(k,495) - lu(k,330) * lu(k,483) - lu(k,496) = - lu(k,331) * lu(k,483) - lu(k,500) = - lu(k,332) * lu(k,483) - lu(k,501) = lu(k,501) - lu(k,333) * lu(k,483) - lu(k,502) = lu(k,502) - lu(k,334) * lu(k,483) - lu(k,636) = lu(k,636) - lu(k,325) * lu(k,631) - lu(k,638) = lu(k,638) - lu(k,326) * lu(k,631) - lu(k,639) = lu(k,639) - lu(k,327) * lu(k,631) - lu(k,640) = - lu(k,328) * lu(k,631) - lu(k,645) = lu(k,645) - lu(k,329) * lu(k,631) - lu(k,650) = lu(k,650) - lu(k,330) * lu(k,631) - lu(k,651) = lu(k,651) - lu(k,331) * lu(k,631) - lu(k,655) = lu(k,655) - lu(k,332) * lu(k,631) - lu(k,656) = lu(k,656) - lu(k,333) * lu(k,631) - lu(k,657) = lu(k,657) - lu(k,334) * lu(k,631) - lu(k,745) = lu(k,745) - lu(k,325) * lu(k,741) - lu(k,747) = lu(k,747) - lu(k,326) * lu(k,741) - lu(k,748) = lu(k,748) - lu(k,327) * lu(k,741) - lu(k,749) = lu(k,749) - lu(k,328) * lu(k,741) - lu(k,755) = lu(k,755) - lu(k,329) * lu(k,741) - lu(k,760) = lu(k,760) - lu(k,330) * lu(k,741) - lu(k,761) = lu(k,761) - lu(k,331) * lu(k,741) - lu(k,765) = lu(k,765) - lu(k,332) * lu(k,741) - lu(k,766) = lu(k,766) - lu(k,333) * lu(k,741) - lu(k,767) = lu(k,767) - lu(k,334) * lu(k,741) - lu(k,791) = lu(k,791) - lu(k,325) * lu(k,786) - lu(k,793) = lu(k,793) - lu(k,326) * lu(k,786) - lu(k,794) = lu(k,794) - lu(k,327) * lu(k,786) - lu(k,796) = lu(k,796) - lu(k,328) * lu(k,786) - lu(k,802) = lu(k,802) - lu(k,329) * lu(k,786) - lu(k,807) = lu(k,807) - lu(k,330) * lu(k,786) - lu(k,808) = lu(k,808) - lu(k,331) * lu(k,786) - lu(k,812) = lu(k,812) - lu(k,332) * lu(k,786) - lu(k,813) = lu(k,813) - lu(k,333) * lu(k,786) - lu(k,814) = lu(k,814) - lu(k,334) * lu(k,786) - lu(k,1275) = - lu(k,325) * lu(k,1270) - lu(k,1279) = lu(k,1279) - lu(k,326) * lu(k,1270) - lu(k,1280) = lu(k,1280) - lu(k,327) * lu(k,1270) - lu(k,1285) = lu(k,1285) - lu(k,328) * lu(k,1270) - lu(k,1291) = - lu(k,329) * lu(k,1270) - lu(k,1296) = - lu(k,330) * lu(k,1270) - lu(k,1297) = lu(k,1297) - lu(k,331) * lu(k,1270) - lu(k,1303) = - lu(k,332) * lu(k,1270) - lu(k,1304) = lu(k,1304) - lu(k,333) * lu(k,1270) - lu(k,1305) = lu(k,1305) - lu(k,334) * lu(k,1270) - lu(k,1454) = lu(k,1454) - lu(k,325) * lu(k,1450) - lu(k,1459) = lu(k,1459) - lu(k,326) * lu(k,1450) - lu(k,1460) = lu(k,1460) - lu(k,327) * lu(k,1450) - lu(k,1465) = lu(k,1465) - lu(k,328) * lu(k,1450) - lu(k,1471) = lu(k,1471) - lu(k,329) * lu(k,1450) - lu(k,1476) = lu(k,1476) - lu(k,330) * lu(k,1450) - lu(k,1477) = lu(k,1477) - lu(k,331) * lu(k,1450) - lu(k,1483) = lu(k,1483) - lu(k,332) * lu(k,1450) - lu(k,1484) = lu(k,1484) - lu(k,333) * lu(k,1450) - lu(k,1485) = lu(k,1485) - lu(k,334) * lu(k,1450) - lu(k,1496) = lu(k,1496) - lu(k,325) * lu(k,1489) - lu(k,1500) = lu(k,1500) - lu(k,326) * lu(k,1489) - lu(k,1501) = lu(k,1501) - lu(k,327) * lu(k,1489) - lu(k,1506) = lu(k,1506) - lu(k,328) * lu(k,1489) - lu(k,1512) = lu(k,1512) - lu(k,329) * lu(k,1489) - lu(k,1517) = lu(k,1517) - lu(k,330) * lu(k,1489) - lu(k,1518) = lu(k,1518) - lu(k,331) * lu(k,1489) - lu(k,1524) = lu(k,1524) - lu(k,332) * lu(k,1489) - lu(k,1525) = lu(k,1525) - lu(k,333) * lu(k,1489) - lu(k,1526) = lu(k,1526) - lu(k,334) * lu(k,1489) - lu(k,1732) = lu(k,1732) - lu(k,325) * lu(k,1728) - lu(k,1737) = lu(k,1737) - lu(k,326) * lu(k,1728) - lu(k,1738) = lu(k,1738) - lu(k,327) * lu(k,1728) - lu(k,1743) = lu(k,1743) - lu(k,328) * lu(k,1728) - lu(k,1749) = lu(k,1749) - lu(k,329) * lu(k,1728) - lu(k,1754) = lu(k,1754) - lu(k,330) * lu(k,1728) - lu(k,1755) = lu(k,1755) - lu(k,331) * lu(k,1728) - lu(k,1761) = lu(k,1761) - lu(k,332) * lu(k,1728) - lu(k,1762) = - lu(k,333) * lu(k,1728) - lu(k,1763) = lu(k,1763) - lu(k,334) * lu(k,1728) - lu(k,1826) = - lu(k,325) * lu(k,1814) - lu(k,1830) = lu(k,1830) - lu(k,326) * lu(k,1814) - lu(k,1831) = lu(k,1831) - lu(k,327) * lu(k,1814) - lu(k,1836) = lu(k,1836) - lu(k,328) * lu(k,1814) - lu(k,1842) = lu(k,1842) - lu(k,329) * lu(k,1814) - lu(k,1847) = - lu(k,330) * lu(k,1814) - lu(k,1848) = lu(k,1848) - lu(k,331) * lu(k,1814) - lu(k,1854) = - lu(k,332) * lu(k,1814) - lu(k,1855) = lu(k,1855) - lu(k,333) * lu(k,1814) - lu(k,1856) = lu(k,1856) - lu(k,334) * lu(k,1814) + lu(k,322) = 1._r8 / lu(k,322) + lu(k,323) = lu(k,323) * lu(k,322) + lu(k,324) = lu(k,324) * lu(k,322) + lu(k,325) = lu(k,325) * lu(k,322) + lu(k,326) = lu(k,326) * lu(k,322) + lu(k,327) = lu(k,327) * lu(k,322) + lu(k,328) = lu(k,328) * lu(k,322) + lu(k,357) = lu(k,357) - lu(k,323) * lu(k,355) + lu(k,360) = lu(k,360) - lu(k,324) * lu(k,355) + lu(k,361) = lu(k,361) - lu(k,325) * lu(k,355) + lu(k,363) = lu(k,363) - lu(k,326) * lu(k,355) + lu(k,364) = lu(k,364) - lu(k,327) * lu(k,355) + lu(k,365) = - lu(k,328) * lu(k,355) + lu(k,898) = lu(k,898) - lu(k,323) * lu(k,889) + lu(k,902) = lu(k,902) - lu(k,324) * lu(k,889) + lu(k,906) = lu(k,906) - lu(k,325) * lu(k,889) + lu(k,911) = lu(k,911) - lu(k,326) * lu(k,889) + lu(k,917) = lu(k,917) - lu(k,327) * lu(k,889) + lu(k,918) = lu(k,918) - lu(k,328) * lu(k,889) + lu(k,981) = lu(k,981) - lu(k,323) * lu(k,966) + lu(k,986) = lu(k,986) - lu(k,324) * lu(k,966) + lu(k,990) = lu(k,990) - lu(k,325) * lu(k,966) + lu(k,995) = lu(k,995) - lu(k,326) * lu(k,966) + lu(k,1001) = lu(k,1001) - lu(k,327) * lu(k,966) + lu(k,1002) = lu(k,1002) - lu(k,328) * lu(k,966) + lu(k,1285) = lu(k,1285) - lu(k,323) * lu(k,1264) + lu(k,1292) = lu(k,1292) - lu(k,324) * lu(k,1264) + lu(k,1297) = lu(k,1297) - lu(k,325) * lu(k,1264) + lu(k,1303) = lu(k,1303) - lu(k,326) * lu(k,1264) + lu(k,1309) = lu(k,1309) - lu(k,327) * lu(k,1264) + lu(k,1310) = lu(k,1310) - lu(k,328) * lu(k,1264) + lu(k,1494) = lu(k,1494) - lu(k,323) * lu(k,1479) + lu(k,1501) = lu(k,1501) - lu(k,324) * lu(k,1479) + lu(k,1506) = lu(k,1506) - lu(k,325) * lu(k,1479) + lu(k,1512) = lu(k,1512) - lu(k,326) * lu(k,1479) + lu(k,1518) = lu(k,1518) - lu(k,327) * lu(k,1479) + lu(k,1519) = lu(k,1519) - lu(k,328) * lu(k,1479) + lu(k,1753) = lu(k,1753) - lu(k,323) * lu(k,1738) + lu(k,1760) = lu(k,1760) - lu(k,324) * lu(k,1738) + lu(k,1765) = lu(k,1765) - lu(k,325) * lu(k,1738) + lu(k,1771) = lu(k,1771) - lu(k,326) * lu(k,1738) + lu(k,1777) = lu(k,1777) - lu(k,327) * lu(k,1738) + lu(k,1778) = - lu(k,328) * lu(k,1738) + lu(k,2002) = lu(k,2002) - lu(k,323) * lu(k,1987) + lu(k,2009) = lu(k,2009) - lu(k,324) * lu(k,1987) + lu(k,2014) = lu(k,2014) - lu(k,325) * lu(k,1987) + lu(k,2020) = lu(k,2020) - lu(k,326) * lu(k,1987) + lu(k,2026) = lu(k,2026) - lu(k,327) * lu(k,1987) + lu(k,2027) = lu(k,2027) - lu(k,328) * lu(k,1987) + lu(k,329) = 1._r8 / lu(k,329) + lu(k,330) = lu(k,330) * lu(k,329) + lu(k,331) = lu(k,331) * lu(k,329) + lu(k,332) = lu(k,332) * lu(k,329) + lu(k,333) = lu(k,333) * lu(k,329) + lu(k,334) = lu(k,334) * lu(k,329) + lu(k,335) = lu(k,335) * lu(k,329) + lu(k,336) = lu(k,336) * lu(k,329) + lu(k,579) = lu(k,579) - lu(k,330) * lu(k,578) + lu(k,580) = lu(k,580) - lu(k,331) * lu(k,578) + lu(k,582) = - lu(k,332) * lu(k,578) + lu(k,584) = lu(k,584) - lu(k,333) * lu(k,578) + lu(k,585) = - lu(k,334) * lu(k,578) + lu(k,586) = - lu(k,335) * lu(k,578) + lu(k,590) = - lu(k,336) * lu(k,578) + lu(k,732) = lu(k,732) - lu(k,330) * lu(k,731) + lu(k,734) = - lu(k,331) * lu(k,731) + lu(k,736) = - lu(k,332) * lu(k,731) + lu(k,738) = lu(k,738) - lu(k,333) * lu(k,731) + lu(k,742) = lu(k,742) - lu(k,334) * lu(k,731) + lu(k,743) = lu(k,743) - lu(k,335) * lu(k,731) + lu(k,754) = lu(k,754) - lu(k,336) * lu(k,731) + lu(k,780) = lu(k,780) - lu(k,330) * lu(k,774) + lu(k,782) = lu(k,782) - lu(k,331) * lu(k,774) + lu(k,784) = lu(k,784) - lu(k,332) * lu(k,774) + lu(k,786) = lu(k,786) - lu(k,333) * lu(k,774) + lu(k,790) = lu(k,790) - lu(k,334) * lu(k,774) + lu(k,791) = lu(k,791) - lu(k,335) * lu(k,774) + lu(k,805) = lu(k,805) - lu(k,336) * lu(k,774) + lu(k,892) = lu(k,892) - lu(k,330) * lu(k,890) + lu(k,894) = lu(k,894) - lu(k,331) * lu(k,890) + lu(k,896) = - lu(k,332) * lu(k,890) + lu(k,898) = lu(k,898) - lu(k,333) * lu(k,890) + lu(k,902) = lu(k,902) - lu(k,334) * lu(k,890) + lu(k,904) = lu(k,904) - lu(k,335) * lu(k,890) + lu(k,918) = lu(k,918) - lu(k,336) * lu(k,890) + lu(k,975) = lu(k,975) - lu(k,330) * lu(k,967) + lu(k,977) = lu(k,977) - lu(k,331) * lu(k,967) + lu(k,979) = lu(k,979) - lu(k,332) * lu(k,967) + lu(k,981) = lu(k,981) - lu(k,333) * lu(k,967) + lu(k,986) = lu(k,986) - lu(k,334) * lu(k,967) + lu(k,988) = lu(k,988) - lu(k,335) * lu(k,967) + lu(k,1002) = lu(k,1002) - lu(k,336) * lu(k,967) + lu(k,1274) = lu(k,1274) - lu(k,330) * lu(k,1265) + lu(k,1277) = lu(k,1277) - lu(k,331) * lu(k,1265) + lu(k,1279) = lu(k,1279) - lu(k,332) * lu(k,1265) + lu(k,1285) = lu(k,1285) - lu(k,333) * lu(k,1265) + lu(k,1292) = lu(k,1292) - lu(k,334) * lu(k,1265) + lu(k,1294) = lu(k,1294) - lu(k,335) * lu(k,1265) + lu(k,1310) = lu(k,1310) - lu(k,336) * lu(k,1265) + lu(k,338) = 1._r8 / lu(k,338) + lu(k,339) = lu(k,339) * lu(k,338) + lu(k,340) = lu(k,340) * lu(k,338) + lu(k,341) = lu(k,341) * lu(k,338) + lu(k,342) = lu(k,342) * lu(k,338) + lu(k,343) = lu(k,343) * lu(k,338) + lu(k,344) = lu(k,344) * lu(k,338) + lu(k,345) = lu(k,345) * lu(k,338) + lu(k,346) = lu(k,346) * lu(k,338) + lu(k,413) = lu(k,413) - lu(k,339) * lu(k,412) + lu(k,414) = lu(k,414) - lu(k,340) * lu(k,412) + lu(k,415) = lu(k,415) - lu(k,341) * lu(k,412) + lu(k,419) = lu(k,419) - lu(k,342) * lu(k,412) + lu(k,420) = - lu(k,343) * lu(k,412) + lu(k,421) = - lu(k,344) * lu(k,412) + lu(k,423) = lu(k,423) - lu(k,345) * lu(k,412) + lu(k,427) = lu(k,427) - lu(k,346) * lu(k,412) + lu(k,642) = - lu(k,339) * lu(k,641) + lu(k,643) = - lu(k,340) * lu(k,641) + lu(k,644) = lu(k,644) - lu(k,341) * lu(k,641) + lu(k,648) = lu(k,648) - lu(k,342) * lu(k,641) + lu(k,650) = - lu(k,343) * lu(k,641) + lu(k,651) = - lu(k,344) * lu(k,641) + lu(k,653) = lu(k,653) - lu(k,345) * lu(k,641) + lu(k,663) = lu(k,663) - lu(k,346) * lu(k,641) + lu(k,777) = lu(k,777) - lu(k,339) * lu(k,775) + lu(k,778) = lu(k,778) - lu(k,340) * lu(k,775) + lu(k,781) = lu(k,781) - lu(k,341) * lu(k,775) + lu(k,786) = lu(k,786) - lu(k,342) * lu(k,775) + lu(k,788) = - lu(k,343) * lu(k,775) + lu(k,789) = - lu(k,344) * lu(k,775) + lu(k,791) = lu(k,791) - lu(k,345) * lu(k,775) + lu(k,805) = lu(k,805) - lu(k,346) * lu(k,775) + lu(k,971) = lu(k,971) - lu(k,339) * lu(k,968) + lu(k,972) = lu(k,972) - lu(k,340) * lu(k,968) + lu(k,976) = lu(k,976) - lu(k,341) * lu(k,968) + lu(k,981) = lu(k,981) - lu(k,342) * lu(k,968) + lu(k,983) = lu(k,983) - lu(k,343) * lu(k,968) + lu(k,985) = lu(k,985) - lu(k,344) * lu(k,968) + lu(k,988) = lu(k,988) - lu(k,345) * lu(k,968) + lu(k,1002) = lu(k,1002) - lu(k,346) * lu(k,968) + lu(k,1213) = - lu(k,339) * lu(k,1212) + lu(k,1214) = - lu(k,340) * lu(k,1212) + lu(k,1217) = - lu(k,341) * lu(k,1212) + lu(k,1225) = lu(k,1225) - lu(k,342) * lu(k,1212) + lu(k,1228) = lu(k,1228) - lu(k,343) * lu(k,1212) + lu(k,1231) = lu(k,1231) - lu(k,344) * lu(k,1212) + lu(k,1234) = lu(k,1234) - lu(k,345) * lu(k,1212) + lu(k,1250) = lu(k,1250) - lu(k,346) * lu(k,1212) + lu(k,2043) = - lu(k,339) * lu(k,2041) + lu(k,2044) = - lu(k,340) * lu(k,2041) + lu(k,2052) = lu(k,2052) - lu(k,341) * lu(k,2041) + lu(k,2062) = lu(k,2062) - lu(k,342) * lu(k,2041) + lu(k,2065) = - lu(k,343) * lu(k,2041) + lu(k,2068) = lu(k,2068) - lu(k,344) * lu(k,2041) + lu(k,2071) = lu(k,2071) - lu(k,345) * lu(k,2041) + lu(k,2087) = lu(k,2087) - lu(k,346) * lu(k,2041) + lu(k,348) = 1._r8 / lu(k,348) + lu(k,349) = lu(k,349) * lu(k,348) + lu(k,350) = lu(k,350) * lu(k,348) + lu(k,351) = lu(k,351) * lu(k,348) + lu(k,352) = lu(k,352) * lu(k,348) + lu(k,353) = lu(k,353) * lu(k,348) + lu(k,487) = lu(k,487) - lu(k,349) * lu(k,486) + lu(k,490) = - lu(k,350) * lu(k,486) + lu(k,491) = lu(k,491) - lu(k,351) * lu(k,486) + lu(k,492) = lu(k,492) - lu(k,352) * lu(k,486) + lu(k,500) = - lu(k,353) * lu(k,486) + lu(k,710) = lu(k,710) - lu(k,349) * lu(k,709) + lu(k,715) = lu(k,715) - lu(k,350) * lu(k,709) + lu(k,716) = lu(k,716) - lu(k,351) * lu(k,709) + lu(k,719) = lu(k,719) - lu(k,352) * lu(k,709) + lu(k,729) = lu(k,729) - lu(k,353) * lu(k,709) + lu(k,974) = lu(k,974) - lu(k,349) * lu(k,969) + lu(k,980) = lu(k,980) - lu(k,350) * lu(k,969) + lu(k,981) = lu(k,981) - lu(k,351) * lu(k,969) + lu(k,986) = lu(k,986) - lu(k,352) * lu(k,969) + lu(k,1002) = lu(k,1002) - lu(k,353) * lu(k,969) + lu(k,1083) = - lu(k,349) * lu(k,1081) + lu(k,1092) = lu(k,1092) - lu(k,350) * lu(k,1081) + lu(k,1094) = lu(k,1094) - lu(k,351) * lu(k,1081) + lu(k,1100) = lu(k,1100) - lu(k,352) * lu(k,1081) + lu(k,1118) = - lu(k,353) * lu(k,1081) + lu(k,1273) = lu(k,1273) - lu(k,349) * lu(k,1266) + lu(k,1283) = lu(k,1283) - lu(k,350) * lu(k,1266) + lu(k,1285) = lu(k,1285) - lu(k,351) * lu(k,1266) + lu(k,1292) = lu(k,1292) - lu(k,352) * lu(k,1266) + lu(k,1310) = lu(k,1310) - lu(k,353) * lu(k,1266) + lu(k,1609) = lu(k,1609) - lu(k,349) * lu(k,1605) + lu(k,1621) = lu(k,1621) - lu(k,350) * lu(k,1605) + lu(k,1623) = lu(k,1623) - lu(k,351) * lu(k,1605) + lu(k,1630) = lu(k,1630) - lu(k,352) * lu(k,1605) + lu(k,1648) = lu(k,1648) - lu(k,353) * lu(k,1605) + lu(k,1743) = lu(k,1743) - lu(k,349) * lu(k,1739) + lu(k,1751) = lu(k,1751) - lu(k,350) * lu(k,1739) + lu(k,1753) = lu(k,1753) - lu(k,351) * lu(k,1739) + lu(k,1760) = lu(k,1760) - lu(k,352) * lu(k,1739) + lu(k,1778) = lu(k,1778) - lu(k,353) * lu(k,1739) + lu(k,1792) = lu(k,1792) - lu(k,349) * lu(k,1787) + lu(k,1800) = lu(k,1800) - lu(k,350) * lu(k,1787) + lu(k,1802) = lu(k,1802) - lu(k,351) * lu(k,1787) + lu(k,1809) = lu(k,1809) - lu(k,352) * lu(k,1787) + lu(k,1827) = - lu(k,353) * lu(k,1787) + lu(k,1902) = lu(k,1902) - lu(k,349) * lu(k,1899) + lu(k,1910) = lu(k,1910) - lu(k,350) * lu(k,1899) + lu(k,1912) = lu(k,1912) - lu(k,351) * lu(k,1899) + lu(k,1919) = lu(k,1919) - lu(k,352) * lu(k,1899) + lu(k,1937) = - lu(k,353) * lu(k,1899) + lu(k,2046) = - lu(k,349) * lu(k,2042) + lu(k,2060) = - lu(k,350) * lu(k,2042) + lu(k,2062) = lu(k,2062) - lu(k,351) * lu(k,2042) + lu(k,2069) = lu(k,2069) - lu(k,352) * lu(k,2042) + lu(k,2087) = lu(k,2087) - lu(k,353) * lu(k,2042) end do end subroutine lu_fac08 subroutine lu_fac09( avec_len, lu ) @@ -1677,115 +1444,269 @@ subroutine lu_fac09( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,335) = 1._r8 / lu(k,335) - lu(k,336) = lu(k,336) * lu(k,335) - lu(k,337) = lu(k,337) * lu(k,335) - lu(k,338) = lu(k,338) * lu(k,335) - lu(k,339) = lu(k,339) * lu(k,335) - lu(k,340) = lu(k,340) * lu(k,335) - lu(k,341) = lu(k,341) * lu(k,335) - lu(k,342) = lu(k,342) * lu(k,335) - lu(k,343) = lu(k,343) * lu(k,335) - lu(k,344) = lu(k,344) * lu(k,335) - lu(k,345) = lu(k,345) * lu(k,335) - lu(k,346) = lu(k,346) * lu(k,335) - lu(k,347) = lu(k,347) * lu(k,335) - lu(k,897) = lu(k,897) - lu(k,336) * lu(k,882) - lu(k,900) = lu(k,900) - lu(k,337) * lu(k,882) - lu(k,901) = - lu(k,338) * lu(k,882) - lu(k,903) = - lu(k,339) * lu(k,882) - lu(k,904) = lu(k,904) - lu(k,340) * lu(k,882) - lu(k,908) = lu(k,908) - lu(k,341) * lu(k,882) - lu(k,911) = lu(k,911) - lu(k,342) * lu(k,882) - lu(k,914) = lu(k,914) - lu(k,343) * lu(k,882) - lu(k,916) = - lu(k,344) * lu(k,882) - lu(k,919) = - lu(k,345) * lu(k,882) - lu(k,921) = lu(k,921) - lu(k,346) * lu(k,882) - lu(k,922) = lu(k,922) - lu(k,347) * lu(k,882) - lu(k,939) = lu(k,939) - lu(k,336) * lu(k,925) - lu(k,942) = - lu(k,337) * lu(k,925) - lu(k,943) = lu(k,943) - lu(k,338) * lu(k,925) - lu(k,945) = lu(k,945) - lu(k,339) * lu(k,925) - lu(k,946) = - lu(k,340) * lu(k,925) - lu(k,950) = lu(k,950) - lu(k,341) * lu(k,925) - lu(k,953) = - lu(k,342) * lu(k,925) - lu(k,956) = lu(k,956) - lu(k,343) * lu(k,925) - lu(k,958) = - lu(k,344) * lu(k,925) - lu(k,961) = - lu(k,345) * lu(k,925) - lu(k,963) = - lu(k,346) * lu(k,925) - lu(k,964) = lu(k,964) - lu(k,347) * lu(k,925) - lu(k,1027) = lu(k,1027) - lu(k,336) * lu(k,1013) - lu(k,1030) = - lu(k,337) * lu(k,1013) - lu(k,1031) = - lu(k,338) * lu(k,1013) - lu(k,1033) = lu(k,1033) - lu(k,339) * lu(k,1013) - lu(k,1034) = - lu(k,340) * lu(k,1013) - lu(k,1038) = lu(k,1038) - lu(k,341) * lu(k,1013) - lu(k,1041) = - lu(k,342) * lu(k,1013) - lu(k,1044) = - lu(k,343) * lu(k,1013) - lu(k,1046) = - lu(k,344) * lu(k,1013) - lu(k,1049) = lu(k,1049) - lu(k,345) * lu(k,1013) - lu(k,1051) = lu(k,1051) - lu(k,346) * lu(k,1013) - lu(k,1052) = lu(k,1052) - lu(k,347) * lu(k,1013) - lu(k,1068) = lu(k,1068) - lu(k,336) * lu(k,1054) - lu(k,1071) = - lu(k,337) * lu(k,1054) - lu(k,1072) = lu(k,1072) - lu(k,338) * lu(k,1054) - lu(k,1074) = lu(k,1074) - lu(k,339) * lu(k,1054) - lu(k,1075) = lu(k,1075) - lu(k,340) * lu(k,1054) - lu(k,1079) = lu(k,1079) - lu(k,341) * lu(k,1054) - lu(k,1082) = - lu(k,342) * lu(k,1054) - lu(k,1085) = lu(k,1085) - lu(k,343) * lu(k,1054) - lu(k,1087) = - lu(k,344) * lu(k,1054) - lu(k,1090) = - lu(k,345) * lu(k,1054) - lu(k,1092) = lu(k,1092) - lu(k,346) * lu(k,1054) - lu(k,1093) = lu(k,1093) - lu(k,347) * lu(k,1054) - lu(k,1359) = lu(k,1359) - lu(k,336) * lu(k,1343) - lu(k,1362) = lu(k,1362) - lu(k,337) * lu(k,1343) - lu(k,1363) = - lu(k,338) * lu(k,1343) - lu(k,1365) = lu(k,1365) - lu(k,339) * lu(k,1343) - lu(k,1366) = - lu(k,340) * lu(k,1343) - lu(k,1370) = lu(k,1370) - lu(k,341) * lu(k,1343) - lu(k,1373) = lu(k,1373) - lu(k,342) * lu(k,1343) - lu(k,1376) = lu(k,1376) - lu(k,343) * lu(k,1343) - lu(k,1378) = - lu(k,344) * lu(k,1343) - lu(k,1381) = - lu(k,345) * lu(k,1343) - lu(k,1383) = lu(k,1383) - lu(k,346) * lu(k,1343) - lu(k,1384) = lu(k,1384) - lu(k,347) * lu(k,1343) - lu(k,1585) = lu(k,1585) - lu(k,336) * lu(k,1571) - lu(k,1588) = - lu(k,337) * lu(k,1571) - lu(k,1589) = - lu(k,338) * lu(k,1571) - lu(k,1591) = - lu(k,339) * lu(k,1571) - lu(k,1592) = - lu(k,340) * lu(k,1571) - lu(k,1596) = lu(k,1596) - lu(k,341) * lu(k,1571) - lu(k,1599) = - lu(k,342) * lu(k,1571) - lu(k,1602) = lu(k,1602) - lu(k,343) * lu(k,1571) - lu(k,1604) = lu(k,1604) - lu(k,344) * lu(k,1571) - lu(k,1607) = lu(k,1607) - lu(k,345) * lu(k,1571) - lu(k,1609) = lu(k,1609) - lu(k,346) * lu(k,1571) - lu(k,1610) = lu(k,1610) - lu(k,347) * lu(k,1571) - lu(k,1617) = lu(k,1617) - lu(k,336) * lu(k,1612) - lu(k,1620) = - lu(k,337) * lu(k,1612) - lu(k,1621) = - lu(k,338) * lu(k,1612) - lu(k,1623) = - lu(k,339) * lu(k,1612) - lu(k,1624) = - lu(k,340) * lu(k,1612) - lu(k,1628) = lu(k,1628) - lu(k,341) * lu(k,1612) - lu(k,1631) = - lu(k,342) * lu(k,1612) - lu(k,1634) = lu(k,1634) - lu(k,343) * lu(k,1612) - lu(k,1636) = - lu(k,344) * lu(k,1612) - lu(k,1639) = - lu(k,345) * lu(k,1612) - lu(k,1641) = lu(k,1641) - lu(k,346) * lu(k,1612) - lu(k,1642) = lu(k,1642) - lu(k,347) * lu(k,1612) - lu(k,1694) = lu(k,1694) - lu(k,336) * lu(k,1680) - lu(k,1697) = - lu(k,337) * lu(k,1680) - lu(k,1698) = - lu(k,338) * lu(k,1680) - lu(k,1700) = lu(k,1700) - lu(k,339) * lu(k,1680) - lu(k,1701) = - lu(k,340) * lu(k,1680) - lu(k,1705) = lu(k,1705) - lu(k,341) * lu(k,1680) - lu(k,1708) = - lu(k,342) * lu(k,1680) - lu(k,1711) = lu(k,1711) - lu(k,343) * lu(k,1680) - lu(k,1713) = lu(k,1713) - lu(k,344) * lu(k,1680) - lu(k,1716) = lu(k,1716) - lu(k,345) * lu(k,1680) - lu(k,1718) = lu(k,1718) - lu(k,346) * lu(k,1680) - lu(k,1719) = lu(k,1719) - lu(k,347) * lu(k,1680) + lu(k,356) = 1._r8 / lu(k,356) + lu(k,357) = lu(k,357) * lu(k,356) + lu(k,358) = lu(k,358) * lu(k,356) + lu(k,359) = lu(k,359) * lu(k,356) + lu(k,360) = lu(k,360) * lu(k,356) + lu(k,361) = lu(k,361) * lu(k,356) + lu(k,362) = lu(k,362) * lu(k,356) + lu(k,363) = lu(k,363) * lu(k,356) + lu(k,364) = lu(k,364) * lu(k,356) + lu(k,365) = lu(k,365) * lu(k,356) + lu(k,981) = lu(k,981) - lu(k,357) * lu(k,970) + lu(k,983) = lu(k,983) - lu(k,358) * lu(k,970) + lu(k,985) = lu(k,985) - lu(k,359) * lu(k,970) + lu(k,986) = lu(k,986) - lu(k,360) * lu(k,970) + lu(k,990) = lu(k,990) - lu(k,361) * lu(k,970) + lu(k,993) = lu(k,993) - lu(k,362) * lu(k,970) + lu(k,995) = lu(k,995) - lu(k,363) * lu(k,970) + lu(k,1001) = lu(k,1001) - lu(k,364) * lu(k,970) + lu(k,1002) = lu(k,1002) - lu(k,365) * lu(k,970) + lu(k,1285) = lu(k,1285) - lu(k,357) * lu(k,1267) + lu(k,1288) = lu(k,1288) - lu(k,358) * lu(k,1267) + lu(k,1291) = lu(k,1291) - lu(k,359) * lu(k,1267) + lu(k,1292) = lu(k,1292) - lu(k,360) * lu(k,1267) + lu(k,1297) = lu(k,1297) - lu(k,361) * lu(k,1267) + lu(k,1300) = lu(k,1300) - lu(k,362) * lu(k,1267) + lu(k,1303) = lu(k,1303) - lu(k,363) * lu(k,1267) + lu(k,1309) = lu(k,1309) - lu(k,364) * lu(k,1267) + lu(k,1310) = lu(k,1310) - lu(k,365) * lu(k,1267) + lu(k,1494) = lu(k,1494) - lu(k,357) * lu(k,1480) + lu(k,1497) = - lu(k,358) * lu(k,1480) + lu(k,1500) = lu(k,1500) - lu(k,359) * lu(k,1480) + lu(k,1501) = lu(k,1501) - lu(k,360) * lu(k,1480) + lu(k,1506) = lu(k,1506) - lu(k,361) * lu(k,1480) + lu(k,1509) = lu(k,1509) - lu(k,362) * lu(k,1480) + lu(k,1512) = lu(k,1512) - lu(k,363) * lu(k,1480) + lu(k,1518) = lu(k,1518) - lu(k,364) * lu(k,1480) + lu(k,1519) = lu(k,1519) - lu(k,365) * lu(k,1480) + lu(k,1623) = lu(k,1623) - lu(k,357) * lu(k,1606) + lu(k,1626) = lu(k,1626) - lu(k,358) * lu(k,1606) + lu(k,1629) = lu(k,1629) - lu(k,359) * lu(k,1606) + lu(k,1630) = lu(k,1630) - lu(k,360) * lu(k,1606) + lu(k,1635) = lu(k,1635) - lu(k,361) * lu(k,1606) + lu(k,1638) = lu(k,1638) - lu(k,362) * lu(k,1606) + lu(k,1641) = lu(k,1641) - lu(k,363) * lu(k,1606) + lu(k,1647) = lu(k,1647) - lu(k,364) * lu(k,1606) + lu(k,1648) = lu(k,1648) - lu(k,365) * lu(k,1606) + lu(k,1753) = lu(k,1753) - lu(k,357) * lu(k,1740) + lu(k,1756) = lu(k,1756) - lu(k,358) * lu(k,1740) + lu(k,1759) = - lu(k,359) * lu(k,1740) + lu(k,1760) = lu(k,1760) - lu(k,360) * lu(k,1740) + lu(k,1765) = lu(k,1765) - lu(k,361) * lu(k,1740) + lu(k,1768) = lu(k,1768) - lu(k,362) * lu(k,1740) + lu(k,1771) = lu(k,1771) - lu(k,363) * lu(k,1740) + lu(k,1777) = lu(k,1777) - lu(k,364) * lu(k,1740) + lu(k,1778) = lu(k,1778) - lu(k,365) * lu(k,1740) + lu(k,2002) = lu(k,2002) - lu(k,357) * lu(k,1988) + lu(k,2005) = lu(k,2005) - lu(k,358) * lu(k,1988) + lu(k,2008) = - lu(k,359) * lu(k,1988) + lu(k,2009) = lu(k,2009) - lu(k,360) * lu(k,1988) + lu(k,2014) = lu(k,2014) - lu(k,361) * lu(k,1988) + lu(k,2017) = lu(k,2017) - lu(k,362) * lu(k,1988) + lu(k,2020) = lu(k,2020) - lu(k,363) * lu(k,1988) + lu(k,2026) = lu(k,2026) - lu(k,364) * lu(k,1988) + lu(k,2027) = lu(k,2027) - lu(k,365) * lu(k,1988) + lu(k,366) = 1._r8 / lu(k,366) + lu(k,367) = lu(k,367) * lu(k,366) + lu(k,368) = lu(k,368) * lu(k,366) + lu(k,369) = lu(k,369) * lu(k,366) + lu(k,370) = lu(k,370) * lu(k,366) + lu(k,371) = lu(k,371) * lu(k,366) + lu(k,372) = lu(k,372) * lu(k,366) + lu(k,373) = lu(k,373) * lu(k,366) + lu(k,829) = lu(k,829) - lu(k,367) * lu(k,827) + lu(k,833) = - lu(k,368) * lu(k,827) + lu(k,840) = lu(k,840) - lu(k,369) * lu(k,827) + lu(k,848) = - lu(k,370) * lu(k,827) + lu(k,850) = lu(k,850) - lu(k,371) * lu(k,827) + lu(k,852) = lu(k,852) - lu(k,372) * lu(k,827) + lu(k,857) = lu(k,857) - lu(k,373) * lu(k,827) + lu(k,1007) = lu(k,1007) - lu(k,367) * lu(k,1003) + lu(k,1009) = lu(k,1009) - lu(k,368) * lu(k,1003) + lu(k,1017) = lu(k,1017) - lu(k,369) * lu(k,1003) + lu(k,1025) = lu(k,1025) - lu(k,370) * lu(k,1003) + lu(k,1027) = lu(k,1027) - lu(k,371) * lu(k,1003) + lu(k,1029) = lu(k,1029) - lu(k,372) * lu(k,1003) + lu(k,1034) = lu(k,1034) - lu(k,373) * lu(k,1003) + lu(k,1280) = lu(k,1280) - lu(k,367) * lu(k,1268) + lu(k,1284) = lu(k,1284) - lu(k,368) * lu(k,1268) + lu(k,1292) = lu(k,1292) - lu(k,369) * lu(k,1268) + lu(k,1300) = lu(k,1300) - lu(k,370) * lu(k,1268) + lu(k,1302) = lu(k,1302) - lu(k,371) * lu(k,1268) + lu(k,1304) = lu(k,1304) - lu(k,372) * lu(k,1268) + lu(k,1309) = lu(k,1309) - lu(k,373) * lu(k,1268) + lu(k,1525) = lu(k,1525) - lu(k,367) * lu(k,1521) + lu(k,1529) = lu(k,1529) - lu(k,368) * lu(k,1521) + lu(k,1537) = lu(k,1537) - lu(k,369) * lu(k,1521) + lu(k,1545) = lu(k,1545) - lu(k,370) * lu(k,1521) + lu(k,1547) = lu(k,1547) - lu(k,371) * lu(k,1521) + lu(k,1549) = lu(k,1549) - lu(k,372) * lu(k,1521) + lu(k,1554) = lu(k,1554) - lu(k,373) * lu(k,1521) + lu(k,1704) = lu(k,1704) - lu(k,367) * lu(k,1693) + lu(k,1707) = lu(k,1707) - lu(k,368) * lu(k,1693) + lu(k,1715) = lu(k,1715) - lu(k,369) * lu(k,1693) + lu(k,1723) = lu(k,1723) - lu(k,370) * lu(k,1693) + lu(k,1725) = lu(k,1725) - lu(k,371) * lu(k,1693) + lu(k,1727) = lu(k,1727) - lu(k,372) * lu(k,1693) + lu(k,1732) = lu(k,1732) - lu(k,373) * lu(k,1693) + lu(k,1748) = lu(k,1748) - lu(k,367) * lu(k,1741) + lu(k,1752) = lu(k,1752) - lu(k,368) * lu(k,1741) + lu(k,1760) = lu(k,1760) - lu(k,369) * lu(k,1741) + lu(k,1768) = lu(k,1768) - lu(k,370) * lu(k,1741) + lu(k,1770) = lu(k,1770) - lu(k,371) * lu(k,1741) + lu(k,1772) = lu(k,1772) - lu(k,372) * lu(k,1741) + lu(k,1777) = lu(k,1777) - lu(k,373) * lu(k,1741) + lu(k,1831) = lu(k,1831) - lu(k,367) * lu(k,1828) + lu(k,1834) = lu(k,1834) - lu(k,368) * lu(k,1828) + lu(k,1842) = lu(k,1842) - lu(k,369) * lu(k,1828) + lu(k,1850) = lu(k,1850) - lu(k,370) * lu(k,1828) + lu(k,1852) = - lu(k,371) * lu(k,1828) + lu(k,1854) = - lu(k,372) * lu(k,1828) + lu(k,1859) = lu(k,1859) - lu(k,373) * lu(k,1828) + lu(k,1997) = lu(k,1997) - lu(k,367) * lu(k,1989) + lu(k,2001) = lu(k,2001) - lu(k,368) * lu(k,1989) + lu(k,2009) = lu(k,2009) - lu(k,369) * lu(k,1989) + lu(k,2017) = lu(k,2017) - lu(k,370) * lu(k,1989) + lu(k,2019) = - lu(k,371) * lu(k,1989) + lu(k,2021) = lu(k,2021) - lu(k,372) * lu(k,1989) + lu(k,2026) = lu(k,2026) - lu(k,373) * lu(k,1989) + lu(k,374) = 1._r8 / lu(k,374) + lu(k,375) = lu(k,375) * lu(k,374) + lu(k,376) = lu(k,376) * lu(k,374) + lu(k,377) = lu(k,377) * lu(k,374) + lu(k,378) = lu(k,378) * lu(k,374) + lu(k,379) = lu(k,379) * lu(k,374) + lu(k,380) = lu(k,380) * lu(k,374) + lu(k,381) = lu(k,381) * lu(k,374) + lu(k,458) = lu(k,458) - lu(k,375) * lu(k,457) + lu(k,460) = lu(k,460) - lu(k,376) * lu(k,457) + lu(k,464) = - lu(k,377) * lu(k,457) + lu(k,465) = lu(k,465) - lu(k,378) * lu(k,457) + lu(k,466) = lu(k,466) - lu(k,379) * lu(k,457) + lu(k,467) = - lu(k,380) * lu(k,457) + lu(k,468) = lu(k,468) - lu(k,381) * lu(k,457) + lu(k,779) = - lu(k,375) * lu(k,776) + lu(k,787) = - lu(k,376) * lu(k,776) + lu(k,794) = - lu(k,377) * lu(k,776) + lu(k,795) = - lu(k,378) * lu(k,776) + lu(k,799) = lu(k,799) - lu(k,379) * lu(k,776) + lu(k,801) = - lu(k,380) * lu(k,776) + lu(k,802) = lu(k,802) - lu(k,381) * lu(k,776) + lu(k,1272) = lu(k,1272) - lu(k,375) * lu(k,1269) + lu(k,1287) = lu(k,1287) - lu(k,376) * lu(k,1269) + lu(k,1298) = lu(k,1298) - lu(k,377) * lu(k,1269) + lu(k,1299) = lu(k,1299) - lu(k,378) * lu(k,1269) + lu(k,1304) = lu(k,1304) - lu(k,379) * lu(k,1269) + lu(k,1306) = lu(k,1306) - lu(k,380) * lu(k,1269) + lu(k,1307) = lu(k,1307) - lu(k,381) * lu(k,1269) + lu(k,1523) = - lu(k,375) * lu(k,1522) + lu(k,1532) = lu(k,1532) - lu(k,376) * lu(k,1522) + lu(k,1543) = lu(k,1543) - lu(k,377) * lu(k,1522) + lu(k,1544) = lu(k,1544) - lu(k,378) * lu(k,1522) + lu(k,1549) = lu(k,1549) - lu(k,379) * lu(k,1522) + lu(k,1551) = lu(k,1551) - lu(k,380) * lu(k,1522) + lu(k,1552) = lu(k,1552) - lu(k,381) * lu(k,1522) + lu(k,1791) = lu(k,1791) - lu(k,375) * lu(k,1788) + lu(k,1804) = lu(k,1804) - lu(k,376) * lu(k,1788) + lu(k,1815) = lu(k,1815) - lu(k,377) * lu(k,1788) + lu(k,1816) = lu(k,1816) - lu(k,378) * lu(k,1788) + lu(k,1821) = lu(k,1821) - lu(k,379) * lu(k,1788) + lu(k,1823) = lu(k,1823) - lu(k,380) * lu(k,1788) + lu(k,1824) = lu(k,1824) - lu(k,381) * lu(k,1788) + lu(k,1862) = - lu(k,375) * lu(k,1861) + lu(k,1873) = lu(k,1873) - lu(k,376) * lu(k,1861) + lu(k,1884) = - lu(k,377) * lu(k,1861) + lu(k,1885) = - lu(k,378) * lu(k,1861) + lu(k,1890) = lu(k,1890) - lu(k,379) * lu(k,1861) + lu(k,1892) = lu(k,1892) - lu(k,380) * lu(k,1861) + lu(k,1893) = lu(k,1893) - lu(k,381) * lu(k,1861) + lu(k,1901) = - lu(k,375) * lu(k,1900) + lu(k,1914) = lu(k,1914) - lu(k,376) * lu(k,1900) + lu(k,1925) = lu(k,1925) - lu(k,377) * lu(k,1900) + lu(k,1926) = - lu(k,378) * lu(k,1900) + lu(k,1931) = lu(k,1931) - lu(k,379) * lu(k,1900) + lu(k,1933) = lu(k,1933) - lu(k,380) * lu(k,1900) + lu(k,1934) = lu(k,1934) - lu(k,381) * lu(k,1900) + lu(k,1946) = - lu(k,375) * lu(k,1943) + lu(k,1956) = lu(k,1956) - lu(k,376) * lu(k,1943) + lu(k,1967) = lu(k,1967) - lu(k,377) * lu(k,1943) + lu(k,1968) = lu(k,1968) - lu(k,378) * lu(k,1943) + lu(k,1973) = lu(k,1973) - lu(k,379) * lu(k,1943) + lu(k,1975) = lu(k,1975) - lu(k,380) * lu(k,1943) + lu(k,1976) = - lu(k,381) * lu(k,1943) + lu(k,385) = 1._r8 / lu(k,385) + lu(k,386) = lu(k,386) * lu(k,385) + lu(k,387) = lu(k,387) * lu(k,385) + lu(k,388) = lu(k,388) * lu(k,385) + lu(k,389) = lu(k,389) * lu(k,385) + lu(k,390) = lu(k,390) * lu(k,385) + lu(k,391) = lu(k,391) * lu(k,385) + lu(k,392) = lu(k,392) * lu(k,385) + lu(k,393) = lu(k,393) * lu(k,385) + lu(k,394) = lu(k,394) * lu(k,385) + lu(k,395) = lu(k,395) * lu(k,385) + lu(k,443) = lu(k,443) - lu(k,386) * lu(k,442) + lu(k,444) = lu(k,444) - lu(k,387) * lu(k,442) + lu(k,445) = - lu(k,388) * lu(k,442) + lu(k,446) = lu(k,446) - lu(k,389) * lu(k,442) + lu(k,448) = lu(k,448) - lu(k,390) * lu(k,442) + lu(k,449) = lu(k,449) - lu(k,391) * lu(k,442) + lu(k,451) = lu(k,451) - lu(k,392) * lu(k,442) + lu(k,453) = lu(k,453) - lu(k,393) * lu(k,442) + lu(k,454) = lu(k,454) - lu(k,394) * lu(k,442) + lu(k,455) = - lu(k,395) * lu(k,442) + lu(k,1050) = lu(k,1050) - lu(k,386) * lu(k,1049) + lu(k,1052) = lu(k,1052) - lu(k,387) * lu(k,1049) + lu(k,1053) = - lu(k,388) * lu(k,1049) + lu(k,1054) = lu(k,1054) - lu(k,389) * lu(k,1049) + lu(k,1057) = lu(k,1057) - lu(k,390) * lu(k,1049) + lu(k,1060) = lu(k,1060) - lu(k,391) * lu(k,1049) + lu(k,1067) = lu(k,1067) - lu(k,392) * lu(k,1049) + lu(k,1070) = lu(k,1070) - lu(k,393) * lu(k,1049) + lu(k,1072) = lu(k,1072) - lu(k,394) * lu(k,1049) + lu(k,1076) = lu(k,1076) - lu(k,395) * lu(k,1049) + lu(k,1124) = lu(k,1124) - lu(k,386) * lu(k,1123) + lu(k,1135) = lu(k,1135) - lu(k,387) * lu(k,1123) + lu(k,1139) = - lu(k,388) * lu(k,1123) + lu(k,1141) = lu(k,1141) - lu(k,389) * lu(k,1123) + lu(k,1145) = lu(k,1145) - lu(k,390) * lu(k,1123) + lu(k,1148) = lu(k,1148) - lu(k,391) * lu(k,1123) + lu(k,1155) = lu(k,1155) - lu(k,392) * lu(k,1123) + lu(k,1158) = lu(k,1158) - lu(k,393) * lu(k,1123) + lu(k,1160) = lu(k,1160) - lu(k,394) * lu(k,1123) + lu(k,1164) = lu(k,1164) - lu(k,395) * lu(k,1123) + lu(k,1271) = lu(k,1271) - lu(k,386) * lu(k,1270) + lu(k,1279) = lu(k,1279) - lu(k,387) * lu(k,1270) + lu(k,1283) = lu(k,1283) - lu(k,388) * lu(k,1270) + lu(k,1285) = lu(k,1285) - lu(k,389) * lu(k,1270) + lu(k,1289) = lu(k,1289) - lu(k,390) * lu(k,1270) + lu(k,1292) = lu(k,1292) - lu(k,391) * lu(k,1270) + lu(k,1299) = lu(k,1299) - lu(k,392) * lu(k,1270) + lu(k,1302) = lu(k,1302) - lu(k,393) * lu(k,1270) + lu(k,1304) = lu(k,1304) - lu(k,394) * lu(k,1270) + lu(k,1308) = lu(k,1308) - lu(k,395) * lu(k,1270) + lu(k,1790) = lu(k,1790) - lu(k,386) * lu(k,1789) + lu(k,1797) = lu(k,1797) - lu(k,387) * lu(k,1789) + lu(k,1800) = lu(k,1800) - lu(k,388) * lu(k,1789) + lu(k,1802) = lu(k,1802) - lu(k,389) * lu(k,1789) + lu(k,1806) = lu(k,1806) - lu(k,390) * lu(k,1789) + lu(k,1809) = lu(k,1809) - lu(k,391) * lu(k,1789) + lu(k,1816) = lu(k,1816) - lu(k,392) * lu(k,1789) + lu(k,1819) = lu(k,1819) - lu(k,393) * lu(k,1789) + lu(k,1821) = lu(k,1821) - lu(k,394) * lu(k,1789) + lu(k,1825) = lu(k,1825) - lu(k,395) * lu(k,1789) + lu(k,1945) = - lu(k,386) * lu(k,1944) + lu(k,1949) = - lu(k,387) * lu(k,1944) + lu(k,1952) = lu(k,1952) - lu(k,388) * lu(k,1944) + lu(k,1954) = lu(k,1954) - lu(k,389) * lu(k,1944) + lu(k,1958) = lu(k,1958) - lu(k,390) * lu(k,1944) + lu(k,1961) = lu(k,1961) - lu(k,391) * lu(k,1944) + lu(k,1968) = lu(k,1968) - lu(k,392) * lu(k,1944) + lu(k,1971) = lu(k,1971) - lu(k,393) * lu(k,1944) + lu(k,1973) = lu(k,1973) - lu(k,394) * lu(k,1944) + lu(k,1977) = lu(k,1977) - lu(k,395) * lu(k,1944) end do end subroutine lu_fac09 subroutine lu_fac10( avec_len, lu ) @@ -1802,379 +1723,183 @@ subroutine lu_fac10( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,350) = 1._r8 / lu(k,350) - lu(k,351) = lu(k,351) * lu(k,350) - lu(k,352) = lu(k,352) * lu(k,350) - lu(k,353) = lu(k,353) * lu(k,350) - lu(k,354) = lu(k,354) * lu(k,350) - lu(k,355) = lu(k,355) * lu(k,350) - lu(k,356) = lu(k,356) * lu(k,350) - lu(k,357) = lu(k,357) * lu(k,350) - lu(k,358) = lu(k,358) * lu(k,350) - lu(k,359) = lu(k,359) * lu(k,350) - lu(k,360) = lu(k,360) * lu(k,350) - lu(k,361) = lu(k,361) * lu(k,350) - lu(k,639) = lu(k,639) - lu(k,351) * lu(k,632) - lu(k,641) = - lu(k,352) * lu(k,632) - lu(k,644) = lu(k,644) - lu(k,353) * lu(k,632) - lu(k,645) = lu(k,645) - lu(k,354) * lu(k,632) - lu(k,647) = lu(k,647) - lu(k,355) * lu(k,632) - lu(k,648) = lu(k,648) - lu(k,356) * lu(k,632) - lu(k,649) = lu(k,649) - lu(k,357) * lu(k,632) - lu(k,652) = lu(k,652) - lu(k,358) * lu(k,632) - lu(k,654) = lu(k,654) - lu(k,359) * lu(k,632) - lu(k,656) = lu(k,656) - lu(k,360) * lu(k,632) - lu(k,657) = lu(k,657) - lu(k,361) * lu(k,632) - lu(k,1192) = lu(k,1192) - lu(k,351) * lu(k,1181) - lu(k,1198) = - lu(k,352) * lu(k,1181) - lu(k,1202) = lu(k,1202) - lu(k,353) * lu(k,1181) - lu(k,1203) = lu(k,1203) - lu(k,354) * lu(k,1181) - lu(k,1205) = lu(k,1205) - lu(k,355) * lu(k,1181) - lu(k,1206) = lu(k,1206) - lu(k,356) * lu(k,1181) - lu(k,1207) = lu(k,1207) - lu(k,357) * lu(k,1181) - lu(k,1210) = lu(k,1210) - lu(k,358) * lu(k,1181) - lu(k,1213) = lu(k,1213) - lu(k,359) * lu(k,1181) - lu(k,1216) = lu(k,1216) - lu(k,360) * lu(k,1181) - lu(k,1217) = lu(k,1217) - lu(k,361) * lu(k,1181) - lu(k,1241) = lu(k,1241) - lu(k,351) * lu(k,1230) - lu(k,1247) = - lu(k,352) * lu(k,1230) - lu(k,1251) = lu(k,1251) - lu(k,353) * lu(k,1230) - lu(k,1252) = lu(k,1252) - lu(k,354) * lu(k,1230) - lu(k,1254) = lu(k,1254) - lu(k,355) * lu(k,1230) - lu(k,1255) = lu(k,1255) - lu(k,356) * lu(k,1230) - lu(k,1256) = lu(k,1256) - lu(k,357) * lu(k,1230) - lu(k,1259) = lu(k,1259) - lu(k,358) * lu(k,1230) - lu(k,1262) = lu(k,1262) - lu(k,359) * lu(k,1230) - lu(k,1265) = lu(k,1265) - lu(k,360) * lu(k,1230) - lu(k,1266) = lu(k,1266) - lu(k,361) * lu(k,1230) - lu(k,1315) = - lu(k,351) * lu(k,1309) - lu(k,1321) = lu(k,1321) - lu(k,352) * lu(k,1309) - lu(k,1325) = lu(k,1325) - lu(k,353) * lu(k,1309) - lu(k,1326) = lu(k,1326) - lu(k,354) * lu(k,1309) - lu(k,1328) = lu(k,1328) - lu(k,355) * lu(k,1309) - lu(k,1329) = lu(k,1329) - lu(k,356) * lu(k,1309) - lu(k,1330) = lu(k,1330) - lu(k,357) * lu(k,1309) - lu(k,1333) = lu(k,1333) - lu(k,358) * lu(k,1309) - lu(k,1336) = lu(k,1336) - lu(k,359) * lu(k,1309) - lu(k,1339) = lu(k,1339) - lu(k,360) * lu(k,1309) - lu(k,1340) = lu(k,1340) - lu(k,361) * lu(k,1309) - lu(k,1359) = lu(k,1359) - lu(k,351) * lu(k,1344) - lu(k,1365) = lu(k,1365) - lu(k,352) * lu(k,1344) - lu(k,1369) = - lu(k,353) * lu(k,1344) - lu(k,1370) = lu(k,1370) - lu(k,354) * lu(k,1344) - lu(k,1372) = lu(k,1372) - lu(k,355) * lu(k,1344) - lu(k,1373) = lu(k,1373) - lu(k,356) * lu(k,1344) - lu(k,1374) = lu(k,1374) - lu(k,357) * lu(k,1344) - lu(k,1377) = lu(k,1377) - lu(k,358) * lu(k,1344) - lu(k,1380) = - lu(k,359) * lu(k,1344) - lu(k,1383) = lu(k,1383) - lu(k,360) * lu(k,1344) - lu(k,1384) = lu(k,1384) - lu(k,361) * lu(k,1344) - lu(k,1418) = lu(k,1418) - lu(k,351) * lu(k,1406) - lu(k,1424) = - lu(k,352) * lu(k,1406) - lu(k,1428) = lu(k,1428) - lu(k,353) * lu(k,1406) - lu(k,1429) = lu(k,1429) - lu(k,354) * lu(k,1406) - lu(k,1431) = lu(k,1431) - lu(k,355) * lu(k,1406) - lu(k,1432) = lu(k,1432) - lu(k,356) * lu(k,1406) - lu(k,1433) = lu(k,1433) - lu(k,357) * lu(k,1406) - lu(k,1436) = lu(k,1436) - lu(k,358) * lu(k,1406) - lu(k,1439) = lu(k,1439) - lu(k,359) * lu(k,1406) - lu(k,1442) = lu(k,1442) - lu(k,360) * lu(k,1406) - lu(k,1443) = lu(k,1443) - lu(k,361) * lu(k,1406) - lu(k,1545) = lu(k,1545) - lu(k,351) * lu(k,1542) - lu(k,1549) = lu(k,1549) - lu(k,352) * lu(k,1542) - lu(k,1553) = lu(k,1553) - lu(k,353) * lu(k,1542) - lu(k,1554) = lu(k,1554) - lu(k,354) * lu(k,1542) - lu(k,1556) = lu(k,1556) - lu(k,355) * lu(k,1542) - lu(k,1557) = lu(k,1557) - lu(k,356) * lu(k,1542) - lu(k,1558) = lu(k,1558) - lu(k,357) * lu(k,1542) - lu(k,1561) = lu(k,1561) - lu(k,358) * lu(k,1542) - lu(k,1564) = lu(k,1564) - lu(k,359) * lu(k,1542) - lu(k,1567) = lu(k,1567) - lu(k,360) * lu(k,1542) - lu(k,1568) = lu(k,1568) - lu(k,361) * lu(k,1542) - lu(k,1652) = lu(k,1652) - lu(k,351) * lu(k,1644) - lu(k,1658) = - lu(k,352) * lu(k,1644) - lu(k,1662) = lu(k,1662) - lu(k,353) * lu(k,1644) - lu(k,1663) = lu(k,1663) - lu(k,354) * lu(k,1644) - lu(k,1665) = lu(k,1665) - lu(k,355) * lu(k,1644) - lu(k,1666) = lu(k,1666) - lu(k,356) * lu(k,1644) - lu(k,1667) = lu(k,1667) - lu(k,357) * lu(k,1644) - lu(k,1670) = lu(k,1670) - lu(k,358) * lu(k,1644) - lu(k,1673) = lu(k,1673) - lu(k,359) * lu(k,1644) - lu(k,1676) = lu(k,1676) - lu(k,360) * lu(k,1644) - lu(k,1677) = lu(k,1677) - lu(k,361) * lu(k,1644) - lu(k,1831) = lu(k,1831) - lu(k,351) * lu(k,1815) - lu(k,1837) = lu(k,1837) - lu(k,352) * lu(k,1815) - lu(k,1841) = - lu(k,353) * lu(k,1815) - lu(k,1842) = lu(k,1842) - lu(k,354) * lu(k,1815) - lu(k,1844) = - lu(k,355) * lu(k,1815) - lu(k,1845) = lu(k,1845) - lu(k,356) * lu(k,1815) - lu(k,1846) = lu(k,1846) - lu(k,357) * lu(k,1815) - lu(k,1849) = lu(k,1849) - lu(k,358) * lu(k,1815) - lu(k,1852) = lu(k,1852) - lu(k,359) * lu(k,1815) - lu(k,1855) = lu(k,1855) - lu(k,360) * lu(k,1815) - lu(k,1856) = lu(k,1856) - lu(k,361) * lu(k,1815) - lu(k,362) = 1._r8 / lu(k,362) - lu(k,363) = lu(k,363) * lu(k,362) - lu(k,364) = lu(k,364) * lu(k,362) - lu(k,365) = lu(k,365) * lu(k,362) - lu(k,366) = lu(k,366) * lu(k,362) - lu(k,367) = lu(k,367) * lu(k,362) - lu(k,368) = lu(k,368) * lu(k,362) - lu(k,369) = lu(k,369) * lu(k,362) - lu(k,370) = lu(k,370) * lu(k,362) - lu(k,371) = lu(k,371) * lu(k,362) - lu(k,372) = lu(k,372) * lu(k,362) - lu(k,373) = lu(k,373) * lu(k,362) - lu(k,374) = lu(k,374) * lu(k,362) - lu(k,375) = lu(k,375) * lu(k,362) - lu(k,539) = lu(k,539) - lu(k,363) * lu(k,537) - lu(k,544) = lu(k,544) - lu(k,364) * lu(k,537) - lu(k,545) = lu(k,545) - lu(k,365) * lu(k,537) - lu(k,547) = lu(k,547) - lu(k,366) * lu(k,537) - lu(k,548) = lu(k,548) - lu(k,367) * lu(k,537) - lu(k,549) = lu(k,549) - lu(k,368) * lu(k,537) - lu(k,550) = lu(k,550) - lu(k,369) * lu(k,537) - lu(k,551) = lu(k,551) - lu(k,370) * lu(k,537) - lu(k,552) = lu(k,552) - lu(k,371) * lu(k,537) - lu(k,553) = lu(k,553) - lu(k,372) * lu(k,537) - lu(k,554) = lu(k,554) - lu(k,373) * lu(k,537) - lu(k,555) = lu(k,555) - lu(k,374) * lu(k,537) - lu(k,556) = lu(k,556) - lu(k,375) * lu(k,537) - lu(k,890) = lu(k,890) - lu(k,363) * lu(k,883) - lu(k,900) = lu(k,900) - lu(k,364) * lu(k,883) - lu(k,901) = lu(k,901) - lu(k,365) * lu(k,883) - lu(k,903) = lu(k,903) - lu(k,366) * lu(k,883) - lu(k,904) = lu(k,904) - lu(k,367) * lu(k,883) - lu(k,908) = lu(k,908) - lu(k,368) * lu(k,883) - lu(k,911) = lu(k,911) - lu(k,369) * lu(k,883) - lu(k,912) = lu(k,912) - lu(k,370) * lu(k,883) - lu(k,914) = lu(k,914) - lu(k,371) * lu(k,883) - lu(k,916) = lu(k,916) - lu(k,372) * lu(k,883) - lu(k,919) = lu(k,919) - lu(k,373) * lu(k,883) - lu(k,921) = lu(k,921) - lu(k,374) * lu(k,883) - lu(k,922) = lu(k,922) - lu(k,375) * lu(k,883) - lu(k,933) = lu(k,933) - lu(k,363) * lu(k,926) - lu(k,942) = lu(k,942) - lu(k,364) * lu(k,926) - lu(k,943) = lu(k,943) - lu(k,365) * lu(k,926) - lu(k,945) = lu(k,945) - lu(k,366) * lu(k,926) - lu(k,946) = lu(k,946) - lu(k,367) * lu(k,926) - lu(k,950) = lu(k,950) - lu(k,368) * lu(k,926) - lu(k,953) = lu(k,953) - lu(k,369) * lu(k,926) - lu(k,954) = lu(k,954) - lu(k,370) * lu(k,926) - lu(k,956) = lu(k,956) - lu(k,371) * lu(k,926) - lu(k,958) = lu(k,958) - lu(k,372) * lu(k,926) - lu(k,961) = lu(k,961) - lu(k,373) * lu(k,926) - lu(k,963) = lu(k,963) - lu(k,374) * lu(k,926) - lu(k,964) = lu(k,964) - lu(k,375) * lu(k,926) - lu(k,1021) = lu(k,1021) - lu(k,363) * lu(k,1014) - lu(k,1030) = lu(k,1030) - lu(k,364) * lu(k,1014) - lu(k,1031) = lu(k,1031) - lu(k,365) * lu(k,1014) - lu(k,1033) = lu(k,1033) - lu(k,366) * lu(k,1014) - lu(k,1034) = lu(k,1034) - lu(k,367) * lu(k,1014) - lu(k,1038) = lu(k,1038) - lu(k,368) * lu(k,1014) - lu(k,1041) = lu(k,1041) - lu(k,369) * lu(k,1014) - lu(k,1042) = lu(k,1042) - lu(k,370) * lu(k,1014) - lu(k,1044) = lu(k,1044) - lu(k,371) * lu(k,1014) - lu(k,1046) = lu(k,1046) - lu(k,372) * lu(k,1014) - lu(k,1049) = lu(k,1049) - lu(k,373) * lu(k,1014) - lu(k,1051) = lu(k,1051) - lu(k,374) * lu(k,1014) - lu(k,1052) = lu(k,1052) - lu(k,375) * lu(k,1014) - lu(k,1062) = lu(k,1062) - lu(k,363) * lu(k,1055) - lu(k,1071) = lu(k,1071) - lu(k,364) * lu(k,1055) - lu(k,1072) = lu(k,1072) - lu(k,365) * lu(k,1055) - lu(k,1074) = lu(k,1074) - lu(k,366) * lu(k,1055) - lu(k,1075) = lu(k,1075) - lu(k,367) * lu(k,1055) - lu(k,1079) = lu(k,1079) - lu(k,368) * lu(k,1055) - lu(k,1082) = lu(k,1082) - lu(k,369) * lu(k,1055) - lu(k,1083) = lu(k,1083) - lu(k,370) * lu(k,1055) - lu(k,1085) = lu(k,1085) - lu(k,371) * lu(k,1055) - lu(k,1087) = lu(k,1087) - lu(k,372) * lu(k,1055) - lu(k,1090) = lu(k,1090) - lu(k,373) * lu(k,1055) - lu(k,1092) = lu(k,1092) - lu(k,374) * lu(k,1055) - lu(k,1093) = lu(k,1093) - lu(k,375) * lu(k,1055) - lu(k,1352) = lu(k,1352) - lu(k,363) * lu(k,1345) - lu(k,1362) = lu(k,1362) - lu(k,364) * lu(k,1345) - lu(k,1363) = lu(k,1363) - lu(k,365) * lu(k,1345) - lu(k,1365) = lu(k,1365) - lu(k,366) * lu(k,1345) - lu(k,1366) = lu(k,1366) - lu(k,367) * lu(k,1345) - lu(k,1370) = lu(k,1370) - lu(k,368) * lu(k,1345) - lu(k,1373) = lu(k,1373) - lu(k,369) * lu(k,1345) - lu(k,1374) = lu(k,1374) - lu(k,370) * lu(k,1345) - lu(k,1376) = lu(k,1376) - lu(k,371) * lu(k,1345) - lu(k,1378) = lu(k,1378) - lu(k,372) * lu(k,1345) - lu(k,1381) = lu(k,1381) - lu(k,373) * lu(k,1345) - lu(k,1383) = lu(k,1383) - lu(k,374) * lu(k,1345) - lu(k,1384) = lu(k,1384) - lu(k,375) * lu(k,1345) - lu(k,1579) = lu(k,1579) - lu(k,363) * lu(k,1572) - lu(k,1588) = lu(k,1588) - lu(k,364) * lu(k,1572) - lu(k,1589) = lu(k,1589) - lu(k,365) * lu(k,1572) - lu(k,1591) = lu(k,1591) - lu(k,366) * lu(k,1572) - lu(k,1592) = lu(k,1592) - lu(k,367) * lu(k,1572) - lu(k,1596) = lu(k,1596) - lu(k,368) * lu(k,1572) - lu(k,1599) = lu(k,1599) - lu(k,369) * lu(k,1572) - lu(k,1600) = lu(k,1600) - lu(k,370) * lu(k,1572) - lu(k,1602) = lu(k,1602) - lu(k,371) * lu(k,1572) - lu(k,1604) = lu(k,1604) - lu(k,372) * lu(k,1572) - lu(k,1607) = lu(k,1607) - lu(k,373) * lu(k,1572) - lu(k,1609) = lu(k,1609) - lu(k,374) * lu(k,1572) - lu(k,1610) = lu(k,1610) - lu(k,375) * lu(k,1572) - lu(k,1688) = lu(k,1688) - lu(k,363) * lu(k,1681) - lu(k,1697) = lu(k,1697) - lu(k,364) * lu(k,1681) - lu(k,1698) = lu(k,1698) - lu(k,365) * lu(k,1681) - lu(k,1700) = lu(k,1700) - lu(k,366) * lu(k,1681) - lu(k,1701) = lu(k,1701) - lu(k,367) * lu(k,1681) - lu(k,1705) = lu(k,1705) - lu(k,368) * lu(k,1681) - lu(k,1708) = lu(k,1708) - lu(k,369) * lu(k,1681) - lu(k,1709) = lu(k,1709) - lu(k,370) * lu(k,1681) - lu(k,1711) = lu(k,1711) - lu(k,371) * lu(k,1681) - lu(k,1713) = lu(k,1713) - lu(k,372) * lu(k,1681) - lu(k,1716) = lu(k,1716) - lu(k,373) * lu(k,1681) - lu(k,1718) = lu(k,1718) - lu(k,374) * lu(k,1681) - lu(k,1719) = lu(k,1719) - lu(k,375) * lu(k,1681) - lu(k,1823) = lu(k,1823) - lu(k,363) * lu(k,1816) - lu(k,1834) = lu(k,1834) - lu(k,364) * lu(k,1816) - lu(k,1835) = lu(k,1835) - lu(k,365) * lu(k,1816) - lu(k,1837) = lu(k,1837) - lu(k,366) * lu(k,1816) - lu(k,1838) = lu(k,1838) - lu(k,367) * lu(k,1816) - lu(k,1842) = lu(k,1842) - lu(k,368) * lu(k,1816) - lu(k,1845) = lu(k,1845) - lu(k,369) * lu(k,1816) - lu(k,1846) = lu(k,1846) - lu(k,370) * lu(k,1816) - lu(k,1848) = lu(k,1848) - lu(k,371) * lu(k,1816) - lu(k,1850) = lu(k,1850) - lu(k,372) * lu(k,1816) - lu(k,1853) = lu(k,1853) - lu(k,373) * lu(k,1816) - lu(k,1855) = lu(k,1855) - lu(k,374) * lu(k,1816) - lu(k,1856) = lu(k,1856) - lu(k,375) * lu(k,1816) - lu(k,379) = 1._r8 / lu(k,379) - lu(k,380) = lu(k,380) * lu(k,379) - lu(k,381) = lu(k,381) * lu(k,379) - lu(k,382) = lu(k,382) * lu(k,379) - lu(k,383) = lu(k,383) * lu(k,379) - lu(k,384) = lu(k,384) * lu(k,379) - lu(k,385) = lu(k,385) * lu(k,379) - lu(k,386) = lu(k,386) * lu(k,379) - lu(k,387) = lu(k,387) * lu(k,379) - lu(k,388) = lu(k,388) * lu(k,379) - lu(k,389) = lu(k,389) * lu(k,379) - lu(k,390) = lu(k,390) * lu(k,379) - lu(k,391) = lu(k,391) * lu(k,379) - lu(k,392) = lu(k,392) * lu(k,379) - lu(k,583) = lu(k,583) - lu(k,380) * lu(k,582) - lu(k,584) = lu(k,584) - lu(k,381) * lu(k,582) - lu(k,587) = lu(k,587) - lu(k,382) * lu(k,582) - lu(k,588) = lu(k,588) - lu(k,383) * lu(k,582) - lu(k,589) = lu(k,589) - lu(k,384) * lu(k,582) - lu(k,592) = - lu(k,385) * lu(k,582) - lu(k,593) = lu(k,593) - lu(k,386) * lu(k,582) - lu(k,595) = lu(k,595) - lu(k,387) * lu(k,582) - lu(k,596) = lu(k,596) - lu(k,388) * lu(k,582) - lu(k,597) = lu(k,597) - lu(k,389) * lu(k,582) - lu(k,598) = lu(k,598) - lu(k,390) * lu(k,582) - lu(k,599) = - lu(k,391) * lu(k,582) - lu(k,600) = lu(k,600) - lu(k,392) * lu(k,582) - lu(k,788) = lu(k,788) - lu(k,380) * lu(k,787) - lu(k,790) = lu(k,790) - lu(k,381) * lu(k,787) - lu(k,793) = lu(k,793) - lu(k,382) * lu(k,787) - lu(k,794) = lu(k,794) - lu(k,383) * lu(k,787) - lu(k,796) = lu(k,796) - lu(k,384) * lu(k,787) - lu(k,801) = lu(k,801) - lu(k,385) * lu(k,787) - lu(k,802) = lu(k,802) - lu(k,386) * lu(k,787) - lu(k,806) = lu(k,806) - lu(k,387) * lu(k,787) - lu(k,807) = lu(k,807) - lu(k,388) * lu(k,787) - lu(k,808) = lu(k,808) - lu(k,389) * lu(k,787) - lu(k,812) = lu(k,812) - lu(k,390) * lu(k,787) - lu(k,813) = lu(k,813) - lu(k,391) * lu(k,787) - lu(k,814) = lu(k,814) - lu(k,392) * lu(k,787) - lu(k,974) = lu(k,974) - lu(k,380) * lu(k,972) - lu(k,979) = lu(k,979) - lu(k,381) * lu(k,972) - lu(k,984) = lu(k,984) - lu(k,382) * lu(k,972) - lu(k,985) = lu(k,985) - lu(k,383) * lu(k,972) - lu(k,990) = lu(k,990) - lu(k,384) * lu(k,972) - lu(k,995) = lu(k,995) - lu(k,385) * lu(k,972) - lu(k,996) = lu(k,996) - lu(k,386) * lu(k,972) - lu(k,1000) = lu(k,1000) - lu(k,387) * lu(k,972) - lu(k,1001) = lu(k,1001) - lu(k,388) * lu(k,972) - lu(k,1002) = lu(k,1002) - lu(k,389) * lu(k,972) - lu(k,1008) = lu(k,1008) - lu(k,390) * lu(k,972) - lu(k,1009) = lu(k,1009) - lu(k,391) * lu(k,972) - lu(k,1010) = lu(k,1010) - lu(k,392) * lu(k,972) - lu(k,1099) = - lu(k,380) * lu(k,1098) - lu(k,1103) = - lu(k,381) * lu(k,1098) - lu(k,1107) = lu(k,1107) - lu(k,382) * lu(k,1098) - lu(k,1108) = lu(k,1108) - lu(k,383) * lu(k,1098) - lu(k,1112) = lu(k,1112) - lu(k,384) * lu(k,1098) - lu(k,1117) = - lu(k,385) * lu(k,1098) - lu(k,1118) = lu(k,1118) - lu(k,386) * lu(k,1098) - lu(k,1122) = lu(k,1122) - lu(k,387) * lu(k,1098) - lu(k,1123) = - lu(k,388) * lu(k,1098) - lu(k,1124) = lu(k,1124) - lu(k,389) * lu(k,1098) - lu(k,1130) = - lu(k,390) * lu(k,1098) - lu(k,1131) = lu(k,1131) - lu(k,391) * lu(k,1098) - lu(k,1132) = lu(k,1132) - lu(k,392) * lu(k,1098) - lu(k,1184) = lu(k,1184) - lu(k,380) * lu(k,1182) - lu(k,1185) = lu(k,1185) - lu(k,381) * lu(k,1182) - lu(k,1191) = lu(k,1191) - lu(k,382) * lu(k,1182) - lu(k,1192) = lu(k,1192) - lu(k,383) * lu(k,1182) - lu(k,1197) = lu(k,1197) - lu(k,384) * lu(k,1182) - lu(k,1202) = lu(k,1202) - lu(k,385) * lu(k,1182) - lu(k,1203) = lu(k,1203) - lu(k,386) * lu(k,1182) - lu(k,1207) = lu(k,1207) - lu(k,387) * lu(k,1182) - lu(k,1208) = lu(k,1208) - lu(k,388) * lu(k,1182) - lu(k,1209) = lu(k,1209) - lu(k,389) * lu(k,1182) - lu(k,1215) = lu(k,1215) - lu(k,390) * lu(k,1182) - lu(k,1216) = lu(k,1216) - lu(k,391) * lu(k,1182) - lu(k,1217) = lu(k,1217) - lu(k,392) * lu(k,1182) - lu(k,1233) = - lu(k,380) * lu(k,1231) - lu(k,1234) = - lu(k,381) * lu(k,1231) - lu(k,1240) = lu(k,1240) - lu(k,382) * lu(k,1231) - lu(k,1241) = lu(k,1241) - lu(k,383) * lu(k,1231) - lu(k,1246) = lu(k,1246) - lu(k,384) * lu(k,1231) - lu(k,1251) = lu(k,1251) - lu(k,385) * lu(k,1231) - lu(k,1252) = lu(k,1252) - lu(k,386) * lu(k,1231) - lu(k,1256) = lu(k,1256) - lu(k,387) * lu(k,1231) - lu(k,1257) = - lu(k,388) * lu(k,1231) - lu(k,1258) = lu(k,1258) - lu(k,389) * lu(k,1231) - lu(k,1264) = - lu(k,390) * lu(k,1231) - lu(k,1265) = lu(k,1265) - lu(k,391) * lu(k,1231) - lu(k,1266) = lu(k,1266) - lu(k,392) * lu(k,1231) - lu(k,1409) = lu(k,1409) - lu(k,380) * lu(k,1407) - lu(k,1411) = lu(k,1411) - lu(k,381) * lu(k,1407) - lu(k,1417) = lu(k,1417) - lu(k,382) * lu(k,1407) - lu(k,1418) = lu(k,1418) - lu(k,383) * lu(k,1407) - lu(k,1423) = lu(k,1423) - lu(k,384) * lu(k,1407) - lu(k,1428) = lu(k,1428) - lu(k,385) * lu(k,1407) - lu(k,1429) = lu(k,1429) - lu(k,386) * lu(k,1407) - lu(k,1433) = lu(k,1433) - lu(k,387) * lu(k,1407) - lu(k,1434) = lu(k,1434) - lu(k,388) * lu(k,1407) - lu(k,1435) = lu(k,1435) - lu(k,389) * lu(k,1407) - lu(k,1441) = lu(k,1441) - lu(k,390) * lu(k,1407) - lu(k,1442) = lu(k,1442) - lu(k,391) * lu(k,1407) - lu(k,1443) = lu(k,1443) - lu(k,392) * lu(k,1407) - lu(k,1730) = lu(k,1730) - lu(k,380) * lu(k,1729) - lu(k,1731) = lu(k,1731) - lu(k,381) * lu(k,1729) - lu(k,1737) = lu(k,1737) - lu(k,382) * lu(k,1729) - lu(k,1738) = lu(k,1738) - lu(k,383) * lu(k,1729) - lu(k,1743) = lu(k,1743) - lu(k,384) * lu(k,1729) - lu(k,1748) = - lu(k,385) * lu(k,1729) - lu(k,1749) = lu(k,1749) - lu(k,386) * lu(k,1729) - lu(k,1753) = lu(k,1753) - lu(k,387) * lu(k,1729) - lu(k,1754) = lu(k,1754) - lu(k,388) * lu(k,1729) - lu(k,1755) = lu(k,1755) - lu(k,389) * lu(k,1729) - lu(k,1761) = lu(k,1761) - lu(k,390) * lu(k,1729) - lu(k,1762) = lu(k,1762) - lu(k,391) * lu(k,1729) - lu(k,1763) = lu(k,1763) - lu(k,392) * lu(k,1729) - lu(k,1820) = - lu(k,380) * lu(k,1817) - lu(k,1825) = - lu(k,381) * lu(k,1817) - lu(k,1830) = lu(k,1830) - lu(k,382) * lu(k,1817) - lu(k,1831) = lu(k,1831) - lu(k,383) * lu(k,1817) - lu(k,1836) = lu(k,1836) - lu(k,384) * lu(k,1817) - lu(k,1841) = lu(k,1841) - lu(k,385) * lu(k,1817) - lu(k,1842) = lu(k,1842) - lu(k,386) * lu(k,1817) - lu(k,1846) = lu(k,1846) - lu(k,387) * lu(k,1817) - lu(k,1847) = lu(k,1847) - lu(k,388) * lu(k,1817) - lu(k,1848) = lu(k,1848) - lu(k,389) * lu(k,1817) - lu(k,1854) = lu(k,1854) - lu(k,390) * lu(k,1817) - lu(k,1855) = lu(k,1855) - lu(k,391) * lu(k,1817) - lu(k,1856) = lu(k,1856) - lu(k,392) * lu(k,1817) + lu(k,398) = 1._r8 / lu(k,398) + lu(k,399) = lu(k,399) * lu(k,398) + lu(k,400) = lu(k,400) * lu(k,398) + lu(k,401) = lu(k,401) * lu(k,398) + lu(k,402) = lu(k,402) * lu(k,398) + lu(k,403) = lu(k,403) * lu(k,398) + lu(k,404) = lu(k,404) * lu(k,398) + lu(k,405) = lu(k,405) * lu(k,398) + lu(k,406) = lu(k,406) * lu(k,398) + lu(k,407) = lu(k,407) * lu(k,398) + lu(k,408) = lu(k,408) * lu(k,398) + lu(k,409) = lu(k,409) * lu(k,398) + lu(k,621) = lu(k,621) - lu(k,399) * lu(k,620) + lu(k,622) = lu(k,622) - lu(k,400) * lu(k,620) + lu(k,623) = lu(k,623) - lu(k,401) * lu(k,620) + lu(k,625) = lu(k,625) - lu(k,402) * lu(k,620) + lu(k,628) = lu(k,628) - lu(k,403) * lu(k,620) + lu(k,629) = - lu(k,404) * lu(k,620) + lu(k,632) = lu(k,632) - lu(k,405) * lu(k,620) + lu(k,635) = - lu(k,406) * lu(k,620) + lu(k,636) = lu(k,636) - lu(k,407) * lu(k,620) + lu(k,637) = lu(k,637) - lu(k,408) * lu(k,620) + lu(k,639) = lu(k,639) - lu(k,409) * lu(k,620) + lu(k,686) = lu(k,686) - lu(k,399) * lu(k,685) + lu(k,687) = lu(k,687) - lu(k,400) * lu(k,685) + lu(k,688) = lu(k,688) - lu(k,401) * lu(k,685) + lu(k,690) = lu(k,690) - lu(k,402) * lu(k,685) + lu(k,693) = lu(k,693) - lu(k,403) * lu(k,685) + lu(k,694) = - lu(k,404) * lu(k,685) + lu(k,697) = lu(k,697) - lu(k,405) * lu(k,685) + lu(k,700) = - lu(k,406) * lu(k,685) + lu(k,701) = lu(k,701) - lu(k,407) * lu(k,685) + lu(k,702) = lu(k,702) - lu(k,408) * lu(k,685) + lu(k,704) = lu(k,704) - lu(k,409) * lu(k,685) + lu(k,1085) = - lu(k,399) * lu(k,1082) + lu(k,1086) = - lu(k,400) * lu(k,1082) + lu(k,1087) = - lu(k,401) * lu(k,1082) + lu(k,1096) = lu(k,1096) - lu(k,402) * lu(k,1082) + lu(k,1099) = lu(k,1099) - lu(k,403) * lu(k,1082) + lu(k,1100) = lu(k,1100) - lu(k,404) * lu(k,1082) + lu(k,1103) = - lu(k,405) * lu(k,1082) + lu(k,1108) = lu(k,1108) - lu(k,406) * lu(k,1082) + lu(k,1109) = - lu(k,407) * lu(k,1082) + lu(k,1110) = lu(k,1110) - lu(k,408) * lu(k,1082) + lu(k,1118) = lu(k,1118) - lu(k,409) * lu(k,1082) + lu(k,1397) = lu(k,1397) - lu(k,399) * lu(k,1390) + lu(k,1398) = lu(k,1398) - lu(k,400) * lu(k,1390) + lu(k,1400) = lu(k,1400) - lu(k,401) * lu(k,1390) + lu(k,1409) = lu(k,1409) - lu(k,402) * lu(k,1390) + lu(k,1412) = lu(k,1412) - lu(k,403) * lu(k,1390) + lu(k,1413) = lu(k,1413) - lu(k,404) * lu(k,1390) + lu(k,1416) = lu(k,1416) - lu(k,405) * lu(k,1390) + lu(k,1421) = lu(k,1421) - lu(k,406) * lu(k,1390) + lu(k,1422) = lu(k,1422) - lu(k,407) * lu(k,1390) + lu(k,1423) = - lu(k,408) * lu(k,1390) + lu(k,1431) = lu(k,1431) - lu(k,409) * lu(k,1390) + lu(k,1612) = - lu(k,399) * lu(k,1607) + lu(k,1613) = - lu(k,400) * lu(k,1607) + lu(k,1615) = lu(k,1615) - lu(k,401) * lu(k,1607) + lu(k,1626) = lu(k,1626) - lu(k,402) * lu(k,1607) + lu(k,1629) = lu(k,1629) - lu(k,403) * lu(k,1607) + lu(k,1630) = lu(k,1630) - lu(k,404) * lu(k,1607) + lu(k,1633) = - lu(k,405) * lu(k,1607) + lu(k,1638) = lu(k,1638) - lu(k,406) * lu(k,1607) + lu(k,1639) = - lu(k,407) * lu(k,1607) + lu(k,1640) = lu(k,1640) - lu(k,408) * lu(k,1607) + lu(k,1648) = lu(k,1648) - lu(k,409) * lu(k,1607) + lu(k,1657) = lu(k,1657) - lu(k,399) * lu(k,1650) + lu(k,1658) = lu(k,1658) - lu(k,400) * lu(k,1650) + lu(k,1660) = lu(k,1660) - lu(k,401) * lu(k,1650) + lu(k,1669) = lu(k,1669) - lu(k,402) * lu(k,1650) + lu(k,1672) = lu(k,1672) - lu(k,403) * lu(k,1650) + lu(k,1673) = lu(k,1673) - lu(k,404) * lu(k,1650) + lu(k,1676) = lu(k,1676) - lu(k,405) * lu(k,1650) + lu(k,1681) = lu(k,1681) - lu(k,406) * lu(k,1650) + lu(k,1682) = lu(k,1682) - lu(k,407) * lu(k,1650) + lu(k,1683) = - lu(k,408) * lu(k,1650) + lu(k,1691) = lu(k,1691) - lu(k,409) * lu(k,1650) + lu(k,413) = 1._r8 / lu(k,413) + lu(k,414) = lu(k,414) * lu(k,413) + lu(k,415) = lu(k,415) * lu(k,413) + lu(k,416) = lu(k,416) * lu(k,413) + lu(k,417) = lu(k,417) * lu(k,413) + lu(k,418) = lu(k,418) * lu(k,413) + lu(k,419) = lu(k,419) * lu(k,413) + lu(k,420) = lu(k,420) * lu(k,413) + lu(k,421) = lu(k,421) * lu(k,413) + lu(k,422) = lu(k,422) * lu(k,413) + lu(k,423) = lu(k,423) * lu(k,413) + lu(k,424) = lu(k,424) * lu(k,413) + lu(k,425) = lu(k,425) * lu(k,413) + lu(k,426) = lu(k,426) * lu(k,413) + lu(k,427) = lu(k,427) * lu(k,413) + lu(k,643) = lu(k,643) - lu(k,414) * lu(k,642) + lu(k,644) = lu(k,644) - lu(k,415) * lu(k,642) + lu(k,645) = - lu(k,416) * lu(k,642) + lu(k,646) = lu(k,646) - lu(k,417) * lu(k,642) + lu(k,647) = - lu(k,418) * lu(k,642) + lu(k,648) = lu(k,648) - lu(k,419) * lu(k,642) + lu(k,650) = lu(k,650) - lu(k,420) * lu(k,642) + lu(k,651) = lu(k,651) - lu(k,421) * lu(k,642) + lu(k,652) = lu(k,652) - lu(k,422) * lu(k,642) + lu(k,653) = lu(k,653) - lu(k,423) * lu(k,642) + lu(k,654) = lu(k,654) - lu(k,424) * lu(k,642) + lu(k,661) = - lu(k,425) * lu(k,642) + lu(k,662) = lu(k,662) - lu(k,426) * lu(k,642) + lu(k,663) = lu(k,663) - lu(k,427) * lu(k,642) + lu(k,778) = lu(k,778) - lu(k,414) * lu(k,777) + lu(k,781) = lu(k,781) - lu(k,415) * lu(k,777) + lu(k,783) = lu(k,783) - lu(k,416) * lu(k,777) + lu(k,784) = lu(k,784) - lu(k,417) * lu(k,777) + lu(k,785) = lu(k,785) - lu(k,418) * lu(k,777) + lu(k,786) = lu(k,786) - lu(k,419) * lu(k,777) + lu(k,788) = lu(k,788) - lu(k,420) * lu(k,777) + lu(k,789) = lu(k,789) - lu(k,421) * lu(k,777) + lu(k,790) = lu(k,790) - lu(k,422) * lu(k,777) + lu(k,791) = lu(k,791) - lu(k,423) * lu(k,777) + lu(k,793) = lu(k,793) - lu(k,424) * lu(k,777) + lu(k,803) = - lu(k,425) * lu(k,777) + lu(k,804) = lu(k,804) - lu(k,426) * lu(k,777) + lu(k,805) = lu(k,805) - lu(k,427) * lu(k,777) + lu(k,972) = lu(k,972) - lu(k,414) * lu(k,971) + lu(k,976) = lu(k,976) - lu(k,415) * lu(k,971) + lu(k,978) = lu(k,978) - lu(k,416) * lu(k,971) + lu(k,979) = lu(k,979) - lu(k,417) * lu(k,971) + lu(k,980) = lu(k,980) - lu(k,418) * lu(k,971) + lu(k,981) = lu(k,981) - lu(k,419) * lu(k,971) + lu(k,983) = lu(k,983) - lu(k,420) * lu(k,971) + lu(k,985) = lu(k,985) - lu(k,421) * lu(k,971) + lu(k,986) = lu(k,986) - lu(k,422) * lu(k,971) + lu(k,988) = lu(k,988) - lu(k,423) * lu(k,971) + lu(k,990) = lu(k,990) - lu(k,424) * lu(k,971) + lu(k,1000) = lu(k,1000) - lu(k,425) * lu(k,971) + lu(k,1001) = lu(k,1001) - lu(k,426) * lu(k,971) + lu(k,1002) = lu(k,1002) - lu(k,427) * lu(k,971) + lu(k,1214) = lu(k,1214) - lu(k,414) * lu(k,1213) + lu(k,1217) = lu(k,1217) - lu(k,415) * lu(k,1213) + lu(k,1219) = - lu(k,416) * lu(k,1213) + lu(k,1220) = - lu(k,417) * lu(k,1213) + lu(k,1223) = lu(k,1223) - lu(k,418) * lu(k,1213) + lu(k,1225) = lu(k,1225) - lu(k,419) * lu(k,1213) + lu(k,1228) = lu(k,1228) - lu(k,420) * lu(k,1213) + lu(k,1231) = lu(k,1231) - lu(k,421) * lu(k,1213) + lu(k,1232) = - lu(k,422) * lu(k,1213) + lu(k,1234) = lu(k,1234) - lu(k,423) * lu(k,1213) + lu(k,1237) = lu(k,1237) - lu(k,424) * lu(k,1213) + lu(k,1248) = lu(k,1248) - lu(k,425) * lu(k,1213) + lu(k,1249) = - lu(k,426) * lu(k,1213) + lu(k,1250) = lu(k,1250) - lu(k,427) * lu(k,1213) + lu(k,1991) = lu(k,1991) - lu(k,414) * lu(k,1990) + lu(k,1993) = lu(k,1993) - lu(k,415) * lu(k,1990) + lu(k,1995) = lu(k,1995) - lu(k,416) * lu(k,1990) + lu(k,1996) = lu(k,1996) - lu(k,417) * lu(k,1990) + lu(k,2000) = lu(k,2000) - lu(k,418) * lu(k,1990) + lu(k,2002) = lu(k,2002) - lu(k,419) * lu(k,1990) + lu(k,2005) = lu(k,2005) - lu(k,420) * lu(k,1990) + lu(k,2008) = lu(k,2008) - lu(k,421) * lu(k,1990) + lu(k,2009) = lu(k,2009) - lu(k,422) * lu(k,1990) + lu(k,2011) = lu(k,2011) - lu(k,423) * lu(k,1990) + lu(k,2014) = lu(k,2014) - lu(k,424) * lu(k,1990) + lu(k,2025) = lu(k,2025) - lu(k,425) * lu(k,1990) + lu(k,2026) = lu(k,2026) - lu(k,426) * lu(k,1990) + lu(k,2027) = lu(k,2027) - lu(k,427) * lu(k,1990) + lu(k,2044) = lu(k,2044) - lu(k,414) * lu(k,2043) + lu(k,2052) = lu(k,2052) - lu(k,415) * lu(k,2043) + lu(k,2056) = - lu(k,416) * lu(k,2043) + lu(k,2057) = lu(k,2057) - lu(k,417) * lu(k,2043) + lu(k,2060) = lu(k,2060) - lu(k,418) * lu(k,2043) + lu(k,2062) = lu(k,2062) - lu(k,419) * lu(k,2043) + lu(k,2065) = lu(k,2065) - lu(k,420) * lu(k,2043) + lu(k,2068) = lu(k,2068) - lu(k,421) * lu(k,2043) + lu(k,2069) = lu(k,2069) - lu(k,422) * lu(k,2043) + lu(k,2071) = lu(k,2071) - lu(k,423) * lu(k,2043) + lu(k,2074) = - lu(k,424) * lu(k,2043) + lu(k,2085) = lu(k,2085) - lu(k,425) * lu(k,2043) + lu(k,2086) = - lu(k,426) * lu(k,2043) + lu(k,2087) = lu(k,2087) - lu(k,427) * lu(k,2043) end do end subroutine lu_fac10 subroutine lu_fac11( avec_len, lu ) @@ -2191,473 +1916,350 @@ subroutine lu_fac11( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,393) = 1._r8 / lu(k,393) - lu(k,394) = lu(k,394) * lu(k,393) - lu(k,395) = lu(k,395) * lu(k,393) - lu(k,396) = lu(k,396) * lu(k,393) - lu(k,397) = lu(k,397) * lu(k,393) - lu(k,398) = lu(k,398) * lu(k,393) - lu(k,399) = lu(k,399) * lu(k,393) - lu(k,400) = lu(k,400) * lu(k,393) - lu(k,401) = lu(k,401) * lu(k,393) - lu(k,402) = lu(k,402) * lu(k,393) - lu(k,403) = lu(k,403) * lu(k,393) - lu(k,404) = lu(k,404) * lu(k,393) - lu(k,405) = lu(k,405) * lu(k,393) - lu(k,406) = lu(k,406) * lu(k,393) - lu(k,407) = lu(k,407) * lu(k,393) - lu(k,410) = lu(k,410) - lu(k,394) * lu(k,408) - lu(k,411) = lu(k,411) - lu(k,395) * lu(k,408) - lu(k,412) = lu(k,412) - lu(k,396) * lu(k,408) - lu(k,413) = lu(k,413) - lu(k,397) * lu(k,408) - lu(k,414) = lu(k,414) - lu(k,398) * lu(k,408) - lu(k,415) = lu(k,415) - lu(k,399) * lu(k,408) - lu(k,416) = lu(k,416) - lu(k,400) * lu(k,408) - lu(k,417) = lu(k,417) - lu(k,401) * lu(k,408) - lu(k,418) = lu(k,418) - lu(k,402) * lu(k,408) - lu(k,419) = lu(k,419) - lu(k,403) * lu(k,408) - lu(k,420) = lu(k,420) - lu(k,404) * lu(k,408) - lu(k,421) = lu(k,421) - lu(k,405) * lu(k,408) - lu(k,422) = lu(k,422) - lu(k,406) * lu(k,408) - lu(k,423) = lu(k,423) - lu(k,407) * lu(k,408) - lu(k,690) = lu(k,690) - lu(k,394) * lu(k,688) - lu(k,693) = lu(k,693) - lu(k,395) * lu(k,688) - lu(k,694) = lu(k,694) - lu(k,396) * lu(k,688) - lu(k,696) = lu(k,696) - lu(k,397) * lu(k,688) - lu(k,697) = lu(k,697) - lu(k,398) * lu(k,688) - lu(k,698) = lu(k,698) - lu(k,399) * lu(k,688) - lu(k,699) = lu(k,699) - lu(k,400) * lu(k,688) - lu(k,701) = lu(k,701) - lu(k,401) * lu(k,688) - lu(k,702) = lu(k,702) - lu(k,402) * lu(k,688) - lu(k,703) = lu(k,703) - lu(k,403) * lu(k,688) - lu(k,705) = lu(k,705) - lu(k,404) * lu(k,688) - lu(k,706) = lu(k,706) - lu(k,405) * lu(k,688) - lu(k,707) = lu(k,707) - lu(k,406) * lu(k,688) - lu(k,708) = lu(k,708) - lu(k,407) * lu(k,688) - lu(k,894) = lu(k,894) - lu(k,394) * lu(k,884) - lu(k,900) = lu(k,900) - lu(k,395) * lu(k,884) - lu(k,901) = lu(k,901) - lu(k,396) * lu(k,884) - lu(k,903) = lu(k,903) - lu(k,397) * lu(k,884) - lu(k,904) = lu(k,904) - lu(k,398) * lu(k,884) - lu(k,906) = lu(k,906) - lu(k,399) * lu(k,884) - lu(k,908) = lu(k,908) - lu(k,400) * lu(k,884) - lu(k,911) = lu(k,911) - lu(k,401) * lu(k,884) - lu(k,913) = lu(k,913) - lu(k,402) * lu(k,884) - lu(k,914) = lu(k,914) - lu(k,403) * lu(k,884) - lu(k,916) = lu(k,916) - lu(k,404) * lu(k,884) - lu(k,919) = lu(k,919) - lu(k,405) * lu(k,884) - lu(k,921) = lu(k,921) - lu(k,406) * lu(k,884) - lu(k,922) = lu(k,922) - lu(k,407) * lu(k,884) - lu(k,936) = lu(k,936) - lu(k,394) * lu(k,927) - lu(k,942) = lu(k,942) - lu(k,395) * lu(k,927) - lu(k,943) = lu(k,943) - lu(k,396) * lu(k,927) - lu(k,945) = lu(k,945) - lu(k,397) * lu(k,927) - lu(k,946) = lu(k,946) - lu(k,398) * lu(k,927) - lu(k,948) = lu(k,948) - lu(k,399) * lu(k,927) - lu(k,950) = lu(k,950) - lu(k,400) * lu(k,927) - lu(k,953) = lu(k,953) - lu(k,401) * lu(k,927) - lu(k,955) = lu(k,955) - lu(k,402) * lu(k,927) - lu(k,956) = lu(k,956) - lu(k,403) * lu(k,927) - lu(k,958) = lu(k,958) - lu(k,404) * lu(k,927) - lu(k,961) = lu(k,961) - lu(k,405) * lu(k,927) - lu(k,963) = lu(k,963) - lu(k,406) * lu(k,927) - lu(k,964) = lu(k,964) - lu(k,407) * lu(k,927) - lu(k,1024) = lu(k,1024) - lu(k,394) * lu(k,1015) - lu(k,1030) = lu(k,1030) - lu(k,395) * lu(k,1015) - lu(k,1031) = lu(k,1031) - lu(k,396) * lu(k,1015) - lu(k,1033) = lu(k,1033) - lu(k,397) * lu(k,1015) - lu(k,1034) = lu(k,1034) - lu(k,398) * lu(k,1015) - lu(k,1036) = lu(k,1036) - lu(k,399) * lu(k,1015) - lu(k,1038) = lu(k,1038) - lu(k,400) * lu(k,1015) - lu(k,1041) = lu(k,1041) - lu(k,401) * lu(k,1015) - lu(k,1043) = lu(k,1043) - lu(k,402) * lu(k,1015) - lu(k,1044) = lu(k,1044) - lu(k,403) * lu(k,1015) - lu(k,1046) = lu(k,1046) - lu(k,404) * lu(k,1015) - lu(k,1049) = lu(k,1049) - lu(k,405) * lu(k,1015) - lu(k,1051) = lu(k,1051) - lu(k,406) * lu(k,1015) - lu(k,1052) = lu(k,1052) - lu(k,407) * lu(k,1015) - lu(k,1065) = lu(k,1065) - lu(k,394) * lu(k,1056) - lu(k,1071) = lu(k,1071) - lu(k,395) * lu(k,1056) - lu(k,1072) = lu(k,1072) - lu(k,396) * lu(k,1056) - lu(k,1074) = lu(k,1074) - lu(k,397) * lu(k,1056) - lu(k,1075) = lu(k,1075) - lu(k,398) * lu(k,1056) - lu(k,1077) = lu(k,1077) - lu(k,399) * lu(k,1056) - lu(k,1079) = lu(k,1079) - lu(k,400) * lu(k,1056) - lu(k,1082) = lu(k,1082) - lu(k,401) * lu(k,1056) - lu(k,1084) = lu(k,1084) - lu(k,402) * lu(k,1056) - lu(k,1085) = lu(k,1085) - lu(k,403) * lu(k,1056) - lu(k,1087) = lu(k,1087) - lu(k,404) * lu(k,1056) - lu(k,1090) = lu(k,1090) - lu(k,405) * lu(k,1056) - lu(k,1092) = lu(k,1092) - lu(k,406) * lu(k,1056) - lu(k,1093) = lu(k,1093) - lu(k,407) * lu(k,1056) - lu(k,1148) = lu(k,1148) - lu(k,394) * lu(k,1139) - lu(k,1154) = - lu(k,395) * lu(k,1139) - lu(k,1155) = - lu(k,396) * lu(k,1139) - lu(k,1157) = - lu(k,397) * lu(k,1139) - lu(k,1158) = - lu(k,398) * lu(k,1139) - lu(k,1160) = lu(k,1160) - lu(k,399) * lu(k,1139) - lu(k,1162) = - lu(k,400) * lu(k,1139) - lu(k,1165) = - lu(k,401) * lu(k,1139) - lu(k,1167) = lu(k,1167) - lu(k,402) * lu(k,1139) - lu(k,1168) = lu(k,1168) - lu(k,403) * lu(k,1139) - lu(k,1170) = - lu(k,404) * lu(k,1139) - lu(k,1173) = - lu(k,405) * lu(k,1139) - lu(k,1175) = lu(k,1175) - lu(k,406) * lu(k,1139) - lu(k,1176) = lu(k,1176) - lu(k,407) * lu(k,1139) - lu(k,1356) = lu(k,1356) - lu(k,394) * lu(k,1346) - lu(k,1362) = lu(k,1362) - lu(k,395) * lu(k,1346) - lu(k,1363) = lu(k,1363) - lu(k,396) * lu(k,1346) - lu(k,1365) = lu(k,1365) - lu(k,397) * lu(k,1346) - lu(k,1366) = lu(k,1366) - lu(k,398) * lu(k,1346) - lu(k,1368) = lu(k,1368) - lu(k,399) * lu(k,1346) - lu(k,1370) = lu(k,1370) - lu(k,400) * lu(k,1346) - lu(k,1373) = lu(k,1373) - lu(k,401) * lu(k,1346) - lu(k,1375) = lu(k,1375) - lu(k,402) * lu(k,1346) - lu(k,1376) = lu(k,1376) - lu(k,403) * lu(k,1346) - lu(k,1378) = lu(k,1378) - lu(k,404) * lu(k,1346) - lu(k,1381) = lu(k,1381) - lu(k,405) * lu(k,1346) - lu(k,1383) = lu(k,1383) - lu(k,406) * lu(k,1346) - lu(k,1384) = lu(k,1384) - lu(k,407) * lu(k,1346) - lu(k,1582) = lu(k,1582) - lu(k,394) * lu(k,1573) - lu(k,1588) = lu(k,1588) - lu(k,395) * lu(k,1573) - lu(k,1589) = lu(k,1589) - lu(k,396) * lu(k,1573) - lu(k,1591) = lu(k,1591) - lu(k,397) * lu(k,1573) - lu(k,1592) = lu(k,1592) - lu(k,398) * lu(k,1573) - lu(k,1594) = lu(k,1594) - lu(k,399) * lu(k,1573) - lu(k,1596) = lu(k,1596) - lu(k,400) * lu(k,1573) - lu(k,1599) = lu(k,1599) - lu(k,401) * lu(k,1573) - lu(k,1601) = lu(k,1601) - lu(k,402) * lu(k,1573) - lu(k,1602) = lu(k,1602) - lu(k,403) * lu(k,1573) - lu(k,1604) = lu(k,1604) - lu(k,404) * lu(k,1573) - lu(k,1607) = lu(k,1607) - lu(k,405) * lu(k,1573) - lu(k,1609) = lu(k,1609) - lu(k,406) * lu(k,1573) - lu(k,1610) = lu(k,1610) - lu(k,407) * lu(k,1573) - lu(k,1691) = lu(k,1691) - lu(k,394) * lu(k,1682) - lu(k,1697) = lu(k,1697) - lu(k,395) * lu(k,1682) - lu(k,1698) = lu(k,1698) - lu(k,396) * lu(k,1682) - lu(k,1700) = lu(k,1700) - lu(k,397) * lu(k,1682) - lu(k,1701) = lu(k,1701) - lu(k,398) * lu(k,1682) - lu(k,1703) = lu(k,1703) - lu(k,399) * lu(k,1682) - lu(k,1705) = lu(k,1705) - lu(k,400) * lu(k,1682) - lu(k,1708) = lu(k,1708) - lu(k,401) * lu(k,1682) - lu(k,1710) = lu(k,1710) - lu(k,402) * lu(k,1682) - lu(k,1711) = lu(k,1711) - lu(k,403) * lu(k,1682) - lu(k,1713) = lu(k,1713) - lu(k,404) * lu(k,1682) - lu(k,1716) = lu(k,1716) - lu(k,405) * lu(k,1682) - lu(k,1718) = lu(k,1718) - lu(k,406) * lu(k,1682) - lu(k,1719) = lu(k,1719) - lu(k,407) * lu(k,1682) - lu(k,409) = 1._r8 / lu(k,409) - lu(k,410) = lu(k,410) * lu(k,409) - lu(k,411) = lu(k,411) * lu(k,409) - lu(k,412) = lu(k,412) * lu(k,409) - lu(k,413) = lu(k,413) * lu(k,409) - lu(k,414) = lu(k,414) * lu(k,409) - lu(k,415) = lu(k,415) * lu(k,409) - lu(k,416) = lu(k,416) * lu(k,409) - lu(k,417) = lu(k,417) * lu(k,409) - lu(k,418) = lu(k,418) * lu(k,409) - lu(k,419) = lu(k,419) * lu(k,409) - lu(k,420) = lu(k,420) * lu(k,409) - lu(k,421) = lu(k,421) * lu(k,409) - lu(k,422) = lu(k,422) * lu(k,409) - lu(k,423) = lu(k,423) * lu(k,409) - lu(k,690) = lu(k,690) - lu(k,410) * lu(k,689) - lu(k,693) = lu(k,693) - lu(k,411) * lu(k,689) - lu(k,694) = lu(k,694) - lu(k,412) * lu(k,689) - lu(k,696) = lu(k,696) - lu(k,413) * lu(k,689) - lu(k,697) = lu(k,697) - lu(k,414) * lu(k,689) - lu(k,698) = lu(k,698) - lu(k,415) * lu(k,689) - lu(k,699) = lu(k,699) - lu(k,416) * lu(k,689) - lu(k,701) = lu(k,701) - lu(k,417) * lu(k,689) - lu(k,702) = lu(k,702) - lu(k,418) * lu(k,689) - lu(k,703) = lu(k,703) - lu(k,419) * lu(k,689) - lu(k,705) = lu(k,705) - lu(k,420) * lu(k,689) - lu(k,706) = lu(k,706) - lu(k,421) * lu(k,689) - lu(k,707) = lu(k,707) - lu(k,422) * lu(k,689) - lu(k,708) = lu(k,708) - lu(k,423) * lu(k,689) - lu(k,894) = lu(k,894) - lu(k,410) * lu(k,885) - lu(k,900) = lu(k,900) - lu(k,411) * lu(k,885) - lu(k,901) = lu(k,901) - lu(k,412) * lu(k,885) - lu(k,903) = lu(k,903) - lu(k,413) * lu(k,885) - lu(k,904) = lu(k,904) - lu(k,414) * lu(k,885) - lu(k,906) = lu(k,906) - lu(k,415) * lu(k,885) - lu(k,908) = lu(k,908) - lu(k,416) * lu(k,885) - lu(k,911) = lu(k,911) - lu(k,417) * lu(k,885) - lu(k,913) = lu(k,913) - lu(k,418) * lu(k,885) - lu(k,914) = lu(k,914) - lu(k,419) * lu(k,885) - lu(k,916) = lu(k,916) - lu(k,420) * lu(k,885) - lu(k,919) = lu(k,919) - lu(k,421) * lu(k,885) - lu(k,921) = lu(k,921) - lu(k,422) * lu(k,885) - lu(k,922) = lu(k,922) - lu(k,423) * lu(k,885) - lu(k,936) = lu(k,936) - lu(k,410) * lu(k,928) - lu(k,942) = lu(k,942) - lu(k,411) * lu(k,928) - lu(k,943) = lu(k,943) - lu(k,412) * lu(k,928) - lu(k,945) = lu(k,945) - lu(k,413) * lu(k,928) - lu(k,946) = lu(k,946) - lu(k,414) * lu(k,928) - lu(k,948) = lu(k,948) - lu(k,415) * lu(k,928) - lu(k,950) = lu(k,950) - lu(k,416) * lu(k,928) - lu(k,953) = lu(k,953) - lu(k,417) * lu(k,928) - lu(k,955) = lu(k,955) - lu(k,418) * lu(k,928) - lu(k,956) = lu(k,956) - lu(k,419) * lu(k,928) - lu(k,958) = lu(k,958) - lu(k,420) * lu(k,928) - lu(k,961) = lu(k,961) - lu(k,421) * lu(k,928) - lu(k,963) = lu(k,963) - lu(k,422) * lu(k,928) - lu(k,964) = lu(k,964) - lu(k,423) * lu(k,928) - lu(k,1024) = lu(k,1024) - lu(k,410) * lu(k,1016) - lu(k,1030) = lu(k,1030) - lu(k,411) * lu(k,1016) - lu(k,1031) = lu(k,1031) - lu(k,412) * lu(k,1016) - lu(k,1033) = lu(k,1033) - lu(k,413) * lu(k,1016) - lu(k,1034) = lu(k,1034) - lu(k,414) * lu(k,1016) - lu(k,1036) = lu(k,1036) - lu(k,415) * lu(k,1016) - lu(k,1038) = lu(k,1038) - lu(k,416) * lu(k,1016) - lu(k,1041) = lu(k,1041) - lu(k,417) * lu(k,1016) - lu(k,1043) = lu(k,1043) - lu(k,418) * lu(k,1016) - lu(k,1044) = lu(k,1044) - lu(k,419) * lu(k,1016) - lu(k,1046) = lu(k,1046) - lu(k,420) * lu(k,1016) - lu(k,1049) = lu(k,1049) - lu(k,421) * lu(k,1016) - lu(k,1051) = lu(k,1051) - lu(k,422) * lu(k,1016) - lu(k,1052) = lu(k,1052) - lu(k,423) * lu(k,1016) - lu(k,1065) = lu(k,1065) - lu(k,410) * lu(k,1057) - lu(k,1071) = lu(k,1071) - lu(k,411) * lu(k,1057) - lu(k,1072) = lu(k,1072) - lu(k,412) * lu(k,1057) - lu(k,1074) = lu(k,1074) - lu(k,413) * lu(k,1057) - lu(k,1075) = lu(k,1075) - lu(k,414) * lu(k,1057) - lu(k,1077) = lu(k,1077) - lu(k,415) * lu(k,1057) - lu(k,1079) = lu(k,1079) - lu(k,416) * lu(k,1057) - lu(k,1082) = lu(k,1082) - lu(k,417) * lu(k,1057) - lu(k,1084) = lu(k,1084) - lu(k,418) * lu(k,1057) - lu(k,1085) = lu(k,1085) - lu(k,419) * lu(k,1057) - lu(k,1087) = lu(k,1087) - lu(k,420) * lu(k,1057) - lu(k,1090) = lu(k,1090) - lu(k,421) * lu(k,1057) - lu(k,1092) = lu(k,1092) - lu(k,422) * lu(k,1057) - lu(k,1093) = lu(k,1093) - lu(k,423) * lu(k,1057) - lu(k,1148) = lu(k,1148) - lu(k,410) * lu(k,1140) - lu(k,1154) = lu(k,1154) - lu(k,411) * lu(k,1140) - lu(k,1155) = lu(k,1155) - lu(k,412) * lu(k,1140) - lu(k,1157) = lu(k,1157) - lu(k,413) * lu(k,1140) - lu(k,1158) = lu(k,1158) - lu(k,414) * lu(k,1140) - lu(k,1160) = lu(k,1160) - lu(k,415) * lu(k,1140) - lu(k,1162) = lu(k,1162) - lu(k,416) * lu(k,1140) - lu(k,1165) = lu(k,1165) - lu(k,417) * lu(k,1140) - lu(k,1167) = lu(k,1167) - lu(k,418) * lu(k,1140) - lu(k,1168) = lu(k,1168) - lu(k,419) * lu(k,1140) - lu(k,1170) = lu(k,1170) - lu(k,420) * lu(k,1140) - lu(k,1173) = lu(k,1173) - lu(k,421) * lu(k,1140) - lu(k,1175) = lu(k,1175) - lu(k,422) * lu(k,1140) - lu(k,1176) = lu(k,1176) - lu(k,423) * lu(k,1140) - lu(k,1356) = lu(k,1356) - lu(k,410) * lu(k,1347) - lu(k,1362) = lu(k,1362) - lu(k,411) * lu(k,1347) - lu(k,1363) = lu(k,1363) - lu(k,412) * lu(k,1347) - lu(k,1365) = lu(k,1365) - lu(k,413) * lu(k,1347) - lu(k,1366) = lu(k,1366) - lu(k,414) * lu(k,1347) - lu(k,1368) = lu(k,1368) - lu(k,415) * lu(k,1347) - lu(k,1370) = lu(k,1370) - lu(k,416) * lu(k,1347) - lu(k,1373) = lu(k,1373) - lu(k,417) * lu(k,1347) - lu(k,1375) = lu(k,1375) - lu(k,418) * lu(k,1347) - lu(k,1376) = lu(k,1376) - lu(k,419) * lu(k,1347) - lu(k,1378) = lu(k,1378) - lu(k,420) * lu(k,1347) - lu(k,1381) = lu(k,1381) - lu(k,421) * lu(k,1347) - lu(k,1383) = lu(k,1383) - lu(k,422) * lu(k,1347) - lu(k,1384) = lu(k,1384) - lu(k,423) * lu(k,1347) - lu(k,1582) = lu(k,1582) - lu(k,410) * lu(k,1574) - lu(k,1588) = lu(k,1588) - lu(k,411) * lu(k,1574) - lu(k,1589) = lu(k,1589) - lu(k,412) * lu(k,1574) - lu(k,1591) = lu(k,1591) - lu(k,413) * lu(k,1574) - lu(k,1592) = lu(k,1592) - lu(k,414) * lu(k,1574) - lu(k,1594) = lu(k,1594) - lu(k,415) * lu(k,1574) - lu(k,1596) = lu(k,1596) - lu(k,416) * lu(k,1574) - lu(k,1599) = lu(k,1599) - lu(k,417) * lu(k,1574) - lu(k,1601) = lu(k,1601) - lu(k,418) * lu(k,1574) - lu(k,1602) = lu(k,1602) - lu(k,419) * lu(k,1574) - lu(k,1604) = lu(k,1604) - lu(k,420) * lu(k,1574) - lu(k,1607) = lu(k,1607) - lu(k,421) * lu(k,1574) - lu(k,1609) = lu(k,1609) - lu(k,422) * lu(k,1574) - lu(k,1610) = lu(k,1610) - lu(k,423) * lu(k,1574) - lu(k,1691) = lu(k,1691) - lu(k,410) * lu(k,1683) - lu(k,1697) = lu(k,1697) - lu(k,411) * lu(k,1683) - lu(k,1698) = lu(k,1698) - lu(k,412) * lu(k,1683) - lu(k,1700) = lu(k,1700) - lu(k,413) * lu(k,1683) - lu(k,1701) = lu(k,1701) - lu(k,414) * lu(k,1683) - lu(k,1703) = lu(k,1703) - lu(k,415) * lu(k,1683) - lu(k,1705) = lu(k,1705) - lu(k,416) * lu(k,1683) - lu(k,1708) = lu(k,1708) - lu(k,417) * lu(k,1683) - lu(k,1710) = lu(k,1710) - lu(k,418) * lu(k,1683) - lu(k,1711) = lu(k,1711) - lu(k,419) * lu(k,1683) - lu(k,1713) = lu(k,1713) - lu(k,420) * lu(k,1683) - lu(k,1716) = lu(k,1716) - lu(k,421) * lu(k,1683) - lu(k,1718) = lu(k,1718) - lu(k,422) * lu(k,1683) - lu(k,1719) = lu(k,1719) - lu(k,423) * lu(k,1683) - lu(k,1828) = lu(k,1828) - lu(k,410) * lu(k,1818) - lu(k,1834) = lu(k,1834) - lu(k,411) * lu(k,1818) - lu(k,1835) = lu(k,1835) - lu(k,412) * lu(k,1818) - lu(k,1837) = lu(k,1837) - lu(k,413) * lu(k,1818) - lu(k,1838) = lu(k,1838) - lu(k,414) * lu(k,1818) - lu(k,1840) = - lu(k,415) * lu(k,1818) - lu(k,1842) = lu(k,1842) - lu(k,416) * lu(k,1818) - lu(k,1845) = lu(k,1845) - lu(k,417) * lu(k,1818) - lu(k,1847) = lu(k,1847) - lu(k,418) * lu(k,1818) - lu(k,1848) = lu(k,1848) - lu(k,419) * lu(k,1818) - lu(k,1850) = lu(k,1850) - lu(k,420) * lu(k,1818) - lu(k,1853) = lu(k,1853) - lu(k,421) * lu(k,1818) - lu(k,1855) = lu(k,1855) - lu(k,422) * lu(k,1818) - lu(k,1856) = lu(k,1856) - lu(k,423) * lu(k,1818) - lu(k,424) = 1._r8 / lu(k,424) - lu(k,425) = lu(k,425) * lu(k,424) - lu(k,426) = lu(k,426) * lu(k,424) - lu(k,427) = lu(k,427) * lu(k,424) - lu(k,428) = lu(k,428) * lu(k,424) - lu(k,429) = lu(k,429) * lu(k,424) - lu(k,430) = lu(k,430) * lu(k,424) - lu(k,431) = lu(k,431) * lu(k,424) - lu(k,432) = lu(k,432) * lu(k,424) - lu(k,433) = lu(k,433) * lu(k,424) - lu(k,434) = lu(k,434) * lu(k,424) - lu(k,435) = lu(k,435) * lu(k,424) - lu(k,436) = lu(k,436) * lu(k,424) - lu(k,437) = lu(k,437) * lu(k,424) - lu(k,543) = lu(k,543) - lu(k,425) * lu(k,538) - lu(k,544) = lu(k,544) - lu(k,426) * lu(k,538) - lu(k,545) = lu(k,545) - lu(k,427) * lu(k,538) - lu(k,546) = lu(k,546) - lu(k,428) * lu(k,538) - lu(k,547) = lu(k,547) - lu(k,429) * lu(k,538) - lu(k,548) = lu(k,548) - lu(k,430) * lu(k,538) - lu(k,549) = lu(k,549) - lu(k,431) * lu(k,538) - lu(k,550) = lu(k,550) - lu(k,432) * lu(k,538) - lu(k,552) = lu(k,552) - lu(k,433) * lu(k,538) - lu(k,553) = lu(k,553) - lu(k,434) * lu(k,538) - lu(k,554) = lu(k,554) - lu(k,435) * lu(k,538) - lu(k,555) = lu(k,555) - lu(k,436) * lu(k,538) - lu(k,556) = lu(k,556) - lu(k,437) * lu(k,538) - lu(k,852) = lu(k,852) - lu(k,425) * lu(k,848) - lu(k,853) = lu(k,853) - lu(k,426) * lu(k,848) - lu(k,854) = lu(k,854) - lu(k,427) * lu(k,848) - lu(k,855) = lu(k,855) - lu(k,428) * lu(k,848) - lu(k,856) = lu(k,856) - lu(k,429) * lu(k,848) - lu(k,857) = lu(k,857) - lu(k,430) * lu(k,848) - lu(k,861) = lu(k,861) - lu(k,431) * lu(k,848) - lu(k,864) = lu(k,864) - lu(k,432) * lu(k,848) - lu(k,867) = lu(k,867) - lu(k,433) * lu(k,848) - lu(k,869) = lu(k,869) - lu(k,434) * lu(k,848) - lu(k,872) = lu(k,872) - lu(k,435) * lu(k,848) - lu(k,874) = lu(k,874) - lu(k,436) * lu(k,848) - lu(k,875) = lu(k,875) - lu(k,437) * lu(k,848) - lu(k,899) = lu(k,899) - lu(k,425) * lu(k,886) - lu(k,900) = lu(k,900) - lu(k,426) * lu(k,886) - lu(k,901) = lu(k,901) - lu(k,427) * lu(k,886) - lu(k,902) = lu(k,902) - lu(k,428) * lu(k,886) - lu(k,903) = lu(k,903) - lu(k,429) * lu(k,886) - lu(k,904) = lu(k,904) - lu(k,430) * lu(k,886) - lu(k,908) = lu(k,908) - lu(k,431) * lu(k,886) - lu(k,911) = lu(k,911) - lu(k,432) * lu(k,886) - lu(k,914) = lu(k,914) - lu(k,433) * lu(k,886) - lu(k,916) = lu(k,916) - lu(k,434) * lu(k,886) - lu(k,919) = lu(k,919) - lu(k,435) * lu(k,886) - lu(k,921) = lu(k,921) - lu(k,436) * lu(k,886) - lu(k,922) = lu(k,922) - lu(k,437) * lu(k,886) - lu(k,941) = lu(k,941) - lu(k,425) * lu(k,929) - lu(k,942) = lu(k,942) - lu(k,426) * lu(k,929) - lu(k,943) = lu(k,943) - lu(k,427) * lu(k,929) - lu(k,944) = lu(k,944) - lu(k,428) * lu(k,929) - lu(k,945) = lu(k,945) - lu(k,429) * lu(k,929) - lu(k,946) = lu(k,946) - lu(k,430) * lu(k,929) - lu(k,950) = lu(k,950) - lu(k,431) * lu(k,929) - lu(k,953) = lu(k,953) - lu(k,432) * lu(k,929) - lu(k,956) = lu(k,956) - lu(k,433) * lu(k,929) - lu(k,958) = lu(k,958) - lu(k,434) * lu(k,929) - lu(k,961) = lu(k,961) - lu(k,435) * lu(k,929) - lu(k,963) = lu(k,963) - lu(k,436) * lu(k,929) - lu(k,964) = lu(k,964) - lu(k,437) * lu(k,929) - lu(k,1029) = lu(k,1029) - lu(k,425) * lu(k,1017) - lu(k,1030) = lu(k,1030) - lu(k,426) * lu(k,1017) - lu(k,1031) = lu(k,1031) - lu(k,427) * lu(k,1017) - lu(k,1032) = lu(k,1032) - lu(k,428) * lu(k,1017) - lu(k,1033) = lu(k,1033) - lu(k,429) * lu(k,1017) - lu(k,1034) = lu(k,1034) - lu(k,430) * lu(k,1017) - lu(k,1038) = lu(k,1038) - lu(k,431) * lu(k,1017) - lu(k,1041) = lu(k,1041) - lu(k,432) * lu(k,1017) - lu(k,1044) = lu(k,1044) - lu(k,433) * lu(k,1017) - lu(k,1046) = lu(k,1046) - lu(k,434) * lu(k,1017) - lu(k,1049) = lu(k,1049) - lu(k,435) * lu(k,1017) - lu(k,1051) = lu(k,1051) - lu(k,436) * lu(k,1017) - lu(k,1052) = lu(k,1052) - lu(k,437) * lu(k,1017) - lu(k,1070) = lu(k,1070) - lu(k,425) * lu(k,1058) - lu(k,1071) = lu(k,1071) - lu(k,426) * lu(k,1058) - lu(k,1072) = lu(k,1072) - lu(k,427) * lu(k,1058) - lu(k,1073) = lu(k,1073) - lu(k,428) * lu(k,1058) - lu(k,1074) = lu(k,1074) - lu(k,429) * lu(k,1058) - lu(k,1075) = lu(k,1075) - lu(k,430) * lu(k,1058) - lu(k,1079) = lu(k,1079) - lu(k,431) * lu(k,1058) - lu(k,1082) = lu(k,1082) - lu(k,432) * lu(k,1058) - lu(k,1085) = lu(k,1085) - lu(k,433) * lu(k,1058) - lu(k,1087) = lu(k,1087) - lu(k,434) * lu(k,1058) - lu(k,1090) = lu(k,1090) - lu(k,435) * lu(k,1058) - lu(k,1092) = lu(k,1092) - lu(k,436) * lu(k,1058) - lu(k,1093) = lu(k,1093) - lu(k,437) * lu(k,1058) - lu(k,1361) = lu(k,1361) - lu(k,425) * lu(k,1348) - lu(k,1362) = lu(k,1362) - lu(k,426) * lu(k,1348) - lu(k,1363) = lu(k,1363) - lu(k,427) * lu(k,1348) - lu(k,1364) = lu(k,1364) - lu(k,428) * lu(k,1348) - lu(k,1365) = lu(k,1365) - lu(k,429) * lu(k,1348) - lu(k,1366) = lu(k,1366) - lu(k,430) * lu(k,1348) - lu(k,1370) = lu(k,1370) - lu(k,431) * lu(k,1348) - lu(k,1373) = lu(k,1373) - lu(k,432) * lu(k,1348) - lu(k,1376) = lu(k,1376) - lu(k,433) * lu(k,1348) - lu(k,1378) = lu(k,1378) - lu(k,434) * lu(k,1348) - lu(k,1381) = lu(k,1381) - lu(k,435) * lu(k,1348) - lu(k,1383) = lu(k,1383) - lu(k,436) * lu(k,1348) - lu(k,1384) = lu(k,1384) - lu(k,437) * lu(k,1348) - lu(k,1503) = lu(k,1503) - lu(k,425) * lu(k,1490) - lu(k,1504) = lu(k,1504) - lu(k,426) * lu(k,1490) - lu(k,1505) = - lu(k,427) * lu(k,1490) - lu(k,1506) = lu(k,1506) - lu(k,428) * lu(k,1490) - lu(k,1507) = - lu(k,429) * lu(k,1490) - lu(k,1508) = - lu(k,430) * lu(k,1490) - lu(k,1512) = lu(k,1512) - lu(k,431) * lu(k,1490) - lu(k,1515) = lu(k,1515) - lu(k,432) * lu(k,1490) - lu(k,1518) = lu(k,1518) - lu(k,433) * lu(k,1490) - lu(k,1520) = - lu(k,434) * lu(k,1490) - lu(k,1523) = - lu(k,435) * lu(k,1490) - lu(k,1525) = lu(k,1525) - lu(k,436) * lu(k,1490) - lu(k,1526) = lu(k,1526) - lu(k,437) * lu(k,1490) - lu(k,1587) = lu(k,1587) - lu(k,425) * lu(k,1575) - lu(k,1588) = lu(k,1588) - lu(k,426) * lu(k,1575) - lu(k,1589) = lu(k,1589) - lu(k,427) * lu(k,1575) - lu(k,1590) = lu(k,1590) - lu(k,428) * lu(k,1575) - lu(k,1591) = lu(k,1591) - lu(k,429) * lu(k,1575) - lu(k,1592) = lu(k,1592) - lu(k,430) * lu(k,1575) - lu(k,1596) = lu(k,1596) - lu(k,431) * lu(k,1575) - lu(k,1599) = lu(k,1599) - lu(k,432) * lu(k,1575) - lu(k,1602) = lu(k,1602) - lu(k,433) * lu(k,1575) - lu(k,1604) = lu(k,1604) - lu(k,434) * lu(k,1575) - lu(k,1607) = lu(k,1607) - lu(k,435) * lu(k,1575) - lu(k,1609) = lu(k,1609) - lu(k,436) * lu(k,1575) - lu(k,1610) = lu(k,1610) - lu(k,437) * lu(k,1575) - lu(k,1696) = lu(k,1696) - lu(k,425) * lu(k,1684) - lu(k,1697) = lu(k,1697) - lu(k,426) * lu(k,1684) - lu(k,1698) = lu(k,1698) - lu(k,427) * lu(k,1684) - lu(k,1699) = lu(k,1699) - lu(k,428) * lu(k,1684) - lu(k,1700) = lu(k,1700) - lu(k,429) * lu(k,1684) - lu(k,1701) = lu(k,1701) - lu(k,430) * lu(k,1684) - lu(k,1705) = lu(k,1705) - lu(k,431) * lu(k,1684) - lu(k,1708) = lu(k,1708) - lu(k,432) * lu(k,1684) - lu(k,1711) = lu(k,1711) - lu(k,433) * lu(k,1684) - lu(k,1713) = lu(k,1713) - lu(k,434) * lu(k,1684) - lu(k,1716) = lu(k,1716) - lu(k,435) * lu(k,1684) - lu(k,1718) = lu(k,1718) - lu(k,436) * lu(k,1684) - lu(k,1719) = lu(k,1719) - lu(k,437) * lu(k,1684) - lu(k,1833) = lu(k,1833) - lu(k,425) * lu(k,1819) - lu(k,1834) = lu(k,1834) - lu(k,426) * lu(k,1819) - lu(k,1835) = lu(k,1835) - lu(k,427) * lu(k,1819) - lu(k,1836) = lu(k,1836) - lu(k,428) * lu(k,1819) - lu(k,1837) = lu(k,1837) - lu(k,429) * lu(k,1819) - lu(k,1838) = lu(k,1838) - lu(k,430) * lu(k,1819) - lu(k,1842) = lu(k,1842) - lu(k,431) * lu(k,1819) - lu(k,1845) = lu(k,1845) - lu(k,432) * lu(k,1819) - lu(k,1848) = lu(k,1848) - lu(k,433) * lu(k,1819) - lu(k,1850) = lu(k,1850) - lu(k,434) * lu(k,1819) - lu(k,1853) = lu(k,1853) - lu(k,435) * lu(k,1819) - lu(k,1855) = lu(k,1855) - lu(k,436) * lu(k,1819) - lu(k,1856) = lu(k,1856) - lu(k,437) * lu(k,1819) + 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,645) = lu(k,645) - lu(k,430) * lu(k,643) + lu(k,647) = lu(k,647) - lu(k,431) * lu(k,643) + lu(k,648) = lu(k,648) - lu(k,432) * lu(k,643) + lu(k,653) = lu(k,653) - lu(k,433) * lu(k,643) + lu(k,655) = - lu(k,434) * lu(k,643) + lu(k,656) = - lu(k,435) * lu(k,643) + lu(k,657) = - lu(k,436) * lu(k,643) + lu(k,658) = - lu(k,437) * lu(k,643) + lu(k,662) = lu(k,662) - lu(k,438) * lu(k,643) + lu(k,663) = lu(k,663) - lu(k,439) * lu(k,643) + lu(k,783) = lu(k,783) - lu(k,430) * lu(k,778) + lu(k,785) = lu(k,785) - lu(k,431) * lu(k,778) + lu(k,786) = lu(k,786) - lu(k,432) * lu(k,778) + lu(k,791) = lu(k,791) - lu(k,433) * lu(k,778) + lu(k,796) = - lu(k,434) * lu(k,778) + lu(k,797) = lu(k,797) - lu(k,435) * lu(k,778) + lu(k,798) = lu(k,798) - lu(k,436) * lu(k,778) + lu(k,799) = lu(k,799) - lu(k,437) * lu(k,778) + lu(k,804) = lu(k,804) - lu(k,438) * lu(k,778) + lu(k,805) = lu(k,805) - lu(k,439) * lu(k,778) + lu(k,895) = lu(k,895) - lu(k,430) * lu(k,891) + lu(k,897) = lu(k,897) - lu(k,431) * lu(k,891) + lu(k,898) = lu(k,898) - lu(k,432) * lu(k,891) + lu(k,904) = lu(k,904) - lu(k,433) * lu(k,891) + lu(k,909) = lu(k,909) - lu(k,434) * lu(k,891) + lu(k,910) = lu(k,910) - lu(k,435) * lu(k,891) + lu(k,911) = lu(k,911) - lu(k,436) * lu(k,891) + lu(k,912) = lu(k,912) - lu(k,437) * lu(k,891) + lu(k,917) = lu(k,917) - lu(k,438) * lu(k,891) + lu(k,918) = lu(k,918) - lu(k,439) * lu(k,891) + lu(k,978) = lu(k,978) - lu(k,430) * lu(k,972) + lu(k,980) = lu(k,980) - lu(k,431) * lu(k,972) + lu(k,981) = lu(k,981) - lu(k,432) * lu(k,972) + lu(k,988) = lu(k,988) - lu(k,433) * lu(k,972) + lu(k,993) = lu(k,993) - lu(k,434) * lu(k,972) + lu(k,994) = lu(k,994) - lu(k,435) * lu(k,972) + lu(k,995) = lu(k,995) - lu(k,436) * lu(k,972) + lu(k,996) = lu(k,996) - lu(k,437) * lu(k,972) + lu(k,1001) = lu(k,1001) - lu(k,438) * lu(k,972) + lu(k,1002) = lu(k,1002) - lu(k,439) * lu(k,972) + lu(k,1219) = lu(k,1219) - lu(k,430) * lu(k,1214) + lu(k,1223) = lu(k,1223) - lu(k,431) * lu(k,1214) + lu(k,1225) = lu(k,1225) - lu(k,432) * lu(k,1214) + lu(k,1234) = lu(k,1234) - lu(k,433) * lu(k,1214) + lu(k,1240) = lu(k,1240) - lu(k,434) * lu(k,1214) + lu(k,1242) = lu(k,1242) - lu(k,435) * lu(k,1214) + lu(k,1243) = - lu(k,436) * lu(k,1214) + lu(k,1244) = - lu(k,437) * lu(k,1214) + lu(k,1249) = lu(k,1249) - lu(k,438) * lu(k,1214) + lu(k,1250) = lu(k,1250) - lu(k,439) * lu(k,1214) + lu(k,1702) = lu(k,1702) - lu(k,430) * lu(k,1694) + lu(k,1706) = lu(k,1706) - lu(k,431) * lu(k,1694) + lu(k,1708) = lu(k,1708) - lu(k,432) * lu(k,1694) + lu(k,1717) = - lu(k,433) * lu(k,1694) + lu(k,1723) = lu(k,1723) - lu(k,434) * lu(k,1694) + lu(k,1725) = lu(k,1725) - lu(k,435) * lu(k,1694) + lu(k,1726) = lu(k,1726) - lu(k,436) * lu(k,1694) + lu(k,1727) = lu(k,1727) - lu(k,437) * lu(k,1694) + lu(k,1732) = lu(k,1732) - lu(k,438) * lu(k,1694) + lu(k,1733) = lu(k,1733) - lu(k,439) * lu(k,1694) + lu(k,1746) = lu(k,1746) - lu(k,430) * lu(k,1742) + lu(k,1751) = lu(k,1751) - lu(k,431) * lu(k,1742) + lu(k,1753) = lu(k,1753) - lu(k,432) * lu(k,1742) + lu(k,1762) = - lu(k,433) * lu(k,1742) + lu(k,1768) = lu(k,1768) - lu(k,434) * lu(k,1742) + lu(k,1770) = lu(k,1770) - lu(k,435) * lu(k,1742) + lu(k,1771) = lu(k,1771) - lu(k,436) * lu(k,1742) + lu(k,1772) = lu(k,1772) - lu(k,437) * lu(k,1742) + lu(k,1777) = lu(k,1777) - lu(k,438) * lu(k,1742) + lu(k,1778) = lu(k,1778) - lu(k,439) * lu(k,1742) + lu(k,1995) = lu(k,1995) - lu(k,430) * lu(k,1991) + lu(k,2000) = lu(k,2000) - lu(k,431) * lu(k,1991) + lu(k,2002) = lu(k,2002) - lu(k,432) * lu(k,1991) + lu(k,2011) = lu(k,2011) - lu(k,433) * lu(k,1991) + lu(k,2017) = lu(k,2017) - lu(k,434) * lu(k,1991) + lu(k,2019) = lu(k,2019) - lu(k,435) * lu(k,1991) + lu(k,2020) = lu(k,2020) - lu(k,436) * lu(k,1991) + lu(k,2021) = lu(k,2021) - lu(k,437) * lu(k,1991) + lu(k,2026) = lu(k,2026) - lu(k,438) * lu(k,1991) + lu(k,2027) = lu(k,2027) - lu(k,439) * lu(k,1991) + lu(k,2056) = lu(k,2056) - lu(k,430) * lu(k,2044) + lu(k,2060) = lu(k,2060) - lu(k,431) * lu(k,2044) + lu(k,2062) = lu(k,2062) - lu(k,432) * lu(k,2044) + lu(k,2071) = lu(k,2071) - lu(k,433) * lu(k,2044) + lu(k,2077) = lu(k,2077) - lu(k,434) * lu(k,2044) + lu(k,2079) = lu(k,2079) - lu(k,435) * lu(k,2044) + lu(k,2080) = - lu(k,436) * lu(k,2044) + lu(k,2081) = lu(k,2081) - lu(k,437) * lu(k,2044) + lu(k,2086) = lu(k,2086) - lu(k,438) * lu(k,2044) + lu(k,2087) = lu(k,2087) - lu(k,439) * lu(k,2044) + lu(k,443) = 1._r8 / lu(k,443) + lu(k,444) = lu(k,444) * lu(k,443) + lu(k,445) = lu(k,445) * lu(k,443) + lu(k,446) = lu(k,446) * lu(k,443) + lu(k,447) = lu(k,447) * lu(k,443) + lu(k,448) = lu(k,448) * lu(k,443) + lu(k,449) = lu(k,449) * lu(k,443) + lu(k,450) = lu(k,450) * lu(k,443) + lu(k,451) = lu(k,451) * lu(k,443) + lu(k,452) = lu(k,452) * lu(k,443) + lu(k,453) = lu(k,453) * lu(k,443) + lu(k,454) = lu(k,454) * lu(k,443) + lu(k,455) = lu(k,455) * lu(k,443) + lu(k,979) = lu(k,979) - lu(k,444) * lu(k,973) + lu(k,980) = lu(k,980) - lu(k,445) * lu(k,973) + lu(k,981) = lu(k,981) - lu(k,446) * lu(k,973) + lu(k,982) = lu(k,982) - lu(k,447) * lu(k,973) + lu(k,984) = - lu(k,448) * lu(k,973) + lu(k,986) = lu(k,986) - lu(k,449) * lu(k,973) + lu(k,988) = lu(k,988) - lu(k,450) * lu(k,973) + lu(k,992) = - lu(k,451) * lu(k,973) + lu(k,993) = lu(k,993) - lu(k,452) * lu(k,973) + lu(k,994) = lu(k,994) - lu(k,453) * lu(k,973) + lu(k,996) = lu(k,996) - lu(k,454) * lu(k,973) + lu(k,1000) = lu(k,1000) - lu(k,455) * lu(k,973) + lu(k,1052) = lu(k,1052) - lu(k,444) * lu(k,1050) + lu(k,1053) = lu(k,1053) - lu(k,445) * lu(k,1050) + lu(k,1054) = lu(k,1054) - lu(k,446) * lu(k,1050) + lu(k,1055) = lu(k,1055) - lu(k,447) * lu(k,1050) + lu(k,1057) = lu(k,1057) - lu(k,448) * lu(k,1050) + lu(k,1060) = lu(k,1060) - lu(k,449) * lu(k,1050) + lu(k,1062) = lu(k,1062) - lu(k,450) * lu(k,1050) + lu(k,1067) = lu(k,1067) - lu(k,451) * lu(k,1050) + lu(k,1068) = lu(k,1068) - lu(k,452) * lu(k,1050) + lu(k,1070) = lu(k,1070) - lu(k,453) * lu(k,1050) + lu(k,1072) = lu(k,1072) - lu(k,454) * lu(k,1050) + lu(k,1076) = lu(k,1076) - lu(k,455) * lu(k,1050) + lu(k,1135) = lu(k,1135) - lu(k,444) * lu(k,1124) + lu(k,1139) = lu(k,1139) - lu(k,445) * lu(k,1124) + lu(k,1141) = lu(k,1141) - lu(k,446) * lu(k,1124) + lu(k,1143) = lu(k,1143) - lu(k,447) * lu(k,1124) + lu(k,1145) = lu(k,1145) - lu(k,448) * lu(k,1124) + lu(k,1148) = lu(k,1148) - lu(k,449) * lu(k,1124) + lu(k,1150) = - lu(k,450) * lu(k,1124) + lu(k,1155) = lu(k,1155) - lu(k,451) * lu(k,1124) + lu(k,1156) = lu(k,1156) - lu(k,452) * lu(k,1124) + lu(k,1158) = lu(k,1158) - lu(k,453) * lu(k,1124) + lu(k,1160) = lu(k,1160) - lu(k,454) * lu(k,1124) + lu(k,1164) = lu(k,1164) - lu(k,455) * lu(k,1124) + lu(k,1279) = lu(k,1279) - lu(k,444) * lu(k,1271) + lu(k,1283) = lu(k,1283) - lu(k,445) * lu(k,1271) + lu(k,1285) = lu(k,1285) - lu(k,446) * lu(k,1271) + lu(k,1287) = lu(k,1287) - lu(k,447) * lu(k,1271) + lu(k,1289) = lu(k,1289) - lu(k,448) * lu(k,1271) + lu(k,1292) = lu(k,1292) - lu(k,449) * lu(k,1271) + lu(k,1294) = lu(k,1294) - lu(k,450) * lu(k,1271) + lu(k,1299) = lu(k,1299) - lu(k,451) * lu(k,1271) + lu(k,1300) = lu(k,1300) - lu(k,452) * lu(k,1271) + lu(k,1302) = lu(k,1302) - lu(k,453) * lu(k,1271) + lu(k,1304) = lu(k,1304) - lu(k,454) * lu(k,1271) + lu(k,1308) = lu(k,1308) - lu(k,455) * lu(k,1271) + lu(k,1569) = lu(k,1569) - lu(k,444) * lu(k,1557) + lu(k,1573) = - lu(k,445) * lu(k,1557) + lu(k,1575) = lu(k,1575) - lu(k,446) * lu(k,1557) + lu(k,1577) = lu(k,1577) - lu(k,447) * lu(k,1557) + lu(k,1579) = lu(k,1579) - lu(k,448) * lu(k,1557) + lu(k,1582) = lu(k,1582) - lu(k,449) * lu(k,1557) + lu(k,1584) = lu(k,1584) - lu(k,450) * lu(k,1557) + lu(k,1589) = lu(k,1589) - lu(k,451) * lu(k,1557) + lu(k,1590) = lu(k,1590) - lu(k,452) * lu(k,1557) + lu(k,1592) = lu(k,1592) - lu(k,453) * lu(k,1557) + lu(k,1594) = lu(k,1594) - lu(k,454) * lu(k,1557) + lu(k,1598) = lu(k,1598) - lu(k,455) * lu(k,1557) + lu(k,1618) = lu(k,1618) - lu(k,444) * lu(k,1608) + lu(k,1621) = lu(k,1621) - lu(k,445) * lu(k,1608) + lu(k,1623) = lu(k,1623) - lu(k,446) * lu(k,1608) + lu(k,1625) = - lu(k,447) * lu(k,1608) + lu(k,1627) = - lu(k,448) * lu(k,1608) + lu(k,1630) = lu(k,1630) - lu(k,449) * lu(k,1608) + lu(k,1632) = - lu(k,450) * lu(k,1608) + lu(k,1637) = - lu(k,451) * lu(k,1608) + lu(k,1638) = lu(k,1638) - lu(k,452) * lu(k,1608) + lu(k,1640) = lu(k,1640) - lu(k,453) * lu(k,1608) + lu(k,1642) = lu(k,1642) - lu(k,454) * lu(k,1608) + lu(k,1646) = lu(k,1646) - lu(k,455) * lu(k,1608) + lu(k,1703) = - lu(k,444) * lu(k,1695) + lu(k,1706) = lu(k,1706) - lu(k,445) * lu(k,1695) + lu(k,1708) = lu(k,1708) - lu(k,446) * lu(k,1695) + lu(k,1710) = lu(k,1710) - lu(k,447) * lu(k,1695) + lu(k,1712) = lu(k,1712) - lu(k,448) * lu(k,1695) + lu(k,1715) = lu(k,1715) - lu(k,449) * lu(k,1695) + lu(k,1717) = lu(k,1717) - lu(k,450) * lu(k,1695) + lu(k,1722) = lu(k,1722) - lu(k,451) * lu(k,1695) + lu(k,1723) = lu(k,1723) - lu(k,452) * lu(k,1695) + lu(k,1725) = lu(k,1725) - lu(k,453) * lu(k,1695) + lu(k,1727) = lu(k,1727) - lu(k,454) * lu(k,1695) + lu(k,1731) = lu(k,1731) - lu(k,455) * lu(k,1695) + lu(k,1797) = lu(k,1797) - lu(k,444) * lu(k,1790) + lu(k,1800) = lu(k,1800) - lu(k,445) * lu(k,1790) + lu(k,1802) = lu(k,1802) - lu(k,446) * lu(k,1790) + lu(k,1804) = lu(k,1804) - lu(k,447) * lu(k,1790) + lu(k,1806) = lu(k,1806) - lu(k,448) * lu(k,1790) + lu(k,1809) = lu(k,1809) - lu(k,449) * lu(k,1790) + lu(k,1811) = lu(k,1811) - lu(k,450) * lu(k,1790) + lu(k,1816) = lu(k,1816) - lu(k,451) * lu(k,1790) + lu(k,1817) = - lu(k,452) * lu(k,1790) + lu(k,1819) = lu(k,1819) - lu(k,453) * lu(k,1790) + lu(k,1821) = lu(k,1821) - lu(k,454) * lu(k,1790) + lu(k,1825) = lu(k,1825) - lu(k,455) * lu(k,1790) + lu(k,1949) = lu(k,1949) - lu(k,444) * lu(k,1945) + lu(k,1952) = lu(k,1952) - lu(k,445) * lu(k,1945) + lu(k,1954) = lu(k,1954) - lu(k,446) * lu(k,1945) + lu(k,1956) = lu(k,1956) - lu(k,447) * lu(k,1945) + lu(k,1958) = lu(k,1958) - lu(k,448) * lu(k,1945) + lu(k,1961) = lu(k,1961) - lu(k,449) * lu(k,1945) + lu(k,1963) = - lu(k,450) * lu(k,1945) + lu(k,1968) = lu(k,1968) - lu(k,451) * lu(k,1945) + lu(k,1969) = - lu(k,452) * lu(k,1945) + lu(k,1971) = lu(k,1971) - lu(k,453) * lu(k,1945) + lu(k,1973) = lu(k,1973) - lu(k,454) * lu(k,1945) + lu(k,1977) = lu(k,1977) - lu(k,455) * lu(k,1945) + lu(k,458) = 1._r8 / lu(k,458) + lu(k,459) = lu(k,459) * lu(k,458) + lu(k,460) = lu(k,460) * lu(k,458) + lu(k,461) = lu(k,461) * lu(k,458) + lu(k,462) = lu(k,462) * lu(k,458) + lu(k,463) = lu(k,463) * lu(k,458) + lu(k,464) = lu(k,464) * lu(k,458) + lu(k,465) = lu(k,465) * lu(k,458) + lu(k,466) = lu(k,466) * lu(k,458) + lu(k,467) = lu(k,467) * lu(k,458) + lu(k,468) = lu(k,468) * lu(k,458) + lu(k,469) = lu(k,469) * lu(k,458) + lu(k,786) = lu(k,786) - lu(k,459) * lu(k,779) + lu(k,787) = lu(k,787) - lu(k,460) * lu(k,779) + lu(k,790) = lu(k,790) - lu(k,461) * lu(k,779) + lu(k,791) = lu(k,791) - lu(k,462) * lu(k,779) + lu(k,792) = - lu(k,463) * lu(k,779) + lu(k,794) = lu(k,794) - lu(k,464) * lu(k,779) + lu(k,795) = lu(k,795) - lu(k,465) * lu(k,779) + lu(k,799) = lu(k,799) - lu(k,466) * lu(k,779) + lu(k,801) = lu(k,801) - lu(k,467) * lu(k,779) + lu(k,802) = lu(k,802) - lu(k,468) * lu(k,779) + lu(k,805) = lu(k,805) - lu(k,469) * lu(k,779) + lu(k,1054) = lu(k,1054) - lu(k,459) * lu(k,1051) + lu(k,1055) = lu(k,1055) - lu(k,460) * lu(k,1051) + lu(k,1060) = lu(k,1060) - lu(k,461) * lu(k,1051) + lu(k,1062) = lu(k,1062) - lu(k,462) * lu(k,1051) + lu(k,1064) = lu(k,1064) - lu(k,463) * lu(k,1051) + lu(k,1066) = lu(k,1066) - lu(k,464) * lu(k,1051) + lu(k,1067) = lu(k,1067) - lu(k,465) * lu(k,1051) + lu(k,1072) = lu(k,1072) - lu(k,466) * lu(k,1051) + lu(k,1074) = lu(k,1074) - lu(k,467) * lu(k,1051) + lu(k,1075) = lu(k,1075) - lu(k,468) * lu(k,1051) + lu(k,1078) = lu(k,1078) - lu(k,469) * lu(k,1051) + lu(k,1285) = lu(k,1285) - lu(k,459) * lu(k,1272) + lu(k,1287) = lu(k,1287) - lu(k,460) * lu(k,1272) + lu(k,1292) = lu(k,1292) - lu(k,461) * lu(k,1272) + lu(k,1294) = lu(k,1294) - lu(k,462) * lu(k,1272) + lu(k,1296) = - lu(k,463) * lu(k,1272) + lu(k,1298) = lu(k,1298) - lu(k,464) * lu(k,1272) + lu(k,1299) = lu(k,1299) - lu(k,465) * lu(k,1272) + lu(k,1304) = lu(k,1304) - lu(k,466) * lu(k,1272) + lu(k,1306) = lu(k,1306) - lu(k,467) * lu(k,1272) + lu(k,1307) = lu(k,1307) - lu(k,468) * lu(k,1272) + lu(k,1310) = lu(k,1310) - lu(k,469) * lu(k,1272) + lu(k,1530) = - lu(k,459) * lu(k,1523) + lu(k,1532) = lu(k,1532) - lu(k,460) * lu(k,1523) + lu(k,1537) = lu(k,1537) - lu(k,461) * lu(k,1523) + lu(k,1539) = lu(k,1539) - lu(k,462) * lu(k,1523) + lu(k,1541) = lu(k,1541) - lu(k,463) * lu(k,1523) + lu(k,1543) = lu(k,1543) - lu(k,464) * lu(k,1523) + lu(k,1544) = lu(k,1544) - lu(k,465) * lu(k,1523) + lu(k,1549) = lu(k,1549) - lu(k,466) * lu(k,1523) + lu(k,1551) = lu(k,1551) - lu(k,467) * lu(k,1523) + lu(k,1552) = lu(k,1552) - lu(k,468) * lu(k,1523) + lu(k,1555) = lu(k,1555) - lu(k,469) * lu(k,1523) + lu(k,1575) = lu(k,1575) - lu(k,459) * lu(k,1558) + lu(k,1577) = lu(k,1577) - lu(k,460) * lu(k,1558) + lu(k,1582) = lu(k,1582) - lu(k,461) * lu(k,1558) + lu(k,1584) = lu(k,1584) - lu(k,462) * lu(k,1558) + lu(k,1586) = lu(k,1586) - lu(k,463) * lu(k,1558) + lu(k,1588) = lu(k,1588) - lu(k,464) * lu(k,1558) + lu(k,1589) = lu(k,1589) - lu(k,465) * lu(k,1558) + lu(k,1594) = lu(k,1594) - lu(k,466) * lu(k,1558) + lu(k,1596) = - lu(k,467) * lu(k,1558) + lu(k,1597) = - lu(k,468) * lu(k,1558) + lu(k,1600) = lu(k,1600) - lu(k,469) * lu(k,1558) + lu(k,1802) = lu(k,1802) - lu(k,459) * lu(k,1791) + lu(k,1804) = lu(k,1804) - lu(k,460) * lu(k,1791) + lu(k,1809) = lu(k,1809) - lu(k,461) * lu(k,1791) + lu(k,1811) = lu(k,1811) - lu(k,462) * lu(k,1791) + lu(k,1813) = - lu(k,463) * lu(k,1791) + lu(k,1815) = lu(k,1815) - lu(k,464) * lu(k,1791) + lu(k,1816) = lu(k,1816) - lu(k,465) * lu(k,1791) + lu(k,1821) = lu(k,1821) - lu(k,466) * lu(k,1791) + lu(k,1823) = lu(k,1823) - lu(k,467) * lu(k,1791) + lu(k,1824) = lu(k,1824) - lu(k,468) * lu(k,1791) + lu(k,1827) = lu(k,1827) - lu(k,469) * lu(k,1791) + lu(k,1871) = lu(k,1871) - lu(k,459) * lu(k,1862) + lu(k,1873) = lu(k,1873) - lu(k,460) * lu(k,1862) + lu(k,1878) = lu(k,1878) - lu(k,461) * lu(k,1862) + lu(k,1880) = lu(k,1880) - lu(k,462) * lu(k,1862) + lu(k,1882) = - lu(k,463) * lu(k,1862) + lu(k,1884) = lu(k,1884) - lu(k,464) * lu(k,1862) + lu(k,1885) = lu(k,1885) - lu(k,465) * lu(k,1862) + lu(k,1890) = lu(k,1890) - lu(k,466) * lu(k,1862) + lu(k,1892) = lu(k,1892) - lu(k,467) * lu(k,1862) + lu(k,1893) = lu(k,1893) - lu(k,468) * lu(k,1862) + lu(k,1896) = lu(k,1896) - lu(k,469) * lu(k,1862) + lu(k,1912) = lu(k,1912) - lu(k,459) * lu(k,1901) + lu(k,1914) = lu(k,1914) - lu(k,460) * lu(k,1901) + lu(k,1919) = lu(k,1919) - lu(k,461) * lu(k,1901) + lu(k,1921) = lu(k,1921) - lu(k,462) * lu(k,1901) + lu(k,1923) = - lu(k,463) * lu(k,1901) + lu(k,1925) = lu(k,1925) - lu(k,464) * lu(k,1901) + lu(k,1926) = lu(k,1926) - lu(k,465) * lu(k,1901) + lu(k,1931) = lu(k,1931) - lu(k,466) * lu(k,1901) + lu(k,1933) = lu(k,1933) - lu(k,467) * lu(k,1901) + lu(k,1934) = lu(k,1934) - lu(k,468) * lu(k,1901) + lu(k,1937) = lu(k,1937) - lu(k,469) * lu(k,1901) + lu(k,1954) = lu(k,1954) - lu(k,459) * lu(k,1946) + lu(k,1956) = lu(k,1956) - lu(k,460) * lu(k,1946) + lu(k,1961) = lu(k,1961) - lu(k,461) * lu(k,1946) + lu(k,1963) = lu(k,1963) - lu(k,462) * lu(k,1946) + lu(k,1965) = - lu(k,463) * lu(k,1946) + lu(k,1967) = lu(k,1967) - lu(k,464) * lu(k,1946) + lu(k,1968) = lu(k,1968) - lu(k,465) * lu(k,1946) + lu(k,1973) = lu(k,1973) - lu(k,466) * lu(k,1946) + lu(k,1975) = lu(k,1975) - lu(k,467) * lu(k,1946) + lu(k,1976) = lu(k,1976) - lu(k,468) * lu(k,1946) + lu(k,1979) = lu(k,1979) - lu(k,469) * lu(k,1946) + lu(k,2062) = lu(k,2062) - lu(k,459) * lu(k,2045) + lu(k,2064) = lu(k,2064) - lu(k,460) * lu(k,2045) + lu(k,2069) = lu(k,2069) - lu(k,461) * lu(k,2045) + lu(k,2071) = lu(k,2071) - lu(k,462) * lu(k,2045) + lu(k,2073) = lu(k,2073) - lu(k,463) * lu(k,2045) + lu(k,2075) = - lu(k,464) * lu(k,2045) + lu(k,2076) = lu(k,2076) - lu(k,465) * lu(k,2045) + lu(k,2081) = lu(k,2081) - lu(k,466) * lu(k,2045) + lu(k,2083) = lu(k,2083) - lu(k,467) * lu(k,2045) + lu(k,2084) = - lu(k,468) * lu(k,2045) + lu(k,2087) = lu(k,2087) - lu(k,469) * lu(k,2045) end do end subroutine lu_fac11 subroutine lu_fac12( avec_len, lu ) @@ -2674,324 +2276,137 @@ subroutine lu_fac12( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,438) = 1._r8 / lu(k,438) - lu(k,439) = lu(k,439) * lu(k,438) - lu(k,440) = lu(k,440) * lu(k,438) - lu(k,441) = lu(k,441) * lu(k,438) - lu(k,442) = lu(k,442) * lu(k,438) - lu(k,443) = lu(k,443) * lu(k,438) - lu(k,444) = lu(k,444) * lu(k,438) - lu(k,445) = lu(k,445) * lu(k,438) - lu(k,446) = lu(k,446) * lu(k,438) - lu(k,447) = lu(k,447) * lu(k,438) - lu(k,448) = lu(k,448) * lu(k,438) - lu(k,449) = lu(k,449) * lu(k,438) - lu(k,450) = lu(k,450) * lu(k,438) - lu(k,451) = lu(k,451) * lu(k,438) - lu(k,662) = - lu(k,439) * lu(k,659) - lu(k,665) = lu(k,665) - lu(k,440) * lu(k,659) - lu(k,666) = lu(k,666) - lu(k,441) * lu(k,659) - lu(k,669) = lu(k,669) - lu(k,442) * lu(k,659) - lu(k,673) = lu(k,673) - lu(k,443) * lu(k,659) - lu(k,674) = lu(k,674) - lu(k,444) * lu(k,659) - lu(k,675) = lu(k,675) - lu(k,445) * lu(k,659) - lu(k,677) = lu(k,677) - lu(k,446) * lu(k,659) - lu(k,679) = lu(k,679) - lu(k,447) * lu(k,659) - lu(k,680) = - lu(k,448) * lu(k,659) - lu(k,682) = - lu(k,449) * lu(k,659) - lu(k,683) = - lu(k,450) * lu(k,659) - lu(k,686) = lu(k,686) - lu(k,451) * lu(k,659) - lu(k,820) = lu(k,820) - lu(k,439) * lu(k,816) - lu(k,822) = lu(k,822) - lu(k,440) * lu(k,816) - lu(k,823) = lu(k,823) - lu(k,441) * lu(k,816) - lu(k,826) = lu(k,826) - lu(k,442) * lu(k,816) - lu(k,831) = - lu(k,443) * lu(k,816) - lu(k,832) = lu(k,832) - lu(k,444) * lu(k,816) - lu(k,834) = lu(k,834) - lu(k,445) * lu(k,816) - lu(k,836) = lu(k,836) - lu(k,446) * lu(k,816) - lu(k,838) = lu(k,838) - lu(k,447) * lu(k,816) - lu(k,839) = - lu(k,448) * lu(k,816) - lu(k,841) = lu(k,841) - lu(k,449) * lu(k,816) - lu(k,842) = lu(k,842) - lu(k,450) * lu(k,816) - lu(k,845) = lu(k,845) - lu(k,451) * lu(k,816) - lu(k,983) = lu(k,983) - lu(k,439) * lu(k,973) - lu(k,986) = lu(k,986) - lu(k,440) * lu(k,973) - lu(k,987) = lu(k,987) - lu(k,441) * lu(k,973) - lu(k,990) = lu(k,990) - lu(k,442) * lu(k,973) - lu(k,995) = lu(k,995) - lu(k,443) * lu(k,973) - lu(k,996) = lu(k,996) - lu(k,444) * lu(k,973) - lu(k,998) = lu(k,998) - lu(k,445) * lu(k,973) - lu(k,1000) = lu(k,1000) - lu(k,446) * lu(k,973) - lu(k,1002) = lu(k,1002) - lu(k,447) * lu(k,973) - lu(k,1003) = lu(k,1003) - lu(k,448) * lu(k,973) - lu(k,1005) = lu(k,1005) - lu(k,449) * lu(k,973) - lu(k,1006) = lu(k,1006) - lu(k,450) * lu(k,973) - lu(k,1009) = lu(k,1009) - lu(k,451) * lu(k,973) - lu(k,1190) = lu(k,1190) - lu(k,439) * lu(k,1183) - lu(k,1193) = - lu(k,440) * lu(k,1183) - lu(k,1194) = lu(k,1194) - lu(k,441) * lu(k,1183) - lu(k,1197) = lu(k,1197) - lu(k,442) * lu(k,1183) - lu(k,1202) = lu(k,1202) - lu(k,443) * lu(k,1183) - lu(k,1203) = lu(k,1203) - lu(k,444) * lu(k,1183) - lu(k,1205) = lu(k,1205) - lu(k,445) * lu(k,1183) - lu(k,1207) = lu(k,1207) - lu(k,446) * lu(k,1183) - lu(k,1209) = lu(k,1209) - lu(k,447) * lu(k,1183) - lu(k,1210) = lu(k,1210) - lu(k,448) * lu(k,1183) - lu(k,1212) = lu(k,1212) - lu(k,449) * lu(k,1183) - lu(k,1213) = lu(k,1213) - lu(k,450) * lu(k,1183) - lu(k,1216) = lu(k,1216) - lu(k,451) * lu(k,1183) - lu(k,1239) = - lu(k,439) * lu(k,1232) - lu(k,1242) = lu(k,1242) - lu(k,440) * lu(k,1232) - lu(k,1243) = - lu(k,441) * lu(k,1232) - lu(k,1246) = lu(k,1246) - lu(k,442) * lu(k,1232) - lu(k,1251) = lu(k,1251) - lu(k,443) * lu(k,1232) - lu(k,1252) = lu(k,1252) - lu(k,444) * lu(k,1232) - lu(k,1254) = lu(k,1254) - lu(k,445) * lu(k,1232) - lu(k,1256) = lu(k,1256) - lu(k,446) * lu(k,1232) - lu(k,1258) = lu(k,1258) - lu(k,447) * lu(k,1232) - lu(k,1259) = lu(k,1259) - lu(k,448) * lu(k,1232) - lu(k,1261) = - lu(k,449) * lu(k,1232) - lu(k,1262) = lu(k,1262) - lu(k,450) * lu(k,1232) - lu(k,1265) = lu(k,1265) - lu(k,451) * lu(k,1232) - lu(k,1313) = lu(k,1313) - lu(k,439) * lu(k,1310) - lu(k,1316) = - lu(k,440) * lu(k,1310) - lu(k,1317) = lu(k,1317) - lu(k,441) * lu(k,1310) - lu(k,1320) = lu(k,1320) - lu(k,442) * lu(k,1310) - lu(k,1325) = lu(k,1325) - lu(k,443) * lu(k,1310) - lu(k,1326) = lu(k,1326) - lu(k,444) * lu(k,1310) - lu(k,1328) = lu(k,1328) - lu(k,445) * lu(k,1310) - lu(k,1330) = lu(k,1330) - lu(k,446) * lu(k,1310) - lu(k,1332) = lu(k,1332) - lu(k,447) * lu(k,1310) - lu(k,1333) = lu(k,1333) - lu(k,448) * lu(k,1310) - lu(k,1335) = - lu(k,449) * lu(k,1310) - lu(k,1336) = lu(k,1336) - lu(k,450) * lu(k,1310) - lu(k,1339) = lu(k,1339) - lu(k,451) * lu(k,1310) - lu(k,1416) = lu(k,1416) - lu(k,439) * lu(k,1408) - lu(k,1419) = lu(k,1419) - lu(k,440) * lu(k,1408) - lu(k,1420) = lu(k,1420) - lu(k,441) * lu(k,1408) - lu(k,1423) = lu(k,1423) - lu(k,442) * lu(k,1408) - lu(k,1428) = lu(k,1428) - lu(k,443) * lu(k,1408) - lu(k,1429) = lu(k,1429) - lu(k,444) * lu(k,1408) - lu(k,1431) = lu(k,1431) - lu(k,445) * lu(k,1408) - lu(k,1433) = lu(k,1433) - lu(k,446) * lu(k,1408) - lu(k,1435) = lu(k,1435) - lu(k,447) * lu(k,1408) - lu(k,1436) = lu(k,1436) - lu(k,448) * lu(k,1408) - lu(k,1438) = lu(k,1438) - lu(k,449) * lu(k,1408) - lu(k,1439) = lu(k,1439) - lu(k,450) * lu(k,1408) - lu(k,1442) = lu(k,1442) - lu(k,451) * lu(k,1408) - lu(k,1499) = lu(k,1499) - lu(k,439) * lu(k,1491) - lu(k,1502) = lu(k,1502) - lu(k,440) * lu(k,1491) - lu(k,1503) = lu(k,1503) - lu(k,441) * lu(k,1491) - lu(k,1506) = lu(k,1506) - lu(k,442) * lu(k,1491) - lu(k,1511) = lu(k,1511) - lu(k,443) * lu(k,1491) - lu(k,1512) = lu(k,1512) - lu(k,444) * lu(k,1491) - lu(k,1514) = - lu(k,445) * lu(k,1491) - lu(k,1516) = lu(k,1516) - lu(k,446) * lu(k,1491) - lu(k,1518) = lu(k,1518) - lu(k,447) * lu(k,1491) - lu(k,1519) = lu(k,1519) - lu(k,448) * lu(k,1491) - lu(k,1521) = - lu(k,449) * lu(k,1491) - lu(k,1522) = lu(k,1522) - lu(k,450) * lu(k,1491) - lu(k,1525) = lu(k,1525) - lu(k,451) * lu(k,1491) - lu(k,1615) = - lu(k,439) * lu(k,1613) - lu(k,1618) = - lu(k,440) * lu(k,1613) - lu(k,1619) = lu(k,1619) - lu(k,441) * lu(k,1613) - lu(k,1622) = lu(k,1622) - lu(k,442) * lu(k,1613) - lu(k,1627) = lu(k,1627) - lu(k,443) * lu(k,1613) - lu(k,1628) = lu(k,1628) - lu(k,444) * lu(k,1613) - lu(k,1630) = - lu(k,445) * lu(k,1613) - lu(k,1632) = lu(k,1632) - lu(k,446) * lu(k,1613) - lu(k,1634) = lu(k,1634) - lu(k,447) * lu(k,1613) - lu(k,1635) = lu(k,1635) - lu(k,448) * lu(k,1613) - lu(k,1637) = lu(k,1637) - lu(k,449) * lu(k,1613) - lu(k,1638) = - lu(k,450) * lu(k,1613) - lu(k,1641) = lu(k,1641) - lu(k,451) * lu(k,1613) - lu(k,1650) = lu(k,1650) - lu(k,439) * lu(k,1645) - lu(k,1653) = lu(k,1653) - lu(k,440) * lu(k,1645) - lu(k,1654) = lu(k,1654) - lu(k,441) * lu(k,1645) - lu(k,1657) = lu(k,1657) - lu(k,442) * lu(k,1645) - lu(k,1662) = lu(k,1662) - lu(k,443) * lu(k,1645) - lu(k,1663) = lu(k,1663) - lu(k,444) * lu(k,1645) - lu(k,1665) = lu(k,1665) - lu(k,445) * lu(k,1645) - lu(k,1667) = lu(k,1667) - lu(k,446) * lu(k,1645) - lu(k,1669) = lu(k,1669) - lu(k,447) * lu(k,1645) - lu(k,1670) = lu(k,1670) - lu(k,448) * lu(k,1645) - lu(k,1672) = lu(k,1672) - lu(k,449) * lu(k,1645) - lu(k,1673) = lu(k,1673) - lu(k,450) * lu(k,1645) - lu(k,1676) = lu(k,1676) - lu(k,451) * lu(k,1645) - lu(k,1771) = - lu(k,439) * lu(k,1765) - lu(k,1774) = lu(k,1774) - lu(k,440) * lu(k,1765) - lu(k,1775) = lu(k,1775) - lu(k,441) * lu(k,1765) - lu(k,1778) = - lu(k,442) * lu(k,1765) - lu(k,1783) = lu(k,1783) - lu(k,443) * lu(k,1765) - lu(k,1784) = lu(k,1784) - lu(k,444) * lu(k,1765) - lu(k,1786) = lu(k,1786) - lu(k,445) * lu(k,1765) - lu(k,1788) = lu(k,1788) - lu(k,446) * lu(k,1765) - lu(k,1790) = lu(k,1790) - lu(k,447) * lu(k,1765) - lu(k,1791) = lu(k,1791) - lu(k,448) * lu(k,1765) - lu(k,1793) = lu(k,1793) - lu(k,449) * lu(k,1765) - lu(k,1794) = - lu(k,450) * lu(k,1765) - lu(k,1797) = lu(k,1797) - lu(k,451) * lu(k,1765) - lu(k,454) = 1._r8 / lu(k,454) - lu(k,455) = lu(k,455) * lu(k,454) - lu(k,456) = lu(k,456) * lu(k,454) - lu(k,457) = lu(k,457) * lu(k,454) - lu(k,458) = lu(k,458) * lu(k,454) - lu(k,459) = lu(k,459) * lu(k,454) - lu(k,460) = lu(k,460) * lu(k,454) - lu(k,461) = lu(k,461) * lu(k,454) - lu(k,462) = lu(k,462) * lu(k,454) - lu(k,463) = lu(k,463) * lu(k,454) - lu(k,464) = lu(k,464) * lu(k,454) - lu(k,584) = lu(k,584) - lu(k,455) * lu(k,583) - lu(k,585) = - lu(k,456) * lu(k,583) - lu(k,586) = - lu(k,457) * lu(k,583) - lu(k,587) = lu(k,587) - lu(k,458) * lu(k,583) - lu(k,588) = lu(k,588) - lu(k,459) * lu(k,583) - lu(k,592) = lu(k,592) - lu(k,460) * lu(k,583) - lu(k,593) = lu(k,593) - lu(k,461) * lu(k,583) - lu(k,595) = lu(k,595) - lu(k,462) * lu(k,583) - lu(k,599) = lu(k,599) - lu(k,463) * lu(k,583) - lu(k,600) = lu(k,600) - lu(k,464) * lu(k,583) - lu(k,605) = lu(k,605) - lu(k,455) * lu(k,603) - lu(k,606) = lu(k,606) - lu(k,456) * lu(k,603) - lu(k,607) = lu(k,607) - lu(k,457) * lu(k,603) - lu(k,608) = lu(k,608) - lu(k,458) * lu(k,603) - lu(k,609) = lu(k,609) - lu(k,459) * lu(k,603) - lu(k,613) = - lu(k,460) * lu(k,603) - lu(k,614) = - lu(k,461) * lu(k,603) - lu(k,616) = lu(k,616) - lu(k,462) * lu(k,603) - lu(k,623) = lu(k,623) - lu(k,463) * lu(k,603) - lu(k,624) = lu(k,624) - lu(k,464) * lu(k,603) - lu(k,635) = lu(k,635) - lu(k,455) * lu(k,633) - lu(k,636) = lu(k,636) - lu(k,456) * lu(k,633) - lu(k,637) = lu(k,637) - lu(k,457) * lu(k,633) - lu(k,638) = lu(k,638) - lu(k,458) * lu(k,633) - lu(k,639) = lu(k,639) - lu(k,459) * lu(k,633) - lu(k,644) = lu(k,644) - lu(k,460) * lu(k,633) - lu(k,645) = lu(k,645) - lu(k,461) * lu(k,633) - lu(k,649) = lu(k,649) - lu(k,462) * lu(k,633) - lu(k,656) = lu(k,656) - lu(k,463) * lu(k,633) - lu(k,657) = lu(k,657) - lu(k,464) * lu(k,633) - lu(k,744) = lu(k,744) - lu(k,455) * lu(k,742) - lu(k,745) = lu(k,745) - lu(k,456) * lu(k,742) - lu(k,746) = lu(k,746) - lu(k,457) * lu(k,742) - lu(k,747) = lu(k,747) - lu(k,458) * lu(k,742) - lu(k,748) = lu(k,748) - lu(k,459) * lu(k,742) - lu(k,754) = lu(k,754) - lu(k,460) * lu(k,742) - lu(k,755) = lu(k,755) - lu(k,461) * lu(k,742) - lu(k,759) = lu(k,759) - lu(k,462) * lu(k,742) - lu(k,766) = lu(k,766) - lu(k,463) * lu(k,742) - lu(k,767) = lu(k,767) - lu(k,464) * lu(k,742) - lu(k,790) = lu(k,790) - lu(k,455) * lu(k,788) - lu(k,791) = lu(k,791) - lu(k,456) * lu(k,788) - lu(k,792) = lu(k,792) - lu(k,457) * lu(k,788) - lu(k,793) = lu(k,793) - lu(k,458) * lu(k,788) - lu(k,794) = lu(k,794) - lu(k,459) * lu(k,788) - lu(k,801) = lu(k,801) - lu(k,460) * lu(k,788) - lu(k,802) = lu(k,802) - lu(k,461) * lu(k,788) - lu(k,806) = lu(k,806) - lu(k,462) * lu(k,788) - lu(k,813) = lu(k,813) - lu(k,463) * lu(k,788) - lu(k,814) = lu(k,814) - lu(k,464) * lu(k,788) - lu(k,979) = lu(k,979) - lu(k,455) * lu(k,974) - lu(k,980) = - lu(k,456) * lu(k,974) - lu(k,981) = lu(k,981) - lu(k,457) * lu(k,974) - lu(k,984) = lu(k,984) - lu(k,458) * lu(k,974) - lu(k,985) = lu(k,985) - lu(k,459) * lu(k,974) - lu(k,995) = lu(k,995) - lu(k,460) * lu(k,974) - lu(k,996) = lu(k,996) - lu(k,461) * lu(k,974) - lu(k,1000) = lu(k,1000) - lu(k,462) * lu(k,974) - lu(k,1009) = lu(k,1009) - lu(k,463) * lu(k,974) - lu(k,1010) = lu(k,1010) - lu(k,464) * lu(k,974) - lu(k,1103) = lu(k,1103) - lu(k,455) * lu(k,1099) - lu(k,1104) = lu(k,1104) - lu(k,456) * lu(k,1099) - lu(k,1105) = - lu(k,457) * lu(k,1099) - lu(k,1107) = lu(k,1107) - lu(k,458) * lu(k,1099) - lu(k,1108) = lu(k,1108) - lu(k,459) * lu(k,1099) - lu(k,1117) = lu(k,1117) - lu(k,460) * lu(k,1099) - lu(k,1118) = lu(k,1118) - lu(k,461) * lu(k,1099) - lu(k,1122) = lu(k,1122) - lu(k,462) * lu(k,1099) - lu(k,1131) = lu(k,1131) - lu(k,463) * lu(k,1099) - lu(k,1132) = lu(k,1132) - lu(k,464) * lu(k,1099) - lu(k,1144) = lu(k,1144) - lu(k,455) * lu(k,1141) - lu(k,1145) = - lu(k,456) * lu(k,1141) - lu(k,1146) = lu(k,1146) - lu(k,457) * lu(k,1141) - lu(k,1150) = lu(k,1150) - lu(k,458) * lu(k,1141) - lu(k,1151) = lu(k,1151) - lu(k,459) * lu(k,1141) - lu(k,1161) = - lu(k,460) * lu(k,1141) - lu(k,1162) = lu(k,1162) - lu(k,461) * lu(k,1141) - lu(k,1166) = lu(k,1166) - lu(k,462) * lu(k,1141) - lu(k,1175) = lu(k,1175) - lu(k,463) * lu(k,1141) - lu(k,1176) = lu(k,1176) - lu(k,464) * lu(k,1141) - lu(k,1185) = lu(k,1185) - lu(k,455) * lu(k,1184) - lu(k,1186) = - lu(k,456) * lu(k,1184) - lu(k,1187) = lu(k,1187) - lu(k,457) * lu(k,1184) - lu(k,1191) = lu(k,1191) - lu(k,458) * lu(k,1184) - lu(k,1192) = lu(k,1192) - lu(k,459) * lu(k,1184) - lu(k,1202) = lu(k,1202) - lu(k,460) * lu(k,1184) - lu(k,1203) = lu(k,1203) - lu(k,461) * lu(k,1184) - lu(k,1207) = lu(k,1207) - lu(k,462) * lu(k,1184) - lu(k,1216) = lu(k,1216) - lu(k,463) * lu(k,1184) - lu(k,1217) = lu(k,1217) - lu(k,464) * lu(k,1184) - lu(k,1234) = lu(k,1234) - lu(k,455) * lu(k,1233) - lu(k,1235) = - lu(k,456) * lu(k,1233) - lu(k,1236) = lu(k,1236) - lu(k,457) * lu(k,1233) - lu(k,1240) = lu(k,1240) - lu(k,458) * lu(k,1233) - lu(k,1241) = lu(k,1241) - lu(k,459) * lu(k,1233) - lu(k,1251) = lu(k,1251) - lu(k,460) * lu(k,1233) - lu(k,1252) = lu(k,1252) - lu(k,461) * lu(k,1233) - lu(k,1256) = lu(k,1256) - lu(k,462) * lu(k,1233) - lu(k,1265) = lu(k,1265) - lu(k,463) * lu(k,1233) - lu(k,1266) = lu(k,1266) - lu(k,464) * lu(k,1233) - lu(k,1411) = lu(k,1411) - lu(k,455) * lu(k,1409) - lu(k,1412) = lu(k,1412) - lu(k,456) * lu(k,1409) - lu(k,1413) = lu(k,1413) - lu(k,457) * lu(k,1409) - lu(k,1417) = lu(k,1417) - lu(k,458) * lu(k,1409) - lu(k,1418) = lu(k,1418) - lu(k,459) * lu(k,1409) - lu(k,1428) = lu(k,1428) - lu(k,460) * lu(k,1409) - lu(k,1429) = lu(k,1429) - lu(k,461) * lu(k,1409) - lu(k,1433) = lu(k,1433) - lu(k,462) * lu(k,1409) - lu(k,1442) = lu(k,1442) - lu(k,463) * lu(k,1409) - lu(k,1443) = lu(k,1443) - lu(k,464) * lu(k,1409) - lu(k,1453) = - lu(k,455) * lu(k,1451) - lu(k,1454) = lu(k,1454) - lu(k,456) * lu(k,1451) - lu(k,1455) = - lu(k,457) * lu(k,1451) - lu(k,1459) = lu(k,1459) - lu(k,458) * lu(k,1451) - lu(k,1460) = lu(k,1460) - lu(k,459) * lu(k,1451) - lu(k,1470) = lu(k,1470) - lu(k,460) * lu(k,1451) - lu(k,1471) = lu(k,1471) - lu(k,461) * lu(k,1451) - lu(k,1475) = lu(k,1475) - lu(k,462) * lu(k,1451) - lu(k,1484) = lu(k,1484) - lu(k,463) * lu(k,1451) - lu(k,1485) = lu(k,1485) - lu(k,464) * lu(k,1451) - lu(k,1495) = lu(k,1495) - lu(k,455) * lu(k,1492) - lu(k,1496) = lu(k,1496) - lu(k,456) * lu(k,1492) - lu(k,1497) = lu(k,1497) - lu(k,457) * lu(k,1492) - lu(k,1500) = lu(k,1500) - lu(k,458) * lu(k,1492) - lu(k,1501) = lu(k,1501) - lu(k,459) * lu(k,1492) - lu(k,1511) = lu(k,1511) - lu(k,460) * lu(k,1492) - lu(k,1512) = lu(k,1512) - lu(k,461) * lu(k,1492) - lu(k,1516) = lu(k,1516) - lu(k,462) * lu(k,1492) - lu(k,1525) = lu(k,1525) - lu(k,463) * lu(k,1492) - lu(k,1526) = lu(k,1526) - lu(k,464) * lu(k,1492) - lu(k,1731) = lu(k,1731) - lu(k,455) * lu(k,1730) - lu(k,1732) = lu(k,1732) - lu(k,456) * lu(k,1730) - lu(k,1733) = - lu(k,457) * lu(k,1730) - lu(k,1737) = lu(k,1737) - lu(k,458) * lu(k,1730) - lu(k,1738) = lu(k,1738) - lu(k,459) * lu(k,1730) - lu(k,1748) = lu(k,1748) - lu(k,460) * lu(k,1730) - lu(k,1749) = lu(k,1749) - lu(k,461) * lu(k,1730) - lu(k,1753) = lu(k,1753) - lu(k,462) * lu(k,1730) - lu(k,1762) = lu(k,1762) - lu(k,463) * lu(k,1730) - lu(k,1763) = lu(k,1763) - lu(k,464) * lu(k,1730) - lu(k,1825) = lu(k,1825) - lu(k,455) * lu(k,1820) - lu(k,1826) = lu(k,1826) - lu(k,456) * lu(k,1820) - lu(k,1827) = lu(k,1827) - lu(k,457) * lu(k,1820) - lu(k,1830) = lu(k,1830) - lu(k,458) * lu(k,1820) - lu(k,1831) = lu(k,1831) - lu(k,459) * lu(k,1820) - lu(k,1841) = lu(k,1841) - lu(k,460) * lu(k,1820) - lu(k,1842) = lu(k,1842) - lu(k,461) * lu(k,1820) - lu(k,1846) = lu(k,1846) - lu(k,462) * lu(k,1820) - lu(k,1855) = lu(k,1855) - lu(k,463) * lu(k,1820) - lu(k,1856) = lu(k,1856) - lu(k,464) * lu(k,1820) + lu(k,470) = 1._r8 / lu(k,470) + lu(k,471) = lu(k,471) * lu(k,470) + lu(k,472) = lu(k,472) * lu(k,470) + lu(k,473) = lu(k,473) * lu(k,470) + lu(k,474) = lu(k,474) * lu(k,470) + lu(k,475) = lu(k,475) * lu(k,470) + lu(k,476) = lu(k,476) * lu(k,470) + lu(k,477) = lu(k,477) * lu(k,470) + lu(k,478) = lu(k,478) * lu(k,470) + lu(k,479) = lu(k,479) * lu(k,470) + lu(k,480) = lu(k,480) * lu(k,470) + lu(k,481) = lu(k,481) * lu(k,470) + lu(k,482) = lu(k,482) * lu(k,470) + lu(k,483) = lu(k,483) * lu(k,470) + lu(k,1141) = lu(k,1141) - lu(k,471) * lu(k,1125) + lu(k,1145) = lu(k,1145) - lu(k,472) * lu(k,1125) + lu(k,1146) = - lu(k,473) * lu(k,1125) + lu(k,1149) = lu(k,1149) - lu(k,474) * lu(k,1125) + lu(k,1150) = lu(k,1150) - lu(k,475) * lu(k,1125) + lu(k,1151) = - lu(k,476) * lu(k,1125) + lu(k,1152) = - lu(k,477) * lu(k,1125) + lu(k,1155) = lu(k,1155) - lu(k,478) * lu(k,1125) + lu(k,1157) = - lu(k,479) * lu(k,1125) + lu(k,1158) = lu(k,1158) - lu(k,480) * lu(k,1125) + lu(k,1160) = lu(k,1160) - lu(k,481) * lu(k,1125) + lu(k,1164) = lu(k,1164) - lu(k,482) * lu(k,1125) + lu(k,1166) = lu(k,1166) - lu(k,483) * lu(k,1125) + lu(k,1184) = lu(k,1184) - lu(k,471) * lu(k,1169) + lu(k,1188) = - lu(k,472) * lu(k,1169) + lu(k,1189) = lu(k,1189) - lu(k,473) * lu(k,1169) + lu(k,1192) = - lu(k,474) * lu(k,1169) + lu(k,1193) = - lu(k,475) * lu(k,1169) + lu(k,1194) = - lu(k,476) * lu(k,1169) + lu(k,1195) = lu(k,1195) - lu(k,477) * lu(k,1169) + lu(k,1198) = - lu(k,478) * lu(k,1169) + lu(k,1200) = - lu(k,479) * lu(k,1169) + lu(k,1201) = lu(k,1201) - lu(k,480) * lu(k,1169) + lu(k,1203) = lu(k,1203) - lu(k,481) * lu(k,1169) + lu(k,1207) = lu(k,1207) - lu(k,482) * lu(k,1169) + lu(k,1209) = lu(k,1209) - lu(k,483) * lu(k,1169) + lu(k,1327) = lu(k,1327) - lu(k,471) * lu(k,1312) + lu(k,1331) = - lu(k,472) * lu(k,1312) + lu(k,1332) = lu(k,1332) - lu(k,473) * lu(k,1312) + lu(k,1335) = lu(k,1335) - lu(k,474) * lu(k,1312) + lu(k,1336) = lu(k,1336) - lu(k,475) * lu(k,1312) + lu(k,1337) = - lu(k,476) * lu(k,1312) + lu(k,1338) = lu(k,1338) - lu(k,477) * lu(k,1312) + lu(k,1341) = - lu(k,478) * lu(k,1312) + lu(k,1343) = - lu(k,479) * lu(k,1312) + lu(k,1344) = lu(k,1344) - lu(k,480) * lu(k,1312) + lu(k,1346) = lu(k,1346) - lu(k,481) * lu(k,1312) + lu(k,1350) = lu(k,1350) - lu(k,482) * lu(k,1312) + lu(k,1352) = lu(k,1352) - lu(k,483) * lu(k,1312) + lu(k,1406) = lu(k,1406) - lu(k,471) * lu(k,1391) + lu(k,1410) = - lu(k,472) * lu(k,1391) + lu(k,1411) = - lu(k,473) * lu(k,1391) + lu(k,1414) = - lu(k,474) * lu(k,1391) + lu(k,1415) = lu(k,1415) - lu(k,475) * lu(k,1391) + lu(k,1416) = lu(k,1416) - lu(k,476) * lu(k,1391) + lu(k,1417) = - lu(k,477) * lu(k,1391) + lu(k,1420) = - lu(k,478) * lu(k,1391) + lu(k,1422) = lu(k,1422) - lu(k,479) * lu(k,1391) + lu(k,1423) = lu(k,1423) - lu(k,480) * lu(k,1391) + lu(k,1425) = lu(k,1425) - lu(k,481) * lu(k,1391) + lu(k,1429) = lu(k,1429) - lu(k,482) * lu(k,1391) + lu(k,1431) = lu(k,1431) - lu(k,483) * lu(k,1391) + lu(k,1449) = lu(k,1449) - lu(k,471) * lu(k,1434) + lu(k,1453) = - lu(k,472) * lu(k,1434) + lu(k,1454) = - lu(k,473) * lu(k,1434) + lu(k,1457) = - lu(k,474) * lu(k,1434) + lu(k,1458) = lu(k,1458) - lu(k,475) * lu(k,1434) + lu(k,1459) = - lu(k,476) * lu(k,1434) + lu(k,1460) = lu(k,1460) - lu(k,477) * lu(k,1434) + lu(k,1463) = - lu(k,478) * lu(k,1434) + lu(k,1465) = lu(k,1465) - lu(k,479) * lu(k,1434) + lu(k,1466) = - lu(k,480) * lu(k,1434) + lu(k,1468) = lu(k,1468) - lu(k,481) * lu(k,1434) + lu(k,1472) = lu(k,1472) - lu(k,482) * lu(k,1434) + lu(k,1474) = lu(k,1474) - lu(k,483) * lu(k,1434) + lu(k,1575) = lu(k,1575) - lu(k,471) * lu(k,1559) + lu(k,1579) = lu(k,1579) - lu(k,472) * lu(k,1559) + lu(k,1580) = - lu(k,473) * lu(k,1559) + lu(k,1583) = - lu(k,474) * lu(k,1559) + lu(k,1584) = lu(k,1584) - lu(k,475) * lu(k,1559) + lu(k,1585) = - lu(k,476) * lu(k,1559) + lu(k,1586) = lu(k,1586) - lu(k,477) * lu(k,1559) + lu(k,1589) = lu(k,1589) - lu(k,478) * lu(k,1559) + lu(k,1591) = - lu(k,479) * lu(k,1559) + lu(k,1592) = lu(k,1592) - lu(k,480) * lu(k,1559) + lu(k,1594) = lu(k,1594) - lu(k,481) * lu(k,1559) + lu(k,1598) = lu(k,1598) - lu(k,482) * lu(k,1559) + lu(k,1600) = lu(k,1600) - lu(k,483) * lu(k,1559) + lu(k,1666) = lu(k,1666) - lu(k,471) * lu(k,1651) + lu(k,1670) = - lu(k,472) * lu(k,1651) + lu(k,1671) = - lu(k,473) * lu(k,1651) + lu(k,1674) = - lu(k,474) * lu(k,1651) + lu(k,1675) = lu(k,1675) - lu(k,475) * lu(k,1651) + lu(k,1676) = lu(k,1676) - lu(k,476) * lu(k,1651) + lu(k,1677) = lu(k,1677) - lu(k,477) * lu(k,1651) + lu(k,1680) = - lu(k,478) * lu(k,1651) + lu(k,1682) = lu(k,1682) - lu(k,479) * lu(k,1651) + lu(k,1683) = lu(k,1683) - lu(k,480) * lu(k,1651) + lu(k,1685) = lu(k,1685) - lu(k,481) * lu(k,1651) + lu(k,1689) = lu(k,1689) - lu(k,482) * lu(k,1651) + lu(k,1691) = lu(k,1691) - lu(k,483) * lu(k,1651) + lu(k,1835) = lu(k,1835) - lu(k,471) * lu(k,1829) + lu(k,1839) = - lu(k,472) * lu(k,1829) + lu(k,1840) = - lu(k,473) * lu(k,1829) + lu(k,1843) = - lu(k,474) * lu(k,1829) + lu(k,1844) = lu(k,1844) - lu(k,475) * lu(k,1829) + lu(k,1845) = - lu(k,476) * lu(k,1829) + lu(k,1846) = - lu(k,477) * lu(k,1829) + lu(k,1849) = - lu(k,478) * lu(k,1829) + lu(k,1851) = - lu(k,479) * lu(k,1829) + lu(k,1852) = lu(k,1852) - lu(k,480) * lu(k,1829) + lu(k,1854) = lu(k,1854) - lu(k,481) * lu(k,1829) + lu(k,1858) = lu(k,1858) - lu(k,482) * lu(k,1829) + lu(k,1860) = lu(k,1860) - lu(k,483) * lu(k,1829) + lu(k,1954) = lu(k,1954) - lu(k,471) * lu(k,1947) + lu(k,1958) = lu(k,1958) - lu(k,472) * lu(k,1947) + lu(k,1959) = - lu(k,473) * lu(k,1947) + lu(k,1962) = lu(k,1962) - lu(k,474) * lu(k,1947) + lu(k,1963) = lu(k,1963) - lu(k,475) * lu(k,1947) + lu(k,1964) = - lu(k,476) * lu(k,1947) + lu(k,1965) = lu(k,1965) - lu(k,477) * lu(k,1947) + lu(k,1968) = lu(k,1968) - lu(k,478) * lu(k,1947) + lu(k,1970) = - lu(k,479) * lu(k,1947) + lu(k,1971) = lu(k,1971) - lu(k,480) * lu(k,1947) + lu(k,1973) = lu(k,1973) - lu(k,481) * lu(k,1947) + lu(k,1977) = lu(k,1977) - lu(k,482) * lu(k,1947) + lu(k,1979) = lu(k,1979) - lu(k,483) * lu(k,1947) end do end subroutine lu_fac12 subroutine lu_fac13( avec_len, lu ) @@ -3008,371 +2423,433 @@ subroutine lu_fac13( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,465) = 1._r8 / lu(k,465) - lu(k,466) = lu(k,466) * lu(k,465) - lu(k,467) = lu(k,467) * lu(k,465) - lu(k,468) = lu(k,468) * lu(k,465) - lu(k,469) = lu(k,469) * lu(k,465) - lu(k,470) = lu(k,470) * lu(k,465) - lu(k,471) = lu(k,471) * lu(k,465) - lu(k,472) = lu(k,472) * lu(k,465) - lu(k,473) = lu(k,473) * lu(k,465) - lu(k,474) = lu(k,474) * lu(k,465) - lu(k,475) = lu(k,475) * lu(k,465) - lu(k,476) = lu(k,476) * lu(k,465) - lu(k,477) = lu(k,477) * lu(k,465) - lu(k,478) = lu(k,478) * lu(k,465) - lu(k,479) = lu(k,479) * lu(k,465) - lu(k,480) = lu(k,480) * lu(k,465) - lu(k,710) = lu(k,710) - lu(k,466) * lu(k,709) - lu(k,715) = lu(k,715) - lu(k,467) * lu(k,709) - lu(k,716) = lu(k,716) - lu(k,468) * lu(k,709) - lu(k,718) = lu(k,718) - lu(k,469) * lu(k,709) - lu(k,719) = lu(k,719) - lu(k,470) * lu(k,709) - lu(k,720) = lu(k,720) - lu(k,471) * lu(k,709) - lu(k,721) = lu(k,721) - lu(k,472) * lu(k,709) - lu(k,723) = lu(k,723) - lu(k,473) * lu(k,709) - lu(k,724) = lu(k,724) - lu(k,474) * lu(k,709) - lu(k,725) = lu(k,725) - lu(k,475) * lu(k,709) - lu(k,728) = lu(k,728) - lu(k,476) * lu(k,709) - lu(k,730) = lu(k,730) - lu(k,477) * lu(k,709) - lu(k,731) = lu(k,731) - lu(k,478) * lu(k,709) - lu(k,732) = - lu(k,479) * lu(k,709) - lu(k,733) = lu(k,733) - lu(k,480) * lu(k,709) - lu(k,888) = lu(k,888) - lu(k,466) * lu(k,887) - lu(k,900) = lu(k,900) - lu(k,467) * lu(k,887) - lu(k,901) = lu(k,901) - lu(k,468) * lu(k,887) - lu(k,903) = lu(k,903) - lu(k,469) * lu(k,887) - lu(k,904) = lu(k,904) - lu(k,470) * lu(k,887) - lu(k,905) = lu(k,905) - lu(k,471) * lu(k,887) - lu(k,906) = lu(k,906) - lu(k,472) * lu(k,887) - lu(k,908) = lu(k,908) - lu(k,473) * lu(k,887) - lu(k,909) = lu(k,909) - lu(k,474) * lu(k,887) - lu(k,911) = lu(k,911) - lu(k,475) * lu(k,887) - lu(k,914) = lu(k,914) - lu(k,476) * lu(k,887) - lu(k,916) = lu(k,916) - lu(k,477) * lu(k,887) - lu(k,919) = lu(k,919) - lu(k,478) * lu(k,887) - lu(k,921) = lu(k,921) - lu(k,479) * lu(k,887) - lu(k,922) = lu(k,922) - lu(k,480) * lu(k,887) - lu(k,931) = lu(k,931) - lu(k,466) * lu(k,930) - lu(k,942) = lu(k,942) - lu(k,467) * lu(k,930) - lu(k,943) = lu(k,943) - lu(k,468) * lu(k,930) - lu(k,945) = lu(k,945) - lu(k,469) * lu(k,930) - lu(k,946) = lu(k,946) - lu(k,470) * lu(k,930) - lu(k,947) = lu(k,947) - lu(k,471) * lu(k,930) - lu(k,948) = lu(k,948) - lu(k,472) * lu(k,930) - lu(k,950) = lu(k,950) - lu(k,473) * lu(k,930) - lu(k,951) = lu(k,951) - lu(k,474) * lu(k,930) - lu(k,953) = lu(k,953) - lu(k,475) * lu(k,930) - lu(k,956) = lu(k,956) - lu(k,476) * lu(k,930) - lu(k,958) = lu(k,958) - lu(k,477) * lu(k,930) - lu(k,961) = lu(k,961) - lu(k,478) * lu(k,930) - lu(k,963) = lu(k,963) - lu(k,479) * lu(k,930) - lu(k,964) = lu(k,964) - lu(k,480) * lu(k,930) - lu(k,1019) = lu(k,1019) - lu(k,466) * lu(k,1018) - lu(k,1030) = lu(k,1030) - lu(k,467) * lu(k,1018) - lu(k,1031) = lu(k,1031) - lu(k,468) * lu(k,1018) - lu(k,1033) = lu(k,1033) - lu(k,469) * lu(k,1018) - lu(k,1034) = lu(k,1034) - lu(k,470) * lu(k,1018) - lu(k,1035) = lu(k,1035) - lu(k,471) * lu(k,1018) - lu(k,1036) = lu(k,1036) - lu(k,472) * lu(k,1018) - lu(k,1038) = lu(k,1038) - lu(k,473) * lu(k,1018) - lu(k,1039) = lu(k,1039) - lu(k,474) * lu(k,1018) - lu(k,1041) = lu(k,1041) - lu(k,475) * lu(k,1018) - lu(k,1044) = lu(k,1044) - lu(k,476) * lu(k,1018) - lu(k,1046) = lu(k,1046) - lu(k,477) * lu(k,1018) - lu(k,1049) = lu(k,1049) - lu(k,478) * lu(k,1018) - lu(k,1051) = lu(k,1051) - lu(k,479) * lu(k,1018) - lu(k,1052) = lu(k,1052) - lu(k,480) * lu(k,1018) - lu(k,1060) = lu(k,1060) - lu(k,466) * lu(k,1059) - lu(k,1071) = lu(k,1071) - lu(k,467) * lu(k,1059) - lu(k,1072) = lu(k,1072) - lu(k,468) * lu(k,1059) - lu(k,1074) = lu(k,1074) - lu(k,469) * lu(k,1059) - lu(k,1075) = lu(k,1075) - lu(k,470) * lu(k,1059) - lu(k,1076) = lu(k,1076) - lu(k,471) * lu(k,1059) - lu(k,1077) = lu(k,1077) - lu(k,472) * lu(k,1059) - lu(k,1079) = lu(k,1079) - lu(k,473) * lu(k,1059) - lu(k,1080) = lu(k,1080) - lu(k,474) * lu(k,1059) - lu(k,1082) = lu(k,1082) - lu(k,475) * lu(k,1059) - lu(k,1085) = lu(k,1085) - lu(k,476) * lu(k,1059) - lu(k,1087) = lu(k,1087) - lu(k,477) * lu(k,1059) - lu(k,1090) = lu(k,1090) - lu(k,478) * lu(k,1059) - lu(k,1092) = lu(k,1092) - lu(k,479) * lu(k,1059) - lu(k,1093) = lu(k,1093) - lu(k,480) * lu(k,1059) - lu(k,1143) = - lu(k,466) * lu(k,1142) - lu(k,1154) = lu(k,1154) - lu(k,467) * lu(k,1142) - lu(k,1155) = lu(k,1155) - lu(k,468) * lu(k,1142) - lu(k,1157) = lu(k,1157) - lu(k,469) * lu(k,1142) - lu(k,1158) = lu(k,1158) - lu(k,470) * lu(k,1142) - lu(k,1159) = lu(k,1159) - lu(k,471) * lu(k,1142) - lu(k,1160) = lu(k,1160) - lu(k,472) * lu(k,1142) - lu(k,1162) = lu(k,1162) - lu(k,473) * lu(k,1142) - lu(k,1163) = lu(k,1163) - lu(k,474) * lu(k,1142) - lu(k,1165) = lu(k,1165) - lu(k,475) * lu(k,1142) - lu(k,1168) = lu(k,1168) - lu(k,476) * lu(k,1142) - lu(k,1170) = lu(k,1170) - lu(k,477) * lu(k,1142) - lu(k,1173) = lu(k,1173) - lu(k,478) * lu(k,1142) - lu(k,1175) = lu(k,1175) - lu(k,479) * lu(k,1142) - lu(k,1176) = lu(k,1176) - lu(k,480) * lu(k,1142) - lu(k,1273) = lu(k,1273) - lu(k,466) * lu(k,1271) - lu(k,1283) = - lu(k,467) * lu(k,1271) - lu(k,1284) = - lu(k,468) * lu(k,1271) - lu(k,1286) = - lu(k,469) * lu(k,1271) - lu(k,1287) = - lu(k,470) * lu(k,1271) - lu(k,1288) = lu(k,1288) - lu(k,471) * lu(k,1271) - lu(k,1289) = lu(k,1289) - lu(k,472) * lu(k,1271) - lu(k,1291) = lu(k,1291) - lu(k,473) * lu(k,1271) - lu(k,1292) = lu(k,1292) - lu(k,474) * lu(k,1271) - lu(k,1294) = - lu(k,475) * lu(k,1271) - lu(k,1297) = lu(k,1297) - lu(k,476) * lu(k,1271) - lu(k,1299) = - lu(k,477) * lu(k,1271) - lu(k,1302) = - lu(k,478) * lu(k,1271) - lu(k,1304) = lu(k,1304) - lu(k,479) * lu(k,1271) - lu(k,1305) = lu(k,1305) - lu(k,480) * lu(k,1271) - lu(k,1350) = lu(k,1350) - lu(k,466) * lu(k,1349) - lu(k,1362) = lu(k,1362) - lu(k,467) * lu(k,1349) - lu(k,1363) = lu(k,1363) - lu(k,468) * lu(k,1349) - lu(k,1365) = lu(k,1365) - lu(k,469) * lu(k,1349) - lu(k,1366) = lu(k,1366) - lu(k,470) * lu(k,1349) - lu(k,1367) = lu(k,1367) - lu(k,471) * lu(k,1349) - lu(k,1368) = lu(k,1368) - lu(k,472) * lu(k,1349) - lu(k,1370) = lu(k,1370) - lu(k,473) * lu(k,1349) - lu(k,1371) = lu(k,1371) - lu(k,474) * lu(k,1349) - lu(k,1373) = lu(k,1373) - lu(k,475) * lu(k,1349) - lu(k,1376) = lu(k,1376) - lu(k,476) * lu(k,1349) - lu(k,1378) = lu(k,1378) - lu(k,477) * lu(k,1349) - lu(k,1381) = lu(k,1381) - lu(k,478) * lu(k,1349) - lu(k,1383) = lu(k,1383) - lu(k,479) * lu(k,1349) - lu(k,1384) = lu(k,1384) - lu(k,480) * lu(k,1349) - lu(k,1577) = lu(k,1577) - lu(k,466) * lu(k,1576) - lu(k,1588) = lu(k,1588) - lu(k,467) * lu(k,1576) - lu(k,1589) = lu(k,1589) - lu(k,468) * lu(k,1576) - lu(k,1591) = lu(k,1591) - lu(k,469) * lu(k,1576) - lu(k,1592) = lu(k,1592) - lu(k,470) * lu(k,1576) - lu(k,1593) = lu(k,1593) - lu(k,471) * lu(k,1576) - lu(k,1594) = lu(k,1594) - lu(k,472) * lu(k,1576) - lu(k,1596) = lu(k,1596) - lu(k,473) * lu(k,1576) - lu(k,1597) = lu(k,1597) - lu(k,474) * lu(k,1576) - lu(k,1599) = lu(k,1599) - lu(k,475) * lu(k,1576) - lu(k,1602) = lu(k,1602) - lu(k,476) * lu(k,1576) - lu(k,1604) = lu(k,1604) - lu(k,477) * lu(k,1576) - lu(k,1607) = lu(k,1607) - lu(k,478) * lu(k,1576) - lu(k,1609) = lu(k,1609) - lu(k,479) * lu(k,1576) - lu(k,1610) = lu(k,1610) - lu(k,480) * lu(k,1576) - lu(k,1686) = lu(k,1686) - lu(k,466) * lu(k,1685) - lu(k,1697) = lu(k,1697) - lu(k,467) * lu(k,1685) - lu(k,1698) = lu(k,1698) - lu(k,468) * lu(k,1685) - lu(k,1700) = lu(k,1700) - lu(k,469) * lu(k,1685) - lu(k,1701) = lu(k,1701) - lu(k,470) * lu(k,1685) - lu(k,1702) = lu(k,1702) - lu(k,471) * lu(k,1685) - lu(k,1703) = lu(k,1703) - lu(k,472) * lu(k,1685) - lu(k,1705) = lu(k,1705) - lu(k,473) * lu(k,1685) - lu(k,1706) = lu(k,1706) - lu(k,474) * lu(k,1685) - lu(k,1708) = lu(k,1708) - lu(k,475) * lu(k,1685) - lu(k,1711) = lu(k,1711) - lu(k,476) * lu(k,1685) - lu(k,1713) = lu(k,1713) - lu(k,477) * lu(k,1685) - lu(k,1716) = lu(k,1716) - lu(k,478) * lu(k,1685) - lu(k,1718) = lu(k,1718) - lu(k,479) * lu(k,1685) - lu(k,1719) = lu(k,1719) - lu(k,480) * lu(k,1685) - lu(k,484) = 1._r8 / lu(k,484) - lu(k,485) = lu(k,485) * lu(k,484) - lu(k,486) = lu(k,486) * lu(k,484) - lu(k,487) = lu(k,487) * lu(k,484) - lu(k,488) = lu(k,488) * lu(k,484) - lu(k,489) = lu(k,489) * lu(k,484) - lu(k,490) = lu(k,490) * lu(k,484) - lu(k,491) = lu(k,491) * lu(k,484) - lu(k,492) = lu(k,492) * lu(k,484) - lu(k,493) = lu(k,493) * lu(k,484) - lu(k,494) = lu(k,494) * lu(k,484) - lu(k,495) = lu(k,495) * lu(k,484) - lu(k,496) = lu(k,496) * lu(k,484) - lu(k,497) = lu(k,497) * lu(k,484) - lu(k,498) = lu(k,498) * lu(k,484) - lu(k,499) = lu(k,499) * lu(k,484) - lu(k,500) = lu(k,500) * lu(k,484) - lu(k,501) = lu(k,501) * lu(k,484) - lu(k,502) = lu(k,502) * lu(k,484) - lu(k,606) = lu(k,606) - lu(k,485) * lu(k,604) - lu(k,607) = lu(k,607) - lu(k,486) * lu(k,604) - lu(k,608) = lu(k,608) - lu(k,487) * lu(k,604) - lu(k,609) = lu(k,609) - lu(k,488) * lu(k,604) - lu(k,610) = - lu(k,489) * lu(k,604) - lu(k,611) = lu(k,611) - lu(k,490) * lu(k,604) - lu(k,612) = lu(k,612) - lu(k,491) * lu(k,604) - lu(k,614) = lu(k,614) - lu(k,492) * lu(k,604) - lu(k,615) = lu(k,615) - lu(k,493) * lu(k,604) - lu(k,616) = lu(k,616) - lu(k,494) * lu(k,604) - lu(k,617) = lu(k,617) - lu(k,495) * lu(k,604) - lu(k,618) = - lu(k,496) * lu(k,604) - lu(k,619) = - lu(k,497) * lu(k,604) - lu(k,620) = - lu(k,498) * lu(k,604) - lu(k,621) = - lu(k,499) * lu(k,604) - lu(k,622) = - lu(k,500) * lu(k,604) - lu(k,623) = lu(k,623) - lu(k,501) * lu(k,604) - lu(k,624) = lu(k,624) - lu(k,502) * lu(k,604) - lu(k,636) = lu(k,636) - lu(k,485) * lu(k,634) - lu(k,637) = lu(k,637) - lu(k,486) * lu(k,634) - lu(k,638) = lu(k,638) - lu(k,487) * lu(k,634) - lu(k,639) = lu(k,639) - lu(k,488) * lu(k,634) - lu(k,640) = lu(k,640) - lu(k,489) * lu(k,634) - lu(k,642) = lu(k,642) - lu(k,490) * lu(k,634) - lu(k,643) = lu(k,643) - lu(k,491) * lu(k,634) - lu(k,645) = lu(k,645) - lu(k,492) * lu(k,634) - lu(k,646) = lu(k,646) - lu(k,493) * lu(k,634) - lu(k,649) = lu(k,649) - lu(k,494) * lu(k,634) - lu(k,650) = lu(k,650) - lu(k,495) * lu(k,634) - lu(k,651) = lu(k,651) - lu(k,496) * lu(k,634) - lu(k,652) = lu(k,652) - lu(k,497) * lu(k,634) - lu(k,653) = - lu(k,498) * lu(k,634) - lu(k,654) = lu(k,654) - lu(k,499) * lu(k,634) - lu(k,655) = lu(k,655) - lu(k,500) * lu(k,634) - lu(k,656) = lu(k,656) - lu(k,501) * lu(k,634) - lu(k,657) = lu(k,657) - lu(k,502) * lu(k,634) - lu(k,745) = lu(k,745) - lu(k,485) * lu(k,743) - lu(k,746) = lu(k,746) - lu(k,486) * lu(k,743) - lu(k,747) = lu(k,747) - lu(k,487) * lu(k,743) - lu(k,748) = lu(k,748) - lu(k,488) * lu(k,743) - lu(k,749) = lu(k,749) - lu(k,489) * lu(k,743) - lu(k,752) = lu(k,752) - lu(k,490) * lu(k,743) - lu(k,753) = lu(k,753) - lu(k,491) * lu(k,743) - lu(k,755) = lu(k,755) - lu(k,492) * lu(k,743) - lu(k,756) = - lu(k,493) * lu(k,743) - lu(k,759) = lu(k,759) - lu(k,494) * lu(k,743) - lu(k,760) = lu(k,760) - lu(k,495) * lu(k,743) - lu(k,761) = lu(k,761) - lu(k,496) * lu(k,743) - lu(k,762) = lu(k,762) - lu(k,497) * lu(k,743) - lu(k,763) = - lu(k,498) * lu(k,743) - lu(k,764) = - lu(k,499) * lu(k,743) - lu(k,765) = lu(k,765) - lu(k,500) * lu(k,743) - lu(k,766) = lu(k,766) - lu(k,501) * lu(k,743) - lu(k,767) = lu(k,767) - lu(k,502) * lu(k,743) - lu(k,791) = lu(k,791) - lu(k,485) * lu(k,789) - lu(k,792) = lu(k,792) - lu(k,486) * lu(k,789) - lu(k,793) = lu(k,793) - lu(k,487) * lu(k,789) - lu(k,794) = lu(k,794) - lu(k,488) * lu(k,789) - lu(k,796) = lu(k,796) - lu(k,489) * lu(k,789) - lu(k,799) = lu(k,799) - lu(k,490) * lu(k,789) - lu(k,800) = lu(k,800) - lu(k,491) * lu(k,789) - lu(k,802) = lu(k,802) - lu(k,492) * lu(k,789) - lu(k,803) = lu(k,803) - lu(k,493) * lu(k,789) - lu(k,806) = lu(k,806) - lu(k,494) * lu(k,789) - lu(k,807) = lu(k,807) - lu(k,495) * lu(k,789) - lu(k,808) = lu(k,808) - lu(k,496) * lu(k,789) - lu(k,809) = lu(k,809) - lu(k,497) * lu(k,789) - lu(k,810) = - lu(k,498) * lu(k,789) - lu(k,811) = - lu(k,499) * lu(k,789) - lu(k,812) = lu(k,812) - lu(k,500) * lu(k,789) - lu(k,813) = lu(k,813) - lu(k,501) * lu(k,789) - lu(k,814) = lu(k,814) - lu(k,502) * lu(k,789) - lu(k,1275) = lu(k,1275) - lu(k,485) * lu(k,1272) - lu(k,1276) = - lu(k,486) * lu(k,1272) - lu(k,1279) = lu(k,1279) - lu(k,487) * lu(k,1272) - lu(k,1280) = lu(k,1280) - lu(k,488) * lu(k,1272) - lu(k,1285) = lu(k,1285) - lu(k,489) * lu(k,1272) - lu(k,1288) = lu(k,1288) - lu(k,490) * lu(k,1272) - lu(k,1289) = lu(k,1289) - lu(k,491) * lu(k,1272) - lu(k,1291) = lu(k,1291) - lu(k,492) * lu(k,1272) - lu(k,1292) = lu(k,1292) - lu(k,493) * lu(k,1272) - lu(k,1295) = - lu(k,494) * lu(k,1272) - lu(k,1296) = lu(k,1296) - lu(k,495) * lu(k,1272) - lu(k,1297) = lu(k,1297) - lu(k,496) * lu(k,1272) - lu(k,1298) = - lu(k,497) * lu(k,1272) - lu(k,1300) = - lu(k,498) * lu(k,1272) - lu(k,1301) = lu(k,1301) - lu(k,499) * lu(k,1272) - lu(k,1303) = lu(k,1303) - lu(k,500) * lu(k,1272) - lu(k,1304) = lu(k,1304) - lu(k,501) * lu(k,1272) - lu(k,1305) = lu(k,1305) - lu(k,502) * lu(k,1272) - lu(k,1412) = lu(k,1412) - lu(k,485) * lu(k,1410) - lu(k,1413) = lu(k,1413) - lu(k,486) * lu(k,1410) - lu(k,1417) = lu(k,1417) - lu(k,487) * lu(k,1410) - lu(k,1418) = lu(k,1418) - lu(k,488) * lu(k,1410) - lu(k,1423) = lu(k,1423) - lu(k,489) * lu(k,1410) - lu(k,1426) = lu(k,1426) - lu(k,490) * lu(k,1410) - lu(k,1427) = lu(k,1427) - lu(k,491) * lu(k,1410) - lu(k,1429) = lu(k,1429) - lu(k,492) * lu(k,1410) - lu(k,1430) = lu(k,1430) - lu(k,493) * lu(k,1410) - lu(k,1433) = lu(k,1433) - lu(k,494) * lu(k,1410) - lu(k,1434) = lu(k,1434) - lu(k,495) * lu(k,1410) - lu(k,1435) = lu(k,1435) - lu(k,496) * lu(k,1410) - lu(k,1436) = lu(k,1436) - lu(k,497) * lu(k,1410) - lu(k,1438) = lu(k,1438) - lu(k,498) * lu(k,1410) - lu(k,1439) = lu(k,1439) - lu(k,499) * lu(k,1410) - lu(k,1441) = lu(k,1441) - lu(k,500) * lu(k,1410) - lu(k,1442) = lu(k,1442) - lu(k,501) * lu(k,1410) - lu(k,1443) = lu(k,1443) - lu(k,502) * lu(k,1410) - lu(k,1454) = lu(k,1454) - lu(k,485) * lu(k,1452) - lu(k,1455) = lu(k,1455) - lu(k,486) * lu(k,1452) - lu(k,1459) = lu(k,1459) - lu(k,487) * lu(k,1452) - lu(k,1460) = lu(k,1460) - lu(k,488) * lu(k,1452) - lu(k,1465) = lu(k,1465) - lu(k,489) * lu(k,1452) - lu(k,1468) = lu(k,1468) - lu(k,490) * lu(k,1452) - lu(k,1469) = lu(k,1469) - lu(k,491) * lu(k,1452) - lu(k,1471) = lu(k,1471) - lu(k,492) * lu(k,1452) - lu(k,1472) = lu(k,1472) - lu(k,493) * lu(k,1452) - lu(k,1475) = lu(k,1475) - lu(k,494) * lu(k,1452) - lu(k,1476) = lu(k,1476) - lu(k,495) * lu(k,1452) - lu(k,1477) = lu(k,1477) - lu(k,496) * lu(k,1452) - lu(k,1478) = - lu(k,497) * lu(k,1452) - lu(k,1480) = lu(k,1480) - lu(k,498) * lu(k,1452) - lu(k,1481) = lu(k,1481) - lu(k,499) * lu(k,1452) - lu(k,1483) = lu(k,1483) - lu(k,500) * lu(k,1452) - lu(k,1484) = lu(k,1484) - lu(k,501) * lu(k,1452) - lu(k,1485) = lu(k,1485) - lu(k,502) * lu(k,1452) - lu(k,1647) = - lu(k,485) * lu(k,1646) - lu(k,1648) = - lu(k,486) * lu(k,1646) - lu(k,1651) = - lu(k,487) * lu(k,1646) - lu(k,1652) = lu(k,1652) - lu(k,488) * lu(k,1646) - lu(k,1657) = lu(k,1657) - lu(k,489) * lu(k,1646) - lu(k,1660) = - lu(k,490) * lu(k,1646) - lu(k,1661) = lu(k,1661) - lu(k,491) * lu(k,1646) - lu(k,1663) = lu(k,1663) - lu(k,492) * lu(k,1646) - lu(k,1664) = lu(k,1664) - lu(k,493) * lu(k,1646) - lu(k,1667) = lu(k,1667) - lu(k,494) * lu(k,1646) - lu(k,1668) = lu(k,1668) - lu(k,495) * lu(k,1646) - lu(k,1669) = lu(k,1669) - lu(k,496) * lu(k,1646) - lu(k,1670) = lu(k,1670) - lu(k,497) * lu(k,1646) - lu(k,1672) = lu(k,1672) - lu(k,498) * lu(k,1646) - lu(k,1673) = lu(k,1673) - lu(k,499) * lu(k,1646) - lu(k,1675) = lu(k,1675) - lu(k,500) * lu(k,1646) - lu(k,1676) = lu(k,1676) - lu(k,501) * lu(k,1646) - lu(k,1677) = lu(k,1677) - lu(k,502) * lu(k,1646) - lu(k,1767) = - lu(k,485) * lu(k,1766) - lu(k,1768) = - lu(k,486) * lu(k,1766) - lu(k,1772) = lu(k,1772) - lu(k,487) * lu(k,1766) - lu(k,1773) = lu(k,1773) - lu(k,488) * lu(k,1766) - lu(k,1778) = lu(k,1778) - lu(k,489) * lu(k,1766) - lu(k,1781) = - lu(k,490) * lu(k,1766) - lu(k,1782) = lu(k,1782) - lu(k,491) * lu(k,1766) - lu(k,1784) = lu(k,1784) - lu(k,492) * lu(k,1766) - lu(k,1785) = - lu(k,493) * lu(k,1766) - lu(k,1788) = lu(k,1788) - lu(k,494) * lu(k,1766) - lu(k,1789) = - lu(k,495) * lu(k,1766) - lu(k,1790) = lu(k,1790) - lu(k,496) * lu(k,1766) - lu(k,1791) = lu(k,1791) - lu(k,497) * lu(k,1766) - lu(k,1793) = lu(k,1793) - lu(k,498) * lu(k,1766) - lu(k,1794) = lu(k,1794) - lu(k,499) * lu(k,1766) - lu(k,1796) = - lu(k,500) * lu(k,1766) - lu(k,1797) = lu(k,1797) - lu(k,501) * lu(k,1766) - lu(k,1798) = lu(k,1798) - lu(k,502) * lu(k,1766) - lu(k,1826) = lu(k,1826) - lu(k,485) * lu(k,1821) - lu(k,1827) = lu(k,1827) - lu(k,486) * lu(k,1821) - lu(k,1830) = lu(k,1830) - lu(k,487) * lu(k,1821) - lu(k,1831) = lu(k,1831) - lu(k,488) * lu(k,1821) - lu(k,1836) = lu(k,1836) - lu(k,489) * lu(k,1821) - lu(k,1839) = lu(k,1839) - lu(k,490) * lu(k,1821) - lu(k,1840) = lu(k,1840) - lu(k,491) * lu(k,1821) - lu(k,1842) = lu(k,1842) - lu(k,492) * lu(k,1821) - lu(k,1843) = lu(k,1843) - lu(k,493) * lu(k,1821) - lu(k,1846) = lu(k,1846) - lu(k,494) * lu(k,1821) - lu(k,1847) = lu(k,1847) - lu(k,495) * lu(k,1821) - lu(k,1848) = lu(k,1848) - lu(k,496) * lu(k,1821) - lu(k,1849) = lu(k,1849) - lu(k,497) * lu(k,1821) - lu(k,1851) = lu(k,1851) - lu(k,498) * lu(k,1821) - lu(k,1852) = lu(k,1852) - lu(k,499) * lu(k,1821) - lu(k,1854) = lu(k,1854) - lu(k,500) * lu(k,1821) - lu(k,1855) = lu(k,1855) - lu(k,501) * lu(k,1821) - lu(k,1856) = lu(k,1856) - lu(k,502) * lu(k,1821) + lu(k,487) = 1._r8 / lu(k,487) + lu(k,488) = lu(k,488) * lu(k,487) + lu(k,489) = lu(k,489) * lu(k,487) + lu(k,490) = lu(k,490) * lu(k,487) + lu(k,491) = lu(k,491) * lu(k,487) + lu(k,492) = lu(k,492) * lu(k,487) + lu(k,493) = lu(k,493) * lu(k,487) + lu(k,494) = lu(k,494) * lu(k,487) + lu(k,495) = lu(k,495) * lu(k,487) + lu(k,496) = lu(k,496) * lu(k,487) + lu(k,497) = lu(k,497) * lu(k,487) + lu(k,498) = lu(k,498) * lu(k,487) + lu(k,499) = lu(k,499) * lu(k,487) + lu(k,500) = lu(k,500) * lu(k,487) + lu(k,711) = lu(k,711) - lu(k,488) * lu(k,710) + lu(k,712) = lu(k,712) - lu(k,489) * lu(k,710) + lu(k,715) = lu(k,715) - lu(k,490) * lu(k,710) + lu(k,716) = lu(k,716) - lu(k,491) * lu(k,710) + lu(k,719) = lu(k,719) - lu(k,492) * lu(k,710) + lu(k,720) = - lu(k,493) * lu(k,710) + lu(k,722) = lu(k,722) - lu(k,494) * lu(k,710) + lu(k,723) = lu(k,723) - lu(k,495) * lu(k,710) + lu(k,724) = lu(k,724) - lu(k,496) * lu(k,710) + lu(k,725) = lu(k,725) - lu(k,497) * lu(k,710) + lu(k,726) = - lu(k,498) * lu(k,710) + lu(k,728) = lu(k,728) - lu(k,499) * lu(k,710) + lu(k,729) = lu(k,729) - lu(k,500) * lu(k,710) + lu(k,975) = lu(k,975) - lu(k,488) * lu(k,974) + lu(k,977) = lu(k,977) - lu(k,489) * lu(k,974) + lu(k,980) = lu(k,980) - lu(k,490) * lu(k,974) + lu(k,981) = lu(k,981) - lu(k,491) * lu(k,974) + lu(k,986) = lu(k,986) - lu(k,492) * lu(k,974) + lu(k,988) = lu(k,988) - lu(k,493) * lu(k,974) + lu(k,993) = lu(k,993) - lu(k,494) * lu(k,974) + lu(k,994) = lu(k,994) - lu(k,495) * lu(k,974) + lu(k,995) = lu(k,995) - lu(k,496) * lu(k,974) + lu(k,996) = lu(k,996) - lu(k,497) * lu(k,974) + lu(k,999) = lu(k,999) - lu(k,498) * lu(k,974) + lu(k,1001) = lu(k,1001) - lu(k,499) * lu(k,974) + lu(k,1002) = lu(k,1002) - lu(k,500) * lu(k,974) + lu(k,1084) = - lu(k,488) * lu(k,1083) + lu(k,1088) = - lu(k,489) * lu(k,1083) + lu(k,1092) = lu(k,1092) - lu(k,490) * lu(k,1083) + lu(k,1094) = lu(k,1094) - lu(k,491) * lu(k,1083) + lu(k,1100) = lu(k,1100) - lu(k,492) * lu(k,1083) + lu(k,1102) = - lu(k,493) * lu(k,1083) + lu(k,1108) = lu(k,1108) - lu(k,494) * lu(k,1083) + lu(k,1110) = lu(k,1110) - lu(k,495) * lu(k,1083) + lu(k,1111) = - lu(k,496) * lu(k,1083) + lu(k,1112) = lu(k,1112) - lu(k,497) * lu(k,1083) + lu(k,1115) = - lu(k,498) * lu(k,1083) + lu(k,1117) = - lu(k,499) * lu(k,1083) + lu(k,1118) = lu(k,1118) - lu(k,500) * lu(k,1083) + lu(k,1274) = lu(k,1274) - lu(k,488) * lu(k,1273) + lu(k,1277) = lu(k,1277) - lu(k,489) * lu(k,1273) + lu(k,1283) = lu(k,1283) - lu(k,490) * lu(k,1273) + lu(k,1285) = lu(k,1285) - lu(k,491) * lu(k,1273) + lu(k,1292) = lu(k,1292) - lu(k,492) * lu(k,1273) + lu(k,1294) = lu(k,1294) - lu(k,493) * lu(k,1273) + lu(k,1300) = lu(k,1300) - lu(k,494) * lu(k,1273) + lu(k,1302) = lu(k,1302) - lu(k,495) * lu(k,1273) + lu(k,1303) = lu(k,1303) - lu(k,496) * lu(k,1273) + lu(k,1304) = lu(k,1304) - lu(k,497) * lu(k,1273) + lu(k,1307) = lu(k,1307) - lu(k,498) * lu(k,1273) + lu(k,1309) = lu(k,1309) - lu(k,499) * lu(k,1273) + lu(k,1310) = lu(k,1310) - lu(k,500) * lu(k,1273) + lu(k,1610) = lu(k,1610) - lu(k,488) * lu(k,1609) + lu(k,1616) = lu(k,1616) - lu(k,489) * lu(k,1609) + lu(k,1621) = lu(k,1621) - lu(k,490) * lu(k,1609) + lu(k,1623) = lu(k,1623) - lu(k,491) * lu(k,1609) + lu(k,1630) = lu(k,1630) - lu(k,492) * lu(k,1609) + lu(k,1632) = lu(k,1632) - lu(k,493) * lu(k,1609) + lu(k,1638) = lu(k,1638) - lu(k,494) * lu(k,1609) + lu(k,1640) = lu(k,1640) - lu(k,495) * lu(k,1609) + lu(k,1641) = lu(k,1641) - lu(k,496) * lu(k,1609) + lu(k,1642) = lu(k,1642) - lu(k,497) * lu(k,1609) + lu(k,1645) = lu(k,1645) - lu(k,498) * lu(k,1609) + lu(k,1647) = lu(k,1647) - lu(k,499) * lu(k,1609) + lu(k,1648) = lu(k,1648) - lu(k,500) * lu(k,1609) + lu(k,1744) = lu(k,1744) - lu(k,488) * lu(k,1743) + lu(k,1745) = lu(k,1745) - lu(k,489) * lu(k,1743) + lu(k,1751) = lu(k,1751) - lu(k,490) * lu(k,1743) + lu(k,1753) = lu(k,1753) - lu(k,491) * lu(k,1743) + lu(k,1760) = lu(k,1760) - lu(k,492) * lu(k,1743) + lu(k,1762) = lu(k,1762) - lu(k,493) * lu(k,1743) + lu(k,1768) = lu(k,1768) - lu(k,494) * lu(k,1743) + lu(k,1770) = lu(k,1770) - lu(k,495) * lu(k,1743) + lu(k,1771) = lu(k,1771) - lu(k,496) * lu(k,1743) + lu(k,1772) = lu(k,1772) - lu(k,497) * lu(k,1743) + lu(k,1775) = - lu(k,498) * lu(k,1743) + lu(k,1777) = lu(k,1777) - lu(k,499) * lu(k,1743) + lu(k,1778) = lu(k,1778) - lu(k,500) * lu(k,1743) + lu(k,1793) = - lu(k,488) * lu(k,1792) + lu(k,1795) = - lu(k,489) * lu(k,1792) + lu(k,1800) = lu(k,1800) - lu(k,490) * lu(k,1792) + lu(k,1802) = lu(k,1802) - lu(k,491) * lu(k,1792) + lu(k,1809) = lu(k,1809) - lu(k,492) * lu(k,1792) + lu(k,1811) = lu(k,1811) - lu(k,493) * lu(k,1792) + lu(k,1817) = lu(k,1817) - lu(k,494) * lu(k,1792) + lu(k,1819) = lu(k,1819) - lu(k,495) * lu(k,1792) + lu(k,1820) = - lu(k,496) * lu(k,1792) + lu(k,1821) = lu(k,1821) - lu(k,497) * lu(k,1792) + lu(k,1824) = lu(k,1824) - lu(k,498) * lu(k,1792) + lu(k,1826) = - lu(k,499) * lu(k,1792) + lu(k,1827) = lu(k,1827) - lu(k,500) * lu(k,1792) + lu(k,1903) = lu(k,1903) - lu(k,488) * lu(k,1902) + lu(k,1905) = lu(k,1905) - lu(k,489) * lu(k,1902) + lu(k,1910) = lu(k,1910) - lu(k,490) * lu(k,1902) + lu(k,1912) = lu(k,1912) - lu(k,491) * lu(k,1902) + lu(k,1919) = lu(k,1919) - lu(k,492) * lu(k,1902) + lu(k,1921) = lu(k,1921) - lu(k,493) * lu(k,1902) + lu(k,1927) = lu(k,1927) - lu(k,494) * lu(k,1902) + lu(k,1929) = lu(k,1929) - lu(k,495) * lu(k,1902) + lu(k,1930) = lu(k,1930) - lu(k,496) * lu(k,1902) + lu(k,1931) = lu(k,1931) - lu(k,497) * lu(k,1902) + lu(k,1934) = lu(k,1934) - lu(k,498) * lu(k,1902) + lu(k,1936) = lu(k,1936) - lu(k,499) * lu(k,1902) + lu(k,1937) = lu(k,1937) - lu(k,500) * lu(k,1902) + lu(k,2050) = - lu(k,488) * lu(k,2046) + lu(k,2055) = - lu(k,489) * lu(k,2046) + lu(k,2060) = lu(k,2060) - lu(k,490) * lu(k,2046) + lu(k,2062) = lu(k,2062) - lu(k,491) * lu(k,2046) + lu(k,2069) = lu(k,2069) - lu(k,492) * lu(k,2046) + lu(k,2071) = lu(k,2071) - lu(k,493) * lu(k,2046) + lu(k,2077) = lu(k,2077) - lu(k,494) * lu(k,2046) + lu(k,2079) = lu(k,2079) - lu(k,495) * lu(k,2046) + lu(k,2080) = lu(k,2080) - lu(k,496) * lu(k,2046) + lu(k,2081) = lu(k,2081) - lu(k,497) * lu(k,2046) + lu(k,2084) = lu(k,2084) - lu(k,498) * lu(k,2046) + lu(k,2086) = lu(k,2086) - lu(k,499) * lu(k,2046) + lu(k,2087) = lu(k,2087) - lu(k,500) * lu(k,2046) + lu(k,501) = 1._r8 / lu(k,501) + lu(k,502) = lu(k,502) * lu(k,501) + lu(k,503) = lu(k,503) * lu(k,501) + lu(k,504) = lu(k,504) * lu(k,501) + lu(k,505) = lu(k,505) * lu(k,501) + lu(k,506) = lu(k,506) * lu(k,501) + lu(k,507) = lu(k,507) * lu(k,501) + lu(k,508) = lu(k,508) * lu(k,501) + lu(k,509) = lu(k,509) * lu(k,501) + lu(k,510) = lu(k,510) * lu(k,501) + lu(k,511) = lu(k,511) * lu(k,501) + lu(k,512) = lu(k,512) * lu(k,501) + lu(k,513) = lu(k,513) * lu(k,501) + lu(k,514) = lu(k,514) * lu(k,501) + lu(k,515) = lu(k,515) * lu(k,501) + lu(k,666) = lu(k,666) - lu(k,502) * lu(k,664) + lu(k,671) = lu(k,671) - lu(k,503) * lu(k,664) + lu(k,672) = lu(k,672) - lu(k,504) * lu(k,664) + lu(k,673) = lu(k,673) - lu(k,505) * lu(k,664) + lu(k,674) = lu(k,674) - lu(k,506) * lu(k,664) + lu(k,675) = lu(k,675) - lu(k,507) * lu(k,664) + lu(k,676) = lu(k,676) - lu(k,508) * lu(k,664) + lu(k,677) = lu(k,677) - lu(k,509) * lu(k,664) + lu(k,678) = lu(k,678) - lu(k,510) * lu(k,664) + lu(k,680) = lu(k,680) - lu(k,511) * lu(k,664) + lu(k,681) = lu(k,681) - lu(k,512) * lu(k,664) + lu(k,682) = lu(k,682) - lu(k,513) * lu(k,664) + lu(k,683) = lu(k,683) - lu(k,514) * lu(k,664) + lu(k,684) = lu(k,684) - lu(k,515) * lu(k,664) + lu(k,1133) = lu(k,1133) - lu(k,502) * lu(k,1126) + lu(k,1145) = lu(k,1145) - lu(k,503) * lu(k,1126) + lu(k,1146) = lu(k,1146) - lu(k,504) * lu(k,1126) + lu(k,1148) = lu(k,1148) - lu(k,505) * lu(k,1126) + lu(k,1149) = lu(k,1149) - lu(k,506) * lu(k,1126) + lu(k,1150) = lu(k,1150) - lu(k,507) * lu(k,1126) + lu(k,1151) = lu(k,1151) - lu(k,508) * lu(k,1126) + lu(k,1152) = lu(k,1152) - lu(k,509) * lu(k,1126) + lu(k,1155) = lu(k,1155) - lu(k,510) * lu(k,1126) + lu(k,1157) = lu(k,1157) - lu(k,511) * lu(k,1126) + lu(k,1158) = lu(k,1158) - lu(k,512) * lu(k,1126) + lu(k,1160) = lu(k,1160) - lu(k,513) * lu(k,1126) + lu(k,1164) = lu(k,1164) - lu(k,514) * lu(k,1126) + lu(k,1166) = lu(k,1166) - lu(k,515) * lu(k,1126) + lu(k,1177) = lu(k,1177) - lu(k,502) * lu(k,1170) + lu(k,1188) = lu(k,1188) - lu(k,503) * lu(k,1170) + lu(k,1189) = lu(k,1189) - lu(k,504) * lu(k,1170) + lu(k,1191) = lu(k,1191) - lu(k,505) * lu(k,1170) + lu(k,1192) = lu(k,1192) - lu(k,506) * lu(k,1170) + lu(k,1193) = lu(k,1193) - lu(k,507) * lu(k,1170) + lu(k,1194) = lu(k,1194) - lu(k,508) * lu(k,1170) + lu(k,1195) = lu(k,1195) - lu(k,509) * lu(k,1170) + lu(k,1198) = lu(k,1198) - lu(k,510) * lu(k,1170) + lu(k,1200) = lu(k,1200) - lu(k,511) * lu(k,1170) + lu(k,1201) = lu(k,1201) - lu(k,512) * lu(k,1170) + lu(k,1203) = lu(k,1203) - lu(k,513) * lu(k,1170) + lu(k,1207) = lu(k,1207) - lu(k,514) * lu(k,1170) + lu(k,1209) = lu(k,1209) - lu(k,515) * lu(k,1170) + lu(k,1320) = lu(k,1320) - lu(k,502) * lu(k,1313) + lu(k,1331) = lu(k,1331) - lu(k,503) * lu(k,1313) + lu(k,1332) = lu(k,1332) - lu(k,504) * lu(k,1313) + lu(k,1334) = lu(k,1334) - lu(k,505) * lu(k,1313) + lu(k,1335) = lu(k,1335) - lu(k,506) * lu(k,1313) + lu(k,1336) = lu(k,1336) - lu(k,507) * lu(k,1313) + lu(k,1337) = lu(k,1337) - lu(k,508) * lu(k,1313) + lu(k,1338) = lu(k,1338) - lu(k,509) * lu(k,1313) + lu(k,1341) = lu(k,1341) - lu(k,510) * lu(k,1313) + lu(k,1343) = lu(k,1343) - lu(k,511) * lu(k,1313) + lu(k,1344) = lu(k,1344) - lu(k,512) * lu(k,1313) + lu(k,1346) = lu(k,1346) - lu(k,513) * lu(k,1313) + lu(k,1350) = lu(k,1350) - lu(k,514) * lu(k,1313) + lu(k,1352) = lu(k,1352) - lu(k,515) * lu(k,1313) + lu(k,1399) = lu(k,1399) - lu(k,502) * lu(k,1392) + lu(k,1410) = lu(k,1410) - lu(k,503) * lu(k,1392) + lu(k,1411) = lu(k,1411) - lu(k,504) * lu(k,1392) + lu(k,1413) = lu(k,1413) - lu(k,505) * lu(k,1392) + lu(k,1414) = lu(k,1414) - lu(k,506) * lu(k,1392) + lu(k,1415) = lu(k,1415) - lu(k,507) * lu(k,1392) + lu(k,1416) = lu(k,1416) - lu(k,508) * lu(k,1392) + lu(k,1417) = lu(k,1417) - lu(k,509) * lu(k,1392) + lu(k,1420) = lu(k,1420) - lu(k,510) * lu(k,1392) + lu(k,1422) = lu(k,1422) - lu(k,511) * lu(k,1392) + lu(k,1423) = lu(k,1423) - lu(k,512) * lu(k,1392) + lu(k,1425) = lu(k,1425) - lu(k,513) * lu(k,1392) + lu(k,1429) = lu(k,1429) - lu(k,514) * lu(k,1392) + lu(k,1431) = lu(k,1431) - lu(k,515) * lu(k,1392) + lu(k,1442) = lu(k,1442) - lu(k,502) * lu(k,1435) + lu(k,1453) = lu(k,1453) - lu(k,503) * lu(k,1435) + lu(k,1454) = lu(k,1454) - lu(k,504) * lu(k,1435) + lu(k,1456) = lu(k,1456) - lu(k,505) * lu(k,1435) + lu(k,1457) = lu(k,1457) - lu(k,506) * lu(k,1435) + lu(k,1458) = lu(k,1458) - lu(k,507) * lu(k,1435) + lu(k,1459) = lu(k,1459) - lu(k,508) * lu(k,1435) + lu(k,1460) = lu(k,1460) - lu(k,509) * lu(k,1435) + lu(k,1463) = lu(k,1463) - lu(k,510) * lu(k,1435) + lu(k,1465) = lu(k,1465) - lu(k,511) * lu(k,1435) + lu(k,1466) = lu(k,1466) - lu(k,512) * lu(k,1435) + lu(k,1468) = lu(k,1468) - lu(k,513) * lu(k,1435) + lu(k,1472) = lu(k,1472) - lu(k,514) * lu(k,1435) + lu(k,1474) = lu(k,1474) - lu(k,515) * lu(k,1435) + lu(k,1567) = lu(k,1567) - lu(k,502) * lu(k,1560) + lu(k,1579) = lu(k,1579) - lu(k,503) * lu(k,1560) + lu(k,1580) = lu(k,1580) - lu(k,504) * lu(k,1560) + lu(k,1582) = lu(k,1582) - lu(k,505) * lu(k,1560) + lu(k,1583) = lu(k,1583) - lu(k,506) * lu(k,1560) + lu(k,1584) = lu(k,1584) - lu(k,507) * lu(k,1560) + lu(k,1585) = lu(k,1585) - lu(k,508) * lu(k,1560) + lu(k,1586) = lu(k,1586) - lu(k,509) * lu(k,1560) + lu(k,1589) = lu(k,1589) - lu(k,510) * lu(k,1560) + lu(k,1591) = lu(k,1591) - lu(k,511) * lu(k,1560) + lu(k,1592) = lu(k,1592) - lu(k,512) * lu(k,1560) + lu(k,1594) = lu(k,1594) - lu(k,513) * lu(k,1560) + lu(k,1598) = lu(k,1598) - lu(k,514) * lu(k,1560) + lu(k,1600) = lu(k,1600) - lu(k,515) * lu(k,1560) + lu(k,1659) = lu(k,1659) - lu(k,502) * lu(k,1652) + lu(k,1670) = lu(k,1670) - lu(k,503) * lu(k,1652) + lu(k,1671) = lu(k,1671) - lu(k,504) * lu(k,1652) + lu(k,1673) = lu(k,1673) - lu(k,505) * lu(k,1652) + lu(k,1674) = lu(k,1674) - lu(k,506) * lu(k,1652) + lu(k,1675) = lu(k,1675) - lu(k,507) * lu(k,1652) + lu(k,1676) = lu(k,1676) - lu(k,508) * lu(k,1652) + lu(k,1677) = lu(k,1677) - lu(k,509) * lu(k,1652) + lu(k,1680) = lu(k,1680) - lu(k,510) * lu(k,1652) + lu(k,1682) = lu(k,1682) - lu(k,511) * lu(k,1652) + lu(k,1683) = lu(k,1683) - lu(k,512) * lu(k,1652) + lu(k,1685) = lu(k,1685) - lu(k,513) * lu(k,1652) + lu(k,1689) = lu(k,1689) - lu(k,514) * lu(k,1652) + lu(k,1691) = lu(k,1691) - lu(k,515) * lu(k,1652) + lu(k,2053) = lu(k,2053) - lu(k,502) * lu(k,2047) + lu(k,2066) = lu(k,2066) - lu(k,503) * lu(k,2047) + lu(k,2067) = lu(k,2067) - lu(k,504) * lu(k,2047) + lu(k,2069) = lu(k,2069) - lu(k,505) * lu(k,2047) + lu(k,2070) = lu(k,2070) - lu(k,506) * lu(k,2047) + lu(k,2071) = lu(k,2071) - lu(k,507) * lu(k,2047) + lu(k,2072) = lu(k,2072) - lu(k,508) * lu(k,2047) + lu(k,2073) = lu(k,2073) - lu(k,509) * lu(k,2047) + lu(k,2076) = lu(k,2076) - lu(k,510) * lu(k,2047) + lu(k,2078) = lu(k,2078) - lu(k,511) * lu(k,2047) + lu(k,2079) = lu(k,2079) - lu(k,512) * lu(k,2047) + lu(k,2081) = lu(k,2081) - lu(k,513) * lu(k,2047) + lu(k,2085) = lu(k,2085) - lu(k,514) * lu(k,2047) + lu(k,2087) = lu(k,2087) - lu(k,515) * lu(k,2047) + lu(k,516) = 1._r8 / lu(k,516) + lu(k,517) = lu(k,517) * lu(k,516) + lu(k,518) = lu(k,518) * lu(k,516) + lu(k,519) = lu(k,519) * lu(k,516) + lu(k,520) = lu(k,520) * lu(k,516) + lu(k,521) = lu(k,521) * lu(k,516) + lu(k,522) = lu(k,522) * lu(k,516) + lu(k,523) = lu(k,523) * lu(k,516) + lu(k,524) = lu(k,524) * lu(k,516) + lu(k,525) = lu(k,525) * lu(k,516) + lu(k,526) = lu(k,526) * lu(k,516) + lu(k,527) = lu(k,527) * lu(k,516) + lu(k,528) = lu(k,528) * lu(k,516) + lu(k,529) = lu(k,529) * lu(k,516) + lu(k,530) = lu(k,530) * lu(k,516) + lu(k,533) = lu(k,533) - lu(k,517) * lu(k,531) + lu(k,534) = lu(k,534) - lu(k,518) * lu(k,531) + lu(k,535) = lu(k,535) - lu(k,519) * lu(k,531) + lu(k,536) = lu(k,536) - lu(k,520) * lu(k,531) + lu(k,537) = lu(k,537) - lu(k,521) * lu(k,531) + lu(k,538) = lu(k,538) - lu(k,522) * lu(k,531) + lu(k,539) = lu(k,539) - lu(k,523) * lu(k,531) + lu(k,540) = lu(k,540) - lu(k,524) * lu(k,531) + lu(k,541) = lu(k,541) - lu(k,525) * lu(k,531) + lu(k,542) = lu(k,542) - lu(k,526) * lu(k,531) + lu(k,543) = lu(k,543) - lu(k,527) * lu(k,531) + lu(k,544) = lu(k,544) - lu(k,528) * lu(k,531) + lu(k,545) = lu(k,545) - lu(k,529) * lu(k,531) + lu(k,546) = lu(k,546) - lu(k,530) * lu(k,531) + lu(k,808) = lu(k,808) - lu(k,517) * lu(k,806) + lu(k,812) = lu(k,812) - lu(k,518) * lu(k,806) + lu(k,813) = lu(k,813) - lu(k,519) * lu(k,806) + lu(k,815) = lu(k,815) - lu(k,520) * lu(k,806) + lu(k,816) = lu(k,816) - lu(k,521) * lu(k,806) + lu(k,817) = lu(k,817) - lu(k,522) * lu(k,806) + lu(k,818) = lu(k,818) - lu(k,523) * lu(k,806) + lu(k,819) = lu(k,819) - lu(k,524) * lu(k,806) + lu(k,820) = lu(k,820) - lu(k,525) * lu(k,806) + lu(k,822) = lu(k,822) - lu(k,526) * lu(k,806) + lu(k,823) = lu(k,823) - lu(k,527) * lu(k,806) + lu(k,824) = lu(k,824) - lu(k,528) * lu(k,806) + lu(k,825) = lu(k,825) - lu(k,529) * lu(k,806) + lu(k,826) = lu(k,826) - lu(k,530) * lu(k,806) + lu(k,1136) = lu(k,1136) - lu(k,517) * lu(k,1127) + lu(k,1145) = lu(k,1145) - lu(k,518) * lu(k,1127) + lu(k,1146) = lu(k,1146) - lu(k,519) * lu(k,1127) + lu(k,1149) = lu(k,1149) - lu(k,520) * lu(k,1127) + lu(k,1150) = lu(k,1150) - lu(k,521) * lu(k,1127) + lu(k,1151) = lu(k,1151) - lu(k,522) * lu(k,1127) + lu(k,1152) = lu(k,1152) - lu(k,523) * lu(k,1127) + lu(k,1153) = lu(k,1153) - lu(k,524) * lu(k,1127) + lu(k,1155) = lu(k,1155) - lu(k,525) * lu(k,1127) + lu(k,1157) = lu(k,1157) - lu(k,526) * lu(k,1127) + lu(k,1158) = lu(k,1158) - lu(k,527) * lu(k,1127) + lu(k,1160) = lu(k,1160) - lu(k,528) * lu(k,1127) + lu(k,1165) = lu(k,1165) - lu(k,529) * lu(k,1127) + lu(k,1166) = lu(k,1166) - lu(k,530) * lu(k,1127) + lu(k,1179) = lu(k,1179) - lu(k,517) * lu(k,1171) + lu(k,1188) = lu(k,1188) - lu(k,518) * lu(k,1171) + lu(k,1189) = lu(k,1189) - lu(k,519) * lu(k,1171) + lu(k,1192) = lu(k,1192) - lu(k,520) * lu(k,1171) + lu(k,1193) = lu(k,1193) - lu(k,521) * lu(k,1171) + lu(k,1194) = lu(k,1194) - lu(k,522) * lu(k,1171) + lu(k,1195) = lu(k,1195) - lu(k,523) * lu(k,1171) + lu(k,1196) = lu(k,1196) - lu(k,524) * lu(k,1171) + lu(k,1198) = lu(k,1198) - lu(k,525) * lu(k,1171) + lu(k,1200) = lu(k,1200) - lu(k,526) * lu(k,1171) + lu(k,1201) = lu(k,1201) - lu(k,527) * lu(k,1171) + lu(k,1203) = lu(k,1203) - lu(k,528) * lu(k,1171) + lu(k,1208) = lu(k,1208) - lu(k,529) * lu(k,1171) + lu(k,1209) = lu(k,1209) - lu(k,530) * lu(k,1171) + lu(k,1322) = lu(k,1322) - lu(k,517) * lu(k,1314) + lu(k,1331) = lu(k,1331) - lu(k,518) * lu(k,1314) + lu(k,1332) = lu(k,1332) - lu(k,519) * lu(k,1314) + lu(k,1335) = lu(k,1335) - lu(k,520) * lu(k,1314) + lu(k,1336) = lu(k,1336) - lu(k,521) * lu(k,1314) + lu(k,1337) = lu(k,1337) - lu(k,522) * lu(k,1314) + lu(k,1338) = lu(k,1338) - lu(k,523) * lu(k,1314) + lu(k,1339) = lu(k,1339) - lu(k,524) * lu(k,1314) + lu(k,1341) = lu(k,1341) - lu(k,525) * lu(k,1314) + lu(k,1343) = lu(k,1343) - lu(k,526) * lu(k,1314) + lu(k,1344) = lu(k,1344) - lu(k,527) * lu(k,1314) + lu(k,1346) = lu(k,1346) - lu(k,528) * lu(k,1314) + lu(k,1351) = lu(k,1351) - lu(k,529) * lu(k,1314) + lu(k,1352) = lu(k,1352) - lu(k,530) * lu(k,1314) + lu(k,1401) = lu(k,1401) - lu(k,517) * lu(k,1393) + lu(k,1410) = lu(k,1410) - lu(k,518) * lu(k,1393) + lu(k,1411) = lu(k,1411) - lu(k,519) * lu(k,1393) + lu(k,1414) = lu(k,1414) - lu(k,520) * lu(k,1393) + lu(k,1415) = lu(k,1415) - lu(k,521) * lu(k,1393) + lu(k,1416) = lu(k,1416) - lu(k,522) * lu(k,1393) + lu(k,1417) = lu(k,1417) - lu(k,523) * lu(k,1393) + lu(k,1418) = lu(k,1418) - lu(k,524) * lu(k,1393) + lu(k,1420) = lu(k,1420) - lu(k,525) * lu(k,1393) + lu(k,1422) = lu(k,1422) - lu(k,526) * lu(k,1393) + lu(k,1423) = lu(k,1423) - lu(k,527) * lu(k,1393) + lu(k,1425) = lu(k,1425) - lu(k,528) * lu(k,1393) + lu(k,1430) = lu(k,1430) - lu(k,529) * lu(k,1393) + lu(k,1431) = lu(k,1431) - lu(k,530) * lu(k,1393) + lu(k,1444) = lu(k,1444) - lu(k,517) * lu(k,1436) + lu(k,1453) = lu(k,1453) - lu(k,518) * lu(k,1436) + lu(k,1454) = lu(k,1454) - lu(k,519) * lu(k,1436) + lu(k,1457) = lu(k,1457) - lu(k,520) * lu(k,1436) + lu(k,1458) = lu(k,1458) - lu(k,521) * lu(k,1436) + lu(k,1459) = lu(k,1459) - lu(k,522) * lu(k,1436) + lu(k,1460) = lu(k,1460) - lu(k,523) * lu(k,1436) + lu(k,1461) = lu(k,1461) - lu(k,524) * lu(k,1436) + lu(k,1463) = lu(k,1463) - lu(k,525) * lu(k,1436) + lu(k,1465) = lu(k,1465) - lu(k,526) * lu(k,1436) + lu(k,1466) = lu(k,1466) - lu(k,527) * lu(k,1436) + lu(k,1468) = lu(k,1468) - lu(k,528) * lu(k,1436) + lu(k,1473) = lu(k,1473) - lu(k,529) * lu(k,1436) + lu(k,1474) = lu(k,1474) - lu(k,530) * lu(k,1436) + lu(k,1489) = lu(k,1489) - lu(k,517) * lu(k,1481) + lu(k,1498) = - lu(k,518) * lu(k,1481) + lu(k,1499) = - lu(k,519) * lu(k,1481) + lu(k,1502) = - lu(k,520) * lu(k,1481) + lu(k,1503) = lu(k,1503) - lu(k,521) * lu(k,1481) + lu(k,1504) = - lu(k,522) * lu(k,1481) + lu(k,1505) = - lu(k,523) * lu(k,1481) + lu(k,1506) = lu(k,1506) - lu(k,524) * lu(k,1481) + lu(k,1508) = - lu(k,525) * lu(k,1481) + lu(k,1510) = - lu(k,526) * lu(k,1481) + lu(k,1511) = lu(k,1511) - lu(k,527) * lu(k,1481) + lu(k,1513) = - lu(k,528) * lu(k,1481) + lu(k,1518) = lu(k,1518) - lu(k,529) * lu(k,1481) + lu(k,1519) = lu(k,1519) - lu(k,530) * lu(k,1481) + lu(k,1570) = lu(k,1570) - lu(k,517) * lu(k,1561) + lu(k,1579) = lu(k,1579) - lu(k,518) * lu(k,1561) + lu(k,1580) = lu(k,1580) - lu(k,519) * lu(k,1561) + lu(k,1583) = lu(k,1583) - lu(k,520) * lu(k,1561) + lu(k,1584) = lu(k,1584) - lu(k,521) * lu(k,1561) + lu(k,1585) = lu(k,1585) - lu(k,522) * lu(k,1561) + lu(k,1586) = lu(k,1586) - lu(k,523) * lu(k,1561) + lu(k,1587) = lu(k,1587) - lu(k,524) * lu(k,1561) + lu(k,1589) = lu(k,1589) - lu(k,525) * lu(k,1561) + lu(k,1591) = lu(k,1591) - lu(k,526) * lu(k,1561) + lu(k,1592) = lu(k,1592) - lu(k,527) * lu(k,1561) + lu(k,1594) = lu(k,1594) - lu(k,528) * lu(k,1561) + lu(k,1599) = lu(k,1599) - lu(k,529) * lu(k,1561) + lu(k,1600) = lu(k,1600) - lu(k,530) * lu(k,1561) + lu(k,1661) = lu(k,1661) - lu(k,517) * lu(k,1653) + lu(k,1670) = lu(k,1670) - lu(k,518) * lu(k,1653) + lu(k,1671) = lu(k,1671) - lu(k,519) * lu(k,1653) + lu(k,1674) = lu(k,1674) - lu(k,520) * lu(k,1653) + lu(k,1675) = lu(k,1675) - lu(k,521) * lu(k,1653) + lu(k,1676) = lu(k,1676) - lu(k,522) * lu(k,1653) + lu(k,1677) = lu(k,1677) - lu(k,523) * lu(k,1653) + lu(k,1678) = lu(k,1678) - lu(k,524) * lu(k,1653) + lu(k,1680) = lu(k,1680) - lu(k,525) * lu(k,1653) + lu(k,1682) = lu(k,1682) - lu(k,526) * lu(k,1653) + lu(k,1683) = lu(k,1683) - lu(k,527) * lu(k,1653) + lu(k,1685) = lu(k,1685) - lu(k,528) * lu(k,1653) + lu(k,1690) = lu(k,1690) - lu(k,529) * lu(k,1653) + lu(k,1691) = lu(k,1691) - lu(k,530) * lu(k,1653) end do end subroutine lu_fac13 subroutine lu_fac14( avec_len, lu ) @@ -3389,612 +2866,484 @@ subroutine lu_fac14( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - 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,509) = lu(k,509) * lu(k,503) - lu(k,510) = lu(k,510) * lu(k,503) - lu(k,511) = lu(k,511) * lu(k,503) - lu(k,512) = lu(k,512) * lu(k,503) - lu(k,513) = lu(k,513) * lu(k,503) - lu(k,514) = lu(k,514) * lu(k,503) - lu(k,515) = lu(k,515) * lu(k,503) - lu(k,516) = lu(k,516) * lu(k,503) - lu(k,521) = - lu(k,504) * lu(k,518) - lu(k,522) = lu(k,522) - lu(k,505) * lu(k,518) - lu(k,523) = lu(k,523) - lu(k,506) * lu(k,518) - lu(k,525) = lu(k,525) - lu(k,507) * lu(k,518) - lu(k,526) = lu(k,526) - lu(k,508) * lu(k,518) - lu(k,527) = lu(k,527) - lu(k,509) * lu(k,518) - lu(k,528) = lu(k,528) - lu(k,510) * lu(k,518) - lu(k,529) = lu(k,529) - lu(k,511) * lu(k,518) - lu(k,530) = lu(k,530) - lu(k,512) * lu(k,518) - lu(k,532) = lu(k,532) - lu(k,513) * lu(k,518) - lu(k,533) = lu(k,533) - lu(k,514) * lu(k,518) - lu(k,534) = lu(k,534) - lu(k,515) * lu(k,518) - lu(k,536) = lu(k,536) - lu(k,516) * lu(k,518) - lu(k,561) = lu(k,561) - lu(k,504) * lu(k,558) - lu(k,562) = lu(k,562) - lu(k,505) * lu(k,558) - lu(k,563) = lu(k,563) - lu(k,506) * lu(k,558) - lu(k,565) = lu(k,565) - lu(k,507) * lu(k,558) - lu(k,566) = lu(k,566) - lu(k,508) * lu(k,558) - lu(k,567) = lu(k,567) - lu(k,509) * lu(k,558) - lu(k,568) = lu(k,568) - lu(k,510) * lu(k,558) - lu(k,569) = lu(k,569) - lu(k,511) * lu(k,558) - lu(k,570) = lu(k,570) - lu(k,512) * lu(k,558) - lu(k,572) = lu(k,572) - lu(k,513) * lu(k,558) - lu(k,573) = lu(k,573) - lu(k,514) * lu(k,558) - lu(k,574) = lu(k,574) - lu(k,515) * lu(k,558) - lu(k,576) = lu(k,576) - lu(k,516) * lu(k,558) - lu(k,713) = lu(k,713) - lu(k,504) * lu(k,710) - lu(k,715) = lu(k,715) - lu(k,505) * lu(k,710) - lu(k,716) = lu(k,716) - lu(k,506) * lu(k,710) - lu(k,718) = lu(k,718) - lu(k,507) * lu(k,710) - lu(k,719) = lu(k,719) - lu(k,508) * lu(k,710) - lu(k,720) = lu(k,720) - lu(k,509) * lu(k,710) - lu(k,723) = lu(k,723) - lu(k,510) * lu(k,710) - lu(k,724) = lu(k,724) - lu(k,511) * lu(k,710) - lu(k,725) = lu(k,725) - lu(k,512) * lu(k,710) - lu(k,728) = lu(k,728) - lu(k,513) * lu(k,710) - lu(k,730) = lu(k,730) - lu(k,514) * lu(k,710) - lu(k,731) = lu(k,731) - lu(k,515) * lu(k,710) - lu(k,733) = lu(k,733) - lu(k,516) * lu(k,710) - lu(k,895) = lu(k,895) - lu(k,504) * lu(k,888) - lu(k,900) = lu(k,900) - lu(k,505) * lu(k,888) - lu(k,901) = lu(k,901) - lu(k,506) * lu(k,888) - lu(k,903) = lu(k,903) - lu(k,507) * lu(k,888) - lu(k,904) = lu(k,904) - lu(k,508) * lu(k,888) - lu(k,905) = lu(k,905) - lu(k,509) * lu(k,888) - lu(k,908) = lu(k,908) - lu(k,510) * lu(k,888) - lu(k,909) = lu(k,909) - lu(k,511) * lu(k,888) - lu(k,911) = lu(k,911) - lu(k,512) * lu(k,888) - lu(k,914) = lu(k,914) - lu(k,513) * lu(k,888) - lu(k,916) = lu(k,916) - lu(k,514) * lu(k,888) - lu(k,919) = lu(k,919) - lu(k,515) * lu(k,888) - lu(k,922) = lu(k,922) - lu(k,516) * lu(k,888) - lu(k,937) = lu(k,937) - lu(k,504) * lu(k,931) - lu(k,942) = lu(k,942) - lu(k,505) * lu(k,931) - lu(k,943) = lu(k,943) - lu(k,506) * lu(k,931) - lu(k,945) = lu(k,945) - lu(k,507) * lu(k,931) - lu(k,946) = lu(k,946) - lu(k,508) * lu(k,931) - lu(k,947) = lu(k,947) - lu(k,509) * lu(k,931) - lu(k,950) = lu(k,950) - lu(k,510) * lu(k,931) - lu(k,951) = lu(k,951) - lu(k,511) * lu(k,931) - lu(k,953) = lu(k,953) - lu(k,512) * lu(k,931) - lu(k,956) = lu(k,956) - lu(k,513) * lu(k,931) - lu(k,958) = lu(k,958) - lu(k,514) * lu(k,931) - lu(k,961) = lu(k,961) - lu(k,515) * lu(k,931) - lu(k,964) = lu(k,964) - lu(k,516) * lu(k,931) - lu(k,983) = lu(k,983) - lu(k,504) * lu(k,975) - lu(k,988) = lu(k,988) - lu(k,505) * lu(k,975) - lu(k,989) = - lu(k,506) * lu(k,975) - lu(k,991) = - lu(k,507) * lu(k,975) - lu(k,992) = - lu(k,508) * lu(k,975) - lu(k,993) = lu(k,993) - lu(k,509) * lu(k,975) - lu(k,996) = lu(k,996) - lu(k,510) * lu(k,975) - lu(k,997) = lu(k,997) - lu(k,511) * lu(k,975) - lu(k,999) = lu(k,999) - lu(k,512) * lu(k,975) - lu(k,1002) = lu(k,1002) - lu(k,513) * lu(k,975) - lu(k,1004) = lu(k,1004) - lu(k,514) * lu(k,975) - lu(k,1007) = lu(k,1007) - lu(k,515) * lu(k,975) - lu(k,1010) = lu(k,1010) - lu(k,516) * lu(k,975) - lu(k,1025) = lu(k,1025) - lu(k,504) * lu(k,1019) - lu(k,1030) = lu(k,1030) - lu(k,505) * lu(k,1019) - lu(k,1031) = lu(k,1031) - lu(k,506) * lu(k,1019) - lu(k,1033) = lu(k,1033) - lu(k,507) * lu(k,1019) - lu(k,1034) = lu(k,1034) - lu(k,508) * lu(k,1019) - lu(k,1035) = lu(k,1035) - lu(k,509) * lu(k,1019) - lu(k,1038) = lu(k,1038) - lu(k,510) * lu(k,1019) - lu(k,1039) = lu(k,1039) - lu(k,511) * lu(k,1019) - lu(k,1041) = lu(k,1041) - lu(k,512) * lu(k,1019) - lu(k,1044) = lu(k,1044) - lu(k,513) * lu(k,1019) - lu(k,1046) = lu(k,1046) - lu(k,514) * lu(k,1019) - lu(k,1049) = lu(k,1049) - lu(k,515) * lu(k,1019) - lu(k,1052) = lu(k,1052) - lu(k,516) * lu(k,1019) - lu(k,1066) = lu(k,1066) - lu(k,504) * lu(k,1060) - lu(k,1071) = lu(k,1071) - lu(k,505) * lu(k,1060) - lu(k,1072) = lu(k,1072) - lu(k,506) * lu(k,1060) - lu(k,1074) = lu(k,1074) - lu(k,507) * lu(k,1060) - lu(k,1075) = lu(k,1075) - lu(k,508) * lu(k,1060) - lu(k,1076) = lu(k,1076) - lu(k,509) * lu(k,1060) - lu(k,1079) = lu(k,1079) - lu(k,510) * lu(k,1060) - lu(k,1080) = lu(k,1080) - lu(k,511) * lu(k,1060) - lu(k,1082) = lu(k,1082) - lu(k,512) * lu(k,1060) - lu(k,1085) = lu(k,1085) - lu(k,513) * lu(k,1060) - lu(k,1087) = lu(k,1087) - lu(k,514) * lu(k,1060) - lu(k,1090) = lu(k,1090) - lu(k,515) * lu(k,1060) - lu(k,1093) = lu(k,1093) - lu(k,516) * lu(k,1060) - lu(k,1106) = - lu(k,504) * lu(k,1100) - lu(k,1110) = - lu(k,505) * lu(k,1100) - lu(k,1111) = - lu(k,506) * lu(k,1100) - lu(k,1113) = - lu(k,507) * lu(k,1100) - lu(k,1114) = - lu(k,508) * lu(k,1100) - lu(k,1115) = lu(k,1115) - lu(k,509) * lu(k,1100) - lu(k,1118) = lu(k,1118) - lu(k,510) * lu(k,1100) - lu(k,1119) = lu(k,1119) - lu(k,511) * lu(k,1100) - lu(k,1121) = - lu(k,512) * lu(k,1100) - lu(k,1124) = lu(k,1124) - lu(k,513) * lu(k,1100) - lu(k,1126) = lu(k,1126) - lu(k,514) * lu(k,1100) - lu(k,1129) = lu(k,1129) - lu(k,515) * lu(k,1100) - lu(k,1132) = lu(k,1132) - lu(k,516) * lu(k,1100) - lu(k,1149) = lu(k,1149) - lu(k,504) * lu(k,1143) - lu(k,1154) = lu(k,1154) - lu(k,505) * lu(k,1143) - lu(k,1155) = lu(k,1155) - lu(k,506) * lu(k,1143) - lu(k,1157) = lu(k,1157) - lu(k,507) * lu(k,1143) - lu(k,1158) = lu(k,1158) - lu(k,508) * lu(k,1143) - lu(k,1159) = lu(k,1159) - lu(k,509) * lu(k,1143) - lu(k,1162) = lu(k,1162) - lu(k,510) * lu(k,1143) - lu(k,1163) = lu(k,1163) - lu(k,511) * lu(k,1143) - lu(k,1165) = lu(k,1165) - lu(k,512) * lu(k,1143) - lu(k,1168) = lu(k,1168) - lu(k,513) * lu(k,1143) - lu(k,1170) = lu(k,1170) - lu(k,514) * lu(k,1143) - lu(k,1173) = lu(k,1173) - lu(k,515) * lu(k,1143) - lu(k,1176) = lu(k,1176) - lu(k,516) * lu(k,1143) - lu(k,1278) = lu(k,1278) - lu(k,504) * lu(k,1273) - lu(k,1283) = lu(k,1283) - lu(k,505) * lu(k,1273) - lu(k,1284) = lu(k,1284) - lu(k,506) * lu(k,1273) - lu(k,1286) = lu(k,1286) - lu(k,507) * lu(k,1273) - lu(k,1287) = lu(k,1287) - lu(k,508) * lu(k,1273) - lu(k,1288) = lu(k,1288) - lu(k,509) * lu(k,1273) - lu(k,1291) = lu(k,1291) - lu(k,510) * lu(k,1273) - lu(k,1292) = lu(k,1292) - lu(k,511) * lu(k,1273) - lu(k,1294) = lu(k,1294) - lu(k,512) * lu(k,1273) - lu(k,1297) = lu(k,1297) - lu(k,513) * lu(k,1273) - lu(k,1299) = lu(k,1299) - lu(k,514) * lu(k,1273) - lu(k,1302) = lu(k,1302) - lu(k,515) * lu(k,1273) - lu(k,1305) = lu(k,1305) - lu(k,516) * lu(k,1273) - lu(k,1357) = lu(k,1357) - lu(k,504) * lu(k,1350) - lu(k,1362) = lu(k,1362) - lu(k,505) * lu(k,1350) - lu(k,1363) = lu(k,1363) - lu(k,506) * lu(k,1350) - lu(k,1365) = lu(k,1365) - lu(k,507) * lu(k,1350) - lu(k,1366) = lu(k,1366) - lu(k,508) * lu(k,1350) - lu(k,1367) = lu(k,1367) - lu(k,509) * lu(k,1350) - lu(k,1370) = lu(k,1370) - lu(k,510) * lu(k,1350) - lu(k,1371) = lu(k,1371) - lu(k,511) * lu(k,1350) - lu(k,1373) = lu(k,1373) - lu(k,512) * lu(k,1350) - lu(k,1376) = lu(k,1376) - lu(k,513) * lu(k,1350) - lu(k,1378) = lu(k,1378) - lu(k,514) * lu(k,1350) - lu(k,1381) = lu(k,1381) - lu(k,515) * lu(k,1350) - lu(k,1384) = lu(k,1384) - lu(k,516) * lu(k,1350) - lu(k,1583) = lu(k,1583) - lu(k,504) * lu(k,1577) - lu(k,1588) = lu(k,1588) - lu(k,505) * lu(k,1577) - lu(k,1589) = lu(k,1589) - lu(k,506) * lu(k,1577) - lu(k,1591) = lu(k,1591) - lu(k,507) * lu(k,1577) - lu(k,1592) = lu(k,1592) - lu(k,508) * lu(k,1577) - lu(k,1593) = lu(k,1593) - lu(k,509) * lu(k,1577) - lu(k,1596) = lu(k,1596) - lu(k,510) * lu(k,1577) - lu(k,1597) = lu(k,1597) - lu(k,511) * lu(k,1577) - lu(k,1599) = lu(k,1599) - lu(k,512) * lu(k,1577) - lu(k,1602) = lu(k,1602) - lu(k,513) * lu(k,1577) - lu(k,1604) = lu(k,1604) - lu(k,514) * lu(k,1577) - lu(k,1607) = lu(k,1607) - lu(k,515) * lu(k,1577) - lu(k,1610) = lu(k,1610) - lu(k,516) * lu(k,1577) - lu(k,1692) = lu(k,1692) - lu(k,504) * lu(k,1686) - lu(k,1697) = lu(k,1697) - lu(k,505) * lu(k,1686) - lu(k,1698) = lu(k,1698) - lu(k,506) * lu(k,1686) - lu(k,1700) = lu(k,1700) - lu(k,507) * lu(k,1686) - lu(k,1701) = lu(k,1701) - lu(k,508) * lu(k,1686) - lu(k,1702) = lu(k,1702) - lu(k,509) * lu(k,1686) - lu(k,1705) = lu(k,1705) - lu(k,510) * lu(k,1686) - lu(k,1706) = lu(k,1706) - lu(k,511) * lu(k,1686) - lu(k,1708) = lu(k,1708) - lu(k,512) * lu(k,1686) - lu(k,1711) = lu(k,1711) - lu(k,513) * lu(k,1686) - lu(k,1713) = lu(k,1713) - lu(k,514) * lu(k,1686) - lu(k,1716) = lu(k,1716) - lu(k,515) * lu(k,1686) - lu(k,1719) = lu(k,1719) - lu(k,516) * lu(k,1686) - lu(k,519) = 1._r8 / lu(k,519) - lu(k,520) = lu(k,520) * lu(k,519) - lu(k,521) = lu(k,521) * lu(k,519) - lu(k,522) = lu(k,522) * lu(k,519) - lu(k,523) = lu(k,523) * lu(k,519) - lu(k,524) = lu(k,524) * lu(k,519) - lu(k,525) = lu(k,525) * lu(k,519) - lu(k,526) = lu(k,526) * lu(k,519) - lu(k,527) = lu(k,527) * lu(k,519) - lu(k,528) = lu(k,528) * lu(k,519) - lu(k,529) = lu(k,529) * lu(k,519) - lu(k,530) = lu(k,530) * lu(k,519) - lu(k,531) = lu(k,531) * lu(k,519) - lu(k,532) = lu(k,532) * lu(k,519) - lu(k,533) = lu(k,533) * lu(k,519) - lu(k,534) = lu(k,534) * lu(k,519) - lu(k,535) = lu(k,535) * lu(k,519) - lu(k,536) = lu(k,536) * lu(k,519) - lu(k,560) = lu(k,560) - lu(k,520) * lu(k,559) - lu(k,561) = lu(k,561) - lu(k,521) * lu(k,559) - lu(k,562) = lu(k,562) - lu(k,522) * lu(k,559) - lu(k,563) = lu(k,563) - lu(k,523) * lu(k,559) - lu(k,564) = lu(k,564) - lu(k,524) * lu(k,559) - lu(k,565) = lu(k,565) - lu(k,525) * lu(k,559) - lu(k,566) = lu(k,566) - lu(k,526) * lu(k,559) - lu(k,567) = lu(k,567) - lu(k,527) * lu(k,559) - lu(k,568) = lu(k,568) - lu(k,528) * lu(k,559) - lu(k,569) = lu(k,569) - lu(k,529) * lu(k,559) - lu(k,570) = lu(k,570) - lu(k,530) * lu(k,559) - lu(k,571) = lu(k,571) - lu(k,531) * lu(k,559) - lu(k,572) = lu(k,572) - lu(k,532) * lu(k,559) - lu(k,573) = lu(k,573) - lu(k,533) * lu(k,559) - lu(k,574) = lu(k,574) - lu(k,534) * lu(k,559) - lu(k,575) = lu(k,575) - lu(k,535) * lu(k,559) - lu(k,576) = lu(k,576) - lu(k,536) * lu(k,559) - lu(k,891) = lu(k,891) - lu(k,520) * lu(k,889) - lu(k,895) = lu(k,895) - lu(k,521) * lu(k,889) - lu(k,900) = lu(k,900) - lu(k,522) * lu(k,889) - lu(k,901) = lu(k,901) - lu(k,523) * lu(k,889) - lu(k,902) = lu(k,902) - lu(k,524) * lu(k,889) - lu(k,903) = lu(k,903) - lu(k,525) * lu(k,889) - lu(k,904) = lu(k,904) - lu(k,526) * lu(k,889) - lu(k,905) = lu(k,905) - lu(k,527) * lu(k,889) - lu(k,908) = lu(k,908) - lu(k,528) * lu(k,889) - lu(k,909) = lu(k,909) - lu(k,529) * lu(k,889) - lu(k,911) = lu(k,911) - lu(k,530) * lu(k,889) - lu(k,912) = lu(k,912) - lu(k,531) * lu(k,889) - lu(k,914) = lu(k,914) - lu(k,532) * lu(k,889) - lu(k,916) = lu(k,916) - lu(k,533) * lu(k,889) - lu(k,919) = lu(k,919) - lu(k,534) * lu(k,889) - lu(k,921) = lu(k,921) - lu(k,535) * lu(k,889) - lu(k,922) = lu(k,922) - lu(k,536) * lu(k,889) - lu(k,934) = lu(k,934) - lu(k,520) * lu(k,932) - lu(k,937) = lu(k,937) - lu(k,521) * lu(k,932) - lu(k,942) = lu(k,942) - lu(k,522) * lu(k,932) - lu(k,943) = lu(k,943) - lu(k,523) * lu(k,932) - lu(k,944) = lu(k,944) - lu(k,524) * lu(k,932) - lu(k,945) = lu(k,945) - lu(k,525) * lu(k,932) - lu(k,946) = lu(k,946) - lu(k,526) * lu(k,932) - lu(k,947) = lu(k,947) - lu(k,527) * lu(k,932) - lu(k,950) = lu(k,950) - lu(k,528) * lu(k,932) - lu(k,951) = lu(k,951) - lu(k,529) * lu(k,932) - lu(k,953) = lu(k,953) - lu(k,530) * lu(k,932) - lu(k,954) = lu(k,954) - lu(k,531) * lu(k,932) - lu(k,956) = lu(k,956) - lu(k,532) * lu(k,932) - lu(k,958) = lu(k,958) - lu(k,533) * lu(k,932) - lu(k,961) = lu(k,961) - lu(k,534) * lu(k,932) - lu(k,963) = lu(k,963) - lu(k,535) * lu(k,932) - lu(k,964) = lu(k,964) - lu(k,536) * lu(k,932) - lu(k,978) = lu(k,978) - lu(k,520) * lu(k,976) - lu(k,983) = lu(k,983) - lu(k,521) * lu(k,976) - lu(k,988) = lu(k,988) - lu(k,522) * lu(k,976) - lu(k,989) = lu(k,989) - lu(k,523) * lu(k,976) - lu(k,990) = lu(k,990) - lu(k,524) * lu(k,976) - lu(k,991) = lu(k,991) - lu(k,525) * lu(k,976) - lu(k,992) = lu(k,992) - lu(k,526) * lu(k,976) - lu(k,993) = lu(k,993) - lu(k,527) * lu(k,976) - lu(k,996) = lu(k,996) - lu(k,528) * lu(k,976) - lu(k,997) = lu(k,997) - lu(k,529) * lu(k,976) - lu(k,999) = lu(k,999) - lu(k,530) * lu(k,976) - lu(k,1000) = lu(k,1000) - lu(k,531) * lu(k,976) - lu(k,1002) = lu(k,1002) - lu(k,532) * lu(k,976) - lu(k,1004) = lu(k,1004) - lu(k,533) * lu(k,976) - lu(k,1007) = lu(k,1007) - lu(k,534) * lu(k,976) - lu(k,1009) = lu(k,1009) - lu(k,535) * lu(k,976) - lu(k,1010) = lu(k,1010) - lu(k,536) * lu(k,976) - lu(k,1022) = lu(k,1022) - lu(k,520) * lu(k,1020) - lu(k,1025) = lu(k,1025) - lu(k,521) * lu(k,1020) - lu(k,1030) = lu(k,1030) - lu(k,522) * lu(k,1020) - lu(k,1031) = lu(k,1031) - lu(k,523) * lu(k,1020) - lu(k,1032) = lu(k,1032) - lu(k,524) * lu(k,1020) - lu(k,1033) = lu(k,1033) - lu(k,525) * lu(k,1020) - lu(k,1034) = lu(k,1034) - lu(k,526) * lu(k,1020) - lu(k,1035) = lu(k,1035) - lu(k,527) * lu(k,1020) - lu(k,1038) = lu(k,1038) - lu(k,528) * lu(k,1020) - lu(k,1039) = lu(k,1039) - lu(k,529) * lu(k,1020) - lu(k,1041) = lu(k,1041) - lu(k,530) * lu(k,1020) - lu(k,1042) = lu(k,1042) - lu(k,531) * lu(k,1020) - lu(k,1044) = lu(k,1044) - lu(k,532) * lu(k,1020) - lu(k,1046) = lu(k,1046) - lu(k,533) * lu(k,1020) - lu(k,1049) = lu(k,1049) - lu(k,534) * lu(k,1020) - lu(k,1051) = lu(k,1051) - lu(k,535) * lu(k,1020) - lu(k,1052) = lu(k,1052) - lu(k,536) * lu(k,1020) - lu(k,1063) = lu(k,1063) - lu(k,520) * lu(k,1061) - lu(k,1066) = lu(k,1066) - lu(k,521) * lu(k,1061) - lu(k,1071) = lu(k,1071) - lu(k,522) * lu(k,1061) - lu(k,1072) = lu(k,1072) - lu(k,523) * lu(k,1061) - lu(k,1073) = lu(k,1073) - lu(k,524) * lu(k,1061) - lu(k,1074) = lu(k,1074) - lu(k,525) * lu(k,1061) - lu(k,1075) = lu(k,1075) - lu(k,526) * lu(k,1061) - lu(k,1076) = lu(k,1076) - lu(k,527) * lu(k,1061) - lu(k,1079) = lu(k,1079) - lu(k,528) * lu(k,1061) - lu(k,1080) = lu(k,1080) - lu(k,529) * lu(k,1061) - lu(k,1082) = lu(k,1082) - lu(k,530) * lu(k,1061) - lu(k,1083) = lu(k,1083) - lu(k,531) * lu(k,1061) - lu(k,1085) = lu(k,1085) - lu(k,532) * lu(k,1061) - lu(k,1087) = lu(k,1087) - lu(k,533) * lu(k,1061) - lu(k,1090) = lu(k,1090) - lu(k,534) * lu(k,1061) - lu(k,1092) = lu(k,1092) - lu(k,535) * lu(k,1061) - lu(k,1093) = lu(k,1093) - lu(k,536) * lu(k,1061) - lu(k,1102) = lu(k,1102) - lu(k,520) * lu(k,1101) - lu(k,1106) = lu(k,1106) - lu(k,521) * lu(k,1101) - lu(k,1110) = lu(k,1110) - lu(k,522) * lu(k,1101) - lu(k,1111) = lu(k,1111) - lu(k,523) * lu(k,1101) - lu(k,1112) = lu(k,1112) - lu(k,524) * lu(k,1101) - lu(k,1113) = lu(k,1113) - lu(k,525) * lu(k,1101) - lu(k,1114) = lu(k,1114) - lu(k,526) * lu(k,1101) - lu(k,1115) = lu(k,1115) - lu(k,527) * lu(k,1101) - lu(k,1118) = lu(k,1118) - lu(k,528) * lu(k,1101) - lu(k,1119) = lu(k,1119) - lu(k,529) * lu(k,1101) - lu(k,1121) = lu(k,1121) - lu(k,530) * lu(k,1101) - lu(k,1122) = lu(k,1122) - lu(k,531) * lu(k,1101) - lu(k,1124) = lu(k,1124) - lu(k,532) * lu(k,1101) - lu(k,1126) = lu(k,1126) - lu(k,533) * lu(k,1101) - lu(k,1129) = lu(k,1129) - lu(k,534) * lu(k,1101) - lu(k,1131) = lu(k,1131) - lu(k,535) * lu(k,1101) - lu(k,1132) = lu(k,1132) - lu(k,536) * lu(k,1101) - lu(k,1353) = lu(k,1353) - lu(k,520) * lu(k,1351) - lu(k,1357) = lu(k,1357) - lu(k,521) * lu(k,1351) - lu(k,1362) = lu(k,1362) - lu(k,522) * lu(k,1351) - lu(k,1363) = lu(k,1363) - lu(k,523) * lu(k,1351) - lu(k,1364) = lu(k,1364) - lu(k,524) * lu(k,1351) - lu(k,1365) = lu(k,1365) - lu(k,525) * lu(k,1351) - lu(k,1366) = lu(k,1366) - lu(k,526) * lu(k,1351) - lu(k,1367) = lu(k,1367) - lu(k,527) * lu(k,1351) - lu(k,1370) = lu(k,1370) - lu(k,528) * lu(k,1351) - lu(k,1371) = lu(k,1371) - lu(k,529) * lu(k,1351) - lu(k,1373) = lu(k,1373) - lu(k,530) * lu(k,1351) - lu(k,1374) = lu(k,1374) - lu(k,531) * lu(k,1351) - lu(k,1376) = lu(k,1376) - lu(k,532) * lu(k,1351) - lu(k,1378) = lu(k,1378) - lu(k,533) * lu(k,1351) - lu(k,1381) = lu(k,1381) - lu(k,534) * lu(k,1351) - lu(k,1383) = lu(k,1383) - lu(k,535) * lu(k,1351) - lu(k,1384) = lu(k,1384) - lu(k,536) * lu(k,1351) - lu(k,1580) = lu(k,1580) - lu(k,520) * lu(k,1578) - lu(k,1583) = lu(k,1583) - lu(k,521) * lu(k,1578) - lu(k,1588) = lu(k,1588) - lu(k,522) * lu(k,1578) - lu(k,1589) = lu(k,1589) - lu(k,523) * lu(k,1578) - lu(k,1590) = lu(k,1590) - lu(k,524) * lu(k,1578) - lu(k,1591) = lu(k,1591) - lu(k,525) * lu(k,1578) - lu(k,1592) = lu(k,1592) - lu(k,526) * lu(k,1578) - lu(k,1593) = lu(k,1593) - lu(k,527) * lu(k,1578) - lu(k,1596) = lu(k,1596) - lu(k,528) * lu(k,1578) - lu(k,1597) = lu(k,1597) - lu(k,529) * lu(k,1578) - lu(k,1599) = lu(k,1599) - lu(k,530) * lu(k,1578) - lu(k,1600) = lu(k,1600) - lu(k,531) * lu(k,1578) - lu(k,1602) = lu(k,1602) - lu(k,532) * lu(k,1578) - lu(k,1604) = lu(k,1604) - lu(k,533) * lu(k,1578) - lu(k,1607) = lu(k,1607) - lu(k,534) * lu(k,1578) - lu(k,1609) = lu(k,1609) - lu(k,535) * lu(k,1578) - lu(k,1610) = lu(k,1610) - lu(k,536) * lu(k,1578) - lu(k,1689) = lu(k,1689) - lu(k,520) * lu(k,1687) - lu(k,1692) = lu(k,1692) - lu(k,521) * lu(k,1687) - lu(k,1697) = lu(k,1697) - lu(k,522) * lu(k,1687) - lu(k,1698) = lu(k,1698) - lu(k,523) * lu(k,1687) - lu(k,1699) = lu(k,1699) - lu(k,524) * lu(k,1687) - lu(k,1700) = lu(k,1700) - lu(k,525) * lu(k,1687) - lu(k,1701) = lu(k,1701) - lu(k,526) * lu(k,1687) - lu(k,1702) = lu(k,1702) - lu(k,527) * lu(k,1687) - lu(k,1705) = lu(k,1705) - lu(k,528) * lu(k,1687) - lu(k,1706) = lu(k,1706) - lu(k,529) * lu(k,1687) - lu(k,1708) = lu(k,1708) - lu(k,530) * lu(k,1687) - lu(k,1709) = lu(k,1709) - lu(k,531) * lu(k,1687) - lu(k,1711) = lu(k,1711) - lu(k,532) * lu(k,1687) - lu(k,1713) = lu(k,1713) - lu(k,533) * lu(k,1687) - lu(k,1716) = lu(k,1716) - lu(k,534) * lu(k,1687) - lu(k,1718) = lu(k,1718) - lu(k,535) * lu(k,1687) - lu(k,1719) = lu(k,1719) - lu(k,536) * lu(k,1687) - lu(k,1824) = lu(k,1824) - lu(k,520) * lu(k,1822) - lu(k,1829) = lu(k,1829) - lu(k,521) * lu(k,1822) - lu(k,1834) = lu(k,1834) - lu(k,522) * lu(k,1822) - lu(k,1835) = lu(k,1835) - lu(k,523) * lu(k,1822) - lu(k,1836) = lu(k,1836) - lu(k,524) * lu(k,1822) - lu(k,1837) = lu(k,1837) - lu(k,525) * lu(k,1822) - lu(k,1838) = lu(k,1838) - lu(k,526) * lu(k,1822) - lu(k,1839) = lu(k,1839) - lu(k,527) * lu(k,1822) - lu(k,1842) = lu(k,1842) - lu(k,528) * lu(k,1822) - lu(k,1843) = lu(k,1843) - lu(k,529) * lu(k,1822) - lu(k,1845) = lu(k,1845) - lu(k,530) * lu(k,1822) - lu(k,1846) = lu(k,1846) - lu(k,531) * lu(k,1822) - lu(k,1848) = lu(k,1848) - lu(k,532) * lu(k,1822) - lu(k,1850) = lu(k,1850) - lu(k,533) * lu(k,1822) - lu(k,1853) = lu(k,1853) - lu(k,534) * lu(k,1822) - lu(k,1855) = lu(k,1855) - lu(k,535) * lu(k,1822) - lu(k,1856) = lu(k,1856) - lu(k,536) * lu(k,1822) - lu(k,539) = 1._r8 / lu(k,539) - lu(k,540) = lu(k,540) * lu(k,539) - lu(k,541) = lu(k,541) * lu(k,539) - lu(k,542) = lu(k,542) * lu(k,539) - lu(k,543) = lu(k,543) * lu(k,539) - lu(k,544) = lu(k,544) * lu(k,539) - lu(k,545) = lu(k,545) * lu(k,539) - lu(k,546) = lu(k,546) * lu(k,539) - lu(k,547) = lu(k,547) * lu(k,539) - lu(k,548) = lu(k,548) * lu(k,539) - lu(k,549) = lu(k,549) * lu(k,539) - lu(k,550) = lu(k,550) * lu(k,539) - lu(k,551) = lu(k,551) * lu(k,539) - lu(k,552) = lu(k,552) * lu(k,539) - lu(k,553) = lu(k,553) * lu(k,539) - lu(k,554) = lu(k,554) * lu(k,539) - lu(k,555) = lu(k,555) * lu(k,539) - lu(k,556) = lu(k,556) * lu(k,539) - lu(k,818) = - lu(k,540) * lu(k,817) - lu(k,820) = lu(k,820) - lu(k,541) * lu(k,817) - lu(k,822) = lu(k,822) - lu(k,542) * lu(k,817) - lu(k,823) = lu(k,823) - lu(k,543) * lu(k,817) - lu(k,824) = lu(k,824) - lu(k,544) * lu(k,817) - lu(k,825) = lu(k,825) - lu(k,545) * lu(k,817) - lu(k,826) = lu(k,826) - lu(k,546) * lu(k,817) - lu(k,827) = lu(k,827) - lu(k,547) * lu(k,817) - lu(k,828) = lu(k,828) - lu(k,548) * lu(k,817) - lu(k,832) = lu(k,832) - lu(k,549) * lu(k,817) - lu(k,835) = lu(k,835) - lu(k,550) * lu(k,817) - lu(k,836) = lu(k,836) - lu(k,551) * lu(k,817) - lu(k,838) = lu(k,838) - lu(k,552) * lu(k,817) - lu(k,840) = lu(k,840) - lu(k,553) * lu(k,817) - lu(k,843) = lu(k,843) - lu(k,554) * lu(k,817) - lu(k,845) = lu(k,845) - lu(k,555) * lu(k,817) - lu(k,846) = lu(k,846) - lu(k,556) * lu(k,817) - lu(k,891) = lu(k,891) - lu(k,540) * lu(k,890) - lu(k,895) = lu(k,895) - lu(k,541) * lu(k,890) - lu(k,898) = lu(k,898) - lu(k,542) * lu(k,890) - lu(k,899) = lu(k,899) - lu(k,543) * lu(k,890) - lu(k,900) = lu(k,900) - lu(k,544) * lu(k,890) - lu(k,901) = lu(k,901) - lu(k,545) * lu(k,890) - lu(k,902) = lu(k,902) - lu(k,546) * lu(k,890) - lu(k,903) = lu(k,903) - lu(k,547) * lu(k,890) - lu(k,904) = lu(k,904) - lu(k,548) * lu(k,890) - lu(k,908) = lu(k,908) - lu(k,549) * lu(k,890) - lu(k,911) = lu(k,911) - lu(k,550) * lu(k,890) - lu(k,912) = lu(k,912) - lu(k,551) * lu(k,890) - lu(k,914) = lu(k,914) - lu(k,552) * lu(k,890) - lu(k,916) = lu(k,916) - lu(k,553) * lu(k,890) - lu(k,919) = lu(k,919) - lu(k,554) * lu(k,890) - lu(k,921) = lu(k,921) - lu(k,555) * lu(k,890) - lu(k,922) = lu(k,922) - lu(k,556) * lu(k,890) - lu(k,934) = lu(k,934) - lu(k,540) * lu(k,933) - lu(k,937) = lu(k,937) - lu(k,541) * lu(k,933) - lu(k,940) = lu(k,940) - lu(k,542) * lu(k,933) - lu(k,941) = lu(k,941) - lu(k,543) * lu(k,933) - lu(k,942) = lu(k,942) - lu(k,544) * lu(k,933) - lu(k,943) = lu(k,943) - lu(k,545) * lu(k,933) - lu(k,944) = lu(k,944) - lu(k,546) * lu(k,933) - lu(k,945) = lu(k,945) - lu(k,547) * lu(k,933) - lu(k,946) = lu(k,946) - lu(k,548) * lu(k,933) - lu(k,950) = lu(k,950) - lu(k,549) * lu(k,933) - lu(k,953) = lu(k,953) - lu(k,550) * lu(k,933) - lu(k,954) = lu(k,954) - lu(k,551) * lu(k,933) - lu(k,956) = lu(k,956) - lu(k,552) * lu(k,933) - lu(k,958) = lu(k,958) - lu(k,553) * lu(k,933) - lu(k,961) = lu(k,961) - lu(k,554) * lu(k,933) - lu(k,963) = lu(k,963) - lu(k,555) * lu(k,933) - lu(k,964) = lu(k,964) - lu(k,556) * lu(k,933) - lu(k,978) = lu(k,978) - lu(k,540) * lu(k,977) - lu(k,983) = lu(k,983) - lu(k,541) * lu(k,977) - lu(k,986) = lu(k,986) - lu(k,542) * lu(k,977) - lu(k,987) = lu(k,987) - lu(k,543) * lu(k,977) - lu(k,988) = lu(k,988) - lu(k,544) * lu(k,977) - lu(k,989) = lu(k,989) - lu(k,545) * lu(k,977) - lu(k,990) = lu(k,990) - lu(k,546) * lu(k,977) - lu(k,991) = lu(k,991) - lu(k,547) * lu(k,977) - lu(k,992) = lu(k,992) - lu(k,548) * lu(k,977) - lu(k,996) = lu(k,996) - lu(k,549) * lu(k,977) - lu(k,999) = lu(k,999) - lu(k,550) * lu(k,977) - lu(k,1000) = lu(k,1000) - lu(k,551) * lu(k,977) - lu(k,1002) = lu(k,1002) - lu(k,552) * lu(k,977) - lu(k,1004) = lu(k,1004) - lu(k,553) * lu(k,977) - lu(k,1007) = lu(k,1007) - lu(k,554) * lu(k,977) - lu(k,1009) = lu(k,1009) - lu(k,555) * lu(k,977) - lu(k,1010) = lu(k,1010) - lu(k,556) * lu(k,977) - lu(k,1022) = lu(k,1022) - lu(k,540) * lu(k,1021) - lu(k,1025) = lu(k,1025) - lu(k,541) * lu(k,1021) - lu(k,1028) = lu(k,1028) - lu(k,542) * lu(k,1021) - lu(k,1029) = lu(k,1029) - lu(k,543) * lu(k,1021) - lu(k,1030) = lu(k,1030) - lu(k,544) * lu(k,1021) - lu(k,1031) = lu(k,1031) - lu(k,545) * lu(k,1021) - lu(k,1032) = lu(k,1032) - lu(k,546) * lu(k,1021) - lu(k,1033) = lu(k,1033) - lu(k,547) * lu(k,1021) - lu(k,1034) = lu(k,1034) - lu(k,548) * lu(k,1021) - lu(k,1038) = lu(k,1038) - lu(k,549) * lu(k,1021) - lu(k,1041) = lu(k,1041) - lu(k,550) * lu(k,1021) - lu(k,1042) = lu(k,1042) - lu(k,551) * lu(k,1021) - lu(k,1044) = lu(k,1044) - lu(k,552) * lu(k,1021) - lu(k,1046) = lu(k,1046) - lu(k,553) * lu(k,1021) - lu(k,1049) = lu(k,1049) - lu(k,554) * lu(k,1021) - lu(k,1051) = lu(k,1051) - lu(k,555) * lu(k,1021) - lu(k,1052) = lu(k,1052) - lu(k,556) * lu(k,1021) - lu(k,1063) = lu(k,1063) - lu(k,540) * lu(k,1062) - lu(k,1066) = lu(k,1066) - lu(k,541) * lu(k,1062) - lu(k,1069) = lu(k,1069) - lu(k,542) * lu(k,1062) - lu(k,1070) = lu(k,1070) - lu(k,543) * lu(k,1062) - lu(k,1071) = lu(k,1071) - lu(k,544) * lu(k,1062) - lu(k,1072) = lu(k,1072) - lu(k,545) * lu(k,1062) - lu(k,1073) = lu(k,1073) - lu(k,546) * lu(k,1062) - lu(k,1074) = lu(k,1074) - lu(k,547) * lu(k,1062) - lu(k,1075) = lu(k,1075) - lu(k,548) * lu(k,1062) - lu(k,1079) = lu(k,1079) - lu(k,549) * lu(k,1062) - lu(k,1082) = lu(k,1082) - lu(k,550) * lu(k,1062) - lu(k,1083) = lu(k,1083) - lu(k,551) * lu(k,1062) - lu(k,1085) = lu(k,1085) - lu(k,552) * lu(k,1062) - lu(k,1087) = lu(k,1087) - lu(k,553) * lu(k,1062) - lu(k,1090) = lu(k,1090) - lu(k,554) * lu(k,1062) - lu(k,1092) = lu(k,1092) - lu(k,555) * lu(k,1062) - lu(k,1093) = lu(k,1093) - lu(k,556) * lu(k,1062) - lu(k,1353) = lu(k,1353) - lu(k,540) * lu(k,1352) - lu(k,1357) = lu(k,1357) - lu(k,541) * lu(k,1352) - lu(k,1360) = lu(k,1360) - lu(k,542) * lu(k,1352) - lu(k,1361) = lu(k,1361) - lu(k,543) * lu(k,1352) - lu(k,1362) = lu(k,1362) - lu(k,544) * lu(k,1352) - lu(k,1363) = lu(k,1363) - lu(k,545) * lu(k,1352) - lu(k,1364) = lu(k,1364) - lu(k,546) * lu(k,1352) - lu(k,1365) = lu(k,1365) - lu(k,547) * lu(k,1352) - lu(k,1366) = lu(k,1366) - lu(k,548) * lu(k,1352) - lu(k,1370) = lu(k,1370) - lu(k,549) * lu(k,1352) - lu(k,1373) = lu(k,1373) - lu(k,550) * lu(k,1352) - lu(k,1374) = lu(k,1374) - lu(k,551) * lu(k,1352) - lu(k,1376) = lu(k,1376) - lu(k,552) * lu(k,1352) - lu(k,1378) = lu(k,1378) - lu(k,553) * lu(k,1352) - lu(k,1381) = lu(k,1381) - lu(k,554) * lu(k,1352) - lu(k,1383) = lu(k,1383) - lu(k,555) * lu(k,1352) - lu(k,1384) = lu(k,1384) - lu(k,556) * lu(k,1352) - lu(k,1494) = - lu(k,540) * lu(k,1493) - lu(k,1499) = lu(k,1499) - lu(k,541) * lu(k,1493) - lu(k,1502) = lu(k,1502) - lu(k,542) * lu(k,1493) - lu(k,1503) = lu(k,1503) - lu(k,543) * lu(k,1493) - lu(k,1504) = lu(k,1504) - lu(k,544) * lu(k,1493) - lu(k,1505) = lu(k,1505) - lu(k,545) * lu(k,1493) - lu(k,1506) = lu(k,1506) - lu(k,546) * lu(k,1493) - lu(k,1507) = lu(k,1507) - lu(k,547) * lu(k,1493) - lu(k,1508) = lu(k,1508) - lu(k,548) * lu(k,1493) - lu(k,1512) = lu(k,1512) - lu(k,549) * lu(k,1493) - lu(k,1515) = lu(k,1515) - lu(k,550) * lu(k,1493) - lu(k,1516) = lu(k,1516) - lu(k,551) * lu(k,1493) - lu(k,1518) = lu(k,1518) - lu(k,552) * lu(k,1493) - lu(k,1520) = lu(k,1520) - lu(k,553) * lu(k,1493) - lu(k,1523) = lu(k,1523) - lu(k,554) * lu(k,1493) - lu(k,1525) = lu(k,1525) - lu(k,555) * lu(k,1493) - lu(k,1526) = lu(k,1526) - lu(k,556) * lu(k,1493) - lu(k,1580) = lu(k,1580) - lu(k,540) * lu(k,1579) - lu(k,1583) = lu(k,1583) - lu(k,541) * lu(k,1579) - lu(k,1586) = lu(k,1586) - lu(k,542) * lu(k,1579) - lu(k,1587) = lu(k,1587) - lu(k,543) * lu(k,1579) - lu(k,1588) = lu(k,1588) - lu(k,544) * lu(k,1579) - lu(k,1589) = lu(k,1589) - lu(k,545) * lu(k,1579) - lu(k,1590) = lu(k,1590) - lu(k,546) * lu(k,1579) - lu(k,1591) = lu(k,1591) - lu(k,547) * lu(k,1579) - lu(k,1592) = lu(k,1592) - lu(k,548) * lu(k,1579) - lu(k,1596) = lu(k,1596) - lu(k,549) * lu(k,1579) - lu(k,1599) = lu(k,1599) - lu(k,550) * lu(k,1579) - lu(k,1600) = lu(k,1600) - lu(k,551) * lu(k,1579) - lu(k,1602) = lu(k,1602) - lu(k,552) * lu(k,1579) - lu(k,1604) = lu(k,1604) - lu(k,553) * lu(k,1579) - lu(k,1607) = lu(k,1607) - lu(k,554) * lu(k,1579) - lu(k,1609) = lu(k,1609) - lu(k,555) * lu(k,1579) - lu(k,1610) = lu(k,1610) - lu(k,556) * lu(k,1579) - lu(k,1689) = lu(k,1689) - lu(k,540) * lu(k,1688) - lu(k,1692) = lu(k,1692) - lu(k,541) * lu(k,1688) - lu(k,1695) = lu(k,1695) - lu(k,542) * lu(k,1688) - lu(k,1696) = lu(k,1696) - lu(k,543) * lu(k,1688) - lu(k,1697) = lu(k,1697) - lu(k,544) * lu(k,1688) - lu(k,1698) = lu(k,1698) - lu(k,545) * lu(k,1688) - lu(k,1699) = lu(k,1699) - lu(k,546) * lu(k,1688) - lu(k,1700) = lu(k,1700) - lu(k,547) * lu(k,1688) - lu(k,1701) = lu(k,1701) - lu(k,548) * lu(k,1688) - lu(k,1705) = lu(k,1705) - lu(k,549) * lu(k,1688) - lu(k,1708) = lu(k,1708) - lu(k,550) * lu(k,1688) - lu(k,1709) = lu(k,1709) - lu(k,551) * lu(k,1688) - lu(k,1711) = lu(k,1711) - lu(k,552) * lu(k,1688) - lu(k,1713) = lu(k,1713) - lu(k,553) * lu(k,1688) - lu(k,1716) = lu(k,1716) - lu(k,554) * lu(k,1688) - lu(k,1718) = lu(k,1718) - lu(k,555) * lu(k,1688) - lu(k,1719) = lu(k,1719) - lu(k,556) * lu(k,1688) - lu(k,1824) = lu(k,1824) - lu(k,540) * lu(k,1823) - lu(k,1829) = lu(k,1829) - lu(k,541) * lu(k,1823) - lu(k,1832) = lu(k,1832) - lu(k,542) * lu(k,1823) - lu(k,1833) = lu(k,1833) - lu(k,543) * lu(k,1823) - lu(k,1834) = lu(k,1834) - lu(k,544) * lu(k,1823) - lu(k,1835) = lu(k,1835) - lu(k,545) * lu(k,1823) - lu(k,1836) = lu(k,1836) - lu(k,546) * lu(k,1823) - lu(k,1837) = lu(k,1837) - lu(k,547) * lu(k,1823) - lu(k,1838) = lu(k,1838) - lu(k,548) * lu(k,1823) - lu(k,1842) = lu(k,1842) - lu(k,549) * lu(k,1823) - lu(k,1845) = lu(k,1845) - lu(k,550) * lu(k,1823) - lu(k,1846) = lu(k,1846) - lu(k,551) * lu(k,1823) - lu(k,1848) = lu(k,1848) - lu(k,552) * lu(k,1823) - lu(k,1850) = lu(k,1850) - lu(k,553) * lu(k,1823) - lu(k,1853) = lu(k,1853) - lu(k,554) * lu(k,1823) - lu(k,1855) = lu(k,1855) - lu(k,555) * lu(k,1823) - lu(k,1856) = lu(k,1856) - lu(k,556) * lu(k,1823) + lu(k,532) = 1._r8 / lu(k,532) + lu(k,533) = lu(k,533) * lu(k,532) + lu(k,534) = lu(k,534) * lu(k,532) + lu(k,535) = lu(k,535) * lu(k,532) + lu(k,536) = lu(k,536) * lu(k,532) + lu(k,537) = lu(k,537) * lu(k,532) + lu(k,538) = lu(k,538) * lu(k,532) + lu(k,539) = lu(k,539) * lu(k,532) + lu(k,540) = lu(k,540) * lu(k,532) + lu(k,541) = lu(k,541) * lu(k,532) + lu(k,542) = lu(k,542) * lu(k,532) + lu(k,543) = lu(k,543) * lu(k,532) + lu(k,544) = lu(k,544) * lu(k,532) + lu(k,545) = lu(k,545) * lu(k,532) + lu(k,546) = lu(k,546) * lu(k,532) + lu(k,808) = lu(k,808) - lu(k,533) * lu(k,807) + lu(k,812) = lu(k,812) - lu(k,534) * lu(k,807) + lu(k,813) = lu(k,813) - lu(k,535) * lu(k,807) + lu(k,815) = lu(k,815) - lu(k,536) * lu(k,807) + lu(k,816) = lu(k,816) - lu(k,537) * lu(k,807) + lu(k,817) = lu(k,817) - lu(k,538) * lu(k,807) + lu(k,818) = lu(k,818) - lu(k,539) * lu(k,807) + lu(k,819) = lu(k,819) - lu(k,540) * lu(k,807) + lu(k,820) = lu(k,820) - lu(k,541) * lu(k,807) + lu(k,822) = lu(k,822) - lu(k,542) * lu(k,807) + lu(k,823) = lu(k,823) - lu(k,543) * lu(k,807) + lu(k,824) = lu(k,824) - lu(k,544) * lu(k,807) + lu(k,825) = lu(k,825) - lu(k,545) * lu(k,807) + lu(k,826) = lu(k,826) - lu(k,546) * lu(k,807) + lu(k,1136) = lu(k,1136) - lu(k,533) * lu(k,1128) + lu(k,1145) = lu(k,1145) - lu(k,534) * lu(k,1128) + lu(k,1146) = lu(k,1146) - lu(k,535) * lu(k,1128) + lu(k,1149) = lu(k,1149) - lu(k,536) * lu(k,1128) + lu(k,1150) = lu(k,1150) - lu(k,537) * lu(k,1128) + lu(k,1151) = lu(k,1151) - lu(k,538) * lu(k,1128) + lu(k,1152) = lu(k,1152) - lu(k,539) * lu(k,1128) + lu(k,1153) = lu(k,1153) - lu(k,540) * lu(k,1128) + lu(k,1155) = lu(k,1155) - lu(k,541) * lu(k,1128) + lu(k,1157) = lu(k,1157) - lu(k,542) * lu(k,1128) + lu(k,1158) = lu(k,1158) - lu(k,543) * lu(k,1128) + lu(k,1160) = lu(k,1160) - lu(k,544) * lu(k,1128) + lu(k,1165) = lu(k,1165) - lu(k,545) * lu(k,1128) + lu(k,1166) = lu(k,1166) - lu(k,546) * lu(k,1128) + lu(k,1179) = lu(k,1179) - lu(k,533) * lu(k,1172) + lu(k,1188) = lu(k,1188) - lu(k,534) * lu(k,1172) + lu(k,1189) = lu(k,1189) - lu(k,535) * lu(k,1172) + lu(k,1192) = lu(k,1192) - lu(k,536) * lu(k,1172) + lu(k,1193) = lu(k,1193) - lu(k,537) * lu(k,1172) + lu(k,1194) = lu(k,1194) - lu(k,538) * lu(k,1172) + lu(k,1195) = lu(k,1195) - lu(k,539) * lu(k,1172) + lu(k,1196) = lu(k,1196) - lu(k,540) * lu(k,1172) + lu(k,1198) = lu(k,1198) - lu(k,541) * lu(k,1172) + lu(k,1200) = lu(k,1200) - lu(k,542) * lu(k,1172) + lu(k,1201) = lu(k,1201) - lu(k,543) * lu(k,1172) + lu(k,1203) = lu(k,1203) - lu(k,544) * lu(k,1172) + lu(k,1208) = lu(k,1208) - lu(k,545) * lu(k,1172) + lu(k,1209) = lu(k,1209) - lu(k,546) * lu(k,1172) + lu(k,1322) = lu(k,1322) - lu(k,533) * lu(k,1315) + lu(k,1331) = lu(k,1331) - lu(k,534) * lu(k,1315) + lu(k,1332) = lu(k,1332) - lu(k,535) * lu(k,1315) + lu(k,1335) = lu(k,1335) - lu(k,536) * lu(k,1315) + lu(k,1336) = lu(k,1336) - lu(k,537) * lu(k,1315) + lu(k,1337) = lu(k,1337) - lu(k,538) * lu(k,1315) + lu(k,1338) = lu(k,1338) - lu(k,539) * lu(k,1315) + lu(k,1339) = lu(k,1339) - lu(k,540) * lu(k,1315) + lu(k,1341) = lu(k,1341) - lu(k,541) * lu(k,1315) + lu(k,1343) = lu(k,1343) - lu(k,542) * lu(k,1315) + lu(k,1344) = lu(k,1344) - lu(k,543) * lu(k,1315) + lu(k,1346) = lu(k,1346) - lu(k,544) * lu(k,1315) + lu(k,1351) = lu(k,1351) - lu(k,545) * lu(k,1315) + lu(k,1352) = lu(k,1352) - lu(k,546) * lu(k,1315) + lu(k,1401) = lu(k,1401) - lu(k,533) * lu(k,1394) + lu(k,1410) = lu(k,1410) - lu(k,534) * lu(k,1394) + lu(k,1411) = lu(k,1411) - lu(k,535) * lu(k,1394) + lu(k,1414) = lu(k,1414) - lu(k,536) * lu(k,1394) + lu(k,1415) = lu(k,1415) - lu(k,537) * lu(k,1394) + lu(k,1416) = lu(k,1416) - lu(k,538) * lu(k,1394) + lu(k,1417) = lu(k,1417) - lu(k,539) * lu(k,1394) + lu(k,1418) = lu(k,1418) - lu(k,540) * lu(k,1394) + lu(k,1420) = lu(k,1420) - lu(k,541) * lu(k,1394) + lu(k,1422) = lu(k,1422) - lu(k,542) * lu(k,1394) + lu(k,1423) = lu(k,1423) - lu(k,543) * lu(k,1394) + lu(k,1425) = lu(k,1425) - lu(k,544) * lu(k,1394) + lu(k,1430) = lu(k,1430) - lu(k,545) * lu(k,1394) + lu(k,1431) = lu(k,1431) - lu(k,546) * lu(k,1394) + lu(k,1444) = lu(k,1444) - lu(k,533) * lu(k,1437) + lu(k,1453) = lu(k,1453) - lu(k,534) * lu(k,1437) + lu(k,1454) = lu(k,1454) - lu(k,535) * lu(k,1437) + lu(k,1457) = lu(k,1457) - lu(k,536) * lu(k,1437) + lu(k,1458) = lu(k,1458) - lu(k,537) * lu(k,1437) + lu(k,1459) = lu(k,1459) - lu(k,538) * lu(k,1437) + lu(k,1460) = lu(k,1460) - lu(k,539) * lu(k,1437) + lu(k,1461) = lu(k,1461) - lu(k,540) * lu(k,1437) + lu(k,1463) = lu(k,1463) - lu(k,541) * lu(k,1437) + lu(k,1465) = lu(k,1465) - lu(k,542) * lu(k,1437) + lu(k,1466) = lu(k,1466) - lu(k,543) * lu(k,1437) + lu(k,1468) = lu(k,1468) - lu(k,544) * lu(k,1437) + lu(k,1473) = lu(k,1473) - lu(k,545) * lu(k,1437) + lu(k,1474) = lu(k,1474) - lu(k,546) * lu(k,1437) + lu(k,1489) = lu(k,1489) - lu(k,533) * lu(k,1482) + lu(k,1498) = lu(k,1498) - lu(k,534) * lu(k,1482) + lu(k,1499) = lu(k,1499) - lu(k,535) * lu(k,1482) + lu(k,1502) = lu(k,1502) - lu(k,536) * lu(k,1482) + lu(k,1503) = lu(k,1503) - lu(k,537) * lu(k,1482) + lu(k,1504) = lu(k,1504) - lu(k,538) * lu(k,1482) + lu(k,1505) = lu(k,1505) - lu(k,539) * lu(k,1482) + lu(k,1506) = lu(k,1506) - lu(k,540) * lu(k,1482) + lu(k,1508) = lu(k,1508) - lu(k,541) * lu(k,1482) + lu(k,1510) = lu(k,1510) - lu(k,542) * lu(k,1482) + lu(k,1511) = lu(k,1511) - lu(k,543) * lu(k,1482) + lu(k,1513) = lu(k,1513) - lu(k,544) * lu(k,1482) + lu(k,1518) = lu(k,1518) - lu(k,545) * lu(k,1482) + lu(k,1519) = lu(k,1519) - lu(k,546) * lu(k,1482) + lu(k,1570) = lu(k,1570) - lu(k,533) * lu(k,1562) + lu(k,1579) = lu(k,1579) - lu(k,534) * lu(k,1562) + lu(k,1580) = lu(k,1580) - lu(k,535) * lu(k,1562) + lu(k,1583) = lu(k,1583) - lu(k,536) * lu(k,1562) + lu(k,1584) = lu(k,1584) - lu(k,537) * lu(k,1562) + lu(k,1585) = lu(k,1585) - lu(k,538) * lu(k,1562) + lu(k,1586) = lu(k,1586) - lu(k,539) * lu(k,1562) + lu(k,1587) = lu(k,1587) - lu(k,540) * lu(k,1562) + lu(k,1589) = lu(k,1589) - lu(k,541) * lu(k,1562) + lu(k,1591) = lu(k,1591) - lu(k,542) * lu(k,1562) + lu(k,1592) = lu(k,1592) - lu(k,543) * lu(k,1562) + lu(k,1594) = lu(k,1594) - lu(k,544) * lu(k,1562) + lu(k,1599) = lu(k,1599) - lu(k,545) * lu(k,1562) + lu(k,1600) = lu(k,1600) - lu(k,546) * lu(k,1562) + lu(k,1661) = lu(k,1661) - lu(k,533) * lu(k,1654) + lu(k,1670) = lu(k,1670) - lu(k,534) * lu(k,1654) + lu(k,1671) = lu(k,1671) - lu(k,535) * lu(k,1654) + lu(k,1674) = lu(k,1674) - lu(k,536) * lu(k,1654) + lu(k,1675) = lu(k,1675) - lu(k,537) * lu(k,1654) + lu(k,1676) = lu(k,1676) - lu(k,538) * lu(k,1654) + lu(k,1677) = lu(k,1677) - lu(k,539) * lu(k,1654) + lu(k,1678) = lu(k,1678) - lu(k,540) * lu(k,1654) + lu(k,1680) = lu(k,1680) - lu(k,541) * lu(k,1654) + lu(k,1682) = lu(k,1682) - lu(k,542) * lu(k,1654) + lu(k,1683) = lu(k,1683) - lu(k,543) * lu(k,1654) + lu(k,1685) = lu(k,1685) - lu(k,544) * lu(k,1654) + lu(k,1690) = lu(k,1690) - lu(k,545) * lu(k,1654) + lu(k,1691) = lu(k,1691) - lu(k,546) * lu(k,1654) + lu(k,2058) = lu(k,2058) - lu(k,533) * lu(k,2048) + lu(k,2066) = lu(k,2066) - lu(k,534) * lu(k,2048) + lu(k,2067) = lu(k,2067) - lu(k,535) * lu(k,2048) + lu(k,2070) = lu(k,2070) - lu(k,536) * lu(k,2048) + lu(k,2071) = lu(k,2071) - lu(k,537) * lu(k,2048) + lu(k,2072) = lu(k,2072) - lu(k,538) * lu(k,2048) + lu(k,2073) = lu(k,2073) - lu(k,539) * lu(k,2048) + lu(k,2074) = lu(k,2074) - lu(k,540) * lu(k,2048) + lu(k,2076) = lu(k,2076) - lu(k,541) * lu(k,2048) + lu(k,2078) = lu(k,2078) - lu(k,542) * lu(k,2048) + lu(k,2079) = lu(k,2079) - lu(k,543) * lu(k,2048) + lu(k,2081) = lu(k,2081) - lu(k,544) * lu(k,2048) + lu(k,2086) = lu(k,2086) - lu(k,545) * lu(k,2048) + lu(k,2087) = lu(k,2087) - lu(k,546) * lu(k,2048) + lu(k,547) = 1._r8 / lu(k,547) + lu(k,548) = lu(k,548) * lu(k,547) + lu(k,549) = lu(k,549) * lu(k,547) + lu(k,550) = lu(k,550) * lu(k,547) + lu(k,551) = lu(k,551) * lu(k,547) + lu(k,552) = lu(k,552) * lu(k,547) + lu(k,553) = lu(k,553) * lu(k,547) + lu(k,554) = lu(k,554) * lu(k,547) + lu(k,555) = lu(k,555) * lu(k,547) + lu(k,556) = lu(k,556) * lu(k,547) + lu(k,557) = lu(k,557) * lu(k,547) + lu(k,558) = lu(k,558) * lu(k,547) + lu(k,559) = lu(k,559) * lu(k,547) + lu(k,560) = lu(k,560) * lu(k,547) + lu(k,669) = lu(k,669) - lu(k,548) * lu(k,665) + lu(k,671) = lu(k,671) - lu(k,549) * lu(k,665) + lu(k,672) = lu(k,672) - lu(k,550) * lu(k,665) + lu(k,674) = lu(k,674) - lu(k,551) * lu(k,665) + lu(k,675) = lu(k,675) - lu(k,552) * lu(k,665) + lu(k,676) = lu(k,676) - lu(k,553) * lu(k,665) + lu(k,677) = lu(k,677) - lu(k,554) * lu(k,665) + lu(k,678) = lu(k,678) - lu(k,555) * lu(k,665) + lu(k,679) = lu(k,679) - lu(k,556) * lu(k,665) + lu(k,680) = lu(k,680) - lu(k,557) * lu(k,665) + lu(k,681) = lu(k,681) - lu(k,558) * lu(k,665) + lu(k,682) = lu(k,682) - lu(k,559) * lu(k,665) + lu(k,684) = lu(k,684) - lu(k,560) * lu(k,665) + lu(k,923) = lu(k,923) - lu(k,548) * lu(k,920) + lu(k,927) = lu(k,927) - lu(k,549) * lu(k,920) + lu(k,928) = lu(k,928) - lu(k,550) * lu(k,920) + lu(k,931) = lu(k,931) - lu(k,551) * lu(k,920) + lu(k,932) = lu(k,932) - lu(k,552) * lu(k,920) + lu(k,933) = lu(k,933) - lu(k,553) * lu(k,920) + lu(k,934) = lu(k,934) - lu(k,554) * lu(k,920) + lu(k,936) = lu(k,936) - lu(k,555) * lu(k,920) + lu(k,937) = lu(k,937) - lu(k,556) * lu(k,920) + lu(k,938) = lu(k,938) - lu(k,557) * lu(k,920) + lu(k,939) = lu(k,939) - lu(k,558) * lu(k,920) + lu(k,941) = lu(k,941) - lu(k,559) * lu(k,920) + lu(k,945) = lu(k,945) - lu(k,560) * lu(k,920) + lu(k,1140) = lu(k,1140) - lu(k,548) * lu(k,1129) + lu(k,1145) = lu(k,1145) - lu(k,549) * lu(k,1129) + lu(k,1146) = lu(k,1146) - lu(k,550) * lu(k,1129) + lu(k,1149) = lu(k,1149) - lu(k,551) * lu(k,1129) + lu(k,1150) = lu(k,1150) - lu(k,552) * lu(k,1129) + lu(k,1151) = lu(k,1151) - lu(k,553) * lu(k,1129) + lu(k,1152) = lu(k,1152) - lu(k,554) * lu(k,1129) + lu(k,1155) = lu(k,1155) - lu(k,555) * lu(k,1129) + lu(k,1156) = lu(k,1156) - lu(k,556) * lu(k,1129) + lu(k,1157) = lu(k,1157) - lu(k,557) * lu(k,1129) + lu(k,1158) = lu(k,1158) - lu(k,558) * lu(k,1129) + lu(k,1160) = lu(k,1160) - lu(k,559) * lu(k,1129) + lu(k,1166) = lu(k,1166) - lu(k,560) * lu(k,1129) + lu(k,1183) = lu(k,1183) - lu(k,548) * lu(k,1173) + lu(k,1188) = lu(k,1188) - lu(k,549) * lu(k,1173) + lu(k,1189) = lu(k,1189) - lu(k,550) * lu(k,1173) + lu(k,1192) = lu(k,1192) - lu(k,551) * lu(k,1173) + lu(k,1193) = lu(k,1193) - lu(k,552) * lu(k,1173) + lu(k,1194) = lu(k,1194) - lu(k,553) * lu(k,1173) + lu(k,1195) = lu(k,1195) - lu(k,554) * lu(k,1173) + lu(k,1198) = lu(k,1198) - lu(k,555) * lu(k,1173) + lu(k,1199) = lu(k,1199) - lu(k,556) * lu(k,1173) + lu(k,1200) = lu(k,1200) - lu(k,557) * lu(k,1173) + lu(k,1201) = lu(k,1201) - lu(k,558) * lu(k,1173) + lu(k,1203) = lu(k,1203) - lu(k,559) * lu(k,1173) + lu(k,1209) = lu(k,1209) - lu(k,560) * lu(k,1173) + lu(k,1326) = lu(k,1326) - lu(k,548) * lu(k,1316) + lu(k,1331) = lu(k,1331) - lu(k,549) * lu(k,1316) + lu(k,1332) = lu(k,1332) - lu(k,550) * lu(k,1316) + lu(k,1335) = lu(k,1335) - lu(k,551) * lu(k,1316) + lu(k,1336) = lu(k,1336) - lu(k,552) * lu(k,1316) + lu(k,1337) = lu(k,1337) - lu(k,553) * lu(k,1316) + lu(k,1338) = lu(k,1338) - lu(k,554) * lu(k,1316) + lu(k,1341) = lu(k,1341) - lu(k,555) * lu(k,1316) + lu(k,1342) = lu(k,1342) - lu(k,556) * lu(k,1316) + lu(k,1343) = lu(k,1343) - lu(k,557) * lu(k,1316) + lu(k,1344) = lu(k,1344) - lu(k,558) * lu(k,1316) + lu(k,1346) = lu(k,1346) - lu(k,559) * lu(k,1316) + lu(k,1352) = lu(k,1352) - lu(k,560) * lu(k,1316) + lu(k,1405) = lu(k,1405) - lu(k,548) * lu(k,1395) + lu(k,1410) = lu(k,1410) - lu(k,549) * lu(k,1395) + lu(k,1411) = lu(k,1411) - lu(k,550) * lu(k,1395) + lu(k,1414) = lu(k,1414) - lu(k,551) * lu(k,1395) + lu(k,1415) = lu(k,1415) - lu(k,552) * lu(k,1395) + lu(k,1416) = lu(k,1416) - lu(k,553) * lu(k,1395) + lu(k,1417) = lu(k,1417) - lu(k,554) * lu(k,1395) + lu(k,1420) = lu(k,1420) - lu(k,555) * lu(k,1395) + lu(k,1421) = lu(k,1421) - lu(k,556) * lu(k,1395) + lu(k,1422) = lu(k,1422) - lu(k,557) * lu(k,1395) + lu(k,1423) = lu(k,1423) - lu(k,558) * lu(k,1395) + lu(k,1425) = lu(k,1425) - lu(k,559) * lu(k,1395) + lu(k,1431) = lu(k,1431) - lu(k,560) * lu(k,1395) + lu(k,1448) = lu(k,1448) - lu(k,548) * lu(k,1438) + lu(k,1453) = lu(k,1453) - lu(k,549) * lu(k,1438) + lu(k,1454) = lu(k,1454) - lu(k,550) * lu(k,1438) + lu(k,1457) = lu(k,1457) - lu(k,551) * lu(k,1438) + lu(k,1458) = lu(k,1458) - lu(k,552) * lu(k,1438) + lu(k,1459) = lu(k,1459) - lu(k,553) * lu(k,1438) + lu(k,1460) = lu(k,1460) - lu(k,554) * lu(k,1438) + lu(k,1463) = lu(k,1463) - lu(k,555) * lu(k,1438) + lu(k,1464) = lu(k,1464) - lu(k,556) * lu(k,1438) + lu(k,1465) = lu(k,1465) - lu(k,557) * lu(k,1438) + lu(k,1466) = lu(k,1466) - lu(k,558) * lu(k,1438) + lu(k,1468) = lu(k,1468) - lu(k,559) * lu(k,1438) + lu(k,1474) = lu(k,1474) - lu(k,560) * lu(k,1438) + lu(k,1574) = lu(k,1574) - lu(k,548) * lu(k,1563) + lu(k,1579) = lu(k,1579) - lu(k,549) * lu(k,1563) + lu(k,1580) = lu(k,1580) - lu(k,550) * lu(k,1563) + lu(k,1583) = lu(k,1583) - lu(k,551) * lu(k,1563) + lu(k,1584) = lu(k,1584) - lu(k,552) * lu(k,1563) + lu(k,1585) = lu(k,1585) - lu(k,553) * lu(k,1563) + lu(k,1586) = lu(k,1586) - lu(k,554) * lu(k,1563) + lu(k,1589) = lu(k,1589) - lu(k,555) * lu(k,1563) + lu(k,1590) = lu(k,1590) - lu(k,556) * lu(k,1563) + lu(k,1591) = lu(k,1591) - lu(k,557) * lu(k,1563) + lu(k,1592) = lu(k,1592) - lu(k,558) * lu(k,1563) + lu(k,1594) = lu(k,1594) - lu(k,559) * lu(k,1563) + lu(k,1600) = lu(k,1600) - lu(k,560) * lu(k,1563) + lu(k,1665) = lu(k,1665) - lu(k,548) * lu(k,1655) + lu(k,1670) = lu(k,1670) - lu(k,549) * lu(k,1655) + lu(k,1671) = lu(k,1671) - lu(k,550) * lu(k,1655) + lu(k,1674) = lu(k,1674) - lu(k,551) * lu(k,1655) + lu(k,1675) = lu(k,1675) - lu(k,552) * lu(k,1655) + lu(k,1676) = lu(k,1676) - lu(k,553) * lu(k,1655) + lu(k,1677) = lu(k,1677) - lu(k,554) * lu(k,1655) + lu(k,1680) = lu(k,1680) - lu(k,555) * lu(k,1655) + lu(k,1681) = lu(k,1681) - lu(k,556) * lu(k,1655) + lu(k,1682) = lu(k,1682) - lu(k,557) * lu(k,1655) + lu(k,1683) = lu(k,1683) - lu(k,558) * lu(k,1655) + lu(k,1685) = lu(k,1685) - lu(k,559) * lu(k,1655) + lu(k,1691) = lu(k,1691) - lu(k,560) * lu(k,1655) + lu(k,1707) = lu(k,1707) - lu(k,548) * lu(k,1696) + lu(k,1712) = lu(k,1712) - lu(k,549) * lu(k,1696) + lu(k,1713) = - lu(k,550) * lu(k,1696) + lu(k,1716) = - lu(k,551) * lu(k,1696) + lu(k,1717) = lu(k,1717) - lu(k,552) * lu(k,1696) + lu(k,1718) = - lu(k,553) * lu(k,1696) + lu(k,1719) = - lu(k,554) * lu(k,1696) + lu(k,1722) = lu(k,1722) - lu(k,555) * lu(k,1696) + lu(k,1723) = lu(k,1723) - lu(k,556) * lu(k,1696) + lu(k,1724) = - lu(k,557) * lu(k,1696) + lu(k,1725) = lu(k,1725) - lu(k,558) * lu(k,1696) + lu(k,1727) = lu(k,1727) - lu(k,559) * lu(k,1696) + lu(k,1733) = lu(k,1733) - lu(k,560) * lu(k,1696) + lu(k,2061) = lu(k,2061) - lu(k,548) * lu(k,2049) + lu(k,2066) = lu(k,2066) - lu(k,549) * lu(k,2049) + lu(k,2067) = lu(k,2067) - lu(k,550) * lu(k,2049) + lu(k,2070) = lu(k,2070) - lu(k,551) * lu(k,2049) + lu(k,2071) = lu(k,2071) - lu(k,552) * lu(k,2049) + lu(k,2072) = lu(k,2072) - lu(k,553) * lu(k,2049) + lu(k,2073) = lu(k,2073) - lu(k,554) * lu(k,2049) + lu(k,2076) = lu(k,2076) - lu(k,555) * lu(k,2049) + lu(k,2077) = lu(k,2077) - lu(k,556) * lu(k,2049) + lu(k,2078) = lu(k,2078) - lu(k,557) * lu(k,2049) + lu(k,2079) = lu(k,2079) - lu(k,558) * lu(k,2049) + lu(k,2081) = lu(k,2081) - lu(k,559) * lu(k,2049) + lu(k,2087) = lu(k,2087) - lu(k,560) * lu(k,2049) + lu(k,561) = 1._r8 / lu(k,561) + lu(k,562) = lu(k,562) * lu(k,561) + lu(k,563) = lu(k,563) * lu(k,561) + lu(k,564) = lu(k,564) * lu(k,561) + lu(k,565) = lu(k,565) * lu(k,561) + lu(k,566) = lu(k,566) * lu(k,561) + lu(k,567) = lu(k,567) * lu(k,561) + lu(k,568) = lu(k,568) * lu(k,561) + lu(k,569) = lu(k,569) * lu(k,561) + lu(k,570) = lu(k,570) * lu(k,561) + lu(k,571) = lu(k,571) * lu(k,561) + lu(k,572) = lu(k,572) * lu(k,561) + lu(k,573) = lu(k,573) * lu(k,561) + lu(k,574) = lu(k,574) * lu(k,561) + lu(k,575) = lu(k,575) * lu(k,561) + lu(k,576) = lu(k,576) * lu(k,561) + lu(k,860) = lu(k,860) - lu(k,562) * lu(k,859) + lu(k,866) = lu(k,866) - lu(k,563) * lu(k,859) + lu(k,867) = lu(k,867) - lu(k,564) * lu(k,859) + lu(k,868) = lu(k,868) - lu(k,565) * lu(k,859) + lu(k,869) = lu(k,869) - lu(k,566) * lu(k,859) + lu(k,871) = lu(k,871) - lu(k,567) * lu(k,859) + lu(k,872) = - lu(k,568) * lu(k,859) + lu(k,873) = lu(k,873) - lu(k,569) * lu(k,859) + lu(k,874) = lu(k,874) - lu(k,570) * lu(k,859) + lu(k,875) = lu(k,875) - lu(k,571) * lu(k,859) + lu(k,876) = lu(k,876) - lu(k,572) * lu(k,859) + lu(k,878) = lu(k,878) - lu(k,573) * lu(k,859) + lu(k,879) = lu(k,879) - lu(k,574) * lu(k,859) + lu(k,880) = lu(k,880) - lu(k,575) * lu(k,859) + lu(k,883) = lu(k,883) - lu(k,576) * lu(k,859) + lu(k,1131) = lu(k,1131) - lu(k,562) * lu(k,1130) + lu(k,1144) = lu(k,1144) - lu(k,563) * lu(k,1130) + lu(k,1145) = lu(k,1145) - lu(k,564) * lu(k,1130) + lu(k,1146) = lu(k,1146) - lu(k,565) * lu(k,1130) + lu(k,1147) = lu(k,1147) - lu(k,566) * lu(k,1130) + lu(k,1149) = lu(k,1149) - lu(k,567) * lu(k,1130) + lu(k,1150) = lu(k,1150) - lu(k,568) * lu(k,1130) + lu(k,1151) = lu(k,1151) - lu(k,569) * lu(k,1130) + lu(k,1152) = lu(k,1152) - lu(k,570) * lu(k,1130) + lu(k,1153) = lu(k,1153) - lu(k,571) * lu(k,1130) + lu(k,1155) = lu(k,1155) - lu(k,572) * lu(k,1130) + lu(k,1157) = lu(k,1157) - lu(k,573) * lu(k,1130) + lu(k,1158) = lu(k,1158) - lu(k,574) * lu(k,1130) + lu(k,1160) = lu(k,1160) - lu(k,575) * lu(k,1130) + lu(k,1166) = lu(k,1166) - lu(k,576) * lu(k,1130) + lu(k,1175) = lu(k,1175) - lu(k,562) * lu(k,1174) + lu(k,1187) = lu(k,1187) - lu(k,563) * lu(k,1174) + lu(k,1188) = lu(k,1188) - lu(k,564) * lu(k,1174) + lu(k,1189) = lu(k,1189) - lu(k,565) * lu(k,1174) + lu(k,1190) = lu(k,1190) - lu(k,566) * lu(k,1174) + lu(k,1192) = lu(k,1192) - lu(k,567) * lu(k,1174) + lu(k,1193) = lu(k,1193) - lu(k,568) * lu(k,1174) + lu(k,1194) = lu(k,1194) - lu(k,569) * lu(k,1174) + lu(k,1195) = lu(k,1195) - lu(k,570) * lu(k,1174) + lu(k,1196) = lu(k,1196) - lu(k,571) * lu(k,1174) + lu(k,1198) = lu(k,1198) - lu(k,572) * lu(k,1174) + lu(k,1200) = lu(k,1200) - lu(k,573) * lu(k,1174) + lu(k,1201) = lu(k,1201) - lu(k,574) * lu(k,1174) + lu(k,1203) = lu(k,1203) - lu(k,575) * lu(k,1174) + lu(k,1209) = lu(k,1209) - lu(k,576) * lu(k,1174) + lu(k,1216) = lu(k,1216) - lu(k,562) * lu(k,1215) + lu(k,1228) = lu(k,1228) - lu(k,563) * lu(k,1215) + lu(k,1229) = - lu(k,564) * lu(k,1215) + lu(k,1230) = - lu(k,565) * lu(k,1215) + lu(k,1231) = lu(k,1231) - lu(k,566) * lu(k,1215) + lu(k,1233) = - lu(k,567) * lu(k,1215) + lu(k,1234) = lu(k,1234) - lu(k,568) * lu(k,1215) + lu(k,1235) = - lu(k,569) * lu(k,1215) + lu(k,1236) = - lu(k,570) * lu(k,1215) + lu(k,1237) = lu(k,1237) - lu(k,571) * lu(k,1215) + lu(k,1239) = - lu(k,572) * lu(k,1215) + lu(k,1241) = - lu(k,573) * lu(k,1215) + lu(k,1242) = lu(k,1242) - lu(k,574) * lu(k,1215) + lu(k,1244) = lu(k,1244) - lu(k,575) * lu(k,1215) + lu(k,1250) = lu(k,1250) - lu(k,576) * lu(k,1215) + lu(k,1318) = lu(k,1318) - lu(k,562) * lu(k,1317) + lu(k,1330) = lu(k,1330) - lu(k,563) * lu(k,1317) + lu(k,1331) = lu(k,1331) - lu(k,564) * lu(k,1317) + lu(k,1332) = lu(k,1332) - lu(k,565) * lu(k,1317) + lu(k,1333) = lu(k,1333) - lu(k,566) * lu(k,1317) + lu(k,1335) = lu(k,1335) - lu(k,567) * lu(k,1317) + lu(k,1336) = lu(k,1336) - lu(k,568) * lu(k,1317) + lu(k,1337) = lu(k,1337) - lu(k,569) * lu(k,1317) + lu(k,1338) = lu(k,1338) - lu(k,570) * lu(k,1317) + lu(k,1339) = lu(k,1339) - lu(k,571) * lu(k,1317) + lu(k,1341) = lu(k,1341) - lu(k,572) * lu(k,1317) + lu(k,1343) = lu(k,1343) - lu(k,573) * lu(k,1317) + lu(k,1344) = lu(k,1344) - lu(k,574) * lu(k,1317) + lu(k,1346) = lu(k,1346) - lu(k,575) * lu(k,1317) + lu(k,1352) = lu(k,1352) - lu(k,576) * lu(k,1317) + lu(k,1397) = lu(k,1397) - lu(k,562) * lu(k,1396) + lu(k,1409) = lu(k,1409) - lu(k,563) * lu(k,1396) + lu(k,1410) = lu(k,1410) - lu(k,564) * lu(k,1396) + lu(k,1411) = lu(k,1411) - lu(k,565) * lu(k,1396) + lu(k,1412) = lu(k,1412) - lu(k,566) * lu(k,1396) + lu(k,1414) = lu(k,1414) - lu(k,567) * lu(k,1396) + lu(k,1415) = lu(k,1415) - lu(k,568) * lu(k,1396) + lu(k,1416) = lu(k,1416) - lu(k,569) * lu(k,1396) + lu(k,1417) = lu(k,1417) - lu(k,570) * lu(k,1396) + lu(k,1418) = lu(k,1418) - lu(k,571) * lu(k,1396) + lu(k,1420) = lu(k,1420) - lu(k,572) * lu(k,1396) + lu(k,1422) = lu(k,1422) - lu(k,573) * lu(k,1396) + lu(k,1423) = lu(k,1423) - lu(k,574) * lu(k,1396) + lu(k,1425) = lu(k,1425) - lu(k,575) * lu(k,1396) + lu(k,1431) = lu(k,1431) - lu(k,576) * lu(k,1396) + lu(k,1440) = lu(k,1440) - lu(k,562) * lu(k,1439) + lu(k,1452) = lu(k,1452) - lu(k,563) * lu(k,1439) + lu(k,1453) = lu(k,1453) - lu(k,564) * lu(k,1439) + lu(k,1454) = lu(k,1454) - lu(k,565) * lu(k,1439) + lu(k,1455) = lu(k,1455) - lu(k,566) * lu(k,1439) + lu(k,1457) = lu(k,1457) - lu(k,567) * lu(k,1439) + lu(k,1458) = lu(k,1458) - lu(k,568) * lu(k,1439) + lu(k,1459) = lu(k,1459) - lu(k,569) * lu(k,1439) + lu(k,1460) = lu(k,1460) - lu(k,570) * lu(k,1439) + lu(k,1461) = lu(k,1461) - lu(k,571) * lu(k,1439) + lu(k,1463) = lu(k,1463) - lu(k,572) * lu(k,1439) + lu(k,1465) = lu(k,1465) - lu(k,573) * lu(k,1439) + lu(k,1466) = lu(k,1466) - lu(k,574) * lu(k,1439) + lu(k,1468) = lu(k,1468) - lu(k,575) * lu(k,1439) + lu(k,1474) = lu(k,1474) - lu(k,576) * lu(k,1439) + lu(k,1485) = - lu(k,562) * lu(k,1483) + lu(k,1497) = lu(k,1497) - lu(k,563) * lu(k,1483) + lu(k,1498) = lu(k,1498) - lu(k,564) * lu(k,1483) + lu(k,1499) = lu(k,1499) - lu(k,565) * lu(k,1483) + lu(k,1500) = lu(k,1500) - lu(k,566) * lu(k,1483) + lu(k,1502) = lu(k,1502) - lu(k,567) * lu(k,1483) + lu(k,1503) = lu(k,1503) - lu(k,568) * lu(k,1483) + lu(k,1504) = lu(k,1504) - lu(k,569) * lu(k,1483) + lu(k,1505) = lu(k,1505) - lu(k,570) * lu(k,1483) + lu(k,1506) = lu(k,1506) - lu(k,571) * lu(k,1483) + lu(k,1508) = lu(k,1508) - lu(k,572) * lu(k,1483) + lu(k,1510) = lu(k,1510) - lu(k,573) * lu(k,1483) + lu(k,1511) = lu(k,1511) - lu(k,574) * lu(k,1483) + lu(k,1513) = lu(k,1513) - lu(k,575) * lu(k,1483) + lu(k,1519) = lu(k,1519) - lu(k,576) * lu(k,1483) + lu(k,1565) = lu(k,1565) - lu(k,562) * lu(k,1564) + lu(k,1578) = lu(k,1578) - lu(k,563) * lu(k,1564) + lu(k,1579) = lu(k,1579) - lu(k,564) * lu(k,1564) + lu(k,1580) = lu(k,1580) - lu(k,565) * lu(k,1564) + lu(k,1581) = lu(k,1581) - lu(k,566) * lu(k,1564) + lu(k,1583) = lu(k,1583) - lu(k,567) * lu(k,1564) + lu(k,1584) = lu(k,1584) - lu(k,568) * lu(k,1564) + lu(k,1585) = lu(k,1585) - lu(k,569) * lu(k,1564) + lu(k,1586) = lu(k,1586) - lu(k,570) * lu(k,1564) + lu(k,1587) = lu(k,1587) - lu(k,571) * lu(k,1564) + lu(k,1589) = lu(k,1589) - lu(k,572) * lu(k,1564) + lu(k,1591) = lu(k,1591) - lu(k,573) * lu(k,1564) + lu(k,1592) = lu(k,1592) - lu(k,574) * lu(k,1564) + lu(k,1594) = lu(k,1594) - lu(k,575) * lu(k,1564) + lu(k,1600) = lu(k,1600) - lu(k,576) * lu(k,1564) + lu(k,1657) = lu(k,1657) - lu(k,562) * lu(k,1656) + lu(k,1669) = lu(k,1669) - lu(k,563) * lu(k,1656) + lu(k,1670) = lu(k,1670) - lu(k,564) * lu(k,1656) + lu(k,1671) = lu(k,1671) - lu(k,565) * lu(k,1656) + lu(k,1672) = lu(k,1672) - lu(k,566) * lu(k,1656) + lu(k,1674) = lu(k,1674) - lu(k,567) * lu(k,1656) + lu(k,1675) = lu(k,1675) - lu(k,568) * lu(k,1656) + lu(k,1676) = lu(k,1676) - lu(k,569) * lu(k,1656) + lu(k,1677) = lu(k,1677) - lu(k,570) * lu(k,1656) + lu(k,1678) = lu(k,1678) - lu(k,571) * lu(k,1656) + lu(k,1680) = lu(k,1680) - lu(k,572) * lu(k,1656) + lu(k,1682) = lu(k,1682) - lu(k,573) * lu(k,1656) + lu(k,1683) = lu(k,1683) - lu(k,574) * lu(k,1656) + lu(k,1685) = lu(k,1685) - lu(k,575) * lu(k,1656) + lu(k,1691) = lu(k,1691) - lu(k,576) * lu(k,1656) end do end subroutine lu_fac14 subroutine lu_fac15( avec_len, lu ) @@ -4011,795 +3360,366 @@ subroutine lu_fac15( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - 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,571) = lu(k,571) * lu(k,560) - lu(k,572) = lu(k,572) * lu(k,560) - lu(k,573) = lu(k,573) * lu(k,560) - lu(k,574) = lu(k,574) * lu(k,560) - lu(k,575) = lu(k,575) * lu(k,560) - lu(k,576) = lu(k,576) * lu(k,560) - lu(k,713) = lu(k,713) - lu(k,561) * lu(k,711) - lu(k,715) = lu(k,715) - lu(k,562) * lu(k,711) - lu(k,716) = lu(k,716) - lu(k,563) * lu(k,711) - lu(k,717) = - lu(k,564) * lu(k,711) - lu(k,718) = lu(k,718) - lu(k,565) * lu(k,711) - lu(k,719) = lu(k,719) - lu(k,566) * lu(k,711) - lu(k,720) = lu(k,720) - lu(k,567) * lu(k,711) - lu(k,723) = lu(k,723) - lu(k,568) * lu(k,711) - lu(k,724) = lu(k,724) - lu(k,569) * lu(k,711) - lu(k,725) = lu(k,725) - lu(k,570) * lu(k,711) - lu(k,726) = lu(k,726) - lu(k,571) * lu(k,711) - lu(k,728) = lu(k,728) - lu(k,572) * lu(k,711) - lu(k,730) = lu(k,730) - lu(k,573) * lu(k,711) - lu(k,731) = lu(k,731) - lu(k,574) * lu(k,711) - lu(k,732) = lu(k,732) - lu(k,575) * lu(k,711) - lu(k,733) = lu(k,733) - lu(k,576) * lu(k,711) - lu(k,820) = lu(k,820) - lu(k,561) * lu(k,818) - lu(k,824) = lu(k,824) - lu(k,562) * lu(k,818) - lu(k,825) = lu(k,825) - lu(k,563) * lu(k,818) - lu(k,826) = lu(k,826) - lu(k,564) * lu(k,818) - lu(k,827) = lu(k,827) - lu(k,565) * lu(k,818) - lu(k,828) = lu(k,828) - lu(k,566) * lu(k,818) - lu(k,829) = - lu(k,567) * lu(k,818) - lu(k,832) = lu(k,832) - lu(k,568) * lu(k,818) - lu(k,833) = lu(k,833) - lu(k,569) * lu(k,818) - lu(k,835) = lu(k,835) - lu(k,570) * lu(k,818) - lu(k,836) = lu(k,836) - lu(k,571) * lu(k,818) - lu(k,838) = lu(k,838) - lu(k,572) * lu(k,818) - lu(k,840) = lu(k,840) - lu(k,573) * lu(k,818) - lu(k,843) = lu(k,843) - lu(k,574) * lu(k,818) - lu(k,845) = lu(k,845) - lu(k,575) * lu(k,818) - lu(k,846) = lu(k,846) - lu(k,576) * lu(k,818) - lu(k,895) = lu(k,895) - lu(k,561) * lu(k,891) - lu(k,900) = lu(k,900) - lu(k,562) * lu(k,891) - lu(k,901) = lu(k,901) - lu(k,563) * lu(k,891) - lu(k,902) = lu(k,902) - lu(k,564) * lu(k,891) - lu(k,903) = lu(k,903) - lu(k,565) * lu(k,891) - lu(k,904) = lu(k,904) - lu(k,566) * lu(k,891) - lu(k,905) = lu(k,905) - lu(k,567) * lu(k,891) - lu(k,908) = lu(k,908) - lu(k,568) * lu(k,891) - lu(k,909) = lu(k,909) - lu(k,569) * lu(k,891) - lu(k,911) = lu(k,911) - lu(k,570) * lu(k,891) - lu(k,912) = lu(k,912) - lu(k,571) * lu(k,891) - lu(k,914) = lu(k,914) - lu(k,572) * lu(k,891) - lu(k,916) = lu(k,916) - lu(k,573) * lu(k,891) - lu(k,919) = lu(k,919) - lu(k,574) * lu(k,891) - lu(k,921) = lu(k,921) - lu(k,575) * lu(k,891) - lu(k,922) = lu(k,922) - lu(k,576) * lu(k,891) - lu(k,937) = lu(k,937) - lu(k,561) * lu(k,934) - lu(k,942) = lu(k,942) - lu(k,562) * lu(k,934) - lu(k,943) = lu(k,943) - lu(k,563) * lu(k,934) - lu(k,944) = lu(k,944) - lu(k,564) * lu(k,934) - lu(k,945) = lu(k,945) - lu(k,565) * lu(k,934) - lu(k,946) = lu(k,946) - lu(k,566) * lu(k,934) - lu(k,947) = lu(k,947) - lu(k,567) * lu(k,934) - lu(k,950) = lu(k,950) - lu(k,568) * lu(k,934) - lu(k,951) = lu(k,951) - lu(k,569) * lu(k,934) - lu(k,953) = lu(k,953) - lu(k,570) * lu(k,934) - lu(k,954) = lu(k,954) - lu(k,571) * lu(k,934) - lu(k,956) = lu(k,956) - lu(k,572) * lu(k,934) - lu(k,958) = lu(k,958) - lu(k,573) * lu(k,934) - lu(k,961) = lu(k,961) - lu(k,574) * lu(k,934) - lu(k,963) = lu(k,963) - lu(k,575) * lu(k,934) - lu(k,964) = lu(k,964) - lu(k,576) * lu(k,934) - lu(k,983) = lu(k,983) - lu(k,561) * lu(k,978) - lu(k,988) = lu(k,988) - lu(k,562) * lu(k,978) - lu(k,989) = lu(k,989) - lu(k,563) * lu(k,978) - lu(k,990) = lu(k,990) - lu(k,564) * lu(k,978) - lu(k,991) = lu(k,991) - lu(k,565) * lu(k,978) - lu(k,992) = lu(k,992) - lu(k,566) * lu(k,978) - lu(k,993) = lu(k,993) - lu(k,567) * lu(k,978) - lu(k,996) = lu(k,996) - lu(k,568) * lu(k,978) - lu(k,997) = lu(k,997) - lu(k,569) * lu(k,978) - lu(k,999) = lu(k,999) - lu(k,570) * lu(k,978) - lu(k,1000) = lu(k,1000) - lu(k,571) * lu(k,978) - lu(k,1002) = lu(k,1002) - lu(k,572) * lu(k,978) - lu(k,1004) = lu(k,1004) - lu(k,573) * lu(k,978) - lu(k,1007) = lu(k,1007) - lu(k,574) * lu(k,978) - lu(k,1009) = lu(k,1009) - lu(k,575) * lu(k,978) - lu(k,1010) = lu(k,1010) - lu(k,576) * lu(k,978) - lu(k,1025) = lu(k,1025) - lu(k,561) * lu(k,1022) - lu(k,1030) = lu(k,1030) - lu(k,562) * lu(k,1022) - lu(k,1031) = lu(k,1031) - lu(k,563) * lu(k,1022) - lu(k,1032) = lu(k,1032) - lu(k,564) * lu(k,1022) - lu(k,1033) = lu(k,1033) - lu(k,565) * lu(k,1022) - lu(k,1034) = lu(k,1034) - lu(k,566) * lu(k,1022) - lu(k,1035) = lu(k,1035) - lu(k,567) * lu(k,1022) - lu(k,1038) = lu(k,1038) - lu(k,568) * lu(k,1022) - lu(k,1039) = lu(k,1039) - lu(k,569) * lu(k,1022) - lu(k,1041) = lu(k,1041) - lu(k,570) * lu(k,1022) - lu(k,1042) = lu(k,1042) - lu(k,571) * lu(k,1022) - lu(k,1044) = lu(k,1044) - lu(k,572) * lu(k,1022) - lu(k,1046) = lu(k,1046) - lu(k,573) * lu(k,1022) - lu(k,1049) = lu(k,1049) - lu(k,574) * lu(k,1022) - lu(k,1051) = lu(k,1051) - lu(k,575) * lu(k,1022) - lu(k,1052) = lu(k,1052) - lu(k,576) * lu(k,1022) - lu(k,1066) = lu(k,1066) - lu(k,561) * lu(k,1063) - lu(k,1071) = lu(k,1071) - lu(k,562) * lu(k,1063) - lu(k,1072) = lu(k,1072) - lu(k,563) * lu(k,1063) - lu(k,1073) = lu(k,1073) - lu(k,564) * lu(k,1063) - lu(k,1074) = lu(k,1074) - lu(k,565) * lu(k,1063) - lu(k,1075) = lu(k,1075) - lu(k,566) * lu(k,1063) - lu(k,1076) = lu(k,1076) - lu(k,567) * lu(k,1063) - lu(k,1079) = lu(k,1079) - lu(k,568) * lu(k,1063) - lu(k,1080) = lu(k,1080) - lu(k,569) * lu(k,1063) - lu(k,1082) = lu(k,1082) - lu(k,570) * lu(k,1063) - lu(k,1083) = lu(k,1083) - lu(k,571) * lu(k,1063) - lu(k,1085) = lu(k,1085) - lu(k,572) * lu(k,1063) - lu(k,1087) = lu(k,1087) - lu(k,573) * lu(k,1063) - lu(k,1090) = lu(k,1090) - lu(k,574) * lu(k,1063) - lu(k,1092) = lu(k,1092) - lu(k,575) * lu(k,1063) - lu(k,1093) = lu(k,1093) - lu(k,576) * lu(k,1063) - lu(k,1106) = lu(k,1106) - lu(k,561) * lu(k,1102) - lu(k,1110) = lu(k,1110) - lu(k,562) * lu(k,1102) - lu(k,1111) = lu(k,1111) - lu(k,563) * lu(k,1102) - lu(k,1112) = lu(k,1112) - lu(k,564) * lu(k,1102) - lu(k,1113) = lu(k,1113) - lu(k,565) * lu(k,1102) - lu(k,1114) = lu(k,1114) - lu(k,566) * lu(k,1102) - lu(k,1115) = lu(k,1115) - lu(k,567) * lu(k,1102) - lu(k,1118) = lu(k,1118) - lu(k,568) * lu(k,1102) - lu(k,1119) = lu(k,1119) - lu(k,569) * lu(k,1102) - lu(k,1121) = lu(k,1121) - lu(k,570) * lu(k,1102) - lu(k,1122) = lu(k,1122) - lu(k,571) * lu(k,1102) - lu(k,1124) = lu(k,1124) - lu(k,572) * lu(k,1102) - lu(k,1126) = lu(k,1126) - lu(k,573) * lu(k,1102) - lu(k,1129) = lu(k,1129) - lu(k,574) * lu(k,1102) - lu(k,1131) = lu(k,1131) - lu(k,575) * lu(k,1102) - lu(k,1132) = lu(k,1132) - lu(k,576) * lu(k,1102) - lu(k,1278) = lu(k,1278) - lu(k,561) * lu(k,1274) - lu(k,1283) = lu(k,1283) - lu(k,562) * lu(k,1274) - lu(k,1284) = lu(k,1284) - lu(k,563) * lu(k,1274) - lu(k,1285) = lu(k,1285) - lu(k,564) * lu(k,1274) - lu(k,1286) = lu(k,1286) - lu(k,565) * lu(k,1274) - lu(k,1287) = lu(k,1287) - lu(k,566) * lu(k,1274) - lu(k,1288) = lu(k,1288) - lu(k,567) * lu(k,1274) - lu(k,1291) = lu(k,1291) - lu(k,568) * lu(k,1274) - lu(k,1292) = lu(k,1292) - lu(k,569) * lu(k,1274) - lu(k,1294) = lu(k,1294) - lu(k,570) * lu(k,1274) - lu(k,1295) = lu(k,1295) - lu(k,571) * lu(k,1274) - lu(k,1297) = lu(k,1297) - lu(k,572) * lu(k,1274) - lu(k,1299) = lu(k,1299) - lu(k,573) * lu(k,1274) - lu(k,1302) = lu(k,1302) - lu(k,574) * lu(k,1274) - lu(k,1304) = lu(k,1304) - lu(k,575) * lu(k,1274) - lu(k,1305) = lu(k,1305) - lu(k,576) * lu(k,1274) - lu(k,1357) = lu(k,1357) - lu(k,561) * lu(k,1353) - lu(k,1362) = lu(k,1362) - lu(k,562) * lu(k,1353) - lu(k,1363) = lu(k,1363) - lu(k,563) * lu(k,1353) - lu(k,1364) = lu(k,1364) - lu(k,564) * lu(k,1353) - lu(k,1365) = lu(k,1365) - lu(k,565) * lu(k,1353) - lu(k,1366) = lu(k,1366) - lu(k,566) * lu(k,1353) - lu(k,1367) = lu(k,1367) - lu(k,567) * lu(k,1353) - lu(k,1370) = lu(k,1370) - lu(k,568) * lu(k,1353) - lu(k,1371) = lu(k,1371) - lu(k,569) * lu(k,1353) - lu(k,1373) = lu(k,1373) - lu(k,570) * lu(k,1353) - lu(k,1374) = lu(k,1374) - lu(k,571) * lu(k,1353) - lu(k,1376) = lu(k,1376) - lu(k,572) * lu(k,1353) - lu(k,1378) = lu(k,1378) - lu(k,573) * lu(k,1353) - lu(k,1381) = lu(k,1381) - lu(k,574) * lu(k,1353) - lu(k,1383) = lu(k,1383) - lu(k,575) * lu(k,1353) - lu(k,1384) = lu(k,1384) - lu(k,576) * lu(k,1353) - lu(k,1499) = lu(k,1499) - lu(k,561) * lu(k,1494) - lu(k,1504) = lu(k,1504) - lu(k,562) * lu(k,1494) - lu(k,1505) = lu(k,1505) - lu(k,563) * lu(k,1494) - lu(k,1506) = lu(k,1506) - lu(k,564) * lu(k,1494) - lu(k,1507) = lu(k,1507) - lu(k,565) * lu(k,1494) - lu(k,1508) = lu(k,1508) - lu(k,566) * lu(k,1494) - lu(k,1509) = lu(k,1509) - lu(k,567) * lu(k,1494) - lu(k,1512) = lu(k,1512) - lu(k,568) * lu(k,1494) - lu(k,1513) = - lu(k,569) * lu(k,1494) - lu(k,1515) = lu(k,1515) - lu(k,570) * lu(k,1494) - lu(k,1516) = lu(k,1516) - lu(k,571) * lu(k,1494) - lu(k,1518) = lu(k,1518) - lu(k,572) * lu(k,1494) - lu(k,1520) = lu(k,1520) - lu(k,573) * lu(k,1494) - lu(k,1523) = lu(k,1523) - lu(k,574) * lu(k,1494) - lu(k,1525) = lu(k,1525) - lu(k,575) * lu(k,1494) - lu(k,1526) = lu(k,1526) - lu(k,576) * lu(k,1494) - lu(k,1583) = lu(k,1583) - lu(k,561) * lu(k,1580) - lu(k,1588) = lu(k,1588) - lu(k,562) * lu(k,1580) - lu(k,1589) = lu(k,1589) - lu(k,563) * lu(k,1580) - lu(k,1590) = lu(k,1590) - lu(k,564) * lu(k,1580) - lu(k,1591) = lu(k,1591) - lu(k,565) * lu(k,1580) - lu(k,1592) = lu(k,1592) - lu(k,566) * lu(k,1580) - lu(k,1593) = lu(k,1593) - lu(k,567) * lu(k,1580) - lu(k,1596) = lu(k,1596) - lu(k,568) * lu(k,1580) - lu(k,1597) = lu(k,1597) - lu(k,569) * lu(k,1580) - lu(k,1599) = lu(k,1599) - lu(k,570) * lu(k,1580) - lu(k,1600) = lu(k,1600) - lu(k,571) * lu(k,1580) - lu(k,1602) = lu(k,1602) - lu(k,572) * lu(k,1580) - lu(k,1604) = lu(k,1604) - lu(k,573) * lu(k,1580) - lu(k,1607) = lu(k,1607) - lu(k,574) * lu(k,1580) - lu(k,1609) = lu(k,1609) - lu(k,575) * lu(k,1580) - lu(k,1610) = lu(k,1610) - lu(k,576) * lu(k,1580) - lu(k,1692) = lu(k,1692) - lu(k,561) * lu(k,1689) - lu(k,1697) = lu(k,1697) - lu(k,562) * lu(k,1689) - lu(k,1698) = lu(k,1698) - lu(k,563) * lu(k,1689) - lu(k,1699) = lu(k,1699) - lu(k,564) * lu(k,1689) - lu(k,1700) = lu(k,1700) - lu(k,565) * lu(k,1689) - lu(k,1701) = lu(k,1701) - lu(k,566) * lu(k,1689) - lu(k,1702) = lu(k,1702) - lu(k,567) * lu(k,1689) - lu(k,1705) = lu(k,1705) - lu(k,568) * lu(k,1689) - lu(k,1706) = lu(k,1706) - lu(k,569) * lu(k,1689) - lu(k,1708) = lu(k,1708) - lu(k,570) * lu(k,1689) - lu(k,1709) = lu(k,1709) - lu(k,571) * lu(k,1689) - lu(k,1711) = lu(k,1711) - lu(k,572) * lu(k,1689) - lu(k,1713) = lu(k,1713) - lu(k,573) * lu(k,1689) - lu(k,1716) = lu(k,1716) - lu(k,574) * lu(k,1689) - lu(k,1718) = lu(k,1718) - lu(k,575) * lu(k,1689) - lu(k,1719) = lu(k,1719) - lu(k,576) * lu(k,1689) - lu(k,1829) = lu(k,1829) - lu(k,561) * lu(k,1824) - lu(k,1834) = lu(k,1834) - lu(k,562) * lu(k,1824) - lu(k,1835) = lu(k,1835) - lu(k,563) * lu(k,1824) - lu(k,1836) = lu(k,1836) - lu(k,564) * lu(k,1824) - lu(k,1837) = lu(k,1837) - lu(k,565) * lu(k,1824) - lu(k,1838) = lu(k,1838) - lu(k,566) * lu(k,1824) - lu(k,1839) = lu(k,1839) - lu(k,567) * lu(k,1824) - lu(k,1842) = lu(k,1842) - lu(k,568) * lu(k,1824) - lu(k,1843) = lu(k,1843) - lu(k,569) * lu(k,1824) - lu(k,1845) = lu(k,1845) - lu(k,570) * lu(k,1824) - lu(k,1846) = lu(k,1846) - lu(k,571) * lu(k,1824) - lu(k,1848) = lu(k,1848) - lu(k,572) * lu(k,1824) - lu(k,1850) = lu(k,1850) - lu(k,573) * lu(k,1824) - lu(k,1853) = lu(k,1853) - lu(k,574) * lu(k,1824) - lu(k,1855) = lu(k,1855) - lu(k,575) * lu(k,1824) - lu(k,1856) = lu(k,1856) - lu(k,576) * lu(k,1824) - lu(k,584) = 1._r8 / lu(k,584) - lu(k,585) = lu(k,585) * lu(k,584) - lu(k,586) = lu(k,586) * lu(k,584) - lu(k,587) = lu(k,587) * lu(k,584) - lu(k,588) = lu(k,588) * lu(k,584) - lu(k,589) = lu(k,589) * lu(k,584) - lu(k,590) = lu(k,590) * lu(k,584) - lu(k,591) = lu(k,591) * lu(k,584) - lu(k,592) = lu(k,592) * lu(k,584) - lu(k,593) = lu(k,593) * lu(k,584) - lu(k,594) = lu(k,594) * lu(k,584) - lu(k,595) = lu(k,595) * lu(k,584) - lu(k,596) = lu(k,596) * lu(k,584) - lu(k,597) = lu(k,597) * lu(k,584) - lu(k,598) = lu(k,598) * lu(k,584) - lu(k,599) = lu(k,599) * lu(k,584) - lu(k,600) = lu(k,600) * lu(k,584) - lu(k,606) = lu(k,606) - lu(k,585) * lu(k,605) - lu(k,607) = lu(k,607) - lu(k,586) * lu(k,605) - lu(k,608) = lu(k,608) - lu(k,587) * lu(k,605) - lu(k,609) = lu(k,609) - lu(k,588) * lu(k,605) - lu(k,610) = lu(k,610) - lu(k,589) * lu(k,605) - lu(k,611) = lu(k,611) - lu(k,590) * lu(k,605) - lu(k,612) = lu(k,612) - lu(k,591) * lu(k,605) - lu(k,613) = lu(k,613) - lu(k,592) * lu(k,605) - lu(k,614) = lu(k,614) - lu(k,593) * lu(k,605) - lu(k,615) = lu(k,615) - lu(k,594) * lu(k,605) - lu(k,616) = lu(k,616) - lu(k,595) * lu(k,605) - lu(k,617) = lu(k,617) - lu(k,596) * lu(k,605) - lu(k,618) = lu(k,618) - lu(k,597) * lu(k,605) - lu(k,622) = lu(k,622) - lu(k,598) * lu(k,605) - lu(k,623) = lu(k,623) - lu(k,599) * lu(k,605) - lu(k,624) = lu(k,624) - lu(k,600) * lu(k,605) - lu(k,636) = lu(k,636) - lu(k,585) * lu(k,635) - lu(k,637) = lu(k,637) - lu(k,586) * lu(k,635) - lu(k,638) = lu(k,638) - lu(k,587) * lu(k,635) - lu(k,639) = lu(k,639) - lu(k,588) * lu(k,635) - lu(k,640) = lu(k,640) - lu(k,589) * lu(k,635) - lu(k,642) = lu(k,642) - lu(k,590) * lu(k,635) - lu(k,643) = lu(k,643) - lu(k,591) * lu(k,635) - lu(k,644) = lu(k,644) - lu(k,592) * lu(k,635) - lu(k,645) = lu(k,645) - lu(k,593) * lu(k,635) - lu(k,646) = lu(k,646) - lu(k,594) * lu(k,635) - lu(k,649) = lu(k,649) - lu(k,595) * lu(k,635) - lu(k,650) = lu(k,650) - lu(k,596) * lu(k,635) - lu(k,651) = lu(k,651) - lu(k,597) * lu(k,635) - lu(k,655) = lu(k,655) - lu(k,598) * lu(k,635) - lu(k,656) = lu(k,656) - lu(k,599) * lu(k,635) - lu(k,657) = lu(k,657) - lu(k,600) * lu(k,635) - lu(k,745) = lu(k,745) - lu(k,585) * lu(k,744) - lu(k,746) = lu(k,746) - lu(k,586) * lu(k,744) - lu(k,747) = lu(k,747) - lu(k,587) * lu(k,744) - lu(k,748) = lu(k,748) - lu(k,588) * lu(k,744) - lu(k,749) = lu(k,749) - lu(k,589) * lu(k,744) - lu(k,752) = lu(k,752) - lu(k,590) * lu(k,744) - lu(k,753) = lu(k,753) - lu(k,591) * lu(k,744) - lu(k,754) = lu(k,754) - lu(k,592) * lu(k,744) - lu(k,755) = lu(k,755) - lu(k,593) * lu(k,744) - lu(k,756) = lu(k,756) - lu(k,594) * lu(k,744) - lu(k,759) = lu(k,759) - lu(k,595) * lu(k,744) - lu(k,760) = lu(k,760) - lu(k,596) * lu(k,744) - lu(k,761) = lu(k,761) - lu(k,597) * lu(k,744) - lu(k,765) = lu(k,765) - lu(k,598) * lu(k,744) - lu(k,766) = lu(k,766) - lu(k,599) * lu(k,744) - lu(k,767) = lu(k,767) - lu(k,600) * lu(k,744) - lu(k,791) = lu(k,791) - lu(k,585) * lu(k,790) - lu(k,792) = lu(k,792) - lu(k,586) * lu(k,790) - lu(k,793) = lu(k,793) - lu(k,587) * lu(k,790) - lu(k,794) = lu(k,794) - lu(k,588) * lu(k,790) - lu(k,796) = lu(k,796) - lu(k,589) * lu(k,790) - lu(k,799) = lu(k,799) - lu(k,590) * lu(k,790) - lu(k,800) = lu(k,800) - lu(k,591) * lu(k,790) - lu(k,801) = lu(k,801) - lu(k,592) * lu(k,790) - lu(k,802) = lu(k,802) - lu(k,593) * lu(k,790) - lu(k,803) = lu(k,803) - lu(k,594) * lu(k,790) - lu(k,806) = lu(k,806) - lu(k,595) * lu(k,790) - lu(k,807) = lu(k,807) - lu(k,596) * lu(k,790) - lu(k,808) = lu(k,808) - lu(k,597) * lu(k,790) - lu(k,812) = lu(k,812) - lu(k,598) * lu(k,790) - lu(k,813) = lu(k,813) - lu(k,599) * lu(k,790) - lu(k,814) = lu(k,814) - lu(k,600) * lu(k,790) - lu(k,980) = lu(k,980) - lu(k,585) * lu(k,979) - lu(k,981) = lu(k,981) - lu(k,586) * lu(k,979) - lu(k,984) = lu(k,984) - lu(k,587) * lu(k,979) - lu(k,985) = lu(k,985) - lu(k,588) * lu(k,979) - lu(k,990) = lu(k,990) - lu(k,589) * lu(k,979) - lu(k,993) = lu(k,993) - lu(k,590) * lu(k,979) - lu(k,994) = lu(k,994) - lu(k,591) * lu(k,979) - lu(k,995) = lu(k,995) - lu(k,592) * lu(k,979) - lu(k,996) = lu(k,996) - lu(k,593) * lu(k,979) - lu(k,997) = lu(k,997) - lu(k,594) * lu(k,979) - lu(k,1000) = lu(k,1000) - lu(k,595) * lu(k,979) - lu(k,1001) = lu(k,1001) - lu(k,596) * lu(k,979) - lu(k,1002) = lu(k,1002) - lu(k,597) * lu(k,979) - lu(k,1008) = lu(k,1008) - lu(k,598) * lu(k,979) - lu(k,1009) = lu(k,1009) - lu(k,599) * lu(k,979) - lu(k,1010) = lu(k,1010) - lu(k,600) * lu(k,979) - lu(k,1104) = lu(k,1104) - lu(k,585) * lu(k,1103) - lu(k,1105) = lu(k,1105) - lu(k,586) * lu(k,1103) - lu(k,1107) = lu(k,1107) - lu(k,587) * lu(k,1103) - lu(k,1108) = lu(k,1108) - lu(k,588) * lu(k,1103) - lu(k,1112) = lu(k,1112) - lu(k,589) * lu(k,1103) - lu(k,1115) = lu(k,1115) - lu(k,590) * lu(k,1103) - lu(k,1116) = - lu(k,591) * lu(k,1103) - lu(k,1117) = lu(k,1117) - lu(k,592) * lu(k,1103) - lu(k,1118) = lu(k,1118) - lu(k,593) * lu(k,1103) - lu(k,1119) = lu(k,1119) - lu(k,594) * lu(k,1103) - lu(k,1122) = lu(k,1122) - lu(k,595) * lu(k,1103) - lu(k,1123) = lu(k,1123) - lu(k,596) * lu(k,1103) - lu(k,1124) = lu(k,1124) - lu(k,597) * lu(k,1103) - lu(k,1130) = lu(k,1130) - lu(k,598) * lu(k,1103) - lu(k,1131) = lu(k,1131) - lu(k,599) * lu(k,1103) - lu(k,1132) = lu(k,1132) - lu(k,600) * lu(k,1103) - lu(k,1145) = lu(k,1145) - lu(k,585) * lu(k,1144) - lu(k,1146) = lu(k,1146) - lu(k,586) * lu(k,1144) - lu(k,1150) = lu(k,1150) - lu(k,587) * lu(k,1144) - lu(k,1151) = lu(k,1151) - lu(k,588) * lu(k,1144) - lu(k,1156) = lu(k,1156) - lu(k,589) * lu(k,1144) - lu(k,1159) = lu(k,1159) - lu(k,590) * lu(k,1144) - lu(k,1160) = lu(k,1160) - lu(k,591) * lu(k,1144) - lu(k,1161) = lu(k,1161) - lu(k,592) * lu(k,1144) - lu(k,1162) = lu(k,1162) - lu(k,593) * lu(k,1144) - lu(k,1163) = lu(k,1163) - lu(k,594) * lu(k,1144) - lu(k,1166) = lu(k,1166) - lu(k,595) * lu(k,1144) - lu(k,1167) = lu(k,1167) - lu(k,596) * lu(k,1144) - lu(k,1168) = lu(k,1168) - lu(k,597) * lu(k,1144) - lu(k,1174) = lu(k,1174) - lu(k,598) * lu(k,1144) - lu(k,1175) = lu(k,1175) - lu(k,599) * lu(k,1144) - lu(k,1176) = lu(k,1176) - lu(k,600) * lu(k,1144) - lu(k,1186) = lu(k,1186) - lu(k,585) * lu(k,1185) - lu(k,1187) = lu(k,1187) - lu(k,586) * lu(k,1185) - lu(k,1191) = lu(k,1191) - lu(k,587) * lu(k,1185) - lu(k,1192) = lu(k,1192) - lu(k,588) * lu(k,1185) - lu(k,1197) = lu(k,1197) - lu(k,589) * lu(k,1185) - lu(k,1200) = lu(k,1200) - lu(k,590) * lu(k,1185) - lu(k,1201) = - lu(k,591) * lu(k,1185) - lu(k,1202) = lu(k,1202) - lu(k,592) * lu(k,1185) - lu(k,1203) = lu(k,1203) - lu(k,593) * lu(k,1185) - lu(k,1204) = - lu(k,594) * lu(k,1185) - lu(k,1207) = lu(k,1207) - lu(k,595) * lu(k,1185) - lu(k,1208) = lu(k,1208) - lu(k,596) * lu(k,1185) - lu(k,1209) = lu(k,1209) - lu(k,597) * lu(k,1185) - lu(k,1215) = lu(k,1215) - lu(k,598) * lu(k,1185) - lu(k,1216) = lu(k,1216) - lu(k,599) * lu(k,1185) - lu(k,1217) = lu(k,1217) - lu(k,600) * lu(k,1185) - lu(k,1235) = lu(k,1235) - lu(k,585) * lu(k,1234) - lu(k,1236) = lu(k,1236) - lu(k,586) * lu(k,1234) - lu(k,1240) = lu(k,1240) - lu(k,587) * lu(k,1234) - lu(k,1241) = lu(k,1241) - lu(k,588) * lu(k,1234) - lu(k,1246) = lu(k,1246) - lu(k,589) * lu(k,1234) - lu(k,1249) = - lu(k,590) * lu(k,1234) - lu(k,1250) = - lu(k,591) * lu(k,1234) - lu(k,1251) = lu(k,1251) - lu(k,592) * lu(k,1234) - lu(k,1252) = lu(k,1252) - lu(k,593) * lu(k,1234) - lu(k,1253) = - lu(k,594) * lu(k,1234) - lu(k,1256) = lu(k,1256) - lu(k,595) * lu(k,1234) - lu(k,1257) = lu(k,1257) - lu(k,596) * lu(k,1234) - lu(k,1258) = lu(k,1258) - lu(k,597) * lu(k,1234) - lu(k,1264) = lu(k,1264) - lu(k,598) * lu(k,1234) - lu(k,1265) = lu(k,1265) - lu(k,599) * lu(k,1234) - lu(k,1266) = lu(k,1266) - lu(k,600) * lu(k,1234) - lu(k,1412) = lu(k,1412) - lu(k,585) * lu(k,1411) - lu(k,1413) = lu(k,1413) - lu(k,586) * lu(k,1411) - lu(k,1417) = lu(k,1417) - lu(k,587) * lu(k,1411) - lu(k,1418) = lu(k,1418) - lu(k,588) * lu(k,1411) - lu(k,1423) = lu(k,1423) - lu(k,589) * lu(k,1411) - lu(k,1426) = lu(k,1426) - lu(k,590) * lu(k,1411) - lu(k,1427) = lu(k,1427) - lu(k,591) * lu(k,1411) - lu(k,1428) = lu(k,1428) - lu(k,592) * lu(k,1411) - lu(k,1429) = lu(k,1429) - lu(k,593) * lu(k,1411) - lu(k,1430) = lu(k,1430) - lu(k,594) * lu(k,1411) - lu(k,1433) = lu(k,1433) - lu(k,595) * lu(k,1411) - lu(k,1434) = lu(k,1434) - lu(k,596) * lu(k,1411) - lu(k,1435) = lu(k,1435) - lu(k,597) * lu(k,1411) - lu(k,1441) = lu(k,1441) - lu(k,598) * lu(k,1411) - lu(k,1442) = lu(k,1442) - lu(k,599) * lu(k,1411) - lu(k,1443) = lu(k,1443) - lu(k,600) * lu(k,1411) - lu(k,1454) = lu(k,1454) - lu(k,585) * lu(k,1453) - lu(k,1455) = lu(k,1455) - lu(k,586) * lu(k,1453) - lu(k,1459) = lu(k,1459) - lu(k,587) * lu(k,1453) - lu(k,1460) = lu(k,1460) - lu(k,588) * lu(k,1453) - lu(k,1465) = lu(k,1465) - lu(k,589) * lu(k,1453) - lu(k,1468) = lu(k,1468) - lu(k,590) * lu(k,1453) - lu(k,1469) = lu(k,1469) - lu(k,591) * lu(k,1453) - lu(k,1470) = lu(k,1470) - lu(k,592) * lu(k,1453) - lu(k,1471) = lu(k,1471) - lu(k,593) * lu(k,1453) - lu(k,1472) = lu(k,1472) - lu(k,594) * lu(k,1453) - lu(k,1475) = lu(k,1475) - lu(k,595) * lu(k,1453) - lu(k,1476) = lu(k,1476) - lu(k,596) * lu(k,1453) - lu(k,1477) = lu(k,1477) - lu(k,597) * lu(k,1453) - lu(k,1483) = lu(k,1483) - lu(k,598) * lu(k,1453) - lu(k,1484) = lu(k,1484) - lu(k,599) * lu(k,1453) - lu(k,1485) = lu(k,1485) - lu(k,600) * lu(k,1453) - lu(k,1496) = lu(k,1496) - lu(k,585) * lu(k,1495) - lu(k,1497) = lu(k,1497) - lu(k,586) * lu(k,1495) - lu(k,1500) = lu(k,1500) - lu(k,587) * lu(k,1495) - lu(k,1501) = lu(k,1501) - lu(k,588) * lu(k,1495) - lu(k,1506) = lu(k,1506) - lu(k,589) * lu(k,1495) - lu(k,1509) = lu(k,1509) - lu(k,590) * lu(k,1495) - lu(k,1510) = - lu(k,591) * lu(k,1495) - lu(k,1511) = lu(k,1511) - lu(k,592) * lu(k,1495) - lu(k,1512) = lu(k,1512) - lu(k,593) * lu(k,1495) - lu(k,1513) = lu(k,1513) - lu(k,594) * lu(k,1495) - lu(k,1516) = lu(k,1516) - lu(k,595) * lu(k,1495) - lu(k,1517) = lu(k,1517) - lu(k,596) * lu(k,1495) - lu(k,1518) = lu(k,1518) - lu(k,597) * lu(k,1495) - lu(k,1524) = lu(k,1524) - lu(k,598) * lu(k,1495) - lu(k,1525) = lu(k,1525) - lu(k,599) * lu(k,1495) - lu(k,1526) = lu(k,1526) - lu(k,600) * lu(k,1495) - lu(k,1732) = lu(k,1732) - lu(k,585) * lu(k,1731) - lu(k,1733) = lu(k,1733) - lu(k,586) * lu(k,1731) - lu(k,1737) = lu(k,1737) - lu(k,587) * lu(k,1731) - lu(k,1738) = lu(k,1738) - lu(k,588) * lu(k,1731) - lu(k,1743) = lu(k,1743) - lu(k,589) * lu(k,1731) - lu(k,1746) = lu(k,1746) - lu(k,590) * lu(k,1731) - lu(k,1747) = lu(k,1747) - lu(k,591) * lu(k,1731) - lu(k,1748) = lu(k,1748) - lu(k,592) * lu(k,1731) - lu(k,1749) = lu(k,1749) - lu(k,593) * lu(k,1731) - lu(k,1750) = lu(k,1750) - lu(k,594) * lu(k,1731) - lu(k,1753) = lu(k,1753) - lu(k,595) * lu(k,1731) - lu(k,1754) = lu(k,1754) - lu(k,596) * lu(k,1731) - lu(k,1755) = lu(k,1755) - lu(k,597) * lu(k,1731) - lu(k,1761) = lu(k,1761) - lu(k,598) * lu(k,1731) - lu(k,1762) = lu(k,1762) - lu(k,599) * lu(k,1731) - lu(k,1763) = lu(k,1763) - lu(k,600) * lu(k,1731) - lu(k,1826) = lu(k,1826) - lu(k,585) * lu(k,1825) - lu(k,1827) = lu(k,1827) - lu(k,586) * lu(k,1825) - lu(k,1830) = lu(k,1830) - lu(k,587) * lu(k,1825) - lu(k,1831) = lu(k,1831) - lu(k,588) * lu(k,1825) - lu(k,1836) = lu(k,1836) - lu(k,589) * lu(k,1825) - lu(k,1839) = lu(k,1839) - lu(k,590) * lu(k,1825) - lu(k,1840) = lu(k,1840) - lu(k,591) * lu(k,1825) - lu(k,1841) = lu(k,1841) - lu(k,592) * lu(k,1825) - lu(k,1842) = lu(k,1842) - lu(k,593) * lu(k,1825) - lu(k,1843) = lu(k,1843) - lu(k,594) * lu(k,1825) - lu(k,1846) = lu(k,1846) - lu(k,595) * lu(k,1825) - lu(k,1847) = lu(k,1847) - lu(k,596) * lu(k,1825) - lu(k,1848) = lu(k,1848) - lu(k,597) * lu(k,1825) - lu(k,1854) = lu(k,1854) - lu(k,598) * lu(k,1825) - lu(k,1855) = lu(k,1855) - lu(k,599) * lu(k,1825) - lu(k,1856) = lu(k,1856) - lu(k,600) * lu(k,1825) - lu(k,606) = 1._r8 / lu(k,606) - lu(k,607) = lu(k,607) * lu(k,606) - lu(k,608) = lu(k,608) * lu(k,606) - lu(k,609) = lu(k,609) * lu(k,606) - lu(k,610) = lu(k,610) * lu(k,606) - lu(k,611) = lu(k,611) * lu(k,606) - lu(k,612) = lu(k,612) * lu(k,606) - lu(k,613) = lu(k,613) * lu(k,606) - lu(k,614) = lu(k,614) * lu(k,606) - lu(k,615) = lu(k,615) * lu(k,606) - lu(k,616) = lu(k,616) * lu(k,606) - lu(k,617) = lu(k,617) * lu(k,606) - lu(k,618) = lu(k,618) * lu(k,606) - lu(k,619) = lu(k,619) * lu(k,606) - lu(k,620) = lu(k,620) * lu(k,606) - lu(k,621) = lu(k,621) * lu(k,606) - lu(k,622) = lu(k,622) * lu(k,606) - lu(k,623) = lu(k,623) * lu(k,606) - lu(k,624) = lu(k,624) * lu(k,606) - lu(k,637) = lu(k,637) - lu(k,607) * lu(k,636) - lu(k,638) = lu(k,638) - lu(k,608) * lu(k,636) - lu(k,639) = lu(k,639) - lu(k,609) * lu(k,636) - lu(k,640) = lu(k,640) - lu(k,610) * lu(k,636) - lu(k,642) = lu(k,642) - lu(k,611) * lu(k,636) - lu(k,643) = lu(k,643) - lu(k,612) * lu(k,636) - lu(k,644) = lu(k,644) - lu(k,613) * lu(k,636) - lu(k,645) = lu(k,645) - lu(k,614) * lu(k,636) - lu(k,646) = lu(k,646) - lu(k,615) * lu(k,636) - lu(k,649) = lu(k,649) - lu(k,616) * lu(k,636) - lu(k,650) = lu(k,650) - lu(k,617) * lu(k,636) - lu(k,651) = lu(k,651) - lu(k,618) * lu(k,636) - lu(k,652) = lu(k,652) - lu(k,619) * lu(k,636) - lu(k,653) = lu(k,653) - lu(k,620) * lu(k,636) - lu(k,654) = lu(k,654) - lu(k,621) * lu(k,636) - lu(k,655) = lu(k,655) - lu(k,622) * lu(k,636) - lu(k,656) = lu(k,656) - lu(k,623) * lu(k,636) - lu(k,657) = lu(k,657) - lu(k,624) * lu(k,636) - lu(k,746) = lu(k,746) - lu(k,607) * lu(k,745) - lu(k,747) = lu(k,747) - lu(k,608) * lu(k,745) - lu(k,748) = lu(k,748) - lu(k,609) * lu(k,745) - lu(k,749) = lu(k,749) - lu(k,610) * lu(k,745) - lu(k,752) = lu(k,752) - lu(k,611) * lu(k,745) - lu(k,753) = lu(k,753) - lu(k,612) * lu(k,745) - lu(k,754) = lu(k,754) - lu(k,613) * lu(k,745) - lu(k,755) = lu(k,755) - lu(k,614) * lu(k,745) - lu(k,756) = lu(k,756) - lu(k,615) * lu(k,745) - lu(k,759) = lu(k,759) - lu(k,616) * lu(k,745) - lu(k,760) = lu(k,760) - lu(k,617) * lu(k,745) - lu(k,761) = lu(k,761) - lu(k,618) * lu(k,745) - lu(k,762) = lu(k,762) - lu(k,619) * lu(k,745) - lu(k,763) = lu(k,763) - lu(k,620) * lu(k,745) - lu(k,764) = lu(k,764) - lu(k,621) * lu(k,745) - lu(k,765) = lu(k,765) - lu(k,622) * lu(k,745) - lu(k,766) = lu(k,766) - lu(k,623) * lu(k,745) - lu(k,767) = lu(k,767) - lu(k,624) * lu(k,745) - lu(k,792) = lu(k,792) - lu(k,607) * lu(k,791) - lu(k,793) = lu(k,793) - lu(k,608) * lu(k,791) - lu(k,794) = lu(k,794) - lu(k,609) * lu(k,791) - lu(k,796) = lu(k,796) - lu(k,610) * lu(k,791) - lu(k,799) = lu(k,799) - lu(k,611) * lu(k,791) - lu(k,800) = lu(k,800) - lu(k,612) * lu(k,791) - lu(k,801) = lu(k,801) - lu(k,613) * lu(k,791) - lu(k,802) = lu(k,802) - lu(k,614) * lu(k,791) - lu(k,803) = lu(k,803) - lu(k,615) * lu(k,791) - lu(k,806) = lu(k,806) - lu(k,616) * lu(k,791) - lu(k,807) = lu(k,807) - lu(k,617) * lu(k,791) - lu(k,808) = lu(k,808) - lu(k,618) * lu(k,791) - lu(k,809) = lu(k,809) - lu(k,619) * lu(k,791) - lu(k,810) = lu(k,810) - lu(k,620) * lu(k,791) - lu(k,811) = lu(k,811) - lu(k,621) * lu(k,791) - lu(k,812) = lu(k,812) - lu(k,622) * lu(k,791) - lu(k,813) = lu(k,813) - lu(k,623) * lu(k,791) - lu(k,814) = lu(k,814) - lu(k,624) * lu(k,791) - lu(k,981) = lu(k,981) - lu(k,607) * lu(k,980) - lu(k,984) = lu(k,984) - lu(k,608) * lu(k,980) - lu(k,985) = lu(k,985) - lu(k,609) * lu(k,980) - lu(k,990) = lu(k,990) - lu(k,610) * lu(k,980) - lu(k,993) = lu(k,993) - lu(k,611) * lu(k,980) - lu(k,994) = lu(k,994) - lu(k,612) * lu(k,980) - lu(k,995) = lu(k,995) - lu(k,613) * lu(k,980) - lu(k,996) = lu(k,996) - lu(k,614) * lu(k,980) - lu(k,997) = lu(k,997) - lu(k,615) * lu(k,980) - lu(k,1000) = lu(k,1000) - lu(k,616) * lu(k,980) - lu(k,1001) = lu(k,1001) - lu(k,617) * lu(k,980) - lu(k,1002) = lu(k,1002) - lu(k,618) * lu(k,980) - lu(k,1003) = lu(k,1003) - lu(k,619) * lu(k,980) - lu(k,1005) = lu(k,1005) - lu(k,620) * lu(k,980) - lu(k,1006) = lu(k,1006) - lu(k,621) * lu(k,980) - lu(k,1008) = lu(k,1008) - lu(k,622) * lu(k,980) - lu(k,1009) = lu(k,1009) - lu(k,623) * lu(k,980) - lu(k,1010) = lu(k,1010) - lu(k,624) * lu(k,980) - lu(k,1105) = lu(k,1105) - lu(k,607) * lu(k,1104) - lu(k,1107) = lu(k,1107) - lu(k,608) * lu(k,1104) - lu(k,1108) = lu(k,1108) - lu(k,609) * lu(k,1104) - lu(k,1112) = lu(k,1112) - lu(k,610) * lu(k,1104) - lu(k,1115) = lu(k,1115) - lu(k,611) * lu(k,1104) - lu(k,1116) = lu(k,1116) - lu(k,612) * lu(k,1104) - lu(k,1117) = lu(k,1117) - lu(k,613) * lu(k,1104) - lu(k,1118) = lu(k,1118) - lu(k,614) * lu(k,1104) - lu(k,1119) = lu(k,1119) - lu(k,615) * lu(k,1104) - lu(k,1122) = lu(k,1122) - lu(k,616) * lu(k,1104) - lu(k,1123) = lu(k,1123) - lu(k,617) * lu(k,1104) - lu(k,1124) = lu(k,1124) - lu(k,618) * lu(k,1104) - lu(k,1125) = - lu(k,619) * lu(k,1104) - lu(k,1127) = - lu(k,620) * lu(k,1104) - lu(k,1128) = - lu(k,621) * lu(k,1104) - lu(k,1130) = lu(k,1130) - lu(k,622) * lu(k,1104) - lu(k,1131) = lu(k,1131) - lu(k,623) * lu(k,1104) - lu(k,1132) = lu(k,1132) - lu(k,624) * lu(k,1104) - lu(k,1146) = lu(k,1146) - lu(k,607) * lu(k,1145) - lu(k,1150) = lu(k,1150) - lu(k,608) * lu(k,1145) - lu(k,1151) = lu(k,1151) - lu(k,609) * lu(k,1145) - lu(k,1156) = lu(k,1156) - lu(k,610) * lu(k,1145) - lu(k,1159) = lu(k,1159) - lu(k,611) * lu(k,1145) - lu(k,1160) = lu(k,1160) - lu(k,612) * lu(k,1145) - lu(k,1161) = lu(k,1161) - lu(k,613) * lu(k,1145) - lu(k,1162) = lu(k,1162) - lu(k,614) * lu(k,1145) - lu(k,1163) = lu(k,1163) - lu(k,615) * lu(k,1145) - lu(k,1166) = lu(k,1166) - lu(k,616) * lu(k,1145) - lu(k,1167) = lu(k,1167) - lu(k,617) * lu(k,1145) - lu(k,1168) = lu(k,1168) - lu(k,618) * lu(k,1145) - lu(k,1169) = - lu(k,619) * lu(k,1145) - lu(k,1171) = lu(k,1171) - lu(k,620) * lu(k,1145) - lu(k,1172) = lu(k,1172) - lu(k,621) * lu(k,1145) - lu(k,1174) = lu(k,1174) - lu(k,622) * lu(k,1145) - lu(k,1175) = lu(k,1175) - lu(k,623) * lu(k,1145) - lu(k,1176) = lu(k,1176) - lu(k,624) * lu(k,1145) - lu(k,1187) = lu(k,1187) - lu(k,607) * lu(k,1186) - lu(k,1191) = lu(k,1191) - lu(k,608) * lu(k,1186) - lu(k,1192) = lu(k,1192) - lu(k,609) * lu(k,1186) - lu(k,1197) = lu(k,1197) - lu(k,610) * lu(k,1186) - lu(k,1200) = lu(k,1200) - lu(k,611) * lu(k,1186) - lu(k,1201) = lu(k,1201) - lu(k,612) * lu(k,1186) - lu(k,1202) = lu(k,1202) - lu(k,613) * lu(k,1186) - lu(k,1203) = lu(k,1203) - lu(k,614) * lu(k,1186) - lu(k,1204) = lu(k,1204) - lu(k,615) * lu(k,1186) - lu(k,1207) = lu(k,1207) - lu(k,616) * lu(k,1186) - lu(k,1208) = lu(k,1208) - lu(k,617) * lu(k,1186) - lu(k,1209) = lu(k,1209) - lu(k,618) * lu(k,1186) - lu(k,1210) = lu(k,1210) - lu(k,619) * lu(k,1186) - lu(k,1212) = lu(k,1212) - lu(k,620) * lu(k,1186) - lu(k,1213) = lu(k,1213) - lu(k,621) * lu(k,1186) - lu(k,1215) = lu(k,1215) - lu(k,622) * lu(k,1186) - lu(k,1216) = lu(k,1216) - lu(k,623) * lu(k,1186) - lu(k,1217) = lu(k,1217) - lu(k,624) * lu(k,1186) - lu(k,1236) = lu(k,1236) - lu(k,607) * lu(k,1235) - lu(k,1240) = lu(k,1240) - lu(k,608) * lu(k,1235) - lu(k,1241) = lu(k,1241) - lu(k,609) * lu(k,1235) - lu(k,1246) = lu(k,1246) - lu(k,610) * lu(k,1235) - lu(k,1249) = lu(k,1249) - lu(k,611) * lu(k,1235) - lu(k,1250) = lu(k,1250) - lu(k,612) * lu(k,1235) - lu(k,1251) = lu(k,1251) - lu(k,613) * lu(k,1235) - lu(k,1252) = lu(k,1252) - lu(k,614) * lu(k,1235) - lu(k,1253) = lu(k,1253) - lu(k,615) * lu(k,1235) - lu(k,1256) = lu(k,1256) - lu(k,616) * lu(k,1235) - lu(k,1257) = lu(k,1257) - lu(k,617) * lu(k,1235) - lu(k,1258) = lu(k,1258) - lu(k,618) * lu(k,1235) - lu(k,1259) = lu(k,1259) - lu(k,619) * lu(k,1235) - lu(k,1261) = lu(k,1261) - lu(k,620) * lu(k,1235) - lu(k,1262) = lu(k,1262) - lu(k,621) * lu(k,1235) - lu(k,1264) = lu(k,1264) - lu(k,622) * lu(k,1235) - lu(k,1265) = lu(k,1265) - lu(k,623) * lu(k,1235) - lu(k,1266) = lu(k,1266) - lu(k,624) * lu(k,1235) - lu(k,1276) = lu(k,1276) - lu(k,607) * lu(k,1275) - lu(k,1279) = lu(k,1279) - lu(k,608) * lu(k,1275) - lu(k,1280) = lu(k,1280) - lu(k,609) * lu(k,1275) - lu(k,1285) = lu(k,1285) - lu(k,610) * lu(k,1275) - lu(k,1288) = lu(k,1288) - lu(k,611) * lu(k,1275) - lu(k,1289) = lu(k,1289) - lu(k,612) * lu(k,1275) - lu(k,1290) = - lu(k,613) * lu(k,1275) - lu(k,1291) = lu(k,1291) - lu(k,614) * lu(k,1275) - lu(k,1292) = lu(k,1292) - lu(k,615) * lu(k,1275) - lu(k,1295) = lu(k,1295) - lu(k,616) * lu(k,1275) - lu(k,1296) = lu(k,1296) - lu(k,617) * lu(k,1275) - lu(k,1297) = lu(k,1297) - lu(k,618) * lu(k,1275) - lu(k,1298) = lu(k,1298) - lu(k,619) * lu(k,1275) - lu(k,1300) = lu(k,1300) - lu(k,620) * lu(k,1275) - lu(k,1301) = lu(k,1301) - lu(k,621) * lu(k,1275) - lu(k,1303) = lu(k,1303) - lu(k,622) * lu(k,1275) - lu(k,1304) = lu(k,1304) - lu(k,623) * lu(k,1275) - lu(k,1305) = lu(k,1305) - lu(k,624) * lu(k,1275) - lu(k,1413) = lu(k,1413) - lu(k,607) * lu(k,1412) - lu(k,1417) = lu(k,1417) - lu(k,608) * lu(k,1412) - lu(k,1418) = lu(k,1418) - lu(k,609) * lu(k,1412) - lu(k,1423) = lu(k,1423) - lu(k,610) * lu(k,1412) - lu(k,1426) = lu(k,1426) - lu(k,611) * lu(k,1412) - lu(k,1427) = lu(k,1427) - lu(k,612) * lu(k,1412) - lu(k,1428) = lu(k,1428) - lu(k,613) * lu(k,1412) - lu(k,1429) = lu(k,1429) - lu(k,614) * lu(k,1412) - lu(k,1430) = lu(k,1430) - lu(k,615) * lu(k,1412) - lu(k,1433) = lu(k,1433) - lu(k,616) * lu(k,1412) - lu(k,1434) = lu(k,1434) - lu(k,617) * lu(k,1412) - lu(k,1435) = lu(k,1435) - lu(k,618) * lu(k,1412) - lu(k,1436) = lu(k,1436) - lu(k,619) * lu(k,1412) - lu(k,1438) = lu(k,1438) - lu(k,620) * lu(k,1412) - lu(k,1439) = lu(k,1439) - lu(k,621) * lu(k,1412) - lu(k,1441) = lu(k,1441) - lu(k,622) * lu(k,1412) - lu(k,1442) = lu(k,1442) - lu(k,623) * lu(k,1412) - lu(k,1443) = lu(k,1443) - lu(k,624) * lu(k,1412) - lu(k,1455) = lu(k,1455) - lu(k,607) * lu(k,1454) - lu(k,1459) = lu(k,1459) - lu(k,608) * lu(k,1454) - lu(k,1460) = lu(k,1460) - lu(k,609) * lu(k,1454) - lu(k,1465) = lu(k,1465) - lu(k,610) * lu(k,1454) - lu(k,1468) = lu(k,1468) - lu(k,611) * lu(k,1454) - lu(k,1469) = lu(k,1469) - lu(k,612) * lu(k,1454) - lu(k,1470) = lu(k,1470) - lu(k,613) * lu(k,1454) - lu(k,1471) = lu(k,1471) - lu(k,614) * lu(k,1454) - lu(k,1472) = lu(k,1472) - lu(k,615) * lu(k,1454) - lu(k,1475) = lu(k,1475) - lu(k,616) * lu(k,1454) - lu(k,1476) = lu(k,1476) - lu(k,617) * lu(k,1454) - lu(k,1477) = lu(k,1477) - lu(k,618) * lu(k,1454) - lu(k,1478) = lu(k,1478) - lu(k,619) * lu(k,1454) - lu(k,1480) = lu(k,1480) - lu(k,620) * lu(k,1454) - lu(k,1481) = lu(k,1481) - lu(k,621) * lu(k,1454) - lu(k,1483) = lu(k,1483) - lu(k,622) * lu(k,1454) - lu(k,1484) = lu(k,1484) - lu(k,623) * lu(k,1454) - lu(k,1485) = lu(k,1485) - lu(k,624) * lu(k,1454) - lu(k,1497) = lu(k,1497) - lu(k,607) * lu(k,1496) - lu(k,1500) = lu(k,1500) - lu(k,608) * lu(k,1496) - lu(k,1501) = lu(k,1501) - lu(k,609) * lu(k,1496) - lu(k,1506) = lu(k,1506) - lu(k,610) * lu(k,1496) - lu(k,1509) = lu(k,1509) - lu(k,611) * lu(k,1496) - lu(k,1510) = lu(k,1510) - lu(k,612) * lu(k,1496) - lu(k,1511) = lu(k,1511) - lu(k,613) * lu(k,1496) - lu(k,1512) = lu(k,1512) - lu(k,614) * lu(k,1496) - lu(k,1513) = lu(k,1513) - lu(k,615) * lu(k,1496) - lu(k,1516) = lu(k,1516) - lu(k,616) * lu(k,1496) - lu(k,1517) = lu(k,1517) - lu(k,617) * lu(k,1496) - lu(k,1518) = lu(k,1518) - lu(k,618) * lu(k,1496) - lu(k,1519) = lu(k,1519) - lu(k,619) * lu(k,1496) - lu(k,1521) = lu(k,1521) - lu(k,620) * lu(k,1496) - lu(k,1522) = lu(k,1522) - lu(k,621) * lu(k,1496) - lu(k,1524) = lu(k,1524) - lu(k,622) * lu(k,1496) - lu(k,1525) = lu(k,1525) - lu(k,623) * lu(k,1496) - lu(k,1526) = lu(k,1526) - lu(k,624) * lu(k,1496) - lu(k,1648) = lu(k,1648) - lu(k,607) * lu(k,1647) - lu(k,1651) = lu(k,1651) - lu(k,608) * lu(k,1647) - lu(k,1652) = lu(k,1652) - lu(k,609) * lu(k,1647) - lu(k,1657) = lu(k,1657) - lu(k,610) * lu(k,1647) - lu(k,1660) = lu(k,1660) - lu(k,611) * lu(k,1647) - lu(k,1661) = lu(k,1661) - lu(k,612) * lu(k,1647) - lu(k,1662) = lu(k,1662) - lu(k,613) * lu(k,1647) - lu(k,1663) = lu(k,1663) - lu(k,614) * lu(k,1647) - lu(k,1664) = lu(k,1664) - lu(k,615) * lu(k,1647) - lu(k,1667) = lu(k,1667) - lu(k,616) * lu(k,1647) - lu(k,1668) = lu(k,1668) - lu(k,617) * lu(k,1647) - lu(k,1669) = lu(k,1669) - lu(k,618) * lu(k,1647) - lu(k,1670) = lu(k,1670) - lu(k,619) * lu(k,1647) - lu(k,1672) = lu(k,1672) - lu(k,620) * lu(k,1647) - lu(k,1673) = lu(k,1673) - lu(k,621) * lu(k,1647) - lu(k,1675) = lu(k,1675) - lu(k,622) * lu(k,1647) - lu(k,1676) = lu(k,1676) - lu(k,623) * lu(k,1647) - lu(k,1677) = lu(k,1677) - lu(k,624) * lu(k,1647) - lu(k,1733) = lu(k,1733) - lu(k,607) * lu(k,1732) - lu(k,1737) = lu(k,1737) - lu(k,608) * lu(k,1732) - lu(k,1738) = lu(k,1738) - lu(k,609) * lu(k,1732) - lu(k,1743) = lu(k,1743) - lu(k,610) * lu(k,1732) - lu(k,1746) = lu(k,1746) - lu(k,611) * lu(k,1732) - lu(k,1747) = lu(k,1747) - lu(k,612) * lu(k,1732) - lu(k,1748) = lu(k,1748) - lu(k,613) * lu(k,1732) - lu(k,1749) = lu(k,1749) - lu(k,614) * lu(k,1732) - lu(k,1750) = lu(k,1750) - lu(k,615) * lu(k,1732) - lu(k,1753) = lu(k,1753) - lu(k,616) * lu(k,1732) - lu(k,1754) = lu(k,1754) - lu(k,617) * lu(k,1732) - lu(k,1755) = lu(k,1755) - lu(k,618) * lu(k,1732) - lu(k,1756) = - lu(k,619) * lu(k,1732) - lu(k,1758) = lu(k,1758) - lu(k,620) * lu(k,1732) - lu(k,1759) = lu(k,1759) - lu(k,621) * lu(k,1732) - lu(k,1761) = lu(k,1761) - lu(k,622) * lu(k,1732) - lu(k,1762) = lu(k,1762) - lu(k,623) * lu(k,1732) - lu(k,1763) = lu(k,1763) - lu(k,624) * lu(k,1732) - lu(k,1768) = lu(k,1768) - lu(k,607) * lu(k,1767) - lu(k,1772) = lu(k,1772) - lu(k,608) * lu(k,1767) - lu(k,1773) = lu(k,1773) - lu(k,609) * lu(k,1767) - lu(k,1778) = lu(k,1778) - lu(k,610) * lu(k,1767) - lu(k,1781) = lu(k,1781) - lu(k,611) * lu(k,1767) - lu(k,1782) = lu(k,1782) - lu(k,612) * lu(k,1767) - lu(k,1783) = lu(k,1783) - lu(k,613) * lu(k,1767) - lu(k,1784) = lu(k,1784) - lu(k,614) * lu(k,1767) - lu(k,1785) = lu(k,1785) - lu(k,615) * lu(k,1767) - lu(k,1788) = lu(k,1788) - lu(k,616) * lu(k,1767) - lu(k,1789) = lu(k,1789) - lu(k,617) * lu(k,1767) - lu(k,1790) = lu(k,1790) - lu(k,618) * lu(k,1767) - lu(k,1791) = lu(k,1791) - lu(k,619) * lu(k,1767) - lu(k,1793) = lu(k,1793) - lu(k,620) * lu(k,1767) - lu(k,1794) = lu(k,1794) - lu(k,621) * lu(k,1767) - lu(k,1796) = lu(k,1796) - lu(k,622) * lu(k,1767) - lu(k,1797) = lu(k,1797) - lu(k,623) * lu(k,1767) - lu(k,1798) = lu(k,1798) - lu(k,624) * lu(k,1767) - lu(k,1827) = lu(k,1827) - lu(k,607) * lu(k,1826) - lu(k,1830) = lu(k,1830) - lu(k,608) * lu(k,1826) - lu(k,1831) = lu(k,1831) - lu(k,609) * lu(k,1826) - lu(k,1836) = lu(k,1836) - lu(k,610) * lu(k,1826) - lu(k,1839) = lu(k,1839) - lu(k,611) * lu(k,1826) - lu(k,1840) = lu(k,1840) - lu(k,612) * lu(k,1826) - lu(k,1841) = lu(k,1841) - lu(k,613) * lu(k,1826) - lu(k,1842) = lu(k,1842) - lu(k,614) * lu(k,1826) - lu(k,1843) = lu(k,1843) - lu(k,615) * lu(k,1826) - lu(k,1846) = lu(k,1846) - lu(k,616) * lu(k,1826) - lu(k,1847) = lu(k,1847) - lu(k,617) * lu(k,1826) - lu(k,1848) = lu(k,1848) - lu(k,618) * lu(k,1826) - lu(k,1849) = lu(k,1849) - lu(k,619) * lu(k,1826) - lu(k,1851) = lu(k,1851) - lu(k,620) * lu(k,1826) - lu(k,1852) = lu(k,1852) - lu(k,621) * lu(k,1826) - lu(k,1854) = lu(k,1854) - lu(k,622) * lu(k,1826) - lu(k,1855) = lu(k,1855) - lu(k,623) * lu(k,1826) - lu(k,1856) = lu(k,1856) - lu(k,624) * lu(k,1826) + lu(k,579) = 1._r8 / lu(k,579) + lu(k,580) = lu(k,580) * lu(k,579) + lu(k,581) = lu(k,581) * lu(k,579) + lu(k,582) = lu(k,582) * lu(k,579) + lu(k,583) = lu(k,583) * lu(k,579) + lu(k,584) = lu(k,584) * lu(k,579) + lu(k,585) = lu(k,585) * lu(k,579) + lu(k,586) = lu(k,586) * lu(k,579) + lu(k,587) = lu(k,587) * lu(k,579) + lu(k,588) = lu(k,588) * lu(k,579) + lu(k,589) = lu(k,589) * lu(k,579) + lu(k,590) = lu(k,590) * lu(k,579) + lu(k,712) = lu(k,712) - lu(k,580) * lu(k,711) + lu(k,713) = - lu(k,581) * lu(k,711) + lu(k,714) = - lu(k,582) * lu(k,711) + lu(k,715) = lu(k,715) - lu(k,583) * lu(k,711) + lu(k,716) = lu(k,716) - lu(k,584) * lu(k,711) + lu(k,719) = lu(k,719) - lu(k,585) * lu(k,711) + lu(k,720) = lu(k,720) - lu(k,586) * lu(k,711) + lu(k,725) = lu(k,725) - lu(k,587) * lu(k,711) + lu(k,726) = lu(k,726) - lu(k,588) * lu(k,711) + lu(k,727) = - lu(k,589) * lu(k,711) + lu(k,729) = lu(k,729) - lu(k,590) * lu(k,711) + lu(k,734) = lu(k,734) - lu(k,580) * lu(k,732) + lu(k,735) = lu(k,735) - lu(k,581) * lu(k,732) + lu(k,736) = lu(k,736) - lu(k,582) * lu(k,732) + lu(k,737) = lu(k,737) - lu(k,583) * lu(k,732) + lu(k,738) = lu(k,738) - lu(k,584) * lu(k,732) + lu(k,742) = lu(k,742) - lu(k,585) * lu(k,732) + lu(k,743) = lu(k,743) - lu(k,586) * lu(k,732) + lu(k,748) = - lu(k,587) * lu(k,732) + lu(k,751) = - lu(k,588) * lu(k,732) + lu(k,752) = lu(k,752) - lu(k,589) * lu(k,732) + lu(k,754) = lu(k,754) - lu(k,590) * lu(k,732) + lu(k,782) = lu(k,782) - lu(k,580) * lu(k,780) + lu(k,783) = lu(k,783) - lu(k,581) * lu(k,780) + lu(k,784) = lu(k,784) - lu(k,582) * lu(k,780) + lu(k,785) = lu(k,785) - lu(k,583) * lu(k,780) + lu(k,786) = lu(k,786) - lu(k,584) * lu(k,780) + lu(k,790) = lu(k,790) - lu(k,585) * lu(k,780) + lu(k,791) = lu(k,791) - lu(k,586) * lu(k,780) + lu(k,799) = lu(k,799) - lu(k,587) * lu(k,780) + lu(k,802) = lu(k,802) - lu(k,588) * lu(k,780) + lu(k,803) = lu(k,803) - lu(k,589) * lu(k,780) + lu(k,805) = lu(k,805) - lu(k,590) * lu(k,780) + lu(k,894) = lu(k,894) - lu(k,580) * lu(k,892) + lu(k,895) = lu(k,895) - lu(k,581) * lu(k,892) + lu(k,896) = lu(k,896) - lu(k,582) * lu(k,892) + lu(k,897) = lu(k,897) - lu(k,583) * lu(k,892) + lu(k,898) = lu(k,898) - lu(k,584) * lu(k,892) + lu(k,902) = lu(k,902) - lu(k,585) * lu(k,892) + lu(k,904) = lu(k,904) - lu(k,586) * lu(k,892) + lu(k,912) = lu(k,912) - lu(k,587) * lu(k,892) + lu(k,915) = lu(k,915) - lu(k,588) * lu(k,892) + lu(k,916) = - lu(k,589) * lu(k,892) + lu(k,918) = lu(k,918) - lu(k,590) * lu(k,892) + lu(k,977) = lu(k,977) - lu(k,580) * lu(k,975) + lu(k,978) = lu(k,978) - lu(k,581) * lu(k,975) + lu(k,979) = lu(k,979) - lu(k,582) * lu(k,975) + lu(k,980) = lu(k,980) - lu(k,583) * lu(k,975) + lu(k,981) = lu(k,981) - lu(k,584) * lu(k,975) + lu(k,986) = lu(k,986) - lu(k,585) * lu(k,975) + lu(k,988) = lu(k,988) - lu(k,586) * lu(k,975) + lu(k,996) = lu(k,996) - lu(k,587) * lu(k,975) + lu(k,999) = lu(k,999) - lu(k,588) * lu(k,975) + lu(k,1000) = lu(k,1000) - lu(k,589) * lu(k,975) + lu(k,1002) = lu(k,1002) - lu(k,590) * lu(k,975) + lu(k,1088) = lu(k,1088) - lu(k,580) * lu(k,1084) + lu(k,1089) = lu(k,1089) - lu(k,581) * lu(k,1084) + lu(k,1090) = - lu(k,582) * lu(k,1084) + lu(k,1092) = lu(k,1092) - lu(k,583) * lu(k,1084) + lu(k,1094) = lu(k,1094) - lu(k,584) * lu(k,1084) + lu(k,1100) = lu(k,1100) - lu(k,585) * lu(k,1084) + lu(k,1102) = lu(k,1102) - lu(k,586) * lu(k,1084) + lu(k,1112) = lu(k,1112) - lu(k,587) * lu(k,1084) + lu(k,1115) = lu(k,1115) - lu(k,588) * lu(k,1084) + lu(k,1116) = lu(k,1116) - lu(k,589) * lu(k,1084) + lu(k,1118) = lu(k,1118) - lu(k,590) * lu(k,1084) + lu(k,1277) = lu(k,1277) - lu(k,580) * lu(k,1274) + lu(k,1278) = lu(k,1278) - lu(k,581) * lu(k,1274) + lu(k,1279) = lu(k,1279) - lu(k,582) * lu(k,1274) + lu(k,1283) = lu(k,1283) - lu(k,583) * lu(k,1274) + lu(k,1285) = lu(k,1285) - lu(k,584) * lu(k,1274) + lu(k,1292) = lu(k,1292) - lu(k,585) * lu(k,1274) + lu(k,1294) = lu(k,1294) - lu(k,586) * lu(k,1274) + lu(k,1304) = lu(k,1304) - lu(k,587) * lu(k,1274) + lu(k,1307) = lu(k,1307) - lu(k,588) * lu(k,1274) + lu(k,1308) = lu(k,1308) - lu(k,589) * lu(k,1274) + lu(k,1310) = lu(k,1310) - lu(k,590) * lu(k,1274) + lu(k,1486) = lu(k,1486) - lu(k,580) * lu(k,1484) + lu(k,1487) = - lu(k,581) * lu(k,1484) + lu(k,1488) = lu(k,1488) - lu(k,582) * lu(k,1484) + lu(k,1492) = lu(k,1492) - lu(k,583) * lu(k,1484) + lu(k,1494) = lu(k,1494) - lu(k,584) * lu(k,1484) + lu(k,1501) = lu(k,1501) - lu(k,585) * lu(k,1484) + lu(k,1503) = lu(k,1503) - lu(k,586) * lu(k,1484) + lu(k,1513) = lu(k,1513) - lu(k,587) * lu(k,1484) + lu(k,1516) = - lu(k,588) * lu(k,1484) + lu(k,1517) = lu(k,1517) - lu(k,589) * lu(k,1484) + lu(k,1519) = lu(k,1519) - lu(k,590) * lu(k,1484) + lu(k,1616) = lu(k,1616) - lu(k,580) * lu(k,1610) + lu(k,1617) = - lu(k,581) * lu(k,1610) + lu(k,1618) = lu(k,1618) - lu(k,582) * lu(k,1610) + lu(k,1621) = lu(k,1621) - lu(k,583) * lu(k,1610) + lu(k,1623) = lu(k,1623) - lu(k,584) * lu(k,1610) + lu(k,1630) = lu(k,1630) - lu(k,585) * lu(k,1610) + lu(k,1632) = lu(k,1632) - lu(k,586) * lu(k,1610) + lu(k,1642) = lu(k,1642) - lu(k,587) * lu(k,1610) + lu(k,1645) = lu(k,1645) - lu(k,588) * lu(k,1610) + lu(k,1646) = lu(k,1646) - lu(k,589) * lu(k,1610) + lu(k,1648) = lu(k,1648) - lu(k,590) * lu(k,1610) + lu(k,1701) = lu(k,1701) - lu(k,580) * lu(k,1697) + lu(k,1702) = lu(k,1702) - lu(k,581) * lu(k,1697) + lu(k,1703) = lu(k,1703) - lu(k,582) * lu(k,1697) + lu(k,1706) = lu(k,1706) - lu(k,583) * lu(k,1697) + lu(k,1708) = lu(k,1708) - lu(k,584) * lu(k,1697) + lu(k,1715) = lu(k,1715) - lu(k,585) * lu(k,1697) + lu(k,1717) = lu(k,1717) - lu(k,586) * lu(k,1697) + lu(k,1727) = lu(k,1727) - lu(k,587) * lu(k,1697) + lu(k,1730) = lu(k,1730) - lu(k,588) * lu(k,1697) + lu(k,1731) = lu(k,1731) - lu(k,589) * lu(k,1697) + lu(k,1733) = lu(k,1733) - lu(k,590) * lu(k,1697) + lu(k,1745) = lu(k,1745) - lu(k,580) * lu(k,1744) + lu(k,1746) = lu(k,1746) - lu(k,581) * lu(k,1744) + lu(k,1747) = - lu(k,582) * lu(k,1744) + lu(k,1751) = lu(k,1751) - lu(k,583) * lu(k,1744) + lu(k,1753) = lu(k,1753) - lu(k,584) * lu(k,1744) + lu(k,1760) = lu(k,1760) - lu(k,585) * lu(k,1744) + lu(k,1762) = lu(k,1762) - lu(k,586) * lu(k,1744) + lu(k,1772) = lu(k,1772) - lu(k,587) * lu(k,1744) + lu(k,1775) = lu(k,1775) - lu(k,588) * lu(k,1744) + lu(k,1776) = lu(k,1776) - lu(k,589) * lu(k,1744) + lu(k,1778) = lu(k,1778) - lu(k,590) * lu(k,1744) + lu(k,1795) = lu(k,1795) - lu(k,580) * lu(k,1793) + lu(k,1796) = - lu(k,581) * lu(k,1793) + lu(k,1797) = lu(k,1797) - lu(k,582) * lu(k,1793) + lu(k,1800) = lu(k,1800) - lu(k,583) * lu(k,1793) + lu(k,1802) = lu(k,1802) - lu(k,584) * lu(k,1793) + lu(k,1809) = lu(k,1809) - lu(k,585) * lu(k,1793) + lu(k,1811) = lu(k,1811) - lu(k,586) * lu(k,1793) + lu(k,1821) = lu(k,1821) - lu(k,587) * lu(k,1793) + lu(k,1824) = lu(k,1824) - lu(k,588) * lu(k,1793) + lu(k,1825) = lu(k,1825) - lu(k,589) * lu(k,1793) + lu(k,1827) = lu(k,1827) - lu(k,590) * lu(k,1793) + lu(k,1905) = lu(k,1905) - lu(k,580) * lu(k,1903) + lu(k,1906) = - lu(k,581) * lu(k,1903) + lu(k,1907) = lu(k,1907) - lu(k,582) * lu(k,1903) + lu(k,1910) = lu(k,1910) - lu(k,583) * lu(k,1903) + lu(k,1912) = lu(k,1912) - lu(k,584) * lu(k,1903) + lu(k,1919) = lu(k,1919) - lu(k,585) * lu(k,1903) + lu(k,1921) = lu(k,1921) - lu(k,586) * lu(k,1903) + lu(k,1931) = lu(k,1931) - lu(k,587) * lu(k,1903) + lu(k,1934) = lu(k,1934) - lu(k,588) * lu(k,1903) + lu(k,1935) = lu(k,1935) - lu(k,589) * lu(k,1903) + lu(k,1937) = lu(k,1937) - lu(k,590) * lu(k,1903) + lu(k,1994) = - lu(k,580) * lu(k,1992) + lu(k,1995) = lu(k,1995) - lu(k,581) * lu(k,1992) + lu(k,1996) = lu(k,1996) - lu(k,582) * lu(k,1992) + lu(k,2000) = lu(k,2000) - lu(k,583) * lu(k,1992) + lu(k,2002) = lu(k,2002) - lu(k,584) * lu(k,1992) + lu(k,2009) = lu(k,2009) - lu(k,585) * lu(k,1992) + lu(k,2011) = lu(k,2011) - lu(k,586) * lu(k,1992) + lu(k,2021) = lu(k,2021) - lu(k,587) * lu(k,1992) + lu(k,2024) = lu(k,2024) - lu(k,588) * lu(k,1992) + lu(k,2025) = lu(k,2025) - lu(k,589) * lu(k,1992) + lu(k,2027) = lu(k,2027) - lu(k,590) * lu(k,1992) + lu(k,2055) = lu(k,2055) - lu(k,580) * lu(k,2050) + lu(k,2056) = lu(k,2056) - lu(k,581) * lu(k,2050) + lu(k,2057) = lu(k,2057) - lu(k,582) * lu(k,2050) + lu(k,2060) = lu(k,2060) - lu(k,583) * lu(k,2050) + lu(k,2062) = lu(k,2062) - lu(k,584) * lu(k,2050) + lu(k,2069) = lu(k,2069) - lu(k,585) * lu(k,2050) + lu(k,2071) = lu(k,2071) - lu(k,586) * lu(k,2050) + lu(k,2081) = lu(k,2081) - lu(k,587) * lu(k,2050) + lu(k,2084) = lu(k,2084) - lu(k,588) * lu(k,2050) + lu(k,2085) = lu(k,2085) - lu(k,589) * lu(k,2050) + lu(k,2087) = lu(k,2087) - lu(k,590) * lu(k,2050) + 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,599) = lu(k,599) * lu(k,591) + lu(k,600) = lu(k,600) * lu(k,591) + lu(k,601) = lu(k,601) * lu(k,591) + lu(k,602) = lu(k,602) * lu(k,591) + lu(k,603) = lu(k,603) * lu(k,591) + lu(k,604) = lu(k,604) * lu(k,591) + lu(k,605) = lu(k,605) * lu(k,591) + lu(k,831) = - lu(k,592) * lu(k,828) + lu(k,833) = lu(k,833) - lu(k,593) * lu(k,828) + lu(k,835) = lu(k,835) - lu(k,594) * lu(k,828) + lu(k,836) = - lu(k,595) * lu(k,828) + lu(k,840) = lu(k,840) - lu(k,596) * lu(k,828) + lu(k,842) = lu(k,842) - lu(k,597) * lu(k,828) + lu(k,846) = lu(k,846) - lu(k,598) * lu(k,828) + lu(k,848) = lu(k,848) - lu(k,599) * lu(k,828) + lu(k,850) = lu(k,850) - lu(k,600) * lu(k,828) + lu(k,852) = lu(k,852) - lu(k,601) * lu(k,828) + lu(k,853) = - lu(k,602) * lu(k,828) + lu(k,854) = - lu(k,603) * lu(k,828) + lu(k,855) = lu(k,855) - lu(k,604) * lu(k,828) + lu(k,856) = lu(k,856) - lu(k,605) * lu(k,828) + lu(k,1008) = lu(k,1008) - lu(k,592) * lu(k,1004) + lu(k,1009) = lu(k,1009) - lu(k,593) * lu(k,1004) + lu(k,1011) = lu(k,1011) - lu(k,594) * lu(k,1004) + lu(k,1012) = - lu(k,595) * lu(k,1004) + lu(k,1017) = lu(k,1017) - lu(k,596) * lu(k,1004) + lu(k,1019) = lu(k,1019) - lu(k,597) * lu(k,1004) + lu(k,1023) = lu(k,1023) - lu(k,598) * lu(k,1004) + lu(k,1025) = lu(k,1025) - lu(k,599) * lu(k,1004) + lu(k,1027) = lu(k,1027) - lu(k,600) * lu(k,1004) + lu(k,1029) = lu(k,1029) - lu(k,601) * lu(k,1004) + lu(k,1030) = lu(k,1030) - lu(k,602) * lu(k,1004) + lu(k,1031) = lu(k,1031) - lu(k,603) * lu(k,1004) + lu(k,1032) = - lu(k,604) * lu(k,1004) + lu(k,1033) = lu(k,1033) - lu(k,605) * lu(k,1004) + lu(k,1282) = lu(k,1282) - lu(k,592) * lu(k,1275) + lu(k,1284) = lu(k,1284) - lu(k,593) * lu(k,1275) + lu(k,1286) = lu(k,1286) - lu(k,594) * lu(k,1275) + lu(k,1287) = lu(k,1287) - lu(k,595) * lu(k,1275) + lu(k,1292) = lu(k,1292) - lu(k,596) * lu(k,1275) + lu(k,1294) = lu(k,1294) - lu(k,597) * lu(k,1275) + lu(k,1298) = lu(k,1298) - lu(k,598) * lu(k,1275) + lu(k,1300) = lu(k,1300) - lu(k,599) * lu(k,1275) + lu(k,1302) = lu(k,1302) - lu(k,600) * lu(k,1275) + lu(k,1304) = lu(k,1304) - lu(k,601) * lu(k,1275) + lu(k,1305) = lu(k,1305) - lu(k,602) * lu(k,1275) + lu(k,1306) = lu(k,1306) - lu(k,603) * lu(k,1275) + lu(k,1307) = lu(k,1307) - lu(k,604) * lu(k,1275) + lu(k,1308) = lu(k,1308) - lu(k,605) * lu(k,1275) + lu(k,1360) = - lu(k,592) * lu(k,1354) + lu(k,1362) = lu(k,1362) - lu(k,593) * lu(k,1354) + lu(k,1364) = lu(k,1364) - lu(k,594) * lu(k,1354) + lu(k,1365) = lu(k,1365) - lu(k,595) * lu(k,1354) + lu(k,1370) = lu(k,1370) - lu(k,596) * lu(k,1354) + lu(k,1372) = lu(k,1372) - lu(k,597) * lu(k,1354) + lu(k,1376) = lu(k,1376) - lu(k,598) * lu(k,1354) + lu(k,1378) = - lu(k,599) * lu(k,1354) + lu(k,1380) = lu(k,1380) - lu(k,600) * lu(k,1354) + lu(k,1382) = lu(k,1382) - lu(k,601) * lu(k,1354) + lu(k,1383) = lu(k,1383) - lu(k,602) * lu(k,1354) + lu(k,1384) = - lu(k,603) * lu(k,1354) + lu(k,1385) = lu(k,1385) - lu(k,604) * lu(k,1354) + lu(k,1386) = lu(k,1386) - lu(k,605) * lu(k,1354) + lu(k,1527) = lu(k,1527) - lu(k,592) * lu(k,1524) + lu(k,1529) = lu(k,1529) - lu(k,593) * lu(k,1524) + lu(k,1531) = - lu(k,594) * lu(k,1524) + lu(k,1532) = lu(k,1532) - lu(k,595) * lu(k,1524) + lu(k,1537) = lu(k,1537) - lu(k,596) * lu(k,1524) + lu(k,1539) = lu(k,1539) - lu(k,597) * lu(k,1524) + lu(k,1543) = lu(k,1543) - lu(k,598) * lu(k,1524) + lu(k,1545) = lu(k,1545) - lu(k,599) * lu(k,1524) + lu(k,1547) = lu(k,1547) - lu(k,600) * lu(k,1524) + lu(k,1549) = lu(k,1549) - lu(k,601) * lu(k,1524) + lu(k,1550) = - lu(k,602) * lu(k,1524) + lu(k,1551) = lu(k,1551) - lu(k,603) * lu(k,1524) + lu(k,1552) = lu(k,1552) - lu(k,604) * lu(k,1524) + lu(k,1553) = lu(k,1553) - lu(k,605) * lu(k,1524) + lu(k,1620) = lu(k,1620) - lu(k,592) * lu(k,1611) + lu(k,1622) = lu(k,1622) - lu(k,593) * lu(k,1611) + lu(k,1624) = lu(k,1624) - lu(k,594) * lu(k,1611) + lu(k,1625) = lu(k,1625) - lu(k,595) * lu(k,1611) + lu(k,1630) = lu(k,1630) - lu(k,596) * lu(k,1611) + lu(k,1632) = lu(k,1632) - lu(k,597) * lu(k,1611) + lu(k,1636) = lu(k,1636) - lu(k,598) * lu(k,1611) + lu(k,1638) = lu(k,1638) - lu(k,599) * lu(k,1611) + lu(k,1640) = lu(k,1640) - lu(k,600) * lu(k,1611) + lu(k,1642) = lu(k,1642) - lu(k,601) * lu(k,1611) + lu(k,1643) = lu(k,1643) - lu(k,602) * lu(k,1611) + lu(k,1644) = lu(k,1644) - lu(k,603) * lu(k,1611) + lu(k,1645) = lu(k,1645) - lu(k,604) * lu(k,1611) + lu(k,1646) = lu(k,1646) - lu(k,605) * lu(k,1611) + lu(k,1705) = lu(k,1705) - lu(k,592) * lu(k,1698) + lu(k,1707) = lu(k,1707) - lu(k,593) * lu(k,1698) + lu(k,1709) = lu(k,1709) - lu(k,594) * lu(k,1698) + lu(k,1710) = lu(k,1710) - lu(k,595) * lu(k,1698) + lu(k,1715) = lu(k,1715) - lu(k,596) * lu(k,1698) + lu(k,1717) = lu(k,1717) - lu(k,597) * lu(k,1698) + lu(k,1721) = - lu(k,598) * lu(k,1698) + lu(k,1723) = lu(k,1723) - lu(k,599) * lu(k,1698) + lu(k,1725) = lu(k,1725) - lu(k,600) * lu(k,1698) + lu(k,1727) = lu(k,1727) - lu(k,601) * lu(k,1698) + lu(k,1728) = - lu(k,602) * lu(k,1698) + lu(k,1729) = lu(k,1729) - lu(k,603) * lu(k,1698) + lu(k,1730) = lu(k,1730) - lu(k,604) * lu(k,1698) + lu(k,1731) = lu(k,1731) - lu(k,605) * lu(k,1698) + lu(k,1799) = - lu(k,592) * lu(k,1794) + lu(k,1801) = - lu(k,593) * lu(k,1794) + lu(k,1803) = lu(k,1803) - lu(k,594) * lu(k,1794) + lu(k,1804) = lu(k,1804) - lu(k,595) * lu(k,1794) + lu(k,1809) = lu(k,1809) - lu(k,596) * lu(k,1794) + lu(k,1811) = lu(k,1811) - lu(k,597) * lu(k,1794) + lu(k,1815) = lu(k,1815) - lu(k,598) * lu(k,1794) + lu(k,1817) = lu(k,1817) - lu(k,599) * lu(k,1794) + lu(k,1819) = lu(k,1819) - lu(k,600) * lu(k,1794) + lu(k,1821) = lu(k,1821) - lu(k,601) * lu(k,1794) + lu(k,1822) = - lu(k,602) * lu(k,1794) + lu(k,1823) = lu(k,1823) - lu(k,603) * lu(k,1794) + lu(k,1824) = lu(k,1824) - lu(k,604) * lu(k,1794) + lu(k,1825) = lu(k,1825) - lu(k,605) * lu(k,1794) + lu(k,1832) = - lu(k,592) * lu(k,1830) + lu(k,1834) = lu(k,1834) - lu(k,593) * lu(k,1830) + lu(k,1836) = - lu(k,594) * lu(k,1830) + lu(k,1837) = lu(k,1837) - lu(k,595) * lu(k,1830) + lu(k,1842) = lu(k,1842) - lu(k,596) * lu(k,1830) + lu(k,1844) = lu(k,1844) - lu(k,597) * lu(k,1830) + lu(k,1848) = - lu(k,598) * lu(k,1830) + lu(k,1850) = lu(k,1850) - lu(k,599) * lu(k,1830) + lu(k,1852) = lu(k,1852) - lu(k,600) * lu(k,1830) + lu(k,1854) = lu(k,1854) - lu(k,601) * lu(k,1830) + lu(k,1855) = lu(k,1855) - lu(k,602) * lu(k,1830) + lu(k,1856) = - lu(k,603) * lu(k,1830) + lu(k,1857) = lu(k,1857) - lu(k,604) * lu(k,1830) + lu(k,1858) = lu(k,1858) - lu(k,605) * lu(k,1830) + lu(k,1868) = lu(k,1868) - lu(k,592) * lu(k,1863) + lu(k,1870) = lu(k,1870) - lu(k,593) * lu(k,1863) + lu(k,1872) = lu(k,1872) - lu(k,594) * lu(k,1863) + lu(k,1873) = lu(k,1873) - lu(k,595) * lu(k,1863) + lu(k,1878) = lu(k,1878) - lu(k,596) * lu(k,1863) + lu(k,1880) = lu(k,1880) - lu(k,597) * lu(k,1863) + lu(k,1884) = lu(k,1884) - lu(k,598) * lu(k,1863) + lu(k,1886) = lu(k,1886) - lu(k,599) * lu(k,1863) + lu(k,1888) = lu(k,1888) - lu(k,600) * lu(k,1863) + lu(k,1890) = lu(k,1890) - lu(k,601) * lu(k,1863) + lu(k,1891) = lu(k,1891) - lu(k,602) * lu(k,1863) + lu(k,1892) = lu(k,1892) - lu(k,603) * lu(k,1863) + lu(k,1893) = lu(k,1893) - lu(k,604) * lu(k,1863) + lu(k,1894) = lu(k,1894) - lu(k,605) * lu(k,1863) + lu(k,1909) = lu(k,1909) - lu(k,592) * lu(k,1904) + lu(k,1911) = lu(k,1911) - lu(k,593) * lu(k,1904) + lu(k,1913) = - lu(k,594) * lu(k,1904) + lu(k,1914) = lu(k,1914) - lu(k,595) * lu(k,1904) + lu(k,1919) = lu(k,1919) - lu(k,596) * lu(k,1904) + lu(k,1921) = lu(k,1921) - lu(k,597) * lu(k,1904) + lu(k,1925) = lu(k,1925) - lu(k,598) * lu(k,1904) + lu(k,1927) = lu(k,1927) - lu(k,599) * lu(k,1904) + lu(k,1929) = lu(k,1929) - lu(k,600) * lu(k,1904) + lu(k,1931) = lu(k,1931) - lu(k,601) * lu(k,1904) + lu(k,1932) = lu(k,1932) - lu(k,602) * lu(k,1904) + lu(k,1933) = lu(k,1933) - lu(k,603) * lu(k,1904) + lu(k,1934) = lu(k,1934) - lu(k,604) * lu(k,1904) + lu(k,1935) = lu(k,1935) - lu(k,605) * lu(k,1904) + lu(k,1951) = - lu(k,592) * lu(k,1948) + lu(k,1953) = - lu(k,593) * lu(k,1948) + lu(k,1955) = lu(k,1955) - lu(k,594) * lu(k,1948) + lu(k,1956) = lu(k,1956) - lu(k,595) * lu(k,1948) + lu(k,1961) = lu(k,1961) - lu(k,596) * lu(k,1948) + lu(k,1963) = lu(k,1963) - lu(k,597) * lu(k,1948) + lu(k,1967) = lu(k,1967) - lu(k,598) * lu(k,1948) + lu(k,1969) = lu(k,1969) - lu(k,599) * lu(k,1948) + lu(k,1971) = lu(k,1971) - lu(k,600) * lu(k,1948) + lu(k,1973) = lu(k,1973) - lu(k,601) * lu(k,1948) + lu(k,1974) = lu(k,1974) - lu(k,602) * lu(k,1948) + lu(k,1975) = lu(k,1975) - lu(k,603) * lu(k,1948) + lu(k,1976) = lu(k,1976) - lu(k,604) * lu(k,1948) + lu(k,1977) = lu(k,1977) - lu(k,605) * lu(k,1948) end do end subroutine lu_fac15 subroutine lu_fac16( avec_len, lu ) @@ -4816,820 +3736,617 @@ subroutine lu_fac16( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,637) = 1._r8 / lu(k,637) - lu(k,638) = lu(k,638) * lu(k,637) - lu(k,639) = lu(k,639) * lu(k,637) - lu(k,640) = lu(k,640) * lu(k,637) - lu(k,641) = lu(k,641) * lu(k,637) - lu(k,642) = lu(k,642) * lu(k,637) - lu(k,643) = lu(k,643) * lu(k,637) - lu(k,644) = lu(k,644) * lu(k,637) - lu(k,645) = lu(k,645) * lu(k,637) - lu(k,646) = lu(k,646) * lu(k,637) - lu(k,647) = lu(k,647) * lu(k,637) - lu(k,648) = lu(k,648) * lu(k,637) - lu(k,649) = lu(k,649) * lu(k,637) - lu(k,650) = lu(k,650) * lu(k,637) - lu(k,651) = lu(k,651) * lu(k,637) - lu(k,652) = lu(k,652) * lu(k,637) - lu(k,653) = lu(k,653) * lu(k,637) - lu(k,654) = lu(k,654) * lu(k,637) - lu(k,655) = lu(k,655) * lu(k,637) - lu(k,656) = lu(k,656) * lu(k,637) - lu(k,657) = lu(k,657) * lu(k,637) - lu(k,747) = lu(k,747) - lu(k,638) * lu(k,746) - lu(k,748) = lu(k,748) - lu(k,639) * lu(k,746) - lu(k,749) = lu(k,749) - lu(k,640) * lu(k,746) - lu(k,750) = lu(k,750) - lu(k,641) * lu(k,746) - lu(k,752) = lu(k,752) - lu(k,642) * lu(k,746) - lu(k,753) = lu(k,753) - lu(k,643) * lu(k,746) - lu(k,754) = lu(k,754) - lu(k,644) * lu(k,746) - lu(k,755) = lu(k,755) - lu(k,645) * lu(k,746) - lu(k,756) = lu(k,756) - lu(k,646) * lu(k,746) - lu(k,757) = - lu(k,647) * lu(k,746) - lu(k,758) = - lu(k,648) * lu(k,746) - lu(k,759) = lu(k,759) - lu(k,649) * lu(k,746) - lu(k,760) = lu(k,760) - lu(k,650) * lu(k,746) - lu(k,761) = lu(k,761) - lu(k,651) * lu(k,746) - lu(k,762) = lu(k,762) - lu(k,652) * lu(k,746) - lu(k,763) = lu(k,763) - lu(k,653) * lu(k,746) - lu(k,764) = lu(k,764) - lu(k,654) * lu(k,746) - lu(k,765) = lu(k,765) - lu(k,655) * lu(k,746) - lu(k,766) = lu(k,766) - lu(k,656) * lu(k,746) - lu(k,767) = lu(k,767) - lu(k,657) * lu(k,746) - lu(k,793) = lu(k,793) - lu(k,638) * lu(k,792) - lu(k,794) = lu(k,794) - lu(k,639) * lu(k,792) - lu(k,796) = lu(k,796) - lu(k,640) * lu(k,792) - lu(k,797) = lu(k,797) - lu(k,641) * lu(k,792) - lu(k,799) = lu(k,799) - lu(k,642) * lu(k,792) - lu(k,800) = lu(k,800) - lu(k,643) * lu(k,792) - lu(k,801) = lu(k,801) - lu(k,644) * lu(k,792) - lu(k,802) = lu(k,802) - lu(k,645) * lu(k,792) - lu(k,803) = lu(k,803) - lu(k,646) * lu(k,792) - lu(k,804) = - lu(k,647) * lu(k,792) - lu(k,805) = lu(k,805) - lu(k,648) * lu(k,792) - lu(k,806) = lu(k,806) - lu(k,649) * lu(k,792) - lu(k,807) = lu(k,807) - lu(k,650) * lu(k,792) - lu(k,808) = lu(k,808) - lu(k,651) * lu(k,792) - lu(k,809) = lu(k,809) - lu(k,652) * lu(k,792) - lu(k,810) = lu(k,810) - lu(k,653) * lu(k,792) - lu(k,811) = lu(k,811) - lu(k,654) * lu(k,792) - lu(k,812) = lu(k,812) - lu(k,655) * lu(k,792) - lu(k,813) = lu(k,813) - lu(k,656) * lu(k,792) - lu(k,814) = lu(k,814) - lu(k,657) * lu(k,792) - lu(k,896) = lu(k,896) - lu(k,638) * lu(k,892) - lu(k,897) = lu(k,897) - lu(k,639) * lu(k,892) - lu(k,902) = lu(k,902) - lu(k,640) * lu(k,892) - lu(k,903) = lu(k,903) - lu(k,641) * lu(k,892) - lu(k,905) = lu(k,905) - lu(k,642) * lu(k,892) - lu(k,906) = lu(k,906) - lu(k,643) * lu(k,892) - lu(k,907) = - lu(k,644) * lu(k,892) - lu(k,908) = lu(k,908) - lu(k,645) * lu(k,892) - lu(k,909) = lu(k,909) - lu(k,646) * lu(k,892) - lu(k,910) = lu(k,910) - lu(k,647) * lu(k,892) - lu(k,911) = lu(k,911) - lu(k,648) * lu(k,892) - lu(k,912) = lu(k,912) - lu(k,649) * lu(k,892) - lu(k,913) = lu(k,913) - lu(k,650) * lu(k,892) - lu(k,914) = lu(k,914) - lu(k,651) * lu(k,892) - lu(k,915) = lu(k,915) - lu(k,652) * lu(k,892) - lu(k,917) = - lu(k,653) * lu(k,892) - lu(k,918) = - lu(k,654) * lu(k,892) - lu(k,920) = - lu(k,655) * lu(k,892) - lu(k,921) = lu(k,921) - lu(k,656) * lu(k,892) - lu(k,922) = lu(k,922) - lu(k,657) * lu(k,892) - lu(k,984) = lu(k,984) - lu(k,638) * lu(k,981) - lu(k,985) = lu(k,985) - lu(k,639) * lu(k,981) - lu(k,990) = lu(k,990) - lu(k,640) * lu(k,981) - lu(k,991) = lu(k,991) - lu(k,641) * lu(k,981) - lu(k,993) = lu(k,993) - lu(k,642) * lu(k,981) - lu(k,994) = lu(k,994) - lu(k,643) * lu(k,981) - lu(k,995) = lu(k,995) - lu(k,644) * lu(k,981) - lu(k,996) = lu(k,996) - lu(k,645) * lu(k,981) - lu(k,997) = lu(k,997) - lu(k,646) * lu(k,981) - lu(k,998) = lu(k,998) - lu(k,647) * lu(k,981) - lu(k,999) = lu(k,999) - lu(k,648) * lu(k,981) - lu(k,1000) = lu(k,1000) - lu(k,649) * lu(k,981) - lu(k,1001) = lu(k,1001) - lu(k,650) * lu(k,981) - lu(k,1002) = lu(k,1002) - lu(k,651) * lu(k,981) - lu(k,1003) = lu(k,1003) - lu(k,652) * lu(k,981) - lu(k,1005) = lu(k,1005) - lu(k,653) * lu(k,981) - lu(k,1006) = lu(k,1006) - lu(k,654) * lu(k,981) - lu(k,1008) = lu(k,1008) - lu(k,655) * lu(k,981) - lu(k,1009) = lu(k,1009) - lu(k,656) * lu(k,981) - lu(k,1010) = lu(k,1010) - lu(k,657) * lu(k,981) - lu(k,1107) = lu(k,1107) - lu(k,638) * lu(k,1105) - lu(k,1108) = lu(k,1108) - lu(k,639) * lu(k,1105) - lu(k,1112) = lu(k,1112) - lu(k,640) * lu(k,1105) - lu(k,1113) = lu(k,1113) - lu(k,641) * lu(k,1105) - lu(k,1115) = lu(k,1115) - lu(k,642) * lu(k,1105) - lu(k,1116) = lu(k,1116) - lu(k,643) * lu(k,1105) - lu(k,1117) = lu(k,1117) - lu(k,644) * lu(k,1105) - lu(k,1118) = lu(k,1118) - lu(k,645) * lu(k,1105) - lu(k,1119) = lu(k,1119) - lu(k,646) * lu(k,1105) - lu(k,1120) = - lu(k,647) * lu(k,1105) - lu(k,1121) = lu(k,1121) - lu(k,648) * lu(k,1105) - lu(k,1122) = lu(k,1122) - lu(k,649) * lu(k,1105) - lu(k,1123) = lu(k,1123) - lu(k,650) * lu(k,1105) - lu(k,1124) = lu(k,1124) - lu(k,651) * lu(k,1105) - lu(k,1125) = lu(k,1125) - lu(k,652) * lu(k,1105) - lu(k,1127) = lu(k,1127) - lu(k,653) * lu(k,1105) - lu(k,1128) = lu(k,1128) - lu(k,654) * lu(k,1105) - lu(k,1130) = lu(k,1130) - lu(k,655) * lu(k,1105) - lu(k,1131) = lu(k,1131) - lu(k,656) * lu(k,1105) - lu(k,1132) = lu(k,1132) - lu(k,657) * lu(k,1105) - lu(k,1150) = lu(k,1150) - lu(k,638) * lu(k,1146) - lu(k,1151) = lu(k,1151) - lu(k,639) * lu(k,1146) - lu(k,1156) = lu(k,1156) - lu(k,640) * lu(k,1146) - lu(k,1157) = lu(k,1157) - lu(k,641) * lu(k,1146) - lu(k,1159) = lu(k,1159) - lu(k,642) * lu(k,1146) - lu(k,1160) = lu(k,1160) - lu(k,643) * lu(k,1146) - lu(k,1161) = lu(k,1161) - lu(k,644) * lu(k,1146) - lu(k,1162) = lu(k,1162) - lu(k,645) * lu(k,1146) - lu(k,1163) = lu(k,1163) - lu(k,646) * lu(k,1146) - lu(k,1164) = lu(k,1164) - lu(k,647) * lu(k,1146) - lu(k,1165) = lu(k,1165) - lu(k,648) * lu(k,1146) - lu(k,1166) = lu(k,1166) - lu(k,649) * lu(k,1146) - lu(k,1167) = lu(k,1167) - lu(k,650) * lu(k,1146) - lu(k,1168) = lu(k,1168) - lu(k,651) * lu(k,1146) - lu(k,1169) = lu(k,1169) - lu(k,652) * lu(k,1146) - lu(k,1171) = lu(k,1171) - lu(k,653) * lu(k,1146) - lu(k,1172) = lu(k,1172) - lu(k,654) * lu(k,1146) - lu(k,1174) = lu(k,1174) - lu(k,655) * lu(k,1146) - lu(k,1175) = lu(k,1175) - lu(k,656) * lu(k,1146) - lu(k,1176) = lu(k,1176) - lu(k,657) * lu(k,1146) - lu(k,1191) = lu(k,1191) - lu(k,638) * lu(k,1187) - lu(k,1192) = lu(k,1192) - lu(k,639) * lu(k,1187) - lu(k,1197) = lu(k,1197) - lu(k,640) * lu(k,1187) - lu(k,1198) = lu(k,1198) - lu(k,641) * lu(k,1187) - lu(k,1200) = lu(k,1200) - lu(k,642) * lu(k,1187) - lu(k,1201) = lu(k,1201) - lu(k,643) * lu(k,1187) - lu(k,1202) = lu(k,1202) - lu(k,644) * lu(k,1187) - lu(k,1203) = lu(k,1203) - lu(k,645) * lu(k,1187) - lu(k,1204) = lu(k,1204) - lu(k,646) * lu(k,1187) - lu(k,1205) = lu(k,1205) - lu(k,647) * lu(k,1187) - lu(k,1206) = lu(k,1206) - lu(k,648) * lu(k,1187) - lu(k,1207) = lu(k,1207) - lu(k,649) * lu(k,1187) - lu(k,1208) = lu(k,1208) - lu(k,650) * lu(k,1187) - lu(k,1209) = lu(k,1209) - lu(k,651) * lu(k,1187) - lu(k,1210) = lu(k,1210) - lu(k,652) * lu(k,1187) - lu(k,1212) = lu(k,1212) - lu(k,653) * lu(k,1187) - lu(k,1213) = lu(k,1213) - lu(k,654) * lu(k,1187) - lu(k,1215) = lu(k,1215) - lu(k,655) * lu(k,1187) - lu(k,1216) = lu(k,1216) - lu(k,656) * lu(k,1187) - lu(k,1217) = lu(k,1217) - lu(k,657) * lu(k,1187) - lu(k,1240) = lu(k,1240) - lu(k,638) * lu(k,1236) - lu(k,1241) = lu(k,1241) - lu(k,639) * lu(k,1236) - lu(k,1246) = lu(k,1246) - lu(k,640) * lu(k,1236) - lu(k,1247) = lu(k,1247) - lu(k,641) * lu(k,1236) - lu(k,1249) = lu(k,1249) - lu(k,642) * lu(k,1236) - lu(k,1250) = lu(k,1250) - lu(k,643) * lu(k,1236) - lu(k,1251) = lu(k,1251) - lu(k,644) * lu(k,1236) - lu(k,1252) = lu(k,1252) - lu(k,645) * lu(k,1236) - lu(k,1253) = lu(k,1253) - lu(k,646) * lu(k,1236) - lu(k,1254) = lu(k,1254) - lu(k,647) * lu(k,1236) - lu(k,1255) = lu(k,1255) - lu(k,648) * lu(k,1236) - lu(k,1256) = lu(k,1256) - lu(k,649) * lu(k,1236) - lu(k,1257) = lu(k,1257) - lu(k,650) * lu(k,1236) - lu(k,1258) = lu(k,1258) - lu(k,651) * lu(k,1236) - lu(k,1259) = lu(k,1259) - lu(k,652) * lu(k,1236) - lu(k,1261) = lu(k,1261) - lu(k,653) * lu(k,1236) - lu(k,1262) = lu(k,1262) - lu(k,654) * lu(k,1236) - lu(k,1264) = lu(k,1264) - lu(k,655) * lu(k,1236) - lu(k,1265) = lu(k,1265) - lu(k,656) * lu(k,1236) - lu(k,1266) = lu(k,1266) - lu(k,657) * lu(k,1236) - lu(k,1279) = lu(k,1279) - lu(k,638) * lu(k,1276) - lu(k,1280) = lu(k,1280) - lu(k,639) * lu(k,1276) - lu(k,1285) = lu(k,1285) - lu(k,640) * lu(k,1276) - lu(k,1286) = lu(k,1286) - lu(k,641) * lu(k,1276) - lu(k,1288) = lu(k,1288) - lu(k,642) * lu(k,1276) - lu(k,1289) = lu(k,1289) - lu(k,643) * lu(k,1276) - lu(k,1290) = lu(k,1290) - lu(k,644) * lu(k,1276) - lu(k,1291) = lu(k,1291) - lu(k,645) * lu(k,1276) - lu(k,1292) = lu(k,1292) - lu(k,646) * lu(k,1276) - lu(k,1293) = lu(k,1293) - lu(k,647) * lu(k,1276) - lu(k,1294) = lu(k,1294) - lu(k,648) * lu(k,1276) - lu(k,1295) = lu(k,1295) - lu(k,649) * lu(k,1276) - lu(k,1296) = lu(k,1296) - lu(k,650) * lu(k,1276) - lu(k,1297) = lu(k,1297) - lu(k,651) * lu(k,1276) - lu(k,1298) = lu(k,1298) - lu(k,652) * lu(k,1276) - lu(k,1300) = lu(k,1300) - lu(k,653) * lu(k,1276) - lu(k,1301) = lu(k,1301) - lu(k,654) * lu(k,1276) - lu(k,1303) = lu(k,1303) - lu(k,655) * lu(k,1276) - lu(k,1304) = lu(k,1304) - lu(k,656) * lu(k,1276) - lu(k,1305) = lu(k,1305) - lu(k,657) * lu(k,1276) - lu(k,1358) = lu(k,1358) - lu(k,638) * lu(k,1354) - lu(k,1359) = lu(k,1359) - lu(k,639) * lu(k,1354) - lu(k,1364) = lu(k,1364) - lu(k,640) * lu(k,1354) - lu(k,1365) = lu(k,1365) - lu(k,641) * lu(k,1354) - lu(k,1367) = lu(k,1367) - lu(k,642) * lu(k,1354) - lu(k,1368) = lu(k,1368) - lu(k,643) * lu(k,1354) - lu(k,1369) = lu(k,1369) - lu(k,644) * lu(k,1354) - lu(k,1370) = lu(k,1370) - lu(k,645) * lu(k,1354) - lu(k,1371) = lu(k,1371) - lu(k,646) * lu(k,1354) - lu(k,1372) = lu(k,1372) - lu(k,647) * lu(k,1354) - lu(k,1373) = lu(k,1373) - lu(k,648) * lu(k,1354) - lu(k,1374) = lu(k,1374) - lu(k,649) * lu(k,1354) - lu(k,1375) = lu(k,1375) - lu(k,650) * lu(k,1354) - lu(k,1376) = lu(k,1376) - lu(k,651) * lu(k,1354) - lu(k,1377) = lu(k,1377) - lu(k,652) * lu(k,1354) - lu(k,1379) = - lu(k,653) * lu(k,1354) - lu(k,1380) = lu(k,1380) - lu(k,654) * lu(k,1354) - lu(k,1382) = - lu(k,655) * lu(k,1354) - lu(k,1383) = lu(k,1383) - lu(k,656) * lu(k,1354) - lu(k,1384) = lu(k,1384) - lu(k,657) * lu(k,1354) - lu(k,1417) = lu(k,1417) - lu(k,638) * lu(k,1413) - lu(k,1418) = lu(k,1418) - lu(k,639) * lu(k,1413) - lu(k,1423) = lu(k,1423) - lu(k,640) * lu(k,1413) - lu(k,1424) = lu(k,1424) - lu(k,641) * lu(k,1413) - lu(k,1426) = lu(k,1426) - lu(k,642) * lu(k,1413) - lu(k,1427) = lu(k,1427) - lu(k,643) * lu(k,1413) - lu(k,1428) = lu(k,1428) - lu(k,644) * lu(k,1413) - lu(k,1429) = lu(k,1429) - lu(k,645) * lu(k,1413) - lu(k,1430) = lu(k,1430) - lu(k,646) * lu(k,1413) - lu(k,1431) = lu(k,1431) - lu(k,647) * lu(k,1413) - lu(k,1432) = lu(k,1432) - lu(k,648) * lu(k,1413) - lu(k,1433) = lu(k,1433) - lu(k,649) * lu(k,1413) - lu(k,1434) = lu(k,1434) - lu(k,650) * lu(k,1413) - lu(k,1435) = lu(k,1435) - lu(k,651) * lu(k,1413) - lu(k,1436) = lu(k,1436) - lu(k,652) * lu(k,1413) - lu(k,1438) = lu(k,1438) - lu(k,653) * lu(k,1413) - lu(k,1439) = lu(k,1439) - lu(k,654) * lu(k,1413) - lu(k,1441) = lu(k,1441) - lu(k,655) * lu(k,1413) - lu(k,1442) = lu(k,1442) - lu(k,656) * lu(k,1413) - lu(k,1443) = lu(k,1443) - lu(k,657) * lu(k,1413) - lu(k,1459) = lu(k,1459) - lu(k,638) * lu(k,1455) - lu(k,1460) = lu(k,1460) - lu(k,639) * lu(k,1455) - lu(k,1465) = lu(k,1465) - lu(k,640) * lu(k,1455) - lu(k,1466) = - lu(k,641) * lu(k,1455) - lu(k,1468) = lu(k,1468) - lu(k,642) * lu(k,1455) - lu(k,1469) = lu(k,1469) - lu(k,643) * lu(k,1455) - lu(k,1470) = lu(k,1470) - lu(k,644) * lu(k,1455) - lu(k,1471) = lu(k,1471) - lu(k,645) * lu(k,1455) - lu(k,1472) = lu(k,1472) - lu(k,646) * lu(k,1455) - lu(k,1473) = lu(k,1473) - lu(k,647) * lu(k,1455) - lu(k,1474) = - lu(k,648) * lu(k,1455) - lu(k,1475) = lu(k,1475) - lu(k,649) * lu(k,1455) - lu(k,1476) = lu(k,1476) - lu(k,650) * lu(k,1455) - lu(k,1477) = lu(k,1477) - lu(k,651) * lu(k,1455) - lu(k,1478) = lu(k,1478) - lu(k,652) * lu(k,1455) - lu(k,1480) = lu(k,1480) - lu(k,653) * lu(k,1455) - lu(k,1481) = lu(k,1481) - lu(k,654) * lu(k,1455) - lu(k,1483) = lu(k,1483) - lu(k,655) * lu(k,1455) - lu(k,1484) = lu(k,1484) - lu(k,656) * lu(k,1455) - lu(k,1485) = lu(k,1485) - lu(k,657) * lu(k,1455) - lu(k,1500) = lu(k,1500) - lu(k,638) * lu(k,1497) - lu(k,1501) = lu(k,1501) - lu(k,639) * lu(k,1497) - lu(k,1506) = lu(k,1506) - lu(k,640) * lu(k,1497) - lu(k,1507) = lu(k,1507) - lu(k,641) * lu(k,1497) - lu(k,1509) = lu(k,1509) - lu(k,642) * lu(k,1497) - lu(k,1510) = lu(k,1510) - lu(k,643) * lu(k,1497) - lu(k,1511) = lu(k,1511) - lu(k,644) * lu(k,1497) - lu(k,1512) = lu(k,1512) - lu(k,645) * lu(k,1497) - lu(k,1513) = lu(k,1513) - lu(k,646) * lu(k,1497) - lu(k,1514) = lu(k,1514) - lu(k,647) * lu(k,1497) - lu(k,1515) = lu(k,1515) - lu(k,648) * lu(k,1497) - lu(k,1516) = lu(k,1516) - lu(k,649) * lu(k,1497) - lu(k,1517) = lu(k,1517) - lu(k,650) * lu(k,1497) - lu(k,1518) = lu(k,1518) - lu(k,651) * lu(k,1497) - lu(k,1519) = lu(k,1519) - lu(k,652) * lu(k,1497) - lu(k,1521) = lu(k,1521) - lu(k,653) * lu(k,1497) - lu(k,1522) = lu(k,1522) - lu(k,654) * lu(k,1497) - lu(k,1524) = lu(k,1524) - lu(k,655) * lu(k,1497) - lu(k,1525) = lu(k,1525) - lu(k,656) * lu(k,1497) - lu(k,1526) = lu(k,1526) - lu(k,657) * lu(k,1497) - lu(k,1544) = lu(k,1544) - lu(k,638) * lu(k,1543) - lu(k,1545) = lu(k,1545) - lu(k,639) * lu(k,1543) - lu(k,1548) = lu(k,1548) - lu(k,640) * lu(k,1543) - lu(k,1549) = lu(k,1549) - lu(k,641) * lu(k,1543) - lu(k,1551) = - lu(k,642) * lu(k,1543) - lu(k,1552) = - lu(k,643) * lu(k,1543) - lu(k,1553) = lu(k,1553) - lu(k,644) * lu(k,1543) - lu(k,1554) = lu(k,1554) - lu(k,645) * lu(k,1543) - lu(k,1555) = - lu(k,646) * lu(k,1543) - lu(k,1556) = lu(k,1556) - lu(k,647) * lu(k,1543) - lu(k,1557) = lu(k,1557) - lu(k,648) * lu(k,1543) - lu(k,1558) = lu(k,1558) - lu(k,649) * lu(k,1543) - lu(k,1559) = - lu(k,650) * lu(k,1543) - lu(k,1560) = lu(k,1560) - lu(k,651) * lu(k,1543) - lu(k,1561) = lu(k,1561) - lu(k,652) * lu(k,1543) - lu(k,1563) = - lu(k,653) * lu(k,1543) - lu(k,1564) = lu(k,1564) - lu(k,654) * lu(k,1543) - lu(k,1566) = - lu(k,655) * lu(k,1543) - lu(k,1567) = lu(k,1567) - lu(k,656) * lu(k,1543) - lu(k,1568) = lu(k,1568) - lu(k,657) * lu(k,1543) - lu(k,1651) = lu(k,1651) - lu(k,638) * lu(k,1648) - lu(k,1652) = lu(k,1652) - lu(k,639) * lu(k,1648) - lu(k,1657) = lu(k,1657) - lu(k,640) * lu(k,1648) - lu(k,1658) = lu(k,1658) - lu(k,641) * lu(k,1648) - lu(k,1660) = lu(k,1660) - lu(k,642) * lu(k,1648) - lu(k,1661) = lu(k,1661) - lu(k,643) * lu(k,1648) - lu(k,1662) = lu(k,1662) - lu(k,644) * lu(k,1648) - lu(k,1663) = lu(k,1663) - lu(k,645) * lu(k,1648) - lu(k,1664) = lu(k,1664) - lu(k,646) * lu(k,1648) - lu(k,1665) = lu(k,1665) - lu(k,647) * lu(k,1648) - lu(k,1666) = lu(k,1666) - lu(k,648) * lu(k,1648) - lu(k,1667) = lu(k,1667) - lu(k,649) * lu(k,1648) - lu(k,1668) = lu(k,1668) - lu(k,650) * lu(k,1648) - lu(k,1669) = lu(k,1669) - lu(k,651) * lu(k,1648) - lu(k,1670) = lu(k,1670) - lu(k,652) * lu(k,1648) - lu(k,1672) = lu(k,1672) - lu(k,653) * lu(k,1648) - lu(k,1673) = lu(k,1673) - lu(k,654) * lu(k,1648) - lu(k,1675) = lu(k,1675) - lu(k,655) * lu(k,1648) - lu(k,1676) = lu(k,1676) - lu(k,656) * lu(k,1648) - lu(k,1677) = lu(k,1677) - lu(k,657) * lu(k,1648) - lu(k,1737) = lu(k,1737) - lu(k,638) * lu(k,1733) - lu(k,1738) = lu(k,1738) - lu(k,639) * lu(k,1733) - lu(k,1743) = lu(k,1743) - lu(k,640) * lu(k,1733) - lu(k,1744) = - lu(k,641) * lu(k,1733) - lu(k,1746) = lu(k,1746) - lu(k,642) * lu(k,1733) - lu(k,1747) = lu(k,1747) - lu(k,643) * lu(k,1733) - lu(k,1748) = lu(k,1748) - lu(k,644) * lu(k,1733) - lu(k,1749) = lu(k,1749) - lu(k,645) * lu(k,1733) - lu(k,1750) = lu(k,1750) - lu(k,646) * lu(k,1733) - lu(k,1751) = lu(k,1751) - lu(k,647) * lu(k,1733) - lu(k,1752) = - lu(k,648) * lu(k,1733) - lu(k,1753) = lu(k,1753) - lu(k,649) * lu(k,1733) - lu(k,1754) = lu(k,1754) - lu(k,650) * lu(k,1733) - lu(k,1755) = lu(k,1755) - lu(k,651) * lu(k,1733) - lu(k,1756) = lu(k,1756) - lu(k,652) * lu(k,1733) - lu(k,1758) = lu(k,1758) - lu(k,653) * lu(k,1733) - lu(k,1759) = lu(k,1759) - lu(k,654) * lu(k,1733) - lu(k,1761) = lu(k,1761) - lu(k,655) * lu(k,1733) - lu(k,1762) = lu(k,1762) - lu(k,656) * lu(k,1733) - lu(k,1763) = lu(k,1763) - lu(k,657) * lu(k,1733) - lu(k,1772) = lu(k,1772) - lu(k,638) * lu(k,1768) - lu(k,1773) = lu(k,1773) - lu(k,639) * lu(k,1768) - lu(k,1778) = lu(k,1778) - lu(k,640) * lu(k,1768) - lu(k,1779) = lu(k,1779) - lu(k,641) * lu(k,1768) - lu(k,1781) = lu(k,1781) - lu(k,642) * lu(k,1768) - lu(k,1782) = lu(k,1782) - lu(k,643) * lu(k,1768) - lu(k,1783) = lu(k,1783) - lu(k,644) * lu(k,1768) - lu(k,1784) = lu(k,1784) - lu(k,645) * lu(k,1768) - lu(k,1785) = lu(k,1785) - lu(k,646) * lu(k,1768) - lu(k,1786) = lu(k,1786) - lu(k,647) * lu(k,1768) - lu(k,1787) = - lu(k,648) * lu(k,1768) - lu(k,1788) = lu(k,1788) - lu(k,649) * lu(k,1768) - lu(k,1789) = lu(k,1789) - lu(k,650) * lu(k,1768) - lu(k,1790) = lu(k,1790) - lu(k,651) * lu(k,1768) - lu(k,1791) = lu(k,1791) - lu(k,652) * lu(k,1768) - lu(k,1793) = lu(k,1793) - lu(k,653) * lu(k,1768) - lu(k,1794) = lu(k,1794) - lu(k,654) * lu(k,1768) - lu(k,1796) = lu(k,1796) - lu(k,655) * lu(k,1768) - lu(k,1797) = lu(k,1797) - lu(k,656) * lu(k,1768) - lu(k,1798) = lu(k,1798) - lu(k,657) * lu(k,1768) - lu(k,1830) = lu(k,1830) - lu(k,638) * lu(k,1827) - lu(k,1831) = lu(k,1831) - lu(k,639) * lu(k,1827) - lu(k,1836) = lu(k,1836) - lu(k,640) * lu(k,1827) - lu(k,1837) = lu(k,1837) - lu(k,641) * lu(k,1827) - lu(k,1839) = lu(k,1839) - lu(k,642) * lu(k,1827) - lu(k,1840) = lu(k,1840) - lu(k,643) * lu(k,1827) - lu(k,1841) = lu(k,1841) - lu(k,644) * lu(k,1827) - lu(k,1842) = lu(k,1842) - lu(k,645) * lu(k,1827) - lu(k,1843) = lu(k,1843) - lu(k,646) * lu(k,1827) - lu(k,1844) = lu(k,1844) - lu(k,647) * lu(k,1827) - lu(k,1845) = lu(k,1845) - lu(k,648) * lu(k,1827) - lu(k,1846) = lu(k,1846) - lu(k,649) * lu(k,1827) - lu(k,1847) = lu(k,1847) - lu(k,650) * lu(k,1827) - lu(k,1848) = lu(k,1848) - lu(k,651) * lu(k,1827) - lu(k,1849) = lu(k,1849) - lu(k,652) * lu(k,1827) - lu(k,1851) = lu(k,1851) - lu(k,653) * lu(k,1827) - lu(k,1852) = lu(k,1852) - lu(k,654) * lu(k,1827) - lu(k,1854) = lu(k,1854) - lu(k,655) * lu(k,1827) - lu(k,1855) = lu(k,1855) - lu(k,656) * lu(k,1827) - lu(k,1856) = lu(k,1856) - lu(k,657) * lu(k,1827) - lu(k,660) = 1._r8 / lu(k,660) - lu(k,661) = lu(k,661) * lu(k,660) - lu(k,662) = lu(k,662) * lu(k,660) - lu(k,663) = lu(k,663) * lu(k,660) - lu(k,664) = lu(k,664) * lu(k,660) - lu(k,665) = lu(k,665) * lu(k,660) - lu(k,666) = lu(k,666) * lu(k,660) - lu(k,667) = lu(k,667) * lu(k,660) - lu(k,668) = lu(k,668) * lu(k,660) - lu(k,669) = lu(k,669) * lu(k,660) - lu(k,670) = lu(k,670) * lu(k,660) - lu(k,671) = lu(k,671) * lu(k,660) - lu(k,672) = lu(k,672) * lu(k,660) - lu(k,673) = lu(k,673) * lu(k,660) - lu(k,674) = lu(k,674) * lu(k,660) - lu(k,675) = lu(k,675) * lu(k,660) - lu(k,676) = lu(k,676) * lu(k,660) - lu(k,677) = lu(k,677) * lu(k,660) - lu(k,678) = lu(k,678) * lu(k,660) - lu(k,679) = lu(k,679) * lu(k,660) - lu(k,680) = lu(k,680) * lu(k,660) - lu(k,681) = lu(k,681) * lu(k,660) - lu(k,682) = lu(k,682) * lu(k,660) - lu(k,683) = lu(k,683) * lu(k,660) - lu(k,684) = lu(k,684) * lu(k,660) - lu(k,685) = lu(k,685) * lu(k,660) - lu(k,686) = lu(k,686) * lu(k,660) - lu(k,687) = lu(k,687) * lu(k,660) - lu(k,894) = lu(k,894) - lu(k,661) * lu(k,893) - lu(k,895) = lu(k,895) - lu(k,662) * lu(k,893) - lu(k,896) = lu(k,896) - lu(k,663) * lu(k,893) - lu(k,897) = lu(k,897) - lu(k,664) * lu(k,893) - lu(k,898) = lu(k,898) - lu(k,665) * lu(k,893) - lu(k,899) = lu(k,899) - lu(k,666) * lu(k,893) - lu(k,900) = lu(k,900) - lu(k,667) * lu(k,893) - lu(k,901) = lu(k,901) - lu(k,668) * lu(k,893) - lu(k,902) = lu(k,902) - lu(k,669) * lu(k,893) - lu(k,903) = lu(k,903) - lu(k,670) * lu(k,893) - lu(k,904) = lu(k,904) - lu(k,671) * lu(k,893) - lu(k,906) = lu(k,906) - lu(k,672) * lu(k,893) - lu(k,907) = lu(k,907) - lu(k,673) * lu(k,893) - lu(k,908) = lu(k,908) - lu(k,674) * lu(k,893) - lu(k,910) = lu(k,910) - lu(k,675) * lu(k,893) - lu(k,911) = lu(k,911) - lu(k,676) * lu(k,893) - lu(k,912) = lu(k,912) - lu(k,677) * lu(k,893) - lu(k,913) = lu(k,913) - lu(k,678) * lu(k,893) - lu(k,914) = lu(k,914) - lu(k,679) * lu(k,893) - lu(k,915) = lu(k,915) - lu(k,680) * lu(k,893) - lu(k,916) = lu(k,916) - lu(k,681) * lu(k,893) - lu(k,917) = lu(k,917) - lu(k,682) * lu(k,893) - lu(k,918) = lu(k,918) - lu(k,683) * lu(k,893) - lu(k,919) = lu(k,919) - lu(k,684) * lu(k,893) - lu(k,920) = lu(k,920) - lu(k,685) * lu(k,893) - lu(k,921) = lu(k,921) - lu(k,686) * lu(k,893) - lu(k,922) = lu(k,922) - lu(k,687) * lu(k,893) - lu(k,936) = lu(k,936) - lu(k,661) * lu(k,935) - lu(k,937) = lu(k,937) - lu(k,662) * lu(k,935) - lu(k,938) = - lu(k,663) * lu(k,935) - lu(k,939) = lu(k,939) - lu(k,664) * lu(k,935) - lu(k,940) = lu(k,940) - lu(k,665) * lu(k,935) - lu(k,941) = lu(k,941) - lu(k,666) * lu(k,935) - lu(k,942) = lu(k,942) - lu(k,667) * lu(k,935) - lu(k,943) = lu(k,943) - lu(k,668) * lu(k,935) - lu(k,944) = lu(k,944) - lu(k,669) * lu(k,935) - lu(k,945) = lu(k,945) - lu(k,670) * lu(k,935) - lu(k,946) = lu(k,946) - lu(k,671) * lu(k,935) - lu(k,948) = lu(k,948) - lu(k,672) * lu(k,935) - lu(k,949) = - lu(k,673) * lu(k,935) - lu(k,950) = lu(k,950) - lu(k,674) * lu(k,935) - lu(k,952) = lu(k,952) - lu(k,675) * lu(k,935) - lu(k,953) = lu(k,953) - lu(k,676) * lu(k,935) - lu(k,954) = lu(k,954) - lu(k,677) * lu(k,935) - lu(k,955) = lu(k,955) - lu(k,678) * lu(k,935) - lu(k,956) = lu(k,956) - lu(k,679) * lu(k,935) - lu(k,957) = lu(k,957) - lu(k,680) * lu(k,935) - lu(k,958) = lu(k,958) - lu(k,681) * lu(k,935) - lu(k,959) = - lu(k,682) * lu(k,935) - lu(k,960) = - lu(k,683) * lu(k,935) - lu(k,961) = lu(k,961) - lu(k,684) * lu(k,935) - lu(k,962) = - lu(k,685) * lu(k,935) - lu(k,963) = lu(k,963) - lu(k,686) * lu(k,935) - lu(k,964) = lu(k,964) - lu(k,687) * lu(k,935) - lu(k,1024) = lu(k,1024) - lu(k,661) * lu(k,1023) - lu(k,1025) = lu(k,1025) - lu(k,662) * lu(k,1023) - lu(k,1026) = - lu(k,663) * lu(k,1023) - lu(k,1027) = lu(k,1027) - lu(k,664) * lu(k,1023) - lu(k,1028) = lu(k,1028) - lu(k,665) * lu(k,1023) - lu(k,1029) = lu(k,1029) - lu(k,666) * lu(k,1023) - lu(k,1030) = lu(k,1030) - lu(k,667) * lu(k,1023) - lu(k,1031) = lu(k,1031) - lu(k,668) * lu(k,1023) - lu(k,1032) = lu(k,1032) - lu(k,669) * lu(k,1023) - lu(k,1033) = lu(k,1033) - lu(k,670) * lu(k,1023) - lu(k,1034) = lu(k,1034) - lu(k,671) * lu(k,1023) - lu(k,1036) = lu(k,1036) - lu(k,672) * lu(k,1023) - lu(k,1037) = - lu(k,673) * lu(k,1023) - lu(k,1038) = lu(k,1038) - lu(k,674) * lu(k,1023) - lu(k,1040) = lu(k,1040) - lu(k,675) * lu(k,1023) - lu(k,1041) = lu(k,1041) - lu(k,676) * lu(k,1023) - lu(k,1042) = lu(k,1042) - lu(k,677) * lu(k,1023) - lu(k,1043) = lu(k,1043) - lu(k,678) * lu(k,1023) - lu(k,1044) = lu(k,1044) - lu(k,679) * lu(k,1023) - lu(k,1045) = lu(k,1045) - lu(k,680) * lu(k,1023) - lu(k,1046) = lu(k,1046) - lu(k,681) * lu(k,1023) - lu(k,1047) = - lu(k,682) * lu(k,1023) - lu(k,1048) = - lu(k,683) * lu(k,1023) - lu(k,1049) = lu(k,1049) - lu(k,684) * lu(k,1023) - lu(k,1050) = - lu(k,685) * lu(k,1023) - lu(k,1051) = lu(k,1051) - lu(k,686) * lu(k,1023) - lu(k,1052) = lu(k,1052) - lu(k,687) * lu(k,1023) - lu(k,1065) = lu(k,1065) - lu(k,661) * lu(k,1064) - lu(k,1066) = lu(k,1066) - lu(k,662) * lu(k,1064) - lu(k,1067) = lu(k,1067) - lu(k,663) * lu(k,1064) - lu(k,1068) = lu(k,1068) - lu(k,664) * lu(k,1064) - lu(k,1069) = lu(k,1069) - lu(k,665) * lu(k,1064) - lu(k,1070) = lu(k,1070) - lu(k,666) * lu(k,1064) - lu(k,1071) = lu(k,1071) - lu(k,667) * lu(k,1064) - lu(k,1072) = lu(k,1072) - lu(k,668) * lu(k,1064) - lu(k,1073) = lu(k,1073) - lu(k,669) * lu(k,1064) - lu(k,1074) = lu(k,1074) - lu(k,670) * lu(k,1064) - lu(k,1075) = lu(k,1075) - lu(k,671) * lu(k,1064) - lu(k,1077) = lu(k,1077) - lu(k,672) * lu(k,1064) - lu(k,1078) = - lu(k,673) * lu(k,1064) - lu(k,1079) = lu(k,1079) - lu(k,674) * lu(k,1064) - lu(k,1081) = lu(k,1081) - lu(k,675) * lu(k,1064) - lu(k,1082) = lu(k,1082) - lu(k,676) * lu(k,1064) - lu(k,1083) = lu(k,1083) - lu(k,677) * lu(k,1064) - lu(k,1084) = lu(k,1084) - lu(k,678) * lu(k,1064) - lu(k,1085) = lu(k,1085) - lu(k,679) * lu(k,1064) - lu(k,1086) = lu(k,1086) - lu(k,680) * lu(k,1064) - lu(k,1087) = lu(k,1087) - lu(k,681) * lu(k,1064) - lu(k,1088) = - lu(k,682) * lu(k,1064) - lu(k,1089) = - lu(k,683) * lu(k,1064) - lu(k,1090) = lu(k,1090) - lu(k,684) * lu(k,1064) - lu(k,1091) = - lu(k,685) * lu(k,1064) - lu(k,1092) = lu(k,1092) - lu(k,686) * lu(k,1064) - lu(k,1093) = lu(k,1093) - lu(k,687) * lu(k,1064) - lu(k,1148) = lu(k,1148) - lu(k,661) * lu(k,1147) - lu(k,1149) = lu(k,1149) - lu(k,662) * lu(k,1147) - lu(k,1150) = lu(k,1150) - lu(k,663) * lu(k,1147) - lu(k,1151) = lu(k,1151) - lu(k,664) * lu(k,1147) - lu(k,1152) = - lu(k,665) * lu(k,1147) - lu(k,1153) = lu(k,1153) - lu(k,666) * lu(k,1147) - lu(k,1154) = lu(k,1154) - lu(k,667) * lu(k,1147) - lu(k,1155) = lu(k,1155) - lu(k,668) * lu(k,1147) - lu(k,1156) = lu(k,1156) - lu(k,669) * lu(k,1147) - lu(k,1157) = lu(k,1157) - lu(k,670) * lu(k,1147) - lu(k,1158) = lu(k,1158) - lu(k,671) * lu(k,1147) - lu(k,1160) = lu(k,1160) - lu(k,672) * lu(k,1147) - lu(k,1161) = lu(k,1161) - lu(k,673) * lu(k,1147) - lu(k,1162) = lu(k,1162) - lu(k,674) * lu(k,1147) - lu(k,1164) = lu(k,1164) - lu(k,675) * lu(k,1147) - lu(k,1165) = lu(k,1165) - lu(k,676) * lu(k,1147) - lu(k,1166) = lu(k,1166) - lu(k,677) * lu(k,1147) - lu(k,1167) = lu(k,1167) - lu(k,678) * lu(k,1147) - lu(k,1168) = lu(k,1168) - lu(k,679) * lu(k,1147) - lu(k,1169) = lu(k,1169) - lu(k,680) * lu(k,1147) - lu(k,1170) = lu(k,1170) - lu(k,681) * lu(k,1147) - lu(k,1171) = lu(k,1171) - lu(k,682) * lu(k,1147) - lu(k,1172) = lu(k,1172) - lu(k,683) * lu(k,1147) - lu(k,1173) = lu(k,1173) - lu(k,684) * lu(k,1147) - lu(k,1174) = lu(k,1174) - lu(k,685) * lu(k,1147) - lu(k,1175) = lu(k,1175) - lu(k,686) * lu(k,1147) - lu(k,1176) = lu(k,1176) - lu(k,687) * lu(k,1147) - lu(k,1189) = - lu(k,661) * lu(k,1188) - lu(k,1190) = lu(k,1190) - lu(k,662) * lu(k,1188) - lu(k,1191) = lu(k,1191) - lu(k,663) * lu(k,1188) - lu(k,1192) = lu(k,1192) - lu(k,664) * lu(k,1188) - lu(k,1193) = lu(k,1193) - lu(k,665) * lu(k,1188) - lu(k,1194) = lu(k,1194) - lu(k,666) * lu(k,1188) - lu(k,1195) = - lu(k,667) * lu(k,1188) - lu(k,1196) = - lu(k,668) * lu(k,1188) - lu(k,1197) = lu(k,1197) - lu(k,669) * lu(k,1188) - lu(k,1198) = lu(k,1198) - lu(k,670) * lu(k,1188) - lu(k,1199) = - lu(k,671) * lu(k,1188) - lu(k,1201) = lu(k,1201) - lu(k,672) * lu(k,1188) - lu(k,1202) = lu(k,1202) - lu(k,673) * lu(k,1188) - lu(k,1203) = lu(k,1203) - lu(k,674) * lu(k,1188) - lu(k,1205) = lu(k,1205) - lu(k,675) * lu(k,1188) - lu(k,1206) = lu(k,1206) - lu(k,676) * lu(k,1188) - lu(k,1207) = lu(k,1207) - lu(k,677) * lu(k,1188) - lu(k,1208) = lu(k,1208) - lu(k,678) * lu(k,1188) - lu(k,1209) = lu(k,1209) - lu(k,679) * lu(k,1188) - lu(k,1210) = lu(k,1210) - lu(k,680) * lu(k,1188) - lu(k,1211) = - lu(k,681) * lu(k,1188) - lu(k,1212) = lu(k,1212) - lu(k,682) * lu(k,1188) - lu(k,1213) = lu(k,1213) - lu(k,683) * lu(k,1188) - lu(k,1214) = - lu(k,684) * lu(k,1188) - lu(k,1215) = lu(k,1215) - lu(k,685) * lu(k,1188) - lu(k,1216) = lu(k,1216) - lu(k,686) * lu(k,1188) - lu(k,1217) = lu(k,1217) - lu(k,687) * lu(k,1188) - lu(k,1238) = - lu(k,661) * lu(k,1237) - lu(k,1239) = lu(k,1239) - lu(k,662) * lu(k,1237) - lu(k,1240) = lu(k,1240) - lu(k,663) * lu(k,1237) - lu(k,1241) = lu(k,1241) - lu(k,664) * lu(k,1237) - lu(k,1242) = lu(k,1242) - lu(k,665) * lu(k,1237) - lu(k,1243) = lu(k,1243) - lu(k,666) * lu(k,1237) - lu(k,1244) = lu(k,1244) - lu(k,667) * lu(k,1237) - lu(k,1245) = - lu(k,668) * lu(k,1237) - lu(k,1246) = lu(k,1246) - lu(k,669) * lu(k,1237) - lu(k,1247) = lu(k,1247) - lu(k,670) * lu(k,1237) - lu(k,1248) = - lu(k,671) * lu(k,1237) - lu(k,1250) = lu(k,1250) - lu(k,672) * lu(k,1237) - lu(k,1251) = lu(k,1251) - lu(k,673) * lu(k,1237) - lu(k,1252) = lu(k,1252) - lu(k,674) * lu(k,1237) - lu(k,1254) = lu(k,1254) - lu(k,675) * lu(k,1237) - lu(k,1255) = lu(k,1255) - lu(k,676) * lu(k,1237) - lu(k,1256) = lu(k,1256) - lu(k,677) * lu(k,1237) - lu(k,1257) = lu(k,1257) - lu(k,678) * lu(k,1237) - lu(k,1258) = lu(k,1258) - lu(k,679) * lu(k,1237) - lu(k,1259) = lu(k,1259) - lu(k,680) * lu(k,1237) - lu(k,1260) = - lu(k,681) * lu(k,1237) - lu(k,1261) = lu(k,1261) - lu(k,682) * lu(k,1237) - lu(k,1262) = lu(k,1262) - lu(k,683) * lu(k,1237) - lu(k,1263) = - lu(k,684) * lu(k,1237) - lu(k,1264) = lu(k,1264) - lu(k,685) * lu(k,1237) - lu(k,1265) = lu(k,1265) - lu(k,686) * lu(k,1237) - lu(k,1266) = lu(k,1266) - lu(k,687) * lu(k,1237) - lu(k,1312) = lu(k,1312) - lu(k,661) * lu(k,1311) - lu(k,1313) = lu(k,1313) - lu(k,662) * lu(k,1311) - lu(k,1314) = lu(k,1314) - lu(k,663) * lu(k,1311) - lu(k,1315) = lu(k,1315) - lu(k,664) * lu(k,1311) - lu(k,1316) = lu(k,1316) - lu(k,665) * lu(k,1311) - lu(k,1317) = lu(k,1317) - lu(k,666) * lu(k,1311) - lu(k,1318) = lu(k,1318) - lu(k,667) * lu(k,1311) - lu(k,1319) = lu(k,1319) - lu(k,668) * lu(k,1311) - lu(k,1320) = lu(k,1320) - lu(k,669) * lu(k,1311) - lu(k,1321) = lu(k,1321) - lu(k,670) * lu(k,1311) - lu(k,1322) = lu(k,1322) - lu(k,671) * lu(k,1311) - lu(k,1324) = lu(k,1324) - lu(k,672) * lu(k,1311) - lu(k,1325) = lu(k,1325) - lu(k,673) * lu(k,1311) - lu(k,1326) = lu(k,1326) - lu(k,674) * lu(k,1311) - lu(k,1328) = lu(k,1328) - lu(k,675) * lu(k,1311) - lu(k,1329) = lu(k,1329) - lu(k,676) * lu(k,1311) - lu(k,1330) = lu(k,1330) - lu(k,677) * lu(k,1311) - lu(k,1331) = lu(k,1331) - lu(k,678) * lu(k,1311) - lu(k,1332) = lu(k,1332) - lu(k,679) * lu(k,1311) - lu(k,1333) = lu(k,1333) - lu(k,680) * lu(k,1311) - lu(k,1334) = lu(k,1334) - lu(k,681) * lu(k,1311) - lu(k,1335) = lu(k,1335) - lu(k,682) * lu(k,1311) - lu(k,1336) = lu(k,1336) - lu(k,683) * lu(k,1311) - lu(k,1337) = lu(k,1337) - lu(k,684) * lu(k,1311) - lu(k,1338) = lu(k,1338) - lu(k,685) * lu(k,1311) - lu(k,1339) = lu(k,1339) - lu(k,686) * lu(k,1311) - lu(k,1340) = lu(k,1340) - lu(k,687) * lu(k,1311) - lu(k,1356) = lu(k,1356) - lu(k,661) * lu(k,1355) - lu(k,1357) = lu(k,1357) - lu(k,662) * lu(k,1355) - lu(k,1358) = lu(k,1358) - lu(k,663) * lu(k,1355) - lu(k,1359) = lu(k,1359) - lu(k,664) * lu(k,1355) - lu(k,1360) = lu(k,1360) - lu(k,665) * lu(k,1355) - lu(k,1361) = lu(k,1361) - lu(k,666) * lu(k,1355) - lu(k,1362) = lu(k,1362) - lu(k,667) * lu(k,1355) - lu(k,1363) = lu(k,1363) - lu(k,668) * lu(k,1355) - lu(k,1364) = lu(k,1364) - lu(k,669) * lu(k,1355) - lu(k,1365) = lu(k,1365) - lu(k,670) * lu(k,1355) - lu(k,1366) = lu(k,1366) - lu(k,671) * lu(k,1355) - lu(k,1368) = lu(k,1368) - lu(k,672) * lu(k,1355) - lu(k,1369) = lu(k,1369) - lu(k,673) * lu(k,1355) - lu(k,1370) = lu(k,1370) - lu(k,674) * lu(k,1355) - lu(k,1372) = lu(k,1372) - lu(k,675) * lu(k,1355) - lu(k,1373) = lu(k,1373) - lu(k,676) * lu(k,1355) - lu(k,1374) = lu(k,1374) - lu(k,677) * lu(k,1355) - lu(k,1375) = lu(k,1375) - lu(k,678) * lu(k,1355) - lu(k,1376) = lu(k,1376) - lu(k,679) * lu(k,1355) - lu(k,1377) = lu(k,1377) - lu(k,680) * lu(k,1355) - lu(k,1378) = lu(k,1378) - lu(k,681) * lu(k,1355) - lu(k,1379) = lu(k,1379) - lu(k,682) * lu(k,1355) - lu(k,1380) = lu(k,1380) - lu(k,683) * lu(k,1355) - lu(k,1381) = lu(k,1381) - lu(k,684) * lu(k,1355) - lu(k,1382) = lu(k,1382) - lu(k,685) * lu(k,1355) - lu(k,1383) = lu(k,1383) - lu(k,686) * lu(k,1355) - lu(k,1384) = lu(k,1384) - lu(k,687) * lu(k,1355) - lu(k,1415) = lu(k,1415) - lu(k,661) * lu(k,1414) - lu(k,1416) = lu(k,1416) - lu(k,662) * lu(k,1414) - lu(k,1417) = lu(k,1417) - lu(k,663) * lu(k,1414) - lu(k,1418) = lu(k,1418) - lu(k,664) * lu(k,1414) - lu(k,1419) = lu(k,1419) - lu(k,665) * lu(k,1414) - lu(k,1420) = lu(k,1420) - lu(k,666) * lu(k,1414) - lu(k,1421) = lu(k,1421) - lu(k,667) * lu(k,1414) - lu(k,1422) = - lu(k,668) * lu(k,1414) - lu(k,1423) = lu(k,1423) - lu(k,669) * lu(k,1414) - lu(k,1424) = lu(k,1424) - lu(k,670) * lu(k,1414) - lu(k,1425) = - lu(k,671) * lu(k,1414) - lu(k,1427) = lu(k,1427) - lu(k,672) * lu(k,1414) - lu(k,1428) = lu(k,1428) - lu(k,673) * lu(k,1414) - lu(k,1429) = lu(k,1429) - lu(k,674) * lu(k,1414) - lu(k,1431) = lu(k,1431) - lu(k,675) * lu(k,1414) - lu(k,1432) = lu(k,1432) - lu(k,676) * lu(k,1414) - lu(k,1433) = lu(k,1433) - lu(k,677) * lu(k,1414) - lu(k,1434) = lu(k,1434) - lu(k,678) * lu(k,1414) - lu(k,1435) = lu(k,1435) - lu(k,679) * lu(k,1414) - lu(k,1436) = lu(k,1436) - lu(k,680) * lu(k,1414) - lu(k,1437) = - lu(k,681) * lu(k,1414) - lu(k,1438) = lu(k,1438) - lu(k,682) * lu(k,1414) - lu(k,1439) = lu(k,1439) - lu(k,683) * lu(k,1414) - lu(k,1440) = - lu(k,684) * lu(k,1414) - lu(k,1441) = lu(k,1441) - lu(k,685) * lu(k,1414) - lu(k,1442) = lu(k,1442) - lu(k,686) * lu(k,1414) - lu(k,1443) = lu(k,1443) - lu(k,687) * lu(k,1414) - lu(k,1457) = lu(k,1457) - lu(k,661) * lu(k,1456) - lu(k,1458) = - lu(k,662) * lu(k,1456) - lu(k,1459) = lu(k,1459) - lu(k,663) * lu(k,1456) - lu(k,1460) = lu(k,1460) - lu(k,664) * lu(k,1456) - lu(k,1461) = lu(k,1461) - lu(k,665) * lu(k,1456) - lu(k,1462) = lu(k,1462) - lu(k,666) * lu(k,1456) - lu(k,1463) = - lu(k,667) * lu(k,1456) - lu(k,1464) = - lu(k,668) * lu(k,1456) - lu(k,1465) = lu(k,1465) - lu(k,669) * lu(k,1456) - lu(k,1466) = lu(k,1466) - lu(k,670) * lu(k,1456) - lu(k,1467) = - lu(k,671) * lu(k,1456) - lu(k,1469) = lu(k,1469) - lu(k,672) * lu(k,1456) - lu(k,1470) = lu(k,1470) - lu(k,673) * lu(k,1456) - lu(k,1471) = lu(k,1471) - lu(k,674) * lu(k,1456) - lu(k,1473) = lu(k,1473) - lu(k,675) * lu(k,1456) - lu(k,1474) = lu(k,1474) - lu(k,676) * lu(k,1456) - lu(k,1475) = lu(k,1475) - lu(k,677) * lu(k,1456) - lu(k,1476) = lu(k,1476) - lu(k,678) * lu(k,1456) - lu(k,1477) = lu(k,1477) - lu(k,679) * lu(k,1456) - lu(k,1478) = lu(k,1478) - lu(k,680) * lu(k,1456) - lu(k,1479) = - lu(k,681) * lu(k,1456) - lu(k,1480) = lu(k,1480) - lu(k,682) * lu(k,1456) - lu(k,1481) = lu(k,1481) - lu(k,683) * lu(k,1456) - lu(k,1482) = - lu(k,684) * lu(k,1456) - lu(k,1483) = lu(k,1483) - lu(k,685) * lu(k,1456) - lu(k,1484) = lu(k,1484) - lu(k,686) * lu(k,1456) - lu(k,1485) = lu(k,1485) - lu(k,687) * lu(k,1456) - lu(k,1582) = lu(k,1582) - lu(k,661) * lu(k,1581) - lu(k,1583) = lu(k,1583) - lu(k,662) * lu(k,1581) - lu(k,1584) = - lu(k,663) * lu(k,1581) - lu(k,1585) = lu(k,1585) - lu(k,664) * lu(k,1581) - lu(k,1586) = lu(k,1586) - lu(k,665) * lu(k,1581) - lu(k,1587) = lu(k,1587) - lu(k,666) * lu(k,1581) - lu(k,1588) = lu(k,1588) - lu(k,667) * lu(k,1581) - lu(k,1589) = lu(k,1589) - lu(k,668) * lu(k,1581) - lu(k,1590) = lu(k,1590) - lu(k,669) * lu(k,1581) - lu(k,1591) = lu(k,1591) - lu(k,670) * lu(k,1581) - lu(k,1592) = lu(k,1592) - lu(k,671) * lu(k,1581) - lu(k,1594) = lu(k,1594) - lu(k,672) * lu(k,1581) - lu(k,1595) = - lu(k,673) * lu(k,1581) - lu(k,1596) = lu(k,1596) - lu(k,674) * lu(k,1581) - lu(k,1598) = lu(k,1598) - lu(k,675) * lu(k,1581) - lu(k,1599) = lu(k,1599) - lu(k,676) * lu(k,1581) - lu(k,1600) = lu(k,1600) - lu(k,677) * lu(k,1581) - lu(k,1601) = lu(k,1601) - lu(k,678) * lu(k,1581) - lu(k,1602) = lu(k,1602) - lu(k,679) * lu(k,1581) - lu(k,1603) = lu(k,1603) - lu(k,680) * lu(k,1581) - lu(k,1604) = lu(k,1604) - lu(k,681) * lu(k,1581) - lu(k,1605) = - lu(k,682) * lu(k,1581) - lu(k,1606) = - lu(k,683) * lu(k,1581) - lu(k,1607) = lu(k,1607) - lu(k,684) * lu(k,1581) - lu(k,1608) = - lu(k,685) * lu(k,1581) - lu(k,1609) = lu(k,1609) - lu(k,686) * lu(k,1581) - lu(k,1610) = lu(k,1610) - lu(k,687) * lu(k,1581) - lu(k,1691) = lu(k,1691) - lu(k,661) * lu(k,1690) - lu(k,1692) = lu(k,1692) - lu(k,662) * lu(k,1690) - lu(k,1693) = - lu(k,663) * lu(k,1690) - lu(k,1694) = lu(k,1694) - lu(k,664) * lu(k,1690) - lu(k,1695) = lu(k,1695) - lu(k,665) * lu(k,1690) - lu(k,1696) = lu(k,1696) - lu(k,666) * lu(k,1690) - lu(k,1697) = lu(k,1697) - lu(k,667) * lu(k,1690) - lu(k,1698) = lu(k,1698) - lu(k,668) * lu(k,1690) - lu(k,1699) = lu(k,1699) - lu(k,669) * lu(k,1690) - lu(k,1700) = lu(k,1700) - lu(k,670) * lu(k,1690) - lu(k,1701) = lu(k,1701) - lu(k,671) * lu(k,1690) - lu(k,1703) = lu(k,1703) - lu(k,672) * lu(k,1690) - lu(k,1704) = - lu(k,673) * lu(k,1690) - lu(k,1705) = lu(k,1705) - lu(k,674) * lu(k,1690) - lu(k,1707) = lu(k,1707) - lu(k,675) * lu(k,1690) - lu(k,1708) = lu(k,1708) - lu(k,676) * lu(k,1690) - lu(k,1709) = lu(k,1709) - lu(k,677) * lu(k,1690) - lu(k,1710) = lu(k,1710) - lu(k,678) * lu(k,1690) - lu(k,1711) = lu(k,1711) - lu(k,679) * lu(k,1690) - lu(k,1712) = lu(k,1712) - lu(k,680) * lu(k,1690) - lu(k,1713) = lu(k,1713) - lu(k,681) * lu(k,1690) - lu(k,1714) = - lu(k,682) * lu(k,1690) - lu(k,1715) = - lu(k,683) * lu(k,1690) - lu(k,1716) = lu(k,1716) - lu(k,684) * lu(k,1690) - lu(k,1717) = - lu(k,685) * lu(k,1690) - lu(k,1718) = lu(k,1718) - lu(k,686) * lu(k,1690) - lu(k,1719) = lu(k,1719) - lu(k,687) * lu(k,1690) - lu(k,1735) = lu(k,1735) - lu(k,661) * lu(k,1734) - lu(k,1736) = - lu(k,662) * lu(k,1734) - lu(k,1737) = lu(k,1737) - lu(k,663) * lu(k,1734) - lu(k,1738) = lu(k,1738) - lu(k,664) * lu(k,1734) - lu(k,1739) = lu(k,1739) - lu(k,665) * lu(k,1734) - lu(k,1740) = lu(k,1740) - lu(k,666) * lu(k,1734) - lu(k,1741) = - lu(k,667) * lu(k,1734) - lu(k,1742) = - lu(k,668) * lu(k,1734) - lu(k,1743) = lu(k,1743) - lu(k,669) * lu(k,1734) - lu(k,1744) = lu(k,1744) - lu(k,670) * lu(k,1734) - lu(k,1745) = - lu(k,671) * lu(k,1734) - lu(k,1747) = lu(k,1747) - lu(k,672) * lu(k,1734) - lu(k,1748) = lu(k,1748) - lu(k,673) * lu(k,1734) - lu(k,1749) = lu(k,1749) - lu(k,674) * lu(k,1734) - lu(k,1751) = lu(k,1751) - lu(k,675) * lu(k,1734) - lu(k,1752) = lu(k,1752) - lu(k,676) * lu(k,1734) - lu(k,1753) = lu(k,1753) - lu(k,677) * lu(k,1734) - lu(k,1754) = lu(k,1754) - lu(k,678) * lu(k,1734) - lu(k,1755) = lu(k,1755) - lu(k,679) * lu(k,1734) - lu(k,1756) = lu(k,1756) - lu(k,680) * lu(k,1734) - lu(k,1757) = - lu(k,681) * lu(k,1734) - lu(k,1758) = lu(k,1758) - lu(k,682) * lu(k,1734) - lu(k,1759) = lu(k,1759) - lu(k,683) * lu(k,1734) - lu(k,1760) = - lu(k,684) * lu(k,1734) - lu(k,1761) = lu(k,1761) - lu(k,685) * lu(k,1734) - lu(k,1762) = lu(k,1762) - lu(k,686) * lu(k,1734) - lu(k,1763) = lu(k,1763) - lu(k,687) * lu(k,1734) - lu(k,1770) = lu(k,1770) - lu(k,661) * lu(k,1769) - lu(k,1771) = lu(k,1771) - lu(k,662) * lu(k,1769) - lu(k,1772) = lu(k,1772) - lu(k,663) * lu(k,1769) - lu(k,1773) = lu(k,1773) - lu(k,664) * lu(k,1769) - lu(k,1774) = lu(k,1774) - lu(k,665) * lu(k,1769) - lu(k,1775) = lu(k,1775) - lu(k,666) * lu(k,1769) - lu(k,1776) = - lu(k,667) * lu(k,1769) - lu(k,1777) = - lu(k,668) * lu(k,1769) - lu(k,1778) = lu(k,1778) - lu(k,669) * lu(k,1769) - lu(k,1779) = lu(k,1779) - lu(k,670) * lu(k,1769) - lu(k,1780) = lu(k,1780) - lu(k,671) * lu(k,1769) - lu(k,1782) = lu(k,1782) - lu(k,672) * lu(k,1769) - lu(k,1783) = lu(k,1783) - lu(k,673) * lu(k,1769) - lu(k,1784) = lu(k,1784) - lu(k,674) * lu(k,1769) - lu(k,1786) = lu(k,1786) - lu(k,675) * lu(k,1769) - lu(k,1787) = lu(k,1787) - lu(k,676) * lu(k,1769) - lu(k,1788) = lu(k,1788) - lu(k,677) * lu(k,1769) - lu(k,1789) = lu(k,1789) - lu(k,678) * lu(k,1769) - lu(k,1790) = lu(k,1790) - lu(k,679) * lu(k,1769) - lu(k,1791) = lu(k,1791) - lu(k,680) * lu(k,1769) - lu(k,1792) = - lu(k,681) * lu(k,1769) - lu(k,1793) = lu(k,1793) - lu(k,682) * lu(k,1769) - lu(k,1794) = lu(k,1794) - lu(k,683) * lu(k,1769) - lu(k,1795) = - lu(k,684) * lu(k,1769) - lu(k,1796) = lu(k,1796) - lu(k,685) * lu(k,1769) - lu(k,1797) = lu(k,1797) - lu(k,686) * lu(k,1769) - lu(k,1798) = lu(k,1798) - lu(k,687) * lu(k,1769) + lu(k,606) = 1._r8 / lu(k,606) + lu(k,607) = lu(k,607) * lu(k,606) + lu(k,608) = lu(k,608) * lu(k,606) + lu(k,609) = lu(k,609) * lu(k,606) + lu(k,610) = lu(k,610) * lu(k,606) + lu(k,611) = lu(k,611) * lu(k,606) + lu(k,612) = lu(k,612) * lu(k,606) + lu(k,613) = lu(k,613) * lu(k,606) + lu(k,614) = lu(k,614) * lu(k,606) + lu(k,615) = lu(k,615) * lu(k,606) + lu(k,616) = lu(k,616) * lu(k,606) + lu(k,617) = lu(k,617) * lu(k,606) + lu(k,618) = lu(k,618) * lu(k,606) + lu(k,619) = lu(k,619) * lu(k,606) + lu(k,624) = - lu(k,607) * lu(k,621) + lu(k,625) = lu(k,625) - lu(k,608) * lu(k,621) + lu(k,626) = lu(k,626) - lu(k,609) * lu(k,621) + lu(k,627) = lu(k,627) - lu(k,610) * lu(k,621) + lu(k,628) = lu(k,628) - lu(k,611) * lu(k,621) + lu(k,630) = lu(k,630) - lu(k,612) * lu(k,621) + lu(k,632) = lu(k,632) - lu(k,613) * lu(k,621) + lu(k,633) = lu(k,633) - lu(k,614) * lu(k,621) + lu(k,634) = lu(k,634) - lu(k,615) * lu(k,621) + lu(k,636) = lu(k,636) - lu(k,616) * lu(k,621) + lu(k,637) = lu(k,637) - lu(k,617) * lu(k,621) + lu(k,638) = lu(k,638) - lu(k,618) * lu(k,621) + lu(k,639) = lu(k,639) - lu(k,619) * lu(k,621) + lu(k,689) = lu(k,689) - lu(k,607) * lu(k,686) + lu(k,690) = lu(k,690) - lu(k,608) * lu(k,686) + lu(k,691) = lu(k,691) - lu(k,609) * lu(k,686) + lu(k,692) = lu(k,692) - lu(k,610) * lu(k,686) + lu(k,693) = lu(k,693) - lu(k,611) * lu(k,686) + lu(k,695) = lu(k,695) - lu(k,612) * lu(k,686) + lu(k,697) = lu(k,697) - lu(k,613) * lu(k,686) + lu(k,698) = lu(k,698) - lu(k,614) * lu(k,686) + lu(k,699) = lu(k,699) - lu(k,615) * lu(k,686) + lu(k,701) = lu(k,701) - lu(k,616) * lu(k,686) + lu(k,702) = lu(k,702) - lu(k,617) * lu(k,686) + lu(k,703) = lu(k,703) - lu(k,618) * lu(k,686) + lu(k,704) = lu(k,704) - lu(k,619) * lu(k,686) + lu(k,863) = lu(k,863) - lu(k,607) * lu(k,860) + lu(k,866) = lu(k,866) - lu(k,608) * lu(k,860) + lu(k,867) = lu(k,867) - lu(k,609) * lu(k,860) + lu(k,868) = lu(k,868) - lu(k,610) * lu(k,860) + lu(k,869) = lu(k,869) - lu(k,611) * lu(k,860) + lu(k,871) = lu(k,871) - lu(k,612) * lu(k,860) + lu(k,873) = lu(k,873) - lu(k,613) * lu(k,860) + lu(k,874) = lu(k,874) - lu(k,614) * lu(k,860) + lu(k,876) = lu(k,876) - lu(k,615) * lu(k,860) + lu(k,878) = lu(k,878) - lu(k,616) * lu(k,860) + lu(k,879) = lu(k,879) - lu(k,617) * lu(k,860) + lu(k,880) = lu(k,880) - lu(k,618) * lu(k,860) + lu(k,883) = lu(k,883) - lu(k,619) * lu(k,860) + lu(k,1091) = - lu(k,607) * lu(k,1085) + lu(k,1096) = lu(k,1096) - lu(k,608) * lu(k,1085) + lu(k,1097) = - lu(k,609) * lu(k,1085) + lu(k,1098) = - lu(k,610) * lu(k,1085) + lu(k,1099) = lu(k,1099) - lu(k,611) * lu(k,1085) + lu(k,1101) = - lu(k,612) * lu(k,1085) + lu(k,1103) = lu(k,1103) - lu(k,613) * lu(k,1085) + lu(k,1104) = - lu(k,614) * lu(k,1085) + lu(k,1107) = - lu(k,615) * lu(k,1085) + lu(k,1109) = lu(k,1109) - lu(k,616) * lu(k,1085) + lu(k,1110) = lu(k,1110) - lu(k,617) * lu(k,1085) + lu(k,1112) = lu(k,1112) - lu(k,618) * lu(k,1085) + lu(k,1118) = lu(k,1118) - lu(k,619) * lu(k,1085) + lu(k,1138) = lu(k,1138) - lu(k,607) * lu(k,1131) + lu(k,1144) = lu(k,1144) - lu(k,608) * lu(k,1131) + lu(k,1145) = lu(k,1145) - lu(k,609) * lu(k,1131) + lu(k,1146) = lu(k,1146) - lu(k,610) * lu(k,1131) + lu(k,1147) = lu(k,1147) - lu(k,611) * lu(k,1131) + lu(k,1149) = lu(k,1149) - lu(k,612) * lu(k,1131) + lu(k,1151) = lu(k,1151) - lu(k,613) * lu(k,1131) + lu(k,1152) = lu(k,1152) - lu(k,614) * lu(k,1131) + lu(k,1155) = lu(k,1155) - lu(k,615) * lu(k,1131) + lu(k,1157) = lu(k,1157) - lu(k,616) * lu(k,1131) + lu(k,1158) = lu(k,1158) - lu(k,617) * lu(k,1131) + lu(k,1160) = lu(k,1160) - lu(k,618) * lu(k,1131) + lu(k,1166) = lu(k,1166) - lu(k,619) * lu(k,1131) + lu(k,1181) = lu(k,1181) - lu(k,607) * lu(k,1175) + lu(k,1187) = lu(k,1187) - lu(k,608) * lu(k,1175) + lu(k,1188) = lu(k,1188) - lu(k,609) * lu(k,1175) + lu(k,1189) = lu(k,1189) - lu(k,610) * lu(k,1175) + lu(k,1190) = lu(k,1190) - lu(k,611) * lu(k,1175) + lu(k,1192) = lu(k,1192) - lu(k,612) * lu(k,1175) + lu(k,1194) = lu(k,1194) - lu(k,613) * lu(k,1175) + lu(k,1195) = lu(k,1195) - lu(k,614) * lu(k,1175) + lu(k,1198) = lu(k,1198) - lu(k,615) * lu(k,1175) + lu(k,1200) = lu(k,1200) - lu(k,616) * lu(k,1175) + lu(k,1201) = lu(k,1201) - lu(k,617) * lu(k,1175) + lu(k,1203) = lu(k,1203) - lu(k,618) * lu(k,1175) + lu(k,1209) = lu(k,1209) - lu(k,619) * lu(k,1175) + lu(k,1222) = lu(k,1222) - lu(k,607) * lu(k,1216) + lu(k,1228) = lu(k,1228) - lu(k,608) * lu(k,1216) + lu(k,1229) = lu(k,1229) - lu(k,609) * lu(k,1216) + lu(k,1230) = lu(k,1230) - lu(k,610) * lu(k,1216) + lu(k,1231) = lu(k,1231) - lu(k,611) * lu(k,1216) + lu(k,1233) = lu(k,1233) - lu(k,612) * lu(k,1216) + lu(k,1235) = lu(k,1235) - lu(k,613) * lu(k,1216) + lu(k,1236) = lu(k,1236) - lu(k,614) * lu(k,1216) + lu(k,1239) = lu(k,1239) - lu(k,615) * lu(k,1216) + lu(k,1241) = lu(k,1241) - lu(k,616) * lu(k,1216) + lu(k,1242) = lu(k,1242) - lu(k,617) * lu(k,1216) + lu(k,1244) = lu(k,1244) - lu(k,618) * lu(k,1216) + lu(k,1250) = lu(k,1250) - lu(k,619) * lu(k,1216) + lu(k,1324) = lu(k,1324) - lu(k,607) * lu(k,1318) + lu(k,1330) = lu(k,1330) - lu(k,608) * lu(k,1318) + lu(k,1331) = lu(k,1331) - lu(k,609) * lu(k,1318) + lu(k,1332) = lu(k,1332) - lu(k,610) * lu(k,1318) + lu(k,1333) = lu(k,1333) - lu(k,611) * lu(k,1318) + lu(k,1335) = lu(k,1335) - lu(k,612) * lu(k,1318) + lu(k,1337) = lu(k,1337) - lu(k,613) * lu(k,1318) + lu(k,1338) = lu(k,1338) - lu(k,614) * lu(k,1318) + lu(k,1341) = lu(k,1341) - lu(k,615) * lu(k,1318) + lu(k,1343) = lu(k,1343) - lu(k,616) * lu(k,1318) + lu(k,1344) = lu(k,1344) - lu(k,617) * lu(k,1318) + lu(k,1346) = lu(k,1346) - lu(k,618) * lu(k,1318) + lu(k,1352) = lu(k,1352) - lu(k,619) * lu(k,1318) + lu(k,1403) = lu(k,1403) - lu(k,607) * lu(k,1397) + lu(k,1409) = lu(k,1409) - lu(k,608) * lu(k,1397) + lu(k,1410) = lu(k,1410) - lu(k,609) * lu(k,1397) + lu(k,1411) = lu(k,1411) - lu(k,610) * lu(k,1397) + lu(k,1412) = lu(k,1412) - lu(k,611) * lu(k,1397) + lu(k,1414) = lu(k,1414) - lu(k,612) * lu(k,1397) + lu(k,1416) = lu(k,1416) - lu(k,613) * lu(k,1397) + lu(k,1417) = lu(k,1417) - lu(k,614) * lu(k,1397) + lu(k,1420) = lu(k,1420) - lu(k,615) * lu(k,1397) + lu(k,1422) = lu(k,1422) - lu(k,616) * lu(k,1397) + lu(k,1423) = lu(k,1423) - lu(k,617) * lu(k,1397) + lu(k,1425) = lu(k,1425) - lu(k,618) * lu(k,1397) + lu(k,1431) = lu(k,1431) - lu(k,619) * lu(k,1397) + lu(k,1446) = lu(k,1446) - lu(k,607) * lu(k,1440) + lu(k,1452) = lu(k,1452) - lu(k,608) * lu(k,1440) + lu(k,1453) = lu(k,1453) - lu(k,609) * lu(k,1440) + lu(k,1454) = lu(k,1454) - lu(k,610) * lu(k,1440) + lu(k,1455) = lu(k,1455) - lu(k,611) * lu(k,1440) + lu(k,1457) = lu(k,1457) - lu(k,612) * lu(k,1440) + lu(k,1459) = lu(k,1459) - lu(k,613) * lu(k,1440) + lu(k,1460) = lu(k,1460) - lu(k,614) * lu(k,1440) + lu(k,1463) = lu(k,1463) - lu(k,615) * lu(k,1440) + lu(k,1465) = lu(k,1465) - lu(k,616) * lu(k,1440) + lu(k,1466) = lu(k,1466) - lu(k,617) * lu(k,1440) + lu(k,1468) = lu(k,1468) - lu(k,618) * lu(k,1440) + lu(k,1474) = lu(k,1474) - lu(k,619) * lu(k,1440) + lu(k,1491) = lu(k,1491) - lu(k,607) * lu(k,1485) + lu(k,1497) = lu(k,1497) - lu(k,608) * lu(k,1485) + lu(k,1498) = lu(k,1498) - lu(k,609) * lu(k,1485) + lu(k,1499) = lu(k,1499) - lu(k,610) * lu(k,1485) + lu(k,1500) = lu(k,1500) - lu(k,611) * lu(k,1485) + lu(k,1502) = lu(k,1502) - lu(k,612) * lu(k,1485) + lu(k,1504) = lu(k,1504) - lu(k,613) * lu(k,1485) + lu(k,1505) = lu(k,1505) - lu(k,614) * lu(k,1485) + lu(k,1508) = lu(k,1508) - lu(k,615) * lu(k,1485) + lu(k,1510) = lu(k,1510) - lu(k,616) * lu(k,1485) + lu(k,1511) = lu(k,1511) - lu(k,617) * lu(k,1485) + lu(k,1513) = lu(k,1513) - lu(k,618) * lu(k,1485) + lu(k,1519) = lu(k,1519) - lu(k,619) * lu(k,1485) + lu(k,1572) = lu(k,1572) - lu(k,607) * lu(k,1565) + lu(k,1578) = lu(k,1578) - lu(k,608) * lu(k,1565) + lu(k,1579) = lu(k,1579) - lu(k,609) * lu(k,1565) + lu(k,1580) = lu(k,1580) - lu(k,610) * lu(k,1565) + lu(k,1581) = lu(k,1581) - lu(k,611) * lu(k,1565) + lu(k,1583) = lu(k,1583) - lu(k,612) * lu(k,1565) + lu(k,1585) = lu(k,1585) - lu(k,613) * lu(k,1565) + lu(k,1586) = lu(k,1586) - lu(k,614) * lu(k,1565) + lu(k,1589) = lu(k,1589) - lu(k,615) * lu(k,1565) + lu(k,1591) = lu(k,1591) - lu(k,616) * lu(k,1565) + lu(k,1592) = lu(k,1592) - lu(k,617) * lu(k,1565) + lu(k,1594) = lu(k,1594) - lu(k,618) * lu(k,1565) + lu(k,1600) = lu(k,1600) - lu(k,619) * lu(k,1565) + lu(k,1620) = lu(k,1620) - lu(k,607) * lu(k,1612) + lu(k,1626) = lu(k,1626) - lu(k,608) * lu(k,1612) + lu(k,1627) = lu(k,1627) - lu(k,609) * lu(k,1612) + lu(k,1628) = - lu(k,610) * lu(k,1612) + lu(k,1629) = lu(k,1629) - lu(k,611) * lu(k,1612) + lu(k,1631) = - lu(k,612) * lu(k,1612) + lu(k,1633) = lu(k,1633) - lu(k,613) * lu(k,1612) + lu(k,1634) = - lu(k,614) * lu(k,1612) + lu(k,1637) = lu(k,1637) - lu(k,615) * lu(k,1612) + lu(k,1639) = lu(k,1639) - lu(k,616) * lu(k,1612) + lu(k,1640) = lu(k,1640) - lu(k,617) * lu(k,1612) + lu(k,1642) = lu(k,1642) - lu(k,618) * lu(k,1612) + lu(k,1648) = lu(k,1648) - lu(k,619) * lu(k,1612) + lu(k,1663) = lu(k,1663) - lu(k,607) * lu(k,1657) + lu(k,1669) = lu(k,1669) - lu(k,608) * lu(k,1657) + lu(k,1670) = lu(k,1670) - lu(k,609) * lu(k,1657) + lu(k,1671) = lu(k,1671) - lu(k,610) * lu(k,1657) + lu(k,1672) = lu(k,1672) - lu(k,611) * lu(k,1657) + lu(k,1674) = lu(k,1674) - lu(k,612) * lu(k,1657) + lu(k,1676) = lu(k,1676) - lu(k,613) * lu(k,1657) + lu(k,1677) = lu(k,1677) - lu(k,614) * lu(k,1657) + lu(k,1680) = lu(k,1680) - lu(k,615) * lu(k,1657) + lu(k,1682) = lu(k,1682) - lu(k,616) * lu(k,1657) + lu(k,1683) = lu(k,1683) - lu(k,617) * lu(k,1657) + lu(k,1685) = lu(k,1685) - lu(k,618) * lu(k,1657) + lu(k,1691) = lu(k,1691) - lu(k,619) * lu(k,1657) + lu(k,622) = 1._r8 / lu(k,622) + lu(k,623) = lu(k,623) * lu(k,622) + lu(k,624) = lu(k,624) * lu(k,622) + lu(k,625) = lu(k,625) * lu(k,622) + lu(k,626) = lu(k,626) * lu(k,622) + lu(k,627) = lu(k,627) * lu(k,622) + lu(k,628) = lu(k,628) * lu(k,622) + lu(k,629) = lu(k,629) * lu(k,622) + lu(k,630) = lu(k,630) * lu(k,622) + lu(k,631) = lu(k,631) * lu(k,622) + lu(k,632) = lu(k,632) * lu(k,622) + lu(k,633) = lu(k,633) * lu(k,622) + lu(k,634) = lu(k,634) * lu(k,622) + lu(k,635) = lu(k,635) * lu(k,622) + lu(k,636) = lu(k,636) * lu(k,622) + lu(k,637) = lu(k,637) * lu(k,622) + lu(k,638) = lu(k,638) * lu(k,622) + lu(k,639) = lu(k,639) * lu(k,622) + lu(k,688) = lu(k,688) - lu(k,623) * lu(k,687) + lu(k,689) = lu(k,689) - lu(k,624) * lu(k,687) + lu(k,690) = lu(k,690) - lu(k,625) * lu(k,687) + lu(k,691) = lu(k,691) - lu(k,626) * lu(k,687) + lu(k,692) = lu(k,692) - lu(k,627) * lu(k,687) + lu(k,693) = lu(k,693) - lu(k,628) * lu(k,687) + lu(k,694) = lu(k,694) - lu(k,629) * lu(k,687) + lu(k,695) = lu(k,695) - lu(k,630) * lu(k,687) + lu(k,696) = lu(k,696) - lu(k,631) * lu(k,687) + lu(k,697) = lu(k,697) - lu(k,632) * lu(k,687) + lu(k,698) = lu(k,698) - lu(k,633) * lu(k,687) + lu(k,699) = lu(k,699) - lu(k,634) * lu(k,687) + lu(k,700) = lu(k,700) - lu(k,635) * lu(k,687) + lu(k,701) = lu(k,701) - lu(k,636) * lu(k,687) + lu(k,702) = lu(k,702) - lu(k,637) * lu(k,687) + lu(k,703) = lu(k,703) - lu(k,638) * lu(k,687) + lu(k,704) = lu(k,704) - lu(k,639) * lu(k,687) + lu(k,1087) = lu(k,1087) - lu(k,623) * lu(k,1086) + lu(k,1091) = lu(k,1091) - lu(k,624) * lu(k,1086) + lu(k,1096) = lu(k,1096) - lu(k,625) * lu(k,1086) + lu(k,1097) = lu(k,1097) - lu(k,626) * lu(k,1086) + lu(k,1098) = lu(k,1098) - lu(k,627) * lu(k,1086) + lu(k,1099) = lu(k,1099) - lu(k,628) * lu(k,1086) + lu(k,1100) = lu(k,1100) - lu(k,629) * lu(k,1086) + lu(k,1101) = lu(k,1101) - lu(k,630) * lu(k,1086) + lu(k,1102) = lu(k,1102) - lu(k,631) * lu(k,1086) + lu(k,1103) = lu(k,1103) - lu(k,632) * lu(k,1086) + lu(k,1104) = lu(k,1104) - lu(k,633) * lu(k,1086) + lu(k,1107) = lu(k,1107) - lu(k,634) * lu(k,1086) + lu(k,1108) = lu(k,1108) - lu(k,635) * lu(k,1086) + lu(k,1109) = lu(k,1109) - lu(k,636) * lu(k,1086) + lu(k,1110) = lu(k,1110) - lu(k,637) * lu(k,1086) + lu(k,1112) = lu(k,1112) - lu(k,638) * lu(k,1086) + lu(k,1118) = lu(k,1118) - lu(k,639) * lu(k,1086) + lu(k,1134) = lu(k,1134) - lu(k,623) * lu(k,1132) + lu(k,1138) = lu(k,1138) - lu(k,624) * lu(k,1132) + lu(k,1144) = lu(k,1144) - lu(k,625) * lu(k,1132) + lu(k,1145) = lu(k,1145) - lu(k,626) * lu(k,1132) + lu(k,1146) = lu(k,1146) - lu(k,627) * lu(k,1132) + lu(k,1147) = lu(k,1147) - lu(k,628) * lu(k,1132) + lu(k,1148) = lu(k,1148) - lu(k,629) * lu(k,1132) + lu(k,1149) = lu(k,1149) - lu(k,630) * lu(k,1132) + lu(k,1150) = lu(k,1150) - lu(k,631) * lu(k,1132) + lu(k,1151) = lu(k,1151) - lu(k,632) * lu(k,1132) + lu(k,1152) = lu(k,1152) - lu(k,633) * lu(k,1132) + lu(k,1155) = lu(k,1155) - lu(k,634) * lu(k,1132) + lu(k,1156) = lu(k,1156) - lu(k,635) * lu(k,1132) + lu(k,1157) = lu(k,1157) - lu(k,636) * lu(k,1132) + lu(k,1158) = lu(k,1158) - lu(k,637) * lu(k,1132) + lu(k,1160) = lu(k,1160) - lu(k,638) * lu(k,1132) + lu(k,1166) = lu(k,1166) - lu(k,639) * lu(k,1132) + lu(k,1178) = lu(k,1178) - lu(k,623) * lu(k,1176) + lu(k,1181) = lu(k,1181) - lu(k,624) * lu(k,1176) + lu(k,1187) = lu(k,1187) - lu(k,625) * lu(k,1176) + lu(k,1188) = lu(k,1188) - lu(k,626) * lu(k,1176) + lu(k,1189) = lu(k,1189) - lu(k,627) * lu(k,1176) + lu(k,1190) = lu(k,1190) - lu(k,628) * lu(k,1176) + lu(k,1191) = lu(k,1191) - lu(k,629) * lu(k,1176) + lu(k,1192) = lu(k,1192) - lu(k,630) * lu(k,1176) + lu(k,1193) = lu(k,1193) - lu(k,631) * lu(k,1176) + lu(k,1194) = lu(k,1194) - lu(k,632) * lu(k,1176) + lu(k,1195) = lu(k,1195) - lu(k,633) * lu(k,1176) + lu(k,1198) = lu(k,1198) - lu(k,634) * lu(k,1176) + lu(k,1199) = lu(k,1199) - lu(k,635) * lu(k,1176) + lu(k,1200) = lu(k,1200) - lu(k,636) * lu(k,1176) + lu(k,1201) = lu(k,1201) - lu(k,637) * lu(k,1176) + lu(k,1203) = lu(k,1203) - lu(k,638) * lu(k,1176) + lu(k,1209) = lu(k,1209) - lu(k,639) * lu(k,1176) + lu(k,1321) = lu(k,1321) - lu(k,623) * lu(k,1319) + lu(k,1324) = lu(k,1324) - lu(k,624) * lu(k,1319) + lu(k,1330) = lu(k,1330) - lu(k,625) * lu(k,1319) + lu(k,1331) = lu(k,1331) - lu(k,626) * lu(k,1319) + lu(k,1332) = lu(k,1332) - lu(k,627) * lu(k,1319) + lu(k,1333) = lu(k,1333) - lu(k,628) * lu(k,1319) + lu(k,1334) = lu(k,1334) - lu(k,629) * lu(k,1319) + lu(k,1335) = lu(k,1335) - lu(k,630) * lu(k,1319) + lu(k,1336) = lu(k,1336) - lu(k,631) * lu(k,1319) + lu(k,1337) = lu(k,1337) - lu(k,632) * lu(k,1319) + lu(k,1338) = lu(k,1338) - lu(k,633) * lu(k,1319) + lu(k,1341) = lu(k,1341) - lu(k,634) * lu(k,1319) + lu(k,1342) = lu(k,1342) - lu(k,635) * lu(k,1319) + lu(k,1343) = lu(k,1343) - lu(k,636) * lu(k,1319) + lu(k,1344) = lu(k,1344) - lu(k,637) * lu(k,1319) + lu(k,1346) = lu(k,1346) - lu(k,638) * lu(k,1319) + lu(k,1352) = lu(k,1352) - lu(k,639) * lu(k,1319) + lu(k,1400) = lu(k,1400) - lu(k,623) * lu(k,1398) + lu(k,1403) = lu(k,1403) - lu(k,624) * lu(k,1398) + lu(k,1409) = lu(k,1409) - lu(k,625) * lu(k,1398) + lu(k,1410) = lu(k,1410) - lu(k,626) * lu(k,1398) + lu(k,1411) = lu(k,1411) - lu(k,627) * lu(k,1398) + lu(k,1412) = lu(k,1412) - lu(k,628) * lu(k,1398) + lu(k,1413) = lu(k,1413) - lu(k,629) * lu(k,1398) + lu(k,1414) = lu(k,1414) - lu(k,630) * lu(k,1398) + lu(k,1415) = lu(k,1415) - lu(k,631) * lu(k,1398) + lu(k,1416) = lu(k,1416) - lu(k,632) * lu(k,1398) + lu(k,1417) = lu(k,1417) - lu(k,633) * lu(k,1398) + lu(k,1420) = lu(k,1420) - lu(k,634) * lu(k,1398) + lu(k,1421) = lu(k,1421) - lu(k,635) * lu(k,1398) + lu(k,1422) = lu(k,1422) - lu(k,636) * lu(k,1398) + lu(k,1423) = lu(k,1423) - lu(k,637) * lu(k,1398) + lu(k,1425) = lu(k,1425) - lu(k,638) * lu(k,1398) + lu(k,1431) = lu(k,1431) - lu(k,639) * lu(k,1398) + lu(k,1443) = lu(k,1443) - lu(k,623) * lu(k,1441) + lu(k,1446) = lu(k,1446) - lu(k,624) * lu(k,1441) + lu(k,1452) = lu(k,1452) - lu(k,625) * lu(k,1441) + lu(k,1453) = lu(k,1453) - lu(k,626) * lu(k,1441) + lu(k,1454) = lu(k,1454) - lu(k,627) * lu(k,1441) + lu(k,1455) = lu(k,1455) - lu(k,628) * lu(k,1441) + lu(k,1456) = lu(k,1456) - lu(k,629) * lu(k,1441) + lu(k,1457) = lu(k,1457) - lu(k,630) * lu(k,1441) + lu(k,1458) = lu(k,1458) - lu(k,631) * lu(k,1441) + lu(k,1459) = lu(k,1459) - lu(k,632) * lu(k,1441) + lu(k,1460) = lu(k,1460) - lu(k,633) * lu(k,1441) + lu(k,1463) = lu(k,1463) - lu(k,634) * lu(k,1441) + lu(k,1464) = lu(k,1464) - lu(k,635) * lu(k,1441) + lu(k,1465) = lu(k,1465) - lu(k,636) * lu(k,1441) + lu(k,1466) = lu(k,1466) - lu(k,637) * lu(k,1441) + lu(k,1468) = lu(k,1468) - lu(k,638) * lu(k,1441) + lu(k,1474) = lu(k,1474) - lu(k,639) * lu(k,1441) + lu(k,1568) = lu(k,1568) - lu(k,623) * lu(k,1566) + lu(k,1572) = lu(k,1572) - lu(k,624) * lu(k,1566) + lu(k,1578) = lu(k,1578) - lu(k,625) * lu(k,1566) + lu(k,1579) = lu(k,1579) - lu(k,626) * lu(k,1566) + lu(k,1580) = lu(k,1580) - lu(k,627) * lu(k,1566) + lu(k,1581) = lu(k,1581) - lu(k,628) * lu(k,1566) + lu(k,1582) = lu(k,1582) - lu(k,629) * lu(k,1566) + lu(k,1583) = lu(k,1583) - lu(k,630) * lu(k,1566) + lu(k,1584) = lu(k,1584) - lu(k,631) * lu(k,1566) + lu(k,1585) = lu(k,1585) - lu(k,632) * lu(k,1566) + lu(k,1586) = lu(k,1586) - lu(k,633) * lu(k,1566) + lu(k,1589) = lu(k,1589) - lu(k,634) * lu(k,1566) + lu(k,1590) = lu(k,1590) - lu(k,635) * lu(k,1566) + lu(k,1591) = lu(k,1591) - lu(k,636) * lu(k,1566) + lu(k,1592) = lu(k,1592) - lu(k,637) * lu(k,1566) + lu(k,1594) = lu(k,1594) - lu(k,638) * lu(k,1566) + lu(k,1600) = lu(k,1600) - lu(k,639) * lu(k,1566) + lu(k,1615) = lu(k,1615) - lu(k,623) * lu(k,1613) + lu(k,1620) = lu(k,1620) - lu(k,624) * lu(k,1613) + lu(k,1626) = lu(k,1626) - lu(k,625) * lu(k,1613) + lu(k,1627) = lu(k,1627) - lu(k,626) * lu(k,1613) + lu(k,1628) = lu(k,1628) - lu(k,627) * lu(k,1613) + lu(k,1629) = lu(k,1629) - lu(k,628) * lu(k,1613) + lu(k,1630) = lu(k,1630) - lu(k,629) * lu(k,1613) + lu(k,1631) = lu(k,1631) - lu(k,630) * lu(k,1613) + lu(k,1632) = lu(k,1632) - lu(k,631) * lu(k,1613) + lu(k,1633) = lu(k,1633) - lu(k,632) * lu(k,1613) + lu(k,1634) = lu(k,1634) - lu(k,633) * lu(k,1613) + lu(k,1637) = lu(k,1637) - lu(k,634) * lu(k,1613) + lu(k,1638) = lu(k,1638) - lu(k,635) * lu(k,1613) + lu(k,1639) = lu(k,1639) - lu(k,636) * lu(k,1613) + lu(k,1640) = lu(k,1640) - lu(k,637) * lu(k,1613) + lu(k,1642) = lu(k,1642) - lu(k,638) * lu(k,1613) + lu(k,1648) = lu(k,1648) - lu(k,639) * lu(k,1613) + lu(k,1660) = lu(k,1660) - lu(k,623) * lu(k,1658) + lu(k,1663) = lu(k,1663) - lu(k,624) * lu(k,1658) + lu(k,1669) = lu(k,1669) - lu(k,625) * lu(k,1658) + lu(k,1670) = lu(k,1670) - lu(k,626) * lu(k,1658) + lu(k,1671) = lu(k,1671) - lu(k,627) * lu(k,1658) + lu(k,1672) = lu(k,1672) - lu(k,628) * lu(k,1658) + lu(k,1673) = lu(k,1673) - lu(k,629) * lu(k,1658) + lu(k,1674) = lu(k,1674) - lu(k,630) * lu(k,1658) + lu(k,1675) = lu(k,1675) - lu(k,631) * lu(k,1658) + lu(k,1676) = lu(k,1676) - lu(k,632) * lu(k,1658) + lu(k,1677) = lu(k,1677) - lu(k,633) * lu(k,1658) + lu(k,1680) = lu(k,1680) - lu(k,634) * lu(k,1658) + lu(k,1681) = lu(k,1681) - lu(k,635) * lu(k,1658) + lu(k,1682) = lu(k,1682) - lu(k,636) * lu(k,1658) + lu(k,1683) = lu(k,1683) - lu(k,637) * lu(k,1658) + lu(k,1685) = lu(k,1685) - lu(k,638) * lu(k,1658) + lu(k,1691) = lu(k,1691) - lu(k,639) * lu(k,1658) + lu(k,2054) = lu(k,2054) - lu(k,623) * lu(k,2051) + lu(k,2059) = lu(k,2059) - lu(k,624) * lu(k,2051) + lu(k,2065) = lu(k,2065) - lu(k,625) * lu(k,2051) + lu(k,2066) = lu(k,2066) - lu(k,626) * lu(k,2051) + lu(k,2067) = lu(k,2067) - lu(k,627) * lu(k,2051) + lu(k,2068) = lu(k,2068) - lu(k,628) * lu(k,2051) + lu(k,2069) = lu(k,2069) - lu(k,629) * lu(k,2051) + lu(k,2070) = lu(k,2070) - lu(k,630) * lu(k,2051) + lu(k,2071) = lu(k,2071) - lu(k,631) * lu(k,2051) + lu(k,2072) = lu(k,2072) - lu(k,632) * lu(k,2051) + lu(k,2073) = lu(k,2073) - lu(k,633) * lu(k,2051) + lu(k,2076) = lu(k,2076) - lu(k,634) * lu(k,2051) + lu(k,2077) = lu(k,2077) - lu(k,635) * lu(k,2051) + lu(k,2078) = lu(k,2078) - lu(k,636) * lu(k,2051) + lu(k,2079) = lu(k,2079) - lu(k,637) * lu(k,2051) + lu(k,2081) = lu(k,2081) - lu(k,638) * lu(k,2051) + lu(k,2087) = lu(k,2087) - lu(k,639) * lu(k,2051) + lu(k,644) = 1._r8 / lu(k,644) + lu(k,645) = lu(k,645) * lu(k,644) + lu(k,646) = lu(k,646) * lu(k,644) + lu(k,647) = lu(k,647) * lu(k,644) + lu(k,648) = lu(k,648) * lu(k,644) + lu(k,649) = lu(k,649) * lu(k,644) + lu(k,650) = lu(k,650) * lu(k,644) + lu(k,651) = lu(k,651) * lu(k,644) + lu(k,652) = lu(k,652) * lu(k,644) + lu(k,653) = lu(k,653) * lu(k,644) + lu(k,654) = lu(k,654) * lu(k,644) + lu(k,655) = lu(k,655) * lu(k,644) + lu(k,656) = lu(k,656) * lu(k,644) + lu(k,657) = lu(k,657) * lu(k,644) + lu(k,658) = lu(k,658) * lu(k,644) + lu(k,659) = lu(k,659) * lu(k,644) + lu(k,660) = lu(k,660) * lu(k,644) + lu(k,661) = lu(k,661) * lu(k,644) + lu(k,662) = lu(k,662) * lu(k,644) + lu(k,663) = lu(k,663) * lu(k,644) + lu(k,735) = lu(k,735) - lu(k,645) * lu(k,733) + lu(k,736) = lu(k,736) - lu(k,646) * lu(k,733) + lu(k,737) = lu(k,737) - lu(k,647) * lu(k,733) + lu(k,738) = lu(k,738) - lu(k,648) * lu(k,733) + lu(k,739) = - lu(k,649) * lu(k,733) + lu(k,740) = lu(k,740) - lu(k,650) * lu(k,733) + lu(k,741) = lu(k,741) - lu(k,651) * lu(k,733) + lu(k,742) = lu(k,742) - lu(k,652) * lu(k,733) + lu(k,743) = lu(k,743) - lu(k,653) * lu(k,733) + lu(k,744) = lu(k,744) - lu(k,654) * lu(k,733) + lu(k,745) = - lu(k,655) * lu(k,733) + lu(k,746) = - lu(k,656) * lu(k,733) + lu(k,747) = - lu(k,657) * lu(k,733) + lu(k,748) = lu(k,748) - lu(k,658) * lu(k,733) + lu(k,749) = - lu(k,659) * lu(k,733) + lu(k,750) = - lu(k,660) * lu(k,733) + lu(k,752) = lu(k,752) - lu(k,661) * lu(k,733) + lu(k,753) = lu(k,753) - lu(k,662) * lu(k,733) + lu(k,754) = lu(k,754) - lu(k,663) * lu(k,733) + lu(k,783) = lu(k,783) - lu(k,645) * lu(k,781) + lu(k,784) = lu(k,784) - lu(k,646) * lu(k,781) + lu(k,785) = lu(k,785) - lu(k,647) * lu(k,781) + lu(k,786) = lu(k,786) - lu(k,648) * lu(k,781) + lu(k,787) = lu(k,787) - lu(k,649) * lu(k,781) + lu(k,788) = lu(k,788) - lu(k,650) * lu(k,781) + lu(k,789) = lu(k,789) - lu(k,651) * lu(k,781) + lu(k,790) = lu(k,790) - lu(k,652) * lu(k,781) + lu(k,791) = lu(k,791) - lu(k,653) * lu(k,781) + lu(k,793) = lu(k,793) - lu(k,654) * lu(k,781) + lu(k,796) = lu(k,796) - lu(k,655) * lu(k,781) + lu(k,797) = lu(k,797) - lu(k,656) * lu(k,781) + lu(k,798) = lu(k,798) - lu(k,657) * lu(k,781) + lu(k,799) = lu(k,799) - lu(k,658) * lu(k,781) + lu(k,800) = - lu(k,659) * lu(k,781) + lu(k,801) = lu(k,801) - lu(k,660) * lu(k,781) + lu(k,803) = lu(k,803) - lu(k,661) * lu(k,781) + lu(k,804) = lu(k,804) - lu(k,662) * lu(k,781) + lu(k,805) = lu(k,805) - lu(k,663) * lu(k,781) + lu(k,895) = lu(k,895) - lu(k,645) * lu(k,893) + lu(k,896) = lu(k,896) - lu(k,646) * lu(k,893) + lu(k,897) = lu(k,897) - lu(k,647) * lu(k,893) + lu(k,898) = lu(k,898) - lu(k,648) * lu(k,893) + lu(k,899) = lu(k,899) - lu(k,649) * lu(k,893) + lu(k,900) = lu(k,900) - lu(k,650) * lu(k,893) + lu(k,901) = - lu(k,651) * lu(k,893) + lu(k,902) = lu(k,902) - lu(k,652) * lu(k,893) + lu(k,904) = lu(k,904) - lu(k,653) * lu(k,893) + lu(k,906) = lu(k,906) - lu(k,654) * lu(k,893) + lu(k,909) = lu(k,909) - lu(k,655) * lu(k,893) + lu(k,910) = lu(k,910) - lu(k,656) * lu(k,893) + lu(k,911) = lu(k,911) - lu(k,657) * lu(k,893) + lu(k,912) = lu(k,912) - lu(k,658) * lu(k,893) + lu(k,913) = - lu(k,659) * lu(k,893) + lu(k,914) = - lu(k,660) * lu(k,893) + lu(k,916) = lu(k,916) - lu(k,661) * lu(k,893) + lu(k,917) = lu(k,917) - lu(k,662) * lu(k,893) + lu(k,918) = lu(k,918) - lu(k,663) * lu(k,893) + lu(k,978) = lu(k,978) - lu(k,645) * lu(k,976) + lu(k,979) = lu(k,979) - lu(k,646) * lu(k,976) + lu(k,980) = lu(k,980) - lu(k,647) * lu(k,976) + lu(k,981) = lu(k,981) - lu(k,648) * lu(k,976) + lu(k,982) = lu(k,982) - lu(k,649) * lu(k,976) + lu(k,983) = lu(k,983) - lu(k,650) * lu(k,976) + lu(k,985) = lu(k,985) - lu(k,651) * lu(k,976) + lu(k,986) = lu(k,986) - lu(k,652) * lu(k,976) + lu(k,988) = lu(k,988) - lu(k,653) * lu(k,976) + lu(k,990) = lu(k,990) - lu(k,654) * lu(k,976) + lu(k,993) = lu(k,993) - lu(k,655) * lu(k,976) + lu(k,994) = lu(k,994) - lu(k,656) * lu(k,976) + lu(k,995) = lu(k,995) - lu(k,657) * lu(k,976) + lu(k,996) = lu(k,996) - lu(k,658) * lu(k,976) + lu(k,997) = - lu(k,659) * lu(k,976) + lu(k,998) = - lu(k,660) * lu(k,976) + lu(k,1000) = lu(k,1000) - lu(k,661) * lu(k,976) + lu(k,1001) = lu(k,1001) - lu(k,662) * lu(k,976) + lu(k,1002) = lu(k,1002) - lu(k,663) * lu(k,976) + lu(k,1219) = lu(k,1219) - lu(k,645) * lu(k,1217) + lu(k,1220) = lu(k,1220) - lu(k,646) * lu(k,1217) + lu(k,1223) = lu(k,1223) - lu(k,647) * lu(k,1217) + lu(k,1225) = lu(k,1225) - lu(k,648) * lu(k,1217) + lu(k,1227) = - lu(k,649) * lu(k,1217) + lu(k,1228) = lu(k,1228) - lu(k,650) * lu(k,1217) + lu(k,1231) = lu(k,1231) - lu(k,651) * lu(k,1217) + lu(k,1232) = lu(k,1232) - lu(k,652) * lu(k,1217) + lu(k,1234) = lu(k,1234) - lu(k,653) * lu(k,1217) + lu(k,1237) = lu(k,1237) - lu(k,654) * lu(k,1217) + lu(k,1240) = lu(k,1240) - lu(k,655) * lu(k,1217) + lu(k,1242) = lu(k,1242) - lu(k,656) * lu(k,1217) + lu(k,1243) = lu(k,1243) - lu(k,657) * lu(k,1217) + lu(k,1244) = lu(k,1244) - lu(k,658) * lu(k,1217) + lu(k,1245) = - lu(k,659) * lu(k,1217) + lu(k,1246) = lu(k,1246) - lu(k,660) * lu(k,1217) + lu(k,1248) = lu(k,1248) - lu(k,661) * lu(k,1217) + lu(k,1249) = lu(k,1249) - lu(k,662) * lu(k,1217) + lu(k,1250) = lu(k,1250) - lu(k,663) * lu(k,1217) + lu(k,1278) = lu(k,1278) - lu(k,645) * lu(k,1276) + lu(k,1279) = lu(k,1279) - lu(k,646) * lu(k,1276) + lu(k,1283) = lu(k,1283) - lu(k,647) * lu(k,1276) + lu(k,1285) = lu(k,1285) - lu(k,648) * lu(k,1276) + lu(k,1287) = lu(k,1287) - lu(k,649) * lu(k,1276) + lu(k,1288) = lu(k,1288) - lu(k,650) * lu(k,1276) + lu(k,1291) = lu(k,1291) - lu(k,651) * lu(k,1276) + lu(k,1292) = lu(k,1292) - lu(k,652) * lu(k,1276) + lu(k,1294) = lu(k,1294) - lu(k,653) * lu(k,1276) + lu(k,1297) = lu(k,1297) - lu(k,654) * lu(k,1276) + lu(k,1300) = lu(k,1300) - lu(k,655) * lu(k,1276) + lu(k,1302) = lu(k,1302) - lu(k,656) * lu(k,1276) + lu(k,1303) = lu(k,1303) - lu(k,657) * lu(k,1276) + lu(k,1304) = lu(k,1304) - lu(k,658) * lu(k,1276) + lu(k,1305) = lu(k,1305) - lu(k,659) * lu(k,1276) + lu(k,1306) = lu(k,1306) - lu(k,660) * lu(k,1276) + lu(k,1308) = lu(k,1308) - lu(k,661) * lu(k,1276) + lu(k,1309) = lu(k,1309) - lu(k,662) * lu(k,1276) + lu(k,1310) = lu(k,1310) - lu(k,663) * lu(k,1276) + lu(k,1356) = - lu(k,645) * lu(k,1355) + lu(k,1357) = - lu(k,646) * lu(k,1355) + lu(k,1361) = lu(k,1361) - lu(k,647) * lu(k,1355) + lu(k,1363) = lu(k,1363) - lu(k,648) * lu(k,1355) + lu(k,1365) = lu(k,1365) - lu(k,649) * lu(k,1355) + lu(k,1366) = - lu(k,650) * lu(k,1355) + lu(k,1369) = - lu(k,651) * lu(k,1355) + lu(k,1370) = lu(k,1370) - lu(k,652) * lu(k,1355) + lu(k,1372) = lu(k,1372) - lu(k,653) * lu(k,1355) + lu(k,1375) = lu(k,1375) - lu(k,654) * lu(k,1355) + lu(k,1378) = lu(k,1378) - lu(k,655) * lu(k,1355) + lu(k,1380) = lu(k,1380) - lu(k,656) * lu(k,1355) + lu(k,1381) = - lu(k,657) * lu(k,1355) + lu(k,1382) = lu(k,1382) - lu(k,658) * lu(k,1355) + lu(k,1383) = lu(k,1383) - lu(k,659) * lu(k,1355) + lu(k,1384) = lu(k,1384) - lu(k,660) * lu(k,1355) + lu(k,1386) = lu(k,1386) - lu(k,661) * lu(k,1355) + lu(k,1387) = - lu(k,662) * lu(k,1355) + lu(k,1388) = lu(k,1388) - lu(k,663) * lu(k,1355) + lu(k,1865) = - lu(k,645) * lu(k,1864) + lu(k,1866) = - lu(k,646) * lu(k,1864) + lu(k,1869) = - lu(k,647) * lu(k,1864) + lu(k,1871) = lu(k,1871) - lu(k,648) * lu(k,1864) + lu(k,1873) = lu(k,1873) - lu(k,649) * lu(k,1864) + lu(k,1874) = - lu(k,650) * lu(k,1864) + lu(k,1877) = lu(k,1877) - lu(k,651) * lu(k,1864) + lu(k,1878) = lu(k,1878) - lu(k,652) * lu(k,1864) + lu(k,1880) = lu(k,1880) - lu(k,653) * lu(k,1864) + lu(k,1883) = lu(k,1883) - lu(k,654) * lu(k,1864) + lu(k,1886) = lu(k,1886) - lu(k,655) * lu(k,1864) + lu(k,1888) = lu(k,1888) - lu(k,656) * lu(k,1864) + lu(k,1889) = lu(k,1889) - lu(k,657) * lu(k,1864) + lu(k,1890) = lu(k,1890) - lu(k,658) * lu(k,1864) + lu(k,1891) = lu(k,1891) - lu(k,659) * lu(k,1864) + lu(k,1892) = lu(k,1892) - lu(k,660) * lu(k,1864) + lu(k,1894) = lu(k,1894) - lu(k,661) * lu(k,1864) + lu(k,1895) = lu(k,1895) - lu(k,662) * lu(k,1864) + lu(k,1896) = lu(k,1896) - lu(k,663) * lu(k,1864) + lu(k,1995) = lu(k,1995) - lu(k,645) * lu(k,1993) + lu(k,1996) = lu(k,1996) - lu(k,646) * lu(k,1993) + lu(k,2000) = lu(k,2000) - lu(k,647) * lu(k,1993) + lu(k,2002) = lu(k,2002) - lu(k,648) * lu(k,1993) + lu(k,2004) = - lu(k,649) * lu(k,1993) + lu(k,2005) = lu(k,2005) - lu(k,650) * lu(k,1993) + lu(k,2008) = lu(k,2008) - lu(k,651) * lu(k,1993) + lu(k,2009) = lu(k,2009) - lu(k,652) * lu(k,1993) + lu(k,2011) = lu(k,2011) - lu(k,653) * lu(k,1993) + lu(k,2014) = lu(k,2014) - lu(k,654) * lu(k,1993) + lu(k,2017) = lu(k,2017) - lu(k,655) * lu(k,1993) + lu(k,2019) = lu(k,2019) - lu(k,656) * lu(k,1993) + lu(k,2020) = lu(k,2020) - lu(k,657) * lu(k,1993) + lu(k,2021) = lu(k,2021) - lu(k,658) * lu(k,1993) + lu(k,2022) = lu(k,2022) - lu(k,659) * lu(k,1993) + lu(k,2023) = lu(k,2023) - lu(k,660) * lu(k,1993) + lu(k,2025) = lu(k,2025) - lu(k,661) * lu(k,1993) + lu(k,2026) = lu(k,2026) - lu(k,662) * lu(k,1993) + lu(k,2027) = lu(k,2027) - lu(k,663) * lu(k,1993) + lu(k,2056) = lu(k,2056) - lu(k,645) * lu(k,2052) + lu(k,2057) = lu(k,2057) - lu(k,646) * lu(k,2052) + lu(k,2060) = lu(k,2060) - lu(k,647) * lu(k,2052) + lu(k,2062) = lu(k,2062) - lu(k,648) * lu(k,2052) + lu(k,2064) = lu(k,2064) - lu(k,649) * lu(k,2052) + lu(k,2065) = lu(k,2065) - lu(k,650) * lu(k,2052) + lu(k,2068) = lu(k,2068) - lu(k,651) * lu(k,2052) + lu(k,2069) = lu(k,2069) - lu(k,652) * lu(k,2052) + lu(k,2071) = lu(k,2071) - lu(k,653) * lu(k,2052) + lu(k,2074) = lu(k,2074) - lu(k,654) * lu(k,2052) + lu(k,2077) = lu(k,2077) - lu(k,655) * lu(k,2052) + lu(k,2079) = lu(k,2079) - lu(k,656) * lu(k,2052) + lu(k,2080) = lu(k,2080) - lu(k,657) * lu(k,2052) + lu(k,2081) = lu(k,2081) - lu(k,658) * lu(k,2052) + lu(k,2082) = lu(k,2082) - lu(k,659) * lu(k,2052) + lu(k,2083) = lu(k,2083) - lu(k,660) * lu(k,2052) + lu(k,2085) = lu(k,2085) - lu(k,661) * lu(k,2052) + lu(k,2086) = lu(k,2086) - lu(k,662) * lu(k,2052) + lu(k,2087) = lu(k,2087) - lu(k,663) * lu(k,2052) end do end subroutine lu_fac16 subroutine lu_fac17( avec_len, lu ) @@ -5646,958 +4363,720 @@ subroutine lu_fac17( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,690) = 1._r8 / lu(k,690) - lu(k,691) = lu(k,691) * lu(k,690) - lu(k,692) = lu(k,692) * lu(k,690) - lu(k,693) = lu(k,693) * lu(k,690) - lu(k,694) = lu(k,694) * lu(k,690) - lu(k,695) = lu(k,695) * lu(k,690) - lu(k,696) = lu(k,696) * lu(k,690) - lu(k,697) = lu(k,697) * lu(k,690) - lu(k,698) = lu(k,698) * lu(k,690) - lu(k,699) = lu(k,699) * lu(k,690) - lu(k,700) = lu(k,700) * lu(k,690) - lu(k,701) = lu(k,701) * lu(k,690) - lu(k,702) = lu(k,702) * lu(k,690) - lu(k,703) = lu(k,703) * lu(k,690) - lu(k,704) = lu(k,704) * lu(k,690) - lu(k,705) = lu(k,705) * lu(k,690) - lu(k,706) = lu(k,706) * lu(k,690) - lu(k,707) = lu(k,707) * lu(k,690) - lu(k,708) = lu(k,708) * lu(k,690) - lu(k,713) = lu(k,713) - lu(k,691) * lu(k,712) - lu(k,714) = lu(k,714) - lu(k,692) * lu(k,712) - lu(k,715) = lu(k,715) - lu(k,693) * lu(k,712) - lu(k,716) = lu(k,716) - lu(k,694) * lu(k,712) - lu(k,717) = lu(k,717) - lu(k,695) * lu(k,712) - lu(k,718) = lu(k,718) - lu(k,696) * lu(k,712) - lu(k,719) = lu(k,719) - lu(k,697) * lu(k,712) - lu(k,721) = lu(k,721) - lu(k,698) * lu(k,712) - lu(k,723) = lu(k,723) - lu(k,699) * lu(k,712) - lu(k,724) = lu(k,724) - lu(k,700) * lu(k,712) - lu(k,725) = lu(k,725) - lu(k,701) * lu(k,712) - lu(k,727) = - lu(k,702) * lu(k,712) - lu(k,728) = lu(k,728) - lu(k,703) * lu(k,712) - lu(k,729) = lu(k,729) - lu(k,704) * lu(k,712) - lu(k,730) = lu(k,730) - lu(k,705) * lu(k,712) - lu(k,731) = lu(k,731) - lu(k,706) * lu(k,712) - lu(k,732) = lu(k,732) - lu(k,707) * lu(k,712) - lu(k,733) = lu(k,733) - lu(k,708) * lu(k,712) - lu(k,820) = lu(k,820) - lu(k,691) * lu(k,819) - lu(k,823) = lu(k,823) - lu(k,692) * lu(k,819) - lu(k,824) = lu(k,824) - lu(k,693) * lu(k,819) - lu(k,825) = lu(k,825) - lu(k,694) * lu(k,819) - lu(k,826) = lu(k,826) - lu(k,695) * lu(k,819) - lu(k,827) = lu(k,827) - lu(k,696) * lu(k,819) - lu(k,828) = lu(k,828) - lu(k,697) * lu(k,819) - lu(k,830) = - lu(k,698) * lu(k,819) - lu(k,832) = lu(k,832) - lu(k,699) * lu(k,819) - lu(k,833) = lu(k,833) - lu(k,700) * lu(k,819) - lu(k,835) = lu(k,835) - lu(k,701) * lu(k,819) - lu(k,837) = lu(k,837) - lu(k,702) * lu(k,819) - lu(k,838) = lu(k,838) - lu(k,703) * lu(k,819) - lu(k,839) = lu(k,839) - lu(k,704) * lu(k,819) - lu(k,840) = lu(k,840) - lu(k,705) * lu(k,819) - lu(k,843) = lu(k,843) - lu(k,706) * lu(k,819) - lu(k,845) = lu(k,845) - lu(k,707) * lu(k,819) - lu(k,846) = lu(k,846) - lu(k,708) * lu(k,819) - lu(k,850) = lu(k,850) - lu(k,691) * lu(k,849) - lu(k,852) = lu(k,852) - lu(k,692) * lu(k,849) - lu(k,853) = lu(k,853) - lu(k,693) * lu(k,849) - lu(k,854) = lu(k,854) - lu(k,694) * lu(k,849) - lu(k,855) = lu(k,855) - lu(k,695) * lu(k,849) - lu(k,856) = lu(k,856) - lu(k,696) * lu(k,849) - lu(k,857) = lu(k,857) - lu(k,697) * lu(k,849) - lu(k,859) = lu(k,859) - lu(k,698) * lu(k,849) - lu(k,861) = lu(k,861) - lu(k,699) * lu(k,849) - lu(k,862) = lu(k,862) - lu(k,700) * lu(k,849) - lu(k,864) = lu(k,864) - lu(k,701) * lu(k,849) - lu(k,866) = lu(k,866) - lu(k,702) * lu(k,849) - lu(k,867) = lu(k,867) - lu(k,703) * lu(k,849) - lu(k,868) = lu(k,868) - lu(k,704) * lu(k,849) - lu(k,869) = lu(k,869) - lu(k,705) * lu(k,849) - lu(k,872) = lu(k,872) - lu(k,706) * lu(k,849) - lu(k,874) = lu(k,874) - lu(k,707) * lu(k,849) - lu(k,875) = lu(k,875) - lu(k,708) * lu(k,849) - lu(k,895) = lu(k,895) - lu(k,691) * lu(k,894) - lu(k,899) = lu(k,899) - lu(k,692) * lu(k,894) - lu(k,900) = lu(k,900) - lu(k,693) * lu(k,894) - lu(k,901) = lu(k,901) - lu(k,694) * lu(k,894) - lu(k,902) = lu(k,902) - lu(k,695) * lu(k,894) - lu(k,903) = lu(k,903) - lu(k,696) * lu(k,894) - lu(k,904) = lu(k,904) - lu(k,697) * lu(k,894) - lu(k,906) = lu(k,906) - lu(k,698) * lu(k,894) - lu(k,908) = lu(k,908) - lu(k,699) * lu(k,894) - lu(k,909) = lu(k,909) - lu(k,700) * lu(k,894) - lu(k,911) = lu(k,911) - lu(k,701) * lu(k,894) - lu(k,913) = lu(k,913) - lu(k,702) * lu(k,894) - lu(k,914) = lu(k,914) - lu(k,703) * lu(k,894) - lu(k,915) = lu(k,915) - lu(k,704) * lu(k,894) - lu(k,916) = lu(k,916) - lu(k,705) * lu(k,894) - lu(k,919) = lu(k,919) - lu(k,706) * lu(k,894) - lu(k,921) = lu(k,921) - lu(k,707) * lu(k,894) - lu(k,922) = lu(k,922) - lu(k,708) * lu(k,894) - lu(k,937) = lu(k,937) - lu(k,691) * lu(k,936) - lu(k,941) = lu(k,941) - lu(k,692) * lu(k,936) - lu(k,942) = lu(k,942) - lu(k,693) * lu(k,936) - lu(k,943) = lu(k,943) - lu(k,694) * lu(k,936) - lu(k,944) = lu(k,944) - lu(k,695) * lu(k,936) - lu(k,945) = lu(k,945) - lu(k,696) * lu(k,936) - lu(k,946) = lu(k,946) - lu(k,697) * lu(k,936) - lu(k,948) = lu(k,948) - lu(k,698) * lu(k,936) - lu(k,950) = lu(k,950) - lu(k,699) * lu(k,936) - lu(k,951) = lu(k,951) - lu(k,700) * lu(k,936) - lu(k,953) = lu(k,953) - lu(k,701) * lu(k,936) - lu(k,955) = lu(k,955) - lu(k,702) * lu(k,936) - lu(k,956) = lu(k,956) - lu(k,703) * lu(k,936) - lu(k,957) = lu(k,957) - lu(k,704) * lu(k,936) - lu(k,958) = lu(k,958) - lu(k,705) * lu(k,936) - lu(k,961) = lu(k,961) - lu(k,706) * lu(k,936) - lu(k,963) = lu(k,963) - lu(k,707) * lu(k,936) - lu(k,964) = lu(k,964) - lu(k,708) * lu(k,936) - lu(k,983) = lu(k,983) - lu(k,691) * lu(k,982) - lu(k,987) = lu(k,987) - lu(k,692) * lu(k,982) - lu(k,988) = lu(k,988) - lu(k,693) * lu(k,982) - lu(k,989) = lu(k,989) - lu(k,694) * lu(k,982) - lu(k,990) = lu(k,990) - lu(k,695) * lu(k,982) - lu(k,991) = lu(k,991) - lu(k,696) * lu(k,982) - lu(k,992) = lu(k,992) - lu(k,697) * lu(k,982) - lu(k,994) = lu(k,994) - lu(k,698) * lu(k,982) - lu(k,996) = lu(k,996) - lu(k,699) * lu(k,982) - lu(k,997) = lu(k,997) - lu(k,700) * lu(k,982) - lu(k,999) = lu(k,999) - lu(k,701) * lu(k,982) - lu(k,1001) = lu(k,1001) - lu(k,702) * lu(k,982) - lu(k,1002) = lu(k,1002) - lu(k,703) * lu(k,982) - lu(k,1003) = lu(k,1003) - lu(k,704) * lu(k,982) - lu(k,1004) = lu(k,1004) - lu(k,705) * lu(k,982) - lu(k,1007) = lu(k,1007) - lu(k,706) * lu(k,982) - lu(k,1009) = lu(k,1009) - lu(k,707) * lu(k,982) - lu(k,1010) = lu(k,1010) - lu(k,708) * lu(k,982) - lu(k,1025) = lu(k,1025) - lu(k,691) * lu(k,1024) - lu(k,1029) = lu(k,1029) - lu(k,692) * lu(k,1024) - lu(k,1030) = lu(k,1030) - lu(k,693) * lu(k,1024) - lu(k,1031) = lu(k,1031) - lu(k,694) * lu(k,1024) - lu(k,1032) = lu(k,1032) - lu(k,695) * lu(k,1024) - lu(k,1033) = lu(k,1033) - lu(k,696) * lu(k,1024) - lu(k,1034) = lu(k,1034) - lu(k,697) * lu(k,1024) - lu(k,1036) = lu(k,1036) - lu(k,698) * lu(k,1024) - lu(k,1038) = lu(k,1038) - lu(k,699) * lu(k,1024) - lu(k,1039) = lu(k,1039) - lu(k,700) * lu(k,1024) - lu(k,1041) = lu(k,1041) - lu(k,701) * lu(k,1024) - lu(k,1043) = lu(k,1043) - lu(k,702) * lu(k,1024) - lu(k,1044) = lu(k,1044) - lu(k,703) * lu(k,1024) - lu(k,1045) = lu(k,1045) - lu(k,704) * lu(k,1024) - lu(k,1046) = lu(k,1046) - lu(k,705) * lu(k,1024) - lu(k,1049) = lu(k,1049) - lu(k,706) * lu(k,1024) - lu(k,1051) = lu(k,1051) - lu(k,707) * lu(k,1024) - lu(k,1052) = lu(k,1052) - lu(k,708) * lu(k,1024) - lu(k,1066) = lu(k,1066) - lu(k,691) * lu(k,1065) - lu(k,1070) = lu(k,1070) - lu(k,692) * lu(k,1065) - lu(k,1071) = lu(k,1071) - lu(k,693) * lu(k,1065) - lu(k,1072) = lu(k,1072) - lu(k,694) * lu(k,1065) - lu(k,1073) = lu(k,1073) - lu(k,695) * lu(k,1065) - lu(k,1074) = lu(k,1074) - lu(k,696) * lu(k,1065) - lu(k,1075) = lu(k,1075) - lu(k,697) * lu(k,1065) - lu(k,1077) = lu(k,1077) - lu(k,698) * lu(k,1065) - lu(k,1079) = lu(k,1079) - lu(k,699) * lu(k,1065) - lu(k,1080) = lu(k,1080) - lu(k,700) * lu(k,1065) - lu(k,1082) = lu(k,1082) - lu(k,701) * lu(k,1065) - lu(k,1084) = lu(k,1084) - lu(k,702) * lu(k,1065) - lu(k,1085) = lu(k,1085) - lu(k,703) * lu(k,1065) - lu(k,1086) = lu(k,1086) - lu(k,704) * lu(k,1065) - lu(k,1087) = lu(k,1087) - lu(k,705) * lu(k,1065) - lu(k,1090) = lu(k,1090) - lu(k,706) * lu(k,1065) - lu(k,1092) = lu(k,1092) - lu(k,707) * lu(k,1065) - lu(k,1093) = lu(k,1093) - lu(k,708) * lu(k,1065) - lu(k,1149) = lu(k,1149) - lu(k,691) * lu(k,1148) - lu(k,1153) = lu(k,1153) - lu(k,692) * lu(k,1148) - lu(k,1154) = lu(k,1154) - lu(k,693) * lu(k,1148) - lu(k,1155) = lu(k,1155) - lu(k,694) * lu(k,1148) - lu(k,1156) = lu(k,1156) - lu(k,695) * lu(k,1148) - lu(k,1157) = lu(k,1157) - lu(k,696) * lu(k,1148) - lu(k,1158) = lu(k,1158) - lu(k,697) * lu(k,1148) - lu(k,1160) = lu(k,1160) - lu(k,698) * lu(k,1148) - lu(k,1162) = lu(k,1162) - lu(k,699) * lu(k,1148) - lu(k,1163) = lu(k,1163) - lu(k,700) * lu(k,1148) - lu(k,1165) = lu(k,1165) - lu(k,701) * lu(k,1148) - lu(k,1167) = lu(k,1167) - lu(k,702) * lu(k,1148) - lu(k,1168) = lu(k,1168) - lu(k,703) * lu(k,1148) - lu(k,1169) = lu(k,1169) - lu(k,704) * lu(k,1148) - lu(k,1170) = lu(k,1170) - lu(k,705) * lu(k,1148) - lu(k,1173) = lu(k,1173) - lu(k,706) * lu(k,1148) - lu(k,1175) = lu(k,1175) - lu(k,707) * lu(k,1148) - lu(k,1176) = lu(k,1176) - lu(k,708) * lu(k,1148) - lu(k,1190) = lu(k,1190) - lu(k,691) * lu(k,1189) - lu(k,1194) = lu(k,1194) - lu(k,692) * lu(k,1189) - lu(k,1195) = lu(k,1195) - lu(k,693) * lu(k,1189) - lu(k,1196) = lu(k,1196) - lu(k,694) * lu(k,1189) - lu(k,1197) = lu(k,1197) - lu(k,695) * lu(k,1189) - lu(k,1198) = lu(k,1198) - lu(k,696) * lu(k,1189) - lu(k,1199) = lu(k,1199) - lu(k,697) * lu(k,1189) - lu(k,1201) = lu(k,1201) - lu(k,698) * lu(k,1189) - lu(k,1203) = lu(k,1203) - lu(k,699) * lu(k,1189) - lu(k,1204) = lu(k,1204) - lu(k,700) * lu(k,1189) - lu(k,1206) = lu(k,1206) - lu(k,701) * lu(k,1189) - lu(k,1208) = lu(k,1208) - lu(k,702) * lu(k,1189) - lu(k,1209) = lu(k,1209) - lu(k,703) * lu(k,1189) - lu(k,1210) = lu(k,1210) - lu(k,704) * lu(k,1189) - lu(k,1211) = lu(k,1211) - lu(k,705) * lu(k,1189) - lu(k,1214) = lu(k,1214) - lu(k,706) * lu(k,1189) - lu(k,1216) = lu(k,1216) - lu(k,707) * lu(k,1189) - lu(k,1217) = lu(k,1217) - lu(k,708) * lu(k,1189) - lu(k,1239) = lu(k,1239) - lu(k,691) * lu(k,1238) - lu(k,1243) = lu(k,1243) - lu(k,692) * lu(k,1238) - lu(k,1244) = lu(k,1244) - lu(k,693) * lu(k,1238) - lu(k,1245) = lu(k,1245) - lu(k,694) * lu(k,1238) - lu(k,1246) = lu(k,1246) - lu(k,695) * lu(k,1238) - lu(k,1247) = lu(k,1247) - lu(k,696) * lu(k,1238) - lu(k,1248) = lu(k,1248) - lu(k,697) * lu(k,1238) - lu(k,1250) = lu(k,1250) - lu(k,698) * lu(k,1238) - lu(k,1252) = lu(k,1252) - lu(k,699) * lu(k,1238) - lu(k,1253) = lu(k,1253) - lu(k,700) * lu(k,1238) - lu(k,1255) = lu(k,1255) - lu(k,701) * lu(k,1238) - lu(k,1257) = lu(k,1257) - lu(k,702) * lu(k,1238) - lu(k,1258) = lu(k,1258) - lu(k,703) * lu(k,1238) - lu(k,1259) = lu(k,1259) - lu(k,704) * lu(k,1238) - lu(k,1260) = lu(k,1260) - lu(k,705) * lu(k,1238) - lu(k,1263) = lu(k,1263) - lu(k,706) * lu(k,1238) - lu(k,1265) = lu(k,1265) - lu(k,707) * lu(k,1238) - lu(k,1266) = lu(k,1266) - lu(k,708) * lu(k,1238) - lu(k,1278) = lu(k,1278) - lu(k,691) * lu(k,1277) - lu(k,1282) = lu(k,1282) - lu(k,692) * lu(k,1277) - lu(k,1283) = lu(k,1283) - lu(k,693) * lu(k,1277) - lu(k,1284) = lu(k,1284) - lu(k,694) * lu(k,1277) - lu(k,1285) = lu(k,1285) - lu(k,695) * lu(k,1277) - lu(k,1286) = lu(k,1286) - lu(k,696) * lu(k,1277) - lu(k,1287) = lu(k,1287) - lu(k,697) * lu(k,1277) - lu(k,1289) = lu(k,1289) - lu(k,698) * lu(k,1277) - lu(k,1291) = lu(k,1291) - lu(k,699) * lu(k,1277) - lu(k,1292) = lu(k,1292) - lu(k,700) * lu(k,1277) - lu(k,1294) = lu(k,1294) - lu(k,701) * lu(k,1277) - lu(k,1296) = lu(k,1296) - lu(k,702) * lu(k,1277) - lu(k,1297) = lu(k,1297) - lu(k,703) * lu(k,1277) - lu(k,1298) = lu(k,1298) - lu(k,704) * lu(k,1277) - lu(k,1299) = lu(k,1299) - lu(k,705) * lu(k,1277) - lu(k,1302) = lu(k,1302) - lu(k,706) * lu(k,1277) - lu(k,1304) = lu(k,1304) - lu(k,707) * lu(k,1277) - lu(k,1305) = lu(k,1305) - lu(k,708) * lu(k,1277) - lu(k,1313) = lu(k,1313) - lu(k,691) * lu(k,1312) - lu(k,1317) = lu(k,1317) - lu(k,692) * lu(k,1312) - lu(k,1318) = lu(k,1318) - lu(k,693) * lu(k,1312) - lu(k,1319) = lu(k,1319) - lu(k,694) * lu(k,1312) - lu(k,1320) = lu(k,1320) - lu(k,695) * lu(k,1312) - lu(k,1321) = lu(k,1321) - lu(k,696) * lu(k,1312) - lu(k,1322) = lu(k,1322) - lu(k,697) * lu(k,1312) - lu(k,1324) = lu(k,1324) - lu(k,698) * lu(k,1312) - lu(k,1326) = lu(k,1326) - lu(k,699) * lu(k,1312) - lu(k,1327) = lu(k,1327) - lu(k,700) * lu(k,1312) - lu(k,1329) = lu(k,1329) - lu(k,701) * lu(k,1312) - lu(k,1331) = lu(k,1331) - lu(k,702) * lu(k,1312) - lu(k,1332) = lu(k,1332) - lu(k,703) * lu(k,1312) - lu(k,1333) = lu(k,1333) - lu(k,704) * lu(k,1312) - lu(k,1334) = lu(k,1334) - lu(k,705) * lu(k,1312) - lu(k,1337) = lu(k,1337) - lu(k,706) * lu(k,1312) - lu(k,1339) = lu(k,1339) - lu(k,707) * lu(k,1312) - lu(k,1340) = lu(k,1340) - lu(k,708) * lu(k,1312) - lu(k,1357) = lu(k,1357) - lu(k,691) * lu(k,1356) - lu(k,1361) = lu(k,1361) - lu(k,692) * lu(k,1356) - lu(k,1362) = lu(k,1362) - lu(k,693) * lu(k,1356) - lu(k,1363) = lu(k,1363) - lu(k,694) * lu(k,1356) - lu(k,1364) = lu(k,1364) - lu(k,695) * lu(k,1356) - lu(k,1365) = lu(k,1365) - lu(k,696) * lu(k,1356) - lu(k,1366) = lu(k,1366) - lu(k,697) * lu(k,1356) - lu(k,1368) = lu(k,1368) - lu(k,698) * lu(k,1356) - lu(k,1370) = lu(k,1370) - lu(k,699) * lu(k,1356) - lu(k,1371) = lu(k,1371) - lu(k,700) * lu(k,1356) - lu(k,1373) = lu(k,1373) - lu(k,701) * lu(k,1356) - lu(k,1375) = lu(k,1375) - lu(k,702) * lu(k,1356) - lu(k,1376) = lu(k,1376) - lu(k,703) * lu(k,1356) - lu(k,1377) = lu(k,1377) - lu(k,704) * lu(k,1356) - lu(k,1378) = lu(k,1378) - lu(k,705) * lu(k,1356) - lu(k,1381) = lu(k,1381) - lu(k,706) * lu(k,1356) - lu(k,1383) = lu(k,1383) - lu(k,707) * lu(k,1356) - lu(k,1384) = lu(k,1384) - lu(k,708) * lu(k,1356) - lu(k,1416) = lu(k,1416) - lu(k,691) * lu(k,1415) - lu(k,1420) = lu(k,1420) - lu(k,692) * lu(k,1415) - lu(k,1421) = lu(k,1421) - lu(k,693) * lu(k,1415) - lu(k,1422) = lu(k,1422) - lu(k,694) * lu(k,1415) - lu(k,1423) = lu(k,1423) - lu(k,695) * lu(k,1415) - lu(k,1424) = lu(k,1424) - lu(k,696) * lu(k,1415) - lu(k,1425) = lu(k,1425) - lu(k,697) * lu(k,1415) - lu(k,1427) = lu(k,1427) - lu(k,698) * lu(k,1415) - lu(k,1429) = lu(k,1429) - lu(k,699) * lu(k,1415) - lu(k,1430) = lu(k,1430) - lu(k,700) * lu(k,1415) - lu(k,1432) = lu(k,1432) - lu(k,701) * lu(k,1415) - lu(k,1434) = lu(k,1434) - lu(k,702) * lu(k,1415) - lu(k,1435) = lu(k,1435) - lu(k,703) * lu(k,1415) - lu(k,1436) = lu(k,1436) - lu(k,704) * lu(k,1415) - lu(k,1437) = lu(k,1437) - lu(k,705) * lu(k,1415) - lu(k,1440) = lu(k,1440) - lu(k,706) * lu(k,1415) - lu(k,1442) = lu(k,1442) - lu(k,707) * lu(k,1415) - lu(k,1443) = lu(k,1443) - lu(k,708) * lu(k,1415) - lu(k,1458) = lu(k,1458) - lu(k,691) * lu(k,1457) - lu(k,1462) = lu(k,1462) - lu(k,692) * lu(k,1457) - lu(k,1463) = lu(k,1463) - lu(k,693) * lu(k,1457) - lu(k,1464) = lu(k,1464) - lu(k,694) * lu(k,1457) - lu(k,1465) = lu(k,1465) - lu(k,695) * lu(k,1457) - lu(k,1466) = lu(k,1466) - lu(k,696) * lu(k,1457) - lu(k,1467) = lu(k,1467) - lu(k,697) * lu(k,1457) - lu(k,1469) = lu(k,1469) - lu(k,698) * lu(k,1457) - lu(k,1471) = lu(k,1471) - lu(k,699) * lu(k,1457) - lu(k,1472) = lu(k,1472) - lu(k,700) * lu(k,1457) - lu(k,1474) = lu(k,1474) - lu(k,701) * lu(k,1457) - lu(k,1476) = lu(k,1476) - lu(k,702) * lu(k,1457) - lu(k,1477) = lu(k,1477) - lu(k,703) * lu(k,1457) - lu(k,1478) = lu(k,1478) - lu(k,704) * lu(k,1457) - lu(k,1479) = lu(k,1479) - lu(k,705) * lu(k,1457) - lu(k,1482) = lu(k,1482) - lu(k,706) * lu(k,1457) - lu(k,1484) = lu(k,1484) - lu(k,707) * lu(k,1457) - lu(k,1485) = lu(k,1485) - lu(k,708) * lu(k,1457) - lu(k,1499) = lu(k,1499) - lu(k,691) * lu(k,1498) - lu(k,1503) = lu(k,1503) - lu(k,692) * lu(k,1498) - lu(k,1504) = lu(k,1504) - lu(k,693) * lu(k,1498) - lu(k,1505) = lu(k,1505) - lu(k,694) * lu(k,1498) - lu(k,1506) = lu(k,1506) - lu(k,695) * lu(k,1498) - lu(k,1507) = lu(k,1507) - lu(k,696) * lu(k,1498) - lu(k,1508) = lu(k,1508) - lu(k,697) * lu(k,1498) - lu(k,1510) = lu(k,1510) - lu(k,698) * lu(k,1498) - lu(k,1512) = lu(k,1512) - lu(k,699) * lu(k,1498) - lu(k,1513) = lu(k,1513) - lu(k,700) * lu(k,1498) - lu(k,1515) = lu(k,1515) - lu(k,701) * lu(k,1498) - lu(k,1517) = lu(k,1517) - lu(k,702) * lu(k,1498) - lu(k,1518) = lu(k,1518) - lu(k,703) * lu(k,1498) - lu(k,1519) = lu(k,1519) - lu(k,704) * lu(k,1498) - lu(k,1520) = lu(k,1520) - lu(k,705) * lu(k,1498) - lu(k,1523) = lu(k,1523) - lu(k,706) * lu(k,1498) - lu(k,1525) = lu(k,1525) - lu(k,707) * lu(k,1498) - lu(k,1526) = lu(k,1526) - lu(k,708) * lu(k,1498) - lu(k,1583) = lu(k,1583) - lu(k,691) * lu(k,1582) - lu(k,1587) = lu(k,1587) - lu(k,692) * lu(k,1582) - lu(k,1588) = lu(k,1588) - lu(k,693) * lu(k,1582) - lu(k,1589) = lu(k,1589) - lu(k,694) * lu(k,1582) - lu(k,1590) = lu(k,1590) - lu(k,695) * lu(k,1582) - lu(k,1591) = lu(k,1591) - lu(k,696) * lu(k,1582) - lu(k,1592) = lu(k,1592) - lu(k,697) * lu(k,1582) - lu(k,1594) = lu(k,1594) - lu(k,698) * lu(k,1582) - lu(k,1596) = lu(k,1596) - lu(k,699) * lu(k,1582) - lu(k,1597) = lu(k,1597) - lu(k,700) * lu(k,1582) - lu(k,1599) = lu(k,1599) - lu(k,701) * lu(k,1582) - lu(k,1601) = lu(k,1601) - lu(k,702) * lu(k,1582) - lu(k,1602) = lu(k,1602) - lu(k,703) * lu(k,1582) - lu(k,1603) = lu(k,1603) - lu(k,704) * lu(k,1582) - lu(k,1604) = lu(k,1604) - lu(k,705) * lu(k,1582) - lu(k,1607) = lu(k,1607) - lu(k,706) * lu(k,1582) - lu(k,1609) = lu(k,1609) - lu(k,707) * lu(k,1582) - lu(k,1610) = lu(k,1610) - lu(k,708) * lu(k,1582) - lu(k,1615) = lu(k,1615) - lu(k,691) * lu(k,1614) - lu(k,1619) = lu(k,1619) - lu(k,692) * lu(k,1614) - lu(k,1620) = lu(k,1620) - lu(k,693) * lu(k,1614) - lu(k,1621) = lu(k,1621) - lu(k,694) * lu(k,1614) - lu(k,1622) = lu(k,1622) - lu(k,695) * lu(k,1614) - lu(k,1623) = lu(k,1623) - lu(k,696) * lu(k,1614) - lu(k,1624) = lu(k,1624) - lu(k,697) * lu(k,1614) - lu(k,1626) = lu(k,1626) - lu(k,698) * lu(k,1614) - lu(k,1628) = lu(k,1628) - lu(k,699) * lu(k,1614) - lu(k,1629) = - lu(k,700) * lu(k,1614) - lu(k,1631) = lu(k,1631) - lu(k,701) * lu(k,1614) - lu(k,1633) = lu(k,1633) - lu(k,702) * lu(k,1614) - lu(k,1634) = lu(k,1634) - lu(k,703) * lu(k,1614) - lu(k,1635) = lu(k,1635) - lu(k,704) * lu(k,1614) - lu(k,1636) = lu(k,1636) - lu(k,705) * lu(k,1614) - lu(k,1639) = lu(k,1639) - lu(k,706) * lu(k,1614) - lu(k,1641) = lu(k,1641) - lu(k,707) * lu(k,1614) - lu(k,1642) = lu(k,1642) - lu(k,708) * lu(k,1614) - lu(k,1650) = lu(k,1650) - lu(k,691) * lu(k,1649) - lu(k,1654) = lu(k,1654) - lu(k,692) * lu(k,1649) - lu(k,1655) = - lu(k,693) * lu(k,1649) - lu(k,1656) = - lu(k,694) * lu(k,1649) - lu(k,1657) = lu(k,1657) - lu(k,695) * lu(k,1649) - lu(k,1658) = lu(k,1658) - lu(k,696) * lu(k,1649) - lu(k,1659) = - lu(k,697) * lu(k,1649) - lu(k,1661) = lu(k,1661) - lu(k,698) * lu(k,1649) - lu(k,1663) = lu(k,1663) - lu(k,699) * lu(k,1649) - lu(k,1664) = lu(k,1664) - lu(k,700) * lu(k,1649) - lu(k,1666) = lu(k,1666) - lu(k,701) * lu(k,1649) - lu(k,1668) = lu(k,1668) - lu(k,702) * lu(k,1649) - lu(k,1669) = lu(k,1669) - lu(k,703) * lu(k,1649) - lu(k,1670) = lu(k,1670) - lu(k,704) * lu(k,1649) - lu(k,1671) = - lu(k,705) * lu(k,1649) - lu(k,1674) = - lu(k,706) * lu(k,1649) - lu(k,1676) = lu(k,1676) - lu(k,707) * lu(k,1649) - lu(k,1677) = lu(k,1677) - lu(k,708) * lu(k,1649) - lu(k,1692) = lu(k,1692) - lu(k,691) * lu(k,1691) - lu(k,1696) = lu(k,1696) - lu(k,692) * lu(k,1691) - lu(k,1697) = lu(k,1697) - lu(k,693) * lu(k,1691) - lu(k,1698) = lu(k,1698) - lu(k,694) * lu(k,1691) - lu(k,1699) = lu(k,1699) - lu(k,695) * lu(k,1691) - lu(k,1700) = lu(k,1700) - lu(k,696) * lu(k,1691) - lu(k,1701) = lu(k,1701) - lu(k,697) * lu(k,1691) - lu(k,1703) = lu(k,1703) - lu(k,698) * lu(k,1691) - lu(k,1705) = lu(k,1705) - lu(k,699) * lu(k,1691) - lu(k,1706) = lu(k,1706) - lu(k,700) * lu(k,1691) - lu(k,1708) = lu(k,1708) - lu(k,701) * lu(k,1691) - lu(k,1710) = lu(k,1710) - lu(k,702) * lu(k,1691) - lu(k,1711) = lu(k,1711) - lu(k,703) * lu(k,1691) - lu(k,1712) = lu(k,1712) - lu(k,704) * lu(k,1691) - lu(k,1713) = lu(k,1713) - lu(k,705) * lu(k,1691) - lu(k,1716) = lu(k,1716) - lu(k,706) * lu(k,1691) - lu(k,1718) = lu(k,1718) - lu(k,707) * lu(k,1691) - lu(k,1719) = lu(k,1719) - lu(k,708) * lu(k,1691) - lu(k,1736) = lu(k,1736) - lu(k,691) * lu(k,1735) - lu(k,1740) = lu(k,1740) - lu(k,692) * lu(k,1735) - lu(k,1741) = lu(k,1741) - lu(k,693) * lu(k,1735) - lu(k,1742) = lu(k,1742) - lu(k,694) * lu(k,1735) - lu(k,1743) = lu(k,1743) - lu(k,695) * lu(k,1735) - lu(k,1744) = lu(k,1744) - lu(k,696) * lu(k,1735) - lu(k,1745) = lu(k,1745) - lu(k,697) * lu(k,1735) - lu(k,1747) = lu(k,1747) - lu(k,698) * lu(k,1735) - lu(k,1749) = lu(k,1749) - lu(k,699) * lu(k,1735) - lu(k,1750) = lu(k,1750) - lu(k,700) * lu(k,1735) - lu(k,1752) = lu(k,1752) - lu(k,701) * lu(k,1735) - lu(k,1754) = lu(k,1754) - lu(k,702) * lu(k,1735) - lu(k,1755) = lu(k,1755) - lu(k,703) * lu(k,1735) - lu(k,1756) = lu(k,1756) - lu(k,704) * lu(k,1735) - lu(k,1757) = lu(k,1757) - lu(k,705) * lu(k,1735) - lu(k,1760) = lu(k,1760) - lu(k,706) * lu(k,1735) - lu(k,1762) = lu(k,1762) - lu(k,707) * lu(k,1735) - lu(k,1763) = lu(k,1763) - lu(k,708) * lu(k,1735) - lu(k,1771) = lu(k,1771) - lu(k,691) * lu(k,1770) - lu(k,1775) = lu(k,1775) - lu(k,692) * lu(k,1770) - lu(k,1776) = lu(k,1776) - lu(k,693) * lu(k,1770) - lu(k,1777) = lu(k,1777) - lu(k,694) * lu(k,1770) - lu(k,1778) = lu(k,1778) - lu(k,695) * lu(k,1770) - lu(k,1779) = lu(k,1779) - lu(k,696) * lu(k,1770) - lu(k,1780) = lu(k,1780) - lu(k,697) * lu(k,1770) - lu(k,1782) = lu(k,1782) - lu(k,698) * lu(k,1770) - lu(k,1784) = lu(k,1784) - lu(k,699) * lu(k,1770) - lu(k,1785) = lu(k,1785) - lu(k,700) * lu(k,1770) - lu(k,1787) = lu(k,1787) - lu(k,701) * lu(k,1770) - lu(k,1789) = lu(k,1789) - lu(k,702) * lu(k,1770) - lu(k,1790) = lu(k,1790) - lu(k,703) * lu(k,1770) - lu(k,1791) = lu(k,1791) - lu(k,704) * lu(k,1770) - lu(k,1792) = lu(k,1792) - lu(k,705) * lu(k,1770) - lu(k,1795) = lu(k,1795) - lu(k,706) * lu(k,1770) - lu(k,1797) = lu(k,1797) - lu(k,707) * lu(k,1770) - lu(k,1798) = lu(k,1798) - lu(k,708) * lu(k,1770) - lu(k,1829) = lu(k,1829) - lu(k,691) * lu(k,1828) - lu(k,1833) = lu(k,1833) - lu(k,692) * lu(k,1828) - lu(k,1834) = lu(k,1834) - lu(k,693) * lu(k,1828) - lu(k,1835) = lu(k,1835) - lu(k,694) * lu(k,1828) - lu(k,1836) = lu(k,1836) - lu(k,695) * lu(k,1828) - lu(k,1837) = lu(k,1837) - lu(k,696) * lu(k,1828) - lu(k,1838) = lu(k,1838) - lu(k,697) * lu(k,1828) - lu(k,1840) = lu(k,1840) - lu(k,698) * lu(k,1828) - lu(k,1842) = lu(k,1842) - lu(k,699) * lu(k,1828) - lu(k,1843) = lu(k,1843) - lu(k,700) * lu(k,1828) - lu(k,1845) = lu(k,1845) - lu(k,701) * lu(k,1828) - lu(k,1847) = lu(k,1847) - lu(k,702) * lu(k,1828) - lu(k,1848) = lu(k,1848) - lu(k,703) * lu(k,1828) - lu(k,1849) = lu(k,1849) - lu(k,704) * lu(k,1828) - lu(k,1850) = lu(k,1850) - lu(k,705) * lu(k,1828) - lu(k,1853) = lu(k,1853) - lu(k,706) * lu(k,1828) - lu(k,1855) = lu(k,1855) - lu(k,707) * lu(k,1828) - lu(k,1856) = lu(k,1856) - lu(k,708) * lu(k,1828) - lu(k,713) = 1._r8 / lu(k,713) - lu(k,714) = lu(k,714) * lu(k,713) - lu(k,715) = lu(k,715) * lu(k,713) - lu(k,716) = lu(k,716) * lu(k,713) - lu(k,717) = lu(k,717) * lu(k,713) - lu(k,718) = lu(k,718) * lu(k,713) - lu(k,719) = lu(k,719) * lu(k,713) - lu(k,720) = lu(k,720) * lu(k,713) - lu(k,721) = lu(k,721) * lu(k,713) - lu(k,722) = lu(k,722) * lu(k,713) - lu(k,723) = lu(k,723) * lu(k,713) - lu(k,724) = lu(k,724) * lu(k,713) - lu(k,725) = lu(k,725) * lu(k,713) - lu(k,726) = lu(k,726) * lu(k,713) - lu(k,727) = lu(k,727) * lu(k,713) - lu(k,728) = lu(k,728) * lu(k,713) - lu(k,729) = lu(k,729) * lu(k,713) - lu(k,730) = lu(k,730) * lu(k,713) - lu(k,731) = lu(k,731) * lu(k,713) - lu(k,732) = lu(k,732) * lu(k,713) - lu(k,733) = lu(k,733) * lu(k,713) - lu(k,823) = lu(k,823) - lu(k,714) * lu(k,820) - lu(k,824) = lu(k,824) - lu(k,715) * lu(k,820) - lu(k,825) = lu(k,825) - lu(k,716) * lu(k,820) - lu(k,826) = lu(k,826) - lu(k,717) * lu(k,820) - lu(k,827) = lu(k,827) - lu(k,718) * lu(k,820) - lu(k,828) = lu(k,828) - lu(k,719) * lu(k,820) - lu(k,829) = lu(k,829) - lu(k,720) * lu(k,820) - lu(k,830) = lu(k,830) - lu(k,721) * lu(k,820) - lu(k,831) = lu(k,831) - lu(k,722) * lu(k,820) - lu(k,832) = lu(k,832) - lu(k,723) * lu(k,820) - lu(k,833) = lu(k,833) - lu(k,724) * lu(k,820) - lu(k,835) = lu(k,835) - lu(k,725) * lu(k,820) - lu(k,836) = lu(k,836) - lu(k,726) * lu(k,820) - lu(k,837) = lu(k,837) - lu(k,727) * lu(k,820) - lu(k,838) = lu(k,838) - lu(k,728) * lu(k,820) - lu(k,839) = lu(k,839) - lu(k,729) * lu(k,820) - lu(k,840) = lu(k,840) - lu(k,730) * lu(k,820) - lu(k,843) = lu(k,843) - lu(k,731) * lu(k,820) - lu(k,845) = lu(k,845) - lu(k,732) * lu(k,820) - lu(k,846) = lu(k,846) - lu(k,733) * lu(k,820) - lu(k,852) = lu(k,852) - lu(k,714) * lu(k,850) - lu(k,853) = lu(k,853) - lu(k,715) * lu(k,850) - lu(k,854) = lu(k,854) - lu(k,716) * lu(k,850) - lu(k,855) = lu(k,855) - lu(k,717) * lu(k,850) - lu(k,856) = lu(k,856) - lu(k,718) * lu(k,850) - lu(k,857) = lu(k,857) - lu(k,719) * lu(k,850) - lu(k,858) = lu(k,858) - lu(k,720) * lu(k,850) - lu(k,859) = lu(k,859) - lu(k,721) * lu(k,850) - lu(k,860) = lu(k,860) - lu(k,722) * lu(k,850) - lu(k,861) = lu(k,861) - lu(k,723) * lu(k,850) - lu(k,862) = lu(k,862) - lu(k,724) * lu(k,850) - lu(k,864) = lu(k,864) - lu(k,725) * lu(k,850) - lu(k,865) = - lu(k,726) * lu(k,850) - lu(k,866) = lu(k,866) - lu(k,727) * lu(k,850) - lu(k,867) = lu(k,867) - lu(k,728) * lu(k,850) - lu(k,868) = lu(k,868) - lu(k,729) * lu(k,850) - lu(k,869) = lu(k,869) - lu(k,730) * lu(k,850) - lu(k,872) = lu(k,872) - lu(k,731) * lu(k,850) - lu(k,874) = lu(k,874) - lu(k,732) * lu(k,850) - lu(k,875) = lu(k,875) - lu(k,733) * lu(k,850) - lu(k,899) = lu(k,899) - lu(k,714) * lu(k,895) - lu(k,900) = lu(k,900) - lu(k,715) * lu(k,895) - lu(k,901) = lu(k,901) - lu(k,716) * lu(k,895) - lu(k,902) = lu(k,902) - lu(k,717) * lu(k,895) - lu(k,903) = lu(k,903) - lu(k,718) * lu(k,895) - lu(k,904) = lu(k,904) - lu(k,719) * lu(k,895) - lu(k,905) = lu(k,905) - lu(k,720) * lu(k,895) - lu(k,906) = lu(k,906) - lu(k,721) * lu(k,895) - lu(k,907) = lu(k,907) - lu(k,722) * lu(k,895) - lu(k,908) = lu(k,908) - lu(k,723) * lu(k,895) - lu(k,909) = lu(k,909) - lu(k,724) * lu(k,895) - lu(k,911) = lu(k,911) - lu(k,725) * lu(k,895) - lu(k,912) = lu(k,912) - lu(k,726) * lu(k,895) - lu(k,913) = lu(k,913) - lu(k,727) * lu(k,895) - lu(k,914) = lu(k,914) - lu(k,728) * lu(k,895) - lu(k,915) = lu(k,915) - lu(k,729) * lu(k,895) - lu(k,916) = lu(k,916) - lu(k,730) * lu(k,895) - lu(k,919) = lu(k,919) - lu(k,731) * lu(k,895) - lu(k,921) = lu(k,921) - lu(k,732) * lu(k,895) - lu(k,922) = lu(k,922) - lu(k,733) * lu(k,895) - lu(k,941) = lu(k,941) - lu(k,714) * lu(k,937) - lu(k,942) = lu(k,942) - lu(k,715) * lu(k,937) - lu(k,943) = lu(k,943) - lu(k,716) * lu(k,937) - lu(k,944) = lu(k,944) - lu(k,717) * lu(k,937) - lu(k,945) = lu(k,945) - lu(k,718) * lu(k,937) - lu(k,946) = lu(k,946) - lu(k,719) * lu(k,937) - lu(k,947) = lu(k,947) - lu(k,720) * lu(k,937) - lu(k,948) = lu(k,948) - lu(k,721) * lu(k,937) - lu(k,949) = lu(k,949) - lu(k,722) * lu(k,937) - lu(k,950) = lu(k,950) - lu(k,723) * lu(k,937) - lu(k,951) = lu(k,951) - lu(k,724) * lu(k,937) - lu(k,953) = lu(k,953) - lu(k,725) * lu(k,937) - lu(k,954) = lu(k,954) - lu(k,726) * lu(k,937) - lu(k,955) = lu(k,955) - lu(k,727) * lu(k,937) - lu(k,956) = lu(k,956) - lu(k,728) * lu(k,937) - lu(k,957) = lu(k,957) - lu(k,729) * lu(k,937) - lu(k,958) = lu(k,958) - lu(k,730) * lu(k,937) - lu(k,961) = lu(k,961) - lu(k,731) * lu(k,937) - lu(k,963) = lu(k,963) - lu(k,732) * lu(k,937) - lu(k,964) = lu(k,964) - lu(k,733) * lu(k,937) - lu(k,987) = lu(k,987) - lu(k,714) * lu(k,983) - lu(k,988) = lu(k,988) - lu(k,715) * lu(k,983) - lu(k,989) = lu(k,989) - lu(k,716) * lu(k,983) - lu(k,990) = lu(k,990) - lu(k,717) * lu(k,983) - lu(k,991) = lu(k,991) - lu(k,718) * lu(k,983) - lu(k,992) = lu(k,992) - lu(k,719) * lu(k,983) - lu(k,993) = lu(k,993) - lu(k,720) * lu(k,983) - lu(k,994) = lu(k,994) - lu(k,721) * lu(k,983) - lu(k,995) = lu(k,995) - lu(k,722) * lu(k,983) - lu(k,996) = lu(k,996) - lu(k,723) * lu(k,983) - lu(k,997) = lu(k,997) - lu(k,724) * lu(k,983) - lu(k,999) = lu(k,999) - lu(k,725) * lu(k,983) - lu(k,1000) = lu(k,1000) - lu(k,726) * lu(k,983) - lu(k,1001) = lu(k,1001) - lu(k,727) * lu(k,983) - lu(k,1002) = lu(k,1002) - lu(k,728) * lu(k,983) - lu(k,1003) = lu(k,1003) - lu(k,729) * lu(k,983) - lu(k,1004) = lu(k,1004) - lu(k,730) * lu(k,983) - lu(k,1007) = lu(k,1007) - lu(k,731) * lu(k,983) - lu(k,1009) = lu(k,1009) - lu(k,732) * lu(k,983) - lu(k,1010) = lu(k,1010) - lu(k,733) * lu(k,983) - lu(k,1029) = lu(k,1029) - lu(k,714) * lu(k,1025) - lu(k,1030) = lu(k,1030) - lu(k,715) * lu(k,1025) - lu(k,1031) = lu(k,1031) - lu(k,716) * lu(k,1025) - lu(k,1032) = lu(k,1032) - lu(k,717) * lu(k,1025) - lu(k,1033) = lu(k,1033) - lu(k,718) * lu(k,1025) - lu(k,1034) = lu(k,1034) - lu(k,719) * lu(k,1025) - lu(k,1035) = lu(k,1035) - lu(k,720) * lu(k,1025) - lu(k,1036) = lu(k,1036) - lu(k,721) * lu(k,1025) - lu(k,1037) = lu(k,1037) - lu(k,722) * lu(k,1025) - lu(k,1038) = lu(k,1038) - lu(k,723) * lu(k,1025) - lu(k,1039) = lu(k,1039) - lu(k,724) * lu(k,1025) - lu(k,1041) = lu(k,1041) - lu(k,725) * lu(k,1025) - lu(k,1042) = lu(k,1042) - lu(k,726) * lu(k,1025) - lu(k,1043) = lu(k,1043) - lu(k,727) * lu(k,1025) - lu(k,1044) = lu(k,1044) - lu(k,728) * lu(k,1025) - lu(k,1045) = lu(k,1045) - lu(k,729) * lu(k,1025) - lu(k,1046) = lu(k,1046) - lu(k,730) * lu(k,1025) - lu(k,1049) = lu(k,1049) - lu(k,731) * lu(k,1025) - lu(k,1051) = lu(k,1051) - lu(k,732) * lu(k,1025) - lu(k,1052) = lu(k,1052) - lu(k,733) * lu(k,1025) - lu(k,1070) = lu(k,1070) - lu(k,714) * lu(k,1066) - lu(k,1071) = lu(k,1071) - lu(k,715) * lu(k,1066) - lu(k,1072) = lu(k,1072) - lu(k,716) * lu(k,1066) - lu(k,1073) = lu(k,1073) - lu(k,717) * lu(k,1066) - lu(k,1074) = lu(k,1074) - lu(k,718) * lu(k,1066) - lu(k,1075) = lu(k,1075) - lu(k,719) * lu(k,1066) - lu(k,1076) = lu(k,1076) - lu(k,720) * lu(k,1066) - lu(k,1077) = lu(k,1077) - lu(k,721) * lu(k,1066) - lu(k,1078) = lu(k,1078) - lu(k,722) * lu(k,1066) - lu(k,1079) = lu(k,1079) - lu(k,723) * lu(k,1066) - lu(k,1080) = lu(k,1080) - lu(k,724) * lu(k,1066) - lu(k,1082) = lu(k,1082) - lu(k,725) * lu(k,1066) - lu(k,1083) = lu(k,1083) - lu(k,726) * lu(k,1066) - lu(k,1084) = lu(k,1084) - lu(k,727) * lu(k,1066) - lu(k,1085) = lu(k,1085) - lu(k,728) * lu(k,1066) - lu(k,1086) = lu(k,1086) - lu(k,729) * lu(k,1066) - lu(k,1087) = lu(k,1087) - lu(k,730) * lu(k,1066) - lu(k,1090) = lu(k,1090) - lu(k,731) * lu(k,1066) - lu(k,1092) = lu(k,1092) - lu(k,732) * lu(k,1066) - lu(k,1093) = lu(k,1093) - lu(k,733) * lu(k,1066) - lu(k,1109) = - lu(k,714) * lu(k,1106) - lu(k,1110) = lu(k,1110) - lu(k,715) * lu(k,1106) - lu(k,1111) = lu(k,1111) - lu(k,716) * lu(k,1106) - lu(k,1112) = lu(k,1112) - lu(k,717) * lu(k,1106) - lu(k,1113) = lu(k,1113) - lu(k,718) * lu(k,1106) - lu(k,1114) = lu(k,1114) - lu(k,719) * lu(k,1106) - lu(k,1115) = lu(k,1115) - lu(k,720) * lu(k,1106) - lu(k,1116) = lu(k,1116) - lu(k,721) * lu(k,1106) - lu(k,1117) = lu(k,1117) - lu(k,722) * lu(k,1106) - lu(k,1118) = lu(k,1118) - lu(k,723) * lu(k,1106) - lu(k,1119) = lu(k,1119) - lu(k,724) * lu(k,1106) - lu(k,1121) = lu(k,1121) - lu(k,725) * lu(k,1106) - lu(k,1122) = lu(k,1122) - lu(k,726) * lu(k,1106) - lu(k,1123) = lu(k,1123) - lu(k,727) * lu(k,1106) - lu(k,1124) = lu(k,1124) - lu(k,728) * lu(k,1106) - lu(k,1125) = lu(k,1125) - lu(k,729) * lu(k,1106) - lu(k,1126) = lu(k,1126) - lu(k,730) * lu(k,1106) - lu(k,1129) = lu(k,1129) - lu(k,731) * lu(k,1106) - lu(k,1131) = lu(k,1131) - lu(k,732) * lu(k,1106) - lu(k,1132) = lu(k,1132) - lu(k,733) * lu(k,1106) - lu(k,1153) = lu(k,1153) - lu(k,714) * lu(k,1149) - lu(k,1154) = lu(k,1154) - lu(k,715) * lu(k,1149) - lu(k,1155) = lu(k,1155) - lu(k,716) * lu(k,1149) - lu(k,1156) = lu(k,1156) - lu(k,717) * lu(k,1149) - lu(k,1157) = lu(k,1157) - lu(k,718) * lu(k,1149) - lu(k,1158) = lu(k,1158) - lu(k,719) * lu(k,1149) - lu(k,1159) = lu(k,1159) - lu(k,720) * lu(k,1149) - lu(k,1160) = lu(k,1160) - lu(k,721) * lu(k,1149) - lu(k,1161) = lu(k,1161) - lu(k,722) * lu(k,1149) - lu(k,1162) = lu(k,1162) - lu(k,723) * lu(k,1149) - lu(k,1163) = lu(k,1163) - lu(k,724) * lu(k,1149) - lu(k,1165) = lu(k,1165) - lu(k,725) * lu(k,1149) - lu(k,1166) = lu(k,1166) - lu(k,726) * lu(k,1149) - lu(k,1167) = lu(k,1167) - lu(k,727) * lu(k,1149) - lu(k,1168) = lu(k,1168) - lu(k,728) * lu(k,1149) - lu(k,1169) = lu(k,1169) - lu(k,729) * lu(k,1149) - lu(k,1170) = lu(k,1170) - lu(k,730) * lu(k,1149) - lu(k,1173) = lu(k,1173) - lu(k,731) * lu(k,1149) - lu(k,1175) = lu(k,1175) - lu(k,732) * lu(k,1149) - lu(k,1176) = lu(k,1176) - lu(k,733) * lu(k,1149) - lu(k,1194) = lu(k,1194) - lu(k,714) * lu(k,1190) - lu(k,1195) = lu(k,1195) - lu(k,715) * lu(k,1190) - lu(k,1196) = lu(k,1196) - lu(k,716) * lu(k,1190) - lu(k,1197) = lu(k,1197) - lu(k,717) * lu(k,1190) - lu(k,1198) = lu(k,1198) - lu(k,718) * lu(k,1190) - lu(k,1199) = lu(k,1199) - lu(k,719) * lu(k,1190) - lu(k,1200) = lu(k,1200) - lu(k,720) * lu(k,1190) - lu(k,1201) = lu(k,1201) - lu(k,721) * lu(k,1190) - lu(k,1202) = lu(k,1202) - lu(k,722) * lu(k,1190) - lu(k,1203) = lu(k,1203) - lu(k,723) * lu(k,1190) - lu(k,1204) = lu(k,1204) - lu(k,724) * lu(k,1190) - lu(k,1206) = lu(k,1206) - lu(k,725) * lu(k,1190) - lu(k,1207) = lu(k,1207) - lu(k,726) * lu(k,1190) - lu(k,1208) = lu(k,1208) - lu(k,727) * lu(k,1190) - lu(k,1209) = lu(k,1209) - lu(k,728) * lu(k,1190) - lu(k,1210) = lu(k,1210) - lu(k,729) * lu(k,1190) - lu(k,1211) = lu(k,1211) - lu(k,730) * lu(k,1190) - lu(k,1214) = lu(k,1214) - lu(k,731) * lu(k,1190) - lu(k,1216) = lu(k,1216) - lu(k,732) * lu(k,1190) - lu(k,1217) = lu(k,1217) - lu(k,733) * lu(k,1190) - lu(k,1243) = lu(k,1243) - lu(k,714) * lu(k,1239) - lu(k,1244) = lu(k,1244) - lu(k,715) * lu(k,1239) - lu(k,1245) = lu(k,1245) - lu(k,716) * lu(k,1239) - lu(k,1246) = lu(k,1246) - lu(k,717) * lu(k,1239) - lu(k,1247) = lu(k,1247) - lu(k,718) * lu(k,1239) - lu(k,1248) = lu(k,1248) - lu(k,719) * lu(k,1239) - lu(k,1249) = lu(k,1249) - lu(k,720) * lu(k,1239) - lu(k,1250) = lu(k,1250) - lu(k,721) * lu(k,1239) - lu(k,1251) = lu(k,1251) - lu(k,722) * lu(k,1239) - lu(k,1252) = lu(k,1252) - lu(k,723) * lu(k,1239) - lu(k,1253) = lu(k,1253) - lu(k,724) * lu(k,1239) - lu(k,1255) = lu(k,1255) - lu(k,725) * lu(k,1239) - lu(k,1256) = lu(k,1256) - lu(k,726) * lu(k,1239) - lu(k,1257) = lu(k,1257) - lu(k,727) * lu(k,1239) - lu(k,1258) = lu(k,1258) - lu(k,728) * lu(k,1239) - lu(k,1259) = lu(k,1259) - lu(k,729) * lu(k,1239) - lu(k,1260) = lu(k,1260) - lu(k,730) * lu(k,1239) - lu(k,1263) = lu(k,1263) - lu(k,731) * lu(k,1239) - lu(k,1265) = lu(k,1265) - lu(k,732) * lu(k,1239) - lu(k,1266) = lu(k,1266) - lu(k,733) * lu(k,1239) - lu(k,1282) = lu(k,1282) - lu(k,714) * lu(k,1278) - lu(k,1283) = lu(k,1283) - lu(k,715) * lu(k,1278) - lu(k,1284) = lu(k,1284) - lu(k,716) * lu(k,1278) - lu(k,1285) = lu(k,1285) - lu(k,717) * lu(k,1278) - lu(k,1286) = lu(k,1286) - lu(k,718) * lu(k,1278) - lu(k,1287) = lu(k,1287) - lu(k,719) * lu(k,1278) - lu(k,1288) = lu(k,1288) - lu(k,720) * lu(k,1278) - lu(k,1289) = lu(k,1289) - lu(k,721) * lu(k,1278) - lu(k,1290) = lu(k,1290) - lu(k,722) * lu(k,1278) - lu(k,1291) = lu(k,1291) - lu(k,723) * lu(k,1278) - lu(k,1292) = lu(k,1292) - lu(k,724) * lu(k,1278) - lu(k,1294) = lu(k,1294) - lu(k,725) * lu(k,1278) - lu(k,1295) = lu(k,1295) - lu(k,726) * lu(k,1278) - lu(k,1296) = lu(k,1296) - lu(k,727) * lu(k,1278) - lu(k,1297) = lu(k,1297) - lu(k,728) * lu(k,1278) - lu(k,1298) = lu(k,1298) - lu(k,729) * lu(k,1278) - lu(k,1299) = lu(k,1299) - lu(k,730) * lu(k,1278) - lu(k,1302) = lu(k,1302) - lu(k,731) * lu(k,1278) - lu(k,1304) = lu(k,1304) - lu(k,732) * lu(k,1278) - lu(k,1305) = lu(k,1305) - lu(k,733) * lu(k,1278) - lu(k,1317) = lu(k,1317) - lu(k,714) * lu(k,1313) - lu(k,1318) = lu(k,1318) - lu(k,715) * lu(k,1313) - lu(k,1319) = lu(k,1319) - lu(k,716) * lu(k,1313) - lu(k,1320) = lu(k,1320) - lu(k,717) * lu(k,1313) - lu(k,1321) = lu(k,1321) - lu(k,718) * lu(k,1313) - lu(k,1322) = lu(k,1322) - lu(k,719) * lu(k,1313) - lu(k,1323) = - lu(k,720) * lu(k,1313) - lu(k,1324) = lu(k,1324) - lu(k,721) * lu(k,1313) - lu(k,1325) = lu(k,1325) - lu(k,722) * lu(k,1313) - lu(k,1326) = lu(k,1326) - lu(k,723) * lu(k,1313) - lu(k,1327) = lu(k,1327) - lu(k,724) * lu(k,1313) - lu(k,1329) = lu(k,1329) - lu(k,725) * lu(k,1313) - lu(k,1330) = lu(k,1330) - lu(k,726) * lu(k,1313) - lu(k,1331) = lu(k,1331) - lu(k,727) * lu(k,1313) - lu(k,1332) = lu(k,1332) - lu(k,728) * lu(k,1313) - lu(k,1333) = lu(k,1333) - lu(k,729) * lu(k,1313) - lu(k,1334) = lu(k,1334) - lu(k,730) * lu(k,1313) - lu(k,1337) = lu(k,1337) - lu(k,731) * lu(k,1313) - lu(k,1339) = lu(k,1339) - lu(k,732) * lu(k,1313) - lu(k,1340) = lu(k,1340) - lu(k,733) * lu(k,1313) - lu(k,1361) = lu(k,1361) - lu(k,714) * lu(k,1357) - lu(k,1362) = lu(k,1362) - lu(k,715) * lu(k,1357) - lu(k,1363) = lu(k,1363) - lu(k,716) * lu(k,1357) - lu(k,1364) = lu(k,1364) - lu(k,717) * lu(k,1357) - lu(k,1365) = lu(k,1365) - lu(k,718) * lu(k,1357) - lu(k,1366) = lu(k,1366) - lu(k,719) * lu(k,1357) - lu(k,1367) = lu(k,1367) - lu(k,720) * lu(k,1357) - lu(k,1368) = lu(k,1368) - lu(k,721) * lu(k,1357) - lu(k,1369) = lu(k,1369) - lu(k,722) * lu(k,1357) - lu(k,1370) = lu(k,1370) - lu(k,723) * lu(k,1357) - lu(k,1371) = lu(k,1371) - lu(k,724) * lu(k,1357) - lu(k,1373) = lu(k,1373) - lu(k,725) * lu(k,1357) - lu(k,1374) = lu(k,1374) - lu(k,726) * lu(k,1357) - lu(k,1375) = lu(k,1375) - lu(k,727) * lu(k,1357) - lu(k,1376) = lu(k,1376) - lu(k,728) * lu(k,1357) - lu(k,1377) = lu(k,1377) - lu(k,729) * lu(k,1357) - lu(k,1378) = lu(k,1378) - lu(k,730) * lu(k,1357) - lu(k,1381) = lu(k,1381) - lu(k,731) * lu(k,1357) - lu(k,1383) = lu(k,1383) - lu(k,732) * lu(k,1357) - lu(k,1384) = lu(k,1384) - lu(k,733) * lu(k,1357) - lu(k,1420) = lu(k,1420) - lu(k,714) * lu(k,1416) - lu(k,1421) = lu(k,1421) - lu(k,715) * lu(k,1416) - lu(k,1422) = lu(k,1422) - lu(k,716) * lu(k,1416) - lu(k,1423) = lu(k,1423) - lu(k,717) * lu(k,1416) - lu(k,1424) = lu(k,1424) - lu(k,718) * lu(k,1416) - lu(k,1425) = lu(k,1425) - lu(k,719) * lu(k,1416) - lu(k,1426) = lu(k,1426) - lu(k,720) * lu(k,1416) - lu(k,1427) = lu(k,1427) - lu(k,721) * lu(k,1416) - lu(k,1428) = lu(k,1428) - lu(k,722) * lu(k,1416) - lu(k,1429) = lu(k,1429) - lu(k,723) * lu(k,1416) - lu(k,1430) = lu(k,1430) - lu(k,724) * lu(k,1416) - lu(k,1432) = lu(k,1432) - lu(k,725) * lu(k,1416) - lu(k,1433) = lu(k,1433) - lu(k,726) * lu(k,1416) - lu(k,1434) = lu(k,1434) - lu(k,727) * lu(k,1416) - lu(k,1435) = lu(k,1435) - lu(k,728) * lu(k,1416) - lu(k,1436) = lu(k,1436) - lu(k,729) * lu(k,1416) - lu(k,1437) = lu(k,1437) - lu(k,730) * lu(k,1416) - lu(k,1440) = lu(k,1440) - lu(k,731) * lu(k,1416) - lu(k,1442) = lu(k,1442) - lu(k,732) * lu(k,1416) - lu(k,1443) = lu(k,1443) - lu(k,733) * lu(k,1416) - lu(k,1462) = lu(k,1462) - lu(k,714) * lu(k,1458) - lu(k,1463) = lu(k,1463) - lu(k,715) * lu(k,1458) - lu(k,1464) = lu(k,1464) - lu(k,716) * lu(k,1458) - lu(k,1465) = lu(k,1465) - lu(k,717) * lu(k,1458) - lu(k,1466) = lu(k,1466) - lu(k,718) * lu(k,1458) - lu(k,1467) = lu(k,1467) - lu(k,719) * lu(k,1458) - lu(k,1468) = lu(k,1468) - lu(k,720) * lu(k,1458) - lu(k,1469) = lu(k,1469) - lu(k,721) * lu(k,1458) - lu(k,1470) = lu(k,1470) - lu(k,722) * lu(k,1458) - lu(k,1471) = lu(k,1471) - lu(k,723) * lu(k,1458) - lu(k,1472) = lu(k,1472) - lu(k,724) * lu(k,1458) - lu(k,1474) = lu(k,1474) - lu(k,725) * lu(k,1458) - lu(k,1475) = lu(k,1475) - lu(k,726) * lu(k,1458) - lu(k,1476) = lu(k,1476) - lu(k,727) * lu(k,1458) - lu(k,1477) = lu(k,1477) - lu(k,728) * lu(k,1458) - lu(k,1478) = lu(k,1478) - lu(k,729) * lu(k,1458) - lu(k,1479) = lu(k,1479) - lu(k,730) * lu(k,1458) - lu(k,1482) = lu(k,1482) - lu(k,731) * lu(k,1458) - lu(k,1484) = lu(k,1484) - lu(k,732) * lu(k,1458) - lu(k,1485) = lu(k,1485) - lu(k,733) * lu(k,1458) - lu(k,1503) = lu(k,1503) - lu(k,714) * lu(k,1499) - lu(k,1504) = lu(k,1504) - lu(k,715) * lu(k,1499) - lu(k,1505) = lu(k,1505) - lu(k,716) * lu(k,1499) - lu(k,1506) = lu(k,1506) - lu(k,717) * lu(k,1499) - lu(k,1507) = lu(k,1507) - lu(k,718) * lu(k,1499) - lu(k,1508) = lu(k,1508) - lu(k,719) * lu(k,1499) - lu(k,1509) = lu(k,1509) - lu(k,720) * lu(k,1499) - lu(k,1510) = lu(k,1510) - lu(k,721) * lu(k,1499) - lu(k,1511) = lu(k,1511) - lu(k,722) * lu(k,1499) - lu(k,1512) = lu(k,1512) - lu(k,723) * lu(k,1499) - lu(k,1513) = lu(k,1513) - lu(k,724) * lu(k,1499) - lu(k,1515) = lu(k,1515) - lu(k,725) * lu(k,1499) - lu(k,1516) = lu(k,1516) - lu(k,726) * lu(k,1499) - lu(k,1517) = lu(k,1517) - lu(k,727) * lu(k,1499) - lu(k,1518) = lu(k,1518) - lu(k,728) * lu(k,1499) - lu(k,1519) = lu(k,1519) - lu(k,729) * lu(k,1499) - lu(k,1520) = lu(k,1520) - lu(k,730) * lu(k,1499) - lu(k,1523) = lu(k,1523) - lu(k,731) * lu(k,1499) - lu(k,1525) = lu(k,1525) - lu(k,732) * lu(k,1499) - lu(k,1526) = lu(k,1526) - lu(k,733) * lu(k,1499) - lu(k,1587) = lu(k,1587) - lu(k,714) * lu(k,1583) - lu(k,1588) = lu(k,1588) - lu(k,715) * lu(k,1583) - lu(k,1589) = lu(k,1589) - lu(k,716) * lu(k,1583) - lu(k,1590) = lu(k,1590) - lu(k,717) * lu(k,1583) - lu(k,1591) = lu(k,1591) - lu(k,718) * lu(k,1583) - lu(k,1592) = lu(k,1592) - lu(k,719) * lu(k,1583) - lu(k,1593) = lu(k,1593) - lu(k,720) * lu(k,1583) - lu(k,1594) = lu(k,1594) - lu(k,721) * lu(k,1583) - lu(k,1595) = lu(k,1595) - lu(k,722) * lu(k,1583) - lu(k,1596) = lu(k,1596) - lu(k,723) * lu(k,1583) - lu(k,1597) = lu(k,1597) - lu(k,724) * lu(k,1583) - lu(k,1599) = lu(k,1599) - lu(k,725) * lu(k,1583) - lu(k,1600) = lu(k,1600) - lu(k,726) * lu(k,1583) - lu(k,1601) = lu(k,1601) - lu(k,727) * lu(k,1583) - lu(k,1602) = lu(k,1602) - lu(k,728) * lu(k,1583) - lu(k,1603) = lu(k,1603) - lu(k,729) * lu(k,1583) - lu(k,1604) = lu(k,1604) - lu(k,730) * lu(k,1583) - lu(k,1607) = lu(k,1607) - lu(k,731) * lu(k,1583) - lu(k,1609) = lu(k,1609) - lu(k,732) * lu(k,1583) - lu(k,1610) = lu(k,1610) - lu(k,733) * lu(k,1583) - lu(k,1619) = lu(k,1619) - lu(k,714) * lu(k,1615) - lu(k,1620) = lu(k,1620) - lu(k,715) * lu(k,1615) - lu(k,1621) = lu(k,1621) - lu(k,716) * lu(k,1615) - lu(k,1622) = lu(k,1622) - lu(k,717) * lu(k,1615) - lu(k,1623) = lu(k,1623) - lu(k,718) * lu(k,1615) - lu(k,1624) = lu(k,1624) - lu(k,719) * lu(k,1615) - lu(k,1625) = - lu(k,720) * lu(k,1615) - lu(k,1626) = lu(k,1626) - lu(k,721) * lu(k,1615) - lu(k,1627) = lu(k,1627) - lu(k,722) * lu(k,1615) - lu(k,1628) = lu(k,1628) - lu(k,723) * lu(k,1615) - lu(k,1629) = lu(k,1629) - lu(k,724) * lu(k,1615) - lu(k,1631) = lu(k,1631) - lu(k,725) * lu(k,1615) - lu(k,1632) = lu(k,1632) - lu(k,726) * lu(k,1615) - lu(k,1633) = lu(k,1633) - lu(k,727) * lu(k,1615) - lu(k,1634) = lu(k,1634) - lu(k,728) * lu(k,1615) - lu(k,1635) = lu(k,1635) - lu(k,729) * lu(k,1615) - lu(k,1636) = lu(k,1636) - lu(k,730) * lu(k,1615) - lu(k,1639) = lu(k,1639) - lu(k,731) * lu(k,1615) - lu(k,1641) = lu(k,1641) - lu(k,732) * lu(k,1615) - lu(k,1642) = lu(k,1642) - lu(k,733) * lu(k,1615) - lu(k,1654) = lu(k,1654) - lu(k,714) * lu(k,1650) - lu(k,1655) = lu(k,1655) - lu(k,715) * lu(k,1650) - lu(k,1656) = lu(k,1656) - lu(k,716) * lu(k,1650) - lu(k,1657) = lu(k,1657) - lu(k,717) * lu(k,1650) - lu(k,1658) = lu(k,1658) - lu(k,718) * lu(k,1650) - lu(k,1659) = lu(k,1659) - lu(k,719) * lu(k,1650) - lu(k,1660) = lu(k,1660) - lu(k,720) * lu(k,1650) - lu(k,1661) = lu(k,1661) - lu(k,721) * lu(k,1650) - lu(k,1662) = lu(k,1662) - lu(k,722) * lu(k,1650) - lu(k,1663) = lu(k,1663) - lu(k,723) * lu(k,1650) - lu(k,1664) = lu(k,1664) - lu(k,724) * lu(k,1650) - lu(k,1666) = lu(k,1666) - lu(k,725) * lu(k,1650) - lu(k,1667) = lu(k,1667) - lu(k,726) * lu(k,1650) - lu(k,1668) = lu(k,1668) - lu(k,727) * lu(k,1650) - lu(k,1669) = lu(k,1669) - lu(k,728) * lu(k,1650) - lu(k,1670) = lu(k,1670) - lu(k,729) * lu(k,1650) - lu(k,1671) = lu(k,1671) - lu(k,730) * lu(k,1650) - lu(k,1674) = lu(k,1674) - lu(k,731) * lu(k,1650) - lu(k,1676) = lu(k,1676) - lu(k,732) * lu(k,1650) - lu(k,1677) = lu(k,1677) - lu(k,733) * lu(k,1650) - lu(k,1696) = lu(k,1696) - lu(k,714) * lu(k,1692) - lu(k,1697) = lu(k,1697) - lu(k,715) * lu(k,1692) - lu(k,1698) = lu(k,1698) - lu(k,716) * lu(k,1692) - lu(k,1699) = lu(k,1699) - lu(k,717) * lu(k,1692) - lu(k,1700) = lu(k,1700) - lu(k,718) * lu(k,1692) - lu(k,1701) = lu(k,1701) - lu(k,719) * lu(k,1692) - lu(k,1702) = lu(k,1702) - lu(k,720) * lu(k,1692) - lu(k,1703) = lu(k,1703) - lu(k,721) * lu(k,1692) - lu(k,1704) = lu(k,1704) - lu(k,722) * lu(k,1692) - lu(k,1705) = lu(k,1705) - lu(k,723) * lu(k,1692) - lu(k,1706) = lu(k,1706) - lu(k,724) * lu(k,1692) - lu(k,1708) = lu(k,1708) - lu(k,725) * lu(k,1692) - lu(k,1709) = lu(k,1709) - lu(k,726) * lu(k,1692) - lu(k,1710) = lu(k,1710) - lu(k,727) * lu(k,1692) - lu(k,1711) = lu(k,1711) - lu(k,728) * lu(k,1692) - lu(k,1712) = lu(k,1712) - lu(k,729) * lu(k,1692) - lu(k,1713) = lu(k,1713) - lu(k,730) * lu(k,1692) - lu(k,1716) = lu(k,1716) - lu(k,731) * lu(k,1692) - lu(k,1718) = lu(k,1718) - lu(k,732) * lu(k,1692) - lu(k,1719) = lu(k,1719) - lu(k,733) * lu(k,1692) - lu(k,1740) = lu(k,1740) - lu(k,714) * lu(k,1736) - lu(k,1741) = lu(k,1741) - lu(k,715) * lu(k,1736) - lu(k,1742) = lu(k,1742) - lu(k,716) * lu(k,1736) - lu(k,1743) = lu(k,1743) - lu(k,717) * lu(k,1736) - lu(k,1744) = lu(k,1744) - lu(k,718) * lu(k,1736) - lu(k,1745) = lu(k,1745) - lu(k,719) * lu(k,1736) - lu(k,1746) = lu(k,1746) - lu(k,720) * lu(k,1736) - lu(k,1747) = lu(k,1747) - lu(k,721) * lu(k,1736) - lu(k,1748) = lu(k,1748) - lu(k,722) * lu(k,1736) - lu(k,1749) = lu(k,1749) - lu(k,723) * lu(k,1736) - lu(k,1750) = lu(k,1750) - lu(k,724) * lu(k,1736) - lu(k,1752) = lu(k,1752) - lu(k,725) * lu(k,1736) - lu(k,1753) = lu(k,1753) - lu(k,726) * lu(k,1736) - lu(k,1754) = lu(k,1754) - lu(k,727) * lu(k,1736) - lu(k,1755) = lu(k,1755) - lu(k,728) * lu(k,1736) - lu(k,1756) = lu(k,1756) - lu(k,729) * lu(k,1736) - lu(k,1757) = lu(k,1757) - lu(k,730) * lu(k,1736) - lu(k,1760) = lu(k,1760) - lu(k,731) * lu(k,1736) - lu(k,1762) = lu(k,1762) - lu(k,732) * lu(k,1736) - lu(k,1763) = lu(k,1763) - lu(k,733) * lu(k,1736) - lu(k,1775) = lu(k,1775) - lu(k,714) * lu(k,1771) - lu(k,1776) = lu(k,1776) - lu(k,715) * lu(k,1771) - lu(k,1777) = lu(k,1777) - lu(k,716) * lu(k,1771) - lu(k,1778) = lu(k,1778) - lu(k,717) * lu(k,1771) - lu(k,1779) = lu(k,1779) - lu(k,718) * lu(k,1771) - lu(k,1780) = lu(k,1780) - lu(k,719) * lu(k,1771) - lu(k,1781) = lu(k,1781) - lu(k,720) * lu(k,1771) - lu(k,1782) = lu(k,1782) - lu(k,721) * lu(k,1771) - lu(k,1783) = lu(k,1783) - lu(k,722) * lu(k,1771) - lu(k,1784) = lu(k,1784) - lu(k,723) * lu(k,1771) - lu(k,1785) = lu(k,1785) - lu(k,724) * lu(k,1771) - lu(k,1787) = lu(k,1787) - lu(k,725) * lu(k,1771) - lu(k,1788) = lu(k,1788) - lu(k,726) * lu(k,1771) - lu(k,1789) = lu(k,1789) - lu(k,727) * lu(k,1771) - lu(k,1790) = lu(k,1790) - lu(k,728) * lu(k,1771) - lu(k,1791) = lu(k,1791) - lu(k,729) * lu(k,1771) - lu(k,1792) = lu(k,1792) - lu(k,730) * lu(k,1771) - lu(k,1795) = lu(k,1795) - lu(k,731) * lu(k,1771) - lu(k,1797) = lu(k,1797) - lu(k,732) * lu(k,1771) - lu(k,1798) = lu(k,1798) - lu(k,733) * lu(k,1771) - lu(k,1833) = lu(k,1833) - lu(k,714) * lu(k,1829) - lu(k,1834) = lu(k,1834) - lu(k,715) * lu(k,1829) - lu(k,1835) = lu(k,1835) - lu(k,716) * lu(k,1829) - lu(k,1836) = lu(k,1836) - lu(k,717) * lu(k,1829) - lu(k,1837) = lu(k,1837) - lu(k,718) * lu(k,1829) - lu(k,1838) = lu(k,1838) - lu(k,719) * lu(k,1829) - lu(k,1839) = lu(k,1839) - lu(k,720) * lu(k,1829) - lu(k,1840) = lu(k,1840) - lu(k,721) * lu(k,1829) - lu(k,1841) = lu(k,1841) - lu(k,722) * lu(k,1829) - lu(k,1842) = lu(k,1842) - lu(k,723) * lu(k,1829) - lu(k,1843) = lu(k,1843) - lu(k,724) * lu(k,1829) - lu(k,1845) = lu(k,1845) - lu(k,725) * lu(k,1829) - lu(k,1846) = lu(k,1846) - lu(k,726) * lu(k,1829) - lu(k,1847) = lu(k,1847) - lu(k,727) * lu(k,1829) - lu(k,1848) = lu(k,1848) - lu(k,728) * lu(k,1829) - lu(k,1849) = lu(k,1849) - lu(k,729) * lu(k,1829) - lu(k,1850) = lu(k,1850) - lu(k,730) * lu(k,1829) - lu(k,1853) = lu(k,1853) - lu(k,731) * lu(k,1829) - lu(k,1855) = lu(k,1855) - lu(k,732) * lu(k,1829) - lu(k,1856) = lu(k,1856) - lu(k,733) * lu(k,1829) + lu(k,666) = 1._r8 / lu(k,666) + lu(k,667) = lu(k,667) * lu(k,666) + lu(k,668) = lu(k,668) * lu(k,666) + lu(k,669) = lu(k,669) * lu(k,666) + lu(k,670) = lu(k,670) * lu(k,666) + lu(k,671) = lu(k,671) * lu(k,666) + lu(k,672) = lu(k,672) * lu(k,666) + lu(k,673) = lu(k,673) * lu(k,666) + lu(k,674) = lu(k,674) * lu(k,666) + lu(k,675) = lu(k,675) * lu(k,666) + lu(k,676) = lu(k,676) * lu(k,666) + lu(k,677) = lu(k,677) * lu(k,666) + lu(k,678) = lu(k,678) * lu(k,666) + lu(k,679) = lu(k,679) * lu(k,666) + lu(k,680) = lu(k,680) * lu(k,666) + lu(k,681) = lu(k,681) * lu(k,666) + lu(k,682) = lu(k,682) * lu(k,666) + lu(k,683) = lu(k,683) * lu(k,666) + lu(k,684) = lu(k,684) * lu(k,666) + lu(k,1006) = - lu(k,667) * lu(k,1005) + lu(k,1008) = lu(k,1008) - lu(k,668) * lu(k,1005) + lu(k,1009) = lu(k,1009) - lu(k,669) * lu(k,1005) + lu(k,1011) = lu(k,1011) - lu(k,670) * lu(k,1005) + lu(k,1014) = lu(k,1014) - lu(k,671) * lu(k,1005) + lu(k,1015) = lu(k,1015) - lu(k,672) * lu(k,1005) + lu(k,1017) = lu(k,1017) - lu(k,673) * lu(k,1005) + lu(k,1018) = lu(k,1018) - lu(k,674) * lu(k,1005) + lu(k,1019) = lu(k,1019) - lu(k,675) * lu(k,1005) + lu(k,1020) = lu(k,1020) - lu(k,676) * lu(k,1005) + lu(k,1021) = lu(k,1021) - lu(k,677) * lu(k,1005) + lu(k,1024) = lu(k,1024) - lu(k,678) * lu(k,1005) + lu(k,1025) = lu(k,1025) - lu(k,679) * lu(k,1005) + lu(k,1026) = lu(k,1026) - lu(k,680) * lu(k,1005) + lu(k,1027) = lu(k,1027) - lu(k,681) * lu(k,1005) + lu(k,1029) = lu(k,1029) - lu(k,682) * lu(k,1005) + lu(k,1033) = lu(k,1033) - lu(k,683) * lu(k,1005) + lu(k,1035) = lu(k,1035) - lu(k,684) * lu(k,1005) + lu(k,1134) = lu(k,1134) - lu(k,667) * lu(k,1133) + lu(k,1138) = lu(k,1138) - lu(k,668) * lu(k,1133) + lu(k,1140) = lu(k,1140) - lu(k,669) * lu(k,1133) + lu(k,1142) = lu(k,1142) - lu(k,670) * lu(k,1133) + lu(k,1145) = lu(k,1145) - lu(k,671) * lu(k,1133) + lu(k,1146) = lu(k,1146) - lu(k,672) * lu(k,1133) + lu(k,1148) = lu(k,1148) - lu(k,673) * lu(k,1133) + lu(k,1149) = lu(k,1149) - lu(k,674) * lu(k,1133) + lu(k,1150) = lu(k,1150) - lu(k,675) * lu(k,1133) + lu(k,1151) = lu(k,1151) - lu(k,676) * lu(k,1133) + lu(k,1152) = lu(k,1152) - lu(k,677) * lu(k,1133) + lu(k,1155) = lu(k,1155) - lu(k,678) * lu(k,1133) + lu(k,1156) = lu(k,1156) - lu(k,679) * lu(k,1133) + lu(k,1157) = lu(k,1157) - lu(k,680) * lu(k,1133) + lu(k,1158) = lu(k,1158) - lu(k,681) * lu(k,1133) + lu(k,1160) = lu(k,1160) - lu(k,682) * lu(k,1133) + lu(k,1164) = lu(k,1164) - lu(k,683) * lu(k,1133) + lu(k,1166) = lu(k,1166) - lu(k,684) * lu(k,1133) + lu(k,1178) = lu(k,1178) - lu(k,667) * lu(k,1177) + lu(k,1181) = lu(k,1181) - lu(k,668) * lu(k,1177) + lu(k,1183) = lu(k,1183) - lu(k,669) * lu(k,1177) + lu(k,1185) = lu(k,1185) - lu(k,670) * lu(k,1177) + lu(k,1188) = lu(k,1188) - lu(k,671) * lu(k,1177) + lu(k,1189) = lu(k,1189) - lu(k,672) * lu(k,1177) + lu(k,1191) = lu(k,1191) - lu(k,673) * lu(k,1177) + lu(k,1192) = lu(k,1192) - lu(k,674) * lu(k,1177) + lu(k,1193) = lu(k,1193) - lu(k,675) * lu(k,1177) + lu(k,1194) = lu(k,1194) - lu(k,676) * lu(k,1177) + lu(k,1195) = lu(k,1195) - lu(k,677) * lu(k,1177) + lu(k,1198) = lu(k,1198) - lu(k,678) * lu(k,1177) + lu(k,1199) = lu(k,1199) - lu(k,679) * lu(k,1177) + lu(k,1200) = lu(k,1200) - lu(k,680) * lu(k,1177) + lu(k,1201) = lu(k,1201) - lu(k,681) * lu(k,1177) + lu(k,1203) = lu(k,1203) - lu(k,682) * lu(k,1177) + lu(k,1207) = lu(k,1207) - lu(k,683) * lu(k,1177) + lu(k,1209) = lu(k,1209) - lu(k,684) * lu(k,1177) + lu(k,1321) = lu(k,1321) - lu(k,667) * lu(k,1320) + lu(k,1324) = lu(k,1324) - lu(k,668) * lu(k,1320) + lu(k,1326) = lu(k,1326) - lu(k,669) * lu(k,1320) + lu(k,1328) = lu(k,1328) - lu(k,670) * lu(k,1320) + lu(k,1331) = lu(k,1331) - lu(k,671) * lu(k,1320) + lu(k,1332) = lu(k,1332) - lu(k,672) * lu(k,1320) + lu(k,1334) = lu(k,1334) - lu(k,673) * lu(k,1320) + lu(k,1335) = lu(k,1335) - lu(k,674) * lu(k,1320) + lu(k,1336) = lu(k,1336) - lu(k,675) * lu(k,1320) + lu(k,1337) = lu(k,1337) - lu(k,676) * lu(k,1320) + lu(k,1338) = lu(k,1338) - lu(k,677) * lu(k,1320) + lu(k,1341) = lu(k,1341) - lu(k,678) * lu(k,1320) + lu(k,1342) = lu(k,1342) - lu(k,679) * lu(k,1320) + lu(k,1343) = lu(k,1343) - lu(k,680) * lu(k,1320) + lu(k,1344) = lu(k,1344) - lu(k,681) * lu(k,1320) + lu(k,1346) = lu(k,1346) - lu(k,682) * lu(k,1320) + lu(k,1350) = lu(k,1350) - lu(k,683) * lu(k,1320) + lu(k,1352) = lu(k,1352) - lu(k,684) * lu(k,1320) + lu(k,1400) = lu(k,1400) - lu(k,667) * lu(k,1399) + lu(k,1403) = lu(k,1403) - lu(k,668) * lu(k,1399) + lu(k,1405) = lu(k,1405) - lu(k,669) * lu(k,1399) + lu(k,1407) = lu(k,1407) - lu(k,670) * lu(k,1399) + lu(k,1410) = lu(k,1410) - lu(k,671) * lu(k,1399) + lu(k,1411) = lu(k,1411) - lu(k,672) * lu(k,1399) + lu(k,1413) = lu(k,1413) - lu(k,673) * lu(k,1399) + lu(k,1414) = lu(k,1414) - lu(k,674) * lu(k,1399) + lu(k,1415) = lu(k,1415) - lu(k,675) * lu(k,1399) + lu(k,1416) = lu(k,1416) - lu(k,676) * lu(k,1399) + lu(k,1417) = lu(k,1417) - lu(k,677) * lu(k,1399) + lu(k,1420) = lu(k,1420) - lu(k,678) * lu(k,1399) + lu(k,1421) = lu(k,1421) - lu(k,679) * lu(k,1399) + lu(k,1422) = lu(k,1422) - lu(k,680) * lu(k,1399) + lu(k,1423) = lu(k,1423) - lu(k,681) * lu(k,1399) + lu(k,1425) = lu(k,1425) - lu(k,682) * lu(k,1399) + lu(k,1429) = lu(k,1429) - lu(k,683) * lu(k,1399) + lu(k,1431) = lu(k,1431) - lu(k,684) * lu(k,1399) + lu(k,1443) = lu(k,1443) - lu(k,667) * lu(k,1442) + lu(k,1446) = lu(k,1446) - lu(k,668) * lu(k,1442) + lu(k,1448) = lu(k,1448) - lu(k,669) * lu(k,1442) + lu(k,1450) = lu(k,1450) - lu(k,670) * lu(k,1442) + lu(k,1453) = lu(k,1453) - lu(k,671) * lu(k,1442) + lu(k,1454) = lu(k,1454) - lu(k,672) * lu(k,1442) + lu(k,1456) = lu(k,1456) - lu(k,673) * lu(k,1442) + lu(k,1457) = lu(k,1457) - lu(k,674) * lu(k,1442) + lu(k,1458) = lu(k,1458) - lu(k,675) * lu(k,1442) + lu(k,1459) = lu(k,1459) - lu(k,676) * lu(k,1442) + lu(k,1460) = lu(k,1460) - lu(k,677) * lu(k,1442) + lu(k,1463) = lu(k,1463) - lu(k,678) * lu(k,1442) + lu(k,1464) = lu(k,1464) - lu(k,679) * lu(k,1442) + lu(k,1465) = lu(k,1465) - lu(k,680) * lu(k,1442) + lu(k,1466) = lu(k,1466) - lu(k,681) * lu(k,1442) + lu(k,1468) = lu(k,1468) - lu(k,682) * lu(k,1442) + lu(k,1472) = lu(k,1472) - lu(k,683) * lu(k,1442) + lu(k,1474) = lu(k,1474) - lu(k,684) * lu(k,1442) + lu(k,1568) = lu(k,1568) - lu(k,667) * lu(k,1567) + lu(k,1572) = lu(k,1572) - lu(k,668) * lu(k,1567) + lu(k,1574) = lu(k,1574) - lu(k,669) * lu(k,1567) + lu(k,1576) = lu(k,1576) - lu(k,670) * lu(k,1567) + lu(k,1579) = lu(k,1579) - lu(k,671) * lu(k,1567) + lu(k,1580) = lu(k,1580) - lu(k,672) * lu(k,1567) + lu(k,1582) = lu(k,1582) - lu(k,673) * lu(k,1567) + lu(k,1583) = lu(k,1583) - lu(k,674) * lu(k,1567) + lu(k,1584) = lu(k,1584) - lu(k,675) * lu(k,1567) + lu(k,1585) = lu(k,1585) - lu(k,676) * lu(k,1567) + lu(k,1586) = lu(k,1586) - lu(k,677) * lu(k,1567) + lu(k,1589) = lu(k,1589) - lu(k,678) * lu(k,1567) + lu(k,1590) = lu(k,1590) - lu(k,679) * lu(k,1567) + lu(k,1591) = lu(k,1591) - lu(k,680) * lu(k,1567) + lu(k,1592) = lu(k,1592) - lu(k,681) * lu(k,1567) + lu(k,1594) = lu(k,1594) - lu(k,682) * lu(k,1567) + lu(k,1598) = lu(k,1598) - lu(k,683) * lu(k,1567) + lu(k,1600) = lu(k,1600) - lu(k,684) * lu(k,1567) + lu(k,1615) = lu(k,1615) - lu(k,667) * lu(k,1614) + lu(k,1620) = lu(k,1620) - lu(k,668) * lu(k,1614) + lu(k,1622) = lu(k,1622) - lu(k,669) * lu(k,1614) + lu(k,1624) = lu(k,1624) - lu(k,670) * lu(k,1614) + lu(k,1627) = lu(k,1627) - lu(k,671) * lu(k,1614) + lu(k,1628) = lu(k,1628) - lu(k,672) * lu(k,1614) + lu(k,1630) = lu(k,1630) - lu(k,673) * lu(k,1614) + lu(k,1631) = lu(k,1631) - lu(k,674) * lu(k,1614) + lu(k,1632) = lu(k,1632) - lu(k,675) * lu(k,1614) + lu(k,1633) = lu(k,1633) - lu(k,676) * lu(k,1614) + lu(k,1634) = lu(k,1634) - lu(k,677) * lu(k,1614) + lu(k,1637) = lu(k,1637) - lu(k,678) * lu(k,1614) + lu(k,1638) = lu(k,1638) - lu(k,679) * lu(k,1614) + lu(k,1639) = lu(k,1639) - lu(k,680) * lu(k,1614) + lu(k,1640) = lu(k,1640) - lu(k,681) * lu(k,1614) + lu(k,1642) = lu(k,1642) - lu(k,682) * lu(k,1614) + lu(k,1646) = lu(k,1646) - lu(k,683) * lu(k,1614) + lu(k,1648) = lu(k,1648) - lu(k,684) * lu(k,1614) + lu(k,1660) = lu(k,1660) - lu(k,667) * lu(k,1659) + lu(k,1663) = lu(k,1663) - lu(k,668) * lu(k,1659) + lu(k,1665) = lu(k,1665) - lu(k,669) * lu(k,1659) + lu(k,1667) = lu(k,1667) - lu(k,670) * lu(k,1659) + lu(k,1670) = lu(k,1670) - lu(k,671) * lu(k,1659) + lu(k,1671) = lu(k,1671) - lu(k,672) * lu(k,1659) + lu(k,1673) = lu(k,1673) - lu(k,673) * lu(k,1659) + lu(k,1674) = lu(k,1674) - lu(k,674) * lu(k,1659) + lu(k,1675) = lu(k,1675) - lu(k,675) * lu(k,1659) + lu(k,1676) = lu(k,1676) - lu(k,676) * lu(k,1659) + lu(k,1677) = lu(k,1677) - lu(k,677) * lu(k,1659) + lu(k,1680) = lu(k,1680) - lu(k,678) * lu(k,1659) + lu(k,1681) = lu(k,1681) - lu(k,679) * lu(k,1659) + lu(k,1682) = lu(k,1682) - lu(k,680) * lu(k,1659) + lu(k,1683) = lu(k,1683) - lu(k,681) * lu(k,1659) + lu(k,1685) = lu(k,1685) - lu(k,682) * lu(k,1659) + lu(k,1689) = lu(k,1689) - lu(k,683) * lu(k,1659) + lu(k,1691) = lu(k,1691) - lu(k,684) * lu(k,1659) + lu(k,1700) = - lu(k,667) * lu(k,1699) + lu(k,1705) = lu(k,1705) - lu(k,668) * lu(k,1699) + lu(k,1707) = lu(k,1707) - lu(k,669) * lu(k,1699) + lu(k,1709) = lu(k,1709) - lu(k,670) * lu(k,1699) + lu(k,1712) = lu(k,1712) - lu(k,671) * lu(k,1699) + lu(k,1713) = lu(k,1713) - lu(k,672) * lu(k,1699) + lu(k,1715) = lu(k,1715) - lu(k,673) * lu(k,1699) + lu(k,1716) = lu(k,1716) - lu(k,674) * lu(k,1699) + lu(k,1717) = lu(k,1717) - lu(k,675) * lu(k,1699) + lu(k,1718) = lu(k,1718) - lu(k,676) * lu(k,1699) + lu(k,1719) = lu(k,1719) - lu(k,677) * lu(k,1699) + lu(k,1722) = lu(k,1722) - lu(k,678) * lu(k,1699) + lu(k,1723) = lu(k,1723) - lu(k,679) * lu(k,1699) + lu(k,1724) = lu(k,1724) - lu(k,680) * lu(k,1699) + lu(k,1725) = lu(k,1725) - lu(k,681) * lu(k,1699) + lu(k,1727) = lu(k,1727) - lu(k,682) * lu(k,1699) + lu(k,1731) = lu(k,1731) - lu(k,683) * lu(k,1699) + lu(k,1733) = lu(k,1733) - lu(k,684) * lu(k,1699) + lu(k,2054) = lu(k,2054) - lu(k,667) * lu(k,2053) + lu(k,2059) = lu(k,2059) - lu(k,668) * lu(k,2053) + lu(k,2061) = lu(k,2061) - lu(k,669) * lu(k,2053) + lu(k,2063) = lu(k,2063) - lu(k,670) * lu(k,2053) + lu(k,2066) = lu(k,2066) - lu(k,671) * lu(k,2053) + lu(k,2067) = lu(k,2067) - lu(k,672) * lu(k,2053) + lu(k,2069) = lu(k,2069) - lu(k,673) * lu(k,2053) + lu(k,2070) = lu(k,2070) - lu(k,674) * lu(k,2053) + lu(k,2071) = lu(k,2071) - lu(k,675) * lu(k,2053) + lu(k,2072) = lu(k,2072) - lu(k,676) * lu(k,2053) + lu(k,2073) = lu(k,2073) - lu(k,677) * lu(k,2053) + lu(k,2076) = lu(k,2076) - lu(k,678) * lu(k,2053) + lu(k,2077) = lu(k,2077) - lu(k,679) * lu(k,2053) + lu(k,2078) = lu(k,2078) - lu(k,680) * lu(k,2053) + lu(k,2079) = lu(k,2079) - lu(k,681) * lu(k,2053) + lu(k,2081) = lu(k,2081) - lu(k,682) * lu(k,2053) + lu(k,2085) = lu(k,2085) - lu(k,683) * lu(k,2053) + lu(k,2087) = lu(k,2087) - lu(k,684) * lu(k,2053) + lu(k,688) = 1._r8 / lu(k,688) + lu(k,689) = lu(k,689) * lu(k,688) + lu(k,690) = lu(k,690) * lu(k,688) + lu(k,691) = lu(k,691) * lu(k,688) + lu(k,692) = lu(k,692) * lu(k,688) + lu(k,693) = lu(k,693) * lu(k,688) + lu(k,694) = lu(k,694) * lu(k,688) + lu(k,695) = lu(k,695) * lu(k,688) + lu(k,696) = lu(k,696) * lu(k,688) + lu(k,697) = lu(k,697) * lu(k,688) + lu(k,698) = lu(k,698) * lu(k,688) + lu(k,699) = lu(k,699) * lu(k,688) + lu(k,700) = lu(k,700) * lu(k,688) + lu(k,701) = lu(k,701) * lu(k,688) + lu(k,702) = lu(k,702) * lu(k,688) + lu(k,703) = lu(k,703) * lu(k,688) + lu(k,704) = lu(k,704) * lu(k,688) + lu(k,863) = lu(k,863) - lu(k,689) * lu(k,861) + lu(k,866) = lu(k,866) - lu(k,690) * lu(k,861) + lu(k,867) = lu(k,867) - lu(k,691) * lu(k,861) + lu(k,868) = lu(k,868) - lu(k,692) * lu(k,861) + lu(k,869) = lu(k,869) - lu(k,693) * lu(k,861) + lu(k,870) = lu(k,870) - lu(k,694) * lu(k,861) + lu(k,871) = lu(k,871) - lu(k,695) * lu(k,861) + lu(k,872) = lu(k,872) - lu(k,696) * lu(k,861) + lu(k,873) = lu(k,873) - lu(k,697) * lu(k,861) + lu(k,874) = lu(k,874) - lu(k,698) * lu(k,861) + lu(k,876) = lu(k,876) - lu(k,699) * lu(k,861) + lu(k,877) = - lu(k,700) * lu(k,861) + lu(k,878) = lu(k,878) - lu(k,701) * lu(k,861) + lu(k,879) = lu(k,879) - lu(k,702) * lu(k,861) + lu(k,880) = lu(k,880) - lu(k,703) * lu(k,861) + lu(k,883) = lu(k,883) - lu(k,704) * lu(k,861) + lu(k,1008) = lu(k,1008) - lu(k,689) * lu(k,1006) + lu(k,1013) = - lu(k,690) * lu(k,1006) + lu(k,1014) = lu(k,1014) - lu(k,691) * lu(k,1006) + lu(k,1015) = lu(k,1015) - lu(k,692) * lu(k,1006) + lu(k,1016) = lu(k,1016) - lu(k,693) * lu(k,1006) + lu(k,1017) = lu(k,1017) - lu(k,694) * lu(k,1006) + lu(k,1018) = lu(k,1018) - lu(k,695) * lu(k,1006) + lu(k,1019) = lu(k,1019) - lu(k,696) * lu(k,1006) + lu(k,1020) = lu(k,1020) - lu(k,697) * lu(k,1006) + lu(k,1021) = lu(k,1021) - lu(k,698) * lu(k,1006) + lu(k,1024) = lu(k,1024) - lu(k,699) * lu(k,1006) + lu(k,1025) = lu(k,1025) - lu(k,700) * lu(k,1006) + lu(k,1026) = lu(k,1026) - lu(k,701) * lu(k,1006) + lu(k,1027) = lu(k,1027) - lu(k,702) * lu(k,1006) + lu(k,1029) = lu(k,1029) - lu(k,703) * lu(k,1006) + lu(k,1035) = lu(k,1035) - lu(k,704) * lu(k,1006) + lu(k,1091) = lu(k,1091) - lu(k,689) * lu(k,1087) + lu(k,1096) = lu(k,1096) - lu(k,690) * lu(k,1087) + lu(k,1097) = lu(k,1097) - lu(k,691) * lu(k,1087) + lu(k,1098) = lu(k,1098) - lu(k,692) * lu(k,1087) + lu(k,1099) = lu(k,1099) - lu(k,693) * lu(k,1087) + lu(k,1100) = lu(k,1100) - lu(k,694) * lu(k,1087) + lu(k,1101) = lu(k,1101) - lu(k,695) * lu(k,1087) + lu(k,1102) = lu(k,1102) - lu(k,696) * lu(k,1087) + lu(k,1103) = lu(k,1103) - lu(k,697) * lu(k,1087) + lu(k,1104) = lu(k,1104) - lu(k,698) * lu(k,1087) + lu(k,1107) = lu(k,1107) - lu(k,699) * lu(k,1087) + lu(k,1108) = lu(k,1108) - lu(k,700) * lu(k,1087) + lu(k,1109) = lu(k,1109) - lu(k,701) * lu(k,1087) + lu(k,1110) = lu(k,1110) - lu(k,702) * lu(k,1087) + lu(k,1112) = lu(k,1112) - lu(k,703) * lu(k,1087) + lu(k,1118) = lu(k,1118) - lu(k,704) * lu(k,1087) + lu(k,1138) = lu(k,1138) - lu(k,689) * lu(k,1134) + lu(k,1144) = lu(k,1144) - lu(k,690) * lu(k,1134) + lu(k,1145) = lu(k,1145) - lu(k,691) * lu(k,1134) + lu(k,1146) = lu(k,1146) - lu(k,692) * lu(k,1134) + lu(k,1147) = lu(k,1147) - lu(k,693) * lu(k,1134) + lu(k,1148) = lu(k,1148) - lu(k,694) * lu(k,1134) + lu(k,1149) = lu(k,1149) - lu(k,695) * lu(k,1134) + lu(k,1150) = lu(k,1150) - lu(k,696) * lu(k,1134) + lu(k,1151) = lu(k,1151) - lu(k,697) * lu(k,1134) + lu(k,1152) = lu(k,1152) - lu(k,698) * lu(k,1134) + lu(k,1155) = lu(k,1155) - lu(k,699) * lu(k,1134) + lu(k,1156) = lu(k,1156) - lu(k,700) * lu(k,1134) + lu(k,1157) = lu(k,1157) - lu(k,701) * lu(k,1134) + lu(k,1158) = lu(k,1158) - lu(k,702) * lu(k,1134) + lu(k,1160) = lu(k,1160) - lu(k,703) * lu(k,1134) + lu(k,1166) = lu(k,1166) - lu(k,704) * lu(k,1134) + lu(k,1181) = lu(k,1181) - lu(k,689) * lu(k,1178) + lu(k,1187) = lu(k,1187) - lu(k,690) * lu(k,1178) + lu(k,1188) = lu(k,1188) - lu(k,691) * lu(k,1178) + lu(k,1189) = lu(k,1189) - lu(k,692) * lu(k,1178) + lu(k,1190) = lu(k,1190) - lu(k,693) * lu(k,1178) + lu(k,1191) = lu(k,1191) - lu(k,694) * lu(k,1178) + lu(k,1192) = lu(k,1192) - lu(k,695) * lu(k,1178) + lu(k,1193) = lu(k,1193) - lu(k,696) * lu(k,1178) + lu(k,1194) = lu(k,1194) - lu(k,697) * lu(k,1178) + lu(k,1195) = lu(k,1195) - lu(k,698) * lu(k,1178) + lu(k,1198) = lu(k,1198) - lu(k,699) * lu(k,1178) + lu(k,1199) = lu(k,1199) - lu(k,700) * lu(k,1178) + lu(k,1200) = lu(k,1200) - lu(k,701) * lu(k,1178) + lu(k,1201) = lu(k,1201) - lu(k,702) * lu(k,1178) + lu(k,1203) = lu(k,1203) - lu(k,703) * lu(k,1178) + lu(k,1209) = lu(k,1209) - lu(k,704) * lu(k,1178) + lu(k,1222) = lu(k,1222) - lu(k,689) * lu(k,1218) + lu(k,1228) = lu(k,1228) - lu(k,690) * lu(k,1218) + lu(k,1229) = lu(k,1229) - lu(k,691) * lu(k,1218) + lu(k,1230) = lu(k,1230) - lu(k,692) * lu(k,1218) + lu(k,1231) = lu(k,1231) - lu(k,693) * lu(k,1218) + lu(k,1232) = lu(k,1232) - lu(k,694) * lu(k,1218) + lu(k,1233) = lu(k,1233) - lu(k,695) * lu(k,1218) + lu(k,1234) = lu(k,1234) - lu(k,696) * lu(k,1218) + lu(k,1235) = lu(k,1235) - lu(k,697) * lu(k,1218) + lu(k,1236) = lu(k,1236) - lu(k,698) * lu(k,1218) + lu(k,1239) = lu(k,1239) - lu(k,699) * lu(k,1218) + lu(k,1240) = lu(k,1240) - lu(k,700) * lu(k,1218) + lu(k,1241) = lu(k,1241) - lu(k,701) * lu(k,1218) + lu(k,1242) = lu(k,1242) - lu(k,702) * lu(k,1218) + lu(k,1244) = lu(k,1244) - lu(k,703) * lu(k,1218) + lu(k,1250) = lu(k,1250) - lu(k,704) * lu(k,1218) + lu(k,1324) = lu(k,1324) - lu(k,689) * lu(k,1321) + lu(k,1330) = lu(k,1330) - lu(k,690) * lu(k,1321) + lu(k,1331) = lu(k,1331) - lu(k,691) * lu(k,1321) + lu(k,1332) = lu(k,1332) - lu(k,692) * lu(k,1321) + lu(k,1333) = lu(k,1333) - lu(k,693) * lu(k,1321) + lu(k,1334) = lu(k,1334) - lu(k,694) * lu(k,1321) + lu(k,1335) = lu(k,1335) - lu(k,695) * lu(k,1321) + lu(k,1336) = lu(k,1336) - lu(k,696) * lu(k,1321) + lu(k,1337) = lu(k,1337) - lu(k,697) * lu(k,1321) + lu(k,1338) = lu(k,1338) - lu(k,698) * lu(k,1321) + lu(k,1341) = lu(k,1341) - lu(k,699) * lu(k,1321) + lu(k,1342) = lu(k,1342) - lu(k,700) * lu(k,1321) + lu(k,1343) = lu(k,1343) - lu(k,701) * lu(k,1321) + lu(k,1344) = lu(k,1344) - lu(k,702) * lu(k,1321) + lu(k,1346) = lu(k,1346) - lu(k,703) * lu(k,1321) + lu(k,1352) = lu(k,1352) - lu(k,704) * lu(k,1321) + lu(k,1403) = lu(k,1403) - lu(k,689) * lu(k,1400) + lu(k,1409) = lu(k,1409) - lu(k,690) * lu(k,1400) + lu(k,1410) = lu(k,1410) - lu(k,691) * lu(k,1400) + lu(k,1411) = lu(k,1411) - lu(k,692) * lu(k,1400) + lu(k,1412) = lu(k,1412) - lu(k,693) * lu(k,1400) + lu(k,1413) = lu(k,1413) - lu(k,694) * lu(k,1400) + lu(k,1414) = lu(k,1414) - lu(k,695) * lu(k,1400) + lu(k,1415) = lu(k,1415) - lu(k,696) * lu(k,1400) + lu(k,1416) = lu(k,1416) - lu(k,697) * lu(k,1400) + lu(k,1417) = lu(k,1417) - lu(k,698) * lu(k,1400) + lu(k,1420) = lu(k,1420) - lu(k,699) * lu(k,1400) + lu(k,1421) = lu(k,1421) - lu(k,700) * lu(k,1400) + lu(k,1422) = lu(k,1422) - lu(k,701) * lu(k,1400) + lu(k,1423) = lu(k,1423) - lu(k,702) * lu(k,1400) + lu(k,1425) = lu(k,1425) - lu(k,703) * lu(k,1400) + lu(k,1431) = lu(k,1431) - lu(k,704) * lu(k,1400) + lu(k,1446) = lu(k,1446) - lu(k,689) * lu(k,1443) + lu(k,1452) = lu(k,1452) - lu(k,690) * lu(k,1443) + lu(k,1453) = lu(k,1453) - lu(k,691) * lu(k,1443) + lu(k,1454) = lu(k,1454) - lu(k,692) * lu(k,1443) + lu(k,1455) = lu(k,1455) - lu(k,693) * lu(k,1443) + lu(k,1456) = lu(k,1456) - lu(k,694) * lu(k,1443) + lu(k,1457) = lu(k,1457) - lu(k,695) * lu(k,1443) + lu(k,1458) = lu(k,1458) - lu(k,696) * lu(k,1443) + lu(k,1459) = lu(k,1459) - lu(k,697) * lu(k,1443) + lu(k,1460) = lu(k,1460) - lu(k,698) * lu(k,1443) + lu(k,1463) = lu(k,1463) - lu(k,699) * lu(k,1443) + lu(k,1464) = lu(k,1464) - lu(k,700) * lu(k,1443) + lu(k,1465) = lu(k,1465) - lu(k,701) * lu(k,1443) + lu(k,1466) = lu(k,1466) - lu(k,702) * lu(k,1443) + lu(k,1468) = lu(k,1468) - lu(k,703) * lu(k,1443) + lu(k,1474) = lu(k,1474) - lu(k,704) * lu(k,1443) + lu(k,1572) = lu(k,1572) - lu(k,689) * lu(k,1568) + lu(k,1578) = lu(k,1578) - lu(k,690) * lu(k,1568) + lu(k,1579) = lu(k,1579) - lu(k,691) * lu(k,1568) + lu(k,1580) = lu(k,1580) - lu(k,692) * lu(k,1568) + lu(k,1581) = lu(k,1581) - lu(k,693) * lu(k,1568) + lu(k,1582) = lu(k,1582) - lu(k,694) * lu(k,1568) + lu(k,1583) = lu(k,1583) - lu(k,695) * lu(k,1568) + lu(k,1584) = lu(k,1584) - lu(k,696) * lu(k,1568) + lu(k,1585) = lu(k,1585) - lu(k,697) * lu(k,1568) + lu(k,1586) = lu(k,1586) - lu(k,698) * lu(k,1568) + lu(k,1589) = lu(k,1589) - lu(k,699) * lu(k,1568) + lu(k,1590) = lu(k,1590) - lu(k,700) * lu(k,1568) + lu(k,1591) = lu(k,1591) - lu(k,701) * lu(k,1568) + lu(k,1592) = lu(k,1592) - lu(k,702) * lu(k,1568) + lu(k,1594) = lu(k,1594) - lu(k,703) * lu(k,1568) + lu(k,1600) = lu(k,1600) - lu(k,704) * lu(k,1568) + lu(k,1620) = lu(k,1620) - lu(k,689) * lu(k,1615) + lu(k,1626) = lu(k,1626) - lu(k,690) * lu(k,1615) + lu(k,1627) = lu(k,1627) - lu(k,691) * lu(k,1615) + lu(k,1628) = lu(k,1628) - lu(k,692) * lu(k,1615) + lu(k,1629) = lu(k,1629) - lu(k,693) * lu(k,1615) + lu(k,1630) = lu(k,1630) - lu(k,694) * lu(k,1615) + lu(k,1631) = lu(k,1631) - lu(k,695) * lu(k,1615) + lu(k,1632) = lu(k,1632) - lu(k,696) * lu(k,1615) + lu(k,1633) = lu(k,1633) - lu(k,697) * lu(k,1615) + lu(k,1634) = lu(k,1634) - lu(k,698) * lu(k,1615) + lu(k,1637) = lu(k,1637) - lu(k,699) * lu(k,1615) + lu(k,1638) = lu(k,1638) - lu(k,700) * lu(k,1615) + lu(k,1639) = lu(k,1639) - lu(k,701) * lu(k,1615) + lu(k,1640) = lu(k,1640) - lu(k,702) * lu(k,1615) + lu(k,1642) = lu(k,1642) - lu(k,703) * lu(k,1615) + lu(k,1648) = lu(k,1648) - lu(k,704) * lu(k,1615) + lu(k,1663) = lu(k,1663) - lu(k,689) * lu(k,1660) + lu(k,1669) = lu(k,1669) - lu(k,690) * lu(k,1660) + lu(k,1670) = lu(k,1670) - lu(k,691) * lu(k,1660) + lu(k,1671) = lu(k,1671) - lu(k,692) * lu(k,1660) + lu(k,1672) = lu(k,1672) - lu(k,693) * lu(k,1660) + lu(k,1673) = lu(k,1673) - lu(k,694) * lu(k,1660) + lu(k,1674) = lu(k,1674) - lu(k,695) * lu(k,1660) + lu(k,1675) = lu(k,1675) - lu(k,696) * lu(k,1660) + lu(k,1676) = lu(k,1676) - lu(k,697) * lu(k,1660) + lu(k,1677) = lu(k,1677) - lu(k,698) * lu(k,1660) + lu(k,1680) = lu(k,1680) - lu(k,699) * lu(k,1660) + lu(k,1681) = lu(k,1681) - lu(k,700) * lu(k,1660) + lu(k,1682) = lu(k,1682) - lu(k,701) * lu(k,1660) + lu(k,1683) = lu(k,1683) - lu(k,702) * lu(k,1660) + lu(k,1685) = lu(k,1685) - lu(k,703) * lu(k,1660) + lu(k,1691) = lu(k,1691) - lu(k,704) * lu(k,1660) + lu(k,1705) = lu(k,1705) - lu(k,689) * lu(k,1700) + lu(k,1711) = lu(k,1711) - lu(k,690) * lu(k,1700) + lu(k,1712) = lu(k,1712) - lu(k,691) * lu(k,1700) + lu(k,1713) = lu(k,1713) - lu(k,692) * lu(k,1700) + lu(k,1714) = - lu(k,693) * lu(k,1700) + lu(k,1715) = lu(k,1715) - lu(k,694) * lu(k,1700) + lu(k,1716) = lu(k,1716) - lu(k,695) * lu(k,1700) + lu(k,1717) = lu(k,1717) - lu(k,696) * lu(k,1700) + lu(k,1718) = lu(k,1718) - lu(k,697) * lu(k,1700) + lu(k,1719) = lu(k,1719) - lu(k,698) * lu(k,1700) + lu(k,1722) = lu(k,1722) - lu(k,699) * lu(k,1700) + lu(k,1723) = lu(k,1723) - lu(k,700) * lu(k,1700) + lu(k,1724) = lu(k,1724) - lu(k,701) * lu(k,1700) + lu(k,1725) = lu(k,1725) - lu(k,702) * lu(k,1700) + lu(k,1727) = lu(k,1727) - lu(k,703) * lu(k,1700) + lu(k,1733) = lu(k,1733) - lu(k,704) * lu(k,1700) + lu(k,2059) = lu(k,2059) - lu(k,689) * lu(k,2054) + lu(k,2065) = lu(k,2065) - lu(k,690) * lu(k,2054) + lu(k,2066) = lu(k,2066) - lu(k,691) * lu(k,2054) + lu(k,2067) = lu(k,2067) - lu(k,692) * lu(k,2054) + lu(k,2068) = lu(k,2068) - lu(k,693) * lu(k,2054) + lu(k,2069) = lu(k,2069) - lu(k,694) * lu(k,2054) + lu(k,2070) = lu(k,2070) - lu(k,695) * lu(k,2054) + lu(k,2071) = lu(k,2071) - lu(k,696) * lu(k,2054) + lu(k,2072) = lu(k,2072) - lu(k,697) * lu(k,2054) + lu(k,2073) = lu(k,2073) - lu(k,698) * lu(k,2054) + lu(k,2076) = lu(k,2076) - lu(k,699) * lu(k,2054) + lu(k,2077) = lu(k,2077) - lu(k,700) * lu(k,2054) + lu(k,2078) = lu(k,2078) - lu(k,701) * lu(k,2054) + lu(k,2079) = lu(k,2079) - lu(k,702) * lu(k,2054) + lu(k,2081) = lu(k,2081) - lu(k,703) * lu(k,2054) + lu(k,2087) = lu(k,2087) - lu(k,704) * lu(k,2054) + lu(k,712) = 1._r8 / lu(k,712) + lu(k,713) = lu(k,713) * lu(k,712) + lu(k,714) = lu(k,714) * lu(k,712) + lu(k,715) = lu(k,715) * lu(k,712) + lu(k,716) = lu(k,716) * lu(k,712) + lu(k,717) = lu(k,717) * lu(k,712) + lu(k,718) = lu(k,718) * lu(k,712) + lu(k,719) = lu(k,719) * lu(k,712) + lu(k,720) = lu(k,720) * lu(k,712) + lu(k,721) = lu(k,721) * lu(k,712) + lu(k,722) = lu(k,722) * lu(k,712) + lu(k,723) = lu(k,723) * lu(k,712) + lu(k,724) = lu(k,724) * lu(k,712) + lu(k,725) = lu(k,725) * lu(k,712) + lu(k,726) = lu(k,726) * lu(k,712) + lu(k,727) = lu(k,727) * lu(k,712) + lu(k,728) = lu(k,728) * lu(k,712) + lu(k,729) = lu(k,729) * lu(k,712) + lu(k,735) = lu(k,735) - lu(k,713) * lu(k,734) + lu(k,736) = lu(k,736) - lu(k,714) * lu(k,734) + lu(k,737) = lu(k,737) - lu(k,715) * lu(k,734) + lu(k,738) = lu(k,738) - lu(k,716) * lu(k,734) + lu(k,740) = lu(k,740) - lu(k,717) * lu(k,734) + lu(k,741) = lu(k,741) - lu(k,718) * lu(k,734) + lu(k,742) = lu(k,742) - lu(k,719) * lu(k,734) + lu(k,743) = lu(k,743) - lu(k,720) * lu(k,734) + lu(k,744) = lu(k,744) - lu(k,721) * lu(k,734) + lu(k,745) = lu(k,745) - lu(k,722) * lu(k,734) + lu(k,746) = lu(k,746) - lu(k,723) * lu(k,734) + lu(k,747) = lu(k,747) - lu(k,724) * lu(k,734) + lu(k,748) = lu(k,748) - lu(k,725) * lu(k,734) + lu(k,751) = lu(k,751) - lu(k,726) * lu(k,734) + lu(k,752) = lu(k,752) - lu(k,727) * lu(k,734) + lu(k,753) = lu(k,753) - lu(k,728) * lu(k,734) + lu(k,754) = lu(k,754) - lu(k,729) * lu(k,734) + lu(k,783) = lu(k,783) - lu(k,713) * lu(k,782) + lu(k,784) = lu(k,784) - lu(k,714) * lu(k,782) + lu(k,785) = lu(k,785) - lu(k,715) * lu(k,782) + lu(k,786) = lu(k,786) - lu(k,716) * lu(k,782) + lu(k,788) = lu(k,788) - lu(k,717) * lu(k,782) + lu(k,789) = lu(k,789) - lu(k,718) * lu(k,782) + lu(k,790) = lu(k,790) - lu(k,719) * lu(k,782) + lu(k,791) = lu(k,791) - lu(k,720) * lu(k,782) + lu(k,793) = lu(k,793) - lu(k,721) * lu(k,782) + lu(k,796) = lu(k,796) - lu(k,722) * lu(k,782) + lu(k,797) = lu(k,797) - lu(k,723) * lu(k,782) + lu(k,798) = lu(k,798) - lu(k,724) * lu(k,782) + lu(k,799) = lu(k,799) - lu(k,725) * lu(k,782) + lu(k,802) = lu(k,802) - lu(k,726) * lu(k,782) + lu(k,803) = lu(k,803) - lu(k,727) * lu(k,782) + lu(k,804) = lu(k,804) - lu(k,728) * lu(k,782) + lu(k,805) = lu(k,805) - lu(k,729) * lu(k,782) + lu(k,895) = lu(k,895) - lu(k,713) * lu(k,894) + lu(k,896) = lu(k,896) - lu(k,714) * lu(k,894) + lu(k,897) = lu(k,897) - lu(k,715) * lu(k,894) + lu(k,898) = lu(k,898) - lu(k,716) * lu(k,894) + lu(k,900) = lu(k,900) - lu(k,717) * lu(k,894) + lu(k,901) = lu(k,901) - lu(k,718) * lu(k,894) + lu(k,902) = lu(k,902) - lu(k,719) * lu(k,894) + lu(k,904) = lu(k,904) - lu(k,720) * lu(k,894) + lu(k,906) = lu(k,906) - lu(k,721) * lu(k,894) + lu(k,909) = lu(k,909) - lu(k,722) * lu(k,894) + lu(k,910) = lu(k,910) - lu(k,723) * lu(k,894) + lu(k,911) = lu(k,911) - lu(k,724) * lu(k,894) + lu(k,912) = lu(k,912) - lu(k,725) * lu(k,894) + lu(k,915) = lu(k,915) - lu(k,726) * lu(k,894) + lu(k,916) = lu(k,916) - lu(k,727) * lu(k,894) + lu(k,917) = lu(k,917) - lu(k,728) * lu(k,894) + lu(k,918) = lu(k,918) - lu(k,729) * lu(k,894) + lu(k,978) = lu(k,978) - lu(k,713) * lu(k,977) + lu(k,979) = lu(k,979) - lu(k,714) * lu(k,977) + lu(k,980) = lu(k,980) - lu(k,715) * lu(k,977) + lu(k,981) = lu(k,981) - lu(k,716) * lu(k,977) + lu(k,983) = lu(k,983) - lu(k,717) * lu(k,977) + lu(k,985) = lu(k,985) - lu(k,718) * lu(k,977) + lu(k,986) = lu(k,986) - lu(k,719) * lu(k,977) + lu(k,988) = lu(k,988) - lu(k,720) * lu(k,977) + lu(k,990) = lu(k,990) - lu(k,721) * lu(k,977) + lu(k,993) = lu(k,993) - lu(k,722) * lu(k,977) + lu(k,994) = lu(k,994) - lu(k,723) * lu(k,977) + lu(k,995) = lu(k,995) - lu(k,724) * lu(k,977) + lu(k,996) = lu(k,996) - lu(k,725) * lu(k,977) + lu(k,999) = lu(k,999) - lu(k,726) * lu(k,977) + lu(k,1000) = lu(k,1000) - lu(k,727) * lu(k,977) + lu(k,1001) = lu(k,1001) - lu(k,728) * lu(k,977) + lu(k,1002) = lu(k,1002) - lu(k,729) * lu(k,977) + lu(k,1089) = lu(k,1089) - lu(k,713) * lu(k,1088) + lu(k,1090) = lu(k,1090) - lu(k,714) * lu(k,1088) + lu(k,1092) = lu(k,1092) - lu(k,715) * lu(k,1088) + lu(k,1094) = lu(k,1094) - lu(k,716) * lu(k,1088) + lu(k,1096) = lu(k,1096) - lu(k,717) * lu(k,1088) + lu(k,1099) = lu(k,1099) - lu(k,718) * lu(k,1088) + lu(k,1100) = lu(k,1100) - lu(k,719) * lu(k,1088) + lu(k,1102) = lu(k,1102) - lu(k,720) * lu(k,1088) + lu(k,1105) = - lu(k,721) * lu(k,1088) + lu(k,1108) = lu(k,1108) - lu(k,722) * lu(k,1088) + lu(k,1110) = lu(k,1110) - lu(k,723) * lu(k,1088) + lu(k,1111) = lu(k,1111) - lu(k,724) * lu(k,1088) + lu(k,1112) = lu(k,1112) - lu(k,725) * lu(k,1088) + lu(k,1115) = lu(k,1115) - lu(k,726) * lu(k,1088) + lu(k,1116) = lu(k,1116) - lu(k,727) * lu(k,1088) + lu(k,1117) = lu(k,1117) - lu(k,728) * lu(k,1088) + lu(k,1118) = lu(k,1118) - lu(k,729) * lu(k,1088) + lu(k,1278) = lu(k,1278) - lu(k,713) * lu(k,1277) + lu(k,1279) = lu(k,1279) - lu(k,714) * lu(k,1277) + lu(k,1283) = lu(k,1283) - lu(k,715) * lu(k,1277) + lu(k,1285) = lu(k,1285) - lu(k,716) * lu(k,1277) + lu(k,1288) = lu(k,1288) - lu(k,717) * lu(k,1277) + lu(k,1291) = lu(k,1291) - lu(k,718) * lu(k,1277) + lu(k,1292) = lu(k,1292) - lu(k,719) * lu(k,1277) + lu(k,1294) = lu(k,1294) - lu(k,720) * lu(k,1277) + lu(k,1297) = lu(k,1297) - lu(k,721) * lu(k,1277) + lu(k,1300) = lu(k,1300) - lu(k,722) * lu(k,1277) + lu(k,1302) = lu(k,1302) - lu(k,723) * lu(k,1277) + lu(k,1303) = lu(k,1303) - lu(k,724) * lu(k,1277) + lu(k,1304) = lu(k,1304) - lu(k,725) * lu(k,1277) + lu(k,1307) = lu(k,1307) - lu(k,726) * lu(k,1277) + lu(k,1308) = lu(k,1308) - lu(k,727) * lu(k,1277) + lu(k,1309) = lu(k,1309) - lu(k,728) * lu(k,1277) + lu(k,1310) = lu(k,1310) - lu(k,729) * lu(k,1277) + lu(k,1487) = lu(k,1487) - lu(k,713) * lu(k,1486) + lu(k,1488) = lu(k,1488) - lu(k,714) * lu(k,1486) + lu(k,1492) = lu(k,1492) - lu(k,715) * lu(k,1486) + lu(k,1494) = lu(k,1494) - lu(k,716) * lu(k,1486) + lu(k,1497) = lu(k,1497) - lu(k,717) * lu(k,1486) + lu(k,1500) = lu(k,1500) - lu(k,718) * lu(k,1486) + lu(k,1501) = lu(k,1501) - lu(k,719) * lu(k,1486) + lu(k,1503) = lu(k,1503) - lu(k,720) * lu(k,1486) + lu(k,1506) = lu(k,1506) - lu(k,721) * lu(k,1486) + lu(k,1509) = lu(k,1509) - lu(k,722) * lu(k,1486) + lu(k,1511) = lu(k,1511) - lu(k,723) * lu(k,1486) + lu(k,1512) = lu(k,1512) - lu(k,724) * lu(k,1486) + lu(k,1513) = lu(k,1513) - lu(k,725) * lu(k,1486) + lu(k,1516) = lu(k,1516) - lu(k,726) * lu(k,1486) + lu(k,1517) = lu(k,1517) - lu(k,727) * lu(k,1486) + lu(k,1518) = lu(k,1518) - lu(k,728) * lu(k,1486) + lu(k,1519) = lu(k,1519) - lu(k,729) * lu(k,1486) + lu(k,1617) = lu(k,1617) - lu(k,713) * lu(k,1616) + lu(k,1618) = lu(k,1618) - lu(k,714) * lu(k,1616) + lu(k,1621) = lu(k,1621) - lu(k,715) * lu(k,1616) + lu(k,1623) = lu(k,1623) - lu(k,716) * lu(k,1616) + lu(k,1626) = lu(k,1626) - lu(k,717) * lu(k,1616) + lu(k,1629) = lu(k,1629) - lu(k,718) * lu(k,1616) + lu(k,1630) = lu(k,1630) - lu(k,719) * lu(k,1616) + lu(k,1632) = lu(k,1632) - lu(k,720) * lu(k,1616) + lu(k,1635) = lu(k,1635) - lu(k,721) * lu(k,1616) + lu(k,1638) = lu(k,1638) - lu(k,722) * lu(k,1616) + lu(k,1640) = lu(k,1640) - lu(k,723) * lu(k,1616) + lu(k,1641) = lu(k,1641) - lu(k,724) * lu(k,1616) + lu(k,1642) = lu(k,1642) - lu(k,725) * lu(k,1616) + lu(k,1645) = lu(k,1645) - lu(k,726) * lu(k,1616) + lu(k,1646) = lu(k,1646) - lu(k,727) * lu(k,1616) + lu(k,1647) = lu(k,1647) - lu(k,728) * lu(k,1616) + lu(k,1648) = lu(k,1648) - lu(k,729) * lu(k,1616) + lu(k,1702) = lu(k,1702) - lu(k,713) * lu(k,1701) + lu(k,1703) = lu(k,1703) - lu(k,714) * lu(k,1701) + lu(k,1706) = lu(k,1706) - lu(k,715) * lu(k,1701) + lu(k,1708) = lu(k,1708) - lu(k,716) * lu(k,1701) + lu(k,1711) = lu(k,1711) - lu(k,717) * lu(k,1701) + lu(k,1714) = lu(k,1714) - lu(k,718) * lu(k,1701) + lu(k,1715) = lu(k,1715) - lu(k,719) * lu(k,1701) + lu(k,1717) = lu(k,1717) - lu(k,720) * lu(k,1701) + lu(k,1720) = - lu(k,721) * lu(k,1701) + lu(k,1723) = lu(k,1723) - lu(k,722) * lu(k,1701) + lu(k,1725) = lu(k,1725) - lu(k,723) * lu(k,1701) + lu(k,1726) = lu(k,1726) - lu(k,724) * lu(k,1701) + lu(k,1727) = lu(k,1727) - lu(k,725) * lu(k,1701) + lu(k,1730) = lu(k,1730) - lu(k,726) * lu(k,1701) + lu(k,1731) = lu(k,1731) - lu(k,727) * lu(k,1701) + lu(k,1732) = lu(k,1732) - lu(k,728) * lu(k,1701) + lu(k,1733) = lu(k,1733) - lu(k,729) * lu(k,1701) + lu(k,1746) = lu(k,1746) - lu(k,713) * lu(k,1745) + lu(k,1747) = lu(k,1747) - lu(k,714) * lu(k,1745) + lu(k,1751) = lu(k,1751) - lu(k,715) * lu(k,1745) + lu(k,1753) = lu(k,1753) - lu(k,716) * lu(k,1745) + lu(k,1756) = lu(k,1756) - lu(k,717) * lu(k,1745) + lu(k,1759) = lu(k,1759) - lu(k,718) * lu(k,1745) + lu(k,1760) = lu(k,1760) - lu(k,719) * lu(k,1745) + lu(k,1762) = lu(k,1762) - lu(k,720) * lu(k,1745) + lu(k,1765) = lu(k,1765) - lu(k,721) * lu(k,1745) + lu(k,1768) = lu(k,1768) - lu(k,722) * lu(k,1745) + lu(k,1770) = lu(k,1770) - lu(k,723) * lu(k,1745) + lu(k,1771) = lu(k,1771) - lu(k,724) * lu(k,1745) + lu(k,1772) = lu(k,1772) - lu(k,725) * lu(k,1745) + lu(k,1775) = lu(k,1775) - lu(k,726) * lu(k,1745) + lu(k,1776) = lu(k,1776) - lu(k,727) * lu(k,1745) + lu(k,1777) = lu(k,1777) - lu(k,728) * lu(k,1745) + lu(k,1778) = lu(k,1778) - lu(k,729) * lu(k,1745) + lu(k,1796) = lu(k,1796) - lu(k,713) * lu(k,1795) + lu(k,1797) = lu(k,1797) - lu(k,714) * lu(k,1795) + lu(k,1800) = lu(k,1800) - lu(k,715) * lu(k,1795) + lu(k,1802) = lu(k,1802) - lu(k,716) * lu(k,1795) + lu(k,1805) = - lu(k,717) * lu(k,1795) + lu(k,1808) = - lu(k,718) * lu(k,1795) + lu(k,1809) = lu(k,1809) - lu(k,719) * lu(k,1795) + lu(k,1811) = lu(k,1811) - lu(k,720) * lu(k,1795) + lu(k,1814) = - lu(k,721) * lu(k,1795) + lu(k,1817) = lu(k,1817) - lu(k,722) * lu(k,1795) + lu(k,1819) = lu(k,1819) - lu(k,723) * lu(k,1795) + lu(k,1820) = lu(k,1820) - lu(k,724) * lu(k,1795) + lu(k,1821) = lu(k,1821) - lu(k,725) * lu(k,1795) + lu(k,1824) = lu(k,1824) - lu(k,726) * lu(k,1795) + lu(k,1825) = lu(k,1825) - lu(k,727) * lu(k,1795) + lu(k,1826) = lu(k,1826) - lu(k,728) * lu(k,1795) + lu(k,1827) = lu(k,1827) - lu(k,729) * lu(k,1795) + lu(k,1906) = lu(k,1906) - lu(k,713) * lu(k,1905) + lu(k,1907) = lu(k,1907) - lu(k,714) * lu(k,1905) + lu(k,1910) = lu(k,1910) - lu(k,715) * lu(k,1905) + lu(k,1912) = lu(k,1912) - lu(k,716) * lu(k,1905) + lu(k,1915) = lu(k,1915) - lu(k,717) * lu(k,1905) + lu(k,1918) = - lu(k,718) * lu(k,1905) + lu(k,1919) = lu(k,1919) - lu(k,719) * lu(k,1905) + lu(k,1921) = lu(k,1921) - lu(k,720) * lu(k,1905) + lu(k,1924) = - lu(k,721) * lu(k,1905) + lu(k,1927) = lu(k,1927) - lu(k,722) * lu(k,1905) + lu(k,1929) = lu(k,1929) - lu(k,723) * lu(k,1905) + lu(k,1930) = lu(k,1930) - lu(k,724) * lu(k,1905) + lu(k,1931) = lu(k,1931) - lu(k,725) * lu(k,1905) + lu(k,1934) = lu(k,1934) - lu(k,726) * lu(k,1905) + lu(k,1935) = lu(k,1935) - lu(k,727) * lu(k,1905) + lu(k,1936) = lu(k,1936) - lu(k,728) * lu(k,1905) + lu(k,1937) = lu(k,1937) - lu(k,729) * lu(k,1905) + lu(k,1995) = lu(k,1995) - lu(k,713) * lu(k,1994) + lu(k,1996) = lu(k,1996) - lu(k,714) * lu(k,1994) + lu(k,2000) = lu(k,2000) - lu(k,715) * lu(k,1994) + lu(k,2002) = lu(k,2002) - lu(k,716) * lu(k,1994) + lu(k,2005) = lu(k,2005) - lu(k,717) * lu(k,1994) + lu(k,2008) = lu(k,2008) - lu(k,718) * lu(k,1994) + lu(k,2009) = lu(k,2009) - lu(k,719) * lu(k,1994) + lu(k,2011) = lu(k,2011) - lu(k,720) * lu(k,1994) + lu(k,2014) = lu(k,2014) - lu(k,721) * lu(k,1994) + lu(k,2017) = lu(k,2017) - lu(k,722) * lu(k,1994) + lu(k,2019) = lu(k,2019) - lu(k,723) * lu(k,1994) + lu(k,2020) = lu(k,2020) - lu(k,724) * lu(k,1994) + lu(k,2021) = lu(k,2021) - lu(k,725) * lu(k,1994) + lu(k,2024) = lu(k,2024) - lu(k,726) * lu(k,1994) + lu(k,2025) = lu(k,2025) - lu(k,727) * lu(k,1994) + lu(k,2026) = lu(k,2026) - lu(k,728) * lu(k,1994) + lu(k,2027) = lu(k,2027) - lu(k,729) * lu(k,1994) + lu(k,2056) = lu(k,2056) - lu(k,713) * lu(k,2055) + lu(k,2057) = lu(k,2057) - lu(k,714) * lu(k,2055) + lu(k,2060) = lu(k,2060) - lu(k,715) * lu(k,2055) + lu(k,2062) = lu(k,2062) - lu(k,716) * lu(k,2055) + lu(k,2065) = lu(k,2065) - lu(k,717) * lu(k,2055) + lu(k,2068) = lu(k,2068) - lu(k,718) * lu(k,2055) + lu(k,2069) = lu(k,2069) - lu(k,719) * lu(k,2055) + lu(k,2071) = lu(k,2071) - lu(k,720) * lu(k,2055) + lu(k,2074) = lu(k,2074) - lu(k,721) * lu(k,2055) + lu(k,2077) = lu(k,2077) - lu(k,722) * lu(k,2055) + lu(k,2079) = lu(k,2079) - lu(k,723) * lu(k,2055) + lu(k,2080) = lu(k,2080) - lu(k,724) * lu(k,2055) + lu(k,2081) = lu(k,2081) - lu(k,725) * lu(k,2055) + lu(k,2084) = lu(k,2084) - lu(k,726) * lu(k,2055) + lu(k,2085) = lu(k,2085) - lu(k,727) * lu(k,2055) + lu(k,2086) = lu(k,2086) - lu(k,728) * lu(k,2055) + lu(k,2087) = lu(k,2087) - lu(k,729) * lu(k,2055) end do end subroutine lu_fac17 subroutine lu_fac18( avec_len, lu ) @@ -6614,1557 +5093,751 @@ subroutine lu_fac18( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,747) = 1._r8 / lu(k,747) - lu(k,748) = lu(k,748) * lu(k,747) - lu(k,749) = lu(k,749) * lu(k,747) - lu(k,750) = lu(k,750) * lu(k,747) - lu(k,751) = lu(k,751) * lu(k,747) - lu(k,752) = lu(k,752) * lu(k,747) - lu(k,753) = lu(k,753) * lu(k,747) - lu(k,754) = lu(k,754) * lu(k,747) - lu(k,755) = lu(k,755) * lu(k,747) - lu(k,756) = lu(k,756) * lu(k,747) - lu(k,757) = lu(k,757) * lu(k,747) - lu(k,758) = lu(k,758) * lu(k,747) - lu(k,759) = lu(k,759) * lu(k,747) - lu(k,760) = lu(k,760) * lu(k,747) - lu(k,761) = lu(k,761) * lu(k,747) - lu(k,762) = lu(k,762) * lu(k,747) - lu(k,763) = lu(k,763) * lu(k,747) - lu(k,764) = lu(k,764) * lu(k,747) - lu(k,765) = lu(k,765) * lu(k,747) - lu(k,766) = lu(k,766) * lu(k,747) - lu(k,767) = lu(k,767) * lu(k,747) - lu(k,794) = lu(k,794) - lu(k,748) * lu(k,793) - lu(k,796) = lu(k,796) - lu(k,749) * lu(k,793) - lu(k,797) = lu(k,797) - lu(k,750) * lu(k,793) - lu(k,798) = lu(k,798) - lu(k,751) * lu(k,793) - lu(k,799) = lu(k,799) - lu(k,752) * lu(k,793) - lu(k,800) = lu(k,800) - lu(k,753) * lu(k,793) - lu(k,801) = lu(k,801) - lu(k,754) * lu(k,793) - lu(k,802) = lu(k,802) - lu(k,755) * lu(k,793) - lu(k,803) = lu(k,803) - lu(k,756) * lu(k,793) - lu(k,804) = lu(k,804) - lu(k,757) * lu(k,793) - lu(k,805) = lu(k,805) - lu(k,758) * lu(k,793) - lu(k,806) = lu(k,806) - lu(k,759) * lu(k,793) - lu(k,807) = lu(k,807) - lu(k,760) * lu(k,793) - lu(k,808) = lu(k,808) - lu(k,761) * lu(k,793) - lu(k,809) = lu(k,809) - lu(k,762) * lu(k,793) - lu(k,810) = lu(k,810) - lu(k,763) * lu(k,793) - lu(k,811) = lu(k,811) - lu(k,764) * lu(k,793) - lu(k,812) = lu(k,812) - lu(k,765) * lu(k,793) - lu(k,813) = lu(k,813) - lu(k,766) * lu(k,793) - lu(k,814) = lu(k,814) - lu(k,767) * lu(k,793) - lu(k,897) = lu(k,897) - lu(k,748) * lu(k,896) - lu(k,902) = lu(k,902) - lu(k,749) * lu(k,896) - lu(k,903) = lu(k,903) - lu(k,750) * lu(k,896) - lu(k,904) = lu(k,904) - lu(k,751) * lu(k,896) - lu(k,905) = lu(k,905) - lu(k,752) * lu(k,896) - lu(k,906) = lu(k,906) - lu(k,753) * lu(k,896) - lu(k,907) = lu(k,907) - lu(k,754) * lu(k,896) - lu(k,908) = lu(k,908) - lu(k,755) * lu(k,896) - lu(k,909) = lu(k,909) - lu(k,756) * lu(k,896) - lu(k,910) = lu(k,910) - lu(k,757) * lu(k,896) - lu(k,911) = lu(k,911) - lu(k,758) * lu(k,896) - lu(k,912) = lu(k,912) - lu(k,759) * lu(k,896) - lu(k,913) = lu(k,913) - lu(k,760) * lu(k,896) - lu(k,914) = lu(k,914) - lu(k,761) * lu(k,896) - lu(k,915) = lu(k,915) - lu(k,762) * lu(k,896) - lu(k,917) = lu(k,917) - lu(k,763) * lu(k,896) - lu(k,918) = lu(k,918) - lu(k,764) * lu(k,896) - lu(k,920) = lu(k,920) - lu(k,765) * lu(k,896) - lu(k,921) = lu(k,921) - lu(k,766) * lu(k,896) - lu(k,922) = lu(k,922) - lu(k,767) * lu(k,896) - lu(k,939) = lu(k,939) - lu(k,748) * lu(k,938) - lu(k,944) = lu(k,944) - lu(k,749) * lu(k,938) - lu(k,945) = lu(k,945) - lu(k,750) * lu(k,938) - lu(k,946) = lu(k,946) - lu(k,751) * lu(k,938) - lu(k,947) = lu(k,947) - lu(k,752) * lu(k,938) - lu(k,948) = lu(k,948) - lu(k,753) * lu(k,938) - lu(k,949) = lu(k,949) - lu(k,754) * lu(k,938) - lu(k,950) = lu(k,950) - lu(k,755) * lu(k,938) - lu(k,951) = lu(k,951) - lu(k,756) * lu(k,938) - lu(k,952) = lu(k,952) - lu(k,757) * lu(k,938) - lu(k,953) = lu(k,953) - lu(k,758) * lu(k,938) - lu(k,954) = lu(k,954) - lu(k,759) * lu(k,938) - lu(k,955) = lu(k,955) - lu(k,760) * lu(k,938) - lu(k,956) = lu(k,956) - lu(k,761) * lu(k,938) - lu(k,957) = lu(k,957) - lu(k,762) * lu(k,938) - lu(k,959) = lu(k,959) - lu(k,763) * lu(k,938) - lu(k,960) = lu(k,960) - lu(k,764) * lu(k,938) - lu(k,962) = lu(k,962) - lu(k,765) * lu(k,938) - lu(k,963) = lu(k,963) - lu(k,766) * lu(k,938) - lu(k,964) = lu(k,964) - lu(k,767) * lu(k,938) - lu(k,985) = lu(k,985) - lu(k,748) * lu(k,984) - lu(k,990) = lu(k,990) - lu(k,749) * lu(k,984) - lu(k,991) = lu(k,991) - lu(k,750) * lu(k,984) - lu(k,992) = lu(k,992) - lu(k,751) * lu(k,984) - lu(k,993) = lu(k,993) - lu(k,752) * lu(k,984) - lu(k,994) = lu(k,994) - lu(k,753) * lu(k,984) - lu(k,995) = lu(k,995) - lu(k,754) * lu(k,984) - lu(k,996) = lu(k,996) - lu(k,755) * lu(k,984) - lu(k,997) = lu(k,997) - lu(k,756) * lu(k,984) - lu(k,998) = lu(k,998) - lu(k,757) * lu(k,984) - lu(k,999) = lu(k,999) - lu(k,758) * lu(k,984) - lu(k,1000) = lu(k,1000) - lu(k,759) * lu(k,984) - lu(k,1001) = lu(k,1001) - lu(k,760) * lu(k,984) - lu(k,1002) = lu(k,1002) - lu(k,761) * lu(k,984) - lu(k,1003) = lu(k,1003) - lu(k,762) * lu(k,984) - lu(k,1005) = lu(k,1005) - lu(k,763) * lu(k,984) - lu(k,1006) = lu(k,1006) - lu(k,764) * lu(k,984) - lu(k,1008) = lu(k,1008) - lu(k,765) * lu(k,984) - lu(k,1009) = lu(k,1009) - lu(k,766) * lu(k,984) - lu(k,1010) = lu(k,1010) - lu(k,767) * lu(k,984) - lu(k,1027) = lu(k,1027) - lu(k,748) * lu(k,1026) - lu(k,1032) = lu(k,1032) - lu(k,749) * lu(k,1026) - lu(k,1033) = lu(k,1033) - lu(k,750) * lu(k,1026) - lu(k,1034) = lu(k,1034) - lu(k,751) * lu(k,1026) - lu(k,1035) = lu(k,1035) - lu(k,752) * lu(k,1026) - lu(k,1036) = lu(k,1036) - lu(k,753) * lu(k,1026) - lu(k,1037) = lu(k,1037) - lu(k,754) * lu(k,1026) - lu(k,1038) = lu(k,1038) - lu(k,755) * lu(k,1026) - lu(k,1039) = lu(k,1039) - lu(k,756) * lu(k,1026) - lu(k,1040) = lu(k,1040) - lu(k,757) * lu(k,1026) - lu(k,1041) = lu(k,1041) - lu(k,758) * lu(k,1026) - lu(k,1042) = lu(k,1042) - lu(k,759) * lu(k,1026) - lu(k,1043) = lu(k,1043) - lu(k,760) * lu(k,1026) - lu(k,1044) = lu(k,1044) - lu(k,761) * lu(k,1026) - lu(k,1045) = lu(k,1045) - lu(k,762) * lu(k,1026) - lu(k,1047) = lu(k,1047) - lu(k,763) * lu(k,1026) - lu(k,1048) = lu(k,1048) - lu(k,764) * lu(k,1026) - lu(k,1050) = lu(k,1050) - lu(k,765) * lu(k,1026) - lu(k,1051) = lu(k,1051) - lu(k,766) * lu(k,1026) - lu(k,1052) = lu(k,1052) - lu(k,767) * lu(k,1026) - lu(k,1068) = lu(k,1068) - lu(k,748) * lu(k,1067) - lu(k,1073) = lu(k,1073) - lu(k,749) * lu(k,1067) - lu(k,1074) = lu(k,1074) - lu(k,750) * lu(k,1067) - lu(k,1075) = lu(k,1075) - lu(k,751) * lu(k,1067) - lu(k,1076) = lu(k,1076) - lu(k,752) * lu(k,1067) - lu(k,1077) = lu(k,1077) - lu(k,753) * lu(k,1067) - lu(k,1078) = lu(k,1078) - lu(k,754) * lu(k,1067) - lu(k,1079) = lu(k,1079) - lu(k,755) * lu(k,1067) - lu(k,1080) = lu(k,1080) - lu(k,756) * lu(k,1067) - lu(k,1081) = lu(k,1081) - lu(k,757) * lu(k,1067) - lu(k,1082) = lu(k,1082) - lu(k,758) * lu(k,1067) - lu(k,1083) = lu(k,1083) - lu(k,759) * lu(k,1067) - lu(k,1084) = lu(k,1084) - lu(k,760) * lu(k,1067) - lu(k,1085) = lu(k,1085) - lu(k,761) * lu(k,1067) - lu(k,1086) = lu(k,1086) - lu(k,762) * lu(k,1067) - lu(k,1088) = lu(k,1088) - lu(k,763) * lu(k,1067) - lu(k,1089) = lu(k,1089) - lu(k,764) * lu(k,1067) - lu(k,1091) = lu(k,1091) - lu(k,765) * lu(k,1067) - lu(k,1092) = lu(k,1092) - lu(k,766) * lu(k,1067) - lu(k,1093) = lu(k,1093) - lu(k,767) * lu(k,1067) - lu(k,1108) = lu(k,1108) - lu(k,748) * lu(k,1107) - lu(k,1112) = lu(k,1112) - lu(k,749) * lu(k,1107) - lu(k,1113) = lu(k,1113) - lu(k,750) * lu(k,1107) - lu(k,1114) = lu(k,1114) - lu(k,751) * lu(k,1107) - lu(k,1115) = lu(k,1115) - lu(k,752) * lu(k,1107) - lu(k,1116) = lu(k,1116) - lu(k,753) * lu(k,1107) - lu(k,1117) = lu(k,1117) - lu(k,754) * lu(k,1107) - lu(k,1118) = lu(k,1118) - lu(k,755) * lu(k,1107) - lu(k,1119) = lu(k,1119) - lu(k,756) * lu(k,1107) - lu(k,1120) = lu(k,1120) - lu(k,757) * lu(k,1107) - lu(k,1121) = lu(k,1121) - lu(k,758) * lu(k,1107) - lu(k,1122) = lu(k,1122) - lu(k,759) * lu(k,1107) - lu(k,1123) = lu(k,1123) - lu(k,760) * lu(k,1107) - lu(k,1124) = lu(k,1124) - lu(k,761) * lu(k,1107) - lu(k,1125) = lu(k,1125) - lu(k,762) * lu(k,1107) - lu(k,1127) = lu(k,1127) - lu(k,763) * lu(k,1107) - lu(k,1128) = lu(k,1128) - lu(k,764) * lu(k,1107) - lu(k,1130) = lu(k,1130) - lu(k,765) * lu(k,1107) - lu(k,1131) = lu(k,1131) - lu(k,766) * lu(k,1107) - lu(k,1132) = lu(k,1132) - lu(k,767) * lu(k,1107) - lu(k,1151) = lu(k,1151) - lu(k,748) * lu(k,1150) - lu(k,1156) = lu(k,1156) - lu(k,749) * lu(k,1150) - lu(k,1157) = lu(k,1157) - lu(k,750) * lu(k,1150) - lu(k,1158) = lu(k,1158) - lu(k,751) * lu(k,1150) - lu(k,1159) = lu(k,1159) - lu(k,752) * lu(k,1150) - lu(k,1160) = lu(k,1160) - lu(k,753) * lu(k,1150) - lu(k,1161) = lu(k,1161) - lu(k,754) * lu(k,1150) - lu(k,1162) = lu(k,1162) - lu(k,755) * lu(k,1150) - lu(k,1163) = lu(k,1163) - lu(k,756) * lu(k,1150) - lu(k,1164) = lu(k,1164) - lu(k,757) * lu(k,1150) - lu(k,1165) = lu(k,1165) - lu(k,758) * lu(k,1150) - lu(k,1166) = lu(k,1166) - lu(k,759) * lu(k,1150) - lu(k,1167) = lu(k,1167) - lu(k,760) * lu(k,1150) - lu(k,1168) = lu(k,1168) - lu(k,761) * lu(k,1150) - lu(k,1169) = lu(k,1169) - lu(k,762) * lu(k,1150) - lu(k,1171) = lu(k,1171) - lu(k,763) * lu(k,1150) - lu(k,1172) = lu(k,1172) - lu(k,764) * lu(k,1150) - lu(k,1174) = lu(k,1174) - lu(k,765) * lu(k,1150) - lu(k,1175) = lu(k,1175) - lu(k,766) * lu(k,1150) - lu(k,1176) = lu(k,1176) - lu(k,767) * lu(k,1150) - lu(k,1192) = lu(k,1192) - lu(k,748) * lu(k,1191) - lu(k,1197) = lu(k,1197) - lu(k,749) * lu(k,1191) - lu(k,1198) = lu(k,1198) - lu(k,750) * lu(k,1191) - lu(k,1199) = lu(k,1199) - lu(k,751) * lu(k,1191) - lu(k,1200) = lu(k,1200) - lu(k,752) * lu(k,1191) - lu(k,1201) = lu(k,1201) - lu(k,753) * lu(k,1191) - lu(k,1202) = lu(k,1202) - lu(k,754) * lu(k,1191) - lu(k,1203) = lu(k,1203) - lu(k,755) * lu(k,1191) - lu(k,1204) = lu(k,1204) - lu(k,756) * lu(k,1191) - lu(k,1205) = lu(k,1205) - lu(k,757) * lu(k,1191) - lu(k,1206) = lu(k,1206) - lu(k,758) * lu(k,1191) - lu(k,1207) = lu(k,1207) - lu(k,759) * lu(k,1191) - lu(k,1208) = lu(k,1208) - lu(k,760) * lu(k,1191) - lu(k,1209) = lu(k,1209) - lu(k,761) * lu(k,1191) - lu(k,1210) = lu(k,1210) - lu(k,762) * lu(k,1191) - lu(k,1212) = lu(k,1212) - lu(k,763) * lu(k,1191) - lu(k,1213) = lu(k,1213) - lu(k,764) * lu(k,1191) - lu(k,1215) = lu(k,1215) - lu(k,765) * lu(k,1191) - lu(k,1216) = lu(k,1216) - lu(k,766) * lu(k,1191) - lu(k,1217) = lu(k,1217) - lu(k,767) * lu(k,1191) - lu(k,1241) = lu(k,1241) - lu(k,748) * lu(k,1240) - lu(k,1246) = lu(k,1246) - lu(k,749) * lu(k,1240) - lu(k,1247) = lu(k,1247) - lu(k,750) * lu(k,1240) - lu(k,1248) = lu(k,1248) - lu(k,751) * lu(k,1240) - lu(k,1249) = lu(k,1249) - lu(k,752) * lu(k,1240) - lu(k,1250) = lu(k,1250) - lu(k,753) * lu(k,1240) - lu(k,1251) = lu(k,1251) - lu(k,754) * lu(k,1240) - lu(k,1252) = lu(k,1252) - lu(k,755) * lu(k,1240) - lu(k,1253) = lu(k,1253) - lu(k,756) * lu(k,1240) - lu(k,1254) = lu(k,1254) - lu(k,757) * lu(k,1240) - lu(k,1255) = lu(k,1255) - lu(k,758) * lu(k,1240) - lu(k,1256) = lu(k,1256) - lu(k,759) * lu(k,1240) - lu(k,1257) = lu(k,1257) - lu(k,760) * lu(k,1240) - lu(k,1258) = lu(k,1258) - lu(k,761) * lu(k,1240) - lu(k,1259) = lu(k,1259) - lu(k,762) * lu(k,1240) - lu(k,1261) = lu(k,1261) - lu(k,763) * lu(k,1240) - lu(k,1262) = lu(k,1262) - lu(k,764) * lu(k,1240) - lu(k,1264) = lu(k,1264) - lu(k,765) * lu(k,1240) - lu(k,1265) = lu(k,1265) - lu(k,766) * lu(k,1240) - lu(k,1266) = lu(k,1266) - lu(k,767) * lu(k,1240) - lu(k,1280) = lu(k,1280) - lu(k,748) * lu(k,1279) - lu(k,1285) = lu(k,1285) - lu(k,749) * lu(k,1279) - lu(k,1286) = lu(k,1286) - lu(k,750) * lu(k,1279) - lu(k,1287) = lu(k,1287) - lu(k,751) * lu(k,1279) - lu(k,1288) = lu(k,1288) - lu(k,752) * lu(k,1279) - lu(k,1289) = lu(k,1289) - lu(k,753) * lu(k,1279) - lu(k,1290) = lu(k,1290) - lu(k,754) * lu(k,1279) - lu(k,1291) = lu(k,1291) - lu(k,755) * lu(k,1279) - lu(k,1292) = lu(k,1292) - lu(k,756) * lu(k,1279) - lu(k,1293) = lu(k,1293) - lu(k,757) * lu(k,1279) - lu(k,1294) = lu(k,1294) - lu(k,758) * lu(k,1279) - lu(k,1295) = lu(k,1295) - lu(k,759) * lu(k,1279) - lu(k,1296) = lu(k,1296) - lu(k,760) * lu(k,1279) - lu(k,1297) = lu(k,1297) - lu(k,761) * lu(k,1279) - lu(k,1298) = lu(k,1298) - lu(k,762) * lu(k,1279) - lu(k,1300) = lu(k,1300) - lu(k,763) * lu(k,1279) - lu(k,1301) = lu(k,1301) - lu(k,764) * lu(k,1279) - lu(k,1303) = lu(k,1303) - lu(k,765) * lu(k,1279) - lu(k,1304) = lu(k,1304) - lu(k,766) * lu(k,1279) - lu(k,1305) = lu(k,1305) - lu(k,767) * lu(k,1279) - lu(k,1315) = lu(k,1315) - lu(k,748) * lu(k,1314) - lu(k,1320) = lu(k,1320) - lu(k,749) * lu(k,1314) - lu(k,1321) = lu(k,1321) - lu(k,750) * lu(k,1314) - lu(k,1322) = lu(k,1322) - lu(k,751) * lu(k,1314) - lu(k,1323) = lu(k,1323) - lu(k,752) * lu(k,1314) - lu(k,1324) = lu(k,1324) - lu(k,753) * lu(k,1314) - lu(k,1325) = lu(k,1325) - lu(k,754) * lu(k,1314) - lu(k,1326) = lu(k,1326) - lu(k,755) * lu(k,1314) - lu(k,1327) = lu(k,1327) - lu(k,756) * lu(k,1314) - lu(k,1328) = lu(k,1328) - lu(k,757) * lu(k,1314) - lu(k,1329) = lu(k,1329) - lu(k,758) * lu(k,1314) - lu(k,1330) = lu(k,1330) - lu(k,759) * lu(k,1314) - lu(k,1331) = lu(k,1331) - lu(k,760) * lu(k,1314) - lu(k,1332) = lu(k,1332) - lu(k,761) * lu(k,1314) - lu(k,1333) = lu(k,1333) - lu(k,762) * lu(k,1314) - lu(k,1335) = lu(k,1335) - lu(k,763) * lu(k,1314) - lu(k,1336) = lu(k,1336) - lu(k,764) * lu(k,1314) - lu(k,1338) = lu(k,1338) - lu(k,765) * lu(k,1314) - lu(k,1339) = lu(k,1339) - lu(k,766) * lu(k,1314) - lu(k,1340) = lu(k,1340) - lu(k,767) * lu(k,1314) - lu(k,1359) = lu(k,1359) - lu(k,748) * lu(k,1358) - lu(k,1364) = lu(k,1364) - lu(k,749) * lu(k,1358) - lu(k,1365) = lu(k,1365) - lu(k,750) * lu(k,1358) - lu(k,1366) = lu(k,1366) - lu(k,751) * lu(k,1358) - lu(k,1367) = lu(k,1367) - lu(k,752) * lu(k,1358) - lu(k,1368) = lu(k,1368) - lu(k,753) * lu(k,1358) - lu(k,1369) = lu(k,1369) - lu(k,754) * lu(k,1358) - lu(k,1370) = lu(k,1370) - lu(k,755) * lu(k,1358) - lu(k,1371) = lu(k,1371) - lu(k,756) * lu(k,1358) - lu(k,1372) = lu(k,1372) - lu(k,757) * lu(k,1358) - lu(k,1373) = lu(k,1373) - lu(k,758) * lu(k,1358) - lu(k,1374) = lu(k,1374) - lu(k,759) * lu(k,1358) - lu(k,1375) = lu(k,1375) - lu(k,760) * lu(k,1358) - lu(k,1376) = lu(k,1376) - lu(k,761) * lu(k,1358) - lu(k,1377) = lu(k,1377) - lu(k,762) * lu(k,1358) - lu(k,1379) = lu(k,1379) - lu(k,763) * lu(k,1358) - lu(k,1380) = lu(k,1380) - lu(k,764) * lu(k,1358) - lu(k,1382) = lu(k,1382) - lu(k,765) * lu(k,1358) - lu(k,1383) = lu(k,1383) - lu(k,766) * lu(k,1358) - lu(k,1384) = lu(k,1384) - lu(k,767) * lu(k,1358) - lu(k,1418) = lu(k,1418) - lu(k,748) * lu(k,1417) - lu(k,1423) = lu(k,1423) - lu(k,749) * lu(k,1417) - lu(k,1424) = lu(k,1424) - lu(k,750) * lu(k,1417) - lu(k,1425) = lu(k,1425) - lu(k,751) * lu(k,1417) - lu(k,1426) = lu(k,1426) - lu(k,752) * lu(k,1417) - lu(k,1427) = lu(k,1427) - lu(k,753) * lu(k,1417) - lu(k,1428) = lu(k,1428) - lu(k,754) * lu(k,1417) - lu(k,1429) = lu(k,1429) - lu(k,755) * lu(k,1417) - lu(k,1430) = lu(k,1430) - lu(k,756) * lu(k,1417) - lu(k,1431) = lu(k,1431) - lu(k,757) * lu(k,1417) - lu(k,1432) = lu(k,1432) - lu(k,758) * lu(k,1417) - lu(k,1433) = lu(k,1433) - lu(k,759) * lu(k,1417) - lu(k,1434) = lu(k,1434) - lu(k,760) * lu(k,1417) - lu(k,1435) = lu(k,1435) - lu(k,761) * lu(k,1417) - lu(k,1436) = lu(k,1436) - lu(k,762) * lu(k,1417) - lu(k,1438) = lu(k,1438) - lu(k,763) * lu(k,1417) - lu(k,1439) = lu(k,1439) - lu(k,764) * lu(k,1417) - lu(k,1441) = lu(k,1441) - lu(k,765) * lu(k,1417) - lu(k,1442) = lu(k,1442) - lu(k,766) * lu(k,1417) - lu(k,1443) = lu(k,1443) - lu(k,767) * lu(k,1417) - lu(k,1460) = lu(k,1460) - lu(k,748) * lu(k,1459) - lu(k,1465) = lu(k,1465) - lu(k,749) * lu(k,1459) - lu(k,1466) = lu(k,1466) - lu(k,750) * lu(k,1459) - lu(k,1467) = lu(k,1467) - lu(k,751) * lu(k,1459) - lu(k,1468) = lu(k,1468) - lu(k,752) * lu(k,1459) - lu(k,1469) = lu(k,1469) - lu(k,753) * lu(k,1459) - lu(k,1470) = lu(k,1470) - lu(k,754) * lu(k,1459) - lu(k,1471) = lu(k,1471) - lu(k,755) * lu(k,1459) - lu(k,1472) = lu(k,1472) - lu(k,756) * lu(k,1459) - lu(k,1473) = lu(k,1473) - lu(k,757) * lu(k,1459) - lu(k,1474) = lu(k,1474) - lu(k,758) * lu(k,1459) - lu(k,1475) = lu(k,1475) - lu(k,759) * lu(k,1459) - lu(k,1476) = lu(k,1476) - lu(k,760) * lu(k,1459) - lu(k,1477) = lu(k,1477) - lu(k,761) * lu(k,1459) - lu(k,1478) = lu(k,1478) - lu(k,762) * lu(k,1459) - lu(k,1480) = lu(k,1480) - lu(k,763) * lu(k,1459) - lu(k,1481) = lu(k,1481) - lu(k,764) * lu(k,1459) - lu(k,1483) = lu(k,1483) - lu(k,765) * lu(k,1459) - lu(k,1484) = lu(k,1484) - lu(k,766) * lu(k,1459) - lu(k,1485) = lu(k,1485) - lu(k,767) * lu(k,1459) - lu(k,1501) = lu(k,1501) - lu(k,748) * lu(k,1500) - lu(k,1506) = lu(k,1506) - lu(k,749) * lu(k,1500) - lu(k,1507) = lu(k,1507) - lu(k,750) * lu(k,1500) - lu(k,1508) = lu(k,1508) - lu(k,751) * lu(k,1500) - lu(k,1509) = lu(k,1509) - lu(k,752) * lu(k,1500) - lu(k,1510) = lu(k,1510) - lu(k,753) * lu(k,1500) - lu(k,1511) = lu(k,1511) - lu(k,754) * lu(k,1500) - lu(k,1512) = lu(k,1512) - lu(k,755) * lu(k,1500) - lu(k,1513) = lu(k,1513) - lu(k,756) * lu(k,1500) - lu(k,1514) = lu(k,1514) - lu(k,757) * lu(k,1500) - lu(k,1515) = lu(k,1515) - lu(k,758) * lu(k,1500) - lu(k,1516) = lu(k,1516) - lu(k,759) * lu(k,1500) - lu(k,1517) = lu(k,1517) - lu(k,760) * lu(k,1500) - lu(k,1518) = lu(k,1518) - lu(k,761) * lu(k,1500) - lu(k,1519) = lu(k,1519) - lu(k,762) * lu(k,1500) - lu(k,1521) = lu(k,1521) - lu(k,763) * lu(k,1500) - lu(k,1522) = lu(k,1522) - lu(k,764) * lu(k,1500) - lu(k,1524) = lu(k,1524) - lu(k,765) * lu(k,1500) - lu(k,1525) = lu(k,1525) - lu(k,766) * lu(k,1500) - lu(k,1526) = lu(k,1526) - lu(k,767) * lu(k,1500) - lu(k,1545) = lu(k,1545) - lu(k,748) * lu(k,1544) - lu(k,1548) = lu(k,1548) - lu(k,749) * lu(k,1544) - lu(k,1549) = lu(k,1549) - lu(k,750) * lu(k,1544) - lu(k,1550) = lu(k,1550) - lu(k,751) * lu(k,1544) - lu(k,1551) = lu(k,1551) - lu(k,752) * lu(k,1544) - lu(k,1552) = lu(k,1552) - lu(k,753) * lu(k,1544) - lu(k,1553) = lu(k,1553) - lu(k,754) * lu(k,1544) - lu(k,1554) = lu(k,1554) - lu(k,755) * lu(k,1544) - lu(k,1555) = lu(k,1555) - lu(k,756) * lu(k,1544) - lu(k,1556) = lu(k,1556) - lu(k,757) * lu(k,1544) - lu(k,1557) = lu(k,1557) - lu(k,758) * lu(k,1544) - lu(k,1558) = lu(k,1558) - lu(k,759) * lu(k,1544) - lu(k,1559) = lu(k,1559) - lu(k,760) * lu(k,1544) - lu(k,1560) = lu(k,1560) - lu(k,761) * lu(k,1544) - lu(k,1561) = lu(k,1561) - lu(k,762) * lu(k,1544) - lu(k,1563) = lu(k,1563) - lu(k,763) * lu(k,1544) - lu(k,1564) = lu(k,1564) - lu(k,764) * lu(k,1544) - lu(k,1566) = lu(k,1566) - lu(k,765) * lu(k,1544) - lu(k,1567) = lu(k,1567) - lu(k,766) * lu(k,1544) - lu(k,1568) = lu(k,1568) - lu(k,767) * lu(k,1544) - lu(k,1585) = lu(k,1585) - lu(k,748) * lu(k,1584) - lu(k,1590) = lu(k,1590) - lu(k,749) * lu(k,1584) - lu(k,1591) = lu(k,1591) - lu(k,750) * lu(k,1584) - lu(k,1592) = lu(k,1592) - lu(k,751) * lu(k,1584) - lu(k,1593) = lu(k,1593) - lu(k,752) * lu(k,1584) - lu(k,1594) = lu(k,1594) - lu(k,753) * lu(k,1584) - lu(k,1595) = lu(k,1595) - lu(k,754) * lu(k,1584) - lu(k,1596) = lu(k,1596) - lu(k,755) * lu(k,1584) - lu(k,1597) = lu(k,1597) - lu(k,756) * lu(k,1584) - lu(k,1598) = lu(k,1598) - lu(k,757) * lu(k,1584) - lu(k,1599) = lu(k,1599) - lu(k,758) * lu(k,1584) - lu(k,1600) = lu(k,1600) - lu(k,759) * lu(k,1584) - lu(k,1601) = lu(k,1601) - lu(k,760) * lu(k,1584) - lu(k,1602) = lu(k,1602) - lu(k,761) * lu(k,1584) - lu(k,1603) = lu(k,1603) - lu(k,762) * lu(k,1584) - lu(k,1605) = lu(k,1605) - lu(k,763) * lu(k,1584) - lu(k,1606) = lu(k,1606) - lu(k,764) * lu(k,1584) - lu(k,1608) = lu(k,1608) - lu(k,765) * lu(k,1584) - lu(k,1609) = lu(k,1609) - lu(k,766) * lu(k,1584) - lu(k,1610) = lu(k,1610) - lu(k,767) * lu(k,1584) - lu(k,1617) = lu(k,1617) - lu(k,748) * lu(k,1616) - lu(k,1622) = lu(k,1622) - lu(k,749) * lu(k,1616) - lu(k,1623) = lu(k,1623) - lu(k,750) * lu(k,1616) - lu(k,1624) = lu(k,1624) - lu(k,751) * lu(k,1616) - lu(k,1625) = lu(k,1625) - lu(k,752) * lu(k,1616) - lu(k,1626) = lu(k,1626) - lu(k,753) * lu(k,1616) - lu(k,1627) = lu(k,1627) - lu(k,754) * lu(k,1616) - lu(k,1628) = lu(k,1628) - lu(k,755) * lu(k,1616) - lu(k,1629) = lu(k,1629) - lu(k,756) * lu(k,1616) - lu(k,1630) = lu(k,1630) - lu(k,757) * lu(k,1616) - lu(k,1631) = lu(k,1631) - lu(k,758) * lu(k,1616) - lu(k,1632) = lu(k,1632) - lu(k,759) * lu(k,1616) - lu(k,1633) = lu(k,1633) - lu(k,760) * lu(k,1616) - lu(k,1634) = lu(k,1634) - lu(k,761) * lu(k,1616) - lu(k,1635) = lu(k,1635) - lu(k,762) * lu(k,1616) - lu(k,1637) = lu(k,1637) - lu(k,763) * lu(k,1616) - lu(k,1638) = lu(k,1638) - lu(k,764) * lu(k,1616) - lu(k,1640) = lu(k,1640) - lu(k,765) * lu(k,1616) - lu(k,1641) = lu(k,1641) - lu(k,766) * lu(k,1616) - lu(k,1642) = lu(k,1642) - lu(k,767) * lu(k,1616) - lu(k,1652) = lu(k,1652) - lu(k,748) * lu(k,1651) - lu(k,1657) = lu(k,1657) - lu(k,749) * lu(k,1651) - lu(k,1658) = lu(k,1658) - lu(k,750) * lu(k,1651) - lu(k,1659) = lu(k,1659) - lu(k,751) * lu(k,1651) - lu(k,1660) = lu(k,1660) - lu(k,752) * lu(k,1651) - lu(k,1661) = lu(k,1661) - lu(k,753) * lu(k,1651) - lu(k,1662) = lu(k,1662) - lu(k,754) * lu(k,1651) - lu(k,1663) = lu(k,1663) - lu(k,755) * lu(k,1651) - lu(k,1664) = lu(k,1664) - lu(k,756) * lu(k,1651) - lu(k,1665) = lu(k,1665) - lu(k,757) * lu(k,1651) - lu(k,1666) = lu(k,1666) - lu(k,758) * lu(k,1651) - lu(k,1667) = lu(k,1667) - lu(k,759) * lu(k,1651) - lu(k,1668) = lu(k,1668) - lu(k,760) * lu(k,1651) - lu(k,1669) = lu(k,1669) - lu(k,761) * lu(k,1651) - lu(k,1670) = lu(k,1670) - lu(k,762) * lu(k,1651) - lu(k,1672) = lu(k,1672) - lu(k,763) * lu(k,1651) - lu(k,1673) = lu(k,1673) - lu(k,764) * lu(k,1651) - lu(k,1675) = lu(k,1675) - lu(k,765) * lu(k,1651) - lu(k,1676) = lu(k,1676) - lu(k,766) * lu(k,1651) - lu(k,1677) = lu(k,1677) - lu(k,767) * lu(k,1651) - lu(k,1694) = lu(k,1694) - lu(k,748) * lu(k,1693) - lu(k,1699) = lu(k,1699) - lu(k,749) * lu(k,1693) - lu(k,1700) = lu(k,1700) - lu(k,750) * lu(k,1693) - lu(k,1701) = lu(k,1701) - lu(k,751) * lu(k,1693) - lu(k,1702) = lu(k,1702) - lu(k,752) * lu(k,1693) - lu(k,1703) = lu(k,1703) - lu(k,753) * lu(k,1693) - lu(k,1704) = lu(k,1704) - lu(k,754) * lu(k,1693) - lu(k,1705) = lu(k,1705) - lu(k,755) * lu(k,1693) - lu(k,1706) = lu(k,1706) - lu(k,756) * lu(k,1693) - lu(k,1707) = lu(k,1707) - lu(k,757) * lu(k,1693) - lu(k,1708) = lu(k,1708) - lu(k,758) * lu(k,1693) - lu(k,1709) = lu(k,1709) - lu(k,759) * lu(k,1693) - lu(k,1710) = lu(k,1710) - lu(k,760) * lu(k,1693) - lu(k,1711) = lu(k,1711) - lu(k,761) * lu(k,1693) - lu(k,1712) = lu(k,1712) - lu(k,762) * lu(k,1693) - lu(k,1714) = lu(k,1714) - lu(k,763) * lu(k,1693) - lu(k,1715) = lu(k,1715) - lu(k,764) * lu(k,1693) - lu(k,1717) = lu(k,1717) - lu(k,765) * lu(k,1693) - lu(k,1718) = lu(k,1718) - lu(k,766) * lu(k,1693) - lu(k,1719) = lu(k,1719) - lu(k,767) * lu(k,1693) - lu(k,1738) = lu(k,1738) - lu(k,748) * lu(k,1737) - lu(k,1743) = lu(k,1743) - lu(k,749) * lu(k,1737) - lu(k,1744) = lu(k,1744) - lu(k,750) * lu(k,1737) - lu(k,1745) = lu(k,1745) - lu(k,751) * lu(k,1737) - lu(k,1746) = lu(k,1746) - lu(k,752) * lu(k,1737) - lu(k,1747) = lu(k,1747) - lu(k,753) * lu(k,1737) - lu(k,1748) = lu(k,1748) - lu(k,754) * lu(k,1737) - lu(k,1749) = lu(k,1749) - lu(k,755) * lu(k,1737) - lu(k,1750) = lu(k,1750) - lu(k,756) * lu(k,1737) - lu(k,1751) = lu(k,1751) - lu(k,757) * lu(k,1737) - lu(k,1752) = lu(k,1752) - lu(k,758) * lu(k,1737) - lu(k,1753) = lu(k,1753) - lu(k,759) * lu(k,1737) - lu(k,1754) = lu(k,1754) - lu(k,760) * lu(k,1737) - lu(k,1755) = lu(k,1755) - lu(k,761) * lu(k,1737) - lu(k,1756) = lu(k,1756) - lu(k,762) * lu(k,1737) - lu(k,1758) = lu(k,1758) - lu(k,763) * lu(k,1737) - lu(k,1759) = lu(k,1759) - lu(k,764) * lu(k,1737) - lu(k,1761) = lu(k,1761) - lu(k,765) * lu(k,1737) - lu(k,1762) = lu(k,1762) - lu(k,766) * lu(k,1737) - lu(k,1763) = lu(k,1763) - lu(k,767) * lu(k,1737) - lu(k,1773) = lu(k,1773) - lu(k,748) * lu(k,1772) - lu(k,1778) = lu(k,1778) - lu(k,749) * lu(k,1772) - lu(k,1779) = lu(k,1779) - lu(k,750) * lu(k,1772) - lu(k,1780) = lu(k,1780) - lu(k,751) * lu(k,1772) - lu(k,1781) = lu(k,1781) - lu(k,752) * lu(k,1772) - lu(k,1782) = lu(k,1782) - lu(k,753) * lu(k,1772) - lu(k,1783) = lu(k,1783) - lu(k,754) * lu(k,1772) - lu(k,1784) = lu(k,1784) - lu(k,755) * lu(k,1772) - lu(k,1785) = lu(k,1785) - lu(k,756) * lu(k,1772) - lu(k,1786) = lu(k,1786) - lu(k,757) * lu(k,1772) - lu(k,1787) = lu(k,1787) - lu(k,758) * lu(k,1772) - lu(k,1788) = lu(k,1788) - lu(k,759) * lu(k,1772) - lu(k,1789) = lu(k,1789) - lu(k,760) * lu(k,1772) - lu(k,1790) = lu(k,1790) - lu(k,761) * lu(k,1772) - lu(k,1791) = lu(k,1791) - lu(k,762) * lu(k,1772) - lu(k,1793) = lu(k,1793) - lu(k,763) * lu(k,1772) - lu(k,1794) = lu(k,1794) - lu(k,764) * lu(k,1772) - lu(k,1796) = lu(k,1796) - lu(k,765) * lu(k,1772) - lu(k,1797) = lu(k,1797) - lu(k,766) * lu(k,1772) - lu(k,1798) = lu(k,1798) - lu(k,767) * lu(k,1772) - lu(k,1831) = lu(k,1831) - lu(k,748) * lu(k,1830) - lu(k,1836) = lu(k,1836) - lu(k,749) * lu(k,1830) - lu(k,1837) = lu(k,1837) - lu(k,750) * lu(k,1830) - lu(k,1838) = lu(k,1838) - lu(k,751) * lu(k,1830) - lu(k,1839) = lu(k,1839) - lu(k,752) * lu(k,1830) - lu(k,1840) = lu(k,1840) - lu(k,753) * lu(k,1830) - lu(k,1841) = lu(k,1841) - lu(k,754) * lu(k,1830) - lu(k,1842) = lu(k,1842) - lu(k,755) * lu(k,1830) - lu(k,1843) = lu(k,1843) - lu(k,756) * lu(k,1830) - lu(k,1844) = lu(k,1844) - lu(k,757) * lu(k,1830) - lu(k,1845) = lu(k,1845) - lu(k,758) * lu(k,1830) - lu(k,1846) = lu(k,1846) - lu(k,759) * lu(k,1830) - lu(k,1847) = lu(k,1847) - lu(k,760) * lu(k,1830) - lu(k,1848) = lu(k,1848) - lu(k,761) * lu(k,1830) - lu(k,1849) = lu(k,1849) - lu(k,762) * lu(k,1830) - lu(k,1851) = lu(k,1851) - lu(k,763) * lu(k,1830) - lu(k,1852) = lu(k,1852) - lu(k,764) * lu(k,1830) - lu(k,1854) = lu(k,1854) - lu(k,765) * lu(k,1830) - lu(k,1855) = lu(k,1855) - lu(k,766) * lu(k,1830) - lu(k,1856) = lu(k,1856) - lu(k,767) * lu(k,1830) - lu(k,794) = 1._r8 / lu(k,794) - lu(k,795) = lu(k,795) * lu(k,794) - lu(k,796) = lu(k,796) * lu(k,794) - lu(k,797) = lu(k,797) * lu(k,794) - lu(k,798) = lu(k,798) * lu(k,794) - lu(k,799) = lu(k,799) * lu(k,794) - lu(k,800) = lu(k,800) * lu(k,794) - lu(k,801) = lu(k,801) * lu(k,794) - lu(k,802) = lu(k,802) * lu(k,794) - lu(k,803) = lu(k,803) * lu(k,794) - lu(k,804) = lu(k,804) * lu(k,794) - lu(k,805) = lu(k,805) * lu(k,794) - lu(k,806) = lu(k,806) * lu(k,794) - lu(k,807) = lu(k,807) * lu(k,794) - lu(k,808) = lu(k,808) * lu(k,794) - lu(k,809) = lu(k,809) * lu(k,794) - lu(k,810) = lu(k,810) * lu(k,794) - lu(k,811) = lu(k,811) * lu(k,794) - lu(k,812) = lu(k,812) * lu(k,794) - lu(k,813) = lu(k,813) * lu(k,794) - lu(k,814) = lu(k,814) * lu(k,794) - lu(k,824) = lu(k,824) - lu(k,795) * lu(k,821) - lu(k,826) = lu(k,826) - lu(k,796) * lu(k,821) - lu(k,827) = lu(k,827) - lu(k,797) * lu(k,821) - lu(k,828) = lu(k,828) - lu(k,798) * lu(k,821) - lu(k,829) = lu(k,829) - lu(k,799) * lu(k,821) - lu(k,830) = lu(k,830) - lu(k,800) * lu(k,821) - lu(k,831) = lu(k,831) - lu(k,801) * lu(k,821) - lu(k,832) = lu(k,832) - lu(k,802) * lu(k,821) - lu(k,833) = lu(k,833) - lu(k,803) * lu(k,821) - lu(k,834) = lu(k,834) - lu(k,804) * lu(k,821) - lu(k,835) = lu(k,835) - lu(k,805) * lu(k,821) - lu(k,836) = lu(k,836) - lu(k,806) * lu(k,821) - lu(k,837) = lu(k,837) - lu(k,807) * lu(k,821) - lu(k,838) = lu(k,838) - lu(k,808) * lu(k,821) - lu(k,839) = lu(k,839) - lu(k,809) * lu(k,821) - lu(k,841) = lu(k,841) - lu(k,810) * lu(k,821) - lu(k,842) = lu(k,842) - lu(k,811) * lu(k,821) - lu(k,844) = lu(k,844) - lu(k,812) * lu(k,821) - lu(k,845) = lu(k,845) - lu(k,813) * lu(k,821) - lu(k,846) = lu(k,846) - lu(k,814) * lu(k,821) - lu(k,853) = lu(k,853) - lu(k,795) * lu(k,851) - lu(k,855) = lu(k,855) - lu(k,796) * lu(k,851) - lu(k,856) = lu(k,856) - lu(k,797) * lu(k,851) - lu(k,857) = lu(k,857) - lu(k,798) * lu(k,851) - lu(k,858) = lu(k,858) - lu(k,799) * lu(k,851) - lu(k,859) = lu(k,859) - lu(k,800) * lu(k,851) - lu(k,860) = lu(k,860) - lu(k,801) * lu(k,851) - lu(k,861) = lu(k,861) - lu(k,802) * lu(k,851) - lu(k,862) = lu(k,862) - lu(k,803) * lu(k,851) - lu(k,863) = - lu(k,804) * lu(k,851) - lu(k,864) = lu(k,864) - lu(k,805) * lu(k,851) - lu(k,865) = lu(k,865) - lu(k,806) * lu(k,851) - lu(k,866) = lu(k,866) - lu(k,807) * lu(k,851) - lu(k,867) = lu(k,867) - lu(k,808) * lu(k,851) - lu(k,868) = lu(k,868) - lu(k,809) * lu(k,851) - lu(k,870) = lu(k,870) - lu(k,810) * lu(k,851) - lu(k,871) = - lu(k,811) * lu(k,851) - lu(k,873) = lu(k,873) - lu(k,812) * lu(k,851) - lu(k,874) = lu(k,874) - lu(k,813) * lu(k,851) - lu(k,875) = lu(k,875) - lu(k,814) * lu(k,851) - lu(k,900) = lu(k,900) - lu(k,795) * lu(k,897) - lu(k,902) = lu(k,902) - lu(k,796) * lu(k,897) - lu(k,903) = lu(k,903) - lu(k,797) * lu(k,897) - lu(k,904) = lu(k,904) - lu(k,798) * lu(k,897) - lu(k,905) = lu(k,905) - lu(k,799) * lu(k,897) - lu(k,906) = lu(k,906) - lu(k,800) * lu(k,897) - lu(k,907) = lu(k,907) - lu(k,801) * lu(k,897) - lu(k,908) = lu(k,908) - lu(k,802) * lu(k,897) - lu(k,909) = lu(k,909) - lu(k,803) * lu(k,897) - lu(k,910) = lu(k,910) - lu(k,804) * lu(k,897) - lu(k,911) = lu(k,911) - lu(k,805) * lu(k,897) - lu(k,912) = lu(k,912) - lu(k,806) * lu(k,897) - lu(k,913) = lu(k,913) - lu(k,807) * lu(k,897) - lu(k,914) = lu(k,914) - lu(k,808) * lu(k,897) - lu(k,915) = lu(k,915) - lu(k,809) * lu(k,897) - lu(k,917) = lu(k,917) - lu(k,810) * lu(k,897) - lu(k,918) = lu(k,918) - lu(k,811) * lu(k,897) - lu(k,920) = lu(k,920) - lu(k,812) * lu(k,897) - lu(k,921) = lu(k,921) - lu(k,813) * lu(k,897) - lu(k,922) = lu(k,922) - lu(k,814) * lu(k,897) - lu(k,942) = lu(k,942) - lu(k,795) * lu(k,939) - lu(k,944) = lu(k,944) - lu(k,796) * lu(k,939) - lu(k,945) = lu(k,945) - lu(k,797) * lu(k,939) - lu(k,946) = lu(k,946) - lu(k,798) * lu(k,939) - lu(k,947) = lu(k,947) - lu(k,799) * lu(k,939) - lu(k,948) = lu(k,948) - lu(k,800) * lu(k,939) - lu(k,949) = lu(k,949) - lu(k,801) * lu(k,939) - lu(k,950) = lu(k,950) - lu(k,802) * lu(k,939) - lu(k,951) = lu(k,951) - lu(k,803) * lu(k,939) - lu(k,952) = lu(k,952) - lu(k,804) * lu(k,939) - lu(k,953) = lu(k,953) - lu(k,805) * lu(k,939) - lu(k,954) = lu(k,954) - lu(k,806) * lu(k,939) - lu(k,955) = lu(k,955) - lu(k,807) * lu(k,939) - lu(k,956) = lu(k,956) - lu(k,808) * lu(k,939) - lu(k,957) = lu(k,957) - lu(k,809) * lu(k,939) - lu(k,959) = lu(k,959) - lu(k,810) * lu(k,939) - lu(k,960) = lu(k,960) - lu(k,811) * lu(k,939) - lu(k,962) = lu(k,962) - lu(k,812) * lu(k,939) - lu(k,963) = lu(k,963) - lu(k,813) * lu(k,939) - lu(k,964) = lu(k,964) - lu(k,814) * lu(k,939) - lu(k,988) = lu(k,988) - lu(k,795) * lu(k,985) - lu(k,990) = lu(k,990) - lu(k,796) * lu(k,985) - lu(k,991) = lu(k,991) - lu(k,797) * lu(k,985) - lu(k,992) = lu(k,992) - lu(k,798) * lu(k,985) - lu(k,993) = lu(k,993) - lu(k,799) * lu(k,985) - lu(k,994) = lu(k,994) - lu(k,800) * lu(k,985) - lu(k,995) = lu(k,995) - lu(k,801) * lu(k,985) - lu(k,996) = lu(k,996) - lu(k,802) * lu(k,985) - lu(k,997) = lu(k,997) - lu(k,803) * lu(k,985) - lu(k,998) = lu(k,998) - lu(k,804) * lu(k,985) - lu(k,999) = lu(k,999) - lu(k,805) * lu(k,985) - lu(k,1000) = lu(k,1000) - lu(k,806) * lu(k,985) - lu(k,1001) = lu(k,1001) - lu(k,807) * lu(k,985) - lu(k,1002) = lu(k,1002) - lu(k,808) * lu(k,985) - lu(k,1003) = lu(k,1003) - lu(k,809) * lu(k,985) - lu(k,1005) = lu(k,1005) - lu(k,810) * lu(k,985) - lu(k,1006) = lu(k,1006) - lu(k,811) * lu(k,985) - lu(k,1008) = lu(k,1008) - lu(k,812) * lu(k,985) - lu(k,1009) = lu(k,1009) - lu(k,813) * lu(k,985) - lu(k,1010) = lu(k,1010) - lu(k,814) * lu(k,985) - lu(k,1030) = lu(k,1030) - lu(k,795) * lu(k,1027) - lu(k,1032) = lu(k,1032) - lu(k,796) * lu(k,1027) - lu(k,1033) = lu(k,1033) - lu(k,797) * lu(k,1027) - lu(k,1034) = lu(k,1034) - lu(k,798) * lu(k,1027) - lu(k,1035) = lu(k,1035) - lu(k,799) * lu(k,1027) - lu(k,1036) = lu(k,1036) - lu(k,800) * lu(k,1027) - lu(k,1037) = lu(k,1037) - lu(k,801) * lu(k,1027) - lu(k,1038) = lu(k,1038) - lu(k,802) * lu(k,1027) - lu(k,1039) = lu(k,1039) - lu(k,803) * lu(k,1027) - lu(k,1040) = lu(k,1040) - lu(k,804) * lu(k,1027) - lu(k,1041) = lu(k,1041) - lu(k,805) * lu(k,1027) - lu(k,1042) = lu(k,1042) - lu(k,806) * lu(k,1027) - lu(k,1043) = lu(k,1043) - lu(k,807) * lu(k,1027) - lu(k,1044) = lu(k,1044) - lu(k,808) * lu(k,1027) - lu(k,1045) = lu(k,1045) - lu(k,809) * lu(k,1027) - lu(k,1047) = lu(k,1047) - lu(k,810) * lu(k,1027) - lu(k,1048) = lu(k,1048) - lu(k,811) * lu(k,1027) - lu(k,1050) = lu(k,1050) - lu(k,812) * lu(k,1027) - lu(k,1051) = lu(k,1051) - lu(k,813) * lu(k,1027) - lu(k,1052) = lu(k,1052) - lu(k,814) * lu(k,1027) - lu(k,1071) = lu(k,1071) - lu(k,795) * lu(k,1068) - lu(k,1073) = lu(k,1073) - lu(k,796) * lu(k,1068) - lu(k,1074) = lu(k,1074) - lu(k,797) * lu(k,1068) - lu(k,1075) = lu(k,1075) - lu(k,798) * lu(k,1068) - lu(k,1076) = lu(k,1076) - lu(k,799) * lu(k,1068) - lu(k,1077) = lu(k,1077) - lu(k,800) * lu(k,1068) - lu(k,1078) = lu(k,1078) - lu(k,801) * lu(k,1068) - lu(k,1079) = lu(k,1079) - lu(k,802) * lu(k,1068) - lu(k,1080) = lu(k,1080) - lu(k,803) * lu(k,1068) - lu(k,1081) = lu(k,1081) - lu(k,804) * lu(k,1068) - lu(k,1082) = lu(k,1082) - lu(k,805) * lu(k,1068) - lu(k,1083) = lu(k,1083) - lu(k,806) * lu(k,1068) - lu(k,1084) = lu(k,1084) - lu(k,807) * lu(k,1068) - lu(k,1085) = lu(k,1085) - lu(k,808) * lu(k,1068) - lu(k,1086) = lu(k,1086) - lu(k,809) * lu(k,1068) - lu(k,1088) = lu(k,1088) - lu(k,810) * lu(k,1068) - lu(k,1089) = lu(k,1089) - lu(k,811) * lu(k,1068) - lu(k,1091) = lu(k,1091) - lu(k,812) * lu(k,1068) - lu(k,1092) = lu(k,1092) - lu(k,813) * lu(k,1068) - lu(k,1093) = lu(k,1093) - lu(k,814) * lu(k,1068) - lu(k,1110) = lu(k,1110) - lu(k,795) * lu(k,1108) - lu(k,1112) = lu(k,1112) - lu(k,796) * lu(k,1108) - lu(k,1113) = lu(k,1113) - lu(k,797) * lu(k,1108) - lu(k,1114) = lu(k,1114) - lu(k,798) * lu(k,1108) - lu(k,1115) = lu(k,1115) - lu(k,799) * lu(k,1108) - lu(k,1116) = lu(k,1116) - lu(k,800) * lu(k,1108) - lu(k,1117) = lu(k,1117) - lu(k,801) * lu(k,1108) - lu(k,1118) = lu(k,1118) - lu(k,802) * lu(k,1108) - lu(k,1119) = lu(k,1119) - lu(k,803) * lu(k,1108) - lu(k,1120) = lu(k,1120) - lu(k,804) * lu(k,1108) - lu(k,1121) = lu(k,1121) - lu(k,805) * lu(k,1108) - lu(k,1122) = lu(k,1122) - lu(k,806) * lu(k,1108) - lu(k,1123) = lu(k,1123) - lu(k,807) * lu(k,1108) - lu(k,1124) = lu(k,1124) - lu(k,808) * lu(k,1108) - lu(k,1125) = lu(k,1125) - lu(k,809) * lu(k,1108) - lu(k,1127) = lu(k,1127) - lu(k,810) * lu(k,1108) - lu(k,1128) = lu(k,1128) - lu(k,811) * lu(k,1108) - lu(k,1130) = lu(k,1130) - lu(k,812) * lu(k,1108) - lu(k,1131) = lu(k,1131) - lu(k,813) * lu(k,1108) - lu(k,1132) = lu(k,1132) - lu(k,814) * lu(k,1108) - lu(k,1154) = lu(k,1154) - lu(k,795) * lu(k,1151) - lu(k,1156) = lu(k,1156) - lu(k,796) * lu(k,1151) - lu(k,1157) = lu(k,1157) - lu(k,797) * lu(k,1151) - lu(k,1158) = lu(k,1158) - lu(k,798) * lu(k,1151) - lu(k,1159) = lu(k,1159) - lu(k,799) * lu(k,1151) - lu(k,1160) = lu(k,1160) - lu(k,800) * lu(k,1151) - lu(k,1161) = lu(k,1161) - lu(k,801) * lu(k,1151) - lu(k,1162) = lu(k,1162) - lu(k,802) * lu(k,1151) - lu(k,1163) = lu(k,1163) - lu(k,803) * lu(k,1151) - lu(k,1164) = lu(k,1164) - lu(k,804) * lu(k,1151) - lu(k,1165) = lu(k,1165) - lu(k,805) * lu(k,1151) - lu(k,1166) = lu(k,1166) - lu(k,806) * lu(k,1151) - lu(k,1167) = lu(k,1167) - lu(k,807) * lu(k,1151) - lu(k,1168) = lu(k,1168) - lu(k,808) * lu(k,1151) - lu(k,1169) = lu(k,1169) - lu(k,809) * lu(k,1151) - lu(k,1171) = lu(k,1171) - lu(k,810) * lu(k,1151) - lu(k,1172) = lu(k,1172) - lu(k,811) * lu(k,1151) - lu(k,1174) = lu(k,1174) - lu(k,812) * lu(k,1151) - lu(k,1175) = lu(k,1175) - lu(k,813) * lu(k,1151) - lu(k,1176) = lu(k,1176) - lu(k,814) * lu(k,1151) - lu(k,1195) = lu(k,1195) - lu(k,795) * lu(k,1192) - lu(k,1197) = lu(k,1197) - lu(k,796) * lu(k,1192) - lu(k,1198) = lu(k,1198) - lu(k,797) * lu(k,1192) - lu(k,1199) = lu(k,1199) - lu(k,798) * lu(k,1192) - lu(k,1200) = lu(k,1200) - lu(k,799) * lu(k,1192) - lu(k,1201) = lu(k,1201) - lu(k,800) * lu(k,1192) - lu(k,1202) = lu(k,1202) - lu(k,801) * lu(k,1192) - lu(k,1203) = lu(k,1203) - lu(k,802) * lu(k,1192) - lu(k,1204) = lu(k,1204) - lu(k,803) * lu(k,1192) - lu(k,1205) = lu(k,1205) - lu(k,804) * lu(k,1192) - lu(k,1206) = lu(k,1206) - lu(k,805) * lu(k,1192) - lu(k,1207) = lu(k,1207) - lu(k,806) * lu(k,1192) - lu(k,1208) = lu(k,1208) - lu(k,807) * lu(k,1192) - lu(k,1209) = lu(k,1209) - lu(k,808) * lu(k,1192) - lu(k,1210) = lu(k,1210) - lu(k,809) * lu(k,1192) - lu(k,1212) = lu(k,1212) - lu(k,810) * lu(k,1192) - lu(k,1213) = lu(k,1213) - lu(k,811) * lu(k,1192) - lu(k,1215) = lu(k,1215) - lu(k,812) * lu(k,1192) - lu(k,1216) = lu(k,1216) - lu(k,813) * lu(k,1192) - lu(k,1217) = lu(k,1217) - lu(k,814) * lu(k,1192) - lu(k,1244) = lu(k,1244) - lu(k,795) * lu(k,1241) - lu(k,1246) = lu(k,1246) - lu(k,796) * lu(k,1241) - lu(k,1247) = lu(k,1247) - lu(k,797) * lu(k,1241) - lu(k,1248) = lu(k,1248) - lu(k,798) * lu(k,1241) - lu(k,1249) = lu(k,1249) - lu(k,799) * lu(k,1241) - lu(k,1250) = lu(k,1250) - lu(k,800) * lu(k,1241) - lu(k,1251) = lu(k,1251) - lu(k,801) * lu(k,1241) - lu(k,1252) = lu(k,1252) - lu(k,802) * lu(k,1241) - lu(k,1253) = lu(k,1253) - lu(k,803) * lu(k,1241) - lu(k,1254) = lu(k,1254) - lu(k,804) * lu(k,1241) - lu(k,1255) = lu(k,1255) - lu(k,805) * lu(k,1241) - lu(k,1256) = lu(k,1256) - lu(k,806) * lu(k,1241) - lu(k,1257) = lu(k,1257) - lu(k,807) * lu(k,1241) - lu(k,1258) = lu(k,1258) - lu(k,808) * lu(k,1241) - lu(k,1259) = lu(k,1259) - lu(k,809) * lu(k,1241) - lu(k,1261) = lu(k,1261) - lu(k,810) * lu(k,1241) - lu(k,1262) = lu(k,1262) - lu(k,811) * lu(k,1241) - lu(k,1264) = lu(k,1264) - lu(k,812) * lu(k,1241) - lu(k,1265) = lu(k,1265) - lu(k,813) * lu(k,1241) - lu(k,1266) = lu(k,1266) - lu(k,814) * lu(k,1241) - lu(k,1283) = lu(k,1283) - lu(k,795) * lu(k,1280) - lu(k,1285) = lu(k,1285) - lu(k,796) * lu(k,1280) - lu(k,1286) = lu(k,1286) - lu(k,797) * lu(k,1280) - lu(k,1287) = lu(k,1287) - lu(k,798) * lu(k,1280) - lu(k,1288) = lu(k,1288) - lu(k,799) * lu(k,1280) - lu(k,1289) = lu(k,1289) - lu(k,800) * lu(k,1280) - lu(k,1290) = lu(k,1290) - lu(k,801) * lu(k,1280) - lu(k,1291) = lu(k,1291) - lu(k,802) * lu(k,1280) - lu(k,1292) = lu(k,1292) - lu(k,803) * lu(k,1280) - lu(k,1293) = lu(k,1293) - lu(k,804) * lu(k,1280) - lu(k,1294) = lu(k,1294) - lu(k,805) * lu(k,1280) - lu(k,1295) = lu(k,1295) - lu(k,806) * lu(k,1280) - lu(k,1296) = lu(k,1296) - lu(k,807) * lu(k,1280) - lu(k,1297) = lu(k,1297) - lu(k,808) * lu(k,1280) - lu(k,1298) = lu(k,1298) - lu(k,809) * lu(k,1280) - lu(k,1300) = lu(k,1300) - lu(k,810) * lu(k,1280) - lu(k,1301) = lu(k,1301) - lu(k,811) * lu(k,1280) - lu(k,1303) = lu(k,1303) - lu(k,812) * lu(k,1280) - lu(k,1304) = lu(k,1304) - lu(k,813) * lu(k,1280) - lu(k,1305) = lu(k,1305) - lu(k,814) * lu(k,1280) - lu(k,1318) = lu(k,1318) - lu(k,795) * lu(k,1315) - lu(k,1320) = lu(k,1320) - lu(k,796) * lu(k,1315) - lu(k,1321) = lu(k,1321) - lu(k,797) * lu(k,1315) - lu(k,1322) = lu(k,1322) - lu(k,798) * lu(k,1315) - lu(k,1323) = lu(k,1323) - lu(k,799) * lu(k,1315) - lu(k,1324) = lu(k,1324) - lu(k,800) * lu(k,1315) - lu(k,1325) = lu(k,1325) - lu(k,801) * lu(k,1315) - lu(k,1326) = lu(k,1326) - lu(k,802) * lu(k,1315) - lu(k,1327) = lu(k,1327) - lu(k,803) * lu(k,1315) - lu(k,1328) = lu(k,1328) - lu(k,804) * lu(k,1315) - lu(k,1329) = lu(k,1329) - lu(k,805) * lu(k,1315) - lu(k,1330) = lu(k,1330) - lu(k,806) * lu(k,1315) - lu(k,1331) = lu(k,1331) - lu(k,807) * lu(k,1315) - lu(k,1332) = lu(k,1332) - lu(k,808) * lu(k,1315) - lu(k,1333) = lu(k,1333) - lu(k,809) * lu(k,1315) - lu(k,1335) = lu(k,1335) - lu(k,810) * lu(k,1315) - lu(k,1336) = lu(k,1336) - lu(k,811) * lu(k,1315) - lu(k,1338) = lu(k,1338) - lu(k,812) * lu(k,1315) - lu(k,1339) = lu(k,1339) - lu(k,813) * lu(k,1315) - lu(k,1340) = lu(k,1340) - lu(k,814) * lu(k,1315) - lu(k,1362) = lu(k,1362) - lu(k,795) * lu(k,1359) - lu(k,1364) = lu(k,1364) - lu(k,796) * lu(k,1359) - lu(k,1365) = lu(k,1365) - lu(k,797) * lu(k,1359) - lu(k,1366) = lu(k,1366) - lu(k,798) * lu(k,1359) - lu(k,1367) = lu(k,1367) - lu(k,799) * lu(k,1359) - lu(k,1368) = lu(k,1368) - lu(k,800) * lu(k,1359) - lu(k,1369) = lu(k,1369) - lu(k,801) * lu(k,1359) - lu(k,1370) = lu(k,1370) - lu(k,802) * lu(k,1359) - lu(k,1371) = lu(k,1371) - lu(k,803) * lu(k,1359) - lu(k,1372) = lu(k,1372) - lu(k,804) * lu(k,1359) - lu(k,1373) = lu(k,1373) - lu(k,805) * lu(k,1359) - lu(k,1374) = lu(k,1374) - lu(k,806) * lu(k,1359) - lu(k,1375) = lu(k,1375) - lu(k,807) * lu(k,1359) - lu(k,1376) = lu(k,1376) - lu(k,808) * lu(k,1359) - lu(k,1377) = lu(k,1377) - lu(k,809) * lu(k,1359) - lu(k,1379) = lu(k,1379) - lu(k,810) * lu(k,1359) - lu(k,1380) = lu(k,1380) - lu(k,811) * lu(k,1359) - lu(k,1382) = lu(k,1382) - lu(k,812) * lu(k,1359) - lu(k,1383) = lu(k,1383) - lu(k,813) * lu(k,1359) - lu(k,1384) = lu(k,1384) - lu(k,814) * lu(k,1359) - lu(k,1421) = lu(k,1421) - lu(k,795) * lu(k,1418) - lu(k,1423) = lu(k,1423) - lu(k,796) * lu(k,1418) - lu(k,1424) = lu(k,1424) - lu(k,797) * lu(k,1418) - lu(k,1425) = lu(k,1425) - lu(k,798) * lu(k,1418) - lu(k,1426) = lu(k,1426) - lu(k,799) * lu(k,1418) - lu(k,1427) = lu(k,1427) - lu(k,800) * lu(k,1418) - lu(k,1428) = lu(k,1428) - lu(k,801) * lu(k,1418) - lu(k,1429) = lu(k,1429) - lu(k,802) * lu(k,1418) - lu(k,1430) = lu(k,1430) - lu(k,803) * lu(k,1418) - lu(k,1431) = lu(k,1431) - lu(k,804) * lu(k,1418) - lu(k,1432) = lu(k,1432) - lu(k,805) * lu(k,1418) - lu(k,1433) = lu(k,1433) - lu(k,806) * lu(k,1418) - lu(k,1434) = lu(k,1434) - lu(k,807) * lu(k,1418) - lu(k,1435) = lu(k,1435) - lu(k,808) * lu(k,1418) - lu(k,1436) = lu(k,1436) - lu(k,809) * lu(k,1418) - lu(k,1438) = lu(k,1438) - lu(k,810) * lu(k,1418) - lu(k,1439) = lu(k,1439) - lu(k,811) * lu(k,1418) - lu(k,1441) = lu(k,1441) - lu(k,812) * lu(k,1418) - lu(k,1442) = lu(k,1442) - lu(k,813) * lu(k,1418) - lu(k,1443) = lu(k,1443) - lu(k,814) * lu(k,1418) - lu(k,1463) = lu(k,1463) - lu(k,795) * lu(k,1460) - lu(k,1465) = lu(k,1465) - lu(k,796) * lu(k,1460) - lu(k,1466) = lu(k,1466) - lu(k,797) * lu(k,1460) - lu(k,1467) = lu(k,1467) - lu(k,798) * lu(k,1460) - lu(k,1468) = lu(k,1468) - lu(k,799) * lu(k,1460) - lu(k,1469) = lu(k,1469) - lu(k,800) * lu(k,1460) - lu(k,1470) = lu(k,1470) - lu(k,801) * lu(k,1460) - lu(k,1471) = lu(k,1471) - lu(k,802) * lu(k,1460) - lu(k,1472) = lu(k,1472) - lu(k,803) * lu(k,1460) - lu(k,1473) = lu(k,1473) - lu(k,804) * lu(k,1460) - lu(k,1474) = lu(k,1474) - lu(k,805) * lu(k,1460) - lu(k,1475) = lu(k,1475) - lu(k,806) * lu(k,1460) - lu(k,1476) = lu(k,1476) - lu(k,807) * lu(k,1460) - lu(k,1477) = lu(k,1477) - lu(k,808) * lu(k,1460) - lu(k,1478) = lu(k,1478) - lu(k,809) * lu(k,1460) - lu(k,1480) = lu(k,1480) - lu(k,810) * lu(k,1460) - lu(k,1481) = lu(k,1481) - lu(k,811) * lu(k,1460) - lu(k,1483) = lu(k,1483) - lu(k,812) * lu(k,1460) - lu(k,1484) = lu(k,1484) - lu(k,813) * lu(k,1460) - lu(k,1485) = lu(k,1485) - lu(k,814) * lu(k,1460) - lu(k,1504) = lu(k,1504) - lu(k,795) * lu(k,1501) - lu(k,1506) = lu(k,1506) - lu(k,796) * lu(k,1501) - lu(k,1507) = lu(k,1507) - lu(k,797) * lu(k,1501) - lu(k,1508) = lu(k,1508) - lu(k,798) * lu(k,1501) - lu(k,1509) = lu(k,1509) - lu(k,799) * lu(k,1501) - lu(k,1510) = lu(k,1510) - lu(k,800) * lu(k,1501) - lu(k,1511) = lu(k,1511) - lu(k,801) * lu(k,1501) - lu(k,1512) = lu(k,1512) - lu(k,802) * lu(k,1501) - lu(k,1513) = lu(k,1513) - lu(k,803) * lu(k,1501) - lu(k,1514) = lu(k,1514) - lu(k,804) * lu(k,1501) - lu(k,1515) = lu(k,1515) - lu(k,805) * lu(k,1501) - lu(k,1516) = lu(k,1516) - lu(k,806) * lu(k,1501) - lu(k,1517) = lu(k,1517) - lu(k,807) * lu(k,1501) - lu(k,1518) = lu(k,1518) - lu(k,808) * lu(k,1501) - lu(k,1519) = lu(k,1519) - lu(k,809) * lu(k,1501) - lu(k,1521) = lu(k,1521) - lu(k,810) * lu(k,1501) - lu(k,1522) = lu(k,1522) - lu(k,811) * lu(k,1501) - lu(k,1524) = lu(k,1524) - lu(k,812) * lu(k,1501) - lu(k,1525) = lu(k,1525) - lu(k,813) * lu(k,1501) - lu(k,1526) = lu(k,1526) - lu(k,814) * lu(k,1501) - lu(k,1546) = lu(k,1546) - lu(k,795) * lu(k,1545) - lu(k,1548) = lu(k,1548) - lu(k,796) * lu(k,1545) - lu(k,1549) = lu(k,1549) - lu(k,797) * lu(k,1545) - lu(k,1550) = lu(k,1550) - lu(k,798) * lu(k,1545) - lu(k,1551) = lu(k,1551) - lu(k,799) * lu(k,1545) - lu(k,1552) = lu(k,1552) - lu(k,800) * lu(k,1545) - lu(k,1553) = lu(k,1553) - lu(k,801) * lu(k,1545) - lu(k,1554) = lu(k,1554) - lu(k,802) * lu(k,1545) - lu(k,1555) = lu(k,1555) - lu(k,803) * lu(k,1545) - lu(k,1556) = lu(k,1556) - lu(k,804) * lu(k,1545) - lu(k,1557) = lu(k,1557) - lu(k,805) * lu(k,1545) - lu(k,1558) = lu(k,1558) - lu(k,806) * lu(k,1545) - lu(k,1559) = lu(k,1559) - lu(k,807) * lu(k,1545) - lu(k,1560) = lu(k,1560) - lu(k,808) * lu(k,1545) - lu(k,1561) = lu(k,1561) - lu(k,809) * lu(k,1545) - lu(k,1563) = lu(k,1563) - lu(k,810) * lu(k,1545) - lu(k,1564) = lu(k,1564) - lu(k,811) * lu(k,1545) - lu(k,1566) = lu(k,1566) - lu(k,812) * lu(k,1545) - lu(k,1567) = lu(k,1567) - lu(k,813) * lu(k,1545) - lu(k,1568) = lu(k,1568) - lu(k,814) * lu(k,1545) - lu(k,1588) = lu(k,1588) - lu(k,795) * lu(k,1585) - lu(k,1590) = lu(k,1590) - lu(k,796) * lu(k,1585) - lu(k,1591) = lu(k,1591) - lu(k,797) * lu(k,1585) - lu(k,1592) = lu(k,1592) - lu(k,798) * lu(k,1585) - lu(k,1593) = lu(k,1593) - lu(k,799) * lu(k,1585) - lu(k,1594) = lu(k,1594) - lu(k,800) * lu(k,1585) - lu(k,1595) = lu(k,1595) - lu(k,801) * lu(k,1585) - lu(k,1596) = lu(k,1596) - lu(k,802) * lu(k,1585) - lu(k,1597) = lu(k,1597) - lu(k,803) * lu(k,1585) - lu(k,1598) = lu(k,1598) - lu(k,804) * lu(k,1585) - lu(k,1599) = lu(k,1599) - lu(k,805) * lu(k,1585) - lu(k,1600) = lu(k,1600) - lu(k,806) * lu(k,1585) - lu(k,1601) = lu(k,1601) - lu(k,807) * lu(k,1585) - lu(k,1602) = lu(k,1602) - lu(k,808) * lu(k,1585) - lu(k,1603) = lu(k,1603) - lu(k,809) * lu(k,1585) - lu(k,1605) = lu(k,1605) - lu(k,810) * lu(k,1585) - lu(k,1606) = lu(k,1606) - lu(k,811) * lu(k,1585) - lu(k,1608) = lu(k,1608) - lu(k,812) * lu(k,1585) - lu(k,1609) = lu(k,1609) - lu(k,813) * lu(k,1585) - lu(k,1610) = lu(k,1610) - lu(k,814) * lu(k,1585) - lu(k,1620) = lu(k,1620) - lu(k,795) * lu(k,1617) - lu(k,1622) = lu(k,1622) - lu(k,796) * lu(k,1617) - lu(k,1623) = lu(k,1623) - lu(k,797) * lu(k,1617) - lu(k,1624) = lu(k,1624) - lu(k,798) * lu(k,1617) - lu(k,1625) = lu(k,1625) - lu(k,799) * lu(k,1617) - lu(k,1626) = lu(k,1626) - lu(k,800) * lu(k,1617) - lu(k,1627) = lu(k,1627) - lu(k,801) * lu(k,1617) - lu(k,1628) = lu(k,1628) - lu(k,802) * lu(k,1617) - lu(k,1629) = lu(k,1629) - lu(k,803) * lu(k,1617) - lu(k,1630) = lu(k,1630) - lu(k,804) * lu(k,1617) - lu(k,1631) = lu(k,1631) - lu(k,805) * lu(k,1617) - lu(k,1632) = lu(k,1632) - lu(k,806) * lu(k,1617) - lu(k,1633) = lu(k,1633) - lu(k,807) * lu(k,1617) - lu(k,1634) = lu(k,1634) - lu(k,808) * lu(k,1617) - lu(k,1635) = lu(k,1635) - lu(k,809) * lu(k,1617) - lu(k,1637) = lu(k,1637) - lu(k,810) * lu(k,1617) - lu(k,1638) = lu(k,1638) - lu(k,811) * lu(k,1617) - lu(k,1640) = lu(k,1640) - lu(k,812) * lu(k,1617) - lu(k,1641) = lu(k,1641) - lu(k,813) * lu(k,1617) - lu(k,1642) = lu(k,1642) - lu(k,814) * lu(k,1617) - lu(k,1655) = lu(k,1655) - lu(k,795) * lu(k,1652) - lu(k,1657) = lu(k,1657) - lu(k,796) * lu(k,1652) - lu(k,1658) = lu(k,1658) - lu(k,797) * lu(k,1652) - lu(k,1659) = lu(k,1659) - lu(k,798) * lu(k,1652) - lu(k,1660) = lu(k,1660) - lu(k,799) * lu(k,1652) - lu(k,1661) = lu(k,1661) - lu(k,800) * lu(k,1652) - lu(k,1662) = lu(k,1662) - lu(k,801) * lu(k,1652) - lu(k,1663) = lu(k,1663) - lu(k,802) * lu(k,1652) - lu(k,1664) = lu(k,1664) - lu(k,803) * lu(k,1652) - lu(k,1665) = lu(k,1665) - lu(k,804) * lu(k,1652) - lu(k,1666) = lu(k,1666) - lu(k,805) * lu(k,1652) - lu(k,1667) = lu(k,1667) - lu(k,806) * lu(k,1652) - lu(k,1668) = lu(k,1668) - lu(k,807) * lu(k,1652) - lu(k,1669) = lu(k,1669) - lu(k,808) * lu(k,1652) - lu(k,1670) = lu(k,1670) - lu(k,809) * lu(k,1652) - lu(k,1672) = lu(k,1672) - lu(k,810) * lu(k,1652) - lu(k,1673) = lu(k,1673) - lu(k,811) * lu(k,1652) - lu(k,1675) = lu(k,1675) - lu(k,812) * lu(k,1652) - lu(k,1676) = lu(k,1676) - lu(k,813) * lu(k,1652) - lu(k,1677) = lu(k,1677) - lu(k,814) * lu(k,1652) - lu(k,1697) = lu(k,1697) - lu(k,795) * lu(k,1694) - lu(k,1699) = lu(k,1699) - lu(k,796) * lu(k,1694) - lu(k,1700) = lu(k,1700) - lu(k,797) * lu(k,1694) - lu(k,1701) = lu(k,1701) - lu(k,798) * lu(k,1694) - lu(k,1702) = lu(k,1702) - lu(k,799) * lu(k,1694) - lu(k,1703) = lu(k,1703) - lu(k,800) * lu(k,1694) - lu(k,1704) = lu(k,1704) - lu(k,801) * lu(k,1694) - lu(k,1705) = lu(k,1705) - lu(k,802) * lu(k,1694) - lu(k,1706) = lu(k,1706) - lu(k,803) * lu(k,1694) - lu(k,1707) = lu(k,1707) - lu(k,804) * lu(k,1694) - lu(k,1708) = lu(k,1708) - lu(k,805) * lu(k,1694) - lu(k,1709) = lu(k,1709) - lu(k,806) * lu(k,1694) - lu(k,1710) = lu(k,1710) - lu(k,807) * lu(k,1694) - lu(k,1711) = lu(k,1711) - lu(k,808) * lu(k,1694) - lu(k,1712) = lu(k,1712) - lu(k,809) * lu(k,1694) - lu(k,1714) = lu(k,1714) - lu(k,810) * lu(k,1694) - lu(k,1715) = lu(k,1715) - lu(k,811) * lu(k,1694) - lu(k,1717) = lu(k,1717) - lu(k,812) * lu(k,1694) - lu(k,1718) = lu(k,1718) - lu(k,813) * lu(k,1694) - lu(k,1719) = lu(k,1719) - lu(k,814) * lu(k,1694) - lu(k,1741) = lu(k,1741) - lu(k,795) * lu(k,1738) - lu(k,1743) = lu(k,1743) - lu(k,796) * lu(k,1738) - lu(k,1744) = lu(k,1744) - lu(k,797) * lu(k,1738) - lu(k,1745) = lu(k,1745) - lu(k,798) * lu(k,1738) - lu(k,1746) = lu(k,1746) - lu(k,799) * lu(k,1738) - lu(k,1747) = lu(k,1747) - lu(k,800) * lu(k,1738) - lu(k,1748) = lu(k,1748) - lu(k,801) * lu(k,1738) - lu(k,1749) = lu(k,1749) - lu(k,802) * lu(k,1738) - lu(k,1750) = lu(k,1750) - lu(k,803) * lu(k,1738) - lu(k,1751) = lu(k,1751) - lu(k,804) * lu(k,1738) - lu(k,1752) = lu(k,1752) - lu(k,805) * lu(k,1738) - lu(k,1753) = lu(k,1753) - lu(k,806) * lu(k,1738) - lu(k,1754) = lu(k,1754) - lu(k,807) * lu(k,1738) - lu(k,1755) = lu(k,1755) - lu(k,808) * lu(k,1738) - lu(k,1756) = lu(k,1756) - lu(k,809) * lu(k,1738) - lu(k,1758) = lu(k,1758) - lu(k,810) * lu(k,1738) - lu(k,1759) = lu(k,1759) - lu(k,811) * lu(k,1738) - lu(k,1761) = lu(k,1761) - lu(k,812) * lu(k,1738) - lu(k,1762) = lu(k,1762) - lu(k,813) * lu(k,1738) - lu(k,1763) = lu(k,1763) - lu(k,814) * lu(k,1738) - lu(k,1776) = lu(k,1776) - lu(k,795) * lu(k,1773) - lu(k,1778) = lu(k,1778) - lu(k,796) * lu(k,1773) - lu(k,1779) = lu(k,1779) - lu(k,797) * lu(k,1773) - lu(k,1780) = lu(k,1780) - lu(k,798) * lu(k,1773) - lu(k,1781) = lu(k,1781) - lu(k,799) * lu(k,1773) - lu(k,1782) = lu(k,1782) - lu(k,800) * lu(k,1773) - lu(k,1783) = lu(k,1783) - lu(k,801) * lu(k,1773) - lu(k,1784) = lu(k,1784) - lu(k,802) * lu(k,1773) - lu(k,1785) = lu(k,1785) - lu(k,803) * lu(k,1773) - lu(k,1786) = lu(k,1786) - lu(k,804) * lu(k,1773) - lu(k,1787) = lu(k,1787) - lu(k,805) * lu(k,1773) - lu(k,1788) = lu(k,1788) - lu(k,806) * lu(k,1773) - lu(k,1789) = lu(k,1789) - lu(k,807) * lu(k,1773) - lu(k,1790) = lu(k,1790) - lu(k,808) * lu(k,1773) - lu(k,1791) = lu(k,1791) - lu(k,809) * lu(k,1773) - lu(k,1793) = lu(k,1793) - lu(k,810) * lu(k,1773) - lu(k,1794) = lu(k,1794) - lu(k,811) * lu(k,1773) - lu(k,1796) = lu(k,1796) - lu(k,812) * lu(k,1773) - lu(k,1797) = lu(k,1797) - lu(k,813) * lu(k,1773) - lu(k,1798) = lu(k,1798) - lu(k,814) * lu(k,1773) - lu(k,1834) = lu(k,1834) - lu(k,795) * lu(k,1831) - lu(k,1836) = lu(k,1836) - lu(k,796) * lu(k,1831) - lu(k,1837) = lu(k,1837) - lu(k,797) * lu(k,1831) - lu(k,1838) = lu(k,1838) - lu(k,798) * lu(k,1831) - lu(k,1839) = lu(k,1839) - lu(k,799) * lu(k,1831) - lu(k,1840) = lu(k,1840) - lu(k,800) * lu(k,1831) - lu(k,1841) = lu(k,1841) - lu(k,801) * lu(k,1831) - lu(k,1842) = lu(k,1842) - lu(k,802) * lu(k,1831) - lu(k,1843) = lu(k,1843) - lu(k,803) * lu(k,1831) - lu(k,1844) = lu(k,1844) - lu(k,804) * lu(k,1831) - lu(k,1845) = lu(k,1845) - lu(k,805) * lu(k,1831) - lu(k,1846) = lu(k,1846) - lu(k,806) * lu(k,1831) - lu(k,1847) = lu(k,1847) - lu(k,807) * lu(k,1831) - lu(k,1848) = lu(k,1848) - lu(k,808) * lu(k,1831) - lu(k,1849) = lu(k,1849) - lu(k,809) * lu(k,1831) - lu(k,1851) = lu(k,1851) - lu(k,810) * lu(k,1831) - lu(k,1852) = lu(k,1852) - lu(k,811) * lu(k,1831) - lu(k,1854) = lu(k,1854) - lu(k,812) * lu(k,1831) - lu(k,1855) = lu(k,1855) - lu(k,813) * lu(k,1831) - lu(k,1856) = lu(k,1856) - lu(k,814) * lu(k,1831) - lu(k,822) = 1._r8 / lu(k,822) - lu(k,823) = lu(k,823) * lu(k,822) - lu(k,824) = lu(k,824) * lu(k,822) - lu(k,825) = lu(k,825) * lu(k,822) - lu(k,826) = lu(k,826) * lu(k,822) - lu(k,827) = lu(k,827) * lu(k,822) - lu(k,828) = lu(k,828) * lu(k,822) - lu(k,829) = lu(k,829) * lu(k,822) - lu(k,830) = lu(k,830) * lu(k,822) - lu(k,831) = lu(k,831) * lu(k,822) - lu(k,832) = lu(k,832) * lu(k,822) - lu(k,833) = lu(k,833) * lu(k,822) - lu(k,834) = lu(k,834) * lu(k,822) - lu(k,835) = lu(k,835) * lu(k,822) - lu(k,836) = lu(k,836) * lu(k,822) - lu(k,837) = lu(k,837) * lu(k,822) - lu(k,838) = lu(k,838) * lu(k,822) - lu(k,839) = lu(k,839) * lu(k,822) - lu(k,840) = lu(k,840) * lu(k,822) - lu(k,841) = lu(k,841) * lu(k,822) - lu(k,842) = lu(k,842) * lu(k,822) - lu(k,843) = lu(k,843) * lu(k,822) - lu(k,844) = lu(k,844) * lu(k,822) - lu(k,845) = lu(k,845) * lu(k,822) - lu(k,846) = lu(k,846) * lu(k,822) - lu(k,899) = lu(k,899) - lu(k,823) * lu(k,898) - lu(k,900) = lu(k,900) - lu(k,824) * lu(k,898) - lu(k,901) = lu(k,901) - lu(k,825) * lu(k,898) - lu(k,902) = lu(k,902) - lu(k,826) * lu(k,898) - lu(k,903) = lu(k,903) - lu(k,827) * lu(k,898) - lu(k,904) = lu(k,904) - lu(k,828) * lu(k,898) - lu(k,905) = lu(k,905) - lu(k,829) * lu(k,898) - lu(k,906) = lu(k,906) - lu(k,830) * lu(k,898) - lu(k,907) = lu(k,907) - lu(k,831) * lu(k,898) - lu(k,908) = lu(k,908) - lu(k,832) * lu(k,898) - lu(k,909) = lu(k,909) - lu(k,833) * lu(k,898) - lu(k,910) = lu(k,910) - lu(k,834) * lu(k,898) - lu(k,911) = lu(k,911) - lu(k,835) * lu(k,898) - lu(k,912) = lu(k,912) - lu(k,836) * lu(k,898) - lu(k,913) = lu(k,913) - lu(k,837) * lu(k,898) - lu(k,914) = lu(k,914) - lu(k,838) * lu(k,898) - lu(k,915) = lu(k,915) - lu(k,839) * lu(k,898) - lu(k,916) = lu(k,916) - lu(k,840) * lu(k,898) - lu(k,917) = lu(k,917) - lu(k,841) * lu(k,898) - lu(k,918) = lu(k,918) - lu(k,842) * lu(k,898) - lu(k,919) = lu(k,919) - lu(k,843) * lu(k,898) - lu(k,920) = lu(k,920) - lu(k,844) * lu(k,898) - lu(k,921) = lu(k,921) - lu(k,845) * lu(k,898) - lu(k,922) = lu(k,922) - lu(k,846) * lu(k,898) - lu(k,941) = lu(k,941) - lu(k,823) * lu(k,940) - lu(k,942) = lu(k,942) - lu(k,824) * lu(k,940) - lu(k,943) = lu(k,943) - lu(k,825) * lu(k,940) - lu(k,944) = lu(k,944) - lu(k,826) * lu(k,940) - lu(k,945) = lu(k,945) - lu(k,827) * lu(k,940) - lu(k,946) = lu(k,946) - lu(k,828) * lu(k,940) - lu(k,947) = lu(k,947) - lu(k,829) * lu(k,940) - lu(k,948) = lu(k,948) - lu(k,830) * lu(k,940) - lu(k,949) = lu(k,949) - lu(k,831) * lu(k,940) - lu(k,950) = lu(k,950) - lu(k,832) * lu(k,940) - lu(k,951) = lu(k,951) - lu(k,833) * lu(k,940) - lu(k,952) = lu(k,952) - lu(k,834) * lu(k,940) - lu(k,953) = lu(k,953) - lu(k,835) * lu(k,940) - lu(k,954) = lu(k,954) - lu(k,836) * lu(k,940) - lu(k,955) = lu(k,955) - lu(k,837) * lu(k,940) - lu(k,956) = lu(k,956) - lu(k,838) * lu(k,940) - lu(k,957) = lu(k,957) - lu(k,839) * lu(k,940) - lu(k,958) = lu(k,958) - lu(k,840) * lu(k,940) - lu(k,959) = lu(k,959) - lu(k,841) * lu(k,940) - lu(k,960) = lu(k,960) - lu(k,842) * lu(k,940) - lu(k,961) = lu(k,961) - lu(k,843) * lu(k,940) - lu(k,962) = lu(k,962) - lu(k,844) * lu(k,940) - lu(k,963) = lu(k,963) - lu(k,845) * lu(k,940) - lu(k,964) = lu(k,964) - lu(k,846) * lu(k,940) - lu(k,987) = lu(k,987) - lu(k,823) * lu(k,986) - lu(k,988) = lu(k,988) - lu(k,824) * lu(k,986) - lu(k,989) = lu(k,989) - lu(k,825) * lu(k,986) - lu(k,990) = lu(k,990) - lu(k,826) * lu(k,986) - lu(k,991) = lu(k,991) - lu(k,827) * lu(k,986) - lu(k,992) = lu(k,992) - lu(k,828) * lu(k,986) - lu(k,993) = lu(k,993) - lu(k,829) * lu(k,986) - lu(k,994) = lu(k,994) - lu(k,830) * lu(k,986) - lu(k,995) = lu(k,995) - lu(k,831) * lu(k,986) - lu(k,996) = lu(k,996) - lu(k,832) * lu(k,986) - lu(k,997) = lu(k,997) - lu(k,833) * lu(k,986) - lu(k,998) = lu(k,998) - lu(k,834) * lu(k,986) - lu(k,999) = lu(k,999) - lu(k,835) * lu(k,986) - lu(k,1000) = lu(k,1000) - lu(k,836) * lu(k,986) - lu(k,1001) = lu(k,1001) - lu(k,837) * lu(k,986) - lu(k,1002) = lu(k,1002) - lu(k,838) * lu(k,986) - lu(k,1003) = lu(k,1003) - lu(k,839) * lu(k,986) - lu(k,1004) = lu(k,1004) - lu(k,840) * lu(k,986) - lu(k,1005) = lu(k,1005) - lu(k,841) * lu(k,986) - lu(k,1006) = lu(k,1006) - lu(k,842) * lu(k,986) - lu(k,1007) = lu(k,1007) - lu(k,843) * lu(k,986) - lu(k,1008) = lu(k,1008) - lu(k,844) * lu(k,986) - lu(k,1009) = lu(k,1009) - lu(k,845) * lu(k,986) - lu(k,1010) = lu(k,1010) - lu(k,846) * lu(k,986) - lu(k,1029) = lu(k,1029) - lu(k,823) * lu(k,1028) - lu(k,1030) = lu(k,1030) - lu(k,824) * lu(k,1028) - lu(k,1031) = lu(k,1031) - lu(k,825) * lu(k,1028) - lu(k,1032) = lu(k,1032) - lu(k,826) * lu(k,1028) - lu(k,1033) = lu(k,1033) - lu(k,827) * lu(k,1028) - lu(k,1034) = lu(k,1034) - lu(k,828) * lu(k,1028) - lu(k,1035) = lu(k,1035) - lu(k,829) * lu(k,1028) - lu(k,1036) = lu(k,1036) - lu(k,830) * lu(k,1028) - lu(k,1037) = lu(k,1037) - lu(k,831) * lu(k,1028) - lu(k,1038) = lu(k,1038) - lu(k,832) * lu(k,1028) - lu(k,1039) = lu(k,1039) - lu(k,833) * lu(k,1028) - lu(k,1040) = lu(k,1040) - lu(k,834) * lu(k,1028) - lu(k,1041) = lu(k,1041) - lu(k,835) * lu(k,1028) - lu(k,1042) = lu(k,1042) - lu(k,836) * lu(k,1028) - lu(k,1043) = lu(k,1043) - lu(k,837) * lu(k,1028) - lu(k,1044) = lu(k,1044) - lu(k,838) * lu(k,1028) - lu(k,1045) = lu(k,1045) - lu(k,839) * lu(k,1028) - lu(k,1046) = lu(k,1046) - lu(k,840) * lu(k,1028) - lu(k,1047) = lu(k,1047) - lu(k,841) * lu(k,1028) - lu(k,1048) = lu(k,1048) - lu(k,842) * lu(k,1028) - lu(k,1049) = lu(k,1049) - lu(k,843) * lu(k,1028) - lu(k,1050) = lu(k,1050) - lu(k,844) * lu(k,1028) - lu(k,1051) = lu(k,1051) - lu(k,845) * lu(k,1028) - lu(k,1052) = lu(k,1052) - lu(k,846) * lu(k,1028) - lu(k,1070) = lu(k,1070) - lu(k,823) * lu(k,1069) - lu(k,1071) = lu(k,1071) - lu(k,824) * lu(k,1069) - lu(k,1072) = lu(k,1072) - lu(k,825) * lu(k,1069) - lu(k,1073) = lu(k,1073) - lu(k,826) * lu(k,1069) - lu(k,1074) = lu(k,1074) - lu(k,827) * lu(k,1069) - lu(k,1075) = lu(k,1075) - lu(k,828) * lu(k,1069) - lu(k,1076) = lu(k,1076) - lu(k,829) * lu(k,1069) - lu(k,1077) = lu(k,1077) - lu(k,830) * lu(k,1069) - lu(k,1078) = lu(k,1078) - lu(k,831) * lu(k,1069) - lu(k,1079) = lu(k,1079) - lu(k,832) * lu(k,1069) - lu(k,1080) = lu(k,1080) - lu(k,833) * lu(k,1069) - lu(k,1081) = lu(k,1081) - lu(k,834) * lu(k,1069) - lu(k,1082) = lu(k,1082) - lu(k,835) * lu(k,1069) - lu(k,1083) = lu(k,1083) - lu(k,836) * lu(k,1069) - lu(k,1084) = lu(k,1084) - lu(k,837) * lu(k,1069) - lu(k,1085) = lu(k,1085) - lu(k,838) * lu(k,1069) - lu(k,1086) = lu(k,1086) - lu(k,839) * lu(k,1069) - lu(k,1087) = lu(k,1087) - lu(k,840) * lu(k,1069) - lu(k,1088) = lu(k,1088) - lu(k,841) * lu(k,1069) - lu(k,1089) = lu(k,1089) - lu(k,842) * lu(k,1069) - lu(k,1090) = lu(k,1090) - lu(k,843) * lu(k,1069) - lu(k,1091) = lu(k,1091) - lu(k,844) * lu(k,1069) - lu(k,1092) = lu(k,1092) - lu(k,845) * lu(k,1069) - lu(k,1093) = lu(k,1093) - lu(k,846) * lu(k,1069) - lu(k,1153) = lu(k,1153) - lu(k,823) * lu(k,1152) - lu(k,1154) = lu(k,1154) - lu(k,824) * lu(k,1152) - lu(k,1155) = lu(k,1155) - lu(k,825) * lu(k,1152) - lu(k,1156) = lu(k,1156) - lu(k,826) * lu(k,1152) - lu(k,1157) = lu(k,1157) - lu(k,827) * lu(k,1152) - lu(k,1158) = lu(k,1158) - lu(k,828) * lu(k,1152) - lu(k,1159) = lu(k,1159) - lu(k,829) * lu(k,1152) - lu(k,1160) = lu(k,1160) - lu(k,830) * lu(k,1152) - lu(k,1161) = lu(k,1161) - lu(k,831) * lu(k,1152) - lu(k,1162) = lu(k,1162) - lu(k,832) * lu(k,1152) - lu(k,1163) = lu(k,1163) - lu(k,833) * lu(k,1152) - lu(k,1164) = lu(k,1164) - lu(k,834) * lu(k,1152) - lu(k,1165) = lu(k,1165) - lu(k,835) * lu(k,1152) - lu(k,1166) = lu(k,1166) - lu(k,836) * lu(k,1152) - lu(k,1167) = lu(k,1167) - lu(k,837) * lu(k,1152) - lu(k,1168) = lu(k,1168) - lu(k,838) * lu(k,1152) - lu(k,1169) = lu(k,1169) - lu(k,839) * lu(k,1152) - lu(k,1170) = lu(k,1170) - lu(k,840) * lu(k,1152) - lu(k,1171) = lu(k,1171) - lu(k,841) * lu(k,1152) - lu(k,1172) = lu(k,1172) - lu(k,842) * lu(k,1152) - lu(k,1173) = lu(k,1173) - lu(k,843) * lu(k,1152) - lu(k,1174) = lu(k,1174) - lu(k,844) * lu(k,1152) - lu(k,1175) = lu(k,1175) - lu(k,845) * lu(k,1152) - lu(k,1176) = lu(k,1176) - lu(k,846) * lu(k,1152) - lu(k,1194) = lu(k,1194) - lu(k,823) * lu(k,1193) - lu(k,1195) = lu(k,1195) - lu(k,824) * lu(k,1193) - lu(k,1196) = lu(k,1196) - lu(k,825) * lu(k,1193) - lu(k,1197) = lu(k,1197) - lu(k,826) * lu(k,1193) - lu(k,1198) = lu(k,1198) - lu(k,827) * lu(k,1193) - lu(k,1199) = lu(k,1199) - lu(k,828) * lu(k,1193) - lu(k,1200) = lu(k,1200) - lu(k,829) * lu(k,1193) - lu(k,1201) = lu(k,1201) - lu(k,830) * lu(k,1193) - lu(k,1202) = lu(k,1202) - lu(k,831) * lu(k,1193) - lu(k,1203) = lu(k,1203) - lu(k,832) * lu(k,1193) - lu(k,1204) = lu(k,1204) - lu(k,833) * lu(k,1193) - lu(k,1205) = lu(k,1205) - lu(k,834) * lu(k,1193) - lu(k,1206) = lu(k,1206) - lu(k,835) * lu(k,1193) - lu(k,1207) = lu(k,1207) - lu(k,836) * lu(k,1193) - lu(k,1208) = lu(k,1208) - lu(k,837) * lu(k,1193) - lu(k,1209) = lu(k,1209) - lu(k,838) * lu(k,1193) - lu(k,1210) = lu(k,1210) - lu(k,839) * lu(k,1193) - lu(k,1211) = lu(k,1211) - lu(k,840) * lu(k,1193) - lu(k,1212) = lu(k,1212) - lu(k,841) * lu(k,1193) - lu(k,1213) = lu(k,1213) - lu(k,842) * lu(k,1193) - lu(k,1214) = lu(k,1214) - lu(k,843) * lu(k,1193) - lu(k,1215) = lu(k,1215) - lu(k,844) * lu(k,1193) - lu(k,1216) = lu(k,1216) - lu(k,845) * lu(k,1193) - lu(k,1217) = lu(k,1217) - lu(k,846) * lu(k,1193) - lu(k,1243) = lu(k,1243) - lu(k,823) * lu(k,1242) - lu(k,1244) = lu(k,1244) - lu(k,824) * lu(k,1242) - lu(k,1245) = lu(k,1245) - lu(k,825) * lu(k,1242) - lu(k,1246) = lu(k,1246) - lu(k,826) * lu(k,1242) - lu(k,1247) = lu(k,1247) - lu(k,827) * lu(k,1242) - lu(k,1248) = lu(k,1248) - lu(k,828) * lu(k,1242) - lu(k,1249) = lu(k,1249) - lu(k,829) * lu(k,1242) - lu(k,1250) = lu(k,1250) - lu(k,830) * lu(k,1242) - lu(k,1251) = lu(k,1251) - lu(k,831) * lu(k,1242) - lu(k,1252) = lu(k,1252) - lu(k,832) * lu(k,1242) - lu(k,1253) = lu(k,1253) - lu(k,833) * lu(k,1242) - lu(k,1254) = lu(k,1254) - lu(k,834) * lu(k,1242) - lu(k,1255) = lu(k,1255) - lu(k,835) * lu(k,1242) - lu(k,1256) = lu(k,1256) - lu(k,836) * lu(k,1242) - lu(k,1257) = lu(k,1257) - lu(k,837) * lu(k,1242) - lu(k,1258) = lu(k,1258) - lu(k,838) * lu(k,1242) - lu(k,1259) = lu(k,1259) - lu(k,839) * lu(k,1242) - lu(k,1260) = lu(k,1260) - lu(k,840) * lu(k,1242) - lu(k,1261) = lu(k,1261) - lu(k,841) * lu(k,1242) - lu(k,1262) = lu(k,1262) - lu(k,842) * lu(k,1242) - lu(k,1263) = lu(k,1263) - lu(k,843) * lu(k,1242) - lu(k,1264) = lu(k,1264) - lu(k,844) * lu(k,1242) - lu(k,1265) = lu(k,1265) - lu(k,845) * lu(k,1242) - lu(k,1266) = lu(k,1266) - lu(k,846) * lu(k,1242) - lu(k,1282) = lu(k,1282) - lu(k,823) * lu(k,1281) - lu(k,1283) = lu(k,1283) - lu(k,824) * lu(k,1281) - lu(k,1284) = lu(k,1284) - lu(k,825) * lu(k,1281) - lu(k,1285) = lu(k,1285) - lu(k,826) * lu(k,1281) - lu(k,1286) = lu(k,1286) - lu(k,827) * lu(k,1281) - lu(k,1287) = lu(k,1287) - lu(k,828) * lu(k,1281) - lu(k,1288) = lu(k,1288) - lu(k,829) * lu(k,1281) - lu(k,1289) = lu(k,1289) - lu(k,830) * lu(k,1281) - lu(k,1290) = lu(k,1290) - lu(k,831) * lu(k,1281) - lu(k,1291) = lu(k,1291) - lu(k,832) * lu(k,1281) - lu(k,1292) = lu(k,1292) - lu(k,833) * lu(k,1281) - lu(k,1293) = lu(k,1293) - lu(k,834) * lu(k,1281) - lu(k,1294) = lu(k,1294) - lu(k,835) * lu(k,1281) - lu(k,1295) = lu(k,1295) - lu(k,836) * lu(k,1281) - lu(k,1296) = lu(k,1296) - lu(k,837) * lu(k,1281) - lu(k,1297) = lu(k,1297) - lu(k,838) * lu(k,1281) - lu(k,1298) = lu(k,1298) - lu(k,839) * lu(k,1281) - lu(k,1299) = lu(k,1299) - lu(k,840) * lu(k,1281) - lu(k,1300) = lu(k,1300) - lu(k,841) * lu(k,1281) - lu(k,1301) = lu(k,1301) - lu(k,842) * lu(k,1281) - lu(k,1302) = lu(k,1302) - lu(k,843) * lu(k,1281) - lu(k,1303) = lu(k,1303) - lu(k,844) * lu(k,1281) - lu(k,1304) = lu(k,1304) - lu(k,845) * lu(k,1281) - lu(k,1305) = lu(k,1305) - lu(k,846) * lu(k,1281) - lu(k,1317) = lu(k,1317) - lu(k,823) * lu(k,1316) - lu(k,1318) = lu(k,1318) - lu(k,824) * lu(k,1316) - lu(k,1319) = lu(k,1319) - lu(k,825) * lu(k,1316) - lu(k,1320) = lu(k,1320) - lu(k,826) * lu(k,1316) - lu(k,1321) = lu(k,1321) - lu(k,827) * lu(k,1316) - lu(k,1322) = lu(k,1322) - lu(k,828) * lu(k,1316) - lu(k,1323) = lu(k,1323) - lu(k,829) * lu(k,1316) - lu(k,1324) = lu(k,1324) - lu(k,830) * lu(k,1316) - lu(k,1325) = lu(k,1325) - lu(k,831) * lu(k,1316) - lu(k,1326) = lu(k,1326) - lu(k,832) * lu(k,1316) - lu(k,1327) = lu(k,1327) - lu(k,833) * lu(k,1316) - lu(k,1328) = lu(k,1328) - lu(k,834) * lu(k,1316) - lu(k,1329) = lu(k,1329) - lu(k,835) * lu(k,1316) - lu(k,1330) = lu(k,1330) - lu(k,836) * lu(k,1316) - lu(k,1331) = lu(k,1331) - lu(k,837) * lu(k,1316) - lu(k,1332) = lu(k,1332) - lu(k,838) * lu(k,1316) - lu(k,1333) = lu(k,1333) - lu(k,839) * lu(k,1316) - lu(k,1334) = lu(k,1334) - lu(k,840) * lu(k,1316) - lu(k,1335) = lu(k,1335) - lu(k,841) * lu(k,1316) - lu(k,1336) = lu(k,1336) - lu(k,842) * lu(k,1316) - lu(k,1337) = lu(k,1337) - lu(k,843) * lu(k,1316) - lu(k,1338) = lu(k,1338) - lu(k,844) * lu(k,1316) - lu(k,1339) = lu(k,1339) - lu(k,845) * lu(k,1316) - lu(k,1340) = lu(k,1340) - lu(k,846) * lu(k,1316) - lu(k,1361) = lu(k,1361) - lu(k,823) * lu(k,1360) - lu(k,1362) = lu(k,1362) - lu(k,824) * lu(k,1360) - lu(k,1363) = lu(k,1363) - lu(k,825) * lu(k,1360) - lu(k,1364) = lu(k,1364) - lu(k,826) * lu(k,1360) - lu(k,1365) = lu(k,1365) - lu(k,827) * lu(k,1360) - lu(k,1366) = lu(k,1366) - lu(k,828) * lu(k,1360) - lu(k,1367) = lu(k,1367) - lu(k,829) * lu(k,1360) - lu(k,1368) = lu(k,1368) - lu(k,830) * lu(k,1360) - lu(k,1369) = lu(k,1369) - lu(k,831) * lu(k,1360) - lu(k,1370) = lu(k,1370) - lu(k,832) * lu(k,1360) - lu(k,1371) = lu(k,1371) - lu(k,833) * lu(k,1360) - lu(k,1372) = lu(k,1372) - lu(k,834) * lu(k,1360) - lu(k,1373) = lu(k,1373) - lu(k,835) * lu(k,1360) - lu(k,1374) = lu(k,1374) - lu(k,836) * lu(k,1360) - lu(k,1375) = lu(k,1375) - lu(k,837) * lu(k,1360) - lu(k,1376) = lu(k,1376) - lu(k,838) * lu(k,1360) - lu(k,1377) = lu(k,1377) - lu(k,839) * lu(k,1360) - lu(k,1378) = lu(k,1378) - lu(k,840) * lu(k,1360) - lu(k,1379) = lu(k,1379) - lu(k,841) * lu(k,1360) - lu(k,1380) = lu(k,1380) - lu(k,842) * lu(k,1360) - lu(k,1381) = lu(k,1381) - lu(k,843) * lu(k,1360) - lu(k,1382) = lu(k,1382) - lu(k,844) * lu(k,1360) - lu(k,1383) = lu(k,1383) - lu(k,845) * lu(k,1360) - lu(k,1384) = lu(k,1384) - lu(k,846) * lu(k,1360) - lu(k,1420) = lu(k,1420) - lu(k,823) * lu(k,1419) - lu(k,1421) = lu(k,1421) - lu(k,824) * lu(k,1419) - lu(k,1422) = lu(k,1422) - lu(k,825) * lu(k,1419) - lu(k,1423) = lu(k,1423) - lu(k,826) * lu(k,1419) - lu(k,1424) = lu(k,1424) - lu(k,827) * lu(k,1419) - lu(k,1425) = lu(k,1425) - lu(k,828) * lu(k,1419) - lu(k,1426) = lu(k,1426) - lu(k,829) * lu(k,1419) - lu(k,1427) = lu(k,1427) - lu(k,830) * lu(k,1419) - lu(k,1428) = lu(k,1428) - lu(k,831) * lu(k,1419) - lu(k,1429) = lu(k,1429) - lu(k,832) * lu(k,1419) - lu(k,1430) = lu(k,1430) - lu(k,833) * lu(k,1419) - lu(k,1431) = lu(k,1431) - lu(k,834) * lu(k,1419) - lu(k,1432) = lu(k,1432) - lu(k,835) * lu(k,1419) - lu(k,1433) = lu(k,1433) - lu(k,836) * lu(k,1419) - lu(k,1434) = lu(k,1434) - lu(k,837) * lu(k,1419) - lu(k,1435) = lu(k,1435) - lu(k,838) * lu(k,1419) - lu(k,1436) = lu(k,1436) - lu(k,839) * lu(k,1419) - lu(k,1437) = lu(k,1437) - lu(k,840) * lu(k,1419) - lu(k,1438) = lu(k,1438) - lu(k,841) * lu(k,1419) - lu(k,1439) = lu(k,1439) - lu(k,842) * lu(k,1419) - lu(k,1440) = lu(k,1440) - lu(k,843) * lu(k,1419) - lu(k,1441) = lu(k,1441) - lu(k,844) * lu(k,1419) - lu(k,1442) = lu(k,1442) - lu(k,845) * lu(k,1419) - lu(k,1443) = lu(k,1443) - lu(k,846) * lu(k,1419) - lu(k,1462) = lu(k,1462) - lu(k,823) * lu(k,1461) - lu(k,1463) = lu(k,1463) - lu(k,824) * lu(k,1461) - lu(k,1464) = lu(k,1464) - lu(k,825) * lu(k,1461) - lu(k,1465) = lu(k,1465) - lu(k,826) * lu(k,1461) - lu(k,1466) = lu(k,1466) - lu(k,827) * lu(k,1461) - lu(k,1467) = lu(k,1467) - lu(k,828) * lu(k,1461) - lu(k,1468) = lu(k,1468) - lu(k,829) * lu(k,1461) - lu(k,1469) = lu(k,1469) - lu(k,830) * lu(k,1461) - lu(k,1470) = lu(k,1470) - lu(k,831) * lu(k,1461) - lu(k,1471) = lu(k,1471) - lu(k,832) * lu(k,1461) - lu(k,1472) = lu(k,1472) - lu(k,833) * lu(k,1461) - lu(k,1473) = lu(k,1473) - lu(k,834) * lu(k,1461) - lu(k,1474) = lu(k,1474) - lu(k,835) * lu(k,1461) - lu(k,1475) = lu(k,1475) - lu(k,836) * lu(k,1461) - lu(k,1476) = lu(k,1476) - lu(k,837) * lu(k,1461) - lu(k,1477) = lu(k,1477) - lu(k,838) * lu(k,1461) - lu(k,1478) = lu(k,1478) - lu(k,839) * lu(k,1461) - lu(k,1479) = lu(k,1479) - lu(k,840) * lu(k,1461) - lu(k,1480) = lu(k,1480) - lu(k,841) * lu(k,1461) - lu(k,1481) = lu(k,1481) - lu(k,842) * lu(k,1461) - lu(k,1482) = lu(k,1482) - lu(k,843) * lu(k,1461) - lu(k,1483) = lu(k,1483) - lu(k,844) * lu(k,1461) - lu(k,1484) = lu(k,1484) - lu(k,845) * lu(k,1461) - lu(k,1485) = lu(k,1485) - lu(k,846) * lu(k,1461) - lu(k,1503) = lu(k,1503) - lu(k,823) * lu(k,1502) - lu(k,1504) = lu(k,1504) - lu(k,824) * lu(k,1502) - lu(k,1505) = lu(k,1505) - lu(k,825) * lu(k,1502) - lu(k,1506) = lu(k,1506) - lu(k,826) * lu(k,1502) - lu(k,1507) = lu(k,1507) - lu(k,827) * lu(k,1502) - lu(k,1508) = lu(k,1508) - lu(k,828) * lu(k,1502) - lu(k,1509) = lu(k,1509) - lu(k,829) * lu(k,1502) - lu(k,1510) = lu(k,1510) - lu(k,830) * lu(k,1502) - lu(k,1511) = lu(k,1511) - lu(k,831) * lu(k,1502) - lu(k,1512) = lu(k,1512) - lu(k,832) * lu(k,1502) - lu(k,1513) = lu(k,1513) - lu(k,833) * lu(k,1502) - lu(k,1514) = lu(k,1514) - lu(k,834) * lu(k,1502) - lu(k,1515) = lu(k,1515) - lu(k,835) * lu(k,1502) - lu(k,1516) = lu(k,1516) - lu(k,836) * lu(k,1502) - lu(k,1517) = lu(k,1517) - lu(k,837) * lu(k,1502) - lu(k,1518) = lu(k,1518) - lu(k,838) * lu(k,1502) - lu(k,1519) = lu(k,1519) - lu(k,839) * lu(k,1502) - lu(k,1520) = lu(k,1520) - lu(k,840) * lu(k,1502) - lu(k,1521) = lu(k,1521) - lu(k,841) * lu(k,1502) - lu(k,1522) = lu(k,1522) - lu(k,842) * lu(k,1502) - lu(k,1523) = lu(k,1523) - lu(k,843) * lu(k,1502) - lu(k,1524) = lu(k,1524) - lu(k,844) * lu(k,1502) - lu(k,1525) = lu(k,1525) - lu(k,845) * lu(k,1502) - lu(k,1526) = lu(k,1526) - lu(k,846) * lu(k,1502) - lu(k,1587) = lu(k,1587) - lu(k,823) * lu(k,1586) - lu(k,1588) = lu(k,1588) - lu(k,824) * lu(k,1586) - lu(k,1589) = lu(k,1589) - lu(k,825) * lu(k,1586) - lu(k,1590) = lu(k,1590) - lu(k,826) * lu(k,1586) - lu(k,1591) = lu(k,1591) - lu(k,827) * lu(k,1586) - lu(k,1592) = lu(k,1592) - lu(k,828) * lu(k,1586) - lu(k,1593) = lu(k,1593) - lu(k,829) * lu(k,1586) - lu(k,1594) = lu(k,1594) - lu(k,830) * lu(k,1586) - lu(k,1595) = lu(k,1595) - lu(k,831) * lu(k,1586) - lu(k,1596) = lu(k,1596) - lu(k,832) * lu(k,1586) - lu(k,1597) = lu(k,1597) - lu(k,833) * lu(k,1586) - lu(k,1598) = lu(k,1598) - lu(k,834) * lu(k,1586) - lu(k,1599) = lu(k,1599) - lu(k,835) * lu(k,1586) - lu(k,1600) = lu(k,1600) - lu(k,836) * lu(k,1586) - lu(k,1601) = lu(k,1601) - lu(k,837) * lu(k,1586) - lu(k,1602) = lu(k,1602) - lu(k,838) * lu(k,1586) - lu(k,1603) = lu(k,1603) - lu(k,839) * lu(k,1586) - lu(k,1604) = lu(k,1604) - lu(k,840) * lu(k,1586) - lu(k,1605) = lu(k,1605) - lu(k,841) * lu(k,1586) - lu(k,1606) = lu(k,1606) - lu(k,842) * lu(k,1586) - lu(k,1607) = lu(k,1607) - lu(k,843) * lu(k,1586) - lu(k,1608) = lu(k,1608) - lu(k,844) * lu(k,1586) - lu(k,1609) = lu(k,1609) - lu(k,845) * lu(k,1586) - lu(k,1610) = lu(k,1610) - lu(k,846) * lu(k,1586) - lu(k,1619) = lu(k,1619) - lu(k,823) * lu(k,1618) - lu(k,1620) = lu(k,1620) - lu(k,824) * lu(k,1618) - lu(k,1621) = lu(k,1621) - lu(k,825) * lu(k,1618) - lu(k,1622) = lu(k,1622) - lu(k,826) * lu(k,1618) - lu(k,1623) = lu(k,1623) - lu(k,827) * lu(k,1618) - lu(k,1624) = lu(k,1624) - lu(k,828) * lu(k,1618) - lu(k,1625) = lu(k,1625) - lu(k,829) * lu(k,1618) - lu(k,1626) = lu(k,1626) - lu(k,830) * lu(k,1618) - lu(k,1627) = lu(k,1627) - lu(k,831) * lu(k,1618) - lu(k,1628) = lu(k,1628) - lu(k,832) * lu(k,1618) - lu(k,1629) = lu(k,1629) - lu(k,833) * lu(k,1618) - lu(k,1630) = lu(k,1630) - lu(k,834) * lu(k,1618) - lu(k,1631) = lu(k,1631) - lu(k,835) * lu(k,1618) - lu(k,1632) = lu(k,1632) - lu(k,836) * lu(k,1618) - lu(k,1633) = lu(k,1633) - lu(k,837) * lu(k,1618) - lu(k,1634) = lu(k,1634) - lu(k,838) * lu(k,1618) - lu(k,1635) = lu(k,1635) - lu(k,839) * lu(k,1618) - lu(k,1636) = lu(k,1636) - lu(k,840) * lu(k,1618) - lu(k,1637) = lu(k,1637) - lu(k,841) * lu(k,1618) - lu(k,1638) = lu(k,1638) - lu(k,842) * lu(k,1618) - lu(k,1639) = lu(k,1639) - lu(k,843) * lu(k,1618) - lu(k,1640) = lu(k,1640) - lu(k,844) * lu(k,1618) - lu(k,1641) = lu(k,1641) - lu(k,845) * lu(k,1618) - lu(k,1642) = lu(k,1642) - lu(k,846) * lu(k,1618) - lu(k,1654) = lu(k,1654) - lu(k,823) * lu(k,1653) - lu(k,1655) = lu(k,1655) - lu(k,824) * lu(k,1653) - lu(k,1656) = lu(k,1656) - lu(k,825) * lu(k,1653) - lu(k,1657) = lu(k,1657) - lu(k,826) * lu(k,1653) - lu(k,1658) = lu(k,1658) - lu(k,827) * lu(k,1653) - lu(k,1659) = lu(k,1659) - lu(k,828) * lu(k,1653) - lu(k,1660) = lu(k,1660) - lu(k,829) * lu(k,1653) - lu(k,1661) = lu(k,1661) - lu(k,830) * lu(k,1653) - lu(k,1662) = lu(k,1662) - lu(k,831) * lu(k,1653) - lu(k,1663) = lu(k,1663) - lu(k,832) * lu(k,1653) - lu(k,1664) = lu(k,1664) - lu(k,833) * lu(k,1653) - lu(k,1665) = lu(k,1665) - lu(k,834) * lu(k,1653) - lu(k,1666) = lu(k,1666) - lu(k,835) * lu(k,1653) - lu(k,1667) = lu(k,1667) - lu(k,836) * lu(k,1653) - lu(k,1668) = lu(k,1668) - lu(k,837) * lu(k,1653) - lu(k,1669) = lu(k,1669) - lu(k,838) * lu(k,1653) - lu(k,1670) = lu(k,1670) - lu(k,839) * lu(k,1653) - lu(k,1671) = lu(k,1671) - lu(k,840) * lu(k,1653) - lu(k,1672) = lu(k,1672) - lu(k,841) * lu(k,1653) - lu(k,1673) = lu(k,1673) - lu(k,842) * lu(k,1653) - lu(k,1674) = lu(k,1674) - lu(k,843) * lu(k,1653) - lu(k,1675) = lu(k,1675) - lu(k,844) * lu(k,1653) - lu(k,1676) = lu(k,1676) - lu(k,845) * lu(k,1653) - lu(k,1677) = lu(k,1677) - lu(k,846) * lu(k,1653) - lu(k,1696) = lu(k,1696) - lu(k,823) * lu(k,1695) - lu(k,1697) = lu(k,1697) - lu(k,824) * lu(k,1695) - lu(k,1698) = lu(k,1698) - lu(k,825) * lu(k,1695) - lu(k,1699) = lu(k,1699) - lu(k,826) * lu(k,1695) - lu(k,1700) = lu(k,1700) - lu(k,827) * lu(k,1695) - lu(k,1701) = lu(k,1701) - lu(k,828) * lu(k,1695) - lu(k,1702) = lu(k,1702) - lu(k,829) * lu(k,1695) - lu(k,1703) = lu(k,1703) - lu(k,830) * lu(k,1695) - lu(k,1704) = lu(k,1704) - lu(k,831) * lu(k,1695) - lu(k,1705) = lu(k,1705) - lu(k,832) * lu(k,1695) - lu(k,1706) = lu(k,1706) - lu(k,833) * lu(k,1695) - lu(k,1707) = lu(k,1707) - lu(k,834) * lu(k,1695) - lu(k,1708) = lu(k,1708) - lu(k,835) * lu(k,1695) - lu(k,1709) = lu(k,1709) - lu(k,836) * lu(k,1695) - lu(k,1710) = lu(k,1710) - lu(k,837) * lu(k,1695) - lu(k,1711) = lu(k,1711) - lu(k,838) * lu(k,1695) - lu(k,1712) = lu(k,1712) - lu(k,839) * lu(k,1695) - lu(k,1713) = lu(k,1713) - lu(k,840) * lu(k,1695) - lu(k,1714) = lu(k,1714) - lu(k,841) * lu(k,1695) - lu(k,1715) = lu(k,1715) - lu(k,842) * lu(k,1695) - lu(k,1716) = lu(k,1716) - lu(k,843) * lu(k,1695) - lu(k,1717) = lu(k,1717) - lu(k,844) * lu(k,1695) - lu(k,1718) = lu(k,1718) - lu(k,845) * lu(k,1695) - lu(k,1719) = lu(k,1719) - lu(k,846) * lu(k,1695) - lu(k,1740) = lu(k,1740) - lu(k,823) * lu(k,1739) - lu(k,1741) = lu(k,1741) - lu(k,824) * lu(k,1739) - lu(k,1742) = lu(k,1742) - lu(k,825) * lu(k,1739) - lu(k,1743) = lu(k,1743) - lu(k,826) * lu(k,1739) - lu(k,1744) = lu(k,1744) - lu(k,827) * lu(k,1739) - lu(k,1745) = lu(k,1745) - lu(k,828) * lu(k,1739) - lu(k,1746) = lu(k,1746) - lu(k,829) * lu(k,1739) - lu(k,1747) = lu(k,1747) - lu(k,830) * lu(k,1739) - lu(k,1748) = lu(k,1748) - lu(k,831) * lu(k,1739) - lu(k,1749) = lu(k,1749) - lu(k,832) * lu(k,1739) - lu(k,1750) = lu(k,1750) - lu(k,833) * lu(k,1739) - lu(k,1751) = lu(k,1751) - lu(k,834) * lu(k,1739) - lu(k,1752) = lu(k,1752) - lu(k,835) * lu(k,1739) - lu(k,1753) = lu(k,1753) - lu(k,836) * lu(k,1739) - lu(k,1754) = lu(k,1754) - lu(k,837) * lu(k,1739) - lu(k,1755) = lu(k,1755) - lu(k,838) * lu(k,1739) - lu(k,1756) = lu(k,1756) - lu(k,839) * lu(k,1739) - lu(k,1757) = lu(k,1757) - lu(k,840) * lu(k,1739) - lu(k,1758) = lu(k,1758) - lu(k,841) * lu(k,1739) - lu(k,1759) = lu(k,1759) - lu(k,842) * lu(k,1739) - lu(k,1760) = lu(k,1760) - lu(k,843) * lu(k,1739) - lu(k,1761) = lu(k,1761) - lu(k,844) * lu(k,1739) - lu(k,1762) = lu(k,1762) - lu(k,845) * lu(k,1739) - lu(k,1763) = lu(k,1763) - lu(k,846) * lu(k,1739) - lu(k,1775) = lu(k,1775) - lu(k,823) * lu(k,1774) - lu(k,1776) = lu(k,1776) - lu(k,824) * lu(k,1774) - lu(k,1777) = lu(k,1777) - lu(k,825) * lu(k,1774) - lu(k,1778) = lu(k,1778) - lu(k,826) * lu(k,1774) - lu(k,1779) = lu(k,1779) - lu(k,827) * lu(k,1774) - lu(k,1780) = lu(k,1780) - lu(k,828) * lu(k,1774) - lu(k,1781) = lu(k,1781) - lu(k,829) * lu(k,1774) - lu(k,1782) = lu(k,1782) - lu(k,830) * lu(k,1774) - lu(k,1783) = lu(k,1783) - lu(k,831) * lu(k,1774) - lu(k,1784) = lu(k,1784) - lu(k,832) * lu(k,1774) - lu(k,1785) = lu(k,1785) - lu(k,833) * lu(k,1774) - lu(k,1786) = lu(k,1786) - lu(k,834) * lu(k,1774) - lu(k,1787) = lu(k,1787) - lu(k,835) * lu(k,1774) - lu(k,1788) = lu(k,1788) - lu(k,836) * lu(k,1774) - lu(k,1789) = lu(k,1789) - lu(k,837) * lu(k,1774) - lu(k,1790) = lu(k,1790) - lu(k,838) * lu(k,1774) - lu(k,1791) = lu(k,1791) - lu(k,839) * lu(k,1774) - lu(k,1792) = lu(k,1792) - lu(k,840) * lu(k,1774) - lu(k,1793) = lu(k,1793) - lu(k,841) * lu(k,1774) - lu(k,1794) = lu(k,1794) - lu(k,842) * lu(k,1774) - lu(k,1795) = lu(k,1795) - lu(k,843) * lu(k,1774) - lu(k,1796) = lu(k,1796) - lu(k,844) * lu(k,1774) - lu(k,1797) = lu(k,1797) - lu(k,845) * lu(k,1774) - lu(k,1798) = lu(k,1798) - lu(k,846) * lu(k,1774) - lu(k,1833) = lu(k,1833) - lu(k,823) * lu(k,1832) - lu(k,1834) = lu(k,1834) - lu(k,824) * lu(k,1832) - lu(k,1835) = lu(k,1835) - lu(k,825) * lu(k,1832) - lu(k,1836) = lu(k,1836) - lu(k,826) * lu(k,1832) - lu(k,1837) = lu(k,1837) - lu(k,827) * lu(k,1832) - lu(k,1838) = lu(k,1838) - lu(k,828) * lu(k,1832) - lu(k,1839) = lu(k,1839) - lu(k,829) * lu(k,1832) - lu(k,1840) = lu(k,1840) - lu(k,830) * lu(k,1832) - lu(k,1841) = lu(k,1841) - lu(k,831) * lu(k,1832) - lu(k,1842) = lu(k,1842) - lu(k,832) * lu(k,1832) - lu(k,1843) = lu(k,1843) - lu(k,833) * lu(k,1832) - lu(k,1844) = lu(k,1844) - lu(k,834) * lu(k,1832) - lu(k,1845) = lu(k,1845) - lu(k,835) * lu(k,1832) - lu(k,1846) = lu(k,1846) - lu(k,836) * lu(k,1832) - lu(k,1847) = lu(k,1847) - lu(k,837) * lu(k,1832) - lu(k,1848) = lu(k,1848) - lu(k,838) * lu(k,1832) - lu(k,1849) = lu(k,1849) - lu(k,839) * lu(k,1832) - lu(k,1850) = lu(k,1850) - lu(k,840) * lu(k,1832) - lu(k,1851) = lu(k,1851) - lu(k,841) * lu(k,1832) - lu(k,1852) = lu(k,1852) - lu(k,842) * lu(k,1832) - lu(k,1853) = lu(k,1853) - lu(k,843) * lu(k,1832) - lu(k,1854) = lu(k,1854) - lu(k,844) * lu(k,1832) - lu(k,1855) = lu(k,1855) - lu(k,845) * lu(k,1832) - lu(k,1856) = lu(k,1856) - lu(k,846) * lu(k,1832) + lu(k,735) = 1._r8 / lu(k,735) + lu(k,736) = lu(k,736) * lu(k,735) + lu(k,737) = lu(k,737) * lu(k,735) + lu(k,738) = lu(k,738) * lu(k,735) + lu(k,739) = lu(k,739) * lu(k,735) + lu(k,740) = lu(k,740) * lu(k,735) + lu(k,741) = lu(k,741) * lu(k,735) + lu(k,742) = lu(k,742) * lu(k,735) + lu(k,743) = lu(k,743) * lu(k,735) + lu(k,744) = lu(k,744) * lu(k,735) + lu(k,745) = lu(k,745) * lu(k,735) + lu(k,746) = lu(k,746) * lu(k,735) + lu(k,747) = lu(k,747) * lu(k,735) + lu(k,748) = lu(k,748) * lu(k,735) + lu(k,749) = lu(k,749) * lu(k,735) + lu(k,750) = lu(k,750) * lu(k,735) + lu(k,751) = lu(k,751) * lu(k,735) + lu(k,752) = lu(k,752) * lu(k,735) + lu(k,753) = lu(k,753) * lu(k,735) + lu(k,754) = lu(k,754) * lu(k,735) + lu(k,784) = lu(k,784) - lu(k,736) * lu(k,783) + lu(k,785) = lu(k,785) - lu(k,737) * lu(k,783) + lu(k,786) = lu(k,786) - lu(k,738) * lu(k,783) + lu(k,787) = lu(k,787) - lu(k,739) * lu(k,783) + lu(k,788) = lu(k,788) - lu(k,740) * lu(k,783) + lu(k,789) = lu(k,789) - lu(k,741) * lu(k,783) + lu(k,790) = lu(k,790) - lu(k,742) * lu(k,783) + lu(k,791) = lu(k,791) - lu(k,743) * lu(k,783) + lu(k,793) = lu(k,793) - lu(k,744) * lu(k,783) + lu(k,796) = lu(k,796) - lu(k,745) * lu(k,783) + lu(k,797) = lu(k,797) - lu(k,746) * lu(k,783) + lu(k,798) = lu(k,798) - lu(k,747) * lu(k,783) + lu(k,799) = lu(k,799) - lu(k,748) * lu(k,783) + lu(k,800) = lu(k,800) - lu(k,749) * lu(k,783) + lu(k,801) = lu(k,801) - lu(k,750) * lu(k,783) + lu(k,802) = lu(k,802) - lu(k,751) * lu(k,783) + lu(k,803) = lu(k,803) - lu(k,752) * lu(k,783) + lu(k,804) = lu(k,804) - lu(k,753) * lu(k,783) + lu(k,805) = lu(k,805) - lu(k,754) * lu(k,783) + lu(k,896) = lu(k,896) - lu(k,736) * lu(k,895) + lu(k,897) = lu(k,897) - lu(k,737) * lu(k,895) + lu(k,898) = lu(k,898) - lu(k,738) * lu(k,895) + lu(k,899) = lu(k,899) - lu(k,739) * lu(k,895) + lu(k,900) = lu(k,900) - lu(k,740) * lu(k,895) + lu(k,901) = lu(k,901) - lu(k,741) * lu(k,895) + lu(k,902) = lu(k,902) - lu(k,742) * lu(k,895) + lu(k,904) = lu(k,904) - lu(k,743) * lu(k,895) + lu(k,906) = lu(k,906) - lu(k,744) * lu(k,895) + lu(k,909) = lu(k,909) - lu(k,745) * lu(k,895) + lu(k,910) = lu(k,910) - lu(k,746) * lu(k,895) + lu(k,911) = lu(k,911) - lu(k,747) * lu(k,895) + lu(k,912) = lu(k,912) - lu(k,748) * lu(k,895) + lu(k,913) = lu(k,913) - lu(k,749) * lu(k,895) + lu(k,914) = lu(k,914) - lu(k,750) * lu(k,895) + lu(k,915) = lu(k,915) - lu(k,751) * lu(k,895) + lu(k,916) = lu(k,916) - lu(k,752) * lu(k,895) + lu(k,917) = lu(k,917) - lu(k,753) * lu(k,895) + lu(k,918) = lu(k,918) - lu(k,754) * lu(k,895) + lu(k,979) = lu(k,979) - lu(k,736) * lu(k,978) + lu(k,980) = lu(k,980) - lu(k,737) * lu(k,978) + lu(k,981) = lu(k,981) - lu(k,738) * lu(k,978) + lu(k,982) = lu(k,982) - lu(k,739) * lu(k,978) + lu(k,983) = lu(k,983) - lu(k,740) * lu(k,978) + lu(k,985) = lu(k,985) - lu(k,741) * lu(k,978) + lu(k,986) = lu(k,986) - lu(k,742) * lu(k,978) + lu(k,988) = lu(k,988) - lu(k,743) * lu(k,978) + lu(k,990) = lu(k,990) - lu(k,744) * lu(k,978) + lu(k,993) = lu(k,993) - lu(k,745) * lu(k,978) + lu(k,994) = lu(k,994) - lu(k,746) * lu(k,978) + lu(k,995) = lu(k,995) - lu(k,747) * lu(k,978) + lu(k,996) = lu(k,996) - lu(k,748) * lu(k,978) + lu(k,997) = lu(k,997) - lu(k,749) * lu(k,978) + lu(k,998) = lu(k,998) - lu(k,750) * lu(k,978) + lu(k,999) = lu(k,999) - lu(k,751) * lu(k,978) + lu(k,1000) = lu(k,1000) - lu(k,752) * lu(k,978) + lu(k,1001) = lu(k,1001) - lu(k,753) * lu(k,978) + lu(k,1002) = lu(k,1002) - lu(k,754) * lu(k,978) + lu(k,1090) = lu(k,1090) - lu(k,736) * lu(k,1089) + lu(k,1092) = lu(k,1092) - lu(k,737) * lu(k,1089) + lu(k,1094) = lu(k,1094) - lu(k,738) * lu(k,1089) + lu(k,1095) = - lu(k,739) * lu(k,1089) + lu(k,1096) = lu(k,1096) - lu(k,740) * lu(k,1089) + lu(k,1099) = lu(k,1099) - lu(k,741) * lu(k,1089) + lu(k,1100) = lu(k,1100) - lu(k,742) * lu(k,1089) + lu(k,1102) = lu(k,1102) - lu(k,743) * lu(k,1089) + lu(k,1105) = lu(k,1105) - lu(k,744) * lu(k,1089) + lu(k,1108) = lu(k,1108) - lu(k,745) * lu(k,1089) + lu(k,1110) = lu(k,1110) - lu(k,746) * lu(k,1089) + lu(k,1111) = lu(k,1111) - lu(k,747) * lu(k,1089) + lu(k,1112) = lu(k,1112) - lu(k,748) * lu(k,1089) + lu(k,1113) = - lu(k,749) * lu(k,1089) + lu(k,1114) = - lu(k,750) * lu(k,1089) + lu(k,1115) = lu(k,1115) - lu(k,751) * lu(k,1089) + lu(k,1116) = lu(k,1116) - lu(k,752) * lu(k,1089) + lu(k,1117) = lu(k,1117) - lu(k,753) * lu(k,1089) + lu(k,1118) = lu(k,1118) - lu(k,754) * lu(k,1089) + lu(k,1220) = lu(k,1220) - lu(k,736) * lu(k,1219) + lu(k,1223) = lu(k,1223) - lu(k,737) * lu(k,1219) + lu(k,1225) = lu(k,1225) - lu(k,738) * lu(k,1219) + lu(k,1227) = lu(k,1227) - lu(k,739) * lu(k,1219) + lu(k,1228) = lu(k,1228) - lu(k,740) * lu(k,1219) + lu(k,1231) = lu(k,1231) - lu(k,741) * lu(k,1219) + lu(k,1232) = lu(k,1232) - lu(k,742) * lu(k,1219) + lu(k,1234) = lu(k,1234) - lu(k,743) * lu(k,1219) + lu(k,1237) = lu(k,1237) - lu(k,744) * lu(k,1219) + lu(k,1240) = lu(k,1240) - lu(k,745) * lu(k,1219) + lu(k,1242) = lu(k,1242) - lu(k,746) * lu(k,1219) + lu(k,1243) = lu(k,1243) - lu(k,747) * lu(k,1219) + lu(k,1244) = lu(k,1244) - lu(k,748) * lu(k,1219) + lu(k,1245) = lu(k,1245) - lu(k,749) * lu(k,1219) + lu(k,1246) = lu(k,1246) - lu(k,750) * lu(k,1219) + lu(k,1247) = - lu(k,751) * lu(k,1219) + lu(k,1248) = lu(k,1248) - lu(k,752) * lu(k,1219) + lu(k,1249) = lu(k,1249) - lu(k,753) * lu(k,1219) + lu(k,1250) = lu(k,1250) - lu(k,754) * lu(k,1219) + lu(k,1279) = lu(k,1279) - lu(k,736) * lu(k,1278) + lu(k,1283) = lu(k,1283) - lu(k,737) * lu(k,1278) + lu(k,1285) = lu(k,1285) - lu(k,738) * lu(k,1278) + lu(k,1287) = lu(k,1287) - lu(k,739) * lu(k,1278) + lu(k,1288) = lu(k,1288) - lu(k,740) * lu(k,1278) + lu(k,1291) = lu(k,1291) - lu(k,741) * lu(k,1278) + lu(k,1292) = lu(k,1292) - lu(k,742) * lu(k,1278) + lu(k,1294) = lu(k,1294) - lu(k,743) * lu(k,1278) + lu(k,1297) = lu(k,1297) - lu(k,744) * lu(k,1278) + lu(k,1300) = lu(k,1300) - lu(k,745) * lu(k,1278) + lu(k,1302) = lu(k,1302) - lu(k,746) * lu(k,1278) + lu(k,1303) = lu(k,1303) - lu(k,747) * lu(k,1278) + lu(k,1304) = lu(k,1304) - lu(k,748) * lu(k,1278) + lu(k,1305) = lu(k,1305) - lu(k,749) * lu(k,1278) + lu(k,1306) = lu(k,1306) - lu(k,750) * lu(k,1278) + lu(k,1307) = lu(k,1307) - lu(k,751) * lu(k,1278) + lu(k,1308) = lu(k,1308) - lu(k,752) * lu(k,1278) + lu(k,1309) = lu(k,1309) - lu(k,753) * lu(k,1278) + lu(k,1310) = lu(k,1310) - lu(k,754) * lu(k,1278) + lu(k,1357) = lu(k,1357) - lu(k,736) * lu(k,1356) + lu(k,1361) = lu(k,1361) - lu(k,737) * lu(k,1356) + lu(k,1363) = lu(k,1363) - lu(k,738) * lu(k,1356) + lu(k,1365) = lu(k,1365) - lu(k,739) * lu(k,1356) + lu(k,1366) = lu(k,1366) - lu(k,740) * lu(k,1356) + lu(k,1369) = lu(k,1369) - lu(k,741) * lu(k,1356) + lu(k,1370) = lu(k,1370) - lu(k,742) * lu(k,1356) + lu(k,1372) = lu(k,1372) - lu(k,743) * lu(k,1356) + lu(k,1375) = lu(k,1375) - lu(k,744) * lu(k,1356) + lu(k,1378) = lu(k,1378) - lu(k,745) * lu(k,1356) + lu(k,1380) = lu(k,1380) - lu(k,746) * lu(k,1356) + lu(k,1381) = lu(k,1381) - lu(k,747) * lu(k,1356) + lu(k,1382) = lu(k,1382) - lu(k,748) * lu(k,1356) + lu(k,1383) = lu(k,1383) - lu(k,749) * lu(k,1356) + lu(k,1384) = lu(k,1384) - lu(k,750) * lu(k,1356) + lu(k,1385) = lu(k,1385) - lu(k,751) * lu(k,1356) + lu(k,1386) = lu(k,1386) - lu(k,752) * lu(k,1356) + lu(k,1387) = lu(k,1387) - lu(k,753) * lu(k,1356) + lu(k,1388) = lu(k,1388) - lu(k,754) * lu(k,1356) + lu(k,1488) = lu(k,1488) - lu(k,736) * lu(k,1487) + lu(k,1492) = lu(k,1492) - lu(k,737) * lu(k,1487) + lu(k,1494) = lu(k,1494) - lu(k,738) * lu(k,1487) + lu(k,1496) = - lu(k,739) * lu(k,1487) + lu(k,1497) = lu(k,1497) - lu(k,740) * lu(k,1487) + lu(k,1500) = lu(k,1500) - lu(k,741) * lu(k,1487) + lu(k,1501) = lu(k,1501) - lu(k,742) * lu(k,1487) + lu(k,1503) = lu(k,1503) - lu(k,743) * lu(k,1487) + lu(k,1506) = lu(k,1506) - lu(k,744) * lu(k,1487) + lu(k,1509) = lu(k,1509) - lu(k,745) * lu(k,1487) + lu(k,1511) = lu(k,1511) - lu(k,746) * lu(k,1487) + lu(k,1512) = lu(k,1512) - lu(k,747) * lu(k,1487) + lu(k,1513) = lu(k,1513) - lu(k,748) * lu(k,1487) + lu(k,1514) = lu(k,1514) - lu(k,749) * lu(k,1487) + lu(k,1515) = lu(k,1515) - lu(k,750) * lu(k,1487) + lu(k,1516) = lu(k,1516) - lu(k,751) * lu(k,1487) + lu(k,1517) = lu(k,1517) - lu(k,752) * lu(k,1487) + lu(k,1518) = lu(k,1518) - lu(k,753) * lu(k,1487) + lu(k,1519) = lu(k,1519) - lu(k,754) * lu(k,1487) + lu(k,1618) = lu(k,1618) - lu(k,736) * lu(k,1617) + lu(k,1621) = lu(k,1621) - lu(k,737) * lu(k,1617) + lu(k,1623) = lu(k,1623) - lu(k,738) * lu(k,1617) + lu(k,1625) = lu(k,1625) - lu(k,739) * lu(k,1617) + lu(k,1626) = lu(k,1626) - lu(k,740) * lu(k,1617) + lu(k,1629) = lu(k,1629) - lu(k,741) * lu(k,1617) + lu(k,1630) = lu(k,1630) - lu(k,742) * lu(k,1617) + lu(k,1632) = lu(k,1632) - lu(k,743) * lu(k,1617) + lu(k,1635) = lu(k,1635) - lu(k,744) * lu(k,1617) + lu(k,1638) = lu(k,1638) - lu(k,745) * lu(k,1617) + lu(k,1640) = lu(k,1640) - lu(k,746) * lu(k,1617) + lu(k,1641) = lu(k,1641) - lu(k,747) * lu(k,1617) + lu(k,1642) = lu(k,1642) - lu(k,748) * lu(k,1617) + lu(k,1643) = lu(k,1643) - lu(k,749) * lu(k,1617) + lu(k,1644) = lu(k,1644) - lu(k,750) * lu(k,1617) + lu(k,1645) = lu(k,1645) - lu(k,751) * lu(k,1617) + lu(k,1646) = lu(k,1646) - lu(k,752) * lu(k,1617) + lu(k,1647) = lu(k,1647) - lu(k,753) * lu(k,1617) + lu(k,1648) = lu(k,1648) - lu(k,754) * lu(k,1617) + lu(k,1703) = lu(k,1703) - lu(k,736) * lu(k,1702) + lu(k,1706) = lu(k,1706) - lu(k,737) * lu(k,1702) + lu(k,1708) = lu(k,1708) - lu(k,738) * lu(k,1702) + lu(k,1710) = lu(k,1710) - lu(k,739) * lu(k,1702) + lu(k,1711) = lu(k,1711) - lu(k,740) * lu(k,1702) + lu(k,1714) = lu(k,1714) - lu(k,741) * lu(k,1702) + lu(k,1715) = lu(k,1715) - lu(k,742) * lu(k,1702) + lu(k,1717) = lu(k,1717) - lu(k,743) * lu(k,1702) + lu(k,1720) = lu(k,1720) - lu(k,744) * lu(k,1702) + lu(k,1723) = lu(k,1723) - lu(k,745) * lu(k,1702) + lu(k,1725) = lu(k,1725) - lu(k,746) * lu(k,1702) + lu(k,1726) = lu(k,1726) - lu(k,747) * lu(k,1702) + lu(k,1727) = lu(k,1727) - lu(k,748) * lu(k,1702) + lu(k,1728) = lu(k,1728) - lu(k,749) * lu(k,1702) + lu(k,1729) = lu(k,1729) - lu(k,750) * lu(k,1702) + lu(k,1730) = lu(k,1730) - lu(k,751) * lu(k,1702) + lu(k,1731) = lu(k,1731) - lu(k,752) * lu(k,1702) + lu(k,1732) = lu(k,1732) - lu(k,753) * lu(k,1702) + lu(k,1733) = lu(k,1733) - lu(k,754) * lu(k,1702) + lu(k,1747) = lu(k,1747) - lu(k,736) * lu(k,1746) + lu(k,1751) = lu(k,1751) - lu(k,737) * lu(k,1746) + lu(k,1753) = lu(k,1753) - lu(k,738) * lu(k,1746) + lu(k,1755) = - lu(k,739) * lu(k,1746) + lu(k,1756) = lu(k,1756) - lu(k,740) * lu(k,1746) + lu(k,1759) = lu(k,1759) - lu(k,741) * lu(k,1746) + lu(k,1760) = lu(k,1760) - lu(k,742) * lu(k,1746) + lu(k,1762) = lu(k,1762) - lu(k,743) * lu(k,1746) + lu(k,1765) = lu(k,1765) - lu(k,744) * lu(k,1746) + lu(k,1768) = lu(k,1768) - lu(k,745) * lu(k,1746) + lu(k,1770) = lu(k,1770) - lu(k,746) * lu(k,1746) + lu(k,1771) = lu(k,1771) - lu(k,747) * lu(k,1746) + lu(k,1772) = lu(k,1772) - lu(k,748) * lu(k,1746) + lu(k,1773) = lu(k,1773) - lu(k,749) * lu(k,1746) + lu(k,1774) = lu(k,1774) - lu(k,750) * lu(k,1746) + lu(k,1775) = lu(k,1775) - lu(k,751) * lu(k,1746) + lu(k,1776) = lu(k,1776) - lu(k,752) * lu(k,1746) + lu(k,1777) = lu(k,1777) - lu(k,753) * lu(k,1746) + lu(k,1778) = lu(k,1778) - lu(k,754) * lu(k,1746) + lu(k,1797) = lu(k,1797) - lu(k,736) * lu(k,1796) + lu(k,1800) = lu(k,1800) - lu(k,737) * lu(k,1796) + lu(k,1802) = lu(k,1802) - lu(k,738) * lu(k,1796) + lu(k,1804) = lu(k,1804) - lu(k,739) * lu(k,1796) + lu(k,1805) = lu(k,1805) - lu(k,740) * lu(k,1796) + lu(k,1808) = lu(k,1808) - lu(k,741) * lu(k,1796) + lu(k,1809) = lu(k,1809) - lu(k,742) * lu(k,1796) + lu(k,1811) = lu(k,1811) - lu(k,743) * lu(k,1796) + lu(k,1814) = lu(k,1814) - lu(k,744) * lu(k,1796) + lu(k,1817) = lu(k,1817) - lu(k,745) * lu(k,1796) + lu(k,1819) = lu(k,1819) - lu(k,746) * lu(k,1796) + lu(k,1820) = lu(k,1820) - lu(k,747) * lu(k,1796) + lu(k,1821) = lu(k,1821) - lu(k,748) * lu(k,1796) + lu(k,1822) = lu(k,1822) - lu(k,749) * lu(k,1796) + lu(k,1823) = lu(k,1823) - lu(k,750) * lu(k,1796) + lu(k,1824) = lu(k,1824) - lu(k,751) * lu(k,1796) + lu(k,1825) = lu(k,1825) - lu(k,752) * lu(k,1796) + lu(k,1826) = lu(k,1826) - lu(k,753) * lu(k,1796) + lu(k,1827) = lu(k,1827) - lu(k,754) * lu(k,1796) + lu(k,1866) = lu(k,1866) - lu(k,736) * lu(k,1865) + lu(k,1869) = lu(k,1869) - lu(k,737) * lu(k,1865) + lu(k,1871) = lu(k,1871) - lu(k,738) * lu(k,1865) + lu(k,1873) = lu(k,1873) - lu(k,739) * lu(k,1865) + lu(k,1874) = lu(k,1874) - lu(k,740) * lu(k,1865) + lu(k,1877) = lu(k,1877) - lu(k,741) * lu(k,1865) + lu(k,1878) = lu(k,1878) - lu(k,742) * lu(k,1865) + lu(k,1880) = lu(k,1880) - lu(k,743) * lu(k,1865) + lu(k,1883) = lu(k,1883) - lu(k,744) * lu(k,1865) + lu(k,1886) = lu(k,1886) - lu(k,745) * lu(k,1865) + lu(k,1888) = lu(k,1888) - lu(k,746) * lu(k,1865) + lu(k,1889) = lu(k,1889) - lu(k,747) * lu(k,1865) + lu(k,1890) = lu(k,1890) - lu(k,748) * lu(k,1865) + lu(k,1891) = lu(k,1891) - lu(k,749) * lu(k,1865) + lu(k,1892) = lu(k,1892) - lu(k,750) * lu(k,1865) + lu(k,1893) = lu(k,1893) - lu(k,751) * lu(k,1865) + lu(k,1894) = lu(k,1894) - lu(k,752) * lu(k,1865) + lu(k,1895) = lu(k,1895) - lu(k,753) * lu(k,1865) + lu(k,1896) = lu(k,1896) - lu(k,754) * lu(k,1865) + lu(k,1907) = lu(k,1907) - lu(k,736) * lu(k,1906) + lu(k,1910) = lu(k,1910) - lu(k,737) * lu(k,1906) + lu(k,1912) = lu(k,1912) - lu(k,738) * lu(k,1906) + lu(k,1914) = lu(k,1914) - lu(k,739) * lu(k,1906) + lu(k,1915) = lu(k,1915) - lu(k,740) * lu(k,1906) + lu(k,1918) = lu(k,1918) - lu(k,741) * lu(k,1906) + lu(k,1919) = lu(k,1919) - lu(k,742) * lu(k,1906) + lu(k,1921) = lu(k,1921) - lu(k,743) * lu(k,1906) + lu(k,1924) = lu(k,1924) - lu(k,744) * lu(k,1906) + lu(k,1927) = lu(k,1927) - lu(k,745) * lu(k,1906) + lu(k,1929) = lu(k,1929) - lu(k,746) * lu(k,1906) + lu(k,1930) = lu(k,1930) - lu(k,747) * lu(k,1906) + lu(k,1931) = lu(k,1931) - lu(k,748) * lu(k,1906) + lu(k,1932) = lu(k,1932) - lu(k,749) * lu(k,1906) + lu(k,1933) = lu(k,1933) - lu(k,750) * lu(k,1906) + lu(k,1934) = lu(k,1934) - lu(k,751) * lu(k,1906) + lu(k,1935) = lu(k,1935) - lu(k,752) * lu(k,1906) + lu(k,1936) = lu(k,1936) - lu(k,753) * lu(k,1906) + lu(k,1937) = lu(k,1937) - lu(k,754) * lu(k,1906) + lu(k,1996) = lu(k,1996) - lu(k,736) * lu(k,1995) + lu(k,2000) = lu(k,2000) - lu(k,737) * lu(k,1995) + lu(k,2002) = lu(k,2002) - lu(k,738) * lu(k,1995) + lu(k,2004) = lu(k,2004) - lu(k,739) * lu(k,1995) + lu(k,2005) = lu(k,2005) - lu(k,740) * lu(k,1995) + lu(k,2008) = lu(k,2008) - lu(k,741) * lu(k,1995) + lu(k,2009) = lu(k,2009) - lu(k,742) * lu(k,1995) + lu(k,2011) = lu(k,2011) - lu(k,743) * lu(k,1995) + lu(k,2014) = lu(k,2014) - lu(k,744) * lu(k,1995) + lu(k,2017) = lu(k,2017) - lu(k,745) * lu(k,1995) + lu(k,2019) = lu(k,2019) - lu(k,746) * lu(k,1995) + lu(k,2020) = lu(k,2020) - lu(k,747) * lu(k,1995) + lu(k,2021) = lu(k,2021) - lu(k,748) * lu(k,1995) + lu(k,2022) = lu(k,2022) - lu(k,749) * lu(k,1995) + lu(k,2023) = lu(k,2023) - lu(k,750) * lu(k,1995) + lu(k,2024) = lu(k,2024) - lu(k,751) * lu(k,1995) + lu(k,2025) = lu(k,2025) - lu(k,752) * lu(k,1995) + lu(k,2026) = lu(k,2026) - lu(k,753) * lu(k,1995) + lu(k,2027) = lu(k,2027) - lu(k,754) * lu(k,1995) + lu(k,2057) = lu(k,2057) - lu(k,736) * lu(k,2056) + lu(k,2060) = lu(k,2060) - lu(k,737) * lu(k,2056) + lu(k,2062) = lu(k,2062) - lu(k,738) * lu(k,2056) + lu(k,2064) = lu(k,2064) - lu(k,739) * lu(k,2056) + lu(k,2065) = lu(k,2065) - lu(k,740) * lu(k,2056) + lu(k,2068) = lu(k,2068) - lu(k,741) * lu(k,2056) + lu(k,2069) = lu(k,2069) - lu(k,742) * lu(k,2056) + lu(k,2071) = lu(k,2071) - lu(k,743) * lu(k,2056) + lu(k,2074) = lu(k,2074) - lu(k,744) * lu(k,2056) + lu(k,2077) = lu(k,2077) - lu(k,745) * lu(k,2056) + lu(k,2079) = lu(k,2079) - lu(k,746) * lu(k,2056) + lu(k,2080) = lu(k,2080) - lu(k,747) * lu(k,2056) + lu(k,2081) = lu(k,2081) - lu(k,748) * lu(k,2056) + lu(k,2082) = lu(k,2082) - lu(k,749) * lu(k,2056) + lu(k,2083) = lu(k,2083) - lu(k,750) * lu(k,2056) + lu(k,2084) = lu(k,2084) - lu(k,751) * lu(k,2056) + lu(k,2085) = lu(k,2085) - lu(k,752) * lu(k,2056) + lu(k,2086) = lu(k,2086) - lu(k,753) * lu(k,2056) + lu(k,2087) = lu(k,2087) - lu(k,754) * lu(k,2056) + lu(k,784) = 1._r8 / lu(k,784) + lu(k,785) = lu(k,785) * lu(k,784) + lu(k,786) = lu(k,786) * lu(k,784) + lu(k,787) = lu(k,787) * lu(k,784) + lu(k,788) = lu(k,788) * lu(k,784) + lu(k,789) = lu(k,789) * lu(k,784) + lu(k,790) = lu(k,790) * lu(k,784) + lu(k,791) = lu(k,791) * lu(k,784) + lu(k,792) = lu(k,792) * lu(k,784) + lu(k,793) = lu(k,793) * lu(k,784) + lu(k,794) = lu(k,794) * lu(k,784) + lu(k,795) = lu(k,795) * lu(k,784) + lu(k,796) = lu(k,796) * lu(k,784) + lu(k,797) = lu(k,797) * lu(k,784) + lu(k,798) = lu(k,798) * lu(k,784) + lu(k,799) = lu(k,799) * lu(k,784) + lu(k,800) = lu(k,800) * lu(k,784) + lu(k,801) = lu(k,801) * lu(k,784) + lu(k,802) = lu(k,802) * lu(k,784) + lu(k,803) = lu(k,803) * lu(k,784) + lu(k,804) = lu(k,804) * lu(k,784) + lu(k,805) = lu(k,805) * lu(k,784) + lu(k,897) = lu(k,897) - lu(k,785) * lu(k,896) + lu(k,898) = lu(k,898) - lu(k,786) * lu(k,896) + lu(k,899) = lu(k,899) - lu(k,787) * lu(k,896) + lu(k,900) = lu(k,900) - lu(k,788) * lu(k,896) + lu(k,901) = lu(k,901) - lu(k,789) * lu(k,896) + lu(k,902) = lu(k,902) - lu(k,790) * lu(k,896) + lu(k,904) = lu(k,904) - lu(k,791) * lu(k,896) + lu(k,905) = lu(k,905) - lu(k,792) * lu(k,896) + lu(k,906) = lu(k,906) - lu(k,793) * lu(k,896) + lu(k,907) = - lu(k,794) * lu(k,896) + lu(k,908) = - lu(k,795) * lu(k,896) + lu(k,909) = lu(k,909) - lu(k,796) * lu(k,896) + lu(k,910) = lu(k,910) - lu(k,797) * lu(k,896) + lu(k,911) = lu(k,911) - lu(k,798) * lu(k,896) + lu(k,912) = lu(k,912) - lu(k,799) * lu(k,896) + lu(k,913) = lu(k,913) - lu(k,800) * lu(k,896) + lu(k,914) = lu(k,914) - lu(k,801) * lu(k,896) + lu(k,915) = lu(k,915) - lu(k,802) * lu(k,896) + lu(k,916) = lu(k,916) - lu(k,803) * lu(k,896) + lu(k,917) = lu(k,917) - lu(k,804) * lu(k,896) + lu(k,918) = lu(k,918) - lu(k,805) * lu(k,896) + lu(k,980) = lu(k,980) - lu(k,785) * lu(k,979) + lu(k,981) = lu(k,981) - lu(k,786) * lu(k,979) + lu(k,982) = lu(k,982) - lu(k,787) * lu(k,979) + lu(k,983) = lu(k,983) - lu(k,788) * lu(k,979) + lu(k,985) = lu(k,985) - lu(k,789) * lu(k,979) + lu(k,986) = lu(k,986) - lu(k,790) * lu(k,979) + lu(k,988) = lu(k,988) - lu(k,791) * lu(k,979) + lu(k,989) = lu(k,989) - lu(k,792) * lu(k,979) + lu(k,990) = lu(k,990) - lu(k,793) * lu(k,979) + lu(k,991) = - lu(k,794) * lu(k,979) + lu(k,992) = lu(k,992) - lu(k,795) * lu(k,979) + lu(k,993) = lu(k,993) - lu(k,796) * lu(k,979) + lu(k,994) = lu(k,994) - lu(k,797) * lu(k,979) + lu(k,995) = lu(k,995) - lu(k,798) * lu(k,979) + lu(k,996) = lu(k,996) - lu(k,799) * lu(k,979) + lu(k,997) = lu(k,997) - lu(k,800) * lu(k,979) + lu(k,998) = lu(k,998) - lu(k,801) * lu(k,979) + lu(k,999) = lu(k,999) - lu(k,802) * lu(k,979) + lu(k,1000) = lu(k,1000) - lu(k,803) * lu(k,979) + lu(k,1001) = lu(k,1001) - lu(k,804) * lu(k,979) + lu(k,1002) = lu(k,1002) - lu(k,805) * lu(k,979) + lu(k,1053) = lu(k,1053) - lu(k,785) * lu(k,1052) + lu(k,1054) = lu(k,1054) - lu(k,786) * lu(k,1052) + lu(k,1055) = lu(k,1055) - lu(k,787) * lu(k,1052) + lu(k,1056) = - lu(k,788) * lu(k,1052) + lu(k,1059) = - lu(k,789) * lu(k,1052) + lu(k,1060) = lu(k,1060) - lu(k,790) * lu(k,1052) + lu(k,1062) = lu(k,1062) - lu(k,791) * lu(k,1052) + lu(k,1064) = lu(k,1064) - lu(k,792) * lu(k,1052) + lu(k,1065) = - lu(k,793) * lu(k,1052) + lu(k,1066) = lu(k,1066) - lu(k,794) * lu(k,1052) + lu(k,1067) = lu(k,1067) - lu(k,795) * lu(k,1052) + lu(k,1068) = lu(k,1068) - lu(k,796) * lu(k,1052) + lu(k,1070) = lu(k,1070) - lu(k,797) * lu(k,1052) + lu(k,1071) = - lu(k,798) * lu(k,1052) + lu(k,1072) = lu(k,1072) - lu(k,799) * lu(k,1052) + lu(k,1073) = - lu(k,800) * lu(k,1052) + lu(k,1074) = lu(k,1074) - lu(k,801) * lu(k,1052) + lu(k,1075) = lu(k,1075) - lu(k,802) * lu(k,1052) + lu(k,1076) = lu(k,1076) - lu(k,803) * lu(k,1052) + lu(k,1077) = - lu(k,804) * lu(k,1052) + lu(k,1078) = lu(k,1078) - lu(k,805) * lu(k,1052) + lu(k,1092) = lu(k,1092) - lu(k,785) * lu(k,1090) + lu(k,1094) = lu(k,1094) - lu(k,786) * lu(k,1090) + lu(k,1095) = lu(k,1095) - lu(k,787) * lu(k,1090) + lu(k,1096) = lu(k,1096) - lu(k,788) * lu(k,1090) + lu(k,1099) = lu(k,1099) - lu(k,789) * lu(k,1090) + lu(k,1100) = lu(k,1100) - lu(k,790) * lu(k,1090) + lu(k,1102) = lu(k,1102) - lu(k,791) * lu(k,1090) + lu(k,1104) = lu(k,1104) - lu(k,792) * lu(k,1090) + lu(k,1105) = lu(k,1105) - lu(k,793) * lu(k,1090) + lu(k,1106) = - lu(k,794) * lu(k,1090) + lu(k,1107) = lu(k,1107) - lu(k,795) * lu(k,1090) + lu(k,1108) = lu(k,1108) - lu(k,796) * lu(k,1090) + lu(k,1110) = lu(k,1110) - lu(k,797) * lu(k,1090) + lu(k,1111) = lu(k,1111) - lu(k,798) * lu(k,1090) + lu(k,1112) = lu(k,1112) - lu(k,799) * lu(k,1090) + lu(k,1113) = lu(k,1113) - lu(k,800) * lu(k,1090) + lu(k,1114) = lu(k,1114) - lu(k,801) * lu(k,1090) + lu(k,1115) = lu(k,1115) - lu(k,802) * lu(k,1090) + lu(k,1116) = lu(k,1116) - lu(k,803) * lu(k,1090) + lu(k,1117) = lu(k,1117) - lu(k,804) * lu(k,1090) + lu(k,1118) = lu(k,1118) - lu(k,805) * lu(k,1090) + lu(k,1139) = lu(k,1139) - lu(k,785) * lu(k,1135) + lu(k,1141) = lu(k,1141) - lu(k,786) * lu(k,1135) + lu(k,1143) = lu(k,1143) - lu(k,787) * lu(k,1135) + lu(k,1144) = lu(k,1144) - lu(k,788) * lu(k,1135) + lu(k,1147) = lu(k,1147) - lu(k,789) * lu(k,1135) + lu(k,1148) = lu(k,1148) - lu(k,790) * lu(k,1135) + lu(k,1150) = lu(k,1150) - lu(k,791) * lu(k,1135) + lu(k,1152) = lu(k,1152) - lu(k,792) * lu(k,1135) + lu(k,1153) = lu(k,1153) - lu(k,793) * lu(k,1135) + lu(k,1154) = lu(k,1154) - lu(k,794) * lu(k,1135) + lu(k,1155) = lu(k,1155) - lu(k,795) * lu(k,1135) + lu(k,1156) = lu(k,1156) - lu(k,796) * lu(k,1135) + lu(k,1158) = lu(k,1158) - lu(k,797) * lu(k,1135) + lu(k,1159) = - lu(k,798) * lu(k,1135) + lu(k,1160) = lu(k,1160) - lu(k,799) * lu(k,1135) + lu(k,1161) = - lu(k,800) * lu(k,1135) + lu(k,1162) = - lu(k,801) * lu(k,1135) + lu(k,1163) = - lu(k,802) * lu(k,1135) + lu(k,1164) = lu(k,1164) - lu(k,803) * lu(k,1135) + lu(k,1165) = lu(k,1165) - lu(k,804) * lu(k,1135) + lu(k,1166) = lu(k,1166) - lu(k,805) * lu(k,1135) + lu(k,1223) = lu(k,1223) - lu(k,785) * lu(k,1220) + lu(k,1225) = lu(k,1225) - lu(k,786) * lu(k,1220) + lu(k,1227) = lu(k,1227) - lu(k,787) * lu(k,1220) + lu(k,1228) = lu(k,1228) - lu(k,788) * lu(k,1220) + lu(k,1231) = lu(k,1231) - lu(k,789) * lu(k,1220) + lu(k,1232) = lu(k,1232) - lu(k,790) * lu(k,1220) + lu(k,1234) = lu(k,1234) - lu(k,791) * lu(k,1220) + lu(k,1236) = lu(k,1236) - lu(k,792) * lu(k,1220) + lu(k,1237) = lu(k,1237) - lu(k,793) * lu(k,1220) + lu(k,1238) = lu(k,1238) - lu(k,794) * lu(k,1220) + lu(k,1239) = lu(k,1239) - lu(k,795) * lu(k,1220) + lu(k,1240) = lu(k,1240) - lu(k,796) * lu(k,1220) + lu(k,1242) = lu(k,1242) - lu(k,797) * lu(k,1220) + lu(k,1243) = lu(k,1243) - lu(k,798) * lu(k,1220) + lu(k,1244) = lu(k,1244) - lu(k,799) * lu(k,1220) + lu(k,1245) = lu(k,1245) - lu(k,800) * lu(k,1220) + lu(k,1246) = lu(k,1246) - lu(k,801) * lu(k,1220) + lu(k,1247) = lu(k,1247) - lu(k,802) * lu(k,1220) + lu(k,1248) = lu(k,1248) - lu(k,803) * lu(k,1220) + lu(k,1249) = lu(k,1249) - lu(k,804) * lu(k,1220) + lu(k,1250) = lu(k,1250) - lu(k,805) * lu(k,1220) + lu(k,1283) = lu(k,1283) - lu(k,785) * lu(k,1279) + lu(k,1285) = lu(k,1285) - lu(k,786) * lu(k,1279) + lu(k,1287) = lu(k,1287) - lu(k,787) * lu(k,1279) + lu(k,1288) = lu(k,1288) - lu(k,788) * lu(k,1279) + lu(k,1291) = lu(k,1291) - lu(k,789) * lu(k,1279) + lu(k,1292) = lu(k,1292) - lu(k,790) * lu(k,1279) + lu(k,1294) = lu(k,1294) - lu(k,791) * lu(k,1279) + lu(k,1296) = lu(k,1296) - lu(k,792) * lu(k,1279) + lu(k,1297) = lu(k,1297) - lu(k,793) * lu(k,1279) + lu(k,1298) = lu(k,1298) - lu(k,794) * lu(k,1279) + lu(k,1299) = lu(k,1299) - lu(k,795) * lu(k,1279) + lu(k,1300) = lu(k,1300) - lu(k,796) * lu(k,1279) + lu(k,1302) = lu(k,1302) - lu(k,797) * lu(k,1279) + lu(k,1303) = lu(k,1303) - lu(k,798) * lu(k,1279) + lu(k,1304) = lu(k,1304) - lu(k,799) * lu(k,1279) + lu(k,1305) = lu(k,1305) - lu(k,800) * lu(k,1279) + lu(k,1306) = lu(k,1306) - lu(k,801) * lu(k,1279) + lu(k,1307) = lu(k,1307) - lu(k,802) * lu(k,1279) + lu(k,1308) = lu(k,1308) - lu(k,803) * lu(k,1279) + lu(k,1309) = lu(k,1309) - lu(k,804) * lu(k,1279) + lu(k,1310) = lu(k,1310) - lu(k,805) * lu(k,1279) + lu(k,1361) = lu(k,1361) - lu(k,785) * lu(k,1357) + lu(k,1363) = lu(k,1363) - lu(k,786) * lu(k,1357) + lu(k,1365) = lu(k,1365) - lu(k,787) * lu(k,1357) + lu(k,1366) = lu(k,1366) - lu(k,788) * lu(k,1357) + lu(k,1369) = lu(k,1369) - lu(k,789) * lu(k,1357) + lu(k,1370) = lu(k,1370) - lu(k,790) * lu(k,1357) + lu(k,1372) = lu(k,1372) - lu(k,791) * lu(k,1357) + lu(k,1374) = lu(k,1374) - lu(k,792) * lu(k,1357) + lu(k,1375) = lu(k,1375) - lu(k,793) * lu(k,1357) + lu(k,1376) = lu(k,1376) - lu(k,794) * lu(k,1357) + lu(k,1377) = - lu(k,795) * lu(k,1357) + lu(k,1378) = lu(k,1378) - lu(k,796) * lu(k,1357) + lu(k,1380) = lu(k,1380) - lu(k,797) * lu(k,1357) + lu(k,1381) = lu(k,1381) - lu(k,798) * lu(k,1357) + lu(k,1382) = lu(k,1382) - lu(k,799) * lu(k,1357) + lu(k,1383) = lu(k,1383) - lu(k,800) * lu(k,1357) + lu(k,1384) = lu(k,1384) - lu(k,801) * lu(k,1357) + lu(k,1385) = lu(k,1385) - lu(k,802) * lu(k,1357) + lu(k,1386) = lu(k,1386) - lu(k,803) * lu(k,1357) + lu(k,1387) = lu(k,1387) - lu(k,804) * lu(k,1357) + lu(k,1388) = lu(k,1388) - lu(k,805) * lu(k,1357) + lu(k,1492) = lu(k,1492) - lu(k,785) * lu(k,1488) + lu(k,1494) = lu(k,1494) - lu(k,786) * lu(k,1488) + lu(k,1496) = lu(k,1496) - lu(k,787) * lu(k,1488) + lu(k,1497) = lu(k,1497) - lu(k,788) * lu(k,1488) + lu(k,1500) = lu(k,1500) - lu(k,789) * lu(k,1488) + lu(k,1501) = lu(k,1501) - lu(k,790) * lu(k,1488) + lu(k,1503) = lu(k,1503) - lu(k,791) * lu(k,1488) + lu(k,1505) = lu(k,1505) - lu(k,792) * lu(k,1488) + lu(k,1506) = lu(k,1506) - lu(k,793) * lu(k,1488) + lu(k,1507) = lu(k,1507) - lu(k,794) * lu(k,1488) + lu(k,1508) = lu(k,1508) - lu(k,795) * lu(k,1488) + lu(k,1509) = lu(k,1509) - lu(k,796) * lu(k,1488) + lu(k,1511) = lu(k,1511) - lu(k,797) * lu(k,1488) + lu(k,1512) = lu(k,1512) - lu(k,798) * lu(k,1488) + lu(k,1513) = lu(k,1513) - lu(k,799) * lu(k,1488) + lu(k,1514) = lu(k,1514) - lu(k,800) * lu(k,1488) + lu(k,1515) = lu(k,1515) - lu(k,801) * lu(k,1488) + lu(k,1516) = lu(k,1516) - lu(k,802) * lu(k,1488) + lu(k,1517) = lu(k,1517) - lu(k,803) * lu(k,1488) + lu(k,1518) = lu(k,1518) - lu(k,804) * lu(k,1488) + lu(k,1519) = lu(k,1519) - lu(k,805) * lu(k,1488) + lu(k,1573) = lu(k,1573) - lu(k,785) * lu(k,1569) + lu(k,1575) = lu(k,1575) - lu(k,786) * lu(k,1569) + lu(k,1577) = lu(k,1577) - lu(k,787) * lu(k,1569) + lu(k,1578) = lu(k,1578) - lu(k,788) * lu(k,1569) + lu(k,1581) = lu(k,1581) - lu(k,789) * lu(k,1569) + lu(k,1582) = lu(k,1582) - lu(k,790) * lu(k,1569) + lu(k,1584) = lu(k,1584) - lu(k,791) * lu(k,1569) + lu(k,1586) = lu(k,1586) - lu(k,792) * lu(k,1569) + lu(k,1587) = lu(k,1587) - lu(k,793) * lu(k,1569) + lu(k,1588) = lu(k,1588) - lu(k,794) * lu(k,1569) + lu(k,1589) = lu(k,1589) - lu(k,795) * lu(k,1569) + lu(k,1590) = lu(k,1590) - lu(k,796) * lu(k,1569) + lu(k,1592) = lu(k,1592) - lu(k,797) * lu(k,1569) + lu(k,1593) = - lu(k,798) * lu(k,1569) + lu(k,1594) = lu(k,1594) - lu(k,799) * lu(k,1569) + lu(k,1595) = - lu(k,800) * lu(k,1569) + lu(k,1596) = lu(k,1596) - lu(k,801) * lu(k,1569) + lu(k,1597) = lu(k,1597) - lu(k,802) * lu(k,1569) + lu(k,1598) = lu(k,1598) - lu(k,803) * lu(k,1569) + lu(k,1599) = lu(k,1599) - lu(k,804) * lu(k,1569) + lu(k,1600) = lu(k,1600) - lu(k,805) * lu(k,1569) + lu(k,1621) = lu(k,1621) - lu(k,785) * lu(k,1618) + lu(k,1623) = lu(k,1623) - lu(k,786) * lu(k,1618) + lu(k,1625) = lu(k,1625) - lu(k,787) * lu(k,1618) + lu(k,1626) = lu(k,1626) - lu(k,788) * lu(k,1618) + lu(k,1629) = lu(k,1629) - lu(k,789) * lu(k,1618) + lu(k,1630) = lu(k,1630) - lu(k,790) * lu(k,1618) + lu(k,1632) = lu(k,1632) - lu(k,791) * lu(k,1618) + lu(k,1634) = lu(k,1634) - lu(k,792) * lu(k,1618) + lu(k,1635) = lu(k,1635) - lu(k,793) * lu(k,1618) + lu(k,1636) = lu(k,1636) - lu(k,794) * lu(k,1618) + lu(k,1637) = lu(k,1637) - lu(k,795) * lu(k,1618) + lu(k,1638) = lu(k,1638) - lu(k,796) * lu(k,1618) + lu(k,1640) = lu(k,1640) - lu(k,797) * lu(k,1618) + lu(k,1641) = lu(k,1641) - lu(k,798) * lu(k,1618) + lu(k,1642) = lu(k,1642) - lu(k,799) * lu(k,1618) + lu(k,1643) = lu(k,1643) - lu(k,800) * lu(k,1618) + lu(k,1644) = lu(k,1644) - lu(k,801) * lu(k,1618) + lu(k,1645) = lu(k,1645) - lu(k,802) * lu(k,1618) + lu(k,1646) = lu(k,1646) - lu(k,803) * lu(k,1618) + lu(k,1647) = lu(k,1647) - lu(k,804) * lu(k,1618) + lu(k,1648) = lu(k,1648) - lu(k,805) * lu(k,1618) + lu(k,1706) = lu(k,1706) - lu(k,785) * lu(k,1703) + lu(k,1708) = lu(k,1708) - lu(k,786) * lu(k,1703) + lu(k,1710) = lu(k,1710) - lu(k,787) * lu(k,1703) + lu(k,1711) = lu(k,1711) - lu(k,788) * lu(k,1703) + lu(k,1714) = lu(k,1714) - lu(k,789) * lu(k,1703) + lu(k,1715) = lu(k,1715) - lu(k,790) * lu(k,1703) + lu(k,1717) = lu(k,1717) - lu(k,791) * lu(k,1703) + lu(k,1719) = lu(k,1719) - lu(k,792) * lu(k,1703) + lu(k,1720) = lu(k,1720) - lu(k,793) * lu(k,1703) + lu(k,1721) = lu(k,1721) - lu(k,794) * lu(k,1703) + lu(k,1722) = lu(k,1722) - lu(k,795) * lu(k,1703) + lu(k,1723) = lu(k,1723) - lu(k,796) * lu(k,1703) + lu(k,1725) = lu(k,1725) - lu(k,797) * lu(k,1703) + lu(k,1726) = lu(k,1726) - lu(k,798) * lu(k,1703) + lu(k,1727) = lu(k,1727) - lu(k,799) * lu(k,1703) + lu(k,1728) = lu(k,1728) - lu(k,800) * lu(k,1703) + lu(k,1729) = lu(k,1729) - lu(k,801) * lu(k,1703) + lu(k,1730) = lu(k,1730) - lu(k,802) * lu(k,1703) + lu(k,1731) = lu(k,1731) - lu(k,803) * lu(k,1703) + lu(k,1732) = lu(k,1732) - lu(k,804) * lu(k,1703) + lu(k,1733) = lu(k,1733) - lu(k,805) * lu(k,1703) + lu(k,1751) = lu(k,1751) - lu(k,785) * lu(k,1747) + lu(k,1753) = lu(k,1753) - lu(k,786) * lu(k,1747) + lu(k,1755) = lu(k,1755) - lu(k,787) * lu(k,1747) + lu(k,1756) = lu(k,1756) - lu(k,788) * lu(k,1747) + lu(k,1759) = lu(k,1759) - lu(k,789) * lu(k,1747) + lu(k,1760) = lu(k,1760) - lu(k,790) * lu(k,1747) + lu(k,1762) = lu(k,1762) - lu(k,791) * lu(k,1747) + lu(k,1764) = - lu(k,792) * lu(k,1747) + lu(k,1765) = lu(k,1765) - lu(k,793) * lu(k,1747) + lu(k,1766) = lu(k,1766) - lu(k,794) * lu(k,1747) + lu(k,1767) = - lu(k,795) * lu(k,1747) + lu(k,1768) = lu(k,1768) - lu(k,796) * lu(k,1747) + lu(k,1770) = lu(k,1770) - lu(k,797) * lu(k,1747) + lu(k,1771) = lu(k,1771) - lu(k,798) * lu(k,1747) + lu(k,1772) = lu(k,1772) - lu(k,799) * lu(k,1747) + lu(k,1773) = lu(k,1773) - lu(k,800) * lu(k,1747) + lu(k,1774) = lu(k,1774) - lu(k,801) * lu(k,1747) + lu(k,1775) = lu(k,1775) - lu(k,802) * lu(k,1747) + lu(k,1776) = lu(k,1776) - lu(k,803) * lu(k,1747) + lu(k,1777) = lu(k,1777) - lu(k,804) * lu(k,1747) + lu(k,1778) = lu(k,1778) - lu(k,805) * lu(k,1747) + lu(k,1800) = lu(k,1800) - lu(k,785) * lu(k,1797) + lu(k,1802) = lu(k,1802) - lu(k,786) * lu(k,1797) + lu(k,1804) = lu(k,1804) - lu(k,787) * lu(k,1797) + lu(k,1805) = lu(k,1805) - lu(k,788) * lu(k,1797) + lu(k,1808) = lu(k,1808) - lu(k,789) * lu(k,1797) + lu(k,1809) = lu(k,1809) - lu(k,790) * lu(k,1797) + lu(k,1811) = lu(k,1811) - lu(k,791) * lu(k,1797) + lu(k,1813) = lu(k,1813) - lu(k,792) * lu(k,1797) + lu(k,1814) = lu(k,1814) - lu(k,793) * lu(k,1797) + lu(k,1815) = lu(k,1815) - lu(k,794) * lu(k,1797) + lu(k,1816) = lu(k,1816) - lu(k,795) * lu(k,1797) + lu(k,1817) = lu(k,1817) - lu(k,796) * lu(k,1797) + lu(k,1819) = lu(k,1819) - lu(k,797) * lu(k,1797) + lu(k,1820) = lu(k,1820) - lu(k,798) * lu(k,1797) + lu(k,1821) = lu(k,1821) - lu(k,799) * lu(k,1797) + lu(k,1822) = lu(k,1822) - lu(k,800) * lu(k,1797) + lu(k,1823) = lu(k,1823) - lu(k,801) * lu(k,1797) + lu(k,1824) = lu(k,1824) - lu(k,802) * lu(k,1797) + lu(k,1825) = lu(k,1825) - lu(k,803) * lu(k,1797) + lu(k,1826) = lu(k,1826) - lu(k,804) * lu(k,1797) + lu(k,1827) = lu(k,1827) - lu(k,805) * lu(k,1797) + lu(k,1869) = lu(k,1869) - lu(k,785) * lu(k,1866) + lu(k,1871) = lu(k,1871) - lu(k,786) * lu(k,1866) + lu(k,1873) = lu(k,1873) - lu(k,787) * lu(k,1866) + lu(k,1874) = lu(k,1874) - lu(k,788) * lu(k,1866) + lu(k,1877) = lu(k,1877) - lu(k,789) * lu(k,1866) + lu(k,1878) = lu(k,1878) - lu(k,790) * lu(k,1866) + lu(k,1880) = lu(k,1880) - lu(k,791) * lu(k,1866) + lu(k,1882) = lu(k,1882) - lu(k,792) * lu(k,1866) + lu(k,1883) = lu(k,1883) - lu(k,793) * lu(k,1866) + lu(k,1884) = lu(k,1884) - lu(k,794) * lu(k,1866) + lu(k,1885) = lu(k,1885) - lu(k,795) * lu(k,1866) + lu(k,1886) = lu(k,1886) - lu(k,796) * lu(k,1866) + lu(k,1888) = lu(k,1888) - lu(k,797) * lu(k,1866) + lu(k,1889) = lu(k,1889) - lu(k,798) * lu(k,1866) + lu(k,1890) = lu(k,1890) - lu(k,799) * lu(k,1866) + lu(k,1891) = lu(k,1891) - lu(k,800) * lu(k,1866) + lu(k,1892) = lu(k,1892) - lu(k,801) * lu(k,1866) + lu(k,1893) = lu(k,1893) - lu(k,802) * lu(k,1866) + lu(k,1894) = lu(k,1894) - lu(k,803) * lu(k,1866) + lu(k,1895) = lu(k,1895) - lu(k,804) * lu(k,1866) + lu(k,1896) = lu(k,1896) - lu(k,805) * lu(k,1866) + lu(k,1910) = lu(k,1910) - lu(k,785) * lu(k,1907) + lu(k,1912) = lu(k,1912) - lu(k,786) * lu(k,1907) + lu(k,1914) = lu(k,1914) - lu(k,787) * lu(k,1907) + lu(k,1915) = lu(k,1915) - lu(k,788) * lu(k,1907) + lu(k,1918) = lu(k,1918) - lu(k,789) * lu(k,1907) + lu(k,1919) = lu(k,1919) - lu(k,790) * lu(k,1907) + lu(k,1921) = lu(k,1921) - lu(k,791) * lu(k,1907) + lu(k,1923) = lu(k,1923) - lu(k,792) * lu(k,1907) + lu(k,1924) = lu(k,1924) - lu(k,793) * lu(k,1907) + lu(k,1925) = lu(k,1925) - lu(k,794) * lu(k,1907) + lu(k,1926) = lu(k,1926) - lu(k,795) * lu(k,1907) + lu(k,1927) = lu(k,1927) - lu(k,796) * lu(k,1907) + lu(k,1929) = lu(k,1929) - lu(k,797) * lu(k,1907) + lu(k,1930) = lu(k,1930) - lu(k,798) * lu(k,1907) + lu(k,1931) = lu(k,1931) - lu(k,799) * lu(k,1907) + lu(k,1932) = lu(k,1932) - lu(k,800) * lu(k,1907) + lu(k,1933) = lu(k,1933) - lu(k,801) * lu(k,1907) + lu(k,1934) = lu(k,1934) - lu(k,802) * lu(k,1907) + lu(k,1935) = lu(k,1935) - lu(k,803) * lu(k,1907) + lu(k,1936) = lu(k,1936) - lu(k,804) * lu(k,1907) + lu(k,1937) = lu(k,1937) - lu(k,805) * lu(k,1907) + lu(k,1952) = lu(k,1952) - lu(k,785) * lu(k,1949) + lu(k,1954) = lu(k,1954) - lu(k,786) * lu(k,1949) + lu(k,1956) = lu(k,1956) - lu(k,787) * lu(k,1949) + lu(k,1957) = - lu(k,788) * lu(k,1949) + lu(k,1960) = - lu(k,789) * lu(k,1949) + lu(k,1961) = lu(k,1961) - lu(k,790) * lu(k,1949) + lu(k,1963) = lu(k,1963) - lu(k,791) * lu(k,1949) + lu(k,1965) = lu(k,1965) - lu(k,792) * lu(k,1949) + lu(k,1966) = - lu(k,793) * lu(k,1949) + lu(k,1967) = lu(k,1967) - lu(k,794) * lu(k,1949) + lu(k,1968) = lu(k,1968) - lu(k,795) * lu(k,1949) + lu(k,1969) = lu(k,1969) - lu(k,796) * lu(k,1949) + lu(k,1971) = lu(k,1971) - lu(k,797) * lu(k,1949) + lu(k,1972) = - lu(k,798) * lu(k,1949) + lu(k,1973) = lu(k,1973) - lu(k,799) * lu(k,1949) + lu(k,1974) = lu(k,1974) - lu(k,800) * lu(k,1949) + lu(k,1975) = lu(k,1975) - lu(k,801) * lu(k,1949) + lu(k,1976) = lu(k,1976) - lu(k,802) * lu(k,1949) + lu(k,1977) = lu(k,1977) - lu(k,803) * lu(k,1949) + lu(k,1978) = - lu(k,804) * lu(k,1949) + lu(k,1979) = lu(k,1979) - lu(k,805) * lu(k,1949) + lu(k,2000) = lu(k,2000) - lu(k,785) * lu(k,1996) + lu(k,2002) = lu(k,2002) - lu(k,786) * lu(k,1996) + lu(k,2004) = lu(k,2004) - lu(k,787) * lu(k,1996) + lu(k,2005) = lu(k,2005) - lu(k,788) * lu(k,1996) + lu(k,2008) = lu(k,2008) - lu(k,789) * lu(k,1996) + lu(k,2009) = lu(k,2009) - lu(k,790) * lu(k,1996) + lu(k,2011) = lu(k,2011) - lu(k,791) * lu(k,1996) + lu(k,2013) = - lu(k,792) * lu(k,1996) + lu(k,2014) = lu(k,2014) - lu(k,793) * lu(k,1996) + lu(k,2015) = lu(k,2015) - lu(k,794) * lu(k,1996) + lu(k,2016) = - lu(k,795) * lu(k,1996) + lu(k,2017) = lu(k,2017) - lu(k,796) * lu(k,1996) + lu(k,2019) = lu(k,2019) - lu(k,797) * lu(k,1996) + lu(k,2020) = lu(k,2020) - lu(k,798) * lu(k,1996) + lu(k,2021) = lu(k,2021) - lu(k,799) * lu(k,1996) + lu(k,2022) = lu(k,2022) - lu(k,800) * lu(k,1996) + lu(k,2023) = lu(k,2023) - lu(k,801) * lu(k,1996) + lu(k,2024) = lu(k,2024) - lu(k,802) * lu(k,1996) + lu(k,2025) = lu(k,2025) - lu(k,803) * lu(k,1996) + lu(k,2026) = lu(k,2026) - lu(k,804) * lu(k,1996) + lu(k,2027) = lu(k,2027) - lu(k,805) * lu(k,1996) + lu(k,2060) = lu(k,2060) - lu(k,785) * lu(k,2057) + lu(k,2062) = lu(k,2062) - lu(k,786) * lu(k,2057) + lu(k,2064) = lu(k,2064) - lu(k,787) * lu(k,2057) + lu(k,2065) = lu(k,2065) - lu(k,788) * lu(k,2057) + lu(k,2068) = lu(k,2068) - lu(k,789) * lu(k,2057) + lu(k,2069) = lu(k,2069) - lu(k,790) * lu(k,2057) + lu(k,2071) = lu(k,2071) - lu(k,791) * lu(k,2057) + lu(k,2073) = lu(k,2073) - lu(k,792) * lu(k,2057) + lu(k,2074) = lu(k,2074) - lu(k,793) * lu(k,2057) + lu(k,2075) = lu(k,2075) - lu(k,794) * lu(k,2057) + lu(k,2076) = lu(k,2076) - lu(k,795) * lu(k,2057) + lu(k,2077) = lu(k,2077) - lu(k,796) * lu(k,2057) + lu(k,2079) = lu(k,2079) - lu(k,797) * lu(k,2057) + lu(k,2080) = lu(k,2080) - lu(k,798) * lu(k,2057) + lu(k,2081) = lu(k,2081) - lu(k,799) * lu(k,2057) + lu(k,2082) = lu(k,2082) - lu(k,800) * lu(k,2057) + lu(k,2083) = lu(k,2083) - lu(k,801) * lu(k,2057) + lu(k,2084) = lu(k,2084) - lu(k,802) * lu(k,2057) + lu(k,2085) = lu(k,2085) - lu(k,803) * lu(k,2057) + lu(k,2086) = lu(k,2086) - lu(k,804) * lu(k,2057) + lu(k,2087) = lu(k,2087) - lu(k,805) * lu(k,2057) end do end subroutine lu_fac18 subroutine lu_fac19( avec_len, lu ) @@ -8181,1506 +5854,916 @@ subroutine lu_fac19( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,852) = 1._r8 / lu(k,852) - lu(k,853) = lu(k,853) * lu(k,852) - lu(k,854) = lu(k,854) * lu(k,852) - lu(k,855) = lu(k,855) * lu(k,852) - lu(k,856) = lu(k,856) * lu(k,852) - lu(k,857) = lu(k,857) * lu(k,852) - lu(k,858) = lu(k,858) * lu(k,852) - lu(k,859) = lu(k,859) * lu(k,852) - lu(k,860) = lu(k,860) * lu(k,852) - lu(k,861) = lu(k,861) * lu(k,852) - lu(k,862) = lu(k,862) * lu(k,852) - lu(k,863) = lu(k,863) * lu(k,852) - lu(k,864) = lu(k,864) * lu(k,852) - lu(k,865) = lu(k,865) * lu(k,852) - lu(k,866) = lu(k,866) * lu(k,852) - lu(k,867) = lu(k,867) * lu(k,852) - lu(k,868) = lu(k,868) * lu(k,852) - lu(k,869) = lu(k,869) * lu(k,852) - lu(k,870) = lu(k,870) * lu(k,852) - lu(k,871) = lu(k,871) * lu(k,852) - lu(k,872) = lu(k,872) * lu(k,852) - lu(k,873) = lu(k,873) * lu(k,852) - lu(k,874) = lu(k,874) * lu(k,852) - lu(k,875) = lu(k,875) * lu(k,852) - lu(k,900) = lu(k,900) - lu(k,853) * lu(k,899) - lu(k,901) = lu(k,901) - lu(k,854) * lu(k,899) - lu(k,902) = lu(k,902) - lu(k,855) * lu(k,899) - lu(k,903) = lu(k,903) - lu(k,856) * lu(k,899) - lu(k,904) = lu(k,904) - lu(k,857) * lu(k,899) - lu(k,905) = lu(k,905) - lu(k,858) * lu(k,899) - lu(k,906) = lu(k,906) - lu(k,859) * lu(k,899) - lu(k,907) = lu(k,907) - lu(k,860) * lu(k,899) - lu(k,908) = lu(k,908) - lu(k,861) * lu(k,899) - lu(k,909) = lu(k,909) - lu(k,862) * lu(k,899) - lu(k,910) = lu(k,910) - lu(k,863) * lu(k,899) - lu(k,911) = lu(k,911) - lu(k,864) * lu(k,899) - lu(k,912) = lu(k,912) - lu(k,865) * lu(k,899) - lu(k,913) = lu(k,913) - lu(k,866) * lu(k,899) - lu(k,914) = lu(k,914) - lu(k,867) * lu(k,899) - lu(k,915) = lu(k,915) - lu(k,868) * lu(k,899) - lu(k,916) = lu(k,916) - lu(k,869) * lu(k,899) - lu(k,917) = lu(k,917) - lu(k,870) * lu(k,899) - lu(k,918) = lu(k,918) - lu(k,871) * lu(k,899) - lu(k,919) = lu(k,919) - lu(k,872) * lu(k,899) - lu(k,920) = lu(k,920) - lu(k,873) * lu(k,899) - lu(k,921) = lu(k,921) - lu(k,874) * lu(k,899) - lu(k,922) = lu(k,922) - lu(k,875) * lu(k,899) - lu(k,942) = lu(k,942) - lu(k,853) * lu(k,941) - lu(k,943) = lu(k,943) - lu(k,854) * lu(k,941) - lu(k,944) = lu(k,944) - lu(k,855) * lu(k,941) - lu(k,945) = lu(k,945) - lu(k,856) * lu(k,941) - lu(k,946) = lu(k,946) - lu(k,857) * lu(k,941) - lu(k,947) = lu(k,947) - lu(k,858) * lu(k,941) - lu(k,948) = lu(k,948) - lu(k,859) * lu(k,941) - lu(k,949) = lu(k,949) - lu(k,860) * lu(k,941) - lu(k,950) = lu(k,950) - lu(k,861) * lu(k,941) - lu(k,951) = lu(k,951) - lu(k,862) * lu(k,941) - lu(k,952) = lu(k,952) - lu(k,863) * lu(k,941) - lu(k,953) = lu(k,953) - lu(k,864) * lu(k,941) - lu(k,954) = lu(k,954) - lu(k,865) * lu(k,941) - lu(k,955) = lu(k,955) - lu(k,866) * lu(k,941) - lu(k,956) = lu(k,956) - lu(k,867) * lu(k,941) - lu(k,957) = lu(k,957) - lu(k,868) * lu(k,941) - lu(k,958) = lu(k,958) - lu(k,869) * lu(k,941) - lu(k,959) = lu(k,959) - lu(k,870) * lu(k,941) - lu(k,960) = lu(k,960) - lu(k,871) * lu(k,941) - lu(k,961) = lu(k,961) - lu(k,872) * lu(k,941) - lu(k,962) = lu(k,962) - lu(k,873) * lu(k,941) - lu(k,963) = lu(k,963) - lu(k,874) * lu(k,941) - lu(k,964) = lu(k,964) - lu(k,875) * lu(k,941) - lu(k,988) = lu(k,988) - lu(k,853) * lu(k,987) - lu(k,989) = lu(k,989) - lu(k,854) * lu(k,987) - lu(k,990) = lu(k,990) - lu(k,855) * lu(k,987) - lu(k,991) = lu(k,991) - lu(k,856) * lu(k,987) - lu(k,992) = lu(k,992) - lu(k,857) * lu(k,987) - lu(k,993) = lu(k,993) - lu(k,858) * lu(k,987) - lu(k,994) = lu(k,994) - lu(k,859) * lu(k,987) - lu(k,995) = lu(k,995) - lu(k,860) * lu(k,987) - lu(k,996) = lu(k,996) - lu(k,861) * lu(k,987) - lu(k,997) = lu(k,997) - lu(k,862) * lu(k,987) - lu(k,998) = lu(k,998) - lu(k,863) * lu(k,987) - lu(k,999) = lu(k,999) - lu(k,864) * lu(k,987) - lu(k,1000) = lu(k,1000) - lu(k,865) * lu(k,987) - lu(k,1001) = lu(k,1001) - lu(k,866) * lu(k,987) - lu(k,1002) = lu(k,1002) - lu(k,867) * lu(k,987) - lu(k,1003) = lu(k,1003) - lu(k,868) * lu(k,987) - lu(k,1004) = lu(k,1004) - lu(k,869) * lu(k,987) - lu(k,1005) = lu(k,1005) - lu(k,870) * lu(k,987) - lu(k,1006) = lu(k,1006) - lu(k,871) * lu(k,987) - lu(k,1007) = lu(k,1007) - lu(k,872) * lu(k,987) - lu(k,1008) = lu(k,1008) - lu(k,873) * lu(k,987) - lu(k,1009) = lu(k,1009) - lu(k,874) * lu(k,987) - lu(k,1010) = lu(k,1010) - lu(k,875) * lu(k,987) - lu(k,1030) = lu(k,1030) - lu(k,853) * lu(k,1029) - lu(k,1031) = lu(k,1031) - lu(k,854) * lu(k,1029) - lu(k,1032) = lu(k,1032) - lu(k,855) * lu(k,1029) - lu(k,1033) = lu(k,1033) - lu(k,856) * lu(k,1029) - lu(k,1034) = lu(k,1034) - lu(k,857) * lu(k,1029) - lu(k,1035) = lu(k,1035) - lu(k,858) * lu(k,1029) - lu(k,1036) = lu(k,1036) - lu(k,859) * lu(k,1029) - lu(k,1037) = lu(k,1037) - lu(k,860) * lu(k,1029) - lu(k,1038) = lu(k,1038) - lu(k,861) * lu(k,1029) - lu(k,1039) = lu(k,1039) - lu(k,862) * lu(k,1029) - lu(k,1040) = lu(k,1040) - lu(k,863) * lu(k,1029) - lu(k,1041) = lu(k,1041) - lu(k,864) * lu(k,1029) - lu(k,1042) = lu(k,1042) - lu(k,865) * lu(k,1029) - lu(k,1043) = lu(k,1043) - lu(k,866) * lu(k,1029) - lu(k,1044) = lu(k,1044) - lu(k,867) * lu(k,1029) - lu(k,1045) = lu(k,1045) - lu(k,868) * lu(k,1029) - lu(k,1046) = lu(k,1046) - lu(k,869) * lu(k,1029) - lu(k,1047) = lu(k,1047) - lu(k,870) * lu(k,1029) - lu(k,1048) = lu(k,1048) - lu(k,871) * lu(k,1029) - lu(k,1049) = lu(k,1049) - lu(k,872) * lu(k,1029) - lu(k,1050) = lu(k,1050) - lu(k,873) * lu(k,1029) - lu(k,1051) = lu(k,1051) - lu(k,874) * lu(k,1029) - lu(k,1052) = lu(k,1052) - lu(k,875) * lu(k,1029) - lu(k,1071) = lu(k,1071) - lu(k,853) * lu(k,1070) - lu(k,1072) = lu(k,1072) - lu(k,854) * lu(k,1070) - lu(k,1073) = lu(k,1073) - lu(k,855) * lu(k,1070) - lu(k,1074) = lu(k,1074) - lu(k,856) * lu(k,1070) - lu(k,1075) = lu(k,1075) - lu(k,857) * lu(k,1070) - lu(k,1076) = lu(k,1076) - lu(k,858) * lu(k,1070) - lu(k,1077) = lu(k,1077) - lu(k,859) * lu(k,1070) - lu(k,1078) = lu(k,1078) - lu(k,860) * lu(k,1070) - lu(k,1079) = lu(k,1079) - lu(k,861) * lu(k,1070) - lu(k,1080) = lu(k,1080) - lu(k,862) * lu(k,1070) - lu(k,1081) = lu(k,1081) - lu(k,863) * lu(k,1070) - lu(k,1082) = lu(k,1082) - lu(k,864) * lu(k,1070) - lu(k,1083) = lu(k,1083) - lu(k,865) * lu(k,1070) - lu(k,1084) = lu(k,1084) - lu(k,866) * lu(k,1070) - lu(k,1085) = lu(k,1085) - lu(k,867) * lu(k,1070) - lu(k,1086) = lu(k,1086) - lu(k,868) * lu(k,1070) - lu(k,1087) = lu(k,1087) - lu(k,869) * lu(k,1070) - lu(k,1088) = lu(k,1088) - lu(k,870) * lu(k,1070) - lu(k,1089) = lu(k,1089) - lu(k,871) * lu(k,1070) - lu(k,1090) = lu(k,1090) - lu(k,872) * lu(k,1070) - lu(k,1091) = lu(k,1091) - lu(k,873) * lu(k,1070) - lu(k,1092) = lu(k,1092) - lu(k,874) * lu(k,1070) - lu(k,1093) = lu(k,1093) - lu(k,875) * lu(k,1070) - lu(k,1110) = lu(k,1110) - lu(k,853) * lu(k,1109) - lu(k,1111) = lu(k,1111) - lu(k,854) * lu(k,1109) - lu(k,1112) = lu(k,1112) - lu(k,855) * lu(k,1109) - lu(k,1113) = lu(k,1113) - lu(k,856) * lu(k,1109) - lu(k,1114) = lu(k,1114) - lu(k,857) * lu(k,1109) - lu(k,1115) = lu(k,1115) - lu(k,858) * lu(k,1109) - lu(k,1116) = lu(k,1116) - lu(k,859) * lu(k,1109) - lu(k,1117) = lu(k,1117) - lu(k,860) * lu(k,1109) - lu(k,1118) = lu(k,1118) - lu(k,861) * lu(k,1109) - lu(k,1119) = lu(k,1119) - lu(k,862) * lu(k,1109) - lu(k,1120) = lu(k,1120) - lu(k,863) * lu(k,1109) - lu(k,1121) = lu(k,1121) - lu(k,864) * lu(k,1109) - lu(k,1122) = lu(k,1122) - lu(k,865) * lu(k,1109) - lu(k,1123) = lu(k,1123) - lu(k,866) * lu(k,1109) - lu(k,1124) = lu(k,1124) - lu(k,867) * lu(k,1109) - lu(k,1125) = lu(k,1125) - lu(k,868) * lu(k,1109) - lu(k,1126) = lu(k,1126) - lu(k,869) * lu(k,1109) - lu(k,1127) = lu(k,1127) - lu(k,870) * lu(k,1109) - lu(k,1128) = lu(k,1128) - lu(k,871) * lu(k,1109) - lu(k,1129) = lu(k,1129) - lu(k,872) * lu(k,1109) - lu(k,1130) = lu(k,1130) - lu(k,873) * lu(k,1109) - lu(k,1131) = lu(k,1131) - lu(k,874) * lu(k,1109) - lu(k,1132) = lu(k,1132) - lu(k,875) * lu(k,1109) - lu(k,1154) = lu(k,1154) - lu(k,853) * lu(k,1153) - lu(k,1155) = lu(k,1155) - lu(k,854) * lu(k,1153) - lu(k,1156) = lu(k,1156) - lu(k,855) * lu(k,1153) - lu(k,1157) = lu(k,1157) - lu(k,856) * lu(k,1153) - lu(k,1158) = lu(k,1158) - lu(k,857) * lu(k,1153) - lu(k,1159) = lu(k,1159) - lu(k,858) * lu(k,1153) - lu(k,1160) = lu(k,1160) - lu(k,859) * lu(k,1153) - lu(k,1161) = lu(k,1161) - lu(k,860) * lu(k,1153) - lu(k,1162) = lu(k,1162) - lu(k,861) * lu(k,1153) - lu(k,1163) = lu(k,1163) - lu(k,862) * lu(k,1153) - lu(k,1164) = lu(k,1164) - lu(k,863) * lu(k,1153) - lu(k,1165) = lu(k,1165) - lu(k,864) * lu(k,1153) - lu(k,1166) = lu(k,1166) - lu(k,865) * lu(k,1153) - lu(k,1167) = lu(k,1167) - lu(k,866) * lu(k,1153) - lu(k,1168) = lu(k,1168) - lu(k,867) * lu(k,1153) - lu(k,1169) = lu(k,1169) - lu(k,868) * lu(k,1153) - lu(k,1170) = lu(k,1170) - lu(k,869) * lu(k,1153) - lu(k,1171) = lu(k,1171) - lu(k,870) * lu(k,1153) - lu(k,1172) = lu(k,1172) - lu(k,871) * lu(k,1153) - lu(k,1173) = lu(k,1173) - lu(k,872) * lu(k,1153) - lu(k,1174) = lu(k,1174) - lu(k,873) * lu(k,1153) - lu(k,1175) = lu(k,1175) - lu(k,874) * lu(k,1153) - lu(k,1176) = lu(k,1176) - lu(k,875) * lu(k,1153) - lu(k,1195) = lu(k,1195) - lu(k,853) * lu(k,1194) - lu(k,1196) = lu(k,1196) - lu(k,854) * lu(k,1194) - lu(k,1197) = lu(k,1197) - lu(k,855) * lu(k,1194) - lu(k,1198) = lu(k,1198) - lu(k,856) * lu(k,1194) - lu(k,1199) = lu(k,1199) - lu(k,857) * lu(k,1194) - lu(k,1200) = lu(k,1200) - lu(k,858) * lu(k,1194) - lu(k,1201) = lu(k,1201) - lu(k,859) * lu(k,1194) - lu(k,1202) = lu(k,1202) - lu(k,860) * lu(k,1194) - lu(k,1203) = lu(k,1203) - lu(k,861) * lu(k,1194) - lu(k,1204) = lu(k,1204) - lu(k,862) * lu(k,1194) - lu(k,1205) = lu(k,1205) - lu(k,863) * lu(k,1194) - lu(k,1206) = lu(k,1206) - lu(k,864) * lu(k,1194) - lu(k,1207) = lu(k,1207) - lu(k,865) * lu(k,1194) - lu(k,1208) = lu(k,1208) - lu(k,866) * lu(k,1194) - lu(k,1209) = lu(k,1209) - lu(k,867) * lu(k,1194) - lu(k,1210) = lu(k,1210) - lu(k,868) * lu(k,1194) - lu(k,1211) = lu(k,1211) - lu(k,869) * lu(k,1194) - lu(k,1212) = lu(k,1212) - lu(k,870) * lu(k,1194) - lu(k,1213) = lu(k,1213) - lu(k,871) * lu(k,1194) - lu(k,1214) = lu(k,1214) - lu(k,872) * lu(k,1194) - lu(k,1215) = lu(k,1215) - lu(k,873) * lu(k,1194) - lu(k,1216) = lu(k,1216) - lu(k,874) * lu(k,1194) - lu(k,1217) = lu(k,1217) - lu(k,875) * lu(k,1194) - lu(k,1244) = lu(k,1244) - lu(k,853) * lu(k,1243) - lu(k,1245) = lu(k,1245) - lu(k,854) * lu(k,1243) - lu(k,1246) = lu(k,1246) - lu(k,855) * lu(k,1243) - lu(k,1247) = lu(k,1247) - lu(k,856) * lu(k,1243) - lu(k,1248) = lu(k,1248) - lu(k,857) * lu(k,1243) - lu(k,1249) = lu(k,1249) - lu(k,858) * lu(k,1243) - lu(k,1250) = lu(k,1250) - lu(k,859) * lu(k,1243) - lu(k,1251) = lu(k,1251) - lu(k,860) * lu(k,1243) - lu(k,1252) = lu(k,1252) - lu(k,861) * lu(k,1243) - lu(k,1253) = lu(k,1253) - lu(k,862) * lu(k,1243) - lu(k,1254) = lu(k,1254) - lu(k,863) * lu(k,1243) - lu(k,1255) = lu(k,1255) - lu(k,864) * lu(k,1243) - lu(k,1256) = lu(k,1256) - lu(k,865) * lu(k,1243) - lu(k,1257) = lu(k,1257) - lu(k,866) * lu(k,1243) - lu(k,1258) = lu(k,1258) - lu(k,867) * lu(k,1243) - lu(k,1259) = lu(k,1259) - lu(k,868) * lu(k,1243) - lu(k,1260) = lu(k,1260) - lu(k,869) * lu(k,1243) - lu(k,1261) = lu(k,1261) - lu(k,870) * lu(k,1243) - lu(k,1262) = lu(k,1262) - lu(k,871) * lu(k,1243) - lu(k,1263) = lu(k,1263) - lu(k,872) * lu(k,1243) - lu(k,1264) = lu(k,1264) - lu(k,873) * lu(k,1243) - lu(k,1265) = lu(k,1265) - lu(k,874) * lu(k,1243) - lu(k,1266) = lu(k,1266) - lu(k,875) * lu(k,1243) - lu(k,1283) = lu(k,1283) - lu(k,853) * lu(k,1282) - lu(k,1284) = lu(k,1284) - lu(k,854) * lu(k,1282) - lu(k,1285) = lu(k,1285) - lu(k,855) * lu(k,1282) - lu(k,1286) = lu(k,1286) - lu(k,856) * lu(k,1282) - lu(k,1287) = lu(k,1287) - lu(k,857) * lu(k,1282) - lu(k,1288) = lu(k,1288) - lu(k,858) * lu(k,1282) - lu(k,1289) = lu(k,1289) - lu(k,859) * lu(k,1282) - lu(k,1290) = lu(k,1290) - lu(k,860) * lu(k,1282) - lu(k,1291) = lu(k,1291) - lu(k,861) * lu(k,1282) - lu(k,1292) = lu(k,1292) - lu(k,862) * lu(k,1282) - lu(k,1293) = lu(k,1293) - lu(k,863) * lu(k,1282) - lu(k,1294) = lu(k,1294) - lu(k,864) * lu(k,1282) - lu(k,1295) = lu(k,1295) - lu(k,865) * lu(k,1282) - lu(k,1296) = lu(k,1296) - lu(k,866) * lu(k,1282) - lu(k,1297) = lu(k,1297) - lu(k,867) * lu(k,1282) - lu(k,1298) = lu(k,1298) - lu(k,868) * lu(k,1282) - lu(k,1299) = lu(k,1299) - lu(k,869) * lu(k,1282) - lu(k,1300) = lu(k,1300) - lu(k,870) * lu(k,1282) - lu(k,1301) = lu(k,1301) - lu(k,871) * lu(k,1282) - lu(k,1302) = lu(k,1302) - lu(k,872) * lu(k,1282) - lu(k,1303) = lu(k,1303) - lu(k,873) * lu(k,1282) - lu(k,1304) = lu(k,1304) - lu(k,874) * lu(k,1282) - lu(k,1305) = lu(k,1305) - lu(k,875) * lu(k,1282) - lu(k,1318) = lu(k,1318) - lu(k,853) * lu(k,1317) - lu(k,1319) = lu(k,1319) - lu(k,854) * lu(k,1317) - lu(k,1320) = lu(k,1320) - lu(k,855) * lu(k,1317) - lu(k,1321) = lu(k,1321) - lu(k,856) * lu(k,1317) - lu(k,1322) = lu(k,1322) - lu(k,857) * lu(k,1317) - lu(k,1323) = lu(k,1323) - lu(k,858) * lu(k,1317) - lu(k,1324) = lu(k,1324) - lu(k,859) * lu(k,1317) - lu(k,1325) = lu(k,1325) - lu(k,860) * lu(k,1317) - lu(k,1326) = lu(k,1326) - lu(k,861) * lu(k,1317) - lu(k,1327) = lu(k,1327) - lu(k,862) * lu(k,1317) - lu(k,1328) = lu(k,1328) - lu(k,863) * lu(k,1317) - lu(k,1329) = lu(k,1329) - lu(k,864) * lu(k,1317) - lu(k,1330) = lu(k,1330) - lu(k,865) * lu(k,1317) - lu(k,1331) = lu(k,1331) - lu(k,866) * lu(k,1317) - lu(k,1332) = lu(k,1332) - lu(k,867) * lu(k,1317) - lu(k,1333) = lu(k,1333) - lu(k,868) * lu(k,1317) - lu(k,1334) = lu(k,1334) - lu(k,869) * lu(k,1317) - lu(k,1335) = lu(k,1335) - lu(k,870) * lu(k,1317) - lu(k,1336) = lu(k,1336) - lu(k,871) * lu(k,1317) - lu(k,1337) = lu(k,1337) - lu(k,872) * lu(k,1317) - lu(k,1338) = lu(k,1338) - lu(k,873) * lu(k,1317) - lu(k,1339) = lu(k,1339) - lu(k,874) * lu(k,1317) - lu(k,1340) = lu(k,1340) - lu(k,875) * lu(k,1317) - lu(k,1362) = lu(k,1362) - lu(k,853) * lu(k,1361) - lu(k,1363) = lu(k,1363) - lu(k,854) * lu(k,1361) - lu(k,1364) = lu(k,1364) - lu(k,855) * lu(k,1361) - lu(k,1365) = lu(k,1365) - lu(k,856) * lu(k,1361) - lu(k,1366) = lu(k,1366) - lu(k,857) * lu(k,1361) - lu(k,1367) = lu(k,1367) - lu(k,858) * lu(k,1361) - lu(k,1368) = lu(k,1368) - lu(k,859) * lu(k,1361) - lu(k,1369) = lu(k,1369) - lu(k,860) * lu(k,1361) - lu(k,1370) = lu(k,1370) - lu(k,861) * lu(k,1361) - lu(k,1371) = lu(k,1371) - lu(k,862) * lu(k,1361) - lu(k,1372) = lu(k,1372) - lu(k,863) * lu(k,1361) - lu(k,1373) = lu(k,1373) - lu(k,864) * lu(k,1361) - lu(k,1374) = lu(k,1374) - lu(k,865) * lu(k,1361) - lu(k,1375) = lu(k,1375) - lu(k,866) * lu(k,1361) - lu(k,1376) = lu(k,1376) - lu(k,867) * lu(k,1361) - lu(k,1377) = lu(k,1377) - lu(k,868) * lu(k,1361) - lu(k,1378) = lu(k,1378) - lu(k,869) * lu(k,1361) - lu(k,1379) = lu(k,1379) - lu(k,870) * lu(k,1361) - lu(k,1380) = lu(k,1380) - lu(k,871) * lu(k,1361) - lu(k,1381) = lu(k,1381) - lu(k,872) * lu(k,1361) - lu(k,1382) = lu(k,1382) - lu(k,873) * lu(k,1361) - lu(k,1383) = lu(k,1383) - lu(k,874) * lu(k,1361) - lu(k,1384) = lu(k,1384) - lu(k,875) * lu(k,1361) - lu(k,1421) = lu(k,1421) - lu(k,853) * lu(k,1420) - lu(k,1422) = lu(k,1422) - lu(k,854) * lu(k,1420) - lu(k,1423) = lu(k,1423) - lu(k,855) * lu(k,1420) - lu(k,1424) = lu(k,1424) - lu(k,856) * lu(k,1420) - lu(k,1425) = lu(k,1425) - lu(k,857) * lu(k,1420) - lu(k,1426) = lu(k,1426) - lu(k,858) * lu(k,1420) - lu(k,1427) = lu(k,1427) - lu(k,859) * lu(k,1420) - lu(k,1428) = lu(k,1428) - lu(k,860) * lu(k,1420) - lu(k,1429) = lu(k,1429) - lu(k,861) * lu(k,1420) - lu(k,1430) = lu(k,1430) - lu(k,862) * lu(k,1420) - lu(k,1431) = lu(k,1431) - lu(k,863) * lu(k,1420) - lu(k,1432) = lu(k,1432) - lu(k,864) * lu(k,1420) - lu(k,1433) = lu(k,1433) - lu(k,865) * lu(k,1420) - lu(k,1434) = lu(k,1434) - lu(k,866) * lu(k,1420) - lu(k,1435) = lu(k,1435) - lu(k,867) * lu(k,1420) - lu(k,1436) = lu(k,1436) - lu(k,868) * lu(k,1420) - lu(k,1437) = lu(k,1437) - lu(k,869) * lu(k,1420) - lu(k,1438) = lu(k,1438) - lu(k,870) * lu(k,1420) - lu(k,1439) = lu(k,1439) - lu(k,871) * lu(k,1420) - lu(k,1440) = lu(k,1440) - lu(k,872) * lu(k,1420) - lu(k,1441) = lu(k,1441) - lu(k,873) * lu(k,1420) - lu(k,1442) = lu(k,1442) - lu(k,874) * lu(k,1420) - lu(k,1443) = lu(k,1443) - lu(k,875) * lu(k,1420) - lu(k,1463) = lu(k,1463) - lu(k,853) * lu(k,1462) - lu(k,1464) = lu(k,1464) - lu(k,854) * lu(k,1462) - lu(k,1465) = lu(k,1465) - lu(k,855) * lu(k,1462) - lu(k,1466) = lu(k,1466) - lu(k,856) * lu(k,1462) - lu(k,1467) = lu(k,1467) - lu(k,857) * lu(k,1462) - lu(k,1468) = lu(k,1468) - lu(k,858) * lu(k,1462) - lu(k,1469) = lu(k,1469) - lu(k,859) * lu(k,1462) - lu(k,1470) = lu(k,1470) - lu(k,860) * lu(k,1462) - lu(k,1471) = lu(k,1471) - lu(k,861) * lu(k,1462) - lu(k,1472) = lu(k,1472) - lu(k,862) * lu(k,1462) - lu(k,1473) = lu(k,1473) - lu(k,863) * lu(k,1462) - lu(k,1474) = lu(k,1474) - lu(k,864) * lu(k,1462) - lu(k,1475) = lu(k,1475) - lu(k,865) * lu(k,1462) - lu(k,1476) = lu(k,1476) - lu(k,866) * lu(k,1462) - lu(k,1477) = lu(k,1477) - lu(k,867) * lu(k,1462) - lu(k,1478) = lu(k,1478) - lu(k,868) * lu(k,1462) - lu(k,1479) = lu(k,1479) - lu(k,869) * lu(k,1462) - lu(k,1480) = lu(k,1480) - lu(k,870) * lu(k,1462) - lu(k,1481) = lu(k,1481) - lu(k,871) * lu(k,1462) - lu(k,1482) = lu(k,1482) - lu(k,872) * lu(k,1462) - lu(k,1483) = lu(k,1483) - lu(k,873) * lu(k,1462) - lu(k,1484) = lu(k,1484) - lu(k,874) * lu(k,1462) - lu(k,1485) = lu(k,1485) - lu(k,875) * lu(k,1462) - lu(k,1504) = lu(k,1504) - lu(k,853) * lu(k,1503) - lu(k,1505) = lu(k,1505) - lu(k,854) * lu(k,1503) - lu(k,1506) = lu(k,1506) - lu(k,855) * lu(k,1503) - lu(k,1507) = lu(k,1507) - lu(k,856) * lu(k,1503) - lu(k,1508) = lu(k,1508) - lu(k,857) * lu(k,1503) - lu(k,1509) = lu(k,1509) - lu(k,858) * lu(k,1503) - lu(k,1510) = lu(k,1510) - lu(k,859) * lu(k,1503) - lu(k,1511) = lu(k,1511) - lu(k,860) * lu(k,1503) - lu(k,1512) = lu(k,1512) - lu(k,861) * lu(k,1503) - lu(k,1513) = lu(k,1513) - lu(k,862) * lu(k,1503) - lu(k,1514) = lu(k,1514) - lu(k,863) * lu(k,1503) - lu(k,1515) = lu(k,1515) - lu(k,864) * lu(k,1503) - lu(k,1516) = lu(k,1516) - lu(k,865) * lu(k,1503) - lu(k,1517) = lu(k,1517) - lu(k,866) * lu(k,1503) - lu(k,1518) = lu(k,1518) - lu(k,867) * lu(k,1503) - lu(k,1519) = lu(k,1519) - lu(k,868) * lu(k,1503) - lu(k,1520) = lu(k,1520) - lu(k,869) * lu(k,1503) - lu(k,1521) = lu(k,1521) - lu(k,870) * lu(k,1503) - lu(k,1522) = lu(k,1522) - lu(k,871) * lu(k,1503) - lu(k,1523) = lu(k,1523) - lu(k,872) * lu(k,1503) - lu(k,1524) = lu(k,1524) - lu(k,873) * lu(k,1503) - lu(k,1525) = lu(k,1525) - lu(k,874) * lu(k,1503) - lu(k,1526) = lu(k,1526) - lu(k,875) * lu(k,1503) - lu(k,1588) = lu(k,1588) - lu(k,853) * lu(k,1587) - lu(k,1589) = lu(k,1589) - lu(k,854) * lu(k,1587) - lu(k,1590) = lu(k,1590) - lu(k,855) * lu(k,1587) - lu(k,1591) = lu(k,1591) - lu(k,856) * lu(k,1587) - lu(k,1592) = lu(k,1592) - lu(k,857) * lu(k,1587) - lu(k,1593) = lu(k,1593) - lu(k,858) * lu(k,1587) - lu(k,1594) = lu(k,1594) - lu(k,859) * lu(k,1587) - lu(k,1595) = lu(k,1595) - lu(k,860) * lu(k,1587) - lu(k,1596) = lu(k,1596) - lu(k,861) * lu(k,1587) - lu(k,1597) = lu(k,1597) - lu(k,862) * lu(k,1587) - lu(k,1598) = lu(k,1598) - lu(k,863) * lu(k,1587) - lu(k,1599) = lu(k,1599) - lu(k,864) * lu(k,1587) - lu(k,1600) = lu(k,1600) - lu(k,865) * lu(k,1587) - lu(k,1601) = lu(k,1601) - lu(k,866) * lu(k,1587) - lu(k,1602) = lu(k,1602) - lu(k,867) * lu(k,1587) - lu(k,1603) = lu(k,1603) - lu(k,868) * lu(k,1587) - lu(k,1604) = lu(k,1604) - lu(k,869) * lu(k,1587) - lu(k,1605) = lu(k,1605) - lu(k,870) * lu(k,1587) - lu(k,1606) = lu(k,1606) - lu(k,871) * lu(k,1587) - lu(k,1607) = lu(k,1607) - lu(k,872) * lu(k,1587) - lu(k,1608) = lu(k,1608) - lu(k,873) * lu(k,1587) - lu(k,1609) = lu(k,1609) - lu(k,874) * lu(k,1587) - lu(k,1610) = lu(k,1610) - lu(k,875) * lu(k,1587) - lu(k,1620) = lu(k,1620) - lu(k,853) * lu(k,1619) - lu(k,1621) = lu(k,1621) - lu(k,854) * lu(k,1619) - lu(k,1622) = lu(k,1622) - lu(k,855) * lu(k,1619) - lu(k,1623) = lu(k,1623) - lu(k,856) * lu(k,1619) - lu(k,1624) = lu(k,1624) - lu(k,857) * lu(k,1619) - lu(k,1625) = lu(k,1625) - lu(k,858) * lu(k,1619) - lu(k,1626) = lu(k,1626) - lu(k,859) * lu(k,1619) - lu(k,1627) = lu(k,1627) - lu(k,860) * lu(k,1619) - lu(k,1628) = lu(k,1628) - lu(k,861) * lu(k,1619) - lu(k,1629) = lu(k,1629) - lu(k,862) * lu(k,1619) - lu(k,1630) = lu(k,1630) - lu(k,863) * lu(k,1619) - lu(k,1631) = lu(k,1631) - lu(k,864) * lu(k,1619) - lu(k,1632) = lu(k,1632) - lu(k,865) * lu(k,1619) - lu(k,1633) = lu(k,1633) - lu(k,866) * lu(k,1619) - lu(k,1634) = lu(k,1634) - lu(k,867) * lu(k,1619) - lu(k,1635) = lu(k,1635) - lu(k,868) * lu(k,1619) - lu(k,1636) = lu(k,1636) - lu(k,869) * lu(k,1619) - lu(k,1637) = lu(k,1637) - lu(k,870) * lu(k,1619) - lu(k,1638) = lu(k,1638) - lu(k,871) * lu(k,1619) - lu(k,1639) = lu(k,1639) - lu(k,872) * lu(k,1619) - lu(k,1640) = lu(k,1640) - lu(k,873) * lu(k,1619) - lu(k,1641) = lu(k,1641) - lu(k,874) * lu(k,1619) - lu(k,1642) = lu(k,1642) - lu(k,875) * lu(k,1619) - lu(k,1655) = lu(k,1655) - lu(k,853) * lu(k,1654) - lu(k,1656) = lu(k,1656) - lu(k,854) * lu(k,1654) - lu(k,1657) = lu(k,1657) - lu(k,855) * lu(k,1654) - lu(k,1658) = lu(k,1658) - lu(k,856) * lu(k,1654) - lu(k,1659) = lu(k,1659) - lu(k,857) * lu(k,1654) - lu(k,1660) = lu(k,1660) - lu(k,858) * lu(k,1654) - lu(k,1661) = lu(k,1661) - lu(k,859) * lu(k,1654) - lu(k,1662) = lu(k,1662) - lu(k,860) * lu(k,1654) - lu(k,1663) = lu(k,1663) - lu(k,861) * lu(k,1654) - lu(k,1664) = lu(k,1664) - lu(k,862) * lu(k,1654) - lu(k,1665) = lu(k,1665) - lu(k,863) * lu(k,1654) - lu(k,1666) = lu(k,1666) - lu(k,864) * lu(k,1654) - lu(k,1667) = lu(k,1667) - lu(k,865) * lu(k,1654) - lu(k,1668) = lu(k,1668) - lu(k,866) * lu(k,1654) - lu(k,1669) = lu(k,1669) - lu(k,867) * lu(k,1654) - lu(k,1670) = lu(k,1670) - lu(k,868) * lu(k,1654) - lu(k,1671) = lu(k,1671) - lu(k,869) * lu(k,1654) - lu(k,1672) = lu(k,1672) - lu(k,870) * lu(k,1654) - lu(k,1673) = lu(k,1673) - lu(k,871) * lu(k,1654) - lu(k,1674) = lu(k,1674) - lu(k,872) * lu(k,1654) - lu(k,1675) = lu(k,1675) - lu(k,873) * lu(k,1654) - lu(k,1676) = lu(k,1676) - lu(k,874) * lu(k,1654) - lu(k,1677) = lu(k,1677) - lu(k,875) * lu(k,1654) - lu(k,1697) = lu(k,1697) - lu(k,853) * lu(k,1696) - lu(k,1698) = lu(k,1698) - lu(k,854) * lu(k,1696) - lu(k,1699) = lu(k,1699) - lu(k,855) * lu(k,1696) - lu(k,1700) = lu(k,1700) - lu(k,856) * lu(k,1696) - lu(k,1701) = lu(k,1701) - lu(k,857) * lu(k,1696) - lu(k,1702) = lu(k,1702) - lu(k,858) * lu(k,1696) - lu(k,1703) = lu(k,1703) - lu(k,859) * lu(k,1696) - lu(k,1704) = lu(k,1704) - lu(k,860) * lu(k,1696) - lu(k,1705) = lu(k,1705) - lu(k,861) * lu(k,1696) - lu(k,1706) = lu(k,1706) - lu(k,862) * lu(k,1696) - lu(k,1707) = lu(k,1707) - lu(k,863) * lu(k,1696) - lu(k,1708) = lu(k,1708) - lu(k,864) * lu(k,1696) - lu(k,1709) = lu(k,1709) - lu(k,865) * lu(k,1696) - lu(k,1710) = lu(k,1710) - lu(k,866) * lu(k,1696) - lu(k,1711) = lu(k,1711) - lu(k,867) * lu(k,1696) - lu(k,1712) = lu(k,1712) - lu(k,868) * lu(k,1696) - lu(k,1713) = lu(k,1713) - lu(k,869) * lu(k,1696) - lu(k,1714) = lu(k,1714) - lu(k,870) * lu(k,1696) - lu(k,1715) = lu(k,1715) - lu(k,871) * lu(k,1696) - lu(k,1716) = lu(k,1716) - lu(k,872) * lu(k,1696) - lu(k,1717) = lu(k,1717) - lu(k,873) * lu(k,1696) - lu(k,1718) = lu(k,1718) - lu(k,874) * lu(k,1696) - lu(k,1719) = lu(k,1719) - lu(k,875) * lu(k,1696) - lu(k,1741) = lu(k,1741) - lu(k,853) * lu(k,1740) - lu(k,1742) = lu(k,1742) - lu(k,854) * lu(k,1740) - lu(k,1743) = lu(k,1743) - lu(k,855) * lu(k,1740) - lu(k,1744) = lu(k,1744) - lu(k,856) * lu(k,1740) - lu(k,1745) = lu(k,1745) - lu(k,857) * lu(k,1740) - lu(k,1746) = lu(k,1746) - lu(k,858) * lu(k,1740) - lu(k,1747) = lu(k,1747) - lu(k,859) * lu(k,1740) - lu(k,1748) = lu(k,1748) - lu(k,860) * lu(k,1740) - lu(k,1749) = lu(k,1749) - lu(k,861) * lu(k,1740) - lu(k,1750) = lu(k,1750) - lu(k,862) * lu(k,1740) - lu(k,1751) = lu(k,1751) - lu(k,863) * lu(k,1740) - lu(k,1752) = lu(k,1752) - lu(k,864) * lu(k,1740) - lu(k,1753) = lu(k,1753) - lu(k,865) * lu(k,1740) - lu(k,1754) = lu(k,1754) - lu(k,866) * lu(k,1740) - lu(k,1755) = lu(k,1755) - lu(k,867) * lu(k,1740) - lu(k,1756) = lu(k,1756) - lu(k,868) * lu(k,1740) - lu(k,1757) = lu(k,1757) - lu(k,869) * lu(k,1740) - lu(k,1758) = lu(k,1758) - lu(k,870) * lu(k,1740) - lu(k,1759) = lu(k,1759) - lu(k,871) * lu(k,1740) - lu(k,1760) = lu(k,1760) - lu(k,872) * lu(k,1740) - lu(k,1761) = lu(k,1761) - lu(k,873) * lu(k,1740) - lu(k,1762) = lu(k,1762) - lu(k,874) * lu(k,1740) - lu(k,1763) = lu(k,1763) - lu(k,875) * lu(k,1740) - lu(k,1776) = lu(k,1776) - lu(k,853) * lu(k,1775) - lu(k,1777) = lu(k,1777) - lu(k,854) * lu(k,1775) - lu(k,1778) = lu(k,1778) - lu(k,855) * lu(k,1775) - lu(k,1779) = lu(k,1779) - lu(k,856) * lu(k,1775) - lu(k,1780) = lu(k,1780) - lu(k,857) * lu(k,1775) - lu(k,1781) = lu(k,1781) - lu(k,858) * lu(k,1775) - lu(k,1782) = lu(k,1782) - lu(k,859) * lu(k,1775) - lu(k,1783) = lu(k,1783) - lu(k,860) * lu(k,1775) - lu(k,1784) = lu(k,1784) - lu(k,861) * lu(k,1775) - lu(k,1785) = lu(k,1785) - lu(k,862) * lu(k,1775) - lu(k,1786) = lu(k,1786) - lu(k,863) * lu(k,1775) - lu(k,1787) = lu(k,1787) - lu(k,864) * lu(k,1775) - lu(k,1788) = lu(k,1788) - lu(k,865) * lu(k,1775) - lu(k,1789) = lu(k,1789) - lu(k,866) * lu(k,1775) - lu(k,1790) = lu(k,1790) - lu(k,867) * lu(k,1775) - lu(k,1791) = lu(k,1791) - lu(k,868) * lu(k,1775) - lu(k,1792) = lu(k,1792) - lu(k,869) * lu(k,1775) - lu(k,1793) = lu(k,1793) - lu(k,870) * lu(k,1775) - lu(k,1794) = lu(k,1794) - lu(k,871) * lu(k,1775) - lu(k,1795) = lu(k,1795) - lu(k,872) * lu(k,1775) - lu(k,1796) = lu(k,1796) - lu(k,873) * lu(k,1775) - lu(k,1797) = lu(k,1797) - lu(k,874) * lu(k,1775) - lu(k,1798) = lu(k,1798) - lu(k,875) * lu(k,1775) - lu(k,1834) = lu(k,1834) - lu(k,853) * lu(k,1833) - lu(k,1835) = lu(k,1835) - lu(k,854) * lu(k,1833) - lu(k,1836) = lu(k,1836) - lu(k,855) * lu(k,1833) - lu(k,1837) = lu(k,1837) - lu(k,856) * lu(k,1833) - lu(k,1838) = lu(k,1838) - lu(k,857) * lu(k,1833) - lu(k,1839) = lu(k,1839) - lu(k,858) * lu(k,1833) - lu(k,1840) = lu(k,1840) - lu(k,859) * lu(k,1833) - lu(k,1841) = lu(k,1841) - lu(k,860) * lu(k,1833) - lu(k,1842) = lu(k,1842) - lu(k,861) * lu(k,1833) - lu(k,1843) = lu(k,1843) - lu(k,862) * lu(k,1833) - lu(k,1844) = lu(k,1844) - lu(k,863) * lu(k,1833) - lu(k,1845) = lu(k,1845) - lu(k,864) * lu(k,1833) - lu(k,1846) = lu(k,1846) - lu(k,865) * lu(k,1833) - lu(k,1847) = lu(k,1847) - lu(k,866) * lu(k,1833) - lu(k,1848) = lu(k,1848) - lu(k,867) * lu(k,1833) - lu(k,1849) = lu(k,1849) - lu(k,868) * lu(k,1833) - lu(k,1850) = lu(k,1850) - lu(k,869) * lu(k,1833) - lu(k,1851) = lu(k,1851) - lu(k,870) * lu(k,1833) - lu(k,1852) = lu(k,1852) - lu(k,871) * lu(k,1833) - lu(k,1853) = lu(k,1853) - lu(k,872) * lu(k,1833) - lu(k,1854) = lu(k,1854) - lu(k,873) * lu(k,1833) - lu(k,1855) = lu(k,1855) - lu(k,874) * lu(k,1833) - lu(k,1856) = lu(k,1856) - lu(k,875) * lu(k,1833) - lu(k,900) = 1._r8 / lu(k,900) - lu(k,901) = lu(k,901) * lu(k,900) - lu(k,902) = lu(k,902) * lu(k,900) - lu(k,903) = lu(k,903) * lu(k,900) - lu(k,904) = lu(k,904) * lu(k,900) - lu(k,905) = lu(k,905) * lu(k,900) - lu(k,906) = lu(k,906) * lu(k,900) - lu(k,907) = lu(k,907) * lu(k,900) - lu(k,908) = lu(k,908) * lu(k,900) - lu(k,909) = lu(k,909) * lu(k,900) - lu(k,910) = lu(k,910) * lu(k,900) - lu(k,911) = lu(k,911) * lu(k,900) - lu(k,912) = lu(k,912) * lu(k,900) - lu(k,913) = lu(k,913) * lu(k,900) - lu(k,914) = lu(k,914) * lu(k,900) - lu(k,915) = lu(k,915) * lu(k,900) - lu(k,916) = lu(k,916) * lu(k,900) - lu(k,917) = lu(k,917) * lu(k,900) - lu(k,918) = lu(k,918) * lu(k,900) - lu(k,919) = lu(k,919) * lu(k,900) - lu(k,920) = lu(k,920) * lu(k,900) - lu(k,921) = lu(k,921) * lu(k,900) - lu(k,922) = lu(k,922) * lu(k,900) - lu(k,943) = lu(k,943) - lu(k,901) * lu(k,942) - lu(k,944) = lu(k,944) - lu(k,902) * lu(k,942) - lu(k,945) = lu(k,945) - lu(k,903) * lu(k,942) - lu(k,946) = lu(k,946) - lu(k,904) * lu(k,942) - lu(k,947) = lu(k,947) - lu(k,905) * lu(k,942) - lu(k,948) = lu(k,948) - lu(k,906) * lu(k,942) - lu(k,949) = lu(k,949) - lu(k,907) * lu(k,942) - lu(k,950) = lu(k,950) - lu(k,908) * lu(k,942) - lu(k,951) = lu(k,951) - lu(k,909) * lu(k,942) - lu(k,952) = lu(k,952) - lu(k,910) * lu(k,942) - lu(k,953) = lu(k,953) - lu(k,911) * lu(k,942) - lu(k,954) = lu(k,954) - lu(k,912) * lu(k,942) - lu(k,955) = lu(k,955) - lu(k,913) * lu(k,942) - lu(k,956) = lu(k,956) - lu(k,914) * lu(k,942) - lu(k,957) = lu(k,957) - lu(k,915) * lu(k,942) - lu(k,958) = lu(k,958) - lu(k,916) * lu(k,942) - lu(k,959) = lu(k,959) - lu(k,917) * lu(k,942) - lu(k,960) = lu(k,960) - lu(k,918) * lu(k,942) - lu(k,961) = lu(k,961) - lu(k,919) * lu(k,942) - lu(k,962) = lu(k,962) - lu(k,920) * lu(k,942) - lu(k,963) = lu(k,963) - lu(k,921) * lu(k,942) - lu(k,964) = lu(k,964) - lu(k,922) * lu(k,942) - lu(k,989) = lu(k,989) - lu(k,901) * lu(k,988) - lu(k,990) = lu(k,990) - lu(k,902) * lu(k,988) - lu(k,991) = lu(k,991) - lu(k,903) * lu(k,988) - lu(k,992) = lu(k,992) - lu(k,904) * lu(k,988) - lu(k,993) = lu(k,993) - lu(k,905) * lu(k,988) - lu(k,994) = lu(k,994) - lu(k,906) * lu(k,988) - lu(k,995) = lu(k,995) - lu(k,907) * lu(k,988) - lu(k,996) = lu(k,996) - lu(k,908) * lu(k,988) - lu(k,997) = lu(k,997) - lu(k,909) * lu(k,988) - lu(k,998) = lu(k,998) - lu(k,910) * lu(k,988) - lu(k,999) = lu(k,999) - lu(k,911) * lu(k,988) - lu(k,1000) = lu(k,1000) - lu(k,912) * lu(k,988) - lu(k,1001) = lu(k,1001) - lu(k,913) * lu(k,988) - lu(k,1002) = lu(k,1002) - lu(k,914) * lu(k,988) - lu(k,1003) = lu(k,1003) - lu(k,915) * lu(k,988) - lu(k,1004) = lu(k,1004) - lu(k,916) * lu(k,988) - lu(k,1005) = lu(k,1005) - lu(k,917) * lu(k,988) - lu(k,1006) = lu(k,1006) - lu(k,918) * lu(k,988) - lu(k,1007) = lu(k,1007) - lu(k,919) * lu(k,988) - lu(k,1008) = lu(k,1008) - lu(k,920) * lu(k,988) - lu(k,1009) = lu(k,1009) - lu(k,921) * lu(k,988) - lu(k,1010) = lu(k,1010) - lu(k,922) * lu(k,988) - lu(k,1031) = lu(k,1031) - lu(k,901) * lu(k,1030) - lu(k,1032) = lu(k,1032) - lu(k,902) * lu(k,1030) - lu(k,1033) = lu(k,1033) - lu(k,903) * lu(k,1030) - lu(k,1034) = lu(k,1034) - lu(k,904) * lu(k,1030) - lu(k,1035) = lu(k,1035) - lu(k,905) * lu(k,1030) - lu(k,1036) = lu(k,1036) - lu(k,906) * lu(k,1030) - lu(k,1037) = lu(k,1037) - lu(k,907) * lu(k,1030) - lu(k,1038) = lu(k,1038) - lu(k,908) * lu(k,1030) - lu(k,1039) = lu(k,1039) - lu(k,909) * lu(k,1030) - lu(k,1040) = lu(k,1040) - lu(k,910) * lu(k,1030) - lu(k,1041) = lu(k,1041) - lu(k,911) * lu(k,1030) - lu(k,1042) = lu(k,1042) - lu(k,912) * lu(k,1030) - lu(k,1043) = lu(k,1043) - lu(k,913) * lu(k,1030) - lu(k,1044) = lu(k,1044) - lu(k,914) * lu(k,1030) - lu(k,1045) = lu(k,1045) - lu(k,915) * lu(k,1030) - lu(k,1046) = lu(k,1046) - lu(k,916) * lu(k,1030) - lu(k,1047) = lu(k,1047) - lu(k,917) * lu(k,1030) - lu(k,1048) = lu(k,1048) - lu(k,918) * lu(k,1030) - lu(k,1049) = lu(k,1049) - lu(k,919) * lu(k,1030) - lu(k,1050) = lu(k,1050) - lu(k,920) * lu(k,1030) - lu(k,1051) = lu(k,1051) - lu(k,921) * lu(k,1030) - lu(k,1052) = lu(k,1052) - lu(k,922) * lu(k,1030) - lu(k,1072) = lu(k,1072) - lu(k,901) * lu(k,1071) - lu(k,1073) = lu(k,1073) - lu(k,902) * lu(k,1071) - lu(k,1074) = lu(k,1074) - lu(k,903) * lu(k,1071) - lu(k,1075) = lu(k,1075) - lu(k,904) * lu(k,1071) - lu(k,1076) = lu(k,1076) - lu(k,905) * lu(k,1071) - lu(k,1077) = lu(k,1077) - lu(k,906) * lu(k,1071) - lu(k,1078) = lu(k,1078) - lu(k,907) * lu(k,1071) - lu(k,1079) = lu(k,1079) - lu(k,908) * lu(k,1071) - lu(k,1080) = lu(k,1080) - lu(k,909) * lu(k,1071) - lu(k,1081) = lu(k,1081) - lu(k,910) * lu(k,1071) - lu(k,1082) = lu(k,1082) - lu(k,911) * lu(k,1071) - lu(k,1083) = lu(k,1083) - lu(k,912) * lu(k,1071) - lu(k,1084) = lu(k,1084) - lu(k,913) * lu(k,1071) - lu(k,1085) = lu(k,1085) - lu(k,914) * lu(k,1071) - lu(k,1086) = lu(k,1086) - lu(k,915) * lu(k,1071) - lu(k,1087) = lu(k,1087) - lu(k,916) * lu(k,1071) - lu(k,1088) = lu(k,1088) - lu(k,917) * lu(k,1071) - lu(k,1089) = lu(k,1089) - lu(k,918) * lu(k,1071) - lu(k,1090) = lu(k,1090) - lu(k,919) * lu(k,1071) - lu(k,1091) = lu(k,1091) - lu(k,920) * lu(k,1071) - lu(k,1092) = lu(k,1092) - lu(k,921) * lu(k,1071) - lu(k,1093) = lu(k,1093) - lu(k,922) * lu(k,1071) - lu(k,1111) = lu(k,1111) - lu(k,901) * lu(k,1110) - lu(k,1112) = lu(k,1112) - lu(k,902) * lu(k,1110) - lu(k,1113) = lu(k,1113) - lu(k,903) * lu(k,1110) - lu(k,1114) = lu(k,1114) - lu(k,904) * lu(k,1110) - lu(k,1115) = lu(k,1115) - lu(k,905) * lu(k,1110) - lu(k,1116) = lu(k,1116) - lu(k,906) * lu(k,1110) - lu(k,1117) = lu(k,1117) - lu(k,907) * lu(k,1110) - lu(k,1118) = lu(k,1118) - lu(k,908) * lu(k,1110) - lu(k,1119) = lu(k,1119) - lu(k,909) * lu(k,1110) - lu(k,1120) = lu(k,1120) - lu(k,910) * lu(k,1110) - lu(k,1121) = lu(k,1121) - lu(k,911) * lu(k,1110) - lu(k,1122) = lu(k,1122) - lu(k,912) * lu(k,1110) - lu(k,1123) = lu(k,1123) - lu(k,913) * lu(k,1110) - lu(k,1124) = lu(k,1124) - lu(k,914) * lu(k,1110) - lu(k,1125) = lu(k,1125) - lu(k,915) * lu(k,1110) - lu(k,1126) = lu(k,1126) - lu(k,916) * lu(k,1110) - lu(k,1127) = lu(k,1127) - lu(k,917) * lu(k,1110) - lu(k,1128) = lu(k,1128) - lu(k,918) * lu(k,1110) - lu(k,1129) = lu(k,1129) - lu(k,919) * lu(k,1110) - lu(k,1130) = lu(k,1130) - lu(k,920) * lu(k,1110) - lu(k,1131) = lu(k,1131) - lu(k,921) * lu(k,1110) - lu(k,1132) = lu(k,1132) - lu(k,922) * lu(k,1110) - lu(k,1155) = lu(k,1155) - lu(k,901) * lu(k,1154) - lu(k,1156) = lu(k,1156) - lu(k,902) * lu(k,1154) - lu(k,1157) = lu(k,1157) - lu(k,903) * lu(k,1154) - lu(k,1158) = lu(k,1158) - lu(k,904) * lu(k,1154) - lu(k,1159) = lu(k,1159) - lu(k,905) * lu(k,1154) - lu(k,1160) = lu(k,1160) - lu(k,906) * lu(k,1154) - lu(k,1161) = lu(k,1161) - lu(k,907) * lu(k,1154) - lu(k,1162) = lu(k,1162) - lu(k,908) * lu(k,1154) - lu(k,1163) = lu(k,1163) - lu(k,909) * lu(k,1154) - lu(k,1164) = lu(k,1164) - lu(k,910) * lu(k,1154) - lu(k,1165) = lu(k,1165) - lu(k,911) * lu(k,1154) - lu(k,1166) = lu(k,1166) - lu(k,912) * lu(k,1154) - lu(k,1167) = lu(k,1167) - lu(k,913) * lu(k,1154) - lu(k,1168) = lu(k,1168) - lu(k,914) * lu(k,1154) - lu(k,1169) = lu(k,1169) - lu(k,915) * lu(k,1154) - lu(k,1170) = lu(k,1170) - lu(k,916) * lu(k,1154) - lu(k,1171) = lu(k,1171) - lu(k,917) * lu(k,1154) - lu(k,1172) = lu(k,1172) - lu(k,918) * lu(k,1154) - lu(k,1173) = lu(k,1173) - lu(k,919) * lu(k,1154) - lu(k,1174) = lu(k,1174) - lu(k,920) * lu(k,1154) - lu(k,1175) = lu(k,1175) - lu(k,921) * lu(k,1154) - lu(k,1176) = lu(k,1176) - lu(k,922) * lu(k,1154) - lu(k,1196) = lu(k,1196) - lu(k,901) * lu(k,1195) - lu(k,1197) = lu(k,1197) - lu(k,902) * lu(k,1195) - lu(k,1198) = lu(k,1198) - lu(k,903) * lu(k,1195) - lu(k,1199) = lu(k,1199) - lu(k,904) * lu(k,1195) - lu(k,1200) = lu(k,1200) - lu(k,905) * lu(k,1195) - lu(k,1201) = lu(k,1201) - lu(k,906) * lu(k,1195) - lu(k,1202) = lu(k,1202) - lu(k,907) * lu(k,1195) - lu(k,1203) = lu(k,1203) - lu(k,908) * lu(k,1195) - lu(k,1204) = lu(k,1204) - lu(k,909) * lu(k,1195) - lu(k,1205) = lu(k,1205) - lu(k,910) * lu(k,1195) - lu(k,1206) = lu(k,1206) - lu(k,911) * lu(k,1195) - lu(k,1207) = lu(k,1207) - lu(k,912) * lu(k,1195) - lu(k,1208) = lu(k,1208) - lu(k,913) * lu(k,1195) - lu(k,1209) = lu(k,1209) - lu(k,914) * lu(k,1195) - lu(k,1210) = lu(k,1210) - lu(k,915) * lu(k,1195) - lu(k,1211) = lu(k,1211) - lu(k,916) * lu(k,1195) - lu(k,1212) = lu(k,1212) - lu(k,917) * lu(k,1195) - lu(k,1213) = lu(k,1213) - lu(k,918) * lu(k,1195) - lu(k,1214) = lu(k,1214) - lu(k,919) * lu(k,1195) - lu(k,1215) = lu(k,1215) - lu(k,920) * lu(k,1195) - lu(k,1216) = lu(k,1216) - lu(k,921) * lu(k,1195) - lu(k,1217) = lu(k,1217) - lu(k,922) * lu(k,1195) - lu(k,1245) = lu(k,1245) - lu(k,901) * lu(k,1244) - lu(k,1246) = lu(k,1246) - lu(k,902) * lu(k,1244) - lu(k,1247) = lu(k,1247) - lu(k,903) * lu(k,1244) - lu(k,1248) = lu(k,1248) - lu(k,904) * lu(k,1244) - lu(k,1249) = lu(k,1249) - lu(k,905) * lu(k,1244) - lu(k,1250) = lu(k,1250) - lu(k,906) * lu(k,1244) - lu(k,1251) = lu(k,1251) - lu(k,907) * lu(k,1244) - lu(k,1252) = lu(k,1252) - lu(k,908) * lu(k,1244) - lu(k,1253) = lu(k,1253) - lu(k,909) * lu(k,1244) - lu(k,1254) = lu(k,1254) - lu(k,910) * lu(k,1244) - lu(k,1255) = lu(k,1255) - lu(k,911) * lu(k,1244) - lu(k,1256) = lu(k,1256) - lu(k,912) * lu(k,1244) - lu(k,1257) = lu(k,1257) - lu(k,913) * lu(k,1244) - lu(k,1258) = lu(k,1258) - lu(k,914) * lu(k,1244) - lu(k,1259) = lu(k,1259) - lu(k,915) * lu(k,1244) - lu(k,1260) = lu(k,1260) - lu(k,916) * lu(k,1244) - lu(k,1261) = lu(k,1261) - lu(k,917) * lu(k,1244) - lu(k,1262) = lu(k,1262) - lu(k,918) * lu(k,1244) - lu(k,1263) = lu(k,1263) - lu(k,919) * lu(k,1244) - lu(k,1264) = lu(k,1264) - lu(k,920) * lu(k,1244) - lu(k,1265) = lu(k,1265) - lu(k,921) * lu(k,1244) - lu(k,1266) = lu(k,1266) - lu(k,922) * lu(k,1244) - lu(k,1284) = lu(k,1284) - lu(k,901) * lu(k,1283) - lu(k,1285) = lu(k,1285) - lu(k,902) * lu(k,1283) - lu(k,1286) = lu(k,1286) - lu(k,903) * lu(k,1283) - lu(k,1287) = lu(k,1287) - lu(k,904) * lu(k,1283) - lu(k,1288) = lu(k,1288) - lu(k,905) * lu(k,1283) - lu(k,1289) = lu(k,1289) - lu(k,906) * lu(k,1283) - lu(k,1290) = lu(k,1290) - lu(k,907) * lu(k,1283) - lu(k,1291) = lu(k,1291) - lu(k,908) * lu(k,1283) - lu(k,1292) = lu(k,1292) - lu(k,909) * lu(k,1283) - lu(k,1293) = lu(k,1293) - lu(k,910) * lu(k,1283) - lu(k,1294) = lu(k,1294) - lu(k,911) * lu(k,1283) - lu(k,1295) = lu(k,1295) - lu(k,912) * lu(k,1283) - lu(k,1296) = lu(k,1296) - lu(k,913) * lu(k,1283) - lu(k,1297) = lu(k,1297) - lu(k,914) * lu(k,1283) - lu(k,1298) = lu(k,1298) - lu(k,915) * lu(k,1283) - lu(k,1299) = lu(k,1299) - lu(k,916) * lu(k,1283) - lu(k,1300) = lu(k,1300) - lu(k,917) * lu(k,1283) - lu(k,1301) = lu(k,1301) - lu(k,918) * lu(k,1283) - lu(k,1302) = lu(k,1302) - lu(k,919) * lu(k,1283) - lu(k,1303) = lu(k,1303) - lu(k,920) * lu(k,1283) - lu(k,1304) = lu(k,1304) - lu(k,921) * lu(k,1283) - lu(k,1305) = lu(k,1305) - lu(k,922) * lu(k,1283) - lu(k,1319) = lu(k,1319) - lu(k,901) * lu(k,1318) - lu(k,1320) = lu(k,1320) - lu(k,902) * lu(k,1318) - lu(k,1321) = lu(k,1321) - lu(k,903) * lu(k,1318) - lu(k,1322) = lu(k,1322) - lu(k,904) * lu(k,1318) - lu(k,1323) = lu(k,1323) - lu(k,905) * lu(k,1318) - lu(k,1324) = lu(k,1324) - lu(k,906) * lu(k,1318) - lu(k,1325) = lu(k,1325) - lu(k,907) * lu(k,1318) - lu(k,1326) = lu(k,1326) - lu(k,908) * lu(k,1318) - lu(k,1327) = lu(k,1327) - lu(k,909) * lu(k,1318) - lu(k,1328) = lu(k,1328) - lu(k,910) * lu(k,1318) - lu(k,1329) = lu(k,1329) - lu(k,911) * lu(k,1318) - lu(k,1330) = lu(k,1330) - lu(k,912) * lu(k,1318) - lu(k,1331) = lu(k,1331) - lu(k,913) * lu(k,1318) - lu(k,1332) = lu(k,1332) - lu(k,914) * lu(k,1318) - lu(k,1333) = lu(k,1333) - lu(k,915) * lu(k,1318) - lu(k,1334) = lu(k,1334) - lu(k,916) * lu(k,1318) - lu(k,1335) = lu(k,1335) - lu(k,917) * lu(k,1318) - lu(k,1336) = lu(k,1336) - lu(k,918) * lu(k,1318) - lu(k,1337) = lu(k,1337) - lu(k,919) * lu(k,1318) - lu(k,1338) = lu(k,1338) - lu(k,920) * lu(k,1318) - lu(k,1339) = lu(k,1339) - lu(k,921) * lu(k,1318) - lu(k,1340) = lu(k,1340) - lu(k,922) * lu(k,1318) - lu(k,1363) = lu(k,1363) - lu(k,901) * lu(k,1362) - lu(k,1364) = lu(k,1364) - lu(k,902) * lu(k,1362) - lu(k,1365) = lu(k,1365) - lu(k,903) * lu(k,1362) - lu(k,1366) = lu(k,1366) - lu(k,904) * lu(k,1362) - lu(k,1367) = lu(k,1367) - lu(k,905) * lu(k,1362) - lu(k,1368) = lu(k,1368) - lu(k,906) * lu(k,1362) - lu(k,1369) = lu(k,1369) - lu(k,907) * lu(k,1362) - lu(k,1370) = lu(k,1370) - lu(k,908) * lu(k,1362) - lu(k,1371) = lu(k,1371) - lu(k,909) * lu(k,1362) - lu(k,1372) = lu(k,1372) - lu(k,910) * lu(k,1362) - lu(k,1373) = lu(k,1373) - lu(k,911) * lu(k,1362) - lu(k,1374) = lu(k,1374) - lu(k,912) * lu(k,1362) - lu(k,1375) = lu(k,1375) - lu(k,913) * lu(k,1362) - lu(k,1376) = lu(k,1376) - lu(k,914) * lu(k,1362) - lu(k,1377) = lu(k,1377) - lu(k,915) * lu(k,1362) - lu(k,1378) = lu(k,1378) - lu(k,916) * lu(k,1362) - lu(k,1379) = lu(k,1379) - lu(k,917) * lu(k,1362) - lu(k,1380) = lu(k,1380) - lu(k,918) * lu(k,1362) - lu(k,1381) = lu(k,1381) - lu(k,919) * lu(k,1362) - lu(k,1382) = lu(k,1382) - lu(k,920) * lu(k,1362) - lu(k,1383) = lu(k,1383) - lu(k,921) * lu(k,1362) - lu(k,1384) = lu(k,1384) - lu(k,922) * lu(k,1362) - lu(k,1422) = lu(k,1422) - lu(k,901) * lu(k,1421) - lu(k,1423) = lu(k,1423) - lu(k,902) * lu(k,1421) - lu(k,1424) = lu(k,1424) - lu(k,903) * lu(k,1421) - lu(k,1425) = lu(k,1425) - lu(k,904) * lu(k,1421) - lu(k,1426) = lu(k,1426) - lu(k,905) * lu(k,1421) - lu(k,1427) = lu(k,1427) - lu(k,906) * lu(k,1421) - lu(k,1428) = lu(k,1428) - lu(k,907) * lu(k,1421) - lu(k,1429) = lu(k,1429) - lu(k,908) * lu(k,1421) - lu(k,1430) = lu(k,1430) - lu(k,909) * lu(k,1421) - lu(k,1431) = lu(k,1431) - lu(k,910) * lu(k,1421) - lu(k,1432) = lu(k,1432) - lu(k,911) * lu(k,1421) - lu(k,1433) = lu(k,1433) - lu(k,912) * lu(k,1421) - lu(k,1434) = lu(k,1434) - lu(k,913) * lu(k,1421) - lu(k,1435) = lu(k,1435) - lu(k,914) * lu(k,1421) - lu(k,1436) = lu(k,1436) - lu(k,915) * lu(k,1421) - lu(k,1437) = lu(k,1437) - lu(k,916) * lu(k,1421) - lu(k,1438) = lu(k,1438) - lu(k,917) * lu(k,1421) - lu(k,1439) = lu(k,1439) - lu(k,918) * lu(k,1421) - lu(k,1440) = lu(k,1440) - lu(k,919) * lu(k,1421) - lu(k,1441) = lu(k,1441) - lu(k,920) * lu(k,1421) - lu(k,1442) = lu(k,1442) - lu(k,921) * lu(k,1421) - lu(k,1443) = lu(k,1443) - lu(k,922) * lu(k,1421) - lu(k,1464) = lu(k,1464) - lu(k,901) * lu(k,1463) - lu(k,1465) = lu(k,1465) - lu(k,902) * lu(k,1463) - lu(k,1466) = lu(k,1466) - lu(k,903) * lu(k,1463) - lu(k,1467) = lu(k,1467) - lu(k,904) * lu(k,1463) - lu(k,1468) = lu(k,1468) - lu(k,905) * lu(k,1463) - lu(k,1469) = lu(k,1469) - lu(k,906) * lu(k,1463) - lu(k,1470) = lu(k,1470) - lu(k,907) * lu(k,1463) - lu(k,1471) = lu(k,1471) - lu(k,908) * lu(k,1463) - lu(k,1472) = lu(k,1472) - lu(k,909) * lu(k,1463) - lu(k,1473) = lu(k,1473) - lu(k,910) * lu(k,1463) - lu(k,1474) = lu(k,1474) - lu(k,911) * lu(k,1463) - lu(k,1475) = lu(k,1475) - lu(k,912) * lu(k,1463) - lu(k,1476) = lu(k,1476) - lu(k,913) * lu(k,1463) - lu(k,1477) = lu(k,1477) - lu(k,914) * lu(k,1463) - lu(k,1478) = lu(k,1478) - lu(k,915) * lu(k,1463) - lu(k,1479) = lu(k,1479) - lu(k,916) * lu(k,1463) - lu(k,1480) = lu(k,1480) - lu(k,917) * lu(k,1463) - lu(k,1481) = lu(k,1481) - lu(k,918) * lu(k,1463) - lu(k,1482) = lu(k,1482) - lu(k,919) * lu(k,1463) - lu(k,1483) = lu(k,1483) - lu(k,920) * lu(k,1463) - lu(k,1484) = lu(k,1484) - lu(k,921) * lu(k,1463) - lu(k,1485) = lu(k,1485) - lu(k,922) * lu(k,1463) - lu(k,1505) = lu(k,1505) - lu(k,901) * lu(k,1504) - lu(k,1506) = lu(k,1506) - lu(k,902) * lu(k,1504) - lu(k,1507) = lu(k,1507) - lu(k,903) * lu(k,1504) - lu(k,1508) = lu(k,1508) - lu(k,904) * lu(k,1504) - lu(k,1509) = lu(k,1509) - lu(k,905) * lu(k,1504) - lu(k,1510) = lu(k,1510) - lu(k,906) * lu(k,1504) - lu(k,1511) = lu(k,1511) - lu(k,907) * lu(k,1504) - lu(k,1512) = lu(k,1512) - lu(k,908) * lu(k,1504) - lu(k,1513) = lu(k,1513) - lu(k,909) * lu(k,1504) - lu(k,1514) = lu(k,1514) - lu(k,910) * lu(k,1504) - lu(k,1515) = lu(k,1515) - lu(k,911) * lu(k,1504) - lu(k,1516) = lu(k,1516) - lu(k,912) * lu(k,1504) - lu(k,1517) = lu(k,1517) - lu(k,913) * lu(k,1504) - lu(k,1518) = lu(k,1518) - lu(k,914) * lu(k,1504) - lu(k,1519) = lu(k,1519) - lu(k,915) * lu(k,1504) - lu(k,1520) = lu(k,1520) - lu(k,916) * lu(k,1504) - lu(k,1521) = lu(k,1521) - lu(k,917) * lu(k,1504) - lu(k,1522) = lu(k,1522) - lu(k,918) * lu(k,1504) - lu(k,1523) = lu(k,1523) - lu(k,919) * lu(k,1504) - lu(k,1524) = lu(k,1524) - lu(k,920) * lu(k,1504) - lu(k,1525) = lu(k,1525) - lu(k,921) * lu(k,1504) - lu(k,1526) = lu(k,1526) - lu(k,922) * lu(k,1504) - lu(k,1547) = lu(k,1547) - lu(k,901) * lu(k,1546) - lu(k,1548) = lu(k,1548) - lu(k,902) * lu(k,1546) - lu(k,1549) = lu(k,1549) - lu(k,903) * lu(k,1546) - lu(k,1550) = lu(k,1550) - lu(k,904) * lu(k,1546) - lu(k,1551) = lu(k,1551) - lu(k,905) * lu(k,1546) - lu(k,1552) = lu(k,1552) - lu(k,906) * lu(k,1546) - lu(k,1553) = lu(k,1553) - lu(k,907) * lu(k,1546) - lu(k,1554) = lu(k,1554) - lu(k,908) * lu(k,1546) - lu(k,1555) = lu(k,1555) - lu(k,909) * lu(k,1546) - lu(k,1556) = lu(k,1556) - lu(k,910) * lu(k,1546) - lu(k,1557) = lu(k,1557) - lu(k,911) * lu(k,1546) - lu(k,1558) = lu(k,1558) - lu(k,912) * lu(k,1546) - lu(k,1559) = lu(k,1559) - lu(k,913) * lu(k,1546) - lu(k,1560) = lu(k,1560) - lu(k,914) * lu(k,1546) - lu(k,1561) = lu(k,1561) - lu(k,915) * lu(k,1546) - lu(k,1562) = lu(k,1562) - lu(k,916) * lu(k,1546) - lu(k,1563) = lu(k,1563) - lu(k,917) * lu(k,1546) - lu(k,1564) = lu(k,1564) - lu(k,918) * lu(k,1546) - lu(k,1565) = lu(k,1565) - lu(k,919) * lu(k,1546) - lu(k,1566) = lu(k,1566) - lu(k,920) * lu(k,1546) - lu(k,1567) = lu(k,1567) - lu(k,921) * lu(k,1546) - lu(k,1568) = lu(k,1568) - lu(k,922) * lu(k,1546) - lu(k,1589) = lu(k,1589) - lu(k,901) * lu(k,1588) - lu(k,1590) = lu(k,1590) - lu(k,902) * lu(k,1588) - lu(k,1591) = lu(k,1591) - lu(k,903) * lu(k,1588) - lu(k,1592) = lu(k,1592) - lu(k,904) * lu(k,1588) - lu(k,1593) = lu(k,1593) - lu(k,905) * lu(k,1588) - lu(k,1594) = lu(k,1594) - lu(k,906) * lu(k,1588) - lu(k,1595) = lu(k,1595) - lu(k,907) * lu(k,1588) - lu(k,1596) = lu(k,1596) - lu(k,908) * lu(k,1588) - lu(k,1597) = lu(k,1597) - lu(k,909) * lu(k,1588) - lu(k,1598) = lu(k,1598) - lu(k,910) * lu(k,1588) - lu(k,1599) = lu(k,1599) - lu(k,911) * lu(k,1588) - lu(k,1600) = lu(k,1600) - lu(k,912) * lu(k,1588) - lu(k,1601) = lu(k,1601) - lu(k,913) * lu(k,1588) - lu(k,1602) = lu(k,1602) - lu(k,914) * lu(k,1588) - lu(k,1603) = lu(k,1603) - lu(k,915) * lu(k,1588) - lu(k,1604) = lu(k,1604) - lu(k,916) * lu(k,1588) - lu(k,1605) = lu(k,1605) - lu(k,917) * lu(k,1588) - lu(k,1606) = lu(k,1606) - lu(k,918) * lu(k,1588) - lu(k,1607) = lu(k,1607) - lu(k,919) * lu(k,1588) - lu(k,1608) = lu(k,1608) - lu(k,920) * lu(k,1588) - lu(k,1609) = lu(k,1609) - lu(k,921) * lu(k,1588) - lu(k,1610) = lu(k,1610) - lu(k,922) * lu(k,1588) - lu(k,1621) = lu(k,1621) - lu(k,901) * lu(k,1620) - lu(k,1622) = lu(k,1622) - lu(k,902) * lu(k,1620) - lu(k,1623) = lu(k,1623) - lu(k,903) * lu(k,1620) - lu(k,1624) = lu(k,1624) - lu(k,904) * lu(k,1620) - lu(k,1625) = lu(k,1625) - lu(k,905) * lu(k,1620) - lu(k,1626) = lu(k,1626) - lu(k,906) * lu(k,1620) - lu(k,1627) = lu(k,1627) - lu(k,907) * lu(k,1620) - lu(k,1628) = lu(k,1628) - lu(k,908) * lu(k,1620) - lu(k,1629) = lu(k,1629) - lu(k,909) * lu(k,1620) - lu(k,1630) = lu(k,1630) - lu(k,910) * lu(k,1620) - lu(k,1631) = lu(k,1631) - lu(k,911) * lu(k,1620) - lu(k,1632) = lu(k,1632) - lu(k,912) * lu(k,1620) - lu(k,1633) = lu(k,1633) - lu(k,913) * lu(k,1620) - lu(k,1634) = lu(k,1634) - lu(k,914) * lu(k,1620) - lu(k,1635) = lu(k,1635) - lu(k,915) * lu(k,1620) - lu(k,1636) = lu(k,1636) - lu(k,916) * lu(k,1620) - lu(k,1637) = lu(k,1637) - lu(k,917) * lu(k,1620) - lu(k,1638) = lu(k,1638) - lu(k,918) * lu(k,1620) - lu(k,1639) = lu(k,1639) - lu(k,919) * lu(k,1620) - lu(k,1640) = lu(k,1640) - lu(k,920) * lu(k,1620) - lu(k,1641) = lu(k,1641) - lu(k,921) * lu(k,1620) - lu(k,1642) = lu(k,1642) - lu(k,922) * lu(k,1620) - lu(k,1656) = lu(k,1656) - lu(k,901) * lu(k,1655) - lu(k,1657) = lu(k,1657) - lu(k,902) * lu(k,1655) - lu(k,1658) = lu(k,1658) - lu(k,903) * lu(k,1655) - lu(k,1659) = lu(k,1659) - lu(k,904) * lu(k,1655) - lu(k,1660) = lu(k,1660) - lu(k,905) * lu(k,1655) - lu(k,1661) = lu(k,1661) - lu(k,906) * lu(k,1655) - lu(k,1662) = lu(k,1662) - lu(k,907) * lu(k,1655) - lu(k,1663) = lu(k,1663) - lu(k,908) * lu(k,1655) - lu(k,1664) = lu(k,1664) - lu(k,909) * lu(k,1655) - lu(k,1665) = lu(k,1665) - lu(k,910) * lu(k,1655) - lu(k,1666) = lu(k,1666) - lu(k,911) * lu(k,1655) - lu(k,1667) = lu(k,1667) - lu(k,912) * lu(k,1655) - lu(k,1668) = lu(k,1668) - lu(k,913) * lu(k,1655) - lu(k,1669) = lu(k,1669) - lu(k,914) * lu(k,1655) - lu(k,1670) = lu(k,1670) - lu(k,915) * lu(k,1655) - lu(k,1671) = lu(k,1671) - lu(k,916) * lu(k,1655) - lu(k,1672) = lu(k,1672) - lu(k,917) * lu(k,1655) - lu(k,1673) = lu(k,1673) - lu(k,918) * lu(k,1655) - lu(k,1674) = lu(k,1674) - lu(k,919) * lu(k,1655) - lu(k,1675) = lu(k,1675) - lu(k,920) * lu(k,1655) - lu(k,1676) = lu(k,1676) - lu(k,921) * lu(k,1655) - lu(k,1677) = lu(k,1677) - lu(k,922) * lu(k,1655) - lu(k,1698) = lu(k,1698) - lu(k,901) * lu(k,1697) - lu(k,1699) = lu(k,1699) - lu(k,902) * lu(k,1697) - lu(k,1700) = lu(k,1700) - lu(k,903) * lu(k,1697) - lu(k,1701) = lu(k,1701) - lu(k,904) * lu(k,1697) - lu(k,1702) = lu(k,1702) - lu(k,905) * lu(k,1697) - lu(k,1703) = lu(k,1703) - lu(k,906) * lu(k,1697) - lu(k,1704) = lu(k,1704) - lu(k,907) * lu(k,1697) - lu(k,1705) = lu(k,1705) - lu(k,908) * lu(k,1697) - lu(k,1706) = lu(k,1706) - lu(k,909) * lu(k,1697) - lu(k,1707) = lu(k,1707) - lu(k,910) * lu(k,1697) - lu(k,1708) = lu(k,1708) - lu(k,911) * lu(k,1697) - lu(k,1709) = lu(k,1709) - lu(k,912) * lu(k,1697) - lu(k,1710) = lu(k,1710) - lu(k,913) * lu(k,1697) - lu(k,1711) = lu(k,1711) - lu(k,914) * lu(k,1697) - lu(k,1712) = lu(k,1712) - lu(k,915) * lu(k,1697) - lu(k,1713) = lu(k,1713) - lu(k,916) * lu(k,1697) - lu(k,1714) = lu(k,1714) - lu(k,917) * lu(k,1697) - lu(k,1715) = lu(k,1715) - lu(k,918) * lu(k,1697) - lu(k,1716) = lu(k,1716) - lu(k,919) * lu(k,1697) - lu(k,1717) = lu(k,1717) - lu(k,920) * lu(k,1697) - lu(k,1718) = lu(k,1718) - lu(k,921) * lu(k,1697) - lu(k,1719) = lu(k,1719) - lu(k,922) * lu(k,1697) - lu(k,1742) = lu(k,1742) - lu(k,901) * lu(k,1741) - lu(k,1743) = lu(k,1743) - lu(k,902) * lu(k,1741) - lu(k,1744) = lu(k,1744) - lu(k,903) * lu(k,1741) - lu(k,1745) = lu(k,1745) - lu(k,904) * lu(k,1741) - lu(k,1746) = lu(k,1746) - lu(k,905) * lu(k,1741) - lu(k,1747) = lu(k,1747) - lu(k,906) * lu(k,1741) - lu(k,1748) = lu(k,1748) - lu(k,907) * lu(k,1741) - lu(k,1749) = lu(k,1749) - lu(k,908) * lu(k,1741) - lu(k,1750) = lu(k,1750) - lu(k,909) * lu(k,1741) - lu(k,1751) = lu(k,1751) - lu(k,910) * lu(k,1741) - lu(k,1752) = lu(k,1752) - lu(k,911) * lu(k,1741) - lu(k,1753) = lu(k,1753) - lu(k,912) * lu(k,1741) - lu(k,1754) = lu(k,1754) - lu(k,913) * lu(k,1741) - lu(k,1755) = lu(k,1755) - lu(k,914) * lu(k,1741) - lu(k,1756) = lu(k,1756) - lu(k,915) * lu(k,1741) - lu(k,1757) = lu(k,1757) - lu(k,916) * lu(k,1741) - lu(k,1758) = lu(k,1758) - lu(k,917) * lu(k,1741) - lu(k,1759) = lu(k,1759) - lu(k,918) * lu(k,1741) - lu(k,1760) = lu(k,1760) - lu(k,919) * lu(k,1741) - lu(k,1761) = lu(k,1761) - lu(k,920) * lu(k,1741) - lu(k,1762) = lu(k,1762) - lu(k,921) * lu(k,1741) - lu(k,1763) = lu(k,1763) - lu(k,922) * lu(k,1741) - lu(k,1777) = lu(k,1777) - lu(k,901) * lu(k,1776) - lu(k,1778) = lu(k,1778) - lu(k,902) * lu(k,1776) - lu(k,1779) = lu(k,1779) - lu(k,903) * lu(k,1776) - lu(k,1780) = lu(k,1780) - lu(k,904) * lu(k,1776) - lu(k,1781) = lu(k,1781) - lu(k,905) * lu(k,1776) - lu(k,1782) = lu(k,1782) - lu(k,906) * lu(k,1776) - lu(k,1783) = lu(k,1783) - lu(k,907) * lu(k,1776) - lu(k,1784) = lu(k,1784) - lu(k,908) * lu(k,1776) - lu(k,1785) = lu(k,1785) - lu(k,909) * lu(k,1776) - lu(k,1786) = lu(k,1786) - lu(k,910) * lu(k,1776) - lu(k,1787) = lu(k,1787) - lu(k,911) * lu(k,1776) - lu(k,1788) = lu(k,1788) - lu(k,912) * lu(k,1776) - lu(k,1789) = lu(k,1789) - lu(k,913) * lu(k,1776) - lu(k,1790) = lu(k,1790) - lu(k,914) * lu(k,1776) - lu(k,1791) = lu(k,1791) - lu(k,915) * lu(k,1776) - lu(k,1792) = lu(k,1792) - lu(k,916) * lu(k,1776) - lu(k,1793) = lu(k,1793) - lu(k,917) * lu(k,1776) - lu(k,1794) = lu(k,1794) - lu(k,918) * lu(k,1776) - lu(k,1795) = lu(k,1795) - lu(k,919) * lu(k,1776) - lu(k,1796) = lu(k,1796) - lu(k,920) * lu(k,1776) - lu(k,1797) = lu(k,1797) - lu(k,921) * lu(k,1776) - lu(k,1798) = lu(k,1798) - lu(k,922) * lu(k,1776) - lu(k,1835) = lu(k,1835) - lu(k,901) * lu(k,1834) - lu(k,1836) = lu(k,1836) - lu(k,902) * lu(k,1834) - lu(k,1837) = lu(k,1837) - lu(k,903) * lu(k,1834) - lu(k,1838) = lu(k,1838) - lu(k,904) * lu(k,1834) - lu(k,1839) = lu(k,1839) - lu(k,905) * lu(k,1834) - lu(k,1840) = lu(k,1840) - lu(k,906) * lu(k,1834) - lu(k,1841) = lu(k,1841) - lu(k,907) * lu(k,1834) - lu(k,1842) = lu(k,1842) - lu(k,908) * lu(k,1834) - lu(k,1843) = lu(k,1843) - lu(k,909) * lu(k,1834) - lu(k,1844) = lu(k,1844) - lu(k,910) * lu(k,1834) - lu(k,1845) = lu(k,1845) - lu(k,911) * lu(k,1834) - lu(k,1846) = lu(k,1846) - lu(k,912) * lu(k,1834) - lu(k,1847) = lu(k,1847) - lu(k,913) * lu(k,1834) - lu(k,1848) = lu(k,1848) - lu(k,914) * lu(k,1834) - lu(k,1849) = lu(k,1849) - lu(k,915) * lu(k,1834) - lu(k,1850) = lu(k,1850) - lu(k,916) * lu(k,1834) - lu(k,1851) = lu(k,1851) - lu(k,917) * lu(k,1834) - lu(k,1852) = lu(k,1852) - lu(k,918) * lu(k,1834) - lu(k,1853) = lu(k,1853) - lu(k,919) * lu(k,1834) - lu(k,1854) = lu(k,1854) - lu(k,920) * lu(k,1834) - lu(k,1855) = lu(k,1855) - lu(k,921) * lu(k,1834) - lu(k,1856) = lu(k,1856) - lu(k,922) * lu(k,1834) - 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,953) = lu(k,953) * lu(k,943) - lu(k,954) = lu(k,954) * lu(k,943) - lu(k,955) = lu(k,955) * lu(k,943) - lu(k,956) = lu(k,956) * lu(k,943) - lu(k,957) = lu(k,957) * lu(k,943) - lu(k,958) = lu(k,958) * lu(k,943) - lu(k,959) = lu(k,959) * lu(k,943) - lu(k,960) = lu(k,960) * lu(k,943) - lu(k,961) = lu(k,961) * lu(k,943) - lu(k,962) = lu(k,962) * lu(k,943) - lu(k,963) = lu(k,963) * lu(k,943) - lu(k,964) = lu(k,964) * lu(k,943) - lu(k,990) = lu(k,990) - lu(k,944) * lu(k,989) - lu(k,991) = lu(k,991) - lu(k,945) * lu(k,989) - lu(k,992) = lu(k,992) - lu(k,946) * lu(k,989) - lu(k,993) = lu(k,993) - lu(k,947) * lu(k,989) - lu(k,994) = lu(k,994) - lu(k,948) * lu(k,989) - lu(k,995) = lu(k,995) - lu(k,949) * lu(k,989) - lu(k,996) = lu(k,996) - lu(k,950) * lu(k,989) - lu(k,997) = lu(k,997) - lu(k,951) * lu(k,989) - lu(k,998) = lu(k,998) - lu(k,952) * lu(k,989) - lu(k,999) = lu(k,999) - lu(k,953) * lu(k,989) - lu(k,1000) = lu(k,1000) - lu(k,954) * lu(k,989) - lu(k,1001) = lu(k,1001) - lu(k,955) * lu(k,989) - lu(k,1002) = lu(k,1002) - lu(k,956) * lu(k,989) - lu(k,1003) = lu(k,1003) - lu(k,957) * lu(k,989) - lu(k,1004) = lu(k,1004) - lu(k,958) * lu(k,989) - lu(k,1005) = lu(k,1005) - lu(k,959) * lu(k,989) - lu(k,1006) = lu(k,1006) - lu(k,960) * lu(k,989) - lu(k,1007) = lu(k,1007) - lu(k,961) * lu(k,989) - lu(k,1008) = lu(k,1008) - lu(k,962) * lu(k,989) - lu(k,1009) = lu(k,1009) - lu(k,963) * lu(k,989) - lu(k,1010) = lu(k,1010) - lu(k,964) * lu(k,989) - lu(k,1032) = lu(k,1032) - lu(k,944) * lu(k,1031) - lu(k,1033) = lu(k,1033) - lu(k,945) * lu(k,1031) - lu(k,1034) = lu(k,1034) - lu(k,946) * lu(k,1031) - lu(k,1035) = lu(k,1035) - lu(k,947) * lu(k,1031) - lu(k,1036) = lu(k,1036) - lu(k,948) * lu(k,1031) - lu(k,1037) = lu(k,1037) - lu(k,949) * lu(k,1031) - lu(k,1038) = lu(k,1038) - lu(k,950) * lu(k,1031) - lu(k,1039) = lu(k,1039) - lu(k,951) * lu(k,1031) - lu(k,1040) = lu(k,1040) - lu(k,952) * lu(k,1031) - lu(k,1041) = lu(k,1041) - lu(k,953) * lu(k,1031) - lu(k,1042) = lu(k,1042) - lu(k,954) * lu(k,1031) - lu(k,1043) = lu(k,1043) - lu(k,955) * lu(k,1031) - lu(k,1044) = lu(k,1044) - lu(k,956) * lu(k,1031) - lu(k,1045) = lu(k,1045) - lu(k,957) * lu(k,1031) - lu(k,1046) = lu(k,1046) - lu(k,958) * lu(k,1031) - lu(k,1047) = lu(k,1047) - lu(k,959) * lu(k,1031) - lu(k,1048) = lu(k,1048) - lu(k,960) * lu(k,1031) - lu(k,1049) = lu(k,1049) - lu(k,961) * lu(k,1031) - lu(k,1050) = lu(k,1050) - lu(k,962) * lu(k,1031) - lu(k,1051) = lu(k,1051) - lu(k,963) * lu(k,1031) - lu(k,1052) = lu(k,1052) - lu(k,964) * lu(k,1031) - lu(k,1073) = lu(k,1073) - lu(k,944) * lu(k,1072) - lu(k,1074) = lu(k,1074) - lu(k,945) * lu(k,1072) - lu(k,1075) = lu(k,1075) - lu(k,946) * lu(k,1072) - lu(k,1076) = lu(k,1076) - lu(k,947) * lu(k,1072) - lu(k,1077) = lu(k,1077) - lu(k,948) * lu(k,1072) - lu(k,1078) = lu(k,1078) - lu(k,949) * lu(k,1072) - lu(k,1079) = lu(k,1079) - lu(k,950) * lu(k,1072) - lu(k,1080) = lu(k,1080) - lu(k,951) * lu(k,1072) - lu(k,1081) = lu(k,1081) - lu(k,952) * lu(k,1072) - lu(k,1082) = lu(k,1082) - lu(k,953) * lu(k,1072) - lu(k,1083) = lu(k,1083) - lu(k,954) * lu(k,1072) - lu(k,1084) = lu(k,1084) - lu(k,955) * lu(k,1072) - lu(k,1085) = lu(k,1085) - lu(k,956) * lu(k,1072) - lu(k,1086) = lu(k,1086) - lu(k,957) * lu(k,1072) - lu(k,1087) = lu(k,1087) - lu(k,958) * lu(k,1072) - lu(k,1088) = lu(k,1088) - lu(k,959) * lu(k,1072) - lu(k,1089) = lu(k,1089) - lu(k,960) * lu(k,1072) - lu(k,1090) = lu(k,1090) - lu(k,961) * lu(k,1072) - lu(k,1091) = lu(k,1091) - lu(k,962) * lu(k,1072) - lu(k,1092) = lu(k,1092) - lu(k,963) * lu(k,1072) - lu(k,1093) = lu(k,1093) - lu(k,964) * lu(k,1072) - lu(k,1112) = lu(k,1112) - lu(k,944) * lu(k,1111) - lu(k,1113) = lu(k,1113) - lu(k,945) * lu(k,1111) - lu(k,1114) = lu(k,1114) - lu(k,946) * lu(k,1111) - lu(k,1115) = lu(k,1115) - lu(k,947) * lu(k,1111) - lu(k,1116) = lu(k,1116) - lu(k,948) * lu(k,1111) - lu(k,1117) = lu(k,1117) - lu(k,949) * lu(k,1111) - lu(k,1118) = lu(k,1118) - lu(k,950) * lu(k,1111) - lu(k,1119) = lu(k,1119) - lu(k,951) * lu(k,1111) - lu(k,1120) = lu(k,1120) - lu(k,952) * lu(k,1111) - lu(k,1121) = lu(k,1121) - lu(k,953) * lu(k,1111) - lu(k,1122) = lu(k,1122) - lu(k,954) * lu(k,1111) - lu(k,1123) = lu(k,1123) - lu(k,955) * lu(k,1111) - lu(k,1124) = lu(k,1124) - lu(k,956) * lu(k,1111) - lu(k,1125) = lu(k,1125) - lu(k,957) * lu(k,1111) - lu(k,1126) = lu(k,1126) - lu(k,958) * lu(k,1111) - lu(k,1127) = lu(k,1127) - lu(k,959) * lu(k,1111) - lu(k,1128) = lu(k,1128) - lu(k,960) * lu(k,1111) - lu(k,1129) = lu(k,1129) - lu(k,961) * lu(k,1111) - lu(k,1130) = lu(k,1130) - lu(k,962) * lu(k,1111) - lu(k,1131) = lu(k,1131) - lu(k,963) * lu(k,1111) - lu(k,1132) = lu(k,1132) - lu(k,964) * lu(k,1111) - lu(k,1156) = lu(k,1156) - lu(k,944) * lu(k,1155) - lu(k,1157) = lu(k,1157) - lu(k,945) * lu(k,1155) - lu(k,1158) = lu(k,1158) - lu(k,946) * lu(k,1155) - lu(k,1159) = lu(k,1159) - lu(k,947) * lu(k,1155) - lu(k,1160) = lu(k,1160) - lu(k,948) * lu(k,1155) - lu(k,1161) = lu(k,1161) - lu(k,949) * lu(k,1155) - lu(k,1162) = lu(k,1162) - lu(k,950) * lu(k,1155) - lu(k,1163) = lu(k,1163) - lu(k,951) * lu(k,1155) - lu(k,1164) = lu(k,1164) - lu(k,952) * lu(k,1155) - lu(k,1165) = lu(k,1165) - lu(k,953) * lu(k,1155) - lu(k,1166) = lu(k,1166) - lu(k,954) * lu(k,1155) - lu(k,1167) = lu(k,1167) - lu(k,955) * lu(k,1155) - lu(k,1168) = lu(k,1168) - lu(k,956) * lu(k,1155) - lu(k,1169) = lu(k,1169) - lu(k,957) * lu(k,1155) - lu(k,1170) = lu(k,1170) - lu(k,958) * lu(k,1155) - lu(k,1171) = lu(k,1171) - lu(k,959) * lu(k,1155) - lu(k,1172) = lu(k,1172) - lu(k,960) * lu(k,1155) - lu(k,1173) = lu(k,1173) - lu(k,961) * lu(k,1155) - lu(k,1174) = lu(k,1174) - lu(k,962) * lu(k,1155) - lu(k,1175) = lu(k,1175) - lu(k,963) * lu(k,1155) - lu(k,1176) = lu(k,1176) - lu(k,964) * lu(k,1155) - lu(k,1197) = lu(k,1197) - lu(k,944) * lu(k,1196) - lu(k,1198) = lu(k,1198) - lu(k,945) * lu(k,1196) - lu(k,1199) = lu(k,1199) - lu(k,946) * lu(k,1196) - lu(k,1200) = lu(k,1200) - lu(k,947) * lu(k,1196) - lu(k,1201) = lu(k,1201) - lu(k,948) * lu(k,1196) - lu(k,1202) = lu(k,1202) - lu(k,949) * lu(k,1196) - lu(k,1203) = lu(k,1203) - lu(k,950) * lu(k,1196) - lu(k,1204) = lu(k,1204) - lu(k,951) * lu(k,1196) - lu(k,1205) = lu(k,1205) - lu(k,952) * lu(k,1196) - lu(k,1206) = lu(k,1206) - lu(k,953) * lu(k,1196) - lu(k,1207) = lu(k,1207) - lu(k,954) * lu(k,1196) - lu(k,1208) = lu(k,1208) - lu(k,955) * lu(k,1196) - lu(k,1209) = lu(k,1209) - lu(k,956) * lu(k,1196) - lu(k,1210) = lu(k,1210) - lu(k,957) * lu(k,1196) - lu(k,1211) = lu(k,1211) - lu(k,958) * lu(k,1196) - lu(k,1212) = lu(k,1212) - lu(k,959) * lu(k,1196) - lu(k,1213) = lu(k,1213) - lu(k,960) * lu(k,1196) - lu(k,1214) = lu(k,1214) - lu(k,961) * lu(k,1196) - lu(k,1215) = lu(k,1215) - lu(k,962) * lu(k,1196) - lu(k,1216) = lu(k,1216) - lu(k,963) * lu(k,1196) - lu(k,1217) = lu(k,1217) - lu(k,964) * lu(k,1196) - lu(k,1246) = lu(k,1246) - lu(k,944) * lu(k,1245) - lu(k,1247) = lu(k,1247) - lu(k,945) * lu(k,1245) - lu(k,1248) = lu(k,1248) - lu(k,946) * lu(k,1245) - lu(k,1249) = lu(k,1249) - lu(k,947) * lu(k,1245) - lu(k,1250) = lu(k,1250) - lu(k,948) * lu(k,1245) - lu(k,1251) = lu(k,1251) - lu(k,949) * lu(k,1245) - lu(k,1252) = lu(k,1252) - lu(k,950) * lu(k,1245) - lu(k,1253) = lu(k,1253) - lu(k,951) * lu(k,1245) - lu(k,1254) = lu(k,1254) - lu(k,952) * lu(k,1245) - lu(k,1255) = lu(k,1255) - lu(k,953) * lu(k,1245) - lu(k,1256) = lu(k,1256) - lu(k,954) * lu(k,1245) - lu(k,1257) = lu(k,1257) - lu(k,955) * lu(k,1245) - lu(k,1258) = lu(k,1258) - lu(k,956) * lu(k,1245) - lu(k,1259) = lu(k,1259) - lu(k,957) * lu(k,1245) - lu(k,1260) = lu(k,1260) - lu(k,958) * lu(k,1245) - lu(k,1261) = lu(k,1261) - lu(k,959) * lu(k,1245) - lu(k,1262) = lu(k,1262) - lu(k,960) * lu(k,1245) - lu(k,1263) = lu(k,1263) - lu(k,961) * lu(k,1245) - lu(k,1264) = lu(k,1264) - lu(k,962) * lu(k,1245) - lu(k,1265) = lu(k,1265) - lu(k,963) * lu(k,1245) - lu(k,1266) = lu(k,1266) - lu(k,964) * lu(k,1245) - lu(k,1285) = lu(k,1285) - lu(k,944) * lu(k,1284) - lu(k,1286) = lu(k,1286) - lu(k,945) * lu(k,1284) - lu(k,1287) = lu(k,1287) - lu(k,946) * lu(k,1284) - lu(k,1288) = lu(k,1288) - lu(k,947) * lu(k,1284) - lu(k,1289) = lu(k,1289) - lu(k,948) * lu(k,1284) - lu(k,1290) = lu(k,1290) - lu(k,949) * lu(k,1284) - lu(k,1291) = lu(k,1291) - lu(k,950) * lu(k,1284) - lu(k,1292) = lu(k,1292) - lu(k,951) * lu(k,1284) - lu(k,1293) = lu(k,1293) - lu(k,952) * lu(k,1284) - lu(k,1294) = lu(k,1294) - lu(k,953) * lu(k,1284) - lu(k,1295) = lu(k,1295) - lu(k,954) * lu(k,1284) - lu(k,1296) = lu(k,1296) - lu(k,955) * lu(k,1284) - lu(k,1297) = lu(k,1297) - lu(k,956) * lu(k,1284) - lu(k,1298) = lu(k,1298) - lu(k,957) * lu(k,1284) - lu(k,1299) = lu(k,1299) - lu(k,958) * lu(k,1284) - lu(k,1300) = lu(k,1300) - lu(k,959) * lu(k,1284) - lu(k,1301) = lu(k,1301) - lu(k,960) * lu(k,1284) - lu(k,1302) = lu(k,1302) - lu(k,961) * lu(k,1284) - lu(k,1303) = lu(k,1303) - lu(k,962) * lu(k,1284) - lu(k,1304) = lu(k,1304) - lu(k,963) * lu(k,1284) - lu(k,1305) = lu(k,1305) - lu(k,964) * lu(k,1284) - lu(k,1320) = lu(k,1320) - lu(k,944) * lu(k,1319) - lu(k,1321) = lu(k,1321) - lu(k,945) * lu(k,1319) - lu(k,1322) = lu(k,1322) - lu(k,946) * lu(k,1319) - lu(k,1323) = lu(k,1323) - lu(k,947) * lu(k,1319) - lu(k,1324) = lu(k,1324) - lu(k,948) * lu(k,1319) - lu(k,1325) = lu(k,1325) - lu(k,949) * lu(k,1319) - lu(k,1326) = lu(k,1326) - lu(k,950) * lu(k,1319) - lu(k,1327) = lu(k,1327) - lu(k,951) * lu(k,1319) - lu(k,1328) = lu(k,1328) - lu(k,952) * lu(k,1319) - lu(k,1329) = lu(k,1329) - lu(k,953) * lu(k,1319) - lu(k,1330) = lu(k,1330) - lu(k,954) * lu(k,1319) - lu(k,1331) = lu(k,1331) - lu(k,955) * lu(k,1319) - lu(k,1332) = lu(k,1332) - lu(k,956) * lu(k,1319) - lu(k,1333) = lu(k,1333) - lu(k,957) * lu(k,1319) - lu(k,1334) = lu(k,1334) - lu(k,958) * lu(k,1319) - lu(k,1335) = lu(k,1335) - lu(k,959) * lu(k,1319) - lu(k,1336) = lu(k,1336) - lu(k,960) * lu(k,1319) - lu(k,1337) = lu(k,1337) - lu(k,961) * lu(k,1319) - lu(k,1338) = lu(k,1338) - lu(k,962) * lu(k,1319) - lu(k,1339) = lu(k,1339) - lu(k,963) * lu(k,1319) - lu(k,1340) = lu(k,1340) - lu(k,964) * lu(k,1319) - lu(k,1364) = lu(k,1364) - lu(k,944) * lu(k,1363) - lu(k,1365) = lu(k,1365) - lu(k,945) * lu(k,1363) - lu(k,1366) = lu(k,1366) - lu(k,946) * lu(k,1363) - lu(k,1367) = lu(k,1367) - lu(k,947) * lu(k,1363) - lu(k,1368) = lu(k,1368) - lu(k,948) * lu(k,1363) - lu(k,1369) = lu(k,1369) - lu(k,949) * lu(k,1363) - lu(k,1370) = lu(k,1370) - lu(k,950) * lu(k,1363) - lu(k,1371) = lu(k,1371) - lu(k,951) * lu(k,1363) - lu(k,1372) = lu(k,1372) - lu(k,952) * lu(k,1363) - lu(k,1373) = lu(k,1373) - lu(k,953) * lu(k,1363) - lu(k,1374) = lu(k,1374) - lu(k,954) * lu(k,1363) - lu(k,1375) = lu(k,1375) - lu(k,955) * lu(k,1363) - lu(k,1376) = lu(k,1376) - lu(k,956) * lu(k,1363) - lu(k,1377) = lu(k,1377) - lu(k,957) * lu(k,1363) - lu(k,1378) = lu(k,1378) - lu(k,958) * lu(k,1363) - lu(k,1379) = lu(k,1379) - lu(k,959) * lu(k,1363) - lu(k,1380) = lu(k,1380) - lu(k,960) * lu(k,1363) - lu(k,1381) = lu(k,1381) - lu(k,961) * lu(k,1363) - lu(k,1382) = lu(k,1382) - lu(k,962) * lu(k,1363) - lu(k,1383) = lu(k,1383) - lu(k,963) * lu(k,1363) - lu(k,1384) = lu(k,1384) - lu(k,964) * lu(k,1363) - lu(k,1423) = lu(k,1423) - lu(k,944) * lu(k,1422) - lu(k,1424) = lu(k,1424) - lu(k,945) * lu(k,1422) - lu(k,1425) = lu(k,1425) - lu(k,946) * lu(k,1422) - lu(k,1426) = lu(k,1426) - lu(k,947) * lu(k,1422) - lu(k,1427) = lu(k,1427) - lu(k,948) * lu(k,1422) - lu(k,1428) = lu(k,1428) - lu(k,949) * lu(k,1422) - lu(k,1429) = lu(k,1429) - lu(k,950) * lu(k,1422) - lu(k,1430) = lu(k,1430) - lu(k,951) * lu(k,1422) - lu(k,1431) = lu(k,1431) - lu(k,952) * lu(k,1422) - lu(k,1432) = lu(k,1432) - lu(k,953) * lu(k,1422) - lu(k,1433) = lu(k,1433) - lu(k,954) * lu(k,1422) - lu(k,1434) = lu(k,1434) - lu(k,955) * lu(k,1422) - lu(k,1435) = lu(k,1435) - lu(k,956) * lu(k,1422) - lu(k,1436) = lu(k,1436) - lu(k,957) * lu(k,1422) - lu(k,1437) = lu(k,1437) - lu(k,958) * lu(k,1422) - lu(k,1438) = lu(k,1438) - lu(k,959) * lu(k,1422) - lu(k,1439) = lu(k,1439) - lu(k,960) * lu(k,1422) - lu(k,1440) = lu(k,1440) - lu(k,961) * lu(k,1422) - lu(k,1441) = lu(k,1441) - lu(k,962) * lu(k,1422) - lu(k,1442) = lu(k,1442) - lu(k,963) * lu(k,1422) - lu(k,1443) = lu(k,1443) - lu(k,964) * lu(k,1422) - lu(k,1465) = lu(k,1465) - lu(k,944) * lu(k,1464) - lu(k,1466) = lu(k,1466) - lu(k,945) * lu(k,1464) - lu(k,1467) = lu(k,1467) - lu(k,946) * lu(k,1464) - lu(k,1468) = lu(k,1468) - lu(k,947) * lu(k,1464) - lu(k,1469) = lu(k,1469) - lu(k,948) * lu(k,1464) - lu(k,1470) = lu(k,1470) - lu(k,949) * lu(k,1464) - lu(k,1471) = lu(k,1471) - lu(k,950) * lu(k,1464) - lu(k,1472) = lu(k,1472) - lu(k,951) * lu(k,1464) - lu(k,1473) = lu(k,1473) - lu(k,952) * lu(k,1464) - lu(k,1474) = lu(k,1474) - lu(k,953) * lu(k,1464) - lu(k,1475) = lu(k,1475) - lu(k,954) * lu(k,1464) - lu(k,1476) = lu(k,1476) - lu(k,955) * lu(k,1464) - lu(k,1477) = lu(k,1477) - lu(k,956) * lu(k,1464) - lu(k,1478) = lu(k,1478) - lu(k,957) * lu(k,1464) - lu(k,1479) = lu(k,1479) - lu(k,958) * lu(k,1464) - lu(k,1480) = lu(k,1480) - lu(k,959) * lu(k,1464) - lu(k,1481) = lu(k,1481) - lu(k,960) * lu(k,1464) - lu(k,1482) = lu(k,1482) - lu(k,961) * lu(k,1464) - lu(k,1483) = lu(k,1483) - lu(k,962) * lu(k,1464) - lu(k,1484) = lu(k,1484) - lu(k,963) * lu(k,1464) - lu(k,1485) = lu(k,1485) - lu(k,964) * lu(k,1464) - lu(k,1506) = lu(k,1506) - lu(k,944) * lu(k,1505) - lu(k,1507) = lu(k,1507) - lu(k,945) * lu(k,1505) - lu(k,1508) = lu(k,1508) - lu(k,946) * lu(k,1505) - lu(k,1509) = lu(k,1509) - lu(k,947) * lu(k,1505) - lu(k,1510) = lu(k,1510) - lu(k,948) * lu(k,1505) - lu(k,1511) = lu(k,1511) - lu(k,949) * lu(k,1505) - lu(k,1512) = lu(k,1512) - lu(k,950) * lu(k,1505) - lu(k,1513) = lu(k,1513) - lu(k,951) * lu(k,1505) - lu(k,1514) = lu(k,1514) - lu(k,952) * lu(k,1505) - lu(k,1515) = lu(k,1515) - lu(k,953) * lu(k,1505) - lu(k,1516) = lu(k,1516) - lu(k,954) * lu(k,1505) - lu(k,1517) = lu(k,1517) - lu(k,955) * lu(k,1505) - lu(k,1518) = lu(k,1518) - lu(k,956) * lu(k,1505) - lu(k,1519) = lu(k,1519) - lu(k,957) * lu(k,1505) - lu(k,1520) = lu(k,1520) - lu(k,958) * lu(k,1505) - lu(k,1521) = lu(k,1521) - lu(k,959) * lu(k,1505) - lu(k,1522) = lu(k,1522) - lu(k,960) * lu(k,1505) - lu(k,1523) = lu(k,1523) - lu(k,961) * lu(k,1505) - lu(k,1524) = lu(k,1524) - lu(k,962) * lu(k,1505) - lu(k,1525) = lu(k,1525) - lu(k,963) * lu(k,1505) - lu(k,1526) = lu(k,1526) - lu(k,964) * lu(k,1505) - lu(k,1548) = lu(k,1548) - lu(k,944) * lu(k,1547) - lu(k,1549) = lu(k,1549) - lu(k,945) * lu(k,1547) - lu(k,1550) = lu(k,1550) - lu(k,946) * lu(k,1547) - lu(k,1551) = lu(k,1551) - lu(k,947) * lu(k,1547) - lu(k,1552) = lu(k,1552) - lu(k,948) * lu(k,1547) - lu(k,1553) = lu(k,1553) - lu(k,949) * lu(k,1547) - lu(k,1554) = lu(k,1554) - lu(k,950) * lu(k,1547) - lu(k,1555) = lu(k,1555) - lu(k,951) * lu(k,1547) - lu(k,1556) = lu(k,1556) - lu(k,952) * lu(k,1547) - lu(k,1557) = lu(k,1557) - lu(k,953) * lu(k,1547) - lu(k,1558) = lu(k,1558) - lu(k,954) * lu(k,1547) - lu(k,1559) = lu(k,1559) - lu(k,955) * lu(k,1547) - lu(k,1560) = lu(k,1560) - lu(k,956) * lu(k,1547) - lu(k,1561) = lu(k,1561) - lu(k,957) * lu(k,1547) - lu(k,1562) = lu(k,1562) - lu(k,958) * lu(k,1547) - lu(k,1563) = lu(k,1563) - lu(k,959) * lu(k,1547) - lu(k,1564) = lu(k,1564) - lu(k,960) * lu(k,1547) - lu(k,1565) = lu(k,1565) - lu(k,961) * lu(k,1547) - lu(k,1566) = lu(k,1566) - lu(k,962) * lu(k,1547) - lu(k,1567) = lu(k,1567) - lu(k,963) * lu(k,1547) - lu(k,1568) = lu(k,1568) - lu(k,964) * lu(k,1547) - lu(k,1590) = lu(k,1590) - lu(k,944) * lu(k,1589) - lu(k,1591) = lu(k,1591) - lu(k,945) * lu(k,1589) - lu(k,1592) = lu(k,1592) - lu(k,946) * lu(k,1589) - lu(k,1593) = lu(k,1593) - lu(k,947) * lu(k,1589) - lu(k,1594) = lu(k,1594) - lu(k,948) * lu(k,1589) - lu(k,1595) = lu(k,1595) - lu(k,949) * lu(k,1589) - lu(k,1596) = lu(k,1596) - lu(k,950) * lu(k,1589) - lu(k,1597) = lu(k,1597) - lu(k,951) * lu(k,1589) - lu(k,1598) = lu(k,1598) - lu(k,952) * lu(k,1589) - lu(k,1599) = lu(k,1599) - lu(k,953) * lu(k,1589) - lu(k,1600) = lu(k,1600) - lu(k,954) * lu(k,1589) - lu(k,1601) = lu(k,1601) - lu(k,955) * lu(k,1589) - lu(k,1602) = lu(k,1602) - lu(k,956) * lu(k,1589) - lu(k,1603) = lu(k,1603) - lu(k,957) * lu(k,1589) - lu(k,1604) = lu(k,1604) - lu(k,958) * lu(k,1589) - lu(k,1605) = lu(k,1605) - lu(k,959) * lu(k,1589) - lu(k,1606) = lu(k,1606) - lu(k,960) * lu(k,1589) - lu(k,1607) = lu(k,1607) - lu(k,961) * lu(k,1589) - lu(k,1608) = lu(k,1608) - lu(k,962) * lu(k,1589) - lu(k,1609) = lu(k,1609) - lu(k,963) * lu(k,1589) - lu(k,1610) = lu(k,1610) - lu(k,964) * lu(k,1589) - lu(k,1622) = lu(k,1622) - lu(k,944) * lu(k,1621) - lu(k,1623) = lu(k,1623) - lu(k,945) * lu(k,1621) - lu(k,1624) = lu(k,1624) - lu(k,946) * lu(k,1621) - lu(k,1625) = lu(k,1625) - lu(k,947) * lu(k,1621) - lu(k,1626) = lu(k,1626) - lu(k,948) * lu(k,1621) - lu(k,1627) = lu(k,1627) - lu(k,949) * lu(k,1621) - lu(k,1628) = lu(k,1628) - lu(k,950) * lu(k,1621) - lu(k,1629) = lu(k,1629) - lu(k,951) * lu(k,1621) - lu(k,1630) = lu(k,1630) - lu(k,952) * lu(k,1621) - lu(k,1631) = lu(k,1631) - lu(k,953) * lu(k,1621) - lu(k,1632) = lu(k,1632) - lu(k,954) * lu(k,1621) - lu(k,1633) = lu(k,1633) - lu(k,955) * lu(k,1621) - lu(k,1634) = lu(k,1634) - lu(k,956) * lu(k,1621) - lu(k,1635) = lu(k,1635) - lu(k,957) * lu(k,1621) - lu(k,1636) = lu(k,1636) - lu(k,958) * lu(k,1621) - lu(k,1637) = lu(k,1637) - lu(k,959) * lu(k,1621) - lu(k,1638) = lu(k,1638) - lu(k,960) * lu(k,1621) - lu(k,1639) = lu(k,1639) - lu(k,961) * lu(k,1621) - lu(k,1640) = lu(k,1640) - lu(k,962) * lu(k,1621) - lu(k,1641) = lu(k,1641) - lu(k,963) * lu(k,1621) - lu(k,1642) = lu(k,1642) - lu(k,964) * lu(k,1621) - lu(k,1657) = lu(k,1657) - lu(k,944) * lu(k,1656) - lu(k,1658) = lu(k,1658) - lu(k,945) * lu(k,1656) - lu(k,1659) = lu(k,1659) - lu(k,946) * lu(k,1656) - lu(k,1660) = lu(k,1660) - lu(k,947) * lu(k,1656) - lu(k,1661) = lu(k,1661) - lu(k,948) * lu(k,1656) - lu(k,1662) = lu(k,1662) - lu(k,949) * lu(k,1656) - lu(k,1663) = lu(k,1663) - lu(k,950) * lu(k,1656) - lu(k,1664) = lu(k,1664) - lu(k,951) * lu(k,1656) - lu(k,1665) = lu(k,1665) - lu(k,952) * lu(k,1656) - lu(k,1666) = lu(k,1666) - lu(k,953) * lu(k,1656) - lu(k,1667) = lu(k,1667) - lu(k,954) * lu(k,1656) - lu(k,1668) = lu(k,1668) - lu(k,955) * lu(k,1656) - lu(k,1669) = lu(k,1669) - lu(k,956) * lu(k,1656) - lu(k,1670) = lu(k,1670) - lu(k,957) * lu(k,1656) - lu(k,1671) = lu(k,1671) - lu(k,958) * lu(k,1656) - lu(k,1672) = lu(k,1672) - lu(k,959) * lu(k,1656) - lu(k,1673) = lu(k,1673) - lu(k,960) * lu(k,1656) - lu(k,1674) = lu(k,1674) - lu(k,961) * lu(k,1656) - lu(k,1675) = lu(k,1675) - lu(k,962) * lu(k,1656) - lu(k,1676) = lu(k,1676) - lu(k,963) * lu(k,1656) - lu(k,1677) = lu(k,1677) - lu(k,964) * lu(k,1656) - lu(k,1699) = lu(k,1699) - lu(k,944) * lu(k,1698) - lu(k,1700) = lu(k,1700) - lu(k,945) * lu(k,1698) - lu(k,1701) = lu(k,1701) - lu(k,946) * lu(k,1698) - lu(k,1702) = lu(k,1702) - lu(k,947) * lu(k,1698) - lu(k,1703) = lu(k,1703) - lu(k,948) * lu(k,1698) - lu(k,1704) = lu(k,1704) - lu(k,949) * lu(k,1698) - lu(k,1705) = lu(k,1705) - lu(k,950) * lu(k,1698) - lu(k,1706) = lu(k,1706) - lu(k,951) * lu(k,1698) - lu(k,1707) = lu(k,1707) - lu(k,952) * lu(k,1698) - lu(k,1708) = lu(k,1708) - lu(k,953) * lu(k,1698) - lu(k,1709) = lu(k,1709) - lu(k,954) * lu(k,1698) - lu(k,1710) = lu(k,1710) - lu(k,955) * lu(k,1698) - lu(k,1711) = lu(k,1711) - lu(k,956) * lu(k,1698) - lu(k,1712) = lu(k,1712) - lu(k,957) * lu(k,1698) - lu(k,1713) = lu(k,1713) - lu(k,958) * lu(k,1698) - lu(k,1714) = lu(k,1714) - lu(k,959) * lu(k,1698) - lu(k,1715) = lu(k,1715) - lu(k,960) * lu(k,1698) - lu(k,1716) = lu(k,1716) - lu(k,961) * lu(k,1698) - lu(k,1717) = lu(k,1717) - lu(k,962) * lu(k,1698) - lu(k,1718) = lu(k,1718) - lu(k,963) * lu(k,1698) - lu(k,1719) = lu(k,1719) - lu(k,964) * lu(k,1698) - lu(k,1743) = lu(k,1743) - lu(k,944) * lu(k,1742) - lu(k,1744) = lu(k,1744) - lu(k,945) * lu(k,1742) - lu(k,1745) = lu(k,1745) - lu(k,946) * lu(k,1742) - lu(k,1746) = lu(k,1746) - lu(k,947) * lu(k,1742) - lu(k,1747) = lu(k,1747) - lu(k,948) * lu(k,1742) - lu(k,1748) = lu(k,1748) - lu(k,949) * lu(k,1742) - lu(k,1749) = lu(k,1749) - lu(k,950) * lu(k,1742) - lu(k,1750) = lu(k,1750) - lu(k,951) * lu(k,1742) - lu(k,1751) = lu(k,1751) - lu(k,952) * lu(k,1742) - lu(k,1752) = lu(k,1752) - lu(k,953) * lu(k,1742) - lu(k,1753) = lu(k,1753) - lu(k,954) * lu(k,1742) - lu(k,1754) = lu(k,1754) - lu(k,955) * lu(k,1742) - lu(k,1755) = lu(k,1755) - lu(k,956) * lu(k,1742) - lu(k,1756) = lu(k,1756) - lu(k,957) * lu(k,1742) - lu(k,1757) = lu(k,1757) - lu(k,958) * lu(k,1742) - lu(k,1758) = lu(k,1758) - lu(k,959) * lu(k,1742) - lu(k,1759) = lu(k,1759) - lu(k,960) * lu(k,1742) - lu(k,1760) = lu(k,1760) - lu(k,961) * lu(k,1742) - lu(k,1761) = lu(k,1761) - lu(k,962) * lu(k,1742) - lu(k,1762) = lu(k,1762) - lu(k,963) * lu(k,1742) - lu(k,1763) = lu(k,1763) - lu(k,964) * lu(k,1742) - lu(k,1778) = lu(k,1778) - lu(k,944) * lu(k,1777) - lu(k,1779) = lu(k,1779) - lu(k,945) * lu(k,1777) - lu(k,1780) = lu(k,1780) - lu(k,946) * lu(k,1777) - lu(k,1781) = lu(k,1781) - lu(k,947) * lu(k,1777) - lu(k,1782) = lu(k,1782) - lu(k,948) * lu(k,1777) - lu(k,1783) = lu(k,1783) - lu(k,949) * lu(k,1777) - lu(k,1784) = lu(k,1784) - lu(k,950) * lu(k,1777) - lu(k,1785) = lu(k,1785) - lu(k,951) * lu(k,1777) - lu(k,1786) = lu(k,1786) - lu(k,952) * lu(k,1777) - lu(k,1787) = lu(k,1787) - lu(k,953) * lu(k,1777) - lu(k,1788) = lu(k,1788) - lu(k,954) * lu(k,1777) - lu(k,1789) = lu(k,1789) - lu(k,955) * lu(k,1777) - lu(k,1790) = lu(k,1790) - lu(k,956) * lu(k,1777) - lu(k,1791) = lu(k,1791) - lu(k,957) * lu(k,1777) - lu(k,1792) = lu(k,1792) - lu(k,958) * lu(k,1777) - lu(k,1793) = lu(k,1793) - lu(k,959) * lu(k,1777) - lu(k,1794) = lu(k,1794) - lu(k,960) * lu(k,1777) - lu(k,1795) = lu(k,1795) - lu(k,961) * lu(k,1777) - lu(k,1796) = lu(k,1796) - lu(k,962) * lu(k,1777) - lu(k,1797) = lu(k,1797) - lu(k,963) * lu(k,1777) - lu(k,1798) = lu(k,1798) - lu(k,964) * lu(k,1777) - lu(k,1836) = lu(k,1836) - lu(k,944) * lu(k,1835) - lu(k,1837) = lu(k,1837) - lu(k,945) * lu(k,1835) - lu(k,1838) = lu(k,1838) - lu(k,946) * lu(k,1835) - lu(k,1839) = lu(k,1839) - lu(k,947) * lu(k,1835) - lu(k,1840) = lu(k,1840) - lu(k,948) * lu(k,1835) - lu(k,1841) = lu(k,1841) - lu(k,949) * lu(k,1835) - lu(k,1842) = lu(k,1842) - lu(k,950) * lu(k,1835) - lu(k,1843) = lu(k,1843) - lu(k,951) * lu(k,1835) - lu(k,1844) = lu(k,1844) - lu(k,952) * lu(k,1835) - lu(k,1845) = lu(k,1845) - lu(k,953) * lu(k,1835) - lu(k,1846) = lu(k,1846) - lu(k,954) * lu(k,1835) - lu(k,1847) = lu(k,1847) - lu(k,955) * lu(k,1835) - lu(k,1848) = lu(k,1848) - lu(k,956) * lu(k,1835) - lu(k,1849) = lu(k,1849) - lu(k,957) * lu(k,1835) - lu(k,1850) = lu(k,1850) - lu(k,958) * lu(k,1835) - lu(k,1851) = lu(k,1851) - lu(k,959) * lu(k,1835) - lu(k,1852) = lu(k,1852) - lu(k,960) * lu(k,1835) - lu(k,1853) = lu(k,1853) - lu(k,961) * lu(k,1835) - lu(k,1854) = lu(k,1854) - lu(k,962) * lu(k,1835) - lu(k,1855) = lu(k,1855) - lu(k,963) * lu(k,1835) - lu(k,1856) = lu(k,1856) - lu(k,964) * lu(k,1835) + lu(k,808) = 1._r8 / lu(k,808) + lu(k,809) = lu(k,809) * lu(k,808) + lu(k,810) = lu(k,810) * lu(k,808) + lu(k,811) = lu(k,811) * lu(k,808) + lu(k,812) = lu(k,812) * lu(k,808) + lu(k,813) = lu(k,813) * lu(k,808) + lu(k,814) = lu(k,814) * lu(k,808) + lu(k,815) = lu(k,815) * lu(k,808) + lu(k,816) = lu(k,816) * lu(k,808) + lu(k,817) = lu(k,817) * lu(k,808) + lu(k,818) = lu(k,818) * lu(k,808) + lu(k,819) = lu(k,819) * lu(k,808) + lu(k,820) = lu(k,820) * lu(k,808) + lu(k,821) = lu(k,821) * lu(k,808) + lu(k,822) = lu(k,822) * lu(k,808) + lu(k,823) = lu(k,823) * lu(k,808) + lu(k,824) = lu(k,824) * lu(k,808) + lu(k,825) = lu(k,825) * lu(k,808) + lu(k,826) = lu(k,826) * lu(k,808) + lu(k,831) = lu(k,831) - lu(k,809) * lu(k,829) + lu(k,833) = lu(k,833) - lu(k,810) * lu(k,829) + lu(k,836) = lu(k,836) - lu(k,811) * lu(k,829) + lu(k,837) = lu(k,837) - lu(k,812) * lu(k,829) + lu(k,838) = lu(k,838) - lu(k,813) * lu(k,829) + lu(k,839) = - lu(k,814) * lu(k,829) + lu(k,841) = lu(k,841) - lu(k,815) * lu(k,829) + lu(k,842) = lu(k,842) - lu(k,816) * lu(k,829) + lu(k,843) = lu(k,843) - lu(k,817) * lu(k,829) + lu(k,844) = lu(k,844) - lu(k,818) * lu(k,829) + lu(k,845) = lu(k,845) - lu(k,819) * lu(k,829) + lu(k,847) = lu(k,847) - lu(k,820) * lu(k,829) + lu(k,848) = lu(k,848) - lu(k,821) * lu(k,829) + lu(k,849) = lu(k,849) - lu(k,822) * lu(k,829) + lu(k,850) = lu(k,850) - lu(k,823) * lu(k,829) + lu(k,852) = lu(k,852) - lu(k,824) * lu(k,829) + lu(k,857) = lu(k,857) - lu(k,825) * lu(k,829) + lu(k,858) = lu(k,858) - lu(k,826) * lu(k,829) + lu(k,863) = lu(k,863) - lu(k,809) * lu(k,862) + lu(k,864) = lu(k,864) - lu(k,810) * lu(k,862) + lu(k,865) = lu(k,865) - lu(k,811) * lu(k,862) + lu(k,867) = lu(k,867) - lu(k,812) * lu(k,862) + lu(k,868) = lu(k,868) - lu(k,813) * lu(k,862) + lu(k,869) = lu(k,869) - lu(k,814) * lu(k,862) + lu(k,871) = lu(k,871) - lu(k,815) * lu(k,862) + lu(k,872) = lu(k,872) - lu(k,816) * lu(k,862) + lu(k,873) = lu(k,873) - lu(k,817) * lu(k,862) + lu(k,874) = lu(k,874) - lu(k,818) * lu(k,862) + lu(k,875) = lu(k,875) - lu(k,819) * lu(k,862) + lu(k,876) = lu(k,876) - lu(k,820) * lu(k,862) + lu(k,877) = lu(k,877) - lu(k,821) * lu(k,862) + lu(k,878) = lu(k,878) - lu(k,822) * lu(k,862) + lu(k,879) = lu(k,879) - lu(k,823) * lu(k,862) + lu(k,880) = lu(k,880) - lu(k,824) * lu(k,862) + lu(k,882) = - lu(k,825) * lu(k,862) + lu(k,883) = lu(k,883) - lu(k,826) * lu(k,862) + lu(k,922) = lu(k,922) - lu(k,809) * lu(k,921) + lu(k,923) = lu(k,923) - lu(k,810) * lu(k,921) + lu(k,925) = lu(k,925) - lu(k,811) * lu(k,921) + lu(k,927) = lu(k,927) - lu(k,812) * lu(k,921) + lu(k,928) = lu(k,928) - lu(k,813) * lu(k,921) + lu(k,929) = lu(k,929) - lu(k,814) * lu(k,921) + lu(k,931) = lu(k,931) - lu(k,815) * lu(k,921) + lu(k,932) = lu(k,932) - lu(k,816) * lu(k,921) + lu(k,933) = lu(k,933) - lu(k,817) * lu(k,921) + lu(k,934) = lu(k,934) - lu(k,818) * lu(k,921) + lu(k,935) = lu(k,935) - lu(k,819) * lu(k,921) + lu(k,936) = lu(k,936) - lu(k,820) * lu(k,921) + lu(k,937) = lu(k,937) - lu(k,821) * lu(k,921) + lu(k,938) = lu(k,938) - lu(k,822) * lu(k,921) + lu(k,939) = lu(k,939) - lu(k,823) * lu(k,921) + lu(k,941) = lu(k,941) - lu(k,824) * lu(k,921) + lu(k,944) = lu(k,944) - lu(k,825) * lu(k,921) + lu(k,945) = lu(k,945) - lu(k,826) * lu(k,921) + lu(k,1008) = lu(k,1008) - lu(k,809) * lu(k,1007) + lu(k,1009) = lu(k,1009) - lu(k,810) * lu(k,1007) + lu(k,1012) = lu(k,1012) - lu(k,811) * lu(k,1007) + lu(k,1014) = lu(k,1014) - lu(k,812) * lu(k,1007) + lu(k,1015) = lu(k,1015) - lu(k,813) * lu(k,1007) + lu(k,1016) = lu(k,1016) - lu(k,814) * lu(k,1007) + lu(k,1018) = lu(k,1018) - lu(k,815) * lu(k,1007) + lu(k,1019) = lu(k,1019) - lu(k,816) * lu(k,1007) + lu(k,1020) = lu(k,1020) - lu(k,817) * lu(k,1007) + lu(k,1021) = lu(k,1021) - lu(k,818) * lu(k,1007) + lu(k,1022) = - lu(k,819) * lu(k,1007) + lu(k,1024) = lu(k,1024) - lu(k,820) * lu(k,1007) + lu(k,1025) = lu(k,1025) - lu(k,821) * lu(k,1007) + lu(k,1026) = lu(k,1026) - lu(k,822) * lu(k,1007) + lu(k,1027) = lu(k,1027) - lu(k,823) * lu(k,1007) + lu(k,1029) = lu(k,1029) - lu(k,824) * lu(k,1007) + lu(k,1034) = lu(k,1034) - lu(k,825) * lu(k,1007) + lu(k,1035) = lu(k,1035) - lu(k,826) * lu(k,1007) + lu(k,1138) = lu(k,1138) - lu(k,809) * lu(k,1136) + lu(k,1140) = lu(k,1140) - lu(k,810) * lu(k,1136) + lu(k,1143) = lu(k,1143) - lu(k,811) * lu(k,1136) + lu(k,1145) = lu(k,1145) - lu(k,812) * lu(k,1136) + lu(k,1146) = lu(k,1146) - lu(k,813) * lu(k,1136) + lu(k,1147) = lu(k,1147) - lu(k,814) * lu(k,1136) + lu(k,1149) = lu(k,1149) - lu(k,815) * lu(k,1136) + lu(k,1150) = lu(k,1150) - lu(k,816) * lu(k,1136) + lu(k,1151) = lu(k,1151) - lu(k,817) * lu(k,1136) + lu(k,1152) = lu(k,1152) - lu(k,818) * lu(k,1136) + lu(k,1153) = lu(k,1153) - lu(k,819) * lu(k,1136) + lu(k,1155) = lu(k,1155) - lu(k,820) * lu(k,1136) + lu(k,1156) = lu(k,1156) - lu(k,821) * lu(k,1136) + lu(k,1157) = lu(k,1157) - lu(k,822) * lu(k,1136) + lu(k,1158) = lu(k,1158) - lu(k,823) * lu(k,1136) + lu(k,1160) = lu(k,1160) - lu(k,824) * lu(k,1136) + lu(k,1165) = lu(k,1165) - lu(k,825) * lu(k,1136) + lu(k,1166) = lu(k,1166) - lu(k,826) * lu(k,1136) + lu(k,1181) = lu(k,1181) - lu(k,809) * lu(k,1179) + lu(k,1183) = lu(k,1183) - lu(k,810) * lu(k,1179) + lu(k,1186) = lu(k,1186) - lu(k,811) * lu(k,1179) + lu(k,1188) = lu(k,1188) - lu(k,812) * lu(k,1179) + lu(k,1189) = lu(k,1189) - lu(k,813) * lu(k,1179) + lu(k,1190) = lu(k,1190) - lu(k,814) * lu(k,1179) + lu(k,1192) = lu(k,1192) - lu(k,815) * lu(k,1179) + lu(k,1193) = lu(k,1193) - lu(k,816) * lu(k,1179) + lu(k,1194) = lu(k,1194) - lu(k,817) * lu(k,1179) + lu(k,1195) = lu(k,1195) - lu(k,818) * lu(k,1179) + lu(k,1196) = lu(k,1196) - lu(k,819) * lu(k,1179) + lu(k,1198) = lu(k,1198) - lu(k,820) * lu(k,1179) + lu(k,1199) = lu(k,1199) - lu(k,821) * lu(k,1179) + lu(k,1200) = lu(k,1200) - lu(k,822) * lu(k,1179) + lu(k,1201) = lu(k,1201) - lu(k,823) * lu(k,1179) + lu(k,1203) = lu(k,1203) - lu(k,824) * lu(k,1179) + lu(k,1208) = lu(k,1208) - lu(k,825) * lu(k,1179) + lu(k,1209) = lu(k,1209) - lu(k,826) * lu(k,1179) + lu(k,1222) = lu(k,1222) - lu(k,809) * lu(k,1221) + lu(k,1224) = lu(k,1224) - lu(k,810) * lu(k,1221) + lu(k,1227) = lu(k,1227) - lu(k,811) * lu(k,1221) + lu(k,1229) = lu(k,1229) - lu(k,812) * lu(k,1221) + lu(k,1230) = lu(k,1230) - lu(k,813) * lu(k,1221) + lu(k,1231) = lu(k,1231) - lu(k,814) * lu(k,1221) + lu(k,1233) = lu(k,1233) - lu(k,815) * lu(k,1221) + lu(k,1234) = lu(k,1234) - lu(k,816) * lu(k,1221) + lu(k,1235) = lu(k,1235) - lu(k,817) * lu(k,1221) + lu(k,1236) = lu(k,1236) - lu(k,818) * lu(k,1221) + lu(k,1237) = lu(k,1237) - lu(k,819) * lu(k,1221) + lu(k,1239) = lu(k,1239) - lu(k,820) * lu(k,1221) + lu(k,1240) = lu(k,1240) - lu(k,821) * lu(k,1221) + lu(k,1241) = lu(k,1241) - lu(k,822) * lu(k,1221) + lu(k,1242) = lu(k,1242) - lu(k,823) * lu(k,1221) + lu(k,1244) = lu(k,1244) - lu(k,824) * lu(k,1221) + lu(k,1249) = lu(k,1249) - lu(k,825) * lu(k,1221) + lu(k,1250) = lu(k,1250) - lu(k,826) * lu(k,1221) + lu(k,1282) = lu(k,1282) - lu(k,809) * lu(k,1280) + lu(k,1284) = lu(k,1284) - lu(k,810) * lu(k,1280) + lu(k,1287) = lu(k,1287) - lu(k,811) * lu(k,1280) + lu(k,1289) = lu(k,1289) - lu(k,812) * lu(k,1280) + lu(k,1290) = - lu(k,813) * lu(k,1280) + lu(k,1291) = lu(k,1291) - lu(k,814) * lu(k,1280) + lu(k,1293) = - lu(k,815) * lu(k,1280) + lu(k,1294) = lu(k,1294) - lu(k,816) * lu(k,1280) + lu(k,1295) = - lu(k,817) * lu(k,1280) + lu(k,1296) = lu(k,1296) - lu(k,818) * lu(k,1280) + lu(k,1297) = lu(k,1297) - lu(k,819) * lu(k,1280) + lu(k,1299) = lu(k,1299) - lu(k,820) * lu(k,1280) + lu(k,1300) = lu(k,1300) - lu(k,821) * lu(k,1280) + lu(k,1301) = - lu(k,822) * lu(k,1280) + lu(k,1302) = lu(k,1302) - lu(k,823) * lu(k,1280) + lu(k,1304) = lu(k,1304) - lu(k,824) * lu(k,1280) + lu(k,1309) = lu(k,1309) - lu(k,825) * lu(k,1280) + lu(k,1310) = lu(k,1310) - lu(k,826) * lu(k,1280) + lu(k,1324) = lu(k,1324) - lu(k,809) * lu(k,1322) + lu(k,1326) = lu(k,1326) - lu(k,810) * lu(k,1322) + lu(k,1329) = lu(k,1329) - lu(k,811) * lu(k,1322) + lu(k,1331) = lu(k,1331) - lu(k,812) * lu(k,1322) + lu(k,1332) = lu(k,1332) - lu(k,813) * lu(k,1322) + lu(k,1333) = lu(k,1333) - lu(k,814) * lu(k,1322) + lu(k,1335) = lu(k,1335) - lu(k,815) * lu(k,1322) + lu(k,1336) = lu(k,1336) - lu(k,816) * lu(k,1322) + lu(k,1337) = lu(k,1337) - lu(k,817) * lu(k,1322) + lu(k,1338) = lu(k,1338) - lu(k,818) * lu(k,1322) + lu(k,1339) = lu(k,1339) - lu(k,819) * lu(k,1322) + lu(k,1341) = lu(k,1341) - lu(k,820) * lu(k,1322) + lu(k,1342) = lu(k,1342) - lu(k,821) * lu(k,1322) + lu(k,1343) = lu(k,1343) - lu(k,822) * lu(k,1322) + lu(k,1344) = lu(k,1344) - lu(k,823) * lu(k,1322) + lu(k,1346) = lu(k,1346) - lu(k,824) * lu(k,1322) + lu(k,1351) = lu(k,1351) - lu(k,825) * lu(k,1322) + lu(k,1352) = lu(k,1352) - lu(k,826) * lu(k,1322) + lu(k,1360) = lu(k,1360) - lu(k,809) * lu(k,1358) + lu(k,1362) = lu(k,1362) - lu(k,810) * lu(k,1358) + lu(k,1365) = lu(k,1365) - lu(k,811) * lu(k,1358) + lu(k,1367) = - lu(k,812) * lu(k,1358) + lu(k,1368) = - lu(k,813) * lu(k,1358) + lu(k,1369) = lu(k,1369) - lu(k,814) * lu(k,1358) + lu(k,1371) = lu(k,1371) - lu(k,815) * lu(k,1358) + lu(k,1372) = lu(k,1372) - lu(k,816) * lu(k,1358) + lu(k,1373) = - lu(k,817) * lu(k,1358) + lu(k,1374) = lu(k,1374) - lu(k,818) * lu(k,1358) + lu(k,1375) = lu(k,1375) - lu(k,819) * lu(k,1358) + lu(k,1377) = lu(k,1377) - lu(k,820) * lu(k,1358) + lu(k,1378) = lu(k,1378) - lu(k,821) * lu(k,1358) + lu(k,1379) = - lu(k,822) * lu(k,1358) + lu(k,1380) = lu(k,1380) - lu(k,823) * lu(k,1358) + lu(k,1382) = lu(k,1382) - lu(k,824) * lu(k,1358) + lu(k,1387) = lu(k,1387) - lu(k,825) * lu(k,1358) + lu(k,1388) = lu(k,1388) - lu(k,826) * lu(k,1358) + lu(k,1403) = lu(k,1403) - lu(k,809) * lu(k,1401) + lu(k,1405) = lu(k,1405) - lu(k,810) * lu(k,1401) + lu(k,1408) = lu(k,1408) - lu(k,811) * lu(k,1401) + lu(k,1410) = lu(k,1410) - lu(k,812) * lu(k,1401) + lu(k,1411) = lu(k,1411) - lu(k,813) * lu(k,1401) + lu(k,1412) = lu(k,1412) - lu(k,814) * lu(k,1401) + lu(k,1414) = lu(k,1414) - lu(k,815) * lu(k,1401) + lu(k,1415) = lu(k,1415) - lu(k,816) * lu(k,1401) + lu(k,1416) = lu(k,1416) - lu(k,817) * lu(k,1401) + lu(k,1417) = lu(k,1417) - lu(k,818) * lu(k,1401) + lu(k,1418) = lu(k,1418) - lu(k,819) * lu(k,1401) + lu(k,1420) = lu(k,1420) - lu(k,820) * lu(k,1401) + lu(k,1421) = lu(k,1421) - lu(k,821) * lu(k,1401) + lu(k,1422) = lu(k,1422) - lu(k,822) * lu(k,1401) + lu(k,1423) = lu(k,1423) - lu(k,823) * lu(k,1401) + lu(k,1425) = lu(k,1425) - lu(k,824) * lu(k,1401) + lu(k,1430) = lu(k,1430) - lu(k,825) * lu(k,1401) + lu(k,1431) = lu(k,1431) - lu(k,826) * lu(k,1401) + lu(k,1446) = lu(k,1446) - lu(k,809) * lu(k,1444) + lu(k,1448) = lu(k,1448) - lu(k,810) * lu(k,1444) + lu(k,1451) = lu(k,1451) - lu(k,811) * lu(k,1444) + lu(k,1453) = lu(k,1453) - lu(k,812) * lu(k,1444) + lu(k,1454) = lu(k,1454) - lu(k,813) * lu(k,1444) + lu(k,1455) = lu(k,1455) - lu(k,814) * lu(k,1444) + lu(k,1457) = lu(k,1457) - lu(k,815) * lu(k,1444) + lu(k,1458) = lu(k,1458) - lu(k,816) * lu(k,1444) + lu(k,1459) = lu(k,1459) - lu(k,817) * lu(k,1444) + lu(k,1460) = lu(k,1460) - lu(k,818) * lu(k,1444) + lu(k,1461) = lu(k,1461) - lu(k,819) * lu(k,1444) + lu(k,1463) = lu(k,1463) - lu(k,820) * lu(k,1444) + lu(k,1464) = lu(k,1464) - lu(k,821) * lu(k,1444) + lu(k,1465) = lu(k,1465) - lu(k,822) * lu(k,1444) + lu(k,1466) = lu(k,1466) - lu(k,823) * lu(k,1444) + lu(k,1468) = lu(k,1468) - lu(k,824) * lu(k,1444) + lu(k,1473) = lu(k,1473) - lu(k,825) * lu(k,1444) + lu(k,1474) = lu(k,1474) - lu(k,826) * lu(k,1444) + lu(k,1491) = lu(k,1491) - lu(k,809) * lu(k,1489) + lu(k,1493) = lu(k,1493) - lu(k,810) * lu(k,1489) + lu(k,1496) = lu(k,1496) - lu(k,811) * lu(k,1489) + lu(k,1498) = lu(k,1498) - lu(k,812) * lu(k,1489) + lu(k,1499) = lu(k,1499) - lu(k,813) * lu(k,1489) + lu(k,1500) = lu(k,1500) - lu(k,814) * lu(k,1489) + lu(k,1502) = lu(k,1502) - lu(k,815) * lu(k,1489) + lu(k,1503) = lu(k,1503) - lu(k,816) * lu(k,1489) + lu(k,1504) = lu(k,1504) - lu(k,817) * lu(k,1489) + lu(k,1505) = lu(k,1505) - lu(k,818) * lu(k,1489) + lu(k,1506) = lu(k,1506) - lu(k,819) * lu(k,1489) + lu(k,1508) = lu(k,1508) - lu(k,820) * lu(k,1489) + lu(k,1509) = lu(k,1509) - lu(k,821) * lu(k,1489) + lu(k,1510) = lu(k,1510) - lu(k,822) * lu(k,1489) + lu(k,1511) = lu(k,1511) - lu(k,823) * lu(k,1489) + lu(k,1513) = lu(k,1513) - lu(k,824) * lu(k,1489) + lu(k,1518) = lu(k,1518) - lu(k,825) * lu(k,1489) + lu(k,1519) = lu(k,1519) - lu(k,826) * lu(k,1489) + lu(k,1527) = lu(k,1527) - lu(k,809) * lu(k,1525) + lu(k,1529) = lu(k,1529) - lu(k,810) * lu(k,1525) + lu(k,1532) = lu(k,1532) - lu(k,811) * lu(k,1525) + lu(k,1534) = lu(k,1534) - lu(k,812) * lu(k,1525) + lu(k,1535) = lu(k,1535) - lu(k,813) * lu(k,1525) + lu(k,1536) = lu(k,1536) - lu(k,814) * lu(k,1525) + lu(k,1538) = lu(k,1538) - lu(k,815) * lu(k,1525) + lu(k,1539) = lu(k,1539) - lu(k,816) * lu(k,1525) + lu(k,1540) = lu(k,1540) - lu(k,817) * lu(k,1525) + lu(k,1541) = lu(k,1541) - lu(k,818) * lu(k,1525) + lu(k,1542) = lu(k,1542) - lu(k,819) * lu(k,1525) + lu(k,1544) = lu(k,1544) - lu(k,820) * lu(k,1525) + lu(k,1545) = lu(k,1545) - lu(k,821) * lu(k,1525) + lu(k,1546) = lu(k,1546) - lu(k,822) * lu(k,1525) + lu(k,1547) = lu(k,1547) - lu(k,823) * lu(k,1525) + lu(k,1549) = lu(k,1549) - lu(k,824) * lu(k,1525) + lu(k,1554) = lu(k,1554) - lu(k,825) * lu(k,1525) + lu(k,1555) = lu(k,1555) - lu(k,826) * lu(k,1525) + lu(k,1572) = lu(k,1572) - lu(k,809) * lu(k,1570) + lu(k,1574) = lu(k,1574) - lu(k,810) * lu(k,1570) + lu(k,1577) = lu(k,1577) - lu(k,811) * lu(k,1570) + lu(k,1579) = lu(k,1579) - lu(k,812) * lu(k,1570) + lu(k,1580) = lu(k,1580) - lu(k,813) * lu(k,1570) + lu(k,1581) = lu(k,1581) - lu(k,814) * lu(k,1570) + lu(k,1583) = lu(k,1583) - lu(k,815) * lu(k,1570) + lu(k,1584) = lu(k,1584) - lu(k,816) * lu(k,1570) + lu(k,1585) = lu(k,1585) - lu(k,817) * lu(k,1570) + lu(k,1586) = lu(k,1586) - lu(k,818) * lu(k,1570) + lu(k,1587) = lu(k,1587) - lu(k,819) * lu(k,1570) + lu(k,1589) = lu(k,1589) - lu(k,820) * lu(k,1570) + lu(k,1590) = lu(k,1590) - lu(k,821) * lu(k,1570) + lu(k,1591) = lu(k,1591) - lu(k,822) * lu(k,1570) + lu(k,1592) = lu(k,1592) - lu(k,823) * lu(k,1570) + lu(k,1594) = lu(k,1594) - lu(k,824) * lu(k,1570) + lu(k,1599) = lu(k,1599) - lu(k,825) * lu(k,1570) + lu(k,1600) = lu(k,1600) - lu(k,826) * lu(k,1570) + lu(k,1620) = lu(k,1620) - lu(k,809) * lu(k,1619) + lu(k,1622) = lu(k,1622) - lu(k,810) * lu(k,1619) + lu(k,1625) = lu(k,1625) - lu(k,811) * lu(k,1619) + lu(k,1627) = lu(k,1627) - lu(k,812) * lu(k,1619) + lu(k,1628) = lu(k,1628) - lu(k,813) * lu(k,1619) + lu(k,1629) = lu(k,1629) - lu(k,814) * lu(k,1619) + lu(k,1631) = lu(k,1631) - lu(k,815) * lu(k,1619) + lu(k,1632) = lu(k,1632) - lu(k,816) * lu(k,1619) + lu(k,1633) = lu(k,1633) - lu(k,817) * lu(k,1619) + lu(k,1634) = lu(k,1634) - lu(k,818) * lu(k,1619) + lu(k,1635) = lu(k,1635) - lu(k,819) * lu(k,1619) + lu(k,1637) = lu(k,1637) - lu(k,820) * lu(k,1619) + lu(k,1638) = lu(k,1638) - lu(k,821) * lu(k,1619) + lu(k,1639) = lu(k,1639) - lu(k,822) * lu(k,1619) + lu(k,1640) = lu(k,1640) - lu(k,823) * lu(k,1619) + lu(k,1642) = lu(k,1642) - lu(k,824) * lu(k,1619) + lu(k,1647) = lu(k,1647) - lu(k,825) * lu(k,1619) + lu(k,1648) = lu(k,1648) - lu(k,826) * lu(k,1619) + lu(k,1663) = lu(k,1663) - lu(k,809) * lu(k,1661) + lu(k,1665) = lu(k,1665) - lu(k,810) * lu(k,1661) + lu(k,1668) = lu(k,1668) - lu(k,811) * lu(k,1661) + lu(k,1670) = lu(k,1670) - lu(k,812) * lu(k,1661) + lu(k,1671) = lu(k,1671) - lu(k,813) * lu(k,1661) + lu(k,1672) = lu(k,1672) - lu(k,814) * lu(k,1661) + lu(k,1674) = lu(k,1674) - lu(k,815) * lu(k,1661) + lu(k,1675) = lu(k,1675) - lu(k,816) * lu(k,1661) + lu(k,1676) = lu(k,1676) - lu(k,817) * lu(k,1661) + lu(k,1677) = lu(k,1677) - lu(k,818) * lu(k,1661) + lu(k,1678) = lu(k,1678) - lu(k,819) * lu(k,1661) + lu(k,1680) = lu(k,1680) - lu(k,820) * lu(k,1661) + lu(k,1681) = lu(k,1681) - lu(k,821) * lu(k,1661) + lu(k,1682) = lu(k,1682) - lu(k,822) * lu(k,1661) + lu(k,1683) = lu(k,1683) - lu(k,823) * lu(k,1661) + lu(k,1685) = lu(k,1685) - lu(k,824) * lu(k,1661) + lu(k,1690) = lu(k,1690) - lu(k,825) * lu(k,1661) + lu(k,1691) = lu(k,1691) - lu(k,826) * lu(k,1661) + lu(k,1705) = lu(k,1705) - lu(k,809) * lu(k,1704) + lu(k,1707) = lu(k,1707) - lu(k,810) * lu(k,1704) + lu(k,1710) = lu(k,1710) - lu(k,811) * lu(k,1704) + lu(k,1712) = lu(k,1712) - lu(k,812) * lu(k,1704) + lu(k,1713) = lu(k,1713) - lu(k,813) * lu(k,1704) + lu(k,1714) = lu(k,1714) - lu(k,814) * lu(k,1704) + lu(k,1716) = lu(k,1716) - lu(k,815) * lu(k,1704) + lu(k,1717) = lu(k,1717) - lu(k,816) * lu(k,1704) + lu(k,1718) = lu(k,1718) - lu(k,817) * lu(k,1704) + lu(k,1719) = lu(k,1719) - lu(k,818) * lu(k,1704) + lu(k,1720) = lu(k,1720) - lu(k,819) * lu(k,1704) + lu(k,1722) = lu(k,1722) - lu(k,820) * lu(k,1704) + lu(k,1723) = lu(k,1723) - lu(k,821) * lu(k,1704) + lu(k,1724) = lu(k,1724) - lu(k,822) * lu(k,1704) + lu(k,1725) = lu(k,1725) - lu(k,823) * lu(k,1704) + lu(k,1727) = lu(k,1727) - lu(k,824) * lu(k,1704) + lu(k,1732) = lu(k,1732) - lu(k,825) * lu(k,1704) + lu(k,1733) = lu(k,1733) - lu(k,826) * lu(k,1704) + lu(k,1750) = - lu(k,809) * lu(k,1748) + lu(k,1752) = lu(k,1752) - lu(k,810) * lu(k,1748) + lu(k,1755) = lu(k,1755) - lu(k,811) * lu(k,1748) + lu(k,1757) = - lu(k,812) * lu(k,1748) + lu(k,1758) = - lu(k,813) * lu(k,1748) + lu(k,1759) = lu(k,1759) - lu(k,814) * lu(k,1748) + lu(k,1761) = - lu(k,815) * lu(k,1748) + lu(k,1762) = lu(k,1762) - lu(k,816) * lu(k,1748) + lu(k,1763) = - lu(k,817) * lu(k,1748) + lu(k,1764) = lu(k,1764) - lu(k,818) * lu(k,1748) + lu(k,1765) = lu(k,1765) - lu(k,819) * lu(k,1748) + lu(k,1767) = lu(k,1767) - lu(k,820) * lu(k,1748) + lu(k,1768) = lu(k,1768) - lu(k,821) * lu(k,1748) + lu(k,1769) = - lu(k,822) * lu(k,1748) + lu(k,1770) = lu(k,1770) - lu(k,823) * lu(k,1748) + lu(k,1772) = lu(k,1772) - lu(k,824) * lu(k,1748) + lu(k,1777) = lu(k,1777) - lu(k,825) * lu(k,1748) + lu(k,1778) = lu(k,1778) - lu(k,826) * lu(k,1748) + lu(k,1832) = lu(k,1832) - lu(k,809) * lu(k,1831) + lu(k,1834) = lu(k,1834) - lu(k,810) * lu(k,1831) + lu(k,1837) = lu(k,1837) - lu(k,811) * lu(k,1831) + lu(k,1839) = lu(k,1839) - lu(k,812) * lu(k,1831) + lu(k,1840) = lu(k,1840) - lu(k,813) * lu(k,1831) + lu(k,1841) = - lu(k,814) * lu(k,1831) + lu(k,1843) = lu(k,1843) - lu(k,815) * lu(k,1831) + lu(k,1844) = lu(k,1844) - lu(k,816) * lu(k,1831) + lu(k,1845) = lu(k,1845) - lu(k,817) * lu(k,1831) + lu(k,1846) = lu(k,1846) - lu(k,818) * lu(k,1831) + lu(k,1847) = lu(k,1847) - lu(k,819) * lu(k,1831) + lu(k,1849) = lu(k,1849) - lu(k,820) * lu(k,1831) + lu(k,1850) = lu(k,1850) - lu(k,821) * lu(k,1831) + lu(k,1851) = lu(k,1851) - lu(k,822) * lu(k,1831) + lu(k,1852) = lu(k,1852) - lu(k,823) * lu(k,1831) + lu(k,1854) = lu(k,1854) - lu(k,824) * lu(k,1831) + lu(k,1859) = lu(k,1859) - lu(k,825) * lu(k,1831) + lu(k,1860) = lu(k,1860) - lu(k,826) * lu(k,1831) + lu(k,1868) = lu(k,1868) - lu(k,809) * lu(k,1867) + lu(k,1870) = lu(k,1870) - lu(k,810) * lu(k,1867) + lu(k,1873) = lu(k,1873) - lu(k,811) * lu(k,1867) + lu(k,1875) = - lu(k,812) * lu(k,1867) + lu(k,1876) = - lu(k,813) * lu(k,1867) + lu(k,1877) = lu(k,1877) - lu(k,814) * lu(k,1867) + lu(k,1879) = - lu(k,815) * lu(k,1867) + lu(k,1880) = lu(k,1880) - lu(k,816) * lu(k,1867) + lu(k,1881) = - lu(k,817) * lu(k,1867) + lu(k,1882) = lu(k,1882) - lu(k,818) * lu(k,1867) + lu(k,1883) = lu(k,1883) - lu(k,819) * lu(k,1867) + lu(k,1885) = lu(k,1885) - lu(k,820) * lu(k,1867) + lu(k,1886) = lu(k,1886) - lu(k,821) * lu(k,1867) + lu(k,1887) = - lu(k,822) * lu(k,1867) + lu(k,1888) = lu(k,1888) - lu(k,823) * lu(k,1867) + lu(k,1890) = lu(k,1890) - lu(k,824) * lu(k,1867) + lu(k,1895) = lu(k,1895) - lu(k,825) * lu(k,1867) + lu(k,1896) = lu(k,1896) - lu(k,826) * lu(k,1867) + lu(k,1999) = - lu(k,809) * lu(k,1997) + lu(k,2001) = lu(k,2001) - lu(k,810) * lu(k,1997) + lu(k,2004) = lu(k,2004) - lu(k,811) * lu(k,1997) + lu(k,2006) = - lu(k,812) * lu(k,1997) + lu(k,2007) = - lu(k,813) * lu(k,1997) + lu(k,2008) = lu(k,2008) - lu(k,814) * lu(k,1997) + lu(k,2010) = - lu(k,815) * lu(k,1997) + lu(k,2011) = lu(k,2011) - lu(k,816) * lu(k,1997) + lu(k,2012) = - lu(k,817) * lu(k,1997) + lu(k,2013) = lu(k,2013) - lu(k,818) * lu(k,1997) + lu(k,2014) = lu(k,2014) - lu(k,819) * lu(k,1997) + lu(k,2016) = lu(k,2016) - lu(k,820) * lu(k,1997) + lu(k,2017) = lu(k,2017) - lu(k,821) * lu(k,1997) + lu(k,2018) = - lu(k,822) * lu(k,1997) + lu(k,2019) = lu(k,2019) - lu(k,823) * lu(k,1997) + lu(k,2021) = lu(k,2021) - lu(k,824) * lu(k,1997) + lu(k,2026) = lu(k,2026) - lu(k,825) * lu(k,1997) + lu(k,2027) = lu(k,2027) - lu(k,826) * lu(k,1997) + lu(k,2059) = lu(k,2059) - lu(k,809) * lu(k,2058) + lu(k,2061) = lu(k,2061) - lu(k,810) * lu(k,2058) + lu(k,2064) = lu(k,2064) - lu(k,811) * lu(k,2058) + lu(k,2066) = lu(k,2066) - lu(k,812) * lu(k,2058) + lu(k,2067) = lu(k,2067) - lu(k,813) * lu(k,2058) + lu(k,2068) = lu(k,2068) - lu(k,814) * lu(k,2058) + lu(k,2070) = lu(k,2070) - lu(k,815) * lu(k,2058) + lu(k,2071) = lu(k,2071) - lu(k,816) * lu(k,2058) + lu(k,2072) = lu(k,2072) - lu(k,817) * lu(k,2058) + lu(k,2073) = lu(k,2073) - lu(k,818) * lu(k,2058) + lu(k,2074) = lu(k,2074) - lu(k,819) * lu(k,2058) + lu(k,2076) = lu(k,2076) - lu(k,820) * lu(k,2058) + lu(k,2077) = lu(k,2077) - lu(k,821) * lu(k,2058) + lu(k,2078) = lu(k,2078) - lu(k,822) * lu(k,2058) + lu(k,2079) = lu(k,2079) - lu(k,823) * lu(k,2058) + lu(k,2081) = lu(k,2081) - lu(k,824) * lu(k,2058) + lu(k,2086) = lu(k,2086) - lu(k,825) * lu(k,2058) + lu(k,2087) = lu(k,2087) - lu(k,826) * lu(k,2058) + lu(k,830) = 1._r8 / lu(k,830) + lu(k,831) = lu(k,831) * lu(k,830) + lu(k,832) = lu(k,832) * lu(k,830) + lu(k,833) = lu(k,833) * lu(k,830) + lu(k,834) = lu(k,834) * lu(k,830) + lu(k,835) = lu(k,835) * lu(k,830) + lu(k,836) = lu(k,836) * lu(k,830) + lu(k,837) = lu(k,837) * lu(k,830) + lu(k,838) = lu(k,838) * lu(k,830) + lu(k,839) = lu(k,839) * lu(k,830) + lu(k,840) = lu(k,840) * lu(k,830) + lu(k,841) = lu(k,841) * lu(k,830) + lu(k,842) = lu(k,842) * lu(k,830) + lu(k,843) = lu(k,843) * lu(k,830) + lu(k,844) = lu(k,844) * lu(k,830) + lu(k,845) = lu(k,845) * lu(k,830) + lu(k,846) = lu(k,846) * lu(k,830) + lu(k,847) = lu(k,847) * lu(k,830) + lu(k,848) = lu(k,848) * lu(k,830) + lu(k,849) = lu(k,849) * lu(k,830) + lu(k,850) = lu(k,850) * lu(k,830) + lu(k,851) = lu(k,851) * lu(k,830) + lu(k,852) = lu(k,852) * lu(k,830) + lu(k,853) = lu(k,853) * lu(k,830) + lu(k,854) = lu(k,854) * lu(k,830) + lu(k,855) = lu(k,855) * lu(k,830) + lu(k,856) = lu(k,856) * lu(k,830) + lu(k,857) = lu(k,857) * lu(k,830) + lu(k,858) = lu(k,858) * lu(k,830) + lu(k,1138) = lu(k,1138) - lu(k,831) * lu(k,1137) + lu(k,1139) = lu(k,1139) - lu(k,832) * lu(k,1137) + lu(k,1140) = lu(k,1140) - lu(k,833) * lu(k,1137) + lu(k,1141) = lu(k,1141) - lu(k,834) * lu(k,1137) + lu(k,1142) = lu(k,1142) - lu(k,835) * lu(k,1137) + lu(k,1143) = lu(k,1143) - lu(k,836) * lu(k,1137) + lu(k,1145) = lu(k,1145) - lu(k,837) * lu(k,1137) + lu(k,1146) = lu(k,1146) - lu(k,838) * lu(k,1137) + lu(k,1147) = lu(k,1147) - lu(k,839) * lu(k,1137) + lu(k,1148) = lu(k,1148) - lu(k,840) * lu(k,1137) + lu(k,1149) = lu(k,1149) - lu(k,841) * lu(k,1137) + lu(k,1150) = lu(k,1150) - lu(k,842) * lu(k,1137) + lu(k,1151) = lu(k,1151) - lu(k,843) * lu(k,1137) + lu(k,1152) = lu(k,1152) - lu(k,844) * lu(k,1137) + lu(k,1153) = lu(k,1153) - lu(k,845) * lu(k,1137) + lu(k,1154) = lu(k,1154) - lu(k,846) * lu(k,1137) + lu(k,1155) = lu(k,1155) - lu(k,847) * lu(k,1137) + lu(k,1156) = lu(k,1156) - lu(k,848) * lu(k,1137) + lu(k,1157) = lu(k,1157) - lu(k,849) * lu(k,1137) + lu(k,1158) = lu(k,1158) - lu(k,850) * lu(k,1137) + lu(k,1159) = lu(k,1159) - lu(k,851) * lu(k,1137) + lu(k,1160) = lu(k,1160) - lu(k,852) * lu(k,1137) + lu(k,1161) = lu(k,1161) - lu(k,853) * lu(k,1137) + lu(k,1162) = lu(k,1162) - lu(k,854) * lu(k,1137) + lu(k,1163) = lu(k,1163) - lu(k,855) * lu(k,1137) + lu(k,1164) = lu(k,1164) - lu(k,856) * lu(k,1137) + lu(k,1165) = lu(k,1165) - lu(k,857) * lu(k,1137) + lu(k,1166) = lu(k,1166) - lu(k,858) * lu(k,1137) + lu(k,1181) = lu(k,1181) - lu(k,831) * lu(k,1180) + lu(k,1182) = - lu(k,832) * lu(k,1180) + lu(k,1183) = lu(k,1183) - lu(k,833) * lu(k,1180) + lu(k,1184) = lu(k,1184) - lu(k,834) * lu(k,1180) + lu(k,1185) = lu(k,1185) - lu(k,835) * lu(k,1180) + lu(k,1186) = lu(k,1186) - lu(k,836) * lu(k,1180) + lu(k,1188) = lu(k,1188) - lu(k,837) * lu(k,1180) + lu(k,1189) = lu(k,1189) - lu(k,838) * lu(k,1180) + lu(k,1190) = lu(k,1190) - lu(k,839) * lu(k,1180) + lu(k,1191) = lu(k,1191) - lu(k,840) * lu(k,1180) + lu(k,1192) = lu(k,1192) - lu(k,841) * lu(k,1180) + lu(k,1193) = lu(k,1193) - lu(k,842) * lu(k,1180) + lu(k,1194) = lu(k,1194) - lu(k,843) * lu(k,1180) + lu(k,1195) = lu(k,1195) - lu(k,844) * lu(k,1180) + lu(k,1196) = lu(k,1196) - lu(k,845) * lu(k,1180) + lu(k,1197) = lu(k,1197) - lu(k,846) * lu(k,1180) + lu(k,1198) = lu(k,1198) - lu(k,847) * lu(k,1180) + lu(k,1199) = lu(k,1199) - lu(k,848) * lu(k,1180) + lu(k,1200) = lu(k,1200) - lu(k,849) * lu(k,1180) + lu(k,1201) = lu(k,1201) - lu(k,850) * lu(k,1180) + lu(k,1202) = - lu(k,851) * lu(k,1180) + lu(k,1203) = lu(k,1203) - lu(k,852) * lu(k,1180) + lu(k,1204) = - lu(k,853) * lu(k,1180) + lu(k,1205) = - lu(k,854) * lu(k,1180) + lu(k,1206) = - lu(k,855) * lu(k,1180) + lu(k,1207) = lu(k,1207) - lu(k,856) * lu(k,1180) + lu(k,1208) = lu(k,1208) - lu(k,857) * lu(k,1180) + lu(k,1209) = lu(k,1209) - lu(k,858) * lu(k,1180) + lu(k,1282) = lu(k,1282) - lu(k,831) * lu(k,1281) + lu(k,1283) = lu(k,1283) - lu(k,832) * lu(k,1281) + lu(k,1284) = lu(k,1284) - lu(k,833) * lu(k,1281) + lu(k,1285) = lu(k,1285) - lu(k,834) * lu(k,1281) + lu(k,1286) = lu(k,1286) - lu(k,835) * lu(k,1281) + lu(k,1287) = lu(k,1287) - lu(k,836) * lu(k,1281) + lu(k,1289) = lu(k,1289) - lu(k,837) * lu(k,1281) + lu(k,1290) = lu(k,1290) - lu(k,838) * lu(k,1281) + lu(k,1291) = lu(k,1291) - lu(k,839) * lu(k,1281) + lu(k,1292) = lu(k,1292) - lu(k,840) * lu(k,1281) + lu(k,1293) = lu(k,1293) - lu(k,841) * lu(k,1281) + lu(k,1294) = lu(k,1294) - lu(k,842) * lu(k,1281) + lu(k,1295) = lu(k,1295) - lu(k,843) * lu(k,1281) + lu(k,1296) = lu(k,1296) - lu(k,844) * lu(k,1281) + lu(k,1297) = lu(k,1297) - lu(k,845) * lu(k,1281) + lu(k,1298) = lu(k,1298) - lu(k,846) * lu(k,1281) + lu(k,1299) = lu(k,1299) - lu(k,847) * lu(k,1281) + lu(k,1300) = lu(k,1300) - lu(k,848) * lu(k,1281) + lu(k,1301) = lu(k,1301) - lu(k,849) * lu(k,1281) + lu(k,1302) = lu(k,1302) - lu(k,850) * lu(k,1281) + lu(k,1303) = lu(k,1303) - lu(k,851) * lu(k,1281) + lu(k,1304) = lu(k,1304) - lu(k,852) * lu(k,1281) + lu(k,1305) = lu(k,1305) - lu(k,853) * lu(k,1281) + lu(k,1306) = lu(k,1306) - lu(k,854) * lu(k,1281) + lu(k,1307) = lu(k,1307) - lu(k,855) * lu(k,1281) + lu(k,1308) = lu(k,1308) - lu(k,856) * lu(k,1281) + lu(k,1309) = lu(k,1309) - lu(k,857) * lu(k,1281) + lu(k,1310) = lu(k,1310) - lu(k,858) * lu(k,1281) + lu(k,1324) = lu(k,1324) - lu(k,831) * lu(k,1323) + lu(k,1325) = lu(k,1325) - lu(k,832) * lu(k,1323) + lu(k,1326) = lu(k,1326) - lu(k,833) * lu(k,1323) + lu(k,1327) = lu(k,1327) - lu(k,834) * lu(k,1323) + lu(k,1328) = lu(k,1328) - lu(k,835) * lu(k,1323) + lu(k,1329) = lu(k,1329) - lu(k,836) * lu(k,1323) + lu(k,1331) = lu(k,1331) - lu(k,837) * lu(k,1323) + lu(k,1332) = lu(k,1332) - lu(k,838) * lu(k,1323) + lu(k,1333) = lu(k,1333) - lu(k,839) * lu(k,1323) + lu(k,1334) = lu(k,1334) - lu(k,840) * lu(k,1323) + lu(k,1335) = lu(k,1335) - lu(k,841) * lu(k,1323) + lu(k,1336) = lu(k,1336) - lu(k,842) * lu(k,1323) + lu(k,1337) = lu(k,1337) - lu(k,843) * lu(k,1323) + lu(k,1338) = lu(k,1338) - lu(k,844) * lu(k,1323) + lu(k,1339) = lu(k,1339) - lu(k,845) * lu(k,1323) + lu(k,1340) = lu(k,1340) - lu(k,846) * lu(k,1323) + lu(k,1341) = lu(k,1341) - lu(k,847) * lu(k,1323) + lu(k,1342) = lu(k,1342) - lu(k,848) * lu(k,1323) + lu(k,1343) = lu(k,1343) - lu(k,849) * lu(k,1323) + lu(k,1344) = lu(k,1344) - lu(k,850) * lu(k,1323) + lu(k,1345) = - lu(k,851) * lu(k,1323) + lu(k,1346) = lu(k,1346) - lu(k,852) * lu(k,1323) + lu(k,1347) = - lu(k,853) * lu(k,1323) + lu(k,1348) = - lu(k,854) * lu(k,1323) + lu(k,1349) = - lu(k,855) * lu(k,1323) + lu(k,1350) = lu(k,1350) - lu(k,856) * lu(k,1323) + lu(k,1351) = lu(k,1351) - lu(k,857) * lu(k,1323) + lu(k,1352) = lu(k,1352) - lu(k,858) * lu(k,1323) + lu(k,1360) = lu(k,1360) - lu(k,831) * lu(k,1359) + lu(k,1361) = lu(k,1361) - lu(k,832) * lu(k,1359) + lu(k,1362) = lu(k,1362) - lu(k,833) * lu(k,1359) + lu(k,1363) = lu(k,1363) - lu(k,834) * lu(k,1359) + lu(k,1364) = lu(k,1364) - lu(k,835) * lu(k,1359) + lu(k,1365) = lu(k,1365) - lu(k,836) * lu(k,1359) + lu(k,1367) = lu(k,1367) - lu(k,837) * lu(k,1359) + lu(k,1368) = lu(k,1368) - lu(k,838) * lu(k,1359) + lu(k,1369) = lu(k,1369) - lu(k,839) * lu(k,1359) + lu(k,1370) = lu(k,1370) - lu(k,840) * lu(k,1359) + lu(k,1371) = lu(k,1371) - lu(k,841) * lu(k,1359) + lu(k,1372) = lu(k,1372) - lu(k,842) * lu(k,1359) + lu(k,1373) = lu(k,1373) - lu(k,843) * lu(k,1359) + lu(k,1374) = lu(k,1374) - lu(k,844) * lu(k,1359) + lu(k,1375) = lu(k,1375) - lu(k,845) * lu(k,1359) + lu(k,1376) = lu(k,1376) - lu(k,846) * lu(k,1359) + lu(k,1377) = lu(k,1377) - lu(k,847) * lu(k,1359) + lu(k,1378) = lu(k,1378) - lu(k,848) * lu(k,1359) + lu(k,1379) = lu(k,1379) - lu(k,849) * lu(k,1359) + lu(k,1380) = lu(k,1380) - lu(k,850) * lu(k,1359) + lu(k,1381) = lu(k,1381) - lu(k,851) * lu(k,1359) + lu(k,1382) = lu(k,1382) - lu(k,852) * lu(k,1359) + lu(k,1383) = lu(k,1383) - lu(k,853) * lu(k,1359) + lu(k,1384) = lu(k,1384) - lu(k,854) * lu(k,1359) + lu(k,1385) = lu(k,1385) - lu(k,855) * lu(k,1359) + lu(k,1386) = lu(k,1386) - lu(k,856) * lu(k,1359) + lu(k,1387) = lu(k,1387) - lu(k,857) * lu(k,1359) + lu(k,1388) = lu(k,1388) - lu(k,858) * lu(k,1359) + lu(k,1403) = lu(k,1403) - lu(k,831) * lu(k,1402) + lu(k,1404) = - lu(k,832) * lu(k,1402) + lu(k,1405) = lu(k,1405) - lu(k,833) * lu(k,1402) + lu(k,1406) = lu(k,1406) - lu(k,834) * lu(k,1402) + lu(k,1407) = lu(k,1407) - lu(k,835) * lu(k,1402) + lu(k,1408) = lu(k,1408) - lu(k,836) * lu(k,1402) + lu(k,1410) = lu(k,1410) - lu(k,837) * lu(k,1402) + lu(k,1411) = lu(k,1411) - lu(k,838) * lu(k,1402) + lu(k,1412) = lu(k,1412) - lu(k,839) * lu(k,1402) + lu(k,1413) = lu(k,1413) - lu(k,840) * lu(k,1402) + lu(k,1414) = lu(k,1414) - lu(k,841) * lu(k,1402) + lu(k,1415) = lu(k,1415) - lu(k,842) * lu(k,1402) + lu(k,1416) = lu(k,1416) - lu(k,843) * lu(k,1402) + lu(k,1417) = lu(k,1417) - lu(k,844) * lu(k,1402) + lu(k,1418) = lu(k,1418) - lu(k,845) * lu(k,1402) + lu(k,1419) = lu(k,1419) - lu(k,846) * lu(k,1402) + lu(k,1420) = lu(k,1420) - lu(k,847) * lu(k,1402) + lu(k,1421) = lu(k,1421) - lu(k,848) * lu(k,1402) + lu(k,1422) = lu(k,1422) - lu(k,849) * lu(k,1402) + lu(k,1423) = lu(k,1423) - lu(k,850) * lu(k,1402) + lu(k,1424) = - lu(k,851) * lu(k,1402) + lu(k,1425) = lu(k,1425) - lu(k,852) * lu(k,1402) + lu(k,1426) = - lu(k,853) * lu(k,1402) + lu(k,1427) = - lu(k,854) * lu(k,1402) + lu(k,1428) = - lu(k,855) * lu(k,1402) + lu(k,1429) = lu(k,1429) - lu(k,856) * lu(k,1402) + lu(k,1430) = lu(k,1430) - lu(k,857) * lu(k,1402) + lu(k,1431) = lu(k,1431) - lu(k,858) * lu(k,1402) + lu(k,1446) = lu(k,1446) - lu(k,831) * lu(k,1445) + lu(k,1447) = - lu(k,832) * lu(k,1445) + lu(k,1448) = lu(k,1448) - lu(k,833) * lu(k,1445) + lu(k,1449) = lu(k,1449) - lu(k,834) * lu(k,1445) + lu(k,1450) = lu(k,1450) - lu(k,835) * lu(k,1445) + lu(k,1451) = lu(k,1451) - lu(k,836) * lu(k,1445) + lu(k,1453) = lu(k,1453) - lu(k,837) * lu(k,1445) + lu(k,1454) = lu(k,1454) - lu(k,838) * lu(k,1445) + lu(k,1455) = lu(k,1455) - lu(k,839) * lu(k,1445) + lu(k,1456) = lu(k,1456) - lu(k,840) * lu(k,1445) + lu(k,1457) = lu(k,1457) - lu(k,841) * lu(k,1445) + lu(k,1458) = lu(k,1458) - lu(k,842) * lu(k,1445) + lu(k,1459) = lu(k,1459) - lu(k,843) * lu(k,1445) + lu(k,1460) = lu(k,1460) - lu(k,844) * lu(k,1445) + lu(k,1461) = lu(k,1461) - lu(k,845) * lu(k,1445) + lu(k,1462) = lu(k,1462) - lu(k,846) * lu(k,1445) + lu(k,1463) = lu(k,1463) - lu(k,847) * lu(k,1445) + lu(k,1464) = lu(k,1464) - lu(k,848) * lu(k,1445) + lu(k,1465) = lu(k,1465) - lu(k,849) * lu(k,1445) + lu(k,1466) = lu(k,1466) - lu(k,850) * lu(k,1445) + lu(k,1467) = - lu(k,851) * lu(k,1445) + lu(k,1468) = lu(k,1468) - lu(k,852) * lu(k,1445) + lu(k,1469) = - lu(k,853) * lu(k,1445) + lu(k,1470) = - lu(k,854) * lu(k,1445) + lu(k,1471) = - lu(k,855) * lu(k,1445) + lu(k,1472) = lu(k,1472) - lu(k,856) * lu(k,1445) + lu(k,1473) = lu(k,1473) - lu(k,857) * lu(k,1445) + lu(k,1474) = lu(k,1474) - lu(k,858) * lu(k,1445) + lu(k,1491) = lu(k,1491) - lu(k,831) * lu(k,1490) + lu(k,1492) = lu(k,1492) - lu(k,832) * lu(k,1490) + lu(k,1493) = lu(k,1493) - lu(k,833) * lu(k,1490) + lu(k,1494) = lu(k,1494) - lu(k,834) * lu(k,1490) + lu(k,1495) = - lu(k,835) * lu(k,1490) + lu(k,1496) = lu(k,1496) - lu(k,836) * lu(k,1490) + lu(k,1498) = lu(k,1498) - lu(k,837) * lu(k,1490) + lu(k,1499) = lu(k,1499) - lu(k,838) * lu(k,1490) + lu(k,1500) = lu(k,1500) - lu(k,839) * lu(k,1490) + lu(k,1501) = lu(k,1501) - lu(k,840) * lu(k,1490) + lu(k,1502) = lu(k,1502) - lu(k,841) * lu(k,1490) + lu(k,1503) = lu(k,1503) - lu(k,842) * lu(k,1490) + lu(k,1504) = lu(k,1504) - lu(k,843) * lu(k,1490) + lu(k,1505) = lu(k,1505) - lu(k,844) * lu(k,1490) + lu(k,1506) = lu(k,1506) - lu(k,845) * lu(k,1490) + lu(k,1507) = lu(k,1507) - lu(k,846) * lu(k,1490) + lu(k,1508) = lu(k,1508) - lu(k,847) * lu(k,1490) + lu(k,1509) = lu(k,1509) - lu(k,848) * lu(k,1490) + lu(k,1510) = lu(k,1510) - lu(k,849) * lu(k,1490) + lu(k,1511) = lu(k,1511) - lu(k,850) * lu(k,1490) + lu(k,1512) = lu(k,1512) - lu(k,851) * lu(k,1490) + lu(k,1513) = lu(k,1513) - lu(k,852) * lu(k,1490) + lu(k,1514) = lu(k,1514) - lu(k,853) * lu(k,1490) + lu(k,1515) = lu(k,1515) - lu(k,854) * lu(k,1490) + lu(k,1516) = lu(k,1516) - lu(k,855) * lu(k,1490) + lu(k,1517) = lu(k,1517) - lu(k,856) * lu(k,1490) + lu(k,1518) = lu(k,1518) - lu(k,857) * lu(k,1490) + lu(k,1519) = lu(k,1519) - lu(k,858) * lu(k,1490) + lu(k,1527) = lu(k,1527) - lu(k,831) * lu(k,1526) + lu(k,1528) = lu(k,1528) - lu(k,832) * lu(k,1526) + lu(k,1529) = lu(k,1529) - lu(k,833) * lu(k,1526) + lu(k,1530) = lu(k,1530) - lu(k,834) * lu(k,1526) + lu(k,1531) = lu(k,1531) - lu(k,835) * lu(k,1526) + lu(k,1532) = lu(k,1532) - lu(k,836) * lu(k,1526) + lu(k,1534) = lu(k,1534) - lu(k,837) * lu(k,1526) + lu(k,1535) = lu(k,1535) - lu(k,838) * lu(k,1526) + lu(k,1536) = lu(k,1536) - lu(k,839) * lu(k,1526) + lu(k,1537) = lu(k,1537) - lu(k,840) * lu(k,1526) + lu(k,1538) = lu(k,1538) - lu(k,841) * lu(k,1526) + lu(k,1539) = lu(k,1539) - lu(k,842) * lu(k,1526) + lu(k,1540) = lu(k,1540) - lu(k,843) * lu(k,1526) + lu(k,1541) = lu(k,1541) - lu(k,844) * lu(k,1526) + lu(k,1542) = lu(k,1542) - lu(k,845) * lu(k,1526) + lu(k,1543) = lu(k,1543) - lu(k,846) * lu(k,1526) + lu(k,1544) = lu(k,1544) - lu(k,847) * lu(k,1526) + lu(k,1545) = lu(k,1545) - lu(k,848) * lu(k,1526) + lu(k,1546) = lu(k,1546) - lu(k,849) * lu(k,1526) + lu(k,1547) = lu(k,1547) - lu(k,850) * lu(k,1526) + lu(k,1548) = lu(k,1548) - lu(k,851) * lu(k,1526) + lu(k,1549) = lu(k,1549) - lu(k,852) * lu(k,1526) + lu(k,1550) = lu(k,1550) - lu(k,853) * lu(k,1526) + lu(k,1551) = lu(k,1551) - lu(k,854) * lu(k,1526) + lu(k,1552) = lu(k,1552) - lu(k,855) * lu(k,1526) + lu(k,1553) = lu(k,1553) - lu(k,856) * lu(k,1526) + lu(k,1554) = lu(k,1554) - lu(k,857) * lu(k,1526) + lu(k,1555) = lu(k,1555) - lu(k,858) * lu(k,1526) + lu(k,1572) = lu(k,1572) - lu(k,831) * lu(k,1571) + lu(k,1573) = lu(k,1573) - lu(k,832) * lu(k,1571) + lu(k,1574) = lu(k,1574) - lu(k,833) * lu(k,1571) + lu(k,1575) = lu(k,1575) - lu(k,834) * lu(k,1571) + lu(k,1576) = lu(k,1576) - lu(k,835) * lu(k,1571) + lu(k,1577) = lu(k,1577) - lu(k,836) * lu(k,1571) + lu(k,1579) = lu(k,1579) - lu(k,837) * lu(k,1571) + lu(k,1580) = lu(k,1580) - lu(k,838) * lu(k,1571) + lu(k,1581) = lu(k,1581) - lu(k,839) * lu(k,1571) + lu(k,1582) = lu(k,1582) - lu(k,840) * lu(k,1571) + lu(k,1583) = lu(k,1583) - lu(k,841) * lu(k,1571) + lu(k,1584) = lu(k,1584) - lu(k,842) * lu(k,1571) + lu(k,1585) = lu(k,1585) - lu(k,843) * lu(k,1571) + lu(k,1586) = lu(k,1586) - lu(k,844) * lu(k,1571) + lu(k,1587) = lu(k,1587) - lu(k,845) * lu(k,1571) + lu(k,1588) = lu(k,1588) - lu(k,846) * lu(k,1571) + lu(k,1589) = lu(k,1589) - lu(k,847) * lu(k,1571) + lu(k,1590) = lu(k,1590) - lu(k,848) * lu(k,1571) + lu(k,1591) = lu(k,1591) - lu(k,849) * lu(k,1571) + lu(k,1592) = lu(k,1592) - lu(k,850) * lu(k,1571) + lu(k,1593) = lu(k,1593) - lu(k,851) * lu(k,1571) + lu(k,1594) = lu(k,1594) - lu(k,852) * lu(k,1571) + lu(k,1595) = lu(k,1595) - lu(k,853) * lu(k,1571) + lu(k,1596) = lu(k,1596) - lu(k,854) * lu(k,1571) + lu(k,1597) = lu(k,1597) - lu(k,855) * lu(k,1571) + lu(k,1598) = lu(k,1598) - lu(k,856) * lu(k,1571) + lu(k,1599) = lu(k,1599) - lu(k,857) * lu(k,1571) + lu(k,1600) = lu(k,1600) - lu(k,858) * lu(k,1571) + lu(k,1663) = lu(k,1663) - lu(k,831) * lu(k,1662) + lu(k,1664) = - lu(k,832) * lu(k,1662) + lu(k,1665) = lu(k,1665) - lu(k,833) * lu(k,1662) + lu(k,1666) = lu(k,1666) - lu(k,834) * lu(k,1662) + lu(k,1667) = lu(k,1667) - lu(k,835) * lu(k,1662) + lu(k,1668) = lu(k,1668) - lu(k,836) * lu(k,1662) + lu(k,1670) = lu(k,1670) - lu(k,837) * lu(k,1662) + lu(k,1671) = lu(k,1671) - lu(k,838) * lu(k,1662) + lu(k,1672) = lu(k,1672) - lu(k,839) * lu(k,1662) + lu(k,1673) = lu(k,1673) - lu(k,840) * lu(k,1662) + lu(k,1674) = lu(k,1674) - lu(k,841) * lu(k,1662) + lu(k,1675) = lu(k,1675) - lu(k,842) * lu(k,1662) + lu(k,1676) = lu(k,1676) - lu(k,843) * lu(k,1662) + lu(k,1677) = lu(k,1677) - lu(k,844) * lu(k,1662) + lu(k,1678) = lu(k,1678) - lu(k,845) * lu(k,1662) + lu(k,1679) = lu(k,1679) - lu(k,846) * lu(k,1662) + lu(k,1680) = lu(k,1680) - lu(k,847) * lu(k,1662) + lu(k,1681) = lu(k,1681) - lu(k,848) * lu(k,1662) + lu(k,1682) = lu(k,1682) - lu(k,849) * lu(k,1662) + lu(k,1683) = lu(k,1683) - lu(k,850) * lu(k,1662) + lu(k,1684) = - lu(k,851) * lu(k,1662) + lu(k,1685) = lu(k,1685) - lu(k,852) * lu(k,1662) + lu(k,1686) = - lu(k,853) * lu(k,1662) + lu(k,1687) = - lu(k,854) * lu(k,1662) + lu(k,1688) = - lu(k,855) * lu(k,1662) + lu(k,1689) = lu(k,1689) - lu(k,856) * lu(k,1662) + lu(k,1690) = lu(k,1690) - lu(k,857) * lu(k,1662) + lu(k,1691) = lu(k,1691) - lu(k,858) * lu(k,1662) + lu(k,1750) = lu(k,1750) - lu(k,831) * lu(k,1749) + lu(k,1751) = lu(k,1751) - lu(k,832) * lu(k,1749) + lu(k,1752) = lu(k,1752) - lu(k,833) * lu(k,1749) + lu(k,1753) = lu(k,1753) - lu(k,834) * lu(k,1749) + lu(k,1754) = lu(k,1754) - lu(k,835) * lu(k,1749) + lu(k,1755) = lu(k,1755) - lu(k,836) * lu(k,1749) + lu(k,1757) = lu(k,1757) - lu(k,837) * lu(k,1749) + lu(k,1758) = lu(k,1758) - lu(k,838) * lu(k,1749) + lu(k,1759) = lu(k,1759) - lu(k,839) * lu(k,1749) + lu(k,1760) = lu(k,1760) - lu(k,840) * lu(k,1749) + lu(k,1761) = lu(k,1761) - lu(k,841) * lu(k,1749) + lu(k,1762) = lu(k,1762) - lu(k,842) * lu(k,1749) + lu(k,1763) = lu(k,1763) - lu(k,843) * lu(k,1749) + lu(k,1764) = lu(k,1764) - lu(k,844) * lu(k,1749) + lu(k,1765) = lu(k,1765) - lu(k,845) * lu(k,1749) + lu(k,1766) = lu(k,1766) - lu(k,846) * lu(k,1749) + lu(k,1767) = lu(k,1767) - lu(k,847) * lu(k,1749) + lu(k,1768) = lu(k,1768) - lu(k,848) * lu(k,1749) + lu(k,1769) = lu(k,1769) - lu(k,849) * lu(k,1749) + lu(k,1770) = lu(k,1770) - lu(k,850) * lu(k,1749) + lu(k,1771) = lu(k,1771) - lu(k,851) * lu(k,1749) + lu(k,1772) = lu(k,1772) - lu(k,852) * lu(k,1749) + lu(k,1773) = lu(k,1773) - lu(k,853) * lu(k,1749) + lu(k,1774) = lu(k,1774) - lu(k,854) * lu(k,1749) + lu(k,1775) = lu(k,1775) - lu(k,855) * lu(k,1749) + lu(k,1776) = lu(k,1776) - lu(k,856) * lu(k,1749) + lu(k,1777) = lu(k,1777) - lu(k,857) * lu(k,1749) + lu(k,1778) = lu(k,1778) - lu(k,858) * lu(k,1749) + lu(k,1799) = lu(k,1799) - lu(k,831) * lu(k,1798) + lu(k,1800) = lu(k,1800) - lu(k,832) * lu(k,1798) + lu(k,1801) = lu(k,1801) - lu(k,833) * lu(k,1798) + lu(k,1802) = lu(k,1802) - lu(k,834) * lu(k,1798) + lu(k,1803) = lu(k,1803) - lu(k,835) * lu(k,1798) + lu(k,1804) = lu(k,1804) - lu(k,836) * lu(k,1798) + lu(k,1806) = lu(k,1806) - lu(k,837) * lu(k,1798) + lu(k,1807) = - lu(k,838) * lu(k,1798) + lu(k,1808) = lu(k,1808) - lu(k,839) * lu(k,1798) + lu(k,1809) = lu(k,1809) - lu(k,840) * lu(k,1798) + lu(k,1810) = - lu(k,841) * lu(k,1798) + lu(k,1811) = lu(k,1811) - lu(k,842) * lu(k,1798) + lu(k,1812) = - lu(k,843) * lu(k,1798) + lu(k,1813) = lu(k,1813) - lu(k,844) * lu(k,1798) + lu(k,1814) = lu(k,1814) - lu(k,845) * lu(k,1798) + lu(k,1815) = lu(k,1815) - lu(k,846) * lu(k,1798) + lu(k,1816) = lu(k,1816) - lu(k,847) * lu(k,1798) + lu(k,1817) = lu(k,1817) - lu(k,848) * lu(k,1798) + lu(k,1818) = - lu(k,849) * lu(k,1798) + lu(k,1819) = lu(k,1819) - lu(k,850) * lu(k,1798) + lu(k,1820) = lu(k,1820) - lu(k,851) * lu(k,1798) + lu(k,1821) = lu(k,1821) - lu(k,852) * lu(k,1798) + lu(k,1822) = lu(k,1822) - lu(k,853) * lu(k,1798) + lu(k,1823) = lu(k,1823) - lu(k,854) * lu(k,1798) + lu(k,1824) = lu(k,1824) - lu(k,855) * lu(k,1798) + lu(k,1825) = lu(k,1825) - lu(k,856) * lu(k,1798) + lu(k,1826) = lu(k,1826) - lu(k,857) * lu(k,1798) + lu(k,1827) = lu(k,1827) - lu(k,858) * lu(k,1798) + lu(k,1909) = lu(k,1909) - lu(k,831) * lu(k,1908) + lu(k,1910) = lu(k,1910) - lu(k,832) * lu(k,1908) + lu(k,1911) = lu(k,1911) - lu(k,833) * lu(k,1908) + lu(k,1912) = lu(k,1912) - lu(k,834) * lu(k,1908) + lu(k,1913) = lu(k,1913) - lu(k,835) * lu(k,1908) + lu(k,1914) = lu(k,1914) - lu(k,836) * lu(k,1908) + lu(k,1916) = - lu(k,837) * lu(k,1908) + lu(k,1917) = - lu(k,838) * lu(k,1908) + lu(k,1918) = lu(k,1918) - lu(k,839) * lu(k,1908) + lu(k,1919) = lu(k,1919) - lu(k,840) * lu(k,1908) + lu(k,1920) = - lu(k,841) * lu(k,1908) + lu(k,1921) = lu(k,1921) - lu(k,842) * lu(k,1908) + lu(k,1922) = - lu(k,843) * lu(k,1908) + lu(k,1923) = lu(k,1923) - lu(k,844) * lu(k,1908) + lu(k,1924) = lu(k,1924) - lu(k,845) * lu(k,1908) + lu(k,1925) = lu(k,1925) - lu(k,846) * lu(k,1908) + lu(k,1926) = lu(k,1926) - lu(k,847) * lu(k,1908) + lu(k,1927) = lu(k,1927) - lu(k,848) * lu(k,1908) + lu(k,1928) = - lu(k,849) * lu(k,1908) + lu(k,1929) = lu(k,1929) - lu(k,850) * lu(k,1908) + lu(k,1930) = lu(k,1930) - lu(k,851) * lu(k,1908) + lu(k,1931) = lu(k,1931) - lu(k,852) * lu(k,1908) + lu(k,1932) = lu(k,1932) - lu(k,853) * lu(k,1908) + lu(k,1933) = lu(k,1933) - lu(k,854) * lu(k,1908) + lu(k,1934) = lu(k,1934) - lu(k,855) * lu(k,1908) + lu(k,1935) = lu(k,1935) - lu(k,856) * lu(k,1908) + lu(k,1936) = lu(k,1936) - lu(k,857) * lu(k,1908) + lu(k,1937) = lu(k,1937) - lu(k,858) * lu(k,1908) + lu(k,1951) = lu(k,1951) - lu(k,831) * lu(k,1950) + lu(k,1952) = lu(k,1952) - lu(k,832) * lu(k,1950) + lu(k,1953) = lu(k,1953) - lu(k,833) * lu(k,1950) + lu(k,1954) = lu(k,1954) - lu(k,834) * lu(k,1950) + lu(k,1955) = lu(k,1955) - lu(k,835) * lu(k,1950) + lu(k,1956) = lu(k,1956) - lu(k,836) * lu(k,1950) + lu(k,1958) = lu(k,1958) - lu(k,837) * lu(k,1950) + lu(k,1959) = lu(k,1959) - lu(k,838) * lu(k,1950) + lu(k,1960) = lu(k,1960) - lu(k,839) * lu(k,1950) + lu(k,1961) = lu(k,1961) - lu(k,840) * lu(k,1950) + lu(k,1962) = lu(k,1962) - lu(k,841) * lu(k,1950) + lu(k,1963) = lu(k,1963) - lu(k,842) * lu(k,1950) + lu(k,1964) = lu(k,1964) - lu(k,843) * lu(k,1950) + lu(k,1965) = lu(k,1965) - lu(k,844) * lu(k,1950) + lu(k,1966) = lu(k,1966) - lu(k,845) * lu(k,1950) + lu(k,1967) = lu(k,1967) - lu(k,846) * lu(k,1950) + lu(k,1968) = lu(k,1968) - lu(k,847) * lu(k,1950) + lu(k,1969) = lu(k,1969) - lu(k,848) * lu(k,1950) + lu(k,1970) = lu(k,1970) - lu(k,849) * lu(k,1950) + lu(k,1971) = lu(k,1971) - lu(k,850) * lu(k,1950) + lu(k,1972) = lu(k,1972) - lu(k,851) * lu(k,1950) + lu(k,1973) = lu(k,1973) - lu(k,852) * lu(k,1950) + lu(k,1974) = lu(k,1974) - lu(k,853) * lu(k,1950) + lu(k,1975) = lu(k,1975) - lu(k,854) * lu(k,1950) + lu(k,1976) = lu(k,1976) - lu(k,855) * lu(k,1950) + lu(k,1977) = lu(k,1977) - lu(k,856) * lu(k,1950) + lu(k,1978) = lu(k,1978) - lu(k,857) * lu(k,1950) + lu(k,1979) = lu(k,1979) - lu(k,858) * lu(k,1950) + lu(k,1999) = lu(k,1999) - lu(k,831) * lu(k,1998) + lu(k,2000) = lu(k,2000) - lu(k,832) * lu(k,1998) + lu(k,2001) = lu(k,2001) - lu(k,833) * lu(k,1998) + lu(k,2002) = lu(k,2002) - lu(k,834) * lu(k,1998) + lu(k,2003) = lu(k,2003) - lu(k,835) * lu(k,1998) + lu(k,2004) = lu(k,2004) - lu(k,836) * lu(k,1998) + lu(k,2006) = lu(k,2006) - lu(k,837) * lu(k,1998) + lu(k,2007) = lu(k,2007) - lu(k,838) * lu(k,1998) + lu(k,2008) = lu(k,2008) - lu(k,839) * lu(k,1998) + lu(k,2009) = lu(k,2009) - lu(k,840) * lu(k,1998) + lu(k,2010) = lu(k,2010) - lu(k,841) * lu(k,1998) + lu(k,2011) = lu(k,2011) - lu(k,842) * lu(k,1998) + lu(k,2012) = lu(k,2012) - lu(k,843) * lu(k,1998) + lu(k,2013) = lu(k,2013) - lu(k,844) * lu(k,1998) + lu(k,2014) = lu(k,2014) - lu(k,845) * lu(k,1998) + lu(k,2015) = lu(k,2015) - lu(k,846) * lu(k,1998) + lu(k,2016) = lu(k,2016) - lu(k,847) * lu(k,1998) + lu(k,2017) = lu(k,2017) - lu(k,848) * lu(k,1998) + lu(k,2018) = lu(k,2018) - lu(k,849) * lu(k,1998) + lu(k,2019) = lu(k,2019) - lu(k,850) * lu(k,1998) + lu(k,2020) = lu(k,2020) - lu(k,851) * lu(k,1998) + lu(k,2021) = lu(k,2021) - lu(k,852) * lu(k,1998) + lu(k,2022) = lu(k,2022) - lu(k,853) * lu(k,1998) + lu(k,2023) = lu(k,2023) - lu(k,854) * lu(k,1998) + lu(k,2024) = lu(k,2024) - lu(k,855) * lu(k,1998) + lu(k,2025) = lu(k,2025) - lu(k,856) * lu(k,1998) + lu(k,2026) = lu(k,2026) - lu(k,857) * lu(k,1998) + lu(k,2027) = lu(k,2027) - lu(k,858) * lu(k,1998) end do end subroutine lu_fac19 subroutine lu_fac20( avec_len, lu ) @@ -9697,1151 +6780,1625 @@ subroutine lu_fac20( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,990) = 1._r8 / lu(k,990) - lu(k,991) = lu(k,991) * lu(k,990) - lu(k,992) = lu(k,992) * lu(k,990) - lu(k,993) = lu(k,993) * lu(k,990) - lu(k,994) = lu(k,994) * lu(k,990) - lu(k,995) = lu(k,995) * lu(k,990) - lu(k,996) = lu(k,996) * lu(k,990) - lu(k,997) = lu(k,997) * lu(k,990) - lu(k,998) = lu(k,998) * lu(k,990) - lu(k,999) = lu(k,999) * lu(k,990) - lu(k,1000) = lu(k,1000) * lu(k,990) - lu(k,1001) = lu(k,1001) * lu(k,990) - lu(k,1002) = lu(k,1002) * lu(k,990) - lu(k,1003) = lu(k,1003) * lu(k,990) - lu(k,1004) = lu(k,1004) * lu(k,990) - lu(k,1005) = lu(k,1005) * lu(k,990) - lu(k,1006) = lu(k,1006) * lu(k,990) - lu(k,1007) = lu(k,1007) * lu(k,990) - lu(k,1008) = lu(k,1008) * lu(k,990) - lu(k,1009) = lu(k,1009) * lu(k,990) - lu(k,1010) = lu(k,1010) * lu(k,990) - lu(k,1033) = lu(k,1033) - lu(k,991) * lu(k,1032) - lu(k,1034) = lu(k,1034) - lu(k,992) * lu(k,1032) - lu(k,1035) = lu(k,1035) - lu(k,993) * lu(k,1032) - lu(k,1036) = lu(k,1036) - lu(k,994) * lu(k,1032) - lu(k,1037) = lu(k,1037) - lu(k,995) * lu(k,1032) - lu(k,1038) = lu(k,1038) - lu(k,996) * lu(k,1032) - lu(k,1039) = lu(k,1039) - lu(k,997) * lu(k,1032) - lu(k,1040) = lu(k,1040) - lu(k,998) * lu(k,1032) - lu(k,1041) = lu(k,1041) - lu(k,999) * lu(k,1032) - lu(k,1042) = lu(k,1042) - lu(k,1000) * lu(k,1032) - lu(k,1043) = lu(k,1043) - lu(k,1001) * lu(k,1032) - lu(k,1044) = lu(k,1044) - lu(k,1002) * lu(k,1032) - lu(k,1045) = lu(k,1045) - lu(k,1003) * lu(k,1032) - lu(k,1046) = lu(k,1046) - lu(k,1004) * lu(k,1032) - lu(k,1047) = lu(k,1047) - lu(k,1005) * lu(k,1032) - lu(k,1048) = lu(k,1048) - lu(k,1006) * lu(k,1032) - lu(k,1049) = lu(k,1049) - lu(k,1007) * lu(k,1032) - lu(k,1050) = lu(k,1050) - lu(k,1008) * lu(k,1032) - lu(k,1051) = lu(k,1051) - lu(k,1009) * lu(k,1032) - lu(k,1052) = lu(k,1052) - lu(k,1010) * lu(k,1032) - lu(k,1074) = lu(k,1074) - lu(k,991) * lu(k,1073) - lu(k,1075) = lu(k,1075) - lu(k,992) * lu(k,1073) - lu(k,1076) = lu(k,1076) - lu(k,993) * lu(k,1073) - lu(k,1077) = lu(k,1077) - lu(k,994) * lu(k,1073) - lu(k,1078) = lu(k,1078) - lu(k,995) * lu(k,1073) - lu(k,1079) = lu(k,1079) - lu(k,996) * lu(k,1073) - lu(k,1080) = lu(k,1080) - lu(k,997) * lu(k,1073) - lu(k,1081) = lu(k,1081) - lu(k,998) * lu(k,1073) - lu(k,1082) = lu(k,1082) - lu(k,999) * lu(k,1073) - lu(k,1083) = lu(k,1083) - lu(k,1000) * lu(k,1073) - lu(k,1084) = lu(k,1084) - lu(k,1001) * lu(k,1073) - lu(k,1085) = lu(k,1085) - lu(k,1002) * lu(k,1073) - lu(k,1086) = lu(k,1086) - lu(k,1003) * lu(k,1073) - lu(k,1087) = lu(k,1087) - lu(k,1004) * lu(k,1073) - lu(k,1088) = lu(k,1088) - lu(k,1005) * lu(k,1073) - lu(k,1089) = lu(k,1089) - lu(k,1006) * lu(k,1073) - lu(k,1090) = lu(k,1090) - lu(k,1007) * lu(k,1073) - lu(k,1091) = lu(k,1091) - lu(k,1008) * lu(k,1073) - lu(k,1092) = lu(k,1092) - lu(k,1009) * lu(k,1073) - lu(k,1093) = lu(k,1093) - lu(k,1010) * lu(k,1073) - lu(k,1113) = lu(k,1113) - lu(k,991) * lu(k,1112) - lu(k,1114) = lu(k,1114) - lu(k,992) * lu(k,1112) - lu(k,1115) = lu(k,1115) - lu(k,993) * lu(k,1112) - lu(k,1116) = lu(k,1116) - lu(k,994) * lu(k,1112) - lu(k,1117) = lu(k,1117) - lu(k,995) * lu(k,1112) - lu(k,1118) = lu(k,1118) - lu(k,996) * lu(k,1112) - lu(k,1119) = lu(k,1119) - lu(k,997) * lu(k,1112) - lu(k,1120) = lu(k,1120) - lu(k,998) * lu(k,1112) - lu(k,1121) = lu(k,1121) - lu(k,999) * lu(k,1112) - lu(k,1122) = lu(k,1122) - lu(k,1000) * lu(k,1112) - lu(k,1123) = lu(k,1123) - lu(k,1001) * lu(k,1112) - lu(k,1124) = lu(k,1124) - lu(k,1002) * lu(k,1112) - lu(k,1125) = lu(k,1125) - lu(k,1003) * lu(k,1112) - lu(k,1126) = lu(k,1126) - lu(k,1004) * lu(k,1112) - lu(k,1127) = lu(k,1127) - lu(k,1005) * lu(k,1112) - lu(k,1128) = lu(k,1128) - lu(k,1006) * lu(k,1112) - lu(k,1129) = lu(k,1129) - lu(k,1007) * lu(k,1112) - lu(k,1130) = lu(k,1130) - lu(k,1008) * lu(k,1112) - lu(k,1131) = lu(k,1131) - lu(k,1009) * lu(k,1112) - lu(k,1132) = lu(k,1132) - lu(k,1010) * lu(k,1112) - lu(k,1157) = lu(k,1157) - lu(k,991) * lu(k,1156) - lu(k,1158) = lu(k,1158) - lu(k,992) * lu(k,1156) - lu(k,1159) = lu(k,1159) - lu(k,993) * lu(k,1156) - lu(k,1160) = lu(k,1160) - lu(k,994) * lu(k,1156) - lu(k,1161) = lu(k,1161) - lu(k,995) * lu(k,1156) - lu(k,1162) = lu(k,1162) - lu(k,996) * lu(k,1156) - lu(k,1163) = lu(k,1163) - lu(k,997) * lu(k,1156) - lu(k,1164) = lu(k,1164) - lu(k,998) * lu(k,1156) - lu(k,1165) = lu(k,1165) - lu(k,999) * lu(k,1156) - lu(k,1166) = lu(k,1166) - lu(k,1000) * lu(k,1156) - lu(k,1167) = lu(k,1167) - lu(k,1001) * lu(k,1156) - lu(k,1168) = lu(k,1168) - lu(k,1002) * lu(k,1156) - lu(k,1169) = lu(k,1169) - lu(k,1003) * lu(k,1156) - lu(k,1170) = lu(k,1170) - lu(k,1004) * lu(k,1156) - lu(k,1171) = lu(k,1171) - lu(k,1005) * lu(k,1156) - lu(k,1172) = lu(k,1172) - lu(k,1006) * lu(k,1156) - lu(k,1173) = lu(k,1173) - lu(k,1007) * lu(k,1156) - lu(k,1174) = lu(k,1174) - lu(k,1008) * lu(k,1156) - lu(k,1175) = lu(k,1175) - lu(k,1009) * lu(k,1156) - lu(k,1176) = lu(k,1176) - lu(k,1010) * lu(k,1156) - lu(k,1198) = lu(k,1198) - lu(k,991) * lu(k,1197) - lu(k,1199) = lu(k,1199) - lu(k,992) * lu(k,1197) - lu(k,1200) = lu(k,1200) - lu(k,993) * lu(k,1197) - lu(k,1201) = lu(k,1201) - lu(k,994) * lu(k,1197) - lu(k,1202) = lu(k,1202) - lu(k,995) * lu(k,1197) - lu(k,1203) = lu(k,1203) - lu(k,996) * lu(k,1197) - lu(k,1204) = lu(k,1204) - lu(k,997) * lu(k,1197) - lu(k,1205) = lu(k,1205) - lu(k,998) * lu(k,1197) - lu(k,1206) = lu(k,1206) - lu(k,999) * lu(k,1197) - lu(k,1207) = lu(k,1207) - lu(k,1000) * lu(k,1197) - lu(k,1208) = lu(k,1208) - lu(k,1001) * lu(k,1197) - lu(k,1209) = lu(k,1209) - lu(k,1002) * lu(k,1197) - lu(k,1210) = lu(k,1210) - lu(k,1003) * lu(k,1197) - lu(k,1211) = lu(k,1211) - lu(k,1004) * lu(k,1197) - lu(k,1212) = lu(k,1212) - lu(k,1005) * lu(k,1197) - lu(k,1213) = lu(k,1213) - lu(k,1006) * lu(k,1197) - lu(k,1214) = lu(k,1214) - lu(k,1007) * lu(k,1197) - lu(k,1215) = lu(k,1215) - lu(k,1008) * lu(k,1197) - lu(k,1216) = lu(k,1216) - lu(k,1009) * lu(k,1197) - lu(k,1217) = lu(k,1217) - lu(k,1010) * lu(k,1197) - lu(k,1247) = lu(k,1247) - lu(k,991) * lu(k,1246) - lu(k,1248) = lu(k,1248) - lu(k,992) * lu(k,1246) - lu(k,1249) = lu(k,1249) - lu(k,993) * lu(k,1246) - lu(k,1250) = lu(k,1250) - lu(k,994) * lu(k,1246) - lu(k,1251) = lu(k,1251) - lu(k,995) * lu(k,1246) - lu(k,1252) = lu(k,1252) - lu(k,996) * lu(k,1246) - lu(k,1253) = lu(k,1253) - lu(k,997) * lu(k,1246) - lu(k,1254) = lu(k,1254) - lu(k,998) * lu(k,1246) - lu(k,1255) = lu(k,1255) - lu(k,999) * lu(k,1246) - lu(k,1256) = lu(k,1256) - lu(k,1000) * lu(k,1246) - lu(k,1257) = lu(k,1257) - lu(k,1001) * lu(k,1246) - lu(k,1258) = lu(k,1258) - lu(k,1002) * lu(k,1246) - lu(k,1259) = lu(k,1259) - lu(k,1003) * lu(k,1246) - lu(k,1260) = lu(k,1260) - lu(k,1004) * lu(k,1246) - lu(k,1261) = lu(k,1261) - lu(k,1005) * lu(k,1246) - lu(k,1262) = lu(k,1262) - lu(k,1006) * lu(k,1246) - lu(k,1263) = lu(k,1263) - lu(k,1007) * lu(k,1246) - lu(k,1264) = lu(k,1264) - lu(k,1008) * lu(k,1246) - lu(k,1265) = lu(k,1265) - lu(k,1009) * lu(k,1246) - lu(k,1266) = lu(k,1266) - lu(k,1010) * lu(k,1246) - lu(k,1286) = lu(k,1286) - lu(k,991) * lu(k,1285) - lu(k,1287) = lu(k,1287) - lu(k,992) * lu(k,1285) - lu(k,1288) = lu(k,1288) - lu(k,993) * lu(k,1285) - lu(k,1289) = lu(k,1289) - lu(k,994) * lu(k,1285) - lu(k,1290) = lu(k,1290) - lu(k,995) * lu(k,1285) - lu(k,1291) = lu(k,1291) - lu(k,996) * lu(k,1285) - lu(k,1292) = lu(k,1292) - lu(k,997) * lu(k,1285) - lu(k,1293) = lu(k,1293) - lu(k,998) * lu(k,1285) - lu(k,1294) = lu(k,1294) - lu(k,999) * lu(k,1285) - lu(k,1295) = lu(k,1295) - lu(k,1000) * lu(k,1285) - lu(k,1296) = lu(k,1296) - lu(k,1001) * lu(k,1285) - lu(k,1297) = lu(k,1297) - lu(k,1002) * lu(k,1285) - lu(k,1298) = lu(k,1298) - lu(k,1003) * lu(k,1285) - lu(k,1299) = lu(k,1299) - lu(k,1004) * lu(k,1285) - lu(k,1300) = lu(k,1300) - lu(k,1005) * lu(k,1285) - lu(k,1301) = lu(k,1301) - lu(k,1006) * lu(k,1285) - lu(k,1302) = lu(k,1302) - lu(k,1007) * lu(k,1285) - lu(k,1303) = lu(k,1303) - lu(k,1008) * lu(k,1285) - lu(k,1304) = lu(k,1304) - lu(k,1009) * lu(k,1285) - lu(k,1305) = lu(k,1305) - lu(k,1010) * lu(k,1285) - lu(k,1321) = lu(k,1321) - lu(k,991) * lu(k,1320) - lu(k,1322) = lu(k,1322) - lu(k,992) * lu(k,1320) - lu(k,1323) = lu(k,1323) - lu(k,993) * lu(k,1320) - lu(k,1324) = lu(k,1324) - lu(k,994) * lu(k,1320) - lu(k,1325) = lu(k,1325) - lu(k,995) * lu(k,1320) - lu(k,1326) = lu(k,1326) - lu(k,996) * lu(k,1320) - lu(k,1327) = lu(k,1327) - lu(k,997) * lu(k,1320) - lu(k,1328) = lu(k,1328) - lu(k,998) * lu(k,1320) - lu(k,1329) = lu(k,1329) - lu(k,999) * lu(k,1320) - lu(k,1330) = lu(k,1330) - lu(k,1000) * lu(k,1320) - lu(k,1331) = lu(k,1331) - lu(k,1001) * lu(k,1320) - lu(k,1332) = lu(k,1332) - lu(k,1002) * lu(k,1320) - lu(k,1333) = lu(k,1333) - lu(k,1003) * lu(k,1320) - lu(k,1334) = lu(k,1334) - lu(k,1004) * lu(k,1320) - lu(k,1335) = lu(k,1335) - lu(k,1005) * lu(k,1320) - lu(k,1336) = lu(k,1336) - lu(k,1006) * lu(k,1320) - lu(k,1337) = lu(k,1337) - lu(k,1007) * lu(k,1320) - lu(k,1338) = lu(k,1338) - lu(k,1008) * lu(k,1320) - lu(k,1339) = lu(k,1339) - lu(k,1009) * lu(k,1320) - lu(k,1340) = lu(k,1340) - lu(k,1010) * lu(k,1320) - lu(k,1365) = lu(k,1365) - lu(k,991) * lu(k,1364) - lu(k,1366) = lu(k,1366) - lu(k,992) * lu(k,1364) - lu(k,1367) = lu(k,1367) - lu(k,993) * lu(k,1364) - lu(k,1368) = lu(k,1368) - lu(k,994) * lu(k,1364) - lu(k,1369) = lu(k,1369) - lu(k,995) * lu(k,1364) - lu(k,1370) = lu(k,1370) - lu(k,996) * lu(k,1364) - lu(k,1371) = lu(k,1371) - lu(k,997) * lu(k,1364) - lu(k,1372) = lu(k,1372) - lu(k,998) * lu(k,1364) - lu(k,1373) = lu(k,1373) - lu(k,999) * lu(k,1364) - lu(k,1374) = lu(k,1374) - lu(k,1000) * lu(k,1364) - lu(k,1375) = lu(k,1375) - lu(k,1001) * lu(k,1364) - lu(k,1376) = lu(k,1376) - lu(k,1002) * lu(k,1364) - lu(k,1377) = lu(k,1377) - lu(k,1003) * lu(k,1364) - lu(k,1378) = lu(k,1378) - lu(k,1004) * lu(k,1364) - lu(k,1379) = lu(k,1379) - lu(k,1005) * lu(k,1364) - lu(k,1380) = lu(k,1380) - lu(k,1006) * lu(k,1364) - lu(k,1381) = lu(k,1381) - lu(k,1007) * lu(k,1364) - lu(k,1382) = lu(k,1382) - lu(k,1008) * lu(k,1364) - lu(k,1383) = lu(k,1383) - lu(k,1009) * lu(k,1364) - lu(k,1384) = lu(k,1384) - lu(k,1010) * lu(k,1364) - lu(k,1424) = lu(k,1424) - lu(k,991) * lu(k,1423) - lu(k,1425) = lu(k,1425) - lu(k,992) * lu(k,1423) - lu(k,1426) = lu(k,1426) - lu(k,993) * lu(k,1423) - lu(k,1427) = lu(k,1427) - lu(k,994) * lu(k,1423) - lu(k,1428) = lu(k,1428) - lu(k,995) * lu(k,1423) - lu(k,1429) = lu(k,1429) - lu(k,996) * lu(k,1423) - lu(k,1430) = lu(k,1430) - lu(k,997) * lu(k,1423) - lu(k,1431) = lu(k,1431) - lu(k,998) * lu(k,1423) - lu(k,1432) = lu(k,1432) - lu(k,999) * lu(k,1423) - lu(k,1433) = lu(k,1433) - lu(k,1000) * lu(k,1423) - lu(k,1434) = lu(k,1434) - lu(k,1001) * lu(k,1423) - lu(k,1435) = lu(k,1435) - lu(k,1002) * lu(k,1423) - lu(k,1436) = lu(k,1436) - lu(k,1003) * lu(k,1423) - lu(k,1437) = lu(k,1437) - lu(k,1004) * lu(k,1423) - lu(k,1438) = lu(k,1438) - lu(k,1005) * lu(k,1423) - lu(k,1439) = lu(k,1439) - lu(k,1006) * lu(k,1423) - lu(k,1440) = lu(k,1440) - lu(k,1007) * lu(k,1423) - lu(k,1441) = lu(k,1441) - lu(k,1008) * lu(k,1423) - lu(k,1442) = lu(k,1442) - lu(k,1009) * lu(k,1423) - lu(k,1443) = lu(k,1443) - lu(k,1010) * lu(k,1423) - lu(k,1466) = lu(k,1466) - lu(k,991) * lu(k,1465) - lu(k,1467) = lu(k,1467) - lu(k,992) * lu(k,1465) - lu(k,1468) = lu(k,1468) - lu(k,993) * lu(k,1465) - lu(k,1469) = lu(k,1469) - lu(k,994) * lu(k,1465) - lu(k,1470) = lu(k,1470) - lu(k,995) * lu(k,1465) - lu(k,1471) = lu(k,1471) - lu(k,996) * lu(k,1465) - lu(k,1472) = lu(k,1472) - lu(k,997) * lu(k,1465) - lu(k,1473) = lu(k,1473) - lu(k,998) * lu(k,1465) - lu(k,1474) = lu(k,1474) - lu(k,999) * lu(k,1465) - lu(k,1475) = lu(k,1475) - lu(k,1000) * lu(k,1465) - lu(k,1476) = lu(k,1476) - lu(k,1001) * lu(k,1465) - lu(k,1477) = lu(k,1477) - lu(k,1002) * lu(k,1465) - lu(k,1478) = lu(k,1478) - lu(k,1003) * lu(k,1465) - lu(k,1479) = lu(k,1479) - lu(k,1004) * lu(k,1465) - lu(k,1480) = lu(k,1480) - lu(k,1005) * lu(k,1465) - lu(k,1481) = lu(k,1481) - lu(k,1006) * lu(k,1465) - lu(k,1482) = lu(k,1482) - lu(k,1007) * lu(k,1465) - lu(k,1483) = lu(k,1483) - lu(k,1008) * lu(k,1465) - lu(k,1484) = lu(k,1484) - lu(k,1009) * lu(k,1465) - lu(k,1485) = lu(k,1485) - lu(k,1010) * lu(k,1465) - lu(k,1507) = lu(k,1507) - lu(k,991) * lu(k,1506) - lu(k,1508) = lu(k,1508) - lu(k,992) * lu(k,1506) - lu(k,1509) = lu(k,1509) - lu(k,993) * lu(k,1506) - lu(k,1510) = lu(k,1510) - lu(k,994) * lu(k,1506) - lu(k,1511) = lu(k,1511) - lu(k,995) * lu(k,1506) - lu(k,1512) = lu(k,1512) - lu(k,996) * lu(k,1506) - lu(k,1513) = lu(k,1513) - lu(k,997) * lu(k,1506) - lu(k,1514) = lu(k,1514) - lu(k,998) * lu(k,1506) - lu(k,1515) = lu(k,1515) - lu(k,999) * lu(k,1506) - lu(k,1516) = lu(k,1516) - lu(k,1000) * lu(k,1506) - lu(k,1517) = lu(k,1517) - lu(k,1001) * lu(k,1506) - lu(k,1518) = lu(k,1518) - lu(k,1002) * lu(k,1506) - lu(k,1519) = lu(k,1519) - lu(k,1003) * lu(k,1506) - lu(k,1520) = lu(k,1520) - lu(k,1004) * lu(k,1506) - lu(k,1521) = lu(k,1521) - lu(k,1005) * lu(k,1506) - lu(k,1522) = lu(k,1522) - lu(k,1006) * lu(k,1506) - lu(k,1523) = lu(k,1523) - lu(k,1007) * lu(k,1506) - lu(k,1524) = lu(k,1524) - lu(k,1008) * lu(k,1506) - lu(k,1525) = lu(k,1525) - lu(k,1009) * lu(k,1506) - lu(k,1526) = lu(k,1526) - lu(k,1010) * lu(k,1506) - lu(k,1549) = lu(k,1549) - lu(k,991) * lu(k,1548) - lu(k,1550) = lu(k,1550) - lu(k,992) * lu(k,1548) - lu(k,1551) = lu(k,1551) - lu(k,993) * lu(k,1548) - lu(k,1552) = lu(k,1552) - lu(k,994) * lu(k,1548) - lu(k,1553) = lu(k,1553) - lu(k,995) * lu(k,1548) - lu(k,1554) = lu(k,1554) - lu(k,996) * lu(k,1548) - lu(k,1555) = lu(k,1555) - lu(k,997) * lu(k,1548) - lu(k,1556) = lu(k,1556) - lu(k,998) * lu(k,1548) - lu(k,1557) = lu(k,1557) - lu(k,999) * lu(k,1548) - lu(k,1558) = lu(k,1558) - lu(k,1000) * lu(k,1548) - lu(k,1559) = lu(k,1559) - lu(k,1001) * lu(k,1548) - lu(k,1560) = lu(k,1560) - lu(k,1002) * lu(k,1548) - lu(k,1561) = lu(k,1561) - lu(k,1003) * lu(k,1548) - lu(k,1562) = lu(k,1562) - lu(k,1004) * lu(k,1548) - lu(k,1563) = lu(k,1563) - lu(k,1005) * lu(k,1548) - lu(k,1564) = lu(k,1564) - lu(k,1006) * lu(k,1548) - lu(k,1565) = lu(k,1565) - lu(k,1007) * lu(k,1548) - lu(k,1566) = lu(k,1566) - lu(k,1008) * lu(k,1548) - lu(k,1567) = lu(k,1567) - lu(k,1009) * lu(k,1548) - lu(k,1568) = lu(k,1568) - lu(k,1010) * lu(k,1548) - lu(k,1591) = lu(k,1591) - lu(k,991) * lu(k,1590) - lu(k,1592) = lu(k,1592) - lu(k,992) * lu(k,1590) - lu(k,1593) = lu(k,1593) - lu(k,993) * lu(k,1590) - lu(k,1594) = lu(k,1594) - lu(k,994) * lu(k,1590) - lu(k,1595) = lu(k,1595) - lu(k,995) * lu(k,1590) - lu(k,1596) = lu(k,1596) - lu(k,996) * lu(k,1590) - lu(k,1597) = lu(k,1597) - lu(k,997) * lu(k,1590) - lu(k,1598) = lu(k,1598) - lu(k,998) * lu(k,1590) - lu(k,1599) = lu(k,1599) - lu(k,999) * lu(k,1590) - lu(k,1600) = lu(k,1600) - lu(k,1000) * lu(k,1590) - lu(k,1601) = lu(k,1601) - lu(k,1001) * lu(k,1590) - lu(k,1602) = lu(k,1602) - lu(k,1002) * lu(k,1590) - lu(k,1603) = lu(k,1603) - lu(k,1003) * lu(k,1590) - lu(k,1604) = lu(k,1604) - lu(k,1004) * lu(k,1590) - lu(k,1605) = lu(k,1605) - lu(k,1005) * lu(k,1590) - lu(k,1606) = lu(k,1606) - lu(k,1006) * lu(k,1590) - lu(k,1607) = lu(k,1607) - lu(k,1007) * lu(k,1590) - lu(k,1608) = lu(k,1608) - lu(k,1008) * lu(k,1590) - lu(k,1609) = lu(k,1609) - lu(k,1009) * lu(k,1590) - lu(k,1610) = lu(k,1610) - lu(k,1010) * lu(k,1590) - lu(k,1623) = lu(k,1623) - lu(k,991) * lu(k,1622) - lu(k,1624) = lu(k,1624) - lu(k,992) * lu(k,1622) - lu(k,1625) = lu(k,1625) - lu(k,993) * lu(k,1622) - lu(k,1626) = lu(k,1626) - lu(k,994) * lu(k,1622) - lu(k,1627) = lu(k,1627) - lu(k,995) * lu(k,1622) - lu(k,1628) = lu(k,1628) - lu(k,996) * lu(k,1622) - lu(k,1629) = lu(k,1629) - lu(k,997) * lu(k,1622) - lu(k,1630) = lu(k,1630) - lu(k,998) * lu(k,1622) - lu(k,1631) = lu(k,1631) - lu(k,999) * lu(k,1622) - lu(k,1632) = lu(k,1632) - lu(k,1000) * lu(k,1622) - lu(k,1633) = lu(k,1633) - lu(k,1001) * lu(k,1622) - lu(k,1634) = lu(k,1634) - lu(k,1002) * lu(k,1622) - lu(k,1635) = lu(k,1635) - lu(k,1003) * lu(k,1622) - lu(k,1636) = lu(k,1636) - lu(k,1004) * lu(k,1622) - lu(k,1637) = lu(k,1637) - lu(k,1005) * lu(k,1622) - lu(k,1638) = lu(k,1638) - lu(k,1006) * lu(k,1622) - lu(k,1639) = lu(k,1639) - lu(k,1007) * lu(k,1622) - lu(k,1640) = lu(k,1640) - lu(k,1008) * lu(k,1622) - lu(k,1641) = lu(k,1641) - lu(k,1009) * lu(k,1622) - lu(k,1642) = lu(k,1642) - lu(k,1010) * lu(k,1622) - lu(k,1658) = lu(k,1658) - lu(k,991) * lu(k,1657) - lu(k,1659) = lu(k,1659) - lu(k,992) * lu(k,1657) - lu(k,1660) = lu(k,1660) - lu(k,993) * lu(k,1657) - lu(k,1661) = lu(k,1661) - lu(k,994) * lu(k,1657) - lu(k,1662) = lu(k,1662) - lu(k,995) * lu(k,1657) - lu(k,1663) = lu(k,1663) - lu(k,996) * lu(k,1657) - lu(k,1664) = lu(k,1664) - lu(k,997) * lu(k,1657) - lu(k,1665) = lu(k,1665) - lu(k,998) * lu(k,1657) - lu(k,1666) = lu(k,1666) - lu(k,999) * lu(k,1657) - lu(k,1667) = lu(k,1667) - lu(k,1000) * lu(k,1657) - lu(k,1668) = lu(k,1668) - lu(k,1001) * lu(k,1657) - lu(k,1669) = lu(k,1669) - lu(k,1002) * lu(k,1657) - lu(k,1670) = lu(k,1670) - lu(k,1003) * lu(k,1657) - lu(k,1671) = lu(k,1671) - lu(k,1004) * lu(k,1657) - lu(k,1672) = lu(k,1672) - lu(k,1005) * lu(k,1657) - lu(k,1673) = lu(k,1673) - lu(k,1006) * lu(k,1657) - lu(k,1674) = lu(k,1674) - lu(k,1007) * lu(k,1657) - lu(k,1675) = lu(k,1675) - lu(k,1008) * lu(k,1657) - lu(k,1676) = lu(k,1676) - lu(k,1009) * lu(k,1657) - lu(k,1677) = lu(k,1677) - lu(k,1010) * lu(k,1657) - lu(k,1700) = lu(k,1700) - lu(k,991) * lu(k,1699) - lu(k,1701) = lu(k,1701) - lu(k,992) * lu(k,1699) - lu(k,1702) = lu(k,1702) - lu(k,993) * lu(k,1699) - lu(k,1703) = lu(k,1703) - lu(k,994) * lu(k,1699) - lu(k,1704) = lu(k,1704) - lu(k,995) * lu(k,1699) - lu(k,1705) = lu(k,1705) - lu(k,996) * lu(k,1699) - lu(k,1706) = lu(k,1706) - lu(k,997) * lu(k,1699) - lu(k,1707) = lu(k,1707) - lu(k,998) * lu(k,1699) - lu(k,1708) = lu(k,1708) - lu(k,999) * lu(k,1699) - lu(k,1709) = lu(k,1709) - lu(k,1000) * lu(k,1699) - lu(k,1710) = lu(k,1710) - lu(k,1001) * lu(k,1699) - lu(k,1711) = lu(k,1711) - lu(k,1002) * lu(k,1699) - lu(k,1712) = lu(k,1712) - lu(k,1003) * lu(k,1699) - lu(k,1713) = lu(k,1713) - lu(k,1004) * lu(k,1699) - lu(k,1714) = lu(k,1714) - lu(k,1005) * lu(k,1699) - lu(k,1715) = lu(k,1715) - lu(k,1006) * lu(k,1699) - lu(k,1716) = lu(k,1716) - lu(k,1007) * lu(k,1699) - lu(k,1717) = lu(k,1717) - lu(k,1008) * lu(k,1699) - lu(k,1718) = lu(k,1718) - lu(k,1009) * lu(k,1699) - lu(k,1719) = lu(k,1719) - lu(k,1010) * lu(k,1699) - lu(k,1744) = lu(k,1744) - lu(k,991) * lu(k,1743) - lu(k,1745) = lu(k,1745) - lu(k,992) * lu(k,1743) - lu(k,1746) = lu(k,1746) - lu(k,993) * lu(k,1743) - lu(k,1747) = lu(k,1747) - lu(k,994) * lu(k,1743) - lu(k,1748) = lu(k,1748) - lu(k,995) * lu(k,1743) - lu(k,1749) = lu(k,1749) - lu(k,996) * lu(k,1743) - lu(k,1750) = lu(k,1750) - lu(k,997) * lu(k,1743) - lu(k,1751) = lu(k,1751) - lu(k,998) * lu(k,1743) - lu(k,1752) = lu(k,1752) - lu(k,999) * lu(k,1743) - lu(k,1753) = lu(k,1753) - lu(k,1000) * lu(k,1743) - lu(k,1754) = lu(k,1754) - lu(k,1001) * lu(k,1743) - lu(k,1755) = lu(k,1755) - lu(k,1002) * lu(k,1743) - lu(k,1756) = lu(k,1756) - lu(k,1003) * lu(k,1743) - lu(k,1757) = lu(k,1757) - lu(k,1004) * lu(k,1743) - lu(k,1758) = lu(k,1758) - lu(k,1005) * lu(k,1743) - lu(k,1759) = lu(k,1759) - lu(k,1006) * lu(k,1743) - lu(k,1760) = lu(k,1760) - lu(k,1007) * lu(k,1743) - lu(k,1761) = lu(k,1761) - lu(k,1008) * lu(k,1743) - lu(k,1762) = lu(k,1762) - lu(k,1009) * lu(k,1743) - lu(k,1763) = lu(k,1763) - lu(k,1010) * lu(k,1743) - lu(k,1779) = lu(k,1779) - lu(k,991) * lu(k,1778) - lu(k,1780) = lu(k,1780) - lu(k,992) * lu(k,1778) - lu(k,1781) = lu(k,1781) - lu(k,993) * lu(k,1778) - lu(k,1782) = lu(k,1782) - lu(k,994) * lu(k,1778) - lu(k,1783) = lu(k,1783) - lu(k,995) * lu(k,1778) - lu(k,1784) = lu(k,1784) - lu(k,996) * lu(k,1778) - lu(k,1785) = lu(k,1785) - lu(k,997) * lu(k,1778) - lu(k,1786) = lu(k,1786) - lu(k,998) * lu(k,1778) - lu(k,1787) = lu(k,1787) - lu(k,999) * lu(k,1778) - lu(k,1788) = lu(k,1788) - lu(k,1000) * lu(k,1778) - lu(k,1789) = lu(k,1789) - lu(k,1001) * lu(k,1778) - lu(k,1790) = lu(k,1790) - lu(k,1002) * lu(k,1778) - lu(k,1791) = lu(k,1791) - lu(k,1003) * lu(k,1778) - lu(k,1792) = lu(k,1792) - lu(k,1004) * lu(k,1778) - lu(k,1793) = lu(k,1793) - lu(k,1005) * lu(k,1778) - lu(k,1794) = lu(k,1794) - lu(k,1006) * lu(k,1778) - lu(k,1795) = lu(k,1795) - lu(k,1007) * lu(k,1778) - lu(k,1796) = lu(k,1796) - lu(k,1008) * lu(k,1778) - lu(k,1797) = lu(k,1797) - lu(k,1009) * lu(k,1778) - lu(k,1798) = lu(k,1798) - lu(k,1010) * lu(k,1778) - lu(k,1837) = lu(k,1837) - lu(k,991) * lu(k,1836) - lu(k,1838) = lu(k,1838) - lu(k,992) * lu(k,1836) - lu(k,1839) = lu(k,1839) - lu(k,993) * lu(k,1836) - lu(k,1840) = lu(k,1840) - lu(k,994) * lu(k,1836) - lu(k,1841) = lu(k,1841) - lu(k,995) * lu(k,1836) - lu(k,1842) = lu(k,1842) - lu(k,996) * lu(k,1836) - lu(k,1843) = lu(k,1843) - lu(k,997) * lu(k,1836) - lu(k,1844) = lu(k,1844) - lu(k,998) * lu(k,1836) - lu(k,1845) = lu(k,1845) - lu(k,999) * lu(k,1836) - lu(k,1846) = lu(k,1846) - lu(k,1000) * lu(k,1836) - lu(k,1847) = lu(k,1847) - lu(k,1001) * lu(k,1836) - lu(k,1848) = lu(k,1848) - lu(k,1002) * lu(k,1836) - lu(k,1849) = lu(k,1849) - lu(k,1003) * lu(k,1836) - lu(k,1850) = lu(k,1850) - lu(k,1004) * lu(k,1836) - lu(k,1851) = lu(k,1851) - lu(k,1005) * lu(k,1836) - lu(k,1852) = lu(k,1852) - lu(k,1006) * lu(k,1836) - lu(k,1853) = lu(k,1853) - lu(k,1007) * lu(k,1836) - lu(k,1854) = lu(k,1854) - lu(k,1008) * lu(k,1836) - lu(k,1855) = lu(k,1855) - lu(k,1009) * lu(k,1836) - lu(k,1856) = lu(k,1856) - lu(k,1010) * lu(k,1836) - lu(k,1033) = 1._r8 / lu(k,1033) - lu(k,1034) = lu(k,1034) * lu(k,1033) - lu(k,1035) = lu(k,1035) * lu(k,1033) - lu(k,1036) = lu(k,1036) * lu(k,1033) - lu(k,1037) = lu(k,1037) * lu(k,1033) - lu(k,1038) = lu(k,1038) * lu(k,1033) - lu(k,1039) = lu(k,1039) * lu(k,1033) - lu(k,1040) = lu(k,1040) * lu(k,1033) - lu(k,1041) = lu(k,1041) * lu(k,1033) - lu(k,1042) = lu(k,1042) * lu(k,1033) - lu(k,1043) = lu(k,1043) * lu(k,1033) - lu(k,1044) = lu(k,1044) * lu(k,1033) - lu(k,1045) = lu(k,1045) * lu(k,1033) - lu(k,1046) = lu(k,1046) * lu(k,1033) - lu(k,1047) = lu(k,1047) * lu(k,1033) - lu(k,1048) = lu(k,1048) * lu(k,1033) - lu(k,1049) = lu(k,1049) * lu(k,1033) - lu(k,1050) = lu(k,1050) * lu(k,1033) - lu(k,1051) = lu(k,1051) * lu(k,1033) - lu(k,1052) = lu(k,1052) * lu(k,1033) - lu(k,1075) = lu(k,1075) - lu(k,1034) * lu(k,1074) - lu(k,1076) = lu(k,1076) - lu(k,1035) * lu(k,1074) - lu(k,1077) = lu(k,1077) - lu(k,1036) * lu(k,1074) - lu(k,1078) = lu(k,1078) - lu(k,1037) * lu(k,1074) - lu(k,1079) = lu(k,1079) - lu(k,1038) * lu(k,1074) - lu(k,1080) = lu(k,1080) - lu(k,1039) * lu(k,1074) - lu(k,1081) = lu(k,1081) - lu(k,1040) * lu(k,1074) - lu(k,1082) = lu(k,1082) - lu(k,1041) * lu(k,1074) - lu(k,1083) = lu(k,1083) - lu(k,1042) * lu(k,1074) - lu(k,1084) = lu(k,1084) - lu(k,1043) * lu(k,1074) - lu(k,1085) = lu(k,1085) - lu(k,1044) * lu(k,1074) - lu(k,1086) = lu(k,1086) - lu(k,1045) * lu(k,1074) - lu(k,1087) = lu(k,1087) - lu(k,1046) * lu(k,1074) - lu(k,1088) = lu(k,1088) - lu(k,1047) * lu(k,1074) - lu(k,1089) = lu(k,1089) - lu(k,1048) * lu(k,1074) - lu(k,1090) = lu(k,1090) - lu(k,1049) * lu(k,1074) - lu(k,1091) = lu(k,1091) - lu(k,1050) * lu(k,1074) - lu(k,1092) = lu(k,1092) - lu(k,1051) * lu(k,1074) - lu(k,1093) = lu(k,1093) - lu(k,1052) * lu(k,1074) - lu(k,1114) = lu(k,1114) - lu(k,1034) * lu(k,1113) - lu(k,1115) = lu(k,1115) - lu(k,1035) * lu(k,1113) - lu(k,1116) = lu(k,1116) - lu(k,1036) * lu(k,1113) - lu(k,1117) = lu(k,1117) - lu(k,1037) * lu(k,1113) - lu(k,1118) = lu(k,1118) - lu(k,1038) * lu(k,1113) - lu(k,1119) = lu(k,1119) - lu(k,1039) * lu(k,1113) - lu(k,1120) = lu(k,1120) - lu(k,1040) * lu(k,1113) - lu(k,1121) = lu(k,1121) - lu(k,1041) * lu(k,1113) - lu(k,1122) = lu(k,1122) - lu(k,1042) * lu(k,1113) - lu(k,1123) = lu(k,1123) - lu(k,1043) * lu(k,1113) - lu(k,1124) = lu(k,1124) - lu(k,1044) * lu(k,1113) - lu(k,1125) = lu(k,1125) - lu(k,1045) * lu(k,1113) - lu(k,1126) = lu(k,1126) - lu(k,1046) * lu(k,1113) - lu(k,1127) = lu(k,1127) - lu(k,1047) * lu(k,1113) - lu(k,1128) = lu(k,1128) - lu(k,1048) * lu(k,1113) - lu(k,1129) = lu(k,1129) - lu(k,1049) * lu(k,1113) - lu(k,1130) = lu(k,1130) - lu(k,1050) * lu(k,1113) - lu(k,1131) = lu(k,1131) - lu(k,1051) * lu(k,1113) - lu(k,1132) = lu(k,1132) - lu(k,1052) * lu(k,1113) - lu(k,1158) = lu(k,1158) - lu(k,1034) * lu(k,1157) - lu(k,1159) = lu(k,1159) - lu(k,1035) * lu(k,1157) - lu(k,1160) = lu(k,1160) - lu(k,1036) * lu(k,1157) - lu(k,1161) = lu(k,1161) - lu(k,1037) * lu(k,1157) - lu(k,1162) = lu(k,1162) - lu(k,1038) * lu(k,1157) - lu(k,1163) = lu(k,1163) - lu(k,1039) * lu(k,1157) - lu(k,1164) = lu(k,1164) - lu(k,1040) * lu(k,1157) - lu(k,1165) = lu(k,1165) - lu(k,1041) * lu(k,1157) - lu(k,1166) = lu(k,1166) - lu(k,1042) * lu(k,1157) - lu(k,1167) = lu(k,1167) - lu(k,1043) * lu(k,1157) - lu(k,1168) = lu(k,1168) - lu(k,1044) * lu(k,1157) - lu(k,1169) = lu(k,1169) - lu(k,1045) * lu(k,1157) - lu(k,1170) = lu(k,1170) - lu(k,1046) * lu(k,1157) - lu(k,1171) = lu(k,1171) - lu(k,1047) * lu(k,1157) - lu(k,1172) = lu(k,1172) - lu(k,1048) * lu(k,1157) - lu(k,1173) = lu(k,1173) - lu(k,1049) * lu(k,1157) - lu(k,1174) = lu(k,1174) - lu(k,1050) * lu(k,1157) - lu(k,1175) = lu(k,1175) - lu(k,1051) * lu(k,1157) - lu(k,1176) = lu(k,1176) - lu(k,1052) * lu(k,1157) - lu(k,1199) = lu(k,1199) - lu(k,1034) * lu(k,1198) - lu(k,1200) = lu(k,1200) - lu(k,1035) * lu(k,1198) - lu(k,1201) = lu(k,1201) - lu(k,1036) * lu(k,1198) - lu(k,1202) = lu(k,1202) - lu(k,1037) * lu(k,1198) - lu(k,1203) = lu(k,1203) - lu(k,1038) * lu(k,1198) - lu(k,1204) = lu(k,1204) - lu(k,1039) * lu(k,1198) - lu(k,1205) = lu(k,1205) - lu(k,1040) * lu(k,1198) - lu(k,1206) = lu(k,1206) - lu(k,1041) * lu(k,1198) - lu(k,1207) = lu(k,1207) - lu(k,1042) * lu(k,1198) - lu(k,1208) = lu(k,1208) - lu(k,1043) * lu(k,1198) - lu(k,1209) = lu(k,1209) - lu(k,1044) * lu(k,1198) - lu(k,1210) = lu(k,1210) - lu(k,1045) * lu(k,1198) - lu(k,1211) = lu(k,1211) - lu(k,1046) * lu(k,1198) - lu(k,1212) = lu(k,1212) - lu(k,1047) * lu(k,1198) - lu(k,1213) = lu(k,1213) - lu(k,1048) * lu(k,1198) - lu(k,1214) = lu(k,1214) - lu(k,1049) * lu(k,1198) - lu(k,1215) = lu(k,1215) - lu(k,1050) * lu(k,1198) - lu(k,1216) = lu(k,1216) - lu(k,1051) * lu(k,1198) - lu(k,1217) = lu(k,1217) - lu(k,1052) * lu(k,1198) - lu(k,1248) = lu(k,1248) - lu(k,1034) * lu(k,1247) - lu(k,1249) = lu(k,1249) - lu(k,1035) * lu(k,1247) - lu(k,1250) = lu(k,1250) - lu(k,1036) * lu(k,1247) - lu(k,1251) = lu(k,1251) - lu(k,1037) * lu(k,1247) - lu(k,1252) = lu(k,1252) - lu(k,1038) * lu(k,1247) - lu(k,1253) = lu(k,1253) - lu(k,1039) * lu(k,1247) - lu(k,1254) = lu(k,1254) - lu(k,1040) * lu(k,1247) - lu(k,1255) = lu(k,1255) - lu(k,1041) * lu(k,1247) - lu(k,1256) = lu(k,1256) - lu(k,1042) * lu(k,1247) - lu(k,1257) = lu(k,1257) - lu(k,1043) * lu(k,1247) - lu(k,1258) = lu(k,1258) - lu(k,1044) * lu(k,1247) - lu(k,1259) = lu(k,1259) - lu(k,1045) * lu(k,1247) - lu(k,1260) = lu(k,1260) - lu(k,1046) * lu(k,1247) - lu(k,1261) = lu(k,1261) - lu(k,1047) * lu(k,1247) - lu(k,1262) = lu(k,1262) - lu(k,1048) * lu(k,1247) - lu(k,1263) = lu(k,1263) - lu(k,1049) * lu(k,1247) - lu(k,1264) = lu(k,1264) - lu(k,1050) * lu(k,1247) - lu(k,1265) = lu(k,1265) - lu(k,1051) * lu(k,1247) - lu(k,1266) = lu(k,1266) - lu(k,1052) * lu(k,1247) - lu(k,1287) = lu(k,1287) - lu(k,1034) * lu(k,1286) - lu(k,1288) = lu(k,1288) - lu(k,1035) * lu(k,1286) - lu(k,1289) = lu(k,1289) - lu(k,1036) * lu(k,1286) - lu(k,1290) = lu(k,1290) - lu(k,1037) * lu(k,1286) - lu(k,1291) = lu(k,1291) - lu(k,1038) * lu(k,1286) - lu(k,1292) = lu(k,1292) - lu(k,1039) * lu(k,1286) - lu(k,1293) = lu(k,1293) - lu(k,1040) * lu(k,1286) - lu(k,1294) = lu(k,1294) - lu(k,1041) * lu(k,1286) - lu(k,1295) = lu(k,1295) - lu(k,1042) * lu(k,1286) - lu(k,1296) = lu(k,1296) - lu(k,1043) * lu(k,1286) - lu(k,1297) = lu(k,1297) - lu(k,1044) * lu(k,1286) - lu(k,1298) = lu(k,1298) - lu(k,1045) * lu(k,1286) - lu(k,1299) = lu(k,1299) - lu(k,1046) * lu(k,1286) - lu(k,1300) = lu(k,1300) - lu(k,1047) * lu(k,1286) - lu(k,1301) = lu(k,1301) - lu(k,1048) * lu(k,1286) - lu(k,1302) = lu(k,1302) - lu(k,1049) * lu(k,1286) - lu(k,1303) = lu(k,1303) - lu(k,1050) * lu(k,1286) - lu(k,1304) = lu(k,1304) - lu(k,1051) * lu(k,1286) - lu(k,1305) = lu(k,1305) - lu(k,1052) * lu(k,1286) - lu(k,1322) = lu(k,1322) - lu(k,1034) * lu(k,1321) - lu(k,1323) = lu(k,1323) - lu(k,1035) * lu(k,1321) - lu(k,1324) = lu(k,1324) - lu(k,1036) * lu(k,1321) - lu(k,1325) = lu(k,1325) - lu(k,1037) * lu(k,1321) - lu(k,1326) = lu(k,1326) - lu(k,1038) * lu(k,1321) - lu(k,1327) = lu(k,1327) - lu(k,1039) * lu(k,1321) - lu(k,1328) = lu(k,1328) - lu(k,1040) * lu(k,1321) - lu(k,1329) = lu(k,1329) - lu(k,1041) * lu(k,1321) - lu(k,1330) = lu(k,1330) - lu(k,1042) * lu(k,1321) - lu(k,1331) = lu(k,1331) - lu(k,1043) * lu(k,1321) - lu(k,1332) = lu(k,1332) - lu(k,1044) * lu(k,1321) - lu(k,1333) = lu(k,1333) - lu(k,1045) * lu(k,1321) - lu(k,1334) = lu(k,1334) - lu(k,1046) * lu(k,1321) - lu(k,1335) = lu(k,1335) - lu(k,1047) * lu(k,1321) - lu(k,1336) = lu(k,1336) - lu(k,1048) * lu(k,1321) - lu(k,1337) = lu(k,1337) - lu(k,1049) * lu(k,1321) - lu(k,1338) = lu(k,1338) - lu(k,1050) * lu(k,1321) - lu(k,1339) = lu(k,1339) - lu(k,1051) * lu(k,1321) - lu(k,1340) = lu(k,1340) - lu(k,1052) * lu(k,1321) - lu(k,1366) = lu(k,1366) - lu(k,1034) * lu(k,1365) - lu(k,1367) = lu(k,1367) - lu(k,1035) * lu(k,1365) - lu(k,1368) = lu(k,1368) - lu(k,1036) * lu(k,1365) - lu(k,1369) = lu(k,1369) - lu(k,1037) * lu(k,1365) - lu(k,1370) = lu(k,1370) - lu(k,1038) * lu(k,1365) - lu(k,1371) = lu(k,1371) - lu(k,1039) * lu(k,1365) - lu(k,1372) = lu(k,1372) - lu(k,1040) * lu(k,1365) - lu(k,1373) = lu(k,1373) - lu(k,1041) * lu(k,1365) - lu(k,1374) = lu(k,1374) - lu(k,1042) * lu(k,1365) - lu(k,1375) = lu(k,1375) - lu(k,1043) * lu(k,1365) - lu(k,1376) = lu(k,1376) - lu(k,1044) * lu(k,1365) - lu(k,1377) = lu(k,1377) - lu(k,1045) * lu(k,1365) - lu(k,1378) = lu(k,1378) - lu(k,1046) * lu(k,1365) - lu(k,1379) = lu(k,1379) - lu(k,1047) * lu(k,1365) - lu(k,1380) = lu(k,1380) - lu(k,1048) * lu(k,1365) - lu(k,1381) = lu(k,1381) - lu(k,1049) * lu(k,1365) - lu(k,1382) = lu(k,1382) - lu(k,1050) * lu(k,1365) - lu(k,1383) = lu(k,1383) - lu(k,1051) * lu(k,1365) - lu(k,1384) = lu(k,1384) - lu(k,1052) * lu(k,1365) - lu(k,1425) = lu(k,1425) - lu(k,1034) * lu(k,1424) - lu(k,1426) = lu(k,1426) - lu(k,1035) * lu(k,1424) - lu(k,1427) = lu(k,1427) - lu(k,1036) * lu(k,1424) - lu(k,1428) = lu(k,1428) - lu(k,1037) * lu(k,1424) - lu(k,1429) = lu(k,1429) - lu(k,1038) * lu(k,1424) - lu(k,1430) = lu(k,1430) - lu(k,1039) * lu(k,1424) - lu(k,1431) = lu(k,1431) - lu(k,1040) * lu(k,1424) - lu(k,1432) = lu(k,1432) - lu(k,1041) * lu(k,1424) - lu(k,1433) = lu(k,1433) - lu(k,1042) * lu(k,1424) - lu(k,1434) = lu(k,1434) - lu(k,1043) * lu(k,1424) - lu(k,1435) = lu(k,1435) - lu(k,1044) * lu(k,1424) - lu(k,1436) = lu(k,1436) - lu(k,1045) * lu(k,1424) - lu(k,1437) = lu(k,1437) - lu(k,1046) * lu(k,1424) - lu(k,1438) = lu(k,1438) - lu(k,1047) * lu(k,1424) - lu(k,1439) = lu(k,1439) - lu(k,1048) * lu(k,1424) - lu(k,1440) = lu(k,1440) - lu(k,1049) * lu(k,1424) - lu(k,1441) = lu(k,1441) - lu(k,1050) * lu(k,1424) - lu(k,1442) = lu(k,1442) - lu(k,1051) * lu(k,1424) - lu(k,1443) = lu(k,1443) - lu(k,1052) * lu(k,1424) - lu(k,1467) = lu(k,1467) - lu(k,1034) * lu(k,1466) - lu(k,1468) = lu(k,1468) - lu(k,1035) * lu(k,1466) - lu(k,1469) = lu(k,1469) - lu(k,1036) * lu(k,1466) - lu(k,1470) = lu(k,1470) - lu(k,1037) * lu(k,1466) - lu(k,1471) = lu(k,1471) - lu(k,1038) * lu(k,1466) - lu(k,1472) = lu(k,1472) - lu(k,1039) * lu(k,1466) - lu(k,1473) = lu(k,1473) - lu(k,1040) * lu(k,1466) - lu(k,1474) = lu(k,1474) - lu(k,1041) * lu(k,1466) - lu(k,1475) = lu(k,1475) - lu(k,1042) * lu(k,1466) - lu(k,1476) = lu(k,1476) - lu(k,1043) * lu(k,1466) - lu(k,1477) = lu(k,1477) - lu(k,1044) * lu(k,1466) - lu(k,1478) = lu(k,1478) - lu(k,1045) * lu(k,1466) - lu(k,1479) = lu(k,1479) - lu(k,1046) * lu(k,1466) - lu(k,1480) = lu(k,1480) - lu(k,1047) * lu(k,1466) - lu(k,1481) = lu(k,1481) - lu(k,1048) * lu(k,1466) - lu(k,1482) = lu(k,1482) - lu(k,1049) * lu(k,1466) - lu(k,1483) = lu(k,1483) - lu(k,1050) * lu(k,1466) - lu(k,1484) = lu(k,1484) - lu(k,1051) * lu(k,1466) - lu(k,1485) = lu(k,1485) - lu(k,1052) * lu(k,1466) - lu(k,1508) = lu(k,1508) - lu(k,1034) * lu(k,1507) - lu(k,1509) = lu(k,1509) - lu(k,1035) * lu(k,1507) - lu(k,1510) = lu(k,1510) - lu(k,1036) * lu(k,1507) - lu(k,1511) = lu(k,1511) - lu(k,1037) * lu(k,1507) - lu(k,1512) = lu(k,1512) - lu(k,1038) * lu(k,1507) - lu(k,1513) = lu(k,1513) - lu(k,1039) * lu(k,1507) - lu(k,1514) = lu(k,1514) - lu(k,1040) * lu(k,1507) - lu(k,1515) = lu(k,1515) - lu(k,1041) * lu(k,1507) - lu(k,1516) = lu(k,1516) - lu(k,1042) * lu(k,1507) - lu(k,1517) = lu(k,1517) - lu(k,1043) * lu(k,1507) - lu(k,1518) = lu(k,1518) - lu(k,1044) * lu(k,1507) - lu(k,1519) = lu(k,1519) - lu(k,1045) * lu(k,1507) - lu(k,1520) = lu(k,1520) - lu(k,1046) * lu(k,1507) - lu(k,1521) = lu(k,1521) - lu(k,1047) * lu(k,1507) - lu(k,1522) = lu(k,1522) - lu(k,1048) * lu(k,1507) - lu(k,1523) = lu(k,1523) - lu(k,1049) * lu(k,1507) - lu(k,1524) = lu(k,1524) - lu(k,1050) * lu(k,1507) - lu(k,1525) = lu(k,1525) - lu(k,1051) * lu(k,1507) - lu(k,1526) = lu(k,1526) - lu(k,1052) * lu(k,1507) - lu(k,1550) = lu(k,1550) - lu(k,1034) * lu(k,1549) - lu(k,1551) = lu(k,1551) - lu(k,1035) * lu(k,1549) - lu(k,1552) = lu(k,1552) - lu(k,1036) * lu(k,1549) - lu(k,1553) = lu(k,1553) - lu(k,1037) * lu(k,1549) - lu(k,1554) = lu(k,1554) - lu(k,1038) * lu(k,1549) - lu(k,1555) = lu(k,1555) - lu(k,1039) * lu(k,1549) - lu(k,1556) = lu(k,1556) - lu(k,1040) * lu(k,1549) - lu(k,1557) = lu(k,1557) - lu(k,1041) * lu(k,1549) - lu(k,1558) = lu(k,1558) - lu(k,1042) * lu(k,1549) - lu(k,1559) = lu(k,1559) - lu(k,1043) * lu(k,1549) - lu(k,1560) = lu(k,1560) - lu(k,1044) * lu(k,1549) - lu(k,1561) = lu(k,1561) - lu(k,1045) * lu(k,1549) - lu(k,1562) = lu(k,1562) - lu(k,1046) * lu(k,1549) - lu(k,1563) = lu(k,1563) - lu(k,1047) * lu(k,1549) - lu(k,1564) = lu(k,1564) - lu(k,1048) * lu(k,1549) - lu(k,1565) = lu(k,1565) - lu(k,1049) * lu(k,1549) - lu(k,1566) = lu(k,1566) - lu(k,1050) * lu(k,1549) - lu(k,1567) = lu(k,1567) - lu(k,1051) * lu(k,1549) - lu(k,1568) = lu(k,1568) - lu(k,1052) * lu(k,1549) - lu(k,1592) = lu(k,1592) - lu(k,1034) * lu(k,1591) - lu(k,1593) = lu(k,1593) - lu(k,1035) * lu(k,1591) - lu(k,1594) = lu(k,1594) - lu(k,1036) * lu(k,1591) - lu(k,1595) = lu(k,1595) - lu(k,1037) * lu(k,1591) - lu(k,1596) = lu(k,1596) - lu(k,1038) * lu(k,1591) - lu(k,1597) = lu(k,1597) - lu(k,1039) * lu(k,1591) - lu(k,1598) = lu(k,1598) - lu(k,1040) * lu(k,1591) - lu(k,1599) = lu(k,1599) - lu(k,1041) * lu(k,1591) - lu(k,1600) = lu(k,1600) - lu(k,1042) * lu(k,1591) - lu(k,1601) = lu(k,1601) - lu(k,1043) * lu(k,1591) - lu(k,1602) = lu(k,1602) - lu(k,1044) * lu(k,1591) - lu(k,1603) = lu(k,1603) - lu(k,1045) * lu(k,1591) - lu(k,1604) = lu(k,1604) - lu(k,1046) * lu(k,1591) - lu(k,1605) = lu(k,1605) - lu(k,1047) * lu(k,1591) - lu(k,1606) = lu(k,1606) - lu(k,1048) * lu(k,1591) - lu(k,1607) = lu(k,1607) - lu(k,1049) * lu(k,1591) - lu(k,1608) = lu(k,1608) - lu(k,1050) * lu(k,1591) - lu(k,1609) = lu(k,1609) - lu(k,1051) * lu(k,1591) - lu(k,1610) = lu(k,1610) - lu(k,1052) * lu(k,1591) - lu(k,1624) = lu(k,1624) - lu(k,1034) * lu(k,1623) - lu(k,1625) = lu(k,1625) - lu(k,1035) * lu(k,1623) - lu(k,1626) = lu(k,1626) - lu(k,1036) * lu(k,1623) - lu(k,1627) = lu(k,1627) - lu(k,1037) * lu(k,1623) - lu(k,1628) = lu(k,1628) - lu(k,1038) * lu(k,1623) - lu(k,1629) = lu(k,1629) - lu(k,1039) * lu(k,1623) - lu(k,1630) = lu(k,1630) - lu(k,1040) * lu(k,1623) - lu(k,1631) = lu(k,1631) - lu(k,1041) * lu(k,1623) - lu(k,1632) = lu(k,1632) - lu(k,1042) * lu(k,1623) - lu(k,1633) = lu(k,1633) - lu(k,1043) * lu(k,1623) - lu(k,1634) = lu(k,1634) - lu(k,1044) * lu(k,1623) - lu(k,1635) = lu(k,1635) - lu(k,1045) * lu(k,1623) - lu(k,1636) = lu(k,1636) - lu(k,1046) * lu(k,1623) - lu(k,1637) = lu(k,1637) - lu(k,1047) * lu(k,1623) - lu(k,1638) = lu(k,1638) - lu(k,1048) * lu(k,1623) - lu(k,1639) = lu(k,1639) - lu(k,1049) * lu(k,1623) - lu(k,1640) = lu(k,1640) - lu(k,1050) * lu(k,1623) - lu(k,1641) = lu(k,1641) - lu(k,1051) * lu(k,1623) - lu(k,1642) = lu(k,1642) - lu(k,1052) * lu(k,1623) - lu(k,1659) = lu(k,1659) - lu(k,1034) * lu(k,1658) - lu(k,1660) = lu(k,1660) - lu(k,1035) * lu(k,1658) - lu(k,1661) = lu(k,1661) - lu(k,1036) * lu(k,1658) - lu(k,1662) = lu(k,1662) - lu(k,1037) * lu(k,1658) - lu(k,1663) = lu(k,1663) - lu(k,1038) * lu(k,1658) - lu(k,1664) = lu(k,1664) - lu(k,1039) * lu(k,1658) - lu(k,1665) = lu(k,1665) - lu(k,1040) * lu(k,1658) - lu(k,1666) = lu(k,1666) - lu(k,1041) * lu(k,1658) - lu(k,1667) = lu(k,1667) - lu(k,1042) * lu(k,1658) - lu(k,1668) = lu(k,1668) - lu(k,1043) * lu(k,1658) - lu(k,1669) = lu(k,1669) - lu(k,1044) * lu(k,1658) - lu(k,1670) = lu(k,1670) - lu(k,1045) * lu(k,1658) - lu(k,1671) = lu(k,1671) - lu(k,1046) * lu(k,1658) - lu(k,1672) = lu(k,1672) - lu(k,1047) * lu(k,1658) - lu(k,1673) = lu(k,1673) - lu(k,1048) * lu(k,1658) - lu(k,1674) = lu(k,1674) - lu(k,1049) * lu(k,1658) - lu(k,1675) = lu(k,1675) - lu(k,1050) * lu(k,1658) - lu(k,1676) = lu(k,1676) - lu(k,1051) * lu(k,1658) - lu(k,1677) = lu(k,1677) - lu(k,1052) * lu(k,1658) - lu(k,1701) = lu(k,1701) - lu(k,1034) * lu(k,1700) - lu(k,1702) = lu(k,1702) - lu(k,1035) * lu(k,1700) - lu(k,1703) = lu(k,1703) - lu(k,1036) * lu(k,1700) - lu(k,1704) = lu(k,1704) - lu(k,1037) * lu(k,1700) - lu(k,1705) = lu(k,1705) - lu(k,1038) * lu(k,1700) - lu(k,1706) = lu(k,1706) - lu(k,1039) * lu(k,1700) - lu(k,1707) = lu(k,1707) - lu(k,1040) * lu(k,1700) - lu(k,1708) = lu(k,1708) - lu(k,1041) * lu(k,1700) - lu(k,1709) = lu(k,1709) - lu(k,1042) * lu(k,1700) - lu(k,1710) = lu(k,1710) - lu(k,1043) * lu(k,1700) - lu(k,1711) = lu(k,1711) - lu(k,1044) * lu(k,1700) - lu(k,1712) = lu(k,1712) - lu(k,1045) * lu(k,1700) - lu(k,1713) = lu(k,1713) - lu(k,1046) * lu(k,1700) - lu(k,1714) = lu(k,1714) - lu(k,1047) * lu(k,1700) - lu(k,1715) = lu(k,1715) - lu(k,1048) * lu(k,1700) - lu(k,1716) = lu(k,1716) - lu(k,1049) * lu(k,1700) - lu(k,1717) = lu(k,1717) - lu(k,1050) * lu(k,1700) - lu(k,1718) = lu(k,1718) - lu(k,1051) * lu(k,1700) - lu(k,1719) = lu(k,1719) - lu(k,1052) * lu(k,1700) - lu(k,1745) = lu(k,1745) - lu(k,1034) * lu(k,1744) - lu(k,1746) = lu(k,1746) - lu(k,1035) * lu(k,1744) - lu(k,1747) = lu(k,1747) - lu(k,1036) * lu(k,1744) - lu(k,1748) = lu(k,1748) - lu(k,1037) * lu(k,1744) - lu(k,1749) = lu(k,1749) - lu(k,1038) * lu(k,1744) - lu(k,1750) = lu(k,1750) - lu(k,1039) * lu(k,1744) - lu(k,1751) = lu(k,1751) - lu(k,1040) * lu(k,1744) - lu(k,1752) = lu(k,1752) - lu(k,1041) * lu(k,1744) - lu(k,1753) = lu(k,1753) - lu(k,1042) * lu(k,1744) - lu(k,1754) = lu(k,1754) - lu(k,1043) * lu(k,1744) - lu(k,1755) = lu(k,1755) - lu(k,1044) * lu(k,1744) - lu(k,1756) = lu(k,1756) - lu(k,1045) * lu(k,1744) - lu(k,1757) = lu(k,1757) - lu(k,1046) * lu(k,1744) - lu(k,1758) = lu(k,1758) - lu(k,1047) * lu(k,1744) - lu(k,1759) = lu(k,1759) - lu(k,1048) * lu(k,1744) - lu(k,1760) = lu(k,1760) - lu(k,1049) * lu(k,1744) - lu(k,1761) = lu(k,1761) - lu(k,1050) * lu(k,1744) - lu(k,1762) = lu(k,1762) - lu(k,1051) * lu(k,1744) - lu(k,1763) = lu(k,1763) - lu(k,1052) * lu(k,1744) - lu(k,1780) = lu(k,1780) - lu(k,1034) * lu(k,1779) - lu(k,1781) = lu(k,1781) - lu(k,1035) * lu(k,1779) - lu(k,1782) = lu(k,1782) - lu(k,1036) * lu(k,1779) - lu(k,1783) = lu(k,1783) - lu(k,1037) * lu(k,1779) - lu(k,1784) = lu(k,1784) - lu(k,1038) * lu(k,1779) - lu(k,1785) = lu(k,1785) - lu(k,1039) * lu(k,1779) - lu(k,1786) = lu(k,1786) - lu(k,1040) * lu(k,1779) - lu(k,1787) = lu(k,1787) - lu(k,1041) * lu(k,1779) - lu(k,1788) = lu(k,1788) - lu(k,1042) * lu(k,1779) - lu(k,1789) = lu(k,1789) - lu(k,1043) * lu(k,1779) - lu(k,1790) = lu(k,1790) - lu(k,1044) * lu(k,1779) - lu(k,1791) = lu(k,1791) - lu(k,1045) * lu(k,1779) - lu(k,1792) = lu(k,1792) - lu(k,1046) * lu(k,1779) - lu(k,1793) = lu(k,1793) - lu(k,1047) * lu(k,1779) - lu(k,1794) = lu(k,1794) - lu(k,1048) * lu(k,1779) - lu(k,1795) = lu(k,1795) - lu(k,1049) * lu(k,1779) - lu(k,1796) = lu(k,1796) - lu(k,1050) * lu(k,1779) - lu(k,1797) = lu(k,1797) - lu(k,1051) * lu(k,1779) - lu(k,1798) = lu(k,1798) - lu(k,1052) * lu(k,1779) - lu(k,1838) = lu(k,1838) - lu(k,1034) * lu(k,1837) - lu(k,1839) = lu(k,1839) - lu(k,1035) * lu(k,1837) - lu(k,1840) = lu(k,1840) - lu(k,1036) * lu(k,1837) - lu(k,1841) = lu(k,1841) - lu(k,1037) * lu(k,1837) - lu(k,1842) = lu(k,1842) - lu(k,1038) * lu(k,1837) - lu(k,1843) = lu(k,1843) - lu(k,1039) * lu(k,1837) - lu(k,1844) = lu(k,1844) - lu(k,1040) * lu(k,1837) - lu(k,1845) = lu(k,1845) - lu(k,1041) * lu(k,1837) - lu(k,1846) = lu(k,1846) - lu(k,1042) * lu(k,1837) - lu(k,1847) = lu(k,1847) - lu(k,1043) * lu(k,1837) - lu(k,1848) = lu(k,1848) - lu(k,1044) * lu(k,1837) - lu(k,1849) = lu(k,1849) - lu(k,1045) * lu(k,1837) - lu(k,1850) = lu(k,1850) - lu(k,1046) * lu(k,1837) - lu(k,1851) = lu(k,1851) - lu(k,1047) * lu(k,1837) - lu(k,1852) = lu(k,1852) - lu(k,1048) * lu(k,1837) - lu(k,1853) = lu(k,1853) - lu(k,1049) * lu(k,1837) - lu(k,1854) = lu(k,1854) - lu(k,1050) * lu(k,1837) - lu(k,1855) = lu(k,1855) - lu(k,1051) * lu(k,1837) - lu(k,1856) = lu(k,1856) - lu(k,1052) * lu(k,1837) - lu(k,1075) = 1._r8 / lu(k,1075) - lu(k,1076) = lu(k,1076) * lu(k,1075) - lu(k,1077) = lu(k,1077) * lu(k,1075) - lu(k,1078) = lu(k,1078) * lu(k,1075) - lu(k,1079) = lu(k,1079) * lu(k,1075) - lu(k,1080) = lu(k,1080) * lu(k,1075) - lu(k,1081) = lu(k,1081) * lu(k,1075) - lu(k,1082) = lu(k,1082) * lu(k,1075) - lu(k,1083) = lu(k,1083) * lu(k,1075) - lu(k,1084) = lu(k,1084) * lu(k,1075) - lu(k,1085) = lu(k,1085) * lu(k,1075) - lu(k,1086) = lu(k,1086) * lu(k,1075) - lu(k,1087) = lu(k,1087) * lu(k,1075) - lu(k,1088) = lu(k,1088) * lu(k,1075) - lu(k,1089) = lu(k,1089) * lu(k,1075) - lu(k,1090) = lu(k,1090) * lu(k,1075) - lu(k,1091) = lu(k,1091) * lu(k,1075) - lu(k,1092) = lu(k,1092) * lu(k,1075) - lu(k,1093) = lu(k,1093) * lu(k,1075) - lu(k,1115) = lu(k,1115) - lu(k,1076) * lu(k,1114) - lu(k,1116) = lu(k,1116) - lu(k,1077) * lu(k,1114) - lu(k,1117) = lu(k,1117) - lu(k,1078) * lu(k,1114) - lu(k,1118) = lu(k,1118) - lu(k,1079) * lu(k,1114) - lu(k,1119) = lu(k,1119) - lu(k,1080) * lu(k,1114) - lu(k,1120) = lu(k,1120) - lu(k,1081) * lu(k,1114) - lu(k,1121) = lu(k,1121) - lu(k,1082) * lu(k,1114) - lu(k,1122) = lu(k,1122) - lu(k,1083) * lu(k,1114) - lu(k,1123) = lu(k,1123) - lu(k,1084) * lu(k,1114) - lu(k,1124) = lu(k,1124) - lu(k,1085) * lu(k,1114) - lu(k,1125) = lu(k,1125) - lu(k,1086) * lu(k,1114) - lu(k,1126) = lu(k,1126) - lu(k,1087) * lu(k,1114) - lu(k,1127) = lu(k,1127) - lu(k,1088) * lu(k,1114) - lu(k,1128) = lu(k,1128) - lu(k,1089) * lu(k,1114) - lu(k,1129) = lu(k,1129) - lu(k,1090) * lu(k,1114) - lu(k,1130) = lu(k,1130) - lu(k,1091) * lu(k,1114) - lu(k,1131) = lu(k,1131) - lu(k,1092) * lu(k,1114) - lu(k,1132) = lu(k,1132) - lu(k,1093) * lu(k,1114) - lu(k,1159) = lu(k,1159) - lu(k,1076) * lu(k,1158) - lu(k,1160) = lu(k,1160) - lu(k,1077) * lu(k,1158) - lu(k,1161) = lu(k,1161) - lu(k,1078) * lu(k,1158) - lu(k,1162) = lu(k,1162) - lu(k,1079) * lu(k,1158) - lu(k,1163) = lu(k,1163) - lu(k,1080) * lu(k,1158) - lu(k,1164) = lu(k,1164) - lu(k,1081) * lu(k,1158) - lu(k,1165) = lu(k,1165) - lu(k,1082) * lu(k,1158) - lu(k,1166) = lu(k,1166) - lu(k,1083) * lu(k,1158) - lu(k,1167) = lu(k,1167) - lu(k,1084) * lu(k,1158) - lu(k,1168) = lu(k,1168) - lu(k,1085) * lu(k,1158) - lu(k,1169) = lu(k,1169) - lu(k,1086) * lu(k,1158) - lu(k,1170) = lu(k,1170) - lu(k,1087) * lu(k,1158) - lu(k,1171) = lu(k,1171) - lu(k,1088) * lu(k,1158) - lu(k,1172) = lu(k,1172) - lu(k,1089) * lu(k,1158) - lu(k,1173) = lu(k,1173) - lu(k,1090) * lu(k,1158) - lu(k,1174) = lu(k,1174) - lu(k,1091) * lu(k,1158) - lu(k,1175) = lu(k,1175) - lu(k,1092) * lu(k,1158) - lu(k,1176) = lu(k,1176) - lu(k,1093) * lu(k,1158) - lu(k,1200) = lu(k,1200) - lu(k,1076) * lu(k,1199) - lu(k,1201) = lu(k,1201) - lu(k,1077) * lu(k,1199) - lu(k,1202) = lu(k,1202) - lu(k,1078) * lu(k,1199) - lu(k,1203) = lu(k,1203) - lu(k,1079) * lu(k,1199) - lu(k,1204) = lu(k,1204) - lu(k,1080) * lu(k,1199) - lu(k,1205) = lu(k,1205) - lu(k,1081) * lu(k,1199) - lu(k,1206) = lu(k,1206) - lu(k,1082) * lu(k,1199) - lu(k,1207) = lu(k,1207) - lu(k,1083) * lu(k,1199) - lu(k,1208) = lu(k,1208) - lu(k,1084) * lu(k,1199) - lu(k,1209) = lu(k,1209) - lu(k,1085) * lu(k,1199) - lu(k,1210) = lu(k,1210) - lu(k,1086) * lu(k,1199) - lu(k,1211) = lu(k,1211) - lu(k,1087) * lu(k,1199) - lu(k,1212) = lu(k,1212) - lu(k,1088) * lu(k,1199) - lu(k,1213) = lu(k,1213) - lu(k,1089) * lu(k,1199) - lu(k,1214) = lu(k,1214) - lu(k,1090) * lu(k,1199) - lu(k,1215) = lu(k,1215) - lu(k,1091) * lu(k,1199) - lu(k,1216) = lu(k,1216) - lu(k,1092) * lu(k,1199) - lu(k,1217) = lu(k,1217) - lu(k,1093) * lu(k,1199) - lu(k,1249) = lu(k,1249) - lu(k,1076) * lu(k,1248) - lu(k,1250) = lu(k,1250) - lu(k,1077) * lu(k,1248) - lu(k,1251) = lu(k,1251) - lu(k,1078) * lu(k,1248) - lu(k,1252) = lu(k,1252) - lu(k,1079) * lu(k,1248) - lu(k,1253) = lu(k,1253) - lu(k,1080) * lu(k,1248) - lu(k,1254) = lu(k,1254) - lu(k,1081) * lu(k,1248) - lu(k,1255) = lu(k,1255) - lu(k,1082) * lu(k,1248) - lu(k,1256) = lu(k,1256) - lu(k,1083) * lu(k,1248) - lu(k,1257) = lu(k,1257) - lu(k,1084) * lu(k,1248) - lu(k,1258) = lu(k,1258) - lu(k,1085) * lu(k,1248) - lu(k,1259) = lu(k,1259) - lu(k,1086) * lu(k,1248) - lu(k,1260) = lu(k,1260) - lu(k,1087) * lu(k,1248) - lu(k,1261) = lu(k,1261) - lu(k,1088) * lu(k,1248) - lu(k,1262) = lu(k,1262) - lu(k,1089) * lu(k,1248) - lu(k,1263) = lu(k,1263) - lu(k,1090) * lu(k,1248) - lu(k,1264) = lu(k,1264) - lu(k,1091) * lu(k,1248) - lu(k,1265) = lu(k,1265) - lu(k,1092) * lu(k,1248) - lu(k,1266) = lu(k,1266) - lu(k,1093) * lu(k,1248) - lu(k,1288) = lu(k,1288) - lu(k,1076) * lu(k,1287) - lu(k,1289) = lu(k,1289) - lu(k,1077) * lu(k,1287) - lu(k,1290) = lu(k,1290) - lu(k,1078) * lu(k,1287) - lu(k,1291) = lu(k,1291) - lu(k,1079) * lu(k,1287) - lu(k,1292) = lu(k,1292) - lu(k,1080) * lu(k,1287) - lu(k,1293) = lu(k,1293) - lu(k,1081) * lu(k,1287) - lu(k,1294) = lu(k,1294) - lu(k,1082) * lu(k,1287) - lu(k,1295) = lu(k,1295) - lu(k,1083) * lu(k,1287) - lu(k,1296) = lu(k,1296) - lu(k,1084) * lu(k,1287) - lu(k,1297) = lu(k,1297) - lu(k,1085) * lu(k,1287) - lu(k,1298) = lu(k,1298) - lu(k,1086) * lu(k,1287) - lu(k,1299) = lu(k,1299) - lu(k,1087) * lu(k,1287) - lu(k,1300) = lu(k,1300) - lu(k,1088) * lu(k,1287) - lu(k,1301) = lu(k,1301) - lu(k,1089) * lu(k,1287) - lu(k,1302) = lu(k,1302) - lu(k,1090) * lu(k,1287) - lu(k,1303) = lu(k,1303) - lu(k,1091) * lu(k,1287) - lu(k,1304) = lu(k,1304) - lu(k,1092) * lu(k,1287) - lu(k,1305) = lu(k,1305) - lu(k,1093) * lu(k,1287) - lu(k,1323) = lu(k,1323) - lu(k,1076) * lu(k,1322) - lu(k,1324) = lu(k,1324) - lu(k,1077) * lu(k,1322) - lu(k,1325) = lu(k,1325) - lu(k,1078) * lu(k,1322) - lu(k,1326) = lu(k,1326) - lu(k,1079) * lu(k,1322) - lu(k,1327) = lu(k,1327) - lu(k,1080) * lu(k,1322) - lu(k,1328) = lu(k,1328) - lu(k,1081) * lu(k,1322) - lu(k,1329) = lu(k,1329) - lu(k,1082) * lu(k,1322) - lu(k,1330) = lu(k,1330) - lu(k,1083) * lu(k,1322) - lu(k,1331) = lu(k,1331) - lu(k,1084) * lu(k,1322) - lu(k,1332) = lu(k,1332) - lu(k,1085) * lu(k,1322) - lu(k,1333) = lu(k,1333) - lu(k,1086) * lu(k,1322) - lu(k,1334) = lu(k,1334) - lu(k,1087) * lu(k,1322) - lu(k,1335) = lu(k,1335) - lu(k,1088) * lu(k,1322) - lu(k,1336) = lu(k,1336) - lu(k,1089) * lu(k,1322) - lu(k,1337) = lu(k,1337) - lu(k,1090) * lu(k,1322) - lu(k,1338) = lu(k,1338) - lu(k,1091) * lu(k,1322) - lu(k,1339) = lu(k,1339) - lu(k,1092) * lu(k,1322) - lu(k,1340) = lu(k,1340) - lu(k,1093) * lu(k,1322) - lu(k,1367) = lu(k,1367) - lu(k,1076) * lu(k,1366) - lu(k,1368) = lu(k,1368) - lu(k,1077) * lu(k,1366) - lu(k,1369) = lu(k,1369) - lu(k,1078) * lu(k,1366) - lu(k,1370) = lu(k,1370) - lu(k,1079) * lu(k,1366) - lu(k,1371) = lu(k,1371) - lu(k,1080) * lu(k,1366) - lu(k,1372) = lu(k,1372) - lu(k,1081) * lu(k,1366) - lu(k,1373) = lu(k,1373) - lu(k,1082) * lu(k,1366) - lu(k,1374) = lu(k,1374) - lu(k,1083) * lu(k,1366) - lu(k,1375) = lu(k,1375) - lu(k,1084) * lu(k,1366) - lu(k,1376) = lu(k,1376) - lu(k,1085) * lu(k,1366) - lu(k,1377) = lu(k,1377) - lu(k,1086) * lu(k,1366) - lu(k,1378) = lu(k,1378) - lu(k,1087) * lu(k,1366) - lu(k,1379) = lu(k,1379) - lu(k,1088) * lu(k,1366) - lu(k,1380) = lu(k,1380) - lu(k,1089) * lu(k,1366) - lu(k,1381) = lu(k,1381) - lu(k,1090) * lu(k,1366) - lu(k,1382) = lu(k,1382) - lu(k,1091) * lu(k,1366) - lu(k,1383) = lu(k,1383) - lu(k,1092) * lu(k,1366) - lu(k,1384) = lu(k,1384) - lu(k,1093) * lu(k,1366) - lu(k,1426) = lu(k,1426) - lu(k,1076) * lu(k,1425) - lu(k,1427) = lu(k,1427) - lu(k,1077) * lu(k,1425) - lu(k,1428) = lu(k,1428) - lu(k,1078) * lu(k,1425) - lu(k,1429) = lu(k,1429) - lu(k,1079) * lu(k,1425) - lu(k,1430) = lu(k,1430) - lu(k,1080) * lu(k,1425) - lu(k,1431) = lu(k,1431) - lu(k,1081) * lu(k,1425) - lu(k,1432) = lu(k,1432) - lu(k,1082) * lu(k,1425) - lu(k,1433) = lu(k,1433) - lu(k,1083) * lu(k,1425) - lu(k,1434) = lu(k,1434) - lu(k,1084) * lu(k,1425) - lu(k,1435) = lu(k,1435) - lu(k,1085) * lu(k,1425) - lu(k,1436) = lu(k,1436) - lu(k,1086) * lu(k,1425) - lu(k,1437) = lu(k,1437) - lu(k,1087) * lu(k,1425) - lu(k,1438) = lu(k,1438) - lu(k,1088) * lu(k,1425) - lu(k,1439) = lu(k,1439) - lu(k,1089) * lu(k,1425) - lu(k,1440) = lu(k,1440) - lu(k,1090) * lu(k,1425) - lu(k,1441) = lu(k,1441) - lu(k,1091) * lu(k,1425) - lu(k,1442) = lu(k,1442) - lu(k,1092) * lu(k,1425) - lu(k,1443) = lu(k,1443) - lu(k,1093) * lu(k,1425) - lu(k,1468) = lu(k,1468) - lu(k,1076) * lu(k,1467) - lu(k,1469) = lu(k,1469) - lu(k,1077) * lu(k,1467) - lu(k,1470) = lu(k,1470) - lu(k,1078) * lu(k,1467) - lu(k,1471) = lu(k,1471) - lu(k,1079) * lu(k,1467) - lu(k,1472) = lu(k,1472) - lu(k,1080) * lu(k,1467) - lu(k,1473) = lu(k,1473) - lu(k,1081) * lu(k,1467) - lu(k,1474) = lu(k,1474) - lu(k,1082) * lu(k,1467) - lu(k,1475) = lu(k,1475) - lu(k,1083) * lu(k,1467) - lu(k,1476) = lu(k,1476) - lu(k,1084) * lu(k,1467) - lu(k,1477) = lu(k,1477) - lu(k,1085) * lu(k,1467) - lu(k,1478) = lu(k,1478) - lu(k,1086) * lu(k,1467) - lu(k,1479) = lu(k,1479) - lu(k,1087) * lu(k,1467) - lu(k,1480) = lu(k,1480) - lu(k,1088) * lu(k,1467) - lu(k,1481) = lu(k,1481) - lu(k,1089) * lu(k,1467) - lu(k,1482) = lu(k,1482) - lu(k,1090) * lu(k,1467) - lu(k,1483) = lu(k,1483) - lu(k,1091) * lu(k,1467) - lu(k,1484) = lu(k,1484) - lu(k,1092) * lu(k,1467) - lu(k,1485) = lu(k,1485) - lu(k,1093) * lu(k,1467) - lu(k,1509) = lu(k,1509) - lu(k,1076) * lu(k,1508) - lu(k,1510) = lu(k,1510) - lu(k,1077) * lu(k,1508) - lu(k,1511) = lu(k,1511) - lu(k,1078) * lu(k,1508) - lu(k,1512) = lu(k,1512) - lu(k,1079) * lu(k,1508) - lu(k,1513) = lu(k,1513) - lu(k,1080) * lu(k,1508) - lu(k,1514) = lu(k,1514) - lu(k,1081) * lu(k,1508) - lu(k,1515) = lu(k,1515) - lu(k,1082) * lu(k,1508) - lu(k,1516) = lu(k,1516) - lu(k,1083) * lu(k,1508) - lu(k,1517) = lu(k,1517) - lu(k,1084) * lu(k,1508) - lu(k,1518) = lu(k,1518) - lu(k,1085) * lu(k,1508) - lu(k,1519) = lu(k,1519) - lu(k,1086) * lu(k,1508) - lu(k,1520) = lu(k,1520) - lu(k,1087) * lu(k,1508) - lu(k,1521) = lu(k,1521) - lu(k,1088) * lu(k,1508) - lu(k,1522) = lu(k,1522) - lu(k,1089) * lu(k,1508) - lu(k,1523) = lu(k,1523) - lu(k,1090) * lu(k,1508) - lu(k,1524) = lu(k,1524) - lu(k,1091) * lu(k,1508) - lu(k,1525) = lu(k,1525) - lu(k,1092) * lu(k,1508) - lu(k,1526) = lu(k,1526) - lu(k,1093) * lu(k,1508) - lu(k,1551) = lu(k,1551) - lu(k,1076) * lu(k,1550) - lu(k,1552) = lu(k,1552) - lu(k,1077) * lu(k,1550) - lu(k,1553) = lu(k,1553) - lu(k,1078) * lu(k,1550) - lu(k,1554) = lu(k,1554) - lu(k,1079) * lu(k,1550) - lu(k,1555) = lu(k,1555) - lu(k,1080) * lu(k,1550) - lu(k,1556) = lu(k,1556) - lu(k,1081) * lu(k,1550) - lu(k,1557) = lu(k,1557) - lu(k,1082) * lu(k,1550) - lu(k,1558) = lu(k,1558) - lu(k,1083) * lu(k,1550) - lu(k,1559) = lu(k,1559) - lu(k,1084) * lu(k,1550) - lu(k,1560) = lu(k,1560) - lu(k,1085) * lu(k,1550) - lu(k,1561) = lu(k,1561) - lu(k,1086) * lu(k,1550) - lu(k,1562) = lu(k,1562) - lu(k,1087) * lu(k,1550) - lu(k,1563) = lu(k,1563) - lu(k,1088) * lu(k,1550) - lu(k,1564) = lu(k,1564) - lu(k,1089) * lu(k,1550) - lu(k,1565) = lu(k,1565) - lu(k,1090) * lu(k,1550) - lu(k,1566) = lu(k,1566) - lu(k,1091) * lu(k,1550) - lu(k,1567) = lu(k,1567) - lu(k,1092) * lu(k,1550) - lu(k,1568) = lu(k,1568) - lu(k,1093) * lu(k,1550) - lu(k,1593) = lu(k,1593) - lu(k,1076) * lu(k,1592) - lu(k,1594) = lu(k,1594) - lu(k,1077) * lu(k,1592) - lu(k,1595) = lu(k,1595) - lu(k,1078) * lu(k,1592) - lu(k,1596) = lu(k,1596) - lu(k,1079) * lu(k,1592) - lu(k,1597) = lu(k,1597) - lu(k,1080) * lu(k,1592) - lu(k,1598) = lu(k,1598) - lu(k,1081) * lu(k,1592) - lu(k,1599) = lu(k,1599) - lu(k,1082) * lu(k,1592) - lu(k,1600) = lu(k,1600) - lu(k,1083) * lu(k,1592) - lu(k,1601) = lu(k,1601) - lu(k,1084) * lu(k,1592) - lu(k,1602) = lu(k,1602) - lu(k,1085) * lu(k,1592) - lu(k,1603) = lu(k,1603) - lu(k,1086) * lu(k,1592) - lu(k,1604) = lu(k,1604) - lu(k,1087) * lu(k,1592) - lu(k,1605) = lu(k,1605) - lu(k,1088) * lu(k,1592) - lu(k,1606) = lu(k,1606) - lu(k,1089) * lu(k,1592) - lu(k,1607) = lu(k,1607) - lu(k,1090) * lu(k,1592) - lu(k,1608) = lu(k,1608) - lu(k,1091) * lu(k,1592) - lu(k,1609) = lu(k,1609) - lu(k,1092) * lu(k,1592) - lu(k,1610) = lu(k,1610) - lu(k,1093) * lu(k,1592) - lu(k,1625) = lu(k,1625) - lu(k,1076) * lu(k,1624) - lu(k,1626) = lu(k,1626) - lu(k,1077) * lu(k,1624) - lu(k,1627) = lu(k,1627) - lu(k,1078) * lu(k,1624) - lu(k,1628) = lu(k,1628) - lu(k,1079) * lu(k,1624) - lu(k,1629) = lu(k,1629) - lu(k,1080) * lu(k,1624) - lu(k,1630) = lu(k,1630) - lu(k,1081) * lu(k,1624) - lu(k,1631) = lu(k,1631) - lu(k,1082) * lu(k,1624) - lu(k,1632) = lu(k,1632) - lu(k,1083) * lu(k,1624) - lu(k,1633) = lu(k,1633) - lu(k,1084) * lu(k,1624) - lu(k,1634) = lu(k,1634) - lu(k,1085) * lu(k,1624) - lu(k,1635) = lu(k,1635) - lu(k,1086) * lu(k,1624) - lu(k,1636) = lu(k,1636) - lu(k,1087) * lu(k,1624) - lu(k,1637) = lu(k,1637) - lu(k,1088) * lu(k,1624) - lu(k,1638) = lu(k,1638) - lu(k,1089) * lu(k,1624) - lu(k,1639) = lu(k,1639) - lu(k,1090) * lu(k,1624) - lu(k,1640) = lu(k,1640) - lu(k,1091) * lu(k,1624) - lu(k,1641) = lu(k,1641) - lu(k,1092) * lu(k,1624) - lu(k,1642) = lu(k,1642) - lu(k,1093) * lu(k,1624) - lu(k,1660) = lu(k,1660) - lu(k,1076) * lu(k,1659) - lu(k,1661) = lu(k,1661) - lu(k,1077) * lu(k,1659) - lu(k,1662) = lu(k,1662) - lu(k,1078) * lu(k,1659) - lu(k,1663) = lu(k,1663) - lu(k,1079) * lu(k,1659) - lu(k,1664) = lu(k,1664) - lu(k,1080) * lu(k,1659) - lu(k,1665) = lu(k,1665) - lu(k,1081) * lu(k,1659) - lu(k,1666) = lu(k,1666) - lu(k,1082) * lu(k,1659) - lu(k,1667) = lu(k,1667) - lu(k,1083) * lu(k,1659) - lu(k,1668) = lu(k,1668) - lu(k,1084) * lu(k,1659) - lu(k,1669) = lu(k,1669) - lu(k,1085) * lu(k,1659) - lu(k,1670) = lu(k,1670) - lu(k,1086) * lu(k,1659) - lu(k,1671) = lu(k,1671) - lu(k,1087) * lu(k,1659) - lu(k,1672) = lu(k,1672) - lu(k,1088) * lu(k,1659) - lu(k,1673) = lu(k,1673) - lu(k,1089) * lu(k,1659) - lu(k,1674) = lu(k,1674) - lu(k,1090) * lu(k,1659) - lu(k,1675) = lu(k,1675) - lu(k,1091) * lu(k,1659) - lu(k,1676) = lu(k,1676) - lu(k,1092) * lu(k,1659) - lu(k,1677) = lu(k,1677) - lu(k,1093) * lu(k,1659) - lu(k,1702) = lu(k,1702) - lu(k,1076) * lu(k,1701) - lu(k,1703) = lu(k,1703) - lu(k,1077) * lu(k,1701) - lu(k,1704) = lu(k,1704) - lu(k,1078) * lu(k,1701) - lu(k,1705) = lu(k,1705) - lu(k,1079) * lu(k,1701) - lu(k,1706) = lu(k,1706) - lu(k,1080) * lu(k,1701) - lu(k,1707) = lu(k,1707) - lu(k,1081) * lu(k,1701) - lu(k,1708) = lu(k,1708) - lu(k,1082) * lu(k,1701) - lu(k,1709) = lu(k,1709) - lu(k,1083) * lu(k,1701) - lu(k,1710) = lu(k,1710) - lu(k,1084) * lu(k,1701) - lu(k,1711) = lu(k,1711) - lu(k,1085) * lu(k,1701) - lu(k,1712) = lu(k,1712) - lu(k,1086) * lu(k,1701) - lu(k,1713) = lu(k,1713) - lu(k,1087) * lu(k,1701) - lu(k,1714) = lu(k,1714) - lu(k,1088) * lu(k,1701) - lu(k,1715) = lu(k,1715) - lu(k,1089) * lu(k,1701) - lu(k,1716) = lu(k,1716) - lu(k,1090) * lu(k,1701) - lu(k,1717) = lu(k,1717) - lu(k,1091) * lu(k,1701) - lu(k,1718) = lu(k,1718) - lu(k,1092) * lu(k,1701) - lu(k,1719) = lu(k,1719) - lu(k,1093) * lu(k,1701) - lu(k,1746) = lu(k,1746) - lu(k,1076) * lu(k,1745) - lu(k,1747) = lu(k,1747) - lu(k,1077) * lu(k,1745) - lu(k,1748) = lu(k,1748) - lu(k,1078) * lu(k,1745) - lu(k,1749) = lu(k,1749) - lu(k,1079) * lu(k,1745) - lu(k,1750) = lu(k,1750) - lu(k,1080) * lu(k,1745) - lu(k,1751) = lu(k,1751) - lu(k,1081) * lu(k,1745) - lu(k,1752) = lu(k,1752) - lu(k,1082) * lu(k,1745) - lu(k,1753) = lu(k,1753) - lu(k,1083) * lu(k,1745) - lu(k,1754) = lu(k,1754) - lu(k,1084) * lu(k,1745) - lu(k,1755) = lu(k,1755) - lu(k,1085) * lu(k,1745) - lu(k,1756) = lu(k,1756) - lu(k,1086) * lu(k,1745) - lu(k,1757) = lu(k,1757) - lu(k,1087) * lu(k,1745) - lu(k,1758) = lu(k,1758) - lu(k,1088) * lu(k,1745) - lu(k,1759) = lu(k,1759) - lu(k,1089) * lu(k,1745) - lu(k,1760) = lu(k,1760) - lu(k,1090) * lu(k,1745) - lu(k,1761) = lu(k,1761) - lu(k,1091) * lu(k,1745) - lu(k,1762) = lu(k,1762) - lu(k,1092) * lu(k,1745) - lu(k,1763) = lu(k,1763) - lu(k,1093) * lu(k,1745) - lu(k,1781) = lu(k,1781) - lu(k,1076) * lu(k,1780) - lu(k,1782) = lu(k,1782) - lu(k,1077) * lu(k,1780) - lu(k,1783) = lu(k,1783) - lu(k,1078) * lu(k,1780) - lu(k,1784) = lu(k,1784) - lu(k,1079) * lu(k,1780) - lu(k,1785) = lu(k,1785) - lu(k,1080) * lu(k,1780) - lu(k,1786) = lu(k,1786) - lu(k,1081) * lu(k,1780) - lu(k,1787) = lu(k,1787) - lu(k,1082) * lu(k,1780) - lu(k,1788) = lu(k,1788) - lu(k,1083) * lu(k,1780) - lu(k,1789) = lu(k,1789) - lu(k,1084) * lu(k,1780) - lu(k,1790) = lu(k,1790) - lu(k,1085) * lu(k,1780) - lu(k,1791) = lu(k,1791) - lu(k,1086) * lu(k,1780) - lu(k,1792) = lu(k,1792) - lu(k,1087) * lu(k,1780) - lu(k,1793) = lu(k,1793) - lu(k,1088) * lu(k,1780) - lu(k,1794) = lu(k,1794) - lu(k,1089) * lu(k,1780) - lu(k,1795) = lu(k,1795) - lu(k,1090) * lu(k,1780) - lu(k,1796) = lu(k,1796) - lu(k,1091) * lu(k,1780) - lu(k,1797) = lu(k,1797) - lu(k,1092) * lu(k,1780) - lu(k,1798) = lu(k,1798) - lu(k,1093) * lu(k,1780) - lu(k,1839) = lu(k,1839) - lu(k,1076) * lu(k,1838) - lu(k,1840) = lu(k,1840) - lu(k,1077) * lu(k,1838) - lu(k,1841) = lu(k,1841) - lu(k,1078) * lu(k,1838) - lu(k,1842) = lu(k,1842) - lu(k,1079) * lu(k,1838) - lu(k,1843) = lu(k,1843) - lu(k,1080) * lu(k,1838) - lu(k,1844) = lu(k,1844) - lu(k,1081) * lu(k,1838) - lu(k,1845) = lu(k,1845) - lu(k,1082) * lu(k,1838) - lu(k,1846) = lu(k,1846) - lu(k,1083) * lu(k,1838) - lu(k,1847) = lu(k,1847) - lu(k,1084) * lu(k,1838) - lu(k,1848) = lu(k,1848) - lu(k,1085) * lu(k,1838) - lu(k,1849) = lu(k,1849) - lu(k,1086) * lu(k,1838) - lu(k,1850) = lu(k,1850) - lu(k,1087) * lu(k,1838) - lu(k,1851) = lu(k,1851) - lu(k,1088) * lu(k,1838) - lu(k,1852) = lu(k,1852) - lu(k,1089) * lu(k,1838) - lu(k,1853) = lu(k,1853) - lu(k,1090) * lu(k,1838) - lu(k,1854) = lu(k,1854) - lu(k,1091) * lu(k,1838) - lu(k,1855) = lu(k,1855) - lu(k,1092) * lu(k,1838) - lu(k,1856) = lu(k,1856) - lu(k,1093) * lu(k,1838) + lu(k,863) = 1._r8 / lu(k,863) + lu(k,864) = lu(k,864) * lu(k,863) + lu(k,865) = lu(k,865) * lu(k,863) + lu(k,866) = lu(k,866) * lu(k,863) + lu(k,867) = lu(k,867) * lu(k,863) + lu(k,868) = lu(k,868) * lu(k,863) + lu(k,869) = lu(k,869) * lu(k,863) + lu(k,870) = lu(k,870) * lu(k,863) + lu(k,871) = lu(k,871) * lu(k,863) + lu(k,872) = lu(k,872) * lu(k,863) + lu(k,873) = lu(k,873) * lu(k,863) + lu(k,874) = lu(k,874) * lu(k,863) + lu(k,875) = lu(k,875) * lu(k,863) + lu(k,876) = lu(k,876) * lu(k,863) + lu(k,877) = lu(k,877) * lu(k,863) + lu(k,878) = lu(k,878) * lu(k,863) + lu(k,879) = lu(k,879) * lu(k,863) + lu(k,880) = lu(k,880) * lu(k,863) + lu(k,881) = lu(k,881) * lu(k,863) + lu(k,882) = lu(k,882) * lu(k,863) + lu(k,883) = lu(k,883) * lu(k,863) + lu(k,923) = lu(k,923) - lu(k,864) * lu(k,922) + lu(k,925) = lu(k,925) - lu(k,865) * lu(k,922) + lu(k,926) = lu(k,926) - lu(k,866) * lu(k,922) + lu(k,927) = lu(k,927) - lu(k,867) * lu(k,922) + lu(k,928) = lu(k,928) - lu(k,868) * lu(k,922) + lu(k,929) = lu(k,929) - lu(k,869) * lu(k,922) + lu(k,930) = - lu(k,870) * lu(k,922) + lu(k,931) = lu(k,931) - lu(k,871) * lu(k,922) + lu(k,932) = lu(k,932) - lu(k,872) * lu(k,922) + lu(k,933) = lu(k,933) - lu(k,873) * lu(k,922) + lu(k,934) = lu(k,934) - lu(k,874) * lu(k,922) + lu(k,935) = lu(k,935) - lu(k,875) * lu(k,922) + lu(k,936) = lu(k,936) - lu(k,876) * lu(k,922) + lu(k,937) = lu(k,937) - lu(k,877) * lu(k,922) + lu(k,938) = lu(k,938) - lu(k,878) * lu(k,922) + lu(k,939) = lu(k,939) - lu(k,879) * lu(k,922) + lu(k,941) = lu(k,941) - lu(k,880) * lu(k,922) + lu(k,943) = lu(k,943) - lu(k,881) * lu(k,922) + lu(k,944) = lu(k,944) - lu(k,882) * lu(k,922) + lu(k,945) = lu(k,945) - lu(k,883) * lu(k,922) + lu(k,1009) = lu(k,1009) - lu(k,864) * lu(k,1008) + lu(k,1012) = lu(k,1012) - lu(k,865) * lu(k,1008) + lu(k,1013) = lu(k,1013) - lu(k,866) * lu(k,1008) + lu(k,1014) = lu(k,1014) - lu(k,867) * lu(k,1008) + lu(k,1015) = lu(k,1015) - lu(k,868) * lu(k,1008) + lu(k,1016) = lu(k,1016) - lu(k,869) * lu(k,1008) + lu(k,1017) = lu(k,1017) - lu(k,870) * lu(k,1008) + lu(k,1018) = lu(k,1018) - lu(k,871) * lu(k,1008) + lu(k,1019) = lu(k,1019) - lu(k,872) * lu(k,1008) + lu(k,1020) = lu(k,1020) - lu(k,873) * lu(k,1008) + lu(k,1021) = lu(k,1021) - lu(k,874) * lu(k,1008) + lu(k,1022) = lu(k,1022) - lu(k,875) * lu(k,1008) + lu(k,1024) = lu(k,1024) - lu(k,876) * lu(k,1008) + lu(k,1025) = lu(k,1025) - lu(k,877) * lu(k,1008) + lu(k,1026) = lu(k,1026) - lu(k,878) * lu(k,1008) + lu(k,1027) = lu(k,1027) - lu(k,879) * lu(k,1008) + lu(k,1029) = lu(k,1029) - lu(k,880) * lu(k,1008) + lu(k,1032) = lu(k,1032) - lu(k,881) * lu(k,1008) + lu(k,1034) = lu(k,1034) - lu(k,882) * lu(k,1008) + lu(k,1035) = lu(k,1035) - lu(k,883) * lu(k,1008) + lu(k,1093) = - lu(k,864) * lu(k,1091) + lu(k,1095) = lu(k,1095) - lu(k,865) * lu(k,1091) + lu(k,1096) = lu(k,1096) - lu(k,866) * lu(k,1091) + lu(k,1097) = lu(k,1097) - lu(k,867) * lu(k,1091) + lu(k,1098) = lu(k,1098) - lu(k,868) * lu(k,1091) + lu(k,1099) = lu(k,1099) - lu(k,869) * lu(k,1091) + lu(k,1100) = lu(k,1100) - lu(k,870) * lu(k,1091) + lu(k,1101) = lu(k,1101) - lu(k,871) * lu(k,1091) + lu(k,1102) = lu(k,1102) - lu(k,872) * lu(k,1091) + lu(k,1103) = lu(k,1103) - lu(k,873) * lu(k,1091) + lu(k,1104) = lu(k,1104) - lu(k,874) * lu(k,1091) + lu(k,1105) = lu(k,1105) - lu(k,875) * lu(k,1091) + lu(k,1107) = lu(k,1107) - lu(k,876) * lu(k,1091) + lu(k,1108) = lu(k,1108) - lu(k,877) * lu(k,1091) + lu(k,1109) = lu(k,1109) - lu(k,878) * lu(k,1091) + lu(k,1110) = lu(k,1110) - lu(k,879) * lu(k,1091) + lu(k,1112) = lu(k,1112) - lu(k,880) * lu(k,1091) + lu(k,1115) = lu(k,1115) - lu(k,881) * lu(k,1091) + lu(k,1117) = lu(k,1117) - lu(k,882) * lu(k,1091) + lu(k,1118) = lu(k,1118) - lu(k,883) * lu(k,1091) + lu(k,1140) = lu(k,1140) - lu(k,864) * lu(k,1138) + lu(k,1143) = lu(k,1143) - lu(k,865) * lu(k,1138) + lu(k,1144) = lu(k,1144) - lu(k,866) * lu(k,1138) + lu(k,1145) = lu(k,1145) - lu(k,867) * lu(k,1138) + lu(k,1146) = lu(k,1146) - lu(k,868) * lu(k,1138) + lu(k,1147) = lu(k,1147) - lu(k,869) * lu(k,1138) + lu(k,1148) = lu(k,1148) - lu(k,870) * lu(k,1138) + lu(k,1149) = lu(k,1149) - lu(k,871) * lu(k,1138) + lu(k,1150) = lu(k,1150) - lu(k,872) * lu(k,1138) + lu(k,1151) = lu(k,1151) - lu(k,873) * lu(k,1138) + lu(k,1152) = lu(k,1152) - lu(k,874) * lu(k,1138) + lu(k,1153) = lu(k,1153) - lu(k,875) * lu(k,1138) + lu(k,1155) = lu(k,1155) - lu(k,876) * lu(k,1138) + lu(k,1156) = lu(k,1156) - lu(k,877) * lu(k,1138) + lu(k,1157) = lu(k,1157) - lu(k,878) * lu(k,1138) + lu(k,1158) = lu(k,1158) - lu(k,879) * lu(k,1138) + lu(k,1160) = lu(k,1160) - lu(k,880) * lu(k,1138) + lu(k,1163) = lu(k,1163) - lu(k,881) * lu(k,1138) + lu(k,1165) = lu(k,1165) - lu(k,882) * lu(k,1138) + lu(k,1166) = lu(k,1166) - lu(k,883) * lu(k,1138) + lu(k,1183) = lu(k,1183) - lu(k,864) * lu(k,1181) + lu(k,1186) = lu(k,1186) - lu(k,865) * lu(k,1181) + lu(k,1187) = lu(k,1187) - lu(k,866) * lu(k,1181) + lu(k,1188) = lu(k,1188) - lu(k,867) * lu(k,1181) + lu(k,1189) = lu(k,1189) - lu(k,868) * lu(k,1181) + lu(k,1190) = lu(k,1190) - lu(k,869) * lu(k,1181) + lu(k,1191) = lu(k,1191) - lu(k,870) * lu(k,1181) + lu(k,1192) = lu(k,1192) - lu(k,871) * lu(k,1181) + lu(k,1193) = lu(k,1193) - lu(k,872) * lu(k,1181) + lu(k,1194) = lu(k,1194) - lu(k,873) * lu(k,1181) + lu(k,1195) = lu(k,1195) - lu(k,874) * lu(k,1181) + lu(k,1196) = lu(k,1196) - lu(k,875) * lu(k,1181) + lu(k,1198) = lu(k,1198) - lu(k,876) * lu(k,1181) + lu(k,1199) = lu(k,1199) - lu(k,877) * lu(k,1181) + lu(k,1200) = lu(k,1200) - lu(k,878) * lu(k,1181) + lu(k,1201) = lu(k,1201) - lu(k,879) * lu(k,1181) + lu(k,1203) = lu(k,1203) - lu(k,880) * lu(k,1181) + lu(k,1206) = lu(k,1206) - lu(k,881) * lu(k,1181) + lu(k,1208) = lu(k,1208) - lu(k,882) * lu(k,1181) + lu(k,1209) = lu(k,1209) - lu(k,883) * lu(k,1181) + lu(k,1224) = lu(k,1224) - lu(k,864) * lu(k,1222) + lu(k,1227) = lu(k,1227) - lu(k,865) * lu(k,1222) + lu(k,1228) = lu(k,1228) - lu(k,866) * lu(k,1222) + lu(k,1229) = lu(k,1229) - lu(k,867) * lu(k,1222) + lu(k,1230) = lu(k,1230) - lu(k,868) * lu(k,1222) + lu(k,1231) = lu(k,1231) - lu(k,869) * lu(k,1222) + lu(k,1232) = lu(k,1232) - lu(k,870) * lu(k,1222) + lu(k,1233) = lu(k,1233) - lu(k,871) * lu(k,1222) + lu(k,1234) = lu(k,1234) - lu(k,872) * lu(k,1222) + lu(k,1235) = lu(k,1235) - lu(k,873) * lu(k,1222) + lu(k,1236) = lu(k,1236) - lu(k,874) * lu(k,1222) + lu(k,1237) = lu(k,1237) - lu(k,875) * lu(k,1222) + lu(k,1239) = lu(k,1239) - lu(k,876) * lu(k,1222) + lu(k,1240) = lu(k,1240) - lu(k,877) * lu(k,1222) + lu(k,1241) = lu(k,1241) - lu(k,878) * lu(k,1222) + lu(k,1242) = lu(k,1242) - lu(k,879) * lu(k,1222) + lu(k,1244) = lu(k,1244) - lu(k,880) * lu(k,1222) + lu(k,1247) = lu(k,1247) - lu(k,881) * lu(k,1222) + lu(k,1249) = lu(k,1249) - lu(k,882) * lu(k,1222) + lu(k,1250) = lu(k,1250) - lu(k,883) * lu(k,1222) + lu(k,1284) = lu(k,1284) - lu(k,864) * lu(k,1282) + lu(k,1287) = lu(k,1287) - lu(k,865) * lu(k,1282) + lu(k,1288) = lu(k,1288) - lu(k,866) * lu(k,1282) + lu(k,1289) = lu(k,1289) - lu(k,867) * lu(k,1282) + lu(k,1290) = lu(k,1290) - lu(k,868) * lu(k,1282) + lu(k,1291) = lu(k,1291) - lu(k,869) * lu(k,1282) + lu(k,1292) = lu(k,1292) - lu(k,870) * lu(k,1282) + lu(k,1293) = lu(k,1293) - lu(k,871) * lu(k,1282) + lu(k,1294) = lu(k,1294) - lu(k,872) * lu(k,1282) + lu(k,1295) = lu(k,1295) - lu(k,873) * lu(k,1282) + lu(k,1296) = lu(k,1296) - lu(k,874) * lu(k,1282) + lu(k,1297) = lu(k,1297) - lu(k,875) * lu(k,1282) + lu(k,1299) = lu(k,1299) - lu(k,876) * lu(k,1282) + lu(k,1300) = lu(k,1300) - lu(k,877) * lu(k,1282) + lu(k,1301) = lu(k,1301) - lu(k,878) * lu(k,1282) + lu(k,1302) = lu(k,1302) - lu(k,879) * lu(k,1282) + lu(k,1304) = lu(k,1304) - lu(k,880) * lu(k,1282) + lu(k,1307) = lu(k,1307) - lu(k,881) * lu(k,1282) + lu(k,1309) = lu(k,1309) - lu(k,882) * lu(k,1282) + lu(k,1310) = lu(k,1310) - lu(k,883) * lu(k,1282) + lu(k,1326) = lu(k,1326) - lu(k,864) * lu(k,1324) + lu(k,1329) = lu(k,1329) - lu(k,865) * lu(k,1324) + lu(k,1330) = lu(k,1330) - lu(k,866) * lu(k,1324) + lu(k,1331) = lu(k,1331) - lu(k,867) * lu(k,1324) + lu(k,1332) = lu(k,1332) - lu(k,868) * lu(k,1324) + lu(k,1333) = lu(k,1333) - lu(k,869) * lu(k,1324) + lu(k,1334) = lu(k,1334) - lu(k,870) * lu(k,1324) + lu(k,1335) = lu(k,1335) - lu(k,871) * lu(k,1324) + lu(k,1336) = lu(k,1336) - lu(k,872) * lu(k,1324) + lu(k,1337) = lu(k,1337) - lu(k,873) * lu(k,1324) + lu(k,1338) = lu(k,1338) - lu(k,874) * lu(k,1324) + lu(k,1339) = lu(k,1339) - lu(k,875) * lu(k,1324) + lu(k,1341) = lu(k,1341) - lu(k,876) * lu(k,1324) + lu(k,1342) = lu(k,1342) - lu(k,877) * lu(k,1324) + lu(k,1343) = lu(k,1343) - lu(k,878) * lu(k,1324) + lu(k,1344) = lu(k,1344) - lu(k,879) * lu(k,1324) + lu(k,1346) = lu(k,1346) - lu(k,880) * lu(k,1324) + lu(k,1349) = lu(k,1349) - lu(k,881) * lu(k,1324) + lu(k,1351) = lu(k,1351) - lu(k,882) * lu(k,1324) + lu(k,1352) = lu(k,1352) - lu(k,883) * lu(k,1324) + lu(k,1362) = lu(k,1362) - lu(k,864) * lu(k,1360) + lu(k,1365) = lu(k,1365) - lu(k,865) * lu(k,1360) + lu(k,1366) = lu(k,1366) - lu(k,866) * lu(k,1360) + lu(k,1367) = lu(k,1367) - lu(k,867) * lu(k,1360) + lu(k,1368) = lu(k,1368) - lu(k,868) * lu(k,1360) + lu(k,1369) = lu(k,1369) - lu(k,869) * lu(k,1360) + lu(k,1370) = lu(k,1370) - lu(k,870) * lu(k,1360) + lu(k,1371) = lu(k,1371) - lu(k,871) * lu(k,1360) + lu(k,1372) = lu(k,1372) - lu(k,872) * lu(k,1360) + lu(k,1373) = lu(k,1373) - lu(k,873) * lu(k,1360) + lu(k,1374) = lu(k,1374) - lu(k,874) * lu(k,1360) + lu(k,1375) = lu(k,1375) - lu(k,875) * lu(k,1360) + lu(k,1377) = lu(k,1377) - lu(k,876) * lu(k,1360) + lu(k,1378) = lu(k,1378) - lu(k,877) * lu(k,1360) + lu(k,1379) = lu(k,1379) - lu(k,878) * lu(k,1360) + lu(k,1380) = lu(k,1380) - lu(k,879) * lu(k,1360) + lu(k,1382) = lu(k,1382) - lu(k,880) * lu(k,1360) + lu(k,1385) = lu(k,1385) - lu(k,881) * lu(k,1360) + lu(k,1387) = lu(k,1387) - lu(k,882) * lu(k,1360) + lu(k,1388) = lu(k,1388) - lu(k,883) * lu(k,1360) + lu(k,1405) = lu(k,1405) - lu(k,864) * lu(k,1403) + lu(k,1408) = lu(k,1408) - lu(k,865) * lu(k,1403) + lu(k,1409) = lu(k,1409) - lu(k,866) * lu(k,1403) + lu(k,1410) = lu(k,1410) - lu(k,867) * lu(k,1403) + lu(k,1411) = lu(k,1411) - lu(k,868) * lu(k,1403) + lu(k,1412) = lu(k,1412) - lu(k,869) * lu(k,1403) + lu(k,1413) = lu(k,1413) - lu(k,870) * lu(k,1403) + lu(k,1414) = lu(k,1414) - lu(k,871) * lu(k,1403) + lu(k,1415) = lu(k,1415) - lu(k,872) * lu(k,1403) + lu(k,1416) = lu(k,1416) - lu(k,873) * lu(k,1403) + lu(k,1417) = lu(k,1417) - lu(k,874) * lu(k,1403) + lu(k,1418) = lu(k,1418) - lu(k,875) * lu(k,1403) + lu(k,1420) = lu(k,1420) - lu(k,876) * lu(k,1403) + lu(k,1421) = lu(k,1421) - lu(k,877) * lu(k,1403) + lu(k,1422) = lu(k,1422) - lu(k,878) * lu(k,1403) + lu(k,1423) = lu(k,1423) - lu(k,879) * lu(k,1403) + lu(k,1425) = lu(k,1425) - lu(k,880) * lu(k,1403) + lu(k,1428) = lu(k,1428) - lu(k,881) * lu(k,1403) + lu(k,1430) = lu(k,1430) - lu(k,882) * lu(k,1403) + lu(k,1431) = lu(k,1431) - lu(k,883) * lu(k,1403) + lu(k,1448) = lu(k,1448) - lu(k,864) * lu(k,1446) + lu(k,1451) = lu(k,1451) - lu(k,865) * lu(k,1446) + lu(k,1452) = lu(k,1452) - lu(k,866) * lu(k,1446) + lu(k,1453) = lu(k,1453) - lu(k,867) * lu(k,1446) + lu(k,1454) = lu(k,1454) - lu(k,868) * lu(k,1446) + lu(k,1455) = lu(k,1455) - lu(k,869) * lu(k,1446) + lu(k,1456) = lu(k,1456) - lu(k,870) * lu(k,1446) + lu(k,1457) = lu(k,1457) - lu(k,871) * lu(k,1446) + lu(k,1458) = lu(k,1458) - lu(k,872) * lu(k,1446) + lu(k,1459) = lu(k,1459) - lu(k,873) * lu(k,1446) + lu(k,1460) = lu(k,1460) - lu(k,874) * lu(k,1446) + lu(k,1461) = lu(k,1461) - lu(k,875) * lu(k,1446) + lu(k,1463) = lu(k,1463) - lu(k,876) * lu(k,1446) + lu(k,1464) = lu(k,1464) - lu(k,877) * lu(k,1446) + lu(k,1465) = lu(k,1465) - lu(k,878) * lu(k,1446) + lu(k,1466) = lu(k,1466) - lu(k,879) * lu(k,1446) + lu(k,1468) = lu(k,1468) - lu(k,880) * lu(k,1446) + lu(k,1471) = lu(k,1471) - lu(k,881) * lu(k,1446) + lu(k,1473) = lu(k,1473) - lu(k,882) * lu(k,1446) + lu(k,1474) = lu(k,1474) - lu(k,883) * lu(k,1446) + lu(k,1493) = lu(k,1493) - lu(k,864) * lu(k,1491) + lu(k,1496) = lu(k,1496) - lu(k,865) * lu(k,1491) + lu(k,1497) = lu(k,1497) - lu(k,866) * lu(k,1491) + lu(k,1498) = lu(k,1498) - lu(k,867) * lu(k,1491) + lu(k,1499) = lu(k,1499) - lu(k,868) * lu(k,1491) + lu(k,1500) = lu(k,1500) - lu(k,869) * lu(k,1491) + lu(k,1501) = lu(k,1501) - lu(k,870) * lu(k,1491) + lu(k,1502) = lu(k,1502) - lu(k,871) * lu(k,1491) + lu(k,1503) = lu(k,1503) - lu(k,872) * lu(k,1491) + lu(k,1504) = lu(k,1504) - lu(k,873) * lu(k,1491) + lu(k,1505) = lu(k,1505) - lu(k,874) * lu(k,1491) + lu(k,1506) = lu(k,1506) - lu(k,875) * lu(k,1491) + lu(k,1508) = lu(k,1508) - lu(k,876) * lu(k,1491) + lu(k,1509) = lu(k,1509) - lu(k,877) * lu(k,1491) + lu(k,1510) = lu(k,1510) - lu(k,878) * lu(k,1491) + lu(k,1511) = lu(k,1511) - lu(k,879) * lu(k,1491) + lu(k,1513) = lu(k,1513) - lu(k,880) * lu(k,1491) + lu(k,1516) = lu(k,1516) - lu(k,881) * lu(k,1491) + lu(k,1518) = lu(k,1518) - lu(k,882) * lu(k,1491) + lu(k,1519) = lu(k,1519) - lu(k,883) * lu(k,1491) + lu(k,1529) = lu(k,1529) - lu(k,864) * lu(k,1527) + lu(k,1532) = lu(k,1532) - lu(k,865) * lu(k,1527) + lu(k,1533) = - lu(k,866) * lu(k,1527) + lu(k,1534) = lu(k,1534) - lu(k,867) * lu(k,1527) + lu(k,1535) = lu(k,1535) - lu(k,868) * lu(k,1527) + lu(k,1536) = lu(k,1536) - lu(k,869) * lu(k,1527) + lu(k,1537) = lu(k,1537) - lu(k,870) * lu(k,1527) + lu(k,1538) = lu(k,1538) - lu(k,871) * lu(k,1527) + lu(k,1539) = lu(k,1539) - lu(k,872) * lu(k,1527) + lu(k,1540) = lu(k,1540) - lu(k,873) * lu(k,1527) + lu(k,1541) = lu(k,1541) - lu(k,874) * lu(k,1527) + lu(k,1542) = lu(k,1542) - lu(k,875) * lu(k,1527) + lu(k,1544) = lu(k,1544) - lu(k,876) * lu(k,1527) + lu(k,1545) = lu(k,1545) - lu(k,877) * lu(k,1527) + lu(k,1546) = lu(k,1546) - lu(k,878) * lu(k,1527) + lu(k,1547) = lu(k,1547) - lu(k,879) * lu(k,1527) + lu(k,1549) = lu(k,1549) - lu(k,880) * lu(k,1527) + lu(k,1552) = lu(k,1552) - lu(k,881) * lu(k,1527) + lu(k,1554) = lu(k,1554) - lu(k,882) * lu(k,1527) + lu(k,1555) = lu(k,1555) - lu(k,883) * lu(k,1527) + lu(k,1574) = lu(k,1574) - lu(k,864) * lu(k,1572) + lu(k,1577) = lu(k,1577) - lu(k,865) * lu(k,1572) + lu(k,1578) = lu(k,1578) - lu(k,866) * lu(k,1572) + lu(k,1579) = lu(k,1579) - lu(k,867) * lu(k,1572) + lu(k,1580) = lu(k,1580) - lu(k,868) * lu(k,1572) + lu(k,1581) = lu(k,1581) - lu(k,869) * lu(k,1572) + lu(k,1582) = lu(k,1582) - lu(k,870) * lu(k,1572) + lu(k,1583) = lu(k,1583) - lu(k,871) * lu(k,1572) + lu(k,1584) = lu(k,1584) - lu(k,872) * lu(k,1572) + lu(k,1585) = lu(k,1585) - lu(k,873) * lu(k,1572) + lu(k,1586) = lu(k,1586) - lu(k,874) * lu(k,1572) + lu(k,1587) = lu(k,1587) - lu(k,875) * lu(k,1572) + lu(k,1589) = lu(k,1589) - lu(k,876) * lu(k,1572) + lu(k,1590) = lu(k,1590) - lu(k,877) * lu(k,1572) + lu(k,1591) = lu(k,1591) - lu(k,878) * lu(k,1572) + lu(k,1592) = lu(k,1592) - lu(k,879) * lu(k,1572) + lu(k,1594) = lu(k,1594) - lu(k,880) * lu(k,1572) + lu(k,1597) = lu(k,1597) - lu(k,881) * lu(k,1572) + lu(k,1599) = lu(k,1599) - lu(k,882) * lu(k,1572) + lu(k,1600) = lu(k,1600) - lu(k,883) * lu(k,1572) + lu(k,1622) = lu(k,1622) - lu(k,864) * lu(k,1620) + lu(k,1625) = lu(k,1625) - lu(k,865) * lu(k,1620) + lu(k,1626) = lu(k,1626) - lu(k,866) * lu(k,1620) + lu(k,1627) = lu(k,1627) - lu(k,867) * lu(k,1620) + lu(k,1628) = lu(k,1628) - lu(k,868) * lu(k,1620) + lu(k,1629) = lu(k,1629) - lu(k,869) * lu(k,1620) + lu(k,1630) = lu(k,1630) - lu(k,870) * lu(k,1620) + lu(k,1631) = lu(k,1631) - lu(k,871) * lu(k,1620) + lu(k,1632) = lu(k,1632) - lu(k,872) * lu(k,1620) + lu(k,1633) = lu(k,1633) - lu(k,873) * lu(k,1620) + lu(k,1634) = lu(k,1634) - lu(k,874) * lu(k,1620) + lu(k,1635) = lu(k,1635) - lu(k,875) * lu(k,1620) + lu(k,1637) = lu(k,1637) - lu(k,876) * lu(k,1620) + lu(k,1638) = lu(k,1638) - lu(k,877) * lu(k,1620) + lu(k,1639) = lu(k,1639) - lu(k,878) * lu(k,1620) + lu(k,1640) = lu(k,1640) - lu(k,879) * lu(k,1620) + lu(k,1642) = lu(k,1642) - lu(k,880) * lu(k,1620) + lu(k,1645) = lu(k,1645) - lu(k,881) * lu(k,1620) + lu(k,1647) = lu(k,1647) - lu(k,882) * lu(k,1620) + lu(k,1648) = lu(k,1648) - lu(k,883) * lu(k,1620) + lu(k,1665) = lu(k,1665) - lu(k,864) * lu(k,1663) + lu(k,1668) = lu(k,1668) - lu(k,865) * lu(k,1663) + lu(k,1669) = lu(k,1669) - lu(k,866) * lu(k,1663) + lu(k,1670) = lu(k,1670) - lu(k,867) * lu(k,1663) + lu(k,1671) = lu(k,1671) - lu(k,868) * lu(k,1663) + lu(k,1672) = lu(k,1672) - lu(k,869) * lu(k,1663) + lu(k,1673) = lu(k,1673) - lu(k,870) * lu(k,1663) + lu(k,1674) = lu(k,1674) - lu(k,871) * lu(k,1663) + lu(k,1675) = lu(k,1675) - lu(k,872) * lu(k,1663) + lu(k,1676) = lu(k,1676) - lu(k,873) * lu(k,1663) + lu(k,1677) = lu(k,1677) - lu(k,874) * lu(k,1663) + lu(k,1678) = lu(k,1678) - lu(k,875) * lu(k,1663) + lu(k,1680) = lu(k,1680) - lu(k,876) * lu(k,1663) + lu(k,1681) = lu(k,1681) - lu(k,877) * lu(k,1663) + lu(k,1682) = lu(k,1682) - lu(k,878) * lu(k,1663) + lu(k,1683) = lu(k,1683) - lu(k,879) * lu(k,1663) + lu(k,1685) = lu(k,1685) - lu(k,880) * lu(k,1663) + lu(k,1688) = lu(k,1688) - lu(k,881) * lu(k,1663) + lu(k,1690) = lu(k,1690) - lu(k,882) * lu(k,1663) + lu(k,1691) = lu(k,1691) - lu(k,883) * lu(k,1663) + lu(k,1707) = lu(k,1707) - lu(k,864) * lu(k,1705) + lu(k,1710) = lu(k,1710) - lu(k,865) * lu(k,1705) + lu(k,1711) = lu(k,1711) - lu(k,866) * lu(k,1705) + lu(k,1712) = lu(k,1712) - lu(k,867) * lu(k,1705) + lu(k,1713) = lu(k,1713) - lu(k,868) * lu(k,1705) + lu(k,1714) = lu(k,1714) - lu(k,869) * lu(k,1705) + lu(k,1715) = lu(k,1715) - lu(k,870) * lu(k,1705) + lu(k,1716) = lu(k,1716) - lu(k,871) * lu(k,1705) + lu(k,1717) = lu(k,1717) - lu(k,872) * lu(k,1705) + lu(k,1718) = lu(k,1718) - lu(k,873) * lu(k,1705) + lu(k,1719) = lu(k,1719) - lu(k,874) * lu(k,1705) + lu(k,1720) = lu(k,1720) - lu(k,875) * lu(k,1705) + lu(k,1722) = lu(k,1722) - lu(k,876) * lu(k,1705) + lu(k,1723) = lu(k,1723) - lu(k,877) * lu(k,1705) + lu(k,1724) = lu(k,1724) - lu(k,878) * lu(k,1705) + lu(k,1725) = lu(k,1725) - lu(k,879) * lu(k,1705) + lu(k,1727) = lu(k,1727) - lu(k,880) * lu(k,1705) + lu(k,1730) = lu(k,1730) - lu(k,881) * lu(k,1705) + lu(k,1732) = lu(k,1732) - lu(k,882) * lu(k,1705) + lu(k,1733) = lu(k,1733) - lu(k,883) * lu(k,1705) + lu(k,1752) = lu(k,1752) - lu(k,864) * lu(k,1750) + lu(k,1755) = lu(k,1755) - lu(k,865) * lu(k,1750) + lu(k,1756) = lu(k,1756) - lu(k,866) * lu(k,1750) + lu(k,1757) = lu(k,1757) - lu(k,867) * lu(k,1750) + lu(k,1758) = lu(k,1758) - lu(k,868) * lu(k,1750) + lu(k,1759) = lu(k,1759) - lu(k,869) * lu(k,1750) + lu(k,1760) = lu(k,1760) - lu(k,870) * lu(k,1750) + lu(k,1761) = lu(k,1761) - lu(k,871) * lu(k,1750) + lu(k,1762) = lu(k,1762) - lu(k,872) * lu(k,1750) + lu(k,1763) = lu(k,1763) - lu(k,873) * lu(k,1750) + lu(k,1764) = lu(k,1764) - lu(k,874) * lu(k,1750) + lu(k,1765) = lu(k,1765) - lu(k,875) * lu(k,1750) + lu(k,1767) = lu(k,1767) - lu(k,876) * lu(k,1750) + lu(k,1768) = lu(k,1768) - lu(k,877) * lu(k,1750) + lu(k,1769) = lu(k,1769) - lu(k,878) * lu(k,1750) + lu(k,1770) = lu(k,1770) - lu(k,879) * lu(k,1750) + lu(k,1772) = lu(k,1772) - lu(k,880) * lu(k,1750) + lu(k,1775) = lu(k,1775) - lu(k,881) * lu(k,1750) + lu(k,1777) = lu(k,1777) - lu(k,882) * lu(k,1750) + lu(k,1778) = lu(k,1778) - lu(k,883) * lu(k,1750) + lu(k,1801) = lu(k,1801) - lu(k,864) * lu(k,1799) + lu(k,1804) = lu(k,1804) - lu(k,865) * lu(k,1799) + lu(k,1805) = lu(k,1805) - lu(k,866) * lu(k,1799) + lu(k,1806) = lu(k,1806) - lu(k,867) * lu(k,1799) + lu(k,1807) = lu(k,1807) - lu(k,868) * lu(k,1799) + lu(k,1808) = lu(k,1808) - lu(k,869) * lu(k,1799) + lu(k,1809) = lu(k,1809) - lu(k,870) * lu(k,1799) + lu(k,1810) = lu(k,1810) - lu(k,871) * lu(k,1799) + lu(k,1811) = lu(k,1811) - lu(k,872) * lu(k,1799) + lu(k,1812) = lu(k,1812) - lu(k,873) * lu(k,1799) + lu(k,1813) = lu(k,1813) - lu(k,874) * lu(k,1799) + lu(k,1814) = lu(k,1814) - lu(k,875) * lu(k,1799) + lu(k,1816) = lu(k,1816) - lu(k,876) * lu(k,1799) + lu(k,1817) = lu(k,1817) - lu(k,877) * lu(k,1799) + lu(k,1818) = lu(k,1818) - lu(k,878) * lu(k,1799) + lu(k,1819) = lu(k,1819) - lu(k,879) * lu(k,1799) + lu(k,1821) = lu(k,1821) - lu(k,880) * lu(k,1799) + lu(k,1824) = lu(k,1824) - lu(k,881) * lu(k,1799) + lu(k,1826) = lu(k,1826) - lu(k,882) * lu(k,1799) + lu(k,1827) = lu(k,1827) - lu(k,883) * lu(k,1799) + lu(k,1834) = lu(k,1834) - lu(k,864) * lu(k,1832) + lu(k,1837) = lu(k,1837) - lu(k,865) * lu(k,1832) + lu(k,1838) = - lu(k,866) * lu(k,1832) + lu(k,1839) = lu(k,1839) - lu(k,867) * lu(k,1832) + lu(k,1840) = lu(k,1840) - lu(k,868) * lu(k,1832) + lu(k,1841) = lu(k,1841) - lu(k,869) * lu(k,1832) + lu(k,1842) = lu(k,1842) - lu(k,870) * lu(k,1832) + lu(k,1843) = lu(k,1843) - lu(k,871) * lu(k,1832) + lu(k,1844) = lu(k,1844) - lu(k,872) * lu(k,1832) + lu(k,1845) = lu(k,1845) - lu(k,873) * lu(k,1832) + lu(k,1846) = lu(k,1846) - lu(k,874) * lu(k,1832) + lu(k,1847) = lu(k,1847) - lu(k,875) * lu(k,1832) + lu(k,1849) = lu(k,1849) - lu(k,876) * lu(k,1832) + lu(k,1850) = lu(k,1850) - lu(k,877) * lu(k,1832) + lu(k,1851) = lu(k,1851) - lu(k,878) * lu(k,1832) + lu(k,1852) = lu(k,1852) - lu(k,879) * lu(k,1832) + lu(k,1854) = lu(k,1854) - lu(k,880) * lu(k,1832) + lu(k,1857) = lu(k,1857) - lu(k,881) * lu(k,1832) + lu(k,1859) = lu(k,1859) - lu(k,882) * lu(k,1832) + lu(k,1860) = lu(k,1860) - lu(k,883) * lu(k,1832) + lu(k,1870) = lu(k,1870) - lu(k,864) * lu(k,1868) + lu(k,1873) = lu(k,1873) - lu(k,865) * lu(k,1868) + lu(k,1874) = lu(k,1874) - lu(k,866) * lu(k,1868) + lu(k,1875) = lu(k,1875) - lu(k,867) * lu(k,1868) + lu(k,1876) = lu(k,1876) - lu(k,868) * lu(k,1868) + lu(k,1877) = lu(k,1877) - lu(k,869) * lu(k,1868) + lu(k,1878) = lu(k,1878) - lu(k,870) * lu(k,1868) + lu(k,1879) = lu(k,1879) - lu(k,871) * lu(k,1868) + lu(k,1880) = lu(k,1880) - lu(k,872) * lu(k,1868) + lu(k,1881) = lu(k,1881) - lu(k,873) * lu(k,1868) + lu(k,1882) = lu(k,1882) - lu(k,874) * lu(k,1868) + lu(k,1883) = lu(k,1883) - lu(k,875) * lu(k,1868) + lu(k,1885) = lu(k,1885) - lu(k,876) * lu(k,1868) + lu(k,1886) = lu(k,1886) - lu(k,877) * lu(k,1868) + lu(k,1887) = lu(k,1887) - lu(k,878) * lu(k,1868) + lu(k,1888) = lu(k,1888) - lu(k,879) * lu(k,1868) + lu(k,1890) = lu(k,1890) - lu(k,880) * lu(k,1868) + lu(k,1893) = lu(k,1893) - lu(k,881) * lu(k,1868) + lu(k,1895) = lu(k,1895) - lu(k,882) * lu(k,1868) + lu(k,1896) = lu(k,1896) - lu(k,883) * lu(k,1868) + lu(k,1911) = lu(k,1911) - lu(k,864) * lu(k,1909) + lu(k,1914) = lu(k,1914) - lu(k,865) * lu(k,1909) + lu(k,1915) = lu(k,1915) - lu(k,866) * lu(k,1909) + lu(k,1916) = lu(k,1916) - lu(k,867) * lu(k,1909) + lu(k,1917) = lu(k,1917) - lu(k,868) * lu(k,1909) + lu(k,1918) = lu(k,1918) - lu(k,869) * lu(k,1909) + lu(k,1919) = lu(k,1919) - lu(k,870) * lu(k,1909) + lu(k,1920) = lu(k,1920) - lu(k,871) * lu(k,1909) + lu(k,1921) = lu(k,1921) - lu(k,872) * lu(k,1909) + lu(k,1922) = lu(k,1922) - lu(k,873) * lu(k,1909) + lu(k,1923) = lu(k,1923) - lu(k,874) * lu(k,1909) + lu(k,1924) = lu(k,1924) - lu(k,875) * lu(k,1909) + lu(k,1926) = lu(k,1926) - lu(k,876) * lu(k,1909) + lu(k,1927) = lu(k,1927) - lu(k,877) * lu(k,1909) + lu(k,1928) = lu(k,1928) - lu(k,878) * lu(k,1909) + lu(k,1929) = lu(k,1929) - lu(k,879) * lu(k,1909) + lu(k,1931) = lu(k,1931) - lu(k,880) * lu(k,1909) + lu(k,1934) = lu(k,1934) - lu(k,881) * lu(k,1909) + lu(k,1936) = lu(k,1936) - lu(k,882) * lu(k,1909) + lu(k,1937) = lu(k,1937) - lu(k,883) * lu(k,1909) + lu(k,1953) = lu(k,1953) - lu(k,864) * lu(k,1951) + lu(k,1956) = lu(k,1956) - lu(k,865) * lu(k,1951) + lu(k,1957) = lu(k,1957) - lu(k,866) * lu(k,1951) + lu(k,1958) = lu(k,1958) - lu(k,867) * lu(k,1951) + lu(k,1959) = lu(k,1959) - lu(k,868) * lu(k,1951) + lu(k,1960) = lu(k,1960) - lu(k,869) * lu(k,1951) + lu(k,1961) = lu(k,1961) - lu(k,870) * lu(k,1951) + lu(k,1962) = lu(k,1962) - lu(k,871) * lu(k,1951) + lu(k,1963) = lu(k,1963) - lu(k,872) * lu(k,1951) + lu(k,1964) = lu(k,1964) - lu(k,873) * lu(k,1951) + lu(k,1965) = lu(k,1965) - lu(k,874) * lu(k,1951) + lu(k,1966) = lu(k,1966) - lu(k,875) * lu(k,1951) + lu(k,1968) = lu(k,1968) - lu(k,876) * lu(k,1951) + lu(k,1969) = lu(k,1969) - lu(k,877) * lu(k,1951) + lu(k,1970) = lu(k,1970) - lu(k,878) * lu(k,1951) + lu(k,1971) = lu(k,1971) - lu(k,879) * lu(k,1951) + lu(k,1973) = lu(k,1973) - lu(k,880) * lu(k,1951) + lu(k,1976) = lu(k,1976) - lu(k,881) * lu(k,1951) + lu(k,1978) = lu(k,1978) - lu(k,882) * lu(k,1951) + lu(k,1979) = lu(k,1979) - lu(k,883) * lu(k,1951) + lu(k,2001) = lu(k,2001) - lu(k,864) * lu(k,1999) + lu(k,2004) = lu(k,2004) - lu(k,865) * lu(k,1999) + lu(k,2005) = lu(k,2005) - lu(k,866) * lu(k,1999) + lu(k,2006) = lu(k,2006) - lu(k,867) * lu(k,1999) + lu(k,2007) = lu(k,2007) - lu(k,868) * lu(k,1999) + lu(k,2008) = lu(k,2008) - lu(k,869) * lu(k,1999) + lu(k,2009) = lu(k,2009) - lu(k,870) * lu(k,1999) + lu(k,2010) = lu(k,2010) - lu(k,871) * lu(k,1999) + lu(k,2011) = lu(k,2011) - lu(k,872) * lu(k,1999) + lu(k,2012) = lu(k,2012) - lu(k,873) * lu(k,1999) + lu(k,2013) = lu(k,2013) - lu(k,874) * lu(k,1999) + lu(k,2014) = lu(k,2014) - lu(k,875) * lu(k,1999) + lu(k,2016) = lu(k,2016) - lu(k,876) * lu(k,1999) + lu(k,2017) = lu(k,2017) - lu(k,877) * lu(k,1999) + lu(k,2018) = lu(k,2018) - lu(k,878) * lu(k,1999) + lu(k,2019) = lu(k,2019) - lu(k,879) * lu(k,1999) + lu(k,2021) = lu(k,2021) - lu(k,880) * lu(k,1999) + lu(k,2024) = lu(k,2024) - lu(k,881) * lu(k,1999) + lu(k,2026) = lu(k,2026) - lu(k,882) * lu(k,1999) + lu(k,2027) = lu(k,2027) - lu(k,883) * lu(k,1999) + lu(k,2061) = lu(k,2061) - lu(k,864) * lu(k,2059) + lu(k,2064) = lu(k,2064) - lu(k,865) * lu(k,2059) + lu(k,2065) = lu(k,2065) - lu(k,866) * lu(k,2059) + lu(k,2066) = lu(k,2066) - lu(k,867) * lu(k,2059) + lu(k,2067) = lu(k,2067) - lu(k,868) * lu(k,2059) + lu(k,2068) = lu(k,2068) - lu(k,869) * lu(k,2059) + lu(k,2069) = lu(k,2069) - lu(k,870) * lu(k,2059) + lu(k,2070) = lu(k,2070) - lu(k,871) * lu(k,2059) + lu(k,2071) = lu(k,2071) - lu(k,872) * lu(k,2059) + lu(k,2072) = lu(k,2072) - lu(k,873) * lu(k,2059) + lu(k,2073) = lu(k,2073) - lu(k,874) * lu(k,2059) + lu(k,2074) = lu(k,2074) - lu(k,875) * lu(k,2059) + lu(k,2076) = lu(k,2076) - lu(k,876) * lu(k,2059) + lu(k,2077) = lu(k,2077) - lu(k,877) * lu(k,2059) + lu(k,2078) = lu(k,2078) - lu(k,878) * lu(k,2059) + lu(k,2079) = lu(k,2079) - lu(k,879) * lu(k,2059) + lu(k,2081) = lu(k,2081) - lu(k,880) * lu(k,2059) + lu(k,2084) = lu(k,2084) - lu(k,881) * lu(k,2059) + lu(k,2086) = lu(k,2086) - lu(k,882) * lu(k,2059) + lu(k,2087) = lu(k,2087) - lu(k,883) * lu(k,2059) + lu(k,897) = 1._r8 / lu(k,897) + lu(k,898) = lu(k,898) * lu(k,897) + lu(k,899) = lu(k,899) * lu(k,897) + lu(k,900) = lu(k,900) * lu(k,897) + lu(k,901) = lu(k,901) * lu(k,897) + lu(k,902) = lu(k,902) * lu(k,897) + lu(k,903) = lu(k,903) * lu(k,897) + lu(k,904) = lu(k,904) * lu(k,897) + lu(k,905) = lu(k,905) * lu(k,897) + lu(k,906) = lu(k,906) * lu(k,897) + lu(k,907) = lu(k,907) * lu(k,897) + lu(k,908) = lu(k,908) * lu(k,897) + lu(k,909) = lu(k,909) * lu(k,897) + lu(k,910) = lu(k,910) * lu(k,897) + lu(k,911) = lu(k,911) * lu(k,897) + lu(k,912) = lu(k,912) * lu(k,897) + lu(k,913) = lu(k,913) * lu(k,897) + lu(k,914) = lu(k,914) * lu(k,897) + lu(k,915) = lu(k,915) * lu(k,897) + lu(k,916) = lu(k,916) * lu(k,897) + lu(k,917) = lu(k,917) * lu(k,897) + lu(k,918) = lu(k,918) * lu(k,897) + lu(k,981) = lu(k,981) - lu(k,898) * lu(k,980) + lu(k,982) = lu(k,982) - lu(k,899) * lu(k,980) + lu(k,983) = lu(k,983) - lu(k,900) * lu(k,980) + lu(k,985) = lu(k,985) - lu(k,901) * lu(k,980) + lu(k,986) = lu(k,986) - lu(k,902) * lu(k,980) + lu(k,987) = lu(k,987) - lu(k,903) * lu(k,980) + lu(k,988) = lu(k,988) - lu(k,904) * lu(k,980) + lu(k,989) = lu(k,989) - lu(k,905) * lu(k,980) + lu(k,990) = lu(k,990) - lu(k,906) * lu(k,980) + lu(k,991) = lu(k,991) - lu(k,907) * lu(k,980) + lu(k,992) = lu(k,992) - lu(k,908) * lu(k,980) + lu(k,993) = lu(k,993) - lu(k,909) * lu(k,980) + lu(k,994) = lu(k,994) - lu(k,910) * lu(k,980) + lu(k,995) = lu(k,995) - lu(k,911) * lu(k,980) + lu(k,996) = lu(k,996) - lu(k,912) * lu(k,980) + lu(k,997) = lu(k,997) - lu(k,913) * lu(k,980) + lu(k,998) = lu(k,998) - lu(k,914) * lu(k,980) + lu(k,999) = lu(k,999) - lu(k,915) * lu(k,980) + lu(k,1000) = lu(k,1000) - lu(k,916) * lu(k,980) + lu(k,1001) = lu(k,1001) - lu(k,917) * lu(k,980) + lu(k,1002) = lu(k,1002) - lu(k,918) * lu(k,980) + lu(k,1054) = lu(k,1054) - lu(k,898) * lu(k,1053) + lu(k,1055) = lu(k,1055) - lu(k,899) * lu(k,1053) + lu(k,1056) = lu(k,1056) - lu(k,900) * lu(k,1053) + lu(k,1059) = lu(k,1059) - lu(k,901) * lu(k,1053) + lu(k,1060) = lu(k,1060) - lu(k,902) * lu(k,1053) + lu(k,1061) = lu(k,1061) - lu(k,903) * lu(k,1053) + lu(k,1062) = lu(k,1062) - lu(k,904) * lu(k,1053) + lu(k,1064) = lu(k,1064) - lu(k,905) * lu(k,1053) + lu(k,1065) = lu(k,1065) - lu(k,906) * lu(k,1053) + lu(k,1066) = lu(k,1066) - lu(k,907) * lu(k,1053) + lu(k,1067) = lu(k,1067) - lu(k,908) * lu(k,1053) + lu(k,1068) = lu(k,1068) - lu(k,909) * lu(k,1053) + lu(k,1070) = lu(k,1070) - lu(k,910) * lu(k,1053) + lu(k,1071) = lu(k,1071) - lu(k,911) * lu(k,1053) + lu(k,1072) = lu(k,1072) - lu(k,912) * lu(k,1053) + lu(k,1073) = lu(k,1073) - lu(k,913) * lu(k,1053) + lu(k,1074) = lu(k,1074) - lu(k,914) * lu(k,1053) + lu(k,1075) = lu(k,1075) - lu(k,915) * lu(k,1053) + lu(k,1076) = lu(k,1076) - lu(k,916) * lu(k,1053) + lu(k,1077) = lu(k,1077) - lu(k,917) * lu(k,1053) + lu(k,1078) = lu(k,1078) - lu(k,918) * lu(k,1053) + lu(k,1094) = lu(k,1094) - lu(k,898) * lu(k,1092) + lu(k,1095) = lu(k,1095) - lu(k,899) * lu(k,1092) + lu(k,1096) = lu(k,1096) - lu(k,900) * lu(k,1092) + lu(k,1099) = lu(k,1099) - lu(k,901) * lu(k,1092) + lu(k,1100) = lu(k,1100) - lu(k,902) * lu(k,1092) + lu(k,1101) = lu(k,1101) - lu(k,903) * lu(k,1092) + lu(k,1102) = lu(k,1102) - lu(k,904) * lu(k,1092) + lu(k,1104) = lu(k,1104) - lu(k,905) * lu(k,1092) + lu(k,1105) = lu(k,1105) - lu(k,906) * lu(k,1092) + lu(k,1106) = lu(k,1106) - lu(k,907) * lu(k,1092) + lu(k,1107) = lu(k,1107) - lu(k,908) * lu(k,1092) + lu(k,1108) = lu(k,1108) - lu(k,909) * lu(k,1092) + lu(k,1110) = lu(k,1110) - lu(k,910) * lu(k,1092) + lu(k,1111) = lu(k,1111) - lu(k,911) * lu(k,1092) + lu(k,1112) = lu(k,1112) - lu(k,912) * lu(k,1092) + lu(k,1113) = lu(k,1113) - lu(k,913) * lu(k,1092) + lu(k,1114) = lu(k,1114) - lu(k,914) * lu(k,1092) + lu(k,1115) = lu(k,1115) - lu(k,915) * lu(k,1092) + lu(k,1116) = lu(k,1116) - lu(k,916) * lu(k,1092) + lu(k,1117) = lu(k,1117) - lu(k,917) * lu(k,1092) + lu(k,1118) = lu(k,1118) - lu(k,918) * lu(k,1092) + lu(k,1141) = lu(k,1141) - lu(k,898) * lu(k,1139) + lu(k,1143) = lu(k,1143) - lu(k,899) * lu(k,1139) + lu(k,1144) = lu(k,1144) - lu(k,900) * lu(k,1139) + lu(k,1147) = lu(k,1147) - lu(k,901) * lu(k,1139) + lu(k,1148) = lu(k,1148) - lu(k,902) * lu(k,1139) + lu(k,1149) = lu(k,1149) - lu(k,903) * lu(k,1139) + lu(k,1150) = lu(k,1150) - lu(k,904) * lu(k,1139) + lu(k,1152) = lu(k,1152) - lu(k,905) * lu(k,1139) + lu(k,1153) = lu(k,1153) - lu(k,906) * lu(k,1139) + lu(k,1154) = lu(k,1154) - lu(k,907) * lu(k,1139) + lu(k,1155) = lu(k,1155) - lu(k,908) * lu(k,1139) + lu(k,1156) = lu(k,1156) - lu(k,909) * lu(k,1139) + lu(k,1158) = lu(k,1158) - lu(k,910) * lu(k,1139) + lu(k,1159) = lu(k,1159) - lu(k,911) * lu(k,1139) + lu(k,1160) = lu(k,1160) - lu(k,912) * lu(k,1139) + lu(k,1161) = lu(k,1161) - lu(k,913) * lu(k,1139) + lu(k,1162) = lu(k,1162) - lu(k,914) * lu(k,1139) + lu(k,1163) = lu(k,1163) - lu(k,915) * lu(k,1139) + lu(k,1164) = lu(k,1164) - lu(k,916) * lu(k,1139) + lu(k,1165) = lu(k,1165) - lu(k,917) * lu(k,1139) + lu(k,1166) = lu(k,1166) - lu(k,918) * lu(k,1139) + lu(k,1184) = lu(k,1184) - lu(k,898) * lu(k,1182) + lu(k,1186) = lu(k,1186) - lu(k,899) * lu(k,1182) + lu(k,1187) = lu(k,1187) - lu(k,900) * lu(k,1182) + lu(k,1190) = lu(k,1190) - lu(k,901) * lu(k,1182) + lu(k,1191) = lu(k,1191) - lu(k,902) * lu(k,1182) + lu(k,1192) = lu(k,1192) - lu(k,903) * lu(k,1182) + lu(k,1193) = lu(k,1193) - lu(k,904) * lu(k,1182) + lu(k,1195) = lu(k,1195) - lu(k,905) * lu(k,1182) + lu(k,1196) = lu(k,1196) - lu(k,906) * lu(k,1182) + lu(k,1197) = lu(k,1197) - lu(k,907) * lu(k,1182) + lu(k,1198) = lu(k,1198) - lu(k,908) * lu(k,1182) + lu(k,1199) = lu(k,1199) - lu(k,909) * lu(k,1182) + lu(k,1201) = lu(k,1201) - lu(k,910) * lu(k,1182) + lu(k,1202) = lu(k,1202) - lu(k,911) * lu(k,1182) + lu(k,1203) = lu(k,1203) - lu(k,912) * lu(k,1182) + lu(k,1204) = lu(k,1204) - lu(k,913) * lu(k,1182) + lu(k,1205) = lu(k,1205) - lu(k,914) * lu(k,1182) + lu(k,1206) = lu(k,1206) - lu(k,915) * lu(k,1182) + lu(k,1207) = lu(k,1207) - lu(k,916) * lu(k,1182) + lu(k,1208) = lu(k,1208) - lu(k,917) * lu(k,1182) + lu(k,1209) = lu(k,1209) - lu(k,918) * lu(k,1182) + lu(k,1225) = lu(k,1225) - lu(k,898) * lu(k,1223) + lu(k,1227) = lu(k,1227) - lu(k,899) * lu(k,1223) + lu(k,1228) = lu(k,1228) - lu(k,900) * lu(k,1223) + lu(k,1231) = lu(k,1231) - lu(k,901) * lu(k,1223) + lu(k,1232) = lu(k,1232) - lu(k,902) * lu(k,1223) + lu(k,1233) = lu(k,1233) - lu(k,903) * lu(k,1223) + lu(k,1234) = lu(k,1234) - lu(k,904) * lu(k,1223) + lu(k,1236) = lu(k,1236) - lu(k,905) * lu(k,1223) + lu(k,1237) = lu(k,1237) - lu(k,906) * lu(k,1223) + lu(k,1238) = lu(k,1238) - lu(k,907) * lu(k,1223) + lu(k,1239) = lu(k,1239) - lu(k,908) * lu(k,1223) + lu(k,1240) = lu(k,1240) - lu(k,909) * lu(k,1223) + lu(k,1242) = lu(k,1242) - lu(k,910) * lu(k,1223) + lu(k,1243) = lu(k,1243) - lu(k,911) * lu(k,1223) + lu(k,1244) = lu(k,1244) - lu(k,912) * lu(k,1223) + lu(k,1245) = lu(k,1245) - lu(k,913) * lu(k,1223) + lu(k,1246) = lu(k,1246) - lu(k,914) * lu(k,1223) + lu(k,1247) = lu(k,1247) - lu(k,915) * lu(k,1223) + lu(k,1248) = lu(k,1248) - lu(k,916) * lu(k,1223) + lu(k,1249) = lu(k,1249) - lu(k,917) * lu(k,1223) + lu(k,1250) = lu(k,1250) - lu(k,918) * lu(k,1223) + lu(k,1285) = lu(k,1285) - lu(k,898) * lu(k,1283) + lu(k,1287) = lu(k,1287) - lu(k,899) * lu(k,1283) + lu(k,1288) = lu(k,1288) - lu(k,900) * lu(k,1283) + lu(k,1291) = lu(k,1291) - lu(k,901) * lu(k,1283) + lu(k,1292) = lu(k,1292) - lu(k,902) * lu(k,1283) + lu(k,1293) = lu(k,1293) - lu(k,903) * lu(k,1283) + lu(k,1294) = lu(k,1294) - lu(k,904) * lu(k,1283) + lu(k,1296) = lu(k,1296) - lu(k,905) * lu(k,1283) + lu(k,1297) = lu(k,1297) - lu(k,906) * lu(k,1283) + lu(k,1298) = lu(k,1298) - lu(k,907) * lu(k,1283) + lu(k,1299) = lu(k,1299) - lu(k,908) * lu(k,1283) + lu(k,1300) = lu(k,1300) - lu(k,909) * lu(k,1283) + lu(k,1302) = lu(k,1302) - lu(k,910) * lu(k,1283) + lu(k,1303) = lu(k,1303) - lu(k,911) * lu(k,1283) + lu(k,1304) = lu(k,1304) - lu(k,912) * lu(k,1283) + lu(k,1305) = lu(k,1305) - lu(k,913) * lu(k,1283) + lu(k,1306) = lu(k,1306) - lu(k,914) * lu(k,1283) + lu(k,1307) = lu(k,1307) - lu(k,915) * lu(k,1283) + lu(k,1308) = lu(k,1308) - lu(k,916) * lu(k,1283) + lu(k,1309) = lu(k,1309) - lu(k,917) * lu(k,1283) + lu(k,1310) = lu(k,1310) - lu(k,918) * lu(k,1283) + lu(k,1327) = lu(k,1327) - lu(k,898) * lu(k,1325) + lu(k,1329) = lu(k,1329) - lu(k,899) * lu(k,1325) + lu(k,1330) = lu(k,1330) - lu(k,900) * lu(k,1325) + lu(k,1333) = lu(k,1333) - lu(k,901) * lu(k,1325) + lu(k,1334) = lu(k,1334) - lu(k,902) * lu(k,1325) + lu(k,1335) = lu(k,1335) - lu(k,903) * lu(k,1325) + lu(k,1336) = lu(k,1336) - lu(k,904) * lu(k,1325) + lu(k,1338) = lu(k,1338) - lu(k,905) * lu(k,1325) + lu(k,1339) = lu(k,1339) - lu(k,906) * lu(k,1325) + lu(k,1340) = lu(k,1340) - lu(k,907) * lu(k,1325) + lu(k,1341) = lu(k,1341) - lu(k,908) * lu(k,1325) + lu(k,1342) = lu(k,1342) - lu(k,909) * lu(k,1325) + lu(k,1344) = lu(k,1344) - lu(k,910) * lu(k,1325) + lu(k,1345) = lu(k,1345) - lu(k,911) * lu(k,1325) + lu(k,1346) = lu(k,1346) - lu(k,912) * lu(k,1325) + lu(k,1347) = lu(k,1347) - lu(k,913) * lu(k,1325) + lu(k,1348) = lu(k,1348) - lu(k,914) * lu(k,1325) + lu(k,1349) = lu(k,1349) - lu(k,915) * lu(k,1325) + lu(k,1350) = lu(k,1350) - lu(k,916) * lu(k,1325) + lu(k,1351) = lu(k,1351) - lu(k,917) * lu(k,1325) + lu(k,1352) = lu(k,1352) - lu(k,918) * lu(k,1325) + lu(k,1363) = lu(k,1363) - lu(k,898) * lu(k,1361) + lu(k,1365) = lu(k,1365) - lu(k,899) * lu(k,1361) + lu(k,1366) = lu(k,1366) - lu(k,900) * lu(k,1361) + lu(k,1369) = lu(k,1369) - lu(k,901) * lu(k,1361) + lu(k,1370) = lu(k,1370) - lu(k,902) * lu(k,1361) + lu(k,1371) = lu(k,1371) - lu(k,903) * lu(k,1361) + lu(k,1372) = lu(k,1372) - lu(k,904) * lu(k,1361) + lu(k,1374) = lu(k,1374) - lu(k,905) * lu(k,1361) + lu(k,1375) = lu(k,1375) - lu(k,906) * lu(k,1361) + lu(k,1376) = lu(k,1376) - lu(k,907) * lu(k,1361) + lu(k,1377) = lu(k,1377) - lu(k,908) * lu(k,1361) + lu(k,1378) = lu(k,1378) - lu(k,909) * lu(k,1361) + lu(k,1380) = lu(k,1380) - lu(k,910) * lu(k,1361) + lu(k,1381) = lu(k,1381) - lu(k,911) * lu(k,1361) + lu(k,1382) = lu(k,1382) - lu(k,912) * lu(k,1361) + lu(k,1383) = lu(k,1383) - lu(k,913) * lu(k,1361) + lu(k,1384) = lu(k,1384) - lu(k,914) * lu(k,1361) + lu(k,1385) = lu(k,1385) - lu(k,915) * lu(k,1361) + lu(k,1386) = lu(k,1386) - lu(k,916) * lu(k,1361) + lu(k,1387) = lu(k,1387) - lu(k,917) * lu(k,1361) + lu(k,1388) = lu(k,1388) - lu(k,918) * lu(k,1361) + lu(k,1406) = lu(k,1406) - lu(k,898) * lu(k,1404) + lu(k,1408) = lu(k,1408) - lu(k,899) * lu(k,1404) + lu(k,1409) = lu(k,1409) - lu(k,900) * lu(k,1404) + lu(k,1412) = lu(k,1412) - lu(k,901) * lu(k,1404) + lu(k,1413) = lu(k,1413) - lu(k,902) * lu(k,1404) + lu(k,1414) = lu(k,1414) - lu(k,903) * lu(k,1404) + lu(k,1415) = lu(k,1415) - lu(k,904) * lu(k,1404) + lu(k,1417) = lu(k,1417) - lu(k,905) * lu(k,1404) + lu(k,1418) = lu(k,1418) - lu(k,906) * lu(k,1404) + lu(k,1419) = lu(k,1419) - lu(k,907) * lu(k,1404) + lu(k,1420) = lu(k,1420) - lu(k,908) * lu(k,1404) + lu(k,1421) = lu(k,1421) - lu(k,909) * lu(k,1404) + lu(k,1423) = lu(k,1423) - lu(k,910) * lu(k,1404) + lu(k,1424) = lu(k,1424) - lu(k,911) * lu(k,1404) + lu(k,1425) = lu(k,1425) - lu(k,912) * lu(k,1404) + lu(k,1426) = lu(k,1426) - lu(k,913) * lu(k,1404) + lu(k,1427) = lu(k,1427) - lu(k,914) * lu(k,1404) + lu(k,1428) = lu(k,1428) - lu(k,915) * lu(k,1404) + lu(k,1429) = lu(k,1429) - lu(k,916) * lu(k,1404) + lu(k,1430) = lu(k,1430) - lu(k,917) * lu(k,1404) + lu(k,1431) = lu(k,1431) - lu(k,918) * lu(k,1404) + lu(k,1449) = lu(k,1449) - lu(k,898) * lu(k,1447) + lu(k,1451) = lu(k,1451) - lu(k,899) * lu(k,1447) + lu(k,1452) = lu(k,1452) - lu(k,900) * lu(k,1447) + lu(k,1455) = lu(k,1455) - lu(k,901) * lu(k,1447) + lu(k,1456) = lu(k,1456) - lu(k,902) * lu(k,1447) + lu(k,1457) = lu(k,1457) - lu(k,903) * lu(k,1447) + lu(k,1458) = lu(k,1458) - lu(k,904) * lu(k,1447) + lu(k,1460) = lu(k,1460) - lu(k,905) * lu(k,1447) + lu(k,1461) = lu(k,1461) - lu(k,906) * lu(k,1447) + lu(k,1462) = lu(k,1462) - lu(k,907) * lu(k,1447) + lu(k,1463) = lu(k,1463) - lu(k,908) * lu(k,1447) + lu(k,1464) = lu(k,1464) - lu(k,909) * lu(k,1447) + lu(k,1466) = lu(k,1466) - lu(k,910) * lu(k,1447) + lu(k,1467) = lu(k,1467) - lu(k,911) * lu(k,1447) + lu(k,1468) = lu(k,1468) - lu(k,912) * lu(k,1447) + lu(k,1469) = lu(k,1469) - lu(k,913) * lu(k,1447) + lu(k,1470) = lu(k,1470) - lu(k,914) * lu(k,1447) + lu(k,1471) = lu(k,1471) - lu(k,915) * lu(k,1447) + lu(k,1472) = lu(k,1472) - lu(k,916) * lu(k,1447) + lu(k,1473) = lu(k,1473) - lu(k,917) * lu(k,1447) + lu(k,1474) = lu(k,1474) - lu(k,918) * lu(k,1447) + lu(k,1494) = lu(k,1494) - lu(k,898) * lu(k,1492) + lu(k,1496) = lu(k,1496) - lu(k,899) * lu(k,1492) + lu(k,1497) = lu(k,1497) - lu(k,900) * lu(k,1492) + lu(k,1500) = lu(k,1500) - lu(k,901) * lu(k,1492) + lu(k,1501) = lu(k,1501) - lu(k,902) * lu(k,1492) + lu(k,1502) = lu(k,1502) - lu(k,903) * lu(k,1492) + lu(k,1503) = lu(k,1503) - lu(k,904) * lu(k,1492) + lu(k,1505) = lu(k,1505) - lu(k,905) * lu(k,1492) + lu(k,1506) = lu(k,1506) - lu(k,906) * lu(k,1492) + lu(k,1507) = lu(k,1507) - lu(k,907) * lu(k,1492) + lu(k,1508) = lu(k,1508) - lu(k,908) * lu(k,1492) + lu(k,1509) = lu(k,1509) - lu(k,909) * lu(k,1492) + lu(k,1511) = lu(k,1511) - lu(k,910) * lu(k,1492) + lu(k,1512) = lu(k,1512) - lu(k,911) * lu(k,1492) + lu(k,1513) = lu(k,1513) - lu(k,912) * lu(k,1492) + lu(k,1514) = lu(k,1514) - lu(k,913) * lu(k,1492) + lu(k,1515) = lu(k,1515) - lu(k,914) * lu(k,1492) + lu(k,1516) = lu(k,1516) - lu(k,915) * lu(k,1492) + lu(k,1517) = lu(k,1517) - lu(k,916) * lu(k,1492) + lu(k,1518) = lu(k,1518) - lu(k,917) * lu(k,1492) + lu(k,1519) = lu(k,1519) - lu(k,918) * lu(k,1492) + lu(k,1530) = lu(k,1530) - lu(k,898) * lu(k,1528) + lu(k,1532) = lu(k,1532) - lu(k,899) * lu(k,1528) + lu(k,1533) = lu(k,1533) - lu(k,900) * lu(k,1528) + lu(k,1536) = lu(k,1536) - lu(k,901) * lu(k,1528) + lu(k,1537) = lu(k,1537) - lu(k,902) * lu(k,1528) + lu(k,1538) = lu(k,1538) - lu(k,903) * lu(k,1528) + lu(k,1539) = lu(k,1539) - lu(k,904) * lu(k,1528) + lu(k,1541) = lu(k,1541) - lu(k,905) * lu(k,1528) + lu(k,1542) = lu(k,1542) - lu(k,906) * lu(k,1528) + lu(k,1543) = lu(k,1543) - lu(k,907) * lu(k,1528) + lu(k,1544) = lu(k,1544) - lu(k,908) * lu(k,1528) + lu(k,1545) = lu(k,1545) - lu(k,909) * lu(k,1528) + lu(k,1547) = lu(k,1547) - lu(k,910) * lu(k,1528) + lu(k,1548) = lu(k,1548) - lu(k,911) * lu(k,1528) + lu(k,1549) = lu(k,1549) - lu(k,912) * lu(k,1528) + lu(k,1550) = lu(k,1550) - lu(k,913) * lu(k,1528) + lu(k,1551) = lu(k,1551) - lu(k,914) * lu(k,1528) + lu(k,1552) = lu(k,1552) - lu(k,915) * lu(k,1528) + lu(k,1553) = lu(k,1553) - lu(k,916) * lu(k,1528) + lu(k,1554) = lu(k,1554) - lu(k,917) * lu(k,1528) + lu(k,1555) = lu(k,1555) - lu(k,918) * lu(k,1528) + lu(k,1575) = lu(k,1575) - lu(k,898) * lu(k,1573) + lu(k,1577) = lu(k,1577) - lu(k,899) * lu(k,1573) + lu(k,1578) = lu(k,1578) - lu(k,900) * lu(k,1573) + lu(k,1581) = lu(k,1581) - lu(k,901) * lu(k,1573) + lu(k,1582) = lu(k,1582) - lu(k,902) * lu(k,1573) + lu(k,1583) = lu(k,1583) - lu(k,903) * lu(k,1573) + lu(k,1584) = lu(k,1584) - lu(k,904) * lu(k,1573) + lu(k,1586) = lu(k,1586) - lu(k,905) * lu(k,1573) + lu(k,1587) = lu(k,1587) - lu(k,906) * lu(k,1573) + lu(k,1588) = lu(k,1588) - lu(k,907) * lu(k,1573) + lu(k,1589) = lu(k,1589) - lu(k,908) * lu(k,1573) + lu(k,1590) = lu(k,1590) - lu(k,909) * lu(k,1573) + lu(k,1592) = lu(k,1592) - lu(k,910) * lu(k,1573) + lu(k,1593) = lu(k,1593) - lu(k,911) * lu(k,1573) + lu(k,1594) = lu(k,1594) - lu(k,912) * lu(k,1573) + lu(k,1595) = lu(k,1595) - lu(k,913) * lu(k,1573) + lu(k,1596) = lu(k,1596) - lu(k,914) * lu(k,1573) + lu(k,1597) = lu(k,1597) - lu(k,915) * lu(k,1573) + lu(k,1598) = lu(k,1598) - lu(k,916) * lu(k,1573) + lu(k,1599) = lu(k,1599) - lu(k,917) * lu(k,1573) + lu(k,1600) = lu(k,1600) - lu(k,918) * lu(k,1573) + lu(k,1623) = lu(k,1623) - lu(k,898) * lu(k,1621) + lu(k,1625) = lu(k,1625) - lu(k,899) * lu(k,1621) + lu(k,1626) = lu(k,1626) - lu(k,900) * lu(k,1621) + lu(k,1629) = lu(k,1629) - lu(k,901) * lu(k,1621) + lu(k,1630) = lu(k,1630) - lu(k,902) * lu(k,1621) + lu(k,1631) = lu(k,1631) - lu(k,903) * lu(k,1621) + lu(k,1632) = lu(k,1632) - lu(k,904) * lu(k,1621) + lu(k,1634) = lu(k,1634) - lu(k,905) * lu(k,1621) + lu(k,1635) = lu(k,1635) - lu(k,906) * lu(k,1621) + lu(k,1636) = lu(k,1636) - lu(k,907) * lu(k,1621) + lu(k,1637) = lu(k,1637) - lu(k,908) * lu(k,1621) + lu(k,1638) = lu(k,1638) - lu(k,909) * lu(k,1621) + lu(k,1640) = lu(k,1640) - lu(k,910) * lu(k,1621) + lu(k,1641) = lu(k,1641) - lu(k,911) * lu(k,1621) + lu(k,1642) = lu(k,1642) - lu(k,912) * lu(k,1621) + lu(k,1643) = lu(k,1643) - lu(k,913) * lu(k,1621) + lu(k,1644) = lu(k,1644) - lu(k,914) * lu(k,1621) + lu(k,1645) = lu(k,1645) - lu(k,915) * lu(k,1621) + lu(k,1646) = lu(k,1646) - lu(k,916) * lu(k,1621) + lu(k,1647) = lu(k,1647) - lu(k,917) * lu(k,1621) + lu(k,1648) = lu(k,1648) - lu(k,918) * lu(k,1621) + lu(k,1666) = lu(k,1666) - lu(k,898) * lu(k,1664) + lu(k,1668) = lu(k,1668) - lu(k,899) * lu(k,1664) + lu(k,1669) = lu(k,1669) - lu(k,900) * lu(k,1664) + lu(k,1672) = lu(k,1672) - lu(k,901) * lu(k,1664) + lu(k,1673) = lu(k,1673) - lu(k,902) * lu(k,1664) + lu(k,1674) = lu(k,1674) - lu(k,903) * lu(k,1664) + lu(k,1675) = lu(k,1675) - lu(k,904) * lu(k,1664) + lu(k,1677) = lu(k,1677) - lu(k,905) * lu(k,1664) + lu(k,1678) = lu(k,1678) - lu(k,906) * lu(k,1664) + lu(k,1679) = lu(k,1679) - lu(k,907) * lu(k,1664) + lu(k,1680) = lu(k,1680) - lu(k,908) * lu(k,1664) + lu(k,1681) = lu(k,1681) - lu(k,909) * lu(k,1664) + lu(k,1683) = lu(k,1683) - lu(k,910) * lu(k,1664) + lu(k,1684) = lu(k,1684) - lu(k,911) * lu(k,1664) + lu(k,1685) = lu(k,1685) - lu(k,912) * lu(k,1664) + lu(k,1686) = lu(k,1686) - lu(k,913) * lu(k,1664) + lu(k,1687) = lu(k,1687) - lu(k,914) * lu(k,1664) + lu(k,1688) = lu(k,1688) - lu(k,915) * lu(k,1664) + lu(k,1689) = lu(k,1689) - lu(k,916) * lu(k,1664) + lu(k,1690) = lu(k,1690) - lu(k,917) * lu(k,1664) + lu(k,1691) = lu(k,1691) - lu(k,918) * lu(k,1664) + lu(k,1708) = lu(k,1708) - lu(k,898) * lu(k,1706) + lu(k,1710) = lu(k,1710) - lu(k,899) * lu(k,1706) + lu(k,1711) = lu(k,1711) - lu(k,900) * lu(k,1706) + lu(k,1714) = lu(k,1714) - lu(k,901) * lu(k,1706) + lu(k,1715) = lu(k,1715) - lu(k,902) * lu(k,1706) + lu(k,1716) = lu(k,1716) - lu(k,903) * lu(k,1706) + lu(k,1717) = lu(k,1717) - lu(k,904) * lu(k,1706) + lu(k,1719) = lu(k,1719) - lu(k,905) * lu(k,1706) + lu(k,1720) = lu(k,1720) - lu(k,906) * lu(k,1706) + lu(k,1721) = lu(k,1721) - lu(k,907) * lu(k,1706) + lu(k,1722) = lu(k,1722) - lu(k,908) * lu(k,1706) + lu(k,1723) = lu(k,1723) - lu(k,909) * lu(k,1706) + lu(k,1725) = lu(k,1725) - lu(k,910) * lu(k,1706) + lu(k,1726) = lu(k,1726) - lu(k,911) * lu(k,1706) + lu(k,1727) = lu(k,1727) - lu(k,912) * lu(k,1706) + lu(k,1728) = lu(k,1728) - lu(k,913) * lu(k,1706) + lu(k,1729) = lu(k,1729) - lu(k,914) * lu(k,1706) + lu(k,1730) = lu(k,1730) - lu(k,915) * lu(k,1706) + lu(k,1731) = lu(k,1731) - lu(k,916) * lu(k,1706) + lu(k,1732) = lu(k,1732) - lu(k,917) * lu(k,1706) + lu(k,1733) = lu(k,1733) - lu(k,918) * lu(k,1706) + lu(k,1753) = lu(k,1753) - lu(k,898) * lu(k,1751) + lu(k,1755) = lu(k,1755) - lu(k,899) * lu(k,1751) + lu(k,1756) = lu(k,1756) - lu(k,900) * lu(k,1751) + lu(k,1759) = lu(k,1759) - lu(k,901) * lu(k,1751) + lu(k,1760) = lu(k,1760) - lu(k,902) * lu(k,1751) + lu(k,1761) = lu(k,1761) - lu(k,903) * lu(k,1751) + lu(k,1762) = lu(k,1762) - lu(k,904) * lu(k,1751) + lu(k,1764) = lu(k,1764) - lu(k,905) * lu(k,1751) + lu(k,1765) = lu(k,1765) - lu(k,906) * lu(k,1751) + lu(k,1766) = lu(k,1766) - lu(k,907) * lu(k,1751) + lu(k,1767) = lu(k,1767) - lu(k,908) * lu(k,1751) + lu(k,1768) = lu(k,1768) - lu(k,909) * lu(k,1751) + lu(k,1770) = lu(k,1770) - lu(k,910) * lu(k,1751) + lu(k,1771) = lu(k,1771) - lu(k,911) * lu(k,1751) + lu(k,1772) = lu(k,1772) - lu(k,912) * lu(k,1751) + lu(k,1773) = lu(k,1773) - lu(k,913) * lu(k,1751) + lu(k,1774) = lu(k,1774) - lu(k,914) * lu(k,1751) + lu(k,1775) = lu(k,1775) - lu(k,915) * lu(k,1751) + lu(k,1776) = lu(k,1776) - lu(k,916) * lu(k,1751) + lu(k,1777) = lu(k,1777) - lu(k,917) * lu(k,1751) + lu(k,1778) = lu(k,1778) - lu(k,918) * lu(k,1751) + lu(k,1802) = lu(k,1802) - lu(k,898) * lu(k,1800) + lu(k,1804) = lu(k,1804) - lu(k,899) * lu(k,1800) + lu(k,1805) = lu(k,1805) - lu(k,900) * lu(k,1800) + lu(k,1808) = lu(k,1808) - lu(k,901) * lu(k,1800) + lu(k,1809) = lu(k,1809) - lu(k,902) * lu(k,1800) + lu(k,1810) = lu(k,1810) - lu(k,903) * lu(k,1800) + lu(k,1811) = lu(k,1811) - lu(k,904) * lu(k,1800) + lu(k,1813) = lu(k,1813) - lu(k,905) * lu(k,1800) + lu(k,1814) = lu(k,1814) - lu(k,906) * lu(k,1800) + lu(k,1815) = lu(k,1815) - lu(k,907) * lu(k,1800) + lu(k,1816) = lu(k,1816) - lu(k,908) * lu(k,1800) + lu(k,1817) = lu(k,1817) - lu(k,909) * lu(k,1800) + lu(k,1819) = lu(k,1819) - lu(k,910) * lu(k,1800) + lu(k,1820) = lu(k,1820) - lu(k,911) * lu(k,1800) + lu(k,1821) = lu(k,1821) - lu(k,912) * lu(k,1800) + lu(k,1822) = lu(k,1822) - lu(k,913) * lu(k,1800) + lu(k,1823) = lu(k,1823) - lu(k,914) * lu(k,1800) + lu(k,1824) = lu(k,1824) - lu(k,915) * lu(k,1800) + lu(k,1825) = lu(k,1825) - lu(k,916) * lu(k,1800) + lu(k,1826) = lu(k,1826) - lu(k,917) * lu(k,1800) + lu(k,1827) = lu(k,1827) - lu(k,918) * lu(k,1800) + lu(k,1835) = lu(k,1835) - lu(k,898) * lu(k,1833) + lu(k,1837) = lu(k,1837) - lu(k,899) * lu(k,1833) + lu(k,1838) = lu(k,1838) - lu(k,900) * lu(k,1833) + lu(k,1841) = lu(k,1841) - lu(k,901) * lu(k,1833) + lu(k,1842) = lu(k,1842) - lu(k,902) * lu(k,1833) + lu(k,1843) = lu(k,1843) - lu(k,903) * lu(k,1833) + lu(k,1844) = lu(k,1844) - lu(k,904) * lu(k,1833) + lu(k,1846) = lu(k,1846) - lu(k,905) * lu(k,1833) + lu(k,1847) = lu(k,1847) - lu(k,906) * lu(k,1833) + lu(k,1848) = lu(k,1848) - lu(k,907) * lu(k,1833) + lu(k,1849) = lu(k,1849) - lu(k,908) * lu(k,1833) + lu(k,1850) = lu(k,1850) - lu(k,909) * lu(k,1833) + lu(k,1852) = lu(k,1852) - lu(k,910) * lu(k,1833) + lu(k,1853) = lu(k,1853) - lu(k,911) * lu(k,1833) + lu(k,1854) = lu(k,1854) - lu(k,912) * lu(k,1833) + lu(k,1855) = lu(k,1855) - lu(k,913) * lu(k,1833) + lu(k,1856) = lu(k,1856) - lu(k,914) * lu(k,1833) + lu(k,1857) = lu(k,1857) - lu(k,915) * lu(k,1833) + lu(k,1858) = lu(k,1858) - lu(k,916) * lu(k,1833) + lu(k,1859) = lu(k,1859) - lu(k,917) * lu(k,1833) + lu(k,1860) = lu(k,1860) - lu(k,918) * lu(k,1833) + lu(k,1871) = lu(k,1871) - lu(k,898) * lu(k,1869) + lu(k,1873) = lu(k,1873) - lu(k,899) * lu(k,1869) + lu(k,1874) = lu(k,1874) - lu(k,900) * lu(k,1869) + lu(k,1877) = lu(k,1877) - lu(k,901) * lu(k,1869) + lu(k,1878) = lu(k,1878) - lu(k,902) * lu(k,1869) + lu(k,1879) = lu(k,1879) - lu(k,903) * lu(k,1869) + lu(k,1880) = lu(k,1880) - lu(k,904) * lu(k,1869) + lu(k,1882) = lu(k,1882) - lu(k,905) * lu(k,1869) + lu(k,1883) = lu(k,1883) - lu(k,906) * lu(k,1869) + lu(k,1884) = lu(k,1884) - lu(k,907) * lu(k,1869) + lu(k,1885) = lu(k,1885) - lu(k,908) * lu(k,1869) + lu(k,1886) = lu(k,1886) - lu(k,909) * lu(k,1869) + lu(k,1888) = lu(k,1888) - lu(k,910) * lu(k,1869) + lu(k,1889) = lu(k,1889) - lu(k,911) * lu(k,1869) + lu(k,1890) = lu(k,1890) - lu(k,912) * lu(k,1869) + lu(k,1891) = lu(k,1891) - lu(k,913) * lu(k,1869) + lu(k,1892) = lu(k,1892) - lu(k,914) * lu(k,1869) + lu(k,1893) = lu(k,1893) - lu(k,915) * lu(k,1869) + lu(k,1894) = lu(k,1894) - lu(k,916) * lu(k,1869) + lu(k,1895) = lu(k,1895) - lu(k,917) * lu(k,1869) + lu(k,1896) = lu(k,1896) - lu(k,918) * lu(k,1869) + lu(k,1912) = lu(k,1912) - lu(k,898) * lu(k,1910) + lu(k,1914) = lu(k,1914) - lu(k,899) * lu(k,1910) + lu(k,1915) = lu(k,1915) - lu(k,900) * lu(k,1910) + lu(k,1918) = lu(k,1918) - lu(k,901) * lu(k,1910) + lu(k,1919) = lu(k,1919) - lu(k,902) * lu(k,1910) + lu(k,1920) = lu(k,1920) - lu(k,903) * lu(k,1910) + lu(k,1921) = lu(k,1921) - lu(k,904) * lu(k,1910) + lu(k,1923) = lu(k,1923) - lu(k,905) * lu(k,1910) + lu(k,1924) = lu(k,1924) - lu(k,906) * lu(k,1910) + lu(k,1925) = lu(k,1925) - lu(k,907) * lu(k,1910) + lu(k,1926) = lu(k,1926) - lu(k,908) * lu(k,1910) + lu(k,1927) = lu(k,1927) - lu(k,909) * lu(k,1910) + lu(k,1929) = lu(k,1929) - lu(k,910) * lu(k,1910) + lu(k,1930) = lu(k,1930) - lu(k,911) * lu(k,1910) + lu(k,1931) = lu(k,1931) - lu(k,912) * lu(k,1910) + lu(k,1932) = lu(k,1932) - lu(k,913) * lu(k,1910) + lu(k,1933) = lu(k,1933) - lu(k,914) * lu(k,1910) + lu(k,1934) = lu(k,1934) - lu(k,915) * lu(k,1910) + lu(k,1935) = lu(k,1935) - lu(k,916) * lu(k,1910) + lu(k,1936) = lu(k,1936) - lu(k,917) * lu(k,1910) + lu(k,1937) = lu(k,1937) - lu(k,918) * lu(k,1910) + lu(k,1954) = lu(k,1954) - lu(k,898) * lu(k,1952) + lu(k,1956) = lu(k,1956) - lu(k,899) * lu(k,1952) + lu(k,1957) = lu(k,1957) - lu(k,900) * lu(k,1952) + lu(k,1960) = lu(k,1960) - lu(k,901) * lu(k,1952) + lu(k,1961) = lu(k,1961) - lu(k,902) * lu(k,1952) + lu(k,1962) = lu(k,1962) - lu(k,903) * lu(k,1952) + lu(k,1963) = lu(k,1963) - lu(k,904) * lu(k,1952) + lu(k,1965) = lu(k,1965) - lu(k,905) * lu(k,1952) + lu(k,1966) = lu(k,1966) - lu(k,906) * lu(k,1952) + lu(k,1967) = lu(k,1967) - lu(k,907) * lu(k,1952) + lu(k,1968) = lu(k,1968) - lu(k,908) * lu(k,1952) + lu(k,1969) = lu(k,1969) - lu(k,909) * lu(k,1952) + lu(k,1971) = lu(k,1971) - lu(k,910) * lu(k,1952) + lu(k,1972) = lu(k,1972) - lu(k,911) * lu(k,1952) + lu(k,1973) = lu(k,1973) - lu(k,912) * lu(k,1952) + lu(k,1974) = lu(k,1974) - lu(k,913) * lu(k,1952) + lu(k,1975) = lu(k,1975) - lu(k,914) * lu(k,1952) + lu(k,1976) = lu(k,1976) - lu(k,915) * lu(k,1952) + lu(k,1977) = lu(k,1977) - lu(k,916) * lu(k,1952) + lu(k,1978) = lu(k,1978) - lu(k,917) * lu(k,1952) + lu(k,1979) = lu(k,1979) - lu(k,918) * lu(k,1952) + lu(k,2002) = lu(k,2002) - lu(k,898) * lu(k,2000) + lu(k,2004) = lu(k,2004) - lu(k,899) * lu(k,2000) + lu(k,2005) = lu(k,2005) - lu(k,900) * lu(k,2000) + lu(k,2008) = lu(k,2008) - lu(k,901) * lu(k,2000) + lu(k,2009) = lu(k,2009) - lu(k,902) * lu(k,2000) + lu(k,2010) = lu(k,2010) - lu(k,903) * lu(k,2000) + lu(k,2011) = lu(k,2011) - lu(k,904) * lu(k,2000) + lu(k,2013) = lu(k,2013) - lu(k,905) * lu(k,2000) + lu(k,2014) = lu(k,2014) - lu(k,906) * lu(k,2000) + lu(k,2015) = lu(k,2015) - lu(k,907) * lu(k,2000) + lu(k,2016) = lu(k,2016) - lu(k,908) * lu(k,2000) + lu(k,2017) = lu(k,2017) - lu(k,909) * lu(k,2000) + lu(k,2019) = lu(k,2019) - lu(k,910) * lu(k,2000) + lu(k,2020) = lu(k,2020) - lu(k,911) * lu(k,2000) + lu(k,2021) = lu(k,2021) - lu(k,912) * lu(k,2000) + lu(k,2022) = lu(k,2022) - lu(k,913) * lu(k,2000) + lu(k,2023) = lu(k,2023) - lu(k,914) * lu(k,2000) + lu(k,2024) = lu(k,2024) - lu(k,915) * lu(k,2000) + lu(k,2025) = lu(k,2025) - lu(k,916) * lu(k,2000) + lu(k,2026) = lu(k,2026) - lu(k,917) * lu(k,2000) + lu(k,2027) = lu(k,2027) - lu(k,918) * lu(k,2000) + lu(k,2062) = lu(k,2062) - lu(k,898) * lu(k,2060) + lu(k,2064) = lu(k,2064) - lu(k,899) * lu(k,2060) + lu(k,2065) = lu(k,2065) - lu(k,900) * lu(k,2060) + lu(k,2068) = lu(k,2068) - lu(k,901) * lu(k,2060) + lu(k,2069) = lu(k,2069) - lu(k,902) * lu(k,2060) + lu(k,2070) = lu(k,2070) - lu(k,903) * lu(k,2060) + lu(k,2071) = lu(k,2071) - lu(k,904) * lu(k,2060) + lu(k,2073) = lu(k,2073) - lu(k,905) * lu(k,2060) + lu(k,2074) = lu(k,2074) - lu(k,906) * lu(k,2060) + lu(k,2075) = lu(k,2075) - lu(k,907) * lu(k,2060) + lu(k,2076) = lu(k,2076) - lu(k,908) * lu(k,2060) + lu(k,2077) = lu(k,2077) - lu(k,909) * lu(k,2060) + lu(k,2079) = lu(k,2079) - lu(k,910) * lu(k,2060) + lu(k,2080) = lu(k,2080) - lu(k,911) * lu(k,2060) + lu(k,2081) = lu(k,2081) - lu(k,912) * lu(k,2060) + lu(k,2082) = lu(k,2082) - lu(k,913) * lu(k,2060) + lu(k,2083) = lu(k,2083) - lu(k,914) * lu(k,2060) + lu(k,2084) = lu(k,2084) - lu(k,915) * lu(k,2060) + lu(k,2085) = lu(k,2085) - lu(k,916) * lu(k,2060) + lu(k,2086) = lu(k,2086) - lu(k,917) * lu(k,2060) + lu(k,2087) = lu(k,2087) - lu(k,918) * lu(k,2060) + lu(k,923) = 1._r8 / lu(k,923) + lu(k,924) = lu(k,924) * lu(k,923) + lu(k,925) = lu(k,925) * lu(k,923) + lu(k,926) = lu(k,926) * lu(k,923) + lu(k,927) = lu(k,927) * lu(k,923) + lu(k,928) = lu(k,928) * lu(k,923) + lu(k,929) = lu(k,929) * lu(k,923) + lu(k,930) = lu(k,930) * lu(k,923) + lu(k,931) = lu(k,931) * lu(k,923) + lu(k,932) = lu(k,932) * lu(k,923) + lu(k,933) = lu(k,933) * lu(k,923) + lu(k,934) = lu(k,934) * lu(k,923) + lu(k,935) = lu(k,935) * lu(k,923) + lu(k,936) = lu(k,936) * lu(k,923) + lu(k,937) = lu(k,937) * lu(k,923) + lu(k,938) = lu(k,938) * lu(k,923) + lu(k,939) = lu(k,939) * lu(k,923) + lu(k,940) = lu(k,940) * lu(k,923) + lu(k,941) = lu(k,941) * lu(k,923) + lu(k,942) = lu(k,942) * lu(k,923) + lu(k,943) = lu(k,943) * lu(k,923) + lu(k,944) = lu(k,944) * lu(k,923) + lu(k,945) = lu(k,945) * lu(k,923) + lu(k,1010) = lu(k,1010) - lu(k,924) * lu(k,1009) + lu(k,1012) = lu(k,1012) - lu(k,925) * lu(k,1009) + lu(k,1013) = lu(k,1013) - lu(k,926) * lu(k,1009) + lu(k,1014) = lu(k,1014) - lu(k,927) * lu(k,1009) + lu(k,1015) = lu(k,1015) - lu(k,928) * lu(k,1009) + lu(k,1016) = lu(k,1016) - lu(k,929) * lu(k,1009) + lu(k,1017) = lu(k,1017) - lu(k,930) * lu(k,1009) + lu(k,1018) = lu(k,1018) - lu(k,931) * lu(k,1009) + lu(k,1019) = lu(k,1019) - lu(k,932) * lu(k,1009) + lu(k,1020) = lu(k,1020) - lu(k,933) * lu(k,1009) + lu(k,1021) = lu(k,1021) - lu(k,934) * lu(k,1009) + lu(k,1022) = lu(k,1022) - lu(k,935) * lu(k,1009) + lu(k,1024) = lu(k,1024) - lu(k,936) * lu(k,1009) + lu(k,1025) = lu(k,1025) - lu(k,937) * lu(k,1009) + lu(k,1026) = lu(k,1026) - lu(k,938) * lu(k,1009) + lu(k,1027) = lu(k,1027) - lu(k,939) * lu(k,1009) + lu(k,1028) = lu(k,1028) - lu(k,940) * lu(k,1009) + lu(k,1029) = lu(k,1029) - lu(k,941) * lu(k,1009) + lu(k,1030) = lu(k,1030) - lu(k,942) * lu(k,1009) + lu(k,1032) = lu(k,1032) - lu(k,943) * lu(k,1009) + lu(k,1034) = lu(k,1034) - lu(k,944) * lu(k,1009) + lu(k,1035) = lu(k,1035) - lu(k,945) * lu(k,1009) + lu(k,1094) = lu(k,1094) - lu(k,924) * lu(k,1093) + lu(k,1095) = lu(k,1095) - lu(k,925) * lu(k,1093) + lu(k,1096) = lu(k,1096) - lu(k,926) * lu(k,1093) + lu(k,1097) = lu(k,1097) - lu(k,927) * lu(k,1093) + lu(k,1098) = lu(k,1098) - lu(k,928) * lu(k,1093) + lu(k,1099) = lu(k,1099) - lu(k,929) * lu(k,1093) + lu(k,1100) = lu(k,1100) - lu(k,930) * lu(k,1093) + lu(k,1101) = lu(k,1101) - lu(k,931) * lu(k,1093) + lu(k,1102) = lu(k,1102) - lu(k,932) * lu(k,1093) + lu(k,1103) = lu(k,1103) - lu(k,933) * lu(k,1093) + lu(k,1104) = lu(k,1104) - lu(k,934) * lu(k,1093) + lu(k,1105) = lu(k,1105) - lu(k,935) * lu(k,1093) + lu(k,1107) = lu(k,1107) - lu(k,936) * lu(k,1093) + lu(k,1108) = lu(k,1108) - lu(k,937) * lu(k,1093) + lu(k,1109) = lu(k,1109) - lu(k,938) * lu(k,1093) + lu(k,1110) = lu(k,1110) - lu(k,939) * lu(k,1093) + lu(k,1111) = lu(k,1111) - lu(k,940) * lu(k,1093) + lu(k,1112) = lu(k,1112) - lu(k,941) * lu(k,1093) + lu(k,1113) = lu(k,1113) - lu(k,942) * lu(k,1093) + lu(k,1115) = lu(k,1115) - lu(k,943) * lu(k,1093) + lu(k,1117) = lu(k,1117) - lu(k,944) * lu(k,1093) + lu(k,1118) = lu(k,1118) - lu(k,945) * lu(k,1093) + lu(k,1141) = lu(k,1141) - lu(k,924) * lu(k,1140) + lu(k,1143) = lu(k,1143) - lu(k,925) * lu(k,1140) + lu(k,1144) = lu(k,1144) - lu(k,926) * lu(k,1140) + lu(k,1145) = lu(k,1145) - lu(k,927) * lu(k,1140) + lu(k,1146) = lu(k,1146) - lu(k,928) * lu(k,1140) + lu(k,1147) = lu(k,1147) - lu(k,929) * lu(k,1140) + lu(k,1148) = lu(k,1148) - lu(k,930) * lu(k,1140) + lu(k,1149) = lu(k,1149) - lu(k,931) * lu(k,1140) + lu(k,1150) = lu(k,1150) - lu(k,932) * lu(k,1140) + lu(k,1151) = lu(k,1151) - lu(k,933) * lu(k,1140) + lu(k,1152) = lu(k,1152) - lu(k,934) * lu(k,1140) + lu(k,1153) = lu(k,1153) - lu(k,935) * lu(k,1140) + lu(k,1155) = lu(k,1155) - lu(k,936) * lu(k,1140) + lu(k,1156) = lu(k,1156) - lu(k,937) * lu(k,1140) + lu(k,1157) = lu(k,1157) - lu(k,938) * lu(k,1140) + lu(k,1158) = lu(k,1158) - lu(k,939) * lu(k,1140) + lu(k,1159) = lu(k,1159) - lu(k,940) * lu(k,1140) + lu(k,1160) = lu(k,1160) - lu(k,941) * lu(k,1140) + lu(k,1161) = lu(k,1161) - lu(k,942) * lu(k,1140) + lu(k,1163) = lu(k,1163) - lu(k,943) * lu(k,1140) + lu(k,1165) = lu(k,1165) - lu(k,944) * lu(k,1140) + lu(k,1166) = lu(k,1166) - lu(k,945) * lu(k,1140) + lu(k,1184) = lu(k,1184) - lu(k,924) * lu(k,1183) + lu(k,1186) = lu(k,1186) - lu(k,925) * lu(k,1183) + lu(k,1187) = lu(k,1187) - lu(k,926) * lu(k,1183) + lu(k,1188) = lu(k,1188) - lu(k,927) * lu(k,1183) + lu(k,1189) = lu(k,1189) - lu(k,928) * lu(k,1183) + lu(k,1190) = lu(k,1190) - lu(k,929) * lu(k,1183) + lu(k,1191) = lu(k,1191) - lu(k,930) * lu(k,1183) + lu(k,1192) = lu(k,1192) - lu(k,931) * lu(k,1183) + lu(k,1193) = lu(k,1193) - lu(k,932) * lu(k,1183) + lu(k,1194) = lu(k,1194) - lu(k,933) * lu(k,1183) + lu(k,1195) = lu(k,1195) - lu(k,934) * lu(k,1183) + lu(k,1196) = lu(k,1196) - lu(k,935) * lu(k,1183) + lu(k,1198) = lu(k,1198) - lu(k,936) * lu(k,1183) + lu(k,1199) = lu(k,1199) - lu(k,937) * lu(k,1183) + lu(k,1200) = lu(k,1200) - lu(k,938) * lu(k,1183) + lu(k,1201) = lu(k,1201) - lu(k,939) * lu(k,1183) + lu(k,1202) = lu(k,1202) - lu(k,940) * lu(k,1183) + lu(k,1203) = lu(k,1203) - lu(k,941) * lu(k,1183) + lu(k,1204) = lu(k,1204) - lu(k,942) * lu(k,1183) + lu(k,1206) = lu(k,1206) - lu(k,943) * lu(k,1183) + lu(k,1208) = lu(k,1208) - lu(k,944) * lu(k,1183) + lu(k,1209) = lu(k,1209) - lu(k,945) * lu(k,1183) + lu(k,1225) = lu(k,1225) - lu(k,924) * lu(k,1224) + lu(k,1227) = lu(k,1227) - lu(k,925) * lu(k,1224) + lu(k,1228) = lu(k,1228) - lu(k,926) * lu(k,1224) + lu(k,1229) = lu(k,1229) - lu(k,927) * lu(k,1224) + lu(k,1230) = lu(k,1230) - lu(k,928) * lu(k,1224) + lu(k,1231) = lu(k,1231) - lu(k,929) * lu(k,1224) + lu(k,1232) = lu(k,1232) - lu(k,930) * lu(k,1224) + lu(k,1233) = lu(k,1233) - lu(k,931) * lu(k,1224) + lu(k,1234) = lu(k,1234) - lu(k,932) * lu(k,1224) + lu(k,1235) = lu(k,1235) - lu(k,933) * lu(k,1224) + lu(k,1236) = lu(k,1236) - lu(k,934) * lu(k,1224) + lu(k,1237) = lu(k,1237) - lu(k,935) * lu(k,1224) + lu(k,1239) = lu(k,1239) - lu(k,936) * lu(k,1224) + lu(k,1240) = lu(k,1240) - lu(k,937) * lu(k,1224) + lu(k,1241) = lu(k,1241) - lu(k,938) * lu(k,1224) + lu(k,1242) = lu(k,1242) - lu(k,939) * lu(k,1224) + lu(k,1243) = lu(k,1243) - lu(k,940) * lu(k,1224) + lu(k,1244) = lu(k,1244) - lu(k,941) * lu(k,1224) + lu(k,1245) = lu(k,1245) - lu(k,942) * lu(k,1224) + lu(k,1247) = lu(k,1247) - lu(k,943) * lu(k,1224) + lu(k,1249) = lu(k,1249) - lu(k,944) * lu(k,1224) + lu(k,1250) = lu(k,1250) - lu(k,945) * lu(k,1224) + lu(k,1285) = lu(k,1285) - lu(k,924) * lu(k,1284) + lu(k,1287) = lu(k,1287) - lu(k,925) * lu(k,1284) + lu(k,1288) = lu(k,1288) - lu(k,926) * lu(k,1284) + lu(k,1289) = lu(k,1289) - lu(k,927) * lu(k,1284) + lu(k,1290) = lu(k,1290) - lu(k,928) * lu(k,1284) + lu(k,1291) = lu(k,1291) - lu(k,929) * lu(k,1284) + lu(k,1292) = lu(k,1292) - lu(k,930) * lu(k,1284) + lu(k,1293) = lu(k,1293) - lu(k,931) * lu(k,1284) + lu(k,1294) = lu(k,1294) - lu(k,932) * lu(k,1284) + lu(k,1295) = lu(k,1295) - lu(k,933) * lu(k,1284) + lu(k,1296) = lu(k,1296) - lu(k,934) * lu(k,1284) + lu(k,1297) = lu(k,1297) - lu(k,935) * lu(k,1284) + lu(k,1299) = lu(k,1299) - lu(k,936) * lu(k,1284) + lu(k,1300) = lu(k,1300) - lu(k,937) * lu(k,1284) + lu(k,1301) = lu(k,1301) - lu(k,938) * lu(k,1284) + lu(k,1302) = lu(k,1302) - lu(k,939) * lu(k,1284) + lu(k,1303) = lu(k,1303) - lu(k,940) * lu(k,1284) + lu(k,1304) = lu(k,1304) - lu(k,941) * lu(k,1284) + lu(k,1305) = lu(k,1305) - lu(k,942) * lu(k,1284) + lu(k,1307) = lu(k,1307) - lu(k,943) * lu(k,1284) + lu(k,1309) = lu(k,1309) - lu(k,944) * lu(k,1284) + lu(k,1310) = lu(k,1310) - lu(k,945) * lu(k,1284) + lu(k,1327) = lu(k,1327) - lu(k,924) * lu(k,1326) + lu(k,1329) = lu(k,1329) - lu(k,925) * lu(k,1326) + lu(k,1330) = lu(k,1330) - lu(k,926) * lu(k,1326) + lu(k,1331) = lu(k,1331) - lu(k,927) * lu(k,1326) + lu(k,1332) = lu(k,1332) - lu(k,928) * lu(k,1326) + lu(k,1333) = lu(k,1333) - lu(k,929) * lu(k,1326) + lu(k,1334) = lu(k,1334) - lu(k,930) * lu(k,1326) + lu(k,1335) = lu(k,1335) - lu(k,931) * lu(k,1326) + lu(k,1336) = lu(k,1336) - lu(k,932) * lu(k,1326) + lu(k,1337) = lu(k,1337) - lu(k,933) * lu(k,1326) + lu(k,1338) = lu(k,1338) - lu(k,934) * lu(k,1326) + lu(k,1339) = lu(k,1339) - lu(k,935) * lu(k,1326) + lu(k,1341) = lu(k,1341) - lu(k,936) * lu(k,1326) + lu(k,1342) = lu(k,1342) - lu(k,937) * lu(k,1326) + lu(k,1343) = lu(k,1343) - lu(k,938) * lu(k,1326) + lu(k,1344) = lu(k,1344) - lu(k,939) * lu(k,1326) + lu(k,1345) = lu(k,1345) - lu(k,940) * lu(k,1326) + lu(k,1346) = lu(k,1346) - lu(k,941) * lu(k,1326) + lu(k,1347) = lu(k,1347) - lu(k,942) * lu(k,1326) + lu(k,1349) = lu(k,1349) - lu(k,943) * lu(k,1326) + lu(k,1351) = lu(k,1351) - lu(k,944) * lu(k,1326) + lu(k,1352) = lu(k,1352) - lu(k,945) * lu(k,1326) + lu(k,1363) = lu(k,1363) - lu(k,924) * lu(k,1362) + lu(k,1365) = lu(k,1365) - lu(k,925) * lu(k,1362) + lu(k,1366) = lu(k,1366) - lu(k,926) * lu(k,1362) + lu(k,1367) = lu(k,1367) - lu(k,927) * lu(k,1362) + lu(k,1368) = lu(k,1368) - lu(k,928) * lu(k,1362) + lu(k,1369) = lu(k,1369) - lu(k,929) * lu(k,1362) + lu(k,1370) = lu(k,1370) - lu(k,930) * lu(k,1362) + lu(k,1371) = lu(k,1371) - lu(k,931) * lu(k,1362) + lu(k,1372) = lu(k,1372) - lu(k,932) * lu(k,1362) + lu(k,1373) = lu(k,1373) - lu(k,933) * lu(k,1362) + lu(k,1374) = lu(k,1374) - lu(k,934) * lu(k,1362) + lu(k,1375) = lu(k,1375) - lu(k,935) * lu(k,1362) + lu(k,1377) = lu(k,1377) - lu(k,936) * lu(k,1362) + lu(k,1378) = lu(k,1378) - lu(k,937) * lu(k,1362) + lu(k,1379) = lu(k,1379) - lu(k,938) * lu(k,1362) + lu(k,1380) = lu(k,1380) - lu(k,939) * lu(k,1362) + lu(k,1381) = lu(k,1381) - lu(k,940) * lu(k,1362) + lu(k,1382) = lu(k,1382) - lu(k,941) * lu(k,1362) + lu(k,1383) = lu(k,1383) - lu(k,942) * lu(k,1362) + lu(k,1385) = lu(k,1385) - lu(k,943) * lu(k,1362) + lu(k,1387) = lu(k,1387) - lu(k,944) * lu(k,1362) + lu(k,1388) = lu(k,1388) - lu(k,945) * lu(k,1362) + lu(k,1406) = lu(k,1406) - lu(k,924) * lu(k,1405) + lu(k,1408) = lu(k,1408) - lu(k,925) * lu(k,1405) + lu(k,1409) = lu(k,1409) - lu(k,926) * lu(k,1405) + lu(k,1410) = lu(k,1410) - lu(k,927) * lu(k,1405) + lu(k,1411) = lu(k,1411) - lu(k,928) * lu(k,1405) + lu(k,1412) = lu(k,1412) - lu(k,929) * lu(k,1405) + lu(k,1413) = lu(k,1413) - lu(k,930) * lu(k,1405) + lu(k,1414) = lu(k,1414) - lu(k,931) * lu(k,1405) + lu(k,1415) = lu(k,1415) - lu(k,932) * lu(k,1405) + lu(k,1416) = lu(k,1416) - lu(k,933) * lu(k,1405) + lu(k,1417) = lu(k,1417) - lu(k,934) * lu(k,1405) + lu(k,1418) = lu(k,1418) - lu(k,935) * lu(k,1405) + lu(k,1420) = lu(k,1420) - lu(k,936) * lu(k,1405) + lu(k,1421) = lu(k,1421) - lu(k,937) * lu(k,1405) + lu(k,1422) = lu(k,1422) - lu(k,938) * lu(k,1405) + lu(k,1423) = lu(k,1423) - lu(k,939) * lu(k,1405) + lu(k,1424) = lu(k,1424) - lu(k,940) * lu(k,1405) + lu(k,1425) = lu(k,1425) - lu(k,941) * lu(k,1405) + lu(k,1426) = lu(k,1426) - lu(k,942) * lu(k,1405) + lu(k,1428) = lu(k,1428) - lu(k,943) * lu(k,1405) + lu(k,1430) = lu(k,1430) - lu(k,944) * lu(k,1405) + lu(k,1431) = lu(k,1431) - lu(k,945) * lu(k,1405) + lu(k,1449) = lu(k,1449) - lu(k,924) * lu(k,1448) + lu(k,1451) = lu(k,1451) - lu(k,925) * lu(k,1448) + lu(k,1452) = lu(k,1452) - lu(k,926) * lu(k,1448) + lu(k,1453) = lu(k,1453) - lu(k,927) * lu(k,1448) + lu(k,1454) = lu(k,1454) - lu(k,928) * lu(k,1448) + lu(k,1455) = lu(k,1455) - lu(k,929) * lu(k,1448) + lu(k,1456) = lu(k,1456) - lu(k,930) * lu(k,1448) + lu(k,1457) = lu(k,1457) - lu(k,931) * lu(k,1448) + lu(k,1458) = lu(k,1458) - lu(k,932) * lu(k,1448) + lu(k,1459) = lu(k,1459) - lu(k,933) * lu(k,1448) + lu(k,1460) = lu(k,1460) - lu(k,934) * lu(k,1448) + lu(k,1461) = lu(k,1461) - lu(k,935) * lu(k,1448) + lu(k,1463) = lu(k,1463) - lu(k,936) * lu(k,1448) + lu(k,1464) = lu(k,1464) - lu(k,937) * lu(k,1448) + lu(k,1465) = lu(k,1465) - lu(k,938) * lu(k,1448) + lu(k,1466) = lu(k,1466) - lu(k,939) * lu(k,1448) + lu(k,1467) = lu(k,1467) - lu(k,940) * lu(k,1448) + lu(k,1468) = lu(k,1468) - lu(k,941) * lu(k,1448) + lu(k,1469) = lu(k,1469) - lu(k,942) * lu(k,1448) + lu(k,1471) = lu(k,1471) - lu(k,943) * lu(k,1448) + lu(k,1473) = lu(k,1473) - lu(k,944) * lu(k,1448) + lu(k,1474) = lu(k,1474) - lu(k,945) * lu(k,1448) + lu(k,1494) = lu(k,1494) - lu(k,924) * lu(k,1493) + lu(k,1496) = lu(k,1496) - lu(k,925) * lu(k,1493) + lu(k,1497) = lu(k,1497) - lu(k,926) * lu(k,1493) + lu(k,1498) = lu(k,1498) - lu(k,927) * lu(k,1493) + lu(k,1499) = lu(k,1499) - lu(k,928) * lu(k,1493) + lu(k,1500) = lu(k,1500) - lu(k,929) * lu(k,1493) + lu(k,1501) = lu(k,1501) - lu(k,930) * lu(k,1493) + lu(k,1502) = lu(k,1502) - lu(k,931) * lu(k,1493) + lu(k,1503) = lu(k,1503) - lu(k,932) * lu(k,1493) + lu(k,1504) = lu(k,1504) - lu(k,933) * lu(k,1493) + lu(k,1505) = lu(k,1505) - lu(k,934) * lu(k,1493) + lu(k,1506) = lu(k,1506) - lu(k,935) * lu(k,1493) + lu(k,1508) = lu(k,1508) - lu(k,936) * lu(k,1493) + lu(k,1509) = lu(k,1509) - lu(k,937) * lu(k,1493) + lu(k,1510) = lu(k,1510) - lu(k,938) * lu(k,1493) + lu(k,1511) = lu(k,1511) - lu(k,939) * lu(k,1493) + lu(k,1512) = lu(k,1512) - lu(k,940) * lu(k,1493) + lu(k,1513) = lu(k,1513) - lu(k,941) * lu(k,1493) + lu(k,1514) = lu(k,1514) - lu(k,942) * lu(k,1493) + lu(k,1516) = lu(k,1516) - lu(k,943) * lu(k,1493) + lu(k,1518) = lu(k,1518) - lu(k,944) * lu(k,1493) + lu(k,1519) = lu(k,1519) - lu(k,945) * lu(k,1493) + lu(k,1530) = lu(k,1530) - lu(k,924) * lu(k,1529) + lu(k,1532) = lu(k,1532) - lu(k,925) * lu(k,1529) + lu(k,1533) = lu(k,1533) - lu(k,926) * lu(k,1529) + lu(k,1534) = lu(k,1534) - lu(k,927) * lu(k,1529) + lu(k,1535) = lu(k,1535) - lu(k,928) * lu(k,1529) + lu(k,1536) = lu(k,1536) - lu(k,929) * lu(k,1529) + lu(k,1537) = lu(k,1537) - lu(k,930) * lu(k,1529) + lu(k,1538) = lu(k,1538) - lu(k,931) * lu(k,1529) + lu(k,1539) = lu(k,1539) - lu(k,932) * lu(k,1529) + lu(k,1540) = lu(k,1540) - lu(k,933) * lu(k,1529) + lu(k,1541) = lu(k,1541) - lu(k,934) * lu(k,1529) + lu(k,1542) = lu(k,1542) - lu(k,935) * lu(k,1529) + lu(k,1544) = lu(k,1544) - lu(k,936) * lu(k,1529) + lu(k,1545) = lu(k,1545) - lu(k,937) * lu(k,1529) + lu(k,1546) = lu(k,1546) - lu(k,938) * lu(k,1529) + lu(k,1547) = lu(k,1547) - lu(k,939) * lu(k,1529) + lu(k,1548) = lu(k,1548) - lu(k,940) * lu(k,1529) + lu(k,1549) = lu(k,1549) - lu(k,941) * lu(k,1529) + lu(k,1550) = lu(k,1550) - lu(k,942) * lu(k,1529) + lu(k,1552) = lu(k,1552) - lu(k,943) * lu(k,1529) + lu(k,1554) = lu(k,1554) - lu(k,944) * lu(k,1529) + lu(k,1555) = lu(k,1555) - lu(k,945) * lu(k,1529) + lu(k,1575) = lu(k,1575) - lu(k,924) * lu(k,1574) + lu(k,1577) = lu(k,1577) - lu(k,925) * lu(k,1574) + lu(k,1578) = lu(k,1578) - lu(k,926) * lu(k,1574) + lu(k,1579) = lu(k,1579) - lu(k,927) * lu(k,1574) + lu(k,1580) = lu(k,1580) - lu(k,928) * lu(k,1574) + lu(k,1581) = lu(k,1581) - lu(k,929) * lu(k,1574) + lu(k,1582) = lu(k,1582) - lu(k,930) * lu(k,1574) + lu(k,1583) = lu(k,1583) - lu(k,931) * lu(k,1574) + lu(k,1584) = lu(k,1584) - lu(k,932) * lu(k,1574) + lu(k,1585) = lu(k,1585) - lu(k,933) * lu(k,1574) + lu(k,1586) = lu(k,1586) - lu(k,934) * lu(k,1574) + lu(k,1587) = lu(k,1587) - lu(k,935) * lu(k,1574) + lu(k,1589) = lu(k,1589) - lu(k,936) * lu(k,1574) + lu(k,1590) = lu(k,1590) - lu(k,937) * lu(k,1574) + lu(k,1591) = lu(k,1591) - lu(k,938) * lu(k,1574) + lu(k,1592) = lu(k,1592) - lu(k,939) * lu(k,1574) + lu(k,1593) = lu(k,1593) - lu(k,940) * lu(k,1574) + lu(k,1594) = lu(k,1594) - lu(k,941) * lu(k,1574) + lu(k,1595) = lu(k,1595) - lu(k,942) * lu(k,1574) + lu(k,1597) = lu(k,1597) - lu(k,943) * lu(k,1574) + lu(k,1599) = lu(k,1599) - lu(k,944) * lu(k,1574) + lu(k,1600) = lu(k,1600) - lu(k,945) * lu(k,1574) + lu(k,1623) = lu(k,1623) - lu(k,924) * lu(k,1622) + lu(k,1625) = lu(k,1625) - lu(k,925) * lu(k,1622) + lu(k,1626) = lu(k,1626) - lu(k,926) * lu(k,1622) + lu(k,1627) = lu(k,1627) - lu(k,927) * lu(k,1622) + lu(k,1628) = lu(k,1628) - lu(k,928) * lu(k,1622) + lu(k,1629) = lu(k,1629) - lu(k,929) * lu(k,1622) + lu(k,1630) = lu(k,1630) - lu(k,930) * lu(k,1622) + lu(k,1631) = lu(k,1631) - lu(k,931) * lu(k,1622) + lu(k,1632) = lu(k,1632) - lu(k,932) * lu(k,1622) + lu(k,1633) = lu(k,1633) - lu(k,933) * lu(k,1622) + lu(k,1634) = lu(k,1634) - lu(k,934) * lu(k,1622) + lu(k,1635) = lu(k,1635) - lu(k,935) * lu(k,1622) + lu(k,1637) = lu(k,1637) - lu(k,936) * lu(k,1622) + lu(k,1638) = lu(k,1638) - lu(k,937) * lu(k,1622) + lu(k,1639) = lu(k,1639) - lu(k,938) * lu(k,1622) + lu(k,1640) = lu(k,1640) - lu(k,939) * lu(k,1622) + lu(k,1641) = lu(k,1641) - lu(k,940) * lu(k,1622) + lu(k,1642) = lu(k,1642) - lu(k,941) * lu(k,1622) + lu(k,1643) = lu(k,1643) - lu(k,942) * lu(k,1622) + lu(k,1645) = lu(k,1645) - lu(k,943) * lu(k,1622) + lu(k,1647) = lu(k,1647) - lu(k,944) * lu(k,1622) + lu(k,1648) = lu(k,1648) - lu(k,945) * lu(k,1622) + lu(k,1666) = lu(k,1666) - lu(k,924) * lu(k,1665) + lu(k,1668) = lu(k,1668) - lu(k,925) * lu(k,1665) + lu(k,1669) = lu(k,1669) - lu(k,926) * lu(k,1665) + lu(k,1670) = lu(k,1670) - lu(k,927) * lu(k,1665) + lu(k,1671) = lu(k,1671) - lu(k,928) * lu(k,1665) + lu(k,1672) = lu(k,1672) - lu(k,929) * lu(k,1665) + lu(k,1673) = lu(k,1673) - lu(k,930) * lu(k,1665) + lu(k,1674) = lu(k,1674) - lu(k,931) * lu(k,1665) + lu(k,1675) = lu(k,1675) - lu(k,932) * lu(k,1665) + lu(k,1676) = lu(k,1676) - lu(k,933) * lu(k,1665) + lu(k,1677) = lu(k,1677) - lu(k,934) * lu(k,1665) + lu(k,1678) = lu(k,1678) - lu(k,935) * lu(k,1665) + lu(k,1680) = lu(k,1680) - lu(k,936) * lu(k,1665) + lu(k,1681) = lu(k,1681) - lu(k,937) * lu(k,1665) + lu(k,1682) = lu(k,1682) - lu(k,938) * lu(k,1665) + lu(k,1683) = lu(k,1683) - lu(k,939) * lu(k,1665) + lu(k,1684) = lu(k,1684) - lu(k,940) * lu(k,1665) + lu(k,1685) = lu(k,1685) - lu(k,941) * lu(k,1665) + lu(k,1686) = lu(k,1686) - lu(k,942) * lu(k,1665) + lu(k,1688) = lu(k,1688) - lu(k,943) * lu(k,1665) + lu(k,1690) = lu(k,1690) - lu(k,944) * lu(k,1665) + lu(k,1691) = lu(k,1691) - lu(k,945) * lu(k,1665) + lu(k,1708) = lu(k,1708) - lu(k,924) * lu(k,1707) + lu(k,1710) = lu(k,1710) - lu(k,925) * lu(k,1707) + lu(k,1711) = lu(k,1711) - lu(k,926) * lu(k,1707) + lu(k,1712) = lu(k,1712) - lu(k,927) * lu(k,1707) + lu(k,1713) = lu(k,1713) - lu(k,928) * lu(k,1707) + lu(k,1714) = lu(k,1714) - lu(k,929) * lu(k,1707) + lu(k,1715) = lu(k,1715) - lu(k,930) * lu(k,1707) + lu(k,1716) = lu(k,1716) - lu(k,931) * lu(k,1707) + lu(k,1717) = lu(k,1717) - lu(k,932) * lu(k,1707) + lu(k,1718) = lu(k,1718) - lu(k,933) * lu(k,1707) + lu(k,1719) = lu(k,1719) - lu(k,934) * lu(k,1707) + lu(k,1720) = lu(k,1720) - lu(k,935) * lu(k,1707) + lu(k,1722) = lu(k,1722) - lu(k,936) * lu(k,1707) + lu(k,1723) = lu(k,1723) - lu(k,937) * lu(k,1707) + lu(k,1724) = lu(k,1724) - lu(k,938) * lu(k,1707) + lu(k,1725) = lu(k,1725) - lu(k,939) * lu(k,1707) + lu(k,1726) = lu(k,1726) - lu(k,940) * lu(k,1707) + lu(k,1727) = lu(k,1727) - lu(k,941) * lu(k,1707) + lu(k,1728) = lu(k,1728) - lu(k,942) * lu(k,1707) + lu(k,1730) = lu(k,1730) - lu(k,943) * lu(k,1707) + lu(k,1732) = lu(k,1732) - lu(k,944) * lu(k,1707) + lu(k,1733) = lu(k,1733) - lu(k,945) * lu(k,1707) + lu(k,1753) = lu(k,1753) - lu(k,924) * lu(k,1752) + lu(k,1755) = lu(k,1755) - lu(k,925) * lu(k,1752) + lu(k,1756) = lu(k,1756) - lu(k,926) * lu(k,1752) + lu(k,1757) = lu(k,1757) - lu(k,927) * lu(k,1752) + lu(k,1758) = lu(k,1758) - lu(k,928) * lu(k,1752) + lu(k,1759) = lu(k,1759) - lu(k,929) * lu(k,1752) + lu(k,1760) = lu(k,1760) - lu(k,930) * lu(k,1752) + lu(k,1761) = lu(k,1761) - lu(k,931) * lu(k,1752) + lu(k,1762) = lu(k,1762) - lu(k,932) * lu(k,1752) + lu(k,1763) = lu(k,1763) - lu(k,933) * lu(k,1752) + lu(k,1764) = lu(k,1764) - lu(k,934) * lu(k,1752) + lu(k,1765) = lu(k,1765) - lu(k,935) * lu(k,1752) + lu(k,1767) = lu(k,1767) - lu(k,936) * lu(k,1752) + lu(k,1768) = lu(k,1768) - lu(k,937) * lu(k,1752) + lu(k,1769) = lu(k,1769) - lu(k,938) * lu(k,1752) + lu(k,1770) = lu(k,1770) - lu(k,939) * lu(k,1752) + lu(k,1771) = lu(k,1771) - lu(k,940) * lu(k,1752) + lu(k,1772) = lu(k,1772) - lu(k,941) * lu(k,1752) + lu(k,1773) = lu(k,1773) - lu(k,942) * lu(k,1752) + lu(k,1775) = lu(k,1775) - lu(k,943) * lu(k,1752) + lu(k,1777) = lu(k,1777) - lu(k,944) * lu(k,1752) + lu(k,1778) = lu(k,1778) - lu(k,945) * lu(k,1752) + lu(k,1802) = lu(k,1802) - lu(k,924) * lu(k,1801) + lu(k,1804) = lu(k,1804) - lu(k,925) * lu(k,1801) + lu(k,1805) = lu(k,1805) - lu(k,926) * lu(k,1801) + lu(k,1806) = lu(k,1806) - lu(k,927) * lu(k,1801) + lu(k,1807) = lu(k,1807) - lu(k,928) * lu(k,1801) + lu(k,1808) = lu(k,1808) - lu(k,929) * lu(k,1801) + lu(k,1809) = lu(k,1809) - lu(k,930) * lu(k,1801) + lu(k,1810) = lu(k,1810) - lu(k,931) * lu(k,1801) + lu(k,1811) = lu(k,1811) - lu(k,932) * lu(k,1801) + lu(k,1812) = lu(k,1812) - lu(k,933) * lu(k,1801) + lu(k,1813) = lu(k,1813) - lu(k,934) * lu(k,1801) + lu(k,1814) = lu(k,1814) - lu(k,935) * lu(k,1801) + lu(k,1816) = lu(k,1816) - lu(k,936) * lu(k,1801) + lu(k,1817) = lu(k,1817) - lu(k,937) * lu(k,1801) + lu(k,1818) = lu(k,1818) - lu(k,938) * lu(k,1801) + lu(k,1819) = lu(k,1819) - lu(k,939) * lu(k,1801) + lu(k,1820) = lu(k,1820) - lu(k,940) * lu(k,1801) + lu(k,1821) = lu(k,1821) - lu(k,941) * lu(k,1801) + lu(k,1822) = lu(k,1822) - lu(k,942) * lu(k,1801) + lu(k,1824) = lu(k,1824) - lu(k,943) * lu(k,1801) + lu(k,1826) = lu(k,1826) - lu(k,944) * lu(k,1801) + lu(k,1827) = lu(k,1827) - lu(k,945) * lu(k,1801) + lu(k,1835) = lu(k,1835) - lu(k,924) * lu(k,1834) + lu(k,1837) = lu(k,1837) - lu(k,925) * lu(k,1834) + lu(k,1838) = lu(k,1838) - lu(k,926) * lu(k,1834) + lu(k,1839) = lu(k,1839) - lu(k,927) * lu(k,1834) + lu(k,1840) = lu(k,1840) - lu(k,928) * lu(k,1834) + lu(k,1841) = lu(k,1841) - lu(k,929) * lu(k,1834) + lu(k,1842) = lu(k,1842) - lu(k,930) * lu(k,1834) + lu(k,1843) = lu(k,1843) - lu(k,931) * lu(k,1834) + lu(k,1844) = lu(k,1844) - lu(k,932) * lu(k,1834) + lu(k,1845) = lu(k,1845) - lu(k,933) * lu(k,1834) + lu(k,1846) = lu(k,1846) - lu(k,934) * lu(k,1834) + lu(k,1847) = lu(k,1847) - lu(k,935) * lu(k,1834) + lu(k,1849) = lu(k,1849) - lu(k,936) * lu(k,1834) + lu(k,1850) = lu(k,1850) - lu(k,937) * lu(k,1834) + lu(k,1851) = lu(k,1851) - lu(k,938) * lu(k,1834) + lu(k,1852) = lu(k,1852) - lu(k,939) * lu(k,1834) + lu(k,1853) = lu(k,1853) - lu(k,940) * lu(k,1834) + lu(k,1854) = lu(k,1854) - lu(k,941) * lu(k,1834) + lu(k,1855) = lu(k,1855) - lu(k,942) * lu(k,1834) + lu(k,1857) = lu(k,1857) - lu(k,943) * lu(k,1834) + lu(k,1859) = lu(k,1859) - lu(k,944) * lu(k,1834) + lu(k,1860) = lu(k,1860) - lu(k,945) * lu(k,1834) + lu(k,1871) = lu(k,1871) - lu(k,924) * lu(k,1870) + lu(k,1873) = lu(k,1873) - lu(k,925) * lu(k,1870) + lu(k,1874) = lu(k,1874) - lu(k,926) * lu(k,1870) + lu(k,1875) = lu(k,1875) - lu(k,927) * lu(k,1870) + lu(k,1876) = lu(k,1876) - lu(k,928) * lu(k,1870) + lu(k,1877) = lu(k,1877) - lu(k,929) * lu(k,1870) + lu(k,1878) = lu(k,1878) - lu(k,930) * lu(k,1870) + lu(k,1879) = lu(k,1879) - lu(k,931) * lu(k,1870) + lu(k,1880) = lu(k,1880) - lu(k,932) * lu(k,1870) + lu(k,1881) = lu(k,1881) - lu(k,933) * lu(k,1870) + lu(k,1882) = lu(k,1882) - lu(k,934) * lu(k,1870) + lu(k,1883) = lu(k,1883) - lu(k,935) * lu(k,1870) + lu(k,1885) = lu(k,1885) - lu(k,936) * lu(k,1870) + lu(k,1886) = lu(k,1886) - lu(k,937) * lu(k,1870) + lu(k,1887) = lu(k,1887) - lu(k,938) * lu(k,1870) + lu(k,1888) = lu(k,1888) - lu(k,939) * lu(k,1870) + lu(k,1889) = lu(k,1889) - lu(k,940) * lu(k,1870) + lu(k,1890) = lu(k,1890) - lu(k,941) * lu(k,1870) + lu(k,1891) = lu(k,1891) - lu(k,942) * lu(k,1870) + lu(k,1893) = lu(k,1893) - lu(k,943) * lu(k,1870) + lu(k,1895) = lu(k,1895) - lu(k,944) * lu(k,1870) + lu(k,1896) = lu(k,1896) - lu(k,945) * lu(k,1870) + lu(k,1912) = lu(k,1912) - lu(k,924) * lu(k,1911) + lu(k,1914) = lu(k,1914) - lu(k,925) * lu(k,1911) + lu(k,1915) = lu(k,1915) - lu(k,926) * lu(k,1911) + lu(k,1916) = lu(k,1916) - lu(k,927) * lu(k,1911) + lu(k,1917) = lu(k,1917) - lu(k,928) * lu(k,1911) + lu(k,1918) = lu(k,1918) - lu(k,929) * lu(k,1911) + lu(k,1919) = lu(k,1919) - lu(k,930) * lu(k,1911) + lu(k,1920) = lu(k,1920) - lu(k,931) * lu(k,1911) + lu(k,1921) = lu(k,1921) - lu(k,932) * lu(k,1911) + lu(k,1922) = lu(k,1922) - lu(k,933) * lu(k,1911) + lu(k,1923) = lu(k,1923) - lu(k,934) * lu(k,1911) + lu(k,1924) = lu(k,1924) - lu(k,935) * lu(k,1911) + lu(k,1926) = lu(k,1926) - lu(k,936) * lu(k,1911) + lu(k,1927) = lu(k,1927) - lu(k,937) * lu(k,1911) + lu(k,1928) = lu(k,1928) - lu(k,938) * lu(k,1911) + lu(k,1929) = lu(k,1929) - lu(k,939) * lu(k,1911) + lu(k,1930) = lu(k,1930) - lu(k,940) * lu(k,1911) + lu(k,1931) = lu(k,1931) - lu(k,941) * lu(k,1911) + lu(k,1932) = lu(k,1932) - lu(k,942) * lu(k,1911) + lu(k,1934) = lu(k,1934) - lu(k,943) * lu(k,1911) + lu(k,1936) = lu(k,1936) - lu(k,944) * lu(k,1911) + lu(k,1937) = lu(k,1937) - lu(k,945) * lu(k,1911) + lu(k,1954) = lu(k,1954) - lu(k,924) * lu(k,1953) + lu(k,1956) = lu(k,1956) - lu(k,925) * lu(k,1953) + lu(k,1957) = lu(k,1957) - lu(k,926) * lu(k,1953) + lu(k,1958) = lu(k,1958) - lu(k,927) * lu(k,1953) + lu(k,1959) = lu(k,1959) - lu(k,928) * lu(k,1953) + lu(k,1960) = lu(k,1960) - lu(k,929) * lu(k,1953) + lu(k,1961) = lu(k,1961) - lu(k,930) * lu(k,1953) + lu(k,1962) = lu(k,1962) - lu(k,931) * lu(k,1953) + lu(k,1963) = lu(k,1963) - lu(k,932) * lu(k,1953) + lu(k,1964) = lu(k,1964) - lu(k,933) * lu(k,1953) + lu(k,1965) = lu(k,1965) - lu(k,934) * lu(k,1953) + lu(k,1966) = lu(k,1966) - lu(k,935) * lu(k,1953) + lu(k,1968) = lu(k,1968) - lu(k,936) * lu(k,1953) + lu(k,1969) = lu(k,1969) - lu(k,937) * lu(k,1953) + lu(k,1970) = lu(k,1970) - lu(k,938) * lu(k,1953) + lu(k,1971) = lu(k,1971) - lu(k,939) * lu(k,1953) + lu(k,1972) = lu(k,1972) - lu(k,940) * lu(k,1953) + lu(k,1973) = lu(k,1973) - lu(k,941) * lu(k,1953) + lu(k,1974) = lu(k,1974) - lu(k,942) * lu(k,1953) + lu(k,1976) = lu(k,1976) - lu(k,943) * lu(k,1953) + lu(k,1978) = lu(k,1978) - lu(k,944) * lu(k,1953) + lu(k,1979) = lu(k,1979) - lu(k,945) * lu(k,1953) + lu(k,2002) = lu(k,2002) - lu(k,924) * lu(k,2001) + lu(k,2004) = lu(k,2004) - lu(k,925) * lu(k,2001) + lu(k,2005) = lu(k,2005) - lu(k,926) * lu(k,2001) + lu(k,2006) = lu(k,2006) - lu(k,927) * lu(k,2001) + lu(k,2007) = lu(k,2007) - lu(k,928) * lu(k,2001) + lu(k,2008) = lu(k,2008) - lu(k,929) * lu(k,2001) + lu(k,2009) = lu(k,2009) - lu(k,930) * lu(k,2001) + lu(k,2010) = lu(k,2010) - lu(k,931) * lu(k,2001) + lu(k,2011) = lu(k,2011) - lu(k,932) * lu(k,2001) + lu(k,2012) = lu(k,2012) - lu(k,933) * lu(k,2001) + lu(k,2013) = lu(k,2013) - lu(k,934) * lu(k,2001) + lu(k,2014) = lu(k,2014) - lu(k,935) * lu(k,2001) + lu(k,2016) = lu(k,2016) - lu(k,936) * lu(k,2001) + lu(k,2017) = lu(k,2017) - lu(k,937) * lu(k,2001) + lu(k,2018) = lu(k,2018) - lu(k,938) * lu(k,2001) + lu(k,2019) = lu(k,2019) - lu(k,939) * lu(k,2001) + lu(k,2020) = lu(k,2020) - lu(k,940) * lu(k,2001) + lu(k,2021) = lu(k,2021) - lu(k,941) * lu(k,2001) + lu(k,2022) = lu(k,2022) - lu(k,942) * lu(k,2001) + lu(k,2024) = lu(k,2024) - lu(k,943) * lu(k,2001) + lu(k,2026) = lu(k,2026) - lu(k,944) * lu(k,2001) + lu(k,2027) = lu(k,2027) - lu(k,945) * lu(k,2001) + lu(k,2062) = lu(k,2062) - lu(k,924) * lu(k,2061) + lu(k,2064) = lu(k,2064) - lu(k,925) * lu(k,2061) + lu(k,2065) = lu(k,2065) - lu(k,926) * lu(k,2061) + lu(k,2066) = lu(k,2066) - lu(k,927) * lu(k,2061) + lu(k,2067) = lu(k,2067) - lu(k,928) * lu(k,2061) + lu(k,2068) = lu(k,2068) - lu(k,929) * lu(k,2061) + lu(k,2069) = lu(k,2069) - lu(k,930) * lu(k,2061) + lu(k,2070) = lu(k,2070) - lu(k,931) * lu(k,2061) + lu(k,2071) = lu(k,2071) - lu(k,932) * lu(k,2061) + lu(k,2072) = lu(k,2072) - lu(k,933) * lu(k,2061) + lu(k,2073) = lu(k,2073) - lu(k,934) * lu(k,2061) + lu(k,2074) = lu(k,2074) - lu(k,935) * lu(k,2061) + lu(k,2076) = lu(k,2076) - lu(k,936) * lu(k,2061) + lu(k,2077) = lu(k,2077) - lu(k,937) * lu(k,2061) + lu(k,2078) = lu(k,2078) - lu(k,938) * lu(k,2061) + lu(k,2079) = lu(k,2079) - lu(k,939) * lu(k,2061) + lu(k,2080) = lu(k,2080) - lu(k,940) * lu(k,2061) + lu(k,2081) = lu(k,2081) - lu(k,941) * lu(k,2061) + lu(k,2082) = lu(k,2082) - lu(k,942) * lu(k,2061) + lu(k,2084) = lu(k,2084) - lu(k,943) * lu(k,2061) + lu(k,2086) = lu(k,2086) - lu(k,944) * lu(k,2061) + lu(k,2087) = lu(k,2087) - lu(k,945) * lu(k,2061) end do end subroutine lu_fac20 subroutine lu_fac21( avec_len, lu ) @@ -10858,827 +8415,1659 @@ subroutine lu_fac21( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1115) = 1._r8 / lu(k,1115) - lu(k,1116) = lu(k,1116) * lu(k,1115) - lu(k,1117) = lu(k,1117) * lu(k,1115) - lu(k,1118) = lu(k,1118) * lu(k,1115) - lu(k,1119) = lu(k,1119) * lu(k,1115) - lu(k,1120) = lu(k,1120) * lu(k,1115) - lu(k,1121) = lu(k,1121) * lu(k,1115) - lu(k,1122) = lu(k,1122) * lu(k,1115) - lu(k,1123) = lu(k,1123) * lu(k,1115) - lu(k,1124) = lu(k,1124) * lu(k,1115) - lu(k,1125) = lu(k,1125) * lu(k,1115) - lu(k,1126) = lu(k,1126) * lu(k,1115) - lu(k,1127) = lu(k,1127) * lu(k,1115) - lu(k,1128) = lu(k,1128) * lu(k,1115) - lu(k,1129) = lu(k,1129) * lu(k,1115) - lu(k,1130) = lu(k,1130) * lu(k,1115) - lu(k,1131) = lu(k,1131) * lu(k,1115) - lu(k,1132) = lu(k,1132) * lu(k,1115) - lu(k,1160) = lu(k,1160) - lu(k,1116) * lu(k,1159) - lu(k,1161) = lu(k,1161) - lu(k,1117) * lu(k,1159) - lu(k,1162) = lu(k,1162) - lu(k,1118) * lu(k,1159) - lu(k,1163) = lu(k,1163) - lu(k,1119) * lu(k,1159) - lu(k,1164) = lu(k,1164) - lu(k,1120) * lu(k,1159) - lu(k,1165) = lu(k,1165) - lu(k,1121) * lu(k,1159) - lu(k,1166) = lu(k,1166) - lu(k,1122) * lu(k,1159) - lu(k,1167) = lu(k,1167) - lu(k,1123) * lu(k,1159) - lu(k,1168) = lu(k,1168) - lu(k,1124) * lu(k,1159) - lu(k,1169) = lu(k,1169) - lu(k,1125) * lu(k,1159) - lu(k,1170) = lu(k,1170) - lu(k,1126) * lu(k,1159) - lu(k,1171) = lu(k,1171) - lu(k,1127) * lu(k,1159) - lu(k,1172) = lu(k,1172) - lu(k,1128) * lu(k,1159) - lu(k,1173) = lu(k,1173) - lu(k,1129) * lu(k,1159) - lu(k,1174) = lu(k,1174) - lu(k,1130) * lu(k,1159) - lu(k,1175) = lu(k,1175) - lu(k,1131) * lu(k,1159) - lu(k,1176) = lu(k,1176) - lu(k,1132) * lu(k,1159) - lu(k,1201) = lu(k,1201) - lu(k,1116) * lu(k,1200) - lu(k,1202) = lu(k,1202) - lu(k,1117) * lu(k,1200) - lu(k,1203) = lu(k,1203) - lu(k,1118) * lu(k,1200) - lu(k,1204) = lu(k,1204) - lu(k,1119) * lu(k,1200) - lu(k,1205) = lu(k,1205) - lu(k,1120) * lu(k,1200) - lu(k,1206) = lu(k,1206) - lu(k,1121) * lu(k,1200) - lu(k,1207) = lu(k,1207) - lu(k,1122) * lu(k,1200) - lu(k,1208) = lu(k,1208) - lu(k,1123) * lu(k,1200) - lu(k,1209) = lu(k,1209) - lu(k,1124) * lu(k,1200) - lu(k,1210) = lu(k,1210) - lu(k,1125) * lu(k,1200) - lu(k,1211) = lu(k,1211) - lu(k,1126) * lu(k,1200) - lu(k,1212) = lu(k,1212) - lu(k,1127) * lu(k,1200) - lu(k,1213) = lu(k,1213) - lu(k,1128) * lu(k,1200) - lu(k,1214) = lu(k,1214) - lu(k,1129) * lu(k,1200) - lu(k,1215) = lu(k,1215) - lu(k,1130) * lu(k,1200) - lu(k,1216) = lu(k,1216) - lu(k,1131) * lu(k,1200) - lu(k,1217) = lu(k,1217) - lu(k,1132) * lu(k,1200) - lu(k,1250) = lu(k,1250) - lu(k,1116) * lu(k,1249) - lu(k,1251) = lu(k,1251) - lu(k,1117) * lu(k,1249) - lu(k,1252) = lu(k,1252) - lu(k,1118) * lu(k,1249) - lu(k,1253) = lu(k,1253) - lu(k,1119) * lu(k,1249) - lu(k,1254) = lu(k,1254) - lu(k,1120) * lu(k,1249) - lu(k,1255) = lu(k,1255) - lu(k,1121) * lu(k,1249) - lu(k,1256) = lu(k,1256) - lu(k,1122) * lu(k,1249) - lu(k,1257) = lu(k,1257) - lu(k,1123) * lu(k,1249) - lu(k,1258) = lu(k,1258) - lu(k,1124) * lu(k,1249) - lu(k,1259) = lu(k,1259) - lu(k,1125) * lu(k,1249) - lu(k,1260) = lu(k,1260) - lu(k,1126) * lu(k,1249) - lu(k,1261) = lu(k,1261) - lu(k,1127) * lu(k,1249) - lu(k,1262) = lu(k,1262) - lu(k,1128) * lu(k,1249) - lu(k,1263) = lu(k,1263) - lu(k,1129) * lu(k,1249) - lu(k,1264) = lu(k,1264) - lu(k,1130) * lu(k,1249) - lu(k,1265) = lu(k,1265) - lu(k,1131) * lu(k,1249) - lu(k,1266) = lu(k,1266) - lu(k,1132) * lu(k,1249) - lu(k,1289) = lu(k,1289) - lu(k,1116) * lu(k,1288) - lu(k,1290) = lu(k,1290) - lu(k,1117) * lu(k,1288) - lu(k,1291) = lu(k,1291) - lu(k,1118) * lu(k,1288) - lu(k,1292) = lu(k,1292) - lu(k,1119) * lu(k,1288) - lu(k,1293) = lu(k,1293) - lu(k,1120) * lu(k,1288) - lu(k,1294) = lu(k,1294) - lu(k,1121) * lu(k,1288) - lu(k,1295) = lu(k,1295) - lu(k,1122) * lu(k,1288) - lu(k,1296) = lu(k,1296) - lu(k,1123) * lu(k,1288) - lu(k,1297) = lu(k,1297) - lu(k,1124) * lu(k,1288) - lu(k,1298) = lu(k,1298) - lu(k,1125) * lu(k,1288) - lu(k,1299) = lu(k,1299) - lu(k,1126) * lu(k,1288) - lu(k,1300) = lu(k,1300) - lu(k,1127) * lu(k,1288) - lu(k,1301) = lu(k,1301) - lu(k,1128) * lu(k,1288) - lu(k,1302) = lu(k,1302) - lu(k,1129) * lu(k,1288) - lu(k,1303) = lu(k,1303) - lu(k,1130) * lu(k,1288) - lu(k,1304) = lu(k,1304) - lu(k,1131) * lu(k,1288) - lu(k,1305) = lu(k,1305) - lu(k,1132) * lu(k,1288) - lu(k,1324) = lu(k,1324) - lu(k,1116) * lu(k,1323) - lu(k,1325) = lu(k,1325) - lu(k,1117) * lu(k,1323) - lu(k,1326) = lu(k,1326) - lu(k,1118) * lu(k,1323) - lu(k,1327) = lu(k,1327) - lu(k,1119) * lu(k,1323) - lu(k,1328) = lu(k,1328) - lu(k,1120) * lu(k,1323) - lu(k,1329) = lu(k,1329) - lu(k,1121) * lu(k,1323) - lu(k,1330) = lu(k,1330) - lu(k,1122) * lu(k,1323) - lu(k,1331) = lu(k,1331) - lu(k,1123) * lu(k,1323) - lu(k,1332) = lu(k,1332) - lu(k,1124) * lu(k,1323) - lu(k,1333) = lu(k,1333) - lu(k,1125) * lu(k,1323) - lu(k,1334) = lu(k,1334) - lu(k,1126) * lu(k,1323) - lu(k,1335) = lu(k,1335) - lu(k,1127) * lu(k,1323) - lu(k,1336) = lu(k,1336) - lu(k,1128) * lu(k,1323) - lu(k,1337) = lu(k,1337) - lu(k,1129) * lu(k,1323) - lu(k,1338) = lu(k,1338) - lu(k,1130) * lu(k,1323) - lu(k,1339) = lu(k,1339) - lu(k,1131) * lu(k,1323) - lu(k,1340) = lu(k,1340) - lu(k,1132) * lu(k,1323) - lu(k,1368) = lu(k,1368) - lu(k,1116) * lu(k,1367) - lu(k,1369) = lu(k,1369) - lu(k,1117) * lu(k,1367) - lu(k,1370) = lu(k,1370) - lu(k,1118) * lu(k,1367) - lu(k,1371) = lu(k,1371) - lu(k,1119) * lu(k,1367) - lu(k,1372) = lu(k,1372) - lu(k,1120) * lu(k,1367) - lu(k,1373) = lu(k,1373) - lu(k,1121) * lu(k,1367) - lu(k,1374) = lu(k,1374) - lu(k,1122) * lu(k,1367) - lu(k,1375) = lu(k,1375) - lu(k,1123) * lu(k,1367) - lu(k,1376) = lu(k,1376) - lu(k,1124) * lu(k,1367) - lu(k,1377) = lu(k,1377) - lu(k,1125) * lu(k,1367) - lu(k,1378) = lu(k,1378) - lu(k,1126) * lu(k,1367) - lu(k,1379) = lu(k,1379) - lu(k,1127) * lu(k,1367) - lu(k,1380) = lu(k,1380) - lu(k,1128) * lu(k,1367) - lu(k,1381) = lu(k,1381) - lu(k,1129) * lu(k,1367) - lu(k,1382) = lu(k,1382) - lu(k,1130) * lu(k,1367) - lu(k,1383) = lu(k,1383) - lu(k,1131) * lu(k,1367) - lu(k,1384) = lu(k,1384) - lu(k,1132) * lu(k,1367) - lu(k,1427) = lu(k,1427) - lu(k,1116) * lu(k,1426) - lu(k,1428) = lu(k,1428) - lu(k,1117) * lu(k,1426) - lu(k,1429) = lu(k,1429) - lu(k,1118) * lu(k,1426) - lu(k,1430) = lu(k,1430) - lu(k,1119) * lu(k,1426) - lu(k,1431) = lu(k,1431) - lu(k,1120) * lu(k,1426) - lu(k,1432) = lu(k,1432) - lu(k,1121) * lu(k,1426) - lu(k,1433) = lu(k,1433) - lu(k,1122) * lu(k,1426) - lu(k,1434) = lu(k,1434) - lu(k,1123) * lu(k,1426) - lu(k,1435) = lu(k,1435) - lu(k,1124) * lu(k,1426) - lu(k,1436) = lu(k,1436) - lu(k,1125) * lu(k,1426) - lu(k,1437) = lu(k,1437) - lu(k,1126) * lu(k,1426) - lu(k,1438) = lu(k,1438) - lu(k,1127) * lu(k,1426) - lu(k,1439) = lu(k,1439) - lu(k,1128) * lu(k,1426) - lu(k,1440) = lu(k,1440) - lu(k,1129) * lu(k,1426) - lu(k,1441) = lu(k,1441) - lu(k,1130) * lu(k,1426) - lu(k,1442) = lu(k,1442) - lu(k,1131) * lu(k,1426) - lu(k,1443) = lu(k,1443) - lu(k,1132) * lu(k,1426) - lu(k,1469) = lu(k,1469) - lu(k,1116) * lu(k,1468) - lu(k,1470) = lu(k,1470) - lu(k,1117) * lu(k,1468) - lu(k,1471) = lu(k,1471) - lu(k,1118) * lu(k,1468) - lu(k,1472) = lu(k,1472) - lu(k,1119) * lu(k,1468) - lu(k,1473) = lu(k,1473) - lu(k,1120) * lu(k,1468) - lu(k,1474) = lu(k,1474) - lu(k,1121) * lu(k,1468) - lu(k,1475) = lu(k,1475) - lu(k,1122) * lu(k,1468) - lu(k,1476) = lu(k,1476) - lu(k,1123) * lu(k,1468) - lu(k,1477) = lu(k,1477) - lu(k,1124) * lu(k,1468) - lu(k,1478) = lu(k,1478) - lu(k,1125) * lu(k,1468) - lu(k,1479) = lu(k,1479) - lu(k,1126) * lu(k,1468) - lu(k,1480) = lu(k,1480) - lu(k,1127) * lu(k,1468) - lu(k,1481) = lu(k,1481) - lu(k,1128) * lu(k,1468) - lu(k,1482) = lu(k,1482) - lu(k,1129) * lu(k,1468) - lu(k,1483) = lu(k,1483) - lu(k,1130) * lu(k,1468) - lu(k,1484) = lu(k,1484) - lu(k,1131) * lu(k,1468) - lu(k,1485) = lu(k,1485) - lu(k,1132) * lu(k,1468) - lu(k,1510) = lu(k,1510) - lu(k,1116) * lu(k,1509) - lu(k,1511) = lu(k,1511) - lu(k,1117) * lu(k,1509) - lu(k,1512) = lu(k,1512) - lu(k,1118) * lu(k,1509) - lu(k,1513) = lu(k,1513) - lu(k,1119) * lu(k,1509) - lu(k,1514) = lu(k,1514) - lu(k,1120) * lu(k,1509) - lu(k,1515) = lu(k,1515) - lu(k,1121) * lu(k,1509) - lu(k,1516) = lu(k,1516) - lu(k,1122) * lu(k,1509) - lu(k,1517) = lu(k,1517) - lu(k,1123) * lu(k,1509) - lu(k,1518) = lu(k,1518) - lu(k,1124) * lu(k,1509) - lu(k,1519) = lu(k,1519) - lu(k,1125) * lu(k,1509) - lu(k,1520) = lu(k,1520) - lu(k,1126) * lu(k,1509) - lu(k,1521) = lu(k,1521) - lu(k,1127) * lu(k,1509) - lu(k,1522) = lu(k,1522) - lu(k,1128) * lu(k,1509) - lu(k,1523) = lu(k,1523) - lu(k,1129) * lu(k,1509) - lu(k,1524) = lu(k,1524) - lu(k,1130) * lu(k,1509) - lu(k,1525) = lu(k,1525) - lu(k,1131) * lu(k,1509) - lu(k,1526) = lu(k,1526) - lu(k,1132) * lu(k,1509) - lu(k,1552) = lu(k,1552) - lu(k,1116) * lu(k,1551) - lu(k,1553) = lu(k,1553) - lu(k,1117) * lu(k,1551) - lu(k,1554) = lu(k,1554) - lu(k,1118) * lu(k,1551) - lu(k,1555) = lu(k,1555) - lu(k,1119) * lu(k,1551) - lu(k,1556) = lu(k,1556) - lu(k,1120) * lu(k,1551) - lu(k,1557) = lu(k,1557) - lu(k,1121) * lu(k,1551) - lu(k,1558) = lu(k,1558) - lu(k,1122) * lu(k,1551) - lu(k,1559) = lu(k,1559) - lu(k,1123) * lu(k,1551) - lu(k,1560) = lu(k,1560) - lu(k,1124) * lu(k,1551) - lu(k,1561) = lu(k,1561) - lu(k,1125) * lu(k,1551) - lu(k,1562) = lu(k,1562) - lu(k,1126) * lu(k,1551) - lu(k,1563) = lu(k,1563) - lu(k,1127) * lu(k,1551) - lu(k,1564) = lu(k,1564) - lu(k,1128) * lu(k,1551) - lu(k,1565) = lu(k,1565) - lu(k,1129) * lu(k,1551) - lu(k,1566) = lu(k,1566) - lu(k,1130) * lu(k,1551) - lu(k,1567) = lu(k,1567) - lu(k,1131) * lu(k,1551) - lu(k,1568) = lu(k,1568) - lu(k,1132) * lu(k,1551) - lu(k,1594) = lu(k,1594) - lu(k,1116) * lu(k,1593) - lu(k,1595) = lu(k,1595) - lu(k,1117) * lu(k,1593) - lu(k,1596) = lu(k,1596) - lu(k,1118) * lu(k,1593) - lu(k,1597) = lu(k,1597) - lu(k,1119) * lu(k,1593) - lu(k,1598) = lu(k,1598) - lu(k,1120) * lu(k,1593) - lu(k,1599) = lu(k,1599) - lu(k,1121) * lu(k,1593) - lu(k,1600) = lu(k,1600) - lu(k,1122) * lu(k,1593) - lu(k,1601) = lu(k,1601) - lu(k,1123) * lu(k,1593) - lu(k,1602) = lu(k,1602) - lu(k,1124) * lu(k,1593) - lu(k,1603) = lu(k,1603) - lu(k,1125) * lu(k,1593) - lu(k,1604) = lu(k,1604) - lu(k,1126) * lu(k,1593) - lu(k,1605) = lu(k,1605) - lu(k,1127) * lu(k,1593) - lu(k,1606) = lu(k,1606) - lu(k,1128) * lu(k,1593) - lu(k,1607) = lu(k,1607) - lu(k,1129) * lu(k,1593) - lu(k,1608) = lu(k,1608) - lu(k,1130) * lu(k,1593) - lu(k,1609) = lu(k,1609) - lu(k,1131) * lu(k,1593) - lu(k,1610) = lu(k,1610) - lu(k,1132) * lu(k,1593) - lu(k,1626) = lu(k,1626) - lu(k,1116) * lu(k,1625) - lu(k,1627) = lu(k,1627) - lu(k,1117) * lu(k,1625) - lu(k,1628) = lu(k,1628) - lu(k,1118) * lu(k,1625) - lu(k,1629) = lu(k,1629) - lu(k,1119) * lu(k,1625) - lu(k,1630) = lu(k,1630) - lu(k,1120) * lu(k,1625) - lu(k,1631) = lu(k,1631) - lu(k,1121) * lu(k,1625) - lu(k,1632) = lu(k,1632) - lu(k,1122) * lu(k,1625) - lu(k,1633) = lu(k,1633) - lu(k,1123) * lu(k,1625) - lu(k,1634) = lu(k,1634) - lu(k,1124) * lu(k,1625) - lu(k,1635) = lu(k,1635) - lu(k,1125) * lu(k,1625) - lu(k,1636) = lu(k,1636) - lu(k,1126) * lu(k,1625) - lu(k,1637) = lu(k,1637) - lu(k,1127) * lu(k,1625) - lu(k,1638) = lu(k,1638) - lu(k,1128) * lu(k,1625) - lu(k,1639) = lu(k,1639) - lu(k,1129) * lu(k,1625) - lu(k,1640) = lu(k,1640) - lu(k,1130) * lu(k,1625) - lu(k,1641) = lu(k,1641) - lu(k,1131) * lu(k,1625) - lu(k,1642) = lu(k,1642) - lu(k,1132) * lu(k,1625) - lu(k,1661) = lu(k,1661) - lu(k,1116) * lu(k,1660) - lu(k,1662) = lu(k,1662) - lu(k,1117) * lu(k,1660) - lu(k,1663) = lu(k,1663) - lu(k,1118) * lu(k,1660) - lu(k,1664) = lu(k,1664) - lu(k,1119) * lu(k,1660) - lu(k,1665) = lu(k,1665) - lu(k,1120) * lu(k,1660) - lu(k,1666) = lu(k,1666) - lu(k,1121) * lu(k,1660) - lu(k,1667) = lu(k,1667) - lu(k,1122) * lu(k,1660) - lu(k,1668) = lu(k,1668) - lu(k,1123) * lu(k,1660) - lu(k,1669) = lu(k,1669) - lu(k,1124) * lu(k,1660) - lu(k,1670) = lu(k,1670) - lu(k,1125) * lu(k,1660) - lu(k,1671) = lu(k,1671) - lu(k,1126) * lu(k,1660) - lu(k,1672) = lu(k,1672) - lu(k,1127) * lu(k,1660) - lu(k,1673) = lu(k,1673) - lu(k,1128) * lu(k,1660) - lu(k,1674) = lu(k,1674) - lu(k,1129) * lu(k,1660) - lu(k,1675) = lu(k,1675) - lu(k,1130) * lu(k,1660) - lu(k,1676) = lu(k,1676) - lu(k,1131) * lu(k,1660) - lu(k,1677) = lu(k,1677) - lu(k,1132) * lu(k,1660) - lu(k,1703) = lu(k,1703) - lu(k,1116) * lu(k,1702) - lu(k,1704) = lu(k,1704) - lu(k,1117) * lu(k,1702) - lu(k,1705) = lu(k,1705) - lu(k,1118) * lu(k,1702) - lu(k,1706) = lu(k,1706) - lu(k,1119) * lu(k,1702) - lu(k,1707) = lu(k,1707) - lu(k,1120) * lu(k,1702) - lu(k,1708) = lu(k,1708) - lu(k,1121) * lu(k,1702) - lu(k,1709) = lu(k,1709) - lu(k,1122) * lu(k,1702) - lu(k,1710) = lu(k,1710) - lu(k,1123) * lu(k,1702) - lu(k,1711) = lu(k,1711) - lu(k,1124) * lu(k,1702) - lu(k,1712) = lu(k,1712) - lu(k,1125) * lu(k,1702) - lu(k,1713) = lu(k,1713) - lu(k,1126) * lu(k,1702) - lu(k,1714) = lu(k,1714) - lu(k,1127) * lu(k,1702) - lu(k,1715) = lu(k,1715) - lu(k,1128) * lu(k,1702) - lu(k,1716) = lu(k,1716) - lu(k,1129) * lu(k,1702) - lu(k,1717) = lu(k,1717) - lu(k,1130) * lu(k,1702) - lu(k,1718) = lu(k,1718) - lu(k,1131) * lu(k,1702) - lu(k,1719) = lu(k,1719) - lu(k,1132) * lu(k,1702) - lu(k,1747) = lu(k,1747) - lu(k,1116) * lu(k,1746) - lu(k,1748) = lu(k,1748) - lu(k,1117) * lu(k,1746) - lu(k,1749) = lu(k,1749) - lu(k,1118) * lu(k,1746) - lu(k,1750) = lu(k,1750) - lu(k,1119) * lu(k,1746) - lu(k,1751) = lu(k,1751) - lu(k,1120) * lu(k,1746) - lu(k,1752) = lu(k,1752) - lu(k,1121) * lu(k,1746) - lu(k,1753) = lu(k,1753) - lu(k,1122) * lu(k,1746) - lu(k,1754) = lu(k,1754) - lu(k,1123) * lu(k,1746) - lu(k,1755) = lu(k,1755) - lu(k,1124) * lu(k,1746) - lu(k,1756) = lu(k,1756) - lu(k,1125) * lu(k,1746) - lu(k,1757) = lu(k,1757) - lu(k,1126) * lu(k,1746) - lu(k,1758) = lu(k,1758) - lu(k,1127) * lu(k,1746) - lu(k,1759) = lu(k,1759) - lu(k,1128) * lu(k,1746) - lu(k,1760) = lu(k,1760) - lu(k,1129) * lu(k,1746) - lu(k,1761) = lu(k,1761) - lu(k,1130) * lu(k,1746) - lu(k,1762) = lu(k,1762) - lu(k,1131) * lu(k,1746) - lu(k,1763) = lu(k,1763) - lu(k,1132) * lu(k,1746) - lu(k,1782) = lu(k,1782) - lu(k,1116) * lu(k,1781) - lu(k,1783) = lu(k,1783) - lu(k,1117) * lu(k,1781) - lu(k,1784) = lu(k,1784) - lu(k,1118) * lu(k,1781) - lu(k,1785) = lu(k,1785) - lu(k,1119) * lu(k,1781) - lu(k,1786) = lu(k,1786) - lu(k,1120) * lu(k,1781) - lu(k,1787) = lu(k,1787) - lu(k,1121) * lu(k,1781) - lu(k,1788) = lu(k,1788) - lu(k,1122) * lu(k,1781) - lu(k,1789) = lu(k,1789) - lu(k,1123) * lu(k,1781) - lu(k,1790) = lu(k,1790) - lu(k,1124) * lu(k,1781) - lu(k,1791) = lu(k,1791) - lu(k,1125) * lu(k,1781) - lu(k,1792) = lu(k,1792) - lu(k,1126) * lu(k,1781) - lu(k,1793) = lu(k,1793) - lu(k,1127) * lu(k,1781) - lu(k,1794) = lu(k,1794) - lu(k,1128) * lu(k,1781) - lu(k,1795) = lu(k,1795) - lu(k,1129) * lu(k,1781) - lu(k,1796) = lu(k,1796) - lu(k,1130) * lu(k,1781) - lu(k,1797) = lu(k,1797) - lu(k,1131) * lu(k,1781) - lu(k,1798) = lu(k,1798) - lu(k,1132) * lu(k,1781) - lu(k,1840) = lu(k,1840) - lu(k,1116) * lu(k,1839) - lu(k,1841) = lu(k,1841) - lu(k,1117) * lu(k,1839) - lu(k,1842) = lu(k,1842) - lu(k,1118) * lu(k,1839) - lu(k,1843) = lu(k,1843) - lu(k,1119) * lu(k,1839) - lu(k,1844) = lu(k,1844) - lu(k,1120) * lu(k,1839) - lu(k,1845) = lu(k,1845) - lu(k,1121) * lu(k,1839) - lu(k,1846) = lu(k,1846) - lu(k,1122) * lu(k,1839) - lu(k,1847) = lu(k,1847) - lu(k,1123) * lu(k,1839) - lu(k,1848) = lu(k,1848) - lu(k,1124) * lu(k,1839) - lu(k,1849) = lu(k,1849) - lu(k,1125) * lu(k,1839) - lu(k,1850) = lu(k,1850) - lu(k,1126) * lu(k,1839) - lu(k,1851) = lu(k,1851) - lu(k,1127) * lu(k,1839) - lu(k,1852) = lu(k,1852) - lu(k,1128) * lu(k,1839) - lu(k,1853) = lu(k,1853) - lu(k,1129) * lu(k,1839) - lu(k,1854) = lu(k,1854) - lu(k,1130) * lu(k,1839) - lu(k,1855) = lu(k,1855) - lu(k,1131) * lu(k,1839) - lu(k,1856) = lu(k,1856) - lu(k,1132) * lu(k,1839) - lu(k,1160) = 1._r8 / lu(k,1160) - lu(k,1161) = lu(k,1161) * lu(k,1160) - lu(k,1162) = lu(k,1162) * lu(k,1160) - lu(k,1163) = lu(k,1163) * lu(k,1160) - lu(k,1164) = lu(k,1164) * lu(k,1160) - lu(k,1165) = lu(k,1165) * lu(k,1160) - lu(k,1166) = lu(k,1166) * lu(k,1160) - lu(k,1167) = lu(k,1167) * lu(k,1160) - lu(k,1168) = lu(k,1168) * lu(k,1160) - lu(k,1169) = lu(k,1169) * lu(k,1160) - lu(k,1170) = lu(k,1170) * lu(k,1160) - lu(k,1171) = lu(k,1171) * lu(k,1160) - lu(k,1172) = lu(k,1172) * lu(k,1160) - lu(k,1173) = lu(k,1173) * lu(k,1160) - lu(k,1174) = lu(k,1174) * lu(k,1160) - lu(k,1175) = lu(k,1175) * lu(k,1160) - lu(k,1176) = lu(k,1176) * lu(k,1160) - lu(k,1202) = lu(k,1202) - lu(k,1161) * lu(k,1201) - lu(k,1203) = lu(k,1203) - lu(k,1162) * lu(k,1201) - lu(k,1204) = lu(k,1204) - lu(k,1163) * lu(k,1201) - lu(k,1205) = lu(k,1205) - lu(k,1164) * lu(k,1201) - lu(k,1206) = lu(k,1206) - lu(k,1165) * lu(k,1201) - lu(k,1207) = lu(k,1207) - lu(k,1166) * lu(k,1201) - lu(k,1208) = lu(k,1208) - lu(k,1167) * lu(k,1201) - lu(k,1209) = lu(k,1209) - lu(k,1168) * lu(k,1201) - lu(k,1210) = lu(k,1210) - lu(k,1169) * lu(k,1201) - lu(k,1211) = lu(k,1211) - lu(k,1170) * lu(k,1201) - lu(k,1212) = lu(k,1212) - lu(k,1171) * lu(k,1201) - lu(k,1213) = lu(k,1213) - lu(k,1172) * lu(k,1201) - lu(k,1214) = lu(k,1214) - lu(k,1173) * lu(k,1201) - lu(k,1215) = lu(k,1215) - lu(k,1174) * lu(k,1201) - lu(k,1216) = lu(k,1216) - lu(k,1175) * lu(k,1201) - lu(k,1217) = lu(k,1217) - lu(k,1176) * lu(k,1201) - lu(k,1251) = lu(k,1251) - lu(k,1161) * lu(k,1250) - lu(k,1252) = lu(k,1252) - lu(k,1162) * lu(k,1250) - lu(k,1253) = lu(k,1253) - lu(k,1163) * lu(k,1250) - lu(k,1254) = lu(k,1254) - lu(k,1164) * lu(k,1250) - lu(k,1255) = lu(k,1255) - lu(k,1165) * lu(k,1250) - lu(k,1256) = lu(k,1256) - lu(k,1166) * lu(k,1250) - lu(k,1257) = lu(k,1257) - lu(k,1167) * lu(k,1250) - lu(k,1258) = lu(k,1258) - lu(k,1168) * lu(k,1250) - lu(k,1259) = lu(k,1259) - lu(k,1169) * lu(k,1250) - lu(k,1260) = lu(k,1260) - lu(k,1170) * lu(k,1250) - lu(k,1261) = lu(k,1261) - lu(k,1171) * lu(k,1250) - lu(k,1262) = lu(k,1262) - lu(k,1172) * lu(k,1250) - lu(k,1263) = lu(k,1263) - lu(k,1173) * lu(k,1250) - lu(k,1264) = lu(k,1264) - lu(k,1174) * lu(k,1250) - lu(k,1265) = lu(k,1265) - lu(k,1175) * lu(k,1250) - lu(k,1266) = lu(k,1266) - lu(k,1176) * lu(k,1250) - lu(k,1290) = lu(k,1290) - lu(k,1161) * lu(k,1289) - lu(k,1291) = lu(k,1291) - lu(k,1162) * lu(k,1289) - lu(k,1292) = lu(k,1292) - lu(k,1163) * lu(k,1289) - lu(k,1293) = lu(k,1293) - lu(k,1164) * lu(k,1289) - lu(k,1294) = lu(k,1294) - lu(k,1165) * lu(k,1289) - lu(k,1295) = lu(k,1295) - lu(k,1166) * lu(k,1289) - lu(k,1296) = lu(k,1296) - lu(k,1167) * lu(k,1289) - lu(k,1297) = lu(k,1297) - lu(k,1168) * lu(k,1289) - lu(k,1298) = lu(k,1298) - lu(k,1169) * lu(k,1289) - lu(k,1299) = lu(k,1299) - lu(k,1170) * lu(k,1289) - lu(k,1300) = lu(k,1300) - lu(k,1171) * lu(k,1289) - lu(k,1301) = lu(k,1301) - lu(k,1172) * lu(k,1289) - lu(k,1302) = lu(k,1302) - lu(k,1173) * lu(k,1289) - lu(k,1303) = lu(k,1303) - lu(k,1174) * lu(k,1289) - lu(k,1304) = lu(k,1304) - lu(k,1175) * lu(k,1289) - lu(k,1305) = lu(k,1305) - lu(k,1176) * lu(k,1289) - lu(k,1325) = lu(k,1325) - lu(k,1161) * lu(k,1324) - lu(k,1326) = lu(k,1326) - lu(k,1162) * lu(k,1324) - lu(k,1327) = lu(k,1327) - lu(k,1163) * lu(k,1324) - lu(k,1328) = lu(k,1328) - lu(k,1164) * lu(k,1324) - lu(k,1329) = lu(k,1329) - lu(k,1165) * lu(k,1324) - lu(k,1330) = lu(k,1330) - lu(k,1166) * lu(k,1324) - lu(k,1331) = lu(k,1331) - lu(k,1167) * lu(k,1324) - lu(k,1332) = lu(k,1332) - lu(k,1168) * lu(k,1324) - lu(k,1333) = lu(k,1333) - lu(k,1169) * lu(k,1324) - lu(k,1334) = lu(k,1334) - lu(k,1170) * lu(k,1324) - lu(k,1335) = lu(k,1335) - lu(k,1171) * lu(k,1324) - lu(k,1336) = lu(k,1336) - lu(k,1172) * lu(k,1324) - lu(k,1337) = lu(k,1337) - lu(k,1173) * lu(k,1324) - lu(k,1338) = lu(k,1338) - lu(k,1174) * lu(k,1324) - lu(k,1339) = lu(k,1339) - lu(k,1175) * lu(k,1324) - lu(k,1340) = lu(k,1340) - lu(k,1176) * lu(k,1324) - lu(k,1369) = lu(k,1369) - lu(k,1161) * lu(k,1368) - lu(k,1370) = lu(k,1370) - lu(k,1162) * lu(k,1368) - lu(k,1371) = lu(k,1371) - lu(k,1163) * lu(k,1368) - lu(k,1372) = lu(k,1372) - lu(k,1164) * lu(k,1368) - lu(k,1373) = lu(k,1373) - lu(k,1165) * lu(k,1368) - lu(k,1374) = lu(k,1374) - lu(k,1166) * lu(k,1368) - lu(k,1375) = lu(k,1375) - lu(k,1167) * lu(k,1368) - lu(k,1376) = lu(k,1376) - lu(k,1168) * lu(k,1368) - lu(k,1377) = lu(k,1377) - lu(k,1169) * lu(k,1368) - lu(k,1378) = lu(k,1378) - lu(k,1170) * lu(k,1368) - lu(k,1379) = lu(k,1379) - lu(k,1171) * lu(k,1368) - lu(k,1380) = lu(k,1380) - lu(k,1172) * lu(k,1368) - lu(k,1381) = lu(k,1381) - lu(k,1173) * lu(k,1368) - lu(k,1382) = lu(k,1382) - lu(k,1174) * lu(k,1368) - lu(k,1383) = lu(k,1383) - lu(k,1175) * lu(k,1368) - lu(k,1384) = lu(k,1384) - lu(k,1176) * lu(k,1368) - lu(k,1428) = lu(k,1428) - lu(k,1161) * lu(k,1427) - lu(k,1429) = lu(k,1429) - lu(k,1162) * lu(k,1427) - lu(k,1430) = lu(k,1430) - lu(k,1163) * lu(k,1427) - lu(k,1431) = lu(k,1431) - lu(k,1164) * lu(k,1427) - lu(k,1432) = lu(k,1432) - lu(k,1165) * lu(k,1427) - lu(k,1433) = lu(k,1433) - lu(k,1166) * lu(k,1427) - lu(k,1434) = lu(k,1434) - lu(k,1167) * lu(k,1427) - lu(k,1435) = lu(k,1435) - lu(k,1168) * lu(k,1427) - lu(k,1436) = lu(k,1436) - lu(k,1169) * lu(k,1427) - lu(k,1437) = lu(k,1437) - lu(k,1170) * lu(k,1427) - lu(k,1438) = lu(k,1438) - lu(k,1171) * lu(k,1427) - lu(k,1439) = lu(k,1439) - lu(k,1172) * lu(k,1427) - lu(k,1440) = lu(k,1440) - lu(k,1173) * lu(k,1427) - lu(k,1441) = lu(k,1441) - lu(k,1174) * lu(k,1427) - lu(k,1442) = lu(k,1442) - lu(k,1175) * lu(k,1427) - lu(k,1443) = lu(k,1443) - lu(k,1176) * lu(k,1427) - lu(k,1470) = lu(k,1470) - lu(k,1161) * lu(k,1469) - lu(k,1471) = lu(k,1471) - lu(k,1162) * lu(k,1469) - lu(k,1472) = lu(k,1472) - lu(k,1163) * lu(k,1469) - lu(k,1473) = lu(k,1473) - lu(k,1164) * lu(k,1469) - lu(k,1474) = lu(k,1474) - lu(k,1165) * lu(k,1469) - lu(k,1475) = lu(k,1475) - lu(k,1166) * lu(k,1469) - lu(k,1476) = lu(k,1476) - lu(k,1167) * lu(k,1469) - lu(k,1477) = lu(k,1477) - lu(k,1168) * lu(k,1469) - lu(k,1478) = lu(k,1478) - lu(k,1169) * lu(k,1469) - lu(k,1479) = lu(k,1479) - lu(k,1170) * lu(k,1469) - lu(k,1480) = lu(k,1480) - lu(k,1171) * lu(k,1469) - lu(k,1481) = lu(k,1481) - lu(k,1172) * lu(k,1469) - lu(k,1482) = lu(k,1482) - lu(k,1173) * lu(k,1469) - lu(k,1483) = lu(k,1483) - lu(k,1174) * lu(k,1469) - lu(k,1484) = lu(k,1484) - lu(k,1175) * lu(k,1469) - lu(k,1485) = lu(k,1485) - lu(k,1176) * lu(k,1469) - lu(k,1511) = lu(k,1511) - lu(k,1161) * lu(k,1510) - lu(k,1512) = lu(k,1512) - lu(k,1162) * lu(k,1510) - lu(k,1513) = lu(k,1513) - lu(k,1163) * lu(k,1510) - lu(k,1514) = lu(k,1514) - lu(k,1164) * lu(k,1510) - lu(k,1515) = lu(k,1515) - lu(k,1165) * lu(k,1510) - lu(k,1516) = lu(k,1516) - lu(k,1166) * lu(k,1510) - lu(k,1517) = lu(k,1517) - lu(k,1167) * lu(k,1510) - lu(k,1518) = lu(k,1518) - lu(k,1168) * lu(k,1510) - lu(k,1519) = lu(k,1519) - lu(k,1169) * lu(k,1510) - lu(k,1520) = lu(k,1520) - lu(k,1170) * lu(k,1510) - lu(k,1521) = lu(k,1521) - lu(k,1171) * lu(k,1510) - lu(k,1522) = lu(k,1522) - lu(k,1172) * lu(k,1510) - lu(k,1523) = lu(k,1523) - lu(k,1173) * lu(k,1510) - lu(k,1524) = lu(k,1524) - lu(k,1174) * lu(k,1510) - lu(k,1525) = lu(k,1525) - lu(k,1175) * lu(k,1510) - lu(k,1526) = lu(k,1526) - lu(k,1176) * lu(k,1510) - lu(k,1553) = lu(k,1553) - lu(k,1161) * lu(k,1552) - lu(k,1554) = lu(k,1554) - lu(k,1162) * lu(k,1552) - lu(k,1555) = lu(k,1555) - lu(k,1163) * lu(k,1552) - lu(k,1556) = lu(k,1556) - lu(k,1164) * lu(k,1552) - lu(k,1557) = lu(k,1557) - lu(k,1165) * lu(k,1552) - lu(k,1558) = lu(k,1558) - lu(k,1166) * lu(k,1552) - lu(k,1559) = lu(k,1559) - lu(k,1167) * lu(k,1552) - lu(k,1560) = lu(k,1560) - lu(k,1168) * lu(k,1552) - lu(k,1561) = lu(k,1561) - lu(k,1169) * lu(k,1552) - lu(k,1562) = lu(k,1562) - lu(k,1170) * lu(k,1552) - lu(k,1563) = lu(k,1563) - lu(k,1171) * lu(k,1552) - lu(k,1564) = lu(k,1564) - lu(k,1172) * lu(k,1552) - lu(k,1565) = lu(k,1565) - lu(k,1173) * lu(k,1552) - lu(k,1566) = lu(k,1566) - lu(k,1174) * lu(k,1552) - lu(k,1567) = lu(k,1567) - lu(k,1175) * lu(k,1552) - lu(k,1568) = lu(k,1568) - lu(k,1176) * lu(k,1552) - lu(k,1595) = lu(k,1595) - lu(k,1161) * lu(k,1594) - lu(k,1596) = lu(k,1596) - lu(k,1162) * lu(k,1594) - lu(k,1597) = lu(k,1597) - lu(k,1163) * lu(k,1594) - lu(k,1598) = lu(k,1598) - lu(k,1164) * lu(k,1594) - lu(k,1599) = lu(k,1599) - lu(k,1165) * lu(k,1594) - lu(k,1600) = lu(k,1600) - lu(k,1166) * lu(k,1594) - lu(k,1601) = lu(k,1601) - lu(k,1167) * lu(k,1594) - lu(k,1602) = lu(k,1602) - lu(k,1168) * lu(k,1594) - lu(k,1603) = lu(k,1603) - lu(k,1169) * lu(k,1594) - lu(k,1604) = lu(k,1604) - lu(k,1170) * lu(k,1594) - lu(k,1605) = lu(k,1605) - lu(k,1171) * lu(k,1594) - lu(k,1606) = lu(k,1606) - lu(k,1172) * lu(k,1594) - lu(k,1607) = lu(k,1607) - lu(k,1173) * lu(k,1594) - lu(k,1608) = lu(k,1608) - lu(k,1174) * lu(k,1594) - lu(k,1609) = lu(k,1609) - lu(k,1175) * lu(k,1594) - lu(k,1610) = lu(k,1610) - lu(k,1176) * lu(k,1594) - lu(k,1627) = lu(k,1627) - lu(k,1161) * lu(k,1626) - lu(k,1628) = lu(k,1628) - lu(k,1162) * lu(k,1626) - lu(k,1629) = lu(k,1629) - lu(k,1163) * lu(k,1626) - lu(k,1630) = lu(k,1630) - lu(k,1164) * lu(k,1626) - lu(k,1631) = lu(k,1631) - lu(k,1165) * lu(k,1626) - lu(k,1632) = lu(k,1632) - lu(k,1166) * lu(k,1626) - lu(k,1633) = lu(k,1633) - lu(k,1167) * lu(k,1626) - lu(k,1634) = lu(k,1634) - lu(k,1168) * lu(k,1626) - lu(k,1635) = lu(k,1635) - lu(k,1169) * lu(k,1626) - lu(k,1636) = lu(k,1636) - lu(k,1170) * lu(k,1626) - lu(k,1637) = lu(k,1637) - lu(k,1171) * lu(k,1626) - lu(k,1638) = lu(k,1638) - lu(k,1172) * lu(k,1626) - lu(k,1639) = lu(k,1639) - lu(k,1173) * lu(k,1626) - lu(k,1640) = lu(k,1640) - lu(k,1174) * lu(k,1626) - lu(k,1641) = lu(k,1641) - lu(k,1175) * lu(k,1626) - lu(k,1642) = lu(k,1642) - lu(k,1176) * lu(k,1626) - lu(k,1662) = lu(k,1662) - lu(k,1161) * lu(k,1661) - lu(k,1663) = lu(k,1663) - lu(k,1162) * lu(k,1661) - lu(k,1664) = lu(k,1664) - lu(k,1163) * lu(k,1661) - lu(k,1665) = lu(k,1665) - lu(k,1164) * lu(k,1661) - lu(k,1666) = lu(k,1666) - lu(k,1165) * lu(k,1661) - lu(k,1667) = lu(k,1667) - lu(k,1166) * lu(k,1661) - lu(k,1668) = lu(k,1668) - lu(k,1167) * lu(k,1661) - lu(k,1669) = lu(k,1669) - lu(k,1168) * lu(k,1661) - lu(k,1670) = lu(k,1670) - lu(k,1169) * lu(k,1661) - lu(k,1671) = lu(k,1671) - lu(k,1170) * lu(k,1661) - lu(k,1672) = lu(k,1672) - lu(k,1171) * lu(k,1661) - lu(k,1673) = lu(k,1673) - lu(k,1172) * lu(k,1661) - lu(k,1674) = lu(k,1674) - lu(k,1173) * lu(k,1661) - lu(k,1675) = lu(k,1675) - lu(k,1174) * lu(k,1661) - lu(k,1676) = lu(k,1676) - lu(k,1175) * lu(k,1661) - lu(k,1677) = lu(k,1677) - lu(k,1176) * lu(k,1661) - lu(k,1704) = lu(k,1704) - lu(k,1161) * lu(k,1703) - lu(k,1705) = lu(k,1705) - lu(k,1162) * lu(k,1703) - lu(k,1706) = lu(k,1706) - lu(k,1163) * lu(k,1703) - lu(k,1707) = lu(k,1707) - lu(k,1164) * lu(k,1703) - lu(k,1708) = lu(k,1708) - lu(k,1165) * lu(k,1703) - lu(k,1709) = lu(k,1709) - lu(k,1166) * lu(k,1703) - lu(k,1710) = lu(k,1710) - lu(k,1167) * lu(k,1703) - lu(k,1711) = lu(k,1711) - lu(k,1168) * lu(k,1703) - lu(k,1712) = lu(k,1712) - lu(k,1169) * lu(k,1703) - lu(k,1713) = lu(k,1713) - lu(k,1170) * lu(k,1703) - lu(k,1714) = lu(k,1714) - lu(k,1171) * lu(k,1703) - lu(k,1715) = lu(k,1715) - lu(k,1172) * lu(k,1703) - lu(k,1716) = lu(k,1716) - lu(k,1173) * lu(k,1703) - lu(k,1717) = lu(k,1717) - lu(k,1174) * lu(k,1703) - lu(k,1718) = lu(k,1718) - lu(k,1175) * lu(k,1703) - lu(k,1719) = lu(k,1719) - lu(k,1176) * lu(k,1703) - lu(k,1748) = lu(k,1748) - lu(k,1161) * lu(k,1747) - lu(k,1749) = lu(k,1749) - lu(k,1162) * lu(k,1747) - lu(k,1750) = lu(k,1750) - lu(k,1163) * lu(k,1747) - lu(k,1751) = lu(k,1751) - lu(k,1164) * lu(k,1747) - lu(k,1752) = lu(k,1752) - lu(k,1165) * lu(k,1747) - lu(k,1753) = lu(k,1753) - lu(k,1166) * lu(k,1747) - lu(k,1754) = lu(k,1754) - lu(k,1167) * lu(k,1747) - lu(k,1755) = lu(k,1755) - lu(k,1168) * lu(k,1747) - lu(k,1756) = lu(k,1756) - lu(k,1169) * lu(k,1747) - lu(k,1757) = lu(k,1757) - lu(k,1170) * lu(k,1747) - lu(k,1758) = lu(k,1758) - lu(k,1171) * lu(k,1747) - lu(k,1759) = lu(k,1759) - lu(k,1172) * lu(k,1747) - lu(k,1760) = lu(k,1760) - lu(k,1173) * lu(k,1747) - lu(k,1761) = lu(k,1761) - lu(k,1174) * lu(k,1747) - lu(k,1762) = lu(k,1762) - lu(k,1175) * lu(k,1747) - lu(k,1763) = lu(k,1763) - lu(k,1176) * lu(k,1747) - lu(k,1783) = lu(k,1783) - lu(k,1161) * lu(k,1782) - lu(k,1784) = lu(k,1784) - lu(k,1162) * lu(k,1782) - lu(k,1785) = lu(k,1785) - lu(k,1163) * lu(k,1782) - lu(k,1786) = lu(k,1786) - lu(k,1164) * lu(k,1782) - lu(k,1787) = lu(k,1787) - lu(k,1165) * lu(k,1782) - lu(k,1788) = lu(k,1788) - lu(k,1166) * lu(k,1782) - lu(k,1789) = lu(k,1789) - lu(k,1167) * lu(k,1782) - lu(k,1790) = lu(k,1790) - lu(k,1168) * lu(k,1782) - lu(k,1791) = lu(k,1791) - lu(k,1169) * lu(k,1782) - lu(k,1792) = lu(k,1792) - lu(k,1170) * lu(k,1782) - lu(k,1793) = lu(k,1793) - lu(k,1171) * lu(k,1782) - lu(k,1794) = lu(k,1794) - lu(k,1172) * lu(k,1782) - lu(k,1795) = lu(k,1795) - lu(k,1173) * lu(k,1782) - lu(k,1796) = lu(k,1796) - lu(k,1174) * lu(k,1782) - lu(k,1797) = lu(k,1797) - lu(k,1175) * lu(k,1782) - lu(k,1798) = lu(k,1798) - lu(k,1176) * lu(k,1782) - lu(k,1841) = lu(k,1841) - lu(k,1161) * lu(k,1840) - lu(k,1842) = lu(k,1842) - lu(k,1162) * lu(k,1840) - lu(k,1843) = lu(k,1843) - lu(k,1163) * lu(k,1840) - lu(k,1844) = lu(k,1844) - lu(k,1164) * lu(k,1840) - lu(k,1845) = lu(k,1845) - lu(k,1165) * lu(k,1840) - lu(k,1846) = lu(k,1846) - lu(k,1166) * lu(k,1840) - lu(k,1847) = lu(k,1847) - lu(k,1167) * lu(k,1840) - lu(k,1848) = lu(k,1848) - lu(k,1168) * lu(k,1840) - lu(k,1849) = lu(k,1849) - lu(k,1169) * lu(k,1840) - lu(k,1850) = lu(k,1850) - lu(k,1170) * lu(k,1840) - lu(k,1851) = lu(k,1851) - lu(k,1171) * lu(k,1840) - lu(k,1852) = lu(k,1852) - lu(k,1172) * lu(k,1840) - lu(k,1853) = lu(k,1853) - lu(k,1173) * lu(k,1840) - lu(k,1854) = lu(k,1854) - lu(k,1174) * lu(k,1840) - lu(k,1855) = lu(k,1855) - lu(k,1175) * lu(k,1840) - lu(k,1856) = lu(k,1856) - lu(k,1176) * lu(k,1840) - lu(k,1202) = 1._r8 / lu(k,1202) - lu(k,1203) = lu(k,1203) * lu(k,1202) - lu(k,1204) = lu(k,1204) * lu(k,1202) - lu(k,1205) = lu(k,1205) * lu(k,1202) - lu(k,1206) = lu(k,1206) * lu(k,1202) - lu(k,1207) = lu(k,1207) * lu(k,1202) - lu(k,1208) = lu(k,1208) * lu(k,1202) - lu(k,1209) = lu(k,1209) * lu(k,1202) - lu(k,1210) = lu(k,1210) * lu(k,1202) - lu(k,1211) = lu(k,1211) * lu(k,1202) - lu(k,1212) = lu(k,1212) * lu(k,1202) - lu(k,1213) = lu(k,1213) * lu(k,1202) - lu(k,1214) = lu(k,1214) * lu(k,1202) - lu(k,1215) = lu(k,1215) * lu(k,1202) - lu(k,1216) = lu(k,1216) * lu(k,1202) - lu(k,1217) = lu(k,1217) * lu(k,1202) - lu(k,1252) = lu(k,1252) - lu(k,1203) * lu(k,1251) - lu(k,1253) = lu(k,1253) - lu(k,1204) * lu(k,1251) - lu(k,1254) = lu(k,1254) - lu(k,1205) * lu(k,1251) - lu(k,1255) = lu(k,1255) - lu(k,1206) * lu(k,1251) - lu(k,1256) = lu(k,1256) - lu(k,1207) * lu(k,1251) - lu(k,1257) = lu(k,1257) - lu(k,1208) * lu(k,1251) - lu(k,1258) = lu(k,1258) - lu(k,1209) * lu(k,1251) - lu(k,1259) = lu(k,1259) - lu(k,1210) * lu(k,1251) - lu(k,1260) = lu(k,1260) - lu(k,1211) * lu(k,1251) - lu(k,1261) = lu(k,1261) - lu(k,1212) * lu(k,1251) - lu(k,1262) = lu(k,1262) - lu(k,1213) * lu(k,1251) - lu(k,1263) = lu(k,1263) - lu(k,1214) * lu(k,1251) - lu(k,1264) = lu(k,1264) - lu(k,1215) * lu(k,1251) - lu(k,1265) = lu(k,1265) - lu(k,1216) * lu(k,1251) - lu(k,1266) = lu(k,1266) - lu(k,1217) * lu(k,1251) - lu(k,1291) = lu(k,1291) - lu(k,1203) * lu(k,1290) - lu(k,1292) = lu(k,1292) - lu(k,1204) * lu(k,1290) - lu(k,1293) = lu(k,1293) - lu(k,1205) * lu(k,1290) - lu(k,1294) = lu(k,1294) - lu(k,1206) * lu(k,1290) - lu(k,1295) = lu(k,1295) - lu(k,1207) * lu(k,1290) - lu(k,1296) = lu(k,1296) - lu(k,1208) * lu(k,1290) - lu(k,1297) = lu(k,1297) - lu(k,1209) * lu(k,1290) - lu(k,1298) = lu(k,1298) - lu(k,1210) * lu(k,1290) - lu(k,1299) = lu(k,1299) - lu(k,1211) * lu(k,1290) - lu(k,1300) = lu(k,1300) - lu(k,1212) * lu(k,1290) - lu(k,1301) = lu(k,1301) - lu(k,1213) * lu(k,1290) - lu(k,1302) = lu(k,1302) - lu(k,1214) * lu(k,1290) - lu(k,1303) = lu(k,1303) - lu(k,1215) * lu(k,1290) - lu(k,1304) = lu(k,1304) - lu(k,1216) * lu(k,1290) - lu(k,1305) = lu(k,1305) - lu(k,1217) * lu(k,1290) - lu(k,1326) = lu(k,1326) - lu(k,1203) * lu(k,1325) - lu(k,1327) = lu(k,1327) - lu(k,1204) * lu(k,1325) - lu(k,1328) = lu(k,1328) - lu(k,1205) * lu(k,1325) - lu(k,1329) = lu(k,1329) - lu(k,1206) * lu(k,1325) - lu(k,1330) = lu(k,1330) - lu(k,1207) * lu(k,1325) - lu(k,1331) = lu(k,1331) - lu(k,1208) * lu(k,1325) - lu(k,1332) = lu(k,1332) - lu(k,1209) * lu(k,1325) - lu(k,1333) = lu(k,1333) - lu(k,1210) * lu(k,1325) - lu(k,1334) = lu(k,1334) - lu(k,1211) * lu(k,1325) - lu(k,1335) = lu(k,1335) - lu(k,1212) * lu(k,1325) - lu(k,1336) = lu(k,1336) - lu(k,1213) * lu(k,1325) - lu(k,1337) = lu(k,1337) - lu(k,1214) * lu(k,1325) - lu(k,1338) = lu(k,1338) - lu(k,1215) * lu(k,1325) - lu(k,1339) = lu(k,1339) - lu(k,1216) * lu(k,1325) - lu(k,1340) = lu(k,1340) - lu(k,1217) * lu(k,1325) - lu(k,1370) = lu(k,1370) - lu(k,1203) * lu(k,1369) - lu(k,1371) = lu(k,1371) - lu(k,1204) * lu(k,1369) - lu(k,1372) = lu(k,1372) - lu(k,1205) * lu(k,1369) - lu(k,1373) = lu(k,1373) - lu(k,1206) * lu(k,1369) - lu(k,1374) = lu(k,1374) - lu(k,1207) * lu(k,1369) - lu(k,1375) = lu(k,1375) - lu(k,1208) * lu(k,1369) - lu(k,1376) = lu(k,1376) - lu(k,1209) * lu(k,1369) - lu(k,1377) = lu(k,1377) - lu(k,1210) * lu(k,1369) - lu(k,1378) = lu(k,1378) - lu(k,1211) * lu(k,1369) - lu(k,1379) = lu(k,1379) - lu(k,1212) * lu(k,1369) - lu(k,1380) = lu(k,1380) - lu(k,1213) * lu(k,1369) - lu(k,1381) = lu(k,1381) - lu(k,1214) * lu(k,1369) - lu(k,1382) = lu(k,1382) - lu(k,1215) * lu(k,1369) - lu(k,1383) = lu(k,1383) - lu(k,1216) * lu(k,1369) - lu(k,1384) = lu(k,1384) - lu(k,1217) * lu(k,1369) - lu(k,1429) = lu(k,1429) - lu(k,1203) * lu(k,1428) - lu(k,1430) = lu(k,1430) - lu(k,1204) * lu(k,1428) - lu(k,1431) = lu(k,1431) - lu(k,1205) * lu(k,1428) - lu(k,1432) = lu(k,1432) - lu(k,1206) * lu(k,1428) - lu(k,1433) = lu(k,1433) - lu(k,1207) * lu(k,1428) - lu(k,1434) = lu(k,1434) - lu(k,1208) * lu(k,1428) - lu(k,1435) = lu(k,1435) - lu(k,1209) * lu(k,1428) - lu(k,1436) = lu(k,1436) - lu(k,1210) * lu(k,1428) - lu(k,1437) = lu(k,1437) - lu(k,1211) * lu(k,1428) - lu(k,1438) = lu(k,1438) - lu(k,1212) * lu(k,1428) - lu(k,1439) = lu(k,1439) - lu(k,1213) * lu(k,1428) - lu(k,1440) = lu(k,1440) - lu(k,1214) * lu(k,1428) - lu(k,1441) = lu(k,1441) - lu(k,1215) * lu(k,1428) - lu(k,1442) = lu(k,1442) - lu(k,1216) * lu(k,1428) - lu(k,1443) = lu(k,1443) - lu(k,1217) * lu(k,1428) - lu(k,1471) = lu(k,1471) - lu(k,1203) * lu(k,1470) - lu(k,1472) = lu(k,1472) - lu(k,1204) * lu(k,1470) - lu(k,1473) = lu(k,1473) - lu(k,1205) * lu(k,1470) - lu(k,1474) = lu(k,1474) - lu(k,1206) * lu(k,1470) - lu(k,1475) = lu(k,1475) - lu(k,1207) * lu(k,1470) - lu(k,1476) = lu(k,1476) - lu(k,1208) * lu(k,1470) - lu(k,1477) = lu(k,1477) - lu(k,1209) * lu(k,1470) - lu(k,1478) = lu(k,1478) - lu(k,1210) * lu(k,1470) - lu(k,1479) = lu(k,1479) - lu(k,1211) * lu(k,1470) - lu(k,1480) = lu(k,1480) - lu(k,1212) * lu(k,1470) - lu(k,1481) = lu(k,1481) - lu(k,1213) * lu(k,1470) - lu(k,1482) = lu(k,1482) - lu(k,1214) * lu(k,1470) - lu(k,1483) = lu(k,1483) - lu(k,1215) * lu(k,1470) - lu(k,1484) = lu(k,1484) - lu(k,1216) * lu(k,1470) - lu(k,1485) = lu(k,1485) - lu(k,1217) * lu(k,1470) - lu(k,1512) = lu(k,1512) - lu(k,1203) * lu(k,1511) - lu(k,1513) = lu(k,1513) - lu(k,1204) * lu(k,1511) - lu(k,1514) = lu(k,1514) - lu(k,1205) * lu(k,1511) - lu(k,1515) = lu(k,1515) - lu(k,1206) * lu(k,1511) - lu(k,1516) = lu(k,1516) - lu(k,1207) * lu(k,1511) - lu(k,1517) = lu(k,1517) - lu(k,1208) * lu(k,1511) - lu(k,1518) = lu(k,1518) - lu(k,1209) * lu(k,1511) - lu(k,1519) = lu(k,1519) - lu(k,1210) * lu(k,1511) - lu(k,1520) = lu(k,1520) - lu(k,1211) * lu(k,1511) - lu(k,1521) = lu(k,1521) - lu(k,1212) * lu(k,1511) - lu(k,1522) = lu(k,1522) - lu(k,1213) * lu(k,1511) - lu(k,1523) = lu(k,1523) - lu(k,1214) * lu(k,1511) - lu(k,1524) = lu(k,1524) - lu(k,1215) * lu(k,1511) - lu(k,1525) = lu(k,1525) - lu(k,1216) * lu(k,1511) - lu(k,1526) = lu(k,1526) - lu(k,1217) * lu(k,1511) - lu(k,1554) = lu(k,1554) - lu(k,1203) * lu(k,1553) - lu(k,1555) = lu(k,1555) - lu(k,1204) * lu(k,1553) - lu(k,1556) = lu(k,1556) - lu(k,1205) * lu(k,1553) - lu(k,1557) = lu(k,1557) - lu(k,1206) * lu(k,1553) - lu(k,1558) = lu(k,1558) - lu(k,1207) * lu(k,1553) - lu(k,1559) = lu(k,1559) - lu(k,1208) * lu(k,1553) - lu(k,1560) = lu(k,1560) - lu(k,1209) * lu(k,1553) - lu(k,1561) = lu(k,1561) - lu(k,1210) * lu(k,1553) - lu(k,1562) = lu(k,1562) - lu(k,1211) * lu(k,1553) - lu(k,1563) = lu(k,1563) - lu(k,1212) * lu(k,1553) - lu(k,1564) = lu(k,1564) - lu(k,1213) * lu(k,1553) - lu(k,1565) = lu(k,1565) - lu(k,1214) * lu(k,1553) - lu(k,1566) = lu(k,1566) - lu(k,1215) * lu(k,1553) - lu(k,1567) = lu(k,1567) - lu(k,1216) * lu(k,1553) - lu(k,1568) = lu(k,1568) - lu(k,1217) * lu(k,1553) - lu(k,1596) = lu(k,1596) - lu(k,1203) * lu(k,1595) - lu(k,1597) = lu(k,1597) - lu(k,1204) * lu(k,1595) - lu(k,1598) = lu(k,1598) - lu(k,1205) * lu(k,1595) - lu(k,1599) = lu(k,1599) - lu(k,1206) * lu(k,1595) - lu(k,1600) = lu(k,1600) - lu(k,1207) * lu(k,1595) - lu(k,1601) = lu(k,1601) - lu(k,1208) * lu(k,1595) - lu(k,1602) = lu(k,1602) - lu(k,1209) * lu(k,1595) - lu(k,1603) = lu(k,1603) - lu(k,1210) * lu(k,1595) - lu(k,1604) = lu(k,1604) - lu(k,1211) * lu(k,1595) - lu(k,1605) = lu(k,1605) - lu(k,1212) * lu(k,1595) - lu(k,1606) = lu(k,1606) - lu(k,1213) * lu(k,1595) - lu(k,1607) = lu(k,1607) - lu(k,1214) * lu(k,1595) - lu(k,1608) = lu(k,1608) - lu(k,1215) * lu(k,1595) - lu(k,1609) = lu(k,1609) - lu(k,1216) * lu(k,1595) - lu(k,1610) = lu(k,1610) - lu(k,1217) * lu(k,1595) - lu(k,1628) = lu(k,1628) - lu(k,1203) * lu(k,1627) - lu(k,1629) = lu(k,1629) - lu(k,1204) * lu(k,1627) - lu(k,1630) = lu(k,1630) - lu(k,1205) * lu(k,1627) - lu(k,1631) = lu(k,1631) - lu(k,1206) * lu(k,1627) - lu(k,1632) = lu(k,1632) - lu(k,1207) * lu(k,1627) - lu(k,1633) = lu(k,1633) - lu(k,1208) * lu(k,1627) - lu(k,1634) = lu(k,1634) - lu(k,1209) * lu(k,1627) - lu(k,1635) = lu(k,1635) - lu(k,1210) * lu(k,1627) - lu(k,1636) = lu(k,1636) - lu(k,1211) * lu(k,1627) - lu(k,1637) = lu(k,1637) - lu(k,1212) * lu(k,1627) - lu(k,1638) = lu(k,1638) - lu(k,1213) * lu(k,1627) - lu(k,1639) = lu(k,1639) - lu(k,1214) * lu(k,1627) - lu(k,1640) = lu(k,1640) - lu(k,1215) * lu(k,1627) - lu(k,1641) = lu(k,1641) - lu(k,1216) * lu(k,1627) - lu(k,1642) = lu(k,1642) - lu(k,1217) * lu(k,1627) - lu(k,1663) = lu(k,1663) - lu(k,1203) * lu(k,1662) - lu(k,1664) = lu(k,1664) - lu(k,1204) * lu(k,1662) - lu(k,1665) = lu(k,1665) - lu(k,1205) * lu(k,1662) - lu(k,1666) = lu(k,1666) - lu(k,1206) * lu(k,1662) - lu(k,1667) = lu(k,1667) - lu(k,1207) * lu(k,1662) - lu(k,1668) = lu(k,1668) - lu(k,1208) * lu(k,1662) - lu(k,1669) = lu(k,1669) - lu(k,1209) * lu(k,1662) - lu(k,1670) = lu(k,1670) - lu(k,1210) * lu(k,1662) - lu(k,1671) = lu(k,1671) - lu(k,1211) * lu(k,1662) - lu(k,1672) = lu(k,1672) - lu(k,1212) * lu(k,1662) - lu(k,1673) = lu(k,1673) - lu(k,1213) * lu(k,1662) - lu(k,1674) = lu(k,1674) - lu(k,1214) * lu(k,1662) - lu(k,1675) = lu(k,1675) - lu(k,1215) * lu(k,1662) - lu(k,1676) = lu(k,1676) - lu(k,1216) * lu(k,1662) - lu(k,1677) = lu(k,1677) - lu(k,1217) * lu(k,1662) - lu(k,1705) = lu(k,1705) - lu(k,1203) * lu(k,1704) - lu(k,1706) = lu(k,1706) - lu(k,1204) * lu(k,1704) - lu(k,1707) = lu(k,1707) - lu(k,1205) * lu(k,1704) - lu(k,1708) = lu(k,1708) - lu(k,1206) * lu(k,1704) - lu(k,1709) = lu(k,1709) - lu(k,1207) * lu(k,1704) - lu(k,1710) = lu(k,1710) - lu(k,1208) * lu(k,1704) - lu(k,1711) = lu(k,1711) - lu(k,1209) * lu(k,1704) - lu(k,1712) = lu(k,1712) - lu(k,1210) * lu(k,1704) - lu(k,1713) = lu(k,1713) - lu(k,1211) * lu(k,1704) - lu(k,1714) = lu(k,1714) - lu(k,1212) * lu(k,1704) - lu(k,1715) = lu(k,1715) - lu(k,1213) * lu(k,1704) - lu(k,1716) = lu(k,1716) - lu(k,1214) * lu(k,1704) - lu(k,1717) = lu(k,1717) - lu(k,1215) * lu(k,1704) - lu(k,1718) = lu(k,1718) - lu(k,1216) * lu(k,1704) - lu(k,1719) = lu(k,1719) - lu(k,1217) * lu(k,1704) - lu(k,1749) = lu(k,1749) - lu(k,1203) * lu(k,1748) - lu(k,1750) = lu(k,1750) - lu(k,1204) * lu(k,1748) - lu(k,1751) = lu(k,1751) - lu(k,1205) * lu(k,1748) - lu(k,1752) = lu(k,1752) - lu(k,1206) * lu(k,1748) - lu(k,1753) = lu(k,1753) - lu(k,1207) * lu(k,1748) - lu(k,1754) = lu(k,1754) - lu(k,1208) * lu(k,1748) - lu(k,1755) = lu(k,1755) - lu(k,1209) * lu(k,1748) - lu(k,1756) = lu(k,1756) - lu(k,1210) * lu(k,1748) - lu(k,1757) = lu(k,1757) - lu(k,1211) * lu(k,1748) - lu(k,1758) = lu(k,1758) - lu(k,1212) * lu(k,1748) - lu(k,1759) = lu(k,1759) - lu(k,1213) * lu(k,1748) - lu(k,1760) = lu(k,1760) - lu(k,1214) * lu(k,1748) - lu(k,1761) = lu(k,1761) - lu(k,1215) * lu(k,1748) - lu(k,1762) = lu(k,1762) - lu(k,1216) * lu(k,1748) - lu(k,1763) = lu(k,1763) - lu(k,1217) * lu(k,1748) - lu(k,1784) = lu(k,1784) - lu(k,1203) * lu(k,1783) - lu(k,1785) = lu(k,1785) - lu(k,1204) * lu(k,1783) - lu(k,1786) = lu(k,1786) - lu(k,1205) * lu(k,1783) - lu(k,1787) = lu(k,1787) - lu(k,1206) * lu(k,1783) - lu(k,1788) = lu(k,1788) - lu(k,1207) * lu(k,1783) - lu(k,1789) = lu(k,1789) - lu(k,1208) * lu(k,1783) - lu(k,1790) = lu(k,1790) - lu(k,1209) * lu(k,1783) - lu(k,1791) = lu(k,1791) - lu(k,1210) * lu(k,1783) - lu(k,1792) = lu(k,1792) - lu(k,1211) * lu(k,1783) - lu(k,1793) = lu(k,1793) - lu(k,1212) * lu(k,1783) - lu(k,1794) = lu(k,1794) - lu(k,1213) * lu(k,1783) - lu(k,1795) = lu(k,1795) - lu(k,1214) * lu(k,1783) - lu(k,1796) = lu(k,1796) - lu(k,1215) * lu(k,1783) - lu(k,1797) = lu(k,1797) - lu(k,1216) * lu(k,1783) - lu(k,1798) = lu(k,1798) - lu(k,1217) * lu(k,1783) - lu(k,1842) = lu(k,1842) - lu(k,1203) * lu(k,1841) - lu(k,1843) = lu(k,1843) - lu(k,1204) * lu(k,1841) - lu(k,1844) = lu(k,1844) - lu(k,1205) * lu(k,1841) - lu(k,1845) = lu(k,1845) - lu(k,1206) * lu(k,1841) - lu(k,1846) = lu(k,1846) - lu(k,1207) * lu(k,1841) - lu(k,1847) = lu(k,1847) - lu(k,1208) * lu(k,1841) - lu(k,1848) = lu(k,1848) - lu(k,1209) * lu(k,1841) - lu(k,1849) = lu(k,1849) - lu(k,1210) * lu(k,1841) - lu(k,1850) = lu(k,1850) - lu(k,1211) * lu(k,1841) - lu(k,1851) = lu(k,1851) - lu(k,1212) * lu(k,1841) - lu(k,1852) = lu(k,1852) - lu(k,1213) * lu(k,1841) - lu(k,1853) = lu(k,1853) - lu(k,1214) * lu(k,1841) - lu(k,1854) = lu(k,1854) - lu(k,1215) * lu(k,1841) - lu(k,1855) = lu(k,1855) - lu(k,1216) * lu(k,1841) - lu(k,1856) = lu(k,1856) - lu(k,1217) * lu(k,1841) + lu(k,981) = 1._r8 / lu(k,981) + lu(k,982) = lu(k,982) * lu(k,981) + lu(k,983) = lu(k,983) * lu(k,981) + lu(k,984) = lu(k,984) * lu(k,981) + lu(k,985) = lu(k,985) * lu(k,981) + lu(k,986) = lu(k,986) * lu(k,981) + lu(k,987) = lu(k,987) * lu(k,981) + lu(k,988) = lu(k,988) * lu(k,981) + lu(k,989) = lu(k,989) * lu(k,981) + lu(k,990) = lu(k,990) * lu(k,981) + lu(k,991) = lu(k,991) * lu(k,981) + lu(k,992) = lu(k,992) * lu(k,981) + lu(k,993) = lu(k,993) * lu(k,981) + lu(k,994) = lu(k,994) * lu(k,981) + lu(k,995) = lu(k,995) * lu(k,981) + lu(k,996) = lu(k,996) * lu(k,981) + lu(k,997) = lu(k,997) * lu(k,981) + lu(k,998) = lu(k,998) * lu(k,981) + lu(k,999) = lu(k,999) * lu(k,981) + lu(k,1000) = lu(k,1000) * lu(k,981) + lu(k,1001) = lu(k,1001) * lu(k,981) + lu(k,1002) = lu(k,1002) * lu(k,981) + lu(k,1012) = lu(k,1012) - lu(k,982) * lu(k,1010) + lu(k,1013) = lu(k,1013) - lu(k,983) * lu(k,1010) + lu(k,1014) = lu(k,1014) - lu(k,984) * lu(k,1010) + lu(k,1016) = lu(k,1016) - lu(k,985) * lu(k,1010) + lu(k,1017) = lu(k,1017) - lu(k,986) * lu(k,1010) + lu(k,1018) = lu(k,1018) - lu(k,987) * lu(k,1010) + lu(k,1019) = lu(k,1019) - lu(k,988) * lu(k,1010) + lu(k,1021) = lu(k,1021) - lu(k,989) * lu(k,1010) + lu(k,1022) = lu(k,1022) - lu(k,990) * lu(k,1010) + lu(k,1023) = lu(k,1023) - lu(k,991) * lu(k,1010) + lu(k,1024) = lu(k,1024) - lu(k,992) * lu(k,1010) + lu(k,1025) = lu(k,1025) - lu(k,993) * lu(k,1010) + lu(k,1027) = lu(k,1027) - lu(k,994) * lu(k,1010) + lu(k,1028) = lu(k,1028) - lu(k,995) * lu(k,1010) + lu(k,1029) = lu(k,1029) - lu(k,996) * lu(k,1010) + lu(k,1030) = lu(k,1030) - lu(k,997) * lu(k,1010) + lu(k,1031) = lu(k,1031) - lu(k,998) * lu(k,1010) + lu(k,1032) = lu(k,1032) - lu(k,999) * lu(k,1010) + lu(k,1033) = lu(k,1033) - lu(k,1000) * lu(k,1010) + lu(k,1034) = lu(k,1034) - lu(k,1001) * lu(k,1010) + lu(k,1035) = lu(k,1035) - lu(k,1002) * lu(k,1010) + lu(k,1055) = lu(k,1055) - lu(k,982) * lu(k,1054) + lu(k,1056) = lu(k,1056) - lu(k,983) * lu(k,1054) + lu(k,1057) = lu(k,1057) - lu(k,984) * lu(k,1054) + lu(k,1059) = lu(k,1059) - lu(k,985) * lu(k,1054) + lu(k,1060) = lu(k,1060) - lu(k,986) * lu(k,1054) + lu(k,1061) = lu(k,1061) - lu(k,987) * lu(k,1054) + lu(k,1062) = lu(k,1062) - lu(k,988) * lu(k,1054) + lu(k,1064) = lu(k,1064) - lu(k,989) * lu(k,1054) + lu(k,1065) = lu(k,1065) - lu(k,990) * lu(k,1054) + lu(k,1066) = lu(k,1066) - lu(k,991) * lu(k,1054) + lu(k,1067) = lu(k,1067) - lu(k,992) * lu(k,1054) + lu(k,1068) = lu(k,1068) - lu(k,993) * lu(k,1054) + lu(k,1070) = lu(k,1070) - lu(k,994) * lu(k,1054) + lu(k,1071) = lu(k,1071) - lu(k,995) * lu(k,1054) + lu(k,1072) = lu(k,1072) - lu(k,996) * lu(k,1054) + lu(k,1073) = lu(k,1073) - lu(k,997) * lu(k,1054) + lu(k,1074) = lu(k,1074) - lu(k,998) * lu(k,1054) + lu(k,1075) = lu(k,1075) - lu(k,999) * lu(k,1054) + lu(k,1076) = lu(k,1076) - lu(k,1000) * lu(k,1054) + lu(k,1077) = lu(k,1077) - lu(k,1001) * lu(k,1054) + lu(k,1078) = lu(k,1078) - lu(k,1002) * lu(k,1054) + lu(k,1095) = lu(k,1095) - lu(k,982) * lu(k,1094) + lu(k,1096) = lu(k,1096) - lu(k,983) * lu(k,1094) + lu(k,1097) = lu(k,1097) - lu(k,984) * lu(k,1094) + lu(k,1099) = lu(k,1099) - lu(k,985) * lu(k,1094) + lu(k,1100) = lu(k,1100) - lu(k,986) * lu(k,1094) + lu(k,1101) = lu(k,1101) - lu(k,987) * lu(k,1094) + lu(k,1102) = lu(k,1102) - lu(k,988) * lu(k,1094) + lu(k,1104) = lu(k,1104) - lu(k,989) * lu(k,1094) + lu(k,1105) = lu(k,1105) - lu(k,990) * lu(k,1094) + lu(k,1106) = lu(k,1106) - lu(k,991) * lu(k,1094) + lu(k,1107) = lu(k,1107) - lu(k,992) * lu(k,1094) + lu(k,1108) = lu(k,1108) - lu(k,993) * lu(k,1094) + lu(k,1110) = lu(k,1110) - lu(k,994) * lu(k,1094) + lu(k,1111) = lu(k,1111) - lu(k,995) * lu(k,1094) + lu(k,1112) = lu(k,1112) - lu(k,996) * lu(k,1094) + lu(k,1113) = lu(k,1113) - lu(k,997) * lu(k,1094) + lu(k,1114) = lu(k,1114) - lu(k,998) * lu(k,1094) + lu(k,1115) = lu(k,1115) - lu(k,999) * lu(k,1094) + lu(k,1116) = lu(k,1116) - lu(k,1000) * lu(k,1094) + lu(k,1117) = lu(k,1117) - lu(k,1001) * lu(k,1094) + lu(k,1118) = lu(k,1118) - lu(k,1002) * lu(k,1094) + lu(k,1143) = lu(k,1143) - lu(k,982) * lu(k,1141) + lu(k,1144) = lu(k,1144) - lu(k,983) * lu(k,1141) + lu(k,1145) = lu(k,1145) - lu(k,984) * lu(k,1141) + lu(k,1147) = lu(k,1147) - lu(k,985) * lu(k,1141) + lu(k,1148) = lu(k,1148) - lu(k,986) * lu(k,1141) + lu(k,1149) = lu(k,1149) - lu(k,987) * lu(k,1141) + lu(k,1150) = lu(k,1150) - lu(k,988) * lu(k,1141) + lu(k,1152) = lu(k,1152) - lu(k,989) * lu(k,1141) + lu(k,1153) = lu(k,1153) - lu(k,990) * lu(k,1141) + lu(k,1154) = lu(k,1154) - lu(k,991) * lu(k,1141) + lu(k,1155) = lu(k,1155) - lu(k,992) * lu(k,1141) + lu(k,1156) = lu(k,1156) - lu(k,993) * lu(k,1141) + lu(k,1158) = lu(k,1158) - lu(k,994) * lu(k,1141) + lu(k,1159) = lu(k,1159) - lu(k,995) * lu(k,1141) + lu(k,1160) = lu(k,1160) - lu(k,996) * lu(k,1141) + lu(k,1161) = lu(k,1161) - lu(k,997) * lu(k,1141) + lu(k,1162) = lu(k,1162) - lu(k,998) * lu(k,1141) + lu(k,1163) = lu(k,1163) - lu(k,999) * lu(k,1141) + lu(k,1164) = lu(k,1164) - lu(k,1000) * lu(k,1141) + lu(k,1165) = lu(k,1165) - lu(k,1001) * lu(k,1141) + lu(k,1166) = lu(k,1166) - lu(k,1002) * lu(k,1141) + lu(k,1186) = lu(k,1186) - lu(k,982) * lu(k,1184) + lu(k,1187) = lu(k,1187) - lu(k,983) * lu(k,1184) + lu(k,1188) = lu(k,1188) - lu(k,984) * lu(k,1184) + lu(k,1190) = lu(k,1190) - lu(k,985) * lu(k,1184) + lu(k,1191) = lu(k,1191) - lu(k,986) * lu(k,1184) + lu(k,1192) = lu(k,1192) - lu(k,987) * lu(k,1184) + lu(k,1193) = lu(k,1193) - lu(k,988) * lu(k,1184) + lu(k,1195) = lu(k,1195) - lu(k,989) * lu(k,1184) + lu(k,1196) = lu(k,1196) - lu(k,990) * lu(k,1184) + lu(k,1197) = lu(k,1197) - lu(k,991) * lu(k,1184) + lu(k,1198) = lu(k,1198) - lu(k,992) * lu(k,1184) + lu(k,1199) = lu(k,1199) - lu(k,993) * lu(k,1184) + lu(k,1201) = lu(k,1201) - lu(k,994) * lu(k,1184) + lu(k,1202) = lu(k,1202) - lu(k,995) * lu(k,1184) + lu(k,1203) = lu(k,1203) - lu(k,996) * lu(k,1184) + lu(k,1204) = lu(k,1204) - lu(k,997) * lu(k,1184) + lu(k,1205) = lu(k,1205) - lu(k,998) * lu(k,1184) + lu(k,1206) = lu(k,1206) - lu(k,999) * lu(k,1184) + lu(k,1207) = lu(k,1207) - lu(k,1000) * lu(k,1184) + lu(k,1208) = lu(k,1208) - lu(k,1001) * lu(k,1184) + lu(k,1209) = lu(k,1209) - lu(k,1002) * lu(k,1184) + lu(k,1227) = lu(k,1227) - lu(k,982) * lu(k,1225) + lu(k,1228) = lu(k,1228) - lu(k,983) * lu(k,1225) + lu(k,1229) = lu(k,1229) - lu(k,984) * lu(k,1225) + lu(k,1231) = lu(k,1231) - lu(k,985) * lu(k,1225) + lu(k,1232) = lu(k,1232) - lu(k,986) * lu(k,1225) + lu(k,1233) = lu(k,1233) - lu(k,987) * lu(k,1225) + lu(k,1234) = lu(k,1234) - lu(k,988) * lu(k,1225) + lu(k,1236) = lu(k,1236) - lu(k,989) * lu(k,1225) + lu(k,1237) = lu(k,1237) - lu(k,990) * lu(k,1225) + lu(k,1238) = lu(k,1238) - lu(k,991) * lu(k,1225) + lu(k,1239) = lu(k,1239) - lu(k,992) * lu(k,1225) + lu(k,1240) = lu(k,1240) - lu(k,993) * lu(k,1225) + lu(k,1242) = lu(k,1242) - lu(k,994) * lu(k,1225) + lu(k,1243) = lu(k,1243) - lu(k,995) * lu(k,1225) + lu(k,1244) = lu(k,1244) - lu(k,996) * lu(k,1225) + lu(k,1245) = lu(k,1245) - lu(k,997) * lu(k,1225) + lu(k,1246) = lu(k,1246) - lu(k,998) * lu(k,1225) + lu(k,1247) = lu(k,1247) - lu(k,999) * lu(k,1225) + lu(k,1248) = lu(k,1248) - lu(k,1000) * lu(k,1225) + lu(k,1249) = lu(k,1249) - lu(k,1001) * lu(k,1225) + lu(k,1250) = lu(k,1250) - lu(k,1002) * lu(k,1225) + lu(k,1287) = lu(k,1287) - lu(k,982) * lu(k,1285) + lu(k,1288) = lu(k,1288) - lu(k,983) * lu(k,1285) + lu(k,1289) = lu(k,1289) - lu(k,984) * lu(k,1285) + lu(k,1291) = lu(k,1291) - lu(k,985) * lu(k,1285) + lu(k,1292) = lu(k,1292) - lu(k,986) * lu(k,1285) + lu(k,1293) = lu(k,1293) - lu(k,987) * lu(k,1285) + lu(k,1294) = lu(k,1294) - lu(k,988) * lu(k,1285) + lu(k,1296) = lu(k,1296) - lu(k,989) * lu(k,1285) + lu(k,1297) = lu(k,1297) - lu(k,990) * lu(k,1285) + lu(k,1298) = lu(k,1298) - lu(k,991) * lu(k,1285) + lu(k,1299) = lu(k,1299) - lu(k,992) * lu(k,1285) + lu(k,1300) = lu(k,1300) - lu(k,993) * lu(k,1285) + lu(k,1302) = lu(k,1302) - lu(k,994) * lu(k,1285) + lu(k,1303) = lu(k,1303) - lu(k,995) * lu(k,1285) + lu(k,1304) = lu(k,1304) - lu(k,996) * lu(k,1285) + lu(k,1305) = lu(k,1305) - lu(k,997) * lu(k,1285) + lu(k,1306) = lu(k,1306) - lu(k,998) * lu(k,1285) + lu(k,1307) = lu(k,1307) - lu(k,999) * lu(k,1285) + lu(k,1308) = lu(k,1308) - lu(k,1000) * lu(k,1285) + lu(k,1309) = lu(k,1309) - lu(k,1001) * lu(k,1285) + lu(k,1310) = lu(k,1310) - lu(k,1002) * lu(k,1285) + lu(k,1329) = lu(k,1329) - lu(k,982) * lu(k,1327) + lu(k,1330) = lu(k,1330) - lu(k,983) * lu(k,1327) + lu(k,1331) = lu(k,1331) - lu(k,984) * lu(k,1327) + lu(k,1333) = lu(k,1333) - lu(k,985) * lu(k,1327) + lu(k,1334) = lu(k,1334) - lu(k,986) * lu(k,1327) + lu(k,1335) = lu(k,1335) - lu(k,987) * lu(k,1327) + lu(k,1336) = lu(k,1336) - lu(k,988) * lu(k,1327) + lu(k,1338) = lu(k,1338) - lu(k,989) * lu(k,1327) + lu(k,1339) = lu(k,1339) - lu(k,990) * lu(k,1327) + lu(k,1340) = lu(k,1340) - lu(k,991) * lu(k,1327) + lu(k,1341) = lu(k,1341) - lu(k,992) * lu(k,1327) + lu(k,1342) = lu(k,1342) - lu(k,993) * lu(k,1327) + lu(k,1344) = lu(k,1344) - lu(k,994) * lu(k,1327) + lu(k,1345) = lu(k,1345) - lu(k,995) * lu(k,1327) + lu(k,1346) = lu(k,1346) - lu(k,996) * lu(k,1327) + lu(k,1347) = lu(k,1347) - lu(k,997) * lu(k,1327) + lu(k,1348) = lu(k,1348) - lu(k,998) * lu(k,1327) + lu(k,1349) = lu(k,1349) - lu(k,999) * lu(k,1327) + lu(k,1350) = lu(k,1350) - lu(k,1000) * lu(k,1327) + lu(k,1351) = lu(k,1351) - lu(k,1001) * lu(k,1327) + lu(k,1352) = lu(k,1352) - lu(k,1002) * lu(k,1327) + lu(k,1365) = lu(k,1365) - lu(k,982) * lu(k,1363) + lu(k,1366) = lu(k,1366) - lu(k,983) * lu(k,1363) + lu(k,1367) = lu(k,1367) - lu(k,984) * lu(k,1363) + lu(k,1369) = lu(k,1369) - lu(k,985) * lu(k,1363) + lu(k,1370) = lu(k,1370) - lu(k,986) * lu(k,1363) + lu(k,1371) = lu(k,1371) - lu(k,987) * lu(k,1363) + lu(k,1372) = lu(k,1372) - lu(k,988) * lu(k,1363) + lu(k,1374) = lu(k,1374) - lu(k,989) * lu(k,1363) + lu(k,1375) = lu(k,1375) - lu(k,990) * lu(k,1363) + lu(k,1376) = lu(k,1376) - lu(k,991) * lu(k,1363) + lu(k,1377) = lu(k,1377) - lu(k,992) * lu(k,1363) + lu(k,1378) = lu(k,1378) - lu(k,993) * lu(k,1363) + lu(k,1380) = lu(k,1380) - lu(k,994) * lu(k,1363) + lu(k,1381) = lu(k,1381) - lu(k,995) * lu(k,1363) + lu(k,1382) = lu(k,1382) - lu(k,996) * lu(k,1363) + lu(k,1383) = lu(k,1383) - lu(k,997) * lu(k,1363) + lu(k,1384) = lu(k,1384) - lu(k,998) * lu(k,1363) + lu(k,1385) = lu(k,1385) - lu(k,999) * lu(k,1363) + lu(k,1386) = lu(k,1386) - lu(k,1000) * lu(k,1363) + lu(k,1387) = lu(k,1387) - lu(k,1001) * lu(k,1363) + lu(k,1388) = lu(k,1388) - lu(k,1002) * lu(k,1363) + lu(k,1408) = lu(k,1408) - lu(k,982) * lu(k,1406) + lu(k,1409) = lu(k,1409) - lu(k,983) * lu(k,1406) + lu(k,1410) = lu(k,1410) - lu(k,984) * lu(k,1406) + lu(k,1412) = lu(k,1412) - lu(k,985) * lu(k,1406) + lu(k,1413) = lu(k,1413) - lu(k,986) * lu(k,1406) + lu(k,1414) = lu(k,1414) - lu(k,987) * lu(k,1406) + lu(k,1415) = lu(k,1415) - lu(k,988) * lu(k,1406) + lu(k,1417) = lu(k,1417) - lu(k,989) * lu(k,1406) + lu(k,1418) = lu(k,1418) - lu(k,990) * lu(k,1406) + lu(k,1419) = lu(k,1419) - lu(k,991) * lu(k,1406) + lu(k,1420) = lu(k,1420) - lu(k,992) * lu(k,1406) + lu(k,1421) = lu(k,1421) - lu(k,993) * lu(k,1406) + lu(k,1423) = lu(k,1423) - lu(k,994) * lu(k,1406) + lu(k,1424) = lu(k,1424) - lu(k,995) * lu(k,1406) + lu(k,1425) = lu(k,1425) - lu(k,996) * lu(k,1406) + lu(k,1426) = lu(k,1426) - lu(k,997) * lu(k,1406) + lu(k,1427) = lu(k,1427) - lu(k,998) * lu(k,1406) + lu(k,1428) = lu(k,1428) - lu(k,999) * lu(k,1406) + lu(k,1429) = lu(k,1429) - lu(k,1000) * lu(k,1406) + lu(k,1430) = lu(k,1430) - lu(k,1001) * lu(k,1406) + lu(k,1431) = lu(k,1431) - lu(k,1002) * lu(k,1406) + lu(k,1451) = lu(k,1451) - lu(k,982) * lu(k,1449) + lu(k,1452) = lu(k,1452) - lu(k,983) * lu(k,1449) + lu(k,1453) = lu(k,1453) - lu(k,984) * lu(k,1449) + lu(k,1455) = lu(k,1455) - lu(k,985) * lu(k,1449) + lu(k,1456) = lu(k,1456) - lu(k,986) * lu(k,1449) + lu(k,1457) = lu(k,1457) - lu(k,987) * lu(k,1449) + lu(k,1458) = lu(k,1458) - lu(k,988) * lu(k,1449) + lu(k,1460) = lu(k,1460) - lu(k,989) * lu(k,1449) + lu(k,1461) = lu(k,1461) - lu(k,990) * lu(k,1449) + lu(k,1462) = lu(k,1462) - lu(k,991) * lu(k,1449) + lu(k,1463) = lu(k,1463) - lu(k,992) * lu(k,1449) + lu(k,1464) = lu(k,1464) - lu(k,993) * lu(k,1449) + lu(k,1466) = lu(k,1466) - lu(k,994) * lu(k,1449) + lu(k,1467) = lu(k,1467) - lu(k,995) * lu(k,1449) + lu(k,1468) = lu(k,1468) - lu(k,996) * lu(k,1449) + lu(k,1469) = lu(k,1469) - lu(k,997) * lu(k,1449) + lu(k,1470) = lu(k,1470) - lu(k,998) * lu(k,1449) + lu(k,1471) = lu(k,1471) - lu(k,999) * lu(k,1449) + lu(k,1472) = lu(k,1472) - lu(k,1000) * lu(k,1449) + lu(k,1473) = lu(k,1473) - lu(k,1001) * lu(k,1449) + lu(k,1474) = lu(k,1474) - lu(k,1002) * lu(k,1449) + lu(k,1496) = lu(k,1496) - lu(k,982) * lu(k,1494) + lu(k,1497) = lu(k,1497) - lu(k,983) * lu(k,1494) + lu(k,1498) = lu(k,1498) - lu(k,984) * lu(k,1494) + lu(k,1500) = lu(k,1500) - lu(k,985) * lu(k,1494) + lu(k,1501) = lu(k,1501) - lu(k,986) * lu(k,1494) + lu(k,1502) = lu(k,1502) - lu(k,987) * lu(k,1494) + lu(k,1503) = lu(k,1503) - lu(k,988) * lu(k,1494) + lu(k,1505) = lu(k,1505) - lu(k,989) * lu(k,1494) + lu(k,1506) = lu(k,1506) - lu(k,990) * lu(k,1494) + lu(k,1507) = lu(k,1507) - lu(k,991) * lu(k,1494) + lu(k,1508) = lu(k,1508) - lu(k,992) * lu(k,1494) + lu(k,1509) = lu(k,1509) - lu(k,993) * lu(k,1494) + lu(k,1511) = lu(k,1511) - lu(k,994) * lu(k,1494) + lu(k,1512) = lu(k,1512) - lu(k,995) * lu(k,1494) + lu(k,1513) = lu(k,1513) - lu(k,996) * lu(k,1494) + lu(k,1514) = lu(k,1514) - lu(k,997) * lu(k,1494) + lu(k,1515) = lu(k,1515) - lu(k,998) * lu(k,1494) + lu(k,1516) = lu(k,1516) - lu(k,999) * lu(k,1494) + lu(k,1517) = lu(k,1517) - lu(k,1000) * lu(k,1494) + lu(k,1518) = lu(k,1518) - lu(k,1001) * lu(k,1494) + lu(k,1519) = lu(k,1519) - lu(k,1002) * lu(k,1494) + lu(k,1532) = lu(k,1532) - lu(k,982) * lu(k,1530) + lu(k,1533) = lu(k,1533) - lu(k,983) * lu(k,1530) + lu(k,1534) = lu(k,1534) - lu(k,984) * lu(k,1530) + lu(k,1536) = lu(k,1536) - lu(k,985) * lu(k,1530) + lu(k,1537) = lu(k,1537) - lu(k,986) * lu(k,1530) + lu(k,1538) = lu(k,1538) - lu(k,987) * lu(k,1530) + lu(k,1539) = lu(k,1539) - lu(k,988) * lu(k,1530) + lu(k,1541) = lu(k,1541) - lu(k,989) * lu(k,1530) + lu(k,1542) = lu(k,1542) - lu(k,990) * lu(k,1530) + lu(k,1543) = lu(k,1543) - lu(k,991) * lu(k,1530) + lu(k,1544) = lu(k,1544) - lu(k,992) * lu(k,1530) + lu(k,1545) = lu(k,1545) - lu(k,993) * lu(k,1530) + lu(k,1547) = lu(k,1547) - lu(k,994) * lu(k,1530) + lu(k,1548) = lu(k,1548) - lu(k,995) * lu(k,1530) + lu(k,1549) = lu(k,1549) - lu(k,996) * lu(k,1530) + lu(k,1550) = lu(k,1550) - lu(k,997) * lu(k,1530) + lu(k,1551) = lu(k,1551) - lu(k,998) * lu(k,1530) + lu(k,1552) = lu(k,1552) - lu(k,999) * lu(k,1530) + lu(k,1553) = lu(k,1553) - lu(k,1000) * lu(k,1530) + lu(k,1554) = lu(k,1554) - lu(k,1001) * lu(k,1530) + lu(k,1555) = lu(k,1555) - lu(k,1002) * lu(k,1530) + lu(k,1577) = lu(k,1577) - lu(k,982) * lu(k,1575) + lu(k,1578) = lu(k,1578) - lu(k,983) * lu(k,1575) + lu(k,1579) = lu(k,1579) - lu(k,984) * lu(k,1575) + lu(k,1581) = lu(k,1581) - lu(k,985) * lu(k,1575) + lu(k,1582) = lu(k,1582) - lu(k,986) * lu(k,1575) + lu(k,1583) = lu(k,1583) - lu(k,987) * lu(k,1575) + lu(k,1584) = lu(k,1584) - lu(k,988) * lu(k,1575) + lu(k,1586) = lu(k,1586) - lu(k,989) * lu(k,1575) + lu(k,1587) = lu(k,1587) - lu(k,990) * lu(k,1575) + lu(k,1588) = lu(k,1588) - lu(k,991) * lu(k,1575) + lu(k,1589) = lu(k,1589) - lu(k,992) * lu(k,1575) + lu(k,1590) = lu(k,1590) - lu(k,993) * lu(k,1575) + lu(k,1592) = lu(k,1592) - lu(k,994) * lu(k,1575) + lu(k,1593) = lu(k,1593) - lu(k,995) * lu(k,1575) + lu(k,1594) = lu(k,1594) - lu(k,996) * lu(k,1575) + lu(k,1595) = lu(k,1595) - lu(k,997) * lu(k,1575) + lu(k,1596) = lu(k,1596) - lu(k,998) * lu(k,1575) + lu(k,1597) = lu(k,1597) - lu(k,999) * lu(k,1575) + lu(k,1598) = lu(k,1598) - lu(k,1000) * lu(k,1575) + lu(k,1599) = lu(k,1599) - lu(k,1001) * lu(k,1575) + lu(k,1600) = lu(k,1600) - lu(k,1002) * lu(k,1575) + lu(k,1625) = lu(k,1625) - lu(k,982) * lu(k,1623) + lu(k,1626) = lu(k,1626) - lu(k,983) * lu(k,1623) + lu(k,1627) = lu(k,1627) - lu(k,984) * lu(k,1623) + lu(k,1629) = lu(k,1629) - lu(k,985) * lu(k,1623) + lu(k,1630) = lu(k,1630) - lu(k,986) * lu(k,1623) + lu(k,1631) = lu(k,1631) - lu(k,987) * lu(k,1623) + lu(k,1632) = lu(k,1632) - lu(k,988) * lu(k,1623) + lu(k,1634) = lu(k,1634) - lu(k,989) * lu(k,1623) + lu(k,1635) = lu(k,1635) - lu(k,990) * lu(k,1623) + lu(k,1636) = lu(k,1636) - lu(k,991) * lu(k,1623) + lu(k,1637) = lu(k,1637) - lu(k,992) * lu(k,1623) + lu(k,1638) = lu(k,1638) - lu(k,993) * lu(k,1623) + lu(k,1640) = lu(k,1640) - lu(k,994) * lu(k,1623) + lu(k,1641) = lu(k,1641) - lu(k,995) * lu(k,1623) + lu(k,1642) = lu(k,1642) - lu(k,996) * lu(k,1623) + lu(k,1643) = lu(k,1643) - lu(k,997) * lu(k,1623) + lu(k,1644) = lu(k,1644) - lu(k,998) * lu(k,1623) + lu(k,1645) = lu(k,1645) - lu(k,999) * lu(k,1623) + lu(k,1646) = lu(k,1646) - lu(k,1000) * lu(k,1623) + lu(k,1647) = lu(k,1647) - lu(k,1001) * lu(k,1623) + lu(k,1648) = lu(k,1648) - lu(k,1002) * lu(k,1623) + lu(k,1668) = lu(k,1668) - lu(k,982) * lu(k,1666) + lu(k,1669) = lu(k,1669) - lu(k,983) * lu(k,1666) + lu(k,1670) = lu(k,1670) - lu(k,984) * lu(k,1666) + lu(k,1672) = lu(k,1672) - lu(k,985) * lu(k,1666) + lu(k,1673) = lu(k,1673) - lu(k,986) * lu(k,1666) + lu(k,1674) = lu(k,1674) - lu(k,987) * lu(k,1666) + lu(k,1675) = lu(k,1675) - lu(k,988) * lu(k,1666) + lu(k,1677) = lu(k,1677) - lu(k,989) * lu(k,1666) + lu(k,1678) = lu(k,1678) - lu(k,990) * lu(k,1666) + lu(k,1679) = lu(k,1679) - lu(k,991) * lu(k,1666) + lu(k,1680) = lu(k,1680) - lu(k,992) * lu(k,1666) + lu(k,1681) = lu(k,1681) - lu(k,993) * lu(k,1666) + lu(k,1683) = lu(k,1683) - lu(k,994) * lu(k,1666) + lu(k,1684) = lu(k,1684) - lu(k,995) * lu(k,1666) + lu(k,1685) = lu(k,1685) - lu(k,996) * lu(k,1666) + lu(k,1686) = lu(k,1686) - lu(k,997) * lu(k,1666) + lu(k,1687) = lu(k,1687) - lu(k,998) * lu(k,1666) + lu(k,1688) = lu(k,1688) - lu(k,999) * lu(k,1666) + lu(k,1689) = lu(k,1689) - lu(k,1000) * lu(k,1666) + lu(k,1690) = lu(k,1690) - lu(k,1001) * lu(k,1666) + lu(k,1691) = lu(k,1691) - lu(k,1002) * lu(k,1666) + lu(k,1710) = lu(k,1710) - lu(k,982) * lu(k,1708) + lu(k,1711) = lu(k,1711) - lu(k,983) * lu(k,1708) + lu(k,1712) = lu(k,1712) - lu(k,984) * lu(k,1708) + lu(k,1714) = lu(k,1714) - lu(k,985) * lu(k,1708) + lu(k,1715) = lu(k,1715) - lu(k,986) * lu(k,1708) + lu(k,1716) = lu(k,1716) - lu(k,987) * lu(k,1708) + lu(k,1717) = lu(k,1717) - lu(k,988) * lu(k,1708) + lu(k,1719) = lu(k,1719) - lu(k,989) * lu(k,1708) + lu(k,1720) = lu(k,1720) - lu(k,990) * lu(k,1708) + lu(k,1721) = lu(k,1721) - lu(k,991) * lu(k,1708) + lu(k,1722) = lu(k,1722) - lu(k,992) * lu(k,1708) + lu(k,1723) = lu(k,1723) - lu(k,993) * lu(k,1708) + lu(k,1725) = lu(k,1725) - lu(k,994) * lu(k,1708) + lu(k,1726) = lu(k,1726) - lu(k,995) * lu(k,1708) + lu(k,1727) = lu(k,1727) - lu(k,996) * lu(k,1708) + lu(k,1728) = lu(k,1728) - lu(k,997) * lu(k,1708) + lu(k,1729) = lu(k,1729) - lu(k,998) * lu(k,1708) + lu(k,1730) = lu(k,1730) - lu(k,999) * lu(k,1708) + lu(k,1731) = lu(k,1731) - lu(k,1000) * lu(k,1708) + lu(k,1732) = lu(k,1732) - lu(k,1001) * lu(k,1708) + lu(k,1733) = lu(k,1733) - lu(k,1002) * lu(k,1708) + lu(k,1755) = lu(k,1755) - lu(k,982) * lu(k,1753) + lu(k,1756) = lu(k,1756) - lu(k,983) * lu(k,1753) + lu(k,1757) = lu(k,1757) - lu(k,984) * lu(k,1753) + lu(k,1759) = lu(k,1759) - lu(k,985) * lu(k,1753) + lu(k,1760) = lu(k,1760) - lu(k,986) * lu(k,1753) + lu(k,1761) = lu(k,1761) - lu(k,987) * lu(k,1753) + lu(k,1762) = lu(k,1762) - lu(k,988) * lu(k,1753) + lu(k,1764) = lu(k,1764) - lu(k,989) * lu(k,1753) + lu(k,1765) = lu(k,1765) - lu(k,990) * lu(k,1753) + lu(k,1766) = lu(k,1766) - lu(k,991) * lu(k,1753) + lu(k,1767) = lu(k,1767) - lu(k,992) * lu(k,1753) + lu(k,1768) = lu(k,1768) - lu(k,993) * lu(k,1753) + lu(k,1770) = lu(k,1770) - lu(k,994) * lu(k,1753) + lu(k,1771) = lu(k,1771) - lu(k,995) * lu(k,1753) + lu(k,1772) = lu(k,1772) - lu(k,996) * lu(k,1753) + lu(k,1773) = lu(k,1773) - lu(k,997) * lu(k,1753) + lu(k,1774) = lu(k,1774) - lu(k,998) * lu(k,1753) + lu(k,1775) = lu(k,1775) - lu(k,999) * lu(k,1753) + lu(k,1776) = lu(k,1776) - lu(k,1000) * lu(k,1753) + lu(k,1777) = lu(k,1777) - lu(k,1001) * lu(k,1753) + lu(k,1778) = lu(k,1778) - lu(k,1002) * lu(k,1753) + lu(k,1804) = lu(k,1804) - lu(k,982) * lu(k,1802) + lu(k,1805) = lu(k,1805) - lu(k,983) * lu(k,1802) + lu(k,1806) = lu(k,1806) - lu(k,984) * lu(k,1802) + lu(k,1808) = lu(k,1808) - lu(k,985) * lu(k,1802) + lu(k,1809) = lu(k,1809) - lu(k,986) * lu(k,1802) + lu(k,1810) = lu(k,1810) - lu(k,987) * lu(k,1802) + lu(k,1811) = lu(k,1811) - lu(k,988) * lu(k,1802) + lu(k,1813) = lu(k,1813) - lu(k,989) * lu(k,1802) + lu(k,1814) = lu(k,1814) - lu(k,990) * lu(k,1802) + lu(k,1815) = lu(k,1815) - lu(k,991) * lu(k,1802) + lu(k,1816) = lu(k,1816) - lu(k,992) * lu(k,1802) + lu(k,1817) = lu(k,1817) - lu(k,993) * lu(k,1802) + lu(k,1819) = lu(k,1819) - lu(k,994) * lu(k,1802) + lu(k,1820) = lu(k,1820) - lu(k,995) * lu(k,1802) + lu(k,1821) = lu(k,1821) - lu(k,996) * lu(k,1802) + lu(k,1822) = lu(k,1822) - lu(k,997) * lu(k,1802) + lu(k,1823) = lu(k,1823) - lu(k,998) * lu(k,1802) + lu(k,1824) = lu(k,1824) - lu(k,999) * lu(k,1802) + lu(k,1825) = lu(k,1825) - lu(k,1000) * lu(k,1802) + lu(k,1826) = lu(k,1826) - lu(k,1001) * lu(k,1802) + lu(k,1827) = lu(k,1827) - lu(k,1002) * lu(k,1802) + lu(k,1837) = lu(k,1837) - lu(k,982) * lu(k,1835) + lu(k,1838) = lu(k,1838) - lu(k,983) * lu(k,1835) + lu(k,1839) = lu(k,1839) - lu(k,984) * lu(k,1835) + lu(k,1841) = lu(k,1841) - lu(k,985) * lu(k,1835) + lu(k,1842) = lu(k,1842) - lu(k,986) * lu(k,1835) + lu(k,1843) = lu(k,1843) - lu(k,987) * lu(k,1835) + lu(k,1844) = lu(k,1844) - lu(k,988) * lu(k,1835) + lu(k,1846) = lu(k,1846) - lu(k,989) * lu(k,1835) + lu(k,1847) = lu(k,1847) - lu(k,990) * lu(k,1835) + lu(k,1848) = lu(k,1848) - lu(k,991) * lu(k,1835) + lu(k,1849) = lu(k,1849) - lu(k,992) * lu(k,1835) + lu(k,1850) = lu(k,1850) - lu(k,993) * lu(k,1835) + lu(k,1852) = lu(k,1852) - lu(k,994) * lu(k,1835) + lu(k,1853) = lu(k,1853) - lu(k,995) * lu(k,1835) + lu(k,1854) = lu(k,1854) - lu(k,996) * lu(k,1835) + lu(k,1855) = lu(k,1855) - lu(k,997) * lu(k,1835) + lu(k,1856) = lu(k,1856) - lu(k,998) * lu(k,1835) + lu(k,1857) = lu(k,1857) - lu(k,999) * lu(k,1835) + lu(k,1858) = lu(k,1858) - lu(k,1000) * lu(k,1835) + lu(k,1859) = lu(k,1859) - lu(k,1001) * lu(k,1835) + lu(k,1860) = lu(k,1860) - lu(k,1002) * lu(k,1835) + lu(k,1873) = lu(k,1873) - lu(k,982) * lu(k,1871) + lu(k,1874) = lu(k,1874) - lu(k,983) * lu(k,1871) + lu(k,1875) = lu(k,1875) - lu(k,984) * lu(k,1871) + lu(k,1877) = lu(k,1877) - lu(k,985) * lu(k,1871) + lu(k,1878) = lu(k,1878) - lu(k,986) * lu(k,1871) + lu(k,1879) = lu(k,1879) - lu(k,987) * lu(k,1871) + lu(k,1880) = lu(k,1880) - lu(k,988) * lu(k,1871) + lu(k,1882) = lu(k,1882) - lu(k,989) * lu(k,1871) + lu(k,1883) = lu(k,1883) - lu(k,990) * lu(k,1871) + lu(k,1884) = lu(k,1884) - lu(k,991) * lu(k,1871) + lu(k,1885) = lu(k,1885) - lu(k,992) * lu(k,1871) + lu(k,1886) = lu(k,1886) - lu(k,993) * lu(k,1871) + lu(k,1888) = lu(k,1888) - lu(k,994) * lu(k,1871) + lu(k,1889) = lu(k,1889) - lu(k,995) * lu(k,1871) + lu(k,1890) = lu(k,1890) - lu(k,996) * lu(k,1871) + lu(k,1891) = lu(k,1891) - lu(k,997) * lu(k,1871) + lu(k,1892) = lu(k,1892) - lu(k,998) * lu(k,1871) + lu(k,1893) = lu(k,1893) - lu(k,999) * lu(k,1871) + lu(k,1894) = lu(k,1894) - lu(k,1000) * lu(k,1871) + lu(k,1895) = lu(k,1895) - lu(k,1001) * lu(k,1871) + lu(k,1896) = lu(k,1896) - lu(k,1002) * lu(k,1871) + lu(k,1914) = lu(k,1914) - lu(k,982) * lu(k,1912) + lu(k,1915) = lu(k,1915) - lu(k,983) * lu(k,1912) + lu(k,1916) = lu(k,1916) - lu(k,984) * lu(k,1912) + lu(k,1918) = lu(k,1918) - lu(k,985) * lu(k,1912) + lu(k,1919) = lu(k,1919) - lu(k,986) * lu(k,1912) + lu(k,1920) = lu(k,1920) - lu(k,987) * lu(k,1912) + lu(k,1921) = lu(k,1921) - lu(k,988) * lu(k,1912) + lu(k,1923) = lu(k,1923) - lu(k,989) * lu(k,1912) + lu(k,1924) = lu(k,1924) - lu(k,990) * lu(k,1912) + lu(k,1925) = lu(k,1925) - lu(k,991) * lu(k,1912) + lu(k,1926) = lu(k,1926) - lu(k,992) * lu(k,1912) + lu(k,1927) = lu(k,1927) - lu(k,993) * lu(k,1912) + lu(k,1929) = lu(k,1929) - lu(k,994) * lu(k,1912) + lu(k,1930) = lu(k,1930) - lu(k,995) * lu(k,1912) + lu(k,1931) = lu(k,1931) - lu(k,996) * lu(k,1912) + lu(k,1932) = lu(k,1932) - lu(k,997) * lu(k,1912) + lu(k,1933) = lu(k,1933) - lu(k,998) * lu(k,1912) + lu(k,1934) = lu(k,1934) - lu(k,999) * lu(k,1912) + lu(k,1935) = lu(k,1935) - lu(k,1000) * lu(k,1912) + lu(k,1936) = lu(k,1936) - lu(k,1001) * lu(k,1912) + lu(k,1937) = lu(k,1937) - lu(k,1002) * lu(k,1912) + lu(k,1956) = lu(k,1956) - lu(k,982) * lu(k,1954) + lu(k,1957) = lu(k,1957) - lu(k,983) * lu(k,1954) + lu(k,1958) = lu(k,1958) - lu(k,984) * lu(k,1954) + lu(k,1960) = lu(k,1960) - lu(k,985) * lu(k,1954) + lu(k,1961) = lu(k,1961) - lu(k,986) * lu(k,1954) + lu(k,1962) = lu(k,1962) - lu(k,987) * lu(k,1954) + lu(k,1963) = lu(k,1963) - lu(k,988) * lu(k,1954) + lu(k,1965) = lu(k,1965) - lu(k,989) * lu(k,1954) + lu(k,1966) = lu(k,1966) - lu(k,990) * lu(k,1954) + lu(k,1967) = lu(k,1967) - lu(k,991) * lu(k,1954) + lu(k,1968) = lu(k,1968) - lu(k,992) * lu(k,1954) + lu(k,1969) = lu(k,1969) - lu(k,993) * lu(k,1954) + lu(k,1971) = lu(k,1971) - lu(k,994) * lu(k,1954) + lu(k,1972) = lu(k,1972) - lu(k,995) * lu(k,1954) + lu(k,1973) = lu(k,1973) - lu(k,996) * lu(k,1954) + lu(k,1974) = lu(k,1974) - lu(k,997) * lu(k,1954) + lu(k,1975) = lu(k,1975) - lu(k,998) * lu(k,1954) + lu(k,1976) = lu(k,1976) - lu(k,999) * lu(k,1954) + lu(k,1977) = lu(k,1977) - lu(k,1000) * lu(k,1954) + lu(k,1978) = lu(k,1978) - lu(k,1001) * lu(k,1954) + lu(k,1979) = lu(k,1979) - lu(k,1002) * lu(k,1954) + lu(k,2004) = lu(k,2004) - lu(k,982) * lu(k,2002) + lu(k,2005) = lu(k,2005) - lu(k,983) * lu(k,2002) + lu(k,2006) = lu(k,2006) - lu(k,984) * lu(k,2002) + lu(k,2008) = lu(k,2008) - lu(k,985) * lu(k,2002) + lu(k,2009) = lu(k,2009) - lu(k,986) * lu(k,2002) + lu(k,2010) = lu(k,2010) - lu(k,987) * lu(k,2002) + lu(k,2011) = lu(k,2011) - lu(k,988) * lu(k,2002) + lu(k,2013) = lu(k,2013) - lu(k,989) * lu(k,2002) + lu(k,2014) = lu(k,2014) - lu(k,990) * lu(k,2002) + lu(k,2015) = lu(k,2015) - lu(k,991) * lu(k,2002) + lu(k,2016) = lu(k,2016) - lu(k,992) * lu(k,2002) + lu(k,2017) = lu(k,2017) - lu(k,993) * lu(k,2002) + lu(k,2019) = lu(k,2019) - lu(k,994) * lu(k,2002) + lu(k,2020) = lu(k,2020) - lu(k,995) * lu(k,2002) + lu(k,2021) = lu(k,2021) - lu(k,996) * lu(k,2002) + lu(k,2022) = lu(k,2022) - lu(k,997) * lu(k,2002) + lu(k,2023) = lu(k,2023) - lu(k,998) * lu(k,2002) + lu(k,2024) = lu(k,2024) - lu(k,999) * lu(k,2002) + lu(k,2025) = lu(k,2025) - lu(k,1000) * lu(k,2002) + lu(k,2026) = lu(k,2026) - lu(k,1001) * lu(k,2002) + lu(k,2027) = lu(k,2027) - lu(k,1002) * lu(k,2002) + lu(k,2064) = lu(k,2064) - lu(k,982) * lu(k,2062) + lu(k,2065) = lu(k,2065) - lu(k,983) * lu(k,2062) + lu(k,2066) = lu(k,2066) - lu(k,984) * lu(k,2062) + lu(k,2068) = lu(k,2068) - lu(k,985) * lu(k,2062) + lu(k,2069) = lu(k,2069) - lu(k,986) * lu(k,2062) + lu(k,2070) = lu(k,2070) - lu(k,987) * lu(k,2062) + lu(k,2071) = lu(k,2071) - lu(k,988) * lu(k,2062) + lu(k,2073) = lu(k,2073) - lu(k,989) * lu(k,2062) + lu(k,2074) = lu(k,2074) - lu(k,990) * lu(k,2062) + lu(k,2075) = lu(k,2075) - lu(k,991) * lu(k,2062) + lu(k,2076) = lu(k,2076) - lu(k,992) * lu(k,2062) + lu(k,2077) = lu(k,2077) - lu(k,993) * lu(k,2062) + lu(k,2079) = lu(k,2079) - lu(k,994) * lu(k,2062) + lu(k,2080) = lu(k,2080) - lu(k,995) * lu(k,2062) + lu(k,2081) = lu(k,2081) - lu(k,996) * lu(k,2062) + lu(k,2082) = lu(k,2082) - lu(k,997) * lu(k,2062) + lu(k,2083) = lu(k,2083) - lu(k,998) * lu(k,2062) + lu(k,2084) = lu(k,2084) - lu(k,999) * lu(k,2062) + lu(k,2085) = lu(k,2085) - lu(k,1000) * lu(k,2062) + lu(k,2086) = lu(k,2086) - lu(k,1001) * lu(k,2062) + lu(k,2087) = lu(k,2087) - lu(k,1002) * lu(k,2062) + 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,1019) = lu(k,1019) * lu(k,1011) + lu(k,1020) = lu(k,1020) * lu(k,1011) + lu(k,1021) = lu(k,1021) * lu(k,1011) + lu(k,1022) = lu(k,1022) * lu(k,1011) + lu(k,1023) = lu(k,1023) * lu(k,1011) + lu(k,1024) = lu(k,1024) * lu(k,1011) + lu(k,1025) = lu(k,1025) * lu(k,1011) + lu(k,1026) = lu(k,1026) * lu(k,1011) + lu(k,1027) = lu(k,1027) * lu(k,1011) + lu(k,1028) = lu(k,1028) * lu(k,1011) + lu(k,1029) = lu(k,1029) * lu(k,1011) + lu(k,1030) = lu(k,1030) * lu(k,1011) + lu(k,1031) = lu(k,1031) * lu(k,1011) + lu(k,1032) = lu(k,1032) * lu(k,1011) + lu(k,1033) = lu(k,1033) * lu(k,1011) + lu(k,1034) = lu(k,1034) * lu(k,1011) + lu(k,1035) = lu(k,1035) * lu(k,1011) + lu(k,1143) = lu(k,1143) - lu(k,1012) * lu(k,1142) + lu(k,1144) = lu(k,1144) - lu(k,1013) * lu(k,1142) + lu(k,1145) = lu(k,1145) - lu(k,1014) * lu(k,1142) + lu(k,1146) = lu(k,1146) - lu(k,1015) * lu(k,1142) + lu(k,1147) = lu(k,1147) - lu(k,1016) * lu(k,1142) + lu(k,1148) = lu(k,1148) - lu(k,1017) * lu(k,1142) + lu(k,1149) = lu(k,1149) - lu(k,1018) * lu(k,1142) + lu(k,1150) = lu(k,1150) - lu(k,1019) * lu(k,1142) + lu(k,1151) = lu(k,1151) - lu(k,1020) * lu(k,1142) + lu(k,1152) = lu(k,1152) - lu(k,1021) * lu(k,1142) + lu(k,1153) = lu(k,1153) - lu(k,1022) * lu(k,1142) + lu(k,1154) = lu(k,1154) - lu(k,1023) * lu(k,1142) + lu(k,1155) = lu(k,1155) - lu(k,1024) * lu(k,1142) + lu(k,1156) = lu(k,1156) - lu(k,1025) * lu(k,1142) + lu(k,1157) = lu(k,1157) - lu(k,1026) * lu(k,1142) + lu(k,1158) = lu(k,1158) - lu(k,1027) * lu(k,1142) + lu(k,1159) = lu(k,1159) - lu(k,1028) * lu(k,1142) + lu(k,1160) = lu(k,1160) - lu(k,1029) * lu(k,1142) + lu(k,1161) = lu(k,1161) - lu(k,1030) * lu(k,1142) + lu(k,1162) = lu(k,1162) - lu(k,1031) * lu(k,1142) + lu(k,1163) = lu(k,1163) - lu(k,1032) * lu(k,1142) + lu(k,1164) = lu(k,1164) - lu(k,1033) * lu(k,1142) + lu(k,1165) = lu(k,1165) - lu(k,1034) * lu(k,1142) + lu(k,1166) = lu(k,1166) - lu(k,1035) * lu(k,1142) + lu(k,1186) = lu(k,1186) - lu(k,1012) * lu(k,1185) + lu(k,1187) = lu(k,1187) - lu(k,1013) * lu(k,1185) + lu(k,1188) = lu(k,1188) - lu(k,1014) * lu(k,1185) + lu(k,1189) = lu(k,1189) - lu(k,1015) * lu(k,1185) + lu(k,1190) = lu(k,1190) - lu(k,1016) * lu(k,1185) + lu(k,1191) = lu(k,1191) - lu(k,1017) * lu(k,1185) + lu(k,1192) = lu(k,1192) - lu(k,1018) * lu(k,1185) + lu(k,1193) = lu(k,1193) - lu(k,1019) * lu(k,1185) + lu(k,1194) = lu(k,1194) - lu(k,1020) * lu(k,1185) + lu(k,1195) = lu(k,1195) - lu(k,1021) * lu(k,1185) + lu(k,1196) = lu(k,1196) - lu(k,1022) * lu(k,1185) + lu(k,1197) = lu(k,1197) - lu(k,1023) * lu(k,1185) + lu(k,1198) = lu(k,1198) - lu(k,1024) * lu(k,1185) + lu(k,1199) = lu(k,1199) - lu(k,1025) * lu(k,1185) + lu(k,1200) = lu(k,1200) - lu(k,1026) * lu(k,1185) + lu(k,1201) = lu(k,1201) - lu(k,1027) * lu(k,1185) + lu(k,1202) = lu(k,1202) - lu(k,1028) * lu(k,1185) + lu(k,1203) = lu(k,1203) - lu(k,1029) * lu(k,1185) + lu(k,1204) = lu(k,1204) - lu(k,1030) * lu(k,1185) + lu(k,1205) = lu(k,1205) - lu(k,1031) * lu(k,1185) + lu(k,1206) = lu(k,1206) - lu(k,1032) * lu(k,1185) + lu(k,1207) = lu(k,1207) - lu(k,1033) * lu(k,1185) + lu(k,1208) = lu(k,1208) - lu(k,1034) * lu(k,1185) + lu(k,1209) = lu(k,1209) - lu(k,1035) * lu(k,1185) + lu(k,1227) = lu(k,1227) - lu(k,1012) * lu(k,1226) + lu(k,1228) = lu(k,1228) - lu(k,1013) * lu(k,1226) + lu(k,1229) = lu(k,1229) - lu(k,1014) * lu(k,1226) + lu(k,1230) = lu(k,1230) - lu(k,1015) * lu(k,1226) + lu(k,1231) = lu(k,1231) - lu(k,1016) * lu(k,1226) + lu(k,1232) = lu(k,1232) - lu(k,1017) * lu(k,1226) + lu(k,1233) = lu(k,1233) - lu(k,1018) * lu(k,1226) + lu(k,1234) = lu(k,1234) - lu(k,1019) * lu(k,1226) + lu(k,1235) = lu(k,1235) - lu(k,1020) * lu(k,1226) + lu(k,1236) = lu(k,1236) - lu(k,1021) * lu(k,1226) + lu(k,1237) = lu(k,1237) - lu(k,1022) * lu(k,1226) + lu(k,1238) = lu(k,1238) - lu(k,1023) * lu(k,1226) + lu(k,1239) = lu(k,1239) - lu(k,1024) * lu(k,1226) + lu(k,1240) = lu(k,1240) - lu(k,1025) * lu(k,1226) + lu(k,1241) = lu(k,1241) - lu(k,1026) * lu(k,1226) + lu(k,1242) = lu(k,1242) - lu(k,1027) * lu(k,1226) + lu(k,1243) = lu(k,1243) - lu(k,1028) * lu(k,1226) + lu(k,1244) = lu(k,1244) - lu(k,1029) * lu(k,1226) + lu(k,1245) = lu(k,1245) - lu(k,1030) * lu(k,1226) + lu(k,1246) = lu(k,1246) - lu(k,1031) * lu(k,1226) + lu(k,1247) = lu(k,1247) - lu(k,1032) * lu(k,1226) + lu(k,1248) = lu(k,1248) - lu(k,1033) * lu(k,1226) + lu(k,1249) = lu(k,1249) - lu(k,1034) * lu(k,1226) + lu(k,1250) = lu(k,1250) - lu(k,1035) * lu(k,1226) + lu(k,1287) = lu(k,1287) - lu(k,1012) * lu(k,1286) + lu(k,1288) = lu(k,1288) - lu(k,1013) * lu(k,1286) + lu(k,1289) = lu(k,1289) - lu(k,1014) * lu(k,1286) + lu(k,1290) = lu(k,1290) - lu(k,1015) * lu(k,1286) + lu(k,1291) = lu(k,1291) - lu(k,1016) * lu(k,1286) + lu(k,1292) = lu(k,1292) - lu(k,1017) * lu(k,1286) + lu(k,1293) = lu(k,1293) - lu(k,1018) * lu(k,1286) + lu(k,1294) = lu(k,1294) - lu(k,1019) * lu(k,1286) + lu(k,1295) = lu(k,1295) - lu(k,1020) * lu(k,1286) + lu(k,1296) = lu(k,1296) - lu(k,1021) * lu(k,1286) + lu(k,1297) = lu(k,1297) - lu(k,1022) * lu(k,1286) + lu(k,1298) = lu(k,1298) - lu(k,1023) * lu(k,1286) + lu(k,1299) = lu(k,1299) - lu(k,1024) * lu(k,1286) + lu(k,1300) = lu(k,1300) - lu(k,1025) * lu(k,1286) + lu(k,1301) = lu(k,1301) - lu(k,1026) * lu(k,1286) + lu(k,1302) = lu(k,1302) - lu(k,1027) * lu(k,1286) + lu(k,1303) = lu(k,1303) - lu(k,1028) * lu(k,1286) + lu(k,1304) = lu(k,1304) - lu(k,1029) * lu(k,1286) + lu(k,1305) = lu(k,1305) - lu(k,1030) * lu(k,1286) + lu(k,1306) = lu(k,1306) - lu(k,1031) * lu(k,1286) + lu(k,1307) = lu(k,1307) - lu(k,1032) * lu(k,1286) + lu(k,1308) = lu(k,1308) - lu(k,1033) * lu(k,1286) + lu(k,1309) = lu(k,1309) - lu(k,1034) * lu(k,1286) + lu(k,1310) = lu(k,1310) - lu(k,1035) * lu(k,1286) + lu(k,1329) = lu(k,1329) - lu(k,1012) * lu(k,1328) + lu(k,1330) = lu(k,1330) - lu(k,1013) * lu(k,1328) + lu(k,1331) = lu(k,1331) - lu(k,1014) * lu(k,1328) + lu(k,1332) = lu(k,1332) - lu(k,1015) * lu(k,1328) + lu(k,1333) = lu(k,1333) - lu(k,1016) * lu(k,1328) + lu(k,1334) = lu(k,1334) - lu(k,1017) * lu(k,1328) + lu(k,1335) = lu(k,1335) - lu(k,1018) * lu(k,1328) + lu(k,1336) = lu(k,1336) - lu(k,1019) * lu(k,1328) + lu(k,1337) = lu(k,1337) - lu(k,1020) * lu(k,1328) + lu(k,1338) = lu(k,1338) - lu(k,1021) * lu(k,1328) + lu(k,1339) = lu(k,1339) - lu(k,1022) * lu(k,1328) + lu(k,1340) = lu(k,1340) - lu(k,1023) * lu(k,1328) + lu(k,1341) = lu(k,1341) - lu(k,1024) * lu(k,1328) + lu(k,1342) = lu(k,1342) - lu(k,1025) * lu(k,1328) + lu(k,1343) = lu(k,1343) - lu(k,1026) * lu(k,1328) + lu(k,1344) = lu(k,1344) - lu(k,1027) * lu(k,1328) + lu(k,1345) = lu(k,1345) - lu(k,1028) * lu(k,1328) + lu(k,1346) = lu(k,1346) - lu(k,1029) * lu(k,1328) + lu(k,1347) = lu(k,1347) - lu(k,1030) * lu(k,1328) + lu(k,1348) = lu(k,1348) - lu(k,1031) * lu(k,1328) + lu(k,1349) = lu(k,1349) - lu(k,1032) * lu(k,1328) + lu(k,1350) = lu(k,1350) - lu(k,1033) * lu(k,1328) + lu(k,1351) = lu(k,1351) - lu(k,1034) * lu(k,1328) + lu(k,1352) = lu(k,1352) - lu(k,1035) * lu(k,1328) + lu(k,1365) = lu(k,1365) - lu(k,1012) * lu(k,1364) + lu(k,1366) = lu(k,1366) - lu(k,1013) * lu(k,1364) + lu(k,1367) = lu(k,1367) - lu(k,1014) * lu(k,1364) + lu(k,1368) = lu(k,1368) - lu(k,1015) * lu(k,1364) + lu(k,1369) = lu(k,1369) - lu(k,1016) * lu(k,1364) + lu(k,1370) = lu(k,1370) - lu(k,1017) * lu(k,1364) + lu(k,1371) = lu(k,1371) - lu(k,1018) * lu(k,1364) + lu(k,1372) = lu(k,1372) - lu(k,1019) * lu(k,1364) + lu(k,1373) = lu(k,1373) - lu(k,1020) * lu(k,1364) + lu(k,1374) = lu(k,1374) - lu(k,1021) * lu(k,1364) + lu(k,1375) = lu(k,1375) - lu(k,1022) * lu(k,1364) + lu(k,1376) = lu(k,1376) - lu(k,1023) * lu(k,1364) + lu(k,1377) = lu(k,1377) - lu(k,1024) * lu(k,1364) + lu(k,1378) = lu(k,1378) - lu(k,1025) * lu(k,1364) + lu(k,1379) = lu(k,1379) - lu(k,1026) * lu(k,1364) + lu(k,1380) = lu(k,1380) - lu(k,1027) * lu(k,1364) + lu(k,1381) = lu(k,1381) - lu(k,1028) * lu(k,1364) + lu(k,1382) = lu(k,1382) - lu(k,1029) * lu(k,1364) + lu(k,1383) = lu(k,1383) - lu(k,1030) * lu(k,1364) + lu(k,1384) = lu(k,1384) - lu(k,1031) * lu(k,1364) + lu(k,1385) = lu(k,1385) - lu(k,1032) * lu(k,1364) + lu(k,1386) = lu(k,1386) - lu(k,1033) * lu(k,1364) + lu(k,1387) = lu(k,1387) - lu(k,1034) * lu(k,1364) + lu(k,1388) = lu(k,1388) - lu(k,1035) * lu(k,1364) + lu(k,1408) = lu(k,1408) - lu(k,1012) * lu(k,1407) + lu(k,1409) = lu(k,1409) - lu(k,1013) * lu(k,1407) + lu(k,1410) = lu(k,1410) - lu(k,1014) * lu(k,1407) + lu(k,1411) = lu(k,1411) - lu(k,1015) * lu(k,1407) + lu(k,1412) = lu(k,1412) - lu(k,1016) * lu(k,1407) + lu(k,1413) = lu(k,1413) - lu(k,1017) * lu(k,1407) + lu(k,1414) = lu(k,1414) - lu(k,1018) * lu(k,1407) + lu(k,1415) = lu(k,1415) - lu(k,1019) * lu(k,1407) + lu(k,1416) = lu(k,1416) - lu(k,1020) * lu(k,1407) + lu(k,1417) = lu(k,1417) - lu(k,1021) * lu(k,1407) + lu(k,1418) = lu(k,1418) - lu(k,1022) * lu(k,1407) + lu(k,1419) = lu(k,1419) - lu(k,1023) * lu(k,1407) + lu(k,1420) = lu(k,1420) - lu(k,1024) * lu(k,1407) + lu(k,1421) = lu(k,1421) - lu(k,1025) * lu(k,1407) + lu(k,1422) = lu(k,1422) - lu(k,1026) * lu(k,1407) + lu(k,1423) = lu(k,1423) - lu(k,1027) * lu(k,1407) + lu(k,1424) = lu(k,1424) - lu(k,1028) * lu(k,1407) + lu(k,1425) = lu(k,1425) - lu(k,1029) * lu(k,1407) + lu(k,1426) = lu(k,1426) - lu(k,1030) * lu(k,1407) + lu(k,1427) = lu(k,1427) - lu(k,1031) * lu(k,1407) + lu(k,1428) = lu(k,1428) - lu(k,1032) * lu(k,1407) + lu(k,1429) = lu(k,1429) - lu(k,1033) * lu(k,1407) + lu(k,1430) = lu(k,1430) - lu(k,1034) * lu(k,1407) + lu(k,1431) = lu(k,1431) - lu(k,1035) * lu(k,1407) + lu(k,1451) = lu(k,1451) - lu(k,1012) * lu(k,1450) + lu(k,1452) = lu(k,1452) - lu(k,1013) * lu(k,1450) + lu(k,1453) = lu(k,1453) - lu(k,1014) * lu(k,1450) + lu(k,1454) = lu(k,1454) - lu(k,1015) * lu(k,1450) + lu(k,1455) = lu(k,1455) - lu(k,1016) * lu(k,1450) + lu(k,1456) = lu(k,1456) - lu(k,1017) * lu(k,1450) + lu(k,1457) = lu(k,1457) - lu(k,1018) * lu(k,1450) + lu(k,1458) = lu(k,1458) - lu(k,1019) * lu(k,1450) + lu(k,1459) = lu(k,1459) - lu(k,1020) * lu(k,1450) + lu(k,1460) = lu(k,1460) - lu(k,1021) * lu(k,1450) + lu(k,1461) = lu(k,1461) - lu(k,1022) * lu(k,1450) + lu(k,1462) = lu(k,1462) - lu(k,1023) * lu(k,1450) + lu(k,1463) = lu(k,1463) - lu(k,1024) * lu(k,1450) + lu(k,1464) = lu(k,1464) - lu(k,1025) * lu(k,1450) + lu(k,1465) = lu(k,1465) - lu(k,1026) * lu(k,1450) + lu(k,1466) = lu(k,1466) - lu(k,1027) * lu(k,1450) + lu(k,1467) = lu(k,1467) - lu(k,1028) * lu(k,1450) + lu(k,1468) = lu(k,1468) - lu(k,1029) * lu(k,1450) + lu(k,1469) = lu(k,1469) - lu(k,1030) * lu(k,1450) + lu(k,1470) = lu(k,1470) - lu(k,1031) * lu(k,1450) + lu(k,1471) = lu(k,1471) - lu(k,1032) * lu(k,1450) + lu(k,1472) = lu(k,1472) - lu(k,1033) * lu(k,1450) + lu(k,1473) = lu(k,1473) - lu(k,1034) * lu(k,1450) + lu(k,1474) = lu(k,1474) - lu(k,1035) * lu(k,1450) + lu(k,1496) = lu(k,1496) - lu(k,1012) * lu(k,1495) + lu(k,1497) = lu(k,1497) - lu(k,1013) * lu(k,1495) + lu(k,1498) = lu(k,1498) - lu(k,1014) * lu(k,1495) + lu(k,1499) = lu(k,1499) - lu(k,1015) * lu(k,1495) + lu(k,1500) = lu(k,1500) - lu(k,1016) * lu(k,1495) + lu(k,1501) = lu(k,1501) - lu(k,1017) * lu(k,1495) + lu(k,1502) = lu(k,1502) - lu(k,1018) * lu(k,1495) + lu(k,1503) = lu(k,1503) - lu(k,1019) * lu(k,1495) + lu(k,1504) = lu(k,1504) - lu(k,1020) * lu(k,1495) + lu(k,1505) = lu(k,1505) - lu(k,1021) * lu(k,1495) + lu(k,1506) = lu(k,1506) - lu(k,1022) * lu(k,1495) + lu(k,1507) = lu(k,1507) - lu(k,1023) * lu(k,1495) + lu(k,1508) = lu(k,1508) - lu(k,1024) * lu(k,1495) + lu(k,1509) = lu(k,1509) - lu(k,1025) * lu(k,1495) + lu(k,1510) = lu(k,1510) - lu(k,1026) * lu(k,1495) + lu(k,1511) = lu(k,1511) - lu(k,1027) * lu(k,1495) + lu(k,1512) = lu(k,1512) - lu(k,1028) * lu(k,1495) + lu(k,1513) = lu(k,1513) - lu(k,1029) * lu(k,1495) + lu(k,1514) = lu(k,1514) - lu(k,1030) * lu(k,1495) + lu(k,1515) = lu(k,1515) - lu(k,1031) * lu(k,1495) + lu(k,1516) = lu(k,1516) - lu(k,1032) * lu(k,1495) + lu(k,1517) = lu(k,1517) - lu(k,1033) * lu(k,1495) + lu(k,1518) = lu(k,1518) - lu(k,1034) * lu(k,1495) + lu(k,1519) = lu(k,1519) - lu(k,1035) * lu(k,1495) + lu(k,1532) = lu(k,1532) - lu(k,1012) * lu(k,1531) + lu(k,1533) = lu(k,1533) - lu(k,1013) * lu(k,1531) + lu(k,1534) = lu(k,1534) - lu(k,1014) * lu(k,1531) + lu(k,1535) = lu(k,1535) - lu(k,1015) * lu(k,1531) + lu(k,1536) = lu(k,1536) - lu(k,1016) * lu(k,1531) + lu(k,1537) = lu(k,1537) - lu(k,1017) * lu(k,1531) + lu(k,1538) = lu(k,1538) - lu(k,1018) * lu(k,1531) + lu(k,1539) = lu(k,1539) - lu(k,1019) * lu(k,1531) + lu(k,1540) = lu(k,1540) - lu(k,1020) * lu(k,1531) + lu(k,1541) = lu(k,1541) - lu(k,1021) * lu(k,1531) + lu(k,1542) = lu(k,1542) - lu(k,1022) * lu(k,1531) + lu(k,1543) = lu(k,1543) - lu(k,1023) * lu(k,1531) + lu(k,1544) = lu(k,1544) - lu(k,1024) * lu(k,1531) + lu(k,1545) = lu(k,1545) - lu(k,1025) * lu(k,1531) + lu(k,1546) = lu(k,1546) - lu(k,1026) * lu(k,1531) + lu(k,1547) = lu(k,1547) - lu(k,1027) * lu(k,1531) + lu(k,1548) = lu(k,1548) - lu(k,1028) * lu(k,1531) + lu(k,1549) = lu(k,1549) - lu(k,1029) * lu(k,1531) + lu(k,1550) = lu(k,1550) - lu(k,1030) * lu(k,1531) + lu(k,1551) = lu(k,1551) - lu(k,1031) * lu(k,1531) + lu(k,1552) = lu(k,1552) - lu(k,1032) * lu(k,1531) + lu(k,1553) = lu(k,1553) - lu(k,1033) * lu(k,1531) + lu(k,1554) = lu(k,1554) - lu(k,1034) * lu(k,1531) + lu(k,1555) = lu(k,1555) - lu(k,1035) * lu(k,1531) + lu(k,1577) = lu(k,1577) - lu(k,1012) * lu(k,1576) + lu(k,1578) = lu(k,1578) - lu(k,1013) * lu(k,1576) + lu(k,1579) = lu(k,1579) - lu(k,1014) * lu(k,1576) + lu(k,1580) = lu(k,1580) - lu(k,1015) * lu(k,1576) + lu(k,1581) = lu(k,1581) - lu(k,1016) * lu(k,1576) + lu(k,1582) = lu(k,1582) - lu(k,1017) * lu(k,1576) + lu(k,1583) = lu(k,1583) - lu(k,1018) * lu(k,1576) + lu(k,1584) = lu(k,1584) - lu(k,1019) * lu(k,1576) + lu(k,1585) = lu(k,1585) - lu(k,1020) * lu(k,1576) + lu(k,1586) = lu(k,1586) - lu(k,1021) * lu(k,1576) + lu(k,1587) = lu(k,1587) - lu(k,1022) * lu(k,1576) + lu(k,1588) = lu(k,1588) - lu(k,1023) * lu(k,1576) + lu(k,1589) = lu(k,1589) - lu(k,1024) * lu(k,1576) + lu(k,1590) = lu(k,1590) - lu(k,1025) * lu(k,1576) + lu(k,1591) = lu(k,1591) - lu(k,1026) * lu(k,1576) + lu(k,1592) = lu(k,1592) - lu(k,1027) * lu(k,1576) + lu(k,1593) = lu(k,1593) - lu(k,1028) * lu(k,1576) + lu(k,1594) = lu(k,1594) - lu(k,1029) * lu(k,1576) + lu(k,1595) = lu(k,1595) - lu(k,1030) * lu(k,1576) + lu(k,1596) = lu(k,1596) - lu(k,1031) * lu(k,1576) + lu(k,1597) = lu(k,1597) - lu(k,1032) * lu(k,1576) + lu(k,1598) = lu(k,1598) - lu(k,1033) * lu(k,1576) + lu(k,1599) = lu(k,1599) - lu(k,1034) * lu(k,1576) + lu(k,1600) = lu(k,1600) - lu(k,1035) * lu(k,1576) + lu(k,1625) = lu(k,1625) - lu(k,1012) * lu(k,1624) + lu(k,1626) = lu(k,1626) - lu(k,1013) * lu(k,1624) + lu(k,1627) = lu(k,1627) - lu(k,1014) * lu(k,1624) + lu(k,1628) = lu(k,1628) - lu(k,1015) * lu(k,1624) + lu(k,1629) = lu(k,1629) - lu(k,1016) * lu(k,1624) + lu(k,1630) = lu(k,1630) - lu(k,1017) * lu(k,1624) + lu(k,1631) = lu(k,1631) - lu(k,1018) * lu(k,1624) + lu(k,1632) = lu(k,1632) - lu(k,1019) * lu(k,1624) + lu(k,1633) = lu(k,1633) - lu(k,1020) * lu(k,1624) + lu(k,1634) = lu(k,1634) - lu(k,1021) * lu(k,1624) + lu(k,1635) = lu(k,1635) - lu(k,1022) * lu(k,1624) + lu(k,1636) = lu(k,1636) - lu(k,1023) * lu(k,1624) + lu(k,1637) = lu(k,1637) - lu(k,1024) * lu(k,1624) + lu(k,1638) = lu(k,1638) - lu(k,1025) * lu(k,1624) + lu(k,1639) = lu(k,1639) - lu(k,1026) * lu(k,1624) + lu(k,1640) = lu(k,1640) - lu(k,1027) * lu(k,1624) + lu(k,1641) = lu(k,1641) - lu(k,1028) * lu(k,1624) + lu(k,1642) = lu(k,1642) - lu(k,1029) * lu(k,1624) + lu(k,1643) = lu(k,1643) - lu(k,1030) * lu(k,1624) + lu(k,1644) = lu(k,1644) - lu(k,1031) * lu(k,1624) + lu(k,1645) = lu(k,1645) - lu(k,1032) * lu(k,1624) + lu(k,1646) = lu(k,1646) - lu(k,1033) * lu(k,1624) + lu(k,1647) = lu(k,1647) - lu(k,1034) * lu(k,1624) + lu(k,1648) = lu(k,1648) - lu(k,1035) * lu(k,1624) + lu(k,1668) = lu(k,1668) - lu(k,1012) * lu(k,1667) + lu(k,1669) = lu(k,1669) - lu(k,1013) * lu(k,1667) + lu(k,1670) = lu(k,1670) - lu(k,1014) * lu(k,1667) + lu(k,1671) = lu(k,1671) - lu(k,1015) * lu(k,1667) + lu(k,1672) = lu(k,1672) - lu(k,1016) * lu(k,1667) + lu(k,1673) = lu(k,1673) - lu(k,1017) * lu(k,1667) + lu(k,1674) = lu(k,1674) - lu(k,1018) * lu(k,1667) + lu(k,1675) = lu(k,1675) - lu(k,1019) * lu(k,1667) + lu(k,1676) = lu(k,1676) - lu(k,1020) * lu(k,1667) + lu(k,1677) = lu(k,1677) - lu(k,1021) * lu(k,1667) + lu(k,1678) = lu(k,1678) - lu(k,1022) * lu(k,1667) + lu(k,1679) = lu(k,1679) - lu(k,1023) * lu(k,1667) + lu(k,1680) = lu(k,1680) - lu(k,1024) * lu(k,1667) + lu(k,1681) = lu(k,1681) - lu(k,1025) * lu(k,1667) + lu(k,1682) = lu(k,1682) - lu(k,1026) * lu(k,1667) + lu(k,1683) = lu(k,1683) - lu(k,1027) * lu(k,1667) + lu(k,1684) = lu(k,1684) - lu(k,1028) * lu(k,1667) + lu(k,1685) = lu(k,1685) - lu(k,1029) * lu(k,1667) + lu(k,1686) = lu(k,1686) - lu(k,1030) * lu(k,1667) + lu(k,1687) = lu(k,1687) - lu(k,1031) * lu(k,1667) + lu(k,1688) = lu(k,1688) - lu(k,1032) * lu(k,1667) + lu(k,1689) = lu(k,1689) - lu(k,1033) * lu(k,1667) + lu(k,1690) = lu(k,1690) - lu(k,1034) * lu(k,1667) + lu(k,1691) = lu(k,1691) - lu(k,1035) * lu(k,1667) + lu(k,1710) = lu(k,1710) - lu(k,1012) * lu(k,1709) + lu(k,1711) = lu(k,1711) - lu(k,1013) * lu(k,1709) + lu(k,1712) = lu(k,1712) - lu(k,1014) * lu(k,1709) + lu(k,1713) = lu(k,1713) - lu(k,1015) * lu(k,1709) + lu(k,1714) = lu(k,1714) - lu(k,1016) * lu(k,1709) + lu(k,1715) = lu(k,1715) - lu(k,1017) * lu(k,1709) + lu(k,1716) = lu(k,1716) - lu(k,1018) * lu(k,1709) + lu(k,1717) = lu(k,1717) - lu(k,1019) * lu(k,1709) + lu(k,1718) = lu(k,1718) - lu(k,1020) * lu(k,1709) + lu(k,1719) = lu(k,1719) - lu(k,1021) * lu(k,1709) + lu(k,1720) = lu(k,1720) - lu(k,1022) * lu(k,1709) + lu(k,1721) = lu(k,1721) - lu(k,1023) * lu(k,1709) + lu(k,1722) = lu(k,1722) - lu(k,1024) * lu(k,1709) + lu(k,1723) = lu(k,1723) - lu(k,1025) * lu(k,1709) + lu(k,1724) = lu(k,1724) - lu(k,1026) * lu(k,1709) + lu(k,1725) = lu(k,1725) - lu(k,1027) * lu(k,1709) + lu(k,1726) = lu(k,1726) - lu(k,1028) * lu(k,1709) + lu(k,1727) = lu(k,1727) - lu(k,1029) * lu(k,1709) + lu(k,1728) = lu(k,1728) - lu(k,1030) * lu(k,1709) + lu(k,1729) = lu(k,1729) - lu(k,1031) * lu(k,1709) + lu(k,1730) = lu(k,1730) - lu(k,1032) * lu(k,1709) + lu(k,1731) = lu(k,1731) - lu(k,1033) * lu(k,1709) + lu(k,1732) = lu(k,1732) - lu(k,1034) * lu(k,1709) + lu(k,1733) = lu(k,1733) - lu(k,1035) * lu(k,1709) + lu(k,1755) = lu(k,1755) - lu(k,1012) * lu(k,1754) + lu(k,1756) = lu(k,1756) - lu(k,1013) * lu(k,1754) + lu(k,1757) = lu(k,1757) - lu(k,1014) * lu(k,1754) + lu(k,1758) = lu(k,1758) - lu(k,1015) * lu(k,1754) + lu(k,1759) = lu(k,1759) - lu(k,1016) * lu(k,1754) + lu(k,1760) = lu(k,1760) - lu(k,1017) * lu(k,1754) + lu(k,1761) = lu(k,1761) - lu(k,1018) * lu(k,1754) + lu(k,1762) = lu(k,1762) - lu(k,1019) * lu(k,1754) + lu(k,1763) = lu(k,1763) - lu(k,1020) * lu(k,1754) + lu(k,1764) = lu(k,1764) - lu(k,1021) * lu(k,1754) + lu(k,1765) = lu(k,1765) - lu(k,1022) * lu(k,1754) + lu(k,1766) = lu(k,1766) - lu(k,1023) * lu(k,1754) + lu(k,1767) = lu(k,1767) - lu(k,1024) * lu(k,1754) + lu(k,1768) = lu(k,1768) - lu(k,1025) * lu(k,1754) + lu(k,1769) = lu(k,1769) - lu(k,1026) * lu(k,1754) + lu(k,1770) = lu(k,1770) - lu(k,1027) * lu(k,1754) + lu(k,1771) = lu(k,1771) - lu(k,1028) * lu(k,1754) + lu(k,1772) = lu(k,1772) - lu(k,1029) * lu(k,1754) + lu(k,1773) = lu(k,1773) - lu(k,1030) * lu(k,1754) + lu(k,1774) = lu(k,1774) - lu(k,1031) * lu(k,1754) + lu(k,1775) = lu(k,1775) - lu(k,1032) * lu(k,1754) + lu(k,1776) = lu(k,1776) - lu(k,1033) * lu(k,1754) + lu(k,1777) = lu(k,1777) - lu(k,1034) * lu(k,1754) + lu(k,1778) = lu(k,1778) - lu(k,1035) * lu(k,1754) + lu(k,1804) = lu(k,1804) - lu(k,1012) * lu(k,1803) + lu(k,1805) = lu(k,1805) - lu(k,1013) * lu(k,1803) + lu(k,1806) = lu(k,1806) - lu(k,1014) * lu(k,1803) + lu(k,1807) = lu(k,1807) - lu(k,1015) * lu(k,1803) + lu(k,1808) = lu(k,1808) - lu(k,1016) * lu(k,1803) + lu(k,1809) = lu(k,1809) - lu(k,1017) * lu(k,1803) + lu(k,1810) = lu(k,1810) - lu(k,1018) * lu(k,1803) + lu(k,1811) = lu(k,1811) - lu(k,1019) * lu(k,1803) + lu(k,1812) = lu(k,1812) - lu(k,1020) * lu(k,1803) + lu(k,1813) = lu(k,1813) - lu(k,1021) * lu(k,1803) + lu(k,1814) = lu(k,1814) - lu(k,1022) * lu(k,1803) + lu(k,1815) = lu(k,1815) - lu(k,1023) * lu(k,1803) + lu(k,1816) = lu(k,1816) - lu(k,1024) * lu(k,1803) + lu(k,1817) = lu(k,1817) - lu(k,1025) * lu(k,1803) + lu(k,1818) = lu(k,1818) - lu(k,1026) * lu(k,1803) + lu(k,1819) = lu(k,1819) - lu(k,1027) * lu(k,1803) + lu(k,1820) = lu(k,1820) - lu(k,1028) * lu(k,1803) + lu(k,1821) = lu(k,1821) - lu(k,1029) * lu(k,1803) + lu(k,1822) = lu(k,1822) - lu(k,1030) * lu(k,1803) + lu(k,1823) = lu(k,1823) - lu(k,1031) * lu(k,1803) + lu(k,1824) = lu(k,1824) - lu(k,1032) * lu(k,1803) + lu(k,1825) = lu(k,1825) - lu(k,1033) * lu(k,1803) + lu(k,1826) = lu(k,1826) - lu(k,1034) * lu(k,1803) + lu(k,1827) = lu(k,1827) - lu(k,1035) * lu(k,1803) + lu(k,1837) = lu(k,1837) - lu(k,1012) * lu(k,1836) + lu(k,1838) = lu(k,1838) - lu(k,1013) * lu(k,1836) + lu(k,1839) = lu(k,1839) - lu(k,1014) * lu(k,1836) + lu(k,1840) = lu(k,1840) - lu(k,1015) * lu(k,1836) + lu(k,1841) = lu(k,1841) - lu(k,1016) * lu(k,1836) + lu(k,1842) = lu(k,1842) - lu(k,1017) * lu(k,1836) + lu(k,1843) = lu(k,1843) - lu(k,1018) * lu(k,1836) + lu(k,1844) = lu(k,1844) - lu(k,1019) * lu(k,1836) + lu(k,1845) = lu(k,1845) - lu(k,1020) * lu(k,1836) + lu(k,1846) = lu(k,1846) - lu(k,1021) * lu(k,1836) + lu(k,1847) = lu(k,1847) - lu(k,1022) * lu(k,1836) + lu(k,1848) = lu(k,1848) - lu(k,1023) * lu(k,1836) + lu(k,1849) = lu(k,1849) - lu(k,1024) * lu(k,1836) + lu(k,1850) = lu(k,1850) - lu(k,1025) * lu(k,1836) + lu(k,1851) = lu(k,1851) - lu(k,1026) * lu(k,1836) + lu(k,1852) = lu(k,1852) - lu(k,1027) * lu(k,1836) + lu(k,1853) = lu(k,1853) - lu(k,1028) * lu(k,1836) + lu(k,1854) = lu(k,1854) - lu(k,1029) * lu(k,1836) + lu(k,1855) = lu(k,1855) - lu(k,1030) * lu(k,1836) + lu(k,1856) = lu(k,1856) - lu(k,1031) * lu(k,1836) + lu(k,1857) = lu(k,1857) - lu(k,1032) * lu(k,1836) + lu(k,1858) = lu(k,1858) - lu(k,1033) * lu(k,1836) + lu(k,1859) = lu(k,1859) - lu(k,1034) * lu(k,1836) + lu(k,1860) = lu(k,1860) - lu(k,1035) * lu(k,1836) + lu(k,1873) = lu(k,1873) - lu(k,1012) * lu(k,1872) + lu(k,1874) = lu(k,1874) - lu(k,1013) * lu(k,1872) + lu(k,1875) = lu(k,1875) - lu(k,1014) * lu(k,1872) + lu(k,1876) = lu(k,1876) - lu(k,1015) * lu(k,1872) + lu(k,1877) = lu(k,1877) - lu(k,1016) * lu(k,1872) + lu(k,1878) = lu(k,1878) - lu(k,1017) * lu(k,1872) + lu(k,1879) = lu(k,1879) - lu(k,1018) * lu(k,1872) + lu(k,1880) = lu(k,1880) - lu(k,1019) * lu(k,1872) + lu(k,1881) = lu(k,1881) - lu(k,1020) * lu(k,1872) + lu(k,1882) = lu(k,1882) - lu(k,1021) * lu(k,1872) + lu(k,1883) = lu(k,1883) - lu(k,1022) * lu(k,1872) + lu(k,1884) = lu(k,1884) - lu(k,1023) * lu(k,1872) + lu(k,1885) = lu(k,1885) - lu(k,1024) * lu(k,1872) + lu(k,1886) = lu(k,1886) - lu(k,1025) * lu(k,1872) + lu(k,1887) = lu(k,1887) - lu(k,1026) * lu(k,1872) + lu(k,1888) = lu(k,1888) - lu(k,1027) * lu(k,1872) + lu(k,1889) = lu(k,1889) - lu(k,1028) * lu(k,1872) + lu(k,1890) = lu(k,1890) - lu(k,1029) * lu(k,1872) + lu(k,1891) = lu(k,1891) - lu(k,1030) * lu(k,1872) + lu(k,1892) = lu(k,1892) - lu(k,1031) * lu(k,1872) + lu(k,1893) = lu(k,1893) - lu(k,1032) * lu(k,1872) + lu(k,1894) = lu(k,1894) - lu(k,1033) * lu(k,1872) + lu(k,1895) = lu(k,1895) - lu(k,1034) * lu(k,1872) + lu(k,1896) = lu(k,1896) - lu(k,1035) * lu(k,1872) + lu(k,1914) = lu(k,1914) - lu(k,1012) * lu(k,1913) + lu(k,1915) = lu(k,1915) - lu(k,1013) * lu(k,1913) + lu(k,1916) = lu(k,1916) - lu(k,1014) * lu(k,1913) + lu(k,1917) = lu(k,1917) - lu(k,1015) * lu(k,1913) + lu(k,1918) = lu(k,1918) - lu(k,1016) * lu(k,1913) + lu(k,1919) = lu(k,1919) - lu(k,1017) * lu(k,1913) + lu(k,1920) = lu(k,1920) - lu(k,1018) * lu(k,1913) + lu(k,1921) = lu(k,1921) - lu(k,1019) * lu(k,1913) + lu(k,1922) = lu(k,1922) - lu(k,1020) * lu(k,1913) + lu(k,1923) = lu(k,1923) - lu(k,1021) * lu(k,1913) + lu(k,1924) = lu(k,1924) - lu(k,1022) * lu(k,1913) + lu(k,1925) = lu(k,1925) - lu(k,1023) * lu(k,1913) + lu(k,1926) = lu(k,1926) - lu(k,1024) * lu(k,1913) + lu(k,1927) = lu(k,1927) - lu(k,1025) * lu(k,1913) + lu(k,1928) = lu(k,1928) - lu(k,1026) * lu(k,1913) + lu(k,1929) = lu(k,1929) - lu(k,1027) * lu(k,1913) + lu(k,1930) = lu(k,1930) - lu(k,1028) * lu(k,1913) + lu(k,1931) = lu(k,1931) - lu(k,1029) * lu(k,1913) + lu(k,1932) = lu(k,1932) - lu(k,1030) * lu(k,1913) + lu(k,1933) = lu(k,1933) - lu(k,1031) * lu(k,1913) + lu(k,1934) = lu(k,1934) - lu(k,1032) * lu(k,1913) + lu(k,1935) = lu(k,1935) - lu(k,1033) * lu(k,1913) + lu(k,1936) = lu(k,1936) - lu(k,1034) * lu(k,1913) + lu(k,1937) = lu(k,1937) - lu(k,1035) * lu(k,1913) + lu(k,1956) = lu(k,1956) - lu(k,1012) * lu(k,1955) + lu(k,1957) = lu(k,1957) - lu(k,1013) * lu(k,1955) + lu(k,1958) = lu(k,1958) - lu(k,1014) * lu(k,1955) + lu(k,1959) = lu(k,1959) - lu(k,1015) * lu(k,1955) + lu(k,1960) = lu(k,1960) - lu(k,1016) * lu(k,1955) + lu(k,1961) = lu(k,1961) - lu(k,1017) * lu(k,1955) + lu(k,1962) = lu(k,1962) - lu(k,1018) * lu(k,1955) + lu(k,1963) = lu(k,1963) - lu(k,1019) * lu(k,1955) + lu(k,1964) = lu(k,1964) - lu(k,1020) * lu(k,1955) + lu(k,1965) = lu(k,1965) - lu(k,1021) * lu(k,1955) + lu(k,1966) = lu(k,1966) - lu(k,1022) * lu(k,1955) + lu(k,1967) = lu(k,1967) - lu(k,1023) * lu(k,1955) + lu(k,1968) = lu(k,1968) - lu(k,1024) * lu(k,1955) + lu(k,1969) = lu(k,1969) - lu(k,1025) * lu(k,1955) + lu(k,1970) = lu(k,1970) - lu(k,1026) * lu(k,1955) + lu(k,1971) = lu(k,1971) - lu(k,1027) * lu(k,1955) + lu(k,1972) = lu(k,1972) - lu(k,1028) * lu(k,1955) + lu(k,1973) = lu(k,1973) - lu(k,1029) * lu(k,1955) + lu(k,1974) = lu(k,1974) - lu(k,1030) * lu(k,1955) + lu(k,1975) = lu(k,1975) - lu(k,1031) * lu(k,1955) + lu(k,1976) = lu(k,1976) - lu(k,1032) * lu(k,1955) + lu(k,1977) = lu(k,1977) - lu(k,1033) * lu(k,1955) + lu(k,1978) = lu(k,1978) - lu(k,1034) * lu(k,1955) + lu(k,1979) = lu(k,1979) - lu(k,1035) * lu(k,1955) + lu(k,2004) = lu(k,2004) - lu(k,1012) * lu(k,2003) + lu(k,2005) = lu(k,2005) - lu(k,1013) * lu(k,2003) + lu(k,2006) = lu(k,2006) - lu(k,1014) * lu(k,2003) + lu(k,2007) = lu(k,2007) - lu(k,1015) * lu(k,2003) + lu(k,2008) = lu(k,2008) - lu(k,1016) * lu(k,2003) + lu(k,2009) = lu(k,2009) - lu(k,1017) * lu(k,2003) + lu(k,2010) = lu(k,2010) - lu(k,1018) * lu(k,2003) + lu(k,2011) = lu(k,2011) - lu(k,1019) * lu(k,2003) + lu(k,2012) = lu(k,2012) - lu(k,1020) * lu(k,2003) + lu(k,2013) = lu(k,2013) - lu(k,1021) * lu(k,2003) + lu(k,2014) = lu(k,2014) - lu(k,1022) * lu(k,2003) + lu(k,2015) = lu(k,2015) - lu(k,1023) * lu(k,2003) + lu(k,2016) = lu(k,2016) - lu(k,1024) * lu(k,2003) + lu(k,2017) = lu(k,2017) - lu(k,1025) * lu(k,2003) + lu(k,2018) = lu(k,2018) - lu(k,1026) * lu(k,2003) + lu(k,2019) = lu(k,2019) - lu(k,1027) * lu(k,2003) + lu(k,2020) = lu(k,2020) - lu(k,1028) * lu(k,2003) + lu(k,2021) = lu(k,2021) - lu(k,1029) * lu(k,2003) + lu(k,2022) = lu(k,2022) - lu(k,1030) * lu(k,2003) + lu(k,2023) = lu(k,2023) - lu(k,1031) * lu(k,2003) + lu(k,2024) = lu(k,2024) - lu(k,1032) * lu(k,2003) + lu(k,2025) = lu(k,2025) - lu(k,1033) * lu(k,2003) + lu(k,2026) = lu(k,2026) - lu(k,1034) * lu(k,2003) + lu(k,2027) = lu(k,2027) - lu(k,1035) * lu(k,2003) + lu(k,2064) = lu(k,2064) - lu(k,1012) * lu(k,2063) + lu(k,2065) = lu(k,2065) - lu(k,1013) * lu(k,2063) + lu(k,2066) = lu(k,2066) - lu(k,1014) * lu(k,2063) + lu(k,2067) = lu(k,2067) - lu(k,1015) * lu(k,2063) + lu(k,2068) = lu(k,2068) - lu(k,1016) * lu(k,2063) + lu(k,2069) = lu(k,2069) - lu(k,1017) * lu(k,2063) + lu(k,2070) = lu(k,2070) - lu(k,1018) * lu(k,2063) + lu(k,2071) = lu(k,2071) - lu(k,1019) * lu(k,2063) + lu(k,2072) = lu(k,2072) - lu(k,1020) * lu(k,2063) + lu(k,2073) = lu(k,2073) - lu(k,1021) * lu(k,2063) + lu(k,2074) = lu(k,2074) - lu(k,1022) * lu(k,2063) + lu(k,2075) = lu(k,2075) - lu(k,1023) * lu(k,2063) + lu(k,2076) = lu(k,2076) - lu(k,1024) * lu(k,2063) + lu(k,2077) = lu(k,2077) - lu(k,1025) * lu(k,2063) + lu(k,2078) = lu(k,2078) - lu(k,1026) * lu(k,2063) + lu(k,2079) = lu(k,2079) - lu(k,1027) * lu(k,2063) + lu(k,2080) = lu(k,2080) - lu(k,1028) * lu(k,2063) + lu(k,2081) = lu(k,2081) - lu(k,1029) * lu(k,2063) + lu(k,2082) = lu(k,2082) - lu(k,1030) * lu(k,2063) + lu(k,2083) = lu(k,2083) - lu(k,1031) * lu(k,2063) + lu(k,2084) = lu(k,2084) - lu(k,1032) * lu(k,2063) + lu(k,2085) = lu(k,2085) - lu(k,1033) * lu(k,2063) + lu(k,2086) = lu(k,2086) - lu(k,1034) * lu(k,2063) + lu(k,2087) = lu(k,2087) - lu(k,1035) * lu(k,2063) + lu(k,1055) = 1._r8 / lu(k,1055) + lu(k,1056) = lu(k,1056) * lu(k,1055) + lu(k,1057) = lu(k,1057) * lu(k,1055) + lu(k,1058) = lu(k,1058) * lu(k,1055) + lu(k,1059) = lu(k,1059) * lu(k,1055) + lu(k,1060) = lu(k,1060) * lu(k,1055) + lu(k,1061) = lu(k,1061) * lu(k,1055) + lu(k,1062) = lu(k,1062) * lu(k,1055) + lu(k,1063) = lu(k,1063) * lu(k,1055) + lu(k,1064) = lu(k,1064) * lu(k,1055) + lu(k,1065) = lu(k,1065) * lu(k,1055) + lu(k,1066) = lu(k,1066) * lu(k,1055) + lu(k,1067) = lu(k,1067) * lu(k,1055) + lu(k,1068) = lu(k,1068) * lu(k,1055) + lu(k,1069) = lu(k,1069) * lu(k,1055) + lu(k,1070) = lu(k,1070) * lu(k,1055) + lu(k,1071) = lu(k,1071) * lu(k,1055) + lu(k,1072) = lu(k,1072) * lu(k,1055) + lu(k,1073) = lu(k,1073) * lu(k,1055) + lu(k,1074) = lu(k,1074) * lu(k,1055) + lu(k,1075) = lu(k,1075) * lu(k,1055) + lu(k,1076) = lu(k,1076) * lu(k,1055) + lu(k,1077) = lu(k,1077) * lu(k,1055) + lu(k,1078) = lu(k,1078) * lu(k,1055) + lu(k,1096) = lu(k,1096) - lu(k,1056) * lu(k,1095) + lu(k,1097) = lu(k,1097) - lu(k,1057) * lu(k,1095) + lu(k,1098) = lu(k,1098) - lu(k,1058) * lu(k,1095) + lu(k,1099) = lu(k,1099) - lu(k,1059) * lu(k,1095) + lu(k,1100) = lu(k,1100) - lu(k,1060) * lu(k,1095) + lu(k,1101) = lu(k,1101) - lu(k,1061) * lu(k,1095) + lu(k,1102) = lu(k,1102) - lu(k,1062) * lu(k,1095) + lu(k,1103) = lu(k,1103) - lu(k,1063) * lu(k,1095) + lu(k,1104) = lu(k,1104) - lu(k,1064) * lu(k,1095) + lu(k,1105) = lu(k,1105) - lu(k,1065) * lu(k,1095) + lu(k,1106) = lu(k,1106) - lu(k,1066) * lu(k,1095) + lu(k,1107) = lu(k,1107) - lu(k,1067) * lu(k,1095) + lu(k,1108) = lu(k,1108) - lu(k,1068) * lu(k,1095) + lu(k,1109) = lu(k,1109) - lu(k,1069) * lu(k,1095) + lu(k,1110) = lu(k,1110) - lu(k,1070) * lu(k,1095) + lu(k,1111) = lu(k,1111) - lu(k,1071) * lu(k,1095) + lu(k,1112) = lu(k,1112) - lu(k,1072) * lu(k,1095) + lu(k,1113) = lu(k,1113) - lu(k,1073) * lu(k,1095) + lu(k,1114) = lu(k,1114) - lu(k,1074) * lu(k,1095) + lu(k,1115) = lu(k,1115) - lu(k,1075) * lu(k,1095) + lu(k,1116) = lu(k,1116) - lu(k,1076) * lu(k,1095) + lu(k,1117) = lu(k,1117) - lu(k,1077) * lu(k,1095) + lu(k,1118) = lu(k,1118) - lu(k,1078) * lu(k,1095) + lu(k,1144) = lu(k,1144) - lu(k,1056) * lu(k,1143) + lu(k,1145) = lu(k,1145) - lu(k,1057) * lu(k,1143) + lu(k,1146) = lu(k,1146) - lu(k,1058) * lu(k,1143) + lu(k,1147) = lu(k,1147) - lu(k,1059) * lu(k,1143) + lu(k,1148) = lu(k,1148) - lu(k,1060) * lu(k,1143) + lu(k,1149) = lu(k,1149) - lu(k,1061) * lu(k,1143) + lu(k,1150) = lu(k,1150) - lu(k,1062) * lu(k,1143) + lu(k,1151) = lu(k,1151) - lu(k,1063) * lu(k,1143) + lu(k,1152) = lu(k,1152) - lu(k,1064) * lu(k,1143) + lu(k,1153) = lu(k,1153) - lu(k,1065) * lu(k,1143) + lu(k,1154) = lu(k,1154) - lu(k,1066) * lu(k,1143) + lu(k,1155) = lu(k,1155) - lu(k,1067) * lu(k,1143) + lu(k,1156) = lu(k,1156) - lu(k,1068) * lu(k,1143) + lu(k,1157) = lu(k,1157) - lu(k,1069) * lu(k,1143) + lu(k,1158) = lu(k,1158) - lu(k,1070) * lu(k,1143) + lu(k,1159) = lu(k,1159) - lu(k,1071) * lu(k,1143) + lu(k,1160) = lu(k,1160) - lu(k,1072) * lu(k,1143) + lu(k,1161) = lu(k,1161) - lu(k,1073) * lu(k,1143) + lu(k,1162) = lu(k,1162) - lu(k,1074) * lu(k,1143) + lu(k,1163) = lu(k,1163) - lu(k,1075) * lu(k,1143) + lu(k,1164) = lu(k,1164) - lu(k,1076) * lu(k,1143) + lu(k,1165) = lu(k,1165) - lu(k,1077) * lu(k,1143) + lu(k,1166) = lu(k,1166) - lu(k,1078) * lu(k,1143) + lu(k,1187) = lu(k,1187) - lu(k,1056) * lu(k,1186) + lu(k,1188) = lu(k,1188) - lu(k,1057) * lu(k,1186) + lu(k,1189) = lu(k,1189) - lu(k,1058) * lu(k,1186) + lu(k,1190) = lu(k,1190) - lu(k,1059) * lu(k,1186) + lu(k,1191) = lu(k,1191) - lu(k,1060) * lu(k,1186) + lu(k,1192) = lu(k,1192) - lu(k,1061) * lu(k,1186) + lu(k,1193) = lu(k,1193) - lu(k,1062) * lu(k,1186) + lu(k,1194) = lu(k,1194) - lu(k,1063) * lu(k,1186) + lu(k,1195) = lu(k,1195) - lu(k,1064) * lu(k,1186) + lu(k,1196) = lu(k,1196) - lu(k,1065) * lu(k,1186) + lu(k,1197) = lu(k,1197) - lu(k,1066) * lu(k,1186) + lu(k,1198) = lu(k,1198) - lu(k,1067) * lu(k,1186) + lu(k,1199) = lu(k,1199) - lu(k,1068) * lu(k,1186) + lu(k,1200) = lu(k,1200) - lu(k,1069) * lu(k,1186) + lu(k,1201) = lu(k,1201) - lu(k,1070) * lu(k,1186) + lu(k,1202) = lu(k,1202) - lu(k,1071) * lu(k,1186) + lu(k,1203) = lu(k,1203) - lu(k,1072) * lu(k,1186) + lu(k,1204) = lu(k,1204) - lu(k,1073) * lu(k,1186) + lu(k,1205) = lu(k,1205) - lu(k,1074) * lu(k,1186) + lu(k,1206) = lu(k,1206) - lu(k,1075) * lu(k,1186) + lu(k,1207) = lu(k,1207) - lu(k,1076) * lu(k,1186) + lu(k,1208) = lu(k,1208) - lu(k,1077) * lu(k,1186) + lu(k,1209) = lu(k,1209) - lu(k,1078) * lu(k,1186) + lu(k,1228) = lu(k,1228) - lu(k,1056) * lu(k,1227) + lu(k,1229) = lu(k,1229) - lu(k,1057) * lu(k,1227) + lu(k,1230) = lu(k,1230) - lu(k,1058) * lu(k,1227) + lu(k,1231) = lu(k,1231) - lu(k,1059) * lu(k,1227) + lu(k,1232) = lu(k,1232) - lu(k,1060) * lu(k,1227) + lu(k,1233) = lu(k,1233) - lu(k,1061) * lu(k,1227) + lu(k,1234) = lu(k,1234) - lu(k,1062) * lu(k,1227) + lu(k,1235) = lu(k,1235) - lu(k,1063) * lu(k,1227) + lu(k,1236) = lu(k,1236) - lu(k,1064) * lu(k,1227) + lu(k,1237) = lu(k,1237) - lu(k,1065) * lu(k,1227) + lu(k,1238) = lu(k,1238) - lu(k,1066) * lu(k,1227) + lu(k,1239) = lu(k,1239) - lu(k,1067) * lu(k,1227) + lu(k,1240) = lu(k,1240) - lu(k,1068) * lu(k,1227) + lu(k,1241) = lu(k,1241) - lu(k,1069) * lu(k,1227) + lu(k,1242) = lu(k,1242) - lu(k,1070) * lu(k,1227) + lu(k,1243) = lu(k,1243) - lu(k,1071) * lu(k,1227) + lu(k,1244) = lu(k,1244) - lu(k,1072) * lu(k,1227) + lu(k,1245) = lu(k,1245) - lu(k,1073) * lu(k,1227) + lu(k,1246) = lu(k,1246) - lu(k,1074) * lu(k,1227) + lu(k,1247) = lu(k,1247) - lu(k,1075) * lu(k,1227) + lu(k,1248) = lu(k,1248) - lu(k,1076) * lu(k,1227) + lu(k,1249) = lu(k,1249) - lu(k,1077) * lu(k,1227) + lu(k,1250) = lu(k,1250) - lu(k,1078) * lu(k,1227) + lu(k,1288) = lu(k,1288) - lu(k,1056) * lu(k,1287) + lu(k,1289) = lu(k,1289) - lu(k,1057) * lu(k,1287) + lu(k,1290) = lu(k,1290) - lu(k,1058) * lu(k,1287) + lu(k,1291) = lu(k,1291) - lu(k,1059) * lu(k,1287) + lu(k,1292) = lu(k,1292) - lu(k,1060) * lu(k,1287) + lu(k,1293) = lu(k,1293) - lu(k,1061) * lu(k,1287) + lu(k,1294) = lu(k,1294) - lu(k,1062) * lu(k,1287) + lu(k,1295) = lu(k,1295) - lu(k,1063) * lu(k,1287) + lu(k,1296) = lu(k,1296) - lu(k,1064) * lu(k,1287) + lu(k,1297) = lu(k,1297) - lu(k,1065) * lu(k,1287) + lu(k,1298) = lu(k,1298) - lu(k,1066) * lu(k,1287) + lu(k,1299) = lu(k,1299) - lu(k,1067) * lu(k,1287) + lu(k,1300) = lu(k,1300) - lu(k,1068) * lu(k,1287) + lu(k,1301) = lu(k,1301) - lu(k,1069) * lu(k,1287) + lu(k,1302) = lu(k,1302) - lu(k,1070) * lu(k,1287) + lu(k,1303) = lu(k,1303) - lu(k,1071) * lu(k,1287) + lu(k,1304) = lu(k,1304) - lu(k,1072) * lu(k,1287) + lu(k,1305) = lu(k,1305) - lu(k,1073) * lu(k,1287) + lu(k,1306) = lu(k,1306) - lu(k,1074) * lu(k,1287) + lu(k,1307) = lu(k,1307) - lu(k,1075) * lu(k,1287) + lu(k,1308) = lu(k,1308) - lu(k,1076) * lu(k,1287) + lu(k,1309) = lu(k,1309) - lu(k,1077) * lu(k,1287) + lu(k,1310) = lu(k,1310) - lu(k,1078) * lu(k,1287) + lu(k,1330) = lu(k,1330) - lu(k,1056) * lu(k,1329) + lu(k,1331) = lu(k,1331) - lu(k,1057) * lu(k,1329) + lu(k,1332) = lu(k,1332) - lu(k,1058) * lu(k,1329) + lu(k,1333) = lu(k,1333) - lu(k,1059) * lu(k,1329) + lu(k,1334) = lu(k,1334) - lu(k,1060) * lu(k,1329) + lu(k,1335) = lu(k,1335) - lu(k,1061) * lu(k,1329) + lu(k,1336) = lu(k,1336) - lu(k,1062) * lu(k,1329) + lu(k,1337) = lu(k,1337) - lu(k,1063) * lu(k,1329) + lu(k,1338) = lu(k,1338) - lu(k,1064) * lu(k,1329) + lu(k,1339) = lu(k,1339) - lu(k,1065) * lu(k,1329) + lu(k,1340) = lu(k,1340) - lu(k,1066) * lu(k,1329) + lu(k,1341) = lu(k,1341) - lu(k,1067) * lu(k,1329) + lu(k,1342) = lu(k,1342) - lu(k,1068) * lu(k,1329) + lu(k,1343) = lu(k,1343) - lu(k,1069) * lu(k,1329) + lu(k,1344) = lu(k,1344) - lu(k,1070) * lu(k,1329) + lu(k,1345) = lu(k,1345) - lu(k,1071) * lu(k,1329) + lu(k,1346) = lu(k,1346) - lu(k,1072) * lu(k,1329) + lu(k,1347) = lu(k,1347) - lu(k,1073) * lu(k,1329) + lu(k,1348) = lu(k,1348) - lu(k,1074) * lu(k,1329) + lu(k,1349) = lu(k,1349) - lu(k,1075) * lu(k,1329) + lu(k,1350) = lu(k,1350) - lu(k,1076) * lu(k,1329) + lu(k,1351) = lu(k,1351) - lu(k,1077) * lu(k,1329) + lu(k,1352) = lu(k,1352) - lu(k,1078) * lu(k,1329) + lu(k,1366) = lu(k,1366) - lu(k,1056) * lu(k,1365) + lu(k,1367) = lu(k,1367) - lu(k,1057) * lu(k,1365) + lu(k,1368) = lu(k,1368) - lu(k,1058) * lu(k,1365) + lu(k,1369) = lu(k,1369) - lu(k,1059) * lu(k,1365) + lu(k,1370) = lu(k,1370) - lu(k,1060) * lu(k,1365) + lu(k,1371) = lu(k,1371) - lu(k,1061) * lu(k,1365) + lu(k,1372) = lu(k,1372) - lu(k,1062) * lu(k,1365) + lu(k,1373) = lu(k,1373) - lu(k,1063) * lu(k,1365) + lu(k,1374) = lu(k,1374) - lu(k,1064) * lu(k,1365) + lu(k,1375) = lu(k,1375) - lu(k,1065) * lu(k,1365) + lu(k,1376) = lu(k,1376) - lu(k,1066) * lu(k,1365) + lu(k,1377) = lu(k,1377) - lu(k,1067) * lu(k,1365) + lu(k,1378) = lu(k,1378) - lu(k,1068) * lu(k,1365) + lu(k,1379) = lu(k,1379) - lu(k,1069) * lu(k,1365) + lu(k,1380) = lu(k,1380) - lu(k,1070) * lu(k,1365) + lu(k,1381) = lu(k,1381) - lu(k,1071) * lu(k,1365) + lu(k,1382) = lu(k,1382) - lu(k,1072) * lu(k,1365) + lu(k,1383) = lu(k,1383) - lu(k,1073) * lu(k,1365) + lu(k,1384) = lu(k,1384) - lu(k,1074) * lu(k,1365) + lu(k,1385) = lu(k,1385) - lu(k,1075) * lu(k,1365) + lu(k,1386) = lu(k,1386) - lu(k,1076) * lu(k,1365) + lu(k,1387) = lu(k,1387) - lu(k,1077) * lu(k,1365) + lu(k,1388) = lu(k,1388) - lu(k,1078) * lu(k,1365) + lu(k,1409) = lu(k,1409) - lu(k,1056) * lu(k,1408) + lu(k,1410) = lu(k,1410) - lu(k,1057) * lu(k,1408) + lu(k,1411) = lu(k,1411) - lu(k,1058) * lu(k,1408) + lu(k,1412) = lu(k,1412) - lu(k,1059) * lu(k,1408) + lu(k,1413) = lu(k,1413) - lu(k,1060) * lu(k,1408) + lu(k,1414) = lu(k,1414) - lu(k,1061) * lu(k,1408) + lu(k,1415) = lu(k,1415) - lu(k,1062) * lu(k,1408) + lu(k,1416) = lu(k,1416) - lu(k,1063) * lu(k,1408) + lu(k,1417) = lu(k,1417) - lu(k,1064) * lu(k,1408) + lu(k,1418) = lu(k,1418) - lu(k,1065) * lu(k,1408) + lu(k,1419) = lu(k,1419) - lu(k,1066) * lu(k,1408) + lu(k,1420) = lu(k,1420) - lu(k,1067) * lu(k,1408) + lu(k,1421) = lu(k,1421) - lu(k,1068) * lu(k,1408) + lu(k,1422) = lu(k,1422) - lu(k,1069) * lu(k,1408) + lu(k,1423) = lu(k,1423) - lu(k,1070) * lu(k,1408) + lu(k,1424) = lu(k,1424) - lu(k,1071) * lu(k,1408) + lu(k,1425) = lu(k,1425) - lu(k,1072) * lu(k,1408) + lu(k,1426) = lu(k,1426) - lu(k,1073) * lu(k,1408) + lu(k,1427) = lu(k,1427) - lu(k,1074) * lu(k,1408) + lu(k,1428) = lu(k,1428) - lu(k,1075) * lu(k,1408) + lu(k,1429) = lu(k,1429) - lu(k,1076) * lu(k,1408) + lu(k,1430) = lu(k,1430) - lu(k,1077) * lu(k,1408) + lu(k,1431) = lu(k,1431) - lu(k,1078) * lu(k,1408) + lu(k,1452) = lu(k,1452) - lu(k,1056) * lu(k,1451) + lu(k,1453) = lu(k,1453) - lu(k,1057) * lu(k,1451) + lu(k,1454) = lu(k,1454) - lu(k,1058) * lu(k,1451) + lu(k,1455) = lu(k,1455) - lu(k,1059) * lu(k,1451) + lu(k,1456) = lu(k,1456) - lu(k,1060) * lu(k,1451) + lu(k,1457) = lu(k,1457) - lu(k,1061) * lu(k,1451) + lu(k,1458) = lu(k,1458) - lu(k,1062) * lu(k,1451) + lu(k,1459) = lu(k,1459) - lu(k,1063) * lu(k,1451) + lu(k,1460) = lu(k,1460) - lu(k,1064) * lu(k,1451) + lu(k,1461) = lu(k,1461) - lu(k,1065) * lu(k,1451) + lu(k,1462) = lu(k,1462) - lu(k,1066) * lu(k,1451) + lu(k,1463) = lu(k,1463) - lu(k,1067) * lu(k,1451) + lu(k,1464) = lu(k,1464) - lu(k,1068) * lu(k,1451) + lu(k,1465) = lu(k,1465) - lu(k,1069) * lu(k,1451) + lu(k,1466) = lu(k,1466) - lu(k,1070) * lu(k,1451) + lu(k,1467) = lu(k,1467) - lu(k,1071) * lu(k,1451) + lu(k,1468) = lu(k,1468) - lu(k,1072) * lu(k,1451) + lu(k,1469) = lu(k,1469) - lu(k,1073) * lu(k,1451) + lu(k,1470) = lu(k,1470) - lu(k,1074) * lu(k,1451) + lu(k,1471) = lu(k,1471) - lu(k,1075) * lu(k,1451) + lu(k,1472) = lu(k,1472) - lu(k,1076) * lu(k,1451) + lu(k,1473) = lu(k,1473) - lu(k,1077) * lu(k,1451) + lu(k,1474) = lu(k,1474) - lu(k,1078) * lu(k,1451) + lu(k,1497) = lu(k,1497) - lu(k,1056) * lu(k,1496) + lu(k,1498) = lu(k,1498) - lu(k,1057) * lu(k,1496) + lu(k,1499) = lu(k,1499) - lu(k,1058) * lu(k,1496) + lu(k,1500) = lu(k,1500) - lu(k,1059) * lu(k,1496) + lu(k,1501) = lu(k,1501) - lu(k,1060) * lu(k,1496) + lu(k,1502) = lu(k,1502) - lu(k,1061) * lu(k,1496) + lu(k,1503) = lu(k,1503) - lu(k,1062) * lu(k,1496) + lu(k,1504) = lu(k,1504) - lu(k,1063) * lu(k,1496) + lu(k,1505) = lu(k,1505) - lu(k,1064) * lu(k,1496) + lu(k,1506) = lu(k,1506) - lu(k,1065) * lu(k,1496) + lu(k,1507) = lu(k,1507) - lu(k,1066) * lu(k,1496) + lu(k,1508) = lu(k,1508) - lu(k,1067) * lu(k,1496) + lu(k,1509) = lu(k,1509) - lu(k,1068) * lu(k,1496) + lu(k,1510) = lu(k,1510) - lu(k,1069) * lu(k,1496) + lu(k,1511) = lu(k,1511) - lu(k,1070) * lu(k,1496) + lu(k,1512) = lu(k,1512) - lu(k,1071) * lu(k,1496) + lu(k,1513) = lu(k,1513) - lu(k,1072) * lu(k,1496) + lu(k,1514) = lu(k,1514) - lu(k,1073) * lu(k,1496) + lu(k,1515) = lu(k,1515) - lu(k,1074) * lu(k,1496) + lu(k,1516) = lu(k,1516) - lu(k,1075) * lu(k,1496) + lu(k,1517) = lu(k,1517) - lu(k,1076) * lu(k,1496) + lu(k,1518) = lu(k,1518) - lu(k,1077) * lu(k,1496) + lu(k,1519) = lu(k,1519) - lu(k,1078) * lu(k,1496) + lu(k,1533) = lu(k,1533) - lu(k,1056) * lu(k,1532) + lu(k,1534) = lu(k,1534) - lu(k,1057) * lu(k,1532) + lu(k,1535) = lu(k,1535) - lu(k,1058) * lu(k,1532) + lu(k,1536) = lu(k,1536) - lu(k,1059) * lu(k,1532) + lu(k,1537) = lu(k,1537) - lu(k,1060) * lu(k,1532) + lu(k,1538) = lu(k,1538) - lu(k,1061) * lu(k,1532) + lu(k,1539) = lu(k,1539) - lu(k,1062) * lu(k,1532) + lu(k,1540) = lu(k,1540) - lu(k,1063) * lu(k,1532) + lu(k,1541) = lu(k,1541) - lu(k,1064) * lu(k,1532) + lu(k,1542) = lu(k,1542) - lu(k,1065) * lu(k,1532) + lu(k,1543) = lu(k,1543) - lu(k,1066) * lu(k,1532) + lu(k,1544) = lu(k,1544) - lu(k,1067) * lu(k,1532) + lu(k,1545) = lu(k,1545) - lu(k,1068) * lu(k,1532) + lu(k,1546) = lu(k,1546) - lu(k,1069) * lu(k,1532) + lu(k,1547) = lu(k,1547) - lu(k,1070) * lu(k,1532) + lu(k,1548) = lu(k,1548) - lu(k,1071) * lu(k,1532) + lu(k,1549) = lu(k,1549) - lu(k,1072) * lu(k,1532) + lu(k,1550) = lu(k,1550) - lu(k,1073) * lu(k,1532) + lu(k,1551) = lu(k,1551) - lu(k,1074) * lu(k,1532) + lu(k,1552) = lu(k,1552) - lu(k,1075) * lu(k,1532) + lu(k,1553) = lu(k,1553) - lu(k,1076) * lu(k,1532) + lu(k,1554) = lu(k,1554) - lu(k,1077) * lu(k,1532) + lu(k,1555) = lu(k,1555) - lu(k,1078) * lu(k,1532) + lu(k,1578) = lu(k,1578) - lu(k,1056) * lu(k,1577) + lu(k,1579) = lu(k,1579) - lu(k,1057) * lu(k,1577) + lu(k,1580) = lu(k,1580) - lu(k,1058) * lu(k,1577) + lu(k,1581) = lu(k,1581) - lu(k,1059) * lu(k,1577) + lu(k,1582) = lu(k,1582) - lu(k,1060) * lu(k,1577) + lu(k,1583) = lu(k,1583) - lu(k,1061) * lu(k,1577) + lu(k,1584) = lu(k,1584) - lu(k,1062) * lu(k,1577) + lu(k,1585) = lu(k,1585) - lu(k,1063) * lu(k,1577) + lu(k,1586) = lu(k,1586) - lu(k,1064) * lu(k,1577) + lu(k,1587) = lu(k,1587) - lu(k,1065) * lu(k,1577) + lu(k,1588) = lu(k,1588) - lu(k,1066) * lu(k,1577) + lu(k,1589) = lu(k,1589) - lu(k,1067) * lu(k,1577) + lu(k,1590) = lu(k,1590) - lu(k,1068) * lu(k,1577) + lu(k,1591) = lu(k,1591) - lu(k,1069) * lu(k,1577) + lu(k,1592) = lu(k,1592) - lu(k,1070) * lu(k,1577) + lu(k,1593) = lu(k,1593) - lu(k,1071) * lu(k,1577) + lu(k,1594) = lu(k,1594) - lu(k,1072) * lu(k,1577) + lu(k,1595) = lu(k,1595) - lu(k,1073) * lu(k,1577) + lu(k,1596) = lu(k,1596) - lu(k,1074) * lu(k,1577) + lu(k,1597) = lu(k,1597) - lu(k,1075) * lu(k,1577) + lu(k,1598) = lu(k,1598) - lu(k,1076) * lu(k,1577) + lu(k,1599) = lu(k,1599) - lu(k,1077) * lu(k,1577) + lu(k,1600) = lu(k,1600) - lu(k,1078) * lu(k,1577) + lu(k,1626) = lu(k,1626) - lu(k,1056) * lu(k,1625) + lu(k,1627) = lu(k,1627) - lu(k,1057) * lu(k,1625) + lu(k,1628) = lu(k,1628) - lu(k,1058) * lu(k,1625) + lu(k,1629) = lu(k,1629) - lu(k,1059) * lu(k,1625) + lu(k,1630) = lu(k,1630) - lu(k,1060) * lu(k,1625) + lu(k,1631) = lu(k,1631) - lu(k,1061) * lu(k,1625) + lu(k,1632) = lu(k,1632) - lu(k,1062) * lu(k,1625) + lu(k,1633) = lu(k,1633) - lu(k,1063) * lu(k,1625) + lu(k,1634) = lu(k,1634) - lu(k,1064) * lu(k,1625) + lu(k,1635) = lu(k,1635) - lu(k,1065) * lu(k,1625) + lu(k,1636) = lu(k,1636) - lu(k,1066) * lu(k,1625) + lu(k,1637) = lu(k,1637) - lu(k,1067) * lu(k,1625) + lu(k,1638) = lu(k,1638) - lu(k,1068) * lu(k,1625) + lu(k,1639) = lu(k,1639) - lu(k,1069) * lu(k,1625) + lu(k,1640) = lu(k,1640) - lu(k,1070) * lu(k,1625) + lu(k,1641) = lu(k,1641) - lu(k,1071) * lu(k,1625) + lu(k,1642) = lu(k,1642) - lu(k,1072) * lu(k,1625) + lu(k,1643) = lu(k,1643) - lu(k,1073) * lu(k,1625) + lu(k,1644) = lu(k,1644) - lu(k,1074) * lu(k,1625) + lu(k,1645) = lu(k,1645) - lu(k,1075) * lu(k,1625) + lu(k,1646) = lu(k,1646) - lu(k,1076) * lu(k,1625) + lu(k,1647) = lu(k,1647) - lu(k,1077) * lu(k,1625) + lu(k,1648) = lu(k,1648) - lu(k,1078) * lu(k,1625) + lu(k,1669) = lu(k,1669) - lu(k,1056) * lu(k,1668) + lu(k,1670) = lu(k,1670) - lu(k,1057) * lu(k,1668) + lu(k,1671) = lu(k,1671) - lu(k,1058) * lu(k,1668) + lu(k,1672) = lu(k,1672) - lu(k,1059) * lu(k,1668) + lu(k,1673) = lu(k,1673) - lu(k,1060) * lu(k,1668) + lu(k,1674) = lu(k,1674) - lu(k,1061) * lu(k,1668) + lu(k,1675) = lu(k,1675) - lu(k,1062) * lu(k,1668) + lu(k,1676) = lu(k,1676) - lu(k,1063) * lu(k,1668) + lu(k,1677) = lu(k,1677) - lu(k,1064) * lu(k,1668) + lu(k,1678) = lu(k,1678) - lu(k,1065) * lu(k,1668) + lu(k,1679) = lu(k,1679) - lu(k,1066) * lu(k,1668) + lu(k,1680) = lu(k,1680) - lu(k,1067) * lu(k,1668) + lu(k,1681) = lu(k,1681) - lu(k,1068) * lu(k,1668) + lu(k,1682) = lu(k,1682) - lu(k,1069) * lu(k,1668) + lu(k,1683) = lu(k,1683) - lu(k,1070) * lu(k,1668) + lu(k,1684) = lu(k,1684) - lu(k,1071) * lu(k,1668) + lu(k,1685) = lu(k,1685) - lu(k,1072) * lu(k,1668) + lu(k,1686) = lu(k,1686) - lu(k,1073) * lu(k,1668) + lu(k,1687) = lu(k,1687) - lu(k,1074) * lu(k,1668) + lu(k,1688) = lu(k,1688) - lu(k,1075) * lu(k,1668) + lu(k,1689) = lu(k,1689) - lu(k,1076) * lu(k,1668) + lu(k,1690) = lu(k,1690) - lu(k,1077) * lu(k,1668) + lu(k,1691) = lu(k,1691) - lu(k,1078) * lu(k,1668) + lu(k,1711) = lu(k,1711) - lu(k,1056) * lu(k,1710) + lu(k,1712) = lu(k,1712) - lu(k,1057) * lu(k,1710) + lu(k,1713) = lu(k,1713) - lu(k,1058) * lu(k,1710) + lu(k,1714) = lu(k,1714) - lu(k,1059) * lu(k,1710) + lu(k,1715) = lu(k,1715) - lu(k,1060) * lu(k,1710) + lu(k,1716) = lu(k,1716) - lu(k,1061) * lu(k,1710) + lu(k,1717) = lu(k,1717) - lu(k,1062) * lu(k,1710) + lu(k,1718) = lu(k,1718) - lu(k,1063) * lu(k,1710) + lu(k,1719) = lu(k,1719) - lu(k,1064) * lu(k,1710) + lu(k,1720) = lu(k,1720) - lu(k,1065) * lu(k,1710) + lu(k,1721) = lu(k,1721) - lu(k,1066) * lu(k,1710) + lu(k,1722) = lu(k,1722) - lu(k,1067) * lu(k,1710) + lu(k,1723) = lu(k,1723) - lu(k,1068) * lu(k,1710) + lu(k,1724) = lu(k,1724) - lu(k,1069) * lu(k,1710) + lu(k,1725) = lu(k,1725) - lu(k,1070) * lu(k,1710) + lu(k,1726) = lu(k,1726) - lu(k,1071) * lu(k,1710) + lu(k,1727) = lu(k,1727) - lu(k,1072) * lu(k,1710) + lu(k,1728) = lu(k,1728) - lu(k,1073) * lu(k,1710) + lu(k,1729) = lu(k,1729) - lu(k,1074) * lu(k,1710) + lu(k,1730) = lu(k,1730) - lu(k,1075) * lu(k,1710) + lu(k,1731) = lu(k,1731) - lu(k,1076) * lu(k,1710) + lu(k,1732) = lu(k,1732) - lu(k,1077) * lu(k,1710) + lu(k,1733) = lu(k,1733) - lu(k,1078) * lu(k,1710) + lu(k,1756) = lu(k,1756) - lu(k,1056) * lu(k,1755) + lu(k,1757) = lu(k,1757) - lu(k,1057) * lu(k,1755) + lu(k,1758) = lu(k,1758) - lu(k,1058) * lu(k,1755) + lu(k,1759) = lu(k,1759) - lu(k,1059) * lu(k,1755) + lu(k,1760) = lu(k,1760) - lu(k,1060) * lu(k,1755) + lu(k,1761) = lu(k,1761) - lu(k,1061) * lu(k,1755) + lu(k,1762) = lu(k,1762) - lu(k,1062) * lu(k,1755) + lu(k,1763) = lu(k,1763) - lu(k,1063) * lu(k,1755) + lu(k,1764) = lu(k,1764) - lu(k,1064) * lu(k,1755) + lu(k,1765) = lu(k,1765) - lu(k,1065) * lu(k,1755) + lu(k,1766) = lu(k,1766) - lu(k,1066) * lu(k,1755) + lu(k,1767) = lu(k,1767) - lu(k,1067) * lu(k,1755) + lu(k,1768) = lu(k,1768) - lu(k,1068) * lu(k,1755) + lu(k,1769) = lu(k,1769) - lu(k,1069) * lu(k,1755) + lu(k,1770) = lu(k,1770) - lu(k,1070) * lu(k,1755) + lu(k,1771) = lu(k,1771) - lu(k,1071) * lu(k,1755) + lu(k,1772) = lu(k,1772) - lu(k,1072) * lu(k,1755) + lu(k,1773) = lu(k,1773) - lu(k,1073) * lu(k,1755) + lu(k,1774) = lu(k,1774) - lu(k,1074) * lu(k,1755) + lu(k,1775) = lu(k,1775) - lu(k,1075) * lu(k,1755) + lu(k,1776) = lu(k,1776) - lu(k,1076) * lu(k,1755) + lu(k,1777) = lu(k,1777) - lu(k,1077) * lu(k,1755) + lu(k,1778) = lu(k,1778) - lu(k,1078) * lu(k,1755) + lu(k,1805) = lu(k,1805) - lu(k,1056) * lu(k,1804) + lu(k,1806) = lu(k,1806) - lu(k,1057) * lu(k,1804) + lu(k,1807) = lu(k,1807) - lu(k,1058) * lu(k,1804) + lu(k,1808) = lu(k,1808) - lu(k,1059) * lu(k,1804) + lu(k,1809) = lu(k,1809) - lu(k,1060) * lu(k,1804) + lu(k,1810) = lu(k,1810) - lu(k,1061) * lu(k,1804) + lu(k,1811) = lu(k,1811) - lu(k,1062) * lu(k,1804) + lu(k,1812) = lu(k,1812) - lu(k,1063) * lu(k,1804) + lu(k,1813) = lu(k,1813) - lu(k,1064) * lu(k,1804) + lu(k,1814) = lu(k,1814) - lu(k,1065) * lu(k,1804) + lu(k,1815) = lu(k,1815) - lu(k,1066) * lu(k,1804) + lu(k,1816) = lu(k,1816) - lu(k,1067) * lu(k,1804) + lu(k,1817) = lu(k,1817) - lu(k,1068) * lu(k,1804) + lu(k,1818) = lu(k,1818) - lu(k,1069) * lu(k,1804) + lu(k,1819) = lu(k,1819) - lu(k,1070) * lu(k,1804) + lu(k,1820) = lu(k,1820) - lu(k,1071) * lu(k,1804) + lu(k,1821) = lu(k,1821) - lu(k,1072) * lu(k,1804) + lu(k,1822) = lu(k,1822) - lu(k,1073) * lu(k,1804) + lu(k,1823) = lu(k,1823) - lu(k,1074) * lu(k,1804) + lu(k,1824) = lu(k,1824) - lu(k,1075) * lu(k,1804) + lu(k,1825) = lu(k,1825) - lu(k,1076) * lu(k,1804) + lu(k,1826) = lu(k,1826) - lu(k,1077) * lu(k,1804) + lu(k,1827) = lu(k,1827) - lu(k,1078) * lu(k,1804) + lu(k,1838) = lu(k,1838) - lu(k,1056) * lu(k,1837) + lu(k,1839) = lu(k,1839) - lu(k,1057) * lu(k,1837) + lu(k,1840) = lu(k,1840) - lu(k,1058) * lu(k,1837) + lu(k,1841) = lu(k,1841) - lu(k,1059) * lu(k,1837) + lu(k,1842) = lu(k,1842) - lu(k,1060) * lu(k,1837) + lu(k,1843) = lu(k,1843) - lu(k,1061) * lu(k,1837) + lu(k,1844) = lu(k,1844) - lu(k,1062) * lu(k,1837) + lu(k,1845) = lu(k,1845) - lu(k,1063) * lu(k,1837) + lu(k,1846) = lu(k,1846) - lu(k,1064) * lu(k,1837) + lu(k,1847) = lu(k,1847) - lu(k,1065) * lu(k,1837) + lu(k,1848) = lu(k,1848) - lu(k,1066) * lu(k,1837) + lu(k,1849) = lu(k,1849) - lu(k,1067) * lu(k,1837) + lu(k,1850) = lu(k,1850) - lu(k,1068) * lu(k,1837) + lu(k,1851) = lu(k,1851) - lu(k,1069) * lu(k,1837) + lu(k,1852) = lu(k,1852) - lu(k,1070) * lu(k,1837) + lu(k,1853) = lu(k,1853) - lu(k,1071) * lu(k,1837) + lu(k,1854) = lu(k,1854) - lu(k,1072) * lu(k,1837) + lu(k,1855) = lu(k,1855) - lu(k,1073) * lu(k,1837) + lu(k,1856) = lu(k,1856) - lu(k,1074) * lu(k,1837) + lu(k,1857) = lu(k,1857) - lu(k,1075) * lu(k,1837) + lu(k,1858) = lu(k,1858) - lu(k,1076) * lu(k,1837) + lu(k,1859) = lu(k,1859) - lu(k,1077) * lu(k,1837) + lu(k,1860) = lu(k,1860) - lu(k,1078) * lu(k,1837) + lu(k,1874) = lu(k,1874) - lu(k,1056) * lu(k,1873) + lu(k,1875) = lu(k,1875) - lu(k,1057) * lu(k,1873) + lu(k,1876) = lu(k,1876) - lu(k,1058) * lu(k,1873) + lu(k,1877) = lu(k,1877) - lu(k,1059) * lu(k,1873) + lu(k,1878) = lu(k,1878) - lu(k,1060) * lu(k,1873) + lu(k,1879) = lu(k,1879) - lu(k,1061) * lu(k,1873) + lu(k,1880) = lu(k,1880) - lu(k,1062) * lu(k,1873) + lu(k,1881) = lu(k,1881) - lu(k,1063) * lu(k,1873) + lu(k,1882) = lu(k,1882) - lu(k,1064) * lu(k,1873) + lu(k,1883) = lu(k,1883) - lu(k,1065) * lu(k,1873) + lu(k,1884) = lu(k,1884) - lu(k,1066) * lu(k,1873) + lu(k,1885) = lu(k,1885) - lu(k,1067) * lu(k,1873) + lu(k,1886) = lu(k,1886) - lu(k,1068) * lu(k,1873) + lu(k,1887) = lu(k,1887) - lu(k,1069) * lu(k,1873) + lu(k,1888) = lu(k,1888) - lu(k,1070) * lu(k,1873) + lu(k,1889) = lu(k,1889) - lu(k,1071) * lu(k,1873) + lu(k,1890) = lu(k,1890) - lu(k,1072) * lu(k,1873) + lu(k,1891) = lu(k,1891) - lu(k,1073) * lu(k,1873) + lu(k,1892) = lu(k,1892) - lu(k,1074) * lu(k,1873) + lu(k,1893) = lu(k,1893) - lu(k,1075) * lu(k,1873) + lu(k,1894) = lu(k,1894) - lu(k,1076) * lu(k,1873) + lu(k,1895) = lu(k,1895) - lu(k,1077) * lu(k,1873) + lu(k,1896) = lu(k,1896) - lu(k,1078) * lu(k,1873) + lu(k,1915) = lu(k,1915) - lu(k,1056) * lu(k,1914) + lu(k,1916) = lu(k,1916) - lu(k,1057) * lu(k,1914) + lu(k,1917) = lu(k,1917) - lu(k,1058) * lu(k,1914) + lu(k,1918) = lu(k,1918) - lu(k,1059) * lu(k,1914) + lu(k,1919) = lu(k,1919) - lu(k,1060) * lu(k,1914) + lu(k,1920) = lu(k,1920) - lu(k,1061) * lu(k,1914) + lu(k,1921) = lu(k,1921) - lu(k,1062) * lu(k,1914) + lu(k,1922) = lu(k,1922) - lu(k,1063) * lu(k,1914) + lu(k,1923) = lu(k,1923) - lu(k,1064) * lu(k,1914) + lu(k,1924) = lu(k,1924) - lu(k,1065) * lu(k,1914) + lu(k,1925) = lu(k,1925) - lu(k,1066) * lu(k,1914) + lu(k,1926) = lu(k,1926) - lu(k,1067) * lu(k,1914) + lu(k,1927) = lu(k,1927) - lu(k,1068) * lu(k,1914) + lu(k,1928) = lu(k,1928) - lu(k,1069) * lu(k,1914) + lu(k,1929) = lu(k,1929) - lu(k,1070) * lu(k,1914) + lu(k,1930) = lu(k,1930) - lu(k,1071) * lu(k,1914) + lu(k,1931) = lu(k,1931) - lu(k,1072) * lu(k,1914) + lu(k,1932) = lu(k,1932) - lu(k,1073) * lu(k,1914) + lu(k,1933) = lu(k,1933) - lu(k,1074) * lu(k,1914) + lu(k,1934) = lu(k,1934) - lu(k,1075) * lu(k,1914) + lu(k,1935) = lu(k,1935) - lu(k,1076) * lu(k,1914) + lu(k,1936) = lu(k,1936) - lu(k,1077) * lu(k,1914) + lu(k,1937) = lu(k,1937) - lu(k,1078) * lu(k,1914) + lu(k,1957) = lu(k,1957) - lu(k,1056) * lu(k,1956) + lu(k,1958) = lu(k,1958) - lu(k,1057) * lu(k,1956) + lu(k,1959) = lu(k,1959) - lu(k,1058) * lu(k,1956) + lu(k,1960) = lu(k,1960) - lu(k,1059) * lu(k,1956) + lu(k,1961) = lu(k,1961) - lu(k,1060) * lu(k,1956) + lu(k,1962) = lu(k,1962) - lu(k,1061) * lu(k,1956) + lu(k,1963) = lu(k,1963) - lu(k,1062) * lu(k,1956) + lu(k,1964) = lu(k,1964) - lu(k,1063) * lu(k,1956) + lu(k,1965) = lu(k,1965) - lu(k,1064) * lu(k,1956) + lu(k,1966) = lu(k,1966) - lu(k,1065) * lu(k,1956) + lu(k,1967) = lu(k,1967) - lu(k,1066) * lu(k,1956) + lu(k,1968) = lu(k,1968) - lu(k,1067) * lu(k,1956) + lu(k,1969) = lu(k,1969) - lu(k,1068) * lu(k,1956) + lu(k,1970) = lu(k,1970) - lu(k,1069) * lu(k,1956) + lu(k,1971) = lu(k,1971) - lu(k,1070) * lu(k,1956) + lu(k,1972) = lu(k,1972) - lu(k,1071) * lu(k,1956) + lu(k,1973) = lu(k,1973) - lu(k,1072) * lu(k,1956) + lu(k,1974) = lu(k,1974) - lu(k,1073) * lu(k,1956) + lu(k,1975) = lu(k,1975) - lu(k,1074) * lu(k,1956) + lu(k,1976) = lu(k,1976) - lu(k,1075) * lu(k,1956) + lu(k,1977) = lu(k,1977) - lu(k,1076) * lu(k,1956) + lu(k,1978) = lu(k,1978) - lu(k,1077) * lu(k,1956) + lu(k,1979) = lu(k,1979) - lu(k,1078) * lu(k,1956) + lu(k,2005) = lu(k,2005) - lu(k,1056) * lu(k,2004) + lu(k,2006) = lu(k,2006) - lu(k,1057) * lu(k,2004) + lu(k,2007) = lu(k,2007) - lu(k,1058) * lu(k,2004) + lu(k,2008) = lu(k,2008) - lu(k,1059) * lu(k,2004) + lu(k,2009) = lu(k,2009) - lu(k,1060) * lu(k,2004) + lu(k,2010) = lu(k,2010) - lu(k,1061) * lu(k,2004) + lu(k,2011) = lu(k,2011) - lu(k,1062) * lu(k,2004) + lu(k,2012) = lu(k,2012) - lu(k,1063) * lu(k,2004) + lu(k,2013) = lu(k,2013) - lu(k,1064) * lu(k,2004) + lu(k,2014) = lu(k,2014) - lu(k,1065) * lu(k,2004) + lu(k,2015) = lu(k,2015) - lu(k,1066) * lu(k,2004) + lu(k,2016) = lu(k,2016) - lu(k,1067) * lu(k,2004) + lu(k,2017) = lu(k,2017) - lu(k,1068) * lu(k,2004) + lu(k,2018) = lu(k,2018) - lu(k,1069) * lu(k,2004) + lu(k,2019) = lu(k,2019) - lu(k,1070) * lu(k,2004) + lu(k,2020) = lu(k,2020) - lu(k,1071) * lu(k,2004) + lu(k,2021) = lu(k,2021) - lu(k,1072) * lu(k,2004) + lu(k,2022) = lu(k,2022) - lu(k,1073) * lu(k,2004) + lu(k,2023) = lu(k,2023) - lu(k,1074) * lu(k,2004) + lu(k,2024) = lu(k,2024) - lu(k,1075) * lu(k,2004) + lu(k,2025) = lu(k,2025) - lu(k,1076) * lu(k,2004) + lu(k,2026) = lu(k,2026) - lu(k,1077) * lu(k,2004) + lu(k,2027) = lu(k,2027) - lu(k,1078) * lu(k,2004) + lu(k,2065) = lu(k,2065) - lu(k,1056) * lu(k,2064) + lu(k,2066) = lu(k,2066) - lu(k,1057) * lu(k,2064) + lu(k,2067) = lu(k,2067) - lu(k,1058) * lu(k,2064) + lu(k,2068) = lu(k,2068) - lu(k,1059) * lu(k,2064) + lu(k,2069) = lu(k,2069) - lu(k,1060) * lu(k,2064) + lu(k,2070) = lu(k,2070) - lu(k,1061) * lu(k,2064) + lu(k,2071) = lu(k,2071) - lu(k,1062) * lu(k,2064) + lu(k,2072) = lu(k,2072) - lu(k,1063) * lu(k,2064) + lu(k,2073) = lu(k,2073) - lu(k,1064) * lu(k,2064) + lu(k,2074) = lu(k,2074) - lu(k,1065) * lu(k,2064) + lu(k,2075) = lu(k,2075) - lu(k,1066) * lu(k,2064) + lu(k,2076) = lu(k,2076) - lu(k,1067) * lu(k,2064) + lu(k,2077) = lu(k,2077) - lu(k,1068) * lu(k,2064) + lu(k,2078) = lu(k,2078) - lu(k,1069) * lu(k,2064) + lu(k,2079) = lu(k,2079) - lu(k,1070) * lu(k,2064) + lu(k,2080) = lu(k,2080) - lu(k,1071) * lu(k,2064) + lu(k,2081) = lu(k,2081) - lu(k,1072) * lu(k,2064) + lu(k,2082) = lu(k,2082) - lu(k,1073) * lu(k,2064) + lu(k,2083) = lu(k,2083) - lu(k,1074) * lu(k,2064) + lu(k,2084) = lu(k,2084) - lu(k,1075) * lu(k,2064) + lu(k,2085) = lu(k,2085) - lu(k,1076) * lu(k,2064) + lu(k,2086) = lu(k,2086) - lu(k,1077) * lu(k,2064) + lu(k,2087) = lu(k,2087) - lu(k,1078) * lu(k,2064) end do end subroutine lu_fac21 subroutine lu_fac22( avec_len, lu ) @@ -11695,217 +10084,1794 @@ subroutine lu_fac22( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1252) = 1._r8 / lu(k,1252) - lu(k,1253) = lu(k,1253) * lu(k,1252) - lu(k,1254) = lu(k,1254) * lu(k,1252) - lu(k,1255) = lu(k,1255) * lu(k,1252) - lu(k,1256) = lu(k,1256) * lu(k,1252) - lu(k,1257) = lu(k,1257) * lu(k,1252) - lu(k,1258) = lu(k,1258) * lu(k,1252) - lu(k,1259) = lu(k,1259) * lu(k,1252) - lu(k,1260) = lu(k,1260) * lu(k,1252) - lu(k,1261) = lu(k,1261) * lu(k,1252) - lu(k,1262) = lu(k,1262) * lu(k,1252) - lu(k,1263) = lu(k,1263) * lu(k,1252) - lu(k,1264) = lu(k,1264) * lu(k,1252) - lu(k,1265) = lu(k,1265) * lu(k,1252) - lu(k,1266) = lu(k,1266) * lu(k,1252) - lu(k,1292) = lu(k,1292) - lu(k,1253) * lu(k,1291) - lu(k,1293) = lu(k,1293) - lu(k,1254) * lu(k,1291) - lu(k,1294) = lu(k,1294) - lu(k,1255) * lu(k,1291) - lu(k,1295) = lu(k,1295) - lu(k,1256) * lu(k,1291) - lu(k,1296) = lu(k,1296) - lu(k,1257) * lu(k,1291) - lu(k,1297) = lu(k,1297) - lu(k,1258) * lu(k,1291) - lu(k,1298) = lu(k,1298) - lu(k,1259) * lu(k,1291) - lu(k,1299) = lu(k,1299) - lu(k,1260) * lu(k,1291) - lu(k,1300) = lu(k,1300) - lu(k,1261) * lu(k,1291) - lu(k,1301) = lu(k,1301) - lu(k,1262) * lu(k,1291) - lu(k,1302) = lu(k,1302) - lu(k,1263) * lu(k,1291) - lu(k,1303) = lu(k,1303) - lu(k,1264) * lu(k,1291) - lu(k,1304) = lu(k,1304) - lu(k,1265) * lu(k,1291) - lu(k,1305) = lu(k,1305) - lu(k,1266) * lu(k,1291) - lu(k,1327) = lu(k,1327) - lu(k,1253) * lu(k,1326) - lu(k,1328) = lu(k,1328) - lu(k,1254) * lu(k,1326) - lu(k,1329) = lu(k,1329) - lu(k,1255) * lu(k,1326) - lu(k,1330) = lu(k,1330) - lu(k,1256) * lu(k,1326) - lu(k,1331) = lu(k,1331) - lu(k,1257) * lu(k,1326) - lu(k,1332) = lu(k,1332) - lu(k,1258) * lu(k,1326) - lu(k,1333) = lu(k,1333) - lu(k,1259) * lu(k,1326) - lu(k,1334) = lu(k,1334) - lu(k,1260) * lu(k,1326) - lu(k,1335) = lu(k,1335) - lu(k,1261) * lu(k,1326) - lu(k,1336) = lu(k,1336) - lu(k,1262) * lu(k,1326) - lu(k,1337) = lu(k,1337) - lu(k,1263) * lu(k,1326) - lu(k,1338) = lu(k,1338) - lu(k,1264) * lu(k,1326) - lu(k,1339) = lu(k,1339) - lu(k,1265) * lu(k,1326) - lu(k,1340) = lu(k,1340) - lu(k,1266) * lu(k,1326) - lu(k,1371) = lu(k,1371) - lu(k,1253) * lu(k,1370) - lu(k,1372) = lu(k,1372) - lu(k,1254) * lu(k,1370) - lu(k,1373) = lu(k,1373) - lu(k,1255) * lu(k,1370) - lu(k,1374) = lu(k,1374) - lu(k,1256) * lu(k,1370) - lu(k,1375) = lu(k,1375) - lu(k,1257) * lu(k,1370) - lu(k,1376) = lu(k,1376) - lu(k,1258) * lu(k,1370) - lu(k,1377) = lu(k,1377) - lu(k,1259) * lu(k,1370) - lu(k,1378) = lu(k,1378) - lu(k,1260) * lu(k,1370) - lu(k,1379) = lu(k,1379) - lu(k,1261) * lu(k,1370) - lu(k,1380) = lu(k,1380) - lu(k,1262) * lu(k,1370) - lu(k,1381) = lu(k,1381) - lu(k,1263) * lu(k,1370) - lu(k,1382) = lu(k,1382) - lu(k,1264) * lu(k,1370) - lu(k,1383) = lu(k,1383) - lu(k,1265) * lu(k,1370) - lu(k,1384) = lu(k,1384) - lu(k,1266) * lu(k,1370) - lu(k,1430) = lu(k,1430) - lu(k,1253) * lu(k,1429) - lu(k,1431) = lu(k,1431) - lu(k,1254) * lu(k,1429) - lu(k,1432) = lu(k,1432) - lu(k,1255) * lu(k,1429) - lu(k,1433) = lu(k,1433) - lu(k,1256) * lu(k,1429) - lu(k,1434) = lu(k,1434) - lu(k,1257) * lu(k,1429) - lu(k,1435) = lu(k,1435) - lu(k,1258) * lu(k,1429) - lu(k,1436) = lu(k,1436) - lu(k,1259) * lu(k,1429) - lu(k,1437) = lu(k,1437) - lu(k,1260) * lu(k,1429) - lu(k,1438) = lu(k,1438) - lu(k,1261) * lu(k,1429) - lu(k,1439) = lu(k,1439) - lu(k,1262) * lu(k,1429) - lu(k,1440) = lu(k,1440) - lu(k,1263) * lu(k,1429) - lu(k,1441) = lu(k,1441) - lu(k,1264) * lu(k,1429) - lu(k,1442) = lu(k,1442) - lu(k,1265) * lu(k,1429) - lu(k,1443) = lu(k,1443) - lu(k,1266) * lu(k,1429) - lu(k,1472) = lu(k,1472) - lu(k,1253) * lu(k,1471) - lu(k,1473) = lu(k,1473) - lu(k,1254) * lu(k,1471) - lu(k,1474) = lu(k,1474) - lu(k,1255) * lu(k,1471) - lu(k,1475) = lu(k,1475) - lu(k,1256) * lu(k,1471) - lu(k,1476) = lu(k,1476) - lu(k,1257) * lu(k,1471) - lu(k,1477) = lu(k,1477) - lu(k,1258) * lu(k,1471) - lu(k,1478) = lu(k,1478) - lu(k,1259) * lu(k,1471) - lu(k,1479) = lu(k,1479) - lu(k,1260) * lu(k,1471) - lu(k,1480) = lu(k,1480) - lu(k,1261) * lu(k,1471) - lu(k,1481) = lu(k,1481) - lu(k,1262) * lu(k,1471) - lu(k,1482) = lu(k,1482) - lu(k,1263) * lu(k,1471) - lu(k,1483) = lu(k,1483) - lu(k,1264) * lu(k,1471) - lu(k,1484) = lu(k,1484) - lu(k,1265) * lu(k,1471) - lu(k,1485) = lu(k,1485) - lu(k,1266) * lu(k,1471) - lu(k,1513) = lu(k,1513) - lu(k,1253) * lu(k,1512) - lu(k,1514) = lu(k,1514) - lu(k,1254) * lu(k,1512) - lu(k,1515) = lu(k,1515) - lu(k,1255) * lu(k,1512) - lu(k,1516) = lu(k,1516) - lu(k,1256) * lu(k,1512) - lu(k,1517) = lu(k,1517) - lu(k,1257) * lu(k,1512) - lu(k,1518) = lu(k,1518) - lu(k,1258) * lu(k,1512) - lu(k,1519) = lu(k,1519) - lu(k,1259) * lu(k,1512) - lu(k,1520) = lu(k,1520) - lu(k,1260) * lu(k,1512) - lu(k,1521) = lu(k,1521) - lu(k,1261) * lu(k,1512) - lu(k,1522) = lu(k,1522) - lu(k,1262) * lu(k,1512) - lu(k,1523) = lu(k,1523) - lu(k,1263) * lu(k,1512) - lu(k,1524) = lu(k,1524) - lu(k,1264) * lu(k,1512) - lu(k,1525) = lu(k,1525) - lu(k,1265) * lu(k,1512) - lu(k,1526) = lu(k,1526) - lu(k,1266) * lu(k,1512) - lu(k,1555) = lu(k,1555) - lu(k,1253) * lu(k,1554) - lu(k,1556) = lu(k,1556) - lu(k,1254) * lu(k,1554) - lu(k,1557) = lu(k,1557) - lu(k,1255) * lu(k,1554) - lu(k,1558) = lu(k,1558) - lu(k,1256) * lu(k,1554) - lu(k,1559) = lu(k,1559) - lu(k,1257) * lu(k,1554) - lu(k,1560) = lu(k,1560) - lu(k,1258) * lu(k,1554) - lu(k,1561) = lu(k,1561) - lu(k,1259) * lu(k,1554) - lu(k,1562) = lu(k,1562) - lu(k,1260) * lu(k,1554) - lu(k,1563) = lu(k,1563) - lu(k,1261) * lu(k,1554) - lu(k,1564) = lu(k,1564) - lu(k,1262) * lu(k,1554) - lu(k,1565) = lu(k,1565) - lu(k,1263) * lu(k,1554) - lu(k,1566) = lu(k,1566) - lu(k,1264) * lu(k,1554) - lu(k,1567) = lu(k,1567) - lu(k,1265) * lu(k,1554) - lu(k,1568) = lu(k,1568) - lu(k,1266) * lu(k,1554) - lu(k,1597) = lu(k,1597) - lu(k,1253) * lu(k,1596) - lu(k,1598) = lu(k,1598) - lu(k,1254) * lu(k,1596) - lu(k,1599) = lu(k,1599) - lu(k,1255) * lu(k,1596) - lu(k,1600) = lu(k,1600) - lu(k,1256) * lu(k,1596) - lu(k,1601) = lu(k,1601) - lu(k,1257) * lu(k,1596) - lu(k,1602) = lu(k,1602) - lu(k,1258) * lu(k,1596) - lu(k,1603) = lu(k,1603) - lu(k,1259) * lu(k,1596) - lu(k,1604) = lu(k,1604) - lu(k,1260) * lu(k,1596) - lu(k,1605) = lu(k,1605) - lu(k,1261) * lu(k,1596) - lu(k,1606) = lu(k,1606) - lu(k,1262) * lu(k,1596) - lu(k,1607) = lu(k,1607) - lu(k,1263) * lu(k,1596) - lu(k,1608) = lu(k,1608) - lu(k,1264) * lu(k,1596) - lu(k,1609) = lu(k,1609) - lu(k,1265) * lu(k,1596) - lu(k,1610) = lu(k,1610) - lu(k,1266) * lu(k,1596) - lu(k,1629) = lu(k,1629) - lu(k,1253) * lu(k,1628) - lu(k,1630) = lu(k,1630) - lu(k,1254) * lu(k,1628) - lu(k,1631) = lu(k,1631) - lu(k,1255) * lu(k,1628) - lu(k,1632) = lu(k,1632) - lu(k,1256) * lu(k,1628) - lu(k,1633) = lu(k,1633) - lu(k,1257) * lu(k,1628) - lu(k,1634) = lu(k,1634) - lu(k,1258) * lu(k,1628) - lu(k,1635) = lu(k,1635) - lu(k,1259) * lu(k,1628) - lu(k,1636) = lu(k,1636) - lu(k,1260) * lu(k,1628) - lu(k,1637) = lu(k,1637) - lu(k,1261) * lu(k,1628) - lu(k,1638) = lu(k,1638) - lu(k,1262) * lu(k,1628) - lu(k,1639) = lu(k,1639) - lu(k,1263) * lu(k,1628) - lu(k,1640) = lu(k,1640) - lu(k,1264) * lu(k,1628) - lu(k,1641) = lu(k,1641) - lu(k,1265) * lu(k,1628) - lu(k,1642) = lu(k,1642) - lu(k,1266) * lu(k,1628) - lu(k,1664) = lu(k,1664) - lu(k,1253) * lu(k,1663) - lu(k,1665) = lu(k,1665) - lu(k,1254) * lu(k,1663) - lu(k,1666) = lu(k,1666) - lu(k,1255) * lu(k,1663) - lu(k,1667) = lu(k,1667) - lu(k,1256) * lu(k,1663) - lu(k,1668) = lu(k,1668) - lu(k,1257) * lu(k,1663) - lu(k,1669) = lu(k,1669) - lu(k,1258) * lu(k,1663) - lu(k,1670) = lu(k,1670) - lu(k,1259) * lu(k,1663) - lu(k,1671) = lu(k,1671) - lu(k,1260) * lu(k,1663) - lu(k,1672) = lu(k,1672) - lu(k,1261) * lu(k,1663) - lu(k,1673) = lu(k,1673) - lu(k,1262) * lu(k,1663) - lu(k,1674) = lu(k,1674) - lu(k,1263) * lu(k,1663) - lu(k,1675) = lu(k,1675) - lu(k,1264) * lu(k,1663) - lu(k,1676) = lu(k,1676) - lu(k,1265) * lu(k,1663) - lu(k,1677) = lu(k,1677) - lu(k,1266) * lu(k,1663) - lu(k,1706) = lu(k,1706) - lu(k,1253) * lu(k,1705) - lu(k,1707) = lu(k,1707) - lu(k,1254) * lu(k,1705) - lu(k,1708) = lu(k,1708) - lu(k,1255) * lu(k,1705) - lu(k,1709) = lu(k,1709) - lu(k,1256) * lu(k,1705) - lu(k,1710) = lu(k,1710) - lu(k,1257) * lu(k,1705) - lu(k,1711) = lu(k,1711) - lu(k,1258) * lu(k,1705) - lu(k,1712) = lu(k,1712) - lu(k,1259) * lu(k,1705) - lu(k,1713) = lu(k,1713) - lu(k,1260) * lu(k,1705) - lu(k,1714) = lu(k,1714) - lu(k,1261) * lu(k,1705) - lu(k,1715) = lu(k,1715) - lu(k,1262) * lu(k,1705) - lu(k,1716) = lu(k,1716) - lu(k,1263) * lu(k,1705) - lu(k,1717) = lu(k,1717) - lu(k,1264) * lu(k,1705) - lu(k,1718) = lu(k,1718) - lu(k,1265) * lu(k,1705) - lu(k,1719) = lu(k,1719) - lu(k,1266) * lu(k,1705) - lu(k,1750) = lu(k,1750) - lu(k,1253) * lu(k,1749) - lu(k,1751) = lu(k,1751) - lu(k,1254) * lu(k,1749) - lu(k,1752) = lu(k,1752) - lu(k,1255) * lu(k,1749) - lu(k,1753) = lu(k,1753) - lu(k,1256) * lu(k,1749) - lu(k,1754) = lu(k,1754) - lu(k,1257) * lu(k,1749) - lu(k,1755) = lu(k,1755) - lu(k,1258) * lu(k,1749) - lu(k,1756) = lu(k,1756) - lu(k,1259) * lu(k,1749) - lu(k,1757) = lu(k,1757) - lu(k,1260) * lu(k,1749) - lu(k,1758) = lu(k,1758) - lu(k,1261) * lu(k,1749) - lu(k,1759) = lu(k,1759) - lu(k,1262) * lu(k,1749) - lu(k,1760) = lu(k,1760) - lu(k,1263) * lu(k,1749) - lu(k,1761) = lu(k,1761) - lu(k,1264) * lu(k,1749) - lu(k,1762) = lu(k,1762) - lu(k,1265) * lu(k,1749) - lu(k,1763) = lu(k,1763) - lu(k,1266) * lu(k,1749) - lu(k,1785) = lu(k,1785) - lu(k,1253) * lu(k,1784) - lu(k,1786) = lu(k,1786) - lu(k,1254) * lu(k,1784) - lu(k,1787) = lu(k,1787) - lu(k,1255) * lu(k,1784) - lu(k,1788) = lu(k,1788) - lu(k,1256) * lu(k,1784) - lu(k,1789) = lu(k,1789) - lu(k,1257) * lu(k,1784) - lu(k,1790) = lu(k,1790) - lu(k,1258) * lu(k,1784) - lu(k,1791) = lu(k,1791) - lu(k,1259) * lu(k,1784) - lu(k,1792) = lu(k,1792) - lu(k,1260) * lu(k,1784) - lu(k,1793) = lu(k,1793) - lu(k,1261) * lu(k,1784) - lu(k,1794) = lu(k,1794) - lu(k,1262) * lu(k,1784) - lu(k,1795) = lu(k,1795) - lu(k,1263) * lu(k,1784) - lu(k,1796) = lu(k,1796) - lu(k,1264) * lu(k,1784) - lu(k,1797) = lu(k,1797) - lu(k,1265) * lu(k,1784) - lu(k,1798) = lu(k,1798) - lu(k,1266) * lu(k,1784) - lu(k,1843) = lu(k,1843) - lu(k,1253) * lu(k,1842) - lu(k,1844) = lu(k,1844) - lu(k,1254) * lu(k,1842) - lu(k,1845) = lu(k,1845) - lu(k,1255) * lu(k,1842) - lu(k,1846) = lu(k,1846) - lu(k,1256) * lu(k,1842) - lu(k,1847) = lu(k,1847) - lu(k,1257) * lu(k,1842) - lu(k,1848) = lu(k,1848) - lu(k,1258) * lu(k,1842) - lu(k,1849) = lu(k,1849) - lu(k,1259) * lu(k,1842) - lu(k,1850) = lu(k,1850) - lu(k,1260) * lu(k,1842) - lu(k,1851) = lu(k,1851) - lu(k,1261) * lu(k,1842) - lu(k,1852) = lu(k,1852) - lu(k,1262) * lu(k,1842) - lu(k,1853) = lu(k,1853) - lu(k,1263) * lu(k,1842) - lu(k,1854) = lu(k,1854) - lu(k,1264) * lu(k,1842) - lu(k,1855) = lu(k,1855) - lu(k,1265) * lu(k,1842) - lu(k,1856) = lu(k,1856) - lu(k,1266) * lu(k,1842) + lu(k,1096) = 1._r8 / lu(k,1096) + lu(k,1097) = lu(k,1097) * lu(k,1096) + lu(k,1098) = lu(k,1098) * lu(k,1096) + lu(k,1099) = lu(k,1099) * lu(k,1096) + lu(k,1100) = lu(k,1100) * lu(k,1096) + lu(k,1101) = lu(k,1101) * lu(k,1096) + lu(k,1102) = lu(k,1102) * lu(k,1096) + lu(k,1103) = lu(k,1103) * lu(k,1096) + lu(k,1104) = lu(k,1104) * lu(k,1096) + lu(k,1105) = lu(k,1105) * lu(k,1096) + lu(k,1106) = lu(k,1106) * lu(k,1096) + lu(k,1107) = lu(k,1107) * lu(k,1096) + lu(k,1108) = lu(k,1108) * lu(k,1096) + lu(k,1109) = lu(k,1109) * lu(k,1096) + lu(k,1110) = lu(k,1110) * lu(k,1096) + lu(k,1111) = lu(k,1111) * lu(k,1096) + lu(k,1112) = lu(k,1112) * lu(k,1096) + lu(k,1113) = lu(k,1113) * lu(k,1096) + lu(k,1114) = lu(k,1114) * lu(k,1096) + lu(k,1115) = lu(k,1115) * lu(k,1096) + lu(k,1116) = lu(k,1116) * lu(k,1096) + lu(k,1117) = lu(k,1117) * lu(k,1096) + lu(k,1118) = lu(k,1118) * lu(k,1096) + lu(k,1145) = lu(k,1145) - lu(k,1097) * lu(k,1144) + lu(k,1146) = lu(k,1146) - lu(k,1098) * lu(k,1144) + lu(k,1147) = lu(k,1147) - lu(k,1099) * lu(k,1144) + lu(k,1148) = lu(k,1148) - lu(k,1100) * lu(k,1144) + lu(k,1149) = lu(k,1149) - lu(k,1101) * lu(k,1144) + lu(k,1150) = lu(k,1150) - lu(k,1102) * lu(k,1144) + lu(k,1151) = lu(k,1151) - lu(k,1103) * lu(k,1144) + lu(k,1152) = lu(k,1152) - lu(k,1104) * lu(k,1144) + lu(k,1153) = lu(k,1153) - lu(k,1105) * lu(k,1144) + lu(k,1154) = lu(k,1154) - lu(k,1106) * lu(k,1144) + lu(k,1155) = lu(k,1155) - lu(k,1107) * lu(k,1144) + lu(k,1156) = lu(k,1156) - lu(k,1108) * lu(k,1144) + lu(k,1157) = lu(k,1157) - lu(k,1109) * lu(k,1144) + lu(k,1158) = lu(k,1158) - lu(k,1110) * lu(k,1144) + lu(k,1159) = lu(k,1159) - lu(k,1111) * lu(k,1144) + lu(k,1160) = lu(k,1160) - lu(k,1112) * lu(k,1144) + lu(k,1161) = lu(k,1161) - lu(k,1113) * lu(k,1144) + lu(k,1162) = lu(k,1162) - lu(k,1114) * lu(k,1144) + lu(k,1163) = lu(k,1163) - lu(k,1115) * lu(k,1144) + lu(k,1164) = lu(k,1164) - lu(k,1116) * lu(k,1144) + lu(k,1165) = lu(k,1165) - lu(k,1117) * lu(k,1144) + lu(k,1166) = lu(k,1166) - lu(k,1118) * lu(k,1144) + lu(k,1188) = lu(k,1188) - lu(k,1097) * lu(k,1187) + lu(k,1189) = lu(k,1189) - lu(k,1098) * lu(k,1187) + lu(k,1190) = lu(k,1190) - lu(k,1099) * lu(k,1187) + lu(k,1191) = lu(k,1191) - lu(k,1100) * lu(k,1187) + lu(k,1192) = lu(k,1192) - lu(k,1101) * lu(k,1187) + lu(k,1193) = lu(k,1193) - lu(k,1102) * lu(k,1187) + lu(k,1194) = lu(k,1194) - lu(k,1103) * lu(k,1187) + lu(k,1195) = lu(k,1195) - lu(k,1104) * lu(k,1187) + lu(k,1196) = lu(k,1196) - lu(k,1105) * lu(k,1187) + lu(k,1197) = lu(k,1197) - lu(k,1106) * lu(k,1187) + lu(k,1198) = lu(k,1198) - lu(k,1107) * lu(k,1187) + lu(k,1199) = lu(k,1199) - lu(k,1108) * lu(k,1187) + lu(k,1200) = lu(k,1200) - lu(k,1109) * lu(k,1187) + lu(k,1201) = lu(k,1201) - lu(k,1110) * lu(k,1187) + lu(k,1202) = lu(k,1202) - lu(k,1111) * lu(k,1187) + lu(k,1203) = lu(k,1203) - lu(k,1112) * lu(k,1187) + lu(k,1204) = lu(k,1204) - lu(k,1113) * lu(k,1187) + lu(k,1205) = lu(k,1205) - lu(k,1114) * lu(k,1187) + lu(k,1206) = lu(k,1206) - lu(k,1115) * lu(k,1187) + lu(k,1207) = lu(k,1207) - lu(k,1116) * lu(k,1187) + lu(k,1208) = lu(k,1208) - lu(k,1117) * lu(k,1187) + lu(k,1209) = lu(k,1209) - lu(k,1118) * lu(k,1187) + lu(k,1229) = lu(k,1229) - lu(k,1097) * lu(k,1228) + lu(k,1230) = lu(k,1230) - lu(k,1098) * lu(k,1228) + lu(k,1231) = lu(k,1231) - lu(k,1099) * lu(k,1228) + lu(k,1232) = lu(k,1232) - lu(k,1100) * lu(k,1228) + lu(k,1233) = lu(k,1233) - lu(k,1101) * lu(k,1228) + lu(k,1234) = lu(k,1234) - lu(k,1102) * lu(k,1228) + lu(k,1235) = lu(k,1235) - lu(k,1103) * lu(k,1228) + lu(k,1236) = lu(k,1236) - lu(k,1104) * lu(k,1228) + lu(k,1237) = lu(k,1237) - lu(k,1105) * lu(k,1228) + lu(k,1238) = lu(k,1238) - lu(k,1106) * lu(k,1228) + lu(k,1239) = lu(k,1239) - lu(k,1107) * lu(k,1228) + lu(k,1240) = lu(k,1240) - lu(k,1108) * lu(k,1228) + lu(k,1241) = lu(k,1241) - lu(k,1109) * lu(k,1228) + lu(k,1242) = lu(k,1242) - lu(k,1110) * lu(k,1228) + lu(k,1243) = lu(k,1243) - lu(k,1111) * lu(k,1228) + lu(k,1244) = lu(k,1244) - lu(k,1112) * lu(k,1228) + lu(k,1245) = lu(k,1245) - lu(k,1113) * lu(k,1228) + lu(k,1246) = lu(k,1246) - lu(k,1114) * lu(k,1228) + lu(k,1247) = lu(k,1247) - lu(k,1115) * lu(k,1228) + lu(k,1248) = lu(k,1248) - lu(k,1116) * lu(k,1228) + lu(k,1249) = lu(k,1249) - lu(k,1117) * lu(k,1228) + lu(k,1250) = lu(k,1250) - lu(k,1118) * lu(k,1228) + lu(k,1289) = lu(k,1289) - lu(k,1097) * lu(k,1288) + lu(k,1290) = lu(k,1290) - lu(k,1098) * lu(k,1288) + lu(k,1291) = lu(k,1291) - lu(k,1099) * lu(k,1288) + lu(k,1292) = lu(k,1292) - lu(k,1100) * lu(k,1288) + lu(k,1293) = lu(k,1293) - lu(k,1101) * lu(k,1288) + lu(k,1294) = lu(k,1294) - lu(k,1102) * lu(k,1288) + lu(k,1295) = lu(k,1295) - lu(k,1103) * lu(k,1288) + lu(k,1296) = lu(k,1296) - lu(k,1104) * lu(k,1288) + lu(k,1297) = lu(k,1297) - lu(k,1105) * lu(k,1288) + lu(k,1298) = lu(k,1298) - lu(k,1106) * lu(k,1288) + lu(k,1299) = lu(k,1299) - lu(k,1107) * lu(k,1288) + lu(k,1300) = lu(k,1300) - lu(k,1108) * lu(k,1288) + lu(k,1301) = lu(k,1301) - lu(k,1109) * lu(k,1288) + lu(k,1302) = lu(k,1302) - lu(k,1110) * lu(k,1288) + lu(k,1303) = lu(k,1303) - lu(k,1111) * lu(k,1288) + lu(k,1304) = lu(k,1304) - lu(k,1112) * lu(k,1288) + lu(k,1305) = lu(k,1305) - lu(k,1113) * lu(k,1288) + lu(k,1306) = lu(k,1306) - lu(k,1114) * lu(k,1288) + lu(k,1307) = lu(k,1307) - lu(k,1115) * lu(k,1288) + lu(k,1308) = lu(k,1308) - lu(k,1116) * lu(k,1288) + lu(k,1309) = lu(k,1309) - lu(k,1117) * lu(k,1288) + lu(k,1310) = lu(k,1310) - lu(k,1118) * lu(k,1288) + lu(k,1331) = lu(k,1331) - lu(k,1097) * lu(k,1330) + lu(k,1332) = lu(k,1332) - lu(k,1098) * lu(k,1330) + lu(k,1333) = lu(k,1333) - lu(k,1099) * lu(k,1330) + lu(k,1334) = lu(k,1334) - lu(k,1100) * lu(k,1330) + lu(k,1335) = lu(k,1335) - lu(k,1101) * lu(k,1330) + lu(k,1336) = lu(k,1336) - lu(k,1102) * lu(k,1330) + lu(k,1337) = lu(k,1337) - lu(k,1103) * lu(k,1330) + lu(k,1338) = lu(k,1338) - lu(k,1104) * lu(k,1330) + lu(k,1339) = lu(k,1339) - lu(k,1105) * lu(k,1330) + lu(k,1340) = lu(k,1340) - lu(k,1106) * lu(k,1330) + lu(k,1341) = lu(k,1341) - lu(k,1107) * lu(k,1330) + lu(k,1342) = lu(k,1342) - lu(k,1108) * lu(k,1330) + lu(k,1343) = lu(k,1343) - lu(k,1109) * lu(k,1330) + lu(k,1344) = lu(k,1344) - lu(k,1110) * lu(k,1330) + lu(k,1345) = lu(k,1345) - lu(k,1111) * lu(k,1330) + lu(k,1346) = lu(k,1346) - lu(k,1112) * lu(k,1330) + lu(k,1347) = lu(k,1347) - lu(k,1113) * lu(k,1330) + lu(k,1348) = lu(k,1348) - lu(k,1114) * lu(k,1330) + lu(k,1349) = lu(k,1349) - lu(k,1115) * lu(k,1330) + lu(k,1350) = lu(k,1350) - lu(k,1116) * lu(k,1330) + lu(k,1351) = lu(k,1351) - lu(k,1117) * lu(k,1330) + lu(k,1352) = lu(k,1352) - lu(k,1118) * lu(k,1330) + lu(k,1367) = lu(k,1367) - lu(k,1097) * lu(k,1366) + lu(k,1368) = lu(k,1368) - lu(k,1098) * lu(k,1366) + lu(k,1369) = lu(k,1369) - lu(k,1099) * lu(k,1366) + lu(k,1370) = lu(k,1370) - lu(k,1100) * lu(k,1366) + lu(k,1371) = lu(k,1371) - lu(k,1101) * lu(k,1366) + lu(k,1372) = lu(k,1372) - lu(k,1102) * lu(k,1366) + lu(k,1373) = lu(k,1373) - lu(k,1103) * lu(k,1366) + lu(k,1374) = lu(k,1374) - lu(k,1104) * lu(k,1366) + lu(k,1375) = lu(k,1375) - lu(k,1105) * lu(k,1366) + lu(k,1376) = lu(k,1376) - lu(k,1106) * lu(k,1366) + lu(k,1377) = lu(k,1377) - lu(k,1107) * lu(k,1366) + lu(k,1378) = lu(k,1378) - lu(k,1108) * lu(k,1366) + lu(k,1379) = lu(k,1379) - lu(k,1109) * lu(k,1366) + lu(k,1380) = lu(k,1380) - lu(k,1110) * lu(k,1366) + lu(k,1381) = lu(k,1381) - lu(k,1111) * lu(k,1366) + lu(k,1382) = lu(k,1382) - lu(k,1112) * lu(k,1366) + lu(k,1383) = lu(k,1383) - lu(k,1113) * lu(k,1366) + lu(k,1384) = lu(k,1384) - lu(k,1114) * lu(k,1366) + lu(k,1385) = lu(k,1385) - lu(k,1115) * lu(k,1366) + lu(k,1386) = lu(k,1386) - lu(k,1116) * lu(k,1366) + lu(k,1387) = lu(k,1387) - lu(k,1117) * lu(k,1366) + lu(k,1388) = lu(k,1388) - lu(k,1118) * lu(k,1366) + lu(k,1410) = lu(k,1410) - lu(k,1097) * lu(k,1409) + lu(k,1411) = lu(k,1411) - lu(k,1098) * lu(k,1409) + lu(k,1412) = lu(k,1412) - lu(k,1099) * lu(k,1409) + lu(k,1413) = lu(k,1413) - lu(k,1100) * lu(k,1409) + lu(k,1414) = lu(k,1414) - lu(k,1101) * lu(k,1409) + lu(k,1415) = lu(k,1415) - lu(k,1102) * lu(k,1409) + lu(k,1416) = lu(k,1416) - lu(k,1103) * lu(k,1409) + lu(k,1417) = lu(k,1417) - lu(k,1104) * lu(k,1409) + lu(k,1418) = lu(k,1418) - lu(k,1105) * lu(k,1409) + lu(k,1419) = lu(k,1419) - lu(k,1106) * lu(k,1409) + lu(k,1420) = lu(k,1420) - lu(k,1107) * lu(k,1409) + lu(k,1421) = lu(k,1421) - lu(k,1108) * lu(k,1409) + lu(k,1422) = lu(k,1422) - lu(k,1109) * lu(k,1409) + lu(k,1423) = lu(k,1423) - lu(k,1110) * lu(k,1409) + lu(k,1424) = lu(k,1424) - lu(k,1111) * lu(k,1409) + lu(k,1425) = lu(k,1425) - lu(k,1112) * lu(k,1409) + lu(k,1426) = lu(k,1426) - lu(k,1113) * lu(k,1409) + lu(k,1427) = lu(k,1427) - lu(k,1114) * lu(k,1409) + lu(k,1428) = lu(k,1428) - lu(k,1115) * lu(k,1409) + lu(k,1429) = lu(k,1429) - lu(k,1116) * lu(k,1409) + lu(k,1430) = lu(k,1430) - lu(k,1117) * lu(k,1409) + lu(k,1431) = lu(k,1431) - lu(k,1118) * lu(k,1409) + lu(k,1453) = lu(k,1453) - lu(k,1097) * lu(k,1452) + lu(k,1454) = lu(k,1454) - lu(k,1098) * lu(k,1452) + lu(k,1455) = lu(k,1455) - lu(k,1099) * lu(k,1452) + lu(k,1456) = lu(k,1456) - lu(k,1100) * lu(k,1452) + lu(k,1457) = lu(k,1457) - lu(k,1101) * lu(k,1452) + lu(k,1458) = lu(k,1458) - lu(k,1102) * lu(k,1452) + lu(k,1459) = lu(k,1459) - lu(k,1103) * lu(k,1452) + lu(k,1460) = lu(k,1460) - lu(k,1104) * lu(k,1452) + lu(k,1461) = lu(k,1461) - lu(k,1105) * lu(k,1452) + lu(k,1462) = lu(k,1462) - lu(k,1106) * lu(k,1452) + lu(k,1463) = lu(k,1463) - lu(k,1107) * lu(k,1452) + lu(k,1464) = lu(k,1464) - lu(k,1108) * lu(k,1452) + lu(k,1465) = lu(k,1465) - lu(k,1109) * lu(k,1452) + lu(k,1466) = lu(k,1466) - lu(k,1110) * lu(k,1452) + lu(k,1467) = lu(k,1467) - lu(k,1111) * lu(k,1452) + lu(k,1468) = lu(k,1468) - lu(k,1112) * lu(k,1452) + lu(k,1469) = lu(k,1469) - lu(k,1113) * lu(k,1452) + lu(k,1470) = lu(k,1470) - lu(k,1114) * lu(k,1452) + lu(k,1471) = lu(k,1471) - lu(k,1115) * lu(k,1452) + lu(k,1472) = lu(k,1472) - lu(k,1116) * lu(k,1452) + lu(k,1473) = lu(k,1473) - lu(k,1117) * lu(k,1452) + lu(k,1474) = lu(k,1474) - lu(k,1118) * lu(k,1452) + lu(k,1498) = lu(k,1498) - lu(k,1097) * lu(k,1497) + lu(k,1499) = lu(k,1499) - lu(k,1098) * lu(k,1497) + lu(k,1500) = lu(k,1500) - lu(k,1099) * lu(k,1497) + lu(k,1501) = lu(k,1501) - lu(k,1100) * lu(k,1497) + lu(k,1502) = lu(k,1502) - lu(k,1101) * lu(k,1497) + lu(k,1503) = lu(k,1503) - lu(k,1102) * lu(k,1497) + lu(k,1504) = lu(k,1504) - lu(k,1103) * lu(k,1497) + lu(k,1505) = lu(k,1505) - lu(k,1104) * lu(k,1497) + lu(k,1506) = lu(k,1506) - lu(k,1105) * lu(k,1497) + lu(k,1507) = lu(k,1507) - lu(k,1106) * lu(k,1497) + lu(k,1508) = lu(k,1508) - lu(k,1107) * lu(k,1497) + lu(k,1509) = lu(k,1509) - lu(k,1108) * lu(k,1497) + lu(k,1510) = lu(k,1510) - lu(k,1109) * lu(k,1497) + lu(k,1511) = lu(k,1511) - lu(k,1110) * lu(k,1497) + lu(k,1512) = lu(k,1512) - lu(k,1111) * lu(k,1497) + lu(k,1513) = lu(k,1513) - lu(k,1112) * lu(k,1497) + lu(k,1514) = lu(k,1514) - lu(k,1113) * lu(k,1497) + lu(k,1515) = lu(k,1515) - lu(k,1114) * lu(k,1497) + lu(k,1516) = lu(k,1516) - lu(k,1115) * lu(k,1497) + lu(k,1517) = lu(k,1517) - lu(k,1116) * lu(k,1497) + lu(k,1518) = lu(k,1518) - lu(k,1117) * lu(k,1497) + lu(k,1519) = lu(k,1519) - lu(k,1118) * lu(k,1497) + lu(k,1534) = lu(k,1534) - lu(k,1097) * lu(k,1533) + lu(k,1535) = lu(k,1535) - lu(k,1098) * lu(k,1533) + lu(k,1536) = lu(k,1536) - lu(k,1099) * lu(k,1533) + lu(k,1537) = lu(k,1537) - lu(k,1100) * lu(k,1533) + lu(k,1538) = lu(k,1538) - lu(k,1101) * lu(k,1533) + lu(k,1539) = lu(k,1539) - lu(k,1102) * lu(k,1533) + lu(k,1540) = lu(k,1540) - lu(k,1103) * lu(k,1533) + lu(k,1541) = lu(k,1541) - lu(k,1104) * lu(k,1533) + lu(k,1542) = lu(k,1542) - lu(k,1105) * lu(k,1533) + lu(k,1543) = lu(k,1543) - lu(k,1106) * lu(k,1533) + lu(k,1544) = lu(k,1544) - lu(k,1107) * lu(k,1533) + lu(k,1545) = lu(k,1545) - lu(k,1108) * lu(k,1533) + lu(k,1546) = lu(k,1546) - lu(k,1109) * lu(k,1533) + lu(k,1547) = lu(k,1547) - lu(k,1110) * lu(k,1533) + lu(k,1548) = lu(k,1548) - lu(k,1111) * lu(k,1533) + lu(k,1549) = lu(k,1549) - lu(k,1112) * lu(k,1533) + lu(k,1550) = lu(k,1550) - lu(k,1113) * lu(k,1533) + lu(k,1551) = lu(k,1551) - lu(k,1114) * lu(k,1533) + lu(k,1552) = lu(k,1552) - lu(k,1115) * lu(k,1533) + lu(k,1553) = lu(k,1553) - lu(k,1116) * lu(k,1533) + lu(k,1554) = lu(k,1554) - lu(k,1117) * lu(k,1533) + lu(k,1555) = lu(k,1555) - lu(k,1118) * lu(k,1533) + lu(k,1579) = lu(k,1579) - lu(k,1097) * lu(k,1578) + lu(k,1580) = lu(k,1580) - lu(k,1098) * lu(k,1578) + lu(k,1581) = lu(k,1581) - lu(k,1099) * lu(k,1578) + lu(k,1582) = lu(k,1582) - lu(k,1100) * lu(k,1578) + lu(k,1583) = lu(k,1583) - lu(k,1101) * lu(k,1578) + lu(k,1584) = lu(k,1584) - lu(k,1102) * lu(k,1578) + lu(k,1585) = lu(k,1585) - lu(k,1103) * lu(k,1578) + lu(k,1586) = lu(k,1586) - lu(k,1104) * lu(k,1578) + lu(k,1587) = lu(k,1587) - lu(k,1105) * lu(k,1578) + lu(k,1588) = lu(k,1588) - lu(k,1106) * lu(k,1578) + lu(k,1589) = lu(k,1589) - lu(k,1107) * lu(k,1578) + lu(k,1590) = lu(k,1590) - lu(k,1108) * lu(k,1578) + lu(k,1591) = lu(k,1591) - lu(k,1109) * lu(k,1578) + lu(k,1592) = lu(k,1592) - lu(k,1110) * lu(k,1578) + lu(k,1593) = lu(k,1593) - lu(k,1111) * lu(k,1578) + lu(k,1594) = lu(k,1594) - lu(k,1112) * lu(k,1578) + lu(k,1595) = lu(k,1595) - lu(k,1113) * lu(k,1578) + lu(k,1596) = lu(k,1596) - lu(k,1114) * lu(k,1578) + lu(k,1597) = lu(k,1597) - lu(k,1115) * lu(k,1578) + lu(k,1598) = lu(k,1598) - lu(k,1116) * lu(k,1578) + lu(k,1599) = lu(k,1599) - lu(k,1117) * lu(k,1578) + lu(k,1600) = lu(k,1600) - lu(k,1118) * lu(k,1578) + lu(k,1627) = lu(k,1627) - lu(k,1097) * lu(k,1626) + lu(k,1628) = lu(k,1628) - lu(k,1098) * lu(k,1626) + lu(k,1629) = lu(k,1629) - lu(k,1099) * lu(k,1626) + lu(k,1630) = lu(k,1630) - lu(k,1100) * lu(k,1626) + lu(k,1631) = lu(k,1631) - lu(k,1101) * lu(k,1626) + lu(k,1632) = lu(k,1632) - lu(k,1102) * lu(k,1626) + lu(k,1633) = lu(k,1633) - lu(k,1103) * lu(k,1626) + lu(k,1634) = lu(k,1634) - lu(k,1104) * lu(k,1626) + lu(k,1635) = lu(k,1635) - lu(k,1105) * lu(k,1626) + lu(k,1636) = lu(k,1636) - lu(k,1106) * lu(k,1626) + lu(k,1637) = lu(k,1637) - lu(k,1107) * lu(k,1626) + lu(k,1638) = lu(k,1638) - lu(k,1108) * lu(k,1626) + lu(k,1639) = lu(k,1639) - lu(k,1109) * lu(k,1626) + lu(k,1640) = lu(k,1640) - lu(k,1110) * lu(k,1626) + lu(k,1641) = lu(k,1641) - lu(k,1111) * lu(k,1626) + lu(k,1642) = lu(k,1642) - lu(k,1112) * lu(k,1626) + lu(k,1643) = lu(k,1643) - lu(k,1113) * lu(k,1626) + lu(k,1644) = lu(k,1644) - lu(k,1114) * lu(k,1626) + lu(k,1645) = lu(k,1645) - lu(k,1115) * lu(k,1626) + lu(k,1646) = lu(k,1646) - lu(k,1116) * lu(k,1626) + lu(k,1647) = lu(k,1647) - lu(k,1117) * lu(k,1626) + lu(k,1648) = lu(k,1648) - lu(k,1118) * lu(k,1626) + lu(k,1670) = lu(k,1670) - lu(k,1097) * lu(k,1669) + lu(k,1671) = lu(k,1671) - lu(k,1098) * lu(k,1669) + lu(k,1672) = lu(k,1672) - lu(k,1099) * lu(k,1669) + lu(k,1673) = lu(k,1673) - lu(k,1100) * lu(k,1669) + lu(k,1674) = lu(k,1674) - lu(k,1101) * lu(k,1669) + lu(k,1675) = lu(k,1675) - lu(k,1102) * lu(k,1669) + lu(k,1676) = lu(k,1676) - lu(k,1103) * lu(k,1669) + lu(k,1677) = lu(k,1677) - lu(k,1104) * lu(k,1669) + lu(k,1678) = lu(k,1678) - lu(k,1105) * lu(k,1669) + lu(k,1679) = lu(k,1679) - lu(k,1106) * lu(k,1669) + lu(k,1680) = lu(k,1680) - lu(k,1107) * lu(k,1669) + lu(k,1681) = lu(k,1681) - lu(k,1108) * lu(k,1669) + lu(k,1682) = lu(k,1682) - lu(k,1109) * lu(k,1669) + lu(k,1683) = lu(k,1683) - lu(k,1110) * lu(k,1669) + lu(k,1684) = lu(k,1684) - lu(k,1111) * lu(k,1669) + lu(k,1685) = lu(k,1685) - lu(k,1112) * lu(k,1669) + lu(k,1686) = lu(k,1686) - lu(k,1113) * lu(k,1669) + lu(k,1687) = lu(k,1687) - lu(k,1114) * lu(k,1669) + lu(k,1688) = lu(k,1688) - lu(k,1115) * lu(k,1669) + lu(k,1689) = lu(k,1689) - lu(k,1116) * lu(k,1669) + lu(k,1690) = lu(k,1690) - lu(k,1117) * lu(k,1669) + lu(k,1691) = lu(k,1691) - lu(k,1118) * lu(k,1669) + lu(k,1712) = lu(k,1712) - lu(k,1097) * lu(k,1711) + lu(k,1713) = lu(k,1713) - lu(k,1098) * lu(k,1711) + lu(k,1714) = lu(k,1714) - lu(k,1099) * lu(k,1711) + lu(k,1715) = lu(k,1715) - lu(k,1100) * lu(k,1711) + lu(k,1716) = lu(k,1716) - lu(k,1101) * lu(k,1711) + lu(k,1717) = lu(k,1717) - lu(k,1102) * lu(k,1711) + lu(k,1718) = lu(k,1718) - lu(k,1103) * lu(k,1711) + lu(k,1719) = lu(k,1719) - lu(k,1104) * lu(k,1711) + lu(k,1720) = lu(k,1720) - lu(k,1105) * lu(k,1711) + lu(k,1721) = lu(k,1721) - lu(k,1106) * lu(k,1711) + lu(k,1722) = lu(k,1722) - lu(k,1107) * lu(k,1711) + lu(k,1723) = lu(k,1723) - lu(k,1108) * lu(k,1711) + lu(k,1724) = lu(k,1724) - lu(k,1109) * lu(k,1711) + lu(k,1725) = lu(k,1725) - lu(k,1110) * lu(k,1711) + lu(k,1726) = lu(k,1726) - lu(k,1111) * lu(k,1711) + lu(k,1727) = lu(k,1727) - lu(k,1112) * lu(k,1711) + lu(k,1728) = lu(k,1728) - lu(k,1113) * lu(k,1711) + lu(k,1729) = lu(k,1729) - lu(k,1114) * lu(k,1711) + lu(k,1730) = lu(k,1730) - lu(k,1115) * lu(k,1711) + lu(k,1731) = lu(k,1731) - lu(k,1116) * lu(k,1711) + lu(k,1732) = lu(k,1732) - lu(k,1117) * lu(k,1711) + lu(k,1733) = lu(k,1733) - lu(k,1118) * lu(k,1711) + lu(k,1757) = lu(k,1757) - lu(k,1097) * lu(k,1756) + lu(k,1758) = lu(k,1758) - lu(k,1098) * lu(k,1756) + lu(k,1759) = lu(k,1759) - lu(k,1099) * lu(k,1756) + lu(k,1760) = lu(k,1760) - lu(k,1100) * lu(k,1756) + lu(k,1761) = lu(k,1761) - lu(k,1101) * lu(k,1756) + lu(k,1762) = lu(k,1762) - lu(k,1102) * lu(k,1756) + lu(k,1763) = lu(k,1763) - lu(k,1103) * lu(k,1756) + lu(k,1764) = lu(k,1764) - lu(k,1104) * lu(k,1756) + lu(k,1765) = lu(k,1765) - lu(k,1105) * lu(k,1756) + lu(k,1766) = lu(k,1766) - lu(k,1106) * lu(k,1756) + lu(k,1767) = lu(k,1767) - lu(k,1107) * lu(k,1756) + lu(k,1768) = lu(k,1768) - lu(k,1108) * lu(k,1756) + lu(k,1769) = lu(k,1769) - lu(k,1109) * lu(k,1756) + lu(k,1770) = lu(k,1770) - lu(k,1110) * lu(k,1756) + lu(k,1771) = lu(k,1771) - lu(k,1111) * lu(k,1756) + lu(k,1772) = lu(k,1772) - lu(k,1112) * lu(k,1756) + lu(k,1773) = lu(k,1773) - lu(k,1113) * lu(k,1756) + lu(k,1774) = lu(k,1774) - lu(k,1114) * lu(k,1756) + lu(k,1775) = lu(k,1775) - lu(k,1115) * lu(k,1756) + lu(k,1776) = lu(k,1776) - lu(k,1116) * lu(k,1756) + lu(k,1777) = lu(k,1777) - lu(k,1117) * lu(k,1756) + lu(k,1778) = lu(k,1778) - lu(k,1118) * lu(k,1756) + lu(k,1806) = lu(k,1806) - lu(k,1097) * lu(k,1805) + lu(k,1807) = lu(k,1807) - lu(k,1098) * lu(k,1805) + lu(k,1808) = lu(k,1808) - lu(k,1099) * lu(k,1805) + lu(k,1809) = lu(k,1809) - lu(k,1100) * lu(k,1805) + lu(k,1810) = lu(k,1810) - lu(k,1101) * lu(k,1805) + lu(k,1811) = lu(k,1811) - lu(k,1102) * lu(k,1805) + lu(k,1812) = lu(k,1812) - lu(k,1103) * lu(k,1805) + lu(k,1813) = lu(k,1813) - lu(k,1104) * lu(k,1805) + lu(k,1814) = lu(k,1814) - lu(k,1105) * lu(k,1805) + lu(k,1815) = lu(k,1815) - lu(k,1106) * lu(k,1805) + lu(k,1816) = lu(k,1816) - lu(k,1107) * lu(k,1805) + lu(k,1817) = lu(k,1817) - lu(k,1108) * lu(k,1805) + lu(k,1818) = lu(k,1818) - lu(k,1109) * lu(k,1805) + lu(k,1819) = lu(k,1819) - lu(k,1110) * lu(k,1805) + lu(k,1820) = lu(k,1820) - lu(k,1111) * lu(k,1805) + lu(k,1821) = lu(k,1821) - lu(k,1112) * lu(k,1805) + lu(k,1822) = lu(k,1822) - lu(k,1113) * lu(k,1805) + lu(k,1823) = lu(k,1823) - lu(k,1114) * lu(k,1805) + lu(k,1824) = lu(k,1824) - lu(k,1115) * lu(k,1805) + lu(k,1825) = lu(k,1825) - lu(k,1116) * lu(k,1805) + lu(k,1826) = lu(k,1826) - lu(k,1117) * lu(k,1805) + lu(k,1827) = lu(k,1827) - lu(k,1118) * lu(k,1805) + lu(k,1839) = lu(k,1839) - lu(k,1097) * lu(k,1838) + lu(k,1840) = lu(k,1840) - lu(k,1098) * lu(k,1838) + lu(k,1841) = lu(k,1841) - lu(k,1099) * lu(k,1838) + lu(k,1842) = lu(k,1842) - lu(k,1100) * lu(k,1838) + lu(k,1843) = lu(k,1843) - lu(k,1101) * lu(k,1838) + lu(k,1844) = lu(k,1844) - lu(k,1102) * lu(k,1838) + lu(k,1845) = lu(k,1845) - lu(k,1103) * lu(k,1838) + lu(k,1846) = lu(k,1846) - lu(k,1104) * lu(k,1838) + lu(k,1847) = lu(k,1847) - lu(k,1105) * lu(k,1838) + lu(k,1848) = lu(k,1848) - lu(k,1106) * lu(k,1838) + lu(k,1849) = lu(k,1849) - lu(k,1107) * lu(k,1838) + lu(k,1850) = lu(k,1850) - lu(k,1108) * lu(k,1838) + lu(k,1851) = lu(k,1851) - lu(k,1109) * lu(k,1838) + lu(k,1852) = lu(k,1852) - lu(k,1110) * lu(k,1838) + lu(k,1853) = lu(k,1853) - lu(k,1111) * lu(k,1838) + lu(k,1854) = lu(k,1854) - lu(k,1112) * lu(k,1838) + lu(k,1855) = lu(k,1855) - lu(k,1113) * lu(k,1838) + lu(k,1856) = lu(k,1856) - lu(k,1114) * lu(k,1838) + lu(k,1857) = lu(k,1857) - lu(k,1115) * lu(k,1838) + lu(k,1858) = lu(k,1858) - lu(k,1116) * lu(k,1838) + lu(k,1859) = lu(k,1859) - lu(k,1117) * lu(k,1838) + lu(k,1860) = lu(k,1860) - lu(k,1118) * lu(k,1838) + lu(k,1875) = lu(k,1875) - lu(k,1097) * lu(k,1874) + lu(k,1876) = lu(k,1876) - lu(k,1098) * lu(k,1874) + lu(k,1877) = lu(k,1877) - lu(k,1099) * lu(k,1874) + lu(k,1878) = lu(k,1878) - lu(k,1100) * lu(k,1874) + lu(k,1879) = lu(k,1879) - lu(k,1101) * lu(k,1874) + lu(k,1880) = lu(k,1880) - lu(k,1102) * lu(k,1874) + lu(k,1881) = lu(k,1881) - lu(k,1103) * lu(k,1874) + lu(k,1882) = lu(k,1882) - lu(k,1104) * lu(k,1874) + lu(k,1883) = lu(k,1883) - lu(k,1105) * lu(k,1874) + lu(k,1884) = lu(k,1884) - lu(k,1106) * lu(k,1874) + lu(k,1885) = lu(k,1885) - lu(k,1107) * lu(k,1874) + lu(k,1886) = lu(k,1886) - lu(k,1108) * lu(k,1874) + lu(k,1887) = lu(k,1887) - lu(k,1109) * lu(k,1874) + lu(k,1888) = lu(k,1888) - lu(k,1110) * lu(k,1874) + lu(k,1889) = lu(k,1889) - lu(k,1111) * lu(k,1874) + lu(k,1890) = lu(k,1890) - lu(k,1112) * lu(k,1874) + lu(k,1891) = lu(k,1891) - lu(k,1113) * lu(k,1874) + lu(k,1892) = lu(k,1892) - lu(k,1114) * lu(k,1874) + lu(k,1893) = lu(k,1893) - lu(k,1115) * lu(k,1874) + lu(k,1894) = lu(k,1894) - lu(k,1116) * lu(k,1874) + lu(k,1895) = lu(k,1895) - lu(k,1117) * lu(k,1874) + lu(k,1896) = lu(k,1896) - lu(k,1118) * lu(k,1874) + lu(k,1916) = lu(k,1916) - lu(k,1097) * lu(k,1915) + lu(k,1917) = lu(k,1917) - lu(k,1098) * lu(k,1915) + lu(k,1918) = lu(k,1918) - lu(k,1099) * lu(k,1915) + lu(k,1919) = lu(k,1919) - lu(k,1100) * lu(k,1915) + lu(k,1920) = lu(k,1920) - lu(k,1101) * lu(k,1915) + lu(k,1921) = lu(k,1921) - lu(k,1102) * lu(k,1915) + lu(k,1922) = lu(k,1922) - lu(k,1103) * lu(k,1915) + lu(k,1923) = lu(k,1923) - lu(k,1104) * lu(k,1915) + lu(k,1924) = lu(k,1924) - lu(k,1105) * lu(k,1915) + lu(k,1925) = lu(k,1925) - lu(k,1106) * lu(k,1915) + lu(k,1926) = lu(k,1926) - lu(k,1107) * lu(k,1915) + lu(k,1927) = lu(k,1927) - lu(k,1108) * lu(k,1915) + lu(k,1928) = lu(k,1928) - lu(k,1109) * lu(k,1915) + lu(k,1929) = lu(k,1929) - lu(k,1110) * lu(k,1915) + lu(k,1930) = lu(k,1930) - lu(k,1111) * lu(k,1915) + lu(k,1931) = lu(k,1931) - lu(k,1112) * lu(k,1915) + lu(k,1932) = lu(k,1932) - lu(k,1113) * lu(k,1915) + lu(k,1933) = lu(k,1933) - lu(k,1114) * lu(k,1915) + lu(k,1934) = lu(k,1934) - lu(k,1115) * lu(k,1915) + lu(k,1935) = lu(k,1935) - lu(k,1116) * lu(k,1915) + lu(k,1936) = lu(k,1936) - lu(k,1117) * lu(k,1915) + lu(k,1937) = lu(k,1937) - lu(k,1118) * lu(k,1915) + lu(k,1958) = lu(k,1958) - lu(k,1097) * lu(k,1957) + lu(k,1959) = lu(k,1959) - lu(k,1098) * lu(k,1957) + lu(k,1960) = lu(k,1960) - lu(k,1099) * lu(k,1957) + lu(k,1961) = lu(k,1961) - lu(k,1100) * lu(k,1957) + lu(k,1962) = lu(k,1962) - lu(k,1101) * lu(k,1957) + lu(k,1963) = lu(k,1963) - lu(k,1102) * lu(k,1957) + lu(k,1964) = lu(k,1964) - lu(k,1103) * lu(k,1957) + lu(k,1965) = lu(k,1965) - lu(k,1104) * lu(k,1957) + lu(k,1966) = lu(k,1966) - lu(k,1105) * lu(k,1957) + lu(k,1967) = lu(k,1967) - lu(k,1106) * lu(k,1957) + lu(k,1968) = lu(k,1968) - lu(k,1107) * lu(k,1957) + lu(k,1969) = lu(k,1969) - lu(k,1108) * lu(k,1957) + lu(k,1970) = lu(k,1970) - lu(k,1109) * lu(k,1957) + lu(k,1971) = lu(k,1971) - lu(k,1110) * lu(k,1957) + lu(k,1972) = lu(k,1972) - lu(k,1111) * lu(k,1957) + lu(k,1973) = lu(k,1973) - lu(k,1112) * lu(k,1957) + lu(k,1974) = lu(k,1974) - lu(k,1113) * lu(k,1957) + lu(k,1975) = lu(k,1975) - lu(k,1114) * lu(k,1957) + lu(k,1976) = lu(k,1976) - lu(k,1115) * lu(k,1957) + lu(k,1977) = lu(k,1977) - lu(k,1116) * lu(k,1957) + lu(k,1978) = lu(k,1978) - lu(k,1117) * lu(k,1957) + lu(k,1979) = lu(k,1979) - lu(k,1118) * lu(k,1957) + lu(k,2006) = lu(k,2006) - lu(k,1097) * lu(k,2005) + lu(k,2007) = lu(k,2007) - lu(k,1098) * lu(k,2005) + lu(k,2008) = lu(k,2008) - lu(k,1099) * lu(k,2005) + lu(k,2009) = lu(k,2009) - lu(k,1100) * lu(k,2005) + lu(k,2010) = lu(k,2010) - lu(k,1101) * lu(k,2005) + lu(k,2011) = lu(k,2011) - lu(k,1102) * lu(k,2005) + lu(k,2012) = lu(k,2012) - lu(k,1103) * lu(k,2005) + lu(k,2013) = lu(k,2013) - lu(k,1104) * lu(k,2005) + lu(k,2014) = lu(k,2014) - lu(k,1105) * lu(k,2005) + lu(k,2015) = lu(k,2015) - lu(k,1106) * lu(k,2005) + lu(k,2016) = lu(k,2016) - lu(k,1107) * lu(k,2005) + lu(k,2017) = lu(k,2017) - lu(k,1108) * lu(k,2005) + lu(k,2018) = lu(k,2018) - lu(k,1109) * lu(k,2005) + lu(k,2019) = lu(k,2019) - lu(k,1110) * lu(k,2005) + lu(k,2020) = lu(k,2020) - lu(k,1111) * lu(k,2005) + lu(k,2021) = lu(k,2021) - lu(k,1112) * lu(k,2005) + lu(k,2022) = lu(k,2022) - lu(k,1113) * lu(k,2005) + lu(k,2023) = lu(k,2023) - lu(k,1114) * lu(k,2005) + lu(k,2024) = lu(k,2024) - lu(k,1115) * lu(k,2005) + lu(k,2025) = lu(k,2025) - lu(k,1116) * lu(k,2005) + lu(k,2026) = lu(k,2026) - lu(k,1117) * lu(k,2005) + lu(k,2027) = lu(k,2027) - lu(k,1118) * lu(k,2005) + lu(k,2066) = lu(k,2066) - lu(k,1097) * lu(k,2065) + lu(k,2067) = lu(k,2067) - lu(k,1098) * lu(k,2065) + lu(k,2068) = lu(k,2068) - lu(k,1099) * lu(k,2065) + lu(k,2069) = lu(k,2069) - lu(k,1100) * lu(k,2065) + lu(k,2070) = lu(k,2070) - lu(k,1101) * lu(k,2065) + lu(k,2071) = lu(k,2071) - lu(k,1102) * lu(k,2065) + lu(k,2072) = lu(k,2072) - lu(k,1103) * lu(k,2065) + lu(k,2073) = lu(k,2073) - lu(k,1104) * lu(k,2065) + lu(k,2074) = lu(k,2074) - lu(k,1105) * lu(k,2065) + lu(k,2075) = lu(k,2075) - lu(k,1106) * lu(k,2065) + lu(k,2076) = lu(k,2076) - lu(k,1107) * lu(k,2065) + lu(k,2077) = lu(k,2077) - lu(k,1108) * lu(k,2065) + lu(k,2078) = lu(k,2078) - lu(k,1109) * lu(k,2065) + lu(k,2079) = lu(k,2079) - lu(k,1110) * lu(k,2065) + lu(k,2080) = lu(k,2080) - lu(k,1111) * lu(k,2065) + lu(k,2081) = lu(k,2081) - lu(k,1112) * lu(k,2065) + lu(k,2082) = lu(k,2082) - lu(k,1113) * lu(k,2065) + lu(k,2083) = lu(k,2083) - lu(k,1114) * lu(k,2065) + lu(k,2084) = lu(k,2084) - lu(k,1115) * lu(k,2065) + lu(k,2085) = lu(k,2085) - lu(k,1116) * lu(k,2065) + lu(k,2086) = lu(k,2086) - lu(k,1117) * lu(k,2065) + lu(k,2087) = lu(k,2087) - lu(k,1118) * lu(k,2065) + lu(k,1145) = 1._r8 / lu(k,1145) + lu(k,1146) = lu(k,1146) * lu(k,1145) + lu(k,1147) = lu(k,1147) * lu(k,1145) + lu(k,1148) = lu(k,1148) * lu(k,1145) + lu(k,1149) = lu(k,1149) * lu(k,1145) + lu(k,1150) = lu(k,1150) * lu(k,1145) + lu(k,1151) = lu(k,1151) * lu(k,1145) + lu(k,1152) = lu(k,1152) * lu(k,1145) + lu(k,1153) = lu(k,1153) * lu(k,1145) + lu(k,1154) = lu(k,1154) * lu(k,1145) + lu(k,1155) = lu(k,1155) * lu(k,1145) + lu(k,1156) = lu(k,1156) * lu(k,1145) + lu(k,1157) = lu(k,1157) * lu(k,1145) + lu(k,1158) = lu(k,1158) * lu(k,1145) + lu(k,1159) = lu(k,1159) * lu(k,1145) + lu(k,1160) = lu(k,1160) * lu(k,1145) + lu(k,1161) = lu(k,1161) * lu(k,1145) + lu(k,1162) = lu(k,1162) * lu(k,1145) + lu(k,1163) = lu(k,1163) * lu(k,1145) + lu(k,1164) = lu(k,1164) * lu(k,1145) + lu(k,1165) = lu(k,1165) * lu(k,1145) + lu(k,1166) = lu(k,1166) * lu(k,1145) + lu(k,1189) = lu(k,1189) - lu(k,1146) * lu(k,1188) + lu(k,1190) = lu(k,1190) - lu(k,1147) * lu(k,1188) + lu(k,1191) = lu(k,1191) - lu(k,1148) * lu(k,1188) + lu(k,1192) = lu(k,1192) - lu(k,1149) * lu(k,1188) + lu(k,1193) = lu(k,1193) - lu(k,1150) * lu(k,1188) + lu(k,1194) = lu(k,1194) - lu(k,1151) * lu(k,1188) + lu(k,1195) = lu(k,1195) - lu(k,1152) * lu(k,1188) + lu(k,1196) = lu(k,1196) - lu(k,1153) * lu(k,1188) + lu(k,1197) = lu(k,1197) - lu(k,1154) * lu(k,1188) + lu(k,1198) = lu(k,1198) - lu(k,1155) * lu(k,1188) + lu(k,1199) = lu(k,1199) - lu(k,1156) * lu(k,1188) + lu(k,1200) = lu(k,1200) - lu(k,1157) * lu(k,1188) + lu(k,1201) = lu(k,1201) - lu(k,1158) * lu(k,1188) + lu(k,1202) = lu(k,1202) - lu(k,1159) * lu(k,1188) + lu(k,1203) = lu(k,1203) - lu(k,1160) * lu(k,1188) + lu(k,1204) = lu(k,1204) - lu(k,1161) * lu(k,1188) + lu(k,1205) = lu(k,1205) - lu(k,1162) * lu(k,1188) + lu(k,1206) = lu(k,1206) - lu(k,1163) * lu(k,1188) + lu(k,1207) = lu(k,1207) - lu(k,1164) * lu(k,1188) + lu(k,1208) = lu(k,1208) - lu(k,1165) * lu(k,1188) + lu(k,1209) = lu(k,1209) - lu(k,1166) * lu(k,1188) + lu(k,1230) = lu(k,1230) - lu(k,1146) * lu(k,1229) + lu(k,1231) = lu(k,1231) - lu(k,1147) * lu(k,1229) + lu(k,1232) = lu(k,1232) - lu(k,1148) * lu(k,1229) + lu(k,1233) = lu(k,1233) - lu(k,1149) * lu(k,1229) + lu(k,1234) = lu(k,1234) - lu(k,1150) * lu(k,1229) + lu(k,1235) = lu(k,1235) - lu(k,1151) * lu(k,1229) + lu(k,1236) = lu(k,1236) - lu(k,1152) * lu(k,1229) + lu(k,1237) = lu(k,1237) - lu(k,1153) * lu(k,1229) + lu(k,1238) = lu(k,1238) - lu(k,1154) * lu(k,1229) + lu(k,1239) = lu(k,1239) - lu(k,1155) * lu(k,1229) + lu(k,1240) = lu(k,1240) - lu(k,1156) * lu(k,1229) + lu(k,1241) = lu(k,1241) - lu(k,1157) * lu(k,1229) + lu(k,1242) = lu(k,1242) - lu(k,1158) * lu(k,1229) + lu(k,1243) = lu(k,1243) - lu(k,1159) * lu(k,1229) + lu(k,1244) = lu(k,1244) - lu(k,1160) * lu(k,1229) + lu(k,1245) = lu(k,1245) - lu(k,1161) * lu(k,1229) + lu(k,1246) = lu(k,1246) - lu(k,1162) * lu(k,1229) + lu(k,1247) = lu(k,1247) - lu(k,1163) * lu(k,1229) + lu(k,1248) = lu(k,1248) - lu(k,1164) * lu(k,1229) + lu(k,1249) = lu(k,1249) - lu(k,1165) * lu(k,1229) + lu(k,1250) = lu(k,1250) - lu(k,1166) * lu(k,1229) + lu(k,1290) = lu(k,1290) - lu(k,1146) * lu(k,1289) + lu(k,1291) = lu(k,1291) - lu(k,1147) * lu(k,1289) + lu(k,1292) = lu(k,1292) - lu(k,1148) * lu(k,1289) + lu(k,1293) = lu(k,1293) - lu(k,1149) * lu(k,1289) + lu(k,1294) = lu(k,1294) - lu(k,1150) * lu(k,1289) + lu(k,1295) = lu(k,1295) - lu(k,1151) * lu(k,1289) + lu(k,1296) = lu(k,1296) - lu(k,1152) * lu(k,1289) + lu(k,1297) = lu(k,1297) - lu(k,1153) * lu(k,1289) + lu(k,1298) = lu(k,1298) - lu(k,1154) * lu(k,1289) + lu(k,1299) = lu(k,1299) - lu(k,1155) * lu(k,1289) + lu(k,1300) = lu(k,1300) - lu(k,1156) * lu(k,1289) + lu(k,1301) = lu(k,1301) - lu(k,1157) * lu(k,1289) + lu(k,1302) = lu(k,1302) - lu(k,1158) * lu(k,1289) + lu(k,1303) = lu(k,1303) - lu(k,1159) * lu(k,1289) + lu(k,1304) = lu(k,1304) - lu(k,1160) * lu(k,1289) + lu(k,1305) = lu(k,1305) - lu(k,1161) * lu(k,1289) + lu(k,1306) = lu(k,1306) - lu(k,1162) * lu(k,1289) + lu(k,1307) = lu(k,1307) - lu(k,1163) * lu(k,1289) + lu(k,1308) = lu(k,1308) - lu(k,1164) * lu(k,1289) + lu(k,1309) = lu(k,1309) - lu(k,1165) * lu(k,1289) + lu(k,1310) = lu(k,1310) - lu(k,1166) * lu(k,1289) + lu(k,1332) = lu(k,1332) - lu(k,1146) * lu(k,1331) + lu(k,1333) = lu(k,1333) - lu(k,1147) * lu(k,1331) + lu(k,1334) = lu(k,1334) - lu(k,1148) * lu(k,1331) + lu(k,1335) = lu(k,1335) - lu(k,1149) * lu(k,1331) + lu(k,1336) = lu(k,1336) - lu(k,1150) * lu(k,1331) + lu(k,1337) = lu(k,1337) - lu(k,1151) * lu(k,1331) + lu(k,1338) = lu(k,1338) - lu(k,1152) * lu(k,1331) + lu(k,1339) = lu(k,1339) - lu(k,1153) * lu(k,1331) + lu(k,1340) = lu(k,1340) - lu(k,1154) * lu(k,1331) + lu(k,1341) = lu(k,1341) - lu(k,1155) * lu(k,1331) + lu(k,1342) = lu(k,1342) - lu(k,1156) * lu(k,1331) + lu(k,1343) = lu(k,1343) - lu(k,1157) * lu(k,1331) + lu(k,1344) = lu(k,1344) - lu(k,1158) * lu(k,1331) + lu(k,1345) = lu(k,1345) - lu(k,1159) * lu(k,1331) + lu(k,1346) = lu(k,1346) - lu(k,1160) * lu(k,1331) + lu(k,1347) = lu(k,1347) - lu(k,1161) * lu(k,1331) + lu(k,1348) = lu(k,1348) - lu(k,1162) * lu(k,1331) + lu(k,1349) = lu(k,1349) - lu(k,1163) * lu(k,1331) + lu(k,1350) = lu(k,1350) - lu(k,1164) * lu(k,1331) + lu(k,1351) = lu(k,1351) - lu(k,1165) * lu(k,1331) + lu(k,1352) = lu(k,1352) - lu(k,1166) * lu(k,1331) + lu(k,1368) = lu(k,1368) - lu(k,1146) * lu(k,1367) + lu(k,1369) = lu(k,1369) - lu(k,1147) * lu(k,1367) + lu(k,1370) = lu(k,1370) - lu(k,1148) * lu(k,1367) + lu(k,1371) = lu(k,1371) - lu(k,1149) * lu(k,1367) + lu(k,1372) = lu(k,1372) - lu(k,1150) * lu(k,1367) + lu(k,1373) = lu(k,1373) - lu(k,1151) * lu(k,1367) + lu(k,1374) = lu(k,1374) - lu(k,1152) * lu(k,1367) + lu(k,1375) = lu(k,1375) - lu(k,1153) * lu(k,1367) + lu(k,1376) = lu(k,1376) - lu(k,1154) * lu(k,1367) + lu(k,1377) = lu(k,1377) - lu(k,1155) * lu(k,1367) + lu(k,1378) = lu(k,1378) - lu(k,1156) * lu(k,1367) + lu(k,1379) = lu(k,1379) - lu(k,1157) * lu(k,1367) + lu(k,1380) = lu(k,1380) - lu(k,1158) * lu(k,1367) + lu(k,1381) = lu(k,1381) - lu(k,1159) * lu(k,1367) + lu(k,1382) = lu(k,1382) - lu(k,1160) * lu(k,1367) + lu(k,1383) = lu(k,1383) - lu(k,1161) * lu(k,1367) + lu(k,1384) = lu(k,1384) - lu(k,1162) * lu(k,1367) + lu(k,1385) = lu(k,1385) - lu(k,1163) * lu(k,1367) + lu(k,1386) = lu(k,1386) - lu(k,1164) * lu(k,1367) + lu(k,1387) = lu(k,1387) - lu(k,1165) * lu(k,1367) + lu(k,1388) = lu(k,1388) - lu(k,1166) * lu(k,1367) + lu(k,1411) = lu(k,1411) - lu(k,1146) * lu(k,1410) + lu(k,1412) = lu(k,1412) - lu(k,1147) * lu(k,1410) + lu(k,1413) = lu(k,1413) - lu(k,1148) * lu(k,1410) + lu(k,1414) = lu(k,1414) - lu(k,1149) * lu(k,1410) + lu(k,1415) = lu(k,1415) - lu(k,1150) * lu(k,1410) + lu(k,1416) = lu(k,1416) - lu(k,1151) * lu(k,1410) + lu(k,1417) = lu(k,1417) - lu(k,1152) * lu(k,1410) + lu(k,1418) = lu(k,1418) - lu(k,1153) * lu(k,1410) + lu(k,1419) = lu(k,1419) - lu(k,1154) * lu(k,1410) + lu(k,1420) = lu(k,1420) - lu(k,1155) * lu(k,1410) + lu(k,1421) = lu(k,1421) - lu(k,1156) * lu(k,1410) + lu(k,1422) = lu(k,1422) - lu(k,1157) * lu(k,1410) + lu(k,1423) = lu(k,1423) - lu(k,1158) * lu(k,1410) + lu(k,1424) = lu(k,1424) - lu(k,1159) * lu(k,1410) + lu(k,1425) = lu(k,1425) - lu(k,1160) * lu(k,1410) + lu(k,1426) = lu(k,1426) - lu(k,1161) * lu(k,1410) + lu(k,1427) = lu(k,1427) - lu(k,1162) * lu(k,1410) + lu(k,1428) = lu(k,1428) - lu(k,1163) * lu(k,1410) + lu(k,1429) = lu(k,1429) - lu(k,1164) * lu(k,1410) + lu(k,1430) = lu(k,1430) - lu(k,1165) * lu(k,1410) + lu(k,1431) = lu(k,1431) - lu(k,1166) * lu(k,1410) + lu(k,1454) = lu(k,1454) - lu(k,1146) * lu(k,1453) + lu(k,1455) = lu(k,1455) - lu(k,1147) * lu(k,1453) + lu(k,1456) = lu(k,1456) - lu(k,1148) * lu(k,1453) + lu(k,1457) = lu(k,1457) - lu(k,1149) * lu(k,1453) + lu(k,1458) = lu(k,1458) - lu(k,1150) * lu(k,1453) + lu(k,1459) = lu(k,1459) - lu(k,1151) * lu(k,1453) + lu(k,1460) = lu(k,1460) - lu(k,1152) * lu(k,1453) + lu(k,1461) = lu(k,1461) - lu(k,1153) * lu(k,1453) + lu(k,1462) = lu(k,1462) - lu(k,1154) * lu(k,1453) + lu(k,1463) = lu(k,1463) - lu(k,1155) * lu(k,1453) + lu(k,1464) = lu(k,1464) - lu(k,1156) * lu(k,1453) + lu(k,1465) = lu(k,1465) - lu(k,1157) * lu(k,1453) + lu(k,1466) = lu(k,1466) - lu(k,1158) * lu(k,1453) + lu(k,1467) = lu(k,1467) - lu(k,1159) * lu(k,1453) + lu(k,1468) = lu(k,1468) - lu(k,1160) * lu(k,1453) + lu(k,1469) = lu(k,1469) - lu(k,1161) * lu(k,1453) + lu(k,1470) = lu(k,1470) - lu(k,1162) * lu(k,1453) + lu(k,1471) = lu(k,1471) - lu(k,1163) * lu(k,1453) + lu(k,1472) = lu(k,1472) - lu(k,1164) * lu(k,1453) + lu(k,1473) = lu(k,1473) - lu(k,1165) * lu(k,1453) + lu(k,1474) = lu(k,1474) - lu(k,1166) * lu(k,1453) + lu(k,1499) = lu(k,1499) - lu(k,1146) * lu(k,1498) + lu(k,1500) = lu(k,1500) - lu(k,1147) * lu(k,1498) + lu(k,1501) = lu(k,1501) - lu(k,1148) * lu(k,1498) + lu(k,1502) = lu(k,1502) - lu(k,1149) * lu(k,1498) + lu(k,1503) = lu(k,1503) - lu(k,1150) * lu(k,1498) + lu(k,1504) = lu(k,1504) - lu(k,1151) * lu(k,1498) + lu(k,1505) = lu(k,1505) - lu(k,1152) * lu(k,1498) + lu(k,1506) = lu(k,1506) - lu(k,1153) * lu(k,1498) + lu(k,1507) = lu(k,1507) - lu(k,1154) * lu(k,1498) + lu(k,1508) = lu(k,1508) - lu(k,1155) * lu(k,1498) + lu(k,1509) = lu(k,1509) - lu(k,1156) * lu(k,1498) + lu(k,1510) = lu(k,1510) - lu(k,1157) * lu(k,1498) + lu(k,1511) = lu(k,1511) - lu(k,1158) * lu(k,1498) + lu(k,1512) = lu(k,1512) - lu(k,1159) * lu(k,1498) + lu(k,1513) = lu(k,1513) - lu(k,1160) * lu(k,1498) + lu(k,1514) = lu(k,1514) - lu(k,1161) * lu(k,1498) + lu(k,1515) = lu(k,1515) - lu(k,1162) * lu(k,1498) + lu(k,1516) = lu(k,1516) - lu(k,1163) * lu(k,1498) + lu(k,1517) = lu(k,1517) - lu(k,1164) * lu(k,1498) + lu(k,1518) = lu(k,1518) - lu(k,1165) * lu(k,1498) + lu(k,1519) = lu(k,1519) - lu(k,1166) * lu(k,1498) + lu(k,1535) = lu(k,1535) - lu(k,1146) * lu(k,1534) + lu(k,1536) = lu(k,1536) - lu(k,1147) * lu(k,1534) + lu(k,1537) = lu(k,1537) - lu(k,1148) * lu(k,1534) + lu(k,1538) = lu(k,1538) - lu(k,1149) * lu(k,1534) + lu(k,1539) = lu(k,1539) - lu(k,1150) * lu(k,1534) + lu(k,1540) = lu(k,1540) - lu(k,1151) * lu(k,1534) + lu(k,1541) = lu(k,1541) - lu(k,1152) * lu(k,1534) + lu(k,1542) = lu(k,1542) - lu(k,1153) * lu(k,1534) + lu(k,1543) = lu(k,1543) - lu(k,1154) * lu(k,1534) + lu(k,1544) = lu(k,1544) - lu(k,1155) * lu(k,1534) + lu(k,1545) = lu(k,1545) - lu(k,1156) * lu(k,1534) + lu(k,1546) = lu(k,1546) - lu(k,1157) * lu(k,1534) + lu(k,1547) = lu(k,1547) - lu(k,1158) * lu(k,1534) + lu(k,1548) = lu(k,1548) - lu(k,1159) * lu(k,1534) + lu(k,1549) = lu(k,1549) - lu(k,1160) * lu(k,1534) + lu(k,1550) = lu(k,1550) - lu(k,1161) * lu(k,1534) + lu(k,1551) = lu(k,1551) - lu(k,1162) * lu(k,1534) + lu(k,1552) = lu(k,1552) - lu(k,1163) * lu(k,1534) + lu(k,1553) = lu(k,1553) - lu(k,1164) * lu(k,1534) + lu(k,1554) = lu(k,1554) - lu(k,1165) * lu(k,1534) + lu(k,1555) = lu(k,1555) - lu(k,1166) * lu(k,1534) + lu(k,1580) = lu(k,1580) - lu(k,1146) * lu(k,1579) + lu(k,1581) = lu(k,1581) - lu(k,1147) * lu(k,1579) + lu(k,1582) = lu(k,1582) - lu(k,1148) * lu(k,1579) + lu(k,1583) = lu(k,1583) - lu(k,1149) * lu(k,1579) + lu(k,1584) = lu(k,1584) - lu(k,1150) * lu(k,1579) + lu(k,1585) = lu(k,1585) - lu(k,1151) * lu(k,1579) + lu(k,1586) = lu(k,1586) - lu(k,1152) * lu(k,1579) + lu(k,1587) = lu(k,1587) - lu(k,1153) * lu(k,1579) + lu(k,1588) = lu(k,1588) - lu(k,1154) * lu(k,1579) + lu(k,1589) = lu(k,1589) - lu(k,1155) * lu(k,1579) + lu(k,1590) = lu(k,1590) - lu(k,1156) * lu(k,1579) + lu(k,1591) = lu(k,1591) - lu(k,1157) * lu(k,1579) + lu(k,1592) = lu(k,1592) - lu(k,1158) * lu(k,1579) + lu(k,1593) = lu(k,1593) - lu(k,1159) * lu(k,1579) + lu(k,1594) = lu(k,1594) - lu(k,1160) * lu(k,1579) + lu(k,1595) = lu(k,1595) - lu(k,1161) * lu(k,1579) + lu(k,1596) = lu(k,1596) - lu(k,1162) * lu(k,1579) + lu(k,1597) = lu(k,1597) - lu(k,1163) * lu(k,1579) + lu(k,1598) = lu(k,1598) - lu(k,1164) * lu(k,1579) + lu(k,1599) = lu(k,1599) - lu(k,1165) * lu(k,1579) + lu(k,1600) = lu(k,1600) - lu(k,1166) * lu(k,1579) + lu(k,1628) = lu(k,1628) - lu(k,1146) * lu(k,1627) + lu(k,1629) = lu(k,1629) - lu(k,1147) * lu(k,1627) + lu(k,1630) = lu(k,1630) - lu(k,1148) * lu(k,1627) + lu(k,1631) = lu(k,1631) - lu(k,1149) * lu(k,1627) + lu(k,1632) = lu(k,1632) - lu(k,1150) * lu(k,1627) + lu(k,1633) = lu(k,1633) - lu(k,1151) * lu(k,1627) + lu(k,1634) = lu(k,1634) - lu(k,1152) * lu(k,1627) + lu(k,1635) = lu(k,1635) - lu(k,1153) * lu(k,1627) + lu(k,1636) = lu(k,1636) - lu(k,1154) * lu(k,1627) + lu(k,1637) = lu(k,1637) - lu(k,1155) * lu(k,1627) + lu(k,1638) = lu(k,1638) - lu(k,1156) * lu(k,1627) + lu(k,1639) = lu(k,1639) - lu(k,1157) * lu(k,1627) + lu(k,1640) = lu(k,1640) - lu(k,1158) * lu(k,1627) + lu(k,1641) = lu(k,1641) - lu(k,1159) * lu(k,1627) + lu(k,1642) = lu(k,1642) - lu(k,1160) * lu(k,1627) + lu(k,1643) = lu(k,1643) - lu(k,1161) * lu(k,1627) + lu(k,1644) = lu(k,1644) - lu(k,1162) * lu(k,1627) + lu(k,1645) = lu(k,1645) - lu(k,1163) * lu(k,1627) + lu(k,1646) = lu(k,1646) - lu(k,1164) * lu(k,1627) + lu(k,1647) = lu(k,1647) - lu(k,1165) * lu(k,1627) + lu(k,1648) = lu(k,1648) - lu(k,1166) * lu(k,1627) + lu(k,1671) = lu(k,1671) - lu(k,1146) * lu(k,1670) + lu(k,1672) = lu(k,1672) - lu(k,1147) * lu(k,1670) + lu(k,1673) = lu(k,1673) - lu(k,1148) * lu(k,1670) + lu(k,1674) = lu(k,1674) - lu(k,1149) * lu(k,1670) + lu(k,1675) = lu(k,1675) - lu(k,1150) * lu(k,1670) + lu(k,1676) = lu(k,1676) - lu(k,1151) * lu(k,1670) + lu(k,1677) = lu(k,1677) - lu(k,1152) * lu(k,1670) + lu(k,1678) = lu(k,1678) - lu(k,1153) * lu(k,1670) + lu(k,1679) = lu(k,1679) - lu(k,1154) * lu(k,1670) + lu(k,1680) = lu(k,1680) - lu(k,1155) * lu(k,1670) + lu(k,1681) = lu(k,1681) - lu(k,1156) * lu(k,1670) + lu(k,1682) = lu(k,1682) - lu(k,1157) * lu(k,1670) + lu(k,1683) = lu(k,1683) - lu(k,1158) * lu(k,1670) + lu(k,1684) = lu(k,1684) - lu(k,1159) * lu(k,1670) + lu(k,1685) = lu(k,1685) - lu(k,1160) * lu(k,1670) + lu(k,1686) = lu(k,1686) - lu(k,1161) * lu(k,1670) + lu(k,1687) = lu(k,1687) - lu(k,1162) * lu(k,1670) + lu(k,1688) = lu(k,1688) - lu(k,1163) * lu(k,1670) + lu(k,1689) = lu(k,1689) - lu(k,1164) * lu(k,1670) + lu(k,1690) = lu(k,1690) - lu(k,1165) * lu(k,1670) + lu(k,1691) = lu(k,1691) - lu(k,1166) * lu(k,1670) + lu(k,1713) = lu(k,1713) - lu(k,1146) * lu(k,1712) + lu(k,1714) = lu(k,1714) - lu(k,1147) * lu(k,1712) + lu(k,1715) = lu(k,1715) - lu(k,1148) * lu(k,1712) + lu(k,1716) = lu(k,1716) - lu(k,1149) * lu(k,1712) + lu(k,1717) = lu(k,1717) - lu(k,1150) * lu(k,1712) + lu(k,1718) = lu(k,1718) - lu(k,1151) * lu(k,1712) + lu(k,1719) = lu(k,1719) - lu(k,1152) * lu(k,1712) + lu(k,1720) = lu(k,1720) - lu(k,1153) * lu(k,1712) + lu(k,1721) = lu(k,1721) - lu(k,1154) * lu(k,1712) + lu(k,1722) = lu(k,1722) - lu(k,1155) * lu(k,1712) + lu(k,1723) = lu(k,1723) - lu(k,1156) * lu(k,1712) + lu(k,1724) = lu(k,1724) - lu(k,1157) * lu(k,1712) + lu(k,1725) = lu(k,1725) - lu(k,1158) * lu(k,1712) + lu(k,1726) = lu(k,1726) - lu(k,1159) * lu(k,1712) + lu(k,1727) = lu(k,1727) - lu(k,1160) * lu(k,1712) + lu(k,1728) = lu(k,1728) - lu(k,1161) * lu(k,1712) + lu(k,1729) = lu(k,1729) - lu(k,1162) * lu(k,1712) + lu(k,1730) = lu(k,1730) - lu(k,1163) * lu(k,1712) + lu(k,1731) = lu(k,1731) - lu(k,1164) * lu(k,1712) + lu(k,1732) = lu(k,1732) - lu(k,1165) * lu(k,1712) + lu(k,1733) = lu(k,1733) - lu(k,1166) * lu(k,1712) + lu(k,1758) = lu(k,1758) - lu(k,1146) * lu(k,1757) + lu(k,1759) = lu(k,1759) - lu(k,1147) * lu(k,1757) + lu(k,1760) = lu(k,1760) - lu(k,1148) * lu(k,1757) + lu(k,1761) = lu(k,1761) - lu(k,1149) * lu(k,1757) + lu(k,1762) = lu(k,1762) - lu(k,1150) * lu(k,1757) + lu(k,1763) = lu(k,1763) - lu(k,1151) * lu(k,1757) + lu(k,1764) = lu(k,1764) - lu(k,1152) * lu(k,1757) + lu(k,1765) = lu(k,1765) - lu(k,1153) * lu(k,1757) + lu(k,1766) = lu(k,1766) - lu(k,1154) * lu(k,1757) + lu(k,1767) = lu(k,1767) - lu(k,1155) * lu(k,1757) + lu(k,1768) = lu(k,1768) - lu(k,1156) * lu(k,1757) + lu(k,1769) = lu(k,1769) - lu(k,1157) * lu(k,1757) + lu(k,1770) = lu(k,1770) - lu(k,1158) * lu(k,1757) + lu(k,1771) = lu(k,1771) - lu(k,1159) * lu(k,1757) + lu(k,1772) = lu(k,1772) - lu(k,1160) * lu(k,1757) + lu(k,1773) = lu(k,1773) - lu(k,1161) * lu(k,1757) + lu(k,1774) = lu(k,1774) - lu(k,1162) * lu(k,1757) + lu(k,1775) = lu(k,1775) - lu(k,1163) * lu(k,1757) + lu(k,1776) = lu(k,1776) - lu(k,1164) * lu(k,1757) + lu(k,1777) = lu(k,1777) - lu(k,1165) * lu(k,1757) + lu(k,1778) = lu(k,1778) - lu(k,1166) * lu(k,1757) + lu(k,1807) = lu(k,1807) - lu(k,1146) * lu(k,1806) + lu(k,1808) = lu(k,1808) - lu(k,1147) * lu(k,1806) + lu(k,1809) = lu(k,1809) - lu(k,1148) * lu(k,1806) + lu(k,1810) = lu(k,1810) - lu(k,1149) * lu(k,1806) + lu(k,1811) = lu(k,1811) - lu(k,1150) * lu(k,1806) + lu(k,1812) = lu(k,1812) - lu(k,1151) * lu(k,1806) + lu(k,1813) = lu(k,1813) - lu(k,1152) * lu(k,1806) + lu(k,1814) = lu(k,1814) - lu(k,1153) * lu(k,1806) + lu(k,1815) = lu(k,1815) - lu(k,1154) * lu(k,1806) + lu(k,1816) = lu(k,1816) - lu(k,1155) * lu(k,1806) + lu(k,1817) = lu(k,1817) - lu(k,1156) * lu(k,1806) + lu(k,1818) = lu(k,1818) - lu(k,1157) * lu(k,1806) + lu(k,1819) = lu(k,1819) - lu(k,1158) * lu(k,1806) + lu(k,1820) = lu(k,1820) - lu(k,1159) * lu(k,1806) + lu(k,1821) = lu(k,1821) - lu(k,1160) * lu(k,1806) + lu(k,1822) = lu(k,1822) - lu(k,1161) * lu(k,1806) + lu(k,1823) = lu(k,1823) - lu(k,1162) * lu(k,1806) + lu(k,1824) = lu(k,1824) - lu(k,1163) * lu(k,1806) + lu(k,1825) = lu(k,1825) - lu(k,1164) * lu(k,1806) + lu(k,1826) = lu(k,1826) - lu(k,1165) * lu(k,1806) + lu(k,1827) = lu(k,1827) - lu(k,1166) * lu(k,1806) + lu(k,1840) = lu(k,1840) - lu(k,1146) * lu(k,1839) + lu(k,1841) = lu(k,1841) - lu(k,1147) * lu(k,1839) + lu(k,1842) = lu(k,1842) - lu(k,1148) * lu(k,1839) + lu(k,1843) = lu(k,1843) - lu(k,1149) * lu(k,1839) + lu(k,1844) = lu(k,1844) - lu(k,1150) * lu(k,1839) + lu(k,1845) = lu(k,1845) - lu(k,1151) * lu(k,1839) + lu(k,1846) = lu(k,1846) - lu(k,1152) * lu(k,1839) + lu(k,1847) = lu(k,1847) - lu(k,1153) * lu(k,1839) + lu(k,1848) = lu(k,1848) - lu(k,1154) * lu(k,1839) + lu(k,1849) = lu(k,1849) - lu(k,1155) * lu(k,1839) + lu(k,1850) = lu(k,1850) - lu(k,1156) * lu(k,1839) + lu(k,1851) = lu(k,1851) - lu(k,1157) * lu(k,1839) + lu(k,1852) = lu(k,1852) - lu(k,1158) * lu(k,1839) + lu(k,1853) = lu(k,1853) - lu(k,1159) * lu(k,1839) + lu(k,1854) = lu(k,1854) - lu(k,1160) * lu(k,1839) + lu(k,1855) = lu(k,1855) - lu(k,1161) * lu(k,1839) + lu(k,1856) = lu(k,1856) - lu(k,1162) * lu(k,1839) + lu(k,1857) = lu(k,1857) - lu(k,1163) * lu(k,1839) + lu(k,1858) = lu(k,1858) - lu(k,1164) * lu(k,1839) + lu(k,1859) = lu(k,1859) - lu(k,1165) * lu(k,1839) + lu(k,1860) = lu(k,1860) - lu(k,1166) * lu(k,1839) + lu(k,1876) = lu(k,1876) - lu(k,1146) * lu(k,1875) + lu(k,1877) = lu(k,1877) - lu(k,1147) * lu(k,1875) + lu(k,1878) = lu(k,1878) - lu(k,1148) * lu(k,1875) + lu(k,1879) = lu(k,1879) - lu(k,1149) * lu(k,1875) + lu(k,1880) = lu(k,1880) - lu(k,1150) * lu(k,1875) + lu(k,1881) = lu(k,1881) - lu(k,1151) * lu(k,1875) + lu(k,1882) = lu(k,1882) - lu(k,1152) * lu(k,1875) + lu(k,1883) = lu(k,1883) - lu(k,1153) * lu(k,1875) + lu(k,1884) = lu(k,1884) - lu(k,1154) * lu(k,1875) + lu(k,1885) = lu(k,1885) - lu(k,1155) * lu(k,1875) + lu(k,1886) = lu(k,1886) - lu(k,1156) * lu(k,1875) + lu(k,1887) = lu(k,1887) - lu(k,1157) * lu(k,1875) + lu(k,1888) = lu(k,1888) - lu(k,1158) * lu(k,1875) + lu(k,1889) = lu(k,1889) - lu(k,1159) * lu(k,1875) + lu(k,1890) = lu(k,1890) - lu(k,1160) * lu(k,1875) + lu(k,1891) = lu(k,1891) - lu(k,1161) * lu(k,1875) + lu(k,1892) = lu(k,1892) - lu(k,1162) * lu(k,1875) + lu(k,1893) = lu(k,1893) - lu(k,1163) * lu(k,1875) + lu(k,1894) = lu(k,1894) - lu(k,1164) * lu(k,1875) + lu(k,1895) = lu(k,1895) - lu(k,1165) * lu(k,1875) + lu(k,1896) = lu(k,1896) - lu(k,1166) * lu(k,1875) + lu(k,1917) = lu(k,1917) - lu(k,1146) * lu(k,1916) + lu(k,1918) = lu(k,1918) - lu(k,1147) * lu(k,1916) + lu(k,1919) = lu(k,1919) - lu(k,1148) * lu(k,1916) + lu(k,1920) = lu(k,1920) - lu(k,1149) * lu(k,1916) + lu(k,1921) = lu(k,1921) - lu(k,1150) * lu(k,1916) + lu(k,1922) = lu(k,1922) - lu(k,1151) * lu(k,1916) + lu(k,1923) = lu(k,1923) - lu(k,1152) * lu(k,1916) + lu(k,1924) = lu(k,1924) - lu(k,1153) * lu(k,1916) + lu(k,1925) = lu(k,1925) - lu(k,1154) * lu(k,1916) + lu(k,1926) = lu(k,1926) - lu(k,1155) * lu(k,1916) + lu(k,1927) = lu(k,1927) - lu(k,1156) * lu(k,1916) + lu(k,1928) = lu(k,1928) - lu(k,1157) * lu(k,1916) + lu(k,1929) = lu(k,1929) - lu(k,1158) * lu(k,1916) + lu(k,1930) = lu(k,1930) - lu(k,1159) * lu(k,1916) + lu(k,1931) = lu(k,1931) - lu(k,1160) * lu(k,1916) + lu(k,1932) = lu(k,1932) - lu(k,1161) * lu(k,1916) + lu(k,1933) = lu(k,1933) - lu(k,1162) * lu(k,1916) + lu(k,1934) = lu(k,1934) - lu(k,1163) * lu(k,1916) + lu(k,1935) = lu(k,1935) - lu(k,1164) * lu(k,1916) + lu(k,1936) = lu(k,1936) - lu(k,1165) * lu(k,1916) + lu(k,1937) = lu(k,1937) - lu(k,1166) * lu(k,1916) + lu(k,1959) = lu(k,1959) - lu(k,1146) * lu(k,1958) + lu(k,1960) = lu(k,1960) - lu(k,1147) * lu(k,1958) + lu(k,1961) = lu(k,1961) - lu(k,1148) * lu(k,1958) + lu(k,1962) = lu(k,1962) - lu(k,1149) * lu(k,1958) + lu(k,1963) = lu(k,1963) - lu(k,1150) * lu(k,1958) + lu(k,1964) = lu(k,1964) - lu(k,1151) * lu(k,1958) + lu(k,1965) = lu(k,1965) - lu(k,1152) * lu(k,1958) + lu(k,1966) = lu(k,1966) - lu(k,1153) * lu(k,1958) + lu(k,1967) = lu(k,1967) - lu(k,1154) * lu(k,1958) + lu(k,1968) = lu(k,1968) - lu(k,1155) * lu(k,1958) + lu(k,1969) = lu(k,1969) - lu(k,1156) * lu(k,1958) + lu(k,1970) = lu(k,1970) - lu(k,1157) * lu(k,1958) + lu(k,1971) = lu(k,1971) - lu(k,1158) * lu(k,1958) + lu(k,1972) = lu(k,1972) - lu(k,1159) * lu(k,1958) + lu(k,1973) = lu(k,1973) - lu(k,1160) * lu(k,1958) + lu(k,1974) = lu(k,1974) - lu(k,1161) * lu(k,1958) + lu(k,1975) = lu(k,1975) - lu(k,1162) * lu(k,1958) + lu(k,1976) = lu(k,1976) - lu(k,1163) * lu(k,1958) + lu(k,1977) = lu(k,1977) - lu(k,1164) * lu(k,1958) + lu(k,1978) = lu(k,1978) - lu(k,1165) * lu(k,1958) + lu(k,1979) = lu(k,1979) - lu(k,1166) * lu(k,1958) + lu(k,2007) = lu(k,2007) - lu(k,1146) * lu(k,2006) + lu(k,2008) = lu(k,2008) - lu(k,1147) * lu(k,2006) + lu(k,2009) = lu(k,2009) - lu(k,1148) * lu(k,2006) + lu(k,2010) = lu(k,2010) - lu(k,1149) * lu(k,2006) + lu(k,2011) = lu(k,2011) - lu(k,1150) * lu(k,2006) + lu(k,2012) = lu(k,2012) - lu(k,1151) * lu(k,2006) + lu(k,2013) = lu(k,2013) - lu(k,1152) * lu(k,2006) + lu(k,2014) = lu(k,2014) - lu(k,1153) * lu(k,2006) + lu(k,2015) = lu(k,2015) - lu(k,1154) * lu(k,2006) + lu(k,2016) = lu(k,2016) - lu(k,1155) * lu(k,2006) + lu(k,2017) = lu(k,2017) - lu(k,1156) * lu(k,2006) + lu(k,2018) = lu(k,2018) - lu(k,1157) * lu(k,2006) + lu(k,2019) = lu(k,2019) - lu(k,1158) * lu(k,2006) + lu(k,2020) = lu(k,2020) - lu(k,1159) * lu(k,2006) + lu(k,2021) = lu(k,2021) - lu(k,1160) * lu(k,2006) + lu(k,2022) = lu(k,2022) - lu(k,1161) * lu(k,2006) + lu(k,2023) = lu(k,2023) - lu(k,1162) * lu(k,2006) + lu(k,2024) = lu(k,2024) - lu(k,1163) * lu(k,2006) + lu(k,2025) = lu(k,2025) - lu(k,1164) * lu(k,2006) + lu(k,2026) = lu(k,2026) - lu(k,1165) * lu(k,2006) + lu(k,2027) = lu(k,2027) - lu(k,1166) * lu(k,2006) + lu(k,2067) = lu(k,2067) - lu(k,1146) * lu(k,2066) + lu(k,2068) = lu(k,2068) - lu(k,1147) * lu(k,2066) + lu(k,2069) = lu(k,2069) - lu(k,1148) * lu(k,2066) + lu(k,2070) = lu(k,2070) - lu(k,1149) * lu(k,2066) + lu(k,2071) = lu(k,2071) - lu(k,1150) * lu(k,2066) + lu(k,2072) = lu(k,2072) - lu(k,1151) * lu(k,2066) + lu(k,2073) = lu(k,2073) - lu(k,1152) * lu(k,2066) + lu(k,2074) = lu(k,2074) - lu(k,1153) * lu(k,2066) + lu(k,2075) = lu(k,2075) - lu(k,1154) * lu(k,2066) + lu(k,2076) = lu(k,2076) - lu(k,1155) * lu(k,2066) + lu(k,2077) = lu(k,2077) - lu(k,1156) * lu(k,2066) + lu(k,2078) = lu(k,2078) - lu(k,1157) * lu(k,2066) + lu(k,2079) = lu(k,2079) - lu(k,1158) * lu(k,2066) + lu(k,2080) = lu(k,2080) - lu(k,1159) * lu(k,2066) + lu(k,2081) = lu(k,2081) - lu(k,1160) * lu(k,2066) + lu(k,2082) = lu(k,2082) - lu(k,1161) * lu(k,2066) + lu(k,2083) = lu(k,2083) - lu(k,1162) * lu(k,2066) + lu(k,2084) = lu(k,2084) - lu(k,1163) * lu(k,2066) + lu(k,2085) = lu(k,2085) - lu(k,1164) * lu(k,2066) + lu(k,2086) = lu(k,2086) - lu(k,1165) * lu(k,2066) + lu(k,2087) = lu(k,2087) - lu(k,1166) * lu(k,2066) + lu(k,1189) = 1._r8 / lu(k,1189) + lu(k,1190) = lu(k,1190) * lu(k,1189) + lu(k,1191) = lu(k,1191) * lu(k,1189) + lu(k,1192) = lu(k,1192) * lu(k,1189) + lu(k,1193) = lu(k,1193) * lu(k,1189) + lu(k,1194) = lu(k,1194) * lu(k,1189) + lu(k,1195) = lu(k,1195) * lu(k,1189) + lu(k,1196) = lu(k,1196) * lu(k,1189) + lu(k,1197) = lu(k,1197) * lu(k,1189) + lu(k,1198) = lu(k,1198) * lu(k,1189) + lu(k,1199) = lu(k,1199) * lu(k,1189) + lu(k,1200) = lu(k,1200) * lu(k,1189) + lu(k,1201) = lu(k,1201) * lu(k,1189) + lu(k,1202) = lu(k,1202) * lu(k,1189) + lu(k,1203) = lu(k,1203) * lu(k,1189) + lu(k,1204) = lu(k,1204) * lu(k,1189) + lu(k,1205) = lu(k,1205) * lu(k,1189) + lu(k,1206) = lu(k,1206) * lu(k,1189) + lu(k,1207) = lu(k,1207) * lu(k,1189) + lu(k,1208) = lu(k,1208) * lu(k,1189) + lu(k,1209) = lu(k,1209) * lu(k,1189) + lu(k,1231) = lu(k,1231) - lu(k,1190) * lu(k,1230) + lu(k,1232) = lu(k,1232) - lu(k,1191) * lu(k,1230) + lu(k,1233) = lu(k,1233) - lu(k,1192) * lu(k,1230) + lu(k,1234) = lu(k,1234) - lu(k,1193) * lu(k,1230) + lu(k,1235) = lu(k,1235) - lu(k,1194) * lu(k,1230) + lu(k,1236) = lu(k,1236) - lu(k,1195) * lu(k,1230) + lu(k,1237) = lu(k,1237) - lu(k,1196) * lu(k,1230) + lu(k,1238) = lu(k,1238) - lu(k,1197) * lu(k,1230) + lu(k,1239) = lu(k,1239) - lu(k,1198) * lu(k,1230) + lu(k,1240) = lu(k,1240) - lu(k,1199) * lu(k,1230) + lu(k,1241) = lu(k,1241) - lu(k,1200) * lu(k,1230) + lu(k,1242) = lu(k,1242) - lu(k,1201) * lu(k,1230) + lu(k,1243) = lu(k,1243) - lu(k,1202) * lu(k,1230) + lu(k,1244) = lu(k,1244) - lu(k,1203) * lu(k,1230) + lu(k,1245) = lu(k,1245) - lu(k,1204) * lu(k,1230) + lu(k,1246) = lu(k,1246) - lu(k,1205) * lu(k,1230) + lu(k,1247) = lu(k,1247) - lu(k,1206) * lu(k,1230) + lu(k,1248) = lu(k,1248) - lu(k,1207) * lu(k,1230) + lu(k,1249) = lu(k,1249) - lu(k,1208) * lu(k,1230) + lu(k,1250) = lu(k,1250) - lu(k,1209) * lu(k,1230) + lu(k,1291) = lu(k,1291) - lu(k,1190) * lu(k,1290) + lu(k,1292) = lu(k,1292) - lu(k,1191) * lu(k,1290) + lu(k,1293) = lu(k,1293) - lu(k,1192) * lu(k,1290) + lu(k,1294) = lu(k,1294) - lu(k,1193) * lu(k,1290) + lu(k,1295) = lu(k,1295) - lu(k,1194) * lu(k,1290) + lu(k,1296) = lu(k,1296) - lu(k,1195) * lu(k,1290) + lu(k,1297) = lu(k,1297) - lu(k,1196) * lu(k,1290) + lu(k,1298) = lu(k,1298) - lu(k,1197) * lu(k,1290) + lu(k,1299) = lu(k,1299) - lu(k,1198) * lu(k,1290) + lu(k,1300) = lu(k,1300) - lu(k,1199) * lu(k,1290) + lu(k,1301) = lu(k,1301) - lu(k,1200) * lu(k,1290) + lu(k,1302) = lu(k,1302) - lu(k,1201) * lu(k,1290) + lu(k,1303) = lu(k,1303) - lu(k,1202) * lu(k,1290) + lu(k,1304) = lu(k,1304) - lu(k,1203) * lu(k,1290) + lu(k,1305) = lu(k,1305) - lu(k,1204) * lu(k,1290) + lu(k,1306) = lu(k,1306) - lu(k,1205) * lu(k,1290) + lu(k,1307) = lu(k,1307) - lu(k,1206) * lu(k,1290) + lu(k,1308) = lu(k,1308) - lu(k,1207) * lu(k,1290) + lu(k,1309) = lu(k,1309) - lu(k,1208) * lu(k,1290) + lu(k,1310) = lu(k,1310) - lu(k,1209) * lu(k,1290) + lu(k,1333) = lu(k,1333) - lu(k,1190) * lu(k,1332) + lu(k,1334) = lu(k,1334) - lu(k,1191) * lu(k,1332) + lu(k,1335) = lu(k,1335) - lu(k,1192) * lu(k,1332) + lu(k,1336) = lu(k,1336) - lu(k,1193) * lu(k,1332) + lu(k,1337) = lu(k,1337) - lu(k,1194) * lu(k,1332) + lu(k,1338) = lu(k,1338) - lu(k,1195) * lu(k,1332) + lu(k,1339) = lu(k,1339) - lu(k,1196) * lu(k,1332) + lu(k,1340) = lu(k,1340) - lu(k,1197) * lu(k,1332) + lu(k,1341) = lu(k,1341) - lu(k,1198) * lu(k,1332) + lu(k,1342) = lu(k,1342) - lu(k,1199) * lu(k,1332) + lu(k,1343) = lu(k,1343) - lu(k,1200) * lu(k,1332) + lu(k,1344) = lu(k,1344) - lu(k,1201) * lu(k,1332) + lu(k,1345) = lu(k,1345) - lu(k,1202) * lu(k,1332) + lu(k,1346) = lu(k,1346) - lu(k,1203) * lu(k,1332) + lu(k,1347) = lu(k,1347) - lu(k,1204) * lu(k,1332) + lu(k,1348) = lu(k,1348) - lu(k,1205) * lu(k,1332) + lu(k,1349) = lu(k,1349) - lu(k,1206) * lu(k,1332) + lu(k,1350) = lu(k,1350) - lu(k,1207) * lu(k,1332) + lu(k,1351) = lu(k,1351) - lu(k,1208) * lu(k,1332) + lu(k,1352) = lu(k,1352) - lu(k,1209) * lu(k,1332) + lu(k,1369) = lu(k,1369) - lu(k,1190) * lu(k,1368) + lu(k,1370) = lu(k,1370) - lu(k,1191) * lu(k,1368) + lu(k,1371) = lu(k,1371) - lu(k,1192) * lu(k,1368) + lu(k,1372) = lu(k,1372) - lu(k,1193) * lu(k,1368) + lu(k,1373) = lu(k,1373) - lu(k,1194) * lu(k,1368) + lu(k,1374) = lu(k,1374) - lu(k,1195) * lu(k,1368) + lu(k,1375) = lu(k,1375) - lu(k,1196) * lu(k,1368) + lu(k,1376) = lu(k,1376) - lu(k,1197) * lu(k,1368) + lu(k,1377) = lu(k,1377) - lu(k,1198) * lu(k,1368) + lu(k,1378) = lu(k,1378) - lu(k,1199) * lu(k,1368) + lu(k,1379) = lu(k,1379) - lu(k,1200) * lu(k,1368) + lu(k,1380) = lu(k,1380) - lu(k,1201) * lu(k,1368) + lu(k,1381) = lu(k,1381) - lu(k,1202) * lu(k,1368) + lu(k,1382) = lu(k,1382) - lu(k,1203) * lu(k,1368) + lu(k,1383) = lu(k,1383) - lu(k,1204) * lu(k,1368) + lu(k,1384) = lu(k,1384) - lu(k,1205) * lu(k,1368) + lu(k,1385) = lu(k,1385) - lu(k,1206) * lu(k,1368) + lu(k,1386) = lu(k,1386) - lu(k,1207) * lu(k,1368) + lu(k,1387) = lu(k,1387) - lu(k,1208) * lu(k,1368) + lu(k,1388) = lu(k,1388) - lu(k,1209) * lu(k,1368) + lu(k,1412) = lu(k,1412) - lu(k,1190) * lu(k,1411) + lu(k,1413) = lu(k,1413) - lu(k,1191) * lu(k,1411) + lu(k,1414) = lu(k,1414) - lu(k,1192) * lu(k,1411) + lu(k,1415) = lu(k,1415) - lu(k,1193) * lu(k,1411) + lu(k,1416) = lu(k,1416) - lu(k,1194) * lu(k,1411) + lu(k,1417) = lu(k,1417) - lu(k,1195) * lu(k,1411) + lu(k,1418) = lu(k,1418) - lu(k,1196) * lu(k,1411) + lu(k,1419) = lu(k,1419) - lu(k,1197) * lu(k,1411) + lu(k,1420) = lu(k,1420) - lu(k,1198) * lu(k,1411) + lu(k,1421) = lu(k,1421) - lu(k,1199) * lu(k,1411) + lu(k,1422) = lu(k,1422) - lu(k,1200) * lu(k,1411) + lu(k,1423) = lu(k,1423) - lu(k,1201) * lu(k,1411) + lu(k,1424) = lu(k,1424) - lu(k,1202) * lu(k,1411) + lu(k,1425) = lu(k,1425) - lu(k,1203) * lu(k,1411) + lu(k,1426) = lu(k,1426) - lu(k,1204) * lu(k,1411) + lu(k,1427) = lu(k,1427) - lu(k,1205) * lu(k,1411) + lu(k,1428) = lu(k,1428) - lu(k,1206) * lu(k,1411) + lu(k,1429) = lu(k,1429) - lu(k,1207) * lu(k,1411) + lu(k,1430) = lu(k,1430) - lu(k,1208) * lu(k,1411) + lu(k,1431) = lu(k,1431) - lu(k,1209) * lu(k,1411) + lu(k,1455) = lu(k,1455) - lu(k,1190) * lu(k,1454) + lu(k,1456) = lu(k,1456) - lu(k,1191) * lu(k,1454) + lu(k,1457) = lu(k,1457) - lu(k,1192) * lu(k,1454) + lu(k,1458) = lu(k,1458) - lu(k,1193) * lu(k,1454) + lu(k,1459) = lu(k,1459) - lu(k,1194) * lu(k,1454) + lu(k,1460) = lu(k,1460) - lu(k,1195) * lu(k,1454) + lu(k,1461) = lu(k,1461) - lu(k,1196) * lu(k,1454) + lu(k,1462) = lu(k,1462) - lu(k,1197) * lu(k,1454) + lu(k,1463) = lu(k,1463) - lu(k,1198) * lu(k,1454) + lu(k,1464) = lu(k,1464) - lu(k,1199) * lu(k,1454) + lu(k,1465) = lu(k,1465) - lu(k,1200) * lu(k,1454) + lu(k,1466) = lu(k,1466) - lu(k,1201) * lu(k,1454) + lu(k,1467) = lu(k,1467) - lu(k,1202) * lu(k,1454) + lu(k,1468) = lu(k,1468) - lu(k,1203) * lu(k,1454) + lu(k,1469) = lu(k,1469) - lu(k,1204) * lu(k,1454) + lu(k,1470) = lu(k,1470) - lu(k,1205) * lu(k,1454) + lu(k,1471) = lu(k,1471) - lu(k,1206) * lu(k,1454) + lu(k,1472) = lu(k,1472) - lu(k,1207) * lu(k,1454) + lu(k,1473) = lu(k,1473) - lu(k,1208) * lu(k,1454) + lu(k,1474) = lu(k,1474) - lu(k,1209) * lu(k,1454) + lu(k,1500) = lu(k,1500) - lu(k,1190) * lu(k,1499) + lu(k,1501) = lu(k,1501) - lu(k,1191) * lu(k,1499) + lu(k,1502) = lu(k,1502) - lu(k,1192) * lu(k,1499) + lu(k,1503) = lu(k,1503) - lu(k,1193) * lu(k,1499) + lu(k,1504) = lu(k,1504) - lu(k,1194) * lu(k,1499) + lu(k,1505) = lu(k,1505) - lu(k,1195) * lu(k,1499) + lu(k,1506) = lu(k,1506) - lu(k,1196) * lu(k,1499) + lu(k,1507) = lu(k,1507) - lu(k,1197) * lu(k,1499) + lu(k,1508) = lu(k,1508) - lu(k,1198) * lu(k,1499) + lu(k,1509) = lu(k,1509) - lu(k,1199) * lu(k,1499) + lu(k,1510) = lu(k,1510) - lu(k,1200) * lu(k,1499) + lu(k,1511) = lu(k,1511) - lu(k,1201) * lu(k,1499) + lu(k,1512) = lu(k,1512) - lu(k,1202) * lu(k,1499) + lu(k,1513) = lu(k,1513) - lu(k,1203) * lu(k,1499) + lu(k,1514) = lu(k,1514) - lu(k,1204) * lu(k,1499) + lu(k,1515) = lu(k,1515) - lu(k,1205) * lu(k,1499) + lu(k,1516) = lu(k,1516) - lu(k,1206) * lu(k,1499) + lu(k,1517) = lu(k,1517) - lu(k,1207) * lu(k,1499) + lu(k,1518) = lu(k,1518) - lu(k,1208) * lu(k,1499) + lu(k,1519) = lu(k,1519) - lu(k,1209) * lu(k,1499) + lu(k,1536) = lu(k,1536) - lu(k,1190) * lu(k,1535) + lu(k,1537) = lu(k,1537) - lu(k,1191) * lu(k,1535) + lu(k,1538) = lu(k,1538) - lu(k,1192) * lu(k,1535) + lu(k,1539) = lu(k,1539) - lu(k,1193) * lu(k,1535) + lu(k,1540) = lu(k,1540) - lu(k,1194) * lu(k,1535) + lu(k,1541) = lu(k,1541) - lu(k,1195) * lu(k,1535) + lu(k,1542) = lu(k,1542) - lu(k,1196) * lu(k,1535) + lu(k,1543) = lu(k,1543) - lu(k,1197) * lu(k,1535) + lu(k,1544) = lu(k,1544) - lu(k,1198) * lu(k,1535) + lu(k,1545) = lu(k,1545) - lu(k,1199) * lu(k,1535) + lu(k,1546) = lu(k,1546) - lu(k,1200) * lu(k,1535) + lu(k,1547) = lu(k,1547) - lu(k,1201) * lu(k,1535) + lu(k,1548) = lu(k,1548) - lu(k,1202) * lu(k,1535) + lu(k,1549) = lu(k,1549) - lu(k,1203) * lu(k,1535) + lu(k,1550) = lu(k,1550) - lu(k,1204) * lu(k,1535) + lu(k,1551) = lu(k,1551) - lu(k,1205) * lu(k,1535) + lu(k,1552) = lu(k,1552) - lu(k,1206) * lu(k,1535) + lu(k,1553) = lu(k,1553) - lu(k,1207) * lu(k,1535) + lu(k,1554) = lu(k,1554) - lu(k,1208) * lu(k,1535) + lu(k,1555) = lu(k,1555) - lu(k,1209) * lu(k,1535) + lu(k,1581) = lu(k,1581) - lu(k,1190) * lu(k,1580) + lu(k,1582) = lu(k,1582) - lu(k,1191) * lu(k,1580) + lu(k,1583) = lu(k,1583) - lu(k,1192) * lu(k,1580) + lu(k,1584) = lu(k,1584) - lu(k,1193) * lu(k,1580) + lu(k,1585) = lu(k,1585) - lu(k,1194) * lu(k,1580) + lu(k,1586) = lu(k,1586) - lu(k,1195) * lu(k,1580) + lu(k,1587) = lu(k,1587) - lu(k,1196) * lu(k,1580) + lu(k,1588) = lu(k,1588) - lu(k,1197) * lu(k,1580) + lu(k,1589) = lu(k,1589) - lu(k,1198) * lu(k,1580) + lu(k,1590) = lu(k,1590) - lu(k,1199) * lu(k,1580) + lu(k,1591) = lu(k,1591) - lu(k,1200) * lu(k,1580) + lu(k,1592) = lu(k,1592) - lu(k,1201) * lu(k,1580) + lu(k,1593) = lu(k,1593) - lu(k,1202) * lu(k,1580) + lu(k,1594) = lu(k,1594) - lu(k,1203) * lu(k,1580) + lu(k,1595) = lu(k,1595) - lu(k,1204) * lu(k,1580) + lu(k,1596) = lu(k,1596) - lu(k,1205) * lu(k,1580) + lu(k,1597) = lu(k,1597) - lu(k,1206) * lu(k,1580) + lu(k,1598) = lu(k,1598) - lu(k,1207) * lu(k,1580) + lu(k,1599) = lu(k,1599) - lu(k,1208) * lu(k,1580) + lu(k,1600) = lu(k,1600) - lu(k,1209) * lu(k,1580) + lu(k,1629) = lu(k,1629) - lu(k,1190) * lu(k,1628) + lu(k,1630) = lu(k,1630) - lu(k,1191) * lu(k,1628) + lu(k,1631) = lu(k,1631) - lu(k,1192) * lu(k,1628) + lu(k,1632) = lu(k,1632) - lu(k,1193) * lu(k,1628) + lu(k,1633) = lu(k,1633) - lu(k,1194) * lu(k,1628) + lu(k,1634) = lu(k,1634) - lu(k,1195) * lu(k,1628) + lu(k,1635) = lu(k,1635) - lu(k,1196) * lu(k,1628) + lu(k,1636) = lu(k,1636) - lu(k,1197) * lu(k,1628) + lu(k,1637) = lu(k,1637) - lu(k,1198) * lu(k,1628) + lu(k,1638) = lu(k,1638) - lu(k,1199) * lu(k,1628) + lu(k,1639) = lu(k,1639) - lu(k,1200) * lu(k,1628) + lu(k,1640) = lu(k,1640) - lu(k,1201) * lu(k,1628) + lu(k,1641) = lu(k,1641) - lu(k,1202) * lu(k,1628) + lu(k,1642) = lu(k,1642) - lu(k,1203) * lu(k,1628) + lu(k,1643) = lu(k,1643) - lu(k,1204) * lu(k,1628) + lu(k,1644) = lu(k,1644) - lu(k,1205) * lu(k,1628) + lu(k,1645) = lu(k,1645) - lu(k,1206) * lu(k,1628) + lu(k,1646) = lu(k,1646) - lu(k,1207) * lu(k,1628) + lu(k,1647) = lu(k,1647) - lu(k,1208) * lu(k,1628) + lu(k,1648) = lu(k,1648) - lu(k,1209) * lu(k,1628) + lu(k,1672) = lu(k,1672) - lu(k,1190) * lu(k,1671) + lu(k,1673) = lu(k,1673) - lu(k,1191) * lu(k,1671) + lu(k,1674) = lu(k,1674) - lu(k,1192) * lu(k,1671) + lu(k,1675) = lu(k,1675) - lu(k,1193) * lu(k,1671) + lu(k,1676) = lu(k,1676) - lu(k,1194) * lu(k,1671) + lu(k,1677) = lu(k,1677) - lu(k,1195) * lu(k,1671) + lu(k,1678) = lu(k,1678) - lu(k,1196) * lu(k,1671) + lu(k,1679) = lu(k,1679) - lu(k,1197) * lu(k,1671) + lu(k,1680) = lu(k,1680) - lu(k,1198) * lu(k,1671) + lu(k,1681) = lu(k,1681) - lu(k,1199) * lu(k,1671) + lu(k,1682) = lu(k,1682) - lu(k,1200) * lu(k,1671) + lu(k,1683) = lu(k,1683) - lu(k,1201) * lu(k,1671) + lu(k,1684) = lu(k,1684) - lu(k,1202) * lu(k,1671) + lu(k,1685) = lu(k,1685) - lu(k,1203) * lu(k,1671) + lu(k,1686) = lu(k,1686) - lu(k,1204) * lu(k,1671) + lu(k,1687) = lu(k,1687) - lu(k,1205) * lu(k,1671) + lu(k,1688) = lu(k,1688) - lu(k,1206) * lu(k,1671) + lu(k,1689) = lu(k,1689) - lu(k,1207) * lu(k,1671) + lu(k,1690) = lu(k,1690) - lu(k,1208) * lu(k,1671) + lu(k,1691) = lu(k,1691) - lu(k,1209) * lu(k,1671) + lu(k,1714) = lu(k,1714) - lu(k,1190) * lu(k,1713) + lu(k,1715) = lu(k,1715) - lu(k,1191) * lu(k,1713) + lu(k,1716) = lu(k,1716) - lu(k,1192) * lu(k,1713) + lu(k,1717) = lu(k,1717) - lu(k,1193) * lu(k,1713) + lu(k,1718) = lu(k,1718) - lu(k,1194) * lu(k,1713) + lu(k,1719) = lu(k,1719) - lu(k,1195) * lu(k,1713) + lu(k,1720) = lu(k,1720) - lu(k,1196) * lu(k,1713) + lu(k,1721) = lu(k,1721) - lu(k,1197) * lu(k,1713) + lu(k,1722) = lu(k,1722) - lu(k,1198) * lu(k,1713) + lu(k,1723) = lu(k,1723) - lu(k,1199) * lu(k,1713) + lu(k,1724) = lu(k,1724) - lu(k,1200) * lu(k,1713) + lu(k,1725) = lu(k,1725) - lu(k,1201) * lu(k,1713) + lu(k,1726) = lu(k,1726) - lu(k,1202) * lu(k,1713) + lu(k,1727) = lu(k,1727) - lu(k,1203) * lu(k,1713) + lu(k,1728) = lu(k,1728) - lu(k,1204) * lu(k,1713) + lu(k,1729) = lu(k,1729) - lu(k,1205) * lu(k,1713) + lu(k,1730) = lu(k,1730) - lu(k,1206) * lu(k,1713) + lu(k,1731) = lu(k,1731) - lu(k,1207) * lu(k,1713) + lu(k,1732) = lu(k,1732) - lu(k,1208) * lu(k,1713) + lu(k,1733) = lu(k,1733) - lu(k,1209) * lu(k,1713) + lu(k,1759) = lu(k,1759) - lu(k,1190) * lu(k,1758) + lu(k,1760) = lu(k,1760) - lu(k,1191) * lu(k,1758) + lu(k,1761) = lu(k,1761) - lu(k,1192) * lu(k,1758) + lu(k,1762) = lu(k,1762) - lu(k,1193) * lu(k,1758) + lu(k,1763) = lu(k,1763) - lu(k,1194) * lu(k,1758) + lu(k,1764) = lu(k,1764) - lu(k,1195) * lu(k,1758) + lu(k,1765) = lu(k,1765) - lu(k,1196) * lu(k,1758) + lu(k,1766) = lu(k,1766) - lu(k,1197) * lu(k,1758) + lu(k,1767) = lu(k,1767) - lu(k,1198) * lu(k,1758) + lu(k,1768) = lu(k,1768) - lu(k,1199) * lu(k,1758) + lu(k,1769) = lu(k,1769) - lu(k,1200) * lu(k,1758) + lu(k,1770) = lu(k,1770) - lu(k,1201) * lu(k,1758) + lu(k,1771) = lu(k,1771) - lu(k,1202) * lu(k,1758) + lu(k,1772) = lu(k,1772) - lu(k,1203) * lu(k,1758) + lu(k,1773) = lu(k,1773) - lu(k,1204) * lu(k,1758) + lu(k,1774) = lu(k,1774) - lu(k,1205) * lu(k,1758) + lu(k,1775) = lu(k,1775) - lu(k,1206) * lu(k,1758) + lu(k,1776) = lu(k,1776) - lu(k,1207) * lu(k,1758) + lu(k,1777) = lu(k,1777) - lu(k,1208) * lu(k,1758) + lu(k,1778) = lu(k,1778) - lu(k,1209) * lu(k,1758) + lu(k,1808) = lu(k,1808) - lu(k,1190) * lu(k,1807) + lu(k,1809) = lu(k,1809) - lu(k,1191) * lu(k,1807) + lu(k,1810) = lu(k,1810) - lu(k,1192) * lu(k,1807) + lu(k,1811) = lu(k,1811) - lu(k,1193) * lu(k,1807) + lu(k,1812) = lu(k,1812) - lu(k,1194) * lu(k,1807) + lu(k,1813) = lu(k,1813) - lu(k,1195) * lu(k,1807) + lu(k,1814) = lu(k,1814) - lu(k,1196) * lu(k,1807) + lu(k,1815) = lu(k,1815) - lu(k,1197) * lu(k,1807) + lu(k,1816) = lu(k,1816) - lu(k,1198) * lu(k,1807) + lu(k,1817) = lu(k,1817) - lu(k,1199) * lu(k,1807) + lu(k,1818) = lu(k,1818) - lu(k,1200) * lu(k,1807) + lu(k,1819) = lu(k,1819) - lu(k,1201) * lu(k,1807) + lu(k,1820) = lu(k,1820) - lu(k,1202) * lu(k,1807) + lu(k,1821) = lu(k,1821) - lu(k,1203) * lu(k,1807) + lu(k,1822) = lu(k,1822) - lu(k,1204) * lu(k,1807) + lu(k,1823) = lu(k,1823) - lu(k,1205) * lu(k,1807) + lu(k,1824) = lu(k,1824) - lu(k,1206) * lu(k,1807) + lu(k,1825) = lu(k,1825) - lu(k,1207) * lu(k,1807) + lu(k,1826) = lu(k,1826) - lu(k,1208) * lu(k,1807) + lu(k,1827) = lu(k,1827) - lu(k,1209) * lu(k,1807) + lu(k,1841) = lu(k,1841) - lu(k,1190) * lu(k,1840) + lu(k,1842) = lu(k,1842) - lu(k,1191) * lu(k,1840) + lu(k,1843) = lu(k,1843) - lu(k,1192) * lu(k,1840) + lu(k,1844) = lu(k,1844) - lu(k,1193) * lu(k,1840) + lu(k,1845) = lu(k,1845) - lu(k,1194) * lu(k,1840) + lu(k,1846) = lu(k,1846) - lu(k,1195) * lu(k,1840) + lu(k,1847) = lu(k,1847) - lu(k,1196) * lu(k,1840) + lu(k,1848) = lu(k,1848) - lu(k,1197) * lu(k,1840) + lu(k,1849) = lu(k,1849) - lu(k,1198) * lu(k,1840) + lu(k,1850) = lu(k,1850) - lu(k,1199) * lu(k,1840) + lu(k,1851) = lu(k,1851) - lu(k,1200) * lu(k,1840) + lu(k,1852) = lu(k,1852) - lu(k,1201) * lu(k,1840) + lu(k,1853) = lu(k,1853) - lu(k,1202) * lu(k,1840) + lu(k,1854) = lu(k,1854) - lu(k,1203) * lu(k,1840) + lu(k,1855) = lu(k,1855) - lu(k,1204) * lu(k,1840) + lu(k,1856) = lu(k,1856) - lu(k,1205) * lu(k,1840) + lu(k,1857) = lu(k,1857) - lu(k,1206) * lu(k,1840) + lu(k,1858) = lu(k,1858) - lu(k,1207) * lu(k,1840) + lu(k,1859) = lu(k,1859) - lu(k,1208) * lu(k,1840) + lu(k,1860) = lu(k,1860) - lu(k,1209) * lu(k,1840) + lu(k,1877) = lu(k,1877) - lu(k,1190) * lu(k,1876) + lu(k,1878) = lu(k,1878) - lu(k,1191) * lu(k,1876) + lu(k,1879) = lu(k,1879) - lu(k,1192) * lu(k,1876) + lu(k,1880) = lu(k,1880) - lu(k,1193) * lu(k,1876) + lu(k,1881) = lu(k,1881) - lu(k,1194) * lu(k,1876) + lu(k,1882) = lu(k,1882) - lu(k,1195) * lu(k,1876) + lu(k,1883) = lu(k,1883) - lu(k,1196) * lu(k,1876) + lu(k,1884) = lu(k,1884) - lu(k,1197) * lu(k,1876) + lu(k,1885) = lu(k,1885) - lu(k,1198) * lu(k,1876) + lu(k,1886) = lu(k,1886) - lu(k,1199) * lu(k,1876) + lu(k,1887) = lu(k,1887) - lu(k,1200) * lu(k,1876) + lu(k,1888) = lu(k,1888) - lu(k,1201) * lu(k,1876) + lu(k,1889) = lu(k,1889) - lu(k,1202) * lu(k,1876) + lu(k,1890) = lu(k,1890) - lu(k,1203) * lu(k,1876) + lu(k,1891) = lu(k,1891) - lu(k,1204) * lu(k,1876) + lu(k,1892) = lu(k,1892) - lu(k,1205) * lu(k,1876) + lu(k,1893) = lu(k,1893) - lu(k,1206) * lu(k,1876) + lu(k,1894) = lu(k,1894) - lu(k,1207) * lu(k,1876) + lu(k,1895) = lu(k,1895) - lu(k,1208) * lu(k,1876) + lu(k,1896) = lu(k,1896) - lu(k,1209) * lu(k,1876) + lu(k,1918) = lu(k,1918) - lu(k,1190) * lu(k,1917) + lu(k,1919) = lu(k,1919) - lu(k,1191) * lu(k,1917) + lu(k,1920) = lu(k,1920) - lu(k,1192) * lu(k,1917) + lu(k,1921) = lu(k,1921) - lu(k,1193) * lu(k,1917) + lu(k,1922) = lu(k,1922) - lu(k,1194) * lu(k,1917) + lu(k,1923) = lu(k,1923) - lu(k,1195) * lu(k,1917) + lu(k,1924) = lu(k,1924) - lu(k,1196) * lu(k,1917) + lu(k,1925) = lu(k,1925) - lu(k,1197) * lu(k,1917) + lu(k,1926) = lu(k,1926) - lu(k,1198) * lu(k,1917) + lu(k,1927) = lu(k,1927) - lu(k,1199) * lu(k,1917) + lu(k,1928) = lu(k,1928) - lu(k,1200) * lu(k,1917) + lu(k,1929) = lu(k,1929) - lu(k,1201) * lu(k,1917) + lu(k,1930) = lu(k,1930) - lu(k,1202) * lu(k,1917) + lu(k,1931) = lu(k,1931) - lu(k,1203) * lu(k,1917) + lu(k,1932) = lu(k,1932) - lu(k,1204) * lu(k,1917) + lu(k,1933) = lu(k,1933) - lu(k,1205) * lu(k,1917) + lu(k,1934) = lu(k,1934) - lu(k,1206) * lu(k,1917) + lu(k,1935) = lu(k,1935) - lu(k,1207) * lu(k,1917) + lu(k,1936) = lu(k,1936) - lu(k,1208) * lu(k,1917) + lu(k,1937) = lu(k,1937) - lu(k,1209) * lu(k,1917) + lu(k,1960) = lu(k,1960) - lu(k,1190) * lu(k,1959) + lu(k,1961) = lu(k,1961) - lu(k,1191) * lu(k,1959) + lu(k,1962) = lu(k,1962) - lu(k,1192) * lu(k,1959) + lu(k,1963) = lu(k,1963) - lu(k,1193) * lu(k,1959) + lu(k,1964) = lu(k,1964) - lu(k,1194) * lu(k,1959) + lu(k,1965) = lu(k,1965) - lu(k,1195) * lu(k,1959) + lu(k,1966) = lu(k,1966) - lu(k,1196) * lu(k,1959) + lu(k,1967) = lu(k,1967) - lu(k,1197) * lu(k,1959) + lu(k,1968) = lu(k,1968) - lu(k,1198) * lu(k,1959) + lu(k,1969) = lu(k,1969) - lu(k,1199) * lu(k,1959) + lu(k,1970) = lu(k,1970) - lu(k,1200) * lu(k,1959) + lu(k,1971) = lu(k,1971) - lu(k,1201) * lu(k,1959) + lu(k,1972) = lu(k,1972) - lu(k,1202) * lu(k,1959) + lu(k,1973) = lu(k,1973) - lu(k,1203) * lu(k,1959) + lu(k,1974) = lu(k,1974) - lu(k,1204) * lu(k,1959) + lu(k,1975) = lu(k,1975) - lu(k,1205) * lu(k,1959) + lu(k,1976) = lu(k,1976) - lu(k,1206) * lu(k,1959) + lu(k,1977) = lu(k,1977) - lu(k,1207) * lu(k,1959) + lu(k,1978) = lu(k,1978) - lu(k,1208) * lu(k,1959) + lu(k,1979) = lu(k,1979) - lu(k,1209) * lu(k,1959) + lu(k,2008) = lu(k,2008) - lu(k,1190) * lu(k,2007) + lu(k,2009) = lu(k,2009) - lu(k,1191) * lu(k,2007) + lu(k,2010) = lu(k,2010) - lu(k,1192) * lu(k,2007) + lu(k,2011) = lu(k,2011) - lu(k,1193) * lu(k,2007) + lu(k,2012) = lu(k,2012) - lu(k,1194) * lu(k,2007) + lu(k,2013) = lu(k,2013) - lu(k,1195) * lu(k,2007) + lu(k,2014) = lu(k,2014) - lu(k,1196) * lu(k,2007) + lu(k,2015) = lu(k,2015) - lu(k,1197) * lu(k,2007) + lu(k,2016) = lu(k,2016) - lu(k,1198) * lu(k,2007) + lu(k,2017) = lu(k,2017) - lu(k,1199) * lu(k,2007) + lu(k,2018) = lu(k,2018) - lu(k,1200) * lu(k,2007) + lu(k,2019) = lu(k,2019) - lu(k,1201) * lu(k,2007) + lu(k,2020) = lu(k,2020) - lu(k,1202) * lu(k,2007) + lu(k,2021) = lu(k,2021) - lu(k,1203) * lu(k,2007) + lu(k,2022) = lu(k,2022) - lu(k,1204) * lu(k,2007) + lu(k,2023) = lu(k,2023) - lu(k,1205) * lu(k,2007) + lu(k,2024) = lu(k,2024) - lu(k,1206) * lu(k,2007) + lu(k,2025) = lu(k,2025) - lu(k,1207) * lu(k,2007) + lu(k,2026) = lu(k,2026) - lu(k,1208) * lu(k,2007) + lu(k,2027) = lu(k,2027) - lu(k,1209) * lu(k,2007) + lu(k,2068) = lu(k,2068) - lu(k,1190) * lu(k,2067) + lu(k,2069) = lu(k,2069) - lu(k,1191) * lu(k,2067) + lu(k,2070) = lu(k,2070) - lu(k,1192) * lu(k,2067) + lu(k,2071) = lu(k,2071) - lu(k,1193) * lu(k,2067) + lu(k,2072) = lu(k,2072) - lu(k,1194) * lu(k,2067) + lu(k,2073) = lu(k,2073) - lu(k,1195) * lu(k,2067) + lu(k,2074) = lu(k,2074) - lu(k,1196) * lu(k,2067) + lu(k,2075) = lu(k,2075) - lu(k,1197) * lu(k,2067) + lu(k,2076) = lu(k,2076) - lu(k,1198) * lu(k,2067) + lu(k,2077) = lu(k,2077) - lu(k,1199) * lu(k,2067) + lu(k,2078) = lu(k,2078) - lu(k,1200) * lu(k,2067) + lu(k,2079) = lu(k,2079) - lu(k,1201) * lu(k,2067) + lu(k,2080) = lu(k,2080) - lu(k,1202) * lu(k,2067) + lu(k,2081) = lu(k,2081) - lu(k,1203) * lu(k,2067) + lu(k,2082) = lu(k,2082) - lu(k,1204) * lu(k,2067) + lu(k,2083) = lu(k,2083) - lu(k,1205) * lu(k,2067) + lu(k,2084) = lu(k,2084) - lu(k,1206) * lu(k,2067) + lu(k,2085) = lu(k,2085) - lu(k,1207) * lu(k,2067) + lu(k,2086) = lu(k,2086) - lu(k,1208) * lu(k,2067) + lu(k,2087) = lu(k,2087) - lu(k,1209) * lu(k,2067) + end do + end subroutine lu_fac22 + subroutine lu_fac23( 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,1231) = 1._r8 / lu(k,1231) + lu(k,1232) = lu(k,1232) * lu(k,1231) + lu(k,1233) = lu(k,1233) * lu(k,1231) + lu(k,1234) = lu(k,1234) * lu(k,1231) + lu(k,1235) = lu(k,1235) * lu(k,1231) + lu(k,1236) = lu(k,1236) * lu(k,1231) + lu(k,1237) = lu(k,1237) * lu(k,1231) + lu(k,1238) = lu(k,1238) * lu(k,1231) + lu(k,1239) = lu(k,1239) * lu(k,1231) + lu(k,1240) = lu(k,1240) * lu(k,1231) + lu(k,1241) = lu(k,1241) * lu(k,1231) + lu(k,1242) = lu(k,1242) * lu(k,1231) + lu(k,1243) = lu(k,1243) * lu(k,1231) + lu(k,1244) = lu(k,1244) * lu(k,1231) + lu(k,1245) = lu(k,1245) * lu(k,1231) + lu(k,1246) = lu(k,1246) * lu(k,1231) + lu(k,1247) = lu(k,1247) * lu(k,1231) + lu(k,1248) = lu(k,1248) * lu(k,1231) + lu(k,1249) = lu(k,1249) * lu(k,1231) + lu(k,1250) = lu(k,1250) * lu(k,1231) + lu(k,1292) = lu(k,1292) - lu(k,1232) * lu(k,1291) + lu(k,1293) = lu(k,1293) - lu(k,1233) * lu(k,1291) + lu(k,1294) = lu(k,1294) - lu(k,1234) * lu(k,1291) + lu(k,1295) = lu(k,1295) - lu(k,1235) * lu(k,1291) + lu(k,1296) = lu(k,1296) - lu(k,1236) * lu(k,1291) + lu(k,1297) = lu(k,1297) - lu(k,1237) * lu(k,1291) + lu(k,1298) = lu(k,1298) - lu(k,1238) * lu(k,1291) + lu(k,1299) = lu(k,1299) - lu(k,1239) * lu(k,1291) + lu(k,1300) = lu(k,1300) - lu(k,1240) * lu(k,1291) + lu(k,1301) = lu(k,1301) - lu(k,1241) * lu(k,1291) + lu(k,1302) = lu(k,1302) - lu(k,1242) * lu(k,1291) + lu(k,1303) = lu(k,1303) - lu(k,1243) * lu(k,1291) + lu(k,1304) = lu(k,1304) - lu(k,1244) * lu(k,1291) + lu(k,1305) = lu(k,1305) - lu(k,1245) * lu(k,1291) + lu(k,1306) = lu(k,1306) - lu(k,1246) * lu(k,1291) + lu(k,1307) = lu(k,1307) - lu(k,1247) * lu(k,1291) + lu(k,1308) = lu(k,1308) - lu(k,1248) * lu(k,1291) + lu(k,1309) = lu(k,1309) - lu(k,1249) * lu(k,1291) + lu(k,1310) = lu(k,1310) - lu(k,1250) * lu(k,1291) + lu(k,1334) = lu(k,1334) - lu(k,1232) * lu(k,1333) + lu(k,1335) = lu(k,1335) - lu(k,1233) * lu(k,1333) + lu(k,1336) = lu(k,1336) - lu(k,1234) * lu(k,1333) + lu(k,1337) = lu(k,1337) - lu(k,1235) * lu(k,1333) + lu(k,1338) = lu(k,1338) - lu(k,1236) * lu(k,1333) + lu(k,1339) = lu(k,1339) - lu(k,1237) * lu(k,1333) + lu(k,1340) = lu(k,1340) - lu(k,1238) * lu(k,1333) + lu(k,1341) = lu(k,1341) - lu(k,1239) * lu(k,1333) + lu(k,1342) = lu(k,1342) - lu(k,1240) * lu(k,1333) + lu(k,1343) = lu(k,1343) - lu(k,1241) * lu(k,1333) + lu(k,1344) = lu(k,1344) - lu(k,1242) * lu(k,1333) + lu(k,1345) = lu(k,1345) - lu(k,1243) * lu(k,1333) + lu(k,1346) = lu(k,1346) - lu(k,1244) * lu(k,1333) + lu(k,1347) = lu(k,1347) - lu(k,1245) * lu(k,1333) + lu(k,1348) = lu(k,1348) - lu(k,1246) * lu(k,1333) + lu(k,1349) = lu(k,1349) - lu(k,1247) * lu(k,1333) + lu(k,1350) = lu(k,1350) - lu(k,1248) * lu(k,1333) + lu(k,1351) = lu(k,1351) - lu(k,1249) * lu(k,1333) + lu(k,1352) = lu(k,1352) - lu(k,1250) * lu(k,1333) + lu(k,1370) = lu(k,1370) - lu(k,1232) * lu(k,1369) + lu(k,1371) = lu(k,1371) - lu(k,1233) * lu(k,1369) + lu(k,1372) = lu(k,1372) - lu(k,1234) * lu(k,1369) + lu(k,1373) = lu(k,1373) - lu(k,1235) * lu(k,1369) + lu(k,1374) = lu(k,1374) - lu(k,1236) * lu(k,1369) + lu(k,1375) = lu(k,1375) - lu(k,1237) * lu(k,1369) + lu(k,1376) = lu(k,1376) - lu(k,1238) * lu(k,1369) + lu(k,1377) = lu(k,1377) - lu(k,1239) * lu(k,1369) + lu(k,1378) = lu(k,1378) - lu(k,1240) * lu(k,1369) + lu(k,1379) = lu(k,1379) - lu(k,1241) * lu(k,1369) + lu(k,1380) = lu(k,1380) - lu(k,1242) * lu(k,1369) + lu(k,1381) = lu(k,1381) - lu(k,1243) * lu(k,1369) + lu(k,1382) = lu(k,1382) - lu(k,1244) * lu(k,1369) + lu(k,1383) = lu(k,1383) - lu(k,1245) * lu(k,1369) + lu(k,1384) = lu(k,1384) - lu(k,1246) * lu(k,1369) + lu(k,1385) = lu(k,1385) - lu(k,1247) * lu(k,1369) + lu(k,1386) = lu(k,1386) - lu(k,1248) * lu(k,1369) + lu(k,1387) = lu(k,1387) - lu(k,1249) * lu(k,1369) + lu(k,1388) = lu(k,1388) - lu(k,1250) * lu(k,1369) + lu(k,1413) = lu(k,1413) - lu(k,1232) * lu(k,1412) + lu(k,1414) = lu(k,1414) - lu(k,1233) * lu(k,1412) + lu(k,1415) = lu(k,1415) - lu(k,1234) * lu(k,1412) + lu(k,1416) = lu(k,1416) - lu(k,1235) * lu(k,1412) + lu(k,1417) = lu(k,1417) - lu(k,1236) * lu(k,1412) + lu(k,1418) = lu(k,1418) - lu(k,1237) * lu(k,1412) + lu(k,1419) = lu(k,1419) - lu(k,1238) * lu(k,1412) + lu(k,1420) = lu(k,1420) - lu(k,1239) * lu(k,1412) + lu(k,1421) = lu(k,1421) - lu(k,1240) * lu(k,1412) + lu(k,1422) = lu(k,1422) - lu(k,1241) * lu(k,1412) + lu(k,1423) = lu(k,1423) - lu(k,1242) * lu(k,1412) + lu(k,1424) = lu(k,1424) - lu(k,1243) * lu(k,1412) + lu(k,1425) = lu(k,1425) - lu(k,1244) * lu(k,1412) + lu(k,1426) = lu(k,1426) - lu(k,1245) * lu(k,1412) + lu(k,1427) = lu(k,1427) - lu(k,1246) * lu(k,1412) + lu(k,1428) = lu(k,1428) - lu(k,1247) * lu(k,1412) + lu(k,1429) = lu(k,1429) - lu(k,1248) * lu(k,1412) + lu(k,1430) = lu(k,1430) - lu(k,1249) * lu(k,1412) + lu(k,1431) = lu(k,1431) - lu(k,1250) * lu(k,1412) + lu(k,1456) = lu(k,1456) - lu(k,1232) * lu(k,1455) + lu(k,1457) = lu(k,1457) - lu(k,1233) * lu(k,1455) + lu(k,1458) = lu(k,1458) - lu(k,1234) * lu(k,1455) + lu(k,1459) = lu(k,1459) - lu(k,1235) * lu(k,1455) + lu(k,1460) = lu(k,1460) - lu(k,1236) * lu(k,1455) + lu(k,1461) = lu(k,1461) - lu(k,1237) * lu(k,1455) + lu(k,1462) = lu(k,1462) - lu(k,1238) * lu(k,1455) + lu(k,1463) = lu(k,1463) - lu(k,1239) * lu(k,1455) + lu(k,1464) = lu(k,1464) - lu(k,1240) * lu(k,1455) + lu(k,1465) = lu(k,1465) - lu(k,1241) * lu(k,1455) + lu(k,1466) = lu(k,1466) - lu(k,1242) * lu(k,1455) + lu(k,1467) = lu(k,1467) - lu(k,1243) * lu(k,1455) + lu(k,1468) = lu(k,1468) - lu(k,1244) * lu(k,1455) + lu(k,1469) = lu(k,1469) - lu(k,1245) * lu(k,1455) + lu(k,1470) = lu(k,1470) - lu(k,1246) * lu(k,1455) + lu(k,1471) = lu(k,1471) - lu(k,1247) * lu(k,1455) + lu(k,1472) = lu(k,1472) - lu(k,1248) * lu(k,1455) + lu(k,1473) = lu(k,1473) - lu(k,1249) * lu(k,1455) + lu(k,1474) = lu(k,1474) - lu(k,1250) * lu(k,1455) + lu(k,1501) = lu(k,1501) - lu(k,1232) * lu(k,1500) + lu(k,1502) = lu(k,1502) - lu(k,1233) * lu(k,1500) + lu(k,1503) = lu(k,1503) - lu(k,1234) * lu(k,1500) + lu(k,1504) = lu(k,1504) - lu(k,1235) * lu(k,1500) + lu(k,1505) = lu(k,1505) - lu(k,1236) * lu(k,1500) + lu(k,1506) = lu(k,1506) - lu(k,1237) * lu(k,1500) + lu(k,1507) = lu(k,1507) - lu(k,1238) * lu(k,1500) + lu(k,1508) = lu(k,1508) - lu(k,1239) * lu(k,1500) + lu(k,1509) = lu(k,1509) - lu(k,1240) * lu(k,1500) + lu(k,1510) = lu(k,1510) - lu(k,1241) * lu(k,1500) + lu(k,1511) = lu(k,1511) - lu(k,1242) * lu(k,1500) + lu(k,1512) = lu(k,1512) - lu(k,1243) * lu(k,1500) + lu(k,1513) = lu(k,1513) - lu(k,1244) * lu(k,1500) + lu(k,1514) = lu(k,1514) - lu(k,1245) * lu(k,1500) + lu(k,1515) = lu(k,1515) - lu(k,1246) * lu(k,1500) + lu(k,1516) = lu(k,1516) - lu(k,1247) * lu(k,1500) + lu(k,1517) = lu(k,1517) - lu(k,1248) * lu(k,1500) + lu(k,1518) = lu(k,1518) - lu(k,1249) * lu(k,1500) + lu(k,1519) = lu(k,1519) - lu(k,1250) * lu(k,1500) + lu(k,1537) = lu(k,1537) - lu(k,1232) * lu(k,1536) + lu(k,1538) = lu(k,1538) - lu(k,1233) * lu(k,1536) + lu(k,1539) = lu(k,1539) - lu(k,1234) * lu(k,1536) + lu(k,1540) = lu(k,1540) - lu(k,1235) * lu(k,1536) + lu(k,1541) = lu(k,1541) - lu(k,1236) * lu(k,1536) + lu(k,1542) = lu(k,1542) - lu(k,1237) * lu(k,1536) + lu(k,1543) = lu(k,1543) - lu(k,1238) * lu(k,1536) + lu(k,1544) = lu(k,1544) - lu(k,1239) * lu(k,1536) + lu(k,1545) = lu(k,1545) - lu(k,1240) * lu(k,1536) + lu(k,1546) = lu(k,1546) - lu(k,1241) * lu(k,1536) + lu(k,1547) = lu(k,1547) - lu(k,1242) * lu(k,1536) + lu(k,1548) = lu(k,1548) - lu(k,1243) * lu(k,1536) + lu(k,1549) = lu(k,1549) - lu(k,1244) * lu(k,1536) + lu(k,1550) = lu(k,1550) - lu(k,1245) * lu(k,1536) + lu(k,1551) = lu(k,1551) - lu(k,1246) * lu(k,1536) + lu(k,1552) = lu(k,1552) - lu(k,1247) * lu(k,1536) + lu(k,1553) = lu(k,1553) - lu(k,1248) * lu(k,1536) + lu(k,1554) = lu(k,1554) - lu(k,1249) * lu(k,1536) + lu(k,1555) = lu(k,1555) - lu(k,1250) * lu(k,1536) + lu(k,1582) = lu(k,1582) - lu(k,1232) * lu(k,1581) + lu(k,1583) = lu(k,1583) - lu(k,1233) * lu(k,1581) + lu(k,1584) = lu(k,1584) - lu(k,1234) * lu(k,1581) + lu(k,1585) = lu(k,1585) - lu(k,1235) * lu(k,1581) + lu(k,1586) = lu(k,1586) - lu(k,1236) * lu(k,1581) + lu(k,1587) = lu(k,1587) - lu(k,1237) * lu(k,1581) + lu(k,1588) = lu(k,1588) - lu(k,1238) * lu(k,1581) + lu(k,1589) = lu(k,1589) - lu(k,1239) * lu(k,1581) + lu(k,1590) = lu(k,1590) - lu(k,1240) * lu(k,1581) + lu(k,1591) = lu(k,1591) - lu(k,1241) * lu(k,1581) + lu(k,1592) = lu(k,1592) - lu(k,1242) * lu(k,1581) + lu(k,1593) = lu(k,1593) - lu(k,1243) * lu(k,1581) + lu(k,1594) = lu(k,1594) - lu(k,1244) * lu(k,1581) + lu(k,1595) = lu(k,1595) - lu(k,1245) * lu(k,1581) + lu(k,1596) = lu(k,1596) - lu(k,1246) * lu(k,1581) + lu(k,1597) = lu(k,1597) - lu(k,1247) * lu(k,1581) + lu(k,1598) = lu(k,1598) - lu(k,1248) * lu(k,1581) + lu(k,1599) = lu(k,1599) - lu(k,1249) * lu(k,1581) + lu(k,1600) = lu(k,1600) - lu(k,1250) * lu(k,1581) + lu(k,1630) = lu(k,1630) - lu(k,1232) * lu(k,1629) + lu(k,1631) = lu(k,1631) - lu(k,1233) * lu(k,1629) + lu(k,1632) = lu(k,1632) - lu(k,1234) * lu(k,1629) + lu(k,1633) = lu(k,1633) - lu(k,1235) * lu(k,1629) + lu(k,1634) = lu(k,1634) - lu(k,1236) * lu(k,1629) + lu(k,1635) = lu(k,1635) - lu(k,1237) * lu(k,1629) + lu(k,1636) = lu(k,1636) - lu(k,1238) * lu(k,1629) + lu(k,1637) = lu(k,1637) - lu(k,1239) * lu(k,1629) + lu(k,1638) = lu(k,1638) - lu(k,1240) * lu(k,1629) + lu(k,1639) = lu(k,1639) - lu(k,1241) * lu(k,1629) + lu(k,1640) = lu(k,1640) - lu(k,1242) * lu(k,1629) + lu(k,1641) = lu(k,1641) - lu(k,1243) * lu(k,1629) + lu(k,1642) = lu(k,1642) - lu(k,1244) * lu(k,1629) + lu(k,1643) = lu(k,1643) - lu(k,1245) * lu(k,1629) + lu(k,1644) = lu(k,1644) - lu(k,1246) * lu(k,1629) + lu(k,1645) = lu(k,1645) - lu(k,1247) * lu(k,1629) + lu(k,1646) = lu(k,1646) - lu(k,1248) * lu(k,1629) + lu(k,1647) = lu(k,1647) - lu(k,1249) * lu(k,1629) + lu(k,1648) = lu(k,1648) - lu(k,1250) * lu(k,1629) + lu(k,1673) = lu(k,1673) - lu(k,1232) * lu(k,1672) + lu(k,1674) = lu(k,1674) - lu(k,1233) * lu(k,1672) + lu(k,1675) = lu(k,1675) - lu(k,1234) * lu(k,1672) + lu(k,1676) = lu(k,1676) - lu(k,1235) * lu(k,1672) + lu(k,1677) = lu(k,1677) - lu(k,1236) * lu(k,1672) + lu(k,1678) = lu(k,1678) - lu(k,1237) * lu(k,1672) + lu(k,1679) = lu(k,1679) - lu(k,1238) * lu(k,1672) + lu(k,1680) = lu(k,1680) - lu(k,1239) * lu(k,1672) + lu(k,1681) = lu(k,1681) - lu(k,1240) * lu(k,1672) + lu(k,1682) = lu(k,1682) - lu(k,1241) * lu(k,1672) + lu(k,1683) = lu(k,1683) - lu(k,1242) * lu(k,1672) + lu(k,1684) = lu(k,1684) - lu(k,1243) * lu(k,1672) + lu(k,1685) = lu(k,1685) - lu(k,1244) * lu(k,1672) + lu(k,1686) = lu(k,1686) - lu(k,1245) * lu(k,1672) + lu(k,1687) = lu(k,1687) - lu(k,1246) * lu(k,1672) + lu(k,1688) = lu(k,1688) - lu(k,1247) * lu(k,1672) + lu(k,1689) = lu(k,1689) - lu(k,1248) * lu(k,1672) + lu(k,1690) = lu(k,1690) - lu(k,1249) * lu(k,1672) + lu(k,1691) = lu(k,1691) - lu(k,1250) * lu(k,1672) + lu(k,1715) = lu(k,1715) - lu(k,1232) * lu(k,1714) + lu(k,1716) = lu(k,1716) - lu(k,1233) * lu(k,1714) + lu(k,1717) = lu(k,1717) - lu(k,1234) * lu(k,1714) + lu(k,1718) = lu(k,1718) - lu(k,1235) * lu(k,1714) + lu(k,1719) = lu(k,1719) - lu(k,1236) * lu(k,1714) + lu(k,1720) = lu(k,1720) - lu(k,1237) * lu(k,1714) + lu(k,1721) = lu(k,1721) - lu(k,1238) * lu(k,1714) + lu(k,1722) = lu(k,1722) - lu(k,1239) * lu(k,1714) + lu(k,1723) = lu(k,1723) - lu(k,1240) * lu(k,1714) + lu(k,1724) = lu(k,1724) - lu(k,1241) * lu(k,1714) + lu(k,1725) = lu(k,1725) - lu(k,1242) * lu(k,1714) + lu(k,1726) = lu(k,1726) - lu(k,1243) * lu(k,1714) + lu(k,1727) = lu(k,1727) - lu(k,1244) * lu(k,1714) + lu(k,1728) = lu(k,1728) - lu(k,1245) * lu(k,1714) + lu(k,1729) = lu(k,1729) - lu(k,1246) * lu(k,1714) + lu(k,1730) = lu(k,1730) - lu(k,1247) * lu(k,1714) + lu(k,1731) = lu(k,1731) - lu(k,1248) * lu(k,1714) + lu(k,1732) = lu(k,1732) - lu(k,1249) * lu(k,1714) + lu(k,1733) = lu(k,1733) - lu(k,1250) * lu(k,1714) + lu(k,1760) = lu(k,1760) - lu(k,1232) * lu(k,1759) + lu(k,1761) = lu(k,1761) - lu(k,1233) * lu(k,1759) + lu(k,1762) = lu(k,1762) - lu(k,1234) * lu(k,1759) + lu(k,1763) = lu(k,1763) - lu(k,1235) * lu(k,1759) + lu(k,1764) = lu(k,1764) - lu(k,1236) * lu(k,1759) + lu(k,1765) = lu(k,1765) - lu(k,1237) * lu(k,1759) + lu(k,1766) = lu(k,1766) - lu(k,1238) * lu(k,1759) + lu(k,1767) = lu(k,1767) - lu(k,1239) * lu(k,1759) + lu(k,1768) = lu(k,1768) - lu(k,1240) * lu(k,1759) + lu(k,1769) = lu(k,1769) - lu(k,1241) * lu(k,1759) + lu(k,1770) = lu(k,1770) - lu(k,1242) * lu(k,1759) + lu(k,1771) = lu(k,1771) - lu(k,1243) * lu(k,1759) + lu(k,1772) = lu(k,1772) - lu(k,1244) * lu(k,1759) + lu(k,1773) = lu(k,1773) - lu(k,1245) * lu(k,1759) + lu(k,1774) = lu(k,1774) - lu(k,1246) * lu(k,1759) + lu(k,1775) = lu(k,1775) - lu(k,1247) * lu(k,1759) + lu(k,1776) = lu(k,1776) - lu(k,1248) * lu(k,1759) + lu(k,1777) = lu(k,1777) - lu(k,1249) * lu(k,1759) + lu(k,1778) = lu(k,1778) - lu(k,1250) * lu(k,1759) + lu(k,1809) = lu(k,1809) - lu(k,1232) * lu(k,1808) + lu(k,1810) = lu(k,1810) - lu(k,1233) * lu(k,1808) + lu(k,1811) = lu(k,1811) - lu(k,1234) * lu(k,1808) + lu(k,1812) = lu(k,1812) - lu(k,1235) * lu(k,1808) + lu(k,1813) = lu(k,1813) - lu(k,1236) * lu(k,1808) + lu(k,1814) = lu(k,1814) - lu(k,1237) * lu(k,1808) + lu(k,1815) = lu(k,1815) - lu(k,1238) * lu(k,1808) + lu(k,1816) = lu(k,1816) - lu(k,1239) * lu(k,1808) + lu(k,1817) = lu(k,1817) - lu(k,1240) * lu(k,1808) + lu(k,1818) = lu(k,1818) - lu(k,1241) * lu(k,1808) + lu(k,1819) = lu(k,1819) - lu(k,1242) * lu(k,1808) + lu(k,1820) = lu(k,1820) - lu(k,1243) * lu(k,1808) + lu(k,1821) = lu(k,1821) - lu(k,1244) * lu(k,1808) + lu(k,1822) = lu(k,1822) - lu(k,1245) * lu(k,1808) + lu(k,1823) = lu(k,1823) - lu(k,1246) * lu(k,1808) + lu(k,1824) = lu(k,1824) - lu(k,1247) * lu(k,1808) + lu(k,1825) = lu(k,1825) - lu(k,1248) * lu(k,1808) + lu(k,1826) = lu(k,1826) - lu(k,1249) * lu(k,1808) + lu(k,1827) = lu(k,1827) - lu(k,1250) * lu(k,1808) + lu(k,1842) = lu(k,1842) - lu(k,1232) * lu(k,1841) + lu(k,1843) = lu(k,1843) - lu(k,1233) * lu(k,1841) + lu(k,1844) = lu(k,1844) - lu(k,1234) * lu(k,1841) + lu(k,1845) = lu(k,1845) - lu(k,1235) * lu(k,1841) + lu(k,1846) = lu(k,1846) - lu(k,1236) * lu(k,1841) + lu(k,1847) = lu(k,1847) - lu(k,1237) * lu(k,1841) + lu(k,1848) = lu(k,1848) - lu(k,1238) * lu(k,1841) + lu(k,1849) = lu(k,1849) - lu(k,1239) * lu(k,1841) + lu(k,1850) = lu(k,1850) - lu(k,1240) * lu(k,1841) + lu(k,1851) = lu(k,1851) - lu(k,1241) * lu(k,1841) + lu(k,1852) = lu(k,1852) - lu(k,1242) * lu(k,1841) + lu(k,1853) = lu(k,1853) - lu(k,1243) * lu(k,1841) + lu(k,1854) = lu(k,1854) - lu(k,1244) * lu(k,1841) + lu(k,1855) = lu(k,1855) - lu(k,1245) * lu(k,1841) + lu(k,1856) = lu(k,1856) - lu(k,1246) * lu(k,1841) + lu(k,1857) = lu(k,1857) - lu(k,1247) * lu(k,1841) + lu(k,1858) = lu(k,1858) - lu(k,1248) * lu(k,1841) + lu(k,1859) = lu(k,1859) - lu(k,1249) * lu(k,1841) + lu(k,1860) = lu(k,1860) - lu(k,1250) * lu(k,1841) + lu(k,1878) = lu(k,1878) - lu(k,1232) * lu(k,1877) + lu(k,1879) = lu(k,1879) - lu(k,1233) * lu(k,1877) + lu(k,1880) = lu(k,1880) - lu(k,1234) * lu(k,1877) + lu(k,1881) = lu(k,1881) - lu(k,1235) * lu(k,1877) + lu(k,1882) = lu(k,1882) - lu(k,1236) * lu(k,1877) + lu(k,1883) = lu(k,1883) - lu(k,1237) * lu(k,1877) + lu(k,1884) = lu(k,1884) - lu(k,1238) * lu(k,1877) + lu(k,1885) = lu(k,1885) - lu(k,1239) * lu(k,1877) + lu(k,1886) = lu(k,1886) - lu(k,1240) * lu(k,1877) + lu(k,1887) = lu(k,1887) - lu(k,1241) * lu(k,1877) + lu(k,1888) = lu(k,1888) - lu(k,1242) * lu(k,1877) + lu(k,1889) = lu(k,1889) - lu(k,1243) * lu(k,1877) + lu(k,1890) = lu(k,1890) - lu(k,1244) * lu(k,1877) + lu(k,1891) = lu(k,1891) - lu(k,1245) * lu(k,1877) + lu(k,1892) = lu(k,1892) - lu(k,1246) * lu(k,1877) + lu(k,1893) = lu(k,1893) - lu(k,1247) * lu(k,1877) + lu(k,1894) = lu(k,1894) - lu(k,1248) * lu(k,1877) + lu(k,1895) = lu(k,1895) - lu(k,1249) * lu(k,1877) + lu(k,1896) = lu(k,1896) - lu(k,1250) * lu(k,1877) + lu(k,1919) = lu(k,1919) - lu(k,1232) * lu(k,1918) + lu(k,1920) = lu(k,1920) - lu(k,1233) * lu(k,1918) + lu(k,1921) = lu(k,1921) - lu(k,1234) * lu(k,1918) + lu(k,1922) = lu(k,1922) - lu(k,1235) * lu(k,1918) + lu(k,1923) = lu(k,1923) - lu(k,1236) * lu(k,1918) + lu(k,1924) = lu(k,1924) - lu(k,1237) * lu(k,1918) + lu(k,1925) = lu(k,1925) - lu(k,1238) * lu(k,1918) + lu(k,1926) = lu(k,1926) - lu(k,1239) * lu(k,1918) + lu(k,1927) = lu(k,1927) - lu(k,1240) * lu(k,1918) + lu(k,1928) = lu(k,1928) - lu(k,1241) * lu(k,1918) + lu(k,1929) = lu(k,1929) - lu(k,1242) * lu(k,1918) + lu(k,1930) = lu(k,1930) - lu(k,1243) * lu(k,1918) + lu(k,1931) = lu(k,1931) - lu(k,1244) * lu(k,1918) + lu(k,1932) = lu(k,1932) - lu(k,1245) * lu(k,1918) + lu(k,1933) = lu(k,1933) - lu(k,1246) * lu(k,1918) + lu(k,1934) = lu(k,1934) - lu(k,1247) * lu(k,1918) + lu(k,1935) = lu(k,1935) - lu(k,1248) * lu(k,1918) + lu(k,1936) = lu(k,1936) - lu(k,1249) * lu(k,1918) + lu(k,1937) = lu(k,1937) - lu(k,1250) * lu(k,1918) + lu(k,1961) = lu(k,1961) - lu(k,1232) * lu(k,1960) + lu(k,1962) = lu(k,1962) - lu(k,1233) * lu(k,1960) + lu(k,1963) = lu(k,1963) - lu(k,1234) * lu(k,1960) + lu(k,1964) = lu(k,1964) - lu(k,1235) * lu(k,1960) + lu(k,1965) = lu(k,1965) - lu(k,1236) * lu(k,1960) + lu(k,1966) = lu(k,1966) - lu(k,1237) * lu(k,1960) + lu(k,1967) = lu(k,1967) - lu(k,1238) * lu(k,1960) + lu(k,1968) = lu(k,1968) - lu(k,1239) * lu(k,1960) + lu(k,1969) = lu(k,1969) - lu(k,1240) * lu(k,1960) + lu(k,1970) = lu(k,1970) - lu(k,1241) * lu(k,1960) + lu(k,1971) = lu(k,1971) - lu(k,1242) * lu(k,1960) + lu(k,1972) = lu(k,1972) - lu(k,1243) * lu(k,1960) + lu(k,1973) = lu(k,1973) - lu(k,1244) * lu(k,1960) + lu(k,1974) = lu(k,1974) - lu(k,1245) * lu(k,1960) + lu(k,1975) = lu(k,1975) - lu(k,1246) * lu(k,1960) + lu(k,1976) = lu(k,1976) - lu(k,1247) * lu(k,1960) + lu(k,1977) = lu(k,1977) - lu(k,1248) * lu(k,1960) + lu(k,1978) = lu(k,1978) - lu(k,1249) * lu(k,1960) + lu(k,1979) = lu(k,1979) - lu(k,1250) * lu(k,1960) + lu(k,2009) = lu(k,2009) - lu(k,1232) * lu(k,2008) + lu(k,2010) = lu(k,2010) - lu(k,1233) * lu(k,2008) + lu(k,2011) = lu(k,2011) - lu(k,1234) * lu(k,2008) + lu(k,2012) = lu(k,2012) - lu(k,1235) * lu(k,2008) + lu(k,2013) = lu(k,2013) - lu(k,1236) * lu(k,2008) + lu(k,2014) = lu(k,2014) - lu(k,1237) * lu(k,2008) + lu(k,2015) = lu(k,2015) - lu(k,1238) * lu(k,2008) + lu(k,2016) = lu(k,2016) - lu(k,1239) * lu(k,2008) + lu(k,2017) = lu(k,2017) - lu(k,1240) * lu(k,2008) + lu(k,2018) = lu(k,2018) - lu(k,1241) * lu(k,2008) + lu(k,2019) = lu(k,2019) - lu(k,1242) * lu(k,2008) + lu(k,2020) = lu(k,2020) - lu(k,1243) * lu(k,2008) + lu(k,2021) = lu(k,2021) - lu(k,1244) * lu(k,2008) + lu(k,2022) = lu(k,2022) - lu(k,1245) * lu(k,2008) + lu(k,2023) = lu(k,2023) - lu(k,1246) * lu(k,2008) + lu(k,2024) = lu(k,2024) - lu(k,1247) * lu(k,2008) + lu(k,2025) = lu(k,2025) - lu(k,1248) * lu(k,2008) + lu(k,2026) = lu(k,2026) - lu(k,1249) * lu(k,2008) + lu(k,2027) = lu(k,2027) - lu(k,1250) * lu(k,2008) + lu(k,2069) = lu(k,2069) - lu(k,1232) * lu(k,2068) + lu(k,2070) = lu(k,2070) - lu(k,1233) * lu(k,2068) + lu(k,2071) = lu(k,2071) - lu(k,1234) * lu(k,2068) + lu(k,2072) = lu(k,2072) - lu(k,1235) * lu(k,2068) + lu(k,2073) = lu(k,2073) - lu(k,1236) * lu(k,2068) + lu(k,2074) = lu(k,2074) - lu(k,1237) * lu(k,2068) + lu(k,2075) = lu(k,2075) - lu(k,1238) * lu(k,2068) + lu(k,2076) = lu(k,2076) - lu(k,1239) * lu(k,2068) + lu(k,2077) = lu(k,2077) - lu(k,1240) * lu(k,2068) + lu(k,2078) = lu(k,2078) - lu(k,1241) * lu(k,2068) + lu(k,2079) = lu(k,2079) - lu(k,1242) * lu(k,2068) + lu(k,2080) = lu(k,2080) - lu(k,1243) * lu(k,2068) + lu(k,2081) = lu(k,2081) - lu(k,1244) * lu(k,2068) + lu(k,2082) = lu(k,2082) - lu(k,1245) * lu(k,2068) + lu(k,2083) = lu(k,2083) - lu(k,1246) * lu(k,2068) + lu(k,2084) = lu(k,2084) - lu(k,1247) * lu(k,2068) + lu(k,2085) = lu(k,2085) - lu(k,1248) * lu(k,2068) + lu(k,2086) = lu(k,2086) - lu(k,1249) * lu(k,2068) + lu(k,2087) = lu(k,2087) - lu(k,1250) * lu(k,2068) lu(k,1292) = 1._r8 / lu(k,1292) lu(k,1293) = lu(k,1293) * lu(k,1292) lu(k,1294) = lu(k,1294) * lu(k,1292) @@ -11920,468 +11886,645 @@ subroutine lu_fac22( avec_len, lu ) lu(k,1303) = lu(k,1303) * lu(k,1292) lu(k,1304) = lu(k,1304) * lu(k,1292) lu(k,1305) = lu(k,1305) * lu(k,1292) - lu(k,1328) = lu(k,1328) - lu(k,1293) * lu(k,1327) - lu(k,1329) = lu(k,1329) - lu(k,1294) * lu(k,1327) - lu(k,1330) = lu(k,1330) - lu(k,1295) * lu(k,1327) - lu(k,1331) = lu(k,1331) - lu(k,1296) * lu(k,1327) - lu(k,1332) = lu(k,1332) - lu(k,1297) * lu(k,1327) - lu(k,1333) = lu(k,1333) - lu(k,1298) * lu(k,1327) - lu(k,1334) = lu(k,1334) - lu(k,1299) * lu(k,1327) - lu(k,1335) = lu(k,1335) - lu(k,1300) * lu(k,1327) - lu(k,1336) = lu(k,1336) - lu(k,1301) * lu(k,1327) - lu(k,1337) = lu(k,1337) - lu(k,1302) * lu(k,1327) - lu(k,1338) = lu(k,1338) - lu(k,1303) * lu(k,1327) - lu(k,1339) = lu(k,1339) - lu(k,1304) * lu(k,1327) - lu(k,1340) = lu(k,1340) - lu(k,1305) * lu(k,1327) - lu(k,1372) = lu(k,1372) - lu(k,1293) * lu(k,1371) - lu(k,1373) = lu(k,1373) - lu(k,1294) * lu(k,1371) - lu(k,1374) = lu(k,1374) - lu(k,1295) * lu(k,1371) - lu(k,1375) = lu(k,1375) - lu(k,1296) * lu(k,1371) - lu(k,1376) = lu(k,1376) - lu(k,1297) * lu(k,1371) - lu(k,1377) = lu(k,1377) - lu(k,1298) * lu(k,1371) - lu(k,1378) = lu(k,1378) - lu(k,1299) * lu(k,1371) - lu(k,1379) = lu(k,1379) - lu(k,1300) * lu(k,1371) - lu(k,1380) = lu(k,1380) - lu(k,1301) * lu(k,1371) - lu(k,1381) = lu(k,1381) - lu(k,1302) * lu(k,1371) - lu(k,1382) = lu(k,1382) - lu(k,1303) * lu(k,1371) - lu(k,1383) = lu(k,1383) - lu(k,1304) * lu(k,1371) - lu(k,1384) = lu(k,1384) - lu(k,1305) * lu(k,1371) - lu(k,1431) = lu(k,1431) - lu(k,1293) * lu(k,1430) - lu(k,1432) = lu(k,1432) - lu(k,1294) * lu(k,1430) - lu(k,1433) = lu(k,1433) - lu(k,1295) * lu(k,1430) - lu(k,1434) = lu(k,1434) - lu(k,1296) * lu(k,1430) - lu(k,1435) = lu(k,1435) - lu(k,1297) * lu(k,1430) - lu(k,1436) = lu(k,1436) - lu(k,1298) * lu(k,1430) - lu(k,1437) = lu(k,1437) - lu(k,1299) * lu(k,1430) - lu(k,1438) = lu(k,1438) - lu(k,1300) * lu(k,1430) - lu(k,1439) = lu(k,1439) - lu(k,1301) * lu(k,1430) - lu(k,1440) = lu(k,1440) - lu(k,1302) * lu(k,1430) - lu(k,1441) = lu(k,1441) - lu(k,1303) * lu(k,1430) - lu(k,1442) = lu(k,1442) - lu(k,1304) * lu(k,1430) - lu(k,1443) = lu(k,1443) - lu(k,1305) * lu(k,1430) - lu(k,1473) = lu(k,1473) - lu(k,1293) * lu(k,1472) - lu(k,1474) = lu(k,1474) - lu(k,1294) * lu(k,1472) - lu(k,1475) = lu(k,1475) - lu(k,1295) * lu(k,1472) - lu(k,1476) = lu(k,1476) - lu(k,1296) * lu(k,1472) - lu(k,1477) = lu(k,1477) - lu(k,1297) * lu(k,1472) - lu(k,1478) = lu(k,1478) - lu(k,1298) * lu(k,1472) - lu(k,1479) = lu(k,1479) - lu(k,1299) * lu(k,1472) - lu(k,1480) = lu(k,1480) - lu(k,1300) * lu(k,1472) - lu(k,1481) = lu(k,1481) - lu(k,1301) * lu(k,1472) - lu(k,1482) = lu(k,1482) - lu(k,1302) * lu(k,1472) - lu(k,1483) = lu(k,1483) - lu(k,1303) * lu(k,1472) - lu(k,1484) = lu(k,1484) - lu(k,1304) * lu(k,1472) - lu(k,1485) = lu(k,1485) - lu(k,1305) * lu(k,1472) - lu(k,1514) = lu(k,1514) - lu(k,1293) * lu(k,1513) - lu(k,1515) = lu(k,1515) - lu(k,1294) * lu(k,1513) - lu(k,1516) = lu(k,1516) - lu(k,1295) * lu(k,1513) - lu(k,1517) = lu(k,1517) - lu(k,1296) * lu(k,1513) - lu(k,1518) = lu(k,1518) - lu(k,1297) * lu(k,1513) - lu(k,1519) = lu(k,1519) - lu(k,1298) * lu(k,1513) - lu(k,1520) = lu(k,1520) - lu(k,1299) * lu(k,1513) - lu(k,1521) = lu(k,1521) - lu(k,1300) * lu(k,1513) - lu(k,1522) = lu(k,1522) - lu(k,1301) * lu(k,1513) - lu(k,1523) = lu(k,1523) - lu(k,1302) * lu(k,1513) - lu(k,1524) = lu(k,1524) - lu(k,1303) * lu(k,1513) - lu(k,1525) = lu(k,1525) - lu(k,1304) * lu(k,1513) - lu(k,1526) = lu(k,1526) - lu(k,1305) * lu(k,1513) - lu(k,1556) = lu(k,1556) - lu(k,1293) * lu(k,1555) - lu(k,1557) = lu(k,1557) - lu(k,1294) * lu(k,1555) - lu(k,1558) = lu(k,1558) - lu(k,1295) * lu(k,1555) - lu(k,1559) = lu(k,1559) - lu(k,1296) * lu(k,1555) - lu(k,1560) = lu(k,1560) - lu(k,1297) * lu(k,1555) - lu(k,1561) = lu(k,1561) - lu(k,1298) * lu(k,1555) - lu(k,1562) = lu(k,1562) - lu(k,1299) * lu(k,1555) - lu(k,1563) = lu(k,1563) - lu(k,1300) * lu(k,1555) - lu(k,1564) = lu(k,1564) - lu(k,1301) * lu(k,1555) - lu(k,1565) = lu(k,1565) - lu(k,1302) * lu(k,1555) - lu(k,1566) = lu(k,1566) - lu(k,1303) * lu(k,1555) - lu(k,1567) = lu(k,1567) - lu(k,1304) * lu(k,1555) - lu(k,1568) = lu(k,1568) - lu(k,1305) * lu(k,1555) - lu(k,1598) = lu(k,1598) - lu(k,1293) * lu(k,1597) - lu(k,1599) = lu(k,1599) - lu(k,1294) * lu(k,1597) - lu(k,1600) = lu(k,1600) - lu(k,1295) * lu(k,1597) - lu(k,1601) = lu(k,1601) - lu(k,1296) * lu(k,1597) - lu(k,1602) = lu(k,1602) - lu(k,1297) * lu(k,1597) - lu(k,1603) = lu(k,1603) - lu(k,1298) * lu(k,1597) - lu(k,1604) = lu(k,1604) - lu(k,1299) * lu(k,1597) - lu(k,1605) = lu(k,1605) - lu(k,1300) * lu(k,1597) - lu(k,1606) = lu(k,1606) - lu(k,1301) * lu(k,1597) - lu(k,1607) = lu(k,1607) - lu(k,1302) * lu(k,1597) - lu(k,1608) = lu(k,1608) - lu(k,1303) * lu(k,1597) - lu(k,1609) = lu(k,1609) - lu(k,1304) * lu(k,1597) - lu(k,1610) = lu(k,1610) - lu(k,1305) * lu(k,1597) - lu(k,1630) = lu(k,1630) - lu(k,1293) * lu(k,1629) - lu(k,1631) = lu(k,1631) - lu(k,1294) * lu(k,1629) - lu(k,1632) = lu(k,1632) - lu(k,1295) * lu(k,1629) - lu(k,1633) = lu(k,1633) - lu(k,1296) * lu(k,1629) - lu(k,1634) = lu(k,1634) - lu(k,1297) * lu(k,1629) - lu(k,1635) = lu(k,1635) - lu(k,1298) * lu(k,1629) - lu(k,1636) = lu(k,1636) - lu(k,1299) * lu(k,1629) - lu(k,1637) = lu(k,1637) - lu(k,1300) * lu(k,1629) - lu(k,1638) = lu(k,1638) - lu(k,1301) * lu(k,1629) - lu(k,1639) = lu(k,1639) - lu(k,1302) * lu(k,1629) - lu(k,1640) = lu(k,1640) - lu(k,1303) * lu(k,1629) - lu(k,1641) = lu(k,1641) - lu(k,1304) * lu(k,1629) - lu(k,1642) = lu(k,1642) - lu(k,1305) * lu(k,1629) - lu(k,1665) = lu(k,1665) - lu(k,1293) * lu(k,1664) - lu(k,1666) = lu(k,1666) - lu(k,1294) * lu(k,1664) - lu(k,1667) = lu(k,1667) - lu(k,1295) * lu(k,1664) - lu(k,1668) = lu(k,1668) - lu(k,1296) * lu(k,1664) - lu(k,1669) = lu(k,1669) - lu(k,1297) * lu(k,1664) - lu(k,1670) = lu(k,1670) - lu(k,1298) * lu(k,1664) - lu(k,1671) = lu(k,1671) - lu(k,1299) * lu(k,1664) - lu(k,1672) = lu(k,1672) - lu(k,1300) * lu(k,1664) - lu(k,1673) = lu(k,1673) - lu(k,1301) * lu(k,1664) - lu(k,1674) = lu(k,1674) - lu(k,1302) * lu(k,1664) - lu(k,1675) = lu(k,1675) - lu(k,1303) * lu(k,1664) - lu(k,1676) = lu(k,1676) - lu(k,1304) * lu(k,1664) - lu(k,1677) = lu(k,1677) - lu(k,1305) * lu(k,1664) - lu(k,1707) = lu(k,1707) - lu(k,1293) * lu(k,1706) - lu(k,1708) = lu(k,1708) - lu(k,1294) * lu(k,1706) - lu(k,1709) = lu(k,1709) - lu(k,1295) * lu(k,1706) - lu(k,1710) = lu(k,1710) - lu(k,1296) * lu(k,1706) - lu(k,1711) = lu(k,1711) - lu(k,1297) * lu(k,1706) - lu(k,1712) = lu(k,1712) - lu(k,1298) * lu(k,1706) - lu(k,1713) = lu(k,1713) - lu(k,1299) * lu(k,1706) - lu(k,1714) = lu(k,1714) - lu(k,1300) * lu(k,1706) - lu(k,1715) = lu(k,1715) - lu(k,1301) * lu(k,1706) - lu(k,1716) = lu(k,1716) - lu(k,1302) * lu(k,1706) - lu(k,1717) = lu(k,1717) - lu(k,1303) * lu(k,1706) - lu(k,1718) = lu(k,1718) - lu(k,1304) * lu(k,1706) - lu(k,1719) = lu(k,1719) - lu(k,1305) * lu(k,1706) - lu(k,1751) = lu(k,1751) - lu(k,1293) * lu(k,1750) - lu(k,1752) = lu(k,1752) - lu(k,1294) * lu(k,1750) - lu(k,1753) = lu(k,1753) - lu(k,1295) * lu(k,1750) - lu(k,1754) = lu(k,1754) - lu(k,1296) * lu(k,1750) - lu(k,1755) = lu(k,1755) - lu(k,1297) * lu(k,1750) - lu(k,1756) = lu(k,1756) - lu(k,1298) * lu(k,1750) - lu(k,1757) = lu(k,1757) - lu(k,1299) * lu(k,1750) - lu(k,1758) = lu(k,1758) - lu(k,1300) * lu(k,1750) - lu(k,1759) = lu(k,1759) - lu(k,1301) * lu(k,1750) - lu(k,1760) = lu(k,1760) - lu(k,1302) * lu(k,1750) - lu(k,1761) = lu(k,1761) - lu(k,1303) * lu(k,1750) - lu(k,1762) = lu(k,1762) - lu(k,1304) * lu(k,1750) - lu(k,1763) = lu(k,1763) - lu(k,1305) * lu(k,1750) - lu(k,1786) = lu(k,1786) - lu(k,1293) * lu(k,1785) - lu(k,1787) = lu(k,1787) - lu(k,1294) * lu(k,1785) - lu(k,1788) = lu(k,1788) - lu(k,1295) * lu(k,1785) - lu(k,1789) = lu(k,1789) - lu(k,1296) * lu(k,1785) - lu(k,1790) = lu(k,1790) - lu(k,1297) * lu(k,1785) - lu(k,1791) = lu(k,1791) - lu(k,1298) * lu(k,1785) - lu(k,1792) = lu(k,1792) - lu(k,1299) * lu(k,1785) - lu(k,1793) = lu(k,1793) - lu(k,1300) * lu(k,1785) - lu(k,1794) = lu(k,1794) - lu(k,1301) * lu(k,1785) - lu(k,1795) = lu(k,1795) - lu(k,1302) * lu(k,1785) - lu(k,1796) = lu(k,1796) - lu(k,1303) * lu(k,1785) - lu(k,1797) = lu(k,1797) - lu(k,1304) * lu(k,1785) - lu(k,1798) = lu(k,1798) - lu(k,1305) * lu(k,1785) - lu(k,1844) = lu(k,1844) - lu(k,1293) * lu(k,1843) - lu(k,1845) = lu(k,1845) - lu(k,1294) * lu(k,1843) - lu(k,1846) = lu(k,1846) - lu(k,1295) * lu(k,1843) - lu(k,1847) = lu(k,1847) - lu(k,1296) * lu(k,1843) - lu(k,1848) = lu(k,1848) - lu(k,1297) * lu(k,1843) - lu(k,1849) = lu(k,1849) - lu(k,1298) * lu(k,1843) - lu(k,1850) = lu(k,1850) - lu(k,1299) * lu(k,1843) - lu(k,1851) = lu(k,1851) - lu(k,1300) * lu(k,1843) - lu(k,1852) = lu(k,1852) - lu(k,1301) * lu(k,1843) - lu(k,1853) = lu(k,1853) - lu(k,1302) * lu(k,1843) - lu(k,1854) = lu(k,1854) - lu(k,1303) * lu(k,1843) - lu(k,1855) = lu(k,1855) - lu(k,1304) * lu(k,1843) - lu(k,1856) = lu(k,1856) - lu(k,1305) * lu(k,1843) - lu(k,1328) = 1._r8 / lu(k,1328) - lu(k,1329) = lu(k,1329) * lu(k,1328) - lu(k,1330) = lu(k,1330) * lu(k,1328) - lu(k,1331) = lu(k,1331) * lu(k,1328) - lu(k,1332) = lu(k,1332) * lu(k,1328) - lu(k,1333) = lu(k,1333) * lu(k,1328) - lu(k,1334) = lu(k,1334) * lu(k,1328) - lu(k,1335) = lu(k,1335) * lu(k,1328) - lu(k,1336) = lu(k,1336) * lu(k,1328) - lu(k,1337) = lu(k,1337) * lu(k,1328) - lu(k,1338) = lu(k,1338) * lu(k,1328) - lu(k,1339) = lu(k,1339) * lu(k,1328) - lu(k,1340) = lu(k,1340) * lu(k,1328) - lu(k,1373) = lu(k,1373) - lu(k,1329) * lu(k,1372) - lu(k,1374) = lu(k,1374) - lu(k,1330) * lu(k,1372) - lu(k,1375) = lu(k,1375) - lu(k,1331) * lu(k,1372) - lu(k,1376) = lu(k,1376) - lu(k,1332) * lu(k,1372) - lu(k,1377) = lu(k,1377) - lu(k,1333) * lu(k,1372) - lu(k,1378) = lu(k,1378) - lu(k,1334) * lu(k,1372) - lu(k,1379) = lu(k,1379) - lu(k,1335) * lu(k,1372) - lu(k,1380) = lu(k,1380) - lu(k,1336) * lu(k,1372) - lu(k,1381) = lu(k,1381) - lu(k,1337) * lu(k,1372) - lu(k,1382) = lu(k,1382) - lu(k,1338) * lu(k,1372) - lu(k,1383) = lu(k,1383) - lu(k,1339) * lu(k,1372) - lu(k,1384) = lu(k,1384) - lu(k,1340) * lu(k,1372) - lu(k,1432) = lu(k,1432) - lu(k,1329) * lu(k,1431) - lu(k,1433) = lu(k,1433) - lu(k,1330) * lu(k,1431) - lu(k,1434) = lu(k,1434) - lu(k,1331) * lu(k,1431) - lu(k,1435) = lu(k,1435) - lu(k,1332) * lu(k,1431) - lu(k,1436) = lu(k,1436) - lu(k,1333) * lu(k,1431) - lu(k,1437) = lu(k,1437) - lu(k,1334) * lu(k,1431) - lu(k,1438) = lu(k,1438) - lu(k,1335) * lu(k,1431) - lu(k,1439) = lu(k,1439) - lu(k,1336) * lu(k,1431) - lu(k,1440) = lu(k,1440) - lu(k,1337) * lu(k,1431) - lu(k,1441) = lu(k,1441) - lu(k,1338) * lu(k,1431) - lu(k,1442) = lu(k,1442) - lu(k,1339) * lu(k,1431) - lu(k,1443) = lu(k,1443) - lu(k,1340) * lu(k,1431) - lu(k,1474) = lu(k,1474) - lu(k,1329) * lu(k,1473) - lu(k,1475) = lu(k,1475) - lu(k,1330) * lu(k,1473) - lu(k,1476) = lu(k,1476) - lu(k,1331) * lu(k,1473) - lu(k,1477) = lu(k,1477) - lu(k,1332) * lu(k,1473) - lu(k,1478) = lu(k,1478) - lu(k,1333) * lu(k,1473) - lu(k,1479) = lu(k,1479) - lu(k,1334) * lu(k,1473) - lu(k,1480) = lu(k,1480) - lu(k,1335) * lu(k,1473) - lu(k,1481) = lu(k,1481) - lu(k,1336) * lu(k,1473) - lu(k,1482) = lu(k,1482) - lu(k,1337) * lu(k,1473) - lu(k,1483) = lu(k,1483) - lu(k,1338) * lu(k,1473) - lu(k,1484) = lu(k,1484) - lu(k,1339) * lu(k,1473) - lu(k,1485) = lu(k,1485) - lu(k,1340) * lu(k,1473) - lu(k,1515) = lu(k,1515) - lu(k,1329) * lu(k,1514) - lu(k,1516) = lu(k,1516) - lu(k,1330) * lu(k,1514) - lu(k,1517) = lu(k,1517) - lu(k,1331) * lu(k,1514) - lu(k,1518) = lu(k,1518) - lu(k,1332) * lu(k,1514) - lu(k,1519) = lu(k,1519) - lu(k,1333) * lu(k,1514) - lu(k,1520) = lu(k,1520) - lu(k,1334) * lu(k,1514) - lu(k,1521) = lu(k,1521) - lu(k,1335) * lu(k,1514) - lu(k,1522) = lu(k,1522) - lu(k,1336) * lu(k,1514) - lu(k,1523) = lu(k,1523) - lu(k,1337) * lu(k,1514) - lu(k,1524) = lu(k,1524) - lu(k,1338) * lu(k,1514) - lu(k,1525) = lu(k,1525) - lu(k,1339) * lu(k,1514) - lu(k,1526) = lu(k,1526) - lu(k,1340) * lu(k,1514) - lu(k,1557) = lu(k,1557) - lu(k,1329) * lu(k,1556) - lu(k,1558) = lu(k,1558) - lu(k,1330) * lu(k,1556) - lu(k,1559) = lu(k,1559) - lu(k,1331) * lu(k,1556) - lu(k,1560) = lu(k,1560) - lu(k,1332) * lu(k,1556) - lu(k,1561) = lu(k,1561) - lu(k,1333) * lu(k,1556) - lu(k,1562) = lu(k,1562) - lu(k,1334) * lu(k,1556) - lu(k,1563) = lu(k,1563) - lu(k,1335) * lu(k,1556) - lu(k,1564) = lu(k,1564) - lu(k,1336) * lu(k,1556) - lu(k,1565) = lu(k,1565) - lu(k,1337) * lu(k,1556) - lu(k,1566) = lu(k,1566) - lu(k,1338) * lu(k,1556) - lu(k,1567) = lu(k,1567) - lu(k,1339) * lu(k,1556) - lu(k,1568) = lu(k,1568) - lu(k,1340) * lu(k,1556) - lu(k,1599) = lu(k,1599) - lu(k,1329) * lu(k,1598) - lu(k,1600) = lu(k,1600) - lu(k,1330) * lu(k,1598) - lu(k,1601) = lu(k,1601) - lu(k,1331) * lu(k,1598) - lu(k,1602) = lu(k,1602) - lu(k,1332) * lu(k,1598) - lu(k,1603) = lu(k,1603) - lu(k,1333) * lu(k,1598) - lu(k,1604) = lu(k,1604) - lu(k,1334) * lu(k,1598) - lu(k,1605) = lu(k,1605) - lu(k,1335) * lu(k,1598) - lu(k,1606) = lu(k,1606) - lu(k,1336) * lu(k,1598) - lu(k,1607) = lu(k,1607) - lu(k,1337) * lu(k,1598) - lu(k,1608) = lu(k,1608) - lu(k,1338) * lu(k,1598) - lu(k,1609) = lu(k,1609) - lu(k,1339) * lu(k,1598) - lu(k,1610) = lu(k,1610) - lu(k,1340) * lu(k,1598) - lu(k,1631) = lu(k,1631) - lu(k,1329) * lu(k,1630) - lu(k,1632) = lu(k,1632) - lu(k,1330) * lu(k,1630) - lu(k,1633) = lu(k,1633) - lu(k,1331) * lu(k,1630) - lu(k,1634) = lu(k,1634) - lu(k,1332) * lu(k,1630) - lu(k,1635) = lu(k,1635) - lu(k,1333) * lu(k,1630) - lu(k,1636) = lu(k,1636) - lu(k,1334) * lu(k,1630) - lu(k,1637) = lu(k,1637) - lu(k,1335) * lu(k,1630) - lu(k,1638) = lu(k,1638) - lu(k,1336) * lu(k,1630) - lu(k,1639) = lu(k,1639) - lu(k,1337) * lu(k,1630) - lu(k,1640) = lu(k,1640) - lu(k,1338) * lu(k,1630) - lu(k,1641) = lu(k,1641) - lu(k,1339) * lu(k,1630) - lu(k,1642) = lu(k,1642) - lu(k,1340) * lu(k,1630) - lu(k,1666) = lu(k,1666) - lu(k,1329) * lu(k,1665) - lu(k,1667) = lu(k,1667) - lu(k,1330) * lu(k,1665) - lu(k,1668) = lu(k,1668) - lu(k,1331) * lu(k,1665) - lu(k,1669) = lu(k,1669) - lu(k,1332) * lu(k,1665) - lu(k,1670) = lu(k,1670) - lu(k,1333) * lu(k,1665) - lu(k,1671) = lu(k,1671) - lu(k,1334) * lu(k,1665) - lu(k,1672) = lu(k,1672) - lu(k,1335) * lu(k,1665) - lu(k,1673) = lu(k,1673) - lu(k,1336) * lu(k,1665) - lu(k,1674) = lu(k,1674) - lu(k,1337) * lu(k,1665) - lu(k,1675) = lu(k,1675) - lu(k,1338) * lu(k,1665) - lu(k,1676) = lu(k,1676) - lu(k,1339) * lu(k,1665) - lu(k,1677) = lu(k,1677) - lu(k,1340) * lu(k,1665) - lu(k,1708) = lu(k,1708) - lu(k,1329) * lu(k,1707) - lu(k,1709) = lu(k,1709) - lu(k,1330) * lu(k,1707) - lu(k,1710) = lu(k,1710) - lu(k,1331) * lu(k,1707) - lu(k,1711) = lu(k,1711) - lu(k,1332) * lu(k,1707) - lu(k,1712) = lu(k,1712) - lu(k,1333) * lu(k,1707) - lu(k,1713) = lu(k,1713) - lu(k,1334) * lu(k,1707) - lu(k,1714) = lu(k,1714) - lu(k,1335) * lu(k,1707) - lu(k,1715) = lu(k,1715) - lu(k,1336) * lu(k,1707) - lu(k,1716) = lu(k,1716) - lu(k,1337) * lu(k,1707) - lu(k,1717) = lu(k,1717) - lu(k,1338) * lu(k,1707) - lu(k,1718) = lu(k,1718) - lu(k,1339) * lu(k,1707) - lu(k,1719) = lu(k,1719) - lu(k,1340) * lu(k,1707) - lu(k,1752) = lu(k,1752) - lu(k,1329) * lu(k,1751) - lu(k,1753) = lu(k,1753) - lu(k,1330) * lu(k,1751) - lu(k,1754) = lu(k,1754) - lu(k,1331) * lu(k,1751) - lu(k,1755) = lu(k,1755) - lu(k,1332) * lu(k,1751) - lu(k,1756) = lu(k,1756) - lu(k,1333) * lu(k,1751) - lu(k,1757) = lu(k,1757) - lu(k,1334) * lu(k,1751) - lu(k,1758) = lu(k,1758) - lu(k,1335) * lu(k,1751) - lu(k,1759) = lu(k,1759) - lu(k,1336) * lu(k,1751) - lu(k,1760) = lu(k,1760) - lu(k,1337) * lu(k,1751) - lu(k,1761) = lu(k,1761) - lu(k,1338) * lu(k,1751) - lu(k,1762) = lu(k,1762) - lu(k,1339) * lu(k,1751) - lu(k,1763) = lu(k,1763) - lu(k,1340) * lu(k,1751) - lu(k,1787) = lu(k,1787) - lu(k,1329) * lu(k,1786) - lu(k,1788) = lu(k,1788) - lu(k,1330) * lu(k,1786) - lu(k,1789) = lu(k,1789) - lu(k,1331) * lu(k,1786) - lu(k,1790) = lu(k,1790) - lu(k,1332) * lu(k,1786) - lu(k,1791) = lu(k,1791) - lu(k,1333) * lu(k,1786) - lu(k,1792) = lu(k,1792) - lu(k,1334) * lu(k,1786) - lu(k,1793) = lu(k,1793) - lu(k,1335) * lu(k,1786) - lu(k,1794) = lu(k,1794) - lu(k,1336) * lu(k,1786) - lu(k,1795) = lu(k,1795) - lu(k,1337) * lu(k,1786) - lu(k,1796) = lu(k,1796) - lu(k,1338) * lu(k,1786) - lu(k,1797) = lu(k,1797) - lu(k,1339) * lu(k,1786) - lu(k,1798) = lu(k,1798) - lu(k,1340) * lu(k,1786) - lu(k,1845) = lu(k,1845) - lu(k,1329) * lu(k,1844) - lu(k,1846) = lu(k,1846) - lu(k,1330) * lu(k,1844) - lu(k,1847) = lu(k,1847) - lu(k,1331) * lu(k,1844) - lu(k,1848) = lu(k,1848) - lu(k,1332) * lu(k,1844) - lu(k,1849) = lu(k,1849) - lu(k,1333) * lu(k,1844) - lu(k,1850) = lu(k,1850) - lu(k,1334) * lu(k,1844) - lu(k,1851) = lu(k,1851) - lu(k,1335) * lu(k,1844) - lu(k,1852) = lu(k,1852) - lu(k,1336) * lu(k,1844) - lu(k,1853) = lu(k,1853) - lu(k,1337) * lu(k,1844) - lu(k,1854) = lu(k,1854) - lu(k,1338) * lu(k,1844) - lu(k,1855) = lu(k,1855) - lu(k,1339) * lu(k,1844) - lu(k,1856) = lu(k,1856) - lu(k,1340) * lu(k,1844) - lu(k,1373) = 1._r8 / lu(k,1373) - lu(k,1374) = lu(k,1374) * lu(k,1373) - lu(k,1375) = lu(k,1375) * lu(k,1373) - lu(k,1376) = lu(k,1376) * lu(k,1373) - lu(k,1377) = lu(k,1377) * lu(k,1373) - lu(k,1378) = lu(k,1378) * lu(k,1373) - lu(k,1379) = lu(k,1379) * lu(k,1373) - lu(k,1380) = lu(k,1380) * lu(k,1373) - lu(k,1381) = lu(k,1381) * lu(k,1373) - lu(k,1382) = lu(k,1382) * lu(k,1373) - lu(k,1383) = lu(k,1383) * lu(k,1373) - lu(k,1384) = lu(k,1384) * lu(k,1373) - lu(k,1433) = lu(k,1433) - lu(k,1374) * lu(k,1432) - lu(k,1434) = lu(k,1434) - lu(k,1375) * lu(k,1432) - lu(k,1435) = lu(k,1435) - lu(k,1376) * lu(k,1432) - lu(k,1436) = lu(k,1436) - lu(k,1377) * lu(k,1432) - lu(k,1437) = lu(k,1437) - lu(k,1378) * lu(k,1432) - lu(k,1438) = lu(k,1438) - lu(k,1379) * lu(k,1432) - lu(k,1439) = lu(k,1439) - lu(k,1380) * lu(k,1432) - lu(k,1440) = lu(k,1440) - lu(k,1381) * lu(k,1432) - lu(k,1441) = lu(k,1441) - lu(k,1382) * lu(k,1432) - lu(k,1442) = lu(k,1442) - lu(k,1383) * lu(k,1432) - lu(k,1443) = lu(k,1443) - lu(k,1384) * lu(k,1432) - lu(k,1475) = lu(k,1475) - lu(k,1374) * lu(k,1474) - lu(k,1476) = lu(k,1476) - lu(k,1375) * lu(k,1474) - lu(k,1477) = lu(k,1477) - lu(k,1376) * lu(k,1474) - lu(k,1478) = lu(k,1478) - lu(k,1377) * lu(k,1474) - lu(k,1479) = lu(k,1479) - lu(k,1378) * lu(k,1474) - lu(k,1480) = lu(k,1480) - lu(k,1379) * lu(k,1474) - lu(k,1481) = lu(k,1481) - lu(k,1380) * lu(k,1474) - lu(k,1482) = lu(k,1482) - lu(k,1381) * lu(k,1474) - lu(k,1483) = lu(k,1483) - lu(k,1382) * lu(k,1474) - lu(k,1484) = lu(k,1484) - lu(k,1383) * lu(k,1474) - lu(k,1485) = lu(k,1485) - lu(k,1384) * lu(k,1474) - lu(k,1516) = lu(k,1516) - lu(k,1374) * lu(k,1515) - lu(k,1517) = lu(k,1517) - lu(k,1375) * lu(k,1515) - lu(k,1518) = lu(k,1518) - lu(k,1376) * lu(k,1515) - lu(k,1519) = lu(k,1519) - lu(k,1377) * lu(k,1515) - lu(k,1520) = lu(k,1520) - lu(k,1378) * lu(k,1515) - lu(k,1521) = lu(k,1521) - lu(k,1379) * lu(k,1515) - lu(k,1522) = lu(k,1522) - lu(k,1380) * lu(k,1515) - lu(k,1523) = lu(k,1523) - lu(k,1381) * lu(k,1515) - lu(k,1524) = lu(k,1524) - lu(k,1382) * lu(k,1515) - lu(k,1525) = lu(k,1525) - lu(k,1383) * lu(k,1515) - lu(k,1526) = lu(k,1526) - lu(k,1384) * lu(k,1515) - lu(k,1558) = lu(k,1558) - lu(k,1374) * lu(k,1557) - lu(k,1559) = lu(k,1559) - lu(k,1375) * lu(k,1557) - lu(k,1560) = lu(k,1560) - lu(k,1376) * lu(k,1557) - lu(k,1561) = lu(k,1561) - lu(k,1377) * lu(k,1557) - lu(k,1562) = lu(k,1562) - lu(k,1378) * lu(k,1557) - lu(k,1563) = lu(k,1563) - lu(k,1379) * lu(k,1557) - lu(k,1564) = lu(k,1564) - lu(k,1380) * lu(k,1557) - lu(k,1565) = lu(k,1565) - lu(k,1381) * lu(k,1557) - lu(k,1566) = lu(k,1566) - lu(k,1382) * lu(k,1557) - lu(k,1567) = lu(k,1567) - lu(k,1383) * lu(k,1557) - lu(k,1568) = lu(k,1568) - lu(k,1384) * lu(k,1557) - lu(k,1600) = lu(k,1600) - lu(k,1374) * lu(k,1599) - lu(k,1601) = lu(k,1601) - lu(k,1375) * lu(k,1599) - lu(k,1602) = lu(k,1602) - lu(k,1376) * lu(k,1599) - lu(k,1603) = lu(k,1603) - lu(k,1377) * lu(k,1599) - lu(k,1604) = lu(k,1604) - lu(k,1378) * lu(k,1599) - lu(k,1605) = lu(k,1605) - lu(k,1379) * lu(k,1599) - lu(k,1606) = lu(k,1606) - lu(k,1380) * lu(k,1599) - lu(k,1607) = lu(k,1607) - lu(k,1381) * lu(k,1599) - lu(k,1608) = lu(k,1608) - lu(k,1382) * lu(k,1599) - lu(k,1609) = lu(k,1609) - lu(k,1383) * lu(k,1599) - lu(k,1610) = lu(k,1610) - lu(k,1384) * lu(k,1599) - lu(k,1632) = lu(k,1632) - lu(k,1374) * lu(k,1631) - lu(k,1633) = lu(k,1633) - lu(k,1375) * lu(k,1631) - lu(k,1634) = lu(k,1634) - lu(k,1376) * lu(k,1631) - lu(k,1635) = lu(k,1635) - lu(k,1377) * lu(k,1631) - lu(k,1636) = lu(k,1636) - lu(k,1378) * lu(k,1631) - lu(k,1637) = lu(k,1637) - lu(k,1379) * lu(k,1631) - lu(k,1638) = lu(k,1638) - lu(k,1380) * lu(k,1631) - lu(k,1639) = lu(k,1639) - lu(k,1381) * lu(k,1631) - lu(k,1640) = lu(k,1640) - lu(k,1382) * lu(k,1631) - lu(k,1641) = lu(k,1641) - lu(k,1383) * lu(k,1631) - lu(k,1642) = lu(k,1642) - lu(k,1384) * lu(k,1631) - lu(k,1667) = lu(k,1667) - lu(k,1374) * lu(k,1666) - lu(k,1668) = lu(k,1668) - lu(k,1375) * lu(k,1666) - lu(k,1669) = lu(k,1669) - lu(k,1376) * lu(k,1666) - lu(k,1670) = lu(k,1670) - lu(k,1377) * lu(k,1666) - lu(k,1671) = lu(k,1671) - lu(k,1378) * lu(k,1666) - lu(k,1672) = lu(k,1672) - lu(k,1379) * lu(k,1666) - lu(k,1673) = lu(k,1673) - lu(k,1380) * lu(k,1666) - lu(k,1674) = lu(k,1674) - lu(k,1381) * lu(k,1666) - lu(k,1675) = lu(k,1675) - lu(k,1382) * lu(k,1666) - lu(k,1676) = lu(k,1676) - lu(k,1383) * lu(k,1666) - lu(k,1677) = lu(k,1677) - lu(k,1384) * lu(k,1666) - lu(k,1709) = lu(k,1709) - lu(k,1374) * lu(k,1708) - lu(k,1710) = lu(k,1710) - lu(k,1375) * lu(k,1708) - lu(k,1711) = lu(k,1711) - lu(k,1376) * lu(k,1708) - lu(k,1712) = lu(k,1712) - lu(k,1377) * lu(k,1708) - lu(k,1713) = lu(k,1713) - lu(k,1378) * lu(k,1708) - lu(k,1714) = lu(k,1714) - lu(k,1379) * lu(k,1708) - lu(k,1715) = lu(k,1715) - lu(k,1380) * lu(k,1708) - lu(k,1716) = lu(k,1716) - lu(k,1381) * lu(k,1708) - lu(k,1717) = lu(k,1717) - lu(k,1382) * lu(k,1708) - lu(k,1718) = lu(k,1718) - lu(k,1383) * lu(k,1708) - lu(k,1719) = lu(k,1719) - lu(k,1384) * lu(k,1708) - lu(k,1753) = lu(k,1753) - lu(k,1374) * lu(k,1752) - lu(k,1754) = lu(k,1754) - lu(k,1375) * lu(k,1752) - lu(k,1755) = lu(k,1755) - lu(k,1376) * lu(k,1752) - lu(k,1756) = lu(k,1756) - lu(k,1377) * lu(k,1752) - lu(k,1757) = lu(k,1757) - lu(k,1378) * lu(k,1752) - lu(k,1758) = lu(k,1758) - lu(k,1379) * lu(k,1752) - lu(k,1759) = lu(k,1759) - lu(k,1380) * lu(k,1752) - lu(k,1760) = lu(k,1760) - lu(k,1381) * lu(k,1752) - lu(k,1761) = lu(k,1761) - lu(k,1382) * lu(k,1752) - lu(k,1762) = lu(k,1762) - lu(k,1383) * lu(k,1752) - lu(k,1763) = lu(k,1763) - lu(k,1384) * lu(k,1752) - lu(k,1788) = lu(k,1788) - lu(k,1374) * lu(k,1787) - lu(k,1789) = lu(k,1789) - lu(k,1375) * lu(k,1787) - lu(k,1790) = lu(k,1790) - lu(k,1376) * lu(k,1787) - lu(k,1791) = lu(k,1791) - lu(k,1377) * lu(k,1787) - lu(k,1792) = lu(k,1792) - lu(k,1378) * lu(k,1787) - lu(k,1793) = lu(k,1793) - lu(k,1379) * lu(k,1787) - lu(k,1794) = lu(k,1794) - lu(k,1380) * lu(k,1787) - lu(k,1795) = lu(k,1795) - lu(k,1381) * lu(k,1787) - lu(k,1796) = lu(k,1796) - lu(k,1382) * lu(k,1787) - lu(k,1797) = lu(k,1797) - lu(k,1383) * lu(k,1787) - lu(k,1798) = lu(k,1798) - lu(k,1384) * lu(k,1787) - lu(k,1846) = lu(k,1846) - lu(k,1374) * lu(k,1845) - lu(k,1847) = lu(k,1847) - lu(k,1375) * lu(k,1845) - lu(k,1848) = lu(k,1848) - lu(k,1376) * lu(k,1845) - lu(k,1849) = lu(k,1849) - lu(k,1377) * lu(k,1845) - lu(k,1850) = lu(k,1850) - lu(k,1378) * lu(k,1845) - lu(k,1851) = lu(k,1851) - lu(k,1379) * lu(k,1845) - lu(k,1852) = lu(k,1852) - lu(k,1380) * lu(k,1845) - lu(k,1853) = lu(k,1853) - lu(k,1381) * lu(k,1845) - lu(k,1854) = lu(k,1854) - lu(k,1382) * lu(k,1845) - lu(k,1855) = lu(k,1855) - lu(k,1383) * lu(k,1845) - lu(k,1856) = lu(k,1856) - lu(k,1384) * lu(k,1845) + lu(k,1306) = lu(k,1306) * lu(k,1292) + lu(k,1307) = lu(k,1307) * lu(k,1292) + lu(k,1308) = lu(k,1308) * lu(k,1292) + lu(k,1309) = lu(k,1309) * lu(k,1292) + lu(k,1310) = lu(k,1310) * lu(k,1292) + lu(k,1335) = lu(k,1335) - lu(k,1293) * lu(k,1334) + lu(k,1336) = lu(k,1336) - lu(k,1294) * lu(k,1334) + lu(k,1337) = lu(k,1337) - lu(k,1295) * lu(k,1334) + lu(k,1338) = lu(k,1338) - lu(k,1296) * lu(k,1334) + lu(k,1339) = lu(k,1339) - lu(k,1297) * lu(k,1334) + lu(k,1340) = lu(k,1340) - lu(k,1298) * lu(k,1334) + lu(k,1341) = lu(k,1341) - lu(k,1299) * lu(k,1334) + lu(k,1342) = lu(k,1342) - lu(k,1300) * lu(k,1334) + lu(k,1343) = lu(k,1343) - lu(k,1301) * lu(k,1334) + lu(k,1344) = lu(k,1344) - lu(k,1302) * lu(k,1334) + lu(k,1345) = lu(k,1345) - lu(k,1303) * lu(k,1334) + lu(k,1346) = lu(k,1346) - lu(k,1304) * lu(k,1334) + lu(k,1347) = lu(k,1347) - lu(k,1305) * lu(k,1334) + lu(k,1348) = lu(k,1348) - lu(k,1306) * lu(k,1334) + lu(k,1349) = lu(k,1349) - lu(k,1307) * lu(k,1334) + lu(k,1350) = lu(k,1350) - lu(k,1308) * lu(k,1334) + lu(k,1351) = lu(k,1351) - lu(k,1309) * lu(k,1334) + lu(k,1352) = lu(k,1352) - lu(k,1310) * lu(k,1334) + lu(k,1371) = lu(k,1371) - lu(k,1293) * lu(k,1370) + lu(k,1372) = lu(k,1372) - lu(k,1294) * lu(k,1370) + lu(k,1373) = lu(k,1373) - lu(k,1295) * lu(k,1370) + lu(k,1374) = lu(k,1374) - lu(k,1296) * lu(k,1370) + lu(k,1375) = lu(k,1375) - lu(k,1297) * lu(k,1370) + lu(k,1376) = lu(k,1376) - lu(k,1298) * lu(k,1370) + lu(k,1377) = lu(k,1377) - lu(k,1299) * lu(k,1370) + lu(k,1378) = lu(k,1378) - lu(k,1300) * lu(k,1370) + lu(k,1379) = lu(k,1379) - lu(k,1301) * lu(k,1370) + lu(k,1380) = lu(k,1380) - lu(k,1302) * lu(k,1370) + lu(k,1381) = lu(k,1381) - lu(k,1303) * lu(k,1370) + lu(k,1382) = lu(k,1382) - lu(k,1304) * lu(k,1370) + lu(k,1383) = lu(k,1383) - lu(k,1305) * lu(k,1370) + lu(k,1384) = lu(k,1384) - lu(k,1306) * lu(k,1370) + lu(k,1385) = lu(k,1385) - lu(k,1307) * lu(k,1370) + lu(k,1386) = lu(k,1386) - lu(k,1308) * lu(k,1370) + lu(k,1387) = lu(k,1387) - lu(k,1309) * lu(k,1370) + lu(k,1388) = lu(k,1388) - lu(k,1310) * lu(k,1370) + lu(k,1414) = lu(k,1414) - lu(k,1293) * lu(k,1413) + lu(k,1415) = lu(k,1415) - lu(k,1294) * lu(k,1413) + lu(k,1416) = lu(k,1416) - lu(k,1295) * lu(k,1413) + lu(k,1417) = lu(k,1417) - lu(k,1296) * lu(k,1413) + lu(k,1418) = lu(k,1418) - lu(k,1297) * lu(k,1413) + lu(k,1419) = lu(k,1419) - lu(k,1298) * lu(k,1413) + lu(k,1420) = lu(k,1420) - lu(k,1299) * lu(k,1413) + lu(k,1421) = lu(k,1421) - lu(k,1300) * lu(k,1413) + lu(k,1422) = lu(k,1422) - lu(k,1301) * lu(k,1413) + lu(k,1423) = lu(k,1423) - lu(k,1302) * lu(k,1413) + lu(k,1424) = lu(k,1424) - lu(k,1303) * lu(k,1413) + lu(k,1425) = lu(k,1425) - lu(k,1304) * lu(k,1413) + lu(k,1426) = lu(k,1426) - lu(k,1305) * lu(k,1413) + lu(k,1427) = lu(k,1427) - lu(k,1306) * lu(k,1413) + lu(k,1428) = lu(k,1428) - lu(k,1307) * lu(k,1413) + lu(k,1429) = lu(k,1429) - lu(k,1308) * lu(k,1413) + lu(k,1430) = lu(k,1430) - lu(k,1309) * lu(k,1413) + lu(k,1431) = lu(k,1431) - lu(k,1310) * lu(k,1413) + lu(k,1457) = lu(k,1457) - lu(k,1293) * lu(k,1456) + lu(k,1458) = lu(k,1458) - lu(k,1294) * lu(k,1456) + lu(k,1459) = lu(k,1459) - lu(k,1295) * lu(k,1456) + lu(k,1460) = lu(k,1460) - lu(k,1296) * lu(k,1456) + lu(k,1461) = lu(k,1461) - lu(k,1297) * lu(k,1456) + lu(k,1462) = lu(k,1462) - lu(k,1298) * lu(k,1456) + lu(k,1463) = lu(k,1463) - lu(k,1299) * lu(k,1456) + lu(k,1464) = lu(k,1464) - lu(k,1300) * lu(k,1456) + lu(k,1465) = lu(k,1465) - lu(k,1301) * lu(k,1456) + lu(k,1466) = lu(k,1466) - lu(k,1302) * lu(k,1456) + lu(k,1467) = lu(k,1467) - lu(k,1303) * lu(k,1456) + lu(k,1468) = lu(k,1468) - lu(k,1304) * lu(k,1456) + lu(k,1469) = lu(k,1469) - lu(k,1305) * lu(k,1456) + lu(k,1470) = lu(k,1470) - lu(k,1306) * lu(k,1456) + lu(k,1471) = lu(k,1471) - lu(k,1307) * lu(k,1456) + lu(k,1472) = lu(k,1472) - lu(k,1308) * lu(k,1456) + lu(k,1473) = lu(k,1473) - lu(k,1309) * lu(k,1456) + lu(k,1474) = lu(k,1474) - lu(k,1310) * lu(k,1456) + lu(k,1502) = lu(k,1502) - lu(k,1293) * lu(k,1501) + lu(k,1503) = lu(k,1503) - lu(k,1294) * lu(k,1501) + lu(k,1504) = lu(k,1504) - lu(k,1295) * lu(k,1501) + lu(k,1505) = lu(k,1505) - lu(k,1296) * lu(k,1501) + lu(k,1506) = lu(k,1506) - lu(k,1297) * lu(k,1501) + lu(k,1507) = lu(k,1507) - lu(k,1298) * lu(k,1501) + lu(k,1508) = lu(k,1508) - lu(k,1299) * lu(k,1501) + lu(k,1509) = lu(k,1509) - lu(k,1300) * lu(k,1501) + lu(k,1510) = lu(k,1510) - lu(k,1301) * lu(k,1501) + lu(k,1511) = lu(k,1511) - lu(k,1302) * lu(k,1501) + lu(k,1512) = lu(k,1512) - lu(k,1303) * lu(k,1501) + lu(k,1513) = lu(k,1513) - lu(k,1304) * lu(k,1501) + lu(k,1514) = lu(k,1514) - lu(k,1305) * lu(k,1501) + lu(k,1515) = lu(k,1515) - lu(k,1306) * lu(k,1501) + lu(k,1516) = lu(k,1516) - lu(k,1307) * lu(k,1501) + lu(k,1517) = lu(k,1517) - lu(k,1308) * lu(k,1501) + lu(k,1518) = lu(k,1518) - lu(k,1309) * lu(k,1501) + lu(k,1519) = lu(k,1519) - lu(k,1310) * lu(k,1501) + lu(k,1538) = lu(k,1538) - lu(k,1293) * lu(k,1537) + lu(k,1539) = lu(k,1539) - lu(k,1294) * lu(k,1537) + lu(k,1540) = lu(k,1540) - lu(k,1295) * lu(k,1537) + lu(k,1541) = lu(k,1541) - lu(k,1296) * lu(k,1537) + lu(k,1542) = lu(k,1542) - lu(k,1297) * lu(k,1537) + lu(k,1543) = lu(k,1543) - lu(k,1298) * lu(k,1537) + lu(k,1544) = lu(k,1544) - lu(k,1299) * lu(k,1537) + lu(k,1545) = lu(k,1545) - lu(k,1300) * lu(k,1537) + lu(k,1546) = lu(k,1546) - lu(k,1301) * lu(k,1537) + lu(k,1547) = lu(k,1547) - lu(k,1302) * lu(k,1537) + lu(k,1548) = lu(k,1548) - lu(k,1303) * lu(k,1537) + lu(k,1549) = lu(k,1549) - lu(k,1304) * lu(k,1537) + lu(k,1550) = lu(k,1550) - lu(k,1305) * lu(k,1537) + lu(k,1551) = lu(k,1551) - lu(k,1306) * lu(k,1537) + lu(k,1552) = lu(k,1552) - lu(k,1307) * lu(k,1537) + lu(k,1553) = lu(k,1553) - lu(k,1308) * lu(k,1537) + lu(k,1554) = lu(k,1554) - lu(k,1309) * lu(k,1537) + lu(k,1555) = lu(k,1555) - lu(k,1310) * lu(k,1537) + lu(k,1583) = lu(k,1583) - lu(k,1293) * lu(k,1582) + lu(k,1584) = lu(k,1584) - lu(k,1294) * lu(k,1582) + lu(k,1585) = lu(k,1585) - lu(k,1295) * lu(k,1582) + lu(k,1586) = lu(k,1586) - lu(k,1296) * lu(k,1582) + lu(k,1587) = lu(k,1587) - lu(k,1297) * lu(k,1582) + lu(k,1588) = lu(k,1588) - lu(k,1298) * lu(k,1582) + lu(k,1589) = lu(k,1589) - lu(k,1299) * lu(k,1582) + lu(k,1590) = lu(k,1590) - lu(k,1300) * lu(k,1582) + lu(k,1591) = lu(k,1591) - lu(k,1301) * lu(k,1582) + lu(k,1592) = lu(k,1592) - lu(k,1302) * lu(k,1582) + lu(k,1593) = lu(k,1593) - lu(k,1303) * lu(k,1582) + lu(k,1594) = lu(k,1594) - lu(k,1304) * lu(k,1582) + lu(k,1595) = lu(k,1595) - lu(k,1305) * lu(k,1582) + lu(k,1596) = lu(k,1596) - lu(k,1306) * lu(k,1582) + lu(k,1597) = lu(k,1597) - lu(k,1307) * lu(k,1582) + lu(k,1598) = lu(k,1598) - lu(k,1308) * lu(k,1582) + lu(k,1599) = lu(k,1599) - lu(k,1309) * lu(k,1582) + lu(k,1600) = lu(k,1600) - lu(k,1310) * lu(k,1582) + lu(k,1631) = lu(k,1631) - lu(k,1293) * lu(k,1630) + lu(k,1632) = lu(k,1632) - lu(k,1294) * lu(k,1630) + lu(k,1633) = lu(k,1633) - lu(k,1295) * lu(k,1630) + lu(k,1634) = lu(k,1634) - lu(k,1296) * lu(k,1630) + lu(k,1635) = lu(k,1635) - lu(k,1297) * lu(k,1630) + lu(k,1636) = lu(k,1636) - lu(k,1298) * lu(k,1630) + lu(k,1637) = lu(k,1637) - lu(k,1299) * lu(k,1630) + lu(k,1638) = lu(k,1638) - lu(k,1300) * lu(k,1630) + lu(k,1639) = lu(k,1639) - lu(k,1301) * lu(k,1630) + lu(k,1640) = lu(k,1640) - lu(k,1302) * lu(k,1630) + lu(k,1641) = lu(k,1641) - lu(k,1303) * lu(k,1630) + lu(k,1642) = lu(k,1642) - lu(k,1304) * lu(k,1630) + lu(k,1643) = lu(k,1643) - lu(k,1305) * lu(k,1630) + lu(k,1644) = lu(k,1644) - lu(k,1306) * lu(k,1630) + lu(k,1645) = lu(k,1645) - lu(k,1307) * lu(k,1630) + lu(k,1646) = lu(k,1646) - lu(k,1308) * lu(k,1630) + lu(k,1647) = lu(k,1647) - lu(k,1309) * lu(k,1630) + lu(k,1648) = lu(k,1648) - lu(k,1310) * lu(k,1630) + lu(k,1674) = lu(k,1674) - lu(k,1293) * lu(k,1673) + lu(k,1675) = lu(k,1675) - lu(k,1294) * lu(k,1673) + lu(k,1676) = lu(k,1676) - lu(k,1295) * lu(k,1673) + lu(k,1677) = lu(k,1677) - lu(k,1296) * lu(k,1673) + lu(k,1678) = lu(k,1678) - lu(k,1297) * lu(k,1673) + lu(k,1679) = lu(k,1679) - lu(k,1298) * lu(k,1673) + lu(k,1680) = lu(k,1680) - lu(k,1299) * lu(k,1673) + lu(k,1681) = lu(k,1681) - lu(k,1300) * lu(k,1673) + lu(k,1682) = lu(k,1682) - lu(k,1301) * lu(k,1673) + lu(k,1683) = lu(k,1683) - lu(k,1302) * lu(k,1673) + lu(k,1684) = lu(k,1684) - lu(k,1303) * lu(k,1673) + lu(k,1685) = lu(k,1685) - lu(k,1304) * lu(k,1673) + lu(k,1686) = lu(k,1686) - lu(k,1305) * lu(k,1673) + lu(k,1687) = lu(k,1687) - lu(k,1306) * lu(k,1673) + lu(k,1688) = lu(k,1688) - lu(k,1307) * lu(k,1673) + lu(k,1689) = lu(k,1689) - lu(k,1308) * lu(k,1673) + lu(k,1690) = lu(k,1690) - lu(k,1309) * lu(k,1673) + lu(k,1691) = lu(k,1691) - lu(k,1310) * lu(k,1673) + lu(k,1716) = lu(k,1716) - lu(k,1293) * lu(k,1715) + lu(k,1717) = lu(k,1717) - lu(k,1294) * lu(k,1715) + lu(k,1718) = lu(k,1718) - lu(k,1295) * lu(k,1715) + lu(k,1719) = lu(k,1719) - lu(k,1296) * lu(k,1715) + lu(k,1720) = lu(k,1720) - lu(k,1297) * lu(k,1715) + lu(k,1721) = lu(k,1721) - lu(k,1298) * lu(k,1715) + lu(k,1722) = lu(k,1722) - lu(k,1299) * lu(k,1715) + lu(k,1723) = lu(k,1723) - lu(k,1300) * lu(k,1715) + lu(k,1724) = lu(k,1724) - lu(k,1301) * lu(k,1715) + lu(k,1725) = lu(k,1725) - lu(k,1302) * lu(k,1715) + lu(k,1726) = lu(k,1726) - lu(k,1303) * lu(k,1715) + lu(k,1727) = lu(k,1727) - lu(k,1304) * lu(k,1715) + lu(k,1728) = lu(k,1728) - lu(k,1305) * lu(k,1715) + lu(k,1729) = lu(k,1729) - lu(k,1306) * lu(k,1715) + lu(k,1730) = lu(k,1730) - lu(k,1307) * lu(k,1715) + lu(k,1731) = lu(k,1731) - lu(k,1308) * lu(k,1715) + lu(k,1732) = lu(k,1732) - lu(k,1309) * lu(k,1715) + lu(k,1733) = lu(k,1733) - lu(k,1310) * lu(k,1715) + lu(k,1761) = lu(k,1761) - lu(k,1293) * lu(k,1760) + lu(k,1762) = lu(k,1762) - lu(k,1294) * lu(k,1760) + lu(k,1763) = lu(k,1763) - lu(k,1295) * lu(k,1760) + lu(k,1764) = lu(k,1764) - lu(k,1296) * lu(k,1760) + lu(k,1765) = lu(k,1765) - lu(k,1297) * lu(k,1760) + lu(k,1766) = lu(k,1766) - lu(k,1298) * lu(k,1760) + lu(k,1767) = lu(k,1767) - lu(k,1299) * lu(k,1760) + lu(k,1768) = lu(k,1768) - lu(k,1300) * lu(k,1760) + lu(k,1769) = lu(k,1769) - lu(k,1301) * lu(k,1760) + lu(k,1770) = lu(k,1770) - lu(k,1302) * lu(k,1760) + lu(k,1771) = lu(k,1771) - lu(k,1303) * lu(k,1760) + lu(k,1772) = lu(k,1772) - lu(k,1304) * lu(k,1760) + lu(k,1773) = lu(k,1773) - lu(k,1305) * lu(k,1760) + lu(k,1774) = lu(k,1774) - lu(k,1306) * lu(k,1760) + lu(k,1775) = lu(k,1775) - lu(k,1307) * lu(k,1760) + lu(k,1776) = lu(k,1776) - lu(k,1308) * lu(k,1760) + lu(k,1777) = lu(k,1777) - lu(k,1309) * lu(k,1760) + lu(k,1778) = lu(k,1778) - lu(k,1310) * lu(k,1760) + lu(k,1810) = lu(k,1810) - lu(k,1293) * lu(k,1809) + lu(k,1811) = lu(k,1811) - lu(k,1294) * lu(k,1809) + lu(k,1812) = lu(k,1812) - lu(k,1295) * lu(k,1809) + lu(k,1813) = lu(k,1813) - lu(k,1296) * lu(k,1809) + lu(k,1814) = lu(k,1814) - lu(k,1297) * lu(k,1809) + lu(k,1815) = lu(k,1815) - lu(k,1298) * lu(k,1809) + lu(k,1816) = lu(k,1816) - lu(k,1299) * lu(k,1809) + lu(k,1817) = lu(k,1817) - lu(k,1300) * lu(k,1809) + lu(k,1818) = lu(k,1818) - lu(k,1301) * lu(k,1809) + lu(k,1819) = lu(k,1819) - lu(k,1302) * lu(k,1809) + lu(k,1820) = lu(k,1820) - lu(k,1303) * lu(k,1809) + lu(k,1821) = lu(k,1821) - lu(k,1304) * lu(k,1809) + lu(k,1822) = lu(k,1822) - lu(k,1305) * lu(k,1809) + lu(k,1823) = lu(k,1823) - lu(k,1306) * lu(k,1809) + lu(k,1824) = lu(k,1824) - lu(k,1307) * lu(k,1809) + lu(k,1825) = lu(k,1825) - lu(k,1308) * lu(k,1809) + lu(k,1826) = lu(k,1826) - lu(k,1309) * lu(k,1809) + lu(k,1827) = lu(k,1827) - lu(k,1310) * lu(k,1809) + lu(k,1843) = lu(k,1843) - lu(k,1293) * lu(k,1842) + lu(k,1844) = lu(k,1844) - lu(k,1294) * lu(k,1842) + lu(k,1845) = lu(k,1845) - lu(k,1295) * lu(k,1842) + lu(k,1846) = lu(k,1846) - lu(k,1296) * lu(k,1842) + lu(k,1847) = lu(k,1847) - lu(k,1297) * lu(k,1842) + lu(k,1848) = lu(k,1848) - lu(k,1298) * lu(k,1842) + lu(k,1849) = lu(k,1849) - lu(k,1299) * lu(k,1842) + lu(k,1850) = lu(k,1850) - lu(k,1300) * lu(k,1842) + lu(k,1851) = lu(k,1851) - lu(k,1301) * lu(k,1842) + lu(k,1852) = lu(k,1852) - lu(k,1302) * lu(k,1842) + lu(k,1853) = lu(k,1853) - lu(k,1303) * lu(k,1842) + lu(k,1854) = lu(k,1854) - lu(k,1304) * lu(k,1842) + lu(k,1855) = lu(k,1855) - lu(k,1305) * lu(k,1842) + lu(k,1856) = lu(k,1856) - lu(k,1306) * lu(k,1842) + lu(k,1857) = lu(k,1857) - lu(k,1307) * lu(k,1842) + lu(k,1858) = lu(k,1858) - lu(k,1308) * lu(k,1842) + lu(k,1859) = lu(k,1859) - lu(k,1309) * lu(k,1842) + lu(k,1860) = lu(k,1860) - lu(k,1310) * lu(k,1842) + lu(k,1879) = lu(k,1879) - lu(k,1293) * lu(k,1878) + lu(k,1880) = lu(k,1880) - lu(k,1294) * lu(k,1878) + lu(k,1881) = lu(k,1881) - lu(k,1295) * lu(k,1878) + lu(k,1882) = lu(k,1882) - lu(k,1296) * lu(k,1878) + lu(k,1883) = lu(k,1883) - lu(k,1297) * lu(k,1878) + lu(k,1884) = lu(k,1884) - lu(k,1298) * lu(k,1878) + lu(k,1885) = lu(k,1885) - lu(k,1299) * lu(k,1878) + lu(k,1886) = lu(k,1886) - lu(k,1300) * lu(k,1878) + lu(k,1887) = lu(k,1887) - lu(k,1301) * lu(k,1878) + lu(k,1888) = lu(k,1888) - lu(k,1302) * lu(k,1878) + lu(k,1889) = lu(k,1889) - lu(k,1303) * lu(k,1878) + lu(k,1890) = lu(k,1890) - lu(k,1304) * lu(k,1878) + lu(k,1891) = lu(k,1891) - lu(k,1305) * lu(k,1878) + lu(k,1892) = lu(k,1892) - lu(k,1306) * lu(k,1878) + lu(k,1893) = lu(k,1893) - lu(k,1307) * lu(k,1878) + lu(k,1894) = lu(k,1894) - lu(k,1308) * lu(k,1878) + lu(k,1895) = lu(k,1895) - lu(k,1309) * lu(k,1878) + lu(k,1896) = lu(k,1896) - lu(k,1310) * lu(k,1878) + lu(k,1920) = lu(k,1920) - lu(k,1293) * lu(k,1919) + lu(k,1921) = lu(k,1921) - lu(k,1294) * lu(k,1919) + lu(k,1922) = lu(k,1922) - lu(k,1295) * lu(k,1919) + lu(k,1923) = lu(k,1923) - lu(k,1296) * lu(k,1919) + lu(k,1924) = lu(k,1924) - lu(k,1297) * lu(k,1919) + lu(k,1925) = lu(k,1925) - lu(k,1298) * lu(k,1919) + lu(k,1926) = lu(k,1926) - lu(k,1299) * lu(k,1919) + lu(k,1927) = lu(k,1927) - lu(k,1300) * lu(k,1919) + lu(k,1928) = lu(k,1928) - lu(k,1301) * lu(k,1919) + lu(k,1929) = lu(k,1929) - lu(k,1302) * lu(k,1919) + lu(k,1930) = lu(k,1930) - lu(k,1303) * lu(k,1919) + lu(k,1931) = lu(k,1931) - lu(k,1304) * lu(k,1919) + lu(k,1932) = lu(k,1932) - lu(k,1305) * lu(k,1919) + lu(k,1933) = lu(k,1933) - lu(k,1306) * lu(k,1919) + lu(k,1934) = lu(k,1934) - lu(k,1307) * lu(k,1919) + lu(k,1935) = lu(k,1935) - lu(k,1308) * lu(k,1919) + lu(k,1936) = lu(k,1936) - lu(k,1309) * lu(k,1919) + lu(k,1937) = lu(k,1937) - lu(k,1310) * lu(k,1919) + lu(k,1962) = lu(k,1962) - lu(k,1293) * lu(k,1961) + lu(k,1963) = lu(k,1963) - lu(k,1294) * lu(k,1961) + lu(k,1964) = lu(k,1964) - lu(k,1295) * lu(k,1961) + lu(k,1965) = lu(k,1965) - lu(k,1296) * lu(k,1961) + lu(k,1966) = lu(k,1966) - lu(k,1297) * lu(k,1961) + lu(k,1967) = lu(k,1967) - lu(k,1298) * lu(k,1961) + lu(k,1968) = lu(k,1968) - lu(k,1299) * lu(k,1961) + lu(k,1969) = lu(k,1969) - lu(k,1300) * lu(k,1961) + lu(k,1970) = lu(k,1970) - lu(k,1301) * lu(k,1961) + lu(k,1971) = lu(k,1971) - lu(k,1302) * lu(k,1961) + lu(k,1972) = lu(k,1972) - lu(k,1303) * lu(k,1961) + lu(k,1973) = lu(k,1973) - lu(k,1304) * lu(k,1961) + lu(k,1974) = lu(k,1974) - lu(k,1305) * lu(k,1961) + lu(k,1975) = lu(k,1975) - lu(k,1306) * lu(k,1961) + lu(k,1976) = lu(k,1976) - lu(k,1307) * lu(k,1961) + lu(k,1977) = lu(k,1977) - lu(k,1308) * lu(k,1961) + lu(k,1978) = lu(k,1978) - lu(k,1309) * lu(k,1961) + lu(k,1979) = lu(k,1979) - lu(k,1310) * lu(k,1961) + lu(k,2010) = lu(k,2010) - lu(k,1293) * lu(k,2009) + lu(k,2011) = lu(k,2011) - lu(k,1294) * lu(k,2009) + lu(k,2012) = lu(k,2012) - lu(k,1295) * lu(k,2009) + lu(k,2013) = lu(k,2013) - lu(k,1296) * lu(k,2009) + lu(k,2014) = lu(k,2014) - lu(k,1297) * lu(k,2009) + lu(k,2015) = lu(k,2015) - lu(k,1298) * lu(k,2009) + lu(k,2016) = lu(k,2016) - lu(k,1299) * lu(k,2009) + lu(k,2017) = lu(k,2017) - lu(k,1300) * lu(k,2009) + lu(k,2018) = lu(k,2018) - lu(k,1301) * lu(k,2009) + lu(k,2019) = lu(k,2019) - lu(k,1302) * lu(k,2009) + lu(k,2020) = lu(k,2020) - lu(k,1303) * lu(k,2009) + lu(k,2021) = lu(k,2021) - lu(k,1304) * lu(k,2009) + lu(k,2022) = lu(k,2022) - lu(k,1305) * lu(k,2009) + lu(k,2023) = lu(k,2023) - lu(k,1306) * lu(k,2009) + lu(k,2024) = lu(k,2024) - lu(k,1307) * lu(k,2009) + lu(k,2025) = lu(k,2025) - lu(k,1308) * lu(k,2009) + lu(k,2026) = lu(k,2026) - lu(k,1309) * lu(k,2009) + lu(k,2027) = lu(k,2027) - lu(k,1310) * lu(k,2009) + lu(k,2070) = lu(k,2070) - lu(k,1293) * lu(k,2069) + lu(k,2071) = lu(k,2071) - lu(k,1294) * lu(k,2069) + lu(k,2072) = lu(k,2072) - lu(k,1295) * lu(k,2069) + lu(k,2073) = lu(k,2073) - lu(k,1296) * lu(k,2069) + lu(k,2074) = lu(k,2074) - lu(k,1297) * lu(k,2069) + lu(k,2075) = lu(k,2075) - lu(k,1298) * lu(k,2069) + lu(k,2076) = lu(k,2076) - lu(k,1299) * lu(k,2069) + lu(k,2077) = lu(k,2077) - lu(k,1300) * lu(k,2069) + lu(k,2078) = lu(k,2078) - lu(k,1301) * lu(k,2069) + lu(k,2079) = lu(k,2079) - lu(k,1302) * lu(k,2069) + lu(k,2080) = lu(k,2080) - lu(k,1303) * lu(k,2069) + lu(k,2081) = lu(k,2081) - lu(k,1304) * lu(k,2069) + lu(k,2082) = lu(k,2082) - lu(k,1305) * lu(k,2069) + lu(k,2083) = lu(k,2083) - lu(k,1306) * lu(k,2069) + lu(k,2084) = lu(k,2084) - lu(k,1307) * lu(k,2069) + lu(k,2085) = lu(k,2085) - lu(k,1308) * lu(k,2069) + lu(k,2086) = lu(k,2086) - lu(k,1309) * lu(k,2069) + lu(k,2087) = lu(k,2087) - lu(k,1310) * lu(k,2069) + lu(k,1335) = 1._r8 / lu(k,1335) + lu(k,1336) = lu(k,1336) * lu(k,1335) + lu(k,1337) = lu(k,1337) * lu(k,1335) + lu(k,1338) = lu(k,1338) * lu(k,1335) + lu(k,1339) = lu(k,1339) * lu(k,1335) + lu(k,1340) = lu(k,1340) * lu(k,1335) + lu(k,1341) = lu(k,1341) * lu(k,1335) + lu(k,1342) = lu(k,1342) * lu(k,1335) + lu(k,1343) = lu(k,1343) * lu(k,1335) + lu(k,1344) = lu(k,1344) * lu(k,1335) + lu(k,1345) = lu(k,1345) * lu(k,1335) + lu(k,1346) = lu(k,1346) * lu(k,1335) + lu(k,1347) = lu(k,1347) * lu(k,1335) + lu(k,1348) = lu(k,1348) * lu(k,1335) + lu(k,1349) = lu(k,1349) * lu(k,1335) + lu(k,1350) = lu(k,1350) * lu(k,1335) + lu(k,1351) = lu(k,1351) * lu(k,1335) + lu(k,1352) = lu(k,1352) * lu(k,1335) + lu(k,1372) = lu(k,1372) - lu(k,1336) * lu(k,1371) + lu(k,1373) = lu(k,1373) - lu(k,1337) * lu(k,1371) + lu(k,1374) = lu(k,1374) - lu(k,1338) * lu(k,1371) + lu(k,1375) = lu(k,1375) - lu(k,1339) * lu(k,1371) + lu(k,1376) = lu(k,1376) - lu(k,1340) * lu(k,1371) + lu(k,1377) = lu(k,1377) - lu(k,1341) * lu(k,1371) + lu(k,1378) = lu(k,1378) - lu(k,1342) * lu(k,1371) + lu(k,1379) = lu(k,1379) - lu(k,1343) * lu(k,1371) + lu(k,1380) = lu(k,1380) - lu(k,1344) * lu(k,1371) + lu(k,1381) = lu(k,1381) - lu(k,1345) * lu(k,1371) + lu(k,1382) = lu(k,1382) - lu(k,1346) * lu(k,1371) + lu(k,1383) = lu(k,1383) - lu(k,1347) * lu(k,1371) + lu(k,1384) = lu(k,1384) - lu(k,1348) * lu(k,1371) + lu(k,1385) = lu(k,1385) - lu(k,1349) * lu(k,1371) + lu(k,1386) = lu(k,1386) - lu(k,1350) * lu(k,1371) + lu(k,1387) = lu(k,1387) - lu(k,1351) * lu(k,1371) + lu(k,1388) = lu(k,1388) - lu(k,1352) * lu(k,1371) + lu(k,1415) = lu(k,1415) - lu(k,1336) * lu(k,1414) + lu(k,1416) = lu(k,1416) - lu(k,1337) * lu(k,1414) + lu(k,1417) = lu(k,1417) - lu(k,1338) * lu(k,1414) + lu(k,1418) = lu(k,1418) - lu(k,1339) * lu(k,1414) + lu(k,1419) = lu(k,1419) - lu(k,1340) * lu(k,1414) + lu(k,1420) = lu(k,1420) - lu(k,1341) * lu(k,1414) + lu(k,1421) = lu(k,1421) - lu(k,1342) * lu(k,1414) + lu(k,1422) = lu(k,1422) - lu(k,1343) * lu(k,1414) + lu(k,1423) = lu(k,1423) - lu(k,1344) * lu(k,1414) + lu(k,1424) = lu(k,1424) - lu(k,1345) * lu(k,1414) + lu(k,1425) = lu(k,1425) - lu(k,1346) * lu(k,1414) + lu(k,1426) = lu(k,1426) - lu(k,1347) * lu(k,1414) + lu(k,1427) = lu(k,1427) - lu(k,1348) * lu(k,1414) + lu(k,1428) = lu(k,1428) - lu(k,1349) * lu(k,1414) + lu(k,1429) = lu(k,1429) - lu(k,1350) * lu(k,1414) + lu(k,1430) = lu(k,1430) - lu(k,1351) * lu(k,1414) + lu(k,1431) = lu(k,1431) - lu(k,1352) * lu(k,1414) + lu(k,1458) = lu(k,1458) - lu(k,1336) * lu(k,1457) + lu(k,1459) = lu(k,1459) - lu(k,1337) * lu(k,1457) + lu(k,1460) = lu(k,1460) - lu(k,1338) * lu(k,1457) + lu(k,1461) = lu(k,1461) - lu(k,1339) * lu(k,1457) + lu(k,1462) = lu(k,1462) - lu(k,1340) * lu(k,1457) + lu(k,1463) = lu(k,1463) - lu(k,1341) * lu(k,1457) + lu(k,1464) = lu(k,1464) - lu(k,1342) * lu(k,1457) + lu(k,1465) = lu(k,1465) - lu(k,1343) * lu(k,1457) + lu(k,1466) = lu(k,1466) - lu(k,1344) * lu(k,1457) + lu(k,1467) = lu(k,1467) - lu(k,1345) * lu(k,1457) + lu(k,1468) = lu(k,1468) - lu(k,1346) * lu(k,1457) + lu(k,1469) = lu(k,1469) - lu(k,1347) * lu(k,1457) + lu(k,1470) = lu(k,1470) - lu(k,1348) * lu(k,1457) + lu(k,1471) = lu(k,1471) - lu(k,1349) * lu(k,1457) + lu(k,1472) = lu(k,1472) - lu(k,1350) * lu(k,1457) + lu(k,1473) = lu(k,1473) - lu(k,1351) * lu(k,1457) + lu(k,1474) = lu(k,1474) - lu(k,1352) * lu(k,1457) + lu(k,1503) = lu(k,1503) - lu(k,1336) * lu(k,1502) + lu(k,1504) = lu(k,1504) - lu(k,1337) * lu(k,1502) + lu(k,1505) = lu(k,1505) - lu(k,1338) * lu(k,1502) + lu(k,1506) = lu(k,1506) - lu(k,1339) * lu(k,1502) + lu(k,1507) = lu(k,1507) - lu(k,1340) * lu(k,1502) + lu(k,1508) = lu(k,1508) - lu(k,1341) * lu(k,1502) + lu(k,1509) = lu(k,1509) - lu(k,1342) * lu(k,1502) + lu(k,1510) = lu(k,1510) - lu(k,1343) * lu(k,1502) + lu(k,1511) = lu(k,1511) - lu(k,1344) * lu(k,1502) + lu(k,1512) = lu(k,1512) - lu(k,1345) * lu(k,1502) + lu(k,1513) = lu(k,1513) - lu(k,1346) * lu(k,1502) + lu(k,1514) = lu(k,1514) - lu(k,1347) * lu(k,1502) + lu(k,1515) = lu(k,1515) - lu(k,1348) * lu(k,1502) + lu(k,1516) = lu(k,1516) - lu(k,1349) * lu(k,1502) + lu(k,1517) = lu(k,1517) - lu(k,1350) * lu(k,1502) + lu(k,1518) = lu(k,1518) - lu(k,1351) * lu(k,1502) + lu(k,1519) = lu(k,1519) - lu(k,1352) * lu(k,1502) + lu(k,1539) = lu(k,1539) - lu(k,1336) * lu(k,1538) + lu(k,1540) = lu(k,1540) - lu(k,1337) * lu(k,1538) + lu(k,1541) = lu(k,1541) - lu(k,1338) * lu(k,1538) + lu(k,1542) = lu(k,1542) - lu(k,1339) * lu(k,1538) + lu(k,1543) = lu(k,1543) - lu(k,1340) * lu(k,1538) + lu(k,1544) = lu(k,1544) - lu(k,1341) * lu(k,1538) + lu(k,1545) = lu(k,1545) - lu(k,1342) * lu(k,1538) + lu(k,1546) = lu(k,1546) - lu(k,1343) * lu(k,1538) + lu(k,1547) = lu(k,1547) - lu(k,1344) * lu(k,1538) + lu(k,1548) = lu(k,1548) - lu(k,1345) * lu(k,1538) + lu(k,1549) = lu(k,1549) - lu(k,1346) * lu(k,1538) + lu(k,1550) = lu(k,1550) - lu(k,1347) * lu(k,1538) + lu(k,1551) = lu(k,1551) - lu(k,1348) * lu(k,1538) + lu(k,1552) = lu(k,1552) - lu(k,1349) * lu(k,1538) + lu(k,1553) = lu(k,1553) - lu(k,1350) * lu(k,1538) + lu(k,1554) = lu(k,1554) - lu(k,1351) * lu(k,1538) + lu(k,1555) = lu(k,1555) - lu(k,1352) * lu(k,1538) + lu(k,1584) = lu(k,1584) - lu(k,1336) * lu(k,1583) + lu(k,1585) = lu(k,1585) - lu(k,1337) * lu(k,1583) + lu(k,1586) = lu(k,1586) - lu(k,1338) * lu(k,1583) + lu(k,1587) = lu(k,1587) - lu(k,1339) * lu(k,1583) + lu(k,1588) = lu(k,1588) - lu(k,1340) * lu(k,1583) + lu(k,1589) = lu(k,1589) - lu(k,1341) * lu(k,1583) + lu(k,1590) = lu(k,1590) - lu(k,1342) * lu(k,1583) + lu(k,1591) = lu(k,1591) - lu(k,1343) * lu(k,1583) + lu(k,1592) = lu(k,1592) - lu(k,1344) * lu(k,1583) + lu(k,1593) = lu(k,1593) - lu(k,1345) * lu(k,1583) + lu(k,1594) = lu(k,1594) - lu(k,1346) * lu(k,1583) + lu(k,1595) = lu(k,1595) - lu(k,1347) * lu(k,1583) + lu(k,1596) = lu(k,1596) - lu(k,1348) * lu(k,1583) + lu(k,1597) = lu(k,1597) - lu(k,1349) * lu(k,1583) + lu(k,1598) = lu(k,1598) - lu(k,1350) * lu(k,1583) + lu(k,1599) = lu(k,1599) - lu(k,1351) * lu(k,1583) + lu(k,1600) = lu(k,1600) - lu(k,1352) * lu(k,1583) + lu(k,1632) = lu(k,1632) - lu(k,1336) * lu(k,1631) + lu(k,1633) = lu(k,1633) - lu(k,1337) * lu(k,1631) + lu(k,1634) = lu(k,1634) - lu(k,1338) * lu(k,1631) + lu(k,1635) = lu(k,1635) - lu(k,1339) * lu(k,1631) + lu(k,1636) = lu(k,1636) - lu(k,1340) * lu(k,1631) + lu(k,1637) = lu(k,1637) - lu(k,1341) * lu(k,1631) + lu(k,1638) = lu(k,1638) - lu(k,1342) * lu(k,1631) + lu(k,1639) = lu(k,1639) - lu(k,1343) * lu(k,1631) + lu(k,1640) = lu(k,1640) - lu(k,1344) * lu(k,1631) + lu(k,1641) = lu(k,1641) - lu(k,1345) * lu(k,1631) + lu(k,1642) = lu(k,1642) - lu(k,1346) * lu(k,1631) + lu(k,1643) = lu(k,1643) - lu(k,1347) * lu(k,1631) + lu(k,1644) = lu(k,1644) - lu(k,1348) * lu(k,1631) + lu(k,1645) = lu(k,1645) - lu(k,1349) * lu(k,1631) + lu(k,1646) = lu(k,1646) - lu(k,1350) * lu(k,1631) + lu(k,1647) = lu(k,1647) - lu(k,1351) * lu(k,1631) + lu(k,1648) = lu(k,1648) - lu(k,1352) * lu(k,1631) + lu(k,1675) = lu(k,1675) - lu(k,1336) * lu(k,1674) + lu(k,1676) = lu(k,1676) - lu(k,1337) * lu(k,1674) + lu(k,1677) = lu(k,1677) - lu(k,1338) * lu(k,1674) + lu(k,1678) = lu(k,1678) - lu(k,1339) * lu(k,1674) + lu(k,1679) = lu(k,1679) - lu(k,1340) * lu(k,1674) + lu(k,1680) = lu(k,1680) - lu(k,1341) * lu(k,1674) + lu(k,1681) = lu(k,1681) - lu(k,1342) * lu(k,1674) + lu(k,1682) = lu(k,1682) - lu(k,1343) * lu(k,1674) + lu(k,1683) = lu(k,1683) - lu(k,1344) * lu(k,1674) + lu(k,1684) = lu(k,1684) - lu(k,1345) * lu(k,1674) + lu(k,1685) = lu(k,1685) - lu(k,1346) * lu(k,1674) + lu(k,1686) = lu(k,1686) - lu(k,1347) * lu(k,1674) + lu(k,1687) = lu(k,1687) - lu(k,1348) * lu(k,1674) + lu(k,1688) = lu(k,1688) - lu(k,1349) * lu(k,1674) + lu(k,1689) = lu(k,1689) - lu(k,1350) * lu(k,1674) + lu(k,1690) = lu(k,1690) - lu(k,1351) * lu(k,1674) + lu(k,1691) = lu(k,1691) - lu(k,1352) * lu(k,1674) + lu(k,1717) = lu(k,1717) - lu(k,1336) * lu(k,1716) + lu(k,1718) = lu(k,1718) - lu(k,1337) * lu(k,1716) + lu(k,1719) = lu(k,1719) - lu(k,1338) * lu(k,1716) + lu(k,1720) = lu(k,1720) - lu(k,1339) * lu(k,1716) + lu(k,1721) = lu(k,1721) - lu(k,1340) * lu(k,1716) + lu(k,1722) = lu(k,1722) - lu(k,1341) * lu(k,1716) + lu(k,1723) = lu(k,1723) - lu(k,1342) * lu(k,1716) + lu(k,1724) = lu(k,1724) - lu(k,1343) * lu(k,1716) + lu(k,1725) = lu(k,1725) - lu(k,1344) * lu(k,1716) + lu(k,1726) = lu(k,1726) - lu(k,1345) * lu(k,1716) + lu(k,1727) = lu(k,1727) - lu(k,1346) * lu(k,1716) + lu(k,1728) = lu(k,1728) - lu(k,1347) * lu(k,1716) + lu(k,1729) = lu(k,1729) - lu(k,1348) * lu(k,1716) + lu(k,1730) = lu(k,1730) - lu(k,1349) * lu(k,1716) + lu(k,1731) = lu(k,1731) - lu(k,1350) * lu(k,1716) + lu(k,1732) = lu(k,1732) - lu(k,1351) * lu(k,1716) + lu(k,1733) = lu(k,1733) - lu(k,1352) * lu(k,1716) + lu(k,1762) = lu(k,1762) - lu(k,1336) * lu(k,1761) + lu(k,1763) = lu(k,1763) - lu(k,1337) * lu(k,1761) + lu(k,1764) = lu(k,1764) - lu(k,1338) * lu(k,1761) + lu(k,1765) = lu(k,1765) - lu(k,1339) * lu(k,1761) + lu(k,1766) = lu(k,1766) - lu(k,1340) * lu(k,1761) + lu(k,1767) = lu(k,1767) - lu(k,1341) * lu(k,1761) + lu(k,1768) = lu(k,1768) - lu(k,1342) * lu(k,1761) + lu(k,1769) = lu(k,1769) - lu(k,1343) * lu(k,1761) + lu(k,1770) = lu(k,1770) - lu(k,1344) * lu(k,1761) + lu(k,1771) = lu(k,1771) - lu(k,1345) * lu(k,1761) + lu(k,1772) = lu(k,1772) - lu(k,1346) * lu(k,1761) + lu(k,1773) = lu(k,1773) - lu(k,1347) * lu(k,1761) + lu(k,1774) = lu(k,1774) - lu(k,1348) * lu(k,1761) + lu(k,1775) = lu(k,1775) - lu(k,1349) * lu(k,1761) + lu(k,1776) = lu(k,1776) - lu(k,1350) * lu(k,1761) + lu(k,1777) = lu(k,1777) - lu(k,1351) * lu(k,1761) + lu(k,1778) = lu(k,1778) - lu(k,1352) * lu(k,1761) + lu(k,1811) = lu(k,1811) - lu(k,1336) * lu(k,1810) + lu(k,1812) = lu(k,1812) - lu(k,1337) * lu(k,1810) + lu(k,1813) = lu(k,1813) - lu(k,1338) * lu(k,1810) + lu(k,1814) = lu(k,1814) - lu(k,1339) * lu(k,1810) + lu(k,1815) = lu(k,1815) - lu(k,1340) * lu(k,1810) + lu(k,1816) = lu(k,1816) - lu(k,1341) * lu(k,1810) + lu(k,1817) = lu(k,1817) - lu(k,1342) * lu(k,1810) + lu(k,1818) = lu(k,1818) - lu(k,1343) * lu(k,1810) + lu(k,1819) = lu(k,1819) - lu(k,1344) * lu(k,1810) + lu(k,1820) = lu(k,1820) - lu(k,1345) * lu(k,1810) + lu(k,1821) = lu(k,1821) - lu(k,1346) * lu(k,1810) + lu(k,1822) = lu(k,1822) - lu(k,1347) * lu(k,1810) + lu(k,1823) = lu(k,1823) - lu(k,1348) * lu(k,1810) + lu(k,1824) = lu(k,1824) - lu(k,1349) * lu(k,1810) + lu(k,1825) = lu(k,1825) - lu(k,1350) * lu(k,1810) + lu(k,1826) = lu(k,1826) - lu(k,1351) * lu(k,1810) + lu(k,1827) = lu(k,1827) - lu(k,1352) * lu(k,1810) + lu(k,1844) = lu(k,1844) - lu(k,1336) * lu(k,1843) + lu(k,1845) = lu(k,1845) - lu(k,1337) * lu(k,1843) + lu(k,1846) = lu(k,1846) - lu(k,1338) * lu(k,1843) + lu(k,1847) = lu(k,1847) - lu(k,1339) * lu(k,1843) + lu(k,1848) = lu(k,1848) - lu(k,1340) * lu(k,1843) + lu(k,1849) = lu(k,1849) - lu(k,1341) * lu(k,1843) + lu(k,1850) = lu(k,1850) - lu(k,1342) * lu(k,1843) + lu(k,1851) = lu(k,1851) - lu(k,1343) * lu(k,1843) + lu(k,1852) = lu(k,1852) - lu(k,1344) * lu(k,1843) + lu(k,1853) = lu(k,1853) - lu(k,1345) * lu(k,1843) + lu(k,1854) = lu(k,1854) - lu(k,1346) * lu(k,1843) + lu(k,1855) = lu(k,1855) - lu(k,1347) * lu(k,1843) + lu(k,1856) = lu(k,1856) - lu(k,1348) * lu(k,1843) + lu(k,1857) = lu(k,1857) - lu(k,1349) * lu(k,1843) + lu(k,1858) = lu(k,1858) - lu(k,1350) * lu(k,1843) + lu(k,1859) = lu(k,1859) - lu(k,1351) * lu(k,1843) + lu(k,1860) = lu(k,1860) - lu(k,1352) * lu(k,1843) + lu(k,1880) = lu(k,1880) - lu(k,1336) * lu(k,1879) + lu(k,1881) = lu(k,1881) - lu(k,1337) * lu(k,1879) + lu(k,1882) = lu(k,1882) - lu(k,1338) * lu(k,1879) + lu(k,1883) = lu(k,1883) - lu(k,1339) * lu(k,1879) + lu(k,1884) = lu(k,1884) - lu(k,1340) * lu(k,1879) + lu(k,1885) = lu(k,1885) - lu(k,1341) * lu(k,1879) + lu(k,1886) = lu(k,1886) - lu(k,1342) * lu(k,1879) + lu(k,1887) = lu(k,1887) - lu(k,1343) * lu(k,1879) + lu(k,1888) = lu(k,1888) - lu(k,1344) * lu(k,1879) + lu(k,1889) = lu(k,1889) - lu(k,1345) * lu(k,1879) + lu(k,1890) = lu(k,1890) - lu(k,1346) * lu(k,1879) + lu(k,1891) = lu(k,1891) - lu(k,1347) * lu(k,1879) + lu(k,1892) = lu(k,1892) - lu(k,1348) * lu(k,1879) + lu(k,1893) = lu(k,1893) - lu(k,1349) * lu(k,1879) + lu(k,1894) = lu(k,1894) - lu(k,1350) * lu(k,1879) + lu(k,1895) = lu(k,1895) - lu(k,1351) * lu(k,1879) + lu(k,1896) = lu(k,1896) - lu(k,1352) * lu(k,1879) + lu(k,1921) = lu(k,1921) - lu(k,1336) * lu(k,1920) + lu(k,1922) = lu(k,1922) - lu(k,1337) * lu(k,1920) + lu(k,1923) = lu(k,1923) - lu(k,1338) * lu(k,1920) + lu(k,1924) = lu(k,1924) - lu(k,1339) * lu(k,1920) + lu(k,1925) = lu(k,1925) - lu(k,1340) * lu(k,1920) + lu(k,1926) = lu(k,1926) - lu(k,1341) * lu(k,1920) + lu(k,1927) = lu(k,1927) - lu(k,1342) * lu(k,1920) + lu(k,1928) = lu(k,1928) - lu(k,1343) * lu(k,1920) + lu(k,1929) = lu(k,1929) - lu(k,1344) * lu(k,1920) + lu(k,1930) = lu(k,1930) - lu(k,1345) * lu(k,1920) + lu(k,1931) = lu(k,1931) - lu(k,1346) * lu(k,1920) + lu(k,1932) = lu(k,1932) - lu(k,1347) * lu(k,1920) + lu(k,1933) = lu(k,1933) - lu(k,1348) * lu(k,1920) + lu(k,1934) = lu(k,1934) - lu(k,1349) * lu(k,1920) + lu(k,1935) = lu(k,1935) - lu(k,1350) * lu(k,1920) + lu(k,1936) = lu(k,1936) - lu(k,1351) * lu(k,1920) + lu(k,1937) = lu(k,1937) - lu(k,1352) * lu(k,1920) + lu(k,1963) = lu(k,1963) - lu(k,1336) * lu(k,1962) + lu(k,1964) = lu(k,1964) - lu(k,1337) * lu(k,1962) + lu(k,1965) = lu(k,1965) - lu(k,1338) * lu(k,1962) + lu(k,1966) = lu(k,1966) - lu(k,1339) * lu(k,1962) + lu(k,1967) = lu(k,1967) - lu(k,1340) * lu(k,1962) + lu(k,1968) = lu(k,1968) - lu(k,1341) * lu(k,1962) + lu(k,1969) = lu(k,1969) - lu(k,1342) * lu(k,1962) + lu(k,1970) = lu(k,1970) - lu(k,1343) * lu(k,1962) + lu(k,1971) = lu(k,1971) - lu(k,1344) * lu(k,1962) + lu(k,1972) = lu(k,1972) - lu(k,1345) * lu(k,1962) + lu(k,1973) = lu(k,1973) - lu(k,1346) * lu(k,1962) + lu(k,1974) = lu(k,1974) - lu(k,1347) * lu(k,1962) + lu(k,1975) = lu(k,1975) - lu(k,1348) * lu(k,1962) + lu(k,1976) = lu(k,1976) - lu(k,1349) * lu(k,1962) + lu(k,1977) = lu(k,1977) - lu(k,1350) * lu(k,1962) + lu(k,1978) = lu(k,1978) - lu(k,1351) * lu(k,1962) + lu(k,1979) = lu(k,1979) - lu(k,1352) * lu(k,1962) + lu(k,2011) = lu(k,2011) - lu(k,1336) * lu(k,2010) + lu(k,2012) = lu(k,2012) - lu(k,1337) * lu(k,2010) + lu(k,2013) = lu(k,2013) - lu(k,1338) * lu(k,2010) + lu(k,2014) = lu(k,2014) - lu(k,1339) * lu(k,2010) + lu(k,2015) = lu(k,2015) - lu(k,1340) * lu(k,2010) + lu(k,2016) = lu(k,2016) - lu(k,1341) * lu(k,2010) + lu(k,2017) = lu(k,2017) - lu(k,1342) * lu(k,2010) + lu(k,2018) = lu(k,2018) - lu(k,1343) * lu(k,2010) + lu(k,2019) = lu(k,2019) - lu(k,1344) * lu(k,2010) + lu(k,2020) = lu(k,2020) - lu(k,1345) * lu(k,2010) + lu(k,2021) = lu(k,2021) - lu(k,1346) * lu(k,2010) + lu(k,2022) = lu(k,2022) - lu(k,1347) * lu(k,2010) + lu(k,2023) = lu(k,2023) - lu(k,1348) * lu(k,2010) + lu(k,2024) = lu(k,2024) - lu(k,1349) * lu(k,2010) + lu(k,2025) = lu(k,2025) - lu(k,1350) * lu(k,2010) + lu(k,2026) = lu(k,2026) - lu(k,1351) * lu(k,2010) + lu(k,2027) = lu(k,2027) - lu(k,1352) * lu(k,2010) + lu(k,2071) = lu(k,2071) - lu(k,1336) * lu(k,2070) + lu(k,2072) = lu(k,2072) - lu(k,1337) * lu(k,2070) + lu(k,2073) = lu(k,2073) - lu(k,1338) * lu(k,2070) + lu(k,2074) = lu(k,2074) - lu(k,1339) * lu(k,2070) + lu(k,2075) = lu(k,2075) - lu(k,1340) * lu(k,2070) + lu(k,2076) = lu(k,2076) - lu(k,1341) * lu(k,2070) + lu(k,2077) = lu(k,2077) - lu(k,1342) * lu(k,2070) + lu(k,2078) = lu(k,2078) - lu(k,1343) * lu(k,2070) + lu(k,2079) = lu(k,2079) - lu(k,1344) * lu(k,2070) + lu(k,2080) = lu(k,2080) - lu(k,1345) * lu(k,2070) + lu(k,2081) = lu(k,2081) - lu(k,1346) * lu(k,2070) + lu(k,2082) = lu(k,2082) - lu(k,1347) * lu(k,2070) + lu(k,2083) = lu(k,2083) - lu(k,1348) * lu(k,2070) + lu(k,2084) = lu(k,2084) - lu(k,1349) * lu(k,2070) + lu(k,2085) = lu(k,2085) - lu(k,1350) * lu(k,2070) + lu(k,2086) = lu(k,2086) - lu(k,1351) * lu(k,2070) + lu(k,2087) = lu(k,2087) - lu(k,1352) * lu(k,2070) end do - end subroutine lu_fac22 - subroutine lu_fac23( avec_len, lu ) + end subroutine lu_fac23 + subroutine lu_fac24( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 implicit none @@ -12395,415 +12538,917 @@ subroutine lu_fac23( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1433) = 1._r8 / lu(k,1433) - lu(k,1434) = lu(k,1434) * lu(k,1433) - lu(k,1435) = lu(k,1435) * lu(k,1433) - lu(k,1436) = lu(k,1436) * lu(k,1433) - lu(k,1437) = lu(k,1437) * lu(k,1433) - lu(k,1438) = lu(k,1438) * lu(k,1433) - lu(k,1439) = lu(k,1439) * lu(k,1433) - lu(k,1440) = lu(k,1440) * lu(k,1433) - lu(k,1441) = lu(k,1441) * lu(k,1433) - lu(k,1442) = lu(k,1442) * lu(k,1433) - lu(k,1443) = lu(k,1443) * lu(k,1433) - lu(k,1476) = lu(k,1476) - lu(k,1434) * lu(k,1475) - lu(k,1477) = lu(k,1477) - lu(k,1435) * lu(k,1475) - lu(k,1478) = lu(k,1478) - lu(k,1436) * lu(k,1475) - lu(k,1479) = lu(k,1479) - lu(k,1437) * lu(k,1475) - lu(k,1480) = lu(k,1480) - lu(k,1438) * lu(k,1475) - lu(k,1481) = lu(k,1481) - lu(k,1439) * lu(k,1475) - lu(k,1482) = lu(k,1482) - lu(k,1440) * lu(k,1475) - lu(k,1483) = lu(k,1483) - lu(k,1441) * lu(k,1475) - lu(k,1484) = lu(k,1484) - lu(k,1442) * lu(k,1475) - lu(k,1485) = lu(k,1485) - lu(k,1443) * lu(k,1475) - lu(k,1517) = lu(k,1517) - lu(k,1434) * lu(k,1516) - lu(k,1518) = lu(k,1518) - lu(k,1435) * lu(k,1516) - lu(k,1519) = lu(k,1519) - lu(k,1436) * lu(k,1516) - lu(k,1520) = lu(k,1520) - lu(k,1437) * lu(k,1516) - lu(k,1521) = lu(k,1521) - lu(k,1438) * lu(k,1516) - lu(k,1522) = lu(k,1522) - lu(k,1439) * lu(k,1516) - lu(k,1523) = lu(k,1523) - lu(k,1440) * lu(k,1516) - lu(k,1524) = lu(k,1524) - lu(k,1441) * lu(k,1516) - lu(k,1525) = lu(k,1525) - lu(k,1442) * lu(k,1516) - lu(k,1526) = lu(k,1526) - lu(k,1443) * lu(k,1516) - lu(k,1559) = lu(k,1559) - lu(k,1434) * lu(k,1558) - lu(k,1560) = lu(k,1560) - lu(k,1435) * lu(k,1558) - lu(k,1561) = lu(k,1561) - lu(k,1436) * lu(k,1558) - lu(k,1562) = lu(k,1562) - lu(k,1437) * lu(k,1558) - lu(k,1563) = lu(k,1563) - lu(k,1438) * lu(k,1558) - lu(k,1564) = lu(k,1564) - lu(k,1439) * lu(k,1558) - lu(k,1565) = lu(k,1565) - lu(k,1440) * lu(k,1558) - lu(k,1566) = lu(k,1566) - lu(k,1441) * lu(k,1558) - lu(k,1567) = lu(k,1567) - lu(k,1442) * lu(k,1558) - lu(k,1568) = lu(k,1568) - lu(k,1443) * lu(k,1558) - lu(k,1601) = lu(k,1601) - lu(k,1434) * lu(k,1600) - lu(k,1602) = lu(k,1602) - lu(k,1435) * lu(k,1600) - lu(k,1603) = lu(k,1603) - lu(k,1436) * lu(k,1600) - lu(k,1604) = lu(k,1604) - lu(k,1437) * lu(k,1600) - lu(k,1605) = lu(k,1605) - lu(k,1438) * lu(k,1600) - lu(k,1606) = lu(k,1606) - lu(k,1439) * lu(k,1600) - lu(k,1607) = lu(k,1607) - lu(k,1440) * lu(k,1600) - lu(k,1608) = lu(k,1608) - lu(k,1441) * lu(k,1600) - lu(k,1609) = lu(k,1609) - lu(k,1442) * lu(k,1600) - lu(k,1610) = lu(k,1610) - lu(k,1443) * lu(k,1600) - lu(k,1633) = lu(k,1633) - lu(k,1434) * lu(k,1632) - lu(k,1634) = lu(k,1634) - lu(k,1435) * lu(k,1632) - lu(k,1635) = lu(k,1635) - lu(k,1436) * lu(k,1632) - lu(k,1636) = lu(k,1636) - lu(k,1437) * lu(k,1632) - lu(k,1637) = lu(k,1637) - lu(k,1438) * lu(k,1632) - lu(k,1638) = lu(k,1638) - lu(k,1439) * lu(k,1632) - lu(k,1639) = lu(k,1639) - lu(k,1440) * lu(k,1632) - lu(k,1640) = lu(k,1640) - lu(k,1441) * lu(k,1632) - lu(k,1641) = lu(k,1641) - lu(k,1442) * lu(k,1632) - lu(k,1642) = lu(k,1642) - lu(k,1443) * lu(k,1632) - lu(k,1668) = lu(k,1668) - lu(k,1434) * lu(k,1667) - lu(k,1669) = lu(k,1669) - lu(k,1435) * lu(k,1667) - lu(k,1670) = lu(k,1670) - lu(k,1436) * lu(k,1667) - lu(k,1671) = lu(k,1671) - lu(k,1437) * lu(k,1667) - lu(k,1672) = lu(k,1672) - lu(k,1438) * lu(k,1667) - lu(k,1673) = lu(k,1673) - lu(k,1439) * lu(k,1667) - lu(k,1674) = lu(k,1674) - lu(k,1440) * lu(k,1667) - lu(k,1675) = lu(k,1675) - lu(k,1441) * lu(k,1667) - lu(k,1676) = lu(k,1676) - lu(k,1442) * lu(k,1667) - lu(k,1677) = lu(k,1677) - lu(k,1443) * lu(k,1667) - lu(k,1710) = lu(k,1710) - lu(k,1434) * lu(k,1709) - lu(k,1711) = lu(k,1711) - lu(k,1435) * lu(k,1709) - lu(k,1712) = lu(k,1712) - lu(k,1436) * lu(k,1709) - lu(k,1713) = lu(k,1713) - lu(k,1437) * lu(k,1709) - lu(k,1714) = lu(k,1714) - lu(k,1438) * lu(k,1709) - lu(k,1715) = lu(k,1715) - lu(k,1439) * lu(k,1709) - lu(k,1716) = lu(k,1716) - lu(k,1440) * lu(k,1709) - lu(k,1717) = lu(k,1717) - lu(k,1441) * lu(k,1709) - lu(k,1718) = lu(k,1718) - lu(k,1442) * lu(k,1709) - lu(k,1719) = lu(k,1719) - lu(k,1443) * lu(k,1709) - lu(k,1754) = lu(k,1754) - lu(k,1434) * lu(k,1753) - lu(k,1755) = lu(k,1755) - lu(k,1435) * lu(k,1753) - lu(k,1756) = lu(k,1756) - lu(k,1436) * lu(k,1753) - lu(k,1757) = lu(k,1757) - lu(k,1437) * lu(k,1753) - lu(k,1758) = lu(k,1758) - lu(k,1438) * lu(k,1753) - lu(k,1759) = lu(k,1759) - lu(k,1439) * lu(k,1753) - lu(k,1760) = lu(k,1760) - lu(k,1440) * lu(k,1753) - lu(k,1761) = lu(k,1761) - lu(k,1441) * lu(k,1753) - lu(k,1762) = lu(k,1762) - lu(k,1442) * lu(k,1753) - lu(k,1763) = lu(k,1763) - lu(k,1443) * lu(k,1753) - lu(k,1789) = lu(k,1789) - lu(k,1434) * lu(k,1788) - lu(k,1790) = lu(k,1790) - lu(k,1435) * lu(k,1788) - lu(k,1791) = lu(k,1791) - lu(k,1436) * lu(k,1788) - lu(k,1792) = lu(k,1792) - lu(k,1437) * lu(k,1788) - lu(k,1793) = lu(k,1793) - lu(k,1438) * lu(k,1788) - lu(k,1794) = lu(k,1794) - lu(k,1439) * lu(k,1788) - lu(k,1795) = lu(k,1795) - lu(k,1440) * lu(k,1788) - lu(k,1796) = lu(k,1796) - lu(k,1441) * lu(k,1788) - lu(k,1797) = lu(k,1797) - lu(k,1442) * lu(k,1788) - lu(k,1798) = lu(k,1798) - lu(k,1443) * lu(k,1788) - lu(k,1847) = lu(k,1847) - lu(k,1434) * lu(k,1846) - lu(k,1848) = lu(k,1848) - lu(k,1435) * lu(k,1846) - lu(k,1849) = lu(k,1849) - lu(k,1436) * lu(k,1846) - lu(k,1850) = lu(k,1850) - lu(k,1437) * lu(k,1846) - lu(k,1851) = lu(k,1851) - lu(k,1438) * lu(k,1846) - lu(k,1852) = lu(k,1852) - lu(k,1439) * lu(k,1846) - lu(k,1853) = lu(k,1853) - lu(k,1440) * lu(k,1846) - lu(k,1854) = lu(k,1854) - lu(k,1441) * lu(k,1846) - lu(k,1855) = lu(k,1855) - lu(k,1442) * lu(k,1846) - lu(k,1856) = lu(k,1856) - lu(k,1443) * lu(k,1846) - lu(k,1476) = 1._r8 / lu(k,1476) - lu(k,1477) = lu(k,1477) * lu(k,1476) - lu(k,1478) = lu(k,1478) * lu(k,1476) - lu(k,1479) = lu(k,1479) * lu(k,1476) - lu(k,1480) = lu(k,1480) * lu(k,1476) - lu(k,1481) = lu(k,1481) * lu(k,1476) - lu(k,1482) = lu(k,1482) * lu(k,1476) - lu(k,1483) = lu(k,1483) * lu(k,1476) - lu(k,1484) = lu(k,1484) * lu(k,1476) - lu(k,1485) = lu(k,1485) * lu(k,1476) - lu(k,1518) = lu(k,1518) - lu(k,1477) * lu(k,1517) - lu(k,1519) = lu(k,1519) - lu(k,1478) * lu(k,1517) - lu(k,1520) = lu(k,1520) - lu(k,1479) * lu(k,1517) - lu(k,1521) = lu(k,1521) - lu(k,1480) * lu(k,1517) - lu(k,1522) = lu(k,1522) - lu(k,1481) * lu(k,1517) - lu(k,1523) = lu(k,1523) - lu(k,1482) * lu(k,1517) - lu(k,1524) = lu(k,1524) - lu(k,1483) * lu(k,1517) - lu(k,1525) = lu(k,1525) - lu(k,1484) * lu(k,1517) - lu(k,1526) = lu(k,1526) - lu(k,1485) * lu(k,1517) - lu(k,1560) = lu(k,1560) - lu(k,1477) * lu(k,1559) - lu(k,1561) = lu(k,1561) - lu(k,1478) * lu(k,1559) - lu(k,1562) = lu(k,1562) - lu(k,1479) * lu(k,1559) - lu(k,1563) = lu(k,1563) - lu(k,1480) * lu(k,1559) - lu(k,1564) = lu(k,1564) - lu(k,1481) * lu(k,1559) - lu(k,1565) = lu(k,1565) - lu(k,1482) * lu(k,1559) - lu(k,1566) = lu(k,1566) - lu(k,1483) * lu(k,1559) - lu(k,1567) = lu(k,1567) - lu(k,1484) * lu(k,1559) - lu(k,1568) = lu(k,1568) - lu(k,1485) * lu(k,1559) - lu(k,1602) = lu(k,1602) - lu(k,1477) * lu(k,1601) - lu(k,1603) = lu(k,1603) - lu(k,1478) * lu(k,1601) - lu(k,1604) = lu(k,1604) - lu(k,1479) * lu(k,1601) - lu(k,1605) = lu(k,1605) - lu(k,1480) * lu(k,1601) - lu(k,1606) = lu(k,1606) - lu(k,1481) * lu(k,1601) - lu(k,1607) = lu(k,1607) - lu(k,1482) * lu(k,1601) - lu(k,1608) = lu(k,1608) - lu(k,1483) * lu(k,1601) - lu(k,1609) = lu(k,1609) - lu(k,1484) * lu(k,1601) - lu(k,1610) = lu(k,1610) - lu(k,1485) * lu(k,1601) - lu(k,1634) = lu(k,1634) - lu(k,1477) * lu(k,1633) - lu(k,1635) = lu(k,1635) - lu(k,1478) * lu(k,1633) - lu(k,1636) = lu(k,1636) - lu(k,1479) * lu(k,1633) - lu(k,1637) = lu(k,1637) - lu(k,1480) * lu(k,1633) - lu(k,1638) = lu(k,1638) - lu(k,1481) * lu(k,1633) - lu(k,1639) = lu(k,1639) - lu(k,1482) * lu(k,1633) - lu(k,1640) = lu(k,1640) - lu(k,1483) * lu(k,1633) - lu(k,1641) = lu(k,1641) - lu(k,1484) * lu(k,1633) - lu(k,1642) = lu(k,1642) - lu(k,1485) * lu(k,1633) - lu(k,1669) = lu(k,1669) - lu(k,1477) * lu(k,1668) - lu(k,1670) = lu(k,1670) - lu(k,1478) * lu(k,1668) - lu(k,1671) = lu(k,1671) - lu(k,1479) * lu(k,1668) - lu(k,1672) = lu(k,1672) - lu(k,1480) * lu(k,1668) - lu(k,1673) = lu(k,1673) - lu(k,1481) * lu(k,1668) - lu(k,1674) = lu(k,1674) - lu(k,1482) * lu(k,1668) - lu(k,1675) = lu(k,1675) - lu(k,1483) * lu(k,1668) - lu(k,1676) = lu(k,1676) - lu(k,1484) * lu(k,1668) - lu(k,1677) = lu(k,1677) - lu(k,1485) * lu(k,1668) - lu(k,1711) = lu(k,1711) - lu(k,1477) * lu(k,1710) - lu(k,1712) = lu(k,1712) - lu(k,1478) * lu(k,1710) - lu(k,1713) = lu(k,1713) - lu(k,1479) * lu(k,1710) - lu(k,1714) = lu(k,1714) - lu(k,1480) * lu(k,1710) - lu(k,1715) = lu(k,1715) - lu(k,1481) * lu(k,1710) - lu(k,1716) = lu(k,1716) - lu(k,1482) * lu(k,1710) - lu(k,1717) = lu(k,1717) - lu(k,1483) * lu(k,1710) - lu(k,1718) = lu(k,1718) - lu(k,1484) * lu(k,1710) - lu(k,1719) = lu(k,1719) - lu(k,1485) * lu(k,1710) - lu(k,1755) = lu(k,1755) - lu(k,1477) * lu(k,1754) - lu(k,1756) = lu(k,1756) - lu(k,1478) * lu(k,1754) - lu(k,1757) = lu(k,1757) - lu(k,1479) * lu(k,1754) - lu(k,1758) = lu(k,1758) - lu(k,1480) * lu(k,1754) - lu(k,1759) = lu(k,1759) - lu(k,1481) * lu(k,1754) - lu(k,1760) = lu(k,1760) - lu(k,1482) * lu(k,1754) - lu(k,1761) = lu(k,1761) - lu(k,1483) * lu(k,1754) - lu(k,1762) = lu(k,1762) - lu(k,1484) * lu(k,1754) - lu(k,1763) = lu(k,1763) - lu(k,1485) * lu(k,1754) - lu(k,1790) = lu(k,1790) - lu(k,1477) * lu(k,1789) - lu(k,1791) = lu(k,1791) - lu(k,1478) * lu(k,1789) - lu(k,1792) = lu(k,1792) - lu(k,1479) * lu(k,1789) - lu(k,1793) = lu(k,1793) - lu(k,1480) * lu(k,1789) - lu(k,1794) = lu(k,1794) - lu(k,1481) * lu(k,1789) - lu(k,1795) = lu(k,1795) - lu(k,1482) * lu(k,1789) - lu(k,1796) = lu(k,1796) - lu(k,1483) * lu(k,1789) - lu(k,1797) = lu(k,1797) - lu(k,1484) * lu(k,1789) - lu(k,1798) = lu(k,1798) - lu(k,1485) * lu(k,1789) - lu(k,1848) = lu(k,1848) - lu(k,1477) * lu(k,1847) - lu(k,1849) = lu(k,1849) - lu(k,1478) * lu(k,1847) - lu(k,1850) = lu(k,1850) - lu(k,1479) * lu(k,1847) - lu(k,1851) = lu(k,1851) - lu(k,1480) * lu(k,1847) - lu(k,1852) = lu(k,1852) - lu(k,1481) * lu(k,1847) - lu(k,1853) = lu(k,1853) - lu(k,1482) * lu(k,1847) - lu(k,1854) = lu(k,1854) - lu(k,1483) * lu(k,1847) - lu(k,1855) = lu(k,1855) - lu(k,1484) * lu(k,1847) - lu(k,1856) = lu(k,1856) - lu(k,1485) * lu(k,1847) - lu(k,1518) = 1._r8 / lu(k,1518) - lu(k,1519) = lu(k,1519) * lu(k,1518) - lu(k,1520) = lu(k,1520) * lu(k,1518) - lu(k,1521) = lu(k,1521) * lu(k,1518) - lu(k,1522) = lu(k,1522) * lu(k,1518) - lu(k,1523) = lu(k,1523) * lu(k,1518) - lu(k,1524) = lu(k,1524) * lu(k,1518) - lu(k,1525) = lu(k,1525) * lu(k,1518) - lu(k,1526) = lu(k,1526) * lu(k,1518) - lu(k,1561) = lu(k,1561) - lu(k,1519) * lu(k,1560) - lu(k,1562) = lu(k,1562) - lu(k,1520) * lu(k,1560) - lu(k,1563) = lu(k,1563) - lu(k,1521) * lu(k,1560) - lu(k,1564) = lu(k,1564) - lu(k,1522) * lu(k,1560) - lu(k,1565) = lu(k,1565) - lu(k,1523) * lu(k,1560) - lu(k,1566) = lu(k,1566) - lu(k,1524) * lu(k,1560) - lu(k,1567) = lu(k,1567) - lu(k,1525) * lu(k,1560) - lu(k,1568) = lu(k,1568) - lu(k,1526) * lu(k,1560) - lu(k,1603) = lu(k,1603) - lu(k,1519) * lu(k,1602) - lu(k,1604) = lu(k,1604) - lu(k,1520) * lu(k,1602) - lu(k,1605) = lu(k,1605) - lu(k,1521) * lu(k,1602) - lu(k,1606) = lu(k,1606) - lu(k,1522) * lu(k,1602) - lu(k,1607) = lu(k,1607) - lu(k,1523) * lu(k,1602) - lu(k,1608) = lu(k,1608) - lu(k,1524) * lu(k,1602) - lu(k,1609) = lu(k,1609) - lu(k,1525) * lu(k,1602) - lu(k,1610) = lu(k,1610) - lu(k,1526) * lu(k,1602) - lu(k,1635) = lu(k,1635) - lu(k,1519) * lu(k,1634) - lu(k,1636) = lu(k,1636) - lu(k,1520) * lu(k,1634) - lu(k,1637) = lu(k,1637) - lu(k,1521) * lu(k,1634) - lu(k,1638) = lu(k,1638) - lu(k,1522) * lu(k,1634) - lu(k,1639) = lu(k,1639) - lu(k,1523) * lu(k,1634) - lu(k,1640) = lu(k,1640) - lu(k,1524) * lu(k,1634) - lu(k,1641) = lu(k,1641) - lu(k,1525) * lu(k,1634) - lu(k,1642) = lu(k,1642) - lu(k,1526) * lu(k,1634) - lu(k,1670) = lu(k,1670) - lu(k,1519) * lu(k,1669) - lu(k,1671) = lu(k,1671) - lu(k,1520) * lu(k,1669) - lu(k,1672) = lu(k,1672) - lu(k,1521) * lu(k,1669) - lu(k,1673) = lu(k,1673) - lu(k,1522) * lu(k,1669) - lu(k,1674) = lu(k,1674) - lu(k,1523) * lu(k,1669) - lu(k,1675) = lu(k,1675) - lu(k,1524) * lu(k,1669) - lu(k,1676) = lu(k,1676) - lu(k,1525) * lu(k,1669) - lu(k,1677) = lu(k,1677) - lu(k,1526) * lu(k,1669) - lu(k,1712) = lu(k,1712) - lu(k,1519) * lu(k,1711) - lu(k,1713) = lu(k,1713) - lu(k,1520) * lu(k,1711) - lu(k,1714) = lu(k,1714) - lu(k,1521) * lu(k,1711) - lu(k,1715) = lu(k,1715) - lu(k,1522) * lu(k,1711) - lu(k,1716) = lu(k,1716) - lu(k,1523) * lu(k,1711) - lu(k,1717) = lu(k,1717) - lu(k,1524) * lu(k,1711) - lu(k,1718) = lu(k,1718) - lu(k,1525) * lu(k,1711) - lu(k,1719) = lu(k,1719) - lu(k,1526) * lu(k,1711) - lu(k,1756) = lu(k,1756) - lu(k,1519) * lu(k,1755) - lu(k,1757) = lu(k,1757) - lu(k,1520) * lu(k,1755) - lu(k,1758) = lu(k,1758) - lu(k,1521) * lu(k,1755) - lu(k,1759) = lu(k,1759) - lu(k,1522) * lu(k,1755) - lu(k,1760) = lu(k,1760) - lu(k,1523) * lu(k,1755) - lu(k,1761) = lu(k,1761) - lu(k,1524) * lu(k,1755) - lu(k,1762) = lu(k,1762) - lu(k,1525) * lu(k,1755) - lu(k,1763) = lu(k,1763) - lu(k,1526) * lu(k,1755) - lu(k,1791) = lu(k,1791) - lu(k,1519) * lu(k,1790) - lu(k,1792) = lu(k,1792) - lu(k,1520) * lu(k,1790) - lu(k,1793) = lu(k,1793) - lu(k,1521) * lu(k,1790) - lu(k,1794) = lu(k,1794) - lu(k,1522) * lu(k,1790) - lu(k,1795) = lu(k,1795) - lu(k,1523) * lu(k,1790) - lu(k,1796) = lu(k,1796) - lu(k,1524) * lu(k,1790) - lu(k,1797) = lu(k,1797) - lu(k,1525) * lu(k,1790) - lu(k,1798) = lu(k,1798) - lu(k,1526) * lu(k,1790) - lu(k,1849) = lu(k,1849) - lu(k,1519) * lu(k,1848) - lu(k,1850) = lu(k,1850) - lu(k,1520) * lu(k,1848) - lu(k,1851) = lu(k,1851) - lu(k,1521) * lu(k,1848) - lu(k,1852) = lu(k,1852) - lu(k,1522) * lu(k,1848) - lu(k,1853) = lu(k,1853) - lu(k,1523) * lu(k,1848) - lu(k,1854) = lu(k,1854) - lu(k,1524) * lu(k,1848) - lu(k,1855) = lu(k,1855) - lu(k,1525) * lu(k,1848) - lu(k,1856) = lu(k,1856) - lu(k,1526) * lu(k,1848) - lu(k,1561) = 1._r8 / lu(k,1561) - lu(k,1562) = lu(k,1562) * lu(k,1561) - lu(k,1563) = lu(k,1563) * lu(k,1561) - lu(k,1564) = lu(k,1564) * lu(k,1561) - lu(k,1565) = lu(k,1565) * lu(k,1561) - lu(k,1566) = lu(k,1566) * lu(k,1561) - lu(k,1567) = lu(k,1567) * lu(k,1561) - lu(k,1568) = lu(k,1568) * lu(k,1561) - lu(k,1604) = lu(k,1604) - lu(k,1562) * lu(k,1603) - lu(k,1605) = lu(k,1605) - lu(k,1563) * lu(k,1603) - lu(k,1606) = lu(k,1606) - lu(k,1564) * lu(k,1603) - lu(k,1607) = lu(k,1607) - lu(k,1565) * lu(k,1603) - lu(k,1608) = lu(k,1608) - lu(k,1566) * lu(k,1603) - lu(k,1609) = lu(k,1609) - lu(k,1567) * lu(k,1603) - lu(k,1610) = lu(k,1610) - lu(k,1568) * lu(k,1603) - lu(k,1636) = lu(k,1636) - lu(k,1562) * lu(k,1635) - lu(k,1637) = lu(k,1637) - lu(k,1563) * lu(k,1635) - lu(k,1638) = lu(k,1638) - lu(k,1564) * lu(k,1635) - lu(k,1639) = lu(k,1639) - lu(k,1565) * lu(k,1635) - lu(k,1640) = lu(k,1640) - lu(k,1566) * lu(k,1635) - lu(k,1641) = lu(k,1641) - lu(k,1567) * lu(k,1635) - lu(k,1642) = lu(k,1642) - lu(k,1568) * lu(k,1635) - lu(k,1671) = lu(k,1671) - lu(k,1562) * lu(k,1670) - lu(k,1672) = lu(k,1672) - lu(k,1563) * lu(k,1670) - lu(k,1673) = lu(k,1673) - lu(k,1564) * lu(k,1670) - lu(k,1674) = lu(k,1674) - lu(k,1565) * lu(k,1670) - lu(k,1675) = lu(k,1675) - lu(k,1566) * lu(k,1670) - lu(k,1676) = lu(k,1676) - lu(k,1567) * lu(k,1670) - lu(k,1677) = lu(k,1677) - lu(k,1568) * lu(k,1670) - lu(k,1713) = lu(k,1713) - lu(k,1562) * lu(k,1712) - lu(k,1714) = lu(k,1714) - lu(k,1563) * lu(k,1712) - lu(k,1715) = lu(k,1715) - lu(k,1564) * lu(k,1712) - lu(k,1716) = lu(k,1716) - lu(k,1565) * lu(k,1712) - lu(k,1717) = lu(k,1717) - lu(k,1566) * lu(k,1712) - lu(k,1718) = lu(k,1718) - lu(k,1567) * lu(k,1712) - lu(k,1719) = lu(k,1719) - lu(k,1568) * lu(k,1712) - lu(k,1757) = lu(k,1757) - lu(k,1562) * lu(k,1756) - lu(k,1758) = lu(k,1758) - lu(k,1563) * lu(k,1756) - lu(k,1759) = lu(k,1759) - lu(k,1564) * lu(k,1756) - lu(k,1760) = lu(k,1760) - lu(k,1565) * lu(k,1756) - lu(k,1761) = lu(k,1761) - lu(k,1566) * lu(k,1756) - lu(k,1762) = lu(k,1762) - lu(k,1567) * lu(k,1756) - lu(k,1763) = lu(k,1763) - lu(k,1568) * lu(k,1756) - lu(k,1792) = lu(k,1792) - lu(k,1562) * lu(k,1791) - lu(k,1793) = lu(k,1793) - lu(k,1563) * lu(k,1791) - lu(k,1794) = lu(k,1794) - lu(k,1564) * lu(k,1791) - lu(k,1795) = lu(k,1795) - lu(k,1565) * lu(k,1791) - lu(k,1796) = lu(k,1796) - lu(k,1566) * lu(k,1791) - lu(k,1797) = lu(k,1797) - lu(k,1567) * lu(k,1791) - lu(k,1798) = lu(k,1798) - lu(k,1568) * lu(k,1791) - lu(k,1850) = lu(k,1850) - lu(k,1562) * lu(k,1849) - lu(k,1851) = lu(k,1851) - lu(k,1563) * lu(k,1849) - lu(k,1852) = lu(k,1852) - lu(k,1564) * lu(k,1849) - lu(k,1853) = lu(k,1853) - lu(k,1565) * lu(k,1849) - lu(k,1854) = lu(k,1854) - lu(k,1566) * lu(k,1849) - lu(k,1855) = lu(k,1855) - lu(k,1567) * lu(k,1849) - lu(k,1856) = lu(k,1856) - lu(k,1568) * lu(k,1849) - lu(k,1604) = 1._r8 / lu(k,1604) - lu(k,1605) = lu(k,1605) * lu(k,1604) - lu(k,1606) = lu(k,1606) * lu(k,1604) - lu(k,1607) = lu(k,1607) * lu(k,1604) - lu(k,1608) = lu(k,1608) * lu(k,1604) - lu(k,1609) = lu(k,1609) * lu(k,1604) - lu(k,1610) = lu(k,1610) * lu(k,1604) - lu(k,1637) = lu(k,1637) - lu(k,1605) * lu(k,1636) - lu(k,1638) = lu(k,1638) - lu(k,1606) * lu(k,1636) - lu(k,1639) = lu(k,1639) - lu(k,1607) * lu(k,1636) - lu(k,1640) = lu(k,1640) - lu(k,1608) * lu(k,1636) - lu(k,1641) = lu(k,1641) - lu(k,1609) * lu(k,1636) - lu(k,1642) = lu(k,1642) - lu(k,1610) * lu(k,1636) - lu(k,1672) = lu(k,1672) - lu(k,1605) * lu(k,1671) - lu(k,1673) = lu(k,1673) - lu(k,1606) * lu(k,1671) - lu(k,1674) = lu(k,1674) - lu(k,1607) * lu(k,1671) - lu(k,1675) = lu(k,1675) - lu(k,1608) * lu(k,1671) - lu(k,1676) = lu(k,1676) - lu(k,1609) * lu(k,1671) - lu(k,1677) = lu(k,1677) - lu(k,1610) * lu(k,1671) - lu(k,1714) = lu(k,1714) - lu(k,1605) * lu(k,1713) - lu(k,1715) = lu(k,1715) - lu(k,1606) * lu(k,1713) - lu(k,1716) = lu(k,1716) - lu(k,1607) * lu(k,1713) - lu(k,1717) = lu(k,1717) - lu(k,1608) * lu(k,1713) - lu(k,1718) = lu(k,1718) - lu(k,1609) * lu(k,1713) - lu(k,1719) = lu(k,1719) - lu(k,1610) * lu(k,1713) - lu(k,1758) = lu(k,1758) - lu(k,1605) * lu(k,1757) - lu(k,1759) = lu(k,1759) - lu(k,1606) * lu(k,1757) - lu(k,1760) = lu(k,1760) - lu(k,1607) * lu(k,1757) - lu(k,1761) = lu(k,1761) - lu(k,1608) * lu(k,1757) - lu(k,1762) = lu(k,1762) - lu(k,1609) * lu(k,1757) - lu(k,1763) = lu(k,1763) - lu(k,1610) * lu(k,1757) - lu(k,1793) = lu(k,1793) - lu(k,1605) * lu(k,1792) - lu(k,1794) = lu(k,1794) - lu(k,1606) * lu(k,1792) - lu(k,1795) = lu(k,1795) - lu(k,1607) * lu(k,1792) - lu(k,1796) = lu(k,1796) - lu(k,1608) * lu(k,1792) - lu(k,1797) = lu(k,1797) - lu(k,1609) * lu(k,1792) - lu(k,1798) = lu(k,1798) - lu(k,1610) * lu(k,1792) - lu(k,1851) = lu(k,1851) - lu(k,1605) * lu(k,1850) - lu(k,1852) = lu(k,1852) - lu(k,1606) * lu(k,1850) - lu(k,1853) = lu(k,1853) - lu(k,1607) * lu(k,1850) - lu(k,1854) = lu(k,1854) - lu(k,1608) * lu(k,1850) - lu(k,1855) = lu(k,1855) - lu(k,1609) * lu(k,1850) - lu(k,1856) = lu(k,1856) - lu(k,1610) * lu(k,1850) - lu(k,1637) = 1._r8 / lu(k,1637) - lu(k,1638) = lu(k,1638) * lu(k,1637) - lu(k,1639) = lu(k,1639) * lu(k,1637) - lu(k,1640) = lu(k,1640) * lu(k,1637) - lu(k,1641) = lu(k,1641) * lu(k,1637) - lu(k,1642) = lu(k,1642) * lu(k,1637) - lu(k,1673) = lu(k,1673) - lu(k,1638) * lu(k,1672) - lu(k,1674) = lu(k,1674) - lu(k,1639) * lu(k,1672) - lu(k,1675) = lu(k,1675) - lu(k,1640) * lu(k,1672) - lu(k,1676) = lu(k,1676) - lu(k,1641) * lu(k,1672) - lu(k,1677) = lu(k,1677) - lu(k,1642) * lu(k,1672) - lu(k,1715) = lu(k,1715) - lu(k,1638) * lu(k,1714) - lu(k,1716) = lu(k,1716) - lu(k,1639) * lu(k,1714) - lu(k,1717) = lu(k,1717) - lu(k,1640) * lu(k,1714) - lu(k,1718) = lu(k,1718) - lu(k,1641) * lu(k,1714) - lu(k,1719) = lu(k,1719) - lu(k,1642) * lu(k,1714) - lu(k,1759) = lu(k,1759) - lu(k,1638) * lu(k,1758) - lu(k,1760) = lu(k,1760) - lu(k,1639) * lu(k,1758) - lu(k,1761) = lu(k,1761) - lu(k,1640) * lu(k,1758) - lu(k,1762) = lu(k,1762) - lu(k,1641) * lu(k,1758) - lu(k,1763) = lu(k,1763) - lu(k,1642) * lu(k,1758) - lu(k,1794) = lu(k,1794) - lu(k,1638) * lu(k,1793) - lu(k,1795) = lu(k,1795) - lu(k,1639) * lu(k,1793) - lu(k,1796) = lu(k,1796) - lu(k,1640) * lu(k,1793) - lu(k,1797) = lu(k,1797) - lu(k,1641) * lu(k,1793) - lu(k,1798) = lu(k,1798) - lu(k,1642) * lu(k,1793) - lu(k,1852) = lu(k,1852) - lu(k,1638) * lu(k,1851) - lu(k,1853) = lu(k,1853) - lu(k,1639) * lu(k,1851) - lu(k,1854) = lu(k,1854) - lu(k,1640) * lu(k,1851) - lu(k,1855) = lu(k,1855) - lu(k,1641) * lu(k,1851) - lu(k,1856) = lu(k,1856) - lu(k,1642) * lu(k,1851) + lu(k,1372) = 1._r8 / lu(k,1372) + lu(k,1373) = lu(k,1373) * lu(k,1372) + lu(k,1374) = lu(k,1374) * lu(k,1372) + lu(k,1375) = lu(k,1375) * lu(k,1372) + lu(k,1376) = lu(k,1376) * lu(k,1372) + lu(k,1377) = lu(k,1377) * lu(k,1372) + lu(k,1378) = lu(k,1378) * lu(k,1372) + lu(k,1379) = lu(k,1379) * lu(k,1372) + lu(k,1380) = lu(k,1380) * lu(k,1372) + lu(k,1381) = lu(k,1381) * lu(k,1372) + lu(k,1382) = lu(k,1382) * lu(k,1372) + lu(k,1383) = lu(k,1383) * lu(k,1372) + lu(k,1384) = lu(k,1384) * lu(k,1372) + lu(k,1385) = lu(k,1385) * lu(k,1372) + lu(k,1386) = lu(k,1386) * lu(k,1372) + lu(k,1387) = lu(k,1387) * lu(k,1372) + lu(k,1388) = lu(k,1388) * lu(k,1372) + lu(k,1416) = lu(k,1416) - lu(k,1373) * lu(k,1415) + lu(k,1417) = lu(k,1417) - lu(k,1374) * lu(k,1415) + lu(k,1418) = lu(k,1418) - lu(k,1375) * lu(k,1415) + lu(k,1419) = lu(k,1419) - lu(k,1376) * lu(k,1415) + lu(k,1420) = lu(k,1420) - lu(k,1377) * lu(k,1415) + lu(k,1421) = lu(k,1421) - lu(k,1378) * lu(k,1415) + lu(k,1422) = lu(k,1422) - lu(k,1379) * lu(k,1415) + lu(k,1423) = lu(k,1423) - lu(k,1380) * lu(k,1415) + lu(k,1424) = lu(k,1424) - lu(k,1381) * lu(k,1415) + lu(k,1425) = lu(k,1425) - lu(k,1382) * lu(k,1415) + lu(k,1426) = lu(k,1426) - lu(k,1383) * lu(k,1415) + lu(k,1427) = lu(k,1427) - lu(k,1384) * lu(k,1415) + lu(k,1428) = lu(k,1428) - lu(k,1385) * lu(k,1415) + lu(k,1429) = lu(k,1429) - lu(k,1386) * lu(k,1415) + lu(k,1430) = lu(k,1430) - lu(k,1387) * lu(k,1415) + lu(k,1431) = lu(k,1431) - lu(k,1388) * lu(k,1415) + lu(k,1459) = lu(k,1459) - lu(k,1373) * lu(k,1458) + lu(k,1460) = lu(k,1460) - lu(k,1374) * lu(k,1458) + lu(k,1461) = lu(k,1461) - lu(k,1375) * lu(k,1458) + lu(k,1462) = lu(k,1462) - lu(k,1376) * lu(k,1458) + lu(k,1463) = lu(k,1463) - lu(k,1377) * lu(k,1458) + lu(k,1464) = lu(k,1464) - lu(k,1378) * lu(k,1458) + lu(k,1465) = lu(k,1465) - lu(k,1379) * lu(k,1458) + lu(k,1466) = lu(k,1466) - lu(k,1380) * lu(k,1458) + lu(k,1467) = lu(k,1467) - lu(k,1381) * lu(k,1458) + lu(k,1468) = lu(k,1468) - lu(k,1382) * lu(k,1458) + lu(k,1469) = lu(k,1469) - lu(k,1383) * lu(k,1458) + lu(k,1470) = lu(k,1470) - lu(k,1384) * lu(k,1458) + lu(k,1471) = lu(k,1471) - lu(k,1385) * lu(k,1458) + lu(k,1472) = lu(k,1472) - lu(k,1386) * lu(k,1458) + lu(k,1473) = lu(k,1473) - lu(k,1387) * lu(k,1458) + lu(k,1474) = lu(k,1474) - lu(k,1388) * lu(k,1458) + lu(k,1504) = lu(k,1504) - lu(k,1373) * lu(k,1503) + lu(k,1505) = lu(k,1505) - lu(k,1374) * lu(k,1503) + lu(k,1506) = lu(k,1506) - lu(k,1375) * lu(k,1503) + lu(k,1507) = lu(k,1507) - lu(k,1376) * lu(k,1503) + lu(k,1508) = lu(k,1508) - lu(k,1377) * lu(k,1503) + lu(k,1509) = lu(k,1509) - lu(k,1378) * lu(k,1503) + lu(k,1510) = lu(k,1510) - lu(k,1379) * lu(k,1503) + lu(k,1511) = lu(k,1511) - lu(k,1380) * lu(k,1503) + lu(k,1512) = lu(k,1512) - lu(k,1381) * lu(k,1503) + lu(k,1513) = lu(k,1513) - lu(k,1382) * lu(k,1503) + lu(k,1514) = lu(k,1514) - lu(k,1383) * lu(k,1503) + lu(k,1515) = lu(k,1515) - lu(k,1384) * lu(k,1503) + lu(k,1516) = lu(k,1516) - lu(k,1385) * lu(k,1503) + lu(k,1517) = lu(k,1517) - lu(k,1386) * lu(k,1503) + lu(k,1518) = lu(k,1518) - lu(k,1387) * lu(k,1503) + lu(k,1519) = lu(k,1519) - lu(k,1388) * lu(k,1503) + lu(k,1540) = lu(k,1540) - lu(k,1373) * lu(k,1539) + lu(k,1541) = lu(k,1541) - lu(k,1374) * lu(k,1539) + lu(k,1542) = lu(k,1542) - lu(k,1375) * lu(k,1539) + lu(k,1543) = lu(k,1543) - lu(k,1376) * lu(k,1539) + lu(k,1544) = lu(k,1544) - lu(k,1377) * lu(k,1539) + lu(k,1545) = lu(k,1545) - lu(k,1378) * lu(k,1539) + lu(k,1546) = lu(k,1546) - lu(k,1379) * lu(k,1539) + lu(k,1547) = lu(k,1547) - lu(k,1380) * lu(k,1539) + lu(k,1548) = lu(k,1548) - lu(k,1381) * lu(k,1539) + lu(k,1549) = lu(k,1549) - lu(k,1382) * lu(k,1539) + lu(k,1550) = lu(k,1550) - lu(k,1383) * lu(k,1539) + lu(k,1551) = lu(k,1551) - lu(k,1384) * lu(k,1539) + lu(k,1552) = lu(k,1552) - lu(k,1385) * lu(k,1539) + lu(k,1553) = lu(k,1553) - lu(k,1386) * lu(k,1539) + lu(k,1554) = lu(k,1554) - lu(k,1387) * lu(k,1539) + lu(k,1555) = lu(k,1555) - lu(k,1388) * lu(k,1539) + lu(k,1585) = lu(k,1585) - lu(k,1373) * lu(k,1584) + lu(k,1586) = lu(k,1586) - lu(k,1374) * lu(k,1584) + lu(k,1587) = lu(k,1587) - lu(k,1375) * lu(k,1584) + lu(k,1588) = lu(k,1588) - lu(k,1376) * lu(k,1584) + lu(k,1589) = lu(k,1589) - lu(k,1377) * lu(k,1584) + lu(k,1590) = lu(k,1590) - lu(k,1378) * lu(k,1584) + lu(k,1591) = lu(k,1591) - lu(k,1379) * lu(k,1584) + lu(k,1592) = lu(k,1592) - lu(k,1380) * lu(k,1584) + lu(k,1593) = lu(k,1593) - lu(k,1381) * lu(k,1584) + lu(k,1594) = lu(k,1594) - lu(k,1382) * lu(k,1584) + lu(k,1595) = lu(k,1595) - lu(k,1383) * lu(k,1584) + lu(k,1596) = lu(k,1596) - lu(k,1384) * lu(k,1584) + lu(k,1597) = lu(k,1597) - lu(k,1385) * lu(k,1584) + lu(k,1598) = lu(k,1598) - lu(k,1386) * lu(k,1584) + lu(k,1599) = lu(k,1599) - lu(k,1387) * lu(k,1584) + lu(k,1600) = lu(k,1600) - lu(k,1388) * lu(k,1584) + lu(k,1633) = lu(k,1633) - lu(k,1373) * lu(k,1632) + lu(k,1634) = lu(k,1634) - lu(k,1374) * lu(k,1632) + lu(k,1635) = lu(k,1635) - lu(k,1375) * lu(k,1632) + lu(k,1636) = lu(k,1636) - lu(k,1376) * lu(k,1632) + lu(k,1637) = lu(k,1637) - lu(k,1377) * lu(k,1632) + lu(k,1638) = lu(k,1638) - lu(k,1378) * lu(k,1632) + lu(k,1639) = lu(k,1639) - lu(k,1379) * lu(k,1632) + lu(k,1640) = lu(k,1640) - lu(k,1380) * lu(k,1632) + lu(k,1641) = lu(k,1641) - lu(k,1381) * lu(k,1632) + lu(k,1642) = lu(k,1642) - lu(k,1382) * lu(k,1632) + lu(k,1643) = lu(k,1643) - lu(k,1383) * lu(k,1632) + lu(k,1644) = lu(k,1644) - lu(k,1384) * lu(k,1632) + lu(k,1645) = lu(k,1645) - lu(k,1385) * lu(k,1632) + lu(k,1646) = lu(k,1646) - lu(k,1386) * lu(k,1632) + lu(k,1647) = lu(k,1647) - lu(k,1387) * lu(k,1632) + lu(k,1648) = lu(k,1648) - lu(k,1388) * lu(k,1632) + lu(k,1676) = lu(k,1676) - lu(k,1373) * lu(k,1675) + lu(k,1677) = lu(k,1677) - lu(k,1374) * lu(k,1675) + lu(k,1678) = lu(k,1678) - lu(k,1375) * lu(k,1675) + lu(k,1679) = lu(k,1679) - lu(k,1376) * lu(k,1675) + lu(k,1680) = lu(k,1680) - lu(k,1377) * lu(k,1675) + lu(k,1681) = lu(k,1681) - lu(k,1378) * lu(k,1675) + lu(k,1682) = lu(k,1682) - lu(k,1379) * lu(k,1675) + lu(k,1683) = lu(k,1683) - lu(k,1380) * lu(k,1675) + lu(k,1684) = lu(k,1684) - lu(k,1381) * lu(k,1675) + lu(k,1685) = lu(k,1685) - lu(k,1382) * lu(k,1675) + lu(k,1686) = lu(k,1686) - lu(k,1383) * lu(k,1675) + lu(k,1687) = lu(k,1687) - lu(k,1384) * lu(k,1675) + lu(k,1688) = lu(k,1688) - lu(k,1385) * lu(k,1675) + lu(k,1689) = lu(k,1689) - lu(k,1386) * lu(k,1675) + lu(k,1690) = lu(k,1690) - lu(k,1387) * lu(k,1675) + lu(k,1691) = lu(k,1691) - lu(k,1388) * lu(k,1675) + lu(k,1718) = lu(k,1718) - lu(k,1373) * lu(k,1717) + lu(k,1719) = lu(k,1719) - lu(k,1374) * lu(k,1717) + lu(k,1720) = lu(k,1720) - lu(k,1375) * lu(k,1717) + lu(k,1721) = lu(k,1721) - lu(k,1376) * lu(k,1717) + lu(k,1722) = lu(k,1722) - lu(k,1377) * lu(k,1717) + lu(k,1723) = lu(k,1723) - lu(k,1378) * lu(k,1717) + lu(k,1724) = lu(k,1724) - lu(k,1379) * lu(k,1717) + lu(k,1725) = lu(k,1725) - lu(k,1380) * lu(k,1717) + lu(k,1726) = lu(k,1726) - lu(k,1381) * lu(k,1717) + lu(k,1727) = lu(k,1727) - lu(k,1382) * lu(k,1717) + lu(k,1728) = lu(k,1728) - lu(k,1383) * lu(k,1717) + lu(k,1729) = lu(k,1729) - lu(k,1384) * lu(k,1717) + lu(k,1730) = lu(k,1730) - lu(k,1385) * lu(k,1717) + lu(k,1731) = lu(k,1731) - lu(k,1386) * lu(k,1717) + lu(k,1732) = lu(k,1732) - lu(k,1387) * lu(k,1717) + lu(k,1733) = lu(k,1733) - lu(k,1388) * lu(k,1717) + lu(k,1763) = lu(k,1763) - lu(k,1373) * lu(k,1762) + lu(k,1764) = lu(k,1764) - lu(k,1374) * lu(k,1762) + lu(k,1765) = lu(k,1765) - lu(k,1375) * lu(k,1762) + lu(k,1766) = lu(k,1766) - lu(k,1376) * lu(k,1762) + lu(k,1767) = lu(k,1767) - lu(k,1377) * lu(k,1762) + lu(k,1768) = lu(k,1768) - lu(k,1378) * lu(k,1762) + lu(k,1769) = lu(k,1769) - lu(k,1379) * lu(k,1762) + lu(k,1770) = lu(k,1770) - lu(k,1380) * lu(k,1762) + lu(k,1771) = lu(k,1771) - lu(k,1381) * lu(k,1762) + lu(k,1772) = lu(k,1772) - lu(k,1382) * lu(k,1762) + lu(k,1773) = lu(k,1773) - lu(k,1383) * lu(k,1762) + lu(k,1774) = lu(k,1774) - lu(k,1384) * lu(k,1762) + lu(k,1775) = lu(k,1775) - lu(k,1385) * lu(k,1762) + lu(k,1776) = lu(k,1776) - lu(k,1386) * lu(k,1762) + lu(k,1777) = lu(k,1777) - lu(k,1387) * lu(k,1762) + lu(k,1778) = lu(k,1778) - lu(k,1388) * lu(k,1762) + lu(k,1812) = lu(k,1812) - lu(k,1373) * lu(k,1811) + lu(k,1813) = lu(k,1813) - lu(k,1374) * lu(k,1811) + lu(k,1814) = lu(k,1814) - lu(k,1375) * lu(k,1811) + lu(k,1815) = lu(k,1815) - lu(k,1376) * lu(k,1811) + lu(k,1816) = lu(k,1816) - lu(k,1377) * lu(k,1811) + lu(k,1817) = lu(k,1817) - lu(k,1378) * lu(k,1811) + lu(k,1818) = lu(k,1818) - lu(k,1379) * lu(k,1811) + lu(k,1819) = lu(k,1819) - lu(k,1380) * lu(k,1811) + lu(k,1820) = lu(k,1820) - lu(k,1381) * lu(k,1811) + lu(k,1821) = lu(k,1821) - lu(k,1382) * lu(k,1811) + lu(k,1822) = lu(k,1822) - lu(k,1383) * lu(k,1811) + lu(k,1823) = lu(k,1823) - lu(k,1384) * lu(k,1811) + lu(k,1824) = lu(k,1824) - lu(k,1385) * lu(k,1811) + lu(k,1825) = lu(k,1825) - lu(k,1386) * lu(k,1811) + lu(k,1826) = lu(k,1826) - lu(k,1387) * lu(k,1811) + lu(k,1827) = lu(k,1827) - lu(k,1388) * lu(k,1811) + lu(k,1845) = lu(k,1845) - lu(k,1373) * lu(k,1844) + lu(k,1846) = lu(k,1846) - lu(k,1374) * lu(k,1844) + lu(k,1847) = lu(k,1847) - lu(k,1375) * lu(k,1844) + lu(k,1848) = lu(k,1848) - lu(k,1376) * lu(k,1844) + lu(k,1849) = lu(k,1849) - lu(k,1377) * lu(k,1844) + lu(k,1850) = lu(k,1850) - lu(k,1378) * lu(k,1844) + lu(k,1851) = lu(k,1851) - lu(k,1379) * lu(k,1844) + lu(k,1852) = lu(k,1852) - lu(k,1380) * lu(k,1844) + lu(k,1853) = lu(k,1853) - lu(k,1381) * lu(k,1844) + lu(k,1854) = lu(k,1854) - lu(k,1382) * lu(k,1844) + lu(k,1855) = lu(k,1855) - lu(k,1383) * lu(k,1844) + lu(k,1856) = lu(k,1856) - lu(k,1384) * lu(k,1844) + lu(k,1857) = lu(k,1857) - lu(k,1385) * lu(k,1844) + lu(k,1858) = lu(k,1858) - lu(k,1386) * lu(k,1844) + lu(k,1859) = lu(k,1859) - lu(k,1387) * lu(k,1844) + lu(k,1860) = lu(k,1860) - lu(k,1388) * lu(k,1844) + lu(k,1881) = lu(k,1881) - lu(k,1373) * lu(k,1880) + lu(k,1882) = lu(k,1882) - lu(k,1374) * lu(k,1880) + lu(k,1883) = lu(k,1883) - lu(k,1375) * lu(k,1880) + lu(k,1884) = lu(k,1884) - lu(k,1376) * lu(k,1880) + lu(k,1885) = lu(k,1885) - lu(k,1377) * lu(k,1880) + lu(k,1886) = lu(k,1886) - lu(k,1378) * lu(k,1880) + lu(k,1887) = lu(k,1887) - lu(k,1379) * lu(k,1880) + lu(k,1888) = lu(k,1888) - lu(k,1380) * lu(k,1880) + lu(k,1889) = lu(k,1889) - lu(k,1381) * lu(k,1880) + lu(k,1890) = lu(k,1890) - lu(k,1382) * lu(k,1880) + lu(k,1891) = lu(k,1891) - lu(k,1383) * lu(k,1880) + lu(k,1892) = lu(k,1892) - lu(k,1384) * lu(k,1880) + lu(k,1893) = lu(k,1893) - lu(k,1385) * lu(k,1880) + lu(k,1894) = lu(k,1894) - lu(k,1386) * lu(k,1880) + lu(k,1895) = lu(k,1895) - lu(k,1387) * lu(k,1880) + lu(k,1896) = lu(k,1896) - lu(k,1388) * lu(k,1880) + lu(k,1922) = lu(k,1922) - lu(k,1373) * lu(k,1921) + lu(k,1923) = lu(k,1923) - lu(k,1374) * lu(k,1921) + lu(k,1924) = lu(k,1924) - lu(k,1375) * lu(k,1921) + lu(k,1925) = lu(k,1925) - lu(k,1376) * lu(k,1921) + lu(k,1926) = lu(k,1926) - lu(k,1377) * lu(k,1921) + lu(k,1927) = lu(k,1927) - lu(k,1378) * lu(k,1921) + lu(k,1928) = lu(k,1928) - lu(k,1379) * lu(k,1921) + lu(k,1929) = lu(k,1929) - lu(k,1380) * lu(k,1921) + lu(k,1930) = lu(k,1930) - lu(k,1381) * lu(k,1921) + lu(k,1931) = lu(k,1931) - lu(k,1382) * lu(k,1921) + lu(k,1932) = lu(k,1932) - lu(k,1383) * lu(k,1921) + lu(k,1933) = lu(k,1933) - lu(k,1384) * lu(k,1921) + lu(k,1934) = lu(k,1934) - lu(k,1385) * lu(k,1921) + lu(k,1935) = lu(k,1935) - lu(k,1386) * lu(k,1921) + lu(k,1936) = lu(k,1936) - lu(k,1387) * lu(k,1921) + lu(k,1937) = lu(k,1937) - lu(k,1388) * lu(k,1921) + lu(k,1964) = lu(k,1964) - lu(k,1373) * lu(k,1963) + lu(k,1965) = lu(k,1965) - lu(k,1374) * lu(k,1963) + lu(k,1966) = lu(k,1966) - lu(k,1375) * lu(k,1963) + lu(k,1967) = lu(k,1967) - lu(k,1376) * lu(k,1963) + lu(k,1968) = lu(k,1968) - lu(k,1377) * lu(k,1963) + lu(k,1969) = lu(k,1969) - lu(k,1378) * lu(k,1963) + lu(k,1970) = lu(k,1970) - lu(k,1379) * lu(k,1963) + lu(k,1971) = lu(k,1971) - lu(k,1380) * lu(k,1963) + lu(k,1972) = lu(k,1972) - lu(k,1381) * lu(k,1963) + lu(k,1973) = lu(k,1973) - lu(k,1382) * lu(k,1963) + lu(k,1974) = lu(k,1974) - lu(k,1383) * lu(k,1963) + lu(k,1975) = lu(k,1975) - lu(k,1384) * lu(k,1963) + lu(k,1976) = lu(k,1976) - lu(k,1385) * lu(k,1963) + lu(k,1977) = lu(k,1977) - lu(k,1386) * lu(k,1963) + lu(k,1978) = lu(k,1978) - lu(k,1387) * lu(k,1963) + lu(k,1979) = lu(k,1979) - lu(k,1388) * lu(k,1963) + lu(k,2012) = lu(k,2012) - lu(k,1373) * lu(k,2011) + lu(k,2013) = lu(k,2013) - lu(k,1374) * lu(k,2011) + lu(k,2014) = lu(k,2014) - lu(k,1375) * lu(k,2011) + lu(k,2015) = lu(k,2015) - lu(k,1376) * lu(k,2011) + lu(k,2016) = lu(k,2016) - lu(k,1377) * lu(k,2011) + lu(k,2017) = lu(k,2017) - lu(k,1378) * lu(k,2011) + lu(k,2018) = lu(k,2018) - lu(k,1379) * lu(k,2011) + lu(k,2019) = lu(k,2019) - lu(k,1380) * lu(k,2011) + lu(k,2020) = lu(k,2020) - lu(k,1381) * lu(k,2011) + lu(k,2021) = lu(k,2021) - lu(k,1382) * lu(k,2011) + lu(k,2022) = lu(k,2022) - lu(k,1383) * lu(k,2011) + lu(k,2023) = lu(k,2023) - lu(k,1384) * lu(k,2011) + lu(k,2024) = lu(k,2024) - lu(k,1385) * lu(k,2011) + lu(k,2025) = lu(k,2025) - lu(k,1386) * lu(k,2011) + lu(k,2026) = lu(k,2026) - lu(k,1387) * lu(k,2011) + lu(k,2027) = lu(k,2027) - lu(k,1388) * lu(k,2011) + lu(k,2072) = lu(k,2072) - lu(k,1373) * lu(k,2071) + lu(k,2073) = lu(k,2073) - lu(k,1374) * lu(k,2071) + lu(k,2074) = lu(k,2074) - lu(k,1375) * lu(k,2071) + lu(k,2075) = lu(k,2075) - lu(k,1376) * lu(k,2071) + lu(k,2076) = lu(k,2076) - lu(k,1377) * lu(k,2071) + lu(k,2077) = lu(k,2077) - lu(k,1378) * lu(k,2071) + lu(k,2078) = lu(k,2078) - lu(k,1379) * lu(k,2071) + lu(k,2079) = lu(k,2079) - lu(k,1380) * lu(k,2071) + lu(k,2080) = lu(k,2080) - lu(k,1381) * lu(k,2071) + lu(k,2081) = lu(k,2081) - lu(k,1382) * lu(k,2071) + lu(k,2082) = lu(k,2082) - lu(k,1383) * lu(k,2071) + lu(k,2083) = lu(k,2083) - lu(k,1384) * lu(k,2071) + lu(k,2084) = lu(k,2084) - lu(k,1385) * lu(k,2071) + lu(k,2085) = lu(k,2085) - lu(k,1386) * lu(k,2071) + lu(k,2086) = lu(k,2086) - lu(k,1387) * lu(k,2071) + lu(k,2087) = lu(k,2087) - lu(k,1388) * lu(k,2071) + lu(k,1416) = 1._r8 / lu(k,1416) + lu(k,1417) = lu(k,1417) * lu(k,1416) + lu(k,1418) = lu(k,1418) * lu(k,1416) + lu(k,1419) = lu(k,1419) * lu(k,1416) + lu(k,1420) = lu(k,1420) * lu(k,1416) + lu(k,1421) = lu(k,1421) * lu(k,1416) + lu(k,1422) = lu(k,1422) * lu(k,1416) + lu(k,1423) = lu(k,1423) * lu(k,1416) + lu(k,1424) = lu(k,1424) * lu(k,1416) + lu(k,1425) = lu(k,1425) * lu(k,1416) + lu(k,1426) = lu(k,1426) * lu(k,1416) + lu(k,1427) = lu(k,1427) * lu(k,1416) + lu(k,1428) = lu(k,1428) * lu(k,1416) + lu(k,1429) = lu(k,1429) * lu(k,1416) + lu(k,1430) = lu(k,1430) * lu(k,1416) + lu(k,1431) = lu(k,1431) * lu(k,1416) + lu(k,1460) = lu(k,1460) - lu(k,1417) * lu(k,1459) + lu(k,1461) = lu(k,1461) - lu(k,1418) * lu(k,1459) + lu(k,1462) = lu(k,1462) - lu(k,1419) * lu(k,1459) + lu(k,1463) = lu(k,1463) - lu(k,1420) * lu(k,1459) + lu(k,1464) = lu(k,1464) - lu(k,1421) * lu(k,1459) + lu(k,1465) = lu(k,1465) - lu(k,1422) * lu(k,1459) + lu(k,1466) = lu(k,1466) - lu(k,1423) * lu(k,1459) + lu(k,1467) = lu(k,1467) - lu(k,1424) * lu(k,1459) + lu(k,1468) = lu(k,1468) - lu(k,1425) * lu(k,1459) + lu(k,1469) = lu(k,1469) - lu(k,1426) * lu(k,1459) + lu(k,1470) = lu(k,1470) - lu(k,1427) * lu(k,1459) + lu(k,1471) = lu(k,1471) - lu(k,1428) * lu(k,1459) + lu(k,1472) = lu(k,1472) - lu(k,1429) * lu(k,1459) + lu(k,1473) = lu(k,1473) - lu(k,1430) * lu(k,1459) + lu(k,1474) = lu(k,1474) - lu(k,1431) * lu(k,1459) + lu(k,1505) = lu(k,1505) - lu(k,1417) * lu(k,1504) + lu(k,1506) = lu(k,1506) - lu(k,1418) * lu(k,1504) + lu(k,1507) = lu(k,1507) - lu(k,1419) * lu(k,1504) + lu(k,1508) = lu(k,1508) - lu(k,1420) * lu(k,1504) + lu(k,1509) = lu(k,1509) - lu(k,1421) * lu(k,1504) + lu(k,1510) = lu(k,1510) - lu(k,1422) * lu(k,1504) + lu(k,1511) = lu(k,1511) - lu(k,1423) * lu(k,1504) + lu(k,1512) = lu(k,1512) - lu(k,1424) * lu(k,1504) + lu(k,1513) = lu(k,1513) - lu(k,1425) * lu(k,1504) + lu(k,1514) = lu(k,1514) - lu(k,1426) * lu(k,1504) + lu(k,1515) = lu(k,1515) - lu(k,1427) * lu(k,1504) + lu(k,1516) = lu(k,1516) - lu(k,1428) * lu(k,1504) + lu(k,1517) = lu(k,1517) - lu(k,1429) * lu(k,1504) + lu(k,1518) = lu(k,1518) - lu(k,1430) * lu(k,1504) + lu(k,1519) = lu(k,1519) - lu(k,1431) * lu(k,1504) + lu(k,1541) = lu(k,1541) - lu(k,1417) * lu(k,1540) + lu(k,1542) = lu(k,1542) - lu(k,1418) * lu(k,1540) + lu(k,1543) = lu(k,1543) - lu(k,1419) * lu(k,1540) + lu(k,1544) = lu(k,1544) - lu(k,1420) * lu(k,1540) + lu(k,1545) = lu(k,1545) - lu(k,1421) * lu(k,1540) + lu(k,1546) = lu(k,1546) - lu(k,1422) * lu(k,1540) + lu(k,1547) = lu(k,1547) - lu(k,1423) * lu(k,1540) + lu(k,1548) = lu(k,1548) - lu(k,1424) * lu(k,1540) + lu(k,1549) = lu(k,1549) - lu(k,1425) * lu(k,1540) + lu(k,1550) = lu(k,1550) - lu(k,1426) * lu(k,1540) + lu(k,1551) = lu(k,1551) - lu(k,1427) * lu(k,1540) + lu(k,1552) = lu(k,1552) - lu(k,1428) * lu(k,1540) + lu(k,1553) = lu(k,1553) - lu(k,1429) * lu(k,1540) + lu(k,1554) = lu(k,1554) - lu(k,1430) * lu(k,1540) + lu(k,1555) = lu(k,1555) - lu(k,1431) * lu(k,1540) + lu(k,1586) = lu(k,1586) - lu(k,1417) * lu(k,1585) + lu(k,1587) = lu(k,1587) - lu(k,1418) * lu(k,1585) + lu(k,1588) = lu(k,1588) - lu(k,1419) * lu(k,1585) + lu(k,1589) = lu(k,1589) - lu(k,1420) * lu(k,1585) + lu(k,1590) = lu(k,1590) - lu(k,1421) * lu(k,1585) + lu(k,1591) = lu(k,1591) - lu(k,1422) * lu(k,1585) + lu(k,1592) = lu(k,1592) - lu(k,1423) * lu(k,1585) + lu(k,1593) = lu(k,1593) - lu(k,1424) * lu(k,1585) + lu(k,1594) = lu(k,1594) - lu(k,1425) * lu(k,1585) + lu(k,1595) = lu(k,1595) - lu(k,1426) * lu(k,1585) + lu(k,1596) = lu(k,1596) - lu(k,1427) * lu(k,1585) + lu(k,1597) = lu(k,1597) - lu(k,1428) * lu(k,1585) + lu(k,1598) = lu(k,1598) - lu(k,1429) * lu(k,1585) + lu(k,1599) = lu(k,1599) - lu(k,1430) * lu(k,1585) + lu(k,1600) = lu(k,1600) - lu(k,1431) * lu(k,1585) + lu(k,1634) = lu(k,1634) - lu(k,1417) * lu(k,1633) + lu(k,1635) = lu(k,1635) - lu(k,1418) * lu(k,1633) + lu(k,1636) = lu(k,1636) - lu(k,1419) * lu(k,1633) + lu(k,1637) = lu(k,1637) - lu(k,1420) * lu(k,1633) + lu(k,1638) = lu(k,1638) - lu(k,1421) * lu(k,1633) + lu(k,1639) = lu(k,1639) - lu(k,1422) * lu(k,1633) + lu(k,1640) = lu(k,1640) - lu(k,1423) * lu(k,1633) + lu(k,1641) = lu(k,1641) - lu(k,1424) * lu(k,1633) + lu(k,1642) = lu(k,1642) - lu(k,1425) * lu(k,1633) + lu(k,1643) = lu(k,1643) - lu(k,1426) * lu(k,1633) + lu(k,1644) = lu(k,1644) - lu(k,1427) * lu(k,1633) + lu(k,1645) = lu(k,1645) - lu(k,1428) * lu(k,1633) + lu(k,1646) = lu(k,1646) - lu(k,1429) * lu(k,1633) + lu(k,1647) = lu(k,1647) - lu(k,1430) * lu(k,1633) + lu(k,1648) = lu(k,1648) - lu(k,1431) * lu(k,1633) + lu(k,1677) = lu(k,1677) - lu(k,1417) * lu(k,1676) + lu(k,1678) = lu(k,1678) - lu(k,1418) * lu(k,1676) + lu(k,1679) = lu(k,1679) - lu(k,1419) * lu(k,1676) + lu(k,1680) = lu(k,1680) - lu(k,1420) * lu(k,1676) + lu(k,1681) = lu(k,1681) - lu(k,1421) * lu(k,1676) + lu(k,1682) = lu(k,1682) - lu(k,1422) * lu(k,1676) + lu(k,1683) = lu(k,1683) - lu(k,1423) * lu(k,1676) + lu(k,1684) = lu(k,1684) - lu(k,1424) * lu(k,1676) + lu(k,1685) = lu(k,1685) - lu(k,1425) * lu(k,1676) + lu(k,1686) = lu(k,1686) - lu(k,1426) * lu(k,1676) + lu(k,1687) = lu(k,1687) - lu(k,1427) * lu(k,1676) + lu(k,1688) = lu(k,1688) - lu(k,1428) * lu(k,1676) + lu(k,1689) = lu(k,1689) - lu(k,1429) * lu(k,1676) + lu(k,1690) = lu(k,1690) - lu(k,1430) * lu(k,1676) + lu(k,1691) = lu(k,1691) - lu(k,1431) * lu(k,1676) + lu(k,1719) = lu(k,1719) - lu(k,1417) * lu(k,1718) + lu(k,1720) = lu(k,1720) - lu(k,1418) * lu(k,1718) + lu(k,1721) = lu(k,1721) - lu(k,1419) * lu(k,1718) + lu(k,1722) = lu(k,1722) - lu(k,1420) * lu(k,1718) + lu(k,1723) = lu(k,1723) - lu(k,1421) * lu(k,1718) + lu(k,1724) = lu(k,1724) - lu(k,1422) * lu(k,1718) + lu(k,1725) = lu(k,1725) - lu(k,1423) * lu(k,1718) + lu(k,1726) = lu(k,1726) - lu(k,1424) * lu(k,1718) + lu(k,1727) = lu(k,1727) - lu(k,1425) * lu(k,1718) + lu(k,1728) = lu(k,1728) - lu(k,1426) * lu(k,1718) + lu(k,1729) = lu(k,1729) - lu(k,1427) * lu(k,1718) + lu(k,1730) = lu(k,1730) - lu(k,1428) * lu(k,1718) + lu(k,1731) = lu(k,1731) - lu(k,1429) * lu(k,1718) + lu(k,1732) = lu(k,1732) - lu(k,1430) * lu(k,1718) + lu(k,1733) = lu(k,1733) - lu(k,1431) * lu(k,1718) + lu(k,1764) = lu(k,1764) - lu(k,1417) * lu(k,1763) + lu(k,1765) = lu(k,1765) - lu(k,1418) * lu(k,1763) + lu(k,1766) = lu(k,1766) - lu(k,1419) * lu(k,1763) + lu(k,1767) = lu(k,1767) - lu(k,1420) * lu(k,1763) + lu(k,1768) = lu(k,1768) - lu(k,1421) * lu(k,1763) + lu(k,1769) = lu(k,1769) - lu(k,1422) * lu(k,1763) + lu(k,1770) = lu(k,1770) - lu(k,1423) * lu(k,1763) + lu(k,1771) = lu(k,1771) - lu(k,1424) * lu(k,1763) + lu(k,1772) = lu(k,1772) - lu(k,1425) * lu(k,1763) + lu(k,1773) = lu(k,1773) - lu(k,1426) * lu(k,1763) + lu(k,1774) = lu(k,1774) - lu(k,1427) * lu(k,1763) + lu(k,1775) = lu(k,1775) - lu(k,1428) * lu(k,1763) + lu(k,1776) = lu(k,1776) - lu(k,1429) * lu(k,1763) + lu(k,1777) = lu(k,1777) - lu(k,1430) * lu(k,1763) + lu(k,1778) = lu(k,1778) - lu(k,1431) * lu(k,1763) + lu(k,1813) = lu(k,1813) - lu(k,1417) * lu(k,1812) + lu(k,1814) = lu(k,1814) - lu(k,1418) * lu(k,1812) + lu(k,1815) = lu(k,1815) - lu(k,1419) * lu(k,1812) + lu(k,1816) = lu(k,1816) - lu(k,1420) * lu(k,1812) + lu(k,1817) = lu(k,1817) - lu(k,1421) * lu(k,1812) + lu(k,1818) = lu(k,1818) - lu(k,1422) * lu(k,1812) + lu(k,1819) = lu(k,1819) - lu(k,1423) * lu(k,1812) + lu(k,1820) = lu(k,1820) - lu(k,1424) * lu(k,1812) + lu(k,1821) = lu(k,1821) - lu(k,1425) * lu(k,1812) + lu(k,1822) = lu(k,1822) - lu(k,1426) * lu(k,1812) + lu(k,1823) = lu(k,1823) - lu(k,1427) * lu(k,1812) + lu(k,1824) = lu(k,1824) - lu(k,1428) * lu(k,1812) + lu(k,1825) = lu(k,1825) - lu(k,1429) * lu(k,1812) + lu(k,1826) = lu(k,1826) - lu(k,1430) * lu(k,1812) + lu(k,1827) = lu(k,1827) - lu(k,1431) * lu(k,1812) + lu(k,1846) = lu(k,1846) - lu(k,1417) * lu(k,1845) + lu(k,1847) = lu(k,1847) - lu(k,1418) * lu(k,1845) + lu(k,1848) = lu(k,1848) - lu(k,1419) * lu(k,1845) + lu(k,1849) = lu(k,1849) - lu(k,1420) * lu(k,1845) + lu(k,1850) = lu(k,1850) - lu(k,1421) * lu(k,1845) + lu(k,1851) = lu(k,1851) - lu(k,1422) * lu(k,1845) + lu(k,1852) = lu(k,1852) - lu(k,1423) * lu(k,1845) + lu(k,1853) = lu(k,1853) - lu(k,1424) * lu(k,1845) + lu(k,1854) = lu(k,1854) - lu(k,1425) * lu(k,1845) + lu(k,1855) = lu(k,1855) - lu(k,1426) * lu(k,1845) + lu(k,1856) = lu(k,1856) - lu(k,1427) * lu(k,1845) + lu(k,1857) = lu(k,1857) - lu(k,1428) * lu(k,1845) + lu(k,1858) = lu(k,1858) - lu(k,1429) * lu(k,1845) + lu(k,1859) = lu(k,1859) - lu(k,1430) * lu(k,1845) + lu(k,1860) = lu(k,1860) - lu(k,1431) * lu(k,1845) + lu(k,1882) = lu(k,1882) - lu(k,1417) * lu(k,1881) + lu(k,1883) = lu(k,1883) - lu(k,1418) * lu(k,1881) + lu(k,1884) = lu(k,1884) - lu(k,1419) * lu(k,1881) + lu(k,1885) = lu(k,1885) - lu(k,1420) * lu(k,1881) + lu(k,1886) = lu(k,1886) - lu(k,1421) * lu(k,1881) + lu(k,1887) = lu(k,1887) - lu(k,1422) * lu(k,1881) + lu(k,1888) = lu(k,1888) - lu(k,1423) * lu(k,1881) + lu(k,1889) = lu(k,1889) - lu(k,1424) * lu(k,1881) + lu(k,1890) = lu(k,1890) - lu(k,1425) * lu(k,1881) + lu(k,1891) = lu(k,1891) - lu(k,1426) * lu(k,1881) + lu(k,1892) = lu(k,1892) - lu(k,1427) * lu(k,1881) + lu(k,1893) = lu(k,1893) - lu(k,1428) * lu(k,1881) + lu(k,1894) = lu(k,1894) - lu(k,1429) * lu(k,1881) + lu(k,1895) = lu(k,1895) - lu(k,1430) * lu(k,1881) + lu(k,1896) = lu(k,1896) - lu(k,1431) * lu(k,1881) + lu(k,1923) = lu(k,1923) - lu(k,1417) * lu(k,1922) + lu(k,1924) = lu(k,1924) - lu(k,1418) * lu(k,1922) + lu(k,1925) = lu(k,1925) - lu(k,1419) * lu(k,1922) + lu(k,1926) = lu(k,1926) - lu(k,1420) * lu(k,1922) + lu(k,1927) = lu(k,1927) - lu(k,1421) * lu(k,1922) + lu(k,1928) = lu(k,1928) - lu(k,1422) * lu(k,1922) + lu(k,1929) = lu(k,1929) - lu(k,1423) * lu(k,1922) + lu(k,1930) = lu(k,1930) - lu(k,1424) * lu(k,1922) + lu(k,1931) = lu(k,1931) - lu(k,1425) * lu(k,1922) + lu(k,1932) = lu(k,1932) - lu(k,1426) * lu(k,1922) + lu(k,1933) = lu(k,1933) - lu(k,1427) * lu(k,1922) + lu(k,1934) = lu(k,1934) - lu(k,1428) * lu(k,1922) + lu(k,1935) = lu(k,1935) - lu(k,1429) * lu(k,1922) + lu(k,1936) = lu(k,1936) - lu(k,1430) * lu(k,1922) + lu(k,1937) = lu(k,1937) - lu(k,1431) * lu(k,1922) + lu(k,1965) = lu(k,1965) - lu(k,1417) * lu(k,1964) + lu(k,1966) = lu(k,1966) - lu(k,1418) * lu(k,1964) + lu(k,1967) = lu(k,1967) - lu(k,1419) * lu(k,1964) + lu(k,1968) = lu(k,1968) - lu(k,1420) * lu(k,1964) + lu(k,1969) = lu(k,1969) - lu(k,1421) * lu(k,1964) + lu(k,1970) = lu(k,1970) - lu(k,1422) * lu(k,1964) + lu(k,1971) = lu(k,1971) - lu(k,1423) * lu(k,1964) + lu(k,1972) = lu(k,1972) - lu(k,1424) * lu(k,1964) + lu(k,1973) = lu(k,1973) - lu(k,1425) * lu(k,1964) + lu(k,1974) = lu(k,1974) - lu(k,1426) * lu(k,1964) + lu(k,1975) = lu(k,1975) - lu(k,1427) * lu(k,1964) + lu(k,1976) = lu(k,1976) - lu(k,1428) * lu(k,1964) + lu(k,1977) = lu(k,1977) - lu(k,1429) * lu(k,1964) + lu(k,1978) = lu(k,1978) - lu(k,1430) * lu(k,1964) + lu(k,1979) = lu(k,1979) - lu(k,1431) * lu(k,1964) + lu(k,2013) = lu(k,2013) - lu(k,1417) * lu(k,2012) + lu(k,2014) = lu(k,2014) - lu(k,1418) * lu(k,2012) + lu(k,2015) = lu(k,2015) - lu(k,1419) * lu(k,2012) + lu(k,2016) = lu(k,2016) - lu(k,1420) * lu(k,2012) + lu(k,2017) = lu(k,2017) - lu(k,1421) * lu(k,2012) + lu(k,2018) = lu(k,2018) - lu(k,1422) * lu(k,2012) + lu(k,2019) = lu(k,2019) - lu(k,1423) * lu(k,2012) + lu(k,2020) = lu(k,2020) - lu(k,1424) * lu(k,2012) + lu(k,2021) = lu(k,2021) - lu(k,1425) * lu(k,2012) + lu(k,2022) = lu(k,2022) - lu(k,1426) * lu(k,2012) + lu(k,2023) = lu(k,2023) - lu(k,1427) * lu(k,2012) + lu(k,2024) = lu(k,2024) - lu(k,1428) * lu(k,2012) + lu(k,2025) = lu(k,2025) - lu(k,1429) * lu(k,2012) + lu(k,2026) = lu(k,2026) - lu(k,1430) * lu(k,2012) + lu(k,2027) = lu(k,2027) - lu(k,1431) * lu(k,2012) + lu(k,2073) = lu(k,2073) - lu(k,1417) * lu(k,2072) + lu(k,2074) = lu(k,2074) - lu(k,1418) * lu(k,2072) + lu(k,2075) = lu(k,2075) - lu(k,1419) * lu(k,2072) + lu(k,2076) = lu(k,2076) - lu(k,1420) * lu(k,2072) + lu(k,2077) = lu(k,2077) - lu(k,1421) * lu(k,2072) + lu(k,2078) = lu(k,2078) - lu(k,1422) * lu(k,2072) + lu(k,2079) = lu(k,2079) - lu(k,1423) * lu(k,2072) + lu(k,2080) = lu(k,2080) - lu(k,1424) * lu(k,2072) + lu(k,2081) = lu(k,2081) - lu(k,1425) * lu(k,2072) + lu(k,2082) = lu(k,2082) - lu(k,1426) * lu(k,2072) + lu(k,2083) = lu(k,2083) - lu(k,1427) * lu(k,2072) + lu(k,2084) = lu(k,2084) - lu(k,1428) * lu(k,2072) + lu(k,2085) = lu(k,2085) - lu(k,1429) * lu(k,2072) + lu(k,2086) = lu(k,2086) - lu(k,1430) * lu(k,2072) + lu(k,2087) = lu(k,2087) - lu(k,1431) * lu(k,2072) + lu(k,1460) = 1._r8 / lu(k,1460) + lu(k,1461) = lu(k,1461) * lu(k,1460) + lu(k,1462) = lu(k,1462) * lu(k,1460) + lu(k,1463) = lu(k,1463) * lu(k,1460) + lu(k,1464) = lu(k,1464) * lu(k,1460) + lu(k,1465) = lu(k,1465) * lu(k,1460) + lu(k,1466) = lu(k,1466) * lu(k,1460) + lu(k,1467) = lu(k,1467) * lu(k,1460) + lu(k,1468) = lu(k,1468) * lu(k,1460) + lu(k,1469) = lu(k,1469) * lu(k,1460) + lu(k,1470) = lu(k,1470) * lu(k,1460) + lu(k,1471) = lu(k,1471) * lu(k,1460) + lu(k,1472) = lu(k,1472) * lu(k,1460) + lu(k,1473) = lu(k,1473) * lu(k,1460) + lu(k,1474) = lu(k,1474) * lu(k,1460) + lu(k,1506) = lu(k,1506) - lu(k,1461) * lu(k,1505) + lu(k,1507) = lu(k,1507) - lu(k,1462) * lu(k,1505) + lu(k,1508) = lu(k,1508) - lu(k,1463) * lu(k,1505) + lu(k,1509) = lu(k,1509) - lu(k,1464) * lu(k,1505) + lu(k,1510) = lu(k,1510) - lu(k,1465) * lu(k,1505) + lu(k,1511) = lu(k,1511) - lu(k,1466) * lu(k,1505) + lu(k,1512) = lu(k,1512) - lu(k,1467) * lu(k,1505) + lu(k,1513) = lu(k,1513) - lu(k,1468) * lu(k,1505) + lu(k,1514) = lu(k,1514) - lu(k,1469) * lu(k,1505) + lu(k,1515) = lu(k,1515) - lu(k,1470) * lu(k,1505) + lu(k,1516) = lu(k,1516) - lu(k,1471) * lu(k,1505) + lu(k,1517) = lu(k,1517) - lu(k,1472) * lu(k,1505) + lu(k,1518) = lu(k,1518) - lu(k,1473) * lu(k,1505) + lu(k,1519) = lu(k,1519) - lu(k,1474) * lu(k,1505) + lu(k,1542) = lu(k,1542) - lu(k,1461) * lu(k,1541) + lu(k,1543) = lu(k,1543) - lu(k,1462) * lu(k,1541) + lu(k,1544) = lu(k,1544) - lu(k,1463) * lu(k,1541) + lu(k,1545) = lu(k,1545) - lu(k,1464) * lu(k,1541) + lu(k,1546) = lu(k,1546) - lu(k,1465) * lu(k,1541) + lu(k,1547) = lu(k,1547) - lu(k,1466) * lu(k,1541) + lu(k,1548) = lu(k,1548) - lu(k,1467) * lu(k,1541) + lu(k,1549) = lu(k,1549) - lu(k,1468) * lu(k,1541) + lu(k,1550) = lu(k,1550) - lu(k,1469) * lu(k,1541) + lu(k,1551) = lu(k,1551) - lu(k,1470) * lu(k,1541) + lu(k,1552) = lu(k,1552) - lu(k,1471) * lu(k,1541) + lu(k,1553) = lu(k,1553) - lu(k,1472) * lu(k,1541) + lu(k,1554) = lu(k,1554) - lu(k,1473) * lu(k,1541) + lu(k,1555) = lu(k,1555) - lu(k,1474) * lu(k,1541) + lu(k,1587) = lu(k,1587) - lu(k,1461) * lu(k,1586) + lu(k,1588) = lu(k,1588) - lu(k,1462) * lu(k,1586) + lu(k,1589) = lu(k,1589) - lu(k,1463) * lu(k,1586) + lu(k,1590) = lu(k,1590) - lu(k,1464) * lu(k,1586) + lu(k,1591) = lu(k,1591) - lu(k,1465) * lu(k,1586) + lu(k,1592) = lu(k,1592) - lu(k,1466) * lu(k,1586) + lu(k,1593) = lu(k,1593) - lu(k,1467) * lu(k,1586) + lu(k,1594) = lu(k,1594) - lu(k,1468) * lu(k,1586) + lu(k,1595) = lu(k,1595) - lu(k,1469) * lu(k,1586) + lu(k,1596) = lu(k,1596) - lu(k,1470) * lu(k,1586) + lu(k,1597) = lu(k,1597) - lu(k,1471) * lu(k,1586) + lu(k,1598) = lu(k,1598) - lu(k,1472) * lu(k,1586) + lu(k,1599) = lu(k,1599) - lu(k,1473) * lu(k,1586) + lu(k,1600) = lu(k,1600) - lu(k,1474) * lu(k,1586) + lu(k,1635) = lu(k,1635) - lu(k,1461) * lu(k,1634) + lu(k,1636) = lu(k,1636) - lu(k,1462) * lu(k,1634) + lu(k,1637) = lu(k,1637) - lu(k,1463) * lu(k,1634) + lu(k,1638) = lu(k,1638) - lu(k,1464) * lu(k,1634) + lu(k,1639) = lu(k,1639) - lu(k,1465) * lu(k,1634) + lu(k,1640) = lu(k,1640) - lu(k,1466) * lu(k,1634) + lu(k,1641) = lu(k,1641) - lu(k,1467) * lu(k,1634) + lu(k,1642) = lu(k,1642) - lu(k,1468) * lu(k,1634) + lu(k,1643) = lu(k,1643) - lu(k,1469) * lu(k,1634) + lu(k,1644) = lu(k,1644) - lu(k,1470) * lu(k,1634) + lu(k,1645) = lu(k,1645) - lu(k,1471) * lu(k,1634) + lu(k,1646) = lu(k,1646) - lu(k,1472) * lu(k,1634) + lu(k,1647) = lu(k,1647) - lu(k,1473) * lu(k,1634) + lu(k,1648) = lu(k,1648) - lu(k,1474) * lu(k,1634) + lu(k,1678) = lu(k,1678) - lu(k,1461) * lu(k,1677) + lu(k,1679) = lu(k,1679) - lu(k,1462) * lu(k,1677) + lu(k,1680) = lu(k,1680) - lu(k,1463) * lu(k,1677) + lu(k,1681) = lu(k,1681) - lu(k,1464) * lu(k,1677) + lu(k,1682) = lu(k,1682) - lu(k,1465) * lu(k,1677) + lu(k,1683) = lu(k,1683) - lu(k,1466) * lu(k,1677) + lu(k,1684) = lu(k,1684) - lu(k,1467) * lu(k,1677) + lu(k,1685) = lu(k,1685) - lu(k,1468) * lu(k,1677) + lu(k,1686) = lu(k,1686) - lu(k,1469) * lu(k,1677) + lu(k,1687) = lu(k,1687) - lu(k,1470) * lu(k,1677) + lu(k,1688) = lu(k,1688) - lu(k,1471) * lu(k,1677) + lu(k,1689) = lu(k,1689) - lu(k,1472) * lu(k,1677) + lu(k,1690) = lu(k,1690) - lu(k,1473) * lu(k,1677) + lu(k,1691) = lu(k,1691) - lu(k,1474) * lu(k,1677) + lu(k,1720) = lu(k,1720) - lu(k,1461) * lu(k,1719) + lu(k,1721) = lu(k,1721) - lu(k,1462) * lu(k,1719) + lu(k,1722) = lu(k,1722) - lu(k,1463) * lu(k,1719) + lu(k,1723) = lu(k,1723) - lu(k,1464) * lu(k,1719) + lu(k,1724) = lu(k,1724) - lu(k,1465) * lu(k,1719) + lu(k,1725) = lu(k,1725) - lu(k,1466) * lu(k,1719) + lu(k,1726) = lu(k,1726) - lu(k,1467) * lu(k,1719) + lu(k,1727) = lu(k,1727) - lu(k,1468) * lu(k,1719) + lu(k,1728) = lu(k,1728) - lu(k,1469) * lu(k,1719) + lu(k,1729) = lu(k,1729) - lu(k,1470) * lu(k,1719) + lu(k,1730) = lu(k,1730) - lu(k,1471) * lu(k,1719) + lu(k,1731) = lu(k,1731) - lu(k,1472) * lu(k,1719) + lu(k,1732) = lu(k,1732) - lu(k,1473) * lu(k,1719) + lu(k,1733) = lu(k,1733) - lu(k,1474) * lu(k,1719) + lu(k,1765) = lu(k,1765) - lu(k,1461) * lu(k,1764) + lu(k,1766) = lu(k,1766) - lu(k,1462) * lu(k,1764) + lu(k,1767) = lu(k,1767) - lu(k,1463) * lu(k,1764) + lu(k,1768) = lu(k,1768) - lu(k,1464) * lu(k,1764) + lu(k,1769) = lu(k,1769) - lu(k,1465) * lu(k,1764) + lu(k,1770) = lu(k,1770) - lu(k,1466) * lu(k,1764) + lu(k,1771) = lu(k,1771) - lu(k,1467) * lu(k,1764) + lu(k,1772) = lu(k,1772) - lu(k,1468) * lu(k,1764) + lu(k,1773) = lu(k,1773) - lu(k,1469) * lu(k,1764) + lu(k,1774) = lu(k,1774) - lu(k,1470) * lu(k,1764) + lu(k,1775) = lu(k,1775) - lu(k,1471) * lu(k,1764) + lu(k,1776) = lu(k,1776) - lu(k,1472) * lu(k,1764) + lu(k,1777) = lu(k,1777) - lu(k,1473) * lu(k,1764) + lu(k,1778) = lu(k,1778) - lu(k,1474) * lu(k,1764) + lu(k,1814) = lu(k,1814) - lu(k,1461) * lu(k,1813) + lu(k,1815) = lu(k,1815) - lu(k,1462) * lu(k,1813) + lu(k,1816) = lu(k,1816) - lu(k,1463) * lu(k,1813) + lu(k,1817) = lu(k,1817) - lu(k,1464) * lu(k,1813) + lu(k,1818) = lu(k,1818) - lu(k,1465) * lu(k,1813) + lu(k,1819) = lu(k,1819) - lu(k,1466) * lu(k,1813) + lu(k,1820) = lu(k,1820) - lu(k,1467) * lu(k,1813) + lu(k,1821) = lu(k,1821) - lu(k,1468) * lu(k,1813) + lu(k,1822) = lu(k,1822) - lu(k,1469) * lu(k,1813) + lu(k,1823) = lu(k,1823) - lu(k,1470) * lu(k,1813) + lu(k,1824) = lu(k,1824) - lu(k,1471) * lu(k,1813) + lu(k,1825) = lu(k,1825) - lu(k,1472) * lu(k,1813) + lu(k,1826) = lu(k,1826) - lu(k,1473) * lu(k,1813) + lu(k,1827) = lu(k,1827) - lu(k,1474) * lu(k,1813) + lu(k,1847) = lu(k,1847) - lu(k,1461) * lu(k,1846) + lu(k,1848) = lu(k,1848) - lu(k,1462) * lu(k,1846) + lu(k,1849) = lu(k,1849) - lu(k,1463) * lu(k,1846) + lu(k,1850) = lu(k,1850) - lu(k,1464) * lu(k,1846) + lu(k,1851) = lu(k,1851) - lu(k,1465) * lu(k,1846) + lu(k,1852) = lu(k,1852) - lu(k,1466) * lu(k,1846) + lu(k,1853) = lu(k,1853) - lu(k,1467) * lu(k,1846) + lu(k,1854) = lu(k,1854) - lu(k,1468) * lu(k,1846) + lu(k,1855) = lu(k,1855) - lu(k,1469) * lu(k,1846) + lu(k,1856) = lu(k,1856) - lu(k,1470) * lu(k,1846) + lu(k,1857) = lu(k,1857) - lu(k,1471) * lu(k,1846) + lu(k,1858) = lu(k,1858) - lu(k,1472) * lu(k,1846) + lu(k,1859) = lu(k,1859) - lu(k,1473) * lu(k,1846) + lu(k,1860) = lu(k,1860) - lu(k,1474) * lu(k,1846) + lu(k,1883) = lu(k,1883) - lu(k,1461) * lu(k,1882) + lu(k,1884) = lu(k,1884) - lu(k,1462) * lu(k,1882) + lu(k,1885) = lu(k,1885) - lu(k,1463) * lu(k,1882) + lu(k,1886) = lu(k,1886) - lu(k,1464) * lu(k,1882) + lu(k,1887) = lu(k,1887) - lu(k,1465) * lu(k,1882) + lu(k,1888) = lu(k,1888) - lu(k,1466) * lu(k,1882) + lu(k,1889) = lu(k,1889) - lu(k,1467) * lu(k,1882) + lu(k,1890) = lu(k,1890) - lu(k,1468) * lu(k,1882) + lu(k,1891) = lu(k,1891) - lu(k,1469) * lu(k,1882) + lu(k,1892) = lu(k,1892) - lu(k,1470) * lu(k,1882) + lu(k,1893) = lu(k,1893) - lu(k,1471) * lu(k,1882) + lu(k,1894) = lu(k,1894) - lu(k,1472) * lu(k,1882) + lu(k,1895) = lu(k,1895) - lu(k,1473) * lu(k,1882) + lu(k,1896) = lu(k,1896) - lu(k,1474) * lu(k,1882) + lu(k,1924) = lu(k,1924) - lu(k,1461) * lu(k,1923) + lu(k,1925) = lu(k,1925) - lu(k,1462) * lu(k,1923) + lu(k,1926) = lu(k,1926) - lu(k,1463) * lu(k,1923) + lu(k,1927) = lu(k,1927) - lu(k,1464) * lu(k,1923) + lu(k,1928) = lu(k,1928) - lu(k,1465) * lu(k,1923) + lu(k,1929) = lu(k,1929) - lu(k,1466) * lu(k,1923) + lu(k,1930) = lu(k,1930) - lu(k,1467) * lu(k,1923) + lu(k,1931) = lu(k,1931) - lu(k,1468) * lu(k,1923) + lu(k,1932) = lu(k,1932) - lu(k,1469) * lu(k,1923) + lu(k,1933) = lu(k,1933) - lu(k,1470) * lu(k,1923) + lu(k,1934) = lu(k,1934) - lu(k,1471) * lu(k,1923) + lu(k,1935) = lu(k,1935) - lu(k,1472) * lu(k,1923) + lu(k,1936) = lu(k,1936) - lu(k,1473) * lu(k,1923) + lu(k,1937) = lu(k,1937) - lu(k,1474) * lu(k,1923) + lu(k,1966) = lu(k,1966) - lu(k,1461) * lu(k,1965) + lu(k,1967) = lu(k,1967) - lu(k,1462) * lu(k,1965) + lu(k,1968) = lu(k,1968) - lu(k,1463) * lu(k,1965) + lu(k,1969) = lu(k,1969) - lu(k,1464) * lu(k,1965) + lu(k,1970) = lu(k,1970) - lu(k,1465) * lu(k,1965) + lu(k,1971) = lu(k,1971) - lu(k,1466) * lu(k,1965) + lu(k,1972) = lu(k,1972) - lu(k,1467) * lu(k,1965) + lu(k,1973) = lu(k,1973) - lu(k,1468) * lu(k,1965) + lu(k,1974) = lu(k,1974) - lu(k,1469) * lu(k,1965) + lu(k,1975) = lu(k,1975) - lu(k,1470) * lu(k,1965) + lu(k,1976) = lu(k,1976) - lu(k,1471) * lu(k,1965) + lu(k,1977) = lu(k,1977) - lu(k,1472) * lu(k,1965) + lu(k,1978) = lu(k,1978) - lu(k,1473) * lu(k,1965) + lu(k,1979) = lu(k,1979) - lu(k,1474) * lu(k,1965) + lu(k,2014) = lu(k,2014) - lu(k,1461) * lu(k,2013) + lu(k,2015) = lu(k,2015) - lu(k,1462) * lu(k,2013) + lu(k,2016) = lu(k,2016) - lu(k,1463) * lu(k,2013) + lu(k,2017) = lu(k,2017) - lu(k,1464) * lu(k,2013) + lu(k,2018) = lu(k,2018) - lu(k,1465) * lu(k,2013) + lu(k,2019) = lu(k,2019) - lu(k,1466) * lu(k,2013) + lu(k,2020) = lu(k,2020) - lu(k,1467) * lu(k,2013) + lu(k,2021) = lu(k,2021) - lu(k,1468) * lu(k,2013) + lu(k,2022) = lu(k,2022) - lu(k,1469) * lu(k,2013) + lu(k,2023) = lu(k,2023) - lu(k,1470) * lu(k,2013) + lu(k,2024) = lu(k,2024) - lu(k,1471) * lu(k,2013) + lu(k,2025) = lu(k,2025) - lu(k,1472) * lu(k,2013) + lu(k,2026) = lu(k,2026) - lu(k,1473) * lu(k,2013) + lu(k,2027) = lu(k,2027) - lu(k,1474) * lu(k,2013) + lu(k,2074) = lu(k,2074) - lu(k,1461) * lu(k,2073) + lu(k,2075) = lu(k,2075) - lu(k,1462) * lu(k,2073) + lu(k,2076) = lu(k,2076) - lu(k,1463) * lu(k,2073) + lu(k,2077) = lu(k,2077) - lu(k,1464) * lu(k,2073) + lu(k,2078) = lu(k,2078) - lu(k,1465) * lu(k,2073) + lu(k,2079) = lu(k,2079) - lu(k,1466) * lu(k,2073) + lu(k,2080) = lu(k,2080) - lu(k,1467) * lu(k,2073) + lu(k,2081) = lu(k,2081) - lu(k,1468) * lu(k,2073) + lu(k,2082) = lu(k,2082) - lu(k,1469) * lu(k,2073) + lu(k,2083) = lu(k,2083) - lu(k,1470) * lu(k,2073) + lu(k,2084) = lu(k,2084) - lu(k,1471) * lu(k,2073) + lu(k,2085) = lu(k,2085) - lu(k,1472) * lu(k,2073) + lu(k,2086) = lu(k,2086) - lu(k,1473) * lu(k,2073) + lu(k,2087) = lu(k,2087) - lu(k,1474) * lu(k,2073) + lu(k,1506) = 1._r8 / lu(k,1506) + lu(k,1507) = lu(k,1507) * lu(k,1506) + lu(k,1508) = lu(k,1508) * lu(k,1506) + lu(k,1509) = lu(k,1509) * lu(k,1506) + lu(k,1510) = lu(k,1510) * lu(k,1506) + lu(k,1511) = lu(k,1511) * lu(k,1506) + lu(k,1512) = lu(k,1512) * lu(k,1506) + lu(k,1513) = lu(k,1513) * lu(k,1506) + lu(k,1514) = lu(k,1514) * lu(k,1506) + lu(k,1515) = lu(k,1515) * lu(k,1506) + lu(k,1516) = lu(k,1516) * lu(k,1506) + lu(k,1517) = lu(k,1517) * lu(k,1506) + lu(k,1518) = lu(k,1518) * lu(k,1506) + lu(k,1519) = lu(k,1519) * lu(k,1506) + lu(k,1543) = lu(k,1543) - lu(k,1507) * lu(k,1542) + lu(k,1544) = lu(k,1544) - lu(k,1508) * lu(k,1542) + lu(k,1545) = lu(k,1545) - lu(k,1509) * lu(k,1542) + lu(k,1546) = lu(k,1546) - lu(k,1510) * lu(k,1542) + lu(k,1547) = lu(k,1547) - lu(k,1511) * lu(k,1542) + lu(k,1548) = lu(k,1548) - lu(k,1512) * lu(k,1542) + lu(k,1549) = lu(k,1549) - lu(k,1513) * lu(k,1542) + lu(k,1550) = lu(k,1550) - lu(k,1514) * lu(k,1542) + lu(k,1551) = lu(k,1551) - lu(k,1515) * lu(k,1542) + lu(k,1552) = lu(k,1552) - lu(k,1516) * lu(k,1542) + lu(k,1553) = lu(k,1553) - lu(k,1517) * lu(k,1542) + lu(k,1554) = lu(k,1554) - lu(k,1518) * lu(k,1542) + lu(k,1555) = lu(k,1555) - lu(k,1519) * lu(k,1542) + lu(k,1588) = lu(k,1588) - lu(k,1507) * lu(k,1587) + lu(k,1589) = lu(k,1589) - lu(k,1508) * lu(k,1587) + lu(k,1590) = lu(k,1590) - lu(k,1509) * lu(k,1587) + lu(k,1591) = lu(k,1591) - lu(k,1510) * lu(k,1587) + lu(k,1592) = lu(k,1592) - lu(k,1511) * lu(k,1587) + lu(k,1593) = lu(k,1593) - lu(k,1512) * lu(k,1587) + lu(k,1594) = lu(k,1594) - lu(k,1513) * lu(k,1587) + lu(k,1595) = lu(k,1595) - lu(k,1514) * lu(k,1587) + lu(k,1596) = lu(k,1596) - lu(k,1515) * lu(k,1587) + lu(k,1597) = lu(k,1597) - lu(k,1516) * lu(k,1587) + lu(k,1598) = lu(k,1598) - lu(k,1517) * lu(k,1587) + lu(k,1599) = lu(k,1599) - lu(k,1518) * lu(k,1587) + lu(k,1600) = lu(k,1600) - lu(k,1519) * lu(k,1587) + lu(k,1636) = lu(k,1636) - lu(k,1507) * lu(k,1635) + lu(k,1637) = lu(k,1637) - lu(k,1508) * lu(k,1635) + lu(k,1638) = lu(k,1638) - lu(k,1509) * lu(k,1635) + lu(k,1639) = lu(k,1639) - lu(k,1510) * lu(k,1635) + lu(k,1640) = lu(k,1640) - lu(k,1511) * lu(k,1635) + lu(k,1641) = lu(k,1641) - lu(k,1512) * lu(k,1635) + lu(k,1642) = lu(k,1642) - lu(k,1513) * lu(k,1635) + lu(k,1643) = lu(k,1643) - lu(k,1514) * lu(k,1635) + lu(k,1644) = lu(k,1644) - lu(k,1515) * lu(k,1635) + lu(k,1645) = lu(k,1645) - lu(k,1516) * lu(k,1635) + lu(k,1646) = lu(k,1646) - lu(k,1517) * lu(k,1635) + lu(k,1647) = lu(k,1647) - lu(k,1518) * lu(k,1635) + lu(k,1648) = lu(k,1648) - lu(k,1519) * lu(k,1635) + lu(k,1679) = lu(k,1679) - lu(k,1507) * lu(k,1678) + lu(k,1680) = lu(k,1680) - lu(k,1508) * lu(k,1678) + lu(k,1681) = lu(k,1681) - lu(k,1509) * lu(k,1678) + lu(k,1682) = lu(k,1682) - lu(k,1510) * lu(k,1678) + lu(k,1683) = lu(k,1683) - lu(k,1511) * lu(k,1678) + lu(k,1684) = lu(k,1684) - lu(k,1512) * lu(k,1678) + lu(k,1685) = lu(k,1685) - lu(k,1513) * lu(k,1678) + lu(k,1686) = lu(k,1686) - lu(k,1514) * lu(k,1678) + lu(k,1687) = lu(k,1687) - lu(k,1515) * lu(k,1678) + lu(k,1688) = lu(k,1688) - lu(k,1516) * lu(k,1678) + lu(k,1689) = lu(k,1689) - lu(k,1517) * lu(k,1678) + lu(k,1690) = lu(k,1690) - lu(k,1518) * lu(k,1678) + lu(k,1691) = lu(k,1691) - lu(k,1519) * lu(k,1678) + lu(k,1721) = lu(k,1721) - lu(k,1507) * lu(k,1720) + lu(k,1722) = lu(k,1722) - lu(k,1508) * lu(k,1720) + lu(k,1723) = lu(k,1723) - lu(k,1509) * lu(k,1720) + lu(k,1724) = lu(k,1724) - lu(k,1510) * lu(k,1720) + lu(k,1725) = lu(k,1725) - lu(k,1511) * lu(k,1720) + lu(k,1726) = lu(k,1726) - lu(k,1512) * lu(k,1720) + lu(k,1727) = lu(k,1727) - lu(k,1513) * lu(k,1720) + lu(k,1728) = lu(k,1728) - lu(k,1514) * lu(k,1720) + lu(k,1729) = lu(k,1729) - lu(k,1515) * lu(k,1720) + lu(k,1730) = lu(k,1730) - lu(k,1516) * lu(k,1720) + lu(k,1731) = lu(k,1731) - lu(k,1517) * lu(k,1720) + lu(k,1732) = lu(k,1732) - lu(k,1518) * lu(k,1720) + lu(k,1733) = lu(k,1733) - lu(k,1519) * lu(k,1720) + lu(k,1766) = lu(k,1766) - lu(k,1507) * lu(k,1765) + lu(k,1767) = lu(k,1767) - lu(k,1508) * lu(k,1765) + lu(k,1768) = lu(k,1768) - lu(k,1509) * lu(k,1765) + lu(k,1769) = lu(k,1769) - lu(k,1510) * lu(k,1765) + lu(k,1770) = lu(k,1770) - lu(k,1511) * lu(k,1765) + lu(k,1771) = lu(k,1771) - lu(k,1512) * lu(k,1765) + lu(k,1772) = lu(k,1772) - lu(k,1513) * lu(k,1765) + lu(k,1773) = lu(k,1773) - lu(k,1514) * lu(k,1765) + lu(k,1774) = lu(k,1774) - lu(k,1515) * lu(k,1765) + lu(k,1775) = lu(k,1775) - lu(k,1516) * lu(k,1765) + lu(k,1776) = lu(k,1776) - lu(k,1517) * lu(k,1765) + lu(k,1777) = lu(k,1777) - lu(k,1518) * lu(k,1765) + lu(k,1778) = lu(k,1778) - lu(k,1519) * lu(k,1765) + lu(k,1815) = lu(k,1815) - lu(k,1507) * lu(k,1814) + lu(k,1816) = lu(k,1816) - lu(k,1508) * lu(k,1814) + lu(k,1817) = lu(k,1817) - lu(k,1509) * lu(k,1814) + lu(k,1818) = lu(k,1818) - lu(k,1510) * lu(k,1814) + lu(k,1819) = lu(k,1819) - lu(k,1511) * lu(k,1814) + lu(k,1820) = lu(k,1820) - lu(k,1512) * lu(k,1814) + lu(k,1821) = lu(k,1821) - lu(k,1513) * lu(k,1814) + lu(k,1822) = lu(k,1822) - lu(k,1514) * lu(k,1814) + lu(k,1823) = lu(k,1823) - lu(k,1515) * lu(k,1814) + lu(k,1824) = lu(k,1824) - lu(k,1516) * lu(k,1814) + lu(k,1825) = lu(k,1825) - lu(k,1517) * lu(k,1814) + lu(k,1826) = lu(k,1826) - lu(k,1518) * lu(k,1814) + lu(k,1827) = lu(k,1827) - lu(k,1519) * lu(k,1814) + lu(k,1848) = lu(k,1848) - lu(k,1507) * lu(k,1847) + lu(k,1849) = lu(k,1849) - lu(k,1508) * lu(k,1847) + lu(k,1850) = lu(k,1850) - lu(k,1509) * lu(k,1847) + lu(k,1851) = lu(k,1851) - lu(k,1510) * lu(k,1847) + lu(k,1852) = lu(k,1852) - lu(k,1511) * lu(k,1847) + lu(k,1853) = lu(k,1853) - lu(k,1512) * lu(k,1847) + lu(k,1854) = lu(k,1854) - lu(k,1513) * lu(k,1847) + lu(k,1855) = lu(k,1855) - lu(k,1514) * lu(k,1847) + lu(k,1856) = lu(k,1856) - lu(k,1515) * lu(k,1847) + lu(k,1857) = lu(k,1857) - lu(k,1516) * lu(k,1847) + lu(k,1858) = lu(k,1858) - lu(k,1517) * lu(k,1847) + lu(k,1859) = lu(k,1859) - lu(k,1518) * lu(k,1847) + lu(k,1860) = lu(k,1860) - lu(k,1519) * lu(k,1847) + lu(k,1884) = lu(k,1884) - lu(k,1507) * lu(k,1883) + lu(k,1885) = lu(k,1885) - lu(k,1508) * lu(k,1883) + lu(k,1886) = lu(k,1886) - lu(k,1509) * lu(k,1883) + lu(k,1887) = lu(k,1887) - lu(k,1510) * lu(k,1883) + lu(k,1888) = lu(k,1888) - lu(k,1511) * lu(k,1883) + lu(k,1889) = lu(k,1889) - lu(k,1512) * lu(k,1883) + lu(k,1890) = lu(k,1890) - lu(k,1513) * lu(k,1883) + lu(k,1891) = lu(k,1891) - lu(k,1514) * lu(k,1883) + lu(k,1892) = lu(k,1892) - lu(k,1515) * lu(k,1883) + lu(k,1893) = lu(k,1893) - lu(k,1516) * lu(k,1883) + lu(k,1894) = lu(k,1894) - lu(k,1517) * lu(k,1883) + lu(k,1895) = lu(k,1895) - lu(k,1518) * lu(k,1883) + lu(k,1896) = lu(k,1896) - lu(k,1519) * lu(k,1883) + lu(k,1925) = lu(k,1925) - lu(k,1507) * lu(k,1924) + lu(k,1926) = lu(k,1926) - lu(k,1508) * lu(k,1924) + lu(k,1927) = lu(k,1927) - lu(k,1509) * lu(k,1924) + lu(k,1928) = lu(k,1928) - lu(k,1510) * lu(k,1924) + lu(k,1929) = lu(k,1929) - lu(k,1511) * lu(k,1924) + lu(k,1930) = lu(k,1930) - lu(k,1512) * lu(k,1924) + lu(k,1931) = lu(k,1931) - lu(k,1513) * lu(k,1924) + lu(k,1932) = lu(k,1932) - lu(k,1514) * lu(k,1924) + lu(k,1933) = lu(k,1933) - lu(k,1515) * lu(k,1924) + lu(k,1934) = lu(k,1934) - lu(k,1516) * lu(k,1924) + lu(k,1935) = lu(k,1935) - lu(k,1517) * lu(k,1924) + lu(k,1936) = lu(k,1936) - lu(k,1518) * lu(k,1924) + lu(k,1937) = lu(k,1937) - lu(k,1519) * lu(k,1924) + lu(k,1967) = lu(k,1967) - lu(k,1507) * lu(k,1966) + lu(k,1968) = lu(k,1968) - lu(k,1508) * lu(k,1966) + lu(k,1969) = lu(k,1969) - lu(k,1509) * lu(k,1966) + lu(k,1970) = lu(k,1970) - lu(k,1510) * lu(k,1966) + lu(k,1971) = lu(k,1971) - lu(k,1511) * lu(k,1966) + lu(k,1972) = lu(k,1972) - lu(k,1512) * lu(k,1966) + lu(k,1973) = lu(k,1973) - lu(k,1513) * lu(k,1966) + lu(k,1974) = lu(k,1974) - lu(k,1514) * lu(k,1966) + lu(k,1975) = lu(k,1975) - lu(k,1515) * lu(k,1966) + lu(k,1976) = lu(k,1976) - lu(k,1516) * lu(k,1966) + lu(k,1977) = lu(k,1977) - lu(k,1517) * lu(k,1966) + lu(k,1978) = lu(k,1978) - lu(k,1518) * lu(k,1966) + lu(k,1979) = lu(k,1979) - lu(k,1519) * lu(k,1966) + lu(k,2015) = lu(k,2015) - lu(k,1507) * lu(k,2014) + lu(k,2016) = lu(k,2016) - lu(k,1508) * lu(k,2014) + lu(k,2017) = lu(k,2017) - lu(k,1509) * lu(k,2014) + lu(k,2018) = lu(k,2018) - lu(k,1510) * lu(k,2014) + lu(k,2019) = lu(k,2019) - lu(k,1511) * lu(k,2014) + lu(k,2020) = lu(k,2020) - lu(k,1512) * lu(k,2014) + lu(k,2021) = lu(k,2021) - lu(k,1513) * lu(k,2014) + lu(k,2022) = lu(k,2022) - lu(k,1514) * lu(k,2014) + lu(k,2023) = lu(k,2023) - lu(k,1515) * lu(k,2014) + lu(k,2024) = lu(k,2024) - lu(k,1516) * lu(k,2014) + lu(k,2025) = lu(k,2025) - lu(k,1517) * lu(k,2014) + lu(k,2026) = lu(k,2026) - lu(k,1518) * lu(k,2014) + lu(k,2027) = lu(k,2027) - lu(k,1519) * lu(k,2014) + lu(k,2075) = lu(k,2075) - lu(k,1507) * lu(k,2074) + lu(k,2076) = lu(k,2076) - lu(k,1508) * lu(k,2074) + lu(k,2077) = lu(k,2077) - lu(k,1509) * lu(k,2074) + lu(k,2078) = lu(k,2078) - lu(k,1510) * lu(k,2074) + lu(k,2079) = lu(k,2079) - lu(k,1511) * lu(k,2074) + lu(k,2080) = lu(k,2080) - lu(k,1512) * lu(k,2074) + lu(k,2081) = lu(k,2081) - lu(k,1513) * lu(k,2074) + lu(k,2082) = lu(k,2082) - lu(k,1514) * lu(k,2074) + lu(k,2083) = lu(k,2083) - lu(k,1515) * lu(k,2074) + lu(k,2084) = lu(k,2084) - lu(k,1516) * lu(k,2074) + lu(k,2085) = lu(k,2085) - lu(k,1517) * lu(k,2074) + lu(k,2086) = lu(k,2086) - lu(k,1518) * lu(k,2074) + lu(k,2087) = lu(k,2087) - lu(k,1519) * lu(k,2074) end do - end subroutine lu_fac23 - subroutine lu_fac24( avec_len, lu ) + end subroutine lu_fac24 + subroutine lu_fac25( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 implicit none @@ -12817,53 +13462,765 @@ subroutine lu_fac24( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1673) = 1._r8 / lu(k,1673) - lu(k,1674) = lu(k,1674) * lu(k,1673) - lu(k,1675) = lu(k,1675) * lu(k,1673) - lu(k,1676) = lu(k,1676) * lu(k,1673) - lu(k,1677) = lu(k,1677) * lu(k,1673) - lu(k,1716) = lu(k,1716) - lu(k,1674) * lu(k,1715) - lu(k,1717) = lu(k,1717) - lu(k,1675) * lu(k,1715) - lu(k,1718) = lu(k,1718) - lu(k,1676) * lu(k,1715) - lu(k,1719) = lu(k,1719) - lu(k,1677) * lu(k,1715) - lu(k,1760) = lu(k,1760) - lu(k,1674) * lu(k,1759) - lu(k,1761) = lu(k,1761) - lu(k,1675) * lu(k,1759) - lu(k,1762) = lu(k,1762) - lu(k,1676) * lu(k,1759) - lu(k,1763) = lu(k,1763) - lu(k,1677) * lu(k,1759) - lu(k,1795) = lu(k,1795) - lu(k,1674) * lu(k,1794) - lu(k,1796) = lu(k,1796) - lu(k,1675) * lu(k,1794) - lu(k,1797) = lu(k,1797) - lu(k,1676) * lu(k,1794) - lu(k,1798) = lu(k,1798) - lu(k,1677) * lu(k,1794) - lu(k,1853) = lu(k,1853) - lu(k,1674) * lu(k,1852) - lu(k,1854) = lu(k,1854) - lu(k,1675) * lu(k,1852) - lu(k,1855) = lu(k,1855) - lu(k,1676) * lu(k,1852) - lu(k,1856) = lu(k,1856) - lu(k,1677) * lu(k,1852) - lu(k,1716) = 1._r8 / lu(k,1716) - lu(k,1717) = lu(k,1717) * lu(k,1716) - lu(k,1718) = lu(k,1718) * lu(k,1716) - lu(k,1719) = lu(k,1719) * lu(k,1716) - lu(k,1761) = lu(k,1761) - lu(k,1717) * lu(k,1760) - lu(k,1762) = lu(k,1762) - lu(k,1718) * lu(k,1760) - lu(k,1763) = lu(k,1763) - lu(k,1719) * lu(k,1760) - lu(k,1796) = lu(k,1796) - lu(k,1717) * lu(k,1795) - lu(k,1797) = lu(k,1797) - lu(k,1718) * lu(k,1795) - lu(k,1798) = lu(k,1798) - lu(k,1719) * lu(k,1795) - lu(k,1854) = lu(k,1854) - lu(k,1717) * lu(k,1853) - lu(k,1855) = lu(k,1855) - lu(k,1718) * lu(k,1853) - lu(k,1856) = lu(k,1856) - lu(k,1719) * lu(k,1853) - lu(k,1761) = 1._r8 / lu(k,1761) - lu(k,1762) = lu(k,1762) * lu(k,1761) - lu(k,1763) = lu(k,1763) * lu(k,1761) - lu(k,1797) = lu(k,1797) - lu(k,1762) * lu(k,1796) - lu(k,1798) = lu(k,1798) - lu(k,1763) * lu(k,1796) - lu(k,1855) = lu(k,1855) - lu(k,1762) * lu(k,1854) - lu(k,1856) = lu(k,1856) - lu(k,1763) * lu(k,1854) - lu(k,1797) = 1._r8 / lu(k,1797) - lu(k,1798) = lu(k,1798) * lu(k,1797) - lu(k,1856) = lu(k,1856) - lu(k,1798) * lu(k,1855) - lu(k,1856) = 1._r8 / lu(k,1856) + lu(k,1543) = 1._r8 / lu(k,1543) + lu(k,1544) = lu(k,1544) * lu(k,1543) + lu(k,1545) = lu(k,1545) * lu(k,1543) + lu(k,1546) = lu(k,1546) * lu(k,1543) + lu(k,1547) = lu(k,1547) * lu(k,1543) + lu(k,1548) = lu(k,1548) * lu(k,1543) + lu(k,1549) = lu(k,1549) * lu(k,1543) + lu(k,1550) = lu(k,1550) * lu(k,1543) + lu(k,1551) = lu(k,1551) * lu(k,1543) + lu(k,1552) = lu(k,1552) * lu(k,1543) + lu(k,1553) = lu(k,1553) * lu(k,1543) + lu(k,1554) = lu(k,1554) * lu(k,1543) + lu(k,1555) = lu(k,1555) * lu(k,1543) + lu(k,1589) = lu(k,1589) - lu(k,1544) * lu(k,1588) + lu(k,1590) = lu(k,1590) - lu(k,1545) * lu(k,1588) + lu(k,1591) = lu(k,1591) - lu(k,1546) * lu(k,1588) + lu(k,1592) = lu(k,1592) - lu(k,1547) * lu(k,1588) + lu(k,1593) = lu(k,1593) - lu(k,1548) * lu(k,1588) + lu(k,1594) = lu(k,1594) - lu(k,1549) * lu(k,1588) + lu(k,1595) = lu(k,1595) - lu(k,1550) * lu(k,1588) + lu(k,1596) = lu(k,1596) - lu(k,1551) * lu(k,1588) + lu(k,1597) = lu(k,1597) - lu(k,1552) * lu(k,1588) + lu(k,1598) = lu(k,1598) - lu(k,1553) * lu(k,1588) + lu(k,1599) = lu(k,1599) - lu(k,1554) * lu(k,1588) + lu(k,1600) = lu(k,1600) - lu(k,1555) * lu(k,1588) + lu(k,1637) = lu(k,1637) - lu(k,1544) * lu(k,1636) + lu(k,1638) = lu(k,1638) - lu(k,1545) * lu(k,1636) + lu(k,1639) = lu(k,1639) - lu(k,1546) * lu(k,1636) + lu(k,1640) = lu(k,1640) - lu(k,1547) * lu(k,1636) + lu(k,1641) = lu(k,1641) - lu(k,1548) * lu(k,1636) + lu(k,1642) = lu(k,1642) - lu(k,1549) * lu(k,1636) + lu(k,1643) = lu(k,1643) - lu(k,1550) * lu(k,1636) + lu(k,1644) = lu(k,1644) - lu(k,1551) * lu(k,1636) + lu(k,1645) = lu(k,1645) - lu(k,1552) * lu(k,1636) + lu(k,1646) = lu(k,1646) - lu(k,1553) * lu(k,1636) + lu(k,1647) = lu(k,1647) - lu(k,1554) * lu(k,1636) + lu(k,1648) = lu(k,1648) - lu(k,1555) * lu(k,1636) + lu(k,1680) = lu(k,1680) - lu(k,1544) * lu(k,1679) + lu(k,1681) = lu(k,1681) - lu(k,1545) * lu(k,1679) + lu(k,1682) = lu(k,1682) - lu(k,1546) * lu(k,1679) + lu(k,1683) = lu(k,1683) - lu(k,1547) * lu(k,1679) + lu(k,1684) = lu(k,1684) - lu(k,1548) * lu(k,1679) + lu(k,1685) = lu(k,1685) - lu(k,1549) * lu(k,1679) + lu(k,1686) = lu(k,1686) - lu(k,1550) * lu(k,1679) + lu(k,1687) = lu(k,1687) - lu(k,1551) * lu(k,1679) + lu(k,1688) = lu(k,1688) - lu(k,1552) * lu(k,1679) + lu(k,1689) = lu(k,1689) - lu(k,1553) * lu(k,1679) + lu(k,1690) = lu(k,1690) - lu(k,1554) * lu(k,1679) + lu(k,1691) = lu(k,1691) - lu(k,1555) * lu(k,1679) + lu(k,1722) = lu(k,1722) - lu(k,1544) * lu(k,1721) + lu(k,1723) = lu(k,1723) - lu(k,1545) * lu(k,1721) + lu(k,1724) = lu(k,1724) - lu(k,1546) * lu(k,1721) + lu(k,1725) = lu(k,1725) - lu(k,1547) * lu(k,1721) + lu(k,1726) = lu(k,1726) - lu(k,1548) * lu(k,1721) + lu(k,1727) = lu(k,1727) - lu(k,1549) * lu(k,1721) + lu(k,1728) = lu(k,1728) - lu(k,1550) * lu(k,1721) + lu(k,1729) = lu(k,1729) - lu(k,1551) * lu(k,1721) + lu(k,1730) = lu(k,1730) - lu(k,1552) * lu(k,1721) + lu(k,1731) = lu(k,1731) - lu(k,1553) * lu(k,1721) + lu(k,1732) = lu(k,1732) - lu(k,1554) * lu(k,1721) + lu(k,1733) = lu(k,1733) - lu(k,1555) * lu(k,1721) + lu(k,1767) = lu(k,1767) - lu(k,1544) * lu(k,1766) + lu(k,1768) = lu(k,1768) - lu(k,1545) * lu(k,1766) + lu(k,1769) = lu(k,1769) - lu(k,1546) * lu(k,1766) + lu(k,1770) = lu(k,1770) - lu(k,1547) * lu(k,1766) + lu(k,1771) = lu(k,1771) - lu(k,1548) * lu(k,1766) + lu(k,1772) = lu(k,1772) - lu(k,1549) * lu(k,1766) + lu(k,1773) = lu(k,1773) - lu(k,1550) * lu(k,1766) + lu(k,1774) = lu(k,1774) - lu(k,1551) * lu(k,1766) + lu(k,1775) = lu(k,1775) - lu(k,1552) * lu(k,1766) + lu(k,1776) = lu(k,1776) - lu(k,1553) * lu(k,1766) + lu(k,1777) = lu(k,1777) - lu(k,1554) * lu(k,1766) + lu(k,1778) = lu(k,1778) - lu(k,1555) * lu(k,1766) + lu(k,1816) = lu(k,1816) - lu(k,1544) * lu(k,1815) + lu(k,1817) = lu(k,1817) - lu(k,1545) * lu(k,1815) + lu(k,1818) = lu(k,1818) - lu(k,1546) * lu(k,1815) + lu(k,1819) = lu(k,1819) - lu(k,1547) * lu(k,1815) + lu(k,1820) = lu(k,1820) - lu(k,1548) * lu(k,1815) + lu(k,1821) = lu(k,1821) - lu(k,1549) * lu(k,1815) + lu(k,1822) = lu(k,1822) - lu(k,1550) * lu(k,1815) + lu(k,1823) = lu(k,1823) - lu(k,1551) * lu(k,1815) + lu(k,1824) = lu(k,1824) - lu(k,1552) * lu(k,1815) + lu(k,1825) = lu(k,1825) - lu(k,1553) * lu(k,1815) + lu(k,1826) = lu(k,1826) - lu(k,1554) * lu(k,1815) + lu(k,1827) = lu(k,1827) - lu(k,1555) * lu(k,1815) + lu(k,1849) = lu(k,1849) - lu(k,1544) * lu(k,1848) + lu(k,1850) = lu(k,1850) - lu(k,1545) * lu(k,1848) + lu(k,1851) = lu(k,1851) - lu(k,1546) * lu(k,1848) + lu(k,1852) = lu(k,1852) - lu(k,1547) * lu(k,1848) + lu(k,1853) = lu(k,1853) - lu(k,1548) * lu(k,1848) + lu(k,1854) = lu(k,1854) - lu(k,1549) * lu(k,1848) + lu(k,1855) = lu(k,1855) - lu(k,1550) * lu(k,1848) + lu(k,1856) = lu(k,1856) - lu(k,1551) * lu(k,1848) + lu(k,1857) = lu(k,1857) - lu(k,1552) * lu(k,1848) + lu(k,1858) = lu(k,1858) - lu(k,1553) * lu(k,1848) + lu(k,1859) = lu(k,1859) - lu(k,1554) * lu(k,1848) + lu(k,1860) = lu(k,1860) - lu(k,1555) * lu(k,1848) + lu(k,1885) = lu(k,1885) - lu(k,1544) * lu(k,1884) + lu(k,1886) = lu(k,1886) - lu(k,1545) * lu(k,1884) + lu(k,1887) = lu(k,1887) - lu(k,1546) * lu(k,1884) + lu(k,1888) = lu(k,1888) - lu(k,1547) * lu(k,1884) + lu(k,1889) = lu(k,1889) - lu(k,1548) * lu(k,1884) + lu(k,1890) = lu(k,1890) - lu(k,1549) * lu(k,1884) + lu(k,1891) = lu(k,1891) - lu(k,1550) * lu(k,1884) + lu(k,1892) = lu(k,1892) - lu(k,1551) * lu(k,1884) + lu(k,1893) = lu(k,1893) - lu(k,1552) * lu(k,1884) + lu(k,1894) = lu(k,1894) - lu(k,1553) * lu(k,1884) + lu(k,1895) = lu(k,1895) - lu(k,1554) * lu(k,1884) + lu(k,1896) = lu(k,1896) - lu(k,1555) * lu(k,1884) + lu(k,1926) = lu(k,1926) - lu(k,1544) * lu(k,1925) + lu(k,1927) = lu(k,1927) - lu(k,1545) * lu(k,1925) + lu(k,1928) = lu(k,1928) - lu(k,1546) * lu(k,1925) + lu(k,1929) = lu(k,1929) - lu(k,1547) * lu(k,1925) + lu(k,1930) = lu(k,1930) - lu(k,1548) * lu(k,1925) + lu(k,1931) = lu(k,1931) - lu(k,1549) * lu(k,1925) + lu(k,1932) = lu(k,1932) - lu(k,1550) * lu(k,1925) + lu(k,1933) = lu(k,1933) - lu(k,1551) * lu(k,1925) + lu(k,1934) = lu(k,1934) - lu(k,1552) * lu(k,1925) + lu(k,1935) = lu(k,1935) - lu(k,1553) * lu(k,1925) + lu(k,1936) = lu(k,1936) - lu(k,1554) * lu(k,1925) + lu(k,1937) = lu(k,1937) - lu(k,1555) * lu(k,1925) + lu(k,1968) = lu(k,1968) - lu(k,1544) * lu(k,1967) + lu(k,1969) = lu(k,1969) - lu(k,1545) * lu(k,1967) + lu(k,1970) = lu(k,1970) - lu(k,1546) * lu(k,1967) + lu(k,1971) = lu(k,1971) - lu(k,1547) * lu(k,1967) + lu(k,1972) = lu(k,1972) - lu(k,1548) * lu(k,1967) + lu(k,1973) = lu(k,1973) - lu(k,1549) * lu(k,1967) + lu(k,1974) = lu(k,1974) - lu(k,1550) * lu(k,1967) + lu(k,1975) = lu(k,1975) - lu(k,1551) * lu(k,1967) + lu(k,1976) = lu(k,1976) - lu(k,1552) * lu(k,1967) + lu(k,1977) = lu(k,1977) - lu(k,1553) * lu(k,1967) + lu(k,1978) = lu(k,1978) - lu(k,1554) * lu(k,1967) + lu(k,1979) = lu(k,1979) - lu(k,1555) * lu(k,1967) + lu(k,2016) = lu(k,2016) - lu(k,1544) * lu(k,2015) + lu(k,2017) = lu(k,2017) - lu(k,1545) * lu(k,2015) + lu(k,2018) = lu(k,2018) - lu(k,1546) * lu(k,2015) + lu(k,2019) = lu(k,2019) - lu(k,1547) * lu(k,2015) + lu(k,2020) = lu(k,2020) - lu(k,1548) * lu(k,2015) + lu(k,2021) = lu(k,2021) - lu(k,1549) * lu(k,2015) + lu(k,2022) = lu(k,2022) - lu(k,1550) * lu(k,2015) + lu(k,2023) = lu(k,2023) - lu(k,1551) * lu(k,2015) + lu(k,2024) = lu(k,2024) - lu(k,1552) * lu(k,2015) + lu(k,2025) = lu(k,2025) - lu(k,1553) * lu(k,2015) + lu(k,2026) = lu(k,2026) - lu(k,1554) * lu(k,2015) + lu(k,2027) = lu(k,2027) - lu(k,1555) * lu(k,2015) + lu(k,2076) = lu(k,2076) - lu(k,1544) * lu(k,2075) + lu(k,2077) = lu(k,2077) - lu(k,1545) * lu(k,2075) + lu(k,2078) = lu(k,2078) - lu(k,1546) * lu(k,2075) + lu(k,2079) = lu(k,2079) - lu(k,1547) * lu(k,2075) + lu(k,2080) = lu(k,2080) - lu(k,1548) * lu(k,2075) + lu(k,2081) = lu(k,2081) - lu(k,1549) * lu(k,2075) + lu(k,2082) = lu(k,2082) - lu(k,1550) * lu(k,2075) + lu(k,2083) = lu(k,2083) - lu(k,1551) * lu(k,2075) + lu(k,2084) = lu(k,2084) - lu(k,1552) * lu(k,2075) + lu(k,2085) = lu(k,2085) - lu(k,1553) * lu(k,2075) + lu(k,2086) = lu(k,2086) - lu(k,1554) * lu(k,2075) + lu(k,2087) = lu(k,2087) - lu(k,1555) * lu(k,2075) + lu(k,1589) = 1._r8 / lu(k,1589) + lu(k,1590) = lu(k,1590) * lu(k,1589) + lu(k,1591) = lu(k,1591) * lu(k,1589) + lu(k,1592) = lu(k,1592) * lu(k,1589) + lu(k,1593) = lu(k,1593) * lu(k,1589) + lu(k,1594) = lu(k,1594) * lu(k,1589) + lu(k,1595) = lu(k,1595) * lu(k,1589) + lu(k,1596) = lu(k,1596) * lu(k,1589) + lu(k,1597) = lu(k,1597) * lu(k,1589) + lu(k,1598) = lu(k,1598) * lu(k,1589) + lu(k,1599) = lu(k,1599) * lu(k,1589) + lu(k,1600) = lu(k,1600) * lu(k,1589) + lu(k,1638) = lu(k,1638) - lu(k,1590) * lu(k,1637) + lu(k,1639) = lu(k,1639) - lu(k,1591) * lu(k,1637) + lu(k,1640) = lu(k,1640) - lu(k,1592) * lu(k,1637) + lu(k,1641) = lu(k,1641) - lu(k,1593) * lu(k,1637) + lu(k,1642) = lu(k,1642) - lu(k,1594) * lu(k,1637) + lu(k,1643) = lu(k,1643) - lu(k,1595) * lu(k,1637) + lu(k,1644) = lu(k,1644) - lu(k,1596) * lu(k,1637) + lu(k,1645) = lu(k,1645) - lu(k,1597) * lu(k,1637) + lu(k,1646) = lu(k,1646) - lu(k,1598) * lu(k,1637) + lu(k,1647) = lu(k,1647) - lu(k,1599) * lu(k,1637) + lu(k,1648) = lu(k,1648) - lu(k,1600) * lu(k,1637) + lu(k,1681) = lu(k,1681) - lu(k,1590) * lu(k,1680) + lu(k,1682) = lu(k,1682) - lu(k,1591) * lu(k,1680) + lu(k,1683) = lu(k,1683) - lu(k,1592) * lu(k,1680) + lu(k,1684) = lu(k,1684) - lu(k,1593) * lu(k,1680) + lu(k,1685) = lu(k,1685) - lu(k,1594) * lu(k,1680) + lu(k,1686) = lu(k,1686) - lu(k,1595) * lu(k,1680) + lu(k,1687) = lu(k,1687) - lu(k,1596) * lu(k,1680) + lu(k,1688) = lu(k,1688) - lu(k,1597) * lu(k,1680) + lu(k,1689) = lu(k,1689) - lu(k,1598) * lu(k,1680) + lu(k,1690) = lu(k,1690) - lu(k,1599) * lu(k,1680) + lu(k,1691) = lu(k,1691) - lu(k,1600) * lu(k,1680) + lu(k,1723) = lu(k,1723) - lu(k,1590) * lu(k,1722) + lu(k,1724) = lu(k,1724) - lu(k,1591) * lu(k,1722) + lu(k,1725) = lu(k,1725) - lu(k,1592) * lu(k,1722) + lu(k,1726) = lu(k,1726) - lu(k,1593) * lu(k,1722) + lu(k,1727) = lu(k,1727) - lu(k,1594) * lu(k,1722) + lu(k,1728) = lu(k,1728) - lu(k,1595) * lu(k,1722) + lu(k,1729) = lu(k,1729) - lu(k,1596) * lu(k,1722) + lu(k,1730) = lu(k,1730) - lu(k,1597) * lu(k,1722) + lu(k,1731) = lu(k,1731) - lu(k,1598) * lu(k,1722) + lu(k,1732) = lu(k,1732) - lu(k,1599) * lu(k,1722) + lu(k,1733) = lu(k,1733) - lu(k,1600) * lu(k,1722) + lu(k,1768) = lu(k,1768) - lu(k,1590) * lu(k,1767) + lu(k,1769) = lu(k,1769) - lu(k,1591) * lu(k,1767) + lu(k,1770) = lu(k,1770) - lu(k,1592) * lu(k,1767) + lu(k,1771) = lu(k,1771) - lu(k,1593) * lu(k,1767) + lu(k,1772) = lu(k,1772) - lu(k,1594) * lu(k,1767) + lu(k,1773) = lu(k,1773) - lu(k,1595) * lu(k,1767) + lu(k,1774) = lu(k,1774) - lu(k,1596) * lu(k,1767) + lu(k,1775) = lu(k,1775) - lu(k,1597) * lu(k,1767) + lu(k,1776) = lu(k,1776) - lu(k,1598) * lu(k,1767) + lu(k,1777) = lu(k,1777) - lu(k,1599) * lu(k,1767) + lu(k,1778) = lu(k,1778) - lu(k,1600) * lu(k,1767) + lu(k,1817) = lu(k,1817) - lu(k,1590) * lu(k,1816) + lu(k,1818) = lu(k,1818) - lu(k,1591) * lu(k,1816) + lu(k,1819) = lu(k,1819) - lu(k,1592) * lu(k,1816) + lu(k,1820) = lu(k,1820) - lu(k,1593) * lu(k,1816) + lu(k,1821) = lu(k,1821) - lu(k,1594) * lu(k,1816) + lu(k,1822) = lu(k,1822) - lu(k,1595) * lu(k,1816) + lu(k,1823) = lu(k,1823) - lu(k,1596) * lu(k,1816) + lu(k,1824) = lu(k,1824) - lu(k,1597) * lu(k,1816) + lu(k,1825) = lu(k,1825) - lu(k,1598) * lu(k,1816) + lu(k,1826) = lu(k,1826) - lu(k,1599) * lu(k,1816) + lu(k,1827) = lu(k,1827) - lu(k,1600) * lu(k,1816) + lu(k,1850) = lu(k,1850) - lu(k,1590) * lu(k,1849) + lu(k,1851) = lu(k,1851) - lu(k,1591) * lu(k,1849) + lu(k,1852) = lu(k,1852) - lu(k,1592) * lu(k,1849) + lu(k,1853) = lu(k,1853) - lu(k,1593) * lu(k,1849) + lu(k,1854) = lu(k,1854) - lu(k,1594) * lu(k,1849) + lu(k,1855) = lu(k,1855) - lu(k,1595) * lu(k,1849) + lu(k,1856) = lu(k,1856) - lu(k,1596) * lu(k,1849) + lu(k,1857) = lu(k,1857) - lu(k,1597) * lu(k,1849) + lu(k,1858) = lu(k,1858) - lu(k,1598) * lu(k,1849) + lu(k,1859) = lu(k,1859) - lu(k,1599) * lu(k,1849) + lu(k,1860) = lu(k,1860) - lu(k,1600) * lu(k,1849) + lu(k,1886) = lu(k,1886) - lu(k,1590) * lu(k,1885) + lu(k,1887) = lu(k,1887) - lu(k,1591) * lu(k,1885) + lu(k,1888) = lu(k,1888) - lu(k,1592) * lu(k,1885) + lu(k,1889) = lu(k,1889) - lu(k,1593) * lu(k,1885) + lu(k,1890) = lu(k,1890) - lu(k,1594) * lu(k,1885) + lu(k,1891) = lu(k,1891) - lu(k,1595) * lu(k,1885) + lu(k,1892) = lu(k,1892) - lu(k,1596) * lu(k,1885) + lu(k,1893) = lu(k,1893) - lu(k,1597) * lu(k,1885) + lu(k,1894) = lu(k,1894) - lu(k,1598) * lu(k,1885) + lu(k,1895) = lu(k,1895) - lu(k,1599) * lu(k,1885) + lu(k,1896) = lu(k,1896) - lu(k,1600) * lu(k,1885) + lu(k,1927) = lu(k,1927) - lu(k,1590) * lu(k,1926) + lu(k,1928) = lu(k,1928) - lu(k,1591) * lu(k,1926) + lu(k,1929) = lu(k,1929) - lu(k,1592) * lu(k,1926) + lu(k,1930) = lu(k,1930) - lu(k,1593) * lu(k,1926) + lu(k,1931) = lu(k,1931) - lu(k,1594) * lu(k,1926) + lu(k,1932) = lu(k,1932) - lu(k,1595) * lu(k,1926) + lu(k,1933) = lu(k,1933) - lu(k,1596) * lu(k,1926) + lu(k,1934) = lu(k,1934) - lu(k,1597) * lu(k,1926) + lu(k,1935) = lu(k,1935) - lu(k,1598) * lu(k,1926) + lu(k,1936) = lu(k,1936) - lu(k,1599) * lu(k,1926) + lu(k,1937) = lu(k,1937) - lu(k,1600) * lu(k,1926) + lu(k,1969) = lu(k,1969) - lu(k,1590) * lu(k,1968) + lu(k,1970) = lu(k,1970) - lu(k,1591) * lu(k,1968) + lu(k,1971) = lu(k,1971) - lu(k,1592) * lu(k,1968) + lu(k,1972) = lu(k,1972) - lu(k,1593) * lu(k,1968) + lu(k,1973) = lu(k,1973) - lu(k,1594) * lu(k,1968) + lu(k,1974) = lu(k,1974) - lu(k,1595) * lu(k,1968) + lu(k,1975) = lu(k,1975) - lu(k,1596) * lu(k,1968) + lu(k,1976) = lu(k,1976) - lu(k,1597) * lu(k,1968) + lu(k,1977) = lu(k,1977) - lu(k,1598) * lu(k,1968) + lu(k,1978) = lu(k,1978) - lu(k,1599) * lu(k,1968) + lu(k,1979) = lu(k,1979) - lu(k,1600) * lu(k,1968) + lu(k,2017) = lu(k,2017) - lu(k,1590) * lu(k,2016) + lu(k,2018) = lu(k,2018) - lu(k,1591) * lu(k,2016) + lu(k,2019) = lu(k,2019) - lu(k,1592) * lu(k,2016) + lu(k,2020) = lu(k,2020) - lu(k,1593) * lu(k,2016) + lu(k,2021) = lu(k,2021) - lu(k,1594) * lu(k,2016) + lu(k,2022) = lu(k,2022) - lu(k,1595) * lu(k,2016) + lu(k,2023) = lu(k,2023) - lu(k,1596) * lu(k,2016) + lu(k,2024) = lu(k,2024) - lu(k,1597) * lu(k,2016) + lu(k,2025) = lu(k,2025) - lu(k,1598) * lu(k,2016) + lu(k,2026) = lu(k,2026) - lu(k,1599) * lu(k,2016) + lu(k,2027) = lu(k,2027) - lu(k,1600) * lu(k,2016) + lu(k,2077) = lu(k,2077) - lu(k,1590) * lu(k,2076) + lu(k,2078) = lu(k,2078) - lu(k,1591) * lu(k,2076) + lu(k,2079) = lu(k,2079) - lu(k,1592) * lu(k,2076) + lu(k,2080) = lu(k,2080) - lu(k,1593) * lu(k,2076) + lu(k,2081) = lu(k,2081) - lu(k,1594) * lu(k,2076) + lu(k,2082) = lu(k,2082) - lu(k,1595) * lu(k,2076) + lu(k,2083) = lu(k,2083) - lu(k,1596) * lu(k,2076) + lu(k,2084) = lu(k,2084) - lu(k,1597) * lu(k,2076) + lu(k,2085) = lu(k,2085) - lu(k,1598) * lu(k,2076) + lu(k,2086) = lu(k,2086) - lu(k,1599) * lu(k,2076) + lu(k,2087) = lu(k,2087) - lu(k,1600) * lu(k,2076) + lu(k,1638) = 1._r8 / lu(k,1638) + lu(k,1639) = lu(k,1639) * lu(k,1638) + lu(k,1640) = lu(k,1640) * lu(k,1638) + lu(k,1641) = lu(k,1641) * lu(k,1638) + lu(k,1642) = lu(k,1642) * lu(k,1638) + lu(k,1643) = lu(k,1643) * lu(k,1638) + lu(k,1644) = lu(k,1644) * lu(k,1638) + lu(k,1645) = lu(k,1645) * lu(k,1638) + lu(k,1646) = lu(k,1646) * lu(k,1638) + lu(k,1647) = lu(k,1647) * lu(k,1638) + lu(k,1648) = lu(k,1648) * lu(k,1638) + lu(k,1682) = lu(k,1682) - lu(k,1639) * lu(k,1681) + lu(k,1683) = lu(k,1683) - lu(k,1640) * lu(k,1681) + lu(k,1684) = lu(k,1684) - lu(k,1641) * lu(k,1681) + lu(k,1685) = lu(k,1685) - lu(k,1642) * lu(k,1681) + lu(k,1686) = lu(k,1686) - lu(k,1643) * lu(k,1681) + lu(k,1687) = lu(k,1687) - lu(k,1644) * lu(k,1681) + lu(k,1688) = lu(k,1688) - lu(k,1645) * lu(k,1681) + lu(k,1689) = lu(k,1689) - lu(k,1646) * lu(k,1681) + lu(k,1690) = lu(k,1690) - lu(k,1647) * lu(k,1681) + lu(k,1691) = lu(k,1691) - lu(k,1648) * lu(k,1681) + lu(k,1724) = lu(k,1724) - lu(k,1639) * lu(k,1723) + lu(k,1725) = lu(k,1725) - lu(k,1640) * lu(k,1723) + lu(k,1726) = lu(k,1726) - lu(k,1641) * lu(k,1723) + lu(k,1727) = lu(k,1727) - lu(k,1642) * lu(k,1723) + lu(k,1728) = lu(k,1728) - lu(k,1643) * lu(k,1723) + lu(k,1729) = lu(k,1729) - lu(k,1644) * lu(k,1723) + lu(k,1730) = lu(k,1730) - lu(k,1645) * lu(k,1723) + lu(k,1731) = lu(k,1731) - lu(k,1646) * lu(k,1723) + lu(k,1732) = lu(k,1732) - lu(k,1647) * lu(k,1723) + lu(k,1733) = lu(k,1733) - lu(k,1648) * lu(k,1723) + lu(k,1769) = lu(k,1769) - lu(k,1639) * lu(k,1768) + lu(k,1770) = lu(k,1770) - lu(k,1640) * lu(k,1768) + lu(k,1771) = lu(k,1771) - lu(k,1641) * lu(k,1768) + lu(k,1772) = lu(k,1772) - lu(k,1642) * lu(k,1768) + lu(k,1773) = lu(k,1773) - lu(k,1643) * lu(k,1768) + lu(k,1774) = lu(k,1774) - lu(k,1644) * lu(k,1768) + lu(k,1775) = lu(k,1775) - lu(k,1645) * lu(k,1768) + lu(k,1776) = lu(k,1776) - lu(k,1646) * lu(k,1768) + lu(k,1777) = lu(k,1777) - lu(k,1647) * lu(k,1768) + lu(k,1778) = lu(k,1778) - lu(k,1648) * lu(k,1768) + lu(k,1818) = lu(k,1818) - lu(k,1639) * lu(k,1817) + lu(k,1819) = lu(k,1819) - lu(k,1640) * lu(k,1817) + lu(k,1820) = lu(k,1820) - lu(k,1641) * lu(k,1817) + lu(k,1821) = lu(k,1821) - lu(k,1642) * lu(k,1817) + lu(k,1822) = lu(k,1822) - lu(k,1643) * lu(k,1817) + lu(k,1823) = lu(k,1823) - lu(k,1644) * lu(k,1817) + lu(k,1824) = lu(k,1824) - lu(k,1645) * lu(k,1817) + lu(k,1825) = lu(k,1825) - lu(k,1646) * lu(k,1817) + lu(k,1826) = lu(k,1826) - lu(k,1647) * lu(k,1817) + lu(k,1827) = lu(k,1827) - lu(k,1648) * lu(k,1817) + lu(k,1851) = lu(k,1851) - lu(k,1639) * lu(k,1850) + lu(k,1852) = lu(k,1852) - lu(k,1640) * lu(k,1850) + lu(k,1853) = lu(k,1853) - lu(k,1641) * lu(k,1850) + lu(k,1854) = lu(k,1854) - lu(k,1642) * lu(k,1850) + lu(k,1855) = lu(k,1855) - lu(k,1643) * lu(k,1850) + lu(k,1856) = lu(k,1856) - lu(k,1644) * lu(k,1850) + lu(k,1857) = lu(k,1857) - lu(k,1645) * lu(k,1850) + lu(k,1858) = lu(k,1858) - lu(k,1646) * lu(k,1850) + lu(k,1859) = lu(k,1859) - lu(k,1647) * lu(k,1850) + lu(k,1860) = lu(k,1860) - lu(k,1648) * lu(k,1850) + lu(k,1887) = lu(k,1887) - lu(k,1639) * lu(k,1886) + lu(k,1888) = lu(k,1888) - lu(k,1640) * lu(k,1886) + lu(k,1889) = lu(k,1889) - lu(k,1641) * lu(k,1886) + lu(k,1890) = lu(k,1890) - lu(k,1642) * lu(k,1886) + lu(k,1891) = lu(k,1891) - lu(k,1643) * lu(k,1886) + lu(k,1892) = lu(k,1892) - lu(k,1644) * lu(k,1886) + lu(k,1893) = lu(k,1893) - lu(k,1645) * lu(k,1886) + lu(k,1894) = lu(k,1894) - lu(k,1646) * lu(k,1886) + lu(k,1895) = lu(k,1895) - lu(k,1647) * lu(k,1886) + lu(k,1896) = lu(k,1896) - lu(k,1648) * lu(k,1886) + lu(k,1928) = lu(k,1928) - lu(k,1639) * lu(k,1927) + lu(k,1929) = lu(k,1929) - lu(k,1640) * lu(k,1927) + lu(k,1930) = lu(k,1930) - lu(k,1641) * lu(k,1927) + lu(k,1931) = lu(k,1931) - lu(k,1642) * lu(k,1927) + lu(k,1932) = lu(k,1932) - lu(k,1643) * lu(k,1927) + lu(k,1933) = lu(k,1933) - lu(k,1644) * lu(k,1927) + lu(k,1934) = lu(k,1934) - lu(k,1645) * lu(k,1927) + lu(k,1935) = lu(k,1935) - lu(k,1646) * lu(k,1927) + lu(k,1936) = lu(k,1936) - lu(k,1647) * lu(k,1927) + lu(k,1937) = lu(k,1937) - lu(k,1648) * lu(k,1927) + lu(k,1970) = lu(k,1970) - lu(k,1639) * lu(k,1969) + lu(k,1971) = lu(k,1971) - lu(k,1640) * lu(k,1969) + lu(k,1972) = lu(k,1972) - lu(k,1641) * lu(k,1969) + lu(k,1973) = lu(k,1973) - lu(k,1642) * lu(k,1969) + lu(k,1974) = lu(k,1974) - lu(k,1643) * lu(k,1969) + lu(k,1975) = lu(k,1975) - lu(k,1644) * lu(k,1969) + lu(k,1976) = lu(k,1976) - lu(k,1645) * lu(k,1969) + lu(k,1977) = lu(k,1977) - lu(k,1646) * lu(k,1969) + lu(k,1978) = lu(k,1978) - lu(k,1647) * lu(k,1969) + lu(k,1979) = lu(k,1979) - lu(k,1648) * lu(k,1969) + lu(k,2018) = lu(k,2018) - lu(k,1639) * lu(k,2017) + lu(k,2019) = lu(k,2019) - lu(k,1640) * lu(k,2017) + lu(k,2020) = lu(k,2020) - lu(k,1641) * lu(k,2017) + lu(k,2021) = lu(k,2021) - lu(k,1642) * lu(k,2017) + lu(k,2022) = lu(k,2022) - lu(k,1643) * lu(k,2017) + lu(k,2023) = lu(k,2023) - lu(k,1644) * lu(k,2017) + lu(k,2024) = lu(k,2024) - lu(k,1645) * lu(k,2017) + lu(k,2025) = lu(k,2025) - lu(k,1646) * lu(k,2017) + lu(k,2026) = lu(k,2026) - lu(k,1647) * lu(k,2017) + lu(k,2027) = lu(k,2027) - lu(k,1648) * lu(k,2017) + lu(k,2078) = lu(k,2078) - lu(k,1639) * lu(k,2077) + lu(k,2079) = lu(k,2079) - lu(k,1640) * lu(k,2077) + lu(k,2080) = lu(k,2080) - lu(k,1641) * lu(k,2077) + lu(k,2081) = lu(k,2081) - lu(k,1642) * lu(k,2077) + lu(k,2082) = lu(k,2082) - lu(k,1643) * lu(k,2077) + lu(k,2083) = lu(k,2083) - lu(k,1644) * lu(k,2077) + lu(k,2084) = lu(k,2084) - lu(k,1645) * lu(k,2077) + lu(k,2085) = lu(k,2085) - lu(k,1646) * lu(k,2077) + lu(k,2086) = lu(k,2086) - lu(k,1647) * lu(k,2077) + lu(k,2087) = lu(k,2087) - lu(k,1648) * lu(k,2077) + lu(k,1682) = 1._r8 / lu(k,1682) + lu(k,1683) = lu(k,1683) * lu(k,1682) + lu(k,1684) = lu(k,1684) * lu(k,1682) + lu(k,1685) = lu(k,1685) * lu(k,1682) + lu(k,1686) = lu(k,1686) * lu(k,1682) + lu(k,1687) = lu(k,1687) * lu(k,1682) + lu(k,1688) = lu(k,1688) * lu(k,1682) + lu(k,1689) = lu(k,1689) * lu(k,1682) + lu(k,1690) = lu(k,1690) * lu(k,1682) + lu(k,1691) = lu(k,1691) * lu(k,1682) + lu(k,1725) = lu(k,1725) - lu(k,1683) * lu(k,1724) + lu(k,1726) = lu(k,1726) - lu(k,1684) * lu(k,1724) + lu(k,1727) = lu(k,1727) - lu(k,1685) * lu(k,1724) + lu(k,1728) = lu(k,1728) - lu(k,1686) * lu(k,1724) + lu(k,1729) = lu(k,1729) - lu(k,1687) * lu(k,1724) + lu(k,1730) = lu(k,1730) - lu(k,1688) * lu(k,1724) + lu(k,1731) = lu(k,1731) - lu(k,1689) * lu(k,1724) + lu(k,1732) = lu(k,1732) - lu(k,1690) * lu(k,1724) + lu(k,1733) = lu(k,1733) - lu(k,1691) * lu(k,1724) + lu(k,1770) = lu(k,1770) - lu(k,1683) * lu(k,1769) + lu(k,1771) = lu(k,1771) - lu(k,1684) * lu(k,1769) + lu(k,1772) = lu(k,1772) - lu(k,1685) * lu(k,1769) + lu(k,1773) = lu(k,1773) - lu(k,1686) * lu(k,1769) + lu(k,1774) = lu(k,1774) - lu(k,1687) * lu(k,1769) + lu(k,1775) = lu(k,1775) - lu(k,1688) * lu(k,1769) + lu(k,1776) = lu(k,1776) - lu(k,1689) * lu(k,1769) + lu(k,1777) = lu(k,1777) - lu(k,1690) * lu(k,1769) + lu(k,1778) = lu(k,1778) - lu(k,1691) * lu(k,1769) + lu(k,1819) = lu(k,1819) - lu(k,1683) * lu(k,1818) + lu(k,1820) = lu(k,1820) - lu(k,1684) * lu(k,1818) + lu(k,1821) = lu(k,1821) - lu(k,1685) * lu(k,1818) + lu(k,1822) = lu(k,1822) - lu(k,1686) * lu(k,1818) + lu(k,1823) = lu(k,1823) - lu(k,1687) * lu(k,1818) + lu(k,1824) = lu(k,1824) - lu(k,1688) * lu(k,1818) + lu(k,1825) = lu(k,1825) - lu(k,1689) * lu(k,1818) + lu(k,1826) = lu(k,1826) - lu(k,1690) * lu(k,1818) + lu(k,1827) = lu(k,1827) - lu(k,1691) * lu(k,1818) + lu(k,1852) = lu(k,1852) - lu(k,1683) * lu(k,1851) + lu(k,1853) = lu(k,1853) - lu(k,1684) * lu(k,1851) + lu(k,1854) = lu(k,1854) - lu(k,1685) * lu(k,1851) + lu(k,1855) = lu(k,1855) - lu(k,1686) * lu(k,1851) + lu(k,1856) = lu(k,1856) - lu(k,1687) * lu(k,1851) + lu(k,1857) = lu(k,1857) - lu(k,1688) * lu(k,1851) + lu(k,1858) = lu(k,1858) - lu(k,1689) * lu(k,1851) + lu(k,1859) = lu(k,1859) - lu(k,1690) * lu(k,1851) + lu(k,1860) = lu(k,1860) - lu(k,1691) * lu(k,1851) + lu(k,1888) = lu(k,1888) - lu(k,1683) * lu(k,1887) + lu(k,1889) = lu(k,1889) - lu(k,1684) * lu(k,1887) + lu(k,1890) = lu(k,1890) - lu(k,1685) * lu(k,1887) + lu(k,1891) = lu(k,1891) - lu(k,1686) * lu(k,1887) + lu(k,1892) = lu(k,1892) - lu(k,1687) * lu(k,1887) + lu(k,1893) = lu(k,1893) - lu(k,1688) * lu(k,1887) + lu(k,1894) = lu(k,1894) - lu(k,1689) * lu(k,1887) + lu(k,1895) = lu(k,1895) - lu(k,1690) * lu(k,1887) + lu(k,1896) = lu(k,1896) - lu(k,1691) * lu(k,1887) + lu(k,1929) = lu(k,1929) - lu(k,1683) * lu(k,1928) + lu(k,1930) = lu(k,1930) - lu(k,1684) * lu(k,1928) + lu(k,1931) = lu(k,1931) - lu(k,1685) * lu(k,1928) + lu(k,1932) = lu(k,1932) - lu(k,1686) * lu(k,1928) + lu(k,1933) = lu(k,1933) - lu(k,1687) * lu(k,1928) + lu(k,1934) = lu(k,1934) - lu(k,1688) * lu(k,1928) + lu(k,1935) = lu(k,1935) - lu(k,1689) * lu(k,1928) + lu(k,1936) = lu(k,1936) - lu(k,1690) * lu(k,1928) + lu(k,1937) = lu(k,1937) - lu(k,1691) * lu(k,1928) + lu(k,1971) = lu(k,1971) - lu(k,1683) * lu(k,1970) + lu(k,1972) = lu(k,1972) - lu(k,1684) * lu(k,1970) + lu(k,1973) = lu(k,1973) - lu(k,1685) * lu(k,1970) + lu(k,1974) = lu(k,1974) - lu(k,1686) * lu(k,1970) + lu(k,1975) = lu(k,1975) - lu(k,1687) * lu(k,1970) + lu(k,1976) = lu(k,1976) - lu(k,1688) * lu(k,1970) + lu(k,1977) = lu(k,1977) - lu(k,1689) * lu(k,1970) + lu(k,1978) = lu(k,1978) - lu(k,1690) * lu(k,1970) + lu(k,1979) = lu(k,1979) - lu(k,1691) * lu(k,1970) + lu(k,2019) = lu(k,2019) - lu(k,1683) * lu(k,2018) + lu(k,2020) = lu(k,2020) - lu(k,1684) * lu(k,2018) + lu(k,2021) = lu(k,2021) - lu(k,1685) * lu(k,2018) + lu(k,2022) = lu(k,2022) - lu(k,1686) * lu(k,2018) + lu(k,2023) = lu(k,2023) - lu(k,1687) * lu(k,2018) + lu(k,2024) = lu(k,2024) - lu(k,1688) * lu(k,2018) + lu(k,2025) = lu(k,2025) - lu(k,1689) * lu(k,2018) + lu(k,2026) = lu(k,2026) - lu(k,1690) * lu(k,2018) + lu(k,2027) = lu(k,2027) - lu(k,1691) * lu(k,2018) + lu(k,2079) = lu(k,2079) - lu(k,1683) * lu(k,2078) + lu(k,2080) = lu(k,2080) - lu(k,1684) * lu(k,2078) + lu(k,2081) = lu(k,2081) - lu(k,1685) * lu(k,2078) + lu(k,2082) = lu(k,2082) - lu(k,1686) * lu(k,2078) + lu(k,2083) = lu(k,2083) - lu(k,1687) * lu(k,2078) + lu(k,2084) = lu(k,2084) - lu(k,1688) * lu(k,2078) + lu(k,2085) = lu(k,2085) - lu(k,1689) * lu(k,2078) + lu(k,2086) = lu(k,2086) - lu(k,1690) * lu(k,2078) + lu(k,2087) = lu(k,2087) - lu(k,1691) * lu(k,2078) + lu(k,1725) = 1._r8 / lu(k,1725) + lu(k,1726) = lu(k,1726) * lu(k,1725) + lu(k,1727) = lu(k,1727) * lu(k,1725) + lu(k,1728) = lu(k,1728) * lu(k,1725) + lu(k,1729) = lu(k,1729) * lu(k,1725) + lu(k,1730) = lu(k,1730) * lu(k,1725) + lu(k,1731) = lu(k,1731) * lu(k,1725) + lu(k,1732) = lu(k,1732) * lu(k,1725) + lu(k,1733) = lu(k,1733) * lu(k,1725) + lu(k,1771) = lu(k,1771) - lu(k,1726) * lu(k,1770) + lu(k,1772) = lu(k,1772) - lu(k,1727) * lu(k,1770) + lu(k,1773) = lu(k,1773) - lu(k,1728) * lu(k,1770) + lu(k,1774) = lu(k,1774) - lu(k,1729) * lu(k,1770) + lu(k,1775) = lu(k,1775) - lu(k,1730) * lu(k,1770) + lu(k,1776) = lu(k,1776) - lu(k,1731) * lu(k,1770) + lu(k,1777) = lu(k,1777) - lu(k,1732) * lu(k,1770) + lu(k,1778) = lu(k,1778) - lu(k,1733) * lu(k,1770) + lu(k,1820) = lu(k,1820) - lu(k,1726) * lu(k,1819) + lu(k,1821) = lu(k,1821) - lu(k,1727) * lu(k,1819) + lu(k,1822) = lu(k,1822) - lu(k,1728) * lu(k,1819) + lu(k,1823) = lu(k,1823) - lu(k,1729) * lu(k,1819) + lu(k,1824) = lu(k,1824) - lu(k,1730) * lu(k,1819) + lu(k,1825) = lu(k,1825) - lu(k,1731) * lu(k,1819) + lu(k,1826) = lu(k,1826) - lu(k,1732) * lu(k,1819) + lu(k,1827) = lu(k,1827) - lu(k,1733) * lu(k,1819) + lu(k,1853) = lu(k,1853) - lu(k,1726) * lu(k,1852) + lu(k,1854) = lu(k,1854) - lu(k,1727) * lu(k,1852) + lu(k,1855) = lu(k,1855) - lu(k,1728) * lu(k,1852) + lu(k,1856) = lu(k,1856) - lu(k,1729) * lu(k,1852) + lu(k,1857) = lu(k,1857) - lu(k,1730) * lu(k,1852) + lu(k,1858) = lu(k,1858) - lu(k,1731) * lu(k,1852) + lu(k,1859) = lu(k,1859) - lu(k,1732) * lu(k,1852) + lu(k,1860) = lu(k,1860) - lu(k,1733) * lu(k,1852) + lu(k,1889) = lu(k,1889) - lu(k,1726) * lu(k,1888) + lu(k,1890) = lu(k,1890) - lu(k,1727) * lu(k,1888) + lu(k,1891) = lu(k,1891) - lu(k,1728) * lu(k,1888) + lu(k,1892) = lu(k,1892) - lu(k,1729) * lu(k,1888) + lu(k,1893) = lu(k,1893) - lu(k,1730) * lu(k,1888) + lu(k,1894) = lu(k,1894) - lu(k,1731) * lu(k,1888) + lu(k,1895) = lu(k,1895) - lu(k,1732) * lu(k,1888) + lu(k,1896) = lu(k,1896) - lu(k,1733) * lu(k,1888) + lu(k,1930) = lu(k,1930) - lu(k,1726) * lu(k,1929) + lu(k,1931) = lu(k,1931) - lu(k,1727) * lu(k,1929) + lu(k,1932) = lu(k,1932) - lu(k,1728) * lu(k,1929) + lu(k,1933) = lu(k,1933) - lu(k,1729) * lu(k,1929) + lu(k,1934) = lu(k,1934) - lu(k,1730) * lu(k,1929) + lu(k,1935) = lu(k,1935) - lu(k,1731) * lu(k,1929) + lu(k,1936) = lu(k,1936) - lu(k,1732) * lu(k,1929) + lu(k,1937) = lu(k,1937) - lu(k,1733) * lu(k,1929) + lu(k,1972) = lu(k,1972) - lu(k,1726) * lu(k,1971) + lu(k,1973) = lu(k,1973) - lu(k,1727) * lu(k,1971) + lu(k,1974) = lu(k,1974) - lu(k,1728) * lu(k,1971) + lu(k,1975) = lu(k,1975) - lu(k,1729) * lu(k,1971) + lu(k,1976) = lu(k,1976) - lu(k,1730) * lu(k,1971) + lu(k,1977) = lu(k,1977) - lu(k,1731) * lu(k,1971) + lu(k,1978) = lu(k,1978) - lu(k,1732) * lu(k,1971) + lu(k,1979) = lu(k,1979) - lu(k,1733) * lu(k,1971) + lu(k,2020) = lu(k,2020) - lu(k,1726) * lu(k,2019) + lu(k,2021) = lu(k,2021) - lu(k,1727) * lu(k,2019) + lu(k,2022) = lu(k,2022) - lu(k,1728) * lu(k,2019) + lu(k,2023) = lu(k,2023) - lu(k,1729) * lu(k,2019) + lu(k,2024) = lu(k,2024) - lu(k,1730) * lu(k,2019) + lu(k,2025) = lu(k,2025) - lu(k,1731) * lu(k,2019) + lu(k,2026) = lu(k,2026) - lu(k,1732) * lu(k,2019) + lu(k,2027) = lu(k,2027) - lu(k,1733) * lu(k,2019) + lu(k,2080) = lu(k,2080) - lu(k,1726) * lu(k,2079) + lu(k,2081) = lu(k,2081) - lu(k,1727) * lu(k,2079) + lu(k,2082) = lu(k,2082) - lu(k,1728) * lu(k,2079) + lu(k,2083) = lu(k,2083) - lu(k,1729) * lu(k,2079) + lu(k,2084) = lu(k,2084) - lu(k,1730) * lu(k,2079) + lu(k,2085) = lu(k,2085) - lu(k,1731) * lu(k,2079) + lu(k,2086) = lu(k,2086) - lu(k,1732) * lu(k,2079) + lu(k,2087) = lu(k,2087) - lu(k,1733) * lu(k,2079) end do - end subroutine lu_fac24 + end subroutine lu_fac25 + subroutine lu_fac26( 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,1771) = 1._r8 / lu(k,1771) + lu(k,1772) = lu(k,1772) * lu(k,1771) + lu(k,1773) = lu(k,1773) * lu(k,1771) + lu(k,1774) = lu(k,1774) * lu(k,1771) + lu(k,1775) = lu(k,1775) * lu(k,1771) + lu(k,1776) = lu(k,1776) * lu(k,1771) + lu(k,1777) = lu(k,1777) * lu(k,1771) + lu(k,1778) = lu(k,1778) * lu(k,1771) + lu(k,1821) = lu(k,1821) - lu(k,1772) * lu(k,1820) + lu(k,1822) = lu(k,1822) - lu(k,1773) * lu(k,1820) + lu(k,1823) = lu(k,1823) - lu(k,1774) * lu(k,1820) + lu(k,1824) = lu(k,1824) - lu(k,1775) * lu(k,1820) + lu(k,1825) = lu(k,1825) - lu(k,1776) * lu(k,1820) + lu(k,1826) = lu(k,1826) - lu(k,1777) * lu(k,1820) + lu(k,1827) = lu(k,1827) - lu(k,1778) * lu(k,1820) + lu(k,1854) = lu(k,1854) - lu(k,1772) * lu(k,1853) + lu(k,1855) = lu(k,1855) - lu(k,1773) * lu(k,1853) + lu(k,1856) = lu(k,1856) - lu(k,1774) * lu(k,1853) + lu(k,1857) = lu(k,1857) - lu(k,1775) * lu(k,1853) + lu(k,1858) = lu(k,1858) - lu(k,1776) * lu(k,1853) + lu(k,1859) = lu(k,1859) - lu(k,1777) * lu(k,1853) + lu(k,1860) = lu(k,1860) - lu(k,1778) * lu(k,1853) + lu(k,1890) = lu(k,1890) - lu(k,1772) * lu(k,1889) + lu(k,1891) = lu(k,1891) - lu(k,1773) * lu(k,1889) + lu(k,1892) = lu(k,1892) - lu(k,1774) * lu(k,1889) + lu(k,1893) = lu(k,1893) - lu(k,1775) * lu(k,1889) + lu(k,1894) = lu(k,1894) - lu(k,1776) * lu(k,1889) + lu(k,1895) = lu(k,1895) - lu(k,1777) * lu(k,1889) + lu(k,1896) = lu(k,1896) - lu(k,1778) * lu(k,1889) + lu(k,1931) = lu(k,1931) - lu(k,1772) * lu(k,1930) + lu(k,1932) = lu(k,1932) - lu(k,1773) * lu(k,1930) + lu(k,1933) = lu(k,1933) - lu(k,1774) * lu(k,1930) + lu(k,1934) = lu(k,1934) - lu(k,1775) * lu(k,1930) + lu(k,1935) = lu(k,1935) - lu(k,1776) * lu(k,1930) + lu(k,1936) = lu(k,1936) - lu(k,1777) * lu(k,1930) + lu(k,1937) = lu(k,1937) - lu(k,1778) * lu(k,1930) + lu(k,1973) = lu(k,1973) - lu(k,1772) * lu(k,1972) + lu(k,1974) = lu(k,1974) - lu(k,1773) * lu(k,1972) + lu(k,1975) = lu(k,1975) - lu(k,1774) * lu(k,1972) + lu(k,1976) = lu(k,1976) - lu(k,1775) * lu(k,1972) + lu(k,1977) = lu(k,1977) - lu(k,1776) * lu(k,1972) + lu(k,1978) = lu(k,1978) - lu(k,1777) * lu(k,1972) + lu(k,1979) = lu(k,1979) - lu(k,1778) * lu(k,1972) + lu(k,2021) = lu(k,2021) - lu(k,1772) * lu(k,2020) + lu(k,2022) = lu(k,2022) - lu(k,1773) * lu(k,2020) + lu(k,2023) = lu(k,2023) - lu(k,1774) * lu(k,2020) + lu(k,2024) = lu(k,2024) - lu(k,1775) * lu(k,2020) + lu(k,2025) = lu(k,2025) - lu(k,1776) * lu(k,2020) + lu(k,2026) = lu(k,2026) - lu(k,1777) * lu(k,2020) + lu(k,2027) = lu(k,2027) - lu(k,1778) * lu(k,2020) + lu(k,2081) = lu(k,2081) - lu(k,1772) * lu(k,2080) + lu(k,2082) = lu(k,2082) - lu(k,1773) * lu(k,2080) + lu(k,2083) = lu(k,2083) - lu(k,1774) * lu(k,2080) + lu(k,2084) = lu(k,2084) - lu(k,1775) * lu(k,2080) + lu(k,2085) = lu(k,2085) - lu(k,1776) * lu(k,2080) + lu(k,2086) = lu(k,2086) - lu(k,1777) * lu(k,2080) + lu(k,2087) = lu(k,2087) - lu(k,1778) * lu(k,2080) + lu(k,1821) = 1._r8 / lu(k,1821) + lu(k,1822) = lu(k,1822) * lu(k,1821) + lu(k,1823) = lu(k,1823) * lu(k,1821) + lu(k,1824) = lu(k,1824) * lu(k,1821) + lu(k,1825) = lu(k,1825) * lu(k,1821) + lu(k,1826) = lu(k,1826) * lu(k,1821) + lu(k,1827) = lu(k,1827) * lu(k,1821) + lu(k,1855) = lu(k,1855) - lu(k,1822) * lu(k,1854) + lu(k,1856) = lu(k,1856) - lu(k,1823) * lu(k,1854) + lu(k,1857) = lu(k,1857) - lu(k,1824) * lu(k,1854) + lu(k,1858) = lu(k,1858) - lu(k,1825) * lu(k,1854) + lu(k,1859) = lu(k,1859) - lu(k,1826) * lu(k,1854) + lu(k,1860) = lu(k,1860) - lu(k,1827) * lu(k,1854) + lu(k,1891) = lu(k,1891) - lu(k,1822) * lu(k,1890) + lu(k,1892) = lu(k,1892) - lu(k,1823) * lu(k,1890) + lu(k,1893) = lu(k,1893) - lu(k,1824) * lu(k,1890) + lu(k,1894) = lu(k,1894) - lu(k,1825) * lu(k,1890) + lu(k,1895) = lu(k,1895) - lu(k,1826) * lu(k,1890) + lu(k,1896) = lu(k,1896) - lu(k,1827) * lu(k,1890) + lu(k,1932) = lu(k,1932) - lu(k,1822) * lu(k,1931) + lu(k,1933) = lu(k,1933) - lu(k,1823) * lu(k,1931) + lu(k,1934) = lu(k,1934) - lu(k,1824) * lu(k,1931) + lu(k,1935) = lu(k,1935) - lu(k,1825) * lu(k,1931) + lu(k,1936) = lu(k,1936) - lu(k,1826) * lu(k,1931) + lu(k,1937) = lu(k,1937) - lu(k,1827) * lu(k,1931) + lu(k,1974) = lu(k,1974) - lu(k,1822) * lu(k,1973) + lu(k,1975) = lu(k,1975) - lu(k,1823) * lu(k,1973) + lu(k,1976) = lu(k,1976) - lu(k,1824) * lu(k,1973) + lu(k,1977) = lu(k,1977) - lu(k,1825) * lu(k,1973) + lu(k,1978) = lu(k,1978) - lu(k,1826) * lu(k,1973) + lu(k,1979) = lu(k,1979) - lu(k,1827) * lu(k,1973) + lu(k,2022) = lu(k,2022) - lu(k,1822) * lu(k,2021) + lu(k,2023) = lu(k,2023) - lu(k,1823) * lu(k,2021) + lu(k,2024) = lu(k,2024) - lu(k,1824) * lu(k,2021) + lu(k,2025) = lu(k,2025) - lu(k,1825) * lu(k,2021) + lu(k,2026) = lu(k,2026) - lu(k,1826) * lu(k,2021) + lu(k,2027) = lu(k,2027) - lu(k,1827) * lu(k,2021) + lu(k,2082) = lu(k,2082) - lu(k,1822) * lu(k,2081) + lu(k,2083) = lu(k,2083) - lu(k,1823) * lu(k,2081) + lu(k,2084) = lu(k,2084) - lu(k,1824) * lu(k,2081) + lu(k,2085) = lu(k,2085) - lu(k,1825) * lu(k,2081) + lu(k,2086) = lu(k,2086) - lu(k,1826) * lu(k,2081) + lu(k,2087) = lu(k,2087) - lu(k,1827) * lu(k,2081) + lu(k,1855) = 1._r8 / lu(k,1855) + lu(k,1856) = lu(k,1856) * lu(k,1855) + lu(k,1857) = lu(k,1857) * lu(k,1855) + lu(k,1858) = lu(k,1858) * lu(k,1855) + lu(k,1859) = lu(k,1859) * lu(k,1855) + lu(k,1860) = lu(k,1860) * lu(k,1855) + lu(k,1892) = lu(k,1892) - lu(k,1856) * lu(k,1891) + lu(k,1893) = lu(k,1893) - lu(k,1857) * lu(k,1891) + lu(k,1894) = lu(k,1894) - lu(k,1858) * lu(k,1891) + lu(k,1895) = lu(k,1895) - lu(k,1859) * lu(k,1891) + lu(k,1896) = lu(k,1896) - lu(k,1860) * lu(k,1891) + lu(k,1933) = lu(k,1933) - lu(k,1856) * lu(k,1932) + lu(k,1934) = lu(k,1934) - lu(k,1857) * lu(k,1932) + lu(k,1935) = lu(k,1935) - lu(k,1858) * lu(k,1932) + lu(k,1936) = lu(k,1936) - lu(k,1859) * lu(k,1932) + lu(k,1937) = lu(k,1937) - lu(k,1860) * lu(k,1932) + lu(k,1975) = lu(k,1975) - lu(k,1856) * lu(k,1974) + lu(k,1976) = lu(k,1976) - lu(k,1857) * lu(k,1974) + lu(k,1977) = lu(k,1977) - lu(k,1858) * lu(k,1974) + lu(k,1978) = lu(k,1978) - lu(k,1859) * lu(k,1974) + lu(k,1979) = lu(k,1979) - lu(k,1860) * lu(k,1974) + lu(k,2023) = lu(k,2023) - lu(k,1856) * lu(k,2022) + lu(k,2024) = lu(k,2024) - lu(k,1857) * lu(k,2022) + lu(k,2025) = lu(k,2025) - lu(k,1858) * lu(k,2022) + lu(k,2026) = lu(k,2026) - lu(k,1859) * lu(k,2022) + lu(k,2027) = lu(k,2027) - lu(k,1860) * lu(k,2022) + lu(k,2083) = lu(k,2083) - lu(k,1856) * lu(k,2082) + lu(k,2084) = lu(k,2084) - lu(k,1857) * lu(k,2082) + lu(k,2085) = lu(k,2085) - lu(k,1858) * lu(k,2082) + lu(k,2086) = lu(k,2086) - lu(k,1859) * lu(k,2082) + lu(k,2087) = lu(k,2087) - lu(k,1860) * lu(k,2082) + lu(k,1892) = 1._r8 / lu(k,1892) + lu(k,1893) = lu(k,1893) * lu(k,1892) + lu(k,1894) = lu(k,1894) * lu(k,1892) + lu(k,1895) = lu(k,1895) * lu(k,1892) + lu(k,1896) = lu(k,1896) * lu(k,1892) + lu(k,1934) = lu(k,1934) - lu(k,1893) * lu(k,1933) + lu(k,1935) = lu(k,1935) - lu(k,1894) * lu(k,1933) + lu(k,1936) = lu(k,1936) - lu(k,1895) * lu(k,1933) + lu(k,1937) = lu(k,1937) - lu(k,1896) * lu(k,1933) + lu(k,1976) = lu(k,1976) - lu(k,1893) * lu(k,1975) + lu(k,1977) = lu(k,1977) - lu(k,1894) * lu(k,1975) + lu(k,1978) = lu(k,1978) - lu(k,1895) * lu(k,1975) + lu(k,1979) = lu(k,1979) - lu(k,1896) * lu(k,1975) + lu(k,2024) = lu(k,2024) - lu(k,1893) * lu(k,2023) + lu(k,2025) = lu(k,2025) - lu(k,1894) * lu(k,2023) + lu(k,2026) = lu(k,2026) - lu(k,1895) * lu(k,2023) + lu(k,2027) = lu(k,2027) - lu(k,1896) * lu(k,2023) + lu(k,2084) = lu(k,2084) - lu(k,1893) * lu(k,2083) + lu(k,2085) = lu(k,2085) - lu(k,1894) * lu(k,2083) + lu(k,2086) = lu(k,2086) - lu(k,1895) * lu(k,2083) + lu(k,2087) = lu(k,2087) - lu(k,1896) * lu(k,2083) + lu(k,1934) = 1._r8 / lu(k,1934) + lu(k,1935) = lu(k,1935) * lu(k,1934) + lu(k,1936) = lu(k,1936) * lu(k,1934) + lu(k,1937) = lu(k,1937) * lu(k,1934) + lu(k,1977) = lu(k,1977) - lu(k,1935) * lu(k,1976) + lu(k,1978) = lu(k,1978) - lu(k,1936) * lu(k,1976) + lu(k,1979) = lu(k,1979) - lu(k,1937) * lu(k,1976) + lu(k,2025) = lu(k,2025) - lu(k,1935) * lu(k,2024) + lu(k,2026) = lu(k,2026) - lu(k,1936) * lu(k,2024) + lu(k,2027) = lu(k,2027) - lu(k,1937) * lu(k,2024) + lu(k,2085) = lu(k,2085) - lu(k,1935) * lu(k,2084) + lu(k,2086) = lu(k,2086) - lu(k,1936) * lu(k,2084) + lu(k,2087) = lu(k,2087) - lu(k,1937) * lu(k,2084) + lu(k,1977) = 1._r8 / lu(k,1977) + lu(k,1978) = lu(k,1978) * lu(k,1977) + lu(k,1979) = lu(k,1979) * lu(k,1977) + lu(k,2026) = lu(k,2026) - lu(k,1978) * lu(k,2025) + lu(k,2027) = lu(k,2027) - lu(k,1979) * lu(k,2025) + lu(k,2086) = lu(k,2086) - lu(k,1978) * lu(k,2085) + lu(k,2087) = lu(k,2087) - lu(k,1979) * lu(k,2085) + lu(k,2026) = 1._r8 / lu(k,2026) + lu(k,2027) = lu(k,2027) * lu(k,2026) + lu(k,2087) = lu(k,2087) - lu(k,2027) * lu(k,2086) + lu(k,2087) = 1._r8 / lu(k,2087) + end do + end subroutine lu_fac26 subroutine lu_fac( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 @@ -12897,5 +14254,7 @@ subroutine lu_fac( avec_len, lu ) call lu_fac22( avec_len, lu ) call lu_fac23( avec_len, lu ) call lu_fac24( avec_len, lu ) + call lu_fac25( avec_len, lu ) + call lu_fac26( avec_len, lu ) end subroutine lu_fac end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_lu_solve.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_lu_solve.F90 index 4cf6552a1f..98bdc804ab 100644 --- a/src/chemistry/pp_waccm_mad_mam4/mo_lu_solve.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/mo_lu_solve.F90 @@ -21,207 +21,208 @@ subroutine lu_slv01( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,105) = b(k,105) - lu(k,22) * b(k,21) - b(k,112) = b(k,112) - lu(k,23) * b(k,21) - b(k,29) = b(k,29) - lu(k,25) * b(k,22) - b(k,114) = b(k,114) - lu(k,26) * b(k,22) - b(k,53) = b(k,53) - lu(k,28) * b(k,23) - b(k,84) = b(k,84) - lu(k,29) * b(k,23) - b(k,105) = b(k,105) - lu(k,31) * b(k,24) - b(k,53) = b(k,53) - lu(k,33) * b(k,25) - b(k,84) = b(k,84) - lu(k,34) * b(k,25) - b(k,105) = b(k,105) - lu(k,35) * b(k,25) - b(k,53) = b(k,53) - lu(k,37) * b(k,26) - b(k,113) = b(k,113) - lu(k,38) * b(k,26) - b(k,75) = b(k,75) - lu(k,40) * b(k,27) - b(k,105) = b(k,105) - lu(k,41) * b(k,27) - b(k,59) = b(k,59) - lu(k,43) * b(k,28) - b(k,100) = b(k,100) - lu(k,44) * b(k,28) - b(k,60) = b(k,60) - lu(k,47) * b(k,29) - b(k,104) = b(k,104) - lu(k,48) * b(k,29) - b(k,114) = b(k,114) - lu(k,49) * b(k,29) - b(k,101) = b(k,101) - lu(k,51) * b(k,30) - b(k,111) = b(k,111) - lu(k,52) * b(k,30) - b(k,114) = b(k,114) - lu(k,53) * b(k,30) - b(k,101) = b(k,101) - lu(k,55) * b(k,31) - b(k,108) = b(k,108) - lu(k,56) * b(k,31) - b(k,114) = b(k,114) - lu(k,57) * b(k,31) - b(k,60) = b(k,60) - lu(k,59) * b(k,32) - b(k,88) = b(k,88) - lu(k,60) * b(k,32) - b(k,89) = b(k,89) - lu(k,61) * b(k,32) - b(k,97) = b(k,97) - lu(k,62) * b(k,32) - b(k,101) = b(k,101) - lu(k,63) * b(k,32) - b(k,60) = b(k,60) - lu(k,65) * b(k,33) - b(k,70) = b(k,70) - lu(k,66) * b(k,33) - b(k,104) = b(k,104) - lu(k,67) * b(k,33) - b(k,112) = b(k,112) - lu(k,68) * b(k,33) - b(k,44) = b(k,44) - lu(k,70) * b(k,34) - b(k,49) = b(k,49) - lu(k,71) * b(k,34) - b(k,60) = b(k,60) - lu(k,72) * b(k,34) - b(k,70) = b(k,70) - lu(k,73) * b(k,34) - b(k,89) = b(k,89) - lu(k,74) * b(k,34) - b(k,104) = b(k,104) - lu(k,75) * b(k,34) - b(k,113) = b(k,113) - lu(k,76) * b(k,34) - b(k,66) = b(k,66) - lu(k,78) * b(k,35) - b(k,83) = b(k,83) - lu(k,79) * b(k,35) - b(k,89) = b(k,89) - lu(k,80) * b(k,35) - b(k,113) = b(k,113) - lu(k,81) * b(k,35) - b(k,114) = b(k,114) - lu(k,82) * b(k,35) - b(k,48) = b(k,48) - lu(k,84) * b(k,36) - b(k,89) = b(k,89) - lu(k,85) * b(k,36) - b(k,107) = b(k,107) - lu(k,86) * b(k,36) - b(k,113) = b(k,113) - lu(k,87) * b(k,36) - b(k,114) = b(k,114) - lu(k,88) * b(k,36) - b(k,50) = b(k,50) - lu(k,90) * b(k,37) - b(k,95) = b(k,95) - lu(k,91) * b(k,37) - b(k,106) = b(k,106) - lu(k,92) * b(k,37) - b(k,107) = b(k,107) - lu(k,93) * b(k,37) - b(k,114) = b(k,114) - lu(k,94) * b(k,37) - b(k,74) = b(k,74) - lu(k,96) * b(k,38) - b(k,85) = b(k,85) - lu(k,97) * b(k,38) - b(k,100) = b(k,100) - lu(k,98) * b(k,38) - b(k,102) = b(k,102) - lu(k,99) * b(k,38) - b(k,104) = b(k,104) - lu(k,100) * b(k,38) - b(k,88) = b(k,88) - lu(k,102) * b(k,39) - b(k,89) = b(k,89) - lu(k,103) * b(k,39) - b(k,94) = b(k,94) - lu(k,104) * b(k,39) - b(k,97) = b(k,97) - lu(k,105) * b(k,39) - b(k,100) = b(k,100) - lu(k,106) * b(k,39) - b(k,114) = b(k,114) - lu(k,107) * b(k,39) - b(k,41) = b(k,41) - lu(k,109) * b(k,40) - b(k,92) = b(k,92) - lu(k,110) * b(k,40) - b(k,96) = b(k,96) - lu(k,111) * b(k,40) - b(k,106) = b(k,106) - lu(k,112) * b(k,40) - b(k,107) = b(k,107) - lu(k,113) * b(k,40) - b(k,114) = b(k,114) - lu(k,114) * b(k,40) - b(k,92) = b(k,92) - lu(k,116) * b(k,41) - b(k,96) = b(k,96) - lu(k,117) * b(k,41) - b(k,106) = b(k,106) - lu(k,118) * b(k,41) - b(k,107) = b(k,107) - lu(k,119) * b(k,41) - b(k,114) = b(k,114) - lu(k,120) * b(k,41) - b(k,43) = b(k,43) - lu(k,122) * b(k,42) - b(k,47) = b(k,47) - lu(k,123) * b(k,42) - b(k,56) = b(k,56) - lu(k,124) * b(k,42) - b(k,61) = b(k,61) - lu(k,125) * b(k,42) - b(k,104) = b(k,104) - lu(k,126) * b(k,42) - b(k,106) = b(k,106) - lu(k,127) * b(k,42) - b(k,47) = b(k,47) - lu(k,129) * b(k,43) - b(k,61) = b(k,61) - lu(k,130) * b(k,43) - b(k,100) = b(k,100) - lu(k,131) * b(k,43) - b(k,103) = b(k,103) - lu(k,132) * b(k,43) - b(k,104) = b(k,104) - lu(k,133) * b(k,43) - b(k,88) = b(k,88) - lu(k,135) * b(k,44) - b(k,89) = b(k,89) - lu(k,136) * b(k,44) - b(k,113) = b(k,113) - lu(k,137) * b(k,44) - b(k,54) = b(k,54) - lu(k,139) * b(k,45) - b(k,75) = b(k,75) - lu(k,140) * b(k,45) - b(k,82) = b(k,82) - lu(k,141) * b(k,45) - b(k,94) = b(k,94) - lu(k,142) * b(k,45) - b(k,97) = b(k,97) - lu(k,143) * b(k,45) - b(k,101) = b(k,101) - lu(k,144) * b(k,45) - b(k,104) = b(k,104) - lu(k,145) * b(k,45) - b(k,88) = b(k,88) - lu(k,147) * b(k,46) - b(k,89) = b(k,89) - lu(k,148) * b(k,46) - b(k,98) = b(k,98) - lu(k,149) * b(k,46) - b(k,104) = b(k,104) - lu(k,150) * b(k,46) - b(k,105) = b(k,105) - lu(k,151) * b(k,46) - b(k,114) = b(k,114) - lu(k,152) * b(k,46) - b(k,55) = b(k,55) - lu(k,154) * b(k,47) - b(k,61) = b(k,61) - lu(k,155) * b(k,47) - b(k,65) = b(k,65) - lu(k,156) * b(k,47) - b(k,92) = b(k,92) - lu(k,157) * b(k,47) - b(k,100) = b(k,100) - lu(k,158) * b(k,47) - b(k,103) = b(k,103) - lu(k,159) * b(k,47) - b(k,104) = b(k,104) - lu(k,160) * b(k,47) - b(k,107) = b(k,107) - lu(k,161) * b(k,47) - b(k,51) = b(k,51) - lu(k,163) * b(k,48) - b(k,95) = b(k,95) - lu(k,164) * b(k,48) - b(k,107) = b(k,107) - lu(k,165) * b(k,48) - b(k,113) = b(k,113) - lu(k,166) * b(k,48) - b(k,114) = b(k,114) - lu(k,167) * b(k,48) - b(k,70) = b(k,70) - lu(k,169) * b(k,49) - b(k,89) = b(k,89) - lu(k,170) * b(k,49) - b(k,99) = b(k,99) - lu(k,171) * b(k,49) - b(k,100) = b(k,100) - lu(k,172) * b(k,49) - b(k,104) = b(k,104) - lu(k,173) * b(k,49) - b(k,113) = b(k,113) - lu(k,174) * b(k,49) - b(k,89) = b(k,89) - lu(k,176) * b(k,50) - b(k,94) = b(k,94) - lu(k,177) * b(k,50) - b(k,106) = b(k,106) - lu(k,178) * b(k,50) - b(k,114) = b(k,114) - lu(k,179) * b(k,50) - b(k,95) = b(k,95) - lu(k,182) * b(k,51) - b(k,107) = b(k,107) - lu(k,183) * b(k,51) - b(k,113) = b(k,113) - lu(k,184) * b(k,51) - b(k,114) = b(k,114) - lu(k,185) * b(k,51) - b(k,89) = b(k,89) - lu(k,190) * b(k,52) - b(k,95) = b(k,95) - lu(k,191) * b(k,52) - b(k,100) = b(k,100) - lu(k,192) * b(k,52) - b(k,103) = b(k,103) - lu(k,193) * b(k,52) - b(k,107) = b(k,107) - lu(k,194) * b(k,52) - b(k,113) = b(k,113) - lu(k,195) * b(k,52) - b(k,114) = b(k,114) - lu(k,196) * b(k,52) - b(k,66) = b(k,66) - lu(k,199) * b(k,53) - b(k,77) = b(k,77) - lu(k,200) * b(k,53) - b(k,89) = b(k,89) - lu(k,201) * b(k,53) - b(k,97) = b(k,97) - lu(k,202) * b(k,53) - b(k,101) = b(k,101) - lu(k,203) * b(k,53) - b(k,113) = b(k,113) - lu(k,204) * b(k,53) - b(k,114) = b(k,114) - lu(k,205) * b(k,53) - b(k,75) = b(k,75) - lu(k,208) * b(k,54) - b(k,82) = b(k,82) - lu(k,209) * b(k,54) - b(k,89) = b(k,89) - lu(k,210) * b(k,54) - b(k,98) = b(k,98) - lu(k,211) * b(k,54) - b(k,104) = b(k,104) - lu(k,212) * b(k,54) - b(k,105) = b(k,105) - lu(k,213) * b(k,54) - b(k,114) = b(k,114) - lu(k,214) * b(k,54) - b(k,56) = b(k,56) - lu(k,216) * b(k,55) - b(k,61) = b(k,61) - lu(k,217) * b(k,55) - b(k,65) = b(k,65) - lu(k,218) * b(k,55) - b(k,84) = b(k,84) - lu(k,219) * b(k,55) - b(k,100) = b(k,100) - lu(k,220) * b(k,55) - b(k,104) = b(k,104) - lu(k,221) * b(k,55) - b(k,106) = b(k,106) - lu(k,222) * b(k,55) - b(k,61) = b(k,61) - lu(k,224) * b(k,56) - b(k,65) = b(k,65) - lu(k,225) * b(k,56) - b(k,92) = b(k,92) - lu(k,226) * b(k,56) - b(k,100) = b(k,100) - lu(k,227) * b(k,56) - b(k,103) = b(k,103) - lu(k,228) * b(k,56) - b(k,104) = b(k,104) - lu(k,229) * b(k,56) - b(k,89) = b(k,89) - lu(k,232) * b(k,57) - b(k,98) = b(k,98) - lu(k,233) * b(k,57) - b(k,104) = b(k,104) - lu(k,234) * b(k,57) - b(k,105) = b(k,105) - lu(k,235) * b(k,57) - b(k,112) = b(k,112) - lu(k,236) * b(k,57) - b(k,114) = b(k,114) - lu(k,237) * b(k,57) - b(k,75) = b(k,75) - lu(k,239) * b(k,58) - b(k,82) = b(k,82) - lu(k,240) * b(k,58) - b(k,84) = b(k,84) - lu(k,241) * b(k,58) - b(k,89) = b(k,89) - lu(k,242) * b(k,58) - b(k,104) = b(k,104) - lu(k,243) * b(k,58) - b(k,113) = b(k,113) - lu(k,244) * b(k,58) - b(k,114) = b(k,114) - lu(k,245) * b(k,58) - b(k,68) = b(k,68) - lu(k,247) * b(k,59) - b(k,99) = b(k,99) - lu(k,248) * b(k,59) - b(k,100) = b(k,100) - lu(k,249) * b(k,59) - b(k,102) = b(k,102) - lu(k,250) * b(k,59) - b(k,103) = b(k,103) - lu(k,251) * b(k,59) - b(k,107) = b(k,107) - lu(k,252) * b(k,59) - b(k,110) = b(k,110) - lu(k,253) * b(k,59) - b(k,70) = b(k,70) - lu(k,256) * b(k,60) - b(k,88) = b(k,88) - lu(k,257) * b(k,60) - b(k,89) = b(k,89) - lu(k,258) * b(k,60) - b(k,104) = b(k,104) - lu(k,259) * b(k,60) - b(k,114) = b(k,114) - lu(k,260) * b(k,60) - b(k,65) = b(k,65) - lu(k,265) * b(k,61) - b(k,84) = b(k,84) - lu(k,266) * b(k,61) - b(k,88) = b(k,88) - lu(k,267) * b(k,61) - b(k,89) = b(k,89) - lu(k,268) * b(k,61) - b(k,92) = b(k,92) - lu(k,269) * b(k,61) - b(k,100) = b(k,100) - lu(k,270) * b(k,61) - b(k,103) = b(k,103) - lu(k,271) * b(k,61) - b(k,104) = b(k,104) - lu(k,272) * b(k,61) - b(k,106) = b(k,106) - lu(k,273) * b(k,61) - b(k,113) = b(k,113) - lu(k,274) * b(k,61) + b(k,130) = b(k,130) - lu(k,25) * b(k,24) + b(k,136) = b(k,136) - lu(k,26) * b(k,24) + b(k,106) = b(k,106) - lu(k,28) * b(k,25) + b(k,136) = b(k,136) - lu(k,29) * b(k,25) + b(k,40) = b(k,40) - lu(k,31) * b(k,26) + b(k,97) = b(k,97) - lu(k,32) * b(k,26) + b(k,106) = b(k,106) - lu(k,33) * b(k,26) + b(k,38) = b(k,38) - lu(k,35) * b(k,27) + b(k,106) = b(k,106) - lu(k,36) * b(k,27) + b(k,136) = b(k,136) - lu(k,37) * b(k,27) + b(k,40) = b(k,40) - lu(k,39) * b(k,28) + b(k,106) = b(k,106) - lu(k,40) * b(k,28) + b(k,136) = b(k,136) - lu(k,41) * b(k,28) + b(k,40) = b(k,40) - lu(k,43) * b(k,29) + b(k,106) = b(k,106) - lu(k,44) * b(k,29) + b(k,136) = b(k,136) - lu(k,45) * b(k,29) + b(k,112) = b(k,112) - lu(k,47) * b(k,30) + b(k,136) = b(k,136) - lu(k,48) * b(k,30) + b(k,137) = b(k,137) - lu(k,49) * b(k,30) + b(k,43) = b(k,43) - lu(k,51) * b(k,31) + b(k,137) = b(k,137) - lu(k,52) * b(k,31) + b(k,40) = b(k,40) - lu(k,54) * b(k,32) + b(k,97) = b(k,97) - lu(k,55) * b(k,32) + b(k,106) = b(k,106) - lu(k,56) * b(k,32) + b(k,136) = b(k,136) - lu(k,57) * b(k,32) + b(k,40) = b(k,40) - lu(k,59) * b(k,33) + b(k,79) = b(k,79) - lu(k,60) * b(k,33) + b(k,97) = b(k,97) - lu(k,61) * b(k,33) + b(k,106) = b(k,106) - lu(k,62) * b(k,33) + b(k,38) = b(k,38) - lu(k,64) * b(k,34) + b(k,40) = b(k,40) - lu(k,65) * b(k,34) + b(k,106) = b(k,106) - lu(k,66) * b(k,34) + b(k,136) = b(k,136) - lu(k,67) * b(k,34) + b(k,40) = b(k,40) - lu(k,69) * b(k,35) + b(k,79) = b(k,79) - lu(k,70) * b(k,35) + b(k,106) = b(k,106) - lu(k,71) * b(k,35) + b(k,136) = b(k,136) - lu(k,72) * b(k,35) + b(k,136) = b(k,136) - lu(k,74) * b(k,36) + b(k,38) = b(k,38) - lu(k,76) * b(k,37) + b(k,106) = b(k,106) - lu(k,77) * b(k,37) + b(k,112) = b(k,112) - lu(k,78) * b(k,37) + b(k,136) = b(k,136) - lu(k,79) * b(k,37) + b(k,79) = b(k,79) - lu(k,81) * b(k,38) + b(k,106) = b(k,106) - lu(k,82) * b(k,38) + b(k,136) = b(k,136) - lu(k,83) * b(k,38) + b(k,40) = b(k,40) - lu(k,85) * b(k,39) + b(k,106) = b(k,106) - lu(k,86) * b(k,39) + b(k,112) = b(k,112) - lu(k,87) * b(k,39) + b(k,136) = b(k,136) - lu(k,88) * b(k,39) + b(k,79) = b(k,79) - lu(k,90) * b(k,40) + b(k,106) = b(k,106) - lu(k,91) * b(k,40) + b(k,97) = b(k,97) - lu(k,93) * b(k,41) + b(k,136) = b(k,136) - lu(k,94) * b(k,41) + b(k,106) = b(k,106) - lu(k,96) * b(k,42) + b(k,129) = b(k,129) - lu(k,97) * b(k,42) + b(k,131) = b(k,131) - lu(k,98) * b(k,42) + b(k,80) = b(k,80) - lu(k,101) * b(k,43) + b(k,119) = b(k,119) - lu(k,102) * b(k,43) + b(k,137) = b(k,137) - lu(k,103) * b(k,43) + b(k,118) = b(k,118) - lu(k,105) * b(k,44) + b(k,128) = b(k,128) - lu(k,106) * b(k,44) + b(k,137) = b(k,137) - lu(k,107) * b(k,44) + b(k,118) = b(k,118) - lu(k,109) * b(k,45) + b(k,122) = b(k,122) - lu(k,110) * b(k,45) + b(k,137) = b(k,137) - lu(k,111) * b(k,45) + b(k,79) = b(k,79) - lu(k,114) * b(k,46) + b(k,106) = b(k,106) - lu(k,115) * b(k,46) + b(k,112) = b(k,112) - lu(k,116) * b(k,46) + b(k,136) = b(k,136) - lu(k,117) * b(k,46) + b(k,137) = b(k,137) - lu(k,118) * b(k,46) + b(k,79) = b(k,79) - lu(k,120) * b(k,47) + b(k,121) = b(k,121) - lu(k,121) * b(k,47) + b(k,80) = b(k,80) - lu(k,123) * b(k,48) + b(k,110) = b(k,110) - lu(k,124) * b(k,48) + b(k,112) = b(k,112) - lu(k,125) * b(k,48) + b(k,115) = b(k,115) - lu(k,126) * b(k,48) + b(k,118) = b(k,118) - lu(k,127) * b(k,48) + b(k,83) = b(k,83) - lu(k,129) * b(k,49) + b(k,131) = b(k,131) - lu(k,130) * b(k,49) + b(k,80) = b(k,80) - lu(k,132) * b(k,50) + b(k,91) = b(k,91) - lu(k,133) * b(k,50) + b(k,119) = b(k,119) - lu(k,134) * b(k,50) + b(k,130) = b(k,130) - lu(k,135) * b(k,50) + b(k,67) = b(k,67) - lu(k,137) * b(k,51) + b(k,70) = b(k,70) - lu(k,138) * b(k,51) + b(k,80) = b(k,80) - lu(k,139) * b(k,51) + b(k,91) = b(k,91) - lu(k,140) * b(k,51) + b(k,112) = b(k,112) - lu(k,141) * b(k,51) + b(k,119) = b(k,119) - lu(k,142) * b(k,51) + b(k,121) = b(k,121) - lu(k,143) * b(k,51) + b(k,67) = b(k,67) - lu(k,145) * b(k,52) + b(k,87) = b(k,87) - lu(k,146) * b(k,52) + b(k,110) = b(k,110) - lu(k,147) * b(k,52) + b(k,112) = b(k,112) - lu(k,148) * b(k,52) + b(k,124) = b(k,124) - lu(k,149) * b(k,52) + b(k,136) = b(k,136) - lu(k,150) * b(k,52) + b(k,137) = b(k,137) - lu(k,151) * b(k,52) + b(k,97) = b(k,97) - lu(k,153) * b(k,53) + b(k,106) = b(k,106) - lu(k,154) * b(k,53) + b(k,112) = b(k,112) - lu(k,155) * b(k,53) + b(k,124) = b(k,124) - lu(k,156) * b(k,53) + b(k,136) = b(k,136) - lu(k,157) * b(k,53) + b(k,87) = b(k,87) - lu(k,159) * b(k,54) + b(k,105) = b(k,105) - lu(k,160) * b(k,54) + b(k,112) = b(k,112) - lu(k,161) * b(k,54) + b(k,121) = b(k,121) - lu(k,162) * b(k,54) + b(k,137) = b(k,137) - lu(k,163) * b(k,54) + b(k,66) = b(k,66) - lu(k,165) * b(k,55) + b(k,112) = b(k,112) - lu(k,166) * b(k,55) + b(k,114) = b(k,114) - lu(k,167) * b(k,55) + b(k,121) = b(k,121) - lu(k,168) * b(k,55) + b(k,137) = b(k,137) - lu(k,169) * b(k,55) + b(k,71) = b(k,71) - lu(k,171) * b(k,56) + b(k,114) = b(k,114) - lu(k,172) * b(k,56) + b(k,123) = b(k,123) - lu(k,173) * b(k,56) + b(k,129) = b(k,129) - lu(k,174) * b(k,56) + b(k,137) = b(k,137) - lu(k,175) * b(k,56) + b(k,97) = b(k,97) - lu(k,177) * b(k,57) + b(k,106) = b(k,106) - lu(k,178) * b(k,57) + b(k,112) = b(k,112) - lu(k,179) * b(k,57) + b(k,124) = b(k,124) - lu(k,180) * b(k,57) + b(k,136) = b(k,136) - lu(k,181) * b(k,57) + b(k,137) = b(k,137) - lu(k,182) * b(k,57) + b(k,110) = b(k,110) - lu(k,184) * b(k,58) + b(k,112) = b(k,112) - lu(k,185) * b(k,58) + b(k,115) = b(k,115) - lu(k,186) * b(k,58) + b(k,127) = b(k,127) - lu(k,187) * b(k,58) + b(k,131) = b(k,131) - lu(k,188) * b(k,58) + b(k,137) = b(k,137) - lu(k,189) * b(k,58) + b(k,60) = b(k,60) - lu(k,191) * b(k,59) + b(k,64) = b(k,64) - lu(k,192) * b(k,59) + b(k,76) = b(k,76) - lu(k,193) * b(k,59) + b(k,84) = b(k,84) - lu(k,194) * b(k,59) + b(k,119) = b(k,119) - lu(k,195) * b(k,59) + b(k,129) = b(k,129) - lu(k,196) * b(k,59) + b(k,64) = b(k,64) - lu(k,198) * b(k,60) + b(k,84) = b(k,84) - lu(k,199) * b(k,60) + b(k,119) = b(k,119) - lu(k,200) * b(k,60) + b(k,126) = b(k,126) - lu(k,201) * b(k,60) + b(k,131) = b(k,131) - lu(k,202) * b(k,60) + b(k,75) = b(k,75) - lu(k,204) * b(k,61) + b(k,97) = b(k,97) - lu(k,205) * b(k,61) + b(k,104) = b(k,104) - lu(k,206) * b(k,61) + b(k,115) = b(k,115) - lu(k,207) * b(k,61) + b(k,118) = b(k,118) - lu(k,208) * b(k,61) + b(k,119) = b(k,119) - lu(k,209) * b(k,61) + b(k,127) = b(k,127) - lu(k,210) * b(k,61) + b(k,110) = b(k,110) - lu(k,212) * b(k,62) + b(k,112) = b(k,112) - lu(k,213) * b(k,62) + b(k,119) = b(k,119) - lu(k,214) * b(k,62) + b(k,124) = b(k,124) - lu(k,215) * b(k,62) + b(k,136) = b(k,136) - lu(k,216) * b(k,62) + b(k,137) = b(k,137) - lu(k,217) * b(k,62) + b(k,87) = b(k,87) - lu(k,219) * b(k,63) + b(k,97) = b(k,97) - lu(k,220) * b(k,63) + b(k,106) = b(k,106) - lu(k,221) * b(k,63) + b(k,110) = b(k,110) - lu(k,222) * b(k,63) + b(k,112) = b(k,112) - lu(k,223) * b(k,63) + b(k,124) = b(k,124) - lu(k,224) * b(k,63) + b(k,136) = b(k,136) - lu(k,225) * b(k,63) + b(k,137) = b(k,137) - lu(k,226) * b(k,63) + b(k,74) = b(k,74) - lu(k,228) * b(k,64) + b(k,84) = b(k,84) - lu(k,229) * b(k,64) + b(k,88) = b(k,88) - lu(k,230) * b(k,64) + b(k,114) = b(k,114) - lu(k,231) * b(k,64) + b(k,116) = b(k,116) - lu(k,232) * b(k,64) + b(k,119) = b(k,119) - lu(k,233) * b(k,64) + b(k,126) = b(k,126) - lu(k,234) * b(k,64) + b(k,131) = b(k,131) - lu(k,235) * b(k,64) + b(k,98) = b(k,98) - lu(k,237) * b(k,65) + b(k,108) = b(k,108) - lu(k,238) * b(k,65) + b(k,119) = b(k,119) - lu(k,239) * b(k,65) + b(k,125) = b(k,125) - lu(k,240) * b(k,65) + b(k,131) = b(k,131) - lu(k,241) * b(k,65) + b(k,135) = b(k,135) - lu(k,242) * b(k,65) + b(k,72) = b(k,72) - lu(k,244) * b(k,66) + b(k,114) = b(k,114) - lu(k,245) * b(k,66) + b(k,121) = b(k,121) - lu(k,246) * b(k,66) + b(k,123) = b(k,123) - lu(k,247) * b(k,66) + b(k,137) = b(k,137) - lu(k,248) * b(k,66) + b(k,110) = b(k,110) - lu(k,250) * b(k,67) + b(k,112) = b(k,112) - lu(k,251) * b(k,67) + b(k,135) = b(k,135) - lu(k,252) * b(k,67) + b(k,69) = b(k,69) - lu(k,254) * b(k,68) + b(k,114) = b(k,114) - lu(k,255) * b(k,68) + b(k,116) = b(k,116) - lu(k,256) * b(k,68) + b(k,120) = b(k,120) - lu(k,257) * b(k,68) + b(k,129) = b(k,129) - lu(k,258) * b(k,68) + b(k,135) = b(k,135) - lu(k,259) * b(k,68) + b(k,137) = b(k,137) - lu(k,260) * b(k,68) + b(k,114) = b(k,114) - lu(k,262) * b(k,69) + b(k,116) = b(k,116) - lu(k,263) * b(k,69) + b(k,120) = b(k,120) - lu(k,264) * b(k,69) + b(k,129) = b(k,129) - lu(k,265) * b(k,69) + b(k,135) = b(k,135) - lu(k,266) * b(k,69) + b(k,137) = b(k,137) - lu(k,267) * b(k,69) + b(k,91) = b(k,91) - lu(k,269) * b(k,70) + b(k,112) = b(k,112) - lu(k,270) * b(k,70) + b(k,119) = b(k,119) - lu(k,271) * b(k,70) + b(k,121) = b(k,121) - lu(k,272) * b(k,70) + b(k,131) = b(k,131) - lu(k,273) * b(k,70) + b(k,134) = b(k,134) - lu(k,274) * b(k,70) end do end subroutine lu_slv01 subroutine lu_slv02( avec_len, lu, b ) @@ -242,213 +243,212 @@ subroutine lu_slv02( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,89) = b(k,89) - lu(k,278) * b(k,62) - b(k,94) = b(k,94) - lu(k,279) * b(k,62) - b(k,97) = b(k,97) - lu(k,280) * b(k,62) - b(k,98) = b(k,98) - lu(k,281) * b(k,62) - b(k,101) = b(k,101) - lu(k,282) * b(k,62) - b(k,104) = b(k,104) - lu(k,283) * b(k,62) - b(k,105) = b(k,105) - lu(k,284) * b(k,62) - b(k,112) = b(k,112) - lu(k,285) * b(k,62) - b(k,114) = b(k,114) - lu(k,286) * b(k,62) - b(k,86) = b(k,86) - lu(k,288) * b(k,63) - b(k,91) = b(k,91) - lu(k,289) * b(k,63) - b(k,94) = b(k,94) - lu(k,290) * b(k,63) - b(k,100) = b(k,100) - lu(k,291) * b(k,63) - b(k,104) = b(k,104) - lu(k,292) * b(k,63) - b(k,105) = b(k,105) - lu(k,293) * b(k,63) - b(k,106) = b(k,106) - lu(k,294) * b(k,63) - b(k,78) = b(k,78) - lu(k,298) * b(k,64) - b(k,79) = b(k,79) - lu(k,299) * b(k,64) - b(k,81) = b(k,81) - lu(k,300) * b(k,64) - b(k,94) = b(k,94) - lu(k,301) * b(k,64) - b(k,97) = b(k,97) - lu(k,302) * b(k,64) - b(k,101) = b(k,101) - lu(k,303) * b(k,64) - b(k,104) = b(k,104) - lu(k,304) * b(k,64) - b(k,106) = b(k,106) - lu(k,305) * b(k,64) - b(k,108) = b(k,108) - lu(k,306) * b(k,64) - b(k,111) = b(k,111) - lu(k,307) * b(k,64) - b(k,114) = b(k,114) - lu(k,308) * b(k,64) - b(k,84) = b(k,84) - lu(k,312) * b(k,65) - b(k,88) = b(k,88) - lu(k,313) * b(k,65) - b(k,89) = b(k,89) - lu(k,314) * b(k,65) - b(k,92) = b(k,92) - lu(k,315) * b(k,65) - b(k,94) = b(k,94) - lu(k,316) * b(k,65) - b(k,100) = b(k,100) - lu(k,317) * b(k,65) - b(k,103) = b(k,103) - lu(k,318) * b(k,65) - b(k,104) = b(k,104) - lu(k,319) * b(k,65) - b(k,106) = b(k,106) - lu(k,320) * b(k,65) - b(k,107) = b(k,107) - lu(k,321) * b(k,65) - b(k,113) = b(k,113) - lu(k,322) * b(k,65) - b(k,83) = b(k,83) - lu(k,325) * b(k,66) - b(k,88) = b(k,88) - lu(k,326) * b(k,66) - b(k,89) = b(k,89) - lu(k,327) * b(k,66) - b(k,94) = b(k,94) - lu(k,328) * b(k,66) - b(k,100) = b(k,100) - lu(k,329) * b(k,66) - b(k,105) = b(k,105) - lu(k,330) * b(k,66) - b(k,106) = b(k,106) - lu(k,331) * b(k,66) - b(k,112) = b(k,112) - lu(k,332) * b(k,66) - b(k,113) = b(k,113) - lu(k,333) * b(k,66) - b(k,114) = b(k,114) - lu(k,334) * b(k,66) - b(k,89) = b(k,89) - lu(k,336) * b(k,67) - b(k,92) = b(k,92) - lu(k,337) * b(k,67) - b(k,93) = b(k,93) - lu(k,338) * b(k,67) - b(k,95) = b(k,95) - lu(k,339) * b(k,67) - b(k,96) = b(k,96) - lu(k,340) * b(k,67) - b(k,100) = b(k,100) - lu(k,341) * b(k,67) - b(k,103) = b(k,103) - lu(k,342) * b(k,67) - b(k,106) = b(k,106) - lu(k,343) * b(k,67) - b(k,108) = b(k,108) - lu(k,344) * b(k,67) - b(k,111) = b(k,111) - lu(k,345) * b(k,67) - b(k,113) = b(k,113) - lu(k,346) * b(k,67) - b(k,114) = b(k,114) - lu(k,347) * b(k,67) - b(k,89) = b(k,89) - lu(k,351) * b(k,68) - b(k,95) = b(k,95) - lu(k,352) * b(k,68) - b(k,99) = b(k,99) - lu(k,353) * b(k,68) - b(k,100) = b(k,100) - lu(k,354) * b(k,68) - b(k,102) = b(k,102) - lu(k,355) * b(k,68) - b(k,103) = b(k,103) - lu(k,356) * b(k,68) - b(k,104) = b(k,104) - lu(k,357) * b(k,68) - b(k,107) = b(k,107) - lu(k,358) * b(k,68) - b(k,110) = b(k,110) - lu(k,359) * b(k,68) - b(k,113) = b(k,113) - lu(k,360) * b(k,68) - b(k,114) = b(k,114) - lu(k,361) * b(k,68) - b(k,80) = b(k,80) - lu(k,363) * b(k,69) - b(k,92) = b(k,92) - lu(k,364) * b(k,69) - b(k,93) = b(k,93) - lu(k,365) * b(k,69) - b(k,95) = b(k,95) - lu(k,366) * b(k,69) - b(k,96) = b(k,96) - lu(k,367) * b(k,69) - b(k,100) = b(k,100) - lu(k,368) * b(k,69) - b(k,103) = b(k,103) - lu(k,369) * b(k,69) - b(k,104) = b(k,104) - lu(k,370) * b(k,69) - b(k,106) = b(k,106) - lu(k,371) * b(k,69) - b(k,108) = b(k,108) - lu(k,372) * b(k,69) - b(k,111) = b(k,111) - lu(k,373) * b(k,69) - b(k,113) = b(k,113) - lu(k,374) * b(k,69) - b(k,114) = b(k,114) - lu(k,375) * b(k,69) - b(k,75) = b(k,75) - lu(k,380) * b(k,70) - b(k,82) = b(k,82) - lu(k,381) * b(k,70) - b(k,88) = b(k,88) - lu(k,382) * b(k,70) - b(k,89) = b(k,89) - lu(k,383) * b(k,70) - b(k,94) = b(k,94) - lu(k,384) * b(k,70) - b(k,99) = b(k,99) - lu(k,385) * b(k,70) - b(k,100) = b(k,100) - lu(k,386) * b(k,70) - b(k,104) = b(k,104) - lu(k,387) * b(k,70) - b(k,105) = b(k,105) - lu(k,388) * b(k,70) - b(k,106) = b(k,106) - lu(k,389) * b(k,70) - b(k,112) = b(k,112) - lu(k,390) * b(k,70) - b(k,113) = b(k,113) - lu(k,391) * b(k,70) - b(k,114) = b(k,114) - lu(k,392) * b(k,70) - b(k,86) = b(k,86) - lu(k,394) * b(k,71) - b(k,92) = b(k,92) - lu(k,395) * b(k,71) - b(k,93) = b(k,93) - lu(k,396) * b(k,71) - b(k,95) = b(k,95) - lu(k,397) * b(k,71) - b(k,96) = b(k,96) - lu(k,398) * b(k,71) - b(k,98) = b(k,98) - lu(k,399) * b(k,71) - b(k,100) = b(k,100) - lu(k,400) * b(k,71) - b(k,103) = b(k,103) - lu(k,401) * b(k,71) - b(k,105) = b(k,105) - lu(k,402) * b(k,71) - b(k,106) = b(k,106) - lu(k,403) * b(k,71) - b(k,108) = b(k,108) - lu(k,404) * b(k,71) - b(k,111) = b(k,111) - lu(k,405) * b(k,71) - b(k,113) = b(k,113) - lu(k,406) * b(k,71) - b(k,114) = b(k,114) - lu(k,407) * b(k,71) - b(k,86) = b(k,86) - lu(k,410) * b(k,72) - b(k,92) = b(k,92) - lu(k,411) * b(k,72) - b(k,93) = b(k,93) - lu(k,412) * b(k,72) - b(k,95) = b(k,95) - lu(k,413) * b(k,72) - b(k,96) = b(k,96) - lu(k,414) * b(k,72) - b(k,98) = b(k,98) - lu(k,415) * b(k,72) - b(k,100) = b(k,100) - lu(k,416) * b(k,72) - b(k,103) = b(k,103) - lu(k,417) * b(k,72) - b(k,105) = b(k,105) - lu(k,418) * b(k,72) - b(k,106) = b(k,106) - lu(k,419) * b(k,72) - b(k,108) = b(k,108) - lu(k,420) * b(k,72) - b(k,111) = b(k,111) - lu(k,421) * b(k,72) - b(k,113) = b(k,113) - lu(k,422) * b(k,72) - b(k,114) = b(k,114) - lu(k,423) * b(k,72) - b(k,91) = b(k,91) - lu(k,425) * b(k,73) - b(k,92) = b(k,92) - lu(k,426) * b(k,73) - b(k,93) = b(k,93) - lu(k,427) * b(k,73) - b(k,94) = b(k,94) - lu(k,428) * b(k,73) - b(k,95) = b(k,95) - lu(k,429) * b(k,73) - b(k,96) = b(k,96) - lu(k,430) * b(k,73) - b(k,100) = b(k,100) - lu(k,431) * b(k,73) - b(k,103) = b(k,103) - lu(k,432) * b(k,73) - b(k,106) = b(k,106) - lu(k,433) * b(k,73) - b(k,108) = b(k,108) - lu(k,434) * b(k,73) - b(k,111) = b(k,111) - lu(k,435) * b(k,73) - b(k,113) = b(k,113) - lu(k,436) * b(k,73) - b(k,114) = b(k,114) - lu(k,437) * b(k,73) - b(k,87) = b(k,87) - lu(k,439) * b(k,74) - b(k,90) = b(k,90) - lu(k,440) * b(k,74) - b(k,91) = b(k,91) - lu(k,441) * b(k,74) - b(k,94) = b(k,94) - lu(k,442) * b(k,74) - b(k,99) = b(k,99) - lu(k,443) * b(k,74) - b(k,100) = b(k,100) - lu(k,444) * b(k,74) - b(k,102) = b(k,102) - lu(k,445) * b(k,74) - b(k,104) = b(k,104) - lu(k,446) * b(k,74) - b(k,106) = b(k,106) - lu(k,447) * b(k,74) - b(k,107) = b(k,107) - lu(k,448) * b(k,74) - b(k,109) = b(k,109) - lu(k,449) * b(k,74) - b(k,110) = b(k,110) - lu(k,450) * b(k,74) - b(k,113) = b(k,113) - lu(k,451) * b(k,74) - b(k,82) = b(k,82) - lu(k,455) * b(k,75) - b(k,83) = b(k,83) - lu(k,456) * b(k,75) - b(k,84) = b(k,84) - lu(k,457) * b(k,75) - b(k,88) = b(k,88) - lu(k,458) * b(k,75) - b(k,89) = b(k,89) - lu(k,459) * b(k,75) - b(k,99) = b(k,99) - lu(k,460) * b(k,75) - b(k,100) = b(k,100) - lu(k,461) * b(k,75) - b(k,104) = b(k,104) - lu(k,462) * b(k,75) - b(k,113) = b(k,113) - lu(k,463) * b(k,75) - b(k,114) = b(k,114) - lu(k,464) * b(k,75) - b(k,78) = b(k,78) - lu(k,466) * b(k,76) - b(k,92) = b(k,92) - lu(k,467) * b(k,76) - b(k,93) = b(k,93) - lu(k,468) * b(k,76) - b(k,95) = b(k,95) - lu(k,469) * b(k,76) - b(k,96) = b(k,96) - lu(k,470) * b(k,76) - b(k,97) = b(k,97) - lu(k,471) * b(k,76) - b(k,98) = b(k,98) - lu(k,472) * b(k,76) - b(k,100) = b(k,100) - lu(k,473) * b(k,76) - b(k,101) = b(k,101) - lu(k,474) * b(k,76) - b(k,103) = b(k,103) - lu(k,475) * b(k,76) - b(k,106) = b(k,106) - lu(k,476) * b(k,76) - b(k,108) = b(k,108) - lu(k,477) * b(k,76) - b(k,111) = b(k,111) - lu(k,478) * b(k,76) - b(k,113) = b(k,113) - lu(k,479) * b(k,76) - b(k,114) = b(k,114) - lu(k,480) * b(k,76) - b(k,83) = b(k,83) - lu(k,485) * b(k,77) - b(k,84) = b(k,84) - lu(k,486) * b(k,77) - b(k,88) = b(k,88) - lu(k,487) * b(k,77) - b(k,89) = b(k,89) - lu(k,488) * b(k,77) - b(k,94) = b(k,94) - lu(k,489) * b(k,77) - b(k,97) = b(k,97) - lu(k,490) * b(k,77) - b(k,98) = b(k,98) - lu(k,491) * b(k,77) - b(k,100) = b(k,100) - lu(k,492) * b(k,77) - b(k,101) = b(k,101) - lu(k,493) * b(k,77) - b(k,104) = b(k,104) - lu(k,494) * b(k,77) - b(k,105) = b(k,105) - lu(k,495) * b(k,77) - b(k,106) = b(k,106) - lu(k,496) * b(k,77) - b(k,107) = b(k,107) - lu(k,497) * b(k,77) - b(k,109) = b(k,109) - lu(k,498) * b(k,77) - b(k,110) = b(k,110) - lu(k,499) * b(k,77) - b(k,112) = b(k,112) - lu(k,500) * b(k,77) - b(k,113) = b(k,113) - lu(k,501) * b(k,77) - b(k,114) = b(k,114) - lu(k,502) * b(k,77) - b(k,87) = b(k,87) - lu(k,504) * b(k,78) - b(k,92) = b(k,92) - lu(k,505) * b(k,78) - b(k,93) = b(k,93) - lu(k,506) * b(k,78) - b(k,95) = b(k,95) - lu(k,507) * b(k,78) - b(k,96) = b(k,96) - lu(k,508) * b(k,78) - b(k,97) = b(k,97) - lu(k,509) * b(k,78) - b(k,100) = b(k,100) - lu(k,510) * b(k,78) - b(k,101) = b(k,101) - lu(k,511) * b(k,78) - b(k,103) = b(k,103) - lu(k,512) * b(k,78) - b(k,106) = b(k,106) - lu(k,513) * b(k,78) - b(k,108) = b(k,108) - lu(k,514) * b(k,78) - b(k,111) = b(k,111) - lu(k,515) * b(k,78) - b(k,114) = b(k,114) - lu(k,516) * b(k,78) + b(k,112) = b(k,112) - lu(k,276) * b(k,71) + b(k,127) = b(k,127) - lu(k,277) * b(k,71) + b(k,129) = b(k,129) - lu(k,278) * b(k,71) + b(k,137) = b(k,137) - lu(k,279) * b(k,71) + b(k,114) = b(k,114) - lu(k,282) * b(k,72) + b(k,121) = b(k,121) - lu(k,283) * b(k,72) + b(k,123) = b(k,123) - lu(k,284) * b(k,72) + b(k,137) = b(k,137) - lu(k,285) * b(k,72) + b(k,112) = b(k,112) - lu(k,290) * b(k,73) + b(k,114) = b(k,114) - lu(k,291) * b(k,73) + b(k,121) = b(k,121) - lu(k,292) * b(k,73) + b(k,123) = b(k,123) - lu(k,293) * b(k,73) + b(k,126) = b(k,126) - lu(k,294) * b(k,73) + b(k,131) = b(k,131) - lu(k,295) * b(k,73) + b(k,137) = b(k,137) - lu(k,296) * b(k,73) + b(k,76) = b(k,76) - lu(k,298) * b(k,74) + b(k,84) = b(k,84) - lu(k,299) * b(k,74) + b(k,88) = b(k,88) - lu(k,300) * b(k,74) + b(k,106) = b(k,106) - lu(k,301) * b(k,74) + b(k,119) = b(k,119) - lu(k,302) * b(k,74) + b(k,129) = b(k,129) - lu(k,303) * b(k,74) + b(k,131) = b(k,131) - lu(k,304) * b(k,74) + b(k,97) = b(k,97) - lu(k,307) * b(k,75) + b(k,104) = b(k,104) - lu(k,308) * b(k,75) + b(k,112) = b(k,112) - lu(k,309) * b(k,75) + b(k,119) = b(k,119) - lu(k,310) * b(k,75) + b(k,124) = b(k,124) - lu(k,311) * b(k,75) + b(k,136) = b(k,136) - lu(k,312) * b(k,75) + b(k,137) = b(k,137) - lu(k,313) * b(k,75) + b(k,84) = b(k,84) - lu(k,315) * b(k,76) + b(k,88) = b(k,88) - lu(k,316) * b(k,76) + b(k,116) = b(k,116) - lu(k,317) * b(k,76) + b(k,119) = b(k,119) - lu(k,318) * b(k,76) + b(k,126) = b(k,126) - lu(k,319) * b(k,76) + b(k,131) = b(k,131) - lu(k,320) * b(k,76) + b(k,112) = b(k,112) - lu(k,323) * b(k,77) + b(k,119) = b(k,119) - lu(k,324) * b(k,77) + b(k,124) = b(k,124) - lu(k,325) * b(k,77) + b(k,130) = b(k,130) - lu(k,326) * b(k,77) + b(k,136) = b(k,136) - lu(k,327) * b(k,77) + b(k,137) = b(k,137) - lu(k,328) * b(k,77) + b(k,97) = b(k,97) - lu(k,330) * b(k,78) + b(k,104) = b(k,104) - lu(k,331) * b(k,78) + b(k,106) = b(k,106) - lu(k,332) * b(k,78) + b(k,112) = b(k,112) - lu(k,333) * b(k,78) + b(k,119) = b(k,119) - lu(k,334) * b(k,78) + b(k,121) = b(k,121) - lu(k,335) * b(k,78) + b(k,137) = b(k,137) - lu(k,336) * b(k,78) + b(k,86) = b(k,86) - lu(k,339) * b(k,79) + b(k,87) = b(k,87) - lu(k,340) * b(k,79) + b(k,101) = b(k,101) - lu(k,341) * b(k,79) + b(k,112) = b(k,112) - lu(k,342) * b(k,79) + b(k,115) = b(k,115) - lu(k,343) * b(k,79) + b(k,118) = b(k,118) - lu(k,344) * b(k,79) + b(k,121) = b(k,121) - lu(k,345) * b(k,79) + b(k,137) = b(k,137) - lu(k,346) * b(k,79) + b(k,91) = b(k,91) - lu(k,349) * b(k,80) + b(k,110) = b(k,110) - lu(k,350) * b(k,80) + b(k,112) = b(k,112) - lu(k,351) * b(k,80) + b(k,119) = b(k,119) - lu(k,352) * b(k,80) + b(k,137) = b(k,137) - lu(k,353) * b(k,80) + b(k,112) = b(k,112) - lu(k,357) * b(k,81) + b(k,115) = b(k,115) - lu(k,358) * b(k,81) + b(k,118) = b(k,118) - lu(k,359) * b(k,81) + b(k,119) = b(k,119) - lu(k,360) * b(k,81) + b(k,124) = b(k,124) - lu(k,361) * b(k,81) + b(k,127) = b(k,127) - lu(k,362) * b(k,81) + b(k,130) = b(k,130) - lu(k,363) * b(k,81) + b(k,136) = b(k,136) - lu(k,364) * b(k,81) + b(k,137) = b(k,137) - lu(k,365) * b(k,81) + b(k,107) = b(k,107) - lu(k,367) * b(k,82) + b(k,111) = b(k,111) - lu(k,368) * b(k,82) + b(k,119) = b(k,119) - lu(k,369) * b(k,82) + b(k,127) = b(k,127) - lu(k,370) * b(k,82) + b(k,129) = b(k,129) - lu(k,371) * b(k,82) + b(k,131) = b(k,131) - lu(k,372) * b(k,82) + b(k,136) = b(k,136) - lu(k,373) * b(k,82) + b(k,89) = b(k,89) - lu(k,375) * b(k,83) + b(k,114) = b(k,114) - lu(k,376) * b(k,83) + b(k,125) = b(k,125) - lu(k,377) * b(k,83) + b(k,126) = b(k,126) - lu(k,378) * b(k,83) + b(k,131) = b(k,131) - lu(k,379) * b(k,83) + b(k,133) = b(k,133) - lu(k,380) * b(k,83) + b(k,134) = b(k,134) - lu(k,381) * b(k,83) + b(k,88) = b(k,88) - lu(k,386) * b(k,84) + b(k,106) = b(k,106) - lu(k,387) * b(k,84) + b(k,110) = b(k,110) - lu(k,388) * b(k,84) + b(k,112) = b(k,112) - lu(k,389) * b(k,84) + b(k,116) = b(k,116) - lu(k,390) * b(k,84) + b(k,119) = b(k,119) - lu(k,391) * b(k,84) + b(k,126) = b(k,126) - lu(k,392) * b(k,84) + b(k,129) = b(k,129) - lu(k,393) * b(k,84) + b(k,131) = b(k,131) - lu(k,394) * b(k,84) + b(k,135) = b(k,135) - lu(k,395) * b(k,84) + b(k,99) = b(k,99) - lu(k,399) * b(k,85) + b(k,100) = b(k,100) - lu(k,400) * b(k,85) + b(k,103) = b(k,103) - lu(k,401) * b(k,85) + b(k,115) = b(k,115) - lu(k,402) * b(k,85) + b(k,118) = b(k,118) - lu(k,403) * b(k,85) + b(k,119) = b(k,119) - lu(k,404) * b(k,85) + b(k,122) = b(k,122) - lu(k,405) * b(k,85) + b(k,127) = b(k,127) - lu(k,406) * b(k,85) + b(k,128) = b(k,128) - lu(k,407) * b(k,85) + b(k,129) = b(k,129) - lu(k,408) * b(k,85) + b(k,137) = b(k,137) - lu(k,409) * b(k,85) + b(k,87) = b(k,87) - lu(k,414) * b(k,86) + b(k,101) = b(k,101) - lu(k,415) * b(k,86) + b(k,105) = b(k,105) - lu(k,416) * b(k,86) + b(k,106) = b(k,106) - lu(k,417) * b(k,86) + b(k,110) = b(k,110) - lu(k,418) * b(k,86) + b(k,112) = b(k,112) - lu(k,419) * b(k,86) + b(k,115) = b(k,115) - lu(k,420) * b(k,86) + b(k,118) = b(k,118) - lu(k,421) * b(k,86) + b(k,119) = b(k,119) - lu(k,422) * b(k,86) + b(k,121) = b(k,121) - lu(k,423) * b(k,86) + b(k,124) = b(k,124) - lu(k,424) * b(k,86) + b(k,135) = b(k,135) - lu(k,425) * b(k,86) + b(k,136) = b(k,136) - lu(k,426) * b(k,86) + b(k,137) = b(k,137) - lu(k,427) * b(k,86) + b(k,105) = b(k,105) - lu(k,430) * b(k,87) + b(k,110) = b(k,110) - lu(k,431) * b(k,87) + b(k,112) = b(k,112) - lu(k,432) * b(k,87) + b(k,121) = b(k,121) - lu(k,433) * b(k,87) + b(k,127) = b(k,127) - lu(k,434) * b(k,87) + b(k,129) = b(k,129) - lu(k,435) * b(k,87) + b(k,130) = b(k,130) - lu(k,436) * b(k,87) + b(k,131) = b(k,131) - lu(k,437) * b(k,87) + b(k,136) = b(k,136) - lu(k,438) * b(k,87) + b(k,137) = b(k,137) - lu(k,439) * b(k,87) + b(k,106) = b(k,106) - lu(k,444) * b(k,88) + b(k,110) = b(k,110) - lu(k,445) * b(k,88) + b(k,112) = b(k,112) - lu(k,446) * b(k,88) + b(k,114) = b(k,114) - lu(k,447) * b(k,88) + b(k,116) = b(k,116) - lu(k,448) * b(k,88) + b(k,119) = b(k,119) - lu(k,449) * b(k,88) + b(k,121) = b(k,121) - lu(k,450) * b(k,88) + b(k,126) = b(k,126) - lu(k,451) * b(k,88) + b(k,127) = b(k,127) - lu(k,452) * b(k,88) + b(k,129) = b(k,129) - lu(k,453) * b(k,88) + b(k,131) = b(k,131) - lu(k,454) * b(k,88) + b(k,135) = b(k,135) - lu(k,455) * b(k,88) + b(k,112) = b(k,112) - lu(k,459) * b(k,89) + b(k,114) = b(k,114) - lu(k,460) * b(k,89) + b(k,119) = b(k,119) - lu(k,461) * b(k,89) + b(k,121) = b(k,121) - lu(k,462) * b(k,89) + b(k,123) = b(k,123) - lu(k,463) * b(k,89) + b(k,125) = b(k,125) - lu(k,464) * b(k,89) + b(k,126) = b(k,126) - lu(k,465) * b(k,89) + b(k,131) = b(k,131) - lu(k,466) * b(k,89) + b(k,133) = b(k,133) - lu(k,467) * b(k,89) + b(k,134) = b(k,134) - lu(k,468) * b(k,89) + b(k,137) = b(k,137) - lu(k,469) * b(k,89) + b(k,112) = b(k,112) - lu(k,471) * b(k,90) + b(k,116) = b(k,116) - lu(k,472) * b(k,90) + b(k,117) = b(k,117) - lu(k,473) * b(k,90) + b(k,120) = b(k,120) - lu(k,474) * b(k,90) + b(k,121) = b(k,121) - lu(k,475) * b(k,90) + b(k,122) = b(k,122) - lu(k,476) * b(k,90) + b(k,123) = b(k,123) - lu(k,477) * b(k,90) + b(k,126) = b(k,126) - lu(k,478) * b(k,90) + b(k,128) = b(k,128) - lu(k,479) * b(k,90) + b(k,129) = b(k,129) - lu(k,480) * b(k,90) + b(k,131) = b(k,131) - lu(k,481) * b(k,90) + b(k,135) = b(k,135) - lu(k,482) * b(k,90) + b(k,137) = b(k,137) - lu(k,483) * b(k,90) + b(k,97) = b(k,97) - lu(k,488) * b(k,91) + b(k,104) = b(k,104) - lu(k,489) * b(k,91) + b(k,110) = b(k,110) - lu(k,490) * b(k,91) + b(k,112) = b(k,112) - lu(k,491) * b(k,91) + b(k,119) = b(k,119) - lu(k,492) * b(k,91) + b(k,121) = b(k,121) - lu(k,493) * b(k,91) + b(k,127) = b(k,127) - lu(k,494) * b(k,91) + b(k,129) = b(k,129) - lu(k,495) * b(k,91) + b(k,130) = b(k,130) - lu(k,496) * b(k,91) + b(k,131) = b(k,131) - lu(k,497) * b(k,91) + b(k,134) = b(k,134) - lu(k,498) * b(k,91) + b(k,136) = b(k,136) - lu(k,499) * b(k,91) + b(k,137) = b(k,137) - lu(k,500) * b(k,91) + b(k,102) = b(k,102) - lu(k,502) * b(k,92) + b(k,116) = b(k,116) - lu(k,503) * b(k,92) + b(k,117) = b(k,117) - lu(k,504) * b(k,92) + b(k,119) = b(k,119) - lu(k,505) * b(k,92) + b(k,120) = b(k,120) - lu(k,506) * b(k,92) + b(k,121) = b(k,121) - lu(k,507) * b(k,92) + b(k,122) = b(k,122) - lu(k,508) * b(k,92) + b(k,123) = b(k,123) - lu(k,509) * b(k,92) + b(k,126) = b(k,126) - lu(k,510) * b(k,92) + b(k,128) = b(k,128) - lu(k,511) * b(k,92) + b(k,129) = b(k,129) - lu(k,512) * b(k,92) + b(k,131) = b(k,131) - lu(k,513) * b(k,92) + b(k,135) = b(k,135) - lu(k,514) * b(k,92) + b(k,137) = b(k,137) - lu(k,515) * b(k,92) + b(k,107) = b(k,107) - lu(k,517) * b(k,93) + b(k,116) = b(k,116) - lu(k,518) * b(k,93) + b(k,117) = b(k,117) - lu(k,519) * b(k,93) + b(k,120) = b(k,120) - lu(k,520) * b(k,93) + b(k,121) = b(k,121) - lu(k,521) * b(k,93) + b(k,122) = b(k,122) - lu(k,522) * b(k,93) + b(k,123) = b(k,123) - lu(k,523) * b(k,93) + b(k,124) = b(k,124) - lu(k,524) * b(k,93) + b(k,126) = b(k,126) - lu(k,525) * b(k,93) + b(k,128) = b(k,128) - lu(k,526) * b(k,93) + b(k,129) = b(k,129) - lu(k,527) * b(k,93) + b(k,131) = b(k,131) - lu(k,528) * b(k,93) + b(k,136) = b(k,136) - lu(k,529) * b(k,93) + b(k,137) = b(k,137) - lu(k,530) * b(k,93) end do end subroutine lu_slv02 subroutine lu_slv03( avec_len, lu, b ) @@ -469,215 +469,213 @@ subroutine lu_slv03( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,81) = b(k,81) - lu(k,520) * b(k,79) - b(k,87) = b(k,87) - lu(k,521) * b(k,79) - b(k,92) = b(k,92) - lu(k,522) * b(k,79) - b(k,93) = b(k,93) - lu(k,523) * b(k,79) - b(k,94) = b(k,94) - lu(k,524) * b(k,79) - b(k,95) = b(k,95) - lu(k,525) * b(k,79) - b(k,96) = b(k,96) - lu(k,526) * b(k,79) - b(k,97) = b(k,97) - lu(k,527) * b(k,79) - b(k,100) = b(k,100) - lu(k,528) * b(k,79) - b(k,101) = b(k,101) - lu(k,529) * b(k,79) - b(k,103) = b(k,103) - lu(k,530) * b(k,79) - b(k,104) = b(k,104) - lu(k,531) * b(k,79) - b(k,106) = b(k,106) - lu(k,532) * b(k,79) - b(k,108) = b(k,108) - lu(k,533) * b(k,79) - b(k,111) = b(k,111) - lu(k,534) * b(k,79) - b(k,113) = b(k,113) - lu(k,535) * b(k,79) - b(k,114) = b(k,114) - lu(k,536) * b(k,79) - b(k,81) = b(k,81) - lu(k,540) * b(k,80) - b(k,87) = b(k,87) - lu(k,541) * b(k,80) - b(k,90) = b(k,90) - lu(k,542) * b(k,80) - b(k,91) = b(k,91) - lu(k,543) * b(k,80) - b(k,92) = b(k,92) - lu(k,544) * b(k,80) - b(k,93) = b(k,93) - lu(k,545) * b(k,80) - b(k,94) = b(k,94) - lu(k,546) * b(k,80) - b(k,95) = b(k,95) - lu(k,547) * b(k,80) - b(k,96) = b(k,96) - lu(k,548) * b(k,80) - b(k,100) = b(k,100) - lu(k,549) * b(k,80) - b(k,103) = b(k,103) - lu(k,550) * b(k,80) - b(k,104) = b(k,104) - lu(k,551) * b(k,80) - b(k,106) = b(k,106) - lu(k,552) * b(k,80) - b(k,108) = b(k,108) - lu(k,553) * b(k,80) - b(k,111) = b(k,111) - lu(k,554) * b(k,80) - b(k,113) = b(k,113) - lu(k,555) * b(k,80) - b(k,114) = b(k,114) - lu(k,556) * b(k,80) - b(k,87) = b(k,87) - lu(k,561) * b(k,81) - b(k,92) = b(k,92) - lu(k,562) * b(k,81) - b(k,93) = b(k,93) - lu(k,563) * b(k,81) - b(k,94) = b(k,94) - lu(k,564) * b(k,81) - b(k,95) = b(k,95) - lu(k,565) * b(k,81) - b(k,96) = b(k,96) - lu(k,566) * b(k,81) - b(k,97) = b(k,97) - lu(k,567) * b(k,81) - b(k,100) = b(k,100) - lu(k,568) * b(k,81) - b(k,101) = b(k,101) - lu(k,569) * b(k,81) - b(k,103) = b(k,103) - lu(k,570) * b(k,81) - b(k,104) = b(k,104) - lu(k,571) * b(k,81) - b(k,106) = b(k,106) - lu(k,572) * b(k,81) - b(k,108) = b(k,108) - lu(k,573) * b(k,81) - b(k,111) = b(k,111) - lu(k,574) * b(k,81) - b(k,113) = b(k,113) - lu(k,575) * b(k,81) - b(k,114) = b(k,114) - lu(k,576) * b(k,81) - b(k,83) = b(k,83) - lu(k,585) * b(k,82) - b(k,84) = b(k,84) - lu(k,586) * b(k,82) - b(k,88) = b(k,88) - lu(k,587) * b(k,82) - b(k,89) = b(k,89) - lu(k,588) * b(k,82) - b(k,94) = b(k,94) - lu(k,589) * b(k,82) - b(k,97) = b(k,97) - lu(k,590) * b(k,82) - b(k,98) = b(k,98) - lu(k,591) * b(k,82) - b(k,99) = b(k,99) - lu(k,592) * b(k,82) - b(k,100) = b(k,100) - lu(k,593) * b(k,82) - b(k,101) = b(k,101) - lu(k,594) * b(k,82) - b(k,104) = b(k,104) - lu(k,595) * b(k,82) - b(k,105) = b(k,105) - lu(k,596) * b(k,82) - b(k,106) = b(k,106) - lu(k,597) * b(k,82) - b(k,112) = b(k,112) - lu(k,598) * b(k,82) - b(k,113) = b(k,113) - lu(k,599) * b(k,82) - b(k,114) = b(k,114) - lu(k,600) * b(k,82) - b(k,84) = b(k,84) - lu(k,607) * b(k,83) - b(k,88) = b(k,88) - lu(k,608) * b(k,83) - b(k,89) = b(k,89) - lu(k,609) * b(k,83) - b(k,94) = b(k,94) - lu(k,610) * b(k,83) - b(k,97) = b(k,97) - lu(k,611) * b(k,83) - b(k,98) = b(k,98) - lu(k,612) * b(k,83) - b(k,99) = b(k,99) - lu(k,613) * b(k,83) - b(k,100) = b(k,100) - lu(k,614) * b(k,83) - b(k,101) = b(k,101) - lu(k,615) * b(k,83) - b(k,104) = b(k,104) - lu(k,616) * b(k,83) - b(k,105) = b(k,105) - lu(k,617) * b(k,83) - b(k,106) = b(k,106) - lu(k,618) * b(k,83) - b(k,107) = b(k,107) - lu(k,619) * b(k,83) - b(k,109) = b(k,109) - lu(k,620) * b(k,83) - b(k,110) = b(k,110) - lu(k,621) * b(k,83) - b(k,112) = b(k,112) - lu(k,622) * b(k,83) - b(k,113) = b(k,113) - lu(k,623) * b(k,83) - b(k,114) = b(k,114) - lu(k,624) * b(k,83) - b(k,88) = b(k,88) - lu(k,638) * b(k,84) - b(k,89) = b(k,89) - lu(k,639) * b(k,84) - b(k,94) = b(k,94) - lu(k,640) * b(k,84) - b(k,95) = b(k,95) - lu(k,641) * b(k,84) - b(k,97) = b(k,97) - lu(k,642) * b(k,84) - b(k,98) = b(k,98) - lu(k,643) * b(k,84) - b(k,99) = b(k,99) - lu(k,644) * b(k,84) - b(k,100) = b(k,100) - lu(k,645) * b(k,84) - b(k,101) = b(k,101) - lu(k,646) * b(k,84) - b(k,102) = b(k,102) - lu(k,647) * b(k,84) - b(k,103) = b(k,103) - lu(k,648) * b(k,84) - b(k,104) = b(k,104) - lu(k,649) * b(k,84) - b(k,105) = b(k,105) - lu(k,650) * b(k,84) - b(k,106) = b(k,106) - lu(k,651) * b(k,84) - b(k,107) = b(k,107) - lu(k,652) * b(k,84) - b(k,109) = b(k,109) - lu(k,653) * b(k,84) - b(k,110) = b(k,110) - lu(k,654) * b(k,84) - b(k,112) = b(k,112) - lu(k,655) * b(k,84) - b(k,113) = b(k,113) - lu(k,656) * b(k,84) - b(k,114) = b(k,114) - lu(k,657) * b(k,84) - b(k,86) = b(k,86) - lu(k,661) * b(k,85) - b(k,87) = b(k,87) - lu(k,662) * b(k,85) - b(k,88) = b(k,88) - lu(k,663) * b(k,85) - b(k,89) = b(k,89) - lu(k,664) * b(k,85) - b(k,90) = b(k,90) - lu(k,665) * b(k,85) - b(k,91) = b(k,91) - lu(k,666) * b(k,85) - b(k,92) = b(k,92) - lu(k,667) * b(k,85) - b(k,93) = b(k,93) - lu(k,668) * b(k,85) - b(k,94) = b(k,94) - lu(k,669) * b(k,85) - b(k,95) = b(k,95) - lu(k,670) * b(k,85) - b(k,96) = b(k,96) - lu(k,671) * b(k,85) - b(k,98) = b(k,98) - lu(k,672) * b(k,85) - b(k,99) = b(k,99) - lu(k,673) * b(k,85) - b(k,100) = b(k,100) - lu(k,674) * b(k,85) - b(k,102) = b(k,102) - lu(k,675) * b(k,85) - b(k,103) = b(k,103) - lu(k,676) * b(k,85) - b(k,104) = b(k,104) - lu(k,677) * b(k,85) - b(k,105) = b(k,105) - lu(k,678) * b(k,85) - b(k,106) = b(k,106) - lu(k,679) * b(k,85) - b(k,107) = b(k,107) - lu(k,680) * b(k,85) - b(k,108) = b(k,108) - lu(k,681) * b(k,85) - b(k,109) = b(k,109) - lu(k,682) * b(k,85) - b(k,110) = b(k,110) - lu(k,683) * b(k,85) - b(k,111) = b(k,111) - lu(k,684) * b(k,85) - b(k,112) = b(k,112) - lu(k,685) * b(k,85) - b(k,113) = b(k,113) - lu(k,686) * b(k,85) - b(k,114) = b(k,114) - lu(k,687) * b(k,85) - b(k,87) = b(k,87) - lu(k,691) * b(k,86) - b(k,91) = b(k,91) - lu(k,692) * b(k,86) - b(k,92) = b(k,92) - lu(k,693) * b(k,86) - b(k,93) = b(k,93) - lu(k,694) * b(k,86) - b(k,94) = b(k,94) - lu(k,695) * b(k,86) - b(k,95) = b(k,95) - lu(k,696) * b(k,86) - b(k,96) = b(k,96) - lu(k,697) * b(k,86) - b(k,98) = b(k,98) - lu(k,698) * b(k,86) - b(k,100) = b(k,100) - lu(k,699) * b(k,86) - b(k,101) = b(k,101) - lu(k,700) * b(k,86) - b(k,103) = b(k,103) - lu(k,701) * b(k,86) - b(k,105) = b(k,105) - lu(k,702) * b(k,86) - b(k,106) = b(k,106) - lu(k,703) * b(k,86) - b(k,107) = b(k,107) - lu(k,704) * b(k,86) - b(k,108) = b(k,108) - lu(k,705) * b(k,86) - b(k,111) = b(k,111) - lu(k,706) * b(k,86) - b(k,113) = b(k,113) - lu(k,707) * b(k,86) - b(k,114) = b(k,114) - lu(k,708) * b(k,86) - b(k,91) = b(k,91) - lu(k,714) * b(k,87) - b(k,92) = b(k,92) - lu(k,715) * b(k,87) - b(k,93) = b(k,93) - lu(k,716) * b(k,87) - b(k,94) = b(k,94) - lu(k,717) * b(k,87) - b(k,95) = b(k,95) - lu(k,718) * b(k,87) - b(k,96) = b(k,96) - lu(k,719) * b(k,87) - b(k,97) = b(k,97) - lu(k,720) * b(k,87) - b(k,98) = b(k,98) - lu(k,721) * b(k,87) - b(k,99) = b(k,99) - lu(k,722) * b(k,87) - b(k,100) = b(k,100) - lu(k,723) * b(k,87) - b(k,101) = b(k,101) - lu(k,724) * b(k,87) - b(k,103) = b(k,103) - lu(k,725) * b(k,87) - b(k,104) = b(k,104) - lu(k,726) * b(k,87) - b(k,105) = b(k,105) - lu(k,727) * b(k,87) - b(k,106) = b(k,106) - lu(k,728) * b(k,87) - b(k,107) = b(k,107) - lu(k,729) * b(k,87) - b(k,108) = b(k,108) - lu(k,730) * b(k,87) - b(k,111) = b(k,111) - lu(k,731) * b(k,87) - b(k,113) = b(k,113) - lu(k,732) * b(k,87) - b(k,114) = b(k,114) - lu(k,733) * b(k,87) - b(k,89) = b(k,89) - lu(k,748) * b(k,88) - b(k,94) = b(k,94) - lu(k,749) * b(k,88) - b(k,95) = b(k,95) - lu(k,750) * b(k,88) - b(k,96) = b(k,96) - lu(k,751) * b(k,88) - b(k,97) = b(k,97) - lu(k,752) * b(k,88) - b(k,98) = b(k,98) - lu(k,753) * b(k,88) - b(k,99) = b(k,99) - lu(k,754) * b(k,88) - b(k,100) = b(k,100) - lu(k,755) * b(k,88) - b(k,101) = b(k,101) - lu(k,756) * b(k,88) - b(k,102) = b(k,102) - lu(k,757) * b(k,88) - b(k,103) = b(k,103) - lu(k,758) * b(k,88) - b(k,104) = b(k,104) - lu(k,759) * b(k,88) - b(k,105) = b(k,105) - lu(k,760) * b(k,88) - b(k,106) = b(k,106) - lu(k,761) * b(k,88) - b(k,107) = b(k,107) - lu(k,762) * b(k,88) - b(k,109) = b(k,109) - lu(k,763) * b(k,88) - b(k,110) = b(k,110) - lu(k,764) * b(k,88) - b(k,112) = b(k,112) - lu(k,765) * b(k,88) - b(k,113) = b(k,113) - lu(k,766) * b(k,88) - b(k,114) = b(k,114) - lu(k,767) * b(k,88) - b(k,92) = b(k,92) - lu(k,795) * b(k,89) - b(k,94) = b(k,94) - lu(k,796) * b(k,89) - b(k,95) = b(k,95) - lu(k,797) * b(k,89) - b(k,96) = b(k,96) - lu(k,798) * b(k,89) - b(k,97) = b(k,97) - lu(k,799) * b(k,89) - b(k,98) = b(k,98) - lu(k,800) * b(k,89) - b(k,99) = b(k,99) - lu(k,801) * b(k,89) - b(k,100) = b(k,100) - lu(k,802) * b(k,89) - b(k,101) = b(k,101) - lu(k,803) * b(k,89) - b(k,102) = b(k,102) - lu(k,804) * b(k,89) - b(k,103) = b(k,103) - lu(k,805) * b(k,89) - b(k,104) = b(k,104) - lu(k,806) * b(k,89) - b(k,105) = b(k,105) - lu(k,807) * b(k,89) - b(k,106) = b(k,106) - lu(k,808) * b(k,89) - b(k,107) = b(k,107) - lu(k,809) * b(k,89) - b(k,109) = b(k,109) - lu(k,810) * b(k,89) - b(k,110) = b(k,110) - lu(k,811) * b(k,89) - b(k,112) = b(k,112) - lu(k,812) * b(k,89) - b(k,113) = b(k,113) - lu(k,813) * b(k,89) - b(k,114) = b(k,114) - lu(k,814) * b(k,89) + b(k,107) = b(k,107) - lu(k,533) * b(k,94) + b(k,116) = b(k,116) - lu(k,534) * b(k,94) + b(k,117) = b(k,117) - lu(k,535) * b(k,94) + b(k,120) = b(k,120) - lu(k,536) * b(k,94) + b(k,121) = b(k,121) - lu(k,537) * b(k,94) + b(k,122) = b(k,122) - lu(k,538) * b(k,94) + b(k,123) = b(k,123) - lu(k,539) * b(k,94) + b(k,124) = b(k,124) - lu(k,540) * b(k,94) + b(k,126) = b(k,126) - lu(k,541) * b(k,94) + b(k,128) = b(k,128) - lu(k,542) * b(k,94) + b(k,129) = b(k,129) - lu(k,543) * b(k,94) + b(k,131) = b(k,131) - lu(k,544) * b(k,94) + b(k,136) = b(k,136) - lu(k,545) * b(k,94) + b(k,137) = b(k,137) - lu(k,546) * b(k,94) + b(k,111) = b(k,111) - lu(k,548) * b(k,95) + b(k,116) = b(k,116) - lu(k,549) * b(k,95) + b(k,117) = b(k,117) - lu(k,550) * b(k,95) + b(k,120) = b(k,120) - lu(k,551) * b(k,95) + b(k,121) = b(k,121) - lu(k,552) * b(k,95) + b(k,122) = b(k,122) - lu(k,553) * b(k,95) + b(k,123) = b(k,123) - lu(k,554) * b(k,95) + b(k,126) = b(k,126) - lu(k,555) * b(k,95) + b(k,127) = b(k,127) - lu(k,556) * b(k,95) + b(k,128) = b(k,128) - lu(k,557) * b(k,95) + b(k,129) = b(k,129) - lu(k,558) * b(k,95) + b(k,131) = b(k,131) - lu(k,559) * b(k,95) + b(k,137) = b(k,137) - lu(k,560) * b(k,95) + b(k,99) = b(k,99) - lu(k,562) * b(k,96) + b(k,115) = b(k,115) - lu(k,563) * b(k,96) + b(k,116) = b(k,116) - lu(k,564) * b(k,96) + b(k,117) = b(k,117) - lu(k,565) * b(k,96) + b(k,118) = b(k,118) - lu(k,566) * b(k,96) + b(k,120) = b(k,120) - lu(k,567) * b(k,96) + b(k,121) = b(k,121) - lu(k,568) * b(k,96) + b(k,122) = b(k,122) - lu(k,569) * b(k,96) + b(k,123) = b(k,123) - lu(k,570) * b(k,96) + b(k,124) = b(k,124) - lu(k,571) * b(k,96) + b(k,126) = b(k,126) - lu(k,572) * b(k,96) + b(k,128) = b(k,128) - lu(k,573) * b(k,96) + b(k,129) = b(k,129) - lu(k,574) * b(k,96) + b(k,131) = b(k,131) - lu(k,575) * b(k,96) + b(k,137) = b(k,137) - lu(k,576) * b(k,96) + b(k,104) = b(k,104) - lu(k,580) * b(k,97) + b(k,105) = b(k,105) - lu(k,581) * b(k,97) + b(k,106) = b(k,106) - lu(k,582) * b(k,97) + b(k,110) = b(k,110) - lu(k,583) * b(k,97) + b(k,112) = b(k,112) - lu(k,584) * b(k,97) + b(k,119) = b(k,119) - lu(k,585) * b(k,97) + b(k,121) = b(k,121) - lu(k,586) * b(k,97) + b(k,131) = b(k,131) - lu(k,587) * b(k,97) + b(k,134) = b(k,134) - lu(k,588) * b(k,97) + b(k,135) = b(k,135) - lu(k,589) * b(k,97) + b(k,137) = b(k,137) - lu(k,590) * b(k,97) + b(k,109) = b(k,109) - lu(k,592) * b(k,98) + b(k,111) = b(k,111) - lu(k,593) * b(k,98) + b(k,113) = b(k,113) - lu(k,594) * b(k,98) + b(k,114) = b(k,114) - lu(k,595) * b(k,98) + b(k,119) = b(k,119) - lu(k,596) * b(k,98) + b(k,121) = b(k,121) - lu(k,597) * b(k,98) + b(k,125) = b(k,125) - lu(k,598) * b(k,98) + b(k,127) = b(k,127) - lu(k,599) * b(k,98) + b(k,129) = b(k,129) - lu(k,600) * b(k,98) + b(k,131) = b(k,131) - lu(k,601) * b(k,98) + b(k,132) = b(k,132) - lu(k,602) * b(k,98) + b(k,133) = b(k,133) - lu(k,603) * b(k,98) + b(k,134) = b(k,134) - lu(k,604) * b(k,98) + b(k,135) = b(k,135) - lu(k,605) * b(k,98) + b(k,109) = b(k,109) - lu(k,607) * b(k,99) + b(k,115) = b(k,115) - lu(k,608) * b(k,99) + b(k,116) = b(k,116) - lu(k,609) * b(k,99) + b(k,117) = b(k,117) - lu(k,610) * b(k,99) + b(k,118) = b(k,118) - lu(k,611) * b(k,99) + b(k,120) = b(k,120) - lu(k,612) * b(k,99) + b(k,122) = b(k,122) - lu(k,613) * b(k,99) + b(k,123) = b(k,123) - lu(k,614) * b(k,99) + b(k,126) = b(k,126) - lu(k,615) * b(k,99) + b(k,128) = b(k,128) - lu(k,616) * b(k,99) + b(k,129) = b(k,129) - lu(k,617) * b(k,99) + b(k,131) = b(k,131) - lu(k,618) * b(k,99) + b(k,137) = b(k,137) - lu(k,619) * b(k,99) + b(k,103) = b(k,103) - lu(k,623) * b(k,100) + b(k,109) = b(k,109) - lu(k,624) * b(k,100) + b(k,115) = b(k,115) - lu(k,625) * b(k,100) + b(k,116) = b(k,116) - lu(k,626) * b(k,100) + b(k,117) = b(k,117) - lu(k,627) * b(k,100) + b(k,118) = b(k,118) - lu(k,628) * b(k,100) + b(k,119) = b(k,119) - lu(k,629) * b(k,100) + b(k,120) = b(k,120) - lu(k,630) * b(k,100) + b(k,121) = b(k,121) - lu(k,631) * b(k,100) + b(k,122) = b(k,122) - lu(k,632) * b(k,100) + b(k,123) = b(k,123) - lu(k,633) * b(k,100) + b(k,126) = b(k,126) - lu(k,634) * b(k,100) + b(k,127) = b(k,127) - lu(k,635) * b(k,100) + b(k,128) = b(k,128) - lu(k,636) * b(k,100) + b(k,129) = b(k,129) - lu(k,637) * b(k,100) + b(k,131) = b(k,131) - lu(k,638) * b(k,100) + b(k,137) = b(k,137) - lu(k,639) * b(k,100) + b(k,105) = b(k,105) - lu(k,645) * b(k,101) + b(k,106) = b(k,106) - lu(k,646) * b(k,101) + b(k,110) = b(k,110) - lu(k,647) * b(k,101) + b(k,112) = b(k,112) - lu(k,648) * b(k,101) + b(k,114) = b(k,114) - lu(k,649) * b(k,101) + b(k,115) = b(k,115) - lu(k,650) * b(k,101) + b(k,118) = b(k,118) - lu(k,651) * b(k,101) + b(k,119) = b(k,119) - lu(k,652) * b(k,101) + b(k,121) = b(k,121) - lu(k,653) * b(k,101) + b(k,124) = b(k,124) - lu(k,654) * b(k,101) + b(k,127) = b(k,127) - lu(k,655) * b(k,101) + b(k,129) = b(k,129) - lu(k,656) * b(k,101) + b(k,130) = b(k,130) - lu(k,657) * b(k,101) + b(k,131) = b(k,131) - lu(k,658) * b(k,101) + b(k,132) = b(k,132) - lu(k,659) * b(k,101) + b(k,133) = b(k,133) - lu(k,660) * b(k,101) + b(k,135) = b(k,135) - lu(k,661) * b(k,101) + b(k,136) = b(k,136) - lu(k,662) * b(k,101) + b(k,137) = b(k,137) - lu(k,663) * b(k,101) + b(k,103) = b(k,103) - lu(k,667) * b(k,102) + b(k,109) = b(k,109) - lu(k,668) * b(k,102) + b(k,111) = b(k,111) - lu(k,669) * b(k,102) + b(k,113) = b(k,113) - lu(k,670) * b(k,102) + b(k,116) = b(k,116) - lu(k,671) * b(k,102) + b(k,117) = b(k,117) - lu(k,672) * b(k,102) + b(k,119) = b(k,119) - lu(k,673) * b(k,102) + b(k,120) = b(k,120) - lu(k,674) * b(k,102) + b(k,121) = b(k,121) - lu(k,675) * b(k,102) + b(k,122) = b(k,122) - lu(k,676) * b(k,102) + b(k,123) = b(k,123) - lu(k,677) * b(k,102) + b(k,126) = b(k,126) - lu(k,678) * b(k,102) + b(k,127) = b(k,127) - lu(k,679) * b(k,102) + b(k,128) = b(k,128) - lu(k,680) * b(k,102) + b(k,129) = b(k,129) - lu(k,681) * b(k,102) + b(k,131) = b(k,131) - lu(k,682) * b(k,102) + b(k,135) = b(k,135) - lu(k,683) * b(k,102) + b(k,137) = b(k,137) - lu(k,684) * b(k,102) + b(k,109) = b(k,109) - lu(k,689) * b(k,103) + b(k,115) = b(k,115) - lu(k,690) * b(k,103) + b(k,116) = b(k,116) - lu(k,691) * b(k,103) + b(k,117) = b(k,117) - lu(k,692) * b(k,103) + b(k,118) = b(k,118) - lu(k,693) * b(k,103) + b(k,119) = b(k,119) - lu(k,694) * b(k,103) + b(k,120) = b(k,120) - lu(k,695) * b(k,103) + b(k,121) = b(k,121) - lu(k,696) * b(k,103) + b(k,122) = b(k,122) - lu(k,697) * b(k,103) + b(k,123) = b(k,123) - lu(k,698) * b(k,103) + b(k,126) = b(k,126) - lu(k,699) * b(k,103) + b(k,127) = b(k,127) - lu(k,700) * b(k,103) + b(k,128) = b(k,128) - lu(k,701) * b(k,103) + b(k,129) = b(k,129) - lu(k,702) * b(k,103) + b(k,131) = b(k,131) - lu(k,703) * b(k,103) + b(k,137) = b(k,137) - lu(k,704) * b(k,103) + b(k,105) = b(k,105) - lu(k,713) * b(k,104) + b(k,106) = b(k,106) - lu(k,714) * b(k,104) + b(k,110) = b(k,110) - lu(k,715) * b(k,104) + b(k,112) = b(k,112) - lu(k,716) * b(k,104) + b(k,115) = b(k,115) - lu(k,717) * b(k,104) + b(k,118) = b(k,118) - lu(k,718) * b(k,104) + b(k,119) = b(k,119) - lu(k,719) * b(k,104) + b(k,121) = b(k,121) - lu(k,720) * b(k,104) + b(k,124) = b(k,124) - lu(k,721) * b(k,104) + b(k,127) = b(k,127) - lu(k,722) * b(k,104) + b(k,129) = b(k,129) - lu(k,723) * b(k,104) + b(k,130) = b(k,130) - lu(k,724) * b(k,104) + b(k,131) = b(k,131) - lu(k,725) * b(k,104) + b(k,134) = b(k,134) - lu(k,726) * b(k,104) + b(k,135) = b(k,135) - lu(k,727) * b(k,104) + b(k,136) = b(k,136) - lu(k,728) * b(k,104) + b(k,137) = b(k,137) - lu(k,729) * b(k,104) + b(k,106) = b(k,106) - lu(k,736) * b(k,105) + b(k,110) = b(k,110) - lu(k,737) * b(k,105) + b(k,112) = b(k,112) - lu(k,738) * b(k,105) + b(k,114) = b(k,114) - lu(k,739) * b(k,105) + b(k,115) = b(k,115) - lu(k,740) * b(k,105) + b(k,118) = b(k,118) - lu(k,741) * b(k,105) + b(k,119) = b(k,119) - lu(k,742) * b(k,105) + b(k,121) = b(k,121) - lu(k,743) * b(k,105) + b(k,124) = b(k,124) - lu(k,744) * b(k,105) + b(k,127) = b(k,127) - lu(k,745) * b(k,105) + b(k,129) = b(k,129) - lu(k,746) * b(k,105) + b(k,130) = b(k,130) - lu(k,747) * b(k,105) + b(k,131) = b(k,131) - lu(k,748) * b(k,105) + b(k,132) = b(k,132) - lu(k,749) * b(k,105) + b(k,133) = b(k,133) - lu(k,750) * b(k,105) + b(k,134) = b(k,134) - lu(k,751) * b(k,105) + b(k,135) = b(k,135) - lu(k,752) * b(k,105) + b(k,136) = b(k,136) - lu(k,753) * b(k,105) + b(k,137) = b(k,137) - lu(k,754) * b(k,105) + b(k,110) = b(k,110) - lu(k,785) * b(k,106) + b(k,112) = b(k,112) - lu(k,786) * b(k,106) + b(k,114) = b(k,114) - lu(k,787) * b(k,106) + b(k,115) = b(k,115) - lu(k,788) * b(k,106) + b(k,118) = b(k,118) - lu(k,789) * b(k,106) + b(k,119) = b(k,119) - lu(k,790) * b(k,106) + b(k,121) = b(k,121) - lu(k,791) * b(k,106) + b(k,123) = b(k,123) - lu(k,792) * b(k,106) + b(k,124) = b(k,124) - lu(k,793) * b(k,106) + b(k,125) = b(k,125) - lu(k,794) * b(k,106) + b(k,126) = b(k,126) - lu(k,795) * b(k,106) + b(k,127) = b(k,127) - lu(k,796) * b(k,106) + b(k,129) = b(k,129) - lu(k,797) * b(k,106) + b(k,130) = b(k,130) - lu(k,798) * b(k,106) + b(k,131) = b(k,131) - lu(k,799) * b(k,106) + b(k,132) = b(k,132) - lu(k,800) * b(k,106) + b(k,133) = b(k,133) - lu(k,801) * b(k,106) + b(k,134) = b(k,134) - lu(k,802) * b(k,106) + b(k,135) = b(k,135) - lu(k,803) * b(k,106) + b(k,136) = b(k,136) - lu(k,804) * b(k,106) + b(k,137) = b(k,137) - lu(k,805) * b(k,106) end do end subroutine lu_slv03 subroutine lu_slv04( avec_len, lu, b ) @@ -698,215 +696,226 @@ subroutine lu_slv04( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,91) = b(k,91) - lu(k,823) * b(k,90) - b(k,92) = b(k,92) - lu(k,824) * b(k,90) - b(k,93) = b(k,93) - lu(k,825) * b(k,90) - b(k,94) = b(k,94) - lu(k,826) * b(k,90) - b(k,95) = b(k,95) - lu(k,827) * b(k,90) - b(k,96) = b(k,96) - lu(k,828) * b(k,90) - b(k,97) = b(k,97) - lu(k,829) * b(k,90) - b(k,98) = b(k,98) - lu(k,830) * b(k,90) - b(k,99) = b(k,99) - lu(k,831) * b(k,90) - b(k,100) = b(k,100) - lu(k,832) * b(k,90) - b(k,101) = b(k,101) - lu(k,833) * b(k,90) - b(k,102) = b(k,102) - lu(k,834) * b(k,90) - b(k,103) = b(k,103) - lu(k,835) * b(k,90) - b(k,104) = b(k,104) - lu(k,836) * b(k,90) - b(k,105) = b(k,105) - lu(k,837) * b(k,90) - b(k,106) = b(k,106) - lu(k,838) * b(k,90) - b(k,107) = b(k,107) - lu(k,839) * b(k,90) - b(k,108) = b(k,108) - lu(k,840) * b(k,90) - b(k,109) = b(k,109) - lu(k,841) * b(k,90) - b(k,110) = b(k,110) - lu(k,842) * b(k,90) - b(k,111) = b(k,111) - lu(k,843) * b(k,90) - b(k,112) = b(k,112) - lu(k,844) * b(k,90) - b(k,113) = b(k,113) - lu(k,845) * b(k,90) - b(k,114) = b(k,114) - lu(k,846) * b(k,90) - b(k,92) = b(k,92) - lu(k,853) * b(k,91) - b(k,93) = b(k,93) - lu(k,854) * b(k,91) - b(k,94) = b(k,94) - lu(k,855) * b(k,91) - b(k,95) = b(k,95) - lu(k,856) * b(k,91) - b(k,96) = b(k,96) - lu(k,857) * b(k,91) - b(k,97) = b(k,97) - lu(k,858) * b(k,91) - b(k,98) = b(k,98) - lu(k,859) * b(k,91) - b(k,99) = b(k,99) - lu(k,860) * b(k,91) - b(k,100) = b(k,100) - lu(k,861) * b(k,91) - b(k,101) = b(k,101) - lu(k,862) * b(k,91) - b(k,102) = b(k,102) - lu(k,863) * b(k,91) - b(k,103) = b(k,103) - lu(k,864) * b(k,91) - b(k,104) = b(k,104) - lu(k,865) * b(k,91) - b(k,105) = b(k,105) - lu(k,866) * b(k,91) - b(k,106) = b(k,106) - lu(k,867) * b(k,91) - b(k,107) = b(k,107) - lu(k,868) * b(k,91) - b(k,108) = b(k,108) - lu(k,869) * b(k,91) - b(k,109) = b(k,109) - lu(k,870) * b(k,91) - b(k,110) = b(k,110) - lu(k,871) * b(k,91) - b(k,111) = b(k,111) - lu(k,872) * b(k,91) - b(k,112) = b(k,112) - lu(k,873) * b(k,91) - b(k,113) = b(k,113) - lu(k,874) * b(k,91) - b(k,114) = b(k,114) - lu(k,875) * b(k,91) - b(k,93) = b(k,93) - lu(k,901) * b(k,92) - b(k,94) = b(k,94) - lu(k,902) * b(k,92) - b(k,95) = b(k,95) - lu(k,903) * b(k,92) - b(k,96) = b(k,96) - lu(k,904) * b(k,92) - b(k,97) = b(k,97) - lu(k,905) * b(k,92) - b(k,98) = b(k,98) - lu(k,906) * b(k,92) - b(k,99) = b(k,99) - lu(k,907) * b(k,92) - b(k,100) = b(k,100) - lu(k,908) * b(k,92) - b(k,101) = b(k,101) - lu(k,909) * b(k,92) - b(k,102) = b(k,102) - lu(k,910) * b(k,92) - b(k,103) = b(k,103) - lu(k,911) * b(k,92) - b(k,104) = b(k,104) - lu(k,912) * b(k,92) - b(k,105) = b(k,105) - lu(k,913) * b(k,92) - b(k,106) = b(k,106) - lu(k,914) * b(k,92) - b(k,107) = b(k,107) - lu(k,915) * b(k,92) - b(k,108) = b(k,108) - lu(k,916) * b(k,92) - b(k,109) = b(k,109) - lu(k,917) * b(k,92) - b(k,110) = b(k,110) - lu(k,918) * b(k,92) - b(k,111) = b(k,111) - lu(k,919) * b(k,92) - b(k,112) = b(k,112) - lu(k,920) * b(k,92) - b(k,113) = b(k,113) - lu(k,921) * b(k,92) - b(k,114) = b(k,114) - lu(k,922) * b(k,92) - b(k,94) = b(k,94) - lu(k,944) * b(k,93) - b(k,95) = b(k,95) - lu(k,945) * b(k,93) - b(k,96) = b(k,96) - lu(k,946) * b(k,93) - b(k,97) = b(k,97) - lu(k,947) * b(k,93) - b(k,98) = b(k,98) - lu(k,948) * b(k,93) - b(k,99) = b(k,99) - lu(k,949) * b(k,93) - b(k,100) = b(k,100) - lu(k,950) * b(k,93) - b(k,101) = b(k,101) - lu(k,951) * b(k,93) - b(k,102) = b(k,102) - lu(k,952) * b(k,93) - b(k,103) = b(k,103) - lu(k,953) * b(k,93) - b(k,104) = b(k,104) - lu(k,954) * b(k,93) - b(k,105) = b(k,105) - lu(k,955) * b(k,93) - b(k,106) = b(k,106) - lu(k,956) * b(k,93) - b(k,107) = b(k,107) - lu(k,957) * b(k,93) - b(k,108) = b(k,108) - lu(k,958) * b(k,93) - b(k,109) = b(k,109) - lu(k,959) * b(k,93) - b(k,110) = b(k,110) - lu(k,960) * b(k,93) - b(k,111) = b(k,111) - lu(k,961) * b(k,93) - b(k,112) = b(k,112) - lu(k,962) * b(k,93) - b(k,113) = b(k,113) - lu(k,963) * b(k,93) - b(k,114) = b(k,114) - lu(k,964) * b(k,93) - b(k,95) = b(k,95) - lu(k,991) * b(k,94) - b(k,96) = b(k,96) - lu(k,992) * b(k,94) - b(k,97) = b(k,97) - lu(k,993) * b(k,94) - b(k,98) = b(k,98) - lu(k,994) * b(k,94) - b(k,99) = b(k,99) - lu(k,995) * b(k,94) - b(k,100) = b(k,100) - lu(k,996) * b(k,94) - b(k,101) = b(k,101) - lu(k,997) * b(k,94) - b(k,102) = b(k,102) - lu(k,998) * b(k,94) - b(k,103) = b(k,103) - lu(k,999) * b(k,94) - b(k,104) = b(k,104) - lu(k,1000) * b(k,94) - b(k,105) = b(k,105) - lu(k,1001) * b(k,94) - b(k,106) = b(k,106) - lu(k,1002) * b(k,94) - b(k,107) = b(k,107) - lu(k,1003) * b(k,94) - b(k,108) = b(k,108) - lu(k,1004) * b(k,94) - b(k,109) = b(k,109) - lu(k,1005) * b(k,94) - b(k,110) = b(k,110) - lu(k,1006) * b(k,94) - b(k,111) = b(k,111) - lu(k,1007) * b(k,94) - b(k,112) = b(k,112) - lu(k,1008) * b(k,94) - b(k,113) = b(k,113) - lu(k,1009) * b(k,94) - b(k,114) = b(k,114) - lu(k,1010) * b(k,94) - b(k,96) = b(k,96) - lu(k,1034) * b(k,95) - b(k,97) = b(k,97) - lu(k,1035) * b(k,95) - b(k,98) = b(k,98) - lu(k,1036) * b(k,95) - b(k,99) = b(k,99) - lu(k,1037) * b(k,95) - b(k,100) = b(k,100) - lu(k,1038) * b(k,95) - b(k,101) = b(k,101) - lu(k,1039) * b(k,95) - b(k,102) = b(k,102) - lu(k,1040) * b(k,95) - b(k,103) = b(k,103) - lu(k,1041) * b(k,95) - b(k,104) = b(k,104) - lu(k,1042) * b(k,95) - b(k,105) = b(k,105) - lu(k,1043) * b(k,95) - b(k,106) = b(k,106) - lu(k,1044) * b(k,95) - b(k,107) = b(k,107) - lu(k,1045) * b(k,95) - b(k,108) = b(k,108) - lu(k,1046) * b(k,95) - b(k,109) = b(k,109) - lu(k,1047) * b(k,95) - b(k,110) = b(k,110) - lu(k,1048) * b(k,95) - b(k,111) = b(k,111) - lu(k,1049) * b(k,95) - b(k,112) = b(k,112) - lu(k,1050) * b(k,95) - b(k,113) = b(k,113) - lu(k,1051) * b(k,95) - b(k,114) = b(k,114) - lu(k,1052) * b(k,95) - b(k,97) = b(k,97) - lu(k,1076) * b(k,96) - b(k,98) = b(k,98) - lu(k,1077) * b(k,96) - b(k,99) = b(k,99) - lu(k,1078) * b(k,96) - b(k,100) = b(k,100) - lu(k,1079) * b(k,96) - b(k,101) = b(k,101) - lu(k,1080) * b(k,96) - b(k,102) = b(k,102) - lu(k,1081) * b(k,96) - b(k,103) = b(k,103) - lu(k,1082) * b(k,96) - b(k,104) = b(k,104) - lu(k,1083) * b(k,96) - b(k,105) = b(k,105) - lu(k,1084) * b(k,96) - b(k,106) = b(k,106) - lu(k,1085) * b(k,96) - b(k,107) = b(k,107) - lu(k,1086) * b(k,96) - b(k,108) = b(k,108) - lu(k,1087) * b(k,96) - b(k,109) = b(k,109) - lu(k,1088) * b(k,96) - b(k,110) = b(k,110) - lu(k,1089) * b(k,96) - b(k,111) = b(k,111) - lu(k,1090) * b(k,96) - b(k,112) = b(k,112) - lu(k,1091) * b(k,96) - b(k,113) = b(k,113) - lu(k,1092) * b(k,96) - b(k,114) = b(k,114) - lu(k,1093) * b(k,96) - b(k,98) = b(k,98) - lu(k,1116) * b(k,97) - b(k,99) = b(k,99) - lu(k,1117) * b(k,97) - b(k,100) = b(k,100) - lu(k,1118) * b(k,97) - b(k,101) = b(k,101) - lu(k,1119) * b(k,97) - b(k,102) = b(k,102) - lu(k,1120) * b(k,97) - b(k,103) = b(k,103) - lu(k,1121) * b(k,97) - b(k,104) = b(k,104) - lu(k,1122) * b(k,97) - b(k,105) = b(k,105) - lu(k,1123) * b(k,97) - b(k,106) = b(k,106) - lu(k,1124) * b(k,97) - b(k,107) = b(k,107) - lu(k,1125) * b(k,97) - b(k,108) = b(k,108) - lu(k,1126) * b(k,97) - b(k,109) = b(k,109) - lu(k,1127) * b(k,97) - b(k,110) = b(k,110) - lu(k,1128) * b(k,97) - b(k,111) = b(k,111) - lu(k,1129) * b(k,97) - b(k,112) = b(k,112) - lu(k,1130) * b(k,97) - b(k,113) = b(k,113) - lu(k,1131) * b(k,97) - b(k,114) = b(k,114) - lu(k,1132) * b(k,97) - b(k,99) = b(k,99) - lu(k,1161) * b(k,98) - b(k,100) = b(k,100) - lu(k,1162) * b(k,98) - b(k,101) = b(k,101) - lu(k,1163) * b(k,98) - b(k,102) = b(k,102) - lu(k,1164) * b(k,98) - b(k,103) = b(k,103) - lu(k,1165) * b(k,98) - b(k,104) = b(k,104) - lu(k,1166) * b(k,98) - b(k,105) = b(k,105) - lu(k,1167) * b(k,98) - b(k,106) = b(k,106) - lu(k,1168) * b(k,98) - b(k,107) = b(k,107) - lu(k,1169) * b(k,98) - b(k,108) = b(k,108) - lu(k,1170) * b(k,98) - b(k,109) = b(k,109) - lu(k,1171) * b(k,98) - b(k,110) = b(k,110) - lu(k,1172) * b(k,98) - b(k,111) = b(k,111) - lu(k,1173) * b(k,98) - b(k,112) = b(k,112) - lu(k,1174) * b(k,98) - b(k,113) = b(k,113) - lu(k,1175) * b(k,98) - b(k,114) = b(k,114) - lu(k,1176) * b(k,98) - b(k,100) = b(k,100) - lu(k,1203) * b(k,99) - b(k,101) = b(k,101) - lu(k,1204) * b(k,99) - b(k,102) = b(k,102) - lu(k,1205) * b(k,99) - b(k,103) = b(k,103) - lu(k,1206) * b(k,99) - b(k,104) = b(k,104) - lu(k,1207) * b(k,99) - b(k,105) = b(k,105) - lu(k,1208) * b(k,99) - b(k,106) = b(k,106) - lu(k,1209) * b(k,99) - b(k,107) = b(k,107) - lu(k,1210) * b(k,99) - b(k,108) = b(k,108) - lu(k,1211) * b(k,99) - b(k,109) = b(k,109) - lu(k,1212) * b(k,99) - b(k,110) = b(k,110) - lu(k,1213) * b(k,99) - b(k,111) = b(k,111) - lu(k,1214) * b(k,99) - b(k,112) = b(k,112) - lu(k,1215) * b(k,99) - b(k,113) = b(k,113) - lu(k,1216) * b(k,99) - b(k,114) = b(k,114) - lu(k,1217) * b(k,99) - b(k,101) = b(k,101) - lu(k,1253) * b(k,100) - b(k,102) = b(k,102) - lu(k,1254) * b(k,100) - b(k,103) = b(k,103) - lu(k,1255) * b(k,100) - b(k,104) = b(k,104) - lu(k,1256) * b(k,100) - b(k,105) = b(k,105) - lu(k,1257) * b(k,100) - b(k,106) = b(k,106) - lu(k,1258) * b(k,100) - b(k,107) = b(k,107) - lu(k,1259) * b(k,100) - b(k,108) = b(k,108) - lu(k,1260) * b(k,100) - b(k,109) = b(k,109) - lu(k,1261) * b(k,100) - b(k,110) = b(k,110) - lu(k,1262) * b(k,100) - b(k,111) = b(k,111) - lu(k,1263) * b(k,100) - b(k,112) = b(k,112) - lu(k,1264) * b(k,100) - b(k,113) = b(k,113) - lu(k,1265) * b(k,100) - b(k,114) = b(k,114) - lu(k,1266) * b(k,100) + b(k,109) = b(k,109) - lu(k,809) * b(k,107) + b(k,111) = b(k,111) - lu(k,810) * b(k,107) + b(k,114) = b(k,114) - lu(k,811) * b(k,107) + b(k,116) = b(k,116) - lu(k,812) * b(k,107) + b(k,117) = b(k,117) - lu(k,813) * b(k,107) + b(k,118) = b(k,118) - lu(k,814) * b(k,107) + b(k,120) = b(k,120) - lu(k,815) * b(k,107) + b(k,121) = b(k,121) - lu(k,816) * b(k,107) + b(k,122) = b(k,122) - lu(k,817) * b(k,107) + b(k,123) = b(k,123) - lu(k,818) * b(k,107) + b(k,124) = b(k,124) - lu(k,819) * b(k,107) + b(k,126) = b(k,126) - lu(k,820) * b(k,107) + b(k,127) = b(k,127) - lu(k,821) * b(k,107) + b(k,128) = b(k,128) - lu(k,822) * b(k,107) + b(k,129) = b(k,129) - lu(k,823) * b(k,107) + b(k,131) = b(k,131) - lu(k,824) * b(k,107) + b(k,136) = b(k,136) - lu(k,825) * b(k,107) + b(k,137) = b(k,137) - lu(k,826) * b(k,107) + b(k,109) = b(k,109) - lu(k,831) * b(k,108) + b(k,110) = b(k,110) - lu(k,832) * b(k,108) + b(k,111) = b(k,111) - lu(k,833) * b(k,108) + b(k,112) = b(k,112) - lu(k,834) * b(k,108) + b(k,113) = b(k,113) - lu(k,835) * b(k,108) + b(k,114) = b(k,114) - lu(k,836) * b(k,108) + b(k,116) = b(k,116) - lu(k,837) * b(k,108) + b(k,117) = b(k,117) - lu(k,838) * b(k,108) + b(k,118) = b(k,118) - lu(k,839) * b(k,108) + b(k,119) = b(k,119) - lu(k,840) * b(k,108) + b(k,120) = b(k,120) - lu(k,841) * b(k,108) + b(k,121) = b(k,121) - lu(k,842) * b(k,108) + b(k,122) = b(k,122) - lu(k,843) * b(k,108) + b(k,123) = b(k,123) - lu(k,844) * b(k,108) + b(k,124) = b(k,124) - lu(k,845) * b(k,108) + b(k,125) = b(k,125) - lu(k,846) * b(k,108) + b(k,126) = b(k,126) - lu(k,847) * b(k,108) + b(k,127) = b(k,127) - lu(k,848) * b(k,108) + b(k,128) = b(k,128) - lu(k,849) * b(k,108) + b(k,129) = b(k,129) - lu(k,850) * b(k,108) + b(k,130) = b(k,130) - lu(k,851) * b(k,108) + b(k,131) = b(k,131) - lu(k,852) * b(k,108) + b(k,132) = b(k,132) - lu(k,853) * b(k,108) + b(k,133) = b(k,133) - lu(k,854) * b(k,108) + b(k,134) = b(k,134) - lu(k,855) * b(k,108) + b(k,135) = b(k,135) - lu(k,856) * b(k,108) + b(k,136) = b(k,136) - lu(k,857) * b(k,108) + b(k,137) = b(k,137) - lu(k,858) * b(k,108) + b(k,111) = b(k,111) - lu(k,864) * b(k,109) + b(k,114) = b(k,114) - lu(k,865) * b(k,109) + b(k,115) = b(k,115) - lu(k,866) * b(k,109) + b(k,116) = b(k,116) - lu(k,867) * b(k,109) + b(k,117) = b(k,117) - lu(k,868) * b(k,109) + b(k,118) = b(k,118) - lu(k,869) * b(k,109) + b(k,119) = b(k,119) - lu(k,870) * b(k,109) + b(k,120) = b(k,120) - lu(k,871) * b(k,109) + b(k,121) = b(k,121) - lu(k,872) * b(k,109) + b(k,122) = b(k,122) - lu(k,873) * b(k,109) + b(k,123) = b(k,123) - lu(k,874) * b(k,109) + b(k,124) = b(k,124) - lu(k,875) * b(k,109) + b(k,126) = b(k,126) - lu(k,876) * b(k,109) + b(k,127) = b(k,127) - lu(k,877) * b(k,109) + b(k,128) = b(k,128) - lu(k,878) * b(k,109) + b(k,129) = b(k,129) - lu(k,879) * b(k,109) + b(k,131) = b(k,131) - lu(k,880) * b(k,109) + b(k,134) = b(k,134) - lu(k,881) * b(k,109) + b(k,136) = b(k,136) - lu(k,882) * b(k,109) + b(k,137) = b(k,137) - lu(k,883) * b(k,109) + b(k,112) = b(k,112) - lu(k,898) * b(k,110) + b(k,114) = b(k,114) - lu(k,899) * b(k,110) + b(k,115) = b(k,115) - lu(k,900) * b(k,110) + b(k,118) = b(k,118) - lu(k,901) * b(k,110) + b(k,119) = b(k,119) - lu(k,902) * b(k,110) + b(k,120) = b(k,120) - lu(k,903) * b(k,110) + b(k,121) = b(k,121) - lu(k,904) * b(k,110) + b(k,123) = b(k,123) - lu(k,905) * b(k,110) + b(k,124) = b(k,124) - lu(k,906) * b(k,110) + b(k,125) = b(k,125) - lu(k,907) * b(k,110) + b(k,126) = b(k,126) - lu(k,908) * b(k,110) + b(k,127) = b(k,127) - lu(k,909) * b(k,110) + b(k,129) = b(k,129) - lu(k,910) * b(k,110) + b(k,130) = b(k,130) - lu(k,911) * b(k,110) + b(k,131) = b(k,131) - lu(k,912) * b(k,110) + b(k,132) = b(k,132) - lu(k,913) * b(k,110) + b(k,133) = b(k,133) - lu(k,914) * b(k,110) + b(k,134) = b(k,134) - lu(k,915) * b(k,110) + b(k,135) = b(k,135) - lu(k,916) * b(k,110) + b(k,136) = b(k,136) - lu(k,917) * b(k,110) + b(k,137) = b(k,137) - lu(k,918) * b(k,110) + b(k,112) = b(k,112) - lu(k,924) * b(k,111) + b(k,114) = b(k,114) - lu(k,925) * b(k,111) + b(k,115) = b(k,115) - lu(k,926) * b(k,111) + b(k,116) = b(k,116) - lu(k,927) * b(k,111) + b(k,117) = b(k,117) - lu(k,928) * b(k,111) + b(k,118) = b(k,118) - lu(k,929) * b(k,111) + b(k,119) = b(k,119) - lu(k,930) * b(k,111) + b(k,120) = b(k,120) - lu(k,931) * b(k,111) + b(k,121) = b(k,121) - lu(k,932) * b(k,111) + b(k,122) = b(k,122) - lu(k,933) * b(k,111) + b(k,123) = b(k,123) - lu(k,934) * b(k,111) + b(k,124) = b(k,124) - lu(k,935) * b(k,111) + b(k,126) = b(k,126) - lu(k,936) * b(k,111) + b(k,127) = b(k,127) - lu(k,937) * b(k,111) + b(k,128) = b(k,128) - lu(k,938) * b(k,111) + b(k,129) = b(k,129) - lu(k,939) * b(k,111) + b(k,130) = b(k,130) - lu(k,940) * b(k,111) + b(k,131) = b(k,131) - lu(k,941) * b(k,111) + b(k,132) = b(k,132) - lu(k,942) * b(k,111) + b(k,134) = b(k,134) - lu(k,943) * b(k,111) + b(k,136) = b(k,136) - lu(k,944) * b(k,111) + b(k,137) = b(k,137) - lu(k,945) * b(k,111) + b(k,114) = b(k,114) - lu(k,982) * b(k,112) + b(k,115) = b(k,115) - lu(k,983) * b(k,112) + b(k,116) = b(k,116) - lu(k,984) * b(k,112) + b(k,118) = b(k,118) - lu(k,985) * b(k,112) + b(k,119) = b(k,119) - lu(k,986) * b(k,112) + b(k,120) = b(k,120) - lu(k,987) * b(k,112) + b(k,121) = b(k,121) - lu(k,988) * b(k,112) + b(k,123) = b(k,123) - lu(k,989) * b(k,112) + b(k,124) = b(k,124) - lu(k,990) * b(k,112) + b(k,125) = b(k,125) - lu(k,991) * b(k,112) + b(k,126) = b(k,126) - lu(k,992) * b(k,112) + b(k,127) = b(k,127) - lu(k,993) * b(k,112) + b(k,129) = b(k,129) - lu(k,994) * b(k,112) + b(k,130) = b(k,130) - lu(k,995) * b(k,112) + b(k,131) = b(k,131) - lu(k,996) * b(k,112) + b(k,132) = b(k,132) - lu(k,997) * b(k,112) + b(k,133) = b(k,133) - lu(k,998) * b(k,112) + b(k,134) = b(k,134) - lu(k,999) * b(k,112) + b(k,135) = b(k,135) - lu(k,1000) * b(k,112) + b(k,136) = b(k,136) - lu(k,1001) * b(k,112) + b(k,137) = b(k,137) - lu(k,1002) * b(k,112) + b(k,114) = b(k,114) - lu(k,1012) * b(k,113) + b(k,115) = b(k,115) - lu(k,1013) * b(k,113) + b(k,116) = b(k,116) - lu(k,1014) * b(k,113) + b(k,117) = b(k,117) - lu(k,1015) * b(k,113) + b(k,118) = b(k,118) - lu(k,1016) * b(k,113) + b(k,119) = b(k,119) - lu(k,1017) * b(k,113) + b(k,120) = b(k,120) - lu(k,1018) * b(k,113) + b(k,121) = b(k,121) - lu(k,1019) * b(k,113) + b(k,122) = b(k,122) - lu(k,1020) * b(k,113) + b(k,123) = b(k,123) - lu(k,1021) * b(k,113) + b(k,124) = b(k,124) - lu(k,1022) * b(k,113) + b(k,125) = b(k,125) - lu(k,1023) * b(k,113) + b(k,126) = b(k,126) - lu(k,1024) * b(k,113) + b(k,127) = b(k,127) - lu(k,1025) * b(k,113) + b(k,128) = b(k,128) - lu(k,1026) * b(k,113) + b(k,129) = b(k,129) - lu(k,1027) * b(k,113) + b(k,130) = b(k,130) - lu(k,1028) * b(k,113) + b(k,131) = b(k,131) - lu(k,1029) * b(k,113) + b(k,132) = b(k,132) - lu(k,1030) * b(k,113) + b(k,133) = b(k,133) - lu(k,1031) * b(k,113) + b(k,134) = b(k,134) - lu(k,1032) * b(k,113) + b(k,135) = b(k,135) - lu(k,1033) * b(k,113) + b(k,136) = b(k,136) - lu(k,1034) * b(k,113) + b(k,137) = b(k,137) - lu(k,1035) * b(k,113) + b(k,115) = b(k,115) - lu(k,1056) * b(k,114) + b(k,116) = b(k,116) - lu(k,1057) * b(k,114) + b(k,117) = b(k,117) - lu(k,1058) * b(k,114) + b(k,118) = b(k,118) - lu(k,1059) * b(k,114) + b(k,119) = b(k,119) - lu(k,1060) * b(k,114) + b(k,120) = b(k,120) - lu(k,1061) * b(k,114) + b(k,121) = b(k,121) - lu(k,1062) * b(k,114) + b(k,122) = b(k,122) - lu(k,1063) * b(k,114) + b(k,123) = b(k,123) - lu(k,1064) * b(k,114) + b(k,124) = b(k,124) - lu(k,1065) * b(k,114) + b(k,125) = b(k,125) - lu(k,1066) * b(k,114) + b(k,126) = b(k,126) - lu(k,1067) * b(k,114) + b(k,127) = b(k,127) - lu(k,1068) * b(k,114) + b(k,128) = b(k,128) - lu(k,1069) * b(k,114) + b(k,129) = b(k,129) - lu(k,1070) * b(k,114) + b(k,130) = b(k,130) - lu(k,1071) * b(k,114) + b(k,131) = b(k,131) - lu(k,1072) * b(k,114) + b(k,132) = b(k,132) - lu(k,1073) * b(k,114) + b(k,133) = b(k,133) - lu(k,1074) * b(k,114) + b(k,134) = b(k,134) - lu(k,1075) * b(k,114) + b(k,135) = b(k,135) - lu(k,1076) * b(k,114) + b(k,136) = b(k,136) - lu(k,1077) * b(k,114) + b(k,137) = b(k,137) - lu(k,1078) * b(k,114) + b(k,116) = b(k,116) - lu(k,1097) * b(k,115) + b(k,117) = b(k,117) - lu(k,1098) * b(k,115) + b(k,118) = b(k,118) - lu(k,1099) * b(k,115) + b(k,119) = b(k,119) - lu(k,1100) * b(k,115) + b(k,120) = b(k,120) - lu(k,1101) * b(k,115) + b(k,121) = b(k,121) - lu(k,1102) * b(k,115) + b(k,122) = b(k,122) - lu(k,1103) * b(k,115) + b(k,123) = b(k,123) - lu(k,1104) * b(k,115) + b(k,124) = b(k,124) - lu(k,1105) * b(k,115) + b(k,125) = b(k,125) - lu(k,1106) * b(k,115) + b(k,126) = b(k,126) - lu(k,1107) * b(k,115) + b(k,127) = b(k,127) - lu(k,1108) * b(k,115) + b(k,128) = b(k,128) - lu(k,1109) * b(k,115) + b(k,129) = b(k,129) - lu(k,1110) * b(k,115) + b(k,130) = b(k,130) - lu(k,1111) * b(k,115) + b(k,131) = b(k,131) - lu(k,1112) * b(k,115) + b(k,132) = b(k,132) - lu(k,1113) * b(k,115) + b(k,133) = b(k,133) - lu(k,1114) * b(k,115) + b(k,134) = b(k,134) - lu(k,1115) * b(k,115) + b(k,135) = b(k,135) - lu(k,1116) * b(k,115) + b(k,136) = b(k,136) - lu(k,1117) * b(k,115) + b(k,137) = b(k,137) - lu(k,1118) * b(k,115) + b(k,117) = b(k,117) - lu(k,1146) * b(k,116) + b(k,118) = b(k,118) - lu(k,1147) * b(k,116) + b(k,119) = b(k,119) - lu(k,1148) * b(k,116) + b(k,120) = b(k,120) - lu(k,1149) * b(k,116) + b(k,121) = b(k,121) - lu(k,1150) * b(k,116) + b(k,122) = b(k,122) - lu(k,1151) * b(k,116) + b(k,123) = b(k,123) - lu(k,1152) * b(k,116) + b(k,124) = b(k,124) - lu(k,1153) * b(k,116) + b(k,125) = b(k,125) - lu(k,1154) * b(k,116) + b(k,126) = b(k,126) - lu(k,1155) * b(k,116) + b(k,127) = b(k,127) - lu(k,1156) * b(k,116) + b(k,128) = b(k,128) - lu(k,1157) * b(k,116) + b(k,129) = b(k,129) - lu(k,1158) * b(k,116) + b(k,130) = b(k,130) - lu(k,1159) * b(k,116) + b(k,131) = b(k,131) - lu(k,1160) * b(k,116) + b(k,132) = b(k,132) - lu(k,1161) * b(k,116) + b(k,133) = b(k,133) - lu(k,1162) * b(k,116) + b(k,134) = b(k,134) - lu(k,1163) * b(k,116) + b(k,135) = b(k,135) - lu(k,1164) * b(k,116) + b(k,136) = b(k,136) - lu(k,1165) * b(k,116) + b(k,137) = b(k,137) - lu(k,1166) * b(k,116) end do end subroutine lu_slv04 subroutine lu_slv05( avec_len, lu, b ) @@ -927,97 +936,210 @@ subroutine lu_slv05( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,102) = b(k,102) - lu(k,1293) * b(k,101) - b(k,103) = b(k,103) - lu(k,1294) * b(k,101) - b(k,104) = b(k,104) - lu(k,1295) * b(k,101) - b(k,105) = b(k,105) - lu(k,1296) * b(k,101) - b(k,106) = b(k,106) - lu(k,1297) * b(k,101) - b(k,107) = b(k,107) - lu(k,1298) * b(k,101) - b(k,108) = b(k,108) - lu(k,1299) * b(k,101) - b(k,109) = b(k,109) - lu(k,1300) * b(k,101) - b(k,110) = b(k,110) - lu(k,1301) * b(k,101) - b(k,111) = b(k,111) - lu(k,1302) * b(k,101) - b(k,112) = b(k,112) - lu(k,1303) * b(k,101) - b(k,113) = b(k,113) - lu(k,1304) * b(k,101) - b(k,114) = b(k,114) - lu(k,1305) * b(k,101) - b(k,103) = b(k,103) - lu(k,1329) * b(k,102) - b(k,104) = b(k,104) - lu(k,1330) * b(k,102) - b(k,105) = b(k,105) - lu(k,1331) * b(k,102) - b(k,106) = b(k,106) - lu(k,1332) * b(k,102) - b(k,107) = b(k,107) - lu(k,1333) * b(k,102) - b(k,108) = b(k,108) - lu(k,1334) * b(k,102) - b(k,109) = b(k,109) - lu(k,1335) * b(k,102) - b(k,110) = b(k,110) - lu(k,1336) * b(k,102) - b(k,111) = b(k,111) - lu(k,1337) * b(k,102) - b(k,112) = b(k,112) - lu(k,1338) * b(k,102) - b(k,113) = b(k,113) - lu(k,1339) * b(k,102) - b(k,114) = b(k,114) - lu(k,1340) * b(k,102) - b(k,104) = b(k,104) - lu(k,1374) * b(k,103) - b(k,105) = b(k,105) - lu(k,1375) * b(k,103) - b(k,106) = b(k,106) - lu(k,1376) * b(k,103) - b(k,107) = b(k,107) - lu(k,1377) * b(k,103) - b(k,108) = b(k,108) - lu(k,1378) * b(k,103) - b(k,109) = b(k,109) - lu(k,1379) * b(k,103) - b(k,110) = b(k,110) - lu(k,1380) * b(k,103) - b(k,111) = b(k,111) - lu(k,1381) * b(k,103) - b(k,112) = b(k,112) - lu(k,1382) * b(k,103) - b(k,113) = b(k,113) - lu(k,1383) * b(k,103) - b(k,114) = b(k,114) - lu(k,1384) * b(k,103) - b(k,105) = b(k,105) - lu(k,1434) * b(k,104) - b(k,106) = b(k,106) - lu(k,1435) * b(k,104) - b(k,107) = b(k,107) - lu(k,1436) * b(k,104) - b(k,108) = b(k,108) - lu(k,1437) * b(k,104) - b(k,109) = b(k,109) - lu(k,1438) * b(k,104) - b(k,110) = b(k,110) - lu(k,1439) * b(k,104) - b(k,111) = b(k,111) - lu(k,1440) * b(k,104) - b(k,112) = b(k,112) - lu(k,1441) * b(k,104) - b(k,113) = b(k,113) - lu(k,1442) * b(k,104) - b(k,114) = b(k,114) - lu(k,1443) * b(k,104) - b(k,106) = b(k,106) - lu(k,1477) * b(k,105) - b(k,107) = b(k,107) - lu(k,1478) * b(k,105) - b(k,108) = b(k,108) - lu(k,1479) * b(k,105) - b(k,109) = b(k,109) - lu(k,1480) * b(k,105) - b(k,110) = b(k,110) - lu(k,1481) * b(k,105) - b(k,111) = b(k,111) - lu(k,1482) * b(k,105) - b(k,112) = b(k,112) - lu(k,1483) * b(k,105) - b(k,113) = b(k,113) - lu(k,1484) * b(k,105) - b(k,114) = b(k,114) - lu(k,1485) * b(k,105) - b(k,107) = b(k,107) - lu(k,1519) * b(k,106) - b(k,108) = b(k,108) - lu(k,1520) * b(k,106) - b(k,109) = b(k,109) - lu(k,1521) * b(k,106) - b(k,110) = b(k,110) - lu(k,1522) * b(k,106) - b(k,111) = b(k,111) - lu(k,1523) * b(k,106) - b(k,112) = b(k,112) - lu(k,1524) * b(k,106) - b(k,113) = b(k,113) - lu(k,1525) * b(k,106) - b(k,114) = b(k,114) - lu(k,1526) * b(k,106) - b(k,108) = b(k,108) - lu(k,1562) * b(k,107) - b(k,109) = b(k,109) - lu(k,1563) * b(k,107) - b(k,110) = b(k,110) - lu(k,1564) * b(k,107) - b(k,111) = b(k,111) - lu(k,1565) * b(k,107) - b(k,112) = b(k,112) - lu(k,1566) * b(k,107) - b(k,113) = b(k,113) - lu(k,1567) * b(k,107) - b(k,114) = b(k,114) - lu(k,1568) * b(k,107) - b(k,109) = b(k,109) - lu(k,1605) * b(k,108) - b(k,110) = b(k,110) - lu(k,1606) * b(k,108) - b(k,111) = b(k,111) - lu(k,1607) * b(k,108) - b(k,112) = b(k,112) - lu(k,1608) * b(k,108) - b(k,113) = b(k,113) - lu(k,1609) * b(k,108) - b(k,114) = b(k,114) - lu(k,1610) * b(k,108) - b(k,110) = b(k,110) - lu(k,1638) * b(k,109) - b(k,111) = b(k,111) - lu(k,1639) * b(k,109) - b(k,112) = b(k,112) - lu(k,1640) * b(k,109) - b(k,113) = b(k,113) - lu(k,1641) * b(k,109) - b(k,114) = b(k,114) - lu(k,1642) * b(k,109) - b(k,111) = b(k,111) - lu(k,1674) * b(k,110) - b(k,112) = b(k,112) - lu(k,1675) * b(k,110) - b(k,113) = b(k,113) - lu(k,1676) * b(k,110) - b(k,114) = b(k,114) - lu(k,1677) * b(k,110) - b(k,112) = b(k,112) - lu(k,1717) * b(k,111) - b(k,113) = b(k,113) - lu(k,1718) * b(k,111) - b(k,114) = b(k,114) - lu(k,1719) * b(k,111) - b(k,113) = b(k,113) - lu(k,1762) * b(k,112) - b(k,114) = b(k,114) - lu(k,1763) * b(k,112) - b(k,114) = b(k,114) - lu(k,1798) * b(k,113) + b(k,118) = b(k,118) - lu(k,1190) * b(k,117) + b(k,119) = b(k,119) - lu(k,1191) * b(k,117) + b(k,120) = b(k,120) - lu(k,1192) * b(k,117) + b(k,121) = b(k,121) - lu(k,1193) * b(k,117) + b(k,122) = b(k,122) - lu(k,1194) * b(k,117) + b(k,123) = b(k,123) - lu(k,1195) * b(k,117) + b(k,124) = b(k,124) - lu(k,1196) * b(k,117) + b(k,125) = b(k,125) - lu(k,1197) * b(k,117) + b(k,126) = b(k,126) - lu(k,1198) * b(k,117) + b(k,127) = b(k,127) - lu(k,1199) * b(k,117) + b(k,128) = b(k,128) - lu(k,1200) * b(k,117) + b(k,129) = b(k,129) - lu(k,1201) * b(k,117) + b(k,130) = b(k,130) - lu(k,1202) * b(k,117) + b(k,131) = b(k,131) - lu(k,1203) * b(k,117) + b(k,132) = b(k,132) - lu(k,1204) * b(k,117) + b(k,133) = b(k,133) - lu(k,1205) * b(k,117) + b(k,134) = b(k,134) - lu(k,1206) * b(k,117) + b(k,135) = b(k,135) - lu(k,1207) * b(k,117) + b(k,136) = b(k,136) - lu(k,1208) * b(k,117) + b(k,137) = b(k,137) - lu(k,1209) * b(k,117) + b(k,119) = b(k,119) - lu(k,1232) * b(k,118) + b(k,120) = b(k,120) - lu(k,1233) * b(k,118) + b(k,121) = b(k,121) - lu(k,1234) * b(k,118) + b(k,122) = b(k,122) - lu(k,1235) * b(k,118) + b(k,123) = b(k,123) - lu(k,1236) * b(k,118) + b(k,124) = b(k,124) - lu(k,1237) * b(k,118) + b(k,125) = b(k,125) - lu(k,1238) * b(k,118) + b(k,126) = b(k,126) - lu(k,1239) * b(k,118) + b(k,127) = b(k,127) - lu(k,1240) * b(k,118) + b(k,128) = b(k,128) - lu(k,1241) * b(k,118) + b(k,129) = b(k,129) - lu(k,1242) * b(k,118) + b(k,130) = b(k,130) - lu(k,1243) * b(k,118) + b(k,131) = b(k,131) - lu(k,1244) * b(k,118) + b(k,132) = b(k,132) - lu(k,1245) * b(k,118) + b(k,133) = b(k,133) - lu(k,1246) * b(k,118) + b(k,134) = b(k,134) - lu(k,1247) * b(k,118) + b(k,135) = b(k,135) - lu(k,1248) * b(k,118) + b(k,136) = b(k,136) - lu(k,1249) * b(k,118) + b(k,137) = b(k,137) - lu(k,1250) * b(k,118) + b(k,120) = b(k,120) - lu(k,1293) * b(k,119) + b(k,121) = b(k,121) - lu(k,1294) * b(k,119) + b(k,122) = b(k,122) - lu(k,1295) * b(k,119) + b(k,123) = b(k,123) - lu(k,1296) * b(k,119) + b(k,124) = b(k,124) - lu(k,1297) * b(k,119) + b(k,125) = b(k,125) - lu(k,1298) * b(k,119) + b(k,126) = b(k,126) - lu(k,1299) * b(k,119) + b(k,127) = b(k,127) - lu(k,1300) * b(k,119) + b(k,128) = b(k,128) - lu(k,1301) * b(k,119) + b(k,129) = b(k,129) - lu(k,1302) * b(k,119) + b(k,130) = b(k,130) - lu(k,1303) * b(k,119) + b(k,131) = b(k,131) - lu(k,1304) * b(k,119) + b(k,132) = b(k,132) - lu(k,1305) * b(k,119) + b(k,133) = b(k,133) - lu(k,1306) * b(k,119) + b(k,134) = b(k,134) - lu(k,1307) * b(k,119) + b(k,135) = b(k,135) - lu(k,1308) * b(k,119) + b(k,136) = b(k,136) - lu(k,1309) * b(k,119) + b(k,137) = b(k,137) - lu(k,1310) * b(k,119) + b(k,121) = b(k,121) - lu(k,1336) * b(k,120) + b(k,122) = b(k,122) - lu(k,1337) * b(k,120) + b(k,123) = b(k,123) - lu(k,1338) * b(k,120) + b(k,124) = b(k,124) - lu(k,1339) * b(k,120) + b(k,125) = b(k,125) - lu(k,1340) * b(k,120) + b(k,126) = b(k,126) - lu(k,1341) * b(k,120) + b(k,127) = b(k,127) - lu(k,1342) * b(k,120) + b(k,128) = b(k,128) - lu(k,1343) * b(k,120) + b(k,129) = b(k,129) - lu(k,1344) * b(k,120) + b(k,130) = b(k,130) - lu(k,1345) * b(k,120) + b(k,131) = b(k,131) - lu(k,1346) * b(k,120) + b(k,132) = b(k,132) - lu(k,1347) * b(k,120) + b(k,133) = b(k,133) - lu(k,1348) * b(k,120) + b(k,134) = b(k,134) - lu(k,1349) * b(k,120) + b(k,135) = b(k,135) - lu(k,1350) * b(k,120) + b(k,136) = b(k,136) - lu(k,1351) * b(k,120) + b(k,137) = b(k,137) - lu(k,1352) * b(k,120) + b(k,122) = b(k,122) - lu(k,1373) * b(k,121) + b(k,123) = b(k,123) - lu(k,1374) * b(k,121) + b(k,124) = b(k,124) - lu(k,1375) * b(k,121) + b(k,125) = b(k,125) - lu(k,1376) * b(k,121) + b(k,126) = b(k,126) - lu(k,1377) * b(k,121) + b(k,127) = b(k,127) - lu(k,1378) * b(k,121) + b(k,128) = b(k,128) - lu(k,1379) * b(k,121) + b(k,129) = b(k,129) - lu(k,1380) * b(k,121) + b(k,130) = b(k,130) - lu(k,1381) * b(k,121) + b(k,131) = b(k,131) - lu(k,1382) * b(k,121) + b(k,132) = b(k,132) - lu(k,1383) * b(k,121) + b(k,133) = b(k,133) - lu(k,1384) * b(k,121) + b(k,134) = b(k,134) - lu(k,1385) * b(k,121) + b(k,135) = b(k,135) - lu(k,1386) * b(k,121) + b(k,136) = b(k,136) - lu(k,1387) * b(k,121) + b(k,137) = b(k,137) - lu(k,1388) * b(k,121) + b(k,123) = b(k,123) - lu(k,1417) * b(k,122) + b(k,124) = b(k,124) - lu(k,1418) * b(k,122) + b(k,125) = b(k,125) - lu(k,1419) * b(k,122) + b(k,126) = b(k,126) - lu(k,1420) * b(k,122) + b(k,127) = b(k,127) - lu(k,1421) * b(k,122) + b(k,128) = b(k,128) - lu(k,1422) * b(k,122) + b(k,129) = b(k,129) - lu(k,1423) * b(k,122) + b(k,130) = b(k,130) - lu(k,1424) * b(k,122) + b(k,131) = b(k,131) - lu(k,1425) * b(k,122) + b(k,132) = b(k,132) - lu(k,1426) * b(k,122) + b(k,133) = b(k,133) - lu(k,1427) * b(k,122) + b(k,134) = b(k,134) - lu(k,1428) * b(k,122) + b(k,135) = b(k,135) - lu(k,1429) * b(k,122) + b(k,136) = b(k,136) - lu(k,1430) * b(k,122) + b(k,137) = b(k,137) - lu(k,1431) * b(k,122) + b(k,124) = b(k,124) - lu(k,1461) * b(k,123) + b(k,125) = b(k,125) - lu(k,1462) * b(k,123) + b(k,126) = b(k,126) - lu(k,1463) * b(k,123) + b(k,127) = b(k,127) - lu(k,1464) * b(k,123) + b(k,128) = b(k,128) - lu(k,1465) * b(k,123) + b(k,129) = b(k,129) - lu(k,1466) * b(k,123) + b(k,130) = b(k,130) - lu(k,1467) * b(k,123) + b(k,131) = b(k,131) - lu(k,1468) * b(k,123) + b(k,132) = b(k,132) - lu(k,1469) * b(k,123) + b(k,133) = b(k,133) - lu(k,1470) * b(k,123) + b(k,134) = b(k,134) - lu(k,1471) * b(k,123) + b(k,135) = b(k,135) - lu(k,1472) * b(k,123) + b(k,136) = b(k,136) - lu(k,1473) * b(k,123) + b(k,137) = b(k,137) - lu(k,1474) * b(k,123) + b(k,125) = b(k,125) - lu(k,1507) * b(k,124) + b(k,126) = b(k,126) - lu(k,1508) * b(k,124) + b(k,127) = b(k,127) - lu(k,1509) * b(k,124) + b(k,128) = b(k,128) - lu(k,1510) * b(k,124) + b(k,129) = b(k,129) - lu(k,1511) * b(k,124) + b(k,130) = b(k,130) - lu(k,1512) * b(k,124) + b(k,131) = b(k,131) - lu(k,1513) * b(k,124) + b(k,132) = b(k,132) - lu(k,1514) * b(k,124) + b(k,133) = b(k,133) - lu(k,1515) * b(k,124) + b(k,134) = b(k,134) - lu(k,1516) * b(k,124) + b(k,135) = b(k,135) - lu(k,1517) * b(k,124) + b(k,136) = b(k,136) - lu(k,1518) * b(k,124) + b(k,137) = b(k,137) - lu(k,1519) * b(k,124) + b(k,126) = b(k,126) - lu(k,1544) * b(k,125) + b(k,127) = b(k,127) - lu(k,1545) * b(k,125) + b(k,128) = b(k,128) - lu(k,1546) * b(k,125) + b(k,129) = b(k,129) - lu(k,1547) * b(k,125) + b(k,130) = b(k,130) - lu(k,1548) * b(k,125) + b(k,131) = b(k,131) - lu(k,1549) * b(k,125) + b(k,132) = b(k,132) - lu(k,1550) * b(k,125) + b(k,133) = b(k,133) - lu(k,1551) * b(k,125) + b(k,134) = b(k,134) - lu(k,1552) * b(k,125) + b(k,135) = b(k,135) - lu(k,1553) * b(k,125) + b(k,136) = b(k,136) - lu(k,1554) * b(k,125) + b(k,137) = b(k,137) - lu(k,1555) * b(k,125) + b(k,127) = b(k,127) - lu(k,1590) * b(k,126) + b(k,128) = b(k,128) - lu(k,1591) * b(k,126) + b(k,129) = b(k,129) - lu(k,1592) * b(k,126) + b(k,130) = b(k,130) - lu(k,1593) * b(k,126) + b(k,131) = b(k,131) - lu(k,1594) * b(k,126) + b(k,132) = b(k,132) - lu(k,1595) * b(k,126) + b(k,133) = b(k,133) - lu(k,1596) * b(k,126) + b(k,134) = b(k,134) - lu(k,1597) * b(k,126) + b(k,135) = b(k,135) - lu(k,1598) * b(k,126) + b(k,136) = b(k,136) - lu(k,1599) * b(k,126) + b(k,137) = b(k,137) - lu(k,1600) * b(k,126) + b(k,128) = b(k,128) - lu(k,1639) * b(k,127) + b(k,129) = b(k,129) - lu(k,1640) * b(k,127) + b(k,130) = b(k,130) - lu(k,1641) * b(k,127) + b(k,131) = b(k,131) - lu(k,1642) * b(k,127) + b(k,132) = b(k,132) - lu(k,1643) * b(k,127) + b(k,133) = b(k,133) - lu(k,1644) * b(k,127) + b(k,134) = b(k,134) - lu(k,1645) * b(k,127) + b(k,135) = b(k,135) - lu(k,1646) * b(k,127) + b(k,136) = b(k,136) - lu(k,1647) * b(k,127) + b(k,137) = b(k,137) - lu(k,1648) * b(k,127) + b(k,129) = b(k,129) - lu(k,1683) * b(k,128) + b(k,130) = b(k,130) - lu(k,1684) * b(k,128) + b(k,131) = b(k,131) - lu(k,1685) * b(k,128) + b(k,132) = b(k,132) - lu(k,1686) * b(k,128) + b(k,133) = b(k,133) - lu(k,1687) * b(k,128) + b(k,134) = b(k,134) - lu(k,1688) * b(k,128) + b(k,135) = b(k,135) - lu(k,1689) * b(k,128) + b(k,136) = b(k,136) - lu(k,1690) * b(k,128) + b(k,137) = b(k,137) - lu(k,1691) * b(k,128) + b(k,130) = b(k,130) - lu(k,1726) * b(k,129) + b(k,131) = b(k,131) - lu(k,1727) * b(k,129) + b(k,132) = b(k,132) - lu(k,1728) * b(k,129) + b(k,133) = b(k,133) - lu(k,1729) * b(k,129) + b(k,134) = b(k,134) - lu(k,1730) * b(k,129) + b(k,135) = b(k,135) - lu(k,1731) * b(k,129) + b(k,136) = b(k,136) - lu(k,1732) * b(k,129) + b(k,137) = b(k,137) - lu(k,1733) * b(k,129) + b(k,131) = b(k,131) - lu(k,1772) * b(k,130) + b(k,132) = b(k,132) - lu(k,1773) * b(k,130) + b(k,133) = b(k,133) - lu(k,1774) * b(k,130) + b(k,134) = b(k,134) - lu(k,1775) * b(k,130) + b(k,135) = b(k,135) - lu(k,1776) * b(k,130) + b(k,136) = b(k,136) - lu(k,1777) * b(k,130) + b(k,137) = b(k,137) - lu(k,1778) * b(k,130) + b(k,132) = b(k,132) - lu(k,1822) * b(k,131) + b(k,133) = b(k,133) - lu(k,1823) * b(k,131) + b(k,134) = b(k,134) - lu(k,1824) * b(k,131) + b(k,135) = b(k,135) - lu(k,1825) * b(k,131) + b(k,136) = b(k,136) - lu(k,1826) * b(k,131) + b(k,137) = b(k,137) - lu(k,1827) * b(k,131) + b(k,133) = b(k,133) - lu(k,1856) * b(k,132) + b(k,134) = b(k,134) - lu(k,1857) * b(k,132) + b(k,135) = b(k,135) - lu(k,1858) * b(k,132) + b(k,136) = b(k,136) - lu(k,1859) * b(k,132) + b(k,137) = b(k,137) - lu(k,1860) * b(k,132) + b(k,134) = b(k,134) - lu(k,1893) * b(k,133) + b(k,135) = b(k,135) - lu(k,1894) * b(k,133) + b(k,136) = b(k,136) - lu(k,1895) * b(k,133) + b(k,137) = b(k,137) - lu(k,1896) * b(k,133) end do end subroutine lu_slv05 subroutine lu_slv06( avec_len, lu, b ) @@ -1038,213 +1160,12 @@ subroutine lu_slv06( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len -!----------------------------------------------------------------------- -! ... Solve U * x = y -!----------------------------------------------------------------------- - b(k,114) = b(k,114) * lu(k,1856) - b(k,113) = b(k,113) - lu(k,1855) * b(k,114) - b(k,112) = b(k,112) - lu(k,1854) * b(k,114) - b(k,111) = b(k,111) - lu(k,1853) * b(k,114) - b(k,110) = b(k,110) - lu(k,1852) * b(k,114) - b(k,109) = b(k,109) - lu(k,1851) * b(k,114) - b(k,108) = b(k,108) - lu(k,1850) * b(k,114) - b(k,107) = b(k,107) - lu(k,1849) * b(k,114) - b(k,106) = b(k,106) - lu(k,1848) * b(k,114) - b(k,105) = b(k,105) - lu(k,1847) * b(k,114) - b(k,104) = b(k,104) - lu(k,1846) * b(k,114) - b(k,103) = b(k,103) - lu(k,1845) * b(k,114) - b(k,102) = b(k,102) - lu(k,1844) * b(k,114) - b(k,101) = b(k,101) - lu(k,1843) * b(k,114) - b(k,100) = b(k,100) - lu(k,1842) * b(k,114) - b(k,99) = b(k,99) - lu(k,1841) * b(k,114) - b(k,98) = b(k,98) - lu(k,1840) * b(k,114) - b(k,97) = b(k,97) - lu(k,1839) * b(k,114) - b(k,96) = b(k,96) - lu(k,1838) * b(k,114) - b(k,95) = b(k,95) - lu(k,1837) * b(k,114) - b(k,94) = b(k,94) - lu(k,1836) * b(k,114) - b(k,93) = b(k,93) - lu(k,1835) * b(k,114) - b(k,92) = b(k,92) - lu(k,1834) * b(k,114) - b(k,91) = b(k,91) - lu(k,1833) * b(k,114) - b(k,90) = b(k,90) - lu(k,1832) * b(k,114) - b(k,89) = b(k,89) - lu(k,1831) * b(k,114) - b(k,88) = b(k,88) - lu(k,1830) * b(k,114) - b(k,87) = b(k,87) - lu(k,1829) * b(k,114) - b(k,86) = b(k,86) - lu(k,1828) * b(k,114) - b(k,84) = b(k,84) - lu(k,1827) * b(k,114) - b(k,83) = b(k,83) - lu(k,1826) * b(k,114) - b(k,82) = b(k,82) - lu(k,1825) * b(k,114) - b(k,81) = b(k,81) - lu(k,1824) * b(k,114) - b(k,80) = b(k,80) - lu(k,1823) * b(k,114) - b(k,79) = b(k,79) - lu(k,1822) * b(k,114) - b(k,77) = b(k,77) - lu(k,1821) * b(k,114) - b(k,75) = b(k,75) - lu(k,1820) * b(k,114) - b(k,73) = b(k,73) - lu(k,1819) * b(k,114) - b(k,72) = b(k,72) - lu(k,1818) * b(k,114) - b(k,70) = b(k,70) - lu(k,1817) * b(k,114) - b(k,69) = b(k,69) - lu(k,1816) * b(k,114) - b(k,68) = b(k,68) - lu(k,1815) * b(k,114) - b(k,66) = b(k,66) - lu(k,1814) * b(k,114) - b(k,60) = b(k,60) - lu(k,1813) * b(k,114) - b(k,53) = b(k,53) - lu(k,1812) * b(k,114) - b(k,52) = b(k,52) - lu(k,1811) * b(k,114) - b(k,51) = b(k,51) - lu(k,1810) * b(k,114) - b(k,50) = b(k,50) - lu(k,1809) * b(k,114) - b(k,48) = b(k,48) - lu(k,1808) * b(k,114) - b(k,41) = b(k,41) - lu(k,1807) * b(k,114) - b(k,40) = b(k,40) - lu(k,1806) * b(k,114) - b(k,37) = b(k,37) - lu(k,1805) * b(k,114) - b(k,36) = b(k,36) - lu(k,1804) * b(k,114) - b(k,31) = b(k,31) - lu(k,1803) * b(k,114) - b(k,30) = b(k,30) - lu(k,1802) * b(k,114) - b(k,29) = b(k,29) - lu(k,1801) * b(k,114) - b(k,26) = b(k,26) - lu(k,1800) * b(k,114) - b(k,22) = b(k,22) - lu(k,1799) * b(k,114) - b(k,113) = b(k,113) * lu(k,1797) - b(k,112) = b(k,112) - lu(k,1796) * b(k,113) - b(k,111) = b(k,111) - lu(k,1795) * b(k,113) - b(k,110) = b(k,110) - lu(k,1794) * b(k,113) - b(k,109) = b(k,109) - lu(k,1793) * b(k,113) - b(k,108) = b(k,108) - lu(k,1792) * b(k,113) - b(k,107) = b(k,107) - lu(k,1791) * b(k,113) - b(k,106) = b(k,106) - lu(k,1790) * b(k,113) - b(k,105) = b(k,105) - lu(k,1789) * b(k,113) - b(k,104) = b(k,104) - lu(k,1788) * b(k,113) - b(k,103) = b(k,103) - lu(k,1787) * b(k,113) - b(k,102) = b(k,102) - lu(k,1786) * b(k,113) - b(k,101) = b(k,101) - lu(k,1785) * b(k,113) - b(k,100) = b(k,100) - lu(k,1784) * b(k,113) - b(k,99) = b(k,99) - lu(k,1783) * b(k,113) - b(k,98) = b(k,98) - lu(k,1782) * b(k,113) - b(k,97) = b(k,97) - lu(k,1781) * b(k,113) - b(k,96) = b(k,96) - lu(k,1780) * b(k,113) - b(k,95) = b(k,95) - lu(k,1779) * b(k,113) - b(k,94) = b(k,94) - lu(k,1778) * b(k,113) - b(k,93) = b(k,93) - lu(k,1777) * b(k,113) - b(k,92) = b(k,92) - lu(k,1776) * b(k,113) - b(k,91) = b(k,91) - lu(k,1775) * b(k,113) - b(k,90) = b(k,90) - lu(k,1774) * b(k,113) - b(k,89) = b(k,89) - lu(k,1773) * b(k,113) - b(k,88) = b(k,88) - lu(k,1772) * b(k,113) - b(k,87) = b(k,87) - lu(k,1771) * b(k,113) - b(k,86) = b(k,86) - lu(k,1770) * b(k,113) - b(k,85) = b(k,85) - lu(k,1769) * b(k,113) - b(k,84) = b(k,84) - lu(k,1768) * b(k,113) - b(k,83) = b(k,83) - lu(k,1767) * b(k,113) - b(k,77) = b(k,77) - lu(k,1766) * b(k,113) - b(k,74) = b(k,74) - lu(k,1765) * b(k,113) - b(k,51) = b(k,51) - lu(k,1764) * b(k,113) - b(k,112) = b(k,112) * lu(k,1761) - b(k,111) = b(k,111) - lu(k,1760) * b(k,112) - b(k,110) = b(k,110) - lu(k,1759) * b(k,112) - b(k,109) = b(k,109) - lu(k,1758) * b(k,112) - b(k,108) = b(k,108) - lu(k,1757) * b(k,112) - b(k,107) = b(k,107) - lu(k,1756) * b(k,112) - b(k,106) = b(k,106) - lu(k,1755) * b(k,112) - b(k,105) = b(k,105) - lu(k,1754) * b(k,112) - b(k,104) = b(k,104) - lu(k,1753) * b(k,112) - b(k,103) = b(k,103) - lu(k,1752) * b(k,112) - b(k,102) = b(k,102) - lu(k,1751) * b(k,112) - b(k,101) = b(k,101) - lu(k,1750) * b(k,112) - b(k,100) = b(k,100) - lu(k,1749) * b(k,112) - b(k,99) = b(k,99) - lu(k,1748) * b(k,112) - b(k,98) = b(k,98) - lu(k,1747) * b(k,112) - b(k,97) = b(k,97) - lu(k,1746) * b(k,112) - b(k,96) = b(k,96) - lu(k,1745) * b(k,112) - b(k,95) = b(k,95) - lu(k,1744) * b(k,112) - b(k,94) = b(k,94) - lu(k,1743) * b(k,112) - b(k,93) = b(k,93) - lu(k,1742) * b(k,112) - b(k,92) = b(k,92) - lu(k,1741) * b(k,112) - b(k,91) = b(k,91) - lu(k,1740) * b(k,112) - b(k,90) = b(k,90) - lu(k,1739) * b(k,112) - b(k,89) = b(k,89) - lu(k,1738) * b(k,112) - b(k,88) = b(k,88) - lu(k,1737) * b(k,112) - b(k,87) = b(k,87) - lu(k,1736) * b(k,112) - b(k,86) = b(k,86) - lu(k,1735) * b(k,112) - b(k,85) = b(k,85) - lu(k,1734) * b(k,112) - b(k,84) = b(k,84) - lu(k,1733) * b(k,112) - b(k,83) = b(k,83) - lu(k,1732) * b(k,112) - b(k,82) = b(k,82) - lu(k,1731) * b(k,112) - b(k,75) = b(k,75) - lu(k,1730) * b(k,112) - b(k,70) = b(k,70) - lu(k,1729) * b(k,112) - b(k,66) = b(k,66) - lu(k,1728) * b(k,112) - b(k,63) = b(k,63) - lu(k,1727) * b(k,112) - b(k,62) = b(k,62) - lu(k,1726) * b(k,112) - b(k,60) = b(k,60) - lu(k,1725) * b(k,112) - b(k,57) = b(k,57) - lu(k,1724) * b(k,112) - b(k,33) = b(k,33) - lu(k,1723) * b(k,112) - b(k,27) = b(k,27) - lu(k,1722) * b(k,112) - b(k,24) = b(k,24) - lu(k,1721) * b(k,112) - b(k,21) = b(k,21) - lu(k,1720) * b(k,112) - b(k,111) = b(k,111) * lu(k,1716) - b(k,110) = b(k,110) - lu(k,1715) * b(k,111) - b(k,109) = b(k,109) - lu(k,1714) * b(k,111) - b(k,108) = b(k,108) - lu(k,1713) * b(k,111) - b(k,107) = b(k,107) - lu(k,1712) * b(k,111) - b(k,106) = b(k,106) - lu(k,1711) * b(k,111) - b(k,105) = b(k,105) - lu(k,1710) * b(k,111) - b(k,104) = b(k,104) - lu(k,1709) * b(k,111) - b(k,103) = b(k,103) - lu(k,1708) * b(k,111) - b(k,102) = b(k,102) - lu(k,1707) * b(k,111) - b(k,101) = b(k,101) - lu(k,1706) * b(k,111) - b(k,100) = b(k,100) - lu(k,1705) * b(k,111) - b(k,99) = b(k,99) - lu(k,1704) * b(k,111) - b(k,98) = b(k,98) - lu(k,1703) * b(k,111) - b(k,97) = b(k,97) - lu(k,1702) * b(k,111) - b(k,96) = b(k,96) - lu(k,1701) * b(k,111) - b(k,95) = b(k,95) - lu(k,1700) * b(k,111) - b(k,94) = b(k,94) - lu(k,1699) * b(k,111) - b(k,93) = b(k,93) - lu(k,1698) * b(k,111) - b(k,92) = b(k,92) - lu(k,1697) * b(k,111) - b(k,91) = b(k,91) - lu(k,1696) * b(k,111) - b(k,90) = b(k,90) - lu(k,1695) * b(k,111) - b(k,89) = b(k,89) - lu(k,1694) * b(k,111) - b(k,88) = b(k,88) - lu(k,1693) * b(k,111) - b(k,87) = b(k,87) - lu(k,1692) * b(k,111) - b(k,86) = b(k,86) - lu(k,1691) * b(k,111) - b(k,85) = b(k,85) - lu(k,1690) * b(k,111) - b(k,81) = b(k,81) - lu(k,1689) * b(k,111) - b(k,80) = b(k,80) - lu(k,1688) * b(k,111) - b(k,79) = b(k,79) - lu(k,1687) * b(k,111) - b(k,78) = b(k,78) - lu(k,1686) * b(k,111) - b(k,76) = b(k,76) - lu(k,1685) * b(k,111) - b(k,73) = b(k,73) - lu(k,1684) * b(k,111) - b(k,72) = b(k,72) - lu(k,1683) * b(k,111) - b(k,71) = b(k,71) - lu(k,1682) * b(k,111) - b(k,69) = b(k,69) - lu(k,1681) * b(k,111) - b(k,67) = b(k,67) - lu(k,1680) * b(k,111) - b(k,64) = b(k,64) - lu(k,1679) * b(k,111) - b(k,30) = b(k,30) - lu(k,1678) * b(k,111) - b(k,110) = b(k,110) * lu(k,1673) - b(k,109) = b(k,109) - lu(k,1672) * b(k,110) - b(k,108) = b(k,108) - lu(k,1671) * b(k,110) - b(k,107) = b(k,107) - lu(k,1670) * b(k,110) - b(k,106) = b(k,106) - lu(k,1669) * b(k,110) - b(k,105) = b(k,105) - lu(k,1668) * b(k,110) - b(k,104) = b(k,104) - lu(k,1667) * b(k,110) - b(k,103) = b(k,103) - lu(k,1666) * b(k,110) - b(k,102) = b(k,102) - lu(k,1665) * b(k,110) - b(k,101) = b(k,101) - lu(k,1664) * b(k,110) - b(k,100) = b(k,100) - lu(k,1663) * b(k,110) - b(k,99) = b(k,99) - lu(k,1662) * b(k,110) - b(k,98) = b(k,98) - lu(k,1661) * b(k,110) - b(k,97) = b(k,97) - lu(k,1660) * b(k,110) - b(k,96) = b(k,96) - lu(k,1659) * b(k,110) - b(k,95) = b(k,95) - lu(k,1658) * b(k,110) - b(k,94) = b(k,94) - lu(k,1657) * b(k,110) - b(k,93) = b(k,93) - lu(k,1656) * b(k,110) - b(k,92) = b(k,92) - lu(k,1655) * b(k,110) - b(k,91) = b(k,91) - lu(k,1654) * b(k,110) - b(k,90) = b(k,90) - lu(k,1653) * b(k,110) - b(k,89) = b(k,89) - lu(k,1652) * b(k,110) - b(k,88) = b(k,88) - lu(k,1651) * b(k,110) - b(k,87) = b(k,87) - lu(k,1650) * b(k,110) - b(k,86) = b(k,86) - lu(k,1649) * b(k,110) - b(k,84) = b(k,84) - lu(k,1648) * b(k,110) - b(k,83) = b(k,83) - lu(k,1647) * b(k,110) - b(k,77) = b(k,77) - lu(k,1646) * b(k,110) - b(k,74) = b(k,74) - lu(k,1645) * b(k,110) - b(k,68) = b(k,68) - lu(k,1644) * b(k,110) - b(k,59) = b(k,59) - lu(k,1643) * b(k,110) + b(k,135) = b(k,135) - lu(k,1935) * b(k,134) + b(k,136) = b(k,136) - lu(k,1936) * b(k,134) + b(k,137) = b(k,137) - lu(k,1937) * b(k,134) + b(k,136) = b(k,136) - lu(k,1978) * b(k,135) + b(k,137) = b(k,137) - lu(k,1979) * b(k,135) + b(k,137) = b(k,137) - lu(k,2027) * b(k,136) end do end subroutine lu_slv06 subroutine lu_slv07( avec_len, lu, b ) @@ -1265,219 +1186,226 @@ subroutine lu_slv07( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,109) = b(k,109) * lu(k,1637) - b(k,108) = b(k,108) - lu(k,1636) * b(k,109) - b(k,107) = b(k,107) - lu(k,1635) * b(k,109) - b(k,106) = b(k,106) - lu(k,1634) * b(k,109) - b(k,105) = b(k,105) - lu(k,1633) * b(k,109) - b(k,104) = b(k,104) - lu(k,1632) * b(k,109) - b(k,103) = b(k,103) - lu(k,1631) * b(k,109) - b(k,102) = b(k,102) - lu(k,1630) * b(k,109) - b(k,101) = b(k,101) - lu(k,1629) * b(k,109) - b(k,100) = b(k,100) - lu(k,1628) * b(k,109) - b(k,99) = b(k,99) - lu(k,1627) * b(k,109) - b(k,98) = b(k,98) - lu(k,1626) * b(k,109) - b(k,97) = b(k,97) - lu(k,1625) * b(k,109) - b(k,96) = b(k,96) - lu(k,1624) * b(k,109) - b(k,95) = b(k,95) - lu(k,1623) * b(k,109) - b(k,94) = b(k,94) - lu(k,1622) * b(k,109) - b(k,93) = b(k,93) - lu(k,1621) * b(k,109) - b(k,92) = b(k,92) - lu(k,1620) * b(k,109) - b(k,91) = b(k,91) - lu(k,1619) * b(k,109) - b(k,90) = b(k,90) - lu(k,1618) * b(k,109) - b(k,89) = b(k,89) - lu(k,1617) * b(k,109) - b(k,88) = b(k,88) - lu(k,1616) * b(k,109) - b(k,87) = b(k,87) - lu(k,1615) * b(k,109) - b(k,86) = b(k,86) - lu(k,1614) * b(k,109) - b(k,74) = b(k,74) - lu(k,1613) * b(k,109) - b(k,67) = b(k,67) - lu(k,1612) * b(k,109) - b(k,63) = b(k,63) - lu(k,1611) * b(k,109) - b(k,108) = b(k,108) * lu(k,1604) - b(k,107) = b(k,107) - lu(k,1603) * b(k,108) - b(k,106) = b(k,106) - lu(k,1602) * b(k,108) - b(k,105) = b(k,105) - lu(k,1601) * b(k,108) - b(k,104) = b(k,104) - lu(k,1600) * b(k,108) - b(k,103) = b(k,103) - lu(k,1599) * b(k,108) - b(k,102) = b(k,102) - lu(k,1598) * b(k,108) - b(k,101) = b(k,101) - lu(k,1597) * b(k,108) - b(k,100) = b(k,100) - lu(k,1596) * b(k,108) - b(k,99) = b(k,99) - lu(k,1595) * b(k,108) - b(k,98) = b(k,98) - lu(k,1594) * b(k,108) - b(k,97) = b(k,97) - lu(k,1593) * b(k,108) - b(k,96) = b(k,96) - lu(k,1592) * b(k,108) - b(k,95) = b(k,95) - lu(k,1591) * b(k,108) - b(k,94) = b(k,94) - lu(k,1590) * b(k,108) - b(k,93) = b(k,93) - lu(k,1589) * b(k,108) - b(k,92) = b(k,92) - lu(k,1588) * b(k,108) - b(k,91) = b(k,91) - lu(k,1587) * b(k,108) - b(k,90) = b(k,90) - lu(k,1586) * b(k,108) - b(k,89) = b(k,89) - lu(k,1585) * b(k,108) - b(k,88) = b(k,88) - lu(k,1584) * b(k,108) - b(k,87) = b(k,87) - lu(k,1583) * b(k,108) - b(k,86) = b(k,86) - lu(k,1582) * b(k,108) - b(k,85) = b(k,85) - lu(k,1581) * b(k,108) - b(k,81) = b(k,81) - lu(k,1580) * b(k,108) - b(k,80) = b(k,80) - lu(k,1579) * b(k,108) - b(k,79) = b(k,79) - lu(k,1578) * b(k,108) - b(k,78) = b(k,78) - lu(k,1577) * b(k,108) - b(k,76) = b(k,76) - lu(k,1576) * b(k,108) - b(k,73) = b(k,73) - lu(k,1575) * b(k,108) - b(k,72) = b(k,72) - lu(k,1574) * b(k,108) - b(k,71) = b(k,71) - lu(k,1573) * b(k,108) - b(k,69) = b(k,69) - lu(k,1572) * b(k,108) - b(k,67) = b(k,67) - lu(k,1571) * b(k,108) - b(k,64) = b(k,64) - lu(k,1570) * b(k,108) - b(k,31) = b(k,31) - lu(k,1569) * b(k,108) - b(k,107) = b(k,107) * lu(k,1561) - b(k,106) = b(k,106) - lu(k,1560) * b(k,107) - b(k,105) = b(k,105) - lu(k,1559) * b(k,107) - b(k,104) = b(k,104) - lu(k,1558) * b(k,107) - b(k,103) = b(k,103) - lu(k,1557) * b(k,107) - b(k,102) = b(k,102) - lu(k,1556) * b(k,107) - b(k,101) = b(k,101) - lu(k,1555) * b(k,107) - b(k,100) = b(k,100) - lu(k,1554) * b(k,107) - b(k,99) = b(k,99) - lu(k,1553) * b(k,107) - b(k,98) = b(k,98) - lu(k,1552) * b(k,107) - b(k,97) = b(k,97) - lu(k,1551) * b(k,107) - b(k,96) = b(k,96) - lu(k,1550) * b(k,107) - b(k,95) = b(k,95) - lu(k,1549) * b(k,107) - b(k,94) = b(k,94) - lu(k,1548) * b(k,107) - b(k,93) = b(k,93) - lu(k,1547) * b(k,107) - b(k,92) = b(k,92) - lu(k,1546) * b(k,107) - b(k,89) = b(k,89) - lu(k,1545) * b(k,107) - b(k,88) = b(k,88) - lu(k,1544) * b(k,107) - b(k,84) = b(k,84) - lu(k,1543) * b(k,107) - b(k,68) = b(k,68) - lu(k,1542) * b(k,107) - b(k,65) = b(k,65) - lu(k,1541) * b(k,107) - b(k,61) = b(k,61) - lu(k,1540) * b(k,107) - b(k,56) = b(k,56) - lu(k,1539) * b(k,107) - b(k,55) = b(k,55) - lu(k,1538) * b(k,107) - b(k,52) = b(k,52) - lu(k,1537) * b(k,107) - b(k,51) = b(k,51) - lu(k,1536) * b(k,107) - b(k,50) = b(k,50) - lu(k,1535) * b(k,107) - b(k,48) = b(k,48) - lu(k,1534) * b(k,107) - b(k,47) = b(k,47) - lu(k,1533) * b(k,107) - b(k,43) = b(k,43) - lu(k,1532) * b(k,107) - b(k,42) = b(k,42) - lu(k,1531) * b(k,107) - b(k,41) = b(k,41) - lu(k,1530) * b(k,107) - b(k,40) = b(k,40) - lu(k,1529) * b(k,107) - b(k,37) = b(k,37) - lu(k,1528) * b(k,107) - b(k,36) = b(k,36) - lu(k,1527) * b(k,107) - b(k,106) = b(k,106) * lu(k,1518) - b(k,105) = b(k,105) - lu(k,1517) * b(k,106) - b(k,104) = b(k,104) - lu(k,1516) * b(k,106) - b(k,103) = b(k,103) - lu(k,1515) * b(k,106) - b(k,102) = b(k,102) - lu(k,1514) * b(k,106) - b(k,101) = b(k,101) - lu(k,1513) * b(k,106) - b(k,100) = b(k,100) - lu(k,1512) * b(k,106) - b(k,99) = b(k,99) - lu(k,1511) * b(k,106) - b(k,98) = b(k,98) - lu(k,1510) * b(k,106) - b(k,97) = b(k,97) - lu(k,1509) * b(k,106) - b(k,96) = b(k,96) - lu(k,1508) * b(k,106) - b(k,95) = b(k,95) - lu(k,1507) * b(k,106) - b(k,94) = b(k,94) - lu(k,1506) * b(k,106) - b(k,93) = b(k,93) - lu(k,1505) * b(k,106) - b(k,92) = b(k,92) - lu(k,1504) * b(k,106) - b(k,91) = b(k,91) - lu(k,1503) * b(k,106) - b(k,90) = b(k,90) - lu(k,1502) * b(k,106) - b(k,89) = b(k,89) - lu(k,1501) * b(k,106) - b(k,88) = b(k,88) - lu(k,1500) * b(k,106) - b(k,87) = b(k,87) - lu(k,1499) * b(k,106) - b(k,86) = b(k,86) - lu(k,1498) * b(k,106) - b(k,84) = b(k,84) - lu(k,1497) * b(k,106) - b(k,83) = b(k,83) - lu(k,1496) * b(k,106) - b(k,82) = b(k,82) - lu(k,1495) * b(k,106) - b(k,81) = b(k,81) - lu(k,1494) * b(k,106) - b(k,80) = b(k,80) - lu(k,1493) * b(k,106) - b(k,75) = b(k,75) - lu(k,1492) * b(k,106) - b(k,74) = b(k,74) - lu(k,1491) * b(k,106) - b(k,73) = b(k,73) - lu(k,1490) * b(k,106) - b(k,66) = b(k,66) - lu(k,1489) * b(k,106) - b(k,65) = b(k,65) - lu(k,1488) * b(k,106) - b(k,63) = b(k,63) - lu(k,1487) * b(k,106) - b(k,50) = b(k,50) - lu(k,1486) * b(k,106) - b(k,105) = b(k,105) * lu(k,1476) - b(k,104) = b(k,104) - lu(k,1475) * b(k,105) - b(k,103) = b(k,103) - lu(k,1474) * b(k,105) - b(k,102) = b(k,102) - lu(k,1473) * b(k,105) - b(k,101) = b(k,101) - lu(k,1472) * b(k,105) - b(k,100) = b(k,100) - lu(k,1471) * b(k,105) - b(k,99) = b(k,99) - lu(k,1470) * b(k,105) - b(k,98) = b(k,98) - lu(k,1469) * b(k,105) - b(k,97) = b(k,97) - lu(k,1468) * b(k,105) - b(k,96) = b(k,96) - lu(k,1467) * b(k,105) - b(k,95) = b(k,95) - lu(k,1466) * b(k,105) - b(k,94) = b(k,94) - lu(k,1465) * b(k,105) - b(k,93) = b(k,93) - lu(k,1464) * b(k,105) - b(k,92) = b(k,92) - lu(k,1463) * b(k,105) - b(k,91) = b(k,91) - lu(k,1462) * b(k,105) - b(k,90) = b(k,90) - lu(k,1461) * b(k,105) - b(k,89) = b(k,89) - lu(k,1460) * b(k,105) - b(k,88) = b(k,88) - lu(k,1459) * b(k,105) - b(k,87) = b(k,87) - lu(k,1458) * b(k,105) - b(k,86) = b(k,86) - lu(k,1457) * b(k,105) - b(k,85) = b(k,85) - lu(k,1456) * b(k,105) - b(k,84) = b(k,84) - lu(k,1455) * b(k,105) - b(k,83) = b(k,83) - lu(k,1454) * b(k,105) - b(k,82) = b(k,82) - lu(k,1453) * b(k,105) - b(k,77) = b(k,77) - lu(k,1452) * b(k,105) - b(k,75) = b(k,75) - lu(k,1451) * b(k,105) - b(k,66) = b(k,66) - lu(k,1450) * b(k,105) - b(k,63) = b(k,63) - lu(k,1449) * b(k,105) - b(k,62) = b(k,62) - lu(k,1448) * b(k,105) - b(k,57) = b(k,57) - lu(k,1447) * b(k,105) - b(k,46) = b(k,46) - lu(k,1446) * b(k,105) - b(k,44) = b(k,44) - lu(k,1445) * b(k,105) - b(k,24) = b(k,24) - lu(k,1444) * b(k,105) - b(k,104) = b(k,104) * lu(k,1433) - b(k,103) = b(k,103) - lu(k,1432) * b(k,104) - b(k,102) = b(k,102) - lu(k,1431) * b(k,104) - b(k,101) = b(k,101) - lu(k,1430) * b(k,104) - b(k,100) = b(k,100) - lu(k,1429) * b(k,104) - b(k,99) = b(k,99) - lu(k,1428) * b(k,104) - b(k,98) = b(k,98) - lu(k,1427) * b(k,104) - b(k,97) = b(k,97) - lu(k,1426) * b(k,104) - b(k,96) = b(k,96) - lu(k,1425) * b(k,104) - b(k,95) = b(k,95) - lu(k,1424) * b(k,104) - b(k,94) = b(k,94) - lu(k,1423) * b(k,104) - b(k,93) = b(k,93) - lu(k,1422) * b(k,104) - b(k,92) = b(k,92) - lu(k,1421) * b(k,104) - b(k,91) = b(k,91) - lu(k,1420) * b(k,104) - b(k,90) = b(k,90) - lu(k,1419) * b(k,104) - b(k,89) = b(k,89) - lu(k,1418) * b(k,104) - b(k,88) = b(k,88) - lu(k,1417) * b(k,104) - b(k,87) = b(k,87) - lu(k,1416) * b(k,104) - b(k,86) = b(k,86) - lu(k,1415) * b(k,104) - b(k,85) = b(k,85) - lu(k,1414) * b(k,104) - b(k,84) = b(k,84) - lu(k,1413) * b(k,104) - b(k,83) = b(k,83) - lu(k,1412) * b(k,104) - b(k,82) = b(k,82) - lu(k,1411) * b(k,104) - b(k,77) = b(k,77) - lu(k,1410) * b(k,104) - b(k,75) = b(k,75) - lu(k,1409) * b(k,104) - b(k,74) = b(k,74) - lu(k,1408) * b(k,104) - b(k,70) = b(k,70) - lu(k,1407) * b(k,104) - b(k,68) = b(k,68) - lu(k,1406) * b(k,104) - b(k,65) = b(k,65) - lu(k,1405) * b(k,104) - b(k,63) = b(k,63) - lu(k,1404) * b(k,104) - b(k,62) = b(k,62) - lu(k,1403) * b(k,104) - b(k,61) = b(k,61) - lu(k,1402) * b(k,104) - b(k,60) = b(k,60) - lu(k,1401) * b(k,104) - b(k,59) = b(k,59) - lu(k,1400) * b(k,104) - b(k,58) = b(k,58) - lu(k,1399) * b(k,104) - b(k,57) = b(k,57) - lu(k,1398) * b(k,104) - b(k,56) = b(k,56) - lu(k,1397) * b(k,104) - b(k,55) = b(k,55) - lu(k,1396) * b(k,104) - b(k,54) = b(k,54) - lu(k,1395) * b(k,104) - b(k,49) = b(k,49) - lu(k,1394) * b(k,104) - b(k,47) = b(k,47) - lu(k,1393) * b(k,104) - b(k,46) = b(k,46) - lu(k,1392) * b(k,104) - b(k,45) = b(k,45) - lu(k,1391) * b(k,104) - b(k,44) = b(k,44) - lu(k,1390) * b(k,104) - b(k,43) = b(k,43) - lu(k,1389) * b(k,104) - b(k,42) = b(k,42) - lu(k,1388) * b(k,104) - b(k,38) = b(k,38) - lu(k,1387) * b(k,104) - b(k,34) = b(k,34) - lu(k,1386) * b(k,104) - b(k,28) = b(k,28) - lu(k,1385) * b(k,104) +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,137) = b(k,137) * lu(k,2087) + b(k,136) = b(k,136) - lu(k,2086) * b(k,137) + b(k,135) = b(k,135) - lu(k,2085) * b(k,137) + b(k,134) = b(k,134) - lu(k,2084) * b(k,137) + b(k,133) = b(k,133) - lu(k,2083) * b(k,137) + b(k,132) = b(k,132) - lu(k,2082) * b(k,137) + b(k,131) = b(k,131) - lu(k,2081) * b(k,137) + b(k,130) = b(k,130) - lu(k,2080) * b(k,137) + b(k,129) = b(k,129) - lu(k,2079) * b(k,137) + b(k,128) = b(k,128) - lu(k,2078) * b(k,137) + b(k,127) = b(k,127) - lu(k,2077) * b(k,137) + b(k,126) = b(k,126) - lu(k,2076) * b(k,137) + b(k,125) = b(k,125) - lu(k,2075) * b(k,137) + b(k,124) = b(k,124) - lu(k,2074) * b(k,137) + b(k,123) = b(k,123) - lu(k,2073) * b(k,137) + b(k,122) = b(k,122) - lu(k,2072) * b(k,137) + b(k,121) = b(k,121) - lu(k,2071) * b(k,137) + b(k,120) = b(k,120) - lu(k,2070) * b(k,137) + b(k,119) = b(k,119) - lu(k,2069) * b(k,137) + b(k,118) = b(k,118) - lu(k,2068) * b(k,137) + b(k,117) = b(k,117) - lu(k,2067) * b(k,137) + b(k,116) = b(k,116) - lu(k,2066) * b(k,137) + b(k,115) = b(k,115) - lu(k,2065) * b(k,137) + b(k,114) = b(k,114) - lu(k,2064) * b(k,137) + b(k,113) = b(k,113) - lu(k,2063) * b(k,137) + b(k,112) = b(k,112) - lu(k,2062) * b(k,137) + b(k,111) = b(k,111) - lu(k,2061) * b(k,137) + b(k,110) = b(k,110) - lu(k,2060) * b(k,137) + b(k,109) = b(k,109) - lu(k,2059) * b(k,137) + b(k,107) = b(k,107) - lu(k,2058) * b(k,137) + b(k,106) = b(k,106) - lu(k,2057) * b(k,137) + b(k,105) = b(k,105) - lu(k,2056) * b(k,137) + b(k,104) = b(k,104) - lu(k,2055) * b(k,137) + b(k,103) = b(k,103) - lu(k,2054) * b(k,137) + b(k,102) = b(k,102) - lu(k,2053) * b(k,137) + b(k,101) = b(k,101) - lu(k,2052) * b(k,137) + b(k,100) = b(k,100) - lu(k,2051) * b(k,137) + b(k,97) = b(k,97) - lu(k,2050) * b(k,137) + b(k,95) = b(k,95) - lu(k,2049) * b(k,137) + b(k,94) = b(k,94) - lu(k,2048) * b(k,137) + b(k,92) = b(k,92) - lu(k,2047) * b(k,137) + b(k,91) = b(k,91) - lu(k,2046) * b(k,137) + b(k,89) = b(k,89) - lu(k,2045) * b(k,137) + b(k,87) = b(k,87) - lu(k,2044) * b(k,137) + b(k,86) = b(k,86) - lu(k,2043) * b(k,137) + b(k,80) = b(k,80) - lu(k,2042) * b(k,137) + b(k,79) = b(k,79) - lu(k,2041) * b(k,137) + b(k,73) = b(k,73) - lu(k,2040) * b(k,137) + b(k,72) = b(k,72) - lu(k,2039) * b(k,137) + b(k,71) = b(k,71) - lu(k,2038) * b(k,137) + b(k,69) = b(k,69) - lu(k,2037) * b(k,137) + b(k,68) = b(k,68) - lu(k,2036) * b(k,137) + b(k,66) = b(k,66) - lu(k,2035) * b(k,137) + b(k,56) = b(k,56) - lu(k,2034) * b(k,137) + b(k,55) = b(k,55) - lu(k,2033) * b(k,137) + b(k,47) = b(k,47) - lu(k,2032) * b(k,137) + b(k,45) = b(k,45) - lu(k,2031) * b(k,137) + b(k,44) = b(k,44) - lu(k,2030) * b(k,137) + b(k,43) = b(k,43) - lu(k,2029) * b(k,137) + b(k,31) = b(k,31) - lu(k,2028) * b(k,137) + b(k,136) = b(k,136) * lu(k,2026) + b(k,135) = b(k,135) - lu(k,2025) * b(k,136) + b(k,134) = b(k,134) - lu(k,2024) * b(k,136) + b(k,133) = b(k,133) - lu(k,2023) * b(k,136) + b(k,132) = b(k,132) - lu(k,2022) * b(k,136) + b(k,131) = b(k,131) - lu(k,2021) * b(k,136) + b(k,130) = b(k,130) - lu(k,2020) * b(k,136) + b(k,129) = b(k,129) - lu(k,2019) * b(k,136) + b(k,128) = b(k,128) - lu(k,2018) * b(k,136) + b(k,127) = b(k,127) - lu(k,2017) * b(k,136) + b(k,126) = b(k,126) - lu(k,2016) * b(k,136) + b(k,125) = b(k,125) - lu(k,2015) * b(k,136) + b(k,124) = b(k,124) - lu(k,2014) * b(k,136) + b(k,123) = b(k,123) - lu(k,2013) * b(k,136) + b(k,122) = b(k,122) - lu(k,2012) * b(k,136) + b(k,121) = b(k,121) - lu(k,2011) * b(k,136) + b(k,120) = b(k,120) - lu(k,2010) * b(k,136) + b(k,119) = b(k,119) - lu(k,2009) * b(k,136) + b(k,118) = b(k,118) - lu(k,2008) * b(k,136) + b(k,117) = b(k,117) - lu(k,2007) * b(k,136) + b(k,116) = b(k,116) - lu(k,2006) * b(k,136) + b(k,115) = b(k,115) - lu(k,2005) * b(k,136) + b(k,114) = b(k,114) - lu(k,2004) * b(k,136) + b(k,113) = b(k,113) - lu(k,2003) * b(k,136) + b(k,112) = b(k,112) - lu(k,2002) * b(k,136) + b(k,111) = b(k,111) - lu(k,2001) * b(k,136) + b(k,110) = b(k,110) - lu(k,2000) * b(k,136) + b(k,109) = b(k,109) - lu(k,1999) * b(k,136) + b(k,108) = b(k,108) - lu(k,1998) * b(k,136) + b(k,107) = b(k,107) - lu(k,1997) * b(k,136) + b(k,106) = b(k,106) - lu(k,1996) * b(k,136) + b(k,105) = b(k,105) - lu(k,1995) * b(k,136) + b(k,104) = b(k,104) - lu(k,1994) * b(k,136) + b(k,101) = b(k,101) - lu(k,1993) * b(k,136) + b(k,97) = b(k,97) - lu(k,1992) * b(k,136) + b(k,87) = b(k,87) - lu(k,1991) * b(k,136) + b(k,86) = b(k,86) - lu(k,1990) * b(k,136) + b(k,82) = b(k,82) - lu(k,1989) * b(k,136) + b(k,81) = b(k,81) - lu(k,1988) * b(k,136) + b(k,77) = b(k,77) - lu(k,1987) * b(k,136) + b(k,67) = b(k,67) - lu(k,1986) * b(k,136) + b(k,63) = b(k,63) - lu(k,1985) * b(k,136) + b(k,62) = b(k,62) - lu(k,1984) * b(k,136) + b(k,57) = b(k,57) - lu(k,1983) * b(k,136) + b(k,53) = b(k,53) - lu(k,1982) * b(k,136) + b(k,52) = b(k,52) - lu(k,1981) * b(k,136) + b(k,36) = b(k,36) - lu(k,1980) * b(k,136) + b(k,135) = b(k,135) * lu(k,1977) + b(k,134) = b(k,134) - lu(k,1976) * b(k,135) + b(k,133) = b(k,133) - lu(k,1975) * b(k,135) + b(k,132) = b(k,132) - lu(k,1974) * b(k,135) + b(k,131) = b(k,131) - lu(k,1973) * b(k,135) + b(k,130) = b(k,130) - lu(k,1972) * b(k,135) + b(k,129) = b(k,129) - lu(k,1971) * b(k,135) + b(k,128) = b(k,128) - lu(k,1970) * b(k,135) + b(k,127) = b(k,127) - lu(k,1969) * b(k,135) + b(k,126) = b(k,126) - lu(k,1968) * b(k,135) + b(k,125) = b(k,125) - lu(k,1967) * b(k,135) + b(k,124) = b(k,124) - lu(k,1966) * b(k,135) + b(k,123) = b(k,123) - lu(k,1965) * b(k,135) + b(k,122) = b(k,122) - lu(k,1964) * b(k,135) + b(k,121) = b(k,121) - lu(k,1963) * b(k,135) + b(k,120) = b(k,120) - lu(k,1962) * b(k,135) + b(k,119) = b(k,119) - lu(k,1961) * b(k,135) + b(k,118) = b(k,118) - lu(k,1960) * b(k,135) + b(k,117) = b(k,117) - lu(k,1959) * b(k,135) + b(k,116) = b(k,116) - lu(k,1958) * b(k,135) + b(k,115) = b(k,115) - lu(k,1957) * b(k,135) + b(k,114) = b(k,114) - lu(k,1956) * b(k,135) + b(k,113) = b(k,113) - lu(k,1955) * b(k,135) + b(k,112) = b(k,112) - lu(k,1954) * b(k,135) + b(k,111) = b(k,111) - lu(k,1953) * b(k,135) + b(k,110) = b(k,110) - lu(k,1952) * b(k,135) + b(k,109) = b(k,109) - lu(k,1951) * b(k,135) + b(k,108) = b(k,108) - lu(k,1950) * b(k,135) + b(k,106) = b(k,106) - lu(k,1949) * b(k,135) + b(k,98) = b(k,98) - lu(k,1948) * b(k,135) + b(k,90) = b(k,90) - lu(k,1947) * b(k,135) + b(k,89) = b(k,89) - lu(k,1946) * b(k,135) + b(k,88) = b(k,88) - lu(k,1945) * b(k,135) + b(k,84) = b(k,84) - lu(k,1944) * b(k,135) + b(k,83) = b(k,83) - lu(k,1943) * b(k,135) + b(k,69) = b(k,69) - lu(k,1942) * b(k,135) + b(k,68) = b(k,68) - lu(k,1941) * b(k,135) + b(k,67) = b(k,67) - lu(k,1940) * b(k,135) + b(k,65) = b(k,65) - lu(k,1939) * b(k,135) + b(k,49) = b(k,49) - lu(k,1938) * b(k,135) + b(k,134) = b(k,134) * lu(k,1934) + b(k,133) = b(k,133) - lu(k,1933) * b(k,134) + b(k,132) = b(k,132) - lu(k,1932) * b(k,134) + b(k,131) = b(k,131) - lu(k,1931) * b(k,134) + b(k,130) = b(k,130) - lu(k,1930) * b(k,134) + b(k,129) = b(k,129) - lu(k,1929) * b(k,134) + b(k,128) = b(k,128) - lu(k,1928) * b(k,134) + b(k,127) = b(k,127) - lu(k,1927) * b(k,134) + b(k,126) = b(k,126) - lu(k,1926) * b(k,134) + b(k,125) = b(k,125) - lu(k,1925) * b(k,134) + b(k,124) = b(k,124) - lu(k,1924) * b(k,134) + b(k,123) = b(k,123) - lu(k,1923) * b(k,134) + b(k,122) = b(k,122) - lu(k,1922) * b(k,134) + b(k,121) = b(k,121) - lu(k,1921) * b(k,134) + b(k,120) = b(k,120) - lu(k,1920) * b(k,134) + b(k,119) = b(k,119) - lu(k,1919) * b(k,134) + b(k,118) = b(k,118) - lu(k,1918) * b(k,134) + b(k,117) = b(k,117) - lu(k,1917) * b(k,134) + b(k,116) = b(k,116) - lu(k,1916) * b(k,134) + b(k,115) = b(k,115) - lu(k,1915) * b(k,134) + b(k,114) = b(k,114) - lu(k,1914) * b(k,134) + b(k,113) = b(k,113) - lu(k,1913) * b(k,134) + b(k,112) = b(k,112) - lu(k,1912) * b(k,134) + b(k,111) = b(k,111) - lu(k,1911) * b(k,134) + b(k,110) = b(k,110) - lu(k,1910) * b(k,134) + b(k,109) = b(k,109) - lu(k,1909) * b(k,134) + b(k,108) = b(k,108) - lu(k,1908) * b(k,134) + b(k,106) = b(k,106) - lu(k,1907) * b(k,134) + b(k,105) = b(k,105) - lu(k,1906) * b(k,134) + b(k,104) = b(k,104) - lu(k,1905) * b(k,134) + b(k,98) = b(k,98) - lu(k,1904) * b(k,134) + b(k,97) = b(k,97) - lu(k,1903) * b(k,134) + b(k,91) = b(k,91) - lu(k,1902) * b(k,134) + b(k,89) = b(k,89) - lu(k,1901) * b(k,134) + b(k,83) = b(k,83) - lu(k,1900) * b(k,134) + b(k,80) = b(k,80) - lu(k,1899) * b(k,134) + b(k,70) = b(k,70) - lu(k,1898) * b(k,134) + b(k,49) = b(k,49) - lu(k,1897) * b(k,134) + b(k,133) = b(k,133) * lu(k,1892) + b(k,132) = b(k,132) - lu(k,1891) * b(k,133) + b(k,131) = b(k,131) - lu(k,1890) * b(k,133) + b(k,130) = b(k,130) - lu(k,1889) * b(k,133) + b(k,129) = b(k,129) - lu(k,1888) * b(k,133) + b(k,128) = b(k,128) - lu(k,1887) * b(k,133) + b(k,127) = b(k,127) - lu(k,1886) * b(k,133) + b(k,126) = b(k,126) - lu(k,1885) * b(k,133) + b(k,125) = b(k,125) - lu(k,1884) * b(k,133) + b(k,124) = b(k,124) - lu(k,1883) * b(k,133) + b(k,123) = b(k,123) - lu(k,1882) * b(k,133) + b(k,122) = b(k,122) - lu(k,1881) * b(k,133) + b(k,121) = b(k,121) - lu(k,1880) * b(k,133) + b(k,120) = b(k,120) - lu(k,1879) * b(k,133) + b(k,119) = b(k,119) - lu(k,1878) * b(k,133) + b(k,118) = b(k,118) - lu(k,1877) * b(k,133) + b(k,117) = b(k,117) - lu(k,1876) * b(k,133) + b(k,116) = b(k,116) - lu(k,1875) * b(k,133) + b(k,115) = b(k,115) - lu(k,1874) * b(k,133) + b(k,114) = b(k,114) - lu(k,1873) * b(k,133) + b(k,113) = b(k,113) - lu(k,1872) * b(k,133) + b(k,112) = b(k,112) - lu(k,1871) * b(k,133) + b(k,111) = b(k,111) - lu(k,1870) * b(k,133) + b(k,110) = b(k,110) - lu(k,1869) * b(k,133) + b(k,109) = b(k,109) - lu(k,1868) * b(k,133) + b(k,107) = b(k,107) - lu(k,1867) * b(k,133) + b(k,106) = b(k,106) - lu(k,1866) * b(k,133) + b(k,105) = b(k,105) - lu(k,1865) * b(k,133) + b(k,101) = b(k,101) - lu(k,1864) * b(k,133) + b(k,98) = b(k,98) - lu(k,1863) * b(k,133) + b(k,89) = b(k,89) - lu(k,1862) * b(k,133) + b(k,83) = b(k,83) - lu(k,1861) * b(k,133) end do end subroutine lu_slv07 subroutine lu_slv08( avec_len, lu, b ) @@ -1498,222 +1426,221 @@ subroutine lu_slv08( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,103) = b(k,103) * lu(k,1373) - b(k,102) = b(k,102) - lu(k,1372) * b(k,103) - b(k,101) = b(k,101) - lu(k,1371) * b(k,103) - b(k,100) = b(k,100) - lu(k,1370) * b(k,103) - b(k,99) = b(k,99) - lu(k,1369) * b(k,103) - b(k,98) = b(k,98) - lu(k,1368) * b(k,103) - b(k,97) = b(k,97) - lu(k,1367) * b(k,103) - b(k,96) = b(k,96) - lu(k,1366) * b(k,103) - b(k,95) = b(k,95) - lu(k,1365) * b(k,103) - b(k,94) = b(k,94) - lu(k,1364) * b(k,103) - b(k,93) = b(k,93) - lu(k,1363) * b(k,103) - b(k,92) = b(k,92) - lu(k,1362) * b(k,103) - b(k,91) = b(k,91) - lu(k,1361) * b(k,103) - b(k,90) = b(k,90) - lu(k,1360) * b(k,103) - b(k,89) = b(k,89) - lu(k,1359) * b(k,103) - b(k,88) = b(k,88) - lu(k,1358) * b(k,103) - b(k,87) = b(k,87) - lu(k,1357) * b(k,103) - b(k,86) = b(k,86) - lu(k,1356) * b(k,103) - b(k,85) = b(k,85) - lu(k,1355) * b(k,103) - b(k,84) = b(k,84) - lu(k,1354) * b(k,103) - b(k,81) = b(k,81) - lu(k,1353) * b(k,103) - b(k,80) = b(k,80) - lu(k,1352) * b(k,103) - b(k,79) = b(k,79) - lu(k,1351) * b(k,103) - b(k,78) = b(k,78) - lu(k,1350) * b(k,103) - b(k,76) = b(k,76) - lu(k,1349) * b(k,103) - b(k,73) = b(k,73) - lu(k,1348) * b(k,103) - b(k,72) = b(k,72) - lu(k,1347) * b(k,103) - b(k,71) = b(k,71) - lu(k,1346) * b(k,103) - b(k,69) = b(k,69) - lu(k,1345) * b(k,103) - b(k,68) = b(k,68) - lu(k,1344) * b(k,103) - b(k,67) = b(k,67) - lu(k,1343) * b(k,103) - b(k,65) = b(k,65) - lu(k,1342) * b(k,103) - b(k,52) = b(k,52) - lu(k,1341) * b(k,103) - b(k,102) = b(k,102) * lu(k,1328) - b(k,101) = b(k,101) - lu(k,1327) * b(k,102) - b(k,100) = b(k,100) - lu(k,1326) * b(k,102) - b(k,99) = b(k,99) - lu(k,1325) * b(k,102) - b(k,98) = b(k,98) - lu(k,1324) * b(k,102) - b(k,97) = b(k,97) - lu(k,1323) * b(k,102) - b(k,96) = b(k,96) - lu(k,1322) * b(k,102) - b(k,95) = b(k,95) - lu(k,1321) * b(k,102) - b(k,94) = b(k,94) - lu(k,1320) * b(k,102) - b(k,93) = b(k,93) - lu(k,1319) * b(k,102) - b(k,92) = b(k,92) - lu(k,1318) * b(k,102) - b(k,91) = b(k,91) - lu(k,1317) * b(k,102) - b(k,90) = b(k,90) - lu(k,1316) * b(k,102) - b(k,89) = b(k,89) - lu(k,1315) * b(k,102) - b(k,88) = b(k,88) - lu(k,1314) * b(k,102) - b(k,87) = b(k,87) - lu(k,1313) * b(k,102) - b(k,86) = b(k,86) - lu(k,1312) * b(k,102) - b(k,85) = b(k,85) - lu(k,1311) * b(k,102) - b(k,74) = b(k,74) - lu(k,1310) * b(k,102) - b(k,68) = b(k,68) - lu(k,1309) * b(k,102) - b(k,63) = b(k,63) - lu(k,1308) * b(k,102) - b(k,59) = b(k,59) - lu(k,1307) * b(k,102) - b(k,38) = b(k,38) - lu(k,1306) * b(k,102) - b(k,101) = b(k,101) * lu(k,1292) - b(k,100) = b(k,100) - lu(k,1291) * b(k,101) - b(k,99) = b(k,99) - lu(k,1290) * b(k,101) - b(k,98) = b(k,98) - lu(k,1289) * b(k,101) - b(k,97) = b(k,97) - lu(k,1288) * b(k,101) - b(k,96) = b(k,96) - lu(k,1287) * b(k,101) - b(k,95) = b(k,95) - lu(k,1286) * b(k,101) - b(k,94) = b(k,94) - lu(k,1285) * b(k,101) - b(k,93) = b(k,93) - lu(k,1284) * b(k,101) - b(k,92) = b(k,92) - lu(k,1283) * b(k,101) - b(k,91) = b(k,91) - lu(k,1282) * b(k,101) - b(k,90) = b(k,90) - lu(k,1281) * b(k,101) - b(k,89) = b(k,89) - lu(k,1280) * b(k,101) - b(k,88) = b(k,88) - lu(k,1279) * b(k,101) - b(k,87) = b(k,87) - lu(k,1278) * b(k,101) - b(k,86) = b(k,86) - lu(k,1277) * b(k,101) - b(k,84) = b(k,84) - lu(k,1276) * b(k,101) - b(k,83) = b(k,83) - lu(k,1275) * b(k,101) - b(k,81) = b(k,81) - lu(k,1274) * b(k,101) - b(k,78) = b(k,78) - lu(k,1273) * b(k,101) - b(k,77) = b(k,77) - lu(k,1272) * b(k,101) - b(k,76) = b(k,76) - lu(k,1271) * b(k,101) - b(k,66) = b(k,66) - lu(k,1270) * b(k,101) - b(k,53) = b(k,53) - lu(k,1269) * b(k,101) - b(k,50) = b(k,50) - lu(k,1268) * b(k,101) - b(k,26) = b(k,26) - lu(k,1267) * b(k,101) - b(k,100) = b(k,100) * lu(k,1252) - b(k,99) = b(k,99) - lu(k,1251) * b(k,100) - b(k,98) = b(k,98) - lu(k,1250) * b(k,100) - b(k,97) = b(k,97) - lu(k,1249) * b(k,100) - b(k,96) = b(k,96) - lu(k,1248) * b(k,100) - b(k,95) = b(k,95) - lu(k,1247) * b(k,100) - b(k,94) = b(k,94) - lu(k,1246) * b(k,100) - b(k,93) = b(k,93) - lu(k,1245) * b(k,100) - b(k,92) = b(k,92) - lu(k,1244) * b(k,100) - b(k,91) = b(k,91) - lu(k,1243) * b(k,100) - b(k,90) = b(k,90) - lu(k,1242) * b(k,100) - b(k,89) = b(k,89) - lu(k,1241) * b(k,100) - b(k,88) = b(k,88) - lu(k,1240) * b(k,100) - b(k,87) = b(k,87) - lu(k,1239) * b(k,100) - b(k,86) = b(k,86) - lu(k,1238) * b(k,100) - b(k,85) = b(k,85) - lu(k,1237) * b(k,100) - b(k,84) = b(k,84) - lu(k,1236) * b(k,100) - b(k,83) = b(k,83) - lu(k,1235) * b(k,100) - b(k,82) = b(k,82) - lu(k,1234) * b(k,100) - b(k,75) = b(k,75) - lu(k,1233) * b(k,100) - b(k,74) = b(k,74) - lu(k,1232) * b(k,100) - b(k,70) = b(k,70) - lu(k,1231) * b(k,100) - b(k,68) = b(k,68) - lu(k,1230) * b(k,100) - b(k,65) = b(k,65) - lu(k,1229) * b(k,100) - b(k,61) = b(k,61) - lu(k,1228) * b(k,100) - b(k,60) = b(k,60) - lu(k,1227) * b(k,100) - b(k,59) = b(k,59) - lu(k,1226) * b(k,100) - b(k,56) = b(k,56) - lu(k,1225) * b(k,100) - b(k,55) = b(k,55) - lu(k,1224) * b(k,100) - b(k,49) = b(k,49) - lu(k,1223) * b(k,100) - b(k,47) = b(k,47) - lu(k,1222) * b(k,100) - b(k,43) = b(k,43) - lu(k,1221) * b(k,100) - b(k,42) = b(k,42) - lu(k,1220) * b(k,100) - b(k,38) = b(k,38) - lu(k,1219) * b(k,100) - b(k,28) = b(k,28) - lu(k,1218) * b(k,100) - b(k,99) = b(k,99) * lu(k,1202) - b(k,98) = b(k,98) - lu(k,1201) * b(k,99) - b(k,97) = b(k,97) - lu(k,1200) * b(k,99) - b(k,96) = b(k,96) - lu(k,1199) * b(k,99) - b(k,95) = b(k,95) - lu(k,1198) * b(k,99) - b(k,94) = b(k,94) - lu(k,1197) * b(k,99) - b(k,93) = b(k,93) - lu(k,1196) * b(k,99) - b(k,92) = b(k,92) - lu(k,1195) * b(k,99) - b(k,91) = b(k,91) - lu(k,1194) * b(k,99) - b(k,90) = b(k,90) - lu(k,1193) * b(k,99) - b(k,89) = b(k,89) - lu(k,1192) * b(k,99) - b(k,88) = b(k,88) - lu(k,1191) * b(k,99) - b(k,87) = b(k,87) - lu(k,1190) * b(k,99) - b(k,86) = b(k,86) - lu(k,1189) * b(k,99) - b(k,85) = b(k,85) - lu(k,1188) * b(k,99) - b(k,84) = b(k,84) - lu(k,1187) * b(k,99) - b(k,83) = b(k,83) - lu(k,1186) * b(k,99) - b(k,82) = b(k,82) - lu(k,1185) * b(k,99) - b(k,75) = b(k,75) - lu(k,1184) * b(k,99) - b(k,74) = b(k,74) - lu(k,1183) * b(k,99) - b(k,70) = b(k,70) - lu(k,1182) * b(k,99) - b(k,68) = b(k,68) - lu(k,1181) * b(k,99) - b(k,60) = b(k,60) - lu(k,1180) * b(k,99) - b(k,59) = b(k,59) - lu(k,1179) * b(k,99) - b(k,49) = b(k,49) - lu(k,1178) * b(k,99) - b(k,28) = b(k,28) - lu(k,1177) * b(k,99) - b(k,98) = b(k,98) * lu(k,1160) - b(k,97) = b(k,97) - lu(k,1159) * b(k,98) - b(k,96) = b(k,96) - lu(k,1158) * b(k,98) - b(k,95) = b(k,95) - lu(k,1157) * b(k,98) - b(k,94) = b(k,94) - lu(k,1156) * b(k,98) - b(k,93) = b(k,93) - lu(k,1155) * b(k,98) - b(k,92) = b(k,92) - lu(k,1154) * b(k,98) - b(k,91) = b(k,91) - lu(k,1153) * b(k,98) - b(k,90) = b(k,90) - lu(k,1152) * b(k,98) - b(k,89) = b(k,89) - lu(k,1151) * b(k,98) - b(k,88) = b(k,88) - lu(k,1150) * b(k,98) - b(k,87) = b(k,87) - lu(k,1149) * b(k,98) - b(k,86) = b(k,86) - lu(k,1148) * b(k,98) - b(k,85) = b(k,85) - lu(k,1147) * b(k,98) - b(k,84) = b(k,84) - lu(k,1146) * b(k,98) - b(k,83) = b(k,83) - lu(k,1145) * b(k,98) - b(k,82) = b(k,82) - lu(k,1144) * b(k,98) - b(k,78) = b(k,78) - lu(k,1143) * b(k,98) - b(k,76) = b(k,76) - lu(k,1142) * b(k,98) - b(k,75) = b(k,75) - lu(k,1141) * b(k,98) - b(k,72) = b(k,72) - lu(k,1140) * b(k,98) - b(k,71) = b(k,71) - lu(k,1139) * b(k,98) - b(k,62) = b(k,62) - lu(k,1138) * b(k,98) - b(k,57) = b(k,57) - lu(k,1137) * b(k,98) - b(k,54) = b(k,54) - lu(k,1136) * b(k,98) - b(k,50) = b(k,50) - lu(k,1135) * b(k,98) - b(k,27) = b(k,27) - lu(k,1134) * b(k,98) - b(k,24) = b(k,24) - lu(k,1133) * b(k,98) - b(k,97) = b(k,97) * lu(k,1115) - b(k,96) = b(k,96) - lu(k,1114) * b(k,97) - b(k,95) = b(k,95) - lu(k,1113) * b(k,97) - b(k,94) = b(k,94) - lu(k,1112) * b(k,97) - b(k,93) = b(k,93) - lu(k,1111) * b(k,97) - b(k,92) = b(k,92) - lu(k,1110) * b(k,97) - b(k,91) = b(k,91) - lu(k,1109) * b(k,97) - b(k,89) = b(k,89) - lu(k,1108) * b(k,97) - b(k,88) = b(k,88) - lu(k,1107) * b(k,97) - b(k,87) = b(k,87) - lu(k,1106) * b(k,97) - b(k,84) = b(k,84) - lu(k,1105) * b(k,97) - b(k,83) = b(k,83) - lu(k,1104) * b(k,97) - b(k,82) = b(k,82) - lu(k,1103) * b(k,97) - b(k,81) = b(k,81) - lu(k,1102) * b(k,97) - b(k,79) = b(k,79) - lu(k,1101) * b(k,97) - b(k,78) = b(k,78) - lu(k,1100) * b(k,97) - b(k,75) = b(k,75) - lu(k,1099) * b(k,97) - b(k,70) = b(k,70) - lu(k,1098) * b(k,97) - b(k,64) = b(k,64) - lu(k,1097) * b(k,97) - b(k,60) = b(k,60) - lu(k,1096) * b(k,97) - b(k,44) = b(k,44) - lu(k,1095) * b(k,97) - b(k,32) = b(k,32) - lu(k,1094) * b(k,97) - b(k,96) = b(k,96) * lu(k,1075) - b(k,95) = b(k,95) - lu(k,1074) * b(k,96) - b(k,94) = b(k,94) - lu(k,1073) * b(k,96) - b(k,93) = b(k,93) - lu(k,1072) * b(k,96) - b(k,92) = b(k,92) - lu(k,1071) * b(k,96) - b(k,91) = b(k,91) - lu(k,1070) * b(k,96) - b(k,90) = b(k,90) - lu(k,1069) * b(k,96) - b(k,89) = b(k,89) - lu(k,1068) * b(k,96) - b(k,88) = b(k,88) - lu(k,1067) * b(k,96) - b(k,87) = b(k,87) - lu(k,1066) * b(k,96) - b(k,86) = b(k,86) - lu(k,1065) * b(k,96) - b(k,85) = b(k,85) - lu(k,1064) * b(k,96) - b(k,81) = b(k,81) - lu(k,1063) * b(k,96) - b(k,80) = b(k,80) - lu(k,1062) * b(k,96) - b(k,79) = b(k,79) - lu(k,1061) * b(k,96) - b(k,78) = b(k,78) - lu(k,1060) * b(k,96) - b(k,76) = b(k,76) - lu(k,1059) * b(k,96) - b(k,73) = b(k,73) - lu(k,1058) * b(k,96) - b(k,72) = b(k,72) - lu(k,1057) * b(k,96) - b(k,71) = b(k,71) - lu(k,1056) * b(k,96) - b(k,69) = b(k,69) - lu(k,1055) * b(k,96) - b(k,67) = b(k,67) - lu(k,1054) * b(k,96) - b(k,51) = b(k,51) - lu(k,1053) * b(k,96) + b(k,132) = b(k,132) * lu(k,1855) + b(k,131) = b(k,131) - lu(k,1854) * b(k,132) + b(k,130) = b(k,130) - lu(k,1853) * b(k,132) + b(k,129) = b(k,129) - lu(k,1852) * b(k,132) + b(k,128) = b(k,128) - lu(k,1851) * b(k,132) + b(k,127) = b(k,127) - lu(k,1850) * b(k,132) + b(k,126) = b(k,126) - lu(k,1849) * b(k,132) + b(k,125) = b(k,125) - lu(k,1848) * b(k,132) + b(k,124) = b(k,124) - lu(k,1847) * b(k,132) + b(k,123) = b(k,123) - lu(k,1846) * b(k,132) + b(k,122) = b(k,122) - lu(k,1845) * b(k,132) + b(k,121) = b(k,121) - lu(k,1844) * b(k,132) + b(k,120) = b(k,120) - lu(k,1843) * b(k,132) + b(k,119) = b(k,119) - lu(k,1842) * b(k,132) + b(k,118) = b(k,118) - lu(k,1841) * b(k,132) + b(k,117) = b(k,117) - lu(k,1840) * b(k,132) + b(k,116) = b(k,116) - lu(k,1839) * b(k,132) + b(k,115) = b(k,115) - lu(k,1838) * b(k,132) + b(k,114) = b(k,114) - lu(k,1837) * b(k,132) + b(k,113) = b(k,113) - lu(k,1836) * b(k,132) + b(k,112) = b(k,112) - lu(k,1835) * b(k,132) + b(k,111) = b(k,111) - lu(k,1834) * b(k,132) + b(k,110) = b(k,110) - lu(k,1833) * b(k,132) + b(k,109) = b(k,109) - lu(k,1832) * b(k,132) + b(k,107) = b(k,107) - lu(k,1831) * b(k,132) + b(k,98) = b(k,98) - lu(k,1830) * b(k,132) + b(k,90) = b(k,90) - lu(k,1829) * b(k,132) + b(k,82) = b(k,82) - lu(k,1828) * b(k,132) + b(k,131) = b(k,131) * lu(k,1821) + b(k,130) = b(k,130) - lu(k,1820) * b(k,131) + b(k,129) = b(k,129) - lu(k,1819) * b(k,131) + b(k,128) = b(k,128) - lu(k,1818) * b(k,131) + b(k,127) = b(k,127) - lu(k,1817) * b(k,131) + b(k,126) = b(k,126) - lu(k,1816) * b(k,131) + b(k,125) = b(k,125) - lu(k,1815) * b(k,131) + b(k,124) = b(k,124) - lu(k,1814) * b(k,131) + b(k,123) = b(k,123) - lu(k,1813) * b(k,131) + b(k,122) = b(k,122) - lu(k,1812) * b(k,131) + b(k,121) = b(k,121) - lu(k,1811) * b(k,131) + b(k,120) = b(k,120) - lu(k,1810) * b(k,131) + b(k,119) = b(k,119) - lu(k,1809) * b(k,131) + b(k,118) = b(k,118) - lu(k,1808) * b(k,131) + b(k,117) = b(k,117) - lu(k,1807) * b(k,131) + b(k,116) = b(k,116) - lu(k,1806) * b(k,131) + b(k,115) = b(k,115) - lu(k,1805) * b(k,131) + b(k,114) = b(k,114) - lu(k,1804) * b(k,131) + b(k,113) = b(k,113) - lu(k,1803) * b(k,131) + b(k,112) = b(k,112) - lu(k,1802) * b(k,131) + b(k,111) = b(k,111) - lu(k,1801) * b(k,131) + b(k,110) = b(k,110) - lu(k,1800) * b(k,131) + b(k,109) = b(k,109) - lu(k,1799) * b(k,131) + b(k,108) = b(k,108) - lu(k,1798) * b(k,131) + b(k,106) = b(k,106) - lu(k,1797) * b(k,131) + b(k,105) = b(k,105) - lu(k,1796) * b(k,131) + b(k,104) = b(k,104) - lu(k,1795) * b(k,131) + b(k,98) = b(k,98) - lu(k,1794) * b(k,131) + b(k,97) = b(k,97) - lu(k,1793) * b(k,131) + b(k,91) = b(k,91) - lu(k,1792) * b(k,131) + b(k,89) = b(k,89) - lu(k,1791) * b(k,131) + b(k,88) = b(k,88) - lu(k,1790) * b(k,131) + b(k,84) = b(k,84) - lu(k,1789) * b(k,131) + b(k,83) = b(k,83) - lu(k,1788) * b(k,131) + b(k,80) = b(k,80) - lu(k,1787) * b(k,131) + b(k,76) = b(k,76) - lu(k,1786) * b(k,131) + b(k,74) = b(k,74) - lu(k,1785) * b(k,131) + b(k,70) = b(k,70) - lu(k,1784) * b(k,131) + b(k,65) = b(k,65) - lu(k,1783) * b(k,131) + b(k,64) = b(k,64) - lu(k,1782) * b(k,131) + b(k,60) = b(k,60) - lu(k,1781) * b(k,131) + b(k,59) = b(k,59) - lu(k,1780) * b(k,131) + b(k,49) = b(k,49) - lu(k,1779) * b(k,131) + b(k,130) = b(k,130) * lu(k,1771) + b(k,129) = b(k,129) - lu(k,1770) * b(k,130) + b(k,128) = b(k,128) - lu(k,1769) * b(k,130) + b(k,127) = b(k,127) - lu(k,1768) * b(k,130) + b(k,126) = b(k,126) - lu(k,1767) * b(k,130) + b(k,125) = b(k,125) - lu(k,1766) * b(k,130) + b(k,124) = b(k,124) - lu(k,1765) * b(k,130) + b(k,123) = b(k,123) - lu(k,1764) * b(k,130) + b(k,122) = b(k,122) - lu(k,1763) * b(k,130) + b(k,121) = b(k,121) - lu(k,1762) * b(k,130) + b(k,120) = b(k,120) - lu(k,1761) * b(k,130) + b(k,119) = b(k,119) - lu(k,1760) * b(k,130) + b(k,118) = b(k,118) - lu(k,1759) * b(k,130) + b(k,117) = b(k,117) - lu(k,1758) * b(k,130) + b(k,116) = b(k,116) - lu(k,1757) * b(k,130) + b(k,115) = b(k,115) - lu(k,1756) * b(k,130) + b(k,114) = b(k,114) - lu(k,1755) * b(k,130) + b(k,113) = b(k,113) - lu(k,1754) * b(k,130) + b(k,112) = b(k,112) - lu(k,1753) * b(k,130) + b(k,111) = b(k,111) - lu(k,1752) * b(k,130) + b(k,110) = b(k,110) - lu(k,1751) * b(k,130) + b(k,109) = b(k,109) - lu(k,1750) * b(k,130) + b(k,108) = b(k,108) - lu(k,1749) * b(k,130) + b(k,107) = b(k,107) - lu(k,1748) * b(k,130) + b(k,106) = b(k,106) - lu(k,1747) * b(k,130) + b(k,105) = b(k,105) - lu(k,1746) * b(k,130) + b(k,104) = b(k,104) - lu(k,1745) * b(k,130) + b(k,97) = b(k,97) - lu(k,1744) * b(k,130) + b(k,91) = b(k,91) - lu(k,1743) * b(k,130) + b(k,87) = b(k,87) - lu(k,1742) * b(k,130) + b(k,82) = b(k,82) - lu(k,1741) * b(k,130) + b(k,81) = b(k,81) - lu(k,1740) * b(k,130) + b(k,80) = b(k,80) - lu(k,1739) * b(k,130) + b(k,77) = b(k,77) - lu(k,1738) * b(k,130) + b(k,50) = b(k,50) - lu(k,1737) * b(k,130) + b(k,41) = b(k,41) - lu(k,1736) * b(k,130) + b(k,36) = b(k,36) - lu(k,1735) * b(k,130) + b(k,24) = b(k,24) - lu(k,1734) * b(k,130) + b(k,129) = b(k,129) * lu(k,1725) + b(k,128) = b(k,128) - lu(k,1724) * b(k,129) + b(k,127) = b(k,127) - lu(k,1723) * b(k,129) + b(k,126) = b(k,126) - lu(k,1722) * b(k,129) + b(k,125) = b(k,125) - lu(k,1721) * b(k,129) + b(k,124) = b(k,124) - lu(k,1720) * b(k,129) + b(k,123) = b(k,123) - lu(k,1719) * b(k,129) + b(k,122) = b(k,122) - lu(k,1718) * b(k,129) + b(k,121) = b(k,121) - lu(k,1717) * b(k,129) + b(k,120) = b(k,120) - lu(k,1716) * b(k,129) + b(k,119) = b(k,119) - lu(k,1715) * b(k,129) + b(k,118) = b(k,118) - lu(k,1714) * b(k,129) + b(k,117) = b(k,117) - lu(k,1713) * b(k,129) + b(k,116) = b(k,116) - lu(k,1712) * b(k,129) + b(k,115) = b(k,115) - lu(k,1711) * b(k,129) + b(k,114) = b(k,114) - lu(k,1710) * b(k,129) + b(k,113) = b(k,113) - lu(k,1709) * b(k,129) + b(k,112) = b(k,112) - lu(k,1708) * b(k,129) + b(k,111) = b(k,111) - lu(k,1707) * b(k,129) + b(k,110) = b(k,110) - lu(k,1706) * b(k,129) + b(k,109) = b(k,109) - lu(k,1705) * b(k,129) + b(k,107) = b(k,107) - lu(k,1704) * b(k,129) + b(k,106) = b(k,106) - lu(k,1703) * b(k,129) + b(k,105) = b(k,105) - lu(k,1702) * b(k,129) + b(k,104) = b(k,104) - lu(k,1701) * b(k,129) + b(k,103) = b(k,103) - lu(k,1700) * b(k,129) + b(k,102) = b(k,102) - lu(k,1699) * b(k,129) + b(k,98) = b(k,98) - lu(k,1698) * b(k,129) + b(k,97) = b(k,97) - lu(k,1697) * b(k,129) + b(k,95) = b(k,95) - lu(k,1696) * b(k,129) + b(k,88) = b(k,88) - lu(k,1695) * b(k,129) + b(k,87) = b(k,87) - lu(k,1694) * b(k,129) + b(k,82) = b(k,82) - lu(k,1693) * b(k,129) + b(k,71) = b(k,71) - lu(k,1692) * b(k,129) + b(k,128) = b(k,128) * lu(k,1682) + b(k,127) = b(k,127) - lu(k,1681) * b(k,128) + b(k,126) = b(k,126) - lu(k,1680) * b(k,128) + b(k,125) = b(k,125) - lu(k,1679) * b(k,128) + b(k,124) = b(k,124) - lu(k,1678) * b(k,128) + b(k,123) = b(k,123) - lu(k,1677) * b(k,128) + b(k,122) = b(k,122) - lu(k,1676) * b(k,128) + b(k,121) = b(k,121) - lu(k,1675) * b(k,128) + b(k,120) = b(k,120) - lu(k,1674) * b(k,128) + b(k,119) = b(k,119) - lu(k,1673) * b(k,128) + b(k,118) = b(k,118) - lu(k,1672) * b(k,128) + b(k,117) = b(k,117) - lu(k,1671) * b(k,128) + b(k,116) = b(k,116) - lu(k,1670) * b(k,128) + b(k,115) = b(k,115) - lu(k,1669) * b(k,128) + b(k,114) = b(k,114) - lu(k,1668) * b(k,128) + b(k,113) = b(k,113) - lu(k,1667) * b(k,128) + b(k,112) = b(k,112) - lu(k,1666) * b(k,128) + b(k,111) = b(k,111) - lu(k,1665) * b(k,128) + b(k,110) = b(k,110) - lu(k,1664) * b(k,128) + b(k,109) = b(k,109) - lu(k,1663) * b(k,128) + b(k,108) = b(k,108) - lu(k,1662) * b(k,128) + b(k,107) = b(k,107) - lu(k,1661) * b(k,128) + b(k,103) = b(k,103) - lu(k,1660) * b(k,128) + b(k,102) = b(k,102) - lu(k,1659) * b(k,128) + b(k,100) = b(k,100) - lu(k,1658) * b(k,128) + b(k,99) = b(k,99) - lu(k,1657) * b(k,128) + b(k,96) = b(k,96) - lu(k,1656) * b(k,128) + b(k,95) = b(k,95) - lu(k,1655) * b(k,128) + b(k,94) = b(k,94) - lu(k,1654) * b(k,128) + b(k,93) = b(k,93) - lu(k,1653) * b(k,128) + b(k,92) = b(k,92) - lu(k,1652) * b(k,128) + b(k,90) = b(k,90) - lu(k,1651) * b(k,128) + b(k,85) = b(k,85) - lu(k,1650) * b(k,128) + b(k,44) = b(k,44) - lu(k,1649) * b(k,128) + b(k,127) = b(k,127) * lu(k,1638) + b(k,126) = b(k,126) - lu(k,1637) * b(k,127) + b(k,125) = b(k,125) - lu(k,1636) * b(k,127) + b(k,124) = b(k,124) - lu(k,1635) * b(k,127) + b(k,123) = b(k,123) - lu(k,1634) * b(k,127) + b(k,122) = b(k,122) - lu(k,1633) * b(k,127) + b(k,121) = b(k,121) - lu(k,1632) * b(k,127) + b(k,120) = b(k,120) - lu(k,1631) * b(k,127) + b(k,119) = b(k,119) - lu(k,1630) * b(k,127) + b(k,118) = b(k,118) - lu(k,1629) * b(k,127) + b(k,117) = b(k,117) - lu(k,1628) * b(k,127) + b(k,116) = b(k,116) - lu(k,1627) * b(k,127) + b(k,115) = b(k,115) - lu(k,1626) * b(k,127) + b(k,114) = b(k,114) - lu(k,1625) * b(k,127) + b(k,113) = b(k,113) - lu(k,1624) * b(k,127) + b(k,112) = b(k,112) - lu(k,1623) * b(k,127) + b(k,111) = b(k,111) - lu(k,1622) * b(k,127) + b(k,110) = b(k,110) - lu(k,1621) * b(k,127) + b(k,109) = b(k,109) - lu(k,1620) * b(k,127) + b(k,107) = b(k,107) - lu(k,1619) * b(k,127) + b(k,106) = b(k,106) - lu(k,1618) * b(k,127) + b(k,105) = b(k,105) - lu(k,1617) * b(k,127) + b(k,104) = b(k,104) - lu(k,1616) * b(k,127) + b(k,103) = b(k,103) - lu(k,1615) * b(k,127) + b(k,102) = b(k,102) - lu(k,1614) * b(k,127) + b(k,100) = b(k,100) - lu(k,1613) * b(k,127) + b(k,99) = b(k,99) - lu(k,1612) * b(k,127) + b(k,98) = b(k,98) - lu(k,1611) * b(k,127) + b(k,97) = b(k,97) - lu(k,1610) * b(k,127) + b(k,91) = b(k,91) - lu(k,1609) * b(k,127) + b(k,88) = b(k,88) - lu(k,1608) * b(k,127) + b(k,85) = b(k,85) - lu(k,1607) * b(k,127) + b(k,81) = b(k,81) - lu(k,1606) * b(k,127) + b(k,80) = b(k,80) - lu(k,1605) * b(k,127) + b(k,75) = b(k,75) - lu(k,1604) * b(k,127) + b(k,61) = b(k,61) - lu(k,1603) * b(k,127) + b(k,58) = b(k,58) - lu(k,1602) * b(k,127) + b(k,42) = b(k,42) - lu(k,1601) * b(k,127) end do end subroutine lu_slv08 subroutine lu_slv09( avec_len, lu, b ) @@ -1734,209 +1661,240 @@ subroutine lu_slv09( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,95) = b(k,95) * lu(k,1033) - b(k,94) = b(k,94) - lu(k,1032) * b(k,95) - b(k,93) = b(k,93) - lu(k,1031) * b(k,95) - b(k,92) = b(k,92) - lu(k,1030) * b(k,95) - b(k,91) = b(k,91) - lu(k,1029) * b(k,95) - b(k,90) = b(k,90) - lu(k,1028) * b(k,95) - b(k,89) = b(k,89) - lu(k,1027) * b(k,95) - b(k,88) = b(k,88) - lu(k,1026) * b(k,95) - b(k,87) = b(k,87) - lu(k,1025) * b(k,95) - b(k,86) = b(k,86) - lu(k,1024) * b(k,95) - b(k,85) = b(k,85) - lu(k,1023) * b(k,95) - b(k,81) = b(k,81) - lu(k,1022) * b(k,95) - b(k,80) = b(k,80) - lu(k,1021) * b(k,95) - b(k,79) = b(k,79) - lu(k,1020) * b(k,95) - b(k,78) = b(k,78) - lu(k,1019) * b(k,95) - b(k,76) = b(k,76) - lu(k,1018) * b(k,95) - b(k,73) = b(k,73) - lu(k,1017) * b(k,95) - b(k,72) = b(k,72) - lu(k,1016) * b(k,95) - b(k,71) = b(k,71) - lu(k,1015) * b(k,95) - b(k,69) = b(k,69) - lu(k,1014) * b(k,95) - b(k,67) = b(k,67) - lu(k,1013) * b(k,95) - b(k,51) = b(k,51) - lu(k,1012) * b(k,95) - b(k,48) = b(k,48) - lu(k,1011) * b(k,95) - b(k,94) = b(k,94) * lu(k,990) - b(k,93) = b(k,93) - lu(k,989) * b(k,94) - b(k,92) = b(k,92) - lu(k,988) * b(k,94) - b(k,91) = b(k,91) - lu(k,987) * b(k,94) - b(k,90) = b(k,90) - lu(k,986) * b(k,94) - b(k,89) = b(k,89) - lu(k,985) * b(k,94) - b(k,88) = b(k,88) - lu(k,984) * b(k,94) - b(k,87) = b(k,87) - lu(k,983) * b(k,94) - b(k,86) = b(k,86) - lu(k,982) * b(k,94) - b(k,84) = b(k,84) - lu(k,981) * b(k,94) - b(k,83) = b(k,83) - lu(k,980) * b(k,94) - b(k,82) = b(k,82) - lu(k,979) * b(k,94) - b(k,81) = b(k,81) - lu(k,978) * b(k,94) - b(k,80) = b(k,80) - lu(k,977) * b(k,94) - b(k,79) = b(k,79) - lu(k,976) * b(k,94) - b(k,78) = b(k,78) - lu(k,975) * b(k,94) - b(k,75) = b(k,75) - lu(k,974) * b(k,94) - b(k,74) = b(k,74) - lu(k,973) * b(k,94) - b(k,70) = b(k,70) - lu(k,972) * b(k,94) - b(k,65) = b(k,65) - lu(k,971) * b(k,94) - b(k,64) = b(k,64) - lu(k,970) * b(k,94) - b(k,62) = b(k,62) - lu(k,969) * b(k,94) - b(k,60) = b(k,60) - lu(k,968) * b(k,94) - b(k,54) = b(k,54) - lu(k,967) * b(k,94) - b(k,45) = b(k,45) - lu(k,966) * b(k,94) - b(k,39) = b(k,39) - lu(k,965) * b(k,94) - b(k,93) = b(k,93) * lu(k,943) - b(k,92) = b(k,92) - lu(k,942) * b(k,93) - b(k,91) = b(k,91) - lu(k,941) * b(k,93) - b(k,90) = b(k,90) - lu(k,940) * b(k,93) - b(k,89) = b(k,89) - lu(k,939) * b(k,93) - b(k,88) = b(k,88) - lu(k,938) * b(k,93) - b(k,87) = b(k,87) - lu(k,937) * b(k,93) - b(k,86) = b(k,86) - lu(k,936) * b(k,93) - b(k,85) = b(k,85) - lu(k,935) * b(k,93) - b(k,81) = b(k,81) - lu(k,934) * b(k,93) - b(k,80) = b(k,80) - lu(k,933) * b(k,93) - b(k,79) = b(k,79) - lu(k,932) * b(k,93) - b(k,78) = b(k,78) - lu(k,931) * b(k,93) - b(k,76) = b(k,76) - lu(k,930) * b(k,93) - b(k,73) = b(k,73) - lu(k,929) * b(k,93) - b(k,72) = b(k,72) - lu(k,928) * b(k,93) - b(k,71) = b(k,71) - lu(k,927) * b(k,93) - b(k,69) = b(k,69) - lu(k,926) * b(k,93) - b(k,67) = b(k,67) - lu(k,925) * b(k,93) - b(k,50) = b(k,50) - lu(k,924) * b(k,93) - b(k,37) = b(k,37) - lu(k,923) * b(k,93) - b(k,92) = b(k,92) * lu(k,900) - b(k,91) = b(k,91) - lu(k,899) * b(k,92) - b(k,90) = b(k,90) - lu(k,898) * b(k,92) - b(k,89) = b(k,89) - lu(k,897) * b(k,92) - b(k,88) = b(k,88) - lu(k,896) * b(k,92) - b(k,87) = b(k,87) - lu(k,895) * b(k,92) - b(k,86) = b(k,86) - lu(k,894) * b(k,92) - b(k,85) = b(k,85) - lu(k,893) * b(k,92) - b(k,84) = b(k,84) - lu(k,892) * b(k,92) - b(k,81) = b(k,81) - lu(k,891) * b(k,92) - b(k,80) = b(k,80) - lu(k,890) * b(k,92) - b(k,79) = b(k,79) - lu(k,889) * b(k,92) - b(k,78) = b(k,78) - lu(k,888) * b(k,92) - b(k,76) = b(k,76) - lu(k,887) * b(k,92) - b(k,73) = b(k,73) - lu(k,886) * b(k,92) - b(k,72) = b(k,72) - lu(k,885) * b(k,92) - b(k,71) = b(k,71) - lu(k,884) * b(k,92) - b(k,69) = b(k,69) - lu(k,883) * b(k,92) - b(k,67) = b(k,67) - lu(k,882) * b(k,92) - b(k,65) = b(k,65) - lu(k,881) * b(k,92) - b(k,61) = b(k,61) - lu(k,880) * b(k,92) - b(k,56) = b(k,56) - lu(k,879) * b(k,92) - b(k,55) = b(k,55) - lu(k,878) * b(k,92) - b(k,41) = b(k,41) - lu(k,877) * b(k,92) - b(k,40) = b(k,40) - lu(k,876) * b(k,92) - b(k,91) = b(k,91) * lu(k,852) - b(k,89) = b(k,89) - lu(k,851) * b(k,91) - b(k,87) = b(k,87) - lu(k,850) * b(k,91) - b(k,86) = b(k,86) - lu(k,849) * b(k,91) - b(k,73) = b(k,73) - lu(k,848) * b(k,91) - b(k,50) = b(k,50) - lu(k,847) * b(k,91) - b(k,90) = b(k,90) * lu(k,822) - b(k,89) = b(k,89) - lu(k,821) * b(k,90) - b(k,87) = b(k,87) - lu(k,820) * b(k,90) - b(k,86) = b(k,86) - lu(k,819) * b(k,90) - b(k,81) = b(k,81) - lu(k,818) * b(k,90) - b(k,80) = b(k,80) - lu(k,817) * b(k,90) - b(k,74) = b(k,74) - lu(k,816) * b(k,90) - b(k,63) = b(k,63) - lu(k,815) * b(k,90) - b(k,89) = b(k,89) * lu(k,794) - b(k,88) = b(k,88) - lu(k,793) * b(k,89) - b(k,84) = b(k,84) - lu(k,792) * b(k,89) - b(k,83) = b(k,83) - lu(k,791) * b(k,89) - b(k,82) = b(k,82) - lu(k,790) * b(k,89) - b(k,77) = b(k,77) - lu(k,789) * b(k,89) - b(k,75) = b(k,75) - lu(k,788) * b(k,89) - b(k,70) = b(k,70) - lu(k,787) * b(k,89) - b(k,66) = b(k,66) - lu(k,786) * b(k,89) - b(k,65) = b(k,65) - lu(k,785) * b(k,89) - b(k,62) = b(k,62) - lu(k,784) * b(k,89) - b(k,60) = b(k,60) - lu(k,783) * b(k,89) - b(k,58) = b(k,58) - lu(k,782) * b(k,89) - b(k,57) = b(k,57) - lu(k,781) * b(k,89) - b(k,53) = b(k,53) - lu(k,780) * b(k,89) - b(k,51) = b(k,51) - lu(k,779) * b(k,89) - b(k,50) = b(k,50) - lu(k,778) * b(k,89) - b(k,49) = b(k,49) - lu(k,777) * b(k,89) - b(k,46) = b(k,46) - lu(k,776) * b(k,89) - b(k,44) = b(k,44) - lu(k,775) * b(k,89) - b(k,39) = b(k,39) - lu(k,774) * b(k,89) - b(k,35) = b(k,35) - lu(k,773) * b(k,89) - b(k,34) = b(k,34) - lu(k,772) * b(k,89) - b(k,32) = b(k,32) - lu(k,771) * b(k,89) - b(k,29) = b(k,29) - lu(k,770) * b(k,89) - b(k,25) = b(k,25) - lu(k,769) * b(k,89) - b(k,23) = b(k,23) - lu(k,768) * b(k,89) - b(k,88) = b(k,88) * lu(k,747) - b(k,84) = b(k,84) - lu(k,746) * b(k,88) - b(k,83) = b(k,83) - lu(k,745) * b(k,88) - b(k,82) = b(k,82) - lu(k,744) * b(k,88) - b(k,77) = b(k,77) - lu(k,743) * b(k,88) - b(k,75) = b(k,75) - lu(k,742) * b(k,88) - b(k,66) = b(k,66) - lu(k,741) * b(k,88) - b(k,58) = b(k,58) - lu(k,740) * b(k,88) - b(k,57) = b(k,57) - lu(k,739) * b(k,88) - b(k,54) = b(k,54) - lu(k,738) * b(k,88) - b(k,51) = b(k,51) - lu(k,737) * b(k,88) - b(k,46) = b(k,46) - lu(k,736) * b(k,88) - b(k,39) = b(k,39) - lu(k,735) * b(k,88) - b(k,35) = b(k,35) - lu(k,734) * b(k,88) - b(k,87) = b(k,87) * lu(k,713) - b(k,86) = b(k,86) - lu(k,712) * b(k,87) - b(k,81) = b(k,81) - lu(k,711) * b(k,87) - b(k,78) = b(k,78) - lu(k,710) * b(k,87) - b(k,76) = b(k,76) - lu(k,709) * b(k,87) - b(k,86) = b(k,86) * lu(k,690) - b(k,72) = b(k,72) - lu(k,689) * b(k,86) - b(k,71) = b(k,71) - lu(k,688) * b(k,86) - b(k,85) = b(k,85) * lu(k,660) - b(k,74) = b(k,74) - lu(k,659) * b(k,85) - b(k,63) = b(k,63) - lu(k,658) * b(k,85) - b(k,84) = b(k,84) * lu(k,637) - b(k,83) = b(k,83) - lu(k,636) * b(k,84) - b(k,82) = b(k,82) - lu(k,635) * b(k,84) - b(k,77) = b(k,77) - lu(k,634) * b(k,84) - b(k,75) = b(k,75) - lu(k,633) * b(k,84) - b(k,68) = b(k,68) - lu(k,632) * b(k,84) - b(k,66) = b(k,66) - lu(k,631) * b(k,84) - b(k,59) = b(k,59) - lu(k,630) * b(k,84) - b(k,58) = b(k,58) - lu(k,629) * b(k,84) - b(k,53) = b(k,53) - lu(k,628) * b(k,84) - b(k,28) = b(k,28) - lu(k,627) * b(k,84) - b(k,25) = b(k,25) - lu(k,626) * b(k,84) - b(k,23) = b(k,23) - lu(k,625) * b(k,84) - b(k,83) = b(k,83) * lu(k,606) - b(k,82) = b(k,82) - lu(k,605) * b(k,83) - b(k,77) = b(k,77) - lu(k,604) * b(k,83) - b(k,75) = b(k,75) - lu(k,603) * b(k,83) - b(k,58) = b(k,58) - lu(k,602) * b(k,83) - b(k,44) = b(k,44) - lu(k,601) * b(k,83) - b(k,82) = b(k,82) * lu(k,584) - b(k,75) = b(k,75) - lu(k,583) * b(k,82) - b(k,70) = b(k,70) - lu(k,582) * b(k,82) - b(k,60) = b(k,60) - lu(k,581) * b(k,82) - b(k,54) = b(k,54) - lu(k,580) * b(k,82) - b(k,45) = b(k,45) - lu(k,579) * b(k,82) - b(k,33) = b(k,33) - lu(k,578) * b(k,82) - b(k,27) = b(k,27) - lu(k,577) * b(k,82) - b(k,81) = b(k,81) * lu(k,560) - b(k,79) = b(k,79) - lu(k,559) * b(k,81) - b(k,78) = b(k,78) - lu(k,558) * b(k,81) - b(k,64) = b(k,64) - lu(k,557) * b(k,81) - b(k,80) = b(k,80) * lu(k,539) - b(k,73) = b(k,73) - lu(k,538) * b(k,80) - b(k,69) = b(k,69) - lu(k,537) * b(k,80) - b(k,79) = b(k,79) * lu(k,519) - b(k,78) = b(k,78) - lu(k,518) * b(k,79) - b(k,64) = b(k,64) - lu(k,517) * b(k,79) - b(k,78) = b(k,78) * lu(k,503) - b(k,77) = b(k,77) * lu(k,484) - b(k,66) = b(k,66) - lu(k,483) * b(k,77) - b(k,53) = b(k,53) - lu(k,482) * b(k,77) - b(k,26) = b(k,26) - lu(k,481) * b(k,77) + b(k,126) = b(k,126) * lu(k,1589) + b(k,125) = b(k,125) - lu(k,1588) * b(k,126) + b(k,124) = b(k,124) - lu(k,1587) * b(k,126) + b(k,123) = b(k,123) - lu(k,1586) * b(k,126) + b(k,122) = b(k,122) - lu(k,1585) * b(k,126) + b(k,121) = b(k,121) - lu(k,1584) * b(k,126) + b(k,120) = b(k,120) - lu(k,1583) * b(k,126) + b(k,119) = b(k,119) - lu(k,1582) * b(k,126) + b(k,118) = b(k,118) - lu(k,1581) * b(k,126) + b(k,117) = b(k,117) - lu(k,1580) * b(k,126) + b(k,116) = b(k,116) - lu(k,1579) * b(k,126) + b(k,115) = b(k,115) - lu(k,1578) * b(k,126) + b(k,114) = b(k,114) - lu(k,1577) * b(k,126) + b(k,113) = b(k,113) - lu(k,1576) * b(k,126) + b(k,112) = b(k,112) - lu(k,1575) * b(k,126) + b(k,111) = b(k,111) - lu(k,1574) * b(k,126) + b(k,110) = b(k,110) - lu(k,1573) * b(k,126) + b(k,109) = b(k,109) - lu(k,1572) * b(k,126) + b(k,108) = b(k,108) - lu(k,1571) * b(k,126) + b(k,107) = b(k,107) - lu(k,1570) * b(k,126) + b(k,106) = b(k,106) - lu(k,1569) * b(k,126) + b(k,103) = b(k,103) - lu(k,1568) * b(k,126) + b(k,102) = b(k,102) - lu(k,1567) * b(k,126) + b(k,100) = b(k,100) - lu(k,1566) * b(k,126) + b(k,99) = b(k,99) - lu(k,1565) * b(k,126) + b(k,96) = b(k,96) - lu(k,1564) * b(k,126) + b(k,95) = b(k,95) - lu(k,1563) * b(k,126) + b(k,94) = b(k,94) - lu(k,1562) * b(k,126) + b(k,93) = b(k,93) - lu(k,1561) * b(k,126) + b(k,92) = b(k,92) - lu(k,1560) * b(k,126) + b(k,90) = b(k,90) - lu(k,1559) * b(k,126) + b(k,89) = b(k,89) - lu(k,1558) * b(k,126) + b(k,88) = b(k,88) - lu(k,1557) * b(k,126) + b(k,73) = b(k,73) - lu(k,1556) * b(k,126) + b(k,125) = b(k,125) * lu(k,1543) + b(k,124) = b(k,124) - lu(k,1542) * b(k,125) + b(k,123) = b(k,123) - lu(k,1541) * b(k,125) + b(k,122) = b(k,122) - lu(k,1540) * b(k,125) + b(k,121) = b(k,121) - lu(k,1539) * b(k,125) + b(k,120) = b(k,120) - lu(k,1538) * b(k,125) + b(k,119) = b(k,119) - lu(k,1537) * b(k,125) + b(k,118) = b(k,118) - lu(k,1536) * b(k,125) + b(k,117) = b(k,117) - lu(k,1535) * b(k,125) + b(k,116) = b(k,116) - lu(k,1534) * b(k,125) + b(k,115) = b(k,115) - lu(k,1533) * b(k,125) + b(k,114) = b(k,114) - lu(k,1532) * b(k,125) + b(k,113) = b(k,113) - lu(k,1531) * b(k,125) + b(k,112) = b(k,112) - lu(k,1530) * b(k,125) + b(k,111) = b(k,111) - lu(k,1529) * b(k,125) + b(k,110) = b(k,110) - lu(k,1528) * b(k,125) + b(k,109) = b(k,109) - lu(k,1527) * b(k,125) + b(k,108) = b(k,108) - lu(k,1526) * b(k,125) + b(k,107) = b(k,107) - lu(k,1525) * b(k,125) + b(k,98) = b(k,98) - lu(k,1524) * b(k,125) + b(k,89) = b(k,89) - lu(k,1523) * b(k,125) + b(k,83) = b(k,83) - lu(k,1522) * b(k,125) + b(k,82) = b(k,82) - lu(k,1521) * b(k,125) + b(k,65) = b(k,65) - lu(k,1520) * b(k,125) + b(k,124) = b(k,124) * lu(k,1506) + b(k,123) = b(k,123) - lu(k,1505) * b(k,124) + b(k,122) = b(k,122) - lu(k,1504) * b(k,124) + b(k,121) = b(k,121) - lu(k,1503) * b(k,124) + b(k,120) = b(k,120) - lu(k,1502) * b(k,124) + b(k,119) = b(k,119) - lu(k,1501) * b(k,124) + b(k,118) = b(k,118) - lu(k,1500) * b(k,124) + b(k,117) = b(k,117) - lu(k,1499) * b(k,124) + b(k,116) = b(k,116) - lu(k,1498) * b(k,124) + b(k,115) = b(k,115) - lu(k,1497) * b(k,124) + b(k,114) = b(k,114) - lu(k,1496) * b(k,124) + b(k,113) = b(k,113) - lu(k,1495) * b(k,124) + b(k,112) = b(k,112) - lu(k,1494) * b(k,124) + b(k,111) = b(k,111) - lu(k,1493) * b(k,124) + b(k,110) = b(k,110) - lu(k,1492) * b(k,124) + b(k,109) = b(k,109) - lu(k,1491) * b(k,124) + b(k,108) = b(k,108) - lu(k,1490) * b(k,124) + b(k,107) = b(k,107) - lu(k,1489) * b(k,124) + b(k,106) = b(k,106) - lu(k,1488) * b(k,124) + b(k,105) = b(k,105) - lu(k,1487) * b(k,124) + b(k,104) = b(k,104) - lu(k,1486) * b(k,124) + b(k,99) = b(k,99) - lu(k,1485) * b(k,124) + b(k,97) = b(k,97) - lu(k,1484) * b(k,124) + b(k,96) = b(k,96) - lu(k,1483) * b(k,124) + b(k,94) = b(k,94) - lu(k,1482) * b(k,124) + b(k,93) = b(k,93) - lu(k,1481) * b(k,124) + b(k,81) = b(k,81) - lu(k,1480) * b(k,124) + b(k,77) = b(k,77) - lu(k,1479) * b(k,124) + b(k,75) = b(k,75) - lu(k,1478) * b(k,124) + b(k,71) = b(k,71) - lu(k,1477) * b(k,124) + b(k,41) = b(k,41) - lu(k,1476) * b(k,124) + b(k,36) = b(k,36) - lu(k,1475) * b(k,124) + b(k,123) = b(k,123) * lu(k,1460) + b(k,122) = b(k,122) - lu(k,1459) * b(k,123) + b(k,121) = b(k,121) - lu(k,1458) * b(k,123) + b(k,120) = b(k,120) - lu(k,1457) * b(k,123) + b(k,119) = b(k,119) - lu(k,1456) * b(k,123) + b(k,118) = b(k,118) - lu(k,1455) * b(k,123) + b(k,117) = b(k,117) - lu(k,1454) * b(k,123) + b(k,116) = b(k,116) - lu(k,1453) * b(k,123) + b(k,115) = b(k,115) - lu(k,1452) * b(k,123) + b(k,114) = b(k,114) - lu(k,1451) * b(k,123) + b(k,113) = b(k,113) - lu(k,1450) * b(k,123) + b(k,112) = b(k,112) - lu(k,1449) * b(k,123) + b(k,111) = b(k,111) - lu(k,1448) * b(k,123) + b(k,110) = b(k,110) - lu(k,1447) * b(k,123) + b(k,109) = b(k,109) - lu(k,1446) * b(k,123) + b(k,108) = b(k,108) - lu(k,1445) * b(k,123) + b(k,107) = b(k,107) - lu(k,1444) * b(k,123) + b(k,103) = b(k,103) - lu(k,1443) * b(k,123) + b(k,102) = b(k,102) - lu(k,1442) * b(k,123) + b(k,100) = b(k,100) - lu(k,1441) * b(k,123) + b(k,99) = b(k,99) - lu(k,1440) * b(k,123) + b(k,96) = b(k,96) - lu(k,1439) * b(k,123) + b(k,95) = b(k,95) - lu(k,1438) * b(k,123) + b(k,94) = b(k,94) - lu(k,1437) * b(k,123) + b(k,93) = b(k,93) - lu(k,1436) * b(k,123) + b(k,92) = b(k,92) - lu(k,1435) * b(k,123) + b(k,90) = b(k,90) - lu(k,1434) * b(k,123) + b(k,72) = b(k,72) - lu(k,1433) * b(k,123) + b(k,66) = b(k,66) - lu(k,1432) * b(k,123) + b(k,122) = b(k,122) * lu(k,1416) + b(k,121) = b(k,121) - lu(k,1415) * b(k,122) + b(k,120) = b(k,120) - lu(k,1414) * b(k,122) + b(k,119) = b(k,119) - lu(k,1413) * b(k,122) + b(k,118) = b(k,118) - lu(k,1412) * b(k,122) + b(k,117) = b(k,117) - lu(k,1411) * b(k,122) + b(k,116) = b(k,116) - lu(k,1410) * b(k,122) + b(k,115) = b(k,115) - lu(k,1409) * b(k,122) + b(k,114) = b(k,114) - lu(k,1408) * b(k,122) + b(k,113) = b(k,113) - lu(k,1407) * b(k,122) + b(k,112) = b(k,112) - lu(k,1406) * b(k,122) + b(k,111) = b(k,111) - lu(k,1405) * b(k,122) + b(k,110) = b(k,110) - lu(k,1404) * b(k,122) + b(k,109) = b(k,109) - lu(k,1403) * b(k,122) + b(k,108) = b(k,108) - lu(k,1402) * b(k,122) + b(k,107) = b(k,107) - lu(k,1401) * b(k,122) + b(k,103) = b(k,103) - lu(k,1400) * b(k,122) + b(k,102) = b(k,102) - lu(k,1399) * b(k,122) + b(k,100) = b(k,100) - lu(k,1398) * b(k,122) + b(k,99) = b(k,99) - lu(k,1397) * b(k,122) + b(k,96) = b(k,96) - lu(k,1396) * b(k,122) + b(k,95) = b(k,95) - lu(k,1395) * b(k,122) + b(k,94) = b(k,94) - lu(k,1394) * b(k,122) + b(k,93) = b(k,93) - lu(k,1393) * b(k,122) + b(k,92) = b(k,92) - lu(k,1392) * b(k,122) + b(k,90) = b(k,90) - lu(k,1391) * b(k,122) + b(k,85) = b(k,85) - lu(k,1390) * b(k,122) + b(k,45) = b(k,45) - lu(k,1389) * b(k,122) + b(k,121) = b(k,121) * lu(k,1372) + b(k,120) = b(k,120) - lu(k,1371) * b(k,121) + b(k,119) = b(k,119) - lu(k,1370) * b(k,121) + b(k,118) = b(k,118) - lu(k,1369) * b(k,121) + b(k,117) = b(k,117) - lu(k,1368) * b(k,121) + b(k,116) = b(k,116) - lu(k,1367) * b(k,121) + b(k,115) = b(k,115) - lu(k,1366) * b(k,121) + b(k,114) = b(k,114) - lu(k,1365) * b(k,121) + b(k,113) = b(k,113) - lu(k,1364) * b(k,121) + b(k,112) = b(k,112) - lu(k,1363) * b(k,121) + b(k,111) = b(k,111) - lu(k,1362) * b(k,121) + b(k,110) = b(k,110) - lu(k,1361) * b(k,121) + b(k,109) = b(k,109) - lu(k,1360) * b(k,121) + b(k,108) = b(k,108) - lu(k,1359) * b(k,121) + b(k,107) = b(k,107) - lu(k,1358) * b(k,121) + b(k,106) = b(k,106) - lu(k,1357) * b(k,121) + b(k,105) = b(k,105) - lu(k,1356) * b(k,121) + b(k,101) = b(k,101) - lu(k,1355) * b(k,121) + b(k,98) = b(k,98) - lu(k,1354) * b(k,121) + b(k,72) = b(k,72) - lu(k,1353) * b(k,121) + b(k,120) = b(k,120) * lu(k,1335) + b(k,119) = b(k,119) - lu(k,1334) * b(k,120) + b(k,118) = b(k,118) - lu(k,1333) * b(k,120) + b(k,117) = b(k,117) - lu(k,1332) * b(k,120) + b(k,116) = b(k,116) - lu(k,1331) * b(k,120) + b(k,115) = b(k,115) - lu(k,1330) * b(k,120) + b(k,114) = b(k,114) - lu(k,1329) * b(k,120) + b(k,113) = b(k,113) - lu(k,1328) * b(k,120) + b(k,112) = b(k,112) - lu(k,1327) * b(k,120) + b(k,111) = b(k,111) - lu(k,1326) * b(k,120) + b(k,110) = b(k,110) - lu(k,1325) * b(k,120) + b(k,109) = b(k,109) - lu(k,1324) * b(k,120) + b(k,108) = b(k,108) - lu(k,1323) * b(k,120) + b(k,107) = b(k,107) - lu(k,1322) * b(k,120) + b(k,103) = b(k,103) - lu(k,1321) * b(k,120) + b(k,102) = b(k,102) - lu(k,1320) * b(k,120) + b(k,100) = b(k,100) - lu(k,1319) * b(k,120) + b(k,99) = b(k,99) - lu(k,1318) * b(k,120) + b(k,96) = b(k,96) - lu(k,1317) * b(k,120) + b(k,95) = b(k,95) - lu(k,1316) * b(k,120) + b(k,94) = b(k,94) - lu(k,1315) * b(k,120) + b(k,93) = b(k,93) - lu(k,1314) * b(k,120) + b(k,92) = b(k,92) - lu(k,1313) * b(k,120) + b(k,90) = b(k,90) - lu(k,1312) * b(k,120) + b(k,72) = b(k,72) - lu(k,1311) * b(k,120) + b(k,119) = b(k,119) * lu(k,1292) + b(k,118) = b(k,118) - lu(k,1291) * b(k,119) + b(k,117) = b(k,117) - lu(k,1290) * b(k,119) + b(k,116) = b(k,116) - lu(k,1289) * b(k,119) + b(k,115) = b(k,115) - lu(k,1288) * b(k,119) + b(k,114) = b(k,114) - lu(k,1287) * b(k,119) + b(k,113) = b(k,113) - lu(k,1286) * b(k,119) + b(k,112) = b(k,112) - lu(k,1285) * b(k,119) + b(k,111) = b(k,111) - lu(k,1284) * b(k,119) + b(k,110) = b(k,110) - lu(k,1283) * b(k,119) + b(k,109) = b(k,109) - lu(k,1282) * b(k,119) + b(k,108) = b(k,108) - lu(k,1281) * b(k,119) + b(k,107) = b(k,107) - lu(k,1280) * b(k,119) + b(k,106) = b(k,106) - lu(k,1279) * b(k,119) + b(k,105) = b(k,105) - lu(k,1278) * b(k,119) + b(k,104) = b(k,104) - lu(k,1277) * b(k,119) + b(k,101) = b(k,101) - lu(k,1276) * b(k,119) + b(k,98) = b(k,98) - lu(k,1275) * b(k,119) + b(k,97) = b(k,97) - lu(k,1274) * b(k,119) + b(k,91) = b(k,91) - lu(k,1273) * b(k,119) + b(k,89) = b(k,89) - lu(k,1272) * b(k,119) + b(k,88) = b(k,88) - lu(k,1271) * b(k,119) + b(k,84) = b(k,84) - lu(k,1270) * b(k,119) + b(k,83) = b(k,83) - lu(k,1269) * b(k,119) + b(k,82) = b(k,82) - lu(k,1268) * b(k,119) + b(k,81) = b(k,81) - lu(k,1267) * b(k,119) + b(k,80) = b(k,80) - lu(k,1266) * b(k,119) + b(k,78) = b(k,78) - lu(k,1265) * b(k,119) + b(k,77) = b(k,77) - lu(k,1264) * b(k,119) + b(k,76) = b(k,76) - lu(k,1263) * b(k,119) + b(k,75) = b(k,75) - lu(k,1262) * b(k,119) + b(k,74) = b(k,74) - lu(k,1261) * b(k,119) + b(k,70) = b(k,70) - lu(k,1260) * b(k,119) + b(k,67) = b(k,67) - lu(k,1259) * b(k,119) + b(k,65) = b(k,65) - lu(k,1258) * b(k,119) + b(k,64) = b(k,64) - lu(k,1257) * b(k,119) + b(k,62) = b(k,62) - lu(k,1256) * b(k,119) + b(k,61) = b(k,61) - lu(k,1255) * b(k,119) + b(k,60) = b(k,60) - lu(k,1254) * b(k,119) + b(k,59) = b(k,59) - lu(k,1253) * b(k,119) + b(k,51) = b(k,51) - lu(k,1252) * b(k,119) + b(k,49) = b(k,49) - lu(k,1251) * b(k,119) end do end subroutine lu_slv09 subroutine lu_slv10( avec_len, lu, b ) @@ -1957,88 +1915,381 @@ subroutine lu_slv10( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,76) = b(k,76) * lu(k,465) - b(k,75) = b(k,75) * lu(k,454) - b(k,58) = b(k,58) - lu(k,453) * b(k,75) - b(k,44) = b(k,44) - lu(k,452) * b(k,75) - b(k,74) = b(k,74) * lu(k,438) - b(k,73) = b(k,73) * lu(k,424) - b(k,72) = b(k,72) * lu(k,409) - b(k,71) = b(k,71) - lu(k,408) * b(k,72) - b(k,71) = b(k,71) * lu(k,393) - b(k,70) = b(k,70) * lu(k,379) - b(k,60) = b(k,60) - lu(k,378) * b(k,70) - b(k,49) = b(k,49) - lu(k,377) * b(k,70) - b(k,33) = b(k,33) - lu(k,376) * b(k,70) - b(k,69) = b(k,69) * lu(k,362) - b(k,68) = b(k,68) * lu(k,350) - b(k,59) = b(k,59) - lu(k,349) * b(k,68) - b(k,52) = b(k,52) - lu(k,348) * b(k,68) - b(k,67) = b(k,67) * lu(k,335) - b(k,66) = b(k,66) * lu(k,324) - b(k,35) = b(k,35) - lu(k,323) * b(k,66) - b(k,65) = b(k,65) * lu(k,311) - b(k,61) = b(k,61) - lu(k,310) * b(k,65) - b(k,56) = b(k,56) - lu(k,309) * b(k,65) - b(k,64) = b(k,64) * lu(k,297) - b(k,31) = b(k,31) - lu(k,296) * b(k,64) - b(k,30) = b(k,30) - lu(k,295) * b(k,64) - b(k,63) = b(k,63) * lu(k,287) - b(k,62) = b(k,62) * lu(k,277) - b(k,57) = b(k,57) - lu(k,276) * b(k,62) - b(k,24) = b(k,24) - lu(k,275) * b(k,62) - b(k,61) = b(k,61) * lu(k,264) - b(k,56) = b(k,56) - lu(k,263) * b(k,61) - b(k,55) = b(k,55) - lu(k,262) * b(k,61) - b(k,44) = b(k,44) - lu(k,261) * b(k,61) - b(k,60) = b(k,60) * lu(k,255) - b(k,29) = b(k,29) - lu(k,254) * b(k,60) - b(k,59) = b(k,59) * lu(k,246) - b(k,58) = b(k,58) * lu(k,238) - b(k,57) = b(k,57) * lu(k,231) - b(k,24) = b(k,24) - lu(k,230) * b(k,57) - b(k,56) = b(k,56) * lu(k,223) - b(k,55) = b(k,55) * lu(k,215) - b(k,54) = b(k,54) * lu(k,207) - b(k,27) = b(k,27) - lu(k,206) * b(k,54) - b(k,53) = b(k,53) * lu(k,198) - b(k,26) = b(k,26) - lu(k,197) * b(k,53) - b(k,52) = b(k,52) * lu(k,189) - b(k,51) = b(k,51) - lu(k,188) * b(k,52) - b(k,48) = b(k,48) - lu(k,187) * b(k,52) - b(k,36) = b(k,36) - lu(k,186) * b(k,52) - b(k,51) = b(k,51) * lu(k,181) - b(k,48) = b(k,48) - lu(k,180) * b(k,51) - b(k,50) = b(k,50) * lu(k,175) - b(k,49) = b(k,49) * lu(k,168) - b(k,48) = b(k,48) * lu(k,162) - b(k,47) = b(k,47) * lu(k,153) - b(k,46) = b(k,46) * lu(k,146) - b(k,45) = b(k,45) * lu(k,138) - b(k,44) = b(k,44) * lu(k,134) - b(k,43) = b(k,43) * lu(k,128) - b(k,42) = b(k,42) * lu(k,121) - b(k,41) = b(k,41) * lu(k,115) - b(k,40) = b(k,40) * lu(k,108) - b(k,39) = b(k,39) * lu(k,101) - b(k,38) = b(k,38) * lu(k,95) - b(k,37) = b(k,37) * lu(k,89) - b(k,36) = b(k,36) * lu(k,83) - b(k,35) = b(k,35) * lu(k,77) - b(k,34) = b(k,34) * lu(k,69) - b(k,33) = b(k,33) * lu(k,64) - b(k,32) = b(k,32) * lu(k,58) - b(k,31) = b(k,31) * lu(k,54) - b(k,30) = b(k,30) * lu(k,50) - b(k,29) = b(k,29) * lu(k,46) - b(k,22) = b(k,22) - lu(k,45) * b(k,29) - b(k,28) = b(k,28) * lu(k,42) - b(k,27) = b(k,27) * lu(k,39) - b(k,26) = b(k,26) * lu(k,36) - b(k,25) = b(k,25) * lu(k,32) - b(k,24) = b(k,24) * lu(k,30) - b(k,23) = b(k,23) * lu(k,27) - b(k,22) = b(k,22) * lu(k,24) + b(k,118) = b(k,118) * lu(k,1231) + b(k,117) = b(k,117) - lu(k,1230) * b(k,118) + b(k,116) = b(k,116) - lu(k,1229) * b(k,118) + b(k,115) = b(k,115) - lu(k,1228) * b(k,118) + b(k,114) = b(k,114) - lu(k,1227) * b(k,118) + b(k,113) = b(k,113) - lu(k,1226) * b(k,118) + b(k,112) = b(k,112) - lu(k,1225) * b(k,118) + b(k,111) = b(k,111) - lu(k,1224) * b(k,118) + b(k,110) = b(k,110) - lu(k,1223) * b(k,118) + b(k,109) = b(k,109) - lu(k,1222) * b(k,118) + b(k,107) = b(k,107) - lu(k,1221) * b(k,118) + b(k,106) = b(k,106) - lu(k,1220) * b(k,118) + b(k,105) = b(k,105) - lu(k,1219) * b(k,118) + b(k,103) = b(k,103) - lu(k,1218) * b(k,118) + b(k,101) = b(k,101) - lu(k,1217) * b(k,118) + b(k,99) = b(k,99) - lu(k,1216) * b(k,118) + b(k,96) = b(k,96) - lu(k,1215) * b(k,118) + b(k,87) = b(k,87) - lu(k,1214) * b(k,118) + b(k,86) = b(k,86) - lu(k,1213) * b(k,118) + b(k,79) = b(k,79) - lu(k,1212) * b(k,118) + b(k,71) = b(k,71) - lu(k,1211) * b(k,118) + b(k,47) = b(k,47) - lu(k,1210) * b(k,118) + b(k,117) = b(k,117) * lu(k,1189) + b(k,116) = b(k,116) - lu(k,1188) * b(k,117) + b(k,115) = b(k,115) - lu(k,1187) * b(k,117) + b(k,114) = b(k,114) - lu(k,1186) * b(k,117) + b(k,113) = b(k,113) - lu(k,1185) * b(k,117) + b(k,112) = b(k,112) - lu(k,1184) * b(k,117) + b(k,111) = b(k,111) - lu(k,1183) * b(k,117) + b(k,110) = b(k,110) - lu(k,1182) * b(k,117) + b(k,109) = b(k,109) - lu(k,1181) * b(k,117) + b(k,108) = b(k,108) - lu(k,1180) * b(k,117) + b(k,107) = b(k,107) - lu(k,1179) * b(k,117) + b(k,103) = b(k,103) - lu(k,1178) * b(k,117) + b(k,102) = b(k,102) - lu(k,1177) * b(k,117) + b(k,100) = b(k,100) - lu(k,1176) * b(k,117) + b(k,99) = b(k,99) - lu(k,1175) * b(k,117) + b(k,96) = b(k,96) - lu(k,1174) * b(k,117) + b(k,95) = b(k,95) - lu(k,1173) * b(k,117) + b(k,94) = b(k,94) - lu(k,1172) * b(k,117) + b(k,93) = b(k,93) - lu(k,1171) * b(k,117) + b(k,92) = b(k,92) - lu(k,1170) * b(k,117) + b(k,90) = b(k,90) - lu(k,1169) * b(k,117) + b(k,71) = b(k,71) - lu(k,1168) * b(k,117) + b(k,56) = b(k,56) - lu(k,1167) * b(k,117) + b(k,116) = b(k,116) * lu(k,1145) + b(k,115) = b(k,115) - lu(k,1144) * b(k,116) + b(k,114) = b(k,114) - lu(k,1143) * b(k,116) + b(k,113) = b(k,113) - lu(k,1142) * b(k,116) + b(k,112) = b(k,112) - lu(k,1141) * b(k,116) + b(k,111) = b(k,111) - lu(k,1140) * b(k,116) + b(k,110) = b(k,110) - lu(k,1139) * b(k,116) + b(k,109) = b(k,109) - lu(k,1138) * b(k,116) + b(k,108) = b(k,108) - lu(k,1137) * b(k,116) + b(k,107) = b(k,107) - lu(k,1136) * b(k,116) + b(k,106) = b(k,106) - lu(k,1135) * b(k,116) + b(k,103) = b(k,103) - lu(k,1134) * b(k,116) + b(k,102) = b(k,102) - lu(k,1133) * b(k,116) + b(k,100) = b(k,100) - lu(k,1132) * b(k,116) + b(k,99) = b(k,99) - lu(k,1131) * b(k,116) + b(k,96) = b(k,96) - lu(k,1130) * b(k,116) + b(k,95) = b(k,95) - lu(k,1129) * b(k,116) + b(k,94) = b(k,94) - lu(k,1128) * b(k,116) + b(k,93) = b(k,93) - lu(k,1127) * b(k,116) + b(k,92) = b(k,92) - lu(k,1126) * b(k,116) + b(k,90) = b(k,90) - lu(k,1125) * b(k,116) + b(k,88) = b(k,88) - lu(k,1124) * b(k,116) + b(k,84) = b(k,84) - lu(k,1123) * b(k,116) + b(k,76) = b(k,76) - lu(k,1122) * b(k,116) + b(k,74) = b(k,74) - lu(k,1121) * b(k,116) + b(k,69) = b(k,69) - lu(k,1120) * b(k,116) + b(k,68) = b(k,68) - lu(k,1119) * b(k,116) + b(k,115) = b(k,115) * lu(k,1096) + b(k,114) = b(k,114) - lu(k,1095) * b(k,115) + b(k,112) = b(k,112) - lu(k,1094) * b(k,115) + b(k,111) = b(k,111) - lu(k,1093) * b(k,115) + b(k,110) = b(k,110) - lu(k,1092) * b(k,115) + b(k,109) = b(k,109) - lu(k,1091) * b(k,115) + b(k,106) = b(k,106) - lu(k,1090) * b(k,115) + b(k,105) = b(k,105) - lu(k,1089) * b(k,115) + b(k,104) = b(k,104) - lu(k,1088) * b(k,115) + b(k,103) = b(k,103) - lu(k,1087) * b(k,115) + b(k,100) = b(k,100) - lu(k,1086) * b(k,115) + b(k,99) = b(k,99) - lu(k,1085) * b(k,115) + b(k,97) = b(k,97) - lu(k,1084) * b(k,115) + b(k,91) = b(k,91) - lu(k,1083) * b(k,115) + b(k,85) = b(k,85) - lu(k,1082) * b(k,115) + b(k,80) = b(k,80) - lu(k,1081) * b(k,115) + b(k,67) = b(k,67) - lu(k,1080) * b(k,115) + b(k,48) = b(k,48) - lu(k,1079) * b(k,115) + b(k,114) = b(k,114) * lu(k,1055) + b(k,112) = b(k,112) - lu(k,1054) * b(k,114) + b(k,110) = b(k,110) - lu(k,1053) * b(k,114) + b(k,106) = b(k,106) - lu(k,1052) * b(k,114) + b(k,89) = b(k,89) - lu(k,1051) * b(k,114) + b(k,88) = b(k,88) - lu(k,1050) * b(k,114) + b(k,84) = b(k,84) - lu(k,1049) * b(k,114) + b(k,76) = b(k,76) - lu(k,1048) * b(k,114) + b(k,74) = b(k,74) - lu(k,1047) * b(k,114) + b(k,73) = b(k,73) - lu(k,1046) * b(k,114) + b(k,72) = b(k,72) - lu(k,1045) * b(k,114) + b(k,71) = b(k,71) - lu(k,1044) * b(k,114) + b(k,69) = b(k,69) - lu(k,1043) * b(k,114) + b(k,68) = b(k,68) - lu(k,1042) * b(k,114) + b(k,66) = b(k,66) - lu(k,1041) * b(k,114) + b(k,64) = b(k,64) - lu(k,1040) * b(k,114) + b(k,60) = b(k,60) - lu(k,1039) * b(k,114) + b(k,59) = b(k,59) - lu(k,1038) * b(k,114) + b(k,56) = b(k,56) - lu(k,1037) * b(k,114) + b(k,55) = b(k,55) - lu(k,1036) * b(k,114) + b(k,113) = b(k,113) * lu(k,1011) + b(k,112) = b(k,112) - lu(k,1010) * b(k,113) + b(k,111) = b(k,111) - lu(k,1009) * b(k,113) + b(k,109) = b(k,109) - lu(k,1008) * b(k,113) + b(k,107) = b(k,107) - lu(k,1007) * b(k,113) + b(k,103) = b(k,103) - lu(k,1006) * b(k,113) + b(k,102) = b(k,102) - lu(k,1005) * b(k,113) + b(k,98) = b(k,98) - lu(k,1004) * b(k,113) + b(k,82) = b(k,82) - lu(k,1003) * b(k,113) + b(k,112) = b(k,112) * lu(k,981) + b(k,110) = b(k,110) - lu(k,980) * b(k,112) + b(k,106) = b(k,106) - lu(k,979) * b(k,112) + b(k,105) = b(k,105) - lu(k,978) * b(k,112) + b(k,104) = b(k,104) - lu(k,977) * b(k,112) + b(k,101) = b(k,101) - lu(k,976) * b(k,112) + b(k,97) = b(k,97) - lu(k,975) * b(k,112) + b(k,91) = b(k,91) - lu(k,974) * b(k,112) + b(k,88) = b(k,88) - lu(k,973) * b(k,112) + b(k,87) = b(k,87) - lu(k,972) * b(k,112) + b(k,86) = b(k,86) - lu(k,971) * b(k,112) + b(k,81) = b(k,81) - lu(k,970) * b(k,112) + b(k,80) = b(k,80) - lu(k,969) * b(k,112) + b(k,79) = b(k,79) - lu(k,968) * b(k,112) + b(k,78) = b(k,78) - lu(k,967) * b(k,112) + b(k,77) = b(k,77) - lu(k,966) * b(k,112) + b(k,72) = b(k,72) - lu(k,965) * b(k,112) + b(k,71) = b(k,71) - lu(k,964) * b(k,112) + b(k,70) = b(k,70) - lu(k,963) * b(k,112) + b(k,67) = b(k,67) - lu(k,962) * b(k,112) + b(k,63) = b(k,63) - lu(k,961) * b(k,112) + b(k,62) = b(k,62) - lu(k,960) * b(k,112) + b(k,58) = b(k,58) - lu(k,959) * b(k,112) + b(k,57) = b(k,57) - lu(k,958) * b(k,112) + b(k,54) = b(k,54) - lu(k,957) * b(k,112) + b(k,53) = b(k,53) - lu(k,956) * b(k,112) + b(k,52) = b(k,52) - lu(k,955) * b(k,112) + b(k,51) = b(k,51) - lu(k,954) * b(k,112) + b(k,48) = b(k,48) - lu(k,953) * b(k,112) + b(k,46) = b(k,46) - lu(k,952) * b(k,112) + b(k,43) = b(k,43) - lu(k,951) * b(k,112) + b(k,40) = b(k,40) - lu(k,950) * b(k,112) + b(k,39) = b(k,39) - lu(k,949) * b(k,112) + b(k,38) = b(k,38) - lu(k,948) * b(k,112) + b(k,37) = b(k,37) - lu(k,947) * b(k,112) + b(k,30) = b(k,30) - lu(k,946) * b(k,112) + b(k,111) = b(k,111) * lu(k,923) + b(k,109) = b(k,109) - lu(k,922) * b(k,111) + b(k,107) = b(k,107) - lu(k,921) * b(k,111) + b(k,95) = b(k,95) - lu(k,920) * b(k,111) + b(k,71) = b(k,71) - lu(k,919) * b(k,111) + b(k,110) = b(k,110) * lu(k,897) + b(k,106) = b(k,106) - lu(k,896) * b(k,110) + b(k,105) = b(k,105) - lu(k,895) * b(k,110) + b(k,104) = b(k,104) - lu(k,894) * b(k,110) + b(k,101) = b(k,101) - lu(k,893) * b(k,110) + b(k,97) = b(k,97) - lu(k,892) * b(k,110) + b(k,87) = b(k,87) - lu(k,891) * b(k,110) + b(k,78) = b(k,78) - lu(k,890) * b(k,110) + b(k,77) = b(k,77) - lu(k,889) * b(k,110) + b(k,75) = b(k,75) - lu(k,888) * b(k,110) + b(k,72) = b(k,72) - lu(k,887) * b(k,110) + b(k,62) = b(k,62) - lu(k,886) * b(k,110) + b(k,58) = b(k,58) - lu(k,885) * b(k,110) + b(k,54) = b(k,54) - lu(k,884) * b(k,110) + b(k,109) = b(k,109) * lu(k,863) + b(k,107) = b(k,107) - lu(k,862) * b(k,109) + b(k,103) = b(k,103) - lu(k,861) * b(k,109) + b(k,99) = b(k,99) - lu(k,860) * b(k,109) + b(k,96) = b(k,96) - lu(k,859) * b(k,109) + b(k,108) = b(k,108) * lu(k,830) + b(k,107) = b(k,107) - lu(k,829) * b(k,108) + b(k,98) = b(k,98) - lu(k,828) * b(k,108) + b(k,82) = b(k,82) - lu(k,827) * b(k,108) + b(k,107) = b(k,107) * lu(k,808) + b(k,94) = b(k,94) - lu(k,807) * b(k,107) + b(k,93) = b(k,93) - lu(k,806) * b(k,107) + b(k,106) = b(k,106) * lu(k,784) + b(k,105) = b(k,105) - lu(k,783) * b(k,106) + b(k,104) = b(k,104) - lu(k,782) * b(k,106) + b(k,101) = b(k,101) - lu(k,781) * b(k,106) + b(k,97) = b(k,97) - lu(k,780) * b(k,106) + b(k,89) = b(k,89) - lu(k,779) * b(k,106) + b(k,87) = b(k,87) - lu(k,778) * b(k,106) + b(k,86) = b(k,86) - lu(k,777) * b(k,106) + b(k,83) = b(k,83) - lu(k,776) * b(k,106) + b(k,79) = b(k,79) - lu(k,775) * b(k,106) + b(k,78) = b(k,78) - lu(k,774) * b(k,106) + b(k,63) = b(k,63) - lu(k,773) * b(k,106) + b(k,57) = b(k,57) - lu(k,772) * b(k,106) + b(k,53) = b(k,53) - lu(k,771) * b(k,106) + b(k,49) = b(k,49) - lu(k,770) * b(k,106) + b(k,46) = b(k,46) - lu(k,769) * b(k,106) + b(k,42) = b(k,42) - lu(k,768) * b(k,106) + b(k,40) = b(k,40) - lu(k,767) * b(k,106) + b(k,39) = b(k,39) - lu(k,766) * b(k,106) + b(k,38) = b(k,38) - lu(k,765) * b(k,106) + b(k,37) = b(k,37) - lu(k,764) * b(k,106) + b(k,35) = b(k,35) - lu(k,763) * b(k,106) + b(k,34) = b(k,34) - lu(k,762) * b(k,106) + b(k,33) = b(k,33) - lu(k,761) * b(k,106) + b(k,32) = b(k,32) - lu(k,760) * b(k,106) + b(k,29) = b(k,29) - lu(k,759) * b(k,106) + b(k,28) = b(k,28) - lu(k,758) * b(k,106) + b(k,27) = b(k,27) - lu(k,757) * b(k,106) + b(k,26) = b(k,26) - lu(k,756) * b(k,106) + b(k,25) = b(k,25) - lu(k,755) * b(k,106) + end do + end subroutine lu_slv10 + subroutine lu_slv11( 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,105) = b(k,105) * lu(k,735) + b(k,104) = b(k,104) - lu(k,734) * b(k,105) + b(k,101) = b(k,101) - lu(k,733) * b(k,105) + b(k,97) = b(k,97) - lu(k,732) * b(k,105) + b(k,78) = b(k,78) - lu(k,731) * b(k,105) + b(k,67) = b(k,67) - lu(k,730) * b(k,105) + b(k,104) = b(k,104) * lu(k,712) + b(k,97) = b(k,97) - lu(k,711) * b(k,104) + b(k,91) = b(k,91) - lu(k,710) * b(k,104) + b(k,80) = b(k,80) - lu(k,709) * b(k,104) + b(k,75) = b(k,75) - lu(k,708) * b(k,104) + b(k,61) = b(k,61) - lu(k,707) * b(k,104) + b(k,50) = b(k,50) - lu(k,706) * b(k,104) + b(k,41) = b(k,41) - lu(k,705) * b(k,104) + b(k,103) = b(k,103) * lu(k,688) + b(k,100) = b(k,100) - lu(k,687) * b(k,103) + b(k,99) = b(k,99) - lu(k,686) * b(k,103) + b(k,85) = b(k,85) - lu(k,685) * b(k,103) + b(k,102) = b(k,102) * lu(k,666) + b(k,95) = b(k,95) - lu(k,665) * b(k,102) + b(k,92) = b(k,92) - lu(k,664) * b(k,102) + b(k,101) = b(k,101) * lu(k,644) + b(k,87) = b(k,87) - lu(k,643) * b(k,101) + b(k,86) = b(k,86) - lu(k,642) * b(k,101) + b(k,79) = b(k,79) - lu(k,641) * b(k,101) + b(k,47) = b(k,47) - lu(k,640) * b(k,101) + b(k,100) = b(k,100) * lu(k,622) + b(k,99) = b(k,99) - lu(k,621) * b(k,100) + b(k,85) = b(k,85) - lu(k,620) * b(k,100) + b(k,99) = b(k,99) * lu(k,606) + b(k,98) = b(k,98) * lu(k,591) + b(k,97) = b(k,97) * lu(k,579) + b(k,78) = b(k,78) - lu(k,578) * b(k,97) + b(k,67) = b(k,67) - lu(k,577) * b(k,97) + b(k,96) = b(k,96) * lu(k,561) + b(k,95) = b(k,95) * lu(k,547) + b(k,94) = b(k,94) * lu(k,532) + b(k,93) = b(k,93) - lu(k,531) * b(k,94) + b(k,93) = b(k,93) * lu(k,516) + b(k,92) = b(k,92) * lu(k,501) + b(k,91) = b(k,91) * lu(k,487) + b(k,80) = b(k,80) - lu(k,486) * b(k,91) + b(k,70) = b(k,70) - lu(k,485) * b(k,91) + b(k,50) = b(k,50) - lu(k,484) * b(k,91) + b(k,90) = b(k,90) * lu(k,470) + b(k,89) = b(k,89) * lu(k,458) + b(k,83) = b(k,83) - lu(k,457) * b(k,89) + b(k,73) = b(k,73) - lu(k,456) * b(k,89) + b(k,88) = b(k,88) * lu(k,443) + b(k,84) = b(k,84) - lu(k,442) * b(k,88) + b(k,76) = b(k,76) - lu(k,441) * b(k,88) + b(k,42) = b(k,42) - lu(k,440) * b(k,88) + b(k,87) = b(k,87) * lu(k,429) + b(k,54) = b(k,54) - lu(k,428) * b(k,87) + b(k,86) = b(k,86) * lu(k,413) + b(k,79) = b(k,79) - lu(k,412) * b(k,86) + b(k,67) = b(k,67) - lu(k,411) * b(k,86) + b(k,47) = b(k,47) - lu(k,410) * b(k,86) + b(k,85) = b(k,85) * lu(k,398) + b(k,45) = b(k,45) - lu(k,397) * b(k,85) + b(k,44) = b(k,44) - lu(k,396) * b(k,85) + b(k,84) = b(k,84) * lu(k,385) + b(k,76) = b(k,76) - lu(k,384) * b(k,84) + b(k,74) = b(k,74) - lu(k,383) * b(k,84) + b(k,67) = b(k,67) - lu(k,382) * b(k,84) + b(k,83) = b(k,83) * lu(k,374) + b(k,82) = b(k,82) * lu(k,366) + b(k,81) = b(k,81) * lu(k,356) + b(k,77) = b(k,77) - lu(k,355) * b(k,81) + b(k,36) = b(k,36) - lu(k,354) * b(k,81) + b(k,80) = b(k,80) * lu(k,348) + b(k,43) = b(k,43) - lu(k,347) * b(k,80) + b(k,79) = b(k,79) * lu(k,338) + b(k,47) = b(k,47) - lu(k,337) * b(k,79) + b(k,78) = b(k,78) * lu(k,329) + b(k,77) = b(k,77) * lu(k,322) + b(k,36) = b(k,36) - lu(k,321) * b(k,77) + b(k,76) = b(k,76) * lu(k,314) + b(k,75) = b(k,75) * lu(k,306) + b(k,41) = b(k,41) - lu(k,305) * b(k,75) + b(k,74) = b(k,74) * lu(k,297) + b(k,73) = b(k,73) * lu(k,289) + b(k,72) = b(k,72) - lu(k,288) * b(k,73) + b(k,66) = b(k,66) - lu(k,287) * b(k,73) + b(k,55) = b(k,55) - lu(k,286) * b(k,73) + b(k,72) = b(k,72) * lu(k,281) + b(k,66) = b(k,66) - lu(k,280) * b(k,72) + b(k,71) = b(k,71) * lu(k,275) + b(k,70) = b(k,70) * lu(k,268) + b(k,69) = b(k,69) * lu(k,261) + b(k,68) = b(k,68) * lu(k,253) + b(k,67) = b(k,67) * lu(k,249) + b(k,66) = b(k,66) * lu(k,243) + b(k,65) = b(k,65) * lu(k,236) + b(k,64) = b(k,64) * lu(k,227) + b(k,63) = b(k,63) * lu(k,218) + b(k,62) = b(k,62) * lu(k,211) + b(k,61) = b(k,61) * lu(k,203) + b(k,60) = b(k,60) * lu(k,197) + b(k,59) = b(k,59) * lu(k,190) + b(k,58) = b(k,58) * lu(k,183) + b(k,57) = b(k,57) * lu(k,176) + b(k,56) = b(k,56) * lu(k,170) + b(k,55) = b(k,55) * lu(k,164) + b(k,54) = b(k,54) * lu(k,158) + b(k,53) = b(k,53) * lu(k,152) + b(k,52) = b(k,52) * lu(k,144) + b(k,51) = b(k,51) * lu(k,136) + b(k,50) = b(k,50) * lu(k,131) + b(k,49) = b(k,49) * lu(k,128) + b(k,48) = b(k,48) * lu(k,122) + b(k,47) = b(k,47) * lu(k,119) + b(k,46) = b(k,46) * lu(k,113) + b(k,40) = b(k,40) - lu(k,112) * b(k,46) + b(k,45) = b(k,45) * lu(k,108) + b(k,44) = b(k,44) * lu(k,104) + b(k,43) = b(k,43) * lu(k,100) + b(k,31) = b(k,31) - lu(k,99) * b(k,43) + b(k,42) = b(k,42) * lu(k,95) + b(k,41) = b(k,41) * lu(k,92) + b(k,40) = b(k,40) * lu(k,89) + b(k,39) = b(k,39) * lu(k,84) + b(k,38) = b(k,38) * lu(k,80) + b(k,37) = b(k,37) * lu(k,75) + b(k,36) = b(k,36) * lu(k,73) + b(k,35) = b(k,35) * lu(k,68) + b(k,34) = b(k,34) * lu(k,63) + b(k,33) = b(k,33) * lu(k,58) + b(k,32) = b(k,32) * lu(k,53) + b(k,31) = b(k,31) * lu(k,50) + b(k,30) = b(k,30) * lu(k,46) + b(k,29) = b(k,29) * lu(k,42) + b(k,28) = b(k,28) * lu(k,38) + b(k,27) = b(k,27) * lu(k,34) + b(k,26) = b(k,26) * lu(k,30) + b(k,25) = b(k,25) * lu(k,27) + b(k,24) = b(k,24) * lu(k,24) + b(k,23) = b(k,23) * lu(k,23) + b(k,22) = b(k,22) * lu(k,22) b(k,21) = b(k,21) * lu(k,21) b(k,20) = b(k,20) * lu(k,20) b(k,19) = b(k,19) * lu(k,19) @@ -2061,7 +2312,7 @@ subroutine lu_slv10( avec_len, lu, b ) b(k,2) = b(k,2) * lu(k,2) b(k,1) = b(k,1) * lu(k,1) end do - end subroutine lu_slv10 + end subroutine lu_slv11 subroutine lu_slv( avec_len, lu, b ) use shr_kind_mod, only : r8 => shr_kind_r8 use chem_mods, only : clscnt4, nzcnt @@ -2082,5 +2333,6 @@ subroutine lu_slv( avec_len, lu, b ) call lu_slv08( avec_len, lu, b ) call lu_slv09( avec_len, lu, b ) call lu_slv10( avec_len, lu, b ) + call lu_slv11( avec_len, lu, b ) end subroutine lu_slv end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_nln_matrix.F90 index 6a96a574b2..a0c2b8a2ee 100644 --- a/src/chemistry/pp_waccm_mad_mam4/mo_nln_matrix.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/mo_nln_matrix.F90 @@ -22,212 +22,472 @@ subroutine nlnmat01( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,577) = rxt(k,492)*y(k,26) - mat(k,1722) = rxt(k,492)*y(k,4) - mat(k,1134) = (rxt(k,571)+rxt(k,576))*y(k,51) - mat(k,206) = (rxt(k,571)+rxt(k,576))*y(k,47) - mat(k,584) = -(4._r8*rxt(k,489)*y(k,4) + (rxt(k,490) + rxt(k,491) + rxt(k,492) & - ) * y(k,26) + rxt(k,493)*y(k,98) + rxt(k,494)*y(k,60) + rxt(k,495) & - *y(k,61) + rxt(k,497)*y(k,67) + rxt(k,498)*y(k,131) + rxt(k,546) & - *y(k,76)) - mat(k,1731) = -(rxt(k,490) + rxt(k,491) + rxt(k,492)) * y(k,4) - mat(k,744) = -rxt(k,493)*y(k,4) - mat(k,1495) = -rxt(k,494)*y(k,4) - mat(k,979) = -rxt(k,495)*y(k,4) - mat(k,1411) = -rxt(k,497)*y(k,4) - mat(k,790) = -rxt(k,498)*y(k,4) - mat(k,381) = -rxt(k,546)*y(k,4) - mat(k,141) = rxt(k,496)*y(k,67) - mat(k,240) = rxt(k,506)*y(k,122) - mat(k,209) = rxt(k,501)*y(k,67) - mat(k,1411) = mat(k,1411) + rxt(k,496)*y(k,5) + rxt(k,501)*y(k,51) - mat(k,1185) = rxt(k,488)*y(k,85) - mat(k,455) = rxt(k,488)*y(k,69) - mat(k,635) = rxt(k,506)*y(k,43) - mat(k,138) = -(rxt(k,496)*y(k,67)) - mat(k,1391) = -rxt(k,496)*y(k,5) - mat(k,579) = rxt(k,495)*y(k,61) - mat(k,966) = rxt(k,495)*y(k,4) - mat(k,606) = -(rxt(k,450)*y(k,86) + rxt(k,486)*y(k,85) + rxt(k,530)*y(k,62) & - + rxt(k,531)*y(k,67) + rxt(k,532)*y(k,131)) - mat(k,1454) = -rxt(k,450)*y(k,16) - mat(k,456) = -rxt(k,486)*y(k,16) - mat(k,1104) = -rxt(k,530)*y(k,16) - mat(k,1412) = -rxt(k,531)*y(k,16) - mat(k,791) = -rxt(k,532)*y(k,16) - mat(k,325) = rxt(k,457)*y(k,26) + rxt(k,534)*y(k,60) - mat(k,79) = .300_r8*rxt(k,535)*y(k,131) - mat(k,1732) = rxt(k,457)*y(k,20) - mat(k,1496) = rxt(k,534)*y(k,20) - mat(k,791) = mat(k,791) + .300_r8*rxt(k,535)*y(k,21) - mat(k,324) = -(rxt(k,457)*y(k,26) + rxt(k,533)*y(k,98) + rxt(k,534)*y(k,60)) - mat(k,1728) = -rxt(k,457)*y(k,20) - mat(k,741) = -rxt(k,533)*y(k,20) - mat(k,1489) = -rxt(k,534)*y(k,20) - mat(k,78) = .700_r8*rxt(k,535)*y(k,131) - mat(k,786) = .700_r8*rxt(k,535)*y(k,21) - mat(k,77) = -(rxt(k,535)*y(k,131)) - mat(k,773) = -rxt(k,535)*y(k,21) - mat(k,323) = rxt(k,533)*y(k,98) - mat(k,734) = rxt(k,533)*y(k,20) - mat(k,1721) = 2.000_r8*rxt(k,459)*y(k,26) - mat(k,275) = (rxt(k,569)+rxt(k,574)+rxt(k,579))*y(k,47) + rxt(k,463)*y(k,86) - mat(k,1133) = (rxt(k,569)+rxt(k,574)+rxt(k,579))*y(k,27) + (rxt(k,564) & - +rxt(k,570)+rxt(k,575))*y(k,52) - mat(k,230) = (rxt(k,564)+rxt(k,570)+rxt(k,575))*y(k,47) - mat(k,1444) = rxt(k,463)*y(k,27) - mat(k,1720) = 2.000_r8*rxt(k,484)*y(k,26) - mat(k,1761) = -(rxt(k,116)*y(k,91) + rxt(k,128)*y(k,94) + rxt(k,286)*y(k,108) & + mat(k,579) = -(rxt(k,486)*y(k,17) + rxt(k,487)*y(k,99) + rxt(k,488)*y(k,72)) + mat(k,732) = -rxt(k,486)*y(k,3) + mat(k,892) = -rxt(k,487)*y(k,3) + mat(k,1903) = -rxt(k,488)*y(k,3) + mat(k,711) = 4.000_r8*rxt(k,489)*y(k,5) + (rxt(k,490)+rxt(k,491))*y(k,28) & + + rxt(k,494)*y(k,62) + rxt(k,497)*y(k,69) + rxt(k,548)*y(k,79) & + + rxt(k,498)*y(k,131) + mat(k,55) = rxt(k,476)*y(k,70) + mat(k,61) = rxt(k,502)*y(k,70) + mat(k,177) = 2.000_r8*rxt(k,513)*y(k,25) + 2.000_r8*rxt(k,525)*y(k,70) & + + 2.000_r8*rxt(k,514)*y(k,131) + mat(k,220) = rxt(k,515)*y(k,25) + rxt(k,526)*y(k,70) + rxt(k,516)*y(k,131) + mat(k,153) = 3.000_r8*rxt(k,520)*y(k,25) + 3.000_r8*rxt(k,503)*y(k,70) & + + 3.000_r8*rxt(k,521)*y(k,131) + mat(k,1992) = 2.000_r8*rxt(k,513)*y(k,16) + rxt(k,515)*y(k,18) & + + 3.000_r8*rxt(k,520)*y(k,24) + mat(k,1744) = (rxt(k,490)+rxt(k,491))*y(k,5) + mat(k,32) = 2.000_r8*rxt(k,504)*y(k,70) + mat(k,330) = rxt(k,499)*y(k,69) + rxt(k,505)*y(k,70) + rxt(k,500)*y(k,131) + mat(k,1697) = rxt(k,494)*y(k,5) + mat(k,1274) = rxt(k,497)*y(k,5) + rxt(k,499)*y(k,45) + mat(k,780) = rxt(k,476)*y(k,9) + rxt(k,502)*y(k,10) + 2.000_r8*rxt(k,525) & + *y(k,16) + rxt(k,526)*y(k,18) + 3.000_r8*rxt(k,503)*y(k,24) & + + 2.000_r8*rxt(k,504)*y(k,42) + rxt(k,505)*y(k,45) + mat(k,488) = rxt(k,548)*y(k,5) + mat(k,975) = rxt(k,498)*y(k,5) + 2.000_r8*rxt(k,514)*y(k,16) + rxt(k,516) & + *y(k,18) + 3.000_r8*rxt(k,521)*y(k,24) + rxt(k,500)*y(k,45) + mat(k,705) = rxt(k,492)*y(k,28) + mat(k,1736) = rxt(k,492)*y(k,5) + mat(k,1476) = (rxt(k,570)+rxt(k,575))*y(k,53) + mat(k,305) = (rxt(k,570)+rxt(k,575))*y(k,49) + mat(k,712) = -(4._r8*rxt(k,489)*y(k,5) + (rxt(k,490) + rxt(k,491) + rxt(k,492) & + ) * y(k,28) + rxt(k,493)*y(k,99) + rxt(k,494)*y(k,62) + rxt(k,495) & + *y(k,63) + rxt(k,497)*y(k,69) + rxt(k,498)*y(k,131) + rxt(k,548) & + *y(k,79)) + mat(k,1745) = -(rxt(k,490) + rxt(k,491) + rxt(k,492)) * y(k,5) + mat(k,894) = -rxt(k,493)*y(k,5) + mat(k,1701) = -rxt(k,494)*y(k,5) + mat(k,1616) = -rxt(k,495)*y(k,5) + mat(k,1277) = -rxt(k,497)*y(k,5) + mat(k,977) = -rxt(k,498)*y(k,5) + mat(k,489) = -rxt(k,548)*y(k,5) + mat(k,580) = rxt(k,488)*y(k,72) + mat(k,206) = rxt(k,496)*y(k,69) + mat(k,331) = rxt(k,506)*y(k,70) + mat(k,308) = rxt(k,501)*y(k,69) + mat(k,1277) = mat(k,1277) + rxt(k,496)*y(k,6) + rxt(k,501)*y(k,53) + mat(k,782) = rxt(k,506)*y(k,45) + mat(k,1905) = rxt(k,488)*y(k,3) + mat(k,203) = -(rxt(k,496)*y(k,69)) + mat(k,1255) = -rxt(k,496)*y(k,6) + mat(k,707) = rxt(k,495)*y(k,63) + mat(k,1603) = rxt(k,495)*y(k,5) + mat(k,27) = -(rxt(k,475)*y(k,70)) + mat(k,755) = -rxt(k,475)*y(k,8) + mat(k,53) = -(rxt(k,476)*y(k,70)) + mat(k,760) = -rxt(k,476)*y(k,9) + mat(k,58) = -(rxt(k,502)*y(k,70)) + mat(k,761) = -rxt(k,502)*y(k,10) + mat(k,34) = -(rxt(k,477)*y(k,70)) + mat(k,757) = -rxt(k,477)*y(k,11) + mat(k,63) = -(rxt(k,478)*y(k,70)) + mat(k,762) = -rxt(k,478)*y(k,12) + mat(k,38) = -(rxt(k,479)*y(k,70)) + mat(k,758) = -rxt(k,479)*y(k,13) + mat(k,68) = -(rxt(k,480)*y(k,70)) + mat(k,763) = -rxt(k,480)*y(k,14) + mat(k,42) = -(rxt(k,481)*y(k,70)) + mat(k,759) = -rxt(k,481)*y(k,15) + mat(k,176) = -(rxt(k,513)*y(k,25) + rxt(k,514)*y(k,131) + rxt(k,525)*y(k,70)) + mat(k,1983) = -rxt(k,513)*y(k,16) + mat(k,958) = -rxt(k,514)*y(k,16) + mat(k,772) = -rxt(k,525)*y(k,16) + mat(k,735) = -(rxt(k,450)*y(k,25) + rxt(k,486)*y(k,3) + rxt(k,530)*y(k,64) & + + rxt(k,531)*y(k,69) + rxt(k,532)*y(k,131)) + mat(k,1995) = -rxt(k,450)*y(k,17) + mat(k,581) = -rxt(k,486)*y(k,17) + mat(k,1089) = -rxt(k,530)*y(k,17) + mat(k,1278) = -rxt(k,531)*y(k,17) + mat(k,978) = -rxt(k,532)*y(k,17) + mat(k,430) = rxt(k,457)*y(k,28) + rxt(k,534)*y(k,62) + mat(k,160) = .300_r8*rxt(k,535)*y(k,131) + mat(k,416) = (rxt(k,538)+rxt(k,539))*y(k,70) + mat(k,1746) = rxt(k,457)*y(k,21) + mat(k,1702) = rxt(k,534)*y(k,21) + mat(k,783) = (rxt(k,538)+rxt(k,539))*y(k,23) + mat(k,978) = mat(k,978) + .300_r8*rxt(k,535)*y(k,22) + mat(k,218) = -(rxt(k,515)*y(k,25) + rxt(k,516)*y(k,131) + rxt(k,526)*y(k,70)) + mat(k,1985) = -rxt(k,515)*y(k,18) + mat(k,961) = -rxt(k,516)*y(k,18) + mat(k,773) = -rxt(k,526)*y(k,18) + mat(k,46) = -(rxt(k,517)*y(k,131)) + mat(k,946) = -rxt(k,517)*y(k,19) + mat(k,144) = -(rxt(k,518)*y(k,25) + rxt(k,519)*y(k,131)) + mat(k,1981) = -rxt(k,518)*y(k,20) + mat(k,955) = -rxt(k,519)*y(k,20) + mat(k,429) = -(rxt(k,457)*y(k,28) + rxt(k,533)*y(k,99) + rxt(k,534)*y(k,62)) + mat(k,1742) = -rxt(k,457)*y(k,21) + mat(k,891) = -rxt(k,533)*y(k,21) + mat(k,1694) = -rxt(k,534)*y(k,21) + mat(k,159) = .700_r8*rxt(k,535)*y(k,131) + mat(k,414) = rxt(k,451)*y(k,25) + rxt(k,507)*y(k,39) + rxt(k,537)*y(k,70) & + + rxt(k,536)*y(k,131) + mat(k,1991) = rxt(k,451)*y(k,23) + mat(k,340) = rxt(k,507)*y(k,23) + mat(k,778) = rxt(k,537)*y(k,23) + mat(k,972) = .700_r8*rxt(k,535)*y(k,22) + rxt(k,536)*y(k,23) + mat(k,158) = -(rxt(k,535)*y(k,131)) + mat(k,957) = -rxt(k,535)*y(k,22) + mat(k,428) = rxt(k,533)*y(k,99) + mat(k,884) = rxt(k,533)*y(k,21) + mat(k,413) = -(rxt(k,451)*y(k,25) + rxt(k,507)*y(k,39) + rxt(k,536)*y(k,131) & + + (rxt(k,537) + rxt(k,538) + rxt(k,539)) * y(k,70)) + mat(k,1990) = -rxt(k,451)*y(k,23) + mat(k,339) = -rxt(k,507)*y(k,23) + mat(k,971) = -rxt(k,536)*y(k,23) + mat(k,777) = -(rxt(k,537) + rxt(k,538) + rxt(k,539)) * y(k,23) + mat(k,152) = -(rxt(k,503)*y(k,70) + rxt(k,520)*y(k,25) + rxt(k,521)*y(k,131)) + mat(k,771) = -rxt(k,503)*y(k,24) + mat(k,1982) = -rxt(k,520)*y(k,24) + mat(k,956) = -rxt(k,521)*y(k,24) + mat(k,2026) = -((rxt(k,114) + rxt(k,115)) * y(k,92) + rxt(k,127)*y(k,95) & + + rxt(k,285)*y(k,109) + rxt(k,314)*y(k,125) + rxt(k,341) & + *y(k,132) + rxt(k,350)*y(k,133) + rxt(k,450)*y(k,17) + rxt(k,451) & + *y(k,23) + rxt(k,452)*y(k,41) + rxt(k,453)*y(k,43) + (rxt(k,454) & + + rxt(k,455)) * y(k,99) + rxt(k,456)*y(k,72) + rxt(k,463) & + *y(k,29) + rxt(k,472)*y(k,54) + rxt(k,513)*y(k,16) + rxt(k,515) & + *y(k,18) + rxt(k,518)*y(k,20) + rxt(k,520)*y(k,24)) + mat(k,1034) = -(rxt(k,114) + rxt(k,115)) * y(k,25) + mat(k,857) = -rxt(k,127)*y(k,25) + mat(k,944) = -rxt(k,285)*y(k,25) + mat(k,1554) = -rxt(k,314)*y(k,25) + mat(k,1859) = -rxt(k,341)*y(k,25) + mat(k,1895) = -rxt(k,350)*y(k,25) + mat(k,753) = -rxt(k,450)*y(k,25) + mat(k,426) = -rxt(k,451)*y(k,25) + mat(k,662) = -rxt(k,452)*y(k,25) + mat(k,216) = -rxt(k,453)*y(k,25) + mat(k,917) = -(rxt(k,454) + rxt(k,455)) * y(k,25) + mat(k,1936) = -rxt(k,456)*y(k,25) + mat(k,364) = -rxt(k,463)*y(k,25) + mat(k,327) = -rxt(k,472)*y(k,25) + mat(k,181) = -rxt(k,513)*y(k,25) + mat(k,225) = -rxt(k,515)*y(k,25) + mat(k,150) = -rxt(k,518)*y(k,25) + mat(k,157) = -rxt(k,520)*y(k,25) + mat(k,728) = rxt(k,491)*y(k,28) + mat(k,29) = 4.000_r8*rxt(k,475)*y(k,70) + mat(k,57) = rxt(k,476)*y(k,70) + mat(k,37) = 2.000_r8*rxt(k,477)*y(k,70) + mat(k,67) = 2.000_r8*rxt(k,478)*y(k,70) + mat(k,41) = 2.000_r8*rxt(k,479)*y(k,70) + mat(k,72) = rxt(k,480)*y(k,70) + mat(k,45) = 2.000_r8*rxt(k,481)*y(k,70) + mat(k,48) = 3.000_r8*rxt(k,517)*y(k,131) + mat(k,150) = mat(k,150) + rxt(k,519)*y(k,131) + mat(k,438) = rxt(k,457)*y(k,28) + mat(k,1777) = rxt(k,491)*y(k,5) + rxt(k,457)*y(k,21) + (4.000_r8*rxt(k,458) & + +2.000_r8*rxt(k,460))*y(k,28) + rxt(k,462)*y(k,62) + rxt(k,467) & + *y(k,69) + rxt(k,549)*y(k,79) + rxt(k,468)*y(k,131) + mat(k,83) = rxt(k,512)*y(k,70) + mat(k,79) = rxt(k,527)*y(k,70) + rxt(k,522)*y(k,131) + mat(k,88) = rxt(k,528)*y(k,70) + rxt(k,523)*y(k,131) + mat(k,117) = rxt(k,529)*y(k,70) + rxt(k,524)*y(k,131) + mat(k,1518) = rxt(k,470)*y(k,69) + rxt(k,482)*y(k,70) + rxt(k,471)*y(k,131) + mat(k,1732) = rxt(k,462)*y(k,28) + rxt(k,111)*y(k,91) + mat(k,1647) = rxt(k,110)*y(k,88) + mat(k,1309) = rxt(k,467)*y(k,28) + rxt(k,470)*y(k,49) + mat(k,804) = 4.000_r8*rxt(k,475)*y(k,8) + rxt(k,476)*y(k,9) & + + 2.000_r8*rxt(k,477)*y(k,11) + 2.000_r8*rxt(k,478)*y(k,12) & + + 2.000_r8*rxt(k,479)*y(k,13) + rxt(k,480)*y(k,14) & + + 2.000_r8*rxt(k,481)*y(k,15) + rxt(k,512)*y(k,34) + rxt(k,527) & + *y(k,46) + rxt(k,528)*y(k,47) + rxt(k,529)*y(k,48) + rxt(k,482) & + *y(k,49) + mat(k,499) = rxt(k,549)*y(k,28) + mat(k,825) = rxt(k,110)*y(k,63) + rxt(k,195)*y(k,101) + rxt(k,147)*y(k,103) & + + rxt(k,177)*y(k,105) + rxt(k,248)*y(k,116) + rxt(k,230) & + *y(k,117) + rxt(k,212)*y(k,120) + rxt(k,154)*y(k,126) + mat(k,545) = rxt(k,199)*y(k,101) + rxt(k,164)*y(k,103) + rxt(k,182)*y(k,105) & + + rxt(k,252)*y(k,116) + rxt(k,234)*y(k,117) + rxt(k,217) & + *y(k,120) + rxt(k,159)*y(k,126) + mat(k,529) = rxt(k,187)*y(k,101) + rxt(k,181)*y(k,103) + rxt(k,169)*y(k,105) & + + rxt(k,240)*y(k,116) + rxt(k,222)*y(k,117) + rxt(k,205) & + *y(k,120) + rxt(k,257)*y(k,126) + mat(k,373) = rxt(k,111)*y(k,62) + mat(k,1473) = rxt(k,195)*y(k,88) + rxt(k,199)*y(k,89) + rxt(k,187)*y(k,90) + mat(k,1690) = rxt(k,147)*y(k,88) + rxt(k,164)*y(k,89) + rxt(k,181)*y(k,90) + mat(k,1430) = rxt(k,177)*y(k,88) + rxt(k,182)*y(k,89) + rxt(k,169)*y(k,90) + mat(k,1165) = rxt(k,248)*y(k,88) + rxt(k,252)*y(k,89) + rxt(k,240)*y(k,90) + mat(k,1208) = rxt(k,230)*y(k,88) + rxt(k,234)*y(k,89) + rxt(k,222)*y(k,90) + mat(k,1351) = rxt(k,212)*y(k,88) + rxt(k,217)*y(k,89) + rxt(k,205)*y(k,90) + mat(k,1599) = rxt(k,154)*y(k,88) + rxt(k,159)*y(k,89) + rxt(k,257)*y(k,90) + mat(k,1001) = 3.000_r8*rxt(k,517)*y(k,19) + rxt(k,519)*y(k,20) + rxt(k,468) & + *y(k,28) + rxt(k,522)*y(k,46) + rxt(k,523)*y(k,47) + rxt(k,524) & + *y(k,48) + rxt(k,471)*y(k,49) + mat(k,1980) = rxt(k,463)*y(k,29) + mat(k,1735) = 2.000_r8*rxt(k,459)*y(k,28) + mat(k,354) = rxt(k,463)*y(k,25) + (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,49) + mat(k,1475) = (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,29) + (rxt(k,563) & + +rxt(k,569)+rxt(k,574))*y(k,54) + mat(k,321) = (rxt(k,563)+rxt(k,569)+rxt(k,574))*y(k,49) + 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,1734) = 2.000_r8*rxt(k,484)*y(k,28) + mat(k,1771) = -(rxt(k,116)*y(k,92) + rxt(k,128)*y(k,95) + rxt(k,286)*y(k,109) & + rxt(k,315)*y(k,125) + rxt(k,342)*y(k,132) + rxt(k,351) & - *y(k,133) + rxt(k,457)*y(k,20) + (4._r8*rxt(k,458) & + *y(k,133) + rxt(k,457)*y(k,21) + (4._r8*rxt(k,458) & + 4._r8*rxt(k,459) + 4._r8*rxt(k,460) + 4._r8*rxt(k,484) & - ) * y(k,26) + rxt(k,461)*y(k,98) + rxt(k,462)*y(k,60) + rxt(k,464) & - *y(k,61) + rxt(k,467)*y(k,67) + (rxt(k,468) + rxt(k,469) & - ) * y(k,131) + (rxt(k,490) + rxt(k,491) + rxt(k,492)) * y(k,4) & - + rxt(k,547)*y(k,76)) - mat(k,844) = -rxt(k,116)*y(k,26) - mat(k,685) = -rxt(k,128)*y(k,26) - mat(k,873) = -rxt(k,286)*y(k,26) - mat(k,1338) = -rxt(k,315)*y(k,26) - mat(k,1640) = -rxt(k,342)*y(k,26) - mat(k,1675) = -rxt(k,351)*y(k,26) - mat(k,332) = -rxt(k,457)*y(k,26) - mat(k,765) = -rxt(k,461)*y(k,26) - mat(k,1524) = -rxt(k,462)*y(k,26) - mat(k,1008) = -rxt(k,464)*y(k,26) - mat(k,1441) = -rxt(k,467)*y(k,26) - mat(k,812) = -(rxt(k,468) + rxt(k,469)) * y(k,26) - mat(k,598) = -(rxt(k,490) + rxt(k,491) + rxt(k,492)) * y(k,26) - mat(k,390) = -rxt(k,547)*y(k,26) - mat(k,285) = rxt(k,465)*y(k,67) - mat(k,1174) = rxt(k,483)*y(k,122) - mat(k,236) = rxt(k,473)*y(k,67) + rxt(k,472)*y(k,86) + rxt(k,474)*y(k,131) - mat(k,1441) = mat(k,1441) + rxt(k,465)*y(k,27) + rxt(k,473)*y(k,52) - mat(k,1215) = rxt(k,456)*y(k,86) - mat(k,68) = rxt(k,552)*y(k,76) - mat(k,390) = mat(k,390) + rxt(k,552)*y(k,70) - mat(k,1483) = rxt(k,472)*y(k,52) + rxt(k,456)*y(k,69) + rxt(k,455)*y(k,98) - mat(k,765) = mat(k,765) + rxt(k,455)*y(k,86) - mat(k,655) = rxt(k,483)*y(k,47) - mat(k,812) = mat(k,812) + rxt(k,474)*y(k,52) - mat(k,277) = -(rxt(k,463)*y(k,86) + rxt(k,465)*y(k,67) + rxt(k,466)*y(k,131) & - + (rxt(k,569) + rxt(k,574) + rxt(k,579)) * y(k,47)) - mat(k,1448) = -rxt(k,463)*y(k,27) - mat(k,1403) = -rxt(k,465)*y(k,27) - mat(k,784) = -rxt(k,466)*y(k,27) - mat(k,1138) = -(rxt(k,569) + rxt(k,574) + rxt(k,579)) * y(k,27) - mat(k,1726) = rxt(k,464)*y(k,61) - mat(k,969) = rxt(k,464)*y(k,26) - mat(k,134) = -((rxt(k,537) + rxt(k,541)) * y(k,131)) - mat(k,775) = -(rxt(k,537) + rxt(k,541)) * y(k,29) - mat(k,601) = rxt(k,530)*y(k,62) + rxt(k,531)*y(k,67) + rxt(k,486)*y(k,85) & - + rxt(k,450)*y(k,86) + rxt(k,532)*y(k,131) - mat(k,1095) = rxt(k,530)*y(k,16) - mat(k,1390) = rxt(k,531)*y(k,16) + rxt(k,542)*y(k,71) - mat(k,70) = rxt(k,542)*y(k,67) + rxt(k,543)*y(k,131) - mat(k,452) = rxt(k,486)*y(k,16) - mat(k,1445) = rxt(k,450)*y(k,16) - mat(k,775) = mat(k,775) + rxt(k,532)*y(k,16) + rxt(k,543)*y(k,71) - mat(k,27) = -(rxt(k,511)*y(k,122)) - mat(k,625) = -rxt(k,511)*y(k,31) - mat(k,32) = -(rxt(k,512)*y(k,122)) - mat(k,626) = -rxt(k,512)*y(k,32) - mat(k,58) = -(rxt(k,556)*y(k,62) + (rxt(k,557) + rxt(k,558)) * y(k,131)) - mat(k,1094) = -rxt(k,556)*y(k,33) - mat(k,771) = -(rxt(k,557) + rxt(k,558)) * y(k,33) - mat(k,198) = -(rxt(k,508)*y(k,39) + rxt(k,509)*y(k,137) + rxt(k,510)*y(k,49)) - mat(k,482) = -rxt(k,508)*y(k,37) - mat(k,1812) = -rxt(k,509)*y(k,37) - mat(k,1269) = -rxt(k,510)*y(k,37) - mat(k,28) = 2.000_r8*rxt(k,511)*y(k,122) - mat(k,33) = rxt(k,512)*y(k,122) - mat(k,628) = 2.000_r8*rxt(k,511)*y(k,31) + rxt(k,512)*y(k,32) - mat(k,1797) = -(rxt(k,105)*y(k,87) + rxt(k,117)*y(k,91) + rxt(k,129)*y(k,94) & - + rxt(k,287)*y(k,108) + rxt(k,309)*y(k,119) + rxt(k,317) & + ) * y(k,28) + rxt(k,461)*y(k,99) + rxt(k,462)*y(k,62) + rxt(k,464) & + *y(k,63) + rxt(k,467)*y(k,69) + (rxt(k,468) + rxt(k,469) & + ) * y(k,131) + (rxt(k,490) + rxt(k,491) + rxt(k,492)) * y(k,5) & + + rxt(k,549)*y(k,79)) + mat(k,1028) = -rxt(k,116)*y(k,28) + mat(k,851) = -rxt(k,128)*y(k,28) + mat(k,940) = -rxt(k,286)*y(k,28) + mat(k,1548) = -rxt(k,315)*y(k,28) + mat(k,1853) = -rxt(k,342)*y(k,28) + mat(k,1889) = -rxt(k,351)*y(k,28) + mat(k,436) = -rxt(k,457)*y(k,28) + mat(k,911) = -rxt(k,461)*y(k,28) + mat(k,1726) = -rxt(k,462)*y(k,28) + mat(k,1641) = -rxt(k,464)*y(k,28) + mat(k,1303) = -rxt(k,467)*y(k,28) + mat(k,995) = -(rxt(k,468) + rxt(k,469)) * y(k,28) + mat(k,724) = -(rxt(k,490) + rxt(k,491) + rxt(k,492)) * y(k,28) + mat(k,496) = -rxt(k,549)*y(k,28) + mat(k,2020) = rxt(k,472)*y(k,54) + rxt(k,456)*y(k,72) + rxt(k,455)*y(k,99) + mat(k,363) = rxt(k,465)*y(k,69) + mat(k,1512) = rxt(k,483)*y(k,70) + mat(k,326) = rxt(k,472)*y(k,25) + rxt(k,473)*y(k,69) + rxt(k,474)*y(k,131) + mat(k,1303) = mat(k,1303) + rxt(k,465)*y(k,29) + rxt(k,473)*y(k,54) + mat(k,798) = rxt(k,483)*y(k,49) + mat(k,1930) = rxt(k,456)*y(k,25) + mat(k,135) = rxt(k,554)*y(k,79) + mat(k,496) = mat(k,496) + rxt(k,554)*y(k,73) + mat(k,911) = mat(k,911) + rxt(k,455)*y(k,25) + mat(k,995) = mat(k,995) + rxt(k,474)*y(k,54) + mat(k,356) = -(rxt(k,463)*y(k,25) + rxt(k,465)*y(k,69) + rxt(k,466)*y(k,131) & + + (rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,49)) + mat(k,1988) = -rxt(k,463)*y(k,29) + mat(k,1267) = -rxt(k,465)*y(k,29) + mat(k,970) = -rxt(k,466)*y(k,29) + mat(k,1480) = -(rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,29) + mat(k,1740) = rxt(k,464)*y(k,63) + mat(k,1606) = rxt(k,464)*y(k,28) + mat(k,249) = -(rxt(k,540)*y(k,131)) + mat(k,962) = -rxt(k,540)*y(k,31) + mat(k,577) = rxt(k,486)*y(k,17) + mat(k,730) = rxt(k,486)*y(k,3) + rxt(k,450)*y(k,25) + rxt(k,530)*y(k,64) & + + rxt(k,531)*y(k,69) + rxt(k,532)*y(k,131) + mat(k,145) = rxt(k,518)*y(k,25) + mat(k,1986) = rxt(k,450)*y(k,17) + rxt(k,518)*y(k,20) + mat(k,1940) = rxt(k,594)*y(k,134) + mat(k,1080) = rxt(k,530)*y(k,17) + mat(k,1259) = rxt(k,531)*y(k,17) + rxt(k,543)*y(k,74) + mat(k,137) = rxt(k,543)*y(k,69) + rxt(k,544)*y(k,131) + mat(k,962) = mat(k,962) + rxt(k,532)*y(k,17) + rxt(k,544)*y(k,74) + mat(k,382) = rxt(k,594)*y(k,32) + mat(k,1977) = -(rxt(k,312)*y(k,121) + rxt(k,316)*y(k,125) + rxt(k,330) & + *y(k,128) + rxt(k,335)*y(k,129) + rxt(k,343)*y(k,132) + rxt(k,352) & + *y(k,133) + rxt(k,368)*y(k,116) + rxt(k,594)*y(k,134)) + mat(k,259) = -rxt(k,312)*y(k,32) + mat(k,1553) = -rxt(k,316)*y(k,32) + mat(k,605) = -rxt(k,330)*y(k,32) + mat(k,242) = -rxt(k,335)*y(k,32) + mat(k,1858) = -rxt(k,343)*y(k,32) + mat(k,1894) = -rxt(k,352)*y(k,32) + mat(k,1164) = -rxt(k,368)*y(k,32) + mat(k,395) = -rxt(k,594)*y(k,32) + mat(k,2025) = (rxt(k,114)+rxt(k,115))*y(k,92) + rxt(k,127)*y(k,95) + mat(k,1776) = rxt(k,116)*y(k,92) + rxt(k,128)*y(k,95) + mat(k,252) = rxt(k,540)*y(k,131) + mat(k,1386) = rxt(k,117)*y(k,92) + mat(k,1517) = rxt(k,130)*y(k,95) + mat(k,1248) = rxt(k,124)*y(k,92) + mat(k,1731) = rxt(k,280)*y(k,92) + (rxt(k,122)+rxt(k,123))*y(k,94) + mat(k,1646) = rxt(k,281)*y(k,92) + (rxt(k,120)+rxt(k,121))*y(k,94) + mat(k,1308) = rxt(k,125)*y(k,92) + mat(k,1825) = rxt(k,126)*y(k,92) + mat(k,1935) = rxt(k,132)*y(k,95) + mat(k,1033) = (rxt(k,114)+rxt(k,115))*y(k,25) + rxt(k,116)*y(k,28) & + + rxt(k,117)*y(k,40) + rxt(k,124)*y(k,51) + rxt(k,280)*y(k,62) & + + rxt(k,281)*y(k,63) + rxt(k,125)*y(k,69) + rxt(k,126)*y(k,71) & + + rxt(k,186)*y(k,101) + (rxt(k,170)+rxt(k,258))*y(k,103) + ( & + + rxt(k,168)+rxt(k,265))*y(k,105) + rxt(k,239)*y(k,116) & + + rxt(k,221)*y(k,117) + rxt(k,204)*y(k,120) + rxt(k,256) & + *y(k,126) + mat(k,514) = rxt(k,194)*y(k,101) + (rxt(k,247)+rxt(k,271))*y(k,103) + ( & + + rxt(k,176)+rxt(k,259))*y(k,105) + rxt(k,246)*y(k,116) & + + rxt(k,229)*y(k,117) + rxt(k,211)*y(k,120) + rxt(k,153) & + *y(k,126) + mat(k,683) = (rxt(k,122)+rxt(k,123))*y(k,62) + (rxt(k,120)+rxt(k,121)) & + *y(k,63) + rxt(k,196)*y(k,101) + (rxt(k,158)+rxt(k,260)) & + *y(k,103) + (rxt(k,178)+rxt(k,261))*y(k,105) + rxt(k,249) & + *y(k,116) + rxt(k,231)*y(k,117) + rxt(k,213)*y(k,120) & + + rxt(k,155)*y(k,126) + mat(k,856) = rxt(k,127)*y(k,25) + rxt(k,128)*y(k,28) + rxt(k,130)*y(k,49) & + + rxt(k,132)*y(k,72) + rxt(k,191)*y(k,101) + rxt(k,225)*y(k,103) & + + rxt(k,174)*y(k,105) + rxt(k,244)*y(k,116) + rxt(k,227) & + *y(k,117) + rxt(k,209)*y(k,120) + rxt(k,151)*y(k,126) + mat(k,1076) = rxt(k,306)*y(k,119) + mat(k,482) = rxt(k,189)*y(k,101) + rxt(k,203)*y(k,103) + rxt(k,172)*y(k,105) & + + rxt(k,242)*y(k,116) + rxt(k,224)*y(k,117) + rxt(k,207) & + *y(k,120) + rxt(k,149)*y(k,126) + mat(k,1472) = rxt(k,186)*y(k,92) + rxt(k,194)*y(k,93) + rxt(k,196)*y(k,94) & + + rxt(k,191)*y(k,95) + rxt(k,189)*y(k,98) + mat(k,1689) = (rxt(k,170)+rxt(k,258))*y(k,92) + (rxt(k,247)+rxt(k,271)) & + *y(k,93) + (rxt(k,158)+rxt(k,260))*y(k,94) + rxt(k,225)*y(k,95) & + + rxt(k,203)*y(k,98) + mat(k,1429) = (rxt(k,168)+rxt(k,265))*y(k,92) + (rxt(k,176)+rxt(k,259)) & + *y(k,93) + (rxt(k,178)+rxt(k,261))*y(k,94) + rxt(k,174)*y(k,95) & + + rxt(k,172)*y(k,98) + mat(k,1164) = mat(k,1164) + rxt(k,239)*y(k,92) + rxt(k,246)*y(k,93) & + + rxt(k,249)*y(k,94) + rxt(k,244)*y(k,95) + rxt(k,242)*y(k,98) + mat(k,1207) = rxt(k,221)*y(k,92) + rxt(k,229)*y(k,93) + rxt(k,231)*y(k,94) & + + rxt(k,227)*y(k,95) + rxt(k,224)*y(k,98) + mat(k,266) = rxt(k,306)*y(k,96) + rxt(k,307)*y(k,137) + mat(k,1350) = rxt(k,204)*y(k,92) + rxt(k,211)*y(k,93) + rxt(k,213)*y(k,94) & + + rxt(k,209)*y(k,95) + rxt(k,207)*y(k,98) + mat(k,1598) = rxt(k,256)*y(k,92) + rxt(k,153)*y(k,93) + rxt(k,155)*y(k,94) & + + rxt(k,151)*y(k,95) + rxt(k,149)*y(k,98) + mat(k,1000) = rxt(k,540)*y(k,31) + mat(k,2085) = rxt(k,307)*y(k,119) + mat(k,89) = -(rxt(k,511)*y(k,70)) + mat(k,767) = -rxt(k,511)*y(k,33) + mat(k,54) = rxt(k,476)*y(k,70) + mat(k,59) = rxt(k,502)*y(k,70) + mat(k,65) = rxt(k,478)*y(k,70) + mat(k,39) = 2.000_r8*rxt(k,479)*y(k,70) + mat(k,69) = 2.000_r8*rxt(k,480)*y(k,70) + mat(k,43) = rxt(k,481)*y(k,70) + mat(k,31) = 2.000_r8*rxt(k,504)*y(k,70) + mat(k,85) = rxt(k,528)*y(k,70) + rxt(k,523)*y(k,131) + mat(k,112) = rxt(k,529)*y(k,70) + rxt(k,524)*y(k,131) + mat(k,767) = mat(k,767) + rxt(k,476)*y(k,9) + rxt(k,502)*y(k,10) + rxt(k,478) & + *y(k,12) + 2.000_r8*rxt(k,479)*y(k,13) + 2.000_r8*rxt(k,480) & + *y(k,14) + rxt(k,481)*y(k,15) + 2.000_r8*rxt(k,504)*y(k,42) & + + rxt(k,528)*y(k,47) + rxt(k,529)*y(k,48) + mat(k,950) = rxt(k,523)*y(k,47) + rxt(k,524)*y(k,48) + mat(k,80) = -(rxt(k,512)*y(k,70)) + mat(k,765) = -rxt(k,512)*y(k,34) + mat(k,35) = rxt(k,477)*y(k,70) + mat(k,64) = rxt(k,478)*y(k,70) + mat(k,76) = rxt(k,527)*y(k,70) + rxt(k,522)*y(k,131) + mat(k,765) = mat(k,765) + rxt(k,477)*y(k,11) + rxt(k,478)*y(k,12) & + + rxt(k,527)*y(k,46) + mat(k,948) = rxt(k,522)*y(k,46) + mat(k,122) = -(rxt(k,541)*y(k,64) + (rxt(k,542) + rxt(k,556)) * y(k,131)) + mat(k,1079) = -rxt(k,541)*y(k,35) + mat(k,953) = -(rxt(k,542) + rxt(k,556)) * y(k,35) + mat(k,338) = -(rxt(k,507)*y(k,23) + rxt(k,508)*y(k,41) + rxt(k,509)*y(k,137) & + + rxt(k,510)*y(k,51)) + mat(k,412) = -rxt(k,507)*y(k,39) + mat(k,641) = -rxt(k,508)*y(k,39) + mat(k,2041) = -rxt(k,509)*y(k,39) + mat(k,1212) = -rxt(k,510)*y(k,39) + mat(k,60) = rxt(k,502)*y(k,70) + mat(k,70) = rxt(k,480)*y(k,70) + mat(k,90) = 2.000_r8*rxt(k,511)*y(k,70) + mat(k,81) = rxt(k,512)*y(k,70) + mat(k,775) = rxt(k,502)*y(k,10) + rxt(k,480)*y(k,14) + 2.000_r8*rxt(k,511) & + *y(k,33) + rxt(k,512)*y(k,34) + mat(k,1372) = -(rxt(k,105)*y(k,88) + rxt(k,117)*y(k,92) + rxt(k,129)*y(k,95) & + + rxt(k,287)*y(k,109) + rxt(k,309)*y(k,120) + rxt(k,317) & *y(k,125) + rxt(k,331)*y(k,128) + rxt(k,344)*y(k,132) + (rxt(k,408) & - + rxt(k,409) + rxt(k,410)) * y(k,98) + rxt(k,411)*y(k,68) & - + rxt(k,414)*y(k,69)) - mat(k,707) = -rxt(k,105)*y(k,38) - mat(k,845) = -rxt(k,117)*y(k,38) - mat(k,686) = -rxt(k,129)*y(k,38) - mat(k,874) = -rxt(k,287)*y(k,38) - mat(k,1092) = -rxt(k,309)*y(k,38) - mat(k,1339) = -rxt(k,317)*y(k,38) - mat(k,451) = -rxt(k,331)*y(k,38) - mat(k,1641) = -rxt(k,344)*y(k,38) - mat(k,766) = -(rxt(k,408) + rxt(k,409) + rxt(k,410)) * y(k,38) - mat(k,1265) = -rxt(k,411)*y(k,38) - mat(k,1216) = -rxt(k,414)*y(k,38) - mat(k,623) = rxt(k,532)*y(k,131) - mat(k,137) = rxt(k,541)*y(k,131) - mat(k,204) = rxt(k,508)*y(k,39) - mat(k,501) = rxt(k,508)*y(k,37) + rxt(k,406)*y(k,67) + rxt(k,452)*y(k,86) & - + rxt(k,389)*y(k,122) + rxt(k,415)*y(k,131) + rxt(k,354) & - *y(k,133) - mat(k,244) = rxt(k,506)*y(k,122) - mat(k,1175) = rxt(k,483)*y(k,122) - mat(k,322) = rxt(k,438)*y(k,131) - mat(k,1442) = rxt(k,406)*y(k,39) + rxt(k,418)*y(k,131) - mat(k,76) = rxt(k,543)*y(k,131) - mat(k,174) = rxt(k,548)*y(k,131) - mat(k,391) = rxt(k,553)*y(k,131) - mat(k,1484) = rxt(k,452)*y(k,39) - mat(k,707) = mat(k,707) + rxt(k,195)*y(k,100) + rxt(k,147)*y(k,102) & - + rxt(k,177)*y(k,104) - mat(k,422) = rxt(k,199)*y(k,100) + rxt(k,164)*y(k,102) + rxt(k,182)*y(k,104) - mat(k,406) = rxt(k,187)*y(k,100) + rxt(k,181)*y(k,102) + rxt(k,169)*y(k,104) - mat(k,845) = mat(k,845) + rxt(k,186)*y(k,100) + (rxt(k,170)+rxt(k,258)) & - *y(k,102) + (rxt(k,168)+rxt(k,265))*y(k,104) - mat(k,374) = rxt(k,194)*y(k,100) + (rxt(k,247)+rxt(k,271))*y(k,102) + ( & - + rxt(k,176)+rxt(k,259))*y(k,104) - mat(k,555) = rxt(k,196)*y(k,100) + (rxt(k,158)+rxt(k,260))*y(k,102) + ( & - + rxt(k,178)+rxt(k,261))*y(k,104) - mat(k,686) = mat(k,686) + rxt(k,191)*y(k,100) + rxt(k,225)*y(k,102) & - + rxt(k,174)*y(k,104) - mat(k,1567) = rxt(k,138)*y(k,96) + rxt(k,382)*y(k,99) + rxt(k,383)*y(k,100) & - + rxt(k,141)*y(k,102) + rxt(k,144)*y(k,104) + rxt(k,381) & - *y(k,105) - mat(k,87) = rxt(k,138)*y(k,95) - mat(k,346) = rxt(k,189)*y(k,100) + rxt(k,203)*y(k,102) + rxt(k,172)*y(k,104) - mat(k,166) = rxt(k,382)*y(k,95) - mat(k,1051) = rxt(k,195)*y(k,87) + rxt(k,199)*y(k,88) + rxt(k,187)*y(k,89) & - + rxt(k,186)*y(k,91) + rxt(k,194)*y(k,92) + rxt(k,196)*y(k,93) & - + rxt(k,191)*y(k,94) + rxt(k,383)*y(k,95) + rxt(k,189)*y(k,97) & - + rxt(k,201)*y(k,108) + rxt(k,197)*y(k,109) + rxt(k,200) & - *y(k,111) + rxt(k,193)*y(k,112) + rxt(k,198)*y(k,113) & + + rxt(k,409) + rxt(k,410)) * y(k,99) + rxt(k,411)*y(k,71) & + + rxt(k,414)*y(k,72)) + mat(k,816) = -rxt(k,105)*y(k,40) + mat(k,1019) = -rxt(k,117)*y(k,40) + mat(k,842) = -rxt(k,129)*y(k,40) + mat(k,932) = -rxt(k,287)*y(k,40) + mat(k,1336) = -rxt(k,309)*y(k,40) + mat(k,1539) = -rxt(k,317)*y(k,40) + mat(k,597) = -rxt(k,331)*y(k,40) + mat(k,1844) = -rxt(k,344)*y(k,40) + mat(k,904) = -(rxt(k,408) + rxt(k,409) + rxt(k,410)) * y(k,40) + mat(k,1811) = -rxt(k,411)*y(k,40) + mat(k,1921) = -rxt(k,414)*y(k,40) + mat(k,743) = rxt(k,532)*y(k,131) + mat(k,423) = rxt(k,538)*y(k,70) + mat(k,2011) = rxt(k,452)*y(k,41) + mat(k,345) = rxt(k,508)*y(k,41) + mat(k,653) = rxt(k,452)*y(k,25) + rxt(k,508)*y(k,39) + rxt(k,406)*y(k,69) & + + rxt(k,389)*y(k,70) + rxt(k,415)*y(k,131) + rxt(k,354)*y(k,133) + mat(k,335) = rxt(k,506)*y(k,70) + mat(k,1503) = rxt(k,483)*y(k,70) + mat(k,450) = rxt(k,438)*y(k,131) + mat(k,1294) = rxt(k,406)*y(k,41) + rxt(k,418)*y(k,131) + mat(k,791) = rxt(k,538)*y(k,23) + rxt(k,389)*y(k,41) + rxt(k,506)*y(k,45) & + + rxt(k,483)*y(k,49) + mat(k,143) = rxt(k,544)*y(k,131) + mat(k,272) = rxt(k,550)*y(k,131) + mat(k,493) = rxt(k,555)*y(k,131) + mat(k,816) = mat(k,816) + rxt(k,195)*y(k,101) + rxt(k,147)*y(k,103) & + + rxt(k,177)*y(k,105) + mat(k,537) = rxt(k,199)*y(k,101) + rxt(k,164)*y(k,103) + rxt(k,182)*y(k,105) + mat(k,521) = rxt(k,187)*y(k,101) + rxt(k,181)*y(k,103) + rxt(k,169)*y(k,105) + mat(k,1019) = mat(k,1019) + rxt(k,186)*y(k,101) + (rxt(k,170)+rxt(k,258)) & + *y(k,103) + (rxt(k,168)+rxt(k,265))*y(k,105) + mat(k,507) = rxt(k,194)*y(k,101) + (rxt(k,247)+rxt(k,271))*y(k,103) + ( & + + rxt(k,176)+rxt(k,259))*y(k,105) + mat(k,675) = rxt(k,196)*y(k,101) + (rxt(k,158)+rxt(k,260))*y(k,103) + ( & + + rxt(k,178)+rxt(k,261))*y(k,105) + mat(k,842) = mat(k,842) + rxt(k,191)*y(k,101) + rxt(k,225)*y(k,103) & + + rxt(k,174)*y(k,105) + mat(k,1062) = rxt(k,138)*y(k,97) + rxt(k,382)*y(k,100) + rxt(k,383)*y(k,101) & + + rxt(k,141)*y(k,103) + rxt(k,144)*y(k,105) + rxt(k,381) & + *y(k,106) + mat(k,168) = rxt(k,138)*y(k,96) + mat(k,475) = rxt(k,189)*y(k,101) + rxt(k,203)*y(k,103) + rxt(k,172)*y(k,105) + mat(k,246) = rxt(k,382)*y(k,96) + mat(k,1458) = rxt(k,195)*y(k,88) + rxt(k,199)*y(k,89) + rxt(k,187)*y(k,90) & + + rxt(k,186)*y(k,92) + rxt(k,194)*y(k,93) + rxt(k,196)*y(k,94) & + + rxt(k,191)*y(k,95) + rxt(k,383)*y(k,96) + rxt(k,189)*y(k,98) & + + rxt(k,201)*y(k,109) + rxt(k,197)*y(k,110) + rxt(k,200) & + *y(k,112) + rxt(k,193)*y(k,113) + rxt(k,198)*y(k,114) & + rxt(k,190)*y(k,125) - mat(k,1718) = rxt(k,147)*y(k,87) + rxt(k,164)*y(k,88) + rxt(k,181)*y(k,89) + ( & - + rxt(k,170)+rxt(k,258))*y(k,91) + (rxt(k,247)+rxt(k,271)) & - *y(k,92) + (rxt(k,158)+rxt(k,260))*y(k,93) + rxt(k,225)*y(k,94) & - + rxt(k,141)*y(k,95) + rxt(k,203)*y(k,97) + rxt(k,166)*y(k,108) & - + rxt(k,162)*y(k,109) + rxt(k,165)*y(k,111) + (rxt(k,236) & - +rxt(k,262))*y(k,112) + rxt(k,163)*y(k,113) + rxt(k,214) & + mat(k,1675) = rxt(k,147)*y(k,88) + rxt(k,164)*y(k,89) + rxt(k,181)*y(k,90) + ( & + + rxt(k,170)+rxt(k,258))*y(k,92) + (rxt(k,247)+rxt(k,271)) & + *y(k,93) + (rxt(k,158)+rxt(k,260))*y(k,94) + rxt(k,225)*y(k,95) & + + rxt(k,141)*y(k,96) + rxt(k,203)*y(k,98) + rxt(k,166)*y(k,109) & + + rxt(k,162)*y(k,110) + rxt(k,165)*y(k,112) + (rxt(k,236) & + +rxt(k,262))*y(k,113) + rxt(k,163)*y(k,114) + rxt(k,214) & *y(k,125) - mat(k,1609) = rxt(k,177)*y(k,87) + rxt(k,182)*y(k,88) + rxt(k,169)*y(k,89) + ( & - + rxt(k,168)+rxt(k,265))*y(k,91) + (rxt(k,176)+rxt(k,259)) & - *y(k,92) + (rxt(k,178)+rxt(k,261))*y(k,93) + rxt(k,174)*y(k,94) & - + rxt(k,144)*y(k,95) + rxt(k,172)*y(k,97) + rxt(k,184)*y(k,108) & - + rxt(k,179)*y(k,109) + rxt(k,183)*y(k,111) + (rxt(k,175) & - +rxt(k,263))*y(k,112) + rxt(k,180)*y(k,113) + rxt(k,173) & + mat(k,1415) = rxt(k,177)*y(k,88) + rxt(k,182)*y(k,89) + rxt(k,169)*y(k,90) + ( & + + rxt(k,168)+rxt(k,265))*y(k,92) + (rxt(k,176)+rxt(k,259)) & + *y(k,93) + (rxt(k,178)+rxt(k,261))*y(k,94) + rxt(k,174)*y(k,95) & + + rxt(k,144)*y(k,96) + rxt(k,172)*y(k,98) + rxt(k,184)*y(k,109) & + + rxt(k,179)*y(k,110) + rxt(k,183)*y(k,112) + (rxt(k,175) & + +rxt(k,263))*y(k,113) + rxt(k,180)*y(k,114) + rxt(k,173) & *y(k,125) - mat(k,184) = rxt(k,381)*y(k,95) - mat(k,874) = mat(k,874) + rxt(k,201)*y(k,100) + rxt(k,166)*y(k,102) & - + rxt(k,184)*y(k,104) - mat(k,436) = rxt(k,197)*y(k,100) + rxt(k,162)*y(k,102) + rxt(k,179)*y(k,104) - mat(k,535) = rxt(k,200)*y(k,100) + rxt(k,165)*y(k,102) + rxt(k,183)*y(k,104) - mat(k,575) = rxt(k,193)*y(k,100) + (rxt(k,236)+rxt(k,262))*y(k,102) + ( & - + rxt(k,175)+rxt(k,263))*y(k,104) - mat(k,479) = rxt(k,198)*y(k,100) + rxt(k,163)*y(k,102) + rxt(k,180)*y(k,104) - mat(k,656) = rxt(k,389)*y(k,39) + rxt(k,506)*y(k,43) + rxt(k,483)*y(k,47) - mat(k,1339) = mat(k,1339) + rxt(k,190)*y(k,100) + rxt(k,214)*y(k,102) & - + rxt(k,173)*y(k,104) - mat(k,813) = rxt(k,532)*y(k,16) + rxt(k,541)*y(k,29) + rxt(k,415)*y(k,39) & - + rxt(k,438)*y(k,54) + rxt(k,418)*y(k,67) + rxt(k,543)*y(k,71) & - + rxt(k,548)*y(k,74) + rxt(k,553)*y(k,76) - mat(k,1676) = rxt(k,354)*y(k,39) + mat(k,283) = rxt(k,381)*y(k,96) + mat(k,932) = mat(k,932) + rxt(k,201)*y(k,101) + rxt(k,166)*y(k,103) & + + rxt(k,184)*y(k,105) + mat(k,552) = rxt(k,197)*y(k,101) + rxt(k,162)*y(k,103) + rxt(k,179)*y(k,105) + mat(k,631) = rxt(k,200)*y(k,101) + rxt(k,165)*y(k,103) + rxt(k,183)*y(k,105) + mat(k,696) = rxt(k,193)*y(k,101) + (rxt(k,236)+rxt(k,262))*y(k,103) + ( & + + rxt(k,175)+rxt(k,263))*y(k,105) + mat(k,568) = rxt(k,198)*y(k,101) + rxt(k,163)*y(k,103) + rxt(k,180)*y(k,105) + mat(k,1539) = mat(k,1539) + rxt(k,190)*y(k,101) + rxt(k,214)*y(k,103) & + + rxt(k,173)*y(k,105) + mat(k,988) = rxt(k,532)*y(k,17) + rxt(k,415)*y(k,41) + rxt(k,438)*y(k,56) & + + rxt(k,418)*y(k,69) + rxt(k,544)*y(k,74) + rxt(k,550)*y(k,77) & + + rxt(k,555)*y(k,79) + mat(k,1880) = rxt(k,354)*y(k,41) end do - end subroutine nlnmat01 - subroutine nlnmat02( avec_len, mat, y, rxt ) + end subroutine nlnmat02 + subroutine nlnmat03( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -245,259 +505,210 @@ subroutine nlnmat02( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,484) = -((rxt(k,353) + rxt(k,354)) * y(k,133) + rxt(k,389)*y(k,122) & - + rxt(k,406)*y(k,67) + rxt(k,415)*y(k,131) + rxt(k,452)*y(k,86) & - + rxt(k,508)*y(k,37)) - mat(k,1646) = -(rxt(k,353) + rxt(k,354)) * y(k,39) - mat(k,634) = -rxt(k,389)*y(k,39) - mat(k,1410) = -rxt(k,406)*y(k,39) - mat(k,789) = -rxt(k,415)*y(k,39) - mat(k,1452) = -rxt(k,452)*y(k,39) - mat(k,200) = -rxt(k,508)*y(k,39) - mat(k,1766) = rxt(k,408)*y(k,98) - mat(k,743) = rxt(k,408)*y(k,38) - mat(k,146) = -(rxt(k,407)*y(k,67) + rxt(k,416)*y(k,131) + rxt(k,453)*y(k,86)) - mat(k,1392) = -rxt(k,407)*y(k,41) - mat(k,776) = -rxt(k,416)*y(k,41) - mat(k,1446) = -rxt(k,453)*y(k,41) - mat(k,736) = 2.000_r8*rxt(k,422)*y(k,98) - mat(k,776) = mat(k,776) + 2.000_r8*rxt(k,421)*y(k,131) - mat(k,45) = rxt(k,555)*y(k,137) - mat(k,1799) = rxt(k,555)*y(k,78) - mat(k,238) = -(rxt(k,499)*y(k,67) + rxt(k,500)*y(k,131) + (rxt(k,505) & - + rxt(k,506)) * y(k,122)) - mat(k,1399) = -rxt(k,499)*y(k,43) - mat(k,782) = -rxt(k,500)*y(k,43) - mat(k,629) = -(rxt(k,505) + rxt(k,506)) * y(k,43) - mat(k,602) = rxt(k,486)*y(k,85) - mat(k,453) = rxt(k,486)*y(k,16) + rxt(k,487)*y(k,98) - mat(k,740) = rxt(k,487)*y(k,85) - mat(k,1160) = -(rxt(k,106)*y(k,88) + rxt(k,108)*y(k,87) + rxt(k,130)*y(k,94) & - + (rxt(k,276) + rxt(k,298)) * y(k,110) + rxt(k,289)*y(k,108) & + mat(k,644) = -((rxt(k,353) + rxt(k,354)) * y(k,133) + rxt(k,389)*y(k,70) & + + rxt(k,406)*y(k,69) + rxt(k,415)*y(k,131) + rxt(k,452)*y(k,25) & + + rxt(k,508)*y(k,39)) + mat(k,1864) = -(rxt(k,353) + rxt(k,354)) * y(k,41) + mat(k,781) = -rxt(k,389)*y(k,41) + mat(k,1276) = -rxt(k,406)*y(k,41) + mat(k,976) = -rxt(k,415)*y(k,41) + mat(k,1993) = -rxt(k,452)*y(k,41) + mat(k,341) = -rxt(k,508)*y(k,41) + mat(k,415) = rxt(k,539)*y(k,70) + mat(k,1355) = rxt(k,408)*y(k,99) + mat(k,781) = mat(k,781) + rxt(k,539)*y(k,23) + mat(k,893) = rxt(k,408)*y(k,40) + mat(k,30) = -(rxt(k,504)*y(k,70)) + mat(k,756) = -rxt(k,504)*y(k,42) + mat(k,211) = -(rxt(k,407)*y(k,69) + rxt(k,416)*y(k,131) + rxt(k,453)*y(k,25)) + mat(k,1256) = -rxt(k,407)*y(k,43) + mat(k,960) = -rxt(k,416)*y(k,43) + mat(k,1984) = -rxt(k,453)*y(k,43) + mat(k,886) = 2.000_r8*rxt(k,422)*y(k,99) + mat(k,960) = mat(k,960) + 2.000_r8*rxt(k,421)*y(k,131) + mat(k,99) = rxt(k,557)*y(k,137) + mat(k,2028) = rxt(k,557)*y(k,81) + mat(k,329) = -(rxt(k,499)*y(k,69) + rxt(k,500)*y(k,131) + (rxt(k,505) & + + rxt(k,506)) * y(k,70)) + mat(k,1265) = -rxt(k,499)*y(k,45) + mat(k,967) = -rxt(k,500)*y(k,45) + mat(k,774) = -(rxt(k,505) + rxt(k,506)) * y(k,45) + mat(k,578) = rxt(k,486)*y(k,17) + rxt(k,487)*y(k,99) + mat(k,731) = rxt(k,486)*y(k,3) + mat(k,890) = rxt(k,487)*y(k,3) + mat(k,75) = -(rxt(k,522)*y(k,131) + rxt(k,527)*y(k,70)) + mat(k,947) = -rxt(k,522)*y(k,46) + mat(k,764) = -rxt(k,527)*y(k,46) + mat(k,84) = -(rxt(k,523)*y(k,131) + rxt(k,528)*y(k,70)) + mat(k,949) = -rxt(k,523)*y(k,47) + mat(k,766) = -rxt(k,528)*y(k,47) + mat(k,113) = -(rxt(k,524)*y(k,131) + rxt(k,529)*y(k,70)) + mat(k,952) = -rxt(k,524)*y(k,48) + mat(k,769) = -rxt(k,529)*y(k,48) + mat(k,1506) = -(rxt(k,106)*y(k,89) + rxt(k,108)*y(k,88) + rxt(k,130)*y(k,95) & + + (rxt(k,276) + rxt(k,298)) * y(k,111) + rxt(k,289)*y(k,109) & + rxt(k,318)*y(k,125) + rxt(k,345)*y(k,132) + rxt(k,356) & - *y(k,133) + rxt(k,470)*y(k,67) + rxt(k,471)*y(k,131) + (rxt(k,482) & - + rxt(k,483)) * y(k,122) + (rxt(k,564) + rxt(k,570) + rxt(k,575) & - ) * y(k,52) + (rxt(k,569) + rxt(k,574) + rxt(k,579)) * y(k,27) & - + (rxt(k,571) + rxt(k,576)) * y(k,51)) - mat(k,415) = -rxt(k,106)*y(k,47) - mat(k,698) = -rxt(k,108)*y(k,47) - mat(k,672) = -rxt(k,130)*y(k,47) - mat(k,721) = -(rxt(k,276) + rxt(k,298)) * y(k,47) - mat(k,859) = -rxt(k,289)*y(k,47) - mat(k,1324) = -rxt(k,318)*y(k,47) - mat(k,1626) = -rxt(k,345)*y(k,47) - mat(k,1661) = -rxt(k,356)*y(k,47) - mat(k,1427) = -rxt(k,470)*y(k,47) - mat(k,800) = -rxt(k,471)*y(k,47) - mat(k,643) = -(rxt(k,482) + rxt(k,483)) * y(k,47) - mat(k,233) = -(rxt(k,564) + rxt(k,570) + rxt(k,575)) * y(k,47) - mat(k,281) = -(rxt(k,569) + rxt(k,574) + rxt(k,579)) * y(k,47) - mat(k,211) = -(rxt(k,571) + rxt(k,576)) * y(k,47) - mat(k,612) = rxt(k,450)*y(k,86) - mat(k,1747) = rxt(k,469)*y(k,131) - mat(k,1782) = rxt(k,105)*y(k,87) - mat(k,491) = rxt(k,452)*y(k,86) - mat(k,149) = rxt(k,453)*y(k,86) - mat(k,1289) = rxt(k,109)*y(k,87) + rxt(k,299)*y(k,113) - mat(k,233) = mat(k,233) + rxt(k,472)*y(k,86) - mat(k,1469) = rxt(k,450)*y(k,16) + rxt(k,452)*y(k,39) + rxt(k,453)*y(k,41) & - + rxt(k,472)*y(k,52) + rxt(k,454)*y(k,98) - mat(k,698) = mat(k,698) + rxt(k,105)*y(k,38) + rxt(k,109)*y(k,49) - mat(k,399) = rxt(k,187)*y(k,100) + (rxt(k,181)+2.000_r8*rxt(k,267))*y(k,102) + ( & - + rxt(k,169)+2.000_r8*rxt(k,268))*y(k,104) + rxt(k,240)*y(k,115) & - + rxt(k,222)*y(k,116) + rxt(k,205)*y(k,119) + rxt(k,257) & + *y(k,133) + rxt(k,470)*y(k,69) + rxt(k,471)*y(k,131) + (rxt(k,482) & + + rxt(k,483)) * y(k,70) + (rxt(k,563) + rxt(k,569) + rxt(k,574) & + ) * y(k,54) + (rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,29) & + + (rxt(k,570) + rxt(k,575)) * y(k,53)) + mat(k,540) = -rxt(k,106)*y(k,49) + mat(k,819) = -rxt(k,108)*y(k,49) + mat(k,845) = -rxt(k,130)*y(k,49) + mat(k,875) = -(rxt(k,276) + rxt(k,298)) * y(k,49) + mat(k,935) = -rxt(k,289)*y(k,49) + mat(k,1542) = -rxt(k,318)*y(k,49) + mat(k,1847) = -rxt(k,345)*y(k,49) + mat(k,1883) = -rxt(k,356)*y(k,49) + mat(k,1297) = -rxt(k,470)*y(k,49) + mat(k,990) = -rxt(k,471)*y(k,49) + mat(k,793) = -(rxt(k,482) + rxt(k,483)) * y(k,49) + mat(k,325) = -(rxt(k,563) + rxt(k,569) + rxt(k,574)) * y(k,49) + mat(k,361) = -(rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,49) + mat(k,311) = -(rxt(k,570) + rxt(k,575)) * y(k,49) + mat(k,180) = rxt(k,513)*y(k,25) + mat(k,744) = rxt(k,450)*y(k,25) + mat(k,224) = rxt(k,515)*y(k,25) + mat(k,149) = 2.000_r8*rxt(k,518)*y(k,25) + mat(k,424) = rxt(k,451)*y(k,25) + mat(k,156) = rxt(k,520)*y(k,25) + mat(k,2014) = rxt(k,513)*y(k,16) + rxt(k,450)*y(k,17) + rxt(k,515)*y(k,18) & + + 2.000_r8*rxt(k,518)*y(k,20) + rxt(k,451)*y(k,23) + rxt(k,520) & + *y(k,24) + rxt(k,452)*y(k,41) + rxt(k,453)*y(k,43) + rxt(k,472) & + *y(k,54) + rxt(k,454)*y(k,99) + mat(k,1765) = rxt(k,469)*y(k,131) + mat(k,1375) = rxt(k,105)*y(k,88) + mat(k,654) = rxt(k,452)*y(k,25) + mat(k,215) = rxt(k,453)*y(k,25) + mat(k,1237) = rxt(k,109)*y(k,88) + rxt(k,299)*y(k,114) + mat(k,325) = mat(k,325) + rxt(k,472)*y(k,25) + mat(k,819) = mat(k,819) + rxt(k,105)*y(k,40) + rxt(k,109)*y(k,51) + mat(k,524) = rxt(k,187)*y(k,101) + (rxt(k,181)+2.000_r8*rxt(k,267))*y(k,103) + ( & + + rxt(k,169)+2.000_r8*rxt(k,268))*y(k,105) + rxt(k,240)*y(k,116) & + + rxt(k,222)*y(k,117) + rxt(k,205)*y(k,120) + rxt(k,257) & *y(k,126) - mat(k,753) = rxt(k,454)*y(k,86) - mat(k,1036) = rxt(k,187)*y(k,89) + rxt(k,198)*y(k,113) - mat(k,1703) = (rxt(k,181)+2.000_r8*rxt(k,267))*y(k,89) + rxt(k,163)*y(k,113) - mat(k,1594) = (rxt(k,169)+2.000_r8*rxt(k,268))*y(k,89) + rxt(k,180)*y(k,113) - mat(k,472) = rxt(k,299)*y(k,49) + rxt(k,198)*y(k,100) + rxt(k,163)*y(k,102) & - + rxt(k,180)*y(k,104) + rxt(k,251)*y(k,115) + rxt(k,233) & - *y(k,116) + rxt(k,216)*y(k,119) + rxt(k,157)*y(k,126) - mat(k,906) = rxt(k,240)*y(k,89) + rxt(k,251)*y(k,113) - mat(k,948) = rxt(k,222)*y(k,89) + rxt(k,233)*y(k,113) - mat(k,1077) = rxt(k,205)*y(k,89) + rxt(k,216)*y(k,113) - mat(k,1368) = rxt(k,257)*y(k,89) + rxt(k,157)*y(k,113) - mat(k,800) = mat(k,800) + rxt(k,469)*y(k,26) - mat(k,197) = rxt(k,508)*y(k,39) + rxt(k,510)*y(k,49) + rxt(k,509)*y(k,137) - mat(k,481) = rxt(k,508)*y(k,37) - mat(k,1267) = rxt(k,510)*y(k,37) - mat(k,1800) = rxt(k,509)*y(k,37) - mat(k,1292) = -(rxt(k,109)*y(k,87) + rxt(k,124)*y(k,91) + rxt(k,290)*y(k,108) & - + rxt(k,295)*y(k,112) + rxt(k,299)*y(k,113) + rxt(k,300) & - *y(k,110) + rxt(k,319)*y(k,125) + rxt(k,357)*y(k,133) + rxt(k,447) & - *y(k,131) + rxt(k,510)*y(k,37)) - mat(k,700) = -rxt(k,109)*y(k,49) - mat(k,833) = -rxt(k,124)*y(k,49) - mat(k,862) = -rxt(k,290)*y(k,49) - mat(k,569) = -rxt(k,295)*y(k,49) - mat(k,474) = -rxt(k,299)*y(k,49) - mat(k,724) = -rxt(k,300)*y(k,49) - mat(k,1327) = -rxt(k,319)*y(k,49) - mat(k,1664) = -rxt(k,357)*y(k,49) - mat(k,803) = -rxt(k,447)*y(k,49) - mat(k,203) = -rxt(k,510)*y(k,49) - mat(k,615) = rxt(k,530)*y(k,62) - mat(k,282) = (rxt(k,569)+rxt(k,574)+rxt(k,579))*y(k,47) - mat(k,63) = rxt(k,556)*y(k,62) - mat(k,1163) = (rxt(k,569)+rxt(k,574)+rxt(k,579))*y(k,27) + rxt(k,298) & - *y(k,110) - mat(k,303) = rxt(k,142)*y(k,102) + rxt(k,145)*y(k,104) + rxt(k,293)*y(k,111) & - + rxt(k,297)*y(k,112) - mat(k,997) = rxt(k,446)*y(k,131) - mat(k,1119) = rxt(k,530)*y(k,16) + rxt(k,556)*y(k,33) - mat(k,1039) = rxt(k,188)*y(k,110) + 2.000_r8*rxt(k,185)*y(k,114) - mat(k,51) = rxt(k,140)*y(k,137) - mat(k,1706) = rxt(k,142)*y(k,56) + (rxt(k,192)+rxt(k,264))*y(k,110) + ( & - + 2.000_r8*rxt(k,146)+2.000_r8*rxt(k,269))*y(k,114) - mat(k,55) = rxt(k,143)*y(k,137) - mat(k,1597) = rxt(k,145)*y(k,56) + (rxt(k,171)+rxt(k,266))*y(k,110) + ( & - + 2.000_r8*rxt(k,167)+2.000_r8*rxt(k,270))*y(k,114) - mat(k,724) = mat(k,724) + rxt(k,298)*y(k,47) + rxt(k,188)*y(k,100) + ( & - + rxt(k,192)+rxt(k,264))*y(k,102) + (rxt(k,171)+rxt(k,266)) & - *y(k,104) - mat(k,529) = rxt(k,293)*y(k,56) - mat(k,569) = mat(k,569) + rxt(k,297)*y(k,56) - mat(k,511) = 2.000_r8*rxt(k,185)*y(k,100) + (2.000_r8*rxt(k,146) & - +2.000_r8*rxt(k,269))*y(k,102) + (2.000_r8*rxt(k,167) & - +2.000_r8*rxt(k,270))*y(k,104) + rxt(k,238)*y(k,115) & - + rxt(k,220)*y(k,116) + rxt(k,202)*y(k,119) + rxt(k,255) & + mat(k,906) = rxt(k,454)*y(k,25) + mat(k,1461) = rxt(k,187)*y(k,90) + rxt(k,198)*y(k,114) + mat(k,1678) = (rxt(k,181)+2.000_r8*rxt(k,267))*y(k,90) + rxt(k,163)*y(k,114) + mat(k,1418) = (rxt(k,169)+2.000_r8*rxt(k,268))*y(k,90) + rxt(k,180)*y(k,114) + mat(k,571) = rxt(k,299)*y(k,51) + rxt(k,198)*y(k,101) + rxt(k,163)*y(k,103) & + + rxt(k,180)*y(k,105) + rxt(k,251)*y(k,116) + rxt(k,233) & + *y(k,117) + rxt(k,216)*y(k,120) + rxt(k,157)*y(k,126) + mat(k,1153) = rxt(k,240)*y(k,90) + rxt(k,251)*y(k,114) + mat(k,1196) = rxt(k,222)*y(k,90) + rxt(k,233)*y(k,114) + mat(k,1339) = rxt(k,205)*y(k,90) + rxt(k,216)*y(k,114) + mat(k,1587) = rxt(k,257)*y(k,90) + rxt(k,157)*y(k,114) + mat(k,990) = mat(k,990) + rxt(k,469)*y(k,28) + mat(k,410) = rxt(k,507)*y(k,39) + mat(k,337) = rxt(k,507)*y(k,23) + rxt(k,508)*y(k,41) + rxt(k,510)*y(k,51) & + + rxt(k,509)*y(k,137) + mat(k,640) = rxt(k,508)*y(k,39) + mat(k,1210) = rxt(k,510)*y(k,39) + mat(k,2032) = rxt(k,509)*y(k,39) + mat(k,1231) = -(rxt(k,109)*y(k,88) + rxt(k,124)*y(k,92) + rxt(k,290)*y(k,109) & + + rxt(k,295)*y(k,113) + rxt(k,299)*y(k,114) + rxt(k,300) & + *y(k,111) + rxt(k,319)*y(k,125) + rxt(k,357)*y(k,133) + rxt(k,447) & + *y(k,131) + rxt(k,510)*y(k,39)) + mat(k,814) = -rxt(k,109)*y(k,51) + mat(k,1016) = -rxt(k,124)*y(k,51) + mat(k,929) = -rxt(k,290)*y(k,51) + mat(k,693) = -rxt(k,295)*y(k,51) + mat(k,566) = -rxt(k,299)*y(k,51) + mat(k,869) = -rxt(k,300)*y(k,51) + mat(k,1536) = -rxt(k,319)*y(k,51) + mat(k,1877) = -rxt(k,357)*y(k,51) + mat(k,985) = -rxt(k,447)*y(k,51) + mat(k,344) = -rxt(k,510)*y(k,51) + mat(k,741) = rxt(k,530)*y(k,64) + mat(k,359) = (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,49) + mat(k,127) = rxt(k,541)*y(k,64) + mat(k,1500) = (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,29) + rxt(k,298) & + *y(k,111) + mat(k,403) = rxt(k,142)*y(k,103) + rxt(k,145)*y(k,105) + rxt(k,293)*y(k,112) & + + rxt(k,297)*y(k,113) + mat(k,1629) = rxt(k,446)*y(k,131) + mat(k,1099) = rxt(k,530)*y(k,17) + rxt(k,541)*y(k,35) + mat(k,1455) = rxt(k,188)*y(k,111) + 2.000_r8*rxt(k,185)*y(k,115) + mat(k,105) = rxt(k,140)*y(k,137) + mat(k,1672) = rxt(k,142)*y(k,58) + (rxt(k,192)+rxt(k,264))*y(k,111) + ( & + + 2.000_r8*rxt(k,146)+2.000_r8*rxt(k,269))*y(k,115) + mat(k,109) = rxt(k,143)*y(k,137) + mat(k,1412) = rxt(k,145)*y(k,58) + (rxt(k,171)+rxt(k,266))*y(k,111) + ( & + + 2.000_r8*rxt(k,167)+2.000_r8*rxt(k,270))*y(k,115) + mat(k,869) = mat(k,869) + rxt(k,298)*y(k,49) + rxt(k,188)*y(k,101) + ( & + + rxt(k,192)+rxt(k,264))*y(k,103) + (rxt(k,171)+rxt(k,266)) & + *y(k,105) + mat(k,628) = rxt(k,293)*y(k,58) + mat(k,693) = mat(k,693) + rxt(k,297)*y(k,58) + mat(k,611) = 2.000_r8*rxt(k,185)*y(k,101) + (2.000_r8*rxt(k,146) & + +2.000_r8*rxt(k,269))*y(k,103) + (2.000_r8*rxt(k,167) & + +2.000_r8*rxt(k,270))*y(k,105) + rxt(k,238)*y(k,116) & + + rxt(k,220)*y(k,117) + rxt(k,202)*y(k,120) + rxt(k,255) & *y(k,126) - mat(k,909) = rxt(k,238)*y(k,114) - mat(k,951) = rxt(k,220)*y(k,114) - mat(k,1080) = rxt(k,202)*y(k,114) - mat(k,1371) = rxt(k,255)*y(k,114) - mat(k,803) = mat(k,803) + rxt(k,446)*y(k,61) - mat(k,1843) = rxt(k,140)*y(k,101) + rxt(k,143)*y(k,103) - mat(k,101) = -(rxt(k,423)*y(k,131)) - mat(k,774) = -rxt(k,423)*y(k,50) - mat(k,965) = rxt(k,444)*y(k,98) - mat(k,735) = rxt(k,444)*y(k,61) - mat(k,207) = -(rxt(k,501)*y(k,67) + (rxt(k,571) + rxt(k,576)) * y(k,47)) - mat(k,1395) = -rxt(k,501)*y(k,51) - mat(k,1136) = -(rxt(k,571) + rxt(k,576)) * y(k,51) - mat(k,580) = rxt(k,493)*y(k,98) - mat(k,738) = rxt(k,493)*y(k,4) - mat(k,231) = -(rxt(k,472)*y(k,86) + rxt(k,473)*y(k,67) + rxt(k,474)*y(k,131) & - + (rxt(k,564) + rxt(k,570) + rxt(k,575)) * y(k,47)) - mat(k,1447) = -rxt(k,472)*y(k,52) - mat(k,1398) = -rxt(k,473)*y(k,52) - mat(k,781) = -rxt(k,474)*y(k,52) - mat(k,1137) = -(rxt(k,564) + rxt(k,570) + rxt(k,575)) * y(k,52) - mat(k,1724) = rxt(k,461)*y(k,98) - mat(k,276) = rxt(k,466)*y(k,131) - mat(k,739) = rxt(k,461)*y(k,26) - mat(k,781) = mat(k,781) + rxt(k,466)*y(k,27) - mat(k,175) = -(rxt(k,340)*y(k,131)) - mat(k,778) = -rxt(k,340)*y(k,53) - mat(k,1135) = rxt(k,289)*y(k,108) - mat(k,1268) = rxt(k,290)*y(k,108) - mat(k,1486) = rxt(k,349)*y(k,131) - mat(k,847) = rxt(k,289)*y(k,47) + rxt(k,290)*y(k,49) - mat(k,90) = rxt(k,305)*y(k,137) - mat(k,778) = mat(k,778) + rxt(k,349)*y(k,60) - mat(k,1809) = rxt(k,305)*y(k,117) - mat(k,311) = -(rxt(k,426)*y(k,60) + (rxt(k,427) + rxt(k,428) + rxt(k,429) & - ) * y(k,61) + rxt(k,430)*y(k,68) + rxt(k,438)*y(k,131) + rxt(k,592) & + mat(k,1147) = rxt(k,238)*y(k,115) + mat(k,1190) = rxt(k,220)*y(k,115) + mat(k,1333) = rxt(k,202)*y(k,115) + mat(k,1581) = rxt(k,255)*y(k,115) + mat(k,985) = mat(k,985) + rxt(k,446)*y(k,63) + mat(k,2068) = rxt(k,140)*y(k,102) + rxt(k,143)*y(k,104) + mat(k,183) = -(rxt(k,423)*y(k,131)) + mat(k,959) = -rxt(k,423)*y(k,52) + mat(k,1602) = rxt(k,444)*y(k,99) + mat(k,885) = rxt(k,444)*y(k,63) + mat(k,306) = -(rxt(k,501)*y(k,69) + (rxt(k,570) + rxt(k,575)) * y(k,49)) + mat(k,1262) = -rxt(k,501)*y(k,53) + mat(k,1478) = -(rxt(k,570) + rxt(k,575)) * y(k,53) + mat(k,708) = rxt(k,493)*y(k,99) + mat(k,888) = rxt(k,493)*y(k,5) + mat(k,322) = -(rxt(k,472)*y(k,25) + rxt(k,473)*y(k,69) + rxt(k,474)*y(k,131) & + + (rxt(k,563) + rxt(k,569) + rxt(k,574)) * y(k,49)) + mat(k,1987) = -rxt(k,472)*y(k,54) + mat(k,1264) = -rxt(k,473)*y(k,54) + mat(k,966) = -rxt(k,474)*y(k,54) + mat(k,1479) = -(rxt(k,563) + rxt(k,569) + rxt(k,574)) * y(k,54) + mat(k,1738) = rxt(k,461)*y(k,99) + mat(k,355) = rxt(k,466)*y(k,131) + mat(k,889) = rxt(k,461)*y(k,28) + mat(k,966) = mat(k,966) + rxt(k,466)*y(k,29) + mat(k,275) = -(rxt(k,340)*y(k,131)) + mat(k,964) = -rxt(k,340)*y(k,55) + mat(k,1477) = rxt(k,289)*y(k,109) + mat(k,1211) = rxt(k,290)*y(k,109) + mat(k,1692) = rxt(k,349)*y(k,131) + mat(k,919) = rxt(k,289)*y(k,49) + rxt(k,290)*y(k,51) + mat(k,171) = rxt(k,305)*y(k,137) + mat(k,964) = mat(k,964) + rxt(k,349)*y(k,62) + mat(k,2038) = rxt(k,305)*y(k,118) + mat(k,443) = -(rxt(k,426)*y(k,62) + (rxt(k,427) + rxt(k,428) + rxt(k,429) & + ) * y(k,63) + rxt(k,430)*y(k,71) + rxt(k,438)*y(k,131) + rxt(k,591) & *y(k,126)) - mat(k,1488) = -rxt(k,426)*y(k,54) - mat(k,971) = -(rxt(k,427) + rxt(k,428) + rxt(k,429)) * y(k,54) - mat(k,1229) = -rxt(k,430)*y(k,54) - mat(k,785) = -rxt(k,438)*y(k,54) - mat(k,1342) = -rxt(k,592)*y(k,54) - mat(k,1405) = rxt(k,424)*y(k,106) + rxt(k,589)*y(k,121) - mat(k,1229) = mat(k,1229) + rxt(k,590)*y(k,121) - mat(k,1541) = 1.100_r8*rxt(k,585)*y(k,107) + .200_r8*rxt(k,583)*y(k,115) - mat(k,218) = rxt(k,424)*y(k,67) - mat(k,156) = 1.100_r8*rxt(k,585)*y(k,95) - mat(k,881) = .200_r8*rxt(k,583)*y(k,95) - mat(k,225) = rxt(k,589)*y(k,67) + rxt(k,590)*y(k,68) - mat(k,297) = -(rxt(k,142)*y(k,102) + rxt(k,145)*y(k,104) + rxt(k,293) & - *y(k,111) + rxt(k,297)*y(k,112)) - mat(k,1679) = -rxt(k,142)*y(k,56) - mat(k,1570) = -rxt(k,145)*y(k,56) - mat(k,517) = -rxt(k,293)*y(k,56) - mat(k,557) = -rxt(k,297)*y(k,56) - mat(k,970) = rxt(k,445)*y(k,62) - mat(k,1097) = rxt(k,445)*y(k,61) - mat(k,1518) = -((rxt(k,111) + rxt(k,112)) * y(k,90) + (rxt(k,122) + rxt(k,123) & - ) * y(k,93) + rxt(k,136)*y(k,133) + (rxt(k,272) + rxt(k,279) & - ) * y(k,128) + rxt(k,280)*y(k,91) + rxt(k,349)*y(k,131) & - + rxt(k,426)*y(k,54) + rxt(k,435)*y(k,62) + rxt(k,439)*y(k,98) & - + rxt(k,440)*y(k,69) + rxt(k,441)*y(k,67) + rxt(k,462)*y(k,26) & - + rxt(k,494)*y(k,4) + rxt(k,534)*y(k,20) + rxt(k,594)*y(k,126)) - mat(k,294) = -(rxt(k,111) + rxt(k,112)) * y(k,60) - mat(k,552) = -(rxt(k,122) + rxt(k,123)) * y(k,60) - mat(k,1669) = -rxt(k,136)*y(k,60) - mat(k,447) = -(rxt(k,272) + rxt(k,279)) * y(k,60) - mat(k,838) = -rxt(k,280)*y(k,60) - mat(k,808) = -rxt(k,349)*y(k,60) - mat(k,320) = -rxt(k,426)*y(k,60) - mat(k,1124) = -rxt(k,435)*y(k,60) - mat(k,761) = -rxt(k,439)*y(k,60) - mat(k,1209) = -rxt(k,440)*y(k,60) - mat(k,1435) = -rxt(k,441)*y(k,60) - mat(k,1755) = -rxt(k,462)*y(k,60) - mat(k,597) = -rxt(k,494)*y(k,60) - mat(k,331) = -rxt(k,534)*y(k,60) - mat(k,1376) = -rxt(k,594)*y(k,60) - mat(k,1790) = rxt(k,287)*y(k,108) + rxt(k,309)*y(k,119) - mat(k,320) = mat(k,320) + 2.000_r8*rxt(k,428)*y(k,61) + rxt(k,430)*y(k,68) & - + rxt(k,438)*y(k,131) - mat(k,1002) = 2.000_r8*rxt(k,428)*y(k,54) + rxt(k,431)*y(k,67) + rxt(k,549) & - *y(k,76) + rxt(k,291)*y(k,108) - mat(k,1435) = mat(k,1435) + rxt(k,431)*y(k,61) - mat(k,1258) = rxt(k,430)*y(k,54) + rxt(k,425)*y(k,106) - mat(k,389) = rxt(k,549)*y(k,61) - mat(k,703) = rxt(k,248)*y(k,115) + rxt(k,230)*y(k,116) + rxt(k,212)*y(k,119) - mat(k,419) = rxt(k,252)*y(k,115) + rxt(k,234)*y(k,116) + rxt(k,217)*y(k,119) - mat(k,403) = rxt(k,240)*y(k,115) + rxt(k,222)*y(k,116) + rxt(k,205)*y(k,119) - mat(k,838) = mat(k,838) + rxt(k,239)*y(k,115) + rxt(k,221)*y(k,116) & - + rxt(k,204)*y(k,119) - mat(k,371) = rxt(k,246)*y(k,115) + rxt(k,229)*y(k,116) + rxt(k,211)*y(k,119) - mat(k,552) = mat(k,552) + rxt(k,249)*y(k,115) + rxt(k,231)*y(k,116) & - + rxt(k,213)*y(k,119) - mat(k,679) = rxt(k,244)*y(k,115) + rxt(k,227)*y(k,116) + rxt(k,209)*y(k,119) - mat(k,1560) = rxt(k,303)*y(k,116) + rxt(k,304)*y(k,117) + rxt(k,306)*y(k,118) & - + rxt(k,308)*y(k,119) + rxt(k,384)*y(k,120) - mat(k,343) = rxt(k,242)*y(k,115) + rxt(k,224)*y(k,116) + rxt(k,207)*y(k,119) - mat(k,222) = rxt(k,425)*y(k,68) - mat(k,867) = rxt(k,287)*y(k,38) + rxt(k,291)*y(k,61) + rxt(k,254)*y(k,115) & - + rxt(k,237)*y(k,116) + rxt(k,219)*y(k,119) - mat(k,433) = rxt(k,250)*y(k,115) + rxt(k,232)*y(k,116) + rxt(k,215)*y(k,119) - mat(k,728) = rxt(k,241)*y(k,115) + rxt(k,223)*y(k,116) + rxt(k,206)*y(k,119) - mat(k,532) = rxt(k,253)*y(k,115) + rxt(k,235)*y(k,116) + rxt(k,218)*y(k,119) - mat(k,572) = rxt(k,245)*y(k,115) + rxt(k,228)*y(k,116) + rxt(k,210)*y(k,119) - mat(k,476) = rxt(k,251)*y(k,115) + rxt(k,233)*y(k,116) + rxt(k,216)*y(k,119) - mat(k,513) = rxt(k,238)*y(k,115) + rxt(k,220)*y(k,116) + rxt(k,202)*y(k,119) - mat(k,914) = rxt(k,248)*y(k,87) + rxt(k,252)*y(k,88) + rxt(k,240)*y(k,89) & - + rxt(k,239)*y(k,91) + rxt(k,246)*y(k,92) + rxt(k,249)*y(k,93) & - + rxt(k,244)*y(k,94) + rxt(k,242)*y(k,97) + rxt(k,254)*y(k,108) & - + rxt(k,250)*y(k,109) + rxt(k,241)*y(k,110) + rxt(k,253) & - *y(k,111) + rxt(k,245)*y(k,112) + rxt(k,251)*y(k,113) & - + rxt(k,238)*y(k,114) + rxt(k,243)*y(k,125) - mat(k,956) = rxt(k,230)*y(k,87) + rxt(k,234)*y(k,88) + rxt(k,222)*y(k,89) & - + rxt(k,221)*y(k,91) + rxt(k,229)*y(k,92) + rxt(k,231)*y(k,93) & - + rxt(k,227)*y(k,94) + rxt(k,303)*y(k,95) + rxt(k,224)*y(k,97) & - + rxt(k,237)*y(k,108) + rxt(k,232)*y(k,109) + rxt(k,223) & - *y(k,110) + rxt(k,235)*y(k,111) + rxt(k,228)*y(k,112) & - + rxt(k,233)*y(k,113) + rxt(k,220)*y(k,114) + rxt(k,226) & - *y(k,125) - mat(k,92) = rxt(k,304)*y(k,95) - mat(k,118) = rxt(k,306)*y(k,95) - mat(k,1085) = rxt(k,309)*y(k,38) + rxt(k,212)*y(k,87) + rxt(k,217)*y(k,88) & - + rxt(k,205)*y(k,89) + rxt(k,204)*y(k,91) + rxt(k,211)*y(k,92) & - + rxt(k,213)*y(k,93) + rxt(k,209)*y(k,94) + rxt(k,308)*y(k,95) & - + rxt(k,207)*y(k,97) + rxt(k,219)*y(k,108) + rxt(k,215)*y(k,109) & - + rxt(k,206)*y(k,110) + rxt(k,218)*y(k,111) + rxt(k,210) & - *y(k,112) + rxt(k,216)*y(k,113) + rxt(k,202)*y(k,114) & - + rxt(k,208)*y(k,125) - mat(k,112) = rxt(k,384)*y(k,95) - mat(k,1332) = rxt(k,243)*y(k,115) + rxt(k,226)*y(k,116) + rxt(k,208)*y(k,119) - mat(k,808) = mat(k,808) + rxt(k,438)*y(k,54) + mat(k,1695) = -rxt(k,426)*y(k,56) + mat(k,1608) = -(rxt(k,427) + rxt(k,428) + rxt(k,429)) * y(k,56) + mat(k,1790) = -rxt(k,430)*y(k,56) + mat(k,973) = -rxt(k,438)*y(k,56) + mat(k,1557) = -rxt(k,591)*y(k,56) + mat(k,1271) = rxt(k,424)*y(k,107) + rxt(k,588)*y(k,122) + mat(k,1790) = mat(k,1790) + rxt(k,589)*y(k,122) + mat(k,1050) = 1.100_r8*rxt(k,584)*y(k,108) + .200_r8*rxt(k,582)*y(k,116) + mat(k,300) = rxt(k,424)*y(k,69) + mat(k,230) = 1.100_r8*rxt(k,584)*y(k,96) + mat(k,1124) = .200_r8*rxt(k,582)*y(k,96) + mat(k,316) = rxt(k,588)*y(k,69) + rxt(k,589)*y(k,71) + mat(k,95) = -((rxt(k,442) + rxt(k,443)) * y(k,70)) + mat(k,768) = -(rxt(k,442) + rxt(k,443)) * y(k,57) + mat(k,440) = rxt(k,427)*y(k,63) + mat(k,1601) = rxt(k,427)*y(k,56) + mat(k,398) = -(rxt(k,142)*y(k,103) + rxt(k,145)*y(k,105) + rxt(k,293) & + *y(k,112) + rxt(k,297)*y(k,113)) + mat(k,1650) = -rxt(k,142)*y(k,58) + mat(k,1390) = -rxt(k,145)*y(k,58) + mat(k,620) = -rxt(k,293)*y(k,58) + mat(k,685) = -rxt(k,297)*y(k,58) + mat(k,1607) = rxt(k,445)*y(k,64) + mat(k,1082) = rxt(k,445)*y(k,63) end do - end subroutine nlnmat02 - subroutine nlnmat03( avec_len, mat, y, rxt ) + end subroutine nlnmat03 + subroutine nlnmat04( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -515,326 +726,526 @@ subroutine nlnmat03( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,990) = -(rxt(k,110)*y(k,87) + (rxt(k,120) + rxt(k,121)) * y(k,93) & - + (rxt(k,277) + rxt(k,278)) * y(k,128) + rxt(k,281)*y(k,91) & - + rxt(k,291)*y(k,108) + rxt(k,320)*y(k,125) + rxt(k,346) & + mat(k,1725) = -((rxt(k,111) + rxt(k,112)) * y(k,91) + (rxt(k,122) + rxt(k,123) & + ) * y(k,94) + rxt(k,136)*y(k,133) + (rxt(k,272) + rxt(k,279) & + ) * y(k,128) + rxt(k,280)*y(k,92) + rxt(k,349)*y(k,131) & + + rxt(k,426)*y(k,56) + rxt(k,435)*y(k,64) + rxt(k,439)*y(k,99) & + + rxt(k,440)*y(k,72) + rxt(k,441)*y(k,69) + rxt(k,462)*y(k,28) & + + rxt(k,494)*y(k,5) + rxt(k,534)*y(k,21) + rxt(k,593)*y(k,126)) + mat(k,371) = -(rxt(k,111) + rxt(k,112)) * y(k,62) + mat(k,681) = -(rxt(k,122) + rxt(k,123)) * y(k,62) + mat(k,1888) = -rxt(k,136)*y(k,62) + mat(k,600) = -(rxt(k,272) + rxt(k,279)) * y(k,62) + mat(k,1027) = -rxt(k,280)*y(k,62) + mat(k,994) = -rxt(k,349)*y(k,62) + mat(k,453) = -rxt(k,426)*y(k,62) + mat(k,1110) = -rxt(k,435)*y(k,62) + mat(k,910) = -rxt(k,439)*y(k,62) + mat(k,1929) = -rxt(k,440)*y(k,62) + mat(k,1302) = -rxt(k,441)*y(k,62) + mat(k,1770) = -rxt(k,462)*y(k,62) + mat(k,723) = -rxt(k,494)*y(k,62) + mat(k,435) = -rxt(k,534)*y(k,62) + mat(k,1592) = -rxt(k,593)*y(k,62) + mat(k,1380) = rxt(k,287)*y(k,109) + rxt(k,309)*y(k,120) + mat(k,453) = mat(k,453) + 2.000_r8*rxt(k,428)*y(k,63) + rxt(k,430)*y(k,71) & + + rxt(k,438)*y(k,131) + mat(k,97) = 2.000_r8*rxt(k,442)*y(k,70) + mat(k,1640) = 2.000_r8*rxt(k,428)*y(k,56) + rxt(k,431)*y(k,69) + rxt(k,551) & + *y(k,79) + rxt(k,291)*y(k,109) + mat(k,1302) = mat(k,1302) + rxt(k,431)*y(k,63) + mat(k,797) = 2.000_r8*rxt(k,442)*y(k,57) + mat(k,1819) = rxt(k,430)*y(k,56) + rxt(k,425)*y(k,107) + mat(k,495) = rxt(k,551)*y(k,63) + mat(k,823) = rxt(k,248)*y(k,116) + rxt(k,230)*y(k,117) + rxt(k,212)*y(k,120) + mat(k,543) = rxt(k,252)*y(k,116) + rxt(k,234)*y(k,117) + rxt(k,217)*y(k,120) + mat(k,527) = rxt(k,240)*y(k,116) + rxt(k,222)*y(k,117) + rxt(k,205)*y(k,120) + mat(k,1027) = mat(k,1027) + rxt(k,239)*y(k,116) + rxt(k,221)*y(k,117) & + + rxt(k,204)*y(k,120) + mat(k,512) = rxt(k,246)*y(k,116) + rxt(k,229)*y(k,117) + rxt(k,211)*y(k,120) + mat(k,681) = mat(k,681) + rxt(k,249)*y(k,116) + rxt(k,231)*y(k,117) & + + rxt(k,213)*y(k,120) + mat(k,850) = rxt(k,244)*y(k,116) + rxt(k,227)*y(k,117) + rxt(k,209)*y(k,120) + mat(k,1070) = rxt(k,303)*y(k,117) + rxt(k,304)*y(k,118) + rxt(k,306)*y(k,119) & + + rxt(k,308)*y(k,120) + rxt(k,384)*y(k,121) + mat(k,480) = rxt(k,242)*y(k,116) + rxt(k,224)*y(k,117) + rxt(k,207)*y(k,120) + mat(k,303) = rxt(k,425)*y(k,71) + mat(k,939) = rxt(k,287)*y(k,40) + rxt(k,291)*y(k,63) + rxt(k,254)*y(k,116) & + + rxt(k,237)*y(k,117) + rxt(k,219)*y(k,120) + mat(k,558) = rxt(k,250)*y(k,116) + rxt(k,232)*y(k,117) + rxt(k,215)*y(k,120) + mat(k,879) = rxt(k,241)*y(k,116) + rxt(k,223)*y(k,117) + rxt(k,206)*y(k,120) + mat(k,637) = rxt(k,253)*y(k,116) + rxt(k,235)*y(k,117) + rxt(k,218)*y(k,120) + mat(k,702) = rxt(k,245)*y(k,116) + rxt(k,228)*y(k,117) + rxt(k,210)*y(k,120) + mat(k,574) = rxt(k,251)*y(k,116) + rxt(k,233)*y(k,117) + rxt(k,216)*y(k,120) + mat(k,617) = rxt(k,238)*y(k,116) + rxt(k,220)*y(k,117) + rxt(k,202)*y(k,120) + mat(k,1158) = rxt(k,248)*y(k,88) + rxt(k,252)*y(k,89) + rxt(k,240)*y(k,90) & + + rxt(k,239)*y(k,92) + rxt(k,246)*y(k,93) + rxt(k,249)*y(k,94) & + + rxt(k,244)*y(k,95) + rxt(k,242)*y(k,98) + rxt(k,254)*y(k,109) & + + rxt(k,250)*y(k,110) + rxt(k,241)*y(k,111) + rxt(k,253) & + *y(k,112) + rxt(k,245)*y(k,113) + rxt(k,251)*y(k,114) & + + rxt(k,238)*y(k,115) + rxt(k,243)*y(k,125) + mat(k,1201) = rxt(k,230)*y(k,88) + rxt(k,234)*y(k,89) + rxt(k,222)*y(k,90) & + + rxt(k,221)*y(k,92) + rxt(k,229)*y(k,93) + rxt(k,231)*y(k,94) & + + rxt(k,227)*y(k,95) + rxt(k,303)*y(k,96) + rxt(k,224)*y(k,98) & + + rxt(k,237)*y(k,109) + rxt(k,232)*y(k,110) + rxt(k,223) & + *y(k,111) + rxt(k,235)*y(k,112) + rxt(k,228)*y(k,113) & + + rxt(k,233)*y(k,114) + rxt(k,220)*y(k,115) + rxt(k,226) & + *y(k,125) + mat(k,174) = rxt(k,304)*y(k,96) + mat(k,265) = rxt(k,306)*y(k,96) + mat(k,1344) = rxt(k,309)*y(k,40) + rxt(k,212)*y(k,88) + rxt(k,217)*y(k,89) & + + rxt(k,205)*y(k,90) + rxt(k,204)*y(k,92) + rxt(k,211)*y(k,93) & + + rxt(k,213)*y(k,94) + rxt(k,209)*y(k,95) + rxt(k,308)*y(k,96) & + + rxt(k,207)*y(k,98) + rxt(k,219)*y(k,109) + rxt(k,215)*y(k,110) & + + rxt(k,206)*y(k,111) + rxt(k,218)*y(k,112) + rxt(k,210) & + *y(k,113) + rxt(k,216)*y(k,114) + rxt(k,202)*y(k,115) & + + rxt(k,208)*y(k,125) + mat(k,258) = rxt(k,384)*y(k,96) + mat(k,1547) = rxt(k,243)*y(k,116) + rxt(k,226)*y(k,117) + rxt(k,208)*y(k,120) + mat(k,994) = mat(k,994) + rxt(k,438)*y(k,56) + mat(k,1638) = -(rxt(k,110)*y(k,88) + (rxt(k,120) + rxt(k,121)) * y(k,94) & + + (rxt(k,277) + rxt(k,278)) * y(k,128) + rxt(k,281)*y(k,92) & + + rxt(k,291)*y(k,109) + rxt(k,320)*y(k,125) + rxt(k,346) & *y(k,132) + rxt(k,359)*y(k,133) + (rxt(k,427) + rxt(k,428) & - + rxt(k,429)) * y(k,54) + (rxt(k,431) + rxt(k,433)) * y(k,67) & - + rxt(k,432)*y(k,69) + rxt(k,444)*y(k,98) + rxt(k,445)*y(k,62) & - + rxt(k,446)*y(k,131) + rxt(k,464)*y(k,26) + rxt(k,495)*y(k,4) & - + rxt(k,549)*y(k,76)) - mat(k,695) = -rxt(k,110)*y(k,61) - mat(k,546) = -(rxt(k,120) + rxt(k,121)) * y(k,61) - mat(k,442) = -(rxt(k,277) + rxt(k,278)) * y(k,61) - mat(k,826) = -rxt(k,281)*y(k,61) - mat(k,855) = -rxt(k,291)*y(k,61) - mat(k,1320) = -rxt(k,320)*y(k,61) - mat(k,1622) = -rxt(k,346)*y(k,61) - mat(k,1657) = -rxt(k,359)*y(k,61) - mat(k,316) = -(rxt(k,427) + rxt(k,428) + rxt(k,429)) * y(k,61) - mat(k,1423) = -(rxt(k,431) + rxt(k,433)) * y(k,61) - mat(k,1197) = -rxt(k,432)*y(k,61) - mat(k,749) = -rxt(k,444)*y(k,61) - mat(k,1112) = -rxt(k,445)*y(k,61) - mat(k,796) = -rxt(k,446)*y(k,61) - mat(k,1743) = -rxt(k,464)*y(k,61) - mat(k,589) = -rxt(k,495)*y(k,61) - mat(k,384) = -rxt(k,549)*y(k,61) - mat(k,589) = mat(k,589) + rxt(k,494)*y(k,60) - mat(k,328) = rxt(k,534)*y(k,60) - mat(k,1743) = mat(k,1743) + rxt(k,462)*y(k,60) - mat(k,104) = rxt(k,423)*y(k,131) - mat(k,177) = rxt(k,340)*y(k,131) - mat(k,1506) = rxt(k,494)*y(k,4) + rxt(k,534)*y(k,20) + rxt(k,462)*y(k,26) & - + 2.000_r8*rxt(k,435)*y(k,62) + rxt(k,441)*y(k,67) + rxt(k,440) & - *y(k,69) + rxt(k,112)*y(k,90) + rxt(k,439)*y(k,98) + rxt(k,136) & + + rxt(k,429)) * y(k,56) + (rxt(k,431) + rxt(k,433)) * y(k,69) & + + rxt(k,432)*y(k,72) + rxt(k,444)*y(k,99) + rxt(k,445)*y(k,64) & + + rxt(k,446)*y(k,131) + rxt(k,464)*y(k,28) + rxt(k,495)*y(k,5) & + + rxt(k,551)*y(k,79)) + mat(k,821) = -rxt(k,110)*y(k,63) + mat(k,679) = -(rxt(k,120) + rxt(k,121)) * y(k,63) + mat(k,599) = -(rxt(k,277) + rxt(k,278)) * y(k,63) + mat(k,1025) = -rxt(k,281)*y(k,63) + mat(k,937) = -rxt(k,291)*y(k,63) + mat(k,1545) = -rxt(k,320)*y(k,63) + mat(k,1850) = -rxt(k,346)*y(k,63) + mat(k,1886) = -rxt(k,359)*y(k,63) + mat(k,452) = -(rxt(k,427) + rxt(k,428) + rxt(k,429)) * y(k,63) + mat(k,1300) = -(rxt(k,431) + rxt(k,433)) * y(k,63) + mat(k,1927) = -rxt(k,432)*y(k,63) + mat(k,909) = -rxt(k,444)*y(k,63) + mat(k,1108) = -rxt(k,445)*y(k,63) + mat(k,993) = -rxt(k,446)*y(k,63) + mat(k,1768) = -rxt(k,464)*y(k,63) + mat(k,722) = -rxt(k,495)*y(k,63) + mat(k,494) = -rxt(k,551)*y(k,63) + mat(k,722) = mat(k,722) + rxt(k,494)*y(k,62) + mat(k,434) = rxt(k,534)*y(k,62) + mat(k,2017) = rxt(k,285)*y(k,109) + mat(k,1768) = mat(k,1768) + rxt(k,462)*y(k,62) + mat(k,187) = rxt(k,423)*y(k,131) + mat(k,277) = rxt(k,340)*y(k,131) + mat(k,1723) = rxt(k,494)*y(k,5) + rxt(k,534)*y(k,21) + rxt(k,462)*y(k,28) & + + 2.000_r8*rxt(k,435)*y(k,64) + rxt(k,441)*y(k,69) + rxt(k,440) & + *y(k,72) + rxt(k,112)*y(k,91) + rxt(k,439)*y(k,99) + rxt(k,136) & *y(k,133) - mat(k,1112) = mat(k,1112) + 2.000_r8*rxt(k,435)*y(k,60) + rxt(k,436)*y(k,67) & - + rxt(k,434)*y(k,98) + rxt(k,437)*y(k,131) - mat(k,1423) = mat(k,1423) + rxt(k,441)*y(k,60) + rxt(k,436)*y(k,62) - mat(k,1197) = mat(k,1197) + rxt(k,440)*y(k,60) - mat(k,1465) = rxt(k,285)*y(k,108) - mat(k,290) = rxt(k,112)*y(k,60) - mat(k,749) = mat(k,749) + rxt(k,439)*y(k,60) + rxt(k,434)*y(k,62) - mat(k,1032) = rxt(k,201)*y(k,108) + rxt(k,197)*y(k,109) - mat(k,1699) = rxt(k,166)*y(k,108) + rxt(k,162)*y(k,109) - mat(k,1590) = rxt(k,184)*y(k,108) + rxt(k,179)*y(k,109) - mat(k,855) = mat(k,855) + rxt(k,285)*y(k,86) + rxt(k,201)*y(k,100) & - + rxt(k,166)*y(k,102) + rxt(k,184)*y(k,104) + rxt(k,254) & - *y(k,115) + rxt(k,237)*y(k,116) + rxt(k,219)*y(k,119) & + mat(k,1108) = mat(k,1108) + 2.000_r8*rxt(k,435)*y(k,62) + rxt(k,436)*y(k,69) & + + rxt(k,434)*y(k,99) + rxt(k,437)*y(k,131) + mat(k,1300) = mat(k,1300) + rxt(k,441)*y(k,62) + rxt(k,436)*y(k,64) + mat(k,1927) = mat(k,1927) + rxt(k,440)*y(k,62) + mat(k,370) = rxt(k,112)*y(k,62) + mat(k,909) = mat(k,909) + rxt(k,439)*y(k,62) + rxt(k,434)*y(k,64) + mat(k,1464) = rxt(k,201)*y(k,109) + rxt(k,197)*y(k,110) + mat(k,1681) = rxt(k,166)*y(k,109) + rxt(k,162)*y(k,110) + mat(k,1421) = rxt(k,184)*y(k,109) + rxt(k,179)*y(k,110) + mat(k,937) = mat(k,937) + rxt(k,285)*y(k,25) + rxt(k,201)*y(k,101) & + + rxt(k,166)*y(k,103) + rxt(k,184)*y(k,105) + rxt(k,254) & + *y(k,116) + rxt(k,237)*y(k,117) + rxt(k,219)*y(k,120) & + rxt(k,161)*y(k,126) - mat(k,428) = rxt(k,197)*y(k,100) + rxt(k,162)*y(k,102) + rxt(k,179)*y(k,104) & - + rxt(k,250)*y(k,115) + rxt(k,232)*y(k,116) + rxt(k,215) & - *y(k,119) + rxt(k,156)*y(k,126) - mat(k,902) = rxt(k,254)*y(k,108) + rxt(k,250)*y(k,109) - mat(k,944) = rxt(k,237)*y(k,108) + rxt(k,232)*y(k,109) - mat(k,1073) = rxt(k,219)*y(k,108) + rxt(k,215)*y(k,109) + rxt(k,311)*y(k,131) - mat(k,1364) = rxt(k,161)*y(k,108) + rxt(k,156)*y(k,109) - mat(k,796) = mat(k,796) + rxt(k,423)*y(k,50) + rxt(k,340)*y(k,53) & - + rxt(k,437)*y(k,62) + rxt(k,311)*y(k,119) - mat(k,1657) = mat(k,1657) + rxt(k,136)*y(k,60) - mat(k,1115) = -(rxt(k,434)*y(k,98) + rxt(k,435)*y(k,60) + rxt(k,436)*y(k,67) & - + rxt(k,437)*y(k,131) + rxt(k,445)*y(k,61) + rxt(k,530)*y(k,16) & - + rxt(k,556)*y(k,33)) - mat(k,752) = -rxt(k,434)*y(k,62) - mat(k,1509) = -rxt(k,435)*y(k,62) - mat(k,1426) = -rxt(k,436)*y(k,62) - mat(k,799) = -rxt(k,437)*y(k,62) - mat(k,993) = -rxt(k,445)*y(k,62) - mat(k,611) = -rxt(k,530)*y(k,62) - mat(k,62) = -rxt(k,556)*y(k,62) - mat(k,143) = rxt(k,496)*y(k,67) - mat(k,1746) = rxt(k,286)*y(k,108) - mat(k,280) = rxt(k,465)*y(k,67) + rxt(k,463)*y(k,86) + rxt(k,466)*y(k,131) - mat(k,202) = rxt(k,510)*y(k,49) - mat(k,1288) = rxt(k,510)*y(k,37) + rxt(k,447)*y(k,131) - mat(k,993) = mat(k,993) + rxt(k,433)*y(k,67) + rxt(k,432)*y(k,69) - mat(k,1426) = mat(k,1426) + rxt(k,496)*y(k,5) + rxt(k,465)*y(k,27) & - + rxt(k,433)*y(k,61) - mat(k,1200) = rxt(k,432)*y(k,61) - mat(k,1468) = rxt(k,463)*y(k,27) - mat(k,752) = mat(k,752) + rxt(k,310)*y(k,119) - mat(k,1035) = rxt(k,200)*y(k,111) + rxt(k,193)*y(k,112) + rxt(k,198)*y(k,113) - mat(k,1702) = rxt(k,165)*y(k,111) + (rxt(k,236)+rxt(k,262))*y(k,112) & - + rxt(k,163)*y(k,113) - mat(k,1593) = rxt(k,183)*y(k,111) + (rxt(k,175)+rxt(k,263))*y(k,112) & - + rxt(k,180)*y(k,113) - mat(k,858) = rxt(k,286)*y(k,26) - mat(k,720) = rxt(k,241)*y(k,115) + rxt(k,223)*y(k,116) + rxt(k,206)*y(k,119) & + mat(k,556) = rxt(k,197)*y(k,101) + rxt(k,162)*y(k,103) + rxt(k,179)*y(k,105) & + + rxt(k,250)*y(k,116) + rxt(k,232)*y(k,117) + rxt(k,215) & + *y(k,120) + rxt(k,156)*y(k,126) + mat(k,1156) = rxt(k,254)*y(k,109) + rxt(k,250)*y(k,110) + mat(k,1199) = rxt(k,237)*y(k,109) + rxt(k,232)*y(k,110) + mat(k,1342) = rxt(k,219)*y(k,109) + rxt(k,215)*y(k,110) + rxt(k,311)*y(k,131) + mat(k,1590) = rxt(k,161)*y(k,109) + rxt(k,156)*y(k,110) + mat(k,993) = mat(k,993) + rxt(k,423)*y(k,52) + rxt(k,340)*y(k,55) & + + rxt(k,437)*y(k,64) + rxt(k,311)*y(k,120) + mat(k,1886) = mat(k,1886) + rxt(k,136)*y(k,62) + mat(k,1096) = -(rxt(k,434)*y(k,99) + rxt(k,435)*y(k,62) + rxt(k,436)*y(k,69) & + + rxt(k,437)*y(k,131) + rxt(k,445)*y(k,63) + rxt(k,530)*y(k,17) & + + rxt(k,541)*y(k,35)) + mat(k,900) = -rxt(k,434)*y(k,64) + mat(k,1711) = -rxt(k,435)*y(k,64) + mat(k,1288) = -rxt(k,436)*y(k,64) + mat(k,983) = -rxt(k,437)*y(k,64) + mat(k,1626) = -rxt(k,445)*y(k,64) + mat(k,740) = -rxt(k,530)*y(k,64) + mat(k,126) = -rxt(k,541)*y(k,64) + mat(k,207) = rxt(k,496)*y(k,69) + mat(k,2005) = rxt(k,463)*y(k,29) + mat(k,1756) = rxt(k,286)*y(k,109) + mat(k,358) = rxt(k,463)*y(k,25) + rxt(k,465)*y(k,69) + rxt(k,466)*y(k,131) + mat(k,343) = rxt(k,510)*y(k,51) + mat(k,1228) = rxt(k,510)*y(k,39) + rxt(k,447)*y(k,131) + mat(k,1626) = mat(k,1626) + rxt(k,433)*y(k,69) + rxt(k,432)*y(k,72) + mat(k,1288) = mat(k,1288) + rxt(k,496)*y(k,6) + rxt(k,465)*y(k,29) & + + rxt(k,433)*y(k,63) + mat(k,1915) = rxt(k,432)*y(k,63) + mat(k,900) = mat(k,900) + rxt(k,310)*y(k,120) + mat(k,1452) = rxt(k,200)*y(k,112) + rxt(k,193)*y(k,113) + rxt(k,198)*y(k,114) + mat(k,1669) = rxt(k,165)*y(k,112) + (rxt(k,236)+rxt(k,262))*y(k,113) & + + rxt(k,163)*y(k,114) + mat(k,1409) = rxt(k,183)*y(k,112) + (rxt(k,175)+rxt(k,263))*y(k,113) & + + rxt(k,180)*y(k,114) + mat(k,926) = rxt(k,286)*y(k,28) + mat(k,866) = rxt(k,241)*y(k,116) + rxt(k,223)*y(k,117) + rxt(k,206)*y(k,120) & + rxt(k,148)*y(k,126) - mat(k,527) = rxt(k,200)*y(k,100) + rxt(k,165)*y(k,102) + rxt(k,183)*y(k,104) & - + rxt(k,253)*y(k,115) + rxt(k,235)*y(k,116) + rxt(k,218) & - *y(k,119) + rxt(k,160)*y(k,126) - mat(k,567) = rxt(k,193)*y(k,100) + (rxt(k,236)+rxt(k,262))*y(k,102) + ( & - + rxt(k,175)+rxt(k,263))*y(k,104) + rxt(k,245)*y(k,115) & - + rxt(k,228)*y(k,116) + rxt(k,210)*y(k,119) + rxt(k,152) & + mat(k,625) = rxt(k,200)*y(k,101) + rxt(k,165)*y(k,103) + rxt(k,183)*y(k,105) & + + rxt(k,253)*y(k,116) + rxt(k,235)*y(k,117) + rxt(k,218) & + *y(k,120) + rxt(k,160)*y(k,126) + mat(k,690) = rxt(k,193)*y(k,101) + (rxt(k,236)+rxt(k,262))*y(k,103) + ( & + + rxt(k,175)+rxt(k,263))*y(k,105) + rxt(k,245)*y(k,116) & + + rxt(k,228)*y(k,117) + rxt(k,210)*y(k,120) + rxt(k,152) & *y(k,126) - mat(k,471) = rxt(k,198)*y(k,100) + rxt(k,163)*y(k,102) + rxt(k,180)*y(k,104) & - + rxt(k,251)*y(k,115) + rxt(k,233)*y(k,116) + rxt(k,216) & - *y(k,119) + rxt(k,157)*y(k,126) - mat(k,509) = rxt(k,238)*y(k,115) + rxt(k,220)*y(k,116) + rxt(k,202)*y(k,119) & + mat(k,563) = rxt(k,198)*y(k,101) + rxt(k,163)*y(k,103) + rxt(k,180)*y(k,105) & + + rxt(k,251)*y(k,116) + rxt(k,233)*y(k,117) + rxt(k,216) & + *y(k,120) + rxt(k,157)*y(k,126) + mat(k,608) = rxt(k,238)*y(k,116) + rxt(k,220)*y(k,117) + rxt(k,202)*y(k,120) & + rxt(k,255)*y(k,126) - mat(k,905) = rxt(k,241)*y(k,110) + rxt(k,253)*y(k,111) + rxt(k,245)*y(k,112) & - + rxt(k,251)*y(k,113) + rxt(k,238)*y(k,114) - mat(k,947) = rxt(k,223)*y(k,110) + rxt(k,235)*y(k,111) + rxt(k,228)*y(k,112) & - + rxt(k,233)*y(k,113) + rxt(k,220)*y(k,114) - mat(k,1076) = rxt(k,310)*y(k,98) + rxt(k,206)*y(k,110) + rxt(k,218)*y(k,111) & - + rxt(k,210)*y(k,112) + rxt(k,216)*y(k,113) + rxt(k,202) & - *y(k,114) - mat(k,1367) = rxt(k,148)*y(k,110) + rxt(k,160)*y(k,111) + rxt(k,152)*y(k,112) & - + rxt(k,157)*y(k,113) + rxt(k,255)*y(k,114) - mat(k,799) = mat(k,799) + rxt(k,466)*y(k,27) + rxt(k,447)*y(k,49) - mat(k,1433) = -(rxt(k,113)*y(k,90) + rxt(k,125)*y(k,91) + rxt(k,131)*y(k,94) & - + rxt(k,301)*y(k,110) + (rxt(k,324) + rxt(k,325)) * y(k,125) & + mat(k,1144) = rxt(k,241)*y(k,111) + rxt(k,253)*y(k,112) + rxt(k,245)*y(k,113) & + + rxt(k,251)*y(k,114) + rxt(k,238)*y(k,115) + mat(k,1187) = rxt(k,223)*y(k,111) + rxt(k,235)*y(k,112) + rxt(k,228)*y(k,113) & + + rxt(k,233)*y(k,114) + rxt(k,220)*y(k,115) + mat(k,1330) = rxt(k,310)*y(k,99) + rxt(k,206)*y(k,111) + rxt(k,218)*y(k,112) & + + rxt(k,210)*y(k,113) + rxt(k,216)*y(k,114) + rxt(k,202) & + *y(k,115) + mat(k,1578) = rxt(k,148)*y(k,111) + rxt(k,160)*y(k,112) + rxt(k,152)*y(k,113) & + + rxt(k,157)*y(k,114) + rxt(k,255)*y(k,115) + mat(k,983) = mat(k,983) + rxt(k,466)*y(k,29) + rxt(k,447)*y(k,51) + mat(k,1292) = -(rxt(k,113)*y(k,91) + rxt(k,125)*y(k,92) + rxt(k,131)*y(k,95) & + + rxt(k,301)*y(k,111) + (rxt(k,324) + rxt(k,325)) * y(k,125) & + (rxt(k,333) + rxt(k,334)) * y(k,128) + rxt(k,336)*y(k,129) & + rxt(k,338)*y(k,130) + rxt(k,347)*y(k,132) + rxt(k,360) & - *y(k,133) + rxt(k,403)*y(k,69) + 4._r8*rxt(k,404)*y(k,67) & - + rxt(k,405)*y(k,68) + rxt(k,406)*y(k,39) + rxt(k,407)*y(k,41) & - + rxt(k,412)*y(k,98) + rxt(k,418)*y(k,131) + (rxt(k,431) & - + rxt(k,433)) * y(k,61) + rxt(k,436)*y(k,62) + rxt(k,441) & - *y(k,60) + rxt(k,465)*y(k,27) + rxt(k,467)*y(k,26) + rxt(k,470) & - *y(k,47) + rxt(k,473)*y(k,52) + rxt(k,496)*y(k,5) + rxt(k,497) & - *y(k,4) + rxt(k,499)*y(k,43) + rxt(k,501)*y(k,51) + rxt(k,531) & - *y(k,16) + rxt(k,542)*y(k,71) + (rxt(k,587) + rxt(k,588) & - ) * y(k,107) + rxt(k,589)*y(k,121)) - mat(k,292) = -rxt(k,113)*y(k,67) - mat(k,836) = -rxt(k,125)*y(k,67) - mat(k,677) = -rxt(k,131)*y(k,67) - mat(k,726) = -rxt(k,301)*y(k,67) - mat(k,1330) = -(rxt(k,324) + rxt(k,325)) * y(k,67) - mat(k,446) = -(rxt(k,333) + rxt(k,334)) * y(k,67) - mat(k,100) = -rxt(k,336)*y(k,67) - mat(k,357) = -rxt(k,338)*y(k,67) - mat(k,1632) = -rxt(k,347)*y(k,67) - mat(k,1667) = -rxt(k,360)*y(k,67) - mat(k,1207) = -rxt(k,403)*y(k,67) - mat(k,1256) = -rxt(k,405)*y(k,67) - mat(k,494) = -rxt(k,406)*y(k,67) - mat(k,150) = -rxt(k,407)*y(k,67) - mat(k,759) = -rxt(k,412)*y(k,67) - mat(k,806) = -rxt(k,418)*y(k,67) - mat(k,1000) = -(rxt(k,431) + rxt(k,433)) * y(k,67) - mat(k,1122) = -rxt(k,436)*y(k,67) - mat(k,1516) = -rxt(k,441)*y(k,67) - mat(k,283) = -rxt(k,465)*y(k,67) - mat(k,1753) = -rxt(k,467)*y(k,67) - mat(k,1166) = -rxt(k,470)*y(k,67) - mat(k,234) = -rxt(k,473)*y(k,67) - mat(k,145) = -rxt(k,496)*y(k,67) - mat(k,595) = -rxt(k,497)*y(k,67) - mat(k,243) = -rxt(k,499)*y(k,67) - mat(k,212) = -rxt(k,501)*y(k,67) - mat(k,616) = -rxt(k,531)*y(k,67) - mat(k,75) = -rxt(k,542)*y(k,67) - mat(k,160) = -(rxt(k,587) + rxt(k,588)) * y(k,67) - mat(k,229) = -rxt(k,589)*y(k,67) - mat(k,1788) = rxt(k,410)*y(k,98) - mat(k,319) = rxt(k,426)*y(k,60) + rxt(k,427)*y(k,61) + rxt(k,430)*y(k,68) & - + rxt(k,592)*y(k,126) - mat(k,1516) = mat(k,1516) + rxt(k,426)*y(k,54) + rxt(k,272)*y(k,128) - mat(k,1000) = mat(k,1000) + rxt(k,427)*y(k,54) + rxt(k,359)*y(k,133) - mat(k,1256) = mat(k,1256) + rxt(k,430)*y(k,54) + rxt(k,544)*y(k,74) & - + rxt(k,550)*y(k,76) + rxt(k,591)*y(k,121) + (rxt(k,392) & - +rxt(k,393))*y(k,122) + rxt(k,598)*y(k,134) + rxt(k,602) & - *y(k,135) - mat(k,1207) = mat(k,1207) + rxt(k,363)*y(k,133) - mat(k,173) = rxt(k,544)*y(k,68) - mat(k,387) = rxt(k,550)*y(k,68) - mat(k,1475) = rxt(k,114)*y(k,91) + rxt(k,350)*y(k,133) - mat(k,836) = mat(k,836) + rxt(k,114)*y(k,86) + rxt(k,186)*y(k,100) + ( & - + rxt(k,170)+rxt(k,258))*y(k,102) + (rxt(k,168)+rxt(k,265)) & - *y(k,104) + rxt(k,239)*y(k,115) + rxt(k,221)*y(k,116) & - + rxt(k,204)*y(k,119) + rxt(k,256)*y(k,126) - mat(k,370) = rxt(k,194)*y(k,100) + (rxt(k,247)+rxt(k,271))*y(k,102) + ( & - + rxt(k,176)+rxt(k,259))*y(k,104) + rxt(k,246)*y(k,115) & - + rxt(k,229)*y(k,116) + rxt(k,211)*y(k,119) + rxt(k,153) & + *y(k,133) + rxt(k,403)*y(k,72) + 4._r8*rxt(k,404)*y(k,69) & + + rxt(k,405)*y(k,71) + rxt(k,406)*y(k,41) + rxt(k,407)*y(k,43) & + + rxt(k,412)*y(k,99) + rxt(k,418)*y(k,131) + (rxt(k,431) & + + rxt(k,433)) * y(k,63) + rxt(k,436)*y(k,64) + rxt(k,441) & + *y(k,62) + rxt(k,465)*y(k,29) + rxt(k,467)*y(k,28) + rxt(k,470) & + *y(k,49) + rxt(k,473)*y(k,54) + rxt(k,496)*y(k,6) + rxt(k,497) & + *y(k,5) + rxt(k,499)*y(k,45) + rxt(k,501)*y(k,53) + rxt(k,531) & + *y(k,17) + rxt(k,543)*y(k,74) + (rxt(k,586) + rxt(k,587) & + ) * y(k,108) + rxt(k,588)*y(k,122)) + mat(k,369) = -rxt(k,113)*y(k,69) + mat(k,1017) = -rxt(k,125)*y(k,69) + mat(k,840) = -rxt(k,131)*y(k,69) + mat(k,870) = -rxt(k,301)*y(k,69) + mat(k,1537) = -(rxt(k,324) + rxt(k,325)) * y(k,69) + mat(k,596) = -(rxt(k,333) + rxt(k,334)) * y(k,69) + mat(k,239) = -rxt(k,336)*y(k,69) + mat(k,461) = -rxt(k,338)*y(k,69) + mat(k,1842) = -rxt(k,347)*y(k,69) + mat(k,1878) = -rxt(k,360)*y(k,69) + mat(k,1919) = -rxt(k,403)*y(k,69) + mat(k,1809) = -rxt(k,405)*y(k,69) + mat(k,652) = -rxt(k,406)*y(k,69) + mat(k,214) = -rxt(k,407)*y(k,69) + mat(k,902) = -rxt(k,412)*y(k,69) + mat(k,986) = -rxt(k,418)*y(k,69) + mat(k,1630) = -(rxt(k,431) + rxt(k,433)) * y(k,69) + mat(k,1100) = -rxt(k,436)*y(k,69) + mat(k,1715) = -rxt(k,441)*y(k,69) + mat(k,360) = -rxt(k,465)*y(k,69) + mat(k,1760) = -rxt(k,467)*y(k,69) + mat(k,1501) = -rxt(k,470)*y(k,69) + mat(k,324) = -rxt(k,473)*y(k,69) + mat(k,209) = -rxt(k,496)*y(k,69) + mat(k,719) = -rxt(k,497)*y(k,69) + mat(k,334) = -rxt(k,499)*y(k,69) + mat(k,310) = -rxt(k,501)*y(k,69) + mat(k,742) = -rxt(k,531)*y(k,69) + mat(k,142) = -rxt(k,543)*y(k,69) + mat(k,233) = -(rxt(k,586) + rxt(k,587)) * y(k,69) + mat(k,318) = -rxt(k,588)*y(k,69) + mat(k,2009) = rxt(k,114)*y(k,92) + rxt(k,350)*y(k,133) + mat(k,1370) = rxt(k,410)*y(k,99) + mat(k,449) = rxt(k,426)*y(k,62) + rxt(k,427)*y(k,63) + rxt(k,430)*y(k,71) & + + rxt(k,591)*y(k,126) + mat(k,1715) = mat(k,1715) + rxt(k,426)*y(k,56) + rxt(k,272)*y(k,128) + mat(k,1630) = mat(k,1630) + rxt(k,427)*y(k,56) + rxt(k,359)*y(k,133) + mat(k,790) = (rxt(k,392)+rxt(k,393))*y(k,71) + mat(k,1809) = mat(k,1809) + rxt(k,430)*y(k,56) + (rxt(k,392)+rxt(k,393)) & + *y(k,70) + rxt(k,545)*y(k,77) + rxt(k,552)*y(k,79) + rxt(k,590) & + *y(k,122) + rxt(k,597)*y(k,134) + rxt(k,601)*y(k,135) + mat(k,1919) = mat(k,1919) + rxt(k,363)*y(k,133) + mat(k,271) = rxt(k,545)*y(k,71) + mat(k,492) = rxt(k,552)*y(k,71) + mat(k,1017) = mat(k,1017) + rxt(k,114)*y(k,25) + rxt(k,186)*y(k,101) + ( & + + rxt(k,170)+rxt(k,258))*y(k,103) + (rxt(k,168)+rxt(k,265)) & + *y(k,105) + rxt(k,239)*y(k,116) + rxt(k,221)*y(k,117) & + + rxt(k,204)*y(k,120) + rxt(k,256)*y(k,126) + mat(k,505) = rxt(k,194)*y(k,101) + (rxt(k,247)+rxt(k,271))*y(k,103) + ( & + + rxt(k,176)+rxt(k,259))*y(k,105) + rxt(k,246)*y(k,116) & + + rxt(k,229)*y(k,117) + rxt(k,211)*y(k,120) + rxt(k,153) & *y(k,126) - mat(k,551) = rxt(k,196)*y(k,100) + (rxt(k,158)+rxt(k,260))*y(k,102) + ( & - + rxt(k,178)+rxt(k,261))*y(k,104) + rxt(k,249)*y(k,115) & - + rxt(k,231)*y(k,116) + rxt(k,213)*y(k,119) + rxt(k,155) & + mat(k,673) = rxt(k,196)*y(k,101) + (rxt(k,158)+rxt(k,260))*y(k,103) + ( & + + rxt(k,178)+rxt(k,261))*y(k,105) + rxt(k,249)*y(k,116) & + + rxt(k,231)*y(k,117) + rxt(k,213)*y(k,120) + rxt(k,155) & *y(k,126) - mat(k,1558) = rxt(k,583)*y(k,115) + 1.150_r8*rxt(k,584)*y(k,126) - mat(k,759) = mat(k,759) + rxt(k,410)*y(k,38) - mat(k,1042) = rxt(k,186)*y(k,91) + rxt(k,194)*y(k,92) + rxt(k,196)*y(k,93) - mat(k,1709) = (rxt(k,170)+rxt(k,258))*y(k,91) + (rxt(k,247)+rxt(k,271)) & - *y(k,92) + (rxt(k,158)+rxt(k,260))*y(k,93) - mat(k,1600) = (rxt(k,168)+rxt(k,265))*y(k,91) + (rxt(k,176)+rxt(k,259)) & - *y(k,92) + (rxt(k,178)+rxt(k,261))*y(k,93) - mat(k,221) = rxt(k,597)*y(k,134) - mat(k,912) = rxt(k,239)*y(k,91) + rxt(k,246)*y(k,92) + rxt(k,249)*y(k,93) & - + rxt(k,583)*y(k,95) - mat(k,954) = rxt(k,221)*y(k,91) + rxt(k,229)*y(k,92) + rxt(k,231)*y(k,93) - mat(k,1083) = rxt(k,204)*y(k,91) + rxt(k,211)*y(k,92) + rxt(k,213)*y(k,93) - mat(k,229) = mat(k,229) + rxt(k,591)*y(k,68) - mat(k,649) = (rxt(k,392)+rxt(k,393))*y(k,68) - mat(k,1374) = rxt(k,592)*y(k,54) + rxt(k,256)*y(k,91) + rxt(k,153)*y(k,92) & - + rxt(k,155)*y(k,93) + 1.150_r8*rxt(k,584)*y(k,95) - mat(k,446) = mat(k,446) + rxt(k,272)*y(k,60) - mat(k,806) = mat(k,806) + 2.000_r8*rxt(k,420)*y(k,131) - mat(k,1667) = mat(k,1667) + rxt(k,359)*y(k,61) + rxt(k,363)*y(k,69) & - + rxt(k,350)*y(k,86) - mat(k,272) = rxt(k,598)*y(k,68) + rxt(k,597)*y(k,106) - mat(k,133) = rxt(k,602)*y(k,68) - mat(k,1252) = -(rxt(k,126)*y(k,91) + (rxt(k,133) + rxt(k,135)) * y(k,95) & + mat(k,1060) = rxt(k,582)*y(k,116) + 1.150_r8*rxt(k,583)*y(k,126) + mat(k,902) = mat(k,902) + rxt(k,410)*y(k,40) + mat(k,1456) = rxt(k,186)*y(k,92) + rxt(k,194)*y(k,93) + rxt(k,196)*y(k,94) + mat(k,1673) = (rxt(k,170)+rxt(k,258))*y(k,92) + (rxt(k,247)+rxt(k,271)) & + *y(k,93) + (rxt(k,158)+rxt(k,260))*y(k,94) + mat(k,1413) = (rxt(k,168)+rxt(k,265))*y(k,92) + (rxt(k,176)+rxt(k,259)) & + *y(k,93) + (rxt(k,178)+rxt(k,261))*y(k,94) + mat(k,302) = rxt(k,596)*y(k,134) + mat(k,1148) = rxt(k,239)*y(k,92) + rxt(k,246)*y(k,93) + rxt(k,249)*y(k,94) & + + rxt(k,582)*y(k,96) + mat(k,1191) = rxt(k,221)*y(k,92) + rxt(k,229)*y(k,93) + rxt(k,231)*y(k,94) + mat(k,1334) = rxt(k,204)*y(k,92) + rxt(k,211)*y(k,93) + rxt(k,213)*y(k,94) + mat(k,318) = mat(k,318) + rxt(k,590)*y(k,71) + mat(k,1582) = rxt(k,591)*y(k,56) + rxt(k,256)*y(k,92) + rxt(k,153)*y(k,93) & + + rxt(k,155)*y(k,94) + 1.150_r8*rxt(k,583)*y(k,96) + mat(k,596) = mat(k,596) + rxt(k,272)*y(k,62) + mat(k,986) = mat(k,986) + 2.000_r8*rxt(k,420)*y(k,131) + mat(k,1878) = mat(k,1878) + rxt(k,350)*y(k,25) + rxt(k,359)*y(k,63) & + + rxt(k,363)*y(k,72) + mat(k,391) = rxt(k,597)*y(k,71) + rxt(k,596)*y(k,107) + mat(k,200) = rxt(k,601)*y(k,71) + 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,784) = -(rxt(k,389)*y(k,41) + rxt(k,390)*y(k,137) + (rxt(k,392) & + + rxt(k,393)) * y(k,71) + rxt(k,394)*y(k,72) + (rxt(k,442) & + + rxt(k,443)) * y(k,57) + rxt(k,475)*y(k,8) + rxt(k,476)*y(k,9) & + + rxt(k,477)*y(k,11) + rxt(k,478)*y(k,12) + rxt(k,479)*y(k,13) & + + rxt(k,480)*y(k,14) + rxt(k,481)*y(k,15) + (rxt(k,482) & + + rxt(k,483)) * y(k,49) + rxt(k,502)*y(k,10) + rxt(k,503) & + *y(k,24) + rxt(k,504)*y(k,42) + (rxt(k,505) + rxt(k,506) & + ) * y(k,45) + rxt(k,511)*y(k,33) + rxt(k,512)*y(k,34) + rxt(k,525) & + *y(k,16) + rxt(k,526)*y(k,18) + rxt(k,527)*y(k,46) + rxt(k,528) & + *y(k,47) + rxt(k,529)*y(k,48) + (rxt(k,537) + rxt(k,538) & + + rxt(k,539)) * y(k,23)) + mat(k,646) = -rxt(k,389)*y(k,70) + mat(k,2057) = -rxt(k,390)*y(k,70) + mat(k,1797) = -(rxt(k,392) + rxt(k,393)) * y(k,70) + mat(k,1907) = -rxt(k,394)*y(k,70) + mat(k,96) = -(rxt(k,442) + rxt(k,443)) * y(k,70) + mat(k,28) = -rxt(k,475)*y(k,70) + mat(k,56) = -rxt(k,476)*y(k,70) + mat(k,36) = -rxt(k,477)*y(k,70) + mat(k,66) = -rxt(k,478)*y(k,70) + mat(k,40) = -rxt(k,479)*y(k,70) + mat(k,71) = -rxt(k,480)*y(k,70) + mat(k,44) = -rxt(k,481)*y(k,70) + mat(k,1488) = -(rxt(k,482) + rxt(k,483)) * y(k,70) + mat(k,62) = -rxt(k,502)*y(k,70) + mat(k,154) = -rxt(k,503)*y(k,70) + mat(k,33) = -rxt(k,504)*y(k,70) + mat(k,332) = -(rxt(k,505) + rxt(k,506)) * y(k,70) + mat(k,91) = -rxt(k,511)*y(k,70) + mat(k,82) = -rxt(k,512)*y(k,70) + mat(k,178) = -rxt(k,525)*y(k,70) + mat(k,221) = -rxt(k,526)*y(k,70) + mat(k,77) = -rxt(k,527)*y(k,70) + mat(k,86) = -rxt(k,528)*y(k,70) + mat(k,115) = -rxt(k,529)*y(k,70) + mat(k,417) = -(rxt(k,537) + rxt(k,538) + rxt(k,539)) * y(k,70) + mat(k,1797) = mat(k,1797) + rxt(k,425)*y(k,107) + mat(k,1052) = .850_r8*rxt(k,583)*y(k,126) + mat(k,301) = rxt(k,425)*y(k,71) + mat(k,1569) = .850_r8*rxt(k,583)*y(k,96) + mat(k,1821) = -(rxt(k,126)*y(k,92) + (rxt(k,133) + rxt(k,135)) * y(k,96) & + rxt(k,322)*y(k,125) + rxt(k,362)*y(k,133) + rxt(k,364) & - *y(k,126) + rxt(k,392)*y(k,122) + rxt(k,397)*y(k,123) + rxt(k,405) & - *y(k,67) + rxt(k,411)*y(k,38) + rxt(k,425)*y(k,106) + rxt(k,430) & - *y(k,54) + rxt(k,544)*y(k,74) + rxt(k,550)*y(k,76) + rxt(k,586) & - *y(k,107) + (rxt(k,590) + rxt(k,591)) * y(k,121) + rxt(k,598) & - *y(k,134) + rxt(k,602)*y(k,135)) - mat(k,832) = -rxt(k,126)*y(k,68) - mat(k,1554) = -(rxt(k,133) + rxt(k,135)) * y(k,68) - mat(k,1326) = -rxt(k,322)*y(k,68) - mat(k,1663) = -rxt(k,362)*y(k,68) - mat(k,1370) = -rxt(k,364)*y(k,68) - mat(k,645) = -rxt(k,392)*y(k,68) - mat(k,249) = -rxt(k,397)*y(k,68) - mat(k,1429) = -rxt(k,405)*y(k,68) - mat(k,1784) = -rxt(k,411)*y(k,68) - mat(k,220) = -rxt(k,425)*y(k,68) - mat(k,317) = -rxt(k,430)*y(k,68) - mat(k,172) = -rxt(k,544)*y(k,68) - mat(k,386) = -rxt(k,550)*y(k,68) - mat(k,158) = -rxt(k,586)*y(k,68) - mat(k,227) = -(rxt(k,590) + rxt(k,591)) * y(k,68) - mat(k,270) = -rxt(k,598)*y(k,68) - mat(k,131) = -rxt(k,602)*y(k,68) - mat(k,593) = 2.000_r8*rxt(k,489)*y(k,4) + (rxt(k,491)+rxt(k,492))*y(k,26) & - + rxt(k,497)*y(k,67) + rxt(k,493)*y(k,98) - mat(k,329) = rxt(k,533)*y(k,98) - mat(k,1749) = (rxt(k,491)+rxt(k,492))*y(k,4) + (2.000_r8*rxt(k,458) & - +2.000_r8*rxt(k,459))*y(k,26) + rxt(k,467)*y(k,67) + rxt(k,116) & - *y(k,91) + rxt(k,128)*y(k,94) + rxt(k,461)*y(k,98) + rxt(k,315) & + *y(k,126) + rxt(k,392)*y(k,70) + rxt(k,397)*y(k,123) + rxt(k,405) & + *y(k,69) + rxt(k,411)*y(k,40) + rxt(k,425)*y(k,107) + rxt(k,430) & + *y(k,56) + rxt(k,545)*y(k,77) + rxt(k,552)*y(k,79) + rxt(k,585) & + *y(k,108) + (rxt(k,589) + rxt(k,590)) * y(k,122) + rxt(k,597) & + *y(k,134) + rxt(k,601)*y(k,135)) + mat(k,1029) = -rxt(k,126)*y(k,71) + mat(k,1072) = -(rxt(k,133) + rxt(k,135)) * y(k,71) + mat(k,1549) = -rxt(k,322)*y(k,71) + mat(k,1890) = -rxt(k,362)*y(k,71) + mat(k,1594) = -rxt(k,364)*y(k,71) + mat(k,799) = -rxt(k,392)*y(k,71) + mat(k,379) = -rxt(k,397)*y(k,71) + mat(k,1304) = -rxt(k,405)*y(k,71) + mat(k,1382) = -rxt(k,411)*y(k,71) + mat(k,304) = -rxt(k,425)*y(k,71) + mat(k,454) = -rxt(k,430)*y(k,71) + mat(k,273) = -rxt(k,545)*y(k,71) + mat(k,497) = -rxt(k,552)*y(k,71) + mat(k,235) = -rxt(k,585)*y(k,71) + mat(k,320) = -(rxt(k,589) + rxt(k,590)) * y(k,71) + mat(k,394) = -rxt(k,597)*y(k,71) + mat(k,202) = -rxt(k,601)*y(k,71) + mat(k,587) = rxt(k,488)*y(k,72) + rxt(k,487)*y(k,99) + mat(k,725) = 2.000_r8*rxt(k,489)*y(k,5) + (rxt(k,491)+rxt(k,492))*y(k,28) & + + rxt(k,497)*y(k,69) + rxt(k,493)*y(k,99) + mat(k,437) = rxt(k,533)*y(k,99) + mat(k,2021) = rxt(k,456)*y(k,72) + rxt(k,127)*y(k,95) + rxt(k,454)*y(k,99) & + + rxt(k,314)*y(k,125) + mat(k,1772) = (rxt(k,491)+rxt(k,492))*y(k,5) + (2.000_r8*rxt(k,458) & + +2.000_r8*rxt(k,459))*y(k,28) + rxt(k,467)*y(k,69) + rxt(k,116) & + *y(k,92) + rxt(k,128)*y(k,95) + rxt(k,461)*y(k,99) + rxt(k,315) & *y(k,125) + rxt(k,469)*y(k,131) + rxt(k,351)*y(k,133) - mat(k,1784) = mat(k,1784) + rxt(k,414)*y(k,69) + rxt(k,408)*y(k,98) & + mat(k,1973) = rxt(k,330)*y(k,128) + rxt(k,335)*y(k,129) + mat(k,1382) = mat(k,1382) + rxt(k,414)*y(k,72) + rxt(k,408)*y(k,99) & + rxt(k,331)*y(k,128) - mat(k,106) = rxt(k,423)*y(k,131) - mat(k,317) = mat(k,317) + rxt(k,429)*y(k,61) - mat(k,1512) = rxt(k,440)*y(k,69) + rxt(k,594)*y(k,126) + rxt(k,279)*y(k,128) - mat(k,996) = rxt(k,429)*y(k,54) + rxt(k,431)*y(k,67) + rxt(k,432)*y(k,69) & + mat(k,188) = rxt(k,423)*y(k,131) + mat(k,454) = mat(k,454) + rxt(k,429)*y(k,63) + mat(k,98) = rxt(k,443)*y(k,70) + mat(k,1727) = rxt(k,440)*y(k,72) + rxt(k,593)*y(k,126) + rxt(k,279)*y(k,128) + mat(k,1642) = rxt(k,429)*y(k,56) + rxt(k,431)*y(k,69) + rxt(k,432)*y(k,72) & + rxt(k,320)*y(k,125) + rxt(k,277)*y(k,128) - mat(k,1118) = rxt(k,436)*y(k,67) + rxt(k,434)*y(k,98) - mat(k,1429) = mat(k,1429) + rxt(k,497)*y(k,4) + rxt(k,467)*y(k,26) & - + rxt(k,431)*y(k,61) + rxt(k,436)*y(k,62) + 2.000_r8*rxt(k,404) & - *y(k,67) + 2.000_r8*rxt(k,403)*y(k,69) + rxt(k,113)*y(k,90) & - + rxt(k,131)*y(k,94) + rxt(k,412)*y(k,98) + rxt(k,301)*y(k,110) & + mat(k,1112) = rxt(k,436)*y(k,69) + rxt(k,434)*y(k,99) + mat(k,1304) = mat(k,1304) + rxt(k,497)*y(k,5) + rxt(k,467)*y(k,28) & + + rxt(k,431)*y(k,63) + rxt(k,436)*y(k,64) + 2.000_r8*rxt(k,404) & + *y(k,69) + 2.000_r8*rxt(k,403)*y(k,72) + rxt(k,113)*y(k,91) & + + rxt(k,131)*y(k,95) + rxt(k,412)*y(k,99) + rxt(k,301)*y(k,111) & + rxt(k,396)*y(k,123) + rxt(k,325)*y(k,125) + ( & + 2.000_r8*rxt(k,333)+rxt(k,334))*y(k,128) + rxt(k,336)*y(k,129) & + rxt(k,418)*y(k,131) + rxt(k,360)*y(k,133) - mat(k,1252) = mat(k,1252) + 2.000_r8*rxt(k,397)*y(k,123) - mat(k,1203) = rxt(k,414)*y(k,38) + rxt(k,440)*y(k,60) + rxt(k,432)*y(k,61) & - + 2.000_r8*rxt(k,403)*y(k,67) + rxt(k,545)*y(k,74) + rxt(k,551) & - *y(k,76) + rxt(k,488)*y(k,85) + rxt(k,456)*y(k,86) + rxt(k,132) & - *y(k,94) + rxt(k,134)*y(k,95) + 2.000_r8*rxt(k,413)*y(k,98) & - + rxt(k,292)*y(k,108) + 2.000_r8*rxt(k,302)*y(k,110) & - + 2.000_r8*rxt(k,394)*y(k,122) + rxt(k,323)*y(k,125) & + mat(k,799) = mat(k,799) + rxt(k,443)*y(k,57) + 2.000_r8*rxt(k,394)*y(k,72) + mat(k,1821) = mat(k,1821) + 2.000_r8*rxt(k,397)*y(k,123) + mat(k,1931) = rxt(k,488)*y(k,3) + rxt(k,456)*y(k,25) + rxt(k,414)*y(k,40) & + + rxt(k,440)*y(k,62) + rxt(k,432)*y(k,63) + 2.000_r8*rxt(k,403) & + *y(k,69) + 2.000_r8*rxt(k,394)*y(k,70) + rxt(k,547)*y(k,77) & + + rxt(k,553)*y(k,79) + rxt(k,132)*y(k,95) + rxt(k,134)*y(k,96) & + + 2.000_r8*rxt(k,413)*y(k,99) + rxt(k,292)*y(k,109) & + + 2.000_r8*rxt(k,302)*y(k,111) + rxt(k,323)*y(k,125) & + 3.000_r8*rxt(k,332)*y(k,128) + rxt(k,419)*y(k,131) - mat(k,172) = mat(k,172) + rxt(k,545)*y(k,69) - mat(k,386) = mat(k,386) + rxt(k,551)*y(k,69) - mat(k,461) = rxt(k,488)*y(k,69) + rxt(k,487)*y(k,98) - mat(k,1471) = rxt(k,456)*y(k,69) + rxt(k,127)*y(k,94) + rxt(k,454)*y(k,98) & - + rxt(k,314)*y(k,125) - mat(k,699) = rxt(k,154)*y(k,126) - mat(k,416) = rxt(k,159)*y(k,126) - mat(k,400) = rxt(k,257)*y(k,126) - mat(k,291) = rxt(k,113)*y(k,67) - mat(k,832) = mat(k,832) + rxt(k,116)*y(k,26) + rxt(k,256)*y(k,126) - mat(k,368) = rxt(k,153)*y(k,126) - mat(k,549) = rxt(k,155)*y(k,126) - mat(k,674) = rxt(k,128)*y(k,26) + rxt(k,131)*y(k,67) + rxt(k,132)*y(k,69) & - + rxt(k,127)*y(k,86) + rxt(k,191)*y(k,100) + rxt(k,225)*y(k,102) & - + rxt(k,174)*y(k,104) + rxt(k,244)*y(k,115) + rxt(k,227) & - *y(k,116) + rxt(k,209)*y(k,119) + 2.000_r8*rxt(k,151)*y(k,126) - mat(k,1554) = mat(k,1554) + rxt(k,134)*y(k,69) + rxt(k,326)*y(k,127) & + mat(k,273) = mat(k,273) + rxt(k,547)*y(k,72) + mat(k,497) = mat(k,497) + rxt(k,553)*y(k,72) + mat(k,824) = rxt(k,154)*y(k,126) + mat(k,544) = rxt(k,159)*y(k,126) + mat(k,528) = rxt(k,257)*y(k,126) + mat(k,372) = rxt(k,113)*y(k,69) + mat(k,1029) = mat(k,1029) + rxt(k,116)*y(k,28) + rxt(k,256)*y(k,126) + mat(k,513) = rxt(k,153)*y(k,126) + mat(k,682) = rxt(k,155)*y(k,126) + mat(k,852) = rxt(k,127)*y(k,25) + rxt(k,128)*y(k,28) + rxt(k,131)*y(k,69) & + + rxt(k,132)*y(k,72) + rxt(k,191)*y(k,101) + rxt(k,225)*y(k,103) & + + rxt(k,174)*y(k,105) + rxt(k,244)*y(k,116) + rxt(k,227) & + *y(k,117) + rxt(k,209)*y(k,120) + 2.000_r8*rxt(k,151)*y(k,126) + mat(k,1072) = mat(k,1072) + rxt(k,134)*y(k,72) + rxt(k,326)*y(k,127) & + 2.000_r8*rxt(k,380)*y(k,130) - mat(k,341) = rxt(k,149)*y(k,126) - mat(k,755) = rxt(k,493)*y(k,4) + rxt(k,533)*y(k,20) + rxt(k,461)*y(k,26) & - + rxt(k,408)*y(k,38) + rxt(k,434)*y(k,62) + rxt(k,412)*y(k,67) & - + 2.000_r8*rxt(k,413)*y(k,69) + rxt(k,487)*y(k,85) + rxt(k,454) & - *y(k,86) + 2.000_r8*rxt(k,422)*y(k,98) + rxt(k,417)*y(k,131) - mat(k,1038) = rxt(k,191)*y(k,94) + rxt(k,190)*y(k,125) - mat(k,1705) = rxt(k,225)*y(k,94) + rxt(k,214)*y(k,125) - mat(k,1596) = rxt(k,174)*y(k,94) + rxt(k,173)*y(k,125) - mat(k,861) = rxt(k,292)*y(k,69) + rxt(k,161)*y(k,126) - mat(k,431) = rxt(k,156)*y(k,126) - mat(k,723) = rxt(k,301)*y(k,67) + 2.000_r8*rxt(k,302)*y(k,69) + rxt(k,148) & + mat(k,481) = rxt(k,149)*y(k,126) + mat(k,912) = rxt(k,487)*y(k,3) + rxt(k,493)*y(k,5) + rxt(k,533)*y(k,21) & + + rxt(k,454)*y(k,25) + rxt(k,461)*y(k,28) + rxt(k,408)*y(k,40) & + + rxt(k,434)*y(k,64) + rxt(k,412)*y(k,69) + 2.000_r8*rxt(k,413) & + *y(k,72) + 2.000_r8*rxt(k,422)*y(k,99) + rxt(k,417)*y(k,131) + mat(k,1468) = rxt(k,191)*y(k,95) + rxt(k,190)*y(k,125) + mat(k,1685) = rxt(k,225)*y(k,95) + rxt(k,214)*y(k,125) + mat(k,1425) = rxt(k,174)*y(k,95) + rxt(k,173)*y(k,125) + mat(k,941) = rxt(k,292)*y(k,72) + rxt(k,161)*y(k,126) + mat(k,559) = rxt(k,156)*y(k,126) + mat(k,880) = rxt(k,301)*y(k,69) + 2.000_r8*rxt(k,302)*y(k,72) + rxt(k,148) & *y(k,126) - mat(k,528) = rxt(k,160)*y(k,126) - mat(k,568) = rxt(k,152)*y(k,126) - mat(k,473) = rxt(k,157)*y(k,126) - mat(k,510) = rxt(k,255)*y(k,126) - mat(k,908) = rxt(k,244)*y(k,94) + rxt(k,243)*y(k,125) - mat(k,950) = rxt(k,227)*y(k,94) + rxt(k,226)*y(k,125) - mat(k,1079) = rxt(k,209)*y(k,94) + rxt(k,208)*y(k,125) - mat(k,645) = mat(k,645) + 2.000_r8*rxt(k,394)*y(k,69) - mat(k,249) = mat(k,249) + rxt(k,396)*y(k,67) + 2.000_r8*rxt(k,397)*y(k,68) & + mat(k,638) = rxt(k,160)*y(k,126) + mat(k,703) = rxt(k,152)*y(k,126) + mat(k,575) = rxt(k,157)*y(k,126) + mat(k,618) = rxt(k,255)*y(k,126) + mat(k,1160) = rxt(k,244)*y(k,95) + rxt(k,243)*y(k,125) + mat(k,1203) = rxt(k,227)*y(k,95) + rxt(k,226)*y(k,125) + mat(k,1346) = rxt(k,209)*y(k,95) + rxt(k,208)*y(k,125) + mat(k,379) = mat(k,379) + rxt(k,396)*y(k,69) + 2.000_r8*rxt(k,397)*y(k,71) & + 2.000_r8*rxt(k,321)*y(k,125) + 2.000_r8*rxt(k,339)*y(k,130) - mat(k,1326) = mat(k,1326) + rxt(k,315)*y(k,26) + rxt(k,320)*y(k,61) & - + rxt(k,325)*y(k,67) + rxt(k,323)*y(k,69) + rxt(k,314)*y(k,86) & - + rxt(k,190)*y(k,100) + rxt(k,214)*y(k,102) + rxt(k,173) & - *y(k,104) + rxt(k,243)*y(k,115) + rxt(k,226)*y(k,116) & - + rxt(k,208)*y(k,119) + 2.000_r8*rxt(k,321)*y(k,123) - mat(k,1370) = mat(k,1370) + rxt(k,594)*y(k,60) + rxt(k,154)*y(k,87) & - + rxt(k,159)*y(k,88) + rxt(k,257)*y(k,89) + rxt(k,256)*y(k,91) & - + rxt(k,153)*y(k,92) + rxt(k,155)*y(k,93) + 2.000_r8*rxt(k,151) & - *y(k,94) + rxt(k,149)*y(k,97) + rxt(k,161)*y(k,108) + rxt(k,156) & - *y(k,109) + rxt(k,148)*y(k,110) + rxt(k,160)*y(k,111) & - + rxt(k,152)*y(k,112) + rxt(k,157)*y(k,113) + rxt(k,255) & - *y(k,114) - mat(k,192) = rxt(k,326)*y(k,95) + (rxt(k,327)+rxt(k,328))*y(k,137) - mat(k,444) = rxt(k,331)*y(k,38) + rxt(k,279)*y(k,60) + rxt(k,277)*y(k,61) + ( & - + 2.000_r8*rxt(k,333)+rxt(k,334))*y(k,67) + 3.000_r8*rxt(k,332) & - *y(k,69) - mat(k,98) = rxt(k,336)*y(k,67) - mat(k,354) = 2.000_r8*rxt(k,380)*y(k,95) + 2.000_r8*rxt(k,339)*y(k,123) & + mat(k,1549) = mat(k,1549) + rxt(k,314)*y(k,25) + rxt(k,315)*y(k,28) & + + rxt(k,320)*y(k,63) + rxt(k,325)*y(k,69) + rxt(k,323)*y(k,72) & + + rxt(k,190)*y(k,101) + rxt(k,214)*y(k,103) + rxt(k,173) & + *y(k,105) + rxt(k,243)*y(k,116) + rxt(k,226)*y(k,117) & + + rxt(k,208)*y(k,120) + 2.000_r8*rxt(k,321)*y(k,123) + mat(k,1594) = mat(k,1594) + rxt(k,593)*y(k,62) + rxt(k,154)*y(k,88) & + + rxt(k,159)*y(k,89) + rxt(k,257)*y(k,90) + rxt(k,256)*y(k,92) & + + rxt(k,153)*y(k,93) + rxt(k,155)*y(k,94) + 2.000_r8*rxt(k,151) & + *y(k,95) + rxt(k,149)*y(k,98) + rxt(k,161)*y(k,109) + rxt(k,156) & + *y(k,110) + rxt(k,148)*y(k,111) + rxt(k,160)*y(k,112) & + + rxt(k,152)*y(k,113) + rxt(k,157)*y(k,114) + rxt(k,255) & + *y(k,115) + mat(k,295) = rxt(k,326)*y(k,96) + (rxt(k,327)+rxt(k,328))*y(k,137) + mat(k,601) = rxt(k,330)*y(k,32) + rxt(k,331)*y(k,40) + rxt(k,279)*y(k,62) & + + rxt(k,277)*y(k,63) + (2.000_r8*rxt(k,333)+rxt(k,334))*y(k,69) & + + 3.000_r8*rxt(k,332)*y(k,72) + mat(k,241) = rxt(k,335)*y(k,32) + rxt(k,336)*y(k,69) + mat(k,466) = 2.000_r8*rxt(k,380)*y(k,96) + 2.000_r8*rxt(k,339)*y(k,123) & + rxt(k,337)*y(k,137) - mat(k,802) = rxt(k,469)*y(k,26) + rxt(k,423)*y(k,50) + rxt(k,418)*y(k,67) & - + rxt(k,419)*y(k,69) + rxt(k,417)*y(k,98) - mat(k,1663) = mat(k,1663) + rxt(k,351)*y(k,26) + rxt(k,360)*y(k,67) - mat(k,1842) = (rxt(k,327)+rxt(k,328))*y(k,127) + rxt(k,337)*y(k,130) + mat(k,996) = rxt(k,469)*y(k,28) + rxt(k,423)*y(k,52) + rxt(k,418)*y(k,69) & + + rxt(k,419)*y(k,72) + rxt(k,417)*y(k,99) + mat(k,1890) = mat(k,1890) + rxt(k,351)*y(k,28) + rxt(k,360)*y(k,69) + mat(k,2081) = (rxt(k,327)+rxt(k,328))*y(k,127) + rxt(k,337)*y(k,130) + mat(k,1934) = -(rxt(k,132)*y(k,95) + rxt(k,134)*y(k,96) + rxt(k,292)*y(k,109) & + + rxt(k,302)*y(k,111) + rxt(k,323)*y(k,125) + rxt(k,332) & + *y(k,128) + rxt(k,348)*y(k,132) + rxt(k,363)*y(k,133) + rxt(k,394) & + *y(k,70) + rxt(k,403)*y(k,69) + rxt(k,413)*y(k,99) + rxt(k,414) & + *y(k,40) + rxt(k,419)*y(k,131) + rxt(k,432)*y(k,63) + rxt(k,440) & + *y(k,62) + rxt(k,456)*y(k,25) + rxt(k,488)*y(k,3) + rxt(k,547) & + *y(k,77) + rxt(k,553)*y(k,79)) + mat(k,855) = -rxt(k,132)*y(k,72) + mat(k,1075) = -rxt(k,134)*y(k,72) + mat(k,943) = -rxt(k,292)*y(k,72) + mat(k,881) = -rxt(k,302)*y(k,72) + mat(k,1552) = -rxt(k,323)*y(k,72) + mat(k,604) = -rxt(k,332)*y(k,72) + mat(k,1857) = -rxt(k,348)*y(k,72) + mat(k,1893) = -rxt(k,363)*y(k,72) + mat(k,802) = -rxt(k,394)*y(k,72) + mat(k,1307) = -rxt(k,403)*y(k,72) + mat(k,915) = -rxt(k,413)*y(k,72) + mat(k,1385) = -rxt(k,414)*y(k,72) + mat(k,999) = -rxt(k,419)*y(k,72) + mat(k,1645) = -rxt(k,432)*y(k,72) + mat(k,1730) = -rxt(k,440)*y(k,72) + mat(k,2024) = -rxt(k,456)*y(k,72) + mat(k,588) = -rxt(k,488)*y(k,72) + mat(k,274) = -rxt(k,547)*y(k,72) + mat(k,498) = -rxt(k,553)*y(k,72) + mat(k,1645) = mat(k,1645) + rxt(k,278)*y(k,128) + mat(k,1307) = mat(k,1307) + rxt(k,405)*y(k,71) + rxt(k,324)*y(k,125) & + + rxt(k,338)*y(k,130) + mat(k,1824) = rxt(k,405)*y(k,69) + mat(k,381) = rxt(k,361)*y(k,133) + mat(k,1552) = mat(k,1552) + rxt(k,324)*y(k,69) + mat(k,604) = mat(k,604) + rxt(k,278)*y(k,63) + mat(k,468) = rxt(k,338)*y(k,69) + mat(k,1893) = mat(k,1893) + rxt(k,361)*y(k,123) + mat(k,131) = -(rxt(k,554)*y(k,79)) + mat(k,484) = -rxt(k,554)*y(k,73) + mat(k,706) = rxt(k,490)*y(k,28) + mat(k,1737) = rxt(k,490)*y(k,5) + 2.000_r8*rxt(k,460)*y(k,28) + mat(k,136) = -(rxt(k,543)*y(k,69) + rxt(k,544)*y(k,131)) + mat(k,1252) = -rxt(k,543)*y(k,74) + mat(k,954) = -rxt(k,544)*y(k,74) + mat(k,268) = -(rxt(k,545)*y(k,71) + rxt(k,547)*y(k,72) + rxt(k,550)*y(k,131)) + mat(k,1784) = -rxt(k,545)*y(k,77) + mat(k,1898) = -rxt(k,547)*y(k,77) + mat(k,963) = -rxt(k,550)*y(k,77) + mat(k,487) = -(rxt(k,548)*y(k,5) + rxt(k,549)*y(k,28) + rxt(k,551)*y(k,63) & + + rxt(k,552)*y(k,71) + rxt(k,553)*y(k,72) + rxt(k,554)*y(k,73) & + + rxt(k,555)*y(k,131)) + mat(k,710) = -rxt(k,548)*y(k,79) + mat(k,1743) = -rxt(k,549)*y(k,79) + mat(k,1609) = -rxt(k,551)*y(k,79) + mat(k,1792) = -rxt(k,552)*y(k,79) + mat(k,1902) = -rxt(k,553)*y(k,79) + mat(k,133) = -rxt(k,554)*y(k,79) + mat(k,974) = -rxt(k,555)*y(k,79) + mat(k,1273) = rxt(k,543)*y(k,74) + mat(k,1792) = mat(k,1792) + rxt(k,545)*y(k,77) + mat(k,1902) = mat(k,1902) + rxt(k,547)*y(k,77) + mat(k,140) = rxt(k,543)*y(k,69) + mat(k,269) = rxt(k,545)*y(k,71) + rxt(k,547)*y(k,72) + rxt(k,550)*y(k,131) + mat(k,974) = mat(k,974) + rxt(k,550)*y(k,77) end do - end subroutine nlnmat03 - subroutine nlnmat04( avec_len, mat, y, rxt ) + end subroutine nlnmat05 + subroutine nlnmat06( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -852,215 +1263,217 @@ subroutine nlnmat04( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,1202) = -(rxt(k,132)*y(k,94) + rxt(k,134)*y(k,95) + rxt(k,292)*y(k,108) & - + rxt(k,302)*y(k,110) + rxt(k,323)*y(k,125) + rxt(k,332) & - *y(k,128) + rxt(k,348)*y(k,132) + rxt(k,363)*y(k,133) + rxt(k,394) & - *y(k,122) + rxt(k,403)*y(k,67) + rxt(k,413)*y(k,98) + rxt(k,414) & - *y(k,38) + rxt(k,419)*y(k,131) + rxt(k,432)*y(k,61) + rxt(k,440) & - *y(k,60) + rxt(k,456)*y(k,86) + rxt(k,488)*y(k,85) + rxt(k,545) & - *y(k,74) + rxt(k,551)*y(k,76)) - mat(k,673) = -rxt(k,132)*y(k,69) - mat(k,1553) = -rxt(k,134)*y(k,69) - mat(k,860) = -rxt(k,292)*y(k,69) - mat(k,722) = -rxt(k,302)*y(k,69) - mat(k,1325) = -rxt(k,323)*y(k,69) - mat(k,443) = -rxt(k,332)*y(k,69) - mat(k,1627) = -rxt(k,348)*y(k,69) - mat(k,1662) = -rxt(k,363)*y(k,69) - mat(k,644) = -rxt(k,394)*y(k,69) - mat(k,1428) = -rxt(k,403)*y(k,69) - mat(k,754) = -rxt(k,413)*y(k,69) - mat(k,1783) = -rxt(k,414)*y(k,69) - mat(k,801) = -rxt(k,419)*y(k,69) - mat(k,995) = -rxt(k,432)*y(k,69) - mat(k,1511) = -rxt(k,440)*y(k,69) - mat(k,1470) = -rxt(k,456)*y(k,69) - mat(k,460) = -rxt(k,488)*y(k,69) - mat(k,171) = -rxt(k,545)*y(k,69) - mat(k,385) = -rxt(k,551)*y(k,69) - mat(k,995) = mat(k,995) + rxt(k,278)*y(k,128) - mat(k,1428) = mat(k,1428) + rxt(k,405)*y(k,68) + rxt(k,324)*y(k,125) & - + rxt(k,338)*y(k,130) - mat(k,1251) = rxt(k,405)*y(k,67) - mat(k,248) = rxt(k,361)*y(k,133) - mat(k,1325) = mat(k,1325) + rxt(k,324)*y(k,67) - mat(k,443) = mat(k,443) + rxt(k,278)*y(k,61) - mat(k,353) = rxt(k,338)*y(k,67) - mat(k,1662) = mat(k,1662) + rxt(k,361)*y(k,123) - mat(k,64) = -(rxt(k,552)*y(k,76)) - mat(k,376) = -rxt(k,552)*y(k,70) - mat(k,578) = rxt(k,490)*y(k,26) - mat(k,1723) = rxt(k,490)*y(k,4) + 2.000_r8*rxt(k,460)*y(k,26) - mat(k,69) = -(rxt(k,542)*y(k,67) + rxt(k,543)*y(k,131)) - mat(k,1386) = -rxt(k,542)*y(k,71) - mat(k,772) = -rxt(k,543)*y(k,71) - mat(k,168) = -(rxt(k,544)*y(k,68) + rxt(k,545)*y(k,69) + rxt(k,548)*y(k,131)) - mat(k,1223) = -rxt(k,544)*y(k,74) - mat(k,1178) = -rxt(k,545)*y(k,74) - mat(k,777) = -rxt(k,548)*y(k,74) - mat(k,379) = -(rxt(k,546)*y(k,4) + rxt(k,547)*y(k,26) + rxt(k,549)*y(k,61) & - + rxt(k,550)*y(k,68) + rxt(k,551)*y(k,69) + rxt(k,552)*y(k,70) & - + rxt(k,553)*y(k,131)) - mat(k,582) = -rxt(k,546)*y(k,76) - mat(k,1729) = -rxt(k,547)*y(k,76) - mat(k,972) = -rxt(k,549)*y(k,76) - mat(k,1231) = -rxt(k,550)*y(k,76) - mat(k,1182) = -rxt(k,551)*y(k,76) - mat(k,66) = -rxt(k,552)*y(k,76) - mat(k,787) = -rxt(k,553)*y(k,76) - mat(k,1407) = rxt(k,542)*y(k,71) - mat(k,1231) = mat(k,1231) + rxt(k,544)*y(k,74) - mat(k,1182) = mat(k,1182) + rxt(k,545)*y(k,74) - mat(k,73) = rxt(k,542)*y(k,67) - mat(k,169) = rxt(k,544)*y(k,68) + rxt(k,545)*y(k,69) + rxt(k,548)*y(k,131) - mat(k,787) = mat(k,787) + rxt(k,548)*y(k,74) - mat(k,255) = -(rxt(k,554)*y(k,131)) - mat(k,783) = -rxt(k,554)*y(k,77) - mat(k,581) = rxt(k,546)*y(k,76) - mat(k,1725) = rxt(k,547)*y(k,76) - mat(k,59) = rxt(k,556)*y(k,62) + (rxt(k,557)+.500_r8*rxt(k,558))*y(k,131) - mat(k,968) = rxt(k,549)*y(k,76) - mat(k,1096) = rxt(k,556)*y(k,33) - mat(k,1227) = rxt(k,550)*y(k,76) - mat(k,1180) = rxt(k,551)*y(k,76) - mat(k,65) = rxt(k,552)*y(k,76) - mat(k,72) = rxt(k,543)*y(k,131) - mat(k,378) = rxt(k,546)*y(k,4) + rxt(k,547)*y(k,26) + rxt(k,549)*y(k,61) & - + rxt(k,550)*y(k,68) + rxt(k,551)*y(k,69) + rxt(k,552)*y(k,70) & - + rxt(k,553)*y(k,131) - mat(k,783) = mat(k,783) + (rxt(k,557)+.500_r8*rxt(k,558))*y(k,33) & - + rxt(k,543)*y(k,71) + rxt(k,553)*y(k,76) - mat(k,46) = -(rxt(k,555)*y(k,137)) - mat(k,1801) = -rxt(k,555)*y(k,78) - mat(k,254) = rxt(k,554)*y(k,131) - mat(k,770) = rxt(k,554)*y(k,77) - mat(k,454) = -(rxt(k,486)*y(k,16) + rxt(k,487)*y(k,98) + rxt(k,488)*y(k,69)) - mat(k,603) = -rxt(k,486)*y(k,85) - mat(k,742) = -rxt(k,487)*y(k,85) - mat(k,1184) = -rxt(k,488)*y(k,85) - mat(k,583) = 4.000_r8*rxt(k,489)*y(k,4) + (rxt(k,490)+rxt(k,491))*y(k,26) & - + rxt(k,494)*y(k,60) + rxt(k,497)*y(k,67) + rxt(k,546)*y(k,76) & - + rxt(k,498)*y(k,131) - mat(k,1730) = (rxt(k,490)+rxt(k,491))*y(k,4) - mat(k,239) = rxt(k,499)*y(k,67) + rxt(k,505)*y(k,122) + rxt(k,500)*y(k,131) - mat(k,1492) = rxt(k,494)*y(k,4) - mat(k,1409) = rxt(k,497)*y(k,4) + rxt(k,499)*y(k,43) - mat(k,380) = rxt(k,546)*y(k,4) - mat(k,633) = rxt(k,505)*y(k,43) - mat(k,788) = rxt(k,498)*y(k,4) + rxt(k,500)*y(k,43) - mat(k,1476) = -((rxt(k,114) + rxt(k,115)) * y(k,91) + rxt(k,127)*y(k,94) & - + rxt(k,285)*y(k,108) + rxt(k,314)*y(k,125) + rxt(k,341) & - *y(k,132) + rxt(k,350)*y(k,133) + rxt(k,450)*y(k,16) + rxt(k,452) & - *y(k,39) + rxt(k,453)*y(k,41) + (rxt(k,454) + rxt(k,455) & - ) * y(k,98) + rxt(k,456)*y(k,69) + rxt(k,463)*y(k,27) + rxt(k,472) & - *y(k,52)) - mat(k,837) = -(rxt(k,114) + rxt(k,115)) * y(k,86) - mat(k,678) = -rxt(k,127)*y(k,86) - mat(k,866) = -rxt(k,285)*y(k,86) - mat(k,1331) = -rxt(k,314)*y(k,86) - mat(k,1633) = -rxt(k,341)*y(k,86) - mat(k,1668) = -rxt(k,350)*y(k,86) - mat(k,617) = -rxt(k,450)*y(k,86) - mat(k,495) = -rxt(k,452)*y(k,86) - mat(k,151) = -rxt(k,453)*y(k,86) - mat(k,760) = -(rxt(k,454) + rxt(k,455)) * y(k,86) - mat(k,1208) = -rxt(k,456)*y(k,86) - mat(k,284) = -rxt(k,463)*y(k,86) - mat(k,235) = -rxt(k,472)*y(k,86) - mat(k,596) = rxt(k,491)*y(k,26) - mat(k,330) = rxt(k,457)*y(k,26) - mat(k,1754) = rxt(k,491)*y(k,4) + rxt(k,457)*y(k,20) + (4.000_r8*rxt(k,458) & - +2.000_r8*rxt(k,460))*y(k,26) + rxt(k,462)*y(k,60) + rxt(k,467) & - *y(k,67) + rxt(k,547)*y(k,76) + rxt(k,468)*y(k,131) - mat(k,35) = rxt(k,512)*y(k,122) - mat(k,1167) = rxt(k,470)*y(k,67) + rxt(k,482)*y(k,122) + rxt(k,471)*y(k,131) - mat(k,1517) = rxt(k,462)*y(k,26) + rxt(k,111)*y(k,90) - mat(k,1001) = rxt(k,110)*y(k,87) - mat(k,1434) = rxt(k,467)*y(k,26) + rxt(k,470)*y(k,47) - mat(k,388) = rxt(k,547)*y(k,26) - mat(k,702) = rxt(k,110)*y(k,61) + rxt(k,195)*y(k,100) + rxt(k,147)*y(k,102) & - + rxt(k,177)*y(k,104) + rxt(k,248)*y(k,115) + rxt(k,230) & - *y(k,116) + rxt(k,212)*y(k,119) + rxt(k,154)*y(k,126) - mat(k,418) = rxt(k,199)*y(k,100) + rxt(k,164)*y(k,102) + rxt(k,182)*y(k,104) & - + rxt(k,252)*y(k,115) + rxt(k,234)*y(k,116) + rxt(k,217) & - *y(k,119) + rxt(k,159)*y(k,126) - mat(k,402) = rxt(k,187)*y(k,100) + rxt(k,181)*y(k,102) + rxt(k,169)*y(k,104) & - + rxt(k,240)*y(k,115) + rxt(k,222)*y(k,116) + rxt(k,205) & - *y(k,119) + rxt(k,257)*y(k,126) - mat(k,293) = rxt(k,111)*y(k,60) - mat(k,1043) = rxt(k,195)*y(k,87) + rxt(k,199)*y(k,88) + rxt(k,187)*y(k,89) - mat(k,1710) = rxt(k,147)*y(k,87) + rxt(k,164)*y(k,88) + rxt(k,181)*y(k,89) - mat(k,1601) = rxt(k,177)*y(k,87) + rxt(k,182)*y(k,88) + rxt(k,169)*y(k,89) - mat(k,913) = rxt(k,248)*y(k,87) + rxt(k,252)*y(k,88) + rxt(k,240)*y(k,89) - mat(k,955) = rxt(k,230)*y(k,87) + rxt(k,234)*y(k,88) + rxt(k,222)*y(k,89) - mat(k,1084) = rxt(k,212)*y(k,87) + rxt(k,217)*y(k,88) + rxt(k,205)*y(k,89) - mat(k,650) = rxt(k,512)*y(k,32) + rxt(k,482)*y(k,47) - mat(k,1375) = rxt(k,154)*y(k,87) + rxt(k,159)*y(k,88) + rxt(k,257)*y(k,89) - mat(k,807) = rxt(k,468)*y(k,26) + rxt(k,471)*y(k,47) - mat(k,690) = -(rxt(k,105)*y(k,38) + rxt(k,107)*y(k,137) + rxt(k,108)*y(k,47) & - + rxt(k,109)*y(k,49) + rxt(k,110)*y(k,61) + rxt(k,147)*y(k,102) & - + rxt(k,154)*y(k,126) + rxt(k,177)*y(k,104) + rxt(k,195) & - *y(k,100) + rxt(k,212)*y(k,119) + rxt(k,230)*y(k,116) + rxt(k,248) & - *y(k,115)) - mat(k,1770) = -rxt(k,105)*y(k,87) - mat(k,1828) = -rxt(k,107)*y(k,87) - mat(k,1148) = -rxt(k,108)*y(k,87) - mat(k,1277) = -rxt(k,109)*y(k,87) - mat(k,982) = -rxt(k,110)*y(k,87) - mat(k,1691) = -rxt(k,147)*y(k,87) - mat(k,1356) = -rxt(k,154)*y(k,87) - mat(k,1582) = -rxt(k,177)*y(k,87) - mat(k,1024) = -rxt(k,195)*y(k,87) - mat(k,1065) = -rxt(k,212)*y(k,87) - mat(k,936) = -rxt(k,230)*y(k,87) - mat(k,894) = -rxt(k,248)*y(k,87) - mat(k,1735) = rxt(k,116)*y(k,91) + rxt(k,286)*y(k,108) + rxt(k,351)*y(k,133) - mat(k,1148) = mat(k,1148) + rxt(k,130)*y(k,94) + rxt(k,289)*y(k,108) & - + rxt(k,298)*y(k,110) + rxt(k,318)*y(k,125) + rxt(k,345) & - *y(k,132) + rxt(k,356)*y(k,133) - mat(k,1498) = rxt(k,112)*y(k,90) - mat(k,1415) = rxt(k,113)*y(k,90) - mat(k,1457) = rxt(k,114)*y(k,91) + rxt(k,127)*y(k,94) + rxt(k,285)*y(k,108) & + mat(k,348) = -(rxt(k,546)*y(k,131)) + mat(k,969) = -rxt(k,546)*y(k,80) + mat(k,709) = rxt(k,548)*y(k,79) + mat(k,1739) = rxt(k,549)*y(k,79) + mat(k,123) = rxt(k,541)*y(k,64) + (rxt(k,542)+.500_r8*rxt(k,556))*y(k,131) + mat(k,1605) = rxt(k,551)*y(k,79) + mat(k,1081) = rxt(k,541)*y(k,35) + mat(k,1787) = rxt(k,552)*y(k,79) + mat(k,1899) = rxt(k,553)*y(k,79) + mat(k,132) = rxt(k,554)*y(k,79) + mat(k,139) = rxt(k,544)*y(k,131) + mat(k,486) = rxt(k,548)*y(k,5) + rxt(k,549)*y(k,28) + rxt(k,551)*y(k,63) & + + rxt(k,552)*y(k,71) + rxt(k,553)*y(k,72) + rxt(k,554)*y(k,73) & + + rxt(k,555)*y(k,131) + mat(k,969) = mat(k,969) + (rxt(k,542)+.500_r8*rxt(k,556))*y(k,35) & + + rxt(k,544)*y(k,74) + rxt(k,555)*y(k,79) + mat(k,100) = -(rxt(k,557)*y(k,137)) + mat(k,2029) = -rxt(k,557)*y(k,81) + mat(k,347) = rxt(k,546)*y(k,131) + mat(k,951) = rxt(k,546)*y(k,80) + mat(k,808) = -(rxt(k,105)*y(k,40) + rxt(k,107)*y(k,137) + rxt(k,108)*y(k,49) & + + rxt(k,109)*y(k,51) + rxt(k,110)*y(k,63) + rxt(k,147)*y(k,103) & + + rxt(k,154)*y(k,126) + rxt(k,177)*y(k,105) + rxt(k,195) & + *y(k,101) + rxt(k,212)*y(k,120) + rxt(k,230)*y(k,117) + rxt(k,248) & + *y(k,116)) + mat(k,1358) = -rxt(k,105)*y(k,88) + mat(k,2058) = -rxt(k,107)*y(k,88) + mat(k,1489) = -rxt(k,108)*y(k,88) + mat(k,1221) = -rxt(k,109)*y(k,88) + mat(k,1619) = -rxt(k,110)*y(k,88) + mat(k,1661) = -rxt(k,147)*y(k,88) + mat(k,1570) = -rxt(k,154)*y(k,88) + mat(k,1401) = -rxt(k,177)*y(k,88) + mat(k,1444) = -rxt(k,195)*y(k,88) + mat(k,1322) = -rxt(k,212)*y(k,88) + mat(k,1179) = -rxt(k,230)*y(k,88) + mat(k,1136) = -rxt(k,248)*y(k,88) + mat(k,1997) = rxt(k,114)*y(k,92) + rxt(k,127)*y(k,95) + rxt(k,285)*y(k,109) & + rxt(k,314)*y(k,125) + rxt(k,341)*y(k,132) + rxt(k,350) & *y(k,133) - mat(k,288) = rxt(k,112)*y(k,60) + rxt(k,113)*y(k,67) - mat(k,819) = rxt(k,116)*y(k,26) + rxt(k,114)*y(k,86) - mat(k,661) = rxt(k,130)*y(k,47) + rxt(k,127)*y(k,86) - mat(k,849) = rxt(k,286)*y(k,26) + rxt(k,289)*y(k,47) + rxt(k,285)*y(k,86) - mat(k,712) = rxt(k,298)*y(k,47) - mat(k,1312) = rxt(k,318)*y(k,47) + rxt(k,314)*y(k,86) - mat(k,1614) = rxt(k,345)*y(k,47) + rxt(k,341)*y(k,86) - mat(k,1649) = rxt(k,351)*y(k,26) + rxt(k,356)*y(k,47) + rxt(k,350)*y(k,86) - mat(k,409) = -(rxt(k,106)*y(k,47) + rxt(k,159)*y(k,126) + rxt(k,164)*y(k,102) & - + rxt(k,182)*y(k,104) + rxt(k,199)*y(k,100) + rxt(k,217) & - *y(k,119) + rxt(k,234)*y(k,116) + rxt(k,252)*y(k,115)) - mat(k,1140) = -rxt(k,106)*y(k,88) - mat(k,1347) = -rxt(k,159)*y(k,88) - mat(k,1683) = -rxt(k,164)*y(k,88) - mat(k,1574) = -rxt(k,182)*y(k,88) - mat(k,1016) = -rxt(k,199)*y(k,88) - mat(k,1057) = -rxt(k,217)*y(k,88) - mat(k,928) = -rxt(k,234)*y(k,88) - mat(k,885) = -rxt(k,252)*y(k,88) - mat(k,689) = rxt(k,107)*y(k,137) - mat(k,1818) = rxt(k,107)*y(k,87) - mat(k,393) = -((rxt(k,169) + rxt(k,268)) * y(k,104) + (rxt(k,181) + rxt(k,267) & - ) * y(k,102) + rxt(k,187)*y(k,100) + rxt(k,205)*y(k,119) & - + rxt(k,222)*y(k,116) + rxt(k,240)*y(k,115) + rxt(k,257) & + mat(k,1748) = rxt(k,116)*y(k,92) + rxt(k,286)*y(k,109) + rxt(k,351)*y(k,133) + mat(k,1489) = mat(k,1489) + rxt(k,130)*y(k,95) + rxt(k,289)*y(k,109) & + + rxt(k,298)*y(k,111) + rxt(k,318)*y(k,125) + rxt(k,345) & + *y(k,132) + rxt(k,356)*y(k,133) + mat(k,1704) = rxt(k,112)*y(k,91) + mat(k,1280) = rxt(k,113)*y(k,91) + mat(k,367) = rxt(k,112)*y(k,62) + rxt(k,113)*y(k,69) + mat(k,1007) = rxt(k,114)*y(k,25) + rxt(k,116)*y(k,28) + mat(k,829) = rxt(k,127)*y(k,25) + rxt(k,130)*y(k,49) + mat(k,921) = rxt(k,285)*y(k,25) + rxt(k,286)*y(k,28) + rxt(k,289)*y(k,49) + mat(k,862) = rxt(k,298)*y(k,49) + mat(k,1525) = rxt(k,314)*y(k,25) + rxt(k,318)*y(k,49) + mat(k,1831) = rxt(k,341)*y(k,25) + rxt(k,345)*y(k,49) + mat(k,1867) = rxt(k,350)*y(k,25) + rxt(k,351)*y(k,28) + rxt(k,356)*y(k,49) + mat(k,532) = -(rxt(k,106)*y(k,49) + rxt(k,159)*y(k,126) + rxt(k,164)*y(k,103) & + + rxt(k,182)*y(k,105) + rxt(k,199)*y(k,101) + rxt(k,217) & + *y(k,120) + rxt(k,234)*y(k,117) + rxt(k,252)*y(k,116)) + mat(k,1482) = -rxt(k,106)*y(k,89) + mat(k,1562) = -rxt(k,159)*y(k,89) + mat(k,1654) = -rxt(k,164)*y(k,89) + mat(k,1394) = -rxt(k,182)*y(k,89) + mat(k,1437) = -rxt(k,199)*y(k,89) + mat(k,1315) = -rxt(k,217)*y(k,89) + mat(k,1172) = -rxt(k,234)*y(k,89) + mat(k,1128) = -rxt(k,252)*y(k,89) + mat(k,807) = rxt(k,107)*y(k,137) + mat(k,2048) = rxt(k,107)*y(k,88) + mat(k,516) = -((rxt(k,169) + rxt(k,268)) * y(k,105) + (rxt(k,181) + rxt(k,267) & + ) * y(k,103) + rxt(k,187)*y(k,101) + rxt(k,205)*y(k,120) & + + rxt(k,222)*y(k,117) + rxt(k,240)*y(k,116) + rxt(k,257) & *y(k,126)) - mat(k,1573) = -(rxt(k,169) + rxt(k,268)) * y(k,89) - mat(k,1682) = -(rxt(k,181) + rxt(k,267)) * y(k,89) - mat(k,1015) = -rxt(k,187)*y(k,89) - mat(k,1056) = -rxt(k,205)*y(k,89) - mat(k,927) = -rxt(k,222)*y(k,89) - mat(k,884) = -rxt(k,240)*y(k,89) - mat(k,1346) = -rxt(k,257)*y(k,89) - mat(k,1139) = rxt(k,108)*y(k,87) + rxt(k,106)*y(k,88) - mat(k,688) = rxt(k,108)*y(k,47) - mat(k,408) = rxt(k,106)*y(k,47) + mat(k,1393) = -(rxt(k,169) + rxt(k,268)) * y(k,90) + mat(k,1653) = -(rxt(k,181) + rxt(k,267)) * y(k,90) + mat(k,1436) = -rxt(k,187)*y(k,90) + mat(k,1314) = -rxt(k,205)*y(k,90) + mat(k,1171) = -rxt(k,222)*y(k,90) + mat(k,1127) = -rxt(k,240)*y(k,90) + mat(k,1561) = -rxt(k,257)*y(k,90) + mat(k,1481) = rxt(k,108)*y(k,88) + rxt(k,106)*y(k,89) + mat(k,806) = rxt(k,108)*y(k,49) + mat(k,531) = rxt(k,106)*y(k,49) + mat(k,366) = -((rxt(k,111) + rxt(k,112)) * y(k,62) + rxt(k,113)*y(k,69)) + mat(k,1693) = -(rxt(k,111) + rxt(k,112)) * y(k,91) + mat(k,1268) = -rxt(k,113)*y(k,91) + mat(k,1989) = rxt(k,115)*y(k,92) + mat(k,1741) = rxt(k,128)*y(k,95) + rxt(k,315)*y(k,125) + rxt(k,342)*y(k,132) + mat(k,1003) = rxt(k,115)*y(k,25) + mat(k,827) = rxt(k,128)*y(k,28) + mat(k,1521) = rxt(k,315)*y(k,28) + mat(k,1828) = rxt(k,342)*y(k,28) + mat(k,1011) = -((rxt(k,114) + rxt(k,115)) * y(k,25) + rxt(k,116)*y(k,28) & + + rxt(k,117)*y(k,40) + rxt(k,119)*y(k,137) + rxt(k,124)*y(k,51) & + + rxt(k,125)*y(k,69) + rxt(k,126)*y(k,71) + (rxt(k,168) & + + rxt(k,265)) * y(k,105) + (rxt(k,170) + rxt(k,258)) * y(k,103) & + + rxt(k,186)*y(k,101) + rxt(k,204)*y(k,120) + rxt(k,221) & + *y(k,117) + rxt(k,239)*y(k,116) + rxt(k,256)*y(k,126) + rxt(k,280) & + *y(k,62) + rxt(k,281)*y(k,63)) + mat(k,2003) = -(rxt(k,114) + rxt(k,115)) * y(k,92) + mat(k,1754) = -rxt(k,116)*y(k,92) + mat(k,1364) = -rxt(k,117)*y(k,92) + mat(k,2063) = -rxt(k,119)*y(k,92) + mat(k,1226) = -rxt(k,124)*y(k,92) + mat(k,1286) = -rxt(k,125)*y(k,92) + mat(k,1803) = -rxt(k,126)*y(k,92) + mat(k,1407) = -(rxt(k,168) + rxt(k,265)) * y(k,92) + mat(k,1667) = -(rxt(k,170) + rxt(k,258)) * y(k,92) + mat(k,1450) = -rxt(k,186)*y(k,92) + mat(k,1328) = -rxt(k,204)*y(k,92) + mat(k,1185) = -rxt(k,221)*y(k,92) + mat(k,1142) = -rxt(k,239)*y(k,92) + mat(k,1576) = -rxt(k,256)*y(k,92) + mat(k,1709) = -rxt(k,280)*y(k,92) + mat(k,1624) = -rxt(k,281)*y(k,92) + mat(k,1955) = rxt(k,330)*y(k,128) + rxt(k,352)*y(k,133) + mat(k,1364) = mat(k,1364) + rxt(k,129)*y(k,95) + mat(k,1286) = mat(k,1286) + rxt(k,131)*y(k,95) + mat(k,835) = rxt(k,129)*y(k,40) + rxt(k,131)*y(k,69) + mat(k,594) = rxt(k,330)*y(k,32) + mat(k,1872) = rxt(k,352)*y(k,32) + mat(k,501) = -(rxt(k,153)*y(k,126) + (rxt(k,176) + rxt(k,259)) * y(k,105) & + + rxt(k,194)*y(k,101) + rxt(k,211)*y(k,120) + rxt(k,229) & + *y(k,117) + rxt(k,246)*y(k,116) + (rxt(k,247) + rxt(k,271) & + ) * y(k,103)) + mat(k,1560) = -rxt(k,153)*y(k,93) + mat(k,1392) = -(rxt(k,176) + rxt(k,259)) * y(k,93) + mat(k,1435) = -rxt(k,194)*y(k,93) + mat(k,1313) = -rxt(k,211)*y(k,93) + mat(k,1170) = -rxt(k,229)*y(k,93) + mat(k,1126) = -rxt(k,246)*y(k,93) + mat(k,1652) = -(rxt(k,247) + rxt(k,271)) * y(k,93) + mat(k,664) = rxt(k,118)*y(k,137) + mat(k,2047) = rxt(k,118)*y(k,94) + mat(k,666) = -(rxt(k,118)*y(k,137) + (rxt(k,120) + rxt(k,121)) * y(k,63) & + + (rxt(k,122) + rxt(k,123)) * y(k,62) + rxt(k,155)*y(k,126) & + + (rxt(k,158) + rxt(k,260)) * y(k,103) + (rxt(k,178) + rxt(k,261) & + ) * y(k,105) + rxt(k,196)*y(k,101) + rxt(k,213)*y(k,120) & + + rxt(k,231)*y(k,117) + rxt(k,249)*y(k,116)) + mat(k,2053) = -rxt(k,118)*y(k,94) + mat(k,1614) = -(rxt(k,120) + rxt(k,121)) * y(k,94) + mat(k,1699) = -(rxt(k,122) + rxt(k,123)) * y(k,94) + mat(k,1567) = -rxt(k,155)*y(k,94) + mat(k,1659) = -(rxt(k,158) + rxt(k,260)) * y(k,94) + mat(k,1399) = -(rxt(k,178) + rxt(k,261)) * y(k,94) + mat(k,1442) = -rxt(k,196)*y(k,94) + mat(k,1320) = -rxt(k,213)*y(k,94) + mat(k,1177) = -rxt(k,231)*y(k,94) + mat(k,1133) = -rxt(k,249)*y(k,94) + mat(k,1005) = rxt(k,119)*y(k,137) + mat(k,2053) = mat(k,2053) + rxt(k,119)*y(k,92) + mat(k,830) = -(rxt(k,127)*y(k,25) + rxt(k,128)*y(k,28) + rxt(k,129)*y(k,40) & + + rxt(k,130)*y(k,49) + rxt(k,131)*y(k,69) + rxt(k,132)*y(k,72) & + + rxt(k,151)*y(k,126) + rxt(k,174)*y(k,105) + rxt(k,191) & + *y(k,101) + rxt(k,209)*y(k,120) + rxt(k,225)*y(k,103) + rxt(k,227) & + *y(k,117) + rxt(k,244)*y(k,116)) + mat(k,1998) = -rxt(k,127)*y(k,95) + mat(k,1749) = -rxt(k,128)*y(k,95) + mat(k,1359) = -rxt(k,129)*y(k,95) + mat(k,1490) = -rxt(k,130)*y(k,95) + mat(k,1281) = -rxt(k,131)*y(k,95) + mat(k,1908) = -rxt(k,132)*y(k,95) + mat(k,1571) = -rxt(k,151)*y(k,95) + mat(k,1402) = -rxt(k,174)*y(k,95) + mat(k,1445) = -rxt(k,191)*y(k,95) + mat(k,1323) = -rxt(k,209)*y(k,95) + mat(k,1662) = -rxt(k,225)*y(k,95) + mat(k,1180) = -rxt(k,227)*y(k,95) + mat(k,1137) = -rxt(k,244)*y(k,95) + mat(k,1950) = rxt(k,316)*y(k,125) + rxt(k,335)*y(k,129) + mat(k,1526) = rxt(k,316)*y(k,32) + mat(k,238) = rxt(k,335)*y(k,32) + mat(k,1055) = -((rxt(k,133) + rxt(k,135)) * y(k,71) + rxt(k,134)*y(k,72) & + + rxt(k,138)*y(k,97) + rxt(k,141)*y(k,103) + rxt(k,144)*y(k,105) & + + rxt(k,303)*y(k,117) + rxt(k,304)*y(k,118) + rxt(k,306) & + *y(k,119) + rxt(k,308)*y(k,120) + rxt(k,326)*y(k,127) + rxt(k,380) & + *y(k,130) + rxt(k,381)*y(k,106) + rxt(k,382)*y(k,100) + rxt(k,383) & + *y(k,101) + rxt(k,384)*y(k,121) + rxt(k,582)*y(k,116) + rxt(k,583) & + *y(k,126) + rxt(k,584)*y(k,108)) + mat(k,1804) = -(rxt(k,133) + rxt(k,135)) * y(k,96) + mat(k,1914) = -rxt(k,134)*y(k,96) + mat(k,167) = -rxt(k,138)*y(k,96) + mat(k,1668) = -rxt(k,141)*y(k,96) + mat(k,1408) = -rxt(k,144)*y(k,96) + mat(k,1186) = -rxt(k,303)*y(k,96) + mat(k,172) = -rxt(k,304)*y(k,96) + mat(k,262) = -rxt(k,306)*y(k,96) + mat(k,1329) = -rxt(k,308)*y(k,96) + mat(k,291) = -rxt(k,326)*y(k,96) + mat(k,460) = -rxt(k,380)*y(k,96) + mat(k,282) = -rxt(k,381)*y(k,96) + mat(k,245) = -rxt(k,382)*y(k,96) + mat(k,1451) = -rxt(k,383)*y(k,96) + mat(k,255) = -rxt(k,384)*y(k,96) + mat(k,1143) = -rxt(k,582)*y(k,96) + mat(k,1577) = -rxt(k,583)*y(k,96) + mat(k,231) = -rxt(k,584)*y(k,96) + mat(k,1365) = rxt(k,105)*y(k,88) + rxt(k,317)*y(k,125) + rxt(k,344)*y(k,132) + mat(k,649) = rxt(k,353)*y(k,133) + mat(k,1710) = rxt(k,136)*y(k,133) + mat(k,1287) = rxt(k,324)*y(k,125) + rxt(k,333)*y(k,128) + rxt(k,347)*y(k,132) & + + rxt(k,360)*y(k,133) + mat(k,1914) = mat(k,1914) + rxt(k,332)*y(k,128) + mat(k,811) = rxt(k,105)*y(k,40) + mat(k,376) = rxt(k,321)*y(k,125) + rxt(k,361)*y(k,133) + mat(k,1532) = rxt(k,317)*y(k,40) + rxt(k,324)*y(k,69) + rxt(k,321)*y(k,123) + mat(k,595) = rxt(k,333)*y(k,69) + rxt(k,332)*y(k,72) + mat(k,1837) = rxt(k,344)*y(k,40) + rxt(k,347)*y(k,69) + mat(k,1873) = rxt(k,353)*y(k,41) + rxt(k,136)*y(k,62) + rxt(k,360)*y(k,69) & + + rxt(k,361)*y(k,123) end do - end subroutine nlnmat04 - subroutine nlnmat05( avec_len, mat, y, rxt ) + end subroutine nlnmat06 + subroutine nlnmat07( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -1078,223 +1491,238 @@ subroutine nlnmat05( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,287) = -((rxt(k,111) + rxt(k,112)) * y(k,60) + rxt(k,113)*y(k,67)) - mat(k,1487) = -(rxt(k,111) + rxt(k,112)) * y(k,90) - mat(k,1404) = -rxt(k,113)*y(k,90) - mat(k,1727) = rxt(k,128)*y(k,94) + rxt(k,315)*y(k,125) + rxt(k,342)*y(k,132) - mat(k,1449) = rxt(k,115)*y(k,91) - mat(k,815) = rxt(k,115)*y(k,86) - mat(k,658) = rxt(k,128)*y(k,26) - mat(k,1308) = rxt(k,315)*y(k,26) - mat(k,1611) = rxt(k,342)*y(k,26) - mat(k,822) = -((rxt(k,114) + rxt(k,115)) * y(k,86) + rxt(k,116)*y(k,26) & - + rxt(k,117)*y(k,38) + rxt(k,119)*y(k,137) + rxt(k,124)*y(k,49) & - + rxt(k,125)*y(k,67) + rxt(k,126)*y(k,68) + (rxt(k,168) & - + rxt(k,265)) * y(k,104) + (rxt(k,170) + rxt(k,258)) * y(k,102) & - + rxt(k,186)*y(k,100) + rxt(k,204)*y(k,119) + rxt(k,221) & - *y(k,116) + rxt(k,239)*y(k,115) + rxt(k,256)*y(k,126) + rxt(k,280) & - *y(k,60) + rxt(k,281)*y(k,61)) - mat(k,1461) = -(rxt(k,114) + rxt(k,115)) * y(k,91) - mat(k,1739) = -rxt(k,116)*y(k,91) - mat(k,1774) = -rxt(k,117)*y(k,91) - mat(k,1832) = -rxt(k,119)*y(k,91) - mat(k,1281) = -rxt(k,124)*y(k,91) - mat(k,1419) = -rxt(k,125)*y(k,91) - mat(k,1242) = -rxt(k,126)*y(k,91) - mat(k,1586) = -(rxt(k,168) + rxt(k,265)) * y(k,91) - mat(k,1695) = -(rxt(k,170) + rxt(k,258)) * y(k,91) - mat(k,1028) = -rxt(k,186)*y(k,91) - mat(k,1069) = -rxt(k,204)*y(k,91) - mat(k,940) = -rxt(k,221)*y(k,91) - mat(k,898) = -rxt(k,239)*y(k,91) - mat(k,1360) = -rxt(k,256)*y(k,91) - mat(k,1502) = -rxt(k,280)*y(k,91) - mat(k,986) = -rxt(k,281)*y(k,91) - mat(k,1774) = mat(k,1774) + rxt(k,129)*y(k,94) - mat(k,1419) = mat(k,1419) + rxt(k,131)*y(k,94) - mat(k,665) = rxt(k,129)*y(k,38) + rxt(k,131)*y(k,67) - mat(k,362) = -(rxt(k,153)*y(k,126) + (rxt(k,176) + rxt(k,259)) * y(k,104) & - + rxt(k,194)*y(k,100) + rxt(k,211)*y(k,119) + rxt(k,229) & - *y(k,116) + rxt(k,246)*y(k,115) + (rxt(k,247) + rxt(k,271) & - ) * y(k,102)) - mat(k,1345) = -rxt(k,153)*y(k,92) - mat(k,1572) = -(rxt(k,176) + rxt(k,259)) * y(k,92) - mat(k,1014) = -rxt(k,194)*y(k,92) - mat(k,1055) = -rxt(k,211)*y(k,92) - mat(k,926) = -rxt(k,229)*y(k,92) - mat(k,883) = -rxt(k,246)*y(k,92) - mat(k,1681) = -(rxt(k,247) + rxt(k,271)) * y(k,92) - mat(k,537) = rxt(k,118)*y(k,137) - mat(k,1816) = rxt(k,118)*y(k,93) - mat(k,539) = -(rxt(k,118)*y(k,137) + (rxt(k,120) + rxt(k,121)) * y(k,61) & - + (rxt(k,122) + rxt(k,123)) * y(k,60) + rxt(k,155)*y(k,126) & - + (rxt(k,158) + rxt(k,260)) * y(k,102) + (rxt(k,178) + rxt(k,261) & - ) * y(k,104) + rxt(k,196)*y(k,100) + rxt(k,213)*y(k,119) & - + rxt(k,231)*y(k,116) + rxt(k,249)*y(k,115)) - mat(k,1823) = -rxt(k,118)*y(k,93) - mat(k,977) = -(rxt(k,120) + rxt(k,121)) * y(k,93) - mat(k,1493) = -(rxt(k,122) + rxt(k,123)) * y(k,93) - mat(k,1352) = -rxt(k,155)*y(k,93) - mat(k,1688) = -(rxt(k,158) + rxt(k,260)) * y(k,93) - mat(k,1579) = -(rxt(k,178) + rxt(k,261)) * y(k,93) - mat(k,1021) = -rxt(k,196)*y(k,93) - mat(k,1062) = -rxt(k,213)*y(k,93) - mat(k,933) = -rxt(k,231)*y(k,93) - mat(k,890) = -rxt(k,249)*y(k,93) - mat(k,817) = rxt(k,119)*y(k,137) - mat(k,1823) = mat(k,1823) + rxt(k,119)*y(k,91) - mat(k,660) = -(rxt(k,127)*y(k,86) + rxt(k,128)*y(k,26) + rxt(k,129)*y(k,38) & - + rxt(k,130)*y(k,47) + rxt(k,131)*y(k,67) + rxt(k,132)*y(k,69) & - + rxt(k,151)*y(k,126) + rxt(k,174)*y(k,104) + rxt(k,191) & - *y(k,100) + rxt(k,209)*y(k,119) + rxt(k,225)*y(k,102) + rxt(k,227) & - *y(k,116) + rxt(k,244)*y(k,115)) - mat(k,1456) = -rxt(k,127)*y(k,94) - mat(k,1734) = -rxt(k,128)*y(k,94) - mat(k,1769) = -rxt(k,129)*y(k,94) - mat(k,1147) = -rxt(k,130)*y(k,94) - mat(k,1414) = -rxt(k,131)*y(k,94) - mat(k,1188) = -rxt(k,132)*y(k,94) - mat(k,1355) = -rxt(k,151)*y(k,94) - mat(k,1581) = -rxt(k,174)*y(k,94) - mat(k,1023) = -rxt(k,191)*y(k,94) - mat(k,1064) = -rxt(k,209)*y(k,94) - mat(k,1690) = -rxt(k,225)*y(k,94) - mat(k,935) = -rxt(k,227)*y(k,94) - mat(k,893) = -rxt(k,244)*y(k,94) - mat(k,1561) = -((rxt(k,133) + rxt(k,135)) * y(k,68) + rxt(k,134)*y(k,69) & - + rxt(k,138)*y(k,96) + rxt(k,141)*y(k,102) + rxt(k,144)*y(k,104) & - + rxt(k,303)*y(k,116) + rxt(k,304)*y(k,117) + rxt(k,306) & - *y(k,118) + rxt(k,308)*y(k,119) + rxt(k,326)*y(k,127) + rxt(k,380) & - *y(k,130) + rxt(k,381)*y(k,105) + rxt(k,382)*y(k,99) + rxt(k,383) & - *y(k,100) + rxt(k,384)*y(k,120) + rxt(k,583)*y(k,115) + rxt(k,584) & - *y(k,126) + rxt(k,585)*y(k,107)) - mat(k,1259) = -(rxt(k,133) + rxt(k,135)) * y(k,95) - mat(k,1210) = -rxt(k,134)*y(k,95) - mat(k,86) = -rxt(k,138)*y(k,95) - mat(k,1712) = -rxt(k,141)*y(k,95) - mat(k,1603) = -rxt(k,144)*y(k,95) - mat(k,957) = -rxt(k,303)*y(k,95) - mat(k,93) = -rxt(k,304)*y(k,95) - mat(k,119) = -rxt(k,306)*y(k,95) - mat(k,1086) = -rxt(k,308)*y(k,95) - mat(k,194) = -rxt(k,326)*y(k,95) - mat(k,358) = -rxt(k,380)*y(k,95) - mat(k,183) = -rxt(k,381)*y(k,95) - mat(k,165) = -rxt(k,382)*y(k,95) - mat(k,1045) = -rxt(k,383)*y(k,95) - mat(k,113) = -rxt(k,384)*y(k,95) - mat(k,915) = -rxt(k,583)*y(k,95) - mat(k,1377) = -rxt(k,584)*y(k,95) - mat(k,161) = -rxt(k,585)*y(k,95) - mat(k,1791) = rxt(k,105)*y(k,87) + rxt(k,317)*y(k,125) + rxt(k,344)*y(k,132) - mat(k,497) = rxt(k,353)*y(k,133) - mat(k,1519) = rxt(k,136)*y(k,133) - mat(k,1436) = rxt(k,324)*y(k,125) + rxt(k,333)*y(k,128) + rxt(k,347)*y(k,132) & - + rxt(k,360)*y(k,133) - mat(k,1210) = mat(k,1210) + rxt(k,332)*y(k,128) - mat(k,704) = rxt(k,105)*y(k,38) - mat(k,252) = rxt(k,321)*y(k,125) + rxt(k,361)*y(k,133) - mat(k,1333) = rxt(k,317)*y(k,38) + rxt(k,324)*y(k,67) + rxt(k,321)*y(k,123) - mat(k,448) = rxt(k,333)*y(k,67) + rxt(k,332)*y(k,69) - mat(k,1635) = rxt(k,344)*y(k,38) + rxt(k,347)*y(k,67) - mat(k,1670) = rxt(k,353)*y(k,39) + rxt(k,136)*y(k,60) + rxt(k,360)*y(k,67) & - + rxt(k,361)*y(k,123) - mat(k,83) = -(rxt(k,138)*y(k,95) + rxt(k,139)*y(k,137)) - mat(k,1527) = -rxt(k,138)*y(k,96) - mat(k,1804) = -rxt(k,139)*y(k,96) - mat(k,186) = rxt(k,327)*y(k,137) - mat(k,1804) = mat(k,1804) + rxt(k,327)*y(k,127) - mat(k,335) = -(rxt(k,149)*y(k,126) + rxt(k,172)*y(k,104) + rxt(k,189) & - *y(k,100) + rxt(k,203)*y(k,102) + rxt(k,207)*y(k,119) + rxt(k,224) & - *y(k,116) + rxt(k,242)*y(k,115)) - mat(k,1343) = -rxt(k,149)*y(k,97) - mat(k,1571) = -rxt(k,172)*y(k,97) - mat(k,1013) = -rxt(k,189)*y(k,97) - mat(k,1680) = -rxt(k,203)*y(k,97) - mat(k,1054) = -rxt(k,207)*y(k,97) - mat(k,925) = -rxt(k,224)*y(k,97) - mat(k,882) = -rxt(k,242)*y(k,97) - mat(k,747) = -(rxt(k,310)*y(k,119) + (rxt(k,408) + rxt(k,409) + rxt(k,410) & - ) * y(k,38) + rxt(k,412)*y(k,67) + rxt(k,413)*y(k,69) + rxt(k,417) & - *y(k,131) + 4._r8*rxt(k,422)*y(k,98) + rxt(k,434)*y(k,62) & - + rxt(k,439)*y(k,60) + rxt(k,444)*y(k,61) + (rxt(k,454) & - + rxt(k,455)) * y(k,86) + rxt(k,461)*y(k,26) + rxt(k,487) & - *y(k,85) + rxt(k,493)*y(k,4) + rxt(k,533)*y(k,20)) - mat(k,1067) = -rxt(k,310)*y(k,98) - mat(k,1772) = -(rxt(k,408) + rxt(k,409) + rxt(k,410)) * y(k,98) - mat(k,1417) = -rxt(k,412)*y(k,98) - mat(k,1191) = -rxt(k,413)*y(k,98) - mat(k,793) = -rxt(k,417)*y(k,98) - mat(k,1107) = -rxt(k,434)*y(k,98) - mat(k,1500) = -rxt(k,439)*y(k,98) - mat(k,984) = -rxt(k,444)*y(k,98) - mat(k,1459) = -(rxt(k,454) + rxt(k,455)) * y(k,98) - mat(k,1737) = -rxt(k,461)*y(k,98) - mat(k,458) = -rxt(k,487)*y(k,98) - mat(k,587) = -rxt(k,493)*y(k,98) - mat(k,326) = -rxt(k,533)*y(k,98) - mat(k,587) = mat(k,587) + rxt(k,498)*y(k,131) - mat(k,608) = rxt(k,530)*y(k,62) + rxt(k,531)*y(k,67) + rxt(k,486)*y(k,85) & - + rxt(k,450)*y(k,86) - mat(k,326) = mat(k,326) + rxt(k,457)*y(k,26) + rxt(k,534)*y(k,60) - mat(k,1737) = mat(k,1737) + rxt(k,457)*y(k,20) + rxt(k,468)*y(k,131) - mat(k,135) = rxt(k,537)*y(k,131) - mat(k,60) = .500_r8*rxt(k,558)*y(k,131) - mat(k,1772) = mat(k,1772) + rxt(k,411)*y(k,68) + rxt(k,317)*y(k,125) - mat(k,147) = rxt(k,407)*y(k,67) + rxt(k,453)*y(k,86) + rxt(k,416)*y(k,131) - mat(k,1150) = rxt(k,130)*y(k,94) + rxt(k,318)*y(k,125) - mat(k,1279) = rxt(k,319)*y(k,125) - mat(k,1500) = mat(k,1500) + rxt(k,534)*y(k,20) - mat(k,1107) = mat(k,1107) + rxt(k,530)*y(k,16) + rxt(k,437)*y(k,131) - mat(k,1417) = mat(k,1417) + rxt(k,531)*y(k,16) + rxt(k,407)*y(k,41) & + mat(k,164) = -(rxt(k,138)*y(k,96) + rxt(k,139)*y(k,137)) + mat(k,1036) = -rxt(k,138)*y(k,97) + mat(k,2033) = -rxt(k,139)*y(k,97) + mat(k,286) = rxt(k,327)*y(k,137) + mat(k,2033) = mat(k,2033) + rxt(k,327)*y(k,127) + mat(k,470) = -(rxt(k,149)*y(k,126) + rxt(k,172)*y(k,105) + rxt(k,189) & + *y(k,101) + rxt(k,203)*y(k,103) + rxt(k,207)*y(k,120) + rxt(k,224) & + *y(k,117) + rxt(k,242)*y(k,116)) + mat(k,1559) = -rxt(k,149)*y(k,98) + mat(k,1391) = -rxt(k,172)*y(k,98) + mat(k,1434) = -rxt(k,189)*y(k,98) + mat(k,1651) = -rxt(k,203)*y(k,98) + mat(k,1312) = -rxt(k,207)*y(k,98) + mat(k,1169) = -rxt(k,224)*y(k,98) + mat(k,1125) = -rxt(k,242)*y(k,98) + mat(k,1947) = rxt(k,343)*y(k,132) + mat(k,1829) = rxt(k,343)*y(k,32) + mat(k,897) = -(rxt(k,310)*y(k,120) + (rxt(k,408) + rxt(k,409) + rxt(k,410) & + ) * y(k,40) + rxt(k,412)*y(k,69) + rxt(k,413)*y(k,72) + rxt(k,417) & + *y(k,131) + 4._r8*rxt(k,422)*y(k,99) + rxt(k,434)*y(k,64) & + + rxt(k,439)*y(k,62) + rxt(k,444)*y(k,63) + (rxt(k,454) & + + rxt(k,455)) * y(k,25) + rxt(k,461)*y(k,28) + rxt(k,487)*y(k,3) & + + rxt(k,493)*y(k,5) + rxt(k,533)*y(k,21)) + mat(k,1325) = -rxt(k,310)*y(k,99) + mat(k,1361) = -(rxt(k,408) + rxt(k,409) + rxt(k,410)) * y(k,99) + mat(k,1283) = -rxt(k,412)*y(k,99) + mat(k,1910) = -rxt(k,413)*y(k,99) + mat(k,980) = -rxt(k,417)*y(k,99) + mat(k,1092) = -rxt(k,434)*y(k,99) + mat(k,1706) = -rxt(k,439)*y(k,99) + mat(k,1621) = -rxt(k,444)*y(k,99) + mat(k,2000) = -(rxt(k,454) + rxt(k,455)) * y(k,99) + mat(k,1751) = -rxt(k,461)*y(k,99) + mat(k,583) = -rxt(k,487)*y(k,99) + mat(k,715) = -rxt(k,493)*y(k,99) + mat(k,431) = -rxt(k,533)*y(k,99) + mat(k,583) = mat(k,583) + rxt(k,486)*y(k,17) + mat(k,715) = mat(k,715) + rxt(k,498)*y(k,131) + mat(k,737) = rxt(k,486)*y(k,3) + rxt(k,450)*y(k,25) + rxt(k,530)*y(k,64) & + + rxt(k,531)*y(k,69) + mat(k,222) = rxt(k,515)*y(k,25) + rxt(k,516)*y(k,131) + mat(k,147) = rxt(k,518)*y(k,25) + rxt(k,519)*y(k,131) + mat(k,431) = mat(k,431) + rxt(k,457)*y(k,28) + rxt(k,534)*y(k,62) + mat(k,418) = rxt(k,538)*y(k,70) + mat(k,2000) = mat(k,2000) + rxt(k,450)*y(k,17) + rxt(k,515)*y(k,18) & + + rxt(k,518)*y(k,20) + rxt(k,453)*y(k,43) + mat(k,1751) = mat(k,1751) + rxt(k,457)*y(k,21) + rxt(k,468)*y(k,131) + mat(k,250) = rxt(k,540)*y(k,131) + mat(k,124) = .500_r8*rxt(k,556)*y(k,131) + mat(k,1361) = mat(k,1361) + rxt(k,411)*y(k,71) + rxt(k,317)*y(k,125) + mat(k,212) = rxt(k,453)*y(k,25) + rxt(k,407)*y(k,69) + rxt(k,416)*y(k,131) + mat(k,1492) = rxt(k,130)*y(k,95) + rxt(k,318)*y(k,125) + mat(k,1223) = rxt(k,319)*y(k,125) + mat(k,1706) = mat(k,1706) + rxt(k,534)*y(k,21) + mat(k,1092) = mat(k,1092) + rxt(k,530)*y(k,17) + rxt(k,437)*y(k,131) + mat(k,1283) = mat(k,1283) + rxt(k,531)*y(k,17) + rxt(k,407)*y(k,43) & + rxt(k,347)*y(k,132) - mat(k,1240) = rxt(k,411)*y(k,38) - mat(k,1191) = mat(k,1191) + rxt(k,419)*y(k,131) - mat(k,257) = rxt(k,554)*y(k,131) - mat(k,458) = mat(k,458) + rxt(k,486)*y(k,16) - mat(k,1459) = mat(k,1459) + rxt(k,450)*y(k,16) + rxt(k,453)*y(k,41) - mat(k,663) = rxt(k,130)*y(k,47) - mat(k,1314) = rxt(k,317)*y(k,38) + rxt(k,318)*y(k,47) + rxt(k,319)*y(k,49) - mat(k,793) = mat(k,793) + rxt(k,498)*y(k,4) + rxt(k,468)*y(k,26) + rxt(k,537) & - *y(k,29) + .500_r8*rxt(k,558)*y(k,33) + rxt(k,416)*y(k,41) & - + rxt(k,437)*y(k,62) + rxt(k,419)*y(k,69) + rxt(k,554)*y(k,77) - mat(k,1616) = rxt(k,347)*y(k,67) - mat(k,162) = -(rxt(k,374)*y(k,137) + rxt(k,382)*y(k,95)) - mat(k,1808) = -rxt(k,374)*y(k,99) - mat(k,1534) = -rxt(k,382)*y(k,99) - mat(k,84) = rxt(k,139)*y(k,137) - mat(k,180) = rxt(k,372)*y(k,137) - mat(k,1808) = mat(k,1808) + rxt(k,139)*y(k,96) + rxt(k,372)*y(k,105) - mat(k,1033) = -(rxt(k,185)*y(k,114) + rxt(k,186)*y(k,91) + rxt(k,187)*y(k,89) & - + rxt(k,188)*y(k,110) + rxt(k,189)*y(k,97) + rxt(k,190)*y(k,125) & - + rxt(k,191)*y(k,94) + rxt(k,193)*y(k,112) + rxt(k,194)*y(k,92) & - + rxt(k,195)*y(k,87) + rxt(k,196)*y(k,93) + rxt(k,197)*y(k,109) & - + rxt(k,198)*y(k,113) + rxt(k,199)*y(k,88) + rxt(k,200)*y(k,111) & - + rxt(k,201)*y(k,108) + rxt(k,376)*y(k,137) + rxt(k,383)*y(k,95)) - mat(k,507) = -rxt(k,185)*y(k,100) - mat(k,827) = -rxt(k,186)*y(k,100) - mat(k,397) = -rxt(k,187)*y(k,100) - mat(k,718) = -rxt(k,188)*y(k,100) - mat(k,339) = -rxt(k,189)*y(k,100) - mat(k,1321) = -rxt(k,190)*y(k,100) - mat(k,670) = -rxt(k,191)*y(k,100) - mat(k,565) = -rxt(k,193)*y(k,100) - mat(k,366) = -rxt(k,194)*y(k,100) - mat(k,696) = -rxt(k,195)*y(k,100) - mat(k,547) = -rxt(k,196)*y(k,100) - mat(k,429) = -rxt(k,197)*y(k,100) - mat(k,469) = -rxt(k,198)*y(k,100) - mat(k,413) = -rxt(k,199)*y(k,100) - mat(k,525) = -rxt(k,200)*y(k,100) - mat(k,856) = -rxt(k,201)*y(k,100) - mat(k,1837) = -rxt(k,376)*y(k,100) - mat(k,1549) = -rxt(k,383)*y(k,100) - mat(k,164) = rxt(k,374)*y(k,137) - mat(k,91) = rxt(k,305)*y(k,137) - mat(k,1837) = mat(k,1837) + rxt(k,374)*y(k,99) + rxt(k,305)*y(k,117) + mat(k,785) = rxt(k,538)*y(k,23) + mat(k,1800) = rxt(k,411)*y(k,40) + mat(k,1910) = mat(k,1910) + rxt(k,419)*y(k,131) + mat(k,350) = rxt(k,546)*y(k,131) + mat(k,832) = rxt(k,130)*y(k,49) + mat(k,1528) = rxt(k,317)*y(k,40) + rxt(k,318)*y(k,49) + rxt(k,319)*y(k,51) + mat(k,980) = mat(k,980) + rxt(k,498)*y(k,5) + rxt(k,516)*y(k,18) + rxt(k,519) & + *y(k,20) + rxt(k,468)*y(k,28) + rxt(k,540)*y(k,31) & + + .500_r8*rxt(k,556)*y(k,35) + rxt(k,416)*y(k,43) + rxt(k,437) & + *y(k,64) + rxt(k,419)*y(k,72) + rxt(k,546)*y(k,80) + mat(k,1833) = rxt(k,347)*y(k,69) + mat(k,243) = -(rxt(k,374)*y(k,137) + rxt(k,382)*y(k,96)) + mat(k,2035) = -rxt(k,374)*y(k,100) + mat(k,1041) = -rxt(k,382)*y(k,100) + mat(k,165) = rxt(k,139)*y(k,137) + mat(k,280) = rxt(k,372)*y(k,137) + mat(k,2035) = mat(k,2035) + rxt(k,139)*y(k,97) + rxt(k,372)*y(k,106) + mat(k,1460) = -(rxt(k,185)*y(k,115) + rxt(k,186)*y(k,92) + rxt(k,187)*y(k,90) & + + rxt(k,188)*y(k,111) + rxt(k,189)*y(k,98) + rxt(k,190)*y(k,125) & + + rxt(k,191)*y(k,95) + rxt(k,193)*y(k,113) + rxt(k,194)*y(k,93) & + + rxt(k,195)*y(k,88) + rxt(k,196)*y(k,94) + rxt(k,197)*y(k,110) & + + rxt(k,198)*y(k,114) + rxt(k,199)*y(k,89) + rxt(k,200)*y(k,112) & + + rxt(k,201)*y(k,109) + rxt(k,376)*y(k,137) + rxt(k,383)*y(k,96)) + mat(k,614) = -rxt(k,185)*y(k,101) + mat(k,1021) = -rxt(k,186)*y(k,101) + mat(k,523) = -rxt(k,187)*y(k,101) + mat(k,874) = -rxt(k,188)*y(k,101) + mat(k,477) = -rxt(k,189)*y(k,101) + mat(k,1541) = -rxt(k,190)*y(k,101) + mat(k,844) = -rxt(k,191)*y(k,101) + mat(k,698) = -rxt(k,193)*y(k,101) + mat(k,509) = -rxt(k,194)*y(k,101) + mat(k,818) = -rxt(k,195)*y(k,101) + mat(k,677) = -rxt(k,196)*y(k,101) + mat(k,554) = -rxt(k,197)*y(k,101) + mat(k,570) = -rxt(k,198)*y(k,101) + mat(k,539) = -rxt(k,199)*y(k,101) + mat(k,633) = -rxt(k,200)*y(k,101) + mat(k,934) = -rxt(k,201)*y(k,101) + mat(k,2073) = -rxt(k,376)*y(k,101) + mat(k,1064) = -rxt(k,383)*y(k,101) + mat(k,247) = rxt(k,374)*y(k,137) + mat(k,173) = rxt(k,305)*y(k,137) + mat(k,2073) = mat(k,2073) + rxt(k,374)*y(k,100) + rxt(k,305)*y(k,118) + mat(k,104) = -(rxt(k,140)*y(k,137)) + mat(k,2030) = -rxt(k,140)*y(k,102) + mat(k,396) = rxt(k,142)*y(k,103) + mat(k,1649) = rxt(k,142)*y(k,58) + mat(k,1682) = -(rxt(k,141)*y(k,96) + rxt(k,142)*y(k,58) + (rxt(k,146) & + + rxt(k,269)) * y(k,115) + rxt(k,147)*y(k,88) + (rxt(k,158) & + + rxt(k,260)) * y(k,94) + rxt(k,162)*y(k,110) + rxt(k,163) & + *y(k,114) + rxt(k,164)*y(k,89) + rxt(k,165)*y(k,112) + rxt(k,166) & + *y(k,109) + (rxt(k,170) + rxt(k,258)) * y(k,92) + (rxt(k,181) & + + rxt(k,267)) * y(k,90) + (rxt(k,192) + rxt(k,264)) * y(k,111) & + + rxt(k,203)*y(k,98) + rxt(k,214)*y(k,125) + rxt(k,225)*y(k,95) & + + (rxt(k,236) + rxt(k,262)) * y(k,113) + (rxt(k,247) + rxt(k,271) & + ) * y(k,93) + rxt(k,378)*y(k,137)) + mat(k,1069) = -rxt(k,141)*y(k,103) + mat(k,407) = -rxt(k,142)*y(k,103) + mat(k,616) = -(rxt(k,146) + rxt(k,269)) * y(k,103) + mat(k,822) = -rxt(k,147)*y(k,103) + mat(k,680) = -(rxt(k,158) + rxt(k,260)) * y(k,103) + mat(k,557) = -rxt(k,162)*y(k,103) + mat(k,573) = -rxt(k,163)*y(k,103) + mat(k,542) = -rxt(k,164)*y(k,103) + mat(k,636) = -rxt(k,165)*y(k,103) + mat(k,938) = -rxt(k,166)*y(k,103) + mat(k,1026) = -(rxt(k,170) + rxt(k,258)) * y(k,103) + mat(k,526) = -(rxt(k,181) + rxt(k,267)) * y(k,103) + mat(k,878) = -(rxt(k,192) + rxt(k,264)) * y(k,103) + mat(k,479) = -rxt(k,203)*y(k,103) + mat(k,1546) = -rxt(k,214)*y(k,103) + mat(k,849) = -rxt(k,225)*y(k,103) + mat(k,701) = -(rxt(k,236) + rxt(k,262)) * y(k,103) + mat(k,511) = -(rxt(k,247) + rxt(k,271)) * y(k,103) + mat(k,2078) = -rxt(k,378)*y(k,103) + mat(k,1465) = rxt(k,376)*y(k,137) + mat(k,106) = rxt(k,140)*y(k,137) + mat(k,2078) = mat(k,2078) + rxt(k,376)*y(k,101) + rxt(k,140)*y(k,102) + mat(k,108) = -(rxt(k,143)*y(k,137)) + mat(k,2031) = -rxt(k,143)*y(k,104) + mat(k,397) = rxt(k,145)*y(k,105) + mat(k,1389) = rxt(k,145)*y(k,58) + mat(k,1416) = -(rxt(k,144)*y(k,96) + rxt(k,145)*y(k,58) + (rxt(k,167) & + + rxt(k,270)) * y(k,115) + (rxt(k,168) + rxt(k,265)) * y(k,92) & + + (rxt(k,169) + rxt(k,268)) * y(k,90) + (rxt(k,171) + rxt(k,266) & + ) * y(k,111) + rxt(k,172)*y(k,98) + rxt(k,173)*y(k,125) & + + rxt(k,174)*y(k,95) + (rxt(k,175) + rxt(k,263)) * y(k,113) & + + (rxt(k,176) + rxt(k,259)) * y(k,93) + rxt(k,177)*y(k,88) & + + (rxt(k,178) + rxt(k,261)) * y(k,94) + rxt(k,179)*y(k,110) & + + rxt(k,180)*y(k,114) + rxt(k,182)*y(k,89) + rxt(k,183)*y(k,112) & + + rxt(k,184)*y(k,109)) + mat(k,1063) = -rxt(k,144)*y(k,105) + mat(k,405) = -rxt(k,145)*y(k,105) + mat(k,613) = -(rxt(k,167) + rxt(k,270)) * y(k,105) + mat(k,1020) = -(rxt(k,168) + rxt(k,265)) * y(k,105) + mat(k,522) = -(rxt(k,169) + rxt(k,268)) * y(k,105) + mat(k,873) = -(rxt(k,171) + rxt(k,266)) * y(k,105) + mat(k,476) = -rxt(k,172)*y(k,105) + mat(k,1540) = -rxt(k,173)*y(k,105) + mat(k,843) = -rxt(k,174)*y(k,105) + mat(k,697) = -(rxt(k,175) + rxt(k,263)) * y(k,105) + mat(k,508) = -(rxt(k,176) + rxt(k,259)) * y(k,105) + mat(k,817) = -rxt(k,177)*y(k,105) + mat(k,676) = -(rxt(k,178) + rxt(k,261)) * y(k,105) + mat(k,553) = -rxt(k,179)*y(k,105) + mat(k,569) = -rxt(k,180)*y(k,105) + mat(k,538) = -rxt(k,182)*y(k,105) + mat(k,632) = -rxt(k,183)*y(k,105) + mat(k,933) = -rxt(k,184)*y(k,105) + mat(k,1676) = rxt(k,378)*y(k,137) + mat(k,110) = rxt(k,143)*y(k,137) + mat(k,2072) = rxt(k,378)*y(k,103) + rxt(k,143)*y(k,104) + mat(k,281) = -(rxt(k,372)*y(k,137) + rxt(k,381)*y(k,96)) + mat(k,2039) = -rxt(k,372)*y(k,106) + mat(k,1045) = -rxt(k,381)*y(k,106) + mat(k,1353) = rxt(k,309)*y(k,120) + mat(k,887) = rxt(k,310)*y(k,120) + mat(k,1311) = rxt(k,309)*y(k,40) + rxt(k,310)*y(k,99) + rxt(k,311)*y(k,131) + mat(k,288) = rxt(k,328)*y(k,137) + mat(k,965) = rxt(k,311)*y(k,120) + mat(k,2039) = mat(k,2039) + rxt(k,328)*y(k,127) + mat(k,297) = -(rxt(k,424)*y(k,69) + rxt(k,425)*y(k,71) + rxt(k,596)*y(k,134)) + mat(k,1261) = -rxt(k,424)*y(k,107) + mat(k,1785) = -rxt(k,425)*y(k,107) + mat(k,383) = -rxt(k,596)*y(k,107) + mat(k,1261) = mat(k,1261) + rxt(k,586)*y(k,108) + mat(k,1047) = .900_r8*rxt(k,584)*y(k,108) + .800_r8*rxt(k,582)*y(k,116) + mat(k,228) = rxt(k,586)*y(k,69) + .900_r8*rxt(k,584)*y(k,96) + mat(k,1121) = .800_r8*rxt(k,582)*y(k,96) + mat(k,227) = -(rxt(k,584)*y(k,96) + rxt(k,585)*y(k,71) + (rxt(k,586) & + + rxt(k,587)) * y(k,69)) + mat(k,1040) = -rxt(k,584)*y(k,108) + mat(k,1782) = -rxt(k,585)*y(k,108) + mat(k,1257) = -(rxt(k,586) + rxt(k,587)) * y(k,108) + mat(k,923) = -(rxt(k,161)*y(k,126) + rxt(k,166)*y(k,103) + rxt(k,184) & + *y(k,105) + rxt(k,201)*y(k,101) + rxt(k,219)*y(k,120) + rxt(k,237) & + *y(k,117) + rxt(k,254)*y(k,116) + rxt(k,285)*y(k,25) + rxt(k,286) & + *y(k,28) + rxt(k,287)*y(k,40) + rxt(k,288)*y(k,137) + rxt(k,289) & + *y(k,49) + rxt(k,290)*y(k,51) + rxt(k,291)*y(k,63) + rxt(k,292) & + *y(k,72)) + mat(k,1574) = -rxt(k,161)*y(k,109) + mat(k,1665) = -rxt(k,166)*y(k,109) + mat(k,1405) = -rxt(k,184)*y(k,109) + mat(k,1448) = -rxt(k,201)*y(k,109) + mat(k,1326) = -rxt(k,219)*y(k,109) + mat(k,1183) = -rxt(k,237)*y(k,109) + mat(k,1140) = -rxt(k,254)*y(k,109) + mat(k,2001) = -rxt(k,285)*y(k,109) + mat(k,1752) = -rxt(k,286)*y(k,109) + mat(k,1362) = -rxt(k,287)*y(k,109) + mat(k,2061) = -rxt(k,288)*y(k,109) + mat(k,1493) = -rxt(k,289)*y(k,109) + mat(k,1224) = -rxt(k,290)*y(k,109) + mat(k,1622) = -rxt(k,291)*y(k,109) + mat(k,1911) = -rxt(k,292)*y(k,109) + mat(k,1707) = rxt(k,111)*y(k,91) + rxt(k,280)*y(k,92) + rxt(k,123)*y(k,94) & + + rxt(k,279)*y(k,128) + mat(k,1622) = mat(k,1622) + rxt(k,110)*y(k,88) + rxt(k,320)*y(k,125) & + + rxt(k,278)*y(k,128) + rxt(k,346)*y(k,132) + rxt(k,359) & + *y(k,133) + mat(k,1284) = rxt(k,301)*y(k,111) + mat(k,1911) = mat(k,1911) + rxt(k,302)*y(k,111) + mat(k,810) = rxt(k,110)*y(k,63) + mat(k,368) = rxt(k,111)*y(k,62) + mat(k,1009) = rxt(k,280)*y(k,62) + mat(k,669) = rxt(k,123)*y(k,62) + mat(k,864) = rxt(k,301)*y(k,69) + rxt(k,302)*y(k,72) + mat(k,1529) = rxt(k,320)*y(k,63) + mat(k,593) = rxt(k,279)*y(k,62) + rxt(k,278)*y(k,63) + mat(k,1834) = rxt(k,346)*y(k,63) + mat(k,1870) = rxt(k,359)*y(k,63) end do - end subroutine nlnmat05 - subroutine nlnmat06( avec_len, mat, y, rxt ) + end subroutine nlnmat07 + subroutine nlnmat08( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -1312,215 +1740,220 @@ subroutine nlnmat06( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,50) = -(rxt(k,140)*y(k,137)) - mat(k,1802) = -rxt(k,140)*y(k,101) - mat(k,295) = rxt(k,142)*y(k,102) - mat(k,1678) = rxt(k,142)*y(k,56) - mat(k,1716) = -(rxt(k,141)*y(k,95) + rxt(k,142)*y(k,56) + (rxt(k,146) & - + rxt(k,269)) * y(k,114) + rxt(k,147)*y(k,87) + (rxt(k,158) & - + rxt(k,260)) * y(k,93) + rxt(k,162)*y(k,109) + rxt(k,163) & - *y(k,113) + rxt(k,164)*y(k,88) + rxt(k,165)*y(k,111) + rxt(k,166) & - *y(k,108) + (rxt(k,170) + rxt(k,258)) * y(k,91) + (rxt(k,181) & - + rxt(k,267)) * y(k,89) + (rxt(k,192) + rxt(k,264)) * y(k,110) & - + rxt(k,203)*y(k,97) + rxt(k,214)*y(k,125) + rxt(k,225)*y(k,94) & - + (rxt(k,236) + rxt(k,262)) * y(k,112) + (rxt(k,247) + rxt(k,271) & - ) * y(k,92) + rxt(k,378)*y(k,137)) - mat(k,1565) = -rxt(k,141)*y(k,102) - mat(k,307) = -rxt(k,142)*y(k,102) - mat(k,515) = -(rxt(k,146) + rxt(k,269)) * y(k,102) - mat(k,706) = -rxt(k,147)*y(k,102) - mat(k,554) = -(rxt(k,158) + rxt(k,260)) * y(k,102) - mat(k,435) = -rxt(k,162)*y(k,102) - mat(k,478) = -rxt(k,163)*y(k,102) - mat(k,421) = -rxt(k,164)*y(k,102) - mat(k,534) = -rxt(k,165)*y(k,102) - mat(k,872) = -rxt(k,166)*y(k,102) - mat(k,843) = -(rxt(k,170) + rxt(k,258)) * y(k,102) - mat(k,405) = -(rxt(k,181) + rxt(k,267)) * y(k,102) - mat(k,731) = -(rxt(k,192) + rxt(k,264)) * y(k,102) - mat(k,345) = -rxt(k,203)*y(k,102) - mat(k,1337) = -rxt(k,214)*y(k,102) - mat(k,684) = -rxt(k,225)*y(k,102) - mat(k,574) = -(rxt(k,236) + rxt(k,262)) * y(k,102) - mat(k,373) = -(rxt(k,247) + rxt(k,271)) * y(k,102) - mat(k,1853) = -rxt(k,378)*y(k,102) - mat(k,1049) = rxt(k,376)*y(k,137) - mat(k,52) = rxt(k,140)*y(k,137) - mat(k,1853) = mat(k,1853) + rxt(k,376)*y(k,100) + rxt(k,140)*y(k,101) - mat(k,54) = -(rxt(k,143)*y(k,137)) - mat(k,1803) = -rxt(k,143)*y(k,103) - mat(k,296) = rxt(k,145)*y(k,104) - mat(k,1569) = rxt(k,145)*y(k,56) - mat(k,1604) = -(rxt(k,144)*y(k,95) + rxt(k,145)*y(k,56) + (rxt(k,167) & - + rxt(k,270)) * y(k,114) + (rxt(k,168) + rxt(k,265)) * y(k,91) & - + (rxt(k,169) + rxt(k,268)) * y(k,89) + (rxt(k,171) + rxt(k,266) & - ) * y(k,110) + rxt(k,172)*y(k,97) + rxt(k,173)*y(k,125) & - + rxt(k,174)*y(k,94) + (rxt(k,175) + rxt(k,263)) * y(k,112) & - + (rxt(k,176) + rxt(k,259)) * y(k,92) + rxt(k,177)*y(k,87) & - + (rxt(k,178) + rxt(k,261)) * y(k,93) + rxt(k,179)*y(k,109) & - + rxt(k,180)*y(k,113) + rxt(k,182)*y(k,88) + rxt(k,183)*y(k,111) & - + rxt(k,184)*y(k,108)) - mat(k,1562) = -rxt(k,144)*y(k,104) - mat(k,306) = -rxt(k,145)*y(k,104) - mat(k,514) = -(rxt(k,167) + rxt(k,270)) * y(k,104) - mat(k,840) = -(rxt(k,168) + rxt(k,265)) * y(k,104) - mat(k,404) = -(rxt(k,169) + rxt(k,268)) * y(k,104) - mat(k,730) = -(rxt(k,171) + rxt(k,266)) * y(k,104) - mat(k,344) = -rxt(k,172)*y(k,104) - mat(k,1334) = -rxt(k,173)*y(k,104) - mat(k,681) = -rxt(k,174)*y(k,104) - mat(k,573) = -(rxt(k,175) + rxt(k,263)) * y(k,104) - mat(k,372) = -(rxt(k,176) + rxt(k,259)) * y(k,104) - mat(k,705) = -rxt(k,177)*y(k,104) - mat(k,553) = -(rxt(k,178) + rxt(k,261)) * y(k,104) - mat(k,434) = -rxt(k,179)*y(k,104) - mat(k,477) = -rxt(k,180)*y(k,104) - mat(k,420) = -rxt(k,182)*y(k,104) - mat(k,533) = -rxt(k,183)*y(k,104) - mat(k,869) = -rxt(k,184)*y(k,104) - mat(k,1713) = rxt(k,378)*y(k,137) - mat(k,56) = rxt(k,143)*y(k,137) - mat(k,1850) = rxt(k,378)*y(k,102) + rxt(k,143)*y(k,103) - mat(k,181) = -(rxt(k,372)*y(k,137) + rxt(k,381)*y(k,95)) - mat(k,1810) = -rxt(k,372)*y(k,105) - mat(k,1536) = -rxt(k,381)*y(k,105) - mat(k,1764) = rxt(k,309)*y(k,119) - mat(k,737) = rxt(k,310)*y(k,119) - mat(k,1053) = rxt(k,309)*y(k,38) + rxt(k,310)*y(k,98) + rxt(k,311)*y(k,131) - mat(k,188) = rxt(k,328)*y(k,137) - mat(k,779) = rxt(k,311)*y(k,119) - mat(k,1810) = mat(k,1810) + rxt(k,328)*y(k,127) - mat(k,215) = -(rxt(k,424)*y(k,67) + rxt(k,425)*y(k,68) + rxt(k,597)*y(k,134)) - mat(k,1396) = -rxt(k,424)*y(k,106) - mat(k,1224) = -rxt(k,425)*y(k,106) - mat(k,262) = -rxt(k,597)*y(k,106) - mat(k,1396) = mat(k,1396) + rxt(k,587)*y(k,107) - mat(k,1538) = .900_r8*rxt(k,585)*y(k,107) + .800_r8*rxt(k,583)*y(k,115) - mat(k,154) = rxt(k,587)*y(k,67) + .900_r8*rxt(k,585)*y(k,95) - mat(k,878) = .800_r8*rxt(k,583)*y(k,95) - mat(k,153) = -(rxt(k,585)*y(k,95) + rxt(k,586)*y(k,68) + (rxt(k,587) & - + rxt(k,588)) * y(k,67)) - mat(k,1533) = -rxt(k,585)*y(k,107) - mat(k,1222) = -rxt(k,586)*y(k,107) - mat(k,1393) = -(rxt(k,587) + rxt(k,588)) * y(k,107) - mat(k,852) = -(rxt(k,161)*y(k,126) + rxt(k,166)*y(k,102) + rxt(k,184) & - *y(k,104) + rxt(k,201)*y(k,100) + rxt(k,219)*y(k,119) + rxt(k,237) & - *y(k,116) + rxt(k,254)*y(k,115) + rxt(k,285)*y(k,86) + rxt(k,286) & - *y(k,26) + rxt(k,287)*y(k,38) + rxt(k,288)*y(k,137) + rxt(k,289) & - *y(k,47) + rxt(k,290)*y(k,49) + rxt(k,291)*y(k,61) + rxt(k,292) & - *y(k,69)) - mat(k,1361) = -rxt(k,161)*y(k,108) - mat(k,1696) = -rxt(k,166)*y(k,108) - mat(k,1587) = -rxt(k,184)*y(k,108) - mat(k,1029) = -rxt(k,201)*y(k,108) - mat(k,1070) = -rxt(k,219)*y(k,108) - mat(k,941) = -rxt(k,237)*y(k,108) - mat(k,899) = -rxt(k,254)*y(k,108) - mat(k,1462) = -rxt(k,285)*y(k,108) - mat(k,1740) = -rxt(k,286)*y(k,108) - mat(k,1775) = -rxt(k,287)*y(k,108) - mat(k,1833) = -rxt(k,288)*y(k,108) - mat(k,1153) = -rxt(k,289)*y(k,108) - mat(k,1282) = -rxt(k,290)*y(k,108) - mat(k,987) = -rxt(k,291)*y(k,108) - mat(k,1194) = -rxt(k,292)*y(k,108) - mat(k,1503) = rxt(k,111)*y(k,90) + rxt(k,280)*y(k,91) + rxt(k,123)*y(k,93) & - + rxt(k,279)*y(k,128) - mat(k,987) = mat(k,987) + rxt(k,110)*y(k,87) + rxt(k,320)*y(k,125) & - + rxt(k,278)*y(k,128) + rxt(k,346)*y(k,132) + rxt(k,359) & - *y(k,133) - mat(k,1420) = rxt(k,301)*y(k,110) - mat(k,1194) = mat(k,1194) + rxt(k,302)*y(k,110) - mat(k,692) = rxt(k,110)*y(k,61) - mat(k,289) = rxt(k,111)*y(k,60) - mat(k,823) = rxt(k,280)*y(k,60) - mat(k,543) = rxt(k,123)*y(k,60) - mat(k,714) = rxt(k,301)*y(k,67) + rxt(k,302)*y(k,69) - mat(k,1317) = rxt(k,320)*y(k,61) - mat(k,441) = rxt(k,279)*y(k,60) + rxt(k,278)*y(k,61) - mat(k,1619) = rxt(k,346)*y(k,61) - mat(k,1654) = rxt(k,359)*y(k,61) - mat(k,424) = -(rxt(k,156)*y(k,126) + rxt(k,162)*y(k,102) + rxt(k,179) & - *y(k,104) + rxt(k,197)*y(k,100) + rxt(k,215)*y(k,119) + rxt(k,232) & - *y(k,116) + rxt(k,250)*y(k,115)) - mat(k,1348) = -rxt(k,156)*y(k,109) - mat(k,1684) = -rxt(k,162)*y(k,109) - mat(k,1575) = -rxt(k,179)*y(k,109) - mat(k,1017) = -rxt(k,197)*y(k,109) - mat(k,1058) = -rxt(k,215)*y(k,109) - mat(k,929) = -rxt(k,232)*y(k,109) - mat(k,886) = -rxt(k,250)*y(k,109) - mat(k,1490) = rxt(k,122)*y(k,93) - mat(k,538) = rxt(k,122)*y(k,60) - mat(k,848) = rxt(k,288)*y(k,137) - mat(k,1819) = rxt(k,288)*y(k,108) - mat(k,713) = -(rxt(k,148)*y(k,126) + (rxt(k,171) + rxt(k,266)) * y(k,104) & - + rxt(k,188)*y(k,100) + (rxt(k,192) + rxt(k,264)) * y(k,102) & - + rxt(k,206)*y(k,119) + rxt(k,223)*y(k,116) + rxt(k,241) & - *y(k,115) + (rxt(k,276) + rxt(k,298)) * y(k,47) + rxt(k,296) & - *y(k,137) + rxt(k,300)*y(k,49) + rxt(k,301)*y(k,67) + rxt(k,302) & - *y(k,69)) - mat(k,1357) = -rxt(k,148)*y(k,110) - mat(k,1583) = -(rxt(k,171) + rxt(k,266)) * y(k,110) - mat(k,1025) = -rxt(k,188)*y(k,110) - mat(k,1692) = -(rxt(k,192) + rxt(k,264)) * y(k,110) - mat(k,1066) = -rxt(k,206)*y(k,110) - mat(k,937) = -rxt(k,223)*y(k,110) - mat(k,895) = -rxt(k,241)*y(k,110) - mat(k,1149) = -(rxt(k,276) + rxt(k,298)) * y(k,110) - mat(k,1829) = -rxt(k,296)*y(k,110) - mat(k,1278) = -rxt(k,300)*y(k,110) - mat(k,1416) = -rxt(k,301)*y(k,110) - mat(k,1190) = -rxt(k,302)*y(k,110) - mat(k,1278) = mat(k,1278) + rxt(k,109)*y(k,87) + rxt(k,124)*y(k,91) & - + rxt(k,290)*y(k,108) + rxt(k,319)*y(k,125) + rxt(k,357) & + mat(k,547) = -(rxt(k,156)*y(k,126) + rxt(k,162)*y(k,103) + rxt(k,179) & + *y(k,105) + rxt(k,197)*y(k,101) + rxt(k,215)*y(k,120) + rxt(k,232) & + *y(k,117) + rxt(k,250)*y(k,116)) + mat(k,1563) = -rxt(k,156)*y(k,110) + mat(k,1655) = -rxt(k,162)*y(k,110) + mat(k,1395) = -rxt(k,179)*y(k,110) + mat(k,1438) = -rxt(k,197)*y(k,110) + mat(k,1316) = -rxt(k,215)*y(k,110) + mat(k,1173) = -rxt(k,232)*y(k,110) + mat(k,1129) = -rxt(k,250)*y(k,110) + mat(k,1696) = rxt(k,122)*y(k,94) + mat(k,665) = rxt(k,122)*y(k,62) + mat(k,920) = rxt(k,288)*y(k,137) + mat(k,2049) = rxt(k,288)*y(k,109) + mat(k,863) = -(rxt(k,148)*y(k,126) + (rxt(k,171) + rxt(k,266)) * y(k,105) & + + rxt(k,188)*y(k,101) + (rxt(k,192) + rxt(k,264)) * y(k,103) & + + rxt(k,206)*y(k,120) + rxt(k,223)*y(k,117) + rxt(k,241) & + *y(k,116) + (rxt(k,276) + rxt(k,298)) * y(k,49) + rxt(k,296) & + *y(k,137) + rxt(k,300)*y(k,51) + rxt(k,301)*y(k,69) + rxt(k,302) & + *y(k,72)) + mat(k,1572) = -rxt(k,148)*y(k,111) + mat(k,1403) = -(rxt(k,171) + rxt(k,266)) * y(k,111) + mat(k,1446) = -rxt(k,188)*y(k,111) + mat(k,1663) = -(rxt(k,192) + rxt(k,264)) * y(k,111) + mat(k,1324) = -rxt(k,206)*y(k,111) + mat(k,1181) = -rxt(k,223)*y(k,111) + mat(k,1138) = -rxt(k,241)*y(k,111) + mat(k,1491) = -(rxt(k,276) + rxt(k,298)) * y(k,111) + mat(k,2059) = -rxt(k,296)*y(k,111) + mat(k,1222) = -rxt(k,300)*y(k,111) + mat(k,1282) = -rxt(k,301)*y(k,111) + mat(k,1909) = -rxt(k,302)*y(k,111) + mat(k,1222) = mat(k,1222) + rxt(k,109)*y(k,88) + rxt(k,124)*y(k,92) & + + rxt(k,290)*y(k,109) + rxt(k,319)*y(k,125) + rxt(k,357) & *y(k,133) - mat(k,1499) = rxt(k,272)*y(k,128) - mat(k,983) = rxt(k,281)*y(k,91) + rxt(k,120)*y(k,93) + rxt(k,291)*y(k,108) & + mat(k,1705) = rxt(k,272)*y(k,128) + mat(k,1620) = rxt(k,281)*y(k,92) + rxt(k,120)*y(k,94) + rxt(k,291)*y(k,109) & + rxt(k,277)*y(k,128) - mat(k,1190) = mat(k,1190) + rxt(k,292)*y(k,108) - mat(k,691) = rxt(k,109)*y(k,49) - mat(k,820) = rxt(k,124)*y(k,49) + rxt(k,281)*y(k,61) - mat(k,541) = rxt(k,120)*y(k,61) - mat(k,850) = rxt(k,290)*y(k,49) + rxt(k,291)*y(k,61) + rxt(k,292)*y(k,69) - mat(k,1313) = rxt(k,319)*y(k,49) - mat(k,439) = rxt(k,272)*y(k,60) + rxt(k,277)*y(k,61) - mat(k,1650) = rxt(k,357)*y(k,49) - mat(k,519) = -(rxt(k,160)*y(k,126) + rxt(k,165)*y(k,102) + rxt(k,183) & - *y(k,104) + rxt(k,200)*y(k,100) + rxt(k,218)*y(k,119) + rxt(k,235) & - *y(k,116) + rxt(k,253)*y(k,115) + rxt(k,293)*y(k,56)) - mat(k,1351) = -rxt(k,160)*y(k,111) - mat(k,1687) = -rxt(k,165)*y(k,111) - mat(k,1578) = -rxt(k,183)*y(k,111) - mat(k,1020) = -rxt(k,200)*y(k,111) - mat(k,1061) = -rxt(k,218)*y(k,111) - mat(k,932) = -rxt(k,235)*y(k,111) - mat(k,889) = -rxt(k,253)*y(k,111) - mat(k,299) = -rxt(k,293)*y(k,111) - mat(k,559) = rxt(k,294)*y(k,137) - mat(k,1822) = rxt(k,294)*y(k,112) - mat(k,560) = -(rxt(k,152)*y(k,126) + (rxt(k,175) + rxt(k,263)) * y(k,104) & - + rxt(k,193)*y(k,100) + rxt(k,210)*y(k,119) + rxt(k,228) & - *y(k,116) + (rxt(k,236) + rxt(k,262)) * y(k,102) + rxt(k,245) & - *y(k,115) + rxt(k,294)*y(k,137) + rxt(k,295)*y(k,49) + rxt(k,297) & - *y(k,56)) - mat(k,1353) = -rxt(k,152)*y(k,112) - mat(k,1580) = -(rxt(k,175) + rxt(k,263)) * y(k,112) - mat(k,1022) = -rxt(k,193)*y(k,112) - mat(k,1063) = -rxt(k,210)*y(k,112) - mat(k,934) = -rxt(k,228)*y(k,112) - mat(k,1689) = -(rxt(k,236) + rxt(k,262)) * y(k,112) - mat(k,891) = -rxt(k,245)*y(k,112) - mat(k,1824) = -rxt(k,294)*y(k,112) - mat(k,1274) = -rxt(k,295)*y(k,112) - mat(k,300) = -rxt(k,297)*y(k,112) - mat(k,978) = rxt(k,121)*y(k,93) - mat(k,540) = rxt(k,121)*y(k,61) - mat(k,711) = rxt(k,296)*y(k,137) - mat(k,1824) = mat(k,1824) + rxt(k,296)*y(k,110) + mat(k,1909) = mat(k,1909) + rxt(k,292)*y(k,109) + mat(k,809) = rxt(k,109)*y(k,51) + mat(k,1008) = rxt(k,124)*y(k,51) + rxt(k,281)*y(k,63) + mat(k,668) = rxt(k,120)*y(k,63) + mat(k,922) = rxt(k,290)*y(k,51) + rxt(k,291)*y(k,63) + rxt(k,292)*y(k,72) + mat(k,1527) = rxt(k,319)*y(k,51) + mat(k,592) = rxt(k,272)*y(k,62) + rxt(k,277)*y(k,63) + mat(k,1868) = rxt(k,357)*y(k,51) + mat(k,622) = -(rxt(k,160)*y(k,126) + rxt(k,165)*y(k,103) + rxt(k,183) & + *y(k,105) + rxt(k,200)*y(k,101) + rxt(k,218)*y(k,120) + rxt(k,235) & + *y(k,117) + rxt(k,253)*y(k,116) + rxt(k,293)*y(k,58)) + mat(k,1566) = -rxt(k,160)*y(k,112) + mat(k,1658) = -rxt(k,165)*y(k,112) + mat(k,1398) = -rxt(k,183)*y(k,112) + mat(k,1441) = -rxt(k,200)*y(k,112) + mat(k,1319) = -rxt(k,218)*y(k,112) + mat(k,1176) = -rxt(k,235)*y(k,112) + mat(k,1132) = -rxt(k,253)*y(k,112) + mat(k,400) = -rxt(k,293)*y(k,112) + mat(k,687) = rxt(k,294)*y(k,137) + mat(k,2051) = rxt(k,294)*y(k,113) + mat(k,688) = -(rxt(k,152)*y(k,126) + (rxt(k,175) + rxt(k,263)) * y(k,105) & + + rxt(k,193)*y(k,101) + rxt(k,210)*y(k,120) + rxt(k,228) & + *y(k,117) + (rxt(k,236) + rxt(k,262)) * y(k,103) + rxt(k,245) & + *y(k,116) + rxt(k,294)*y(k,137) + rxt(k,295)*y(k,51) + rxt(k,297) & + *y(k,58)) + mat(k,1568) = -rxt(k,152)*y(k,113) + mat(k,1400) = -(rxt(k,175) + rxt(k,263)) * y(k,113) + mat(k,1443) = -rxt(k,193)*y(k,113) + mat(k,1321) = -rxt(k,210)*y(k,113) + mat(k,1178) = -rxt(k,228)*y(k,113) + mat(k,1660) = -(rxt(k,236) + rxt(k,262)) * y(k,113) + mat(k,1134) = -rxt(k,245)*y(k,113) + mat(k,2054) = -rxt(k,294)*y(k,113) + mat(k,1218) = -rxt(k,295)*y(k,113) + mat(k,401) = -rxt(k,297)*y(k,113) + mat(k,1615) = rxt(k,121)*y(k,94) + mat(k,667) = rxt(k,121)*y(k,63) + mat(k,861) = rxt(k,296)*y(k,137) + mat(k,2054) = mat(k,2054) + rxt(k,296)*y(k,111) + mat(k,561) = -(rxt(k,157)*y(k,126) + rxt(k,163)*y(k,103) + rxt(k,180) & + *y(k,105) + rxt(k,198)*y(k,101) + rxt(k,216)*y(k,120) + rxt(k,233) & + *y(k,117) + rxt(k,251)*y(k,116) + rxt(k,299)*y(k,51)) + mat(k,1564) = -rxt(k,157)*y(k,114) + mat(k,1656) = -rxt(k,163)*y(k,114) + mat(k,1396) = -rxt(k,180)*y(k,114) + mat(k,1439) = -rxt(k,198)*y(k,114) + mat(k,1317) = -rxt(k,216)*y(k,114) + mat(k,1174) = -rxt(k,233)*y(k,114) + mat(k,1130) = -rxt(k,251)*y(k,114) + mat(k,1215) = -rxt(k,299)*y(k,114) + mat(k,1483) = rxt(k,276)*y(k,111) + mat(k,859) = rxt(k,276)*y(k,49) + mat(k,606) = -((rxt(k,146) + rxt(k,269)) * y(k,103) + (rxt(k,167) + rxt(k,270) & + ) * y(k,105) + rxt(k,185)*y(k,101) + rxt(k,202)*y(k,120) & + + rxt(k,220)*y(k,117) + rxt(k,238)*y(k,116) + rxt(k,255) & + *y(k,126)) + mat(k,1657) = -(rxt(k,146) + rxt(k,269)) * y(k,115) + mat(k,1397) = -(rxt(k,167) + rxt(k,270)) * y(k,115) + mat(k,1440) = -rxt(k,185)*y(k,115) + mat(k,1318) = -rxt(k,202)*y(k,115) + mat(k,1175) = -rxt(k,220)*y(k,115) + mat(k,1131) = -rxt(k,238)*y(k,115) + mat(k,1565) = -rxt(k,255)*y(k,115) + mat(k,1216) = rxt(k,300)*y(k,111) + rxt(k,295)*y(k,113) + rxt(k,299)*y(k,114) + mat(k,399) = rxt(k,293)*y(k,112) + rxt(k,297)*y(k,113) + mat(k,860) = rxt(k,300)*y(k,51) + mat(k,621) = rxt(k,293)*y(k,58) + mat(k,686) = rxt(k,295)*y(k,51) + rxt(k,297)*y(k,58) + mat(k,562) = rxt(k,299)*y(k,51) + mat(k,1145) = -(rxt(k,238)*y(k,115) + rxt(k,239)*y(k,92) + rxt(k,240)*y(k,90) & + + rxt(k,241)*y(k,111) + rxt(k,242)*y(k,98) + rxt(k,243)*y(k,125) & + + rxt(k,244)*y(k,95) + rxt(k,245)*y(k,113) + rxt(k,246)*y(k,93) & + + rxt(k,248)*y(k,88) + rxt(k,249)*y(k,94) + rxt(k,250)*y(k,110) & + + rxt(k,251)*y(k,114) + rxt(k,252)*y(k,89) + rxt(k,253)*y(k,112) & + + rxt(k,254)*y(k,109) + rxt(k,365)*y(k,137) + rxt(k,368)*y(k,32) & + + rxt(k,582)*y(k,96)) + mat(k,609) = -rxt(k,238)*y(k,116) + mat(k,1014) = -rxt(k,239)*y(k,116) + mat(k,518) = -rxt(k,240)*y(k,116) + mat(k,867) = -rxt(k,241)*y(k,116) + mat(k,472) = -rxt(k,242)*y(k,116) + mat(k,1534) = -rxt(k,243)*y(k,116) + mat(k,837) = -rxt(k,244)*y(k,116) + mat(k,691) = -rxt(k,245)*y(k,116) + mat(k,503) = -rxt(k,246)*y(k,116) + mat(k,812) = -rxt(k,248)*y(k,116) + mat(k,671) = -rxt(k,249)*y(k,116) + mat(k,549) = -rxt(k,250)*y(k,116) + mat(k,564) = -rxt(k,251)*y(k,116) + mat(k,534) = -rxt(k,252)*y(k,116) + mat(k,626) = -rxt(k,253)*y(k,116) + mat(k,927) = -rxt(k,254)*y(k,116) + mat(k,2066) = -rxt(k,365)*y(k,116) + mat(k,1958) = -rxt(k,368)*y(k,116) + mat(k,1057) = -rxt(k,582)*y(k,116) + mat(k,448) = rxt(k,591)*y(k,126) + mat(k,1712) = rxt(k,593)*y(k,126) + mat(k,1289) = rxt(k,586)*y(k,108) + mat(k,1806) = rxt(k,590)*y(k,122) + mat(k,232) = rxt(k,586)*y(k,69) + mat(k,317) = rxt(k,590)*y(k,71) + mat(k,1579) = rxt(k,591)*y(k,56) + rxt(k,593)*y(k,62) + mat(k,1189) = -(rxt(k,220)*y(k,115) + rxt(k,221)*y(k,92) + rxt(k,222)*y(k,90) & + + rxt(k,223)*y(k,111) + rxt(k,224)*y(k,98) + rxt(k,226)*y(k,125) & + + rxt(k,227)*y(k,95) + rxt(k,228)*y(k,113) + rxt(k,229)*y(k,93) & + + rxt(k,230)*y(k,88) + rxt(k,231)*y(k,94) + rxt(k,232)*y(k,110) & + + rxt(k,233)*y(k,114) + rxt(k,234)*y(k,89) + rxt(k,235)*y(k,112) & + + rxt(k,237)*y(k,109) + rxt(k,303)*y(k,96) + rxt(k,367)*y(k,137)) + mat(k,610) = -rxt(k,220)*y(k,117) + mat(k,1015) = -rxt(k,221)*y(k,117) + mat(k,519) = -rxt(k,222)*y(k,117) + mat(k,868) = -rxt(k,223)*y(k,117) + mat(k,473) = -rxt(k,224)*y(k,117) + mat(k,1535) = -rxt(k,226)*y(k,117) + mat(k,838) = -rxt(k,227)*y(k,117) + mat(k,692) = -rxt(k,228)*y(k,117) + mat(k,504) = -rxt(k,229)*y(k,117) + mat(k,813) = -rxt(k,230)*y(k,117) + mat(k,672) = -rxt(k,231)*y(k,117) + mat(k,550) = -rxt(k,232)*y(k,117) + mat(k,565) = -rxt(k,233)*y(k,117) + mat(k,535) = -rxt(k,234)*y(k,117) + mat(k,627) = -rxt(k,235)*y(k,117) + mat(k,928) = -rxt(k,237)*y(k,117) + mat(k,1058) = -rxt(k,303)*y(k,117) + mat(k,2067) = -rxt(k,367)*y(k,117) + mat(k,1332) = rxt(k,366)*y(k,137) + mat(k,2067) = mat(k,2067) + rxt(k,366)*y(k,120) + mat(k,170) = -(rxt(k,304)*y(k,96) + rxt(k,305)*y(k,137)) + mat(k,1037) = -rxt(k,304)*y(k,118) + mat(k,2034) = -rxt(k,305)*y(k,118) + mat(k,1167) = rxt(k,367)*y(k,137) + mat(k,2034) = mat(k,2034) + rxt(k,367)*y(k,117) + mat(k,261) = -(rxt(k,306)*y(k,96) + rxt(k,307)*y(k,137)) + mat(k,1043) = -rxt(k,306)*y(k,119) + mat(k,2037) = -rxt(k,307)*y(k,119) + mat(k,1942) = rxt(k,368)*y(k,116) + rxt(k,312)*y(k,121) + mat(k,1120) = rxt(k,368)*y(k,32) + mat(k,254) = rxt(k,312)*y(k,32) + mat(k,1335) = -(rxt(k,202)*y(k,115) + rxt(k,204)*y(k,92) + rxt(k,205)*y(k,90) & + + rxt(k,206)*y(k,111) + rxt(k,207)*y(k,98) + rxt(k,208)*y(k,125) & + + rxt(k,209)*y(k,95) + rxt(k,210)*y(k,113) + rxt(k,211)*y(k,93) & + + rxt(k,212)*y(k,88) + rxt(k,213)*y(k,94) + rxt(k,215)*y(k,110) & + + rxt(k,216)*y(k,114) + rxt(k,217)*y(k,89) + rxt(k,218)*y(k,112) & + + rxt(k,219)*y(k,109) + rxt(k,308)*y(k,96) + rxt(k,309)*y(k,40) & + + rxt(k,310)*y(k,99) + rxt(k,311)*y(k,131) + rxt(k,366)*y(k,137)) + mat(k,612) = -rxt(k,202)*y(k,120) + mat(k,1018) = -rxt(k,204)*y(k,120) + mat(k,520) = -rxt(k,205)*y(k,120) + mat(k,871) = -rxt(k,206)*y(k,120) + mat(k,474) = -rxt(k,207)*y(k,120) + mat(k,1538) = -rxt(k,208)*y(k,120) + mat(k,841) = -rxt(k,209)*y(k,120) + mat(k,695) = -rxt(k,210)*y(k,120) + mat(k,506) = -rxt(k,211)*y(k,120) + mat(k,815) = -rxt(k,212)*y(k,120) + mat(k,674) = -rxt(k,213)*y(k,120) + mat(k,551) = -rxt(k,215)*y(k,120) + mat(k,567) = -rxt(k,216)*y(k,120) + mat(k,536) = -rxt(k,217)*y(k,120) + mat(k,630) = -rxt(k,218)*y(k,120) + mat(k,931) = -rxt(k,219)*y(k,120) + mat(k,1061) = -rxt(k,308)*y(k,120) + mat(k,1371) = -rxt(k,309)*y(k,120) + mat(k,903) = -rxt(k,310)*y(k,120) + mat(k,987) = -rxt(k,311)*y(k,120) + mat(k,2070) = -rxt(k,366)*y(k,120) + mat(k,1149) = rxt(k,365)*y(k,137) + mat(k,264) = rxt(k,307)*y(k,137) + mat(k,257) = rxt(k,313)*y(k,137) + mat(k,2070) = mat(k,2070) + rxt(k,365)*y(k,116) + rxt(k,307)*y(k,119) & + + rxt(k,313)*y(k,121) end do - end subroutine nlnmat06 - subroutine nlnmat07( avec_len, mat, y, rxt ) + end subroutine nlnmat08 + subroutine nlnmat09( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -1538,247 +1971,248 @@ subroutine nlnmat07( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,465) = -(rxt(k,157)*y(k,126) + rxt(k,163)*y(k,102) + rxt(k,180) & - *y(k,104) + rxt(k,198)*y(k,100) + rxt(k,216)*y(k,119) + rxt(k,233) & - *y(k,116) + rxt(k,251)*y(k,115) + rxt(k,299)*y(k,49)) - mat(k,1349) = -rxt(k,157)*y(k,113) - mat(k,1685) = -rxt(k,163)*y(k,113) - mat(k,1576) = -rxt(k,180)*y(k,113) - mat(k,1018) = -rxt(k,198)*y(k,113) - mat(k,1059) = -rxt(k,216)*y(k,113) - mat(k,930) = -rxt(k,233)*y(k,113) - mat(k,887) = -rxt(k,251)*y(k,113) - mat(k,1271) = -rxt(k,299)*y(k,113) - mat(k,1142) = rxt(k,276)*y(k,110) - mat(k,709) = rxt(k,276)*y(k,47) - mat(k,503) = -((rxt(k,146) + rxt(k,269)) * y(k,102) + (rxt(k,167) + rxt(k,270) & - ) * y(k,104) + rxt(k,185)*y(k,100) + rxt(k,202)*y(k,119) & - + rxt(k,220)*y(k,116) + rxt(k,238)*y(k,115) + rxt(k,255) & - *y(k,126)) - mat(k,1686) = -(rxt(k,146) + rxt(k,269)) * y(k,114) - mat(k,1577) = -(rxt(k,167) + rxt(k,270)) * y(k,114) - mat(k,1019) = -rxt(k,185)*y(k,114) - mat(k,1060) = -rxt(k,202)*y(k,114) - mat(k,931) = -rxt(k,220)*y(k,114) - mat(k,888) = -rxt(k,238)*y(k,114) - mat(k,1350) = -rxt(k,255)*y(k,114) - mat(k,1273) = rxt(k,300)*y(k,110) + rxt(k,295)*y(k,112) + rxt(k,299)*y(k,113) - mat(k,298) = rxt(k,293)*y(k,111) + rxt(k,297)*y(k,112) - mat(k,710) = rxt(k,300)*y(k,49) - mat(k,518) = rxt(k,293)*y(k,56) - mat(k,558) = rxt(k,295)*y(k,49) + rxt(k,297)*y(k,56) - mat(k,466) = rxt(k,299)*y(k,49) - mat(k,900) = -(rxt(k,238)*y(k,114) + rxt(k,239)*y(k,91) + rxt(k,240)*y(k,89) & - + rxt(k,241)*y(k,110) + rxt(k,242)*y(k,97) + rxt(k,243)*y(k,125) & - + rxt(k,244)*y(k,94) + rxt(k,245)*y(k,112) + rxt(k,246)*y(k,92) & - + rxt(k,248)*y(k,87) + rxt(k,249)*y(k,93) + rxt(k,250)*y(k,109) & - + rxt(k,251)*y(k,113) + rxt(k,252)*y(k,88) + rxt(k,253)*y(k,111) & - + rxt(k,254)*y(k,108) + rxt(k,365)*y(k,137) + rxt(k,583)*y(k,95)) - mat(k,505) = -rxt(k,238)*y(k,115) - mat(k,824) = -rxt(k,239)*y(k,115) - mat(k,395) = -rxt(k,240)*y(k,115) - mat(k,715) = -rxt(k,241)*y(k,115) - mat(k,337) = -rxt(k,242)*y(k,115) - mat(k,1318) = -rxt(k,243)*y(k,115) - mat(k,667) = -rxt(k,244)*y(k,115) - mat(k,562) = -rxt(k,245)*y(k,115) - mat(k,364) = -rxt(k,246)*y(k,115) - mat(k,693) = -rxt(k,248)*y(k,115) - mat(k,544) = -rxt(k,249)*y(k,115) - mat(k,426) = -rxt(k,250)*y(k,115) - mat(k,467) = -rxt(k,251)*y(k,115) - mat(k,411) = -rxt(k,252)*y(k,115) - mat(k,522) = -rxt(k,253)*y(k,115) - mat(k,853) = -rxt(k,254)*y(k,115) - mat(k,1834) = -rxt(k,365)*y(k,115) - mat(k,1546) = -rxt(k,583)*y(k,115) - mat(k,315) = rxt(k,592)*y(k,126) - mat(k,1504) = rxt(k,594)*y(k,126) - mat(k,1421) = rxt(k,587)*y(k,107) - mat(k,1244) = rxt(k,591)*y(k,121) - mat(k,157) = rxt(k,587)*y(k,67) - mat(k,226) = rxt(k,591)*y(k,68) - mat(k,1362) = rxt(k,592)*y(k,54) + rxt(k,594)*y(k,60) - mat(k,943) = -(rxt(k,220)*y(k,114) + rxt(k,221)*y(k,91) + rxt(k,222)*y(k,89) & - + rxt(k,223)*y(k,110) + rxt(k,224)*y(k,97) + rxt(k,226)*y(k,125) & - + rxt(k,227)*y(k,94) + rxt(k,228)*y(k,112) + rxt(k,229)*y(k,92) & - + rxt(k,230)*y(k,87) + rxt(k,231)*y(k,93) + rxt(k,232)*y(k,109) & - + rxt(k,233)*y(k,113) + rxt(k,234)*y(k,88) + rxt(k,235)*y(k,111) & - + rxt(k,237)*y(k,108) + rxt(k,303)*y(k,95) + rxt(k,367)*y(k,137)) - mat(k,506) = -rxt(k,220)*y(k,116) - mat(k,825) = -rxt(k,221)*y(k,116) - mat(k,396) = -rxt(k,222)*y(k,116) - mat(k,716) = -rxt(k,223)*y(k,116) - mat(k,338) = -rxt(k,224)*y(k,116) - mat(k,1319) = -rxt(k,226)*y(k,116) - mat(k,668) = -rxt(k,227)*y(k,116) - mat(k,563) = -rxt(k,228)*y(k,116) - mat(k,365) = -rxt(k,229)*y(k,116) - mat(k,694) = -rxt(k,230)*y(k,116) - mat(k,545) = -rxt(k,231)*y(k,116) - mat(k,427) = -rxt(k,232)*y(k,116) - mat(k,468) = -rxt(k,233)*y(k,116) - mat(k,412) = -rxt(k,234)*y(k,116) - mat(k,523) = -rxt(k,235)*y(k,116) - mat(k,854) = -rxt(k,237)*y(k,116) - mat(k,1547) = -rxt(k,303)*y(k,116) - mat(k,1835) = -rxt(k,367)*y(k,116) - mat(k,1072) = rxt(k,366)*y(k,137) - mat(k,1835) = mat(k,1835) + rxt(k,366)*y(k,119) - mat(k,89) = -(rxt(k,304)*y(k,95) + rxt(k,305)*y(k,137)) - mat(k,1528) = -rxt(k,304)*y(k,117) - mat(k,1805) = -rxt(k,305)*y(k,117) - mat(k,923) = rxt(k,367)*y(k,137) - mat(k,1805) = mat(k,1805) + rxt(k,367)*y(k,116) - mat(k,115) = -(rxt(k,306)*y(k,95) + rxt(k,307)*y(k,137)) - mat(k,1530) = -rxt(k,306)*y(k,118) - mat(k,1807) = -rxt(k,307)*y(k,118) - mat(k,1075) = -(rxt(k,202)*y(k,114) + rxt(k,204)*y(k,91) + rxt(k,205)*y(k,89) & - + rxt(k,206)*y(k,110) + rxt(k,207)*y(k,97) + rxt(k,208)*y(k,125) & - + rxt(k,209)*y(k,94) + rxt(k,210)*y(k,112) + rxt(k,211)*y(k,92) & - + rxt(k,212)*y(k,87) + rxt(k,213)*y(k,93) + rxt(k,215)*y(k,109) & - + rxt(k,216)*y(k,113) + rxt(k,217)*y(k,88) + rxt(k,218)*y(k,111) & - + rxt(k,219)*y(k,108) + rxt(k,308)*y(k,95) + rxt(k,309)*y(k,38) & - + rxt(k,310)*y(k,98) + rxt(k,311)*y(k,131) + rxt(k,366)*y(k,137)) - mat(k,508) = -rxt(k,202)*y(k,119) - mat(k,828) = -rxt(k,204)*y(k,119) - mat(k,398) = -rxt(k,205)*y(k,119) - mat(k,719) = -rxt(k,206)*y(k,119) - mat(k,340) = -rxt(k,207)*y(k,119) - mat(k,1322) = -rxt(k,208)*y(k,119) - mat(k,671) = -rxt(k,209)*y(k,119) - mat(k,566) = -rxt(k,210)*y(k,119) - mat(k,367) = -rxt(k,211)*y(k,119) - mat(k,697) = -rxt(k,212)*y(k,119) - mat(k,548) = -rxt(k,213)*y(k,119) - mat(k,430) = -rxt(k,215)*y(k,119) - mat(k,470) = -rxt(k,216)*y(k,119) - mat(k,414) = -rxt(k,217)*y(k,119) - mat(k,526) = -rxt(k,218)*y(k,119) - mat(k,857) = -rxt(k,219)*y(k,119) - mat(k,1550) = -rxt(k,308)*y(k,119) - mat(k,1780) = -rxt(k,309)*y(k,119) - mat(k,751) = -rxt(k,310)*y(k,119) - mat(k,798) = -rxt(k,311)*y(k,119) - mat(k,1838) = -rxt(k,366)*y(k,119) - mat(k,904) = rxt(k,365)*y(k,137) - mat(k,117) = rxt(k,307)*y(k,137) - mat(k,111) = rxt(k,313)*y(k,137) - mat(k,1838) = mat(k,1838) + rxt(k,365)*y(k,115) + rxt(k,307)*y(k,118) & - + rxt(k,313)*y(k,120) - mat(k,108) = -(rxt(k,313)*y(k,137) + rxt(k,384)*y(k,95)) - mat(k,1806) = -rxt(k,313)*y(k,120) - mat(k,1529) = -rxt(k,384)*y(k,120) - mat(k,223) = -(rxt(k,589)*y(k,67) + (rxt(k,590) + rxt(k,591)) * y(k,68)) - mat(k,1397) = -rxt(k,589)*y(k,121) - mat(k,1225) = -(rxt(k,590) + rxt(k,591)) * y(k,121) - mat(k,216) = rxt(k,597)*y(k,134) - mat(k,263) = rxt(k,597)*y(k,106) - mat(k,637) = -(rxt(k,389)*y(k,39) + rxt(k,390)*y(k,137) + (rxt(k,392) & - + rxt(k,393)) * y(k,68) + rxt(k,394)*y(k,69) + (rxt(k,482) & - + rxt(k,483)) * y(k,47) + (rxt(k,505) + rxt(k,506)) * y(k,43) & - + rxt(k,511)*y(k,31) + rxt(k,512)*y(k,32)) - mat(k,486) = -rxt(k,389)*y(k,122) - mat(k,1827) = -rxt(k,390)*y(k,122) - mat(k,1236) = -(rxt(k,392) + rxt(k,393)) * y(k,122) - mat(k,1187) = -rxt(k,394)*y(k,122) - mat(k,1146) = -(rxt(k,482) + rxt(k,483)) * y(k,122) - mat(k,241) = -(rxt(k,505) + rxt(k,506)) * y(k,122) - mat(k,29) = -rxt(k,511)*y(k,122) - mat(k,34) = -rxt(k,512)*y(k,122) - mat(k,1236) = mat(k,1236) + rxt(k,425)*y(k,106) - mat(k,1543) = .850_r8*rxt(k,584)*y(k,126) - mat(k,219) = rxt(k,425)*y(k,68) - mat(k,1354) = .850_r8*rxt(k,584)*y(k,95) - mat(k,246) = -(rxt(k,321)*y(k,125) + rxt(k,339)*y(k,130) + rxt(k,361) & - *y(k,133) + rxt(k,396)*y(k,67) + rxt(k,397)*y(k,68)) - mat(k,1307) = -rxt(k,321)*y(k,123) - mat(k,349) = -rxt(k,339)*y(k,123) - mat(k,1643) = -rxt(k,361)*y(k,123) - mat(k,1400) = -rxt(k,396)*y(k,123) - mat(k,1226) = -rxt(k,397)*y(k,123) - mat(k,1400) = mat(k,1400) + rxt(k,400)*y(k,124) - mat(k,1226) = mat(k,1226) + rxt(k,401)*y(k,124) - mat(k,1179) = rxt(k,402)*y(k,124) - mat(k,43) = rxt(k,400)*y(k,67) + rxt(k,401)*y(k,68) + rxt(k,402)*y(k,69) - mat(k,42) = -(rxt(k,400)*y(k,67) + rxt(k,401)*y(k,68) + rxt(k,402)*y(k,69)) - mat(k,1385) = -rxt(k,400)*y(k,124) - mat(k,1218) = -rxt(k,401)*y(k,124) - mat(k,1177) = -rxt(k,402)*y(k,124) - mat(k,1218) = mat(k,1218) + rxt(k,392)*y(k,122) - mat(k,627) = rxt(k,392)*y(k,68) - mat(k,1328) = -(rxt(k,150)*y(k,126) + rxt(k,173)*y(k,104) + rxt(k,190) & - *y(k,100) + rxt(k,208)*y(k,119) + rxt(k,214)*y(k,102) + rxt(k,226) & - *y(k,116) + rxt(k,243)*y(k,115) + rxt(k,314)*y(k,86) + rxt(k,315) & - *y(k,26) + rxt(k,317)*y(k,38) + rxt(k,318)*y(k,47) + rxt(k,319) & - *y(k,49) + rxt(k,320)*y(k,61) + rxt(k,321)*y(k,123) + rxt(k,322) & - *y(k,68) + rxt(k,323)*y(k,69) + (rxt(k,324) + rxt(k,325) & - ) * y(k,67)) - mat(k,1372) = -rxt(k,150)*y(k,125) - mat(k,1598) = -rxt(k,173)*y(k,125) - mat(k,1040) = -rxt(k,190)*y(k,125) - mat(k,1081) = -rxt(k,208)*y(k,125) - mat(k,1707) = -rxt(k,214)*y(k,125) - mat(k,952) = -rxt(k,226)*y(k,125) - mat(k,910) = -rxt(k,243)*y(k,125) - mat(k,1473) = -rxt(k,314)*y(k,125) - mat(k,1751) = -rxt(k,315)*y(k,125) - mat(k,1786) = -rxt(k,317)*y(k,125) - mat(k,1164) = -rxt(k,318)*y(k,125) - mat(k,1293) = -rxt(k,319)*y(k,125) - mat(k,998) = -rxt(k,320)*y(k,125) - mat(k,250) = -rxt(k,321)*y(k,125) - mat(k,1254) = -rxt(k,322)*y(k,125) - mat(k,1205) = -rxt(k,323)*y(k,125) - mat(k,1431) = -(rxt(k,324) + rxt(k,325)) * y(k,125) - mat(k,1431) = mat(k,1431) + rxt(k,125)*y(k,91) + rxt(k,334)*y(k,128) - mat(k,1254) = mat(k,1254) + (rxt(k,133)+rxt(k,135))*y(k,95) - mat(k,834) = rxt(k,125)*y(k,67) - mat(k,1556) = (rxt(k,133)+rxt(k,135))*y(k,68) - mat(k,445) = rxt(k,334)*y(k,67) - mat(k,1373) = -(rxt(k,148)*y(k,110) + rxt(k,149)*y(k,97) + rxt(k,150) & - *y(k,125) + rxt(k,151)*y(k,94) + rxt(k,152)*y(k,112) + rxt(k,153) & - *y(k,92) + rxt(k,154)*y(k,87) + rxt(k,155)*y(k,93) + rxt(k,156) & - *y(k,109) + rxt(k,157)*y(k,113) + rxt(k,159)*y(k,88) + rxt(k,160) & - *y(k,111) + rxt(k,161)*y(k,108) + rxt(k,255)*y(k,114) + rxt(k,256) & - *y(k,91) + rxt(k,257)*y(k,89) + rxt(k,329)*y(k,137) + rxt(k,364) & - *y(k,68) + rxt(k,584)*y(k,95) + rxt(k,592)*y(k,54) + rxt(k,594) & - *y(k,60)) - mat(k,725) = -rxt(k,148)*y(k,126) - mat(k,342) = -rxt(k,149)*y(k,126) - mat(k,1329) = -rxt(k,150)*y(k,126) - mat(k,676) = -rxt(k,151)*y(k,126) - mat(k,570) = -rxt(k,152)*y(k,126) - mat(k,369) = -rxt(k,153)*y(k,126) - mat(k,701) = -rxt(k,154)*y(k,126) - mat(k,550) = -rxt(k,155)*y(k,126) - mat(k,432) = -rxt(k,156)*y(k,126) - mat(k,475) = -rxt(k,157)*y(k,126) - mat(k,417) = -rxt(k,159)*y(k,126) - mat(k,530) = -rxt(k,160)*y(k,126) - mat(k,864) = -rxt(k,161)*y(k,126) - mat(k,512) = -rxt(k,255)*y(k,126) - mat(k,835) = -rxt(k,256)*y(k,126) - mat(k,401) = -rxt(k,257)*y(k,126) - mat(k,1845) = -rxt(k,329)*y(k,126) - mat(k,1255) = -rxt(k,364)*y(k,126) - mat(k,1557) = -rxt(k,584)*y(k,126) - mat(k,318) = -rxt(k,592)*y(k,126) - mat(k,1515) = -rxt(k,594)*y(k,126) - mat(k,1432) = rxt(k,338)*y(k,130) - mat(k,1255) = mat(k,1255) + rxt(k,586)*y(k,107) + rxt(k,590)*y(k,121) & - + rxt(k,598)*y(k,134) + rxt(k,602)*y(k,135) - mat(k,159) = rxt(k,586)*y(k,68) - mat(k,228) = rxt(k,590)*y(k,68) - mat(k,251) = rxt(k,339)*y(k,130) - mat(k,1329) = mat(k,1329) + 2.000_r8*rxt(k,150)*y(k,126) - mat(k,1373) = mat(k,1373) + 2.000_r8*rxt(k,150)*y(k,125) - mat(k,356) = rxt(k,338)*y(k,67) + rxt(k,339)*y(k,123) - mat(k,271) = rxt(k,598)*y(k,68) - mat(k,132) = rxt(k,602)*y(k,68) + mat(k,253) = -(rxt(k,312)*y(k,32) + rxt(k,313)*y(k,137) + rxt(k,384)*y(k,96)) + mat(k,1941) = -rxt(k,312)*y(k,121) + mat(k,2036) = -rxt(k,313)*y(k,121) + mat(k,1042) = -rxt(k,384)*y(k,121) + mat(k,314) = -(rxt(k,588)*y(k,69) + (rxt(k,589) + rxt(k,590)) * y(k,71)) + mat(k,1263) = -rxt(k,588)*y(k,122) + mat(k,1786) = -(rxt(k,589) + rxt(k,590)) * y(k,122) + mat(k,298) = rxt(k,596)*y(k,134) + mat(k,384) = rxt(k,596)*y(k,107) + mat(k,374) = -(rxt(k,321)*y(k,125) + rxt(k,339)*y(k,130) + rxt(k,361) & + *y(k,133) + rxt(k,396)*y(k,69) + rxt(k,397)*y(k,71)) + mat(k,1522) = -rxt(k,321)*y(k,123) + mat(k,457) = -rxt(k,339)*y(k,123) + mat(k,1861) = -rxt(k,361)*y(k,123) + mat(k,1269) = -rxt(k,396)*y(k,123) + mat(k,1788) = -rxt(k,397)*y(k,123) + mat(k,1943) = rxt(k,398)*y(k,124) + mat(k,1269) = mat(k,1269) + rxt(k,400)*y(k,124) + mat(k,1788) = mat(k,1788) + rxt(k,401)*y(k,124) + mat(k,1900) = rxt(k,402)*y(k,124) + mat(k,129) = rxt(k,398)*y(k,32) + rxt(k,400)*y(k,69) + rxt(k,401)*y(k,71) & + + rxt(k,402)*y(k,72) + mat(k,128) = -(rxt(k,398)*y(k,32) + rxt(k,400)*y(k,69) + rxt(k,401)*y(k,71) & + + rxt(k,402)*y(k,72)) + mat(k,1938) = -rxt(k,398)*y(k,124) + mat(k,1251) = -rxt(k,400)*y(k,124) + mat(k,1779) = -rxt(k,401)*y(k,124) + mat(k,1897) = -rxt(k,402)*y(k,124) + mat(k,770) = rxt(k,392)*y(k,71) + mat(k,1779) = mat(k,1779) + rxt(k,392)*y(k,70) + mat(k,1543) = -(rxt(k,150)*y(k,126) + rxt(k,173)*y(k,105) + rxt(k,190) & + *y(k,101) + rxt(k,208)*y(k,120) + rxt(k,214)*y(k,103) + rxt(k,226) & + *y(k,117) + rxt(k,243)*y(k,116) + rxt(k,314)*y(k,25) + rxt(k,315) & + *y(k,28) + rxt(k,316)*y(k,32) + rxt(k,317)*y(k,40) + rxt(k,318) & + *y(k,49) + rxt(k,319)*y(k,51) + rxt(k,320)*y(k,63) + rxt(k,321) & + *y(k,123) + rxt(k,322)*y(k,71) + rxt(k,323)*y(k,72) + (rxt(k,324) & + + rxt(k,325)) * y(k,69)) + mat(k,1588) = -rxt(k,150)*y(k,125) + mat(k,1419) = -rxt(k,173)*y(k,125) + mat(k,1462) = -rxt(k,190)*y(k,125) + mat(k,1340) = -rxt(k,208)*y(k,125) + mat(k,1679) = -rxt(k,214)*y(k,125) + mat(k,1197) = -rxt(k,226)*y(k,125) + mat(k,1154) = -rxt(k,243)*y(k,125) + mat(k,2015) = -rxt(k,314)*y(k,125) + mat(k,1766) = -rxt(k,315)*y(k,125) + mat(k,1967) = -rxt(k,316)*y(k,125) + mat(k,1376) = -rxt(k,317)*y(k,125) + mat(k,1507) = -rxt(k,318)*y(k,125) + mat(k,1238) = -rxt(k,319)*y(k,125) + mat(k,1636) = -rxt(k,320)*y(k,125) + mat(k,377) = -rxt(k,321)*y(k,125) + mat(k,1815) = -rxt(k,322)*y(k,125) + mat(k,1925) = -rxt(k,323)*y(k,125) + mat(k,1298) = -(rxt(k,324) + rxt(k,325)) * y(k,125) + mat(k,1298) = mat(k,1298) + rxt(k,125)*y(k,92) + rxt(k,334)*y(k,128) + mat(k,1815) = mat(k,1815) + (rxt(k,133)+rxt(k,135))*y(k,96) + mat(k,1023) = rxt(k,125)*y(k,69) + mat(k,1066) = (rxt(k,133)+rxt(k,135))*y(k,71) + mat(k,598) = rxt(k,334)*y(k,69) + mat(k,1589) = -(rxt(k,148)*y(k,111) + rxt(k,149)*y(k,98) + rxt(k,150) & + *y(k,125) + rxt(k,151)*y(k,95) + rxt(k,152)*y(k,113) + rxt(k,153) & + *y(k,93) + rxt(k,154)*y(k,88) + rxt(k,155)*y(k,94) + rxt(k,156) & + *y(k,110) + rxt(k,157)*y(k,114) + rxt(k,159)*y(k,89) + rxt(k,160) & + *y(k,112) + rxt(k,161)*y(k,109) + rxt(k,255)*y(k,115) + rxt(k,256) & + *y(k,92) + rxt(k,257)*y(k,90) + rxt(k,329)*y(k,137) + rxt(k,364) & + *y(k,71) + rxt(k,583)*y(k,96) + rxt(k,591)*y(k,56) + rxt(k,593) & + *y(k,62)) + mat(k,876) = -rxt(k,148)*y(k,126) + mat(k,478) = -rxt(k,149)*y(k,126) + mat(k,1544) = -rxt(k,150)*y(k,126) + mat(k,847) = -rxt(k,151)*y(k,126) + mat(k,699) = -rxt(k,152)*y(k,126) + mat(k,510) = -rxt(k,153)*y(k,126) + mat(k,820) = -rxt(k,154)*y(k,126) + mat(k,678) = -rxt(k,155)*y(k,126) + mat(k,555) = -rxt(k,156)*y(k,126) + mat(k,572) = -rxt(k,157)*y(k,126) + mat(k,541) = -rxt(k,159)*y(k,126) + mat(k,634) = -rxt(k,160)*y(k,126) + mat(k,936) = -rxt(k,161)*y(k,126) + mat(k,615) = -rxt(k,255)*y(k,126) + mat(k,1024) = -rxt(k,256)*y(k,126) + mat(k,525) = -rxt(k,257)*y(k,126) + mat(k,2076) = -rxt(k,329)*y(k,126) + mat(k,1816) = -rxt(k,364)*y(k,126) + mat(k,1067) = -rxt(k,583)*y(k,126) + mat(k,451) = -rxt(k,591)*y(k,126) + mat(k,1722) = -rxt(k,593)*y(k,126) + mat(k,1968) = rxt(k,594)*y(k,134) + mat(k,1299) = rxt(k,338)*y(k,130) + mat(k,1816) = mat(k,1816) + rxt(k,585)*y(k,108) + rxt(k,589)*y(k,122) & + + rxt(k,597)*y(k,134) + rxt(k,601)*y(k,135) + mat(k,234) = rxt(k,585)*y(k,71) + mat(k,319) = rxt(k,589)*y(k,71) + mat(k,378) = rxt(k,339)*y(k,130) + mat(k,1544) = mat(k,1544) + 2.000_r8*rxt(k,150)*y(k,126) + mat(k,1589) = mat(k,1589) + 2.000_r8*rxt(k,150)*y(k,125) + mat(k,465) = rxt(k,338)*y(k,69) + rxt(k,339)*y(k,123) + mat(k,392) = rxt(k,594)*y(k,32) + rxt(k,597)*y(k,71) + mat(k,201) = rxt(k,601)*y(k,71) + mat(k,289) = -(rxt(k,326)*y(k,96) + (rxt(k,327) + rxt(k,328)) * y(k,137)) + mat(k,1046) = -rxt(k,326)*y(k,127) + mat(k,2040) = -(rxt(k,327) + rxt(k,328)) * y(k,127) + mat(k,1556) = rxt(k,329)*y(k,137) + mat(k,456) = rxt(k,337)*y(k,137) + mat(k,2040) = mat(k,2040) + rxt(k,329)*y(k,126) + rxt(k,337)*y(k,130) + mat(k,591) = -((rxt(k,272) + rxt(k,279)) * y(k,62) + (rxt(k,277) + rxt(k,278) & + ) * y(k,63) + rxt(k,330)*y(k,32) + rxt(k,331)*y(k,40) + rxt(k,332) & + *y(k,72) + (rxt(k,333) + rxt(k,334)) * y(k,69)) + mat(k,1698) = -(rxt(k,272) + rxt(k,279)) * y(k,128) + mat(k,1611) = -(rxt(k,277) + rxt(k,278)) * y(k,128) + mat(k,1948) = -rxt(k,330)*y(k,128) + mat(k,1354) = -rxt(k,331)*y(k,128) + mat(k,1904) = -rxt(k,332)*y(k,128) + mat(k,1275) = -(rxt(k,333) + rxt(k,334)) * y(k,128) + mat(k,1275) = mat(k,1275) + rxt(k,336)*y(k,129) + mat(k,1794) = rxt(k,126)*y(k,92) + rxt(k,362)*y(k,133) + mat(k,1904) = mat(k,1904) + rxt(k,132)*y(k,95) + rxt(k,323)*y(k,125) & + + rxt(k,348)*y(k,132) + rxt(k,363)*y(k,133) + mat(k,1004) = rxt(k,126)*y(k,71) + mat(k,828) = rxt(k,132)*y(k,72) + mat(k,1524) = rxt(k,323)*y(k,72) + mat(k,237) = rxt(k,336)*y(k,69) + mat(k,1830) = rxt(k,348)*y(k,72) + mat(k,1863) = rxt(k,362)*y(k,71) + rxt(k,363)*y(k,72) + mat(k,236) = -(rxt(k,335)*y(k,32) + rxt(k,336)*y(k,69)) + mat(k,1939) = -rxt(k,335)*y(k,129) + mat(k,1258) = -rxt(k,336)*y(k,129) + mat(k,1783) = rxt(k,322)*y(k,125) + mat(k,1520) = rxt(k,322)*y(k,71) + mat(k,458) = -(rxt(k,337)*y(k,137) + rxt(k,338)*y(k,69) + rxt(k,339)*y(k,123) & + + rxt(k,380)*y(k,96)) + mat(k,2045) = -rxt(k,337)*y(k,130) + mat(k,1272) = -rxt(k,338)*y(k,130) + mat(k,375) = -rxt(k,339)*y(k,130) + mat(k,1051) = -rxt(k,380)*y(k,130) + mat(k,1791) = rxt(k,364)*y(k,126) + mat(k,1558) = rxt(k,364)*y(k,71) + mat(k,981) = -(rxt(k,311)*y(k,120) + rxt(k,340)*y(k,55) + rxt(k,349)*y(k,62) & + + rxt(k,415)*y(k,41) + rxt(k,416)*y(k,43) + rxt(k,417)*y(k,99) & + + rxt(k,418)*y(k,69) + rxt(k,419)*y(k,72) + (4._r8*rxt(k,420) & + + 4._r8*rxt(k,421)) * y(k,131) + rxt(k,423)*y(k,52) + rxt(k,437) & + *y(k,64) + rxt(k,438)*y(k,56) + rxt(k,446)*y(k,63) + rxt(k,447) & + *y(k,51) + rxt(k,466)*y(k,29) + (rxt(k,468) + rxt(k,469) & + ) * y(k,28) + rxt(k,471)*y(k,49) + rxt(k,474)*y(k,54) + rxt(k,498) & + *y(k,5) + rxt(k,500)*y(k,45) + rxt(k,514)*y(k,16) + rxt(k,516) & + *y(k,18) + rxt(k,517)*y(k,19) + rxt(k,519)*y(k,20) + rxt(k,521) & + *y(k,24) + rxt(k,522)*y(k,46) + rxt(k,523)*y(k,47) + rxt(k,524) & + *y(k,48) + rxt(k,532)*y(k,17) + rxt(k,535)*y(k,22) + rxt(k,536) & + *y(k,23) + rxt(k,540)*y(k,31) + (rxt(k,542) + rxt(k,556) & + ) * y(k,35) + rxt(k,544)*y(k,74) + rxt(k,546)*y(k,80) + rxt(k,550) & + *y(k,77) + rxt(k,555)*y(k,79)) + mat(k,1327) = -rxt(k,311)*y(k,131) + mat(k,276) = -rxt(k,340)*y(k,131) + mat(k,1708) = -rxt(k,349)*y(k,131) + mat(k,648) = -rxt(k,415)*y(k,131) + mat(k,213) = -rxt(k,416)*y(k,131) + mat(k,898) = -rxt(k,417)*y(k,131) + mat(k,1285) = -rxt(k,418)*y(k,131) + mat(k,1912) = -rxt(k,419)*y(k,131) + mat(k,185) = -rxt(k,423)*y(k,131) + mat(k,1094) = -rxt(k,437)*y(k,131) + mat(k,446) = -rxt(k,438)*y(k,131) + mat(k,1623) = -rxt(k,446)*y(k,131) + mat(k,1225) = -rxt(k,447)*y(k,131) + mat(k,357) = -rxt(k,466)*y(k,131) + mat(k,1753) = -(rxt(k,468) + rxt(k,469)) * y(k,131) + mat(k,1494) = -rxt(k,471)*y(k,131) + mat(k,323) = -rxt(k,474)*y(k,131) + mat(k,716) = -rxt(k,498)*y(k,131) + mat(k,333) = -rxt(k,500)*y(k,131) + mat(k,179) = -rxt(k,514)*y(k,131) + mat(k,223) = -rxt(k,516)*y(k,131) + mat(k,47) = -rxt(k,517)*y(k,131) + mat(k,148) = -rxt(k,519)*y(k,131) + mat(k,155) = -rxt(k,521)*y(k,131) + mat(k,78) = -rxt(k,522)*y(k,131) + mat(k,87) = -rxt(k,523)*y(k,131) + mat(k,116) = -rxt(k,524)*y(k,131) + mat(k,738) = -rxt(k,532)*y(k,131) + mat(k,161) = -rxt(k,535)*y(k,131) + mat(k,419) = -rxt(k,536)*y(k,131) + mat(k,251) = -rxt(k,540)*y(k,131) + mat(k,125) = -(rxt(k,542) + rxt(k,556)) * y(k,131) + mat(k,141) = -rxt(k,544)*y(k,131) + mat(k,351) = -rxt(k,546)*y(k,131) + mat(k,270) = -rxt(k,550)*y(k,131) + mat(k,491) = -rxt(k,555)*y(k,131) + mat(k,738) = mat(k,738) + rxt(k,531)*y(k,69) + mat(k,161) = mat(k,161) + .300_r8*rxt(k,535)*y(k,131) + mat(k,419) = mat(k,419) + rxt(k,537)*y(k,70) + mat(k,2002) = rxt(k,455)*y(k,99) + rxt(k,341)*y(k,132) + mat(k,1753) = mat(k,1753) + rxt(k,342)*y(k,132) + mat(k,342) = rxt(k,509)*y(k,137) + mat(k,1363) = rxt(k,414)*y(k,72) + rxt(k,129)*y(k,95) + 2.000_r8*rxt(k,409) & + *y(k,99) + mat(k,648) = mat(k,648) + rxt(k,406)*y(k,69) + rxt(k,389)*y(k,70) + mat(k,213) = mat(k,213) + rxt(k,407)*y(k,69) + mat(k,333) = mat(k,333) + rxt(k,499)*y(k,69) + rxt(k,505)*y(k,70) + mat(k,1494) = mat(k,1494) + rxt(k,470)*y(k,69) + rxt(k,482)*y(k,70) & + + rxt(k,356)*y(k,133) + mat(k,1225) = mat(k,1225) + rxt(k,124)*y(k,92) + rxt(k,357)*y(k,133) + mat(k,309) = rxt(k,501)*y(k,69) + mat(k,323) = mat(k,323) + rxt(k,473)*y(k,69) + mat(k,1708) = mat(k,1708) + rxt(k,439)*y(k,99) + mat(k,1623) = mat(k,1623) + rxt(k,346)*y(k,132) + mat(k,1094) = mat(k,1094) + rxt(k,434)*y(k,99) + mat(k,1285) = mat(k,1285) + rxt(k,531)*y(k,17) + rxt(k,406)*y(k,41) & + + rxt(k,407)*y(k,43) + rxt(k,499)*y(k,45) + rxt(k,470)*y(k,49) & + + rxt(k,501)*y(k,53) + rxt(k,473)*y(k,54) + rxt(k,412)*y(k,99) + mat(k,786) = rxt(k,537)*y(k,23) + rxt(k,389)*y(k,41) + rxt(k,505)*y(k,45) & + + rxt(k,482)*y(k,49) + 2.000_r8*rxt(k,390)*y(k,137) + mat(k,1912) = mat(k,1912) + rxt(k,414)*y(k,40) + rxt(k,413)*y(k,99) & + + rxt(k,348)*y(k,132) + mat(k,1010) = rxt(k,124)*y(k,51) + mat(k,834) = rxt(k,129)*y(k,40) + mat(k,1054) = rxt(k,138)*y(k,97) + mat(k,166) = rxt(k,138)*y(k,96) + rxt(k,139)*y(k,137) + mat(k,471) = rxt(k,189)*y(k,101) + rxt(k,203)*y(k,103) + rxt(k,172)*y(k,105) & + + rxt(k,242)*y(k,116) + rxt(k,224)*y(k,117) + rxt(k,207) & + *y(k,120) + rxt(k,149)*y(k,126) + mat(k,898) = mat(k,898) + rxt(k,455)*y(k,25) + 2.000_r8*rxt(k,409)*y(k,40) & + + rxt(k,439)*y(k,62) + rxt(k,434)*y(k,64) + rxt(k,412)*y(k,69) & + + rxt(k,413)*y(k,72) + mat(k,1449) = rxt(k,189)*y(k,98) + mat(k,1666) = rxt(k,203)*y(k,98) + mat(k,1406) = rxt(k,172)*y(k,98) + mat(k,1141) = rxt(k,242)*y(k,98) + mat(k,1184) = rxt(k,224)*y(k,98) + mat(k,1327) = mat(k,1327) + rxt(k,207)*y(k,98) + mat(k,1575) = rxt(k,149)*y(k,98) + mat(k,290) = rxt(k,328)*y(k,137) + mat(k,981) = mat(k,981) + .300_r8*rxt(k,535)*y(k,22) + mat(k,1835) = rxt(k,341)*y(k,25) + rxt(k,342)*y(k,28) + rxt(k,346)*y(k,63) & + + rxt(k,348)*y(k,72) + mat(k,1871) = rxt(k,356)*y(k,49) + rxt(k,357)*y(k,51) + rxt(k,355)*y(k,137) + mat(k,2062) = rxt(k,509)*y(k,39) + 2.000_r8*rxt(k,390)*y(k,70) + rxt(k,139) & + *y(k,97) + rxt(k,328)*y(k,127) + rxt(k,355)*y(k,133) end do - end subroutine nlnmat07 - subroutine nlnmat08( avec_len, mat, y, rxt ) + end subroutine nlnmat09 + subroutine nlnmat10( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -1796,378 +2230,266 @@ subroutine nlnmat08( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,189) = -(rxt(k,326)*y(k,95) + (rxt(k,327) + rxt(k,328)) * y(k,137)) - mat(k,1537) = -rxt(k,326)*y(k,127) - mat(k,1811) = -(rxt(k,327) + rxt(k,328)) * y(k,127) - mat(k,1341) = rxt(k,329)*y(k,137) - mat(k,348) = rxt(k,337)*y(k,137) - mat(k,1811) = mat(k,1811) + rxt(k,329)*y(k,126) + rxt(k,337)*y(k,130) - mat(k,438) = -((rxt(k,272) + rxt(k,279)) * y(k,60) + (rxt(k,277) + rxt(k,278) & - ) * y(k,61) + rxt(k,331)*y(k,38) + rxt(k,332)*y(k,69) + (rxt(k,333) & - + rxt(k,334)) * y(k,67)) - mat(k,1491) = -(rxt(k,272) + rxt(k,279)) * y(k,128) - mat(k,973) = -(rxt(k,277) + rxt(k,278)) * y(k,128) - mat(k,1765) = -rxt(k,331)*y(k,128) - mat(k,1183) = -rxt(k,332)*y(k,128) - mat(k,1408) = -(rxt(k,333) + rxt(k,334)) * y(k,128) - mat(k,1408) = mat(k,1408) + rxt(k,336)*y(k,129) - mat(k,1232) = rxt(k,126)*y(k,91) + rxt(k,362)*y(k,133) - mat(k,1183) = mat(k,1183) + rxt(k,132)*y(k,94) + rxt(k,323)*y(k,125) & - + rxt(k,348)*y(k,132) + rxt(k,363)*y(k,133) - mat(k,816) = rxt(k,126)*y(k,68) - mat(k,659) = rxt(k,132)*y(k,69) - mat(k,1310) = rxt(k,323)*y(k,69) - mat(k,96) = rxt(k,336)*y(k,67) - mat(k,1613) = rxt(k,348)*y(k,69) - mat(k,1645) = rxt(k,362)*y(k,68) + rxt(k,363)*y(k,69) - mat(k,95) = -(rxt(k,336)*y(k,67)) - mat(k,1387) = -rxt(k,336)*y(k,129) - mat(k,1219) = rxt(k,322)*y(k,125) - mat(k,1306) = rxt(k,322)*y(k,68) - mat(k,350) = -(rxt(k,337)*y(k,137) + rxt(k,338)*y(k,67) + rxt(k,339)*y(k,123) & - + rxt(k,380)*y(k,95)) - mat(k,1815) = -rxt(k,337)*y(k,130) - mat(k,1406) = -rxt(k,338)*y(k,130) - mat(k,247) = -rxt(k,339)*y(k,130) - mat(k,1542) = -rxt(k,380)*y(k,130) - mat(k,1230) = rxt(k,364)*y(k,126) - mat(k,1344) = rxt(k,364)*y(k,68) - mat(k,794) = -(rxt(k,311)*y(k,119) + rxt(k,340)*y(k,53) + rxt(k,349)*y(k,60) & - + rxt(k,415)*y(k,39) + rxt(k,416)*y(k,41) + rxt(k,417)*y(k,98) & - + rxt(k,418)*y(k,67) + rxt(k,419)*y(k,69) + (4._r8*rxt(k,420) & - + 4._r8*rxt(k,421)) * y(k,131) + rxt(k,423)*y(k,50) + rxt(k,437) & - *y(k,62) + rxt(k,438)*y(k,54) + rxt(k,446)*y(k,61) + rxt(k,447) & - *y(k,49) + rxt(k,466)*y(k,27) + (rxt(k,468) + rxt(k,469) & - ) * y(k,26) + rxt(k,471)*y(k,47) + rxt(k,474)*y(k,52) + rxt(k,498) & - *y(k,4) + rxt(k,500)*y(k,43) + rxt(k,532)*y(k,16) + rxt(k,535) & - *y(k,21) + (rxt(k,537) + rxt(k,541)) * y(k,29) + rxt(k,543) & - *y(k,71) + rxt(k,548)*y(k,74) + rxt(k,553)*y(k,76) + rxt(k,554) & - *y(k,77) + (rxt(k,557) + rxt(k,558)) * y(k,33)) - mat(k,1068) = -rxt(k,311)*y(k,131) - mat(k,176) = -rxt(k,340)*y(k,131) - mat(k,1501) = -rxt(k,349)*y(k,131) - mat(k,488) = -rxt(k,415)*y(k,131) - mat(k,148) = -rxt(k,416)*y(k,131) - mat(k,748) = -rxt(k,417)*y(k,131) - mat(k,1418) = -rxt(k,418)*y(k,131) - mat(k,1192) = -rxt(k,419)*y(k,131) - mat(k,103) = -rxt(k,423)*y(k,131) - mat(k,1108) = -rxt(k,437)*y(k,131) - mat(k,314) = -rxt(k,438)*y(k,131) - mat(k,985) = -rxt(k,446)*y(k,131) - mat(k,1280) = -rxt(k,447)*y(k,131) - mat(k,278) = -rxt(k,466)*y(k,131) - mat(k,1738) = -(rxt(k,468) + rxt(k,469)) * y(k,131) - mat(k,1151) = -rxt(k,471)*y(k,131) - mat(k,232) = -rxt(k,474)*y(k,131) - mat(k,588) = -rxt(k,498)*y(k,131) - mat(k,242) = -rxt(k,500)*y(k,131) - mat(k,609) = -rxt(k,532)*y(k,131) - mat(k,80) = -rxt(k,535)*y(k,131) - mat(k,136) = -(rxt(k,537) + rxt(k,541)) * y(k,131) - mat(k,74) = -rxt(k,543)*y(k,131) - mat(k,170) = -rxt(k,548)*y(k,131) - mat(k,383) = -rxt(k,553)*y(k,131) - mat(k,258) = -rxt(k,554)*y(k,131) - mat(k,61) = -(rxt(k,557) + rxt(k,558)) * y(k,131) - mat(k,609) = mat(k,609) + rxt(k,531)*y(k,67) - mat(k,80) = mat(k,80) + .300_r8*rxt(k,535)*y(k,131) - mat(k,1738) = mat(k,1738) + rxt(k,342)*y(k,132) - mat(k,201) = rxt(k,509)*y(k,137) - mat(k,1773) = rxt(k,414)*y(k,69) + rxt(k,129)*y(k,94) + 2.000_r8*rxt(k,409) & - *y(k,98) - mat(k,488) = mat(k,488) + rxt(k,406)*y(k,67) + rxt(k,389)*y(k,122) - mat(k,148) = mat(k,148) + rxt(k,407)*y(k,67) - mat(k,242) = mat(k,242) + rxt(k,499)*y(k,67) + rxt(k,505)*y(k,122) - mat(k,1151) = mat(k,1151) + rxt(k,470)*y(k,67) + rxt(k,482)*y(k,122) & - + rxt(k,356)*y(k,133) - mat(k,1280) = mat(k,1280) + rxt(k,124)*y(k,91) + rxt(k,357)*y(k,133) - mat(k,210) = rxt(k,501)*y(k,67) - mat(k,232) = mat(k,232) + rxt(k,473)*y(k,67) - mat(k,1501) = mat(k,1501) + rxt(k,439)*y(k,98) - mat(k,985) = mat(k,985) + rxt(k,346)*y(k,132) - mat(k,1108) = mat(k,1108) + rxt(k,434)*y(k,98) - mat(k,1418) = mat(k,1418) + rxt(k,531)*y(k,16) + rxt(k,406)*y(k,39) & - + rxt(k,407)*y(k,41) + rxt(k,499)*y(k,43) + rxt(k,470)*y(k,47) & - + rxt(k,501)*y(k,51) + rxt(k,473)*y(k,52) + rxt(k,412)*y(k,98) - mat(k,1192) = mat(k,1192) + rxt(k,414)*y(k,38) + rxt(k,413)*y(k,98) & - + rxt(k,348)*y(k,132) - mat(k,1460) = rxt(k,455)*y(k,98) + rxt(k,341)*y(k,132) - mat(k,821) = rxt(k,124)*y(k,49) - mat(k,664) = rxt(k,129)*y(k,38) - mat(k,1545) = rxt(k,138)*y(k,96) - mat(k,85) = rxt(k,138)*y(k,95) + rxt(k,139)*y(k,137) - mat(k,336) = rxt(k,189)*y(k,100) + rxt(k,203)*y(k,102) + rxt(k,172)*y(k,104) & - + rxt(k,242)*y(k,115) + rxt(k,224)*y(k,116) + rxt(k,207) & - *y(k,119) + rxt(k,149)*y(k,126) - mat(k,748) = mat(k,748) + 2.000_r8*rxt(k,409)*y(k,38) + rxt(k,439)*y(k,60) & - + rxt(k,434)*y(k,62) + rxt(k,412)*y(k,67) + rxt(k,413)*y(k,69) & - + rxt(k,455)*y(k,86) - mat(k,1027) = rxt(k,189)*y(k,97) - mat(k,1694) = rxt(k,203)*y(k,97) - mat(k,1585) = rxt(k,172)*y(k,97) - mat(k,897) = rxt(k,242)*y(k,97) - mat(k,939) = rxt(k,224)*y(k,97) - mat(k,1068) = mat(k,1068) + rxt(k,207)*y(k,97) - mat(k,639) = rxt(k,389)*y(k,39) + rxt(k,505)*y(k,43) + rxt(k,482)*y(k,47) & - + 2.000_r8*rxt(k,390)*y(k,137) - mat(k,1359) = rxt(k,149)*y(k,97) - mat(k,190) = rxt(k,328)*y(k,137) - mat(k,794) = mat(k,794) + .300_r8*rxt(k,535)*y(k,21) - mat(k,1617) = rxt(k,342)*y(k,26) + rxt(k,346)*y(k,61) + rxt(k,348)*y(k,69) & - + rxt(k,341)*y(k,86) - mat(k,1652) = rxt(k,356)*y(k,47) + rxt(k,357)*y(k,49) + rxt(k,355)*y(k,137) - mat(k,1831) = rxt(k,509)*y(k,37) + rxt(k,139)*y(k,96) + 2.000_r8*rxt(k,390) & - *y(k,122) + rxt(k,328)*y(k,127) + rxt(k,355)*y(k,133) - mat(k,1637) = -(rxt(k,341)*y(k,86) + rxt(k,342)*y(k,26) + rxt(k,344)*y(k,38) & - + rxt(k,345)*y(k,47) + rxt(k,346)*y(k,61) + rxt(k,347)*y(k,67) & - + rxt(k,348)*y(k,69)) - mat(k,1480) = -rxt(k,341)*y(k,132) - mat(k,1758) = -rxt(k,342)*y(k,132) - mat(k,1793) = -rxt(k,344)*y(k,132) - mat(k,1171) = -rxt(k,345)*y(k,132) - mat(k,1005) = -rxt(k,346)*y(k,132) - mat(k,1438) = -rxt(k,347)*y(k,132) - mat(k,1212) = -rxt(k,348)*y(k,132) - mat(k,1793) = mat(k,1793) + rxt(k,117)*y(k,91) + rxt(k,287)*y(k,108) & + mat(k,1855) = -(rxt(k,341)*y(k,25) + rxt(k,342)*y(k,28) + rxt(k,343)*y(k,32) & + + rxt(k,344)*y(k,40) + rxt(k,345)*y(k,49) + rxt(k,346)*y(k,63) & + + rxt(k,347)*y(k,69) + rxt(k,348)*y(k,72)) + mat(k,2022) = -rxt(k,341)*y(k,132) + mat(k,1773) = -rxt(k,342)*y(k,132) + mat(k,1974) = -rxt(k,343)*y(k,132) + mat(k,1383) = -rxt(k,344)*y(k,132) + mat(k,1514) = -rxt(k,345)*y(k,132) + mat(k,1643) = -rxt(k,346)*y(k,132) + mat(k,1305) = -rxt(k,347)*y(k,132) + mat(k,1932) = -rxt(k,348)*y(k,132) + mat(k,1383) = mat(k,1383) + rxt(k,117)*y(k,92) + rxt(k,287)*y(k,109) & + rxt(k,331)*y(k,128) - mat(k,498) = rxt(k,354)*y(k,133) - mat(k,841) = rxt(k,117)*y(k,38) - mat(k,870) = rxt(k,287)*y(k,38) - mat(k,449) = rxt(k,331)*y(k,38) - mat(k,1672) = rxt(k,354)*y(k,39) + rxt(k,355)*y(k,137) - mat(k,1851) = rxt(k,355)*y(k,133) - mat(k,1673) = -(rxt(k,136)*y(k,60) + rxt(k,350)*y(k,86) + rxt(k,351)*y(k,26) & - + (rxt(k,353) + rxt(k,354)) * y(k,39) + rxt(k,355)*y(k,137) & - + rxt(k,356)*y(k,47) + rxt(k,357)*y(k,49) + rxt(k,359)*y(k,61) & - + rxt(k,360)*y(k,67) + rxt(k,361)*y(k,123) + rxt(k,362)*y(k,68) & - + rxt(k,363)*y(k,69)) - mat(k,1522) = -rxt(k,136)*y(k,133) - mat(k,1481) = -rxt(k,350)*y(k,133) - mat(k,1759) = -rxt(k,351)*y(k,133) - mat(k,499) = -(rxt(k,353) + rxt(k,354)) * y(k,133) - mat(k,1852) = -rxt(k,355)*y(k,133) - mat(k,1172) = -rxt(k,356)*y(k,133) - mat(k,1301) = -rxt(k,357)*y(k,133) - mat(k,1006) = -rxt(k,359)*y(k,133) - mat(k,1439) = -rxt(k,360)*y(k,133) - mat(k,253) = -rxt(k,361)*y(k,133) - mat(k,1262) = -rxt(k,362)*y(k,133) - mat(k,1213) = -rxt(k,363)*y(k,133) - mat(k,1439) = mat(k,1439) + rxt(k,325)*y(k,125) - mat(k,1213) = mat(k,1213) + rxt(k,134)*y(k,95) - mat(k,1564) = rxt(k,134)*y(k,69) - mat(k,1336) = rxt(k,325)*y(k,67) - mat(k,264) = -(rxt(k,597)*y(k,106) + rxt(k,598)*y(k,68)) - mat(k,217) = -rxt(k,597)*y(k,134) - mat(k,1228) = -rxt(k,598)*y(k,134) - mat(k,1402) = rxt(k,588)*y(k,107) + rxt(k,589)*y(k,121) + rxt(k,601)*y(k,135) & - + rxt(k,607)*y(k,136) - mat(k,1540) = rxt(k,599)*y(k,135) + rxt(k,604)*y(k,136) - mat(k,155) = rxt(k,588)*y(k,67) - mat(k,224) = rxt(k,589)*y(k,67) - mat(k,130) = rxt(k,601)*y(k,67) + rxt(k,599)*y(k,95) - mat(k,125) = rxt(k,607)*y(k,67) + rxt(k,604)*y(k,95) - mat(k,128) = -(rxt(k,599)*y(k,95) + rxt(k,601)*y(k,67) + rxt(k,602)*y(k,68)) - mat(k,1532) = -rxt(k,599)*y(k,135) - mat(k,1389) = -rxt(k,601)*y(k,135) - mat(k,1221) = -rxt(k,602)*y(k,135) - mat(k,1532) = mat(k,1532) + rxt(k,603)*y(k,136) - mat(k,122) = rxt(k,603)*y(k,95) - mat(k,121) = -((rxt(k,603) + rxt(k,604)) * y(k,95) + rxt(k,607)*y(k,67)) - mat(k,1531) = -(rxt(k,603) + rxt(k,604)) * y(k,136) - mat(k,1388) = -rxt(k,607)*y(k,136) - mat(k,1856) = -(rxt(k,107)*y(k,87) + rxt(k,118)*y(k,93) + rxt(k,119)*y(k,91) & - + rxt(k,139)*y(k,96) + rxt(k,140)*y(k,101) + rxt(k,143)*y(k,103) & - + rxt(k,288)*y(k,108) + rxt(k,294)*y(k,112) + rxt(k,296) & - *y(k,110) + rxt(k,305)*y(k,117) + rxt(k,307)*y(k,118) + rxt(k,313) & - *y(k,120) + (rxt(k,327) + rxt(k,328)) * y(k,127) + rxt(k,329) & + mat(k,659) = rxt(k,354)*y(k,133) + mat(k,1030) = rxt(k,117)*y(k,40) + mat(k,942) = rxt(k,287)*y(k,40) + mat(k,602) = rxt(k,331)*y(k,40) + mat(k,1891) = rxt(k,354)*y(k,41) + rxt(k,355)*y(k,137) + mat(k,2082) = rxt(k,355)*y(k,133) + mat(k,1892) = -(rxt(k,136)*y(k,62) + rxt(k,350)*y(k,25) + rxt(k,351)*y(k,28) & + + rxt(k,352)*y(k,32) + (rxt(k,353) + rxt(k,354)) * y(k,41) & + + rxt(k,355)*y(k,137) + rxt(k,356)*y(k,49) + rxt(k,357)*y(k,51) & + + rxt(k,359)*y(k,63) + rxt(k,360)*y(k,69) + rxt(k,361)*y(k,123) & + + rxt(k,362)*y(k,71) + rxt(k,363)*y(k,72)) + mat(k,1729) = -rxt(k,136)*y(k,133) + mat(k,2023) = -rxt(k,350)*y(k,133) + mat(k,1774) = -rxt(k,351)*y(k,133) + mat(k,1975) = -rxt(k,352)*y(k,133) + mat(k,660) = -(rxt(k,353) + rxt(k,354)) * y(k,133) + mat(k,2083) = -rxt(k,355)*y(k,133) + mat(k,1515) = -rxt(k,356)*y(k,133) + mat(k,1246) = -rxt(k,357)*y(k,133) + mat(k,1644) = -rxt(k,359)*y(k,133) + mat(k,1306) = -rxt(k,360)*y(k,133) + mat(k,380) = -rxt(k,361)*y(k,133) + mat(k,1823) = -rxt(k,362)*y(k,133) + mat(k,1933) = -rxt(k,363)*y(k,133) + mat(k,1306) = mat(k,1306) + rxt(k,325)*y(k,125) + mat(k,1933) = mat(k,1933) + rxt(k,134)*y(k,96) + mat(k,1074) = rxt(k,134)*y(k,72) + mat(k,1551) = rxt(k,325)*y(k,69) + mat(k,385) = -(rxt(k,594)*y(k,32) + rxt(k,596)*y(k,107) + rxt(k,597)*y(k,71)) + mat(k,1944) = -rxt(k,594)*y(k,134) + mat(k,299) = -rxt(k,596)*y(k,134) + mat(k,1789) = -rxt(k,597)*y(k,134) + mat(k,1270) = rxt(k,587)*y(k,108) + rxt(k,588)*y(k,122) + rxt(k,600)*y(k,135) & + + rxt(k,606)*y(k,136) + mat(k,1049) = rxt(k,598)*y(k,135) + rxt(k,603)*y(k,136) + mat(k,229) = rxt(k,587)*y(k,69) + mat(k,315) = rxt(k,588)*y(k,69) + mat(k,199) = rxt(k,600)*y(k,69) + rxt(k,598)*y(k,96) + mat(k,194) = rxt(k,606)*y(k,69) + rxt(k,603)*y(k,96) + mat(k,197) = -(rxt(k,598)*y(k,96) + rxt(k,600)*y(k,69) + rxt(k,601)*y(k,71)) + mat(k,1039) = -rxt(k,598)*y(k,135) + mat(k,1254) = -rxt(k,600)*y(k,135) + mat(k,1781) = -rxt(k,601)*y(k,135) + mat(k,1039) = mat(k,1039) + rxt(k,602)*y(k,136) + mat(k,191) = rxt(k,602)*y(k,96) + mat(k,190) = -((rxt(k,602) + rxt(k,603)) * y(k,96) + rxt(k,606)*y(k,69)) + mat(k,1038) = -(rxt(k,602) + rxt(k,603)) * y(k,136) + mat(k,1253) = -rxt(k,606)*y(k,136) + mat(k,2087) = -(rxt(k,107)*y(k,88) + rxt(k,118)*y(k,94) + rxt(k,119)*y(k,92) & + + rxt(k,139)*y(k,97) + rxt(k,140)*y(k,102) + rxt(k,143)*y(k,104) & + + rxt(k,288)*y(k,109) + rxt(k,294)*y(k,113) + rxt(k,296) & + *y(k,111) + rxt(k,305)*y(k,118) + rxt(k,307)*y(k,119) + rxt(k,313) & + *y(k,121) + (rxt(k,327) + rxt(k,328)) * y(k,127) + rxt(k,329) & *y(k,126) + rxt(k,337)*y(k,130) + rxt(k,355)*y(k,133) + rxt(k,365) & - *y(k,115) + rxt(k,366)*y(k,119) + rxt(k,367)*y(k,116) + rxt(k,372) & - *y(k,105) + rxt(k,374)*y(k,99) + rxt(k,376)*y(k,100) + rxt(k,378) & - *y(k,102) + rxt(k,390)*y(k,122) + rxt(k,509)*y(k,37) + rxt(k,555) & - *y(k,78)) - mat(k,708) = -rxt(k,107)*y(k,137) - mat(k,556) = -rxt(k,118)*y(k,137) - mat(k,846) = -rxt(k,119)*y(k,137) - mat(k,88) = -rxt(k,139)*y(k,137) - mat(k,53) = -rxt(k,140)*y(k,137) - mat(k,57) = -rxt(k,143)*y(k,137) - mat(k,875) = -rxt(k,288)*y(k,137) - mat(k,576) = -rxt(k,294)*y(k,137) - mat(k,733) = -rxt(k,296)*y(k,137) - mat(k,94) = -rxt(k,305)*y(k,137) - mat(k,120) = -rxt(k,307)*y(k,137) - mat(k,114) = -rxt(k,313)*y(k,137) - mat(k,196) = -(rxt(k,327) + rxt(k,328)) * y(k,137) - mat(k,1384) = -rxt(k,329)*y(k,137) - mat(k,361) = -rxt(k,337)*y(k,137) - mat(k,1677) = -rxt(k,355)*y(k,137) - mat(k,922) = -rxt(k,365)*y(k,137) - mat(k,1093) = -rxt(k,366)*y(k,137) - mat(k,964) = -rxt(k,367)*y(k,137) - mat(k,185) = -rxt(k,372)*y(k,137) - mat(k,167) = -rxt(k,374)*y(k,137) - mat(k,1052) = -rxt(k,376)*y(k,137) - mat(k,1719) = -rxt(k,378)*y(k,137) - mat(k,657) = -rxt(k,390)*y(k,137) - mat(k,205) = -rxt(k,509)*y(k,137) - mat(k,49) = -rxt(k,555)*y(k,137) - mat(k,624) = rxt(k,532)*y(k,131) - mat(k,82) = rxt(k,535)*y(k,131) - mat(k,1798) = rxt(k,410)*y(k,98) + rxt(k,344)*y(k,132) - mat(k,502) = rxt(k,415)*y(k,131) + rxt(k,353)*y(k,133) - mat(k,152) = rxt(k,416)*y(k,131) - mat(k,245) = rxt(k,500)*y(k,131) - mat(k,1176) = (rxt(k,571)+rxt(k,576))*y(k,51) + (rxt(k,564)+rxt(k,570) & - +rxt(k,575))*y(k,52) + rxt(k,106)*y(k,88) + rxt(k,471)*y(k,131) & + *y(k,116) + rxt(k,366)*y(k,120) + rxt(k,367)*y(k,117) + rxt(k,372) & + *y(k,106) + rxt(k,374)*y(k,100) + rxt(k,376)*y(k,101) + rxt(k,378) & + *y(k,103) + rxt(k,390)*y(k,70) + rxt(k,509)*y(k,39) + rxt(k,557) & + *y(k,81)) + mat(k,826) = -rxt(k,107)*y(k,137) + mat(k,684) = -rxt(k,118)*y(k,137) + mat(k,1035) = -rxt(k,119)*y(k,137) + mat(k,169) = -rxt(k,139)*y(k,137) + mat(k,107) = -rxt(k,140)*y(k,137) + mat(k,111) = -rxt(k,143)*y(k,137) + mat(k,945) = -rxt(k,288)*y(k,137) + mat(k,704) = -rxt(k,294)*y(k,137) + mat(k,883) = -rxt(k,296)*y(k,137) + mat(k,175) = -rxt(k,305)*y(k,137) + mat(k,267) = -rxt(k,307)*y(k,137) + mat(k,260) = -rxt(k,313)*y(k,137) + mat(k,296) = -(rxt(k,327) + rxt(k,328)) * y(k,137) + mat(k,1600) = -rxt(k,329)*y(k,137) + mat(k,469) = -rxt(k,337)*y(k,137) + mat(k,1896) = -rxt(k,355)*y(k,137) + mat(k,1166) = -rxt(k,365)*y(k,137) + mat(k,1352) = -rxt(k,366)*y(k,137) + mat(k,1209) = -rxt(k,367)*y(k,137) + mat(k,285) = -rxt(k,372)*y(k,137) + mat(k,248) = -rxt(k,374)*y(k,137) + mat(k,1474) = -rxt(k,376)*y(k,137) + mat(k,1691) = -rxt(k,378)*y(k,137) + mat(k,805) = -rxt(k,390)*y(k,137) + mat(k,346) = -rxt(k,509)*y(k,137) + mat(k,103) = -rxt(k,557)*y(k,137) + mat(k,182) = rxt(k,514)*y(k,131) + mat(k,754) = rxt(k,532)*y(k,131) + mat(k,226) = rxt(k,516)*y(k,131) + mat(k,49) = rxt(k,517)*y(k,131) + mat(k,151) = rxt(k,519)*y(k,131) + mat(k,163) = rxt(k,535)*y(k,131) + mat(k,427) = rxt(k,536)*y(k,131) + mat(k,1388) = rxt(k,410)*y(k,99) + rxt(k,344)*y(k,132) + mat(k,663) = rxt(k,415)*y(k,131) + rxt(k,353)*y(k,133) + mat(k,217) = rxt(k,416)*y(k,131) + mat(k,336) = rxt(k,500)*y(k,131) + mat(k,118) = rxt(k,524)*y(k,131) + mat(k,1519) = (rxt(k,570)+rxt(k,575))*y(k,53) + (rxt(k,563)+rxt(k,569) & + +rxt(k,574))*y(k,54) + rxt(k,106)*y(k,89) + rxt(k,471)*y(k,131) & + rxt(k,345)*y(k,132) - mat(k,1305) = rxt(k,295)*y(k,112) + rxt(k,447)*y(k,131) - mat(k,107) = rxt(k,423)*y(k,131) - mat(k,214) = (rxt(k,571)+rxt(k,576))*y(k,47) - mat(k,237) = (rxt(k,564)+rxt(k,570)+rxt(k,575))*y(k,47) + rxt(k,474)*y(k,131) - mat(k,179) = rxt(k,340)*y(k,131) - mat(k,308) = rxt(k,293)*y(k,111) - mat(k,1526) = rxt(k,123)*y(k,93) - mat(k,1010) = rxt(k,120)*y(k,93) - mat(k,708) = mat(k,708) + 3.000_r8*rxt(k,195)*y(k,100) + 4.000_r8*rxt(k,147) & - *y(k,102) + 5.000_r8*rxt(k,177)*y(k,104) + 2.000_r8*rxt(k,230) & - *y(k,116) + rxt(k,212)*y(k,119) - mat(k,423) = rxt(k,106)*y(k,47) + 4.000_r8*rxt(k,199)*y(k,100) & - + 5.000_r8*rxt(k,164)*y(k,102) + 6.000_r8*rxt(k,182)*y(k,104) & - + rxt(k,252)*y(k,115) + 3.000_r8*rxt(k,234)*y(k,116) & - + 2.000_r8*rxt(k,217)*y(k,119) + rxt(k,159)*y(k,126) - mat(k,407) = 3.000_r8*rxt(k,187)*y(k,100) + (4.000_r8*rxt(k,181) & - +4.000_r8*rxt(k,267))*y(k,102) + (5.000_r8*rxt(k,169) & - +5.000_r8*rxt(k,268))*y(k,104) + 2.000_r8*rxt(k,222)*y(k,116) & - + rxt(k,205)*y(k,119) - mat(k,846) = mat(k,846) + 3.000_r8*rxt(k,186)*y(k,100) + (4.000_r8*rxt(k,170) & - +4.000_r8*rxt(k,258))*y(k,102) + (5.000_r8*rxt(k,168) & - +5.000_r8*rxt(k,265))*y(k,104) + 2.000_r8*rxt(k,221)*y(k,116) & - + rxt(k,204)*y(k,119) - mat(k,375) = 5.000_r8*rxt(k,194)*y(k,100) + (6.000_r8*rxt(k,247) & - +6.000_r8*rxt(k,271))*y(k,102) + (7.000_r8*rxt(k,176) & - +7.000_r8*rxt(k,259))*y(k,104) + 2.000_r8*rxt(k,246)*y(k,115) & - + 4.000_r8*rxt(k,229)*y(k,116) + 3.000_r8*rxt(k,211)*y(k,119) & + mat(k,1250) = rxt(k,295)*y(k,113) + rxt(k,447)*y(k,131) + mat(k,189) = rxt(k,423)*y(k,131) + mat(k,313) = (rxt(k,570)+rxt(k,575))*y(k,49) + mat(k,328) = (rxt(k,563)+rxt(k,569)+rxt(k,574))*y(k,49) + rxt(k,474)*y(k,131) + mat(k,279) = rxt(k,340)*y(k,131) + mat(k,409) = rxt(k,293)*y(k,112) + mat(k,1733) = rxt(k,123)*y(k,94) + mat(k,1648) = rxt(k,120)*y(k,94) + mat(k,826) = mat(k,826) + 3.000_r8*rxt(k,195)*y(k,101) + 4.000_r8*rxt(k,147) & + *y(k,103) + 5.000_r8*rxt(k,177)*y(k,105) + 2.000_r8*rxt(k,230) & + *y(k,117) + rxt(k,212)*y(k,120) + mat(k,546) = rxt(k,106)*y(k,49) + 4.000_r8*rxt(k,199)*y(k,101) & + + 5.000_r8*rxt(k,164)*y(k,103) + 6.000_r8*rxt(k,182)*y(k,105) & + + rxt(k,252)*y(k,116) + 3.000_r8*rxt(k,234)*y(k,117) & + + 2.000_r8*rxt(k,217)*y(k,120) + rxt(k,159)*y(k,126) + mat(k,530) = 3.000_r8*rxt(k,187)*y(k,101) + (4.000_r8*rxt(k,181) & + +4.000_r8*rxt(k,267))*y(k,103) + (5.000_r8*rxt(k,169) & + +5.000_r8*rxt(k,268))*y(k,105) + 2.000_r8*rxt(k,222)*y(k,117) & + + rxt(k,205)*y(k,120) + mat(k,1035) = mat(k,1035) + 3.000_r8*rxt(k,186)*y(k,101) + ( & + + 4.000_r8*rxt(k,170)+4.000_r8*rxt(k,258))*y(k,103) + ( & + + 5.000_r8*rxt(k,168)+5.000_r8*rxt(k,265))*y(k,105) & + + 2.000_r8*rxt(k,221)*y(k,117) + rxt(k,204)*y(k,120) + mat(k,515) = 5.000_r8*rxt(k,194)*y(k,101) + (6.000_r8*rxt(k,247) & + +6.000_r8*rxt(k,271))*y(k,103) + (7.000_r8*rxt(k,176) & + +7.000_r8*rxt(k,259))*y(k,105) + 2.000_r8*rxt(k,246)*y(k,116) & + + 4.000_r8*rxt(k,229)*y(k,117) + 3.000_r8*rxt(k,211)*y(k,120) & + 2.000_r8*rxt(k,153)*y(k,126) - mat(k,556) = mat(k,556) + rxt(k,123)*y(k,60) + rxt(k,120)*y(k,61) & - + 4.000_r8*rxt(k,196)*y(k,100) + (5.000_r8*rxt(k,158) & - +5.000_r8*rxt(k,260))*y(k,102) + (6.000_r8*rxt(k,178) & - +6.000_r8*rxt(k,261))*y(k,104) + rxt(k,249)*y(k,115) & - + 3.000_r8*rxt(k,231)*y(k,116) + 2.000_r8*rxt(k,213)*y(k,119) & + mat(k,684) = mat(k,684) + rxt(k,123)*y(k,62) + rxt(k,120)*y(k,63) & + + 4.000_r8*rxt(k,196)*y(k,101) + (5.000_r8*rxt(k,158) & + +5.000_r8*rxt(k,260))*y(k,103) + (6.000_r8*rxt(k,178) & + +6.000_r8*rxt(k,261))*y(k,105) + rxt(k,249)*y(k,116) & + + 3.000_r8*rxt(k,231)*y(k,117) + 2.000_r8*rxt(k,213)*y(k,120) & + rxt(k,155)*y(k,126) - mat(k,687) = 3.000_r8*rxt(k,191)*y(k,100) + 4.000_r8*rxt(k,225)*y(k,102) & - + 5.000_r8*rxt(k,174)*y(k,104) + 2.000_r8*rxt(k,227)*y(k,116) & - + rxt(k,209)*y(k,119) - mat(k,1568) = rxt(k,138)*y(k,96) + 2.000_r8*rxt(k,382)*y(k,99) & - + 3.000_r8*rxt(k,383)*y(k,100) + 4.000_r8*rxt(k,141)*y(k,102) & - + 5.000_r8*rxt(k,144)*y(k,104) + rxt(k,381)*y(k,105) & - + 2.000_r8*rxt(k,303)*y(k,116) + 3.000_r8*rxt(k,304)*y(k,117) & - + rxt(k,308)*y(k,119) + rxt(k,326)*y(k,127) - mat(k,88) = mat(k,88) + rxt(k,138)*y(k,95) - mat(k,347) = 3.000_r8*rxt(k,189)*y(k,100) + 4.000_r8*rxt(k,203)*y(k,102) & - + 5.000_r8*rxt(k,172)*y(k,104) + 2.000_r8*rxt(k,224)*y(k,116) & - + rxt(k,207)*y(k,119) - mat(k,767) = rxt(k,410)*y(k,38) + rxt(k,417)*y(k,131) - mat(k,167) = mat(k,167) + 2.000_r8*rxt(k,382)*y(k,95) - mat(k,1052) = mat(k,1052) + 3.000_r8*rxt(k,195)*y(k,87) + 4.000_r8*rxt(k,199) & - *y(k,88) + 3.000_r8*rxt(k,187)*y(k,89) + 3.000_r8*rxt(k,186) & - *y(k,91) + 5.000_r8*rxt(k,194)*y(k,92) + 4.000_r8*rxt(k,196) & - *y(k,93) + 3.000_r8*rxt(k,191)*y(k,94) + 3.000_r8*rxt(k,383) & - *y(k,95) + 3.000_r8*rxt(k,189)*y(k,97) + 3.000_r8*rxt(k,201) & - *y(k,108) + 4.000_r8*rxt(k,197)*y(k,109) + 3.000_r8*rxt(k,188) & - *y(k,110) + 5.000_r8*rxt(k,200)*y(k,111) + 4.000_r8*rxt(k,193) & - *y(k,112) + 3.000_r8*rxt(k,198)*y(k,113) + 3.000_r8*rxt(k,185) & - *y(k,114) + 3.000_r8*rxt(k,190)*y(k,125) - mat(k,1719) = mat(k,1719) + 4.000_r8*rxt(k,147)*y(k,87) + 5.000_r8*rxt(k,164) & - *y(k,88) + (4.000_r8*rxt(k,181)+4.000_r8*rxt(k,267))*y(k,89) + ( & - + 4.000_r8*rxt(k,170)+4.000_r8*rxt(k,258))*y(k,91) + ( & - + 6.000_r8*rxt(k,247)+6.000_r8*rxt(k,271))*y(k,92) + ( & - + 5.000_r8*rxt(k,158)+5.000_r8*rxt(k,260))*y(k,93) & - + 4.000_r8*rxt(k,225)*y(k,94) + 4.000_r8*rxt(k,141)*y(k,95) & - + 4.000_r8*rxt(k,203)*y(k,97) + 4.000_r8*rxt(k,166)*y(k,108) & - + 5.000_r8*rxt(k,162)*y(k,109) + (4.000_r8*rxt(k,192) & - +4.000_r8*rxt(k,264))*y(k,110) + 6.000_r8*rxt(k,165)*y(k,111) + ( & - + 5.000_r8*rxt(k,236)+5.000_r8*rxt(k,262))*y(k,112) & - + 4.000_r8*rxt(k,163)*y(k,113) + (4.000_r8*rxt(k,146) & - +4.000_r8*rxt(k,269))*y(k,114) + 4.000_r8*rxt(k,214)*y(k,125) - mat(k,1610) = 5.000_r8*rxt(k,177)*y(k,87) + 6.000_r8*rxt(k,182)*y(k,88) + ( & - + 5.000_r8*rxt(k,169)+5.000_r8*rxt(k,268))*y(k,89) + ( & - + 5.000_r8*rxt(k,168)+5.000_r8*rxt(k,265))*y(k,91) + ( & - + 7.000_r8*rxt(k,176)+7.000_r8*rxt(k,259))*y(k,92) + ( & - + 6.000_r8*rxt(k,178)+6.000_r8*rxt(k,261))*y(k,93) & - + 5.000_r8*rxt(k,174)*y(k,94) + 5.000_r8*rxt(k,144)*y(k,95) & - + 5.000_r8*rxt(k,172)*y(k,97) + 5.000_r8*rxt(k,184)*y(k,108) & - + 6.000_r8*rxt(k,179)*y(k,109) + (5.000_r8*rxt(k,171) & - +5.000_r8*rxt(k,266))*y(k,110) + 7.000_r8*rxt(k,183)*y(k,111) + ( & - + 6.000_r8*rxt(k,175)+6.000_r8*rxt(k,263))*y(k,112) & - + 5.000_r8*rxt(k,180)*y(k,113) + (5.000_r8*rxt(k,167) & - +5.000_r8*rxt(k,270))*y(k,114) + 5.000_r8*rxt(k,173)*y(k,125) - mat(k,185) = mat(k,185) + rxt(k,381)*y(k,95) - mat(k,875) = mat(k,875) + 3.000_r8*rxt(k,201)*y(k,100) + 4.000_r8*rxt(k,166) & - *y(k,102) + 5.000_r8*rxt(k,184)*y(k,104) + 2.000_r8*rxt(k,237) & - *y(k,116) + rxt(k,219)*y(k,119) - mat(k,437) = 4.000_r8*rxt(k,197)*y(k,100) + 5.000_r8*rxt(k,162)*y(k,102) & - + 6.000_r8*rxt(k,179)*y(k,104) + rxt(k,250)*y(k,115) & - + 3.000_r8*rxt(k,232)*y(k,116) + 2.000_r8*rxt(k,215)*y(k,119) & + mat(k,858) = 3.000_r8*rxt(k,191)*y(k,101) + 4.000_r8*rxt(k,225)*y(k,103) & + + 5.000_r8*rxt(k,174)*y(k,105) + 2.000_r8*rxt(k,227)*y(k,117) & + + rxt(k,209)*y(k,120) + mat(k,1078) = rxt(k,138)*y(k,97) + 2.000_r8*rxt(k,382)*y(k,100) & + + 3.000_r8*rxt(k,383)*y(k,101) + 4.000_r8*rxt(k,141)*y(k,103) & + + 5.000_r8*rxt(k,144)*y(k,105) + rxt(k,381)*y(k,106) & + + 2.000_r8*rxt(k,303)*y(k,117) + 3.000_r8*rxt(k,304)*y(k,118) & + + rxt(k,308)*y(k,120) + rxt(k,326)*y(k,127) + mat(k,169) = mat(k,169) + rxt(k,138)*y(k,96) + mat(k,483) = 3.000_r8*rxt(k,189)*y(k,101) + 4.000_r8*rxt(k,203)*y(k,103) & + + 5.000_r8*rxt(k,172)*y(k,105) + 2.000_r8*rxt(k,224)*y(k,117) & + + rxt(k,207)*y(k,120) + mat(k,918) = rxt(k,410)*y(k,40) + rxt(k,417)*y(k,131) + mat(k,248) = mat(k,248) + 2.000_r8*rxt(k,382)*y(k,96) + mat(k,1474) = mat(k,1474) + 3.000_r8*rxt(k,195)*y(k,88) + 4.000_r8*rxt(k,199) & + *y(k,89) + 3.000_r8*rxt(k,187)*y(k,90) + 3.000_r8*rxt(k,186) & + *y(k,92) + 5.000_r8*rxt(k,194)*y(k,93) + 4.000_r8*rxt(k,196) & + *y(k,94) + 3.000_r8*rxt(k,191)*y(k,95) + 3.000_r8*rxt(k,383) & + *y(k,96) + 3.000_r8*rxt(k,189)*y(k,98) + 3.000_r8*rxt(k,201) & + *y(k,109) + 4.000_r8*rxt(k,197)*y(k,110) + 3.000_r8*rxt(k,188) & + *y(k,111) + 5.000_r8*rxt(k,200)*y(k,112) + 4.000_r8*rxt(k,193) & + *y(k,113) + 3.000_r8*rxt(k,198)*y(k,114) + 3.000_r8*rxt(k,185) & + *y(k,115) + 3.000_r8*rxt(k,190)*y(k,125) + mat(k,1691) = mat(k,1691) + 4.000_r8*rxt(k,147)*y(k,88) + 5.000_r8*rxt(k,164) & + *y(k,89) + (4.000_r8*rxt(k,181)+4.000_r8*rxt(k,267))*y(k,90) + ( & + + 4.000_r8*rxt(k,170)+4.000_r8*rxt(k,258))*y(k,92) + ( & + + 6.000_r8*rxt(k,247)+6.000_r8*rxt(k,271))*y(k,93) + ( & + + 5.000_r8*rxt(k,158)+5.000_r8*rxt(k,260))*y(k,94) & + + 4.000_r8*rxt(k,225)*y(k,95) + 4.000_r8*rxt(k,141)*y(k,96) & + + 4.000_r8*rxt(k,203)*y(k,98) + 4.000_r8*rxt(k,166)*y(k,109) & + + 5.000_r8*rxt(k,162)*y(k,110) + (4.000_r8*rxt(k,192) & + +4.000_r8*rxt(k,264))*y(k,111) + 6.000_r8*rxt(k,165)*y(k,112) + ( & + + 5.000_r8*rxt(k,236)+5.000_r8*rxt(k,262))*y(k,113) & + + 4.000_r8*rxt(k,163)*y(k,114) + (4.000_r8*rxt(k,146) & + +4.000_r8*rxt(k,269))*y(k,115) + 4.000_r8*rxt(k,214)*y(k,125) + mat(k,1431) = 5.000_r8*rxt(k,177)*y(k,88) + 6.000_r8*rxt(k,182)*y(k,89) + ( & + + 5.000_r8*rxt(k,169)+5.000_r8*rxt(k,268))*y(k,90) + ( & + + 5.000_r8*rxt(k,168)+5.000_r8*rxt(k,265))*y(k,92) + ( & + + 7.000_r8*rxt(k,176)+7.000_r8*rxt(k,259))*y(k,93) + ( & + + 6.000_r8*rxt(k,178)+6.000_r8*rxt(k,261))*y(k,94) & + + 5.000_r8*rxt(k,174)*y(k,95) + 5.000_r8*rxt(k,144)*y(k,96) & + + 5.000_r8*rxt(k,172)*y(k,98) + 5.000_r8*rxt(k,184)*y(k,109) & + + 6.000_r8*rxt(k,179)*y(k,110) + (5.000_r8*rxt(k,171) & + +5.000_r8*rxt(k,266))*y(k,111) + 7.000_r8*rxt(k,183)*y(k,112) + ( & + + 6.000_r8*rxt(k,175)+6.000_r8*rxt(k,263))*y(k,113) & + + 5.000_r8*rxt(k,180)*y(k,114) + (5.000_r8*rxt(k,167) & + +5.000_r8*rxt(k,270))*y(k,115) + 5.000_r8*rxt(k,173)*y(k,125) + mat(k,285) = mat(k,285) + rxt(k,381)*y(k,96) + mat(k,945) = mat(k,945) + 3.000_r8*rxt(k,201)*y(k,101) + 4.000_r8*rxt(k,166) & + *y(k,103) + 5.000_r8*rxt(k,184)*y(k,105) + 2.000_r8*rxt(k,237) & + *y(k,117) + rxt(k,219)*y(k,120) + mat(k,560) = 4.000_r8*rxt(k,197)*y(k,101) + 5.000_r8*rxt(k,162)*y(k,103) & + + 6.000_r8*rxt(k,179)*y(k,105) + rxt(k,250)*y(k,116) & + + 3.000_r8*rxt(k,232)*y(k,117) + 2.000_r8*rxt(k,215)*y(k,120) & + rxt(k,156)*y(k,126) - mat(k,733) = mat(k,733) + 3.000_r8*rxt(k,188)*y(k,100) + (4.000_r8*rxt(k,192) & - +4.000_r8*rxt(k,264))*y(k,102) + (5.000_r8*rxt(k,171) & - +5.000_r8*rxt(k,266))*y(k,104) + 2.000_r8*rxt(k,223)*y(k,116) & - + rxt(k,206)*y(k,119) - mat(k,536) = rxt(k,293)*y(k,56) + 5.000_r8*rxt(k,200)*y(k,100) & - + 6.000_r8*rxt(k,165)*y(k,102) + 7.000_r8*rxt(k,183)*y(k,104) & - + 2.000_r8*rxt(k,253)*y(k,115) + 4.000_r8*rxt(k,235)*y(k,116) & - + 3.000_r8*rxt(k,218)*y(k,119) + 2.000_r8*rxt(k,160)*y(k,126) - mat(k,576) = mat(k,576) + rxt(k,295)*y(k,49) + 4.000_r8*rxt(k,193)*y(k,100) + ( & - + 5.000_r8*rxt(k,236)+5.000_r8*rxt(k,262))*y(k,102) + ( & - + 6.000_r8*rxt(k,175)+6.000_r8*rxt(k,263))*y(k,104) + rxt(k,245) & - *y(k,115) + 3.000_r8*rxt(k,228)*y(k,116) + 2.000_r8*rxt(k,210) & - *y(k,119) + rxt(k,152)*y(k,126) - mat(k,480) = 3.000_r8*rxt(k,198)*y(k,100) + 4.000_r8*rxt(k,163)*y(k,102) & - + 5.000_r8*rxt(k,180)*y(k,104) + 2.000_r8*rxt(k,233)*y(k,116) & - + rxt(k,216)*y(k,119) - mat(k,516) = 3.000_r8*rxt(k,185)*y(k,100) + (4.000_r8*rxt(k,146) & - +4.000_r8*rxt(k,269))*y(k,102) + (5.000_r8*rxt(k,167) & - +5.000_r8*rxt(k,270))*y(k,104) + 2.000_r8*rxt(k,220)*y(k,116) & - + rxt(k,202)*y(k,119) - mat(k,922) = mat(k,922) + rxt(k,252)*y(k,88) + 2.000_r8*rxt(k,246)*y(k,92) & - + rxt(k,249)*y(k,93) + rxt(k,250)*y(k,109) + 2.000_r8*rxt(k,253) & - *y(k,111) + rxt(k,245)*y(k,112) - mat(k,964) = mat(k,964) + 2.000_r8*rxt(k,230)*y(k,87) + 3.000_r8*rxt(k,234) & - *y(k,88) + 2.000_r8*rxt(k,222)*y(k,89) + 2.000_r8*rxt(k,221) & - *y(k,91) + 4.000_r8*rxt(k,229)*y(k,92) + 3.000_r8*rxt(k,231) & - *y(k,93) + 2.000_r8*rxt(k,227)*y(k,94) + 2.000_r8*rxt(k,303) & - *y(k,95) + 2.000_r8*rxt(k,224)*y(k,97) + 2.000_r8*rxt(k,237) & - *y(k,108) + 3.000_r8*rxt(k,232)*y(k,109) + 2.000_r8*rxt(k,223) & - *y(k,110) + 4.000_r8*rxt(k,235)*y(k,111) + 3.000_r8*rxt(k,228) & - *y(k,112) + 2.000_r8*rxt(k,233)*y(k,113) + 2.000_r8*rxt(k,220) & - *y(k,114) + 2.000_r8*rxt(k,226)*y(k,125) - mat(k,94) = mat(k,94) + 3.000_r8*rxt(k,304)*y(k,95) - mat(k,1093) = mat(k,1093) + rxt(k,212)*y(k,87) + 2.000_r8*rxt(k,217)*y(k,88) & - + rxt(k,205)*y(k,89) + rxt(k,204)*y(k,91) + 3.000_r8*rxt(k,211) & - *y(k,92) + 2.000_r8*rxt(k,213)*y(k,93) + rxt(k,209)*y(k,94) & - + rxt(k,308)*y(k,95) + rxt(k,207)*y(k,97) + rxt(k,219)*y(k,108) & - + 2.000_r8*rxt(k,215)*y(k,109) + rxt(k,206)*y(k,110) & - + 3.000_r8*rxt(k,218)*y(k,111) + 2.000_r8*rxt(k,210)*y(k,112) & - + rxt(k,216)*y(k,113) + rxt(k,202)*y(k,114) + rxt(k,208) & + mat(k,883) = mat(k,883) + 3.000_r8*rxt(k,188)*y(k,101) + (4.000_r8*rxt(k,192) & + +4.000_r8*rxt(k,264))*y(k,103) + (5.000_r8*rxt(k,171) & + +5.000_r8*rxt(k,266))*y(k,105) + 2.000_r8*rxt(k,223)*y(k,117) & + + rxt(k,206)*y(k,120) + mat(k,639) = rxt(k,293)*y(k,58) + 5.000_r8*rxt(k,200)*y(k,101) & + + 6.000_r8*rxt(k,165)*y(k,103) + 7.000_r8*rxt(k,183)*y(k,105) & + + 2.000_r8*rxt(k,253)*y(k,116) + 4.000_r8*rxt(k,235)*y(k,117) & + + 3.000_r8*rxt(k,218)*y(k,120) + 2.000_r8*rxt(k,160)*y(k,126) + mat(k,704) = mat(k,704) + rxt(k,295)*y(k,51) + 4.000_r8*rxt(k,193)*y(k,101) + ( & + + 5.000_r8*rxt(k,236)+5.000_r8*rxt(k,262))*y(k,103) + ( & + + 6.000_r8*rxt(k,175)+6.000_r8*rxt(k,263))*y(k,105) + rxt(k,245) & + *y(k,116) + 3.000_r8*rxt(k,228)*y(k,117) + 2.000_r8*rxt(k,210) & + *y(k,120) + rxt(k,152)*y(k,126) + mat(k,576) = 3.000_r8*rxt(k,198)*y(k,101) + 4.000_r8*rxt(k,163)*y(k,103) & + + 5.000_r8*rxt(k,180)*y(k,105) + 2.000_r8*rxt(k,233)*y(k,117) & + + rxt(k,216)*y(k,120) + mat(k,619) = 3.000_r8*rxt(k,185)*y(k,101) + (4.000_r8*rxt(k,146) & + +4.000_r8*rxt(k,269))*y(k,103) + (5.000_r8*rxt(k,167) & + +5.000_r8*rxt(k,270))*y(k,105) + 2.000_r8*rxt(k,220)*y(k,117) & + + rxt(k,202)*y(k,120) + mat(k,1166) = mat(k,1166) + rxt(k,252)*y(k,89) + 2.000_r8*rxt(k,246)*y(k,93) & + + rxt(k,249)*y(k,94) + rxt(k,250)*y(k,110) + 2.000_r8*rxt(k,253) & + *y(k,112) + rxt(k,245)*y(k,113) + mat(k,1209) = mat(k,1209) + 2.000_r8*rxt(k,230)*y(k,88) + 3.000_r8*rxt(k,234) & + *y(k,89) + 2.000_r8*rxt(k,222)*y(k,90) + 2.000_r8*rxt(k,221) & + *y(k,92) + 4.000_r8*rxt(k,229)*y(k,93) + 3.000_r8*rxt(k,231) & + *y(k,94) + 2.000_r8*rxt(k,227)*y(k,95) + 2.000_r8*rxt(k,303) & + *y(k,96) + 2.000_r8*rxt(k,224)*y(k,98) + 2.000_r8*rxt(k,237) & + *y(k,109) + 3.000_r8*rxt(k,232)*y(k,110) + 2.000_r8*rxt(k,223) & + *y(k,111) + 4.000_r8*rxt(k,235)*y(k,112) + 3.000_r8*rxt(k,228) & + *y(k,113) + 2.000_r8*rxt(k,233)*y(k,114) + 2.000_r8*rxt(k,220) & + *y(k,115) + 2.000_r8*rxt(k,226)*y(k,125) + mat(k,175) = mat(k,175) + 3.000_r8*rxt(k,304)*y(k,96) + mat(k,1352) = mat(k,1352) + rxt(k,212)*y(k,88) + 2.000_r8*rxt(k,217)*y(k,89) & + + rxt(k,205)*y(k,90) + rxt(k,204)*y(k,92) + 3.000_r8*rxt(k,211) & + *y(k,93) + 2.000_r8*rxt(k,213)*y(k,94) + rxt(k,209)*y(k,95) & + + rxt(k,308)*y(k,96) + rxt(k,207)*y(k,98) + rxt(k,219)*y(k,109) & + + 2.000_r8*rxt(k,215)*y(k,110) + rxt(k,206)*y(k,111) & + + 3.000_r8*rxt(k,218)*y(k,112) + 2.000_r8*rxt(k,210)*y(k,113) & + + rxt(k,216)*y(k,114) + rxt(k,202)*y(k,115) + rxt(k,208) & *y(k,125) - mat(k,1340) = 3.000_r8*rxt(k,190)*y(k,100) + 4.000_r8*rxt(k,214)*y(k,102) & - + 5.000_r8*rxt(k,173)*y(k,104) + 2.000_r8*rxt(k,226)*y(k,116) & - + rxt(k,208)*y(k,119) - mat(k,1384) = mat(k,1384) + rxt(k,159)*y(k,88) + 2.000_r8*rxt(k,153)*y(k,92) & - + rxt(k,155)*y(k,93) + rxt(k,156)*y(k,109) + 2.000_r8*rxt(k,160) & - *y(k,111) + rxt(k,152)*y(k,112) - mat(k,196) = mat(k,196) + rxt(k,326)*y(k,95) - mat(k,814) = rxt(k,532)*y(k,16) + rxt(k,535)*y(k,21) + rxt(k,415)*y(k,39) & - + rxt(k,416)*y(k,41) + rxt(k,500)*y(k,43) + rxt(k,471)*y(k,47) & - + rxt(k,447)*y(k,49) + rxt(k,423)*y(k,50) + rxt(k,474)*y(k,52) & - + rxt(k,340)*y(k,53) + rxt(k,417)*y(k,98) + 2.000_r8*rxt(k,420) & + mat(k,1555) = 3.000_r8*rxt(k,190)*y(k,101) + 4.000_r8*rxt(k,214)*y(k,103) & + + 5.000_r8*rxt(k,173)*y(k,105) + 2.000_r8*rxt(k,226)*y(k,117) & + + rxt(k,208)*y(k,120) + mat(k,1600) = mat(k,1600) + rxt(k,159)*y(k,89) + 2.000_r8*rxt(k,153)*y(k,93) & + + rxt(k,155)*y(k,94) + rxt(k,156)*y(k,110) + 2.000_r8*rxt(k,160) & + *y(k,112) + rxt(k,152)*y(k,113) + mat(k,296) = mat(k,296) + rxt(k,326)*y(k,96) + mat(k,1002) = rxt(k,514)*y(k,16) + rxt(k,532)*y(k,17) + rxt(k,516)*y(k,18) & + + rxt(k,517)*y(k,19) + rxt(k,519)*y(k,20) + rxt(k,535)*y(k,22) & + + rxt(k,536)*y(k,23) + rxt(k,415)*y(k,41) + rxt(k,416)*y(k,43) & + + rxt(k,500)*y(k,45) + rxt(k,524)*y(k,48) + rxt(k,471)*y(k,49) & + + rxt(k,447)*y(k,51) + rxt(k,423)*y(k,52) + rxt(k,474)*y(k,54) & + + rxt(k,340)*y(k,55) + rxt(k,417)*y(k,99) + 2.000_r8*rxt(k,420) & *y(k,131) - mat(k,1642) = rxt(k,344)*y(k,38) + rxt(k,345)*y(k,47) - mat(k,1677) = mat(k,1677) + rxt(k,353)*y(k,39) + mat(k,1860) = rxt(k,344)*y(k,40) + rxt(k,345)*y(k,49) + mat(k,1896) = mat(k,1896) + rxt(k,353)*y(k,41) end do - end subroutine nlnmat08 + end subroutine nlnmat10 subroutine nlnmat_finit( avec_len, mat, lmat, dti ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none @@ -2213,723 +2535,792 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 25) = lmat(k, 25) mat(k, 26) = lmat(k, 26) mat(k, 27) = mat(k, 27) + lmat(k, 27) - mat(k, 28) = mat(k, 28) + lmat(k, 28) - mat(k, 30) = lmat(k, 30) - mat(k, 31) = lmat(k, 31) + mat(k, 29) = mat(k, 29) + lmat(k, 29) + mat(k, 30) = mat(k, 30) + lmat(k, 30) + mat(k, 31) = mat(k, 31) + lmat(k, 31) mat(k, 32) = mat(k, 32) + lmat(k, 32) - mat(k, 33) = mat(k, 33) + lmat(k, 33) + mat(k, 34) = mat(k, 34) + lmat(k, 34) mat(k, 35) = 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) = lmat(k, 39) - mat(k, 40) = lmat(k, 40) - mat(k, 41) = lmat(k, 41) + mat(k, 37) = mat(k, 37) + lmat(k, 37) + mat(k, 38) = mat(k, 38) + lmat(k, 38) + mat(k, 39) = mat(k, 39) + lmat(k, 39) + mat(k, 41) = mat(k, 41) + lmat(k, 41) mat(k, 42) = mat(k, 42) + lmat(k, 42) mat(k, 43) = mat(k, 43) + lmat(k, 43) - mat(k, 44) = lmat(k, 44) + mat(k, 45) = mat(k, 45) + lmat(k, 45) mat(k, 46) = mat(k, 46) + lmat(k, 46) - mat(k, 47) = lmat(k, 47) - mat(k, 48) = lmat(k, 48) - mat(k, 50) = mat(k, 50) + lmat(k, 50) + mat(k, 48) = mat(k, 48) + lmat(k, 48) + mat(k, 50) = lmat(k, 50) + mat(k, 51) = lmat(k, 51) + mat(k, 52) = lmat(k, 52) + mat(k, 53) = mat(k, 53) + lmat(k, 53) 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, 59) = mat(k, 59) + lmat(k, 59) + 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, 67) = lmat(k, 67) + mat(k, 65) = mat(k, 65) + lmat(k, 65) + mat(k, 67) = mat(k, 67) + lmat(k, 67) mat(k, 68) = mat(k, 68) + lmat(k, 68) mat(k, 69) = mat(k, 69) + lmat(k, 69) mat(k, 70) = mat(k, 70) + lmat(k, 70) - mat(k, 71) = lmat(k, 71) - mat(k, 77) = mat(k, 77) + lmat(k, 77) + mat(k, 72) = mat(k, 72) + lmat(k, 72) + mat(k, 73) = lmat(k, 73) + mat(k, 74) = lmat(k, 74) + mat(k, 75) = mat(k, 75) + lmat(k, 75) + mat(k, 76) = mat(k, 76) + lmat(k, 76) mat(k, 79) = mat(k, 79) + lmat(k, 79) mat(k, 80) = mat(k, 80) + lmat(k, 80) - mat(k, 81) = lmat(k, 81) + mat(k, 81) = mat(k, 81) + lmat(k, 81) mat(k, 83) = mat(k, 83) + lmat(k, 83) + mat(k, 84) = mat(k, 84) + lmat(k, 84) + mat(k, 85) = mat(k, 85) + lmat(k, 85) + mat(k, 88) = 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, 92) = lmat(k, 92) + mat(k, 93) = lmat(k, 93) + mat(k, 94) = lmat(k, 94) mat(k, 95) = mat(k, 95) + lmat(k, 95) - mat(k, 97) = lmat(k, 97) - mat(k, 98) = mat(k, 98) + lmat(k, 98) - mat(k, 99) = lmat(k, 99) - mat(k, 101) = mat(k, 101) + lmat(k, 101) + mat(k, 96) = mat(k, 96) + lmat(k, 96) + mat(k, 100) = mat(k, 100) + lmat(k, 100) + mat(k, 101) = lmat(k, 101) 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, 105) = lmat(k, 105) mat(k, 108) = mat(k, 108) + lmat(k, 108) - mat(k, 109) = lmat(k, 109) - mat(k, 110) = lmat(k, 110) - mat(k, 115) = mat(k, 115) + lmat(k, 115) - mat(k, 116) = lmat(k, 116) - mat(k, 121) = mat(k, 121) + lmat(k, 121) + mat(k, 112) = mat(k, 112) + lmat(k, 112) + mat(k, 113) = mat(k, 113) + lmat(k, 113) + mat(k, 117) = mat(k, 117) + lmat(k, 117) + mat(k, 119) = lmat(k, 119) + mat(k, 120) = lmat(k, 120) + mat(k, 121) = lmat(k, 121) mat(k, 122) = mat(k, 122) + lmat(k, 122) - mat(k, 123) = lmat(k, 123) - mat(k, 124) = lmat(k, 124) - mat(k, 125) = mat(k, 125) + lmat(k, 125) - mat(k, 126) = lmat(k, 126) - mat(k, 127) = lmat(k, 127) mat(k, 128) = mat(k, 128) + lmat(k, 128) - mat(k, 129) = lmat(k, 129) - mat(k, 130) = mat(k, 130) + lmat(k, 130) - mat(k, 133) = mat(k, 133) + lmat(k, 133) - mat(k, 134) = mat(k, 134) + lmat(k, 134) - mat(k, 138) = mat(k, 138) + lmat(k, 138) - mat(k, 139) = lmat(k, 139) - mat(k, 140) = lmat(k, 140) - mat(k, 141) = mat(k, 141) + lmat(k, 141) - mat(k, 142) = lmat(k, 142) - mat(k, 143) = mat(k, 143) + lmat(k, 143) - mat(k, 144) = lmat(k, 144) - mat(k, 146) = mat(k, 146) + lmat(k, 146) - mat(k, 148) = mat(k, 148) + lmat(k, 148) + mat(k, 129) = mat(k, 129) + lmat(k, 129) + mat(k, 130) = lmat(k, 130) + mat(k, 131) = mat(k, 131) + lmat(k, 131) + mat(k, 134) = lmat(k, 134) + mat(k, 135) = mat(k, 135) + lmat(k, 135) + mat(k, 136) = mat(k, 136) + lmat(k, 136) + mat(k, 137) = mat(k, 137) + lmat(k, 137) + mat(k, 138) = lmat(k, 138) + mat(k, 144) = mat(k, 144) + lmat(k, 144) + mat(k, 146) = lmat(k, 146) + mat(k, 150) = mat(k, 150) + lmat(k, 150) + mat(k, 152) = mat(k, 152) + lmat(k, 152) mat(k, 153) = mat(k, 153) + lmat(k, 153) - mat(k, 162) = mat(k, 162) + lmat(k, 162) - mat(k, 163) = lmat(k, 163) - mat(k, 167) = mat(k, 167) + lmat(k, 167) - mat(k, 168) = mat(k, 168) + lmat(k, 168) - mat(k, 175) = mat(k, 175) + lmat(k, 175) + mat(k, 158) = mat(k, 158) + lmat(k, 158) + mat(k, 160) = mat(k, 160) + lmat(k, 160) + mat(k, 161) = mat(k, 161) + lmat(k, 161) + mat(k, 162) = lmat(k, 162) + mat(k, 164) = mat(k, 164) + lmat(k, 164) + mat(k, 170) = mat(k, 170) + lmat(k, 170) mat(k, 176) = mat(k, 176) + lmat(k, 176) - mat(k, 178) = lmat(k, 178) - mat(k, 181) = mat(k, 181) + lmat(k, 181) - mat(k, 189) = mat(k, 189) + lmat(k, 189) + mat(k, 177) = mat(k, 177) + lmat(k, 177) + mat(k, 183) = mat(k, 183) + lmat(k, 183) + mat(k, 184) = lmat(k, 184) + mat(k, 185) = mat(k, 185) + lmat(k, 185) + mat(k, 186) = lmat(k, 186) + mat(k, 187) = mat(k, 187) + lmat(k, 187) + mat(k, 190) = mat(k, 190) + lmat(k, 190) + mat(k, 191) = mat(k, 191) + lmat(k, 191) + mat(k, 192) = lmat(k, 192) mat(k, 193) = lmat(k, 193) - mat(k, 196) = mat(k, 196) + lmat(k, 196) + mat(k, 194) = mat(k, 194) + lmat(k, 194) + mat(k, 195) = lmat(k, 195) + mat(k, 196) = lmat(k, 196) mat(k, 197) = mat(k, 197) + lmat(k, 197) - mat(k, 198) = mat(k, 198) + lmat(k, 198) - mat(k, 199) = lmat(k, 199) + mat(k, 198) = lmat(k, 198) + mat(k, 199) = mat(k, 199) + lmat(k, 199) + mat(k, 200) = mat(k, 200) + lmat(k, 200) + mat(k, 203) = mat(k, 203) + lmat(k, 203) + mat(k, 204) = lmat(k, 204) + mat(k, 205) = lmat(k, 205) + mat(k, 206) = mat(k, 206) + lmat(k, 206) mat(k, 207) = mat(k, 207) + lmat(k, 207) mat(k, 208) = lmat(k, 208) - mat(k, 210) = mat(k, 210) + lmat(k, 210) - mat(k, 215) = mat(k, 215) + lmat(k, 215) - mat(k, 223) = mat(k, 223) + lmat(k, 223) - mat(k, 231) = mat(k, 231) + lmat(k, 231) - mat(k, 232) = mat(k, 232) + lmat(k, 232) - mat(k, 235) = mat(k, 235) + lmat(k, 235) - mat(k, 238) = mat(k, 238) + lmat(k, 238) - mat(k, 239) = mat(k, 239) + lmat(k, 239) - mat(k, 244) = mat(k, 244) + lmat(k, 244) - mat(k, 246) = mat(k, 246) + lmat(k, 246) + mat(k, 210) = lmat(k, 210) + mat(k, 211) = mat(k, 211) + lmat(k, 211) + mat(k, 213) = mat(k, 213) + lmat(k, 213) + mat(k, 218) = mat(k, 218) + lmat(k, 218) + 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, 236) = mat(k, 236) + lmat(k, 236) + mat(k, 240) = lmat(k, 240) + mat(k, 241) = mat(k, 241) + lmat(k, 241) + mat(k, 243) = mat(k, 243) + lmat(k, 243) + mat(k, 244) = lmat(k, 244) + mat(k, 248) = mat(k, 248) + lmat(k, 248) mat(k, 249) = mat(k, 249) + lmat(k, 249) - mat(k, 255) = mat(k, 255) + lmat(k, 255) + mat(k, 253) = mat(k, 253) + lmat(k, 253) mat(k, 256) = lmat(k, 256) - mat(k, 259) = lmat(k, 259) - mat(k, 261) = lmat(k, 261) - mat(k, 264) = mat(k, 264) + lmat(k, 264) - mat(k, 265) = lmat(k, 265) - mat(k, 269) = lmat(k, 269) - mat(k, 271) = mat(k, 271) + lmat(k, 271) + mat(k, 261) = mat(k, 261) + lmat(k, 261) + mat(k, 263) = lmat(k, 263) + mat(k, 266) = mat(k, 266) + lmat(k, 266) + mat(k, 268) = mat(k, 268) + lmat(k, 268) + mat(k, 275) = mat(k, 275) + lmat(k, 275) mat(k, 276) = mat(k, 276) + lmat(k, 276) - mat(k, 277) = mat(k, 277) + lmat(k, 277) - mat(k, 279) = lmat(k, 279) - mat(k, 280) = mat(k, 280) + lmat(k, 280) - mat(k, 282) = mat(k, 282) + lmat(k, 282) - mat(k, 284) = mat(k, 284) + lmat(k, 284) - mat(k, 285) = mat(k, 285) + lmat(k, 285) - mat(k, 287) = mat(k, 287) + lmat(k, 287) + mat(k, 278) = lmat(k, 278) + mat(k, 281) = mat(k, 281) + lmat(k, 281) + mat(k, 289) = mat(k, 289) + lmat(k, 289) + mat(k, 294) = lmat(k, 294) + mat(k, 296) = mat(k, 296) + lmat(k, 296) mat(k, 297) = mat(k, 297) + lmat(k, 297) - mat(k, 301) = lmat(k, 301) - mat(k, 302) = lmat(k, 302) - mat(k, 303) = mat(k, 303) + lmat(k, 303) - mat(k, 304) = lmat(k, 304) - mat(k, 305) = lmat(k, 305) - mat(k, 309) = lmat(k, 309) - mat(k, 311) = mat(k, 311) + lmat(k, 311) - mat(k, 321) = lmat(k, 321) - mat(k, 324) = mat(k, 324) + lmat(k, 324) + mat(k, 306) = mat(k, 306) + lmat(k, 306) + mat(k, 307) = lmat(k, 307) + mat(k, 309) = mat(k, 309) + lmat(k, 309) + mat(k, 314) = mat(k, 314) + lmat(k, 314) + mat(k, 322) = mat(k, 322) + lmat(k, 322) + mat(k, 323) = mat(k, 323) + lmat(k, 323) + mat(k, 327) = mat(k, 327) + lmat(k, 327) + mat(k, 329) = mat(k, 329) + lmat(k, 329) + mat(k, 330) = mat(k, 330) + lmat(k, 330) mat(k, 335) = mat(k, 335) + lmat(k, 335) - mat(k, 350) = mat(k, 350) + lmat(k, 350) - mat(k, 362) = mat(k, 362) + lmat(k, 362) - mat(k, 363) = lmat(k, 363) - mat(k, 375) = mat(k, 375) + lmat(k, 375) - mat(k, 377) = lmat(k, 377) + mat(k, 338) = mat(k, 338) + lmat(k, 338) + mat(k, 348) = mat(k, 348) + lmat(k, 348) + mat(k, 349) = lmat(k, 349) + mat(k, 352) = lmat(k, 352) + mat(k, 355) = mat(k, 355) + lmat(k, 355) + mat(k, 356) = mat(k, 356) + lmat(k, 356) + mat(k, 358) = mat(k, 358) + lmat(k, 358) + mat(k, 359) = mat(k, 359) + lmat(k, 359) + mat(k, 362) = lmat(k, 362) + mat(k, 363) = mat(k, 363) + lmat(k, 363) + mat(k, 364) = mat(k, 364) + lmat(k, 364) + mat(k, 366) = mat(k, 366) + lmat(k, 366) + mat(k, 374) = mat(k, 374) + lmat(k, 374) mat(k, 379) = mat(k, 379) + lmat(k, 379) - mat(k, 387) = mat(k, 387) + lmat(k, 387) - mat(k, 393) = mat(k, 393) + lmat(k, 393) - mat(k, 394) = lmat(k, 394) - mat(k, 399) = mat(k, 399) + lmat(k, 399) - mat(k, 409) = mat(k, 409) + lmat(k, 409) - mat(k, 410) = lmat(k, 410) + mat(k, 385) = mat(k, 385) + lmat(k, 385) + mat(k, 386) = lmat(k, 386) + mat(k, 390) = lmat(k, 390) + mat(k, 398) = mat(k, 398) + lmat(k, 398) + mat(k, 402) = lmat(k, 402) + mat(k, 403) = mat(k, 403) + lmat(k, 403) + mat(k, 404) = lmat(k, 404) + mat(k, 406) = lmat(k, 406) + mat(k, 408) = lmat(k, 408) + mat(k, 411) = lmat(k, 411) + mat(k, 413) = mat(k, 413) + lmat(k, 413) + mat(k, 414) = mat(k, 414) + lmat(k, 414) + mat(k, 415) = mat(k, 415) + lmat(k, 415) + mat(k, 416) = mat(k, 416) + lmat(k, 416) + mat(k, 419) = mat(k, 419) + lmat(k, 419) + mat(k, 422) = lmat(k, 422) mat(k, 423) = mat(k, 423) + lmat(k, 423) - mat(k, 424) = mat(k, 424) + lmat(k, 424) mat(k, 425) = lmat(k, 425) - mat(k, 437) = mat(k, 437) + lmat(k, 437) - mat(k, 438) = mat(k, 438) + lmat(k, 438) - mat(k, 440) = lmat(k, 440) + mat(k, 427) = mat(k, 427) + lmat(k, 427) + mat(k, 429) = mat(k, 429) + lmat(k, 429) + mat(k, 441) = lmat(k, 441) mat(k, 443) = mat(k, 443) + lmat(k, 443) - mat(k, 444) = mat(k, 444) + lmat(k, 444) - mat(k, 448) = mat(k, 448) + lmat(k, 448) - mat(k, 450) = lmat(k, 450) - mat(k, 454) = mat(k, 454) + lmat(k, 454) - mat(k, 465) = mat(k, 465) + lmat(k, 465) - mat(k, 484) = mat(k, 484) + lmat(k, 484) - mat(k, 503) = mat(k, 503) + lmat(k, 503) - mat(k, 504) = lmat(k, 504) - mat(k, 511) = mat(k, 511) + lmat(k, 511) - mat(k, 519) = mat(k, 519) + lmat(k, 519) - mat(k, 520) = lmat(k, 520) - mat(k, 536) = mat(k, 536) + lmat(k, 536) - mat(k, 539) = mat(k, 539) + lmat(k, 539) - mat(k, 542) = lmat(k, 542) - mat(k, 556) = mat(k, 556) + lmat(k, 556) + mat(k, 447) = lmat(k, 447) + mat(k, 458) = mat(k, 458) + lmat(k, 458) + mat(k, 470) = mat(k, 470) + lmat(k, 470) + mat(k, 485) = lmat(k, 485) + mat(k, 487) = mat(k, 487) + lmat(k, 487) + mat(k, 492) = mat(k, 492) + lmat(k, 492) + mat(k, 501) = mat(k, 501) + lmat(k, 501) + mat(k, 502) = lmat(k, 502) + mat(k, 515) = mat(k, 515) + lmat(k, 515) + mat(k, 516) = mat(k, 516) + lmat(k, 516) + mat(k, 517) = lmat(k, 517) + mat(k, 524) = mat(k, 524) + lmat(k, 524) + mat(k, 532) = mat(k, 532) + lmat(k, 532) + mat(k, 533) = lmat(k, 533) + mat(k, 546) = mat(k, 546) + lmat(k, 546) + mat(k, 547) = mat(k, 547) + lmat(k, 547) + mat(k, 548) = lmat(k, 548) mat(k, 560) = mat(k, 560) + lmat(k, 560) - mat(k, 561) = lmat(k, 561) - mat(k, 576) = mat(k, 576) + lmat(k, 576) - mat(k, 583) = mat(k, 583) + lmat(k, 583) - mat(k, 584) = mat(k, 584) + lmat(k, 584) + mat(k, 561) = mat(k, 561) + lmat(k, 561) + mat(k, 579) = mat(k, 579) + lmat(k, 579) + mat(k, 591) = mat(k, 591) + lmat(k, 591) mat(k, 595) = mat(k, 595) + lmat(k, 595) mat(k, 601) = mat(k, 601) + lmat(k, 601) - mat(k, 604) = lmat(k, 604) + mat(k, 603) = lmat(k, 603) + mat(k, 604) = mat(k, 604) + lmat(k, 604) mat(k, 606) = mat(k, 606) + lmat(k, 606) - mat(k, 623) = mat(k, 623) + lmat(k, 623) - mat(k, 625) = mat(k, 625) + lmat(k, 625) - mat(k, 626) = mat(k, 626) + lmat(k, 626) - mat(k, 628) = mat(k, 628) + lmat(k, 628) - mat(k, 631) = lmat(k, 631) - mat(k, 633) = mat(k, 633) + lmat(k, 633) - mat(k, 634) = mat(k, 634) + lmat(k, 634) - mat(k, 636) = lmat(k, 636) - mat(k, 637) = mat(k, 637) + lmat(k, 637) - mat(k, 638) = lmat(k, 638) + mat(k, 607) = lmat(k, 607) + mat(k, 611) = mat(k, 611) + lmat(k, 611) + mat(k, 622) = mat(k, 622) + lmat(k, 622) + mat(k, 623) = lmat(k, 623) mat(k, 639) = mat(k, 639) + lmat(k, 639) - mat(k, 645) = mat(k, 645) + lmat(k, 645) - mat(k, 649) = mat(k, 649) + lmat(k, 649) - mat(k, 650) = mat(k, 650) + lmat(k, 650) - mat(k, 651) = lmat(k, 651) - mat(k, 656) = mat(k, 656) + lmat(k, 656) - mat(k, 660) = mat(k, 660) + lmat(k, 660) - mat(k, 675) = lmat(k, 675) - mat(k, 690) = mat(k, 690) + lmat(k, 690) - mat(k, 713) = mat(k, 713) + lmat(k, 713) - mat(k, 720) = mat(k, 720) + lmat(k, 720) - mat(k, 729) = lmat(k, 729) - mat(k, 736) = mat(k, 736) + lmat(k, 736) - mat(k, 747) = mat(k, 747) + lmat(k, 747) - mat(k, 768) = lmat(k, 768) - mat(k, 769) = lmat(k, 769) - mat(k, 786) = mat(k, 786) + lmat(k, 786) - mat(k, 788) = mat(k, 788) + lmat(k, 788) - mat(k, 793) = mat(k, 793) + lmat(k, 793) - mat(k, 794) = mat(k, 794) + lmat(k, 794) - mat(k, 807) = mat(k, 807) + lmat(k, 807) - mat(k, 814) = mat(k, 814) + lmat(k, 814) - mat(k, 822) = mat(k, 822) + lmat(k, 822) - mat(k, 842) = lmat(k, 842) - mat(k, 852) = mat(k, 852) + lmat(k, 852) - mat(k, 855) = mat(k, 855) + lmat(k, 855) - mat(k, 868) = lmat(k, 868) - mat(k, 876) = lmat(k, 876) - mat(k, 877) = lmat(k, 877) - mat(k, 900) = mat(k, 900) + lmat(k, 900) - mat(k, 943) = mat(k, 943) + lmat(k, 943) - mat(k, 985) = mat(k, 985) + lmat(k, 985) - mat(k, 990) = mat(k, 990) + lmat(k, 990) - mat(k, 997) = mat(k, 997) + lmat(k, 997) - mat(k,1000) = mat(k,1000) + lmat(k,1000) - mat(k,1002) = mat(k,1002) + lmat(k,1002) - mat(k,1011) = lmat(k,1011) + mat(k, 644) = mat(k, 644) + lmat(k, 644) + mat(k, 666) = mat(k, 666) + lmat(k, 666) + mat(k, 670) = lmat(k, 670) + mat(k, 684) = mat(k, 684) + lmat(k, 684) + mat(k, 688) = mat(k, 688) + lmat(k, 688) + mat(k, 689) = lmat(k, 689) + mat(k, 704) = mat(k, 704) + lmat(k, 704) + mat(k, 711) = mat(k, 711) + lmat(k, 711) + mat(k, 712) = mat(k, 712) + lmat(k, 712) + mat(k, 719) = mat(k, 719) + lmat(k, 719) + mat(k, 730) = mat(k, 730) + lmat(k, 730) + mat(k, 733) = lmat(k, 733) + mat(k, 735) = mat(k, 735) + lmat(k, 735) + mat(k, 743) = mat(k, 743) + lmat(k, 743) + mat(k, 784) = mat(k, 784) + lmat(k, 784) + mat(k, 790) = mat(k, 790) + lmat(k, 790) + mat(k, 808) = mat(k, 808) + lmat(k, 808) + mat(k, 830) = mat(k, 830) + lmat(k, 830) + mat(k, 846) = lmat(k, 846) + mat(k, 856) = mat(k, 856) + lmat(k, 856) + mat(k, 863) = mat(k, 863) + lmat(k, 863) + mat(k, 865) = lmat(k, 865) + mat(k, 866) = mat(k, 866) + lmat(k, 866) + mat(k, 886) = mat(k, 886) + lmat(k, 886) + mat(k, 897) = mat(k, 897) + lmat(k, 897) + mat(k, 923) = mat(k, 923) + lmat(k, 923) + mat(k, 925) = lmat(k, 925) + mat(k, 937) = mat(k, 937) + lmat(k, 937) + mat(k, 981) = mat(k, 981) + lmat(k, 981) + mat(k,1011) = mat(k,1011) + lmat(k,1011) + mat(k,1031) = lmat(k,1031) mat(k,1033) = mat(k,1033) + lmat(k,1033) - mat(k,1052) = mat(k,1052) + lmat(k,1052) - mat(k,1075) = mat(k,1075) + lmat(k,1075) + mat(k,1055) = mat(k,1055) + lmat(k,1055) + mat(k,1096) = mat(k,1096) + lmat(k,1096) + mat(k,1099) = mat(k,1099) + lmat(k,1099) + mat(k,1100) = mat(k,1100) + lmat(k,1100) + mat(k,1108) = mat(k,1108) + lmat(k,1108) + mat(k,1110) = mat(k,1110) + lmat(k,1110) mat(k,1112) = mat(k,1112) + lmat(k,1112) - mat(k,1115) = mat(k,1115) + lmat(k,1115) - mat(k,1118) = mat(k,1118) + lmat(k,1118) - mat(k,1119) = mat(k,1119) + lmat(k,1119) - mat(k,1122) = mat(k,1122) + lmat(k,1122) - mat(k,1124) = mat(k,1124) + lmat(k,1124) - mat(k,1160) = mat(k,1160) + lmat(k,1160) - mat(k,1167) = mat(k,1167) + lmat(k,1167) - mat(k,1175) = mat(k,1175) + lmat(k,1175) - mat(k,1179) = mat(k,1179) + lmat(k,1179) - mat(k,1187) = mat(k,1187) + lmat(k,1187) - mat(k,1202) = mat(k,1202) + lmat(k,1202) - mat(k,1203) = mat(k,1203) + lmat(k,1203) - mat(k,1207) = mat(k,1207) + lmat(k,1207) - mat(k,1220) = lmat(k,1220) - mat(k,1221) = mat(k,1221) + lmat(k,1221) - mat(k,1228) = mat(k,1228) + lmat(k,1228) - mat(k,1236) = mat(k,1236) + lmat(k,1236) - mat(k,1252) = mat(k,1252) + lmat(k,1252) - mat(k,1255) = mat(k,1255) + lmat(k,1255) - mat(k,1256) = mat(k,1256) + lmat(k,1256) - mat(k,1259) = mat(k,1259) + lmat(k,1259) - mat(k,1280) = mat(k,1280) + lmat(k,1280) - mat(k,1285) = lmat(k,1285) + mat(k,1119) = lmat(k,1119) + mat(k,1145) = mat(k,1145) + lmat(k,1145) + mat(k,1189) = mat(k,1189) + lmat(k,1189) + mat(k,1225) = mat(k,1225) + lmat(k,1225) + mat(k,1231) = mat(k,1231) + lmat(k,1231) + mat(k,1240) = lmat(k,1240) + mat(k,1253) = mat(k,1253) + lmat(k,1253) + mat(k,1254) = mat(k,1254) + lmat(k,1254) + mat(k,1270) = mat(k,1270) + lmat(k,1270) + mat(k,1287) = mat(k,1287) + lmat(k,1287) mat(k,1292) = mat(k,1292) + lmat(k,1292) - mat(k,1311) = lmat(k,1311) - mat(k,1326) = mat(k,1326) + lmat(k,1326) - mat(k,1328) = mat(k,1328) + lmat(k,1328) - mat(k,1333) = mat(k,1333) + lmat(k,1333) - mat(k,1362) = mat(k,1362) + lmat(k,1362) - mat(k,1373) = mat(k,1373) + lmat(k,1373) - mat(k,1376) = mat(k,1376) + lmat(k,1376) - mat(k,1388) = mat(k,1388) + lmat(k,1388) - mat(k,1389) = mat(k,1389) + lmat(k,1389) - mat(k,1402) = mat(k,1402) + lmat(k,1402) - mat(k,1433) = mat(k,1433) + lmat(k,1433) - mat(k,1436) = mat(k,1436) + lmat(k,1436) - mat(k,1445) = mat(k,1445) + lmat(k,1445) - mat(k,1450) = lmat(k,1450) - mat(k,1451) = lmat(k,1451) - mat(k,1459) = mat(k,1459) + lmat(k,1459) - mat(k,1469) = mat(k,1469) + lmat(k,1469) - mat(k,1476) = mat(k,1476) + lmat(k,1476) - mat(k,1488) = mat(k,1488) + lmat(k,1488) - mat(k,1504) = mat(k,1504) + lmat(k,1504) - mat(k,1516) = mat(k,1516) + lmat(k,1516) + mat(k,1335) = mat(k,1335) + lmat(k,1335) + mat(k,1372) = mat(k,1372) + lmat(k,1372) + mat(k,1416) = mat(k,1416) + lmat(k,1416) + mat(k,1422) = lmat(k,1422) + mat(k,1431) = mat(k,1431) + lmat(k,1431) + mat(k,1432) = lmat(k,1432) + mat(k,1460) = mat(k,1460) + lmat(k,1460) + mat(k,1474) = mat(k,1474) + lmat(k,1474) + mat(k,1503) = mat(k,1503) + lmat(k,1503) + mat(k,1506) = mat(k,1506) + lmat(k,1506) mat(k,1518) = mat(k,1518) + lmat(k,1518) - mat(k,1519) = mat(k,1519) + lmat(k,1519) - mat(k,1561) = mat(k,1561) + lmat(k,1561) - mat(k,1604) = mat(k,1604) + lmat(k,1604) - mat(k,1607) = lmat(k,1607) - mat(k,1610) = mat(k,1610) + lmat(k,1610) - mat(k,1612) = lmat(k,1612) - mat(k,1617) = mat(k,1617) + lmat(k,1617) - mat(k,1635) = mat(k,1635) + lmat(k,1635) - mat(k,1637) = mat(k,1637) + lmat(k,1637) - mat(k,1653) = lmat(k,1653) - mat(k,1667) = mat(k,1667) + lmat(k,1667) - mat(k,1670) = mat(k,1670) + lmat(k,1670) - mat(k,1673) = mat(k,1673) + lmat(k,1673) - mat(k,1700) = lmat(k,1700) - mat(k,1716) = mat(k,1716) + lmat(k,1716) - mat(k,1719) = mat(k,1719) + lmat(k,1719) - mat(k,1753) = mat(k,1753) + lmat(k,1753) - mat(k,1754) = mat(k,1754) + lmat(k,1754) - mat(k,1761) = mat(k,1761) + lmat(k,1761) + mat(k,1532) = mat(k,1532) + lmat(k,1532) + mat(k,1543) = mat(k,1543) + lmat(k,1543) + mat(k,1549) = mat(k,1549) + lmat(k,1549) + mat(k,1579) = mat(k,1579) + lmat(k,1579) + mat(k,1589) = mat(k,1589) + lmat(k,1589) + mat(k,1592) = mat(k,1592) + lmat(k,1592) + mat(k,1623) = mat(k,1623) + lmat(k,1623) + mat(k,1629) = mat(k,1629) + lmat(k,1629) + mat(k,1630) = mat(k,1630) + lmat(k,1630) + mat(k,1638) = mat(k,1638) + lmat(k,1638) + mat(k,1640) = mat(k,1640) + lmat(k,1640) + mat(k,1677) = lmat(k,1677) + mat(k,1682) = mat(k,1682) + lmat(k,1682) + mat(k,1691) = mat(k,1691) + lmat(k,1691) + mat(k,1695) = mat(k,1695) + lmat(k,1695) + mat(k,1710) = mat(k,1710) + lmat(k,1710) + mat(k,1712) = mat(k,1712) + lmat(k,1712) + mat(k,1715) = mat(k,1715) + lmat(k,1715) + mat(k,1725) = mat(k,1725) + lmat(k,1725) + mat(k,1760) = mat(k,1760) + lmat(k,1760) + mat(k,1771) = mat(k,1771) + lmat(k,1771) + mat(k,1777) = mat(k,1777) + lmat(k,1777) + mat(k,1780) = lmat(k,1780) + mat(k,1781) = mat(k,1781) + lmat(k,1781) + mat(k,1789) = mat(k,1789) + lmat(k,1789) mat(k,1797) = mat(k,1797) + lmat(k,1797) - mat(k,1821) = lmat(k,1821) - mat(k,1827) = mat(k,1827) + lmat(k,1827) - mat(k,1831) = mat(k,1831) + lmat(k,1831) - mat(k,1846) = lmat(k,1846) - mat(k,1855) = lmat(k,1855) - mat(k,1856) = mat(k,1856) + lmat(k,1856) - mat(k, 182) = 0._r8 - mat(k, 187) = 0._r8 - mat(k, 191) = 0._r8 - mat(k, 195) = 0._r8 - mat(k, 213) = 0._r8 - mat(k, 260) = 0._r8 - mat(k, 266) = 0._r8 - mat(k, 267) = 0._r8 - mat(k, 268) = 0._r8 - mat(k, 273) = 0._r8 - mat(k, 274) = 0._r8 - mat(k, 286) = 0._r8 - mat(k, 310) = 0._r8 + mat(k,1804) = mat(k,1804) + lmat(k,1804) + mat(k,1809) = mat(k,1809) + lmat(k,1809) + mat(k,1816) = mat(k,1816) + lmat(k,1816) + mat(k,1821) = mat(k,1821) + lmat(k,1821) + mat(k,1835) = mat(k,1835) + lmat(k,1835) + mat(k,1837) = mat(k,1837) + lmat(k,1837) + mat(k,1855) = mat(k,1855) + lmat(k,1855) + mat(k,1873) = mat(k,1873) + lmat(k,1873) + mat(k,1878) = mat(k,1878) + lmat(k,1878) + mat(k,1892) = mat(k,1892) + lmat(k,1892) + mat(k,1900) = mat(k,1900) + lmat(k,1900) + mat(k,1907) = mat(k,1907) + lmat(k,1907) + mat(k,1919) = mat(k,1919) + lmat(k,1919) + mat(k,1931) = mat(k,1931) + lmat(k,1931) + mat(k,1934) = mat(k,1934) + lmat(k,1934) + mat(k,1940) = mat(k,1940) + lmat(k,1940) + mat(k,1961) = lmat(k,1961) + mat(k,1977) = mat(k,1977) + lmat(k,1977) + mat(k,2026) = mat(k,2026) + lmat(k,2026) + mat(k,2052) = lmat(k,2052) + mat(k,2057) = mat(k,2057) + lmat(k,2057) + mat(k,2062) = mat(k,2062) + lmat(k,2062) + mat(k,2069) = lmat(k,2069) + mat(k,2071) = lmat(k,2071) + mat(k,2087) = mat(k,2087) + lmat(k,2087) + mat(k, 114) = 0._r8 + mat(k, 284) = 0._r8 + mat(k, 287) = 0._r8 + mat(k, 292) = 0._r8 + mat(k, 293) = 0._r8 mat(k, 312) = 0._r8 - mat(k, 313) = 0._r8 - mat(k, 327) = 0._r8 - mat(k, 333) = 0._r8 - mat(k, 334) = 0._r8 - mat(k, 351) = 0._r8 - mat(k, 352) = 0._r8 - mat(k, 355) = 0._r8 - mat(k, 359) = 0._r8 - mat(k, 360) = 0._r8 - mat(k, 382) = 0._r8 - mat(k, 392) = 0._r8 - mat(k, 457) = 0._r8 + mat(k, 353) = 0._r8 + mat(k, 365) = 0._r8 + mat(k, 387) = 0._r8 + mat(k, 388) = 0._r8 + mat(k, 389) = 0._r8 + mat(k, 393) = 0._r8 + mat(k, 420) = 0._r8 + mat(k, 421) = 0._r8 + mat(k, 432) = 0._r8 + mat(k, 433) = 0._r8 + mat(k, 439) = 0._r8 + mat(k, 442) = 0._r8 + mat(k, 444) = 0._r8 + mat(k, 445) = 0._r8 + mat(k, 455) = 0._r8 mat(k, 459) = 0._r8 mat(k, 462) = 0._r8 mat(k, 463) = 0._r8 mat(k, 464) = 0._r8 - mat(k, 483) = 0._r8 - mat(k, 485) = 0._r8 - mat(k, 487) = 0._r8 - mat(k, 489) = 0._r8 + mat(k, 467) = 0._r8 mat(k, 490) = 0._r8 - mat(k, 492) = 0._r8 - mat(k, 493) = 0._r8 - mat(k, 496) = 0._r8 mat(k, 500) = 0._r8 - mat(k, 521) = 0._r8 - mat(k, 524) = 0._r8 - mat(k, 531) = 0._r8 - mat(k, 564) = 0._r8 - mat(k, 571) = 0._r8 + mat(k, 582) = 0._r8 + mat(k, 584) = 0._r8 mat(k, 585) = 0._r8 mat(k, 586) = 0._r8 + mat(k, 589) = 0._r8 mat(k, 590) = 0._r8 - mat(k, 591) = 0._r8 - mat(k, 592) = 0._r8 - mat(k, 594) = 0._r8 - mat(k, 599) = 0._r8 - mat(k, 600) = 0._r8 - mat(k, 605) = 0._r8 - mat(k, 607) = 0._r8 - mat(k, 610) = 0._r8 - mat(k, 613) = 0._r8 - mat(k, 614) = 0._r8 - mat(k, 618) = 0._r8 - mat(k, 619) = 0._r8 - mat(k, 620) = 0._r8 - mat(k, 621) = 0._r8 - mat(k, 622) = 0._r8 - mat(k, 630) = 0._r8 - mat(k, 632) = 0._r8 - mat(k, 640) = 0._r8 - mat(k, 641) = 0._r8 + mat(k, 624) = 0._r8 + mat(k, 629) = 0._r8 + mat(k, 635) = 0._r8 mat(k, 642) = 0._r8 - mat(k, 646) = 0._r8 + mat(k, 643) = 0._r8 + mat(k, 645) = 0._r8 mat(k, 647) = 0._r8 - mat(k, 648) = 0._r8 - mat(k, 652) = 0._r8 - mat(k, 653) = 0._r8 - mat(k, 654) = 0._r8 - mat(k, 662) = 0._r8 - mat(k, 666) = 0._r8 - mat(k, 669) = 0._r8 - mat(k, 680) = 0._r8 - mat(k, 682) = 0._r8 - mat(k, 683) = 0._r8 + mat(k, 650) = 0._r8 + mat(k, 651) = 0._r8 + mat(k, 655) = 0._r8 + mat(k, 656) = 0._r8 + mat(k, 657) = 0._r8 + mat(k, 658) = 0._r8 + mat(k, 661) = 0._r8 + mat(k, 694) = 0._r8 + mat(k, 700) = 0._r8 + mat(k, 713) = 0._r8 + mat(k, 714) = 0._r8 mat(k, 717) = 0._r8 + mat(k, 718) = 0._r8 + mat(k, 720) = 0._r8 + mat(k, 721) = 0._r8 + mat(k, 726) = 0._r8 mat(k, 727) = 0._r8 - mat(k, 732) = 0._r8 + mat(k, 729) = 0._r8 + mat(k, 734) = 0._r8 + mat(k, 736) = 0._r8 + mat(k, 739) = 0._r8 mat(k, 745) = 0._r8 mat(k, 746) = 0._r8 + mat(k, 747) = 0._r8 + mat(k, 748) = 0._r8 + mat(k, 749) = 0._r8 mat(k, 750) = 0._r8 - mat(k, 756) = 0._r8 - mat(k, 757) = 0._r8 - mat(k, 758) = 0._r8 - mat(k, 762) = 0._r8 - mat(k, 763) = 0._r8 - mat(k, 764) = 0._r8 - mat(k, 780) = 0._r8 + mat(k, 751) = 0._r8 + mat(k, 752) = 0._r8 + mat(k, 776) = 0._r8 + mat(k, 779) = 0._r8 + mat(k, 787) = 0._r8 + mat(k, 788) = 0._r8 + mat(k, 789) = 0._r8 mat(k, 792) = 0._r8 + mat(k, 794) = 0._r8 mat(k, 795) = 0._r8 - mat(k, 797) = 0._r8 - mat(k, 804) = 0._r8 - mat(k, 805) = 0._r8 - mat(k, 809) = 0._r8 - mat(k, 810) = 0._r8 - mat(k, 811) = 0._r8 - mat(k, 818) = 0._r8 - mat(k, 829) = 0._r8 - mat(k, 830) = 0._r8 + mat(k, 796) = 0._r8 + mat(k, 800) = 0._r8 + mat(k, 801) = 0._r8 + mat(k, 803) = 0._r8 mat(k, 831) = 0._r8 + mat(k, 833) = 0._r8 + mat(k, 836) = 0._r8 mat(k, 839) = 0._r8 - mat(k, 851) = 0._r8 - mat(k, 863) = 0._r8 - mat(k, 865) = 0._r8 - mat(k, 871) = 0._r8 - mat(k, 879) = 0._r8 - mat(k, 880) = 0._r8 - mat(k, 892) = 0._r8 + mat(k, 848) = 0._r8 + mat(k, 853) = 0._r8 + mat(k, 854) = 0._r8 + mat(k, 872) = 0._r8 + mat(k, 877) = 0._r8 + mat(k, 882) = 0._r8 + mat(k, 895) = 0._r8 mat(k, 896) = 0._r8 + mat(k, 899) = 0._r8 mat(k, 901) = 0._r8 - mat(k, 903) = 0._r8 + mat(k, 905) = 0._r8 mat(k, 907) = 0._r8 - mat(k, 911) = 0._r8 + mat(k, 908) = 0._r8 + mat(k, 913) = 0._r8 + mat(k, 914) = 0._r8 mat(k, 916) = 0._r8 - mat(k, 917) = 0._r8 - mat(k, 918) = 0._r8 - mat(k, 919) = 0._r8 - mat(k, 920) = 0._r8 - mat(k, 921) = 0._r8 mat(k, 924) = 0._r8 - mat(k, 938) = 0._r8 - mat(k, 942) = 0._r8 - mat(k, 945) = 0._r8 - mat(k, 946) = 0._r8 - mat(k, 949) = 0._r8 - mat(k, 953) = 0._r8 - mat(k, 958) = 0._r8 - mat(k, 959) = 0._r8 - mat(k, 960) = 0._r8 - mat(k, 961) = 0._r8 - mat(k, 962) = 0._r8 - mat(k, 963) = 0._r8 - mat(k, 967) = 0._r8 - mat(k, 974) = 0._r8 - mat(k, 975) = 0._r8 - mat(k, 976) = 0._r8 - mat(k, 980) = 0._r8 - mat(k, 981) = 0._r8 - mat(k, 988) = 0._r8 + mat(k, 930) = 0._r8 + mat(k, 968) = 0._r8 + mat(k, 979) = 0._r8 + mat(k, 982) = 0._r8 + mat(k, 984) = 0._r8 mat(k, 989) = 0._r8 mat(k, 991) = 0._r8 mat(k, 992) = 0._r8 - mat(k, 994) = 0._r8 - mat(k, 999) = 0._r8 - mat(k,1003) = 0._r8 - mat(k,1004) = 0._r8 - mat(k,1007) = 0._r8 - mat(k,1009) = 0._r8 + mat(k, 997) = 0._r8 + mat(k, 998) = 0._r8 + mat(k,1006) = 0._r8 mat(k,1012) = 0._r8 - mat(k,1026) = 0._r8 - mat(k,1030) = 0._r8 - mat(k,1031) = 0._r8 - mat(k,1034) = 0._r8 - mat(k,1037) = 0._r8 - mat(k,1041) = 0._r8 + mat(k,1013) = 0._r8 + mat(k,1022) = 0._r8 + mat(k,1032) = 0._r8 mat(k,1044) = 0._r8 - mat(k,1046) = 0._r8 - mat(k,1047) = 0._r8 mat(k,1048) = 0._r8 - mat(k,1050) = 0._r8 + mat(k,1053) = 0._r8 + mat(k,1056) = 0._r8 + mat(k,1059) = 0._r8 + mat(k,1065) = 0._r8 + mat(k,1068) = 0._r8 mat(k,1071) = 0._r8 - mat(k,1074) = 0._r8 - mat(k,1078) = 0._r8 - mat(k,1082) = 0._r8 + mat(k,1073) = 0._r8 + mat(k,1077) = 0._r8 + mat(k,1083) = 0._r8 + mat(k,1084) = 0._r8 + mat(k,1085) = 0._r8 + mat(k,1086) = 0._r8 mat(k,1087) = 0._r8 mat(k,1088) = 0._r8 - mat(k,1089) = 0._r8 mat(k,1090) = 0._r8 mat(k,1091) = 0._r8 + mat(k,1093) = 0._r8 + mat(k,1095) = 0._r8 + mat(k,1097) = 0._r8 mat(k,1098) = 0._r8 - mat(k,1099) = 0._r8 - mat(k,1100) = 0._r8 mat(k,1101) = 0._r8 mat(k,1102) = 0._r8 mat(k,1103) = 0._r8 + mat(k,1104) = 0._r8 mat(k,1105) = 0._r8 mat(k,1106) = 0._r8 + mat(k,1107) = 0._r8 mat(k,1109) = 0._r8 - mat(k,1110) = 0._r8 mat(k,1111) = 0._r8 mat(k,1113) = 0._r8 mat(k,1114) = 0._r8 + mat(k,1115) = 0._r8 mat(k,1116) = 0._r8 mat(k,1117) = 0._r8 - mat(k,1120) = 0._r8 - mat(k,1121) = 0._r8 + mat(k,1118) = 0._r8 + mat(k,1122) = 0._r8 mat(k,1123) = 0._r8 - mat(k,1125) = 0._r8 - mat(k,1126) = 0._r8 - mat(k,1127) = 0._r8 - mat(k,1128) = 0._r8 - mat(k,1129) = 0._r8 - mat(k,1130) = 0._r8 - mat(k,1131) = 0._r8 - mat(k,1132) = 0._r8 - mat(k,1141) = 0._r8 - mat(k,1143) = 0._r8 - mat(k,1144) = 0._r8 - mat(k,1145) = 0._r8 + mat(k,1135) = 0._r8 + mat(k,1139) = 0._r8 + mat(k,1146) = 0._r8 + mat(k,1150) = 0._r8 + mat(k,1151) = 0._r8 mat(k,1152) = 0._r8 - mat(k,1154) = 0._r8 mat(k,1155) = 0._r8 - mat(k,1156) = 0._r8 mat(k,1157) = 0._r8 - mat(k,1158) = 0._r8 mat(k,1159) = 0._r8 mat(k,1161) = 0._r8 mat(k,1162) = 0._r8 - mat(k,1165) = 0._r8 + mat(k,1163) = 0._r8 mat(k,1168) = 0._r8 - mat(k,1169) = 0._r8 - mat(k,1170) = 0._r8 - mat(k,1173) = 0._r8 - mat(k,1181) = 0._r8 - mat(k,1186) = 0._r8 - mat(k,1189) = 0._r8 + mat(k,1182) = 0._r8 + mat(k,1188) = 0._r8 + mat(k,1192) = 0._r8 mat(k,1193) = 0._r8 + mat(k,1194) = 0._r8 mat(k,1195) = 0._r8 - mat(k,1196) = 0._r8 mat(k,1198) = 0._r8 - mat(k,1199) = 0._r8 - mat(k,1201) = 0._r8 + mat(k,1200) = 0._r8 + mat(k,1202) = 0._r8 mat(k,1204) = 0._r8 + mat(k,1205) = 0._r8 mat(k,1206) = 0._r8 - mat(k,1211) = 0._r8 + mat(k,1213) = 0._r8 mat(k,1214) = 0._r8 mat(k,1217) = 0._r8 + mat(k,1219) = 0._r8 + mat(k,1220) = 0._r8 + mat(k,1227) = 0._r8 + mat(k,1229) = 0._r8 + mat(k,1230) = 0._r8 + mat(k,1232) = 0._r8 mat(k,1233) = 0._r8 mat(k,1234) = 0._r8 mat(k,1235) = 0._r8 - mat(k,1237) = 0._r8 - mat(k,1238) = 0._r8 + mat(k,1236) = 0._r8 mat(k,1239) = 0._r8 mat(k,1241) = 0._r8 + mat(k,1242) = 0._r8 mat(k,1243) = 0._r8 + mat(k,1244) = 0._r8 mat(k,1245) = 0._r8 - mat(k,1246) = 0._r8 mat(k,1247) = 0._r8 - mat(k,1248) = 0._r8 mat(k,1249) = 0._r8 - mat(k,1250) = 0._r8 - mat(k,1253) = 0._r8 - mat(k,1257) = 0._r8 mat(k,1260) = 0._r8 - mat(k,1261) = 0._r8 - mat(k,1263) = 0._r8 - mat(k,1264) = 0._r8 mat(k,1266) = 0._r8 - mat(k,1270) = 0._r8 - mat(k,1272) = 0._r8 - mat(k,1275) = 0._r8 - mat(k,1276) = 0._r8 - mat(k,1283) = 0._r8 - mat(k,1284) = 0._r8 - mat(k,1286) = 0._r8 - mat(k,1287) = 0._r8 + mat(k,1279) = 0._r8 mat(k,1290) = 0._r8 mat(k,1291) = 0._r8 - mat(k,1294) = 0._r8 + mat(k,1293) = 0._r8 mat(k,1295) = 0._r8 mat(k,1296) = 0._r8 - mat(k,1297) = 0._r8 - mat(k,1298) = 0._r8 - mat(k,1299) = 0._r8 - mat(k,1300) = 0._r8 - mat(k,1302) = 0._r8 - mat(k,1303) = 0._r8 - mat(k,1304) = 0._r8 - mat(k,1309) = 0._r8 - mat(k,1315) = 0._r8 - mat(k,1316) = 0._r8 - mat(k,1323) = 0._r8 - mat(k,1335) = 0._r8 - mat(k,1358) = 0._r8 - mat(k,1363) = 0._r8 - mat(k,1365) = 0._r8 + mat(k,1301) = 0._r8 + mat(k,1310) = 0._r8 + mat(k,1331) = 0._r8 + mat(k,1337) = 0._r8 + mat(k,1338) = 0._r8 + mat(k,1341) = 0._r8 + mat(k,1343) = 0._r8 + mat(k,1345) = 0._r8 + mat(k,1347) = 0._r8 + mat(k,1348) = 0._r8 + mat(k,1349) = 0._r8 + mat(k,1356) = 0._r8 + mat(k,1357) = 0._r8 + mat(k,1360) = 0._r8 mat(k,1366) = 0._r8 + mat(k,1367) = 0._r8 + mat(k,1368) = 0._r8 mat(k,1369) = 0._r8 + mat(k,1373) = 0._r8 + mat(k,1374) = 0._r8 + mat(k,1377) = 0._r8 mat(k,1378) = 0._r8 mat(k,1379) = 0._r8 - mat(k,1380) = 0._r8 mat(k,1381) = 0._r8 - mat(k,1382) = 0._r8 - mat(k,1383) = 0._r8 - mat(k,1394) = 0._r8 - mat(k,1401) = 0._r8 - mat(k,1413) = 0._r8 - mat(k,1422) = 0._r8 + mat(k,1384) = 0._r8 + mat(k,1387) = 0._r8 + mat(k,1404) = 0._r8 + mat(k,1410) = 0._r8 + mat(k,1411) = 0._r8 + mat(k,1414) = 0._r8 + mat(k,1417) = 0._r8 + mat(k,1420) = 0._r8 + mat(k,1423) = 0._r8 mat(k,1424) = 0._r8 - mat(k,1425) = 0._r8 - mat(k,1430) = 0._r8 - mat(k,1437) = 0._r8 - mat(k,1440) = 0._r8 - mat(k,1443) = 0._r8 + mat(k,1426) = 0._r8 + mat(k,1427) = 0._r8 + mat(k,1428) = 0._r8 + mat(k,1433) = 0._r8 + mat(k,1447) = 0._r8 mat(k,1453) = 0._r8 - mat(k,1455) = 0._r8 - mat(k,1458) = 0._r8 + mat(k,1454) = 0._r8 + mat(k,1457) = 0._r8 + mat(k,1459) = 0._r8 mat(k,1463) = 0._r8 - mat(k,1464) = 0._r8 mat(k,1466) = 0._r8 mat(k,1467) = 0._r8 - mat(k,1472) = 0._r8 - mat(k,1474) = 0._r8 - mat(k,1477) = 0._r8 - mat(k,1478) = 0._r8 - mat(k,1479) = 0._r8 - mat(k,1482) = 0._r8 + mat(k,1469) = 0._r8 + mat(k,1470) = 0._r8 + mat(k,1471) = 0._r8 + mat(k,1484) = 0._r8 mat(k,1485) = 0._r8 - mat(k,1494) = 0._r8 + mat(k,1486) = 0._r8 + mat(k,1487) = 0._r8 + mat(k,1495) = 0._r8 + mat(k,1496) = 0._r8 mat(k,1497) = 0._r8 + mat(k,1498) = 0._r8 + mat(k,1499) = 0._r8 + mat(k,1502) = 0._r8 + mat(k,1504) = 0._r8 mat(k,1505) = 0._r8 - mat(k,1507) = 0._r8 mat(k,1508) = 0._r8 + mat(k,1509) = 0._r8 mat(k,1510) = 0._r8 + mat(k,1511) = 0._r8 mat(k,1513) = 0._r8 - mat(k,1514) = 0._r8 - mat(k,1520) = 0._r8 - mat(k,1521) = 0._r8 + mat(k,1516) = 0._r8 mat(k,1523) = 0._r8 - mat(k,1525) = 0._r8 - mat(k,1535) = 0._r8 - mat(k,1539) = 0._r8 - mat(k,1544) = 0._r8 - mat(k,1548) = 0._r8 - mat(k,1551) = 0._r8 - mat(k,1552) = 0._r8 - mat(k,1555) = 0._r8 - mat(k,1559) = 0._r8 - mat(k,1563) = 0._r8 - mat(k,1566) = 0._r8 + mat(k,1530) = 0._r8 + mat(k,1531) = 0._r8 + mat(k,1533) = 0._r8 + mat(k,1550) = 0._r8 + mat(k,1573) = 0._r8 + mat(k,1580) = 0._r8 + mat(k,1583) = 0._r8 mat(k,1584) = 0._r8 - mat(k,1588) = 0._r8 - mat(k,1589) = 0._r8 + mat(k,1585) = 0._r8 + mat(k,1586) = 0._r8 mat(k,1591) = 0._r8 - mat(k,1592) = 0._r8 + mat(k,1593) = 0._r8 mat(k,1595) = 0._r8 - mat(k,1599) = 0._r8 - mat(k,1602) = 0._r8 - mat(k,1605) = 0._r8 - mat(k,1606) = 0._r8 - mat(k,1608) = 0._r8 - mat(k,1615) = 0._r8 + mat(k,1596) = 0._r8 + mat(k,1597) = 0._r8 + mat(k,1604) = 0._r8 + mat(k,1610) = 0._r8 + mat(k,1612) = 0._r8 + mat(k,1613) = 0._r8 + mat(k,1617) = 0._r8 mat(k,1618) = 0._r8 - mat(k,1620) = 0._r8 - mat(k,1621) = 0._r8 - mat(k,1623) = 0._r8 - mat(k,1624) = 0._r8 mat(k,1625) = 0._r8 + mat(k,1627) = 0._r8 mat(k,1628) = 0._r8 - mat(k,1629) = 0._r8 - mat(k,1630) = 0._r8 mat(k,1631) = 0._r8 + mat(k,1632) = 0._r8 + mat(k,1633) = 0._r8 mat(k,1634) = 0._r8 - mat(k,1636) = 0._r8 - mat(k,1638) = 0._r8 + mat(k,1635) = 0._r8 + mat(k,1637) = 0._r8 mat(k,1639) = 0._r8 - mat(k,1644) = 0._r8 - mat(k,1647) = 0._r8 - mat(k,1648) = 0._r8 - mat(k,1651) = 0._r8 - mat(k,1655) = 0._r8 - mat(k,1656) = 0._r8 - mat(k,1658) = 0._r8 - mat(k,1659) = 0._r8 - mat(k,1660) = 0._r8 - mat(k,1665) = 0._r8 - mat(k,1666) = 0._r8 + mat(k,1664) = 0._r8 + mat(k,1670) = 0._r8 mat(k,1671) = 0._r8 mat(k,1674) = 0._r8 - mat(k,1693) = 0._r8 - mat(k,1697) = 0._r8 - mat(k,1698) = 0._r8 - mat(k,1701) = 0._r8 - mat(k,1704) = 0._r8 - mat(k,1708) = 0._r8 - mat(k,1711) = 0._r8 + mat(k,1680) = 0._r8 + mat(k,1683) = 0._r8 + mat(k,1684) = 0._r8 + mat(k,1686) = 0._r8 + mat(k,1687) = 0._r8 + mat(k,1688) = 0._r8 + mat(k,1700) = 0._r8 + mat(k,1703) = 0._r8 + mat(k,1713) = 0._r8 mat(k,1714) = 0._r8 - mat(k,1715) = 0._r8 + mat(k,1716) = 0._r8 mat(k,1717) = 0._r8 - mat(k,1733) = 0._r8 - mat(k,1736) = 0._r8 - mat(k,1741) = 0._r8 - mat(k,1742) = 0._r8 - mat(k,1744) = 0._r8 - mat(k,1745) = 0._r8 - mat(k,1748) = 0._r8 + mat(k,1718) = 0._r8 + mat(k,1719) = 0._r8 + mat(k,1720) = 0._r8 + mat(k,1721) = 0._r8 + mat(k,1724) = 0._r8 + mat(k,1728) = 0._r8 + mat(k,1747) = 0._r8 mat(k,1750) = 0._r8 - mat(k,1752) = 0._r8 - mat(k,1756) = 0._r8 + mat(k,1755) = 0._r8 mat(k,1757) = 0._r8 - mat(k,1760) = 0._r8 + mat(k,1758) = 0._r8 + mat(k,1759) = 0._r8 + mat(k,1761) = 0._r8 mat(k,1762) = 0._r8 mat(k,1763) = 0._r8 + mat(k,1764) = 0._r8 mat(k,1767) = 0._r8 - mat(k,1768) = 0._r8 - mat(k,1771) = 0._r8 - mat(k,1776) = 0._r8 - mat(k,1777) = 0._r8 + mat(k,1769) = 0._r8 + mat(k,1775) = 0._r8 mat(k,1778) = 0._r8 - mat(k,1779) = 0._r8 - mat(k,1781) = 0._r8 - mat(k,1785) = 0._r8 - mat(k,1787) = 0._r8 - mat(k,1789) = 0._r8 - mat(k,1792) = 0._r8 - mat(k,1794) = 0._r8 + mat(k,1793) = 0._r8 mat(k,1795) = 0._r8 mat(k,1796) = 0._r8 + mat(k,1798) = 0._r8 + mat(k,1799) = 0._r8 + mat(k,1801) = 0._r8 + mat(k,1802) = 0._r8 + mat(k,1805) = 0._r8 + mat(k,1807) = 0._r8 + mat(k,1808) = 0._r8 + mat(k,1810) = 0._r8 + mat(k,1812) = 0._r8 mat(k,1813) = 0._r8 mat(k,1814) = 0._r8 mat(k,1817) = 0._r8 + mat(k,1818) = 0._r8 mat(k,1820) = 0._r8 - mat(k,1825) = 0._r8 + mat(k,1822) = 0._r8 mat(k,1826) = 0._r8 - mat(k,1830) = 0._r8 + mat(k,1827) = 0._r8 + mat(k,1832) = 0._r8 mat(k,1836) = 0._r8 + mat(k,1838) = 0._r8 mat(k,1839) = 0._r8 mat(k,1840) = 0._r8 mat(k,1841) = 0._r8 - mat(k,1844) = 0._r8 - mat(k,1847) = 0._r8 + mat(k,1843) = 0._r8 + mat(k,1845) = 0._r8 + mat(k,1846) = 0._r8 mat(k,1848) = 0._r8 mat(k,1849) = 0._r8 + mat(k,1851) = 0._r8 + mat(k,1852) = 0._r8 mat(k,1854) = 0._r8 + mat(k,1856) = 0._r8 + mat(k,1862) = 0._r8 + mat(k,1865) = 0._r8 + mat(k,1866) = 0._r8 + mat(k,1869) = 0._r8 + mat(k,1874) = 0._r8 + mat(k,1875) = 0._r8 + mat(k,1876) = 0._r8 + mat(k,1879) = 0._r8 + mat(k,1881) = 0._r8 + mat(k,1882) = 0._r8 + mat(k,1884) = 0._r8 + mat(k,1885) = 0._r8 + mat(k,1887) = 0._r8 + mat(k,1901) = 0._r8 + mat(k,1906) = 0._r8 + mat(k,1913) = 0._r8 + mat(k,1916) = 0._r8 + mat(k,1917) = 0._r8 + mat(k,1918) = 0._r8 + mat(k,1920) = 0._r8 + mat(k,1922) = 0._r8 + mat(k,1923) = 0._r8 + mat(k,1924) = 0._r8 + mat(k,1926) = 0._r8 + mat(k,1928) = 0._r8 + mat(k,1937) = 0._r8 + mat(k,1945) = 0._r8 + mat(k,1946) = 0._r8 + mat(k,1949) = 0._r8 + mat(k,1951) = 0._r8 + mat(k,1952) = 0._r8 + mat(k,1953) = 0._r8 + mat(k,1954) = 0._r8 + mat(k,1956) = 0._r8 + mat(k,1957) = 0._r8 + mat(k,1959) = 0._r8 + mat(k,1960) = 0._r8 + mat(k,1962) = 0._r8 + mat(k,1963) = 0._r8 + mat(k,1964) = 0._r8 + mat(k,1965) = 0._r8 + mat(k,1966) = 0._r8 + mat(k,1969) = 0._r8 + mat(k,1970) = 0._r8 + mat(k,1971) = 0._r8 + mat(k,1972) = 0._r8 + mat(k,1976) = 0._r8 + mat(k,1978) = 0._r8 + mat(k,1979) = 0._r8 + mat(k,1994) = 0._r8 + mat(k,1996) = 0._r8 + mat(k,1999) = 0._r8 + mat(k,2004) = 0._r8 + mat(k,2006) = 0._r8 + mat(k,2007) = 0._r8 + mat(k,2008) = 0._r8 + mat(k,2010) = 0._r8 + mat(k,2012) = 0._r8 + mat(k,2013) = 0._r8 + mat(k,2016) = 0._r8 + mat(k,2018) = 0._r8 + mat(k,2019) = 0._r8 + mat(k,2027) = 0._r8 + mat(k,2042) = 0._r8 + mat(k,2043) = 0._r8 + mat(k,2044) = 0._r8 + mat(k,2046) = 0._r8 + mat(k,2050) = 0._r8 + mat(k,2055) = 0._r8 + mat(k,2056) = 0._r8 + mat(k,2060) = 0._r8 + mat(k,2064) = 0._r8 + mat(k,2065) = 0._r8 + mat(k,2074) = 0._r8 + mat(k,2075) = 0._r8 + mat(k,2077) = 0._r8 + mat(k,2079) = 0._r8 + mat(k,2080) = 0._r8 + mat(k,2084) = 0._r8 + mat(k,2086) = 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) @@ -2951,99 +3342,122 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) 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, 27) = mat(k, 27) - dti(k) mat(k, 30) = mat(k, 30) - dti(k) - mat(k, 32) = mat(k, 32) - dti(k) - mat(k, 36) = mat(k, 36) - dti(k) - mat(k, 39) = mat(k, 39) - dti(k) + mat(k, 34) = mat(k, 34) - dti(k) + mat(k, 38) = mat(k, 38) - dti(k) mat(k, 42) = mat(k, 42) - dti(k) mat(k, 46) = mat(k, 46) - dti(k) mat(k, 50) = mat(k, 50) - dti(k) - mat(k, 54) = mat(k, 54) - dti(k) + mat(k, 53) = mat(k, 53) - dti(k) mat(k, 58) = mat(k, 58) - dti(k) - mat(k, 64) = mat(k, 64) - dti(k) - mat(k, 69) = mat(k, 69) - dti(k) - mat(k, 77) = mat(k, 77) - dti(k) - mat(k, 83) = mat(k, 83) - dti(k) + mat(k, 63) = mat(k, 63) - dti(k) + mat(k, 68) = mat(k, 68) - dti(k) + mat(k, 73) = mat(k, 73) - dti(k) + mat(k, 75) = mat(k, 75) - dti(k) + mat(k, 80) = mat(k, 80) - dti(k) + mat(k, 84) = mat(k, 84) - dti(k) mat(k, 89) = mat(k, 89) - dti(k) + mat(k, 92) = mat(k, 92) - dti(k) mat(k, 95) = mat(k, 95) - dti(k) - mat(k, 101) = mat(k, 101) - dti(k) + mat(k, 100) = mat(k, 100) - dti(k) + mat(k, 104) = mat(k, 104) - dti(k) mat(k, 108) = mat(k, 108) - dti(k) - mat(k, 115) = mat(k, 115) - dti(k) - mat(k, 121) = mat(k, 121) - dti(k) + mat(k, 113) = mat(k, 113) - dti(k) + mat(k, 119) = mat(k, 119) - dti(k) + mat(k, 122) = mat(k, 122) - dti(k) mat(k, 128) = mat(k, 128) - dti(k) - mat(k, 134) = mat(k, 134) - dti(k) - mat(k, 138) = mat(k, 138) - dti(k) - mat(k, 146) = mat(k, 146) - dti(k) - mat(k, 153) = mat(k, 153) - dti(k) - mat(k, 162) = mat(k, 162) - dti(k) - mat(k, 168) = mat(k, 168) - dti(k) - mat(k, 175) = mat(k, 175) - dti(k) - mat(k, 181) = mat(k, 181) - dti(k) - mat(k, 189) = mat(k, 189) - dti(k) - mat(k, 198) = mat(k, 198) - dti(k) - mat(k, 207) = mat(k, 207) - dti(k) - mat(k, 215) = mat(k, 215) - dti(k) - mat(k, 223) = mat(k, 223) - dti(k) - mat(k, 231) = mat(k, 231) - dti(k) - mat(k, 238) = mat(k, 238) - dti(k) - mat(k, 246) = mat(k, 246) - dti(k) - mat(k, 255) = mat(k, 255) - dti(k) - mat(k, 264) = mat(k, 264) - dti(k) - mat(k, 277) = mat(k, 277) - dti(k) - mat(k, 287) = mat(k, 287) - dti(k) + mat(k, 131) = mat(k, 131) - dti(k) + mat(k, 136) = mat(k, 136) - dti(k) + mat(k, 144) = mat(k, 144) - dti(k) + mat(k, 152) = mat(k, 152) - dti(k) + mat(k, 158) = mat(k, 158) - dti(k) + mat(k, 164) = mat(k, 164) - dti(k) + mat(k, 170) = mat(k, 170) - dti(k) + mat(k, 176) = mat(k, 176) - dti(k) + mat(k, 183) = mat(k, 183) - dti(k) + mat(k, 190) = mat(k, 190) - dti(k) + mat(k, 197) = mat(k, 197) - dti(k) + mat(k, 203) = mat(k, 203) - dti(k) + mat(k, 211) = mat(k, 211) - dti(k) + mat(k, 218) = mat(k, 218) - dti(k) + mat(k, 227) = mat(k, 227) - dti(k) + mat(k, 236) = mat(k, 236) - dti(k) + mat(k, 243) = mat(k, 243) - dti(k) + mat(k, 249) = mat(k, 249) - dti(k) + mat(k, 253) = mat(k, 253) - dti(k) + mat(k, 261) = mat(k, 261) - dti(k) + mat(k, 268) = mat(k, 268) - dti(k) + mat(k, 275) = mat(k, 275) - dti(k) + mat(k, 281) = mat(k, 281) - dti(k) + mat(k, 289) = mat(k, 289) - dti(k) mat(k, 297) = mat(k, 297) - dti(k) - mat(k, 311) = mat(k, 311) - dti(k) - mat(k, 324) = mat(k, 324) - dti(k) - mat(k, 335) = mat(k, 335) - dti(k) - mat(k, 350) = mat(k, 350) - dti(k) - mat(k, 362) = mat(k, 362) - dti(k) - mat(k, 379) = mat(k, 379) - dti(k) - mat(k, 393) = mat(k, 393) - dti(k) - mat(k, 409) = mat(k, 409) - dti(k) - mat(k, 424) = mat(k, 424) - dti(k) - mat(k, 438) = mat(k, 438) - dti(k) - mat(k, 454) = mat(k, 454) - dti(k) - mat(k, 465) = mat(k, 465) - dti(k) - mat(k, 484) = mat(k, 484) - dti(k) - mat(k, 503) = mat(k, 503) - dti(k) - mat(k, 519) = mat(k, 519) - dti(k) - mat(k, 539) = mat(k, 539) - dti(k) - mat(k, 560) = mat(k, 560) - dti(k) - mat(k, 584) = mat(k, 584) - dti(k) + mat(k, 306) = mat(k, 306) - dti(k) + mat(k, 314) = mat(k, 314) - dti(k) + mat(k, 322) = mat(k, 322) - dti(k) + mat(k, 329) = mat(k, 329) - dti(k) + mat(k, 338) = mat(k, 338) - dti(k) + mat(k, 348) = mat(k, 348) - dti(k) + mat(k, 356) = mat(k, 356) - dti(k) + mat(k, 366) = mat(k, 366) - dti(k) + mat(k, 374) = mat(k, 374) - dti(k) + mat(k, 385) = mat(k, 385) - dti(k) + mat(k, 398) = mat(k, 398) - dti(k) + mat(k, 413) = mat(k, 413) - dti(k) + mat(k, 429) = mat(k, 429) - dti(k) + mat(k, 443) = mat(k, 443) - dti(k) + mat(k, 458) = mat(k, 458) - dti(k) + mat(k, 470) = mat(k, 470) - dti(k) + mat(k, 487) = mat(k, 487) - dti(k) + mat(k, 501) = mat(k, 501) - dti(k) + mat(k, 516) = mat(k, 516) - dti(k) + mat(k, 532) = mat(k, 532) - dti(k) + mat(k, 547) = mat(k, 547) - dti(k) + mat(k, 561) = mat(k, 561) - dti(k) + mat(k, 579) = mat(k, 579) - dti(k) + mat(k, 591) = mat(k, 591) - dti(k) mat(k, 606) = mat(k, 606) - dti(k) - mat(k, 637) = mat(k, 637) - dti(k) - mat(k, 660) = mat(k, 660) - dti(k) - mat(k, 690) = mat(k, 690) - dti(k) - mat(k, 713) = mat(k, 713) - dti(k) - mat(k, 747) = mat(k, 747) - dti(k) - mat(k, 794) = mat(k, 794) - dti(k) - mat(k, 822) = mat(k, 822) - dti(k) - mat(k, 852) = mat(k, 852) - dti(k) - mat(k, 900) = mat(k, 900) - dti(k) - mat(k, 943) = mat(k, 943) - dti(k) - mat(k, 990) = mat(k, 990) - dti(k) - mat(k,1033) = mat(k,1033) - dti(k) - mat(k,1075) = mat(k,1075) - dti(k) - mat(k,1115) = mat(k,1115) - dti(k) - mat(k,1160) = mat(k,1160) - dti(k) - mat(k,1202) = mat(k,1202) - dti(k) - mat(k,1252) = mat(k,1252) - dti(k) + mat(k, 622) = mat(k, 622) - dti(k) + mat(k, 644) = mat(k, 644) - dti(k) + mat(k, 666) = mat(k, 666) - dti(k) + mat(k, 688) = mat(k, 688) - dti(k) + mat(k, 712) = mat(k, 712) - dti(k) + mat(k, 735) = mat(k, 735) - dti(k) + mat(k, 784) = mat(k, 784) - dti(k) + mat(k, 808) = mat(k, 808) - dti(k) + mat(k, 830) = mat(k, 830) - dti(k) + mat(k, 863) = mat(k, 863) - dti(k) + mat(k, 897) = mat(k, 897) - dti(k) + mat(k, 923) = mat(k, 923) - dti(k) + mat(k, 981) = mat(k, 981) - dti(k) + mat(k,1011) = mat(k,1011) - dti(k) + mat(k,1055) = mat(k,1055) - dti(k) + mat(k,1096) = mat(k,1096) - dti(k) + mat(k,1145) = mat(k,1145) - dti(k) + mat(k,1189) = mat(k,1189) - dti(k) + mat(k,1231) = mat(k,1231) - dti(k) mat(k,1292) = mat(k,1292) - dti(k) - mat(k,1328) = mat(k,1328) - dti(k) - mat(k,1373) = mat(k,1373) - dti(k) - mat(k,1433) = mat(k,1433) - dti(k) - mat(k,1476) = mat(k,1476) - dti(k) - mat(k,1518) = mat(k,1518) - dti(k) - mat(k,1561) = mat(k,1561) - dti(k) - mat(k,1604) = mat(k,1604) - dti(k) - mat(k,1637) = mat(k,1637) - dti(k) - mat(k,1673) = mat(k,1673) - dti(k) - mat(k,1716) = mat(k,1716) - dti(k) - mat(k,1761) = mat(k,1761) - dti(k) - mat(k,1797) = mat(k,1797) - dti(k) - mat(k,1856) = mat(k,1856) - dti(k) + mat(k,1335) = mat(k,1335) - dti(k) + mat(k,1372) = mat(k,1372) - dti(k) + mat(k,1416) = mat(k,1416) - dti(k) + mat(k,1460) = mat(k,1460) - dti(k) + mat(k,1506) = mat(k,1506) - dti(k) + mat(k,1543) = mat(k,1543) - dti(k) + mat(k,1589) = mat(k,1589) - dti(k) + mat(k,1638) = mat(k,1638) - dti(k) + mat(k,1682) = mat(k,1682) - dti(k) + mat(k,1725) = mat(k,1725) - dti(k) + mat(k,1771) = mat(k,1771) - dti(k) + mat(k,1821) = mat(k,1821) - dti(k) + mat(k,1855) = mat(k,1855) - dti(k) + mat(k,1892) = mat(k,1892) - dti(k) + mat(k,1934) = mat(k,1934) - dti(k) + mat(k,1977) = mat(k,1977) - dti(k) + mat(k,2026) = mat(k,2026) - dti(k) + mat(k,2087) = mat(k,2087) - dti(k) end do end subroutine nlnmat_finit subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) @@ -3066,6 +3480,8 @@ subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) call nlnmat06( avec_len, mat, y, rxt ) call nlnmat07( avec_len, mat, y, rxt ) call nlnmat08( avec_len, mat, y, rxt ) + call nlnmat09( avec_len, mat, y, rxt ) + call nlnmat10( 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_waccm_mad_mam4/mo_prod_loss.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_prod_loss.F90 index 0c07fd1e43..ab533d3264 100644 --- a/src/chemistry/pp_waccm_mad_mam4/mo_prod_loss.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/mo_prod_loss.F90 @@ -19,74 +19,6 @@ subroutine exp_prod_loss( ofl, ofu, prod, loss, y, & 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,6))* y(k,6) - prod(k,1) = 0._r8 - loss(k,2) = (rxt(k,475)* y(k,122) + rxt(k,31) + het_rates(k,7))* y(k,7) - prod(k,2) = 0._r8 - loss(k,3) = (rxt(k,476)* y(k,122) + rxt(k,32) + het_rates(k,8))* y(k,8) - prod(k,3) = 0._r8 - loss(k,4) = (rxt(k,502)* y(k,122) + rxt(k,33) + het_rates(k,9))* y(k,9) - prod(k,4) = 0._r8 - loss(k,5) = (rxt(k,477)* y(k,122) + rxt(k,34) + het_rates(k,10))* y(k,10) - prod(k,5) = 0._r8 - loss(k,6) = (rxt(k,478)* y(k,122) + rxt(k,35) + het_rates(k,11))* y(k,11) - prod(k,6) = 0._r8 - loss(k,7) = (rxt(k,479)* y(k,122) + rxt(k,36) + het_rates(k,12))* y(k,12) - prod(k,7) = 0._r8 - loss(k,8) = (rxt(k,480)* y(k,122) + rxt(k,37) + het_rates(k,13))* y(k,13) - prod(k,8) = 0._r8 - loss(k,9) = (rxt(k,481)* y(k,122) + rxt(k,38) + het_rates(k,14))* y(k,14) - prod(k,9) = 0._r8 - loss(k,10) = (rxt(k,513)* y(k,86) +rxt(k,525)* y(k,122) +rxt(k,514)* y(k,131) & - + rxt(k,39) + het_rates(k,15))* y(k,15) - prod(k,10) = 0._r8 - loss(k,11) = (rxt(k,515)* y(k,86) +rxt(k,526)* y(k,122) +rxt(k,516)* y(k,131) & - + rxt(k,40) + het_rates(k,17))* y(k,17) - prod(k,11) = 0._r8 - loss(k,12) = (rxt(k,517)* y(k,131) + rxt(k,41) + het_rates(k,18))* y(k,18) - prod(k,12) = 0._r8 - loss(k,13) = (rxt(k,518)* y(k,86) +rxt(k,519)* y(k,131) + rxt(k,42) & - + het_rates(k,19))* y(k,19) - prod(k,13) = 0._r8 - loss(k,14) = (rxt(k,507)* y(k,37) +rxt(k,451)* y(k,86) + (rxt(k,538) + & - rxt(k,539) +rxt(k,540))* y(k,122) +rxt(k,536)* y(k,131) + rxt(k,24) & - + rxt(k,25) + het_rates(k,22))* y(k,22) - prod(k,14) = 0._r8 - loss(k,15) = (rxt(k,520)* y(k,86) +rxt(k,503)* y(k,122) +rxt(k,521)* y(k,131) & - + rxt(k,43) + het_rates(k,23))* y(k,23) - prod(k,15) = 0._r8 - loss(k,16) = ( + het_rates(k,28))* y(k,28) - prod(k,16) = 0._r8 - loss(k,17) = (rxt(k,368)* y(k,115) +rxt(k,312)* y(k,120) +rxt(k,316) & - * y(k,125) +rxt(k,330)* y(k,128) +rxt(k,335)* y(k,129) +rxt(k,343) & - * y(k,132) +rxt(k,352)* y(k,133) +rxt(k,595)* y(k,134) + rxt(k,26) & - + rxt(k,62) + het_rates(k,30))* y(k,30) - prod(k,17) =.440_r8*rxt(k,25)*y(k,22) - loss(k,18) = (rxt(k,504)* y(k,122) + rxt(k,51) + het_rates(k,40))* y(k,40) - prod(k,18) = 0._r8 - loss(k,19) = (rxt(k,527)* y(k,122) +rxt(k,522)* y(k,131) + rxt(k,53) & - + het_rates(k,44))* y(k,44) - prod(k,19) = 0._r8 - loss(k,20) = (rxt(k,528)* y(k,122) +rxt(k,523)* y(k,131) + rxt(k,54) & - + het_rates(k,45))* y(k,45) - prod(k,20) = 0._r8 - loss(k,21) = (rxt(k,529)* y(k,122) +rxt(k,524)* y(k,131) + rxt(k,55) & - + het_rates(k,46))* y(k,46) - prod(k,21) = 0._r8 - loss(k,22) = ((rxt(k,442) +rxt(k,443))* y(k,122) + rxt(k,13) & - + het_rates(k,55))* y(k,55) - prod(k,22) = 0._r8 - loss(k,23) = ( + rxt(k,61) + het_rates(k,75))* y(k,75) - prod(k,23) = 0._r8 - end do end subroutine exp_prod_loss subroutine imp_prod_loss( avec_len, prod, loss, y, & rxt, het_rates ) @@ -114,915 +46,1012 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & prod(k,1) = 0._r8 loss(k,2) = ( + het_rates(k,2))* y(k,2) prod(k,2) = 0._r8 - loss(k,27) = ( + rxt(k,27) + het_rates(k,3))* y(k,3) - prod(k,27) = (rxt(k,571)*y(k,51) +rxt(k,576)*y(k,51))*y(k,47) & - +rxt(k,492)*y(k,26)*y(k,4) - loss(k,82) = (2._r8*rxt(k,489)* y(k,4) + (rxt(k,490) +rxt(k,491) +rxt(k,492)) & - * y(k,26) +rxt(k,494)* y(k,60) +rxt(k,495)* y(k,61) +rxt(k,497) & - * y(k,67) +rxt(k,546)* y(k,76) +rxt(k,493)* y(k,98) +rxt(k,498) & - * y(k,131) + rxt(k,28) + het_rates(k,4))* y(k,4) - prod(k,82) = (rxt(k,29) +rxt(k,496)*y(k,67))*y(k,5) +rxt(k,506)*y(k,122) & - *y(k,43) +rxt(k,501)*y(k,67)*y(k,51) +rxt(k,488)*y(k,85)*y(k,69) - loss(k,45) = (rxt(k,496)* y(k,67) + rxt(k,29) + rxt(k,30) + rxt(k,565) & - + rxt(k,568) + rxt(k,573) + het_rates(k,5))* y(k,5) - prod(k,45) =rxt(k,495)*y(k,61)*y(k,4) - loss(k,83) = (rxt(k,530)* y(k,62) +rxt(k,531)* y(k,67) +rxt(k,486)* y(k,85) & - +rxt(k,450)* y(k,86) +rxt(k,532)* y(k,131) + rxt(k,21) + rxt(k,22) & - + het_rates(k,16))* y(k,16) - prod(k,83) = (rxt(k,457)*y(k,26) +rxt(k,534)*y(k,60))*y(k,20) + (rxt(k,23) + & - .300_r8*rxt(k,535)*y(k,131))*y(k,21) + (rxt(k,539)*y(k,122) + & - rxt(k,540)*y(k,122))*y(k,22) - loss(k,66) = (rxt(k,457)* y(k,26) +rxt(k,534)* y(k,60) +rxt(k,533)* y(k,98) & + loss(k,97) = (rxt(k,486)* y(k,17) +rxt(k,488)* y(k,72) +rxt(k,487)* y(k,99) & + + het_rates(k,3))* y(k,3) + prod(k,97) = (rxt(k,28) +2.000_r8*rxt(k,489)*y(k,5) +rxt(k,490)*y(k,28) + & + rxt(k,491)*y(k,28) +rxt(k,494)*y(k,62) +rxt(k,497)*y(k,69) + & + rxt(k,498)*y(k,131) +rxt(k,548)*y(k,79))*y(k,5) & + + (rxt(k,476)*y(k,9) +rxt(k,502)*y(k,10) + & + 3.000_r8*rxt(k,503)*y(k,24) +2.000_r8*rxt(k,504)*y(k,42) + & + rxt(k,505)*y(k,45) +2.000_r8*rxt(k,525)*y(k,16) +rxt(k,526)*y(k,18)) & + *y(k,70) + (rxt(k,500)*y(k,45) +2.000_r8*rxt(k,514)*y(k,16) + & + rxt(k,516)*y(k,18) +3.000_r8*rxt(k,521)*y(k,24))*y(k,131) & + + (2.000_r8*rxt(k,513)*y(k,16) +rxt(k,515)*y(k,18) + & + 3.000_r8*rxt(k,520)*y(k,24))*y(k,25) + (rxt(k,52) + & + rxt(k,499)*y(k,69))*y(k,45) +rxt(k,27)*y(k,4) +rxt(k,30)*y(k,6) & + +rxt(k,32)*y(k,9) +rxt(k,33)*y(k,10) +2.000_r8*rxt(k,39)*y(k,16) & + +rxt(k,40)*y(k,18) +3.000_r8*rxt(k,43)*y(k,24) +2.000_r8*rxt(k,51) & + *y(k,42) +rxt(k,58)*y(k,53) + loss(k,41) = ( + rxt(k,27) + het_rates(k,4))* y(k,4) + prod(k,41) = (rxt(k,570)*y(k,53) +rxt(k,575)*y(k,53))*y(k,49) & + +rxt(k,492)*y(k,28)*y(k,5) + loss(k,104) = (2._r8*rxt(k,489)* y(k,5) + (rxt(k,490) +rxt(k,491) + & + rxt(k,492))* y(k,28) +rxt(k,494)* y(k,62) +rxt(k,495)* y(k,63) & + +rxt(k,497)* y(k,69) +rxt(k,548)* y(k,79) +rxt(k,493)* y(k,99) & + +rxt(k,498)* y(k,131) + rxt(k,28) + het_rates(k,5))* y(k,5) + prod(k,104) = (rxt(k,29) +rxt(k,496)*y(k,69))*y(k,6) +rxt(k,488)*y(k,72) & + *y(k,3) +rxt(k,506)*y(k,70)*y(k,45) +rxt(k,501)*y(k,69)*y(k,53) + loss(k,61) = (rxt(k,496)* y(k,69) + rxt(k,29) + rxt(k,30) + rxt(k,564) & + + rxt(k,567) + rxt(k,572) + het_rates(k,6))* y(k,6) + prod(k,61) =rxt(k,495)*y(k,63)*y(k,5) + loss(k,3) = ( + het_rates(k,7))* y(k,7) + prod(k,3) = 0._r8 + loss(k,25) = (rxt(k,475)* y(k,70) + rxt(k,31) + het_rates(k,8))* y(k,8) + prod(k,25) = 0._r8 + loss(k,32) = (rxt(k,476)* y(k,70) + rxt(k,32) + het_rates(k,9))* y(k,9) + prod(k,32) = 0._r8 + loss(k,33) = (rxt(k,502)* y(k,70) + rxt(k,33) + het_rates(k,10))* y(k,10) + prod(k,33) = 0._r8 + loss(k,27) = (rxt(k,477)* y(k,70) + rxt(k,34) + het_rates(k,11))* y(k,11) + prod(k,27) = 0._r8 + loss(k,34) = (rxt(k,478)* y(k,70) + rxt(k,35) + het_rates(k,12))* y(k,12) + prod(k,34) = 0._r8 + loss(k,28) = (rxt(k,479)* y(k,70) + rxt(k,36) + het_rates(k,13))* y(k,13) + prod(k,28) = 0._r8 + loss(k,35) = (rxt(k,480)* y(k,70) + rxt(k,37) + het_rates(k,14))* y(k,14) + prod(k,35) = 0._r8 + loss(k,29) = (rxt(k,481)* y(k,70) + rxt(k,38) + het_rates(k,15))* y(k,15) + prod(k,29) = 0._r8 + loss(k,57) = (rxt(k,513)* y(k,25) +rxt(k,525)* y(k,70) +rxt(k,514)* y(k,131) & + + rxt(k,39) + het_rates(k,16))* y(k,16) + prod(k,57) = 0._r8 + loss(k,105) = (rxt(k,486)* y(k,3) +rxt(k,450)* y(k,25) +rxt(k,530)* y(k,64) & + +rxt(k,531)* y(k,69) +rxt(k,532)* y(k,131) + rxt(k,21) + rxt(k,22) & + + het_rates(k,17))* y(k,17) + prod(k,105) = (.180_r8*rxt(k,25) +rxt(k,538)*y(k,70) +rxt(k,539)*y(k,70)) & + *y(k,23) + (rxt(k,457)*y(k,28) +rxt(k,534)*y(k,62))*y(k,21) & + + (rxt(k,23) +.300_r8*rxt(k,535)*y(k,131))*y(k,22) + loss(k,63) = (rxt(k,515)* y(k,25) +rxt(k,526)* y(k,70) +rxt(k,516)* y(k,131) & + + rxt(k,40) + het_rates(k,18))* y(k,18) + prod(k,63) = 0._r8 + loss(k,30) = (rxt(k,517)* y(k,131) + rxt(k,41) + het_rates(k,19))* y(k,19) + prod(k,30) = 0._r8 + loss(k,52) = (rxt(k,518)* y(k,25) +rxt(k,519)* y(k,131) + rxt(k,42) & + het_rates(k,20))* y(k,20) - prod(k,66) = (rxt(k,451)*y(k,86) +rxt(k,507)*y(k,37) +rxt(k,536)*y(k,131) + & - rxt(k,538)*y(k,122))*y(k,22) +.700_r8*rxt(k,535)*y(k,131)*y(k,21) - loss(k,35) = (rxt(k,535)* y(k,131) + rxt(k,23) + het_rates(k,21))* y(k,21) - prod(k,35) =rxt(k,533)*y(k,98)*y(k,20) - loss(k,24) = ( + rxt(k,44) + het_rates(k,24))* y(k,24) - prod(k,24) = (rxt(k,564)*y(k,52) +rxt(k,569)*y(k,27) +rxt(k,570)*y(k,52) + & - rxt(k,574)*y(k,27) +rxt(k,575)*y(k,52) +rxt(k,579)*y(k,27))*y(k,47) & - +rxt(k,459)*y(k,26)*y(k,26) +rxt(k,463)*y(k,86)*y(k,27) - loss(k,21) = ( + rxt(k,45) + rxt(k,485) + het_rates(k,25))* y(k,25) - prod(k,21) =rxt(k,484)*y(k,26)*y(k,26) - loss(k,112) = ((rxt(k,490) +rxt(k,491) +rxt(k,492))* y(k,4) +rxt(k,457) & - * y(k,20) + 2._r8*(rxt(k,458) +rxt(k,459) +rxt(k,460) +rxt(k,484)) & - * y(k,26) +rxt(k,462)* y(k,60) +rxt(k,464)* y(k,61) +rxt(k,467) & - * y(k,67) +rxt(k,547)* y(k,76) +rxt(k,116)* y(k,91) +rxt(k,128) & - * y(k,94) +rxt(k,461)* y(k,98) +rxt(k,286)* y(k,108) +rxt(k,315) & + prod(k,52) = 0._r8 + loss(k,87) = (rxt(k,457)* y(k,28) +rxt(k,534)* y(k,62) +rxt(k,533)* y(k,99) & + + het_rates(k,21))* y(k,21) + prod(k,87) = (rxt(k,24) +rxt(k,451)*y(k,25) +rxt(k,507)*y(k,39) + & + rxt(k,536)*y(k,131) +rxt(k,537)*y(k,70))*y(k,23) +rxt(k,40)*y(k,18) & + +rxt(k,42)*y(k,20) +.700_r8*rxt(k,535)*y(k,131)*y(k,22) + loss(k,54) = (rxt(k,535)* y(k,131) + rxt(k,23) + het_rates(k,22))* y(k,22) + prod(k,54) =rxt(k,533)*y(k,99)*y(k,21) + loss(k,86) = (rxt(k,451)* y(k,25) +rxt(k,507)* y(k,39) + (rxt(k,537) + & + rxt(k,538) +rxt(k,539))* y(k,70) +rxt(k,536)* y(k,131) + rxt(k,24) & + + rxt(k,25) + het_rates(k,23))* y(k,23) + prod(k,86) = 0._r8 + loss(k,53) = (rxt(k,520)* y(k,25) +rxt(k,503)* y(k,70) +rxt(k,521)* y(k,131) & + + rxt(k,43) + het_rates(k,24))* y(k,24) + prod(k,53) = 0._r8 + loss(k,136) = (rxt(k,513)* y(k,16) +rxt(k,450)* y(k,17) +rxt(k,515)* y(k,18) & + +rxt(k,518)* y(k,20) +rxt(k,451)* y(k,23) +rxt(k,520)* y(k,24) & + +rxt(k,463)* y(k,29) +rxt(k,452)* y(k,41) +rxt(k,453)* y(k,43) & + +rxt(k,472)* y(k,54) +rxt(k,456)* y(k,72) + (rxt(k,114) +rxt(k,115)) & + * y(k,92) +rxt(k,127)* y(k,95) + (rxt(k,454) +rxt(k,455))* y(k,99) & + +rxt(k,285)* y(k,109) +rxt(k,314)* y(k,125) +rxt(k,341)* y(k,132) & + +rxt(k,350)* y(k,133) + het_rates(k,25))* y(k,25) + prod(k,136) = (4.000_r8*rxt(k,475)*y(k,8) +rxt(k,476)*y(k,9) + & + 2.000_r8*rxt(k,477)*y(k,11) +2.000_r8*rxt(k,478)*y(k,12) + & + 2.000_r8*rxt(k,479)*y(k,13) +rxt(k,480)*y(k,14) + & + 2.000_r8*rxt(k,481)*y(k,15) +rxt(k,482)*y(k,49) +rxt(k,512)*y(k,34) + & + rxt(k,527)*y(k,46) +rxt(k,528)*y(k,47) +rxt(k,529)*y(k,48))*y(k,70) & + + (rxt(k,46) +rxt(k,457)*y(k,21) +2.000_r8*rxt(k,458)*y(k,28) + & + rxt(k,460)*y(k,28) +rxt(k,462)*y(k,62) +rxt(k,467)*y(k,69) + & + rxt(k,468)*y(k,131) +rxt(k,491)*y(k,5) +rxt(k,549)*y(k,79))*y(k,28) & + + (rxt(k,110)*y(k,63) +rxt(k,147)*y(k,103) +rxt(k,154)*y(k,126) + & + rxt(k,177)*y(k,105) +rxt(k,195)*y(k,101) +rxt(k,212)*y(k,120) + & + rxt(k,230)*y(k,117) +rxt(k,248)*y(k,116))*y(k,88) & + + (rxt(k,159)*y(k,126) +rxt(k,164)*y(k,103) +rxt(k,182)*y(k,105) + & + rxt(k,199)*y(k,101) +rxt(k,217)*y(k,120) +rxt(k,234)*y(k,117) + & + rxt(k,252)*y(k,116))*y(k,89) + (rxt(k,169)*y(k,105) + & + rxt(k,181)*y(k,103) +rxt(k,187)*y(k,101) +rxt(k,205)*y(k,120) + & + rxt(k,222)*y(k,117) +rxt(k,240)*y(k,116) +rxt(k,257)*y(k,126)) & + *y(k,90) + (rxt(k,471)*y(k,49) +3.000_r8*rxt(k,517)*y(k,19) + & + rxt(k,519)*y(k,20) +rxt(k,522)*y(k,46) +rxt(k,523)*y(k,47) + & + rxt(k,524)*y(k,48))*y(k,131) + (rxt(k,56) +rxt(k,470)*y(k,69)) & + *y(k,49) +rxt(k,27)*y(k,4) +4.000_r8*rxt(k,31)*y(k,8) +rxt(k,32) & + *y(k,9) +2.000_r8*rxt(k,34)*y(k,11) +2.000_r8*rxt(k,35)*y(k,12) & + +2.000_r8*rxt(k,36)*y(k,13) +rxt(k,37)*y(k,14) +2.000_r8*rxt(k,38) & + *y(k,15) +3.000_r8*rxt(k,41)*y(k,19) +rxt(k,42)*y(k,20) & + +2.000_r8*rxt(k,44)*y(k,26) +2.000_r8*rxt(k,45)*y(k,27) +rxt(k,47) & + *y(k,29) +rxt(k,50)*y(k,34) +rxt(k,53)*y(k,46) +rxt(k,54)*y(k,47) & + +rxt(k,55)*y(k,48) +rxt(k,59)*y(k,54) +rxt(k,111)*y(k,91)*y(k,62) + loss(k,36) = ( + rxt(k,44) + het_rates(k,26))* y(k,26) + prod(k,36) = (rxt(k,563)*y(k,54) +rxt(k,568)*y(k,29) +rxt(k,569)*y(k,54) + & + rxt(k,573)*y(k,29) +rxt(k,574)*y(k,54) +rxt(k,578)*y(k,29))*y(k,49) & + +rxt(k,463)*y(k,29)*y(k,25) +rxt(k,459)*y(k,28)*y(k,28) + loss(k,24) = ( + rxt(k,45) + rxt(k,485) + het_rates(k,27))* y(k,27) + prod(k,24) =rxt(k,484)*y(k,28)*y(k,28) + loss(k,130) = ((rxt(k,490) +rxt(k,491) +rxt(k,492))* y(k,5) +rxt(k,457) & + * y(k,21) + 2._r8*(rxt(k,458) +rxt(k,459) +rxt(k,460) +rxt(k,484)) & + * y(k,28) +rxt(k,462)* y(k,62) +rxt(k,464)* y(k,63) +rxt(k,467) & + * y(k,69) +rxt(k,549)* y(k,79) +rxt(k,116)* y(k,92) +rxt(k,128) & + * y(k,95) +rxt(k,461)* y(k,99) +rxt(k,286)* y(k,109) +rxt(k,315) & * y(k,125) + (rxt(k,468) +rxt(k,469))* y(k,131) +rxt(k,342)* y(k,132) & - +rxt(k,351)* y(k,133) + rxt(k,46) + het_rates(k,26))* y(k,26) - prod(k,112) = (rxt(k,472)*y(k,86) +rxt(k,473)*y(k,67) +rxt(k,474)*y(k,131)) & - *y(k,52) + (rxt(k,48) +rxt(k,465)*y(k,67))*y(k,27) + (rxt(k,60) + & - rxt(k,552)*y(k,76))*y(k,70) + (rxt(k,455)*y(k,98) + & - rxt(k,456)*y(k,69))*y(k,86) +2.000_r8*rxt(k,485)*y(k,25) & - +rxt(k,483)*y(k,122)*y(k,47) - loss(k,62) = ((rxt(k,569) +rxt(k,574) +rxt(k,579))* y(k,47) +rxt(k,465) & - * y(k,67) +rxt(k,463)* y(k,86) +rxt(k,466)* y(k,131) + rxt(k,47) & - + rxt(k,48) + rxt(k,567) + rxt(k,572) + rxt(k,578) & - + het_rates(k,27))* y(k,27) - prod(k,62) =rxt(k,464)*y(k,61)*y(k,26) - loss(k,44) = ((rxt(k,537) +rxt(k,541))* y(k,131) + het_rates(k,29))* y(k,29) - prod(k,44) = (rxt(k,21) +rxt(k,22) +rxt(k,450)*y(k,86) +rxt(k,486)*y(k,85) + & - rxt(k,530)*y(k,62) +rxt(k,531)*y(k,67) +rxt(k,532)*y(k,131))*y(k,16) & - + (rxt(k,101) +rxt(k,542)*y(k,67) +rxt(k,543)*y(k,131))*y(k,71) & - +rxt(k,518)*y(k,86)*y(k,19) +rxt(k,595)*y(k,134)*y(k,30) - loss(k,23) = (rxt(k,511)* y(k,122) + rxt(k,49) + het_rates(k,31))* y(k,31) - prod(k,23) = (rxt(k,476)*y(k,8) +rxt(k,478)*y(k,11) + & - 2.000_r8*rxt(k,479)*y(k,12) +2.000_r8*rxt(k,480)*y(k,13) + & - rxt(k,481)*y(k,14) +rxt(k,502)*y(k,9) +2.000_r8*rxt(k,504)*y(k,40) + & - rxt(k,528)*y(k,45) +rxt(k,529)*y(k,46))*y(k,122) & - + (rxt(k,523)*y(k,45) +rxt(k,524)*y(k,46))*y(k,131) - loss(k,25) = (rxt(k,512)* y(k,122) + rxt(k,50) + het_rates(k,32))* y(k,32) - prod(k,25) = (rxt(k,477)*y(k,10) +rxt(k,478)*y(k,11) +rxt(k,527)*y(k,44)) & - *y(k,122) +rxt(k,522)*y(k,131)*y(k,44) - loss(k,32) = (rxt(k,556)* y(k,62) + (rxt(k,557) +rxt(k,558))* y(k,131) & - + het_rates(k,33))* y(k,33) - prod(k,32) = 0._r8 - loss(k,3) = ( + het_rates(k,34))* y(k,34) - prod(k,3) = 0._r8 - loss(k,4) = ( + het_rates(k,35))* y(k,35) + +rxt(k,351)* y(k,133) + rxt(k,46) + het_rates(k,28))* y(k,28) + prod(k,130) = (rxt(k,455)*y(k,99) +rxt(k,456)*y(k,72) +rxt(k,472)*y(k,54)) & + *y(k,25) + (rxt(k,48) +rxt(k,465)*y(k,69))*y(k,29) & + + (rxt(k,473)*y(k,69) +rxt(k,474)*y(k,131))*y(k,54) + (rxt(k,60) + & + rxt(k,554)*y(k,79))*y(k,73) +2.000_r8*rxt(k,485)*y(k,27) & + +rxt(k,483)*y(k,70)*y(k,49) + loss(k,81) = (rxt(k,463)* y(k,25) + (rxt(k,568) +rxt(k,573) +rxt(k,578)) & + * y(k,49) +rxt(k,465)* y(k,69) +rxt(k,466)* y(k,131) + rxt(k,47) & + + rxt(k,48) + rxt(k,566) + rxt(k,571) + rxt(k,577) & + + het_rates(k,29))* y(k,29) + prod(k,81) =rxt(k,464)*y(k,63)*y(k,28) + loss(k,4) = ( + het_rates(k,30))* y(k,30) prod(k,4) = 0._r8 + loss(k,67) = (rxt(k,540)* y(k,131) + het_rates(k,31))* y(k,31) + prod(k,67) = (rxt(k,21) +rxt(k,22) +rxt(k,450)*y(k,25) +rxt(k,486)*y(k,3) + & + rxt(k,530)*y(k,64) +rxt(k,531)*y(k,69) +rxt(k,532)*y(k,131))*y(k,17) & + + (rxt(k,26) +rxt(k,62) +rxt(k,594)*y(k,134))*y(k,32) & + + (rxt(k,101) +rxt(k,543)*y(k,69) +rxt(k,544)*y(k,131))*y(k,74) & + +rxt(k,518)*y(k,25)*y(k,20) +.380_r8*rxt(k,25)*y(k,23) + loss(k,135) = (rxt(k,368)* y(k,116) +rxt(k,312)* y(k,121) +rxt(k,316) & + * y(k,125) +rxt(k,330)* y(k,128) +rxt(k,335)* y(k,129) +rxt(k,343) & + * y(k,132) +rxt(k,352)* y(k,133) +rxt(k,594)* y(k,134) + rxt(k,26) & + + rxt(k,62) + het_rates(k,32))* y(k,32) + prod(k,135) = (rxt(k,63) +rxt(k,114)*y(k,25) +rxt(k,115)*y(k,25) + & + rxt(k,116)*y(k,28) +rxt(k,117)*y(k,40) +rxt(k,124)*y(k,51) + & + rxt(k,125)*y(k,69) +rxt(k,126)*y(k,71) +rxt(k,168)*y(k,105) + & + rxt(k,170)*y(k,103) +rxt(k,186)*y(k,101) +rxt(k,204)*y(k,120) + & + rxt(k,221)*y(k,117) +rxt(k,239)*y(k,116) +rxt(k,256)*y(k,126) + & + rxt(k,258)*y(k,103) +rxt(k,265)*y(k,105) +rxt(k,280)*y(k,62) + & + rxt(k,281)*y(k,63))*y(k,92) + (rxt(k,120)*y(k,63) + & + rxt(k,121)*y(k,63) +rxt(k,122)*y(k,62) +rxt(k,123)*y(k,62) + & + rxt(k,155)*y(k,126) +rxt(k,158)*y(k,103) +rxt(k,178)*y(k,105) + & + rxt(k,196)*y(k,101) +rxt(k,213)*y(k,120) +rxt(k,231)*y(k,117) + & + rxt(k,249)*y(k,116) +rxt(k,260)*y(k,103) +rxt(k,261)*y(k,105)) & + *y(k,94) + (rxt(k,65) +rxt(k,127)*y(k,25) +rxt(k,128)*y(k,28) + & + rxt(k,130)*y(k,49) +rxt(k,132)*y(k,72) +rxt(k,151)*y(k,126) + & + rxt(k,174)*y(k,105) +rxt(k,191)*y(k,101) +rxt(k,209)*y(k,120) + & + rxt(k,225)*y(k,103) +rxt(k,227)*y(k,117) +rxt(k,244)*y(k,116)) & + *y(k,95) + (rxt(k,153)*y(k,126) +rxt(k,176)*y(k,105) + & + rxt(k,194)*y(k,101) +rxt(k,211)*y(k,120) +rxt(k,229)*y(k,117) + & + rxt(k,246)*y(k,116) +rxt(k,247)*y(k,103) +rxt(k,259)*y(k,105) + & + rxt(k,271)*y(k,103))*y(k,93) + (rxt(k,149)*y(k,126) + & + rxt(k,172)*y(k,105) +rxt(k,189)*y(k,101) +rxt(k,203)*y(k,103) + & + rxt(k,207)*y(k,120) +rxt(k,224)*y(k,117) +rxt(k,242)*y(k,116)) & + *y(k,98) + (rxt(k,369) +rxt(k,306)*y(k,96) +rxt(k,307)*y(k,137)) & + *y(k,119) +.440_r8*rxt(k,25)*y(k,23) +rxt(k,540)*y(k,131)*y(k,31) + loss(k,40) = (rxt(k,511)* y(k,70) + rxt(k,49) + het_rates(k,33))* y(k,33) + prod(k,40) = (rxt(k,476)*y(k,9) +rxt(k,478)*y(k,12) + & + 2.000_r8*rxt(k,479)*y(k,13) +2.000_r8*rxt(k,480)*y(k,14) + & + rxt(k,481)*y(k,15) +rxt(k,502)*y(k,10) +2.000_r8*rxt(k,504)*y(k,42) + & + rxt(k,528)*y(k,47) +rxt(k,529)*y(k,48))*y(k,70) + (rxt(k,54) + & + rxt(k,523)*y(k,131))*y(k,47) + (rxt(k,55) +rxt(k,524)*y(k,131)) & + *y(k,48) +rxt(k,32)*y(k,9) +rxt(k,33)*y(k,10) +rxt(k,35)*y(k,12) & + +2.000_r8*rxt(k,36)*y(k,13) +2.000_r8*rxt(k,37)*y(k,14) +rxt(k,38) & + *y(k,15) +2.000_r8*rxt(k,51)*y(k,42) + loss(k,38) = (rxt(k,512)* y(k,70) + rxt(k,50) + het_rates(k,34))* y(k,34) + prod(k,38) = (rxt(k,53) +rxt(k,522)*y(k,131) +rxt(k,527)*y(k,70))*y(k,46) & + + (rxt(k,34) +rxt(k,477)*y(k,70))*y(k,11) + (rxt(k,35) + & + rxt(k,478)*y(k,70))*y(k,12) + loss(k,48) = (rxt(k,541)* y(k,64) + (rxt(k,542) +rxt(k,556))* y(k,131) & + + het_rates(k,35))* y(k,35) + prod(k,48) = 0._r8 loss(k,5) = ( + het_rates(k,36))* y(k,36) prod(k,5) = 0._r8 - loss(k,53) = (rxt(k,507)* y(k,22) +rxt(k,508)* y(k,39) +rxt(k,510)* y(k,49) & - +rxt(k,509)* y(k,137) + het_rates(k,37))* y(k,37) - prod(k,53) = (rxt(k,480)*y(k,13) +rxt(k,502)*y(k,9) + & - 2.000_r8*rxt(k,511)*y(k,31) +rxt(k,512)*y(k,32))*y(k,122) & - +2.000_r8*rxt(k,49)*y(k,31) +rxt(k,50)*y(k,32) +rxt(k,57)*y(k,48) - loss(k,113) = (rxt(k,411)* y(k,68) +rxt(k,414)* y(k,69) +rxt(k,105)* y(k,87) & - +rxt(k,117)* y(k,91) +rxt(k,129)* y(k,94) + (rxt(k,408) + & - rxt(k,409) +rxt(k,410))* y(k,98) +rxt(k,287)* y(k,108) +rxt(k,309) & - * y(k,119) +rxt(k,317)* y(k,125) +rxt(k,331)* y(k,128) +rxt(k,344) & - * y(k,132) + het_rates(k,38))* y(k,38) - prod(k,113) = (rxt(k,141)*y(k,95) +rxt(k,147)*y(k,87) +rxt(k,158)*y(k,93) + & - rxt(k,162)*y(k,109) +rxt(k,163)*y(k,113) +rxt(k,164)*y(k,88) + & - rxt(k,165)*y(k,111) +rxt(k,166)*y(k,108) +rxt(k,170)*y(k,91) + & - rxt(k,181)*y(k,89) +rxt(k,203)*y(k,97) +rxt(k,214)*y(k,125) + & - rxt(k,225)*y(k,94) +rxt(k,236)*y(k,112) +rxt(k,247)*y(k,92) + & - rxt(k,258)*y(k,91) +rxt(k,260)*y(k,93) +rxt(k,262)*y(k,112) + & - rxt(k,271)*y(k,92))*y(k,102) + (rxt(k,144)*y(k,95) + & - rxt(k,168)*y(k,91) +rxt(k,169)*y(k,89) +rxt(k,172)*y(k,97) + & - rxt(k,173)*y(k,125) +rxt(k,174)*y(k,94) +rxt(k,175)*y(k,112) + & - rxt(k,176)*y(k,92) +rxt(k,177)*y(k,87) +rxt(k,178)*y(k,93) + & - rxt(k,179)*y(k,109) +rxt(k,180)*y(k,113) +rxt(k,182)*y(k,88) + & - rxt(k,183)*y(k,111) +rxt(k,184)*y(k,108) +rxt(k,259)*y(k,92) + & - rxt(k,261)*y(k,93) +rxt(k,263)*y(k,112) +rxt(k,265)*y(k,91))*y(k,104) & - + (rxt(k,186)*y(k,91) +rxt(k,187)*y(k,89) +rxt(k,189)*y(k,97) + & - rxt(k,190)*y(k,125) +rxt(k,191)*y(k,94) +rxt(k,193)*y(k,112) + & - rxt(k,194)*y(k,92) +rxt(k,195)*y(k,87) +rxt(k,196)*y(k,93) + & - rxt(k,197)*y(k,109) +rxt(k,198)*y(k,113) +rxt(k,199)*y(k,88) + & - rxt(k,200)*y(k,111) +rxt(k,201)*y(k,108) +rxt(k,383)*y(k,95)) & - *y(k,100) + (rxt(k,415)*y(k,39) +rxt(k,418)*y(k,67) + & - rxt(k,438)*y(k,54) +rxt(k,532)*y(k,16) +rxt(k,541)*y(k,29) + & - rxt(k,543)*y(k,71) +rxt(k,548)*y(k,74) +rxt(k,553)*y(k,76))*y(k,131) & - + (rxt(k,354)*y(k,133) +rxt(k,389)*y(k,122) +rxt(k,406)*y(k,67) + & - rxt(k,452)*y(k,86) +rxt(k,508)*y(k,37))*y(k,39) & - + (rxt(k,138)*y(k,96) +rxt(k,381)*y(k,105) +rxt(k,382)*y(k,99)) & - *y(k,95) + (rxt(k,539)*y(k,22) +rxt(k,483)*y(k,47) + & - rxt(k,506)*y(k,43))*y(k,122) + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,137) & - +2.000_r8*rxt(k,21)*y(k,16) +rxt(k,23)*y(k,21) +rxt(k,52)*y(k,43) & - +rxt(k,56)*y(k,47) +rxt(k,57)*y(k,48) - loss(k,77) = (rxt(k,508)* y(k,37) +rxt(k,406)* y(k,67) +rxt(k,452)* y(k,86) & - +rxt(k,389)* y(k,122) +rxt(k,415)* y(k,131) + (rxt(k,353) + & - rxt(k,354))* y(k,133) + het_rates(k,39))* y(k,39) - prod(k,77) =rxt(k,22)*y(k,16) +rxt(k,540)*y(k,122)*y(k,22) & - +rxt(k,408)*y(k,98)*y(k,38) +rxt(k,1)*y(k,137) - loss(k,46) = (rxt(k,407)* y(k,67) +rxt(k,453)* y(k,86) +rxt(k,416)* y(k,131) & - + rxt(k,4) + het_rates(k,41))* y(k,41) - prod(k,46) = (.500_r8*rxt(k,559) +rxt(k,422)*y(k,98))*y(k,98) & + loss(k,6) = ( + het_rates(k,37))* y(k,37) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,38))* y(k,38) + prod(k,7) = 0._r8 + loss(k,79) = (rxt(k,507)* y(k,23) +rxt(k,508)* y(k,41) +rxt(k,510)* y(k,51) & + +rxt(k,509)* y(k,137) + het_rates(k,39))* y(k,39) + prod(k,79) = (rxt(k,480)*y(k,14) +rxt(k,502)*y(k,10) + & + 2.000_r8*rxt(k,511)*y(k,33) +rxt(k,512)*y(k,34))*y(k,70) +rxt(k,33) & + *y(k,10) +rxt(k,37)*y(k,14) +2.000_r8*rxt(k,49)*y(k,33) +rxt(k,50) & + *y(k,34) +rxt(k,57)*y(k,50) + loss(k,121) = (rxt(k,411)* y(k,71) +rxt(k,414)* y(k,72) +rxt(k,105)* y(k,88) & + +rxt(k,117)* y(k,92) +rxt(k,129)* y(k,95) + (rxt(k,408) + & + rxt(k,409) +rxt(k,410))* y(k,99) +rxt(k,287)* y(k,109) +rxt(k,309) & + * y(k,120) +rxt(k,317)* y(k,125) +rxt(k,331)* y(k,128) +rxt(k,344) & + * y(k,132) + het_rates(k,40))* y(k,40) + prod(k,121) = (rxt(k,141)*y(k,96) +rxt(k,147)*y(k,88) +rxt(k,158)*y(k,94) + & + rxt(k,162)*y(k,110) +rxt(k,163)*y(k,114) +rxt(k,164)*y(k,89) + & + rxt(k,165)*y(k,112) +rxt(k,166)*y(k,109) +rxt(k,170)*y(k,92) + & + rxt(k,181)*y(k,90) +rxt(k,203)*y(k,98) +rxt(k,214)*y(k,125) + & + rxt(k,225)*y(k,95) +rxt(k,236)*y(k,113) +rxt(k,247)*y(k,93) + & + rxt(k,258)*y(k,92) +rxt(k,260)*y(k,94) +rxt(k,262)*y(k,113) + & + rxt(k,271)*y(k,93))*y(k,103) + (rxt(k,144)*y(k,96) + & + rxt(k,168)*y(k,92) +rxt(k,169)*y(k,90) +rxt(k,172)*y(k,98) + & + rxt(k,173)*y(k,125) +rxt(k,174)*y(k,95) +rxt(k,175)*y(k,113) + & + rxt(k,176)*y(k,93) +rxt(k,177)*y(k,88) +rxt(k,178)*y(k,94) + & + rxt(k,179)*y(k,110) +rxt(k,180)*y(k,114) +rxt(k,182)*y(k,89) + & + rxt(k,183)*y(k,112) +rxt(k,184)*y(k,109) +rxt(k,259)*y(k,93) + & + rxt(k,261)*y(k,94) +rxt(k,263)*y(k,113) +rxt(k,265)*y(k,92))*y(k,105) & + + (rxt(k,186)*y(k,92) +rxt(k,187)*y(k,90) +rxt(k,189)*y(k,98) + & + rxt(k,190)*y(k,125) +rxt(k,191)*y(k,95) +rxt(k,193)*y(k,113) + & + rxt(k,194)*y(k,93) +rxt(k,195)*y(k,88) +rxt(k,196)*y(k,94) + & + rxt(k,197)*y(k,110) +rxt(k,198)*y(k,114) +rxt(k,199)*y(k,89) + & + rxt(k,200)*y(k,112) +rxt(k,201)*y(k,109) +rxt(k,383)*y(k,96)) & + *y(k,101) + (rxt(k,415)*y(k,41) +rxt(k,418)*y(k,69) + & + rxt(k,438)*y(k,56) +rxt(k,532)*y(k,17) +rxt(k,544)*y(k,74) + & + rxt(k,550)*y(k,77) +rxt(k,555)*y(k,79))*y(k,131) & + + (rxt(k,354)*y(k,133) +rxt(k,389)*y(k,70) +rxt(k,406)*y(k,69) + & + rxt(k,452)*y(k,25) +rxt(k,508)*y(k,39))*y(k,41) + (rxt(k,24) + & + .330_r8*rxt(k,25) +rxt(k,538)*y(k,70))*y(k,23) & + + (rxt(k,138)*y(k,97) +rxt(k,381)*y(k,106) +rxt(k,382)*y(k,100)) & + *y(k,96) + (rxt(k,52) +rxt(k,506)*y(k,70))*y(k,45) + (rxt(k,56) + & + rxt(k,483)*y(k,70))*y(k,49) + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,137) & + +2.000_r8*rxt(k,21)*y(k,17) +rxt(k,23)*y(k,22) +rxt(k,57)*y(k,50) + loss(k,101) = (rxt(k,452)* y(k,25) +rxt(k,508)* y(k,39) +rxt(k,406)* y(k,69) & + +rxt(k,389)* y(k,70) +rxt(k,415)* y(k,131) + (rxt(k,353) + & + rxt(k,354))* y(k,133) + het_rates(k,41))* y(k,41) + prod(k,101) = (1.440_r8*rxt(k,25) +rxt(k,539)*y(k,70))*y(k,23) +rxt(k,22) & + *y(k,17) +rxt(k,408)*y(k,99)*y(k,40) +rxt(k,1)*y(k,137) + loss(k,26) = (rxt(k,504)* y(k,70) + rxt(k,51) + het_rates(k,42))* y(k,42) + prod(k,26) = 0._r8 + loss(k,62) = (rxt(k,453)* y(k,25) +rxt(k,407)* y(k,69) +rxt(k,416)* y(k,131) & + + rxt(k,4) + het_rates(k,43))* y(k,43) + prod(k,62) = (.500_r8*rxt(k,558) +rxt(k,422)*y(k,99))*y(k,99) & +rxt(k,421)*y(k,131)*y(k,131) - loss(k,22) = ( + rxt(k,100) + het_rates(k,42))* y(k,42) - prod(k,22) =rxt(k,555)*y(k,137)*y(k,78) - loss(k,58) = (rxt(k,499)* y(k,67) + (rxt(k,505) +rxt(k,506))* y(k,122) & - +rxt(k,500)* y(k,131) + rxt(k,52) + het_rates(k,43))* y(k,43) - prod(k,58) = (rxt(k,486)*y(k,16) +rxt(k,487)*y(k,98))*y(k,85) - loss(k,98) = ((rxt(k,569) +rxt(k,574) +rxt(k,579))* y(k,27) + (rxt(k,571) + & - rxt(k,576))* y(k,51) + (rxt(k,564) +rxt(k,570) +rxt(k,575))* y(k,52) & - +rxt(k,470)* y(k,67) +rxt(k,108)* y(k,87) +rxt(k,106)* y(k,88) & - +rxt(k,130)* y(k,94) +rxt(k,289)* y(k,108) + (rxt(k,276) + & - rxt(k,298))* y(k,110) + (rxt(k,482) +rxt(k,483))* y(k,122) & - +rxt(k,318)* y(k,125) +rxt(k,471)* y(k,131) +rxt(k,345)* y(k,132) & - +rxt(k,356)* y(k,133) + rxt(k,56) + het_rates(k,47))* y(k,47) - prod(k,98) = (rxt(k,451)*y(k,22) +rxt(k,513)*y(k,15) +rxt(k,515)*y(k,17) + & - 2.000_r8*rxt(k,518)*y(k,19) +rxt(k,520)*y(k,23) +rxt(k,450)*y(k,16) + & - rxt(k,452)*y(k,39) +rxt(k,453)*y(k,41) +rxt(k,454)*y(k,98) + & - rxt(k,472)*y(k,52))*y(k,86) + (rxt(k,386) +rxt(k,169)*y(k,104) + & - rxt(k,181)*y(k,102) +rxt(k,187)*y(k,100) +rxt(k,205)*y(k,119) + & - rxt(k,222)*y(k,116) +rxt(k,240)*y(k,115) +rxt(k,257)*y(k,126) + & - 2.000_r8*rxt(k,267)*y(k,102) +2.000_r8*rxt(k,268)*y(k,104))*y(k,89) & - + (rxt(k,157)*y(k,126) +rxt(k,163)*y(k,102) +rxt(k,180)*y(k,104) + & - rxt(k,198)*y(k,100) +rxt(k,216)*y(k,119) +rxt(k,233)*y(k,116) + & - rxt(k,251)*y(k,115) +rxt(k,299)*y(k,49))*y(k,113) & - + (rxt(k,105)*y(k,38) +rxt(k,109)*y(k,49))*y(k,87) & - +rxt(k,469)*y(k,131)*y(k,26) - loss(k,26) = ( + rxt(k,57) + het_rates(k,48))* y(k,48) - prod(k,26) = (rxt(k,507)*y(k,22) +rxt(k,508)*y(k,39) +rxt(k,509)*y(k,137) + & - rxt(k,510)*y(k,49))*y(k,37) - loss(k,101) = (rxt(k,510)* y(k,37) +rxt(k,109)* y(k,87) +rxt(k,124)* y(k,91) & - +rxt(k,290)* y(k,108) +rxt(k,300)* y(k,110) +rxt(k,295)* y(k,112) & - +rxt(k,299)* y(k,113) +rxt(k,319)* y(k,125) +rxt(k,447)* y(k,131) & - +rxt(k,357)* y(k,133) + rxt(k,9) + het_rates(k,49))* y(k,49) - prod(k,101) = (rxt(k,275) +2.000_r8*rxt(k,146)*y(k,102) + & - 2.000_r8*rxt(k,167)*y(k,104) +2.000_r8*rxt(k,185)*y(k,100) + & - rxt(k,202)*y(k,119) +rxt(k,220)*y(k,116) +rxt(k,238)*y(k,115) + & - rxt(k,255)*y(k,126) +2.000_r8*rxt(k,269)*y(k,102) + & - 2.000_r8*rxt(k,270)*y(k,104))*y(k,114) + (2.000_r8*rxt(k,560) + & - 2.000_r8*rxt(k,563) +2.000_r8*rxt(k,566) +2.000_r8*rxt(k,577) + & - rxt(k,142)*y(k,102) +rxt(k,145)*y(k,104) +rxt(k,293)*y(k,111) + & - rxt(k,297)*y(k,112))*y(k,56) + (rxt(k,567) +rxt(k,572) +rxt(k,578) + & - rxt(k,569)*y(k,47) +rxt(k,574)*y(k,47) +rxt(k,579)*y(k,47))*y(k,27) & - + (rxt(k,171)*y(k,104) +rxt(k,188)*y(k,100) +rxt(k,192)*y(k,102) + & - rxt(k,264)*y(k,102) +rxt(k,266)*y(k,104) +rxt(k,298)*y(k,47)) & - *y(k,110) + (rxt(k,565) +rxt(k,568) +rxt(k,573))*y(k,5) & - + (rxt(k,562) +rxt(k,530)*y(k,16) +rxt(k,556)*y(k,33))*y(k,62) & - + (.500_r8*rxt(k,561) +rxt(k,446)*y(k,131))*y(k,61) & - + (rxt(k,140)*y(k,101) +rxt(k,143)*y(k,103))*y(k,137) - loss(k,39) = (rxt(k,423)* y(k,131) + rxt(k,10) + rxt(k,11) + rxt(k,448) & - + het_rates(k,50))* y(k,50) - prod(k,39) =rxt(k,444)*y(k,98)*y(k,61) - loss(k,54) = ((rxt(k,571) +rxt(k,576))* y(k,47) +rxt(k,501)* y(k,67) & - + rxt(k,58) + het_rates(k,51))* y(k,51) - prod(k,54) = (rxt(k,565) +rxt(k,568) +rxt(k,573))*y(k,5) +rxt(k,493)*y(k,98) & - *y(k,4) - loss(k,57) = ((rxt(k,564) +rxt(k,570) +rxt(k,575))* y(k,47) +rxt(k,473) & - * y(k,67) +rxt(k,472)* y(k,86) +rxt(k,474)* y(k,131) + rxt(k,59) & + loss(k,31) = ( + rxt(k,100) + het_rates(k,44))* y(k,44) + prod(k,31) =rxt(k,557)*y(k,137)*y(k,81) + loss(k,78) = (rxt(k,499)* y(k,69) + (rxt(k,505) +rxt(k,506))* y(k,70) & + +rxt(k,500)* y(k,131) + rxt(k,52) + het_rates(k,45))* y(k,45) + prod(k,78) = (rxt(k,486)*y(k,17) +rxt(k,487)*y(k,99))*y(k,3) + loss(k,37) = (rxt(k,527)* y(k,70) +rxt(k,522)* y(k,131) + rxt(k,53) & + + het_rates(k,46))* y(k,46) + prod(k,37) = 0._r8 + loss(k,39) = (rxt(k,528)* y(k,70) +rxt(k,523)* y(k,131) + rxt(k,54) & + + het_rates(k,47))* y(k,47) + prod(k,39) = 0._r8 + loss(k,46) = (rxt(k,529)* y(k,70) +rxt(k,524)* y(k,131) + rxt(k,55) & + + het_rates(k,48))* y(k,48) + prod(k,46) = 0._r8 + loss(k,124) = ((rxt(k,568) +rxt(k,573) +rxt(k,578))* y(k,29) + (rxt(k,570) + & + rxt(k,575))* y(k,53) + (rxt(k,563) +rxt(k,569) +rxt(k,574))* y(k,54) & + +rxt(k,470)* y(k,69) + (rxt(k,482) +rxt(k,483))* y(k,70) +rxt(k,108) & + * y(k,88) +rxt(k,106)* y(k,89) +rxt(k,130)* y(k,95) +rxt(k,289) & + * y(k,109) + (rxt(k,276) +rxt(k,298))* y(k,111) +rxt(k,318)* y(k,125) & + +rxt(k,471)* y(k,131) +rxt(k,345)* y(k,132) +rxt(k,356)* y(k,133) & + + rxt(k,56) + het_rates(k,49))* y(k,49) + prod(k,124) = (rxt(k,450)*y(k,17) +rxt(k,451)*y(k,23) +rxt(k,452)*y(k,41) + & + rxt(k,453)*y(k,43) +rxt(k,454)*y(k,99) +rxt(k,472)*y(k,54) + & + rxt(k,513)*y(k,16) +rxt(k,515)*y(k,18) +2.000_r8*rxt(k,518)*y(k,20) + & + rxt(k,520)*y(k,24))*y(k,25) + (rxt(k,386) +rxt(k,169)*y(k,105) + & + rxt(k,181)*y(k,103) +rxt(k,187)*y(k,101) +rxt(k,205)*y(k,120) + & + rxt(k,222)*y(k,117) +rxt(k,240)*y(k,116) +rxt(k,257)*y(k,126) + & + 2.000_r8*rxt(k,267)*y(k,103) +2.000_r8*rxt(k,268)*y(k,105))*y(k,90) & + + (rxt(k,157)*y(k,126) +rxt(k,163)*y(k,103) +rxt(k,180)*y(k,105) + & + rxt(k,198)*y(k,101) +rxt(k,216)*y(k,120) +rxt(k,233)*y(k,117) + & + rxt(k,251)*y(k,116) +rxt(k,299)*y(k,51))*y(k,114) & + + (rxt(k,105)*y(k,40) +rxt(k,109)*y(k,51))*y(k,88) & + +rxt(k,469)*y(k,131)*y(k,28) + loss(k,47) = ( + rxt(k,57) + het_rates(k,50))* y(k,50) + prod(k,47) = (rxt(k,507)*y(k,23) +rxt(k,508)*y(k,41) +rxt(k,509)*y(k,137) + & + rxt(k,510)*y(k,51))*y(k,39) + loss(k,118) = (rxt(k,510)* y(k,39) +rxt(k,109)* y(k,88) +rxt(k,124)* y(k,92) & + +rxt(k,290)* y(k,109) +rxt(k,300)* y(k,111) +rxt(k,295)* y(k,113) & + +rxt(k,299)* y(k,114) +rxt(k,319)* y(k,125) +rxt(k,447)* y(k,131) & + +rxt(k,357)* y(k,133) + rxt(k,9) + het_rates(k,51))* y(k,51) + prod(k,118) = (rxt(k,275) +2.000_r8*rxt(k,146)*y(k,103) + & + 2.000_r8*rxt(k,167)*y(k,105) +2.000_r8*rxt(k,185)*y(k,101) + & + rxt(k,202)*y(k,120) +rxt(k,220)*y(k,117) +rxt(k,238)*y(k,116) + & + rxt(k,255)*y(k,126) +2.000_r8*rxt(k,269)*y(k,103) + & + 2.000_r8*rxt(k,270)*y(k,105))*y(k,115) + (2.000_r8*rxt(k,559) + & + 2.000_r8*rxt(k,562) +2.000_r8*rxt(k,565) +2.000_r8*rxt(k,576) + & + rxt(k,142)*y(k,103) +rxt(k,145)*y(k,105) +rxt(k,293)*y(k,112) + & + rxt(k,297)*y(k,113))*y(k,58) + (rxt(k,566) +rxt(k,571) +rxt(k,577) + & + rxt(k,568)*y(k,49) +rxt(k,573)*y(k,49) +rxt(k,578)*y(k,49))*y(k,29) & + + (rxt(k,171)*y(k,105) +rxt(k,188)*y(k,101) +rxt(k,192)*y(k,103) + & + rxt(k,264)*y(k,103) +rxt(k,266)*y(k,105) +rxt(k,298)*y(k,49)) & + *y(k,111) + (rxt(k,564) +rxt(k,567) +rxt(k,572))*y(k,6) & + + (rxt(k,561) +rxt(k,530)*y(k,17) +rxt(k,541)*y(k,35))*y(k,64) & + + (.500_r8*rxt(k,560) +rxt(k,446)*y(k,131))*y(k,63) & + + (rxt(k,140)*y(k,102) +rxt(k,143)*y(k,104))*y(k,137) + loss(k,58) = (rxt(k,423)* y(k,131) + rxt(k,10) + rxt(k,11) + rxt(k,448) & + het_rates(k,52))* y(k,52) - prod(k,57) = (rxt(k,567) +rxt(k,572) +rxt(k,578) +rxt(k,466)*y(k,131)) & - *y(k,27) +rxt(k,461)*y(k,98)*y(k,26) - loss(k,50) = (rxt(k,340)* y(k,131) + rxt(k,12) + het_rates(k,53))* y(k,53) - prod(k,50) = (rxt(k,289)*y(k,47) +rxt(k,290)*y(k,49))*y(k,108) & - +rxt(k,349)*y(k,131)*y(k,60) +rxt(k,305)*y(k,137)*y(k,117) - loss(k,65) = (rxt(k,426)* y(k,60) + (rxt(k,427) +rxt(k,428) +rxt(k,429)) & - * y(k,61) +rxt(k,430)* y(k,68) +rxt(k,592)* y(k,126) +rxt(k,438) & - * y(k,131) + rxt(k,66) + het_rates(k,54))* y(k,54) - prod(k,65) = (rxt(k,424)*y(k,106) +rxt(k,589)*y(k,121))*y(k,67) & - + (.200_r8*rxt(k,583)*y(k,115) +1.100_r8*rxt(k,585)*y(k,107)) & - *y(k,95) +rxt(k,17)*y(k,60) +rxt(k,590)*y(k,121)*y(k,68) +rxt(k,596) & + prod(k,58) =rxt(k,444)*y(k,99)*y(k,63) + loss(k,75) = ((rxt(k,570) +rxt(k,575))* y(k,49) +rxt(k,501)* y(k,69) & + + rxt(k,58) + het_rates(k,53))* y(k,53) + prod(k,75) = (rxt(k,564) +rxt(k,567) +rxt(k,572))*y(k,6) +rxt(k,493)*y(k,99) & + *y(k,5) + loss(k,77) = (rxt(k,472)* y(k,25) + (rxt(k,563) +rxt(k,569) +rxt(k,574)) & + * y(k,49) +rxt(k,473)* y(k,69) +rxt(k,474)* y(k,131) + rxt(k,59) & + + het_rates(k,54))* y(k,54) + prod(k,77) = (rxt(k,566) +rxt(k,571) +rxt(k,577) +rxt(k,466)*y(k,131)) & + *y(k,29) +rxt(k,461)*y(k,99)*y(k,28) + loss(k,71) = (rxt(k,340)* y(k,131) + rxt(k,12) + het_rates(k,55))* y(k,55) + prod(k,71) = (rxt(k,289)*y(k,49) +rxt(k,290)*y(k,51))*y(k,109) & + +rxt(k,349)*y(k,131)*y(k,62) +rxt(k,305)*y(k,137)*y(k,118) + loss(k,88) = (rxt(k,426)* y(k,62) + (rxt(k,427) +rxt(k,428) +rxt(k,429)) & + * y(k,63) +rxt(k,430)* y(k,71) +rxt(k,591)* y(k,126) +rxt(k,438) & + * y(k,131) + rxt(k,66) + het_rates(k,56))* y(k,56) + prod(k,88) = (rxt(k,424)*y(k,107) +rxt(k,588)*y(k,122))*y(k,69) & + + (.200_r8*rxt(k,582)*y(k,116) +1.100_r8*rxt(k,584)*y(k,108)) & + *y(k,96) +rxt(k,17)*y(k,62) +rxt(k,589)*y(k,122)*y(k,71) +rxt(k,595) & *y(k,134) - loss(k,64) = (rxt(k,142)* y(k,102) +rxt(k,145)* y(k,104) +rxt(k,293) & - * y(k,111) +rxt(k,297)* y(k,112) + rxt(k,14) + rxt(k,15) + rxt(k,449) & - + rxt(k,560) + rxt(k,563) + rxt(k,566) + rxt(k,577) & - + het_rates(k,56))* y(k,56) - prod(k,64) =rxt(k,445)*y(k,62)*y(k,61) - loss(k,6) = ( + het_rates(k,57))* y(k,57) - prod(k,6) = 0._r8 - loss(k,7) = ( + het_rates(k,58))* y(k,58) - prod(k,7) = 0._r8 + loss(k,42) = ((rxt(k,442) +rxt(k,443))* y(k,70) + rxt(k,13) & + + het_rates(k,57))* y(k,57) + prod(k,42) =rxt(k,427)*y(k,63)*y(k,56) + loss(k,85) = (rxt(k,142)* y(k,103) +rxt(k,145)* y(k,105) +rxt(k,293) & + * y(k,112) +rxt(k,297)* y(k,113) + rxt(k,14) + rxt(k,15) + rxt(k,449) & + + rxt(k,559) + rxt(k,562) + rxt(k,565) + rxt(k,576) & + + het_rates(k,58))* y(k,58) + prod(k,85) =rxt(k,445)*y(k,64)*y(k,63) loss(k,8) = ( + het_rates(k,59))* y(k,59) prod(k,8) = 0._r8 - loss(k,106) = (rxt(k,494)* y(k,4) +rxt(k,534)* y(k,20) +rxt(k,462)* y(k,26) & - +rxt(k,426)* y(k,54) +rxt(k,435)* y(k,62) +rxt(k,441)* y(k,67) & - +rxt(k,440)* y(k,69) + (rxt(k,111) +rxt(k,112))* y(k,90) +rxt(k,280) & - * y(k,91) + (rxt(k,122) +rxt(k,123))* y(k,93) +rxt(k,439)* y(k,98) & - +rxt(k,594)* y(k,126) + (rxt(k,272) +rxt(k,279))* y(k,128) & - +rxt(k,349)* y(k,131) +rxt(k,136)* y(k,133) + rxt(k,16) + rxt(k,17) & - + het_rates(k,60))* y(k,60) - prod(k,106) = (rxt(k,202)*y(k,114) +rxt(k,204)*y(k,91) +rxt(k,205)*y(k,89) + & - rxt(k,206)*y(k,110) +rxt(k,207)*y(k,97) +rxt(k,208)*y(k,125) + & - rxt(k,209)*y(k,94) +rxt(k,210)*y(k,112) +rxt(k,211)*y(k,92) + & - rxt(k,212)*y(k,87) +rxt(k,213)*y(k,93) +rxt(k,215)*y(k,109) + & - rxt(k,216)*y(k,113) +rxt(k,217)*y(k,88) +rxt(k,218)*y(k,111) + & - rxt(k,219)*y(k,108) +rxt(k,308)*y(k,95) +rxt(k,309)*y(k,38))*y(k,119) & - + (rxt(k,220)*y(k,114) +rxt(k,221)*y(k,91) +rxt(k,222)*y(k,89) + & - rxt(k,223)*y(k,110) +rxt(k,224)*y(k,97) +rxt(k,226)*y(k,125) + & - rxt(k,227)*y(k,94) +rxt(k,228)*y(k,112) +rxt(k,229)*y(k,92) + & - rxt(k,230)*y(k,87) +rxt(k,231)*y(k,93) +rxt(k,232)*y(k,109) + & - rxt(k,233)*y(k,113) +rxt(k,234)*y(k,88) +rxt(k,235)*y(k,111) + & - rxt(k,237)*y(k,108) +rxt(k,303)*y(k,95))*y(k,116) & - + (rxt(k,238)*y(k,114) +rxt(k,239)*y(k,91) +rxt(k,240)*y(k,89) + & - rxt(k,241)*y(k,110) +rxt(k,242)*y(k,97) +rxt(k,243)*y(k,125) + & - rxt(k,244)*y(k,94) +rxt(k,245)*y(k,112) +rxt(k,246)*y(k,92) + & - rxt(k,248)*y(k,87) +rxt(k,249)*y(k,93) +rxt(k,250)*y(k,109) + & - rxt(k,251)*y(k,113) +rxt(k,252)*y(k,88) +rxt(k,253)*y(k,111) + & - rxt(k,254)*y(k,108))*y(k,115) + (rxt(k,18) +.500_r8*rxt(k,561) + & - rxt(k,291)*y(k,108) +2.000_r8*rxt(k,428)*y(k,54) + & - rxt(k,431)*y(k,67) +rxt(k,549)*y(k,76))*y(k,61) & - + (rxt(k,304)*y(k,117) +rxt(k,306)*y(k,118) +rxt(k,384)*y(k,120)) & - *y(k,95) + (rxt(k,430)*y(k,68) +rxt(k,438)*y(k,131))*y(k,54) & - +rxt(k,287)*y(k,108)*y(k,38) +rxt(k,12)*y(k,53) & - +2.000_r8*rxt(k,442)*y(k,122)*y(k,55) +rxt(k,15)*y(k,56) +rxt(k,20) & - *y(k,62) +rxt(k,425)*y(k,106)*y(k,68) +rxt(k,593)*y(k,126) & - +rxt(k,606)*y(k,136) - loss(k,94) = (rxt(k,495)* y(k,4) +rxt(k,464)* y(k,26) + (rxt(k,427) + & - rxt(k,428) +rxt(k,429))* y(k,54) +rxt(k,445)* y(k,62) + (rxt(k,431) + & - rxt(k,433))* y(k,67) +rxt(k,432)* y(k,69) +rxt(k,549)* y(k,76) & - +rxt(k,110)* y(k,87) +rxt(k,281)* y(k,91) + (rxt(k,120) +rxt(k,121)) & - * y(k,93) +rxt(k,444)* y(k,98) +rxt(k,291)* y(k,108) +rxt(k,320) & - * y(k,125) + (rxt(k,277) +rxt(k,278))* y(k,128) +rxt(k,446)* y(k,131) & - +rxt(k,346)* y(k,132) +rxt(k,359)* y(k,133) + rxt(k,18) + rxt(k,561) & - + het_rates(k,61))* y(k,61) - prod(k,94) = (rxt(k,112)*y(k,90) +rxt(k,136)*y(k,133) + & - 2.000_r8*rxt(k,435)*y(k,62) +rxt(k,439)*y(k,98) +rxt(k,440)*y(k,69) + & - rxt(k,441)*y(k,67) +rxt(k,462)*y(k,26) +rxt(k,494)*y(k,4) + & - rxt(k,534)*y(k,20))*y(k,60) + (rxt(k,75) +rxt(k,161)*y(k,126) + & - rxt(k,166)*y(k,102) +rxt(k,184)*y(k,104) +rxt(k,201)*y(k,100) + & - rxt(k,219)*y(k,119) +rxt(k,237)*y(k,116) +rxt(k,254)*y(k,115) + & - rxt(k,285)*y(k,86))*y(k,108) + (rxt(k,156)*y(k,126) + & - rxt(k,162)*y(k,102) +rxt(k,179)*y(k,104) +rxt(k,197)*y(k,100) + & - rxt(k,215)*y(k,119) +rxt(k,232)*y(k,116) +rxt(k,250)*y(k,115)) & - *y(k,109) + (rxt(k,19) +rxt(k,434)*y(k,98) +rxt(k,436)*y(k,67) + & - rxt(k,437)*y(k,131))*y(k,62) + (rxt(k,11) +rxt(k,448) + & - rxt(k,423)*y(k,131))*y(k,50) + (rxt(k,14) +rxt(k,449))*y(k,56) & - + (rxt(k,311)*y(k,119) +rxt(k,340)*y(k,53))*y(k,131) +rxt(k,29) & - *y(k,5) +rxt(k,48)*y(k,27) +rxt(k,9)*y(k,49) - loss(k,97) = (rxt(k,530)* y(k,16) +rxt(k,556)* y(k,33) +rxt(k,435)* y(k,60) & - +rxt(k,445)* y(k,61) +rxt(k,436)* y(k,67) +rxt(k,434)* y(k,98) & - +rxt(k,437)* y(k,131) + rxt(k,19) + rxt(k,20) + rxt(k,562) & - + het_rates(k,62))* y(k,62) - prod(k,97) = (rxt(k,152)*y(k,126) +rxt(k,175)*y(k,104) +rxt(k,193)*y(k,100) + & - rxt(k,210)*y(k,119) +rxt(k,228)*y(k,116) +rxt(k,236)*y(k,102) + & - rxt(k,245)*y(k,115) +rxt(k,262)*y(k,102) +rxt(k,263)*y(k,104)) & - *y(k,112) + (rxt(k,160)*y(k,126) +rxt(k,165)*y(k,102) + & - rxt(k,183)*y(k,104) +rxt(k,200)*y(k,100) +rxt(k,218)*y(k,119) + & - rxt(k,235)*y(k,116) +rxt(k,253)*y(k,115))*y(k,111) & - + (rxt(k,157)*y(k,126) +rxt(k,163)*y(k,102) +rxt(k,180)*y(k,104) + & - rxt(k,198)*y(k,100) +rxt(k,216)*y(k,119) +rxt(k,233)*y(k,116) + & - rxt(k,251)*y(k,115))*y(k,113) + (rxt(k,76) +rxt(k,148)*y(k,126) + & - rxt(k,206)*y(k,119) +rxt(k,223)*y(k,116) +rxt(k,241)*y(k,115)) & - *y(k,110) + (rxt(k,47) +rxt(k,463)*y(k,86) +rxt(k,465)*y(k,67) + & - rxt(k,466)*y(k,131))*y(k,27) + (rxt(k,202)*y(k,119) + & - rxt(k,220)*y(k,116) +rxt(k,238)*y(k,115) +rxt(k,255)*y(k,126)) & - *y(k,114) + (rxt(k,14) +rxt(k,15) +rxt(k,449))*y(k,56) + (rxt(k,30) + & - rxt(k,496)*y(k,67))*y(k,5) + (rxt(k,447)*y(k,131) + & - rxt(k,510)*y(k,37))*y(k,49) + (rxt(k,432)*y(k,69) + & - rxt(k,433)*y(k,67))*y(k,61) +rxt(k,286)*y(k,108)*y(k,26) +rxt(k,10) & - *y(k,50) +rxt(k,310)*y(k,119)*y(k,98) - loss(k,9) = ( + het_rates(k,63))* y(k,63) + loss(k,9) = ( + het_rates(k,60))* y(k,60) prod(k,9) = 0._r8 - loss(k,10) = ( + het_rates(k,64))* y(k,64) + loss(k,10) = ( + het_rates(k,61))* y(k,61) prod(k,10) = 0._r8 + loss(k,129) = (rxt(k,494)* y(k,5) +rxt(k,534)* y(k,21) +rxt(k,462)* y(k,28) & + +rxt(k,426)* y(k,56) +rxt(k,435)* y(k,64) +rxt(k,441)* y(k,69) & + +rxt(k,440)* y(k,72) + (rxt(k,111) +rxt(k,112))* y(k,91) +rxt(k,280) & + * y(k,92) + (rxt(k,122) +rxt(k,123))* y(k,94) +rxt(k,439)* y(k,99) & + +rxt(k,593)* y(k,126) + (rxt(k,272) +rxt(k,279))* y(k,128) & + +rxt(k,349)* y(k,131) +rxt(k,136)* y(k,133) + rxt(k,16) + rxt(k,17) & + + het_rates(k,62))* y(k,62) + prod(k,129) = (rxt(k,202)*y(k,115) +rxt(k,204)*y(k,92) +rxt(k,205)*y(k,90) + & + rxt(k,206)*y(k,111) +rxt(k,207)*y(k,98) +rxt(k,208)*y(k,125) + & + rxt(k,209)*y(k,95) +rxt(k,210)*y(k,113) +rxt(k,211)*y(k,93) + & + rxt(k,212)*y(k,88) +rxt(k,213)*y(k,94) +rxt(k,215)*y(k,110) + & + rxt(k,216)*y(k,114) +rxt(k,217)*y(k,89) +rxt(k,218)*y(k,112) + & + rxt(k,219)*y(k,109) +rxt(k,308)*y(k,96) +rxt(k,309)*y(k,40))*y(k,120) & + + (rxt(k,220)*y(k,115) +rxt(k,221)*y(k,92) +rxt(k,222)*y(k,90) + & + rxt(k,223)*y(k,111) +rxt(k,224)*y(k,98) +rxt(k,226)*y(k,125) + & + rxt(k,227)*y(k,95) +rxt(k,228)*y(k,113) +rxt(k,229)*y(k,93) + & + rxt(k,230)*y(k,88) +rxt(k,231)*y(k,94) +rxt(k,232)*y(k,110) + & + rxt(k,233)*y(k,114) +rxt(k,234)*y(k,89) +rxt(k,235)*y(k,112) + & + rxt(k,237)*y(k,109) +rxt(k,303)*y(k,96))*y(k,117) & + + (rxt(k,238)*y(k,115) +rxt(k,239)*y(k,92) +rxt(k,240)*y(k,90) + & + rxt(k,241)*y(k,111) +rxt(k,242)*y(k,98) +rxt(k,243)*y(k,125) + & + rxt(k,244)*y(k,95) +rxt(k,245)*y(k,113) +rxt(k,246)*y(k,93) + & + rxt(k,248)*y(k,88) +rxt(k,249)*y(k,94) +rxt(k,250)*y(k,110) + & + rxt(k,251)*y(k,114) +rxt(k,252)*y(k,89) +rxt(k,253)*y(k,112) + & + rxt(k,254)*y(k,109))*y(k,116) + (rxt(k,18) +.500_r8*rxt(k,560) + & + rxt(k,291)*y(k,109) +2.000_r8*rxt(k,428)*y(k,56) + & + rxt(k,431)*y(k,69) +rxt(k,551)*y(k,79))*y(k,63) & + + (rxt(k,304)*y(k,118) +rxt(k,306)*y(k,119) +rxt(k,384)*y(k,121)) & + *y(k,96) + (rxt(k,430)*y(k,71) +rxt(k,438)*y(k,131))*y(k,56) & + +rxt(k,287)*y(k,109)*y(k,40) +rxt(k,12)*y(k,55) & + +2.000_r8*rxt(k,442)*y(k,70)*y(k,57) +rxt(k,15)*y(k,58) +rxt(k,20) & + *y(k,64) +rxt(k,425)*y(k,107)*y(k,71) +rxt(k,592)*y(k,126) & + +rxt(k,605)*y(k,136) + loss(k,127) = (rxt(k,495)* y(k,5) +rxt(k,464)* y(k,28) + (rxt(k,427) + & + rxt(k,428) +rxt(k,429))* y(k,56) +rxt(k,445)* y(k,64) + (rxt(k,431) + & + rxt(k,433))* y(k,69) +rxt(k,432)* y(k,72) +rxt(k,551)* y(k,79) & + +rxt(k,110)* y(k,88) +rxt(k,281)* y(k,92) + (rxt(k,120) +rxt(k,121)) & + * y(k,94) +rxt(k,444)* y(k,99) +rxt(k,291)* y(k,109) +rxt(k,320) & + * y(k,125) + (rxt(k,277) +rxt(k,278))* y(k,128) +rxt(k,446)* y(k,131) & + +rxt(k,346)* y(k,132) +rxt(k,359)* y(k,133) + rxt(k,18) + rxt(k,560) & + + het_rates(k,63))* y(k,63) + prod(k,127) = (rxt(k,112)*y(k,91) +rxt(k,136)*y(k,133) + & + 2.000_r8*rxt(k,435)*y(k,64) +rxt(k,439)*y(k,99) +rxt(k,440)*y(k,72) + & + rxt(k,441)*y(k,69) +rxt(k,462)*y(k,28) +rxt(k,494)*y(k,5) + & + rxt(k,534)*y(k,21))*y(k,62) + (rxt(k,75) +rxt(k,161)*y(k,126) + & + rxt(k,166)*y(k,103) +rxt(k,184)*y(k,105) +rxt(k,201)*y(k,101) + & + rxt(k,219)*y(k,120) +rxt(k,237)*y(k,117) +rxt(k,254)*y(k,116) + & + rxt(k,285)*y(k,25))*y(k,109) + (rxt(k,156)*y(k,126) + & + rxt(k,162)*y(k,103) +rxt(k,179)*y(k,105) +rxt(k,197)*y(k,101) + & + rxt(k,215)*y(k,120) +rxt(k,232)*y(k,117) +rxt(k,250)*y(k,116)) & + *y(k,110) + (rxt(k,19) +rxt(k,434)*y(k,99) +rxt(k,436)*y(k,69) + & + rxt(k,437)*y(k,131))*y(k,64) + (rxt(k,11) +rxt(k,448) + & + rxt(k,423)*y(k,131))*y(k,52) + (rxt(k,14) +rxt(k,449))*y(k,58) & + + (rxt(k,311)*y(k,120) +rxt(k,340)*y(k,55))*y(k,131) +rxt(k,29) & + *y(k,6) +rxt(k,48)*y(k,29) +rxt(k,9)*y(k,51) + loss(k,115) = (rxt(k,530)* y(k,17) +rxt(k,541)* y(k,35) +rxt(k,435)* y(k,62) & + +rxt(k,445)* y(k,63) +rxt(k,436)* y(k,69) +rxt(k,434)* y(k,99) & + +rxt(k,437)* y(k,131) + rxt(k,19) + rxt(k,20) + rxt(k,561) & + + het_rates(k,64))* y(k,64) + prod(k,115) = (rxt(k,152)*y(k,126) +rxt(k,175)*y(k,105) + & + rxt(k,193)*y(k,101) +rxt(k,210)*y(k,120) +rxt(k,228)*y(k,117) + & + rxt(k,236)*y(k,103) +rxt(k,245)*y(k,116) +rxt(k,262)*y(k,103) + & + rxt(k,263)*y(k,105))*y(k,113) + (rxt(k,160)*y(k,126) + & + rxt(k,165)*y(k,103) +rxt(k,183)*y(k,105) +rxt(k,200)*y(k,101) + & + rxt(k,218)*y(k,120) +rxt(k,235)*y(k,117) +rxt(k,253)*y(k,116)) & + *y(k,112) + (rxt(k,157)*y(k,126) +rxt(k,163)*y(k,103) + & + rxt(k,180)*y(k,105) +rxt(k,198)*y(k,101) +rxt(k,216)*y(k,120) + & + rxt(k,233)*y(k,117) +rxt(k,251)*y(k,116))*y(k,114) + (rxt(k,76) + & + rxt(k,148)*y(k,126) +rxt(k,206)*y(k,120) +rxt(k,223)*y(k,117) + & + rxt(k,241)*y(k,116))*y(k,111) + (rxt(k,47) +rxt(k,463)*y(k,25) + & + rxt(k,465)*y(k,69) +rxt(k,466)*y(k,131))*y(k,29) & + + (rxt(k,202)*y(k,120) +rxt(k,220)*y(k,117) +rxt(k,238)*y(k,116) + & + rxt(k,255)*y(k,126))*y(k,115) + (rxt(k,14) +rxt(k,15) +rxt(k,449)) & + *y(k,58) + (rxt(k,30) +rxt(k,496)*y(k,69))*y(k,6) & + + (rxt(k,447)*y(k,131) +rxt(k,510)*y(k,39))*y(k,51) & + + (rxt(k,432)*y(k,72) +rxt(k,433)*y(k,69))*y(k,63) & + +rxt(k,286)*y(k,109)*y(k,28) +rxt(k,10)*y(k,52) +rxt(k,310)*y(k,120) & + *y(k,99) loss(k,11) = ( + het_rates(k,65))* y(k,65) prod(k,11) = 0._r8 loss(k,12) = ( + het_rates(k,66))* y(k,66) prod(k,12) = 0._r8 - loss(k,104) = (rxt(k,497)* y(k,4) +rxt(k,496)* y(k,5) +rxt(k,531)* y(k,16) & - +rxt(k,467)* y(k,26) +rxt(k,465)* y(k,27) +rxt(k,406)* y(k,39) & - +rxt(k,407)* y(k,41) +rxt(k,499)* y(k,43) +rxt(k,470)* y(k,47) & - +rxt(k,501)* y(k,51) +rxt(k,473)* y(k,52) +rxt(k,441)* y(k,60) & - + (rxt(k,431) +rxt(k,433))* y(k,61) +rxt(k,436)* y(k,62) & - + 2._r8*rxt(k,404)* y(k,67) +rxt(k,405)* y(k,68) +rxt(k,403) & - * y(k,69) +rxt(k,542)* y(k,71) +rxt(k,113)* y(k,90) +rxt(k,125) & - * y(k,91) +rxt(k,131)* y(k,94) +rxt(k,412)* y(k,98) + (rxt(k,587) + & - rxt(k,588))* y(k,107) +rxt(k,301)* y(k,110) +rxt(k,589)* y(k,121) & + loss(k,13) = ( + het_rates(k,67))* y(k,67) + prod(k,13) = 0._r8 + loss(k,14) = ( + het_rates(k,68))* y(k,68) + prod(k,14) = 0._r8 + loss(k,119) = (rxt(k,497)* y(k,5) +rxt(k,496)* y(k,6) +rxt(k,531)* y(k,17) & + +rxt(k,467)* y(k,28) +rxt(k,465)* y(k,29) +rxt(k,406)* y(k,41) & + +rxt(k,407)* y(k,43) +rxt(k,499)* y(k,45) +rxt(k,470)* y(k,49) & + +rxt(k,501)* y(k,53) +rxt(k,473)* y(k,54) +rxt(k,441)* y(k,62) & + + (rxt(k,431) +rxt(k,433))* y(k,63) +rxt(k,436)* y(k,64) & + + 2._r8*rxt(k,404)* y(k,69) +rxt(k,405)* y(k,71) +rxt(k,403) & + * y(k,72) +rxt(k,543)* y(k,74) +rxt(k,113)* y(k,91) +rxt(k,125) & + * y(k,92) +rxt(k,131)* y(k,95) +rxt(k,412)* y(k,99) + (rxt(k,586) + & + rxt(k,587))* y(k,108) +rxt(k,301)* y(k,111) +rxt(k,588)* y(k,122) & + (rxt(k,324) +rxt(k,325))* y(k,125) + (rxt(k,333) +rxt(k,334)) & * y(k,128) +rxt(k,336)* y(k,129) +rxt(k,338)* y(k,130) +rxt(k,418) & * y(k,131) +rxt(k,347)* y(k,132) +rxt(k,360)* y(k,133) + rxt(k,77) & + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) + rxt(k,82) & - + het_rates(k,67))* y(k,67) - prod(k,104) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,83) +rxt(k,85) +rxt(k,87) + & + + het_rates(k,69))* y(k,69) + prod(k,119) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,83) +rxt(k,85) +rxt(k,87) + & 2.000_r8*rxt(k,88) +2.000_r8*rxt(k,89) +rxt(k,90) +rxt(k,91) + & - rxt(k,92) +rxt(k,392)*y(k,122) +rxt(k,393)*y(k,122) + & - rxt(k,430)*y(k,54) +rxt(k,544)*y(k,74) +rxt(k,550)*y(k,76) + & - rxt(k,591)*y(k,121) +rxt(k,598)*y(k,134) +rxt(k,602)*y(k,135)) & - *y(k,68) + (rxt(k,114)*y(k,86) +rxt(k,168)*y(k,104) + & - rxt(k,170)*y(k,102) +rxt(k,186)*y(k,100) +rxt(k,204)*y(k,119) + & - rxt(k,221)*y(k,116) +rxt(k,239)*y(k,115) +rxt(k,256)*y(k,126) + & - rxt(k,258)*y(k,102) +rxt(k,265)*y(k,104))*y(k,91) & - + (rxt(k,153)*y(k,126) +rxt(k,176)*y(k,104) +rxt(k,194)*y(k,100) + & - rxt(k,211)*y(k,119) +rxt(k,229)*y(k,116) +rxt(k,246)*y(k,115) + & - rxt(k,247)*y(k,102) +rxt(k,259)*y(k,104) +rxt(k,271)*y(k,102)) & - *y(k,92) + (rxt(k,155)*y(k,126) +rxt(k,158)*y(k,102) + & - rxt(k,178)*y(k,104) +rxt(k,196)*y(k,100) +rxt(k,213)*y(k,119) + & - rxt(k,231)*y(k,116) +rxt(k,249)*y(k,115) +rxt(k,260)*y(k,102) + & - rxt(k,261)*y(k,104))*y(k,93) + (rxt(k,99) +rxt(k,358) + & - rxt(k,350)*y(k,86) +rxt(k,359)*y(k,61) +rxt(k,363)*y(k,69))*y(k,133) & - + (rxt(k,426)*y(k,60) +rxt(k,427)*y(k,61) +rxt(k,592)*y(k,126)) & - *y(k,54) + (rxt(k,17) +rxt(k,272)*y(k,128))*y(k,60) & - + (rxt(k,583)*y(k,115) +1.150_r8*rxt(k,584)*y(k,126))*y(k,95) & - +rxt(k,28)*y(k,4) +rxt(k,46)*y(k,26) +rxt(k,410)*y(k,98)*y(k,38) & - +rxt(k,15)*y(k,56) +rxt(k,18)*y(k,61) +rxt(k,19)*y(k,62) +rxt(k,8) & - *y(k,69) +rxt(k,60)*y(k,70) +rxt(k,102)*y(k,76) +rxt(k,103)*y(k,77) & - +rxt(k,104)*y(k,78) +rxt(k,597)*y(k,134)*y(k,106) +rxt(k,391) & - *y(k,122) +rxt(k,420)*y(k,131)*y(k,131) +rxt(k,600)*y(k,135) & - +rxt(k,605)*y(k,136) +rxt(k,2)*y(k,137) - loss(k,100) = (rxt(k,411)* y(k,38) +rxt(k,430)* y(k,54) +rxt(k,405)* y(k,67) & - +rxt(k,544)* y(k,74) +rxt(k,550)* y(k,76) +rxt(k,126)* y(k,91) & - + (rxt(k,133) +rxt(k,135))* y(k,95) +rxt(k,425)* y(k,106) & - +rxt(k,586)* y(k,107) + (rxt(k,590) +rxt(k,591))* y(k,121) & - +rxt(k,392)* y(k,122) +rxt(k,397)* y(k,123) +rxt(k,322)* y(k,125) & - +rxt(k,364)* y(k,126) +rxt(k,362)* y(k,133) +rxt(k,598)* y(k,134) & - +rxt(k,602)* y(k,135) + rxt(k,5) + rxt(k,6) + rxt(k,83) + rxt(k,84) & - + rxt(k,85) + rxt(k,86) + rxt(k,87) + rxt(k,88) + rxt(k,89) & - + rxt(k,90) + rxt(k,91) + rxt(k,92) + het_rates(k,68))* y(k,68) - prod(k,100) = (rxt(k,8) +rxt(k,132)*y(k,94) +rxt(k,134)*y(k,95) + & - rxt(k,292)*y(k,108) +2.000_r8*rxt(k,302)*y(k,110) + & + rxt(k,92) +rxt(k,392)*y(k,70) +rxt(k,393)*y(k,70) + & + rxt(k,430)*y(k,56) +rxt(k,545)*y(k,77) +rxt(k,552)*y(k,79) + & + rxt(k,590)*y(k,122) +rxt(k,597)*y(k,134) +rxt(k,601)*y(k,135)) & + *y(k,71) + (rxt(k,114)*y(k,25) +rxt(k,168)*y(k,105) + & + rxt(k,170)*y(k,103) +rxt(k,186)*y(k,101) +rxt(k,204)*y(k,120) + & + rxt(k,221)*y(k,117) +rxt(k,239)*y(k,116) +rxt(k,256)*y(k,126) + & + rxt(k,258)*y(k,103) +rxt(k,265)*y(k,105))*y(k,92) & + + (rxt(k,153)*y(k,126) +rxt(k,176)*y(k,105) +rxt(k,194)*y(k,101) + & + rxt(k,211)*y(k,120) +rxt(k,229)*y(k,117) +rxt(k,246)*y(k,116) + & + rxt(k,247)*y(k,103) +rxt(k,259)*y(k,105) +rxt(k,271)*y(k,103)) & + *y(k,93) + (rxt(k,155)*y(k,126) +rxt(k,158)*y(k,103) + & + rxt(k,178)*y(k,105) +rxt(k,196)*y(k,101) +rxt(k,213)*y(k,120) + & + rxt(k,231)*y(k,117) +rxt(k,249)*y(k,116) +rxt(k,260)*y(k,103) + & + rxt(k,261)*y(k,105))*y(k,94) + (rxt(k,99) +rxt(k,358) + & + rxt(k,350)*y(k,25) +rxt(k,359)*y(k,63) +rxt(k,363)*y(k,72))*y(k,133) & + + (rxt(k,426)*y(k,62) +rxt(k,427)*y(k,63) +rxt(k,591)*y(k,126)) & + *y(k,56) + (rxt(k,26) +rxt(k,62))*y(k,32) + (rxt(k,17) + & + rxt(k,272)*y(k,128))*y(k,62) + (rxt(k,582)*y(k,116) + & + 1.150_r8*rxt(k,583)*y(k,126))*y(k,96) +rxt(k,28)*y(k,5) & + +.180_r8*rxt(k,25)*y(k,23) +rxt(k,46)*y(k,28) +rxt(k,410)*y(k,99) & + *y(k,40) +rxt(k,15)*y(k,58) +rxt(k,18)*y(k,63) +rxt(k,19)*y(k,64) & + +rxt(k,391)*y(k,70) +rxt(k,8)*y(k,72) +rxt(k,60)*y(k,73) +rxt(k,102) & + *y(k,79) +rxt(k,103)*y(k,80) +rxt(k,104)*y(k,81) +rxt(k,596)*y(k,134) & + *y(k,107) +rxt(k,420)*y(k,131)*y(k,131) +rxt(k,599)*y(k,135) & + +rxt(k,604)*y(k,136) +rxt(k,2)*y(k,137) + loss(k,106) = (rxt(k,475)* y(k,8) +rxt(k,476)* y(k,9) +rxt(k,502)* y(k,10) & + +rxt(k,477)* y(k,11) +rxt(k,478)* y(k,12) +rxt(k,479)* y(k,13) & + +rxt(k,480)* y(k,14) +rxt(k,481)* y(k,15) +rxt(k,525)* y(k,16) & + +rxt(k,526)* y(k,18) + (rxt(k,537) +rxt(k,538) +rxt(k,539))* y(k,23) & + +rxt(k,503)* y(k,24) +rxt(k,511)* y(k,33) +rxt(k,512)* y(k,34) & + +rxt(k,389)* y(k,41) +rxt(k,504)* y(k,42) + (rxt(k,505) +rxt(k,506)) & + * y(k,45) +rxt(k,527)* y(k,46) +rxt(k,528)* y(k,47) +rxt(k,529) & + * y(k,48) + (rxt(k,482) +rxt(k,483))* y(k,49) + (rxt(k,442) + & + rxt(k,443))* y(k,57) + (rxt(k,392) +rxt(k,393))* y(k,71) +rxt(k,394) & + * y(k,72) +rxt(k,390)* y(k,137) + rxt(k,391) + het_rates(k,70)) & + * y(k,70) + prod(k,106) = (rxt(k,6) +rxt(k,425)*y(k,107))*y(k,71) +rxt(k,13)*y(k,57) & + +rxt(k,7)*y(k,72) +.850_r8*rxt(k,583)*y(k,126)*y(k,96) +rxt(k,1) & + *y(k,137) + loss(k,131) = (rxt(k,411)* y(k,40) +rxt(k,430)* y(k,56) +rxt(k,405)* y(k,69) & + +rxt(k,392)* y(k,70) +rxt(k,545)* y(k,77) +rxt(k,552)* y(k,79) & + +rxt(k,126)* y(k,92) + (rxt(k,133) +rxt(k,135))* y(k,96) +rxt(k,425) & + * y(k,107) +rxt(k,585)* y(k,108) + (rxt(k,589) +rxt(k,590))* y(k,122) & + +rxt(k,397)* y(k,123) +rxt(k,322)* y(k,125) +rxt(k,364)* y(k,126) & + +rxt(k,362)* y(k,133) +rxt(k,597)* y(k,134) +rxt(k,601)* y(k,135) & + + rxt(k,5) + rxt(k,6) + rxt(k,83) + rxt(k,84) + rxt(k,85) & + + rxt(k,86) + rxt(k,87) + rxt(k,88) + rxt(k,89) + rxt(k,90) & + + rxt(k,91) + rxt(k,92) + het_rates(k,71))* y(k,71) + prod(k,131) = (rxt(k,8) +rxt(k,132)*y(k,95) +rxt(k,134)*y(k,96) + & + rxt(k,292)*y(k,109) +2.000_r8*rxt(k,302)*y(k,111) + & rxt(k,323)*y(k,125) +3.000_r8*rxt(k,332)*y(k,128) + & - 2.000_r8*rxt(k,394)*y(k,122) +2.000_r8*rxt(k,403)*y(k,67) + & - 2.000_r8*rxt(k,413)*y(k,98) +rxt(k,414)*y(k,38) + & - rxt(k,419)*y(k,131) +rxt(k,432)*y(k,61) +rxt(k,440)*y(k,60) + & - rxt(k,456)*y(k,86) +rxt(k,488)*y(k,85) +rxt(k,545)*y(k,74) + & - rxt(k,551)*y(k,76))*y(k,69) + (rxt(k,113)*y(k,90) + & - rxt(k,131)*y(k,94) +rxt(k,301)*y(k,110) +rxt(k,325)*y(k,125) + & + 2.000_r8*rxt(k,394)*y(k,70) +2.000_r8*rxt(k,403)*y(k,69) + & + 2.000_r8*rxt(k,413)*y(k,99) +rxt(k,414)*y(k,40) + & + rxt(k,419)*y(k,131) +rxt(k,432)*y(k,63) +rxt(k,440)*y(k,62) + & + rxt(k,456)*y(k,25) +rxt(k,488)*y(k,3) +rxt(k,547)*y(k,77) + & + rxt(k,553)*y(k,79))*y(k,72) + (rxt(k,113)*y(k,91) + & + rxt(k,131)*y(k,95) +rxt(k,301)*y(k,111) +rxt(k,325)*y(k,125) + & 2.000_r8*rxt(k,333)*y(k,128) +rxt(k,334)*y(k,128) + & rxt(k,336)*y(k,129) +rxt(k,360)*y(k,133) +rxt(k,396)*y(k,123) + & - rxt(k,404)*y(k,67) +rxt(k,412)*y(k,98) +rxt(k,418)*y(k,131) + & - rxt(k,431)*y(k,61) +rxt(k,436)*y(k,62) +rxt(k,467)*y(k,26) + & - rxt(k,497)*y(k,4))*y(k,67) + (rxt(k,148)*y(k,110) + & - rxt(k,149)*y(k,97) +2.000_r8*rxt(k,151)*y(k,94) + & - rxt(k,152)*y(k,112) +rxt(k,153)*y(k,92) +rxt(k,154)*y(k,87) + & - rxt(k,155)*y(k,93) +rxt(k,156)*y(k,109) +rxt(k,157)*y(k,113) + & - rxt(k,159)*y(k,88) +rxt(k,160)*y(k,111) +rxt(k,161)*y(k,108) + & - rxt(k,255)*y(k,114) +rxt(k,256)*y(k,91) +rxt(k,257)*y(k,89) + & - rxt(k,594)*y(k,60))*y(k,126) + (rxt(k,93) +rxt(k,137) + & - rxt(k,173)*y(k,104) +rxt(k,190)*y(k,100) +rxt(k,208)*y(k,119) + & - rxt(k,214)*y(k,102) +rxt(k,226)*y(k,116) +rxt(k,243)*y(k,115) + & - rxt(k,314)*y(k,86) +rxt(k,315)*y(k,26) +rxt(k,320)*y(k,61) + & - 2.000_r8*rxt(k,321)*y(k,123))*y(k,125) + (rxt(k,116)*y(k,91) + & - rxt(k,128)*y(k,94) +rxt(k,351)*y(k,133) +rxt(k,458)*y(k,26) + & - rxt(k,459)*y(k,26) +rxt(k,461)*y(k,98) +rxt(k,469)*y(k,131) + & - rxt(k,491)*y(k,4) +rxt(k,492)*y(k,4))*y(k,26) + (rxt(k,408)*y(k,38) + & - rxt(k,417)*y(k,131) +rxt(k,422)*y(k,98) +rxt(k,434)*y(k,62) + & - rxt(k,454)*y(k,86) +rxt(k,487)*y(k,85) +rxt(k,493)*y(k,4) + & - rxt(k,533)*y(k,20))*y(k,98) + (rxt(k,127)*y(k,86) + & - rxt(k,174)*y(k,104) +rxt(k,191)*y(k,100) +rxt(k,209)*y(k,119) + & - rxt(k,225)*y(k,102) +rxt(k,227)*y(k,116) +rxt(k,244)*y(k,115)) & - *y(k,94) + (rxt(k,95) +rxt(k,330)*y(k,30) +rxt(k,277)*y(k,61) + & - rxt(k,279)*y(k,60) +rxt(k,331)*y(k,38))*y(k,128) + (rxt(k,387) + & + rxt(k,404)*y(k,69) +rxt(k,412)*y(k,99) +rxt(k,418)*y(k,131) + & + rxt(k,431)*y(k,63) +rxt(k,436)*y(k,64) +rxt(k,467)*y(k,28) + & + rxt(k,497)*y(k,5))*y(k,69) + (rxt(k,148)*y(k,111) + & + rxt(k,149)*y(k,98) +2.000_r8*rxt(k,151)*y(k,95) + & + rxt(k,152)*y(k,113) +rxt(k,153)*y(k,93) +rxt(k,154)*y(k,88) + & + rxt(k,155)*y(k,94) +rxt(k,156)*y(k,110) +rxt(k,157)*y(k,114) + & + rxt(k,159)*y(k,89) +rxt(k,160)*y(k,112) +rxt(k,161)*y(k,109) + & + rxt(k,255)*y(k,115) +rxt(k,256)*y(k,92) +rxt(k,257)*y(k,90) + & + rxt(k,593)*y(k,62))*y(k,126) + (rxt(k,93) +rxt(k,137) + & + rxt(k,173)*y(k,105) +rxt(k,190)*y(k,101) +rxt(k,208)*y(k,120) + & + rxt(k,214)*y(k,103) +rxt(k,226)*y(k,117) +rxt(k,243)*y(k,116) + & + rxt(k,314)*y(k,25) +rxt(k,315)*y(k,28) +rxt(k,320)*y(k,63) + & + 2.000_r8*rxt(k,321)*y(k,123))*y(k,125) + (rxt(k,116)*y(k,92) + & + rxt(k,128)*y(k,95) +rxt(k,351)*y(k,133) +rxt(k,458)*y(k,28) + & + rxt(k,459)*y(k,28) +rxt(k,461)*y(k,99) +rxt(k,469)*y(k,131) + & + rxt(k,491)*y(k,5) +rxt(k,492)*y(k,5))*y(k,28) + (rxt(k,408)*y(k,40) + & + rxt(k,417)*y(k,131) +rxt(k,422)*y(k,99) +rxt(k,434)*y(k,64) + & + rxt(k,454)*y(k,25) +rxt(k,487)*y(k,3) +rxt(k,493)*y(k,5) + & + rxt(k,533)*y(k,21))*y(k,99) + (rxt(k,127)*y(k,25) + & + rxt(k,174)*y(k,105) +rxt(k,191)*y(k,101) +rxt(k,209)*y(k,120) + & + rxt(k,225)*y(k,103) +rxt(k,227)*y(k,117) +rxt(k,244)*y(k,116)) & + *y(k,95) + (rxt(k,95) +rxt(k,277)*y(k,63) +rxt(k,279)*y(k,62) + & + rxt(k,330)*y(k,32) +rxt(k,331)*y(k,40))*y(k,128) + (rxt(k,387) + & rxt(k,395) +2.000_r8*rxt(k,339)*y(k,130) + & - 2.000_r8*rxt(k,397)*y(k,68))*y(k,123) + (rxt(k,326)*y(k,95) + & + 2.000_r8*rxt(k,397)*y(k,71))*y(k,123) + (rxt(k,326)*y(k,96) + & rxt(k,327)*y(k,137) +rxt(k,328)*y(k,137))*y(k,127) + (rxt(k,97) + & - rxt(k,335)*y(k,30))*y(k,129) + (rxt(k,337)*y(k,137) + & - 2.000_r8*rxt(k,380)*y(k,95))*y(k,130) +rxt(k,489)*y(k,4)*y(k,4) & - +rxt(k,423)*y(k,131)*y(k,50) +rxt(k,429)*y(k,61)*y(k,54) & - +rxt(k,443)*y(k,122)*y(k,55) +rxt(k,20)*y(k,62) +rxt(k,388)*y(k,124) - loss(k,99) = (rxt(k,414)* y(k,38) +rxt(k,440)* y(k,60) +rxt(k,432)* y(k,61) & - +rxt(k,403)* y(k,67) +rxt(k,545)* y(k,74) +rxt(k,551)* y(k,76) & - +rxt(k,488)* y(k,85) +rxt(k,456)* y(k,86) +rxt(k,132)* y(k,94) & - +rxt(k,134)* y(k,95) +rxt(k,413)* y(k,98) +rxt(k,292)* y(k,108) & - +rxt(k,302)* y(k,110) +rxt(k,394)* y(k,122) +rxt(k,323)* y(k,125) & + rxt(k,335)*y(k,32))*y(k,129) + (rxt(k,337)*y(k,137) + & + 2.000_r8*rxt(k,380)*y(k,96))*y(k,130) +rxt(k,489)*y(k,5)*y(k,5) & + +rxt(k,423)*y(k,131)*y(k,52) +rxt(k,429)*y(k,63)*y(k,56) & + +rxt(k,443)*y(k,70)*y(k,57) +rxt(k,20)*y(k,64) +rxt(k,388)*y(k,124) + loss(k,134) = (rxt(k,488)* y(k,3) +rxt(k,456)* y(k,25) +rxt(k,414)* y(k,40) & + +rxt(k,440)* y(k,62) +rxt(k,432)* y(k,63) +rxt(k,403)* y(k,69) & + +rxt(k,394)* y(k,70) +rxt(k,547)* y(k,77) +rxt(k,553)* y(k,79) & + +rxt(k,132)* y(k,95) +rxt(k,134)* y(k,96) +rxt(k,413)* y(k,99) & + +rxt(k,292)* y(k,109) +rxt(k,302)* y(k,111) +rxt(k,323)* y(k,125) & +rxt(k,332)* y(k,128) +rxt(k,419)* y(k,131) +rxt(k,348)* y(k,132) & - +rxt(k,363)* y(k,133) + rxt(k,7) + rxt(k,8) + het_rates(k,69)) & - * y(k,69) - prod(k,99) = (rxt(k,324)*y(k,125) +rxt(k,338)*y(k,130) +rxt(k,405)*y(k,68)) & - *y(k,67) + (rxt(k,96) +rxt(k,278)*y(k,61))*y(k,128) & + +rxt(k,363)* y(k,133) + rxt(k,7) + rxt(k,8) + het_rates(k,72)) & + * y(k,72) + prod(k,134) = (rxt(k,324)*y(k,125) +rxt(k,338)*y(k,130) +rxt(k,405)*y(k,71)) & + *y(k,69) + (rxt(k,96) +rxt(k,278)*y(k,63))*y(k,128) & +rxt(k,361)*y(k,133)*y(k,123) - loss(k,33) = (rxt(k,552)* y(k,76) + rxt(k,60) + het_rates(k,70))* y(k,70) - prod(k,33) = (rxt(k,460)*y(k,26) +rxt(k,490)*y(k,4))*y(k,26) - loss(k,34) = (rxt(k,542)* y(k,67) +rxt(k,543)* y(k,131) + rxt(k,101) & - + het_rates(k,71))* y(k,71) - prod(k,34) = 0._r8 - loss(k,13) = ( + het_rates(k,72))* y(k,72) - prod(k,13) = 0._r8 - loss(k,14) = ( + het_rates(k,73))* y(k,73) - prod(k,14) = 0._r8 - loss(k,49) = (rxt(k,544)* y(k,68) +rxt(k,545)* y(k,69) +rxt(k,548)* y(k,131) & + loss(k,50) = (rxt(k,554)* y(k,79) + rxt(k,60) + het_rates(k,73))* y(k,73) + prod(k,50) = (rxt(k,460)*y(k,28) +rxt(k,490)*y(k,5))*y(k,28) + loss(k,51) = (rxt(k,543)* y(k,69) +rxt(k,544)* y(k,131) + rxt(k,101) & + het_rates(k,74))* y(k,74) - prod(k,49) =rxt(k,101)*y(k,71) +rxt(k,102)*y(k,76) - loss(k,70) = (rxt(k,546)* y(k,4) +rxt(k,547)* y(k,26) +rxt(k,549)* y(k,61) & - +rxt(k,550)* y(k,68) +rxt(k,551)* y(k,69) +rxt(k,552)* y(k,70) & - +rxt(k,553)* y(k,131) + rxt(k,102) + het_rates(k,76))* y(k,76) - prod(k,70) = (rxt(k,544)*y(k,68) +rxt(k,545)*y(k,69) +rxt(k,548)*y(k,131)) & - *y(k,74) +rxt(k,542)*y(k,71)*y(k,67) +rxt(k,103)*y(k,77) - loss(k,60) = (rxt(k,554)* y(k,131) + rxt(k,103) + het_rates(k,77))* y(k,77) - prod(k,60) = (rxt(k,546)*y(k,4) +rxt(k,547)*y(k,26) +rxt(k,549)*y(k,61) + & - rxt(k,550)*y(k,68) +rxt(k,551)*y(k,69) +rxt(k,552)*y(k,70) + & - rxt(k,553)*y(k,131))*y(k,76) + (rxt(k,556)*y(k,62) + & - rxt(k,557)*y(k,131) +.500_r8*rxt(k,558)*y(k,131))*y(k,33) & - +rxt(k,543)*y(k,131)*y(k,71) +rxt(k,104)*y(k,78) - loss(k,29) = (rxt(k,555)* y(k,137) + rxt(k,104) + het_rates(k,78))* y(k,78) - prod(k,29) =rxt(k,100)*y(k,42) +rxt(k,554)*y(k,131)*y(k,77) - loss(k,15) = ( + het_rates(k,79))* y(k,79) + prod(k,51) = 0._r8 + loss(k,15) = ( + het_rates(k,75))* y(k,75) prod(k,15) = 0._r8 - loss(k,16) = ( + het_rates(k,80))* y(k,80) + loss(k,16) = ( + het_rates(k,76))* y(k,76) prod(k,16) = 0._r8 - loss(k,17) = ( + het_rates(k,81))* y(k,81) + loss(k,70) = (rxt(k,545)* y(k,71) +rxt(k,547)* y(k,72) +rxt(k,550)* y(k,131) & + + het_rates(k,77))* y(k,77) + prod(k,70) =rxt(k,101)*y(k,74) +rxt(k,102)*y(k,79) + loss(k,17) = ( + rxt(k,61) + het_rates(k,78))* y(k,78) prod(k,17) = 0._r8 + loss(k,91) = (rxt(k,548)* y(k,5) +rxt(k,549)* y(k,28) +rxt(k,551)* y(k,63) & + +rxt(k,552)* y(k,71) +rxt(k,553)* y(k,72) +rxt(k,554)* y(k,73) & + +rxt(k,555)* y(k,131) + rxt(k,102) + het_rates(k,79))* y(k,79) + prod(k,91) = (rxt(k,545)*y(k,71) +rxt(k,547)*y(k,72) +rxt(k,550)*y(k,131)) & + *y(k,77) +rxt(k,543)*y(k,74)*y(k,69) +rxt(k,103)*y(k,80) + loss(k,80) = (rxt(k,546)* y(k,131) + rxt(k,103) + het_rates(k,80))* y(k,80) + prod(k,80) = (rxt(k,548)*y(k,5) +rxt(k,549)*y(k,28) +rxt(k,551)*y(k,63) + & + rxt(k,552)*y(k,71) +rxt(k,553)*y(k,72) +rxt(k,554)*y(k,73) + & + rxt(k,555)*y(k,131))*y(k,79) + (rxt(k,541)*y(k,64) + & + rxt(k,542)*y(k,131) +.500_r8*rxt(k,556)*y(k,131))*y(k,35) & + +rxt(k,544)*y(k,131)*y(k,74) +rxt(k,104)*y(k,81) + loss(k,43) = (rxt(k,557)* y(k,137) + rxt(k,104) + het_rates(k,81))* y(k,81) + prod(k,43) =rxt(k,100)*y(k,44) +rxt(k,546)*y(k,131)*y(k,80) loss(k,18) = ( + het_rates(k,82))* y(k,82) prod(k,18) = 0._r8 loss(k,19) = ( + het_rates(k,83))* y(k,83) prod(k,19) = 0._r8 loss(k,20) = ( + het_rates(k,84))* y(k,84) prod(k,20) = 0._r8 - loss(k,75) = (rxt(k,486)* y(k,16) +rxt(k,488)* y(k,69) +rxt(k,487)* y(k,98) & - + het_rates(k,85))* y(k,85) - prod(k,75) = (rxt(k,28) +2.000_r8*rxt(k,489)*y(k,4) +rxt(k,490)*y(k,26) + & - rxt(k,491)*y(k,26) +rxt(k,494)*y(k,60) +rxt(k,497)*y(k,67) + & - rxt(k,498)*y(k,131) +rxt(k,546)*y(k,76))*y(k,4) & - + (rxt(k,476)*y(k,8) +rxt(k,502)*y(k,9) + & - 3.000_r8*rxt(k,503)*y(k,23) +2.000_r8*rxt(k,504)*y(k,40) + & - 2.000_r8*rxt(k,525)*y(k,15) +rxt(k,526)*y(k,17) +rxt(k,505)*y(k,43)) & - *y(k,122) + (2.000_r8*rxt(k,514)*y(k,15) +rxt(k,516)*y(k,17) + & - 3.000_r8*rxt(k,521)*y(k,23) +rxt(k,500)*y(k,43))*y(k,131) & - + (2.000_r8*rxt(k,513)*y(k,15) +rxt(k,515)*y(k,17) + & - 3.000_r8*rxt(k,520)*y(k,23))*y(k,86) + (rxt(k,52) + & - rxt(k,499)*y(k,67))*y(k,43) +rxt(k,27)*y(k,3) +rxt(k,30)*y(k,5) & - +rxt(k,58)*y(k,51) - loss(k,105) = (rxt(k,513)* y(k,15) +rxt(k,450)* y(k,16) +rxt(k,515)* y(k,17) & - +rxt(k,518)* y(k,19) +rxt(k,451)* y(k,22) +rxt(k,520)* y(k,23) & - +rxt(k,463)* y(k,27) +rxt(k,452)* y(k,39) +rxt(k,453)* y(k,41) & - +rxt(k,472)* y(k,52) +rxt(k,456)* y(k,69) + (rxt(k,114) +rxt(k,115)) & - * y(k,91) +rxt(k,127)* y(k,94) + (rxt(k,454) +rxt(k,455))* y(k,98) & - +rxt(k,285)* y(k,108) +rxt(k,314)* y(k,125) +rxt(k,341)* y(k,132) & - +rxt(k,350)* y(k,133) + het_rates(k,86))* y(k,86) - prod(k,105) = (4.000_r8*rxt(k,475)*y(k,7) +rxt(k,476)*y(k,8) + & - 2.000_r8*rxt(k,477)*y(k,10) +2.000_r8*rxt(k,478)*y(k,11) + & - 2.000_r8*rxt(k,479)*y(k,12) +rxt(k,480)*y(k,13) + & - 2.000_r8*rxt(k,481)*y(k,14) +rxt(k,527)*y(k,44) +rxt(k,528)*y(k,45) + & - rxt(k,529)*y(k,46) +rxt(k,482)*y(k,47) +rxt(k,512)*y(k,32))*y(k,122) & - + (rxt(k,46) +rxt(k,457)*y(k,20) +2.000_r8*rxt(k,458)*y(k,26) + & - rxt(k,460)*y(k,26) +rxt(k,462)*y(k,60) +rxt(k,467)*y(k,67) + & - rxt(k,468)*y(k,131) +rxt(k,491)*y(k,4) +rxt(k,547)*y(k,76))*y(k,26) & - + (rxt(k,110)*y(k,61) +rxt(k,147)*y(k,102) +rxt(k,154)*y(k,126) + & - rxt(k,177)*y(k,104) +rxt(k,195)*y(k,100) +rxt(k,212)*y(k,119) + & - rxt(k,230)*y(k,116) +rxt(k,248)*y(k,115))*y(k,87) & - + (rxt(k,159)*y(k,126) +rxt(k,164)*y(k,102) +rxt(k,182)*y(k,104) + & - rxt(k,199)*y(k,100) +rxt(k,217)*y(k,119) +rxt(k,234)*y(k,116) + & - rxt(k,252)*y(k,115))*y(k,88) + (rxt(k,169)*y(k,104) + & - rxt(k,181)*y(k,102) +rxt(k,187)*y(k,100) +rxt(k,205)*y(k,119) + & - rxt(k,222)*y(k,116) +rxt(k,240)*y(k,115) +rxt(k,257)*y(k,126)) & - *y(k,89) + (3.000_r8*rxt(k,517)*y(k,18) +rxt(k,519)*y(k,19) + & - rxt(k,522)*y(k,44) +rxt(k,523)*y(k,45) +rxt(k,524)*y(k,46) + & - rxt(k,471)*y(k,47))*y(k,131) + (rxt(k,56) +rxt(k,470)*y(k,67)) & - *y(k,47) +rxt(k,27)*y(k,3) +2.000_r8*rxt(k,44)*y(k,24) & - +2.000_r8*rxt(k,45)*y(k,25) +rxt(k,47)*y(k,27) +rxt(k,50)*y(k,32) & - +rxt(k,59)*y(k,52) +rxt(k,111)*y(k,90)*y(k,60) - loss(k,86) = (rxt(k,105)* y(k,38) +rxt(k,108)* y(k,47) +rxt(k,109)* y(k,49) & - +rxt(k,110)* y(k,61) +rxt(k,195)* y(k,100) +rxt(k,147)* y(k,102) & - +rxt(k,177)* y(k,104) +rxt(k,248)* y(k,115) +rxt(k,230)* y(k,116) & - +rxt(k,212)* y(k,119) +rxt(k,154)* y(k,126) +rxt(k,107)* y(k,137) & - + het_rates(k,87))* y(k,87) - prod(k,86) = (rxt(k,130)*y(k,94) +rxt(k,289)*y(k,108) +rxt(k,298)*y(k,110) + & - rxt(k,318)*y(k,125) +rxt(k,345)*y(k,132) +rxt(k,356)*y(k,133)) & - *y(k,47) + (rxt(k,114)*y(k,91) +rxt(k,127)*y(k,94) + & - rxt(k,285)*y(k,108) +rxt(k,314)*y(k,125) +rxt(k,341)*y(k,132) + & - rxt(k,350)*y(k,133))*y(k,86) + (rxt(k,116)*y(k,91) + & - rxt(k,286)*y(k,108) +rxt(k,351)*y(k,133))*y(k,26) & - + (rxt(k,112)*y(k,60) +rxt(k,113)*y(k,67))*y(k,90) +rxt(k,385) & - *y(k,88) +rxt(k,386)*y(k,89) - loss(k,72) = (rxt(k,106)* y(k,47) +rxt(k,199)* y(k,100) +rxt(k,164)* y(k,102) & - +rxt(k,182)* y(k,104) +rxt(k,252)* y(k,115) +rxt(k,234)* y(k,116) & - +rxt(k,217)* y(k,119) +rxt(k,159)* y(k,126) + rxt(k,385) & + loss(k,21) = ( + het_rates(k,85))* y(k,85) + prod(k,21) = 0._r8 + loss(k,22) = ( + het_rates(k,86))* y(k,86) + prod(k,22) = 0._r8 + loss(k,23) = ( + het_rates(k,87))* y(k,87) + prod(k,23) = 0._r8 + loss(k,107) = (rxt(k,105)* y(k,40) +rxt(k,108)* y(k,49) +rxt(k,109)* y(k,51) & + +rxt(k,110)* y(k,63) +rxt(k,195)* y(k,101) +rxt(k,147)* y(k,103) & + +rxt(k,177)* y(k,105) +rxt(k,248)* y(k,116) +rxt(k,230)* y(k,117) & + +rxt(k,212)* y(k,120) +rxt(k,154)* y(k,126) +rxt(k,107)* y(k,137) & + het_rates(k,88))* y(k,88) - prod(k,72) =rxt(k,107)*y(k,137)*y(k,87) - loss(k,71) = (rxt(k,187)* y(k,100) + (rxt(k,181) +rxt(k,267))* y(k,102) & - + (rxt(k,169) +rxt(k,268))* y(k,104) +rxt(k,240)* y(k,115) & - +rxt(k,222)* y(k,116) +rxt(k,205)* y(k,119) +rxt(k,257)* y(k,126) & - + rxt(k,386) + het_rates(k,89))* y(k,89) - prod(k,71) = (rxt(k,106)*y(k,88) +rxt(k,108)*y(k,87))*y(k,47) - loss(k,63) = ((rxt(k,111) +rxt(k,112))* y(k,60) +rxt(k,113)* y(k,67) & - + het_rates(k,90))* y(k,90) - prod(k,63) = (rxt(k,128)*y(k,94) +rxt(k,315)*y(k,125) +rxt(k,342)*y(k,132)) & - *y(k,26) +rxt(k,115)*y(k,91)*y(k,86) - loss(k,90) = (rxt(k,116)* y(k,26) +rxt(k,117)* y(k,38) +rxt(k,124)* y(k,49) & - +rxt(k,280)* y(k,60) +rxt(k,281)* y(k,61) +rxt(k,125)* y(k,67) & - +rxt(k,126)* y(k,68) + (rxt(k,114) +rxt(k,115))* y(k,86) +rxt(k,186) & - * y(k,100) + (rxt(k,170) +rxt(k,258))* y(k,102) + (rxt(k,168) + & - rxt(k,265))* y(k,104) +rxt(k,239)* y(k,115) +rxt(k,221)* y(k,116) & - +rxt(k,204)* y(k,119) +rxt(k,256)* y(k,126) +rxt(k,119)* y(k,137) & - + rxt(k,63) + het_rates(k,91))* y(k,91) - prod(k,90) = (rxt(k,330)*y(k,128) +rxt(k,352)*y(k,133))*y(k,30) & - + (rxt(k,64) +rxt(k,283))*y(k,93) + (rxt(k,129)*y(k,38) + & - rxt(k,131)*y(k,67))*y(k,94) - loss(k,69) = (rxt(k,194)* y(k,100) + (rxt(k,247) +rxt(k,271))* y(k,102) & - + (rxt(k,176) +rxt(k,259))* y(k,104) +rxt(k,246)* y(k,115) & - +rxt(k,229)* y(k,116) +rxt(k,211)* y(k,119) +rxt(k,153)* y(k,126) & - + rxt(k,284) + het_rates(k,92))* y(k,92) - prod(k,69) =rxt(k,118)*y(k,137)*y(k,93) - loss(k,80) = ((rxt(k,122) +rxt(k,123))* y(k,60) + (rxt(k,120) +rxt(k,121)) & - * y(k,61) +rxt(k,196)* y(k,100) + (rxt(k,158) +rxt(k,260))* y(k,102) & - + (rxt(k,178) +rxt(k,261))* y(k,104) +rxt(k,249)* y(k,115) & - +rxt(k,231)* y(k,116) +rxt(k,213)* y(k,119) +rxt(k,155)* y(k,126) & - +rxt(k,118)* y(k,137) + rxt(k,64) + rxt(k,283) + het_rates(k,93)) & - * y(k,93) - prod(k,80) =rxt(k,119)*y(k,137)*y(k,91) +rxt(k,284)*y(k,92) - loss(k,85) = (rxt(k,128)* y(k,26) +rxt(k,129)* y(k,38) +rxt(k,130)* y(k,47) & - +rxt(k,131)* y(k,67) +rxt(k,132)* y(k,69) +rxt(k,127)* y(k,86) & - +rxt(k,191)* y(k,100) +rxt(k,225)* y(k,102) +rxt(k,174)* y(k,104) & - +rxt(k,244)* y(k,115) +rxt(k,227)* y(k,116) +rxt(k,209)* y(k,119) & - +rxt(k,151)* y(k,126) + rxt(k,65) + het_rates(k,94))* y(k,94) - prod(k,85) = (rxt(k,316)*y(k,125) +rxt(k,335)*y(k,129))*y(k,30) - loss(k,107) = ((rxt(k,133) +rxt(k,135))* y(k,68) +rxt(k,134)* y(k,69) & - +rxt(k,138)* y(k,96) +rxt(k,382)* y(k,99) +rxt(k,383)* y(k,100) & - +rxt(k,141)* y(k,102) +rxt(k,144)* y(k,104) +rxt(k,381)* y(k,105) & - +rxt(k,585)* y(k,107) +rxt(k,583)* y(k,115) +rxt(k,303)* y(k,116) & - +rxt(k,304)* y(k,117) +rxt(k,306)* y(k,118) +rxt(k,308)* y(k,119) & - +rxt(k,384)* y(k,120) +rxt(k,584)* y(k,126) +rxt(k,326)* y(k,127) & - +rxt(k,380)* y(k,130) + het_rates(k,95))* y(k,95) - prod(k,107) = (rxt(k,77) +rxt(k,78) +rxt(k,79) +rxt(k,80) +rxt(k,81) + & + prod(k,107) = (rxt(k,114)*y(k,92) +rxt(k,127)*y(k,95) +rxt(k,285)*y(k,109) + & + rxt(k,314)*y(k,125) +rxt(k,341)*y(k,132) +rxt(k,350)*y(k,133)) & + *y(k,25) + (rxt(k,130)*y(k,95) +rxt(k,289)*y(k,109) + & + rxt(k,298)*y(k,111) +rxt(k,318)*y(k,125) +rxt(k,345)*y(k,132) + & + rxt(k,356)*y(k,133))*y(k,49) + (rxt(k,116)*y(k,92) + & + rxt(k,286)*y(k,109) +rxt(k,351)*y(k,133))*y(k,28) & + + (rxt(k,112)*y(k,62) +rxt(k,113)*y(k,69))*y(k,91) +rxt(k,385) & + *y(k,89) +rxt(k,386)*y(k,90) + loss(k,94) = (rxt(k,106)* y(k,49) +rxt(k,199)* y(k,101) +rxt(k,164)* y(k,103) & + +rxt(k,182)* y(k,105) +rxt(k,252)* y(k,116) +rxt(k,234)* y(k,117) & + +rxt(k,217)* y(k,120) +rxt(k,159)* y(k,126) + rxt(k,385) & + + het_rates(k,89))* y(k,89) + prod(k,94) =rxt(k,107)*y(k,137)*y(k,88) + loss(k,93) = (rxt(k,187)* y(k,101) + (rxt(k,181) +rxt(k,267))* y(k,103) & + + (rxt(k,169) +rxt(k,268))* y(k,105) +rxt(k,240)* y(k,116) & + +rxt(k,222)* y(k,117) +rxt(k,205)* y(k,120) +rxt(k,257)* y(k,126) & + + rxt(k,386) + het_rates(k,90))* y(k,90) + prod(k,93) = (rxt(k,106)*y(k,89) +rxt(k,108)*y(k,88))*y(k,49) + loss(k,82) = ((rxt(k,111) +rxt(k,112))* y(k,62) +rxt(k,113)* y(k,69) & + + het_rates(k,91))* y(k,91) + prod(k,82) = (rxt(k,128)*y(k,95) +rxt(k,315)*y(k,125) +rxt(k,342)*y(k,132)) & + *y(k,28) +rxt(k,115)*y(k,92)*y(k,25) + loss(k,113) = ((rxt(k,114) +rxt(k,115))* y(k,25) +rxt(k,116)* y(k,28) & + +rxt(k,117)* y(k,40) +rxt(k,124)* y(k,51) +rxt(k,280)* y(k,62) & + +rxt(k,281)* y(k,63) +rxt(k,125)* y(k,69) +rxt(k,126)* y(k,71) & + +rxt(k,186)* y(k,101) + (rxt(k,170) +rxt(k,258))* y(k,103) & + + (rxt(k,168) +rxt(k,265))* y(k,105) +rxt(k,239)* y(k,116) & + +rxt(k,221)* y(k,117) +rxt(k,204)* y(k,120) +rxt(k,256)* y(k,126) & + +rxt(k,119)* y(k,137) + rxt(k,63) + het_rates(k,92))* y(k,92) + prod(k,113) = (rxt(k,330)*y(k,128) +rxt(k,352)*y(k,133))*y(k,32) & + + (rxt(k,64) +rxt(k,283))*y(k,94) + (rxt(k,129)*y(k,40) + & + rxt(k,131)*y(k,69))*y(k,95) + loss(k,92) = (rxt(k,194)* y(k,101) + (rxt(k,247) +rxt(k,271))* y(k,103) & + + (rxt(k,176) +rxt(k,259))* y(k,105) +rxt(k,246)* y(k,116) & + +rxt(k,229)* y(k,117) +rxt(k,211)* y(k,120) +rxt(k,153)* y(k,126) & + + rxt(k,284) + het_rates(k,93))* y(k,93) + prod(k,92) =rxt(k,118)*y(k,137)*y(k,94) + loss(k,102) = ((rxt(k,122) +rxt(k,123))* y(k,62) + (rxt(k,120) +rxt(k,121)) & + * y(k,63) +rxt(k,196)* y(k,101) + (rxt(k,158) +rxt(k,260))* y(k,103) & + + (rxt(k,178) +rxt(k,261))* y(k,105) +rxt(k,249)* y(k,116) & + +rxt(k,231)* y(k,117) +rxt(k,213)* y(k,120) +rxt(k,155)* y(k,126) & + +rxt(k,118)* y(k,137) + rxt(k,64) + rxt(k,283) + het_rates(k,94)) & + * y(k,94) + prod(k,102) =rxt(k,119)*y(k,137)*y(k,92) +rxt(k,284)*y(k,93) + loss(k,108) = (rxt(k,127)* y(k,25) +rxt(k,128)* y(k,28) +rxt(k,129)* y(k,40) & + +rxt(k,130)* y(k,49) +rxt(k,131)* y(k,69) +rxt(k,132)* y(k,72) & + +rxt(k,191)* y(k,101) +rxt(k,225)* y(k,103) +rxt(k,174)* y(k,105) & + +rxt(k,244)* y(k,116) +rxt(k,227)* y(k,117) +rxt(k,209)* y(k,120) & + +rxt(k,151)* y(k,126) + rxt(k,65) + het_rates(k,95))* y(k,95) + prod(k,108) = (rxt(k,316)*y(k,125) +rxt(k,335)*y(k,129))*y(k,32) + loss(k,114) = ((rxt(k,133) +rxt(k,135))* y(k,71) +rxt(k,134)* y(k,72) & + +rxt(k,138)* y(k,97) +rxt(k,382)* y(k,100) +rxt(k,383)* y(k,101) & + +rxt(k,141)* y(k,103) +rxt(k,144)* y(k,105) +rxt(k,381)* y(k,106) & + +rxt(k,584)* y(k,108) +rxt(k,582)* y(k,116) +rxt(k,303)* y(k,117) & + +rxt(k,304)* y(k,118) +rxt(k,306)* y(k,119) +rxt(k,308)* y(k,120) & + +rxt(k,384)* y(k,121) +rxt(k,583)* y(k,126) +rxt(k,326)* y(k,127) & + +rxt(k,380)* y(k,130) + het_rates(k,96))* y(k,96) + prod(k,114) = (rxt(k,77) +rxt(k,78) +rxt(k,79) +rxt(k,80) +rxt(k,81) + & rxt(k,82) +rxt(k,324)*y(k,125) +rxt(k,333)*y(k,128) + & - rxt(k,347)*y(k,132) +rxt(k,360)*y(k,133))*y(k,67) + (rxt(k,83) + & + rxt(k,347)*y(k,132) +rxt(k,360)*y(k,133))*y(k,69) + (rxt(k,83) + & rxt(k,84) +rxt(k,85) +rxt(k,86) +rxt(k,87) +rxt(k,90) +rxt(k,91) + & - rxt(k,92))*y(k,68) + (rxt(k,99) +rxt(k,358) +rxt(k,136)*y(k,60) + & - rxt(k,353)*y(k,39) +rxt(k,361)*y(k,123))*y(k,133) + (rxt(k,93) + & - rxt(k,137) +rxt(k,317)*y(k,38) +rxt(k,321)*y(k,123))*y(k,125) & - + (rxt(k,105)*y(k,87) +rxt(k,344)*y(k,132))*y(k,38) + (rxt(k,96) + & - rxt(k,332)*y(k,69))*y(k,128) +rxt(k,66)*y(k,54) +rxt(k,16)*y(k,60) & - +rxt(k,75)*y(k,108) +rxt(k,76)*y(k,110) +rxt(k,98)*y(k,132) - loss(k,36) = (rxt(k,138)* y(k,95) +rxt(k,139)* y(k,137) + het_rates(k,96)) & - * y(k,96) - prod(k,36) =rxt(k,327)*y(k,137)*y(k,127) - loss(k,67) = (rxt(k,189)* y(k,100) +rxt(k,203)* y(k,102) +rxt(k,172) & - * y(k,104) +rxt(k,242)* y(k,115) +rxt(k,224)* y(k,116) +rxt(k,207) & - * y(k,119) +rxt(k,149)* y(k,126) + het_rates(k,97))* y(k,97) - prod(k,67) =rxt(k,343)*y(k,132)*y(k,30) - loss(k,88) = (rxt(k,493)* y(k,4) +rxt(k,533)* y(k,20) +rxt(k,461)* y(k,26) & - + (rxt(k,408) +rxt(k,409) +rxt(k,410))* y(k,38) +rxt(k,439)* y(k,60) & - +rxt(k,444)* y(k,61) +rxt(k,434)* y(k,62) +rxt(k,412)* y(k,67) & - +rxt(k,413)* y(k,69) +rxt(k,487)* y(k,85) + (rxt(k,454) +rxt(k,455)) & - * y(k,86) + 2._r8*rxt(k,422)* y(k,98) +rxt(k,310)* y(k,119) & - +rxt(k,417)* y(k,131) + rxt(k,559) + het_rates(k,98))* y(k,98) - prod(k,88) = (rxt(k,516)*y(k,17) +rxt(k,519)*y(k,19) +rxt(k,416)*y(k,41) + & - rxt(k,419)*y(k,69) +rxt(k,437)*y(k,62) +rxt(k,468)*y(k,26) + & - rxt(k,498)*y(k,4) +rxt(k,537)*y(k,29) +rxt(k,554)*y(k,77) + & - .500_r8*rxt(k,558)*y(k,33))*y(k,131) + (rxt(k,450)*y(k,86) + & - rxt(k,486)*y(k,85) +rxt(k,530)*y(k,62) +rxt(k,531)*y(k,67))*y(k,16) & - + (rxt(k,515)*y(k,17) +rxt(k,518)*y(k,19) +rxt(k,453)*y(k,41)) & - *y(k,86) + (rxt(k,317)*y(k,38) +rxt(k,318)*y(k,47) + & - rxt(k,319)*y(k,49))*y(k,125) + (rxt(k,457)*y(k,26) + & - rxt(k,534)*y(k,60))*y(k,20) + (rxt(k,11) +rxt(k,448))*y(k,50) & - + (rxt(k,347)*y(k,132) +rxt(k,407)*y(k,41))*y(k,67) & - +rxt(k,539)*y(k,122)*y(k,22) +rxt(k,411)*y(k,68)*y(k,38) & - +rxt(k,130)*y(k,94)*y(k,47) - loss(k,48) = (rxt(k,382)* y(k,95) +rxt(k,374)* y(k,137) + rxt(k,373) & - + het_rates(k,99))* y(k,99) - prod(k,48) = (rxt(k,139)*y(k,96) +rxt(k,372)*y(k,105))*y(k,137) +rxt(k,375) & - *y(k,100) - loss(k,95) = (rxt(k,195)* y(k,87) +rxt(k,199)* y(k,88) +rxt(k,187)* y(k,89) & - +rxt(k,186)* y(k,91) +rxt(k,194)* y(k,92) +rxt(k,196)* y(k,93) & - +rxt(k,191)* y(k,94) +rxt(k,383)* y(k,95) +rxt(k,189)* y(k,97) & - +rxt(k,201)* y(k,108) +rxt(k,197)* y(k,109) +rxt(k,188)* y(k,110) & - +rxt(k,200)* y(k,111) +rxt(k,193)* y(k,112) +rxt(k,198)* y(k,113) & - +rxt(k,185)* y(k,114) +rxt(k,190)* y(k,125) +rxt(k,376)* y(k,137) & - + rxt(k,375) + het_rates(k,100))* y(k,100) - prod(k,95) = (rxt(k,305)*y(k,117) +rxt(k,374)*y(k,99))*y(k,137) +rxt(k,377) & - *y(k,102) - loss(k,30) = (rxt(k,140)* y(k,137) + het_rates(k,101))* y(k,101) - prod(k,30) =rxt(k,142)*y(k,102)*y(k,56) - loss(k,111) = (rxt(k,142)* y(k,56) +rxt(k,147)* y(k,87) +rxt(k,164)* y(k,88) & - + (rxt(k,181) +rxt(k,267))* y(k,89) + (rxt(k,170) +rxt(k,258)) & - * y(k,91) + (rxt(k,247) +rxt(k,271))* y(k,92) + (rxt(k,158) + & - rxt(k,260))* y(k,93) +rxt(k,225)* y(k,94) +rxt(k,141)* y(k,95) & - +rxt(k,203)* y(k,97) +rxt(k,166)* y(k,108) +rxt(k,162)* y(k,109) & - + (rxt(k,192) +rxt(k,264))* y(k,110) +rxt(k,165)* y(k,111) & - + (rxt(k,236) +rxt(k,262))* y(k,112) +rxt(k,163)* y(k,113) & - + (rxt(k,146) +rxt(k,269))* y(k,114) +rxt(k,214)* y(k,125) & - +rxt(k,378)* y(k,137) + rxt(k,377) + het_rates(k,102))* y(k,102) - prod(k,111) = (rxt(k,140)*y(k,101) +rxt(k,376)*y(k,100))*y(k,137) +rxt(k,379) & - *y(k,104) - loss(k,31) = (rxt(k,143)* y(k,137) + het_rates(k,103))* y(k,103) - prod(k,31) =rxt(k,145)*y(k,104)*y(k,56) - loss(k,108) = (rxt(k,145)* y(k,56) +rxt(k,177)* y(k,87) +rxt(k,182)* y(k,88) & - + (rxt(k,169) +rxt(k,268))* y(k,89) + (rxt(k,168) +rxt(k,265)) & - * y(k,91) + (rxt(k,176) +rxt(k,259))* y(k,92) + (rxt(k,178) + & - rxt(k,261))* y(k,93) +rxt(k,174)* y(k,94) +rxt(k,144)* y(k,95) & - +rxt(k,172)* y(k,97) +rxt(k,184)* y(k,108) +rxt(k,179)* y(k,109) & - + (rxt(k,171) +rxt(k,266))* y(k,110) +rxt(k,183)* y(k,111) & - + (rxt(k,175) +rxt(k,263))* y(k,112) +rxt(k,180)* y(k,113) & - + (rxt(k,167) +rxt(k,270))* y(k,114) +rxt(k,173)* y(k,125) & - + rxt(k,379) + het_rates(k,104))* y(k,104) - prod(k,108) = (rxt(k,143)*y(k,103) +rxt(k,378)*y(k,102))*y(k,137) - loss(k,51) = (rxt(k,381)* y(k,95) +rxt(k,372)* y(k,137) + het_rates(k,105)) & - * y(k,105) - prod(k,51) = (rxt(k,309)*y(k,38) +rxt(k,310)*y(k,98) +rxt(k,311)*y(k,131)) & - *y(k,119) +rxt(k,373)*y(k,99) +rxt(k,328)*y(k,137)*y(k,127) - loss(k,55) = (rxt(k,424)* y(k,67) +rxt(k,425)* y(k,68) +rxt(k,597)* y(k,134) & - + het_rates(k,106))* y(k,106) - prod(k,55) = (.800_r8*rxt(k,583)*y(k,115) +.900_r8*rxt(k,585)*y(k,107)) & - *y(k,95) +rxt(k,587)*y(k,107)*y(k,67) - loss(k,47) = ((rxt(k,587) +rxt(k,588))* y(k,67) +rxt(k,586)* y(k,68) & - +rxt(k,585)* y(k,95) + het_rates(k,107))* y(k,107) - prod(k,47) =rxt(k,600)*y(k,135) +rxt(k,605)*y(k,136) - loss(k,91) = (rxt(k,286)* y(k,26) +rxt(k,287)* y(k,38) +rxt(k,289)* y(k,47) & - +rxt(k,290)* y(k,49) +rxt(k,291)* y(k,61) +rxt(k,292)* y(k,69) & - +rxt(k,285)* y(k,86) +rxt(k,201)* y(k,100) +rxt(k,166)* y(k,102) & - +rxt(k,184)* y(k,104) +rxt(k,254)* y(k,115) +rxt(k,237)* y(k,116) & - +rxt(k,219)* y(k,119) +rxt(k,161)* y(k,126) +rxt(k,288)* y(k,137) & - + rxt(k,75) + het_rates(k,108))* y(k,108) - prod(k,91) = (rxt(k,110)*y(k,87) +rxt(k,278)*y(k,128) +rxt(k,320)*y(k,125) + & - rxt(k,346)*y(k,132) +rxt(k,359)*y(k,133))*y(k,61) & - + (rxt(k,111)*y(k,90) +rxt(k,123)*y(k,93) +rxt(k,279)*y(k,128) + & - rxt(k,280)*y(k,91))*y(k,60) + (rxt(k,301)*y(k,67) + & - rxt(k,302)*y(k,69))*y(k,110) +rxt(k,273)*y(k,109) - loss(k,73) = (rxt(k,197)* y(k,100) +rxt(k,162)* y(k,102) +rxt(k,179) & - * y(k,104) +rxt(k,250)* y(k,115) +rxt(k,232)* y(k,116) +rxt(k,215) & - * y(k,119) +rxt(k,156)* y(k,126) + rxt(k,273) + het_rates(k,109)) & - * y(k,109) - prod(k,73) =rxt(k,122)*y(k,93)*y(k,60) +rxt(k,288)*y(k,137)*y(k,108) - loss(k,87) = ((rxt(k,276) +rxt(k,298))* y(k,47) +rxt(k,300)* y(k,49) & - +rxt(k,301)* y(k,67) +rxt(k,302)* y(k,69) +rxt(k,188)* y(k,100) & - + (rxt(k,192) +rxt(k,264))* y(k,102) + (rxt(k,171) +rxt(k,266)) & - * y(k,104) +rxt(k,241)* y(k,115) +rxt(k,223)* y(k,116) +rxt(k,206) & - * y(k,119) +rxt(k,148)* y(k,126) +rxt(k,296)* y(k,137) + rxt(k,76) & - + het_rates(k,110))* y(k,110) - prod(k,87) = (rxt(k,109)*y(k,87) +rxt(k,124)*y(k,91) +rxt(k,290)*y(k,108) + & - rxt(k,319)*y(k,125) +rxt(k,357)*y(k,133))*y(k,49) & - + (rxt(k,120)*y(k,93) +rxt(k,277)*y(k,128) +rxt(k,281)*y(k,91) + & - rxt(k,291)*y(k,108))*y(k,61) +rxt(k,272)*y(k,128)*y(k,60) & - +rxt(k,292)*y(k,108)*y(k,69) +rxt(k,282)*y(k,112) +rxt(k,275) & - *y(k,114) - loss(k,79) = (rxt(k,293)* y(k,56) +rxt(k,200)* y(k,100) +rxt(k,165)* y(k,102) & - +rxt(k,183)* y(k,104) +rxt(k,253)* y(k,115) +rxt(k,235)* y(k,116) & - +rxt(k,218)* y(k,119) +rxt(k,160)* y(k,126) + rxt(k,274) & + rxt(k,92))*y(k,71) + (rxt(k,99) +rxt(k,358) +rxt(k,136)*y(k,62) + & + rxt(k,353)*y(k,41) +rxt(k,361)*y(k,123))*y(k,133) + (rxt(k,93) + & + rxt(k,137) +rxt(k,317)*y(k,40) +rxt(k,321)*y(k,123))*y(k,125) & + + (rxt(k,105)*y(k,88) +rxt(k,344)*y(k,132))*y(k,40) + (rxt(k,96) + & + rxt(k,332)*y(k,72))*y(k,128) +rxt(k,66)*y(k,56) +rxt(k,16)*y(k,62) & + +rxt(k,75)*y(k,109) +rxt(k,76)*y(k,111) +rxt(k,98)*y(k,132) + loss(k,55) = (rxt(k,138)* y(k,96) +rxt(k,139)* y(k,137) + het_rates(k,97)) & + * y(k,97) + prod(k,55) =rxt(k,327)*y(k,137)*y(k,127) + loss(k,90) = (rxt(k,189)* y(k,101) +rxt(k,203)* y(k,103) +rxt(k,172) & + * y(k,105) +rxt(k,242)* y(k,116) +rxt(k,224)* y(k,117) +rxt(k,207) & + * y(k,120) +rxt(k,149)* y(k,126) + het_rates(k,98))* y(k,98) + prod(k,90) =rxt(k,343)*y(k,132)*y(k,32) + loss(k,110) = (rxt(k,487)* y(k,3) +rxt(k,493)* y(k,5) +rxt(k,533)* y(k,21) & + + (rxt(k,454) +rxt(k,455))* y(k,25) +rxt(k,461)* y(k,28) & + + (rxt(k,408) +rxt(k,409) +rxt(k,410))* y(k,40) +rxt(k,439)* y(k,62) & + +rxt(k,444)* y(k,63) +rxt(k,434)* y(k,64) +rxt(k,412)* y(k,69) & + +rxt(k,413)* y(k,72) + 2._r8*rxt(k,422)* y(k,99) +rxt(k,310) & + * y(k,120) +rxt(k,417)* y(k,131) + rxt(k,558) + het_rates(k,99)) & + * y(k,99) + prod(k,110) = (rxt(k,416)*y(k,43) +rxt(k,419)*y(k,72) +rxt(k,437)*y(k,64) + & + rxt(k,468)*y(k,28) +rxt(k,498)*y(k,5) +rxt(k,516)*y(k,18) + & + rxt(k,519)*y(k,20) +rxt(k,540)*y(k,31) +rxt(k,546)*y(k,80) + & + .500_r8*rxt(k,556)*y(k,35))*y(k,131) + (rxt(k,450)*y(k,25) + & + rxt(k,486)*y(k,3) +rxt(k,530)*y(k,64) +rxt(k,531)*y(k,69))*y(k,17) & + + (rxt(k,453)*y(k,43) +rxt(k,515)*y(k,18) +rxt(k,518)*y(k,20)) & + *y(k,25) + (rxt(k,317)*y(k,40) +rxt(k,318)*y(k,49) + & + rxt(k,319)*y(k,51))*y(k,125) + (rxt(k,457)*y(k,28) + & + rxt(k,534)*y(k,62))*y(k,21) + (rxt(k,11) +rxt(k,448))*y(k,52) & + + (rxt(k,347)*y(k,132) +rxt(k,407)*y(k,43))*y(k,69) & + +rxt(k,538)*y(k,70)*y(k,23) +rxt(k,411)*y(k,71)*y(k,40) & + +rxt(k,130)*y(k,95)*y(k,49) + loss(k,66) = (rxt(k,382)* y(k,96) +rxt(k,374)* y(k,137) + rxt(k,373) & + + het_rates(k,100))* y(k,100) + prod(k,66) = (rxt(k,139)*y(k,97) +rxt(k,372)*y(k,106))*y(k,137) +rxt(k,375) & + *y(k,101) + loss(k,123) = (rxt(k,195)* y(k,88) +rxt(k,199)* y(k,89) +rxt(k,187)* y(k,90) & + +rxt(k,186)* y(k,92) +rxt(k,194)* y(k,93) +rxt(k,196)* y(k,94) & + +rxt(k,191)* y(k,95) +rxt(k,383)* y(k,96) +rxt(k,189)* y(k,98) & + +rxt(k,201)* y(k,109) +rxt(k,197)* y(k,110) +rxt(k,188)* y(k,111) & + +rxt(k,200)* y(k,112) +rxt(k,193)* y(k,113) +rxt(k,198)* y(k,114) & + +rxt(k,185)* y(k,115) +rxt(k,190)* y(k,125) +rxt(k,376)* y(k,137) & + + rxt(k,375) + het_rates(k,101))* y(k,101) + prod(k,123) = (rxt(k,305)*y(k,118) +rxt(k,374)*y(k,100))*y(k,137) +rxt(k,377) & + *y(k,103) + loss(k,44) = (rxt(k,140)* y(k,137) + het_rates(k,102))* y(k,102) + prod(k,44) =rxt(k,142)*y(k,103)*y(k,58) + loss(k,128) = (rxt(k,142)* y(k,58) +rxt(k,147)* y(k,88) +rxt(k,164)* y(k,89) & + + (rxt(k,181) +rxt(k,267))* y(k,90) + (rxt(k,170) +rxt(k,258)) & + * y(k,92) + (rxt(k,247) +rxt(k,271))* y(k,93) + (rxt(k,158) + & + rxt(k,260))* y(k,94) +rxt(k,225)* y(k,95) +rxt(k,141)* y(k,96) & + +rxt(k,203)* y(k,98) +rxt(k,166)* y(k,109) +rxt(k,162)* y(k,110) & + + (rxt(k,192) +rxt(k,264))* y(k,111) +rxt(k,165)* y(k,112) & + + (rxt(k,236) +rxt(k,262))* y(k,113) +rxt(k,163)* y(k,114) & + + (rxt(k,146) +rxt(k,269))* y(k,115) +rxt(k,214)* y(k,125) & + +rxt(k,378)* y(k,137) + rxt(k,377) + het_rates(k,103))* y(k,103) + prod(k,128) = (rxt(k,140)*y(k,102) +rxt(k,376)*y(k,101))*y(k,137) +rxt(k,379) & + *y(k,105) + loss(k,45) = (rxt(k,143)* y(k,137) + het_rates(k,104))* y(k,104) + prod(k,45) =rxt(k,145)*y(k,105)*y(k,58) + loss(k,122) = (rxt(k,145)* y(k,58) +rxt(k,177)* y(k,88) +rxt(k,182)* y(k,89) & + + (rxt(k,169) +rxt(k,268))* y(k,90) + (rxt(k,168) +rxt(k,265)) & + * y(k,92) + (rxt(k,176) +rxt(k,259))* y(k,93) + (rxt(k,178) + & + rxt(k,261))* y(k,94) +rxt(k,174)* y(k,95) +rxt(k,144)* y(k,96) & + +rxt(k,172)* y(k,98) +rxt(k,184)* y(k,109) +rxt(k,179)* y(k,110) & + + (rxt(k,171) +rxt(k,266))* y(k,111) +rxt(k,183)* y(k,112) & + + (rxt(k,175) +rxt(k,263))* y(k,113) +rxt(k,180)* y(k,114) & + + (rxt(k,167) +rxt(k,270))* y(k,115) +rxt(k,173)* y(k,125) & + + rxt(k,379) + het_rates(k,105))* y(k,105) + prod(k,122) = (rxt(k,143)*y(k,104) +rxt(k,378)*y(k,103))*y(k,137) + loss(k,72) = (rxt(k,381)* y(k,96) +rxt(k,372)* y(k,137) + het_rates(k,106)) & + * y(k,106) + prod(k,72) = (rxt(k,309)*y(k,40) +rxt(k,310)*y(k,99) +rxt(k,311)*y(k,131)) & + *y(k,120) +rxt(k,373)*y(k,100) +rxt(k,328)*y(k,137)*y(k,127) + loss(k,74) = (rxt(k,424)* y(k,69) +rxt(k,425)* y(k,71) +rxt(k,596)* y(k,134) & + + het_rates(k,107))* y(k,107) + prod(k,74) = (.800_r8*rxt(k,582)*y(k,116) +.900_r8*rxt(k,584)*y(k,108)) & + *y(k,96) +rxt(k,586)*y(k,108)*y(k,69) + loss(k,64) = ((rxt(k,586) +rxt(k,587))* y(k,69) +rxt(k,585)* y(k,71) & + +rxt(k,584)* y(k,96) + het_rates(k,108))* y(k,108) + prod(k,64) =rxt(k,599)*y(k,135) +rxt(k,604)*y(k,136) + loss(k,111) = (rxt(k,285)* y(k,25) +rxt(k,286)* y(k,28) +rxt(k,287)* y(k,40) & + +rxt(k,289)* y(k,49) +rxt(k,290)* y(k,51) +rxt(k,291)* y(k,63) & + +rxt(k,292)* y(k,72) +rxt(k,201)* y(k,101) +rxt(k,166)* y(k,103) & + +rxt(k,184)* y(k,105) +rxt(k,254)* y(k,116) +rxt(k,237)* y(k,117) & + +rxt(k,219)* y(k,120) +rxt(k,161)* y(k,126) +rxt(k,288)* y(k,137) & + + rxt(k,75) + het_rates(k,109))* y(k,109) + prod(k,111) = (rxt(k,110)*y(k,88) +rxt(k,278)*y(k,128) +rxt(k,320)*y(k,125) + & + rxt(k,346)*y(k,132) +rxt(k,359)*y(k,133))*y(k,63) & + + (rxt(k,111)*y(k,91) +rxt(k,123)*y(k,94) +rxt(k,279)*y(k,128) + & + rxt(k,280)*y(k,92))*y(k,62) + (rxt(k,301)*y(k,69) + & + rxt(k,302)*y(k,72))*y(k,111) +rxt(k,273)*y(k,110) + loss(k,95) = (rxt(k,197)* y(k,101) +rxt(k,162)* y(k,103) +rxt(k,179) & + * y(k,105) +rxt(k,250)* y(k,116) +rxt(k,232)* y(k,117) +rxt(k,215) & + * y(k,120) +rxt(k,156)* y(k,126) + rxt(k,273) + het_rates(k,110)) & + * y(k,110) + prod(k,95) =rxt(k,122)*y(k,94)*y(k,62) +rxt(k,288)*y(k,137)*y(k,109) + loss(k,109) = ((rxt(k,276) +rxt(k,298))* y(k,49) +rxt(k,300)* y(k,51) & + +rxt(k,301)* y(k,69) +rxt(k,302)* y(k,72) +rxt(k,188)* y(k,101) & + + (rxt(k,192) +rxt(k,264))* y(k,103) + (rxt(k,171) +rxt(k,266)) & + * y(k,105) +rxt(k,241)* y(k,116) +rxt(k,223)* y(k,117) +rxt(k,206) & + * y(k,120) +rxt(k,148)* y(k,126) +rxt(k,296)* y(k,137) + rxt(k,76) & + het_rates(k,111))* y(k,111) - prod(k,79) =rxt(k,294)*y(k,137)*y(k,112) - loss(k,81) = (rxt(k,295)* y(k,49) +rxt(k,297)* y(k,56) +rxt(k,193)* y(k,100) & - + (rxt(k,236) +rxt(k,262))* y(k,102) + (rxt(k,175) +rxt(k,263)) & - * y(k,104) +rxt(k,245)* y(k,115) +rxt(k,228)* y(k,116) +rxt(k,210) & - * y(k,119) +rxt(k,152)* y(k,126) +rxt(k,294)* y(k,137) + rxt(k,282) & + prod(k,109) = (rxt(k,109)*y(k,88) +rxt(k,124)*y(k,92) +rxt(k,290)*y(k,109) + & + rxt(k,319)*y(k,125) +rxt(k,357)*y(k,133))*y(k,51) & + + (rxt(k,120)*y(k,94) +rxt(k,277)*y(k,128) +rxt(k,281)*y(k,92) + & + rxt(k,291)*y(k,109))*y(k,63) +rxt(k,272)*y(k,128)*y(k,62) & + +rxt(k,292)*y(k,109)*y(k,72) +rxt(k,282)*y(k,113) +rxt(k,275) & + *y(k,115) + loss(k,100) = (rxt(k,293)* y(k,58) +rxt(k,200)* y(k,101) +rxt(k,165) & + * y(k,103) +rxt(k,183)* y(k,105) +rxt(k,253)* y(k,116) +rxt(k,235) & + * y(k,117) +rxt(k,218)* y(k,120) +rxt(k,160)* y(k,126) + rxt(k,274) & + het_rates(k,112))* y(k,112) - prod(k,81) =rxt(k,121)*y(k,93)*y(k,61) +rxt(k,296)*y(k,137)*y(k,110) & - +rxt(k,274)*y(k,111) - loss(k,76) = (rxt(k,299)* y(k,49) +rxt(k,198)* y(k,100) +rxt(k,163)* y(k,102) & - +rxt(k,180)* y(k,104) +rxt(k,251)* y(k,115) +rxt(k,233)* y(k,116) & - +rxt(k,216)* y(k,119) +rxt(k,157)* y(k,126) + het_rates(k,113)) & - * y(k,113) - prod(k,76) =rxt(k,276)*y(k,110)*y(k,47) - loss(k,78) = (rxt(k,185)* y(k,100) + (rxt(k,146) +rxt(k,269))* y(k,102) & - + (rxt(k,167) +rxt(k,270))* y(k,104) +rxt(k,238)* y(k,115) & - +rxt(k,220)* y(k,116) +rxt(k,202)* y(k,119) +rxt(k,255)* y(k,126) & - + rxt(k,275) + het_rates(k,114))* y(k,114) - prod(k,78) = (rxt(k,295)*y(k,112) +rxt(k,299)*y(k,113) +rxt(k,300)*y(k,110)) & - *y(k,49) + (rxt(k,293)*y(k,111) +rxt(k,297)*y(k,112))*y(k,56) - loss(k,92) = (rxt(k,368)* y(k,30) +rxt(k,248)* y(k,87) +rxt(k,252)* y(k,88) & - +rxt(k,240)* y(k,89) +rxt(k,239)* y(k,91) +rxt(k,246)* y(k,92) & - +rxt(k,249)* y(k,93) +rxt(k,244)* y(k,94) +rxt(k,583)* y(k,95) & - +rxt(k,242)* y(k,97) +rxt(k,254)* y(k,108) +rxt(k,250)* y(k,109) & - +rxt(k,241)* y(k,110) +rxt(k,253)* y(k,111) +rxt(k,245)* y(k,112) & - +rxt(k,251)* y(k,113) +rxt(k,238)* y(k,114) +rxt(k,243)* y(k,125) & - +rxt(k,365)* y(k,137) + rxt(k,370) + het_rates(k,115))* y(k,115) - prod(k,92) = (rxt(k,593) +rxt(k,592)*y(k,54) +rxt(k,594)*y(k,60))*y(k,126) & - +rxt(k,16)*y(k,60) +rxt(k,587)*y(k,107)*y(k,67) +rxt(k,591)*y(k,121) & - *y(k,68) +rxt(k,369)*y(k,118) +rxt(k,371)*y(k,120) +rxt(k,596) & + prod(k,100) =rxt(k,294)*y(k,137)*y(k,113) + loss(k,103) = (rxt(k,295)* y(k,51) +rxt(k,297)* y(k,58) +rxt(k,193)* y(k,101) & + + (rxt(k,236) +rxt(k,262))* y(k,103) + (rxt(k,175) +rxt(k,263)) & + * y(k,105) +rxt(k,245)* y(k,116) +rxt(k,228)* y(k,117) +rxt(k,210) & + * y(k,120) +rxt(k,152)* y(k,126) +rxt(k,294)* y(k,137) + rxt(k,282) & + + het_rates(k,113))* y(k,113) + prod(k,103) =rxt(k,121)*y(k,94)*y(k,63) +rxt(k,296)*y(k,137)*y(k,111) & + +rxt(k,274)*y(k,112) + loss(k,96) = (rxt(k,299)* y(k,51) +rxt(k,198)* y(k,101) +rxt(k,163)* y(k,103) & + +rxt(k,180)* y(k,105) +rxt(k,251)* y(k,116) +rxt(k,233)* y(k,117) & + +rxt(k,216)* y(k,120) +rxt(k,157)* y(k,126) + het_rates(k,114)) & + * y(k,114) + prod(k,96) =rxt(k,276)*y(k,111)*y(k,49) + loss(k,99) = (rxt(k,185)* y(k,101) + (rxt(k,146) +rxt(k,269))* y(k,103) & + + (rxt(k,167) +rxt(k,270))* y(k,105) +rxt(k,238)* y(k,116) & + +rxt(k,220)* y(k,117) +rxt(k,202)* y(k,120) +rxt(k,255)* y(k,126) & + + rxt(k,275) + het_rates(k,115))* y(k,115) + prod(k,99) = (rxt(k,295)*y(k,113) +rxt(k,299)*y(k,114) +rxt(k,300)*y(k,111)) & + *y(k,51) + (rxt(k,293)*y(k,112) +rxt(k,297)*y(k,113))*y(k,58) + loss(k,116) = (rxt(k,368)* y(k,32) +rxt(k,248)* y(k,88) +rxt(k,252)* y(k,89) & + +rxt(k,240)* y(k,90) +rxt(k,239)* y(k,92) +rxt(k,246)* y(k,93) & + +rxt(k,249)* y(k,94) +rxt(k,244)* y(k,95) +rxt(k,582)* y(k,96) & + +rxt(k,242)* y(k,98) +rxt(k,254)* y(k,109) +rxt(k,250)* y(k,110) & + +rxt(k,241)* y(k,111) +rxt(k,253)* y(k,112) +rxt(k,245)* y(k,113) & + +rxt(k,251)* y(k,114) +rxt(k,238)* y(k,115) +rxt(k,243)* y(k,125) & + +rxt(k,365)* y(k,137) + rxt(k,370) + het_rates(k,116))* y(k,116) + prod(k,116) = (rxt(k,592) +rxt(k,591)*y(k,56) +rxt(k,593)*y(k,62))*y(k,126) & + +rxt(k,16)*y(k,62) +rxt(k,586)*y(k,108)*y(k,69) +rxt(k,590)*y(k,122) & + *y(k,71) +rxt(k,369)*y(k,119) +rxt(k,371)*y(k,121) +rxt(k,595) & *y(k,134) - loss(k,93) = (rxt(k,230)* y(k,87) +rxt(k,234)* y(k,88) +rxt(k,222)* y(k,89) & - +rxt(k,221)* y(k,91) +rxt(k,229)* y(k,92) +rxt(k,231)* y(k,93) & - +rxt(k,227)* y(k,94) +rxt(k,303)* y(k,95) +rxt(k,224)* y(k,97) & - +rxt(k,237)* y(k,108) +rxt(k,232)* y(k,109) +rxt(k,223)* y(k,110) & - +rxt(k,235)* y(k,111) +rxt(k,228)* y(k,112) +rxt(k,233)* y(k,113) & - +rxt(k,220)* y(k,114) +rxt(k,226)* y(k,125) +rxt(k,367)* y(k,137) & - + het_rates(k,116))* y(k,116) - prod(k,93) =rxt(k,366)*y(k,137)*y(k,119) - loss(k,37) = (rxt(k,304)* y(k,95) +rxt(k,305)* y(k,137) + het_rates(k,117)) & - * y(k,117) - prod(k,37) =rxt(k,367)*y(k,137)*y(k,116) - loss(k,41) = (rxt(k,306)* y(k,95) +rxt(k,307)* y(k,137) + rxt(k,369) & - + het_rates(k,118))* y(k,118) - prod(k,41) = (rxt(k,312)*y(k,120) +rxt(k,368)*y(k,115))*y(k,30) - loss(k,96) = (rxt(k,309)* y(k,38) +rxt(k,212)* y(k,87) +rxt(k,217)* y(k,88) & - +rxt(k,205)* y(k,89) +rxt(k,204)* y(k,91) +rxt(k,211)* y(k,92) & - +rxt(k,213)* y(k,93) +rxt(k,209)* y(k,94) +rxt(k,308)* y(k,95) & - +rxt(k,207)* y(k,97) +rxt(k,310)* y(k,98) +rxt(k,219)* y(k,108) & - +rxt(k,215)* y(k,109) +rxt(k,206)* y(k,110) +rxt(k,218)* y(k,111) & - +rxt(k,210)* y(k,112) +rxt(k,216)* y(k,113) +rxt(k,202)* y(k,114) & - +rxt(k,208)* y(k,125) +rxt(k,311)* y(k,131) +rxt(k,366)* y(k,137) & + loss(k,117) = (rxt(k,230)* y(k,88) +rxt(k,234)* y(k,89) +rxt(k,222)* y(k,90) & + +rxt(k,221)* y(k,92) +rxt(k,229)* y(k,93) +rxt(k,231)* y(k,94) & + +rxt(k,227)* y(k,95) +rxt(k,303)* y(k,96) +rxt(k,224)* y(k,98) & + +rxt(k,237)* y(k,109) +rxt(k,232)* y(k,110) +rxt(k,223)* y(k,111) & + +rxt(k,235)* y(k,112) +rxt(k,228)* y(k,113) +rxt(k,233)* y(k,114) & + +rxt(k,220)* y(k,115) +rxt(k,226)* y(k,125) +rxt(k,367)* y(k,137) & + + het_rates(k,117))* y(k,117) + prod(k,117) =rxt(k,366)*y(k,137)*y(k,120) + loss(k,56) = (rxt(k,304)* y(k,96) +rxt(k,305)* y(k,137) + het_rates(k,118)) & + * y(k,118) + prod(k,56) =rxt(k,367)*y(k,137)*y(k,117) + loss(k,69) = (rxt(k,306)* y(k,96) +rxt(k,307)* y(k,137) + rxt(k,369) & + het_rates(k,119))* y(k,119) - prod(k,96) = (rxt(k,307)*y(k,118) +rxt(k,313)*y(k,120) +rxt(k,365)*y(k,115)) & + prod(k,69) = (rxt(k,312)*y(k,121) +rxt(k,368)*y(k,116))*y(k,32) + loss(k,120) = (rxt(k,309)* y(k,40) +rxt(k,212)* y(k,88) +rxt(k,217)* y(k,89) & + +rxt(k,205)* y(k,90) +rxt(k,204)* y(k,92) +rxt(k,211)* y(k,93) & + +rxt(k,213)* y(k,94) +rxt(k,209)* y(k,95) +rxt(k,308)* y(k,96) & + +rxt(k,207)* y(k,98) +rxt(k,310)* y(k,99) +rxt(k,219)* y(k,109) & + +rxt(k,215)* y(k,110) +rxt(k,206)* y(k,111) +rxt(k,218)* y(k,112) & + +rxt(k,210)* y(k,113) +rxt(k,216)* y(k,114) +rxt(k,202)* y(k,115) & + +rxt(k,208)* y(k,125) +rxt(k,311)* y(k,131) +rxt(k,366)* y(k,137) & + + het_rates(k,120))* y(k,120) + prod(k,120) = (rxt(k,307)*y(k,119) +rxt(k,313)*y(k,121) +rxt(k,365)*y(k,116)) & *y(k,137) - loss(k,40) = (rxt(k,312)* y(k,30) +rxt(k,384)* y(k,95) +rxt(k,313)* y(k,137) & - + rxt(k,371) + het_rates(k,120))* y(k,120) - prod(k,40) =rxt(k,370)*y(k,115) - loss(k,56) = (rxt(k,589)* y(k,67) + (rxt(k,590) +rxt(k,591))* y(k,68) & - + het_rates(k,121))* y(k,121) - prod(k,56) =rxt(k,66)*y(k,54) +rxt(k,597)*y(k,134)*y(k,106) +rxt(k,606) & + loss(k,68) = (rxt(k,312)* y(k,32) +rxt(k,384)* y(k,96) +rxt(k,313)* y(k,137) & + + rxt(k,371) + het_rates(k,121))* y(k,121) + prod(k,68) =rxt(k,370)*y(k,116) + loss(k,76) = (rxt(k,588)* y(k,69) + (rxt(k,589) +rxt(k,590))* y(k,71) & + + het_rates(k,122))* y(k,122) + prod(k,76) =rxt(k,66)*y(k,56) +rxt(k,596)*y(k,134)*y(k,107) +rxt(k,605) & *y(k,136) - loss(k,84) = (rxt(k,475)* y(k,7) +rxt(k,476)* y(k,8) +rxt(k,502)* y(k,9) & - +rxt(k,477)* y(k,10) +rxt(k,478)* y(k,11) +rxt(k,479)* y(k,12) & - +rxt(k,480)* y(k,13) +rxt(k,481)* y(k,14) +rxt(k,525)* y(k,15) & - +rxt(k,526)* y(k,17) + (rxt(k,538) +rxt(k,539) +rxt(k,540))* y(k,22) & - +rxt(k,503)* y(k,23) +rxt(k,511)* y(k,31) +rxt(k,512)* y(k,32) & - +rxt(k,389)* y(k,39) +rxt(k,504)* y(k,40) + (rxt(k,505) +rxt(k,506)) & - * y(k,43) +rxt(k,527)* y(k,44) +rxt(k,528)* y(k,45) +rxt(k,529) & - * y(k,46) + (rxt(k,482) +rxt(k,483))* y(k,47) + (rxt(k,442) + & - rxt(k,443))* y(k,55) + (rxt(k,392) +rxt(k,393))* y(k,68) +rxt(k,394) & - * y(k,69) +rxt(k,390)* y(k,137) + rxt(k,391) + het_rates(k,122)) & - * y(k,122) - prod(k,84) = (rxt(k,6) +rxt(k,425)*y(k,106))*y(k,68) +rxt(k,7)*y(k,69) & - +.850_r8*rxt(k,584)*y(k,126)*y(k,95) +rxt(k,1)*y(k,137) - loss(k,59) = (rxt(k,396)* y(k,67) +rxt(k,397)* y(k,68) +rxt(k,321)* y(k,125) & + loss(k,83) = (rxt(k,396)* y(k,69) +rxt(k,397)* y(k,71) +rxt(k,321)* y(k,125) & +rxt(k,339)* y(k,130) +rxt(k,361)* y(k,133) + rxt(k,387) & + rxt(k,395) + het_rates(k,123))* y(k,123) - prod(k,59) = (rxt(k,399) +rxt(k,398)*y(k,30) +rxt(k,400)*y(k,67) + & - rxt(k,401)*y(k,68) +rxt(k,402)*y(k,69))*y(k,124) +rxt(k,7)*y(k,69) - loss(k,28) = (rxt(k,398)* y(k,30) +rxt(k,400)* y(k,67) +rxt(k,401)* y(k,68) & - +rxt(k,402)* y(k,69) + rxt(k,388) + rxt(k,399) + het_rates(k,124)) & + prod(k,83) = (rxt(k,399) +rxt(k,398)*y(k,32) +rxt(k,400)*y(k,69) + & + rxt(k,401)*y(k,71) +rxt(k,402)*y(k,72))*y(k,124) +rxt(k,7)*y(k,72) + loss(k,49) = (rxt(k,398)* y(k,32) +rxt(k,400)* y(k,69) +rxt(k,401)* y(k,71) & + +rxt(k,402)* y(k,72) + rxt(k,388) + rxt(k,399) + het_rates(k,124)) & * y(k,124) - prod(k,28) =rxt(k,392)*y(k,122)*y(k,68) - loss(k,102) = (rxt(k,315)* y(k,26) +rxt(k,316)* y(k,30) +rxt(k,317)* y(k,38) & - +rxt(k,318)* y(k,47) +rxt(k,319)* y(k,49) +rxt(k,320)* y(k,61) & - + (rxt(k,324) +rxt(k,325))* y(k,67) +rxt(k,322)* y(k,68) +rxt(k,323) & - * y(k,69) +rxt(k,314)* y(k,86) +rxt(k,190)* y(k,100) +rxt(k,214) & - * y(k,102) +rxt(k,173)* y(k,104) +rxt(k,243)* y(k,115) +rxt(k,226) & - * y(k,116) +rxt(k,208)* y(k,119) +rxt(k,321)* y(k,123) +rxt(k,150) & + prod(k,49) =rxt(k,392)*y(k,71)*y(k,70) + loss(k,125) = (rxt(k,314)* y(k,25) +rxt(k,315)* y(k,28) +rxt(k,316)* y(k,32) & + +rxt(k,317)* y(k,40) +rxt(k,318)* y(k,49) +rxt(k,319)* y(k,51) & + +rxt(k,320)* y(k,63) + (rxt(k,324) +rxt(k,325))* y(k,69) +rxt(k,322) & + * y(k,71) +rxt(k,323)* y(k,72) +rxt(k,190)* y(k,101) +rxt(k,214) & + * y(k,103) +rxt(k,173)* y(k,105) +rxt(k,243)* y(k,116) +rxt(k,226) & + * y(k,117) +rxt(k,208)* y(k,120) +rxt(k,321)* y(k,123) +rxt(k,150) & * y(k,126) + rxt(k,93) + rxt(k,137) + het_rates(k,125))* y(k,125) - prod(k,102) = (rxt(k,125)*y(k,91) +rxt(k,334)*y(k,128))*y(k,67) & - + (rxt(k,133)*y(k,95) +rxt(k,135)*y(k,95))*y(k,68) +rxt(k,65) & - *y(k,94) +rxt(k,97)*y(k,129) - loss(k,103) = (rxt(k,592)* y(k,54) +rxt(k,594)* y(k,60) +rxt(k,364)* y(k,68) & - +rxt(k,154)* y(k,87) +rxt(k,159)* y(k,88) +rxt(k,257)* y(k,89) & - +rxt(k,256)* y(k,91) +rxt(k,153)* y(k,92) +rxt(k,155)* y(k,93) & - +rxt(k,151)* y(k,94) +rxt(k,584)* y(k,95) +rxt(k,149)* y(k,97) & - +rxt(k,161)* y(k,108) +rxt(k,156)* y(k,109) +rxt(k,148)* y(k,110) & - +rxt(k,160)* y(k,111) +rxt(k,152)* y(k,112) +rxt(k,157)* y(k,113) & - +rxt(k,255)* y(k,114) +rxt(k,150)* y(k,125) +rxt(k,329)* y(k,137) & - + rxt(k,593) + het_rates(k,126))* y(k,126) - prod(k,103) = (rxt(k,84) +rxt(k,86) +rxt(k,586)*y(k,107) + & - rxt(k,590)*y(k,121) +rxt(k,598)*y(k,134) +rxt(k,602)*y(k,135)) & - *y(k,68) + (rxt(k,338)*y(k,67) +rxt(k,339)*y(k,123))*y(k,130) & - +rxt(k,595)*y(k,134)*y(k,30) +2.000_r8*rxt(k,150)*y(k,126)*y(k,125) & + prod(k,125) = (rxt(k,125)*y(k,92) +rxt(k,334)*y(k,128))*y(k,69) & + + (rxt(k,133)*y(k,96) +rxt(k,135)*y(k,96))*y(k,71) +rxt(k,65) & + *y(k,95) +rxt(k,97)*y(k,129) + loss(k,126) = (rxt(k,591)* y(k,56) +rxt(k,593)* y(k,62) +rxt(k,364)* y(k,71) & + +rxt(k,154)* y(k,88) +rxt(k,159)* y(k,89) +rxt(k,257)* y(k,90) & + +rxt(k,256)* y(k,92) +rxt(k,153)* y(k,93) +rxt(k,155)* y(k,94) & + +rxt(k,151)* y(k,95) +rxt(k,583)* y(k,96) +rxt(k,149)* y(k,98) & + +rxt(k,161)* y(k,109) +rxt(k,156)* y(k,110) +rxt(k,148)* y(k,111) & + +rxt(k,160)* y(k,112) +rxt(k,152)* y(k,113) +rxt(k,157)* y(k,114) & + +rxt(k,255)* y(k,115) +rxt(k,150)* y(k,125) +rxt(k,329)* y(k,137) & + + rxt(k,592) + het_rates(k,126))* y(k,126) + prod(k,126) = (rxt(k,84) +rxt(k,86) +rxt(k,585)*y(k,108) + & + rxt(k,589)*y(k,122) +rxt(k,597)*y(k,134) +rxt(k,601)*y(k,135)) & + *y(k,71) + (rxt(k,338)*y(k,69) +rxt(k,339)*y(k,123))*y(k,130) & + +rxt(k,594)*y(k,134)*y(k,32) +2.000_r8*rxt(k,150)*y(k,126)*y(k,125) & +rxt(k,94)*y(k,127) - loss(k,52) = (rxt(k,326)* y(k,95) + (rxt(k,327) +rxt(k,328))* y(k,137) & + loss(k,73) = (rxt(k,326)* y(k,96) + (rxt(k,327) +rxt(k,328))* y(k,137) & + rxt(k,94) + het_rates(k,127))* y(k,127) - prod(k,52) = (rxt(k,329)*y(k,126) +rxt(k,337)*y(k,130))*y(k,137) - loss(k,74) = (rxt(k,330)* y(k,30) +rxt(k,331)* y(k,38) + (rxt(k,272) + & - rxt(k,279))* y(k,60) + (rxt(k,277) +rxt(k,278))* y(k,61) & - + (rxt(k,333) +rxt(k,334))* y(k,67) +rxt(k,332)* y(k,69) + rxt(k,95) & + prod(k,73) = (rxt(k,329)*y(k,126) +rxt(k,337)*y(k,130))*y(k,137) + loss(k,98) = (rxt(k,330)* y(k,32) +rxt(k,331)* y(k,40) + (rxt(k,272) + & + rxt(k,279))* y(k,62) + (rxt(k,277) +rxt(k,278))* y(k,63) & + + (rxt(k,333) +rxt(k,334))* y(k,69) +rxt(k,332)* y(k,72) + rxt(k,95) & + rxt(k,96) + het_rates(k,128))* y(k,128) - prod(k,74) = (rxt(k,132)*y(k,94) +rxt(k,323)*y(k,125) +rxt(k,348)*y(k,132) + & - rxt(k,363)*y(k,133))*y(k,69) + (rxt(k,126)*y(k,91) + & - rxt(k,362)*y(k,133))*y(k,68) +rxt(k,336)*y(k,129)*y(k,67) - loss(k,38) = (rxt(k,335)* y(k,30) +rxt(k,336)* y(k,67) + rxt(k,97) & + prod(k,98) = (rxt(k,132)*y(k,95) +rxt(k,323)*y(k,125) +rxt(k,348)*y(k,132) + & + rxt(k,363)*y(k,133))*y(k,72) + (rxt(k,126)*y(k,92) + & + rxt(k,362)*y(k,133))*y(k,71) +rxt(k,336)*y(k,129)*y(k,69) + loss(k,65) = (rxt(k,335)* y(k,32) +rxt(k,336)* y(k,69) + rxt(k,97) & + het_rates(k,129))* y(k,129) - prod(k,38) =rxt(k,322)*y(k,125)*y(k,68) - loss(k,68) = (rxt(k,338)* y(k,67) +rxt(k,380)* y(k,95) +rxt(k,339)* y(k,123) & + prod(k,65) =rxt(k,322)*y(k,125)*y(k,71) + loss(k,89) = (rxt(k,338)* y(k,69) +rxt(k,380)* y(k,96) +rxt(k,339)* y(k,123) & +rxt(k,337)* y(k,137) + het_rates(k,130))* y(k,130) - prod(k,68) =rxt(k,364)*y(k,126)*y(k,68) - loss(k,89) = (rxt(k,498)* y(k,4) +rxt(k,514)* y(k,15) +rxt(k,532)* y(k,16) & - +rxt(k,516)* y(k,17) +rxt(k,517)* y(k,18) +rxt(k,519)* y(k,19) & - +rxt(k,535)* y(k,21) +rxt(k,536)* y(k,22) +rxt(k,521)* y(k,23) & - + (rxt(k,468) +rxt(k,469))* y(k,26) +rxt(k,466)* y(k,27) & - + (rxt(k,537) +rxt(k,541))* y(k,29) + (rxt(k,557) +rxt(k,558)) & - * y(k,33) +rxt(k,415)* y(k,39) +rxt(k,416)* y(k,41) +rxt(k,500) & - * y(k,43) +rxt(k,522)* y(k,44) +rxt(k,523)* y(k,45) +rxt(k,524) & - * y(k,46) +rxt(k,471)* y(k,47) +rxt(k,447)* y(k,49) +rxt(k,423) & - * y(k,50) +rxt(k,474)* y(k,52) +rxt(k,340)* y(k,53) +rxt(k,438) & - * y(k,54) +rxt(k,349)* y(k,60) +rxt(k,446)* y(k,61) +rxt(k,437) & - * y(k,62) +rxt(k,418)* y(k,67) +rxt(k,419)* y(k,69) +rxt(k,543) & - * y(k,71) +rxt(k,548)* y(k,74) +rxt(k,553)* y(k,76) +rxt(k,554) & - * y(k,77) +rxt(k,417)* y(k,98) +rxt(k,311)* y(k,119) & - + 2._r8*(rxt(k,420) +rxt(k,421))* y(k,131) + het_rates(k,131)) & - * y(k,131) - prod(k,89) = (rxt(k,406)*y(k,39) +rxt(k,407)*y(k,41) +rxt(k,412)*y(k,98) + & - rxt(k,470)*y(k,47) +rxt(k,473)*y(k,52) +rxt(k,499)*y(k,43) + & - rxt(k,501)*y(k,51) +rxt(k,531)*y(k,16))*y(k,67) & - + (rxt(k,149)*y(k,126) +rxt(k,172)*y(k,104) +rxt(k,189)*y(k,100) + & - rxt(k,203)*y(k,102) +rxt(k,207)*y(k,119) +rxt(k,224)*y(k,116) + & - rxt(k,242)*y(k,115))*y(k,97) + (rxt(k,3) +rxt(k,139)*y(k,96) + & + prod(k,89) =rxt(k,364)*y(k,126)*y(k,71) + loss(k,112) = (rxt(k,498)* y(k,5) +rxt(k,514)* y(k,16) +rxt(k,532)* y(k,17) & + +rxt(k,516)* y(k,18) +rxt(k,517)* y(k,19) +rxt(k,519)* y(k,20) & + +rxt(k,535)* y(k,22) +rxt(k,536)* y(k,23) +rxt(k,521)* y(k,24) & + + (rxt(k,468) +rxt(k,469))* y(k,28) +rxt(k,466)* y(k,29) +rxt(k,540) & + * y(k,31) + (rxt(k,542) +rxt(k,556))* y(k,35) +rxt(k,415)* y(k,41) & + +rxt(k,416)* y(k,43) +rxt(k,500)* y(k,45) +rxt(k,522)* y(k,46) & + +rxt(k,523)* y(k,47) +rxt(k,524)* y(k,48) +rxt(k,471)* y(k,49) & + +rxt(k,447)* y(k,51) +rxt(k,423)* y(k,52) +rxt(k,474)* y(k,54) & + +rxt(k,340)* y(k,55) +rxt(k,438)* y(k,56) +rxt(k,349)* y(k,62) & + +rxt(k,446)* y(k,63) +rxt(k,437)* y(k,64) +rxt(k,418)* y(k,69) & + +rxt(k,419)* y(k,72) +rxt(k,544)* y(k,74) +rxt(k,550)* y(k,77) & + +rxt(k,555)* y(k,79) +rxt(k,546)* y(k,80) +rxt(k,417)* y(k,99) & + +rxt(k,311)* y(k,120) + 2._r8*(rxt(k,420) +rxt(k,421))* y(k,131) & + + het_rates(k,131))* y(k,131) + prod(k,112) = (rxt(k,406)*y(k,41) +rxt(k,407)*y(k,43) +rxt(k,412)*y(k,99) + & + rxt(k,470)*y(k,49) +rxt(k,473)*y(k,54) +rxt(k,499)*y(k,45) + & + rxt(k,501)*y(k,53) +rxt(k,531)*y(k,17))*y(k,69) & + + (rxt(k,149)*y(k,126) +rxt(k,172)*y(k,105) +rxt(k,189)*y(k,101) + & + rxt(k,203)*y(k,103) +rxt(k,207)*y(k,120) +rxt(k,224)*y(k,117) + & + rxt(k,242)*y(k,116))*y(k,98) + (rxt(k,3) +rxt(k,139)*y(k,97) + & rxt(k,328)*y(k,127) +rxt(k,355)*y(k,133) + & - 2.000_r8*rxt(k,390)*y(k,122) +rxt(k,509)*y(k,37))*y(k,137) & - + (2.000_r8*rxt(k,409)*y(k,38) +rxt(k,413)*y(k,69) + & - rxt(k,434)*y(k,62) +rxt(k,439)*y(k,60) +rxt(k,455)*y(k,86))*y(k,98) & - + (rxt(k,98) +rxt(k,341)*y(k,86) +rxt(k,342)*y(k,26) + & - rxt(k,346)*y(k,61) +rxt(k,348)*y(k,69))*y(k,132) & - + (rxt(k,538)*y(k,22) +rxt(k,389)*y(k,39) +rxt(k,482)*y(k,47) + & - rxt(k,505)*y(k,43))*y(k,122) + (rxt(k,9) +rxt(k,124)*y(k,91) + & - rxt(k,357)*y(k,133))*y(k,49) + (rxt(k,23) + & - .300_r8*rxt(k,535)*y(k,131))*y(k,21) + (rxt(k,129)*y(k,94) + & - rxt(k,414)*y(k,69))*y(k,38) +2.000_r8*rxt(k,4)*y(k,41) & - +rxt(k,356)*y(k,133)*y(k,47) +rxt(k,10)*y(k,50) +rxt(k,58)*y(k,51) & - +rxt(k,59)*y(k,52) +rxt(k,12)*y(k,53) +.500_r8*rxt(k,561)*y(k,61) & - +rxt(k,138)*y(k,96)*y(k,95) - loss(k,109) = (rxt(k,342)* y(k,26) +rxt(k,343)* y(k,30) +rxt(k,344)* y(k,38) & - +rxt(k,345)* y(k,47) +rxt(k,346)* y(k,61) +rxt(k,347)* y(k,67) & - +rxt(k,348)* y(k,69) +rxt(k,341)* y(k,86) + rxt(k,98) & + 2.000_r8*rxt(k,390)*y(k,70) +rxt(k,509)*y(k,39))*y(k,137) & + + (2.000_r8*rxt(k,409)*y(k,40) +rxt(k,413)*y(k,72) + & + rxt(k,434)*y(k,64) +rxt(k,439)*y(k,62) +rxt(k,455)*y(k,25))*y(k,99) & + + (rxt(k,98) +rxt(k,341)*y(k,25) +rxt(k,342)*y(k,28) + & + rxt(k,346)*y(k,63) +rxt(k,348)*y(k,72))*y(k,132) & + + (rxt(k,389)*y(k,41) +rxt(k,482)*y(k,49) +rxt(k,505)*y(k,45) + & + rxt(k,537)*y(k,23))*y(k,70) + (rxt(k,9) +rxt(k,124)*y(k,92) + & + rxt(k,357)*y(k,133))*y(k,51) + (rxt(k,23) + & + .300_r8*rxt(k,535)*y(k,131))*y(k,22) + (rxt(k,129)*y(k,95) + & + rxt(k,414)*y(k,72))*y(k,40) +.330_r8*rxt(k,25)*y(k,23) & + +2.000_r8*rxt(k,4)*y(k,43) +rxt(k,356)*y(k,133)*y(k,49) +rxt(k,10) & + *y(k,52) +rxt(k,58)*y(k,53) +rxt(k,59)*y(k,54) +rxt(k,12)*y(k,55) & + +.500_r8*rxt(k,560)*y(k,63) +rxt(k,138)*y(k,97)*y(k,96) + loss(k,132) = (rxt(k,341)* y(k,25) +rxt(k,342)* y(k,28) +rxt(k,343)* y(k,32) & + +rxt(k,344)* y(k,40) +rxt(k,345)* y(k,49) +rxt(k,346)* y(k,63) & + +rxt(k,347)* y(k,69) +rxt(k,348)* y(k,72) + rxt(k,98) & + het_rates(k,132))* y(k,132) - prod(k,109) = (rxt(k,117)*y(k,91) +rxt(k,287)*y(k,108) +rxt(k,331)*y(k,128)) & - *y(k,38) + (rxt(k,354)*y(k,39) +rxt(k,355)*y(k,137))*y(k,133) - loss(k,110) = (rxt(k,351)* y(k,26) +rxt(k,352)* y(k,30) + (rxt(k,353) + & - rxt(k,354))* y(k,39) +rxt(k,356)* y(k,47) +rxt(k,357)* y(k,49) & - +rxt(k,136)* y(k,60) +rxt(k,359)* y(k,61) +rxt(k,360)* y(k,67) & - +rxt(k,362)* y(k,68) +rxt(k,363)* y(k,69) +rxt(k,350)* y(k,86) & - +rxt(k,361)* y(k,123) +rxt(k,355)* y(k,137) + rxt(k,99) + rxt(k,358) & + prod(k,132) = (rxt(k,117)*y(k,92) +rxt(k,287)*y(k,109) +rxt(k,331)*y(k,128)) & + *y(k,40) + (rxt(k,354)*y(k,41) +rxt(k,355)*y(k,137))*y(k,133) + loss(k,133) = (rxt(k,350)* y(k,25) +rxt(k,351)* y(k,28) +rxt(k,352)* y(k,32) & + + (rxt(k,353) +rxt(k,354))* y(k,41) +rxt(k,356)* y(k,49) +rxt(k,357) & + * y(k,51) +rxt(k,136)* y(k,62) +rxt(k,359)* y(k,63) +rxt(k,360) & + * y(k,69) +rxt(k,362)* y(k,71) +rxt(k,363)* y(k,72) +rxt(k,361) & + * y(k,123) +rxt(k,355)* y(k,137) + rxt(k,99) + rxt(k,358) & + het_rates(k,133))* y(k,133) - prod(k,110) =rxt(k,325)*y(k,125)*y(k,67) +rxt(k,134)*y(k,95)*y(k,69) & - +rxt(k,63)*y(k,91) +rxt(k,95)*y(k,128) - loss(k,61) = (rxt(k,595)* y(k,30) +rxt(k,598)* y(k,68) +rxt(k,597)* y(k,106) & - + rxt(k,596) + het_rates(k,134))* y(k,134) - prod(k,61) = (rxt(k,77) +rxt(k,81) +rxt(k,588)*y(k,107) + & - rxt(k,589)*y(k,121) +rxt(k,601)*y(k,135) +rxt(k,607)*y(k,136)) & - *y(k,67) + (rxt(k,85) +rxt(k,87))*y(k,68) + (rxt(k,599)*y(k,135) + & - rxt(k,604)*y(k,136))*y(k,95) +rxt(k,581)*y(k,135) +rxt(k,580) & + prod(k,133) =rxt(k,325)*y(k,125)*y(k,69) +rxt(k,134)*y(k,96)*y(k,72) & + +rxt(k,63)*y(k,92) +rxt(k,95)*y(k,128) + loss(k,84) = (rxt(k,594)* y(k,32) +rxt(k,597)* y(k,71) +rxt(k,596)* y(k,107) & + + rxt(k,595) + het_rates(k,134))* y(k,134) + prod(k,84) = (rxt(k,77) +rxt(k,81) +rxt(k,587)*y(k,108) + & + rxt(k,588)*y(k,122) +rxt(k,600)*y(k,135) +rxt(k,606)*y(k,136)) & + *y(k,69) + (rxt(k,85) +rxt(k,87))*y(k,71) + (rxt(k,598)*y(k,135) + & + rxt(k,603)*y(k,136))*y(k,96) +rxt(k,580)*y(k,135) +rxt(k,579) & *y(k,136) - loss(k,43) = (rxt(k,601)* y(k,67) +rxt(k,602)* y(k,68) +rxt(k,599)* y(k,95) & - + rxt(k,581) + rxt(k,600) + het_rates(k,135))* y(k,135) - prod(k,43) = (rxt(k,78) +rxt(k,82))*y(k,67) + (rxt(k,83) +rxt(k,92))*y(k,68) & - + (rxt(k,582) +rxt(k,603)*y(k,95))*y(k,136) - loss(k,42) = (rxt(k,607)* y(k,67) + (rxt(k,603) +rxt(k,604))* y(k,95) & - + rxt(k,580) + rxt(k,582) + rxt(k,605) + rxt(k,606) & + loss(k,60) = (rxt(k,600)* y(k,69) +rxt(k,601)* y(k,71) +rxt(k,598)* y(k,96) & + + rxt(k,580) + rxt(k,599) + het_rates(k,135))* y(k,135) + prod(k,60) = (rxt(k,78) +rxt(k,82))*y(k,69) + (rxt(k,83) +rxt(k,92))*y(k,71) & + + (rxt(k,581) +rxt(k,602)*y(k,96))*y(k,136) + loss(k,59) = (rxt(k,606)* y(k,69) + (rxt(k,602) +rxt(k,603))* y(k,96) & + + rxt(k,579) + rxt(k,581) + rxt(k,604) + rxt(k,605) & + het_rates(k,136))* y(k,136) - prod(k,42) = (rxt(k,79) +rxt(k,80))*y(k,67) + (rxt(k,90) +rxt(k,91))*y(k,68) - loss(k,114) = (rxt(k,509)* y(k,37) +rxt(k,555)* y(k,78) +rxt(k,107)* y(k,87) & - +rxt(k,119)* y(k,91) +rxt(k,118)* y(k,93) +rxt(k,139)* y(k,96) & - +rxt(k,374)* y(k,99) +rxt(k,376)* y(k,100) +rxt(k,140)* y(k,101) & - +rxt(k,378)* y(k,102) +rxt(k,143)* y(k,103) +rxt(k,372)* y(k,105) & - +rxt(k,288)* y(k,108) +rxt(k,296)* y(k,110) +rxt(k,294)* y(k,112) & - +rxt(k,365)* y(k,115) +rxt(k,367)* y(k,116) +rxt(k,305)* y(k,117) & - +rxt(k,307)* y(k,118) +rxt(k,366)* y(k,119) +rxt(k,313)* y(k,120) & - +rxt(k,390)* y(k,122) +rxt(k,329)* y(k,126) + (rxt(k,327) + & + prod(k,59) = (rxt(k,79) +rxt(k,80))*y(k,69) + (rxt(k,90) +rxt(k,91))*y(k,71) + loss(k,137) = (rxt(k,509)* y(k,39) +rxt(k,390)* y(k,70) +rxt(k,557)* y(k,81) & + +rxt(k,107)* y(k,88) +rxt(k,119)* y(k,92) +rxt(k,118)* y(k,94) & + +rxt(k,139)* y(k,97) +rxt(k,374)* y(k,100) +rxt(k,376)* y(k,101) & + +rxt(k,140)* y(k,102) +rxt(k,378)* y(k,103) +rxt(k,143)* y(k,104) & + +rxt(k,372)* y(k,106) +rxt(k,288)* y(k,109) +rxt(k,296)* y(k,111) & + +rxt(k,294)* y(k,113) +rxt(k,365)* y(k,116) +rxt(k,367)* y(k,117) & + +rxt(k,305)* y(k,118) +rxt(k,307)* y(k,119) +rxt(k,366)* y(k,120) & + +rxt(k,313)* y(k,121) +rxt(k,329)* y(k,126) + (rxt(k,327) + & rxt(k,328))* y(k,127) +rxt(k,337)* y(k,130) +rxt(k,355)* y(k,133) & + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,137))* y(k,137) - prod(k,114) = (rxt(k,377) +4.000_r8*rxt(k,141)*y(k,95) + & - 4.000_r8*rxt(k,146)*y(k,114) +4.000_r8*rxt(k,147)*y(k,87) + & - 5.000_r8*rxt(k,158)*y(k,93) +5.000_r8*rxt(k,162)*y(k,109) + & - 4.000_r8*rxt(k,163)*y(k,113) +5.000_r8*rxt(k,164)*y(k,88) + & - 6.000_r8*rxt(k,165)*y(k,111) +4.000_r8*rxt(k,166)*y(k,108) + & - 4.000_r8*rxt(k,170)*y(k,91) +4.000_r8*rxt(k,181)*y(k,89) + & - 4.000_r8*rxt(k,192)*y(k,110) +4.000_r8*rxt(k,203)*y(k,97) + & - 4.000_r8*rxt(k,214)*y(k,125) +4.000_r8*rxt(k,225)*y(k,94) + & - 5.000_r8*rxt(k,236)*y(k,112) +6.000_r8*rxt(k,247)*y(k,92) + & - 4.000_r8*rxt(k,258)*y(k,91) +5.000_r8*rxt(k,260)*y(k,93) + & - 5.000_r8*rxt(k,262)*y(k,112) +4.000_r8*rxt(k,264)*y(k,110) + & - 4.000_r8*rxt(k,267)*y(k,89) +4.000_r8*rxt(k,269)*y(k,114) + & - 6.000_r8*rxt(k,271)*y(k,92))*y(k,102) + (rxt(k,379) + & - 5.000_r8*rxt(k,144)*y(k,95) +5.000_r8*rxt(k,167)*y(k,114) + & - 5.000_r8*rxt(k,168)*y(k,91) +5.000_r8*rxt(k,169)*y(k,89) + & - 5.000_r8*rxt(k,171)*y(k,110) +5.000_r8*rxt(k,172)*y(k,97) + & - 5.000_r8*rxt(k,173)*y(k,125) +5.000_r8*rxt(k,174)*y(k,94) + & - 6.000_r8*rxt(k,175)*y(k,112) +7.000_r8*rxt(k,176)*y(k,92) + & - 5.000_r8*rxt(k,177)*y(k,87) +6.000_r8*rxt(k,178)*y(k,93) + & - 6.000_r8*rxt(k,179)*y(k,109) +5.000_r8*rxt(k,180)*y(k,113) + & - 6.000_r8*rxt(k,182)*y(k,88) +7.000_r8*rxt(k,183)*y(k,111) + & - 5.000_r8*rxt(k,184)*y(k,108) +7.000_r8*rxt(k,259)*y(k,92) + & - 6.000_r8*rxt(k,261)*y(k,93) +6.000_r8*rxt(k,263)*y(k,112) + & - 5.000_r8*rxt(k,265)*y(k,91) +5.000_r8*rxt(k,266)*y(k,110) + & - 5.000_r8*rxt(k,268)*y(k,89) +5.000_r8*rxt(k,270)*y(k,114))*y(k,104) & - + (rxt(k,375) +3.000_r8*rxt(k,185)*y(k,114) + & - 3.000_r8*rxt(k,186)*y(k,91) +3.000_r8*rxt(k,187)*y(k,89) + & - 3.000_r8*rxt(k,188)*y(k,110) +3.000_r8*rxt(k,189)*y(k,97) + & - 3.000_r8*rxt(k,190)*y(k,125) +3.000_r8*rxt(k,191)*y(k,94) + & - 4.000_r8*rxt(k,193)*y(k,112) +5.000_r8*rxt(k,194)*y(k,92) + & - 3.000_r8*rxt(k,195)*y(k,87) +4.000_r8*rxt(k,196)*y(k,93) + & - 4.000_r8*rxt(k,197)*y(k,109) +3.000_r8*rxt(k,198)*y(k,113) + & - 4.000_r8*rxt(k,199)*y(k,88) +5.000_r8*rxt(k,200)*y(k,111) + & - 3.000_r8*rxt(k,201)*y(k,108) +3.000_r8*rxt(k,383)*y(k,95))*y(k,100) & - + (rxt(k,514)*y(k,15) +rxt(k,516)*y(k,17) +rxt(k,517)*y(k,18) + & - rxt(k,519)*y(k,19) +rxt(k,524)*y(k,46) +rxt(k,536)*y(k,22) + & - rxt(k,340)*y(k,53) +rxt(k,415)*y(k,39) +rxt(k,416)*y(k,41) + & - rxt(k,417)*y(k,98) +rxt(k,420)*y(k,131) +rxt(k,423)*y(k,50) + & - rxt(k,447)*y(k,49) +rxt(k,471)*y(k,47) +rxt(k,474)*y(k,52) + & - rxt(k,500)*y(k,43) +rxt(k,532)*y(k,16) +rxt(k,535)*y(k,21))*y(k,131) & - + (2.000_r8*rxt(k,220)*y(k,114) +2.000_r8*rxt(k,221)*y(k,91) + & - 2.000_r8*rxt(k,222)*y(k,89) +2.000_r8*rxt(k,223)*y(k,110) + & - 2.000_r8*rxt(k,224)*y(k,97) +2.000_r8*rxt(k,226)*y(k,125) + & - 2.000_r8*rxt(k,227)*y(k,94) +3.000_r8*rxt(k,228)*y(k,112) + & - 4.000_r8*rxt(k,229)*y(k,92) +2.000_r8*rxt(k,230)*y(k,87) + & - 3.000_r8*rxt(k,231)*y(k,93) +3.000_r8*rxt(k,232)*y(k,109) + & - 2.000_r8*rxt(k,233)*y(k,113) +3.000_r8*rxt(k,234)*y(k,88) + & - 4.000_r8*rxt(k,235)*y(k,111) +2.000_r8*rxt(k,237)*y(k,108) + & - 2.000_r8*rxt(k,303)*y(k,95))*y(k,116) + (rxt(k,202)*y(k,114) + & - rxt(k,204)*y(k,91) +rxt(k,205)*y(k,89) +rxt(k,206)*y(k,110) + & - rxt(k,207)*y(k,97) +rxt(k,208)*y(k,125) +rxt(k,209)*y(k,94) + & - 2.000_r8*rxt(k,210)*y(k,112) +3.000_r8*rxt(k,211)*y(k,92) + & - rxt(k,212)*y(k,87) +2.000_r8*rxt(k,213)*y(k,93) + & - 2.000_r8*rxt(k,215)*y(k,109) +rxt(k,216)*y(k,113) + & - 2.000_r8*rxt(k,217)*y(k,88) +3.000_r8*rxt(k,218)*y(k,111) + & - rxt(k,219)*y(k,108) +rxt(k,308)*y(k,95))*y(k,119) & - + (rxt(k,106)*y(k,88) +rxt(k,345)*y(k,132) +rxt(k,564)*y(k,52) + & - rxt(k,570)*y(k,52) +rxt(k,571)*y(k,51) +rxt(k,575)*y(k,52) + & - rxt(k,576)*y(k,51))*y(k,47) + (rxt(k,64) +rxt(k,283) + & - rxt(k,120)*y(k,61) +rxt(k,123)*y(k,60) +rxt(k,155)*y(k,126) + & - rxt(k,249)*y(k,115))*y(k,93) + (rxt(k,138)*y(k,96) + & - 3.000_r8*rxt(k,304)*y(k,117) +rxt(k,326)*y(k,127) + & - rxt(k,381)*y(k,105) +2.000_r8*rxt(k,382)*y(k,99))*y(k,95) & - + (rxt(k,245)*y(k,112) +2.000_r8*rxt(k,246)*y(k,92) + & - rxt(k,250)*y(k,109) +rxt(k,252)*y(k,88) + & - 2.000_r8*rxt(k,253)*y(k,111))*y(k,115) + (rxt(k,152)*y(k,112) + & - 2.000_r8*rxt(k,153)*y(k,92) +rxt(k,156)*y(k,109) + & - rxt(k,159)*y(k,88) +2.000_r8*rxt(k,160)*y(k,111))*y(k,126) & - + (rxt(k,344)*y(k,132) +rxt(k,410)*y(k,98))*y(k,38) + (rxt(k,274) + & - rxt(k,293)*y(k,56))*y(k,111) + (rxt(k,282) +rxt(k,295)*y(k,49)) & - *y(k,112) +rxt(k,353)*y(k,133)*y(k,39) +rxt(k,100)*y(k,42) & - +rxt(k,385)*y(k,88) +rxt(k,284)*y(k,92) +rxt(k,373)*y(k,99) & - +rxt(k,273)*y(k,109) +rxt(k,94)*y(k,127) + prod(k,137) = (rxt(k,377) +4.000_r8*rxt(k,141)*y(k,96) + & + 4.000_r8*rxt(k,146)*y(k,115) +4.000_r8*rxt(k,147)*y(k,88) + & + 5.000_r8*rxt(k,158)*y(k,94) +5.000_r8*rxt(k,162)*y(k,110) + & + 4.000_r8*rxt(k,163)*y(k,114) +5.000_r8*rxt(k,164)*y(k,89) + & + 6.000_r8*rxt(k,165)*y(k,112) +4.000_r8*rxt(k,166)*y(k,109) + & + 4.000_r8*rxt(k,170)*y(k,92) +4.000_r8*rxt(k,181)*y(k,90) + & + 4.000_r8*rxt(k,192)*y(k,111) +4.000_r8*rxt(k,203)*y(k,98) + & + 4.000_r8*rxt(k,214)*y(k,125) +4.000_r8*rxt(k,225)*y(k,95) + & + 5.000_r8*rxt(k,236)*y(k,113) +6.000_r8*rxt(k,247)*y(k,93) + & + 4.000_r8*rxt(k,258)*y(k,92) +5.000_r8*rxt(k,260)*y(k,94) + & + 5.000_r8*rxt(k,262)*y(k,113) +4.000_r8*rxt(k,264)*y(k,111) + & + 4.000_r8*rxt(k,267)*y(k,90) +4.000_r8*rxt(k,269)*y(k,115) + & + 6.000_r8*rxt(k,271)*y(k,93))*y(k,103) + (rxt(k,379) + & + 5.000_r8*rxt(k,144)*y(k,96) +5.000_r8*rxt(k,167)*y(k,115) + & + 5.000_r8*rxt(k,168)*y(k,92) +5.000_r8*rxt(k,169)*y(k,90) + & + 5.000_r8*rxt(k,171)*y(k,111) +5.000_r8*rxt(k,172)*y(k,98) + & + 5.000_r8*rxt(k,173)*y(k,125) +5.000_r8*rxt(k,174)*y(k,95) + & + 6.000_r8*rxt(k,175)*y(k,113) +7.000_r8*rxt(k,176)*y(k,93) + & + 5.000_r8*rxt(k,177)*y(k,88) +6.000_r8*rxt(k,178)*y(k,94) + & + 6.000_r8*rxt(k,179)*y(k,110) +5.000_r8*rxt(k,180)*y(k,114) + & + 6.000_r8*rxt(k,182)*y(k,89) +7.000_r8*rxt(k,183)*y(k,112) + & + 5.000_r8*rxt(k,184)*y(k,109) +7.000_r8*rxt(k,259)*y(k,93) + & + 6.000_r8*rxt(k,261)*y(k,94) +6.000_r8*rxt(k,263)*y(k,113) + & + 5.000_r8*rxt(k,265)*y(k,92) +5.000_r8*rxt(k,266)*y(k,111) + & + 5.000_r8*rxt(k,268)*y(k,90) +5.000_r8*rxt(k,270)*y(k,115))*y(k,105) & + + (rxt(k,375) +3.000_r8*rxt(k,185)*y(k,115) + & + 3.000_r8*rxt(k,186)*y(k,92) +3.000_r8*rxt(k,187)*y(k,90) + & + 3.000_r8*rxt(k,188)*y(k,111) +3.000_r8*rxt(k,189)*y(k,98) + & + 3.000_r8*rxt(k,190)*y(k,125) +3.000_r8*rxt(k,191)*y(k,95) + & + 4.000_r8*rxt(k,193)*y(k,113) +5.000_r8*rxt(k,194)*y(k,93) + & + 3.000_r8*rxt(k,195)*y(k,88) +4.000_r8*rxt(k,196)*y(k,94) + & + 4.000_r8*rxt(k,197)*y(k,110) +3.000_r8*rxt(k,198)*y(k,114) + & + 4.000_r8*rxt(k,199)*y(k,89) +5.000_r8*rxt(k,200)*y(k,112) + & + 3.000_r8*rxt(k,201)*y(k,109) +3.000_r8*rxt(k,383)*y(k,96))*y(k,101) & + + (rxt(k,340)*y(k,55) +rxt(k,415)*y(k,41) +rxt(k,416)*y(k,43) + & + rxt(k,417)*y(k,99) +rxt(k,420)*y(k,131) +rxt(k,423)*y(k,52) + & + rxt(k,447)*y(k,51) +rxt(k,471)*y(k,49) +rxt(k,474)*y(k,54) + & + rxt(k,500)*y(k,45) +rxt(k,514)*y(k,16) +rxt(k,516)*y(k,18) + & + rxt(k,517)*y(k,19) +rxt(k,519)*y(k,20) +rxt(k,524)*y(k,48) + & + rxt(k,532)*y(k,17) +rxt(k,535)*y(k,22) +rxt(k,536)*y(k,23))*y(k,131) & + + (2.000_r8*rxt(k,220)*y(k,115) +2.000_r8*rxt(k,221)*y(k,92) + & + 2.000_r8*rxt(k,222)*y(k,90) +2.000_r8*rxt(k,223)*y(k,111) + & + 2.000_r8*rxt(k,224)*y(k,98) +2.000_r8*rxt(k,226)*y(k,125) + & + 2.000_r8*rxt(k,227)*y(k,95) +3.000_r8*rxt(k,228)*y(k,113) + & + 4.000_r8*rxt(k,229)*y(k,93) +2.000_r8*rxt(k,230)*y(k,88) + & + 3.000_r8*rxt(k,231)*y(k,94) +3.000_r8*rxt(k,232)*y(k,110) + & + 2.000_r8*rxt(k,233)*y(k,114) +3.000_r8*rxt(k,234)*y(k,89) + & + 4.000_r8*rxt(k,235)*y(k,112) +2.000_r8*rxt(k,237)*y(k,109) + & + 2.000_r8*rxt(k,303)*y(k,96))*y(k,117) + (rxt(k,202)*y(k,115) + & + rxt(k,204)*y(k,92) +rxt(k,205)*y(k,90) +rxt(k,206)*y(k,111) + & + rxt(k,207)*y(k,98) +rxt(k,208)*y(k,125) +rxt(k,209)*y(k,95) + & + 2.000_r8*rxt(k,210)*y(k,113) +3.000_r8*rxt(k,211)*y(k,93) + & + rxt(k,212)*y(k,88) +2.000_r8*rxt(k,213)*y(k,94) + & + 2.000_r8*rxt(k,215)*y(k,110) +rxt(k,216)*y(k,114) + & + 2.000_r8*rxt(k,217)*y(k,89) +3.000_r8*rxt(k,218)*y(k,112) + & + rxt(k,219)*y(k,109) +rxt(k,308)*y(k,96))*y(k,120) & + + (rxt(k,106)*y(k,89) +rxt(k,345)*y(k,132) +rxt(k,563)*y(k,54) + & + rxt(k,569)*y(k,54) +rxt(k,570)*y(k,53) +rxt(k,574)*y(k,54) + & + rxt(k,575)*y(k,53))*y(k,49) + (rxt(k,64) +rxt(k,283) + & + rxt(k,120)*y(k,63) +rxt(k,123)*y(k,62) +rxt(k,155)*y(k,126) + & + rxt(k,249)*y(k,116))*y(k,94) + (rxt(k,138)*y(k,97) + & + 3.000_r8*rxt(k,304)*y(k,118) +rxt(k,326)*y(k,127) + & + rxt(k,381)*y(k,106) +2.000_r8*rxt(k,382)*y(k,100))*y(k,96) & + + (rxt(k,245)*y(k,113) +2.000_r8*rxt(k,246)*y(k,93) + & + rxt(k,250)*y(k,110) +rxt(k,252)*y(k,89) + & + 2.000_r8*rxt(k,253)*y(k,112))*y(k,116) + (rxt(k,152)*y(k,113) + & + 2.000_r8*rxt(k,153)*y(k,93) +rxt(k,156)*y(k,110) + & + rxt(k,159)*y(k,89) +2.000_r8*rxt(k,160)*y(k,112))*y(k,126) & + + (rxt(k,344)*y(k,132) +rxt(k,410)*y(k,99))*y(k,40) + (rxt(k,274) + & + rxt(k,293)*y(k,58))*y(k,112) + (rxt(k,282) +rxt(k,295)*y(k,51)) & + *y(k,113) +.050_r8*rxt(k,25)*y(k,23) +rxt(k,353)*y(k,133)*y(k,41) & + +rxt(k,100)*y(k,44) +rxt(k,385)*y(k,89) +rxt(k,284)*y(k,93) & + +rxt(k,373)*y(k,100) +rxt(k,273)*y(k,110) +rxt(k,94)*y(k,127) end do end subroutine imp_prod_loss end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_rxt_rates_conv.F90 index 300eafe047..f39a2c6431 100644 --- a/src/chemistry/pp_waccm_mad_mam4/mo_rxt_rates_conv.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/mo_rxt_rates_conv.F90 @@ -11,69 +11,69 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 137) ! rate_const*H2O rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 137) ! rate_const*H2O rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 137) ! rate_const*H2O - rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 41) ! rate_const*H2O2 - rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 68) ! rate_const*O2 - rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 68) ! rate_const*O2 - rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 69) ! rate_const*O3 - rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 69) ! rate_const*O3 - rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 49) ! rate_const*HNO3 - rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 50) ! rate_const*HO2NO2 - rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 50) ! rate_const*HO2NO2 - rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 53) ! rate_const*HONO - rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 55) ! rate_const*N2O - rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 56) ! rate_const*N2O5 - rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 56) ! rate_const*N2O5 - rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 60) ! rate_const*NO - rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 60) ! rate_const*NO - rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 61) ! rate_const*NO2 - rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 62) ! rate_const*NO3 - rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 62) ! rate_const*NO3 - rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 16) ! rate_const*CH2O - rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 16) ! rate_const*CH2O - rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 21) ! rate_const*CH3OOH - rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 22) ! rate_const*CH4 - rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 22) ! rate_const*CH4 - rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 30) ! rate_const*CO2 - rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 3) ! rate_const*BRCL - rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 4) ! rate_const*BRO - rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 5) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 5) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 7) ! rate_const*CCL4 - rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 8) ! rate_const*CF2CLBR - rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 9) ! rate_const*CF3BR - rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 10) ! rate_const*CFC11 - rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 11) ! rate_const*CFC113 - rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 12) ! rate_const*CFC114 - rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 13) ! rate_const*CFC115 - rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 14) ! rate_const*CFC12 - rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 15) ! rate_const*CH2BR2 - rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 17) ! rate_const*CH3BR - rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 18) ! rate_const*CH3CCL3 - rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 19) ! rate_const*CH3CL - rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 23) ! rate_const*CHBR3 - rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 24) ! rate_const*CL2 - rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 25) ! rate_const*CL2O2 - rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 26) ! rate_const*CLO - rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 27) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 27) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 31) ! rate_const*COF2 - rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 32) ! rate_const*COFCL - rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 40) ! rate_const*H2402 - rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 43) ! rate_const*HBR - rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 44) ! rate_const*HCFC141B - rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 45) ! rate_const*HCFC142B - rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 46) ! rate_const*HCFC22 - rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 47) ! rate_const*HCL - rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 48) ! rate_const*HF - rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 51) ! rate_const*HOBR - rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 52) ! rate_const*HOCL - rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 70) ! rate_const*OCLO - rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 75) ! rate_const*SF6 - rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 30) ! rate_const*CO2 - rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 91) ! rate_const*CO3m - rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 93) ! rate_const*CO3m_H2O - rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 94) ! rate_const*CO4m - rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 54) ! rate_const*N + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 43) ! rate_const*H2O2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 71) ! rate_const*O2 + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 71) ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 72) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 72) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 51) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 52) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 52) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 55) ! rate_const*HONO + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 57) ! rate_const*N2O + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 58) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 58) ! rate_const*N2O5 + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 62) ! rate_const*NO + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 62) ! rate_const*NO + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 63) ! rate_const*NO2 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 64) ! rate_const*NO3 + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 64) ! rate_const*NO3 + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 17) ! rate_const*CH2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 17) ! rate_const*CH2O + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 22) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 23) ! rate_const*CH4 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 23) ! rate_const*CH4 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 32) ! rate_const*CO2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 4) ! rate_const*BRCL + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 5) ! rate_const*BRO + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 8) ! rate_const*CCL4 + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 9) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 10) ! rate_const*CF3BR + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 11) ! rate_const*CFC11 + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 12) ! rate_const*CFC113 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 13) ! rate_const*CFC114 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 14) ! rate_const*CFC115 + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 15) ! rate_const*CFC12 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 16) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 18) ! rate_const*CH3BR + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 19) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 20) ! rate_const*CH3CL + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 24) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 26) ! rate_const*CL2 + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 27) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 28) ! rate_const*CLO + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 33) ! rate_const*COF2 + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 34) ! rate_const*COFCL + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 42) ! rate_const*H2402 + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 45) ! rate_const*HBR + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 46) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 47) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 48) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 49) ! rate_const*HCL + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 50) ! rate_const*HF + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 53) ! rate_const*HOBR + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 54) ! rate_const*HOCL + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 73) ! rate_const*OCLO + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 78) ! rate_const*SF6 + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 32) ! rate_const*CO2 + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 92) ! rate_const*CO3m + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 94) ! rate_const*CO3m_H2O + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 95) ! rate_const*CO4m + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 56) ! rate_const*N ! rate_const*N2 ! rate_const*N2 ! rate_const*N2 @@ -82,24 +82,24 @@ subroutine set_rates( rxt_rates, sol, ncol ) ! rate_const*N2 ! rate_const*N2 ! rate_const*N2 - rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 108) ! rate_const*NO2m - rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 110) ! rate_const*NO3m - rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 67) ! rate_const*O - rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 67) ! rate_const*O - rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 67) ! rate_const*O - rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 67) ! rate_const*O - rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 67) ! rate_const*O - rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 67) ! rate_const*O - rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 68) ! rate_const*O2 - rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 68) ! rate_const*O2 - rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 68) ! rate_const*O2 - rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 68) ! rate_const*O2 - rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 68) ! rate_const*O2 - rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 68) ! rate_const*O2 - rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 68) ! rate_const*O2 - rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 68) ! rate_const*O2 - rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 68) ! rate_const*O2 - rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 68) ! rate_const*O2 + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 109) ! rate_const*NO2m + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 111) ! rate_const*NO3m + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 69) ! rate_const*O + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 69) ! rate_const*O + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 69) ! rate_const*O + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 69) ! rate_const*O + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 69) ! rate_const*O + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 69) ! rate_const*O + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 71) ! rate_const*O2 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 71) ! rate_const*O2 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 71) ! rate_const*O2 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 71) ! rate_const*O2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 71) ! rate_const*O2 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 71) ! rate_const*O2 + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 71) ! rate_const*O2 + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 71) ! rate_const*O2 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 71) ! rate_const*O2 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 71) ! rate_const*O2 rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 125) ! rate_const*O2m rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 127) ! rate_const*O2p_H2O rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 128) ! rate_const*O3m @@ -107,513 +107,512 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 129) ! rate_const*O4m rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 132) ! rate_const*OHm rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 133) ! rate_const*Om - rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 42) ! rate_const*H2SO4 - rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 71) ! rate_const*OCS - rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 76) ! rate_const*SO - rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 77) ! rate_const*SO2 - rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 78) ! rate_const*SO3 - rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 87)*sol(:ncol,:, 38) ! rate_const*CLm*H - rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 88)*sol(:ncol,:, 47) ! rate_const*CLm_H2O*HCL - rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 87)*sol(:ncol,:, 137) ! rate_const*M*CLm*H2O - rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 47)*sol(:ncol,:, 87) ! rate_const*M*HCL*CLm - rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 87)*sol(:ncol,:, 49) ! rate_const*CLm*HNO3 - rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 87)*sol(:ncol,:, 61) ! rate_const*CLm*NO2 - rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 90)*sol(:ncol,:, 60) ! rate_const*CLOm*NO - rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 90)*sol(:ncol,:, 60) ! rate_const*CLOm*NO - rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 90)*sol(:ncol,:, 67) ! rate_const*CLOm*O - rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 86)*sol(:ncol,:, 91) ! rate_const*CL*CO3m - rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 86)*sol(:ncol,:, 91) ! rate_const*CL*CO3m - rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 26)*sol(:ncol,:, 91) ! rate_const*CLO*CO3m - rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 38)*sol(:ncol,:, 91) ! rate_const*H*CO3m - rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 93)*sol(:ncol,:, 137) ! rate_const*M*CO3m_H2O*H2O - rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 91)*sol(:ncol,:, 137) ! rate_const*M*CO3m*H2O - rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 93)*sol(:ncol,:, 61) ! rate_const*CO3m_H2O*NO2 - rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 93)*sol(:ncol,:, 61) ! rate_const*CO3m_H2O*NO2 - rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 93)*sol(:ncol,:, 60) ! rate_const*CO3m_H2O*NO - rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 93)*sol(:ncol,:, 60) ! rate_const*CO3m_H2O*NO - rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 91)*sol(:ncol,:, 49) ! rate_const*CO3m*HNO3 - rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 91)*sol(:ncol,:, 67) ! rate_const*CO3m*O - rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 68)*sol(:ncol,:, 91) ! rate_const*O2*CO3m - rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 86)*sol(:ncol,:, 94) ! rate_const*CL*CO4m - rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 26)*sol(:ncol,:, 94) ! rate_const*CLO*CO4m - rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 94)*sol(:ncol,:, 38) ! rate_const*CO4m*H - rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 94)*sol(:ncol,:, 47) ! rate_const*CO4m*HCL - rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 94)*sol(:ncol,:, 67) ! rate_const*CO4m*O - rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 94)*sol(:ncol,:, 69) ! rate_const*CO4m*O3 - rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 95)*sol(:ncol,:, 68) ! rate_const*N2*e*O2 - rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 69)*sol(:ncol,:, 95) ! rate_const*O3*e - rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 68)*sol(:ncol,:, 95) ! rate_const*M*O2*e - rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 60)*sol(:ncol,:, 133) ! rate_const*NO*Om + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 44) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 74) ! rate_const*OCS + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 79) ! rate_const*SO + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 80) ! rate_const*SO2 + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 81) ! rate_const*SO3 + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 88)*sol(:ncol,:, 40) ! rate_const*CLm*H + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 89)*sol(:ncol,:, 49) ! rate_const*CLm_H2O*HCL + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 88)*sol(:ncol,:, 137) ! rate_const*M*CLm*H2O + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 49)*sol(:ncol,:, 88) ! rate_const*M*HCL*CLm + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 88)*sol(:ncol,:, 51) ! rate_const*CLm*HNO3 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 88)*sol(:ncol,:, 63) ! rate_const*CLm*NO2 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 91)*sol(:ncol,:, 62) ! rate_const*CLOm*NO + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 91)*sol(:ncol,:, 62) ! rate_const*CLOm*NO + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 91)*sol(:ncol,:, 69) ! rate_const*CLOm*O + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 25)*sol(:ncol,:, 92) ! rate_const*CL*CO3m + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 25)*sol(:ncol,:, 92) ! rate_const*CL*CO3m + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 28)*sol(:ncol,:, 92) ! rate_const*CLO*CO3m + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 40)*sol(:ncol,:, 92) ! rate_const*H*CO3m + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 94)*sol(:ncol,:, 137) ! rate_const*M*CO3m_H2O*H2O + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 92)*sol(:ncol,:, 137) ! rate_const*M*CO3m*H2O + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 94)*sol(:ncol,:, 63) ! rate_const*CO3m_H2O*NO2 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 94)*sol(:ncol,:, 63) ! rate_const*CO3m_H2O*NO2 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 94)*sol(:ncol,:, 62) ! rate_const*CO3m_H2O*NO + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 94)*sol(:ncol,:, 62) ! rate_const*CO3m_H2O*NO + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 92)*sol(:ncol,:, 51) ! rate_const*CO3m*HNO3 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 92)*sol(:ncol,:, 69) ! rate_const*CO3m*O + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 71)*sol(:ncol,:, 92) ! rate_const*O2*CO3m + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 25)*sol(:ncol,:, 95) ! rate_const*CL*CO4m + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 28)*sol(:ncol,:, 95) ! rate_const*CLO*CO4m + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 95)*sol(:ncol,:, 40) ! rate_const*CO4m*H + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 95)*sol(:ncol,:, 49) ! rate_const*CO4m*HCL + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 95)*sol(:ncol,:, 69) ! rate_const*CO4m*O + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 95)*sol(:ncol,:, 72) ! rate_const*CO4m*O3 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 96)*sol(:ncol,:, 71) ! rate_const*N2*e*O2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 72)*sol(:ncol,:, 96) ! rate_const*O3*e + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 71)*sol(:ncol,:, 96) ! rate_const*M*O2*e + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 62)*sol(:ncol,:, 133) ! rate_const*NO*Om rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 125) ! rate_const*N2*O2m - rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 96)*sol(:ncol,:, 95) ! rate_const*H3Op_OH*e - rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 137)*sol(:ncol,:, 96) ! rate_const*H2O*H3Op_OH - rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 137)*sol(:ncol,:, 101) ! rate_const*H2O*Hp_3N1 - rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 102)*sol(:ncol,:, 95) ! rate_const*Hp_4H2O*e - rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 102)*sol(:ncol,:, 56) ! rate_const*Hp_4H2O*N2O5 - rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 137)*sol(:ncol,:, 103) ! rate_const*H2O*Hp_4N1 - rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 104)*sol(:ncol,:, 95) ! rate_const*Hp_5H2O*e - rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 104)*sol(:ncol,:, 56) ! rate_const*Hp_5H2O*N2O5 - rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 102)*sol(:ncol,:, 114) ! rate_const*Hp_4H2O*NO3mHNO3 - rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 87)*sol(:ncol,:, 102) ! rate_const*CLm*Hp_4H2O - rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 110)*sol(:ncol,:, 126) ! rate_const*NO3m*O2p - rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 97)*sol(:ncol,:, 126) ! rate_const*HCO3m*O2p + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 97)*sol(:ncol,:, 96) ! rate_const*H3Op_OH*e + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 137)*sol(:ncol,:, 97) ! rate_const*H2O*H3Op_OH + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 137)*sol(:ncol,:, 102) ! rate_const*H2O*Hp_3N1 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 103)*sol(:ncol,:, 96) ! rate_const*Hp_4H2O*e + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 103)*sol(:ncol,:, 58) ! rate_const*Hp_4H2O*N2O5 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 137)*sol(:ncol,:, 104) ! rate_const*H2O*Hp_4N1 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 105)*sol(:ncol,:, 96) ! rate_const*Hp_5H2O*e + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 105)*sol(:ncol,:, 58) ! rate_const*Hp_5H2O*N2O5 + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 103)*sol(:ncol,:, 115) ! rate_const*Hp_4H2O*NO3mHNO3 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 88)*sol(:ncol,:, 103) ! rate_const*CLm*Hp_4H2O + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 111)*sol(:ncol,:, 126) ! rate_const*NO3m*O2p + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 98)*sol(:ncol,:, 126) ! rate_const*HCO3m*O2p rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 125)*sol(:ncol,:, 126) ! rate_const*O2m*O2p - rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 94)*sol(:ncol,:, 126) ! rate_const*CO4m*O2p - rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 112)*sol(:ncol,:, 126) ! rate_const*NO3m_H2O*O2p - rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 92)*sol(:ncol,:, 126) ! rate_const*CO3m2H2O*O2p - rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 87)*sol(:ncol,:, 126) ! rate_const*CLm*O2p - rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 93)*sol(:ncol,:, 126) ! rate_const*CO3m_H2O*O2p - rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 109)*sol(:ncol,:, 126) ! rate_const*NO2m_H2O*O2p - rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 113)*sol(:ncol,:, 126) ! rate_const*NO3m_HCL*O2p - rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 93)*sol(:ncol,:, 102) ! rate_const*CO3m_H2O*Hp_4H2O - rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 126)*sol(:ncol,:, 88) ! rate_const*O2p*CLm_H2O - rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 111)*sol(:ncol,:, 126) ! rate_const*NO3m2H2O*O2p - rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 108)*sol(:ncol,:, 126) ! rate_const*NO2m*O2p - rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 102)*sol(:ncol,:, 109) ! rate_const*Hp_4H2O*NO2m_H2O - rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 102)*sol(:ncol,:, 113) ! rate_const*Hp_4H2O*NO3m_HCL - rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 88)*sol(:ncol,:, 102) ! rate_const*CLm_H2O*Hp_4H2O - rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 111)*sol(:ncol,:, 102) ! rate_const*NO3m2H2O*Hp_4H2O - rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 102)*sol(:ncol,:, 108) ! rate_const*Hp_4H2O*NO2m - rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 104)*sol(:ncol,:, 114) ! rate_const*Hp_5H2O*NO3mHNO3 - rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 91)*sol(:ncol,:, 104) ! rate_const*CO3m*Hp_5H2O - rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 89)*sol(:ncol,:, 104) ! rate_const*CLm_HCL*Hp_5H2O - rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 91)*sol(:ncol,:, 102) ! rate_const*CO3m*Hp_4H2O - rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 110)*sol(:ncol,:, 104) ! rate_const*NO3m*Hp_5H2O - rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 97)*sol(:ncol,:, 104) ! rate_const*HCO3m*Hp_5H2O - rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 104)*sol(:ncol,:, 125) ! rate_const*Hp_5H2O*O2m - rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 94)*sol(:ncol,:, 104) ! rate_const*CO4m*Hp_5H2O - rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 104)*sol(:ncol,:, 112) ! rate_const*Hp_5H2O*NO3m_H2O - rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 92)*sol(:ncol,:, 104) ! rate_const*CO3m2H2O*Hp_5H2O - rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 87)*sol(:ncol,:, 104) ! rate_const*CLm*Hp_5H2O - rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 93)*sol(:ncol,:, 104) ! rate_const*CO3m_H2O*Hp_5H2O - rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 109)*sol(:ncol,:, 104) ! rate_const*NO2m_H2O*Hp_5H2O - rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 104)*sol(:ncol,:, 113) ! rate_const*Hp_5H2O*NO3m_HCL - rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 89)*sol(:ncol,:, 102) ! rate_const*CLm_HCL*Hp_4H2O - rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 88)*sol(:ncol,:, 104) ! rate_const*CLm_H2O*Hp_5H2O - rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 104)*sol(:ncol,:, 111) ! rate_const*Hp_5H2O*NO3m2H2O - rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 104)*sol(:ncol,:, 108) ! rate_const*Hp_5H2O*NO2m - rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 100)*sol(:ncol,:, 114) ! rate_const*Hp_3H2O*NO3mHNO3 - rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 100)*sol(:ncol,:, 91) ! rate_const*Hp_3H2O*CO3m - rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 89)*sol(:ncol,:, 100) ! rate_const*CLm_HCL*Hp_3H2O - rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 100)*sol(:ncol,:, 110) ! rate_const*Hp_3H2O*NO3m - rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 97)*sol(:ncol,:, 100) ! rate_const*HCO3m*Hp_3H2O - rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 100)*sol(:ncol,:, 125) ! rate_const*Hp_3H2O*O2m - rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 94)*sol(:ncol,:, 100) ! rate_const*CO4m*Hp_3H2O - rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 102)*sol(:ncol,:, 110) ! rate_const*Hp_4H2O*NO3m - rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 100)*sol(:ncol,:, 112) ! rate_const*Hp_3H2O*NO3m_H2O - rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 92)*sol(:ncol,:, 100) ! rate_const*CO3m2H2O*Hp_3H2O - rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 87)*sol(:ncol,:, 100) ! rate_const*CLm*Hp_3H2O - rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 93)*sol(:ncol,:, 100) ! rate_const*CO3m_H2O*Hp_3H2O - rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 100)*sol(:ncol,:, 109) ! rate_const*Hp_3H2O*NO2m_H2O - rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 100)*sol(:ncol,:, 113) ! rate_const*Hp_3H2O*NO3m_HCL - rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 88)*sol(:ncol,:, 100) ! rate_const*CLm_H2O*Hp_3H2O - rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 100)*sol(:ncol,:, 111) ! rate_const*Hp_3H2O*NO3m2H2O - rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 100)*sol(:ncol,:, 108) ! rate_const*Hp_3H2O*NO2m - rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 114)*sol(:ncol,:, 119) ! rate_const*NO3mHNO3*NOp_H2O - rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 97)*sol(:ncol,:, 102) ! rate_const*HCO3m*Hp_4H2O - rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 91)*sol(:ncol,:, 119) ! rate_const*CO3m*NOp_H2O - rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 89)*sol(:ncol,:, 119) ! rate_const*CLm_HCL*NOp_H2O - rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 110)*sol(:ncol,:, 119) ! rate_const*NO3m*NOp_H2O - rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 97)*sol(:ncol,:, 119) ! rate_const*HCO3m*NOp_H2O - rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 119)*sol(:ncol,:, 125) ! rate_const*NOp_H2O*O2m - rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 94)*sol(:ncol,:, 119) ! rate_const*CO4m*NOp_H2O - rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 112)*sol(:ncol,:, 119) ! rate_const*NO3m_H2O*NOp_H2O - rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 92)*sol(:ncol,:, 119) ! rate_const*CO3m2H2O*NOp_H2O - rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 87)*sol(:ncol,:, 119) ! rate_const*CLm*NOp_H2O - rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 93)*sol(:ncol,:, 119) ! rate_const*CO3m_H2O*NOp_H2O - rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 102)*sol(:ncol,:, 125) ! rate_const*Hp_4H2O*O2m - rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 109)*sol(:ncol,:, 119) ! rate_const*NO2m_H2O*NOp_H2O - rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 113)*sol(:ncol,:, 119) ! rate_const*NO3m_HCL*NOp_H2O - rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 88)*sol(:ncol,:, 119) ! rate_const*CLm_H2O*NOp_H2O - rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 111)*sol(:ncol,:, 119) ! rate_const*NO3m2H2O*NOp_H2O - rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 108)*sol(:ncol,:, 119) ! rate_const*NO2m*NOp_H2O - rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 114)*sol(:ncol,:, 116) ! rate_const*NO3mHNO3*NOp_2H2O - rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 91)*sol(:ncol,:, 116) ! rate_const*CO3m*NOp_2H2O - rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 89)*sol(:ncol,:, 116) ! rate_const*CLm_HCL*NOp_2H2O - rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 116)*sol(:ncol,:, 110) ! rate_const*NOp_2H2O*NO3m - rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 97)*sol(:ncol,:, 116) ! rate_const*HCO3m*NOp_2H2O - rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 94)*sol(:ncol,:, 102) ! rate_const*CO4m*Hp_4H2O - rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 116)*sol(:ncol,:, 125) ! rate_const*NOp_2H2O*O2m - rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 116)*sol(:ncol,:, 94) ! rate_const*NOp_2H2O*CO4m - rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 112)*sol(:ncol,:, 116) ! rate_const*NO3m_H2O*NOp_2H2O - rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 92)*sol(:ncol,:, 116) ! rate_const*CO3m2H2O*NOp_2H2O - rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 87)*sol(:ncol,:, 116) ! rate_const*CLm*NOp_2H2O - rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 93)*sol(:ncol,:, 116) ! rate_const*CO3m_H2O*NOp_2H2O - rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 116)*sol(:ncol,:, 109) ! rate_const*NOp_2H2O*NO2m_H2O - rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 113)*sol(:ncol,:, 116) ! rate_const*NO3m_HCL*NOp_2H2O - rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 116)*sol(:ncol,:, 88) ! rate_const*NOp_2H2O*CLm_H2O - rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 116)*sol(:ncol,:, 111) ! rate_const*NOp_2H2O*NO3m2H2O - rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 102)*sol(:ncol,:, 112) ! rate_const*Hp_4H2O*NO3m_H2O - rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 116)*sol(:ncol,:, 108) ! rate_const*NOp_2H2O*NO2m - rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 115)*sol(:ncol,:, 114) ! rate_const*NOp*NO3mHNO3 - rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 115)*sol(:ncol,:, 91) ! rate_const*NOp*CO3m - rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 115)*sol(:ncol,:, 89) ! rate_const*NOp*CLm_HCL - rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 110)*sol(:ncol,:, 115) ! rate_const*NO3m*NOp - rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 115)*sol(:ncol,:, 97) ! rate_const*NOp*HCO3m - rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 125)*sol(:ncol,:, 115) ! rate_const*O2m*NOp - rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 115)*sol(:ncol,:, 94) ! rate_const*NOp*CO4m - rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 115)*sol(:ncol,:, 112) ! rate_const*NOp*NO3m_H2O - rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 115)*sol(:ncol,:, 92) ! rate_const*NOp*CO3m2H2O - rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 92)*sol(:ncol,:, 102) ! rate_const*CO3m2H2O*Hp_4H2O - rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 87)*sol(:ncol,:, 115) ! rate_const*CLm*NOp - rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 93)*sol(:ncol,:, 115) ! rate_const*CO3m_H2O*NOp - rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 109)*sol(:ncol,:, 115) ! rate_const*NO2m_H2O*NOp - rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 113)*sol(:ncol,:, 115) ! rate_const*NO3m_HCL*NOp - rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 88)*sol(:ncol,:, 115) ! rate_const*CLm_H2O*NOp - rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 115)*sol(:ncol,:, 111) ! rate_const*NOp*NO3m2H2O - rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 115)*sol(:ncol,:, 108) ! rate_const*NOp*NO2m - rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 114)*sol(:ncol,:, 126) ! rate_const*NO3mHNO3*O2p - rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 126)*sol(:ncol,:, 91) ! rate_const*O2p*CO3m - rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 126)*sol(:ncol,:, 89) ! rate_const*O2p*CLm_HCL - rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 102)*sol(:ncol,:, 91) ! rate_const*M*Hp_4H2O*CO3m - rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 104)*sol(:ncol,:, 92) ! rate_const*M*Hp_5H2O*CO3m2H2O - rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 93)*sol(:ncol,:, 102) ! rate_const*M*CO3m_H2O*Hp_4H2O - rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 104)*sol(:ncol,:, 93) ! rate_const*M*Hp_5H2O*CO3m_H2O - rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 112)*sol(:ncol,:, 102) ! rate_const*M*NO3m_H2O*Hp_4H2O - rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 112)*sol(:ncol,:, 104) ! rate_const*M*NO3m_H2O*Hp_5H2O - rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 110)*sol(:ncol,:, 102) ! rate_const*M*NO3m*Hp_4H2O - rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 104)*sol(:ncol,:, 91) ! rate_const*M*Hp_5H2O*CO3m - rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 104)*sol(:ncol,:, 110) ! rate_const*M*Hp_5H2O*NO3m - rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 89)*sol(:ncol,:, 102) ! rate_const*M*CLm_HCL*Hp_4H2O - rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 104)*sol(:ncol,:, 89) ! rate_const*M*Hp_5H2O*CLm_HCL - rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 114)*sol(:ncol,:, 102) ! rate_const*M*NO3mHNO3*Hp_4H2O - rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 104)*sol(:ncol,:, 114) ! rate_const*M*Hp_5H2O*NO3mHNO3 - rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 92)*sol(:ncol,:, 102) ! rate_const*M*CO3m2H2O*Hp_4H2O - rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 60)*sol(:ncol,:, 128) ! rate_const*NO*O3m - rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 109) ! rate_const*M*NO2m_H2O - rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 111) ! rate_const*M*NO3m2H2O - rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 114) ! rate_const*M*NO3mHNO3 - rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 47)*sol(:ncol,:, 110) ! rate_const*M*HCL*NO3m - rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 61)*sol(:ncol,:, 128) ! rate_const*NO2*O3m - rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 61)*sol(:ncol,:, 128) ! rate_const*NO2*O3m - rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 60)*sol(:ncol,:, 128) ! rate_const*NO*O3m - rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 91)*sol(:ncol,:, 60) ! rate_const*CO3m*NO - rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 91)*sol(:ncol,:, 61) ! rate_const*CO3m*NO2 - rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 112) ! rate_const*M*NO3m_H2O - rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 93) ! rate_const*M*CO3m_H2O - rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 92) ! rate_const*M*CO3m2H2O - rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 86)*sol(:ncol,:, 108) ! rate_const*CL*NO2m - rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 26)*sol(:ncol,:, 108) ! rate_const*CLO*NO2m - rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 38)*sol(:ncol,:, 108) ! rate_const*H*NO2m - rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 108)*sol(:ncol,:, 137) ! rate_const*M*NO2m*H2O - rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 47)*sol(:ncol,:, 108) ! rate_const*HCL*NO2m - rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 49)*sol(:ncol,:, 108) ! rate_const*HNO3*NO2m - rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 61)*sol(:ncol,:, 108) ! rate_const*NO2*NO2m - rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 108)*sol(:ncol,:, 69) ! rate_const*NO2m*O3 - rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 111)*sol(:ncol,:, 56) ! rate_const*NO3m2H2O*N2O5 - rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 112)*sol(:ncol,:, 137) ! rate_const*M*NO3m_H2O*H2O - rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 49)*sol(:ncol,:, 112) ! rate_const*HNO3*NO3m_H2O - rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 137)*sol(:ncol,:, 110) ! rate_const*M*H2O*NO3m - rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 112)*sol(:ncol,:, 56) ! rate_const*NO3m_H2O*N2O5 - rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 47)*sol(:ncol,:, 110) ! rate_const*HCL*NO3m - rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 49)*sol(:ncol,:, 113) ! rate_const*HNO3*NO3m_HCL - rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 110)*sol(:ncol,:, 49) ! rate_const*M*NO3m*HNO3 - rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 110)*sol(:ncol,:, 67) ! rate_const*NO3m*O - rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 69)*sol(:ncol,:, 110) ! rate_const*O3*NO3m - rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 116)*sol(:ncol,:, 95) ! rate_const*NOp_2H2O*e - rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 117)*sol(:ncol,:, 95) ! rate_const*NOp_3H2O*e - rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 137)*sol(:ncol,:, 117) ! rate_const*H2O*NOp_3H2O - rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 118)*sol(:ncol,:, 95) ! rate_const*NOp_CO2*e - rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 118)*sol(:ncol,:, 137) ! rate_const*NOp_CO2*H2O - rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 119)*sol(:ncol,:, 95) ! rate_const*NOp_H2O*e - rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 38)*sol(:ncol,:, 119) ! rate_const*H*NOp_H2O - rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 119)*sol(:ncol,:, 98) ! rate_const*NOp_H2O*HO2 - rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 119)*sol(:ncol,:, 131) ! rate_const*NOp_H2O*OH - rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 30)*sol(:ncol,:, 120) ! rate_const*CO2*NOp_N2 - rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 120)*sol(:ncol,:, 137) ! rate_const*NOp_N2*H2O - rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 125)*sol(:ncol,:, 86) ! rate_const*O2m*CL - rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 26)*sol(:ncol,:, 125) ! rate_const*CLO*O2m - rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 30)*sol(:ncol,:, 125) ! rate_const*M*CO2*O2m - rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 38)*sol(:ncol,:, 125) ! rate_const*H*O2m - rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 125)*sol(:ncol,:, 47) ! rate_const*O2m*HCL - rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 125)*sol(:ncol,:, 49) ! rate_const*O2m*HNO3 - rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 61)*sol(:ncol,:, 125) ! rate_const*NO2*O2m + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 95)*sol(:ncol,:, 126) ! rate_const*CO4m*O2p + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 113)*sol(:ncol,:, 126) ! rate_const*NO3m_H2O*O2p + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 93)*sol(:ncol,:, 126) ! rate_const*CO3m2H2O*O2p + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 88)*sol(:ncol,:, 126) ! rate_const*CLm*O2p + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 94)*sol(:ncol,:, 126) ! rate_const*CO3m_H2O*O2p + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 110)*sol(:ncol,:, 126) ! rate_const*NO2m_H2O*O2p + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 114)*sol(:ncol,:, 126) ! rate_const*NO3m_HCL*O2p + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 94)*sol(:ncol,:, 103) ! rate_const*CO3m_H2O*Hp_4H2O + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 126)*sol(:ncol,:, 89) ! rate_const*O2p*CLm_H2O + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 112)*sol(:ncol,:, 126) ! rate_const*NO3m2H2O*O2p + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 109)*sol(:ncol,:, 126) ! rate_const*NO2m*O2p + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 103)*sol(:ncol,:, 110) ! rate_const*Hp_4H2O*NO2m_H2O + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 103)*sol(:ncol,:, 114) ! rate_const*Hp_4H2O*NO3m_HCL + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 89)*sol(:ncol,:, 103) ! rate_const*CLm_H2O*Hp_4H2O + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 112)*sol(:ncol,:, 103) ! rate_const*NO3m2H2O*Hp_4H2O + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 103)*sol(:ncol,:, 109) ! rate_const*Hp_4H2O*NO2m + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 105)*sol(:ncol,:, 115) ! rate_const*Hp_5H2O*NO3mHNO3 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 92)*sol(:ncol,:, 105) ! rate_const*CO3m*Hp_5H2O + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 90)*sol(:ncol,:, 105) ! rate_const*CLm_HCL*Hp_5H2O + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 92)*sol(:ncol,:, 103) ! rate_const*CO3m*Hp_4H2O + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 111)*sol(:ncol,:, 105) ! rate_const*NO3m*Hp_5H2O + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 98)*sol(:ncol,:, 105) ! rate_const*HCO3m*Hp_5H2O + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 105)*sol(:ncol,:, 125) ! rate_const*Hp_5H2O*O2m + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 95)*sol(:ncol,:, 105) ! rate_const*CO4m*Hp_5H2O + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 105)*sol(:ncol,:, 113) ! rate_const*Hp_5H2O*NO3m_H2O + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 93)*sol(:ncol,:, 105) ! rate_const*CO3m2H2O*Hp_5H2O + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 88)*sol(:ncol,:, 105) ! rate_const*CLm*Hp_5H2O + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 94)*sol(:ncol,:, 105) ! rate_const*CO3m_H2O*Hp_5H2O + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 110)*sol(:ncol,:, 105) ! rate_const*NO2m_H2O*Hp_5H2O + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 105)*sol(:ncol,:, 114) ! rate_const*Hp_5H2O*NO3m_HCL + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 90)*sol(:ncol,:, 103) ! rate_const*CLm_HCL*Hp_4H2O + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 89)*sol(:ncol,:, 105) ! rate_const*CLm_H2O*Hp_5H2O + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 105)*sol(:ncol,:, 112) ! rate_const*Hp_5H2O*NO3m2H2O + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 105)*sol(:ncol,:, 109) ! rate_const*Hp_5H2O*NO2m + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 101)*sol(:ncol,:, 115) ! rate_const*Hp_3H2O*NO3mHNO3 + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 101)*sol(:ncol,:, 92) ! rate_const*Hp_3H2O*CO3m + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 90)*sol(:ncol,:, 101) ! rate_const*CLm_HCL*Hp_3H2O + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 101)*sol(:ncol,:, 111) ! rate_const*Hp_3H2O*NO3m + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 98)*sol(:ncol,:, 101) ! rate_const*HCO3m*Hp_3H2O + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 101)*sol(:ncol,:, 125) ! rate_const*Hp_3H2O*O2m + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 95)*sol(:ncol,:, 101) ! rate_const*CO4m*Hp_3H2O + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 103)*sol(:ncol,:, 111) ! rate_const*Hp_4H2O*NO3m + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 101)*sol(:ncol,:, 113) ! rate_const*Hp_3H2O*NO3m_H2O + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 93)*sol(:ncol,:, 101) ! rate_const*CO3m2H2O*Hp_3H2O + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 88)*sol(:ncol,:, 101) ! rate_const*CLm*Hp_3H2O + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 94)*sol(:ncol,:, 101) ! rate_const*CO3m_H2O*Hp_3H2O + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 101)*sol(:ncol,:, 110) ! rate_const*Hp_3H2O*NO2m_H2O + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 101)*sol(:ncol,:, 114) ! rate_const*Hp_3H2O*NO3m_HCL + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 89)*sol(:ncol,:, 101) ! rate_const*CLm_H2O*Hp_3H2O + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 101)*sol(:ncol,:, 112) ! rate_const*Hp_3H2O*NO3m2H2O + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 101)*sol(:ncol,:, 109) ! rate_const*Hp_3H2O*NO2m + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 115)*sol(:ncol,:, 120) ! rate_const*NO3mHNO3*NOp_H2O + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 98)*sol(:ncol,:, 103) ! rate_const*HCO3m*Hp_4H2O + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 92)*sol(:ncol,:, 120) ! rate_const*CO3m*NOp_H2O + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 90)*sol(:ncol,:, 120) ! rate_const*CLm_HCL*NOp_H2O + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 111)*sol(:ncol,:, 120) ! rate_const*NO3m*NOp_H2O + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 98)*sol(:ncol,:, 120) ! rate_const*HCO3m*NOp_H2O + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 120)*sol(:ncol,:, 125) ! rate_const*NOp_H2O*O2m + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 95)*sol(:ncol,:, 120) ! rate_const*CO4m*NOp_H2O + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 113)*sol(:ncol,:, 120) ! rate_const*NO3m_H2O*NOp_H2O + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 93)*sol(:ncol,:, 120) ! rate_const*CO3m2H2O*NOp_H2O + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 88)*sol(:ncol,:, 120) ! rate_const*CLm*NOp_H2O + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 94)*sol(:ncol,:, 120) ! rate_const*CO3m_H2O*NOp_H2O + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 103)*sol(:ncol,:, 125) ! rate_const*Hp_4H2O*O2m + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 110)*sol(:ncol,:, 120) ! rate_const*NO2m_H2O*NOp_H2O + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 114)*sol(:ncol,:, 120) ! rate_const*NO3m_HCL*NOp_H2O + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 89)*sol(:ncol,:, 120) ! rate_const*CLm_H2O*NOp_H2O + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 112)*sol(:ncol,:, 120) ! rate_const*NO3m2H2O*NOp_H2O + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 109)*sol(:ncol,:, 120) ! rate_const*NO2m*NOp_H2O + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 115)*sol(:ncol,:, 117) ! rate_const*NO3mHNO3*NOp_2H2O + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 92)*sol(:ncol,:, 117) ! rate_const*CO3m*NOp_2H2O + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 90)*sol(:ncol,:, 117) ! rate_const*CLm_HCL*NOp_2H2O + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 117)*sol(:ncol,:, 111) ! rate_const*NOp_2H2O*NO3m + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 98)*sol(:ncol,:, 117) ! rate_const*HCO3m*NOp_2H2O + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 95)*sol(:ncol,:, 103) ! rate_const*CO4m*Hp_4H2O + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 117)*sol(:ncol,:, 125) ! rate_const*NOp_2H2O*O2m + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 117)*sol(:ncol,:, 95) ! rate_const*NOp_2H2O*CO4m + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 113)*sol(:ncol,:, 117) ! rate_const*NO3m_H2O*NOp_2H2O + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 93)*sol(:ncol,:, 117) ! rate_const*CO3m2H2O*NOp_2H2O + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 88)*sol(:ncol,:, 117) ! rate_const*CLm*NOp_2H2O + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 94)*sol(:ncol,:, 117) ! rate_const*CO3m_H2O*NOp_2H2O + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 117)*sol(:ncol,:, 110) ! rate_const*NOp_2H2O*NO2m_H2O + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 114)*sol(:ncol,:, 117) ! rate_const*NO3m_HCL*NOp_2H2O + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 117)*sol(:ncol,:, 89) ! rate_const*NOp_2H2O*CLm_H2O + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 117)*sol(:ncol,:, 112) ! rate_const*NOp_2H2O*NO3m2H2O + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 103)*sol(:ncol,:, 113) ! rate_const*Hp_4H2O*NO3m_H2O + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 117)*sol(:ncol,:, 109) ! rate_const*NOp_2H2O*NO2m + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 116)*sol(:ncol,:, 115) ! rate_const*NOp*NO3mHNO3 + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 116)*sol(:ncol,:, 92) ! rate_const*NOp*CO3m + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 116)*sol(:ncol,:, 90) ! rate_const*NOp*CLm_HCL + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 111)*sol(:ncol,:, 116) ! rate_const*NO3m*NOp + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 116)*sol(:ncol,:, 98) ! rate_const*NOp*HCO3m + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 125)*sol(:ncol,:, 116) ! rate_const*O2m*NOp + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 116)*sol(:ncol,:, 95) ! rate_const*NOp*CO4m + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 116)*sol(:ncol,:, 113) ! rate_const*NOp*NO3m_H2O + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 116)*sol(:ncol,:, 93) ! rate_const*NOp*CO3m2H2O + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 93)*sol(:ncol,:, 103) ! rate_const*CO3m2H2O*Hp_4H2O + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 88)*sol(:ncol,:, 116) ! rate_const*CLm*NOp + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 94)*sol(:ncol,:, 116) ! rate_const*CO3m_H2O*NOp + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 110)*sol(:ncol,:, 116) ! rate_const*NO2m_H2O*NOp + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 114)*sol(:ncol,:, 116) ! rate_const*NO3m_HCL*NOp + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 89)*sol(:ncol,:, 116) ! rate_const*CLm_H2O*NOp + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 116)*sol(:ncol,:, 112) ! rate_const*NOp*NO3m2H2O + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 116)*sol(:ncol,:, 109) ! rate_const*NOp*NO2m + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 115)*sol(:ncol,:, 126) ! rate_const*NO3mHNO3*O2p + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 126)*sol(:ncol,:, 92) ! rate_const*O2p*CO3m + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 126)*sol(:ncol,:, 90) ! rate_const*O2p*CLm_HCL + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 103)*sol(:ncol,:, 92) ! rate_const*M*Hp_4H2O*CO3m + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 105)*sol(:ncol,:, 93) ! rate_const*M*Hp_5H2O*CO3m2H2O + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 94)*sol(:ncol,:, 103) ! rate_const*M*CO3m_H2O*Hp_4H2O + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 105)*sol(:ncol,:, 94) ! rate_const*M*Hp_5H2O*CO3m_H2O + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 113)*sol(:ncol,:, 103) ! rate_const*M*NO3m_H2O*Hp_4H2O + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 113)*sol(:ncol,:, 105) ! rate_const*M*NO3m_H2O*Hp_5H2O + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 111)*sol(:ncol,:, 103) ! rate_const*M*NO3m*Hp_4H2O + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 105)*sol(:ncol,:, 92) ! rate_const*M*Hp_5H2O*CO3m + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 105)*sol(:ncol,:, 111) ! rate_const*M*Hp_5H2O*NO3m + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 90)*sol(:ncol,:, 103) ! rate_const*M*CLm_HCL*Hp_4H2O + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 105)*sol(:ncol,:, 90) ! rate_const*M*Hp_5H2O*CLm_HCL + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 115)*sol(:ncol,:, 103) ! rate_const*M*NO3mHNO3*Hp_4H2O + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 105)*sol(:ncol,:, 115) ! rate_const*M*Hp_5H2O*NO3mHNO3 + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 93)*sol(:ncol,:, 103) ! rate_const*M*CO3m2H2O*Hp_4H2O + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 62)*sol(:ncol,:, 128) ! rate_const*NO*O3m + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 110) ! rate_const*M*NO2m_H2O + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 112) ! rate_const*M*NO3m2H2O + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 115) ! rate_const*M*NO3mHNO3 + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 49)*sol(:ncol,:, 111) ! rate_const*M*HCL*NO3m + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 63)*sol(:ncol,:, 128) ! rate_const*NO2*O3m + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 63)*sol(:ncol,:, 128) ! rate_const*NO2*O3m + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 62)*sol(:ncol,:, 128) ! rate_const*NO*O3m + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 92)*sol(:ncol,:, 62) ! rate_const*CO3m*NO + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 92)*sol(:ncol,:, 63) ! rate_const*CO3m*NO2 + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 113) ! rate_const*M*NO3m_H2O + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 94) ! rate_const*M*CO3m_H2O + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 93) ! rate_const*M*CO3m2H2O + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 25)*sol(:ncol,:, 109) ! rate_const*CL*NO2m + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 28)*sol(:ncol,:, 109) ! rate_const*CLO*NO2m + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 40)*sol(:ncol,:, 109) ! rate_const*H*NO2m + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 109)*sol(:ncol,:, 137) ! rate_const*M*NO2m*H2O + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 49)*sol(:ncol,:, 109) ! rate_const*HCL*NO2m + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 51)*sol(:ncol,:, 109) ! rate_const*HNO3*NO2m + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 63)*sol(:ncol,:, 109) ! rate_const*NO2*NO2m + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 109)*sol(:ncol,:, 72) ! rate_const*NO2m*O3 + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 112)*sol(:ncol,:, 58) ! rate_const*NO3m2H2O*N2O5 + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 113)*sol(:ncol,:, 137) ! rate_const*M*NO3m_H2O*H2O + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 51)*sol(:ncol,:, 113) ! rate_const*HNO3*NO3m_H2O + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 137)*sol(:ncol,:, 111) ! rate_const*M*H2O*NO3m + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 113)*sol(:ncol,:, 58) ! rate_const*NO3m_H2O*N2O5 + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 49)*sol(:ncol,:, 111) ! rate_const*HCL*NO3m + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 51)*sol(:ncol,:, 114) ! rate_const*HNO3*NO3m_HCL + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 111)*sol(:ncol,:, 51) ! rate_const*M*NO3m*HNO3 + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 111)*sol(:ncol,:, 69) ! rate_const*NO3m*O + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 72)*sol(:ncol,:, 111) ! rate_const*O3*NO3m + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 117)*sol(:ncol,:, 96) ! rate_const*NOp_2H2O*e + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 118)*sol(:ncol,:, 96) ! rate_const*NOp_3H2O*e + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 137)*sol(:ncol,:, 118) ! rate_const*H2O*NOp_3H2O + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 119)*sol(:ncol,:, 96) ! rate_const*NOp_CO2*e + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 119)*sol(:ncol,:, 137) ! rate_const*NOp_CO2*H2O + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 120)*sol(:ncol,:, 96) ! rate_const*NOp_H2O*e + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 40)*sol(:ncol,:, 120) ! rate_const*H*NOp_H2O + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 120)*sol(:ncol,:, 99) ! rate_const*NOp_H2O*HO2 + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 120)*sol(:ncol,:, 131) ! rate_const*NOp_H2O*OH + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 32)*sol(:ncol,:, 121) ! rate_const*CO2*NOp_N2 + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 121)*sol(:ncol,:, 137) ! rate_const*NOp_N2*H2O + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 125)*sol(:ncol,:, 25) ! rate_const*O2m*CL + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 28)*sol(:ncol,:, 125) ! rate_const*CLO*O2m + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 32)*sol(:ncol,:, 125) ! rate_const*M*CO2*O2m + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 40)*sol(:ncol,:, 125) ! rate_const*H*O2m + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 125)*sol(:ncol,:, 49) ! rate_const*O2m*HCL + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 125)*sol(:ncol,:, 51) ! rate_const*O2m*HNO3 + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 63)*sol(:ncol,:, 125) ! rate_const*NO2*O2m rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 123)*sol(:ncol,:, 125) ! rate_const*O2_1D*O2m - rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 68)*sol(:ncol,:, 125) ! rate_const*M*O2*O2m - rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 69)*sol(:ncol,:, 125) ! rate_const*O3*O2m - rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 67)*sol(:ncol,:, 125) ! rate_const*O*O2m - rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 125)*sol(:ncol,:, 67) ! rate_const*O2m*O - rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 127)*sol(:ncol,:, 95) ! rate_const*O2p_H2O*e + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 71)*sol(:ncol,:, 125) ! rate_const*M*O2*O2m + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 72)*sol(:ncol,:, 125) ! rate_const*O3*O2m + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 69)*sol(:ncol,:, 125) ! rate_const*O*O2m + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 125)*sol(:ncol,:, 69) ! rate_const*O2m*O + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 127)*sol(:ncol,:, 96) ! rate_const*O2p_H2O*e rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 127)*sol(:ncol,:, 137) ! rate_const*O2p_H2O*H2O rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 127)*sol(:ncol,:, 137) ! rate_const*O2p_H2O*H2O rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 137)*sol(:ncol,:, 126) ! rate_const*M*H2O*O2p - rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 128)*sol(:ncol,:, 30) ! rate_const*O3m*CO2 - rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 128)*sol(:ncol,:, 38) ! rate_const*O3m*H - rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 69)*sol(:ncol,:, 128) ! rate_const*O3*O3m - rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 128)*sol(:ncol,:, 67) ! rate_const*O3m*O - rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 67)*sol(:ncol,:, 128) ! rate_const*O*O3m - rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 30)*sol(:ncol,:, 129) ! rate_const*CO2*O4m - rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 67)*sol(:ncol,:, 129) ! rate_const*O*O4m + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 128)*sol(:ncol,:, 32) ! rate_const*O3m*CO2 + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 128)*sol(:ncol,:, 40) ! rate_const*O3m*H + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 72)*sol(:ncol,:, 128) ! rate_const*O3*O3m + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 128)*sol(:ncol,:, 69) ! rate_const*O3m*O + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 69)*sol(:ncol,:, 128) ! rate_const*O*O3m + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 32)*sol(:ncol,:, 129) ! rate_const*CO2*O4m + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 69)*sol(:ncol,:, 129) ! rate_const*O*O4m rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 137)*sol(:ncol,:, 130) ! rate_const*H2O*O4p - rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 130)*sol(:ncol,:, 67) ! rate_const*O4p*O + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 130)*sol(:ncol,:, 69) ! rate_const*O4p*O rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 130)*sol(:ncol,:, 123) ! rate_const*O4p*O2_1D - rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 53)*sol(:ncol,:, 131) ! rate_const*HONO*OH - rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 86)*sol(:ncol,:, 132) ! rate_const*CL*OHm - rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 26)*sol(:ncol,:, 132) ! rate_const*CLO*OHm - rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 30)*sol(:ncol,:, 132) ! rate_const*M*CO2*OHm - rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 38)*sol(:ncol,:, 132) ! rate_const*H*OHm - rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 132)*sol(:ncol,:, 47) ! rate_const*OHm*HCL - rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 61)*sol(:ncol,:, 132) ! rate_const*NO2*OHm - rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 132)*sol(:ncol,:, 67) ! rate_const*OHm*O - rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 132)*sol(:ncol,:, 69) ! rate_const*OHm*O3 - rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 131)*sol(:ncol,:, 60) ! rate_const*M*OH*NO - rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 133)*sol(:ncol,:, 86) ! rate_const*Om*CL - rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 26)*sol(:ncol,:, 133) ! rate_const*CLO*Om - rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 133)*sol(:ncol,:, 30) ! rate_const*M*Om*CO2 - rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 39)*sol(:ncol,:, 133) ! rate_const*H2*Om - rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 133)*sol(:ncol,:, 39) ! rate_const*Om*H2 + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 55)*sol(:ncol,:, 131) ! rate_const*HONO*OH + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 25)*sol(:ncol,:, 132) ! rate_const*CL*OHm + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 28)*sol(:ncol,:, 132) ! rate_const*CLO*OHm + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 32)*sol(:ncol,:, 132) ! rate_const*M*CO2*OHm + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 40)*sol(:ncol,:, 132) ! rate_const*H*OHm + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 132)*sol(:ncol,:, 49) ! rate_const*OHm*HCL + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 63)*sol(:ncol,:, 132) ! rate_const*NO2*OHm + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 132)*sol(:ncol,:, 69) ! rate_const*OHm*O + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 132)*sol(:ncol,:, 72) ! rate_const*OHm*O3 + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 131)*sol(:ncol,:, 62) ! rate_const*M*OH*NO + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 133)*sol(:ncol,:, 25) ! rate_const*Om*CL + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 28)*sol(:ncol,:, 133) ! rate_const*CLO*Om + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 133)*sol(:ncol,:, 32) ! rate_const*M*Om*CO2 + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 41)*sol(:ncol,:, 133) ! rate_const*H2*Om + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 133)*sol(:ncol,:, 41) ! rate_const*Om*H2 rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 133)*sol(:ncol,:, 137) ! rate_const*Om*H2O - rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 133)*sol(:ncol,:, 47) ! rate_const*Om*HCL - rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 133)*sol(:ncol,:, 49) ! rate_const*Om*HNO3 + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 133)*sol(:ncol,:, 49) ! rate_const*Om*HCL + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 133)*sol(:ncol,:, 51) ! rate_const*Om*HNO3 rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 133) ! rate_const*M*Om - rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 61)*sol(:ncol,:, 133) ! rate_const*NO2*Om - rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 133)*sol(:ncol,:, 67) ! rate_const*Om*O + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 63)*sol(:ncol,:, 133) ! rate_const*NO2*Om + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 133)*sol(:ncol,:, 69) ! rate_const*Om*O rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 133)*sol(:ncol,:, 123) ! rate_const*Om*O2_1D - rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 133)*sol(:ncol,:, 68) ! rate_const*M*Om*O2 - rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 69)*sol(:ncol,:, 133) ! rate_const*O3*Om - rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 126)*sol(:ncol,:, 68) ! rate_const*M*O2p*O2 - rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 137)*sol(:ncol,:, 115) ! rate_const*M*H2O*NOp - rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 137)*sol(:ncol,:, 119) ! rate_const*M*H2O*NOp_H2O - rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 137)*sol(:ncol,:, 116) ! rate_const*M*H2O*NOp_2H2O - rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 115)*sol(:ncol,:, 30) ! rate_const*M*NOp*CO2 - rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 118) ! rate_const*M*NOp_CO2 - rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 115) ! rate_const*N2*M*NOp - rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 120) ! rate_const*M*NOp_N2 - rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 105)*sol(:ncol,:, 137) ! rate_const*M*Hp_H2O*H2O - rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 99) ! rate_const*M*Hp_2H2O - rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 137)*sol(:ncol,:, 99) ! rate_const*M*H2O*Hp_2H2O - rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 100) ! rate_const*M*Hp_3H2O - rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 100)*sol(:ncol,:, 137) ! rate_const*M*Hp_3H2O*H2O - rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 102) ! rate_const*M*Hp_4H2O - rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 102)*sol(:ncol,:, 137) ! rate_const*M*Hp_4H2O*H2O - rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 104) ! rate_const*M*Hp_5H2O - rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 95)*sol(:ncol,:, 130) ! rate_const*e*O4p - rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 105)*sol(:ncol,:, 95) ! rate_const*Hp_H2O*e - rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 99)*sol(:ncol,:, 95) ! rate_const*Hp_2H2O*e - rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 100)*sol(:ncol,:, 95) ! rate_const*Hp_3H2O*e - rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 95)*sol(:ncol,:, 120) ! rate_const*e*NOp_N2 - rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 88) ! rate_const*M*CLm_H2O - rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 89) ! rate_const*M*CLm_HCL + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 133)*sol(:ncol,:, 71) ! rate_const*M*Om*O2 + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 72)*sol(:ncol,:, 133) ! rate_const*O3*Om + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 126)*sol(:ncol,:, 71) ! rate_const*M*O2p*O2 + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 137)*sol(:ncol,:, 116) ! rate_const*M*H2O*NOp + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 137)*sol(:ncol,:, 120) ! rate_const*M*H2O*NOp_H2O + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 137)*sol(:ncol,:, 117) ! rate_const*M*H2O*NOp_2H2O + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 116)*sol(:ncol,:, 32) ! rate_const*M*NOp*CO2 + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 119) ! rate_const*M*NOp_CO2 + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 116) ! rate_const*N2*M*NOp + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 121) ! rate_const*M*NOp_N2 + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 106)*sol(:ncol,:, 137) ! rate_const*M*Hp_H2O*H2O + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 100) ! rate_const*M*Hp_2H2O + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 137)*sol(:ncol,:, 100) ! rate_const*M*H2O*Hp_2H2O + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 101) ! rate_const*M*Hp_3H2O + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 101)*sol(:ncol,:, 137) ! rate_const*M*Hp_3H2O*H2O + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 103) ! rate_const*M*Hp_4H2O + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 103)*sol(:ncol,:, 137) ! rate_const*M*Hp_4H2O*H2O + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 105) ! rate_const*M*Hp_5H2O + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 96)*sol(:ncol,:, 130) ! rate_const*e*O4p + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 106)*sol(:ncol,:, 96) ! rate_const*Hp_H2O*e + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 100)*sol(:ncol,:, 96) ! rate_const*Hp_2H2O*e + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 101)*sol(:ncol,:, 96) ! rate_const*Hp_3H2O*e + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 96)*sol(:ncol,:, 121) ! rate_const*e*NOp_N2 + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 89) ! rate_const*M*CLm_H2O + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 90) ! rate_const*M*CLm_HCL rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 123) ! rate_const*O2_1D rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 124) ! rate_const*O2_1S - rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 122)*sol(:ncol,:, 39) ! rate_const*O1D*H2 - rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 122)*sol(:ncol,:, 137) ! rate_const*O1D*H2O - rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 122) ! rate_const*N2*O1D - rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 122)*sol(:ncol,:, 68) ! rate_const*O1D*O2 - rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 122)*sol(:ncol,:, 68) ! rate_const*O1D*O2 - rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 122)*sol(:ncol,:, 69) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 70)*sol(:ncol,:, 41) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 70)*sol(:ncol,:, 137) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 70) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 70)*sol(:ncol,:, 71) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 70)*sol(:ncol,:, 71) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 70)*sol(:ncol,:, 72) ! rate_const*O1D*O3 rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 123) ! rate_const*N2*O2_1D - rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 123)*sol(:ncol,:, 67) ! rate_const*O2_1D*O - rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 123)*sol(:ncol,:, 68) ! rate_const*O2_1D*O2 - rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 124)*sol(:ncol,:, 30) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 123)*sol(:ncol,:, 69) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 123)*sol(:ncol,:, 71) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 124)*sol(:ncol,:, 32) ! rate_const*O2_1S*CO2 rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 124) ! rate_const*N2*O2_1S - rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 124)*sol(:ncol,:, 67) ! rate_const*O2_1S*O - rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 124)*sol(:ncol,:, 68) ! rate_const*O2_1S*O2 - rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 124)*sol(:ncol,:, 69) ! rate_const*O2_1S*O3 - rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 67)*sol(:ncol,:, 69) ! rate_const*O*O3 - rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 67)*sol(:ncol,:, 67) ! rate_const*M*O*O - rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 67)*sol(:ncol,:, 68) ! rate_const*M*O*O2 - rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 39)*sol(:ncol,:, 67) ! rate_const*H2*O - rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 41)*sol(:ncol,:, 67) ! rate_const*H2O2*O - rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 38)*sol(:ncol,:, 98) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 38)*sol(:ncol,:, 98) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 38)*sol(:ncol,:, 98) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 38)*sol(:ncol,:, 68) ! rate_const*M*H*O2 - rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 98)*sol(:ncol,:, 67) ! rate_const*HO2*O - rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 98)*sol(:ncol,:, 69) ! rate_const*HO2*O3 - rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 38)*sol(:ncol,:, 69) ! rate_const*H*O3 - rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 131)*sol(:ncol,:, 39) ! rate_const*OH*H2 - rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 131)*sol(:ncol,:, 41) ! rate_const*OH*H2O2 - rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 131)*sol(:ncol,:, 98) ! rate_const*OH*HO2 - rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 131)*sol(:ncol,:, 67) ! rate_const*OH*O - rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 131)*sol(:ncol,:, 69) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 124)*sol(:ncol,:, 69) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 124)*sol(:ncol,:, 71) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 124)*sol(:ncol,:, 72) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 69)*sol(:ncol,:, 72) ! rate_const*O*O3 + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 69)*sol(:ncol,:, 69) ! rate_const*M*O*O + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 69)*sol(:ncol,:, 71) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 41)*sol(:ncol,:, 69) ! rate_const*H2*O + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 43)*sol(:ncol,:, 69) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 40)*sol(:ncol,:, 99) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 40)*sol(:ncol,:, 99) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 40)*sol(:ncol,:, 99) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 40)*sol(:ncol,:, 71) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 99)*sol(:ncol,:, 69) ! rate_const*HO2*O + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 99)*sol(:ncol,:, 72) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 40)*sol(:ncol,:, 72) ! rate_const*H*O3 + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 131)*sol(:ncol,:, 41) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 131)*sol(:ncol,:, 43) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 131)*sol(:ncol,:, 99) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 131)*sol(:ncol,:, 69) ! rate_const*OH*O + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 131)*sol(:ncol,:, 72) ! rate_const*OH*O3 rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 131)*sol(:ncol,:, 131) ! rate_const*OH*OH rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 131)*sol(:ncol,:, 131) ! rate_const*M*OH*OH - rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 98)*sol(:ncol,:, 98) ! rate_const*HO2*HO2 - rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 50)*sol(:ncol,:, 131) ! rate_const*HO2NO2*OH - rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 106)*sol(:ncol,:, 67) ! rate_const*N2D*O - rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 106)*sol(:ncol,:, 68) ! rate_const*N2D*O2 - rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 54)*sol(:ncol,:, 60) ! rate_const*N*NO - rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 54)*sol(:ncol,:, 61) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 54)*sol(:ncol,:, 61) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 54)*sol(:ncol,:, 61) ! rate_const*N*NO2 - rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 54)*sol(:ncol,:, 68) ! rate_const*N*O2 - rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 61)*sol(:ncol,:, 67) ! rate_const*NO2*O - rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 61)*sol(:ncol,:, 69) ! rate_const*NO2*O3 - rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 61)*sol(:ncol,:, 67) ! rate_const*M*NO2*O - rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 62)*sol(:ncol,:, 98) ! rate_const*NO3*HO2 - rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 62)*sol(:ncol,:, 60) ! rate_const*NO3*NO - rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 62)*sol(:ncol,:, 67) ! rate_const*NO3*O - rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 62)*sol(:ncol,:, 131) ! rate_const*NO3*OH - rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 54)*sol(:ncol,:, 131) ! rate_const*N*OH - rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 60)*sol(:ncol,:, 98) ! rate_const*NO*HO2 - rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 60)*sol(:ncol,:, 69) ! rate_const*NO*O3 - rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 60)*sol(:ncol,:, 67) ! rate_const*M*NO*O - rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 122)*sol(:ncol,:, 55) ! rate_const*O1D*N2O - rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 122)*sol(:ncol,:, 55) ! rate_const*O1D*N2O - rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 61)*sol(:ncol,:, 98) ! rate_const*M*NO2*HO2 - rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 61)*sol(:ncol,:, 62) ! rate_const*M*NO2*NO3 - rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 61)*sol(:ncol,:, 131) ! rate_const*M*NO2*OH - rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 49)*sol(:ncol,:, 131) ! rate_const*HNO3*OH - rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 50) ! rate_const*M*HO2NO2 - rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 56) ! rate_const*M*N2O5 - rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 86)*sol(:ncol,:, 16) ! rate_const*CL*CH2O - rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 86)*sol(:ncol,:, 22) ! rate_const*CL*CH4 - rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 86)*sol(:ncol,:, 39) ! rate_const*CL*H2 - rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 86)*sol(:ncol,:, 41) ! rate_const*CL*H2O2 - rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 86)*sol(:ncol,:, 98) ! rate_const*CL*HO2 - rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 86)*sol(:ncol,:, 98) ! rate_const*CL*HO2 - rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 86)*sol(:ncol,:, 69) ! rate_const*CL*O3 - rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 26)*sol(:ncol,:, 20) ! rate_const*CLO*CH3O2 - rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 26)*sol(:ncol,:, 98) ! rate_const*CLO*HO2 - rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 26)*sol(:ncol,:, 60) ! rate_const*CLO*NO - rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 27)*sol(:ncol,:, 86) ! rate_const*CLONO2*CL - rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 26)*sol(:ncol,:, 61) ! rate_const*M*CLO*NO2 - rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 27)*sol(:ncol,:, 67) ! rate_const*CLONO2*O - rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 27)*sol(:ncol,:, 131) ! rate_const*CLONO2*OH - rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 26)*sol(:ncol,:, 67) ! rate_const*CLO*O - rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 26)*sol(:ncol,:, 131) ! rate_const*CLO*OH - rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 26)*sol(:ncol,:, 131) ! rate_const*CLO*OH - rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 47)*sol(:ncol,:, 67) ! rate_const*HCL*O - rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 47)*sol(:ncol,:, 131) ! rate_const*HCL*OH - rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 52)*sol(:ncol,:, 86) ! rate_const*HOCL*CL - rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 52)*sol(:ncol,:, 67) ! rate_const*HOCL*O - rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 52)*sol(:ncol,:, 131) ! rate_const*HOCL*OH - rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 122)*sol(:ncol,:, 7) ! rate_const*O1D*CCL4 - rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 122)*sol(:ncol,:, 8) ! rate_const*O1D*CF2CLBR - rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 122)*sol(:ncol,:, 10) ! rate_const*O1D*CFC11 - rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 122)*sol(:ncol,:, 11) ! rate_const*O1D*CFC113 - rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 122)*sol(:ncol,:, 12) ! rate_const*O1D*CFC114 - rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 122)*sol(:ncol,:, 13) ! rate_const*O1D*CFC115 - rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 122)*sol(:ncol,:, 14) ! rate_const*O1D*CFC12 - rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 122)*sol(:ncol,:, 47) ! rate_const*O1D*HCL - rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 122)*sol(:ncol,:, 47) ! rate_const*O1D*HCL - rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 26)*sol(:ncol,:, 26) ! rate_const*M*CLO*CLO - rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 25) ! rate_const*M*CL2O2 - rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 85)*sol(:ncol,:, 16) ! rate_const*BR*CH2O - rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 85)*sol(:ncol,:, 98) ! rate_const*BR*HO2 - rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 85)*sol(:ncol,:, 69) ! rate_const*BR*O3 - rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 4)*sol(:ncol,:, 4) ! rate_const*BRO*BRO - rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 4)*sol(:ncol,:, 26) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 4)*sol(:ncol,:, 26) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 4)*sol(:ncol,:, 26) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 4)*sol(:ncol,:, 98) ! rate_const*BRO*HO2 - rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 4)*sol(:ncol,:, 60) ! rate_const*BRO*NO - rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 4)*sol(:ncol,:, 61) ! rate_const*M*BRO*NO2 - rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 5)*sol(:ncol,:, 67) ! rate_const*BRONO2*O - rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 4)*sol(:ncol,:, 67) ! rate_const*BRO*O - rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 4)*sol(:ncol,:, 131) ! rate_const*BRO*OH - rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 43)*sol(:ncol,:, 67) ! rate_const*HBR*O - rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 43)*sol(:ncol,:, 131) ! rate_const*HBR*OH - rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 51)*sol(:ncol,:, 67) ! rate_const*HOBR*O - rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 122)*sol(:ncol,:, 9) ! rate_const*O1D*CF3BR - rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 122)*sol(:ncol,:, 23) ! rate_const*O1D*CHBR3 - rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 122)*sol(:ncol,:, 40) ! rate_const*O1D*H2402 - rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 122)*sol(:ncol,:, 43) ! rate_const*O1D*HBR - rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 122)*sol(:ncol,:, 43) ! rate_const*O1D*HBR - rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 37)*sol(:ncol,:, 22) ! rate_const*F*CH4 - rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 37)*sol(:ncol,:, 39) ! rate_const*F*H2 - rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 37)*sol(:ncol,:, 137) ! rate_const*F*H2O - rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 37)*sol(:ncol,:, 49) ! rate_const*F*HNO3 - rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 122)*sol(:ncol,:, 31) ! rate_const*O1D*COF2 - rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 122)*sol(:ncol,:, 32) ! rate_const*O1D*COFCL - rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 15)*sol(:ncol,:, 86) ! rate_const*CH2BR2*CL - rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 15)*sol(:ncol,:, 131) ! rate_const*CH2BR2*OH - rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 17)*sol(:ncol,:, 86) ! rate_const*CH3BR*CL - rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 17)*sol(:ncol,:, 131) ! rate_const*CH3BR*OH - rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 18)*sol(:ncol,:, 131) ! rate_const*CH3CCL3*OH - rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 19)*sol(:ncol,:, 86) ! rate_const*CH3CL*CL - rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 19)*sol(:ncol,:, 131) ! rate_const*CH3CL*OH - rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 23)*sol(:ncol,:, 86) ! rate_const*CHBR3*CL - rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 23)*sol(:ncol,:, 131) ! rate_const*CHBR3*OH - rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 44)*sol(:ncol,:, 131) ! rate_const*HCFC141B*OH - rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 45)*sol(:ncol,:, 131) ! rate_const*HCFC142B*OH - rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 46)*sol(:ncol,:, 131) ! rate_const*HCFC22*OH - rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 122)*sol(:ncol,:, 15) ! rate_const*O1D*CH2BR2 - rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 122)*sol(:ncol,:, 17) ! rate_const*O1D*CH3BR - rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 122)*sol(:ncol,:, 44) ! rate_const*O1D*HCFC141B - rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 122)*sol(:ncol,:, 45) ! rate_const*O1D*HCFC142B - rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 122)*sol(:ncol,:, 46) ! rate_const*O1D*HCFC22 - rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 16)*sol(:ncol,:, 62) ! rate_const*CH2O*NO3 - rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 16)*sol(:ncol,:, 67) ! rate_const*CH2O*O - rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 16)*sol(:ncol,:, 131) ! rate_const*CH2O*OH - rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 20)*sol(:ncol,:, 98) ! rate_const*CH3O2*HO2 - rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 20)*sol(:ncol,:, 60) ! rate_const*CH3O2*NO - rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 21)*sol(:ncol,:, 131) ! rate_const*CH3OOH*OH - rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 22)*sol(:ncol,:, 131) ! rate_const*CH4*OH - rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 29)*sol(:ncol,:, 131) ! rate_const*M*CO*OH - rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 122)*sol(:ncol,:, 22) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 122)*sol(:ncol,:, 22) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 122)*sol(:ncol,:, 22) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 29)*sol(:ncol,:, 131) ! rate_const*CO*OH - rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 71)*sol(:ncol,:, 67) ! rate_const*OCS*O - rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 71)*sol(:ncol,:, 131) ! rate_const*OCS*OH - rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 74)*sol(:ncol,:, 68) ! rate_const*S*O2 - rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 74)*sol(:ncol,:, 69) ! rate_const*S*O3 - rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 76)*sol(:ncol,:, 4) ! rate_const*SO*BRO - rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 76)*sol(:ncol,:, 26) ! rate_const*SO*CLO - rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 74)*sol(:ncol,:, 131) ! rate_const*S*OH - rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 76)*sol(:ncol,:, 61) ! rate_const*SO*NO2 - rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 76)*sol(:ncol,:, 68) ! rate_const*SO*O2 - rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 76)*sol(:ncol,:, 69) ! rate_const*SO*O3 - rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 76)*sol(:ncol,:, 70) ! rate_const*SO*OCLO - rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 76)*sol(:ncol,:, 131) ! rate_const*SO*OH - rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 77)*sol(:ncol,:, 131) ! rate_const*SO2*OH - rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 78)*sol(:ncol,:, 137) ! rate_const*SO3*H2O - rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 33)*sol(:ncol,:, 62) ! rate_const*DMS*NO3 - rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 33)*sol(:ncol,:, 131) ! rate_const*DMS*OH - rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 33)*sol(:ncol,:, 131) ! rate_const*DMS*OH - rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 98) ! rate_const*HO2 - rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 56) ! rate_const*N2O5 - rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 61) ! rate_const*NO2 - rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 62) ! rate_const*NO3 - rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 56) ! rate_const*N2O5 - rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 52)*sol(:ncol,:, 47) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 5) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 56) ! rate_const*N2O5 - rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 27) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 5) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 27)*sol(:ncol,:, 47) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 52)*sol(:ncol,:, 47) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 51)*sol(:ncol,:, 47) ! rate_const*HOBR*HCL - rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 27) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 5) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 27)*sol(:ncol,:, 47) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 52)*sol(:ncol,:, 47) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 51)*sol(:ncol,:, 47) ! rate_const*HOBR*HCL - rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 56) ! rate_const*N2O5 - rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 27) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 27)*sol(:ncol,:, 47) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 136) ! rate_const*Op2P - rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 135) ! rate_const*Op2D - rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 136) ! rate_const*Op2P - rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 115)*sol(:ncol,:, 95) ! rate_const*NOp*e - rxt_rates(:ncol,:, 584) = rxt_rates(:ncol,:, 584)*sol(:ncol,:, 126)*sol(:ncol,:, 95) ! rate_const*O2p*e - rxt_rates(:ncol,:, 585) = rxt_rates(:ncol,:, 585)*sol(:ncol,:, 107)*sol(:ncol,:, 95) ! rate_const*N2p*e - rxt_rates(:ncol,:, 586) = rxt_rates(:ncol,:, 586)*sol(:ncol,:, 107)*sol(:ncol,:, 68) ! rate_const*N2p*O2 - rxt_rates(:ncol,:, 587) = rxt_rates(:ncol,:, 587)*sol(:ncol,:, 107)*sol(:ncol,:, 67) ! rate_const*N2p*O - rxt_rates(:ncol,:, 588) = rxt_rates(:ncol,:, 588)*sol(:ncol,:, 107)*sol(:ncol,:, 67) ! rate_const*N2p*O - rxt_rates(:ncol,:, 589) = rxt_rates(:ncol,:, 589)*sol(:ncol,:, 121)*sol(:ncol,:, 67) ! rate_const*Np*O - rxt_rates(:ncol,:, 590) = rxt_rates(:ncol,:, 590)*sol(:ncol,:, 121)*sol(:ncol,:, 68) ! rate_const*Np*O2 - rxt_rates(:ncol,:, 591) = rxt_rates(:ncol,:, 591)*sol(:ncol,:, 121)*sol(:ncol,:, 68) ! rate_const*Np*O2 - rxt_rates(:ncol,:, 592) = rxt_rates(:ncol,:, 592)*sol(:ncol,:, 126)*sol(:ncol,:, 54) ! rate_const*O2p*N - rxt_rates(:ncol,:, 593) = rxt_rates(:ncol,:, 593)*sol(:ncol,:, 126) ! rate_const*N2*O2p - rxt_rates(:ncol,:, 594) = rxt_rates(:ncol,:, 594)*sol(:ncol,:, 126)*sol(:ncol,:, 60) ! rate_const*O2p*NO - rxt_rates(:ncol,:, 595) = rxt_rates(:ncol,:, 595)*sol(:ncol,:, 134)*sol(:ncol,:, 30) ! rate_const*Op*CO2 - rxt_rates(:ncol,:, 596) = rxt_rates(:ncol,:, 596)*sol(:ncol,:, 134) ! rate_const*N2*Op - rxt_rates(:ncol,:, 597) = rxt_rates(:ncol,:, 597)*sol(:ncol,:, 134)*sol(:ncol,:, 106) ! rate_const*Op*N2D - rxt_rates(:ncol,:, 598) = rxt_rates(:ncol,:, 598)*sol(:ncol,:, 134)*sol(:ncol,:, 68) ! rate_const*Op*O2 - rxt_rates(:ncol,:, 599) = rxt_rates(:ncol,:, 599)*sol(:ncol,:, 135)*sol(:ncol,:, 95) ! rate_const*Op2D*e - rxt_rates(:ncol,:, 600) = rxt_rates(:ncol,:, 600)*sol(:ncol,:, 135) ! rate_const*N2*Op2D - rxt_rates(:ncol,:, 601) = rxt_rates(:ncol,:, 601)*sol(:ncol,:, 135)*sol(:ncol,:, 67) ! rate_const*Op2D*O - rxt_rates(:ncol,:, 602) = rxt_rates(:ncol,:, 602)*sol(:ncol,:, 135)*sol(:ncol,:, 68) ! rate_const*Op2D*O2 - rxt_rates(:ncol,:, 603) = rxt_rates(:ncol,:, 603)*sol(:ncol,:, 136)*sol(:ncol,:, 95) ! rate_const*Op2P*e - rxt_rates(:ncol,:, 604) = rxt_rates(:ncol,:, 604)*sol(:ncol,:, 136)*sol(:ncol,:, 95) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 99)*sol(:ncol,:, 99) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 52)*sol(:ncol,:, 131) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 107)*sol(:ncol,:, 69) ! rate_const*N2D*O + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 107)*sol(:ncol,:, 71) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 56)*sol(:ncol,:, 62) ! rate_const*N*NO + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 56)*sol(:ncol,:, 63) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 56)*sol(:ncol,:, 63) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 56)*sol(:ncol,:, 63) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 56)*sol(:ncol,:, 71) ! rate_const*N*O2 + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 63)*sol(:ncol,:, 69) ! rate_const*NO2*O + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 63)*sol(:ncol,:, 72) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 63)*sol(:ncol,:, 69) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 64)*sol(:ncol,:, 99) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 64)*sol(:ncol,:, 62) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 64)*sol(:ncol,:, 69) ! rate_const*NO3*O + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 64)*sol(:ncol,:, 131) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 56)*sol(:ncol,:, 131) ! rate_const*N*OH + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 62)*sol(:ncol,:, 99) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 62)*sol(:ncol,:, 72) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 62)*sol(:ncol,:, 69) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 70)*sol(:ncol,:, 57) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 70)*sol(:ncol,:, 57) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 63)*sol(:ncol,:, 99) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 63)*sol(:ncol,:, 64) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 63)*sol(:ncol,:, 131) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 51)*sol(:ncol,:, 131) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 52) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 58) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 25)*sol(:ncol,:, 17) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 25)*sol(:ncol,:, 23) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 25)*sol(:ncol,:, 41) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 25)*sol(:ncol,:, 43) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 25)*sol(:ncol,:, 99) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 25)*sol(:ncol,:, 99) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 25)*sol(:ncol,:, 72) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 28)*sol(:ncol,:, 21) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 28)*sol(:ncol,:, 99) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 28)*sol(:ncol,:, 62) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 29)*sol(:ncol,:, 25) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 28)*sol(:ncol,:, 63) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 29)*sol(:ncol,:, 69) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 29)*sol(:ncol,:, 131) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 28)*sol(:ncol,:, 69) ! rate_const*CLO*O + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 28)*sol(:ncol,:, 131) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 28)*sol(:ncol,:, 131) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 49)*sol(:ncol,:, 69) ! rate_const*HCL*O + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 49)*sol(:ncol,:, 131) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 54)*sol(:ncol,:, 25) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 54)*sol(:ncol,:, 69) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 54)*sol(:ncol,:, 131) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 70)*sol(:ncol,:, 8) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 70)*sol(:ncol,:, 9) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 70)*sol(:ncol,:, 11) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 70)*sol(:ncol,:, 12) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 70)*sol(:ncol,:, 13) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 70)*sol(:ncol,:, 14) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 70)*sol(:ncol,:, 15) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 70)*sol(:ncol,:, 49) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 70)*sol(:ncol,:, 49) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 27) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 3)*sol(:ncol,:, 17) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 3)*sol(:ncol,:, 99) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 3)*sol(:ncol,:, 72) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 5)*sol(:ncol,:, 5) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 5)*sol(:ncol,:, 28) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 5)*sol(:ncol,:, 28) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 5)*sol(:ncol,:, 28) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 5)*sol(:ncol,:, 99) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 5)*sol(:ncol,:, 62) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 5)*sol(:ncol,:, 63) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 6)*sol(:ncol,:, 69) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 5)*sol(:ncol,:, 69) ! rate_const*BRO*O + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 5)*sol(:ncol,:, 131) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 45)*sol(:ncol,:, 69) ! rate_const*HBR*O + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 45)*sol(:ncol,:, 131) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 53)*sol(:ncol,:, 69) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 70)*sol(:ncol,:, 10) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 70)*sol(:ncol,:, 24) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 70)*sol(:ncol,:, 42) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 70)*sol(:ncol,:, 45) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 70)*sol(:ncol,:, 45) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 39)*sol(:ncol,:, 23) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 39)*sol(:ncol,:, 41) ! rate_const*F*H2 + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 39)*sol(:ncol,:, 137) ! rate_const*F*H2O + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 39)*sol(:ncol,:, 51) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 70)*sol(:ncol,:, 33) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 70)*sol(:ncol,:, 34) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 16)*sol(:ncol,:, 25) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 16)*sol(:ncol,:, 131) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 18)*sol(:ncol,:, 25) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 18)*sol(:ncol,:, 131) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 19)*sol(:ncol,:, 131) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 20)*sol(:ncol,:, 25) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 20)*sol(:ncol,:, 131) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 24)*sol(:ncol,:, 25) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 24)*sol(:ncol,:, 131) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 46)*sol(:ncol,:, 131) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 47)*sol(:ncol,:, 131) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 48)*sol(:ncol,:, 131) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 70)*sol(:ncol,:, 16) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 70)*sol(:ncol,:, 18) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 70)*sol(:ncol,:, 46) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 70)*sol(:ncol,:, 47) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 70)*sol(:ncol,:, 48) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 17)*sol(:ncol,:, 64) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 17)*sol(:ncol,:, 69) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 17)*sol(:ncol,:, 131) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 21)*sol(:ncol,:, 99) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 21)*sol(:ncol,:, 62) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 22)*sol(:ncol,:, 131) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 23)*sol(:ncol,:, 131) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 70)*sol(:ncol,:, 23) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 70)*sol(:ncol,:, 23) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 70)*sol(:ncol,:, 23) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 31)*sol(:ncol,:, 131) ! rate_const*CO*OH + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 35)*sol(:ncol,:, 64) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 35)*sol(:ncol,:, 131) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 74)*sol(:ncol,:, 69) ! rate_const*OCS*O + rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 74)*sol(:ncol,:, 131) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 77)*sol(:ncol,:, 71) ! rate_const*S*O2 + rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 80)*sol(:ncol,:, 131) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 77)*sol(:ncol,:, 72) ! rate_const*S*O3 + rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 79)*sol(:ncol,:, 5) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 79)*sol(:ncol,:, 28) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 77)*sol(:ncol,:, 131) ! rate_const*S*OH + rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 79)*sol(:ncol,:, 63) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 79)*sol(:ncol,:, 71) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 79)*sol(:ncol,:, 72) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 79)*sol(:ncol,:, 73) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 79)*sol(:ncol,:, 131) ! rate_const*SO*OH + rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 35)*sol(:ncol,:, 131) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 81)*sol(:ncol,:, 137) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 99) ! rate_const*HO2 + rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 58) ! rate_const*N2O5 + rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 63) ! rate_const*NO2 + rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 64) ! rate_const*NO3 + rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 58) ! rate_const*N2O5 + rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 54)*sol(:ncol,:, 49) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 58) ! rate_const*N2O5 + rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 29)*sol(:ncol,:, 49) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 54)*sol(:ncol,:, 49) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 53)*sol(:ncol,:, 49) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 29)*sol(:ncol,:, 49) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 54)*sol(:ncol,:, 49) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 53)*sol(:ncol,:, 49) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 58) ! rate_const*N2O5 + rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 29)*sol(:ncol,:, 49) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 136) ! rate_const*Op2P + rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 135) ! rate_const*Op2D + rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 136) ! rate_const*Op2P + rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 116)*sol(:ncol,:, 96) ! rate_const*NOp*e + rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 126)*sol(:ncol,:, 96) ! rate_const*O2p*e + rxt_rates(:ncol,:, 584) = rxt_rates(:ncol,:, 584)*sol(:ncol,:, 108)*sol(:ncol,:, 96) ! rate_const*N2p*e + rxt_rates(:ncol,:, 585) = rxt_rates(:ncol,:, 585)*sol(:ncol,:, 108)*sol(:ncol,:, 71) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 586) = rxt_rates(:ncol,:, 586)*sol(:ncol,:, 108)*sol(:ncol,:, 69) ! rate_const*N2p*O + rxt_rates(:ncol,:, 587) = rxt_rates(:ncol,:, 587)*sol(:ncol,:, 108)*sol(:ncol,:, 69) ! rate_const*N2p*O + rxt_rates(:ncol,:, 588) = rxt_rates(:ncol,:, 588)*sol(:ncol,:, 122)*sol(:ncol,:, 69) ! rate_const*Np*O + rxt_rates(:ncol,:, 589) = rxt_rates(:ncol,:, 589)*sol(:ncol,:, 122)*sol(:ncol,:, 71) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 590) = rxt_rates(:ncol,:, 590)*sol(:ncol,:, 122)*sol(:ncol,:, 71) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 591) = rxt_rates(:ncol,:, 591)*sol(:ncol,:, 126)*sol(:ncol,:, 56) ! rate_const*O2p*N + rxt_rates(:ncol,:, 592) = rxt_rates(:ncol,:, 592)*sol(:ncol,:, 126) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 593) = rxt_rates(:ncol,:, 593)*sol(:ncol,:, 126)*sol(:ncol,:, 62) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 594) = rxt_rates(:ncol,:, 594)*sol(:ncol,:, 134)*sol(:ncol,:, 32) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 595) = rxt_rates(:ncol,:, 595)*sol(:ncol,:, 134) ! rate_const*N2*Op + rxt_rates(:ncol,:, 596) = rxt_rates(:ncol,:, 596)*sol(:ncol,:, 134)*sol(:ncol,:, 107) ! rate_const*Op*N2D + rxt_rates(:ncol,:, 597) = rxt_rates(:ncol,:, 597)*sol(:ncol,:, 134)*sol(:ncol,:, 71) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 598) = rxt_rates(:ncol,:, 598)*sol(:ncol,:, 135)*sol(:ncol,:, 96) ! rate_const*Op2D*e + rxt_rates(:ncol,:, 599) = rxt_rates(:ncol,:, 599)*sol(:ncol,:, 135) ! rate_const*N2*Op2D + rxt_rates(:ncol,:, 600) = rxt_rates(:ncol,:, 600)*sol(:ncol,:, 135)*sol(:ncol,:, 69) ! rate_const*Op2D*O + rxt_rates(:ncol,:, 601) = rxt_rates(:ncol,:, 601)*sol(:ncol,:, 135)*sol(:ncol,:, 71) ! rate_const*Op2D*O2 + rxt_rates(:ncol,:, 602) = rxt_rates(:ncol,:, 602)*sol(:ncol,:, 136)*sol(:ncol,:, 96) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 603) = rxt_rates(:ncol,:, 603)*sol(:ncol,:, 136)*sol(:ncol,:, 96) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 604) = rxt_rates(:ncol,:, 604)*sol(:ncol,:, 136) ! rate_const*N2*Op2P rxt_rates(:ncol,:, 605) = rxt_rates(:ncol,:, 605)*sol(:ncol,:, 136) ! rate_const*N2*Op2P - rxt_rates(:ncol,:, 606) = rxt_rates(:ncol,:, 606)*sol(:ncol,:, 136) ! rate_const*N2*Op2P - rxt_rates(:ncol,:, 607) = rxt_rates(:ncol,:, 607)*sol(:ncol,:, 136)*sol(:ncol,:, 67) ! rate_const*Op2P*O + rxt_rates(:ncol,:, 606) = rxt_rates(:ncol,:, 606)*sol(:ncol,:, 136)*sol(:ncol,:, 69) ! rate_const*Op2P*O end subroutine set_rates end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_setrxt.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_setrxt.F90 index 4afca6d204..211122efbc 100644 --- a/src/chemistry/pp_waccm_mad_mam4/mo_setrxt.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/mo_setrxt.F90 @@ -167,7 +167,7 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,424) = 7e-13_r8 rate(:,425) = 5e-12_r8 rate(:,434) = 3.5e-12_r8 - rate(:,436) = 1e-11_r8 + rate(:,436) = 1.3e-11_r8 rate(:,437) = 2.2e-11_r8 rate(:,438) = 5e-11_r8 rate(:,473) = 1.7e-13_r8 @@ -192,41 +192,44 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,527) = 1.794e-10_r8 rate(:,528) = 1.3e-10_r8 rate(:,529) = 7.65e-11_r8 - rate(:,538) = 1.31e-10_r8 - rate(:,539) = 3.5e-11_r8 - rate(:,540) = 9e-12_r8 - rate(:,544) = 2.3e-12_r8 - rate(:,545) = 1.2e-11_r8 - rate(:,546) = 5.7e-11_r8 - rate(:,547) = 2.8e-11_r8 - rate(:,548) = 6.6e-11_r8 - rate(:,549) = 1.4e-11_r8 - rate(:,552) = 1.9e-12_r8 - rate(:,580) = 0.047_r8 - rate(:,581) = 7.7e-05_r8 - rate(:,582) = 0.171_r8 - rate(:,586) = 6e-11_r8 - rate(:,589) = 1e-12_r8 - rate(:,590) = 4e-10_r8 - rate(:,591) = 2e-10_r8 - rate(:,592) = 1e-10_r8 - rate(:,593) = 5e-16_r8 - rate(:,594) = 4.4e-10_r8 - rate(:,595) = 9e-10_r8 - rate(:,597) = 1.3e-10_r8 - rate(:,600) = 8e-10_r8 - rate(:,601) = 5e-12_r8 - rate(:,602) = 7e-10_r8 - rate(:,605) = 4.8e-10_r8 - rate(:,606) = 1e-10_r8 - rate(:,607) = 4e-10_r8 + rate(:,537) = 1.31e-10_r8 + rate(:,538) = 3.5e-11_r8 + rate(:,539) = 9e-12_r8 + rate(:,545) = 2.3e-12_r8 + rate(:,547) = 1.2e-11_r8 + rate(:,548) = 5.7e-11_r8 + rate(:,549) = 2.8e-11_r8 + rate(:,550) = 6.6e-11_r8 + rate(:,551) = 1.4e-11_r8 + rate(:,554) = 1.9e-12_r8 + rate(:,579) = 0.047_r8 + rate(:,580) = 7.7e-05_r8 + rate(:,581) = 0.171_r8 + rate(:,585) = 6e-11_r8 + rate(:,588) = 1e-12_r8 + rate(:,589) = 4e-10_r8 + rate(:,590) = 2e-10_r8 + rate(:,591) = 1e-10_r8 + rate(:,592) = 5e-16_r8 + rate(:,593) = 4.4e-10_r8 + rate(:,594) = 9e-10_r8 + rate(:,596) = 1.3e-10_r8 + rate(:,599) = 8e-10_r8 + rate(:,600) = 5e-12_r8 + rate(:,601) = 7e-10_r8 + rate(:,604) = 4.8e-10_r8 + rate(:,605) = 1e-10_r8 + rate(:,606) = 4e-10_r8 do n = 1,pver offset = (n-1)*ncol itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,n) end do - rate(:,340) = 1.8e-11_r8 * exp( 390._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,340) = 3e-12_r8 * exp_fac(:) + rate(:,417) = 4.8e-11_r8 * exp_fac(:) + rate(:,498) = 1.7e-11_r8 * exp_fac(:) rate(:,390) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) rate(:,391) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) exp_fac(:) = exp( 55._r8 * itemp(:) ) @@ -245,27 +248,26 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,413) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) rate(:,414) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) rate(:,415) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) - exp_fac(:) = exp( 250._r8 * itemp(:) ) - rate(:,417) = 4.8e-11_r8 * exp_fac(:) - rate(:,498) = 1.7e-11_r8 * exp_fac(:) rate(:,418) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) rate(:,419) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) - rate(:,423) = 1.3e-12_r8 * exp( 380._r8 * itemp(:) ) + rate(:,423) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) rate(:,426) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) exp_fac(:) = exp( 220._r8 * itemp(:) ) rate(:,427) = 2.9e-12_r8 * exp_fac(:) rate(:,428) = 1.45e-12_r8 * exp_fac(:) rate(:,429) = 1.45e-12_r8 * exp_fac(:) - rate(:,430) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:,430) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) rate(:,431) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) exp_fac(:) = exp( -2450._r8 * itemp(:) ) rate(:,432) = 1.2e-13_r8 * exp_fac(:) rate(:,458) = 3e-11_r8 * exp_fac(:) - rate(:,435) = 1.5e-11_r8 * exp( 170._r8 * itemp(:) ) - exp_fac(:) = exp( 270._r8 * itemp(:) ) - rate(:,439) = 3.3e-12_r8 * exp_fac(:) - rate(:,454) = 1.4e-11_r8 * exp_fac(:) - rate(:,468) = 7.4e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,435) = 1.7e-11_r8 * exp_fac(:) + rate(:,532) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,439) = 3.44e-12_r8 * exp_fac(:) + rate(:,491) = 2.3e-12_r8 * exp_fac(:) + rate(:,494) = 8.8e-12_r8 * exp_fac(:) exp_fac(:) = exp( -1500._r8 * itemp(:) ) rate(:,440) = 3e-12_r8 * exp_fac(:) rate(:,499) = 5.8e-12_r8 * exp_fac(:) @@ -276,6 +278,9 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,451) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) rate(:,452) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) rate(:,453) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,454) = 1.4e-11_r8 * exp_fac(:) + rate(:,468) = 7.4e-12_r8 * exp_fac(:) rate(:,455) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) rate(:,456) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) rate(:,457) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) @@ -307,9 +312,6 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,487) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) rate(:,488) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) rate(:,490) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) - exp_fac(:) = exp( 260._r8 * itemp(:) ) - rate(:,491) = 2.3e-12_r8 * exp_fac(:) - rate(:,494) = 8.8e-12_r8 * exp_fac(:) rate(:,493) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) rate(:,496) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) rate(:,501) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) @@ -323,41 +325,39 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,527) = 1.794e-10_r8 * exp_fac(:) rate(:,528) = 1.3e-10_r8 * exp_fac(:) rate(:,529) = 7.65e-11_r8 * exp_fac(:) - rate(:,538) = 1.31e-10_r8 * exp_fac(:) - rate(:,539) = 3.5e-11_r8 * exp_fac(:) - rate(:,540) = 9e-12_r8 * exp_fac(:) - rate(:,544) = 2.3e-12_r8 * exp_fac(:) - rate(:,545) = 1.2e-11_r8 * exp_fac(:) - rate(:,546) = 5.7e-11_r8 * exp_fac(:) - rate(:,547) = 2.8e-11_r8 * exp_fac(:) - rate(:,548) = 6.6e-11_r8 * exp_fac(:) - rate(:,549) = 1.4e-11_r8 * exp_fac(:) - rate(:,552) = 1.9e-12_r8 * exp_fac(:) - rate(:,580) = 0.047_r8 * exp_fac(:) - rate(:,581) = 7.7e-05_r8 * exp_fac(:) - rate(:,582) = 0.171_r8 * exp_fac(:) - rate(:,586) = 6e-11_r8 * exp_fac(:) - rate(:,589) = 1e-12_r8 * exp_fac(:) - rate(:,590) = 4e-10_r8 * exp_fac(:) - rate(:,591) = 2e-10_r8 * exp_fac(:) - rate(:,592) = 1e-10_r8 * exp_fac(:) - rate(:,593) = 5e-16_r8 * exp_fac(:) - rate(:,594) = 4.4e-10_r8 * exp_fac(:) - rate(:,595) = 9e-10_r8 * exp_fac(:) - rate(:,597) = 1.3e-10_r8 * exp_fac(:) - rate(:,600) = 8e-10_r8 * exp_fac(:) - rate(:,601) = 5e-12_r8 * exp_fac(:) - rate(:,602) = 7e-10_r8 * exp_fac(:) - rate(:,605) = 4.8e-10_r8 * exp_fac(:) - rate(:,606) = 1e-10_r8 * exp_fac(:) - rate(:,607) = 4e-10_r8 * exp_fac(:) + rate(:,537) = 1.31e-10_r8 * exp_fac(:) + rate(:,538) = 3.5e-11_r8 * exp_fac(:) + rate(:,539) = 9e-12_r8 * exp_fac(:) + rate(:,545) = 2.3e-12_r8 * exp_fac(:) + rate(:,547) = 1.2e-11_r8 * exp_fac(:) + rate(:,548) = 5.7e-11_r8 * exp_fac(:) + rate(:,549) = 2.8e-11_r8 * exp_fac(:) + rate(:,550) = 6.6e-11_r8 * exp_fac(:) + rate(:,551) = 1.4e-11_r8 * exp_fac(:) + rate(:,554) = 1.9e-12_r8 * exp_fac(:) + rate(:,579) = 0.047_r8 * exp_fac(:) + rate(:,580) = 7.7e-05_r8 * exp_fac(:) + rate(:,581) = 0.171_r8 * exp_fac(:) + rate(:,585) = 6e-11_r8 * exp_fac(:) + rate(:,588) = 1e-12_r8 * exp_fac(:) + rate(:,589) = 4e-10_r8 * exp_fac(:) + rate(:,590) = 2e-10_r8 * exp_fac(:) + rate(:,591) = 1e-10_r8 * exp_fac(:) + rate(:,592) = 5e-16_r8 * exp_fac(:) + rate(:,593) = 4.4e-10_r8 * exp_fac(:) + rate(:,594) = 9e-10_r8 * exp_fac(:) + rate(:,596) = 1.3e-10_r8 * exp_fac(:) + rate(:,599) = 8e-10_r8 * exp_fac(:) + rate(:,600) = 5e-12_r8 * exp_fac(:) + rate(:,601) = 7e-10_r8 * exp_fac(:) + rate(:,604) = 4.8e-10_r8 * exp_fac(:) + rate(:,605) = 1e-10_r8 * exp_fac(:) + rate(:,606) = 4e-10_r8 * exp_fac(:) rate(:,510) = 6e-12_r8 * exp( 400._r8 * itemp(:) ) rate(:,515) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) rate(:,516) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) rate(:,517) = 1.64e-12_r8 * exp( -1520._r8 * itemp(:) ) - exp_fac(:) = exp( -1100._r8 * itemp(:) ) - rate(:,518) = 2.03e-11_r8 * exp_fac(:) - rate(:,551) = 3.4e-12_r8 * exp_fac(:) + rate(:,518) = 2.03e-11_r8 * exp( -1110._r8 * itemp(:) ) rate(:,519) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) rate(:,520) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) rate(:,521) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) @@ -367,16 +367,16 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,523) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) rate(:,524) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) rate(:,530) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) - rate(:,532) = 5.5e-12_r8 * exp( 125._r8 * itemp(:) ) rate(:,533) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) rate(:,534) = 2.8e-12_r8 * exp( 300._r8 * itemp(:) ) rate(:,536) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) - rate(:,542) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) - rate(:,543) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) - rate(:,550) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) - rate(:,553) = 2.7e-11_r8 * exp( 335._r8 * itemp(:) ) - rate(:,556) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) - rate(:,557) = 9.6e-12_r8 * exp( -234._r8 * itemp(:) ) + rate(:,541) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,542) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,543) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,544) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,552) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,553) = 3.4e-12_r8 * exp( -1100._r8 * itemp(:) ) + rate(:,555) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) itemp(:) = 300._r8 * itemp(:) @@ -386,8 +386,8 @@ subroutine setrxt( rate, temp, m, ncol ) kinf(:) = 3.6e-11_r8 * itemp(:)**0.1_r8 call jpl( rate(:,349), m, 0.6_r8, ko, kinf, n ) - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + ko(:) = 5.3e-32_r8 * itemp(:)**1.8_r8 + kinf(:) = 9.5e-11_r8 * itemp(:)**(-0.4_r8) call jpl( rate(:,411), m, 0.6_r8, ko, kinf, n ) ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 @@ -426,9 +426,9 @@ subroutine setrxt( rate, temp, m, ncol ) kinf(:) = 6.9e-12_r8 * itemp(:)**2.9_r8 call jpl( rate(:,495), m, 0.6_r8, ko, kinf, n ) - ko(:) = 5.9e-33_r8 * itemp(:)**1._r8 - kinf(:) = 1.1e-12_r8 * itemp(:)**(-1.3_r8) - call jpl( rate(:,537), 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(:,546), m, 0.6_r8, ko, kinf, n ) end subroutine setrxt @@ -473,22 +473,22 @@ subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) rate(:n,408) = 6.9e-12_r8 rate(:n,424) = 7e-13_r8 rate(:n,425) = 5e-12_r8 - rate(:n,580) = 0.047_r8 - rate(:n,581) = 7.7e-05_r8 - rate(:n,582) = 0.171_r8 - rate(:n,586) = 6e-11_r8 - rate(:n,589) = 1e-12_r8 - rate(:n,590) = 4e-10_r8 - rate(:n,591) = 2e-10_r8 - rate(:n,592) = 1e-10_r8 - rate(:n,594) = 4.4e-10_r8 - rate(:n,597) = 1.3e-10_r8 - rate(:n,600) = 8e-10_r8 - rate(:n,601) = 5e-12_r8 - rate(:n,602) = 7e-10_r8 - rate(:n,605) = 4.8e-10_r8 - rate(:n,606) = 1e-10_r8 - rate(:n,607) = 4e-10_r8 + rate(:n,579) = 0.047_r8 + rate(:n,580) = 7.7e-05_r8 + rate(:n,581) = 0.171_r8 + rate(:n,585) = 6e-11_r8 + rate(:n,588) = 1e-12_r8 + rate(:n,589) = 4e-10_r8 + rate(:n,590) = 2e-10_r8 + rate(:n,591) = 1e-10_r8 + rate(:n,593) = 4.4e-10_r8 + rate(:n,596) = 1.3e-10_r8 + rate(:n,599) = 8e-10_r8 + rate(:n,600) = 5e-12_r8 + rate(:n,601) = 7e-10_r8 + rate(:n,604) = 4.8e-10_r8 + rate(:n,605) = 1e-10_r8 + rate(:n,606) = 4e-10_r8 do k = 1,kbot offset = (k-1)*ncol @@ -510,16 +510,16 @@ subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) rate(:n,418) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) rate(:n,419) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) rate(:n,426) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) - rate(:n,430) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:n,430) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) rate(:n,431) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) - rate(:n,439) = 3.3e-12_r8 * exp( 270._r8 * itemp(:) ) + rate(:n,439) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) rate(:n,440) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) itemp(:) = 300._r8 * itemp(:) - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + 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,411) = wrk(:) diff --git a/src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 b/src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 index 67551cd7b7..40115997a6 100644 --- a/src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 +++ b/src/chemistry/pp_waccm_mad_mam4/mo_sim_dat.F90 @@ -31,93 +31,92 @@ subroutine set_sim_dat is_scalar = .false. is_vector = .true. - clscnt(:) = (/ 23, 0, 0, 114, 0 /) + clscnt(:) = (/ 0, 0, 0, 137, 0 /) - cls_rxt_cnt(:,1) = (/ 66, 66, 0, 23 /) - cls_rxt_cnt(:,4) = (/ 30, 163, 413, 114 /) + cls_rxt_cnt(:,4) = (/ 8, 142, 456, 137 /) - solsym(:137) = (/ 'bc_a1 ','bc_a4 ','BRCL ','BRO ','BRONO2 ', & - 'BRY ','CCL4 ','CF2CLBR ','CF3BR ','CFC11 ', & - 'CFC113 ','CFC114 ','CFC115 ','CFC12 ','CH2BR2 ', & - 'CH2O ','CH3BR ','CH3CCL3 ','CH3CL ','CH3O2 ', & - 'CH3OOH ','CH4 ','CHBR3 ','CL2 ','CL2O2 ', & - 'CLO ','CLONO2 ','CLY ','CO ','CO2 ', & - 'COF2 ','COFCL ','DMS ','dst_a1 ','dst_a2 ', & - 'dst_a3 ','F ','H ','H2 ','H2402 ', & - 'H2O2 ','H2SO4 ','HBR ','HCFC141B ','HCFC142B ', & - 'HCFC22 ','HCL ','HF ','HNO3 ','HO2NO2 ', & - 'HOBR ','HOCL ','HONO ','N ','N2O ', & - 'N2O5 ','ncl_a1 ','ncl_a2 ','ncl_a3 ','NO ', & - 'NO2 ','NO3 ','num_a1 ','num_a2 ','num_a3 ', & - 'num_a4 ','O ','O2 ','O3 ','OCLO ', & - 'OCS ','pom_a1 ','pom_a4 ','S ','SF6 ', & - 'SO ','SO2 ','SO3 ','so4_a1 ','so4_a2 ', & - 'so4_a3 ','soa_a1 ','soa_a2 ','SOAG ','BR ', & - 'CL ','CLm ','CLm_H2O ','CLm_HCL ','CLOm ', & - 'CO3m ','CO3m2H2O ','CO3m_H2O ','CO4m ','e ', & - 'H3Op_OH ','HCO3m ','HO2 ','Hp_2H2O ','Hp_3H2O ', & - 'Hp_3N1 ','Hp_4H2O ','Hp_4N1 ','Hp_5H2O ','Hp_H2O ', & - 'N2D ','N2p ','NO2m ','NO2m_H2O ','NO3m ', & - 'NO3m2H2O ','NO3m_H2O ','NO3m_HCL ','NO3mHNO3 ','NOp ', & - 'NOp_2H2O ','NOp_3H2O ','NOp_CO2 ','NOp_H2O ','NOp_N2 ', & - 'Np ','O1D ','O2_1D ','O2_1S ','O2m ', & + solsym(:137) = (/ 'bc_a1 ','bc_a4 ','BR ','BRCL ','BRO ', & + 'BRONO2 ','BRY ','CCL4 ','CF2CLBR ','CF3BR ', & + 'CFC11 ','CFC113 ','CFC114 ','CFC115 ','CFC12 ', & + 'CH2BR2 ','CH2O ','CH3BR ','CH3CCL3 ','CH3CL ', & + 'CH3O2 ','CH3OOH ','CH4 ','CHBR3 ','CL ', & + 'CL2 ','CL2O2 ','CLO ','CLONO2 ','CLY ', & + 'CO ','CO2 ','COF2 ','COFCL ','DMS ', & + 'dst_a1 ','dst_a2 ','dst_a3 ','F ','H ', & + 'H2 ','H2402 ','H2O2 ','H2SO4 ','HBR ', & + 'HCFC141B ','HCFC142B ','HCFC22 ','HCL ','HF ', & + 'HNO3 ','HO2NO2 ','HOBR ','HOCL ','HONO ', & + 'N ','N2O ','N2O5 ','ncl_a1 ','ncl_a2 ', & + 'ncl_a3 ','NO ','NO2 ','NO3 ','num_a1 ', & + 'num_a2 ','num_a3 ','num_a4 ','O ','O1D ', & + 'O2 ','O3 ','OCLO ','OCS ','pom_a1 ', & + 'pom_a4 ','S ','SF6 ','SO ','SO2 ', & + 'SO3 ','so4_a1 ','so4_a2 ','so4_a3 ','soa_a1 ', & + 'soa_a2 ','SOAG ','CLm ','CLm_H2O ','CLm_HCL ', & + 'CLOm ','CO3m ','CO3m2H2O ','CO3m_H2O ','CO4m ', & + 'e ','H3Op_OH ','HCO3m ','HO2 ','Hp_2H2O ', & + 'Hp_3H2O ','Hp_3N1 ','Hp_4H2O ','Hp_4N1 ','Hp_5H2O ', & + 'Hp_H2O ','N2D ','N2p ','NO2m ','NO2m_H2O ', & + 'NO3m ','NO3m2H2O ','NO3m_H2O ','NO3m_HCL ','NO3mHNO3 ', & + 'NOp ','NOp_2H2O ','NOp_3H2O ','NOp_CO2 ','NOp_H2O ', & + 'NOp_N2 ','Np ','O2_1D ','O2_1S ','O2m ', & 'O2p ','O2p_H2O ','O3m ','O4m ','O4p ', & 'OH ','OHm ','Om ','Op ','Op2D ', & 'Op2P ','H2O ' /) - adv_mass(:137) = (/ 12.011000_r8, 12.011000_r8, 115.356700_r8, 95.903400_r8, 141.908940_r8, & - 99.716850_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, 50.485900_r8, 47.032000_r8, & - 48.039400_r8, 16.040600_r8, 252.730400_r8, 70.905400_r8, 102.904200_r8, & - 51.452100_r8, 97.457640_r8, 100.916850_r8, 28.010400_r8, 44.009800_r8, & - 66.007206_r8, 82.461503_r8, 62.132400_r8, 135.064039_r8, 135.064039_r8, & - 135.064039_r8, 18.998403_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, 47.012940_r8, 14.006740_r8, 44.012880_r8, & - 108.010480_r8, 58.442468_r8, 58.442468_r8, 58.442468_r8, 30.006140_r8, & - 46.005540_r8, 62.004940_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, & - 1.007400_r8, 15.999400_r8, 31.998800_r8, 47.998200_r8, 67.451500_r8, & - 60.076400_r8, 12.011000_r8, 12.011000_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, 12.011000_r8, 12.011000_r8, 12.011000_r8, 79.904000_r8, & - 35.452700_r8, 35.452700_r8, 53.466900_r8, 71.912800_r8, 51.452100_r8, & - 60.009200_r8, 96.037600_r8, 78.023400_r8, 76.008600_r8, 0.548567E-03_r8, & - 36.028400_r8, 61.016600_r8, 33.006200_r8, 37.035800_r8, 55.050000_r8, & - 118.062340_r8, 73.064200_r8, 136.076540_r8, 91.078400_r8, 19.021600_r8, & - 14.006740_r8, 28.013480_r8, 46.005540_r8, 64.019740_r8, 62.004940_r8, & - 98.033340_r8, 80.019140_r8, 98.465040_r8, 125.017280_r8, 30.006140_r8, & - 66.034540_r8, 68.049340_r8, 74.015940_r8, 48.020340_r8, 58.019620_r8, & - 14.006740_r8, 15.999400_r8, 31.998800_r8, 31.998800_r8, 31.998800_r8, & + adv_mass(:137) = (/ 12.011000_r8, 12.011000_r8, 79.904000_r8, 115.356700_r8, 95.903400_r8, & + 141.908940_r8, 99.716850_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, 50.485900_r8, & + 47.032000_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, 66.007206_r8, 82.461503_r8, 62.132400_r8, & + 135.064039_r8, 135.064039_r8, 135.064039_r8, 18.998403_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, 47.012940_r8, & + 14.006740_r8, 44.012880_r8, 108.010480_r8, 58.442468_r8, 58.442468_r8, & + 58.442468_r8, 30.006140_r8, 46.005540_r8, 62.004940_r8, 1.007400_r8, & + 1.007400_r8, 1.007400_r8, 1.007400_r8, 15.999400_r8, 15.999400_r8, & + 31.998800_r8, 47.998200_r8, 67.451500_r8, 60.076400_r8, 12.011000_r8, & + 12.011000_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, 12.011000_r8, & + 12.011000_r8, 12.011000_r8, 35.452700_r8, 53.466900_r8, 71.912800_r8, & + 51.452100_r8, 60.009200_r8, 96.037600_r8, 78.023400_r8, 76.008600_r8, & + 0.548567E-03_r8, 36.028400_r8, 61.016600_r8, 33.006200_r8, 37.035800_r8, & + 55.050000_r8, 118.062340_r8, 73.064200_r8, 136.076540_r8, 91.078400_r8, & + 19.021600_r8, 14.006740_r8, 28.013480_r8, 46.005540_r8, 64.019740_r8, & + 62.004940_r8, 98.033340_r8, 80.019140_r8, 98.465040_r8, 125.017280_r8, & + 30.006140_r8, 66.034540_r8, 68.049340_r8, 74.015940_r8, 48.020340_r8, & + 58.019620_r8, 14.006740_r8, 31.998800_r8, 31.998800_r8, 31.998800_r8, & 31.998800_r8, 50.013000_r8, 47.998200_r8, 63.997600_r8, 63.997600_r8, & 17.006800_r8, 17.006800_r8, 15.999400_r8, 15.999400_r8, 15.999400_r8, & 15.999400_r8, 18.014200_r8 /) crb_mass(:137) = (/ 12.011000_r8, 12.011000_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, & - 24.022000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, 12.011000_r8, & - 12.011000_r8, 12.011000_r8, 24.022000_r8, 12.011000_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, 12.011000_r8, 12.011000_r8, 12.011000_r8, & - 12.011000_r8, 12.011000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, & - 0.000000_r8, 0.000000_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, 0.000000_r8, 0.000000_r8, 0.000000_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, 12.011000_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, 12.011000_r8, 12.011000_r8, 24.022000_r8, & 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_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, 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, 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, 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, 0.000000_r8, & - 0.000000_r8, 12.011000_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, 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, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_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, 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, 0.000000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_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, 0.000000_r8, 0.000000_r8, & 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & @@ -125,47 +124,50 @@ subroutine set_sim_dat fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) - clsmap(: 23,1) = (/ 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, & - 17, 18, 19, 22, 23, 28, 30, 40, 44, 45, & - 46, 55, 75 /) - clsmap(:114,4) = (/ 1, 2, 3, 4, 5, 16, 20, 21, 24, 25, & - 26, 27, 29, 31, 32, 33, 34, 35, 36, 37, & - 38, 39, 41, 42, 43, 47, 48, 49, 50, 51, & - 52, 53, 54, 56, 57, 58, 59, 60, 61, 62, & - 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, & - 73, 74, 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 /) + clsmap(:137,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, 124, 125, 126, 127, 128, 129, 130, & + 131, 132, 133, 134, 135, 136, 137 /) - permute(:114,4) = (/ 1, 2, 27, 82, 45, 83, 66, 35, 24, 21, & - 112, 62, 44, 23, 25, 32, 3, 4, 5, 53, & - 113, 77, 46, 22, 58, 98, 26, 101, 39, 54, & - 57, 50, 65, 64, 6, 7, 8, 106, 94, 97, & - 9, 10, 11, 12, 104, 100, 99, 33, 34, 13, & - 14, 49, 70, 60, 29, 15, 16, 17, 18, 19, & - 20, 75, 105, 86, 72, 71, 63, 90, 69, 80, & - 85, 107, 36, 67, 88, 48, 95, 30, 111, 31, & - 108, 51, 55, 47, 91, 73, 87, 79, 81, 76, & - 78, 92, 93, 37, 41, 96, 40, 56, 84, 59, & - 28, 102, 103, 52, 74, 38, 68, 89, 109, 110, & - 61, 43, 42, 114 /) + permute(:137,4) = (/ 1, 2, 97, 41, 104, 61, 3, 25, 32, 33, & + 27, 34, 28, 35, 29, 57, 105, 63, 30, 52, & + 87, 54, 86, 53, 136, 36, 24, 130, 81, 4, & + 67, 135, 40, 38, 48, 5, 6, 7, 79, 121, & + 101, 26, 62, 31, 78, 37, 39, 46, 124, 47, & + 118, 58, 75, 77, 71, 88, 42, 85, 8, 9, & + 10, 129, 127, 115, 11, 12, 13, 14, 119, 106, & + 131, 134, 50, 51, 15, 16, 70, 17, 91, 80, & + 43, 18, 19, 20, 21, 22, 23, 107, 94, 93, & + 82, 113, 92, 102, 108, 114, 55, 90, 110, 66, & + 123, 44, 128, 45, 122, 72, 74, 64, 111, 95, & + 109, 100, 103, 96, 99, 116, 117, 56, 69, 120, & + 68, 76, 83, 49, 125, 126, 73, 98, 65, 89, & + 112, 132, 133, 84, 60, 59, 137 /) - diag_map(:114) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + diag_map(:137) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & - 21, 24, 27, 30, 32, 36, 39, 42, 46, 50, & - 54, 58, 64, 69, 77, 83, 89, 95, 101, 108, & - 115, 121, 128, 134, 138, 146, 153, 162, 168, 175, & - 181, 189, 198, 207, 215, 223, 231, 238, 246, 255, & - 264, 277, 287, 297, 311, 324, 335, 350, 362, 379, & - 393, 409, 424, 438, 454, 465, 484, 503, 519, 539, & - 560, 584, 606, 637, 660, 690, 713, 747, 794, 822, & - 852, 900, 943, 990,1033,1075,1115,1160,1202,1252, & - 1292,1328,1373,1433,1476,1518,1561,1604,1637,1673, & - 1716,1761,1797,1856 /) + 21, 22, 23, 24, 27, 30, 34, 38, 42, 46, & + 50, 53, 58, 63, 68, 73, 75, 80, 84, 89, & + 92, 95, 100, 104, 108, 113, 119, 122, 128, 131, & + 136, 144, 152, 158, 164, 170, 176, 183, 190, 197, & + 203, 211, 218, 227, 236, 243, 249, 253, 261, 268, & + 275, 281, 289, 297, 306, 314, 322, 329, 338, 348, & + 356, 366, 374, 385, 398, 413, 429, 443, 458, 470, & + 487, 501, 516, 532, 547, 561, 579, 591, 606, 622, & + 644, 666, 688, 712, 735, 784, 808, 830, 863, 897, & + 923, 981,1011,1055,1096,1145,1189,1231,1292,1335, & + 1372,1416,1460,1506,1543,1589,1638,1682,1725,1771, & + 1821,1855,1892,1934,1977,2026,2087 /) extfrc_lst(: 23) = (/ 'so4_a2 ','DMS ','NO2 ','SO2 ','bc_a1 ', & 'bc_a4 ','num_a1 ','num_a2 ','num_a4 ','pom_a1 ', & @@ -181,17 +183,16 @@ subroutine set_sim_dat inv_lst(: 2) = (/ 'M ', 'N2 ' /) - slvd_lst(: 52) = (/ 'BR ', 'CL ', 'CLm ', 'CLm_H2O ', 'CLm_HCL ', & - 'CLOm ', 'CO3m ', 'CO3m2H2O ', 'CO3m_H2O ', 'CO4m ', & - 'e ', 'H3Op_OH ', 'HCO3m ', 'HO2 ', 'Hp_2H2O ', & - 'Hp_3H2O ', 'Hp_3N1 ', 'Hp_4H2O ', 'Hp_4N1 ', 'Hp_5H2O ', & - 'Hp_H2O ', 'N2D ', 'N2p ', 'NO2m ', 'NO2m_H2O ', & - 'NO3m ', 'NO3m2H2O ', 'NO3m_H2O ', 'NO3m_HCL ', 'NO3mHNO3 ', & - 'NOp ', 'NOp_2H2O ', 'NOp_3H2O ', 'NOp_CO2 ', 'NOp_H2O ', & - 'NOp_N2 ', 'Np ', 'O1D ', 'O2_1D ', 'O2_1S ', & - 'O2m ', 'O2p ', 'O2p_H2O ', 'O3m ', 'O4m ', & - 'O4p ', 'OH ', 'OHm ', 'Om ', 'Op ', & - 'Op2D ', 'Op2P ' /) + slvd_lst(: 49) = (/ 'CLm ', 'CLm_H2O ', 'CLm_HCL ', 'CLOm ', 'CO3m ', & + 'CO3m2H2O ', 'CO3m_H2O ', 'CO4m ', 'e ', 'H3Op_OH ', & + 'HCO3m ', 'HO2 ', 'Hp_2H2O ', 'Hp_3H2O ', 'Hp_3N1 ', & + 'Hp_4H2O ', 'Hp_4N1 ', 'Hp_5H2O ', 'Hp_H2O ', 'N2D ', & + 'N2p ', 'NO2m ', 'NO2m_H2O ', 'NO3m ', 'NO3m2H2O ', & + 'NO3m_H2O ', 'NO3m_HCL ', 'NO3mHNO3 ', 'NOp ', 'NOp_2H2O ', & + 'NOp_3H2O ', 'NOp_CO2 ', 'NOp_H2O ', 'NOp_N2 ', 'Np ', & + 'O2_1D ', 'O2_1S ', 'O2m ', 'O2p ', 'O2p_H2O ', & + 'O3m ', 'O4m ', 'O4p ', 'OH ', 'OHm ', & + 'Om ', 'Op ', 'Op2D ', 'Op2P ' /) if( allocated( rxt_tag_lst ) ) then deallocate( rxt_tag_lst ) @@ -477,42 +478,41 @@ subroutine set_sim_dat 'CH2O_O ', 'CH2O_OH ', & 'CH3O2_HO2 ', 'CH3O2_NO ', & 'CH3OOH_OH ', 'CH4_OH ', & - 'CO_OH_M ', 'O1D_CH4a ', & - 'O1D_CH4b ', 'O1D_CH4c ', & - 'usr_CO_OH_b ', 'OCS_O ', & - 'OCS_OH ', 'S_O2 ', & + 'O1D_CH4a ', 'O1D_CH4b ', & + 'O1D_CH4c ', 'usr_CO_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_SO2_OH ', & - 'usr_SO3_H2O ', 'DMS_NO3 ', & - 'DMS_OHa ', 'usr_DMS_OH ', & - 'usr_HO2_aer ', 'usr_N2O5_aer ', & - 'usr_NO2_aer ', 'usr_NO3_aer ', & - 'het1 ', 'het10 ', & - 'het11 ', 'het12 ', & - 'het13 ', 'het14 ', & - 'het15 ', 'het16 ', & - 'het17 ', 'het2 ', & - 'het3 ', 'het4 ', & - 'het5 ', 'het6 ', & - 'het7 ', 'het8 ', & - 'het9 ', 'ag247nm ', & - 'ag373nm ', 'ag732nm ', & - 'elec1 ', 'elec2 ', & - 'elec3 ', 'ion_N2p_O2 ', & - 'ion_N2p_Oa ', 'ion_N2p_Ob ', & - 'ion_Np_O ', 'ion_Np_O2a ', & - 'ion_Np_O2b ', 'ion_O2p_N ', & - 'ion_O2p_N2 ', 'ion_O2p_NO ', & - 'ion_Op_CO2 ', 'ion_Op_N2 ', & - 'ion_Op_N2D ', 'ion_Op_O2 ', & - 'Op2D_e ', 'Op2D_N2 ' /) - rxt_tag_lst( 601: 607) = (/ 'Op2D_O ', 'Op2D_O2 ', & - 'Op2P_ea ', 'Op2P_eb ', & - 'Op2P_N2a ', 'Op2P_N2b ', & - 'Op2P_O ' /) + 'SO_OH ', 'usr_DMS_OH ', & + 'usr_SO3_H2O ', 'usr_HO2_aer ', & + 'usr_N2O5_aer ', 'usr_NO2_aer ', & + 'usr_NO3_aer ', 'het1 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ', & + 'het8 ', 'het9 ', & + 'ag247nm ', 'ag373nm ', & + 'ag732nm ', 'elec1 ', & + 'elec2 ', 'elec3 ', & + 'ion_N2p_O2 ', 'ion_N2p_Oa ', & + 'ion_N2p_Ob ', 'ion_Np_O ', & + 'ion_Np_O2a ', 'ion_Np_O2b ', & + 'ion_O2p_N ', 'ion_O2p_N2 ', & + 'ion_O2p_NO ', 'ion_Op_CO2 ', & + 'ion_Op_N2 ', 'ion_Op_N2D ', & + 'ion_Op_O2 ', 'Op2D_e ', & + 'Op2D_N2 ', 'Op2D_O ' /) + rxt_tag_lst( 601: 606) = (/ 'Op2D_O2 ', 'Op2P_ea ', & + 'Op2P_eb ', 'Op2P_N2a ', & + 'Op2P_N2b ', 'Op2P_O ' /) 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, & @@ -573,7 +573,7 @@ subroutine set_sim_dat 571, 572, 573, 574, 575, 576, 577, 578, 579, 580, & 581, 582, 583, 584, 585, 586, 587, 588, 589, 590, & 591, 592, 593, 594, 595, 596, 597, 598, 599, 600, & - 601, 602, 603, 604, 605, 606, 607 /) + 601, 602, 603, 604, 605, 606 /) if( allocated( pht_alias_lst ) ) then deallocate( pht_alias_lst ) end if @@ -699,12 +699,12 @@ subroutine set_sim_dat 403, 404, 405, 408, 411, & 412, 413, 414, 417, 418, & 419, 422, 424, 425, 426, & - 430, 431, 439, 440, 580, & - 581, 582, 583, 584, 585, & - 586, 587, 589, 590, 591, & - 592, 594, 596, 597, 598, & - 599, 600, 601, 602, 603, & - 604, 605, 606, 607 /) + 430, 431, 439, 440, 579, & + 580, 581, 582, 583, 584, & + 585, 586, 588, 589, 590, & + 591, 593, 595, 596, 597, & + 598, 599, 600, 601, 602, & + 603, 604, 605, 606 /) cph_enthalpy(:) = (/ 189.810000_r8, 32.910000_r8, 189.810000_r8, 94.300000_r8, 94.300000_r8, & 94.300000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, & 392.190000_r8, 493.580000_r8, 101.390000_r8, 232.590000_r8, 203.400000_r8, & @@ -764,14 +764,14 @@ subroutine set_sim_dat 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, 2, 2, 1, 1, 1, 1, 1, 2, & - 1, 1, 1, 1, 2, 2, 2, 1, 1, 2, & - 2, 2, 1, 1, 2, 1, 1, 1, 2, 2, & + 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 1, 1, 1, 1, 1, 2, 1, & + 1, 1, 1, 2, 2, 2, 1, 1, 2, 2, & + 2, 1, 1, 2, 1, 1, 1, 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 /) end subroutine set_sim_dat diff --git a/src/chemistry/pp_waccm_mad_mam5/chem_mech.doc b/src/chemistry/pp_waccm_mad_mam5/chem_mech.doc new file mode 100644 index 0000000000..ef13b8492e --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/chem_mech.doc @@ -0,0 +1,1528 @@ + + + Solution species + ( 1) bc_a1 (C) + ( 2) bc_a4 (C) + ( 3) BR (Br) + ( 4) BRCL (BrCl) + ( 5) BRO (BrO) + ( 6) BRONO2 (BrONO2) + ( 7) BRY + ( 8) CCL4 (CCl4) + ( 9) CF2CLBR (CF2ClBr) + ( 10) CF3BR (CF3Br) + ( 11) CFC11 (CFCl3) + ( 12) CFC113 (CCl2FCClF2) + ( 13) CFC114 (CClF2CClF2) + ( 14) CFC115 (CClF2CF3) + ( 15) CFC12 (CF2Cl2) + ( 16) CH2BR2 (CH2Br2) + ( 17) CH2O + ( 18) CH3BR (CH3Br) + ( 19) CH3CCL3 (CH3CCl3) + ( 20) CH3CL (CH3Cl) + ( 21) CH3O2 + ( 22) CH3OOH + ( 23) CH4 + ( 24) CHBR3 (CHBr3) + ( 25) CL (Cl) + ( 26) CL2 (Cl2) + ( 27) CL2O2 (Cl2O2) + ( 28) CLO (ClO) + ( 29) CLONO2 (ClONO2) + ( 30) CLY + ( 31) CO + ( 32) CO2 + ( 33) COF2 + ( 34) COFCL (COFCl) + ( 35) DMS (CH3SCH3) + ( 36) dst_a1 (AlSiO5) + ( 37) dst_a2 (AlSiO5) + ( 38) dst_a3 (AlSiO5) + ( 39) F + ( 40) H + ( 41) H2 + ( 42) H2402 (CBrF2CBrF2) + ( 43) H2O2 + ( 44) H2SO4 (H2SO4) + ( 45) HBR (HBr) + ( 46) HCFC141B (CH3CCl2F) + ( 47) HCFC142B (CH3CClF2) + ( 48) HCFC22 (CHF2Cl) + ( 49) HCL (HCl) + ( 50) HF + ( 51) HNO3 + ( 52) HO2NO2 + ( 53) HOBR (HOBr) + ( 54) HOCL (HOCl) + ( 55) HONO + ( 56) N + ( 57) N2O + ( 58) N2O5 + ( 59) ncl_a1 (NaCl) + ( 60) ncl_a2 (NaCl) + ( 61) ncl_a3 (NaCl) + ( 62) NO + ( 63) NO2 + ( 64) NO3 + ( 65) num_a1 (H) + ( 66) num_a2 (H) + ( 67) num_a3 (H) + ( 68) num_a4 (H) + ( 69) num_a5 (H) + ( 70) O + ( 71) O1D (O) + ( 72) O2 + ( 73) O3 + ( 74) OCLO (OClO) + ( 75) OCS (OCS) + ( 76) pom_a1 (C) + ( 77) pom_a4 (C) + ( 78) S (S) + ( 79) SF6 + ( 80) SO (SO) + ( 81) SO2 + ( 82) SO3 (SO3) + ( 83) so4_a1 (NH4HSO4) + ( 84) so4_a2 (NH4HSO4) + ( 85) so4_a3 (NH4HSO4) + ( 86) so4_a5 (NH4HSO4) + ( 87) soa_a1 (C) + ( 88) soa_a2 (C) + ( 89) SOAG (C) + ( 90) CLm (Cl) + ( 91) CLm_H2O (ClH2O) + ( 92) CLm_HCL (Cl2H) + ( 93) CLOm (ClO) + ( 94) CO3m (CO3) + ( 95) CO3m2H2O (H4CO5) + ( 96) CO3m_H2O (H2CO4) + ( 97) CO4m (CO4) + ( 98) e (E) + ( 99) H3Op_OH (H4O2) + (100) HCO3m (HCO3) + (101) HO2 + (102) Hp_2H2O (H5O2) + (103) Hp_3H2O (H7O3) + (104) Hp_3N1 (H8NO6) + (105) Hp_4H2O (H9O4) + (106) Hp_4N1 (H10NO7) + (107) Hp_5H2O (H11O5) + (108) Hp_H2O (H3O) + (109) N2D (N) + (110) N2p (N2) + (111) NO2m (NO2) + (112) NO2m_H2O (H2NO3) + (113) NO3m (NO3) + (114) NO3m2H2O (H4NO5) + (115) NO3m_H2O (H2NO4) + (116) NO3m_HCL (NO3HCl) + (117) NO3mHNO3 (HN2O6) + (118) NOp (NO) + (119) NOp_2H2O (H4NO3) + (120) NOp_3H2O (H6NO3) + (121) NOp_CO2 (NCO3) + (122) NOp_H2O (H2NO2) + (123) NOp_N2 (N3O) + (124) Np (N) + (125) O2_1D (O2) + (126) O2_1S (O2) + (127) O2m (O2) + (128) O2p (O2) + (129) O2p_H2O (H2O3) + (130) O3m (O3) + (131) O4m (O4) + (132) O4p (O4) + (133) OH + (134) OHm (OH) + (135) Om (O) + (136) Op (O) + (137) Op2D (O) + (138) Op2P (O) + (139) H2O + + + Invariant species + ( 1) M + ( 2) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + + Implicit + -------- + ( 1) bc_a1 + ( 2) bc_a4 + ( 3) BR + ( 4) BRCL + ( 5) BRO + ( 6) BRONO2 + ( 7) BRY + ( 8) CCL4 + ( 9) CF2CLBR + ( 10) CF3BR + ( 11) CFC11 + ( 12) CFC113 + ( 13) CFC114 + ( 14) CFC115 + ( 15) CFC12 + ( 16) CH2BR2 + ( 17) CH2O + ( 18) CH3BR + ( 19) CH3CCL3 + ( 20) CH3CL + ( 21) CH3O2 + ( 22) CH3OOH + ( 23) CH4 + ( 24) CHBR3 + ( 25) CL + ( 26) CL2 + ( 27) CL2O2 + ( 28) CLO + ( 29) CLONO2 + ( 30) CLY + ( 31) CO + ( 32) CO2 + ( 33) COF2 + ( 34) COFCL + ( 35) DMS + ( 36) dst_a1 + ( 37) dst_a2 + ( 38) dst_a3 + ( 39) F + ( 40) H + ( 41) H2 + ( 42) H2402 + ( 43) H2O2 + ( 44) H2SO4 + ( 45) HBR + ( 46) HCFC141B + ( 47) HCFC142B + ( 48) HCFC22 + ( 49) HCL + ( 50) HF + ( 51) HNO3 + ( 52) HO2NO2 + ( 53) HOBR + ( 54) HOCL + ( 55) HONO + ( 56) N + ( 57) N2O + ( 58) N2O5 + ( 59) ncl_a1 + ( 60) ncl_a2 + ( 61) ncl_a3 + ( 62) NO + ( 63) NO2 + ( 64) NO3 + ( 65) num_a1 + ( 66) num_a2 + ( 67) num_a3 + ( 68) num_a4 + ( 69) num_a5 + ( 70) O + ( 71) O1D + ( 72) O2 + ( 73) O3 + ( 74) OCLO + ( 75) OCS + ( 76) pom_a1 + ( 77) pom_a4 + ( 78) S + ( 79) SF6 + ( 80) SO + ( 81) SO2 + ( 82) SO3 + ( 83) so4_a1 + ( 84) so4_a2 + ( 85) so4_a3 + ( 86) so4_a5 + ( 87) soa_a1 + ( 88) soa_a2 + ( 89) SOAG + ( 90) CLm + ( 91) CLm_H2O + ( 92) CLm_HCL + ( 93) CLOm + ( 94) CO3m + ( 95) CO3m2H2O + ( 96) CO3m_H2O + ( 97) CO4m + ( 98) e + ( 99) H3Op_OH + (100) HCO3m + (101) HO2 + (102) Hp_2H2O + (103) Hp_3H2O + (104) Hp_3N1 + (105) Hp_4H2O + (106) Hp_4N1 + (107) Hp_5H2O + (108) Hp_H2O + (109) N2D + (110) N2p + (111) NO2m + (112) NO2m_H2O + (113) NO3m + (114) NO3m2H2O + (115) NO3m_H2O + (116) NO3m_HCL + (117) NO3mHNO3 + (118) NOp + (119) NOp_2H2O + (120) NOp_3H2O + (121) NOp_CO2 + (122) NOp_H2O + (123) NOp_N2 + (124) Np + (125) O2_1D + (126) O2_1S + (127) O2m + (128) O2p + (129) O2p_H2O + (130) O3m + (131) O4m + (132) O4p + (133) OH + (134) OHm + (135) Om + (136) Op + (137) Op2D + (138) Op2P + (139) H2O + + Photolysis + jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) + jh2o_c ( 2) H2O + hv -> 2*H + O rate = ** User defined ** ( 2) + jh2o_a ( 3) H2O + hv -> OH + H rate = ** User defined ** ( 3) + jh2o2 ( 4) H2O2 + hv -> 2*OH rate = ** User defined ** ( 4) + jo2_b ( 5) O2 + hv -> 2*O rate = ** User defined ** ( 5) + jo2_a ( 6) O2 + hv -> O + O1D rate = ** User defined ** ( 6) + jo3_a ( 7) O3 + hv -> O1D + O2_1D 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) + jhono ( 12) HONO + hv -> NO + OH rate = ** User defined ** ( 12) + jn2o ( 13) N2O + hv -> O1D + N2 rate = ** User defined ** ( 13) + jn2o5_a ( 14) N2O5 + hv -> NO2 + NO3 rate = ** User defined ** ( 14) + jn2o5_b ( 15) N2O5 + hv -> NO + O + NO3 rate = ** User defined ** ( 15) + jno_i ( 16) NO + hv -> NOp + e rate = ** User defined ** ( 16) + jno ( 17) NO + hv -> N + O rate = ** User defined ** ( 17) + jno2 ( 18) NO2 + hv -> NO + O rate = ** User defined ** ( 18) + jno3_a ( 19) NO3 + hv -> NO2 + O rate = ** User defined ** ( 19) + jno3_b ( 20) NO3 + hv -> NO + O2 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) + jch3ooh ( 23) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 23) + jch4_a ( 24) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 24) + jch4_b ( 25) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 25) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jco2 ( 26) CO2 + hv -> CO + O rate = ** User defined ** ( 26) + jbrcl ( 27) BRCL + hv -> BR + CL rate = ** User defined ** ( 27) + jbro ( 28) BRO + hv -> BR + O rate = ** User defined ** ( 28) + jbrono2_b ( 29) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 29) + jbrono2_a ( 30) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 30) + jccl4 ( 31) CCL4 + hv -> 4*CL rate = ** User defined ** ( 31) + jcf2clbr ( 32) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 32) + jcf3br ( 33) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 33) + jcfcl3 ( 34) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 34) + jcfc113 ( 35) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 35) + jcfc114 ( 36) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 36) + jcfc115 ( 37) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 37) + jcf2cl2 ( 38) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 38) + jch2br2 ( 39) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 39) + jch3br ( 40) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 40) + jch3ccl3 ( 41) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 41) + jch3cl ( 42) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 42) + jchbr3 ( 43) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 43) + jcl2 ( 44) CL2 + hv -> 2*CL rate = ** User defined ** ( 44) + jcl2o2 ( 45) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 45) + jclo ( 46) CLO + hv -> CL + O rate = ** User defined ** ( 46) + jclono2_a ( 47) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 47) + jclono2_b ( 48) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 48) + jcof2 ( 49) COF2 + hv -> 2*F rate = ** User defined ** ( 49) + jcofcl ( 50) COFCL + hv -> F + CL rate = ** User defined ** ( 50) + jh2402 ( 51) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 51) + jhbr ( 52) HBR + hv -> BR + H rate = ** User defined ** ( 52) + jhcfc141b ( 53) HCFC141B + hv -> CL + COFCL rate = ** User defined ** ( 53) + jhcfc142b ( 54) HCFC142B + hv -> CL + COF2 rate = ** User defined ** ( 54) + jhcfc22 ( 55) HCFC22 + hv -> CL + COF2 rate = ** User defined ** ( 55) + jhcl ( 56) HCL + hv -> H + CL rate = ** User defined ** ( 56) + jhf ( 57) HF + hv -> H + F rate = ** User defined ** ( 57) + jhobr ( 58) HOBR + hv -> BR + OH rate = ** User defined ** ( 58) + jhocl ( 59) HOCL + hv -> OH + CL rate = ** User defined ** ( 59) + joclo ( 60) OCLO + hv -> O + CLO rate = ** User defined ** ( 60) + jsf6 ( 61) SF6 + hv -> {sink} rate = ** User defined ** ( 61) + jeuv_26 ( 62) CO2 + hv -> CO + O rate = ** User defined ** ( 62) + jpni3 ( 63) CO3m + hv -> CO2 + Om rate = ** User defined ** ( 63) + jpni5 ( 64) CO3m_H2O + hv -> CO3m + H2O rate = ** User defined ** ( 64) + jpni4 ( 65) CO4m + hv -> CO2 + O2m rate = ** User defined ** ( 65) + jeuv_4 ( 66) N + hv -> Np + e rate = ** User defined ** ( 66) + jeuv_18 ( 67) N2 + hv -> N2p + e rate = ** User defined ** ( 67) + jeuv_11 ( 68) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 68) + jeuv_10 ( 69) N2 + hv -> N + Np + e rate = ** User defined ** ( 69) + jeuv_22 ( 70) N2 + hv -> N + Np + e rate = ** User defined ** ( 70) + jeuv_23 ( 71) N2 + hv -> N2D + Np + e rate = ** User defined ** ( 71) + jeuv_25 ( 72) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** ( 72) + jeuv_13 ( 73) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** ( 73) + jeuv_6 ( 74) N2 + hv -> N2p + e rate = ** User defined ** ( 74) + jepn6 ( 75) NO2m + hv -> NO2 + e rate = ** User defined ** ( 75) + jepn7 ( 76) NO3m + hv -> NO3 + e rate = ** User defined ** ( 76) + jeuv_1 ( 77) O + hv -> Op + e rate = ** User defined ** ( 77) + jeuv_2 ( 78) O + hv -> Op2D + e rate = ** User defined ** ( 78) + jeuv_16 ( 79) O + hv -> Op2P + e rate = ** User defined ** ( 79) + jeuv_3 ( 80) O + hv -> Op2P + e rate = ** User defined ** ( 80) + jeuv_14 ( 81) O + hv -> Op + e rate = ** User defined ** ( 81) + jeuv_15 ( 82) O + hv -> Op2D + e rate = ** User defined ** ( 82) + jeuv_8 ( 83) O2 + hv -> O + Op2D + e rate = ** User defined ** ( 83) + jeuv_17 ( 84) O2 + hv -> O2p + e rate = ** User defined ** ( 84) + jeuv_7 ( 85) O2 + hv -> O + Op + e rate = ** User defined ** ( 85) + jeuv_5 ( 86) O2 + hv -> O2p + e rate = ** User defined ** ( 86) + jeuv_19 ( 87) O2 + hv -> O + Op + e rate = ** User defined ** ( 87) + jeuv_24 ( 88) O2 + hv -> 2*O rate = ** User defined ** ( 88) + jeuv_12 ( 89) O2 + hv -> 2*O rate = ** User defined ** ( 89) + jeuv_21 ( 90) O2 + hv -> O + Op2P + e rate = ** User defined ** ( 90) + jeuv_9 ( 91) O2 + hv -> O + Op2P + e rate = ** User defined ** ( 91) + jeuv_20 ( 92) O2 + hv -> O + Op2D + e rate = ** User defined ** ( 92) + jepn2 ( 93) O2m + hv -> O2 + e rate = ** User defined ** ( 93) + jppi ( 94) O2p_H2O + hv -> H2O + O2p rate = ** User defined ** ( 94) + jpni1 ( 95) O3m + hv -> O2 + Om rate = ** User defined ** ( 95) + jepn3 ( 96) O3m + hv -> O3 + e rate = ** User defined ** ( 96) + jpni2 ( 97) O4m + hv -> O2 + O2m rate = ** User defined ** ( 97) + jepn4 ( 98) OHm + hv -> OH + e rate = ** User defined ** ( 98) + jepn1 ( 99) Om + hv -> O + e rate = ** User defined ** ( 99) + jh2so4 (100) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** (100) + jocs (101) OCS + hv -> S + CO rate = ** User defined ** (101) + jso (102) SO + hv -> S + O rate = ** User defined ** (102) + jso2 (103) SO2 + hv -> SO + O rate = ** User defined ** (103) + jso3 (104) SO3 + hv -> SO2 + O rate = ** User defined ** (104) + + Reactions + CLm_H ( 1) CLm + H -> HCL + e rate = 9.60E-10 (105) + CLmH2O_HCL ( 2) CLm_H2O + HCL -> CLm_HCL + H2O rate = 1.30E-09 (106) + CLm_H2O_Ma ( 3) CLm + H2O + M -> CLm_H2O + M rate = 2.00E-29 (107) + CLmHCL_M ( 4) HCL + M + CLm -> CLm_HCL + M rate = 1.00E-27 (108) + CLm_HNO3 ( 5) CLm + HNO3 -> HCL + NO3m rate = 1.60E-09 (109) + CLm_NO2 ( 6) CLm + NO2 -> CL + NO2m rate = 6.00E-12 (110) + CLOm_NOa ( 7) CLOm + NO -> CL + NO2m rate = 2.90E-12 (111) + CLOm_NOb ( 8) CLOm + NO -> NO2 + CLm rate = 2.90E-11 (112) + CLOm_O ( 9) CLOm + O -> CLm + O2 rate = 2.00E-10 (113) + CO3m_CLa ( 10) CL + CO3m -> CLm + CO2 + O rate = 1.00E-10 (114) + CO3m_CLb ( 11) CL + CO3m -> CLOm + CO2 rate = 1.00E-10 (115) + CO3m_CLO ( 12) CLO + CO3m -> CLm + CO2 + O2 rate = 1.00E-11 (116) + CO3m_H ( 13) H + CO3m -> CO2 + OHm rate = 1.70E-10 (117) + CO3mH2O_H2O_M ( 14) CO3m_H2O + H2O + M -> CO3m2H2O + M rate = 1.00E-28 (118) + CO3m_H2O_M ( 15) CO3m + H2O + M -> CO3m_H2O + M rate = 1.00E-28 (119) + CO3mH2O_NO2a ( 16) CO3m_H2O + NO2 -> CO2 + H2O + NO3m rate = 4.00E-11 (120) + CO3mH2O_NO2b ( 17) CO3m_H2O + NO2 -> CO2 + NO3m_H2O rate = 4.00E-11 (121) + CO3mH2O_NOa ( 18) CO3m_H2O + NO -> CO2 + NO2m_H2O rate = 3.50E-12 (122) + CO3mH2O_NOb ( 19) CO3m_H2O + NO -> CO2 + H2O + NO2m rate = 3.50E-12 (123) + CO3m_HNO3 ( 20) CO3m + HNO3 -> CO2 + NO3m + OH rate = 3.51E-10 (124) + CO3m_O ( 21) CO3m + O -> CO2 + O2m rate = 1.10E-10 (125) + CO3m_O2 ( 22) O2 + CO3m -> CO2 + O3m rate = 6.00E-15 (126) + CO4m_CL ( 23) CL + CO4m -> CLm + CO2 + O2 rate = 1.00E-10 (127) + CO4m_CLO ( 24) CLO + CO4m -> CLOm + CO2 + O2 rate = 1.00E-10 (128) + CO4m_H ( 25) CO4m + H -> CO3m + OH rate = 2.20E-10 (129) + CO4m_HCL ( 26) CO4m + HCL -> CLm + CO2 + HO2 rate = 1.20E-09 (130) + CO4m_O ( 27) CO4m + O -> CO3m + O2 rate = 1.40E-10 (131) + CO4m_O3 ( 28) CO4m + O3 -> CO2 + O2 + O3m rate = 1.30E-10 (132) + ean1 ( 29) e + O2 + N2 -> N2 + O2m rate = ** User defined ** (133) + ean2 ( 30) O3 + e -> O2 + Om rate = ** User defined ** (134) + ean3 ( 31) M + O2 + e -> M + O2m rate = ** User defined ** (135) + edn1 ( 32) NO + Om -> e + NO2 rate = ** User defined ** (136) + edn2 ( 33) N2 + O2m -> e + O2 + N2 rate = ** User defined ** (137) + H3OpOH_e ( 34) H3Op_OH + e -> H + H2O + OH rate = 1.50E-06 (138) + H3OpOH_H2O ( 35) H2O + H3Op_OH -> Hp_2H2O + OH rate = 2.00E-09 (139) + Hp3N1_H2O ( 36) H2O + Hp_3N1 -> HNO3 + Hp_4H2O rate = 1.00E-09 (140) + Hp4H2O_e ( 37) Hp_4H2O + e -> H + 4*H2O rate = 3.60E-06 (141) + Hp4H2O_N2O5 ( 38) Hp_4H2O + N2O5 -> HNO3 + Hp_3N1 rate = 4.00E-12 (142) + Hp4N1_H2O ( 39) H2O + Hp_4N1 -> HNO3 + Hp_5H2O rate = 1.00E-09 (143) + Hp5H2O_e ( 40) Hp_5H2O + e -> H + 5*H2O rate = 5.00E-06 (144) + Hp5H2O_N2O5 ( 41) Hp_5H2O + N2O5 -> HNO3 + Hp_4N1 rate = 7.00E-12 (145) + iira1 ( 42) Hp_4H2O + NO3mHNO3 -> 4*H2O + 2*HNO3 rate = ** User defined ** (146) + iira10 ( 43) CLm + Hp_4H2O -> CL + H + 4*H2O rate = ** User defined ** (147) + iira100 ( 44) NO3m + O2p -> NO3 + O2 rate = ** User defined ** (148) + iira101 ( 45) HCO3m + O2p -> CO2 + O2 + OH rate = ** User defined ** (149) + iira102 ( 46) O2m + O2p -> 2*O2p rate = ** User defined ** (150) + iira103 ( 47) CO4m + O2p -> CO2 + O2 + O2 rate = ** User defined ** (151) + iira104 ( 48) NO3m_H2O + O2p -> H2O + NO3 + O2 rate = ** User defined ** (152) + iira105 ( 49) CO3m2H2O + O2p -> CO2 + 2*H2O + O + O2 rate = ** User defined ** (153) + iira106 ( 50) CLm + O2p -> CL + O2 rate = ** User defined ** (154) + iira107 ( 51) CO3m_H2O + O2p -> H2O + O + O2 + CO2 rate = ** User defined ** (155) + iira108 ( 52) NO2m_H2O + O2p -> H2O + NO2 + O2 rate = ** User defined ** (156) + iira109 ( 53) NO3m_HCL + O2p -> HCL + NO3 + O2 rate = ** User defined ** (157) + iira11 ( 54) CO3m_H2O + Hp_4H2O -> CO2 + 5*H2O + O + H rate = ** User defined ** (158) + iira110 ( 55) O2p + CLm_H2O -> CL + H2O + O2 rate = ** User defined ** (159) + iira111 ( 56) NO3m2H2O + O2p -> 2*H2O + NO3 + O2 rate = ** User defined ** (160) + iira112 ( 57) NO2m + O2p -> NO2 + O2 rate = ** User defined ** (161) + iira12 ( 58) Hp_4H2O + NO2m_H2O -> H + 5*H2O + NO2 rate = ** User defined ** (162) + iira13 ( 59) Hp_4H2O + NO3m_HCL -> H + 4*H2O + NO3 + HCL rate = ** User defined ** (163) + iira14 ( 60) CLm_H2O + Hp_4H2O -> H + CL + 5*H2O rate = ** User defined ** (164) + iira15 ( 61) NO3m2H2O + Hp_4H2O -> H + 6*H2O + NO3 rate = ** User defined ** (165) + iira16 ( 62) Hp_4H2O + NO2m -> H + NO2 + 4*H2O rate = ** User defined ** (166) + iira17 ( 63) Hp_5H2O + NO3mHNO3 -> 5*H2O + 2*HNO3 rate = ** User defined ** (167) + iira18 ( 64) CO3m + Hp_5H2O -> CO2 + 5*H2O + O + H rate = ** User defined ** (168) + iira19 ( 65) CLm_HCL + Hp_5H2O -> CL + H + 5*H2O + HCL rate = ** User defined ** (169) + iira2 ( 66) CO3m + Hp_4H2O -> CO2 + H + 4*H2O + O rate = ** User defined ** (170) + iira20 ( 67) NO3m + Hp_5H2O -> 5*H2O + HNO3 rate = ** User defined ** (171) + iira21 ( 68) HCO3m + Hp_5H2O -> CO2 + H + 5*H2O + OH rate = ** User defined ** (172) + iira22 ( 69) Hp_5H2O + O2m -> H + 5*H2O + O2 rate = ** User defined ** (173) + iira23 ( 70) CO4m + Hp_5H2O -> CO2 + 5*H2O + O2 + H rate = ** User defined ** (174) + iira24 ( 71) Hp_5H2O + NO3m_H2O -> H + 6*H2O + NO3 rate = ** User defined ** (175) + iira25 ( 72) CO3m2H2O + Hp_5H2O -> H + CO2 + 7*H2O + O rate = ** User defined ** (176) + iira26 ( 73) CLm + Hp_5H2O -> CL + H + 5*H2O rate = ** User defined ** (177) + iira27 ( 74) CO3m_H2O + Hp_5H2O -> CO2 + H + 6*H2O + O rate = ** User defined ** (178) + iira28 ( 75) NO2m_H2O + Hp_5H2O -> H + 6*H2O + NO2 rate = ** User defined ** (179) + iira29 ( 76) Hp_5H2O + NO3m_HCL -> H + 5*H2O + HCL + NO3 rate = ** User defined ** (180) + iira3 ( 77) CLm_HCL + Hp_4H2O -> CL + H + HCL + 4*H2O rate = ** User defined ** (181) + iira30 ( 78) CLm_H2O + Hp_5H2O -> CL + H + 6*H2O rate = ** User defined ** (182) + iira31 ( 79) Hp_5H2O + NO3m2H2O -> H + 7*H2O + NO3 rate = ** User defined ** (183) + iira32 ( 80) Hp_5H2O + NO2m -> 5*H2O + NO2 + H rate = ** User defined ** (184) + iira33 ( 81) Hp_3H2O + NO3mHNO3 -> 3*H2O + 2*HNO3 rate = ** User defined ** (185) + iira34 ( 82) Hp_3H2O + CO3m -> CO2 + H + 3*H2O + O rate = ** User defined ** (186) + iira35 ( 83) CLm_HCL + Hp_3H2O -> CL + H + 3*H2O + HCL rate = ** User defined ** (187) + iira36 ( 84) Hp_3H2O + NO3m -> 3*H2O + HNO3 rate = ** User defined ** (188) + iira37 ( 85) HCO3m + Hp_3H2O -> CO2 + H + 3*H2O + OH rate = ** User defined ** (189) + iira38 ( 86) Hp_3H2O + O2m -> H + 3*H2O + O2 rate = ** User defined ** (190) + iira39 ( 87) CO4m + Hp_3H2O -> CO2 + H + 3*H2O + O2 rate = ** User defined ** (191) + iira4 ( 88) Hp_4H2O + NO3m -> 4*H2O + HNO3 rate = ** User defined ** (192) + iira40 ( 89) Hp_3H2O + NO3m_H2O -> H + 4*H2O + NO3 rate = ** User defined ** (193) + iira41 ( 90) CO3m2H2O + Hp_3H2O -> CO2 + H + 5*H2O + O rate = ** User defined ** (194) + iira42 ( 91) CLm + Hp_3H2O -> CL + H + 3*H2O rate = ** User defined ** (195) + iira43 ( 92) CO3m_H2O + Hp_3H2O -> CO2 + H + O + 4*H2O rate = ** User defined ** (196) + iira44 ( 93) Hp_3H2O + NO2m_H2O -> H + 4*H2O + NO2 rate = ** User defined ** (197) + iira45 ( 94) Hp_3H2O + NO3m_HCL -> H + 3*H2O + HCL + NO3 rate = ** User defined ** (198) + iira46 ( 95) CLm_H2O + Hp_3H2O -> H + 4*H2O + CL rate = ** User defined ** (199) + iira47 ( 96) Hp_3H2O + NO3m2H2O -> H + 5*H2O + NO3 rate = ** User defined ** (200) + iira48 ( 97) Hp_3H2O + NO2m -> H + 3*H2O + NO2 rate = ** User defined ** (201) + iira49 ( 98) NO3mHNO3 + NOp_H2O -> H2O + HNO3 + NO + NO3 rate = ** User defined ** (202) + iira5 ( 99) HCO3m + Hp_4H2O -> CO2 + H + 4*H2O + OH rate = ** User defined ** (203) + iira50 (100) CO3m + NOp_H2O -> CO2 + H2O + NO + O rate = ** User defined ** (204) + iira51 (101) CLm_HCL + NOp_H2O -> CL + NO + H2O + HCL rate = ** User defined ** (205) + iira52 (102) NO3m + NOp_H2O -> H2O + NO + NO3 rate = ** User defined ** (206) + iira53 (103) HCO3m + NOp_H2O -> OH + CO2 + H2O + NO rate = ** User defined ** (207) + iira54 (104) NOp_H2O + O2m -> H2O + NO + O2 rate = ** User defined ** (208) + iira55 (105) CO4m + NOp_H2O -> O2 + NO + CO2 + H2O rate = ** User defined ** (209) + iira56 (106) NO3m_H2O + NOp_H2O -> 2*H2O + NO + NO3 rate = ** User defined ** (210) + iira57 (107) CO3m2H2O + NOp_H2O -> CO2 + 3*H2O + NO + O rate = ** User defined ** (211) + iira58 (108) CLm + NOp_H2O -> CL + H2O + NO rate = ** User defined ** (212) + iira59 (109) CO3m_H2O + NOp_H2O -> O + CO2 + 2*H2O + NO rate = ** User defined ** (213) + iira6 (110) Hp_4H2O + O2m -> O2 + H + 4*H2O rate = ** User defined ** (214) + iira60 (111) NO2m_H2O + NOp_H2O -> NO + 2*H2O + NO2 rate = ** User defined ** (215) + iira61 (112) NO3m_HCL + NOp_H2O -> H2O + NO + NO3 + HCL rate = ** User defined ** (216) + iira62 (113) CLm_H2O + NOp_H2O -> CL + 2*H2O + NO rate = ** User defined ** (217) + iira63 (114) NO3m2H2O + NOp_H2O -> NO + NO3 + 3*H2O rate = ** User defined ** (218) + iira64 (115) NO2m + NOp_H2O -> NO + H2O + NO2 rate = ** User defined ** (219) + iira65 (116) NO3mHNO3 + NOp_2H2O -> 2*H2O + NO3 + HNO3 + NO rate = ** User defined ** (220) + iira66 (117) CO3m + NOp_2H2O -> 2*H2O + NO + CO2 + O rate = ** User defined ** (221) + iira67 (118) CLm_HCL + NOp_2H2O -> NO + CL + 2*H2O + HCL rate = ** User defined ** (222) + iira68 (119) NOp_2H2O + NO3m -> NO + 2*H2O + NO3 rate = ** User defined ** (223) + iira69 (120) HCO3m + NOp_2H2O -> 2*H2O + OH + NO + CO2 rate = ** User defined ** (224) + iira7 (121) CO4m + Hp_4H2O -> 4*H2O + H + CO2 + O2 rate = ** User defined ** (225) + iira70 (122) NOp_2H2O + O2m -> 2*H2O + NO + O2 rate = ** User defined ** (226) + iira71 (123) NOp_2H2O + CO4m -> O2 + 2*H2O + NO + CO2 rate = ** User defined ** (227) + iira72 (124) NO3m_H2O + NOp_2H2O -> 3*H2O + NO3 + NO rate = ** User defined ** (228) + iira73 (125) CO3m2H2O + NOp_2H2O -> O + CO2 + 4*H2O + NO rate = ** User defined ** (229) + iira74 (126) CLm + NOp_2H2O -> 2*H2O + NO + CL rate = ** User defined ** (230) + iira75 (127) CO3m_H2O + NOp_2H2O -> 3*H2O + CO2 + NO + O rate = ** User defined ** (231) + iira76 (128) NOp_2H2O + NO2m_H2O -> 3*H2O + NO + NO2 rate = ** User defined ** (232) + iira77 (129) NO3m_HCL + NOp_2H2O -> NO + HCL + 2*H2O + NO3 rate = ** User defined ** (233) + iira78 (130) NOp_2H2O + CLm_H2O -> NO + 3*H2O + CL rate = ** User defined ** (234) + iira79 (131) NOp_2H2O + NO3m2H2O -> NO + NO3 + 4*H2O rate = ** User defined ** (235) + iira8 (132) Hp_4H2O + NO3m_H2O -> H + 5*H2O + NO3 rate = ** User defined ** (236) + iira80 (133) NOp_2H2O + NO2m -> 2*H2O + NO2 + NO rate = ** User defined ** (237) + iira81 (134) NOp + NO3mHNO3 -> NO + HNO3 + NO3 rate = ** User defined ** (238) + iira82 (135) NOp + CO3m -> CO2 + NO + O rate = ** User defined ** (239) + iira83 (136) NOp + CLm_HCL -> CL + HCL + NO rate = ** User defined ** (240) + iira84 (137) NO3m + NOp -> NO3 + NO rate = ** User defined ** (241) + iira85 (138) NOp + HCO3m -> NO + CO2 + OH rate = ** User defined ** (242) + iira86 (139) O2m + NOp -> NO + O2 rate = ** User defined ** (243) + iira87 (140) NOp + CO4m -> CO2 + NO + O2 rate = ** User defined ** (244) + iira88 (141) NOp + NO3m_H2O -> H2O + NO + NO3 rate = ** User defined ** (245) + iira89 (142) NOp + CO3m2H2O -> NO + O + CO2 + 2*H2O rate = ** User defined ** (246) + iira9 (143) CO3m2H2O + Hp_4H2O -> CO2 + 6*H2O + O + H rate = ** User defined ** (247) + iira90 (144) CLm + NOp -> CL + NO rate = ** User defined ** (248) + iira91 (145) CO3m_H2O + NOp -> H2O + NO + O + CO2 rate = ** User defined ** (249) + iira92 (146) NO2m_H2O + NOp -> NO + NO2 + H2O rate = ** User defined ** (250) + iira93 (147) NO3m_HCL + NOp -> NO + HCL + NO3 rate = ** User defined ** (251) + iira94 (148) CLm_H2O + NOp -> CL + NO + H2O rate = ** User defined ** (252) + iira95 (149) NOp + NO3m2H2O -> 2*H2O + NO + NO3 rate = ** User defined ** (253) + iira96 (150) NOp + NO2m -> NO2 + NO rate = ** User defined ** (254) + iira97 (151) NO3mHNO3 + O2p -> O2 + NO3 + HNO3 rate = ** User defined ** (255) + iira98 (152) O2p + CO3m -> O + O2 + CO2 rate = ** User defined ** (256) + iira99 (153) O2p + CLm_HCL -> O2 + HCL + CL rate = ** User defined ** (257) + iirb1 (154) Hp_4H2O + CO3m + M -> 4*H2O + O + CO2 + H + M rate = ** User defined ** (258) + iirb10 (155) Hp_5H2O + M + CO3m2H2O -> H + 7*H2O + M + CO2 + O rate = ** User defined ** (259) + iirb11 (156) M + CO3m_H2O + Hp_4H2O -> 5*H2O + M + H + CO2 + O rate = ** User defined ** (260) + iirb12 (157) Hp_5H2O + M + CO3m_H2O -> CO2 + M + O + H + 6*H2O rate = ** User defined ** (261) + iirb13 (158) NO3m_H2O + Hp_4H2O + M -> M + NO3 + H + 5*H2O rate = ** User defined ** (262) + iirb14 (159) NO3m_H2O + Hp_5H2O + M -> M + NO3 + H + 6*H2O rate = ** User defined ** (263) + iirb2 (160) NO3m + M + Hp_4H2O -> 4*H2O + HNO3 + M rate = ** User defined ** (264) + iirb3 (161) Hp_5H2O + M + CO3m -> 5*H2O + M + CO2 + O + H rate = ** User defined ** (265) + iirb4 (162) Hp_5H2O + NO3m + M -> M + HNO3 + 5*H2O rate = ** User defined ** (266) + iirb5 (163) M + CLm_HCL + Hp_4H2O -> M + 2*HCL + 4*H2O rate = ** User defined ** (267) + iirb6 (164) M + Hp_5H2O + CLm_HCL -> M + 5*H2O + 2*HCL rate = ** User defined ** (268) + iirb7 (165) NO3mHNO3 + M + Hp_4H2O -> 4*H2O + M + 2*HNO3 rate = ** User defined ** (269) + iirb8 (166) Hp_5H2O + M + NO3mHNO3 -> M + 5*H2O + 2*HNO3 rate = ** User defined ** (270) + iirb9 (167) M + CO3m2H2O + Hp_4H2O -> CO2 + 6*H2O + H + M + O rate = ** User defined ** (271) + nir1 (168) NO + O3m -> O + NO3m rate = ** User defined ** (272) + nir10 (169) NO2m_H2O + M -> H2O + NO2m + M rate = ** User defined ** (273) + nir11 (170) NO3m2H2O + M -> M + NO3m_H2O + H2O rate = ** User defined ** (274) + nir12 (171) NO3mHNO3 + M -> NO3m + HNO3 + M rate = ** User defined ** (275) + nir13 (172) HCL + M + NO3m -> NO3m_HCL + M rate = ** User defined ** (276) + nir2 (173) NO2 + O3m -> NO3m + O2 rate = ** User defined ** (277) + nir3 (174) NO2 + O3m -> NO2m + O3 rate = ** User defined ** (278) + nir4 (175) NO + O3m -> NO2m + O2 rate = ** User defined ** (279) + nir5 (176) CO3m + NO -> CO2 + NO2m rate = ** User defined ** (280) + nir6 (177) CO3m + NO2 -> NO3m + CO2 rate = ** User defined ** (281) + nir7 (178) M + NO3m_H2O -> M + H2O + NO3m rate = ** User defined ** (282) + nir8 (179) CO3m_H2O + M -> CO3m + M + H2O rate = ** User defined ** (283) + nir9 (180) CO3m2H2O + M -> CO3m_H2O + H2O + M rate = ** User defined ** (284) + NO2m_CL (181) CL + NO2m -> CLm + NO2 rate = 1.00E-10 (285) + NO2m_CLO (182) CLO + NO2m -> CLm + NO3 rate = 1.00E-10 (286) + NO2m_H (183) H + NO2m -> NO + OHm rate = 3.00E-10 (287) + NO2m_H2O_M (184) NO2m + H2O + M -> M + NO2m_H2O rate = 1.60E-28 (288) + NO2m_HCL (185) HCL + NO2m -> CLm + HONO rate = 1.40E-09 (289) + NO2m_HNO3 (186) HNO3 + NO2m -> NO3m + HONO rate = 1.60E-09 (290) + NO2m_NO2 (187) NO2 + NO2m -> NO + NO3m rate = 2.00E-13 (291) + NO2m_O3 (188) NO2m + O3 -> NO3m + O2 rate = 1.20E-10 (292) + NO3m2H2O_N2O5 (189) NO3m2H2O + N2O5 -> H2O + HNO3 + NO3mHNO3 rate = 7.00E-10 (293) + NO3mH2O_H2O_M (190) NO3m_H2O + H2O + M -> M + NO3m2H2O rate = 1.60E-28 (294) + NO3mH2O_HNO3 (191) HNO3 + NO3m_H2O -> H2O + NO3mHNO3 rate = 1.60E-09 (295) + NO3m_H2O_M (192) H2O + M + NO3m -> M + NO3m_H2O rate = 1.60E-28 (296) + NO3mH2O_N2O5 (193) NO3m_H2O + N2O5 -> HNO3 + NO3mHNO3 rate = 7.00E-10 (297) + NO3m_HCLa (194) HCL + NO3m -> CLm + HNO3 rate = 1.00E-12 (298) + NO3mHCL_HNO3 (195) HNO3 + NO3m_HCL -> HCL + NO3mHNO3 rate = 7.60E-10 (299) + NO3m_HNO3_M (196) NO3m + HNO3 + M -> M + NO3mHNO3 rate = 1.45E-26 (300) + NO3m_O (197) NO3m + O -> NO2m + O2 rate = 5.00E-12 (301) + NO3m_O3 (198) O3 + NO3m -> NO2m + 2*O2 rate = 1.00E-13 (302) + NOp2H2O_e (199) NOp_2H2O + e -> 2*H2O + NO rate = 2.00E-06 (303) + NOp3H2O_e (200) NOp_3H2O + e -> 3*H2O + NO rate = 2.00E-06 (304) + NOp3H2O_H2O (201) H2O + NOp_3H2O -> HONO + Hp_3H2O rate = 7.00E-11 (305) + NOpCO2_e (202) NOp_CO2 + e -> CO2 + NO rate = 1.50E-06 (306) + NOpCO2_H2O (203) NOp_CO2 + H2O -> CO2 + NOp_H2O rate = 1.00E-09 (307) + NOpH2O_e (204) NOp_H2O + e -> H2O + NO rate = 1.50E-06 (308) + NOpH2O_H (205) H + NOp_H2O -> NO + Hp_H2O rate = 7.00E-12 (309) + NOpH2O_HO2 (206) NOp_H2O + HO2 -> Hp_H2O + NO3 rate = 5.00E-10 (310) + NOpH2O_OH (207) NOp_H2O + OH -> Hp_H2O + NO2 rate = 1.00E-10 (311) + NOpN2_CO2 (208) CO2 + NOp_N2 -> N2 + NOp_CO2 rate = 1.00E-09 (312) + NOpN2_H2O (209) NOp_N2 + H2O -> N2 + NOp_H2O rate = 1.00E-09 (313) + O2m_CL (210) O2m + CL -> CLm + O2 rate = 1.00E-10 (314) + O2m_CLO (211) CLO + O2m -> CLOm + O2 rate = 1.00E-10 (315) + O2m_CO2_M (212) CO2 + M + O2m -> CO4m + M rate = 9.90E-30 (316) + O2m_H (213) H + O2m -> HO2 + e rate = 1.40E-09 (317) + O2m_HCL (214) O2m + HCL -> CLm + HO2 rate = 1.60E-09 (318) + O2m_HNO3 (215) O2m + HNO3 -> HO2 + NO3m rate = 2.90E-09 (319) + O2m_NO2 (216) NO2 + O2m -> NO2m + O2 rate = 7.00E-10 (320) + O2m_O21D (217) O2_1D + O2m -> 2*O2 + e rate = 2.00E-10 (321) + O2m_O2_M (218) O2 + M + O2m -> M + O4m rate = 3.40E-31 (322) + O2m_O3 (219) O3 + O2m -> O2 + O3m rate = 7.80E-10 (323) + O2m_O_a (220) O + O2m -> O3 + e rate = 1.50E-10 (324) + O2m_O_b (221) O2m + O -> O2 + Om rate = 1.50E-10 (325) + O2pH2O_e (222) O2p_H2O + e -> H2O + O2 rate = 2.00E-06 (326) + O2pH2O_H2Oa (223) O2p_H2O + H2O -> H3Op_OH + O2 rate = 9.00E-10 (327) + O2pH2O_H2Ob (224) O2p_H2O + H2O -> Hp_H2O + O2 + OH rate = 2.40E-10 (328) + O2p_H2O_M (225) M + H2O + O2p -> M + O2p_H2O rate = 2.80E-28 (329) + O3m_CO2 (226) O3m + CO2 -> CO3m + O2 rate = 5.50E-10 (330) + O3m_H (227) O3m + H -> O2 + OHm rate = 8.40E-10 (331) + O3m_O3 (228) O3 + O3m -> 3*O2 + e rate = 1.00E-10 (332) + O3m_O_a (229) O3m + O -> 2*O2 + e rate = 1.00E-10 (333) + O3m_O_b (230) O + O3m -> O2 + O2m rate = 2.50E-10 (334) + O4m_CO2 (231) CO2 + O4m -> CO4m + O2 rate = 4.30E-10 (335) + O4m_O (232) O + O4m -> O3m + O2 rate = 4.00E-10 (336) + O4p_H2O (233) H2O + O4p -> O2 + O2p_H2O rate = 1.70E-09 (337) + O4p_O (234) O4p + O -> O2p + O3 rate = 3.00E-10 (338) + O4p_O21D (235) O4p + O2_1D -> 2*O2 + O2p rate = 1.50E-10 (339) + OH_HONO (236) HONO + OH -> H2O + NO2 rate = 3.00E-12*exp( 250./t) (340) + OHm_CL (237) CL + OHm -> CLm + OH rate = 1.00E-10 (341) + OHm_CLO (238) CLO + OHm -> CLOm + OH rate = 1.00E-10 (342) + OHm_CO2 (239) CO2 + M + OHm -> M + HCO3m rate = 7.60E-28 (343) + OHm_H (240) H + OHm -> e + H2O rate = 1.40E-09 (344) + OHm_HCL (241) OHm + HCL -> CLm + H2O rate = 1.00E-09 (345) + OHm_NO2 (242) NO2 + OHm -> NO2m + OH rate = 1.10E-09 (346) + OHm_O (243) OHm + O -> HO2 + e rate = 2.00E-10 (347) + OHm_O3 (244) OHm + O3 -> O3m + OH rate = 9.00E-10 (348) + OH_NO_M (245) OH + NO + M -> HONO + M troe : ko=7.00E-31*(300/t)**2.60 (349) + ki=3.60E-11*(300/t)**0.10 + f=0.60 + Om_CL (246) Om + CL -> CLm + O rate = 1.00E-10 (350) + Om_CLO (247) CLO + Om -> CLm + O2 rate = 1.00E-10 (351) + Om_CO2_M (248) M + Om + CO2 -> CO3m + M rate = 2.00E-28 (352) + Om_H2_a (249) H2 + Om -> H2O + e rate = 5.80E-10 (353) + Om_H2_b (250) Om + H2 -> H + OHm rate = 3.20E-11 (354) + Om_H2O (251) Om + H2O -> OHm + OH rate = 6.00E-13 (355) + Om_HCL (252) Om + HCL -> CLm + OH rate = 2.00E-09 (356) + Om_HNO3 (253) Om + HNO3 -> NO3m + OH rate = 3.60E-09 (357) + Om_M (254) M + Om -> O + M + e rate = 5.00E-13 (358) + Om_NO2 (255) NO2 + Om -> O + NO2m rate = 1.00E-09 (359) + Om_O (256) Om + O -> e + O2 rate = 1.90E-10 (360) + Om_O21D (257) Om + O2_1D -> O3 + e rate = 3.00E-10 (361) + Om_O2_M (258) M + Om + O2 -> M + O3m rate = 2.90E-31 (362) + Om_O3 (259) O3 + Om -> O + O3m rate = 8.00E-10 (363) + pir1 (260) M + O2p + O2 -> M + O4p rate = ** User defined ** (364) + pir10 (261) H2O + NOp + M -> M + NOp_H2O rate = ** User defined ** (365) + pir11 (262) H2O + M + NOp_H2O -> M + NOp_2H2O rate = ** User defined ** (366) + pir12 (263) H2O + NOp_2H2O + M -> M + NOp_3H2O rate = ** User defined ** (367) + pir13 (264) NOp + CO2 + M -> M + NOp_CO2 rate = ** User defined ** (368) + pir14 (265) NOp_CO2 + M -> M + NOp + CO2 rate = ** User defined ** (369) + pir15 (266) N2 + M + NOp -> NOp_N2 + M rate = ** User defined ** (370) + pir16 (267) NOp_N2 + M -> M + NOp + N2 rate = ** User defined ** (371) + pir2 (268) M + Hp_H2O + H2O -> Hp_2H2O + M rate = ** User defined ** (372) + pir3 (269) Hp_2H2O + M -> H2O + Hp_H2O + M rate = ** User defined ** (373) + pir4 (270) H2O + Hp_2H2O + M -> Hp_3H2O + M rate = ** User defined ** (374) + pir5 (271) Hp_3H2O + M -> M + Hp_2H2O + H2O rate = ** User defined ** (375) + pir6 (272) Hp_3H2O + H2O + M -> M + Hp_4H2O rate = ** User defined ** (376) + pir7 (273) Hp_4H2O + M -> H2O + M + Hp_3H2O rate = ** User defined ** (377) + pir8 (274) Hp_4H2O + M + H2O -> Hp_5H2O + M rate = ** User defined ** (378) + pir9 (275) M + Hp_5H2O -> M + H2O + Hp_4H2O rate = ** User defined ** (379) + rpe1 (276) e + O4p -> 2*O2 rate = ** User defined ** (380) + rpe2 (277) Hp_H2O + e -> H + H2O rate = ** User defined ** (381) + rpe3 (278) Hp_2H2O + e -> 2*H2O + H rate = ** User defined ** (382) + rpe4 (279) Hp_3H2O + e -> H + 3*H2O rate = ** User defined ** (383) + rpe5 (280) e + NOp_N2 -> N2 + NO rate = ** User defined ** (384) + usr_CLm_H2O_M (281) CLm_H2O + M -> H2O + M + CLm rate = ** User defined ** (385) + usr_CLm_HCL_M (282) M + CLm_HCL -> CLm + HCL + M rate = ** User defined ** (386) + ag1 (283) O2_1D -> O2 rate = 2.58E-04 (387) + ag2 (284) O2_1S -> O2 rate = 8.50E-02 (388) + O1D_H2 (285) O1D + H2 -> H + OH rate = 1.20E-10 (389) + O1D_H2O (286) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (390) + O1D_N2 (287) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (391) + O1D_O2 (288) O1D + O2 -> O + O2_1S rate = 2.64E-11*exp( 55./t) (392) + O1D_O2b (289) O1D + O2 -> O + O2 rate = 6.60E-12*exp( 55./t) (393) + O1D_O3 (290) O1D + O3 -> O2 + O2 rate = 1.20E-10 (394) + O2_1D_N2 (291) O2_1D + N2 -> O2 + N2 rate = 1.00E-20 (395) + O2_1D_O (292) O2_1D + O -> O2 + O rate = 1.30E-16 (396) + O2_1D_O2 (293) O2_1D + O2 -> 2*O2 rate = 3.60E-18*exp( -220./t) (397) + O2_1S_CO2 (294) O2_1S + CO2 -> O2_1D + CO2 rate = 4.20E-13 (398) + O2_1S_N2 (295) O2_1S + N2 -> O2_1D + N2 rate = 1.80E-15*exp( 45./t) (399) + O2_1S_O (296) O2_1S + O -> O2_1D + O rate = 8.00E-14 (400) + O2_1S_O2 (297) O2_1S + O2 -> O2_1D + O2 rate = 3.90E-17 (401) + O2_1S_O3 (298) O2_1S + O3 -> O2_1D + O3 rate = 3.50E-11*exp( -135./t) (402) + O_O3 (299) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (403) + usr_O_O (300) O + O + M -> O2 + M rate = ** User defined ** (404) + usr_O_O2 (301) O + O2 + M -> O3 + M rate = ** User defined ** (405) + H2_O (302) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (406) + H2O2_O (303) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (407) + H_HO2 (304) H + HO2 -> H2 + O2 rate = 6.90E-12 (408) + H_HO2a (305) H + HO2 -> 2*OH rate = 7.20E-11 (409) + H_HO2b (306) H + HO2 -> H2O + O rate = 1.60E-12 (410) + H_O2 (307) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (411) + ki=9.50E-11*(300/t)**-0.40 + f=0.60 + HO2_O (308) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (412) + HO2_O3 (309) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (413) + H_O3 (310) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (414) + OH_H2 (311) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (415) + OH_H2O2 (312) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (416) + OH_HO2 (313) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (417) + OH_O (314) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (418) + OH_O3 (315) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (419) + OH_OH (316) OH + OH -> H2O + O rate = 1.80E-12 (420) + OH_OH_M (317) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (421) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 (318) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (422) + HO2NO2_OH (319) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (423) + N2D_O (320) N2D + O -> N + O rate = 7.00E-13 (424) + N2D_O2 (321) N2D + O2 -> NO + O1D rate = 5.00E-12 (425) + N_NO (322) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (426) + N_NO2a (323) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (427) + N_NO2b (324) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (428) + N_NO2c (325) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (429) + N_O2 (326) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (430) + NO2_O (327) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (431) + NO2_O3 (328) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (432) + NO2_O_M (329) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (433) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 (330) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (434) + NO3_NO (331) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (435) + NO3_O (332) NO3 + O -> NO2 + O2 rate = 1.30E-11 (436) + NO3_OH (333) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (437) + N_OH (334) N + OH -> NO + H rate = 5.00E-11 (438) + NO_HO2 (335) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (439) + NO_O3 (336) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (440) + NO_O_M (337) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (441) + ki=3.00E-11 + f=0.60 + O1D_N2Oa (338) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (442) + O1D_N2Ob (339) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (443) + tag_NO2_HO2 (340) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (444) + ki=4.00E-12*(300/t)**0.30 + f=0.60 + tag_NO2_NO3 (341) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (445) + ki=1.60E-12*(300/t)**-0.10 + f=0.60 + tag_NO2_OH (342) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (446) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH (343) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (447) + usr_HO2NO2_M (344) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (448) + usr_N2O5_M (345) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (449) + CL_CH2O (346) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (450) + CL_CH4 (347) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (451) + CL_H2 (348) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (452) + CL_H2O2 (349) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (453) + CL_HO2a (350) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (454) + CL_HO2b (351) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (455) + CL_O3 (352) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (456) + CLO_CH3O2 (353) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (457) + CLO_CLOa (354) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (458) + CLO_CLOb (355) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (459) + CLO_CLOc (356) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (460) + CLO_HO2 (357) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (461) + CLO_NO (358) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (462) + CLONO2_CL (359) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (463) + CLO_NO2_M (360) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (464) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLONO2_O (361) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (465) + CLONO2_OH (362) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (466) + CLO_O (363) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (467) + CLO_OHa (364) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (468) + CLO_OHb (365) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (469) + HCL_O (366) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (470) + HCL_OH (367) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (471) + HOCL_CL (368) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (472) + HOCL_O (369) HOCL + O -> CLO + OH rate = 1.70E-13 (473) + HOCL_OH (370) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (474) + O1D_CCL4 (371) O1D + CCL4 -> 4*CL rate = 2.61E-10 (475) + O1D_CF2CLBR (372) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (476) + O1D_CFC11 (373) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (477) + O1D_CFC113 (374) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (478) + O1D_CFC114 (375) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (479) + O1D_CFC115 (376) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (480) + O1D_CFC12 (377) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (481) + O1D_HCLa (378) O1D + HCL -> CL + OH rate = 9.90E-11 (482) + O1D_HCLb (379) O1D + HCL -> CLO + H rate = 3.30E-12 (483) + tag_CLO_CLO_M (380) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (484) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M (381) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (485) + BR_CH2O (382) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (486) + BR_HO2 (383) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (487) + BR_O3 (384) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (488) + BRO_BRO (385) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (489) + BRO_CLOa (386) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (490) + BRO_CLOb (387) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (491) + BRO_CLOc (388) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (492) + BRO_HO2 (389) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (493) + BRO_NO (390) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (494) + BRO_NO2_M (391) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (495) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRONO2_O (392) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (496) + BRO_O (393) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (497) + BRO_OH (394) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (498) + HBR_O (395) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (499) + HBR_OH (396) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (500) + HOBR_O (397) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (501) + O1D_CF3BR (398) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (502) + O1D_CHBR3 (399) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (503) + O1D_H2402 (400) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (504) + O1D_HBRa (401) O1D + HBR -> BR + OH rate = 9.00E-11 (505) + O1D_HBRb (402) O1D + HBR -> BRO + H rate = 3.00E-11 (506) + F_CH4 (403) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (507) + F_H2 (404) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (508) + F_H2O (405) F + H2O -> HF + OH rate = 1.40E-11 (509) + F_HNO3 (406) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (510) + O1D_COF2 (407) O1D + COF2 -> 2*F rate = 2.14E-11 (511) + O1D_COFCL (408) O1D + COFCL -> F + CL rate = 1.90E-10 (512) + CH2BR2_CL (409) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (513) + CH2BR2_OH (410) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (514) + CH3BR_CL (411) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (515) + CH3BR_OH (412) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (516) + CH3CCL3_OH (413) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (517) + CH3CL_CL (414) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1110./t) (518) + CH3CL_OH (415) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (519) + CHBR3_CL (416) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (520) + CHBR3_OH (417) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (521) + HCFC141B_OH (418) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (522) + HCFC142B_OH (419) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (523) + HCFC22_OH (420) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (524) + O1D_CH2BR2 (421) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (525) + O1D_CH3BR (422) O1D + CH3BR -> BR rate = 1.80E-10 (526) + O1D_HCFC141B (423) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (527) + O1D_HCFC142B (424) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (528) + O1D_HCFC22 (425) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (529) + CH2O_NO3 (426) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (530) + CH2O_O (427) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (531) + CH2O_OH (428) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (532) + CH3O2_HO2 (429) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (533) + CH3O2_NO (430) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (534) + CH3OOH_OH (431) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (535) + CH4_OH (432) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (536) + O1D_CH4a (433) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (537) + O1D_CH4b (434) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (538) + O1D_CH4c (435) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (539) + usr_CO_OH (436) CO + OH -> CO2 + HO2 rate = ** User defined ** (540) + DMS_NO3 (437) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (541) + DMS_OHa (438) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (542) + OCS_O (439) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (543) + OCS_OH (440) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (544) + S_O2 (441) S + O2 -> SO + O rate = 2.30E-12 (545) + SO2_OH_M (442) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (546) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + S_O3 (443) S + O3 -> SO + O2 rate = 1.20E-11 (547) + SO_BRO (444) SO + BRO -> SO2 + BR rate = 5.70E-11 (548) + SO_CLO (445) SO + CLO -> SO2 + CL rate = 2.80E-11 (549) + S_OH (446) S + OH -> SO + H rate = 6.60E-11 (550) + SO_NO2 (447) SO + NO2 -> SO2 + NO rate = 1.40E-11 (551) + SO_O2 (448) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (552) + SO_O3 (449) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (553) + SO_OCLO (450) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (554) + SO_OH (451) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (555) + usr_DMS_OH (452) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (556) + usr_SO3_H2O (453) SO3 + H2O -> H2SO4 rate = ** User defined ** (557) + usr_HO2_aer (454) HO2 -> 0.5*H2O2 rate = ** User defined ** (558) + usr_N2O5_aer (455) N2O5 -> 2*HNO3 rate = ** User defined ** (559) + usr_NO2_aer (456) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (560) + usr_NO3_aer (457) NO3 -> HNO3 rate = ** User defined ** (561) + het1 (458) N2O5 -> 2*HNO3 rate = ** User defined ** (562) + het10 (459) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (563) + het11 (460) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (564) + het12 (461) N2O5 -> 2*HNO3 rate = ** User defined ** (565) + het13 (462) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (566) + het14 (463) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (567) + het15 (464) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (568) + het16 (465) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (569) + het17 (466) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (570) + het2 (467) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (571) + het3 (468) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (572) + het4 (469) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (573) + het5 (470) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (574) + het6 (471) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (575) + het7 (472) N2O5 -> 2*HNO3 rate = ** User defined ** (576) + het8 (473) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (577) + het9 (474) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (578) + ag247nm (475) Op2P -> Op rate = 4.70E-02 (579) + ag373nm (476) Op2D -> Op rate = 7.70E-05 (580) + ag732nm (477) Op2P -> Op2D rate = 1.71E-01 (581) + elec1 (478) NOp + e -> 0.2*N + 0.8*N2D + O rate = ** User defined ** (582) + elec2 (479) O2p + e -> 1.15*O + 0.85*O1D rate = ** User defined ** (583) + elec3 (480) N2p + e -> 1.1*N + 0.9*N2D rate = ** User defined ** (584) + ion_N2p_O2 (481) N2p + O2 -> O2p + N2 rate = 6.00E-11 (585) + ion_N2p_Oa (482) N2p + O -> NOp + N2D rate = ** User defined ** (586) + ion_N2p_Ob (483) N2p + O -> Op + N2 rate = ** User defined ** (587) + ion_Np_O (484) Np + O -> Op + N rate = 1.00E-12 (588) + ion_Np_O2a (485) Np + O2 -> O2p + N rate = 4.00E-10 (589) + ion_Np_O2b (486) Np + O2 -> NOp + O rate = 2.00E-10 (590) + ion_O2p_N (487) O2p + N -> NOp + O rate = 1.00E-10 (591) + ion_O2p_N2 (488) O2p + N2 -> NOp + NO rate = 5.00E-16 (592) + ion_O2p_NO (489) O2p + NO -> NOp + O2 rate = 4.40E-10 (593) + ion_Op_CO2 (490) Op + CO2 -> O2p + CO rate = 9.00E-10 (594) + ion_Op_N2 (491) Op + N2 -> NOp + N rate = ** User defined ** (595) + ion_Op_N2D (492) Op + N2D -> Np + O rate = 1.30E-10 (596) + ion_Op_O2 (493) Op + O2 -> O2p + O rate = ** User defined ** (597) + Op2D_e (494) Op2D + e -> Op + e rate = ** User defined ** (598) + Op2D_N2 (495) Op2D + N2 -> N2p + O rate = 8.00E-10 (599) + Op2D_O (496) Op2D + O -> Op + O rate = 5.00E-12 (600) + Op2D_O2 (497) Op2D + O2 -> O2p + O rate = 7.00E-10 (601) + Op2P_ea (498) Op2P + e -> Op2D + e rate = ** User defined ** (602) + Op2P_eb (499) Op2P + e -> Op + e rate = ** User defined ** (603) + Op2P_N2a (500) Op2P + N2 -> N2p + O rate = 4.80E-10 (604) + Op2P_N2b (501) Op2P + N2 -> Np + NO rate = 1.00E-10 (605) + Op2P_O (502) Op2P + O -> Op + O rate = 4.00E-10 (606) + +Extraneous prod/loss species + ( 1) so4_a2 (dataset) + ( 2) DMS (dataset) + ( 3) NO2 (dataset) + ( 4) SO2 (dataset) + ( 5) bc_a1 (dataset) + ( 6) bc_a4 (dataset) + ( 7) num_a1 (dataset) + ( 8) num_a2 (dataset) + ( 9) num_a4 (dataset) + (10) num_a5 (dataset) + (11) pom_a1 (dataset) + (12) pom_a4 (dataset) + (13) so4_a1 (dataset) + (14) so4_a5 (dataset) + (15) CO (dataset) + (16) NO (dataset) + (17) N + (18) N2D + (19) N2p + (20) OH + (21) Op + (22) e + (23) Np + (24) O + (25) O2p + + + Equation Report + + d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(BR)/dt = j27*BRCL + j28*BRO + j30*BRONO2 + j32*CF2CLBR + j33*CF3BR + 2*j39*CH2BR2 + j40*CH3BR + + 3*j43*CHBR3 + 2*j51*H2402 + j52*HBR + j58*HOBR + r372*O1D*CF2CLBR + 2*r385*BRO*BRO + + r386*BRO*CLO + r387*BRO*CLO + r390*BRO*NO + r393*BRO*O + r394*BRO*OH + r395*HBR*O + + r396*HBR*OH + r398*O1D*CF3BR + 3*r399*O1D*CHBR3 + 2*r400*O1D*H2402 + r401*O1D*HBR + + 2*r409*CH2BR2*CL + 2*r410*CH2BR2*OH + r411*CH3BR*CL + r412*CH3BR*OH + 3*r416*CHBR3*CL + + 3*r417*CHBR3*OH + 2*r421*O1D*CH2BR2 + r422*O1D*CH3BR + r444*SO*BRO + - r382*CH2O*BR - r383*HO2*BR - r384*O3*BR + d(BRCL)/dt = r388*BRO*CLO + r466*HOBR*HCL + r471*HOBR*HCL + - j27*BRCL + d(BRO)/dt = j29*BRONO2 + r384*BR*O3 + r392*BRONO2*O + r397*HOBR*O + r402*O1D*HBR + - j28*BRO - 2*r385*BRO*BRO - r386*CLO*BRO - r387*CLO*BRO - r388*CLO*BRO - r389*HO2*BRO + - r390*NO*BRO - r391*M*NO2*BRO - r393*O*BRO - r394*OH*BRO - r444*SO*BRO + d(BRONO2)/dt = r391*M*BRO*NO2 + - j29*BRONO2 - j30*BRONO2 - r460*BRONO2 - r463*BRONO2 - r468*BRONO2 - r392*O*BRONO2 + d(BRY)/dt = 0 + d(CCL4)/dt = - j31*CCL4 - r371*O1D*CCL4 + d(CF2CLBR)/dt = - j32*CF2CLBR - r372*O1D*CF2CLBR + d(CF3BR)/dt = - j33*CF3BR - r398*O1D*CF3BR + d(CFC11)/dt = - j34*CFC11 - r373*O1D*CFC11 + d(CFC113)/dt = - j35*CFC113 - r374*O1D*CFC113 + d(CFC114)/dt = - j36*CFC114 - r375*O1D*CFC114 + d(CFC115)/dt = - j37*CFC115 - r376*O1D*CFC115 + d(CFC12)/dt = - j38*CFC12 - r377*O1D*CFC12 + d(CH2BR2)/dt = - j39*CH2BR2 - r409*CL*CH2BR2 - r410*OH*CH2BR2 - r421*O1D*CH2BR2 + d(CH2O)/dt = j23*CH3OOH + .18*j25*CH4 + r353*CLO*CH3O2 + r430*CH3O2*NO + .3*r431*CH3OOH*OH + r434*O1D*CH4 + + r435*O1D*CH4 + - j21*CH2O - j22*CH2O - r346*CL*CH2O - r382*BR*CH2O - r426*NO3*CH2O - r427*O*CH2O + - r428*OH*CH2O + d(CH3BR)/dt = - j40*CH3BR - r411*CL*CH3BR - r412*OH*CH3BR - r422*O1D*CH3BR + d(CH3CCL3)/dt = - j41*CH3CCL3 - r413*OH*CH3CCL3 + d(CH3CL)/dt = - j42*CH3CL - r414*CL*CH3CL - r415*OH*CH3CL + d(CH3O2)/dt = j24*CH4 + j40*CH3BR + j42*CH3CL + r347*CL*CH4 + r403*F*CH4 + .7*r431*CH3OOH*OH + r432*CH4*OH + + r433*O1D*CH4 + - r353*CLO*CH3O2 - r429*HO2*CH3O2 - r430*NO*CH3O2 + d(CH3OOH)/dt = r429*CH3O2*HO2 + - j23*CH3OOH - r431*OH*CH3OOH + d(CH4)/dt = - j24*CH4 - j25*CH4 - r347*CL*CH4 - r403*F*CH4 - r432*OH*CH4 - r433*O1D*CH4 - r434*O1D*CH4 + - r435*O1D*CH4 + d(CHBR3)/dt = - j43*CHBR3 - r399*O1D*CHBR3 - r416*CL*CHBR3 - r417*OH*CHBR3 + d(CL)/dt = j27*BRCL + 4*j31*CCL4 + j32*CF2CLBR + 2*j34*CFC11 + 2*j35*CFC113 + 2*j36*CFC114 + j37*CFC115 + + 2*j38*CFC12 + 3*j41*CH3CCL3 + j42*CH3CL + 2*j44*CL2 + 2*j45*CL2O2 + j46*CLO + j47*CLONO2 + + j50*COFCL + j53*HCFC141B + j54*HCFC142B + j55*HCFC22 + j56*HCL + j59*HOCL + r6*CLm*NO2 + + r7*CLOm*NO + r43*CLm*Hp_4H2O + r50*CLm*O2p + r55*O2p*CLm_H2O + r60*CLm_H2O*Hp_4H2O + + r65*CLm_HCL*Hp_5H2O + r73*CLm*Hp_5H2O + r77*CLm_HCL*Hp_4H2O + r78*CLm_H2O*Hp_5H2O + + r83*CLm_HCL*Hp_3H2O + r91*CLm*Hp_3H2O + r95*CLm_H2O*Hp_3H2O + r101*CLm_HCL*NOp_H2O + + r108*CLm*NOp_H2O + r113*CLm_H2O*NOp_H2O + r118*CLm_HCL*NOp_2H2O + r126*CLm*NOp_2H2O + + r130*NOp_2H2O*CLm_H2O + r136*NOp*CLm_HCL + r144*CLm*NOp + r148*CLm_H2O*NOp + r153*O2p*CLm_HCL + + r353*CLO*CH3O2 + 2*r354*CLO*CLO + r356*CLO*CLO + r358*CLO*NO + r363*CLO*O + r364*CLO*OH + + r366*HCL*O + r367*HCL*OH + 4*r371*O1D*CCL4 + r372*O1D*CF2CLBR + 2*r373*O1D*CFC11 + + 2*r374*O1D*CFC113 + 2*r375*O1D*CFC114 + r376*O1D*CFC115 + 2*r377*O1D*CFC12 + r378*O1D*HCL + + r387*BRO*CLO + r408*O1D*COFCL + 3*r413*CH3CCL3*OH + r415*CH3CL*OH + r418*HCFC141B*OH + + r419*HCFC142B*OH + r420*HCFC22*OH + r423*O1D*HCFC141B + r424*O1D*HCFC142B + r425*O1D*HCFC22 + + r445*SO*CLO + - r10*CO3m*CL - r11*CO3m*CL - r23*CO4m*CL - r181*NO2m*CL - r210*O2m*CL - r237*OHm*CL + - r246*Om*CL - r346*CH2O*CL - r347*CH4*CL - r348*H2*CL - r349*H2O2*CL - r350*HO2*CL + - r351*HO2*CL - r352*O3*CL - r359*CLONO2*CL - r368*HOCL*CL - r409*CH2BR2*CL - r411*CH3BR*CL + - r414*CH3CL*CL - r416*CHBR3*CL + d(CL2)/dt = r355*CLO*CLO + r359*CLONO2*CL + r459*HOCL*HCL + r464*CLONO2*HCL + r465*HOCL*HCL + r469*CLONO2*HCL + + r470*HOCL*HCL + r474*CLONO2*HCL + - j44*CL2 + d(CL2O2)/dt = r380*M*CLO*CLO + - j45*CL2O2 - r381*M*CL2O2 + d(CLO)/dt = j48*CLONO2 + j60*OCLO + r381*M*CL2O2 + r381*M*CL2O2 + r351*CL*HO2 + r352*CL*O3 + r361*CLONO2*O + + r368*HOCL*CL + r369*HOCL*O + r370*HOCL*OH + r379*O1D*HCL + r450*SO*OCLO + - j46*CLO - r12*CO3m*CLO - r24*CO4m*CLO - r182*NO2m*CLO - r211*O2m*CLO - r238*OHm*CLO + - r247*Om*CLO - r353*CH3O2*CLO - 2*r354*CLO*CLO - 2*r355*CLO*CLO - 2*r356*CLO*CLO - r357*HO2*CLO + - r358*NO*CLO - r360*M*NO2*CLO - r363*O*CLO - r364*OH*CLO - r365*OH*CLO - 2*r380*M*CLO*CLO + - r386*BRO*CLO - r387*BRO*CLO - r388*BRO*CLO - r445*SO*CLO + d(CLONO2)/dt = r360*M*CLO*NO2 + - j47*CLONO2 - j48*CLONO2 - r462*CLONO2 - r467*CLONO2 - r473*CLONO2 - r359*CL*CLONO2 + - r361*O*CLONO2 - r362*OH*CLONO2 - r464*HCL*CLONO2 - r469*HCL*CLONO2 - r474*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = j21*CH2O + j22*CH2O + .38*j25*CH4 + j26*CO2 + j62*CO2 + j101*OCS + r346*CL*CH2O + r382*BR*CH2O + + r414*CH3CL*CL + r426*CH2O*NO3 + r427*CH2O*O + r428*CH2O*OH + r439*OCS*O + r440*OCS*OH + + r490*Op*CO2 + - r436*OH*CO + d(CO2)/dt = .44*j25*CH4 + j63*CO3m + j65*CO4m + r265*M*NOp_CO2 + r10*CL*CO3m + r11*CL*CO3m + r12*CLO*CO3m + + r13*H*CO3m + r16*CO3m_H2O*NO2 + r17*CO3m_H2O*NO2 + r18*CO3m_H2O*NO + r19*CO3m_H2O*NO + + r20*CO3m*HNO3 + r21*CO3m*O + r22*O2*CO3m + r23*CL*CO4m + r24*CLO*CO4m + r26*CO4m*HCL + + r28*CO4m*O3 + r45*HCO3m*O2p + r47*CO4m*O2p + r49*CO3m2H2O*O2p + r51*CO3m_H2O*O2p + + r54*CO3m_H2O*Hp_4H2O + r64*CO3m*Hp_5H2O + r66*CO3m*Hp_4H2O + r68*HCO3m*Hp_5H2O + + r70*CO4m*Hp_5H2O + r72*CO3m2H2O*Hp_5H2O + r74*CO3m_H2O*Hp_5H2O + r82*Hp_3H2O*CO3m + + r85*HCO3m*Hp_3H2O + r87*CO4m*Hp_3H2O + r90*CO3m2H2O*Hp_3H2O + r92*CO3m_H2O*Hp_3H2O + + r99*HCO3m*Hp_4H2O + r100*CO3m*NOp_H2O + r103*HCO3m*NOp_H2O + r105*CO4m*NOp_H2O + + r107*CO3m2H2O*NOp_H2O + r109*CO3m_H2O*NOp_H2O + r117*CO3m*NOp_2H2O + r120*HCO3m*NOp_2H2O + + r121*CO4m*Hp_4H2O + r123*NOp_2H2O*CO4m + r125*CO3m2H2O*NOp_2H2O + r127*CO3m_H2O*NOp_2H2O + + r135*NOp*CO3m + r138*NOp*HCO3m + r140*NOp*CO4m + r142*NOp*CO3m2H2O + r143*CO3m2H2O*Hp_4H2O + + r145*CO3m_H2O*NOp + r152*O2p*CO3m + r154*M*Hp_4H2O*CO3m + r155*M*Hp_5H2O*CO3m2H2O + + r156*M*CO3m_H2O*Hp_4H2O + r157*M*Hp_5H2O*CO3m_H2O + r161*M*Hp_5H2O*CO3m + + r167*M*CO3m2H2O*Hp_4H2O + r176*CO3m*NO + r177*CO3m*NO2 + r202*NOp_CO2*e + r203*NOp_CO2*H2O + + r436*CO*OH + - j26*CO2 - j62*CO2 - r208*NOp_N2*CO2 - r212*M*O2m*CO2 - r226*O3m*CO2 - r231*O4m*CO2 + - r239*M*OHm*CO2 - r248*M*Om*CO2 - r264*M*NOp*CO2 - r490*Op*CO2 + d(COF2)/dt = j32*CF2CLBR + j33*CF3BR + j35*CFC113 + 2*j36*CFC114 + 2*j37*CFC115 + j38*CFC12 + 2*j51*H2402 + + j54*HCFC142B + j55*HCFC22 + r372*O1D*CF2CLBR + r374*O1D*CFC113 + 2*r375*O1D*CFC114 + + 2*r376*O1D*CFC115 + r377*O1D*CFC12 + r398*O1D*CF3BR + 2*r400*O1D*H2402 + r419*HCFC142B*OH + + r420*HCFC22*OH + r424*O1D*HCFC142B + r425*O1D*HCFC22 + - j49*COF2 - r407*O1D*COF2 + d(COFCL)/dt = j34*CFC11 + j35*CFC113 + j53*HCFC141B + r373*O1D*CFC11 + r374*O1D*CFC113 + r418*HCFC141B*OH + + r423*O1D*HCFC141B + - j50*COFCL - r408*O1D*COFCL + d(DMS)/dt = - r437*NO3*DMS - r438*OH*DMS - r452*OH*DMS + d(dst_a1)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(F)/dt = j33*CF3BR + j37*CFC115 + 2*j49*COF2 + j50*COFCL + j57*HF + r376*O1D*CFC115 + r398*O1D*CF3BR + + 2*r407*O1D*COF2 + r408*O1D*COFCL + - r403*CH4*F - r404*H2*F - r405*H2O*F - r406*HNO3*F + d(H)/dt = 2*j2*H2O + j3*H2O + 2*j21*CH2O + j23*CH3OOH + j24*CH4 + .33*j25*CH4 + j52*HBR + j56*HCL + j57*HF + + r34*H3Op_OH*e + r37*Hp_4H2O*e + r40*Hp_5H2O*e + r43*CLm*Hp_4H2O + r54*CO3m_H2O*Hp_4H2O + + r58*Hp_4H2O*NO2m_H2O + r59*Hp_4H2O*NO3m_HCL + r60*CLm_H2O*Hp_4H2O + r61*NO3m2H2O*Hp_4H2O + + r62*Hp_4H2O*NO2m + r64*CO3m*Hp_5H2O + r65*CLm_HCL*Hp_5H2O + r66*CO3m*Hp_4H2O + r68*HCO3m*Hp_5H2O + + r69*Hp_5H2O*O2m + r70*CO4m*Hp_5H2O + r71*Hp_5H2O*NO3m_H2O + r72*CO3m2H2O*Hp_5H2O + + r73*CLm*Hp_5H2O + r74*CO3m_H2O*Hp_5H2O + r75*NO2m_H2O*Hp_5H2O + r76*Hp_5H2O*NO3m_HCL + + r77*CLm_HCL*Hp_4H2O + r78*CLm_H2O*Hp_5H2O + r79*Hp_5H2O*NO3m2H2O + r80*Hp_5H2O*NO2m + + r82*Hp_3H2O*CO3m + r83*CLm_HCL*Hp_3H2O + r85*HCO3m*Hp_3H2O + r86*Hp_3H2O*O2m + r87*CO4m*Hp_3H2O + + r89*Hp_3H2O*NO3m_H2O + r90*CO3m2H2O*Hp_3H2O + r91*CLm*Hp_3H2O + r92*CO3m_H2O*Hp_3H2O + + r93*Hp_3H2O*NO2m_H2O + r94*Hp_3H2O*NO3m_HCL + r95*CLm_H2O*Hp_3H2O + r96*Hp_3H2O*NO3m2H2O + + r97*Hp_3H2O*NO2m + r99*HCO3m*Hp_4H2O + r110*Hp_4H2O*O2m + r121*CO4m*Hp_4H2O + + r132*Hp_4H2O*NO3m_H2O + r143*CO3m2H2O*Hp_4H2O + r154*M*Hp_4H2O*CO3m + r155*M*Hp_5H2O*CO3m2H2O + + r156*M*CO3m_H2O*Hp_4H2O + r157*M*Hp_5H2O*CO3m_H2O + r158*M*NO3m_H2O*Hp_4H2O + + r159*M*NO3m_H2O*Hp_5H2O + r161*M*Hp_5H2O*CO3m + r167*M*CO3m2H2O*Hp_4H2O + r250*Om*H2 + + r277*Hp_H2O*e + r278*Hp_2H2O*e + r279*Hp_3H2O*e + r285*O1D*H2 + r302*H2*O + r311*OH*H2 + + r314*OH*O + r334*N*OH + r348*CL*H2 + r379*O1D*HCL + r402*O1D*HBR + r404*F*H2 + r428*CH2O*OH + + r434*O1D*CH4 + r440*OCS*OH + r446*S*OH + r451*SO*OH + - r1*CLm*H - r13*CO3m*H - r25*CO4m*H - r183*NO2m*H - r205*NOp_H2O*H - r213*O2m*H - r227*O3m*H + - r240*OHm*H - r304*HO2*H - r305*HO2*H - r306*HO2*H - r307*M*O2*H - r310*O3*H + d(H2)/dt = j1*H2O + j22*CH2O + 1.4400001*j25*CH4 + r304*H*HO2 + r435*O1D*CH4 + - r249*Om*H2 - r250*Om*H2 - r285*O1D*H2 - r302*O*H2 - r311*OH*H2 - r348*CL*H2 - r404*F*H2 + d(H2402)/dt = - j51*H2402 - r400*O1D*H2402 + d(H2O2)/dt = .5*r454*HO2 + r317*M*OH*OH + r318*HO2*HO2 + - j4*H2O2 - r303*O*H2O2 - r312*OH*H2O2 - r349*CL*H2O2 + d(H2SO4)/dt = r453*SO3*H2O + - j100*H2SO4 + d(HBR)/dt = r382*BR*CH2O + r383*BR*HO2 + - j52*HBR - r395*O*HBR - r396*OH*HBR - r401*O1D*HBR - r402*O1D*HBR + d(HCFC141B)/dt = - j53*HCFC141B - r418*OH*HCFC141B - r423*O1D*HCFC141B + d(HCFC142B)/dt = - j54*HCFC142B - r419*OH*HCFC142B - r424*O1D*HCFC142B + d(HCFC22)/dt = - j55*HCFC22 - r420*OH*HCFC22 - r425*O1D*HCFC22 + d(HCL)/dt = r282*M*CLm_HCL + r1*CLm*H + r5*CLm*HNO3 + r53*NO3m_HCL*O2p + r59*Hp_4H2O*NO3m_HCL + + r65*CLm_HCL*Hp_5H2O + r76*Hp_5H2O*NO3m_HCL + r77*CLm_HCL*Hp_4H2O + r83*CLm_HCL*Hp_3H2O + + r94*Hp_3H2O*NO3m_HCL + r101*CLm_HCL*NOp_H2O + r112*NO3m_HCL*NOp_H2O + r118*CLm_HCL*NOp_2H2O + + r129*NO3m_HCL*NOp_2H2O + r136*NOp*CLm_HCL + r147*NO3m_HCL*NOp + r153*O2p*CLm_HCL + + 2*r163*M*CLm_HCL*Hp_4H2O + 2*r164*M*Hp_5H2O*CLm_HCL + r195*HNO3*NO3m_HCL + r346*CL*CH2O + + r347*CL*CH4 + r348*CL*H2 + r349*CL*H2O2 + r350*CL*HO2 + r365*CLO*OH + r368*HOCL*CL + + r409*CH2BR2*CL + r411*CH3BR*CL + 2*r414*CH3CL*CL + r416*CHBR3*CL + - j56*HCL - r2*CLm_H2O*HCL - r4*M*CLm*HCL - r26*CO4m*HCL - r172*M*NO3m*HCL - r185*NO2m*HCL + - r194*NO3m*HCL - r214*O2m*HCL - r241*OHm*HCL - r252*Om*HCL - r366*O*HCL - r367*OH*HCL + - r378*O1D*HCL - r379*O1D*HCL - r459*HOCL*HCL - r464*CLONO2*HCL - r465*HOCL*HCL - r466*HOBR*HCL + - r469*CLONO2*HCL - r470*HOCL*HCL - r471*HOBR*HCL - r474*CLONO2*HCL + d(HF)/dt = r403*F*CH4 + r404*F*H2 + r405*F*H2O + r406*F*HNO3 + - j57*HF + d(HNO3)/dt = r171*M*NO3mHNO3 + 2*r455*N2O5 + .5*r456*NO2 + r457*NO3 + 2*r458*N2O5 + r460*BRONO2 + + 2*r461*N2O5 + r462*CLONO2 + r463*BRONO2 + r467*CLONO2 + r468*BRONO2 + 2*r472*N2O5 + + r473*CLONO2 + r36*H2O*Hp_3N1 + r38*Hp_4H2O*N2O5 + r39*H2O*Hp_4N1 + r41*Hp_5H2O*N2O5 + + 2*r42*Hp_4H2O*NO3mHNO3 + 2*r63*Hp_5H2O*NO3mHNO3 + r67*NO3m*Hp_5H2O + 2*r81*Hp_3H2O*NO3mHNO3 + + r84*Hp_3H2O*NO3m + r88*Hp_4H2O*NO3m + r98*NO3mHNO3*NOp_H2O + r116*NO3mHNO3*NOp_2H2O + + r134*NOp*NO3mHNO3 + r151*NO3mHNO3*O2p + r160*M*NO3m*Hp_4H2O + r162*M*Hp_5H2O*NO3m + + 2*r165*M*NO3mHNO3*Hp_4H2O + 2*r166*M*Hp_5H2O*NO3mHNO3 + r189*NO3m2H2O*N2O5 + r193*NO3m_H2O*N2O5 + + r194*HCL*NO3m + r342*M*NO2*OH + r426*CH2O*NO3 + r437*DMS*NO3 + r464*CLONO2*HCL + + r469*CLONO2*HCL + r474*CLONO2*HCL + - j9*HNO3 - r5*CLm*HNO3 - r20*CO3m*HNO3 - r186*NO2m*HNO3 - r191*NO3m_H2O*HNO3 + - r195*NO3m_HCL*HNO3 - r196*M*NO3m*HNO3 - r215*O2m*HNO3 - r253*Om*HNO3 - r343*OH*HNO3 + - r406*F*HNO3 + d(HO2NO2)/dt = r340*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r344*M*HO2NO2 - r319*OH*HO2NO2 + d(HOBR)/dt = r460*BRONO2 + r463*BRONO2 + r468*BRONO2 + r389*BRO*HO2 + - j58*HOBR - r397*O*HOBR - r466*HCL*HOBR - r471*HCL*HOBR + d(HOCL)/dt = r462*CLONO2 + r467*CLONO2 + r473*CLONO2 + r357*CLO*HO2 + r362*CLONO2*OH + - j59*HOCL - r368*CL*HOCL - r369*O*HOCL - r370*OH*HOCL - r459*HCL*HOCL - r465*HCL*HOCL + - r470*HCL*HOCL + d(HONO)/dt = r185*HCL*NO2m + r186*HNO3*NO2m + r201*H2O*NOp_3H2O + r245*M*OH*NO + - j12*HONO - r236*OH*HONO + d(N)/dt = j69*N2 + j70*N2 + .8*j72*N2 + .8*j73*N2 + j17*NO + r491*N2*Op + r320*N2D*O + .2*r478*NOp*e + + 1.1*r480*N2p*e + r484*Np*O + r485*Np*O2 + - j66*N - r322*NO*N - r323*NO2*N - r324*NO2*N - r325*NO2*N - r326*O2*N - r334*OH*N - r487*O2p*N + d(N2O)/dt = r323*N*NO2 + - j13*N2O - r338*O1D*N2O - r339*O1D*N2O + d(N2O5)/dt = r341*M*NO2*NO3 + - j14*N2O5 - j15*N2O5 - r345*M*N2O5 - r455*N2O5 - r458*N2O5 - r461*N2O5 - r472*N2O5 + - r38*Hp_4H2O*N2O5 - r41*Hp_5H2O*N2O5 - r189*NO3m2H2O*N2O5 - r193*NO3m_H2O*N2O5 + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 + d(ncl_a3)/dt = 0 + d(NO)/dt = j12*HONO + j15*N2O5 + j18*NO2 + j20*NO3 + .5*r456*NO2 + r488*N2*O2p + r501*N2*Op2P + + r98*NO3mHNO3*NOp_H2O + r100*CO3m*NOp_H2O + r101*CLm_HCL*NOp_H2O + r102*NO3m*NOp_H2O + + r103*HCO3m*NOp_H2O + r104*NOp_H2O*O2m + r105*CO4m*NOp_H2O + r106*NO3m_H2O*NOp_H2O + + r107*CO3m2H2O*NOp_H2O + r108*CLm*NOp_H2O + r109*CO3m_H2O*NOp_H2O + r111*NO2m_H2O*NOp_H2O + + r112*NO3m_HCL*NOp_H2O + r113*CLm_H2O*NOp_H2O + r114*NO3m2H2O*NOp_H2O + r115*NO2m*NOp_H2O + + r116*NO3mHNO3*NOp_2H2O + r117*CO3m*NOp_2H2O + r118*CLm_HCL*NOp_2H2O + r119*NOp_2H2O*NO3m + + r120*HCO3m*NOp_2H2O + r122*NOp_2H2O*O2m + r123*NOp_2H2O*CO4m + r124*NO3m_H2O*NOp_2H2O + + r125*CO3m2H2O*NOp_2H2O + r126*CLm*NOp_2H2O + r127*CO3m_H2O*NOp_2H2O + r128*NOp_2H2O*NO2m_H2O + + r129*NO3m_HCL*NOp_2H2O + r130*NOp_2H2O*CLm_H2O + r131*NOp_2H2O*NO3m2H2O + r133*NOp_2H2O*NO2m + + r134*NOp*NO3mHNO3 + r135*NOp*CO3m + r136*NOp*CLm_HCL + r137*NO3m*NOp + r138*NOp*HCO3m + + r139*O2m*NOp + r140*NOp*CO4m + r141*NOp*NO3m_H2O + r142*NOp*CO3m2H2O + r144*CLm*NOp + + r145*CO3m_H2O*NOp + r146*NO2m_H2O*NOp + r147*NO3m_HCL*NOp + r148*CLm_H2O*NOp + r149*NOp*NO3m2H2O + + r150*NOp*NO2m + r183*H*NO2m + r187*NO2*NO2m + r199*NOp_2H2O*e + r200*NOp_3H2O*e + + r202*NOp_CO2*e + r204*NOp_H2O*e + r205*H*NOp_H2O + r280*e*NOp_N2 + r321*N2D*O2 + 2*r324*N*NO2 + + r326*N*O2 + r327*NO2*O + r334*N*OH + 2*r338*O1D*N2O + r447*SO*NO2 + - j16*NO - j17*NO - r7*CLOm*NO - r8*CLOm*NO - r18*CO3m_H2O*NO - r19*CO3m_H2O*NO - r32*Om*NO + - r168*O3m*NO - r175*O3m*NO - r176*CO3m*NO - r245*M*OH*NO - r322*N*NO - r331*NO3*NO + - r335*HO2*NO - r336*O3*NO - r337*M*O*NO - r358*CLO*NO - r390*BRO*NO - r430*CH3O2*NO + - r489*O2p*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j14*N2O5 + j19*NO3 + j29*BRONO2 + j48*CLONO2 + j75*NO2m + r344*M*HO2NO2 + + r345*M*N2O5 + r8*CLOm*NO + r32*NO*Om + r52*NO2m_H2O*O2p + r57*NO2m*O2p + r58*Hp_4H2O*NO2m_H2O + + r62*Hp_4H2O*NO2m + r75*NO2m_H2O*Hp_5H2O + r80*Hp_5H2O*NO2m + r93*Hp_3H2O*NO2m_H2O + + r97*Hp_3H2O*NO2m + r111*NO2m_H2O*NOp_H2O + r115*NO2m*NOp_H2O + r128*NOp_2H2O*NO2m_H2O + + r133*NOp_2H2O*NO2m + r146*NO2m_H2O*NOp + r150*NOp*NO2m + r181*CL*NO2m + r207*NOp_H2O*OH + + r236*HONO*OH + r319*HO2NO2*OH + r330*NO3*HO2 + 2*r331*NO3*NO + r332*NO3*O + r333*NO3*OH + + r335*NO*HO2 + r336*NO*O3 + r337*M*NO*O + r358*CLO*NO + r390*BRO*NO + r430*CH3O2*NO + - j18*NO2 - r456*NO2 - r6*CLm*NO2 - r16*CO3m_H2O*NO2 - r17*CO3m_H2O*NO2 - r173*O3m*NO2 + - r174*O3m*NO2 - r177*CO3m*NO2 - r187*NO2m*NO2 - r216*O2m*NO2 - r242*OHm*NO2 - r255*Om*NO2 + - r323*N*NO2 - r324*N*NO2 - r325*N*NO2 - r327*O*NO2 - r328*O3*NO2 - r329*M*O*NO2 + - r340*M*HO2*NO2 - r341*M*NO3*NO2 - r342*M*OH*NO2 - r360*M*CLO*NO2 - r391*M*BRO*NO2 + - r447*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j14*N2O5 + j15*N2O5 + j30*BRONO2 + j47*CLONO2 + j76*NO3m + r345*M*N2O5 + + r44*NO3m*O2p + r48*NO3m_H2O*O2p + r53*NO3m_HCL*O2p + r56*NO3m2H2O*O2p + r59*Hp_4H2O*NO3m_HCL + + r61*NO3m2H2O*Hp_4H2O + r71*Hp_5H2O*NO3m_H2O + r76*Hp_5H2O*NO3m_HCL + r79*Hp_5H2O*NO3m2H2O + + r89*Hp_3H2O*NO3m_H2O + r94*Hp_3H2O*NO3m_HCL + r96*Hp_3H2O*NO3m2H2O + r98*NO3mHNO3*NOp_H2O + + r102*NO3m*NOp_H2O + r106*NO3m_H2O*NOp_H2O + r112*NO3m_HCL*NOp_H2O + r114*NO3m2H2O*NOp_H2O + + r116*NO3mHNO3*NOp_2H2O + r119*NOp_2H2O*NO3m + r124*NO3m_H2O*NOp_2H2O + r129*NO3m_HCL*NOp_2H2O + + r131*NOp_2H2O*NO3m2H2O + r132*Hp_4H2O*NO3m_H2O + r134*NOp*NO3mHNO3 + r137*NO3m*NOp + + r141*NOp*NO3m_H2O + r147*NO3m_HCL*NOp + r149*NOp*NO3m2H2O + r151*NO3mHNO3*O2p + + r158*M*NO3m_H2O*Hp_4H2O + r159*M*NO3m_H2O*Hp_5H2O + r182*CLO*NO2m + r206*NOp_H2O*HO2 + + r328*NO2*O3 + r329*M*NO2*O + r343*HNO3*OH + r359*CLONO2*CL + r361*CLONO2*O + r362*CLONO2*OH + + r392*BRONO2*O + r406*F*HNO3 + - j19*NO3 - j20*NO3 - r457*NO3 - r330*HO2*NO3 - r331*NO*NO3 - r332*O*NO3 - r333*OH*NO3 + - r341*M*NO2*NO3 - r426*CH2O*NO3 - r437*DMS*NO3 + 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 = j2*H2O + 2*j5*O2 + j6*O2 + j8*O3 + j15*N2O5 + j17*NO + j18*NO2 + j19*NO3 + .18*j25*CH4 + + j26*CO2 + j28*BRO + j46*CLO + j60*OCLO + j62*CO2 + j83*O2 + j85*O2 + j87*O2 + 2*j88*O2 + + 2*j89*O2 + j90*O2 + j91*O2 + j92*O2 + j99*Om + j102*SO + j103*SO2 + j104*SO3 + r254*M*Om + + r287*N2*O1D + r495*N2*Op2D + r500*N2*Op2P + r10*CL*CO3m + r49*CO3m2H2O*O2p + r51*CO3m_H2O*O2p + + r54*CO3m_H2O*Hp_4H2O + r64*CO3m*Hp_5H2O + r66*CO3m*Hp_4H2O + r72*CO3m2H2O*Hp_5H2O + + r74*CO3m_H2O*Hp_5H2O + r82*Hp_3H2O*CO3m + r90*CO3m2H2O*Hp_3H2O + r92*CO3m_H2O*Hp_3H2O + + r100*CO3m*NOp_H2O + r107*CO3m2H2O*NOp_H2O + r109*CO3m_H2O*NOp_H2O + r117*CO3m*NOp_2H2O + + r125*CO3m2H2O*NOp_2H2O + r127*CO3m_H2O*NOp_2H2O + r135*NOp*CO3m + r142*NOp*CO3m2H2O + + r143*CO3m2H2O*Hp_4H2O + r145*CO3m_H2O*NOp + r152*O2p*CO3m + r154*M*Hp_4H2O*CO3m + + r155*M*Hp_5H2O*CO3m2H2O + r156*M*CO3m_H2O*Hp_4H2O + r157*M*Hp_5H2O*CO3m_H2O + r161*M*Hp_5H2O*CO3m + + r167*M*CO3m2H2O*Hp_4H2O + r168*NO*O3m + r246*Om*CL + r255*NO2*Om + r259*O3*Om + r288*O1D*O2 + + r289*O1D*O2 + r306*H*HO2 + r316*OH*OH + r322*N*NO + r323*N*NO2 + r326*N*O2 + r441*S*O2 + + r448*SO*O2 + r478*NOp*e + 1.15*r479*O2p*e + r486*Np*O2 + r487*O2p*N + r492*Op*N2D + r493*Op*O2 + + r497*Op2D*O2 + - j77*O - j78*O - j79*O - j80*O - j81*O - j82*O - r9*CLOm*O - r21*CO3m*O - r27*CO4m*O + - r197*NO3m*O - r220*O2m*O - r221*O2m*O - r229*O3m*O - r230*O3m*O - r232*O4m*O - r234*O4p*O + - r243*OHm*O - r256*Om*O - r299*O3*O - 2*r300*M*O*O - r301*M*O2*O - r302*H2*O - r303*H2O2*O + - r308*HO2*O - r314*OH*O - r327*NO2*O - r329*M*NO2*O - r332*NO3*O - r337*M*NO*O - r361*CLONO2*O + - r363*CLO*O - r366*HCL*O - r369*HOCL*O - r392*BRONO2*O - r393*BRO*O - r395*HBR*O - r397*HOBR*O + - r427*CH2O*O - r439*OCS*O - r482*N2p*O - r483*N2p*O - r484*Np*O + d(O1D)/dt = j1*H2O + j6*O2 + j7*O3 + j13*N2O + r321*N2D*O2 + .85*r479*O2p*e + - r287*N2*O1D - r285*H2*O1D - r286*H2O*O1D - r288*O2*O1D - r289*O2*O1D - r290*O3*O1D + - r338*N2O*O1D - r339*N2O*O1D - r371*CCL4*O1D - r372*CF2CLBR*O1D - r373*CFC11*O1D + - r374*CFC113*O1D - r375*CFC114*O1D - r376*CFC115*O1D - r377*CFC12*O1D - r378*HCL*O1D + - r379*HCL*O1D - r398*CF3BR*O1D - r399*CHBR3*O1D - r400*H2402*O1D - r401*HBR*O1D - r402*HBR*O1D + - r407*COF2*O1D - r408*COFCL*O1D - r421*CH2BR2*O1D - r422*CH3BR*O1D - r423*HCFC141B*O1D + - r424*HCFC142B*O1D - r425*HCFC22*O1D - r433*CH4*O1D - r434*CH4*O1D - r435*CH4*O1D + d(O2)/dt = j8*O3 + j20*NO3 + j93*O2m + j95*O3m + j97*O4m + r33*N2*O2m + r283*O2_1D + r284*O2_1S + + r291*N2*O2_1D + r9*CLOm*O + r12*CLO*CO3m + r23*CL*CO4m + r24*CLO*CO4m + r27*CO4m*O + + r28*CO4m*O3 + r30*O3*e + r44*NO3m*O2p + r45*HCO3m*O2p + r47*CO4m*O2p + r47*CO4m*O2p + + r48*NO3m_H2O*O2p + r49*CO3m2H2O*O2p + r50*CLm*O2p + r51*CO3m_H2O*O2p + r52*NO2m_H2O*O2p + + r53*NO3m_HCL*O2p + r55*O2p*CLm_H2O + r56*NO3m2H2O*O2p + r57*NO2m*O2p + r69*Hp_5H2O*O2m + + r70*CO4m*Hp_5H2O + r86*Hp_3H2O*O2m + r87*CO4m*Hp_3H2O + r104*NOp_H2O*O2m + r105*CO4m*NOp_H2O + + r110*Hp_4H2O*O2m + r121*CO4m*Hp_4H2O + r122*NOp_2H2O*O2m + r123*NOp_2H2O*CO4m + r139*O2m*NOp + + r140*NOp*CO4m + r151*NO3mHNO3*O2p + r152*O2p*CO3m + r153*O2p*CLm_HCL + r173*NO2*O3m + + r175*NO*O3m + r188*NO2m*O3 + r197*NO3m*O + 2*r198*O3*NO3m + r210*O2m*CL + r211*CLO*O2m + + r216*NO2*O2m + 2*r217*O2_1D*O2m + r219*O3*O2m + r221*O2m*O + r222*O2p_H2O*e + r223*O2p_H2O*H2O + + r224*O2p_H2O*H2O + r226*O3m*CO2 + r227*O3m*H + 3*r228*O3*O3m + 2*r229*O3m*O + r230*O*O3m + + r231*CO2*O4m + r232*O*O4m + r233*H2O*O4p + 2*r235*O4p*O2_1D + r247*CLO*Om + r256*Om*O + + 2*r276*e*O4p + r290*O1D*O3 + r290*O1D*O3 + r292*O2_1D*O + 2*r293*O2_1D*O2 + 2*r299*O*O3 + + r300*M*O*O + r304*H*HO2 + r308*HO2*O + 2*r309*HO2*O3 + r310*H*O3 + r313*OH*HO2 + r314*OH*O + + r315*OH*O3 + r318*HO2*HO2 + r319*HO2NO2*OH + r325*N*NO2 + r327*NO2*O + r328*NO2*O3 + + r330*NO3*HO2 + r332*NO3*O + r336*NO*O3 + r339*O1D*N2O + r350*CL*HO2 + r352*CL*O3 + + r354*CLO*CLO + r355*CLO*CLO + r357*CLO*HO2 + r363*CLO*O + r365*CLO*OH + r383*BR*HO2 + + r384*BR*O3 + r385*BRO*BRO + r387*BRO*CLO + r388*BRO*CLO + r389*BRO*HO2 + r393*BRO*O + + r429*CH3O2*HO2 + r443*S*O3 + r449*SO*O3 + r489*O2p*NO + - j5*O2 - j6*O2 - j83*O2 - j84*O2 - j85*O2 - j86*O2 - j87*O2 - j88*O2 - j89*O2 - j90*O2 + - j91*O2 - j92*O2 - r22*CO3m*O2 - r29*N2*e*O2 - r31*M*e*O2 - r218*M*O2m*O2 - r258*M*Om*O2 + - r260*M*O2p*O2 - r288*O1D*O2 - r293*O2_1D*O2 - r301*M*O*O2 - r307*M*H*O2 - r321*N2D*O2 + - r326*N*O2 - r441*S*O2 - r448*SO*O2 - r481*N2p*O2 - r485*Np*O2 - r486*Np*O2 - r493*Op*O2 + - r497*Op2D*O2 + d(O3)/dt = j96*O3m + r174*NO2*O3m + r220*O*O2m + r234*O4p*O + r257*Om*O2_1D + r301*M*O*O2 + - j7*O3 - j8*O3 - r28*CO4m*O3 - r30*e*O3 - r188*NO2m*O3 - r198*NO3m*O3 - r219*O2m*O3 + - r228*O3m*O3 - r244*OHm*O3 - r259*Om*O3 - r290*O1D*O3 - r299*O*O3 - r309*HO2*O3 - r310*H*O3 + - r315*OH*O3 - r328*NO2*O3 - r336*NO*O3 - r352*CL*O3 - r384*BR*O3 - r443*S*O3 - r449*SO*O3 + d(OCLO)/dt = r356*CLO*CLO + r386*BRO*CLO + - j60*OCLO - r450*SO*OCLO + d(OCS)/dt = - j101*OCS - r439*O*OCS - r440*OH*OCS + d(pom_a1)/dt = 0 + d(pom_a4)/dt = 0 + d(S)/dt = j101*OCS + j102*SO + - r441*O2*S - r443*O3*S - r446*OH*S + d(SF6)/dt = - j61*SF6 + d(SO)/dt = j103*SO2 + r439*OCS*O + r441*S*O2 + r443*S*O3 + r446*S*OH + - j102*SO - r444*BRO*SO - r445*CLO*SO - r447*NO2*SO - r448*O2*SO - r449*O3*SO - r450*OCLO*SO + - r451*OH*SO + d(SO2)/dt = j104*SO3 + r437*DMS*NO3 + r438*DMS*OH + r440*OCS*OH + r444*SO*BRO + r445*SO*CLO + r447*SO*NO2 + + r448*SO*O2 + r449*SO*O3 + r450*SO*OCLO + r451*SO*OH + .5*r452*DMS*OH + - j103*SO2 - r442*M*OH*SO2 + d(SO3)/dt = j100*H2SO4 + r442*M*SO2*OH + - j104*SO3 - r453*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 = 0 + d(soa_a2)/dt = 0 + d(SOAG)/dt = 0 + d(CLm)/dt = r281*M*CLm_H2O + r282*M*CLm_HCL + r8*CLOm*NO + r9*CLOm*O + r10*CL*CO3m + r12*CLO*CO3m + + r23*CL*CO4m + r26*CO4m*HCL + r181*CL*NO2m + r182*CLO*NO2m + r185*HCL*NO2m + r194*HCL*NO3m + + r210*O2m*CL + r214*O2m*HCL + r237*CL*OHm + r241*OHm*HCL + r246*Om*CL + r247*CLO*Om + + r252*Om*HCL + - r1*H*CLm - r3*M*H2O*CLm - r4*M*HCL*CLm - r5*HNO3*CLm - r6*NO2*CLm - r43*Hp_4H2O*CLm + - r50*O2p*CLm - r73*Hp_5H2O*CLm - r91*Hp_3H2O*CLm - r108*NOp_H2O*CLm - r126*NOp_2H2O*CLm + - r144*NOp*CLm + d(CLm_H2O)/dt = r3*M*CLm*H2O + - r281*M*CLm_H2O - r2*HCL*CLm_H2O - r55*O2p*CLm_H2O - r60*Hp_4H2O*CLm_H2O + - r78*Hp_5H2O*CLm_H2O - r95*Hp_3H2O*CLm_H2O - r113*NOp_H2O*CLm_H2O - r130*NOp_2H2O*CLm_H2O + - r148*NOp*CLm_H2O + d(CLm_HCL)/dt = r2*CLm_H2O*HCL + r4*M*HCL*CLm + - r282*M*CLm_HCL - r65*Hp_5H2O*CLm_HCL - r77*Hp_4H2O*CLm_HCL - r83*Hp_3H2O*CLm_HCL + - r101*NOp_H2O*CLm_HCL - r118*NOp_2H2O*CLm_HCL - r136*NOp*CLm_HCL - r153*O2p*CLm_HCL + - r163*M*Hp_4H2O*CLm_HCL - r164*M*Hp_5H2O*CLm_HCL + d(CLOm)/dt = r11*CL*CO3m + r24*CLO*CO4m + r211*CLO*O2m + r238*CLO*OHm + - r7*NO*CLOm - r8*NO*CLOm - r9*O*CLOm + d(CO3m)/dt = j64*CO3m_H2O + r179*M*CO3m_H2O + r25*CO4m*H + r27*CO4m*O + r226*O3m*CO2 + r248*M*Om*CO2 + - j63*CO3m - r10*CL*CO3m - r11*CL*CO3m - r12*CLO*CO3m - r13*H*CO3m - r15*M*H2O*CO3m + - r20*HNO3*CO3m - r21*O*CO3m - r22*O2*CO3m - r64*Hp_5H2O*CO3m - r66*Hp_4H2O*CO3m + - r82*Hp_3H2O*CO3m - r100*NOp_H2O*CO3m - r117*NOp_2H2O*CO3m - r135*NOp*CO3m - r152*O2p*CO3m + - r154*M*Hp_4H2O*CO3m - r161*M*Hp_5H2O*CO3m - r176*NO*CO3m - r177*NO2*CO3m + d(CO3m2H2O)/dt = r14*M*CO3m_H2O*H2O + - r180*M*CO3m2H2O - r49*O2p*CO3m2H2O - r72*Hp_5H2O*CO3m2H2O - r90*Hp_3H2O*CO3m2H2O + - r107*NOp_H2O*CO3m2H2O - r125*NOp_2H2O*CO3m2H2O - r142*NOp*CO3m2H2O - r143*Hp_4H2O*CO3m2H2O + - r155*M*Hp_5H2O*CO3m2H2O - r167*M*Hp_4H2O*CO3m2H2O + d(CO3m_H2O)/dt = r180*M*CO3m2H2O + r15*M*CO3m*H2O + - j64*CO3m_H2O - r179*M*CO3m_H2O - r14*M*H2O*CO3m_H2O - r16*NO2*CO3m_H2O - r17*NO2*CO3m_H2O + - r18*NO*CO3m_H2O - r19*NO*CO3m_H2O - r51*O2p*CO3m_H2O - r54*Hp_4H2O*CO3m_H2O + - r74*Hp_5H2O*CO3m_H2O - r92*Hp_3H2O*CO3m_H2O - r109*NOp_H2O*CO3m_H2O + - r127*NOp_2H2O*CO3m_H2O - r145*NOp*CO3m_H2O - r156*M*Hp_4H2O*CO3m_H2O + - r157*M*Hp_5H2O*CO3m_H2O + d(CO4m)/dt = r212*M*CO2*O2m + r231*CO2*O4m + - j65*CO4m - r23*CL*CO4m - r24*CLO*CO4m - r25*H*CO4m - r26*HCL*CO4m - r27*O*CO4m - r28*O3*CO4m + - r47*O2p*CO4m - r70*Hp_5H2O*CO4m - r87*Hp_3H2O*CO4m - r105*NOp_H2O*CO4m - r121*Hp_4H2O*CO4m + - r123*NOp_2H2O*CO4m - r140*NOp*CO4m + d(e)/dt = j67*N2 + j68*N2 + j69*N2 + j70*N2 + j71*N2 + j74*N2 + j16*NO + j66*N + j75*NO2m + j76*NO3m + + j77*O + j78*O + j79*O + j80*O + j81*O + j82*O + j83*O2 + j84*O2 + j85*O2 + j86*O2 + j87*O2 + + j90*O2 + j91*O2 + j92*O2 + j93*O2m + j96*O3m + j98*OHm + j99*Om + r33*N2*O2m + r254*M*Om + + r1*CLm*H + r32*NO*Om + r213*H*O2m + r217*O2_1D*O2m + r220*O*O2m + r228*O3*O3m + r229*O3m*O + + r240*H*OHm + r243*OHm*O + r249*H2*Om + r256*Om*O + r257*Om*O2_1D + - r29*N2*O2*e - r30*O3*e - r31*M*O2*e - r34*H3Op_OH*e - r37*Hp_4H2O*e - r40*Hp_5H2O*e + - r199*NOp_2H2O*e - r200*NOp_3H2O*e - r202*NOp_CO2*e - r204*NOp_H2O*e - r222*O2p_H2O*e + - r276*O4p*e - r277*Hp_H2O*e - r278*Hp_2H2O*e - r279*Hp_3H2O*e - r280*NOp_N2*e - r478*NOp*e + - r479*O2p*e - r480*N2p*e + d(H3Op_OH)/dt = r223*O2p_H2O*H2O + - r34*e*H3Op_OH - r35*H2O*H3Op_OH + d(HCO3m)/dt = r239*M*CO2*OHm + - r45*O2p*HCO3m - r68*Hp_5H2O*HCO3m - r85*Hp_3H2O*HCO3m - r99*Hp_4H2O*HCO3m + - r103*NOp_H2O*HCO3m - r120*NOp_2H2O*HCO3m - r138*NOp*HCO3m + d(HO2)/dt = j11*HO2NO2 + r344*M*HO2NO2 + r26*CO4m*HCL + r213*H*O2m + r214*O2m*HCL + r215*O2m*HNO3 + + r243*OHm*O + r303*H2O2*O + r307*M*H*O2 + r312*OH*H2O2 + r315*OH*O3 + r333*NO3*OH + + r346*CL*CH2O + r349*CL*H2O2 + r353*CLO*CH3O2 + r364*CLO*OH + r382*BR*CH2O + r394*BRO*OH + + r411*CH3BR*CL + r412*CH3BR*OH + r414*CH3CL*CL + r415*CH3CL*OH + r426*CH2O*NO3 + r427*CH2O*O + + r430*CH3O2*NO + r434*O1D*CH4 + r436*CO*OH + r442*M*SO2*OH + .5*r452*DMS*OH + - r454*HO2 - r206*NOp_H2O*HO2 - r304*H*HO2 - r305*H*HO2 - r306*H*HO2 - r308*O*HO2 - r309*O3*HO2 + - r313*OH*HO2 - 2*r318*HO2*HO2 - r330*NO3*HO2 - r335*NO*HO2 - r340*M*NO2*HO2 - r350*CL*HO2 + - r351*CL*HO2 - r357*CLO*HO2 - r383*BR*HO2 - r389*BRO*HO2 - r429*CH3O2*HO2 + d(Hp_2H2O)/dt = r271*M*Hp_3H2O + r35*H2O*H3Op_OH + r268*M*Hp_H2O*H2O + - r269*M*Hp_2H2O - r270*M*H2O*Hp_2H2O - r278*e*Hp_2H2O + d(Hp_3H2O)/dt = r273*M*Hp_4H2O + r201*H2O*NOp_3H2O + r270*M*H2O*Hp_2H2O + - r271*M*Hp_3H2O - r81*NO3mHNO3*Hp_3H2O - r82*CO3m*Hp_3H2O - r83*CLm_HCL*Hp_3H2O + - r84*NO3m*Hp_3H2O - r85*HCO3m*Hp_3H2O - r86*O2m*Hp_3H2O - r87*CO4m*Hp_3H2O + - r89*NO3m_H2O*Hp_3H2O - r90*CO3m2H2O*Hp_3H2O - r91*CLm*Hp_3H2O - r92*CO3m_H2O*Hp_3H2O + - r93*NO2m_H2O*Hp_3H2O - r94*NO3m_HCL*Hp_3H2O - r95*CLm_H2O*Hp_3H2O - r96*NO3m2H2O*Hp_3H2O + - r97*NO2m*Hp_3H2O - r272*M*H2O*Hp_3H2O - r279*e*Hp_3H2O + d(Hp_3N1)/dt = r38*Hp_4H2O*N2O5 + - r36*H2O*Hp_3N1 + d(Hp_4H2O)/dt = r275*M*Hp_5H2O + r36*H2O*Hp_3N1 + r272*M*Hp_3H2O*H2O + - r273*M*Hp_4H2O - r37*e*Hp_4H2O - r38*N2O5*Hp_4H2O - r42*NO3mHNO3*Hp_4H2O - r43*CLm*Hp_4H2O + - r54*CO3m_H2O*Hp_4H2O - r58*NO2m_H2O*Hp_4H2O - r59*NO3m_HCL*Hp_4H2O - r60*CLm_H2O*Hp_4H2O + - r61*NO3m2H2O*Hp_4H2O - r62*NO2m*Hp_4H2O - r66*CO3m*Hp_4H2O - r77*CLm_HCL*Hp_4H2O + - r88*NO3m*Hp_4H2O - r99*HCO3m*Hp_4H2O - r110*O2m*Hp_4H2O - r121*CO4m*Hp_4H2O + - r132*NO3m_H2O*Hp_4H2O - r143*CO3m2H2O*Hp_4H2O - r154*M*CO3m*Hp_4H2O + - r156*M*CO3m_H2O*Hp_4H2O - r158*M*NO3m_H2O*Hp_4H2O - r160*M*NO3m*Hp_4H2O + - r163*M*CLm_HCL*Hp_4H2O - r165*M*NO3mHNO3*Hp_4H2O - r167*M*CO3m2H2O*Hp_4H2O + - r274*M*H2O*Hp_4H2O + d(Hp_4N1)/dt = r41*Hp_5H2O*N2O5 + - r39*H2O*Hp_4N1 + d(Hp_5H2O)/dt = r39*H2O*Hp_4N1 + r274*M*Hp_4H2O*H2O + - r275*M*Hp_5H2O - r40*e*Hp_5H2O - r41*N2O5*Hp_5H2O - r63*NO3mHNO3*Hp_5H2O - r64*CO3m*Hp_5H2O + - r65*CLm_HCL*Hp_5H2O - r67*NO3m*Hp_5H2O - r68*HCO3m*Hp_5H2O - r69*O2m*Hp_5H2O + - r70*CO4m*Hp_5H2O - r71*NO3m_H2O*Hp_5H2O - r72*CO3m2H2O*Hp_5H2O - r73*CLm*Hp_5H2O + - r74*CO3m_H2O*Hp_5H2O - r75*NO2m_H2O*Hp_5H2O - r76*NO3m_HCL*Hp_5H2O - r78*CLm_H2O*Hp_5H2O + - r79*NO3m2H2O*Hp_5H2O - r80*NO2m*Hp_5H2O - r155*M*CO3m2H2O*Hp_5H2O - r157*M*CO3m_H2O*Hp_5H2O + - r159*M*NO3m_H2O*Hp_5H2O - r161*M*CO3m*Hp_5H2O - r162*M*NO3m*Hp_5H2O - r164*M*CLm_HCL*Hp_5H2O + - r166*M*NO3mHNO3*Hp_5H2O + d(Hp_H2O)/dt = r269*M*Hp_2H2O + r205*H*NOp_H2O + r206*NOp_H2O*HO2 + r207*NOp_H2O*OH + r224*O2p_H2O*H2O + - r268*M*H2O*Hp_H2O - r277*e*Hp_H2O + d(N2D)/dt = j68*N2 + j71*N2 + 1.2*j72*N2 + 1.2*j73*N2 + .8*r478*NOp*e + .9*r480*N2p*e + r482*N2p*O + - r320*O*N2D - r321*O2*N2D - r492*Op*N2D + d(N2p)/dt = j67*N2 + j74*N2 + r495*N2*Op2D + r500*N2*Op2P + - r480*e*N2p - r481*O2*N2p - r482*O*N2p - r483*O*N2p + d(NO2m)/dt = r169*M*NO2m_H2O + r6*CLm*NO2 + r7*CLOm*NO + r19*CO3m_H2O*NO + r174*NO2*O3m + r175*NO*O3m + + r176*CO3m*NO + r197*NO3m*O + r198*O3*NO3m + r216*NO2*O2m + r242*NO2*OHm + r255*NO2*Om + - j75*NO2m - r57*O2p*NO2m - r62*Hp_4H2O*NO2m - r80*Hp_5H2O*NO2m - r97*Hp_3H2O*NO2m + - r115*NOp_H2O*NO2m - r133*NOp_2H2O*NO2m - r150*NOp*NO2m - r181*CL*NO2m - r182*CLO*NO2m + - r183*H*NO2m - r184*M*H2O*NO2m - r185*HCL*NO2m - r186*HNO3*NO2m - r187*NO2*NO2m - r188*O3*NO2m + d(NO2m_H2O)/dt = r18*CO3m_H2O*NO + r184*M*NO2m*H2O + - r169*M*NO2m_H2O - r52*O2p*NO2m_H2O - r58*Hp_4H2O*NO2m_H2O - r75*Hp_5H2O*NO2m_H2O + - r93*Hp_3H2O*NO2m_H2O - r111*NOp_H2O*NO2m_H2O - r128*NOp_2H2O*NO2m_H2O - r146*NOp*NO2m_H2O + d(NO3m)/dt = r171*M*NO3mHNO3 + r178*M*NO3m_H2O + r5*CLm*HNO3 + r16*CO3m_H2O*NO2 + r20*CO3m*HNO3 + r168*NO*O3m + + r173*NO2*O3m + r177*CO3m*NO2 + r186*HNO3*NO2m + r187*NO2*NO2m + r188*NO2m*O3 + r215*O2m*HNO3 + + r253*Om*HNO3 + - j76*NO3m - r44*O2p*NO3m - r67*Hp_5H2O*NO3m - r84*Hp_3H2O*NO3m - r88*Hp_4H2O*NO3m + - r102*NOp_H2O*NO3m - r119*NOp_2H2O*NO3m - r137*NOp*NO3m - r160*M*Hp_4H2O*NO3m + - r162*M*Hp_5H2O*NO3m - r172*M*HCL*NO3m - r192*M*H2O*NO3m - r194*HCL*NO3m - r196*M*HNO3*NO3m + - r197*O*NO3m - r198*O3*NO3m + d(NO3m2H2O)/dt = r190*M*NO3m_H2O*H2O + - r170*M*NO3m2H2O - r56*O2p*NO3m2H2O - r61*Hp_4H2O*NO3m2H2O - r79*Hp_5H2O*NO3m2H2O + - r96*Hp_3H2O*NO3m2H2O - r114*NOp_H2O*NO3m2H2O - r131*NOp_2H2O*NO3m2H2O - r149*NOp*NO3m2H2O + - r189*N2O5*NO3m2H2O + d(NO3m_H2O)/dt = r170*M*NO3m2H2O + r17*CO3m_H2O*NO2 + r192*M*H2O*NO3m + - r178*M*NO3m_H2O - r48*O2p*NO3m_H2O - r71*Hp_5H2O*NO3m_H2O - r89*Hp_3H2O*NO3m_H2O + - r106*NOp_H2O*NO3m_H2O - r124*NOp_2H2O*NO3m_H2O - r132*Hp_4H2O*NO3m_H2O - r141*NOp*NO3m_H2O + - r158*M*Hp_4H2O*NO3m_H2O - r159*M*Hp_5H2O*NO3m_H2O - r190*M*H2O*NO3m_H2O + - r191*HNO3*NO3m_H2O - r193*N2O5*NO3m_H2O + d(NO3m_HCL)/dt = r172*M*HCL*NO3m + - r53*O2p*NO3m_HCL - r59*Hp_4H2O*NO3m_HCL - r76*Hp_5H2O*NO3m_HCL - r94*Hp_3H2O*NO3m_HCL + - r112*NOp_H2O*NO3m_HCL - r129*NOp_2H2O*NO3m_HCL - r147*NOp*NO3m_HCL - r195*HNO3*NO3m_HCL + d(NO3mHNO3)/dt = r189*NO3m2H2O*N2O5 + r191*HNO3*NO3m_H2O + r193*NO3m_H2O*N2O5 + r195*HNO3*NO3m_HCL + + r196*M*NO3m*HNO3 + - r171*M*NO3mHNO3 - r42*Hp_4H2O*NO3mHNO3 - r63*Hp_5H2O*NO3mHNO3 - r81*Hp_3H2O*NO3mHNO3 + - r98*NOp_H2O*NO3mHNO3 - r116*NOp_2H2O*NO3mHNO3 - r134*NOp*NO3mHNO3 - r151*O2p*NO3mHNO3 + - r165*M*Hp_4H2O*NO3mHNO3 - r166*M*Hp_5H2O*NO3mHNO3 + d(NOp)/dt = j16*NO + r265*M*NOp_CO2 + r267*M*NOp_N2 + r488*N2*O2p + r491*N2*Op + r482*N2p*O + r486*Np*O2 + + r487*O2p*N + r489*O2p*NO + - r266*N2*M*NOp - r134*NO3mHNO3*NOp - r135*CO3m*NOp - r136*CLm_HCL*NOp - r137*NO3m*NOp + - r138*HCO3m*NOp - r139*O2m*NOp - r140*CO4m*NOp - r141*NO3m_H2O*NOp - r142*CO3m2H2O*NOp + - r144*CLm*NOp - r145*CO3m_H2O*NOp - r146*NO2m_H2O*NOp - r147*NO3m_HCL*NOp - r148*CLm_H2O*NOp + - r149*NO3m2H2O*NOp - r150*NO2m*NOp - r261*M*H2O*NOp - r264*M*CO2*NOp - r478*e*NOp + d(NOp_2H2O)/dt = r262*M*H2O*NOp_H2O + - r116*NO3mHNO3*NOp_2H2O - r117*CO3m*NOp_2H2O - r118*CLm_HCL*NOp_2H2O - r119*NO3m*NOp_2H2O + - r120*HCO3m*NOp_2H2O - r122*O2m*NOp_2H2O - r123*CO4m*NOp_2H2O - r124*NO3m_H2O*NOp_2H2O + - r125*CO3m2H2O*NOp_2H2O - r126*CLm*NOp_2H2O - r127*CO3m_H2O*NOp_2H2O + - r128*NO2m_H2O*NOp_2H2O - r129*NO3m_HCL*NOp_2H2O - r130*CLm_H2O*NOp_2H2O + - r131*NO3m2H2O*NOp_2H2O - r133*NO2m*NOp_2H2O - r199*e*NOp_2H2O - r263*M*H2O*NOp_2H2O + d(NOp_3H2O)/dt = r263*M*H2O*NOp_2H2O + - r200*e*NOp_3H2O - r201*H2O*NOp_3H2O + d(NOp_CO2)/dt = r208*CO2*NOp_N2 + r264*M*NOp*CO2 + - r265*M*NOp_CO2 - r202*e*NOp_CO2 - r203*H2O*NOp_CO2 + d(NOp_H2O)/dt = r203*NOp_CO2*H2O + r209*NOp_N2*H2O + r261*M*H2O*NOp + - r98*NO3mHNO3*NOp_H2O - r100*CO3m*NOp_H2O - r101*CLm_HCL*NOp_H2O - r102*NO3m*NOp_H2O + - r103*HCO3m*NOp_H2O - r104*O2m*NOp_H2O - r105*CO4m*NOp_H2O - r106*NO3m_H2O*NOp_H2O + - r107*CO3m2H2O*NOp_H2O - r108*CLm*NOp_H2O - r109*CO3m_H2O*NOp_H2O - r111*NO2m_H2O*NOp_H2O + - r112*NO3m_HCL*NOp_H2O - r113*CLm_H2O*NOp_H2O - r114*NO3m2H2O*NOp_H2O - r115*NO2m*NOp_H2O + - r204*e*NOp_H2O - r205*H*NOp_H2O - r206*HO2*NOp_H2O - r207*OH*NOp_H2O - r262*M*H2O*NOp_H2O + d(NOp_N2)/dt = r266*N2*M*NOp + - r267*M*NOp_N2 - r208*CO2*NOp_N2 - r209*H2O*NOp_N2 - r280*e*NOp_N2 + d(Np)/dt = j68*N2 + j69*N2 + j70*N2 + j71*N2 + j66*N + r501*N2*Op2P + r492*Op*N2D + - r484*O*Np - r485*O2*Np - r486*O2*Np + d(O2_1D)/dt = j7*O3 + r295*N2*O2_1S + r294*O2_1S*CO2 + r296*O2_1S*O + r297*O2_1S*O2 + r298*O2_1S*O3 + - r283*O2_1D - r291*N2*O2_1D - r217*O2m*O2_1D - r235*O4p*O2_1D - r257*Om*O2_1D - r292*O*O2_1D + - r293*O2*O2_1D + d(O2_1S)/dt = r288*O1D*O2 + - r284*O2_1S - r295*N2*O2_1S - r294*CO2*O2_1S - r296*O*O2_1S - r297*O2*O2_1S - r298*O3*O2_1S + d(O2m)/dt = j65*CO4m + j97*O4m + r21*CO3m*O + r29*N2*e*O2 + r31*M*O2*e + r230*O*O3m + - j93*O2m - r33*N2*O2m - r46*O2p*O2m - r69*Hp_5H2O*O2m - r86*Hp_3H2O*O2m - r104*NOp_H2O*O2m + - r110*Hp_4H2O*O2m - r122*NOp_2H2O*O2m - r139*NOp*O2m - r210*CL*O2m - r211*CLO*O2m + - r212*M*CO2*O2m - r213*H*O2m - r214*HCL*O2m - r215*HNO3*O2m - r216*NO2*O2m - r217*O2_1D*O2m + - r218*M*O2*O2m - r219*O3*O2m - r220*O*O2m - r221*O*O2m + d(O2p)/dt = j84*O2 + j86*O2 + j94*O2p_H2O + 2*r46*O2m*O2p + r234*O4p*O + r235*O4p*O2_1D + r481*N2p*O2 + + r485*Np*O2 + r490*Op*CO2 + r493*Op*O2 + r497*Op2D*O2 + - r488*N2*O2p - r44*NO3m*O2p - r45*HCO3m*O2p - r46*O2m*O2p - r47*CO4m*O2p - r48*NO3m_H2O*O2p + - r49*CO3m2H2O*O2p - r50*CLm*O2p - r51*CO3m_H2O*O2p - r52*NO2m_H2O*O2p - r53*NO3m_HCL*O2p + - r55*CLm_H2O*O2p - r56*NO3m2H2O*O2p - r57*NO2m*O2p - r151*NO3mHNO3*O2p - r152*CO3m*O2p + - r153*CLm_HCL*O2p - r225*M*H2O*O2p - r260*M*O2*O2p - r479*e*O2p - r487*N*O2p - r489*NO*O2p + d(O2p_H2O)/dt = r225*M*H2O*O2p + r233*H2O*O4p + - j94*O2p_H2O - r222*e*O2p_H2O - r223*H2O*O2p_H2O - r224*H2O*O2p_H2O + d(O3m)/dt = r22*O2*CO3m + r28*CO4m*O3 + r219*O3*O2m + r232*O*O4m + r244*OHm*O3 + r258*M*Om*O2 + r259*O3*Om + - j95*O3m - j96*O3m - r168*NO*O3m - r173*NO2*O3m - r174*NO2*O3m - r175*NO*O3m - r226*CO2*O3m + - r227*H*O3m - r228*O3*O3m - r229*O*O3m - r230*O*O3m + d(O4m)/dt = r218*M*O2*O2m + - j97*O4m - r231*CO2*O4m - r232*O*O4m + d(O4p)/dt = r260*M*O2p*O2 + - r233*H2O*O4p - r234*O*O4p - r235*O2_1D*O4p - r276*e*O4p + d(OH)/dt = j3*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j12*HONO + j23*CH3OOH + .33*j25*CH4 + j58*HOBR + + j59*HOCL + j98*OHm + .5*r456*NO2 + r20*CO3m*HNO3 + r25*CO4m*H + r34*H3Op_OH*e + + r35*H2O*H3Op_OH + r45*HCO3m*O2p + r68*HCO3m*Hp_5H2O + r85*HCO3m*Hp_3H2O + r99*HCO3m*Hp_4H2O + + r103*HCO3m*NOp_H2O + r120*HCO3m*NOp_2H2O + r138*NOp*HCO3m + r224*O2p_H2O*H2O + r237*CL*OHm + + r238*CLO*OHm + r242*NO2*OHm + r244*OHm*O3 + r251*Om*H2O + r252*Om*HCL + r253*Om*HNO3 + + r285*O1D*H2 + 2*r286*O1D*H2O + r302*H2*O + r303*H2O2*O + 2*r305*H*HO2 + r308*HO2*O + + r309*HO2*O3 + r310*H*O3 + r330*NO3*HO2 + r335*NO*HO2 + r351*CL*HO2 + r366*HCL*O + r369*HOCL*O + + r378*O1D*HCL + r395*HBR*O + r397*HOBR*O + r401*O1D*HBR + r405*F*H2O + r427*CH2O*O + + .3*r431*CH3OOH*OH + r433*O1D*CH4 + - r207*NOp_H2O*OH - r236*HONO*OH - r245*M*NO*OH - r311*H2*OH - r312*H2O2*OH - r313*HO2*OH + - r314*O*OH - r315*O3*OH - 2*r316*OH*OH - 2*r317*M*OH*OH - r319*HO2NO2*OH - r333*NO3*OH + - r334*N*OH - r342*M*NO2*OH - r343*HNO3*OH - r362*CLONO2*OH - r364*CLO*OH - r365*CLO*OH + - r367*HCL*OH - r370*HOCL*OH - r394*BRO*OH - r396*HBR*OH - r410*CH2BR2*OH - r412*CH3BR*OH + - r413*CH3CCL3*OH - r415*CH3CL*OH - r417*CHBR3*OH - r418*HCFC141B*OH - r419*HCFC142B*OH + - r420*HCFC22*OH - r428*CH2O*OH - r431*CH3OOH*OH - r432*CH4*OH - r436*CO*OH - r438*DMS*OH + - r440*OCS*OH - r442*M*SO2*OH - r446*S*OH - r451*SO*OH - r452*DMS*OH + d(OHm)/dt = r13*H*CO3m + r183*H*NO2m + r227*O3m*H + r250*Om*H2 + r251*Om*H2O + - j98*OHm - r237*CL*OHm - r238*CLO*OHm - r239*M*CO2*OHm - r240*H*OHm - r241*HCL*OHm + - r242*NO2*OHm - r243*O*OHm - r244*O3*OHm + d(Om)/dt = j63*CO3m + j95*O3m + r30*O3*e + r221*O2m*O + - j99*Om - r254*M*Om - r32*NO*Om - r246*CL*Om - r247*CLO*Om - r248*M*CO2*Om - r249*H2*Om + - r250*H2*Om - r251*H2O*Om - r252*HCL*Om - r253*HNO3*Om - r255*NO2*Om - r256*O*Om + - r257*O2_1D*Om - r258*M*O2*Om - r259*O3*Om + d(Op)/dt = j77*O + j81*O + j85*O2 + j87*O2 + r475*Op2P + r476*Op2D + r483*N2p*O + r484*Np*O + r494*Op2D*e + + r496*Op2D*O + r499*Op2P*e + r502*Op2P*O + - r491*N2*Op - r490*CO2*Op - r492*N2D*Op - r493*O2*Op + d(Op2D)/dt = j78*O + j82*O + j83*O2 + j92*O2 + r477*Op2P + r498*Op2P*e + - r476*Op2D - r495*N2*Op2D - r494*e*Op2D - r496*O*Op2D - r497*O2*Op2D + d(Op2P)/dt = j79*O + j80*O + j90*O2 + j91*O2 + - r475*Op2P - r477*Op2P - r500*N2*Op2P - r501*N2*Op2P - r498*e*Op2P - r499*e*Op2P + - r502*O*Op2P + d(H2O)/dt = .05*j25*CH4 + j64*CO3m_H2O + j94*O2p_H2O + j100*H2SO4 + r169*M*NO2m_H2O + r170*M*NO3m2H2O + + r178*M*NO3m_H2O + r179*M*CO3m_H2O + r180*M*CO3m2H2O + r269*M*Hp_2H2O + r271*M*Hp_3H2O + + r273*M*Hp_4H2O + r275*M*Hp_5H2O + r281*M*CLm_H2O + r2*CLm_H2O*HCL + r16*CO3m_H2O*NO2 + + r19*CO3m_H2O*NO + r34*H3Op_OH*e + 4*r37*Hp_4H2O*e + 5*r40*Hp_5H2O*e + 4*r42*Hp_4H2O*NO3mHNO3 + + 4*r43*CLm*Hp_4H2O + r48*NO3m_H2O*O2p + 2*r49*CO3m2H2O*O2p + r51*CO3m_H2O*O2p + r52*NO2m_H2O*O2p + + 5*r54*CO3m_H2O*Hp_4H2O + r55*O2p*CLm_H2O + 2*r56*NO3m2H2O*O2p + 5*r58*Hp_4H2O*NO2m_H2O + + 4*r59*Hp_4H2O*NO3m_HCL + 5*r60*CLm_H2O*Hp_4H2O + 6*r61*NO3m2H2O*Hp_4H2O + 4*r62*Hp_4H2O*NO2m + + 5*r63*Hp_5H2O*NO3mHNO3 + 5*r64*CO3m*Hp_5H2O + 5*r65*CLm_HCL*Hp_5H2O + 4*r66*CO3m*Hp_4H2O + + 5*r67*NO3m*Hp_5H2O + 5*r68*HCO3m*Hp_5H2O + 5*r69*Hp_5H2O*O2m + 5*r70*CO4m*Hp_5H2O + + 6*r71*Hp_5H2O*NO3m_H2O + 7*r72*CO3m2H2O*Hp_5H2O + 5*r73*CLm*Hp_5H2O + 6*r74*CO3m_H2O*Hp_5H2O + + 6*r75*NO2m_H2O*Hp_5H2O + 5*r76*Hp_5H2O*NO3m_HCL + 4*r77*CLm_HCL*Hp_4H2O + 6*r78*CLm_H2O*Hp_5H2O + + 7*r79*Hp_5H2O*NO3m2H2O + 5*r80*Hp_5H2O*NO2m + 3*r81*Hp_3H2O*NO3mHNO3 + 3*r82*Hp_3H2O*CO3m + + 3*r83*CLm_HCL*Hp_3H2O + 3*r84*Hp_3H2O*NO3m + 3*r85*HCO3m*Hp_3H2O + 3*r86*Hp_3H2O*O2m + + 3*r87*CO4m*Hp_3H2O + 4*r88*Hp_4H2O*NO3m + 4*r89*Hp_3H2O*NO3m_H2O + 5*r90*CO3m2H2O*Hp_3H2O + + 3*r91*CLm*Hp_3H2O + 4*r92*CO3m_H2O*Hp_3H2O + 4*r93*Hp_3H2O*NO2m_H2O + 3*r94*Hp_3H2O*NO3m_HCL + + 4*r95*CLm_H2O*Hp_3H2O + 5*r96*Hp_3H2O*NO3m2H2O + 3*r97*Hp_3H2O*NO2m + r98*NO3mHNO3*NOp_H2O + + 4*r99*HCO3m*Hp_4H2O + r100*CO3m*NOp_H2O + r101*CLm_HCL*NOp_H2O + r102*NO3m*NOp_H2O + + r103*HCO3m*NOp_H2O + r104*NOp_H2O*O2m + r105*CO4m*NOp_H2O + 2*r106*NO3m_H2O*NOp_H2O + + 3*r107*CO3m2H2O*NOp_H2O + r108*CLm*NOp_H2O + 2*r109*CO3m_H2O*NOp_H2O + 4*r110*Hp_4H2O*O2m + + 2*r111*NO2m_H2O*NOp_H2O + r112*NO3m_HCL*NOp_H2O + 2*r113*CLm_H2O*NOp_H2O + + 3*r114*NO3m2H2O*NOp_H2O + r115*NO2m*NOp_H2O + 2*r116*NO3mHNO3*NOp_2H2O + 2*r117*CO3m*NOp_2H2O + + 2*r118*CLm_HCL*NOp_2H2O + 2*r119*NOp_2H2O*NO3m + 2*r120*HCO3m*NOp_2H2O + 4*r121*CO4m*Hp_4H2O + + 2*r122*NOp_2H2O*O2m + 2*r123*NOp_2H2O*CO4m + 3*r124*NO3m_H2O*NOp_2H2O + 4*r125*CO3m2H2O*NOp_2H2O + + 2*r126*CLm*NOp_2H2O + 3*r127*CO3m_H2O*NOp_2H2O + 3*r128*NOp_2H2O*NO2m_H2O + + 2*r129*NO3m_HCL*NOp_2H2O + 3*r130*NOp_2H2O*CLm_H2O + 4*r131*NOp_2H2O*NO3m2H2O + + 5*r132*Hp_4H2O*NO3m_H2O + 2*r133*NOp_2H2O*NO2m + r141*NOp*NO3m_H2O + 2*r142*NOp*CO3m2H2O + + 6*r143*CO3m2H2O*Hp_4H2O + r145*CO3m_H2O*NOp + r146*NO2m_H2O*NOp + r148*CLm_H2O*NOp + + 2*r149*NOp*NO3m2H2O + 4*r154*M*Hp_4H2O*CO3m + 7*r155*M*Hp_5H2O*CO3m2H2O + + 5*r156*M*CO3m_H2O*Hp_4H2O + 6*r157*M*Hp_5H2O*CO3m_H2O + 5*r158*M*NO3m_H2O*Hp_4H2O + + 6*r159*M*NO3m_H2O*Hp_5H2O + 4*r160*M*NO3m*Hp_4H2O + 5*r161*M*Hp_5H2O*CO3m + + 5*r162*M*Hp_5H2O*NO3m + 4*r163*M*CLm_HCL*Hp_4H2O + 5*r164*M*Hp_5H2O*CLm_HCL + + 4*r165*M*NO3mHNO3*Hp_4H2O + 5*r166*M*Hp_5H2O*NO3mHNO3 + 6*r167*M*CO3m2H2O*Hp_4H2O + + r189*NO3m2H2O*N2O5 + r191*HNO3*NO3m_H2O + 2*r199*NOp_2H2O*e + 3*r200*NOp_3H2O*e + + r204*NOp_H2O*e + r222*O2p_H2O*e + r236*HONO*OH + r240*H*OHm + r241*OHm*HCL + r249*H2*Om + + r277*Hp_H2O*e + 2*r278*Hp_2H2O*e + 3*r279*Hp_3H2O*e + r306*H*HO2 + r311*OH*H2 + r312*OH*H2O2 + + r313*OH*HO2 + r316*OH*OH + r319*HO2NO2*OH + r343*HNO3*OH + r367*HCL*OH + r370*HOCL*OH + + r396*HBR*OH + r410*CH2BR2*OH + r412*CH3BR*OH + r413*CH3CCL3*OH + r415*CH3CL*OH + + r420*HCFC22*OH + r428*CH2O*OH + r431*CH3OOH*OH + r432*CH4*OH + r459*HOCL*HCL + r465*HOCL*HCL + + r466*HOBR*HCL + r470*HOCL*HCL + r471*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r3*M*CLm*H2O - r14*M*CO3m_H2O*H2O - r15*M*CO3m*H2O + - r35*H3Op_OH*H2O - r36*Hp_3N1*H2O - r39*Hp_4N1*H2O - r184*M*NO2m*H2O - r190*M*NO3m_H2O*H2O + - r192*M*NO3m*H2O - r201*NOp_3H2O*H2O - r203*NOp_CO2*H2O - r209*NOp_N2*H2O - r223*O2p_H2O*H2O + - r224*O2p_H2O*H2O - r225*M*O2p*H2O - r233*O4p*H2O - r251*Om*H2O - r261*M*NOp*H2O + - r262*M*NOp_H2O*H2O - r263*M*NOp_2H2O*H2O - r268*M*Hp_H2O*H2O - r270*M*Hp_2H2O*H2O + - r272*M*Hp_3H2O*H2O - r274*M*Hp_4H2O*H2O - r286*O1D*H2O - r405*F*H2O - r453*SO3*H2O diff --git a/src/chemistry/pp_waccm_mad_mam5/chem_mech.in b/src/chemistry/pp_waccm_mad_mam5/chem_mech.in new file mode 100644 index 0000000000..6457b97c02 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/chem_mech.in @@ -0,0 +1,1082 @@ +* Comments +* User-given Tag Description: WACCM_MAD_MAM4_JPL19 +* Tag database identifier : MZ322_MAD_MAM4_20221220 +* Tag created by : lke +* Tag created from branch : MAD_MAM4 +* Tag created on : 2022-12-20 14:37:15.595223-07 +* Comments for this tag follow: +* lke : 2022-12-20 : WACCM Middle Atmosphere and D-region mechanism, updated to JPL19 + + SPECIES + + Solution + bc_a1 -> C, + bc_a4 -> C, + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + CCL4 -> CCl4, + CF2CLBR -> CF2ClBr, + CF3BR -> CF3Br, + CFC11 -> CFCl3, + CFC113 -> CCl2FCClF2, + CFC114 -> CClF2CClF2, + CFC115 -> CClF2CF3, + CFC12 -> CF2Cl2, + CH2BR2 -> CH2Br2, + CH2O, + CH3BR -> CH3Br, + CH3CCL3 -> CH3CCl3, + CH3CL -> CH3Cl, + CH3O2, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + COF2, + COFCL -> COFCl, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + F, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HF, + HNO3, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + HONO, + N, + N2O, + N2O5, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + NO, + NO2, + NO3, + num_a1 -> H, + num_a2 -> H, + num_a3 -> H, + num_a4 -> H, + num_a5 -> H, + O, + O1D -> O, + O2, + O3, + OCLO -> OClO, + OCS -> OCS, + pom_a1 -> C, + pom_a4 -> C, + 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, + SOAG -> C, + CLm -> Cl, + CLm_H2O -> ClH2O, + CLm_HCL -> Cl2H, + CLOm -> ClO, + CO3m -> CO3, + CO3m2H2O -> H4CO5, + CO3m_H2O -> H2CO4, + CO4m -> CO4, + e -> E, + H3Op_OH -> H4O2, + HCO3m -> HCO3, + HO2, + Hp_2H2O -> H5O2, + Hp_3H2O -> H7O3, + Hp_3N1 -> H8NO6, + Hp_4H2O -> H9O4, + Hp_4N1 -> H10NO7, + Hp_5H2O -> H11O5, + Hp_H2O -> H3O, + N2D -> N, + N2p -> N2, + NO2m -> NO2, + NO2m_H2O -> H2NO3, + NO3m -> NO3, + NO3m2H2O -> H4NO5, + NO3m_H2O -> H2NO4, + NO3m_HCL -> NO3HCl, + NO3mHNO3 -> HN2O6, + NOp -> NO, + NOp_2H2O -> H4NO3, + NOp_3H2O -> H6NO3, + NOp_CO2 -> NCO3, + NOp_H2O -> H2NO2, + NOp_N2 -> N3O, + Np -> N, + O2_1D -> O2, + O2_1S -> O2, + O2m -> O2, + O2p -> O2, + O2p_H2O -> H2O3, + O3m -> O3, + O4m -> O4, + O4p -> O4, + OH, + OHm -> OH, + Om -> O, + Op -> O, + Op2D -> O, + Op2P -> O, + H2O + + End Solution + + + Fixed + M, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + CLm, + CLm_H2O, + CLm_HCL, + CLOm, + CO3m, + CO3m2H2O, + CO3m_H2O, + CO4m, + e, + H3Op_OH, + HCO3m, + HO2, + Hp_2H2O, + Hp_3H2O, + Hp_3N1, + Hp_4H2O, + Hp_4N1, + Hp_5H2O, + Hp_H2O, + N2D, + N2p, + NO2m, + NO2m_H2O, + NO3m, + NO3m2H2O, + NO3m_H2O, + NO3m_HCL, + NO3mHNO3, + NOp, + NOp_2H2O, + NOp_3H2O, + NOp_CO2, + NOp_H2O, + NOp_N2, + Np, + O2_1D, + O2_1S, + O2m, + O2p, + O2p_H2O, + O3m, + O4m, + O4p, + OH, + OHm, + Om, + Op, + Op2D, + Op2P + End Not-Transported + + END Species + + + Solution classes + Explicit + + End Explicit + + Implicit + bc_a1 + bc_a4 + BR + BRCL + BRO + BRONO2 + BRY + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH2O + CH3BR + CH3CCL3 + CH3CL + CH3O2 + CH3OOH + CH4 + CHBR3 + CL + CL2 + CL2O2 + CLO + CLONO2 + CLY + CO + CO2 + COF2 + COFCL + DMS + dst_a1 + dst_a2 + dst_a3 + F + H + H2 + H2402 + H2O2 + H2SO4 + HBR + HCFC141B + HCFC142B + HCFC22 + HCL + HF + HNO3 + HO2NO2 + HOBR + HOCL + HONO + N + N2O + N2O5 + ncl_a1 + ncl_a2 + ncl_a3 + NO + NO2 + NO3 + num_a1 + num_a2 + num_a3 + num_a4 + num_a5 + O + O1D + O2 + O3 + OCLO + OCS + pom_a1 + pom_a4 + S + SF6 + SO + SO2 + SO3 + so4_a1 + so4_a2 + so4_a3 + so4_a5 + soa_a1 + soa_a2 + SOAG + CLm + CLm_H2O + CLm_HCL + CLOm + CO3m + CO3m2H2O + CO3m_H2O + CO4m + e + H3Op_OH + HCO3m + HO2 + Hp_2H2O + Hp_3H2O + Hp_3N1 + Hp_4H2O + Hp_4N1 + Hp_5H2O + Hp_H2O + N2D + N2p + NO2m + NO2m_H2O + NO3m + NO3m2H2O + NO3m_H2O + NO3m_HCL + NO3mHNO3 + NOp + NOp_2H2O + NOp_3H2O + NOp_CO2 + NOp_H2O + NOp_N2 + Np + O2_1D + O2_1S + O2m + O2p + O2p_H2O + O3m + O4m + O4p + OH + OHm + Om + Op + Op2D + Op2P + H2O + End Implicit + + End Solution classes + + + CHEMISTRY + Photolysis +********************************* +*** odd-oxygen +********************************* +[jh2o_b] H2O + hv -> H2 + O1D +[jh2o_c] H2O + hv -> 2*H + O +[jh2o_a] H2O + hv -> OH + H +[jh2o2] H2O2 + hv -> 2*OH +[jo2_b=userdefined,] O2 + hv -> 2*O +[jo2_a=userdefined,] O2 + hv -> O + O1D +[jo3_a] O3 + hv -> O1D + O2_1D +[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 +[jhono] HONO + hv -> NO + OH +[jn2o] N2O + hv -> O1D + N2 +[jn2o5_a] N2O5 + hv -> NO2 + NO3 +[jn2o5_b] N2O5 + hv -> NO + O + NO3 +[jno_i] NO + hv -> NOp + e +[jno=userdefined,] NO + hv -> N + O +[jno2] NO2 + hv -> NO + O +[jno3_a] NO3 + hv -> NO2 + O +[jno3_b] NO3 + hv -> NO + O2 +********************************* +*** organics +********************************* +[jch2o_a] CH2O + hv -> CO + 2*H +[jch2o_b] CH2O + hv -> CO + H2 +[jch3ooh] CH3OOH + hv -> CH2O + H + OH +[jch4_a] CH4 + hv -> H + CH3O2 +[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 +[jco2] CO2 + hv -> CO + O +********************************* +*** 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 -> 2*CL + COFCL +[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 +[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_a] CLONO2 + hv -> CL + NO3 +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jcof2] COF2 + hv -> 2*F +[jcofcl] COFCL + hv -> F + CL +[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 +********************************* +*** ions +********************************* +[jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O +[jpni3=userdefined] CO3m + hv -> CO2 + Om +[jpni5=userdefined] CO3m_H2O + hv -> CO3m + H2O +[jpni4=userdefined] CO4m + hv -> CO2 + O2m +[jeuv_4=userdefined,userdefined] N + hv -> Np + e +[jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e +[jepn6=userdefined] NO2m + hv -> NO2 + e +[jepn7=userdefined] NO3m + hv -> NO3 + e +[jeuv_1=userdefined,userdefined] O + hv -> Op + e +[jeuv_2=userdefined,userdefined] O + hv -> Op2D + e +[jeuv_16=userdefined,userdefined] O + hv -> Op2P + e +[jeuv_3=userdefined,userdefined] O + hv -> Op2P + e +[jeuv_14=userdefined,userdefined] O + hv -> Op + e +[jeuv_15=userdefined,userdefined] O + hv -> Op2D + e +[jeuv_8=userdefined,userdefined] O2 + hv -> O + Op2D + e +[jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_24=userdefined,userdefined] O2 + hv -> 2*O +[jeuv_12=userdefined,userdefined] O2 + hv -> 2*O +[jeuv_21=userdefined,userdefined] O2 + hv -> O + Op2P + e +[jeuv_9=userdefined,userdefined] O2 + hv -> O + Op2P + e +[jeuv_20=userdefined,userdefined] O2 + hv -> O + Op2D + e +[jepn2=userdefined] O2m + hv -> O2 + e +[jppi=userdefined] O2p_H2O + hv -> H2O + O2p +[jpni1=userdefined] O3m + hv -> O2 + Om +[jepn3=userdefined] O3m + hv -> O3 + e +[jpni2=userdefined] O4m + hv -> O2 + O2m +[jepn4=userdefined] OHm + hv -> OH + e +[jepn1=userdefined] Om + hv -> O + e +********************************* +*** 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 + End Photolysis + + Reactions +********************************* +*** Not Assigned to a Section +********************************* +[CLm_H] CLm + H -> HCL + e ; 9.6e-10 +[CLmH2O_HCL] CLm_H2O + HCL -> CLm_HCL + H2O ; 1.3e-09 +[CLm_H2O_Ma] CLm + H2O + M -> CLm_H2O + M ; 2e-29 +[CLmHCL_M] HCL + M + CLm -> CLm_HCL + M ; 1e-27 +[CLm_HNO3] CLm + HNO3 -> HCL + NO3m ; 1.6e-09 +[CLm_NO2] CLm + NO2 -> CL + NO2m ; 6e-12 +[CLOm_NOa] CLOm + NO -> CL + NO2m ; 2.9e-12 +[CLOm_NOb] CLOm + NO -> NO2 + CLm ; 2.9e-11 +[CLOm_O] CLOm + O -> CLm + O2 ; 2e-10 +[CO3m_CLa] CL + CO3m -> CLm + CO2 + O ; 1e-10 +[CO3m_CLb] CL + CO3m -> CLOm + CO2 ; 1e-10 +[CO3m_CLO] CLO + CO3m -> CLm + CO2 + O2 ; 1e-11 +[CO3m_H] H + CO3m -> CO2 + OHm ; 1.7e-10 +[CO3mH2O_H2O_M] CO3m_H2O + H2O + M -> CO3m2H2O + M ; 1e-28 +[CO3m_H2O_M] CO3m + H2O + M -> CO3m_H2O + M ; 1e-28 +[CO3mH2O_NO2a] CO3m_H2O + NO2 -> CO2 + H2O + NO3m ; 4e-11 +[CO3mH2O_NO2b] CO3m_H2O + NO2 -> CO2 + NO3m_H2O ; 4e-11 +[CO3mH2O_NOa] CO3m_H2O + NO -> CO2 + NO2m_H2O ; 3.5e-12 +[CO3mH2O_NOb] CO3m_H2O + NO -> CO2 + H2O + NO2m ; 3.5e-12 +[CO3m_HNO3] CO3m + HNO3 -> CO2 + NO3m + OH ; 3.51e-10 +[CO3m_O] CO3m + O -> CO2 + O2m ; 1.1e-10 +[CO3m_O2] O2 + CO3m -> CO2 + O3m ; 6e-15 +[CO4m_CL] CL + CO4m -> CLm + CO2 + O2 ; 1e-10 +[CO4m_CLO] CLO + CO4m -> CLOm + CO2 + O2 ; 1e-10 +[CO4m_H] CO4m + H -> CO3m + OH ; 2.2e-10 +[CO4m_HCL] CO4m + HCL -> CLm + CO2 + HO2 ; 1.2e-09 +[CO4m_O] CO4m + O -> CO3m + O2 ; 1.4e-10 +[CO4m_O3] CO4m + O3 -> CO2 + O2 + O3m ; 1.3e-10 +[ean1] e + O2 + N2 -> N2 + O2m +[ean2] O3 + e -> O2 + Om +[ean3] M + O2 + e -> M + O2m +[edn1] NO + Om -> e + NO2 +[edn2] N2 + O2m -> e + O2 + N2 +[H3OpOH_e] H3Op_OH + e -> H + H2O + OH ; 1.5e-06 +[H3OpOH_H2O] H2O + H3Op_OH -> Hp_2H2O + OH ; 2e-09 +[Hp3N1_H2O] H2O + Hp_3N1 -> HNO3 + Hp_4H2O ; 1e-09 +[Hp4H2O_e] Hp_4H2O + e -> H + 4*H2O ; 3.6e-06 +[Hp4H2O_N2O5] Hp_4H2O + N2O5 -> HNO3 + Hp_3N1 ; 4e-12 +[Hp4N1_H2O] H2O + Hp_4N1 -> HNO3 + Hp_5H2O ; 1e-09 +[Hp5H2O_e] Hp_5H2O + e -> H + 5*H2O ; 5e-06 +[Hp5H2O_N2O5] Hp_5H2O + N2O5 -> HNO3 + Hp_4N1 ; 7e-12 +[iira1] Hp_4H2O + NO3mHNO3 -> 4*H2O + 2*HNO3 +[iira10] CLm + Hp_4H2O -> CL + H + 4*H2O +[iira100] NO3m + O2p -> NO3 + O2 +[iira101] HCO3m + O2p -> CO2 + O2 + OH +[iira102] O2m + O2p -> 2*O2p +[iira103] CO4m + O2p -> CO2 + O2 + O2 +[iira104] NO3m_H2O + O2p -> H2O + NO3 + O2 +[iira105] CO3m2H2O + O2p -> CO2 + 2*H2O + O + O2 +[iira106] CLm + O2p -> CL + O2 +[iira107] CO3m_H2O + O2p -> H2O + O + O2 + CO2 +[iira108] NO2m_H2O + O2p -> H2O + NO2 + O2 +[iira109] NO3m_HCL + O2p -> HCL + NO3 + O2 +[iira11] CO3m_H2O + Hp_4H2O -> CO2 + 5*H2O + O + H +[iira110] O2p + CLm_H2O -> CL + H2O + O2 +[iira111] NO3m2H2O + O2p -> 2*H2O + NO3 + O2 +[iira112] NO2m + O2p -> NO2 + O2 +[iira12] Hp_4H2O + NO2m_H2O -> H + 5*H2O + NO2 +[iira13] Hp_4H2O + NO3m_HCL -> H + 4*H2O + NO3 + HCL +[iira14] CLm_H2O + Hp_4H2O -> H + CL + 5*H2O +[iira15] NO3m2H2O + Hp_4H2O -> H + 6*H2O + NO3 +[iira16] Hp_4H2O + NO2m -> H + NO2 + 4*H2O +[iira17] Hp_5H2O + NO3mHNO3 -> 5*H2O + 2*HNO3 +[iira18] CO3m + Hp_5H2O -> CO2 + 5*H2O + O + H +[iira19] CLm_HCL + Hp_5H2O -> CL + H + 5*H2O + HCL +[iira2] CO3m + Hp_4H2O -> CO2 + H + 4*H2O + O +[iira20] NO3m + Hp_5H2O -> 5*H2O + HNO3 +[iira21] HCO3m + Hp_5H2O -> CO2 + H + 5*H2O + OH +[iira22] Hp_5H2O + O2m -> H + 5*H2O + O2 +[iira23] CO4m + Hp_5H2O -> CO2 + 5*H2O + O2 + H +[iira24] Hp_5H2O + NO3m_H2O -> H + 6*H2O + NO3 +[iira25] CO3m2H2O + Hp_5H2O -> H + CO2 + 7*H2O + O +[iira26] CLm + Hp_5H2O -> CL + H + 5*H2O +[iira27] CO3m_H2O + Hp_5H2O -> CO2 + H + 6*H2O + O +[iira28] NO2m_H2O + Hp_5H2O -> H + 6*H2O + NO2 +[iira29] Hp_5H2O + NO3m_HCL -> H + 5*H2O + HCL + NO3 +[iira3] CLm_HCL + Hp_4H2O -> CL + H + HCL + 4*H2O +[iira30] CLm_H2O + Hp_5H2O -> CL + H + 6*H2O +[iira31] Hp_5H2O + NO3m2H2O -> H + 7*H2O + NO3 +[iira32] Hp_5H2O + NO2m -> 5*H2O + NO2 + H +[iira33] Hp_3H2O + NO3mHNO3 -> 3*H2O + 2*HNO3 +[iira34] Hp_3H2O + CO3m -> CO2 + H + 3*H2O + O +[iira35] CLm_HCL + Hp_3H2O -> CL + H + 3*H2O + HCL +[iira36] Hp_3H2O + NO3m -> 3*H2O + HNO3 +[iira37] HCO3m + Hp_3H2O -> CO2 + H + 3*H2O + OH +[iira38] Hp_3H2O + O2m -> H + 3*H2O + O2 +[iira39] CO4m + Hp_3H2O -> CO2 + H + 3*H2O + O2 +[iira4] Hp_4H2O + NO3m -> 4*H2O + HNO3 +[iira40] Hp_3H2O + NO3m_H2O -> H + 4*H2O + NO3 +[iira41] CO3m2H2O + Hp_3H2O -> CO2 + H + 5*H2O + O +[iira42] CLm + Hp_3H2O -> CL + H + 3*H2O +[iira43] CO3m_H2O + Hp_3H2O -> CO2 + H + O + 4*H2O +[iira44] Hp_3H2O + NO2m_H2O -> H + 4*H2O + NO2 +[iira45] Hp_3H2O + NO3m_HCL -> H + 3*H2O + HCL + NO3 +[iira46] CLm_H2O + Hp_3H2O -> H + 4*H2O + CL +[iira47] Hp_3H2O + NO3m2H2O -> H + 5*H2O + NO3 +[iira48] Hp_3H2O + NO2m -> H + 3*H2O + NO2 +[iira49] NO3mHNO3 + NOp_H2O -> H2O + HNO3 + NO + NO3 +[iira5] HCO3m + Hp_4H2O -> CO2 + H + 4*H2O + OH +[iira50] CO3m + NOp_H2O -> CO2 + H2O + NO + O +[iira51] CLm_HCL + NOp_H2O -> CL + NO + H2O + HCL +[iira52] NO3m + NOp_H2O -> H2O + NO + NO3 +[iira53] HCO3m + NOp_H2O -> OH + CO2 + H2O + NO +[iira54] NOp_H2O + O2m -> H2O + NO + O2 +[iira55] CO4m + NOp_H2O -> O2 + NO + CO2 + H2O +[iira56] NO3m_H2O + NOp_H2O -> 2*H2O + NO + NO3 +[iira57] CO3m2H2O + NOp_H2O -> CO2 + 3*H2O + NO + O +[iira58] CLm + NOp_H2O -> CL + H2O + NO +[iira59] CO3m_H2O + NOp_H2O -> O + CO2 + 2*H2O + NO +[iira6] Hp_4H2O + O2m -> O2 + H + 4*H2O +[iira60] NO2m_H2O + NOp_H2O -> NO + 2*H2O + NO2 +[iira61] NO3m_HCL + NOp_H2O -> H2O + NO + NO3 + HCL +[iira62] CLm_H2O + NOp_H2O -> CL + 2*H2O + NO +[iira63] NO3m2H2O + NOp_H2O -> NO + NO3 + 3*H2O +[iira64] NO2m + NOp_H2O -> NO + H2O + NO2 +[iira65] NO3mHNO3 + NOp_2H2O -> 2*H2O + NO3 + HNO3 + NO +[iira66] CO3m + NOp_2H2O -> 2*H2O + NO + CO2 + O +[iira67] CLm_HCL + NOp_2H2O -> NO + CL + 2*H2O + HCL +[iira68] NOp_2H2O + NO3m -> NO + 2*H2O + NO3 +[iira69] HCO3m + NOp_2H2O -> 2*H2O + OH + NO + CO2 +[iira7] CO4m + Hp_4H2O -> 4*H2O + H + CO2 + O2 +[iira70] NOp_2H2O + O2m -> 2*H2O + NO + O2 +[iira71] NOp_2H2O + CO4m -> O2 + 2*H2O + NO + CO2 +[iira72] NO3m_H2O + NOp_2H2O -> 3*H2O + NO3 + NO +[iira73] CO3m2H2O + NOp_2H2O -> O + CO2 + 4*H2O + NO +[iira74] CLm + NOp_2H2O -> 2*H2O + NO + CL +[iira75] CO3m_H2O + NOp_2H2O -> 3*H2O + CO2 + NO + O +[iira76] NOp_2H2O + NO2m_H2O -> 3*H2O + NO + NO2 +[iira77] NO3m_HCL + NOp_2H2O -> NO + HCL + 2*H2O + NO3 +[iira78] NOp_2H2O + CLm_H2O -> NO + 3*H2O + CL +[iira79] NOp_2H2O + NO3m2H2O -> NO + NO3 + 4*H2O +[iira8] Hp_4H2O + NO3m_H2O -> H + 5*H2O + NO3 +[iira80] NOp_2H2O + NO2m -> 2*H2O + NO2 + NO +[iira81] NOp + NO3mHNO3 -> NO + HNO3 + NO3 +[iira82] NOp + CO3m -> CO2 + NO + O +[iira83] NOp + CLm_HCL -> CL + HCL + NO +[iira84] NO3m + NOp -> NO3 + NO +[iira85] NOp + HCO3m -> NO + CO2 + OH +[iira86] O2m + NOp -> NO + O2 +[iira87] NOp + CO4m -> CO2 + NO + O2 +[iira88] NOp + NO3m_H2O -> H2O + NO + NO3 +[iira89] NOp + CO3m2H2O -> NO + O + CO2 + 2*H2O +[iira9] CO3m2H2O + Hp_4H2O -> CO2 + 6*H2O + O + H +[iira90] CLm + NOp -> CL + NO +[iira91] CO3m_H2O + NOp -> H2O + NO + O + CO2 +[iira92] NO2m_H2O + NOp -> NO + NO2 + H2O +[iira93] NO3m_HCL + NOp -> NO + HCL + NO3 +[iira94] CLm_H2O + NOp -> CL + NO + H2O +[iira95] NOp + NO3m2H2O -> 2*H2O + NO + NO3 +[iira96] NOp + NO2m -> NO2 + NO +[iira97] NO3mHNO3 + O2p -> O2 + NO3 + HNO3 +[iira98] O2p + CO3m -> O + O2 + CO2 +[iira99] O2p + CLm_HCL -> O2 + HCL + CL +[iirb1] Hp_4H2O + CO3m + M -> 4*H2O + O + CO2 + H + M +[iirb10] Hp_5H2O + M + CO3m2H2O -> H + 7*H2O + M + CO2 + O +[iirb11] M + CO3m_H2O + Hp_4H2O -> 5*H2O + M + H + CO2 + O +[iirb12] Hp_5H2O + M + CO3m_H2O -> CO2 + M + O + H + 6*H2O +[iirb13] NO3m_H2O + Hp_4H2O + M -> M + NO3 + H + 5*H2O +[iirb14] NO3m_H2O + Hp_5H2O + M -> M + NO3 + H + 6*H2O +[iirb2] NO3m + M + Hp_4H2O -> 4*H2O + HNO3 + M +[iirb3] Hp_5H2O + M + CO3m -> 5*H2O + M + CO2 + O + H +[iirb4] Hp_5H2O + NO3m + M -> M + HNO3 + 5*H2O +[iirb5] M + CLm_HCL + Hp_4H2O -> M + 2*HCL + 4*H2O +[iirb6] M + Hp_5H2O + CLm_HCL -> M + 5*H2O + 2*HCL +[iirb7] NO3mHNO3 + M + Hp_4H2O -> 4*H2O + M + 2*HNO3 +[iirb8] Hp_5H2O + M + NO3mHNO3 -> M + 5*H2O + 2*HNO3 +[iirb9] M + CO3m2H2O + Hp_4H2O -> CO2 + 6*H2O + H + M + O +[nir1] NO + O3m -> O + NO3m +[nir10] NO2m_H2O + M -> H2O + NO2m + M +[nir11] NO3m2H2O + M -> M + NO3m_H2O + H2O +[nir12] NO3mHNO3 + M -> NO3m + HNO3 + M +[nir13] HCL + M + NO3m -> NO3m_HCL + M +[nir2] NO2 + O3m -> NO3m + O2 +[nir3] NO2 + O3m -> NO2m + O3 +[nir4] NO + O3m -> NO2m + O2 +[nir5] CO3m + NO -> CO2 + NO2m +[nir6] CO3m + NO2 -> NO3m + CO2 +[nir7] M + NO3m_H2O -> M + H2O + NO3m +[nir8] CO3m_H2O + M -> CO3m + M + H2O +[nir9] CO3m2H2O + M -> CO3m_H2O + H2O + M +[NO2m_CL] CL + NO2m -> CLm + NO2 ; 1e-10 +[NO2m_CLO] CLO + NO2m -> CLm + NO3 ; 1e-10 +[NO2m_H] H + NO2m -> NO + OHm ; 3e-10 +[NO2m_H2O_M] NO2m + H2O + M -> M + NO2m_H2O ; 1.6e-28 +[NO2m_HCL] HCL + NO2m -> CLm + HONO ; 1.4e-09 +[NO2m_HNO3] HNO3 + NO2m -> NO3m + HONO ; 1.6e-09 +[NO2m_NO2] NO2 + NO2m -> NO + NO3m ; 2e-13 +[NO2m_O3] NO2m + O3 -> NO3m + O2 ; 1.2e-10 +[NO3m2H2O_N2O5] NO3m2H2O + N2O5 -> H2O + HNO3 + NO3mHNO3 ; 7e-10 +[NO3mH2O_H2O_M] NO3m_H2O + H2O + M -> M + NO3m2H2O ; 1.6e-28 +[NO3mH2O_HNO3] HNO3 + NO3m_H2O -> H2O + NO3mHNO3 ; 1.6e-09 +[NO3m_H2O_M] H2O + M + NO3m -> M + NO3m_H2O ; 1.6e-28 +[NO3mH2O_N2O5] NO3m_H2O + N2O5 -> HNO3 + NO3mHNO3 ; 7e-10 +[NO3m_HCLa] HCL + NO3m -> CLm + HNO3 ; 1e-12 +[NO3mHCL_HNO3] HNO3 + NO3m_HCL -> HCL + NO3mHNO3 ; 7.6e-10 +[NO3m_HNO3_M] NO3m + HNO3 + M -> M + NO3mHNO3 ; 1.45e-26 +[NO3m_O] NO3m + O -> NO2m + O2 ; 5e-12 +[NO3m_O3] O3 + NO3m -> NO2m + 2*O2 ; 1e-13 +[NOp2H2O_e] NOp_2H2O + e -> 2*H2O + NO ; 2e-06 +[NOp3H2O_e] NOp_3H2O + e -> 3*H2O + NO ; 2e-06 +[NOp3H2O_H2O] H2O + NOp_3H2O -> HONO + Hp_3H2O ; 7e-11 +[NOpCO2_e] NOp_CO2 + e -> CO2 + NO ; 1.5e-06 +[NOpCO2_H2O] NOp_CO2 + H2O -> CO2 + NOp_H2O ; 1e-09 +[NOpH2O_e] NOp_H2O + e -> H2O + NO ; 1.5e-06 +[NOpH2O_H] H + NOp_H2O -> NO + Hp_H2O ; 7e-12 +[NOpH2O_HO2] NOp_H2O + HO2 -> Hp_H2O + NO3 ; 5e-10 +[NOpH2O_OH] NOp_H2O + OH -> Hp_H2O + NO2 ; 1e-10 +[NOpN2_CO2] CO2 + NOp_N2 -> N2 + NOp_CO2 ; 1e-09 +[NOpN2_H2O] NOp_N2 + H2O -> N2 + NOp_H2O ; 1e-09 +[O2m_CL] O2m + CL -> CLm + O2 ; 1e-10 +[O2m_CLO] CLO + O2m -> CLOm + O2 ; 1e-10 +[O2m_CO2_M] CO2 + M + O2m -> CO4m + M ; 9.9e-30 +[O2m_H] H + O2m -> HO2 + e ; 1.4e-09 +[O2m_HCL] O2m + HCL -> CLm + HO2 ; 1.6e-09 +[O2m_HNO3] O2m + HNO3 -> HO2 + NO3m ; 2.9e-09 +[O2m_NO2] NO2 + O2m -> NO2m + O2 ; 7e-10 +[O2m_O21D] O2_1D + O2m -> 2*O2 + e ; 2e-10 +[O2m_O2_M] O2 + M + O2m -> M + O4m ; 3.4e-31 +[O2m_O3] O3 + O2m -> O2 + O3m ; 7.8e-10 +[O2m_O_a] O + O2m -> O3 + e ; 1.5e-10 +[O2m_O_b] O2m + O -> O2 + Om ; 1.5e-10 +[O2pH2O_e] O2p_H2O + e -> H2O + O2 ; 2e-06 +[O2pH2O_H2Oa] O2p_H2O + H2O -> H3Op_OH + O2 ; 9e-10 +[O2pH2O_H2Ob] O2p_H2O + H2O -> Hp_H2O + O2 + OH ; 2.4e-10 +[O2p_H2O_M] M + H2O + O2p -> M + O2p_H2O ; 2.8e-28 +[O3m_CO2] O3m + CO2 -> CO3m + O2 ; 5.5e-10 +[O3m_H] O3m + H -> O2 + OHm ; 8.4e-10 +[O3m_O3] O3 + O3m -> 3*O2 + e ; 1e-10 +[O3m_O_a] O3m + O -> 2*O2 + e ; 1e-10 +[O3m_O_b] O + O3m -> O2 + O2m ; 2.5e-10 +[O4m_CO2] CO2 + O4m -> CO4m + O2 ; 4.3e-10 +[O4m_O] O + O4m -> O3m + O2 ; 4e-10 +[O4p_H2O] H2O + O4p -> O2 + O2p_H2O ; 1.7e-09 +[O4p_O] O4p + O -> O2p + O3 ; 3e-10 +[O4p_O21D] O4p + O2_1D -> 2*O2 + O2p ; 1.5e-10 +[OH_HONO] HONO + OH -> H2O + NO2 ; 3e-12, 250 +[OHm_CL] CL + OHm -> CLm + OH ; 1e-10 +[OHm_CLO] CLO + OHm -> CLOm + OH ; 1e-10 +[OHm_CO2] CO2 + M + OHm -> M + HCO3m ; 7.6e-28 +[OHm_H] H + OHm -> e + H2O ; 1.4e-09 +[OHm_HCL] OHm + HCL -> CLm + H2O ; 1e-09 +[OHm_NO2] NO2 + OHm -> NO2m + OH ; 1.1e-09 +[OHm_O] OHm + O -> HO2 + e ; 2e-10 +[OHm_O3] OHm + O3 -> O3m + OH ; 9e-10 +[OH_NO_M] OH + NO + M -> HONO + M ; 7e-31, 2.6, 3.6e-11, 0.1, 0.6 +[Om_CL] Om + CL -> CLm + O ; 1e-10 +[Om_CLO] CLO + Om -> CLm + O2 ; 1e-10 +[Om_CO2_M] M + Om + CO2 -> CO3m + M ; 2e-28 +[Om_H2_a] H2 + Om -> H2O + e ; 5.8e-10 +[Om_H2_b] Om + H2 -> H + OHm ; 3.2e-11 +[Om_H2O] Om + H2O -> OHm + OH ; 6e-13 +[Om_HCL] Om + HCL -> CLm + OH ; 2e-09 +[Om_HNO3] Om + HNO3 -> NO3m + OH ; 3.6e-09 +[Om_M] M + Om -> O + M + e ; 5e-13 +[Om_NO2] NO2 + Om -> O + NO2m ; 1e-09 +[Om_O] Om + O -> e + O2 ; 1.9e-10 +[Om_O21D] Om + O2_1D -> O3 + e ; 3e-10 +[Om_O2_M] M + Om + O2 -> M + O3m ; 2.9e-31 +[Om_O3] O3 + Om -> O + O3m ; 8e-10 +[pir1] M + O2p + O2 -> M + O4p +[pir10] H2O + NOp + M -> M + NOp_H2O +[pir11] H2O + M + NOp_H2O -> M + NOp_2H2O +[pir12] H2O + NOp_2H2O + M -> M + NOp_3H2O +[pir13] NOp + CO2 + M -> M + NOp_CO2 +[pir14] NOp_CO2 + M -> M + NOp + CO2 +[pir15] N2 + M + NOp -> NOp_N2 + M +[pir16] NOp_N2 + M -> M + NOp + N2 +[pir2] M + Hp_H2O + H2O -> Hp_2H2O + M +[pir3] Hp_2H2O + M -> H2O + Hp_H2O + M +[pir4] H2O + Hp_2H2O + M -> Hp_3H2O + M +[pir5] Hp_3H2O + M -> M + Hp_2H2O + H2O +[pir6] Hp_3H2O + H2O + M -> M + Hp_4H2O +[pir7] Hp_4H2O + M -> H2O + M + Hp_3H2O +[pir8] Hp_4H2O + M + H2O -> Hp_5H2O + M +[pir9] M + Hp_5H2O -> M + H2O + Hp_4H2O +[rpe1] e + O4p -> 2*O2 +[rpe2] Hp_H2O + e -> H + H2O +[rpe3] Hp_2H2O + e -> 2*H2O + H +[rpe4] Hp_3H2O + e -> H + 3*H2O +[rpe5] e + NOp_N2 -> N2 + NO +[usr_CLm_H2O_M] CLm_H2O + M -> H2O + M + CLm +[usr_CLm_HCL_M] M + CLm_HCL -> CLm + HCL + M +********************************* +*** odd-oxygen +********************************* +[ag1] O2_1D -> O2 ; 0.000258 +[ag2] O2_1S -> O2 ; 0.085 +[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_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 2.64e-11, 55 +[O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 6.6e-12, 55 +[O1D_O3] O1D + O3 -> O2 + O2 ; 1.2e-10 +[O2_1D_N2,cph=94.3] O2_1D + N2 -> O2 + N2 ; 1e-20 +[O2_1D_O,cph=94.3] O2_1D + O -> O2 + O ; 1.3e-16 +[O2_1D_O2,cph=94.3] O2_1D + O2 -> 2*O2 ; 3.6e-18, -220 +[O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13 +[O2_1S_N2,cph=62.6] O2_1S + N2 -> O2_1D + N2 ; 1.8e-15, 45 +[O2_1S_O,cph=62.6] O2_1S + O -> O2_1D + O ; 8e-14 +[O2_1S_O2,cph=62.6] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17 +[O2_1S_O3,cph=62.6] O2_1S + O3 -> O2_1D + O3 ; 3.5e-11, -135 +[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 +[N2D_O,cph=229.61] N2D + O -> N + O ; 7e-13 +[N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5e-12 +[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 -> 2*CL + COFCL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 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 +********************************* +*** odd-fluorine +********************************* +[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 +[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 +[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 +[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 +[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 +[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 +********************************* +*** 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, -1110 +[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 + COFCL ; 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 + COFCL ; 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_HO2] CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750 +[CH3O2_NO] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300 +[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 +********************************* +*** 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 +********************************* +[usr_HO2_aer] HO2 -> 0.5*H2O2 +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 +[usr_NO3_aer] NO3 -> HNO3 +********************************* +*** 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 +********************************* +*** Ions +********************************* +[ag247nm,cph=483.39] Op2P -> Op ; 0.047 +[ag373nm,cph=321.3] Op2D -> Op ; 7.7e-05 +[ag732nm,cph=163.06] Op2P -> Op2D ; 0.171 +[elec1,cph=82.389] NOp + e -> 0.2*N + 0.8*N2D + O +[elec2,cph=508.95] O2p + e -> 1.15*O + 0.85*O1D +[elec3,cph=354.83] N2p + e -> 1.1*N + 0.9*N2D +[ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6e-11 +[ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D +[ion_N2p_Ob] N2p + O -> Op + N2 +[ion_Np_O,cph=95.55] Np + O -> Op + N ; 1e-12 +[ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4e-10 +[ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2e-10 +[ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1e-10 +[ion_O2p_N2] O2p + N2 -> NOp + NO ; 5e-16 +[ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 +[ion_Op_CO2] Op + CO2 -> O2p + CO ; 9e-10 +[ion_Op_N2,cph=105.04] Op + N2 -> NOp + N +[ion_Op_N2D,cph=139.9] Op + N2D -> Np + O ; 1.3e-10 +[ion_Op_O2,cph=150.11] Op + O2 -> O2p + O +[Op2D_e,cph=319.37] Op2D + e -> Op + e +[Op2D_N2,cph=128.32] Op2D + N2 -> N2p + O ; 8e-10 +[Op2D_O,cph=319.36] Op2D + O -> Op + O ; 5e-12 +[Op2D_O2,cph=469.4] Op2D + O2 -> O2p + O ; 7e-10 +[Op2P_ea,cph=163.06] Op2P + e -> Op2D + e +[Op2P_eb,cph=482.43] Op2P + e -> Op + e +[Op2P_N2a,cph=291.38] Op2P + N2 -> N2p + O ; 4.8e-10 +[Op2P_N2b,cph=67.54] Op2P + N2 -> Np + NO ; 1e-10 +[Op2P_O,cph=501.72] Op2P + O -> Op + O ; 4e-10 + End Reactions + + Ext Forcing + so4_a2 <- dataset + DMS <- dataset + NO2 <- dataset + SO2 <- dataset + bc_a1 <- dataset + bc_a4 <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset + num_a5 <- dataset + pom_a1 <- dataset + pom_a4 <- dataset + so4_a1 <- dataset + so4_a5 <- dataset + CO <- dataset + NO <- dataset + N + N2D + N2p + OH + Op + e + Np + O + O2p + 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_waccm_mad_mam5/chem_mods.F90 b/src/chemistry/pp_waccm_mad_mam5/chem_mods.F90 new file mode 100644 index 0000000000..6ec70347a1 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/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 = 104, & ! number of photolysis reactions + rxntot = 606, & ! number of total reactions + gascnt = 502, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 139, & ! number of "gas phase" species + nfs = 2, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 2090, & ! number of non-zero matrix entries + extcnt = 25, & ! number of species with external forcing + clscnt1 = 0, & ! 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 = 606, & + enthalpy_cnt = 54, & + nslvd = 49 + 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_waccm_mad_mam5/m_rxt_id.F90 b/src/chemistry/pp_waccm_mad_mam5/m_rxt_id.F90 new file mode 100644 index 0000000000..b0906a4849 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/m_rxt_id.F90 @@ -0,0 +1,609 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o_b = 1 + integer, parameter :: rid_jh2o_c = 2 + integer, parameter :: rid_jh2o_a = 3 + integer, parameter :: rid_jh2o2 = 4 + integer, parameter :: rid_jo2_b = 5 + integer, parameter :: rid_jo2_a = 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_jhono = 12 + integer, parameter :: rid_jn2o = 13 + integer, parameter :: rid_jn2o5_a = 14 + integer, parameter :: rid_jn2o5_b = 15 + integer, parameter :: rid_jno_i = 16 + integer, parameter :: rid_jno = 17 + integer, parameter :: rid_jno2 = 18 + integer, parameter :: rid_jno3_a = 19 + integer, parameter :: rid_jno3_b = 20 + integer, parameter :: rid_jch2o_a = 21 + integer, parameter :: rid_jch2o_b = 22 + integer, parameter :: rid_jch3ooh = 23 + integer, parameter :: rid_jch4_a = 24 + integer, parameter :: rid_jch4_b = 25 + integer, parameter :: rid_jco2 = 26 + integer, parameter :: rid_jbrcl = 27 + integer, parameter :: rid_jbro = 28 + integer, parameter :: rid_jbrono2_b = 29 + integer, parameter :: rid_jbrono2_a = 30 + integer, parameter :: rid_jccl4 = 31 + integer, parameter :: rid_jcf2clbr = 32 + integer, parameter :: rid_jcf3br = 33 + integer, parameter :: rid_jcfcl3 = 34 + integer, parameter :: rid_jcfc113 = 35 + integer, parameter :: rid_jcfc114 = 36 + integer, parameter :: rid_jcfc115 = 37 + integer, parameter :: rid_jcf2cl2 = 38 + integer, parameter :: rid_jch2br2 = 39 + integer, parameter :: rid_jch3br = 40 + integer, parameter :: rid_jch3ccl3 = 41 + integer, parameter :: rid_jch3cl = 42 + integer, parameter :: rid_jchbr3 = 43 + integer, parameter :: rid_jcl2 = 44 + integer, parameter :: rid_jcl2o2 = 45 + integer, parameter :: rid_jclo = 46 + integer, parameter :: rid_jclono2_a = 47 + integer, parameter :: rid_jclono2_b = 48 + integer, parameter :: rid_jcof2 = 49 + integer, parameter :: rid_jcofcl = 50 + integer, parameter :: rid_jh2402 = 51 + integer, parameter :: rid_jhbr = 52 + integer, parameter :: rid_jhcfc141b = 53 + integer, parameter :: rid_jhcfc142b = 54 + integer, parameter :: rid_jhcfc22 = 55 + integer, parameter :: rid_jhcl = 56 + integer, parameter :: rid_jhf = 57 + integer, parameter :: rid_jhobr = 58 + integer, parameter :: rid_jhocl = 59 + integer, parameter :: rid_joclo = 60 + integer, parameter :: rid_jsf6 = 61 + integer, parameter :: rid_jeuv_26 = 62 + integer, parameter :: rid_jpni3 = 63 + integer, parameter :: rid_jpni5 = 64 + integer, parameter :: rid_jpni4 = 65 + integer, parameter :: rid_jeuv_4 = 66 + integer, parameter :: rid_jeuv_18 = 67 + integer, parameter :: rid_jeuv_11 = 68 + integer, parameter :: rid_jeuv_10 = 69 + integer, parameter :: rid_jeuv_22 = 70 + integer, parameter :: rid_jeuv_23 = 71 + integer, parameter :: rid_jeuv_25 = 72 + integer, parameter :: rid_jeuv_13 = 73 + integer, parameter :: rid_jeuv_6 = 74 + integer, parameter :: rid_jepn6 = 75 + integer, parameter :: rid_jepn7 = 76 + integer, parameter :: rid_jeuv_1 = 77 + integer, parameter :: rid_jeuv_2 = 78 + integer, parameter :: rid_jeuv_16 = 79 + integer, parameter :: rid_jeuv_3 = 80 + integer, parameter :: rid_jeuv_14 = 81 + integer, parameter :: rid_jeuv_15 = 82 + integer, parameter :: rid_jeuv_8 = 83 + integer, parameter :: rid_jeuv_17 = 84 + integer, parameter :: rid_jeuv_7 = 85 + integer, parameter :: rid_jeuv_5 = 86 + integer, parameter :: rid_jeuv_19 = 87 + integer, parameter :: rid_jeuv_24 = 88 + integer, parameter :: rid_jeuv_12 = 89 + integer, parameter :: rid_jeuv_21 = 90 + integer, parameter :: rid_jeuv_9 = 91 + integer, parameter :: rid_jeuv_20 = 92 + integer, parameter :: rid_jepn2 = 93 + integer, parameter :: rid_jppi = 94 + integer, parameter :: rid_jpni1 = 95 + integer, parameter :: rid_jepn3 = 96 + integer, parameter :: rid_jpni2 = 97 + integer, parameter :: rid_jepn4 = 98 + integer, parameter :: rid_jepn1 = 99 + integer, parameter :: rid_jh2so4 = 100 + integer, parameter :: rid_jocs = 101 + integer, parameter :: rid_jso = 102 + integer, parameter :: rid_jso2 = 103 + integer, parameter :: rid_jso3 = 104 + integer, parameter :: rid_CLm_H = 105 + integer, parameter :: rid_CLmH2O_HCL = 106 + integer, parameter :: rid_CLm_H2O_Ma = 107 + integer, parameter :: rid_CLmHCL_M = 108 + integer, parameter :: rid_CLm_HNO3 = 109 + integer, parameter :: rid_CLm_NO2 = 110 + integer, parameter :: rid_CLOm_NOa = 111 + integer, parameter :: rid_CLOm_NOb = 112 + integer, parameter :: rid_CLOm_O = 113 + integer, parameter :: rid_CO3m_CLa = 114 + integer, parameter :: rid_CO3m_CLb = 115 + integer, parameter :: rid_CO3m_CLO = 116 + integer, parameter :: rid_CO3m_H = 117 + integer, parameter :: rid_CO3mH2O_H2O_M = 118 + integer, parameter :: rid_CO3m_H2O_M = 119 + integer, parameter :: rid_CO3mH2O_NO2a = 120 + integer, parameter :: rid_CO3mH2O_NO2b = 121 + integer, parameter :: rid_CO3mH2O_NOa = 122 + integer, parameter :: rid_CO3mH2O_NOb = 123 + integer, parameter :: rid_CO3m_HNO3 = 124 + integer, parameter :: rid_CO3m_O = 125 + integer, parameter :: rid_CO3m_O2 = 126 + integer, parameter :: rid_CO4m_CL = 127 + integer, parameter :: rid_CO4m_CLO = 128 + integer, parameter :: rid_CO4m_H = 129 + integer, parameter :: rid_CO4m_HCL = 130 + integer, parameter :: rid_CO4m_O = 131 + integer, parameter :: rid_CO4m_O3 = 132 + integer, parameter :: rid_ean1 = 133 + integer, parameter :: rid_ean2 = 134 + integer, parameter :: rid_ean3 = 135 + integer, parameter :: rid_edn1 = 136 + integer, parameter :: rid_edn2 = 137 + integer, parameter :: rid_H3OpOH_e = 138 + integer, parameter :: rid_H3OpOH_H2O = 139 + integer, parameter :: rid_Hp3N1_H2O = 140 + integer, parameter :: rid_Hp4H2O_e = 141 + integer, parameter :: rid_Hp4H2O_N2O5 = 142 + integer, parameter :: rid_Hp4N1_H2O = 143 + integer, parameter :: rid_Hp5H2O_e = 144 + integer, parameter :: rid_Hp5H2O_N2O5 = 145 + integer, parameter :: rid_iira1 = 146 + integer, parameter :: rid_iira10 = 147 + integer, parameter :: rid_iira100 = 148 + integer, parameter :: rid_iira101 = 149 + integer, parameter :: rid_iira102 = 150 + integer, parameter :: rid_iira103 = 151 + integer, parameter :: rid_iira104 = 152 + integer, parameter :: rid_iira105 = 153 + integer, parameter :: rid_iira106 = 154 + integer, parameter :: rid_iira107 = 155 + integer, parameter :: rid_iira108 = 156 + integer, parameter :: rid_iira109 = 157 + integer, parameter :: rid_iira11 = 158 + integer, parameter :: rid_iira110 = 159 + integer, parameter :: rid_iira111 = 160 + integer, parameter :: rid_iira112 = 161 + integer, parameter :: rid_iira12 = 162 + integer, parameter :: rid_iira13 = 163 + integer, parameter :: rid_iira14 = 164 + integer, parameter :: rid_iira15 = 165 + integer, parameter :: rid_iira16 = 166 + integer, parameter :: rid_iira17 = 167 + integer, parameter :: rid_iira18 = 168 + integer, parameter :: rid_iira19 = 169 + integer, parameter :: rid_iira2 = 170 + integer, parameter :: rid_iira20 = 171 + integer, parameter :: rid_iira21 = 172 + integer, parameter :: rid_iira22 = 173 + integer, parameter :: rid_iira23 = 174 + integer, parameter :: rid_iira24 = 175 + integer, parameter :: rid_iira25 = 176 + integer, parameter :: rid_iira26 = 177 + integer, parameter :: rid_iira27 = 178 + integer, parameter :: rid_iira28 = 179 + integer, parameter :: rid_iira29 = 180 + integer, parameter :: rid_iira3 = 181 + integer, parameter :: rid_iira30 = 182 + integer, parameter :: rid_iira31 = 183 + integer, parameter :: rid_iira32 = 184 + integer, parameter :: rid_iira33 = 185 + integer, parameter :: rid_iira34 = 186 + integer, parameter :: rid_iira35 = 187 + integer, parameter :: rid_iira36 = 188 + integer, parameter :: rid_iira37 = 189 + integer, parameter :: rid_iira38 = 190 + integer, parameter :: rid_iira39 = 191 + integer, parameter :: rid_iira4 = 192 + integer, parameter :: rid_iira40 = 193 + integer, parameter :: rid_iira41 = 194 + integer, parameter :: rid_iira42 = 195 + integer, parameter :: rid_iira43 = 196 + integer, parameter :: rid_iira44 = 197 + integer, parameter :: rid_iira45 = 198 + integer, parameter :: rid_iira46 = 199 + integer, parameter :: rid_iira47 = 200 + integer, parameter :: rid_iira48 = 201 + integer, parameter :: rid_iira49 = 202 + integer, parameter :: rid_iira5 = 203 + integer, parameter :: rid_iira50 = 204 + integer, parameter :: rid_iira51 = 205 + integer, parameter :: rid_iira52 = 206 + integer, parameter :: rid_iira53 = 207 + integer, parameter :: rid_iira54 = 208 + integer, parameter :: rid_iira55 = 209 + integer, parameter :: rid_iira56 = 210 + integer, parameter :: rid_iira57 = 211 + integer, parameter :: rid_iira58 = 212 + integer, parameter :: rid_iira59 = 213 + integer, parameter :: rid_iira6 = 214 + integer, parameter :: rid_iira60 = 215 + integer, parameter :: rid_iira61 = 216 + integer, parameter :: rid_iira62 = 217 + integer, parameter :: rid_iira63 = 218 + integer, parameter :: rid_iira64 = 219 + integer, parameter :: rid_iira65 = 220 + integer, parameter :: rid_iira66 = 221 + integer, parameter :: rid_iira67 = 222 + integer, parameter :: rid_iira68 = 223 + integer, parameter :: rid_iira69 = 224 + integer, parameter :: rid_iira7 = 225 + integer, parameter :: rid_iira70 = 226 + integer, parameter :: rid_iira71 = 227 + integer, parameter :: rid_iira72 = 228 + integer, parameter :: rid_iira73 = 229 + integer, parameter :: rid_iira74 = 230 + integer, parameter :: rid_iira75 = 231 + integer, parameter :: rid_iira76 = 232 + integer, parameter :: rid_iira77 = 233 + integer, parameter :: rid_iira78 = 234 + integer, parameter :: rid_iira79 = 235 + integer, parameter :: rid_iira8 = 236 + integer, parameter :: rid_iira80 = 237 + integer, parameter :: rid_iira81 = 238 + integer, parameter :: rid_iira82 = 239 + integer, parameter :: rid_iira83 = 240 + integer, parameter :: rid_iira84 = 241 + integer, parameter :: rid_iira85 = 242 + integer, parameter :: rid_iira86 = 243 + integer, parameter :: rid_iira87 = 244 + integer, parameter :: rid_iira88 = 245 + integer, parameter :: rid_iira89 = 246 + integer, parameter :: rid_iira9 = 247 + integer, parameter :: rid_iira90 = 248 + integer, parameter :: rid_iira91 = 249 + integer, parameter :: rid_iira92 = 250 + integer, parameter :: rid_iira93 = 251 + integer, parameter :: rid_iira94 = 252 + integer, parameter :: rid_iira95 = 253 + integer, parameter :: rid_iira96 = 254 + integer, parameter :: rid_iira97 = 255 + integer, parameter :: rid_iira98 = 256 + integer, parameter :: rid_iira99 = 257 + integer, parameter :: rid_iirb1 = 258 + integer, parameter :: rid_iirb10 = 259 + integer, parameter :: rid_iirb11 = 260 + integer, parameter :: rid_iirb12 = 261 + integer, parameter :: rid_iirb13 = 262 + integer, parameter :: rid_iirb14 = 263 + integer, parameter :: rid_iirb2 = 264 + integer, parameter :: rid_iirb3 = 265 + integer, parameter :: rid_iirb4 = 266 + integer, parameter :: rid_iirb5 = 267 + integer, parameter :: rid_iirb6 = 268 + integer, parameter :: rid_iirb7 = 269 + integer, parameter :: rid_iirb8 = 270 + integer, parameter :: rid_iirb9 = 271 + integer, parameter :: rid_nir1 = 272 + integer, parameter :: rid_nir10 = 273 + integer, parameter :: rid_nir11 = 274 + integer, parameter :: rid_nir12 = 275 + integer, parameter :: rid_nir13 = 276 + integer, parameter :: rid_nir2 = 277 + integer, parameter :: rid_nir3 = 278 + integer, parameter :: rid_nir4 = 279 + integer, parameter :: rid_nir5 = 280 + integer, parameter :: rid_nir6 = 281 + integer, parameter :: rid_nir7 = 282 + integer, parameter :: rid_nir8 = 283 + integer, parameter :: rid_nir9 = 284 + integer, parameter :: rid_NO2m_CL = 285 + integer, parameter :: rid_NO2m_CLO = 286 + integer, parameter :: rid_NO2m_H = 287 + integer, parameter :: rid_NO2m_H2O_M = 288 + integer, parameter :: rid_NO2m_HCL = 289 + integer, parameter :: rid_NO2m_HNO3 = 290 + integer, parameter :: rid_NO2m_NO2 = 291 + integer, parameter :: rid_NO2m_O3 = 292 + integer, parameter :: rid_NO3m2H2O_N2O5 = 293 + integer, parameter :: rid_NO3mH2O_H2O_M = 294 + integer, parameter :: rid_NO3mH2O_HNO3 = 295 + integer, parameter :: rid_NO3m_H2O_M = 296 + integer, parameter :: rid_NO3mH2O_N2O5 = 297 + integer, parameter :: rid_NO3m_HCLa = 298 + integer, parameter :: rid_NO3mHCL_HNO3 = 299 + integer, parameter :: rid_NO3m_HNO3_M = 300 + integer, parameter :: rid_NO3m_O = 301 + integer, parameter :: rid_NO3m_O3 = 302 + integer, parameter :: rid_NOp2H2O_e = 303 + integer, parameter :: rid_NOp3H2O_e = 304 + integer, parameter :: rid_NOp3H2O_H2O = 305 + integer, parameter :: rid_NOpCO2_e = 306 + integer, parameter :: rid_NOpCO2_H2O = 307 + integer, parameter :: rid_NOpH2O_e = 308 + integer, parameter :: rid_NOpH2O_H = 309 + integer, parameter :: rid_NOpH2O_HO2 = 310 + integer, parameter :: rid_NOpH2O_OH = 311 + integer, parameter :: rid_NOpN2_CO2 = 312 + integer, parameter :: rid_NOpN2_H2O = 313 + integer, parameter :: rid_O2m_CL = 314 + integer, parameter :: rid_O2m_CLO = 315 + integer, parameter :: rid_O2m_CO2_M = 316 + integer, parameter :: rid_O2m_H = 317 + integer, parameter :: rid_O2m_HCL = 318 + integer, parameter :: rid_O2m_HNO3 = 319 + integer, parameter :: rid_O2m_NO2 = 320 + integer, parameter :: rid_O2m_O21D = 321 + integer, parameter :: rid_O2m_O2_M = 322 + integer, parameter :: rid_O2m_O3 = 323 + integer, parameter :: rid_O2m_O_a = 324 + integer, parameter :: rid_O2m_O_b = 325 + integer, parameter :: rid_O2pH2O_e = 326 + integer, parameter :: rid_O2pH2O_H2Oa = 327 + integer, parameter :: rid_O2pH2O_H2Ob = 328 + integer, parameter :: rid_O2p_H2O_M = 329 + integer, parameter :: rid_O3m_CO2 = 330 + integer, parameter :: rid_O3m_H = 331 + integer, parameter :: rid_O3m_O3 = 332 + integer, parameter :: rid_O3m_O_a = 333 + integer, parameter :: rid_O3m_O_b = 334 + integer, parameter :: rid_O4m_CO2 = 335 + integer, parameter :: rid_O4m_O = 336 + integer, parameter :: rid_O4p_H2O = 337 + integer, parameter :: rid_O4p_O = 338 + integer, parameter :: rid_O4p_O21D = 339 + integer, parameter :: rid_OH_HONO = 340 + integer, parameter :: rid_OHm_CL = 341 + integer, parameter :: rid_OHm_CLO = 342 + integer, parameter :: rid_OHm_CO2 = 343 + integer, parameter :: rid_OHm_H = 344 + integer, parameter :: rid_OHm_HCL = 345 + integer, parameter :: rid_OHm_NO2 = 346 + integer, parameter :: rid_OHm_O = 347 + integer, parameter :: rid_OHm_O3 = 348 + integer, parameter :: rid_OH_NO_M = 349 + integer, parameter :: rid_Om_CL = 350 + integer, parameter :: rid_Om_CLO = 351 + integer, parameter :: rid_Om_CO2_M = 352 + integer, parameter :: rid_Om_H2_a = 353 + integer, parameter :: rid_Om_H2_b = 354 + integer, parameter :: rid_Om_H2O = 355 + integer, parameter :: rid_Om_HCL = 356 + integer, parameter :: rid_Om_HNO3 = 357 + integer, parameter :: rid_Om_M = 358 + integer, parameter :: rid_Om_NO2 = 359 + integer, parameter :: rid_Om_O = 360 + integer, parameter :: rid_Om_O21D = 361 + integer, parameter :: rid_Om_O2_M = 362 + integer, parameter :: rid_Om_O3 = 363 + integer, parameter :: rid_pir1 = 364 + integer, parameter :: rid_pir10 = 365 + integer, parameter :: rid_pir11 = 366 + integer, parameter :: rid_pir12 = 367 + integer, parameter :: rid_pir13 = 368 + integer, parameter :: rid_pir14 = 369 + integer, parameter :: rid_pir15 = 370 + integer, parameter :: rid_pir16 = 371 + integer, parameter :: rid_pir2 = 372 + integer, parameter :: rid_pir3 = 373 + integer, parameter :: rid_pir4 = 374 + integer, parameter :: rid_pir5 = 375 + integer, parameter :: rid_pir6 = 376 + integer, parameter :: rid_pir7 = 377 + integer, parameter :: rid_pir8 = 378 + integer, parameter :: rid_pir9 = 379 + integer, parameter :: rid_rpe1 = 380 + integer, parameter :: rid_rpe2 = 381 + integer, parameter :: rid_rpe3 = 382 + integer, parameter :: rid_rpe4 = 383 + integer, parameter :: rid_rpe5 = 384 + integer, parameter :: rid_usr_CLm_H2O_M = 385 + integer, parameter :: rid_usr_CLm_HCL_M = 386 + integer, parameter :: rid_ag1 = 387 + integer, parameter :: rid_ag2 = 388 + integer, parameter :: rid_O1D_H2 = 389 + integer, parameter :: rid_O1D_H2O = 390 + integer, parameter :: rid_O1D_N2 = 391 + integer, parameter :: rid_O1D_O2 = 392 + integer, parameter :: rid_O1D_O2b = 393 + integer, parameter :: rid_O1D_O3 = 394 + integer, parameter :: rid_O2_1D_N2 = 395 + integer, parameter :: rid_O2_1D_O = 396 + integer, parameter :: rid_O2_1D_O2 = 397 + integer, parameter :: rid_O2_1S_CO2 = 398 + integer, parameter :: rid_O2_1S_N2 = 399 + integer, parameter :: rid_O2_1S_O = 400 + integer, parameter :: rid_O2_1S_O2 = 401 + integer, parameter :: rid_O2_1S_O3 = 402 + integer, parameter :: rid_O_O3 = 403 + integer, parameter :: rid_usr_O_O = 404 + integer, parameter :: rid_usr_O_O2 = 405 + integer, parameter :: rid_H2_O = 406 + integer, parameter :: rid_H2O2_O = 407 + integer, parameter :: rid_H_HO2 = 408 + integer, parameter :: rid_H_HO2a = 409 + integer, parameter :: rid_H_HO2b = 410 + integer, parameter :: rid_H_O2 = 411 + integer, parameter :: rid_HO2_O = 412 + integer, parameter :: rid_HO2_O3 = 413 + integer, parameter :: rid_H_O3 = 414 + integer, parameter :: rid_OH_H2 = 415 + integer, parameter :: rid_OH_H2O2 = 416 + integer, parameter :: rid_OH_HO2 = 417 + integer, parameter :: rid_OH_O = 418 + integer, parameter :: rid_OH_O3 = 419 + integer, parameter :: rid_OH_OH = 420 + integer, parameter :: rid_OH_OH_M = 421 + integer, parameter :: rid_usr_HO2_HO2 = 422 + integer, parameter :: rid_HO2NO2_OH = 423 + integer, parameter :: rid_N2D_O = 424 + integer, parameter :: rid_N2D_O2 = 425 + integer, parameter :: rid_N_NO = 426 + integer, parameter :: rid_N_NO2a = 427 + integer, parameter :: rid_N_NO2b = 428 + integer, parameter :: rid_N_NO2c = 429 + integer, parameter :: rid_N_O2 = 430 + integer, parameter :: rid_NO2_O = 431 + integer, parameter :: rid_NO2_O3 = 432 + integer, parameter :: rid_NO2_O_M = 433 + integer, parameter :: rid_NO3_HO2 = 434 + integer, parameter :: rid_NO3_NO = 435 + integer, parameter :: rid_NO3_O = 436 + integer, parameter :: rid_NO3_OH = 437 + integer, parameter :: rid_N_OH = 438 + integer, parameter :: rid_NO_HO2 = 439 + integer, parameter :: rid_NO_O3 = 440 + integer, parameter :: rid_NO_O_M = 441 + integer, parameter :: rid_O1D_N2Oa = 442 + integer, parameter :: rid_O1D_N2Ob = 443 + integer, parameter :: rid_tag_NO2_HO2 = 444 + integer, parameter :: rid_tag_NO2_NO3 = 445 + integer, parameter :: rid_tag_NO2_OH = 446 + integer, parameter :: rid_usr_HNO3_OH = 447 + integer, parameter :: rid_usr_HO2NO2_M = 448 + integer, parameter :: rid_usr_N2O5_M = 449 + integer, parameter :: rid_CL_CH2O = 450 + integer, parameter :: rid_CL_CH4 = 451 + integer, parameter :: rid_CL_H2 = 452 + integer, parameter :: rid_CL_H2O2 = 453 + integer, parameter :: rid_CL_HO2a = 454 + integer, parameter :: rid_CL_HO2b = 455 + integer, parameter :: rid_CL_O3 = 456 + integer, parameter :: rid_CLO_CH3O2 = 457 + integer, parameter :: rid_CLO_CLOa = 458 + integer, parameter :: rid_CLO_CLOb = 459 + integer, parameter :: rid_CLO_CLOc = 460 + integer, parameter :: rid_CLO_HO2 = 461 + integer, parameter :: rid_CLO_NO = 462 + integer, parameter :: rid_CLONO2_CL = 463 + integer, parameter :: rid_CLO_NO2_M = 464 + integer, parameter :: rid_CLONO2_O = 465 + integer, parameter :: rid_CLONO2_OH = 466 + integer, parameter :: rid_CLO_O = 467 + integer, parameter :: rid_CLO_OHa = 468 + integer, parameter :: rid_CLO_OHb = 469 + integer, parameter :: rid_HCL_O = 470 + integer, parameter :: rid_HCL_OH = 471 + integer, parameter :: rid_HOCL_CL = 472 + integer, parameter :: rid_HOCL_O = 473 + integer, parameter :: rid_HOCL_OH = 474 + integer, parameter :: rid_O1D_CCL4 = 475 + integer, parameter :: rid_O1D_CF2CLBR = 476 + integer, parameter :: rid_O1D_CFC11 = 477 + integer, parameter :: rid_O1D_CFC113 = 478 + integer, parameter :: rid_O1D_CFC114 = 479 + integer, parameter :: rid_O1D_CFC115 = 480 + integer, parameter :: rid_O1D_CFC12 = 481 + integer, parameter :: rid_O1D_HCLa = 482 + integer, parameter :: rid_O1D_HCLb = 483 + integer, parameter :: rid_tag_CLO_CLO_M = 484 + integer, parameter :: rid_usr_CL2O2_M = 485 + integer, parameter :: rid_BR_CH2O = 486 + integer, parameter :: rid_BR_HO2 = 487 + integer, parameter :: rid_BR_O3 = 488 + integer, parameter :: rid_BRO_BRO = 489 + integer, parameter :: rid_BRO_CLOa = 490 + integer, parameter :: rid_BRO_CLOb = 491 + integer, parameter :: rid_BRO_CLOc = 492 + integer, parameter :: rid_BRO_HO2 = 493 + integer, parameter :: rid_BRO_NO = 494 + integer, parameter :: rid_BRO_NO2_M = 495 + integer, parameter :: rid_BRONO2_O = 496 + integer, parameter :: rid_BRO_O = 497 + integer, parameter :: rid_BRO_OH = 498 + integer, parameter :: rid_HBR_O = 499 + integer, parameter :: rid_HBR_OH = 500 + integer, parameter :: rid_HOBR_O = 501 + integer, parameter :: rid_O1D_CF3BR = 502 + integer, parameter :: rid_O1D_CHBR3 = 503 + integer, parameter :: rid_O1D_H2402 = 504 + integer, parameter :: rid_O1D_HBRa = 505 + integer, parameter :: rid_O1D_HBRb = 506 + integer, parameter :: rid_F_CH4 = 507 + integer, parameter :: rid_F_H2 = 508 + integer, parameter :: rid_F_H2O = 509 + integer, parameter :: rid_F_HNO3 = 510 + integer, parameter :: rid_O1D_COF2 = 511 + integer, parameter :: rid_O1D_COFCL = 512 + integer, parameter :: rid_CH2BR2_CL = 513 + integer, parameter :: rid_CH2BR2_OH = 514 + integer, parameter :: rid_CH3BR_CL = 515 + integer, parameter :: rid_CH3BR_OH = 516 + integer, parameter :: rid_CH3CCL3_OH = 517 + integer, parameter :: rid_CH3CL_CL = 518 + integer, parameter :: rid_CH3CL_OH = 519 + integer, parameter :: rid_CHBR3_CL = 520 + integer, parameter :: rid_CHBR3_OH = 521 + integer, parameter :: rid_HCFC141B_OH = 522 + integer, parameter :: rid_HCFC142B_OH = 523 + integer, parameter :: rid_HCFC22_OH = 524 + integer, parameter :: rid_O1D_CH2BR2 = 525 + integer, parameter :: rid_O1D_CH3BR = 526 + integer, parameter :: rid_O1D_HCFC141B = 527 + integer, parameter :: rid_O1D_HCFC142B = 528 + integer, parameter :: rid_O1D_HCFC22 = 529 + integer, parameter :: rid_CH2O_NO3 = 530 + integer, parameter :: rid_CH2O_O = 531 + integer, parameter :: rid_CH2O_OH = 532 + integer, parameter :: rid_CH3O2_HO2 = 533 + integer, parameter :: rid_CH3O2_NO = 534 + integer, parameter :: rid_CH3OOH_OH = 535 + integer, parameter :: rid_CH4_OH = 536 + integer, parameter :: rid_O1D_CH4a = 537 + integer, parameter :: rid_O1D_CH4b = 538 + integer, parameter :: rid_O1D_CH4c = 539 + integer, parameter :: rid_usr_CO_OH = 540 + integer, parameter :: rid_DMS_NO3 = 541 + integer, parameter :: rid_DMS_OHa = 542 + integer, parameter :: rid_OCS_O = 543 + integer, parameter :: rid_OCS_OH = 544 + integer, parameter :: rid_S_O2 = 545 + integer, parameter :: rid_SO2_OH_M = 546 + integer, parameter :: rid_S_O3 = 547 + integer, parameter :: rid_SO_BRO = 548 + integer, parameter :: rid_SO_CLO = 549 + integer, parameter :: rid_S_OH = 550 + integer, parameter :: rid_SO_NO2 = 551 + integer, parameter :: rid_SO_O2 = 552 + integer, parameter :: rid_SO_O3 = 553 + integer, parameter :: rid_SO_OCLO = 554 + integer, parameter :: rid_SO_OH = 555 + integer, parameter :: rid_usr_DMS_OH = 556 + integer, parameter :: rid_usr_SO3_H2O = 557 + integer, parameter :: rid_usr_HO2_aer = 558 + integer, parameter :: rid_usr_N2O5_aer = 559 + integer, parameter :: rid_usr_NO2_aer = 560 + integer, parameter :: rid_usr_NO3_aer = 561 + integer, parameter :: rid_het1 = 562 + integer, parameter :: rid_het10 = 563 + integer, parameter :: rid_het11 = 564 + integer, parameter :: rid_het12 = 565 + integer, parameter :: rid_het13 = 566 + integer, parameter :: rid_het14 = 567 + integer, parameter :: rid_het15 = 568 + integer, parameter :: rid_het16 = 569 + integer, parameter :: rid_het17 = 570 + integer, parameter :: rid_het2 = 571 + integer, parameter :: rid_het3 = 572 + integer, parameter :: rid_het4 = 573 + integer, parameter :: rid_het5 = 574 + integer, parameter :: rid_het6 = 575 + integer, parameter :: rid_het7 = 576 + integer, parameter :: rid_het8 = 577 + integer, parameter :: rid_het9 = 578 + integer, parameter :: rid_ag247nm = 579 + integer, parameter :: rid_ag373nm = 580 + integer, parameter :: rid_ag732nm = 581 + integer, parameter :: rid_elec1 = 582 + integer, parameter :: rid_elec2 = 583 + integer, parameter :: rid_elec3 = 584 + integer, parameter :: rid_ion_N2p_O2 = 585 + integer, parameter :: rid_ion_N2p_Oa = 586 + integer, parameter :: rid_ion_N2p_Ob = 587 + integer, parameter :: rid_ion_Np_O = 588 + integer, parameter :: rid_ion_Np_O2a = 589 + integer, parameter :: rid_ion_Np_O2b = 590 + integer, parameter :: rid_ion_O2p_N = 591 + integer, parameter :: rid_ion_O2p_N2 = 592 + integer, parameter :: rid_ion_O2p_NO = 593 + integer, parameter :: rid_ion_Op_CO2 = 594 + integer, parameter :: rid_ion_Op_N2 = 595 + integer, parameter :: rid_ion_Op_N2D = 596 + integer, parameter :: rid_ion_Op_O2 = 597 + integer, parameter :: rid_Op2D_e = 598 + integer, parameter :: rid_Op2D_N2 = 599 + integer, parameter :: rid_Op2D_O = 600 + integer, parameter :: rid_Op2D_O2 = 601 + integer, parameter :: rid_Op2P_ea = 602 + integer, parameter :: rid_Op2P_eb = 603 + integer, parameter :: rid_Op2P_N2a = 604 + integer, parameter :: rid_Op2P_N2b = 605 + integer, parameter :: rid_Op2P_O = 606 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_mad_mam5/m_spc_id.F90 b/src/chemistry/pp_waccm_mad_mam5/m_spc_id.F90 new file mode 100644 index 0000000000..e35e20000b --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/m_spc_id.F90 @@ -0,0 +1,142 @@ + module m_spc_id + implicit none + integer, parameter :: id_bc_a1 = 1 + integer, parameter :: id_bc_a4 = 2 + integer, parameter :: id_BR = 3 + integer, parameter :: id_BRCL = 4 + integer, parameter :: id_BRO = 5 + integer, parameter :: id_BRONO2 = 6 + integer, parameter :: id_BRY = 7 + integer, parameter :: id_CCL4 = 8 + integer, parameter :: id_CF2CLBR = 9 + integer, parameter :: id_CF3BR = 10 + integer, parameter :: id_CFC11 = 11 + integer, parameter :: id_CFC113 = 12 + integer, parameter :: id_CFC114 = 13 + integer, parameter :: id_CFC115 = 14 + integer, parameter :: id_CFC12 = 15 + integer, parameter :: id_CH2BR2 = 16 + integer, parameter :: id_CH2O = 17 + integer, parameter :: id_CH3BR = 18 + integer, parameter :: id_CH3CCL3 = 19 + integer, parameter :: id_CH3CL = 20 + integer, parameter :: id_CH3O2 = 21 + integer, parameter :: id_CH3OOH = 22 + integer, parameter :: id_CH4 = 23 + integer, parameter :: id_CHBR3 = 24 + integer, parameter :: id_CL = 25 + integer, parameter :: id_CL2 = 26 + integer, parameter :: id_CL2O2 = 27 + integer, parameter :: id_CLO = 28 + integer, parameter :: id_CLONO2 = 29 + integer, parameter :: id_CLY = 30 + integer, parameter :: id_CO = 31 + integer, parameter :: id_CO2 = 32 + integer, parameter :: id_COF2 = 33 + integer, parameter :: id_COFCL = 34 + integer, parameter :: id_DMS = 35 + integer, parameter :: id_dst_a1 = 36 + integer, parameter :: id_dst_a2 = 37 + integer, parameter :: id_dst_a3 = 38 + integer, parameter :: id_F = 39 + integer, parameter :: id_H = 40 + integer, parameter :: id_H2 = 41 + integer, parameter :: id_H2402 = 42 + integer, parameter :: id_H2O2 = 43 + integer, parameter :: id_H2SO4 = 44 + integer, parameter :: id_HBR = 45 + integer, parameter :: id_HCFC141B = 46 + integer, parameter :: id_HCFC142B = 47 + integer, parameter :: id_HCFC22 = 48 + integer, parameter :: id_HCL = 49 + integer, parameter :: id_HF = 50 + integer, parameter :: id_HNO3 = 51 + integer, parameter :: id_HO2NO2 = 52 + integer, parameter :: id_HOBR = 53 + integer, parameter :: id_HOCL = 54 + integer, parameter :: id_HONO = 55 + integer, parameter :: id_N = 56 + integer, parameter :: id_N2O = 57 + integer, parameter :: id_N2O5 = 58 + integer, parameter :: id_ncl_a1 = 59 + integer, parameter :: id_ncl_a2 = 60 + integer, parameter :: id_ncl_a3 = 61 + integer, parameter :: id_NO = 62 + integer, parameter :: id_NO2 = 63 + integer, parameter :: id_NO3 = 64 + integer, parameter :: id_num_a1 = 65 + integer, parameter :: id_num_a2 = 66 + integer, parameter :: id_num_a3 = 67 + integer, parameter :: id_num_a4 = 68 + integer, parameter :: id_num_a5 = 69 + integer, parameter :: id_O = 70 + integer, parameter :: id_O1D = 71 + integer, parameter :: id_O2 = 72 + integer, parameter :: id_O3 = 73 + integer, parameter :: id_OCLO = 74 + integer, parameter :: id_OCS = 75 + integer, parameter :: id_pom_a1 = 76 + integer, parameter :: id_pom_a4 = 77 + integer, parameter :: id_S = 78 + integer, parameter :: id_SF6 = 79 + integer, parameter :: id_SO = 80 + integer, parameter :: id_SO2 = 81 + integer, parameter :: id_SO3 = 82 + integer, parameter :: id_so4_a1 = 83 + integer, parameter :: id_so4_a2 = 84 + integer, parameter :: id_so4_a3 = 85 + integer, parameter :: id_so4_a5 = 86 + integer, parameter :: id_soa_a1 = 87 + integer, parameter :: id_soa_a2 = 88 + integer, parameter :: id_SOAG = 89 + integer, parameter :: id_CLm = 90 + integer, parameter :: id_CLm_H2O = 91 + integer, parameter :: id_CLm_HCL = 92 + integer, parameter :: id_CLOm = 93 + integer, parameter :: id_CO3m = 94 + integer, parameter :: id_CO3m2H2O = 95 + integer, parameter :: id_CO3m_H2O = 96 + integer, parameter :: id_CO4m = 97 + integer, parameter :: id_e = 98 + integer, parameter :: id_H3Op_OH = 99 + integer, parameter :: id_HCO3m = 100 + integer, parameter :: id_HO2 = 101 + integer, parameter :: id_Hp_2H2O = 102 + integer, parameter :: id_Hp_3H2O = 103 + integer, parameter :: id_Hp_3N1 = 104 + integer, parameter :: id_Hp_4H2O = 105 + integer, parameter :: id_Hp_4N1 = 106 + integer, parameter :: id_Hp_5H2O = 107 + integer, parameter :: id_Hp_H2O = 108 + integer, parameter :: id_N2D = 109 + integer, parameter :: id_N2p = 110 + integer, parameter :: id_NO2m = 111 + integer, parameter :: id_NO2m_H2O = 112 + integer, parameter :: id_NO3m = 113 + integer, parameter :: id_NO3m2H2O = 114 + integer, parameter :: id_NO3m_H2O = 115 + integer, parameter :: id_NO3m_HCL = 116 + integer, parameter :: id_NO3mHNO3 = 117 + integer, parameter :: id_NOp = 118 + integer, parameter :: id_NOp_2H2O = 119 + integer, parameter :: id_NOp_3H2O = 120 + integer, parameter :: id_NOp_CO2 = 121 + integer, parameter :: id_NOp_H2O = 122 + integer, parameter :: id_NOp_N2 = 123 + integer, parameter :: id_Np = 124 + integer, parameter :: id_O2_1D = 125 + integer, parameter :: id_O2_1S = 126 + integer, parameter :: id_O2m = 127 + integer, parameter :: id_O2p = 128 + integer, parameter :: id_O2p_H2O = 129 + integer, parameter :: id_O3m = 130 + integer, parameter :: id_O4m = 131 + integer, parameter :: id_O4p = 132 + integer, parameter :: id_OH = 133 + integer, parameter :: id_OHm = 134 + integer, parameter :: id_Om = 135 + integer, parameter :: id_Op = 136 + integer, parameter :: id_Op2D = 137 + integer, parameter :: id_Op2P = 138 + integer, parameter :: id_H2O = 139 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_mad_mam5/mo_adjrxt.F90 b/src/chemistry/pp_waccm_mad_mam5/mo_adjrxt.F90 new file mode 100644 index 0000000000..4b4f607089 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/mo_adjrxt.F90 @@ -0,0 +1,555 @@ + 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(:,:, 107) = rate(:,:, 107) * inv(:,:, 1) + rate(:,:, 108) = rate(:,:, 108) * inv(:,:, 1) + rate(:,:, 118) = rate(:,:, 118) * inv(:,:, 1) + rate(:,:, 119) = rate(:,:, 119) * inv(:,:, 1) + rate(:,:, 133) = rate(:,:, 133) * inv(:,:, 2) + rate(:,:, 135) = rate(:,:, 135) * inv(:,:, 1) + rate(:,:, 137) = rate(:,:, 137) * inv(:,:, 2) + rate(:,:, 258) = rate(:,:, 258) * inv(:,:, 1) + rate(:,:, 259) = rate(:,:, 259) * inv(:,:, 1) + rate(:,:, 260) = rate(:,:, 260) * inv(:,:, 1) + rate(:,:, 261) = rate(:,:, 261) * inv(:,:, 1) + rate(:,:, 262) = rate(:,:, 262) * inv(:,:, 1) + rate(:,:, 263) = rate(:,:, 263) * inv(:,:, 1) + rate(:,:, 264) = rate(:,:, 264) * inv(:,:, 1) + rate(:,:, 265) = rate(:,:, 265) * inv(:,:, 1) + rate(:,:, 266) = rate(:,:, 266) * inv(:,:, 1) + rate(:,:, 267) = rate(:,:, 267) * inv(:,:, 1) + rate(:,:, 268) = rate(:,:, 268) * inv(:,:, 1) + rate(:,:, 269) = rate(:,:, 269) * inv(:,:, 1) + rate(:,:, 270) = rate(:,:, 270) * inv(:,:, 1) + rate(:,:, 271) = rate(:,:, 271) * inv(:,:, 1) + rate(:,:, 273) = rate(:,:, 273) * inv(:,:, 1) + rate(:,:, 274) = rate(:,:, 274) * inv(:,:, 1) + rate(:,:, 275) = rate(:,:, 275) * inv(:,:, 1) + rate(:,:, 276) = rate(:,:, 276) * inv(:,:, 1) + rate(:,:, 282) = rate(:,:, 282) * inv(:,:, 1) + rate(:,:, 283) = rate(:,:, 283) * inv(:,:, 1) + rate(:,:, 284) = rate(:,:, 284) * inv(:,:, 1) + rate(:,:, 288) = rate(:,:, 288) * inv(:,:, 1) + rate(:,:, 294) = rate(:,:, 294) * inv(:,:, 1) + rate(:,:, 296) = rate(:,:, 296) * inv(:,:, 1) + rate(:,:, 300) = rate(:,:, 300) * inv(:,:, 1) + rate(:,:, 316) = rate(:,:, 316) * inv(:,:, 1) + rate(:,:, 322) = rate(:,:, 322) * inv(:,:, 1) + rate(:,:, 329) = rate(:,:, 329) * inv(:,:, 1) + rate(:,:, 343) = rate(:,:, 343) * inv(:,:, 1) + rate(:,:, 349) = rate(:,:, 349) * inv(:,:, 1) + rate(:,:, 352) = rate(:,:, 352) * inv(:,:, 1) + rate(:,:, 358) = rate(:,:, 358) * inv(:,:, 1) + rate(:,:, 362) = rate(:,:, 362) * inv(:,:, 1) + rate(:,:, 364) = rate(:,:, 364) * inv(:,:, 1) + rate(:,:, 365) = rate(:,:, 365) * inv(:,:, 1) + rate(:,:, 366) = rate(:,:, 366) * inv(:,:, 1) + rate(:,:, 367) = rate(:,:, 367) * inv(:,:, 1) + rate(:,:, 368) = rate(:,:, 368) * inv(:,:, 1) + rate(:,:, 369) = rate(:,:, 369) * inv(:,:, 1) + rate(:,:, 371) = rate(:,:, 371) * inv(:,:, 1) + rate(:,:, 372) = rate(:,:, 372) * inv(:,:, 1) + rate(:,:, 373) = rate(:,:, 373) * inv(:,:, 1) + rate(:,:, 374) = rate(:,:, 374) * inv(:,:, 1) + rate(:,:, 375) = rate(:,:, 375) * inv(:,:, 1) + rate(:,:, 376) = rate(:,:, 376) * inv(:,:, 1) + rate(:,:, 377) = rate(:,:, 377) * inv(:,:, 1) + rate(:,:, 378) = rate(:,:, 378) * inv(:,:, 1) + rate(:,:, 379) = rate(:,:, 379) * inv(:,:, 1) + rate(:,:, 385) = rate(:,:, 385) * inv(:,:, 1) + rate(:,:, 386) = rate(:,:, 386) * inv(:,:, 1) + rate(:,:, 391) = rate(:,:, 391) * inv(:,:, 2) + rate(:,:, 395) = rate(:,:, 395) * inv(:,:, 2) + rate(:,:, 399) = rate(:,:, 399) * inv(:,:, 2) + rate(:,:, 404) = rate(:,:, 404) * inv(:,:, 1) + rate(:,:, 405) = rate(:,:, 405) * inv(:,:, 1) + rate(:,:, 411) = rate(:,:, 411) * inv(:,:, 1) + rate(:,:, 421) = rate(:,:, 421) * inv(:,:, 1) + rate(:,:, 433) = rate(:,:, 433) * inv(:,:, 1) + rate(:,:, 441) = rate(:,:, 441) * inv(:,:, 1) + rate(:,:, 444) = rate(:,:, 444) * inv(:,:, 1) + rate(:,:, 445) = rate(:,:, 445) * inv(:,:, 1) + rate(:,:, 446) = rate(:,:, 446) * inv(:,:, 1) + rate(:,:, 448) = rate(:,:, 448) * inv(:,:, 1) + rate(:,:, 449) = rate(:,:, 449) * inv(:,:, 1) + rate(:,:, 464) = rate(:,:, 464) * inv(:,:, 1) + rate(:,:, 484) = rate(:,:, 484) * inv(:,:, 1) + rate(:,:, 485) = rate(:,:, 485) * inv(:,:, 1) + rate(:,:, 495) = rate(:,:, 495) * inv(:,:, 1) + rate(:,:, 546) = rate(:,:, 546) * inv(:,:, 1) + rate(:,:, 592) = rate(:,:, 592) * inv(:,:, 2) + rate(:,:, 595) = rate(:,:, 595) * inv(:,:, 2) + rate(:,:, 599) = rate(:,:, 599) * inv(:,:, 2) + rate(:,:, 604) = rate(:,:, 604) * inv(:,:, 2) + rate(:,:, 605) = rate(:,:, 605) * inv(:,:, 2) + rate(:,:, 370) = rate(:,:, 370) * inv(:,:, 2) * inv(:,:, 1) + 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(:,:, 117) = rate(:,:, 117) * 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(:,:, 135) = rate(:,:, 135) * m(:,:) + rate(:,:, 136) = rate(:,:, 136) * 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(:,:, 172) = rate(:,:, 172) * 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * 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(:,:, 252) = rate(:,:, 252) * 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(:,:, 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(:,:, 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(:,:, 292) = rate(:,:, 292) * 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(:,:, 322) = rate(:,:, 322) * 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(:,:, 329) = rate(:,:, 329) * 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(:,:, 336) = rate(:,:, 336) * m(:,:) + rate(:,:, 337) = rate(:,:, 337) * m(:,:) + rate(:,:, 338) = rate(:,:, 338) * m(:,:) + rate(:,:, 339) = rate(:,:, 339) * m(:,:) + rate(:,:, 340) = rate(:,:, 340) * m(:,:) + rate(:,:, 341) = rate(:,:, 341) * m(:,:) + rate(:,:, 342) = rate(:,:, 342) * m(:,:) + rate(:,:, 343) = rate(:,:, 343) * m(:,:) + rate(:,:, 344) = rate(:,:, 344) * m(:,:) + rate(:,:, 345) = rate(:,:, 345) * m(:,:) + rate(:,:, 346) = rate(:,:, 346) * m(:,:) + rate(:,:, 347) = rate(:,:, 347) * m(:,:) + rate(:,:, 348) = rate(:,:, 348) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 352) = rate(:,:, 352) * m(:,:) + rate(:,:, 353) = rate(:,:, 353) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 357) = rate(:,:, 357) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + rate(:,:, 360) = rate(:,:, 360) * m(:,:) + rate(:,:, 361) = rate(:,:, 361) * m(:,:) + rate(:,:, 362) = rate(:,:, 362) * m(:,:) + rate(:,:, 363) = rate(:,:, 363) * m(:,:) + rate(:,:, 364) = rate(:,:, 364) * m(:,:) + rate(:,:, 365) = rate(:,:, 365) * m(:,:) + rate(:,:, 366) = rate(:,:, 366) * m(:,:) + rate(:,:, 367) = rate(:,:, 367) * m(:,:) + rate(:,:, 368) = rate(:,:, 368) * m(:,:) + rate(:,:, 372) = rate(:,:, 372) * m(:,:) + rate(:,:, 374) = rate(:,:, 374) * m(:,:) + rate(:,:, 376) = rate(:,:, 376) * m(:,:) + rate(:,:, 378) = rate(:,:, 378) * m(:,:) + rate(:,:, 380) = rate(:,:, 380) * m(:,:) + rate(:,:, 381) = rate(:,:, 381) * m(:,:) + rate(:,:, 382) = rate(:,:, 382) * m(:,:) + rate(:,:, 383) = rate(:,:, 383) * m(:,:) + rate(:,:, 384) = rate(:,:, 384) * m(:,:) + rate(:,:, 389) = rate(:,:, 389) * m(:,:) + rate(:,:, 390) = rate(:,:, 390) * m(:,:) + rate(:,:, 392) = rate(:,:, 392) * m(:,:) + rate(:,:, 393) = rate(:,:, 393) * m(:,:) + rate(:,:, 394) = rate(:,:, 394) * m(:,:) + rate(:,:, 396) = rate(:,:, 396) * m(:,:) + rate(:,:, 397) = rate(:,:, 397) * m(:,:) + rate(:,:, 398) = rate(:,:, 398) * m(:,:) + rate(:,:, 400) = rate(:,:, 400) * m(:,:) + rate(:,:, 401) = rate(:,:, 401) * m(:,:) + rate(:,:, 402) = rate(:,:, 402) * m(:,:) + rate(:,:, 403) = rate(:,:, 403) * m(:,:) + rate(:,:, 404) = rate(:,:, 404) * m(:,:) + rate(:,:, 405) = rate(:,:, 405) * m(:,:) + rate(:,:, 406) = rate(:,:, 406) * m(:,:) + rate(:,:, 407) = rate(:,:, 407) * m(:,:) + rate(:,:, 408) = rate(:,:, 408) * m(:,:) + rate(:,:, 409) = rate(:,:, 409) * m(:,:) + rate(:,:, 410) = rate(:,:, 410) * m(:,:) + rate(:,:, 411) = rate(:,:, 411) * m(:,:) + rate(:,:, 412) = rate(:,:, 412) * m(:,:) + rate(:,:, 413) = rate(:,:, 413) * m(:,:) + rate(:,:, 414) = rate(:,:, 414) * m(:,:) + rate(:,:, 415) = rate(:,:, 415) * m(:,:) + rate(:,:, 416) = rate(:,:, 416) * m(:,:) + rate(:,:, 417) = rate(:,:, 417) * m(:,:) + rate(:,:, 418) = rate(:,:, 418) * m(:,:) + rate(:,:, 419) = rate(:,:, 419) * m(:,:) + rate(:,:, 420) = rate(:,:, 420) * m(:,:) + rate(:,:, 421) = rate(:,:, 421) * m(:,:) + rate(:,:, 422) = rate(:,:, 422) * m(:,:) + rate(:,:, 423) = rate(:,:, 423) * m(:,:) + rate(:,:, 424) = rate(:,:, 424) * m(:,:) + rate(:,:, 425) = rate(:,:, 425) * m(:,:) + rate(:,:, 426) = rate(:,:, 426) * m(:,:) + rate(:,:, 427) = rate(:,:, 427) * m(:,:) + rate(:,:, 428) = rate(:,:, 428) * m(:,:) + rate(:,:, 429) = rate(:,:, 429) * m(:,:) + rate(:,:, 430) = rate(:,:, 430) * m(:,:) + rate(:,:, 431) = rate(:,:, 431) * m(:,:) + rate(:,:, 432) = rate(:,:, 432) * m(:,:) + rate(:,:, 433) = rate(:,:, 433) * m(:,:) + rate(:,:, 434) = rate(:,:, 434) * m(:,:) + rate(:,:, 435) = rate(:,:, 435) * m(:,:) + rate(:,:, 436) = rate(:,:, 436) * m(:,:) + rate(:,:, 437) = rate(:,:, 437) * m(:,:) + rate(:,:, 438) = rate(:,:, 438) * m(:,:) + rate(:,:, 439) = rate(:,:, 439) * m(:,:) + rate(:,:, 440) = rate(:,:, 440) * m(:,:) + rate(:,:, 441) = rate(:,:, 441) * m(:,:) + rate(:,:, 442) = rate(:,:, 442) * m(:,:) + rate(:,:, 443) = rate(:,:, 443) * m(:,:) + rate(:,:, 444) = rate(:,:, 444) * m(:,:) + rate(:,:, 445) = rate(:,:, 445) * m(:,:) + rate(:,:, 446) = rate(:,:, 446) * m(:,:) + rate(:,:, 447) = rate(:,:, 447) * m(:,:) + rate(:,:, 450) = rate(:,:, 450) * m(:,:) + rate(:,:, 451) = rate(:,:, 451) * m(:,:) + rate(:,:, 452) = rate(:,:, 452) * m(:,:) + rate(:,:, 453) = rate(:,:, 453) * m(:,:) + rate(:,:, 454) = rate(:,:, 454) * m(:,:) + rate(:,:, 455) = rate(:,:, 455) * m(:,:) + rate(:,:, 456) = rate(:,:, 456) * m(:,:) + rate(:,:, 457) = rate(:,:, 457) * m(:,:) + rate(:,:, 458) = rate(:,:, 458) * m(:,:) + rate(:,:, 459) = rate(:,:, 459) * m(:,:) + rate(:,:, 460) = rate(:,:, 460) * m(:,:) + rate(:,:, 461) = rate(:,:, 461) * m(:,:) + rate(:,:, 462) = rate(:,:, 462) * m(:,:) + rate(:,:, 463) = rate(:,:, 463) * m(:,:) + rate(:,:, 464) = rate(:,:, 464) * m(:,:) + rate(:,:, 465) = rate(:,:, 465) * m(:,:) + rate(:,:, 466) = rate(:,:, 466) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * m(:,:) + rate(:,:, 468) = rate(:,:, 468) * m(:,:) + rate(:,:, 469) = rate(:,:, 469) * m(:,:) + rate(:,:, 470) = rate(:,:, 470) * m(:,:) + rate(:,:, 471) = rate(:,:, 471) * m(:,:) + rate(:,:, 472) = rate(:,:, 472) * m(:,:) + rate(:,:, 473) = rate(:,:, 473) * m(:,:) + rate(:,:, 474) = rate(:,:, 474) * m(:,:) + rate(:,:, 475) = rate(:,:, 475) * m(:,:) + rate(:,:, 476) = rate(:,:, 476) * m(:,:) + rate(:,:, 477) = rate(:,:, 477) * m(:,:) + rate(:,:, 478) = rate(:,:, 478) * m(:,:) + rate(:,:, 479) = rate(:,:, 479) * m(:,:) + rate(:,:, 480) = rate(:,:, 480) * m(:,:) + rate(:,:, 481) = rate(:,:, 481) * m(:,:) + rate(:,:, 482) = rate(:,:, 482) * m(:,:) + rate(:,:, 483) = rate(:,:, 483) * m(:,:) + rate(:,:, 484) = rate(:,:, 484) * m(:,:) + rate(:,:, 486) = rate(:,:, 486) * m(:,:) + rate(:,:, 487) = rate(:,:, 487) * m(:,:) + rate(:,:, 488) = rate(:,:, 488) * m(:,:) + rate(:,:, 489) = rate(:,:, 489) * m(:,:) + rate(:,:, 490) = rate(:,:, 490) * m(:,:) + rate(:,:, 491) = rate(:,:, 491) * m(:,:) + rate(:,:, 492) = rate(:,:, 492) * m(:,:) + rate(:,:, 493) = rate(:,:, 493) * m(:,:) + rate(:,:, 494) = rate(:,:, 494) * m(:,:) + rate(:,:, 495) = rate(:,:, 495) * m(:,:) + rate(:,:, 496) = rate(:,:, 496) * m(:,:) + rate(:,:, 497) = rate(:,:, 497) * m(:,:) + rate(:,:, 498) = rate(:,:, 498) * m(:,:) + rate(:,:, 499) = rate(:,:, 499) * m(:,:) + rate(:,:, 500) = rate(:,:, 500) * m(:,:) + rate(:,:, 501) = rate(:,:, 501) * m(:,:) + rate(:,:, 502) = rate(:,:, 502) * m(:,:) + rate(:,:, 503) = rate(:,:, 503) * m(:,:) + rate(:,:, 504) = rate(:,:, 504) * m(:,:) + rate(:,:, 505) = rate(:,:, 505) * m(:,:) + rate(:,:, 506) = rate(:,:, 506) * m(:,:) + rate(:,:, 507) = rate(:,:, 507) * m(:,:) + rate(:,:, 508) = rate(:,:, 508) * m(:,:) + rate(:,:, 509) = rate(:,:, 509) * m(:,:) + rate(:,:, 510) = rate(:,:, 510) * m(:,:) + rate(:,:, 511) = rate(:,:, 511) * m(:,:) + rate(:,:, 512) = rate(:,:, 512) * m(:,:) + rate(:,:, 513) = rate(:,:, 513) * m(:,:) + rate(:,:, 514) = rate(:,:, 514) * m(:,:) + rate(:,:, 515) = rate(:,:, 515) * m(:,:) + rate(:,:, 516) = rate(:,:, 516) * m(:,:) + rate(:,:, 517) = rate(:,:, 517) * m(:,:) + rate(:,:, 518) = rate(:,:, 518) * m(:,:) + rate(:,:, 519) = rate(:,:, 519) * m(:,:) + rate(:,:, 520) = rate(:,:, 520) * m(:,:) + rate(:,:, 521) = rate(:,:, 521) * m(:,:) + rate(:,:, 522) = rate(:,:, 522) * m(:,:) + rate(:,:, 523) = rate(:,:, 523) * m(:,:) + rate(:,:, 524) = rate(:,:, 524) * m(:,:) + rate(:,:, 525) = rate(:,:, 525) * m(:,:) + rate(:,:, 526) = rate(:,:, 526) * m(:,:) + rate(:,:, 527) = rate(:,:, 527) * m(:,:) + rate(:,:, 528) = rate(:,:, 528) * m(:,:) + rate(:,:, 529) = rate(:,:, 529) * m(:,:) + rate(:,:, 530) = rate(:,:, 530) * m(:,:) + rate(:,:, 531) = rate(:,:, 531) * m(:,:) + rate(:,:, 532) = rate(:,:, 532) * m(:,:) + rate(:,:, 533) = rate(:,:, 533) * m(:,:) + rate(:,:, 534) = rate(:,:, 534) * m(:,:) + rate(:,:, 535) = rate(:,:, 535) * m(:,:) + rate(:,:, 536) = rate(:,:, 536) * m(:,:) + rate(:,:, 537) = rate(:,:, 537) * m(:,:) + rate(:,:, 538) = rate(:,:, 538) * m(:,:) + rate(:,:, 539) = rate(:,:, 539) * m(:,:) + rate(:,:, 540) = rate(:,:, 540) * m(:,:) + rate(:,:, 541) = rate(:,:, 541) * m(:,:) + rate(:,:, 542) = rate(:,:, 542) * m(:,:) + rate(:,:, 543) = rate(:,:, 543) * m(:,:) + rate(:,:, 544) = rate(:,:, 544) * m(:,:) + rate(:,:, 545) = rate(:,:, 545) * m(:,:) + rate(:,:, 546) = rate(:,:, 546) * m(:,:) + rate(:,:, 547) = rate(:,:, 547) * m(:,:) + rate(:,:, 548) = rate(:,:, 548) * m(:,:) + rate(:,:, 549) = rate(:,:, 549) * m(:,:) + rate(:,:, 550) = rate(:,:, 550) * m(:,:) + rate(:,:, 551) = rate(:,:, 551) * m(:,:) + rate(:,:, 552) = rate(:,:, 552) * m(:,:) + rate(:,:, 553) = rate(:,:, 553) * m(:,:) + rate(:,:, 554) = rate(:,:, 554) * m(:,:) + rate(:,:, 555) = rate(:,:, 555) * m(:,:) + rate(:,:, 556) = rate(:,:, 556) * m(:,:) + rate(:,:, 557) = rate(:,:, 557) * m(:,:) + rate(:,:, 563) = rate(:,:, 563) * m(:,:) + rate(:,:, 568) = rate(:,:, 568) * m(:,:) + rate(:,:, 569) = rate(:,:, 569) * m(:,:) + rate(:,:, 570) = rate(:,:, 570) * m(:,:) + rate(:,:, 573) = rate(:,:, 573) * m(:,:) + rate(:,:, 574) = rate(:,:, 574) * m(:,:) + rate(:,:, 575) = rate(:,:, 575) * m(:,:) + rate(:,:, 578) = rate(:,:, 578) * m(:,:) + rate(:,:, 582) = rate(:,:, 582) * m(:,:) + rate(:,:, 583) = rate(:,:, 583) * m(:,:) + rate(:,:, 584) = rate(:,:, 584) * m(:,:) + rate(:,:, 585) = rate(:,:, 585) * m(:,:) + rate(:,:, 586) = rate(:,:, 586) * m(:,:) + rate(:,:, 587) = rate(:,:, 587) * m(:,:) + rate(:,:, 588) = rate(:,:, 588) * m(:,:) + rate(:,:, 589) = rate(:,:, 589) * m(:,:) + rate(:,:, 590) = rate(:,:, 590) * m(:,:) + rate(:,:, 591) = rate(:,:, 591) * m(:,:) + rate(:,:, 593) = rate(:,:, 593) * m(:,:) + rate(:,:, 594) = rate(:,:, 594) * m(:,:) + rate(:,:, 596) = rate(:,:, 596) * m(:,:) + rate(:,:, 597) = rate(:,:, 597) * m(:,:) + rate(:,:, 598) = rate(:,:, 598) * m(:,:) + rate(:,:, 600) = rate(:,:, 600) * m(:,:) + rate(:,:, 601) = rate(:,:, 601) * m(:,:) + rate(:,:, 602) = rate(:,:, 602) * m(:,:) + rate(:,:, 603) = rate(:,:, 603) * m(:,:) + rate(:,:, 606) = rate(:,:, 606) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_mad_mam5/mo_exp_sol.F90 b/src/chemistry/pp_waccm_mad_mam5/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/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_waccm_mad_mam5/mo_imp_sol.F90 b/src/chemistry/pp_waccm_mad_mam5/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/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_waccm_mad_mam5/mo_indprd.F90 b/src/chemistry/pp_waccm_mad_mam5/mo_indprd.F90 new file mode 100644 index 0000000000..d5466d06cb --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/mo_indprd.F90 @@ -0,0 +1,167 @@ + 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 Implicit species +!-------------------------------------------------------------------- + if( class == 4 ) then + prod(:,1) = + extfrc(:,5) + prod(:,2) = + extfrc(:,6) + prod(:,99) = 0._r8 + prod(:,43) = 0._r8 + prod(:,106) = 0._r8 + prod(:,63) = 0._r8 + prod(:,3) = 0._r8 + prod(:,27) = 0._r8 + prod(:,34) = 0._r8 + prod(:,35) = 0._r8 + prod(:,29) = 0._r8 + prod(:,36) = 0._r8 + prod(:,30) = 0._r8 + prod(:,37) = 0._r8 + prod(:,31) = 0._r8 + prod(:,60) = 0._r8 + prod(:,107) = 0._r8 + prod(:,65) = 0._r8 + prod(:,32) = 0._r8 + prod(:,54) = 0._r8 + prod(:,89) = 0._r8 + prod(:,55) = 0._r8 + prod(:,88) = 0._r8 + prod(:,56) = 0._r8 + prod(:,125) = 0._r8 + prod(:,38) = 0._r8 + prod(:,26) = 0._r8 + prod(:,117) = 0._r8 + prod(:,83) = 0._r8 + prod(:,4) = 0._r8 + prod(:,69) = + extfrc(:,15) + prod(:,121) = 0._r8 + prod(:,39) = 0._r8 + prod(:,41) = 0._r8 + prod(:,50) = + extfrc(:,2) + prod(:,5) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,81) = 0._r8 + prod(:,132) = 0._r8 + prod(:,103) = 0._r8 + prod(:,28) = 0._r8 + prod(:,64) = 0._r8 + prod(:,33) = 0._r8 + prod(:,79) = 0._r8 + prod(:,40) = 0._r8 + prod(:,42) = 0._r8 + prod(:,48) = 0._r8 + prod(:,138) = 0._r8 + prod(:,49) = 0._r8 + prod(:,126) = 0._r8 + prod(:,59) = 0._r8 + prod(:,77) = 0._r8 + prod(:,80) = 0._r8 + prod(:,73) = 0._r8 + prod(:,90) = (rxt(:,69) +rxt(:,70) +.800_r8*rxt(:,72) +.800_r8*rxt(:,73)) & + + extfrc(:,17) + prod(:,44) = 0._r8 + prod(:,87) = 0._r8 + prod(:,8) = 0._r8 + prod(:,9) = 0._r8 + prod(:,10) = 0._r8 + prod(:,137) = + extfrc(:,16) + prod(:,133) = + extfrc(:,3) + prod(:,131) = 0._r8 + prod(:,11) = + extfrc(:,7) + prod(:,12) = + extfrc(:,8) + prod(:,13) = 0._r8 + prod(:,14) = + extfrc(:,9) + prod(:,15) = + extfrc(:,10) + prod(:,123) = + extfrc(:,24) + prod(:,108) = 0._r8 + prod(:,124) = 0._r8 + prod(:,136) = 0._r8 + prod(:,52) = 0._r8 + prod(:,53) = 0._r8 + prod(:,16) = + extfrc(:,11) + prod(:,17) = + extfrc(:,12) + prod(:,72) = 0._r8 + prod(:,18) = 0._r8 + prod(:,92) = 0._r8 + prod(:,82) = + extfrc(:,4) + prod(:,45) = 0._r8 + prod(:,19) = + extfrc(:,13) + prod(:,20) = + extfrc(:,1) + prod(:,21) = 0._r8 + prod(:,22) = + extfrc(:,14) + prod(:,23) = 0._r8 + prod(:,24) = 0._r8 + prod(:,25) = 0._r8 + prod(:,109) = 0._r8 + prod(:,96) = 0._r8 + prod(:,95) = 0._r8 + prod(:,84) = 0._r8 + prod(:,115) = 0._r8 + prod(:,94) = 0._r8 + prod(:,104) = 0._r8 + prod(:,110) = 0._r8 + prod(:,116) = (rxt(:,67) +rxt(:,68) +rxt(:,69) +rxt(:,70) +rxt(:,71) + & + rxt(:,74)) + extfrc(:,22) + prod(:,57) = 0._r8 + prod(:,93) = 0._r8 + prod(:,112) = 0._r8 + prod(:,68) = 0._r8 + prod(:,120) = 0._r8 + prod(:,46) = 0._r8 + prod(:,130) = 0._r8 + prod(:,47) = 0._r8 + prod(:,129) = 0._r8 + prod(:,74) = 0._r8 + prod(:,76) = (rxt(:,68) +rxt(:,71) +1.200_r8*rxt(:,72) +1.200_r8*rxt(:,73)) & + + extfrc(:,18) + prod(:,66) = (rxt(:,67) +rxt(:,74)) + extfrc(:,19) + prod(:,113) = 0._r8 + prod(:,97) = 0._r8 + prod(:,111) = 0._r8 + prod(:,102) = 0._r8 + prod(:,105) = 0._r8 + prod(:,98) = 0._r8 + prod(:,101) = 0._r8 + prod(:,118) = 0._r8 + prod(:,119) = 0._r8 + prod(:,58) = 0._r8 + prod(:,71) = 0._r8 + prod(:,122) = 0._r8 + prod(:,70) = 0._r8 + prod(:,78) = (rxt(:,68) +rxt(:,69) +rxt(:,70) +rxt(:,71)) + extfrc(:,23) + prod(:,85) = 0._r8 + prod(:,51) = 0._r8 + prod(:,127) = 0._r8 + prod(:,128) = + extfrc(:,25) + prod(:,75) = 0._r8 + prod(:,100) = 0._r8 + prod(:,67) = 0._r8 + prod(:,91) = 0._r8 + prod(:,114) = + extfrc(:,20) + prod(:,134) = 0._r8 + prod(:,135) = 0._r8 + prod(:,86) = + extfrc(:,21) + prod(:,62) = 0._r8 + prod(:,61) = 0._r8 + prod(:,139) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_mad_mam5/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_mad_mam5/mo_lin_matrix.F90 new file mode 100644 index 0000000000..c6f9b7479d --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/mo_lin_matrix.F90 @@ -0,0 +1,434 @@ + 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,582) = -( het_rates(k,3) ) + mat(k,96) = rxt(k,27) + mat(k,714) = rxt(k,28) + mat(k,208) = rxt(k,30) + mat(k,57) = rxt(k,32) + mat(k,63) = rxt(k,33) + mat(k,187) = 2.000_r8*rxt(k,39) + mat(k,223) = rxt(k,40) + mat(k,162) = 3.000_r8*rxt(k,43) + mat(k,34) = 2.000_r8*rxt(k,51) + mat(k,325) = rxt(k,52) + mat(k,310) = rxt(k,58) + mat(k,95) = -( rxt(k,27) + het_rates(k,4) ) + mat(k,715) = -( rxt(k,28) + het_rates(k,5) ) + mat(k,209) = rxt(k,29) + mat(k,206) = -( rxt(k,29) + rxt(k,30) + rxt(k,564) + rxt(k,567) + rxt(k,572) & + + het_rates(k,6) ) + mat(k,3) = -( het_rates(k,7) ) + mat(k,29) = -( rxt(k,31) + het_rates(k,8) ) + mat(k,55) = -( rxt(k,32) + het_rates(k,9) ) + mat(k,60) = -( rxt(k,33) + het_rates(k,10) ) + mat(k,36) = -( rxt(k,34) + het_rates(k,11) ) + mat(k,65) = -( rxt(k,35) + het_rates(k,12) ) + mat(k,40) = -( rxt(k,36) + het_rates(k,13) ) + mat(k,70) = -( rxt(k,37) + het_rates(k,14) ) + mat(k,44) = -( rxt(k,38) + het_rates(k,15) ) + mat(k,186) = -( rxt(k,39) + het_rates(k,16) ) + mat(k,738) = -( rxt(k,21) + rxt(k,22) + het_rates(k,17) ) + mat(k,157) = rxt(k,23) + mat(k,419) = .180_r8*rxt(k,25) + mat(k,221) = -( rxt(k,40) + het_rates(k,18) ) + mat(k,48) = -( rxt(k,41) + het_rates(k,19) ) + mat(k,147) = -( rxt(k,42) + het_rates(k,20) ) + mat(k,432) = -( het_rates(k,21) ) + mat(k,417) = rxt(k,24) + mat(k,222) = rxt(k,40) + mat(k,149) = rxt(k,42) + mat(k,155) = -( rxt(k,23) + het_rates(k,22) ) + mat(k,416) = -( rxt(k,24) + rxt(k,25) + het_rates(k,23) ) + mat(k,161) = -( rxt(k,43) + het_rates(k,24) ) + mat(k,1487) = -( het_rates(k,25) ) + mat(k,97) = rxt(k,27) + mat(k,31) = 4.000_r8*rxt(k,31) + mat(k,59) = rxt(k,32) + mat(k,39) = 2.000_r8*rxt(k,34) + mat(k,69) = 2.000_r8*rxt(k,35) + mat(k,43) = 2.000_r8*rxt(k,36) + mat(k,74) = rxt(k,37) + mat(k,47) = 2.000_r8*rxt(k,38) + mat(k,50) = 3.000_r8*rxt(k,41) + mat(k,152) = rxt(k,42) + mat(k,76) = 2.000_r8*rxt(k,44) + mat(k,28) = 2.000_r8*rxt(k,45) + mat(k,1112) = rxt(k,46) + mat(k,363) = rxt(k,47) + mat(k,88) = rxt(k,50) + mat(k,84) = rxt(k,53) + mat(k,94) = rxt(k,54) + mat(k,120) = rxt(k,55) + mat(k,2016) = rxt(k,56) + mat(k,337) = rxt(k,59) + mat(k,75) = -( rxt(k,44) + het_rates(k,26) ) + mat(k,26) = -( rxt(k,45) + rxt(k,485) + het_rates(k,27) ) + mat(k,1104) = -( rxt(k,46) + het_rates(k,28) ) + mat(k,361) = rxt(k,48) + mat(k,137) = rxt(k,60) + mat(k,27) = 2.000_r8*rxt(k,485) + mat(k,359) = -( rxt(k,47) + rxt(k,48) + rxt(k,566) + rxt(k,571) + rxt(k,577) & + + het_rates(k,29) ) + mat(k,4) = -( het_rates(k,30) ) + mat(k,252) = -( het_rates(k,31) ) + mat(k,733) = rxt(k,21) + rxt(k,22) + mat(k,414) = .380_r8*rxt(k,25) + mat(k,1263) = rxt(k,26) + rxt(k,62) + mat(k,140) = rxt(k,101) + mat(k,1284) = -( rxt(k,26) + rxt(k,62) + het_rates(k,32) ) + mat(k,423) = .440_r8*rxt(k,25) + mat(k,1020) = rxt(k,63) + mat(k,844) = rxt(k,65) + mat(k,267) = rxt(k,369) + mat(k,77) = -( rxt(k,49) + het_rates(k,33) ) + mat(k,56) = rxt(k,32) + mat(k,61) = rxt(k,33) + mat(k,66) = rxt(k,35) + mat(k,41) = 2.000_r8*rxt(k,36) + mat(k,71) = 2.000_r8*rxt(k,37) + mat(k,45) = rxt(k,38) + mat(k,33) = 2.000_r8*rxt(k,51) + mat(k,89) = rxt(k,54) + mat(k,115) = rxt(k,55) + mat(k,85) = -( rxt(k,50) + het_rates(k,34) ) + mat(k,37) = rxt(k,34) + mat(k,67) = rxt(k,35) + mat(k,81) = rxt(k,53) + mat(k,125) = -( het_rates(k,35) ) + mat(k,5) = -( het_rates(k,36) ) + mat(k,6) = -( het_rates(k,37) ) + mat(k,7) = -( het_rates(k,38) ) + mat(k,341) = -( het_rates(k,39) ) + mat(k,62) = rxt(k,33) + mat(k,72) = rxt(k,37) + mat(k,78) = 2.000_r8*rxt(k,49) + mat(k,86) = rxt(k,50) + mat(k,123) = rxt(k,57) + mat(k,1778) = -( het_rates(k,40) ) + mat(k,2083) = 2.000_r8*rxt(k,2) + rxt(k,3) + mat(k,750) = 2.000_r8*rxt(k,21) + mat(k,159) = rxt(k,23) + mat(k,428) = rxt(k,24) + .330_r8*rxt(k,25) + mat(k,330) = rxt(k,52) + mat(k,2023) = rxt(k,56) + mat(k,124) = rxt(k,57) + mat(k,647) = -( het_rates(k,41) ) + mat(k,2055) = rxt(k,1) + mat(k,736) = rxt(k,22) + mat(k,418) = 1.440_r8*rxt(k,25) + mat(k,32) = -( rxt(k,51) + het_rates(k,42) ) + mat(k,214) = -( rxt(k,4) + het_rates(k,43) ) + mat(k,889) = .500_r8*rxt(k,558) + mat(k,52) = -( rxt(k,100) + het_rates(k,44) ) + mat(k,324) = -( rxt(k,52) + het_rates(k,45) ) + mat(k,80) = -( rxt(k,53) + het_rates(k,46) ) + mat(k,90) = -( rxt(k,54) + het_rates(k,47) ) + mat(k,116) = -( rxt(k,55) + het_rates(k,48) ) + mat(k,2029) = -( rxt(k,56) + het_rates(k,49) ) + mat(k,532) = rxt(k,386) + mat(k,122) = -( rxt(k,57) + het_rates(k,50) ) + mat(k,1529) = -( rxt(k,9) + het_rates(k,51) ) + mat(k,616) = rxt(k,275) + mat(k,406) = 2.000_r8*rxt(k,559) + 2.000_r8*rxt(k,562) + 2.000_r8*rxt(k,565) & + + 2.000_r8*rxt(k,576) + mat(k,1820) = .500_r8*rxt(k,560) + mat(k,1736) = rxt(k,561) + mat(k,211) = rxt(k,564) + rxt(k,567) + rxt(k,572) + mat(k,364) = rxt(k,566) + rxt(k,571) + rxt(k,577) + mat(k,179) = -( rxt(k,10) + rxt(k,11) + rxt(k,448) + het_rates(k,52) ) + mat(k,309) = -( rxt(k,58) + het_rates(k,53) ) + mat(k,207) = rxt(k,564) + rxt(k,567) + rxt(k,572) + mat(k,333) = -( rxt(k,59) + het_rates(k,54) ) + mat(k,358) = rxt(k,566) + rxt(k,571) + rxt(k,577) + mat(k,278) = -( rxt(k,12) + het_rates(k,55) ) + mat(k,446) = -( rxt(k,66) + het_rates(k,56) ) + mat(k,1947) = rxt(k,17) + mat(k,389) = rxt(k,595) + mat(k,98) = -( rxt(k,13) + het_rates(k,57) ) + mat(k,401) = -( rxt(k,14) + rxt(k,15) + rxt(k,449) + rxt(k,559) + rxt(k,562) & + + rxt(k,565) + rxt(k,576) + het_rates(k,58) ) + mat(k,8) = -( het_rates(k,59) ) + mat(k,9) = -( het_rates(k,60) ) + mat(k,10) = -( het_rates(k,61) ) + mat(k,1983) = -( rxt(k,16) + rxt(k,17) + het_rates(k,62) ) + mat(k,281) = rxt(k,12) + mat(k,411) = rxt(k,15) + mat(k,1831) = rxt(k,18) + .500_r8*rxt(k,560) + mat(k,1747) = rxt(k,20) + mat(k,1621) = rxt(k,592) + mat(k,199) = rxt(k,605) + mat(k,1827) = -( rxt(k,18) + rxt(k,560) + het_rates(k,63) ) + mat(k,1536) = rxt(k,9) + mat(k,184) = rxt(k,11) + rxt(k,448) + mat(k,410) = rxt(k,14) + rxt(k,449) + mat(k,1743) = rxt(k,19) + mat(k,213) = rxt(k,29) + mat(k,366) = rxt(k,48) + mat(k,943) = rxt(k,75) + mat(k,1741) = -( rxt(k,19) + rxt(k,20) + rxt(k,561) + het_rates(k,64) ) + mat(k,183) = rxt(k,10) + mat(k,409) = rxt(k,14) + rxt(k,15) + rxt(k,449) + mat(k,212) = rxt(k,30) + mat(k,365) = rxt(k,47) + mat(k,880) = rxt(k,76) + mat(k,11) = -( het_rates(k,65) ) + mat(k,12) = -( het_rates(k,66) ) + mat(k,13) = -( het_rates(k,67) ) + mat(k,14) = -( het_rates(k,68) ) + mat(k,15) = -( het_rates(k,69) ) + mat(k,1388) = -( rxt(k,77) + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) & + + rxt(k,82) + het_rates(k,70) ) + mat(k,2074) = rxt(k,2) + mat(k,1437) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,83) + rxt(k,85) + rxt(k,87) & + + 2.000_r8*rxt(k,88) + 2.000_r8*rxt(k,89) + rxt(k,90) + rxt(k,91) & + + rxt(k,92) + mat(k,1927) = rxt(k,8) + mat(k,405) = rxt(k,15) + mat(k,1969) = rxt(k,17) + mat(k,1817) = rxt(k,18) + mat(k,1733) = rxt(k,19) + mat(k,424) = .180_r8*rxt(k,25) + mat(k,1286) = rxt(k,26) + rxt(k,62) + mat(k,722) = rxt(k,28) + mat(k,1110) = rxt(k,46) + mat(k,138) = rxt(k,60) + mat(k,1886) = rxt(k,99) + rxt(k,358) + mat(k,482) = rxt(k,102) + mat(k,355) = rxt(k,103) + mat(k,105) = rxt(k,104) + mat(k,794) = rxt(k,391) + mat(k,203) = rxt(k,599) + mat(k,198) = rxt(k,604) + 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,787) = -( rxt(k,391) + het_rates(k,71) ) + mat(k,2060) = rxt(k,1) + mat(k,1423) = rxt(k,6) + mat(k,1913) = rxt(k,7) + mat(k,99) = rxt(k,13) + mat(k,1438) = -( rxt(k,5) + rxt(k,6) + rxt(k,83) + rxt(k,84) + rxt(k,85) & + + rxt(k,86) + rxt(k,87) + rxt(k,88) + rxt(k,89) + rxt(k,90) & + + rxt(k,91) + rxt(k,92) + het_rates(k,72) ) + mat(k,1928) = rxt(k,8) + mat(k,1734) = rxt(k,20) + mat(k,1563) = rxt(k,93) + rxt(k,137) + mat(k,601) = rxt(k,95) + mat(k,244) = rxt(k,97) + mat(k,380) = rxt(k,387) + rxt(k,395) + mat(k,133) = rxt(k,388) + mat(k,1940) = -( rxt(k,7) + rxt(k,8) + het_rates(k,73) ) + mat(k,607) = rxt(k,96) + mat(k,134) = -( rxt(k,60) + het_rates(k,74) ) + mat(k,139) = -( rxt(k,101) + het_rates(k,75) ) + mat(k,16) = -( het_rates(k,76) ) + mat(k,17) = -( het_rates(k,77) ) + mat(k,271) = -( het_rates(k,78) ) + mat(k,141) = rxt(k,101) + mat(k,474) = rxt(k,102) + mat(k,18) = -( rxt(k,61) + het_rates(k,79) ) + mat(k,476) = -( rxt(k,102) + het_rates(k,80) ) + mat(k,352) = rxt(k,103) + mat(k,351) = -( rxt(k,103) + het_rates(k,81) ) + mat(k,104) = rxt(k,104) + mat(k,103) = -( rxt(k,104) + het_rates(k,82) ) + mat(k,53) = rxt(k,100) + mat(k,19) = -( het_rates(k,83) ) + mat(k,20) = -( het_rates(k,84) ) + mat(k,21) = -( het_rates(k,85) ) + mat(k,22) = -( het_rates(k,86) ) + mat(k,23) = -( het_rates(k,87) ) + mat(k,24) = -( het_rates(k,88) ) + mat(k,25) = -( het_rates(k,89) ) + mat(k,811) = -( het_rates(k,90) ) + mat(k,536) = rxt(k,385) + mat(k,520) = rxt(k,386) + mat(k,535) = -( rxt(k,385) + het_rates(k,91) ) + mat(k,519) = -( rxt(k,386) + het_rates(k,92) ) + mat(k,369) = -( het_rates(k,93) ) + mat(k,1014) = -( rxt(k,63) + het_rates(k,94) ) + mat(k,673) = rxt(k,64) + rxt(k,283) + mat(k,504) = -( rxt(k,284) + het_rates(k,95) ) + mat(k,669) = -( rxt(k,64) + rxt(k,283) + het_rates(k,96) ) + mat(k,505) = rxt(k,284) + mat(k,833) = -( rxt(k,65) + het_rates(k,97) ) + mat(k,1058) = -( het_rates(k,98) ) + mat(k,1962) = rxt(k,16) + mat(k,450) = rxt(k,66) + mat(k,928) = rxt(k,75) + mat(k,868) = rxt(k,76) + mat(k,1381) = rxt(k,77) + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) & + + rxt(k,82) + mat(k,1430) = rxt(k,83) + rxt(k,84) + rxt(k,85) + rxt(k,86) + rxt(k,87) & + + rxt(k,90) + rxt(k,91) + rxt(k,92) + mat(k,1555) = rxt(k,93) + rxt(k,137) + mat(k,598) = rxt(k,96) + mat(k,1843) = rxt(k,98) + mat(k,1879) = rxt(k,99) + rxt(k,358) + mat(k,167) = -( het_rates(k,99) ) + mat(k,490) = -( het_rates(k,100) ) + mat(k,900) = -( rxt(k,558) + het_rates(k,101) ) + mat(k,180) = rxt(k,11) + rxt(k,448) + mat(k,246) = -( rxt(k,373) + het_rates(k,102) ) + mat(k,1218) = rxt(k,375) + mat(k,1241) = -( rxt(k,375) + het_rates(k,103) ) + mat(k,1690) = rxt(k,377) + mat(k,107) = -( het_rates(k,104) ) + mat(k,1700) = -( rxt(k,377) + het_rates(k,105) ) + mat(k,1657) = rxt(k,379) + mat(k,111) = -( het_rates(k,106) ) + mat(k,1656) = -( rxt(k,379) + het_rates(k,107) ) + mat(k,284) = -( het_rates(k,108) ) + mat(k,247) = rxt(k,373) + mat(k,300) = -( het_rates(k,109) ) + mat(k,230) = -( het_rates(k,110) ) + mat(k,201) = rxt(k,599) + mat(k,195) = rxt(k,604) + mat(k,926) = -( rxt(k,75) + het_rates(k,111) ) + mat(k,551) = rxt(k,273) + mat(k,550) = -( rxt(k,273) + het_rates(k,112) ) + mat(k,866) = -( rxt(k,76) + het_rates(k,113) ) + mat(k,610) = rxt(k,275) + mat(k,692) = rxt(k,282) + mat(k,625) = -( rxt(k,274) + het_rates(k,114) ) + mat(k,691) = -( rxt(k,282) + het_rates(k,115) ) + mat(k,626) = rxt(k,274) + mat(k,564) = -( het_rates(k,116) ) + mat(k,609) = -( rxt(k,275) + het_rates(k,117) ) + mat(k,1153) = -( rxt(k,370) + het_rates(k,118) ) + mat(k,1964) = rxt(k,16) + mat(k,266) = rxt(k,369) + mat(k,259) = rxt(k,371) + mat(k,1602) = rxt(k,592) + mat(k,393) = rxt(k,595) + mat(k,1197) = -( het_rates(k,119) ) + mat(k,173) = -( het_rates(k,120) ) + mat(k,264) = -( rxt(k,369) + het_rates(k,121) ) + mat(k,1327) = -( het_rates(k,122) ) + mat(k,256) = -( rxt(k,371) + het_rates(k,123) ) + mat(k,1127) = rxt(k,370) + mat(k,317) = -( het_rates(k,124) ) + mat(k,444) = rxt(k,66) + mat(k,196) = rxt(k,605) + mat(k,377) = -( rxt(k,387) + rxt(k,395) + het_rates(k,125) ) + mat(k,1906) = rxt(k,7) + mat(k,132) = rxt(k,399) + mat(k,131) = -( rxt(k,388) + rxt(k,399) + het_rates(k,126) ) + mat(k,1566) = -( rxt(k,93) + rxt(k,137) + het_rates(k,127) ) + mat(k,850) = rxt(k,65) + mat(k,245) = rxt(k,97) + mat(k,1612) = -( rxt(k,592) + het_rates(k,128) ) + mat(k,1442) = rxt(k,84) + rxt(k,86) + mat(k,297) = rxt(k,94) + mat(k,292) = -( rxt(k,94) + het_rates(k,129) ) + mat(k,594) = -( rxt(k,95) + rxt(k,96) + het_rates(k,130) ) + mat(k,239) = -( rxt(k,97) + het_rates(k,131) ) + mat(k,461) = -( het_rates(k,132) ) + mat(k,984) = -( het_rates(k,133) ) + mat(k,2065) = rxt(k,3) + mat(k,216) = 2.000_r8*rxt(k,4) + mat(k,1517) = rxt(k,9) + mat(k,181) = rxt(k,10) + mat(k,279) = rxt(k,12) + mat(k,158) = rxt(k,23) + mat(k,422) = .330_r8*rxt(k,25) + mat(k,312) = rxt(k,58) + mat(k,334) = rxt(k,59) + mat(k,1841) = rxt(k,98) + mat(k,1808) = .500_r8*rxt(k,560) + mat(k,1861) = -( rxt(k,98) + het_rates(k,134) ) + mat(k,1898) = -( rxt(k,99) + rxt(k,358) + het_rates(k,135) ) + mat(k,1034) = rxt(k,63) + mat(k,606) = rxt(k,95) + mat(k,388) = -( rxt(k,595) + het_rates(k,136) ) + mat(k,1364) = rxt(k,77) + rxt(k,81) + mat(k,1415) = rxt(k,85) + rxt(k,87) + mat(k,197) = rxt(k,579) + mat(k,202) = rxt(k,580) + mat(k,200) = -( rxt(k,580) + rxt(k,599) + het_rates(k,137) ) + mat(k,1348) = rxt(k,78) + rxt(k,82) + mat(k,1407) = rxt(k,83) + rxt(k,92) + mat(k,194) = rxt(k,581) + mat(k,193) = -( rxt(k,579) + rxt(k,581) + rxt(k,604) + rxt(k,605) & + + het_rates(k,138) ) + mat(k,1347) = rxt(k,79) + rxt(k,80) + mat(k,1406) = rxt(k,90) + rxt(k,91) + mat(k,2090) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,139) ) + mat(k,430) = .050_r8*rxt(k,25) + mat(k,687) = rxt(k,64) + rxt(k,283) + mat(k,299) = rxt(k,94) + mat(k,54) = rxt(k,100) + mat(k,563) = rxt(k,273) + mat(k,642) = rxt(k,274) + mat(k,707) = rxt(k,282) + mat(k,518) = rxt(k,284) + mat(k,251) = rxt(k,373) + mat(k,1260) = rxt(k,375) + mat(k,1709) = rxt(k,377) + mat(k,1666) = rxt(k,379) + mat(k,549) = rxt(k,385) + 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_waccm_mad_mam5/mo_lu_factor.F90 b/src/chemistry/pp_waccm_mad_mam5/mo_lu_factor.F90 new file mode 100644 index 0000000000..dd7f1e2b1d --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/mo_lu_factor.F90 @@ -0,0 +1,14264 @@ + 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) = 1._r8 / lu(k,10) + 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) = lu(k,27) * lu(k,26) + lu(k,28) = lu(k,28) * lu(k,26) + lu(k,1104) = lu(k,1104) - lu(k,27) * lu(k,1082) + lu(k,1112) = lu(k,1112) - lu(k,28) * lu(k,1082) + lu(k,29) = 1._r8 / lu(k,29) + lu(k,30) = lu(k,30) * lu(k,29) + lu(k,31) = lu(k,31) * lu(k,29) + lu(k,787) = lu(k,787) - lu(k,30) * lu(k,758) + lu(k,796) = lu(k,796) - lu(k,31) * lu(k,758) + lu(k,32) = 1._r8 / lu(k,32) + lu(k,33) = lu(k,33) * lu(k,32) + lu(k,34) = lu(k,34) * lu(k,32) + lu(k,35) = lu(k,35) * lu(k,32) + lu(k,767) = lu(k,767) - lu(k,33) * lu(k,759) + lu(k,783) = lu(k,783) - lu(k,34) * lu(k,759) + lu(k,787) = lu(k,787) - lu(k,35) * lu(k,759) + 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,39) = lu(k,39) * lu(k,36) + lu(k,769) = lu(k,769) - lu(k,37) * lu(k,760) + lu(k,787) = lu(k,787) - lu(k,38) * lu(k,760) + lu(k,796) = lu(k,796) - lu(k,39) * lu(k,760) + lu(k,40) = 1._r8 / lu(k,40) + lu(k,41) = lu(k,41) * lu(k,40) + lu(k,42) = lu(k,42) * lu(k,40) + lu(k,43) = lu(k,43) * lu(k,40) + lu(k,767) = lu(k,767) - lu(k,41) * lu(k,761) + lu(k,787) = lu(k,787) - lu(k,42) * lu(k,761) + lu(k,796) = lu(k,796) - lu(k,43) * lu(k,761) + lu(k,44) = 1._r8 / lu(k,44) + lu(k,45) = lu(k,45) * lu(k,44) + lu(k,46) = lu(k,46) * lu(k,44) + lu(k,47) = lu(k,47) * lu(k,44) + lu(k,767) = lu(k,767) - lu(k,45) * lu(k,762) + lu(k,787) = lu(k,787) - lu(k,46) * lu(k,762) + lu(k,796) = lu(k,796) - lu(k,47) * lu(k,762) + 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,51) = lu(k,51) * lu(k,48) + lu(k,984) = lu(k,984) - lu(k,49) * lu(k,949) + lu(k,993) = lu(k,993) - lu(k,50) * lu(k,949) + lu(k,1005) = lu(k,1005) - lu(k,51) * lu(k,949) + 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,52) = 1._r8 / lu(k,52) + lu(k,53) = lu(k,53) * lu(k,52) + lu(k,54) = lu(k,54) * lu(k,52) + lu(k,103) = lu(k,103) - lu(k,53) * lu(k,102) + lu(k,106) = lu(k,106) - lu(k,54) * lu(k,102) + lu(k,2032) = lu(k,2032) - lu(k,53) * lu(k,2031) + lu(k,2090) = lu(k,2090) - lu(k,54) * lu(k,2031) + lu(k,55) = 1._r8 / lu(k,55) + lu(k,56) = lu(k,56) * lu(k,55) + lu(k,57) = lu(k,57) * lu(k,55) + lu(k,58) = lu(k,58) * lu(k,55) + lu(k,59) = lu(k,59) * lu(k,55) + lu(k,767) = lu(k,767) - lu(k,56) * lu(k,763) + lu(k,783) = lu(k,783) - lu(k,57) * lu(k,763) + lu(k,787) = lu(k,787) - lu(k,58) * lu(k,763) + lu(k,796) = lu(k,796) - lu(k,59) * lu(k,763) + 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,63) = lu(k,63) * lu(k,60) + lu(k,64) = lu(k,64) * lu(k,60) + lu(k,767) = lu(k,767) - lu(k,61) * lu(k,764) + lu(k,778) = lu(k,778) - lu(k,62) * lu(k,764) + lu(k,783) = lu(k,783) - lu(k,63) * lu(k,764) + lu(k,787) = lu(k,787) - lu(k,64) * lu(k,764) + lu(k,65) = 1._r8 / lu(k,65) + lu(k,66) = lu(k,66) * lu(k,65) + lu(k,67) = lu(k,67) * lu(k,65) + lu(k,68) = lu(k,68) * lu(k,65) + lu(k,69) = lu(k,69) * lu(k,65) + lu(k,767) = lu(k,767) - lu(k,66) * lu(k,765) + lu(k,769) = lu(k,769) - lu(k,67) * lu(k,765) + lu(k,787) = lu(k,787) - lu(k,68) * lu(k,765) + lu(k,796) = lu(k,796) - lu(k,69) * lu(k,765) + lu(k,70) = 1._r8 / lu(k,70) + lu(k,71) = lu(k,71) * lu(k,70) + lu(k,72) = lu(k,72) * lu(k,70) + lu(k,73) = lu(k,73) * lu(k,70) + lu(k,74) = lu(k,74) * lu(k,70) + lu(k,767) = lu(k,767) - lu(k,71) * lu(k,766) + lu(k,778) = lu(k,778) - lu(k,72) * lu(k,766) + lu(k,787) = lu(k,787) - lu(k,73) * lu(k,766) + lu(k,796) = lu(k,796) - lu(k,74) * lu(k,766) + lu(k,75) = 1._r8 / lu(k,75) + lu(k,76) = lu(k,76) * lu(k,75) + lu(k,337) = lu(k,337) - lu(k,76) * lu(k,332) + lu(k,363) = lu(k,363) - lu(k,76) * lu(k,357) + lu(k,1112) = lu(k,1112) - lu(k,76) * lu(k,1083) + lu(k,1487) = lu(k,1487) - lu(k,76) * lu(k,1454) + lu(k,2016) = lu(k,2016) - lu(k,76) * lu(k,1986) + 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,91) = - lu(k,78) * lu(k,89) + lu(k,92) = lu(k,92) - lu(k,79) * lu(k,89) + lu(k,117) = - lu(k,78) * lu(k,115) + lu(k,118) = lu(k,118) - lu(k,79) * lu(k,115) + lu(k,778) = lu(k,778) - lu(k,78) * lu(k,767) + lu(k,787) = lu(k,787) - lu(k,79) * lu(k,767) + lu(k,971) = - lu(k,78) * lu(k,950) + lu(k,982) = - lu(k,79) * lu(k,950) + lu(k,80) = 1._r8 / lu(k,80) + lu(k,81) = lu(k,81) * lu(k,80) + lu(k,82) = lu(k,82) * lu(k,80) + lu(k,83) = lu(k,83) * lu(k,80) + lu(k,84) = lu(k,84) * lu(k,80) + lu(k,769) = lu(k,769) - lu(k,81) * lu(k,768) + lu(k,787) = lu(k,787) - lu(k,82) * lu(k,768) + lu(k,789) = lu(k,789) - lu(k,83) * lu(k,768) + lu(k,796) = lu(k,796) - lu(k,84) * lu(k,768) + lu(k,952) = lu(k,952) - lu(k,81) * lu(k,951) + lu(k,982) = lu(k,982) - lu(k,82) * lu(k,951) + lu(k,984) = lu(k,984) - lu(k,83) * lu(k,951) + lu(k,993) = lu(k,993) - lu(k,84) * lu(k,951) + lu(k,85) = 1._r8 / lu(k,85) + lu(k,86) = lu(k,86) * lu(k,85) + lu(k,87) = lu(k,87) * lu(k,85) + lu(k,88) = lu(k,88) * lu(k,85) + lu(k,778) = lu(k,778) - lu(k,86) * lu(k,769) + lu(k,787) = lu(k,787) - lu(k,87) * lu(k,769) + lu(k,796) = lu(k,796) - lu(k,88) * lu(k,769) + lu(k,971) = lu(k,971) - lu(k,86) * lu(k,952) + lu(k,982) = lu(k,982) - lu(k,87) * lu(k,952) + lu(k,993) = lu(k,993) - lu(k,88) * lu(k,952) + lu(k,90) = 1._r8 / lu(k,90) + lu(k,91) = lu(k,91) * lu(k,90) + lu(k,92) = lu(k,92) * lu(k,90) + lu(k,93) = lu(k,93) * lu(k,90) + lu(k,94) = lu(k,94) * lu(k,90) + lu(k,778) = lu(k,778) - lu(k,91) * lu(k,770) + lu(k,787) = lu(k,787) - lu(k,92) * lu(k,770) + lu(k,789) = lu(k,789) - lu(k,93) * lu(k,770) + lu(k,796) = lu(k,796) - lu(k,94) * lu(k,770) + lu(k,971) = lu(k,971) - lu(k,91) * lu(k,953) + lu(k,982) = lu(k,982) - lu(k,92) * lu(k,953) + lu(k,984) = lu(k,984) - lu(k,93) * lu(k,953) + lu(k,993) = lu(k,993) - lu(k,94) * lu(k,953) + lu(k,95) = 1._r8 / lu(k,95) + lu(k,96) = lu(k,96) * lu(k,95) + lu(k,97) = lu(k,97) * lu(k,95) + lu(k,310) = lu(k,310) - lu(k,96) * lu(k,308) + lu(k,314) = - lu(k,97) * lu(k,308) + lu(k,714) = lu(k,714) - lu(k,96) * lu(k,708) + lu(k,724) = lu(k,724) - lu(k,97) * lu(k,708) + lu(k,1092) = lu(k,1092) - lu(k,96) * lu(k,1084) + lu(k,1112) = lu(k,1112) - lu(k,97) * lu(k,1084) + lu(k,1995) = - lu(k,96) * lu(k,1987) + lu(k,2016) = lu(k,2016) - lu(k,97) * lu(k,1987) + 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,98) = 1._r8 / lu(k,98) + lu(k,99) = lu(k,99) * lu(k,98) + lu(k,100) = lu(k,100) * lu(k,98) + lu(k,101) = lu(k,101) * lu(k,98) + lu(k,447) = - lu(k,99) * lu(k,443) + lu(k,454) = lu(k,454) - lu(k,100) * lu(k,443) + lu(k,458) = lu(k,458) - lu(k,101) * lu(k,443) + lu(k,787) = lu(k,787) - lu(k,99) * lu(k,771) + lu(k,795) = lu(k,795) - lu(k,100) * lu(k,771) + lu(k,806) = lu(k,806) - lu(k,101) * lu(k,771) + lu(k,1803) = - lu(k,99) * lu(k,1786) + lu(k,1818) = lu(k,1818) - lu(k,100) * lu(k,1786) + lu(k,1831) = lu(k,1831) - lu(k,101) * lu(k,1786) + 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,351) = lu(k,351) - lu(k,104) * lu(k,350) + lu(k,355) = lu(k,355) - lu(k,105) * lu(k,350) + lu(k,356) = - lu(k,106) * lu(k,350) + lu(k,972) = lu(k,972) - lu(k,104) * lu(k,954) + lu(k,991) = lu(k,991) - lu(k,105) * lu(k,954) + lu(k,1005) = lu(k,1005) - lu(k,106) * lu(k,954) + lu(k,2045) = - lu(k,104) * lu(k,2032) + lu(k,2074) = lu(k,2074) - lu(k,105) * lu(k,2032) + lu(k,2090) = lu(k,2090) - lu(k,106) * lu(k,2032) + lu(k,107) = 1._r8 / lu(k,107) + lu(k,108) = lu(k,108) * lu(k,107) + lu(k,109) = lu(k,109) * lu(k,107) + lu(k,110) = lu(k,110) * lu(k,107) + lu(k,406) = lu(k,406) - lu(k,108) * lu(k,399) + lu(k,408) = lu(k,408) - lu(k,109) * lu(k,399) + lu(k,412) = lu(k,412) - lu(k,110) * lu(k,399) + lu(k,1696) = lu(k,1696) - lu(k,108) * lu(k,1667) + lu(k,1700) = lu(k,1700) - lu(k,109) * lu(k,1667) + lu(k,1709) = lu(k,1709) - lu(k,110) * lu(k,1667) + lu(k,2077) = lu(k,2077) - lu(k,108) * lu(k,2033) + lu(k,2081) = lu(k,2081) - lu(k,109) * lu(k,2033) + lu(k,2090) = lu(k,2090) - lu(k,110) * lu(k,2033) + 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,406) = lu(k,406) - lu(k,112) * lu(k,400) + lu(k,407) = lu(k,407) - lu(k,113) * lu(k,400) + lu(k,412) = lu(k,412) - lu(k,114) * lu(k,400) + lu(k,1653) = lu(k,1653) - lu(k,112) * lu(k,1624) + lu(k,1656) = lu(k,1656) - lu(k,113) * lu(k,1624) + lu(k,1666) = lu(k,1666) - lu(k,114) * lu(k,1624) + lu(k,2077) = lu(k,2077) - lu(k,112) * lu(k,2034) + lu(k,2080) = lu(k,2080) - lu(k,113) * lu(k,2034) + lu(k,2090) = lu(k,2090) - lu(k,114) * lu(k,2034) + 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,120) = lu(k,120) * lu(k,116) + lu(k,121) = lu(k,121) * lu(k,116) + lu(k,778) = lu(k,778) - lu(k,117) * lu(k,772) + lu(k,787) = lu(k,787) - lu(k,118) * lu(k,772) + lu(k,789) = lu(k,789) - lu(k,119) * lu(k,772) + lu(k,796) = lu(k,796) - lu(k,120) * lu(k,772) + lu(k,808) = lu(k,808) - lu(k,121) * lu(k,772) + lu(k,971) = lu(k,971) - lu(k,117) * lu(k,955) + lu(k,982) = lu(k,982) - lu(k,118) * lu(k,955) + lu(k,984) = lu(k,984) - lu(k,119) * lu(k,955) + lu(k,993) = lu(k,993) - lu(k,120) * lu(k,955) + lu(k,1005) = lu(k,1005) - lu(k,121) * lu(k,955) + lu(k,122) = 1._r8 / lu(k,122) + lu(k,123) = lu(k,123) * lu(k,122) + lu(k,124) = lu(k,124) * lu(k,122) + lu(k,341) = lu(k,341) - lu(k,123) * lu(k,340) + lu(k,348) = lu(k,348) - lu(k,124) * lu(k,340) + lu(k,415) = lu(k,415) - lu(k,123) * lu(k,413) + lu(k,428) = lu(k,428) - lu(k,124) * lu(k,413) + lu(k,644) = lu(k,644) - lu(k,123) * lu(k,643) + lu(k,660) = lu(k,660) - lu(k,124) * lu(k,643) + lu(k,1504) = lu(k,1504) - lu(k,123) * lu(k,1502) + lu(k,1535) = - lu(k,124) * lu(k,1502) + lu(k,2044) = lu(k,2044) - lu(k,123) * lu(k,2035) + lu(k,2083) = lu(k,2083) - lu(k,124) * lu(k,2035) + lu(k,125) = 1._r8 / lu(k,125) + lu(k,126) = lu(k,126) * lu(k,125) + lu(k,127) = lu(k,127) * lu(k,125) + lu(k,128) = lu(k,128) * lu(k,125) + lu(k,129) = lu(k,129) * lu(k,125) + lu(k,130) = lu(k,130) * lu(k,125) + lu(k,972) = lu(k,972) - lu(k,126) * lu(k,956) + lu(k,983) = lu(k,983) - lu(k,127) * lu(k,956) + lu(k,984) = lu(k,984) - lu(k,128) * lu(k,956) + lu(k,994) = lu(k,994) - lu(k,129) * lu(k,956) + lu(k,997) = lu(k,997) - lu(k,130) * lu(k,956) + lu(k,1712) = lu(k,1712) - lu(k,126) * lu(k,1710) + lu(k,1723) = lu(k,1723) - lu(k,127) * lu(k,1710) + lu(k,1725) = lu(k,1725) - lu(k,128) * lu(k,1710) + lu(k,1736) = lu(k,1736) - lu(k,129) * lu(k,1710) + lu(k,1741) = lu(k,1741) - lu(k,130) * lu(k,1710) + lu(k,131) = 1._r8 / lu(k,131) + lu(k,132) = lu(k,132) * lu(k,131) + lu(k,133) = lu(k,133) * lu(k,131) + lu(k,779) = - lu(k,132) * lu(k,773) + lu(k,795) = lu(k,795) - lu(k,133) * lu(k,773) + lu(k,1266) = lu(k,1266) - lu(k,132) * lu(k,1261) + lu(k,1287) = lu(k,1287) - lu(k,133) * lu(k,1261) + lu(k,1363) = lu(k,1363) - lu(k,132) * lu(k,1345) + lu(k,1389) = lu(k,1389) - lu(k,133) * lu(k,1345) + lu(k,1414) = lu(k,1414) - lu(k,132) * lu(k,1405) + lu(k,1438) = lu(k,1438) - lu(k,133) * lu(k,1405) + lu(k,1906) = lu(k,1906) - lu(k,132) * lu(k,1903) + lu(k,1928) = lu(k,1928) - lu(k,133) * lu(k,1903) + lu(k,134) = 1._r8 / lu(k,134) + lu(k,135) = lu(k,135) * lu(k,134) + lu(k,136) = lu(k,136) * lu(k,134) + lu(k,137) = lu(k,137) * lu(k,134) + lu(k,138) = lu(k,138) * lu(k,134) + lu(k,475) = lu(k,475) - lu(k,135) * lu(k,473) + lu(k,476) = lu(k,476) - lu(k,136) * lu(k,473) + lu(k,481) = lu(k,481) - lu(k,137) * lu(k,473) + lu(k,482) = lu(k,482) - lu(k,138) * lu(k,473) + lu(k,712) = lu(k,712) - lu(k,135) * lu(k,709) + lu(k,713) = lu(k,713) - lu(k,136) * lu(k,709) + lu(k,720) = lu(k,720) - lu(k,137) * lu(k,709) + lu(k,722) = lu(k,722) - lu(k,138) * lu(k,709) + lu(k,1087) = lu(k,1087) - lu(k,135) * lu(k,1085) + lu(k,1091) = lu(k,1091) - lu(k,136) * lu(k,1085) + lu(k,1104) = lu(k,1104) - lu(k,137) * lu(k,1085) + lu(k,1110) = lu(k,1110) - lu(k,138) * lu(k,1085) + lu(k,139) = 1._r8 / lu(k,139) + lu(k,140) = lu(k,140) * lu(k,139) + lu(k,141) = lu(k,141) * lu(k,139) + lu(k,142) = lu(k,142) * lu(k,139) + lu(k,143) = lu(k,143) * lu(k,139) + lu(k,144) = lu(k,144) * lu(k,139) + lu(k,145) = lu(k,145) * lu(k,139) + lu(k,146) = lu(k,146) * lu(k,139) + lu(k,965) = lu(k,965) - lu(k,140) * lu(k,957) + lu(k,966) = lu(k,966) - lu(k,141) * lu(k,957) + lu(k,972) = lu(k,972) - lu(k,142) * lu(k,957) + lu(k,977) = lu(k,977) - lu(k,143) * lu(k,957) + lu(k,984) = lu(k,984) - lu(k,144) * lu(k,957) + lu(k,991) = lu(k,991) - lu(k,145) * lu(k,957) + lu(k,998) = lu(k,998) - lu(k,146) * lu(k,957) + lu(k,1353) = lu(k,1353) - lu(k,140) * lu(k,1346) + lu(k,1354) = - lu(k,141) * lu(k,1346) + lu(k,1360) = - lu(k,142) * lu(k,1346) + lu(k,1367) = lu(k,1367) - lu(k,143) * lu(k,1346) + lu(k,1379) = lu(k,1379) - lu(k,144) * lu(k,1346) + lu(k,1388) = lu(k,1388) - lu(k,145) * lu(k,1346) + lu(k,1397) = lu(k,1397) - lu(k,146) * lu(k,1346) + 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,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,152) = lu(k,152) * lu(k,147) + lu(k,153) = lu(k,153) * lu(k,147) + lu(k,154) = lu(k,154) * lu(k,147) + lu(k,965) = lu(k,965) - lu(k,148) * lu(k,958) + lu(k,975) = lu(k,975) - lu(k,149) * lu(k,958) + lu(k,983) = lu(k,983) - lu(k,150) * lu(k,958) + lu(k,984) = lu(k,984) - lu(k,151) * lu(k,958) + lu(k,993) = lu(k,993) - lu(k,152) * lu(k,958) + lu(k,1004) = lu(k,1004) - lu(k,153) * lu(k,958) + lu(k,1005) = lu(k,1005) - lu(k,154) * lu(k,958) + lu(k,1460) = lu(k,1460) - lu(k,148) * lu(k,1455) + lu(k,1465) = lu(k,1465) - lu(k,149) * lu(k,1455) + lu(k,1474) = lu(k,1474) - lu(k,150) * lu(k,1455) + lu(k,1476) = lu(k,1476) - lu(k,151) * lu(k,1455) + lu(k,1487) = lu(k,1487) - lu(k,152) * lu(k,1455) + lu(k,1500) = lu(k,1500) - lu(k,153) * lu(k,1455) + lu(k,1501) = - lu(k,154) * lu(k,1455) + lu(k,155) = 1._r8 / lu(k,155) + lu(k,156) = lu(k,156) * lu(k,155) + lu(k,157) = lu(k,157) * lu(k,155) + lu(k,158) = lu(k,158) * lu(k,155) + lu(k,159) = lu(k,159) * lu(k,155) + lu(k,160) = lu(k,160) * lu(k,155) + lu(k,432) = lu(k,432) - lu(k,156) * lu(k,431) + lu(k,433) = lu(k,433) - lu(k,157) * lu(k,431) + lu(k,435) = - lu(k,158) * lu(k,431) + lu(k,439) = - lu(k,159) * lu(k,431) + lu(k,442) = - lu(k,160) * lu(k,431) + lu(k,894) = lu(k,894) - lu(k,156) * lu(k,887) + lu(k,898) = - lu(k,157) * lu(k,887) + lu(k,901) = lu(k,901) - lu(k,158) * lu(k,887) + lu(k,914) = lu(k,914) - lu(k,159) * lu(k,887) + lu(k,921) = lu(k,921) - lu(k,160) * lu(k,887) + lu(k,975) = lu(k,975) - lu(k,156) * lu(k,959) + lu(k,981) = lu(k,981) - lu(k,157) * lu(k,959) + lu(k,984) = lu(k,984) - lu(k,158) * lu(k,959) + lu(k,998) = lu(k,998) - lu(k,159) * lu(k,959) + lu(k,1005) = lu(k,1005) - lu(k,160) * lu(k,959) + lu(k,161) = 1._r8 / lu(k,161) + lu(k,162) = lu(k,162) * lu(k,161) + lu(k,163) = lu(k,163) * lu(k,161) + lu(k,164) = lu(k,164) * lu(k,161) + lu(k,165) = lu(k,165) * lu(k,161) + lu(k,166) = lu(k,166) * lu(k,161) + lu(k,783) = lu(k,783) - lu(k,162) * lu(k,774) + lu(k,787) = lu(k,787) - lu(k,163) * lu(k,774) + lu(k,789) = lu(k,789) - lu(k,164) * lu(k,774) + lu(k,796) = lu(k,796) - lu(k,165) * lu(k,774) + lu(k,807) = lu(k,807) - lu(k,166) * lu(k,774) + lu(k,978) = lu(k,978) - lu(k,162) * lu(k,960) + lu(k,982) = lu(k,982) - lu(k,163) * lu(k,960) + lu(k,984) = lu(k,984) - lu(k,164) * lu(k,960) + lu(k,993) = lu(k,993) - lu(k,165) * lu(k,960) + lu(k,1004) = lu(k,1004) - lu(k,166) * lu(k,960) + lu(k,1466) = lu(k,1466) - lu(k,162) * lu(k,1456) + lu(k,1470) = - lu(k,163) * lu(k,1456) + lu(k,1476) = lu(k,1476) - lu(k,164) * lu(k,1456) + lu(k,1487) = lu(k,1487) - lu(k,165) * lu(k,1456) + lu(k,1500) = lu(k,1500) - lu(k,166) * lu(k,1456) + lu(k,167) = 1._r8 / lu(k,167) + lu(k,168) = lu(k,168) * lu(k,167) + lu(k,169) = lu(k,169) * lu(k,167) + lu(k,170) = lu(k,170) * lu(k,167) + lu(k,171) = lu(k,171) * lu(k,167) + lu(k,172) = lu(k,172) * lu(k,167) + lu(k,290) = - lu(k,168) * lu(k,289) + lu(k,293) = lu(k,293) - lu(k,169) * lu(k,289) + lu(k,294) = lu(k,294) - lu(k,170) * lu(k,289) + lu(k,298) = - lu(k,171) * lu(k,289) + lu(k,299) = lu(k,299) - lu(k,172) * lu(k,289) + lu(k,1044) = lu(k,1044) - lu(k,168) * lu(k,1039) + lu(k,1057) = lu(k,1057) - lu(k,169) * lu(k,1039) + lu(k,1058) = lu(k,1058) - lu(k,170) * lu(k,1039) + lu(k,1074) = lu(k,1074) - lu(k,171) * lu(k,1039) + lu(k,1081) = lu(k,1081) - lu(k,172) * lu(k,1039) + lu(k,2038) = lu(k,2038) - lu(k,168) * lu(k,2036) + lu(k,2065) = lu(k,2065) - lu(k,169) * lu(k,2036) + lu(k,2067) = - lu(k,170) * lu(k,2036) + lu(k,2083) = lu(k,2083) - lu(k,171) * lu(k,2036) + lu(k,2090) = lu(k,2090) - lu(k,172) * lu(k,2036) + lu(k,173) = 1._r8 / lu(k,173) + lu(k,174) = lu(k,174) * lu(k,173) + lu(k,175) = lu(k,175) * lu(k,173) + lu(k,176) = lu(k,176) * lu(k,173) + lu(k,177) = lu(k,177) * lu(k,173) + lu(k,178) = lu(k,178) * lu(k,173) + lu(k,1047) = - lu(k,174) * lu(k,1040) + lu(k,1058) = lu(k,1058) - lu(k,175) * lu(k,1040) + lu(k,1062) = lu(k,1062) - lu(k,176) * lu(k,1040) + lu(k,1079) = lu(k,1079) - lu(k,177) * lu(k,1040) + lu(k,1081) = lu(k,1081) - lu(k,178) * lu(k,1040) + lu(k,1176) = - lu(k,174) * lu(k,1175) + lu(k,1194) = lu(k,1194) - lu(k,175) * lu(k,1175) + lu(k,1198) = - lu(k,176) * lu(k,1175) + lu(k,1215) = lu(k,1215) - lu(k,177) * lu(k,1175) + lu(k,1217) = lu(k,1217) - lu(k,178) * lu(k,1175) + lu(k,2041) = lu(k,2041) - lu(k,174) * lu(k,2037) + lu(k,2067) = lu(k,2067) - lu(k,175) * lu(k,2037) + lu(k,2071) = lu(k,2071) - lu(k,176) * lu(k,2037) + lu(k,2088) = - lu(k,177) * lu(k,2037) + lu(k,2090) = lu(k,2090) - lu(k,178) * lu(k,2037) + lu(k,179) = 1._r8 / lu(k,179) + lu(k,180) = lu(k,180) * lu(k,179) + lu(k,181) = lu(k,181) * lu(k,179) + lu(k,182) = lu(k,182) * lu(k,179) + lu(k,183) = lu(k,183) * lu(k,179) + lu(k,184) = lu(k,184) * lu(k,179) + lu(k,185) = lu(k,185) * lu(k,179) + lu(k,900) = lu(k,900) - lu(k,180) * lu(k,888) + lu(k,901) = lu(k,901) - lu(k,181) * lu(k,888) + lu(k,908) = lu(k,908) - lu(k,182) * lu(k,888) + lu(k,913) = lu(k,913) - lu(k,183) * lu(k,888) + lu(k,915) = lu(k,915) - lu(k,184) * lu(k,888) + lu(k,921) = lu(k,921) - lu(k,185) * lu(k,888) + lu(k,983) = lu(k,983) - lu(k,180) * lu(k,961) + lu(k,984) = lu(k,984) - lu(k,181) * lu(k,961) + lu(k,992) = lu(k,992) - lu(k,182) * lu(k,961) + lu(k,997) = lu(k,997) - lu(k,183) * lu(k,961) + lu(k,999) = lu(k,999) - lu(k,184) * lu(k,961) + lu(k,1005) = lu(k,1005) - lu(k,185) * lu(k,961) + lu(k,1806) = lu(k,1806) - lu(k,180) * lu(k,1787) + lu(k,1808) = lu(k,1808) - lu(k,181) * lu(k,1787) + lu(k,1818) = lu(k,1818) - lu(k,182) * lu(k,1787) + lu(k,1825) = lu(k,1825) - lu(k,183) * lu(k,1787) + lu(k,1827) = lu(k,1827) - lu(k,184) * lu(k,1787) + lu(k,1833) = lu(k,1833) - lu(k,185) * lu(k,1787) + 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,186) = 1._r8 / lu(k,186) + lu(k,187) = lu(k,187) * lu(k,186) + lu(k,188) = lu(k,188) * lu(k,186) + lu(k,189) = lu(k,189) * lu(k,186) + lu(k,190) = lu(k,190) * lu(k,186) + lu(k,191) = lu(k,191) * lu(k,186) + lu(k,192) = lu(k,192) * lu(k,186) + lu(k,783) = lu(k,783) - lu(k,187) * lu(k,775) + lu(k,787) = lu(k,787) - lu(k,188) * lu(k,775) + lu(k,789) = lu(k,789) - lu(k,189) * lu(k,775) + lu(k,796) = lu(k,796) - lu(k,190) * lu(k,775) + lu(k,807) = lu(k,807) - lu(k,191) * lu(k,775) + lu(k,808) = lu(k,808) - lu(k,192) * lu(k,775) + lu(k,978) = lu(k,978) - lu(k,187) * lu(k,962) + lu(k,982) = lu(k,982) - lu(k,188) * lu(k,962) + lu(k,984) = lu(k,984) - lu(k,189) * lu(k,962) + lu(k,993) = lu(k,993) - lu(k,190) * lu(k,962) + lu(k,1004) = lu(k,1004) - lu(k,191) * lu(k,962) + lu(k,1005) = lu(k,1005) - lu(k,192) * lu(k,962) + lu(k,1466) = lu(k,1466) - lu(k,187) * lu(k,1457) + lu(k,1470) = lu(k,1470) - lu(k,188) * lu(k,1457) + lu(k,1476) = lu(k,1476) - lu(k,189) * lu(k,1457) + lu(k,1487) = lu(k,1487) - lu(k,190) * lu(k,1457) + lu(k,1500) = lu(k,1500) - lu(k,191) * lu(k,1457) + lu(k,1501) = lu(k,1501) - lu(k,192) * lu(k,1457) + lu(k,193) = 1._r8 / lu(k,193) + lu(k,194) = lu(k,194) * lu(k,193) + lu(k,195) = lu(k,195) * lu(k,193) + lu(k,196) = lu(k,196) * lu(k,193) + lu(k,197) = lu(k,197) * lu(k,193) + lu(k,198) = lu(k,198) * lu(k,193) + lu(k,199) = lu(k,199) * lu(k,193) + lu(k,1042) = lu(k,1042) - lu(k,194) * lu(k,1041) + lu(k,1043) = lu(k,1043) - lu(k,195) * lu(k,1041) + lu(k,1051) = - lu(k,196) * lu(k,1041) + lu(k,1052) = lu(k,1052) - lu(k,197) * lu(k,1041) + lu(k,1065) = lu(k,1065) - lu(k,198) * lu(k,1041) + lu(k,1079) = lu(k,1079) - lu(k,199) * lu(k,1041) + lu(k,1348) = lu(k,1348) - lu(k,194) * lu(k,1347) + lu(k,1351) = lu(k,1351) - lu(k,195) * lu(k,1347) + lu(k,1357) = lu(k,1357) - lu(k,196) * lu(k,1347) + lu(k,1364) = lu(k,1364) - lu(k,197) * lu(k,1347) + lu(k,1388) = lu(k,1388) - lu(k,198) * lu(k,1347) + lu(k,1402) = lu(k,1402) - lu(k,199) * lu(k,1347) + lu(k,1407) = lu(k,1407) - lu(k,194) * lu(k,1406) + lu(k,1408) = lu(k,1408) - lu(k,195) * lu(k,1406) + lu(k,1412) = lu(k,1412) - lu(k,196) * lu(k,1406) + lu(k,1415) = lu(k,1415) - lu(k,197) * lu(k,1406) + lu(k,1437) = lu(k,1437) - lu(k,198) * lu(k,1406) + lu(k,1451) = lu(k,1451) - lu(k,199) * lu(k,1406) + 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,1043) = lu(k,1043) - lu(k,201) * lu(k,1042) + lu(k,1052) = lu(k,1052) - lu(k,202) * lu(k,1042) + lu(k,1065) = lu(k,1065) - lu(k,203) * lu(k,1042) + lu(k,1066) = lu(k,1066) - lu(k,204) * lu(k,1042) + lu(k,1070) = lu(k,1070) - lu(k,205) * lu(k,1042) + lu(k,1351) = lu(k,1351) - lu(k,201) * lu(k,1348) + lu(k,1364) = lu(k,1364) - lu(k,202) * lu(k,1348) + lu(k,1388) = lu(k,1388) - lu(k,203) * lu(k,1348) + lu(k,1389) = lu(k,1389) - lu(k,204) * lu(k,1348) + lu(k,1393) = lu(k,1393) - lu(k,205) * lu(k,1348) + lu(k,1408) = lu(k,1408) - lu(k,201) * lu(k,1407) + lu(k,1415) = lu(k,1415) - lu(k,202) * lu(k,1407) + lu(k,1437) = lu(k,1437) - lu(k,203) * lu(k,1407) + lu(k,1438) = lu(k,1438) - lu(k,204) * lu(k,1407) + lu(k,1442) = lu(k,1442) - lu(k,205) * lu(k,1407) + 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,212) = lu(k,212) * lu(k,206) + lu(k,213) = lu(k,213) * lu(k,206) + lu(k,711) = lu(k,711) - lu(k,207) * lu(k,710) + lu(k,714) = lu(k,714) - lu(k,208) * lu(k,710) + lu(k,715) = lu(k,715) - lu(k,209) * lu(k,710) + lu(k,722) = lu(k,722) - lu(k,210) * lu(k,710) + lu(k,725) = - lu(k,211) * lu(k,710) + lu(k,726) = - lu(k,212) * lu(k,710) + lu(k,728) = lu(k,728) - lu(k,213) * lu(k,710) + lu(k,1356) = lu(k,1356) - lu(k,207) * lu(k,1349) + lu(k,1368) = lu(k,1368) - lu(k,208) * lu(k,1349) + lu(k,1371) = lu(k,1371) - lu(k,209) * lu(k,1349) + lu(k,1388) = lu(k,1388) - lu(k,210) * lu(k,1349) + lu(k,1391) = - lu(k,211) * lu(k,1349) + lu(k,1396) = lu(k,1396) - lu(k,212) * lu(k,1349) + lu(k,1398) = lu(k,1398) - lu(k,213) * lu(k,1349) + lu(k,1789) = - lu(k,207) * lu(k,1788) + lu(k,1795) = - lu(k,208) * lu(k,1788) + lu(k,1801) = lu(k,1801) - lu(k,209) * lu(k,1788) + lu(k,1817) = lu(k,1817) - lu(k,210) * lu(k,1788) + lu(k,1820) = lu(k,1820) - lu(k,211) * lu(k,1788) + lu(k,1825) = lu(k,1825) - lu(k,212) * lu(k,1788) + lu(k,1827) = lu(k,1827) - lu(k,213) * lu(k,1788) + lu(k,214) = 1._r8 / lu(k,214) + lu(k,215) = lu(k,215) * lu(k,214) + lu(k,216) = lu(k,216) * lu(k,214) + lu(k,217) = lu(k,217) * lu(k,214) + lu(k,218) = lu(k,218) * lu(k,214) + lu(k,219) = lu(k,219) * lu(k,214) + lu(k,220) = lu(k,220) * lu(k,214) + lu(k,900) = lu(k,900) - lu(k,215) * lu(k,889) + lu(k,901) = lu(k,901) - lu(k,216) * lu(k,889) + lu(k,907) = lu(k,907) - lu(k,217) * lu(k,889) + lu(k,909) = lu(k,909) - lu(k,218) * lu(k,889) + lu(k,920) = lu(k,920) - lu(k,219) * lu(k,889) + lu(k,921) = lu(k,921) - lu(k,220) * lu(k,889) + lu(k,983) = lu(k,983) - lu(k,215) * lu(k,963) + lu(k,984) = lu(k,984) - lu(k,216) * lu(k,963) + lu(k,991) = lu(k,991) - lu(k,217) * lu(k,963) + lu(k,993) = lu(k,993) - lu(k,218) * lu(k,963) + lu(k,1004) = lu(k,1004) - lu(k,219) * lu(k,963) + lu(k,1005) = lu(k,1005) - lu(k,220) * lu(k,963) + lu(k,1377) = lu(k,1377) - lu(k,215) * lu(k,1350) + lu(k,1379) = lu(k,1379) - lu(k,216) * lu(k,1350) + lu(k,1388) = lu(k,1388) - lu(k,217) * lu(k,1350) + lu(k,1390) = lu(k,1390) - lu(k,218) * lu(k,1350) + lu(k,1403) = lu(k,1403) - lu(k,219) * lu(k,1350) + lu(k,1404) = - lu(k,220) * lu(k,1350) + lu(k,1474) = lu(k,1474) - lu(k,215) * lu(k,1458) + lu(k,1476) = lu(k,1476) - lu(k,216) * lu(k,1458) + lu(k,1485) = lu(k,1485) - lu(k,217) * lu(k,1458) + lu(k,1487) = lu(k,1487) - lu(k,218) * lu(k,1458) + lu(k,1500) = lu(k,1500) - lu(k,219) * lu(k,1458) + lu(k,1501) = lu(k,1501) - lu(k,220) * lu(k,1458) + lu(k,221) = 1._r8 / lu(k,221) + lu(k,222) = lu(k,222) * lu(k,221) + lu(k,223) = lu(k,223) * lu(k,221) + lu(k,224) = lu(k,224) * lu(k,221) + lu(k,225) = lu(k,225) * lu(k,221) + lu(k,226) = lu(k,226) * lu(k,221) + lu(k,227) = lu(k,227) * lu(k,221) + lu(k,228) = lu(k,228) * lu(k,221) + lu(k,229) = lu(k,229) * lu(k,221) + lu(k,781) = lu(k,781) - lu(k,222) * lu(k,776) + lu(k,783) = lu(k,783) - lu(k,223) * lu(k,776) + lu(k,787) = lu(k,787) - lu(k,224) * lu(k,776) + lu(k,788) = lu(k,788) - lu(k,225) * lu(k,776) + lu(k,789) = lu(k,789) - lu(k,226) * lu(k,776) + lu(k,796) = lu(k,796) - lu(k,227) * lu(k,776) + lu(k,807) = lu(k,807) - lu(k,228) * lu(k,776) + lu(k,808) = lu(k,808) - lu(k,229) * lu(k,776) + lu(k,975) = lu(k,975) - lu(k,222) * lu(k,964) + lu(k,978) = lu(k,978) - lu(k,223) * lu(k,964) + lu(k,982) = lu(k,982) - lu(k,224) * lu(k,964) + lu(k,983) = lu(k,983) - lu(k,225) * lu(k,964) + lu(k,984) = lu(k,984) - lu(k,226) * lu(k,964) + lu(k,993) = lu(k,993) - lu(k,227) * lu(k,964) + lu(k,1004) = lu(k,1004) - lu(k,228) * lu(k,964) + lu(k,1005) = lu(k,1005) - lu(k,229) * lu(k,964) + lu(k,1465) = lu(k,1465) - lu(k,222) * lu(k,1459) + lu(k,1466) = lu(k,1466) - lu(k,223) * lu(k,1459) + lu(k,1470) = lu(k,1470) - lu(k,224) * lu(k,1459) + lu(k,1474) = lu(k,1474) - lu(k,225) * lu(k,1459) + lu(k,1476) = lu(k,1476) - lu(k,226) * lu(k,1459) + lu(k,1487) = lu(k,1487) - lu(k,227) * lu(k,1459) + lu(k,1500) = lu(k,1500) - lu(k,228) * lu(k,1459) + lu(k,1501) = lu(k,1501) - lu(k,229) * lu(k,1459) + 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,230) = 1._r8 / lu(k,230) + lu(k,231) = lu(k,231) * lu(k,230) + lu(k,232) = lu(k,232) * lu(k,230) + lu(k,233) = lu(k,233) * lu(k,230) + lu(k,234) = lu(k,234) * lu(k,230) + lu(k,235) = lu(k,235) * lu(k,230) + lu(k,236) = lu(k,236) * lu(k,230) + lu(k,237) = lu(k,237) * lu(k,230) + lu(k,238) = lu(k,238) * lu(k,230) + lu(k,1050) = lu(k,1050) - lu(k,231) * lu(k,1043) + lu(k,1052) = lu(k,1052) - lu(k,232) * lu(k,1043) + lu(k,1053) = lu(k,1053) - lu(k,233) * lu(k,1043) + lu(k,1058) = lu(k,1058) - lu(k,234) * lu(k,1043) + lu(k,1060) = lu(k,1060) - lu(k,235) * lu(k,1043) + lu(k,1065) = lu(k,1065) - lu(k,236) * lu(k,1043) + lu(k,1066) = lu(k,1066) - lu(k,237) * lu(k,1043) + lu(k,1070) = lu(k,1070) - lu(k,238) * lu(k,1043) + lu(k,1355) = lu(k,1355) - lu(k,231) * lu(k,1351) + lu(k,1364) = lu(k,1364) - lu(k,232) * lu(k,1351) + lu(k,1365) = lu(k,1365) - lu(k,233) * lu(k,1351) + lu(k,1381) = lu(k,1381) - lu(k,234) * lu(k,1351) + lu(k,1383) = lu(k,1383) - lu(k,235) * lu(k,1351) + lu(k,1388) = lu(k,1388) - lu(k,236) * lu(k,1351) + lu(k,1389) = lu(k,1389) - lu(k,237) * lu(k,1351) + lu(k,1393) = lu(k,1393) - lu(k,238) * lu(k,1351) + lu(k,1411) = lu(k,1411) - lu(k,231) * lu(k,1408) + lu(k,1415) = lu(k,1415) - lu(k,232) * lu(k,1408) + lu(k,1416) = lu(k,1416) - lu(k,233) * lu(k,1408) + lu(k,1430) = lu(k,1430) - lu(k,234) * lu(k,1408) + lu(k,1432) = lu(k,1432) - lu(k,235) * lu(k,1408) + lu(k,1437) = lu(k,1437) - lu(k,236) * lu(k,1408) + lu(k,1438) = lu(k,1438) - lu(k,237) * lu(k,1408) + lu(k,1442) = lu(k,1442) - lu(k,238) * lu(k,1408) + lu(k,239) = 1._r8 / lu(k,239) + lu(k,240) = lu(k,240) * lu(k,239) + lu(k,241) = lu(k,241) * lu(k,239) + lu(k,242) = lu(k,242) * lu(k,239) + lu(k,243) = lu(k,243) * lu(k,239) + lu(k,244) = lu(k,244) * lu(k,239) + lu(k,245) = lu(k,245) * lu(k,239) + lu(k,1271) = lu(k,1271) - lu(k,240) * lu(k,1262) + lu(k,1273) = lu(k,1273) - lu(k,241) * lu(k,1262) + lu(k,1284) = lu(k,1284) - lu(k,242) * lu(k,1262) + lu(k,1286) = lu(k,1286) - lu(k,243) * lu(k,1262) + lu(k,1287) = lu(k,1287) - lu(k,244) * lu(k,1262) + lu(k,1290) = lu(k,1290) - lu(k,245) * lu(k,1262) + lu(k,1369) = lu(k,1369) - lu(k,240) * lu(k,1352) + lu(k,1375) = lu(k,1375) - lu(k,241) * lu(k,1352) + lu(k,1386) = lu(k,1386) - lu(k,242) * lu(k,1352) + lu(k,1388) = lu(k,1388) - lu(k,243) * lu(k,1352) + lu(k,1389) = lu(k,1389) - lu(k,244) * lu(k,1352) + lu(k,1392) = lu(k,1392) - lu(k,245) * lu(k,1352) + lu(k,1420) = lu(k,1420) - lu(k,240) * lu(k,1409) + lu(k,1424) = - lu(k,241) * lu(k,1409) + lu(k,1435) = lu(k,1435) - lu(k,242) * lu(k,1409) + lu(k,1437) = lu(k,1437) - lu(k,243) * lu(k,1409) + lu(k,1438) = lu(k,1438) - lu(k,244) * lu(k,1409) + lu(k,1441) = lu(k,1441) - lu(k,245) * lu(k,1409) + lu(k,1547) = lu(k,1547) - lu(k,240) * lu(k,1543) + lu(k,1549) = lu(k,1549) - lu(k,241) * lu(k,1543) + lu(k,1560) = lu(k,1560) - lu(k,242) * lu(k,1543) + lu(k,1562) = lu(k,1562) - lu(k,243) * lu(k,1543) + lu(k,1563) = lu(k,1563) - lu(k,244) * lu(k,1543) + lu(k,1566) = lu(k,1566) - lu(k,245) * lu(k,1543) + lu(k,246) = 1._r8 / lu(k,246) + lu(k,247) = lu(k,247) * lu(k,246) + lu(k,248) = lu(k,248) * lu(k,246) + lu(k,249) = lu(k,249) * lu(k,246) + lu(k,250) = lu(k,250) * lu(k,246) + lu(k,251) = lu(k,251) * lu(k,246) + lu(k,284) = lu(k,284) - lu(k,247) * lu(k,283) + lu(k,285) = lu(k,285) - lu(k,248) * lu(k,283) + lu(k,286) = - lu(k,249) * lu(k,283) + lu(k,287) = lu(k,287) - lu(k,250) * lu(k,283) + lu(k,288) = lu(k,288) - lu(k,251) * lu(k,283) + lu(k,291) = lu(k,291) - lu(k,247) * lu(k,290) + lu(k,294) = lu(k,294) - lu(k,248) * lu(k,290) + lu(k,295) = - lu(k,249) * lu(k,290) + lu(k,298) = lu(k,298) - lu(k,250) * lu(k,290) + lu(k,299) = lu(k,299) - lu(k,251) * lu(k,290) + lu(k,1048) = lu(k,1048) - lu(k,247) * lu(k,1044) + lu(k,1058) = lu(k,1058) - lu(k,248) * lu(k,1044) + lu(k,1062) = lu(k,1062) - lu(k,249) * lu(k,1044) + lu(k,1074) = lu(k,1074) - lu(k,250) * lu(k,1044) + lu(k,1081) = lu(k,1081) - lu(k,251) * lu(k,1044) + lu(k,1219) = - lu(k,247) * lu(k,1218) + lu(k,1237) = lu(k,1237) - lu(k,248) * lu(k,1218) + lu(k,1241) = lu(k,1241) - lu(k,249) * lu(k,1218) + lu(k,1253) = lu(k,1253) - lu(k,250) * lu(k,1218) + lu(k,1260) = lu(k,1260) - lu(k,251) * lu(k,1218) + lu(k,2042) = lu(k,2042) - lu(k,247) * lu(k,2038) + lu(k,2067) = lu(k,2067) - lu(k,248) * lu(k,2038) + lu(k,2071) = lu(k,2071) - lu(k,249) * lu(k,2038) + lu(k,2083) = lu(k,2083) - lu(k,250) * lu(k,2038) + lu(k,2090) = lu(k,2090) - lu(k,251) * lu(k,2038) + 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,391) = - lu(k,253) * lu(k,385) + lu(k,392) = - lu(k,254) * lu(k,385) + lu(k,394) = lu(k,394) - lu(k,255) * lu(k,385) + lu(k,421) = lu(k,421) - lu(k,253) * lu(k,414) + lu(k,422) = lu(k,422) - lu(k,254) * lu(k,414) + lu(k,423) = lu(k,423) - lu(k,255) * lu(k,414) + lu(k,586) = lu(k,586) - lu(k,253) * lu(k,580) + lu(k,587) = - lu(k,254) * lu(k,580) + lu(k,588) = - lu(k,255) * lu(k,580) + lu(k,740) = lu(k,740) - lu(k,253) * lu(k,733) + lu(k,741) = lu(k,741) - lu(k,254) * lu(k,733) + lu(k,744) = - lu(k,255) * lu(k,733) + lu(k,983) = lu(k,983) - lu(k,253) * lu(k,965) + lu(k,984) = lu(k,984) - lu(k,254) * lu(k,965) + lu(k,989) = lu(k,989) - lu(k,255) * lu(k,965) + lu(k,1275) = - lu(k,253) * lu(k,1263) + lu(k,1277) = - lu(k,254) * lu(k,1263) + lu(k,1284) = lu(k,1284) - lu(k,255) * lu(k,1263) + lu(k,1377) = lu(k,1377) - lu(k,253) * lu(k,1353) + lu(k,1379) = lu(k,1379) - lu(k,254) * lu(k,1353) + lu(k,1386) = lu(k,1386) - lu(k,255) * lu(k,1353) + lu(k,1474) = lu(k,1474) - lu(k,253) * lu(k,1460) + lu(k,1476) = lu(k,1476) - lu(k,254) * lu(k,1460) + lu(k,1483) = lu(k,1483) - lu(k,255) * lu(k,1460) + lu(k,1723) = lu(k,1723) - lu(k,253) * lu(k,1711) + lu(k,1725) = lu(k,1725) - lu(k,254) * lu(k,1711) + lu(k,1731) = - lu(k,255) * lu(k,1711) + lu(k,256) = 1._r8 / lu(k,256) + lu(k,257) = lu(k,257) * lu(k,256) + lu(k,258) = lu(k,258) * lu(k,256) + lu(k,259) = lu(k,259) * lu(k,256) + lu(k,260) = lu(k,260) * lu(k,256) + lu(k,261) = lu(k,261) * lu(k,256) + lu(k,262) = lu(k,262) * lu(k,256) + lu(k,263) = lu(k,263) * lu(k,256) + lu(k,1046) = lu(k,1046) - lu(k,257) * lu(k,1045) + lu(k,1058) = lu(k,1058) - lu(k,258) * lu(k,1045) + lu(k,1060) = lu(k,1060) - lu(k,259) * lu(k,1045) + lu(k,1063) = lu(k,1063) - lu(k,260) * lu(k,1045) + lu(k,1064) = lu(k,1064) - lu(k,261) * lu(k,1045) + lu(k,1079) = lu(k,1079) - lu(k,262) * lu(k,1045) + lu(k,1081) = lu(k,1081) - lu(k,263) * lu(k,1045) + lu(k,1128) = lu(k,1128) - lu(k,257) * lu(k,1127) + lu(k,1151) = lu(k,1151) - lu(k,258) * lu(k,1127) + lu(k,1153) = lu(k,1153) - lu(k,259) * lu(k,1127) + lu(k,1156) = lu(k,1156) - lu(k,260) * lu(k,1127) + lu(k,1157) = lu(k,1157) - lu(k,261) * lu(k,1127) + lu(k,1172) = lu(k,1172) - lu(k,262) * lu(k,1127) + lu(k,1174) = lu(k,1174) - lu(k,263) * lu(k,1127) + lu(k,1265) = lu(k,1265) - lu(k,257) * lu(k,1264) + lu(k,1279) = - lu(k,258) * lu(k,1264) + lu(k,1281) = lu(k,1281) - lu(k,259) * lu(k,1264) + lu(k,1284) = lu(k,1284) - lu(k,260) * lu(k,1264) + lu(k,1285) = - lu(k,261) * lu(k,1264) + lu(k,1300) = - lu(k,262) * lu(k,1264) + lu(k,1302) = - lu(k,263) * lu(k,1264) + lu(k,2040) = lu(k,2040) - lu(k,257) * lu(k,2039) + lu(k,2067) = lu(k,2067) - lu(k,258) * lu(k,2039) + lu(k,2069) = lu(k,2069) - lu(k,259) * lu(k,2039) + lu(k,2072) = lu(k,2072) - lu(k,260) * lu(k,2039) + lu(k,2073) = lu(k,2073) - lu(k,261) * lu(k,2039) + lu(k,2088) = lu(k,2088) - lu(k,262) * lu(k,2039) + lu(k,2090) = lu(k,2090) - lu(k,263) * lu(k,2039) + lu(k,264) = 1._r8 / lu(k,264) + lu(k,265) = lu(k,265) * lu(k,264) + lu(k,266) = lu(k,266) * lu(k,264) + lu(k,267) = lu(k,267) * lu(k,264) + lu(k,268) = lu(k,268) * lu(k,264) + lu(k,269) = lu(k,269) * lu(k,264) + lu(k,270) = lu(k,270) * lu(k,264) + lu(k,1058) = lu(k,1058) - lu(k,265) * lu(k,1046) + lu(k,1060) = lu(k,1060) - lu(k,266) * lu(k,1046) + lu(k,1063) = lu(k,1063) - lu(k,267) * lu(k,1046) + lu(k,1064) = lu(k,1064) - lu(k,268) * lu(k,1046) + lu(k,1079) = lu(k,1079) - lu(k,269) * lu(k,1046) + lu(k,1081) = lu(k,1081) - lu(k,270) * lu(k,1046) + lu(k,1151) = lu(k,1151) - lu(k,265) * lu(k,1128) + lu(k,1153) = lu(k,1153) - lu(k,266) * lu(k,1128) + lu(k,1156) = lu(k,1156) - lu(k,267) * lu(k,1128) + lu(k,1157) = lu(k,1157) - lu(k,268) * lu(k,1128) + lu(k,1172) = lu(k,1172) - lu(k,269) * lu(k,1128) + lu(k,1174) = lu(k,1174) - lu(k,270) * lu(k,1128) + lu(k,1279) = lu(k,1279) - lu(k,265) * lu(k,1265) + lu(k,1281) = lu(k,1281) - lu(k,266) * lu(k,1265) + lu(k,1284) = lu(k,1284) - lu(k,267) * lu(k,1265) + lu(k,1285) = lu(k,1285) - lu(k,268) * lu(k,1265) + lu(k,1300) = lu(k,1300) - lu(k,269) * lu(k,1265) + lu(k,1302) = lu(k,1302) - lu(k,270) * lu(k,1265) + lu(k,2067) = lu(k,2067) - lu(k,265) * lu(k,2040) + lu(k,2069) = lu(k,2069) - lu(k,266) * lu(k,2040) + lu(k,2072) = lu(k,2072) - lu(k,267) * lu(k,2040) + lu(k,2073) = lu(k,2073) - lu(k,268) * lu(k,2040) + lu(k,2088) = lu(k,2088) - lu(k,269) * lu(k,2040) + lu(k,2090) = lu(k,2090) - lu(k,270) * lu(k,2040) + 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,271) = 1._r8 / lu(k,271) + lu(k,272) = lu(k,272) * lu(k,271) + lu(k,273) = lu(k,273) * lu(k,271) + lu(k,274) = lu(k,274) * lu(k,271) + lu(k,275) = lu(k,275) * lu(k,271) + lu(k,276) = lu(k,276) * lu(k,271) + lu(k,277) = lu(k,277) * lu(k,271) + lu(k,476) = lu(k,476) - lu(k,272) * lu(k,474) + lu(k,480) = lu(k,480) - lu(k,273) * lu(k,474) + lu(k,482) = lu(k,482) - lu(k,274) * lu(k,474) + lu(k,483) = lu(k,483) - lu(k,275) * lu(k,474) + lu(k,485) = lu(k,485) - lu(k,276) * lu(k,474) + lu(k,487) = lu(k,487) - lu(k,277) * lu(k,474) + lu(k,977) = lu(k,977) - lu(k,272) * lu(k,966) + lu(k,984) = lu(k,984) - lu(k,273) * lu(k,966) + lu(k,991) = lu(k,991) - lu(k,274) * lu(k,966) + lu(k,992) = lu(k,992) - lu(k,275) * lu(k,966) + lu(k,998) = lu(k,998) - lu(k,276) * lu(k,966) + lu(k,1002) = lu(k,1002) - lu(k,277) * lu(k,966) + lu(k,1367) = lu(k,1367) - lu(k,272) * lu(k,1354) + lu(k,1379) = lu(k,1379) - lu(k,273) * lu(k,1354) + lu(k,1388) = lu(k,1388) - lu(k,274) * lu(k,1354) + lu(k,1389) = lu(k,1389) - lu(k,275) * lu(k,1354) + lu(k,1397) = lu(k,1397) - lu(k,276) * lu(k,1354) + lu(k,1401) = lu(k,1401) - lu(k,277) * lu(k,1354) + lu(k,1418) = lu(k,1418) - lu(k,272) * lu(k,1410) + lu(k,1428) = - lu(k,273) * lu(k,1410) + lu(k,1437) = lu(k,1437) - lu(k,274) * lu(k,1410) + lu(k,1438) = lu(k,1438) - lu(k,275) * lu(k,1410) + lu(k,1446) = lu(k,1446) - lu(k,276) * lu(k,1410) + lu(k,1450) = lu(k,1450) - lu(k,277) * lu(k,1410) + lu(k,1908) = lu(k,1908) - lu(k,272) * lu(k,1904) + lu(k,1918) = lu(k,1918) - lu(k,273) * lu(k,1904) + lu(k,1927) = lu(k,1927) - lu(k,274) * lu(k,1904) + lu(k,1928) = lu(k,1928) - lu(k,275) * lu(k,1904) + lu(k,1936) = lu(k,1936) - lu(k,276) * lu(k,1904) + lu(k,1940) = lu(k,1940) - lu(k,277) * lu(k,1904) + lu(k,278) = 1._r8 / lu(k,278) + lu(k,279) = lu(k,279) * lu(k,278) + lu(k,280) = lu(k,280) * lu(k,278) + lu(k,281) = lu(k,281) * lu(k,278) + lu(k,282) = lu(k,282) * lu(k,278) + lu(k,927) = - lu(k,279) * lu(k,922) + lu(k,943) = lu(k,943) - lu(k,280) * lu(k,922) + lu(k,946) = lu(k,946) - lu(k,281) * lu(k,922) + lu(k,948) = lu(k,948) - lu(k,282) * lu(k,922) + lu(k,984) = lu(k,984) - lu(k,279) * lu(k,967) + lu(k,999) = lu(k,999) - lu(k,280) * lu(k,967) + lu(k,1003) = lu(k,1003) - lu(k,281) * lu(k,967) + lu(k,1005) = lu(k,1005) - lu(k,282) * lu(k,967) + lu(k,1057) = lu(k,1057) - lu(k,279) * lu(k,1047) + lu(k,1075) = - lu(k,280) * lu(k,1047) + lu(k,1079) = lu(k,1079) - lu(k,281) * lu(k,1047) + lu(k,1081) = lu(k,1081) - lu(k,282) * lu(k,1047) + lu(k,1192) = lu(k,1192) - lu(k,279) * lu(k,1176) + lu(k,1211) = lu(k,1211) - lu(k,280) * lu(k,1176) + lu(k,1215) = lu(k,1215) - lu(k,281) * lu(k,1176) + lu(k,1217) = lu(k,1217) - lu(k,282) * lu(k,1176) + lu(k,1517) = lu(k,1517) - lu(k,279) * lu(k,1503) + lu(k,1536) = lu(k,1536) - lu(k,280) * lu(k,1503) + lu(k,1540) = - lu(k,281) * lu(k,1503) + lu(k,1542) = lu(k,1542) - lu(k,282) * lu(k,1503) + lu(k,1960) = lu(k,1960) - lu(k,279) * lu(k,1944) + lu(k,1979) = lu(k,1979) - lu(k,280) * lu(k,1944) + lu(k,1983) = lu(k,1983) - lu(k,281) * lu(k,1944) + lu(k,1985) = lu(k,1985) - lu(k,282) * lu(k,1944) + lu(k,2005) = lu(k,2005) - lu(k,279) * lu(k,1988) + lu(k,2024) = - lu(k,280) * lu(k,1988) + lu(k,2028) = - lu(k,281) * lu(k,1988) + lu(k,2030) = lu(k,2030) - lu(k,282) * lu(k,1988) + lu(k,2065) = lu(k,2065) - lu(k,279) * lu(k,2041) + lu(k,2084) = - lu(k,280) * lu(k,2041) + lu(k,2088) = lu(k,2088) - lu(k,281) * lu(k,2041) + lu(k,2090) = lu(k,2090) - lu(k,282) * lu(k,2041) + lu(k,284) = 1._r8 / lu(k,284) + lu(k,285) = lu(k,285) * lu(k,284) + lu(k,286) = lu(k,286) * lu(k,284) + lu(k,287) = lu(k,287) * lu(k,284) + lu(k,288) = lu(k,288) * lu(k,284) + lu(k,294) = lu(k,294) - lu(k,285) * lu(k,291) + lu(k,295) = lu(k,295) - lu(k,286) * lu(k,291) + lu(k,298) = lu(k,298) - lu(k,287) * lu(k,291) + lu(k,299) = lu(k,299) - lu(k,288) * lu(k,291) + lu(k,902) = - lu(k,285) * lu(k,890) + lu(k,904) = - lu(k,286) * lu(k,890) + lu(k,914) = lu(k,914) - lu(k,287) * lu(k,890) + lu(k,921) = lu(k,921) - lu(k,288) * lu(k,890) + lu(k,985) = - lu(k,285) * lu(k,968) + lu(k,988) = - lu(k,286) * lu(k,968) + lu(k,998) = lu(k,998) - lu(k,287) * lu(k,968) + lu(k,1005) = lu(k,1005) - lu(k,288) * lu(k,968) + lu(k,1058) = lu(k,1058) - lu(k,285) * lu(k,1048) + lu(k,1062) = lu(k,1062) - lu(k,286) * lu(k,1048) + lu(k,1074) = lu(k,1074) - lu(k,287) * lu(k,1048) + lu(k,1081) = lu(k,1081) - lu(k,288) * lu(k,1048) + lu(k,1237) = lu(k,1237) - lu(k,285) * lu(k,1219) + lu(k,1241) = lu(k,1241) - lu(k,286) * lu(k,1219) + lu(k,1253) = lu(k,1253) - lu(k,287) * lu(k,1219) + lu(k,1260) = lu(k,1260) - lu(k,288) * lu(k,1219) + lu(k,1321) = lu(k,1321) - lu(k,285) * lu(k,1303) + lu(k,1325) = - lu(k,286) * lu(k,1303) + lu(k,1337) = lu(k,1337) - lu(k,287) * lu(k,1303) + lu(k,1344) = lu(k,1344) - lu(k,288) * lu(k,1303) + lu(k,1762) = lu(k,1762) - lu(k,285) * lu(k,1750) + lu(k,1766) = - lu(k,286) * lu(k,1750) + lu(k,1778) = lu(k,1778) - lu(k,287) * lu(k,1750) + lu(k,1785) = lu(k,1785) - lu(k,288) * lu(k,1750) + lu(k,2067) = lu(k,2067) - lu(k,285) * lu(k,2042) + lu(k,2071) = lu(k,2071) - lu(k,286) * lu(k,2042) + lu(k,2083) = lu(k,2083) - lu(k,287) * lu(k,2042) + lu(k,2090) = lu(k,2090) - lu(k,288) * lu(k,2042) + 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,462) = - lu(k,293) * lu(k,459) + lu(k,463) = lu(k,463) - lu(k,294) * lu(k,459) + lu(k,464) = - lu(k,295) * lu(k,459) + lu(k,466) = lu(k,466) - lu(k,296) * lu(k,459) + lu(k,468) = lu(k,468) - lu(k,297) * lu(k,459) + lu(k,469) = - lu(k,298) * lu(k,459) + lu(k,472) = lu(k,472) - lu(k,299) * lu(k,459) + lu(k,1057) = lu(k,1057) - lu(k,293) * lu(k,1049) + lu(k,1058) = lu(k,1058) - lu(k,294) * lu(k,1049) + lu(k,1062) = lu(k,1062) - lu(k,295) * lu(k,1049) + lu(k,1066) = lu(k,1066) - lu(k,296) * lu(k,1049) + lu(k,1070) = lu(k,1070) - lu(k,297) * lu(k,1049) + lu(k,1074) = lu(k,1074) - lu(k,298) * lu(k,1049) + lu(k,1081) = lu(k,1081) - lu(k,299) * lu(k,1049) + lu(k,1598) = lu(k,1598) - lu(k,293) * lu(k,1579) + lu(k,1600) = lu(k,1600) - lu(k,294) * lu(k,1579) + lu(k,1604) = - lu(k,295) * lu(k,1579) + lu(k,1608) = lu(k,1608) - lu(k,296) * lu(k,1579) + lu(k,1612) = lu(k,1612) - lu(k,297) * lu(k,1579) + lu(k,1616) = - lu(k,298) * lu(k,1579) + lu(k,1623) = lu(k,1623) - lu(k,299) * lu(k,1579) + lu(k,2065) = lu(k,2065) - lu(k,293) * lu(k,2043) + lu(k,2067) = lu(k,2067) - lu(k,294) * lu(k,2043) + lu(k,2071) = lu(k,2071) - lu(k,295) * lu(k,2043) + lu(k,2075) = lu(k,2075) - lu(k,296) * lu(k,2043) + lu(k,2079) = lu(k,2079) - lu(k,297) * lu(k,2043) + lu(k,2083) = lu(k,2083) - lu(k,298) * lu(k,2043) + lu(k,2090) = lu(k,2090) - lu(k,299) * lu(k,2043) + lu(k,300) = 1._r8 / lu(k,300) + lu(k,301) = lu(k,301) * lu(k,300) + lu(k,302) = lu(k,302) * lu(k,300) + lu(k,303) = lu(k,303) * lu(k,300) + lu(k,304) = lu(k,304) * lu(k,300) + lu(k,305) = lu(k,305) * lu(k,300) + lu(k,306) = lu(k,306) * lu(k,300) + lu(k,307) = lu(k,307) * lu(k,300) + lu(k,387) = lu(k,387) - lu(k,301) * lu(k,386) + lu(k,388) = lu(k,388) - lu(k,302) * lu(k,386) + lu(k,389) = lu(k,389) - lu(k,303) * lu(k,386) + lu(k,390) = - lu(k,304) * lu(k,386) + lu(k,395) = lu(k,395) - lu(k,305) * lu(k,386) + lu(k,396) = lu(k,396) - lu(k,306) * lu(k,386) + lu(k,398) = - lu(k,307) * lu(k,386) + lu(k,1051) = lu(k,1051) - lu(k,301) * lu(k,1050) + lu(k,1052) = lu(k,1052) - lu(k,302) * lu(k,1050) + lu(k,1053) = lu(k,1053) - lu(k,303) * lu(k,1050) + lu(k,1055) = lu(k,1055) - lu(k,304) * lu(k,1050) + lu(k,1065) = lu(k,1065) - lu(k,305) * lu(k,1050) + lu(k,1066) = lu(k,1066) - lu(k,306) * lu(k,1050) + lu(k,1079) = lu(k,1079) - lu(k,307) * lu(k,1050) + lu(k,1130) = - lu(k,301) * lu(k,1129) + lu(k,1131) = - lu(k,302) * lu(k,1129) + lu(k,1132) = lu(k,1132) - lu(k,303) * lu(k,1129) + lu(k,1143) = - lu(k,304) * lu(k,1129) + lu(k,1158) = lu(k,1158) - lu(k,305) * lu(k,1129) + lu(k,1159) = lu(k,1159) - lu(k,306) * lu(k,1129) + lu(k,1172) = lu(k,1172) - lu(k,307) * lu(k,1129) + lu(k,1357) = lu(k,1357) - lu(k,301) * lu(k,1355) + lu(k,1364) = lu(k,1364) - lu(k,302) * lu(k,1355) + lu(k,1365) = lu(k,1365) - lu(k,303) * lu(k,1355) + lu(k,1373) = - lu(k,304) * lu(k,1355) + lu(k,1388) = lu(k,1388) - lu(k,305) * lu(k,1355) + lu(k,1389) = lu(k,1389) - lu(k,306) * lu(k,1355) + lu(k,1402) = lu(k,1402) - lu(k,307) * lu(k,1355) + lu(k,1412) = lu(k,1412) - lu(k,301) * lu(k,1411) + lu(k,1415) = lu(k,1415) - lu(k,302) * lu(k,1411) + lu(k,1416) = lu(k,1416) - lu(k,303) * lu(k,1411) + lu(k,1423) = lu(k,1423) - lu(k,304) * lu(k,1411) + lu(k,1437) = lu(k,1437) - lu(k,305) * lu(k,1411) + lu(k,1438) = lu(k,1438) - lu(k,306) * lu(k,1411) + lu(k,1451) = lu(k,1451) - lu(k,307) * lu(k,1411) + 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,309) = 1._r8 / lu(k,309) + lu(k,310) = lu(k,310) * lu(k,309) + lu(k,311) = lu(k,311) * lu(k,309) + lu(k,312) = lu(k,312) * lu(k,309) + lu(k,313) = lu(k,313) * lu(k,309) + lu(k,314) = lu(k,314) * lu(k,309) + lu(k,315) = lu(k,315) * lu(k,309) + lu(k,316) = lu(k,316) * lu(k,309) + lu(k,714) = lu(k,714) - lu(k,310) * lu(k,711) + lu(k,715) = lu(k,715) - lu(k,311) * lu(k,711) + lu(k,719) = lu(k,719) - lu(k,312) * lu(k,711) + lu(k,722) = lu(k,722) - lu(k,313) * lu(k,711) + lu(k,724) = lu(k,724) - lu(k,314) * lu(k,711) + lu(k,731) = - lu(k,315) * lu(k,711) + lu(k,732) = - lu(k,316) * lu(k,711) + lu(k,895) = lu(k,895) - lu(k,310) * lu(k,891) + lu(k,897) = lu(k,897) - lu(k,311) * lu(k,891) + lu(k,901) = lu(k,901) - lu(k,312) * lu(k,891) + lu(k,907) = lu(k,907) - lu(k,313) * lu(k,891) + lu(k,909) = lu(k,909) - lu(k,314) * lu(k,891) + lu(k,920) = lu(k,920) - lu(k,315) * lu(k,891) + lu(k,921) = lu(k,921) - lu(k,316) * lu(k,891) + lu(k,1368) = lu(k,1368) - lu(k,310) * lu(k,1356) + lu(k,1371) = lu(k,1371) - lu(k,311) * lu(k,1356) + lu(k,1379) = lu(k,1379) - lu(k,312) * lu(k,1356) + lu(k,1388) = lu(k,1388) - lu(k,313) * lu(k,1356) + lu(k,1390) = lu(k,1390) - lu(k,314) * lu(k,1356) + lu(k,1403) = lu(k,1403) - lu(k,315) * lu(k,1356) + lu(k,1404) = lu(k,1404) - lu(k,316) * lu(k,1356) + lu(k,1795) = lu(k,1795) - lu(k,310) * lu(k,1789) + lu(k,1801) = lu(k,1801) - lu(k,311) * lu(k,1789) + lu(k,1808) = lu(k,1808) - lu(k,312) * lu(k,1789) + lu(k,1817) = lu(k,1817) - lu(k,313) * lu(k,1789) + lu(k,1819) = lu(k,1819) - lu(k,314) * lu(k,1789) + lu(k,1832) = - lu(k,315) * lu(k,1789) + lu(k,1833) = lu(k,1833) - lu(k,316) * lu(k,1789) + lu(k,1995) = lu(k,1995) - lu(k,310) * lu(k,1989) + lu(k,1997) = - lu(k,311) * lu(k,1989) + lu(k,2005) = lu(k,2005) - lu(k,312) * lu(k,1989) + lu(k,2014) = lu(k,2014) - lu(k,313) * lu(k,1989) + lu(k,2016) = lu(k,2016) - lu(k,314) * lu(k,1989) + lu(k,2029) = lu(k,2029) - lu(k,315) * lu(k,1989) + lu(k,2030) = lu(k,2030) - lu(k,316) * lu(k,1989) + lu(k,317) = 1._r8 / lu(k,317) + lu(k,318) = lu(k,318) * lu(k,317) + lu(k,319) = lu(k,319) * lu(k,317) + lu(k,320) = lu(k,320) * lu(k,317) + lu(k,321) = lu(k,321) * lu(k,317) + lu(k,322) = lu(k,322) * lu(k,317) + lu(k,323) = lu(k,323) * lu(k,317) + lu(k,388) = lu(k,388) - lu(k,318) * lu(k,387) + lu(k,389) = lu(k,389) - lu(k,319) * lu(k,387) + lu(k,393) = lu(k,393) - lu(k,320) * lu(k,387) + lu(k,395) = lu(k,395) - lu(k,321) * lu(k,387) + lu(k,396) = lu(k,396) - lu(k,322) * lu(k,387) + lu(k,397) = lu(k,397) - lu(k,323) * lu(k,387) + lu(k,445) = - lu(k,318) * lu(k,444) + lu(k,446) = lu(k,446) - lu(k,319) * lu(k,444) + lu(k,451) = lu(k,451) - lu(k,320) * lu(k,444) + lu(k,453) = lu(k,453) - lu(k,321) * lu(k,444) + lu(k,454) = lu(k,454) - lu(k,322) * lu(k,444) + lu(k,455) = lu(k,455) - lu(k,323) * lu(k,444) + lu(k,1052) = lu(k,1052) - lu(k,318) * lu(k,1051) + lu(k,1053) = lu(k,1053) - lu(k,319) * lu(k,1051) + lu(k,1060) = lu(k,1060) - lu(k,320) * lu(k,1051) + lu(k,1065) = lu(k,1065) - lu(k,321) * lu(k,1051) + lu(k,1066) = lu(k,1066) - lu(k,322) * lu(k,1051) + lu(k,1070) = lu(k,1070) - lu(k,323) * lu(k,1051) + lu(k,1131) = lu(k,1131) - lu(k,318) * lu(k,1130) + lu(k,1132) = lu(k,1132) - lu(k,319) * lu(k,1130) + lu(k,1153) = lu(k,1153) - lu(k,320) * lu(k,1130) + lu(k,1158) = lu(k,1158) - lu(k,321) * lu(k,1130) + lu(k,1159) = lu(k,1159) - lu(k,322) * lu(k,1130) + lu(k,1163) = - lu(k,323) * lu(k,1130) + lu(k,1364) = lu(k,1364) - lu(k,318) * lu(k,1357) + lu(k,1365) = lu(k,1365) - lu(k,319) * lu(k,1357) + lu(k,1383) = lu(k,1383) - lu(k,320) * lu(k,1357) + lu(k,1388) = lu(k,1388) - lu(k,321) * lu(k,1357) + lu(k,1389) = lu(k,1389) - lu(k,322) * lu(k,1357) + lu(k,1393) = lu(k,1393) - lu(k,323) * lu(k,1357) + lu(k,1415) = lu(k,1415) - lu(k,318) * lu(k,1412) + lu(k,1416) = lu(k,1416) - lu(k,319) * lu(k,1412) + lu(k,1432) = lu(k,1432) - lu(k,320) * lu(k,1412) + lu(k,1437) = lu(k,1437) - lu(k,321) * lu(k,1412) + lu(k,1438) = lu(k,1438) - lu(k,322) * lu(k,1412) + lu(k,1442) = lu(k,1442) - lu(k,323) * lu(k,1412) + lu(k,324) = 1._r8 / lu(k,324) + lu(k,325) = lu(k,325) * lu(k,324) + lu(k,326) = lu(k,326) * lu(k,324) + lu(k,327) = lu(k,327) * lu(k,324) + lu(k,328) = lu(k,328) * lu(k,324) + lu(k,329) = lu(k,329) * lu(k,324) + lu(k,330) = lu(k,330) * lu(k,324) + lu(k,331) = lu(k,331) * lu(k,324) + lu(k,582) = lu(k,582) - lu(k,325) * lu(k,581) + lu(k,583) = lu(k,583) - lu(k,326) * lu(k,581) + lu(k,585) = - lu(k,327) * lu(k,581) + lu(k,587) = lu(k,587) - lu(k,328) * lu(k,581) + lu(k,589) = - lu(k,329) * lu(k,581) + lu(k,591) = - lu(k,330) * lu(k,581) + lu(k,593) = - lu(k,331) * lu(k,581) + lu(k,735) = lu(k,735) - lu(k,325) * lu(k,734) + lu(k,737) = - lu(k,326) * lu(k,734) + lu(k,739) = - lu(k,327) * lu(k,734) + lu(k,741) = lu(k,741) - lu(k,328) * lu(k,734) + lu(k,745) = lu(k,745) - lu(k,329) * lu(k,734) + lu(k,750) = lu(k,750) - lu(k,330) * lu(k,734) + lu(k,757) = lu(k,757) - lu(k,331) * lu(k,734) + lu(k,783) = lu(k,783) - lu(k,325) * lu(k,777) + lu(k,785) = lu(k,785) - lu(k,326) * lu(k,777) + lu(k,787) = lu(k,787) - lu(k,327) * lu(k,777) + lu(k,789) = lu(k,789) - lu(k,328) * lu(k,777) + lu(k,794) = lu(k,794) - lu(k,329) * lu(k,777) + lu(k,801) = lu(k,801) - lu(k,330) * lu(k,777) + lu(k,808) = lu(k,808) - lu(k,331) * lu(k,777) + lu(k,895) = lu(k,895) - lu(k,325) * lu(k,892) + lu(k,897) = lu(k,897) - lu(k,326) * lu(k,892) + lu(k,899) = - lu(k,327) * lu(k,892) + lu(k,901) = lu(k,901) - lu(k,328) * lu(k,892) + lu(k,907) = lu(k,907) - lu(k,329) * lu(k,892) + lu(k,914) = lu(k,914) - lu(k,330) * lu(k,892) + lu(k,921) = lu(k,921) - lu(k,331) * lu(k,892) + lu(k,978) = lu(k,978) - lu(k,325) * lu(k,969) + lu(k,980) = lu(k,980) - lu(k,326) * lu(k,969) + lu(k,982) = lu(k,982) - lu(k,327) * lu(k,969) + lu(k,984) = lu(k,984) - lu(k,328) * lu(k,969) + lu(k,991) = lu(k,991) - lu(k,329) * lu(k,969) + lu(k,998) = lu(k,998) - lu(k,330) * lu(k,969) + lu(k,1005) = lu(k,1005) - lu(k,331) * lu(k,969) + lu(k,1368) = lu(k,1368) - lu(k,325) * lu(k,1358) + lu(k,1371) = lu(k,1371) - lu(k,326) * lu(k,1358) + lu(k,1373) = lu(k,1373) - lu(k,327) * lu(k,1358) + lu(k,1379) = lu(k,1379) - lu(k,328) * lu(k,1358) + lu(k,1388) = lu(k,1388) - lu(k,329) * lu(k,1358) + lu(k,1397) = lu(k,1397) - lu(k,330) * lu(k,1358) + lu(k,1404) = lu(k,1404) - lu(k,331) * lu(k,1358) + lu(k,333) = 1._r8 / lu(k,333) + lu(k,334) = lu(k,334) * lu(k,333) + lu(k,335) = lu(k,335) * lu(k,333) + lu(k,336) = lu(k,336) * lu(k,333) + lu(k,337) = lu(k,337) * lu(k,333) + lu(k,338) = lu(k,338) * lu(k,333) + lu(k,339) = lu(k,339) * lu(k,333) + lu(k,360) = lu(k,360) - lu(k,334) * lu(k,358) + lu(k,361) = lu(k,361) - lu(k,335) * lu(k,358) + lu(k,362) = lu(k,362) - lu(k,336) * lu(k,358) + lu(k,363) = lu(k,363) - lu(k,337) * lu(k,358) + lu(k,367) = lu(k,367) - lu(k,338) * lu(k,358) + lu(k,368) = - lu(k,339) * lu(k,358) + lu(k,901) = lu(k,901) - lu(k,334) * lu(k,893) + lu(k,903) = lu(k,903) - lu(k,335) * lu(k,893) + lu(k,907) = lu(k,907) - lu(k,336) * lu(k,893) + lu(k,909) = lu(k,909) - lu(k,337) * lu(k,893) + lu(k,920) = lu(k,920) - lu(k,338) * lu(k,893) + lu(k,921) = lu(k,921) - lu(k,339) * lu(k,893) + lu(k,984) = lu(k,984) - lu(k,334) * lu(k,970) + lu(k,986) = lu(k,986) - lu(k,335) * lu(k,970) + lu(k,991) = lu(k,991) - lu(k,336) * lu(k,970) + lu(k,993) = lu(k,993) - lu(k,337) * lu(k,970) + lu(k,1004) = lu(k,1004) - lu(k,338) * lu(k,970) + lu(k,1005) = lu(k,1005) - lu(k,339) * lu(k,970) + lu(k,1101) = lu(k,1101) - lu(k,334) * lu(k,1086) + lu(k,1104) = lu(k,1104) - lu(k,335) * lu(k,1086) + lu(k,1110) = lu(k,1110) - lu(k,336) * lu(k,1086) + lu(k,1112) = lu(k,1112) - lu(k,337) * lu(k,1086) + lu(k,1125) = lu(k,1125) - lu(k,338) * lu(k,1086) + lu(k,1126) = - lu(k,339) * lu(k,1086) + lu(k,1379) = lu(k,1379) - lu(k,334) * lu(k,1359) + lu(k,1382) = lu(k,1382) - lu(k,335) * lu(k,1359) + lu(k,1388) = lu(k,1388) - lu(k,336) * lu(k,1359) + lu(k,1390) = lu(k,1390) - lu(k,337) * lu(k,1359) + lu(k,1403) = lu(k,1403) - lu(k,338) * lu(k,1359) + lu(k,1404) = lu(k,1404) - lu(k,339) * lu(k,1359) + lu(k,1476) = lu(k,1476) - lu(k,334) * lu(k,1461) + lu(k,1479) = lu(k,1479) - lu(k,335) * lu(k,1461) + lu(k,1485) = lu(k,1485) - lu(k,336) * lu(k,1461) + lu(k,1487) = lu(k,1487) - lu(k,337) * lu(k,1461) + lu(k,1500) = lu(k,1500) - lu(k,338) * lu(k,1461) + lu(k,1501) = lu(k,1501) - lu(k,339) * lu(k,1461) + lu(k,2005) = lu(k,2005) - lu(k,334) * lu(k,1990) + lu(k,2008) = lu(k,2008) - lu(k,335) * lu(k,1990) + lu(k,2014) = lu(k,2014) - lu(k,336) * lu(k,1990) + lu(k,2016) = lu(k,2016) - lu(k,337) * lu(k,1990) + lu(k,2029) = lu(k,2029) - lu(k,338) * lu(k,1990) + lu(k,2030) = lu(k,2030) - lu(k,339) * lu(k,1990) + lu(k,341) = 1._r8 / lu(k,341) + lu(k,342) = lu(k,342) * lu(k,341) + lu(k,343) = lu(k,343) * lu(k,341) + lu(k,344) = lu(k,344) * lu(k,341) + lu(k,345) = lu(k,345) * lu(k,341) + lu(k,346) = lu(k,346) * lu(k,341) + lu(k,347) = lu(k,347) * lu(k,341) + lu(k,348) = lu(k,348) * lu(k,341) + lu(k,349) = lu(k,349) * lu(k,341) + lu(k,416) = lu(k,416) - lu(k,342) * lu(k,415) + lu(k,417) = lu(k,417) - lu(k,343) * lu(k,415) + lu(k,418) = lu(k,418) - lu(k,344) * lu(k,415) + lu(k,422) = lu(k,422) - lu(k,345) * lu(k,415) + lu(k,426) = - lu(k,346) * lu(k,415) + lu(k,427) = - lu(k,347) * lu(k,415) + lu(k,428) = lu(k,428) - lu(k,348) * lu(k,415) + lu(k,430) = lu(k,430) - lu(k,349) * lu(k,415) + lu(k,645) = - lu(k,342) * lu(k,644) + lu(k,646) = - lu(k,343) * lu(k,644) + lu(k,647) = lu(k,647) - lu(k,344) * lu(k,644) + lu(k,651) = lu(k,651) - lu(k,345) * lu(k,644) + lu(k,658) = - lu(k,346) * lu(k,644) + lu(k,659) = - lu(k,347) * lu(k,644) + lu(k,660) = lu(k,660) - lu(k,348) * lu(k,644) + lu(k,666) = lu(k,666) - lu(k,349) * lu(k,644) + lu(k,780) = lu(k,780) - lu(k,342) * lu(k,778) + lu(k,781) = lu(k,781) - lu(k,343) * lu(k,778) + lu(k,784) = lu(k,784) - lu(k,344) * lu(k,778) + lu(k,789) = lu(k,789) - lu(k,345) * lu(k,778) + lu(k,797) = - lu(k,346) * lu(k,778) + lu(k,800) = - lu(k,347) * lu(k,778) + lu(k,801) = lu(k,801) - lu(k,348) * lu(k,778) + lu(k,808) = lu(k,808) - lu(k,349) * lu(k,778) + lu(k,974) = lu(k,974) - lu(k,342) * lu(k,971) + lu(k,975) = lu(k,975) - lu(k,343) * lu(k,971) + lu(k,979) = lu(k,979) - lu(k,344) * lu(k,971) + lu(k,984) = lu(k,984) - lu(k,345) * lu(k,971) + lu(k,994) = lu(k,994) - lu(k,346) * lu(k,971) + lu(k,997) = lu(k,997) - lu(k,347) * lu(k,971) + lu(k,998) = lu(k,998) - lu(k,348) * lu(k,971) + lu(k,1005) = lu(k,1005) - lu(k,349) * lu(k,971) + lu(k,1505) = - lu(k,342) * lu(k,1504) + lu(k,1506) = - lu(k,343) * lu(k,1504) + lu(k,1509) = - lu(k,344) * lu(k,1504) + lu(k,1517) = lu(k,1517) - lu(k,345) * lu(k,1504) + lu(k,1529) = lu(k,1529) - lu(k,346) * lu(k,1504) + lu(k,1534) = lu(k,1534) - lu(k,347) * lu(k,1504) + lu(k,1535) = lu(k,1535) - lu(k,348) * lu(k,1504) + lu(k,1542) = lu(k,1542) - lu(k,349) * lu(k,1504) + lu(k,2046) = - lu(k,342) * lu(k,2044) + lu(k,2047) = - lu(k,343) * lu(k,2044) + lu(k,2055) = lu(k,2055) - lu(k,344) * lu(k,2044) + lu(k,2065) = lu(k,2065) - lu(k,345) * lu(k,2044) + lu(k,2077) = lu(k,2077) - lu(k,346) * lu(k,2044) + lu(k,2082) = - lu(k,347) * lu(k,2044) + lu(k,2083) = lu(k,2083) - lu(k,348) * lu(k,2044) + lu(k,2090) = lu(k,2090) - lu(k,349) * lu(k,2044) + 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,351) = 1._r8 / lu(k,351) + lu(k,352) = lu(k,352) * lu(k,351) + lu(k,353) = lu(k,353) * lu(k,351) + lu(k,354) = lu(k,354) * lu(k,351) + lu(k,355) = lu(k,355) * lu(k,351) + lu(k,356) = lu(k,356) * lu(k,351) + lu(k,476) = lu(k,476) - lu(k,352) * lu(k,475) + lu(k,479) = - lu(k,353) * lu(k,475) + lu(k,480) = lu(k,480) - lu(k,354) * lu(k,475) + lu(k,482) = lu(k,482) - lu(k,355) * lu(k,475) + lu(k,489) = - lu(k,356) * lu(k,475) + lu(k,713) = lu(k,713) - lu(k,352) * lu(k,712) + lu(k,718) = lu(k,718) - lu(k,353) * lu(k,712) + lu(k,719) = lu(k,719) - lu(k,354) * lu(k,712) + lu(k,722) = lu(k,722) - lu(k,355) * lu(k,712) + lu(k,732) = lu(k,732) - lu(k,356) * lu(k,712) + lu(k,977) = lu(k,977) - lu(k,352) * lu(k,972) + lu(k,983) = lu(k,983) - lu(k,353) * lu(k,972) + lu(k,984) = lu(k,984) - lu(k,354) * lu(k,972) + lu(k,991) = lu(k,991) - lu(k,355) * lu(k,972) + lu(k,1005) = lu(k,1005) - lu(k,356) * lu(k,972) + lu(k,1091) = lu(k,1091) - lu(k,352) * lu(k,1087) + lu(k,1099) = lu(k,1099) - lu(k,353) * lu(k,1087) + lu(k,1101) = lu(k,1101) - lu(k,354) * lu(k,1087) + lu(k,1110) = lu(k,1110) - lu(k,355) * lu(k,1087) + lu(k,1126) = lu(k,1126) - lu(k,356) * lu(k,1087) + lu(k,1367) = lu(k,1367) - lu(k,352) * lu(k,1360) + lu(k,1377) = lu(k,1377) - lu(k,353) * lu(k,1360) + lu(k,1379) = lu(k,1379) - lu(k,354) * lu(k,1360) + lu(k,1388) = lu(k,1388) - lu(k,355) * lu(k,1360) + lu(k,1404) = lu(k,1404) - lu(k,356) * lu(k,1360) + lu(k,1418) = lu(k,1418) - lu(k,352) * lu(k,1413) + lu(k,1426) = lu(k,1426) - lu(k,353) * lu(k,1413) + lu(k,1428) = lu(k,1428) - lu(k,354) * lu(k,1413) + lu(k,1437) = lu(k,1437) - lu(k,355) * lu(k,1413) + lu(k,1453) = - lu(k,356) * lu(k,1413) + lu(k,1714) = - lu(k,352) * lu(k,1712) + lu(k,1723) = lu(k,1723) - lu(k,353) * lu(k,1712) + lu(k,1725) = lu(k,1725) - lu(k,354) * lu(k,1712) + lu(k,1733) = lu(k,1733) - lu(k,355) * lu(k,1712) + lu(k,1749) = - lu(k,356) * lu(k,1712) + lu(k,1794) = lu(k,1794) - lu(k,352) * lu(k,1790) + lu(k,1806) = lu(k,1806) - lu(k,353) * lu(k,1790) + lu(k,1808) = lu(k,1808) - lu(k,354) * lu(k,1790) + lu(k,1817) = lu(k,1817) - lu(k,355) * lu(k,1790) + lu(k,1833) = lu(k,1833) - lu(k,356) * lu(k,1790) + lu(k,1908) = lu(k,1908) - lu(k,352) * lu(k,1905) + lu(k,1916) = lu(k,1916) - lu(k,353) * lu(k,1905) + lu(k,1918) = lu(k,1918) - lu(k,354) * lu(k,1905) + lu(k,1927) = lu(k,1927) - lu(k,355) * lu(k,1905) + lu(k,1943) = - lu(k,356) * lu(k,1905) + lu(k,2049) = - lu(k,352) * lu(k,2045) + lu(k,2063) = - lu(k,353) * lu(k,2045) + lu(k,2065) = lu(k,2065) - lu(k,354) * lu(k,2045) + lu(k,2074) = lu(k,2074) - lu(k,355) * lu(k,2045) + lu(k,2090) = lu(k,2090) - lu(k,356) * lu(k,2045) + lu(k,359) = 1._r8 / lu(k,359) + lu(k,360) = lu(k,360) * lu(k,359) + lu(k,361) = lu(k,361) * lu(k,359) + lu(k,362) = lu(k,362) * lu(k,359) + lu(k,363) = lu(k,363) * lu(k,359) + lu(k,364) = lu(k,364) * lu(k,359) + lu(k,365) = lu(k,365) * lu(k,359) + lu(k,366) = lu(k,366) * lu(k,359) + lu(k,367) = lu(k,367) * lu(k,359) + lu(k,368) = lu(k,368) * lu(k,359) + lu(k,984) = lu(k,984) - lu(k,360) * lu(k,973) + lu(k,986) = lu(k,986) - lu(k,361) * lu(k,973) + lu(k,991) = lu(k,991) - lu(k,362) * lu(k,973) + lu(k,993) = lu(k,993) - lu(k,363) * lu(k,973) + lu(k,994) = lu(k,994) - lu(k,364) * lu(k,973) + lu(k,997) = lu(k,997) - lu(k,365) * lu(k,973) + lu(k,999) = lu(k,999) - lu(k,366) * lu(k,973) + lu(k,1004) = lu(k,1004) - lu(k,367) * lu(k,973) + lu(k,1005) = lu(k,1005) - lu(k,368) * lu(k,973) + lu(k,1101) = lu(k,1101) - lu(k,360) * lu(k,1088) + lu(k,1104) = lu(k,1104) - lu(k,361) * lu(k,1088) + lu(k,1110) = lu(k,1110) - lu(k,362) * lu(k,1088) + lu(k,1112) = lu(k,1112) - lu(k,363) * lu(k,1088) + lu(k,1113) = - lu(k,364) * lu(k,1088) + lu(k,1118) = lu(k,1118) - lu(k,365) * lu(k,1088) + lu(k,1120) = lu(k,1120) - lu(k,366) * lu(k,1088) + lu(k,1125) = lu(k,1125) - lu(k,367) * lu(k,1088) + lu(k,1126) = lu(k,1126) - lu(k,368) * lu(k,1088) + lu(k,1379) = lu(k,1379) - lu(k,360) * lu(k,1361) + lu(k,1382) = lu(k,1382) - lu(k,361) * lu(k,1361) + lu(k,1388) = lu(k,1388) - lu(k,362) * lu(k,1361) + lu(k,1390) = lu(k,1390) - lu(k,363) * lu(k,1361) + lu(k,1391) = lu(k,1391) - lu(k,364) * lu(k,1361) + lu(k,1396) = lu(k,1396) - lu(k,365) * lu(k,1361) + lu(k,1398) = lu(k,1398) - lu(k,366) * lu(k,1361) + lu(k,1403) = lu(k,1403) - lu(k,367) * lu(k,1361) + lu(k,1404) = lu(k,1404) - lu(k,368) * lu(k,1361) + lu(k,1476) = lu(k,1476) - lu(k,360) * lu(k,1462) + lu(k,1479) = lu(k,1479) - lu(k,361) * lu(k,1462) + lu(k,1485) = lu(k,1485) - lu(k,362) * lu(k,1462) + lu(k,1487) = lu(k,1487) - lu(k,363) * lu(k,1462) + lu(k,1488) = - lu(k,364) * lu(k,1462) + lu(k,1493) = lu(k,1493) - lu(k,365) * lu(k,1462) + lu(k,1495) = lu(k,1495) - lu(k,366) * lu(k,1462) + lu(k,1500) = lu(k,1500) - lu(k,367) * lu(k,1462) + lu(k,1501) = lu(k,1501) - lu(k,368) * lu(k,1462) + lu(k,1808) = lu(k,1808) - lu(k,360) * lu(k,1791) + lu(k,1811) = lu(k,1811) - lu(k,361) * lu(k,1791) + lu(k,1817) = lu(k,1817) - lu(k,362) * lu(k,1791) + lu(k,1819) = lu(k,1819) - lu(k,363) * lu(k,1791) + lu(k,1820) = lu(k,1820) - lu(k,364) * lu(k,1791) + lu(k,1825) = lu(k,1825) - lu(k,365) * lu(k,1791) + lu(k,1827) = lu(k,1827) - lu(k,366) * lu(k,1791) + lu(k,1832) = lu(k,1832) - lu(k,367) * lu(k,1791) + lu(k,1833) = lu(k,1833) - lu(k,368) * lu(k,1791) + lu(k,2005) = lu(k,2005) - lu(k,360) * lu(k,1991) + lu(k,2008) = lu(k,2008) - lu(k,361) * lu(k,1991) + lu(k,2014) = lu(k,2014) - lu(k,362) * lu(k,1991) + lu(k,2016) = lu(k,2016) - lu(k,363) * lu(k,1991) + lu(k,2017) = lu(k,2017) - lu(k,364) * lu(k,1991) + lu(k,2022) = - lu(k,365) * lu(k,1991) + lu(k,2024) = lu(k,2024) - lu(k,366) * lu(k,1991) + lu(k,2029) = lu(k,2029) - lu(k,367) * lu(k,1991) + lu(k,2030) = lu(k,2030) - lu(k,368) * lu(k,1991) + 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,832) = lu(k,832) - lu(k,370) * lu(k,830) + lu(k,836) = - lu(k,371) * lu(k,830) + lu(k,846) = lu(k,846) - lu(k,372) * lu(k,830) + lu(k,847) = lu(k,847) - lu(k,373) * lu(k,830) + lu(k,848) = lu(k,848) - lu(k,374) * lu(k,830) + lu(k,855) = - lu(k,375) * lu(k,830) + lu(k,859) = lu(k,859) - lu(k,376) * lu(k,830) + lu(k,1010) = lu(k,1010) - lu(k,370) * lu(k,1006) + lu(k,1012) = lu(k,1012) - lu(k,371) * lu(k,1006) + lu(k,1022) = lu(k,1022) - lu(k,372) * lu(k,1006) + lu(k,1023) = lu(k,1023) - lu(k,373) * lu(k,1006) + lu(k,1024) = lu(k,1024) - lu(k,374) * lu(k,1006) + lu(k,1032) = lu(k,1032) - lu(k,375) * lu(k,1006) + lu(k,1036) = lu(k,1036) - lu(k,376) * lu(k,1006) + lu(k,1096) = lu(k,1096) - lu(k,370) * lu(k,1089) + lu(k,1100) = lu(k,1100) - lu(k,371) * lu(k,1089) + lu(k,1110) = lu(k,1110) - lu(k,372) * lu(k,1089) + lu(k,1111) = lu(k,1111) - lu(k,373) * lu(k,1089) + lu(k,1112) = lu(k,1112) - lu(k,374) * lu(k,1089) + lu(k,1120) = lu(k,1120) - lu(k,375) * lu(k,1089) + lu(k,1124) = lu(k,1124) - lu(k,376) * lu(k,1089) + lu(k,1374) = lu(k,1374) - lu(k,370) * lu(k,1362) + lu(k,1378) = lu(k,1378) - lu(k,371) * lu(k,1362) + lu(k,1388) = lu(k,1388) - lu(k,372) * lu(k,1362) + lu(k,1389) = lu(k,1389) - lu(k,373) * lu(k,1362) + lu(k,1390) = lu(k,1390) - lu(k,374) * lu(k,1362) + lu(k,1398) = lu(k,1398) - lu(k,375) * lu(k,1362) + lu(k,1402) = lu(k,1402) - lu(k,376) * lu(k,1362) + lu(k,1471) = lu(k,1471) - lu(k,370) * lu(k,1463) + lu(k,1475) = lu(k,1475) - lu(k,371) * lu(k,1463) + lu(k,1485) = lu(k,1485) - lu(k,372) * lu(k,1463) + lu(k,1486) = lu(k,1486) - lu(k,373) * lu(k,1463) + lu(k,1487) = lu(k,1487) - lu(k,374) * lu(k,1463) + lu(k,1495) = lu(k,1495) - lu(k,375) * lu(k,1463) + lu(k,1499) = - lu(k,376) * lu(k,1463) + lu(k,1548) = lu(k,1548) - lu(k,370) * lu(k,1544) + lu(k,1552) = lu(k,1552) - lu(k,371) * lu(k,1544) + lu(k,1562) = lu(k,1562) - lu(k,372) * lu(k,1544) + lu(k,1563) = lu(k,1563) - lu(k,373) * lu(k,1544) + lu(k,1564) = lu(k,1564) - lu(k,374) * lu(k,1544) + lu(k,1572) = lu(k,1572) - lu(k,375) * lu(k,1544) + lu(k,1576) = lu(k,1576) - lu(k,376) * lu(k,1544) + lu(k,1837) = lu(k,1837) - lu(k,370) * lu(k,1834) + lu(k,1840) = lu(k,1840) - lu(k,371) * lu(k,1834) + lu(k,1850) = lu(k,1850) - lu(k,372) * lu(k,1834) + lu(k,1851) = - lu(k,373) * lu(k,1834) + lu(k,1852) = lu(k,1852) - lu(k,374) * lu(k,1834) + lu(k,1860) = lu(k,1860) - lu(k,375) * lu(k,1834) + lu(k,1864) = - lu(k,376) * lu(k,1834) + lu(k,1956) = lu(k,1956) - lu(k,370) * lu(k,1945) + lu(k,1959) = lu(k,1959) - lu(k,371) * lu(k,1945) + lu(k,1969) = lu(k,1969) - lu(k,372) * lu(k,1945) + lu(k,1970) = lu(k,1970) - lu(k,373) * lu(k,1945) + lu(k,1971) = lu(k,1971) - lu(k,374) * lu(k,1945) + lu(k,1979) = lu(k,1979) - lu(k,375) * lu(k,1945) + lu(k,1983) = lu(k,1983) - lu(k,376) * lu(k,1945) + 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,461) = lu(k,461) - lu(k,378) * lu(k,460) + lu(k,463) = lu(k,463) - lu(k,379) * lu(k,460) + lu(k,466) = lu(k,466) - lu(k,380) * lu(k,460) + lu(k,467) = - lu(k,381) * lu(k,460) + lu(k,468) = lu(k,468) - lu(k,382) * lu(k,460) + lu(k,470) = - lu(k,383) * lu(k,460) + lu(k,471) = lu(k,471) - lu(k,384) * lu(k,460) + lu(k,782) = - lu(k,378) * lu(k,779) + lu(k,790) = - lu(k,379) * lu(k,779) + lu(k,795) = lu(k,795) - lu(k,380) * lu(k,779) + lu(k,798) = - lu(k,381) * lu(k,779) + lu(k,799) = - lu(k,382) * lu(k,779) + lu(k,804) = - lu(k,383) * lu(k,779) + lu(k,805) = lu(k,805) - lu(k,384) * lu(k,779) + lu(k,1269) = - lu(k,378) * lu(k,1266) + lu(k,1279) = lu(k,1279) - lu(k,379) * lu(k,1266) + lu(k,1287) = lu(k,1287) - lu(k,380) * lu(k,1266) + lu(k,1290) = lu(k,1290) - lu(k,381) * lu(k,1266) + lu(k,1291) = lu(k,1291) - lu(k,382) * lu(k,1266) + lu(k,1298) = lu(k,1298) - lu(k,383) * lu(k,1266) + lu(k,1299) = - lu(k,384) * lu(k,1266) + lu(k,1366) = lu(k,1366) - lu(k,378) * lu(k,1363) + lu(k,1381) = lu(k,1381) - lu(k,379) * lu(k,1363) + lu(k,1389) = lu(k,1389) - lu(k,380) * lu(k,1363) + lu(k,1392) = lu(k,1392) - lu(k,381) * lu(k,1363) + lu(k,1393) = lu(k,1393) - lu(k,382) * lu(k,1363) + lu(k,1400) = lu(k,1400) - lu(k,383) * lu(k,1363) + lu(k,1401) = lu(k,1401) - lu(k,384) * lu(k,1363) + lu(k,1417) = lu(k,1417) - lu(k,378) * lu(k,1414) + lu(k,1430) = lu(k,1430) - lu(k,379) * lu(k,1414) + lu(k,1438) = lu(k,1438) - lu(k,380) * lu(k,1414) + lu(k,1441) = lu(k,1441) - lu(k,381) * lu(k,1414) + lu(k,1442) = lu(k,1442) - lu(k,382) * lu(k,1414) + lu(k,1449) = lu(k,1449) - lu(k,383) * lu(k,1414) + lu(k,1450) = lu(k,1450) - lu(k,384) * lu(k,1414) + lu(k,1546) = - lu(k,378) * lu(k,1545) + lu(k,1555) = lu(k,1555) - lu(k,379) * lu(k,1545) + lu(k,1563) = lu(k,1563) - lu(k,380) * lu(k,1545) + lu(k,1566) = lu(k,1566) - lu(k,381) * lu(k,1545) + lu(k,1567) = lu(k,1567) - lu(k,382) * lu(k,1545) + lu(k,1574) = lu(k,1574) - lu(k,383) * lu(k,1545) + lu(k,1575) = lu(k,1575) - lu(k,384) * lu(k,1545) + lu(k,1868) = - lu(k,378) * lu(k,1867) + lu(k,1879) = lu(k,1879) - lu(k,379) * lu(k,1867) + lu(k,1887) = lu(k,1887) - lu(k,380) * lu(k,1867) + lu(k,1890) = - lu(k,381) * lu(k,1867) + lu(k,1891) = - lu(k,382) * lu(k,1867) + lu(k,1898) = lu(k,1898) - lu(k,383) * lu(k,1867) + lu(k,1899) = lu(k,1899) - lu(k,384) * lu(k,1867) + lu(k,1907) = - lu(k,378) * lu(k,1906) + lu(k,1920) = lu(k,1920) - lu(k,379) * lu(k,1906) + lu(k,1928) = lu(k,1928) - lu(k,380) * lu(k,1906) + lu(k,1931) = lu(k,1931) - lu(k,381) * lu(k,1906) + lu(k,1932) = - lu(k,382) * lu(k,1906) + lu(k,1939) = lu(k,1939) - lu(k,383) * lu(k,1906) + lu(k,1940) = lu(k,1940) - lu(k,384) * lu(k,1906) + 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,388) = 1._r8 / lu(k,388) + lu(k,389) = lu(k,389) * lu(k,388) + lu(k,390) = lu(k,390) * lu(k,388) + lu(k,391) = lu(k,391) * lu(k,388) + lu(k,392) = lu(k,392) * lu(k,388) + lu(k,393) = lu(k,393) * lu(k,388) + lu(k,394) = lu(k,394) * lu(k,388) + lu(k,395) = lu(k,395) * lu(k,388) + lu(k,396) = lu(k,396) * lu(k,388) + lu(k,397) = lu(k,397) * lu(k,388) + lu(k,398) = lu(k,398) * lu(k,388) + lu(k,446) = lu(k,446) - lu(k,389) * lu(k,445) + lu(k,447) = lu(k,447) - lu(k,390) * lu(k,445) + lu(k,448) = - lu(k,391) * lu(k,445) + lu(k,449) = lu(k,449) - lu(k,392) * lu(k,445) + lu(k,451) = lu(k,451) - lu(k,393) * lu(k,445) + lu(k,452) = - lu(k,394) * lu(k,445) + lu(k,453) = lu(k,453) - lu(k,395) * lu(k,445) + lu(k,454) = lu(k,454) - lu(k,396) * lu(k,445) + lu(k,455) = lu(k,455) - lu(k,397) * lu(k,445) + lu(k,458) = lu(k,458) - lu(k,398) * lu(k,445) + lu(k,1053) = lu(k,1053) - lu(k,389) * lu(k,1052) + lu(k,1055) = lu(k,1055) - lu(k,390) * lu(k,1052) + lu(k,1056) = - lu(k,391) * lu(k,1052) + lu(k,1057) = lu(k,1057) - lu(k,392) * lu(k,1052) + lu(k,1060) = lu(k,1060) - lu(k,393) * lu(k,1052) + lu(k,1063) = lu(k,1063) - lu(k,394) * lu(k,1052) + lu(k,1065) = lu(k,1065) - lu(k,395) * lu(k,1052) + lu(k,1066) = lu(k,1066) - lu(k,396) * lu(k,1052) + lu(k,1070) = lu(k,1070) - lu(k,397) * lu(k,1052) + lu(k,1079) = lu(k,1079) - lu(k,398) * lu(k,1052) + lu(k,1132) = lu(k,1132) - lu(k,389) * lu(k,1131) + lu(k,1143) = lu(k,1143) - lu(k,390) * lu(k,1131) + lu(k,1147) = - lu(k,391) * lu(k,1131) + lu(k,1149) = lu(k,1149) - lu(k,392) * lu(k,1131) + lu(k,1153) = lu(k,1153) - lu(k,393) * lu(k,1131) + lu(k,1156) = lu(k,1156) - lu(k,394) * lu(k,1131) + lu(k,1158) = lu(k,1158) - lu(k,395) * lu(k,1131) + lu(k,1159) = lu(k,1159) - lu(k,396) * lu(k,1131) + lu(k,1163) = lu(k,1163) - lu(k,397) * lu(k,1131) + lu(k,1172) = lu(k,1172) - lu(k,398) * lu(k,1131) + lu(k,1268) = - lu(k,389) * lu(k,1267) + lu(k,1272) = - lu(k,390) * lu(k,1267) + lu(k,1275) = lu(k,1275) - lu(k,391) * lu(k,1267) + lu(k,1277) = lu(k,1277) - lu(k,392) * lu(k,1267) + lu(k,1281) = lu(k,1281) - lu(k,393) * lu(k,1267) + lu(k,1284) = lu(k,1284) - lu(k,394) * lu(k,1267) + lu(k,1286) = lu(k,1286) - lu(k,395) * lu(k,1267) + lu(k,1287) = lu(k,1287) - lu(k,396) * lu(k,1267) + lu(k,1291) = lu(k,1291) - lu(k,397) * lu(k,1267) + lu(k,1300) = lu(k,1300) - lu(k,398) * lu(k,1267) + lu(k,1365) = lu(k,1365) - lu(k,389) * lu(k,1364) + lu(k,1373) = lu(k,1373) - lu(k,390) * lu(k,1364) + lu(k,1377) = lu(k,1377) - lu(k,391) * lu(k,1364) + lu(k,1379) = lu(k,1379) - lu(k,392) * lu(k,1364) + lu(k,1383) = lu(k,1383) - lu(k,393) * lu(k,1364) + lu(k,1386) = lu(k,1386) - lu(k,394) * lu(k,1364) + lu(k,1388) = lu(k,1388) - lu(k,395) * lu(k,1364) + lu(k,1389) = lu(k,1389) - lu(k,396) * lu(k,1364) + lu(k,1393) = lu(k,1393) - lu(k,397) * lu(k,1364) + lu(k,1402) = lu(k,1402) - lu(k,398) * lu(k,1364) + lu(k,1416) = lu(k,1416) - lu(k,389) * lu(k,1415) + lu(k,1423) = lu(k,1423) - lu(k,390) * lu(k,1415) + lu(k,1426) = lu(k,1426) - lu(k,391) * lu(k,1415) + lu(k,1428) = lu(k,1428) - lu(k,392) * lu(k,1415) + lu(k,1432) = lu(k,1432) - lu(k,393) * lu(k,1415) + lu(k,1435) = lu(k,1435) - lu(k,394) * lu(k,1415) + lu(k,1437) = lu(k,1437) - lu(k,395) * lu(k,1415) + lu(k,1438) = lu(k,1438) - lu(k,396) * lu(k,1415) + lu(k,1442) = lu(k,1442) - lu(k,397) * lu(k,1415) + lu(k,1451) = lu(k,1451) - lu(k,398) * lu(k,1415) + 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,408) = lu(k,408) * lu(k,401) + lu(k,409) = lu(k,409) * lu(k,401) + lu(k,410) = lu(k,410) * lu(k,401) + lu(k,411) = lu(k,411) * lu(k,401) + lu(k,412) = lu(k,412) * lu(k,401) + lu(k,624) = lu(k,624) - lu(k,402) * lu(k,623) + lu(k,625) = lu(k,625) - lu(k,403) * lu(k,623) + lu(k,626) = lu(k,626) - lu(k,404) * lu(k,623) + lu(k,632) = - lu(k,405) * lu(k,623) + lu(k,634) = lu(k,634) - lu(k,406) * lu(k,623) + lu(k,636) = lu(k,636) - lu(k,407) * lu(k,623) + lu(k,637) = lu(k,637) - lu(k,408) * lu(k,623) + lu(k,638) = lu(k,638) - lu(k,409) * lu(k,623) + lu(k,640) = - lu(k,410) * lu(k,623) + lu(k,641) = lu(k,641) - lu(k,411) * lu(k,623) + lu(k,642) = lu(k,642) - lu(k,412) * lu(k,623) + lu(k,689) = lu(k,689) - lu(k,402) * lu(k,688) + lu(k,690) = lu(k,690) - lu(k,403) * lu(k,688) + lu(k,691) = lu(k,691) - lu(k,404) * lu(k,688) + lu(k,697) = - lu(k,405) * lu(k,688) + lu(k,699) = lu(k,699) - lu(k,406) * lu(k,688) + lu(k,701) = lu(k,701) - lu(k,407) * lu(k,688) + lu(k,702) = lu(k,702) - lu(k,408) * lu(k,688) + lu(k,703) = lu(k,703) - lu(k,409) * lu(k,688) + lu(k,705) = - lu(k,410) * lu(k,688) + lu(k,706) = lu(k,706) - lu(k,411) * lu(k,688) + lu(k,707) = lu(k,707) - lu(k,412) * lu(k,688) + lu(k,1632) = lu(k,1632) - lu(k,402) * lu(k,1625) + lu(k,1633) = lu(k,1633) - lu(k,403) * lu(k,1625) + lu(k,1635) = lu(k,1635) - lu(k,404) * lu(k,1625) + lu(k,1650) = lu(k,1650) - lu(k,405) * lu(k,1625) + lu(k,1653) = lu(k,1653) - lu(k,406) * lu(k,1625) + lu(k,1656) = lu(k,1656) - lu(k,407) * lu(k,1625) + lu(k,1657) = lu(k,1657) - lu(k,408) * lu(k,1625) + lu(k,1658) = lu(k,1658) - lu(k,409) * lu(k,1625) + lu(k,1660) = lu(k,1660) - lu(k,410) * lu(k,1625) + lu(k,1664) = - lu(k,411) * lu(k,1625) + lu(k,1666) = lu(k,1666) - lu(k,412) * lu(k,1625) + lu(k,1675) = lu(k,1675) - lu(k,402) * lu(k,1668) + lu(k,1676) = lu(k,1676) - lu(k,403) * lu(k,1668) + lu(k,1678) = lu(k,1678) - lu(k,404) * lu(k,1668) + lu(k,1693) = lu(k,1693) - lu(k,405) * lu(k,1668) + lu(k,1696) = lu(k,1696) - lu(k,406) * lu(k,1668) + lu(k,1699) = lu(k,1699) - lu(k,407) * lu(k,1668) + lu(k,1700) = lu(k,1700) - lu(k,408) * lu(k,1668) + lu(k,1701) = lu(k,1701) - lu(k,409) * lu(k,1668) + lu(k,1703) = lu(k,1703) - lu(k,410) * lu(k,1668) + lu(k,1707) = - lu(k,411) * lu(k,1668) + lu(k,1709) = lu(k,1709) - lu(k,412) * lu(k,1668) + lu(k,1716) = - lu(k,402) * lu(k,1713) + lu(k,1717) = - lu(k,403) * lu(k,1713) + lu(k,1718) = - lu(k,404) * lu(k,1713) + lu(k,1733) = lu(k,1733) - lu(k,405) * lu(k,1713) + lu(k,1736) = lu(k,1736) - lu(k,406) * lu(k,1713) + lu(k,1739) = - lu(k,407) * lu(k,1713) + lu(k,1740) = - lu(k,408) * lu(k,1713) + lu(k,1741) = lu(k,1741) - lu(k,409) * lu(k,1713) + lu(k,1743) = lu(k,1743) - lu(k,410) * lu(k,1713) + lu(k,1747) = lu(k,1747) - lu(k,411) * lu(k,1713) + lu(k,1749) = lu(k,1749) - lu(k,412) * lu(k,1713) + lu(k,1797) = - lu(k,402) * lu(k,1792) + lu(k,1798) = - lu(k,403) * lu(k,1792) + lu(k,1800) = lu(k,1800) - lu(k,404) * lu(k,1792) + lu(k,1817) = lu(k,1817) - lu(k,405) * lu(k,1792) + lu(k,1820) = lu(k,1820) - lu(k,406) * lu(k,1792) + lu(k,1823) = - lu(k,407) * lu(k,1792) + lu(k,1824) = - lu(k,408) * lu(k,1792) + lu(k,1825) = lu(k,1825) - lu(k,409) * lu(k,1792) + lu(k,1827) = lu(k,1827) - lu(k,410) * lu(k,1792) + lu(k,1831) = lu(k,1831) - lu(k,411) * lu(k,1792) + lu(k,1833) = lu(k,1833) - lu(k,412) * lu(k,1792) + 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,421) = lu(k,421) * lu(k,416) + lu(k,422) = lu(k,422) * lu(k,416) + lu(k,423) = lu(k,423) * lu(k,416) + lu(k,424) = lu(k,424) * lu(k,416) + lu(k,425) = lu(k,425) * lu(k,416) + lu(k,426) = lu(k,426) * lu(k,416) + lu(k,427) = lu(k,427) * lu(k,416) + lu(k,428) = lu(k,428) * lu(k,416) + lu(k,429) = lu(k,429) * lu(k,416) + lu(k,430) = lu(k,430) * lu(k,416) + lu(k,646) = lu(k,646) - lu(k,417) * lu(k,645) + lu(k,647) = lu(k,647) - lu(k,418) * lu(k,645) + lu(k,648) = - lu(k,419) * lu(k,645) + lu(k,649) = lu(k,649) - lu(k,420) * lu(k,645) + lu(k,650) = - lu(k,421) * lu(k,645) + lu(k,651) = lu(k,651) - lu(k,422) * lu(k,645) + lu(k,654) = - lu(k,423) * lu(k,645) + lu(k,655) = lu(k,655) - lu(k,424) * lu(k,645) + lu(k,657) = lu(k,657) - lu(k,425) * lu(k,645) + lu(k,658) = lu(k,658) - lu(k,426) * lu(k,645) + lu(k,659) = lu(k,659) - lu(k,427) * lu(k,645) + lu(k,660) = lu(k,660) - lu(k,428) * lu(k,645) + lu(k,665) = lu(k,665) - lu(k,429) * lu(k,645) + lu(k,666) = lu(k,666) - lu(k,430) * lu(k,645) + lu(k,781) = lu(k,781) - lu(k,417) * lu(k,780) + lu(k,784) = lu(k,784) - lu(k,418) * lu(k,780) + lu(k,786) = lu(k,786) - lu(k,419) * lu(k,780) + lu(k,787) = lu(k,787) - lu(k,420) * lu(k,780) + lu(k,788) = lu(k,788) - lu(k,421) * lu(k,780) + lu(k,789) = lu(k,789) - lu(k,422) * lu(k,780) + lu(k,793) = - lu(k,423) * lu(k,780) + lu(k,794) = lu(k,794) - lu(k,424) * lu(k,780) + lu(k,796) = lu(k,796) - lu(k,425) * lu(k,780) + lu(k,797) = lu(k,797) - lu(k,426) * lu(k,780) + lu(k,800) = lu(k,800) - lu(k,427) * lu(k,780) + lu(k,801) = lu(k,801) - lu(k,428) * lu(k,780) + lu(k,807) = lu(k,807) - lu(k,429) * lu(k,780) + lu(k,808) = lu(k,808) - lu(k,430) * lu(k,780) + lu(k,975) = lu(k,975) - lu(k,417) * lu(k,974) + lu(k,979) = lu(k,979) - lu(k,418) * lu(k,974) + lu(k,981) = lu(k,981) - lu(k,419) * lu(k,974) + lu(k,982) = lu(k,982) - lu(k,420) * lu(k,974) + lu(k,983) = lu(k,983) - lu(k,421) * lu(k,974) + lu(k,984) = lu(k,984) - lu(k,422) * lu(k,974) + lu(k,989) = lu(k,989) - lu(k,423) * lu(k,974) + lu(k,991) = lu(k,991) - lu(k,424) * lu(k,974) + lu(k,993) = lu(k,993) - lu(k,425) * lu(k,974) + lu(k,994) = lu(k,994) - lu(k,426) * lu(k,974) + lu(k,997) = lu(k,997) - lu(k,427) * lu(k,974) + lu(k,998) = lu(k,998) - lu(k,428) * lu(k,974) + lu(k,1004) = lu(k,1004) - lu(k,429) * lu(k,974) + lu(k,1005) = lu(k,1005) - lu(k,430) * lu(k,974) + lu(k,1465) = lu(k,1465) - lu(k,417) * lu(k,1464) + lu(k,1467) = lu(k,1467) - lu(k,418) * lu(k,1464) + lu(k,1469) = lu(k,1469) - lu(k,419) * lu(k,1464) + lu(k,1470) = lu(k,1470) - lu(k,420) * lu(k,1464) + lu(k,1474) = lu(k,1474) - lu(k,421) * lu(k,1464) + lu(k,1476) = lu(k,1476) - lu(k,422) * lu(k,1464) + lu(k,1483) = lu(k,1483) - lu(k,423) * lu(k,1464) + lu(k,1485) = lu(k,1485) - lu(k,424) * lu(k,1464) + lu(k,1487) = lu(k,1487) - lu(k,425) * lu(k,1464) + lu(k,1488) = lu(k,1488) - lu(k,426) * lu(k,1464) + lu(k,1493) = lu(k,1493) - lu(k,427) * lu(k,1464) + lu(k,1494) = lu(k,1494) - lu(k,428) * lu(k,1464) + lu(k,1500) = lu(k,1500) - lu(k,429) * lu(k,1464) + lu(k,1501) = lu(k,1501) - lu(k,430) * lu(k,1464) + lu(k,1506) = lu(k,1506) - lu(k,417) * lu(k,1505) + lu(k,1509) = lu(k,1509) - lu(k,418) * lu(k,1505) + lu(k,1511) = - lu(k,419) * lu(k,1505) + lu(k,1512) = - lu(k,420) * lu(k,1505) + lu(k,1515) = lu(k,1515) - lu(k,421) * lu(k,1505) + lu(k,1517) = lu(k,1517) - lu(k,422) * lu(k,1505) + lu(k,1524) = lu(k,1524) - lu(k,423) * lu(k,1505) + lu(k,1526) = - lu(k,424) * lu(k,1505) + lu(k,1528) = - lu(k,425) * lu(k,1505) + lu(k,1529) = lu(k,1529) - lu(k,426) * lu(k,1505) + lu(k,1534) = lu(k,1534) - lu(k,427) * lu(k,1505) + lu(k,1535) = lu(k,1535) - lu(k,428) * lu(k,1505) + lu(k,1541) = lu(k,1541) - lu(k,429) * lu(k,1505) + lu(k,1542) = lu(k,1542) - lu(k,430) * lu(k,1505) + lu(k,2047) = lu(k,2047) - lu(k,417) * lu(k,2046) + lu(k,2055) = lu(k,2055) - lu(k,418) * lu(k,2046) + lu(k,2059) = - lu(k,419) * lu(k,2046) + lu(k,2060) = lu(k,2060) - lu(k,420) * lu(k,2046) + lu(k,2063) = lu(k,2063) - lu(k,421) * lu(k,2046) + lu(k,2065) = lu(k,2065) - lu(k,422) * lu(k,2046) + lu(k,2072) = lu(k,2072) - lu(k,423) * lu(k,2046) + lu(k,2074) = lu(k,2074) - lu(k,424) * lu(k,2046) + lu(k,2076) = - lu(k,425) * lu(k,2046) + lu(k,2077) = lu(k,2077) - lu(k,426) * lu(k,2046) + lu(k,2082) = lu(k,2082) - lu(k,427) * lu(k,2046) + lu(k,2083) = lu(k,2083) - lu(k,428) * lu(k,2046) + lu(k,2089) = - lu(k,429) * lu(k,2046) + lu(k,2090) = lu(k,2090) - lu(k,430) * lu(k,2046) + 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,432) = 1._r8 / lu(k,432) + lu(k,433) = lu(k,433) * lu(k,432) + lu(k,434) = lu(k,434) * lu(k,432) + lu(k,435) = lu(k,435) * lu(k,432) + lu(k,436) = lu(k,436) * lu(k,432) + lu(k,437) = lu(k,437) * lu(k,432) + lu(k,438) = lu(k,438) * lu(k,432) + lu(k,439) = lu(k,439) * lu(k,432) + lu(k,440) = lu(k,440) * lu(k,432) + lu(k,441) = lu(k,441) * lu(k,432) + lu(k,442) = lu(k,442) * lu(k,432) + lu(k,648) = lu(k,648) - lu(k,433) * lu(k,646) + lu(k,650) = lu(k,650) - lu(k,434) * lu(k,646) + lu(k,651) = lu(k,651) - lu(k,435) * lu(k,646) + lu(k,653) = - lu(k,436) * lu(k,646) + lu(k,656) = - lu(k,437) * lu(k,646) + lu(k,657) = lu(k,657) - lu(k,438) * lu(k,646) + lu(k,660) = lu(k,660) - lu(k,439) * lu(k,646) + lu(k,661) = - lu(k,440) * lu(k,646) + lu(k,664) = - lu(k,441) * lu(k,646) + lu(k,666) = lu(k,666) - lu(k,442) * lu(k,646) + lu(k,786) = lu(k,786) - lu(k,433) * lu(k,781) + lu(k,788) = lu(k,788) - lu(k,434) * lu(k,781) + lu(k,789) = lu(k,789) - lu(k,435) * lu(k,781) + lu(k,791) = lu(k,791) - lu(k,436) * lu(k,781) + lu(k,795) = lu(k,795) - lu(k,437) * lu(k,781) + lu(k,796) = lu(k,796) - lu(k,438) * lu(k,781) + lu(k,801) = lu(k,801) - lu(k,439) * lu(k,781) + lu(k,802) = - lu(k,440) * lu(k,781) + lu(k,806) = lu(k,806) - lu(k,441) * lu(k,781) + lu(k,808) = lu(k,808) - lu(k,442) * lu(k,781) + lu(k,898) = lu(k,898) - lu(k,433) * lu(k,894) + lu(k,900) = lu(k,900) - lu(k,434) * lu(k,894) + lu(k,901) = lu(k,901) - lu(k,435) * lu(k,894) + lu(k,903) = lu(k,903) - lu(k,436) * lu(k,894) + lu(k,908) = lu(k,908) - lu(k,437) * lu(k,894) + lu(k,909) = lu(k,909) - lu(k,438) * lu(k,894) + lu(k,914) = lu(k,914) - lu(k,439) * lu(k,894) + lu(k,915) = lu(k,915) - lu(k,440) * lu(k,894) + lu(k,919) = lu(k,919) - lu(k,441) * lu(k,894) + lu(k,921) = lu(k,921) - lu(k,442) * lu(k,894) + lu(k,981) = lu(k,981) - lu(k,433) * lu(k,975) + lu(k,983) = lu(k,983) - lu(k,434) * lu(k,975) + lu(k,984) = lu(k,984) - lu(k,435) * lu(k,975) + lu(k,986) = lu(k,986) - lu(k,436) * lu(k,975) + lu(k,992) = lu(k,992) - lu(k,437) * lu(k,975) + lu(k,993) = lu(k,993) - lu(k,438) * lu(k,975) + lu(k,998) = lu(k,998) - lu(k,439) * lu(k,975) + lu(k,999) = lu(k,999) - lu(k,440) * lu(k,975) + lu(k,1003) = lu(k,1003) - lu(k,441) * lu(k,975) + lu(k,1005) = lu(k,1005) - lu(k,442) * lu(k,975) + lu(k,1094) = lu(k,1094) - lu(k,433) * lu(k,1090) + lu(k,1099) = lu(k,1099) - lu(k,434) * lu(k,1090) + lu(k,1101) = lu(k,1101) - lu(k,435) * lu(k,1090) + lu(k,1104) = lu(k,1104) - lu(k,436) * lu(k,1090) + lu(k,1111) = lu(k,1111) - lu(k,437) * lu(k,1090) + lu(k,1112) = lu(k,1112) - lu(k,438) * lu(k,1090) + lu(k,1119) = - lu(k,439) * lu(k,1090) + lu(k,1120) = lu(k,1120) - lu(k,440) * lu(k,1090) + lu(k,1124) = lu(k,1124) - lu(k,441) * lu(k,1090) + lu(k,1126) = lu(k,1126) - lu(k,442) * lu(k,1090) + lu(k,1469) = lu(k,1469) - lu(k,433) * lu(k,1465) + lu(k,1474) = lu(k,1474) - lu(k,434) * lu(k,1465) + lu(k,1476) = lu(k,1476) - lu(k,435) * lu(k,1465) + lu(k,1479) = lu(k,1479) - lu(k,436) * lu(k,1465) + lu(k,1486) = lu(k,1486) - lu(k,437) * lu(k,1465) + lu(k,1487) = lu(k,1487) - lu(k,438) * lu(k,1465) + lu(k,1494) = lu(k,1494) - lu(k,439) * lu(k,1465) + lu(k,1495) = lu(k,1495) - lu(k,440) * lu(k,1465) + lu(k,1499) = lu(k,1499) - lu(k,441) * lu(k,1465) + lu(k,1501) = lu(k,1501) - lu(k,442) * lu(k,1465) + lu(k,1511) = lu(k,1511) - lu(k,433) * lu(k,1506) + lu(k,1515) = lu(k,1515) - lu(k,434) * lu(k,1506) + lu(k,1517) = lu(k,1517) - lu(k,435) * lu(k,1506) + lu(k,1520) = - lu(k,436) * lu(k,1506) + lu(k,1527) = - lu(k,437) * lu(k,1506) + lu(k,1528) = lu(k,1528) - lu(k,438) * lu(k,1506) + lu(k,1535) = lu(k,1535) - lu(k,439) * lu(k,1506) + lu(k,1536) = lu(k,1536) - lu(k,440) * lu(k,1506) + lu(k,1540) = lu(k,1540) - lu(k,441) * lu(k,1506) + lu(k,1542) = lu(k,1542) - lu(k,442) * lu(k,1506) + lu(k,1954) = lu(k,1954) - lu(k,433) * lu(k,1946) + lu(k,1958) = lu(k,1958) - lu(k,434) * lu(k,1946) + lu(k,1960) = lu(k,1960) - lu(k,435) * lu(k,1946) + lu(k,1963) = lu(k,1963) - lu(k,436) * lu(k,1946) + lu(k,1970) = lu(k,1970) - lu(k,437) * lu(k,1946) + lu(k,1971) = lu(k,1971) - lu(k,438) * lu(k,1946) + lu(k,1978) = - lu(k,439) * lu(k,1946) + lu(k,1979) = lu(k,1979) - lu(k,440) * lu(k,1946) + lu(k,1983) = lu(k,1983) - lu(k,441) * lu(k,1946) + lu(k,1985) = lu(k,1985) - lu(k,442) * lu(k,1946) + lu(k,2059) = lu(k,2059) - lu(k,433) * lu(k,2047) + lu(k,2063) = lu(k,2063) - lu(k,434) * lu(k,2047) + lu(k,2065) = lu(k,2065) - lu(k,435) * lu(k,2047) + lu(k,2068) = - lu(k,436) * lu(k,2047) + lu(k,2075) = lu(k,2075) - lu(k,437) * lu(k,2047) + lu(k,2076) = lu(k,2076) - lu(k,438) * lu(k,2047) + lu(k,2083) = lu(k,2083) - lu(k,439) * lu(k,2047) + lu(k,2084) = lu(k,2084) - lu(k,440) * lu(k,2047) + lu(k,2088) = lu(k,2088) - lu(k,441) * lu(k,2047) + lu(k,2090) = lu(k,2090) - lu(k,442) * lu(k,2047) + lu(k,446) = 1._r8 / lu(k,446) + lu(k,447) = lu(k,447) * lu(k,446) + lu(k,448) = lu(k,448) * lu(k,446) + lu(k,449) = lu(k,449) * lu(k,446) + lu(k,450) = lu(k,450) * lu(k,446) + lu(k,451) = lu(k,451) * lu(k,446) + lu(k,452) = lu(k,452) * lu(k,446) + lu(k,453) = lu(k,453) * lu(k,446) + lu(k,454) = lu(k,454) * lu(k,446) + lu(k,455) = lu(k,455) * lu(k,446) + lu(k,456) = lu(k,456) * lu(k,446) + lu(k,457) = lu(k,457) * lu(k,446) + lu(k,458) = lu(k,458) * lu(k,446) + lu(k,982) = lu(k,982) - lu(k,447) * lu(k,976) + lu(k,983) = lu(k,983) - lu(k,448) * lu(k,976) + lu(k,984) = lu(k,984) - lu(k,449) * lu(k,976) + lu(k,985) = lu(k,985) - lu(k,450) * lu(k,976) + lu(k,987) = - lu(k,451) * lu(k,976) + lu(k,989) = lu(k,989) - lu(k,452) * lu(k,976) + lu(k,991) = lu(k,991) - lu(k,453) * lu(k,976) + lu(k,992) = lu(k,992) - lu(k,454) * lu(k,976) + lu(k,996) = - lu(k,455) * lu(k,976) + lu(k,998) = lu(k,998) - lu(k,456) * lu(k,976) + lu(k,999) = lu(k,999) - lu(k,457) * lu(k,976) + lu(k,1003) = lu(k,1003) - lu(k,458) * lu(k,976) + lu(k,1055) = lu(k,1055) - lu(k,447) * lu(k,1053) + lu(k,1056) = lu(k,1056) - lu(k,448) * lu(k,1053) + lu(k,1057) = lu(k,1057) - lu(k,449) * lu(k,1053) + lu(k,1058) = lu(k,1058) - lu(k,450) * lu(k,1053) + lu(k,1060) = lu(k,1060) - lu(k,451) * lu(k,1053) + lu(k,1063) = lu(k,1063) - lu(k,452) * lu(k,1053) + lu(k,1065) = lu(k,1065) - lu(k,453) * lu(k,1053) + lu(k,1066) = lu(k,1066) - lu(k,454) * lu(k,1053) + lu(k,1070) = lu(k,1070) - lu(k,455) * lu(k,1053) + lu(k,1074) = lu(k,1074) - lu(k,456) * lu(k,1053) + lu(k,1075) = lu(k,1075) - lu(k,457) * lu(k,1053) + lu(k,1079) = lu(k,1079) - lu(k,458) * lu(k,1053) + lu(k,1143) = lu(k,1143) - lu(k,447) * lu(k,1132) + lu(k,1147) = lu(k,1147) - lu(k,448) * lu(k,1132) + lu(k,1149) = lu(k,1149) - lu(k,449) * lu(k,1132) + lu(k,1151) = lu(k,1151) - lu(k,450) * lu(k,1132) + lu(k,1153) = lu(k,1153) - lu(k,451) * lu(k,1132) + lu(k,1156) = lu(k,1156) - lu(k,452) * lu(k,1132) + lu(k,1158) = lu(k,1158) - lu(k,453) * lu(k,1132) + lu(k,1159) = lu(k,1159) - lu(k,454) * lu(k,1132) + lu(k,1163) = lu(k,1163) - lu(k,455) * lu(k,1132) + lu(k,1167) = - lu(k,456) * lu(k,1132) + lu(k,1168) = lu(k,1168) - lu(k,457) * lu(k,1132) + lu(k,1172) = lu(k,1172) - lu(k,458) * lu(k,1132) + lu(k,1272) = lu(k,1272) - lu(k,447) * lu(k,1268) + lu(k,1275) = lu(k,1275) - lu(k,448) * lu(k,1268) + lu(k,1277) = lu(k,1277) - lu(k,449) * lu(k,1268) + lu(k,1279) = lu(k,1279) - lu(k,450) * lu(k,1268) + lu(k,1281) = lu(k,1281) - lu(k,451) * lu(k,1268) + lu(k,1284) = lu(k,1284) - lu(k,452) * lu(k,1268) + lu(k,1286) = lu(k,1286) - lu(k,453) * lu(k,1268) + lu(k,1287) = lu(k,1287) - lu(k,454) * lu(k,1268) + lu(k,1291) = lu(k,1291) - lu(k,455) * lu(k,1268) + lu(k,1295) = - lu(k,456) * lu(k,1268) + lu(k,1296) = - lu(k,457) * lu(k,1268) + lu(k,1300) = lu(k,1300) - lu(k,458) * lu(k,1268) + lu(k,1373) = lu(k,1373) - lu(k,447) * lu(k,1365) + lu(k,1377) = lu(k,1377) - lu(k,448) * lu(k,1365) + lu(k,1379) = lu(k,1379) - lu(k,449) * lu(k,1365) + lu(k,1381) = lu(k,1381) - lu(k,450) * lu(k,1365) + lu(k,1383) = lu(k,1383) - lu(k,451) * lu(k,1365) + lu(k,1386) = lu(k,1386) - lu(k,452) * lu(k,1365) + lu(k,1388) = lu(k,1388) - lu(k,453) * lu(k,1365) + lu(k,1389) = lu(k,1389) - lu(k,454) * lu(k,1365) + lu(k,1393) = lu(k,1393) - lu(k,455) * lu(k,1365) + lu(k,1397) = lu(k,1397) - lu(k,456) * lu(k,1365) + lu(k,1398) = lu(k,1398) - lu(k,457) * lu(k,1365) + lu(k,1402) = lu(k,1402) - lu(k,458) * lu(k,1365) + lu(k,1423) = lu(k,1423) - lu(k,447) * lu(k,1416) + lu(k,1426) = lu(k,1426) - lu(k,448) * lu(k,1416) + lu(k,1428) = lu(k,1428) - lu(k,449) * lu(k,1416) + lu(k,1430) = lu(k,1430) - lu(k,450) * lu(k,1416) + lu(k,1432) = lu(k,1432) - lu(k,451) * lu(k,1416) + lu(k,1435) = lu(k,1435) - lu(k,452) * lu(k,1416) + lu(k,1437) = lu(k,1437) - lu(k,453) * lu(k,1416) + lu(k,1438) = lu(k,1438) - lu(k,454) * lu(k,1416) + lu(k,1442) = lu(k,1442) - lu(k,455) * lu(k,1416) + lu(k,1446) = lu(k,1446) - lu(k,456) * lu(k,1416) + lu(k,1447) = - lu(k,457) * lu(k,1416) + lu(k,1451) = lu(k,1451) - lu(k,458) * lu(k,1416) + lu(k,1592) = lu(k,1592) - lu(k,447) * lu(k,1580) + lu(k,1596) = - lu(k,448) * lu(k,1580) + lu(k,1598) = lu(k,1598) - lu(k,449) * lu(k,1580) + lu(k,1600) = lu(k,1600) - lu(k,450) * lu(k,1580) + lu(k,1602) = lu(k,1602) - lu(k,451) * lu(k,1580) + lu(k,1605) = lu(k,1605) - lu(k,452) * lu(k,1580) + lu(k,1607) = lu(k,1607) - lu(k,453) * lu(k,1580) + lu(k,1608) = lu(k,1608) - lu(k,454) * lu(k,1580) + lu(k,1612) = lu(k,1612) - lu(k,455) * lu(k,1580) + lu(k,1616) = lu(k,1616) - lu(k,456) * lu(k,1580) + lu(k,1617) = lu(k,1617) - lu(k,457) * lu(k,1580) + lu(k,1621) = lu(k,1621) - lu(k,458) * lu(k,1580) + lu(k,1803) = lu(k,1803) - lu(k,447) * lu(k,1793) + lu(k,1806) = lu(k,1806) - lu(k,448) * lu(k,1793) + lu(k,1808) = lu(k,1808) - lu(k,449) * lu(k,1793) + lu(k,1810) = - lu(k,450) * lu(k,1793) + lu(k,1812) = - lu(k,451) * lu(k,1793) + lu(k,1815) = lu(k,1815) - lu(k,452) * lu(k,1793) + lu(k,1817) = lu(k,1817) - lu(k,453) * lu(k,1793) + lu(k,1818) = lu(k,1818) - lu(k,454) * lu(k,1793) + lu(k,1822) = - lu(k,455) * lu(k,1793) + lu(k,1826) = - lu(k,456) * lu(k,1793) + lu(k,1827) = lu(k,1827) - lu(k,457) * lu(k,1793) + lu(k,1831) = lu(k,1831) - lu(k,458) * lu(k,1793) + lu(k,1955) = - lu(k,447) * lu(k,1947) + lu(k,1958) = lu(k,1958) - lu(k,448) * lu(k,1947) + lu(k,1960) = lu(k,1960) - lu(k,449) * lu(k,1947) + lu(k,1962) = lu(k,1962) - lu(k,450) * lu(k,1947) + lu(k,1964) = lu(k,1964) - lu(k,451) * lu(k,1947) + lu(k,1967) = lu(k,1967) - lu(k,452) * lu(k,1947) + lu(k,1969) = lu(k,1969) - lu(k,453) * lu(k,1947) + lu(k,1970) = lu(k,1970) - lu(k,454) * lu(k,1947) + lu(k,1974) = lu(k,1974) - lu(k,455) * lu(k,1947) + lu(k,1978) = lu(k,1978) - lu(k,456) * lu(k,1947) + lu(k,1979) = lu(k,1979) - lu(k,457) * lu(k,1947) + lu(k,1983) = lu(k,1983) - lu(k,458) * lu(k,1947) + lu(k,461) = 1._r8 / lu(k,461) + lu(k,462) = lu(k,462) * lu(k,461) + lu(k,463) = lu(k,463) * lu(k,461) + lu(k,464) = lu(k,464) * lu(k,461) + lu(k,465) = lu(k,465) * lu(k,461) + lu(k,466) = lu(k,466) * lu(k,461) + lu(k,467) = lu(k,467) * lu(k,461) + lu(k,468) = lu(k,468) * lu(k,461) + lu(k,469) = lu(k,469) * lu(k,461) + lu(k,470) = lu(k,470) * lu(k,461) + lu(k,471) = lu(k,471) * lu(k,461) + lu(k,472) = lu(k,472) * lu(k,461) + lu(k,789) = lu(k,789) - lu(k,462) * lu(k,782) + lu(k,790) = lu(k,790) - lu(k,463) * lu(k,782) + lu(k,792) = - lu(k,464) * lu(k,782) + lu(k,794) = lu(k,794) - lu(k,465) * lu(k,782) + lu(k,795) = lu(k,795) - lu(k,466) * lu(k,782) + lu(k,798) = lu(k,798) - lu(k,467) * lu(k,782) + lu(k,799) = lu(k,799) - lu(k,468) * lu(k,782) + lu(k,801) = lu(k,801) - lu(k,469) * lu(k,782) + lu(k,804) = lu(k,804) - lu(k,470) * lu(k,782) + lu(k,805) = lu(k,805) - lu(k,471) * lu(k,782) + lu(k,808) = lu(k,808) - lu(k,472) * lu(k,782) + lu(k,1057) = lu(k,1057) - lu(k,462) * lu(k,1054) + lu(k,1058) = lu(k,1058) - lu(k,463) * lu(k,1054) + lu(k,1062) = lu(k,1062) - lu(k,464) * lu(k,1054) + lu(k,1065) = lu(k,1065) - lu(k,465) * lu(k,1054) + lu(k,1066) = lu(k,1066) - lu(k,466) * lu(k,1054) + lu(k,1069) = lu(k,1069) - lu(k,467) * lu(k,1054) + lu(k,1070) = lu(k,1070) - lu(k,468) * lu(k,1054) + lu(k,1074) = lu(k,1074) - lu(k,469) * lu(k,1054) + lu(k,1077) = lu(k,1077) - lu(k,470) * lu(k,1054) + lu(k,1078) = lu(k,1078) - lu(k,471) * lu(k,1054) + lu(k,1081) = lu(k,1081) - lu(k,472) * lu(k,1054) + lu(k,1277) = lu(k,1277) - lu(k,462) * lu(k,1269) + lu(k,1279) = lu(k,1279) - lu(k,463) * lu(k,1269) + lu(k,1283) = - lu(k,464) * lu(k,1269) + lu(k,1286) = lu(k,1286) - lu(k,465) * lu(k,1269) + lu(k,1287) = lu(k,1287) - lu(k,466) * lu(k,1269) + lu(k,1290) = lu(k,1290) - lu(k,467) * lu(k,1269) + lu(k,1291) = lu(k,1291) - lu(k,468) * lu(k,1269) + lu(k,1295) = lu(k,1295) - lu(k,469) * lu(k,1269) + lu(k,1298) = lu(k,1298) - lu(k,470) * lu(k,1269) + lu(k,1299) = lu(k,1299) - lu(k,471) * lu(k,1269) + lu(k,1302) = lu(k,1302) - lu(k,472) * lu(k,1269) + lu(k,1379) = lu(k,1379) - lu(k,462) * lu(k,1366) + lu(k,1381) = lu(k,1381) - lu(k,463) * lu(k,1366) + lu(k,1385) = - lu(k,464) * lu(k,1366) + lu(k,1388) = lu(k,1388) - lu(k,465) * lu(k,1366) + lu(k,1389) = lu(k,1389) - lu(k,466) * lu(k,1366) + lu(k,1392) = lu(k,1392) - lu(k,467) * lu(k,1366) + lu(k,1393) = lu(k,1393) - lu(k,468) * lu(k,1366) + lu(k,1397) = lu(k,1397) - lu(k,469) * lu(k,1366) + lu(k,1400) = lu(k,1400) - lu(k,470) * lu(k,1366) + lu(k,1401) = lu(k,1401) - lu(k,471) * lu(k,1366) + lu(k,1404) = lu(k,1404) - lu(k,472) * lu(k,1366) + lu(k,1428) = lu(k,1428) - lu(k,462) * lu(k,1417) + lu(k,1430) = lu(k,1430) - lu(k,463) * lu(k,1417) + lu(k,1434) = - lu(k,464) * lu(k,1417) + lu(k,1437) = lu(k,1437) - lu(k,465) * lu(k,1417) + lu(k,1438) = lu(k,1438) - lu(k,466) * lu(k,1417) + lu(k,1441) = lu(k,1441) - lu(k,467) * lu(k,1417) + lu(k,1442) = lu(k,1442) - lu(k,468) * lu(k,1417) + lu(k,1446) = lu(k,1446) - lu(k,469) * lu(k,1417) + lu(k,1449) = lu(k,1449) - lu(k,470) * lu(k,1417) + lu(k,1450) = lu(k,1450) - lu(k,471) * lu(k,1417) + lu(k,1453) = lu(k,1453) - lu(k,472) * lu(k,1417) + lu(k,1553) = - lu(k,462) * lu(k,1546) + lu(k,1555) = lu(k,1555) - lu(k,463) * lu(k,1546) + lu(k,1559) = lu(k,1559) - lu(k,464) * lu(k,1546) + lu(k,1562) = lu(k,1562) - lu(k,465) * lu(k,1546) + lu(k,1563) = lu(k,1563) - lu(k,466) * lu(k,1546) + lu(k,1566) = lu(k,1566) - lu(k,467) * lu(k,1546) + lu(k,1567) = lu(k,1567) - lu(k,468) * lu(k,1546) + lu(k,1571) = lu(k,1571) - lu(k,469) * lu(k,1546) + lu(k,1574) = lu(k,1574) - lu(k,470) * lu(k,1546) + lu(k,1575) = lu(k,1575) - lu(k,471) * lu(k,1546) + lu(k,1578) = lu(k,1578) - lu(k,472) * lu(k,1546) + lu(k,1598) = lu(k,1598) - lu(k,462) * lu(k,1581) + lu(k,1600) = lu(k,1600) - lu(k,463) * lu(k,1581) + lu(k,1604) = lu(k,1604) - lu(k,464) * lu(k,1581) + lu(k,1607) = lu(k,1607) - lu(k,465) * lu(k,1581) + lu(k,1608) = lu(k,1608) - lu(k,466) * lu(k,1581) + lu(k,1611) = lu(k,1611) - lu(k,467) * lu(k,1581) + lu(k,1612) = lu(k,1612) - lu(k,468) * lu(k,1581) + lu(k,1616) = lu(k,1616) - lu(k,469) * lu(k,1581) + lu(k,1619) = - lu(k,470) * lu(k,1581) + lu(k,1620) = - lu(k,471) * lu(k,1581) + lu(k,1623) = lu(k,1623) - lu(k,472) * lu(k,1581) + lu(k,1877) = lu(k,1877) - lu(k,462) * lu(k,1868) + lu(k,1879) = lu(k,1879) - lu(k,463) * lu(k,1868) + lu(k,1883) = - lu(k,464) * lu(k,1868) + lu(k,1886) = lu(k,1886) - lu(k,465) * lu(k,1868) + lu(k,1887) = lu(k,1887) - lu(k,466) * lu(k,1868) + lu(k,1890) = lu(k,1890) - lu(k,467) * lu(k,1868) + lu(k,1891) = lu(k,1891) - lu(k,468) * lu(k,1868) + lu(k,1895) = lu(k,1895) - lu(k,469) * lu(k,1868) + lu(k,1898) = lu(k,1898) - lu(k,470) * lu(k,1868) + lu(k,1899) = lu(k,1899) - lu(k,471) * lu(k,1868) + lu(k,1902) = lu(k,1902) - lu(k,472) * lu(k,1868) + lu(k,1918) = lu(k,1918) - lu(k,462) * lu(k,1907) + lu(k,1920) = lu(k,1920) - lu(k,463) * lu(k,1907) + lu(k,1924) = - lu(k,464) * lu(k,1907) + lu(k,1927) = lu(k,1927) - lu(k,465) * lu(k,1907) + lu(k,1928) = lu(k,1928) - lu(k,466) * lu(k,1907) + lu(k,1931) = lu(k,1931) - lu(k,467) * lu(k,1907) + lu(k,1932) = lu(k,1932) - lu(k,468) * lu(k,1907) + lu(k,1936) = lu(k,1936) - lu(k,469) * lu(k,1907) + lu(k,1939) = lu(k,1939) - lu(k,470) * lu(k,1907) + lu(k,1940) = lu(k,1940) - lu(k,471) * lu(k,1907) + lu(k,1943) = lu(k,1943) - lu(k,472) * lu(k,1907) + lu(k,2065) = lu(k,2065) - lu(k,462) * lu(k,2048) + lu(k,2067) = lu(k,2067) - lu(k,463) * lu(k,2048) + lu(k,2071) = lu(k,2071) - lu(k,464) * lu(k,2048) + lu(k,2074) = lu(k,2074) - lu(k,465) * lu(k,2048) + lu(k,2075) = lu(k,2075) - lu(k,466) * lu(k,2048) + lu(k,2078) = - lu(k,467) * lu(k,2048) + lu(k,2079) = lu(k,2079) - lu(k,468) * lu(k,2048) + lu(k,2083) = lu(k,2083) - lu(k,469) * lu(k,2048) + lu(k,2086) = lu(k,2086) - lu(k,470) * lu(k,2048) + lu(k,2087) = - lu(k,471) * lu(k,2048) + lu(k,2090) = lu(k,2090) - lu(k,472) * lu(k,2048) + 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,476) = 1._r8 / lu(k,476) + lu(k,477) = lu(k,477) * lu(k,476) + lu(k,478) = lu(k,478) * lu(k,476) + lu(k,479) = lu(k,479) * lu(k,476) + lu(k,480) = lu(k,480) * lu(k,476) + lu(k,481) = lu(k,481) * lu(k,476) + lu(k,482) = lu(k,482) * lu(k,476) + lu(k,483) = lu(k,483) * lu(k,476) + lu(k,484) = lu(k,484) * lu(k,476) + lu(k,485) = lu(k,485) * lu(k,476) + lu(k,486) = lu(k,486) * lu(k,476) + lu(k,487) = lu(k,487) * lu(k,476) + lu(k,488) = lu(k,488) * lu(k,476) + lu(k,489) = lu(k,489) * lu(k,476) + lu(k,714) = lu(k,714) - lu(k,477) * lu(k,713) + lu(k,715) = lu(k,715) - lu(k,478) * lu(k,713) + lu(k,718) = lu(k,718) - lu(k,479) * lu(k,713) + lu(k,719) = lu(k,719) - lu(k,480) * lu(k,713) + lu(k,720) = lu(k,720) - lu(k,481) * lu(k,713) + lu(k,722) = lu(k,722) - lu(k,482) * lu(k,713) + lu(k,723) = lu(k,723) - lu(k,483) * lu(k,713) + lu(k,724) = lu(k,724) - lu(k,484) * lu(k,713) + lu(k,727) = - lu(k,485) * lu(k,713) + lu(k,728) = lu(k,728) - lu(k,486) * lu(k,713) + lu(k,729) = - lu(k,487) * lu(k,713) + lu(k,730) = lu(k,730) - lu(k,488) * lu(k,713) + lu(k,732) = lu(k,732) - lu(k,489) * lu(k,713) + lu(k,978) = lu(k,978) - lu(k,477) * lu(k,977) + lu(k,980) = lu(k,980) - lu(k,478) * lu(k,977) + lu(k,983) = lu(k,983) - lu(k,479) * lu(k,977) + lu(k,984) = lu(k,984) - lu(k,480) * lu(k,977) + lu(k,986) = lu(k,986) - lu(k,481) * lu(k,977) + lu(k,991) = lu(k,991) - lu(k,482) * lu(k,977) + lu(k,992) = lu(k,992) - lu(k,483) * lu(k,977) + lu(k,993) = lu(k,993) - lu(k,484) * lu(k,977) + lu(k,998) = lu(k,998) - lu(k,485) * lu(k,977) + lu(k,999) = lu(k,999) - lu(k,486) * lu(k,977) + lu(k,1002) = lu(k,1002) - lu(k,487) * lu(k,977) + lu(k,1003) = lu(k,1003) - lu(k,488) * lu(k,977) + lu(k,1005) = lu(k,1005) - lu(k,489) * lu(k,977) + lu(k,1092) = lu(k,1092) - lu(k,477) * lu(k,1091) + lu(k,1093) = lu(k,1093) - lu(k,478) * lu(k,1091) + lu(k,1099) = lu(k,1099) - lu(k,479) * lu(k,1091) + lu(k,1101) = lu(k,1101) - lu(k,480) * lu(k,1091) + lu(k,1104) = lu(k,1104) - lu(k,481) * lu(k,1091) + lu(k,1110) = lu(k,1110) - lu(k,482) * lu(k,1091) + lu(k,1111) = lu(k,1111) - lu(k,483) * lu(k,1091) + lu(k,1112) = lu(k,1112) - lu(k,484) * lu(k,1091) + lu(k,1119) = lu(k,1119) - lu(k,485) * lu(k,1091) + lu(k,1120) = lu(k,1120) - lu(k,486) * lu(k,1091) + lu(k,1123) = - lu(k,487) * lu(k,1091) + lu(k,1124) = lu(k,1124) - lu(k,488) * lu(k,1091) + lu(k,1126) = lu(k,1126) - lu(k,489) * lu(k,1091) + lu(k,1368) = lu(k,1368) - lu(k,477) * lu(k,1367) + lu(k,1371) = lu(k,1371) - lu(k,478) * lu(k,1367) + lu(k,1377) = lu(k,1377) - lu(k,479) * lu(k,1367) + lu(k,1379) = lu(k,1379) - lu(k,480) * lu(k,1367) + lu(k,1382) = lu(k,1382) - lu(k,481) * lu(k,1367) + lu(k,1388) = lu(k,1388) - lu(k,482) * lu(k,1367) + lu(k,1389) = lu(k,1389) - lu(k,483) * lu(k,1367) + lu(k,1390) = lu(k,1390) - lu(k,484) * lu(k,1367) + lu(k,1397) = lu(k,1397) - lu(k,485) * lu(k,1367) + lu(k,1398) = lu(k,1398) - lu(k,486) * lu(k,1367) + lu(k,1401) = lu(k,1401) - lu(k,487) * lu(k,1367) + lu(k,1402) = lu(k,1402) - lu(k,488) * lu(k,1367) + lu(k,1404) = lu(k,1404) - lu(k,489) * lu(k,1367) + lu(k,1419) = - lu(k,477) * lu(k,1418) + lu(k,1421) = - lu(k,478) * lu(k,1418) + lu(k,1426) = lu(k,1426) - lu(k,479) * lu(k,1418) + lu(k,1428) = lu(k,1428) - lu(k,480) * lu(k,1418) + lu(k,1431) = - lu(k,481) * lu(k,1418) + lu(k,1437) = lu(k,1437) - lu(k,482) * lu(k,1418) + lu(k,1438) = lu(k,1438) - lu(k,483) * lu(k,1418) + lu(k,1439) = - lu(k,484) * lu(k,1418) + lu(k,1446) = lu(k,1446) - lu(k,485) * lu(k,1418) + lu(k,1447) = lu(k,1447) - lu(k,486) * lu(k,1418) + lu(k,1450) = lu(k,1450) - lu(k,487) * lu(k,1418) + lu(k,1451) = lu(k,1451) - lu(k,488) * lu(k,1418) + lu(k,1453) = lu(k,1453) - lu(k,489) * lu(k,1418) + lu(k,1715) = - lu(k,477) * lu(k,1714) + lu(k,1719) = - lu(k,478) * lu(k,1714) + lu(k,1723) = lu(k,1723) - lu(k,479) * lu(k,1714) + lu(k,1725) = lu(k,1725) - lu(k,480) * lu(k,1714) + lu(k,1727) = - lu(k,481) * lu(k,1714) + lu(k,1733) = lu(k,1733) - lu(k,482) * lu(k,1714) + lu(k,1734) = lu(k,1734) - lu(k,483) * lu(k,1714) + lu(k,1735) = - lu(k,484) * lu(k,1714) + lu(k,1742) = - lu(k,485) * lu(k,1714) + lu(k,1743) = lu(k,1743) - lu(k,486) * lu(k,1714) + lu(k,1746) = - lu(k,487) * lu(k,1714) + lu(k,1747) = lu(k,1747) - lu(k,488) * lu(k,1714) + lu(k,1749) = lu(k,1749) - lu(k,489) * lu(k,1714) + lu(k,1795) = lu(k,1795) - lu(k,477) * lu(k,1794) + lu(k,1801) = lu(k,1801) - lu(k,478) * lu(k,1794) + lu(k,1806) = lu(k,1806) - lu(k,479) * lu(k,1794) + lu(k,1808) = lu(k,1808) - lu(k,480) * lu(k,1794) + lu(k,1811) = lu(k,1811) - lu(k,481) * lu(k,1794) + lu(k,1817) = lu(k,1817) - lu(k,482) * lu(k,1794) + lu(k,1818) = lu(k,1818) - lu(k,483) * lu(k,1794) + lu(k,1819) = lu(k,1819) - lu(k,484) * lu(k,1794) + lu(k,1826) = lu(k,1826) - lu(k,485) * lu(k,1794) + lu(k,1827) = lu(k,1827) - lu(k,486) * lu(k,1794) + lu(k,1830) = lu(k,1830) - lu(k,487) * lu(k,1794) + lu(k,1831) = lu(k,1831) - lu(k,488) * lu(k,1794) + lu(k,1833) = lu(k,1833) - lu(k,489) * lu(k,1794) + lu(k,1909) = lu(k,1909) - lu(k,477) * lu(k,1908) + lu(k,1911) = lu(k,1911) - lu(k,478) * lu(k,1908) + lu(k,1916) = lu(k,1916) - lu(k,479) * lu(k,1908) + lu(k,1918) = lu(k,1918) - lu(k,480) * lu(k,1908) + lu(k,1921) = lu(k,1921) - lu(k,481) * lu(k,1908) + lu(k,1927) = lu(k,1927) - lu(k,482) * lu(k,1908) + lu(k,1928) = lu(k,1928) - lu(k,483) * lu(k,1908) + lu(k,1929) = lu(k,1929) - lu(k,484) * lu(k,1908) + lu(k,1936) = lu(k,1936) - lu(k,485) * lu(k,1908) + lu(k,1937) = lu(k,1937) - lu(k,486) * lu(k,1908) + lu(k,1940) = lu(k,1940) - lu(k,487) * lu(k,1908) + lu(k,1941) = lu(k,1941) - lu(k,488) * lu(k,1908) + lu(k,1943) = lu(k,1943) - lu(k,489) * lu(k,1908) + lu(k,2053) = - lu(k,477) * lu(k,2049) + lu(k,2058) = - lu(k,478) * lu(k,2049) + lu(k,2063) = lu(k,2063) - lu(k,479) * lu(k,2049) + lu(k,2065) = lu(k,2065) - lu(k,480) * lu(k,2049) + lu(k,2068) = lu(k,2068) - lu(k,481) * lu(k,2049) + lu(k,2074) = lu(k,2074) - lu(k,482) * lu(k,2049) + lu(k,2075) = lu(k,2075) - lu(k,483) * lu(k,2049) + lu(k,2076) = lu(k,2076) - lu(k,484) * lu(k,2049) + lu(k,2083) = lu(k,2083) - lu(k,485) * lu(k,2049) + lu(k,2084) = lu(k,2084) - lu(k,486) * lu(k,2049) + lu(k,2087) = lu(k,2087) - lu(k,487) * lu(k,2049) + lu(k,2088) = lu(k,2088) - lu(k,488) * lu(k,2049) + lu(k,2090) = lu(k,2090) - lu(k,489) * lu(k,2049) + lu(k,490) = 1._r8 / lu(k,490) + lu(k,491) = lu(k,491) * lu(k,490) + lu(k,492) = lu(k,492) * lu(k,490) + lu(k,493) = lu(k,493) * lu(k,490) + lu(k,494) = lu(k,494) * lu(k,490) + lu(k,495) = lu(k,495) * lu(k,490) + lu(k,496) = lu(k,496) * lu(k,490) + lu(k,497) = lu(k,497) * lu(k,490) + lu(k,498) = lu(k,498) * lu(k,490) + lu(k,499) = lu(k,499) * lu(k,490) + lu(k,500) = lu(k,500) * lu(k,490) + lu(k,501) = lu(k,501) * lu(k,490) + lu(k,502) = lu(k,502) * lu(k,490) + lu(k,503) = lu(k,503) * lu(k,490) + lu(k,1149) = lu(k,1149) - lu(k,491) * lu(k,1133) + lu(k,1153) = lu(k,1153) - lu(k,492) * lu(k,1133) + lu(k,1154) = - lu(k,493) * lu(k,1133) + lu(k,1155) = - lu(k,494) * lu(k,1133) + lu(k,1156) = lu(k,1156) - lu(k,495) * lu(k,1133) + lu(k,1157) = lu(k,1157) - lu(k,496) * lu(k,1133) + lu(k,1159) = lu(k,1159) - lu(k,497) * lu(k,1133) + lu(k,1163) = lu(k,1163) - lu(k,498) * lu(k,1133) + lu(k,1164) = - lu(k,499) * lu(k,1133) + lu(k,1165) = - lu(k,500) * lu(k,1133) + lu(k,1167) = lu(k,1167) - lu(k,501) * lu(k,1133) + lu(k,1172) = lu(k,1172) - lu(k,502) * lu(k,1133) + lu(k,1174) = lu(k,1174) - lu(k,503) * lu(k,1133) + lu(k,1192) = lu(k,1192) - lu(k,491) * lu(k,1177) + lu(k,1196) = - lu(k,492) * lu(k,1177) + lu(k,1197) = lu(k,1197) - lu(k,493) * lu(k,1177) + lu(k,1198) = lu(k,1198) - lu(k,494) * lu(k,1177) + lu(k,1199) = lu(k,1199) - lu(k,495) * lu(k,1177) + lu(k,1200) = - lu(k,496) * lu(k,1177) + lu(k,1202) = lu(k,1202) - lu(k,497) * lu(k,1177) + lu(k,1206) = - lu(k,498) * lu(k,1177) + lu(k,1207) = - lu(k,499) * lu(k,1177) + lu(k,1208) = - lu(k,500) * lu(k,1177) + lu(k,1210) = - lu(k,501) * lu(k,1177) + lu(k,1215) = lu(k,1215) - lu(k,502) * lu(k,1177) + lu(k,1217) = lu(k,1217) - lu(k,503) * lu(k,1177) + lu(k,1235) = lu(k,1235) - lu(k,491) * lu(k,1220) + lu(k,1239) = - lu(k,492) * lu(k,1220) + lu(k,1240) = - lu(k,493) * lu(k,1220) + lu(k,1241) = lu(k,1241) - lu(k,494) * lu(k,1220) + lu(k,1242) = lu(k,1242) - lu(k,495) * lu(k,1220) + lu(k,1243) = - lu(k,496) * lu(k,1220) + lu(k,1245) = lu(k,1245) - lu(k,497) * lu(k,1220) + lu(k,1249) = - lu(k,498) * lu(k,1220) + lu(k,1250) = - lu(k,499) * lu(k,1220) + lu(k,1251) = lu(k,1251) - lu(k,500) * lu(k,1220) + lu(k,1253) = lu(k,1253) - lu(k,501) * lu(k,1220) + lu(k,1258) = - lu(k,502) * lu(k,1220) + lu(k,1260) = lu(k,1260) - lu(k,503) * lu(k,1220) + lu(k,1277) = lu(k,1277) - lu(k,491) * lu(k,1270) + lu(k,1281) = lu(k,1281) - lu(k,492) * lu(k,1270) + lu(k,1282) = - lu(k,493) * lu(k,1270) + lu(k,1283) = lu(k,1283) - lu(k,494) * lu(k,1270) + lu(k,1284) = lu(k,1284) - lu(k,495) * lu(k,1270) + lu(k,1285) = lu(k,1285) - lu(k,496) * lu(k,1270) + lu(k,1287) = lu(k,1287) - lu(k,497) * lu(k,1270) + lu(k,1291) = lu(k,1291) - lu(k,498) * lu(k,1270) + lu(k,1292) = - lu(k,499) * lu(k,1270) + lu(k,1293) = - lu(k,500) * lu(k,1270) + lu(k,1295) = lu(k,1295) - lu(k,501) * lu(k,1270) + lu(k,1300) = lu(k,1300) - lu(k,502) * lu(k,1270) + lu(k,1302) = lu(k,1302) - lu(k,503) * lu(k,1270) + lu(k,1319) = lu(k,1319) - lu(k,491) * lu(k,1304) + lu(k,1323) = - lu(k,492) * lu(k,1304) + lu(k,1324) = lu(k,1324) - lu(k,493) * lu(k,1304) + lu(k,1325) = lu(k,1325) - lu(k,494) * lu(k,1304) + lu(k,1326) = lu(k,1326) - lu(k,495) * lu(k,1304) + lu(k,1327) = lu(k,1327) - lu(k,496) * lu(k,1304) + lu(k,1329) = lu(k,1329) - lu(k,497) * lu(k,1304) + lu(k,1333) = - lu(k,498) * lu(k,1304) + lu(k,1334) = - lu(k,499) * lu(k,1304) + lu(k,1335) = - lu(k,500) * lu(k,1304) + lu(k,1337) = lu(k,1337) - lu(k,501) * lu(k,1304) + lu(k,1342) = lu(k,1342) - lu(k,502) * lu(k,1304) + lu(k,1344) = lu(k,1344) - lu(k,503) * lu(k,1304) + lu(k,1598) = lu(k,1598) - lu(k,491) * lu(k,1582) + lu(k,1602) = lu(k,1602) - lu(k,492) * lu(k,1582) + lu(k,1603) = - lu(k,493) * lu(k,1582) + lu(k,1604) = lu(k,1604) - lu(k,494) * lu(k,1582) + lu(k,1605) = lu(k,1605) - lu(k,495) * lu(k,1582) + lu(k,1606) = - lu(k,496) * lu(k,1582) + lu(k,1608) = lu(k,1608) - lu(k,497) * lu(k,1582) + lu(k,1612) = lu(k,1612) - lu(k,498) * lu(k,1582) + lu(k,1613) = - lu(k,499) * lu(k,1582) + lu(k,1614) = - lu(k,500) * lu(k,1582) + lu(k,1616) = lu(k,1616) - lu(k,501) * lu(k,1582) + lu(k,1621) = lu(k,1621) - lu(k,502) * lu(k,1582) + lu(k,1623) = lu(k,1623) - lu(k,503) * lu(k,1582) + lu(k,1641) = lu(k,1641) - lu(k,491) * lu(k,1626) + lu(k,1645) = - lu(k,492) * lu(k,1626) + lu(k,1646) = - lu(k,493) * lu(k,1626) + lu(k,1647) = - lu(k,494) * lu(k,1626) + lu(k,1648) = lu(k,1648) - lu(k,495) * lu(k,1626) + lu(k,1649) = - lu(k,496) * lu(k,1626) + lu(k,1651) = lu(k,1651) - lu(k,497) * lu(k,1626) + lu(k,1655) = - lu(k,498) * lu(k,1626) + lu(k,1656) = lu(k,1656) - lu(k,499) * lu(k,1626) + lu(k,1657) = lu(k,1657) - lu(k,500) * lu(k,1626) + lu(k,1659) = lu(k,1659) - lu(k,501) * lu(k,1626) + lu(k,1664) = lu(k,1664) - lu(k,502) * lu(k,1626) + lu(k,1666) = lu(k,1666) - lu(k,503) * lu(k,1626) + lu(k,1684) = lu(k,1684) - lu(k,491) * lu(k,1669) + lu(k,1688) = - lu(k,492) * lu(k,1669) + lu(k,1689) = - lu(k,493) * lu(k,1669) + lu(k,1690) = lu(k,1690) - lu(k,494) * lu(k,1669) + lu(k,1691) = lu(k,1691) - lu(k,495) * lu(k,1669) + lu(k,1692) = - lu(k,496) * lu(k,1669) + lu(k,1694) = lu(k,1694) - lu(k,497) * lu(k,1669) + lu(k,1698) = - lu(k,498) * lu(k,1669) + lu(k,1699) = lu(k,1699) - lu(k,499) * lu(k,1669) + lu(k,1700) = lu(k,1700) - lu(k,500) * lu(k,1669) + lu(k,1702) = lu(k,1702) - lu(k,501) * lu(k,1669) + lu(k,1707) = lu(k,1707) - lu(k,502) * lu(k,1669) + lu(k,1709) = lu(k,1709) - lu(k,503) * lu(k,1669) + lu(k,1841) = lu(k,1841) - lu(k,491) * lu(k,1835) + lu(k,1845) = - lu(k,492) * lu(k,1835) + lu(k,1846) = - lu(k,493) * lu(k,1835) + lu(k,1847) = - lu(k,494) * lu(k,1835) + lu(k,1848) = lu(k,1848) - lu(k,495) * lu(k,1835) + lu(k,1849) = - lu(k,496) * lu(k,1835) + lu(k,1851) = lu(k,1851) - lu(k,497) * lu(k,1835) + lu(k,1855) = - lu(k,498) * lu(k,1835) + lu(k,1856) = - lu(k,499) * lu(k,1835) + lu(k,1857) = - lu(k,500) * lu(k,1835) + lu(k,1859) = lu(k,1859) - lu(k,501) * lu(k,1835) + lu(k,1864) = lu(k,1864) - lu(k,502) * lu(k,1835) + lu(k,1866) = lu(k,1866) - lu(k,503) * lu(k,1835) + 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,504) = 1._r8 / lu(k,504) + lu(k,505) = lu(k,505) * lu(k,504) + lu(k,506) = lu(k,506) * lu(k,504) + lu(k,507) = lu(k,507) * lu(k,504) + lu(k,508) = lu(k,508) * lu(k,504) + lu(k,509) = lu(k,509) * lu(k,504) + lu(k,510) = lu(k,510) * lu(k,504) + lu(k,511) = lu(k,511) * lu(k,504) + lu(k,512) = lu(k,512) * lu(k,504) + lu(k,513) = lu(k,513) * lu(k,504) + lu(k,514) = lu(k,514) * lu(k,504) + lu(k,515) = lu(k,515) * lu(k,504) + lu(k,516) = lu(k,516) * lu(k,504) + lu(k,517) = lu(k,517) * lu(k,504) + lu(k,518) = lu(k,518) * lu(k,504) + lu(k,669) = lu(k,669) - lu(k,505) * lu(k,667) + lu(k,674) = lu(k,674) - lu(k,506) * lu(k,667) + lu(k,675) = lu(k,675) - lu(k,507) * lu(k,667) + lu(k,676) = lu(k,676) - lu(k,508) * lu(k,667) + lu(k,677) = lu(k,677) - lu(k,509) * lu(k,667) + lu(k,678) = lu(k,678) - lu(k,510) * lu(k,667) + lu(k,679) = lu(k,679) - lu(k,511) * lu(k,667) + lu(k,680) = lu(k,680) - lu(k,512) * lu(k,667) + lu(k,681) = lu(k,681) - lu(k,513) * lu(k,667) + lu(k,682) = lu(k,682) - lu(k,514) * lu(k,667) + lu(k,683) = lu(k,683) - lu(k,515) * lu(k,667) + lu(k,684) = lu(k,684) - lu(k,516) * lu(k,667) + lu(k,686) = lu(k,686) - lu(k,517) * lu(k,667) + lu(k,687) = lu(k,687) - lu(k,518) * lu(k,667) + lu(k,1141) = lu(k,1141) - lu(k,505) * lu(k,1134) + lu(k,1153) = lu(k,1153) - lu(k,506) * lu(k,1134) + lu(k,1154) = lu(k,1154) - lu(k,507) * lu(k,1134) + lu(k,1155) = lu(k,1155) - lu(k,508) * lu(k,1134) + lu(k,1156) = lu(k,1156) - lu(k,509) * lu(k,1134) + lu(k,1157) = lu(k,1157) - lu(k,510) * lu(k,1134) + lu(k,1158) = lu(k,1158) - lu(k,511) * lu(k,1134) + lu(k,1159) = lu(k,1159) - lu(k,512) * lu(k,1134) + lu(k,1163) = lu(k,1163) - lu(k,513) * lu(k,1134) + lu(k,1164) = lu(k,1164) - lu(k,514) * lu(k,1134) + lu(k,1165) = lu(k,1165) - lu(k,515) * lu(k,1134) + lu(k,1167) = lu(k,1167) - lu(k,516) * lu(k,1134) + lu(k,1172) = lu(k,1172) - lu(k,517) * lu(k,1134) + lu(k,1174) = lu(k,1174) - lu(k,518) * lu(k,1134) + lu(k,1185) = lu(k,1185) - lu(k,505) * lu(k,1178) + lu(k,1196) = lu(k,1196) - lu(k,506) * lu(k,1178) + lu(k,1197) = lu(k,1197) - lu(k,507) * lu(k,1178) + lu(k,1198) = lu(k,1198) - lu(k,508) * lu(k,1178) + lu(k,1199) = lu(k,1199) - lu(k,509) * lu(k,1178) + lu(k,1200) = lu(k,1200) - lu(k,510) * lu(k,1178) + lu(k,1201) = lu(k,1201) - lu(k,511) * lu(k,1178) + lu(k,1202) = lu(k,1202) - lu(k,512) * lu(k,1178) + lu(k,1206) = lu(k,1206) - lu(k,513) * lu(k,1178) + lu(k,1207) = lu(k,1207) - lu(k,514) * lu(k,1178) + lu(k,1208) = lu(k,1208) - lu(k,515) * lu(k,1178) + lu(k,1210) = lu(k,1210) - lu(k,516) * lu(k,1178) + lu(k,1215) = lu(k,1215) - lu(k,517) * lu(k,1178) + lu(k,1217) = lu(k,1217) - lu(k,518) * lu(k,1178) + lu(k,1228) = lu(k,1228) - lu(k,505) * lu(k,1221) + lu(k,1239) = lu(k,1239) - lu(k,506) * lu(k,1221) + lu(k,1240) = lu(k,1240) - lu(k,507) * lu(k,1221) + lu(k,1241) = lu(k,1241) - lu(k,508) * lu(k,1221) + lu(k,1242) = lu(k,1242) - lu(k,509) * lu(k,1221) + lu(k,1243) = lu(k,1243) - lu(k,510) * lu(k,1221) + lu(k,1244) = lu(k,1244) - lu(k,511) * lu(k,1221) + lu(k,1245) = lu(k,1245) - lu(k,512) * lu(k,1221) + lu(k,1249) = lu(k,1249) - lu(k,513) * lu(k,1221) + lu(k,1250) = lu(k,1250) - lu(k,514) * lu(k,1221) + lu(k,1251) = lu(k,1251) - lu(k,515) * lu(k,1221) + lu(k,1253) = lu(k,1253) - lu(k,516) * lu(k,1221) + lu(k,1258) = lu(k,1258) - lu(k,517) * lu(k,1221) + lu(k,1260) = lu(k,1260) - lu(k,518) * lu(k,1221) + lu(k,1312) = lu(k,1312) - lu(k,505) * lu(k,1305) + lu(k,1323) = lu(k,1323) - lu(k,506) * lu(k,1305) + lu(k,1324) = lu(k,1324) - lu(k,507) * lu(k,1305) + lu(k,1325) = lu(k,1325) - lu(k,508) * lu(k,1305) + lu(k,1326) = lu(k,1326) - lu(k,509) * lu(k,1305) + lu(k,1327) = lu(k,1327) - lu(k,510) * lu(k,1305) + lu(k,1328) = lu(k,1328) - lu(k,511) * lu(k,1305) + lu(k,1329) = lu(k,1329) - lu(k,512) * lu(k,1305) + lu(k,1333) = lu(k,1333) - lu(k,513) * lu(k,1305) + lu(k,1334) = lu(k,1334) - lu(k,514) * lu(k,1305) + lu(k,1335) = lu(k,1335) - lu(k,515) * lu(k,1305) + lu(k,1337) = lu(k,1337) - lu(k,516) * lu(k,1305) + lu(k,1342) = lu(k,1342) - lu(k,517) * lu(k,1305) + lu(k,1344) = lu(k,1344) - lu(k,518) * lu(k,1305) + lu(k,1590) = lu(k,1590) - lu(k,505) * lu(k,1583) + lu(k,1602) = lu(k,1602) - lu(k,506) * lu(k,1583) + lu(k,1603) = lu(k,1603) - lu(k,507) * lu(k,1583) + lu(k,1604) = lu(k,1604) - lu(k,508) * lu(k,1583) + lu(k,1605) = lu(k,1605) - lu(k,509) * lu(k,1583) + lu(k,1606) = lu(k,1606) - lu(k,510) * lu(k,1583) + lu(k,1607) = lu(k,1607) - lu(k,511) * lu(k,1583) + lu(k,1608) = lu(k,1608) - lu(k,512) * lu(k,1583) + lu(k,1612) = lu(k,1612) - lu(k,513) * lu(k,1583) + lu(k,1613) = lu(k,1613) - lu(k,514) * lu(k,1583) + lu(k,1614) = lu(k,1614) - lu(k,515) * lu(k,1583) + lu(k,1616) = lu(k,1616) - lu(k,516) * lu(k,1583) + lu(k,1621) = lu(k,1621) - lu(k,517) * lu(k,1583) + lu(k,1623) = lu(k,1623) - lu(k,518) * lu(k,1583) + lu(k,1634) = lu(k,1634) - lu(k,505) * lu(k,1627) + lu(k,1645) = lu(k,1645) - lu(k,506) * lu(k,1627) + lu(k,1646) = lu(k,1646) - lu(k,507) * lu(k,1627) + lu(k,1647) = lu(k,1647) - lu(k,508) * lu(k,1627) + lu(k,1648) = lu(k,1648) - lu(k,509) * lu(k,1627) + lu(k,1649) = lu(k,1649) - lu(k,510) * lu(k,1627) + lu(k,1650) = lu(k,1650) - lu(k,511) * lu(k,1627) + lu(k,1651) = lu(k,1651) - lu(k,512) * lu(k,1627) + lu(k,1655) = lu(k,1655) - lu(k,513) * lu(k,1627) + lu(k,1656) = lu(k,1656) - lu(k,514) * lu(k,1627) + lu(k,1657) = lu(k,1657) - lu(k,515) * lu(k,1627) + lu(k,1659) = lu(k,1659) - lu(k,516) * lu(k,1627) + lu(k,1664) = lu(k,1664) - lu(k,517) * lu(k,1627) + lu(k,1666) = lu(k,1666) - lu(k,518) * lu(k,1627) + lu(k,1677) = lu(k,1677) - lu(k,505) * lu(k,1670) + lu(k,1688) = lu(k,1688) - lu(k,506) * lu(k,1670) + lu(k,1689) = lu(k,1689) - lu(k,507) * lu(k,1670) + lu(k,1690) = lu(k,1690) - lu(k,508) * lu(k,1670) + lu(k,1691) = lu(k,1691) - lu(k,509) * lu(k,1670) + lu(k,1692) = lu(k,1692) - lu(k,510) * lu(k,1670) + lu(k,1693) = lu(k,1693) - lu(k,511) * lu(k,1670) + lu(k,1694) = lu(k,1694) - lu(k,512) * lu(k,1670) + lu(k,1698) = lu(k,1698) - lu(k,513) * lu(k,1670) + lu(k,1699) = lu(k,1699) - lu(k,514) * lu(k,1670) + lu(k,1700) = lu(k,1700) - lu(k,515) * lu(k,1670) + lu(k,1702) = lu(k,1702) - lu(k,516) * lu(k,1670) + lu(k,1707) = lu(k,1707) - lu(k,517) * lu(k,1670) + lu(k,1709) = lu(k,1709) - lu(k,518) * lu(k,1670) + lu(k,2056) = lu(k,2056) - lu(k,505) * lu(k,2050) + lu(k,2069) = lu(k,2069) - lu(k,506) * lu(k,2050) + lu(k,2070) = lu(k,2070) - lu(k,507) * lu(k,2050) + lu(k,2071) = lu(k,2071) - lu(k,508) * lu(k,2050) + lu(k,2072) = lu(k,2072) - lu(k,509) * lu(k,2050) + lu(k,2073) = lu(k,2073) - lu(k,510) * lu(k,2050) + lu(k,2074) = lu(k,2074) - lu(k,511) * lu(k,2050) + lu(k,2075) = lu(k,2075) - lu(k,512) * lu(k,2050) + lu(k,2079) = lu(k,2079) - lu(k,513) * lu(k,2050) + lu(k,2080) = lu(k,2080) - lu(k,514) * lu(k,2050) + lu(k,2081) = lu(k,2081) - lu(k,515) * lu(k,2050) + lu(k,2083) = lu(k,2083) - lu(k,516) * lu(k,2050) + lu(k,2088) = lu(k,2088) - lu(k,517) * lu(k,2050) + lu(k,2090) = lu(k,2090) - lu(k,518) * lu(k,2050) + lu(k,519) = 1._r8 / lu(k,519) + lu(k,520) = lu(k,520) * lu(k,519) + lu(k,521) = lu(k,521) * lu(k,519) + lu(k,522) = lu(k,522) * lu(k,519) + lu(k,523) = lu(k,523) * lu(k,519) + lu(k,524) = lu(k,524) * lu(k,519) + lu(k,525) = lu(k,525) * lu(k,519) + lu(k,526) = lu(k,526) * lu(k,519) + lu(k,527) = lu(k,527) * lu(k,519) + lu(k,528) = lu(k,528) * lu(k,519) + lu(k,529) = lu(k,529) * lu(k,519) + lu(k,530) = lu(k,530) * lu(k,519) + lu(k,531) = lu(k,531) * lu(k,519) + lu(k,532) = lu(k,532) * lu(k,519) + lu(k,533) = lu(k,533) * lu(k,519) + lu(k,536) = lu(k,536) - lu(k,520) * lu(k,534) + lu(k,537) = lu(k,537) - lu(k,521) * lu(k,534) + lu(k,538) = lu(k,538) - lu(k,522) * lu(k,534) + lu(k,539) = lu(k,539) - lu(k,523) * lu(k,534) + lu(k,540) = lu(k,540) - lu(k,524) * lu(k,534) + lu(k,541) = lu(k,541) - lu(k,525) * lu(k,534) + lu(k,542) = lu(k,542) - lu(k,526) * lu(k,534) + lu(k,543) = lu(k,543) - lu(k,527) * lu(k,534) + lu(k,544) = lu(k,544) - lu(k,528) * lu(k,534) + lu(k,545) = lu(k,545) - lu(k,529) * lu(k,534) + lu(k,546) = lu(k,546) - lu(k,530) * lu(k,534) + lu(k,547) = lu(k,547) - lu(k,531) * lu(k,534) + lu(k,548) = lu(k,548) - lu(k,532) * lu(k,534) + lu(k,549) = lu(k,549) - lu(k,533) * lu(k,534) + lu(k,811) = lu(k,811) - lu(k,520) * lu(k,809) + lu(k,815) = lu(k,815) - lu(k,521) * lu(k,809) + lu(k,816) = lu(k,816) - lu(k,522) * lu(k,809) + lu(k,817) = lu(k,817) - lu(k,523) * lu(k,809) + lu(k,818) = lu(k,818) - lu(k,524) * lu(k,809) + lu(k,819) = lu(k,819) - lu(k,525) * lu(k,809) + lu(k,820) = lu(k,820) - lu(k,526) * lu(k,809) + lu(k,822) = lu(k,822) - lu(k,527) * lu(k,809) + lu(k,823) = lu(k,823) - lu(k,528) * lu(k,809) + lu(k,824) = lu(k,824) - lu(k,529) * lu(k,809) + lu(k,825) = lu(k,825) - lu(k,530) * lu(k,809) + lu(k,827) = lu(k,827) - lu(k,531) * lu(k,809) + lu(k,828) = lu(k,828) - lu(k,532) * lu(k,809) + lu(k,829) = lu(k,829) - lu(k,533) * lu(k,809) + lu(k,1144) = lu(k,1144) - lu(k,520) * lu(k,1135) + lu(k,1153) = lu(k,1153) - lu(k,521) * lu(k,1135) + lu(k,1154) = lu(k,1154) - lu(k,522) * lu(k,1135) + lu(k,1155) = lu(k,1155) - lu(k,523) * lu(k,1135) + lu(k,1157) = lu(k,1157) - lu(k,524) * lu(k,1135) + lu(k,1159) = lu(k,1159) - lu(k,525) * lu(k,1135) + lu(k,1160) = lu(k,1160) - lu(k,526) * lu(k,1135) + lu(k,1163) = lu(k,1163) - lu(k,527) * lu(k,1135) + lu(k,1164) = lu(k,1164) - lu(k,528) * lu(k,1135) + lu(k,1165) = lu(k,1165) - lu(k,529) * lu(k,1135) + lu(k,1167) = lu(k,1167) - lu(k,530) * lu(k,1135) + lu(k,1172) = lu(k,1172) - lu(k,531) * lu(k,1135) + lu(k,1173) = lu(k,1173) - lu(k,532) * lu(k,1135) + lu(k,1174) = lu(k,1174) - lu(k,533) * lu(k,1135) + lu(k,1187) = lu(k,1187) - lu(k,520) * lu(k,1179) + lu(k,1196) = lu(k,1196) - lu(k,521) * lu(k,1179) + lu(k,1197) = lu(k,1197) - lu(k,522) * lu(k,1179) + lu(k,1198) = lu(k,1198) - lu(k,523) * lu(k,1179) + lu(k,1200) = lu(k,1200) - lu(k,524) * lu(k,1179) + lu(k,1202) = lu(k,1202) - lu(k,525) * lu(k,1179) + lu(k,1203) = lu(k,1203) - lu(k,526) * lu(k,1179) + lu(k,1206) = lu(k,1206) - lu(k,527) * lu(k,1179) + lu(k,1207) = lu(k,1207) - lu(k,528) * lu(k,1179) + lu(k,1208) = lu(k,1208) - lu(k,529) * lu(k,1179) + lu(k,1210) = lu(k,1210) - lu(k,530) * lu(k,1179) + lu(k,1215) = lu(k,1215) - lu(k,531) * lu(k,1179) + lu(k,1216) = lu(k,1216) - lu(k,532) * lu(k,1179) + lu(k,1217) = lu(k,1217) - lu(k,533) * lu(k,1179) + lu(k,1230) = lu(k,1230) - lu(k,520) * lu(k,1222) + lu(k,1239) = lu(k,1239) - lu(k,521) * lu(k,1222) + lu(k,1240) = lu(k,1240) - lu(k,522) * lu(k,1222) + lu(k,1241) = lu(k,1241) - lu(k,523) * lu(k,1222) + lu(k,1243) = lu(k,1243) - lu(k,524) * lu(k,1222) + lu(k,1245) = lu(k,1245) - lu(k,525) * lu(k,1222) + lu(k,1246) = lu(k,1246) - lu(k,526) * lu(k,1222) + lu(k,1249) = lu(k,1249) - lu(k,527) * lu(k,1222) + lu(k,1250) = lu(k,1250) - lu(k,528) * lu(k,1222) + lu(k,1251) = lu(k,1251) - lu(k,529) * lu(k,1222) + lu(k,1253) = lu(k,1253) - lu(k,530) * lu(k,1222) + lu(k,1258) = lu(k,1258) - lu(k,531) * lu(k,1222) + lu(k,1259) = lu(k,1259) - lu(k,532) * lu(k,1222) + lu(k,1260) = lu(k,1260) - lu(k,533) * lu(k,1222) + lu(k,1314) = lu(k,1314) - lu(k,520) * lu(k,1306) + lu(k,1323) = lu(k,1323) - lu(k,521) * lu(k,1306) + lu(k,1324) = lu(k,1324) - lu(k,522) * lu(k,1306) + lu(k,1325) = lu(k,1325) - lu(k,523) * lu(k,1306) + lu(k,1327) = lu(k,1327) - lu(k,524) * lu(k,1306) + lu(k,1329) = lu(k,1329) - lu(k,525) * lu(k,1306) + lu(k,1330) = lu(k,1330) - lu(k,526) * lu(k,1306) + lu(k,1333) = lu(k,1333) - lu(k,527) * lu(k,1306) + lu(k,1334) = lu(k,1334) - lu(k,528) * lu(k,1306) + lu(k,1335) = lu(k,1335) - lu(k,529) * lu(k,1306) + lu(k,1337) = lu(k,1337) - lu(k,530) * lu(k,1306) + lu(k,1342) = lu(k,1342) - lu(k,531) * lu(k,1306) + lu(k,1343) = lu(k,1343) - lu(k,532) * lu(k,1306) + lu(k,1344) = lu(k,1344) - lu(k,533) * lu(k,1306) + lu(k,1593) = lu(k,1593) - lu(k,520) * lu(k,1584) + lu(k,1602) = lu(k,1602) - lu(k,521) * lu(k,1584) + lu(k,1603) = lu(k,1603) - lu(k,522) * lu(k,1584) + lu(k,1604) = lu(k,1604) - lu(k,523) * lu(k,1584) + lu(k,1606) = lu(k,1606) - lu(k,524) * lu(k,1584) + lu(k,1608) = lu(k,1608) - lu(k,525) * lu(k,1584) + lu(k,1609) = lu(k,1609) - lu(k,526) * lu(k,1584) + lu(k,1612) = lu(k,1612) - lu(k,527) * lu(k,1584) + lu(k,1613) = lu(k,1613) - lu(k,528) * lu(k,1584) + lu(k,1614) = lu(k,1614) - lu(k,529) * lu(k,1584) + lu(k,1616) = lu(k,1616) - lu(k,530) * lu(k,1584) + lu(k,1621) = lu(k,1621) - lu(k,531) * lu(k,1584) + lu(k,1622) = lu(k,1622) - lu(k,532) * lu(k,1584) + lu(k,1623) = lu(k,1623) - lu(k,533) * lu(k,1584) + lu(k,1636) = lu(k,1636) - lu(k,520) * lu(k,1628) + lu(k,1645) = lu(k,1645) - lu(k,521) * lu(k,1628) + lu(k,1646) = lu(k,1646) - lu(k,522) * lu(k,1628) + lu(k,1647) = lu(k,1647) - lu(k,523) * lu(k,1628) + lu(k,1649) = lu(k,1649) - lu(k,524) * lu(k,1628) + lu(k,1651) = lu(k,1651) - lu(k,525) * lu(k,1628) + lu(k,1652) = lu(k,1652) - lu(k,526) * lu(k,1628) + lu(k,1655) = lu(k,1655) - lu(k,527) * lu(k,1628) + lu(k,1656) = lu(k,1656) - lu(k,528) * lu(k,1628) + lu(k,1657) = lu(k,1657) - lu(k,529) * lu(k,1628) + lu(k,1659) = lu(k,1659) - lu(k,530) * lu(k,1628) + lu(k,1664) = lu(k,1664) - lu(k,531) * lu(k,1628) + lu(k,1665) = lu(k,1665) - lu(k,532) * lu(k,1628) + lu(k,1666) = lu(k,1666) - lu(k,533) * lu(k,1628) + lu(k,1679) = lu(k,1679) - lu(k,520) * lu(k,1671) + lu(k,1688) = lu(k,1688) - lu(k,521) * lu(k,1671) + lu(k,1689) = lu(k,1689) - lu(k,522) * lu(k,1671) + lu(k,1690) = lu(k,1690) - lu(k,523) * lu(k,1671) + lu(k,1692) = lu(k,1692) - lu(k,524) * lu(k,1671) + lu(k,1694) = lu(k,1694) - lu(k,525) * lu(k,1671) + lu(k,1695) = lu(k,1695) - lu(k,526) * lu(k,1671) + lu(k,1698) = lu(k,1698) - lu(k,527) * lu(k,1671) + lu(k,1699) = lu(k,1699) - lu(k,528) * lu(k,1671) + lu(k,1700) = lu(k,1700) - lu(k,529) * lu(k,1671) + lu(k,1702) = lu(k,1702) - lu(k,530) * lu(k,1671) + lu(k,1707) = lu(k,1707) - lu(k,531) * lu(k,1671) + lu(k,1708) = lu(k,1708) - lu(k,532) * lu(k,1671) + lu(k,1709) = lu(k,1709) - lu(k,533) * lu(k,1671) + lu(k,2000) = lu(k,2000) - lu(k,520) * lu(k,1992) + lu(k,2009) = - lu(k,521) * lu(k,1992) + lu(k,2010) = - lu(k,522) * lu(k,1992) + lu(k,2011) = - lu(k,523) * lu(k,1992) + lu(k,2013) = - lu(k,524) * lu(k,1992) + lu(k,2015) = - lu(k,525) * lu(k,1992) + lu(k,2016) = lu(k,2016) - lu(k,526) * lu(k,1992) + lu(k,2019) = - lu(k,527) * lu(k,1992) + lu(k,2020) = - lu(k,528) * lu(k,1992) + lu(k,2021) = - lu(k,529) * lu(k,1992) + lu(k,2023) = lu(k,2023) - lu(k,530) * lu(k,1992) + lu(k,2028) = lu(k,2028) - lu(k,531) * lu(k,1992) + lu(k,2029) = lu(k,2029) - lu(k,532) * lu(k,1992) + lu(k,2030) = lu(k,2030) - lu(k,533) * lu(k,1992) + lu(k,535) = 1._r8 / lu(k,535) + lu(k,536) = lu(k,536) * lu(k,535) + lu(k,537) = lu(k,537) * lu(k,535) + lu(k,538) = lu(k,538) * lu(k,535) + lu(k,539) = lu(k,539) * lu(k,535) + lu(k,540) = lu(k,540) * lu(k,535) + lu(k,541) = lu(k,541) * lu(k,535) + lu(k,542) = lu(k,542) * lu(k,535) + lu(k,543) = lu(k,543) * lu(k,535) + lu(k,544) = lu(k,544) * lu(k,535) + lu(k,545) = lu(k,545) * lu(k,535) + lu(k,546) = lu(k,546) * lu(k,535) + lu(k,547) = lu(k,547) * lu(k,535) + lu(k,548) = lu(k,548) * lu(k,535) + lu(k,549) = lu(k,549) * lu(k,535) + lu(k,811) = lu(k,811) - lu(k,536) * lu(k,810) + lu(k,815) = lu(k,815) - lu(k,537) * lu(k,810) + lu(k,816) = lu(k,816) - lu(k,538) * lu(k,810) + lu(k,817) = lu(k,817) - lu(k,539) * lu(k,810) + lu(k,818) = lu(k,818) - lu(k,540) * lu(k,810) + lu(k,819) = lu(k,819) - lu(k,541) * lu(k,810) + lu(k,820) = lu(k,820) - lu(k,542) * lu(k,810) + lu(k,822) = lu(k,822) - lu(k,543) * lu(k,810) + lu(k,823) = lu(k,823) - lu(k,544) * lu(k,810) + lu(k,824) = lu(k,824) - lu(k,545) * lu(k,810) + lu(k,825) = lu(k,825) - lu(k,546) * lu(k,810) + lu(k,827) = lu(k,827) - lu(k,547) * lu(k,810) + lu(k,828) = lu(k,828) - lu(k,548) * lu(k,810) + lu(k,829) = lu(k,829) - lu(k,549) * lu(k,810) + lu(k,1144) = lu(k,1144) - lu(k,536) * lu(k,1136) + lu(k,1153) = lu(k,1153) - lu(k,537) * lu(k,1136) + lu(k,1154) = lu(k,1154) - lu(k,538) * lu(k,1136) + lu(k,1155) = lu(k,1155) - lu(k,539) * lu(k,1136) + lu(k,1157) = lu(k,1157) - lu(k,540) * lu(k,1136) + lu(k,1159) = lu(k,1159) - lu(k,541) * lu(k,1136) + lu(k,1160) = lu(k,1160) - lu(k,542) * lu(k,1136) + lu(k,1163) = lu(k,1163) - lu(k,543) * lu(k,1136) + lu(k,1164) = lu(k,1164) - lu(k,544) * lu(k,1136) + lu(k,1165) = lu(k,1165) - lu(k,545) * lu(k,1136) + lu(k,1167) = lu(k,1167) - lu(k,546) * lu(k,1136) + lu(k,1172) = lu(k,1172) - lu(k,547) * lu(k,1136) + lu(k,1173) = lu(k,1173) - lu(k,548) * lu(k,1136) + lu(k,1174) = lu(k,1174) - lu(k,549) * lu(k,1136) + lu(k,1187) = lu(k,1187) - lu(k,536) * lu(k,1180) + lu(k,1196) = lu(k,1196) - lu(k,537) * lu(k,1180) + lu(k,1197) = lu(k,1197) - lu(k,538) * lu(k,1180) + lu(k,1198) = lu(k,1198) - lu(k,539) * lu(k,1180) + lu(k,1200) = lu(k,1200) - lu(k,540) * lu(k,1180) + lu(k,1202) = lu(k,1202) - lu(k,541) * lu(k,1180) + lu(k,1203) = lu(k,1203) - lu(k,542) * lu(k,1180) + lu(k,1206) = lu(k,1206) - lu(k,543) * lu(k,1180) + lu(k,1207) = lu(k,1207) - lu(k,544) * lu(k,1180) + lu(k,1208) = lu(k,1208) - lu(k,545) * lu(k,1180) + lu(k,1210) = lu(k,1210) - lu(k,546) * lu(k,1180) + lu(k,1215) = lu(k,1215) - lu(k,547) * lu(k,1180) + lu(k,1216) = lu(k,1216) - lu(k,548) * lu(k,1180) + lu(k,1217) = lu(k,1217) - lu(k,549) * lu(k,1180) + lu(k,1230) = lu(k,1230) - lu(k,536) * lu(k,1223) + lu(k,1239) = lu(k,1239) - lu(k,537) * lu(k,1223) + lu(k,1240) = lu(k,1240) - lu(k,538) * lu(k,1223) + lu(k,1241) = lu(k,1241) - lu(k,539) * lu(k,1223) + lu(k,1243) = lu(k,1243) - lu(k,540) * lu(k,1223) + lu(k,1245) = lu(k,1245) - lu(k,541) * lu(k,1223) + lu(k,1246) = lu(k,1246) - lu(k,542) * lu(k,1223) + lu(k,1249) = lu(k,1249) - lu(k,543) * lu(k,1223) + lu(k,1250) = lu(k,1250) - lu(k,544) * lu(k,1223) + lu(k,1251) = lu(k,1251) - lu(k,545) * lu(k,1223) + lu(k,1253) = lu(k,1253) - lu(k,546) * lu(k,1223) + lu(k,1258) = lu(k,1258) - lu(k,547) * lu(k,1223) + lu(k,1259) = lu(k,1259) - lu(k,548) * lu(k,1223) + lu(k,1260) = lu(k,1260) - lu(k,549) * lu(k,1223) + lu(k,1314) = lu(k,1314) - lu(k,536) * lu(k,1307) + lu(k,1323) = lu(k,1323) - lu(k,537) * lu(k,1307) + lu(k,1324) = lu(k,1324) - lu(k,538) * lu(k,1307) + lu(k,1325) = lu(k,1325) - lu(k,539) * lu(k,1307) + lu(k,1327) = lu(k,1327) - lu(k,540) * lu(k,1307) + lu(k,1329) = lu(k,1329) - lu(k,541) * lu(k,1307) + lu(k,1330) = lu(k,1330) - lu(k,542) * lu(k,1307) + lu(k,1333) = lu(k,1333) - lu(k,543) * lu(k,1307) + lu(k,1334) = lu(k,1334) - lu(k,544) * lu(k,1307) + lu(k,1335) = lu(k,1335) - lu(k,545) * lu(k,1307) + lu(k,1337) = lu(k,1337) - lu(k,546) * lu(k,1307) + lu(k,1342) = lu(k,1342) - lu(k,547) * lu(k,1307) + lu(k,1343) = lu(k,1343) - lu(k,548) * lu(k,1307) + lu(k,1344) = lu(k,1344) - lu(k,549) * lu(k,1307) + lu(k,1593) = lu(k,1593) - lu(k,536) * lu(k,1585) + lu(k,1602) = lu(k,1602) - lu(k,537) * lu(k,1585) + lu(k,1603) = lu(k,1603) - lu(k,538) * lu(k,1585) + lu(k,1604) = lu(k,1604) - lu(k,539) * lu(k,1585) + lu(k,1606) = lu(k,1606) - lu(k,540) * lu(k,1585) + lu(k,1608) = lu(k,1608) - lu(k,541) * lu(k,1585) + lu(k,1609) = lu(k,1609) - lu(k,542) * lu(k,1585) + lu(k,1612) = lu(k,1612) - lu(k,543) * lu(k,1585) + lu(k,1613) = lu(k,1613) - lu(k,544) * lu(k,1585) + lu(k,1614) = lu(k,1614) - lu(k,545) * lu(k,1585) + lu(k,1616) = lu(k,1616) - lu(k,546) * lu(k,1585) + lu(k,1621) = lu(k,1621) - lu(k,547) * lu(k,1585) + lu(k,1622) = lu(k,1622) - lu(k,548) * lu(k,1585) + lu(k,1623) = lu(k,1623) - lu(k,549) * lu(k,1585) + lu(k,1636) = lu(k,1636) - lu(k,536) * lu(k,1629) + lu(k,1645) = lu(k,1645) - lu(k,537) * lu(k,1629) + lu(k,1646) = lu(k,1646) - lu(k,538) * lu(k,1629) + lu(k,1647) = lu(k,1647) - lu(k,539) * lu(k,1629) + lu(k,1649) = lu(k,1649) - lu(k,540) * lu(k,1629) + lu(k,1651) = lu(k,1651) - lu(k,541) * lu(k,1629) + lu(k,1652) = lu(k,1652) - lu(k,542) * lu(k,1629) + lu(k,1655) = lu(k,1655) - lu(k,543) * lu(k,1629) + lu(k,1656) = lu(k,1656) - lu(k,544) * lu(k,1629) + lu(k,1657) = lu(k,1657) - lu(k,545) * lu(k,1629) + lu(k,1659) = lu(k,1659) - lu(k,546) * lu(k,1629) + lu(k,1664) = lu(k,1664) - lu(k,547) * lu(k,1629) + lu(k,1665) = lu(k,1665) - lu(k,548) * lu(k,1629) + lu(k,1666) = lu(k,1666) - lu(k,549) * lu(k,1629) + lu(k,1679) = lu(k,1679) - lu(k,536) * lu(k,1672) + lu(k,1688) = lu(k,1688) - lu(k,537) * lu(k,1672) + lu(k,1689) = lu(k,1689) - lu(k,538) * lu(k,1672) + lu(k,1690) = lu(k,1690) - lu(k,539) * lu(k,1672) + lu(k,1692) = lu(k,1692) - lu(k,540) * lu(k,1672) + lu(k,1694) = lu(k,1694) - lu(k,541) * lu(k,1672) + lu(k,1695) = lu(k,1695) - lu(k,542) * lu(k,1672) + lu(k,1698) = lu(k,1698) - lu(k,543) * lu(k,1672) + lu(k,1699) = lu(k,1699) - lu(k,544) * lu(k,1672) + lu(k,1700) = lu(k,1700) - lu(k,545) * lu(k,1672) + lu(k,1702) = lu(k,1702) - lu(k,546) * lu(k,1672) + lu(k,1707) = lu(k,1707) - lu(k,547) * lu(k,1672) + lu(k,1708) = lu(k,1708) - lu(k,548) * lu(k,1672) + lu(k,1709) = lu(k,1709) - lu(k,549) * lu(k,1672) + lu(k,2000) = lu(k,2000) - lu(k,536) * lu(k,1993) + lu(k,2009) = lu(k,2009) - lu(k,537) * lu(k,1993) + lu(k,2010) = lu(k,2010) - lu(k,538) * lu(k,1993) + lu(k,2011) = lu(k,2011) - lu(k,539) * lu(k,1993) + lu(k,2013) = lu(k,2013) - lu(k,540) * lu(k,1993) + lu(k,2015) = lu(k,2015) - lu(k,541) * lu(k,1993) + lu(k,2016) = lu(k,2016) - lu(k,542) * lu(k,1993) + lu(k,2019) = lu(k,2019) - lu(k,543) * lu(k,1993) + lu(k,2020) = lu(k,2020) - lu(k,544) * lu(k,1993) + lu(k,2021) = lu(k,2021) - lu(k,545) * lu(k,1993) + lu(k,2023) = lu(k,2023) - lu(k,546) * lu(k,1993) + lu(k,2028) = lu(k,2028) - lu(k,547) * lu(k,1993) + lu(k,2029) = lu(k,2029) - lu(k,548) * lu(k,1993) + lu(k,2030) = lu(k,2030) - lu(k,549) * lu(k,1993) + lu(k,2061) = lu(k,2061) - lu(k,536) * lu(k,2051) + lu(k,2069) = lu(k,2069) - lu(k,537) * lu(k,2051) + lu(k,2070) = lu(k,2070) - lu(k,538) * lu(k,2051) + lu(k,2071) = lu(k,2071) - lu(k,539) * lu(k,2051) + lu(k,2073) = lu(k,2073) - lu(k,540) * lu(k,2051) + lu(k,2075) = lu(k,2075) - lu(k,541) * lu(k,2051) + lu(k,2076) = lu(k,2076) - lu(k,542) * lu(k,2051) + lu(k,2079) = lu(k,2079) - lu(k,543) * lu(k,2051) + lu(k,2080) = lu(k,2080) - lu(k,544) * lu(k,2051) + lu(k,2081) = lu(k,2081) - lu(k,545) * lu(k,2051) + lu(k,2083) = lu(k,2083) - lu(k,546) * lu(k,2051) + lu(k,2088) = lu(k,2088) - lu(k,547) * lu(k,2051) + lu(k,2089) = lu(k,2089) - lu(k,548) * lu(k,2051) + lu(k,2090) = lu(k,2090) - lu(k,549) * lu(k,2051) + 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,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,559) = lu(k,559) * lu(k,550) + lu(k,560) = lu(k,560) * lu(k,550) + lu(k,561) = lu(k,561) * lu(k,550) + lu(k,562) = lu(k,562) * lu(k,550) + lu(k,563) = lu(k,563) * lu(k,550) + lu(k,672) = lu(k,672) - lu(k,551) * lu(k,668) + lu(k,674) = lu(k,674) - lu(k,552) * lu(k,668) + lu(k,675) = lu(k,675) - lu(k,553) * lu(k,668) + lu(k,676) = lu(k,676) - lu(k,554) * lu(k,668) + lu(k,678) = lu(k,678) - lu(k,555) * lu(k,668) + lu(k,680) = lu(k,680) - lu(k,556) * lu(k,668) + lu(k,681) = lu(k,681) - lu(k,557) * lu(k,668) + lu(k,682) = lu(k,682) - lu(k,558) * lu(k,668) + lu(k,683) = lu(k,683) - lu(k,559) * lu(k,668) + lu(k,684) = lu(k,684) - lu(k,560) * lu(k,668) + lu(k,685) = lu(k,685) - lu(k,561) * lu(k,668) + lu(k,686) = lu(k,686) - lu(k,562) * lu(k,668) + lu(k,687) = lu(k,687) - lu(k,563) * lu(k,668) + lu(k,926) = lu(k,926) - lu(k,551) * lu(k,923) + lu(k,930) = lu(k,930) - lu(k,552) * lu(k,923) + lu(k,931) = lu(k,931) - lu(k,553) * lu(k,923) + lu(k,932) = lu(k,932) - lu(k,554) * lu(k,923) + lu(k,933) = lu(k,933) - lu(k,555) * lu(k,923) + lu(k,935) = lu(k,935) - lu(k,556) * lu(k,923) + lu(k,938) = lu(k,938) - lu(k,557) * lu(k,923) + lu(k,939) = lu(k,939) - lu(k,558) * lu(k,923) + lu(k,940) = lu(k,940) - lu(k,559) * lu(k,923) + lu(k,942) = lu(k,942) - lu(k,560) * lu(k,923) + lu(k,943) = lu(k,943) - lu(k,561) * lu(k,923) + lu(k,946) = lu(k,946) - lu(k,562) * lu(k,923) + lu(k,948) = lu(k,948) - lu(k,563) * lu(k,923) + lu(k,1148) = lu(k,1148) - lu(k,551) * lu(k,1137) + lu(k,1153) = lu(k,1153) - lu(k,552) * lu(k,1137) + lu(k,1154) = lu(k,1154) - lu(k,553) * lu(k,1137) + lu(k,1155) = lu(k,1155) - lu(k,554) * lu(k,1137) + lu(k,1157) = lu(k,1157) - lu(k,555) * lu(k,1137) + lu(k,1159) = lu(k,1159) - lu(k,556) * lu(k,1137) + lu(k,1163) = lu(k,1163) - lu(k,557) * lu(k,1137) + lu(k,1164) = lu(k,1164) - lu(k,558) * lu(k,1137) + lu(k,1165) = lu(k,1165) - lu(k,559) * lu(k,1137) + lu(k,1167) = lu(k,1167) - lu(k,560) * lu(k,1137) + lu(k,1168) = lu(k,1168) - lu(k,561) * lu(k,1137) + lu(k,1172) = lu(k,1172) - lu(k,562) * lu(k,1137) + lu(k,1174) = lu(k,1174) - lu(k,563) * lu(k,1137) + lu(k,1191) = lu(k,1191) - lu(k,551) * lu(k,1181) + lu(k,1196) = lu(k,1196) - lu(k,552) * lu(k,1181) + lu(k,1197) = lu(k,1197) - lu(k,553) * lu(k,1181) + lu(k,1198) = lu(k,1198) - lu(k,554) * lu(k,1181) + lu(k,1200) = lu(k,1200) - lu(k,555) * lu(k,1181) + lu(k,1202) = lu(k,1202) - lu(k,556) * lu(k,1181) + lu(k,1206) = lu(k,1206) - lu(k,557) * lu(k,1181) + lu(k,1207) = lu(k,1207) - lu(k,558) * lu(k,1181) + lu(k,1208) = lu(k,1208) - lu(k,559) * lu(k,1181) + lu(k,1210) = lu(k,1210) - lu(k,560) * lu(k,1181) + lu(k,1211) = lu(k,1211) - lu(k,561) * lu(k,1181) + lu(k,1215) = lu(k,1215) - lu(k,562) * lu(k,1181) + lu(k,1217) = lu(k,1217) - lu(k,563) * lu(k,1181) + lu(k,1234) = lu(k,1234) - lu(k,551) * lu(k,1224) + lu(k,1239) = lu(k,1239) - lu(k,552) * lu(k,1224) + lu(k,1240) = lu(k,1240) - lu(k,553) * lu(k,1224) + lu(k,1241) = lu(k,1241) - lu(k,554) * lu(k,1224) + lu(k,1243) = lu(k,1243) - lu(k,555) * lu(k,1224) + lu(k,1245) = lu(k,1245) - lu(k,556) * lu(k,1224) + lu(k,1249) = lu(k,1249) - lu(k,557) * lu(k,1224) + lu(k,1250) = lu(k,1250) - lu(k,558) * lu(k,1224) + lu(k,1251) = lu(k,1251) - lu(k,559) * lu(k,1224) + lu(k,1253) = lu(k,1253) - lu(k,560) * lu(k,1224) + lu(k,1254) = lu(k,1254) - lu(k,561) * lu(k,1224) + lu(k,1258) = lu(k,1258) - lu(k,562) * lu(k,1224) + lu(k,1260) = lu(k,1260) - lu(k,563) * lu(k,1224) + lu(k,1318) = lu(k,1318) - lu(k,551) * lu(k,1308) + lu(k,1323) = lu(k,1323) - lu(k,552) * lu(k,1308) + lu(k,1324) = lu(k,1324) - lu(k,553) * lu(k,1308) + lu(k,1325) = lu(k,1325) - lu(k,554) * lu(k,1308) + lu(k,1327) = lu(k,1327) - lu(k,555) * lu(k,1308) + lu(k,1329) = lu(k,1329) - lu(k,556) * lu(k,1308) + lu(k,1333) = lu(k,1333) - lu(k,557) * lu(k,1308) + lu(k,1334) = lu(k,1334) - lu(k,558) * lu(k,1308) + lu(k,1335) = lu(k,1335) - lu(k,559) * lu(k,1308) + lu(k,1337) = lu(k,1337) - lu(k,560) * lu(k,1308) + lu(k,1338) = lu(k,1338) - lu(k,561) * lu(k,1308) + lu(k,1342) = lu(k,1342) - lu(k,562) * lu(k,1308) + lu(k,1344) = lu(k,1344) - lu(k,563) * lu(k,1308) + lu(k,1597) = lu(k,1597) - lu(k,551) * lu(k,1586) + lu(k,1602) = lu(k,1602) - lu(k,552) * lu(k,1586) + lu(k,1603) = lu(k,1603) - lu(k,553) * lu(k,1586) + lu(k,1604) = lu(k,1604) - lu(k,554) * lu(k,1586) + lu(k,1606) = lu(k,1606) - lu(k,555) * lu(k,1586) + lu(k,1608) = lu(k,1608) - lu(k,556) * lu(k,1586) + lu(k,1612) = lu(k,1612) - lu(k,557) * lu(k,1586) + lu(k,1613) = lu(k,1613) - lu(k,558) * lu(k,1586) + lu(k,1614) = lu(k,1614) - lu(k,559) * lu(k,1586) + lu(k,1616) = lu(k,1616) - lu(k,560) * lu(k,1586) + lu(k,1617) = lu(k,1617) - lu(k,561) * lu(k,1586) + lu(k,1621) = lu(k,1621) - lu(k,562) * lu(k,1586) + lu(k,1623) = lu(k,1623) - lu(k,563) * lu(k,1586) + lu(k,1640) = lu(k,1640) - lu(k,551) * lu(k,1630) + lu(k,1645) = lu(k,1645) - lu(k,552) * lu(k,1630) + lu(k,1646) = lu(k,1646) - lu(k,553) * lu(k,1630) + lu(k,1647) = lu(k,1647) - lu(k,554) * lu(k,1630) + lu(k,1649) = lu(k,1649) - lu(k,555) * lu(k,1630) + lu(k,1651) = lu(k,1651) - lu(k,556) * lu(k,1630) + lu(k,1655) = lu(k,1655) - lu(k,557) * lu(k,1630) + lu(k,1656) = lu(k,1656) - lu(k,558) * lu(k,1630) + lu(k,1657) = lu(k,1657) - lu(k,559) * lu(k,1630) + lu(k,1659) = lu(k,1659) - lu(k,560) * lu(k,1630) + lu(k,1660) = lu(k,1660) - lu(k,561) * lu(k,1630) + lu(k,1664) = lu(k,1664) - lu(k,562) * lu(k,1630) + lu(k,1666) = lu(k,1666) - lu(k,563) * lu(k,1630) + lu(k,1683) = lu(k,1683) - lu(k,551) * lu(k,1673) + lu(k,1688) = lu(k,1688) - lu(k,552) * lu(k,1673) + lu(k,1689) = lu(k,1689) - lu(k,553) * lu(k,1673) + lu(k,1690) = lu(k,1690) - lu(k,554) * lu(k,1673) + lu(k,1692) = lu(k,1692) - lu(k,555) * lu(k,1673) + lu(k,1694) = lu(k,1694) - lu(k,556) * lu(k,1673) + lu(k,1698) = lu(k,1698) - lu(k,557) * lu(k,1673) + lu(k,1699) = lu(k,1699) - lu(k,558) * lu(k,1673) + lu(k,1700) = lu(k,1700) - lu(k,559) * lu(k,1673) + lu(k,1702) = lu(k,1702) - lu(k,560) * lu(k,1673) + lu(k,1703) = lu(k,1703) - lu(k,561) * lu(k,1673) + lu(k,1707) = lu(k,1707) - lu(k,562) * lu(k,1673) + lu(k,1709) = lu(k,1709) - lu(k,563) * lu(k,1673) + lu(k,1959) = lu(k,1959) - lu(k,551) * lu(k,1948) + lu(k,1964) = lu(k,1964) - lu(k,552) * lu(k,1948) + lu(k,1965) = - lu(k,553) * lu(k,1948) + lu(k,1966) = - lu(k,554) * lu(k,1948) + lu(k,1968) = - lu(k,555) * lu(k,1948) + lu(k,1970) = lu(k,1970) - lu(k,556) * lu(k,1948) + lu(k,1974) = lu(k,1974) - lu(k,557) * lu(k,1948) + lu(k,1975) = - lu(k,558) * lu(k,1948) + lu(k,1976) = - lu(k,559) * lu(k,1948) + lu(k,1978) = lu(k,1978) - lu(k,560) * lu(k,1948) + lu(k,1979) = lu(k,1979) - lu(k,561) * lu(k,1948) + lu(k,1983) = lu(k,1983) - lu(k,562) * lu(k,1948) + lu(k,1985) = lu(k,1985) - lu(k,563) * lu(k,1948) + lu(k,2064) = lu(k,2064) - lu(k,551) * lu(k,2052) + lu(k,2069) = lu(k,2069) - lu(k,552) * lu(k,2052) + lu(k,2070) = lu(k,2070) - lu(k,553) * lu(k,2052) + lu(k,2071) = lu(k,2071) - lu(k,554) * lu(k,2052) + lu(k,2073) = lu(k,2073) - lu(k,555) * lu(k,2052) + lu(k,2075) = lu(k,2075) - lu(k,556) * lu(k,2052) + lu(k,2079) = lu(k,2079) - lu(k,557) * lu(k,2052) + lu(k,2080) = lu(k,2080) - lu(k,558) * lu(k,2052) + lu(k,2081) = lu(k,2081) - lu(k,559) * lu(k,2052) + lu(k,2083) = lu(k,2083) - lu(k,560) * lu(k,2052) + lu(k,2084) = lu(k,2084) - lu(k,561) * lu(k,2052) + lu(k,2088) = lu(k,2088) - lu(k,562) * lu(k,2052) + lu(k,2090) = lu(k,2090) - lu(k,563) * lu(k,2052) + lu(k,564) = 1._r8 / lu(k,564) + lu(k,565) = lu(k,565) * lu(k,564) + lu(k,566) = lu(k,566) * lu(k,564) + lu(k,567) = lu(k,567) * lu(k,564) + lu(k,568) = lu(k,568) * lu(k,564) + lu(k,569) = lu(k,569) * lu(k,564) + lu(k,570) = lu(k,570) * lu(k,564) + lu(k,571) = lu(k,571) * lu(k,564) + lu(k,572) = lu(k,572) * lu(k,564) + lu(k,573) = lu(k,573) * lu(k,564) + lu(k,574) = lu(k,574) * lu(k,564) + lu(k,575) = lu(k,575) * lu(k,564) + lu(k,576) = lu(k,576) * lu(k,564) + lu(k,577) = lu(k,577) * lu(k,564) + lu(k,578) = lu(k,578) * lu(k,564) + lu(k,579) = lu(k,579) * lu(k,564) + lu(k,863) = lu(k,863) - lu(k,565) * lu(k,862) + lu(k,869) = lu(k,869) - lu(k,566) * lu(k,862) + lu(k,870) = lu(k,870) - lu(k,567) * lu(k,862) + lu(k,871) = lu(k,871) - lu(k,568) * lu(k,862) + lu(k,872) = lu(k,872) - lu(k,569) * lu(k,862) + lu(k,874) = lu(k,874) - lu(k,570) * lu(k,862) + lu(k,876) = lu(k,876) - lu(k,571) * lu(k,862) + lu(k,877) = lu(k,877) - lu(k,572) * lu(k,862) + lu(k,878) = lu(k,878) - lu(k,573) * lu(k,862) + lu(k,879) = lu(k,879) - lu(k,574) * lu(k,862) + lu(k,880) = lu(k,880) - lu(k,575) * lu(k,862) + lu(k,881) = - lu(k,576) * lu(k,862) + lu(k,884) = lu(k,884) - lu(k,577) * lu(k,862) + lu(k,885) = lu(k,885) - lu(k,578) * lu(k,862) + lu(k,886) = lu(k,886) - lu(k,579) * lu(k,862) + lu(k,1139) = lu(k,1139) - lu(k,565) * lu(k,1138) + lu(k,1153) = lu(k,1153) - lu(k,566) * lu(k,1138) + lu(k,1154) = lu(k,1154) - lu(k,567) * lu(k,1138) + lu(k,1155) = lu(k,1155) - lu(k,568) * lu(k,1138) + lu(k,1157) = lu(k,1157) - lu(k,569) * lu(k,1138) + lu(k,1159) = lu(k,1159) - lu(k,570) * lu(k,1138) + lu(k,1161) = lu(k,1161) - lu(k,571) * lu(k,1138) + lu(k,1163) = lu(k,1163) - lu(k,572) * lu(k,1138) + lu(k,1164) = lu(k,1164) - lu(k,573) * lu(k,1138) + lu(k,1165) = lu(k,1165) - lu(k,574) * lu(k,1138) + lu(k,1166) = lu(k,1166) - lu(k,575) * lu(k,1138) + lu(k,1167) = lu(k,1167) - lu(k,576) * lu(k,1138) + lu(k,1172) = lu(k,1172) - lu(k,577) * lu(k,1138) + lu(k,1173) = lu(k,1173) - lu(k,578) * lu(k,1138) + lu(k,1174) = lu(k,1174) - lu(k,579) * lu(k,1138) + lu(k,1183) = lu(k,1183) - lu(k,565) * lu(k,1182) + lu(k,1196) = lu(k,1196) - lu(k,566) * lu(k,1182) + lu(k,1197) = lu(k,1197) - lu(k,567) * lu(k,1182) + lu(k,1198) = lu(k,1198) - lu(k,568) * lu(k,1182) + lu(k,1200) = lu(k,1200) - lu(k,569) * lu(k,1182) + lu(k,1202) = lu(k,1202) - lu(k,570) * lu(k,1182) + lu(k,1204) = lu(k,1204) - lu(k,571) * lu(k,1182) + lu(k,1206) = lu(k,1206) - lu(k,572) * lu(k,1182) + lu(k,1207) = lu(k,1207) - lu(k,573) * lu(k,1182) + lu(k,1208) = lu(k,1208) - lu(k,574) * lu(k,1182) + lu(k,1209) = lu(k,1209) - lu(k,575) * lu(k,1182) + lu(k,1210) = lu(k,1210) - lu(k,576) * lu(k,1182) + lu(k,1215) = lu(k,1215) - lu(k,577) * lu(k,1182) + lu(k,1216) = lu(k,1216) - lu(k,578) * lu(k,1182) + lu(k,1217) = lu(k,1217) - lu(k,579) * lu(k,1182) + lu(k,1226) = lu(k,1226) - lu(k,565) * lu(k,1225) + lu(k,1239) = lu(k,1239) - lu(k,566) * lu(k,1225) + lu(k,1240) = lu(k,1240) - lu(k,567) * lu(k,1225) + lu(k,1241) = lu(k,1241) - lu(k,568) * lu(k,1225) + lu(k,1243) = lu(k,1243) - lu(k,569) * lu(k,1225) + lu(k,1245) = lu(k,1245) - lu(k,570) * lu(k,1225) + lu(k,1247) = lu(k,1247) - lu(k,571) * lu(k,1225) + lu(k,1249) = lu(k,1249) - lu(k,572) * lu(k,1225) + lu(k,1250) = lu(k,1250) - lu(k,573) * lu(k,1225) + lu(k,1251) = lu(k,1251) - lu(k,574) * lu(k,1225) + lu(k,1252) = lu(k,1252) - lu(k,575) * lu(k,1225) + lu(k,1253) = lu(k,1253) - lu(k,576) * lu(k,1225) + lu(k,1258) = lu(k,1258) - lu(k,577) * lu(k,1225) + lu(k,1259) = lu(k,1259) - lu(k,578) * lu(k,1225) + lu(k,1260) = lu(k,1260) - lu(k,579) * lu(k,1225) + lu(k,1310) = lu(k,1310) - lu(k,565) * lu(k,1309) + lu(k,1323) = lu(k,1323) - lu(k,566) * lu(k,1309) + lu(k,1324) = lu(k,1324) - lu(k,567) * lu(k,1309) + lu(k,1325) = lu(k,1325) - lu(k,568) * lu(k,1309) + lu(k,1327) = lu(k,1327) - lu(k,569) * lu(k,1309) + lu(k,1329) = lu(k,1329) - lu(k,570) * lu(k,1309) + lu(k,1331) = lu(k,1331) - lu(k,571) * lu(k,1309) + lu(k,1333) = lu(k,1333) - lu(k,572) * lu(k,1309) + lu(k,1334) = lu(k,1334) - lu(k,573) * lu(k,1309) + lu(k,1335) = lu(k,1335) - lu(k,574) * lu(k,1309) + lu(k,1336) = lu(k,1336) - lu(k,575) * lu(k,1309) + lu(k,1337) = lu(k,1337) - lu(k,576) * lu(k,1309) + lu(k,1342) = lu(k,1342) - lu(k,577) * lu(k,1309) + lu(k,1343) = lu(k,1343) - lu(k,578) * lu(k,1309) + lu(k,1344) = lu(k,1344) - lu(k,579) * lu(k,1309) + lu(k,1508) = lu(k,1508) - lu(k,565) * lu(k,1507) + lu(k,1521) = - lu(k,566) * lu(k,1507) + lu(k,1522) = - lu(k,567) * lu(k,1507) + lu(k,1523) = - lu(k,568) * lu(k,1507) + lu(k,1525) = - lu(k,569) * lu(k,1507) + lu(k,1527) = lu(k,1527) - lu(k,570) * lu(k,1507) + lu(k,1529) = lu(k,1529) - lu(k,571) * lu(k,1507) + lu(k,1531) = - lu(k,572) * lu(k,1507) + lu(k,1532) = - lu(k,573) * lu(k,1507) + lu(k,1533) = - lu(k,574) * lu(k,1507) + lu(k,1534) = lu(k,1534) - lu(k,575) * lu(k,1507) + lu(k,1535) = lu(k,1535) - lu(k,576) * lu(k,1507) + lu(k,1540) = lu(k,1540) - lu(k,577) * lu(k,1507) + lu(k,1541) = lu(k,1541) - lu(k,578) * lu(k,1507) + lu(k,1542) = lu(k,1542) - lu(k,579) * lu(k,1507) + lu(k,1588) = lu(k,1588) - lu(k,565) * lu(k,1587) + lu(k,1602) = lu(k,1602) - lu(k,566) * lu(k,1587) + lu(k,1603) = lu(k,1603) - lu(k,567) * lu(k,1587) + lu(k,1604) = lu(k,1604) - lu(k,568) * lu(k,1587) + lu(k,1606) = lu(k,1606) - lu(k,569) * lu(k,1587) + lu(k,1608) = lu(k,1608) - lu(k,570) * lu(k,1587) + lu(k,1610) = lu(k,1610) - lu(k,571) * lu(k,1587) + lu(k,1612) = lu(k,1612) - lu(k,572) * lu(k,1587) + lu(k,1613) = lu(k,1613) - lu(k,573) * lu(k,1587) + lu(k,1614) = lu(k,1614) - lu(k,574) * lu(k,1587) + lu(k,1615) = lu(k,1615) - lu(k,575) * lu(k,1587) + lu(k,1616) = lu(k,1616) - lu(k,576) * lu(k,1587) + lu(k,1621) = lu(k,1621) - lu(k,577) * lu(k,1587) + lu(k,1622) = lu(k,1622) - lu(k,578) * lu(k,1587) + lu(k,1623) = lu(k,1623) - lu(k,579) * lu(k,1587) + lu(k,1632) = lu(k,1632) - lu(k,565) * lu(k,1631) + lu(k,1645) = lu(k,1645) - lu(k,566) * lu(k,1631) + lu(k,1646) = lu(k,1646) - lu(k,567) * lu(k,1631) + lu(k,1647) = lu(k,1647) - lu(k,568) * lu(k,1631) + lu(k,1649) = lu(k,1649) - lu(k,569) * lu(k,1631) + lu(k,1651) = lu(k,1651) - lu(k,570) * lu(k,1631) + lu(k,1653) = lu(k,1653) - lu(k,571) * lu(k,1631) + lu(k,1655) = lu(k,1655) - lu(k,572) * lu(k,1631) + lu(k,1656) = lu(k,1656) - lu(k,573) * lu(k,1631) + lu(k,1657) = lu(k,1657) - lu(k,574) * lu(k,1631) + lu(k,1658) = lu(k,1658) - lu(k,575) * lu(k,1631) + lu(k,1659) = lu(k,1659) - lu(k,576) * lu(k,1631) + lu(k,1664) = lu(k,1664) - lu(k,577) * lu(k,1631) + lu(k,1665) = lu(k,1665) - lu(k,578) * lu(k,1631) + lu(k,1666) = lu(k,1666) - lu(k,579) * lu(k,1631) + lu(k,1675) = lu(k,1675) - lu(k,565) * lu(k,1674) + lu(k,1688) = lu(k,1688) - lu(k,566) * lu(k,1674) + lu(k,1689) = lu(k,1689) - lu(k,567) * lu(k,1674) + lu(k,1690) = lu(k,1690) - lu(k,568) * lu(k,1674) + lu(k,1692) = lu(k,1692) - lu(k,569) * lu(k,1674) + lu(k,1694) = lu(k,1694) - lu(k,570) * lu(k,1674) + lu(k,1696) = lu(k,1696) - lu(k,571) * lu(k,1674) + lu(k,1698) = lu(k,1698) - lu(k,572) * lu(k,1674) + lu(k,1699) = lu(k,1699) - lu(k,573) * lu(k,1674) + lu(k,1700) = lu(k,1700) - lu(k,574) * lu(k,1674) + lu(k,1701) = lu(k,1701) - lu(k,575) * lu(k,1674) + lu(k,1702) = lu(k,1702) - lu(k,576) * lu(k,1674) + lu(k,1707) = lu(k,1707) - lu(k,577) * lu(k,1674) + lu(k,1708) = lu(k,1708) - lu(k,578) * lu(k,1674) + lu(k,1709) = lu(k,1709) - lu(k,579) * lu(k,1674) + lu(k,1996) = - lu(k,565) * lu(k,1994) + lu(k,2009) = lu(k,2009) - lu(k,566) * lu(k,1994) + lu(k,2010) = lu(k,2010) - lu(k,567) * lu(k,1994) + lu(k,2011) = lu(k,2011) - lu(k,568) * lu(k,1994) + lu(k,2013) = lu(k,2013) - lu(k,569) * lu(k,1994) + lu(k,2015) = lu(k,2015) - lu(k,570) * lu(k,1994) + lu(k,2017) = lu(k,2017) - lu(k,571) * lu(k,1994) + lu(k,2019) = lu(k,2019) - lu(k,572) * lu(k,1994) + lu(k,2020) = lu(k,2020) - lu(k,573) * lu(k,1994) + lu(k,2021) = lu(k,2021) - lu(k,574) * lu(k,1994) + lu(k,2022) = lu(k,2022) - lu(k,575) * lu(k,1994) + lu(k,2023) = lu(k,2023) - lu(k,576) * lu(k,1994) + lu(k,2028) = lu(k,2028) - lu(k,577) * lu(k,1994) + lu(k,2029) = lu(k,2029) - lu(k,578) * lu(k,1994) + lu(k,2030) = lu(k,2030) - lu(k,579) * lu(k,1994) + lu(k,582) = 1._r8 / lu(k,582) + lu(k,583) = lu(k,583) * lu(k,582) + lu(k,584) = lu(k,584) * lu(k,582) + lu(k,585) = lu(k,585) * lu(k,582) + lu(k,586) = lu(k,586) * lu(k,582) + lu(k,587) = lu(k,587) * lu(k,582) + lu(k,588) = lu(k,588) * lu(k,582) + lu(k,589) = lu(k,589) * lu(k,582) + lu(k,590) = lu(k,590) * lu(k,582) + lu(k,591) = lu(k,591) * lu(k,582) + lu(k,592) = lu(k,592) * lu(k,582) + lu(k,593) = lu(k,593) * lu(k,582) + lu(k,715) = lu(k,715) - lu(k,583) * lu(k,714) + lu(k,716) = - lu(k,584) * lu(k,714) + lu(k,717) = - lu(k,585) * lu(k,714) + lu(k,718) = lu(k,718) - lu(k,586) * lu(k,714) + lu(k,719) = lu(k,719) - lu(k,587) * lu(k,714) + lu(k,721) = - lu(k,588) * lu(k,714) + lu(k,722) = lu(k,722) - lu(k,589) * lu(k,714) + lu(k,723) = lu(k,723) - lu(k,590) * lu(k,714) + lu(k,727) = lu(k,727) - lu(k,591) * lu(k,714) + lu(k,729) = lu(k,729) - lu(k,592) * lu(k,714) + lu(k,732) = lu(k,732) - lu(k,593) * lu(k,714) + lu(k,737) = lu(k,737) - lu(k,583) * lu(k,735) + lu(k,738) = lu(k,738) - lu(k,584) * lu(k,735) + lu(k,739) = lu(k,739) - lu(k,585) * lu(k,735) + lu(k,740) = lu(k,740) - lu(k,586) * lu(k,735) + lu(k,741) = lu(k,741) - lu(k,587) * lu(k,735) + lu(k,744) = lu(k,744) - lu(k,588) * lu(k,735) + lu(k,745) = lu(k,745) - lu(k,589) * lu(k,735) + lu(k,746) = - lu(k,590) * lu(k,735) + lu(k,750) = lu(k,750) - lu(k,591) * lu(k,735) + lu(k,754) = - lu(k,592) * lu(k,735) + lu(k,757) = lu(k,757) - lu(k,593) * lu(k,735) + lu(k,785) = lu(k,785) - lu(k,583) * lu(k,783) + lu(k,786) = lu(k,786) - lu(k,584) * lu(k,783) + lu(k,787) = lu(k,787) - lu(k,585) * lu(k,783) + lu(k,788) = lu(k,788) - lu(k,586) * lu(k,783) + lu(k,789) = lu(k,789) - lu(k,587) * lu(k,783) + lu(k,793) = lu(k,793) - lu(k,588) * lu(k,783) + lu(k,794) = lu(k,794) - lu(k,589) * lu(k,783) + lu(k,795) = lu(k,795) - lu(k,590) * lu(k,783) + lu(k,801) = lu(k,801) - lu(k,591) * lu(k,783) + lu(k,805) = lu(k,805) - lu(k,592) * lu(k,783) + lu(k,808) = lu(k,808) - lu(k,593) * lu(k,783) + lu(k,897) = lu(k,897) - lu(k,583) * lu(k,895) + lu(k,898) = lu(k,898) - lu(k,584) * lu(k,895) + lu(k,899) = lu(k,899) - lu(k,585) * lu(k,895) + lu(k,900) = lu(k,900) - lu(k,586) * lu(k,895) + lu(k,901) = lu(k,901) - lu(k,587) * lu(k,895) + lu(k,905) = - lu(k,588) * lu(k,895) + lu(k,907) = lu(k,907) - lu(k,589) * lu(k,895) + lu(k,908) = lu(k,908) - lu(k,590) * lu(k,895) + lu(k,914) = lu(k,914) - lu(k,591) * lu(k,895) + lu(k,918) = lu(k,918) - lu(k,592) * lu(k,895) + lu(k,921) = lu(k,921) - lu(k,593) * lu(k,895) + lu(k,980) = lu(k,980) - lu(k,583) * lu(k,978) + lu(k,981) = lu(k,981) - lu(k,584) * lu(k,978) + lu(k,982) = lu(k,982) - lu(k,585) * lu(k,978) + lu(k,983) = lu(k,983) - lu(k,586) * lu(k,978) + lu(k,984) = lu(k,984) - lu(k,587) * lu(k,978) + lu(k,989) = lu(k,989) - lu(k,588) * lu(k,978) + lu(k,991) = lu(k,991) - lu(k,589) * lu(k,978) + lu(k,992) = lu(k,992) - lu(k,590) * lu(k,978) + lu(k,998) = lu(k,998) - lu(k,591) * lu(k,978) + lu(k,1002) = lu(k,1002) - lu(k,592) * lu(k,978) + lu(k,1005) = lu(k,1005) - lu(k,593) * lu(k,978) + lu(k,1093) = lu(k,1093) - lu(k,583) * lu(k,1092) + lu(k,1094) = lu(k,1094) - lu(k,584) * lu(k,1092) + lu(k,1095) = - lu(k,585) * lu(k,1092) + lu(k,1099) = lu(k,1099) - lu(k,586) * lu(k,1092) + lu(k,1101) = lu(k,1101) - lu(k,587) * lu(k,1092) + lu(k,1108) = lu(k,1108) - lu(k,588) * lu(k,1092) + lu(k,1110) = lu(k,1110) - lu(k,589) * lu(k,1092) + lu(k,1111) = lu(k,1111) - lu(k,590) * lu(k,1092) + lu(k,1119) = lu(k,1119) - lu(k,591) * lu(k,1092) + lu(k,1123) = lu(k,1123) - lu(k,592) * lu(k,1092) + lu(k,1126) = lu(k,1126) - lu(k,593) * lu(k,1092) + lu(k,1371) = lu(k,1371) - lu(k,583) * lu(k,1368) + lu(k,1372) = lu(k,1372) - lu(k,584) * lu(k,1368) + lu(k,1373) = lu(k,1373) - lu(k,585) * lu(k,1368) + lu(k,1377) = lu(k,1377) - lu(k,586) * lu(k,1368) + lu(k,1379) = lu(k,1379) - lu(k,587) * lu(k,1368) + lu(k,1386) = lu(k,1386) - lu(k,588) * lu(k,1368) + lu(k,1388) = lu(k,1388) - lu(k,589) * lu(k,1368) + lu(k,1389) = lu(k,1389) - lu(k,590) * lu(k,1368) + lu(k,1397) = lu(k,1397) - lu(k,591) * lu(k,1368) + lu(k,1401) = lu(k,1401) - lu(k,592) * lu(k,1368) + lu(k,1404) = lu(k,1404) - lu(k,593) * lu(k,1368) + lu(k,1421) = lu(k,1421) - lu(k,583) * lu(k,1419) + lu(k,1422) = - lu(k,584) * lu(k,1419) + lu(k,1423) = lu(k,1423) - lu(k,585) * lu(k,1419) + lu(k,1426) = lu(k,1426) - lu(k,586) * lu(k,1419) + lu(k,1428) = lu(k,1428) - lu(k,587) * lu(k,1419) + lu(k,1435) = lu(k,1435) - lu(k,588) * lu(k,1419) + lu(k,1437) = lu(k,1437) - lu(k,589) * lu(k,1419) + lu(k,1438) = lu(k,1438) - lu(k,590) * lu(k,1419) + lu(k,1446) = lu(k,1446) - lu(k,591) * lu(k,1419) + lu(k,1450) = lu(k,1450) - lu(k,592) * lu(k,1419) + lu(k,1453) = lu(k,1453) - lu(k,593) * lu(k,1419) + lu(k,1468) = - lu(k,583) * lu(k,1466) + lu(k,1469) = lu(k,1469) - lu(k,584) * lu(k,1466) + lu(k,1470) = lu(k,1470) - lu(k,585) * lu(k,1466) + lu(k,1474) = lu(k,1474) - lu(k,586) * lu(k,1466) + lu(k,1476) = lu(k,1476) - lu(k,587) * lu(k,1466) + lu(k,1483) = lu(k,1483) - lu(k,588) * lu(k,1466) + lu(k,1485) = lu(k,1485) - lu(k,589) * lu(k,1466) + lu(k,1486) = lu(k,1486) - lu(k,590) * lu(k,1466) + lu(k,1494) = lu(k,1494) - lu(k,591) * lu(k,1466) + lu(k,1498) = lu(k,1498) - lu(k,592) * lu(k,1466) + lu(k,1501) = lu(k,1501) - lu(k,593) * lu(k,1466) + lu(k,1719) = lu(k,1719) - lu(k,583) * lu(k,1715) + lu(k,1720) = lu(k,1720) - lu(k,584) * lu(k,1715) + lu(k,1721) = - lu(k,585) * lu(k,1715) + lu(k,1723) = lu(k,1723) - lu(k,586) * lu(k,1715) + lu(k,1725) = lu(k,1725) - lu(k,587) * lu(k,1715) + lu(k,1731) = lu(k,1731) - lu(k,588) * lu(k,1715) + lu(k,1733) = lu(k,1733) - lu(k,589) * lu(k,1715) + lu(k,1734) = lu(k,1734) - lu(k,590) * lu(k,1715) + lu(k,1742) = lu(k,1742) - lu(k,591) * lu(k,1715) + lu(k,1746) = lu(k,1746) - lu(k,592) * lu(k,1715) + lu(k,1749) = lu(k,1749) - lu(k,593) * lu(k,1715) + lu(k,1801) = lu(k,1801) - lu(k,583) * lu(k,1795) + lu(k,1802) = - lu(k,584) * lu(k,1795) + lu(k,1803) = lu(k,1803) - lu(k,585) * lu(k,1795) + lu(k,1806) = lu(k,1806) - lu(k,586) * lu(k,1795) + lu(k,1808) = lu(k,1808) - lu(k,587) * lu(k,1795) + lu(k,1815) = lu(k,1815) - lu(k,588) * lu(k,1795) + lu(k,1817) = lu(k,1817) - lu(k,589) * lu(k,1795) + lu(k,1818) = lu(k,1818) - lu(k,590) * lu(k,1795) + lu(k,1826) = lu(k,1826) - lu(k,591) * lu(k,1795) + lu(k,1830) = lu(k,1830) - lu(k,592) * lu(k,1795) + lu(k,1833) = lu(k,1833) - lu(k,593) * lu(k,1795) + lu(k,1911) = lu(k,1911) - lu(k,583) * lu(k,1909) + lu(k,1912) = - lu(k,584) * lu(k,1909) + lu(k,1913) = lu(k,1913) - lu(k,585) * lu(k,1909) + lu(k,1916) = lu(k,1916) - lu(k,586) * lu(k,1909) + lu(k,1918) = lu(k,1918) - lu(k,587) * lu(k,1909) + lu(k,1925) = lu(k,1925) - lu(k,588) * lu(k,1909) + lu(k,1927) = lu(k,1927) - lu(k,589) * lu(k,1909) + lu(k,1928) = lu(k,1928) - lu(k,590) * lu(k,1909) + lu(k,1936) = lu(k,1936) - lu(k,591) * lu(k,1909) + lu(k,1940) = lu(k,1940) - lu(k,592) * lu(k,1909) + lu(k,1943) = lu(k,1943) - lu(k,593) * lu(k,1909) + lu(k,1953) = lu(k,1953) - lu(k,583) * lu(k,1949) + lu(k,1954) = lu(k,1954) - lu(k,584) * lu(k,1949) + lu(k,1955) = lu(k,1955) - lu(k,585) * lu(k,1949) + lu(k,1958) = lu(k,1958) - lu(k,586) * lu(k,1949) + lu(k,1960) = lu(k,1960) - lu(k,587) * lu(k,1949) + lu(k,1967) = lu(k,1967) - lu(k,588) * lu(k,1949) + lu(k,1969) = lu(k,1969) - lu(k,589) * lu(k,1949) + lu(k,1970) = lu(k,1970) - lu(k,590) * lu(k,1949) + lu(k,1978) = lu(k,1978) - lu(k,591) * lu(k,1949) + lu(k,1982) = lu(k,1982) - lu(k,592) * lu(k,1949) + lu(k,1985) = lu(k,1985) - lu(k,593) * lu(k,1949) + lu(k,1997) = lu(k,1997) - lu(k,583) * lu(k,1995) + lu(k,1998) = - lu(k,584) * lu(k,1995) + lu(k,1999) = lu(k,1999) - lu(k,585) * lu(k,1995) + lu(k,2003) = lu(k,2003) - lu(k,586) * lu(k,1995) + lu(k,2005) = lu(k,2005) - lu(k,587) * lu(k,1995) + lu(k,2012) = lu(k,2012) - lu(k,588) * lu(k,1995) + lu(k,2014) = lu(k,2014) - lu(k,589) * lu(k,1995) + lu(k,2015) = lu(k,2015) - lu(k,590) * lu(k,1995) + lu(k,2023) = lu(k,2023) - lu(k,591) * lu(k,1995) + lu(k,2027) = - lu(k,592) * lu(k,1995) + lu(k,2030) = lu(k,2030) - lu(k,593) * lu(k,1995) + lu(k,2058) = lu(k,2058) - lu(k,583) * lu(k,2053) + lu(k,2059) = lu(k,2059) - lu(k,584) * lu(k,2053) + lu(k,2060) = lu(k,2060) - lu(k,585) * lu(k,2053) + lu(k,2063) = lu(k,2063) - lu(k,586) * lu(k,2053) + lu(k,2065) = lu(k,2065) - lu(k,587) * lu(k,2053) + lu(k,2072) = lu(k,2072) - lu(k,588) * lu(k,2053) + lu(k,2074) = lu(k,2074) - lu(k,589) * lu(k,2053) + lu(k,2075) = lu(k,2075) - lu(k,590) * lu(k,2053) + lu(k,2083) = lu(k,2083) - lu(k,591) * lu(k,2053) + lu(k,2087) = lu(k,2087) - lu(k,592) * lu(k,2053) + lu(k,2090) = lu(k,2090) - lu(k,593) * lu(k,2053) + 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,594) = 1._r8 / lu(k,594) + lu(k,595) = lu(k,595) * lu(k,594) + lu(k,596) = lu(k,596) * lu(k,594) + lu(k,597) = lu(k,597) * lu(k,594) + lu(k,598) = lu(k,598) * lu(k,594) + lu(k,599) = lu(k,599) * lu(k,594) + lu(k,600) = lu(k,600) * lu(k,594) + lu(k,601) = lu(k,601) * lu(k,594) + lu(k,602) = lu(k,602) * lu(k,594) + lu(k,603) = lu(k,603) * lu(k,594) + lu(k,604) = lu(k,604) * lu(k,594) + lu(k,605) = lu(k,605) * lu(k,594) + lu(k,606) = lu(k,606) * lu(k,594) + lu(k,607) = lu(k,607) * lu(k,594) + lu(k,608) = lu(k,608) * lu(k,594) + lu(k,834) = - lu(k,595) * lu(k,831) + lu(k,836) = lu(k,836) - lu(k,596) * lu(k,831) + lu(k,838) = lu(k,838) - lu(k,597) * lu(k,831) + lu(k,839) = - lu(k,598) * lu(k,831) + lu(k,844) = lu(k,844) - lu(k,599) * lu(k,831) + lu(k,846) = lu(k,846) - lu(k,600) * lu(k,831) + lu(k,847) = lu(k,847) - lu(k,601) * lu(k,831) + lu(k,850) = lu(k,850) - lu(k,602) * lu(k,831) + lu(k,854) = lu(k,854) - lu(k,603) * lu(k,831) + lu(k,855) = lu(k,855) - lu(k,604) * lu(k,831) + lu(k,856) = - lu(k,605) * lu(k,831) + lu(k,857) = - lu(k,606) * lu(k,831) + lu(k,858) = lu(k,858) - lu(k,607) * lu(k,831) + lu(k,859) = lu(k,859) - lu(k,608) * lu(k,831) + lu(k,1011) = lu(k,1011) - lu(k,595) * lu(k,1007) + lu(k,1012) = lu(k,1012) - lu(k,596) * lu(k,1007) + lu(k,1014) = lu(k,1014) - lu(k,597) * lu(k,1007) + lu(k,1015) = - lu(k,598) * lu(k,1007) + lu(k,1020) = lu(k,1020) - lu(k,599) * lu(k,1007) + lu(k,1022) = lu(k,1022) - lu(k,600) * lu(k,1007) + lu(k,1023) = lu(k,1023) - lu(k,601) * lu(k,1007) + lu(k,1026) = lu(k,1026) - lu(k,602) * lu(k,1007) + lu(k,1031) = lu(k,1031) - lu(k,603) * lu(k,1007) + lu(k,1032) = lu(k,1032) - lu(k,604) * lu(k,1007) + lu(k,1033) = lu(k,1033) - lu(k,605) * lu(k,1007) + lu(k,1034) = lu(k,1034) - lu(k,606) * lu(k,1007) + lu(k,1035) = - lu(k,607) * lu(k,1007) + lu(k,1036) = lu(k,1036) - lu(k,608) * lu(k,1007) + lu(k,1274) = - lu(k,595) * lu(k,1271) + lu(k,1276) = - lu(k,596) * lu(k,1271) + lu(k,1278) = lu(k,1278) - lu(k,597) * lu(k,1271) + lu(k,1279) = lu(k,1279) - lu(k,598) * lu(k,1271) + lu(k,1284) = lu(k,1284) - lu(k,599) * lu(k,1271) + lu(k,1286) = lu(k,1286) - lu(k,600) * lu(k,1271) + lu(k,1287) = lu(k,1287) - lu(k,601) * lu(k,1271) + lu(k,1290) = lu(k,1290) - lu(k,602) * lu(k,1271) + lu(k,1295) = lu(k,1295) - lu(k,603) * lu(k,1271) + lu(k,1296) = lu(k,1296) - lu(k,604) * lu(k,1271) + lu(k,1297) = lu(k,1297) - lu(k,605) * lu(k,1271) + lu(k,1298) = lu(k,1298) - lu(k,606) * lu(k,1271) + lu(k,1299) = lu(k,1299) - lu(k,607) * lu(k,1271) + lu(k,1300) = lu(k,1300) - lu(k,608) * lu(k,1271) + lu(k,1376) = lu(k,1376) - lu(k,595) * lu(k,1369) + lu(k,1378) = lu(k,1378) - lu(k,596) * lu(k,1369) + lu(k,1380) = lu(k,1380) - lu(k,597) * lu(k,1369) + lu(k,1381) = lu(k,1381) - lu(k,598) * lu(k,1369) + lu(k,1386) = lu(k,1386) - lu(k,599) * lu(k,1369) + lu(k,1388) = lu(k,1388) - lu(k,600) * lu(k,1369) + lu(k,1389) = lu(k,1389) - lu(k,601) * lu(k,1369) + lu(k,1392) = lu(k,1392) - lu(k,602) * lu(k,1369) + lu(k,1397) = lu(k,1397) - lu(k,603) * lu(k,1369) + lu(k,1398) = lu(k,1398) - lu(k,604) * lu(k,1369) + lu(k,1399) = lu(k,1399) - lu(k,605) * lu(k,1369) + lu(k,1400) = lu(k,1400) - lu(k,606) * lu(k,1369) + lu(k,1401) = lu(k,1401) - lu(k,607) * lu(k,1369) + lu(k,1402) = lu(k,1402) - lu(k,608) * lu(k,1369) + lu(k,1425) = - lu(k,595) * lu(k,1420) + lu(k,1427) = - lu(k,596) * lu(k,1420) + lu(k,1429) = lu(k,1429) - lu(k,597) * lu(k,1420) + lu(k,1430) = lu(k,1430) - lu(k,598) * lu(k,1420) + lu(k,1435) = lu(k,1435) - lu(k,599) * lu(k,1420) + lu(k,1437) = lu(k,1437) - lu(k,600) * lu(k,1420) + lu(k,1438) = lu(k,1438) - lu(k,601) * lu(k,1420) + lu(k,1441) = lu(k,1441) - lu(k,602) * lu(k,1420) + lu(k,1446) = lu(k,1446) - lu(k,603) * lu(k,1420) + lu(k,1447) = lu(k,1447) - lu(k,604) * lu(k,1420) + lu(k,1448) = - lu(k,605) * lu(k,1420) + lu(k,1449) = lu(k,1449) - lu(k,606) * lu(k,1420) + lu(k,1450) = lu(k,1450) - lu(k,607) * lu(k,1420) + lu(k,1451) = lu(k,1451) - lu(k,608) * lu(k,1420) + lu(k,1550) = lu(k,1550) - lu(k,595) * lu(k,1547) + lu(k,1552) = lu(k,1552) - lu(k,596) * lu(k,1547) + lu(k,1554) = - lu(k,597) * lu(k,1547) + lu(k,1555) = lu(k,1555) - lu(k,598) * lu(k,1547) + lu(k,1560) = lu(k,1560) - lu(k,599) * lu(k,1547) + lu(k,1562) = lu(k,1562) - lu(k,600) * lu(k,1547) + lu(k,1563) = lu(k,1563) - lu(k,601) * lu(k,1547) + lu(k,1566) = lu(k,1566) - lu(k,602) * lu(k,1547) + lu(k,1571) = lu(k,1571) - lu(k,603) * lu(k,1547) + lu(k,1572) = lu(k,1572) - lu(k,604) * lu(k,1547) + lu(k,1573) = - lu(k,605) * lu(k,1547) + lu(k,1574) = lu(k,1574) - lu(k,606) * lu(k,1547) + lu(k,1575) = lu(k,1575) - lu(k,607) * lu(k,1547) + lu(k,1576) = lu(k,1576) - lu(k,608) * lu(k,1547) + lu(k,1757) = - lu(k,595) * lu(k,1751) + lu(k,1759) = lu(k,1759) - lu(k,596) * lu(k,1751) + lu(k,1761) = lu(k,1761) - lu(k,597) * lu(k,1751) + lu(k,1762) = lu(k,1762) - lu(k,598) * lu(k,1751) + lu(k,1767) = lu(k,1767) - lu(k,599) * lu(k,1751) + lu(k,1769) = lu(k,1769) - lu(k,600) * lu(k,1751) + lu(k,1770) = lu(k,1770) - lu(k,601) * lu(k,1751) + lu(k,1773) = lu(k,1773) - lu(k,602) * lu(k,1751) + lu(k,1778) = lu(k,1778) - lu(k,603) * lu(k,1751) + lu(k,1779) = - lu(k,604) * lu(k,1751) + lu(k,1780) = lu(k,1780) - lu(k,605) * lu(k,1751) + lu(k,1781) = - lu(k,606) * lu(k,1751) + lu(k,1782) = lu(k,1782) - lu(k,607) * lu(k,1751) + lu(k,1783) = lu(k,1783) - lu(k,608) * lu(k,1751) + lu(k,1805) = lu(k,1805) - lu(k,595) * lu(k,1796) + lu(k,1807) = lu(k,1807) - lu(k,596) * lu(k,1796) + lu(k,1809) = lu(k,1809) - lu(k,597) * lu(k,1796) + lu(k,1810) = lu(k,1810) - lu(k,598) * lu(k,1796) + lu(k,1815) = lu(k,1815) - lu(k,599) * lu(k,1796) + lu(k,1817) = lu(k,1817) - lu(k,600) * lu(k,1796) + lu(k,1818) = lu(k,1818) - lu(k,601) * lu(k,1796) + lu(k,1821) = lu(k,1821) - lu(k,602) * lu(k,1796) + lu(k,1826) = lu(k,1826) - lu(k,603) * lu(k,1796) + lu(k,1827) = lu(k,1827) - lu(k,604) * lu(k,1796) + lu(k,1828) = lu(k,1828) - lu(k,605) * lu(k,1796) + lu(k,1829) = lu(k,1829) - lu(k,606) * lu(k,1796) + lu(k,1830) = lu(k,1830) - lu(k,607) * lu(k,1796) + lu(k,1831) = lu(k,1831) - lu(k,608) * lu(k,1796) + lu(k,1838) = - lu(k,595) * lu(k,1836) + lu(k,1840) = lu(k,1840) - lu(k,596) * lu(k,1836) + lu(k,1842) = - lu(k,597) * lu(k,1836) + lu(k,1843) = lu(k,1843) - lu(k,598) * lu(k,1836) + lu(k,1848) = lu(k,1848) - lu(k,599) * lu(k,1836) + lu(k,1850) = lu(k,1850) - lu(k,600) * lu(k,1836) + lu(k,1851) = lu(k,1851) - lu(k,601) * lu(k,1836) + lu(k,1854) = - lu(k,602) * lu(k,1836) + lu(k,1859) = lu(k,1859) - lu(k,603) * lu(k,1836) + lu(k,1860) = lu(k,1860) - lu(k,604) * lu(k,1836) + lu(k,1861) = lu(k,1861) - lu(k,605) * lu(k,1836) + lu(k,1862) = - lu(k,606) * lu(k,1836) + lu(k,1863) = lu(k,1863) - lu(k,607) * lu(k,1836) + lu(k,1864) = lu(k,1864) - lu(k,608) * lu(k,1836) + lu(k,1874) = lu(k,1874) - lu(k,595) * lu(k,1869) + lu(k,1876) = lu(k,1876) - lu(k,596) * lu(k,1869) + lu(k,1878) = lu(k,1878) - lu(k,597) * lu(k,1869) + lu(k,1879) = lu(k,1879) - lu(k,598) * lu(k,1869) + lu(k,1884) = lu(k,1884) - lu(k,599) * lu(k,1869) + lu(k,1886) = lu(k,1886) - lu(k,600) * lu(k,1869) + lu(k,1887) = lu(k,1887) - lu(k,601) * lu(k,1869) + lu(k,1890) = lu(k,1890) - lu(k,602) * lu(k,1869) + lu(k,1895) = lu(k,1895) - lu(k,603) * lu(k,1869) + lu(k,1896) = lu(k,1896) - lu(k,604) * lu(k,1869) + lu(k,1897) = lu(k,1897) - lu(k,605) * lu(k,1869) + lu(k,1898) = lu(k,1898) - lu(k,606) * lu(k,1869) + lu(k,1899) = lu(k,1899) - lu(k,607) * lu(k,1869) + lu(k,1900) = lu(k,1900) - lu(k,608) * lu(k,1869) + lu(k,1915) = lu(k,1915) - lu(k,595) * lu(k,1910) + lu(k,1917) = lu(k,1917) - lu(k,596) * lu(k,1910) + lu(k,1919) = - lu(k,597) * lu(k,1910) + lu(k,1920) = lu(k,1920) - lu(k,598) * lu(k,1910) + lu(k,1925) = lu(k,1925) - lu(k,599) * lu(k,1910) + lu(k,1927) = lu(k,1927) - lu(k,600) * lu(k,1910) + lu(k,1928) = lu(k,1928) - lu(k,601) * lu(k,1910) + lu(k,1931) = lu(k,1931) - lu(k,602) * lu(k,1910) + lu(k,1936) = lu(k,1936) - lu(k,603) * lu(k,1910) + lu(k,1937) = lu(k,1937) - lu(k,604) * lu(k,1910) + lu(k,1938) = lu(k,1938) - lu(k,605) * lu(k,1910) + lu(k,1939) = lu(k,1939) - lu(k,606) * lu(k,1910) + lu(k,1940) = lu(k,1940) - lu(k,607) * lu(k,1910) + lu(k,1941) = lu(k,1941) - lu(k,608) * lu(k,1910) + lu(k,1957) = lu(k,1957) - lu(k,595) * lu(k,1950) + lu(k,1959) = lu(k,1959) - lu(k,596) * lu(k,1950) + lu(k,1961) = lu(k,1961) - lu(k,597) * lu(k,1950) + lu(k,1962) = lu(k,1962) - lu(k,598) * lu(k,1950) + lu(k,1967) = lu(k,1967) - lu(k,599) * lu(k,1950) + lu(k,1969) = lu(k,1969) - lu(k,600) * lu(k,1950) + lu(k,1970) = lu(k,1970) - lu(k,601) * lu(k,1950) + lu(k,1973) = - lu(k,602) * lu(k,1950) + lu(k,1978) = lu(k,1978) - lu(k,603) * lu(k,1950) + lu(k,1979) = lu(k,1979) - lu(k,604) * lu(k,1950) + lu(k,1980) = - lu(k,605) * lu(k,1950) + lu(k,1981) = lu(k,1981) - lu(k,606) * lu(k,1950) + lu(k,1982) = lu(k,1982) - lu(k,607) * lu(k,1950) + lu(k,1983) = lu(k,1983) - lu(k,608) * lu(k,1950) + lu(k,609) = 1._r8 / lu(k,609) + lu(k,610) = lu(k,610) * lu(k,609) + lu(k,611) = lu(k,611) * lu(k,609) + lu(k,612) = lu(k,612) * lu(k,609) + lu(k,613) = lu(k,613) * lu(k,609) + lu(k,614) = lu(k,614) * lu(k,609) + lu(k,615) = lu(k,615) * lu(k,609) + lu(k,616) = lu(k,616) * lu(k,609) + lu(k,617) = lu(k,617) * lu(k,609) + lu(k,618) = lu(k,618) * lu(k,609) + lu(k,619) = lu(k,619) * lu(k,609) + lu(k,620) = lu(k,620) * lu(k,609) + lu(k,621) = lu(k,621) * lu(k,609) + lu(k,622) = lu(k,622) * lu(k,609) + lu(k,627) = - lu(k,610) * lu(k,624) + lu(k,628) = lu(k,628) - lu(k,611) * lu(k,624) + lu(k,629) = lu(k,629) - lu(k,612) * lu(k,624) + lu(k,630) = lu(k,630) - lu(k,613) * lu(k,624) + lu(k,631) = lu(k,631) - lu(k,614) * lu(k,624) + lu(k,633) = lu(k,633) - lu(k,615) * lu(k,624) + lu(k,634) = lu(k,634) - lu(k,616) * lu(k,624) + lu(k,635) = lu(k,635) - lu(k,617) * lu(k,624) + lu(k,636) = lu(k,636) - lu(k,618) * lu(k,624) + lu(k,637) = lu(k,637) - lu(k,619) * lu(k,624) + lu(k,638) = lu(k,638) - lu(k,620) * lu(k,624) + lu(k,641) = lu(k,641) - lu(k,621) * lu(k,624) + lu(k,642) = lu(k,642) - lu(k,622) * lu(k,624) + lu(k,692) = lu(k,692) - lu(k,610) * lu(k,689) + lu(k,693) = lu(k,693) - lu(k,611) * lu(k,689) + lu(k,694) = lu(k,694) - lu(k,612) * lu(k,689) + lu(k,695) = lu(k,695) - lu(k,613) * lu(k,689) + lu(k,696) = lu(k,696) - lu(k,614) * lu(k,689) + lu(k,698) = lu(k,698) - lu(k,615) * lu(k,689) + lu(k,699) = lu(k,699) - lu(k,616) * lu(k,689) + lu(k,700) = lu(k,700) - lu(k,617) * lu(k,689) + lu(k,701) = lu(k,701) - lu(k,618) * lu(k,689) + lu(k,702) = lu(k,702) - lu(k,619) * lu(k,689) + lu(k,703) = lu(k,703) - lu(k,620) * lu(k,689) + lu(k,706) = lu(k,706) - lu(k,621) * lu(k,689) + lu(k,707) = lu(k,707) - lu(k,622) * lu(k,689) + lu(k,866) = lu(k,866) - lu(k,610) * lu(k,863) + lu(k,869) = lu(k,869) - lu(k,611) * lu(k,863) + lu(k,870) = lu(k,870) - lu(k,612) * lu(k,863) + lu(k,871) = lu(k,871) - lu(k,613) * lu(k,863) + lu(k,872) = lu(k,872) - lu(k,614) * lu(k,863) + lu(k,874) = lu(k,874) - lu(k,615) * lu(k,863) + lu(k,876) = lu(k,876) - lu(k,616) * lu(k,863) + lu(k,877) = lu(k,877) - lu(k,617) * lu(k,863) + lu(k,878) = lu(k,878) - lu(k,618) * lu(k,863) + lu(k,879) = lu(k,879) - lu(k,619) * lu(k,863) + lu(k,880) = lu(k,880) - lu(k,620) * lu(k,863) + lu(k,884) = lu(k,884) - lu(k,621) * lu(k,863) + lu(k,886) = lu(k,886) - lu(k,622) * lu(k,863) + lu(k,1146) = lu(k,1146) - lu(k,610) * lu(k,1139) + lu(k,1153) = lu(k,1153) - lu(k,611) * lu(k,1139) + lu(k,1154) = lu(k,1154) - lu(k,612) * lu(k,1139) + lu(k,1155) = lu(k,1155) - lu(k,613) * lu(k,1139) + lu(k,1157) = lu(k,1157) - lu(k,614) * lu(k,1139) + lu(k,1159) = lu(k,1159) - lu(k,615) * lu(k,1139) + lu(k,1161) = lu(k,1161) - lu(k,616) * lu(k,1139) + lu(k,1163) = lu(k,1163) - lu(k,617) * lu(k,1139) + lu(k,1164) = lu(k,1164) - lu(k,618) * lu(k,1139) + lu(k,1165) = lu(k,1165) - lu(k,619) * lu(k,1139) + lu(k,1166) = lu(k,1166) - lu(k,620) * lu(k,1139) + lu(k,1172) = lu(k,1172) - lu(k,621) * lu(k,1139) + lu(k,1174) = lu(k,1174) - lu(k,622) * lu(k,1139) + lu(k,1189) = lu(k,1189) - lu(k,610) * lu(k,1183) + lu(k,1196) = lu(k,1196) - lu(k,611) * lu(k,1183) + lu(k,1197) = lu(k,1197) - lu(k,612) * lu(k,1183) + lu(k,1198) = lu(k,1198) - lu(k,613) * lu(k,1183) + lu(k,1200) = lu(k,1200) - lu(k,614) * lu(k,1183) + lu(k,1202) = lu(k,1202) - lu(k,615) * lu(k,1183) + lu(k,1204) = lu(k,1204) - lu(k,616) * lu(k,1183) + lu(k,1206) = lu(k,1206) - lu(k,617) * lu(k,1183) + lu(k,1207) = lu(k,1207) - lu(k,618) * lu(k,1183) + lu(k,1208) = lu(k,1208) - lu(k,619) * lu(k,1183) + lu(k,1209) = lu(k,1209) - lu(k,620) * lu(k,1183) + lu(k,1215) = lu(k,1215) - lu(k,621) * lu(k,1183) + lu(k,1217) = lu(k,1217) - lu(k,622) * lu(k,1183) + lu(k,1232) = lu(k,1232) - lu(k,610) * lu(k,1226) + lu(k,1239) = lu(k,1239) - lu(k,611) * lu(k,1226) + lu(k,1240) = lu(k,1240) - lu(k,612) * lu(k,1226) + lu(k,1241) = lu(k,1241) - lu(k,613) * lu(k,1226) + lu(k,1243) = lu(k,1243) - lu(k,614) * lu(k,1226) + lu(k,1245) = lu(k,1245) - lu(k,615) * lu(k,1226) + lu(k,1247) = lu(k,1247) - lu(k,616) * lu(k,1226) + lu(k,1249) = lu(k,1249) - lu(k,617) * lu(k,1226) + lu(k,1250) = lu(k,1250) - lu(k,618) * lu(k,1226) + lu(k,1251) = lu(k,1251) - lu(k,619) * lu(k,1226) + lu(k,1252) = lu(k,1252) - lu(k,620) * lu(k,1226) + lu(k,1258) = lu(k,1258) - lu(k,621) * lu(k,1226) + lu(k,1260) = lu(k,1260) - lu(k,622) * lu(k,1226) + lu(k,1316) = lu(k,1316) - lu(k,610) * lu(k,1310) + lu(k,1323) = lu(k,1323) - lu(k,611) * lu(k,1310) + lu(k,1324) = lu(k,1324) - lu(k,612) * lu(k,1310) + lu(k,1325) = lu(k,1325) - lu(k,613) * lu(k,1310) + lu(k,1327) = lu(k,1327) - lu(k,614) * lu(k,1310) + lu(k,1329) = lu(k,1329) - lu(k,615) * lu(k,1310) + lu(k,1331) = lu(k,1331) - lu(k,616) * lu(k,1310) + lu(k,1333) = lu(k,1333) - lu(k,617) * lu(k,1310) + lu(k,1334) = lu(k,1334) - lu(k,618) * lu(k,1310) + lu(k,1335) = lu(k,1335) - lu(k,619) * lu(k,1310) + lu(k,1336) = lu(k,1336) - lu(k,620) * lu(k,1310) + lu(k,1342) = lu(k,1342) - lu(k,621) * lu(k,1310) + lu(k,1344) = lu(k,1344) - lu(k,622) * lu(k,1310) + lu(k,1514) = lu(k,1514) - lu(k,610) * lu(k,1508) + lu(k,1521) = lu(k,1521) - lu(k,611) * lu(k,1508) + lu(k,1522) = lu(k,1522) - lu(k,612) * lu(k,1508) + lu(k,1523) = lu(k,1523) - lu(k,613) * lu(k,1508) + lu(k,1525) = lu(k,1525) - lu(k,614) * lu(k,1508) + lu(k,1527) = lu(k,1527) - lu(k,615) * lu(k,1508) + lu(k,1529) = lu(k,1529) - lu(k,616) * lu(k,1508) + lu(k,1531) = lu(k,1531) - lu(k,617) * lu(k,1508) + lu(k,1532) = lu(k,1532) - lu(k,618) * lu(k,1508) + lu(k,1533) = lu(k,1533) - lu(k,619) * lu(k,1508) + lu(k,1534) = lu(k,1534) - lu(k,620) * lu(k,1508) + lu(k,1540) = lu(k,1540) - lu(k,621) * lu(k,1508) + lu(k,1542) = lu(k,1542) - lu(k,622) * lu(k,1508) + lu(k,1595) = lu(k,1595) - lu(k,610) * lu(k,1588) + lu(k,1602) = lu(k,1602) - lu(k,611) * lu(k,1588) + lu(k,1603) = lu(k,1603) - lu(k,612) * lu(k,1588) + lu(k,1604) = lu(k,1604) - lu(k,613) * lu(k,1588) + lu(k,1606) = lu(k,1606) - lu(k,614) * lu(k,1588) + lu(k,1608) = lu(k,1608) - lu(k,615) * lu(k,1588) + lu(k,1610) = lu(k,1610) - lu(k,616) * lu(k,1588) + lu(k,1612) = lu(k,1612) - lu(k,617) * lu(k,1588) + lu(k,1613) = lu(k,1613) - lu(k,618) * lu(k,1588) + lu(k,1614) = lu(k,1614) - lu(k,619) * lu(k,1588) + lu(k,1615) = lu(k,1615) - lu(k,620) * lu(k,1588) + lu(k,1621) = lu(k,1621) - lu(k,621) * lu(k,1588) + lu(k,1623) = lu(k,1623) - lu(k,622) * lu(k,1588) + lu(k,1638) = lu(k,1638) - lu(k,610) * lu(k,1632) + lu(k,1645) = lu(k,1645) - lu(k,611) * lu(k,1632) + lu(k,1646) = lu(k,1646) - lu(k,612) * lu(k,1632) + lu(k,1647) = lu(k,1647) - lu(k,613) * lu(k,1632) + lu(k,1649) = lu(k,1649) - lu(k,614) * lu(k,1632) + lu(k,1651) = lu(k,1651) - lu(k,615) * lu(k,1632) + lu(k,1653) = lu(k,1653) - lu(k,616) * lu(k,1632) + lu(k,1655) = lu(k,1655) - lu(k,617) * lu(k,1632) + lu(k,1656) = lu(k,1656) - lu(k,618) * lu(k,1632) + lu(k,1657) = lu(k,1657) - lu(k,619) * lu(k,1632) + lu(k,1658) = lu(k,1658) - lu(k,620) * lu(k,1632) + lu(k,1664) = lu(k,1664) - lu(k,621) * lu(k,1632) + lu(k,1666) = lu(k,1666) - lu(k,622) * lu(k,1632) + lu(k,1681) = lu(k,1681) - lu(k,610) * lu(k,1675) + lu(k,1688) = lu(k,1688) - lu(k,611) * lu(k,1675) + lu(k,1689) = lu(k,1689) - lu(k,612) * lu(k,1675) + lu(k,1690) = lu(k,1690) - lu(k,613) * lu(k,1675) + lu(k,1692) = lu(k,1692) - lu(k,614) * lu(k,1675) + lu(k,1694) = lu(k,1694) - lu(k,615) * lu(k,1675) + lu(k,1696) = lu(k,1696) - lu(k,616) * lu(k,1675) + lu(k,1698) = lu(k,1698) - lu(k,617) * lu(k,1675) + lu(k,1699) = lu(k,1699) - lu(k,618) * lu(k,1675) + lu(k,1700) = lu(k,1700) - lu(k,619) * lu(k,1675) + lu(k,1701) = lu(k,1701) - lu(k,620) * lu(k,1675) + lu(k,1707) = lu(k,1707) - lu(k,621) * lu(k,1675) + lu(k,1709) = lu(k,1709) - lu(k,622) * lu(k,1675) + lu(k,1722) = - lu(k,610) * lu(k,1716) + lu(k,1728) = - lu(k,611) * lu(k,1716) + lu(k,1729) = - lu(k,612) * lu(k,1716) + lu(k,1730) = - lu(k,613) * lu(k,1716) + lu(k,1732) = - lu(k,614) * lu(k,1716) + lu(k,1734) = lu(k,1734) - lu(k,615) * lu(k,1716) + lu(k,1736) = lu(k,1736) - lu(k,616) * lu(k,1716) + lu(k,1738) = - lu(k,617) * lu(k,1716) + lu(k,1739) = lu(k,1739) - lu(k,618) * lu(k,1716) + lu(k,1740) = lu(k,1740) - lu(k,619) * lu(k,1716) + lu(k,1741) = lu(k,1741) - lu(k,620) * lu(k,1716) + lu(k,1747) = lu(k,1747) - lu(k,621) * lu(k,1716) + lu(k,1749) = lu(k,1749) - lu(k,622) * lu(k,1716) + lu(k,1805) = lu(k,1805) - lu(k,610) * lu(k,1797) + lu(k,1812) = lu(k,1812) - lu(k,611) * lu(k,1797) + lu(k,1813) = - lu(k,612) * lu(k,1797) + lu(k,1814) = - lu(k,613) * lu(k,1797) + lu(k,1816) = - lu(k,614) * lu(k,1797) + lu(k,1818) = lu(k,1818) - lu(k,615) * lu(k,1797) + lu(k,1820) = lu(k,1820) - lu(k,616) * lu(k,1797) + lu(k,1822) = lu(k,1822) - lu(k,617) * lu(k,1797) + lu(k,1823) = lu(k,1823) - lu(k,618) * lu(k,1797) + lu(k,1824) = lu(k,1824) - lu(k,619) * lu(k,1797) + lu(k,1825) = lu(k,1825) - lu(k,620) * lu(k,1797) + lu(k,1831) = lu(k,1831) - lu(k,621) * lu(k,1797) + lu(k,1833) = lu(k,1833) - lu(k,622) * lu(k,1797) + lu(k,2002) = lu(k,2002) - lu(k,610) * lu(k,1996) + lu(k,2009) = lu(k,2009) - lu(k,611) * lu(k,1996) + lu(k,2010) = lu(k,2010) - lu(k,612) * lu(k,1996) + lu(k,2011) = lu(k,2011) - lu(k,613) * lu(k,1996) + lu(k,2013) = lu(k,2013) - lu(k,614) * lu(k,1996) + lu(k,2015) = lu(k,2015) - lu(k,615) * lu(k,1996) + lu(k,2017) = lu(k,2017) - lu(k,616) * lu(k,1996) + lu(k,2019) = lu(k,2019) - lu(k,617) * lu(k,1996) + lu(k,2020) = lu(k,2020) - lu(k,618) * lu(k,1996) + lu(k,2021) = lu(k,2021) - lu(k,619) * lu(k,1996) + lu(k,2022) = lu(k,2022) - lu(k,620) * lu(k,1996) + lu(k,2028) = lu(k,2028) - lu(k,621) * lu(k,1996) + lu(k,2030) = lu(k,2030) - lu(k,622) * lu(k,1996) + 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,625) = 1._r8 / lu(k,625) + lu(k,626) = lu(k,626) * lu(k,625) + lu(k,627) = lu(k,627) * lu(k,625) + lu(k,628) = lu(k,628) * lu(k,625) + lu(k,629) = lu(k,629) * lu(k,625) + lu(k,630) = lu(k,630) * lu(k,625) + lu(k,631) = lu(k,631) * lu(k,625) + lu(k,632) = lu(k,632) * lu(k,625) + lu(k,633) = lu(k,633) * lu(k,625) + lu(k,634) = lu(k,634) * lu(k,625) + lu(k,635) = lu(k,635) * lu(k,625) + lu(k,636) = lu(k,636) * lu(k,625) + lu(k,637) = lu(k,637) * lu(k,625) + lu(k,638) = lu(k,638) * lu(k,625) + lu(k,639) = lu(k,639) * lu(k,625) + lu(k,640) = lu(k,640) * lu(k,625) + lu(k,641) = lu(k,641) * lu(k,625) + lu(k,642) = lu(k,642) * lu(k,625) + lu(k,691) = lu(k,691) - lu(k,626) * lu(k,690) + lu(k,692) = lu(k,692) - lu(k,627) * lu(k,690) + lu(k,693) = lu(k,693) - lu(k,628) * lu(k,690) + lu(k,694) = lu(k,694) - lu(k,629) * lu(k,690) + lu(k,695) = lu(k,695) - lu(k,630) * lu(k,690) + lu(k,696) = lu(k,696) - lu(k,631) * lu(k,690) + lu(k,697) = lu(k,697) - lu(k,632) * lu(k,690) + lu(k,698) = lu(k,698) - lu(k,633) * lu(k,690) + lu(k,699) = lu(k,699) - lu(k,634) * lu(k,690) + lu(k,700) = lu(k,700) - lu(k,635) * lu(k,690) + lu(k,701) = lu(k,701) - lu(k,636) * lu(k,690) + lu(k,702) = lu(k,702) - lu(k,637) * lu(k,690) + lu(k,703) = lu(k,703) - lu(k,638) * lu(k,690) + lu(k,704) = lu(k,704) - lu(k,639) * lu(k,690) + lu(k,705) = lu(k,705) - lu(k,640) * lu(k,690) + lu(k,706) = lu(k,706) - lu(k,641) * lu(k,690) + lu(k,707) = lu(k,707) - lu(k,642) * lu(k,690) + lu(k,1142) = lu(k,1142) - lu(k,626) * lu(k,1140) + lu(k,1146) = lu(k,1146) - lu(k,627) * lu(k,1140) + lu(k,1153) = lu(k,1153) - lu(k,628) * lu(k,1140) + lu(k,1154) = lu(k,1154) - lu(k,629) * lu(k,1140) + lu(k,1155) = lu(k,1155) - lu(k,630) * lu(k,1140) + lu(k,1157) = lu(k,1157) - lu(k,631) * lu(k,1140) + lu(k,1158) = lu(k,1158) - lu(k,632) * lu(k,1140) + lu(k,1159) = lu(k,1159) - lu(k,633) * lu(k,1140) + lu(k,1161) = lu(k,1161) - lu(k,634) * lu(k,1140) + lu(k,1163) = lu(k,1163) - lu(k,635) * lu(k,1140) + lu(k,1164) = lu(k,1164) - lu(k,636) * lu(k,1140) + lu(k,1165) = lu(k,1165) - lu(k,637) * lu(k,1140) + lu(k,1166) = lu(k,1166) - lu(k,638) * lu(k,1140) + lu(k,1167) = lu(k,1167) - lu(k,639) * lu(k,1140) + lu(k,1168) = lu(k,1168) - lu(k,640) * lu(k,1140) + lu(k,1172) = lu(k,1172) - lu(k,641) * lu(k,1140) + lu(k,1174) = lu(k,1174) - lu(k,642) * lu(k,1140) + lu(k,1186) = lu(k,1186) - lu(k,626) * lu(k,1184) + lu(k,1189) = lu(k,1189) - lu(k,627) * lu(k,1184) + lu(k,1196) = lu(k,1196) - lu(k,628) * lu(k,1184) + lu(k,1197) = lu(k,1197) - lu(k,629) * lu(k,1184) + lu(k,1198) = lu(k,1198) - lu(k,630) * lu(k,1184) + lu(k,1200) = lu(k,1200) - lu(k,631) * lu(k,1184) + lu(k,1201) = lu(k,1201) - lu(k,632) * lu(k,1184) + lu(k,1202) = lu(k,1202) - lu(k,633) * lu(k,1184) + lu(k,1204) = lu(k,1204) - lu(k,634) * lu(k,1184) + lu(k,1206) = lu(k,1206) - lu(k,635) * lu(k,1184) + lu(k,1207) = lu(k,1207) - lu(k,636) * lu(k,1184) + lu(k,1208) = lu(k,1208) - lu(k,637) * lu(k,1184) + lu(k,1209) = lu(k,1209) - lu(k,638) * lu(k,1184) + lu(k,1210) = lu(k,1210) - lu(k,639) * lu(k,1184) + lu(k,1211) = lu(k,1211) - lu(k,640) * lu(k,1184) + lu(k,1215) = lu(k,1215) - lu(k,641) * lu(k,1184) + lu(k,1217) = lu(k,1217) - lu(k,642) * lu(k,1184) + lu(k,1229) = lu(k,1229) - lu(k,626) * lu(k,1227) + lu(k,1232) = lu(k,1232) - lu(k,627) * lu(k,1227) + lu(k,1239) = lu(k,1239) - lu(k,628) * lu(k,1227) + lu(k,1240) = lu(k,1240) - lu(k,629) * lu(k,1227) + lu(k,1241) = lu(k,1241) - lu(k,630) * lu(k,1227) + lu(k,1243) = lu(k,1243) - lu(k,631) * lu(k,1227) + lu(k,1244) = lu(k,1244) - lu(k,632) * lu(k,1227) + lu(k,1245) = lu(k,1245) - lu(k,633) * lu(k,1227) + lu(k,1247) = lu(k,1247) - lu(k,634) * lu(k,1227) + lu(k,1249) = lu(k,1249) - lu(k,635) * lu(k,1227) + lu(k,1250) = lu(k,1250) - lu(k,636) * lu(k,1227) + lu(k,1251) = lu(k,1251) - lu(k,637) * lu(k,1227) + lu(k,1252) = lu(k,1252) - lu(k,638) * lu(k,1227) + lu(k,1253) = lu(k,1253) - lu(k,639) * lu(k,1227) + lu(k,1254) = lu(k,1254) - lu(k,640) * lu(k,1227) + lu(k,1258) = lu(k,1258) - lu(k,641) * lu(k,1227) + lu(k,1260) = lu(k,1260) - lu(k,642) * lu(k,1227) + lu(k,1313) = lu(k,1313) - lu(k,626) * lu(k,1311) + lu(k,1316) = lu(k,1316) - lu(k,627) * lu(k,1311) + lu(k,1323) = lu(k,1323) - lu(k,628) * lu(k,1311) + lu(k,1324) = lu(k,1324) - lu(k,629) * lu(k,1311) + lu(k,1325) = lu(k,1325) - lu(k,630) * lu(k,1311) + lu(k,1327) = lu(k,1327) - lu(k,631) * lu(k,1311) + lu(k,1328) = lu(k,1328) - lu(k,632) * lu(k,1311) + lu(k,1329) = lu(k,1329) - lu(k,633) * lu(k,1311) + lu(k,1331) = lu(k,1331) - lu(k,634) * lu(k,1311) + lu(k,1333) = lu(k,1333) - lu(k,635) * lu(k,1311) + lu(k,1334) = lu(k,1334) - lu(k,636) * lu(k,1311) + lu(k,1335) = lu(k,1335) - lu(k,637) * lu(k,1311) + lu(k,1336) = lu(k,1336) - lu(k,638) * lu(k,1311) + lu(k,1337) = lu(k,1337) - lu(k,639) * lu(k,1311) + lu(k,1338) = lu(k,1338) - lu(k,640) * lu(k,1311) + lu(k,1342) = lu(k,1342) - lu(k,641) * lu(k,1311) + lu(k,1344) = lu(k,1344) - lu(k,642) * lu(k,1311) + lu(k,1591) = lu(k,1591) - lu(k,626) * lu(k,1589) + lu(k,1595) = lu(k,1595) - lu(k,627) * lu(k,1589) + lu(k,1602) = lu(k,1602) - lu(k,628) * lu(k,1589) + lu(k,1603) = lu(k,1603) - lu(k,629) * lu(k,1589) + lu(k,1604) = lu(k,1604) - lu(k,630) * lu(k,1589) + lu(k,1606) = lu(k,1606) - lu(k,631) * lu(k,1589) + lu(k,1607) = lu(k,1607) - lu(k,632) * lu(k,1589) + lu(k,1608) = lu(k,1608) - lu(k,633) * lu(k,1589) + lu(k,1610) = lu(k,1610) - lu(k,634) * lu(k,1589) + lu(k,1612) = lu(k,1612) - lu(k,635) * lu(k,1589) + lu(k,1613) = lu(k,1613) - lu(k,636) * lu(k,1589) + lu(k,1614) = lu(k,1614) - lu(k,637) * lu(k,1589) + lu(k,1615) = lu(k,1615) - lu(k,638) * lu(k,1589) + lu(k,1616) = lu(k,1616) - lu(k,639) * lu(k,1589) + lu(k,1617) = lu(k,1617) - lu(k,640) * lu(k,1589) + lu(k,1621) = lu(k,1621) - lu(k,641) * lu(k,1589) + lu(k,1623) = lu(k,1623) - lu(k,642) * lu(k,1589) + lu(k,1635) = lu(k,1635) - lu(k,626) * lu(k,1633) + lu(k,1638) = lu(k,1638) - lu(k,627) * lu(k,1633) + lu(k,1645) = lu(k,1645) - lu(k,628) * lu(k,1633) + lu(k,1646) = lu(k,1646) - lu(k,629) * lu(k,1633) + lu(k,1647) = lu(k,1647) - lu(k,630) * lu(k,1633) + lu(k,1649) = lu(k,1649) - lu(k,631) * lu(k,1633) + lu(k,1650) = lu(k,1650) - lu(k,632) * lu(k,1633) + lu(k,1651) = lu(k,1651) - lu(k,633) * lu(k,1633) + lu(k,1653) = lu(k,1653) - lu(k,634) * lu(k,1633) + lu(k,1655) = lu(k,1655) - lu(k,635) * lu(k,1633) + lu(k,1656) = lu(k,1656) - lu(k,636) * lu(k,1633) + lu(k,1657) = lu(k,1657) - lu(k,637) * lu(k,1633) + lu(k,1658) = lu(k,1658) - lu(k,638) * lu(k,1633) + lu(k,1659) = lu(k,1659) - lu(k,639) * lu(k,1633) + lu(k,1660) = lu(k,1660) - lu(k,640) * lu(k,1633) + lu(k,1664) = lu(k,1664) - lu(k,641) * lu(k,1633) + lu(k,1666) = lu(k,1666) - lu(k,642) * lu(k,1633) + lu(k,1678) = lu(k,1678) - lu(k,626) * lu(k,1676) + lu(k,1681) = lu(k,1681) - lu(k,627) * lu(k,1676) + lu(k,1688) = lu(k,1688) - lu(k,628) * lu(k,1676) + lu(k,1689) = lu(k,1689) - lu(k,629) * lu(k,1676) + lu(k,1690) = lu(k,1690) - lu(k,630) * lu(k,1676) + lu(k,1692) = lu(k,1692) - lu(k,631) * lu(k,1676) + lu(k,1693) = lu(k,1693) - lu(k,632) * lu(k,1676) + lu(k,1694) = lu(k,1694) - lu(k,633) * lu(k,1676) + lu(k,1696) = lu(k,1696) - lu(k,634) * lu(k,1676) + lu(k,1698) = lu(k,1698) - lu(k,635) * lu(k,1676) + lu(k,1699) = lu(k,1699) - lu(k,636) * lu(k,1676) + lu(k,1700) = lu(k,1700) - lu(k,637) * lu(k,1676) + lu(k,1701) = lu(k,1701) - lu(k,638) * lu(k,1676) + lu(k,1702) = lu(k,1702) - lu(k,639) * lu(k,1676) + lu(k,1703) = lu(k,1703) - lu(k,640) * lu(k,1676) + lu(k,1707) = lu(k,1707) - lu(k,641) * lu(k,1676) + lu(k,1709) = lu(k,1709) - lu(k,642) * lu(k,1676) + lu(k,1718) = lu(k,1718) - lu(k,626) * lu(k,1717) + lu(k,1722) = lu(k,1722) - lu(k,627) * lu(k,1717) + lu(k,1728) = lu(k,1728) - lu(k,628) * lu(k,1717) + lu(k,1729) = lu(k,1729) - lu(k,629) * lu(k,1717) + lu(k,1730) = lu(k,1730) - lu(k,630) * lu(k,1717) + lu(k,1732) = lu(k,1732) - lu(k,631) * lu(k,1717) + lu(k,1733) = lu(k,1733) - lu(k,632) * lu(k,1717) + lu(k,1734) = lu(k,1734) - lu(k,633) * lu(k,1717) + lu(k,1736) = lu(k,1736) - lu(k,634) * lu(k,1717) + lu(k,1738) = lu(k,1738) - lu(k,635) * lu(k,1717) + lu(k,1739) = lu(k,1739) - lu(k,636) * lu(k,1717) + lu(k,1740) = lu(k,1740) - lu(k,637) * lu(k,1717) + lu(k,1741) = lu(k,1741) - lu(k,638) * lu(k,1717) + lu(k,1742) = lu(k,1742) - lu(k,639) * lu(k,1717) + lu(k,1743) = lu(k,1743) - lu(k,640) * lu(k,1717) + lu(k,1747) = lu(k,1747) - lu(k,641) * lu(k,1717) + lu(k,1749) = lu(k,1749) - lu(k,642) * lu(k,1717) + lu(k,1800) = lu(k,1800) - lu(k,626) * lu(k,1798) + lu(k,1805) = lu(k,1805) - lu(k,627) * lu(k,1798) + lu(k,1812) = lu(k,1812) - lu(k,628) * lu(k,1798) + lu(k,1813) = lu(k,1813) - lu(k,629) * lu(k,1798) + lu(k,1814) = lu(k,1814) - lu(k,630) * lu(k,1798) + lu(k,1816) = lu(k,1816) - lu(k,631) * lu(k,1798) + lu(k,1817) = lu(k,1817) - lu(k,632) * lu(k,1798) + lu(k,1818) = lu(k,1818) - lu(k,633) * lu(k,1798) + lu(k,1820) = lu(k,1820) - lu(k,634) * lu(k,1798) + lu(k,1822) = lu(k,1822) - lu(k,635) * lu(k,1798) + lu(k,1823) = lu(k,1823) - lu(k,636) * lu(k,1798) + lu(k,1824) = lu(k,1824) - lu(k,637) * lu(k,1798) + lu(k,1825) = lu(k,1825) - lu(k,638) * lu(k,1798) + lu(k,1826) = lu(k,1826) - lu(k,639) * lu(k,1798) + lu(k,1827) = lu(k,1827) - lu(k,640) * lu(k,1798) + lu(k,1831) = lu(k,1831) - lu(k,641) * lu(k,1798) + lu(k,1833) = lu(k,1833) - lu(k,642) * lu(k,1798) + lu(k,2057) = lu(k,2057) - lu(k,626) * lu(k,2054) + lu(k,2062) = lu(k,2062) - lu(k,627) * lu(k,2054) + lu(k,2069) = lu(k,2069) - lu(k,628) * lu(k,2054) + lu(k,2070) = lu(k,2070) - lu(k,629) * lu(k,2054) + lu(k,2071) = lu(k,2071) - lu(k,630) * lu(k,2054) + lu(k,2073) = lu(k,2073) - lu(k,631) * lu(k,2054) + lu(k,2074) = lu(k,2074) - lu(k,632) * lu(k,2054) + lu(k,2075) = lu(k,2075) - lu(k,633) * lu(k,2054) + lu(k,2077) = lu(k,2077) - lu(k,634) * lu(k,2054) + lu(k,2079) = lu(k,2079) - lu(k,635) * lu(k,2054) + lu(k,2080) = lu(k,2080) - lu(k,636) * lu(k,2054) + lu(k,2081) = lu(k,2081) - lu(k,637) * lu(k,2054) + lu(k,2082) = lu(k,2082) - lu(k,638) * lu(k,2054) + lu(k,2083) = lu(k,2083) - lu(k,639) * lu(k,2054) + lu(k,2084) = lu(k,2084) - lu(k,640) * lu(k,2054) + lu(k,2088) = lu(k,2088) - lu(k,641) * lu(k,2054) + lu(k,2090) = lu(k,2090) - lu(k,642) * lu(k,2054) + lu(k,647) = 1._r8 / lu(k,647) + lu(k,648) = lu(k,648) * lu(k,647) + lu(k,649) = lu(k,649) * lu(k,647) + lu(k,650) = lu(k,650) * lu(k,647) + lu(k,651) = lu(k,651) * lu(k,647) + lu(k,652) = lu(k,652) * lu(k,647) + lu(k,653) = lu(k,653) * lu(k,647) + lu(k,654) = lu(k,654) * lu(k,647) + lu(k,655) = lu(k,655) * lu(k,647) + lu(k,656) = lu(k,656) * lu(k,647) + lu(k,657) = lu(k,657) * lu(k,647) + lu(k,658) = lu(k,658) * lu(k,647) + lu(k,659) = lu(k,659) * lu(k,647) + lu(k,660) = lu(k,660) * lu(k,647) + lu(k,661) = lu(k,661) * lu(k,647) + lu(k,662) = lu(k,662) * lu(k,647) + lu(k,663) = lu(k,663) * lu(k,647) + lu(k,664) = lu(k,664) * lu(k,647) + lu(k,665) = lu(k,665) * lu(k,647) + lu(k,666) = lu(k,666) * lu(k,647) + lu(k,738) = lu(k,738) - lu(k,648) * lu(k,736) + lu(k,739) = lu(k,739) - lu(k,649) * lu(k,736) + lu(k,740) = lu(k,740) - lu(k,650) * lu(k,736) + lu(k,741) = lu(k,741) - lu(k,651) * lu(k,736) + lu(k,742) = - lu(k,652) * lu(k,736) + lu(k,743) = - lu(k,653) * lu(k,736) + lu(k,744) = lu(k,744) - lu(k,654) * lu(k,736) + lu(k,745) = lu(k,745) - lu(k,655) * lu(k,736) + lu(k,746) = lu(k,746) - lu(k,656) * lu(k,736) + lu(k,747) = lu(k,747) - lu(k,657) * lu(k,736) + lu(k,748) = lu(k,748) - lu(k,658) * lu(k,736) + lu(k,749) = lu(k,749) - lu(k,659) * lu(k,736) + lu(k,750) = lu(k,750) - lu(k,660) * lu(k,736) + lu(k,751) = - lu(k,661) * lu(k,736) + lu(k,752) = - lu(k,662) * lu(k,736) + lu(k,753) = - lu(k,663) * lu(k,736) + lu(k,755) = - lu(k,664) * lu(k,736) + lu(k,756) = lu(k,756) - lu(k,665) * lu(k,736) + lu(k,757) = lu(k,757) - lu(k,666) * lu(k,736) + lu(k,786) = lu(k,786) - lu(k,648) * lu(k,784) + lu(k,787) = lu(k,787) - lu(k,649) * lu(k,784) + lu(k,788) = lu(k,788) - lu(k,650) * lu(k,784) + lu(k,789) = lu(k,789) - lu(k,651) * lu(k,784) + lu(k,790) = lu(k,790) - lu(k,652) * lu(k,784) + lu(k,791) = lu(k,791) - lu(k,653) * lu(k,784) + lu(k,793) = lu(k,793) - lu(k,654) * lu(k,784) + lu(k,794) = lu(k,794) - lu(k,655) * lu(k,784) + lu(k,795) = lu(k,795) - lu(k,656) * lu(k,784) + lu(k,796) = lu(k,796) - lu(k,657) * lu(k,784) + lu(k,797) = lu(k,797) - lu(k,658) * lu(k,784) + lu(k,800) = lu(k,800) - lu(k,659) * lu(k,784) + lu(k,801) = lu(k,801) - lu(k,660) * lu(k,784) + lu(k,802) = lu(k,802) - lu(k,661) * lu(k,784) + lu(k,803) = - lu(k,662) * lu(k,784) + lu(k,804) = lu(k,804) - lu(k,663) * lu(k,784) + lu(k,806) = lu(k,806) - lu(k,664) * lu(k,784) + lu(k,807) = lu(k,807) - lu(k,665) * lu(k,784) + lu(k,808) = lu(k,808) - lu(k,666) * lu(k,784) + lu(k,898) = lu(k,898) - lu(k,648) * lu(k,896) + lu(k,899) = lu(k,899) - lu(k,649) * lu(k,896) + lu(k,900) = lu(k,900) - lu(k,650) * lu(k,896) + lu(k,901) = lu(k,901) - lu(k,651) * lu(k,896) + lu(k,902) = lu(k,902) - lu(k,652) * lu(k,896) + lu(k,903) = lu(k,903) - lu(k,653) * lu(k,896) + lu(k,905) = lu(k,905) - lu(k,654) * lu(k,896) + lu(k,907) = lu(k,907) - lu(k,655) * lu(k,896) + lu(k,908) = lu(k,908) - lu(k,656) * lu(k,896) + lu(k,909) = lu(k,909) - lu(k,657) * lu(k,896) + lu(k,910) = - lu(k,658) * lu(k,896) + lu(k,913) = lu(k,913) - lu(k,659) * lu(k,896) + lu(k,914) = lu(k,914) - lu(k,660) * lu(k,896) + lu(k,915) = lu(k,915) - lu(k,661) * lu(k,896) + lu(k,916) = - lu(k,662) * lu(k,896) + lu(k,917) = - lu(k,663) * lu(k,896) + lu(k,919) = lu(k,919) - lu(k,664) * lu(k,896) + lu(k,920) = lu(k,920) - lu(k,665) * lu(k,896) + lu(k,921) = lu(k,921) - lu(k,666) * lu(k,896) + lu(k,981) = lu(k,981) - lu(k,648) * lu(k,979) + lu(k,982) = lu(k,982) - lu(k,649) * lu(k,979) + lu(k,983) = lu(k,983) - lu(k,650) * lu(k,979) + lu(k,984) = lu(k,984) - lu(k,651) * lu(k,979) + lu(k,985) = lu(k,985) - lu(k,652) * lu(k,979) + lu(k,986) = lu(k,986) - lu(k,653) * lu(k,979) + lu(k,989) = lu(k,989) - lu(k,654) * lu(k,979) + lu(k,991) = lu(k,991) - lu(k,655) * lu(k,979) + lu(k,992) = lu(k,992) - lu(k,656) * lu(k,979) + lu(k,993) = lu(k,993) - lu(k,657) * lu(k,979) + lu(k,994) = lu(k,994) - lu(k,658) * lu(k,979) + lu(k,997) = lu(k,997) - lu(k,659) * lu(k,979) + lu(k,998) = lu(k,998) - lu(k,660) * lu(k,979) + lu(k,999) = lu(k,999) - lu(k,661) * lu(k,979) + lu(k,1000) = - lu(k,662) * lu(k,979) + lu(k,1001) = - lu(k,663) * lu(k,979) + lu(k,1003) = lu(k,1003) - lu(k,664) * lu(k,979) + lu(k,1004) = lu(k,1004) - lu(k,665) * lu(k,979) + lu(k,1005) = lu(k,1005) - lu(k,666) * lu(k,979) + lu(k,1372) = lu(k,1372) - lu(k,648) * lu(k,1370) + lu(k,1373) = lu(k,1373) - lu(k,649) * lu(k,1370) + lu(k,1377) = lu(k,1377) - lu(k,650) * lu(k,1370) + lu(k,1379) = lu(k,1379) - lu(k,651) * lu(k,1370) + lu(k,1381) = lu(k,1381) - lu(k,652) * lu(k,1370) + lu(k,1382) = lu(k,1382) - lu(k,653) * lu(k,1370) + lu(k,1386) = lu(k,1386) - lu(k,654) * lu(k,1370) + lu(k,1388) = lu(k,1388) - lu(k,655) * lu(k,1370) + lu(k,1389) = lu(k,1389) - lu(k,656) * lu(k,1370) + lu(k,1390) = lu(k,1390) - lu(k,657) * lu(k,1370) + lu(k,1391) = lu(k,1391) - lu(k,658) * lu(k,1370) + lu(k,1396) = lu(k,1396) - lu(k,659) * lu(k,1370) + lu(k,1397) = lu(k,1397) - lu(k,660) * lu(k,1370) + lu(k,1398) = lu(k,1398) - lu(k,661) * lu(k,1370) + lu(k,1399) = lu(k,1399) - lu(k,662) * lu(k,1370) + lu(k,1400) = lu(k,1400) - lu(k,663) * lu(k,1370) + lu(k,1402) = lu(k,1402) - lu(k,664) * lu(k,1370) + lu(k,1403) = lu(k,1403) - lu(k,665) * lu(k,1370) + lu(k,1404) = lu(k,1404) - lu(k,666) * lu(k,1370) + lu(k,1469) = lu(k,1469) - lu(k,648) * lu(k,1467) + lu(k,1470) = lu(k,1470) - lu(k,649) * lu(k,1467) + lu(k,1474) = lu(k,1474) - lu(k,650) * lu(k,1467) + lu(k,1476) = lu(k,1476) - lu(k,651) * lu(k,1467) + lu(k,1478) = - lu(k,652) * lu(k,1467) + lu(k,1479) = lu(k,1479) - lu(k,653) * lu(k,1467) + lu(k,1483) = lu(k,1483) - lu(k,654) * lu(k,1467) + lu(k,1485) = lu(k,1485) - lu(k,655) * lu(k,1467) + lu(k,1486) = lu(k,1486) - lu(k,656) * lu(k,1467) + lu(k,1487) = lu(k,1487) - lu(k,657) * lu(k,1467) + lu(k,1488) = lu(k,1488) - lu(k,658) * lu(k,1467) + lu(k,1493) = lu(k,1493) - lu(k,659) * lu(k,1467) + lu(k,1494) = lu(k,1494) - lu(k,660) * lu(k,1467) + lu(k,1495) = lu(k,1495) - lu(k,661) * lu(k,1467) + lu(k,1496) = lu(k,1496) - lu(k,662) * lu(k,1467) + lu(k,1497) = lu(k,1497) - lu(k,663) * lu(k,1467) + lu(k,1499) = lu(k,1499) - lu(k,664) * lu(k,1467) + lu(k,1500) = lu(k,1500) - lu(k,665) * lu(k,1467) + lu(k,1501) = lu(k,1501) - lu(k,666) * lu(k,1467) + lu(k,1511) = lu(k,1511) - lu(k,648) * lu(k,1509) + lu(k,1512) = lu(k,1512) - lu(k,649) * lu(k,1509) + lu(k,1515) = lu(k,1515) - lu(k,650) * lu(k,1509) + lu(k,1517) = lu(k,1517) - lu(k,651) * lu(k,1509) + lu(k,1519) = - lu(k,652) * lu(k,1509) + lu(k,1520) = lu(k,1520) - lu(k,653) * lu(k,1509) + lu(k,1524) = lu(k,1524) - lu(k,654) * lu(k,1509) + lu(k,1526) = lu(k,1526) - lu(k,655) * lu(k,1509) + lu(k,1527) = lu(k,1527) - lu(k,656) * lu(k,1509) + lu(k,1528) = lu(k,1528) - lu(k,657) * lu(k,1509) + lu(k,1529) = lu(k,1529) - lu(k,658) * lu(k,1509) + lu(k,1534) = lu(k,1534) - lu(k,659) * lu(k,1509) + lu(k,1535) = lu(k,1535) - lu(k,660) * lu(k,1509) + lu(k,1536) = lu(k,1536) - lu(k,661) * lu(k,1509) + lu(k,1537) = - lu(k,662) * lu(k,1509) + lu(k,1538) = lu(k,1538) - lu(k,663) * lu(k,1509) + lu(k,1540) = lu(k,1540) - lu(k,664) * lu(k,1509) + lu(k,1541) = lu(k,1541) - lu(k,665) * lu(k,1509) + lu(k,1542) = lu(k,1542) - lu(k,666) * lu(k,1509) + lu(k,1753) = - lu(k,648) * lu(k,1752) + lu(k,1754) = - lu(k,649) * lu(k,1752) + lu(k,1758) = lu(k,1758) - lu(k,650) * lu(k,1752) + lu(k,1760) = lu(k,1760) - lu(k,651) * lu(k,1752) + lu(k,1762) = lu(k,1762) - lu(k,652) * lu(k,1752) + lu(k,1763) = - lu(k,653) * lu(k,1752) + lu(k,1767) = lu(k,1767) - lu(k,654) * lu(k,1752) + lu(k,1769) = lu(k,1769) - lu(k,655) * lu(k,1752) + lu(k,1770) = lu(k,1770) - lu(k,656) * lu(k,1752) + lu(k,1771) = - lu(k,657) * lu(k,1752) + lu(k,1772) = - lu(k,658) * lu(k,1752) + lu(k,1777) = - lu(k,659) * lu(k,1752) + lu(k,1778) = lu(k,1778) - lu(k,660) * lu(k,1752) + lu(k,1779) = lu(k,1779) - lu(k,661) * lu(k,1752) + lu(k,1780) = lu(k,1780) - lu(k,662) * lu(k,1752) + lu(k,1781) = lu(k,1781) - lu(k,663) * lu(k,1752) + lu(k,1783) = lu(k,1783) - lu(k,664) * lu(k,1752) + lu(k,1784) = lu(k,1784) - lu(k,665) * lu(k,1752) + lu(k,1785) = lu(k,1785) - lu(k,666) * lu(k,1752) + lu(k,1871) = - lu(k,648) * lu(k,1870) + lu(k,1872) = - lu(k,649) * lu(k,1870) + lu(k,1875) = - lu(k,650) * lu(k,1870) + lu(k,1877) = lu(k,1877) - lu(k,651) * lu(k,1870) + lu(k,1879) = lu(k,1879) - lu(k,652) * lu(k,1870) + lu(k,1880) = lu(k,1880) - lu(k,653) * lu(k,1870) + lu(k,1884) = lu(k,1884) - lu(k,654) * lu(k,1870) + lu(k,1886) = lu(k,1886) - lu(k,655) * lu(k,1870) + lu(k,1887) = lu(k,1887) - lu(k,656) * lu(k,1870) + lu(k,1888) = lu(k,1888) - lu(k,657) * lu(k,1870) + lu(k,1889) = lu(k,1889) - lu(k,658) * lu(k,1870) + lu(k,1894) = - lu(k,659) * lu(k,1870) + lu(k,1895) = lu(k,1895) - lu(k,660) * lu(k,1870) + lu(k,1896) = lu(k,1896) - lu(k,661) * lu(k,1870) + lu(k,1897) = lu(k,1897) - lu(k,662) * lu(k,1870) + lu(k,1898) = lu(k,1898) - lu(k,663) * lu(k,1870) + lu(k,1900) = lu(k,1900) - lu(k,664) * lu(k,1870) + lu(k,1901) = lu(k,1901) - lu(k,665) * lu(k,1870) + lu(k,1902) = lu(k,1902) - lu(k,666) * lu(k,1870) + lu(k,2059) = lu(k,2059) - lu(k,648) * lu(k,2055) + lu(k,2060) = lu(k,2060) - lu(k,649) * lu(k,2055) + lu(k,2063) = lu(k,2063) - lu(k,650) * lu(k,2055) + lu(k,2065) = lu(k,2065) - lu(k,651) * lu(k,2055) + lu(k,2067) = lu(k,2067) - lu(k,652) * lu(k,2055) + lu(k,2068) = lu(k,2068) - lu(k,653) * lu(k,2055) + lu(k,2072) = lu(k,2072) - lu(k,654) * lu(k,2055) + lu(k,2074) = lu(k,2074) - lu(k,655) * lu(k,2055) + lu(k,2075) = lu(k,2075) - lu(k,656) * lu(k,2055) + lu(k,2076) = lu(k,2076) - lu(k,657) * lu(k,2055) + lu(k,2077) = lu(k,2077) - lu(k,658) * lu(k,2055) + lu(k,2082) = lu(k,2082) - lu(k,659) * lu(k,2055) + lu(k,2083) = lu(k,2083) - lu(k,660) * lu(k,2055) + lu(k,2084) = lu(k,2084) - lu(k,661) * lu(k,2055) + lu(k,2085) = lu(k,2085) - lu(k,662) * lu(k,2055) + lu(k,2086) = lu(k,2086) - lu(k,663) * lu(k,2055) + lu(k,2088) = lu(k,2088) - lu(k,664) * lu(k,2055) + lu(k,2089) = lu(k,2089) - lu(k,665) * lu(k,2055) + lu(k,2090) = lu(k,2090) - lu(k,666) * lu(k,2055) + 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,669) = 1._r8 / lu(k,669) + lu(k,670) = lu(k,670) * lu(k,669) + lu(k,671) = lu(k,671) * lu(k,669) + lu(k,672) = lu(k,672) * lu(k,669) + lu(k,673) = lu(k,673) * lu(k,669) + lu(k,674) = lu(k,674) * lu(k,669) + lu(k,675) = lu(k,675) * lu(k,669) + lu(k,676) = lu(k,676) * lu(k,669) + lu(k,677) = lu(k,677) * lu(k,669) + lu(k,678) = lu(k,678) * lu(k,669) + lu(k,679) = lu(k,679) * lu(k,669) + lu(k,680) = lu(k,680) * lu(k,669) + lu(k,681) = lu(k,681) * lu(k,669) + lu(k,682) = lu(k,682) * lu(k,669) + lu(k,683) = lu(k,683) * lu(k,669) + lu(k,684) = lu(k,684) * lu(k,669) + lu(k,685) = lu(k,685) * lu(k,669) + lu(k,686) = lu(k,686) * lu(k,669) + lu(k,687) = lu(k,687) * lu(k,669) + lu(k,1009) = - lu(k,670) * lu(k,1008) + lu(k,1011) = lu(k,1011) - lu(k,671) * lu(k,1008) + lu(k,1012) = lu(k,1012) - lu(k,672) * lu(k,1008) + lu(k,1014) = lu(k,1014) - lu(k,673) * lu(k,1008) + lu(k,1017) = lu(k,1017) - lu(k,674) * lu(k,1008) + lu(k,1018) = lu(k,1018) - lu(k,675) * lu(k,1008) + lu(k,1019) = lu(k,1019) - lu(k,676) * lu(k,1008) + lu(k,1020) = lu(k,1020) - lu(k,677) * lu(k,1008) + lu(k,1021) = lu(k,1021) - lu(k,678) * lu(k,1008) + lu(k,1022) = lu(k,1022) - lu(k,679) * lu(k,1008) + lu(k,1023) = lu(k,1023) - lu(k,680) * lu(k,1008) + lu(k,1027) = lu(k,1027) - lu(k,681) * lu(k,1008) + lu(k,1028) = lu(k,1028) - lu(k,682) * lu(k,1008) + lu(k,1029) = lu(k,1029) - lu(k,683) * lu(k,1008) + lu(k,1031) = lu(k,1031) - lu(k,684) * lu(k,1008) + lu(k,1032) = lu(k,1032) - lu(k,685) * lu(k,1008) + lu(k,1036) = lu(k,1036) - lu(k,686) * lu(k,1008) + lu(k,1038) = lu(k,1038) - lu(k,687) * lu(k,1008) + lu(k,1142) = lu(k,1142) - lu(k,670) * lu(k,1141) + lu(k,1146) = lu(k,1146) - lu(k,671) * lu(k,1141) + lu(k,1148) = lu(k,1148) - lu(k,672) * lu(k,1141) + lu(k,1150) = lu(k,1150) - lu(k,673) * lu(k,1141) + lu(k,1153) = lu(k,1153) - lu(k,674) * lu(k,1141) + lu(k,1154) = lu(k,1154) - lu(k,675) * lu(k,1141) + lu(k,1155) = lu(k,1155) - lu(k,676) * lu(k,1141) + lu(k,1156) = lu(k,1156) - lu(k,677) * lu(k,1141) + lu(k,1157) = lu(k,1157) - lu(k,678) * lu(k,1141) + lu(k,1158) = lu(k,1158) - lu(k,679) * lu(k,1141) + lu(k,1159) = lu(k,1159) - lu(k,680) * lu(k,1141) + lu(k,1163) = lu(k,1163) - lu(k,681) * lu(k,1141) + lu(k,1164) = lu(k,1164) - lu(k,682) * lu(k,1141) + lu(k,1165) = lu(k,1165) - lu(k,683) * lu(k,1141) + lu(k,1167) = lu(k,1167) - lu(k,684) * lu(k,1141) + lu(k,1168) = lu(k,1168) - lu(k,685) * lu(k,1141) + lu(k,1172) = lu(k,1172) - lu(k,686) * lu(k,1141) + lu(k,1174) = lu(k,1174) - lu(k,687) * lu(k,1141) + lu(k,1186) = lu(k,1186) - lu(k,670) * lu(k,1185) + lu(k,1189) = lu(k,1189) - lu(k,671) * lu(k,1185) + lu(k,1191) = lu(k,1191) - lu(k,672) * lu(k,1185) + lu(k,1193) = lu(k,1193) - lu(k,673) * lu(k,1185) + lu(k,1196) = lu(k,1196) - lu(k,674) * lu(k,1185) + lu(k,1197) = lu(k,1197) - lu(k,675) * lu(k,1185) + lu(k,1198) = lu(k,1198) - lu(k,676) * lu(k,1185) + lu(k,1199) = lu(k,1199) - lu(k,677) * lu(k,1185) + lu(k,1200) = lu(k,1200) - lu(k,678) * lu(k,1185) + lu(k,1201) = lu(k,1201) - lu(k,679) * lu(k,1185) + lu(k,1202) = lu(k,1202) - lu(k,680) * lu(k,1185) + lu(k,1206) = lu(k,1206) - lu(k,681) * lu(k,1185) + lu(k,1207) = lu(k,1207) - lu(k,682) * lu(k,1185) + lu(k,1208) = lu(k,1208) - lu(k,683) * lu(k,1185) + lu(k,1210) = lu(k,1210) - lu(k,684) * lu(k,1185) + lu(k,1211) = lu(k,1211) - lu(k,685) * lu(k,1185) + lu(k,1215) = lu(k,1215) - lu(k,686) * lu(k,1185) + lu(k,1217) = lu(k,1217) - lu(k,687) * lu(k,1185) + lu(k,1229) = lu(k,1229) - lu(k,670) * lu(k,1228) + lu(k,1232) = lu(k,1232) - lu(k,671) * lu(k,1228) + lu(k,1234) = lu(k,1234) - lu(k,672) * lu(k,1228) + lu(k,1236) = lu(k,1236) - lu(k,673) * lu(k,1228) + lu(k,1239) = lu(k,1239) - lu(k,674) * lu(k,1228) + lu(k,1240) = lu(k,1240) - lu(k,675) * lu(k,1228) + lu(k,1241) = lu(k,1241) - lu(k,676) * lu(k,1228) + lu(k,1242) = lu(k,1242) - lu(k,677) * lu(k,1228) + lu(k,1243) = lu(k,1243) - lu(k,678) * lu(k,1228) + lu(k,1244) = lu(k,1244) - lu(k,679) * lu(k,1228) + lu(k,1245) = lu(k,1245) - lu(k,680) * lu(k,1228) + lu(k,1249) = lu(k,1249) - lu(k,681) * lu(k,1228) + lu(k,1250) = lu(k,1250) - lu(k,682) * lu(k,1228) + lu(k,1251) = lu(k,1251) - lu(k,683) * lu(k,1228) + lu(k,1253) = lu(k,1253) - lu(k,684) * lu(k,1228) + lu(k,1254) = lu(k,1254) - lu(k,685) * lu(k,1228) + lu(k,1258) = lu(k,1258) - lu(k,686) * lu(k,1228) + lu(k,1260) = lu(k,1260) - lu(k,687) * lu(k,1228) + lu(k,1313) = lu(k,1313) - lu(k,670) * lu(k,1312) + lu(k,1316) = lu(k,1316) - lu(k,671) * lu(k,1312) + lu(k,1318) = lu(k,1318) - lu(k,672) * lu(k,1312) + lu(k,1320) = lu(k,1320) - lu(k,673) * lu(k,1312) + lu(k,1323) = lu(k,1323) - lu(k,674) * lu(k,1312) + lu(k,1324) = lu(k,1324) - lu(k,675) * lu(k,1312) + lu(k,1325) = lu(k,1325) - lu(k,676) * lu(k,1312) + lu(k,1326) = lu(k,1326) - lu(k,677) * lu(k,1312) + lu(k,1327) = lu(k,1327) - lu(k,678) * lu(k,1312) + lu(k,1328) = lu(k,1328) - lu(k,679) * lu(k,1312) + lu(k,1329) = lu(k,1329) - lu(k,680) * lu(k,1312) + lu(k,1333) = lu(k,1333) - lu(k,681) * lu(k,1312) + lu(k,1334) = lu(k,1334) - lu(k,682) * lu(k,1312) + lu(k,1335) = lu(k,1335) - lu(k,683) * lu(k,1312) + lu(k,1337) = lu(k,1337) - lu(k,684) * lu(k,1312) + lu(k,1338) = lu(k,1338) - lu(k,685) * lu(k,1312) + lu(k,1342) = lu(k,1342) - lu(k,686) * lu(k,1312) + lu(k,1344) = lu(k,1344) - lu(k,687) * lu(k,1312) + lu(k,1591) = lu(k,1591) - lu(k,670) * lu(k,1590) + lu(k,1595) = lu(k,1595) - lu(k,671) * lu(k,1590) + lu(k,1597) = lu(k,1597) - lu(k,672) * lu(k,1590) + lu(k,1599) = lu(k,1599) - lu(k,673) * lu(k,1590) + lu(k,1602) = lu(k,1602) - lu(k,674) * lu(k,1590) + lu(k,1603) = lu(k,1603) - lu(k,675) * lu(k,1590) + lu(k,1604) = lu(k,1604) - lu(k,676) * lu(k,1590) + lu(k,1605) = lu(k,1605) - lu(k,677) * lu(k,1590) + lu(k,1606) = lu(k,1606) - lu(k,678) * lu(k,1590) + lu(k,1607) = lu(k,1607) - lu(k,679) * lu(k,1590) + lu(k,1608) = lu(k,1608) - lu(k,680) * lu(k,1590) + lu(k,1612) = lu(k,1612) - lu(k,681) * lu(k,1590) + lu(k,1613) = lu(k,1613) - lu(k,682) * lu(k,1590) + lu(k,1614) = lu(k,1614) - lu(k,683) * lu(k,1590) + lu(k,1616) = lu(k,1616) - lu(k,684) * lu(k,1590) + lu(k,1617) = lu(k,1617) - lu(k,685) * lu(k,1590) + lu(k,1621) = lu(k,1621) - lu(k,686) * lu(k,1590) + lu(k,1623) = lu(k,1623) - lu(k,687) * lu(k,1590) + lu(k,1635) = lu(k,1635) - lu(k,670) * lu(k,1634) + lu(k,1638) = lu(k,1638) - lu(k,671) * lu(k,1634) + lu(k,1640) = lu(k,1640) - lu(k,672) * lu(k,1634) + lu(k,1642) = lu(k,1642) - lu(k,673) * lu(k,1634) + lu(k,1645) = lu(k,1645) - lu(k,674) * lu(k,1634) + lu(k,1646) = lu(k,1646) - lu(k,675) * lu(k,1634) + lu(k,1647) = lu(k,1647) - lu(k,676) * lu(k,1634) + lu(k,1648) = lu(k,1648) - lu(k,677) * lu(k,1634) + lu(k,1649) = lu(k,1649) - lu(k,678) * lu(k,1634) + lu(k,1650) = lu(k,1650) - lu(k,679) * lu(k,1634) + lu(k,1651) = lu(k,1651) - lu(k,680) * lu(k,1634) + lu(k,1655) = lu(k,1655) - lu(k,681) * lu(k,1634) + lu(k,1656) = lu(k,1656) - lu(k,682) * lu(k,1634) + lu(k,1657) = lu(k,1657) - lu(k,683) * lu(k,1634) + lu(k,1659) = lu(k,1659) - lu(k,684) * lu(k,1634) + lu(k,1660) = lu(k,1660) - lu(k,685) * lu(k,1634) + lu(k,1664) = lu(k,1664) - lu(k,686) * lu(k,1634) + lu(k,1666) = lu(k,1666) - lu(k,687) * lu(k,1634) + lu(k,1678) = lu(k,1678) - lu(k,670) * lu(k,1677) + lu(k,1681) = lu(k,1681) - lu(k,671) * lu(k,1677) + lu(k,1683) = lu(k,1683) - lu(k,672) * lu(k,1677) + lu(k,1685) = lu(k,1685) - lu(k,673) * lu(k,1677) + lu(k,1688) = lu(k,1688) - lu(k,674) * lu(k,1677) + lu(k,1689) = lu(k,1689) - lu(k,675) * lu(k,1677) + lu(k,1690) = lu(k,1690) - lu(k,676) * lu(k,1677) + lu(k,1691) = lu(k,1691) - lu(k,677) * lu(k,1677) + lu(k,1692) = lu(k,1692) - lu(k,678) * lu(k,1677) + lu(k,1693) = lu(k,1693) - lu(k,679) * lu(k,1677) + lu(k,1694) = lu(k,1694) - lu(k,680) * lu(k,1677) + lu(k,1698) = lu(k,1698) - lu(k,681) * lu(k,1677) + lu(k,1699) = lu(k,1699) - lu(k,682) * lu(k,1677) + lu(k,1700) = lu(k,1700) - lu(k,683) * lu(k,1677) + lu(k,1702) = lu(k,1702) - lu(k,684) * lu(k,1677) + lu(k,1703) = lu(k,1703) - lu(k,685) * lu(k,1677) + lu(k,1707) = lu(k,1707) - lu(k,686) * lu(k,1677) + lu(k,1709) = lu(k,1709) - lu(k,687) * lu(k,1677) + lu(k,1800) = lu(k,1800) - lu(k,670) * lu(k,1799) + lu(k,1805) = lu(k,1805) - lu(k,671) * lu(k,1799) + lu(k,1807) = lu(k,1807) - lu(k,672) * lu(k,1799) + lu(k,1809) = lu(k,1809) - lu(k,673) * lu(k,1799) + lu(k,1812) = lu(k,1812) - lu(k,674) * lu(k,1799) + lu(k,1813) = lu(k,1813) - lu(k,675) * lu(k,1799) + lu(k,1814) = lu(k,1814) - lu(k,676) * lu(k,1799) + lu(k,1815) = lu(k,1815) - lu(k,677) * lu(k,1799) + lu(k,1816) = lu(k,1816) - lu(k,678) * lu(k,1799) + lu(k,1817) = lu(k,1817) - lu(k,679) * lu(k,1799) + lu(k,1818) = lu(k,1818) - lu(k,680) * lu(k,1799) + lu(k,1822) = lu(k,1822) - lu(k,681) * lu(k,1799) + lu(k,1823) = lu(k,1823) - lu(k,682) * lu(k,1799) + lu(k,1824) = lu(k,1824) - lu(k,683) * lu(k,1799) + lu(k,1826) = lu(k,1826) - lu(k,684) * lu(k,1799) + lu(k,1827) = lu(k,1827) - lu(k,685) * lu(k,1799) + lu(k,1831) = lu(k,1831) - lu(k,686) * lu(k,1799) + lu(k,1833) = lu(k,1833) - lu(k,687) * lu(k,1799) + lu(k,1952) = - lu(k,670) * lu(k,1951) + lu(k,1957) = lu(k,1957) - lu(k,671) * lu(k,1951) + lu(k,1959) = lu(k,1959) - lu(k,672) * lu(k,1951) + lu(k,1961) = lu(k,1961) - lu(k,673) * lu(k,1951) + lu(k,1964) = lu(k,1964) - lu(k,674) * lu(k,1951) + lu(k,1965) = lu(k,1965) - lu(k,675) * lu(k,1951) + lu(k,1966) = lu(k,1966) - lu(k,676) * lu(k,1951) + lu(k,1967) = lu(k,1967) - lu(k,677) * lu(k,1951) + lu(k,1968) = lu(k,1968) - lu(k,678) * lu(k,1951) + lu(k,1969) = lu(k,1969) - lu(k,679) * lu(k,1951) + lu(k,1970) = lu(k,1970) - lu(k,680) * lu(k,1951) + lu(k,1974) = lu(k,1974) - lu(k,681) * lu(k,1951) + lu(k,1975) = lu(k,1975) - lu(k,682) * lu(k,1951) + lu(k,1976) = lu(k,1976) - lu(k,683) * lu(k,1951) + lu(k,1978) = lu(k,1978) - lu(k,684) * lu(k,1951) + lu(k,1979) = lu(k,1979) - lu(k,685) * lu(k,1951) + lu(k,1983) = lu(k,1983) - lu(k,686) * lu(k,1951) + lu(k,1985) = lu(k,1985) - lu(k,687) * lu(k,1951) + lu(k,2057) = lu(k,2057) - lu(k,670) * lu(k,2056) + lu(k,2062) = lu(k,2062) - lu(k,671) * lu(k,2056) + lu(k,2064) = lu(k,2064) - lu(k,672) * lu(k,2056) + lu(k,2066) = lu(k,2066) - lu(k,673) * lu(k,2056) + lu(k,2069) = lu(k,2069) - lu(k,674) * lu(k,2056) + lu(k,2070) = lu(k,2070) - lu(k,675) * lu(k,2056) + lu(k,2071) = lu(k,2071) - lu(k,676) * lu(k,2056) + lu(k,2072) = lu(k,2072) - lu(k,677) * lu(k,2056) + lu(k,2073) = lu(k,2073) - lu(k,678) * lu(k,2056) + lu(k,2074) = lu(k,2074) - lu(k,679) * lu(k,2056) + lu(k,2075) = lu(k,2075) - lu(k,680) * lu(k,2056) + lu(k,2079) = lu(k,2079) - lu(k,681) * lu(k,2056) + lu(k,2080) = lu(k,2080) - lu(k,682) * lu(k,2056) + lu(k,2081) = lu(k,2081) - lu(k,683) * lu(k,2056) + lu(k,2083) = lu(k,2083) - lu(k,684) * lu(k,2056) + lu(k,2084) = lu(k,2084) - lu(k,685) * lu(k,2056) + lu(k,2088) = lu(k,2088) - lu(k,686) * lu(k,2056) + lu(k,2090) = lu(k,2090) - lu(k,687) * lu(k,2056) + lu(k,691) = 1._r8 / lu(k,691) + lu(k,692) = lu(k,692) * lu(k,691) + lu(k,693) = lu(k,693) * lu(k,691) + lu(k,694) = lu(k,694) * lu(k,691) + lu(k,695) = lu(k,695) * lu(k,691) + lu(k,696) = lu(k,696) * lu(k,691) + lu(k,697) = lu(k,697) * lu(k,691) + lu(k,698) = lu(k,698) * lu(k,691) + lu(k,699) = lu(k,699) * lu(k,691) + lu(k,700) = lu(k,700) * lu(k,691) + lu(k,701) = lu(k,701) * lu(k,691) + lu(k,702) = lu(k,702) * lu(k,691) + lu(k,703) = lu(k,703) * lu(k,691) + lu(k,704) = lu(k,704) * lu(k,691) + lu(k,705) = lu(k,705) * lu(k,691) + lu(k,706) = lu(k,706) * lu(k,691) + lu(k,707) = lu(k,707) * lu(k,691) + lu(k,866) = lu(k,866) - lu(k,692) * lu(k,864) + lu(k,869) = lu(k,869) - lu(k,693) * lu(k,864) + lu(k,870) = lu(k,870) - lu(k,694) * lu(k,864) + lu(k,871) = lu(k,871) - lu(k,695) * lu(k,864) + lu(k,872) = lu(k,872) - lu(k,696) * lu(k,864) + lu(k,873) = lu(k,873) - lu(k,697) * lu(k,864) + lu(k,874) = lu(k,874) - lu(k,698) * lu(k,864) + lu(k,876) = lu(k,876) - lu(k,699) * lu(k,864) + lu(k,877) = lu(k,877) - lu(k,700) * lu(k,864) + lu(k,878) = lu(k,878) - lu(k,701) * lu(k,864) + lu(k,879) = lu(k,879) - lu(k,702) * lu(k,864) + lu(k,880) = lu(k,880) - lu(k,703) * lu(k,864) + lu(k,881) = lu(k,881) - lu(k,704) * lu(k,864) + lu(k,882) = - lu(k,705) * lu(k,864) + lu(k,884) = lu(k,884) - lu(k,706) * lu(k,864) + lu(k,886) = lu(k,886) - lu(k,707) * lu(k,864) + lu(k,1011) = lu(k,1011) - lu(k,692) * lu(k,1009) + lu(k,1017) = lu(k,1017) - lu(k,693) * lu(k,1009) + lu(k,1018) = lu(k,1018) - lu(k,694) * lu(k,1009) + lu(k,1019) = lu(k,1019) - lu(k,695) * lu(k,1009) + lu(k,1021) = lu(k,1021) - lu(k,696) * lu(k,1009) + lu(k,1022) = lu(k,1022) - lu(k,697) * lu(k,1009) + lu(k,1023) = lu(k,1023) - lu(k,698) * lu(k,1009) + lu(k,1025) = lu(k,1025) - lu(k,699) * lu(k,1009) + lu(k,1027) = lu(k,1027) - lu(k,700) * lu(k,1009) + lu(k,1028) = lu(k,1028) - lu(k,701) * lu(k,1009) + lu(k,1029) = lu(k,1029) - lu(k,702) * lu(k,1009) + lu(k,1030) = - lu(k,703) * lu(k,1009) + lu(k,1031) = lu(k,1031) - lu(k,704) * lu(k,1009) + lu(k,1032) = lu(k,1032) - lu(k,705) * lu(k,1009) + lu(k,1036) = lu(k,1036) - lu(k,706) * lu(k,1009) + lu(k,1038) = lu(k,1038) - lu(k,707) * lu(k,1009) + lu(k,1146) = lu(k,1146) - lu(k,692) * lu(k,1142) + lu(k,1153) = lu(k,1153) - lu(k,693) * lu(k,1142) + lu(k,1154) = lu(k,1154) - lu(k,694) * lu(k,1142) + lu(k,1155) = lu(k,1155) - lu(k,695) * lu(k,1142) + lu(k,1157) = lu(k,1157) - lu(k,696) * lu(k,1142) + lu(k,1158) = lu(k,1158) - lu(k,697) * lu(k,1142) + lu(k,1159) = lu(k,1159) - lu(k,698) * lu(k,1142) + lu(k,1161) = lu(k,1161) - lu(k,699) * lu(k,1142) + lu(k,1163) = lu(k,1163) - lu(k,700) * lu(k,1142) + lu(k,1164) = lu(k,1164) - lu(k,701) * lu(k,1142) + lu(k,1165) = lu(k,1165) - lu(k,702) * lu(k,1142) + lu(k,1166) = lu(k,1166) - lu(k,703) * lu(k,1142) + lu(k,1167) = lu(k,1167) - lu(k,704) * lu(k,1142) + lu(k,1168) = lu(k,1168) - lu(k,705) * lu(k,1142) + lu(k,1172) = lu(k,1172) - lu(k,706) * lu(k,1142) + lu(k,1174) = lu(k,1174) - lu(k,707) * lu(k,1142) + lu(k,1189) = lu(k,1189) - lu(k,692) * lu(k,1186) + lu(k,1196) = lu(k,1196) - lu(k,693) * lu(k,1186) + lu(k,1197) = lu(k,1197) - lu(k,694) * lu(k,1186) + lu(k,1198) = lu(k,1198) - lu(k,695) * lu(k,1186) + lu(k,1200) = lu(k,1200) - lu(k,696) * lu(k,1186) + lu(k,1201) = lu(k,1201) - lu(k,697) * lu(k,1186) + lu(k,1202) = lu(k,1202) - lu(k,698) * lu(k,1186) + lu(k,1204) = lu(k,1204) - lu(k,699) * lu(k,1186) + lu(k,1206) = lu(k,1206) - lu(k,700) * lu(k,1186) + lu(k,1207) = lu(k,1207) - lu(k,701) * lu(k,1186) + lu(k,1208) = lu(k,1208) - lu(k,702) * lu(k,1186) + lu(k,1209) = lu(k,1209) - lu(k,703) * lu(k,1186) + lu(k,1210) = lu(k,1210) - lu(k,704) * lu(k,1186) + lu(k,1211) = lu(k,1211) - lu(k,705) * lu(k,1186) + lu(k,1215) = lu(k,1215) - lu(k,706) * lu(k,1186) + lu(k,1217) = lu(k,1217) - lu(k,707) * lu(k,1186) + lu(k,1232) = lu(k,1232) - lu(k,692) * lu(k,1229) + lu(k,1239) = lu(k,1239) - lu(k,693) * lu(k,1229) + lu(k,1240) = lu(k,1240) - lu(k,694) * lu(k,1229) + lu(k,1241) = lu(k,1241) - lu(k,695) * lu(k,1229) + lu(k,1243) = lu(k,1243) - lu(k,696) * lu(k,1229) + lu(k,1244) = lu(k,1244) - lu(k,697) * lu(k,1229) + lu(k,1245) = lu(k,1245) - lu(k,698) * lu(k,1229) + lu(k,1247) = lu(k,1247) - lu(k,699) * lu(k,1229) + lu(k,1249) = lu(k,1249) - lu(k,700) * lu(k,1229) + lu(k,1250) = lu(k,1250) - lu(k,701) * lu(k,1229) + lu(k,1251) = lu(k,1251) - lu(k,702) * lu(k,1229) + lu(k,1252) = lu(k,1252) - lu(k,703) * lu(k,1229) + lu(k,1253) = lu(k,1253) - lu(k,704) * lu(k,1229) + lu(k,1254) = lu(k,1254) - lu(k,705) * lu(k,1229) + lu(k,1258) = lu(k,1258) - lu(k,706) * lu(k,1229) + lu(k,1260) = lu(k,1260) - lu(k,707) * lu(k,1229) + lu(k,1316) = lu(k,1316) - lu(k,692) * lu(k,1313) + lu(k,1323) = lu(k,1323) - lu(k,693) * lu(k,1313) + lu(k,1324) = lu(k,1324) - lu(k,694) * lu(k,1313) + lu(k,1325) = lu(k,1325) - lu(k,695) * lu(k,1313) + lu(k,1327) = lu(k,1327) - lu(k,696) * lu(k,1313) + lu(k,1328) = lu(k,1328) - lu(k,697) * lu(k,1313) + lu(k,1329) = lu(k,1329) - lu(k,698) * lu(k,1313) + lu(k,1331) = lu(k,1331) - lu(k,699) * lu(k,1313) + lu(k,1333) = lu(k,1333) - lu(k,700) * lu(k,1313) + lu(k,1334) = lu(k,1334) - lu(k,701) * lu(k,1313) + lu(k,1335) = lu(k,1335) - lu(k,702) * lu(k,1313) + lu(k,1336) = lu(k,1336) - lu(k,703) * lu(k,1313) + lu(k,1337) = lu(k,1337) - lu(k,704) * lu(k,1313) + lu(k,1338) = lu(k,1338) - lu(k,705) * lu(k,1313) + lu(k,1342) = lu(k,1342) - lu(k,706) * lu(k,1313) + lu(k,1344) = lu(k,1344) - lu(k,707) * lu(k,1313) + lu(k,1514) = lu(k,1514) - lu(k,692) * lu(k,1510) + lu(k,1521) = lu(k,1521) - lu(k,693) * lu(k,1510) + lu(k,1522) = lu(k,1522) - lu(k,694) * lu(k,1510) + lu(k,1523) = lu(k,1523) - lu(k,695) * lu(k,1510) + lu(k,1525) = lu(k,1525) - lu(k,696) * lu(k,1510) + lu(k,1526) = lu(k,1526) - lu(k,697) * lu(k,1510) + lu(k,1527) = lu(k,1527) - lu(k,698) * lu(k,1510) + lu(k,1529) = lu(k,1529) - lu(k,699) * lu(k,1510) + lu(k,1531) = lu(k,1531) - lu(k,700) * lu(k,1510) + lu(k,1532) = lu(k,1532) - lu(k,701) * lu(k,1510) + lu(k,1533) = lu(k,1533) - lu(k,702) * lu(k,1510) + lu(k,1534) = lu(k,1534) - lu(k,703) * lu(k,1510) + lu(k,1535) = lu(k,1535) - lu(k,704) * lu(k,1510) + lu(k,1536) = lu(k,1536) - lu(k,705) * lu(k,1510) + lu(k,1540) = lu(k,1540) - lu(k,706) * lu(k,1510) + lu(k,1542) = lu(k,1542) - lu(k,707) * lu(k,1510) + lu(k,1595) = lu(k,1595) - lu(k,692) * lu(k,1591) + lu(k,1602) = lu(k,1602) - lu(k,693) * lu(k,1591) + lu(k,1603) = lu(k,1603) - lu(k,694) * lu(k,1591) + lu(k,1604) = lu(k,1604) - lu(k,695) * lu(k,1591) + lu(k,1606) = lu(k,1606) - lu(k,696) * lu(k,1591) + lu(k,1607) = lu(k,1607) - lu(k,697) * lu(k,1591) + lu(k,1608) = lu(k,1608) - lu(k,698) * lu(k,1591) + lu(k,1610) = lu(k,1610) - lu(k,699) * lu(k,1591) + lu(k,1612) = lu(k,1612) - lu(k,700) * lu(k,1591) + lu(k,1613) = lu(k,1613) - lu(k,701) * lu(k,1591) + lu(k,1614) = lu(k,1614) - lu(k,702) * lu(k,1591) + lu(k,1615) = lu(k,1615) - lu(k,703) * lu(k,1591) + lu(k,1616) = lu(k,1616) - lu(k,704) * lu(k,1591) + lu(k,1617) = lu(k,1617) - lu(k,705) * lu(k,1591) + lu(k,1621) = lu(k,1621) - lu(k,706) * lu(k,1591) + lu(k,1623) = lu(k,1623) - lu(k,707) * lu(k,1591) + lu(k,1638) = lu(k,1638) - lu(k,692) * lu(k,1635) + lu(k,1645) = lu(k,1645) - lu(k,693) * lu(k,1635) + lu(k,1646) = lu(k,1646) - lu(k,694) * lu(k,1635) + lu(k,1647) = lu(k,1647) - lu(k,695) * lu(k,1635) + lu(k,1649) = lu(k,1649) - lu(k,696) * lu(k,1635) + lu(k,1650) = lu(k,1650) - lu(k,697) * lu(k,1635) + lu(k,1651) = lu(k,1651) - lu(k,698) * lu(k,1635) + lu(k,1653) = lu(k,1653) - lu(k,699) * lu(k,1635) + lu(k,1655) = lu(k,1655) - lu(k,700) * lu(k,1635) + lu(k,1656) = lu(k,1656) - lu(k,701) * lu(k,1635) + lu(k,1657) = lu(k,1657) - lu(k,702) * lu(k,1635) + lu(k,1658) = lu(k,1658) - lu(k,703) * lu(k,1635) + lu(k,1659) = lu(k,1659) - lu(k,704) * lu(k,1635) + lu(k,1660) = lu(k,1660) - lu(k,705) * lu(k,1635) + lu(k,1664) = lu(k,1664) - lu(k,706) * lu(k,1635) + lu(k,1666) = lu(k,1666) - lu(k,707) * lu(k,1635) + lu(k,1681) = lu(k,1681) - lu(k,692) * lu(k,1678) + lu(k,1688) = lu(k,1688) - lu(k,693) * lu(k,1678) + lu(k,1689) = lu(k,1689) - lu(k,694) * lu(k,1678) + lu(k,1690) = lu(k,1690) - lu(k,695) * lu(k,1678) + lu(k,1692) = lu(k,1692) - lu(k,696) * lu(k,1678) + lu(k,1693) = lu(k,1693) - lu(k,697) * lu(k,1678) + lu(k,1694) = lu(k,1694) - lu(k,698) * lu(k,1678) + lu(k,1696) = lu(k,1696) - lu(k,699) * lu(k,1678) + lu(k,1698) = lu(k,1698) - lu(k,700) * lu(k,1678) + lu(k,1699) = lu(k,1699) - lu(k,701) * lu(k,1678) + lu(k,1700) = lu(k,1700) - lu(k,702) * lu(k,1678) + lu(k,1701) = lu(k,1701) - lu(k,703) * lu(k,1678) + lu(k,1702) = lu(k,1702) - lu(k,704) * lu(k,1678) + lu(k,1703) = lu(k,1703) - lu(k,705) * lu(k,1678) + lu(k,1707) = lu(k,1707) - lu(k,706) * lu(k,1678) + lu(k,1709) = lu(k,1709) - lu(k,707) * lu(k,1678) + lu(k,1722) = lu(k,1722) - lu(k,692) * lu(k,1718) + lu(k,1728) = lu(k,1728) - lu(k,693) * lu(k,1718) + lu(k,1729) = lu(k,1729) - lu(k,694) * lu(k,1718) + lu(k,1730) = lu(k,1730) - lu(k,695) * lu(k,1718) + lu(k,1732) = lu(k,1732) - lu(k,696) * lu(k,1718) + lu(k,1733) = lu(k,1733) - lu(k,697) * lu(k,1718) + lu(k,1734) = lu(k,1734) - lu(k,698) * lu(k,1718) + lu(k,1736) = lu(k,1736) - lu(k,699) * lu(k,1718) + lu(k,1738) = lu(k,1738) - lu(k,700) * lu(k,1718) + lu(k,1739) = lu(k,1739) - lu(k,701) * lu(k,1718) + lu(k,1740) = lu(k,1740) - lu(k,702) * lu(k,1718) + lu(k,1741) = lu(k,1741) - lu(k,703) * lu(k,1718) + lu(k,1742) = lu(k,1742) - lu(k,704) * lu(k,1718) + lu(k,1743) = lu(k,1743) - lu(k,705) * lu(k,1718) + lu(k,1747) = lu(k,1747) - lu(k,706) * lu(k,1718) + lu(k,1749) = lu(k,1749) - lu(k,707) * lu(k,1718) + lu(k,1805) = lu(k,1805) - lu(k,692) * lu(k,1800) + lu(k,1812) = lu(k,1812) - lu(k,693) * lu(k,1800) + lu(k,1813) = lu(k,1813) - lu(k,694) * lu(k,1800) + lu(k,1814) = lu(k,1814) - lu(k,695) * lu(k,1800) + lu(k,1816) = lu(k,1816) - lu(k,696) * lu(k,1800) + lu(k,1817) = lu(k,1817) - lu(k,697) * lu(k,1800) + lu(k,1818) = lu(k,1818) - lu(k,698) * lu(k,1800) + lu(k,1820) = lu(k,1820) - lu(k,699) * lu(k,1800) + lu(k,1822) = lu(k,1822) - lu(k,700) * lu(k,1800) + lu(k,1823) = lu(k,1823) - lu(k,701) * lu(k,1800) + lu(k,1824) = lu(k,1824) - lu(k,702) * lu(k,1800) + lu(k,1825) = lu(k,1825) - lu(k,703) * lu(k,1800) + lu(k,1826) = lu(k,1826) - lu(k,704) * lu(k,1800) + lu(k,1827) = lu(k,1827) - lu(k,705) * lu(k,1800) + lu(k,1831) = lu(k,1831) - lu(k,706) * lu(k,1800) + lu(k,1833) = lu(k,1833) - lu(k,707) * lu(k,1800) + lu(k,1957) = lu(k,1957) - lu(k,692) * lu(k,1952) + lu(k,1964) = lu(k,1964) - lu(k,693) * lu(k,1952) + lu(k,1965) = lu(k,1965) - lu(k,694) * lu(k,1952) + lu(k,1966) = lu(k,1966) - lu(k,695) * lu(k,1952) + lu(k,1968) = lu(k,1968) - lu(k,696) * lu(k,1952) + lu(k,1969) = lu(k,1969) - lu(k,697) * lu(k,1952) + lu(k,1970) = lu(k,1970) - lu(k,698) * lu(k,1952) + lu(k,1972) = - lu(k,699) * lu(k,1952) + lu(k,1974) = lu(k,1974) - lu(k,700) * lu(k,1952) + lu(k,1975) = lu(k,1975) - lu(k,701) * lu(k,1952) + lu(k,1976) = lu(k,1976) - lu(k,702) * lu(k,1952) + lu(k,1977) = lu(k,1977) - lu(k,703) * lu(k,1952) + lu(k,1978) = lu(k,1978) - lu(k,704) * lu(k,1952) + lu(k,1979) = lu(k,1979) - lu(k,705) * lu(k,1952) + lu(k,1983) = lu(k,1983) - lu(k,706) * lu(k,1952) + lu(k,1985) = lu(k,1985) - lu(k,707) * lu(k,1952) + lu(k,2062) = lu(k,2062) - lu(k,692) * lu(k,2057) + lu(k,2069) = lu(k,2069) - lu(k,693) * lu(k,2057) + lu(k,2070) = lu(k,2070) - lu(k,694) * lu(k,2057) + lu(k,2071) = lu(k,2071) - lu(k,695) * lu(k,2057) + lu(k,2073) = lu(k,2073) - lu(k,696) * lu(k,2057) + lu(k,2074) = lu(k,2074) - lu(k,697) * lu(k,2057) + lu(k,2075) = lu(k,2075) - lu(k,698) * lu(k,2057) + lu(k,2077) = lu(k,2077) - lu(k,699) * lu(k,2057) + lu(k,2079) = lu(k,2079) - lu(k,700) * lu(k,2057) + lu(k,2080) = lu(k,2080) - lu(k,701) * lu(k,2057) + lu(k,2081) = lu(k,2081) - lu(k,702) * lu(k,2057) + lu(k,2082) = lu(k,2082) - lu(k,703) * lu(k,2057) + lu(k,2083) = lu(k,2083) - lu(k,704) * lu(k,2057) + lu(k,2084) = lu(k,2084) - lu(k,705) * lu(k,2057) + lu(k,2088) = lu(k,2088) - lu(k,706) * lu(k,2057) + lu(k,2090) = lu(k,2090) - lu(k,707) * lu(k,2057) + 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,730) = lu(k,730) * lu(k,715) + lu(k,731) = lu(k,731) * lu(k,715) + lu(k,732) = lu(k,732) * lu(k,715) + lu(k,738) = lu(k,738) - lu(k,716) * lu(k,737) + lu(k,739) = lu(k,739) - lu(k,717) * lu(k,737) + lu(k,740) = lu(k,740) - lu(k,718) * lu(k,737) + lu(k,741) = lu(k,741) - lu(k,719) * lu(k,737) + lu(k,743) = lu(k,743) - lu(k,720) * lu(k,737) + lu(k,744) = lu(k,744) - lu(k,721) * lu(k,737) + lu(k,745) = lu(k,745) - lu(k,722) * lu(k,737) + lu(k,746) = lu(k,746) - lu(k,723) * lu(k,737) + lu(k,747) = lu(k,747) - lu(k,724) * lu(k,737) + lu(k,748) = lu(k,748) - lu(k,725) * lu(k,737) + lu(k,749) = lu(k,749) - lu(k,726) * lu(k,737) + lu(k,750) = lu(k,750) - lu(k,727) * lu(k,737) + lu(k,751) = lu(k,751) - lu(k,728) * lu(k,737) + lu(k,754) = lu(k,754) - lu(k,729) * lu(k,737) + lu(k,755) = lu(k,755) - lu(k,730) * lu(k,737) + lu(k,756) = lu(k,756) - lu(k,731) * lu(k,737) + lu(k,757) = lu(k,757) - lu(k,732) * lu(k,737) + lu(k,786) = lu(k,786) - lu(k,716) * lu(k,785) + lu(k,787) = lu(k,787) - lu(k,717) * lu(k,785) + lu(k,788) = lu(k,788) - lu(k,718) * lu(k,785) + lu(k,789) = lu(k,789) - lu(k,719) * lu(k,785) + lu(k,791) = lu(k,791) - lu(k,720) * lu(k,785) + lu(k,793) = lu(k,793) - lu(k,721) * lu(k,785) + lu(k,794) = lu(k,794) - lu(k,722) * lu(k,785) + lu(k,795) = lu(k,795) - lu(k,723) * lu(k,785) + lu(k,796) = lu(k,796) - lu(k,724) * lu(k,785) + lu(k,797) = lu(k,797) - lu(k,725) * lu(k,785) + lu(k,800) = lu(k,800) - lu(k,726) * lu(k,785) + lu(k,801) = lu(k,801) - lu(k,727) * lu(k,785) + lu(k,802) = lu(k,802) - lu(k,728) * lu(k,785) + lu(k,805) = lu(k,805) - lu(k,729) * lu(k,785) + lu(k,806) = lu(k,806) - lu(k,730) * lu(k,785) + lu(k,807) = lu(k,807) - lu(k,731) * lu(k,785) + lu(k,808) = lu(k,808) - lu(k,732) * lu(k,785) + lu(k,898) = lu(k,898) - lu(k,716) * lu(k,897) + lu(k,899) = lu(k,899) - lu(k,717) * lu(k,897) + lu(k,900) = lu(k,900) - lu(k,718) * lu(k,897) + lu(k,901) = lu(k,901) - lu(k,719) * lu(k,897) + lu(k,903) = lu(k,903) - lu(k,720) * lu(k,897) + lu(k,905) = lu(k,905) - lu(k,721) * lu(k,897) + lu(k,907) = lu(k,907) - lu(k,722) * lu(k,897) + lu(k,908) = lu(k,908) - lu(k,723) * lu(k,897) + lu(k,909) = lu(k,909) - lu(k,724) * lu(k,897) + lu(k,910) = lu(k,910) - lu(k,725) * lu(k,897) + lu(k,913) = lu(k,913) - lu(k,726) * lu(k,897) + lu(k,914) = lu(k,914) - lu(k,727) * lu(k,897) + lu(k,915) = lu(k,915) - lu(k,728) * lu(k,897) + lu(k,918) = lu(k,918) - lu(k,729) * lu(k,897) + lu(k,919) = lu(k,919) - lu(k,730) * lu(k,897) + lu(k,920) = lu(k,920) - lu(k,731) * lu(k,897) + lu(k,921) = lu(k,921) - lu(k,732) * lu(k,897) + lu(k,981) = lu(k,981) - lu(k,716) * lu(k,980) + lu(k,982) = lu(k,982) - lu(k,717) * lu(k,980) + lu(k,983) = lu(k,983) - lu(k,718) * lu(k,980) + lu(k,984) = lu(k,984) - lu(k,719) * lu(k,980) + lu(k,986) = lu(k,986) - lu(k,720) * lu(k,980) + lu(k,989) = lu(k,989) - lu(k,721) * lu(k,980) + lu(k,991) = lu(k,991) - lu(k,722) * lu(k,980) + lu(k,992) = lu(k,992) - lu(k,723) * lu(k,980) + lu(k,993) = lu(k,993) - lu(k,724) * lu(k,980) + lu(k,994) = lu(k,994) - lu(k,725) * lu(k,980) + lu(k,997) = lu(k,997) - lu(k,726) * lu(k,980) + lu(k,998) = lu(k,998) - lu(k,727) * lu(k,980) + lu(k,999) = lu(k,999) - lu(k,728) * lu(k,980) + lu(k,1002) = lu(k,1002) - lu(k,729) * lu(k,980) + lu(k,1003) = lu(k,1003) - lu(k,730) * lu(k,980) + lu(k,1004) = lu(k,1004) - lu(k,731) * lu(k,980) + lu(k,1005) = lu(k,1005) - lu(k,732) * lu(k,980) + lu(k,1094) = lu(k,1094) - lu(k,716) * lu(k,1093) + lu(k,1095) = lu(k,1095) - lu(k,717) * lu(k,1093) + lu(k,1099) = lu(k,1099) - lu(k,718) * lu(k,1093) + lu(k,1101) = lu(k,1101) - lu(k,719) * lu(k,1093) + lu(k,1104) = lu(k,1104) - lu(k,720) * lu(k,1093) + lu(k,1108) = lu(k,1108) - lu(k,721) * lu(k,1093) + lu(k,1110) = lu(k,1110) - lu(k,722) * lu(k,1093) + lu(k,1111) = lu(k,1111) - lu(k,723) * lu(k,1093) + lu(k,1112) = lu(k,1112) - lu(k,724) * lu(k,1093) + lu(k,1113) = lu(k,1113) - lu(k,725) * lu(k,1093) + lu(k,1118) = lu(k,1118) - lu(k,726) * lu(k,1093) + lu(k,1119) = lu(k,1119) - lu(k,727) * lu(k,1093) + lu(k,1120) = lu(k,1120) - lu(k,728) * lu(k,1093) + lu(k,1123) = lu(k,1123) - lu(k,729) * lu(k,1093) + lu(k,1124) = lu(k,1124) - lu(k,730) * lu(k,1093) + lu(k,1125) = lu(k,1125) - lu(k,731) * lu(k,1093) + lu(k,1126) = lu(k,1126) - lu(k,732) * lu(k,1093) + lu(k,1372) = lu(k,1372) - lu(k,716) * lu(k,1371) + lu(k,1373) = lu(k,1373) - lu(k,717) * lu(k,1371) + lu(k,1377) = lu(k,1377) - lu(k,718) * lu(k,1371) + lu(k,1379) = lu(k,1379) - lu(k,719) * lu(k,1371) + lu(k,1382) = lu(k,1382) - lu(k,720) * lu(k,1371) + lu(k,1386) = lu(k,1386) - lu(k,721) * lu(k,1371) + lu(k,1388) = lu(k,1388) - lu(k,722) * lu(k,1371) + lu(k,1389) = lu(k,1389) - lu(k,723) * lu(k,1371) + lu(k,1390) = lu(k,1390) - lu(k,724) * lu(k,1371) + lu(k,1391) = lu(k,1391) - lu(k,725) * lu(k,1371) + lu(k,1396) = lu(k,1396) - lu(k,726) * lu(k,1371) + lu(k,1397) = lu(k,1397) - lu(k,727) * lu(k,1371) + lu(k,1398) = lu(k,1398) - lu(k,728) * lu(k,1371) + lu(k,1401) = lu(k,1401) - lu(k,729) * lu(k,1371) + lu(k,1402) = lu(k,1402) - lu(k,730) * lu(k,1371) + lu(k,1403) = lu(k,1403) - lu(k,731) * lu(k,1371) + lu(k,1404) = lu(k,1404) - lu(k,732) * lu(k,1371) + lu(k,1422) = lu(k,1422) - lu(k,716) * lu(k,1421) + lu(k,1423) = lu(k,1423) - lu(k,717) * lu(k,1421) + lu(k,1426) = lu(k,1426) - lu(k,718) * lu(k,1421) + lu(k,1428) = lu(k,1428) - lu(k,719) * lu(k,1421) + lu(k,1431) = lu(k,1431) - lu(k,720) * lu(k,1421) + lu(k,1435) = lu(k,1435) - lu(k,721) * lu(k,1421) + lu(k,1437) = lu(k,1437) - lu(k,722) * lu(k,1421) + lu(k,1438) = lu(k,1438) - lu(k,723) * lu(k,1421) + lu(k,1439) = lu(k,1439) - lu(k,724) * lu(k,1421) + lu(k,1440) = - lu(k,725) * lu(k,1421) + lu(k,1445) = - lu(k,726) * lu(k,1421) + lu(k,1446) = lu(k,1446) - lu(k,727) * lu(k,1421) + lu(k,1447) = lu(k,1447) - lu(k,728) * lu(k,1421) + lu(k,1450) = lu(k,1450) - lu(k,729) * lu(k,1421) + lu(k,1451) = lu(k,1451) - lu(k,730) * lu(k,1421) + lu(k,1452) = - lu(k,731) * lu(k,1421) + lu(k,1453) = lu(k,1453) - lu(k,732) * lu(k,1421) + lu(k,1469) = lu(k,1469) - lu(k,716) * lu(k,1468) + lu(k,1470) = lu(k,1470) - lu(k,717) * lu(k,1468) + lu(k,1474) = lu(k,1474) - lu(k,718) * lu(k,1468) + lu(k,1476) = lu(k,1476) - lu(k,719) * lu(k,1468) + lu(k,1479) = lu(k,1479) - lu(k,720) * lu(k,1468) + lu(k,1483) = lu(k,1483) - lu(k,721) * lu(k,1468) + lu(k,1485) = lu(k,1485) - lu(k,722) * lu(k,1468) + lu(k,1486) = lu(k,1486) - lu(k,723) * lu(k,1468) + lu(k,1487) = lu(k,1487) - lu(k,724) * lu(k,1468) + lu(k,1488) = lu(k,1488) - lu(k,725) * lu(k,1468) + lu(k,1493) = lu(k,1493) - lu(k,726) * lu(k,1468) + lu(k,1494) = lu(k,1494) - lu(k,727) * lu(k,1468) + lu(k,1495) = lu(k,1495) - lu(k,728) * lu(k,1468) + lu(k,1498) = lu(k,1498) - lu(k,729) * lu(k,1468) + lu(k,1499) = lu(k,1499) - lu(k,730) * lu(k,1468) + lu(k,1500) = lu(k,1500) - lu(k,731) * lu(k,1468) + lu(k,1501) = lu(k,1501) - lu(k,732) * lu(k,1468) + lu(k,1720) = lu(k,1720) - lu(k,716) * lu(k,1719) + lu(k,1721) = lu(k,1721) - lu(k,717) * lu(k,1719) + lu(k,1723) = lu(k,1723) - lu(k,718) * lu(k,1719) + lu(k,1725) = lu(k,1725) - lu(k,719) * lu(k,1719) + lu(k,1727) = lu(k,1727) - lu(k,720) * lu(k,1719) + lu(k,1731) = lu(k,1731) - lu(k,721) * lu(k,1719) + lu(k,1733) = lu(k,1733) - lu(k,722) * lu(k,1719) + lu(k,1734) = lu(k,1734) - lu(k,723) * lu(k,1719) + lu(k,1735) = lu(k,1735) - lu(k,724) * lu(k,1719) + lu(k,1736) = lu(k,1736) - lu(k,725) * lu(k,1719) + lu(k,1741) = lu(k,1741) - lu(k,726) * lu(k,1719) + lu(k,1742) = lu(k,1742) - lu(k,727) * lu(k,1719) + lu(k,1743) = lu(k,1743) - lu(k,728) * lu(k,1719) + lu(k,1746) = lu(k,1746) - lu(k,729) * lu(k,1719) + lu(k,1747) = lu(k,1747) - lu(k,730) * lu(k,1719) + lu(k,1748) = - lu(k,731) * lu(k,1719) + lu(k,1749) = lu(k,1749) - lu(k,732) * lu(k,1719) + lu(k,1802) = lu(k,1802) - lu(k,716) * lu(k,1801) + lu(k,1803) = lu(k,1803) - lu(k,717) * lu(k,1801) + lu(k,1806) = lu(k,1806) - lu(k,718) * lu(k,1801) + lu(k,1808) = lu(k,1808) - lu(k,719) * lu(k,1801) + lu(k,1811) = lu(k,1811) - lu(k,720) * lu(k,1801) + lu(k,1815) = lu(k,1815) - lu(k,721) * lu(k,1801) + lu(k,1817) = lu(k,1817) - lu(k,722) * lu(k,1801) + lu(k,1818) = lu(k,1818) - lu(k,723) * lu(k,1801) + lu(k,1819) = lu(k,1819) - lu(k,724) * lu(k,1801) + lu(k,1820) = lu(k,1820) - lu(k,725) * lu(k,1801) + lu(k,1825) = lu(k,1825) - lu(k,726) * lu(k,1801) + lu(k,1826) = lu(k,1826) - lu(k,727) * lu(k,1801) + lu(k,1827) = lu(k,1827) - lu(k,728) * lu(k,1801) + lu(k,1830) = lu(k,1830) - lu(k,729) * lu(k,1801) + lu(k,1831) = lu(k,1831) - lu(k,730) * lu(k,1801) + lu(k,1832) = lu(k,1832) - lu(k,731) * lu(k,1801) + lu(k,1833) = lu(k,1833) - lu(k,732) * lu(k,1801) + lu(k,1912) = lu(k,1912) - lu(k,716) * lu(k,1911) + lu(k,1913) = lu(k,1913) - lu(k,717) * lu(k,1911) + lu(k,1916) = lu(k,1916) - lu(k,718) * lu(k,1911) + lu(k,1918) = lu(k,1918) - lu(k,719) * lu(k,1911) + lu(k,1921) = lu(k,1921) - lu(k,720) * lu(k,1911) + lu(k,1925) = lu(k,1925) - lu(k,721) * lu(k,1911) + lu(k,1927) = lu(k,1927) - lu(k,722) * lu(k,1911) + lu(k,1928) = lu(k,1928) - lu(k,723) * lu(k,1911) + lu(k,1929) = lu(k,1929) - lu(k,724) * lu(k,1911) + lu(k,1930) = - lu(k,725) * lu(k,1911) + lu(k,1935) = lu(k,1935) - lu(k,726) * lu(k,1911) + lu(k,1936) = lu(k,1936) - lu(k,727) * lu(k,1911) + lu(k,1937) = lu(k,1937) - lu(k,728) * lu(k,1911) + lu(k,1940) = lu(k,1940) - lu(k,729) * lu(k,1911) + lu(k,1941) = lu(k,1941) - lu(k,730) * lu(k,1911) + lu(k,1942) = - lu(k,731) * lu(k,1911) + lu(k,1943) = lu(k,1943) - lu(k,732) * lu(k,1911) + lu(k,1954) = lu(k,1954) - lu(k,716) * lu(k,1953) + lu(k,1955) = lu(k,1955) - lu(k,717) * lu(k,1953) + lu(k,1958) = lu(k,1958) - lu(k,718) * lu(k,1953) + lu(k,1960) = lu(k,1960) - lu(k,719) * lu(k,1953) + lu(k,1963) = lu(k,1963) - lu(k,720) * lu(k,1953) + lu(k,1967) = lu(k,1967) - lu(k,721) * lu(k,1953) + lu(k,1969) = lu(k,1969) - lu(k,722) * lu(k,1953) + lu(k,1970) = lu(k,1970) - lu(k,723) * lu(k,1953) + lu(k,1971) = lu(k,1971) - lu(k,724) * lu(k,1953) + lu(k,1972) = lu(k,1972) - lu(k,725) * lu(k,1953) + lu(k,1977) = lu(k,1977) - lu(k,726) * lu(k,1953) + lu(k,1978) = lu(k,1978) - lu(k,727) * lu(k,1953) + lu(k,1979) = lu(k,1979) - lu(k,728) * lu(k,1953) + lu(k,1982) = lu(k,1982) - lu(k,729) * lu(k,1953) + lu(k,1983) = lu(k,1983) - lu(k,730) * lu(k,1953) + lu(k,1984) = - lu(k,731) * lu(k,1953) + lu(k,1985) = lu(k,1985) - lu(k,732) * lu(k,1953) + lu(k,1998) = lu(k,1998) - lu(k,716) * lu(k,1997) + lu(k,1999) = lu(k,1999) - lu(k,717) * lu(k,1997) + lu(k,2003) = lu(k,2003) - lu(k,718) * lu(k,1997) + lu(k,2005) = lu(k,2005) - lu(k,719) * lu(k,1997) + lu(k,2008) = lu(k,2008) - lu(k,720) * lu(k,1997) + lu(k,2012) = lu(k,2012) - lu(k,721) * lu(k,1997) + lu(k,2014) = lu(k,2014) - lu(k,722) * lu(k,1997) + lu(k,2015) = lu(k,2015) - lu(k,723) * lu(k,1997) + lu(k,2016) = lu(k,2016) - lu(k,724) * lu(k,1997) + lu(k,2017) = lu(k,2017) - lu(k,725) * lu(k,1997) + lu(k,2022) = lu(k,2022) - lu(k,726) * lu(k,1997) + lu(k,2023) = lu(k,2023) - lu(k,727) * lu(k,1997) + lu(k,2024) = lu(k,2024) - lu(k,728) * lu(k,1997) + lu(k,2027) = lu(k,2027) - lu(k,729) * lu(k,1997) + lu(k,2028) = lu(k,2028) - lu(k,730) * lu(k,1997) + lu(k,2029) = lu(k,2029) - lu(k,731) * lu(k,1997) + lu(k,2030) = lu(k,2030) - lu(k,732) * lu(k,1997) + lu(k,2059) = lu(k,2059) - lu(k,716) * lu(k,2058) + lu(k,2060) = lu(k,2060) - lu(k,717) * lu(k,2058) + lu(k,2063) = lu(k,2063) - lu(k,718) * lu(k,2058) + lu(k,2065) = lu(k,2065) - lu(k,719) * lu(k,2058) + lu(k,2068) = lu(k,2068) - lu(k,720) * lu(k,2058) + lu(k,2072) = lu(k,2072) - lu(k,721) * lu(k,2058) + lu(k,2074) = lu(k,2074) - lu(k,722) * lu(k,2058) + lu(k,2075) = lu(k,2075) - lu(k,723) * lu(k,2058) + lu(k,2076) = lu(k,2076) - lu(k,724) * lu(k,2058) + lu(k,2077) = lu(k,2077) - lu(k,725) * lu(k,2058) + lu(k,2082) = lu(k,2082) - lu(k,726) * lu(k,2058) + lu(k,2083) = lu(k,2083) - lu(k,727) * lu(k,2058) + lu(k,2084) = lu(k,2084) - lu(k,728) * lu(k,2058) + lu(k,2087) = lu(k,2087) - lu(k,729) * lu(k,2058) + lu(k,2088) = lu(k,2088) - lu(k,730) * lu(k,2058) + lu(k,2089) = lu(k,2089) - lu(k,731) * lu(k,2058) + lu(k,2090) = lu(k,2090) - lu(k,732) * lu(k,2058) + 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,738) = 1._r8 / lu(k,738) + lu(k,739) = lu(k,739) * lu(k,738) + lu(k,740) = lu(k,740) * lu(k,738) + lu(k,741) = lu(k,741) * lu(k,738) + lu(k,742) = lu(k,742) * lu(k,738) + lu(k,743) = lu(k,743) * lu(k,738) + lu(k,744) = lu(k,744) * lu(k,738) + lu(k,745) = lu(k,745) * lu(k,738) + lu(k,746) = lu(k,746) * lu(k,738) + lu(k,747) = lu(k,747) * lu(k,738) + lu(k,748) = lu(k,748) * lu(k,738) + lu(k,749) = lu(k,749) * lu(k,738) + lu(k,750) = lu(k,750) * lu(k,738) + lu(k,751) = lu(k,751) * lu(k,738) + lu(k,752) = lu(k,752) * lu(k,738) + lu(k,753) = lu(k,753) * lu(k,738) + lu(k,754) = lu(k,754) * lu(k,738) + lu(k,755) = lu(k,755) * lu(k,738) + lu(k,756) = lu(k,756) * lu(k,738) + lu(k,757) = lu(k,757) * lu(k,738) + lu(k,787) = lu(k,787) - lu(k,739) * lu(k,786) + lu(k,788) = lu(k,788) - lu(k,740) * lu(k,786) + lu(k,789) = lu(k,789) - lu(k,741) * lu(k,786) + lu(k,790) = lu(k,790) - lu(k,742) * lu(k,786) + lu(k,791) = lu(k,791) - lu(k,743) * lu(k,786) + lu(k,793) = lu(k,793) - lu(k,744) * lu(k,786) + lu(k,794) = lu(k,794) - lu(k,745) * lu(k,786) + lu(k,795) = lu(k,795) - lu(k,746) * lu(k,786) + lu(k,796) = lu(k,796) - lu(k,747) * lu(k,786) + lu(k,797) = lu(k,797) - lu(k,748) * lu(k,786) + lu(k,800) = lu(k,800) - lu(k,749) * lu(k,786) + lu(k,801) = lu(k,801) - lu(k,750) * lu(k,786) + lu(k,802) = lu(k,802) - lu(k,751) * lu(k,786) + lu(k,803) = lu(k,803) - lu(k,752) * lu(k,786) + lu(k,804) = lu(k,804) - lu(k,753) * lu(k,786) + lu(k,805) = lu(k,805) - lu(k,754) * lu(k,786) + lu(k,806) = lu(k,806) - lu(k,755) * lu(k,786) + lu(k,807) = lu(k,807) - lu(k,756) * lu(k,786) + lu(k,808) = lu(k,808) - lu(k,757) * lu(k,786) + lu(k,899) = lu(k,899) - lu(k,739) * lu(k,898) + lu(k,900) = lu(k,900) - lu(k,740) * lu(k,898) + lu(k,901) = lu(k,901) - lu(k,741) * lu(k,898) + lu(k,902) = lu(k,902) - lu(k,742) * lu(k,898) + lu(k,903) = lu(k,903) - lu(k,743) * lu(k,898) + lu(k,905) = lu(k,905) - lu(k,744) * lu(k,898) + lu(k,907) = lu(k,907) - lu(k,745) * lu(k,898) + lu(k,908) = lu(k,908) - lu(k,746) * lu(k,898) + lu(k,909) = lu(k,909) - lu(k,747) * lu(k,898) + lu(k,910) = lu(k,910) - lu(k,748) * lu(k,898) + lu(k,913) = lu(k,913) - lu(k,749) * lu(k,898) + lu(k,914) = lu(k,914) - lu(k,750) * lu(k,898) + lu(k,915) = lu(k,915) - lu(k,751) * lu(k,898) + lu(k,916) = lu(k,916) - lu(k,752) * lu(k,898) + lu(k,917) = lu(k,917) - lu(k,753) * lu(k,898) + lu(k,918) = lu(k,918) - lu(k,754) * lu(k,898) + lu(k,919) = lu(k,919) - lu(k,755) * lu(k,898) + lu(k,920) = lu(k,920) - lu(k,756) * lu(k,898) + lu(k,921) = lu(k,921) - lu(k,757) * lu(k,898) + lu(k,982) = lu(k,982) - lu(k,739) * lu(k,981) + lu(k,983) = lu(k,983) - lu(k,740) * lu(k,981) + lu(k,984) = lu(k,984) - lu(k,741) * lu(k,981) + lu(k,985) = lu(k,985) - lu(k,742) * lu(k,981) + lu(k,986) = lu(k,986) - lu(k,743) * lu(k,981) + lu(k,989) = lu(k,989) - lu(k,744) * lu(k,981) + lu(k,991) = lu(k,991) - lu(k,745) * lu(k,981) + lu(k,992) = lu(k,992) - lu(k,746) * lu(k,981) + lu(k,993) = lu(k,993) - lu(k,747) * lu(k,981) + lu(k,994) = lu(k,994) - lu(k,748) * lu(k,981) + lu(k,997) = lu(k,997) - lu(k,749) * lu(k,981) + lu(k,998) = lu(k,998) - lu(k,750) * lu(k,981) + lu(k,999) = lu(k,999) - lu(k,751) * lu(k,981) + lu(k,1000) = lu(k,1000) - lu(k,752) * lu(k,981) + lu(k,1001) = lu(k,1001) - lu(k,753) * lu(k,981) + lu(k,1002) = lu(k,1002) - lu(k,754) * lu(k,981) + lu(k,1003) = lu(k,1003) - lu(k,755) * lu(k,981) + lu(k,1004) = lu(k,1004) - lu(k,756) * lu(k,981) + lu(k,1005) = lu(k,1005) - lu(k,757) * lu(k,981) + lu(k,1095) = lu(k,1095) - lu(k,739) * lu(k,1094) + lu(k,1099) = lu(k,1099) - lu(k,740) * lu(k,1094) + lu(k,1101) = lu(k,1101) - lu(k,741) * lu(k,1094) + lu(k,1103) = - lu(k,742) * lu(k,1094) + lu(k,1104) = lu(k,1104) - lu(k,743) * lu(k,1094) + lu(k,1108) = lu(k,1108) - lu(k,744) * lu(k,1094) + lu(k,1110) = lu(k,1110) - lu(k,745) * lu(k,1094) + lu(k,1111) = lu(k,1111) - lu(k,746) * lu(k,1094) + lu(k,1112) = lu(k,1112) - lu(k,747) * lu(k,1094) + lu(k,1113) = lu(k,1113) - lu(k,748) * lu(k,1094) + lu(k,1118) = lu(k,1118) - lu(k,749) * lu(k,1094) + lu(k,1119) = lu(k,1119) - lu(k,750) * lu(k,1094) + lu(k,1120) = lu(k,1120) - lu(k,751) * lu(k,1094) + lu(k,1121) = lu(k,1121) - lu(k,752) * lu(k,1094) + lu(k,1122) = lu(k,1122) - lu(k,753) * lu(k,1094) + lu(k,1123) = lu(k,1123) - lu(k,754) * lu(k,1094) + lu(k,1124) = lu(k,1124) - lu(k,755) * lu(k,1094) + lu(k,1125) = lu(k,1125) - lu(k,756) * lu(k,1094) + lu(k,1126) = lu(k,1126) - lu(k,757) * lu(k,1094) + lu(k,1373) = lu(k,1373) - lu(k,739) * lu(k,1372) + lu(k,1377) = lu(k,1377) - lu(k,740) * lu(k,1372) + lu(k,1379) = lu(k,1379) - lu(k,741) * lu(k,1372) + lu(k,1381) = lu(k,1381) - lu(k,742) * lu(k,1372) + lu(k,1382) = lu(k,1382) - lu(k,743) * lu(k,1372) + lu(k,1386) = lu(k,1386) - lu(k,744) * lu(k,1372) + lu(k,1388) = lu(k,1388) - lu(k,745) * lu(k,1372) + lu(k,1389) = lu(k,1389) - lu(k,746) * lu(k,1372) + lu(k,1390) = lu(k,1390) - lu(k,747) * lu(k,1372) + lu(k,1391) = lu(k,1391) - lu(k,748) * lu(k,1372) + lu(k,1396) = lu(k,1396) - lu(k,749) * lu(k,1372) + lu(k,1397) = lu(k,1397) - lu(k,750) * lu(k,1372) + lu(k,1398) = lu(k,1398) - lu(k,751) * lu(k,1372) + lu(k,1399) = lu(k,1399) - lu(k,752) * lu(k,1372) + lu(k,1400) = lu(k,1400) - lu(k,753) * lu(k,1372) + lu(k,1401) = lu(k,1401) - lu(k,754) * lu(k,1372) + lu(k,1402) = lu(k,1402) - lu(k,755) * lu(k,1372) + lu(k,1403) = lu(k,1403) - lu(k,756) * lu(k,1372) + lu(k,1404) = lu(k,1404) - lu(k,757) * lu(k,1372) + lu(k,1423) = lu(k,1423) - lu(k,739) * lu(k,1422) + lu(k,1426) = lu(k,1426) - lu(k,740) * lu(k,1422) + lu(k,1428) = lu(k,1428) - lu(k,741) * lu(k,1422) + lu(k,1430) = lu(k,1430) - lu(k,742) * lu(k,1422) + lu(k,1431) = lu(k,1431) - lu(k,743) * lu(k,1422) + lu(k,1435) = lu(k,1435) - lu(k,744) * lu(k,1422) + lu(k,1437) = lu(k,1437) - lu(k,745) * lu(k,1422) + lu(k,1438) = lu(k,1438) - lu(k,746) * lu(k,1422) + lu(k,1439) = lu(k,1439) - lu(k,747) * lu(k,1422) + lu(k,1440) = lu(k,1440) - lu(k,748) * lu(k,1422) + lu(k,1445) = lu(k,1445) - lu(k,749) * lu(k,1422) + lu(k,1446) = lu(k,1446) - lu(k,750) * lu(k,1422) + lu(k,1447) = lu(k,1447) - lu(k,751) * lu(k,1422) + lu(k,1448) = lu(k,1448) - lu(k,752) * lu(k,1422) + lu(k,1449) = lu(k,1449) - lu(k,753) * lu(k,1422) + lu(k,1450) = lu(k,1450) - lu(k,754) * lu(k,1422) + lu(k,1451) = lu(k,1451) - lu(k,755) * lu(k,1422) + lu(k,1452) = lu(k,1452) - lu(k,756) * lu(k,1422) + lu(k,1453) = lu(k,1453) - lu(k,757) * lu(k,1422) + lu(k,1470) = lu(k,1470) - lu(k,739) * lu(k,1469) + lu(k,1474) = lu(k,1474) - lu(k,740) * lu(k,1469) + lu(k,1476) = lu(k,1476) - lu(k,741) * lu(k,1469) + lu(k,1478) = lu(k,1478) - lu(k,742) * lu(k,1469) + lu(k,1479) = lu(k,1479) - lu(k,743) * lu(k,1469) + lu(k,1483) = lu(k,1483) - lu(k,744) * lu(k,1469) + lu(k,1485) = lu(k,1485) - lu(k,745) * lu(k,1469) + lu(k,1486) = lu(k,1486) - lu(k,746) * lu(k,1469) + lu(k,1487) = lu(k,1487) - lu(k,747) * lu(k,1469) + lu(k,1488) = lu(k,1488) - lu(k,748) * lu(k,1469) + lu(k,1493) = lu(k,1493) - lu(k,749) * lu(k,1469) + lu(k,1494) = lu(k,1494) - lu(k,750) * lu(k,1469) + lu(k,1495) = lu(k,1495) - lu(k,751) * lu(k,1469) + lu(k,1496) = lu(k,1496) - lu(k,752) * lu(k,1469) + lu(k,1497) = lu(k,1497) - lu(k,753) * lu(k,1469) + lu(k,1498) = lu(k,1498) - lu(k,754) * lu(k,1469) + lu(k,1499) = lu(k,1499) - lu(k,755) * lu(k,1469) + lu(k,1500) = lu(k,1500) - lu(k,756) * lu(k,1469) + lu(k,1501) = lu(k,1501) - lu(k,757) * lu(k,1469) + lu(k,1512) = lu(k,1512) - lu(k,739) * lu(k,1511) + lu(k,1515) = lu(k,1515) - lu(k,740) * lu(k,1511) + lu(k,1517) = lu(k,1517) - lu(k,741) * lu(k,1511) + lu(k,1519) = lu(k,1519) - lu(k,742) * lu(k,1511) + lu(k,1520) = lu(k,1520) - lu(k,743) * lu(k,1511) + lu(k,1524) = lu(k,1524) - lu(k,744) * lu(k,1511) + lu(k,1526) = lu(k,1526) - lu(k,745) * lu(k,1511) + lu(k,1527) = lu(k,1527) - lu(k,746) * lu(k,1511) + lu(k,1528) = lu(k,1528) - lu(k,747) * lu(k,1511) + lu(k,1529) = lu(k,1529) - lu(k,748) * lu(k,1511) + lu(k,1534) = lu(k,1534) - lu(k,749) * lu(k,1511) + lu(k,1535) = lu(k,1535) - lu(k,750) * lu(k,1511) + lu(k,1536) = lu(k,1536) - lu(k,751) * lu(k,1511) + lu(k,1537) = lu(k,1537) - lu(k,752) * lu(k,1511) + lu(k,1538) = lu(k,1538) - lu(k,753) * lu(k,1511) + lu(k,1539) = - lu(k,754) * lu(k,1511) + lu(k,1540) = lu(k,1540) - lu(k,755) * lu(k,1511) + lu(k,1541) = lu(k,1541) - lu(k,756) * lu(k,1511) + lu(k,1542) = lu(k,1542) - lu(k,757) * lu(k,1511) + lu(k,1721) = lu(k,1721) - lu(k,739) * lu(k,1720) + lu(k,1723) = lu(k,1723) - lu(k,740) * lu(k,1720) + lu(k,1725) = lu(k,1725) - lu(k,741) * lu(k,1720) + lu(k,1726) = - lu(k,742) * lu(k,1720) + lu(k,1727) = lu(k,1727) - lu(k,743) * lu(k,1720) + lu(k,1731) = lu(k,1731) - lu(k,744) * lu(k,1720) + lu(k,1733) = lu(k,1733) - lu(k,745) * lu(k,1720) + lu(k,1734) = lu(k,1734) - lu(k,746) * lu(k,1720) + lu(k,1735) = lu(k,1735) - lu(k,747) * lu(k,1720) + lu(k,1736) = lu(k,1736) - lu(k,748) * lu(k,1720) + lu(k,1741) = lu(k,1741) - lu(k,749) * lu(k,1720) + lu(k,1742) = lu(k,1742) - lu(k,750) * lu(k,1720) + lu(k,1743) = lu(k,1743) - lu(k,751) * lu(k,1720) + lu(k,1744) = - lu(k,752) * lu(k,1720) + lu(k,1745) = - lu(k,753) * lu(k,1720) + lu(k,1746) = lu(k,1746) - lu(k,754) * lu(k,1720) + lu(k,1747) = lu(k,1747) - lu(k,755) * lu(k,1720) + lu(k,1748) = lu(k,1748) - lu(k,756) * lu(k,1720) + lu(k,1749) = lu(k,1749) - lu(k,757) * lu(k,1720) + lu(k,1754) = lu(k,1754) - lu(k,739) * lu(k,1753) + lu(k,1758) = lu(k,1758) - lu(k,740) * lu(k,1753) + lu(k,1760) = lu(k,1760) - lu(k,741) * lu(k,1753) + lu(k,1762) = lu(k,1762) - lu(k,742) * lu(k,1753) + lu(k,1763) = lu(k,1763) - lu(k,743) * lu(k,1753) + lu(k,1767) = lu(k,1767) - lu(k,744) * lu(k,1753) + lu(k,1769) = lu(k,1769) - lu(k,745) * lu(k,1753) + lu(k,1770) = lu(k,1770) - lu(k,746) * lu(k,1753) + lu(k,1771) = lu(k,1771) - lu(k,747) * lu(k,1753) + lu(k,1772) = lu(k,1772) - lu(k,748) * lu(k,1753) + lu(k,1777) = lu(k,1777) - lu(k,749) * lu(k,1753) + lu(k,1778) = lu(k,1778) - lu(k,750) * lu(k,1753) + lu(k,1779) = lu(k,1779) - lu(k,751) * lu(k,1753) + lu(k,1780) = lu(k,1780) - lu(k,752) * lu(k,1753) + lu(k,1781) = lu(k,1781) - lu(k,753) * lu(k,1753) + lu(k,1782) = lu(k,1782) - lu(k,754) * lu(k,1753) + lu(k,1783) = lu(k,1783) - lu(k,755) * lu(k,1753) + lu(k,1784) = lu(k,1784) - lu(k,756) * lu(k,1753) + lu(k,1785) = lu(k,1785) - lu(k,757) * lu(k,1753) + lu(k,1803) = lu(k,1803) - lu(k,739) * lu(k,1802) + lu(k,1806) = lu(k,1806) - lu(k,740) * lu(k,1802) + lu(k,1808) = lu(k,1808) - lu(k,741) * lu(k,1802) + lu(k,1810) = lu(k,1810) - lu(k,742) * lu(k,1802) + lu(k,1811) = lu(k,1811) - lu(k,743) * lu(k,1802) + lu(k,1815) = lu(k,1815) - lu(k,744) * lu(k,1802) + lu(k,1817) = lu(k,1817) - lu(k,745) * lu(k,1802) + lu(k,1818) = lu(k,1818) - lu(k,746) * lu(k,1802) + lu(k,1819) = lu(k,1819) - lu(k,747) * lu(k,1802) + lu(k,1820) = lu(k,1820) - lu(k,748) * lu(k,1802) + lu(k,1825) = lu(k,1825) - lu(k,749) * lu(k,1802) + lu(k,1826) = lu(k,1826) - lu(k,750) * lu(k,1802) + lu(k,1827) = lu(k,1827) - lu(k,751) * lu(k,1802) + lu(k,1828) = lu(k,1828) - lu(k,752) * lu(k,1802) + lu(k,1829) = lu(k,1829) - lu(k,753) * lu(k,1802) + lu(k,1830) = lu(k,1830) - lu(k,754) * lu(k,1802) + lu(k,1831) = lu(k,1831) - lu(k,755) * lu(k,1802) + lu(k,1832) = lu(k,1832) - lu(k,756) * lu(k,1802) + lu(k,1833) = lu(k,1833) - lu(k,757) * lu(k,1802) + lu(k,1872) = lu(k,1872) - lu(k,739) * lu(k,1871) + lu(k,1875) = lu(k,1875) - lu(k,740) * lu(k,1871) + lu(k,1877) = lu(k,1877) - lu(k,741) * lu(k,1871) + lu(k,1879) = lu(k,1879) - lu(k,742) * lu(k,1871) + lu(k,1880) = lu(k,1880) - lu(k,743) * lu(k,1871) + lu(k,1884) = lu(k,1884) - lu(k,744) * lu(k,1871) + lu(k,1886) = lu(k,1886) - lu(k,745) * lu(k,1871) + lu(k,1887) = lu(k,1887) - lu(k,746) * lu(k,1871) + lu(k,1888) = lu(k,1888) - lu(k,747) * lu(k,1871) + lu(k,1889) = lu(k,1889) - lu(k,748) * lu(k,1871) + lu(k,1894) = lu(k,1894) - lu(k,749) * lu(k,1871) + lu(k,1895) = lu(k,1895) - lu(k,750) * lu(k,1871) + lu(k,1896) = lu(k,1896) - lu(k,751) * lu(k,1871) + lu(k,1897) = lu(k,1897) - lu(k,752) * lu(k,1871) + lu(k,1898) = lu(k,1898) - lu(k,753) * lu(k,1871) + lu(k,1899) = lu(k,1899) - lu(k,754) * lu(k,1871) + lu(k,1900) = lu(k,1900) - lu(k,755) * lu(k,1871) + lu(k,1901) = lu(k,1901) - lu(k,756) * lu(k,1871) + lu(k,1902) = lu(k,1902) - lu(k,757) * lu(k,1871) + lu(k,1913) = lu(k,1913) - lu(k,739) * lu(k,1912) + lu(k,1916) = lu(k,1916) - lu(k,740) * lu(k,1912) + lu(k,1918) = lu(k,1918) - lu(k,741) * lu(k,1912) + lu(k,1920) = lu(k,1920) - lu(k,742) * lu(k,1912) + lu(k,1921) = lu(k,1921) - lu(k,743) * lu(k,1912) + lu(k,1925) = lu(k,1925) - lu(k,744) * lu(k,1912) + lu(k,1927) = lu(k,1927) - lu(k,745) * lu(k,1912) + lu(k,1928) = lu(k,1928) - lu(k,746) * lu(k,1912) + lu(k,1929) = lu(k,1929) - lu(k,747) * lu(k,1912) + lu(k,1930) = lu(k,1930) - lu(k,748) * lu(k,1912) + lu(k,1935) = lu(k,1935) - lu(k,749) * lu(k,1912) + lu(k,1936) = lu(k,1936) - lu(k,750) * lu(k,1912) + lu(k,1937) = lu(k,1937) - lu(k,751) * lu(k,1912) + lu(k,1938) = lu(k,1938) - lu(k,752) * lu(k,1912) + lu(k,1939) = lu(k,1939) - lu(k,753) * lu(k,1912) + lu(k,1940) = lu(k,1940) - lu(k,754) * lu(k,1912) + lu(k,1941) = lu(k,1941) - lu(k,755) * lu(k,1912) + lu(k,1942) = lu(k,1942) - lu(k,756) * lu(k,1912) + lu(k,1943) = lu(k,1943) - lu(k,757) * lu(k,1912) + lu(k,1955) = lu(k,1955) - lu(k,739) * lu(k,1954) + lu(k,1958) = lu(k,1958) - lu(k,740) * lu(k,1954) + lu(k,1960) = lu(k,1960) - lu(k,741) * lu(k,1954) + lu(k,1962) = lu(k,1962) - lu(k,742) * lu(k,1954) + lu(k,1963) = lu(k,1963) - lu(k,743) * lu(k,1954) + lu(k,1967) = lu(k,1967) - lu(k,744) * lu(k,1954) + lu(k,1969) = lu(k,1969) - lu(k,745) * lu(k,1954) + lu(k,1970) = lu(k,1970) - lu(k,746) * lu(k,1954) + lu(k,1971) = lu(k,1971) - lu(k,747) * lu(k,1954) + lu(k,1972) = lu(k,1972) - lu(k,748) * lu(k,1954) + lu(k,1977) = lu(k,1977) - lu(k,749) * lu(k,1954) + lu(k,1978) = lu(k,1978) - lu(k,750) * lu(k,1954) + lu(k,1979) = lu(k,1979) - lu(k,751) * lu(k,1954) + lu(k,1980) = lu(k,1980) - lu(k,752) * lu(k,1954) + lu(k,1981) = lu(k,1981) - lu(k,753) * lu(k,1954) + lu(k,1982) = lu(k,1982) - lu(k,754) * lu(k,1954) + lu(k,1983) = lu(k,1983) - lu(k,755) * lu(k,1954) + lu(k,1984) = lu(k,1984) - lu(k,756) * lu(k,1954) + lu(k,1985) = lu(k,1985) - lu(k,757) * lu(k,1954) + lu(k,1999) = lu(k,1999) - lu(k,739) * lu(k,1998) + lu(k,2003) = lu(k,2003) - lu(k,740) * lu(k,1998) + lu(k,2005) = lu(k,2005) - lu(k,741) * lu(k,1998) + lu(k,2007) = - lu(k,742) * lu(k,1998) + lu(k,2008) = lu(k,2008) - lu(k,743) * lu(k,1998) + lu(k,2012) = lu(k,2012) - lu(k,744) * lu(k,1998) + lu(k,2014) = lu(k,2014) - lu(k,745) * lu(k,1998) + lu(k,2015) = lu(k,2015) - lu(k,746) * lu(k,1998) + lu(k,2016) = lu(k,2016) - lu(k,747) * lu(k,1998) + lu(k,2017) = lu(k,2017) - lu(k,748) * lu(k,1998) + lu(k,2022) = lu(k,2022) - lu(k,749) * lu(k,1998) + lu(k,2023) = lu(k,2023) - lu(k,750) * lu(k,1998) + lu(k,2024) = lu(k,2024) - lu(k,751) * lu(k,1998) + lu(k,2025) = lu(k,2025) - lu(k,752) * lu(k,1998) + lu(k,2026) = lu(k,2026) - lu(k,753) * lu(k,1998) + lu(k,2027) = lu(k,2027) - lu(k,754) * lu(k,1998) + lu(k,2028) = lu(k,2028) - lu(k,755) * lu(k,1998) + lu(k,2029) = lu(k,2029) - lu(k,756) * lu(k,1998) + lu(k,2030) = lu(k,2030) - lu(k,757) * lu(k,1998) + lu(k,2060) = lu(k,2060) - lu(k,739) * lu(k,2059) + lu(k,2063) = lu(k,2063) - lu(k,740) * lu(k,2059) + lu(k,2065) = lu(k,2065) - lu(k,741) * lu(k,2059) + lu(k,2067) = lu(k,2067) - lu(k,742) * lu(k,2059) + lu(k,2068) = lu(k,2068) - lu(k,743) * lu(k,2059) + lu(k,2072) = lu(k,2072) - lu(k,744) * lu(k,2059) + lu(k,2074) = lu(k,2074) - lu(k,745) * lu(k,2059) + lu(k,2075) = lu(k,2075) - lu(k,746) * lu(k,2059) + lu(k,2076) = lu(k,2076) - lu(k,747) * lu(k,2059) + lu(k,2077) = lu(k,2077) - lu(k,748) * lu(k,2059) + lu(k,2082) = lu(k,2082) - lu(k,749) * lu(k,2059) + lu(k,2083) = lu(k,2083) - lu(k,750) * lu(k,2059) + lu(k,2084) = lu(k,2084) - lu(k,751) * lu(k,2059) + lu(k,2085) = lu(k,2085) - lu(k,752) * lu(k,2059) + lu(k,2086) = lu(k,2086) - lu(k,753) * lu(k,2059) + lu(k,2087) = lu(k,2087) - lu(k,754) * lu(k,2059) + lu(k,2088) = lu(k,2088) - lu(k,755) * lu(k,2059) + lu(k,2089) = lu(k,2089) - lu(k,756) * lu(k,2059) + lu(k,2090) = lu(k,2090) - lu(k,757) * lu(k,2059) + lu(k,787) = 1._r8 / lu(k,787) + lu(k,788) = lu(k,788) * lu(k,787) + lu(k,789) = lu(k,789) * lu(k,787) + lu(k,790) = lu(k,790) * lu(k,787) + lu(k,791) = lu(k,791) * lu(k,787) + lu(k,792) = lu(k,792) * lu(k,787) + lu(k,793) = lu(k,793) * lu(k,787) + lu(k,794) = lu(k,794) * lu(k,787) + lu(k,795) = lu(k,795) * lu(k,787) + lu(k,796) = lu(k,796) * lu(k,787) + lu(k,797) = lu(k,797) * lu(k,787) + lu(k,798) = lu(k,798) * lu(k,787) + lu(k,799) = lu(k,799) * lu(k,787) + lu(k,800) = lu(k,800) * lu(k,787) + lu(k,801) = lu(k,801) * lu(k,787) + lu(k,802) = lu(k,802) * lu(k,787) + lu(k,803) = lu(k,803) * lu(k,787) + lu(k,804) = lu(k,804) * lu(k,787) + lu(k,805) = lu(k,805) * lu(k,787) + lu(k,806) = lu(k,806) * lu(k,787) + lu(k,807) = lu(k,807) * lu(k,787) + lu(k,808) = lu(k,808) * lu(k,787) + lu(k,900) = lu(k,900) - lu(k,788) * lu(k,899) + lu(k,901) = lu(k,901) - lu(k,789) * lu(k,899) + lu(k,902) = lu(k,902) - lu(k,790) * lu(k,899) + lu(k,903) = lu(k,903) - lu(k,791) * lu(k,899) + lu(k,904) = lu(k,904) - lu(k,792) * lu(k,899) + lu(k,905) = lu(k,905) - lu(k,793) * lu(k,899) + lu(k,907) = lu(k,907) - lu(k,794) * lu(k,899) + lu(k,908) = lu(k,908) - lu(k,795) * lu(k,899) + lu(k,909) = lu(k,909) - lu(k,796) * lu(k,899) + lu(k,910) = lu(k,910) - lu(k,797) * lu(k,899) + lu(k,911) = - lu(k,798) * lu(k,899) + lu(k,912) = - lu(k,799) * lu(k,899) + lu(k,913) = lu(k,913) - lu(k,800) * lu(k,899) + lu(k,914) = lu(k,914) - lu(k,801) * lu(k,899) + lu(k,915) = lu(k,915) - lu(k,802) * lu(k,899) + lu(k,916) = lu(k,916) - lu(k,803) * lu(k,899) + lu(k,917) = lu(k,917) - lu(k,804) * lu(k,899) + lu(k,918) = lu(k,918) - lu(k,805) * lu(k,899) + lu(k,919) = lu(k,919) - lu(k,806) * lu(k,899) + lu(k,920) = lu(k,920) - lu(k,807) * lu(k,899) + lu(k,921) = lu(k,921) - lu(k,808) * lu(k,899) + lu(k,983) = lu(k,983) - lu(k,788) * lu(k,982) + lu(k,984) = lu(k,984) - lu(k,789) * lu(k,982) + lu(k,985) = lu(k,985) - lu(k,790) * lu(k,982) + lu(k,986) = lu(k,986) - lu(k,791) * lu(k,982) + lu(k,988) = lu(k,988) - lu(k,792) * lu(k,982) + lu(k,989) = lu(k,989) - lu(k,793) * lu(k,982) + lu(k,991) = lu(k,991) - lu(k,794) * lu(k,982) + lu(k,992) = lu(k,992) - lu(k,795) * lu(k,982) + lu(k,993) = lu(k,993) - lu(k,796) * lu(k,982) + lu(k,994) = lu(k,994) - lu(k,797) * lu(k,982) + lu(k,995) = - lu(k,798) * lu(k,982) + lu(k,996) = lu(k,996) - lu(k,799) * lu(k,982) + lu(k,997) = lu(k,997) - lu(k,800) * lu(k,982) + lu(k,998) = lu(k,998) - lu(k,801) * lu(k,982) + lu(k,999) = lu(k,999) - lu(k,802) * lu(k,982) + lu(k,1000) = lu(k,1000) - lu(k,803) * lu(k,982) + lu(k,1001) = lu(k,1001) - lu(k,804) * lu(k,982) + lu(k,1002) = lu(k,1002) - lu(k,805) * lu(k,982) + lu(k,1003) = lu(k,1003) - lu(k,806) * lu(k,982) + lu(k,1004) = lu(k,1004) - lu(k,807) * lu(k,982) + lu(k,1005) = lu(k,1005) - lu(k,808) * lu(k,982) + lu(k,1056) = lu(k,1056) - lu(k,788) * lu(k,1055) + lu(k,1057) = lu(k,1057) - lu(k,789) * lu(k,1055) + lu(k,1058) = lu(k,1058) - lu(k,790) * lu(k,1055) + lu(k,1059) = - lu(k,791) * lu(k,1055) + lu(k,1062) = lu(k,1062) - lu(k,792) * lu(k,1055) + lu(k,1063) = lu(k,1063) - lu(k,793) * lu(k,1055) + lu(k,1065) = lu(k,1065) - lu(k,794) * lu(k,1055) + lu(k,1066) = lu(k,1066) - lu(k,795) * lu(k,1055) + lu(k,1067) = - lu(k,796) * lu(k,1055) + lu(k,1068) = - lu(k,797) * lu(k,1055) + lu(k,1069) = lu(k,1069) - lu(k,798) * lu(k,1055) + lu(k,1070) = lu(k,1070) - lu(k,799) * lu(k,1055) + lu(k,1073) = - lu(k,800) * lu(k,1055) + lu(k,1074) = lu(k,1074) - lu(k,801) * lu(k,1055) + lu(k,1075) = lu(k,1075) - lu(k,802) * lu(k,1055) + lu(k,1076) = - lu(k,803) * lu(k,1055) + lu(k,1077) = lu(k,1077) - lu(k,804) * lu(k,1055) + lu(k,1078) = lu(k,1078) - lu(k,805) * lu(k,1055) + lu(k,1079) = lu(k,1079) - lu(k,806) * lu(k,1055) + lu(k,1080) = - lu(k,807) * lu(k,1055) + lu(k,1081) = lu(k,1081) - lu(k,808) * lu(k,1055) + lu(k,1099) = lu(k,1099) - lu(k,788) * lu(k,1095) + lu(k,1101) = lu(k,1101) - lu(k,789) * lu(k,1095) + lu(k,1103) = lu(k,1103) - lu(k,790) * lu(k,1095) + lu(k,1104) = lu(k,1104) - lu(k,791) * lu(k,1095) + lu(k,1107) = - lu(k,792) * lu(k,1095) + lu(k,1108) = lu(k,1108) - lu(k,793) * lu(k,1095) + lu(k,1110) = lu(k,1110) - lu(k,794) * lu(k,1095) + lu(k,1111) = lu(k,1111) - lu(k,795) * lu(k,1095) + lu(k,1112) = lu(k,1112) - lu(k,796) * lu(k,1095) + lu(k,1113) = lu(k,1113) - lu(k,797) * lu(k,1095) + lu(k,1114) = lu(k,1114) - lu(k,798) * lu(k,1095) + lu(k,1115) = - lu(k,799) * lu(k,1095) + lu(k,1118) = lu(k,1118) - lu(k,800) * lu(k,1095) + lu(k,1119) = lu(k,1119) - lu(k,801) * lu(k,1095) + lu(k,1120) = lu(k,1120) - lu(k,802) * lu(k,1095) + lu(k,1121) = lu(k,1121) - lu(k,803) * lu(k,1095) + lu(k,1122) = lu(k,1122) - lu(k,804) * lu(k,1095) + lu(k,1123) = lu(k,1123) - lu(k,805) * lu(k,1095) + lu(k,1124) = lu(k,1124) - lu(k,806) * lu(k,1095) + lu(k,1125) = lu(k,1125) - lu(k,807) * lu(k,1095) + lu(k,1126) = lu(k,1126) - lu(k,808) * lu(k,1095) + lu(k,1147) = lu(k,1147) - lu(k,788) * lu(k,1143) + lu(k,1149) = lu(k,1149) - lu(k,789) * lu(k,1143) + lu(k,1151) = lu(k,1151) - lu(k,790) * lu(k,1143) + lu(k,1152) = - lu(k,791) * lu(k,1143) + lu(k,1155) = lu(k,1155) - lu(k,792) * lu(k,1143) + lu(k,1156) = lu(k,1156) - lu(k,793) * lu(k,1143) + lu(k,1158) = lu(k,1158) - lu(k,794) * lu(k,1143) + lu(k,1159) = lu(k,1159) - lu(k,795) * lu(k,1143) + lu(k,1160) = lu(k,1160) - lu(k,796) * lu(k,1143) + lu(k,1161) = lu(k,1161) - lu(k,797) * lu(k,1143) + lu(k,1162) = lu(k,1162) - lu(k,798) * lu(k,1143) + lu(k,1163) = lu(k,1163) - lu(k,799) * lu(k,1143) + lu(k,1166) = lu(k,1166) - lu(k,800) * lu(k,1143) + lu(k,1167) = lu(k,1167) - lu(k,801) * lu(k,1143) + lu(k,1168) = lu(k,1168) - lu(k,802) * lu(k,1143) + lu(k,1169) = - lu(k,803) * lu(k,1143) + lu(k,1170) = - lu(k,804) * lu(k,1143) + lu(k,1171) = - lu(k,805) * lu(k,1143) + lu(k,1172) = lu(k,1172) - lu(k,806) * lu(k,1143) + lu(k,1173) = lu(k,1173) - lu(k,807) * lu(k,1143) + lu(k,1174) = lu(k,1174) - lu(k,808) * lu(k,1143) + lu(k,1275) = lu(k,1275) - lu(k,788) * lu(k,1272) + lu(k,1277) = lu(k,1277) - lu(k,789) * lu(k,1272) + lu(k,1279) = lu(k,1279) - lu(k,790) * lu(k,1272) + lu(k,1280) = - lu(k,791) * lu(k,1272) + lu(k,1283) = lu(k,1283) - lu(k,792) * lu(k,1272) + lu(k,1284) = lu(k,1284) - lu(k,793) * lu(k,1272) + lu(k,1286) = lu(k,1286) - lu(k,794) * lu(k,1272) + lu(k,1287) = lu(k,1287) - lu(k,795) * lu(k,1272) + lu(k,1288) = - lu(k,796) * lu(k,1272) + lu(k,1289) = - lu(k,797) * lu(k,1272) + lu(k,1290) = lu(k,1290) - lu(k,798) * lu(k,1272) + lu(k,1291) = lu(k,1291) - lu(k,799) * lu(k,1272) + lu(k,1294) = - lu(k,800) * lu(k,1272) + lu(k,1295) = lu(k,1295) - lu(k,801) * lu(k,1272) + lu(k,1296) = lu(k,1296) - lu(k,802) * lu(k,1272) + lu(k,1297) = lu(k,1297) - lu(k,803) * lu(k,1272) + lu(k,1298) = lu(k,1298) - lu(k,804) * lu(k,1272) + lu(k,1299) = lu(k,1299) - lu(k,805) * lu(k,1272) + lu(k,1300) = lu(k,1300) - lu(k,806) * lu(k,1272) + lu(k,1301) = - lu(k,807) * lu(k,1272) + lu(k,1302) = lu(k,1302) - lu(k,808) * lu(k,1272) + lu(k,1377) = lu(k,1377) - lu(k,788) * lu(k,1373) + lu(k,1379) = lu(k,1379) - lu(k,789) * lu(k,1373) + lu(k,1381) = lu(k,1381) - lu(k,790) * lu(k,1373) + lu(k,1382) = lu(k,1382) - lu(k,791) * lu(k,1373) + lu(k,1385) = lu(k,1385) - lu(k,792) * lu(k,1373) + lu(k,1386) = lu(k,1386) - lu(k,793) * lu(k,1373) + lu(k,1388) = lu(k,1388) - lu(k,794) * lu(k,1373) + lu(k,1389) = lu(k,1389) - lu(k,795) * lu(k,1373) + lu(k,1390) = lu(k,1390) - lu(k,796) * lu(k,1373) + lu(k,1391) = lu(k,1391) - lu(k,797) * lu(k,1373) + lu(k,1392) = lu(k,1392) - lu(k,798) * lu(k,1373) + lu(k,1393) = lu(k,1393) - lu(k,799) * lu(k,1373) + lu(k,1396) = lu(k,1396) - lu(k,800) * lu(k,1373) + lu(k,1397) = lu(k,1397) - lu(k,801) * lu(k,1373) + lu(k,1398) = lu(k,1398) - lu(k,802) * lu(k,1373) + lu(k,1399) = lu(k,1399) - lu(k,803) * lu(k,1373) + lu(k,1400) = lu(k,1400) - lu(k,804) * lu(k,1373) + lu(k,1401) = lu(k,1401) - lu(k,805) * lu(k,1373) + lu(k,1402) = lu(k,1402) - lu(k,806) * lu(k,1373) + lu(k,1403) = lu(k,1403) - lu(k,807) * lu(k,1373) + lu(k,1404) = lu(k,1404) - lu(k,808) * lu(k,1373) + lu(k,1426) = lu(k,1426) - lu(k,788) * lu(k,1423) + lu(k,1428) = lu(k,1428) - lu(k,789) * lu(k,1423) + lu(k,1430) = lu(k,1430) - lu(k,790) * lu(k,1423) + lu(k,1431) = lu(k,1431) - lu(k,791) * lu(k,1423) + lu(k,1434) = lu(k,1434) - lu(k,792) * lu(k,1423) + lu(k,1435) = lu(k,1435) - lu(k,793) * lu(k,1423) + lu(k,1437) = lu(k,1437) - lu(k,794) * lu(k,1423) + lu(k,1438) = lu(k,1438) - lu(k,795) * lu(k,1423) + lu(k,1439) = lu(k,1439) - lu(k,796) * lu(k,1423) + lu(k,1440) = lu(k,1440) - lu(k,797) * lu(k,1423) + lu(k,1441) = lu(k,1441) - lu(k,798) * lu(k,1423) + lu(k,1442) = lu(k,1442) - lu(k,799) * lu(k,1423) + lu(k,1445) = lu(k,1445) - lu(k,800) * lu(k,1423) + lu(k,1446) = lu(k,1446) - lu(k,801) * lu(k,1423) + lu(k,1447) = lu(k,1447) - lu(k,802) * lu(k,1423) + lu(k,1448) = lu(k,1448) - lu(k,803) * lu(k,1423) + lu(k,1449) = lu(k,1449) - lu(k,804) * lu(k,1423) + lu(k,1450) = lu(k,1450) - lu(k,805) * lu(k,1423) + lu(k,1451) = lu(k,1451) - lu(k,806) * lu(k,1423) + lu(k,1452) = lu(k,1452) - lu(k,807) * lu(k,1423) + lu(k,1453) = lu(k,1453) - lu(k,808) * lu(k,1423) + lu(k,1474) = lu(k,1474) - lu(k,788) * lu(k,1470) + lu(k,1476) = lu(k,1476) - lu(k,789) * lu(k,1470) + lu(k,1478) = lu(k,1478) - lu(k,790) * lu(k,1470) + lu(k,1479) = lu(k,1479) - lu(k,791) * lu(k,1470) + lu(k,1482) = - lu(k,792) * lu(k,1470) + lu(k,1483) = lu(k,1483) - lu(k,793) * lu(k,1470) + lu(k,1485) = lu(k,1485) - lu(k,794) * lu(k,1470) + lu(k,1486) = lu(k,1486) - lu(k,795) * lu(k,1470) + lu(k,1487) = lu(k,1487) - lu(k,796) * lu(k,1470) + lu(k,1488) = lu(k,1488) - lu(k,797) * lu(k,1470) + lu(k,1489) = lu(k,1489) - lu(k,798) * lu(k,1470) + lu(k,1490) = - lu(k,799) * lu(k,1470) + lu(k,1493) = lu(k,1493) - lu(k,800) * lu(k,1470) + lu(k,1494) = lu(k,1494) - lu(k,801) * lu(k,1470) + lu(k,1495) = lu(k,1495) - lu(k,802) * lu(k,1470) + lu(k,1496) = lu(k,1496) - lu(k,803) * lu(k,1470) + lu(k,1497) = lu(k,1497) - lu(k,804) * lu(k,1470) + lu(k,1498) = lu(k,1498) - lu(k,805) * lu(k,1470) + lu(k,1499) = lu(k,1499) - lu(k,806) * lu(k,1470) + lu(k,1500) = lu(k,1500) - lu(k,807) * lu(k,1470) + lu(k,1501) = lu(k,1501) - lu(k,808) * lu(k,1470) + lu(k,1515) = lu(k,1515) - lu(k,788) * lu(k,1512) + lu(k,1517) = lu(k,1517) - lu(k,789) * lu(k,1512) + lu(k,1519) = lu(k,1519) - lu(k,790) * lu(k,1512) + lu(k,1520) = lu(k,1520) - lu(k,791) * lu(k,1512) + lu(k,1523) = lu(k,1523) - lu(k,792) * lu(k,1512) + lu(k,1524) = lu(k,1524) - lu(k,793) * lu(k,1512) + lu(k,1526) = lu(k,1526) - lu(k,794) * lu(k,1512) + lu(k,1527) = lu(k,1527) - lu(k,795) * lu(k,1512) + lu(k,1528) = lu(k,1528) - lu(k,796) * lu(k,1512) + lu(k,1529) = lu(k,1529) - lu(k,797) * lu(k,1512) + lu(k,1530) = lu(k,1530) - lu(k,798) * lu(k,1512) + lu(k,1531) = lu(k,1531) - lu(k,799) * lu(k,1512) + lu(k,1534) = lu(k,1534) - lu(k,800) * lu(k,1512) + lu(k,1535) = lu(k,1535) - lu(k,801) * lu(k,1512) + lu(k,1536) = lu(k,1536) - lu(k,802) * lu(k,1512) + lu(k,1537) = lu(k,1537) - lu(k,803) * lu(k,1512) + lu(k,1538) = lu(k,1538) - lu(k,804) * lu(k,1512) + lu(k,1539) = lu(k,1539) - lu(k,805) * lu(k,1512) + lu(k,1540) = lu(k,1540) - lu(k,806) * lu(k,1512) + lu(k,1541) = lu(k,1541) - lu(k,807) * lu(k,1512) + lu(k,1542) = lu(k,1542) - lu(k,808) * lu(k,1512) + lu(k,1596) = lu(k,1596) - lu(k,788) * lu(k,1592) + lu(k,1598) = lu(k,1598) - lu(k,789) * lu(k,1592) + lu(k,1600) = lu(k,1600) - lu(k,790) * lu(k,1592) + lu(k,1601) = - lu(k,791) * lu(k,1592) + lu(k,1604) = lu(k,1604) - lu(k,792) * lu(k,1592) + lu(k,1605) = lu(k,1605) - lu(k,793) * lu(k,1592) + lu(k,1607) = lu(k,1607) - lu(k,794) * lu(k,1592) + lu(k,1608) = lu(k,1608) - lu(k,795) * lu(k,1592) + lu(k,1609) = lu(k,1609) - lu(k,796) * lu(k,1592) + lu(k,1610) = lu(k,1610) - lu(k,797) * lu(k,1592) + lu(k,1611) = lu(k,1611) - lu(k,798) * lu(k,1592) + lu(k,1612) = lu(k,1612) - lu(k,799) * lu(k,1592) + lu(k,1615) = lu(k,1615) - lu(k,800) * lu(k,1592) + lu(k,1616) = lu(k,1616) - lu(k,801) * lu(k,1592) + lu(k,1617) = lu(k,1617) - lu(k,802) * lu(k,1592) + lu(k,1618) = - lu(k,803) * lu(k,1592) + lu(k,1619) = lu(k,1619) - lu(k,804) * lu(k,1592) + lu(k,1620) = lu(k,1620) - lu(k,805) * lu(k,1592) + lu(k,1621) = lu(k,1621) - lu(k,806) * lu(k,1592) + lu(k,1622) = lu(k,1622) - lu(k,807) * lu(k,1592) + lu(k,1623) = lu(k,1623) - lu(k,808) * lu(k,1592) + lu(k,1723) = lu(k,1723) - lu(k,788) * lu(k,1721) + lu(k,1725) = lu(k,1725) - lu(k,789) * lu(k,1721) + lu(k,1726) = lu(k,1726) - lu(k,790) * lu(k,1721) + lu(k,1727) = lu(k,1727) - lu(k,791) * lu(k,1721) + lu(k,1730) = lu(k,1730) - lu(k,792) * lu(k,1721) + lu(k,1731) = lu(k,1731) - lu(k,793) * lu(k,1721) + lu(k,1733) = lu(k,1733) - lu(k,794) * lu(k,1721) + lu(k,1734) = lu(k,1734) - lu(k,795) * lu(k,1721) + lu(k,1735) = lu(k,1735) - lu(k,796) * lu(k,1721) + lu(k,1736) = lu(k,1736) - lu(k,797) * lu(k,1721) + lu(k,1737) = - lu(k,798) * lu(k,1721) + lu(k,1738) = lu(k,1738) - lu(k,799) * lu(k,1721) + lu(k,1741) = lu(k,1741) - lu(k,800) * lu(k,1721) + lu(k,1742) = lu(k,1742) - lu(k,801) * lu(k,1721) + lu(k,1743) = lu(k,1743) - lu(k,802) * lu(k,1721) + lu(k,1744) = lu(k,1744) - lu(k,803) * lu(k,1721) + lu(k,1745) = lu(k,1745) - lu(k,804) * lu(k,1721) + lu(k,1746) = lu(k,1746) - lu(k,805) * lu(k,1721) + lu(k,1747) = lu(k,1747) - lu(k,806) * lu(k,1721) + lu(k,1748) = lu(k,1748) - lu(k,807) * lu(k,1721) + lu(k,1749) = lu(k,1749) - lu(k,808) * lu(k,1721) + lu(k,1758) = lu(k,1758) - lu(k,788) * lu(k,1754) + lu(k,1760) = lu(k,1760) - lu(k,789) * lu(k,1754) + lu(k,1762) = lu(k,1762) - lu(k,790) * lu(k,1754) + lu(k,1763) = lu(k,1763) - lu(k,791) * lu(k,1754) + lu(k,1766) = lu(k,1766) - lu(k,792) * lu(k,1754) + lu(k,1767) = lu(k,1767) - lu(k,793) * lu(k,1754) + lu(k,1769) = lu(k,1769) - lu(k,794) * lu(k,1754) + lu(k,1770) = lu(k,1770) - lu(k,795) * lu(k,1754) + lu(k,1771) = lu(k,1771) - lu(k,796) * lu(k,1754) + lu(k,1772) = lu(k,1772) - lu(k,797) * lu(k,1754) + lu(k,1773) = lu(k,1773) - lu(k,798) * lu(k,1754) + lu(k,1774) = - lu(k,799) * lu(k,1754) + lu(k,1777) = lu(k,1777) - lu(k,800) * lu(k,1754) + lu(k,1778) = lu(k,1778) - lu(k,801) * lu(k,1754) + lu(k,1779) = lu(k,1779) - lu(k,802) * lu(k,1754) + lu(k,1780) = lu(k,1780) - lu(k,803) * lu(k,1754) + lu(k,1781) = lu(k,1781) - lu(k,804) * lu(k,1754) + lu(k,1782) = lu(k,1782) - lu(k,805) * lu(k,1754) + lu(k,1783) = lu(k,1783) - lu(k,806) * lu(k,1754) + lu(k,1784) = lu(k,1784) - lu(k,807) * lu(k,1754) + lu(k,1785) = lu(k,1785) - lu(k,808) * lu(k,1754) + lu(k,1806) = lu(k,1806) - lu(k,788) * lu(k,1803) + lu(k,1808) = lu(k,1808) - lu(k,789) * lu(k,1803) + lu(k,1810) = lu(k,1810) - lu(k,790) * lu(k,1803) + lu(k,1811) = lu(k,1811) - lu(k,791) * lu(k,1803) + lu(k,1814) = lu(k,1814) - lu(k,792) * lu(k,1803) + lu(k,1815) = lu(k,1815) - lu(k,793) * lu(k,1803) + lu(k,1817) = lu(k,1817) - lu(k,794) * lu(k,1803) + lu(k,1818) = lu(k,1818) - lu(k,795) * lu(k,1803) + lu(k,1819) = lu(k,1819) - lu(k,796) * lu(k,1803) + lu(k,1820) = lu(k,1820) - lu(k,797) * lu(k,1803) + lu(k,1821) = lu(k,1821) - lu(k,798) * lu(k,1803) + lu(k,1822) = lu(k,1822) - lu(k,799) * lu(k,1803) + lu(k,1825) = lu(k,1825) - lu(k,800) * lu(k,1803) + lu(k,1826) = lu(k,1826) - lu(k,801) * lu(k,1803) + lu(k,1827) = lu(k,1827) - lu(k,802) * lu(k,1803) + lu(k,1828) = lu(k,1828) - lu(k,803) * lu(k,1803) + lu(k,1829) = lu(k,1829) - lu(k,804) * lu(k,1803) + lu(k,1830) = lu(k,1830) - lu(k,805) * lu(k,1803) + lu(k,1831) = lu(k,1831) - lu(k,806) * lu(k,1803) + lu(k,1832) = lu(k,1832) - lu(k,807) * lu(k,1803) + lu(k,1833) = lu(k,1833) - lu(k,808) * lu(k,1803) + lu(k,1875) = lu(k,1875) - lu(k,788) * lu(k,1872) + lu(k,1877) = lu(k,1877) - lu(k,789) * lu(k,1872) + lu(k,1879) = lu(k,1879) - lu(k,790) * lu(k,1872) + lu(k,1880) = lu(k,1880) - lu(k,791) * lu(k,1872) + lu(k,1883) = lu(k,1883) - lu(k,792) * lu(k,1872) + lu(k,1884) = lu(k,1884) - lu(k,793) * lu(k,1872) + lu(k,1886) = lu(k,1886) - lu(k,794) * lu(k,1872) + lu(k,1887) = lu(k,1887) - lu(k,795) * lu(k,1872) + lu(k,1888) = lu(k,1888) - lu(k,796) * lu(k,1872) + lu(k,1889) = lu(k,1889) - lu(k,797) * lu(k,1872) + lu(k,1890) = lu(k,1890) - lu(k,798) * lu(k,1872) + lu(k,1891) = lu(k,1891) - lu(k,799) * lu(k,1872) + lu(k,1894) = lu(k,1894) - lu(k,800) * lu(k,1872) + lu(k,1895) = lu(k,1895) - lu(k,801) * lu(k,1872) + lu(k,1896) = lu(k,1896) - lu(k,802) * lu(k,1872) + lu(k,1897) = lu(k,1897) - lu(k,803) * lu(k,1872) + lu(k,1898) = lu(k,1898) - lu(k,804) * lu(k,1872) + lu(k,1899) = lu(k,1899) - lu(k,805) * lu(k,1872) + lu(k,1900) = lu(k,1900) - lu(k,806) * lu(k,1872) + lu(k,1901) = lu(k,1901) - lu(k,807) * lu(k,1872) + lu(k,1902) = lu(k,1902) - lu(k,808) * lu(k,1872) + lu(k,1916) = lu(k,1916) - lu(k,788) * lu(k,1913) + lu(k,1918) = lu(k,1918) - lu(k,789) * lu(k,1913) + lu(k,1920) = lu(k,1920) - lu(k,790) * lu(k,1913) + lu(k,1921) = lu(k,1921) - lu(k,791) * lu(k,1913) + lu(k,1924) = lu(k,1924) - lu(k,792) * lu(k,1913) + lu(k,1925) = lu(k,1925) - lu(k,793) * lu(k,1913) + lu(k,1927) = lu(k,1927) - lu(k,794) * lu(k,1913) + lu(k,1928) = lu(k,1928) - lu(k,795) * lu(k,1913) + lu(k,1929) = lu(k,1929) - lu(k,796) * lu(k,1913) + lu(k,1930) = lu(k,1930) - lu(k,797) * lu(k,1913) + lu(k,1931) = lu(k,1931) - lu(k,798) * lu(k,1913) + lu(k,1932) = lu(k,1932) - lu(k,799) * lu(k,1913) + lu(k,1935) = lu(k,1935) - lu(k,800) * lu(k,1913) + lu(k,1936) = lu(k,1936) - lu(k,801) * lu(k,1913) + lu(k,1937) = lu(k,1937) - lu(k,802) * lu(k,1913) + lu(k,1938) = lu(k,1938) - lu(k,803) * lu(k,1913) + lu(k,1939) = lu(k,1939) - lu(k,804) * lu(k,1913) + lu(k,1940) = lu(k,1940) - lu(k,805) * lu(k,1913) + lu(k,1941) = lu(k,1941) - lu(k,806) * lu(k,1913) + lu(k,1942) = lu(k,1942) - lu(k,807) * lu(k,1913) + lu(k,1943) = lu(k,1943) - lu(k,808) * lu(k,1913) + lu(k,1958) = lu(k,1958) - lu(k,788) * lu(k,1955) + lu(k,1960) = lu(k,1960) - lu(k,789) * lu(k,1955) + lu(k,1962) = lu(k,1962) - lu(k,790) * lu(k,1955) + lu(k,1963) = lu(k,1963) - lu(k,791) * lu(k,1955) + lu(k,1966) = lu(k,1966) - lu(k,792) * lu(k,1955) + lu(k,1967) = lu(k,1967) - lu(k,793) * lu(k,1955) + lu(k,1969) = lu(k,1969) - lu(k,794) * lu(k,1955) + lu(k,1970) = lu(k,1970) - lu(k,795) * lu(k,1955) + lu(k,1971) = lu(k,1971) - lu(k,796) * lu(k,1955) + lu(k,1972) = lu(k,1972) - lu(k,797) * lu(k,1955) + lu(k,1973) = lu(k,1973) - lu(k,798) * lu(k,1955) + lu(k,1974) = lu(k,1974) - lu(k,799) * lu(k,1955) + lu(k,1977) = lu(k,1977) - lu(k,800) * lu(k,1955) + lu(k,1978) = lu(k,1978) - lu(k,801) * lu(k,1955) + lu(k,1979) = lu(k,1979) - lu(k,802) * lu(k,1955) + lu(k,1980) = lu(k,1980) - lu(k,803) * lu(k,1955) + lu(k,1981) = lu(k,1981) - lu(k,804) * lu(k,1955) + lu(k,1982) = lu(k,1982) - lu(k,805) * lu(k,1955) + lu(k,1983) = lu(k,1983) - lu(k,806) * lu(k,1955) + lu(k,1984) = lu(k,1984) - lu(k,807) * lu(k,1955) + lu(k,1985) = lu(k,1985) - lu(k,808) * lu(k,1955) + lu(k,2003) = lu(k,2003) - lu(k,788) * lu(k,1999) + lu(k,2005) = lu(k,2005) - lu(k,789) * lu(k,1999) + lu(k,2007) = lu(k,2007) - lu(k,790) * lu(k,1999) + lu(k,2008) = lu(k,2008) - lu(k,791) * lu(k,1999) + lu(k,2011) = lu(k,2011) - lu(k,792) * lu(k,1999) + lu(k,2012) = lu(k,2012) - lu(k,793) * lu(k,1999) + lu(k,2014) = lu(k,2014) - lu(k,794) * lu(k,1999) + lu(k,2015) = lu(k,2015) - lu(k,795) * lu(k,1999) + lu(k,2016) = lu(k,2016) - lu(k,796) * lu(k,1999) + lu(k,2017) = lu(k,2017) - lu(k,797) * lu(k,1999) + lu(k,2018) = lu(k,2018) - lu(k,798) * lu(k,1999) + lu(k,2019) = lu(k,2019) - lu(k,799) * lu(k,1999) + lu(k,2022) = lu(k,2022) - lu(k,800) * lu(k,1999) + lu(k,2023) = lu(k,2023) - lu(k,801) * lu(k,1999) + lu(k,2024) = lu(k,2024) - lu(k,802) * lu(k,1999) + lu(k,2025) = lu(k,2025) - lu(k,803) * lu(k,1999) + lu(k,2026) = lu(k,2026) - lu(k,804) * lu(k,1999) + lu(k,2027) = lu(k,2027) - lu(k,805) * lu(k,1999) + lu(k,2028) = lu(k,2028) - lu(k,806) * lu(k,1999) + lu(k,2029) = lu(k,2029) - lu(k,807) * lu(k,1999) + lu(k,2030) = lu(k,2030) - lu(k,808) * lu(k,1999) + lu(k,2063) = lu(k,2063) - lu(k,788) * lu(k,2060) + lu(k,2065) = lu(k,2065) - lu(k,789) * lu(k,2060) + lu(k,2067) = lu(k,2067) - lu(k,790) * lu(k,2060) + lu(k,2068) = lu(k,2068) - lu(k,791) * lu(k,2060) + lu(k,2071) = lu(k,2071) - lu(k,792) * lu(k,2060) + lu(k,2072) = lu(k,2072) - lu(k,793) * lu(k,2060) + lu(k,2074) = lu(k,2074) - lu(k,794) * lu(k,2060) + lu(k,2075) = lu(k,2075) - lu(k,795) * lu(k,2060) + lu(k,2076) = lu(k,2076) - lu(k,796) * lu(k,2060) + lu(k,2077) = lu(k,2077) - lu(k,797) * lu(k,2060) + lu(k,2078) = lu(k,2078) - lu(k,798) * lu(k,2060) + lu(k,2079) = lu(k,2079) - lu(k,799) * lu(k,2060) + lu(k,2082) = lu(k,2082) - lu(k,800) * lu(k,2060) + lu(k,2083) = lu(k,2083) - lu(k,801) * lu(k,2060) + lu(k,2084) = lu(k,2084) - lu(k,802) * lu(k,2060) + lu(k,2085) = lu(k,2085) - lu(k,803) * lu(k,2060) + lu(k,2086) = lu(k,2086) - lu(k,804) * lu(k,2060) + lu(k,2087) = lu(k,2087) - lu(k,805) * lu(k,2060) + lu(k,2088) = lu(k,2088) - lu(k,806) * lu(k,2060) + lu(k,2089) = lu(k,2089) - lu(k,807) * lu(k,2060) + lu(k,2090) = lu(k,2090) - lu(k,808) * lu(k,2060) + end do + end subroutine lu_fac18 + subroutine lu_fac19( 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,811) = 1._r8 / lu(k,811) + lu(k,812) = lu(k,812) * lu(k,811) + lu(k,813) = lu(k,813) * lu(k,811) + lu(k,814) = lu(k,814) * lu(k,811) + lu(k,815) = lu(k,815) * lu(k,811) + lu(k,816) = lu(k,816) * lu(k,811) + lu(k,817) = lu(k,817) * lu(k,811) + lu(k,818) = lu(k,818) * lu(k,811) + lu(k,819) = lu(k,819) * lu(k,811) + lu(k,820) = lu(k,820) * lu(k,811) + lu(k,821) = lu(k,821) * lu(k,811) + lu(k,822) = lu(k,822) * lu(k,811) + lu(k,823) = lu(k,823) * lu(k,811) + lu(k,824) = lu(k,824) * lu(k,811) + lu(k,825) = lu(k,825) * lu(k,811) + lu(k,826) = lu(k,826) * lu(k,811) + lu(k,827) = lu(k,827) * lu(k,811) + lu(k,828) = lu(k,828) * lu(k,811) + lu(k,829) = lu(k,829) * lu(k,811) + lu(k,834) = lu(k,834) - lu(k,812) * lu(k,832) + lu(k,836) = lu(k,836) - lu(k,813) * lu(k,832) + lu(k,839) = lu(k,839) - lu(k,814) * lu(k,832) + lu(k,841) = lu(k,841) - lu(k,815) * lu(k,832) + lu(k,842) = lu(k,842) - lu(k,816) * lu(k,832) + lu(k,843) = lu(k,843) - lu(k,817) * lu(k,832) + lu(k,845) = lu(k,845) - lu(k,818) * lu(k,832) + lu(k,847) = lu(k,847) - lu(k,819) * lu(k,832) + lu(k,848) = lu(k,848) - lu(k,820) * lu(k,832) + lu(k,849) = - lu(k,821) * lu(k,832) + lu(k,851) = lu(k,851) - lu(k,822) * lu(k,832) + lu(k,852) = lu(k,852) - lu(k,823) * lu(k,832) + lu(k,853) = lu(k,853) - lu(k,824) * lu(k,832) + lu(k,854) = lu(k,854) - lu(k,825) * lu(k,832) + lu(k,855) = lu(k,855) - lu(k,826) * lu(k,832) + lu(k,859) = lu(k,859) - lu(k,827) * lu(k,832) + lu(k,860) = lu(k,860) - lu(k,828) * lu(k,832) + lu(k,861) = lu(k,861) - lu(k,829) * lu(k,832) + lu(k,866) = lu(k,866) - lu(k,812) * lu(k,865) + lu(k,867) = lu(k,867) - lu(k,813) * lu(k,865) + lu(k,868) = lu(k,868) - lu(k,814) * lu(k,865) + lu(k,869) = lu(k,869) - lu(k,815) * lu(k,865) + lu(k,870) = lu(k,870) - lu(k,816) * lu(k,865) + lu(k,871) = lu(k,871) - lu(k,817) * lu(k,865) + lu(k,872) = lu(k,872) - lu(k,818) * lu(k,865) + lu(k,874) = lu(k,874) - lu(k,819) * lu(k,865) + lu(k,875) = - lu(k,820) * lu(k,865) + lu(k,876) = lu(k,876) - lu(k,821) * lu(k,865) + lu(k,877) = lu(k,877) - lu(k,822) * lu(k,865) + lu(k,878) = lu(k,878) - lu(k,823) * lu(k,865) + lu(k,879) = lu(k,879) - lu(k,824) * lu(k,865) + lu(k,881) = lu(k,881) - lu(k,825) * lu(k,865) + lu(k,882) = lu(k,882) - lu(k,826) * lu(k,865) + lu(k,884) = lu(k,884) - lu(k,827) * lu(k,865) + lu(k,885) = lu(k,885) - lu(k,828) * lu(k,865) + lu(k,886) = lu(k,886) - lu(k,829) * lu(k,865) + lu(k,925) = lu(k,925) - lu(k,812) * lu(k,924) + lu(k,926) = lu(k,926) - lu(k,813) * lu(k,924) + lu(k,928) = lu(k,928) - lu(k,814) * lu(k,924) + lu(k,930) = lu(k,930) - lu(k,815) * lu(k,924) + lu(k,931) = lu(k,931) - lu(k,816) * lu(k,924) + lu(k,932) = lu(k,932) - lu(k,817) * lu(k,924) + lu(k,933) = lu(k,933) - lu(k,818) * lu(k,924) + lu(k,935) = lu(k,935) - lu(k,819) * lu(k,924) + lu(k,936) = lu(k,936) - lu(k,820) * lu(k,924) + lu(k,937) = lu(k,937) - lu(k,821) * lu(k,924) + lu(k,938) = lu(k,938) - lu(k,822) * lu(k,924) + lu(k,939) = lu(k,939) - lu(k,823) * lu(k,924) + lu(k,940) = lu(k,940) - lu(k,824) * lu(k,924) + lu(k,942) = lu(k,942) - lu(k,825) * lu(k,924) + lu(k,943) = lu(k,943) - lu(k,826) * lu(k,924) + lu(k,946) = lu(k,946) - lu(k,827) * lu(k,924) + lu(k,947) = lu(k,947) - lu(k,828) * lu(k,924) + lu(k,948) = lu(k,948) - lu(k,829) * lu(k,924) + lu(k,1011) = lu(k,1011) - lu(k,812) * lu(k,1010) + lu(k,1012) = lu(k,1012) - lu(k,813) * lu(k,1010) + lu(k,1015) = lu(k,1015) - lu(k,814) * lu(k,1010) + lu(k,1017) = lu(k,1017) - lu(k,815) * lu(k,1010) + lu(k,1018) = lu(k,1018) - lu(k,816) * lu(k,1010) + lu(k,1019) = lu(k,1019) - lu(k,817) * lu(k,1010) + lu(k,1021) = lu(k,1021) - lu(k,818) * lu(k,1010) + lu(k,1023) = lu(k,1023) - lu(k,819) * lu(k,1010) + lu(k,1024) = lu(k,1024) - lu(k,820) * lu(k,1010) + lu(k,1025) = lu(k,1025) - lu(k,821) * lu(k,1010) + lu(k,1027) = lu(k,1027) - lu(k,822) * lu(k,1010) + lu(k,1028) = lu(k,1028) - lu(k,823) * lu(k,1010) + lu(k,1029) = lu(k,1029) - lu(k,824) * lu(k,1010) + lu(k,1031) = lu(k,1031) - lu(k,825) * lu(k,1010) + lu(k,1032) = lu(k,1032) - lu(k,826) * lu(k,1010) + lu(k,1036) = lu(k,1036) - lu(k,827) * lu(k,1010) + lu(k,1037) = - lu(k,828) * lu(k,1010) + lu(k,1038) = lu(k,1038) - lu(k,829) * lu(k,1010) + lu(k,1098) = - lu(k,812) * lu(k,1096) + lu(k,1100) = lu(k,1100) - lu(k,813) * lu(k,1096) + lu(k,1103) = lu(k,1103) - lu(k,814) * lu(k,1096) + lu(k,1105) = - lu(k,815) * lu(k,1096) + lu(k,1106) = - lu(k,816) * lu(k,1096) + lu(k,1107) = lu(k,1107) - lu(k,817) * lu(k,1096) + lu(k,1109) = - lu(k,818) * lu(k,1096) + lu(k,1111) = lu(k,1111) - lu(k,819) * lu(k,1096) + lu(k,1112) = lu(k,1112) - lu(k,820) * lu(k,1096) + lu(k,1113) = lu(k,1113) - lu(k,821) * lu(k,1096) + lu(k,1115) = lu(k,1115) - lu(k,822) * lu(k,1096) + lu(k,1116) = - lu(k,823) * lu(k,1096) + lu(k,1117) = - lu(k,824) * lu(k,1096) + lu(k,1119) = lu(k,1119) - lu(k,825) * lu(k,1096) + lu(k,1120) = lu(k,1120) - lu(k,826) * lu(k,1096) + lu(k,1124) = lu(k,1124) - lu(k,827) * lu(k,1096) + lu(k,1125) = lu(k,1125) - lu(k,828) * lu(k,1096) + lu(k,1126) = lu(k,1126) - lu(k,829) * lu(k,1096) + lu(k,1146) = lu(k,1146) - lu(k,812) * lu(k,1144) + lu(k,1148) = lu(k,1148) - lu(k,813) * lu(k,1144) + lu(k,1151) = lu(k,1151) - lu(k,814) * lu(k,1144) + lu(k,1153) = lu(k,1153) - lu(k,815) * lu(k,1144) + lu(k,1154) = lu(k,1154) - lu(k,816) * lu(k,1144) + lu(k,1155) = lu(k,1155) - lu(k,817) * lu(k,1144) + lu(k,1157) = lu(k,1157) - lu(k,818) * lu(k,1144) + lu(k,1159) = lu(k,1159) - lu(k,819) * lu(k,1144) + lu(k,1160) = lu(k,1160) - lu(k,820) * lu(k,1144) + lu(k,1161) = lu(k,1161) - lu(k,821) * lu(k,1144) + lu(k,1163) = lu(k,1163) - lu(k,822) * lu(k,1144) + lu(k,1164) = lu(k,1164) - lu(k,823) * lu(k,1144) + lu(k,1165) = lu(k,1165) - lu(k,824) * lu(k,1144) + lu(k,1167) = lu(k,1167) - lu(k,825) * lu(k,1144) + lu(k,1168) = lu(k,1168) - lu(k,826) * lu(k,1144) + lu(k,1172) = lu(k,1172) - lu(k,827) * lu(k,1144) + lu(k,1173) = lu(k,1173) - lu(k,828) * lu(k,1144) + lu(k,1174) = lu(k,1174) - lu(k,829) * lu(k,1144) + lu(k,1189) = lu(k,1189) - lu(k,812) * lu(k,1187) + lu(k,1191) = lu(k,1191) - lu(k,813) * lu(k,1187) + lu(k,1194) = lu(k,1194) - lu(k,814) * lu(k,1187) + lu(k,1196) = lu(k,1196) - lu(k,815) * lu(k,1187) + lu(k,1197) = lu(k,1197) - lu(k,816) * lu(k,1187) + lu(k,1198) = lu(k,1198) - lu(k,817) * lu(k,1187) + lu(k,1200) = lu(k,1200) - lu(k,818) * lu(k,1187) + lu(k,1202) = lu(k,1202) - lu(k,819) * lu(k,1187) + lu(k,1203) = lu(k,1203) - lu(k,820) * lu(k,1187) + lu(k,1204) = lu(k,1204) - lu(k,821) * lu(k,1187) + lu(k,1206) = lu(k,1206) - lu(k,822) * lu(k,1187) + lu(k,1207) = lu(k,1207) - lu(k,823) * lu(k,1187) + lu(k,1208) = lu(k,1208) - lu(k,824) * lu(k,1187) + lu(k,1210) = lu(k,1210) - lu(k,825) * lu(k,1187) + lu(k,1211) = lu(k,1211) - lu(k,826) * lu(k,1187) + lu(k,1215) = lu(k,1215) - lu(k,827) * lu(k,1187) + lu(k,1216) = lu(k,1216) - lu(k,828) * lu(k,1187) + lu(k,1217) = lu(k,1217) - lu(k,829) * lu(k,1187) + lu(k,1232) = lu(k,1232) - lu(k,812) * lu(k,1230) + lu(k,1234) = lu(k,1234) - lu(k,813) * lu(k,1230) + lu(k,1237) = lu(k,1237) - lu(k,814) * lu(k,1230) + lu(k,1239) = lu(k,1239) - lu(k,815) * lu(k,1230) + lu(k,1240) = lu(k,1240) - lu(k,816) * lu(k,1230) + lu(k,1241) = lu(k,1241) - lu(k,817) * lu(k,1230) + lu(k,1243) = lu(k,1243) - lu(k,818) * lu(k,1230) + lu(k,1245) = lu(k,1245) - lu(k,819) * lu(k,1230) + lu(k,1246) = lu(k,1246) - lu(k,820) * lu(k,1230) + lu(k,1247) = lu(k,1247) - lu(k,821) * lu(k,1230) + lu(k,1249) = lu(k,1249) - lu(k,822) * lu(k,1230) + lu(k,1250) = lu(k,1250) - lu(k,823) * lu(k,1230) + lu(k,1251) = lu(k,1251) - lu(k,824) * lu(k,1230) + lu(k,1253) = lu(k,1253) - lu(k,825) * lu(k,1230) + lu(k,1254) = lu(k,1254) - lu(k,826) * lu(k,1230) + lu(k,1258) = lu(k,1258) - lu(k,827) * lu(k,1230) + lu(k,1259) = lu(k,1259) - lu(k,828) * lu(k,1230) + lu(k,1260) = lu(k,1260) - lu(k,829) * lu(k,1230) + lu(k,1316) = lu(k,1316) - lu(k,812) * lu(k,1314) + lu(k,1318) = lu(k,1318) - lu(k,813) * lu(k,1314) + lu(k,1321) = lu(k,1321) - lu(k,814) * lu(k,1314) + lu(k,1323) = lu(k,1323) - lu(k,815) * lu(k,1314) + lu(k,1324) = lu(k,1324) - lu(k,816) * lu(k,1314) + lu(k,1325) = lu(k,1325) - lu(k,817) * lu(k,1314) + lu(k,1327) = lu(k,1327) - lu(k,818) * lu(k,1314) + lu(k,1329) = lu(k,1329) - lu(k,819) * lu(k,1314) + lu(k,1330) = lu(k,1330) - lu(k,820) * lu(k,1314) + lu(k,1331) = lu(k,1331) - lu(k,821) * lu(k,1314) + lu(k,1333) = lu(k,1333) - lu(k,822) * lu(k,1314) + lu(k,1334) = lu(k,1334) - lu(k,823) * lu(k,1314) + lu(k,1335) = lu(k,1335) - lu(k,824) * lu(k,1314) + lu(k,1337) = lu(k,1337) - lu(k,825) * lu(k,1314) + lu(k,1338) = lu(k,1338) - lu(k,826) * lu(k,1314) + lu(k,1342) = lu(k,1342) - lu(k,827) * lu(k,1314) + lu(k,1343) = lu(k,1343) - lu(k,828) * lu(k,1314) + lu(k,1344) = lu(k,1344) - lu(k,829) * lu(k,1314) + lu(k,1376) = lu(k,1376) - lu(k,812) * lu(k,1374) + lu(k,1378) = lu(k,1378) - lu(k,813) * lu(k,1374) + lu(k,1381) = lu(k,1381) - lu(k,814) * lu(k,1374) + lu(k,1383) = lu(k,1383) - lu(k,815) * lu(k,1374) + lu(k,1384) = - lu(k,816) * lu(k,1374) + lu(k,1385) = lu(k,1385) - lu(k,817) * lu(k,1374) + lu(k,1387) = - lu(k,818) * lu(k,1374) + lu(k,1389) = lu(k,1389) - lu(k,819) * lu(k,1374) + lu(k,1390) = lu(k,1390) - lu(k,820) * lu(k,1374) + lu(k,1391) = lu(k,1391) - lu(k,821) * lu(k,1374) + lu(k,1393) = lu(k,1393) - lu(k,822) * lu(k,1374) + lu(k,1394) = - lu(k,823) * lu(k,1374) + lu(k,1395) = - lu(k,824) * lu(k,1374) + lu(k,1397) = lu(k,1397) - lu(k,825) * lu(k,1374) + lu(k,1398) = lu(k,1398) - lu(k,826) * lu(k,1374) + lu(k,1402) = lu(k,1402) - lu(k,827) * lu(k,1374) + lu(k,1403) = lu(k,1403) - lu(k,828) * lu(k,1374) + lu(k,1404) = lu(k,1404) - lu(k,829) * lu(k,1374) + lu(k,1473) = - lu(k,812) * lu(k,1471) + lu(k,1475) = lu(k,1475) - lu(k,813) * lu(k,1471) + lu(k,1478) = lu(k,1478) - lu(k,814) * lu(k,1471) + lu(k,1480) = - lu(k,815) * lu(k,1471) + lu(k,1481) = - lu(k,816) * lu(k,1471) + lu(k,1482) = lu(k,1482) - lu(k,817) * lu(k,1471) + lu(k,1484) = - lu(k,818) * lu(k,1471) + lu(k,1486) = lu(k,1486) - lu(k,819) * lu(k,1471) + lu(k,1487) = lu(k,1487) - lu(k,820) * lu(k,1471) + lu(k,1488) = lu(k,1488) - lu(k,821) * lu(k,1471) + lu(k,1490) = lu(k,1490) - lu(k,822) * lu(k,1471) + lu(k,1491) = - lu(k,823) * lu(k,1471) + lu(k,1492) = - lu(k,824) * lu(k,1471) + lu(k,1494) = lu(k,1494) - lu(k,825) * lu(k,1471) + lu(k,1495) = lu(k,1495) - lu(k,826) * lu(k,1471) + lu(k,1499) = lu(k,1499) - lu(k,827) * lu(k,1471) + lu(k,1500) = lu(k,1500) - lu(k,828) * lu(k,1471) + lu(k,1501) = lu(k,1501) - lu(k,829) * lu(k,1471) + lu(k,1514) = lu(k,1514) - lu(k,812) * lu(k,1513) + lu(k,1516) = lu(k,1516) - lu(k,813) * lu(k,1513) + lu(k,1519) = lu(k,1519) - lu(k,814) * lu(k,1513) + lu(k,1521) = lu(k,1521) - lu(k,815) * lu(k,1513) + lu(k,1522) = lu(k,1522) - lu(k,816) * lu(k,1513) + lu(k,1523) = lu(k,1523) - lu(k,817) * lu(k,1513) + lu(k,1525) = lu(k,1525) - lu(k,818) * lu(k,1513) + lu(k,1527) = lu(k,1527) - lu(k,819) * lu(k,1513) + lu(k,1528) = lu(k,1528) - lu(k,820) * lu(k,1513) + lu(k,1529) = lu(k,1529) - lu(k,821) * lu(k,1513) + lu(k,1531) = lu(k,1531) - lu(k,822) * lu(k,1513) + lu(k,1532) = lu(k,1532) - lu(k,823) * lu(k,1513) + lu(k,1533) = lu(k,1533) - lu(k,824) * lu(k,1513) + lu(k,1535) = lu(k,1535) - lu(k,825) * lu(k,1513) + lu(k,1536) = lu(k,1536) - lu(k,826) * lu(k,1513) + lu(k,1540) = lu(k,1540) - lu(k,827) * lu(k,1513) + lu(k,1541) = lu(k,1541) - lu(k,828) * lu(k,1513) + lu(k,1542) = lu(k,1542) - lu(k,829) * lu(k,1513) + lu(k,1550) = lu(k,1550) - lu(k,812) * lu(k,1548) + lu(k,1552) = lu(k,1552) - lu(k,813) * lu(k,1548) + lu(k,1555) = lu(k,1555) - lu(k,814) * lu(k,1548) + lu(k,1557) = lu(k,1557) - lu(k,815) * lu(k,1548) + lu(k,1558) = lu(k,1558) - lu(k,816) * lu(k,1548) + lu(k,1559) = lu(k,1559) - lu(k,817) * lu(k,1548) + lu(k,1561) = lu(k,1561) - lu(k,818) * lu(k,1548) + lu(k,1563) = lu(k,1563) - lu(k,819) * lu(k,1548) + lu(k,1564) = lu(k,1564) - lu(k,820) * lu(k,1548) + lu(k,1565) = lu(k,1565) - lu(k,821) * lu(k,1548) + lu(k,1567) = lu(k,1567) - lu(k,822) * lu(k,1548) + lu(k,1568) = lu(k,1568) - lu(k,823) * lu(k,1548) + lu(k,1569) = lu(k,1569) - lu(k,824) * lu(k,1548) + lu(k,1571) = lu(k,1571) - lu(k,825) * lu(k,1548) + lu(k,1572) = lu(k,1572) - lu(k,826) * lu(k,1548) + lu(k,1576) = lu(k,1576) - lu(k,827) * lu(k,1548) + lu(k,1577) = lu(k,1577) - lu(k,828) * lu(k,1548) + lu(k,1578) = lu(k,1578) - lu(k,829) * lu(k,1548) + lu(k,1595) = lu(k,1595) - lu(k,812) * lu(k,1593) + lu(k,1597) = lu(k,1597) - lu(k,813) * lu(k,1593) + lu(k,1600) = lu(k,1600) - lu(k,814) * lu(k,1593) + lu(k,1602) = lu(k,1602) - lu(k,815) * lu(k,1593) + lu(k,1603) = lu(k,1603) - lu(k,816) * lu(k,1593) + lu(k,1604) = lu(k,1604) - lu(k,817) * lu(k,1593) + lu(k,1606) = lu(k,1606) - lu(k,818) * lu(k,1593) + lu(k,1608) = lu(k,1608) - lu(k,819) * lu(k,1593) + lu(k,1609) = lu(k,1609) - lu(k,820) * lu(k,1593) + lu(k,1610) = lu(k,1610) - lu(k,821) * lu(k,1593) + lu(k,1612) = lu(k,1612) - lu(k,822) * lu(k,1593) + lu(k,1613) = lu(k,1613) - lu(k,823) * lu(k,1593) + lu(k,1614) = lu(k,1614) - lu(k,824) * lu(k,1593) + lu(k,1616) = lu(k,1616) - lu(k,825) * lu(k,1593) + lu(k,1617) = lu(k,1617) - lu(k,826) * lu(k,1593) + lu(k,1621) = lu(k,1621) - lu(k,827) * lu(k,1593) + lu(k,1622) = lu(k,1622) - lu(k,828) * lu(k,1593) + lu(k,1623) = lu(k,1623) - lu(k,829) * lu(k,1593) + lu(k,1638) = lu(k,1638) - lu(k,812) * lu(k,1636) + lu(k,1640) = lu(k,1640) - lu(k,813) * lu(k,1636) + lu(k,1643) = lu(k,1643) - lu(k,814) * lu(k,1636) + lu(k,1645) = lu(k,1645) - lu(k,815) * lu(k,1636) + lu(k,1646) = lu(k,1646) - lu(k,816) * lu(k,1636) + lu(k,1647) = lu(k,1647) - lu(k,817) * lu(k,1636) + lu(k,1649) = lu(k,1649) - lu(k,818) * lu(k,1636) + lu(k,1651) = lu(k,1651) - lu(k,819) * lu(k,1636) + lu(k,1652) = lu(k,1652) - lu(k,820) * lu(k,1636) + lu(k,1653) = lu(k,1653) - lu(k,821) * lu(k,1636) + lu(k,1655) = lu(k,1655) - lu(k,822) * lu(k,1636) + lu(k,1656) = lu(k,1656) - lu(k,823) * lu(k,1636) + lu(k,1657) = lu(k,1657) - lu(k,824) * lu(k,1636) + lu(k,1659) = lu(k,1659) - lu(k,825) * lu(k,1636) + lu(k,1660) = lu(k,1660) - lu(k,826) * lu(k,1636) + lu(k,1664) = lu(k,1664) - lu(k,827) * lu(k,1636) + lu(k,1665) = lu(k,1665) - lu(k,828) * lu(k,1636) + lu(k,1666) = lu(k,1666) - lu(k,829) * lu(k,1636) + lu(k,1681) = lu(k,1681) - lu(k,812) * lu(k,1679) + lu(k,1683) = lu(k,1683) - lu(k,813) * lu(k,1679) + lu(k,1686) = lu(k,1686) - lu(k,814) * lu(k,1679) + lu(k,1688) = lu(k,1688) - lu(k,815) * lu(k,1679) + lu(k,1689) = lu(k,1689) - lu(k,816) * lu(k,1679) + lu(k,1690) = lu(k,1690) - lu(k,817) * lu(k,1679) + lu(k,1692) = lu(k,1692) - lu(k,818) * lu(k,1679) + lu(k,1694) = lu(k,1694) - lu(k,819) * lu(k,1679) + lu(k,1695) = lu(k,1695) - lu(k,820) * lu(k,1679) + lu(k,1696) = lu(k,1696) - lu(k,821) * lu(k,1679) + lu(k,1698) = lu(k,1698) - lu(k,822) * lu(k,1679) + lu(k,1699) = lu(k,1699) - lu(k,823) * lu(k,1679) + lu(k,1700) = lu(k,1700) - lu(k,824) * lu(k,1679) + lu(k,1702) = lu(k,1702) - lu(k,825) * lu(k,1679) + lu(k,1703) = lu(k,1703) - lu(k,826) * lu(k,1679) + lu(k,1707) = lu(k,1707) - lu(k,827) * lu(k,1679) + lu(k,1708) = lu(k,1708) - lu(k,828) * lu(k,1679) + lu(k,1709) = lu(k,1709) - lu(k,829) * lu(k,1679) + lu(k,1757) = lu(k,1757) - lu(k,812) * lu(k,1755) + lu(k,1759) = lu(k,1759) - lu(k,813) * lu(k,1755) + lu(k,1762) = lu(k,1762) - lu(k,814) * lu(k,1755) + lu(k,1764) = - lu(k,815) * lu(k,1755) + lu(k,1765) = - lu(k,816) * lu(k,1755) + lu(k,1766) = lu(k,1766) - lu(k,817) * lu(k,1755) + lu(k,1768) = lu(k,1768) - lu(k,818) * lu(k,1755) + lu(k,1770) = lu(k,1770) - lu(k,819) * lu(k,1755) + lu(k,1771) = lu(k,1771) - lu(k,820) * lu(k,1755) + lu(k,1772) = lu(k,1772) - lu(k,821) * lu(k,1755) + lu(k,1774) = lu(k,1774) - lu(k,822) * lu(k,1755) + lu(k,1775) = - lu(k,823) * lu(k,1755) + lu(k,1776) = - lu(k,824) * lu(k,1755) + lu(k,1778) = lu(k,1778) - lu(k,825) * lu(k,1755) + lu(k,1779) = lu(k,1779) - lu(k,826) * lu(k,1755) + lu(k,1783) = lu(k,1783) - lu(k,827) * lu(k,1755) + lu(k,1784) = lu(k,1784) - lu(k,828) * lu(k,1755) + lu(k,1785) = lu(k,1785) - lu(k,829) * lu(k,1755) + lu(k,1805) = lu(k,1805) - lu(k,812) * lu(k,1804) + lu(k,1807) = lu(k,1807) - lu(k,813) * lu(k,1804) + lu(k,1810) = lu(k,1810) - lu(k,814) * lu(k,1804) + lu(k,1812) = lu(k,1812) - lu(k,815) * lu(k,1804) + lu(k,1813) = lu(k,1813) - lu(k,816) * lu(k,1804) + lu(k,1814) = lu(k,1814) - lu(k,817) * lu(k,1804) + lu(k,1816) = lu(k,1816) - lu(k,818) * lu(k,1804) + lu(k,1818) = lu(k,1818) - lu(k,819) * lu(k,1804) + lu(k,1819) = lu(k,1819) - lu(k,820) * lu(k,1804) + lu(k,1820) = lu(k,1820) - lu(k,821) * lu(k,1804) + lu(k,1822) = lu(k,1822) - lu(k,822) * lu(k,1804) + lu(k,1823) = lu(k,1823) - lu(k,823) * lu(k,1804) + lu(k,1824) = lu(k,1824) - lu(k,824) * lu(k,1804) + lu(k,1826) = lu(k,1826) - lu(k,825) * lu(k,1804) + lu(k,1827) = lu(k,1827) - lu(k,826) * lu(k,1804) + lu(k,1831) = lu(k,1831) - lu(k,827) * lu(k,1804) + lu(k,1832) = lu(k,1832) - lu(k,828) * lu(k,1804) + lu(k,1833) = lu(k,1833) - lu(k,829) * lu(k,1804) + lu(k,1838) = lu(k,1838) - lu(k,812) * lu(k,1837) + lu(k,1840) = lu(k,1840) - lu(k,813) * lu(k,1837) + lu(k,1843) = lu(k,1843) - lu(k,814) * lu(k,1837) + lu(k,1845) = lu(k,1845) - lu(k,815) * lu(k,1837) + lu(k,1846) = lu(k,1846) - lu(k,816) * lu(k,1837) + lu(k,1847) = lu(k,1847) - lu(k,817) * lu(k,1837) + lu(k,1849) = lu(k,1849) - lu(k,818) * lu(k,1837) + lu(k,1851) = lu(k,1851) - lu(k,819) * lu(k,1837) + lu(k,1852) = lu(k,1852) - lu(k,820) * lu(k,1837) + lu(k,1853) = - lu(k,821) * lu(k,1837) + lu(k,1855) = lu(k,1855) - lu(k,822) * lu(k,1837) + lu(k,1856) = lu(k,1856) - lu(k,823) * lu(k,1837) + lu(k,1857) = lu(k,1857) - lu(k,824) * lu(k,1837) + lu(k,1859) = lu(k,1859) - lu(k,825) * lu(k,1837) + lu(k,1860) = lu(k,1860) - lu(k,826) * lu(k,1837) + lu(k,1864) = lu(k,1864) - lu(k,827) * lu(k,1837) + lu(k,1865) = lu(k,1865) - lu(k,828) * lu(k,1837) + lu(k,1866) = lu(k,1866) - lu(k,829) * lu(k,1837) + lu(k,1874) = lu(k,1874) - lu(k,812) * lu(k,1873) + lu(k,1876) = lu(k,1876) - lu(k,813) * lu(k,1873) + lu(k,1879) = lu(k,1879) - lu(k,814) * lu(k,1873) + lu(k,1881) = - lu(k,815) * lu(k,1873) + lu(k,1882) = - lu(k,816) * lu(k,1873) + lu(k,1883) = lu(k,1883) - lu(k,817) * lu(k,1873) + lu(k,1885) = - lu(k,818) * lu(k,1873) + lu(k,1887) = lu(k,1887) - lu(k,819) * lu(k,1873) + lu(k,1888) = lu(k,1888) - lu(k,820) * lu(k,1873) + lu(k,1889) = lu(k,1889) - lu(k,821) * lu(k,1873) + lu(k,1891) = lu(k,1891) - lu(k,822) * lu(k,1873) + lu(k,1892) = - lu(k,823) * lu(k,1873) + lu(k,1893) = - lu(k,824) * lu(k,1873) + lu(k,1895) = lu(k,1895) - lu(k,825) * lu(k,1873) + lu(k,1896) = lu(k,1896) - lu(k,826) * lu(k,1873) + lu(k,1900) = lu(k,1900) - lu(k,827) * lu(k,1873) + lu(k,1901) = lu(k,1901) - lu(k,828) * lu(k,1873) + lu(k,1902) = lu(k,1902) - lu(k,829) * lu(k,1873) + lu(k,1957) = lu(k,1957) - lu(k,812) * lu(k,1956) + lu(k,1959) = lu(k,1959) - lu(k,813) * lu(k,1956) + lu(k,1962) = lu(k,1962) - lu(k,814) * lu(k,1956) + lu(k,1964) = lu(k,1964) - lu(k,815) * lu(k,1956) + lu(k,1965) = lu(k,1965) - lu(k,816) * lu(k,1956) + lu(k,1966) = lu(k,1966) - lu(k,817) * lu(k,1956) + lu(k,1968) = lu(k,1968) - lu(k,818) * lu(k,1956) + lu(k,1970) = lu(k,1970) - lu(k,819) * lu(k,1956) + lu(k,1971) = lu(k,1971) - lu(k,820) * lu(k,1956) + lu(k,1972) = lu(k,1972) - lu(k,821) * lu(k,1956) + lu(k,1974) = lu(k,1974) - lu(k,822) * lu(k,1956) + lu(k,1975) = lu(k,1975) - lu(k,823) * lu(k,1956) + lu(k,1976) = lu(k,1976) - lu(k,824) * lu(k,1956) + lu(k,1978) = lu(k,1978) - lu(k,825) * lu(k,1956) + lu(k,1979) = lu(k,1979) - lu(k,826) * lu(k,1956) + lu(k,1983) = lu(k,1983) - lu(k,827) * lu(k,1956) + lu(k,1984) = lu(k,1984) - lu(k,828) * lu(k,1956) + lu(k,1985) = lu(k,1985) - lu(k,829) * lu(k,1956) + lu(k,2002) = lu(k,2002) - lu(k,812) * lu(k,2000) + lu(k,2004) = lu(k,2004) - lu(k,813) * lu(k,2000) + lu(k,2007) = lu(k,2007) - lu(k,814) * lu(k,2000) + lu(k,2009) = lu(k,2009) - lu(k,815) * lu(k,2000) + lu(k,2010) = lu(k,2010) - lu(k,816) * lu(k,2000) + lu(k,2011) = lu(k,2011) - lu(k,817) * lu(k,2000) + lu(k,2013) = lu(k,2013) - lu(k,818) * lu(k,2000) + lu(k,2015) = lu(k,2015) - lu(k,819) * lu(k,2000) + lu(k,2016) = lu(k,2016) - lu(k,820) * lu(k,2000) + lu(k,2017) = lu(k,2017) - lu(k,821) * lu(k,2000) + lu(k,2019) = lu(k,2019) - lu(k,822) * lu(k,2000) + lu(k,2020) = lu(k,2020) - lu(k,823) * lu(k,2000) + lu(k,2021) = lu(k,2021) - lu(k,824) * lu(k,2000) + lu(k,2023) = lu(k,2023) - lu(k,825) * lu(k,2000) + lu(k,2024) = lu(k,2024) - lu(k,826) * lu(k,2000) + lu(k,2028) = lu(k,2028) - lu(k,827) * lu(k,2000) + lu(k,2029) = lu(k,2029) - lu(k,828) * lu(k,2000) + lu(k,2030) = lu(k,2030) - lu(k,829) * lu(k,2000) + lu(k,2062) = lu(k,2062) - lu(k,812) * lu(k,2061) + lu(k,2064) = lu(k,2064) - lu(k,813) * lu(k,2061) + lu(k,2067) = lu(k,2067) - lu(k,814) * lu(k,2061) + lu(k,2069) = lu(k,2069) - lu(k,815) * lu(k,2061) + lu(k,2070) = lu(k,2070) - lu(k,816) * lu(k,2061) + lu(k,2071) = lu(k,2071) - lu(k,817) * lu(k,2061) + lu(k,2073) = lu(k,2073) - lu(k,818) * lu(k,2061) + lu(k,2075) = lu(k,2075) - lu(k,819) * lu(k,2061) + lu(k,2076) = lu(k,2076) - lu(k,820) * lu(k,2061) + lu(k,2077) = lu(k,2077) - lu(k,821) * lu(k,2061) + lu(k,2079) = lu(k,2079) - lu(k,822) * lu(k,2061) + lu(k,2080) = lu(k,2080) - lu(k,823) * lu(k,2061) + lu(k,2081) = lu(k,2081) - lu(k,824) * lu(k,2061) + lu(k,2083) = lu(k,2083) - lu(k,825) * lu(k,2061) + lu(k,2084) = lu(k,2084) - lu(k,826) * lu(k,2061) + lu(k,2088) = lu(k,2088) - lu(k,827) * lu(k,2061) + lu(k,2089) = lu(k,2089) - lu(k,828) * lu(k,2061) + lu(k,2090) = lu(k,2090) - lu(k,829) * lu(k,2061) + lu(k,833) = 1._r8 / lu(k,833) + lu(k,834) = lu(k,834) * lu(k,833) + lu(k,835) = lu(k,835) * lu(k,833) + lu(k,836) = lu(k,836) * lu(k,833) + lu(k,837) = lu(k,837) * lu(k,833) + lu(k,838) = lu(k,838) * lu(k,833) + lu(k,839) = lu(k,839) * lu(k,833) + lu(k,840) = lu(k,840) * lu(k,833) + lu(k,841) = lu(k,841) * lu(k,833) + lu(k,842) = lu(k,842) * lu(k,833) + lu(k,843) = lu(k,843) * lu(k,833) + lu(k,844) = lu(k,844) * lu(k,833) + lu(k,845) = lu(k,845) * lu(k,833) + lu(k,846) = lu(k,846) * lu(k,833) + lu(k,847) = lu(k,847) * lu(k,833) + lu(k,848) = lu(k,848) * lu(k,833) + lu(k,849) = lu(k,849) * lu(k,833) + lu(k,850) = lu(k,850) * lu(k,833) + lu(k,851) = lu(k,851) * lu(k,833) + lu(k,852) = lu(k,852) * lu(k,833) + lu(k,853) = lu(k,853) * lu(k,833) + lu(k,854) = lu(k,854) * lu(k,833) + lu(k,855) = lu(k,855) * lu(k,833) + lu(k,856) = lu(k,856) * lu(k,833) + lu(k,857) = lu(k,857) * lu(k,833) + lu(k,858) = lu(k,858) * lu(k,833) + lu(k,859) = lu(k,859) * lu(k,833) + lu(k,860) = lu(k,860) * lu(k,833) + lu(k,861) = lu(k,861) * lu(k,833) + lu(k,1098) = lu(k,1098) - lu(k,834) * lu(k,1097) + lu(k,1099) = lu(k,1099) - lu(k,835) * lu(k,1097) + lu(k,1100) = lu(k,1100) - lu(k,836) * lu(k,1097) + lu(k,1101) = lu(k,1101) - lu(k,837) * lu(k,1097) + lu(k,1102) = lu(k,1102) - lu(k,838) * lu(k,1097) + lu(k,1103) = lu(k,1103) - lu(k,839) * lu(k,1097) + lu(k,1104) = lu(k,1104) - lu(k,840) * lu(k,1097) + lu(k,1105) = lu(k,1105) - lu(k,841) * lu(k,1097) + lu(k,1106) = lu(k,1106) - lu(k,842) * lu(k,1097) + lu(k,1107) = lu(k,1107) - lu(k,843) * lu(k,1097) + lu(k,1108) = lu(k,1108) - lu(k,844) * lu(k,1097) + lu(k,1109) = lu(k,1109) - lu(k,845) * lu(k,1097) + lu(k,1110) = lu(k,1110) - lu(k,846) * lu(k,1097) + lu(k,1111) = lu(k,1111) - lu(k,847) * lu(k,1097) + lu(k,1112) = lu(k,1112) - lu(k,848) * lu(k,1097) + lu(k,1113) = lu(k,1113) - lu(k,849) * lu(k,1097) + lu(k,1114) = lu(k,1114) - lu(k,850) * lu(k,1097) + lu(k,1115) = lu(k,1115) - lu(k,851) * lu(k,1097) + lu(k,1116) = lu(k,1116) - lu(k,852) * lu(k,1097) + lu(k,1117) = lu(k,1117) - lu(k,853) * lu(k,1097) + lu(k,1119) = lu(k,1119) - lu(k,854) * lu(k,1097) + lu(k,1120) = lu(k,1120) - lu(k,855) * lu(k,1097) + lu(k,1121) = lu(k,1121) - lu(k,856) * lu(k,1097) + lu(k,1122) = lu(k,1122) - lu(k,857) * lu(k,1097) + lu(k,1123) = lu(k,1123) - lu(k,858) * lu(k,1097) + lu(k,1124) = lu(k,1124) - lu(k,859) * lu(k,1097) + lu(k,1125) = lu(k,1125) - lu(k,860) * lu(k,1097) + lu(k,1126) = lu(k,1126) - lu(k,861) * lu(k,1097) + lu(k,1146) = lu(k,1146) - lu(k,834) * lu(k,1145) + lu(k,1147) = lu(k,1147) - lu(k,835) * lu(k,1145) + lu(k,1148) = lu(k,1148) - lu(k,836) * lu(k,1145) + lu(k,1149) = lu(k,1149) - lu(k,837) * lu(k,1145) + lu(k,1150) = lu(k,1150) - lu(k,838) * lu(k,1145) + lu(k,1151) = lu(k,1151) - lu(k,839) * lu(k,1145) + lu(k,1152) = lu(k,1152) - lu(k,840) * lu(k,1145) + lu(k,1153) = lu(k,1153) - lu(k,841) * lu(k,1145) + lu(k,1154) = lu(k,1154) - lu(k,842) * lu(k,1145) + lu(k,1155) = lu(k,1155) - lu(k,843) * lu(k,1145) + lu(k,1156) = lu(k,1156) - lu(k,844) * lu(k,1145) + lu(k,1157) = lu(k,1157) - lu(k,845) * lu(k,1145) + lu(k,1158) = lu(k,1158) - lu(k,846) * lu(k,1145) + lu(k,1159) = lu(k,1159) - lu(k,847) * lu(k,1145) + lu(k,1160) = lu(k,1160) - lu(k,848) * lu(k,1145) + lu(k,1161) = lu(k,1161) - lu(k,849) * lu(k,1145) + lu(k,1162) = lu(k,1162) - lu(k,850) * lu(k,1145) + lu(k,1163) = lu(k,1163) - lu(k,851) * lu(k,1145) + lu(k,1164) = lu(k,1164) - lu(k,852) * lu(k,1145) + lu(k,1165) = lu(k,1165) - lu(k,853) * lu(k,1145) + lu(k,1167) = lu(k,1167) - lu(k,854) * lu(k,1145) + lu(k,1168) = lu(k,1168) - lu(k,855) * lu(k,1145) + lu(k,1169) = lu(k,1169) - lu(k,856) * lu(k,1145) + lu(k,1170) = lu(k,1170) - lu(k,857) * lu(k,1145) + lu(k,1171) = lu(k,1171) - lu(k,858) * lu(k,1145) + lu(k,1172) = lu(k,1172) - lu(k,859) * lu(k,1145) + lu(k,1173) = lu(k,1173) - lu(k,860) * lu(k,1145) + lu(k,1174) = lu(k,1174) - lu(k,861) * lu(k,1145) + lu(k,1189) = lu(k,1189) - lu(k,834) * lu(k,1188) + lu(k,1190) = - lu(k,835) * lu(k,1188) + lu(k,1191) = lu(k,1191) - lu(k,836) * lu(k,1188) + lu(k,1192) = lu(k,1192) - lu(k,837) * lu(k,1188) + lu(k,1193) = lu(k,1193) - lu(k,838) * lu(k,1188) + lu(k,1194) = lu(k,1194) - lu(k,839) * lu(k,1188) + lu(k,1195) = - lu(k,840) * lu(k,1188) + lu(k,1196) = lu(k,1196) - lu(k,841) * lu(k,1188) + lu(k,1197) = lu(k,1197) - lu(k,842) * lu(k,1188) + lu(k,1198) = lu(k,1198) - lu(k,843) * lu(k,1188) + lu(k,1199) = lu(k,1199) - lu(k,844) * lu(k,1188) + lu(k,1200) = lu(k,1200) - lu(k,845) * lu(k,1188) + lu(k,1201) = lu(k,1201) - lu(k,846) * lu(k,1188) + lu(k,1202) = lu(k,1202) - lu(k,847) * lu(k,1188) + lu(k,1203) = lu(k,1203) - lu(k,848) * lu(k,1188) + lu(k,1204) = lu(k,1204) - lu(k,849) * lu(k,1188) + lu(k,1205) = lu(k,1205) - lu(k,850) * lu(k,1188) + lu(k,1206) = lu(k,1206) - lu(k,851) * lu(k,1188) + lu(k,1207) = lu(k,1207) - lu(k,852) * lu(k,1188) + lu(k,1208) = lu(k,1208) - lu(k,853) * lu(k,1188) + lu(k,1210) = lu(k,1210) - lu(k,854) * lu(k,1188) + lu(k,1211) = lu(k,1211) - lu(k,855) * lu(k,1188) + lu(k,1212) = - lu(k,856) * lu(k,1188) + lu(k,1213) = - lu(k,857) * lu(k,1188) + lu(k,1214) = - lu(k,858) * lu(k,1188) + lu(k,1215) = lu(k,1215) - lu(k,859) * lu(k,1188) + lu(k,1216) = lu(k,1216) - lu(k,860) * lu(k,1188) + lu(k,1217) = lu(k,1217) - lu(k,861) * lu(k,1188) + lu(k,1232) = lu(k,1232) - lu(k,834) * lu(k,1231) + lu(k,1233) = - lu(k,835) * lu(k,1231) + lu(k,1234) = lu(k,1234) - lu(k,836) * lu(k,1231) + lu(k,1235) = lu(k,1235) - lu(k,837) * lu(k,1231) + lu(k,1236) = lu(k,1236) - lu(k,838) * lu(k,1231) + lu(k,1237) = lu(k,1237) - lu(k,839) * lu(k,1231) + lu(k,1238) = - lu(k,840) * lu(k,1231) + lu(k,1239) = lu(k,1239) - lu(k,841) * lu(k,1231) + lu(k,1240) = lu(k,1240) - lu(k,842) * lu(k,1231) + lu(k,1241) = lu(k,1241) - lu(k,843) * lu(k,1231) + lu(k,1242) = lu(k,1242) - lu(k,844) * lu(k,1231) + lu(k,1243) = lu(k,1243) - lu(k,845) * lu(k,1231) + lu(k,1244) = lu(k,1244) - lu(k,846) * lu(k,1231) + lu(k,1245) = lu(k,1245) - lu(k,847) * lu(k,1231) + lu(k,1246) = lu(k,1246) - lu(k,848) * lu(k,1231) + lu(k,1247) = lu(k,1247) - lu(k,849) * lu(k,1231) + lu(k,1248) = lu(k,1248) - lu(k,850) * lu(k,1231) + lu(k,1249) = lu(k,1249) - lu(k,851) * lu(k,1231) + lu(k,1250) = lu(k,1250) - lu(k,852) * lu(k,1231) + lu(k,1251) = lu(k,1251) - lu(k,853) * lu(k,1231) + lu(k,1253) = lu(k,1253) - lu(k,854) * lu(k,1231) + lu(k,1254) = lu(k,1254) - lu(k,855) * lu(k,1231) + lu(k,1255) = - lu(k,856) * lu(k,1231) + lu(k,1256) = - lu(k,857) * lu(k,1231) + lu(k,1257) = - lu(k,858) * lu(k,1231) + lu(k,1258) = lu(k,1258) - lu(k,859) * lu(k,1231) + lu(k,1259) = lu(k,1259) - lu(k,860) * lu(k,1231) + lu(k,1260) = lu(k,1260) - lu(k,861) * lu(k,1231) + lu(k,1274) = lu(k,1274) - lu(k,834) * lu(k,1273) + lu(k,1275) = lu(k,1275) - lu(k,835) * lu(k,1273) + lu(k,1276) = lu(k,1276) - lu(k,836) * lu(k,1273) + lu(k,1277) = lu(k,1277) - lu(k,837) * lu(k,1273) + lu(k,1278) = lu(k,1278) - lu(k,838) * lu(k,1273) + lu(k,1279) = lu(k,1279) - lu(k,839) * lu(k,1273) + lu(k,1280) = lu(k,1280) - lu(k,840) * lu(k,1273) + lu(k,1281) = lu(k,1281) - lu(k,841) * lu(k,1273) + lu(k,1282) = lu(k,1282) - lu(k,842) * lu(k,1273) + lu(k,1283) = lu(k,1283) - lu(k,843) * lu(k,1273) + lu(k,1284) = lu(k,1284) - lu(k,844) * lu(k,1273) + lu(k,1285) = lu(k,1285) - lu(k,845) * lu(k,1273) + lu(k,1286) = lu(k,1286) - lu(k,846) * lu(k,1273) + lu(k,1287) = lu(k,1287) - lu(k,847) * lu(k,1273) + lu(k,1288) = lu(k,1288) - lu(k,848) * lu(k,1273) + lu(k,1289) = lu(k,1289) - lu(k,849) * lu(k,1273) + lu(k,1290) = lu(k,1290) - lu(k,850) * lu(k,1273) + lu(k,1291) = lu(k,1291) - lu(k,851) * lu(k,1273) + lu(k,1292) = lu(k,1292) - lu(k,852) * lu(k,1273) + lu(k,1293) = lu(k,1293) - lu(k,853) * lu(k,1273) + lu(k,1295) = lu(k,1295) - lu(k,854) * lu(k,1273) + lu(k,1296) = lu(k,1296) - lu(k,855) * lu(k,1273) + lu(k,1297) = lu(k,1297) - lu(k,856) * lu(k,1273) + lu(k,1298) = lu(k,1298) - lu(k,857) * lu(k,1273) + lu(k,1299) = lu(k,1299) - lu(k,858) * lu(k,1273) + lu(k,1300) = lu(k,1300) - lu(k,859) * lu(k,1273) + lu(k,1301) = lu(k,1301) - lu(k,860) * lu(k,1273) + lu(k,1302) = lu(k,1302) - lu(k,861) * lu(k,1273) + lu(k,1316) = lu(k,1316) - lu(k,834) * lu(k,1315) + lu(k,1317) = lu(k,1317) - lu(k,835) * lu(k,1315) + lu(k,1318) = lu(k,1318) - lu(k,836) * lu(k,1315) + lu(k,1319) = lu(k,1319) - lu(k,837) * lu(k,1315) + lu(k,1320) = lu(k,1320) - lu(k,838) * lu(k,1315) + lu(k,1321) = lu(k,1321) - lu(k,839) * lu(k,1315) + lu(k,1322) = - lu(k,840) * lu(k,1315) + lu(k,1323) = lu(k,1323) - lu(k,841) * lu(k,1315) + lu(k,1324) = lu(k,1324) - lu(k,842) * lu(k,1315) + lu(k,1325) = lu(k,1325) - lu(k,843) * lu(k,1315) + lu(k,1326) = lu(k,1326) - lu(k,844) * lu(k,1315) + lu(k,1327) = lu(k,1327) - lu(k,845) * lu(k,1315) + lu(k,1328) = lu(k,1328) - lu(k,846) * lu(k,1315) + lu(k,1329) = lu(k,1329) - lu(k,847) * lu(k,1315) + lu(k,1330) = lu(k,1330) - lu(k,848) * lu(k,1315) + lu(k,1331) = lu(k,1331) - lu(k,849) * lu(k,1315) + lu(k,1332) = lu(k,1332) - lu(k,850) * lu(k,1315) + lu(k,1333) = lu(k,1333) - lu(k,851) * lu(k,1315) + lu(k,1334) = lu(k,1334) - lu(k,852) * lu(k,1315) + lu(k,1335) = lu(k,1335) - lu(k,853) * lu(k,1315) + lu(k,1337) = lu(k,1337) - lu(k,854) * lu(k,1315) + lu(k,1338) = lu(k,1338) - lu(k,855) * lu(k,1315) + lu(k,1339) = - lu(k,856) * lu(k,1315) + lu(k,1340) = - lu(k,857) * lu(k,1315) + lu(k,1341) = - lu(k,858) * lu(k,1315) + lu(k,1342) = lu(k,1342) - lu(k,859) * lu(k,1315) + lu(k,1343) = lu(k,1343) - lu(k,860) * lu(k,1315) + lu(k,1344) = lu(k,1344) - lu(k,861) * lu(k,1315) + lu(k,1376) = lu(k,1376) - lu(k,834) * lu(k,1375) + lu(k,1377) = lu(k,1377) - lu(k,835) * lu(k,1375) + lu(k,1378) = lu(k,1378) - lu(k,836) * lu(k,1375) + lu(k,1379) = lu(k,1379) - lu(k,837) * lu(k,1375) + lu(k,1380) = lu(k,1380) - lu(k,838) * lu(k,1375) + lu(k,1381) = lu(k,1381) - lu(k,839) * lu(k,1375) + lu(k,1382) = lu(k,1382) - lu(k,840) * lu(k,1375) + lu(k,1383) = lu(k,1383) - lu(k,841) * lu(k,1375) + lu(k,1384) = lu(k,1384) - lu(k,842) * lu(k,1375) + lu(k,1385) = lu(k,1385) - lu(k,843) * lu(k,1375) + lu(k,1386) = lu(k,1386) - lu(k,844) * lu(k,1375) + lu(k,1387) = lu(k,1387) - lu(k,845) * lu(k,1375) + lu(k,1388) = lu(k,1388) - lu(k,846) * lu(k,1375) + lu(k,1389) = lu(k,1389) - lu(k,847) * lu(k,1375) + lu(k,1390) = lu(k,1390) - lu(k,848) * lu(k,1375) + lu(k,1391) = lu(k,1391) - lu(k,849) * lu(k,1375) + lu(k,1392) = lu(k,1392) - lu(k,850) * lu(k,1375) + lu(k,1393) = lu(k,1393) - lu(k,851) * lu(k,1375) + lu(k,1394) = lu(k,1394) - lu(k,852) * lu(k,1375) + lu(k,1395) = lu(k,1395) - lu(k,853) * lu(k,1375) + lu(k,1397) = lu(k,1397) - lu(k,854) * lu(k,1375) + lu(k,1398) = lu(k,1398) - lu(k,855) * lu(k,1375) + lu(k,1399) = lu(k,1399) - lu(k,856) * lu(k,1375) + lu(k,1400) = lu(k,1400) - lu(k,857) * lu(k,1375) + lu(k,1401) = lu(k,1401) - lu(k,858) * lu(k,1375) + lu(k,1402) = lu(k,1402) - lu(k,859) * lu(k,1375) + lu(k,1403) = lu(k,1403) - lu(k,860) * lu(k,1375) + lu(k,1404) = lu(k,1404) - lu(k,861) * lu(k,1375) + lu(k,1425) = lu(k,1425) - lu(k,834) * lu(k,1424) + lu(k,1426) = lu(k,1426) - lu(k,835) * lu(k,1424) + lu(k,1427) = lu(k,1427) - lu(k,836) * lu(k,1424) + lu(k,1428) = lu(k,1428) - lu(k,837) * lu(k,1424) + lu(k,1429) = lu(k,1429) - lu(k,838) * lu(k,1424) + lu(k,1430) = lu(k,1430) - lu(k,839) * lu(k,1424) + lu(k,1431) = lu(k,1431) - lu(k,840) * lu(k,1424) + lu(k,1432) = lu(k,1432) - lu(k,841) * lu(k,1424) + lu(k,1433) = - lu(k,842) * lu(k,1424) + lu(k,1434) = lu(k,1434) - lu(k,843) * lu(k,1424) + lu(k,1435) = lu(k,1435) - lu(k,844) * lu(k,1424) + lu(k,1436) = - lu(k,845) * lu(k,1424) + lu(k,1437) = lu(k,1437) - lu(k,846) * lu(k,1424) + lu(k,1438) = lu(k,1438) - lu(k,847) * lu(k,1424) + lu(k,1439) = lu(k,1439) - lu(k,848) * lu(k,1424) + lu(k,1440) = lu(k,1440) - lu(k,849) * lu(k,1424) + lu(k,1441) = lu(k,1441) - lu(k,850) * lu(k,1424) + lu(k,1442) = lu(k,1442) - lu(k,851) * lu(k,1424) + lu(k,1443) = - lu(k,852) * lu(k,1424) + lu(k,1444) = - lu(k,853) * lu(k,1424) + lu(k,1446) = lu(k,1446) - lu(k,854) * lu(k,1424) + lu(k,1447) = lu(k,1447) - lu(k,855) * lu(k,1424) + lu(k,1448) = lu(k,1448) - lu(k,856) * lu(k,1424) + lu(k,1449) = lu(k,1449) - lu(k,857) * lu(k,1424) + lu(k,1450) = lu(k,1450) - lu(k,858) * lu(k,1424) + lu(k,1451) = lu(k,1451) - lu(k,859) * lu(k,1424) + lu(k,1452) = lu(k,1452) - lu(k,860) * lu(k,1424) + lu(k,1453) = lu(k,1453) - lu(k,861) * lu(k,1424) + lu(k,1473) = lu(k,1473) - lu(k,834) * lu(k,1472) + lu(k,1474) = lu(k,1474) - lu(k,835) * lu(k,1472) + lu(k,1475) = lu(k,1475) - lu(k,836) * lu(k,1472) + lu(k,1476) = lu(k,1476) - lu(k,837) * lu(k,1472) + lu(k,1477) = lu(k,1477) - lu(k,838) * lu(k,1472) + lu(k,1478) = lu(k,1478) - lu(k,839) * lu(k,1472) + lu(k,1479) = lu(k,1479) - lu(k,840) * lu(k,1472) + lu(k,1480) = lu(k,1480) - lu(k,841) * lu(k,1472) + lu(k,1481) = lu(k,1481) - lu(k,842) * lu(k,1472) + lu(k,1482) = lu(k,1482) - lu(k,843) * lu(k,1472) + lu(k,1483) = lu(k,1483) - lu(k,844) * lu(k,1472) + lu(k,1484) = lu(k,1484) - lu(k,845) * lu(k,1472) + lu(k,1485) = lu(k,1485) - lu(k,846) * lu(k,1472) + lu(k,1486) = lu(k,1486) - lu(k,847) * lu(k,1472) + lu(k,1487) = lu(k,1487) - lu(k,848) * lu(k,1472) + lu(k,1488) = lu(k,1488) - lu(k,849) * lu(k,1472) + lu(k,1489) = lu(k,1489) - lu(k,850) * lu(k,1472) + lu(k,1490) = lu(k,1490) - lu(k,851) * lu(k,1472) + lu(k,1491) = lu(k,1491) - lu(k,852) * lu(k,1472) + lu(k,1492) = lu(k,1492) - lu(k,853) * lu(k,1472) + lu(k,1494) = lu(k,1494) - lu(k,854) * lu(k,1472) + lu(k,1495) = lu(k,1495) - lu(k,855) * lu(k,1472) + lu(k,1496) = lu(k,1496) - lu(k,856) * lu(k,1472) + lu(k,1497) = lu(k,1497) - lu(k,857) * lu(k,1472) + lu(k,1498) = lu(k,1498) - lu(k,858) * lu(k,1472) + lu(k,1499) = lu(k,1499) - lu(k,859) * lu(k,1472) + lu(k,1500) = lu(k,1500) - lu(k,860) * lu(k,1472) + lu(k,1501) = lu(k,1501) - lu(k,861) * lu(k,1472) + lu(k,1550) = lu(k,1550) - lu(k,834) * lu(k,1549) + lu(k,1551) = lu(k,1551) - lu(k,835) * lu(k,1549) + lu(k,1552) = lu(k,1552) - lu(k,836) * lu(k,1549) + lu(k,1553) = lu(k,1553) - lu(k,837) * lu(k,1549) + lu(k,1554) = lu(k,1554) - lu(k,838) * lu(k,1549) + lu(k,1555) = lu(k,1555) - lu(k,839) * lu(k,1549) + lu(k,1556) = lu(k,1556) - lu(k,840) * lu(k,1549) + lu(k,1557) = lu(k,1557) - lu(k,841) * lu(k,1549) + lu(k,1558) = lu(k,1558) - lu(k,842) * lu(k,1549) + lu(k,1559) = lu(k,1559) - lu(k,843) * lu(k,1549) + lu(k,1560) = lu(k,1560) - lu(k,844) * lu(k,1549) + lu(k,1561) = lu(k,1561) - lu(k,845) * lu(k,1549) + lu(k,1562) = lu(k,1562) - lu(k,846) * lu(k,1549) + lu(k,1563) = lu(k,1563) - lu(k,847) * lu(k,1549) + lu(k,1564) = lu(k,1564) - lu(k,848) * lu(k,1549) + lu(k,1565) = lu(k,1565) - lu(k,849) * lu(k,1549) + lu(k,1566) = lu(k,1566) - lu(k,850) * lu(k,1549) + lu(k,1567) = lu(k,1567) - lu(k,851) * lu(k,1549) + lu(k,1568) = lu(k,1568) - lu(k,852) * lu(k,1549) + lu(k,1569) = lu(k,1569) - lu(k,853) * lu(k,1549) + lu(k,1571) = lu(k,1571) - lu(k,854) * lu(k,1549) + lu(k,1572) = lu(k,1572) - lu(k,855) * lu(k,1549) + lu(k,1573) = lu(k,1573) - lu(k,856) * lu(k,1549) + lu(k,1574) = lu(k,1574) - lu(k,857) * lu(k,1549) + lu(k,1575) = lu(k,1575) - lu(k,858) * lu(k,1549) + lu(k,1576) = lu(k,1576) - lu(k,859) * lu(k,1549) + lu(k,1577) = lu(k,1577) - lu(k,860) * lu(k,1549) + lu(k,1578) = lu(k,1578) - lu(k,861) * lu(k,1549) + lu(k,1595) = lu(k,1595) - lu(k,834) * lu(k,1594) + lu(k,1596) = lu(k,1596) - lu(k,835) * lu(k,1594) + lu(k,1597) = lu(k,1597) - lu(k,836) * lu(k,1594) + lu(k,1598) = lu(k,1598) - lu(k,837) * lu(k,1594) + lu(k,1599) = lu(k,1599) - lu(k,838) * lu(k,1594) + lu(k,1600) = lu(k,1600) - lu(k,839) * lu(k,1594) + lu(k,1601) = lu(k,1601) - lu(k,840) * lu(k,1594) + lu(k,1602) = lu(k,1602) - lu(k,841) * lu(k,1594) + lu(k,1603) = lu(k,1603) - lu(k,842) * lu(k,1594) + lu(k,1604) = lu(k,1604) - lu(k,843) * lu(k,1594) + lu(k,1605) = lu(k,1605) - lu(k,844) * lu(k,1594) + lu(k,1606) = lu(k,1606) - lu(k,845) * lu(k,1594) + lu(k,1607) = lu(k,1607) - lu(k,846) * lu(k,1594) + lu(k,1608) = lu(k,1608) - lu(k,847) * lu(k,1594) + lu(k,1609) = lu(k,1609) - lu(k,848) * lu(k,1594) + lu(k,1610) = lu(k,1610) - lu(k,849) * lu(k,1594) + lu(k,1611) = lu(k,1611) - lu(k,850) * lu(k,1594) + lu(k,1612) = lu(k,1612) - lu(k,851) * lu(k,1594) + lu(k,1613) = lu(k,1613) - lu(k,852) * lu(k,1594) + lu(k,1614) = lu(k,1614) - lu(k,853) * lu(k,1594) + lu(k,1616) = lu(k,1616) - lu(k,854) * lu(k,1594) + lu(k,1617) = lu(k,1617) - lu(k,855) * lu(k,1594) + lu(k,1618) = lu(k,1618) - lu(k,856) * lu(k,1594) + lu(k,1619) = lu(k,1619) - lu(k,857) * lu(k,1594) + lu(k,1620) = lu(k,1620) - lu(k,858) * lu(k,1594) + lu(k,1621) = lu(k,1621) - lu(k,859) * lu(k,1594) + lu(k,1622) = lu(k,1622) - lu(k,860) * lu(k,1594) + lu(k,1623) = lu(k,1623) - lu(k,861) * lu(k,1594) + lu(k,1638) = lu(k,1638) - lu(k,834) * lu(k,1637) + lu(k,1639) = - lu(k,835) * lu(k,1637) + lu(k,1640) = lu(k,1640) - lu(k,836) * lu(k,1637) + lu(k,1641) = lu(k,1641) - lu(k,837) * lu(k,1637) + lu(k,1642) = lu(k,1642) - lu(k,838) * lu(k,1637) + lu(k,1643) = lu(k,1643) - lu(k,839) * lu(k,1637) + lu(k,1644) = - lu(k,840) * lu(k,1637) + lu(k,1645) = lu(k,1645) - lu(k,841) * lu(k,1637) + lu(k,1646) = lu(k,1646) - lu(k,842) * lu(k,1637) + lu(k,1647) = lu(k,1647) - lu(k,843) * lu(k,1637) + lu(k,1648) = lu(k,1648) - lu(k,844) * lu(k,1637) + lu(k,1649) = lu(k,1649) - lu(k,845) * lu(k,1637) + lu(k,1650) = lu(k,1650) - lu(k,846) * lu(k,1637) + lu(k,1651) = lu(k,1651) - lu(k,847) * lu(k,1637) + lu(k,1652) = lu(k,1652) - lu(k,848) * lu(k,1637) + lu(k,1653) = lu(k,1653) - lu(k,849) * lu(k,1637) + lu(k,1654) = lu(k,1654) - lu(k,850) * lu(k,1637) + lu(k,1655) = lu(k,1655) - lu(k,851) * lu(k,1637) + lu(k,1656) = lu(k,1656) - lu(k,852) * lu(k,1637) + lu(k,1657) = lu(k,1657) - lu(k,853) * lu(k,1637) + lu(k,1659) = lu(k,1659) - lu(k,854) * lu(k,1637) + lu(k,1660) = lu(k,1660) - lu(k,855) * lu(k,1637) + lu(k,1661) = - lu(k,856) * lu(k,1637) + lu(k,1662) = - lu(k,857) * lu(k,1637) + lu(k,1663) = - lu(k,858) * lu(k,1637) + lu(k,1664) = lu(k,1664) - lu(k,859) * lu(k,1637) + lu(k,1665) = lu(k,1665) - lu(k,860) * lu(k,1637) + lu(k,1666) = lu(k,1666) - lu(k,861) * lu(k,1637) + lu(k,1681) = lu(k,1681) - lu(k,834) * lu(k,1680) + lu(k,1682) = - lu(k,835) * lu(k,1680) + lu(k,1683) = lu(k,1683) - lu(k,836) * lu(k,1680) + lu(k,1684) = lu(k,1684) - lu(k,837) * lu(k,1680) + lu(k,1685) = lu(k,1685) - lu(k,838) * lu(k,1680) + lu(k,1686) = lu(k,1686) - lu(k,839) * lu(k,1680) + lu(k,1687) = - lu(k,840) * lu(k,1680) + lu(k,1688) = lu(k,1688) - lu(k,841) * lu(k,1680) + lu(k,1689) = lu(k,1689) - lu(k,842) * lu(k,1680) + lu(k,1690) = lu(k,1690) - lu(k,843) * lu(k,1680) + lu(k,1691) = lu(k,1691) - lu(k,844) * lu(k,1680) + lu(k,1692) = lu(k,1692) - lu(k,845) * lu(k,1680) + lu(k,1693) = lu(k,1693) - lu(k,846) * lu(k,1680) + lu(k,1694) = lu(k,1694) - lu(k,847) * lu(k,1680) + lu(k,1695) = lu(k,1695) - lu(k,848) * lu(k,1680) + lu(k,1696) = lu(k,1696) - lu(k,849) * lu(k,1680) + lu(k,1697) = lu(k,1697) - lu(k,850) * lu(k,1680) + lu(k,1698) = lu(k,1698) - lu(k,851) * lu(k,1680) + lu(k,1699) = lu(k,1699) - lu(k,852) * lu(k,1680) + lu(k,1700) = lu(k,1700) - lu(k,853) * lu(k,1680) + lu(k,1702) = lu(k,1702) - lu(k,854) * lu(k,1680) + lu(k,1703) = lu(k,1703) - lu(k,855) * lu(k,1680) + lu(k,1704) = - lu(k,856) * lu(k,1680) + lu(k,1705) = - lu(k,857) * lu(k,1680) + lu(k,1706) = - lu(k,858) * lu(k,1680) + lu(k,1707) = lu(k,1707) - lu(k,859) * lu(k,1680) + lu(k,1708) = lu(k,1708) - lu(k,860) * lu(k,1680) + lu(k,1709) = lu(k,1709) - lu(k,861) * lu(k,1680) + lu(k,1757) = lu(k,1757) - lu(k,834) * lu(k,1756) + lu(k,1758) = lu(k,1758) - lu(k,835) * lu(k,1756) + lu(k,1759) = lu(k,1759) - lu(k,836) * lu(k,1756) + lu(k,1760) = lu(k,1760) - lu(k,837) * lu(k,1756) + lu(k,1761) = lu(k,1761) - lu(k,838) * lu(k,1756) + lu(k,1762) = lu(k,1762) - lu(k,839) * lu(k,1756) + lu(k,1763) = lu(k,1763) - lu(k,840) * lu(k,1756) + lu(k,1764) = lu(k,1764) - lu(k,841) * lu(k,1756) + lu(k,1765) = lu(k,1765) - lu(k,842) * lu(k,1756) + lu(k,1766) = lu(k,1766) - lu(k,843) * lu(k,1756) + lu(k,1767) = lu(k,1767) - lu(k,844) * lu(k,1756) + lu(k,1768) = lu(k,1768) - lu(k,845) * lu(k,1756) + lu(k,1769) = lu(k,1769) - lu(k,846) * lu(k,1756) + lu(k,1770) = lu(k,1770) - lu(k,847) * lu(k,1756) + lu(k,1771) = lu(k,1771) - lu(k,848) * lu(k,1756) + lu(k,1772) = lu(k,1772) - lu(k,849) * lu(k,1756) + lu(k,1773) = lu(k,1773) - lu(k,850) * lu(k,1756) + lu(k,1774) = lu(k,1774) - lu(k,851) * lu(k,1756) + lu(k,1775) = lu(k,1775) - lu(k,852) * lu(k,1756) + lu(k,1776) = lu(k,1776) - lu(k,853) * lu(k,1756) + lu(k,1778) = lu(k,1778) - lu(k,854) * lu(k,1756) + lu(k,1779) = lu(k,1779) - lu(k,855) * lu(k,1756) + lu(k,1780) = lu(k,1780) - lu(k,856) * lu(k,1756) + lu(k,1781) = lu(k,1781) - lu(k,857) * lu(k,1756) + lu(k,1782) = lu(k,1782) - lu(k,858) * lu(k,1756) + lu(k,1783) = lu(k,1783) - lu(k,859) * lu(k,1756) + lu(k,1784) = lu(k,1784) - lu(k,860) * lu(k,1756) + lu(k,1785) = lu(k,1785) - lu(k,861) * lu(k,1756) + lu(k,1915) = lu(k,1915) - lu(k,834) * lu(k,1914) + lu(k,1916) = lu(k,1916) - lu(k,835) * lu(k,1914) + lu(k,1917) = lu(k,1917) - lu(k,836) * lu(k,1914) + lu(k,1918) = lu(k,1918) - lu(k,837) * lu(k,1914) + lu(k,1919) = lu(k,1919) - lu(k,838) * lu(k,1914) + lu(k,1920) = lu(k,1920) - lu(k,839) * lu(k,1914) + lu(k,1921) = lu(k,1921) - lu(k,840) * lu(k,1914) + lu(k,1922) = - lu(k,841) * lu(k,1914) + lu(k,1923) = - lu(k,842) * lu(k,1914) + lu(k,1924) = lu(k,1924) - lu(k,843) * lu(k,1914) + lu(k,1925) = lu(k,1925) - lu(k,844) * lu(k,1914) + lu(k,1926) = - lu(k,845) * lu(k,1914) + lu(k,1927) = lu(k,1927) - lu(k,846) * lu(k,1914) + lu(k,1928) = lu(k,1928) - lu(k,847) * lu(k,1914) + lu(k,1929) = lu(k,1929) - lu(k,848) * lu(k,1914) + lu(k,1930) = lu(k,1930) - lu(k,849) * lu(k,1914) + lu(k,1931) = lu(k,1931) - lu(k,850) * lu(k,1914) + lu(k,1932) = lu(k,1932) - lu(k,851) * lu(k,1914) + lu(k,1933) = - lu(k,852) * lu(k,1914) + lu(k,1934) = - lu(k,853) * lu(k,1914) + lu(k,1936) = lu(k,1936) - lu(k,854) * lu(k,1914) + lu(k,1937) = lu(k,1937) - lu(k,855) * lu(k,1914) + lu(k,1938) = lu(k,1938) - lu(k,856) * lu(k,1914) + lu(k,1939) = lu(k,1939) - lu(k,857) * lu(k,1914) + lu(k,1940) = lu(k,1940) - lu(k,858) * lu(k,1914) + lu(k,1941) = lu(k,1941) - lu(k,859) * lu(k,1914) + lu(k,1942) = lu(k,1942) - lu(k,860) * lu(k,1914) + lu(k,1943) = lu(k,1943) - lu(k,861) * lu(k,1914) + lu(k,2002) = lu(k,2002) - lu(k,834) * lu(k,2001) + lu(k,2003) = lu(k,2003) - lu(k,835) * lu(k,2001) + lu(k,2004) = lu(k,2004) - lu(k,836) * lu(k,2001) + lu(k,2005) = lu(k,2005) - lu(k,837) * lu(k,2001) + lu(k,2006) = - lu(k,838) * lu(k,2001) + lu(k,2007) = lu(k,2007) - lu(k,839) * lu(k,2001) + lu(k,2008) = lu(k,2008) - lu(k,840) * lu(k,2001) + lu(k,2009) = lu(k,2009) - lu(k,841) * lu(k,2001) + lu(k,2010) = lu(k,2010) - lu(k,842) * lu(k,2001) + lu(k,2011) = lu(k,2011) - lu(k,843) * lu(k,2001) + lu(k,2012) = lu(k,2012) - lu(k,844) * lu(k,2001) + lu(k,2013) = lu(k,2013) - lu(k,845) * lu(k,2001) + lu(k,2014) = lu(k,2014) - lu(k,846) * lu(k,2001) + lu(k,2015) = lu(k,2015) - lu(k,847) * lu(k,2001) + lu(k,2016) = lu(k,2016) - lu(k,848) * lu(k,2001) + lu(k,2017) = lu(k,2017) - lu(k,849) * lu(k,2001) + lu(k,2018) = lu(k,2018) - lu(k,850) * lu(k,2001) + lu(k,2019) = lu(k,2019) - lu(k,851) * lu(k,2001) + lu(k,2020) = lu(k,2020) - lu(k,852) * lu(k,2001) + lu(k,2021) = lu(k,2021) - lu(k,853) * lu(k,2001) + lu(k,2023) = lu(k,2023) - lu(k,854) * lu(k,2001) + lu(k,2024) = lu(k,2024) - lu(k,855) * lu(k,2001) + lu(k,2025) = lu(k,2025) - lu(k,856) * lu(k,2001) + lu(k,2026) = lu(k,2026) - lu(k,857) * lu(k,2001) + lu(k,2027) = lu(k,2027) - lu(k,858) * lu(k,2001) + lu(k,2028) = lu(k,2028) - lu(k,859) * lu(k,2001) + lu(k,2029) = lu(k,2029) - lu(k,860) * lu(k,2001) + lu(k,2030) = lu(k,2030) - lu(k,861) * lu(k,2001) + end do + end subroutine lu_fac19 + subroutine lu_fac20( 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,866) = 1._r8 / lu(k,866) + lu(k,867) = lu(k,867) * lu(k,866) + lu(k,868) = lu(k,868) * lu(k,866) + lu(k,869) = lu(k,869) * lu(k,866) + lu(k,870) = lu(k,870) * lu(k,866) + lu(k,871) = lu(k,871) * lu(k,866) + lu(k,872) = lu(k,872) * lu(k,866) + lu(k,873) = lu(k,873) * lu(k,866) + lu(k,874) = lu(k,874) * lu(k,866) + lu(k,875) = lu(k,875) * lu(k,866) + lu(k,876) = lu(k,876) * lu(k,866) + lu(k,877) = lu(k,877) * lu(k,866) + lu(k,878) = lu(k,878) * lu(k,866) + lu(k,879) = lu(k,879) * lu(k,866) + lu(k,880) = lu(k,880) * lu(k,866) + lu(k,881) = lu(k,881) * lu(k,866) + lu(k,882) = lu(k,882) * lu(k,866) + lu(k,883) = lu(k,883) * lu(k,866) + lu(k,884) = lu(k,884) * lu(k,866) + lu(k,885) = lu(k,885) * lu(k,866) + lu(k,886) = lu(k,886) * lu(k,866) + lu(k,926) = lu(k,926) - lu(k,867) * lu(k,925) + lu(k,928) = lu(k,928) - lu(k,868) * lu(k,925) + lu(k,930) = lu(k,930) - lu(k,869) * lu(k,925) + lu(k,931) = lu(k,931) - lu(k,870) * lu(k,925) + lu(k,932) = lu(k,932) - lu(k,871) * lu(k,925) + lu(k,933) = lu(k,933) - lu(k,872) * lu(k,925) + lu(k,934) = - lu(k,873) * lu(k,925) + lu(k,935) = lu(k,935) - lu(k,874) * lu(k,925) + lu(k,936) = lu(k,936) - lu(k,875) * lu(k,925) + lu(k,937) = lu(k,937) - lu(k,876) * lu(k,925) + lu(k,938) = lu(k,938) - lu(k,877) * lu(k,925) + lu(k,939) = lu(k,939) - lu(k,878) * lu(k,925) + lu(k,940) = lu(k,940) - lu(k,879) * lu(k,925) + lu(k,941) = lu(k,941) - lu(k,880) * lu(k,925) + lu(k,942) = lu(k,942) - lu(k,881) * lu(k,925) + lu(k,943) = lu(k,943) - lu(k,882) * lu(k,925) + lu(k,945) = lu(k,945) - lu(k,883) * lu(k,925) + lu(k,946) = lu(k,946) - lu(k,884) * lu(k,925) + lu(k,947) = lu(k,947) - lu(k,885) * lu(k,925) + lu(k,948) = lu(k,948) - lu(k,886) * lu(k,925) + lu(k,1012) = lu(k,1012) - lu(k,867) * lu(k,1011) + lu(k,1015) = lu(k,1015) - lu(k,868) * lu(k,1011) + lu(k,1017) = lu(k,1017) - lu(k,869) * lu(k,1011) + lu(k,1018) = lu(k,1018) - lu(k,870) * lu(k,1011) + lu(k,1019) = lu(k,1019) - lu(k,871) * lu(k,1011) + lu(k,1021) = lu(k,1021) - lu(k,872) * lu(k,1011) + lu(k,1022) = lu(k,1022) - lu(k,873) * lu(k,1011) + lu(k,1023) = lu(k,1023) - lu(k,874) * lu(k,1011) + lu(k,1024) = lu(k,1024) - lu(k,875) * lu(k,1011) + lu(k,1025) = lu(k,1025) - lu(k,876) * lu(k,1011) + lu(k,1027) = lu(k,1027) - lu(k,877) * lu(k,1011) + lu(k,1028) = lu(k,1028) - lu(k,878) * lu(k,1011) + lu(k,1029) = lu(k,1029) - lu(k,879) * lu(k,1011) + lu(k,1030) = lu(k,1030) - lu(k,880) * lu(k,1011) + lu(k,1031) = lu(k,1031) - lu(k,881) * lu(k,1011) + lu(k,1032) = lu(k,1032) - lu(k,882) * lu(k,1011) + lu(k,1035) = lu(k,1035) - lu(k,883) * lu(k,1011) + lu(k,1036) = lu(k,1036) - lu(k,884) * lu(k,1011) + lu(k,1037) = lu(k,1037) - lu(k,885) * lu(k,1011) + lu(k,1038) = lu(k,1038) - lu(k,886) * lu(k,1011) + lu(k,1100) = lu(k,1100) - lu(k,867) * lu(k,1098) + lu(k,1103) = lu(k,1103) - lu(k,868) * lu(k,1098) + lu(k,1105) = lu(k,1105) - lu(k,869) * lu(k,1098) + lu(k,1106) = lu(k,1106) - lu(k,870) * lu(k,1098) + lu(k,1107) = lu(k,1107) - lu(k,871) * lu(k,1098) + lu(k,1109) = lu(k,1109) - lu(k,872) * lu(k,1098) + lu(k,1110) = lu(k,1110) - lu(k,873) * lu(k,1098) + lu(k,1111) = lu(k,1111) - lu(k,874) * lu(k,1098) + lu(k,1112) = lu(k,1112) - lu(k,875) * lu(k,1098) + lu(k,1113) = lu(k,1113) - lu(k,876) * lu(k,1098) + lu(k,1115) = lu(k,1115) - lu(k,877) * lu(k,1098) + lu(k,1116) = lu(k,1116) - lu(k,878) * lu(k,1098) + lu(k,1117) = lu(k,1117) - lu(k,879) * lu(k,1098) + lu(k,1118) = lu(k,1118) - lu(k,880) * lu(k,1098) + lu(k,1119) = lu(k,1119) - lu(k,881) * lu(k,1098) + lu(k,1120) = lu(k,1120) - lu(k,882) * lu(k,1098) + lu(k,1123) = lu(k,1123) - lu(k,883) * lu(k,1098) + lu(k,1124) = lu(k,1124) - lu(k,884) * lu(k,1098) + lu(k,1125) = lu(k,1125) - lu(k,885) * lu(k,1098) + lu(k,1126) = lu(k,1126) - lu(k,886) * lu(k,1098) + lu(k,1148) = lu(k,1148) - lu(k,867) * lu(k,1146) + lu(k,1151) = lu(k,1151) - lu(k,868) * lu(k,1146) + lu(k,1153) = lu(k,1153) - lu(k,869) * lu(k,1146) + lu(k,1154) = lu(k,1154) - lu(k,870) * lu(k,1146) + lu(k,1155) = lu(k,1155) - lu(k,871) * lu(k,1146) + lu(k,1157) = lu(k,1157) - lu(k,872) * lu(k,1146) + lu(k,1158) = lu(k,1158) - lu(k,873) * lu(k,1146) + lu(k,1159) = lu(k,1159) - lu(k,874) * lu(k,1146) + lu(k,1160) = lu(k,1160) - lu(k,875) * lu(k,1146) + lu(k,1161) = lu(k,1161) - lu(k,876) * lu(k,1146) + lu(k,1163) = lu(k,1163) - lu(k,877) * lu(k,1146) + lu(k,1164) = lu(k,1164) - lu(k,878) * lu(k,1146) + lu(k,1165) = lu(k,1165) - lu(k,879) * lu(k,1146) + lu(k,1166) = lu(k,1166) - lu(k,880) * lu(k,1146) + lu(k,1167) = lu(k,1167) - lu(k,881) * lu(k,1146) + lu(k,1168) = lu(k,1168) - lu(k,882) * lu(k,1146) + lu(k,1171) = lu(k,1171) - lu(k,883) * lu(k,1146) + lu(k,1172) = lu(k,1172) - lu(k,884) * lu(k,1146) + lu(k,1173) = lu(k,1173) - lu(k,885) * lu(k,1146) + lu(k,1174) = lu(k,1174) - lu(k,886) * lu(k,1146) + lu(k,1191) = lu(k,1191) - lu(k,867) * lu(k,1189) + lu(k,1194) = lu(k,1194) - lu(k,868) * lu(k,1189) + lu(k,1196) = lu(k,1196) - lu(k,869) * lu(k,1189) + lu(k,1197) = lu(k,1197) - lu(k,870) * lu(k,1189) + lu(k,1198) = lu(k,1198) - lu(k,871) * lu(k,1189) + lu(k,1200) = lu(k,1200) - lu(k,872) * lu(k,1189) + lu(k,1201) = lu(k,1201) - lu(k,873) * lu(k,1189) + lu(k,1202) = lu(k,1202) - lu(k,874) * lu(k,1189) + lu(k,1203) = lu(k,1203) - lu(k,875) * lu(k,1189) + lu(k,1204) = lu(k,1204) - lu(k,876) * lu(k,1189) + lu(k,1206) = lu(k,1206) - lu(k,877) * lu(k,1189) + lu(k,1207) = lu(k,1207) - lu(k,878) * lu(k,1189) + lu(k,1208) = lu(k,1208) - lu(k,879) * lu(k,1189) + lu(k,1209) = lu(k,1209) - lu(k,880) * lu(k,1189) + lu(k,1210) = lu(k,1210) - lu(k,881) * lu(k,1189) + lu(k,1211) = lu(k,1211) - lu(k,882) * lu(k,1189) + lu(k,1214) = lu(k,1214) - lu(k,883) * lu(k,1189) + lu(k,1215) = lu(k,1215) - lu(k,884) * lu(k,1189) + lu(k,1216) = lu(k,1216) - lu(k,885) * lu(k,1189) + lu(k,1217) = lu(k,1217) - lu(k,886) * lu(k,1189) + lu(k,1234) = lu(k,1234) - lu(k,867) * lu(k,1232) + lu(k,1237) = lu(k,1237) - lu(k,868) * lu(k,1232) + lu(k,1239) = lu(k,1239) - lu(k,869) * lu(k,1232) + lu(k,1240) = lu(k,1240) - lu(k,870) * lu(k,1232) + lu(k,1241) = lu(k,1241) - lu(k,871) * lu(k,1232) + lu(k,1243) = lu(k,1243) - lu(k,872) * lu(k,1232) + lu(k,1244) = lu(k,1244) - lu(k,873) * lu(k,1232) + lu(k,1245) = lu(k,1245) - lu(k,874) * lu(k,1232) + lu(k,1246) = lu(k,1246) - lu(k,875) * lu(k,1232) + lu(k,1247) = lu(k,1247) - lu(k,876) * lu(k,1232) + lu(k,1249) = lu(k,1249) - lu(k,877) * lu(k,1232) + lu(k,1250) = lu(k,1250) - lu(k,878) * lu(k,1232) + lu(k,1251) = lu(k,1251) - lu(k,879) * lu(k,1232) + lu(k,1252) = lu(k,1252) - lu(k,880) * lu(k,1232) + lu(k,1253) = lu(k,1253) - lu(k,881) * lu(k,1232) + lu(k,1254) = lu(k,1254) - lu(k,882) * lu(k,1232) + lu(k,1257) = lu(k,1257) - lu(k,883) * lu(k,1232) + lu(k,1258) = lu(k,1258) - lu(k,884) * lu(k,1232) + lu(k,1259) = lu(k,1259) - lu(k,885) * lu(k,1232) + lu(k,1260) = lu(k,1260) - lu(k,886) * lu(k,1232) + lu(k,1276) = lu(k,1276) - lu(k,867) * lu(k,1274) + lu(k,1279) = lu(k,1279) - lu(k,868) * lu(k,1274) + lu(k,1281) = lu(k,1281) - lu(k,869) * lu(k,1274) + lu(k,1282) = lu(k,1282) - lu(k,870) * lu(k,1274) + lu(k,1283) = lu(k,1283) - lu(k,871) * lu(k,1274) + lu(k,1285) = lu(k,1285) - lu(k,872) * lu(k,1274) + lu(k,1286) = lu(k,1286) - lu(k,873) * lu(k,1274) + lu(k,1287) = lu(k,1287) - lu(k,874) * lu(k,1274) + lu(k,1288) = lu(k,1288) - lu(k,875) * lu(k,1274) + lu(k,1289) = lu(k,1289) - lu(k,876) * lu(k,1274) + lu(k,1291) = lu(k,1291) - lu(k,877) * lu(k,1274) + lu(k,1292) = lu(k,1292) - lu(k,878) * lu(k,1274) + lu(k,1293) = lu(k,1293) - lu(k,879) * lu(k,1274) + lu(k,1294) = lu(k,1294) - lu(k,880) * lu(k,1274) + lu(k,1295) = lu(k,1295) - lu(k,881) * lu(k,1274) + lu(k,1296) = lu(k,1296) - lu(k,882) * lu(k,1274) + lu(k,1299) = lu(k,1299) - lu(k,883) * lu(k,1274) + lu(k,1300) = lu(k,1300) - lu(k,884) * lu(k,1274) + lu(k,1301) = lu(k,1301) - lu(k,885) * lu(k,1274) + lu(k,1302) = lu(k,1302) - lu(k,886) * lu(k,1274) + lu(k,1318) = lu(k,1318) - lu(k,867) * lu(k,1316) + lu(k,1321) = lu(k,1321) - lu(k,868) * lu(k,1316) + lu(k,1323) = lu(k,1323) - lu(k,869) * lu(k,1316) + lu(k,1324) = lu(k,1324) - lu(k,870) * lu(k,1316) + lu(k,1325) = lu(k,1325) - lu(k,871) * lu(k,1316) + lu(k,1327) = lu(k,1327) - lu(k,872) * lu(k,1316) + lu(k,1328) = lu(k,1328) - lu(k,873) * lu(k,1316) + lu(k,1329) = lu(k,1329) - lu(k,874) * lu(k,1316) + lu(k,1330) = lu(k,1330) - lu(k,875) * lu(k,1316) + lu(k,1331) = lu(k,1331) - lu(k,876) * lu(k,1316) + lu(k,1333) = lu(k,1333) - lu(k,877) * lu(k,1316) + lu(k,1334) = lu(k,1334) - lu(k,878) * lu(k,1316) + lu(k,1335) = lu(k,1335) - lu(k,879) * lu(k,1316) + lu(k,1336) = lu(k,1336) - lu(k,880) * lu(k,1316) + lu(k,1337) = lu(k,1337) - lu(k,881) * lu(k,1316) + lu(k,1338) = lu(k,1338) - lu(k,882) * lu(k,1316) + lu(k,1341) = lu(k,1341) - lu(k,883) * lu(k,1316) + lu(k,1342) = lu(k,1342) - lu(k,884) * lu(k,1316) + lu(k,1343) = lu(k,1343) - lu(k,885) * lu(k,1316) + lu(k,1344) = lu(k,1344) - lu(k,886) * lu(k,1316) + lu(k,1378) = lu(k,1378) - lu(k,867) * lu(k,1376) + lu(k,1381) = lu(k,1381) - lu(k,868) * lu(k,1376) + lu(k,1383) = lu(k,1383) - lu(k,869) * lu(k,1376) + lu(k,1384) = lu(k,1384) - lu(k,870) * lu(k,1376) + lu(k,1385) = lu(k,1385) - lu(k,871) * lu(k,1376) + lu(k,1387) = lu(k,1387) - lu(k,872) * lu(k,1376) + lu(k,1388) = lu(k,1388) - lu(k,873) * lu(k,1376) + lu(k,1389) = lu(k,1389) - lu(k,874) * lu(k,1376) + lu(k,1390) = lu(k,1390) - lu(k,875) * lu(k,1376) + lu(k,1391) = lu(k,1391) - lu(k,876) * lu(k,1376) + lu(k,1393) = lu(k,1393) - lu(k,877) * lu(k,1376) + lu(k,1394) = lu(k,1394) - lu(k,878) * lu(k,1376) + lu(k,1395) = lu(k,1395) - lu(k,879) * lu(k,1376) + lu(k,1396) = lu(k,1396) - lu(k,880) * lu(k,1376) + lu(k,1397) = lu(k,1397) - lu(k,881) * lu(k,1376) + lu(k,1398) = lu(k,1398) - lu(k,882) * lu(k,1376) + lu(k,1401) = lu(k,1401) - lu(k,883) * lu(k,1376) + lu(k,1402) = lu(k,1402) - lu(k,884) * lu(k,1376) + lu(k,1403) = lu(k,1403) - lu(k,885) * lu(k,1376) + lu(k,1404) = lu(k,1404) - lu(k,886) * lu(k,1376) + lu(k,1427) = lu(k,1427) - lu(k,867) * lu(k,1425) + lu(k,1430) = lu(k,1430) - lu(k,868) * lu(k,1425) + lu(k,1432) = lu(k,1432) - lu(k,869) * lu(k,1425) + lu(k,1433) = lu(k,1433) - lu(k,870) * lu(k,1425) + lu(k,1434) = lu(k,1434) - lu(k,871) * lu(k,1425) + lu(k,1436) = lu(k,1436) - lu(k,872) * lu(k,1425) + lu(k,1437) = lu(k,1437) - lu(k,873) * lu(k,1425) + lu(k,1438) = lu(k,1438) - lu(k,874) * lu(k,1425) + lu(k,1439) = lu(k,1439) - lu(k,875) * lu(k,1425) + lu(k,1440) = lu(k,1440) - lu(k,876) * lu(k,1425) + lu(k,1442) = lu(k,1442) - lu(k,877) * lu(k,1425) + lu(k,1443) = lu(k,1443) - lu(k,878) * lu(k,1425) + lu(k,1444) = lu(k,1444) - lu(k,879) * lu(k,1425) + lu(k,1445) = lu(k,1445) - lu(k,880) * lu(k,1425) + lu(k,1446) = lu(k,1446) - lu(k,881) * lu(k,1425) + lu(k,1447) = lu(k,1447) - lu(k,882) * lu(k,1425) + lu(k,1450) = lu(k,1450) - lu(k,883) * lu(k,1425) + lu(k,1451) = lu(k,1451) - lu(k,884) * lu(k,1425) + lu(k,1452) = lu(k,1452) - lu(k,885) * lu(k,1425) + lu(k,1453) = lu(k,1453) - lu(k,886) * lu(k,1425) + lu(k,1475) = lu(k,1475) - lu(k,867) * lu(k,1473) + lu(k,1478) = lu(k,1478) - lu(k,868) * lu(k,1473) + lu(k,1480) = lu(k,1480) - lu(k,869) * lu(k,1473) + lu(k,1481) = lu(k,1481) - lu(k,870) * lu(k,1473) + lu(k,1482) = lu(k,1482) - lu(k,871) * lu(k,1473) + lu(k,1484) = lu(k,1484) - lu(k,872) * lu(k,1473) + lu(k,1485) = lu(k,1485) - lu(k,873) * lu(k,1473) + lu(k,1486) = lu(k,1486) - lu(k,874) * lu(k,1473) + lu(k,1487) = lu(k,1487) - lu(k,875) * lu(k,1473) + lu(k,1488) = lu(k,1488) - lu(k,876) * lu(k,1473) + lu(k,1490) = lu(k,1490) - lu(k,877) * lu(k,1473) + lu(k,1491) = lu(k,1491) - lu(k,878) * lu(k,1473) + lu(k,1492) = lu(k,1492) - lu(k,879) * lu(k,1473) + lu(k,1493) = lu(k,1493) - lu(k,880) * lu(k,1473) + lu(k,1494) = lu(k,1494) - lu(k,881) * lu(k,1473) + lu(k,1495) = lu(k,1495) - lu(k,882) * lu(k,1473) + lu(k,1498) = lu(k,1498) - lu(k,883) * lu(k,1473) + lu(k,1499) = lu(k,1499) - lu(k,884) * lu(k,1473) + lu(k,1500) = lu(k,1500) - lu(k,885) * lu(k,1473) + lu(k,1501) = lu(k,1501) - lu(k,886) * lu(k,1473) + lu(k,1516) = lu(k,1516) - lu(k,867) * lu(k,1514) + lu(k,1519) = lu(k,1519) - lu(k,868) * lu(k,1514) + lu(k,1521) = lu(k,1521) - lu(k,869) * lu(k,1514) + lu(k,1522) = lu(k,1522) - lu(k,870) * lu(k,1514) + lu(k,1523) = lu(k,1523) - lu(k,871) * lu(k,1514) + lu(k,1525) = lu(k,1525) - lu(k,872) * lu(k,1514) + lu(k,1526) = lu(k,1526) - lu(k,873) * lu(k,1514) + lu(k,1527) = lu(k,1527) - lu(k,874) * lu(k,1514) + lu(k,1528) = lu(k,1528) - lu(k,875) * lu(k,1514) + lu(k,1529) = lu(k,1529) - lu(k,876) * lu(k,1514) + lu(k,1531) = lu(k,1531) - lu(k,877) * lu(k,1514) + lu(k,1532) = lu(k,1532) - lu(k,878) * lu(k,1514) + lu(k,1533) = lu(k,1533) - lu(k,879) * lu(k,1514) + lu(k,1534) = lu(k,1534) - lu(k,880) * lu(k,1514) + lu(k,1535) = lu(k,1535) - lu(k,881) * lu(k,1514) + lu(k,1536) = lu(k,1536) - lu(k,882) * lu(k,1514) + lu(k,1539) = lu(k,1539) - lu(k,883) * lu(k,1514) + lu(k,1540) = lu(k,1540) - lu(k,884) * lu(k,1514) + lu(k,1541) = lu(k,1541) - lu(k,885) * lu(k,1514) + lu(k,1542) = lu(k,1542) - lu(k,886) * lu(k,1514) + lu(k,1552) = lu(k,1552) - lu(k,867) * lu(k,1550) + lu(k,1555) = lu(k,1555) - lu(k,868) * lu(k,1550) + lu(k,1557) = lu(k,1557) - lu(k,869) * lu(k,1550) + lu(k,1558) = lu(k,1558) - lu(k,870) * lu(k,1550) + lu(k,1559) = lu(k,1559) - lu(k,871) * lu(k,1550) + lu(k,1561) = lu(k,1561) - lu(k,872) * lu(k,1550) + lu(k,1562) = lu(k,1562) - lu(k,873) * lu(k,1550) + lu(k,1563) = lu(k,1563) - lu(k,874) * lu(k,1550) + lu(k,1564) = lu(k,1564) - lu(k,875) * lu(k,1550) + lu(k,1565) = lu(k,1565) - lu(k,876) * lu(k,1550) + lu(k,1567) = lu(k,1567) - lu(k,877) * lu(k,1550) + lu(k,1568) = lu(k,1568) - lu(k,878) * lu(k,1550) + lu(k,1569) = lu(k,1569) - lu(k,879) * lu(k,1550) + lu(k,1570) = - lu(k,880) * lu(k,1550) + lu(k,1571) = lu(k,1571) - lu(k,881) * lu(k,1550) + lu(k,1572) = lu(k,1572) - lu(k,882) * lu(k,1550) + lu(k,1575) = lu(k,1575) - lu(k,883) * lu(k,1550) + lu(k,1576) = lu(k,1576) - lu(k,884) * lu(k,1550) + lu(k,1577) = lu(k,1577) - lu(k,885) * lu(k,1550) + lu(k,1578) = lu(k,1578) - lu(k,886) * lu(k,1550) + lu(k,1597) = lu(k,1597) - lu(k,867) * lu(k,1595) + lu(k,1600) = lu(k,1600) - lu(k,868) * lu(k,1595) + lu(k,1602) = lu(k,1602) - lu(k,869) * lu(k,1595) + lu(k,1603) = lu(k,1603) - lu(k,870) * lu(k,1595) + lu(k,1604) = lu(k,1604) - lu(k,871) * lu(k,1595) + lu(k,1606) = lu(k,1606) - lu(k,872) * lu(k,1595) + lu(k,1607) = lu(k,1607) - lu(k,873) * lu(k,1595) + lu(k,1608) = lu(k,1608) - lu(k,874) * lu(k,1595) + lu(k,1609) = lu(k,1609) - lu(k,875) * lu(k,1595) + lu(k,1610) = lu(k,1610) - lu(k,876) * lu(k,1595) + lu(k,1612) = lu(k,1612) - lu(k,877) * lu(k,1595) + lu(k,1613) = lu(k,1613) - lu(k,878) * lu(k,1595) + lu(k,1614) = lu(k,1614) - lu(k,879) * lu(k,1595) + lu(k,1615) = lu(k,1615) - lu(k,880) * lu(k,1595) + lu(k,1616) = lu(k,1616) - lu(k,881) * lu(k,1595) + lu(k,1617) = lu(k,1617) - lu(k,882) * lu(k,1595) + lu(k,1620) = lu(k,1620) - lu(k,883) * lu(k,1595) + lu(k,1621) = lu(k,1621) - lu(k,884) * lu(k,1595) + lu(k,1622) = lu(k,1622) - lu(k,885) * lu(k,1595) + lu(k,1623) = lu(k,1623) - lu(k,886) * lu(k,1595) + lu(k,1640) = lu(k,1640) - lu(k,867) * lu(k,1638) + lu(k,1643) = lu(k,1643) - lu(k,868) * lu(k,1638) + lu(k,1645) = lu(k,1645) - lu(k,869) * lu(k,1638) + lu(k,1646) = lu(k,1646) - lu(k,870) * lu(k,1638) + lu(k,1647) = lu(k,1647) - lu(k,871) * lu(k,1638) + lu(k,1649) = lu(k,1649) - lu(k,872) * lu(k,1638) + lu(k,1650) = lu(k,1650) - lu(k,873) * lu(k,1638) + lu(k,1651) = lu(k,1651) - lu(k,874) * lu(k,1638) + lu(k,1652) = lu(k,1652) - lu(k,875) * lu(k,1638) + lu(k,1653) = lu(k,1653) - lu(k,876) * lu(k,1638) + lu(k,1655) = lu(k,1655) - lu(k,877) * lu(k,1638) + lu(k,1656) = lu(k,1656) - lu(k,878) * lu(k,1638) + lu(k,1657) = lu(k,1657) - lu(k,879) * lu(k,1638) + lu(k,1658) = lu(k,1658) - lu(k,880) * lu(k,1638) + lu(k,1659) = lu(k,1659) - lu(k,881) * lu(k,1638) + lu(k,1660) = lu(k,1660) - lu(k,882) * lu(k,1638) + lu(k,1663) = lu(k,1663) - lu(k,883) * lu(k,1638) + lu(k,1664) = lu(k,1664) - lu(k,884) * lu(k,1638) + lu(k,1665) = lu(k,1665) - lu(k,885) * lu(k,1638) + lu(k,1666) = lu(k,1666) - lu(k,886) * lu(k,1638) + lu(k,1683) = lu(k,1683) - lu(k,867) * lu(k,1681) + lu(k,1686) = lu(k,1686) - lu(k,868) * lu(k,1681) + lu(k,1688) = lu(k,1688) - lu(k,869) * lu(k,1681) + lu(k,1689) = lu(k,1689) - lu(k,870) * lu(k,1681) + lu(k,1690) = lu(k,1690) - lu(k,871) * lu(k,1681) + lu(k,1692) = lu(k,1692) - lu(k,872) * lu(k,1681) + lu(k,1693) = lu(k,1693) - lu(k,873) * lu(k,1681) + lu(k,1694) = lu(k,1694) - lu(k,874) * lu(k,1681) + lu(k,1695) = lu(k,1695) - lu(k,875) * lu(k,1681) + lu(k,1696) = lu(k,1696) - lu(k,876) * lu(k,1681) + lu(k,1698) = lu(k,1698) - lu(k,877) * lu(k,1681) + lu(k,1699) = lu(k,1699) - lu(k,878) * lu(k,1681) + lu(k,1700) = lu(k,1700) - lu(k,879) * lu(k,1681) + lu(k,1701) = lu(k,1701) - lu(k,880) * lu(k,1681) + lu(k,1702) = lu(k,1702) - lu(k,881) * lu(k,1681) + lu(k,1703) = lu(k,1703) - lu(k,882) * lu(k,1681) + lu(k,1706) = lu(k,1706) - lu(k,883) * lu(k,1681) + lu(k,1707) = lu(k,1707) - lu(k,884) * lu(k,1681) + lu(k,1708) = lu(k,1708) - lu(k,885) * lu(k,1681) + lu(k,1709) = lu(k,1709) - lu(k,886) * lu(k,1681) + lu(k,1724) = - lu(k,867) * lu(k,1722) + lu(k,1726) = lu(k,1726) - lu(k,868) * lu(k,1722) + lu(k,1728) = lu(k,1728) - lu(k,869) * lu(k,1722) + lu(k,1729) = lu(k,1729) - lu(k,870) * lu(k,1722) + lu(k,1730) = lu(k,1730) - lu(k,871) * lu(k,1722) + lu(k,1732) = lu(k,1732) - lu(k,872) * lu(k,1722) + lu(k,1733) = lu(k,1733) - lu(k,873) * lu(k,1722) + lu(k,1734) = lu(k,1734) - lu(k,874) * lu(k,1722) + lu(k,1735) = lu(k,1735) - lu(k,875) * lu(k,1722) + lu(k,1736) = lu(k,1736) - lu(k,876) * lu(k,1722) + lu(k,1738) = lu(k,1738) - lu(k,877) * lu(k,1722) + lu(k,1739) = lu(k,1739) - lu(k,878) * lu(k,1722) + lu(k,1740) = lu(k,1740) - lu(k,879) * lu(k,1722) + lu(k,1741) = lu(k,1741) - lu(k,880) * lu(k,1722) + lu(k,1742) = lu(k,1742) - lu(k,881) * lu(k,1722) + lu(k,1743) = lu(k,1743) - lu(k,882) * lu(k,1722) + lu(k,1746) = lu(k,1746) - lu(k,883) * lu(k,1722) + lu(k,1747) = lu(k,1747) - lu(k,884) * lu(k,1722) + lu(k,1748) = lu(k,1748) - lu(k,885) * lu(k,1722) + lu(k,1749) = lu(k,1749) - lu(k,886) * lu(k,1722) + lu(k,1759) = lu(k,1759) - lu(k,867) * lu(k,1757) + lu(k,1762) = lu(k,1762) - lu(k,868) * lu(k,1757) + lu(k,1764) = lu(k,1764) - lu(k,869) * lu(k,1757) + lu(k,1765) = lu(k,1765) - lu(k,870) * lu(k,1757) + lu(k,1766) = lu(k,1766) - lu(k,871) * lu(k,1757) + lu(k,1768) = lu(k,1768) - lu(k,872) * lu(k,1757) + lu(k,1769) = lu(k,1769) - lu(k,873) * lu(k,1757) + lu(k,1770) = lu(k,1770) - lu(k,874) * lu(k,1757) + lu(k,1771) = lu(k,1771) - lu(k,875) * lu(k,1757) + lu(k,1772) = lu(k,1772) - lu(k,876) * lu(k,1757) + lu(k,1774) = lu(k,1774) - lu(k,877) * lu(k,1757) + lu(k,1775) = lu(k,1775) - lu(k,878) * lu(k,1757) + lu(k,1776) = lu(k,1776) - lu(k,879) * lu(k,1757) + lu(k,1777) = lu(k,1777) - lu(k,880) * lu(k,1757) + lu(k,1778) = lu(k,1778) - lu(k,881) * lu(k,1757) + lu(k,1779) = lu(k,1779) - lu(k,882) * lu(k,1757) + lu(k,1782) = lu(k,1782) - lu(k,883) * lu(k,1757) + lu(k,1783) = lu(k,1783) - lu(k,884) * lu(k,1757) + lu(k,1784) = lu(k,1784) - lu(k,885) * lu(k,1757) + lu(k,1785) = lu(k,1785) - lu(k,886) * lu(k,1757) + lu(k,1807) = lu(k,1807) - lu(k,867) * lu(k,1805) + lu(k,1810) = lu(k,1810) - lu(k,868) * lu(k,1805) + lu(k,1812) = lu(k,1812) - lu(k,869) * lu(k,1805) + lu(k,1813) = lu(k,1813) - lu(k,870) * lu(k,1805) + lu(k,1814) = lu(k,1814) - lu(k,871) * lu(k,1805) + lu(k,1816) = lu(k,1816) - lu(k,872) * lu(k,1805) + lu(k,1817) = lu(k,1817) - lu(k,873) * lu(k,1805) + lu(k,1818) = lu(k,1818) - lu(k,874) * lu(k,1805) + lu(k,1819) = lu(k,1819) - lu(k,875) * lu(k,1805) + lu(k,1820) = lu(k,1820) - lu(k,876) * lu(k,1805) + lu(k,1822) = lu(k,1822) - lu(k,877) * lu(k,1805) + lu(k,1823) = lu(k,1823) - lu(k,878) * lu(k,1805) + lu(k,1824) = lu(k,1824) - lu(k,879) * lu(k,1805) + lu(k,1825) = lu(k,1825) - lu(k,880) * lu(k,1805) + lu(k,1826) = lu(k,1826) - lu(k,881) * lu(k,1805) + lu(k,1827) = lu(k,1827) - lu(k,882) * lu(k,1805) + lu(k,1830) = lu(k,1830) - lu(k,883) * lu(k,1805) + lu(k,1831) = lu(k,1831) - lu(k,884) * lu(k,1805) + lu(k,1832) = lu(k,1832) - lu(k,885) * lu(k,1805) + lu(k,1833) = lu(k,1833) - lu(k,886) * lu(k,1805) + lu(k,1840) = lu(k,1840) - lu(k,867) * lu(k,1838) + lu(k,1843) = lu(k,1843) - lu(k,868) * lu(k,1838) + lu(k,1845) = lu(k,1845) - lu(k,869) * lu(k,1838) + lu(k,1846) = lu(k,1846) - lu(k,870) * lu(k,1838) + lu(k,1847) = lu(k,1847) - lu(k,871) * lu(k,1838) + lu(k,1849) = lu(k,1849) - lu(k,872) * lu(k,1838) + lu(k,1850) = lu(k,1850) - lu(k,873) * lu(k,1838) + lu(k,1851) = lu(k,1851) - lu(k,874) * lu(k,1838) + lu(k,1852) = lu(k,1852) - lu(k,875) * lu(k,1838) + lu(k,1853) = lu(k,1853) - lu(k,876) * lu(k,1838) + lu(k,1855) = lu(k,1855) - lu(k,877) * lu(k,1838) + lu(k,1856) = lu(k,1856) - lu(k,878) * lu(k,1838) + lu(k,1857) = lu(k,1857) - lu(k,879) * lu(k,1838) + lu(k,1858) = - lu(k,880) * lu(k,1838) + lu(k,1859) = lu(k,1859) - lu(k,881) * lu(k,1838) + lu(k,1860) = lu(k,1860) - lu(k,882) * lu(k,1838) + lu(k,1863) = lu(k,1863) - lu(k,883) * lu(k,1838) + lu(k,1864) = lu(k,1864) - lu(k,884) * lu(k,1838) + lu(k,1865) = lu(k,1865) - lu(k,885) * lu(k,1838) + lu(k,1866) = lu(k,1866) - lu(k,886) * lu(k,1838) + lu(k,1876) = lu(k,1876) - lu(k,867) * lu(k,1874) + lu(k,1879) = lu(k,1879) - lu(k,868) * lu(k,1874) + lu(k,1881) = lu(k,1881) - lu(k,869) * lu(k,1874) + lu(k,1882) = lu(k,1882) - lu(k,870) * lu(k,1874) + lu(k,1883) = lu(k,1883) - lu(k,871) * lu(k,1874) + lu(k,1885) = lu(k,1885) - lu(k,872) * lu(k,1874) + lu(k,1886) = lu(k,1886) - lu(k,873) * lu(k,1874) + lu(k,1887) = lu(k,1887) - lu(k,874) * lu(k,1874) + lu(k,1888) = lu(k,1888) - lu(k,875) * lu(k,1874) + lu(k,1889) = lu(k,1889) - lu(k,876) * lu(k,1874) + lu(k,1891) = lu(k,1891) - lu(k,877) * lu(k,1874) + lu(k,1892) = lu(k,1892) - lu(k,878) * lu(k,1874) + lu(k,1893) = lu(k,1893) - lu(k,879) * lu(k,1874) + lu(k,1894) = lu(k,1894) - lu(k,880) * lu(k,1874) + lu(k,1895) = lu(k,1895) - lu(k,881) * lu(k,1874) + lu(k,1896) = lu(k,1896) - lu(k,882) * lu(k,1874) + lu(k,1899) = lu(k,1899) - lu(k,883) * lu(k,1874) + lu(k,1900) = lu(k,1900) - lu(k,884) * lu(k,1874) + lu(k,1901) = lu(k,1901) - lu(k,885) * lu(k,1874) + lu(k,1902) = lu(k,1902) - lu(k,886) * lu(k,1874) + lu(k,1917) = lu(k,1917) - lu(k,867) * lu(k,1915) + lu(k,1920) = lu(k,1920) - lu(k,868) * lu(k,1915) + lu(k,1922) = lu(k,1922) - lu(k,869) * lu(k,1915) + lu(k,1923) = lu(k,1923) - lu(k,870) * lu(k,1915) + lu(k,1924) = lu(k,1924) - lu(k,871) * lu(k,1915) + lu(k,1926) = lu(k,1926) - lu(k,872) * lu(k,1915) + lu(k,1927) = lu(k,1927) - lu(k,873) * lu(k,1915) + lu(k,1928) = lu(k,1928) - lu(k,874) * lu(k,1915) + lu(k,1929) = lu(k,1929) - lu(k,875) * lu(k,1915) + lu(k,1930) = lu(k,1930) - lu(k,876) * lu(k,1915) + lu(k,1932) = lu(k,1932) - lu(k,877) * lu(k,1915) + lu(k,1933) = lu(k,1933) - lu(k,878) * lu(k,1915) + lu(k,1934) = lu(k,1934) - lu(k,879) * lu(k,1915) + lu(k,1935) = lu(k,1935) - lu(k,880) * lu(k,1915) + lu(k,1936) = lu(k,1936) - lu(k,881) * lu(k,1915) + lu(k,1937) = lu(k,1937) - lu(k,882) * lu(k,1915) + lu(k,1940) = lu(k,1940) - lu(k,883) * lu(k,1915) + lu(k,1941) = lu(k,1941) - lu(k,884) * lu(k,1915) + lu(k,1942) = lu(k,1942) - lu(k,885) * lu(k,1915) + lu(k,1943) = lu(k,1943) - lu(k,886) * lu(k,1915) + lu(k,1959) = lu(k,1959) - lu(k,867) * lu(k,1957) + lu(k,1962) = lu(k,1962) - lu(k,868) * lu(k,1957) + lu(k,1964) = lu(k,1964) - lu(k,869) * lu(k,1957) + lu(k,1965) = lu(k,1965) - lu(k,870) * lu(k,1957) + lu(k,1966) = lu(k,1966) - lu(k,871) * lu(k,1957) + lu(k,1968) = lu(k,1968) - lu(k,872) * lu(k,1957) + lu(k,1969) = lu(k,1969) - lu(k,873) * lu(k,1957) + lu(k,1970) = lu(k,1970) - lu(k,874) * lu(k,1957) + lu(k,1971) = lu(k,1971) - lu(k,875) * lu(k,1957) + lu(k,1972) = lu(k,1972) - lu(k,876) * lu(k,1957) + lu(k,1974) = lu(k,1974) - lu(k,877) * lu(k,1957) + lu(k,1975) = lu(k,1975) - lu(k,878) * lu(k,1957) + lu(k,1976) = lu(k,1976) - lu(k,879) * lu(k,1957) + lu(k,1977) = lu(k,1977) - lu(k,880) * lu(k,1957) + lu(k,1978) = lu(k,1978) - lu(k,881) * lu(k,1957) + lu(k,1979) = lu(k,1979) - lu(k,882) * lu(k,1957) + lu(k,1982) = lu(k,1982) - lu(k,883) * lu(k,1957) + lu(k,1983) = lu(k,1983) - lu(k,884) * lu(k,1957) + lu(k,1984) = lu(k,1984) - lu(k,885) * lu(k,1957) + lu(k,1985) = lu(k,1985) - lu(k,886) * lu(k,1957) + lu(k,2004) = lu(k,2004) - lu(k,867) * lu(k,2002) + lu(k,2007) = lu(k,2007) - lu(k,868) * lu(k,2002) + lu(k,2009) = lu(k,2009) - lu(k,869) * lu(k,2002) + lu(k,2010) = lu(k,2010) - lu(k,870) * lu(k,2002) + lu(k,2011) = lu(k,2011) - lu(k,871) * lu(k,2002) + lu(k,2013) = lu(k,2013) - lu(k,872) * lu(k,2002) + lu(k,2014) = lu(k,2014) - lu(k,873) * lu(k,2002) + lu(k,2015) = lu(k,2015) - lu(k,874) * lu(k,2002) + lu(k,2016) = lu(k,2016) - lu(k,875) * lu(k,2002) + lu(k,2017) = lu(k,2017) - lu(k,876) * lu(k,2002) + lu(k,2019) = lu(k,2019) - lu(k,877) * lu(k,2002) + lu(k,2020) = lu(k,2020) - lu(k,878) * lu(k,2002) + lu(k,2021) = lu(k,2021) - lu(k,879) * lu(k,2002) + lu(k,2022) = lu(k,2022) - lu(k,880) * lu(k,2002) + lu(k,2023) = lu(k,2023) - lu(k,881) * lu(k,2002) + lu(k,2024) = lu(k,2024) - lu(k,882) * lu(k,2002) + lu(k,2027) = lu(k,2027) - lu(k,883) * lu(k,2002) + lu(k,2028) = lu(k,2028) - lu(k,884) * lu(k,2002) + lu(k,2029) = lu(k,2029) - lu(k,885) * lu(k,2002) + lu(k,2030) = lu(k,2030) - lu(k,886) * lu(k,2002) + lu(k,2064) = lu(k,2064) - lu(k,867) * lu(k,2062) + lu(k,2067) = lu(k,2067) - lu(k,868) * lu(k,2062) + lu(k,2069) = lu(k,2069) - lu(k,869) * lu(k,2062) + lu(k,2070) = lu(k,2070) - lu(k,870) * lu(k,2062) + lu(k,2071) = lu(k,2071) - lu(k,871) * lu(k,2062) + lu(k,2073) = lu(k,2073) - lu(k,872) * lu(k,2062) + lu(k,2074) = lu(k,2074) - lu(k,873) * lu(k,2062) + lu(k,2075) = lu(k,2075) - lu(k,874) * lu(k,2062) + lu(k,2076) = lu(k,2076) - lu(k,875) * lu(k,2062) + lu(k,2077) = lu(k,2077) - lu(k,876) * lu(k,2062) + lu(k,2079) = lu(k,2079) - lu(k,877) * lu(k,2062) + lu(k,2080) = lu(k,2080) - lu(k,878) * lu(k,2062) + lu(k,2081) = lu(k,2081) - lu(k,879) * lu(k,2062) + lu(k,2082) = lu(k,2082) - lu(k,880) * lu(k,2062) + lu(k,2083) = lu(k,2083) - lu(k,881) * lu(k,2062) + lu(k,2084) = lu(k,2084) - lu(k,882) * lu(k,2062) + lu(k,2087) = lu(k,2087) - lu(k,883) * lu(k,2062) + lu(k,2088) = lu(k,2088) - lu(k,884) * lu(k,2062) + lu(k,2089) = lu(k,2089) - lu(k,885) * lu(k,2062) + lu(k,2090) = lu(k,2090) - lu(k,886) * lu(k,2062) + lu(k,900) = 1._r8 / lu(k,900) + lu(k,901) = lu(k,901) * lu(k,900) + lu(k,902) = lu(k,902) * lu(k,900) + lu(k,903) = lu(k,903) * lu(k,900) + lu(k,904) = lu(k,904) * lu(k,900) + lu(k,905) = lu(k,905) * lu(k,900) + lu(k,906) = lu(k,906) * lu(k,900) + lu(k,907) = lu(k,907) * lu(k,900) + lu(k,908) = lu(k,908) * lu(k,900) + lu(k,909) = lu(k,909) * lu(k,900) + lu(k,910) = lu(k,910) * lu(k,900) + lu(k,911) = lu(k,911) * lu(k,900) + lu(k,912) = lu(k,912) * lu(k,900) + lu(k,913) = lu(k,913) * lu(k,900) + lu(k,914) = lu(k,914) * lu(k,900) + lu(k,915) = lu(k,915) * lu(k,900) + lu(k,916) = lu(k,916) * lu(k,900) + lu(k,917) = lu(k,917) * lu(k,900) + lu(k,918) = lu(k,918) * lu(k,900) + lu(k,919) = lu(k,919) * lu(k,900) + lu(k,920) = lu(k,920) * lu(k,900) + lu(k,921) = lu(k,921) * lu(k,900) + lu(k,984) = lu(k,984) - lu(k,901) * lu(k,983) + lu(k,985) = lu(k,985) - lu(k,902) * lu(k,983) + lu(k,986) = lu(k,986) - lu(k,903) * lu(k,983) + lu(k,988) = lu(k,988) - lu(k,904) * lu(k,983) + lu(k,989) = lu(k,989) - lu(k,905) * lu(k,983) + lu(k,990) = lu(k,990) - lu(k,906) * lu(k,983) + lu(k,991) = lu(k,991) - lu(k,907) * lu(k,983) + lu(k,992) = lu(k,992) - lu(k,908) * lu(k,983) + lu(k,993) = lu(k,993) - lu(k,909) * lu(k,983) + lu(k,994) = lu(k,994) - lu(k,910) * lu(k,983) + lu(k,995) = lu(k,995) - lu(k,911) * lu(k,983) + lu(k,996) = lu(k,996) - lu(k,912) * lu(k,983) + lu(k,997) = lu(k,997) - lu(k,913) * lu(k,983) + lu(k,998) = lu(k,998) - lu(k,914) * lu(k,983) + lu(k,999) = lu(k,999) - lu(k,915) * lu(k,983) + lu(k,1000) = lu(k,1000) - lu(k,916) * lu(k,983) + lu(k,1001) = lu(k,1001) - lu(k,917) * lu(k,983) + lu(k,1002) = lu(k,1002) - lu(k,918) * lu(k,983) + lu(k,1003) = lu(k,1003) - lu(k,919) * lu(k,983) + lu(k,1004) = lu(k,1004) - lu(k,920) * lu(k,983) + lu(k,1005) = lu(k,1005) - lu(k,921) * lu(k,983) + lu(k,1057) = lu(k,1057) - lu(k,901) * lu(k,1056) + lu(k,1058) = lu(k,1058) - lu(k,902) * lu(k,1056) + lu(k,1059) = lu(k,1059) - lu(k,903) * lu(k,1056) + lu(k,1062) = lu(k,1062) - lu(k,904) * lu(k,1056) + lu(k,1063) = lu(k,1063) - lu(k,905) * lu(k,1056) + lu(k,1064) = lu(k,1064) - lu(k,906) * lu(k,1056) + lu(k,1065) = lu(k,1065) - lu(k,907) * lu(k,1056) + lu(k,1066) = lu(k,1066) - lu(k,908) * lu(k,1056) + lu(k,1067) = lu(k,1067) - lu(k,909) * lu(k,1056) + lu(k,1068) = lu(k,1068) - lu(k,910) * lu(k,1056) + lu(k,1069) = lu(k,1069) - lu(k,911) * lu(k,1056) + lu(k,1070) = lu(k,1070) - lu(k,912) * lu(k,1056) + lu(k,1073) = lu(k,1073) - lu(k,913) * lu(k,1056) + lu(k,1074) = lu(k,1074) - lu(k,914) * lu(k,1056) + lu(k,1075) = lu(k,1075) - lu(k,915) * lu(k,1056) + lu(k,1076) = lu(k,1076) - lu(k,916) * lu(k,1056) + lu(k,1077) = lu(k,1077) - lu(k,917) * lu(k,1056) + lu(k,1078) = lu(k,1078) - lu(k,918) * lu(k,1056) + lu(k,1079) = lu(k,1079) - lu(k,919) * lu(k,1056) + lu(k,1080) = lu(k,1080) - lu(k,920) * lu(k,1056) + lu(k,1081) = lu(k,1081) - lu(k,921) * lu(k,1056) + lu(k,1101) = lu(k,1101) - lu(k,901) * lu(k,1099) + lu(k,1103) = lu(k,1103) - lu(k,902) * lu(k,1099) + lu(k,1104) = lu(k,1104) - lu(k,903) * lu(k,1099) + lu(k,1107) = lu(k,1107) - lu(k,904) * lu(k,1099) + lu(k,1108) = lu(k,1108) - lu(k,905) * lu(k,1099) + lu(k,1109) = lu(k,1109) - lu(k,906) * lu(k,1099) + lu(k,1110) = lu(k,1110) - lu(k,907) * lu(k,1099) + lu(k,1111) = lu(k,1111) - lu(k,908) * lu(k,1099) + lu(k,1112) = lu(k,1112) - lu(k,909) * lu(k,1099) + lu(k,1113) = lu(k,1113) - lu(k,910) * lu(k,1099) + lu(k,1114) = lu(k,1114) - lu(k,911) * lu(k,1099) + lu(k,1115) = lu(k,1115) - lu(k,912) * lu(k,1099) + lu(k,1118) = lu(k,1118) - lu(k,913) * lu(k,1099) + lu(k,1119) = lu(k,1119) - lu(k,914) * lu(k,1099) + lu(k,1120) = lu(k,1120) - lu(k,915) * lu(k,1099) + lu(k,1121) = lu(k,1121) - lu(k,916) * lu(k,1099) + lu(k,1122) = lu(k,1122) - lu(k,917) * lu(k,1099) + lu(k,1123) = lu(k,1123) - lu(k,918) * lu(k,1099) + lu(k,1124) = lu(k,1124) - lu(k,919) * lu(k,1099) + lu(k,1125) = lu(k,1125) - lu(k,920) * lu(k,1099) + lu(k,1126) = lu(k,1126) - lu(k,921) * lu(k,1099) + lu(k,1149) = lu(k,1149) - lu(k,901) * lu(k,1147) + lu(k,1151) = lu(k,1151) - lu(k,902) * lu(k,1147) + lu(k,1152) = lu(k,1152) - lu(k,903) * lu(k,1147) + lu(k,1155) = lu(k,1155) - lu(k,904) * lu(k,1147) + lu(k,1156) = lu(k,1156) - lu(k,905) * lu(k,1147) + lu(k,1157) = lu(k,1157) - lu(k,906) * lu(k,1147) + lu(k,1158) = lu(k,1158) - lu(k,907) * lu(k,1147) + lu(k,1159) = lu(k,1159) - lu(k,908) * lu(k,1147) + lu(k,1160) = lu(k,1160) - lu(k,909) * lu(k,1147) + lu(k,1161) = lu(k,1161) - lu(k,910) * lu(k,1147) + lu(k,1162) = lu(k,1162) - lu(k,911) * lu(k,1147) + lu(k,1163) = lu(k,1163) - lu(k,912) * lu(k,1147) + lu(k,1166) = lu(k,1166) - lu(k,913) * lu(k,1147) + lu(k,1167) = lu(k,1167) - lu(k,914) * lu(k,1147) + lu(k,1168) = lu(k,1168) - lu(k,915) * lu(k,1147) + lu(k,1169) = lu(k,1169) - lu(k,916) * lu(k,1147) + lu(k,1170) = lu(k,1170) - lu(k,917) * lu(k,1147) + lu(k,1171) = lu(k,1171) - lu(k,918) * lu(k,1147) + lu(k,1172) = lu(k,1172) - lu(k,919) * lu(k,1147) + lu(k,1173) = lu(k,1173) - lu(k,920) * lu(k,1147) + lu(k,1174) = lu(k,1174) - lu(k,921) * lu(k,1147) + lu(k,1192) = lu(k,1192) - lu(k,901) * lu(k,1190) + lu(k,1194) = lu(k,1194) - lu(k,902) * lu(k,1190) + lu(k,1195) = lu(k,1195) - lu(k,903) * lu(k,1190) + lu(k,1198) = lu(k,1198) - lu(k,904) * lu(k,1190) + lu(k,1199) = lu(k,1199) - lu(k,905) * lu(k,1190) + lu(k,1200) = lu(k,1200) - lu(k,906) * lu(k,1190) + lu(k,1201) = lu(k,1201) - lu(k,907) * lu(k,1190) + lu(k,1202) = lu(k,1202) - lu(k,908) * lu(k,1190) + lu(k,1203) = lu(k,1203) - lu(k,909) * lu(k,1190) + lu(k,1204) = lu(k,1204) - lu(k,910) * lu(k,1190) + lu(k,1205) = lu(k,1205) - lu(k,911) * lu(k,1190) + lu(k,1206) = lu(k,1206) - lu(k,912) * lu(k,1190) + lu(k,1209) = lu(k,1209) - lu(k,913) * lu(k,1190) + lu(k,1210) = lu(k,1210) - lu(k,914) * lu(k,1190) + lu(k,1211) = lu(k,1211) - lu(k,915) * lu(k,1190) + lu(k,1212) = lu(k,1212) - lu(k,916) * lu(k,1190) + lu(k,1213) = lu(k,1213) - lu(k,917) * lu(k,1190) + lu(k,1214) = lu(k,1214) - lu(k,918) * lu(k,1190) + lu(k,1215) = lu(k,1215) - lu(k,919) * lu(k,1190) + lu(k,1216) = lu(k,1216) - lu(k,920) * lu(k,1190) + lu(k,1217) = lu(k,1217) - lu(k,921) * lu(k,1190) + lu(k,1235) = lu(k,1235) - lu(k,901) * lu(k,1233) + lu(k,1237) = lu(k,1237) - lu(k,902) * lu(k,1233) + lu(k,1238) = lu(k,1238) - lu(k,903) * lu(k,1233) + lu(k,1241) = lu(k,1241) - lu(k,904) * lu(k,1233) + lu(k,1242) = lu(k,1242) - lu(k,905) * lu(k,1233) + lu(k,1243) = lu(k,1243) - lu(k,906) * lu(k,1233) + lu(k,1244) = lu(k,1244) - lu(k,907) * lu(k,1233) + lu(k,1245) = lu(k,1245) - lu(k,908) * lu(k,1233) + lu(k,1246) = lu(k,1246) - lu(k,909) * lu(k,1233) + lu(k,1247) = lu(k,1247) - lu(k,910) * lu(k,1233) + lu(k,1248) = lu(k,1248) - lu(k,911) * lu(k,1233) + lu(k,1249) = lu(k,1249) - lu(k,912) * lu(k,1233) + lu(k,1252) = lu(k,1252) - lu(k,913) * lu(k,1233) + lu(k,1253) = lu(k,1253) - lu(k,914) * lu(k,1233) + lu(k,1254) = lu(k,1254) - lu(k,915) * lu(k,1233) + lu(k,1255) = lu(k,1255) - lu(k,916) * lu(k,1233) + lu(k,1256) = lu(k,1256) - lu(k,917) * lu(k,1233) + lu(k,1257) = lu(k,1257) - lu(k,918) * lu(k,1233) + lu(k,1258) = lu(k,1258) - lu(k,919) * lu(k,1233) + lu(k,1259) = lu(k,1259) - lu(k,920) * lu(k,1233) + lu(k,1260) = lu(k,1260) - lu(k,921) * lu(k,1233) + lu(k,1277) = lu(k,1277) - lu(k,901) * lu(k,1275) + lu(k,1279) = lu(k,1279) - lu(k,902) * lu(k,1275) + lu(k,1280) = lu(k,1280) - lu(k,903) * lu(k,1275) + lu(k,1283) = lu(k,1283) - lu(k,904) * lu(k,1275) + lu(k,1284) = lu(k,1284) - lu(k,905) * lu(k,1275) + lu(k,1285) = lu(k,1285) - lu(k,906) * lu(k,1275) + lu(k,1286) = lu(k,1286) - lu(k,907) * lu(k,1275) + lu(k,1287) = lu(k,1287) - lu(k,908) * lu(k,1275) + lu(k,1288) = lu(k,1288) - lu(k,909) * lu(k,1275) + lu(k,1289) = lu(k,1289) - lu(k,910) * lu(k,1275) + lu(k,1290) = lu(k,1290) - lu(k,911) * lu(k,1275) + lu(k,1291) = lu(k,1291) - lu(k,912) * lu(k,1275) + lu(k,1294) = lu(k,1294) - lu(k,913) * lu(k,1275) + lu(k,1295) = lu(k,1295) - lu(k,914) * lu(k,1275) + lu(k,1296) = lu(k,1296) - lu(k,915) * lu(k,1275) + lu(k,1297) = lu(k,1297) - lu(k,916) * lu(k,1275) + lu(k,1298) = lu(k,1298) - lu(k,917) * lu(k,1275) + lu(k,1299) = lu(k,1299) - lu(k,918) * lu(k,1275) + lu(k,1300) = lu(k,1300) - lu(k,919) * lu(k,1275) + lu(k,1301) = lu(k,1301) - lu(k,920) * lu(k,1275) + lu(k,1302) = lu(k,1302) - lu(k,921) * lu(k,1275) + lu(k,1319) = lu(k,1319) - lu(k,901) * lu(k,1317) + lu(k,1321) = lu(k,1321) - lu(k,902) * lu(k,1317) + lu(k,1322) = lu(k,1322) - lu(k,903) * lu(k,1317) + lu(k,1325) = lu(k,1325) - lu(k,904) * lu(k,1317) + lu(k,1326) = lu(k,1326) - lu(k,905) * lu(k,1317) + lu(k,1327) = lu(k,1327) - lu(k,906) * lu(k,1317) + lu(k,1328) = lu(k,1328) - lu(k,907) * lu(k,1317) + lu(k,1329) = lu(k,1329) - lu(k,908) * lu(k,1317) + lu(k,1330) = lu(k,1330) - lu(k,909) * lu(k,1317) + lu(k,1331) = lu(k,1331) - lu(k,910) * lu(k,1317) + lu(k,1332) = lu(k,1332) - lu(k,911) * lu(k,1317) + lu(k,1333) = lu(k,1333) - lu(k,912) * lu(k,1317) + lu(k,1336) = lu(k,1336) - lu(k,913) * lu(k,1317) + lu(k,1337) = lu(k,1337) - lu(k,914) * lu(k,1317) + lu(k,1338) = lu(k,1338) - lu(k,915) * lu(k,1317) + lu(k,1339) = lu(k,1339) - lu(k,916) * lu(k,1317) + lu(k,1340) = lu(k,1340) - lu(k,917) * lu(k,1317) + lu(k,1341) = lu(k,1341) - lu(k,918) * lu(k,1317) + lu(k,1342) = lu(k,1342) - lu(k,919) * lu(k,1317) + lu(k,1343) = lu(k,1343) - lu(k,920) * lu(k,1317) + lu(k,1344) = lu(k,1344) - lu(k,921) * lu(k,1317) + lu(k,1379) = lu(k,1379) - lu(k,901) * lu(k,1377) + lu(k,1381) = lu(k,1381) - lu(k,902) * lu(k,1377) + lu(k,1382) = lu(k,1382) - lu(k,903) * lu(k,1377) + lu(k,1385) = lu(k,1385) - lu(k,904) * lu(k,1377) + lu(k,1386) = lu(k,1386) - lu(k,905) * lu(k,1377) + lu(k,1387) = lu(k,1387) - lu(k,906) * lu(k,1377) + lu(k,1388) = lu(k,1388) - lu(k,907) * lu(k,1377) + lu(k,1389) = lu(k,1389) - lu(k,908) * lu(k,1377) + lu(k,1390) = lu(k,1390) - lu(k,909) * lu(k,1377) + lu(k,1391) = lu(k,1391) - lu(k,910) * lu(k,1377) + lu(k,1392) = lu(k,1392) - lu(k,911) * lu(k,1377) + lu(k,1393) = lu(k,1393) - lu(k,912) * lu(k,1377) + lu(k,1396) = lu(k,1396) - lu(k,913) * lu(k,1377) + lu(k,1397) = lu(k,1397) - lu(k,914) * lu(k,1377) + lu(k,1398) = lu(k,1398) - lu(k,915) * lu(k,1377) + lu(k,1399) = lu(k,1399) - lu(k,916) * lu(k,1377) + lu(k,1400) = lu(k,1400) - lu(k,917) * lu(k,1377) + lu(k,1401) = lu(k,1401) - lu(k,918) * lu(k,1377) + lu(k,1402) = lu(k,1402) - lu(k,919) * lu(k,1377) + lu(k,1403) = lu(k,1403) - lu(k,920) * lu(k,1377) + lu(k,1404) = lu(k,1404) - lu(k,921) * lu(k,1377) + lu(k,1428) = lu(k,1428) - lu(k,901) * lu(k,1426) + lu(k,1430) = lu(k,1430) - lu(k,902) * lu(k,1426) + lu(k,1431) = lu(k,1431) - lu(k,903) * lu(k,1426) + lu(k,1434) = lu(k,1434) - lu(k,904) * lu(k,1426) + lu(k,1435) = lu(k,1435) - lu(k,905) * lu(k,1426) + lu(k,1436) = lu(k,1436) - lu(k,906) * lu(k,1426) + lu(k,1437) = lu(k,1437) - lu(k,907) * lu(k,1426) + lu(k,1438) = lu(k,1438) - lu(k,908) * lu(k,1426) + lu(k,1439) = lu(k,1439) - lu(k,909) * lu(k,1426) + lu(k,1440) = lu(k,1440) - lu(k,910) * lu(k,1426) + lu(k,1441) = lu(k,1441) - lu(k,911) * lu(k,1426) + lu(k,1442) = lu(k,1442) - lu(k,912) * lu(k,1426) + lu(k,1445) = lu(k,1445) - lu(k,913) * lu(k,1426) + lu(k,1446) = lu(k,1446) - lu(k,914) * lu(k,1426) + lu(k,1447) = lu(k,1447) - lu(k,915) * lu(k,1426) + lu(k,1448) = lu(k,1448) - lu(k,916) * lu(k,1426) + lu(k,1449) = lu(k,1449) - lu(k,917) * lu(k,1426) + lu(k,1450) = lu(k,1450) - lu(k,918) * lu(k,1426) + lu(k,1451) = lu(k,1451) - lu(k,919) * lu(k,1426) + lu(k,1452) = lu(k,1452) - lu(k,920) * lu(k,1426) + lu(k,1453) = lu(k,1453) - lu(k,921) * lu(k,1426) + lu(k,1476) = lu(k,1476) - lu(k,901) * lu(k,1474) + lu(k,1478) = lu(k,1478) - lu(k,902) * lu(k,1474) + lu(k,1479) = lu(k,1479) - lu(k,903) * lu(k,1474) + lu(k,1482) = lu(k,1482) - lu(k,904) * lu(k,1474) + lu(k,1483) = lu(k,1483) - lu(k,905) * lu(k,1474) + lu(k,1484) = lu(k,1484) - lu(k,906) * lu(k,1474) + lu(k,1485) = lu(k,1485) - lu(k,907) * lu(k,1474) + lu(k,1486) = lu(k,1486) - lu(k,908) * lu(k,1474) + lu(k,1487) = lu(k,1487) - lu(k,909) * lu(k,1474) + lu(k,1488) = lu(k,1488) - lu(k,910) * lu(k,1474) + lu(k,1489) = lu(k,1489) - lu(k,911) * lu(k,1474) + lu(k,1490) = lu(k,1490) - lu(k,912) * lu(k,1474) + lu(k,1493) = lu(k,1493) - lu(k,913) * lu(k,1474) + lu(k,1494) = lu(k,1494) - lu(k,914) * lu(k,1474) + lu(k,1495) = lu(k,1495) - lu(k,915) * lu(k,1474) + lu(k,1496) = lu(k,1496) - lu(k,916) * lu(k,1474) + lu(k,1497) = lu(k,1497) - lu(k,917) * lu(k,1474) + lu(k,1498) = lu(k,1498) - lu(k,918) * lu(k,1474) + lu(k,1499) = lu(k,1499) - lu(k,919) * lu(k,1474) + lu(k,1500) = lu(k,1500) - lu(k,920) * lu(k,1474) + lu(k,1501) = lu(k,1501) - lu(k,921) * lu(k,1474) + lu(k,1517) = lu(k,1517) - lu(k,901) * lu(k,1515) + lu(k,1519) = lu(k,1519) - lu(k,902) * lu(k,1515) + lu(k,1520) = lu(k,1520) - lu(k,903) * lu(k,1515) + lu(k,1523) = lu(k,1523) - lu(k,904) * lu(k,1515) + lu(k,1524) = lu(k,1524) - lu(k,905) * lu(k,1515) + lu(k,1525) = lu(k,1525) - lu(k,906) * lu(k,1515) + lu(k,1526) = lu(k,1526) - lu(k,907) * lu(k,1515) + lu(k,1527) = lu(k,1527) - lu(k,908) * lu(k,1515) + lu(k,1528) = lu(k,1528) - lu(k,909) * lu(k,1515) + lu(k,1529) = lu(k,1529) - lu(k,910) * lu(k,1515) + lu(k,1530) = lu(k,1530) - lu(k,911) * lu(k,1515) + lu(k,1531) = lu(k,1531) - lu(k,912) * lu(k,1515) + lu(k,1534) = lu(k,1534) - lu(k,913) * lu(k,1515) + lu(k,1535) = lu(k,1535) - lu(k,914) * lu(k,1515) + lu(k,1536) = lu(k,1536) - lu(k,915) * lu(k,1515) + lu(k,1537) = lu(k,1537) - lu(k,916) * lu(k,1515) + lu(k,1538) = lu(k,1538) - lu(k,917) * lu(k,1515) + lu(k,1539) = lu(k,1539) - lu(k,918) * lu(k,1515) + lu(k,1540) = lu(k,1540) - lu(k,919) * lu(k,1515) + lu(k,1541) = lu(k,1541) - lu(k,920) * lu(k,1515) + lu(k,1542) = lu(k,1542) - lu(k,921) * lu(k,1515) + lu(k,1553) = lu(k,1553) - lu(k,901) * lu(k,1551) + lu(k,1555) = lu(k,1555) - lu(k,902) * lu(k,1551) + lu(k,1556) = lu(k,1556) - lu(k,903) * lu(k,1551) + lu(k,1559) = lu(k,1559) - lu(k,904) * lu(k,1551) + lu(k,1560) = lu(k,1560) - lu(k,905) * lu(k,1551) + lu(k,1561) = lu(k,1561) - lu(k,906) * lu(k,1551) + lu(k,1562) = lu(k,1562) - lu(k,907) * lu(k,1551) + lu(k,1563) = lu(k,1563) - lu(k,908) * lu(k,1551) + lu(k,1564) = lu(k,1564) - lu(k,909) * lu(k,1551) + lu(k,1565) = lu(k,1565) - lu(k,910) * lu(k,1551) + lu(k,1566) = lu(k,1566) - lu(k,911) * lu(k,1551) + lu(k,1567) = lu(k,1567) - lu(k,912) * lu(k,1551) + lu(k,1570) = lu(k,1570) - lu(k,913) * lu(k,1551) + lu(k,1571) = lu(k,1571) - lu(k,914) * lu(k,1551) + lu(k,1572) = lu(k,1572) - lu(k,915) * lu(k,1551) + lu(k,1573) = lu(k,1573) - lu(k,916) * lu(k,1551) + lu(k,1574) = lu(k,1574) - lu(k,917) * lu(k,1551) + lu(k,1575) = lu(k,1575) - lu(k,918) * lu(k,1551) + lu(k,1576) = lu(k,1576) - lu(k,919) * lu(k,1551) + lu(k,1577) = lu(k,1577) - lu(k,920) * lu(k,1551) + lu(k,1578) = lu(k,1578) - lu(k,921) * lu(k,1551) + lu(k,1598) = lu(k,1598) - lu(k,901) * lu(k,1596) + lu(k,1600) = lu(k,1600) - lu(k,902) * lu(k,1596) + lu(k,1601) = lu(k,1601) - lu(k,903) * lu(k,1596) + lu(k,1604) = lu(k,1604) - lu(k,904) * lu(k,1596) + lu(k,1605) = lu(k,1605) - lu(k,905) * lu(k,1596) + lu(k,1606) = lu(k,1606) - lu(k,906) * lu(k,1596) + lu(k,1607) = lu(k,1607) - lu(k,907) * lu(k,1596) + lu(k,1608) = lu(k,1608) - lu(k,908) * lu(k,1596) + lu(k,1609) = lu(k,1609) - lu(k,909) * lu(k,1596) + lu(k,1610) = lu(k,1610) - lu(k,910) * lu(k,1596) + lu(k,1611) = lu(k,1611) - lu(k,911) * lu(k,1596) + lu(k,1612) = lu(k,1612) - lu(k,912) * lu(k,1596) + lu(k,1615) = lu(k,1615) - lu(k,913) * lu(k,1596) + lu(k,1616) = lu(k,1616) - lu(k,914) * lu(k,1596) + lu(k,1617) = lu(k,1617) - lu(k,915) * lu(k,1596) + lu(k,1618) = lu(k,1618) - lu(k,916) * lu(k,1596) + lu(k,1619) = lu(k,1619) - lu(k,917) * lu(k,1596) + lu(k,1620) = lu(k,1620) - lu(k,918) * lu(k,1596) + lu(k,1621) = lu(k,1621) - lu(k,919) * lu(k,1596) + lu(k,1622) = lu(k,1622) - lu(k,920) * lu(k,1596) + lu(k,1623) = lu(k,1623) - lu(k,921) * lu(k,1596) + lu(k,1641) = lu(k,1641) - lu(k,901) * lu(k,1639) + lu(k,1643) = lu(k,1643) - lu(k,902) * lu(k,1639) + lu(k,1644) = lu(k,1644) - lu(k,903) * lu(k,1639) + lu(k,1647) = lu(k,1647) - lu(k,904) * lu(k,1639) + lu(k,1648) = lu(k,1648) - lu(k,905) * lu(k,1639) + lu(k,1649) = lu(k,1649) - lu(k,906) * lu(k,1639) + lu(k,1650) = lu(k,1650) - lu(k,907) * lu(k,1639) + lu(k,1651) = lu(k,1651) - lu(k,908) * lu(k,1639) + lu(k,1652) = lu(k,1652) - lu(k,909) * lu(k,1639) + lu(k,1653) = lu(k,1653) - lu(k,910) * lu(k,1639) + lu(k,1654) = lu(k,1654) - lu(k,911) * lu(k,1639) + lu(k,1655) = lu(k,1655) - lu(k,912) * lu(k,1639) + lu(k,1658) = lu(k,1658) - lu(k,913) * lu(k,1639) + lu(k,1659) = lu(k,1659) - lu(k,914) * lu(k,1639) + lu(k,1660) = lu(k,1660) - lu(k,915) * lu(k,1639) + lu(k,1661) = lu(k,1661) - lu(k,916) * lu(k,1639) + lu(k,1662) = lu(k,1662) - lu(k,917) * lu(k,1639) + lu(k,1663) = lu(k,1663) - lu(k,918) * lu(k,1639) + lu(k,1664) = lu(k,1664) - lu(k,919) * lu(k,1639) + lu(k,1665) = lu(k,1665) - lu(k,920) * lu(k,1639) + lu(k,1666) = lu(k,1666) - lu(k,921) * lu(k,1639) + lu(k,1684) = lu(k,1684) - lu(k,901) * lu(k,1682) + lu(k,1686) = lu(k,1686) - lu(k,902) * lu(k,1682) + lu(k,1687) = lu(k,1687) - lu(k,903) * lu(k,1682) + lu(k,1690) = lu(k,1690) - lu(k,904) * lu(k,1682) + lu(k,1691) = lu(k,1691) - lu(k,905) * lu(k,1682) + lu(k,1692) = lu(k,1692) - lu(k,906) * lu(k,1682) + lu(k,1693) = lu(k,1693) - lu(k,907) * lu(k,1682) + lu(k,1694) = lu(k,1694) - lu(k,908) * lu(k,1682) + lu(k,1695) = lu(k,1695) - lu(k,909) * lu(k,1682) + lu(k,1696) = lu(k,1696) - lu(k,910) * lu(k,1682) + lu(k,1697) = lu(k,1697) - lu(k,911) * lu(k,1682) + lu(k,1698) = lu(k,1698) - lu(k,912) * lu(k,1682) + lu(k,1701) = lu(k,1701) - lu(k,913) * lu(k,1682) + lu(k,1702) = lu(k,1702) - lu(k,914) * lu(k,1682) + lu(k,1703) = lu(k,1703) - lu(k,915) * lu(k,1682) + lu(k,1704) = lu(k,1704) - lu(k,916) * lu(k,1682) + lu(k,1705) = lu(k,1705) - lu(k,917) * lu(k,1682) + lu(k,1706) = lu(k,1706) - lu(k,918) * lu(k,1682) + lu(k,1707) = lu(k,1707) - lu(k,919) * lu(k,1682) + lu(k,1708) = lu(k,1708) - lu(k,920) * lu(k,1682) + lu(k,1709) = lu(k,1709) - lu(k,921) * lu(k,1682) + lu(k,1725) = lu(k,1725) - lu(k,901) * lu(k,1723) + lu(k,1726) = lu(k,1726) - lu(k,902) * lu(k,1723) + lu(k,1727) = lu(k,1727) - lu(k,903) * lu(k,1723) + lu(k,1730) = lu(k,1730) - lu(k,904) * lu(k,1723) + lu(k,1731) = lu(k,1731) - lu(k,905) * lu(k,1723) + lu(k,1732) = lu(k,1732) - lu(k,906) * lu(k,1723) + lu(k,1733) = lu(k,1733) - lu(k,907) * lu(k,1723) + lu(k,1734) = lu(k,1734) - lu(k,908) * lu(k,1723) + lu(k,1735) = lu(k,1735) - lu(k,909) * lu(k,1723) + lu(k,1736) = lu(k,1736) - lu(k,910) * lu(k,1723) + lu(k,1737) = lu(k,1737) - lu(k,911) * lu(k,1723) + lu(k,1738) = lu(k,1738) - lu(k,912) * lu(k,1723) + lu(k,1741) = lu(k,1741) - lu(k,913) * lu(k,1723) + lu(k,1742) = lu(k,1742) - lu(k,914) * lu(k,1723) + lu(k,1743) = lu(k,1743) - lu(k,915) * lu(k,1723) + lu(k,1744) = lu(k,1744) - lu(k,916) * lu(k,1723) + lu(k,1745) = lu(k,1745) - lu(k,917) * lu(k,1723) + lu(k,1746) = lu(k,1746) - lu(k,918) * lu(k,1723) + lu(k,1747) = lu(k,1747) - lu(k,919) * lu(k,1723) + lu(k,1748) = lu(k,1748) - lu(k,920) * lu(k,1723) + lu(k,1749) = lu(k,1749) - lu(k,921) * lu(k,1723) + lu(k,1760) = lu(k,1760) - lu(k,901) * lu(k,1758) + lu(k,1762) = lu(k,1762) - lu(k,902) * lu(k,1758) + lu(k,1763) = lu(k,1763) - lu(k,903) * lu(k,1758) + lu(k,1766) = lu(k,1766) - lu(k,904) * lu(k,1758) + lu(k,1767) = lu(k,1767) - lu(k,905) * lu(k,1758) + lu(k,1768) = lu(k,1768) - lu(k,906) * lu(k,1758) + lu(k,1769) = lu(k,1769) - lu(k,907) * lu(k,1758) + lu(k,1770) = lu(k,1770) - lu(k,908) * lu(k,1758) + lu(k,1771) = lu(k,1771) - lu(k,909) * lu(k,1758) + lu(k,1772) = lu(k,1772) - lu(k,910) * lu(k,1758) + lu(k,1773) = lu(k,1773) - lu(k,911) * lu(k,1758) + lu(k,1774) = lu(k,1774) - lu(k,912) * lu(k,1758) + lu(k,1777) = lu(k,1777) - lu(k,913) * lu(k,1758) + lu(k,1778) = lu(k,1778) - lu(k,914) * lu(k,1758) + lu(k,1779) = lu(k,1779) - lu(k,915) * lu(k,1758) + lu(k,1780) = lu(k,1780) - lu(k,916) * lu(k,1758) + lu(k,1781) = lu(k,1781) - lu(k,917) * lu(k,1758) + lu(k,1782) = lu(k,1782) - lu(k,918) * lu(k,1758) + lu(k,1783) = lu(k,1783) - lu(k,919) * lu(k,1758) + lu(k,1784) = lu(k,1784) - lu(k,920) * lu(k,1758) + lu(k,1785) = lu(k,1785) - lu(k,921) * lu(k,1758) + lu(k,1808) = lu(k,1808) - lu(k,901) * lu(k,1806) + lu(k,1810) = lu(k,1810) - lu(k,902) * lu(k,1806) + lu(k,1811) = lu(k,1811) - lu(k,903) * lu(k,1806) + lu(k,1814) = lu(k,1814) - lu(k,904) * lu(k,1806) + lu(k,1815) = lu(k,1815) - lu(k,905) * lu(k,1806) + lu(k,1816) = lu(k,1816) - lu(k,906) * lu(k,1806) + lu(k,1817) = lu(k,1817) - lu(k,907) * lu(k,1806) + lu(k,1818) = lu(k,1818) - lu(k,908) * lu(k,1806) + lu(k,1819) = lu(k,1819) - lu(k,909) * lu(k,1806) + lu(k,1820) = lu(k,1820) - lu(k,910) * lu(k,1806) + lu(k,1821) = lu(k,1821) - lu(k,911) * lu(k,1806) + lu(k,1822) = lu(k,1822) - lu(k,912) * lu(k,1806) + lu(k,1825) = lu(k,1825) - lu(k,913) * lu(k,1806) + lu(k,1826) = lu(k,1826) - lu(k,914) * lu(k,1806) + lu(k,1827) = lu(k,1827) - lu(k,915) * lu(k,1806) + lu(k,1828) = lu(k,1828) - lu(k,916) * lu(k,1806) + lu(k,1829) = lu(k,1829) - lu(k,917) * lu(k,1806) + lu(k,1830) = lu(k,1830) - lu(k,918) * lu(k,1806) + lu(k,1831) = lu(k,1831) - lu(k,919) * lu(k,1806) + lu(k,1832) = lu(k,1832) - lu(k,920) * lu(k,1806) + lu(k,1833) = lu(k,1833) - lu(k,921) * lu(k,1806) + lu(k,1841) = lu(k,1841) - lu(k,901) * lu(k,1839) + lu(k,1843) = lu(k,1843) - lu(k,902) * lu(k,1839) + lu(k,1844) = lu(k,1844) - lu(k,903) * lu(k,1839) + lu(k,1847) = lu(k,1847) - lu(k,904) * lu(k,1839) + lu(k,1848) = lu(k,1848) - lu(k,905) * lu(k,1839) + lu(k,1849) = lu(k,1849) - lu(k,906) * lu(k,1839) + lu(k,1850) = lu(k,1850) - lu(k,907) * lu(k,1839) + lu(k,1851) = lu(k,1851) - lu(k,908) * lu(k,1839) + lu(k,1852) = lu(k,1852) - lu(k,909) * lu(k,1839) + lu(k,1853) = lu(k,1853) - lu(k,910) * lu(k,1839) + lu(k,1854) = lu(k,1854) - lu(k,911) * lu(k,1839) + lu(k,1855) = lu(k,1855) - lu(k,912) * lu(k,1839) + lu(k,1858) = lu(k,1858) - lu(k,913) * lu(k,1839) + lu(k,1859) = lu(k,1859) - lu(k,914) * lu(k,1839) + lu(k,1860) = lu(k,1860) - lu(k,915) * lu(k,1839) + lu(k,1861) = lu(k,1861) - lu(k,916) * lu(k,1839) + lu(k,1862) = lu(k,1862) - lu(k,917) * lu(k,1839) + lu(k,1863) = lu(k,1863) - lu(k,918) * lu(k,1839) + lu(k,1864) = lu(k,1864) - lu(k,919) * lu(k,1839) + lu(k,1865) = lu(k,1865) - lu(k,920) * lu(k,1839) + lu(k,1866) = lu(k,1866) - lu(k,921) * lu(k,1839) + lu(k,1877) = lu(k,1877) - lu(k,901) * lu(k,1875) + lu(k,1879) = lu(k,1879) - lu(k,902) * lu(k,1875) + lu(k,1880) = lu(k,1880) - lu(k,903) * lu(k,1875) + lu(k,1883) = lu(k,1883) - lu(k,904) * lu(k,1875) + lu(k,1884) = lu(k,1884) - lu(k,905) * lu(k,1875) + lu(k,1885) = lu(k,1885) - lu(k,906) * lu(k,1875) + lu(k,1886) = lu(k,1886) - lu(k,907) * lu(k,1875) + lu(k,1887) = lu(k,1887) - lu(k,908) * lu(k,1875) + lu(k,1888) = lu(k,1888) - lu(k,909) * lu(k,1875) + lu(k,1889) = lu(k,1889) - lu(k,910) * lu(k,1875) + lu(k,1890) = lu(k,1890) - lu(k,911) * lu(k,1875) + lu(k,1891) = lu(k,1891) - lu(k,912) * lu(k,1875) + lu(k,1894) = lu(k,1894) - lu(k,913) * lu(k,1875) + lu(k,1895) = lu(k,1895) - lu(k,914) * lu(k,1875) + lu(k,1896) = lu(k,1896) - lu(k,915) * lu(k,1875) + lu(k,1897) = lu(k,1897) - lu(k,916) * lu(k,1875) + lu(k,1898) = lu(k,1898) - lu(k,917) * lu(k,1875) + lu(k,1899) = lu(k,1899) - lu(k,918) * lu(k,1875) + lu(k,1900) = lu(k,1900) - lu(k,919) * lu(k,1875) + lu(k,1901) = lu(k,1901) - lu(k,920) * lu(k,1875) + lu(k,1902) = lu(k,1902) - lu(k,921) * lu(k,1875) + lu(k,1918) = lu(k,1918) - lu(k,901) * lu(k,1916) + lu(k,1920) = lu(k,1920) - lu(k,902) * lu(k,1916) + lu(k,1921) = lu(k,1921) - lu(k,903) * lu(k,1916) + lu(k,1924) = lu(k,1924) - lu(k,904) * lu(k,1916) + lu(k,1925) = lu(k,1925) - lu(k,905) * lu(k,1916) + lu(k,1926) = lu(k,1926) - lu(k,906) * lu(k,1916) + lu(k,1927) = lu(k,1927) - lu(k,907) * lu(k,1916) + lu(k,1928) = lu(k,1928) - lu(k,908) * lu(k,1916) + lu(k,1929) = lu(k,1929) - lu(k,909) * lu(k,1916) + lu(k,1930) = lu(k,1930) - lu(k,910) * lu(k,1916) + lu(k,1931) = lu(k,1931) - lu(k,911) * lu(k,1916) + lu(k,1932) = lu(k,1932) - lu(k,912) * lu(k,1916) + lu(k,1935) = lu(k,1935) - lu(k,913) * lu(k,1916) + lu(k,1936) = lu(k,1936) - lu(k,914) * lu(k,1916) + lu(k,1937) = lu(k,1937) - lu(k,915) * lu(k,1916) + lu(k,1938) = lu(k,1938) - lu(k,916) * lu(k,1916) + lu(k,1939) = lu(k,1939) - lu(k,917) * lu(k,1916) + lu(k,1940) = lu(k,1940) - lu(k,918) * lu(k,1916) + lu(k,1941) = lu(k,1941) - lu(k,919) * lu(k,1916) + lu(k,1942) = lu(k,1942) - lu(k,920) * lu(k,1916) + lu(k,1943) = lu(k,1943) - lu(k,921) * lu(k,1916) + lu(k,1960) = lu(k,1960) - lu(k,901) * lu(k,1958) + lu(k,1962) = lu(k,1962) - lu(k,902) * lu(k,1958) + lu(k,1963) = lu(k,1963) - lu(k,903) * lu(k,1958) + lu(k,1966) = lu(k,1966) - lu(k,904) * lu(k,1958) + lu(k,1967) = lu(k,1967) - lu(k,905) * lu(k,1958) + lu(k,1968) = lu(k,1968) - lu(k,906) * lu(k,1958) + lu(k,1969) = lu(k,1969) - lu(k,907) * lu(k,1958) + lu(k,1970) = lu(k,1970) - lu(k,908) * lu(k,1958) + lu(k,1971) = lu(k,1971) - lu(k,909) * lu(k,1958) + lu(k,1972) = lu(k,1972) - lu(k,910) * lu(k,1958) + lu(k,1973) = lu(k,1973) - lu(k,911) * lu(k,1958) + lu(k,1974) = lu(k,1974) - lu(k,912) * lu(k,1958) + lu(k,1977) = lu(k,1977) - lu(k,913) * lu(k,1958) + lu(k,1978) = lu(k,1978) - lu(k,914) * lu(k,1958) + lu(k,1979) = lu(k,1979) - lu(k,915) * lu(k,1958) + lu(k,1980) = lu(k,1980) - lu(k,916) * lu(k,1958) + lu(k,1981) = lu(k,1981) - lu(k,917) * lu(k,1958) + lu(k,1982) = lu(k,1982) - lu(k,918) * lu(k,1958) + lu(k,1983) = lu(k,1983) - lu(k,919) * lu(k,1958) + lu(k,1984) = lu(k,1984) - lu(k,920) * lu(k,1958) + lu(k,1985) = lu(k,1985) - lu(k,921) * lu(k,1958) + lu(k,2005) = lu(k,2005) - lu(k,901) * lu(k,2003) + lu(k,2007) = lu(k,2007) - lu(k,902) * lu(k,2003) + lu(k,2008) = lu(k,2008) - lu(k,903) * lu(k,2003) + lu(k,2011) = lu(k,2011) - lu(k,904) * lu(k,2003) + lu(k,2012) = lu(k,2012) - lu(k,905) * lu(k,2003) + lu(k,2013) = lu(k,2013) - lu(k,906) * lu(k,2003) + lu(k,2014) = lu(k,2014) - lu(k,907) * lu(k,2003) + lu(k,2015) = lu(k,2015) - lu(k,908) * lu(k,2003) + lu(k,2016) = lu(k,2016) - lu(k,909) * lu(k,2003) + lu(k,2017) = lu(k,2017) - lu(k,910) * lu(k,2003) + lu(k,2018) = lu(k,2018) - lu(k,911) * lu(k,2003) + lu(k,2019) = lu(k,2019) - lu(k,912) * lu(k,2003) + lu(k,2022) = lu(k,2022) - lu(k,913) * lu(k,2003) + lu(k,2023) = lu(k,2023) - lu(k,914) * lu(k,2003) + lu(k,2024) = lu(k,2024) - lu(k,915) * lu(k,2003) + lu(k,2025) = lu(k,2025) - lu(k,916) * lu(k,2003) + lu(k,2026) = lu(k,2026) - lu(k,917) * lu(k,2003) + lu(k,2027) = lu(k,2027) - lu(k,918) * lu(k,2003) + lu(k,2028) = lu(k,2028) - lu(k,919) * lu(k,2003) + lu(k,2029) = lu(k,2029) - lu(k,920) * lu(k,2003) + lu(k,2030) = lu(k,2030) - lu(k,921) * lu(k,2003) + lu(k,2065) = lu(k,2065) - lu(k,901) * lu(k,2063) + lu(k,2067) = lu(k,2067) - lu(k,902) * lu(k,2063) + lu(k,2068) = lu(k,2068) - lu(k,903) * lu(k,2063) + lu(k,2071) = lu(k,2071) - lu(k,904) * lu(k,2063) + lu(k,2072) = lu(k,2072) - lu(k,905) * lu(k,2063) + lu(k,2073) = lu(k,2073) - lu(k,906) * lu(k,2063) + lu(k,2074) = lu(k,2074) - lu(k,907) * lu(k,2063) + lu(k,2075) = lu(k,2075) - lu(k,908) * lu(k,2063) + lu(k,2076) = lu(k,2076) - lu(k,909) * lu(k,2063) + lu(k,2077) = lu(k,2077) - lu(k,910) * lu(k,2063) + lu(k,2078) = lu(k,2078) - lu(k,911) * lu(k,2063) + lu(k,2079) = lu(k,2079) - lu(k,912) * lu(k,2063) + lu(k,2082) = lu(k,2082) - lu(k,913) * lu(k,2063) + lu(k,2083) = lu(k,2083) - lu(k,914) * lu(k,2063) + lu(k,2084) = lu(k,2084) - lu(k,915) * lu(k,2063) + lu(k,2085) = lu(k,2085) - lu(k,916) * lu(k,2063) + lu(k,2086) = lu(k,2086) - lu(k,917) * lu(k,2063) + lu(k,2087) = lu(k,2087) - lu(k,918) * lu(k,2063) + lu(k,2088) = lu(k,2088) - lu(k,919) * lu(k,2063) + lu(k,2089) = lu(k,2089) - lu(k,920) * lu(k,2063) + lu(k,2090) = lu(k,2090) - lu(k,921) * lu(k,2063) + lu(k,926) = 1._r8 / lu(k,926) + lu(k,927) = lu(k,927) * lu(k,926) + lu(k,928) = lu(k,928) * lu(k,926) + lu(k,929) = lu(k,929) * lu(k,926) + lu(k,930) = lu(k,930) * lu(k,926) + lu(k,931) = lu(k,931) * lu(k,926) + lu(k,932) = lu(k,932) * lu(k,926) + lu(k,933) = lu(k,933) * lu(k,926) + lu(k,934) = lu(k,934) * lu(k,926) + lu(k,935) = lu(k,935) * lu(k,926) + lu(k,936) = lu(k,936) * lu(k,926) + lu(k,937) = lu(k,937) * lu(k,926) + lu(k,938) = lu(k,938) * lu(k,926) + lu(k,939) = lu(k,939) * lu(k,926) + lu(k,940) = lu(k,940) * lu(k,926) + lu(k,941) = lu(k,941) * lu(k,926) + lu(k,942) = lu(k,942) * lu(k,926) + lu(k,943) = lu(k,943) * lu(k,926) + lu(k,944) = lu(k,944) * lu(k,926) + lu(k,945) = lu(k,945) * lu(k,926) + lu(k,946) = lu(k,946) * lu(k,926) + lu(k,947) = lu(k,947) * lu(k,926) + lu(k,948) = lu(k,948) * lu(k,926) + lu(k,1013) = lu(k,1013) - lu(k,927) * lu(k,1012) + lu(k,1015) = lu(k,1015) - lu(k,928) * lu(k,1012) + lu(k,1016) = lu(k,1016) - lu(k,929) * lu(k,1012) + lu(k,1017) = lu(k,1017) - lu(k,930) * lu(k,1012) + lu(k,1018) = lu(k,1018) - lu(k,931) * lu(k,1012) + lu(k,1019) = lu(k,1019) - lu(k,932) * lu(k,1012) + lu(k,1021) = lu(k,1021) - lu(k,933) * lu(k,1012) + lu(k,1022) = lu(k,1022) - lu(k,934) * lu(k,1012) + lu(k,1023) = lu(k,1023) - lu(k,935) * lu(k,1012) + lu(k,1024) = lu(k,1024) - lu(k,936) * lu(k,1012) + lu(k,1025) = lu(k,1025) - lu(k,937) * lu(k,1012) + lu(k,1027) = lu(k,1027) - lu(k,938) * lu(k,1012) + lu(k,1028) = lu(k,1028) - lu(k,939) * lu(k,1012) + lu(k,1029) = lu(k,1029) - lu(k,940) * lu(k,1012) + lu(k,1030) = lu(k,1030) - lu(k,941) * lu(k,1012) + lu(k,1031) = lu(k,1031) - lu(k,942) * lu(k,1012) + lu(k,1032) = lu(k,1032) - lu(k,943) * lu(k,1012) + lu(k,1033) = lu(k,1033) - lu(k,944) * lu(k,1012) + lu(k,1035) = lu(k,1035) - lu(k,945) * lu(k,1012) + lu(k,1036) = lu(k,1036) - lu(k,946) * lu(k,1012) + lu(k,1037) = lu(k,1037) - lu(k,947) * lu(k,1012) + lu(k,1038) = lu(k,1038) - lu(k,948) * lu(k,1012) + lu(k,1101) = lu(k,1101) - lu(k,927) * lu(k,1100) + lu(k,1103) = lu(k,1103) - lu(k,928) * lu(k,1100) + lu(k,1104) = lu(k,1104) - lu(k,929) * lu(k,1100) + lu(k,1105) = lu(k,1105) - lu(k,930) * lu(k,1100) + lu(k,1106) = lu(k,1106) - lu(k,931) * lu(k,1100) + lu(k,1107) = lu(k,1107) - lu(k,932) * lu(k,1100) + lu(k,1109) = lu(k,1109) - lu(k,933) * lu(k,1100) + lu(k,1110) = lu(k,1110) - lu(k,934) * lu(k,1100) + lu(k,1111) = lu(k,1111) - lu(k,935) * lu(k,1100) + lu(k,1112) = lu(k,1112) - lu(k,936) * lu(k,1100) + lu(k,1113) = lu(k,1113) - lu(k,937) * lu(k,1100) + lu(k,1115) = lu(k,1115) - lu(k,938) * lu(k,1100) + lu(k,1116) = lu(k,1116) - lu(k,939) * lu(k,1100) + lu(k,1117) = lu(k,1117) - lu(k,940) * lu(k,1100) + lu(k,1118) = lu(k,1118) - lu(k,941) * lu(k,1100) + lu(k,1119) = lu(k,1119) - lu(k,942) * lu(k,1100) + lu(k,1120) = lu(k,1120) - lu(k,943) * lu(k,1100) + lu(k,1121) = lu(k,1121) - lu(k,944) * lu(k,1100) + lu(k,1123) = lu(k,1123) - lu(k,945) * lu(k,1100) + lu(k,1124) = lu(k,1124) - lu(k,946) * lu(k,1100) + lu(k,1125) = lu(k,1125) - lu(k,947) * lu(k,1100) + lu(k,1126) = lu(k,1126) - lu(k,948) * lu(k,1100) + lu(k,1149) = lu(k,1149) - lu(k,927) * lu(k,1148) + lu(k,1151) = lu(k,1151) - lu(k,928) * lu(k,1148) + lu(k,1152) = lu(k,1152) - lu(k,929) * lu(k,1148) + lu(k,1153) = lu(k,1153) - lu(k,930) * lu(k,1148) + lu(k,1154) = lu(k,1154) - lu(k,931) * lu(k,1148) + lu(k,1155) = lu(k,1155) - lu(k,932) * lu(k,1148) + lu(k,1157) = lu(k,1157) - lu(k,933) * lu(k,1148) + lu(k,1158) = lu(k,1158) - lu(k,934) * lu(k,1148) + lu(k,1159) = lu(k,1159) - lu(k,935) * lu(k,1148) + lu(k,1160) = lu(k,1160) - lu(k,936) * lu(k,1148) + lu(k,1161) = lu(k,1161) - lu(k,937) * lu(k,1148) + lu(k,1163) = lu(k,1163) - lu(k,938) * lu(k,1148) + lu(k,1164) = lu(k,1164) - lu(k,939) * lu(k,1148) + lu(k,1165) = lu(k,1165) - lu(k,940) * lu(k,1148) + lu(k,1166) = lu(k,1166) - lu(k,941) * lu(k,1148) + lu(k,1167) = lu(k,1167) - lu(k,942) * lu(k,1148) + lu(k,1168) = lu(k,1168) - lu(k,943) * lu(k,1148) + lu(k,1169) = lu(k,1169) - lu(k,944) * lu(k,1148) + lu(k,1171) = lu(k,1171) - lu(k,945) * lu(k,1148) + lu(k,1172) = lu(k,1172) - lu(k,946) * lu(k,1148) + lu(k,1173) = lu(k,1173) - lu(k,947) * lu(k,1148) + lu(k,1174) = lu(k,1174) - lu(k,948) * lu(k,1148) + lu(k,1192) = lu(k,1192) - lu(k,927) * lu(k,1191) + lu(k,1194) = lu(k,1194) - lu(k,928) * lu(k,1191) + lu(k,1195) = lu(k,1195) - lu(k,929) * lu(k,1191) + lu(k,1196) = lu(k,1196) - lu(k,930) * lu(k,1191) + lu(k,1197) = lu(k,1197) - lu(k,931) * lu(k,1191) + lu(k,1198) = lu(k,1198) - lu(k,932) * lu(k,1191) + lu(k,1200) = lu(k,1200) - lu(k,933) * lu(k,1191) + lu(k,1201) = lu(k,1201) - lu(k,934) * lu(k,1191) + lu(k,1202) = lu(k,1202) - lu(k,935) * lu(k,1191) + lu(k,1203) = lu(k,1203) - lu(k,936) * lu(k,1191) + lu(k,1204) = lu(k,1204) - lu(k,937) * lu(k,1191) + lu(k,1206) = lu(k,1206) - lu(k,938) * lu(k,1191) + lu(k,1207) = lu(k,1207) - lu(k,939) * lu(k,1191) + lu(k,1208) = lu(k,1208) - lu(k,940) * lu(k,1191) + lu(k,1209) = lu(k,1209) - lu(k,941) * lu(k,1191) + lu(k,1210) = lu(k,1210) - lu(k,942) * lu(k,1191) + lu(k,1211) = lu(k,1211) - lu(k,943) * lu(k,1191) + lu(k,1212) = lu(k,1212) - lu(k,944) * lu(k,1191) + lu(k,1214) = lu(k,1214) - lu(k,945) * lu(k,1191) + lu(k,1215) = lu(k,1215) - lu(k,946) * lu(k,1191) + lu(k,1216) = lu(k,1216) - lu(k,947) * lu(k,1191) + lu(k,1217) = lu(k,1217) - lu(k,948) * lu(k,1191) + lu(k,1235) = lu(k,1235) - lu(k,927) * lu(k,1234) + lu(k,1237) = lu(k,1237) - lu(k,928) * lu(k,1234) + lu(k,1238) = lu(k,1238) - lu(k,929) * lu(k,1234) + lu(k,1239) = lu(k,1239) - lu(k,930) * lu(k,1234) + lu(k,1240) = lu(k,1240) - lu(k,931) * lu(k,1234) + lu(k,1241) = lu(k,1241) - lu(k,932) * lu(k,1234) + lu(k,1243) = lu(k,1243) - lu(k,933) * lu(k,1234) + lu(k,1244) = lu(k,1244) - lu(k,934) * lu(k,1234) + lu(k,1245) = lu(k,1245) - lu(k,935) * lu(k,1234) + lu(k,1246) = lu(k,1246) - lu(k,936) * lu(k,1234) + lu(k,1247) = lu(k,1247) - lu(k,937) * lu(k,1234) + lu(k,1249) = lu(k,1249) - lu(k,938) * lu(k,1234) + lu(k,1250) = lu(k,1250) - lu(k,939) * lu(k,1234) + lu(k,1251) = lu(k,1251) - lu(k,940) * lu(k,1234) + lu(k,1252) = lu(k,1252) - lu(k,941) * lu(k,1234) + lu(k,1253) = lu(k,1253) - lu(k,942) * lu(k,1234) + lu(k,1254) = lu(k,1254) - lu(k,943) * lu(k,1234) + lu(k,1255) = lu(k,1255) - lu(k,944) * lu(k,1234) + lu(k,1257) = lu(k,1257) - lu(k,945) * lu(k,1234) + lu(k,1258) = lu(k,1258) - lu(k,946) * lu(k,1234) + lu(k,1259) = lu(k,1259) - lu(k,947) * lu(k,1234) + lu(k,1260) = lu(k,1260) - lu(k,948) * lu(k,1234) + lu(k,1277) = lu(k,1277) - lu(k,927) * lu(k,1276) + lu(k,1279) = lu(k,1279) - lu(k,928) * lu(k,1276) + lu(k,1280) = lu(k,1280) - lu(k,929) * lu(k,1276) + lu(k,1281) = lu(k,1281) - lu(k,930) * lu(k,1276) + lu(k,1282) = lu(k,1282) - lu(k,931) * lu(k,1276) + lu(k,1283) = lu(k,1283) - lu(k,932) * lu(k,1276) + lu(k,1285) = lu(k,1285) - lu(k,933) * lu(k,1276) + lu(k,1286) = lu(k,1286) - lu(k,934) * lu(k,1276) + lu(k,1287) = lu(k,1287) - lu(k,935) * lu(k,1276) + lu(k,1288) = lu(k,1288) - lu(k,936) * lu(k,1276) + lu(k,1289) = lu(k,1289) - lu(k,937) * lu(k,1276) + lu(k,1291) = lu(k,1291) - lu(k,938) * lu(k,1276) + lu(k,1292) = lu(k,1292) - lu(k,939) * lu(k,1276) + lu(k,1293) = lu(k,1293) - lu(k,940) * lu(k,1276) + lu(k,1294) = lu(k,1294) - lu(k,941) * lu(k,1276) + lu(k,1295) = lu(k,1295) - lu(k,942) * lu(k,1276) + lu(k,1296) = lu(k,1296) - lu(k,943) * lu(k,1276) + lu(k,1297) = lu(k,1297) - lu(k,944) * lu(k,1276) + lu(k,1299) = lu(k,1299) - lu(k,945) * lu(k,1276) + lu(k,1300) = lu(k,1300) - lu(k,946) * lu(k,1276) + lu(k,1301) = lu(k,1301) - lu(k,947) * lu(k,1276) + lu(k,1302) = lu(k,1302) - lu(k,948) * lu(k,1276) + lu(k,1319) = lu(k,1319) - lu(k,927) * lu(k,1318) + lu(k,1321) = lu(k,1321) - lu(k,928) * lu(k,1318) + lu(k,1322) = lu(k,1322) - lu(k,929) * lu(k,1318) + lu(k,1323) = lu(k,1323) - lu(k,930) * lu(k,1318) + lu(k,1324) = lu(k,1324) - lu(k,931) * lu(k,1318) + lu(k,1325) = lu(k,1325) - lu(k,932) * lu(k,1318) + lu(k,1327) = lu(k,1327) - lu(k,933) * lu(k,1318) + lu(k,1328) = lu(k,1328) - lu(k,934) * lu(k,1318) + lu(k,1329) = lu(k,1329) - lu(k,935) * lu(k,1318) + lu(k,1330) = lu(k,1330) - lu(k,936) * lu(k,1318) + lu(k,1331) = lu(k,1331) - lu(k,937) * lu(k,1318) + lu(k,1333) = lu(k,1333) - lu(k,938) * lu(k,1318) + lu(k,1334) = lu(k,1334) - lu(k,939) * lu(k,1318) + lu(k,1335) = lu(k,1335) - lu(k,940) * lu(k,1318) + lu(k,1336) = lu(k,1336) - lu(k,941) * lu(k,1318) + lu(k,1337) = lu(k,1337) - lu(k,942) * lu(k,1318) + lu(k,1338) = lu(k,1338) - lu(k,943) * lu(k,1318) + lu(k,1339) = lu(k,1339) - lu(k,944) * lu(k,1318) + lu(k,1341) = lu(k,1341) - lu(k,945) * lu(k,1318) + lu(k,1342) = lu(k,1342) - lu(k,946) * lu(k,1318) + lu(k,1343) = lu(k,1343) - lu(k,947) * lu(k,1318) + lu(k,1344) = lu(k,1344) - lu(k,948) * lu(k,1318) + lu(k,1379) = lu(k,1379) - lu(k,927) * lu(k,1378) + lu(k,1381) = lu(k,1381) - lu(k,928) * lu(k,1378) + lu(k,1382) = lu(k,1382) - lu(k,929) * lu(k,1378) + lu(k,1383) = lu(k,1383) - lu(k,930) * lu(k,1378) + lu(k,1384) = lu(k,1384) - lu(k,931) * lu(k,1378) + lu(k,1385) = lu(k,1385) - lu(k,932) * lu(k,1378) + lu(k,1387) = lu(k,1387) - lu(k,933) * lu(k,1378) + lu(k,1388) = lu(k,1388) - lu(k,934) * lu(k,1378) + lu(k,1389) = lu(k,1389) - lu(k,935) * lu(k,1378) + lu(k,1390) = lu(k,1390) - lu(k,936) * lu(k,1378) + lu(k,1391) = lu(k,1391) - lu(k,937) * lu(k,1378) + lu(k,1393) = lu(k,1393) - lu(k,938) * lu(k,1378) + lu(k,1394) = lu(k,1394) - lu(k,939) * lu(k,1378) + lu(k,1395) = lu(k,1395) - lu(k,940) * lu(k,1378) + lu(k,1396) = lu(k,1396) - lu(k,941) * lu(k,1378) + lu(k,1397) = lu(k,1397) - lu(k,942) * lu(k,1378) + lu(k,1398) = lu(k,1398) - lu(k,943) * lu(k,1378) + lu(k,1399) = lu(k,1399) - lu(k,944) * lu(k,1378) + lu(k,1401) = lu(k,1401) - lu(k,945) * lu(k,1378) + lu(k,1402) = lu(k,1402) - lu(k,946) * lu(k,1378) + lu(k,1403) = lu(k,1403) - lu(k,947) * lu(k,1378) + lu(k,1404) = lu(k,1404) - lu(k,948) * lu(k,1378) + lu(k,1428) = lu(k,1428) - lu(k,927) * lu(k,1427) + lu(k,1430) = lu(k,1430) - lu(k,928) * lu(k,1427) + lu(k,1431) = lu(k,1431) - lu(k,929) * lu(k,1427) + lu(k,1432) = lu(k,1432) - lu(k,930) * lu(k,1427) + lu(k,1433) = lu(k,1433) - lu(k,931) * lu(k,1427) + lu(k,1434) = lu(k,1434) - lu(k,932) * lu(k,1427) + lu(k,1436) = lu(k,1436) - lu(k,933) * lu(k,1427) + lu(k,1437) = lu(k,1437) - lu(k,934) * lu(k,1427) + lu(k,1438) = lu(k,1438) - lu(k,935) * lu(k,1427) + lu(k,1439) = lu(k,1439) - lu(k,936) * lu(k,1427) + lu(k,1440) = lu(k,1440) - lu(k,937) * lu(k,1427) + lu(k,1442) = lu(k,1442) - lu(k,938) * lu(k,1427) + lu(k,1443) = lu(k,1443) - lu(k,939) * lu(k,1427) + lu(k,1444) = lu(k,1444) - lu(k,940) * lu(k,1427) + lu(k,1445) = lu(k,1445) - lu(k,941) * lu(k,1427) + lu(k,1446) = lu(k,1446) - lu(k,942) * lu(k,1427) + lu(k,1447) = lu(k,1447) - lu(k,943) * lu(k,1427) + lu(k,1448) = lu(k,1448) - lu(k,944) * lu(k,1427) + lu(k,1450) = lu(k,1450) - lu(k,945) * lu(k,1427) + lu(k,1451) = lu(k,1451) - lu(k,946) * lu(k,1427) + lu(k,1452) = lu(k,1452) - lu(k,947) * lu(k,1427) + lu(k,1453) = lu(k,1453) - lu(k,948) * lu(k,1427) + lu(k,1476) = lu(k,1476) - lu(k,927) * lu(k,1475) + lu(k,1478) = lu(k,1478) - lu(k,928) * lu(k,1475) + lu(k,1479) = lu(k,1479) - lu(k,929) * lu(k,1475) + lu(k,1480) = lu(k,1480) - lu(k,930) * lu(k,1475) + lu(k,1481) = lu(k,1481) - lu(k,931) * lu(k,1475) + lu(k,1482) = lu(k,1482) - lu(k,932) * lu(k,1475) + lu(k,1484) = lu(k,1484) - lu(k,933) * lu(k,1475) + lu(k,1485) = lu(k,1485) - lu(k,934) * lu(k,1475) + lu(k,1486) = lu(k,1486) - lu(k,935) * lu(k,1475) + lu(k,1487) = lu(k,1487) - lu(k,936) * lu(k,1475) + lu(k,1488) = lu(k,1488) - lu(k,937) * lu(k,1475) + lu(k,1490) = lu(k,1490) - lu(k,938) * lu(k,1475) + lu(k,1491) = lu(k,1491) - lu(k,939) * lu(k,1475) + lu(k,1492) = lu(k,1492) - lu(k,940) * lu(k,1475) + lu(k,1493) = lu(k,1493) - lu(k,941) * lu(k,1475) + lu(k,1494) = lu(k,1494) - lu(k,942) * lu(k,1475) + lu(k,1495) = lu(k,1495) - lu(k,943) * lu(k,1475) + lu(k,1496) = lu(k,1496) - lu(k,944) * lu(k,1475) + lu(k,1498) = lu(k,1498) - lu(k,945) * lu(k,1475) + lu(k,1499) = lu(k,1499) - lu(k,946) * lu(k,1475) + lu(k,1500) = lu(k,1500) - lu(k,947) * lu(k,1475) + lu(k,1501) = lu(k,1501) - lu(k,948) * lu(k,1475) + lu(k,1517) = lu(k,1517) - lu(k,927) * lu(k,1516) + lu(k,1519) = lu(k,1519) - lu(k,928) * lu(k,1516) + lu(k,1520) = lu(k,1520) - lu(k,929) * lu(k,1516) + lu(k,1521) = lu(k,1521) - lu(k,930) * lu(k,1516) + lu(k,1522) = lu(k,1522) - lu(k,931) * lu(k,1516) + lu(k,1523) = lu(k,1523) - lu(k,932) * lu(k,1516) + lu(k,1525) = lu(k,1525) - lu(k,933) * lu(k,1516) + lu(k,1526) = lu(k,1526) - lu(k,934) * lu(k,1516) + lu(k,1527) = lu(k,1527) - lu(k,935) * lu(k,1516) + lu(k,1528) = lu(k,1528) - lu(k,936) * lu(k,1516) + lu(k,1529) = lu(k,1529) - lu(k,937) * lu(k,1516) + lu(k,1531) = lu(k,1531) - lu(k,938) * lu(k,1516) + lu(k,1532) = lu(k,1532) - lu(k,939) * lu(k,1516) + lu(k,1533) = lu(k,1533) - lu(k,940) * lu(k,1516) + lu(k,1534) = lu(k,1534) - lu(k,941) * lu(k,1516) + lu(k,1535) = lu(k,1535) - lu(k,942) * lu(k,1516) + lu(k,1536) = lu(k,1536) - lu(k,943) * lu(k,1516) + lu(k,1537) = lu(k,1537) - lu(k,944) * lu(k,1516) + lu(k,1539) = lu(k,1539) - lu(k,945) * lu(k,1516) + lu(k,1540) = lu(k,1540) - lu(k,946) * lu(k,1516) + lu(k,1541) = lu(k,1541) - lu(k,947) * lu(k,1516) + lu(k,1542) = lu(k,1542) - lu(k,948) * lu(k,1516) + lu(k,1553) = lu(k,1553) - lu(k,927) * lu(k,1552) + lu(k,1555) = lu(k,1555) - lu(k,928) * lu(k,1552) + lu(k,1556) = lu(k,1556) - lu(k,929) * lu(k,1552) + lu(k,1557) = lu(k,1557) - lu(k,930) * lu(k,1552) + lu(k,1558) = lu(k,1558) - lu(k,931) * lu(k,1552) + lu(k,1559) = lu(k,1559) - lu(k,932) * lu(k,1552) + lu(k,1561) = lu(k,1561) - lu(k,933) * lu(k,1552) + lu(k,1562) = lu(k,1562) - lu(k,934) * lu(k,1552) + lu(k,1563) = lu(k,1563) - lu(k,935) * lu(k,1552) + lu(k,1564) = lu(k,1564) - lu(k,936) * lu(k,1552) + lu(k,1565) = lu(k,1565) - lu(k,937) * lu(k,1552) + lu(k,1567) = lu(k,1567) - lu(k,938) * lu(k,1552) + lu(k,1568) = lu(k,1568) - lu(k,939) * lu(k,1552) + lu(k,1569) = lu(k,1569) - lu(k,940) * lu(k,1552) + lu(k,1570) = lu(k,1570) - lu(k,941) * lu(k,1552) + lu(k,1571) = lu(k,1571) - lu(k,942) * lu(k,1552) + lu(k,1572) = lu(k,1572) - lu(k,943) * lu(k,1552) + lu(k,1573) = lu(k,1573) - lu(k,944) * lu(k,1552) + lu(k,1575) = lu(k,1575) - lu(k,945) * lu(k,1552) + lu(k,1576) = lu(k,1576) - lu(k,946) * lu(k,1552) + lu(k,1577) = lu(k,1577) - lu(k,947) * lu(k,1552) + lu(k,1578) = lu(k,1578) - lu(k,948) * lu(k,1552) + lu(k,1598) = lu(k,1598) - lu(k,927) * lu(k,1597) + lu(k,1600) = lu(k,1600) - lu(k,928) * lu(k,1597) + lu(k,1601) = lu(k,1601) - lu(k,929) * lu(k,1597) + lu(k,1602) = lu(k,1602) - lu(k,930) * lu(k,1597) + lu(k,1603) = lu(k,1603) - lu(k,931) * lu(k,1597) + lu(k,1604) = lu(k,1604) - lu(k,932) * lu(k,1597) + lu(k,1606) = lu(k,1606) - lu(k,933) * lu(k,1597) + lu(k,1607) = lu(k,1607) - lu(k,934) * lu(k,1597) + lu(k,1608) = lu(k,1608) - lu(k,935) * lu(k,1597) + lu(k,1609) = lu(k,1609) - lu(k,936) * lu(k,1597) + lu(k,1610) = lu(k,1610) - lu(k,937) * lu(k,1597) + lu(k,1612) = lu(k,1612) - lu(k,938) * lu(k,1597) + lu(k,1613) = lu(k,1613) - lu(k,939) * lu(k,1597) + lu(k,1614) = lu(k,1614) - lu(k,940) * lu(k,1597) + lu(k,1615) = lu(k,1615) - lu(k,941) * lu(k,1597) + lu(k,1616) = lu(k,1616) - lu(k,942) * lu(k,1597) + lu(k,1617) = lu(k,1617) - lu(k,943) * lu(k,1597) + lu(k,1618) = lu(k,1618) - lu(k,944) * lu(k,1597) + lu(k,1620) = lu(k,1620) - lu(k,945) * lu(k,1597) + lu(k,1621) = lu(k,1621) - lu(k,946) * lu(k,1597) + lu(k,1622) = lu(k,1622) - lu(k,947) * lu(k,1597) + lu(k,1623) = lu(k,1623) - lu(k,948) * lu(k,1597) + lu(k,1641) = lu(k,1641) - lu(k,927) * lu(k,1640) + lu(k,1643) = lu(k,1643) - lu(k,928) * lu(k,1640) + lu(k,1644) = lu(k,1644) - lu(k,929) * lu(k,1640) + lu(k,1645) = lu(k,1645) - lu(k,930) * lu(k,1640) + lu(k,1646) = lu(k,1646) - lu(k,931) * lu(k,1640) + lu(k,1647) = lu(k,1647) - lu(k,932) * lu(k,1640) + lu(k,1649) = lu(k,1649) - lu(k,933) * lu(k,1640) + lu(k,1650) = lu(k,1650) - lu(k,934) * lu(k,1640) + lu(k,1651) = lu(k,1651) - lu(k,935) * lu(k,1640) + lu(k,1652) = lu(k,1652) - lu(k,936) * lu(k,1640) + lu(k,1653) = lu(k,1653) - lu(k,937) * lu(k,1640) + lu(k,1655) = lu(k,1655) - lu(k,938) * lu(k,1640) + lu(k,1656) = lu(k,1656) - lu(k,939) * lu(k,1640) + lu(k,1657) = lu(k,1657) - lu(k,940) * lu(k,1640) + lu(k,1658) = lu(k,1658) - lu(k,941) * lu(k,1640) + lu(k,1659) = lu(k,1659) - lu(k,942) * lu(k,1640) + lu(k,1660) = lu(k,1660) - lu(k,943) * lu(k,1640) + lu(k,1661) = lu(k,1661) - lu(k,944) * lu(k,1640) + lu(k,1663) = lu(k,1663) - lu(k,945) * lu(k,1640) + lu(k,1664) = lu(k,1664) - lu(k,946) * lu(k,1640) + lu(k,1665) = lu(k,1665) - lu(k,947) * lu(k,1640) + lu(k,1666) = lu(k,1666) - lu(k,948) * lu(k,1640) + lu(k,1684) = lu(k,1684) - lu(k,927) * lu(k,1683) + lu(k,1686) = lu(k,1686) - lu(k,928) * lu(k,1683) + lu(k,1687) = lu(k,1687) - lu(k,929) * lu(k,1683) + lu(k,1688) = lu(k,1688) - lu(k,930) * lu(k,1683) + lu(k,1689) = lu(k,1689) - lu(k,931) * lu(k,1683) + lu(k,1690) = lu(k,1690) - lu(k,932) * lu(k,1683) + lu(k,1692) = lu(k,1692) - lu(k,933) * lu(k,1683) + lu(k,1693) = lu(k,1693) - lu(k,934) * lu(k,1683) + lu(k,1694) = lu(k,1694) - lu(k,935) * lu(k,1683) + lu(k,1695) = lu(k,1695) - lu(k,936) * lu(k,1683) + lu(k,1696) = lu(k,1696) - lu(k,937) * lu(k,1683) + lu(k,1698) = lu(k,1698) - lu(k,938) * lu(k,1683) + lu(k,1699) = lu(k,1699) - lu(k,939) * lu(k,1683) + lu(k,1700) = lu(k,1700) - lu(k,940) * lu(k,1683) + lu(k,1701) = lu(k,1701) - lu(k,941) * lu(k,1683) + lu(k,1702) = lu(k,1702) - lu(k,942) * lu(k,1683) + lu(k,1703) = lu(k,1703) - lu(k,943) * lu(k,1683) + lu(k,1704) = lu(k,1704) - lu(k,944) * lu(k,1683) + lu(k,1706) = lu(k,1706) - lu(k,945) * lu(k,1683) + lu(k,1707) = lu(k,1707) - lu(k,946) * lu(k,1683) + lu(k,1708) = lu(k,1708) - lu(k,947) * lu(k,1683) + lu(k,1709) = lu(k,1709) - lu(k,948) * lu(k,1683) + lu(k,1725) = lu(k,1725) - lu(k,927) * lu(k,1724) + lu(k,1726) = lu(k,1726) - lu(k,928) * lu(k,1724) + lu(k,1727) = lu(k,1727) - lu(k,929) * lu(k,1724) + lu(k,1728) = lu(k,1728) - lu(k,930) * lu(k,1724) + lu(k,1729) = lu(k,1729) - lu(k,931) * lu(k,1724) + lu(k,1730) = lu(k,1730) - lu(k,932) * lu(k,1724) + lu(k,1732) = lu(k,1732) - lu(k,933) * lu(k,1724) + lu(k,1733) = lu(k,1733) - lu(k,934) * lu(k,1724) + lu(k,1734) = lu(k,1734) - lu(k,935) * lu(k,1724) + lu(k,1735) = lu(k,1735) - lu(k,936) * lu(k,1724) + lu(k,1736) = lu(k,1736) - lu(k,937) * lu(k,1724) + lu(k,1738) = lu(k,1738) - lu(k,938) * lu(k,1724) + lu(k,1739) = lu(k,1739) - lu(k,939) * lu(k,1724) + lu(k,1740) = lu(k,1740) - lu(k,940) * lu(k,1724) + lu(k,1741) = lu(k,1741) - lu(k,941) * lu(k,1724) + lu(k,1742) = lu(k,1742) - lu(k,942) * lu(k,1724) + lu(k,1743) = lu(k,1743) - lu(k,943) * lu(k,1724) + lu(k,1744) = lu(k,1744) - lu(k,944) * lu(k,1724) + lu(k,1746) = lu(k,1746) - lu(k,945) * lu(k,1724) + lu(k,1747) = lu(k,1747) - lu(k,946) * lu(k,1724) + lu(k,1748) = lu(k,1748) - lu(k,947) * lu(k,1724) + lu(k,1749) = lu(k,1749) - lu(k,948) * lu(k,1724) + lu(k,1760) = lu(k,1760) - lu(k,927) * lu(k,1759) + lu(k,1762) = lu(k,1762) - lu(k,928) * lu(k,1759) + lu(k,1763) = lu(k,1763) - lu(k,929) * lu(k,1759) + lu(k,1764) = lu(k,1764) - lu(k,930) * lu(k,1759) + lu(k,1765) = lu(k,1765) - lu(k,931) * lu(k,1759) + lu(k,1766) = lu(k,1766) - lu(k,932) * lu(k,1759) + lu(k,1768) = lu(k,1768) - lu(k,933) * lu(k,1759) + lu(k,1769) = lu(k,1769) - lu(k,934) * lu(k,1759) + lu(k,1770) = lu(k,1770) - lu(k,935) * lu(k,1759) + lu(k,1771) = lu(k,1771) - lu(k,936) * lu(k,1759) + lu(k,1772) = lu(k,1772) - lu(k,937) * lu(k,1759) + lu(k,1774) = lu(k,1774) - lu(k,938) * lu(k,1759) + lu(k,1775) = lu(k,1775) - lu(k,939) * lu(k,1759) + lu(k,1776) = lu(k,1776) - lu(k,940) * lu(k,1759) + lu(k,1777) = lu(k,1777) - lu(k,941) * lu(k,1759) + lu(k,1778) = lu(k,1778) - lu(k,942) * lu(k,1759) + lu(k,1779) = lu(k,1779) - lu(k,943) * lu(k,1759) + lu(k,1780) = lu(k,1780) - lu(k,944) * lu(k,1759) + lu(k,1782) = lu(k,1782) - lu(k,945) * lu(k,1759) + lu(k,1783) = lu(k,1783) - lu(k,946) * lu(k,1759) + lu(k,1784) = lu(k,1784) - lu(k,947) * lu(k,1759) + lu(k,1785) = lu(k,1785) - lu(k,948) * lu(k,1759) + lu(k,1808) = lu(k,1808) - lu(k,927) * lu(k,1807) + lu(k,1810) = lu(k,1810) - lu(k,928) * lu(k,1807) + lu(k,1811) = lu(k,1811) - lu(k,929) * lu(k,1807) + lu(k,1812) = lu(k,1812) - lu(k,930) * lu(k,1807) + lu(k,1813) = lu(k,1813) - lu(k,931) * lu(k,1807) + lu(k,1814) = lu(k,1814) - lu(k,932) * lu(k,1807) + lu(k,1816) = lu(k,1816) - lu(k,933) * lu(k,1807) + lu(k,1817) = lu(k,1817) - lu(k,934) * lu(k,1807) + lu(k,1818) = lu(k,1818) - lu(k,935) * lu(k,1807) + lu(k,1819) = lu(k,1819) - lu(k,936) * lu(k,1807) + lu(k,1820) = lu(k,1820) - lu(k,937) * lu(k,1807) + lu(k,1822) = lu(k,1822) - lu(k,938) * lu(k,1807) + lu(k,1823) = lu(k,1823) - lu(k,939) * lu(k,1807) + lu(k,1824) = lu(k,1824) - lu(k,940) * lu(k,1807) + lu(k,1825) = lu(k,1825) - lu(k,941) * lu(k,1807) + lu(k,1826) = lu(k,1826) - lu(k,942) * lu(k,1807) + lu(k,1827) = lu(k,1827) - lu(k,943) * lu(k,1807) + lu(k,1828) = lu(k,1828) - lu(k,944) * lu(k,1807) + lu(k,1830) = lu(k,1830) - lu(k,945) * lu(k,1807) + lu(k,1831) = lu(k,1831) - lu(k,946) * lu(k,1807) + lu(k,1832) = lu(k,1832) - lu(k,947) * lu(k,1807) + lu(k,1833) = lu(k,1833) - lu(k,948) * lu(k,1807) + lu(k,1841) = lu(k,1841) - lu(k,927) * lu(k,1840) + lu(k,1843) = lu(k,1843) - lu(k,928) * lu(k,1840) + lu(k,1844) = lu(k,1844) - lu(k,929) * lu(k,1840) + lu(k,1845) = lu(k,1845) - lu(k,930) * lu(k,1840) + lu(k,1846) = lu(k,1846) - lu(k,931) * lu(k,1840) + lu(k,1847) = lu(k,1847) - lu(k,932) * lu(k,1840) + lu(k,1849) = lu(k,1849) - lu(k,933) * lu(k,1840) + lu(k,1850) = lu(k,1850) - lu(k,934) * lu(k,1840) + lu(k,1851) = lu(k,1851) - lu(k,935) * lu(k,1840) + lu(k,1852) = lu(k,1852) - lu(k,936) * lu(k,1840) + lu(k,1853) = lu(k,1853) - lu(k,937) * lu(k,1840) + lu(k,1855) = lu(k,1855) - lu(k,938) * lu(k,1840) + lu(k,1856) = lu(k,1856) - lu(k,939) * lu(k,1840) + lu(k,1857) = lu(k,1857) - lu(k,940) * lu(k,1840) + lu(k,1858) = lu(k,1858) - lu(k,941) * lu(k,1840) + lu(k,1859) = lu(k,1859) - lu(k,942) * lu(k,1840) + lu(k,1860) = lu(k,1860) - lu(k,943) * lu(k,1840) + lu(k,1861) = lu(k,1861) - lu(k,944) * lu(k,1840) + lu(k,1863) = lu(k,1863) - lu(k,945) * lu(k,1840) + lu(k,1864) = lu(k,1864) - lu(k,946) * lu(k,1840) + lu(k,1865) = lu(k,1865) - lu(k,947) * lu(k,1840) + lu(k,1866) = lu(k,1866) - lu(k,948) * lu(k,1840) + lu(k,1877) = lu(k,1877) - lu(k,927) * lu(k,1876) + lu(k,1879) = lu(k,1879) - lu(k,928) * lu(k,1876) + lu(k,1880) = lu(k,1880) - lu(k,929) * lu(k,1876) + lu(k,1881) = lu(k,1881) - lu(k,930) * lu(k,1876) + lu(k,1882) = lu(k,1882) - lu(k,931) * lu(k,1876) + lu(k,1883) = lu(k,1883) - lu(k,932) * lu(k,1876) + lu(k,1885) = lu(k,1885) - lu(k,933) * lu(k,1876) + lu(k,1886) = lu(k,1886) - lu(k,934) * lu(k,1876) + lu(k,1887) = lu(k,1887) - lu(k,935) * lu(k,1876) + lu(k,1888) = lu(k,1888) - lu(k,936) * lu(k,1876) + lu(k,1889) = lu(k,1889) - lu(k,937) * lu(k,1876) + lu(k,1891) = lu(k,1891) - lu(k,938) * lu(k,1876) + lu(k,1892) = lu(k,1892) - lu(k,939) * lu(k,1876) + lu(k,1893) = lu(k,1893) - lu(k,940) * lu(k,1876) + lu(k,1894) = lu(k,1894) - lu(k,941) * lu(k,1876) + lu(k,1895) = lu(k,1895) - lu(k,942) * lu(k,1876) + lu(k,1896) = lu(k,1896) - lu(k,943) * lu(k,1876) + lu(k,1897) = lu(k,1897) - lu(k,944) * lu(k,1876) + lu(k,1899) = lu(k,1899) - lu(k,945) * lu(k,1876) + lu(k,1900) = lu(k,1900) - lu(k,946) * lu(k,1876) + lu(k,1901) = lu(k,1901) - lu(k,947) * lu(k,1876) + lu(k,1902) = lu(k,1902) - lu(k,948) * lu(k,1876) + lu(k,1918) = lu(k,1918) - lu(k,927) * lu(k,1917) + lu(k,1920) = lu(k,1920) - lu(k,928) * lu(k,1917) + lu(k,1921) = lu(k,1921) - lu(k,929) * lu(k,1917) + lu(k,1922) = lu(k,1922) - lu(k,930) * lu(k,1917) + lu(k,1923) = lu(k,1923) - lu(k,931) * lu(k,1917) + lu(k,1924) = lu(k,1924) - lu(k,932) * lu(k,1917) + lu(k,1926) = lu(k,1926) - lu(k,933) * lu(k,1917) + lu(k,1927) = lu(k,1927) - lu(k,934) * lu(k,1917) + lu(k,1928) = lu(k,1928) - lu(k,935) * lu(k,1917) + lu(k,1929) = lu(k,1929) - lu(k,936) * lu(k,1917) + lu(k,1930) = lu(k,1930) - lu(k,937) * lu(k,1917) + lu(k,1932) = lu(k,1932) - lu(k,938) * lu(k,1917) + lu(k,1933) = lu(k,1933) - lu(k,939) * lu(k,1917) + lu(k,1934) = lu(k,1934) - lu(k,940) * lu(k,1917) + lu(k,1935) = lu(k,1935) - lu(k,941) * lu(k,1917) + lu(k,1936) = lu(k,1936) - lu(k,942) * lu(k,1917) + lu(k,1937) = lu(k,1937) - lu(k,943) * lu(k,1917) + lu(k,1938) = lu(k,1938) - lu(k,944) * lu(k,1917) + lu(k,1940) = lu(k,1940) - lu(k,945) * lu(k,1917) + lu(k,1941) = lu(k,1941) - lu(k,946) * lu(k,1917) + lu(k,1942) = lu(k,1942) - lu(k,947) * lu(k,1917) + lu(k,1943) = lu(k,1943) - lu(k,948) * lu(k,1917) + lu(k,1960) = lu(k,1960) - lu(k,927) * lu(k,1959) + lu(k,1962) = lu(k,1962) - lu(k,928) * lu(k,1959) + lu(k,1963) = lu(k,1963) - lu(k,929) * lu(k,1959) + lu(k,1964) = lu(k,1964) - lu(k,930) * lu(k,1959) + lu(k,1965) = lu(k,1965) - lu(k,931) * lu(k,1959) + lu(k,1966) = lu(k,1966) - lu(k,932) * lu(k,1959) + lu(k,1968) = lu(k,1968) - lu(k,933) * lu(k,1959) + lu(k,1969) = lu(k,1969) - lu(k,934) * lu(k,1959) + lu(k,1970) = lu(k,1970) - lu(k,935) * lu(k,1959) + lu(k,1971) = lu(k,1971) - lu(k,936) * lu(k,1959) + lu(k,1972) = lu(k,1972) - lu(k,937) * lu(k,1959) + lu(k,1974) = lu(k,1974) - lu(k,938) * lu(k,1959) + lu(k,1975) = lu(k,1975) - lu(k,939) * lu(k,1959) + lu(k,1976) = lu(k,1976) - lu(k,940) * lu(k,1959) + lu(k,1977) = lu(k,1977) - lu(k,941) * lu(k,1959) + lu(k,1978) = lu(k,1978) - lu(k,942) * lu(k,1959) + lu(k,1979) = lu(k,1979) - lu(k,943) * lu(k,1959) + lu(k,1980) = lu(k,1980) - lu(k,944) * lu(k,1959) + lu(k,1982) = lu(k,1982) - lu(k,945) * lu(k,1959) + lu(k,1983) = lu(k,1983) - lu(k,946) * lu(k,1959) + lu(k,1984) = lu(k,1984) - lu(k,947) * lu(k,1959) + lu(k,1985) = lu(k,1985) - lu(k,948) * lu(k,1959) + lu(k,2005) = lu(k,2005) - lu(k,927) * lu(k,2004) + lu(k,2007) = lu(k,2007) - lu(k,928) * lu(k,2004) + lu(k,2008) = lu(k,2008) - lu(k,929) * lu(k,2004) + lu(k,2009) = lu(k,2009) - lu(k,930) * lu(k,2004) + lu(k,2010) = lu(k,2010) - lu(k,931) * lu(k,2004) + lu(k,2011) = lu(k,2011) - lu(k,932) * lu(k,2004) + lu(k,2013) = lu(k,2013) - lu(k,933) * lu(k,2004) + lu(k,2014) = lu(k,2014) - lu(k,934) * lu(k,2004) + lu(k,2015) = lu(k,2015) - lu(k,935) * lu(k,2004) + lu(k,2016) = lu(k,2016) - lu(k,936) * lu(k,2004) + lu(k,2017) = lu(k,2017) - lu(k,937) * lu(k,2004) + lu(k,2019) = lu(k,2019) - lu(k,938) * lu(k,2004) + lu(k,2020) = lu(k,2020) - lu(k,939) * lu(k,2004) + lu(k,2021) = lu(k,2021) - lu(k,940) * lu(k,2004) + lu(k,2022) = lu(k,2022) - lu(k,941) * lu(k,2004) + lu(k,2023) = lu(k,2023) - lu(k,942) * lu(k,2004) + lu(k,2024) = lu(k,2024) - lu(k,943) * lu(k,2004) + lu(k,2025) = lu(k,2025) - lu(k,944) * lu(k,2004) + lu(k,2027) = lu(k,2027) - lu(k,945) * lu(k,2004) + lu(k,2028) = lu(k,2028) - lu(k,946) * lu(k,2004) + lu(k,2029) = lu(k,2029) - lu(k,947) * lu(k,2004) + lu(k,2030) = lu(k,2030) - lu(k,948) * lu(k,2004) + lu(k,2065) = lu(k,2065) - lu(k,927) * lu(k,2064) + lu(k,2067) = lu(k,2067) - lu(k,928) * lu(k,2064) + lu(k,2068) = lu(k,2068) - lu(k,929) * lu(k,2064) + lu(k,2069) = lu(k,2069) - lu(k,930) * lu(k,2064) + lu(k,2070) = lu(k,2070) - lu(k,931) * lu(k,2064) + lu(k,2071) = lu(k,2071) - lu(k,932) * lu(k,2064) + lu(k,2073) = lu(k,2073) - lu(k,933) * lu(k,2064) + lu(k,2074) = lu(k,2074) - lu(k,934) * lu(k,2064) + lu(k,2075) = lu(k,2075) - lu(k,935) * lu(k,2064) + lu(k,2076) = lu(k,2076) - lu(k,936) * lu(k,2064) + lu(k,2077) = lu(k,2077) - lu(k,937) * lu(k,2064) + lu(k,2079) = lu(k,2079) - lu(k,938) * lu(k,2064) + lu(k,2080) = lu(k,2080) - lu(k,939) * lu(k,2064) + lu(k,2081) = lu(k,2081) - lu(k,940) * lu(k,2064) + lu(k,2082) = lu(k,2082) - lu(k,941) * lu(k,2064) + lu(k,2083) = lu(k,2083) - lu(k,942) * lu(k,2064) + lu(k,2084) = lu(k,2084) - lu(k,943) * lu(k,2064) + lu(k,2085) = lu(k,2085) - lu(k,944) * lu(k,2064) + lu(k,2087) = lu(k,2087) - lu(k,945) * lu(k,2064) + lu(k,2088) = lu(k,2088) - lu(k,946) * lu(k,2064) + lu(k,2089) = lu(k,2089) - lu(k,947) * lu(k,2064) + lu(k,2090) = lu(k,2090) - lu(k,948) * lu(k,2064) + end do + end subroutine lu_fac20 + subroutine lu_fac21( 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,984) = 1._r8 / lu(k,984) + lu(k,985) = lu(k,985) * lu(k,984) + lu(k,986) = lu(k,986) * lu(k,984) + lu(k,987) = lu(k,987) * lu(k,984) + lu(k,988) = lu(k,988) * lu(k,984) + lu(k,989) = lu(k,989) * lu(k,984) + lu(k,990) = lu(k,990) * lu(k,984) + lu(k,991) = lu(k,991) * lu(k,984) + lu(k,992) = lu(k,992) * lu(k,984) + lu(k,993) = lu(k,993) * lu(k,984) + lu(k,994) = lu(k,994) * lu(k,984) + lu(k,995) = lu(k,995) * lu(k,984) + lu(k,996) = lu(k,996) * lu(k,984) + lu(k,997) = lu(k,997) * lu(k,984) + lu(k,998) = lu(k,998) * lu(k,984) + lu(k,999) = lu(k,999) * lu(k,984) + lu(k,1000) = lu(k,1000) * lu(k,984) + lu(k,1001) = lu(k,1001) * lu(k,984) + lu(k,1002) = lu(k,1002) * lu(k,984) + lu(k,1003) = lu(k,1003) * lu(k,984) + lu(k,1004) = lu(k,1004) * lu(k,984) + lu(k,1005) = lu(k,1005) * lu(k,984) + lu(k,1015) = lu(k,1015) - lu(k,985) * lu(k,1013) + lu(k,1016) = lu(k,1016) - lu(k,986) * lu(k,1013) + lu(k,1017) = lu(k,1017) - lu(k,987) * lu(k,1013) + lu(k,1019) = lu(k,1019) - lu(k,988) * lu(k,1013) + lu(k,1020) = lu(k,1020) - lu(k,989) * lu(k,1013) + lu(k,1021) = lu(k,1021) - lu(k,990) * lu(k,1013) + lu(k,1022) = lu(k,1022) - lu(k,991) * lu(k,1013) + lu(k,1023) = lu(k,1023) - lu(k,992) * lu(k,1013) + lu(k,1024) = lu(k,1024) - lu(k,993) * lu(k,1013) + lu(k,1025) = lu(k,1025) - lu(k,994) * lu(k,1013) + lu(k,1026) = lu(k,1026) - lu(k,995) * lu(k,1013) + lu(k,1027) = lu(k,1027) - lu(k,996) * lu(k,1013) + lu(k,1030) = lu(k,1030) - lu(k,997) * lu(k,1013) + lu(k,1031) = lu(k,1031) - lu(k,998) * lu(k,1013) + lu(k,1032) = lu(k,1032) - lu(k,999) * lu(k,1013) + lu(k,1033) = lu(k,1033) - lu(k,1000) * lu(k,1013) + lu(k,1034) = lu(k,1034) - lu(k,1001) * lu(k,1013) + lu(k,1035) = lu(k,1035) - lu(k,1002) * lu(k,1013) + lu(k,1036) = lu(k,1036) - lu(k,1003) * lu(k,1013) + lu(k,1037) = lu(k,1037) - lu(k,1004) * lu(k,1013) + lu(k,1038) = lu(k,1038) - lu(k,1005) * lu(k,1013) + lu(k,1058) = lu(k,1058) - lu(k,985) * lu(k,1057) + lu(k,1059) = lu(k,1059) - lu(k,986) * lu(k,1057) + lu(k,1060) = lu(k,1060) - lu(k,987) * lu(k,1057) + lu(k,1062) = lu(k,1062) - lu(k,988) * lu(k,1057) + lu(k,1063) = lu(k,1063) - lu(k,989) * lu(k,1057) + lu(k,1064) = lu(k,1064) - lu(k,990) * lu(k,1057) + lu(k,1065) = lu(k,1065) - lu(k,991) * lu(k,1057) + lu(k,1066) = lu(k,1066) - lu(k,992) * lu(k,1057) + lu(k,1067) = lu(k,1067) - lu(k,993) * lu(k,1057) + lu(k,1068) = lu(k,1068) - lu(k,994) * lu(k,1057) + lu(k,1069) = lu(k,1069) - lu(k,995) * lu(k,1057) + lu(k,1070) = lu(k,1070) - lu(k,996) * lu(k,1057) + lu(k,1073) = lu(k,1073) - lu(k,997) * lu(k,1057) + lu(k,1074) = lu(k,1074) - lu(k,998) * lu(k,1057) + lu(k,1075) = lu(k,1075) - lu(k,999) * lu(k,1057) + lu(k,1076) = lu(k,1076) - lu(k,1000) * lu(k,1057) + lu(k,1077) = lu(k,1077) - lu(k,1001) * lu(k,1057) + lu(k,1078) = lu(k,1078) - lu(k,1002) * lu(k,1057) + lu(k,1079) = lu(k,1079) - lu(k,1003) * lu(k,1057) + lu(k,1080) = lu(k,1080) - lu(k,1004) * lu(k,1057) + lu(k,1081) = lu(k,1081) - lu(k,1005) * lu(k,1057) + lu(k,1103) = lu(k,1103) - lu(k,985) * lu(k,1101) + lu(k,1104) = lu(k,1104) - lu(k,986) * lu(k,1101) + lu(k,1105) = lu(k,1105) - lu(k,987) * lu(k,1101) + lu(k,1107) = lu(k,1107) - lu(k,988) * lu(k,1101) + lu(k,1108) = lu(k,1108) - lu(k,989) * lu(k,1101) + lu(k,1109) = lu(k,1109) - lu(k,990) * lu(k,1101) + lu(k,1110) = lu(k,1110) - lu(k,991) * lu(k,1101) + lu(k,1111) = lu(k,1111) - lu(k,992) * lu(k,1101) + lu(k,1112) = lu(k,1112) - lu(k,993) * lu(k,1101) + lu(k,1113) = lu(k,1113) - lu(k,994) * lu(k,1101) + lu(k,1114) = lu(k,1114) - lu(k,995) * lu(k,1101) + lu(k,1115) = lu(k,1115) - lu(k,996) * lu(k,1101) + lu(k,1118) = lu(k,1118) - lu(k,997) * lu(k,1101) + lu(k,1119) = lu(k,1119) - lu(k,998) * lu(k,1101) + lu(k,1120) = lu(k,1120) - lu(k,999) * lu(k,1101) + lu(k,1121) = lu(k,1121) - lu(k,1000) * lu(k,1101) + lu(k,1122) = lu(k,1122) - lu(k,1001) * lu(k,1101) + lu(k,1123) = lu(k,1123) - lu(k,1002) * lu(k,1101) + lu(k,1124) = lu(k,1124) - lu(k,1003) * lu(k,1101) + lu(k,1125) = lu(k,1125) - lu(k,1004) * lu(k,1101) + lu(k,1126) = lu(k,1126) - lu(k,1005) * lu(k,1101) + lu(k,1151) = lu(k,1151) - lu(k,985) * lu(k,1149) + lu(k,1152) = lu(k,1152) - lu(k,986) * lu(k,1149) + lu(k,1153) = lu(k,1153) - lu(k,987) * lu(k,1149) + lu(k,1155) = lu(k,1155) - lu(k,988) * lu(k,1149) + lu(k,1156) = lu(k,1156) - lu(k,989) * lu(k,1149) + lu(k,1157) = lu(k,1157) - lu(k,990) * lu(k,1149) + lu(k,1158) = lu(k,1158) - lu(k,991) * lu(k,1149) + lu(k,1159) = lu(k,1159) - lu(k,992) * lu(k,1149) + lu(k,1160) = lu(k,1160) - lu(k,993) * lu(k,1149) + lu(k,1161) = lu(k,1161) - lu(k,994) * lu(k,1149) + lu(k,1162) = lu(k,1162) - lu(k,995) * lu(k,1149) + lu(k,1163) = lu(k,1163) - lu(k,996) * lu(k,1149) + lu(k,1166) = lu(k,1166) - lu(k,997) * lu(k,1149) + lu(k,1167) = lu(k,1167) - lu(k,998) * lu(k,1149) + lu(k,1168) = lu(k,1168) - lu(k,999) * lu(k,1149) + lu(k,1169) = lu(k,1169) - lu(k,1000) * lu(k,1149) + lu(k,1170) = lu(k,1170) - lu(k,1001) * lu(k,1149) + lu(k,1171) = lu(k,1171) - lu(k,1002) * lu(k,1149) + lu(k,1172) = lu(k,1172) - lu(k,1003) * lu(k,1149) + lu(k,1173) = lu(k,1173) - lu(k,1004) * lu(k,1149) + lu(k,1174) = lu(k,1174) - lu(k,1005) * lu(k,1149) + lu(k,1194) = lu(k,1194) - lu(k,985) * lu(k,1192) + lu(k,1195) = lu(k,1195) - lu(k,986) * lu(k,1192) + lu(k,1196) = lu(k,1196) - lu(k,987) * lu(k,1192) + lu(k,1198) = lu(k,1198) - lu(k,988) * lu(k,1192) + lu(k,1199) = lu(k,1199) - lu(k,989) * lu(k,1192) + lu(k,1200) = lu(k,1200) - lu(k,990) * lu(k,1192) + lu(k,1201) = lu(k,1201) - lu(k,991) * lu(k,1192) + lu(k,1202) = lu(k,1202) - lu(k,992) * lu(k,1192) + lu(k,1203) = lu(k,1203) - lu(k,993) * lu(k,1192) + lu(k,1204) = lu(k,1204) - lu(k,994) * lu(k,1192) + lu(k,1205) = lu(k,1205) - lu(k,995) * lu(k,1192) + lu(k,1206) = lu(k,1206) - lu(k,996) * lu(k,1192) + lu(k,1209) = lu(k,1209) - lu(k,997) * lu(k,1192) + lu(k,1210) = lu(k,1210) - lu(k,998) * lu(k,1192) + lu(k,1211) = lu(k,1211) - lu(k,999) * lu(k,1192) + lu(k,1212) = lu(k,1212) - lu(k,1000) * lu(k,1192) + lu(k,1213) = lu(k,1213) - lu(k,1001) * lu(k,1192) + lu(k,1214) = lu(k,1214) - lu(k,1002) * lu(k,1192) + lu(k,1215) = lu(k,1215) - lu(k,1003) * lu(k,1192) + lu(k,1216) = lu(k,1216) - lu(k,1004) * lu(k,1192) + lu(k,1217) = lu(k,1217) - lu(k,1005) * lu(k,1192) + lu(k,1237) = lu(k,1237) - lu(k,985) * lu(k,1235) + lu(k,1238) = lu(k,1238) - lu(k,986) * lu(k,1235) + lu(k,1239) = lu(k,1239) - lu(k,987) * lu(k,1235) + lu(k,1241) = lu(k,1241) - lu(k,988) * lu(k,1235) + lu(k,1242) = lu(k,1242) - lu(k,989) * lu(k,1235) + lu(k,1243) = lu(k,1243) - lu(k,990) * lu(k,1235) + lu(k,1244) = lu(k,1244) - lu(k,991) * lu(k,1235) + lu(k,1245) = lu(k,1245) - lu(k,992) * lu(k,1235) + lu(k,1246) = lu(k,1246) - lu(k,993) * lu(k,1235) + lu(k,1247) = lu(k,1247) - lu(k,994) * lu(k,1235) + lu(k,1248) = lu(k,1248) - lu(k,995) * lu(k,1235) + lu(k,1249) = lu(k,1249) - lu(k,996) * lu(k,1235) + lu(k,1252) = lu(k,1252) - lu(k,997) * lu(k,1235) + lu(k,1253) = lu(k,1253) - lu(k,998) * lu(k,1235) + lu(k,1254) = lu(k,1254) - lu(k,999) * lu(k,1235) + lu(k,1255) = lu(k,1255) - lu(k,1000) * lu(k,1235) + lu(k,1256) = lu(k,1256) - lu(k,1001) * lu(k,1235) + lu(k,1257) = lu(k,1257) - lu(k,1002) * lu(k,1235) + lu(k,1258) = lu(k,1258) - lu(k,1003) * lu(k,1235) + lu(k,1259) = lu(k,1259) - lu(k,1004) * lu(k,1235) + lu(k,1260) = lu(k,1260) - lu(k,1005) * lu(k,1235) + lu(k,1279) = lu(k,1279) - lu(k,985) * lu(k,1277) + lu(k,1280) = lu(k,1280) - lu(k,986) * lu(k,1277) + lu(k,1281) = lu(k,1281) - lu(k,987) * lu(k,1277) + lu(k,1283) = lu(k,1283) - lu(k,988) * lu(k,1277) + lu(k,1284) = lu(k,1284) - lu(k,989) * lu(k,1277) + lu(k,1285) = lu(k,1285) - lu(k,990) * lu(k,1277) + lu(k,1286) = lu(k,1286) - lu(k,991) * lu(k,1277) + lu(k,1287) = lu(k,1287) - lu(k,992) * lu(k,1277) + lu(k,1288) = lu(k,1288) - lu(k,993) * lu(k,1277) + lu(k,1289) = lu(k,1289) - lu(k,994) * lu(k,1277) + lu(k,1290) = lu(k,1290) - lu(k,995) * lu(k,1277) + lu(k,1291) = lu(k,1291) - lu(k,996) * lu(k,1277) + lu(k,1294) = lu(k,1294) - lu(k,997) * lu(k,1277) + lu(k,1295) = lu(k,1295) - lu(k,998) * lu(k,1277) + lu(k,1296) = lu(k,1296) - lu(k,999) * lu(k,1277) + lu(k,1297) = lu(k,1297) - lu(k,1000) * lu(k,1277) + lu(k,1298) = lu(k,1298) - lu(k,1001) * lu(k,1277) + lu(k,1299) = lu(k,1299) - lu(k,1002) * lu(k,1277) + lu(k,1300) = lu(k,1300) - lu(k,1003) * lu(k,1277) + lu(k,1301) = lu(k,1301) - lu(k,1004) * lu(k,1277) + lu(k,1302) = lu(k,1302) - lu(k,1005) * lu(k,1277) + lu(k,1321) = lu(k,1321) - lu(k,985) * lu(k,1319) + lu(k,1322) = lu(k,1322) - lu(k,986) * lu(k,1319) + lu(k,1323) = lu(k,1323) - lu(k,987) * lu(k,1319) + lu(k,1325) = lu(k,1325) - lu(k,988) * lu(k,1319) + lu(k,1326) = lu(k,1326) - lu(k,989) * lu(k,1319) + lu(k,1327) = lu(k,1327) - lu(k,990) * lu(k,1319) + lu(k,1328) = lu(k,1328) - lu(k,991) * lu(k,1319) + lu(k,1329) = lu(k,1329) - lu(k,992) * lu(k,1319) + lu(k,1330) = lu(k,1330) - lu(k,993) * lu(k,1319) + lu(k,1331) = lu(k,1331) - lu(k,994) * lu(k,1319) + lu(k,1332) = lu(k,1332) - lu(k,995) * lu(k,1319) + lu(k,1333) = lu(k,1333) - lu(k,996) * lu(k,1319) + lu(k,1336) = lu(k,1336) - lu(k,997) * lu(k,1319) + lu(k,1337) = lu(k,1337) - lu(k,998) * lu(k,1319) + lu(k,1338) = lu(k,1338) - lu(k,999) * lu(k,1319) + lu(k,1339) = lu(k,1339) - lu(k,1000) * lu(k,1319) + lu(k,1340) = lu(k,1340) - lu(k,1001) * lu(k,1319) + lu(k,1341) = lu(k,1341) - lu(k,1002) * lu(k,1319) + lu(k,1342) = lu(k,1342) - lu(k,1003) * lu(k,1319) + lu(k,1343) = lu(k,1343) - lu(k,1004) * lu(k,1319) + lu(k,1344) = lu(k,1344) - lu(k,1005) * lu(k,1319) + lu(k,1381) = lu(k,1381) - lu(k,985) * lu(k,1379) + lu(k,1382) = lu(k,1382) - lu(k,986) * lu(k,1379) + lu(k,1383) = lu(k,1383) - lu(k,987) * lu(k,1379) + lu(k,1385) = lu(k,1385) - lu(k,988) * lu(k,1379) + lu(k,1386) = lu(k,1386) - lu(k,989) * lu(k,1379) + lu(k,1387) = lu(k,1387) - lu(k,990) * lu(k,1379) + lu(k,1388) = lu(k,1388) - lu(k,991) * lu(k,1379) + lu(k,1389) = lu(k,1389) - lu(k,992) * lu(k,1379) + lu(k,1390) = lu(k,1390) - lu(k,993) * lu(k,1379) + lu(k,1391) = lu(k,1391) - lu(k,994) * lu(k,1379) + lu(k,1392) = lu(k,1392) - lu(k,995) * lu(k,1379) + lu(k,1393) = lu(k,1393) - lu(k,996) * lu(k,1379) + lu(k,1396) = lu(k,1396) - lu(k,997) * lu(k,1379) + lu(k,1397) = lu(k,1397) - lu(k,998) * lu(k,1379) + lu(k,1398) = lu(k,1398) - lu(k,999) * lu(k,1379) + lu(k,1399) = lu(k,1399) - lu(k,1000) * lu(k,1379) + lu(k,1400) = lu(k,1400) - lu(k,1001) * lu(k,1379) + lu(k,1401) = lu(k,1401) - lu(k,1002) * lu(k,1379) + lu(k,1402) = lu(k,1402) - lu(k,1003) * lu(k,1379) + lu(k,1403) = lu(k,1403) - lu(k,1004) * lu(k,1379) + lu(k,1404) = lu(k,1404) - lu(k,1005) * lu(k,1379) + lu(k,1430) = lu(k,1430) - lu(k,985) * lu(k,1428) + lu(k,1431) = lu(k,1431) - lu(k,986) * lu(k,1428) + lu(k,1432) = lu(k,1432) - lu(k,987) * lu(k,1428) + lu(k,1434) = lu(k,1434) - lu(k,988) * lu(k,1428) + lu(k,1435) = lu(k,1435) - lu(k,989) * lu(k,1428) + lu(k,1436) = lu(k,1436) - lu(k,990) * lu(k,1428) + lu(k,1437) = lu(k,1437) - lu(k,991) * lu(k,1428) + lu(k,1438) = lu(k,1438) - lu(k,992) * lu(k,1428) + lu(k,1439) = lu(k,1439) - lu(k,993) * lu(k,1428) + lu(k,1440) = lu(k,1440) - lu(k,994) * lu(k,1428) + lu(k,1441) = lu(k,1441) - lu(k,995) * lu(k,1428) + lu(k,1442) = lu(k,1442) - lu(k,996) * lu(k,1428) + lu(k,1445) = lu(k,1445) - lu(k,997) * lu(k,1428) + lu(k,1446) = lu(k,1446) - lu(k,998) * lu(k,1428) + lu(k,1447) = lu(k,1447) - lu(k,999) * lu(k,1428) + lu(k,1448) = lu(k,1448) - lu(k,1000) * lu(k,1428) + lu(k,1449) = lu(k,1449) - lu(k,1001) * lu(k,1428) + lu(k,1450) = lu(k,1450) - lu(k,1002) * lu(k,1428) + lu(k,1451) = lu(k,1451) - lu(k,1003) * lu(k,1428) + lu(k,1452) = lu(k,1452) - lu(k,1004) * lu(k,1428) + lu(k,1453) = lu(k,1453) - lu(k,1005) * lu(k,1428) + lu(k,1478) = lu(k,1478) - lu(k,985) * lu(k,1476) + lu(k,1479) = lu(k,1479) - lu(k,986) * lu(k,1476) + lu(k,1480) = lu(k,1480) - lu(k,987) * lu(k,1476) + lu(k,1482) = lu(k,1482) - lu(k,988) * lu(k,1476) + lu(k,1483) = lu(k,1483) - lu(k,989) * lu(k,1476) + lu(k,1484) = lu(k,1484) - lu(k,990) * lu(k,1476) + lu(k,1485) = lu(k,1485) - lu(k,991) * lu(k,1476) + lu(k,1486) = lu(k,1486) - lu(k,992) * lu(k,1476) + lu(k,1487) = lu(k,1487) - lu(k,993) * lu(k,1476) + lu(k,1488) = lu(k,1488) - lu(k,994) * lu(k,1476) + lu(k,1489) = lu(k,1489) - lu(k,995) * lu(k,1476) + lu(k,1490) = lu(k,1490) - lu(k,996) * lu(k,1476) + lu(k,1493) = lu(k,1493) - lu(k,997) * lu(k,1476) + lu(k,1494) = lu(k,1494) - lu(k,998) * lu(k,1476) + lu(k,1495) = lu(k,1495) - lu(k,999) * lu(k,1476) + lu(k,1496) = lu(k,1496) - lu(k,1000) * lu(k,1476) + lu(k,1497) = lu(k,1497) - lu(k,1001) * lu(k,1476) + lu(k,1498) = lu(k,1498) - lu(k,1002) * lu(k,1476) + lu(k,1499) = lu(k,1499) - lu(k,1003) * lu(k,1476) + lu(k,1500) = lu(k,1500) - lu(k,1004) * lu(k,1476) + lu(k,1501) = lu(k,1501) - lu(k,1005) * lu(k,1476) + lu(k,1519) = lu(k,1519) - lu(k,985) * lu(k,1517) + lu(k,1520) = lu(k,1520) - lu(k,986) * lu(k,1517) + lu(k,1521) = lu(k,1521) - lu(k,987) * lu(k,1517) + lu(k,1523) = lu(k,1523) - lu(k,988) * lu(k,1517) + lu(k,1524) = lu(k,1524) - lu(k,989) * lu(k,1517) + lu(k,1525) = lu(k,1525) - lu(k,990) * lu(k,1517) + lu(k,1526) = lu(k,1526) - lu(k,991) * lu(k,1517) + lu(k,1527) = lu(k,1527) - lu(k,992) * lu(k,1517) + lu(k,1528) = lu(k,1528) - lu(k,993) * lu(k,1517) + lu(k,1529) = lu(k,1529) - lu(k,994) * lu(k,1517) + lu(k,1530) = lu(k,1530) - lu(k,995) * lu(k,1517) + lu(k,1531) = lu(k,1531) - lu(k,996) * lu(k,1517) + lu(k,1534) = lu(k,1534) - lu(k,997) * lu(k,1517) + lu(k,1535) = lu(k,1535) - lu(k,998) * lu(k,1517) + lu(k,1536) = lu(k,1536) - lu(k,999) * lu(k,1517) + lu(k,1537) = lu(k,1537) - lu(k,1000) * lu(k,1517) + lu(k,1538) = lu(k,1538) - lu(k,1001) * lu(k,1517) + lu(k,1539) = lu(k,1539) - lu(k,1002) * lu(k,1517) + lu(k,1540) = lu(k,1540) - lu(k,1003) * lu(k,1517) + lu(k,1541) = lu(k,1541) - lu(k,1004) * lu(k,1517) + lu(k,1542) = lu(k,1542) - lu(k,1005) * lu(k,1517) + lu(k,1555) = lu(k,1555) - lu(k,985) * lu(k,1553) + lu(k,1556) = lu(k,1556) - lu(k,986) * lu(k,1553) + lu(k,1557) = lu(k,1557) - lu(k,987) * lu(k,1553) + lu(k,1559) = lu(k,1559) - lu(k,988) * lu(k,1553) + lu(k,1560) = lu(k,1560) - lu(k,989) * lu(k,1553) + lu(k,1561) = lu(k,1561) - lu(k,990) * lu(k,1553) + lu(k,1562) = lu(k,1562) - lu(k,991) * lu(k,1553) + lu(k,1563) = lu(k,1563) - lu(k,992) * lu(k,1553) + lu(k,1564) = lu(k,1564) - lu(k,993) * lu(k,1553) + lu(k,1565) = lu(k,1565) - lu(k,994) * lu(k,1553) + lu(k,1566) = lu(k,1566) - lu(k,995) * lu(k,1553) + lu(k,1567) = lu(k,1567) - lu(k,996) * lu(k,1553) + lu(k,1570) = lu(k,1570) - lu(k,997) * lu(k,1553) + lu(k,1571) = lu(k,1571) - lu(k,998) * lu(k,1553) + lu(k,1572) = lu(k,1572) - lu(k,999) * lu(k,1553) + lu(k,1573) = lu(k,1573) - lu(k,1000) * lu(k,1553) + lu(k,1574) = lu(k,1574) - lu(k,1001) * lu(k,1553) + lu(k,1575) = lu(k,1575) - lu(k,1002) * lu(k,1553) + lu(k,1576) = lu(k,1576) - lu(k,1003) * lu(k,1553) + lu(k,1577) = lu(k,1577) - lu(k,1004) * lu(k,1553) + lu(k,1578) = lu(k,1578) - lu(k,1005) * lu(k,1553) + lu(k,1600) = lu(k,1600) - lu(k,985) * lu(k,1598) + lu(k,1601) = lu(k,1601) - lu(k,986) * lu(k,1598) + lu(k,1602) = lu(k,1602) - lu(k,987) * lu(k,1598) + lu(k,1604) = lu(k,1604) - lu(k,988) * lu(k,1598) + lu(k,1605) = lu(k,1605) - lu(k,989) * lu(k,1598) + lu(k,1606) = lu(k,1606) - lu(k,990) * lu(k,1598) + lu(k,1607) = lu(k,1607) - lu(k,991) * lu(k,1598) + lu(k,1608) = lu(k,1608) - lu(k,992) * lu(k,1598) + lu(k,1609) = lu(k,1609) - lu(k,993) * lu(k,1598) + lu(k,1610) = lu(k,1610) - lu(k,994) * lu(k,1598) + lu(k,1611) = lu(k,1611) - lu(k,995) * lu(k,1598) + lu(k,1612) = lu(k,1612) - lu(k,996) * lu(k,1598) + lu(k,1615) = lu(k,1615) - lu(k,997) * lu(k,1598) + lu(k,1616) = lu(k,1616) - lu(k,998) * lu(k,1598) + lu(k,1617) = lu(k,1617) - lu(k,999) * lu(k,1598) + lu(k,1618) = lu(k,1618) - lu(k,1000) * lu(k,1598) + lu(k,1619) = lu(k,1619) - lu(k,1001) * lu(k,1598) + lu(k,1620) = lu(k,1620) - lu(k,1002) * lu(k,1598) + lu(k,1621) = lu(k,1621) - lu(k,1003) * lu(k,1598) + lu(k,1622) = lu(k,1622) - lu(k,1004) * lu(k,1598) + lu(k,1623) = lu(k,1623) - lu(k,1005) * lu(k,1598) + lu(k,1643) = lu(k,1643) - lu(k,985) * lu(k,1641) + lu(k,1644) = lu(k,1644) - lu(k,986) * lu(k,1641) + lu(k,1645) = lu(k,1645) - lu(k,987) * lu(k,1641) + lu(k,1647) = lu(k,1647) - lu(k,988) * lu(k,1641) + lu(k,1648) = lu(k,1648) - lu(k,989) * lu(k,1641) + lu(k,1649) = lu(k,1649) - lu(k,990) * lu(k,1641) + lu(k,1650) = lu(k,1650) - lu(k,991) * lu(k,1641) + lu(k,1651) = lu(k,1651) - lu(k,992) * lu(k,1641) + lu(k,1652) = lu(k,1652) - lu(k,993) * lu(k,1641) + lu(k,1653) = lu(k,1653) - lu(k,994) * lu(k,1641) + lu(k,1654) = lu(k,1654) - lu(k,995) * lu(k,1641) + lu(k,1655) = lu(k,1655) - lu(k,996) * lu(k,1641) + lu(k,1658) = lu(k,1658) - lu(k,997) * lu(k,1641) + lu(k,1659) = lu(k,1659) - lu(k,998) * lu(k,1641) + lu(k,1660) = lu(k,1660) - lu(k,999) * lu(k,1641) + lu(k,1661) = lu(k,1661) - lu(k,1000) * lu(k,1641) + lu(k,1662) = lu(k,1662) - lu(k,1001) * lu(k,1641) + lu(k,1663) = lu(k,1663) - lu(k,1002) * lu(k,1641) + lu(k,1664) = lu(k,1664) - lu(k,1003) * lu(k,1641) + lu(k,1665) = lu(k,1665) - lu(k,1004) * lu(k,1641) + lu(k,1666) = lu(k,1666) - lu(k,1005) * lu(k,1641) + lu(k,1686) = lu(k,1686) - lu(k,985) * lu(k,1684) + lu(k,1687) = lu(k,1687) - lu(k,986) * lu(k,1684) + lu(k,1688) = lu(k,1688) - lu(k,987) * lu(k,1684) + lu(k,1690) = lu(k,1690) - lu(k,988) * lu(k,1684) + lu(k,1691) = lu(k,1691) - lu(k,989) * lu(k,1684) + lu(k,1692) = lu(k,1692) - lu(k,990) * lu(k,1684) + lu(k,1693) = lu(k,1693) - lu(k,991) * lu(k,1684) + lu(k,1694) = lu(k,1694) - lu(k,992) * lu(k,1684) + lu(k,1695) = lu(k,1695) - lu(k,993) * lu(k,1684) + lu(k,1696) = lu(k,1696) - lu(k,994) * lu(k,1684) + lu(k,1697) = lu(k,1697) - lu(k,995) * lu(k,1684) + lu(k,1698) = lu(k,1698) - lu(k,996) * lu(k,1684) + lu(k,1701) = lu(k,1701) - lu(k,997) * lu(k,1684) + lu(k,1702) = lu(k,1702) - lu(k,998) * lu(k,1684) + lu(k,1703) = lu(k,1703) - lu(k,999) * lu(k,1684) + lu(k,1704) = lu(k,1704) - lu(k,1000) * lu(k,1684) + lu(k,1705) = lu(k,1705) - lu(k,1001) * lu(k,1684) + lu(k,1706) = lu(k,1706) - lu(k,1002) * lu(k,1684) + lu(k,1707) = lu(k,1707) - lu(k,1003) * lu(k,1684) + lu(k,1708) = lu(k,1708) - lu(k,1004) * lu(k,1684) + lu(k,1709) = lu(k,1709) - lu(k,1005) * lu(k,1684) + lu(k,1726) = lu(k,1726) - lu(k,985) * lu(k,1725) + lu(k,1727) = lu(k,1727) - lu(k,986) * lu(k,1725) + lu(k,1728) = lu(k,1728) - lu(k,987) * lu(k,1725) + lu(k,1730) = lu(k,1730) - lu(k,988) * lu(k,1725) + lu(k,1731) = lu(k,1731) - lu(k,989) * lu(k,1725) + lu(k,1732) = lu(k,1732) - lu(k,990) * lu(k,1725) + lu(k,1733) = lu(k,1733) - lu(k,991) * lu(k,1725) + lu(k,1734) = lu(k,1734) - lu(k,992) * lu(k,1725) + lu(k,1735) = lu(k,1735) - lu(k,993) * lu(k,1725) + lu(k,1736) = lu(k,1736) - lu(k,994) * lu(k,1725) + lu(k,1737) = lu(k,1737) - lu(k,995) * lu(k,1725) + lu(k,1738) = lu(k,1738) - lu(k,996) * lu(k,1725) + lu(k,1741) = lu(k,1741) - lu(k,997) * lu(k,1725) + lu(k,1742) = lu(k,1742) - lu(k,998) * lu(k,1725) + lu(k,1743) = lu(k,1743) - lu(k,999) * lu(k,1725) + lu(k,1744) = lu(k,1744) - lu(k,1000) * lu(k,1725) + lu(k,1745) = lu(k,1745) - lu(k,1001) * lu(k,1725) + lu(k,1746) = lu(k,1746) - lu(k,1002) * lu(k,1725) + lu(k,1747) = lu(k,1747) - lu(k,1003) * lu(k,1725) + lu(k,1748) = lu(k,1748) - lu(k,1004) * lu(k,1725) + lu(k,1749) = lu(k,1749) - lu(k,1005) * lu(k,1725) + lu(k,1762) = lu(k,1762) - lu(k,985) * lu(k,1760) + lu(k,1763) = lu(k,1763) - lu(k,986) * lu(k,1760) + lu(k,1764) = lu(k,1764) - lu(k,987) * lu(k,1760) + lu(k,1766) = lu(k,1766) - lu(k,988) * lu(k,1760) + lu(k,1767) = lu(k,1767) - lu(k,989) * lu(k,1760) + lu(k,1768) = lu(k,1768) - lu(k,990) * lu(k,1760) + lu(k,1769) = lu(k,1769) - lu(k,991) * lu(k,1760) + lu(k,1770) = lu(k,1770) - lu(k,992) * lu(k,1760) + lu(k,1771) = lu(k,1771) - lu(k,993) * lu(k,1760) + lu(k,1772) = lu(k,1772) - lu(k,994) * lu(k,1760) + lu(k,1773) = lu(k,1773) - lu(k,995) * lu(k,1760) + lu(k,1774) = lu(k,1774) - lu(k,996) * lu(k,1760) + lu(k,1777) = lu(k,1777) - lu(k,997) * lu(k,1760) + lu(k,1778) = lu(k,1778) - lu(k,998) * lu(k,1760) + lu(k,1779) = lu(k,1779) - lu(k,999) * lu(k,1760) + lu(k,1780) = lu(k,1780) - lu(k,1000) * lu(k,1760) + lu(k,1781) = lu(k,1781) - lu(k,1001) * lu(k,1760) + lu(k,1782) = lu(k,1782) - lu(k,1002) * lu(k,1760) + lu(k,1783) = lu(k,1783) - lu(k,1003) * lu(k,1760) + lu(k,1784) = lu(k,1784) - lu(k,1004) * lu(k,1760) + lu(k,1785) = lu(k,1785) - lu(k,1005) * lu(k,1760) + lu(k,1810) = lu(k,1810) - lu(k,985) * lu(k,1808) + lu(k,1811) = lu(k,1811) - lu(k,986) * lu(k,1808) + lu(k,1812) = lu(k,1812) - lu(k,987) * lu(k,1808) + lu(k,1814) = lu(k,1814) - lu(k,988) * lu(k,1808) + lu(k,1815) = lu(k,1815) - lu(k,989) * lu(k,1808) + lu(k,1816) = lu(k,1816) - lu(k,990) * lu(k,1808) + lu(k,1817) = lu(k,1817) - lu(k,991) * lu(k,1808) + lu(k,1818) = lu(k,1818) - lu(k,992) * lu(k,1808) + lu(k,1819) = lu(k,1819) - lu(k,993) * lu(k,1808) + lu(k,1820) = lu(k,1820) - lu(k,994) * lu(k,1808) + lu(k,1821) = lu(k,1821) - lu(k,995) * lu(k,1808) + lu(k,1822) = lu(k,1822) - lu(k,996) * lu(k,1808) + lu(k,1825) = lu(k,1825) - lu(k,997) * lu(k,1808) + lu(k,1826) = lu(k,1826) - lu(k,998) * lu(k,1808) + lu(k,1827) = lu(k,1827) - lu(k,999) * lu(k,1808) + lu(k,1828) = lu(k,1828) - lu(k,1000) * lu(k,1808) + lu(k,1829) = lu(k,1829) - lu(k,1001) * lu(k,1808) + lu(k,1830) = lu(k,1830) - lu(k,1002) * lu(k,1808) + lu(k,1831) = lu(k,1831) - lu(k,1003) * lu(k,1808) + lu(k,1832) = lu(k,1832) - lu(k,1004) * lu(k,1808) + lu(k,1833) = lu(k,1833) - lu(k,1005) * lu(k,1808) + lu(k,1843) = lu(k,1843) - lu(k,985) * lu(k,1841) + lu(k,1844) = lu(k,1844) - lu(k,986) * lu(k,1841) + lu(k,1845) = lu(k,1845) - lu(k,987) * lu(k,1841) + lu(k,1847) = lu(k,1847) - lu(k,988) * lu(k,1841) + lu(k,1848) = lu(k,1848) - lu(k,989) * lu(k,1841) + lu(k,1849) = lu(k,1849) - lu(k,990) * lu(k,1841) + lu(k,1850) = lu(k,1850) - lu(k,991) * lu(k,1841) + lu(k,1851) = lu(k,1851) - lu(k,992) * lu(k,1841) + lu(k,1852) = lu(k,1852) - lu(k,993) * lu(k,1841) + lu(k,1853) = lu(k,1853) - lu(k,994) * lu(k,1841) + lu(k,1854) = lu(k,1854) - lu(k,995) * lu(k,1841) + lu(k,1855) = lu(k,1855) - lu(k,996) * lu(k,1841) + lu(k,1858) = lu(k,1858) - lu(k,997) * lu(k,1841) + lu(k,1859) = lu(k,1859) - lu(k,998) * lu(k,1841) + lu(k,1860) = lu(k,1860) - lu(k,999) * lu(k,1841) + lu(k,1861) = lu(k,1861) - lu(k,1000) * lu(k,1841) + lu(k,1862) = lu(k,1862) - lu(k,1001) * lu(k,1841) + lu(k,1863) = lu(k,1863) - lu(k,1002) * lu(k,1841) + lu(k,1864) = lu(k,1864) - lu(k,1003) * lu(k,1841) + lu(k,1865) = lu(k,1865) - lu(k,1004) * lu(k,1841) + lu(k,1866) = lu(k,1866) - lu(k,1005) * lu(k,1841) + lu(k,1879) = lu(k,1879) - lu(k,985) * lu(k,1877) + lu(k,1880) = lu(k,1880) - lu(k,986) * lu(k,1877) + lu(k,1881) = lu(k,1881) - lu(k,987) * lu(k,1877) + lu(k,1883) = lu(k,1883) - lu(k,988) * lu(k,1877) + lu(k,1884) = lu(k,1884) - lu(k,989) * lu(k,1877) + lu(k,1885) = lu(k,1885) - lu(k,990) * lu(k,1877) + lu(k,1886) = lu(k,1886) - lu(k,991) * lu(k,1877) + lu(k,1887) = lu(k,1887) - lu(k,992) * lu(k,1877) + lu(k,1888) = lu(k,1888) - lu(k,993) * lu(k,1877) + lu(k,1889) = lu(k,1889) - lu(k,994) * lu(k,1877) + lu(k,1890) = lu(k,1890) - lu(k,995) * lu(k,1877) + lu(k,1891) = lu(k,1891) - lu(k,996) * lu(k,1877) + lu(k,1894) = lu(k,1894) - lu(k,997) * lu(k,1877) + lu(k,1895) = lu(k,1895) - lu(k,998) * lu(k,1877) + lu(k,1896) = lu(k,1896) - lu(k,999) * lu(k,1877) + lu(k,1897) = lu(k,1897) - lu(k,1000) * lu(k,1877) + lu(k,1898) = lu(k,1898) - lu(k,1001) * lu(k,1877) + lu(k,1899) = lu(k,1899) - lu(k,1002) * lu(k,1877) + lu(k,1900) = lu(k,1900) - lu(k,1003) * lu(k,1877) + lu(k,1901) = lu(k,1901) - lu(k,1004) * lu(k,1877) + lu(k,1902) = lu(k,1902) - lu(k,1005) * lu(k,1877) + lu(k,1920) = lu(k,1920) - lu(k,985) * lu(k,1918) + lu(k,1921) = lu(k,1921) - lu(k,986) * lu(k,1918) + lu(k,1922) = lu(k,1922) - lu(k,987) * lu(k,1918) + lu(k,1924) = lu(k,1924) - lu(k,988) * lu(k,1918) + lu(k,1925) = lu(k,1925) - lu(k,989) * lu(k,1918) + lu(k,1926) = lu(k,1926) - lu(k,990) * lu(k,1918) + lu(k,1927) = lu(k,1927) - lu(k,991) * lu(k,1918) + lu(k,1928) = lu(k,1928) - lu(k,992) * lu(k,1918) + lu(k,1929) = lu(k,1929) - lu(k,993) * lu(k,1918) + lu(k,1930) = lu(k,1930) - lu(k,994) * lu(k,1918) + lu(k,1931) = lu(k,1931) - lu(k,995) * lu(k,1918) + lu(k,1932) = lu(k,1932) - lu(k,996) * lu(k,1918) + lu(k,1935) = lu(k,1935) - lu(k,997) * lu(k,1918) + lu(k,1936) = lu(k,1936) - lu(k,998) * lu(k,1918) + lu(k,1937) = lu(k,1937) - lu(k,999) * lu(k,1918) + lu(k,1938) = lu(k,1938) - lu(k,1000) * lu(k,1918) + lu(k,1939) = lu(k,1939) - lu(k,1001) * lu(k,1918) + lu(k,1940) = lu(k,1940) - lu(k,1002) * lu(k,1918) + lu(k,1941) = lu(k,1941) - lu(k,1003) * lu(k,1918) + lu(k,1942) = lu(k,1942) - lu(k,1004) * lu(k,1918) + lu(k,1943) = lu(k,1943) - lu(k,1005) * lu(k,1918) + lu(k,1962) = lu(k,1962) - lu(k,985) * lu(k,1960) + lu(k,1963) = lu(k,1963) - lu(k,986) * lu(k,1960) + lu(k,1964) = lu(k,1964) - lu(k,987) * lu(k,1960) + lu(k,1966) = lu(k,1966) - lu(k,988) * lu(k,1960) + lu(k,1967) = lu(k,1967) - lu(k,989) * lu(k,1960) + lu(k,1968) = lu(k,1968) - lu(k,990) * lu(k,1960) + lu(k,1969) = lu(k,1969) - lu(k,991) * lu(k,1960) + lu(k,1970) = lu(k,1970) - lu(k,992) * lu(k,1960) + lu(k,1971) = lu(k,1971) - lu(k,993) * lu(k,1960) + lu(k,1972) = lu(k,1972) - lu(k,994) * lu(k,1960) + lu(k,1973) = lu(k,1973) - lu(k,995) * lu(k,1960) + lu(k,1974) = lu(k,1974) - lu(k,996) * lu(k,1960) + lu(k,1977) = lu(k,1977) - lu(k,997) * lu(k,1960) + lu(k,1978) = lu(k,1978) - lu(k,998) * lu(k,1960) + lu(k,1979) = lu(k,1979) - lu(k,999) * lu(k,1960) + lu(k,1980) = lu(k,1980) - lu(k,1000) * lu(k,1960) + lu(k,1981) = lu(k,1981) - lu(k,1001) * lu(k,1960) + lu(k,1982) = lu(k,1982) - lu(k,1002) * lu(k,1960) + lu(k,1983) = lu(k,1983) - lu(k,1003) * lu(k,1960) + lu(k,1984) = lu(k,1984) - lu(k,1004) * lu(k,1960) + lu(k,1985) = lu(k,1985) - lu(k,1005) * lu(k,1960) + lu(k,2007) = lu(k,2007) - lu(k,985) * lu(k,2005) + lu(k,2008) = lu(k,2008) - lu(k,986) * lu(k,2005) + lu(k,2009) = lu(k,2009) - lu(k,987) * lu(k,2005) + lu(k,2011) = lu(k,2011) - lu(k,988) * lu(k,2005) + lu(k,2012) = lu(k,2012) - lu(k,989) * lu(k,2005) + lu(k,2013) = lu(k,2013) - lu(k,990) * lu(k,2005) + lu(k,2014) = lu(k,2014) - lu(k,991) * lu(k,2005) + lu(k,2015) = lu(k,2015) - lu(k,992) * lu(k,2005) + lu(k,2016) = lu(k,2016) - lu(k,993) * lu(k,2005) + lu(k,2017) = lu(k,2017) - lu(k,994) * lu(k,2005) + lu(k,2018) = lu(k,2018) - lu(k,995) * lu(k,2005) + lu(k,2019) = lu(k,2019) - lu(k,996) * lu(k,2005) + lu(k,2022) = lu(k,2022) - lu(k,997) * lu(k,2005) + lu(k,2023) = lu(k,2023) - lu(k,998) * lu(k,2005) + lu(k,2024) = lu(k,2024) - lu(k,999) * lu(k,2005) + lu(k,2025) = lu(k,2025) - lu(k,1000) * lu(k,2005) + lu(k,2026) = lu(k,2026) - lu(k,1001) * lu(k,2005) + lu(k,2027) = lu(k,2027) - lu(k,1002) * lu(k,2005) + lu(k,2028) = lu(k,2028) - lu(k,1003) * lu(k,2005) + lu(k,2029) = lu(k,2029) - lu(k,1004) * lu(k,2005) + lu(k,2030) = lu(k,2030) - lu(k,1005) * lu(k,2005) + lu(k,2067) = lu(k,2067) - lu(k,985) * lu(k,2065) + lu(k,2068) = lu(k,2068) - lu(k,986) * lu(k,2065) + lu(k,2069) = lu(k,2069) - lu(k,987) * lu(k,2065) + lu(k,2071) = lu(k,2071) - lu(k,988) * lu(k,2065) + lu(k,2072) = lu(k,2072) - lu(k,989) * lu(k,2065) + lu(k,2073) = lu(k,2073) - lu(k,990) * lu(k,2065) + lu(k,2074) = lu(k,2074) - lu(k,991) * lu(k,2065) + lu(k,2075) = lu(k,2075) - lu(k,992) * lu(k,2065) + lu(k,2076) = lu(k,2076) - lu(k,993) * lu(k,2065) + lu(k,2077) = lu(k,2077) - lu(k,994) * lu(k,2065) + lu(k,2078) = lu(k,2078) - lu(k,995) * lu(k,2065) + lu(k,2079) = lu(k,2079) - lu(k,996) * lu(k,2065) + lu(k,2082) = lu(k,2082) - lu(k,997) * lu(k,2065) + lu(k,2083) = lu(k,2083) - lu(k,998) * lu(k,2065) + lu(k,2084) = lu(k,2084) - lu(k,999) * lu(k,2065) + lu(k,2085) = lu(k,2085) - lu(k,1000) * lu(k,2065) + lu(k,2086) = lu(k,2086) - lu(k,1001) * lu(k,2065) + lu(k,2087) = lu(k,2087) - lu(k,1002) * lu(k,2065) + lu(k,2088) = lu(k,2088) - lu(k,1003) * lu(k,2065) + lu(k,2089) = lu(k,2089) - lu(k,1004) * lu(k,2065) + lu(k,2090) = lu(k,2090) - lu(k,1005) * lu(k,2065) + lu(k,1014) = 1._r8 / lu(k,1014) + lu(k,1015) = lu(k,1015) * lu(k,1014) + lu(k,1016) = lu(k,1016) * lu(k,1014) + lu(k,1017) = lu(k,1017) * lu(k,1014) + lu(k,1018) = lu(k,1018) * lu(k,1014) + lu(k,1019) = lu(k,1019) * lu(k,1014) + lu(k,1020) = lu(k,1020) * lu(k,1014) + lu(k,1021) = lu(k,1021) * lu(k,1014) + lu(k,1022) = lu(k,1022) * lu(k,1014) + lu(k,1023) = lu(k,1023) * lu(k,1014) + lu(k,1024) = lu(k,1024) * lu(k,1014) + lu(k,1025) = lu(k,1025) * lu(k,1014) + lu(k,1026) = lu(k,1026) * lu(k,1014) + lu(k,1027) = lu(k,1027) * lu(k,1014) + lu(k,1028) = lu(k,1028) * lu(k,1014) + lu(k,1029) = lu(k,1029) * lu(k,1014) + lu(k,1030) = lu(k,1030) * lu(k,1014) + lu(k,1031) = lu(k,1031) * lu(k,1014) + lu(k,1032) = lu(k,1032) * lu(k,1014) + lu(k,1033) = lu(k,1033) * lu(k,1014) + lu(k,1034) = lu(k,1034) * lu(k,1014) + lu(k,1035) = lu(k,1035) * lu(k,1014) + lu(k,1036) = lu(k,1036) * lu(k,1014) + lu(k,1037) = lu(k,1037) * lu(k,1014) + lu(k,1038) = lu(k,1038) * lu(k,1014) + lu(k,1103) = lu(k,1103) - lu(k,1015) * lu(k,1102) + lu(k,1104) = lu(k,1104) - lu(k,1016) * lu(k,1102) + lu(k,1105) = lu(k,1105) - lu(k,1017) * lu(k,1102) + lu(k,1106) = lu(k,1106) - lu(k,1018) * lu(k,1102) + lu(k,1107) = lu(k,1107) - lu(k,1019) * lu(k,1102) + lu(k,1108) = lu(k,1108) - lu(k,1020) * lu(k,1102) + lu(k,1109) = lu(k,1109) - lu(k,1021) * lu(k,1102) + lu(k,1110) = lu(k,1110) - lu(k,1022) * lu(k,1102) + lu(k,1111) = lu(k,1111) - lu(k,1023) * lu(k,1102) + lu(k,1112) = lu(k,1112) - lu(k,1024) * lu(k,1102) + lu(k,1113) = lu(k,1113) - lu(k,1025) * lu(k,1102) + lu(k,1114) = lu(k,1114) - lu(k,1026) * lu(k,1102) + lu(k,1115) = lu(k,1115) - lu(k,1027) * lu(k,1102) + lu(k,1116) = lu(k,1116) - lu(k,1028) * lu(k,1102) + lu(k,1117) = lu(k,1117) - lu(k,1029) * lu(k,1102) + lu(k,1118) = lu(k,1118) - lu(k,1030) * lu(k,1102) + lu(k,1119) = lu(k,1119) - lu(k,1031) * lu(k,1102) + lu(k,1120) = lu(k,1120) - lu(k,1032) * lu(k,1102) + lu(k,1121) = lu(k,1121) - lu(k,1033) * lu(k,1102) + lu(k,1122) = lu(k,1122) - lu(k,1034) * lu(k,1102) + lu(k,1123) = lu(k,1123) - lu(k,1035) * lu(k,1102) + lu(k,1124) = lu(k,1124) - lu(k,1036) * lu(k,1102) + lu(k,1125) = lu(k,1125) - lu(k,1037) * lu(k,1102) + lu(k,1126) = lu(k,1126) - lu(k,1038) * lu(k,1102) + lu(k,1151) = lu(k,1151) - lu(k,1015) * lu(k,1150) + lu(k,1152) = lu(k,1152) - lu(k,1016) * lu(k,1150) + lu(k,1153) = lu(k,1153) - lu(k,1017) * lu(k,1150) + lu(k,1154) = lu(k,1154) - lu(k,1018) * lu(k,1150) + lu(k,1155) = lu(k,1155) - lu(k,1019) * lu(k,1150) + lu(k,1156) = lu(k,1156) - lu(k,1020) * lu(k,1150) + lu(k,1157) = lu(k,1157) - lu(k,1021) * lu(k,1150) + lu(k,1158) = lu(k,1158) - lu(k,1022) * lu(k,1150) + lu(k,1159) = lu(k,1159) - lu(k,1023) * lu(k,1150) + lu(k,1160) = lu(k,1160) - lu(k,1024) * lu(k,1150) + lu(k,1161) = lu(k,1161) - lu(k,1025) * lu(k,1150) + lu(k,1162) = lu(k,1162) - lu(k,1026) * lu(k,1150) + lu(k,1163) = lu(k,1163) - lu(k,1027) * lu(k,1150) + lu(k,1164) = lu(k,1164) - lu(k,1028) * lu(k,1150) + lu(k,1165) = lu(k,1165) - lu(k,1029) * lu(k,1150) + lu(k,1166) = lu(k,1166) - lu(k,1030) * lu(k,1150) + lu(k,1167) = lu(k,1167) - lu(k,1031) * lu(k,1150) + lu(k,1168) = lu(k,1168) - lu(k,1032) * lu(k,1150) + lu(k,1169) = lu(k,1169) - lu(k,1033) * lu(k,1150) + lu(k,1170) = lu(k,1170) - lu(k,1034) * lu(k,1150) + lu(k,1171) = lu(k,1171) - lu(k,1035) * lu(k,1150) + lu(k,1172) = lu(k,1172) - lu(k,1036) * lu(k,1150) + lu(k,1173) = lu(k,1173) - lu(k,1037) * lu(k,1150) + lu(k,1174) = lu(k,1174) - lu(k,1038) * lu(k,1150) + lu(k,1194) = lu(k,1194) - lu(k,1015) * lu(k,1193) + lu(k,1195) = lu(k,1195) - lu(k,1016) * lu(k,1193) + lu(k,1196) = lu(k,1196) - lu(k,1017) * lu(k,1193) + lu(k,1197) = lu(k,1197) - lu(k,1018) * lu(k,1193) + lu(k,1198) = lu(k,1198) - lu(k,1019) * lu(k,1193) + lu(k,1199) = lu(k,1199) - lu(k,1020) * lu(k,1193) + lu(k,1200) = lu(k,1200) - lu(k,1021) * lu(k,1193) + lu(k,1201) = lu(k,1201) - lu(k,1022) * lu(k,1193) + lu(k,1202) = lu(k,1202) - lu(k,1023) * lu(k,1193) + lu(k,1203) = lu(k,1203) - lu(k,1024) * lu(k,1193) + lu(k,1204) = lu(k,1204) - lu(k,1025) * lu(k,1193) + lu(k,1205) = lu(k,1205) - lu(k,1026) * lu(k,1193) + lu(k,1206) = lu(k,1206) - lu(k,1027) * lu(k,1193) + lu(k,1207) = lu(k,1207) - lu(k,1028) * lu(k,1193) + lu(k,1208) = lu(k,1208) - lu(k,1029) * lu(k,1193) + lu(k,1209) = lu(k,1209) - lu(k,1030) * lu(k,1193) + lu(k,1210) = lu(k,1210) - lu(k,1031) * lu(k,1193) + lu(k,1211) = lu(k,1211) - lu(k,1032) * lu(k,1193) + lu(k,1212) = lu(k,1212) - lu(k,1033) * lu(k,1193) + lu(k,1213) = lu(k,1213) - lu(k,1034) * lu(k,1193) + lu(k,1214) = lu(k,1214) - lu(k,1035) * lu(k,1193) + lu(k,1215) = lu(k,1215) - lu(k,1036) * lu(k,1193) + lu(k,1216) = lu(k,1216) - lu(k,1037) * lu(k,1193) + lu(k,1217) = lu(k,1217) - lu(k,1038) * lu(k,1193) + lu(k,1237) = lu(k,1237) - lu(k,1015) * lu(k,1236) + lu(k,1238) = lu(k,1238) - lu(k,1016) * lu(k,1236) + lu(k,1239) = lu(k,1239) - lu(k,1017) * lu(k,1236) + lu(k,1240) = lu(k,1240) - lu(k,1018) * lu(k,1236) + lu(k,1241) = lu(k,1241) - lu(k,1019) * lu(k,1236) + lu(k,1242) = lu(k,1242) - lu(k,1020) * lu(k,1236) + lu(k,1243) = lu(k,1243) - lu(k,1021) * lu(k,1236) + lu(k,1244) = lu(k,1244) - lu(k,1022) * lu(k,1236) + lu(k,1245) = lu(k,1245) - lu(k,1023) * lu(k,1236) + lu(k,1246) = lu(k,1246) - lu(k,1024) * lu(k,1236) + lu(k,1247) = lu(k,1247) - lu(k,1025) * lu(k,1236) + lu(k,1248) = lu(k,1248) - lu(k,1026) * lu(k,1236) + lu(k,1249) = lu(k,1249) - lu(k,1027) * lu(k,1236) + lu(k,1250) = lu(k,1250) - lu(k,1028) * lu(k,1236) + lu(k,1251) = lu(k,1251) - lu(k,1029) * lu(k,1236) + lu(k,1252) = lu(k,1252) - lu(k,1030) * lu(k,1236) + lu(k,1253) = lu(k,1253) - lu(k,1031) * lu(k,1236) + lu(k,1254) = lu(k,1254) - lu(k,1032) * lu(k,1236) + lu(k,1255) = lu(k,1255) - lu(k,1033) * lu(k,1236) + lu(k,1256) = lu(k,1256) - lu(k,1034) * lu(k,1236) + lu(k,1257) = lu(k,1257) - lu(k,1035) * lu(k,1236) + lu(k,1258) = lu(k,1258) - lu(k,1036) * lu(k,1236) + lu(k,1259) = lu(k,1259) - lu(k,1037) * lu(k,1236) + lu(k,1260) = lu(k,1260) - lu(k,1038) * lu(k,1236) + lu(k,1279) = lu(k,1279) - lu(k,1015) * lu(k,1278) + lu(k,1280) = lu(k,1280) - lu(k,1016) * lu(k,1278) + lu(k,1281) = lu(k,1281) - lu(k,1017) * lu(k,1278) + lu(k,1282) = lu(k,1282) - lu(k,1018) * lu(k,1278) + lu(k,1283) = lu(k,1283) - lu(k,1019) * lu(k,1278) + lu(k,1284) = lu(k,1284) - lu(k,1020) * lu(k,1278) + lu(k,1285) = lu(k,1285) - lu(k,1021) * lu(k,1278) + lu(k,1286) = lu(k,1286) - lu(k,1022) * lu(k,1278) + lu(k,1287) = lu(k,1287) - lu(k,1023) * lu(k,1278) + lu(k,1288) = lu(k,1288) - lu(k,1024) * lu(k,1278) + lu(k,1289) = lu(k,1289) - lu(k,1025) * lu(k,1278) + lu(k,1290) = lu(k,1290) - lu(k,1026) * lu(k,1278) + lu(k,1291) = lu(k,1291) - lu(k,1027) * lu(k,1278) + lu(k,1292) = lu(k,1292) - lu(k,1028) * lu(k,1278) + lu(k,1293) = lu(k,1293) - lu(k,1029) * lu(k,1278) + lu(k,1294) = lu(k,1294) - lu(k,1030) * lu(k,1278) + lu(k,1295) = lu(k,1295) - lu(k,1031) * lu(k,1278) + lu(k,1296) = lu(k,1296) - lu(k,1032) * lu(k,1278) + lu(k,1297) = lu(k,1297) - lu(k,1033) * lu(k,1278) + lu(k,1298) = lu(k,1298) - lu(k,1034) * lu(k,1278) + lu(k,1299) = lu(k,1299) - lu(k,1035) * lu(k,1278) + lu(k,1300) = lu(k,1300) - lu(k,1036) * lu(k,1278) + lu(k,1301) = lu(k,1301) - lu(k,1037) * lu(k,1278) + lu(k,1302) = lu(k,1302) - lu(k,1038) * lu(k,1278) + lu(k,1321) = lu(k,1321) - lu(k,1015) * lu(k,1320) + lu(k,1322) = lu(k,1322) - lu(k,1016) * lu(k,1320) + lu(k,1323) = lu(k,1323) - lu(k,1017) * lu(k,1320) + lu(k,1324) = lu(k,1324) - lu(k,1018) * lu(k,1320) + lu(k,1325) = lu(k,1325) - lu(k,1019) * lu(k,1320) + lu(k,1326) = lu(k,1326) - lu(k,1020) * lu(k,1320) + lu(k,1327) = lu(k,1327) - lu(k,1021) * lu(k,1320) + lu(k,1328) = lu(k,1328) - lu(k,1022) * lu(k,1320) + lu(k,1329) = lu(k,1329) - lu(k,1023) * lu(k,1320) + lu(k,1330) = lu(k,1330) - lu(k,1024) * lu(k,1320) + lu(k,1331) = lu(k,1331) - lu(k,1025) * lu(k,1320) + lu(k,1332) = lu(k,1332) - lu(k,1026) * lu(k,1320) + lu(k,1333) = lu(k,1333) - lu(k,1027) * lu(k,1320) + lu(k,1334) = lu(k,1334) - lu(k,1028) * lu(k,1320) + lu(k,1335) = lu(k,1335) - lu(k,1029) * lu(k,1320) + lu(k,1336) = lu(k,1336) - lu(k,1030) * lu(k,1320) + lu(k,1337) = lu(k,1337) - lu(k,1031) * lu(k,1320) + lu(k,1338) = lu(k,1338) - lu(k,1032) * lu(k,1320) + lu(k,1339) = lu(k,1339) - lu(k,1033) * lu(k,1320) + lu(k,1340) = lu(k,1340) - lu(k,1034) * lu(k,1320) + lu(k,1341) = lu(k,1341) - lu(k,1035) * lu(k,1320) + lu(k,1342) = lu(k,1342) - lu(k,1036) * lu(k,1320) + lu(k,1343) = lu(k,1343) - lu(k,1037) * lu(k,1320) + lu(k,1344) = lu(k,1344) - lu(k,1038) * lu(k,1320) + lu(k,1381) = lu(k,1381) - lu(k,1015) * lu(k,1380) + lu(k,1382) = lu(k,1382) - lu(k,1016) * lu(k,1380) + lu(k,1383) = lu(k,1383) - lu(k,1017) * lu(k,1380) + lu(k,1384) = lu(k,1384) - lu(k,1018) * lu(k,1380) + lu(k,1385) = lu(k,1385) - lu(k,1019) * lu(k,1380) + lu(k,1386) = lu(k,1386) - lu(k,1020) * lu(k,1380) + lu(k,1387) = lu(k,1387) - lu(k,1021) * lu(k,1380) + lu(k,1388) = lu(k,1388) - lu(k,1022) * lu(k,1380) + lu(k,1389) = lu(k,1389) - lu(k,1023) * lu(k,1380) + lu(k,1390) = lu(k,1390) - lu(k,1024) * lu(k,1380) + lu(k,1391) = lu(k,1391) - lu(k,1025) * lu(k,1380) + lu(k,1392) = lu(k,1392) - lu(k,1026) * lu(k,1380) + lu(k,1393) = lu(k,1393) - lu(k,1027) * lu(k,1380) + lu(k,1394) = lu(k,1394) - lu(k,1028) * lu(k,1380) + lu(k,1395) = lu(k,1395) - lu(k,1029) * lu(k,1380) + lu(k,1396) = lu(k,1396) - lu(k,1030) * lu(k,1380) + lu(k,1397) = lu(k,1397) - lu(k,1031) * lu(k,1380) + lu(k,1398) = lu(k,1398) - lu(k,1032) * lu(k,1380) + lu(k,1399) = lu(k,1399) - lu(k,1033) * lu(k,1380) + lu(k,1400) = lu(k,1400) - lu(k,1034) * lu(k,1380) + lu(k,1401) = lu(k,1401) - lu(k,1035) * lu(k,1380) + lu(k,1402) = lu(k,1402) - lu(k,1036) * lu(k,1380) + lu(k,1403) = lu(k,1403) - lu(k,1037) * lu(k,1380) + lu(k,1404) = lu(k,1404) - lu(k,1038) * lu(k,1380) + lu(k,1430) = lu(k,1430) - lu(k,1015) * lu(k,1429) + lu(k,1431) = lu(k,1431) - lu(k,1016) * lu(k,1429) + lu(k,1432) = lu(k,1432) - lu(k,1017) * lu(k,1429) + lu(k,1433) = lu(k,1433) - lu(k,1018) * lu(k,1429) + lu(k,1434) = lu(k,1434) - lu(k,1019) * lu(k,1429) + lu(k,1435) = lu(k,1435) - lu(k,1020) * lu(k,1429) + lu(k,1436) = lu(k,1436) - lu(k,1021) * lu(k,1429) + lu(k,1437) = lu(k,1437) - lu(k,1022) * lu(k,1429) + lu(k,1438) = lu(k,1438) - lu(k,1023) * lu(k,1429) + lu(k,1439) = lu(k,1439) - lu(k,1024) * lu(k,1429) + lu(k,1440) = lu(k,1440) - lu(k,1025) * lu(k,1429) + lu(k,1441) = lu(k,1441) - lu(k,1026) * lu(k,1429) + lu(k,1442) = lu(k,1442) - lu(k,1027) * lu(k,1429) + lu(k,1443) = lu(k,1443) - lu(k,1028) * lu(k,1429) + lu(k,1444) = lu(k,1444) - lu(k,1029) * lu(k,1429) + lu(k,1445) = lu(k,1445) - lu(k,1030) * lu(k,1429) + lu(k,1446) = lu(k,1446) - lu(k,1031) * lu(k,1429) + lu(k,1447) = lu(k,1447) - lu(k,1032) * lu(k,1429) + lu(k,1448) = lu(k,1448) - lu(k,1033) * lu(k,1429) + lu(k,1449) = lu(k,1449) - lu(k,1034) * lu(k,1429) + lu(k,1450) = lu(k,1450) - lu(k,1035) * lu(k,1429) + lu(k,1451) = lu(k,1451) - lu(k,1036) * lu(k,1429) + lu(k,1452) = lu(k,1452) - lu(k,1037) * lu(k,1429) + lu(k,1453) = lu(k,1453) - lu(k,1038) * lu(k,1429) + lu(k,1478) = lu(k,1478) - lu(k,1015) * lu(k,1477) + lu(k,1479) = lu(k,1479) - lu(k,1016) * lu(k,1477) + lu(k,1480) = lu(k,1480) - lu(k,1017) * lu(k,1477) + lu(k,1481) = lu(k,1481) - lu(k,1018) * lu(k,1477) + lu(k,1482) = lu(k,1482) - lu(k,1019) * lu(k,1477) + lu(k,1483) = lu(k,1483) - lu(k,1020) * lu(k,1477) + lu(k,1484) = lu(k,1484) - lu(k,1021) * lu(k,1477) + lu(k,1485) = lu(k,1485) - lu(k,1022) * lu(k,1477) + lu(k,1486) = lu(k,1486) - lu(k,1023) * lu(k,1477) + lu(k,1487) = lu(k,1487) - lu(k,1024) * lu(k,1477) + lu(k,1488) = lu(k,1488) - lu(k,1025) * lu(k,1477) + lu(k,1489) = lu(k,1489) - lu(k,1026) * lu(k,1477) + lu(k,1490) = lu(k,1490) - lu(k,1027) * lu(k,1477) + lu(k,1491) = lu(k,1491) - lu(k,1028) * lu(k,1477) + lu(k,1492) = lu(k,1492) - lu(k,1029) * lu(k,1477) + lu(k,1493) = lu(k,1493) - lu(k,1030) * lu(k,1477) + lu(k,1494) = lu(k,1494) - lu(k,1031) * lu(k,1477) + lu(k,1495) = lu(k,1495) - lu(k,1032) * lu(k,1477) + lu(k,1496) = lu(k,1496) - lu(k,1033) * lu(k,1477) + lu(k,1497) = lu(k,1497) - lu(k,1034) * lu(k,1477) + lu(k,1498) = lu(k,1498) - lu(k,1035) * lu(k,1477) + lu(k,1499) = lu(k,1499) - lu(k,1036) * lu(k,1477) + lu(k,1500) = lu(k,1500) - lu(k,1037) * lu(k,1477) + lu(k,1501) = lu(k,1501) - lu(k,1038) * lu(k,1477) + lu(k,1519) = lu(k,1519) - lu(k,1015) * lu(k,1518) + lu(k,1520) = lu(k,1520) - lu(k,1016) * lu(k,1518) + lu(k,1521) = lu(k,1521) - lu(k,1017) * lu(k,1518) + lu(k,1522) = lu(k,1522) - lu(k,1018) * lu(k,1518) + lu(k,1523) = lu(k,1523) - lu(k,1019) * lu(k,1518) + lu(k,1524) = lu(k,1524) - lu(k,1020) * lu(k,1518) + lu(k,1525) = lu(k,1525) - lu(k,1021) * lu(k,1518) + lu(k,1526) = lu(k,1526) - lu(k,1022) * lu(k,1518) + lu(k,1527) = lu(k,1527) - lu(k,1023) * lu(k,1518) + lu(k,1528) = lu(k,1528) - lu(k,1024) * lu(k,1518) + lu(k,1529) = lu(k,1529) - lu(k,1025) * lu(k,1518) + lu(k,1530) = lu(k,1530) - lu(k,1026) * lu(k,1518) + lu(k,1531) = lu(k,1531) - lu(k,1027) * lu(k,1518) + lu(k,1532) = lu(k,1532) - lu(k,1028) * lu(k,1518) + lu(k,1533) = lu(k,1533) - lu(k,1029) * lu(k,1518) + lu(k,1534) = lu(k,1534) - lu(k,1030) * lu(k,1518) + lu(k,1535) = lu(k,1535) - lu(k,1031) * lu(k,1518) + lu(k,1536) = lu(k,1536) - lu(k,1032) * lu(k,1518) + lu(k,1537) = lu(k,1537) - lu(k,1033) * lu(k,1518) + lu(k,1538) = lu(k,1538) - lu(k,1034) * lu(k,1518) + lu(k,1539) = lu(k,1539) - lu(k,1035) * lu(k,1518) + lu(k,1540) = lu(k,1540) - lu(k,1036) * lu(k,1518) + lu(k,1541) = lu(k,1541) - lu(k,1037) * lu(k,1518) + lu(k,1542) = lu(k,1542) - lu(k,1038) * lu(k,1518) + lu(k,1555) = lu(k,1555) - lu(k,1015) * lu(k,1554) + lu(k,1556) = lu(k,1556) - lu(k,1016) * lu(k,1554) + lu(k,1557) = lu(k,1557) - lu(k,1017) * lu(k,1554) + lu(k,1558) = lu(k,1558) - lu(k,1018) * lu(k,1554) + lu(k,1559) = lu(k,1559) - lu(k,1019) * lu(k,1554) + lu(k,1560) = lu(k,1560) - lu(k,1020) * lu(k,1554) + lu(k,1561) = lu(k,1561) - lu(k,1021) * lu(k,1554) + lu(k,1562) = lu(k,1562) - lu(k,1022) * lu(k,1554) + lu(k,1563) = lu(k,1563) - lu(k,1023) * lu(k,1554) + lu(k,1564) = lu(k,1564) - lu(k,1024) * lu(k,1554) + lu(k,1565) = lu(k,1565) - lu(k,1025) * lu(k,1554) + lu(k,1566) = lu(k,1566) - lu(k,1026) * lu(k,1554) + lu(k,1567) = lu(k,1567) - lu(k,1027) * lu(k,1554) + lu(k,1568) = lu(k,1568) - lu(k,1028) * lu(k,1554) + lu(k,1569) = lu(k,1569) - lu(k,1029) * lu(k,1554) + lu(k,1570) = lu(k,1570) - lu(k,1030) * lu(k,1554) + lu(k,1571) = lu(k,1571) - lu(k,1031) * lu(k,1554) + lu(k,1572) = lu(k,1572) - lu(k,1032) * lu(k,1554) + lu(k,1573) = lu(k,1573) - lu(k,1033) * lu(k,1554) + lu(k,1574) = lu(k,1574) - lu(k,1034) * lu(k,1554) + lu(k,1575) = lu(k,1575) - lu(k,1035) * lu(k,1554) + lu(k,1576) = lu(k,1576) - lu(k,1036) * lu(k,1554) + lu(k,1577) = lu(k,1577) - lu(k,1037) * lu(k,1554) + lu(k,1578) = lu(k,1578) - lu(k,1038) * lu(k,1554) + lu(k,1600) = lu(k,1600) - lu(k,1015) * lu(k,1599) + lu(k,1601) = lu(k,1601) - lu(k,1016) * lu(k,1599) + lu(k,1602) = lu(k,1602) - lu(k,1017) * lu(k,1599) + lu(k,1603) = lu(k,1603) - lu(k,1018) * lu(k,1599) + lu(k,1604) = lu(k,1604) - lu(k,1019) * lu(k,1599) + lu(k,1605) = lu(k,1605) - lu(k,1020) * lu(k,1599) + lu(k,1606) = lu(k,1606) - lu(k,1021) * lu(k,1599) + lu(k,1607) = lu(k,1607) - lu(k,1022) * lu(k,1599) + lu(k,1608) = lu(k,1608) - lu(k,1023) * lu(k,1599) + lu(k,1609) = lu(k,1609) - lu(k,1024) * lu(k,1599) + lu(k,1610) = lu(k,1610) - lu(k,1025) * lu(k,1599) + lu(k,1611) = lu(k,1611) - lu(k,1026) * lu(k,1599) + lu(k,1612) = lu(k,1612) - lu(k,1027) * lu(k,1599) + lu(k,1613) = lu(k,1613) - lu(k,1028) * lu(k,1599) + lu(k,1614) = lu(k,1614) - lu(k,1029) * lu(k,1599) + lu(k,1615) = lu(k,1615) - lu(k,1030) * lu(k,1599) + lu(k,1616) = lu(k,1616) - lu(k,1031) * lu(k,1599) + lu(k,1617) = lu(k,1617) - lu(k,1032) * lu(k,1599) + lu(k,1618) = lu(k,1618) - lu(k,1033) * lu(k,1599) + lu(k,1619) = lu(k,1619) - lu(k,1034) * lu(k,1599) + lu(k,1620) = lu(k,1620) - lu(k,1035) * lu(k,1599) + lu(k,1621) = lu(k,1621) - lu(k,1036) * lu(k,1599) + lu(k,1622) = lu(k,1622) - lu(k,1037) * lu(k,1599) + lu(k,1623) = lu(k,1623) - lu(k,1038) * lu(k,1599) + lu(k,1643) = lu(k,1643) - lu(k,1015) * lu(k,1642) + lu(k,1644) = lu(k,1644) - lu(k,1016) * lu(k,1642) + lu(k,1645) = lu(k,1645) - lu(k,1017) * lu(k,1642) + lu(k,1646) = lu(k,1646) - lu(k,1018) * lu(k,1642) + lu(k,1647) = lu(k,1647) - lu(k,1019) * lu(k,1642) + lu(k,1648) = lu(k,1648) - lu(k,1020) * lu(k,1642) + lu(k,1649) = lu(k,1649) - lu(k,1021) * lu(k,1642) + lu(k,1650) = lu(k,1650) - lu(k,1022) * lu(k,1642) + lu(k,1651) = lu(k,1651) - lu(k,1023) * lu(k,1642) + lu(k,1652) = lu(k,1652) - lu(k,1024) * lu(k,1642) + lu(k,1653) = lu(k,1653) - lu(k,1025) * lu(k,1642) + lu(k,1654) = lu(k,1654) - lu(k,1026) * lu(k,1642) + lu(k,1655) = lu(k,1655) - lu(k,1027) * lu(k,1642) + lu(k,1656) = lu(k,1656) - lu(k,1028) * lu(k,1642) + lu(k,1657) = lu(k,1657) - lu(k,1029) * lu(k,1642) + lu(k,1658) = lu(k,1658) - lu(k,1030) * lu(k,1642) + lu(k,1659) = lu(k,1659) - lu(k,1031) * lu(k,1642) + lu(k,1660) = lu(k,1660) - lu(k,1032) * lu(k,1642) + lu(k,1661) = lu(k,1661) - lu(k,1033) * lu(k,1642) + lu(k,1662) = lu(k,1662) - lu(k,1034) * lu(k,1642) + lu(k,1663) = lu(k,1663) - lu(k,1035) * lu(k,1642) + lu(k,1664) = lu(k,1664) - lu(k,1036) * lu(k,1642) + lu(k,1665) = lu(k,1665) - lu(k,1037) * lu(k,1642) + lu(k,1666) = lu(k,1666) - lu(k,1038) * lu(k,1642) + lu(k,1686) = lu(k,1686) - lu(k,1015) * lu(k,1685) + lu(k,1687) = lu(k,1687) - lu(k,1016) * lu(k,1685) + lu(k,1688) = lu(k,1688) - lu(k,1017) * lu(k,1685) + lu(k,1689) = lu(k,1689) - lu(k,1018) * lu(k,1685) + lu(k,1690) = lu(k,1690) - lu(k,1019) * lu(k,1685) + lu(k,1691) = lu(k,1691) - lu(k,1020) * lu(k,1685) + lu(k,1692) = lu(k,1692) - lu(k,1021) * lu(k,1685) + lu(k,1693) = lu(k,1693) - lu(k,1022) * lu(k,1685) + lu(k,1694) = lu(k,1694) - lu(k,1023) * lu(k,1685) + lu(k,1695) = lu(k,1695) - lu(k,1024) * lu(k,1685) + lu(k,1696) = lu(k,1696) - lu(k,1025) * lu(k,1685) + lu(k,1697) = lu(k,1697) - lu(k,1026) * lu(k,1685) + lu(k,1698) = lu(k,1698) - lu(k,1027) * lu(k,1685) + lu(k,1699) = lu(k,1699) - lu(k,1028) * lu(k,1685) + lu(k,1700) = lu(k,1700) - lu(k,1029) * lu(k,1685) + lu(k,1701) = lu(k,1701) - lu(k,1030) * lu(k,1685) + lu(k,1702) = lu(k,1702) - lu(k,1031) * lu(k,1685) + lu(k,1703) = lu(k,1703) - lu(k,1032) * lu(k,1685) + lu(k,1704) = lu(k,1704) - lu(k,1033) * lu(k,1685) + lu(k,1705) = lu(k,1705) - lu(k,1034) * lu(k,1685) + lu(k,1706) = lu(k,1706) - lu(k,1035) * lu(k,1685) + lu(k,1707) = lu(k,1707) - lu(k,1036) * lu(k,1685) + lu(k,1708) = lu(k,1708) - lu(k,1037) * lu(k,1685) + lu(k,1709) = lu(k,1709) - lu(k,1038) * lu(k,1685) + lu(k,1762) = lu(k,1762) - lu(k,1015) * lu(k,1761) + lu(k,1763) = lu(k,1763) - lu(k,1016) * lu(k,1761) + lu(k,1764) = lu(k,1764) - lu(k,1017) * lu(k,1761) + lu(k,1765) = lu(k,1765) - lu(k,1018) * lu(k,1761) + lu(k,1766) = lu(k,1766) - lu(k,1019) * lu(k,1761) + lu(k,1767) = lu(k,1767) - lu(k,1020) * lu(k,1761) + lu(k,1768) = lu(k,1768) - lu(k,1021) * lu(k,1761) + lu(k,1769) = lu(k,1769) - lu(k,1022) * lu(k,1761) + lu(k,1770) = lu(k,1770) - lu(k,1023) * lu(k,1761) + lu(k,1771) = lu(k,1771) - lu(k,1024) * lu(k,1761) + lu(k,1772) = lu(k,1772) - lu(k,1025) * lu(k,1761) + lu(k,1773) = lu(k,1773) - lu(k,1026) * lu(k,1761) + lu(k,1774) = lu(k,1774) - lu(k,1027) * lu(k,1761) + lu(k,1775) = lu(k,1775) - lu(k,1028) * lu(k,1761) + lu(k,1776) = lu(k,1776) - lu(k,1029) * lu(k,1761) + lu(k,1777) = lu(k,1777) - lu(k,1030) * lu(k,1761) + lu(k,1778) = lu(k,1778) - lu(k,1031) * lu(k,1761) + lu(k,1779) = lu(k,1779) - lu(k,1032) * lu(k,1761) + lu(k,1780) = lu(k,1780) - lu(k,1033) * lu(k,1761) + lu(k,1781) = lu(k,1781) - lu(k,1034) * lu(k,1761) + lu(k,1782) = lu(k,1782) - lu(k,1035) * lu(k,1761) + lu(k,1783) = lu(k,1783) - lu(k,1036) * lu(k,1761) + lu(k,1784) = lu(k,1784) - lu(k,1037) * lu(k,1761) + lu(k,1785) = lu(k,1785) - lu(k,1038) * lu(k,1761) + lu(k,1810) = lu(k,1810) - lu(k,1015) * lu(k,1809) + lu(k,1811) = lu(k,1811) - lu(k,1016) * lu(k,1809) + lu(k,1812) = lu(k,1812) - lu(k,1017) * lu(k,1809) + lu(k,1813) = lu(k,1813) - lu(k,1018) * lu(k,1809) + lu(k,1814) = lu(k,1814) - lu(k,1019) * lu(k,1809) + lu(k,1815) = lu(k,1815) - lu(k,1020) * lu(k,1809) + lu(k,1816) = lu(k,1816) - lu(k,1021) * lu(k,1809) + lu(k,1817) = lu(k,1817) - lu(k,1022) * lu(k,1809) + lu(k,1818) = lu(k,1818) - lu(k,1023) * lu(k,1809) + lu(k,1819) = lu(k,1819) - lu(k,1024) * lu(k,1809) + lu(k,1820) = lu(k,1820) - lu(k,1025) * lu(k,1809) + lu(k,1821) = lu(k,1821) - lu(k,1026) * lu(k,1809) + lu(k,1822) = lu(k,1822) - lu(k,1027) * lu(k,1809) + lu(k,1823) = lu(k,1823) - lu(k,1028) * lu(k,1809) + lu(k,1824) = lu(k,1824) - lu(k,1029) * lu(k,1809) + lu(k,1825) = lu(k,1825) - lu(k,1030) * lu(k,1809) + lu(k,1826) = lu(k,1826) - lu(k,1031) * lu(k,1809) + lu(k,1827) = lu(k,1827) - lu(k,1032) * lu(k,1809) + lu(k,1828) = lu(k,1828) - lu(k,1033) * lu(k,1809) + lu(k,1829) = lu(k,1829) - lu(k,1034) * lu(k,1809) + lu(k,1830) = lu(k,1830) - lu(k,1035) * lu(k,1809) + lu(k,1831) = lu(k,1831) - lu(k,1036) * lu(k,1809) + lu(k,1832) = lu(k,1832) - lu(k,1037) * lu(k,1809) + lu(k,1833) = lu(k,1833) - lu(k,1038) * lu(k,1809) + lu(k,1843) = lu(k,1843) - lu(k,1015) * lu(k,1842) + lu(k,1844) = lu(k,1844) - lu(k,1016) * lu(k,1842) + lu(k,1845) = lu(k,1845) - lu(k,1017) * lu(k,1842) + lu(k,1846) = lu(k,1846) - lu(k,1018) * lu(k,1842) + lu(k,1847) = lu(k,1847) - lu(k,1019) * lu(k,1842) + lu(k,1848) = lu(k,1848) - lu(k,1020) * lu(k,1842) + lu(k,1849) = lu(k,1849) - lu(k,1021) * lu(k,1842) + lu(k,1850) = lu(k,1850) - lu(k,1022) * lu(k,1842) + lu(k,1851) = lu(k,1851) - lu(k,1023) * lu(k,1842) + lu(k,1852) = lu(k,1852) - lu(k,1024) * lu(k,1842) + lu(k,1853) = lu(k,1853) - lu(k,1025) * lu(k,1842) + lu(k,1854) = lu(k,1854) - lu(k,1026) * lu(k,1842) + lu(k,1855) = lu(k,1855) - lu(k,1027) * lu(k,1842) + lu(k,1856) = lu(k,1856) - lu(k,1028) * lu(k,1842) + lu(k,1857) = lu(k,1857) - lu(k,1029) * lu(k,1842) + lu(k,1858) = lu(k,1858) - lu(k,1030) * lu(k,1842) + lu(k,1859) = lu(k,1859) - lu(k,1031) * lu(k,1842) + lu(k,1860) = lu(k,1860) - lu(k,1032) * lu(k,1842) + lu(k,1861) = lu(k,1861) - lu(k,1033) * lu(k,1842) + lu(k,1862) = lu(k,1862) - lu(k,1034) * lu(k,1842) + lu(k,1863) = lu(k,1863) - lu(k,1035) * lu(k,1842) + lu(k,1864) = lu(k,1864) - lu(k,1036) * lu(k,1842) + lu(k,1865) = lu(k,1865) - lu(k,1037) * lu(k,1842) + lu(k,1866) = lu(k,1866) - lu(k,1038) * lu(k,1842) + lu(k,1879) = lu(k,1879) - lu(k,1015) * lu(k,1878) + lu(k,1880) = lu(k,1880) - lu(k,1016) * lu(k,1878) + lu(k,1881) = lu(k,1881) - lu(k,1017) * lu(k,1878) + lu(k,1882) = lu(k,1882) - lu(k,1018) * lu(k,1878) + lu(k,1883) = lu(k,1883) - lu(k,1019) * lu(k,1878) + lu(k,1884) = lu(k,1884) - lu(k,1020) * lu(k,1878) + lu(k,1885) = lu(k,1885) - lu(k,1021) * lu(k,1878) + lu(k,1886) = lu(k,1886) - lu(k,1022) * lu(k,1878) + lu(k,1887) = lu(k,1887) - lu(k,1023) * lu(k,1878) + lu(k,1888) = lu(k,1888) - lu(k,1024) * lu(k,1878) + lu(k,1889) = lu(k,1889) - lu(k,1025) * lu(k,1878) + lu(k,1890) = lu(k,1890) - lu(k,1026) * lu(k,1878) + lu(k,1891) = lu(k,1891) - lu(k,1027) * lu(k,1878) + lu(k,1892) = lu(k,1892) - lu(k,1028) * lu(k,1878) + lu(k,1893) = lu(k,1893) - lu(k,1029) * lu(k,1878) + lu(k,1894) = lu(k,1894) - lu(k,1030) * lu(k,1878) + lu(k,1895) = lu(k,1895) - lu(k,1031) * lu(k,1878) + lu(k,1896) = lu(k,1896) - lu(k,1032) * lu(k,1878) + lu(k,1897) = lu(k,1897) - lu(k,1033) * lu(k,1878) + lu(k,1898) = lu(k,1898) - lu(k,1034) * lu(k,1878) + lu(k,1899) = lu(k,1899) - lu(k,1035) * lu(k,1878) + lu(k,1900) = lu(k,1900) - lu(k,1036) * lu(k,1878) + lu(k,1901) = lu(k,1901) - lu(k,1037) * lu(k,1878) + lu(k,1902) = lu(k,1902) - lu(k,1038) * lu(k,1878) + lu(k,1920) = lu(k,1920) - lu(k,1015) * lu(k,1919) + lu(k,1921) = lu(k,1921) - lu(k,1016) * lu(k,1919) + lu(k,1922) = lu(k,1922) - lu(k,1017) * lu(k,1919) + lu(k,1923) = lu(k,1923) - lu(k,1018) * lu(k,1919) + lu(k,1924) = lu(k,1924) - lu(k,1019) * lu(k,1919) + lu(k,1925) = lu(k,1925) - lu(k,1020) * lu(k,1919) + lu(k,1926) = lu(k,1926) - lu(k,1021) * lu(k,1919) + lu(k,1927) = lu(k,1927) - lu(k,1022) * lu(k,1919) + lu(k,1928) = lu(k,1928) - lu(k,1023) * lu(k,1919) + lu(k,1929) = lu(k,1929) - lu(k,1024) * lu(k,1919) + lu(k,1930) = lu(k,1930) - lu(k,1025) * lu(k,1919) + lu(k,1931) = lu(k,1931) - lu(k,1026) * lu(k,1919) + lu(k,1932) = lu(k,1932) - lu(k,1027) * lu(k,1919) + lu(k,1933) = lu(k,1933) - lu(k,1028) * lu(k,1919) + lu(k,1934) = lu(k,1934) - lu(k,1029) * lu(k,1919) + lu(k,1935) = lu(k,1935) - lu(k,1030) * lu(k,1919) + lu(k,1936) = lu(k,1936) - lu(k,1031) * lu(k,1919) + lu(k,1937) = lu(k,1937) - lu(k,1032) * lu(k,1919) + lu(k,1938) = lu(k,1938) - lu(k,1033) * lu(k,1919) + lu(k,1939) = lu(k,1939) - lu(k,1034) * lu(k,1919) + lu(k,1940) = lu(k,1940) - lu(k,1035) * lu(k,1919) + lu(k,1941) = lu(k,1941) - lu(k,1036) * lu(k,1919) + lu(k,1942) = lu(k,1942) - lu(k,1037) * lu(k,1919) + lu(k,1943) = lu(k,1943) - lu(k,1038) * lu(k,1919) + lu(k,1962) = lu(k,1962) - lu(k,1015) * lu(k,1961) + lu(k,1963) = lu(k,1963) - lu(k,1016) * lu(k,1961) + lu(k,1964) = lu(k,1964) - lu(k,1017) * lu(k,1961) + lu(k,1965) = lu(k,1965) - lu(k,1018) * lu(k,1961) + lu(k,1966) = lu(k,1966) - lu(k,1019) * lu(k,1961) + lu(k,1967) = lu(k,1967) - lu(k,1020) * lu(k,1961) + lu(k,1968) = lu(k,1968) - lu(k,1021) * lu(k,1961) + lu(k,1969) = lu(k,1969) - lu(k,1022) * lu(k,1961) + lu(k,1970) = lu(k,1970) - lu(k,1023) * lu(k,1961) + lu(k,1971) = lu(k,1971) - lu(k,1024) * lu(k,1961) + lu(k,1972) = lu(k,1972) - lu(k,1025) * lu(k,1961) + lu(k,1973) = lu(k,1973) - lu(k,1026) * lu(k,1961) + lu(k,1974) = lu(k,1974) - lu(k,1027) * lu(k,1961) + lu(k,1975) = lu(k,1975) - lu(k,1028) * lu(k,1961) + lu(k,1976) = lu(k,1976) - lu(k,1029) * lu(k,1961) + lu(k,1977) = lu(k,1977) - lu(k,1030) * lu(k,1961) + lu(k,1978) = lu(k,1978) - lu(k,1031) * lu(k,1961) + lu(k,1979) = lu(k,1979) - lu(k,1032) * lu(k,1961) + lu(k,1980) = lu(k,1980) - lu(k,1033) * lu(k,1961) + lu(k,1981) = lu(k,1981) - lu(k,1034) * lu(k,1961) + lu(k,1982) = lu(k,1982) - lu(k,1035) * lu(k,1961) + lu(k,1983) = lu(k,1983) - lu(k,1036) * lu(k,1961) + lu(k,1984) = lu(k,1984) - lu(k,1037) * lu(k,1961) + lu(k,1985) = lu(k,1985) - lu(k,1038) * lu(k,1961) + lu(k,2007) = lu(k,2007) - lu(k,1015) * lu(k,2006) + lu(k,2008) = lu(k,2008) - lu(k,1016) * lu(k,2006) + lu(k,2009) = lu(k,2009) - lu(k,1017) * lu(k,2006) + lu(k,2010) = lu(k,2010) - lu(k,1018) * lu(k,2006) + lu(k,2011) = lu(k,2011) - lu(k,1019) * lu(k,2006) + lu(k,2012) = lu(k,2012) - lu(k,1020) * lu(k,2006) + lu(k,2013) = lu(k,2013) - lu(k,1021) * lu(k,2006) + lu(k,2014) = lu(k,2014) - lu(k,1022) * lu(k,2006) + lu(k,2015) = lu(k,2015) - lu(k,1023) * lu(k,2006) + lu(k,2016) = lu(k,2016) - lu(k,1024) * lu(k,2006) + lu(k,2017) = lu(k,2017) - lu(k,1025) * lu(k,2006) + lu(k,2018) = lu(k,2018) - lu(k,1026) * lu(k,2006) + lu(k,2019) = lu(k,2019) - lu(k,1027) * lu(k,2006) + lu(k,2020) = lu(k,2020) - lu(k,1028) * lu(k,2006) + lu(k,2021) = lu(k,2021) - lu(k,1029) * lu(k,2006) + lu(k,2022) = lu(k,2022) - lu(k,1030) * lu(k,2006) + lu(k,2023) = lu(k,2023) - lu(k,1031) * lu(k,2006) + lu(k,2024) = lu(k,2024) - lu(k,1032) * lu(k,2006) + lu(k,2025) = lu(k,2025) - lu(k,1033) * lu(k,2006) + lu(k,2026) = lu(k,2026) - lu(k,1034) * lu(k,2006) + lu(k,2027) = lu(k,2027) - lu(k,1035) * lu(k,2006) + lu(k,2028) = lu(k,2028) - lu(k,1036) * lu(k,2006) + lu(k,2029) = lu(k,2029) - lu(k,1037) * lu(k,2006) + lu(k,2030) = lu(k,2030) - lu(k,1038) * lu(k,2006) + lu(k,2067) = lu(k,2067) - lu(k,1015) * lu(k,2066) + lu(k,2068) = lu(k,2068) - lu(k,1016) * lu(k,2066) + lu(k,2069) = lu(k,2069) - lu(k,1017) * lu(k,2066) + lu(k,2070) = lu(k,2070) - lu(k,1018) * lu(k,2066) + lu(k,2071) = lu(k,2071) - lu(k,1019) * lu(k,2066) + lu(k,2072) = lu(k,2072) - lu(k,1020) * lu(k,2066) + lu(k,2073) = lu(k,2073) - lu(k,1021) * lu(k,2066) + lu(k,2074) = lu(k,2074) - lu(k,1022) * lu(k,2066) + lu(k,2075) = lu(k,2075) - lu(k,1023) * lu(k,2066) + lu(k,2076) = lu(k,2076) - lu(k,1024) * lu(k,2066) + lu(k,2077) = lu(k,2077) - lu(k,1025) * lu(k,2066) + lu(k,2078) = lu(k,2078) - lu(k,1026) * lu(k,2066) + lu(k,2079) = lu(k,2079) - lu(k,1027) * lu(k,2066) + lu(k,2080) = lu(k,2080) - lu(k,1028) * lu(k,2066) + lu(k,2081) = lu(k,2081) - lu(k,1029) * lu(k,2066) + lu(k,2082) = lu(k,2082) - lu(k,1030) * lu(k,2066) + lu(k,2083) = lu(k,2083) - lu(k,1031) * lu(k,2066) + lu(k,2084) = lu(k,2084) - lu(k,1032) * lu(k,2066) + lu(k,2085) = lu(k,2085) - lu(k,1033) * lu(k,2066) + lu(k,2086) = lu(k,2086) - lu(k,1034) * lu(k,2066) + lu(k,2087) = lu(k,2087) - lu(k,1035) * lu(k,2066) + lu(k,2088) = lu(k,2088) - lu(k,1036) * lu(k,2066) + lu(k,2089) = lu(k,2089) - lu(k,1037) * lu(k,2066) + lu(k,2090) = lu(k,2090) - lu(k,1038) * lu(k,2066) + lu(k,1058) = 1._r8 / lu(k,1058) + lu(k,1059) = lu(k,1059) * lu(k,1058) + lu(k,1060) = lu(k,1060) * lu(k,1058) + lu(k,1061) = lu(k,1061) * lu(k,1058) + lu(k,1062) = lu(k,1062) * lu(k,1058) + lu(k,1063) = lu(k,1063) * lu(k,1058) + lu(k,1064) = lu(k,1064) * lu(k,1058) + lu(k,1065) = lu(k,1065) * lu(k,1058) + lu(k,1066) = lu(k,1066) * lu(k,1058) + lu(k,1067) = lu(k,1067) * lu(k,1058) + lu(k,1068) = lu(k,1068) * lu(k,1058) + lu(k,1069) = lu(k,1069) * lu(k,1058) + lu(k,1070) = lu(k,1070) * lu(k,1058) + lu(k,1071) = lu(k,1071) * lu(k,1058) + lu(k,1072) = lu(k,1072) * lu(k,1058) + lu(k,1073) = lu(k,1073) * lu(k,1058) + lu(k,1074) = lu(k,1074) * lu(k,1058) + lu(k,1075) = lu(k,1075) * lu(k,1058) + lu(k,1076) = lu(k,1076) * lu(k,1058) + lu(k,1077) = lu(k,1077) * lu(k,1058) + lu(k,1078) = lu(k,1078) * lu(k,1058) + lu(k,1079) = lu(k,1079) * lu(k,1058) + lu(k,1080) = lu(k,1080) * lu(k,1058) + lu(k,1081) = lu(k,1081) * lu(k,1058) + lu(k,1104) = lu(k,1104) - lu(k,1059) * lu(k,1103) + lu(k,1105) = lu(k,1105) - lu(k,1060) * lu(k,1103) + lu(k,1106) = lu(k,1106) - lu(k,1061) * lu(k,1103) + lu(k,1107) = lu(k,1107) - lu(k,1062) * lu(k,1103) + lu(k,1108) = lu(k,1108) - lu(k,1063) * lu(k,1103) + lu(k,1109) = lu(k,1109) - lu(k,1064) * lu(k,1103) + lu(k,1110) = lu(k,1110) - lu(k,1065) * lu(k,1103) + lu(k,1111) = lu(k,1111) - lu(k,1066) * lu(k,1103) + lu(k,1112) = lu(k,1112) - lu(k,1067) * lu(k,1103) + lu(k,1113) = lu(k,1113) - lu(k,1068) * lu(k,1103) + lu(k,1114) = lu(k,1114) - lu(k,1069) * lu(k,1103) + lu(k,1115) = lu(k,1115) - lu(k,1070) * lu(k,1103) + lu(k,1116) = lu(k,1116) - lu(k,1071) * lu(k,1103) + lu(k,1117) = lu(k,1117) - lu(k,1072) * lu(k,1103) + lu(k,1118) = lu(k,1118) - lu(k,1073) * lu(k,1103) + lu(k,1119) = lu(k,1119) - lu(k,1074) * lu(k,1103) + lu(k,1120) = lu(k,1120) - lu(k,1075) * lu(k,1103) + lu(k,1121) = lu(k,1121) - lu(k,1076) * lu(k,1103) + lu(k,1122) = lu(k,1122) - lu(k,1077) * lu(k,1103) + lu(k,1123) = lu(k,1123) - lu(k,1078) * lu(k,1103) + lu(k,1124) = lu(k,1124) - lu(k,1079) * lu(k,1103) + lu(k,1125) = lu(k,1125) - lu(k,1080) * lu(k,1103) + lu(k,1126) = lu(k,1126) - lu(k,1081) * lu(k,1103) + lu(k,1152) = lu(k,1152) - lu(k,1059) * lu(k,1151) + lu(k,1153) = lu(k,1153) - lu(k,1060) * lu(k,1151) + lu(k,1154) = lu(k,1154) - lu(k,1061) * lu(k,1151) + lu(k,1155) = lu(k,1155) - lu(k,1062) * lu(k,1151) + lu(k,1156) = lu(k,1156) - lu(k,1063) * lu(k,1151) + lu(k,1157) = lu(k,1157) - lu(k,1064) * lu(k,1151) + lu(k,1158) = lu(k,1158) - lu(k,1065) * lu(k,1151) + lu(k,1159) = lu(k,1159) - lu(k,1066) * lu(k,1151) + lu(k,1160) = lu(k,1160) - lu(k,1067) * lu(k,1151) + lu(k,1161) = lu(k,1161) - lu(k,1068) * lu(k,1151) + lu(k,1162) = lu(k,1162) - lu(k,1069) * lu(k,1151) + lu(k,1163) = lu(k,1163) - lu(k,1070) * lu(k,1151) + lu(k,1164) = lu(k,1164) - lu(k,1071) * lu(k,1151) + lu(k,1165) = lu(k,1165) - lu(k,1072) * lu(k,1151) + lu(k,1166) = lu(k,1166) - lu(k,1073) * lu(k,1151) + lu(k,1167) = lu(k,1167) - lu(k,1074) * lu(k,1151) + lu(k,1168) = lu(k,1168) - lu(k,1075) * lu(k,1151) + lu(k,1169) = lu(k,1169) - lu(k,1076) * lu(k,1151) + lu(k,1170) = lu(k,1170) - lu(k,1077) * lu(k,1151) + lu(k,1171) = lu(k,1171) - lu(k,1078) * lu(k,1151) + lu(k,1172) = lu(k,1172) - lu(k,1079) * lu(k,1151) + lu(k,1173) = lu(k,1173) - lu(k,1080) * lu(k,1151) + lu(k,1174) = lu(k,1174) - lu(k,1081) * lu(k,1151) + lu(k,1195) = lu(k,1195) - lu(k,1059) * lu(k,1194) + lu(k,1196) = lu(k,1196) - lu(k,1060) * lu(k,1194) + lu(k,1197) = lu(k,1197) - lu(k,1061) * lu(k,1194) + lu(k,1198) = lu(k,1198) - lu(k,1062) * lu(k,1194) + lu(k,1199) = lu(k,1199) - lu(k,1063) * lu(k,1194) + lu(k,1200) = lu(k,1200) - lu(k,1064) * lu(k,1194) + lu(k,1201) = lu(k,1201) - lu(k,1065) * lu(k,1194) + lu(k,1202) = lu(k,1202) - lu(k,1066) * lu(k,1194) + lu(k,1203) = lu(k,1203) - lu(k,1067) * lu(k,1194) + lu(k,1204) = lu(k,1204) - lu(k,1068) * lu(k,1194) + lu(k,1205) = lu(k,1205) - lu(k,1069) * lu(k,1194) + lu(k,1206) = lu(k,1206) - lu(k,1070) * lu(k,1194) + lu(k,1207) = lu(k,1207) - lu(k,1071) * lu(k,1194) + lu(k,1208) = lu(k,1208) - lu(k,1072) * lu(k,1194) + lu(k,1209) = lu(k,1209) - lu(k,1073) * lu(k,1194) + lu(k,1210) = lu(k,1210) - lu(k,1074) * lu(k,1194) + lu(k,1211) = lu(k,1211) - lu(k,1075) * lu(k,1194) + lu(k,1212) = lu(k,1212) - lu(k,1076) * lu(k,1194) + lu(k,1213) = lu(k,1213) - lu(k,1077) * lu(k,1194) + lu(k,1214) = lu(k,1214) - lu(k,1078) * lu(k,1194) + lu(k,1215) = lu(k,1215) - lu(k,1079) * lu(k,1194) + lu(k,1216) = lu(k,1216) - lu(k,1080) * lu(k,1194) + lu(k,1217) = lu(k,1217) - lu(k,1081) * lu(k,1194) + lu(k,1238) = lu(k,1238) - lu(k,1059) * lu(k,1237) + lu(k,1239) = lu(k,1239) - lu(k,1060) * lu(k,1237) + lu(k,1240) = lu(k,1240) - lu(k,1061) * lu(k,1237) + lu(k,1241) = lu(k,1241) - lu(k,1062) * lu(k,1237) + lu(k,1242) = lu(k,1242) - lu(k,1063) * lu(k,1237) + lu(k,1243) = lu(k,1243) - lu(k,1064) * lu(k,1237) + lu(k,1244) = lu(k,1244) - lu(k,1065) * lu(k,1237) + lu(k,1245) = lu(k,1245) - lu(k,1066) * lu(k,1237) + lu(k,1246) = lu(k,1246) - lu(k,1067) * lu(k,1237) + lu(k,1247) = lu(k,1247) - lu(k,1068) * lu(k,1237) + lu(k,1248) = lu(k,1248) - lu(k,1069) * lu(k,1237) + lu(k,1249) = lu(k,1249) - lu(k,1070) * lu(k,1237) + lu(k,1250) = lu(k,1250) - lu(k,1071) * lu(k,1237) + lu(k,1251) = lu(k,1251) - lu(k,1072) * lu(k,1237) + lu(k,1252) = lu(k,1252) - lu(k,1073) * lu(k,1237) + lu(k,1253) = lu(k,1253) - lu(k,1074) * lu(k,1237) + lu(k,1254) = lu(k,1254) - lu(k,1075) * lu(k,1237) + lu(k,1255) = lu(k,1255) - lu(k,1076) * lu(k,1237) + lu(k,1256) = lu(k,1256) - lu(k,1077) * lu(k,1237) + lu(k,1257) = lu(k,1257) - lu(k,1078) * lu(k,1237) + lu(k,1258) = lu(k,1258) - lu(k,1079) * lu(k,1237) + lu(k,1259) = lu(k,1259) - lu(k,1080) * lu(k,1237) + lu(k,1260) = lu(k,1260) - lu(k,1081) * lu(k,1237) + lu(k,1280) = lu(k,1280) - lu(k,1059) * lu(k,1279) + lu(k,1281) = lu(k,1281) - lu(k,1060) * lu(k,1279) + lu(k,1282) = lu(k,1282) - lu(k,1061) * lu(k,1279) + lu(k,1283) = lu(k,1283) - lu(k,1062) * lu(k,1279) + lu(k,1284) = lu(k,1284) - lu(k,1063) * lu(k,1279) + lu(k,1285) = lu(k,1285) - lu(k,1064) * lu(k,1279) + lu(k,1286) = lu(k,1286) - lu(k,1065) * lu(k,1279) + lu(k,1287) = lu(k,1287) - lu(k,1066) * lu(k,1279) + lu(k,1288) = lu(k,1288) - lu(k,1067) * lu(k,1279) + lu(k,1289) = lu(k,1289) - lu(k,1068) * lu(k,1279) + lu(k,1290) = lu(k,1290) - lu(k,1069) * lu(k,1279) + lu(k,1291) = lu(k,1291) - lu(k,1070) * lu(k,1279) + lu(k,1292) = lu(k,1292) - lu(k,1071) * lu(k,1279) + lu(k,1293) = lu(k,1293) - lu(k,1072) * lu(k,1279) + lu(k,1294) = lu(k,1294) - lu(k,1073) * lu(k,1279) + lu(k,1295) = lu(k,1295) - lu(k,1074) * lu(k,1279) + lu(k,1296) = lu(k,1296) - lu(k,1075) * lu(k,1279) + lu(k,1297) = lu(k,1297) - lu(k,1076) * lu(k,1279) + lu(k,1298) = lu(k,1298) - lu(k,1077) * lu(k,1279) + lu(k,1299) = lu(k,1299) - lu(k,1078) * lu(k,1279) + lu(k,1300) = lu(k,1300) - lu(k,1079) * lu(k,1279) + lu(k,1301) = lu(k,1301) - lu(k,1080) * lu(k,1279) + lu(k,1302) = lu(k,1302) - lu(k,1081) * lu(k,1279) + lu(k,1322) = lu(k,1322) - lu(k,1059) * lu(k,1321) + lu(k,1323) = lu(k,1323) - lu(k,1060) * lu(k,1321) + lu(k,1324) = lu(k,1324) - lu(k,1061) * lu(k,1321) + lu(k,1325) = lu(k,1325) - lu(k,1062) * lu(k,1321) + lu(k,1326) = lu(k,1326) - lu(k,1063) * lu(k,1321) + lu(k,1327) = lu(k,1327) - lu(k,1064) * lu(k,1321) + lu(k,1328) = lu(k,1328) - lu(k,1065) * lu(k,1321) + lu(k,1329) = lu(k,1329) - lu(k,1066) * lu(k,1321) + lu(k,1330) = lu(k,1330) - lu(k,1067) * lu(k,1321) + lu(k,1331) = lu(k,1331) - lu(k,1068) * lu(k,1321) + lu(k,1332) = lu(k,1332) - lu(k,1069) * lu(k,1321) + lu(k,1333) = lu(k,1333) - lu(k,1070) * lu(k,1321) + lu(k,1334) = lu(k,1334) - lu(k,1071) * lu(k,1321) + lu(k,1335) = lu(k,1335) - lu(k,1072) * lu(k,1321) + lu(k,1336) = lu(k,1336) - lu(k,1073) * lu(k,1321) + lu(k,1337) = lu(k,1337) - lu(k,1074) * lu(k,1321) + lu(k,1338) = lu(k,1338) - lu(k,1075) * lu(k,1321) + lu(k,1339) = lu(k,1339) - lu(k,1076) * lu(k,1321) + lu(k,1340) = lu(k,1340) - lu(k,1077) * lu(k,1321) + lu(k,1341) = lu(k,1341) - lu(k,1078) * lu(k,1321) + lu(k,1342) = lu(k,1342) - lu(k,1079) * lu(k,1321) + lu(k,1343) = lu(k,1343) - lu(k,1080) * lu(k,1321) + lu(k,1344) = lu(k,1344) - lu(k,1081) * lu(k,1321) + lu(k,1382) = lu(k,1382) - lu(k,1059) * lu(k,1381) + lu(k,1383) = lu(k,1383) - lu(k,1060) * lu(k,1381) + lu(k,1384) = lu(k,1384) - lu(k,1061) * lu(k,1381) + lu(k,1385) = lu(k,1385) - lu(k,1062) * lu(k,1381) + lu(k,1386) = lu(k,1386) - lu(k,1063) * lu(k,1381) + lu(k,1387) = lu(k,1387) - lu(k,1064) * lu(k,1381) + lu(k,1388) = lu(k,1388) - lu(k,1065) * lu(k,1381) + lu(k,1389) = lu(k,1389) - lu(k,1066) * lu(k,1381) + lu(k,1390) = lu(k,1390) - lu(k,1067) * lu(k,1381) + lu(k,1391) = lu(k,1391) - lu(k,1068) * lu(k,1381) + lu(k,1392) = lu(k,1392) - lu(k,1069) * lu(k,1381) + lu(k,1393) = lu(k,1393) - lu(k,1070) * lu(k,1381) + lu(k,1394) = lu(k,1394) - lu(k,1071) * lu(k,1381) + lu(k,1395) = lu(k,1395) - lu(k,1072) * lu(k,1381) + lu(k,1396) = lu(k,1396) - lu(k,1073) * lu(k,1381) + lu(k,1397) = lu(k,1397) - lu(k,1074) * lu(k,1381) + lu(k,1398) = lu(k,1398) - lu(k,1075) * lu(k,1381) + lu(k,1399) = lu(k,1399) - lu(k,1076) * lu(k,1381) + lu(k,1400) = lu(k,1400) - lu(k,1077) * lu(k,1381) + lu(k,1401) = lu(k,1401) - lu(k,1078) * lu(k,1381) + lu(k,1402) = lu(k,1402) - lu(k,1079) * lu(k,1381) + lu(k,1403) = lu(k,1403) - lu(k,1080) * lu(k,1381) + lu(k,1404) = lu(k,1404) - lu(k,1081) * lu(k,1381) + lu(k,1431) = lu(k,1431) - lu(k,1059) * lu(k,1430) + lu(k,1432) = lu(k,1432) - lu(k,1060) * lu(k,1430) + lu(k,1433) = lu(k,1433) - lu(k,1061) * lu(k,1430) + lu(k,1434) = lu(k,1434) - lu(k,1062) * lu(k,1430) + lu(k,1435) = lu(k,1435) - lu(k,1063) * lu(k,1430) + lu(k,1436) = lu(k,1436) - lu(k,1064) * lu(k,1430) + lu(k,1437) = lu(k,1437) - lu(k,1065) * lu(k,1430) + lu(k,1438) = lu(k,1438) - lu(k,1066) * lu(k,1430) + lu(k,1439) = lu(k,1439) - lu(k,1067) * lu(k,1430) + lu(k,1440) = lu(k,1440) - lu(k,1068) * lu(k,1430) + lu(k,1441) = lu(k,1441) - lu(k,1069) * lu(k,1430) + lu(k,1442) = lu(k,1442) - lu(k,1070) * lu(k,1430) + lu(k,1443) = lu(k,1443) - lu(k,1071) * lu(k,1430) + lu(k,1444) = lu(k,1444) - lu(k,1072) * lu(k,1430) + lu(k,1445) = lu(k,1445) - lu(k,1073) * lu(k,1430) + lu(k,1446) = lu(k,1446) - lu(k,1074) * lu(k,1430) + lu(k,1447) = lu(k,1447) - lu(k,1075) * lu(k,1430) + lu(k,1448) = lu(k,1448) - lu(k,1076) * lu(k,1430) + lu(k,1449) = lu(k,1449) - lu(k,1077) * lu(k,1430) + lu(k,1450) = lu(k,1450) - lu(k,1078) * lu(k,1430) + lu(k,1451) = lu(k,1451) - lu(k,1079) * lu(k,1430) + lu(k,1452) = lu(k,1452) - lu(k,1080) * lu(k,1430) + lu(k,1453) = lu(k,1453) - lu(k,1081) * lu(k,1430) + lu(k,1479) = lu(k,1479) - lu(k,1059) * lu(k,1478) + lu(k,1480) = lu(k,1480) - lu(k,1060) * lu(k,1478) + lu(k,1481) = lu(k,1481) - lu(k,1061) * lu(k,1478) + lu(k,1482) = lu(k,1482) - lu(k,1062) * lu(k,1478) + lu(k,1483) = lu(k,1483) - lu(k,1063) * lu(k,1478) + lu(k,1484) = lu(k,1484) - lu(k,1064) * lu(k,1478) + lu(k,1485) = lu(k,1485) - lu(k,1065) * lu(k,1478) + lu(k,1486) = lu(k,1486) - lu(k,1066) * lu(k,1478) + lu(k,1487) = lu(k,1487) - lu(k,1067) * lu(k,1478) + lu(k,1488) = lu(k,1488) - lu(k,1068) * lu(k,1478) + lu(k,1489) = lu(k,1489) - lu(k,1069) * lu(k,1478) + lu(k,1490) = lu(k,1490) - lu(k,1070) * lu(k,1478) + lu(k,1491) = lu(k,1491) - lu(k,1071) * lu(k,1478) + lu(k,1492) = lu(k,1492) - lu(k,1072) * lu(k,1478) + lu(k,1493) = lu(k,1493) - lu(k,1073) * lu(k,1478) + lu(k,1494) = lu(k,1494) - lu(k,1074) * lu(k,1478) + lu(k,1495) = lu(k,1495) - lu(k,1075) * lu(k,1478) + lu(k,1496) = lu(k,1496) - lu(k,1076) * lu(k,1478) + lu(k,1497) = lu(k,1497) - lu(k,1077) * lu(k,1478) + lu(k,1498) = lu(k,1498) - lu(k,1078) * lu(k,1478) + lu(k,1499) = lu(k,1499) - lu(k,1079) * lu(k,1478) + lu(k,1500) = lu(k,1500) - lu(k,1080) * lu(k,1478) + lu(k,1501) = lu(k,1501) - lu(k,1081) * lu(k,1478) + lu(k,1520) = lu(k,1520) - lu(k,1059) * lu(k,1519) + lu(k,1521) = lu(k,1521) - lu(k,1060) * lu(k,1519) + lu(k,1522) = lu(k,1522) - lu(k,1061) * lu(k,1519) + lu(k,1523) = lu(k,1523) - lu(k,1062) * lu(k,1519) + lu(k,1524) = lu(k,1524) - lu(k,1063) * lu(k,1519) + lu(k,1525) = lu(k,1525) - lu(k,1064) * lu(k,1519) + lu(k,1526) = lu(k,1526) - lu(k,1065) * lu(k,1519) + lu(k,1527) = lu(k,1527) - lu(k,1066) * lu(k,1519) + lu(k,1528) = lu(k,1528) - lu(k,1067) * lu(k,1519) + lu(k,1529) = lu(k,1529) - lu(k,1068) * lu(k,1519) + lu(k,1530) = lu(k,1530) - lu(k,1069) * lu(k,1519) + lu(k,1531) = lu(k,1531) - lu(k,1070) * lu(k,1519) + lu(k,1532) = lu(k,1532) - lu(k,1071) * lu(k,1519) + lu(k,1533) = lu(k,1533) - lu(k,1072) * lu(k,1519) + lu(k,1534) = lu(k,1534) - lu(k,1073) * lu(k,1519) + lu(k,1535) = lu(k,1535) - lu(k,1074) * lu(k,1519) + lu(k,1536) = lu(k,1536) - lu(k,1075) * lu(k,1519) + lu(k,1537) = lu(k,1537) - lu(k,1076) * lu(k,1519) + lu(k,1538) = lu(k,1538) - lu(k,1077) * lu(k,1519) + lu(k,1539) = lu(k,1539) - lu(k,1078) * lu(k,1519) + lu(k,1540) = lu(k,1540) - lu(k,1079) * lu(k,1519) + lu(k,1541) = lu(k,1541) - lu(k,1080) * lu(k,1519) + lu(k,1542) = lu(k,1542) - lu(k,1081) * lu(k,1519) + lu(k,1556) = lu(k,1556) - lu(k,1059) * lu(k,1555) + lu(k,1557) = lu(k,1557) - lu(k,1060) * lu(k,1555) + lu(k,1558) = lu(k,1558) - lu(k,1061) * lu(k,1555) + lu(k,1559) = lu(k,1559) - lu(k,1062) * lu(k,1555) + lu(k,1560) = lu(k,1560) - lu(k,1063) * lu(k,1555) + lu(k,1561) = lu(k,1561) - lu(k,1064) * lu(k,1555) + lu(k,1562) = lu(k,1562) - lu(k,1065) * lu(k,1555) + lu(k,1563) = lu(k,1563) - lu(k,1066) * lu(k,1555) + lu(k,1564) = lu(k,1564) - lu(k,1067) * lu(k,1555) + lu(k,1565) = lu(k,1565) - lu(k,1068) * lu(k,1555) + lu(k,1566) = lu(k,1566) - lu(k,1069) * lu(k,1555) + lu(k,1567) = lu(k,1567) - lu(k,1070) * lu(k,1555) + lu(k,1568) = lu(k,1568) - lu(k,1071) * lu(k,1555) + lu(k,1569) = lu(k,1569) - lu(k,1072) * lu(k,1555) + lu(k,1570) = lu(k,1570) - lu(k,1073) * lu(k,1555) + lu(k,1571) = lu(k,1571) - lu(k,1074) * lu(k,1555) + lu(k,1572) = lu(k,1572) - lu(k,1075) * lu(k,1555) + lu(k,1573) = lu(k,1573) - lu(k,1076) * lu(k,1555) + lu(k,1574) = lu(k,1574) - lu(k,1077) * lu(k,1555) + lu(k,1575) = lu(k,1575) - lu(k,1078) * lu(k,1555) + lu(k,1576) = lu(k,1576) - lu(k,1079) * lu(k,1555) + lu(k,1577) = lu(k,1577) - lu(k,1080) * lu(k,1555) + lu(k,1578) = lu(k,1578) - lu(k,1081) * lu(k,1555) + lu(k,1601) = lu(k,1601) - lu(k,1059) * lu(k,1600) + lu(k,1602) = lu(k,1602) - lu(k,1060) * lu(k,1600) + lu(k,1603) = lu(k,1603) - lu(k,1061) * lu(k,1600) + lu(k,1604) = lu(k,1604) - lu(k,1062) * lu(k,1600) + lu(k,1605) = lu(k,1605) - lu(k,1063) * lu(k,1600) + lu(k,1606) = lu(k,1606) - lu(k,1064) * lu(k,1600) + lu(k,1607) = lu(k,1607) - lu(k,1065) * lu(k,1600) + lu(k,1608) = lu(k,1608) - lu(k,1066) * lu(k,1600) + lu(k,1609) = lu(k,1609) - lu(k,1067) * lu(k,1600) + lu(k,1610) = lu(k,1610) - lu(k,1068) * lu(k,1600) + lu(k,1611) = lu(k,1611) - lu(k,1069) * lu(k,1600) + lu(k,1612) = lu(k,1612) - lu(k,1070) * lu(k,1600) + lu(k,1613) = lu(k,1613) - lu(k,1071) * lu(k,1600) + lu(k,1614) = lu(k,1614) - lu(k,1072) * lu(k,1600) + lu(k,1615) = lu(k,1615) - lu(k,1073) * lu(k,1600) + lu(k,1616) = lu(k,1616) - lu(k,1074) * lu(k,1600) + lu(k,1617) = lu(k,1617) - lu(k,1075) * lu(k,1600) + lu(k,1618) = lu(k,1618) - lu(k,1076) * lu(k,1600) + lu(k,1619) = lu(k,1619) - lu(k,1077) * lu(k,1600) + lu(k,1620) = lu(k,1620) - lu(k,1078) * lu(k,1600) + lu(k,1621) = lu(k,1621) - lu(k,1079) * lu(k,1600) + lu(k,1622) = lu(k,1622) - lu(k,1080) * lu(k,1600) + lu(k,1623) = lu(k,1623) - lu(k,1081) * lu(k,1600) + lu(k,1644) = lu(k,1644) - lu(k,1059) * lu(k,1643) + lu(k,1645) = lu(k,1645) - lu(k,1060) * lu(k,1643) + lu(k,1646) = lu(k,1646) - lu(k,1061) * lu(k,1643) + lu(k,1647) = lu(k,1647) - lu(k,1062) * lu(k,1643) + lu(k,1648) = lu(k,1648) - lu(k,1063) * lu(k,1643) + lu(k,1649) = lu(k,1649) - lu(k,1064) * lu(k,1643) + lu(k,1650) = lu(k,1650) - lu(k,1065) * lu(k,1643) + lu(k,1651) = lu(k,1651) - lu(k,1066) * lu(k,1643) + lu(k,1652) = lu(k,1652) - lu(k,1067) * lu(k,1643) + lu(k,1653) = lu(k,1653) - lu(k,1068) * lu(k,1643) + lu(k,1654) = lu(k,1654) - lu(k,1069) * lu(k,1643) + lu(k,1655) = lu(k,1655) - lu(k,1070) * lu(k,1643) + lu(k,1656) = lu(k,1656) - lu(k,1071) * lu(k,1643) + lu(k,1657) = lu(k,1657) - lu(k,1072) * lu(k,1643) + lu(k,1658) = lu(k,1658) - lu(k,1073) * lu(k,1643) + lu(k,1659) = lu(k,1659) - lu(k,1074) * lu(k,1643) + lu(k,1660) = lu(k,1660) - lu(k,1075) * lu(k,1643) + lu(k,1661) = lu(k,1661) - lu(k,1076) * lu(k,1643) + lu(k,1662) = lu(k,1662) - lu(k,1077) * lu(k,1643) + lu(k,1663) = lu(k,1663) - lu(k,1078) * lu(k,1643) + lu(k,1664) = lu(k,1664) - lu(k,1079) * lu(k,1643) + lu(k,1665) = lu(k,1665) - lu(k,1080) * lu(k,1643) + lu(k,1666) = lu(k,1666) - lu(k,1081) * lu(k,1643) + lu(k,1687) = lu(k,1687) - lu(k,1059) * lu(k,1686) + lu(k,1688) = lu(k,1688) - lu(k,1060) * lu(k,1686) + lu(k,1689) = lu(k,1689) - lu(k,1061) * lu(k,1686) + lu(k,1690) = lu(k,1690) - lu(k,1062) * lu(k,1686) + lu(k,1691) = lu(k,1691) - lu(k,1063) * lu(k,1686) + lu(k,1692) = lu(k,1692) - lu(k,1064) * lu(k,1686) + lu(k,1693) = lu(k,1693) - lu(k,1065) * lu(k,1686) + lu(k,1694) = lu(k,1694) - lu(k,1066) * lu(k,1686) + lu(k,1695) = lu(k,1695) - lu(k,1067) * lu(k,1686) + lu(k,1696) = lu(k,1696) - lu(k,1068) * lu(k,1686) + lu(k,1697) = lu(k,1697) - lu(k,1069) * lu(k,1686) + lu(k,1698) = lu(k,1698) - lu(k,1070) * lu(k,1686) + lu(k,1699) = lu(k,1699) - lu(k,1071) * lu(k,1686) + lu(k,1700) = lu(k,1700) - lu(k,1072) * lu(k,1686) + lu(k,1701) = lu(k,1701) - lu(k,1073) * lu(k,1686) + lu(k,1702) = lu(k,1702) - lu(k,1074) * lu(k,1686) + lu(k,1703) = lu(k,1703) - lu(k,1075) * lu(k,1686) + lu(k,1704) = lu(k,1704) - lu(k,1076) * lu(k,1686) + lu(k,1705) = lu(k,1705) - lu(k,1077) * lu(k,1686) + lu(k,1706) = lu(k,1706) - lu(k,1078) * lu(k,1686) + lu(k,1707) = lu(k,1707) - lu(k,1079) * lu(k,1686) + lu(k,1708) = lu(k,1708) - lu(k,1080) * lu(k,1686) + lu(k,1709) = lu(k,1709) - lu(k,1081) * lu(k,1686) + lu(k,1727) = lu(k,1727) - lu(k,1059) * lu(k,1726) + lu(k,1728) = lu(k,1728) - lu(k,1060) * lu(k,1726) + lu(k,1729) = lu(k,1729) - lu(k,1061) * lu(k,1726) + lu(k,1730) = lu(k,1730) - lu(k,1062) * lu(k,1726) + lu(k,1731) = lu(k,1731) - lu(k,1063) * lu(k,1726) + lu(k,1732) = lu(k,1732) - lu(k,1064) * lu(k,1726) + lu(k,1733) = lu(k,1733) - lu(k,1065) * lu(k,1726) + lu(k,1734) = lu(k,1734) - lu(k,1066) * lu(k,1726) + lu(k,1735) = lu(k,1735) - lu(k,1067) * lu(k,1726) + lu(k,1736) = lu(k,1736) - lu(k,1068) * lu(k,1726) + lu(k,1737) = lu(k,1737) - lu(k,1069) * lu(k,1726) + lu(k,1738) = lu(k,1738) - lu(k,1070) * lu(k,1726) + lu(k,1739) = lu(k,1739) - lu(k,1071) * lu(k,1726) + lu(k,1740) = lu(k,1740) - lu(k,1072) * lu(k,1726) + lu(k,1741) = lu(k,1741) - lu(k,1073) * lu(k,1726) + lu(k,1742) = lu(k,1742) - lu(k,1074) * lu(k,1726) + lu(k,1743) = lu(k,1743) - lu(k,1075) * lu(k,1726) + lu(k,1744) = lu(k,1744) - lu(k,1076) * lu(k,1726) + lu(k,1745) = lu(k,1745) - lu(k,1077) * lu(k,1726) + lu(k,1746) = lu(k,1746) - lu(k,1078) * lu(k,1726) + lu(k,1747) = lu(k,1747) - lu(k,1079) * lu(k,1726) + lu(k,1748) = lu(k,1748) - lu(k,1080) * lu(k,1726) + lu(k,1749) = lu(k,1749) - lu(k,1081) * lu(k,1726) + lu(k,1763) = lu(k,1763) - lu(k,1059) * lu(k,1762) + lu(k,1764) = lu(k,1764) - lu(k,1060) * lu(k,1762) + lu(k,1765) = lu(k,1765) - lu(k,1061) * lu(k,1762) + lu(k,1766) = lu(k,1766) - lu(k,1062) * lu(k,1762) + lu(k,1767) = lu(k,1767) - lu(k,1063) * lu(k,1762) + lu(k,1768) = lu(k,1768) - lu(k,1064) * lu(k,1762) + lu(k,1769) = lu(k,1769) - lu(k,1065) * lu(k,1762) + lu(k,1770) = lu(k,1770) - lu(k,1066) * lu(k,1762) + lu(k,1771) = lu(k,1771) - lu(k,1067) * lu(k,1762) + lu(k,1772) = lu(k,1772) - lu(k,1068) * lu(k,1762) + lu(k,1773) = lu(k,1773) - lu(k,1069) * lu(k,1762) + lu(k,1774) = lu(k,1774) - lu(k,1070) * lu(k,1762) + lu(k,1775) = lu(k,1775) - lu(k,1071) * lu(k,1762) + lu(k,1776) = lu(k,1776) - lu(k,1072) * lu(k,1762) + lu(k,1777) = lu(k,1777) - lu(k,1073) * lu(k,1762) + lu(k,1778) = lu(k,1778) - lu(k,1074) * lu(k,1762) + lu(k,1779) = lu(k,1779) - lu(k,1075) * lu(k,1762) + lu(k,1780) = lu(k,1780) - lu(k,1076) * lu(k,1762) + lu(k,1781) = lu(k,1781) - lu(k,1077) * lu(k,1762) + lu(k,1782) = lu(k,1782) - lu(k,1078) * lu(k,1762) + lu(k,1783) = lu(k,1783) - lu(k,1079) * lu(k,1762) + lu(k,1784) = lu(k,1784) - lu(k,1080) * lu(k,1762) + lu(k,1785) = lu(k,1785) - lu(k,1081) * lu(k,1762) + lu(k,1811) = lu(k,1811) - lu(k,1059) * lu(k,1810) + lu(k,1812) = lu(k,1812) - lu(k,1060) * lu(k,1810) + lu(k,1813) = lu(k,1813) - lu(k,1061) * lu(k,1810) + lu(k,1814) = lu(k,1814) - lu(k,1062) * lu(k,1810) + lu(k,1815) = lu(k,1815) - lu(k,1063) * lu(k,1810) + lu(k,1816) = lu(k,1816) - lu(k,1064) * lu(k,1810) + lu(k,1817) = lu(k,1817) - lu(k,1065) * lu(k,1810) + lu(k,1818) = lu(k,1818) - lu(k,1066) * lu(k,1810) + lu(k,1819) = lu(k,1819) - lu(k,1067) * lu(k,1810) + lu(k,1820) = lu(k,1820) - lu(k,1068) * lu(k,1810) + lu(k,1821) = lu(k,1821) - lu(k,1069) * lu(k,1810) + lu(k,1822) = lu(k,1822) - lu(k,1070) * lu(k,1810) + lu(k,1823) = lu(k,1823) - lu(k,1071) * lu(k,1810) + lu(k,1824) = lu(k,1824) - lu(k,1072) * lu(k,1810) + lu(k,1825) = lu(k,1825) - lu(k,1073) * lu(k,1810) + lu(k,1826) = lu(k,1826) - lu(k,1074) * lu(k,1810) + lu(k,1827) = lu(k,1827) - lu(k,1075) * lu(k,1810) + lu(k,1828) = lu(k,1828) - lu(k,1076) * lu(k,1810) + lu(k,1829) = lu(k,1829) - lu(k,1077) * lu(k,1810) + lu(k,1830) = lu(k,1830) - lu(k,1078) * lu(k,1810) + lu(k,1831) = lu(k,1831) - lu(k,1079) * lu(k,1810) + lu(k,1832) = lu(k,1832) - lu(k,1080) * lu(k,1810) + lu(k,1833) = lu(k,1833) - lu(k,1081) * lu(k,1810) + lu(k,1844) = lu(k,1844) - lu(k,1059) * lu(k,1843) + lu(k,1845) = lu(k,1845) - lu(k,1060) * lu(k,1843) + lu(k,1846) = lu(k,1846) - lu(k,1061) * lu(k,1843) + lu(k,1847) = lu(k,1847) - lu(k,1062) * lu(k,1843) + lu(k,1848) = lu(k,1848) - lu(k,1063) * lu(k,1843) + lu(k,1849) = lu(k,1849) - lu(k,1064) * lu(k,1843) + lu(k,1850) = lu(k,1850) - lu(k,1065) * lu(k,1843) + lu(k,1851) = lu(k,1851) - lu(k,1066) * lu(k,1843) + lu(k,1852) = lu(k,1852) - lu(k,1067) * lu(k,1843) + lu(k,1853) = lu(k,1853) - lu(k,1068) * lu(k,1843) + lu(k,1854) = lu(k,1854) - lu(k,1069) * lu(k,1843) + lu(k,1855) = lu(k,1855) - lu(k,1070) * lu(k,1843) + lu(k,1856) = lu(k,1856) - lu(k,1071) * lu(k,1843) + lu(k,1857) = lu(k,1857) - lu(k,1072) * lu(k,1843) + lu(k,1858) = lu(k,1858) - lu(k,1073) * lu(k,1843) + lu(k,1859) = lu(k,1859) - lu(k,1074) * lu(k,1843) + lu(k,1860) = lu(k,1860) - lu(k,1075) * lu(k,1843) + lu(k,1861) = lu(k,1861) - lu(k,1076) * lu(k,1843) + lu(k,1862) = lu(k,1862) - lu(k,1077) * lu(k,1843) + lu(k,1863) = lu(k,1863) - lu(k,1078) * lu(k,1843) + lu(k,1864) = lu(k,1864) - lu(k,1079) * lu(k,1843) + lu(k,1865) = lu(k,1865) - lu(k,1080) * lu(k,1843) + lu(k,1866) = lu(k,1866) - lu(k,1081) * lu(k,1843) + lu(k,1880) = lu(k,1880) - lu(k,1059) * lu(k,1879) + lu(k,1881) = lu(k,1881) - lu(k,1060) * lu(k,1879) + lu(k,1882) = lu(k,1882) - lu(k,1061) * lu(k,1879) + lu(k,1883) = lu(k,1883) - lu(k,1062) * lu(k,1879) + lu(k,1884) = lu(k,1884) - lu(k,1063) * lu(k,1879) + lu(k,1885) = lu(k,1885) - lu(k,1064) * lu(k,1879) + lu(k,1886) = lu(k,1886) - lu(k,1065) * lu(k,1879) + lu(k,1887) = lu(k,1887) - lu(k,1066) * lu(k,1879) + lu(k,1888) = lu(k,1888) - lu(k,1067) * lu(k,1879) + lu(k,1889) = lu(k,1889) - lu(k,1068) * lu(k,1879) + lu(k,1890) = lu(k,1890) - lu(k,1069) * lu(k,1879) + lu(k,1891) = lu(k,1891) - lu(k,1070) * lu(k,1879) + lu(k,1892) = lu(k,1892) - lu(k,1071) * lu(k,1879) + lu(k,1893) = lu(k,1893) - lu(k,1072) * lu(k,1879) + lu(k,1894) = lu(k,1894) - lu(k,1073) * lu(k,1879) + lu(k,1895) = lu(k,1895) - lu(k,1074) * lu(k,1879) + lu(k,1896) = lu(k,1896) - lu(k,1075) * lu(k,1879) + lu(k,1897) = lu(k,1897) - lu(k,1076) * lu(k,1879) + lu(k,1898) = lu(k,1898) - lu(k,1077) * lu(k,1879) + lu(k,1899) = lu(k,1899) - lu(k,1078) * lu(k,1879) + lu(k,1900) = lu(k,1900) - lu(k,1079) * lu(k,1879) + lu(k,1901) = lu(k,1901) - lu(k,1080) * lu(k,1879) + lu(k,1902) = lu(k,1902) - lu(k,1081) * lu(k,1879) + lu(k,1921) = lu(k,1921) - lu(k,1059) * lu(k,1920) + lu(k,1922) = lu(k,1922) - lu(k,1060) * lu(k,1920) + lu(k,1923) = lu(k,1923) - lu(k,1061) * lu(k,1920) + lu(k,1924) = lu(k,1924) - lu(k,1062) * lu(k,1920) + lu(k,1925) = lu(k,1925) - lu(k,1063) * lu(k,1920) + lu(k,1926) = lu(k,1926) - lu(k,1064) * lu(k,1920) + lu(k,1927) = lu(k,1927) - lu(k,1065) * lu(k,1920) + lu(k,1928) = lu(k,1928) - lu(k,1066) * lu(k,1920) + lu(k,1929) = lu(k,1929) - lu(k,1067) * lu(k,1920) + lu(k,1930) = lu(k,1930) - lu(k,1068) * lu(k,1920) + lu(k,1931) = lu(k,1931) - lu(k,1069) * lu(k,1920) + lu(k,1932) = lu(k,1932) - lu(k,1070) * lu(k,1920) + lu(k,1933) = lu(k,1933) - lu(k,1071) * lu(k,1920) + lu(k,1934) = lu(k,1934) - lu(k,1072) * lu(k,1920) + lu(k,1935) = lu(k,1935) - lu(k,1073) * lu(k,1920) + lu(k,1936) = lu(k,1936) - lu(k,1074) * lu(k,1920) + lu(k,1937) = lu(k,1937) - lu(k,1075) * lu(k,1920) + lu(k,1938) = lu(k,1938) - lu(k,1076) * lu(k,1920) + lu(k,1939) = lu(k,1939) - lu(k,1077) * lu(k,1920) + lu(k,1940) = lu(k,1940) - lu(k,1078) * lu(k,1920) + lu(k,1941) = lu(k,1941) - lu(k,1079) * lu(k,1920) + lu(k,1942) = lu(k,1942) - lu(k,1080) * lu(k,1920) + lu(k,1943) = lu(k,1943) - lu(k,1081) * lu(k,1920) + lu(k,1963) = lu(k,1963) - lu(k,1059) * lu(k,1962) + lu(k,1964) = lu(k,1964) - lu(k,1060) * lu(k,1962) + lu(k,1965) = lu(k,1965) - lu(k,1061) * lu(k,1962) + lu(k,1966) = lu(k,1966) - lu(k,1062) * lu(k,1962) + lu(k,1967) = lu(k,1967) - lu(k,1063) * lu(k,1962) + lu(k,1968) = lu(k,1968) - lu(k,1064) * lu(k,1962) + lu(k,1969) = lu(k,1969) - lu(k,1065) * lu(k,1962) + lu(k,1970) = lu(k,1970) - lu(k,1066) * lu(k,1962) + lu(k,1971) = lu(k,1971) - lu(k,1067) * lu(k,1962) + lu(k,1972) = lu(k,1972) - lu(k,1068) * lu(k,1962) + lu(k,1973) = lu(k,1973) - lu(k,1069) * lu(k,1962) + lu(k,1974) = lu(k,1974) - lu(k,1070) * lu(k,1962) + lu(k,1975) = lu(k,1975) - lu(k,1071) * lu(k,1962) + lu(k,1976) = lu(k,1976) - lu(k,1072) * lu(k,1962) + lu(k,1977) = lu(k,1977) - lu(k,1073) * lu(k,1962) + lu(k,1978) = lu(k,1978) - lu(k,1074) * lu(k,1962) + lu(k,1979) = lu(k,1979) - lu(k,1075) * lu(k,1962) + lu(k,1980) = lu(k,1980) - lu(k,1076) * lu(k,1962) + lu(k,1981) = lu(k,1981) - lu(k,1077) * lu(k,1962) + lu(k,1982) = lu(k,1982) - lu(k,1078) * lu(k,1962) + lu(k,1983) = lu(k,1983) - lu(k,1079) * lu(k,1962) + lu(k,1984) = lu(k,1984) - lu(k,1080) * lu(k,1962) + lu(k,1985) = lu(k,1985) - lu(k,1081) * lu(k,1962) + lu(k,2008) = lu(k,2008) - lu(k,1059) * lu(k,2007) + lu(k,2009) = lu(k,2009) - lu(k,1060) * lu(k,2007) + lu(k,2010) = lu(k,2010) - lu(k,1061) * lu(k,2007) + lu(k,2011) = lu(k,2011) - lu(k,1062) * lu(k,2007) + lu(k,2012) = lu(k,2012) - lu(k,1063) * lu(k,2007) + lu(k,2013) = lu(k,2013) - lu(k,1064) * lu(k,2007) + lu(k,2014) = lu(k,2014) - lu(k,1065) * lu(k,2007) + lu(k,2015) = lu(k,2015) - lu(k,1066) * lu(k,2007) + lu(k,2016) = lu(k,2016) - lu(k,1067) * lu(k,2007) + lu(k,2017) = lu(k,2017) - lu(k,1068) * lu(k,2007) + lu(k,2018) = lu(k,2018) - lu(k,1069) * lu(k,2007) + lu(k,2019) = lu(k,2019) - lu(k,1070) * lu(k,2007) + lu(k,2020) = lu(k,2020) - lu(k,1071) * lu(k,2007) + lu(k,2021) = lu(k,2021) - lu(k,1072) * lu(k,2007) + lu(k,2022) = lu(k,2022) - lu(k,1073) * lu(k,2007) + lu(k,2023) = lu(k,2023) - lu(k,1074) * lu(k,2007) + lu(k,2024) = lu(k,2024) - lu(k,1075) * lu(k,2007) + lu(k,2025) = lu(k,2025) - lu(k,1076) * lu(k,2007) + lu(k,2026) = lu(k,2026) - lu(k,1077) * lu(k,2007) + lu(k,2027) = lu(k,2027) - lu(k,1078) * lu(k,2007) + lu(k,2028) = lu(k,2028) - lu(k,1079) * lu(k,2007) + lu(k,2029) = lu(k,2029) - lu(k,1080) * lu(k,2007) + lu(k,2030) = lu(k,2030) - lu(k,1081) * lu(k,2007) + lu(k,2068) = lu(k,2068) - lu(k,1059) * lu(k,2067) + lu(k,2069) = lu(k,2069) - lu(k,1060) * lu(k,2067) + lu(k,2070) = lu(k,2070) - lu(k,1061) * lu(k,2067) + lu(k,2071) = lu(k,2071) - lu(k,1062) * lu(k,2067) + lu(k,2072) = lu(k,2072) - lu(k,1063) * lu(k,2067) + lu(k,2073) = lu(k,2073) - lu(k,1064) * lu(k,2067) + lu(k,2074) = lu(k,2074) - lu(k,1065) * lu(k,2067) + lu(k,2075) = lu(k,2075) - lu(k,1066) * lu(k,2067) + lu(k,2076) = lu(k,2076) - lu(k,1067) * lu(k,2067) + lu(k,2077) = lu(k,2077) - lu(k,1068) * lu(k,2067) + lu(k,2078) = lu(k,2078) - lu(k,1069) * lu(k,2067) + lu(k,2079) = lu(k,2079) - lu(k,1070) * lu(k,2067) + lu(k,2080) = lu(k,2080) - lu(k,1071) * lu(k,2067) + lu(k,2081) = lu(k,2081) - lu(k,1072) * lu(k,2067) + lu(k,2082) = lu(k,2082) - lu(k,1073) * lu(k,2067) + lu(k,2083) = lu(k,2083) - lu(k,1074) * lu(k,2067) + lu(k,2084) = lu(k,2084) - lu(k,1075) * lu(k,2067) + lu(k,2085) = lu(k,2085) - lu(k,1076) * lu(k,2067) + lu(k,2086) = lu(k,2086) - lu(k,1077) * lu(k,2067) + lu(k,2087) = lu(k,2087) - lu(k,1078) * lu(k,2067) + lu(k,2088) = lu(k,2088) - lu(k,1079) * lu(k,2067) + lu(k,2089) = lu(k,2089) - lu(k,1080) * lu(k,2067) + lu(k,2090) = lu(k,2090) - lu(k,1081) * lu(k,2067) + end do + end subroutine lu_fac21 + subroutine lu_fac22( 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,1104) = 1._r8 / lu(k,1104) + lu(k,1105) = lu(k,1105) * lu(k,1104) + lu(k,1106) = lu(k,1106) * lu(k,1104) + lu(k,1107) = lu(k,1107) * lu(k,1104) + lu(k,1108) = lu(k,1108) * lu(k,1104) + lu(k,1109) = lu(k,1109) * lu(k,1104) + lu(k,1110) = lu(k,1110) * lu(k,1104) + lu(k,1111) = lu(k,1111) * lu(k,1104) + lu(k,1112) = lu(k,1112) * lu(k,1104) + lu(k,1113) = lu(k,1113) * lu(k,1104) + lu(k,1114) = lu(k,1114) * lu(k,1104) + lu(k,1115) = lu(k,1115) * lu(k,1104) + lu(k,1116) = lu(k,1116) * lu(k,1104) + lu(k,1117) = lu(k,1117) * lu(k,1104) + lu(k,1118) = lu(k,1118) * lu(k,1104) + lu(k,1119) = lu(k,1119) * lu(k,1104) + lu(k,1120) = lu(k,1120) * lu(k,1104) + lu(k,1121) = lu(k,1121) * lu(k,1104) + lu(k,1122) = lu(k,1122) * lu(k,1104) + lu(k,1123) = lu(k,1123) * lu(k,1104) + lu(k,1124) = lu(k,1124) * lu(k,1104) + lu(k,1125) = lu(k,1125) * lu(k,1104) + lu(k,1126) = lu(k,1126) * lu(k,1104) + lu(k,1153) = lu(k,1153) - lu(k,1105) * lu(k,1152) + lu(k,1154) = lu(k,1154) - lu(k,1106) * lu(k,1152) + lu(k,1155) = lu(k,1155) - lu(k,1107) * lu(k,1152) + lu(k,1156) = lu(k,1156) - lu(k,1108) * lu(k,1152) + lu(k,1157) = lu(k,1157) - lu(k,1109) * lu(k,1152) + lu(k,1158) = lu(k,1158) - lu(k,1110) * lu(k,1152) + lu(k,1159) = lu(k,1159) - lu(k,1111) * lu(k,1152) + lu(k,1160) = lu(k,1160) - lu(k,1112) * lu(k,1152) + lu(k,1161) = lu(k,1161) - lu(k,1113) * lu(k,1152) + lu(k,1162) = lu(k,1162) - lu(k,1114) * lu(k,1152) + lu(k,1163) = lu(k,1163) - lu(k,1115) * lu(k,1152) + lu(k,1164) = lu(k,1164) - lu(k,1116) * lu(k,1152) + lu(k,1165) = lu(k,1165) - lu(k,1117) * lu(k,1152) + lu(k,1166) = lu(k,1166) - lu(k,1118) * lu(k,1152) + lu(k,1167) = lu(k,1167) - lu(k,1119) * lu(k,1152) + lu(k,1168) = lu(k,1168) - lu(k,1120) * lu(k,1152) + lu(k,1169) = lu(k,1169) - lu(k,1121) * lu(k,1152) + lu(k,1170) = lu(k,1170) - lu(k,1122) * lu(k,1152) + lu(k,1171) = lu(k,1171) - lu(k,1123) * lu(k,1152) + lu(k,1172) = lu(k,1172) - lu(k,1124) * lu(k,1152) + lu(k,1173) = lu(k,1173) - lu(k,1125) * lu(k,1152) + lu(k,1174) = lu(k,1174) - lu(k,1126) * lu(k,1152) + lu(k,1196) = lu(k,1196) - lu(k,1105) * lu(k,1195) + lu(k,1197) = lu(k,1197) - lu(k,1106) * lu(k,1195) + lu(k,1198) = lu(k,1198) - lu(k,1107) * lu(k,1195) + lu(k,1199) = lu(k,1199) - lu(k,1108) * lu(k,1195) + lu(k,1200) = lu(k,1200) - lu(k,1109) * lu(k,1195) + lu(k,1201) = lu(k,1201) - lu(k,1110) * lu(k,1195) + lu(k,1202) = lu(k,1202) - lu(k,1111) * lu(k,1195) + lu(k,1203) = lu(k,1203) - lu(k,1112) * lu(k,1195) + lu(k,1204) = lu(k,1204) - lu(k,1113) * lu(k,1195) + lu(k,1205) = lu(k,1205) - lu(k,1114) * lu(k,1195) + lu(k,1206) = lu(k,1206) - lu(k,1115) * lu(k,1195) + lu(k,1207) = lu(k,1207) - lu(k,1116) * lu(k,1195) + lu(k,1208) = lu(k,1208) - lu(k,1117) * lu(k,1195) + lu(k,1209) = lu(k,1209) - lu(k,1118) * lu(k,1195) + lu(k,1210) = lu(k,1210) - lu(k,1119) * lu(k,1195) + lu(k,1211) = lu(k,1211) - lu(k,1120) * lu(k,1195) + lu(k,1212) = lu(k,1212) - lu(k,1121) * lu(k,1195) + lu(k,1213) = lu(k,1213) - lu(k,1122) * lu(k,1195) + lu(k,1214) = lu(k,1214) - lu(k,1123) * lu(k,1195) + lu(k,1215) = lu(k,1215) - lu(k,1124) * lu(k,1195) + lu(k,1216) = lu(k,1216) - lu(k,1125) * lu(k,1195) + lu(k,1217) = lu(k,1217) - lu(k,1126) * lu(k,1195) + lu(k,1239) = lu(k,1239) - lu(k,1105) * lu(k,1238) + lu(k,1240) = lu(k,1240) - lu(k,1106) * lu(k,1238) + lu(k,1241) = lu(k,1241) - lu(k,1107) * lu(k,1238) + lu(k,1242) = lu(k,1242) - lu(k,1108) * lu(k,1238) + lu(k,1243) = lu(k,1243) - lu(k,1109) * lu(k,1238) + lu(k,1244) = lu(k,1244) - lu(k,1110) * lu(k,1238) + lu(k,1245) = lu(k,1245) - lu(k,1111) * lu(k,1238) + lu(k,1246) = lu(k,1246) - lu(k,1112) * lu(k,1238) + lu(k,1247) = lu(k,1247) - lu(k,1113) * lu(k,1238) + lu(k,1248) = lu(k,1248) - lu(k,1114) * lu(k,1238) + lu(k,1249) = lu(k,1249) - lu(k,1115) * lu(k,1238) + lu(k,1250) = lu(k,1250) - lu(k,1116) * lu(k,1238) + lu(k,1251) = lu(k,1251) - lu(k,1117) * lu(k,1238) + lu(k,1252) = lu(k,1252) - lu(k,1118) * lu(k,1238) + lu(k,1253) = lu(k,1253) - lu(k,1119) * lu(k,1238) + lu(k,1254) = lu(k,1254) - lu(k,1120) * lu(k,1238) + lu(k,1255) = lu(k,1255) - lu(k,1121) * lu(k,1238) + lu(k,1256) = lu(k,1256) - lu(k,1122) * lu(k,1238) + lu(k,1257) = lu(k,1257) - lu(k,1123) * lu(k,1238) + lu(k,1258) = lu(k,1258) - lu(k,1124) * lu(k,1238) + lu(k,1259) = lu(k,1259) - lu(k,1125) * lu(k,1238) + lu(k,1260) = lu(k,1260) - lu(k,1126) * lu(k,1238) + lu(k,1281) = lu(k,1281) - lu(k,1105) * lu(k,1280) + lu(k,1282) = lu(k,1282) - lu(k,1106) * lu(k,1280) + lu(k,1283) = lu(k,1283) - lu(k,1107) * lu(k,1280) + lu(k,1284) = lu(k,1284) - lu(k,1108) * lu(k,1280) + lu(k,1285) = lu(k,1285) - lu(k,1109) * lu(k,1280) + lu(k,1286) = lu(k,1286) - lu(k,1110) * lu(k,1280) + lu(k,1287) = lu(k,1287) - lu(k,1111) * lu(k,1280) + lu(k,1288) = lu(k,1288) - lu(k,1112) * lu(k,1280) + lu(k,1289) = lu(k,1289) - lu(k,1113) * lu(k,1280) + lu(k,1290) = lu(k,1290) - lu(k,1114) * lu(k,1280) + lu(k,1291) = lu(k,1291) - lu(k,1115) * lu(k,1280) + lu(k,1292) = lu(k,1292) - lu(k,1116) * lu(k,1280) + lu(k,1293) = lu(k,1293) - lu(k,1117) * lu(k,1280) + lu(k,1294) = lu(k,1294) - lu(k,1118) * lu(k,1280) + lu(k,1295) = lu(k,1295) - lu(k,1119) * lu(k,1280) + lu(k,1296) = lu(k,1296) - lu(k,1120) * lu(k,1280) + lu(k,1297) = lu(k,1297) - lu(k,1121) * lu(k,1280) + lu(k,1298) = lu(k,1298) - lu(k,1122) * lu(k,1280) + lu(k,1299) = lu(k,1299) - lu(k,1123) * lu(k,1280) + lu(k,1300) = lu(k,1300) - lu(k,1124) * lu(k,1280) + lu(k,1301) = lu(k,1301) - lu(k,1125) * lu(k,1280) + lu(k,1302) = lu(k,1302) - lu(k,1126) * lu(k,1280) + lu(k,1323) = lu(k,1323) - lu(k,1105) * lu(k,1322) + lu(k,1324) = lu(k,1324) - lu(k,1106) * lu(k,1322) + lu(k,1325) = lu(k,1325) - lu(k,1107) * lu(k,1322) + lu(k,1326) = lu(k,1326) - lu(k,1108) * lu(k,1322) + lu(k,1327) = lu(k,1327) - lu(k,1109) * lu(k,1322) + lu(k,1328) = lu(k,1328) - lu(k,1110) * lu(k,1322) + lu(k,1329) = lu(k,1329) - lu(k,1111) * lu(k,1322) + lu(k,1330) = lu(k,1330) - lu(k,1112) * lu(k,1322) + lu(k,1331) = lu(k,1331) - lu(k,1113) * lu(k,1322) + lu(k,1332) = lu(k,1332) - lu(k,1114) * lu(k,1322) + lu(k,1333) = lu(k,1333) - lu(k,1115) * lu(k,1322) + lu(k,1334) = lu(k,1334) - lu(k,1116) * lu(k,1322) + lu(k,1335) = lu(k,1335) - lu(k,1117) * lu(k,1322) + lu(k,1336) = lu(k,1336) - lu(k,1118) * lu(k,1322) + lu(k,1337) = lu(k,1337) - lu(k,1119) * lu(k,1322) + lu(k,1338) = lu(k,1338) - lu(k,1120) * lu(k,1322) + lu(k,1339) = lu(k,1339) - lu(k,1121) * lu(k,1322) + lu(k,1340) = lu(k,1340) - lu(k,1122) * lu(k,1322) + lu(k,1341) = lu(k,1341) - lu(k,1123) * lu(k,1322) + lu(k,1342) = lu(k,1342) - lu(k,1124) * lu(k,1322) + lu(k,1343) = lu(k,1343) - lu(k,1125) * lu(k,1322) + lu(k,1344) = lu(k,1344) - lu(k,1126) * lu(k,1322) + lu(k,1383) = lu(k,1383) - lu(k,1105) * lu(k,1382) + lu(k,1384) = lu(k,1384) - lu(k,1106) * lu(k,1382) + lu(k,1385) = lu(k,1385) - lu(k,1107) * lu(k,1382) + lu(k,1386) = lu(k,1386) - lu(k,1108) * lu(k,1382) + lu(k,1387) = lu(k,1387) - lu(k,1109) * lu(k,1382) + lu(k,1388) = lu(k,1388) - lu(k,1110) * lu(k,1382) + lu(k,1389) = lu(k,1389) - lu(k,1111) * lu(k,1382) + lu(k,1390) = lu(k,1390) - lu(k,1112) * lu(k,1382) + lu(k,1391) = lu(k,1391) - lu(k,1113) * lu(k,1382) + lu(k,1392) = lu(k,1392) - lu(k,1114) * lu(k,1382) + lu(k,1393) = lu(k,1393) - lu(k,1115) * lu(k,1382) + lu(k,1394) = lu(k,1394) - lu(k,1116) * lu(k,1382) + lu(k,1395) = lu(k,1395) - lu(k,1117) * lu(k,1382) + lu(k,1396) = lu(k,1396) - lu(k,1118) * lu(k,1382) + lu(k,1397) = lu(k,1397) - lu(k,1119) * lu(k,1382) + lu(k,1398) = lu(k,1398) - lu(k,1120) * lu(k,1382) + lu(k,1399) = lu(k,1399) - lu(k,1121) * lu(k,1382) + lu(k,1400) = lu(k,1400) - lu(k,1122) * lu(k,1382) + lu(k,1401) = lu(k,1401) - lu(k,1123) * lu(k,1382) + lu(k,1402) = lu(k,1402) - lu(k,1124) * lu(k,1382) + lu(k,1403) = lu(k,1403) - lu(k,1125) * lu(k,1382) + lu(k,1404) = lu(k,1404) - lu(k,1126) * lu(k,1382) + lu(k,1432) = lu(k,1432) - lu(k,1105) * lu(k,1431) + lu(k,1433) = lu(k,1433) - lu(k,1106) * lu(k,1431) + lu(k,1434) = lu(k,1434) - lu(k,1107) * lu(k,1431) + lu(k,1435) = lu(k,1435) - lu(k,1108) * lu(k,1431) + lu(k,1436) = lu(k,1436) - lu(k,1109) * lu(k,1431) + lu(k,1437) = lu(k,1437) - lu(k,1110) * lu(k,1431) + lu(k,1438) = lu(k,1438) - lu(k,1111) * lu(k,1431) + lu(k,1439) = lu(k,1439) - lu(k,1112) * lu(k,1431) + lu(k,1440) = lu(k,1440) - lu(k,1113) * lu(k,1431) + lu(k,1441) = lu(k,1441) - lu(k,1114) * lu(k,1431) + lu(k,1442) = lu(k,1442) - lu(k,1115) * lu(k,1431) + lu(k,1443) = lu(k,1443) - lu(k,1116) * lu(k,1431) + lu(k,1444) = lu(k,1444) - lu(k,1117) * lu(k,1431) + lu(k,1445) = lu(k,1445) - lu(k,1118) * lu(k,1431) + lu(k,1446) = lu(k,1446) - lu(k,1119) * lu(k,1431) + lu(k,1447) = lu(k,1447) - lu(k,1120) * lu(k,1431) + lu(k,1448) = lu(k,1448) - lu(k,1121) * lu(k,1431) + lu(k,1449) = lu(k,1449) - lu(k,1122) * lu(k,1431) + lu(k,1450) = lu(k,1450) - lu(k,1123) * lu(k,1431) + lu(k,1451) = lu(k,1451) - lu(k,1124) * lu(k,1431) + lu(k,1452) = lu(k,1452) - lu(k,1125) * lu(k,1431) + lu(k,1453) = lu(k,1453) - lu(k,1126) * lu(k,1431) + lu(k,1480) = lu(k,1480) - lu(k,1105) * lu(k,1479) + lu(k,1481) = lu(k,1481) - lu(k,1106) * lu(k,1479) + lu(k,1482) = lu(k,1482) - lu(k,1107) * lu(k,1479) + lu(k,1483) = lu(k,1483) - lu(k,1108) * lu(k,1479) + lu(k,1484) = lu(k,1484) - lu(k,1109) * lu(k,1479) + lu(k,1485) = lu(k,1485) - lu(k,1110) * lu(k,1479) + lu(k,1486) = lu(k,1486) - lu(k,1111) * lu(k,1479) + lu(k,1487) = lu(k,1487) - lu(k,1112) * lu(k,1479) + lu(k,1488) = lu(k,1488) - lu(k,1113) * lu(k,1479) + lu(k,1489) = lu(k,1489) - lu(k,1114) * lu(k,1479) + lu(k,1490) = lu(k,1490) - lu(k,1115) * lu(k,1479) + lu(k,1491) = lu(k,1491) - lu(k,1116) * lu(k,1479) + lu(k,1492) = lu(k,1492) - lu(k,1117) * lu(k,1479) + lu(k,1493) = lu(k,1493) - lu(k,1118) * lu(k,1479) + lu(k,1494) = lu(k,1494) - lu(k,1119) * lu(k,1479) + lu(k,1495) = lu(k,1495) - lu(k,1120) * lu(k,1479) + lu(k,1496) = lu(k,1496) - lu(k,1121) * lu(k,1479) + lu(k,1497) = lu(k,1497) - lu(k,1122) * lu(k,1479) + lu(k,1498) = lu(k,1498) - lu(k,1123) * lu(k,1479) + lu(k,1499) = lu(k,1499) - lu(k,1124) * lu(k,1479) + lu(k,1500) = lu(k,1500) - lu(k,1125) * lu(k,1479) + lu(k,1501) = lu(k,1501) - lu(k,1126) * lu(k,1479) + lu(k,1521) = lu(k,1521) - lu(k,1105) * lu(k,1520) + lu(k,1522) = lu(k,1522) - lu(k,1106) * lu(k,1520) + lu(k,1523) = lu(k,1523) - lu(k,1107) * lu(k,1520) + lu(k,1524) = lu(k,1524) - lu(k,1108) * lu(k,1520) + lu(k,1525) = lu(k,1525) - lu(k,1109) * lu(k,1520) + lu(k,1526) = lu(k,1526) - lu(k,1110) * lu(k,1520) + lu(k,1527) = lu(k,1527) - lu(k,1111) * lu(k,1520) + lu(k,1528) = lu(k,1528) - lu(k,1112) * lu(k,1520) + lu(k,1529) = lu(k,1529) - lu(k,1113) * lu(k,1520) + lu(k,1530) = lu(k,1530) - lu(k,1114) * lu(k,1520) + lu(k,1531) = lu(k,1531) - lu(k,1115) * lu(k,1520) + lu(k,1532) = lu(k,1532) - lu(k,1116) * lu(k,1520) + lu(k,1533) = lu(k,1533) - lu(k,1117) * lu(k,1520) + lu(k,1534) = lu(k,1534) - lu(k,1118) * lu(k,1520) + lu(k,1535) = lu(k,1535) - lu(k,1119) * lu(k,1520) + lu(k,1536) = lu(k,1536) - lu(k,1120) * lu(k,1520) + lu(k,1537) = lu(k,1537) - lu(k,1121) * lu(k,1520) + lu(k,1538) = lu(k,1538) - lu(k,1122) * lu(k,1520) + lu(k,1539) = lu(k,1539) - lu(k,1123) * lu(k,1520) + lu(k,1540) = lu(k,1540) - lu(k,1124) * lu(k,1520) + lu(k,1541) = lu(k,1541) - lu(k,1125) * lu(k,1520) + lu(k,1542) = lu(k,1542) - lu(k,1126) * lu(k,1520) + lu(k,1557) = lu(k,1557) - lu(k,1105) * lu(k,1556) + lu(k,1558) = lu(k,1558) - lu(k,1106) * lu(k,1556) + lu(k,1559) = lu(k,1559) - lu(k,1107) * lu(k,1556) + lu(k,1560) = lu(k,1560) - lu(k,1108) * lu(k,1556) + lu(k,1561) = lu(k,1561) - lu(k,1109) * lu(k,1556) + lu(k,1562) = lu(k,1562) - lu(k,1110) * lu(k,1556) + lu(k,1563) = lu(k,1563) - lu(k,1111) * lu(k,1556) + lu(k,1564) = lu(k,1564) - lu(k,1112) * lu(k,1556) + lu(k,1565) = lu(k,1565) - lu(k,1113) * lu(k,1556) + lu(k,1566) = lu(k,1566) - lu(k,1114) * lu(k,1556) + lu(k,1567) = lu(k,1567) - lu(k,1115) * lu(k,1556) + lu(k,1568) = lu(k,1568) - lu(k,1116) * lu(k,1556) + lu(k,1569) = lu(k,1569) - lu(k,1117) * lu(k,1556) + lu(k,1570) = lu(k,1570) - lu(k,1118) * lu(k,1556) + lu(k,1571) = lu(k,1571) - lu(k,1119) * lu(k,1556) + lu(k,1572) = lu(k,1572) - lu(k,1120) * lu(k,1556) + lu(k,1573) = lu(k,1573) - lu(k,1121) * lu(k,1556) + lu(k,1574) = lu(k,1574) - lu(k,1122) * lu(k,1556) + lu(k,1575) = lu(k,1575) - lu(k,1123) * lu(k,1556) + lu(k,1576) = lu(k,1576) - lu(k,1124) * lu(k,1556) + lu(k,1577) = lu(k,1577) - lu(k,1125) * lu(k,1556) + lu(k,1578) = lu(k,1578) - lu(k,1126) * lu(k,1556) + lu(k,1602) = lu(k,1602) - lu(k,1105) * lu(k,1601) + lu(k,1603) = lu(k,1603) - lu(k,1106) * lu(k,1601) + lu(k,1604) = lu(k,1604) - lu(k,1107) * lu(k,1601) + lu(k,1605) = lu(k,1605) - lu(k,1108) * lu(k,1601) + lu(k,1606) = lu(k,1606) - lu(k,1109) * lu(k,1601) + lu(k,1607) = lu(k,1607) - lu(k,1110) * lu(k,1601) + lu(k,1608) = lu(k,1608) - lu(k,1111) * lu(k,1601) + lu(k,1609) = lu(k,1609) - lu(k,1112) * lu(k,1601) + lu(k,1610) = lu(k,1610) - lu(k,1113) * lu(k,1601) + lu(k,1611) = lu(k,1611) - lu(k,1114) * lu(k,1601) + lu(k,1612) = lu(k,1612) - lu(k,1115) * lu(k,1601) + lu(k,1613) = lu(k,1613) - lu(k,1116) * lu(k,1601) + lu(k,1614) = lu(k,1614) - lu(k,1117) * lu(k,1601) + lu(k,1615) = lu(k,1615) - lu(k,1118) * lu(k,1601) + lu(k,1616) = lu(k,1616) - lu(k,1119) * lu(k,1601) + lu(k,1617) = lu(k,1617) - lu(k,1120) * lu(k,1601) + lu(k,1618) = lu(k,1618) - lu(k,1121) * lu(k,1601) + lu(k,1619) = lu(k,1619) - lu(k,1122) * lu(k,1601) + lu(k,1620) = lu(k,1620) - lu(k,1123) * lu(k,1601) + lu(k,1621) = lu(k,1621) - lu(k,1124) * lu(k,1601) + lu(k,1622) = lu(k,1622) - lu(k,1125) * lu(k,1601) + lu(k,1623) = lu(k,1623) - lu(k,1126) * lu(k,1601) + lu(k,1645) = lu(k,1645) - lu(k,1105) * lu(k,1644) + lu(k,1646) = lu(k,1646) - lu(k,1106) * lu(k,1644) + lu(k,1647) = lu(k,1647) - lu(k,1107) * lu(k,1644) + lu(k,1648) = lu(k,1648) - lu(k,1108) * lu(k,1644) + lu(k,1649) = lu(k,1649) - lu(k,1109) * lu(k,1644) + lu(k,1650) = lu(k,1650) - lu(k,1110) * lu(k,1644) + lu(k,1651) = lu(k,1651) - lu(k,1111) * lu(k,1644) + lu(k,1652) = lu(k,1652) - lu(k,1112) * lu(k,1644) + lu(k,1653) = lu(k,1653) - lu(k,1113) * lu(k,1644) + lu(k,1654) = lu(k,1654) - lu(k,1114) * lu(k,1644) + lu(k,1655) = lu(k,1655) - lu(k,1115) * lu(k,1644) + lu(k,1656) = lu(k,1656) - lu(k,1116) * lu(k,1644) + lu(k,1657) = lu(k,1657) - lu(k,1117) * lu(k,1644) + lu(k,1658) = lu(k,1658) - lu(k,1118) * lu(k,1644) + lu(k,1659) = lu(k,1659) - lu(k,1119) * lu(k,1644) + lu(k,1660) = lu(k,1660) - lu(k,1120) * lu(k,1644) + lu(k,1661) = lu(k,1661) - lu(k,1121) * lu(k,1644) + lu(k,1662) = lu(k,1662) - lu(k,1122) * lu(k,1644) + lu(k,1663) = lu(k,1663) - lu(k,1123) * lu(k,1644) + lu(k,1664) = lu(k,1664) - lu(k,1124) * lu(k,1644) + lu(k,1665) = lu(k,1665) - lu(k,1125) * lu(k,1644) + lu(k,1666) = lu(k,1666) - lu(k,1126) * lu(k,1644) + lu(k,1688) = lu(k,1688) - lu(k,1105) * lu(k,1687) + lu(k,1689) = lu(k,1689) - lu(k,1106) * lu(k,1687) + lu(k,1690) = lu(k,1690) - lu(k,1107) * lu(k,1687) + lu(k,1691) = lu(k,1691) - lu(k,1108) * lu(k,1687) + lu(k,1692) = lu(k,1692) - lu(k,1109) * lu(k,1687) + lu(k,1693) = lu(k,1693) - lu(k,1110) * lu(k,1687) + lu(k,1694) = lu(k,1694) - lu(k,1111) * lu(k,1687) + lu(k,1695) = lu(k,1695) - lu(k,1112) * lu(k,1687) + lu(k,1696) = lu(k,1696) - lu(k,1113) * lu(k,1687) + lu(k,1697) = lu(k,1697) - lu(k,1114) * lu(k,1687) + lu(k,1698) = lu(k,1698) - lu(k,1115) * lu(k,1687) + lu(k,1699) = lu(k,1699) - lu(k,1116) * lu(k,1687) + lu(k,1700) = lu(k,1700) - lu(k,1117) * lu(k,1687) + lu(k,1701) = lu(k,1701) - lu(k,1118) * lu(k,1687) + lu(k,1702) = lu(k,1702) - lu(k,1119) * lu(k,1687) + lu(k,1703) = lu(k,1703) - lu(k,1120) * lu(k,1687) + lu(k,1704) = lu(k,1704) - lu(k,1121) * lu(k,1687) + lu(k,1705) = lu(k,1705) - lu(k,1122) * lu(k,1687) + lu(k,1706) = lu(k,1706) - lu(k,1123) * lu(k,1687) + lu(k,1707) = lu(k,1707) - lu(k,1124) * lu(k,1687) + lu(k,1708) = lu(k,1708) - lu(k,1125) * lu(k,1687) + lu(k,1709) = lu(k,1709) - lu(k,1126) * lu(k,1687) + lu(k,1728) = lu(k,1728) - lu(k,1105) * lu(k,1727) + lu(k,1729) = lu(k,1729) - lu(k,1106) * lu(k,1727) + lu(k,1730) = lu(k,1730) - lu(k,1107) * lu(k,1727) + lu(k,1731) = lu(k,1731) - lu(k,1108) * lu(k,1727) + lu(k,1732) = lu(k,1732) - lu(k,1109) * lu(k,1727) + lu(k,1733) = lu(k,1733) - lu(k,1110) * lu(k,1727) + lu(k,1734) = lu(k,1734) - lu(k,1111) * lu(k,1727) + lu(k,1735) = lu(k,1735) - lu(k,1112) * lu(k,1727) + lu(k,1736) = lu(k,1736) - lu(k,1113) * lu(k,1727) + lu(k,1737) = lu(k,1737) - lu(k,1114) * lu(k,1727) + lu(k,1738) = lu(k,1738) - lu(k,1115) * lu(k,1727) + lu(k,1739) = lu(k,1739) - lu(k,1116) * lu(k,1727) + lu(k,1740) = lu(k,1740) - lu(k,1117) * lu(k,1727) + lu(k,1741) = lu(k,1741) - lu(k,1118) * lu(k,1727) + lu(k,1742) = lu(k,1742) - lu(k,1119) * lu(k,1727) + lu(k,1743) = lu(k,1743) - lu(k,1120) * lu(k,1727) + lu(k,1744) = lu(k,1744) - lu(k,1121) * lu(k,1727) + lu(k,1745) = lu(k,1745) - lu(k,1122) * lu(k,1727) + lu(k,1746) = lu(k,1746) - lu(k,1123) * lu(k,1727) + lu(k,1747) = lu(k,1747) - lu(k,1124) * lu(k,1727) + lu(k,1748) = lu(k,1748) - lu(k,1125) * lu(k,1727) + lu(k,1749) = lu(k,1749) - lu(k,1126) * lu(k,1727) + lu(k,1764) = lu(k,1764) - lu(k,1105) * lu(k,1763) + lu(k,1765) = lu(k,1765) - lu(k,1106) * lu(k,1763) + lu(k,1766) = lu(k,1766) - lu(k,1107) * lu(k,1763) + lu(k,1767) = lu(k,1767) - lu(k,1108) * lu(k,1763) + lu(k,1768) = lu(k,1768) - lu(k,1109) * lu(k,1763) + lu(k,1769) = lu(k,1769) - lu(k,1110) * lu(k,1763) + lu(k,1770) = lu(k,1770) - lu(k,1111) * lu(k,1763) + lu(k,1771) = lu(k,1771) - lu(k,1112) * lu(k,1763) + lu(k,1772) = lu(k,1772) - lu(k,1113) * lu(k,1763) + lu(k,1773) = lu(k,1773) - lu(k,1114) * lu(k,1763) + lu(k,1774) = lu(k,1774) - lu(k,1115) * lu(k,1763) + lu(k,1775) = lu(k,1775) - lu(k,1116) * lu(k,1763) + lu(k,1776) = lu(k,1776) - lu(k,1117) * lu(k,1763) + lu(k,1777) = lu(k,1777) - lu(k,1118) * lu(k,1763) + lu(k,1778) = lu(k,1778) - lu(k,1119) * lu(k,1763) + lu(k,1779) = lu(k,1779) - lu(k,1120) * lu(k,1763) + lu(k,1780) = lu(k,1780) - lu(k,1121) * lu(k,1763) + lu(k,1781) = lu(k,1781) - lu(k,1122) * lu(k,1763) + lu(k,1782) = lu(k,1782) - lu(k,1123) * lu(k,1763) + lu(k,1783) = lu(k,1783) - lu(k,1124) * lu(k,1763) + lu(k,1784) = lu(k,1784) - lu(k,1125) * lu(k,1763) + lu(k,1785) = lu(k,1785) - lu(k,1126) * lu(k,1763) + lu(k,1812) = lu(k,1812) - lu(k,1105) * lu(k,1811) + lu(k,1813) = lu(k,1813) - lu(k,1106) * lu(k,1811) + lu(k,1814) = lu(k,1814) - lu(k,1107) * lu(k,1811) + lu(k,1815) = lu(k,1815) - lu(k,1108) * lu(k,1811) + lu(k,1816) = lu(k,1816) - lu(k,1109) * lu(k,1811) + lu(k,1817) = lu(k,1817) - lu(k,1110) * lu(k,1811) + lu(k,1818) = lu(k,1818) - lu(k,1111) * lu(k,1811) + lu(k,1819) = lu(k,1819) - lu(k,1112) * lu(k,1811) + lu(k,1820) = lu(k,1820) - lu(k,1113) * lu(k,1811) + lu(k,1821) = lu(k,1821) - lu(k,1114) * lu(k,1811) + lu(k,1822) = lu(k,1822) - lu(k,1115) * lu(k,1811) + lu(k,1823) = lu(k,1823) - lu(k,1116) * lu(k,1811) + lu(k,1824) = lu(k,1824) - lu(k,1117) * lu(k,1811) + lu(k,1825) = lu(k,1825) - lu(k,1118) * lu(k,1811) + lu(k,1826) = lu(k,1826) - lu(k,1119) * lu(k,1811) + lu(k,1827) = lu(k,1827) - lu(k,1120) * lu(k,1811) + lu(k,1828) = lu(k,1828) - lu(k,1121) * lu(k,1811) + lu(k,1829) = lu(k,1829) - lu(k,1122) * lu(k,1811) + lu(k,1830) = lu(k,1830) - lu(k,1123) * lu(k,1811) + lu(k,1831) = lu(k,1831) - lu(k,1124) * lu(k,1811) + lu(k,1832) = lu(k,1832) - lu(k,1125) * lu(k,1811) + lu(k,1833) = lu(k,1833) - lu(k,1126) * lu(k,1811) + lu(k,1845) = lu(k,1845) - lu(k,1105) * lu(k,1844) + lu(k,1846) = lu(k,1846) - lu(k,1106) * lu(k,1844) + lu(k,1847) = lu(k,1847) - lu(k,1107) * lu(k,1844) + lu(k,1848) = lu(k,1848) - lu(k,1108) * lu(k,1844) + lu(k,1849) = lu(k,1849) - lu(k,1109) * lu(k,1844) + lu(k,1850) = lu(k,1850) - lu(k,1110) * lu(k,1844) + lu(k,1851) = lu(k,1851) - lu(k,1111) * lu(k,1844) + lu(k,1852) = lu(k,1852) - lu(k,1112) * lu(k,1844) + lu(k,1853) = lu(k,1853) - lu(k,1113) * lu(k,1844) + lu(k,1854) = lu(k,1854) - lu(k,1114) * lu(k,1844) + lu(k,1855) = lu(k,1855) - lu(k,1115) * lu(k,1844) + lu(k,1856) = lu(k,1856) - lu(k,1116) * lu(k,1844) + lu(k,1857) = lu(k,1857) - lu(k,1117) * lu(k,1844) + lu(k,1858) = lu(k,1858) - lu(k,1118) * lu(k,1844) + lu(k,1859) = lu(k,1859) - lu(k,1119) * lu(k,1844) + lu(k,1860) = lu(k,1860) - lu(k,1120) * lu(k,1844) + lu(k,1861) = lu(k,1861) - lu(k,1121) * lu(k,1844) + lu(k,1862) = lu(k,1862) - lu(k,1122) * lu(k,1844) + lu(k,1863) = lu(k,1863) - lu(k,1123) * lu(k,1844) + lu(k,1864) = lu(k,1864) - lu(k,1124) * lu(k,1844) + lu(k,1865) = lu(k,1865) - lu(k,1125) * lu(k,1844) + lu(k,1866) = lu(k,1866) - lu(k,1126) * lu(k,1844) + lu(k,1881) = lu(k,1881) - lu(k,1105) * lu(k,1880) + lu(k,1882) = lu(k,1882) - lu(k,1106) * lu(k,1880) + lu(k,1883) = lu(k,1883) - lu(k,1107) * lu(k,1880) + lu(k,1884) = lu(k,1884) - lu(k,1108) * lu(k,1880) + lu(k,1885) = lu(k,1885) - lu(k,1109) * lu(k,1880) + lu(k,1886) = lu(k,1886) - lu(k,1110) * lu(k,1880) + lu(k,1887) = lu(k,1887) - lu(k,1111) * lu(k,1880) + lu(k,1888) = lu(k,1888) - lu(k,1112) * lu(k,1880) + lu(k,1889) = lu(k,1889) - lu(k,1113) * lu(k,1880) + lu(k,1890) = lu(k,1890) - lu(k,1114) * lu(k,1880) + lu(k,1891) = lu(k,1891) - lu(k,1115) * lu(k,1880) + lu(k,1892) = lu(k,1892) - lu(k,1116) * lu(k,1880) + lu(k,1893) = lu(k,1893) - lu(k,1117) * lu(k,1880) + lu(k,1894) = lu(k,1894) - lu(k,1118) * lu(k,1880) + lu(k,1895) = lu(k,1895) - lu(k,1119) * lu(k,1880) + lu(k,1896) = lu(k,1896) - lu(k,1120) * lu(k,1880) + lu(k,1897) = lu(k,1897) - lu(k,1121) * lu(k,1880) + lu(k,1898) = lu(k,1898) - lu(k,1122) * lu(k,1880) + lu(k,1899) = lu(k,1899) - lu(k,1123) * lu(k,1880) + lu(k,1900) = lu(k,1900) - lu(k,1124) * lu(k,1880) + lu(k,1901) = lu(k,1901) - lu(k,1125) * lu(k,1880) + lu(k,1902) = lu(k,1902) - lu(k,1126) * lu(k,1880) + lu(k,1922) = lu(k,1922) - lu(k,1105) * lu(k,1921) + lu(k,1923) = lu(k,1923) - lu(k,1106) * lu(k,1921) + lu(k,1924) = lu(k,1924) - lu(k,1107) * lu(k,1921) + lu(k,1925) = lu(k,1925) - lu(k,1108) * lu(k,1921) + lu(k,1926) = lu(k,1926) - lu(k,1109) * lu(k,1921) + lu(k,1927) = lu(k,1927) - lu(k,1110) * lu(k,1921) + lu(k,1928) = lu(k,1928) - lu(k,1111) * lu(k,1921) + lu(k,1929) = lu(k,1929) - lu(k,1112) * lu(k,1921) + lu(k,1930) = lu(k,1930) - lu(k,1113) * lu(k,1921) + lu(k,1931) = lu(k,1931) - lu(k,1114) * lu(k,1921) + lu(k,1932) = lu(k,1932) - lu(k,1115) * lu(k,1921) + lu(k,1933) = lu(k,1933) - lu(k,1116) * lu(k,1921) + lu(k,1934) = lu(k,1934) - lu(k,1117) * lu(k,1921) + lu(k,1935) = lu(k,1935) - lu(k,1118) * lu(k,1921) + lu(k,1936) = lu(k,1936) - lu(k,1119) * lu(k,1921) + lu(k,1937) = lu(k,1937) - lu(k,1120) * lu(k,1921) + lu(k,1938) = lu(k,1938) - lu(k,1121) * lu(k,1921) + lu(k,1939) = lu(k,1939) - lu(k,1122) * lu(k,1921) + lu(k,1940) = lu(k,1940) - lu(k,1123) * lu(k,1921) + lu(k,1941) = lu(k,1941) - lu(k,1124) * lu(k,1921) + lu(k,1942) = lu(k,1942) - lu(k,1125) * lu(k,1921) + lu(k,1943) = lu(k,1943) - lu(k,1126) * lu(k,1921) + lu(k,1964) = lu(k,1964) - lu(k,1105) * lu(k,1963) + lu(k,1965) = lu(k,1965) - lu(k,1106) * lu(k,1963) + lu(k,1966) = lu(k,1966) - lu(k,1107) * lu(k,1963) + lu(k,1967) = lu(k,1967) - lu(k,1108) * lu(k,1963) + lu(k,1968) = lu(k,1968) - lu(k,1109) * lu(k,1963) + lu(k,1969) = lu(k,1969) - lu(k,1110) * lu(k,1963) + lu(k,1970) = lu(k,1970) - lu(k,1111) * lu(k,1963) + lu(k,1971) = lu(k,1971) - lu(k,1112) * lu(k,1963) + lu(k,1972) = lu(k,1972) - lu(k,1113) * lu(k,1963) + lu(k,1973) = lu(k,1973) - lu(k,1114) * lu(k,1963) + lu(k,1974) = lu(k,1974) - lu(k,1115) * lu(k,1963) + lu(k,1975) = lu(k,1975) - lu(k,1116) * lu(k,1963) + lu(k,1976) = lu(k,1976) - lu(k,1117) * lu(k,1963) + lu(k,1977) = lu(k,1977) - lu(k,1118) * lu(k,1963) + lu(k,1978) = lu(k,1978) - lu(k,1119) * lu(k,1963) + lu(k,1979) = lu(k,1979) - lu(k,1120) * lu(k,1963) + lu(k,1980) = lu(k,1980) - lu(k,1121) * lu(k,1963) + lu(k,1981) = lu(k,1981) - lu(k,1122) * lu(k,1963) + lu(k,1982) = lu(k,1982) - lu(k,1123) * lu(k,1963) + lu(k,1983) = lu(k,1983) - lu(k,1124) * lu(k,1963) + lu(k,1984) = lu(k,1984) - lu(k,1125) * lu(k,1963) + lu(k,1985) = lu(k,1985) - lu(k,1126) * lu(k,1963) + lu(k,2009) = lu(k,2009) - lu(k,1105) * lu(k,2008) + lu(k,2010) = lu(k,2010) - lu(k,1106) * lu(k,2008) + lu(k,2011) = lu(k,2011) - lu(k,1107) * lu(k,2008) + lu(k,2012) = lu(k,2012) - lu(k,1108) * lu(k,2008) + lu(k,2013) = lu(k,2013) - lu(k,1109) * lu(k,2008) + lu(k,2014) = lu(k,2014) - lu(k,1110) * lu(k,2008) + lu(k,2015) = lu(k,2015) - lu(k,1111) * lu(k,2008) + lu(k,2016) = lu(k,2016) - lu(k,1112) * lu(k,2008) + lu(k,2017) = lu(k,2017) - lu(k,1113) * lu(k,2008) + lu(k,2018) = lu(k,2018) - lu(k,1114) * lu(k,2008) + lu(k,2019) = lu(k,2019) - lu(k,1115) * lu(k,2008) + lu(k,2020) = lu(k,2020) - lu(k,1116) * lu(k,2008) + lu(k,2021) = lu(k,2021) - lu(k,1117) * lu(k,2008) + lu(k,2022) = lu(k,2022) - lu(k,1118) * lu(k,2008) + lu(k,2023) = lu(k,2023) - lu(k,1119) * lu(k,2008) + lu(k,2024) = lu(k,2024) - lu(k,1120) * lu(k,2008) + lu(k,2025) = lu(k,2025) - lu(k,1121) * lu(k,2008) + lu(k,2026) = lu(k,2026) - lu(k,1122) * lu(k,2008) + lu(k,2027) = lu(k,2027) - lu(k,1123) * lu(k,2008) + lu(k,2028) = lu(k,2028) - lu(k,1124) * lu(k,2008) + lu(k,2029) = lu(k,2029) - lu(k,1125) * lu(k,2008) + lu(k,2030) = lu(k,2030) - lu(k,1126) * lu(k,2008) + lu(k,2069) = lu(k,2069) - lu(k,1105) * lu(k,2068) + lu(k,2070) = lu(k,2070) - lu(k,1106) * lu(k,2068) + lu(k,2071) = lu(k,2071) - lu(k,1107) * lu(k,2068) + lu(k,2072) = lu(k,2072) - lu(k,1108) * lu(k,2068) + lu(k,2073) = lu(k,2073) - lu(k,1109) * lu(k,2068) + lu(k,2074) = lu(k,2074) - lu(k,1110) * lu(k,2068) + lu(k,2075) = lu(k,2075) - lu(k,1111) * lu(k,2068) + lu(k,2076) = lu(k,2076) - lu(k,1112) * lu(k,2068) + lu(k,2077) = lu(k,2077) - lu(k,1113) * lu(k,2068) + lu(k,2078) = lu(k,2078) - lu(k,1114) * lu(k,2068) + lu(k,2079) = lu(k,2079) - lu(k,1115) * lu(k,2068) + lu(k,2080) = lu(k,2080) - lu(k,1116) * lu(k,2068) + lu(k,2081) = lu(k,2081) - lu(k,1117) * lu(k,2068) + lu(k,2082) = lu(k,2082) - lu(k,1118) * lu(k,2068) + lu(k,2083) = lu(k,2083) - lu(k,1119) * lu(k,2068) + lu(k,2084) = lu(k,2084) - lu(k,1120) * lu(k,2068) + lu(k,2085) = lu(k,2085) - lu(k,1121) * lu(k,2068) + lu(k,2086) = lu(k,2086) - lu(k,1122) * lu(k,2068) + lu(k,2087) = lu(k,2087) - lu(k,1123) * lu(k,2068) + lu(k,2088) = lu(k,2088) - lu(k,1124) * lu(k,2068) + lu(k,2089) = lu(k,2089) - lu(k,1125) * lu(k,2068) + lu(k,2090) = lu(k,2090) - lu(k,1126) * lu(k,2068) + lu(k,1153) = 1._r8 / lu(k,1153) + lu(k,1154) = lu(k,1154) * lu(k,1153) + lu(k,1155) = lu(k,1155) * lu(k,1153) + lu(k,1156) = lu(k,1156) * lu(k,1153) + lu(k,1157) = lu(k,1157) * lu(k,1153) + lu(k,1158) = lu(k,1158) * lu(k,1153) + lu(k,1159) = lu(k,1159) * lu(k,1153) + lu(k,1160) = lu(k,1160) * lu(k,1153) + lu(k,1161) = lu(k,1161) * lu(k,1153) + lu(k,1162) = lu(k,1162) * lu(k,1153) + lu(k,1163) = lu(k,1163) * lu(k,1153) + lu(k,1164) = lu(k,1164) * lu(k,1153) + lu(k,1165) = lu(k,1165) * lu(k,1153) + lu(k,1166) = lu(k,1166) * lu(k,1153) + lu(k,1167) = lu(k,1167) * lu(k,1153) + lu(k,1168) = lu(k,1168) * lu(k,1153) + lu(k,1169) = lu(k,1169) * lu(k,1153) + lu(k,1170) = lu(k,1170) * lu(k,1153) + lu(k,1171) = lu(k,1171) * lu(k,1153) + lu(k,1172) = lu(k,1172) * lu(k,1153) + lu(k,1173) = lu(k,1173) * lu(k,1153) + lu(k,1174) = lu(k,1174) * lu(k,1153) + lu(k,1197) = lu(k,1197) - lu(k,1154) * lu(k,1196) + lu(k,1198) = lu(k,1198) - lu(k,1155) * lu(k,1196) + lu(k,1199) = lu(k,1199) - lu(k,1156) * lu(k,1196) + lu(k,1200) = lu(k,1200) - lu(k,1157) * lu(k,1196) + lu(k,1201) = lu(k,1201) - lu(k,1158) * lu(k,1196) + lu(k,1202) = lu(k,1202) - lu(k,1159) * lu(k,1196) + lu(k,1203) = lu(k,1203) - lu(k,1160) * lu(k,1196) + lu(k,1204) = lu(k,1204) - lu(k,1161) * lu(k,1196) + lu(k,1205) = lu(k,1205) - lu(k,1162) * lu(k,1196) + lu(k,1206) = lu(k,1206) - lu(k,1163) * lu(k,1196) + lu(k,1207) = lu(k,1207) - lu(k,1164) * lu(k,1196) + lu(k,1208) = lu(k,1208) - lu(k,1165) * lu(k,1196) + lu(k,1209) = lu(k,1209) - lu(k,1166) * lu(k,1196) + lu(k,1210) = lu(k,1210) - lu(k,1167) * lu(k,1196) + lu(k,1211) = lu(k,1211) - lu(k,1168) * lu(k,1196) + lu(k,1212) = lu(k,1212) - lu(k,1169) * lu(k,1196) + lu(k,1213) = lu(k,1213) - lu(k,1170) * lu(k,1196) + lu(k,1214) = lu(k,1214) - lu(k,1171) * lu(k,1196) + lu(k,1215) = lu(k,1215) - lu(k,1172) * lu(k,1196) + lu(k,1216) = lu(k,1216) - lu(k,1173) * lu(k,1196) + lu(k,1217) = lu(k,1217) - lu(k,1174) * lu(k,1196) + lu(k,1240) = lu(k,1240) - lu(k,1154) * lu(k,1239) + lu(k,1241) = lu(k,1241) - lu(k,1155) * lu(k,1239) + lu(k,1242) = lu(k,1242) - lu(k,1156) * lu(k,1239) + lu(k,1243) = lu(k,1243) - lu(k,1157) * lu(k,1239) + lu(k,1244) = lu(k,1244) - lu(k,1158) * lu(k,1239) + lu(k,1245) = lu(k,1245) - lu(k,1159) * lu(k,1239) + lu(k,1246) = lu(k,1246) - lu(k,1160) * lu(k,1239) + lu(k,1247) = lu(k,1247) - lu(k,1161) * lu(k,1239) + lu(k,1248) = lu(k,1248) - lu(k,1162) * lu(k,1239) + lu(k,1249) = lu(k,1249) - lu(k,1163) * lu(k,1239) + lu(k,1250) = lu(k,1250) - lu(k,1164) * lu(k,1239) + lu(k,1251) = lu(k,1251) - lu(k,1165) * lu(k,1239) + lu(k,1252) = lu(k,1252) - lu(k,1166) * lu(k,1239) + lu(k,1253) = lu(k,1253) - lu(k,1167) * lu(k,1239) + lu(k,1254) = lu(k,1254) - lu(k,1168) * lu(k,1239) + lu(k,1255) = lu(k,1255) - lu(k,1169) * lu(k,1239) + lu(k,1256) = lu(k,1256) - lu(k,1170) * lu(k,1239) + lu(k,1257) = lu(k,1257) - lu(k,1171) * lu(k,1239) + lu(k,1258) = lu(k,1258) - lu(k,1172) * lu(k,1239) + lu(k,1259) = lu(k,1259) - lu(k,1173) * lu(k,1239) + lu(k,1260) = lu(k,1260) - lu(k,1174) * lu(k,1239) + lu(k,1282) = lu(k,1282) - lu(k,1154) * lu(k,1281) + lu(k,1283) = lu(k,1283) - lu(k,1155) * lu(k,1281) + lu(k,1284) = lu(k,1284) - lu(k,1156) * lu(k,1281) + lu(k,1285) = lu(k,1285) - lu(k,1157) * lu(k,1281) + lu(k,1286) = lu(k,1286) - lu(k,1158) * lu(k,1281) + lu(k,1287) = lu(k,1287) - lu(k,1159) * lu(k,1281) + lu(k,1288) = lu(k,1288) - lu(k,1160) * lu(k,1281) + lu(k,1289) = lu(k,1289) - lu(k,1161) * lu(k,1281) + lu(k,1290) = lu(k,1290) - lu(k,1162) * lu(k,1281) + lu(k,1291) = lu(k,1291) - lu(k,1163) * lu(k,1281) + lu(k,1292) = lu(k,1292) - lu(k,1164) * lu(k,1281) + lu(k,1293) = lu(k,1293) - lu(k,1165) * lu(k,1281) + lu(k,1294) = lu(k,1294) - lu(k,1166) * lu(k,1281) + lu(k,1295) = lu(k,1295) - lu(k,1167) * lu(k,1281) + lu(k,1296) = lu(k,1296) - lu(k,1168) * lu(k,1281) + lu(k,1297) = lu(k,1297) - lu(k,1169) * lu(k,1281) + lu(k,1298) = lu(k,1298) - lu(k,1170) * lu(k,1281) + lu(k,1299) = lu(k,1299) - lu(k,1171) * lu(k,1281) + lu(k,1300) = lu(k,1300) - lu(k,1172) * lu(k,1281) + lu(k,1301) = lu(k,1301) - lu(k,1173) * lu(k,1281) + lu(k,1302) = lu(k,1302) - lu(k,1174) * lu(k,1281) + lu(k,1324) = lu(k,1324) - lu(k,1154) * lu(k,1323) + lu(k,1325) = lu(k,1325) - lu(k,1155) * lu(k,1323) + lu(k,1326) = lu(k,1326) - lu(k,1156) * lu(k,1323) + lu(k,1327) = lu(k,1327) - lu(k,1157) * lu(k,1323) + lu(k,1328) = lu(k,1328) - lu(k,1158) * lu(k,1323) + lu(k,1329) = lu(k,1329) - lu(k,1159) * lu(k,1323) + lu(k,1330) = lu(k,1330) - lu(k,1160) * lu(k,1323) + lu(k,1331) = lu(k,1331) - lu(k,1161) * lu(k,1323) + lu(k,1332) = lu(k,1332) - lu(k,1162) * lu(k,1323) + lu(k,1333) = lu(k,1333) - lu(k,1163) * lu(k,1323) + lu(k,1334) = lu(k,1334) - lu(k,1164) * lu(k,1323) + lu(k,1335) = lu(k,1335) - lu(k,1165) * lu(k,1323) + lu(k,1336) = lu(k,1336) - lu(k,1166) * lu(k,1323) + lu(k,1337) = lu(k,1337) - lu(k,1167) * lu(k,1323) + lu(k,1338) = lu(k,1338) - lu(k,1168) * lu(k,1323) + lu(k,1339) = lu(k,1339) - lu(k,1169) * lu(k,1323) + lu(k,1340) = lu(k,1340) - lu(k,1170) * lu(k,1323) + lu(k,1341) = lu(k,1341) - lu(k,1171) * lu(k,1323) + lu(k,1342) = lu(k,1342) - lu(k,1172) * lu(k,1323) + lu(k,1343) = lu(k,1343) - lu(k,1173) * lu(k,1323) + lu(k,1344) = lu(k,1344) - lu(k,1174) * lu(k,1323) + lu(k,1384) = lu(k,1384) - lu(k,1154) * lu(k,1383) + lu(k,1385) = lu(k,1385) - lu(k,1155) * lu(k,1383) + lu(k,1386) = lu(k,1386) - lu(k,1156) * lu(k,1383) + lu(k,1387) = lu(k,1387) - lu(k,1157) * lu(k,1383) + lu(k,1388) = lu(k,1388) - lu(k,1158) * lu(k,1383) + lu(k,1389) = lu(k,1389) - lu(k,1159) * lu(k,1383) + lu(k,1390) = lu(k,1390) - lu(k,1160) * lu(k,1383) + lu(k,1391) = lu(k,1391) - lu(k,1161) * lu(k,1383) + lu(k,1392) = lu(k,1392) - lu(k,1162) * lu(k,1383) + lu(k,1393) = lu(k,1393) - lu(k,1163) * lu(k,1383) + lu(k,1394) = lu(k,1394) - lu(k,1164) * lu(k,1383) + lu(k,1395) = lu(k,1395) - lu(k,1165) * lu(k,1383) + lu(k,1396) = lu(k,1396) - lu(k,1166) * lu(k,1383) + lu(k,1397) = lu(k,1397) - lu(k,1167) * lu(k,1383) + lu(k,1398) = lu(k,1398) - lu(k,1168) * lu(k,1383) + lu(k,1399) = lu(k,1399) - lu(k,1169) * lu(k,1383) + lu(k,1400) = lu(k,1400) - lu(k,1170) * lu(k,1383) + lu(k,1401) = lu(k,1401) - lu(k,1171) * lu(k,1383) + lu(k,1402) = lu(k,1402) - lu(k,1172) * lu(k,1383) + lu(k,1403) = lu(k,1403) - lu(k,1173) * lu(k,1383) + lu(k,1404) = lu(k,1404) - lu(k,1174) * lu(k,1383) + lu(k,1433) = lu(k,1433) - lu(k,1154) * lu(k,1432) + lu(k,1434) = lu(k,1434) - lu(k,1155) * lu(k,1432) + lu(k,1435) = lu(k,1435) - lu(k,1156) * lu(k,1432) + lu(k,1436) = lu(k,1436) - lu(k,1157) * lu(k,1432) + lu(k,1437) = lu(k,1437) - lu(k,1158) * lu(k,1432) + lu(k,1438) = lu(k,1438) - lu(k,1159) * lu(k,1432) + lu(k,1439) = lu(k,1439) - lu(k,1160) * lu(k,1432) + lu(k,1440) = lu(k,1440) - lu(k,1161) * lu(k,1432) + lu(k,1441) = lu(k,1441) - lu(k,1162) * lu(k,1432) + lu(k,1442) = lu(k,1442) - lu(k,1163) * lu(k,1432) + lu(k,1443) = lu(k,1443) - lu(k,1164) * lu(k,1432) + lu(k,1444) = lu(k,1444) - lu(k,1165) * lu(k,1432) + lu(k,1445) = lu(k,1445) - lu(k,1166) * lu(k,1432) + lu(k,1446) = lu(k,1446) - lu(k,1167) * lu(k,1432) + lu(k,1447) = lu(k,1447) - lu(k,1168) * lu(k,1432) + lu(k,1448) = lu(k,1448) - lu(k,1169) * lu(k,1432) + lu(k,1449) = lu(k,1449) - lu(k,1170) * lu(k,1432) + lu(k,1450) = lu(k,1450) - lu(k,1171) * lu(k,1432) + lu(k,1451) = lu(k,1451) - lu(k,1172) * lu(k,1432) + lu(k,1452) = lu(k,1452) - lu(k,1173) * lu(k,1432) + lu(k,1453) = lu(k,1453) - lu(k,1174) * lu(k,1432) + lu(k,1481) = lu(k,1481) - lu(k,1154) * lu(k,1480) + lu(k,1482) = lu(k,1482) - lu(k,1155) * lu(k,1480) + lu(k,1483) = lu(k,1483) - lu(k,1156) * lu(k,1480) + lu(k,1484) = lu(k,1484) - lu(k,1157) * lu(k,1480) + lu(k,1485) = lu(k,1485) - lu(k,1158) * lu(k,1480) + lu(k,1486) = lu(k,1486) - lu(k,1159) * lu(k,1480) + lu(k,1487) = lu(k,1487) - lu(k,1160) * lu(k,1480) + lu(k,1488) = lu(k,1488) - lu(k,1161) * lu(k,1480) + lu(k,1489) = lu(k,1489) - lu(k,1162) * lu(k,1480) + lu(k,1490) = lu(k,1490) - lu(k,1163) * lu(k,1480) + lu(k,1491) = lu(k,1491) - lu(k,1164) * lu(k,1480) + lu(k,1492) = lu(k,1492) - lu(k,1165) * lu(k,1480) + lu(k,1493) = lu(k,1493) - lu(k,1166) * lu(k,1480) + lu(k,1494) = lu(k,1494) - lu(k,1167) * lu(k,1480) + lu(k,1495) = lu(k,1495) - lu(k,1168) * lu(k,1480) + lu(k,1496) = lu(k,1496) - lu(k,1169) * lu(k,1480) + lu(k,1497) = lu(k,1497) - lu(k,1170) * lu(k,1480) + lu(k,1498) = lu(k,1498) - lu(k,1171) * lu(k,1480) + lu(k,1499) = lu(k,1499) - lu(k,1172) * lu(k,1480) + lu(k,1500) = lu(k,1500) - lu(k,1173) * lu(k,1480) + lu(k,1501) = lu(k,1501) - lu(k,1174) * lu(k,1480) + lu(k,1522) = lu(k,1522) - lu(k,1154) * lu(k,1521) + lu(k,1523) = lu(k,1523) - lu(k,1155) * lu(k,1521) + lu(k,1524) = lu(k,1524) - lu(k,1156) * lu(k,1521) + lu(k,1525) = lu(k,1525) - lu(k,1157) * lu(k,1521) + lu(k,1526) = lu(k,1526) - lu(k,1158) * lu(k,1521) + lu(k,1527) = lu(k,1527) - lu(k,1159) * lu(k,1521) + lu(k,1528) = lu(k,1528) - lu(k,1160) * lu(k,1521) + lu(k,1529) = lu(k,1529) - lu(k,1161) * lu(k,1521) + lu(k,1530) = lu(k,1530) - lu(k,1162) * lu(k,1521) + lu(k,1531) = lu(k,1531) - lu(k,1163) * lu(k,1521) + lu(k,1532) = lu(k,1532) - lu(k,1164) * lu(k,1521) + lu(k,1533) = lu(k,1533) - lu(k,1165) * lu(k,1521) + lu(k,1534) = lu(k,1534) - lu(k,1166) * lu(k,1521) + lu(k,1535) = lu(k,1535) - lu(k,1167) * lu(k,1521) + lu(k,1536) = lu(k,1536) - lu(k,1168) * lu(k,1521) + lu(k,1537) = lu(k,1537) - lu(k,1169) * lu(k,1521) + lu(k,1538) = lu(k,1538) - lu(k,1170) * lu(k,1521) + lu(k,1539) = lu(k,1539) - lu(k,1171) * lu(k,1521) + lu(k,1540) = lu(k,1540) - lu(k,1172) * lu(k,1521) + lu(k,1541) = lu(k,1541) - lu(k,1173) * lu(k,1521) + lu(k,1542) = lu(k,1542) - lu(k,1174) * lu(k,1521) + lu(k,1558) = lu(k,1558) - lu(k,1154) * lu(k,1557) + lu(k,1559) = lu(k,1559) - lu(k,1155) * lu(k,1557) + lu(k,1560) = lu(k,1560) - lu(k,1156) * lu(k,1557) + lu(k,1561) = lu(k,1561) - lu(k,1157) * lu(k,1557) + lu(k,1562) = lu(k,1562) - lu(k,1158) * lu(k,1557) + lu(k,1563) = lu(k,1563) - lu(k,1159) * lu(k,1557) + lu(k,1564) = lu(k,1564) - lu(k,1160) * lu(k,1557) + lu(k,1565) = lu(k,1565) - lu(k,1161) * lu(k,1557) + lu(k,1566) = lu(k,1566) - lu(k,1162) * lu(k,1557) + lu(k,1567) = lu(k,1567) - lu(k,1163) * lu(k,1557) + lu(k,1568) = lu(k,1568) - lu(k,1164) * lu(k,1557) + lu(k,1569) = lu(k,1569) - lu(k,1165) * lu(k,1557) + lu(k,1570) = lu(k,1570) - lu(k,1166) * lu(k,1557) + lu(k,1571) = lu(k,1571) - lu(k,1167) * lu(k,1557) + lu(k,1572) = lu(k,1572) - lu(k,1168) * lu(k,1557) + lu(k,1573) = lu(k,1573) - lu(k,1169) * lu(k,1557) + lu(k,1574) = lu(k,1574) - lu(k,1170) * lu(k,1557) + lu(k,1575) = lu(k,1575) - lu(k,1171) * lu(k,1557) + lu(k,1576) = lu(k,1576) - lu(k,1172) * lu(k,1557) + lu(k,1577) = lu(k,1577) - lu(k,1173) * lu(k,1557) + lu(k,1578) = lu(k,1578) - lu(k,1174) * lu(k,1557) + lu(k,1603) = lu(k,1603) - lu(k,1154) * lu(k,1602) + lu(k,1604) = lu(k,1604) - lu(k,1155) * lu(k,1602) + lu(k,1605) = lu(k,1605) - lu(k,1156) * lu(k,1602) + lu(k,1606) = lu(k,1606) - lu(k,1157) * lu(k,1602) + lu(k,1607) = lu(k,1607) - lu(k,1158) * lu(k,1602) + lu(k,1608) = lu(k,1608) - lu(k,1159) * lu(k,1602) + lu(k,1609) = lu(k,1609) - lu(k,1160) * lu(k,1602) + lu(k,1610) = lu(k,1610) - lu(k,1161) * lu(k,1602) + lu(k,1611) = lu(k,1611) - lu(k,1162) * lu(k,1602) + lu(k,1612) = lu(k,1612) - lu(k,1163) * lu(k,1602) + lu(k,1613) = lu(k,1613) - lu(k,1164) * lu(k,1602) + lu(k,1614) = lu(k,1614) - lu(k,1165) * lu(k,1602) + lu(k,1615) = lu(k,1615) - lu(k,1166) * lu(k,1602) + lu(k,1616) = lu(k,1616) - lu(k,1167) * lu(k,1602) + lu(k,1617) = lu(k,1617) - lu(k,1168) * lu(k,1602) + lu(k,1618) = lu(k,1618) - lu(k,1169) * lu(k,1602) + lu(k,1619) = lu(k,1619) - lu(k,1170) * lu(k,1602) + lu(k,1620) = lu(k,1620) - lu(k,1171) * lu(k,1602) + lu(k,1621) = lu(k,1621) - lu(k,1172) * lu(k,1602) + lu(k,1622) = lu(k,1622) - lu(k,1173) * lu(k,1602) + lu(k,1623) = lu(k,1623) - lu(k,1174) * lu(k,1602) + lu(k,1646) = lu(k,1646) - lu(k,1154) * lu(k,1645) + lu(k,1647) = lu(k,1647) - lu(k,1155) * lu(k,1645) + lu(k,1648) = lu(k,1648) - lu(k,1156) * lu(k,1645) + lu(k,1649) = lu(k,1649) - lu(k,1157) * lu(k,1645) + lu(k,1650) = lu(k,1650) - lu(k,1158) * lu(k,1645) + lu(k,1651) = lu(k,1651) - lu(k,1159) * lu(k,1645) + lu(k,1652) = lu(k,1652) - lu(k,1160) * lu(k,1645) + lu(k,1653) = lu(k,1653) - lu(k,1161) * lu(k,1645) + lu(k,1654) = lu(k,1654) - lu(k,1162) * lu(k,1645) + lu(k,1655) = lu(k,1655) - lu(k,1163) * lu(k,1645) + lu(k,1656) = lu(k,1656) - lu(k,1164) * lu(k,1645) + lu(k,1657) = lu(k,1657) - lu(k,1165) * lu(k,1645) + lu(k,1658) = lu(k,1658) - lu(k,1166) * lu(k,1645) + lu(k,1659) = lu(k,1659) - lu(k,1167) * lu(k,1645) + lu(k,1660) = lu(k,1660) - lu(k,1168) * lu(k,1645) + lu(k,1661) = lu(k,1661) - lu(k,1169) * lu(k,1645) + lu(k,1662) = lu(k,1662) - lu(k,1170) * lu(k,1645) + lu(k,1663) = lu(k,1663) - lu(k,1171) * lu(k,1645) + lu(k,1664) = lu(k,1664) - lu(k,1172) * lu(k,1645) + lu(k,1665) = lu(k,1665) - lu(k,1173) * lu(k,1645) + lu(k,1666) = lu(k,1666) - lu(k,1174) * lu(k,1645) + lu(k,1689) = lu(k,1689) - lu(k,1154) * lu(k,1688) + lu(k,1690) = lu(k,1690) - lu(k,1155) * lu(k,1688) + lu(k,1691) = lu(k,1691) - lu(k,1156) * lu(k,1688) + lu(k,1692) = lu(k,1692) - lu(k,1157) * lu(k,1688) + lu(k,1693) = lu(k,1693) - lu(k,1158) * lu(k,1688) + lu(k,1694) = lu(k,1694) - lu(k,1159) * lu(k,1688) + lu(k,1695) = lu(k,1695) - lu(k,1160) * lu(k,1688) + lu(k,1696) = lu(k,1696) - lu(k,1161) * lu(k,1688) + lu(k,1697) = lu(k,1697) - lu(k,1162) * lu(k,1688) + lu(k,1698) = lu(k,1698) - lu(k,1163) * lu(k,1688) + lu(k,1699) = lu(k,1699) - lu(k,1164) * lu(k,1688) + lu(k,1700) = lu(k,1700) - lu(k,1165) * lu(k,1688) + lu(k,1701) = lu(k,1701) - lu(k,1166) * lu(k,1688) + lu(k,1702) = lu(k,1702) - lu(k,1167) * lu(k,1688) + lu(k,1703) = lu(k,1703) - lu(k,1168) * lu(k,1688) + lu(k,1704) = lu(k,1704) - lu(k,1169) * lu(k,1688) + lu(k,1705) = lu(k,1705) - lu(k,1170) * lu(k,1688) + lu(k,1706) = lu(k,1706) - lu(k,1171) * lu(k,1688) + lu(k,1707) = lu(k,1707) - lu(k,1172) * lu(k,1688) + lu(k,1708) = lu(k,1708) - lu(k,1173) * lu(k,1688) + lu(k,1709) = lu(k,1709) - lu(k,1174) * lu(k,1688) + lu(k,1729) = lu(k,1729) - lu(k,1154) * lu(k,1728) + lu(k,1730) = lu(k,1730) - lu(k,1155) * lu(k,1728) + lu(k,1731) = lu(k,1731) - lu(k,1156) * lu(k,1728) + lu(k,1732) = lu(k,1732) - lu(k,1157) * lu(k,1728) + lu(k,1733) = lu(k,1733) - lu(k,1158) * lu(k,1728) + lu(k,1734) = lu(k,1734) - lu(k,1159) * lu(k,1728) + lu(k,1735) = lu(k,1735) - lu(k,1160) * lu(k,1728) + lu(k,1736) = lu(k,1736) - lu(k,1161) * lu(k,1728) + lu(k,1737) = lu(k,1737) - lu(k,1162) * lu(k,1728) + lu(k,1738) = lu(k,1738) - lu(k,1163) * lu(k,1728) + lu(k,1739) = lu(k,1739) - lu(k,1164) * lu(k,1728) + lu(k,1740) = lu(k,1740) - lu(k,1165) * lu(k,1728) + lu(k,1741) = lu(k,1741) - lu(k,1166) * lu(k,1728) + lu(k,1742) = lu(k,1742) - lu(k,1167) * lu(k,1728) + lu(k,1743) = lu(k,1743) - lu(k,1168) * lu(k,1728) + lu(k,1744) = lu(k,1744) - lu(k,1169) * lu(k,1728) + lu(k,1745) = lu(k,1745) - lu(k,1170) * lu(k,1728) + lu(k,1746) = lu(k,1746) - lu(k,1171) * lu(k,1728) + lu(k,1747) = lu(k,1747) - lu(k,1172) * lu(k,1728) + lu(k,1748) = lu(k,1748) - lu(k,1173) * lu(k,1728) + lu(k,1749) = lu(k,1749) - lu(k,1174) * lu(k,1728) + lu(k,1765) = lu(k,1765) - lu(k,1154) * lu(k,1764) + lu(k,1766) = lu(k,1766) - lu(k,1155) * lu(k,1764) + lu(k,1767) = lu(k,1767) - lu(k,1156) * lu(k,1764) + lu(k,1768) = lu(k,1768) - lu(k,1157) * lu(k,1764) + lu(k,1769) = lu(k,1769) - lu(k,1158) * lu(k,1764) + lu(k,1770) = lu(k,1770) - lu(k,1159) * lu(k,1764) + lu(k,1771) = lu(k,1771) - lu(k,1160) * lu(k,1764) + lu(k,1772) = lu(k,1772) - lu(k,1161) * lu(k,1764) + lu(k,1773) = lu(k,1773) - lu(k,1162) * lu(k,1764) + lu(k,1774) = lu(k,1774) - lu(k,1163) * lu(k,1764) + lu(k,1775) = lu(k,1775) - lu(k,1164) * lu(k,1764) + lu(k,1776) = lu(k,1776) - lu(k,1165) * lu(k,1764) + lu(k,1777) = lu(k,1777) - lu(k,1166) * lu(k,1764) + lu(k,1778) = lu(k,1778) - lu(k,1167) * lu(k,1764) + lu(k,1779) = lu(k,1779) - lu(k,1168) * lu(k,1764) + lu(k,1780) = lu(k,1780) - lu(k,1169) * lu(k,1764) + lu(k,1781) = lu(k,1781) - lu(k,1170) * lu(k,1764) + lu(k,1782) = lu(k,1782) - lu(k,1171) * lu(k,1764) + lu(k,1783) = lu(k,1783) - lu(k,1172) * lu(k,1764) + lu(k,1784) = lu(k,1784) - lu(k,1173) * lu(k,1764) + lu(k,1785) = lu(k,1785) - lu(k,1174) * lu(k,1764) + lu(k,1813) = lu(k,1813) - lu(k,1154) * lu(k,1812) + lu(k,1814) = lu(k,1814) - lu(k,1155) * lu(k,1812) + lu(k,1815) = lu(k,1815) - lu(k,1156) * lu(k,1812) + lu(k,1816) = lu(k,1816) - lu(k,1157) * lu(k,1812) + lu(k,1817) = lu(k,1817) - lu(k,1158) * lu(k,1812) + lu(k,1818) = lu(k,1818) - lu(k,1159) * lu(k,1812) + lu(k,1819) = lu(k,1819) - lu(k,1160) * lu(k,1812) + lu(k,1820) = lu(k,1820) - lu(k,1161) * lu(k,1812) + lu(k,1821) = lu(k,1821) - lu(k,1162) * lu(k,1812) + lu(k,1822) = lu(k,1822) - lu(k,1163) * lu(k,1812) + lu(k,1823) = lu(k,1823) - lu(k,1164) * lu(k,1812) + lu(k,1824) = lu(k,1824) - lu(k,1165) * lu(k,1812) + lu(k,1825) = lu(k,1825) - lu(k,1166) * lu(k,1812) + lu(k,1826) = lu(k,1826) - lu(k,1167) * lu(k,1812) + lu(k,1827) = lu(k,1827) - lu(k,1168) * lu(k,1812) + lu(k,1828) = lu(k,1828) - lu(k,1169) * lu(k,1812) + lu(k,1829) = lu(k,1829) - lu(k,1170) * lu(k,1812) + lu(k,1830) = lu(k,1830) - lu(k,1171) * lu(k,1812) + lu(k,1831) = lu(k,1831) - lu(k,1172) * lu(k,1812) + lu(k,1832) = lu(k,1832) - lu(k,1173) * lu(k,1812) + lu(k,1833) = lu(k,1833) - lu(k,1174) * lu(k,1812) + lu(k,1846) = lu(k,1846) - lu(k,1154) * lu(k,1845) + lu(k,1847) = lu(k,1847) - lu(k,1155) * lu(k,1845) + lu(k,1848) = lu(k,1848) - lu(k,1156) * lu(k,1845) + lu(k,1849) = lu(k,1849) - lu(k,1157) * lu(k,1845) + lu(k,1850) = lu(k,1850) - lu(k,1158) * lu(k,1845) + lu(k,1851) = lu(k,1851) - lu(k,1159) * lu(k,1845) + lu(k,1852) = lu(k,1852) - lu(k,1160) * lu(k,1845) + lu(k,1853) = lu(k,1853) - lu(k,1161) * lu(k,1845) + lu(k,1854) = lu(k,1854) - lu(k,1162) * lu(k,1845) + lu(k,1855) = lu(k,1855) - lu(k,1163) * lu(k,1845) + lu(k,1856) = lu(k,1856) - lu(k,1164) * lu(k,1845) + lu(k,1857) = lu(k,1857) - lu(k,1165) * lu(k,1845) + lu(k,1858) = lu(k,1858) - lu(k,1166) * lu(k,1845) + lu(k,1859) = lu(k,1859) - lu(k,1167) * lu(k,1845) + lu(k,1860) = lu(k,1860) - lu(k,1168) * lu(k,1845) + lu(k,1861) = lu(k,1861) - lu(k,1169) * lu(k,1845) + lu(k,1862) = lu(k,1862) - lu(k,1170) * lu(k,1845) + lu(k,1863) = lu(k,1863) - lu(k,1171) * lu(k,1845) + lu(k,1864) = lu(k,1864) - lu(k,1172) * lu(k,1845) + lu(k,1865) = lu(k,1865) - lu(k,1173) * lu(k,1845) + lu(k,1866) = lu(k,1866) - lu(k,1174) * lu(k,1845) + lu(k,1882) = lu(k,1882) - lu(k,1154) * lu(k,1881) + lu(k,1883) = lu(k,1883) - lu(k,1155) * lu(k,1881) + lu(k,1884) = lu(k,1884) - lu(k,1156) * lu(k,1881) + lu(k,1885) = lu(k,1885) - lu(k,1157) * lu(k,1881) + lu(k,1886) = lu(k,1886) - lu(k,1158) * lu(k,1881) + lu(k,1887) = lu(k,1887) - lu(k,1159) * lu(k,1881) + lu(k,1888) = lu(k,1888) - lu(k,1160) * lu(k,1881) + lu(k,1889) = lu(k,1889) - lu(k,1161) * lu(k,1881) + lu(k,1890) = lu(k,1890) - lu(k,1162) * lu(k,1881) + lu(k,1891) = lu(k,1891) - lu(k,1163) * lu(k,1881) + lu(k,1892) = lu(k,1892) - lu(k,1164) * lu(k,1881) + lu(k,1893) = lu(k,1893) - lu(k,1165) * lu(k,1881) + lu(k,1894) = lu(k,1894) - lu(k,1166) * lu(k,1881) + lu(k,1895) = lu(k,1895) - lu(k,1167) * lu(k,1881) + lu(k,1896) = lu(k,1896) - lu(k,1168) * lu(k,1881) + lu(k,1897) = lu(k,1897) - lu(k,1169) * lu(k,1881) + lu(k,1898) = lu(k,1898) - lu(k,1170) * lu(k,1881) + lu(k,1899) = lu(k,1899) - lu(k,1171) * lu(k,1881) + lu(k,1900) = lu(k,1900) - lu(k,1172) * lu(k,1881) + lu(k,1901) = lu(k,1901) - lu(k,1173) * lu(k,1881) + lu(k,1902) = lu(k,1902) - lu(k,1174) * lu(k,1881) + lu(k,1923) = lu(k,1923) - lu(k,1154) * lu(k,1922) + lu(k,1924) = lu(k,1924) - lu(k,1155) * lu(k,1922) + lu(k,1925) = lu(k,1925) - lu(k,1156) * lu(k,1922) + lu(k,1926) = lu(k,1926) - lu(k,1157) * lu(k,1922) + lu(k,1927) = lu(k,1927) - lu(k,1158) * lu(k,1922) + lu(k,1928) = lu(k,1928) - lu(k,1159) * lu(k,1922) + lu(k,1929) = lu(k,1929) - lu(k,1160) * lu(k,1922) + lu(k,1930) = lu(k,1930) - lu(k,1161) * lu(k,1922) + lu(k,1931) = lu(k,1931) - lu(k,1162) * lu(k,1922) + lu(k,1932) = lu(k,1932) - lu(k,1163) * lu(k,1922) + lu(k,1933) = lu(k,1933) - lu(k,1164) * lu(k,1922) + lu(k,1934) = lu(k,1934) - lu(k,1165) * lu(k,1922) + lu(k,1935) = lu(k,1935) - lu(k,1166) * lu(k,1922) + lu(k,1936) = lu(k,1936) - lu(k,1167) * lu(k,1922) + lu(k,1937) = lu(k,1937) - lu(k,1168) * lu(k,1922) + lu(k,1938) = lu(k,1938) - lu(k,1169) * lu(k,1922) + lu(k,1939) = lu(k,1939) - lu(k,1170) * lu(k,1922) + lu(k,1940) = lu(k,1940) - lu(k,1171) * lu(k,1922) + lu(k,1941) = lu(k,1941) - lu(k,1172) * lu(k,1922) + lu(k,1942) = lu(k,1942) - lu(k,1173) * lu(k,1922) + lu(k,1943) = lu(k,1943) - lu(k,1174) * lu(k,1922) + lu(k,1965) = lu(k,1965) - lu(k,1154) * lu(k,1964) + lu(k,1966) = lu(k,1966) - lu(k,1155) * lu(k,1964) + lu(k,1967) = lu(k,1967) - lu(k,1156) * lu(k,1964) + lu(k,1968) = lu(k,1968) - lu(k,1157) * lu(k,1964) + lu(k,1969) = lu(k,1969) - lu(k,1158) * lu(k,1964) + lu(k,1970) = lu(k,1970) - lu(k,1159) * lu(k,1964) + lu(k,1971) = lu(k,1971) - lu(k,1160) * lu(k,1964) + lu(k,1972) = lu(k,1972) - lu(k,1161) * lu(k,1964) + lu(k,1973) = lu(k,1973) - lu(k,1162) * lu(k,1964) + lu(k,1974) = lu(k,1974) - lu(k,1163) * lu(k,1964) + lu(k,1975) = lu(k,1975) - lu(k,1164) * lu(k,1964) + lu(k,1976) = lu(k,1976) - lu(k,1165) * lu(k,1964) + lu(k,1977) = lu(k,1977) - lu(k,1166) * lu(k,1964) + lu(k,1978) = lu(k,1978) - lu(k,1167) * lu(k,1964) + lu(k,1979) = lu(k,1979) - lu(k,1168) * lu(k,1964) + lu(k,1980) = lu(k,1980) - lu(k,1169) * lu(k,1964) + lu(k,1981) = lu(k,1981) - lu(k,1170) * lu(k,1964) + lu(k,1982) = lu(k,1982) - lu(k,1171) * lu(k,1964) + lu(k,1983) = lu(k,1983) - lu(k,1172) * lu(k,1964) + lu(k,1984) = lu(k,1984) - lu(k,1173) * lu(k,1964) + lu(k,1985) = lu(k,1985) - lu(k,1174) * lu(k,1964) + lu(k,2010) = lu(k,2010) - lu(k,1154) * lu(k,2009) + lu(k,2011) = lu(k,2011) - lu(k,1155) * lu(k,2009) + lu(k,2012) = lu(k,2012) - lu(k,1156) * lu(k,2009) + lu(k,2013) = lu(k,2013) - lu(k,1157) * lu(k,2009) + lu(k,2014) = lu(k,2014) - lu(k,1158) * lu(k,2009) + lu(k,2015) = lu(k,2015) - lu(k,1159) * lu(k,2009) + lu(k,2016) = lu(k,2016) - lu(k,1160) * lu(k,2009) + lu(k,2017) = lu(k,2017) - lu(k,1161) * lu(k,2009) + lu(k,2018) = lu(k,2018) - lu(k,1162) * lu(k,2009) + lu(k,2019) = lu(k,2019) - lu(k,1163) * lu(k,2009) + lu(k,2020) = lu(k,2020) - lu(k,1164) * lu(k,2009) + lu(k,2021) = lu(k,2021) - lu(k,1165) * lu(k,2009) + lu(k,2022) = lu(k,2022) - lu(k,1166) * lu(k,2009) + lu(k,2023) = lu(k,2023) - lu(k,1167) * lu(k,2009) + lu(k,2024) = lu(k,2024) - lu(k,1168) * lu(k,2009) + lu(k,2025) = lu(k,2025) - lu(k,1169) * lu(k,2009) + lu(k,2026) = lu(k,2026) - lu(k,1170) * lu(k,2009) + lu(k,2027) = lu(k,2027) - lu(k,1171) * lu(k,2009) + lu(k,2028) = lu(k,2028) - lu(k,1172) * lu(k,2009) + lu(k,2029) = lu(k,2029) - lu(k,1173) * lu(k,2009) + lu(k,2030) = lu(k,2030) - lu(k,1174) * lu(k,2009) + lu(k,2070) = lu(k,2070) - lu(k,1154) * lu(k,2069) + lu(k,2071) = lu(k,2071) - lu(k,1155) * lu(k,2069) + lu(k,2072) = lu(k,2072) - lu(k,1156) * lu(k,2069) + lu(k,2073) = lu(k,2073) - lu(k,1157) * lu(k,2069) + lu(k,2074) = lu(k,2074) - lu(k,1158) * lu(k,2069) + lu(k,2075) = lu(k,2075) - lu(k,1159) * lu(k,2069) + lu(k,2076) = lu(k,2076) - lu(k,1160) * lu(k,2069) + lu(k,2077) = lu(k,2077) - lu(k,1161) * lu(k,2069) + lu(k,2078) = lu(k,2078) - lu(k,1162) * lu(k,2069) + lu(k,2079) = lu(k,2079) - lu(k,1163) * lu(k,2069) + lu(k,2080) = lu(k,2080) - lu(k,1164) * lu(k,2069) + lu(k,2081) = lu(k,2081) - lu(k,1165) * lu(k,2069) + lu(k,2082) = lu(k,2082) - lu(k,1166) * lu(k,2069) + lu(k,2083) = lu(k,2083) - lu(k,1167) * lu(k,2069) + lu(k,2084) = lu(k,2084) - lu(k,1168) * lu(k,2069) + lu(k,2085) = lu(k,2085) - lu(k,1169) * lu(k,2069) + lu(k,2086) = lu(k,2086) - lu(k,1170) * lu(k,2069) + lu(k,2087) = lu(k,2087) - lu(k,1171) * lu(k,2069) + lu(k,2088) = lu(k,2088) - lu(k,1172) * lu(k,2069) + lu(k,2089) = lu(k,2089) - lu(k,1173) * lu(k,2069) + lu(k,2090) = lu(k,2090) - lu(k,1174) * lu(k,2069) + lu(k,1197) = 1._r8 / lu(k,1197) + lu(k,1198) = lu(k,1198) * lu(k,1197) + lu(k,1199) = lu(k,1199) * lu(k,1197) + lu(k,1200) = lu(k,1200) * lu(k,1197) + lu(k,1201) = lu(k,1201) * lu(k,1197) + lu(k,1202) = lu(k,1202) * lu(k,1197) + lu(k,1203) = lu(k,1203) * lu(k,1197) + lu(k,1204) = lu(k,1204) * lu(k,1197) + lu(k,1205) = lu(k,1205) * lu(k,1197) + lu(k,1206) = lu(k,1206) * lu(k,1197) + lu(k,1207) = lu(k,1207) * lu(k,1197) + lu(k,1208) = lu(k,1208) * lu(k,1197) + lu(k,1209) = lu(k,1209) * lu(k,1197) + lu(k,1210) = lu(k,1210) * lu(k,1197) + lu(k,1211) = lu(k,1211) * lu(k,1197) + lu(k,1212) = lu(k,1212) * lu(k,1197) + lu(k,1213) = lu(k,1213) * lu(k,1197) + lu(k,1214) = lu(k,1214) * lu(k,1197) + lu(k,1215) = lu(k,1215) * lu(k,1197) + lu(k,1216) = lu(k,1216) * lu(k,1197) + lu(k,1217) = lu(k,1217) * lu(k,1197) + lu(k,1241) = lu(k,1241) - lu(k,1198) * lu(k,1240) + lu(k,1242) = lu(k,1242) - lu(k,1199) * lu(k,1240) + lu(k,1243) = lu(k,1243) - lu(k,1200) * lu(k,1240) + lu(k,1244) = lu(k,1244) - lu(k,1201) * lu(k,1240) + lu(k,1245) = lu(k,1245) - lu(k,1202) * lu(k,1240) + lu(k,1246) = lu(k,1246) - lu(k,1203) * lu(k,1240) + lu(k,1247) = lu(k,1247) - lu(k,1204) * lu(k,1240) + lu(k,1248) = lu(k,1248) - lu(k,1205) * lu(k,1240) + lu(k,1249) = lu(k,1249) - lu(k,1206) * lu(k,1240) + lu(k,1250) = lu(k,1250) - lu(k,1207) * lu(k,1240) + lu(k,1251) = lu(k,1251) - lu(k,1208) * lu(k,1240) + lu(k,1252) = lu(k,1252) - lu(k,1209) * lu(k,1240) + lu(k,1253) = lu(k,1253) - lu(k,1210) * lu(k,1240) + lu(k,1254) = lu(k,1254) - lu(k,1211) * lu(k,1240) + lu(k,1255) = lu(k,1255) - lu(k,1212) * lu(k,1240) + lu(k,1256) = lu(k,1256) - lu(k,1213) * lu(k,1240) + lu(k,1257) = lu(k,1257) - lu(k,1214) * lu(k,1240) + lu(k,1258) = lu(k,1258) - lu(k,1215) * lu(k,1240) + lu(k,1259) = lu(k,1259) - lu(k,1216) * lu(k,1240) + lu(k,1260) = lu(k,1260) - lu(k,1217) * lu(k,1240) + lu(k,1283) = lu(k,1283) - lu(k,1198) * lu(k,1282) + lu(k,1284) = lu(k,1284) - lu(k,1199) * lu(k,1282) + lu(k,1285) = lu(k,1285) - lu(k,1200) * lu(k,1282) + lu(k,1286) = lu(k,1286) - lu(k,1201) * lu(k,1282) + lu(k,1287) = lu(k,1287) - lu(k,1202) * lu(k,1282) + lu(k,1288) = lu(k,1288) - lu(k,1203) * lu(k,1282) + lu(k,1289) = lu(k,1289) - lu(k,1204) * lu(k,1282) + lu(k,1290) = lu(k,1290) - lu(k,1205) * lu(k,1282) + lu(k,1291) = lu(k,1291) - lu(k,1206) * lu(k,1282) + lu(k,1292) = lu(k,1292) - lu(k,1207) * lu(k,1282) + lu(k,1293) = lu(k,1293) - lu(k,1208) * lu(k,1282) + lu(k,1294) = lu(k,1294) - lu(k,1209) * lu(k,1282) + lu(k,1295) = lu(k,1295) - lu(k,1210) * lu(k,1282) + lu(k,1296) = lu(k,1296) - lu(k,1211) * lu(k,1282) + lu(k,1297) = lu(k,1297) - lu(k,1212) * lu(k,1282) + lu(k,1298) = lu(k,1298) - lu(k,1213) * lu(k,1282) + lu(k,1299) = lu(k,1299) - lu(k,1214) * lu(k,1282) + lu(k,1300) = lu(k,1300) - lu(k,1215) * lu(k,1282) + lu(k,1301) = lu(k,1301) - lu(k,1216) * lu(k,1282) + lu(k,1302) = lu(k,1302) - lu(k,1217) * lu(k,1282) + lu(k,1325) = lu(k,1325) - lu(k,1198) * lu(k,1324) + lu(k,1326) = lu(k,1326) - lu(k,1199) * lu(k,1324) + lu(k,1327) = lu(k,1327) - lu(k,1200) * lu(k,1324) + lu(k,1328) = lu(k,1328) - lu(k,1201) * lu(k,1324) + lu(k,1329) = lu(k,1329) - lu(k,1202) * lu(k,1324) + lu(k,1330) = lu(k,1330) - lu(k,1203) * lu(k,1324) + lu(k,1331) = lu(k,1331) - lu(k,1204) * lu(k,1324) + lu(k,1332) = lu(k,1332) - lu(k,1205) * lu(k,1324) + lu(k,1333) = lu(k,1333) - lu(k,1206) * lu(k,1324) + lu(k,1334) = lu(k,1334) - lu(k,1207) * lu(k,1324) + lu(k,1335) = lu(k,1335) - lu(k,1208) * lu(k,1324) + lu(k,1336) = lu(k,1336) - lu(k,1209) * lu(k,1324) + lu(k,1337) = lu(k,1337) - lu(k,1210) * lu(k,1324) + lu(k,1338) = lu(k,1338) - lu(k,1211) * lu(k,1324) + lu(k,1339) = lu(k,1339) - lu(k,1212) * lu(k,1324) + lu(k,1340) = lu(k,1340) - lu(k,1213) * lu(k,1324) + lu(k,1341) = lu(k,1341) - lu(k,1214) * lu(k,1324) + lu(k,1342) = lu(k,1342) - lu(k,1215) * lu(k,1324) + lu(k,1343) = lu(k,1343) - lu(k,1216) * lu(k,1324) + lu(k,1344) = lu(k,1344) - lu(k,1217) * lu(k,1324) + lu(k,1385) = lu(k,1385) - lu(k,1198) * lu(k,1384) + lu(k,1386) = lu(k,1386) - lu(k,1199) * lu(k,1384) + lu(k,1387) = lu(k,1387) - lu(k,1200) * lu(k,1384) + lu(k,1388) = lu(k,1388) - lu(k,1201) * lu(k,1384) + lu(k,1389) = lu(k,1389) - lu(k,1202) * lu(k,1384) + lu(k,1390) = lu(k,1390) - lu(k,1203) * lu(k,1384) + lu(k,1391) = lu(k,1391) - lu(k,1204) * lu(k,1384) + lu(k,1392) = lu(k,1392) - lu(k,1205) * lu(k,1384) + lu(k,1393) = lu(k,1393) - lu(k,1206) * lu(k,1384) + lu(k,1394) = lu(k,1394) - lu(k,1207) * lu(k,1384) + lu(k,1395) = lu(k,1395) - lu(k,1208) * lu(k,1384) + lu(k,1396) = lu(k,1396) - lu(k,1209) * lu(k,1384) + lu(k,1397) = lu(k,1397) - lu(k,1210) * lu(k,1384) + lu(k,1398) = lu(k,1398) - lu(k,1211) * lu(k,1384) + lu(k,1399) = lu(k,1399) - lu(k,1212) * lu(k,1384) + lu(k,1400) = lu(k,1400) - lu(k,1213) * lu(k,1384) + lu(k,1401) = lu(k,1401) - lu(k,1214) * lu(k,1384) + lu(k,1402) = lu(k,1402) - lu(k,1215) * lu(k,1384) + lu(k,1403) = lu(k,1403) - lu(k,1216) * lu(k,1384) + lu(k,1404) = lu(k,1404) - lu(k,1217) * lu(k,1384) + lu(k,1434) = lu(k,1434) - lu(k,1198) * lu(k,1433) + lu(k,1435) = lu(k,1435) - lu(k,1199) * lu(k,1433) + lu(k,1436) = lu(k,1436) - lu(k,1200) * lu(k,1433) + lu(k,1437) = lu(k,1437) - lu(k,1201) * lu(k,1433) + lu(k,1438) = lu(k,1438) - lu(k,1202) * lu(k,1433) + lu(k,1439) = lu(k,1439) - lu(k,1203) * lu(k,1433) + lu(k,1440) = lu(k,1440) - lu(k,1204) * lu(k,1433) + lu(k,1441) = lu(k,1441) - lu(k,1205) * lu(k,1433) + lu(k,1442) = lu(k,1442) - lu(k,1206) * lu(k,1433) + lu(k,1443) = lu(k,1443) - lu(k,1207) * lu(k,1433) + lu(k,1444) = lu(k,1444) - lu(k,1208) * lu(k,1433) + lu(k,1445) = lu(k,1445) - lu(k,1209) * lu(k,1433) + lu(k,1446) = lu(k,1446) - lu(k,1210) * lu(k,1433) + lu(k,1447) = lu(k,1447) - lu(k,1211) * lu(k,1433) + lu(k,1448) = lu(k,1448) - lu(k,1212) * lu(k,1433) + lu(k,1449) = lu(k,1449) - lu(k,1213) * lu(k,1433) + lu(k,1450) = lu(k,1450) - lu(k,1214) * lu(k,1433) + lu(k,1451) = lu(k,1451) - lu(k,1215) * lu(k,1433) + lu(k,1452) = lu(k,1452) - lu(k,1216) * lu(k,1433) + lu(k,1453) = lu(k,1453) - lu(k,1217) * lu(k,1433) + lu(k,1482) = lu(k,1482) - lu(k,1198) * lu(k,1481) + lu(k,1483) = lu(k,1483) - lu(k,1199) * lu(k,1481) + lu(k,1484) = lu(k,1484) - lu(k,1200) * lu(k,1481) + lu(k,1485) = lu(k,1485) - lu(k,1201) * lu(k,1481) + lu(k,1486) = lu(k,1486) - lu(k,1202) * lu(k,1481) + lu(k,1487) = lu(k,1487) - lu(k,1203) * lu(k,1481) + lu(k,1488) = lu(k,1488) - lu(k,1204) * lu(k,1481) + lu(k,1489) = lu(k,1489) - lu(k,1205) * lu(k,1481) + lu(k,1490) = lu(k,1490) - lu(k,1206) * lu(k,1481) + lu(k,1491) = lu(k,1491) - lu(k,1207) * lu(k,1481) + lu(k,1492) = lu(k,1492) - lu(k,1208) * lu(k,1481) + lu(k,1493) = lu(k,1493) - lu(k,1209) * lu(k,1481) + lu(k,1494) = lu(k,1494) - lu(k,1210) * lu(k,1481) + lu(k,1495) = lu(k,1495) - lu(k,1211) * lu(k,1481) + lu(k,1496) = lu(k,1496) - lu(k,1212) * lu(k,1481) + lu(k,1497) = lu(k,1497) - lu(k,1213) * lu(k,1481) + lu(k,1498) = lu(k,1498) - lu(k,1214) * lu(k,1481) + lu(k,1499) = lu(k,1499) - lu(k,1215) * lu(k,1481) + lu(k,1500) = lu(k,1500) - lu(k,1216) * lu(k,1481) + lu(k,1501) = lu(k,1501) - lu(k,1217) * lu(k,1481) + lu(k,1523) = lu(k,1523) - lu(k,1198) * lu(k,1522) + lu(k,1524) = lu(k,1524) - lu(k,1199) * lu(k,1522) + lu(k,1525) = lu(k,1525) - lu(k,1200) * lu(k,1522) + lu(k,1526) = lu(k,1526) - lu(k,1201) * lu(k,1522) + lu(k,1527) = lu(k,1527) - lu(k,1202) * lu(k,1522) + lu(k,1528) = lu(k,1528) - lu(k,1203) * lu(k,1522) + lu(k,1529) = lu(k,1529) - lu(k,1204) * lu(k,1522) + lu(k,1530) = lu(k,1530) - lu(k,1205) * lu(k,1522) + lu(k,1531) = lu(k,1531) - lu(k,1206) * lu(k,1522) + lu(k,1532) = lu(k,1532) - lu(k,1207) * lu(k,1522) + lu(k,1533) = lu(k,1533) - lu(k,1208) * lu(k,1522) + lu(k,1534) = lu(k,1534) - lu(k,1209) * lu(k,1522) + lu(k,1535) = lu(k,1535) - lu(k,1210) * lu(k,1522) + lu(k,1536) = lu(k,1536) - lu(k,1211) * lu(k,1522) + lu(k,1537) = lu(k,1537) - lu(k,1212) * lu(k,1522) + lu(k,1538) = lu(k,1538) - lu(k,1213) * lu(k,1522) + lu(k,1539) = lu(k,1539) - lu(k,1214) * lu(k,1522) + lu(k,1540) = lu(k,1540) - lu(k,1215) * lu(k,1522) + lu(k,1541) = lu(k,1541) - lu(k,1216) * lu(k,1522) + lu(k,1542) = lu(k,1542) - lu(k,1217) * lu(k,1522) + lu(k,1559) = lu(k,1559) - lu(k,1198) * lu(k,1558) + lu(k,1560) = lu(k,1560) - lu(k,1199) * lu(k,1558) + lu(k,1561) = lu(k,1561) - lu(k,1200) * lu(k,1558) + lu(k,1562) = lu(k,1562) - lu(k,1201) * lu(k,1558) + lu(k,1563) = lu(k,1563) - lu(k,1202) * lu(k,1558) + lu(k,1564) = lu(k,1564) - lu(k,1203) * lu(k,1558) + lu(k,1565) = lu(k,1565) - lu(k,1204) * lu(k,1558) + lu(k,1566) = lu(k,1566) - lu(k,1205) * lu(k,1558) + lu(k,1567) = lu(k,1567) - lu(k,1206) * lu(k,1558) + lu(k,1568) = lu(k,1568) - lu(k,1207) * lu(k,1558) + lu(k,1569) = lu(k,1569) - lu(k,1208) * lu(k,1558) + lu(k,1570) = lu(k,1570) - lu(k,1209) * lu(k,1558) + lu(k,1571) = lu(k,1571) - lu(k,1210) * lu(k,1558) + lu(k,1572) = lu(k,1572) - lu(k,1211) * lu(k,1558) + lu(k,1573) = lu(k,1573) - lu(k,1212) * lu(k,1558) + lu(k,1574) = lu(k,1574) - lu(k,1213) * lu(k,1558) + lu(k,1575) = lu(k,1575) - lu(k,1214) * lu(k,1558) + lu(k,1576) = lu(k,1576) - lu(k,1215) * lu(k,1558) + lu(k,1577) = lu(k,1577) - lu(k,1216) * lu(k,1558) + lu(k,1578) = lu(k,1578) - lu(k,1217) * lu(k,1558) + lu(k,1604) = lu(k,1604) - lu(k,1198) * lu(k,1603) + lu(k,1605) = lu(k,1605) - lu(k,1199) * lu(k,1603) + lu(k,1606) = lu(k,1606) - lu(k,1200) * lu(k,1603) + lu(k,1607) = lu(k,1607) - lu(k,1201) * lu(k,1603) + lu(k,1608) = lu(k,1608) - lu(k,1202) * lu(k,1603) + lu(k,1609) = lu(k,1609) - lu(k,1203) * lu(k,1603) + lu(k,1610) = lu(k,1610) - lu(k,1204) * lu(k,1603) + lu(k,1611) = lu(k,1611) - lu(k,1205) * lu(k,1603) + lu(k,1612) = lu(k,1612) - lu(k,1206) * lu(k,1603) + lu(k,1613) = lu(k,1613) - lu(k,1207) * lu(k,1603) + lu(k,1614) = lu(k,1614) - lu(k,1208) * lu(k,1603) + lu(k,1615) = lu(k,1615) - lu(k,1209) * lu(k,1603) + lu(k,1616) = lu(k,1616) - lu(k,1210) * lu(k,1603) + lu(k,1617) = lu(k,1617) - lu(k,1211) * lu(k,1603) + lu(k,1618) = lu(k,1618) - lu(k,1212) * lu(k,1603) + lu(k,1619) = lu(k,1619) - lu(k,1213) * lu(k,1603) + lu(k,1620) = lu(k,1620) - lu(k,1214) * lu(k,1603) + lu(k,1621) = lu(k,1621) - lu(k,1215) * lu(k,1603) + lu(k,1622) = lu(k,1622) - lu(k,1216) * lu(k,1603) + lu(k,1623) = lu(k,1623) - lu(k,1217) * lu(k,1603) + lu(k,1647) = lu(k,1647) - lu(k,1198) * lu(k,1646) + lu(k,1648) = lu(k,1648) - lu(k,1199) * lu(k,1646) + lu(k,1649) = lu(k,1649) - lu(k,1200) * lu(k,1646) + lu(k,1650) = lu(k,1650) - lu(k,1201) * lu(k,1646) + lu(k,1651) = lu(k,1651) - lu(k,1202) * lu(k,1646) + lu(k,1652) = lu(k,1652) - lu(k,1203) * lu(k,1646) + lu(k,1653) = lu(k,1653) - lu(k,1204) * lu(k,1646) + lu(k,1654) = lu(k,1654) - lu(k,1205) * lu(k,1646) + lu(k,1655) = lu(k,1655) - lu(k,1206) * lu(k,1646) + lu(k,1656) = lu(k,1656) - lu(k,1207) * lu(k,1646) + lu(k,1657) = lu(k,1657) - lu(k,1208) * lu(k,1646) + lu(k,1658) = lu(k,1658) - lu(k,1209) * lu(k,1646) + lu(k,1659) = lu(k,1659) - lu(k,1210) * lu(k,1646) + lu(k,1660) = lu(k,1660) - lu(k,1211) * lu(k,1646) + lu(k,1661) = lu(k,1661) - lu(k,1212) * lu(k,1646) + lu(k,1662) = lu(k,1662) - lu(k,1213) * lu(k,1646) + lu(k,1663) = lu(k,1663) - lu(k,1214) * lu(k,1646) + lu(k,1664) = lu(k,1664) - lu(k,1215) * lu(k,1646) + lu(k,1665) = lu(k,1665) - lu(k,1216) * lu(k,1646) + lu(k,1666) = lu(k,1666) - lu(k,1217) * lu(k,1646) + lu(k,1690) = lu(k,1690) - lu(k,1198) * lu(k,1689) + lu(k,1691) = lu(k,1691) - lu(k,1199) * lu(k,1689) + lu(k,1692) = lu(k,1692) - lu(k,1200) * lu(k,1689) + lu(k,1693) = lu(k,1693) - lu(k,1201) * lu(k,1689) + lu(k,1694) = lu(k,1694) - lu(k,1202) * lu(k,1689) + lu(k,1695) = lu(k,1695) - lu(k,1203) * lu(k,1689) + lu(k,1696) = lu(k,1696) - lu(k,1204) * lu(k,1689) + lu(k,1697) = lu(k,1697) - lu(k,1205) * lu(k,1689) + lu(k,1698) = lu(k,1698) - lu(k,1206) * lu(k,1689) + lu(k,1699) = lu(k,1699) - lu(k,1207) * lu(k,1689) + lu(k,1700) = lu(k,1700) - lu(k,1208) * lu(k,1689) + lu(k,1701) = lu(k,1701) - lu(k,1209) * lu(k,1689) + lu(k,1702) = lu(k,1702) - lu(k,1210) * lu(k,1689) + lu(k,1703) = lu(k,1703) - lu(k,1211) * lu(k,1689) + lu(k,1704) = lu(k,1704) - lu(k,1212) * lu(k,1689) + lu(k,1705) = lu(k,1705) - lu(k,1213) * lu(k,1689) + lu(k,1706) = lu(k,1706) - lu(k,1214) * lu(k,1689) + lu(k,1707) = lu(k,1707) - lu(k,1215) * lu(k,1689) + lu(k,1708) = lu(k,1708) - lu(k,1216) * lu(k,1689) + lu(k,1709) = lu(k,1709) - lu(k,1217) * lu(k,1689) + lu(k,1730) = lu(k,1730) - lu(k,1198) * lu(k,1729) + lu(k,1731) = lu(k,1731) - lu(k,1199) * lu(k,1729) + lu(k,1732) = lu(k,1732) - lu(k,1200) * lu(k,1729) + lu(k,1733) = lu(k,1733) - lu(k,1201) * lu(k,1729) + lu(k,1734) = lu(k,1734) - lu(k,1202) * lu(k,1729) + lu(k,1735) = lu(k,1735) - lu(k,1203) * lu(k,1729) + lu(k,1736) = lu(k,1736) - lu(k,1204) * lu(k,1729) + lu(k,1737) = lu(k,1737) - lu(k,1205) * lu(k,1729) + lu(k,1738) = lu(k,1738) - lu(k,1206) * lu(k,1729) + lu(k,1739) = lu(k,1739) - lu(k,1207) * lu(k,1729) + lu(k,1740) = lu(k,1740) - lu(k,1208) * lu(k,1729) + lu(k,1741) = lu(k,1741) - lu(k,1209) * lu(k,1729) + lu(k,1742) = lu(k,1742) - lu(k,1210) * lu(k,1729) + lu(k,1743) = lu(k,1743) - lu(k,1211) * lu(k,1729) + lu(k,1744) = lu(k,1744) - lu(k,1212) * lu(k,1729) + lu(k,1745) = lu(k,1745) - lu(k,1213) * lu(k,1729) + lu(k,1746) = lu(k,1746) - lu(k,1214) * lu(k,1729) + lu(k,1747) = lu(k,1747) - lu(k,1215) * lu(k,1729) + lu(k,1748) = lu(k,1748) - lu(k,1216) * lu(k,1729) + lu(k,1749) = lu(k,1749) - lu(k,1217) * lu(k,1729) + lu(k,1766) = lu(k,1766) - lu(k,1198) * lu(k,1765) + lu(k,1767) = lu(k,1767) - lu(k,1199) * lu(k,1765) + lu(k,1768) = lu(k,1768) - lu(k,1200) * lu(k,1765) + lu(k,1769) = lu(k,1769) - lu(k,1201) * lu(k,1765) + lu(k,1770) = lu(k,1770) - lu(k,1202) * lu(k,1765) + lu(k,1771) = lu(k,1771) - lu(k,1203) * lu(k,1765) + lu(k,1772) = lu(k,1772) - lu(k,1204) * lu(k,1765) + lu(k,1773) = lu(k,1773) - lu(k,1205) * lu(k,1765) + lu(k,1774) = lu(k,1774) - lu(k,1206) * lu(k,1765) + lu(k,1775) = lu(k,1775) - lu(k,1207) * lu(k,1765) + lu(k,1776) = lu(k,1776) - lu(k,1208) * lu(k,1765) + lu(k,1777) = lu(k,1777) - lu(k,1209) * lu(k,1765) + lu(k,1778) = lu(k,1778) - lu(k,1210) * lu(k,1765) + lu(k,1779) = lu(k,1779) - lu(k,1211) * lu(k,1765) + lu(k,1780) = lu(k,1780) - lu(k,1212) * lu(k,1765) + lu(k,1781) = lu(k,1781) - lu(k,1213) * lu(k,1765) + lu(k,1782) = lu(k,1782) - lu(k,1214) * lu(k,1765) + lu(k,1783) = lu(k,1783) - lu(k,1215) * lu(k,1765) + lu(k,1784) = lu(k,1784) - lu(k,1216) * lu(k,1765) + lu(k,1785) = lu(k,1785) - lu(k,1217) * lu(k,1765) + lu(k,1814) = lu(k,1814) - lu(k,1198) * lu(k,1813) + lu(k,1815) = lu(k,1815) - lu(k,1199) * lu(k,1813) + lu(k,1816) = lu(k,1816) - lu(k,1200) * lu(k,1813) + lu(k,1817) = lu(k,1817) - lu(k,1201) * lu(k,1813) + lu(k,1818) = lu(k,1818) - lu(k,1202) * lu(k,1813) + lu(k,1819) = lu(k,1819) - lu(k,1203) * lu(k,1813) + lu(k,1820) = lu(k,1820) - lu(k,1204) * lu(k,1813) + lu(k,1821) = lu(k,1821) - lu(k,1205) * lu(k,1813) + lu(k,1822) = lu(k,1822) - lu(k,1206) * lu(k,1813) + lu(k,1823) = lu(k,1823) - lu(k,1207) * lu(k,1813) + lu(k,1824) = lu(k,1824) - lu(k,1208) * lu(k,1813) + lu(k,1825) = lu(k,1825) - lu(k,1209) * lu(k,1813) + lu(k,1826) = lu(k,1826) - lu(k,1210) * lu(k,1813) + lu(k,1827) = lu(k,1827) - lu(k,1211) * lu(k,1813) + lu(k,1828) = lu(k,1828) - lu(k,1212) * lu(k,1813) + lu(k,1829) = lu(k,1829) - lu(k,1213) * lu(k,1813) + lu(k,1830) = lu(k,1830) - lu(k,1214) * lu(k,1813) + lu(k,1831) = lu(k,1831) - lu(k,1215) * lu(k,1813) + lu(k,1832) = lu(k,1832) - lu(k,1216) * lu(k,1813) + lu(k,1833) = lu(k,1833) - lu(k,1217) * lu(k,1813) + lu(k,1847) = lu(k,1847) - lu(k,1198) * lu(k,1846) + lu(k,1848) = lu(k,1848) - lu(k,1199) * lu(k,1846) + lu(k,1849) = lu(k,1849) - lu(k,1200) * lu(k,1846) + lu(k,1850) = lu(k,1850) - lu(k,1201) * lu(k,1846) + lu(k,1851) = lu(k,1851) - lu(k,1202) * lu(k,1846) + lu(k,1852) = lu(k,1852) - lu(k,1203) * lu(k,1846) + lu(k,1853) = lu(k,1853) - lu(k,1204) * lu(k,1846) + lu(k,1854) = lu(k,1854) - lu(k,1205) * lu(k,1846) + lu(k,1855) = lu(k,1855) - lu(k,1206) * lu(k,1846) + lu(k,1856) = lu(k,1856) - lu(k,1207) * lu(k,1846) + lu(k,1857) = lu(k,1857) - lu(k,1208) * lu(k,1846) + lu(k,1858) = lu(k,1858) - lu(k,1209) * lu(k,1846) + lu(k,1859) = lu(k,1859) - lu(k,1210) * lu(k,1846) + lu(k,1860) = lu(k,1860) - lu(k,1211) * lu(k,1846) + lu(k,1861) = lu(k,1861) - lu(k,1212) * lu(k,1846) + lu(k,1862) = lu(k,1862) - lu(k,1213) * lu(k,1846) + lu(k,1863) = lu(k,1863) - lu(k,1214) * lu(k,1846) + lu(k,1864) = lu(k,1864) - lu(k,1215) * lu(k,1846) + lu(k,1865) = lu(k,1865) - lu(k,1216) * lu(k,1846) + lu(k,1866) = lu(k,1866) - lu(k,1217) * lu(k,1846) + lu(k,1883) = lu(k,1883) - lu(k,1198) * lu(k,1882) + lu(k,1884) = lu(k,1884) - lu(k,1199) * lu(k,1882) + lu(k,1885) = lu(k,1885) - lu(k,1200) * lu(k,1882) + lu(k,1886) = lu(k,1886) - lu(k,1201) * lu(k,1882) + lu(k,1887) = lu(k,1887) - lu(k,1202) * lu(k,1882) + lu(k,1888) = lu(k,1888) - lu(k,1203) * lu(k,1882) + lu(k,1889) = lu(k,1889) - lu(k,1204) * lu(k,1882) + lu(k,1890) = lu(k,1890) - lu(k,1205) * lu(k,1882) + lu(k,1891) = lu(k,1891) - lu(k,1206) * lu(k,1882) + lu(k,1892) = lu(k,1892) - lu(k,1207) * lu(k,1882) + lu(k,1893) = lu(k,1893) - lu(k,1208) * lu(k,1882) + lu(k,1894) = lu(k,1894) - lu(k,1209) * lu(k,1882) + lu(k,1895) = lu(k,1895) - lu(k,1210) * lu(k,1882) + lu(k,1896) = lu(k,1896) - lu(k,1211) * lu(k,1882) + lu(k,1897) = lu(k,1897) - lu(k,1212) * lu(k,1882) + lu(k,1898) = lu(k,1898) - lu(k,1213) * lu(k,1882) + lu(k,1899) = lu(k,1899) - lu(k,1214) * lu(k,1882) + lu(k,1900) = lu(k,1900) - lu(k,1215) * lu(k,1882) + lu(k,1901) = lu(k,1901) - lu(k,1216) * lu(k,1882) + lu(k,1902) = lu(k,1902) - lu(k,1217) * lu(k,1882) + lu(k,1924) = lu(k,1924) - lu(k,1198) * lu(k,1923) + lu(k,1925) = lu(k,1925) - lu(k,1199) * lu(k,1923) + lu(k,1926) = lu(k,1926) - lu(k,1200) * lu(k,1923) + lu(k,1927) = lu(k,1927) - lu(k,1201) * lu(k,1923) + lu(k,1928) = lu(k,1928) - lu(k,1202) * lu(k,1923) + lu(k,1929) = lu(k,1929) - lu(k,1203) * lu(k,1923) + lu(k,1930) = lu(k,1930) - lu(k,1204) * lu(k,1923) + lu(k,1931) = lu(k,1931) - lu(k,1205) * lu(k,1923) + lu(k,1932) = lu(k,1932) - lu(k,1206) * lu(k,1923) + lu(k,1933) = lu(k,1933) - lu(k,1207) * lu(k,1923) + lu(k,1934) = lu(k,1934) - lu(k,1208) * lu(k,1923) + lu(k,1935) = lu(k,1935) - lu(k,1209) * lu(k,1923) + lu(k,1936) = lu(k,1936) - lu(k,1210) * lu(k,1923) + lu(k,1937) = lu(k,1937) - lu(k,1211) * lu(k,1923) + lu(k,1938) = lu(k,1938) - lu(k,1212) * lu(k,1923) + lu(k,1939) = lu(k,1939) - lu(k,1213) * lu(k,1923) + lu(k,1940) = lu(k,1940) - lu(k,1214) * lu(k,1923) + lu(k,1941) = lu(k,1941) - lu(k,1215) * lu(k,1923) + lu(k,1942) = lu(k,1942) - lu(k,1216) * lu(k,1923) + lu(k,1943) = lu(k,1943) - lu(k,1217) * lu(k,1923) + lu(k,1966) = lu(k,1966) - lu(k,1198) * lu(k,1965) + lu(k,1967) = lu(k,1967) - lu(k,1199) * lu(k,1965) + lu(k,1968) = lu(k,1968) - lu(k,1200) * lu(k,1965) + lu(k,1969) = lu(k,1969) - lu(k,1201) * lu(k,1965) + lu(k,1970) = lu(k,1970) - lu(k,1202) * lu(k,1965) + lu(k,1971) = lu(k,1971) - lu(k,1203) * lu(k,1965) + lu(k,1972) = lu(k,1972) - lu(k,1204) * lu(k,1965) + lu(k,1973) = lu(k,1973) - lu(k,1205) * lu(k,1965) + lu(k,1974) = lu(k,1974) - lu(k,1206) * lu(k,1965) + lu(k,1975) = lu(k,1975) - lu(k,1207) * lu(k,1965) + lu(k,1976) = lu(k,1976) - lu(k,1208) * lu(k,1965) + lu(k,1977) = lu(k,1977) - lu(k,1209) * lu(k,1965) + lu(k,1978) = lu(k,1978) - lu(k,1210) * lu(k,1965) + lu(k,1979) = lu(k,1979) - lu(k,1211) * lu(k,1965) + lu(k,1980) = lu(k,1980) - lu(k,1212) * lu(k,1965) + lu(k,1981) = lu(k,1981) - lu(k,1213) * lu(k,1965) + lu(k,1982) = lu(k,1982) - lu(k,1214) * lu(k,1965) + lu(k,1983) = lu(k,1983) - lu(k,1215) * lu(k,1965) + lu(k,1984) = lu(k,1984) - lu(k,1216) * lu(k,1965) + lu(k,1985) = lu(k,1985) - lu(k,1217) * lu(k,1965) + lu(k,2011) = lu(k,2011) - lu(k,1198) * lu(k,2010) + lu(k,2012) = lu(k,2012) - lu(k,1199) * lu(k,2010) + lu(k,2013) = lu(k,2013) - lu(k,1200) * lu(k,2010) + lu(k,2014) = lu(k,2014) - lu(k,1201) * lu(k,2010) + lu(k,2015) = lu(k,2015) - lu(k,1202) * lu(k,2010) + lu(k,2016) = lu(k,2016) - lu(k,1203) * lu(k,2010) + lu(k,2017) = lu(k,2017) - lu(k,1204) * lu(k,2010) + lu(k,2018) = lu(k,2018) - lu(k,1205) * lu(k,2010) + lu(k,2019) = lu(k,2019) - lu(k,1206) * lu(k,2010) + lu(k,2020) = lu(k,2020) - lu(k,1207) * lu(k,2010) + lu(k,2021) = lu(k,2021) - lu(k,1208) * lu(k,2010) + lu(k,2022) = lu(k,2022) - lu(k,1209) * lu(k,2010) + lu(k,2023) = lu(k,2023) - lu(k,1210) * lu(k,2010) + lu(k,2024) = lu(k,2024) - lu(k,1211) * lu(k,2010) + lu(k,2025) = lu(k,2025) - lu(k,1212) * lu(k,2010) + lu(k,2026) = lu(k,2026) - lu(k,1213) * lu(k,2010) + lu(k,2027) = lu(k,2027) - lu(k,1214) * lu(k,2010) + lu(k,2028) = lu(k,2028) - lu(k,1215) * lu(k,2010) + lu(k,2029) = lu(k,2029) - lu(k,1216) * lu(k,2010) + lu(k,2030) = lu(k,2030) - lu(k,1217) * lu(k,2010) + lu(k,2071) = lu(k,2071) - lu(k,1198) * lu(k,2070) + lu(k,2072) = lu(k,2072) - lu(k,1199) * lu(k,2070) + lu(k,2073) = lu(k,2073) - lu(k,1200) * lu(k,2070) + lu(k,2074) = lu(k,2074) - lu(k,1201) * lu(k,2070) + lu(k,2075) = lu(k,2075) - lu(k,1202) * lu(k,2070) + lu(k,2076) = lu(k,2076) - lu(k,1203) * lu(k,2070) + lu(k,2077) = lu(k,2077) - lu(k,1204) * lu(k,2070) + lu(k,2078) = lu(k,2078) - lu(k,1205) * lu(k,2070) + lu(k,2079) = lu(k,2079) - lu(k,1206) * lu(k,2070) + lu(k,2080) = lu(k,2080) - lu(k,1207) * lu(k,2070) + lu(k,2081) = lu(k,2081) - lu(k,1208) * lu(k,2070) + lu(k,2082) = lu(k,2082) - lu(k,1209) * lu(k,2070) + lu(k,2083) = lu(k,2083) - lu(k,1210) * lu(k,2070) + lu(k,2084) = lu(k,2084) - lu(k,1211) * lu(k,2070) + lu(k,2085) = lu(k,2085) - lu(k,1212) * lu(k,2070) + lu(k,2086) = lu(k,2086) - lu(k,1213) * lu(k,2070) + lu(k,2087) = lu(k,2087) - lu(k,1214) * lu(k,2070) + lu(k,2088) = lu(k,2088) - lu(k,1215) * lu(k,2070) + lu(k,2089) = lu(k,2089) - lu(k,1216) * lu(k,2070) + lu(k,2090) = lu(k,2090) - lu(k,1217) * lu(k,2070) + end do + end subroutine lu_fac22 + subroutine lu_fac23( 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,1241) = 1._r8 / lu(k,1241) + lu(k,1242) = lu(k,1242) * lu(k,1241) + lu(k,1243) = lu(k,1243) * lu(k,1241) + lu(k,1244) = lu(k,1244) * lu(k,1241) + lu(k,1245) = lu(k,1245) * lu(k,1241) + lu(k,1246) = lu(k,1246) * lu(k,1241) + lu(k,1247) = lu(k,1247) * lu(k,1241) + lu(k,1248) = lu(k,1248) * lu(k,1241) + lu(k,1249) = lu(k,1249) * lu(k,1241) + lu(k,1250) = lu(k,1250) * lu(k,1241) + lu(k,1251) = lu(k,1251) * lu(k,1241) + lu(k,1252) = lu(k,1252) * lu(k,1241) + lu(k,1253) = lu(k,1253) * lu(k,1241) + lu(k,1254) = lu(k,1254) * lu(k,1241) + lu(k,1255) = lu(k,1255) * lu(k,1241) + lu(k,1256) = lu(k,1256) * lu(k,1241) + lu(k,1257) = lu(k,1257) * lu(k,1241) + lu(k,1258) = lu(k,1258) * lu(k,1241) + lu(k,1259) = lu(k,1259) * lu(k,1241) + lu(k,1260) = lu(k,1260) * lu(k,1241) + lu(k,1284) = lu(k,1284) - lu(k,1242) * lu(k,1283) + lu(k,1285) = lu(k,1285) - lu(k,1243) * lu(k,1283) + lu(k,1286) = lu(k,1286) - lu(k,1244) * lu(k,1283) + lu(k,1287) = lu(k,1287) - lu(k,1245) * lu(k,1283) + lu(k,1288) = lu(k,1288) - lu(k,1246) * lu(k,1283) + lu(k,1289) = lu(k,1289) - lu(k,1247) * lu(k,1283) + lu(k,1290) = lu(k,1290) - lu(k,1248) * lu(k,1283) + lu(k,1291) = lu(k,1291) - lu(k,1249) * lu(k,1283) + lu(k,1292) = lu(k,1292) - lu(k,1250) * lu(k,1283) + lu(k,1293) = lu(k,1293) - lu(k,1251) * lu(k,1283) + lu(k,1294) = lu(k,1294) - lu(k,1252) * lu(k,1283) + lu(k,1295) = lu(k,1295) - lu(k,1253) * lu(k,1283) + lu(k,1296) = lu(k,1296) - lu(k,1254) * lu(k,1283) + lu(k,1297) = lu(k,1297) - lu(k,1255) * lu(k,1283) + lu(k,1298) = lu(k,1298) - lu(k,1256) * lu(k,1283) + lu(k,1299) = lu(k,1299) - lu(k,1257) * lu(k,1283) + lu(k,1300) = lu(k,1300) - lu(k,1258) * lu(k,1283) + lu(k,1301) = lu(k,1301) - lu(k,1259) * lu(k,1283) + lu(k,1302) = lu(k,1302) - lu(k,1260) * lu(k,1283) + lu(k,1326) = lu(k,1326) - lu(k,1242) * lu(k,1325) + lu(k,1327) = lu(k,1327) - lu(k,1243) * lu(k,1325) + lu(k,1328) = lu(k,1328) - lu(k,1244) * lu(k,1325) + lu(k,1329) = lu(k,1329) - lu(k,1245) * lu(k,1325) + lu(k,1330) = lu(k,1330) - lu(k,1246) * lu(k,1325) + lu(k,1331) = lu(k,1331) - lu(k,1247) * lu(k,1325) + lu(k,1332) = lu(k,1332) - lu(k,1248) * lu(k,1325) + lu(k,1333) = lu(k,1333) - lu(k,1249) * lu(k,1325) + lu(k,1334) = lu(k,1334) - lu(k,1250) * lu(k,1325) + lu(k,1335) = lu(k,1335) - lu(k,1251) * lu(k,1325) + lu(k,1336) = lu(k,1336) - lu(k,1252) * lu(k,1325) + lu(k,1337) = lu(k,1337) - lu(k,1253) * lu(k,1325) + lu(k,1338) = lu(k,1338) - lu(k,1254) * lu(k,1325) + lu(k,1339) = lu(k,1339) - lu(k,1255) * lu(k,1325) + lu(k,1340) = lu(k,1340) - lu(k,1256) * lu(k,1325) + lu(k,1341) = lu(k,1341) - lu(k,1257) * lu(k,1325) + lu(k,1342) = lu(k,1342) - lu(k,1258) * lu(k,1325) + lu(k,1343) = lu(k,1343) - lu(k,1259) * lu(k,1325) + lu(k,1344) = lu(k,1344) - lu(k,1260) * lu(k,1325) + lu(k,1386) = lu(k,1386) - lu(k,1242) * lu(k,1385) + lu(k,1387) = lu(k,1387) - lu(k,1243) * lu(k,1385) + lu(k,1388) = lu(k,1388) - lu(k,1244) * lu(k,1385) + lu(k,1389) = lu(k,1389) - lu(k,1245) * lu(k,1385) + lu(k,1390) = lu(k,1390) - lu(k,1246) * lu(k,1385) + lu(k,1391) = lu(k,1391) - lu(k,1247) * lu(k,1385) + lu(k,1392) = lu(k,1392) - lu(k,1248) * lu(k,1385) + lu(k,1393) = lu(k,1393) - lu(k,1249) * lu(k,1385) + lu(k,1394) = lu(k,1394) - lu(k,1250) * lu(k,1385) + lu(k,1395) = lu(k,1395) - lu(k,1251) * lu(k,1385) + lu(k,1396) = lu(k,1396) - lu(k,1252) * lu(k,1385) + lu(k,1397) = lu(k,1397) - lu(k,1253) * lu(k,1385) + lu(k,1398) = lu(k,1398) - lu(k,1254) * lu(k,1385) + lu(k,1399) = lu(k,1399) - lu(k,1255) * lu(k,1385) + lu(k,1400) = lu(k,1400) - lu(k,1256) * lu(k,1385) + lu(k,1401) = lu(k,1401) - lu(k,1257) * lu(k,1385) + lu(k,1402) = lu(k,1402) - lu(k,1258) * lu(k,1385) + lu(k,1403) = lu(k,1403) - lu(k,1259) * lu(k,1385) + lu(k,1404) = lu(k,1404) - lu(k,1260) * lu(k,1385) + lu(k,1435) = lu(k,1435) - lu(k,1242) * lu(k,1434) + lu(k,1436) = lu(k,1436) - lu(k,1243) * lu(k,1434) + lu(k,1437) = lu(k,1437) - lu(k,1244) * lu(k,1434) + lu(k,1438) = lu(k,1438) - lu(k,1245) * lu(k,1434) + lu(k,1439) = lu(k,1439) - lu(k,1246) * lu(k,1434) + lu(k,1440) = lu(k,1440) - lu(k,1247) * lu(k,1434) + lu(k,1441) = lu(k,1441) - lu(k,1248) * lu(k,1434) + lu(k,1442) = lu(k,1442) - lu(k,1249) * lu(k,1434) + lu(k,1443) = lu(k,1443) - lu(k,1250) * lu(k,1434) + lu(k,1444) = lu(k,1444) - lu(k,1251) * lu(k,1434) + lu(k,1445) = lu(k,1445) - lu(k,1252) * lu(k,1434) + lu(k,1446) = lu(k,1446) - lu(k,1253) * lu(k,1434) + lu(k,1447) = lu(k,1447) - lu(k,1254) * lu(k,1434) + lu(k,1448) = lu(k,1448) - lu(k,1255) * lu(k,1434) + lu(k,1449) = lu(k,1449) - lu(k,1256) * lu(k,1434) + lu(k,1450) = lu(k,1450) - lu(k,1257) * lu(k,1434) + lu(k,1451) = lu(k,1451) - lu(k,1258) * lu(k,1434) + lu(k,1452) = lu(k,1452) - lu(k,1259) * lu(k,1434) + lu(k,1453) = lu(k,1453) - lu(k,1260) * lu(k,1434) + lu(k,1483) = lu(k,1483) - lu(k,1242) * lu(k,1482) + lu(k,1484) = lu(k,1484) - lu(k,1243) * lu(k,1482) + lu(k,1485) = lu(k,1485) - lu(k,1244) * lu(k,1482) + lu(k,1486) = lu(k,1486) - lu(k,1245) * lu(k,1482) + lu(k,1487) = lu(k,1487) - lu(k,1246) * lu(k,1482) + lu(k,1488) = lu(k,1488) - lu(k,1247) * lu(k,1482) + lu(k,1489) = lu(k,1489) - lu(k,1248) * lu(k,1482) + lu(k,1490) = lu(k,1490) - lu(k,1249) * lu(k,1482) + lu(k,1491) = lu(k,1491) - lu(k,1250) * lu(k,1482) + lu(k,1492) = lu(k,1492) - lu(k,1251) * lu(k,1482) + lu(k,1493) = lu(k,1493) - lu(k,1252) * lu(k,1482) + lu(k,1494) = lu(k,1494) - lu(k,1253) * lu(k,1482) + lu(k,1495) = lu(k,1495) - lu(k,1254) * lu(k,1482) + lu(k,1496) = lu(k,1496) - lu(k,1255) * lu(k,1482) + lu(k,1497) = lu(k,1497) - lu(k,1256) * lu(k,1482) + lu(k,1498) = lu(k,1498) - lu(k,1257) * lu(k,1482) + lu(k,1499) = lu(k,1499) - lu(k,1258) * lu(k,1482) + lu(k,1500) = lu(k,1500) - lu(k,1259) * lu(k,1482) + lu(k,1501) = lu(k,1501) - lu(k,1260) * lu(k,1482) + lu(k,1524) = lu(k,1524) - lu(k,1242) * lu(k,1523) + lu(k,1525) = lu(k,1525) - lu(k,1243) * lu(k,1523) + lu(k,1526) = lu(k,1526) - lu(k,1244) * lu(k,1523) + lu(k,1527) = lu(k,1527) - lu(k,1245) * lu(k,1523) + lu(k,1528) = lu(k,1528) - lu(k,1246) * lu(k,1523) + lu(k,1529) = lu(k,1529) - lu(k,1247) * lu(k,1523) + lu(k,1530) = lu(k,1530) - lu(k,1248) * lu(k,1523) + lu(k,1531) = lu(k,1531) - lu(k,1249) * lu(k,1523) + lu(k,1532) = lu(k,1532) - lu(k,1250) * lu(k,1523) + lu(k,1533) = lu(k,1533) - lu(k,1251) * lu(k,1523) + lu(k,1534) = lu(k,1534) - lu(k,1252) * lu(k,1523) + lu(k,1535) = lu(k,1535) - lu(k,1253) * lu(k,1523) + lu(k,1536) = lu(k,1536) - lu(k,1254) * lu(k,1523) + lu(k,1537) = lu(k,1537) - lu(k,1255) * lu(k,1523) + lu(k,1538) = lu(k,1538) - lu(k,1256) * lu(k,1523) + lu(k,1539) = lu(k,1539) - lu(k,1257) * lu(k,1523) + lu(k,1540) = lu(k,1540) - lu(k,1258) * lu(k,1523) + lu(k,1541) = lu(k,1541) - lu(k,1259) * lu(k,1523) + lu(k,1542) = lu(k,1542) - lu(k,1260) * lu(k,1523) + lu(k,1560) = lu(k,1560) - lu(k,1242) * lu(k,1559) + lu(k,1561) = lu(k,1561) - lu(k,1243) * lu(k,1559) + lu(k,1562) = lu(k,1562) - lu(k,1244) * lu(k,1559) + lu(k,1563) = lu(k,1563) - lu(k,1245) * lu(k,1559) + lu(k,1564) = lu(k,1564) - lu(k,1246) * lu(k,1559) + lu(k,1565) = lu(k,1565) - lu(k,1247) * lu(k,1559) + lu(k,1566) = lu(k,1566) - lu(k,1248) * lu(k,1559) + lu(k,1567) = lu(k,1567) - lu(k,1249) * lu(k,1559) + lu(k,1568) = lu(k,1568) - lu(k,1250) * lu(k,1559) + lu(k,1569) = lu(k,1569) - lu(k,1251) * lu(k,1559) + lu(k,1570) = lu(k,1570) - lu(k,1252) * lu(k,1559) + lu(k,1571) = lu(k,1571) - lu(k,1253) * lu(k,1559) + lu(k,1572) = lu(k,1572) - lu(k,1254) * lu(k,1559) + lu(k,1573) = lu(k,1573) - lu(k,1255) * lu(k,1559) + lu(k,1574) = lu(k,1574) - lu(k,1256) * lu(k,1559) + lu(k,1575) = lu(k,1575) - lu(k,1257) * lu(k,1559) + lu(k,1576) = lu(k,1576) - lu(k,1258) * lu(k,1559) + lu(k,1577) = lu(k,1577) - lu(k,1259) * lu(k,1559) + lu(k,1578) = lu(k,1578) - lu(k,1260) * lu(k,1559) + lu(k,1605) = lu(k,1605) - lu(k,1242) * lu(k,1604) + lu(k,1606) = lu(k,1606) - lu(k,1243) * lu(k,1604) + lu(k,1607) = lu(k,1607) - lu(k,1244) * lu(k,1604) + lu(k,1608) = lu(k,1608) - lu(k,1245) * lu(k,1604) + lu(k,1609) = lu(k,1609) - lu(k,1246) * lu(k,1604) + lu(k,1610) = lu(k,1610) - lu(k,1247) * lu(k,1604) + lu(k,1611) = lu(k,1611) - lu(k,1248) * lu(k,1604) + lu(k,1612) = lu(k,1612) - lu(k,1249) * lu(k,1604) + lu(k,1613) = lu(k,1613) - lu(k,1250) * lu(k,1604) + lu(k,1614) = lu(k,1614) - lu(k,1251) * lu(k,1604) + lu(k,1615) = lu(k,1615) - lu(k,1252) * lu(k,1604) + lu(k,1616) = lu(k,1616) - lu(k,1253) * lu(k,1604) + lu(k,1617) = lu(k,1617) - lu(k,1254) * lu(k,1604) + lu(k,1618) = lu(k,1618) - lu(k,1255) * lu(k,1604) + lu(k,1619) = lu(k,1619) - lu(k,1256) * lu(k,1604) + lu(k,1620) = lu(k,1620) - lu(k,1257) * lu(k,1604) + lu(k,1621) = lu(k,1621) - lu(k,1258) * lu(k,1604) + lu(k,1622) = lu(k,1622) - lu(k,1259) * lu(k,1604) + lu(k,1623) = lu(k,1623) - lu(k,1260) * lu(k,1604) + lu(k,1648) = lu(k,1648) - lu(k,1242) * lu(k,1647) + lu(k,1649) = lu(k,1649) - lu(k,1243) * lu(k,1647) + lu(k,1650) = lu(k,1650) - lu(k,1244) * lu(k,1647) + lu(k,1651) = lu(k,1651) - lu(k,1245) * lu(k,1647) + lu(k,1652) = lu(k,1652) - lu(k,1246) * lu(k,1647) + lu(k,1653) = lu(k,1653) - lu(k,1247) * lu(k,1647) + lu(k,1654) = lu(k,1654) - lu(k,1248) * lu(k,1647) + lu(k,1655) = lu(k,1655) - lu(k,1249) * lu(k,1647) + lu(k,1656) = lu(k,1656) - lu(k,1250) * lu(k,1647) + lu(k,1657) = lu(k,1657) - lu(k,1251) * lu(k,1647) + lu(k,1658) = lu(k,1658) - lu(k,1252) * lu(k,1647) + lu(k,1659) = lu(k,1659) - lu(k,1253) * lu(k,1647) + lu(k,1660) = lu(k,1660) - lu(k,1254) * lu(k,1647) + lu(k,1661) = lu(k,1661) - lu(k,1255) * lu(k,1647) + lu(k,1662) = lu(k,1662) - lu(k,1256) * lu(k,1647) + lu(k,1663) = lu(k,1663) - lu(k,1257) * lu(k,1647) + lu(k,1664) = lu(k,1664) - lu(k,1258) * lu(k,1647) + lu(k,1665) = lu(k,1665) - lu(k,1259) * lu(k,1647) + lu(k,1666) = lu(k,1666) - lu(k,1260) * lu(k,1647) + lu(k,1691) = lu(k,1691) - lu(k,1242) * lu(k,1690) + lu(k,1692) = lu(k,1692) - lu(k,1243) * lu(k,1690) + lu(k,1693) = lu(k,1693) - lu(k,1244) * lu(k,1690) + lu(k,1694) = lu(k,1694) - lu(k,1245) * lu(k,1690) + lu(k,1695) = lu(k,1695) - lu(k,1246) * lu(k,1690) + lu(k,1696) = lu(k,1696) - lu(k,1247) * lu(k,1690) + lu(k,1697) = lu(k,1697) - lu(k,1248) * lu(k,1690) + lu(k,1698) = lu(k,1698) - lu(k,1249) * lu(k,1690) + lu(k,1699) = lu(k,1699) - lu(k,1250) * lu(k,1690) + lu(k,1700) = lu(k,1700) - lu(k,1251) * lu(k,1690) + lu(k,1701) = lu(k,1701) - lu(k,1252) * lu(k,1690) + lu(k,1702) = lu(k,1702) - lu(k,1253) * lu(k,1690) + lu(k,1703) = lu(k,1703) - lu(k,1254) * lu(k,1690) + lu(k,1704) = lu(k,1704) - lu(k,1255) * lu(k,1690) + lu(k,1705) = lu(k,1705) - lu(k,1256) * lu(k,1690) + lu(k,1706) = lu(k,1706) - lu(k,1257) * lu(k,1690) + lu(k,1707) = lu(k,1707) - lu(k,1258) * lu(k,1690) + lu(k,1708) = lu(k,1708) - lu(k,1259) * lu(k,1690) + lu(k,1709) = lu(k,1709) - lu(k,1260) * lu(k,1690) + lu(k,1731) = lu(k,1731) - lu(k,1242) * lu(k,1730) + lu(k,1732) = lu(k,1732) - lu(k,1243) * lu(k,1730) + lu(k,1733) = lu(k,1733) - lu(k,1244) * lu(k,1730) + lu(k,1734) = lu(k,1734) - lu(k,1245) * lu(k,1730) + lu(k,1735) = lu(k,1735) - lu(k,1246) * lu(k,1730) + lu(k,1736) = lu(k,1736) - lu(k,1247) * lu(k,1730) + lu(k,1737) = lu(k,1737) - lu(k,1248) * lu(k,1730) + lu(k,1738) = lu(k,1738) - lu(k,1249) * lu(k,1730) + lu(k,1739) = lu(k,1739) - lu(k,1250) * lu(k,1730) + lu(k,1740) = lu(k,1740) - lu(k,1251) * lu(k,1730) + lu(k,1741) = lu(k,1741) - lu(k,1252) * lu(k,1730) + lu(k,1742) = lu(k,1742) - lu(k,1253) * lu(k,1730) + lu(k,1743) = lu(k,1743) - lu(k,1254) * lu(k,1730) + lu(k,1744) = lu(k,1744) - lu(k,1255) * lu(k,1730) + lu(k,1745) = lu(k,1745) - lu(k,1256) * lu(k,1730) + lu(k,1746) = lu(k,1746) - lu(k,1257) * lu(k,1730) + lu(k,1747) = lu(k,1747) - lu(k,1258) * lu(k,1730) + lu(k,1748) = lu(k,1748) - lu(k,1259) * lu(k,1730) + lu(k,1749) = lu(k,1749) - lu(k,1260) * lu(k,1730) + lu(k,1767) = lu(k,1767) - lu(k,1242) * lu(k,1766) + lu(k,1768) = lu(k,1768) - lu(k,1243) * lu(k,1766) + lu(k,1769) = lu(k,1769) - lu(k,1244) * lu(k,1766) + lu(k,1770) = lu(k,1770) - lu(k,1245) * lu(k,1766) + lu(k,1771) = lu(k,1771) - lu(k,1246) * lu(k,1766) + lu(k,1772) = lu(k,1772) - lu(k,1247) * lu(k,1766) + lu(k,1773) = lu(k,1773) - lu(k,1248) * lu(k,1766) + lu(k,1774) = lu(k,1774) - lu(k,1249) * lu(k,1766) + lu(k,1775) = lu(k,1775) - lu(k,1250) * lu(k,1766) + lu(k,1776) = lu(k,1776) - lu(k,1251) * lu(k,1766) + lu(k,1777) = lu(k,1777) - lu(k,1252) * lu(k,1766) + lu(k,1778) = lu(k,1778) - lu(k,1253) * lu(k,1766) + lu(k,1779) = lu(k,1779) - lu(k,1254) * lu(k,1766) + lu(k,1780) = lu(k,1780) - lu(k,1255) * lu(k,1766) + lu(k,1781) = lu(k,1781) - lu(k,1256) * lu(k,1766) + lu(k,1782) = lu(k,1782) - lu(k,1257) * lu(k,1766) + lu(k,1783) = lu(k,1783) - lu(k,1258) * lu(k,1766) + lu(k,1784) = lu(k,1784) - lu(k,1259) * lu(k,1766) + lu(k,1785) = lu(k,1785) - lu(k,1260) * lu(k,1766) + lu(k,1815) = lu(k,1815) - lu(k,1242) * lu(k,1814) + lu(k,1816) = lu(k,1816) - lu(k,1243) * lu(k,1814) + lu(k,1817) = lu(k,1817) - lu(k,1244) * lu(k,1814) + lu(k,1818) = lu(k,1818) - lu(k,1245) * lu(k,1814) + lu(k,1819) = lu(k,1819) - lu(k,1246) * lu(k,1814) + lu(k,1820) = lu(k,1820) - lu(k,1247) * lu(k,1814) + lu(k,1821) = lu(k,1821) - lu(k,1248) * lu(k,1814) + lu(k,1822) = lu(k,1822) - lu(k,1249) * lu(k,1814) + lu(k,1823) = lu(k,1823) - lu(k,1250) * lu(k,1814) + lu(k,1824) = lu(k,1824) - lu(k,1251) * lu(k,1814) + lu(k,1825) = lu(k,1825) - lu(k,1252) * lu(k,1814) + lu(k,1826) = lu(k,1826) - lu(k,1253) * lu(k,1814) + lu(k,1827) = lu(k,1827) - lu(k,1254) * lu(k,1814) + lu(k,1828) = lu(k,1828) - lu(k,1255) * lu(k,1814) + lu(k,1829) = lu(k,1829) - lu(k,1256) * lu(k,1814) + lu(k,1830) = lu(k,1830) - lu(k,1257) * lu(k,1814) + lu(k,1831) = lu(k,1831) - lu(k,1258) * lu(k,1814) + lu(k,1832) = lu(k,1832) - lu(k,1259) * lu(k,1814) + lu(k,1833) = lu(k,1833) - lu(k,1260) * lu(k,1814) + lu(k,1848) = lu(k,1848) - lu(k,1242) * lu(k,1847) + lu(k,1849) = lu(k,1849) - lu(k,1243) * lu(k,1847) + lu(k,1850) = lu(k,1850) - lu(k,1244) * lu(k,1847) + lu(k,1851) = lu(k,1851) - lu(k,1245) * lu(k,1847) + lu(k,1852) = lu(k,1852) - lu(k,1246) * lu(k,1847) + lu(k,1853) = lu(k,1853) - lu(k,1247) * lu(k,1847) + lu(k,1854) = lu(k,1854) - lu(k,1248) * lu(k,1847) + lu(k,1855) = lu(k,1855) - lu(k,1249) * lu(k,1847) + lu(k,1856) = lu(k,1856) - lu(k,1250) * lu(k,1847) + lu(k,1857) = lu(k,1857) - lu(k,1251) * lu(k,1847) + lu(k,1858) = lu(k,1858) - lu(k,1252) * lu(k,1847) + lu(k,1859) = lu(k,1859) - lu(k,1253) * lu(k,1847) + lu(k,1860) = lu(k,1860) - lu(k,1254) * lu(k,1847) + lu(k,1861) = lu(k,1861) - lu(k,1255) * lu(k,1847) + lu(k,1862) = lu(k,1862) - lu(k,1256) * lu(k,1847) + lu(k,1863) = lu(k,1863) - lu(k,1257) * lu(k,1847) + lu(k,1864) = lu(k,1864) - lu(k,1258) * lu(k,1847) + lu(k,1865) = lu(k,1865) - lu(k,1259) * lu(k,1847) + lu(k,1866) = lu(k,1866) - lu(k,1260) * lu(k,1847) + lu(k,1884) = lu(k,1884) - lu(k,1242) * lu(k,1883) + lu(k,1885) = lu(k,1885) - lu(k,1243) * lu(k,1883) + lu(k,1886) = lu(k,1886) - lu(k,1244) * lu(k,1883) + lu(k,1887) = lu(k,1887) - lu(k,1245) * lu(k,1883) + lu(k,1888) = lu(k,1888) - lu(k,1246) * lu(k,1883) + lu(k,1889) = lu(k,1889) - lu(k,1247) * lu(k,1883) + lu(k,1890) = lu(k,1890) - lu(k,1248) * lu(k,1883) + lu(k,1891) = lu(k,1891) - lu(k,1249) * lu(k,1883) + lu(k,1892) = lu(k,1892) - lu(k,1250) * lu(k,1883) + lu(k,1893) = lu(k,1893) - lu(k,1251) * lu(k,1883) + lu(k,1894) = lu(k,1894) - lu(k,1252) * lu(k,1883) + lu(k,1895) = lu(k,1895) - lu(k,1253) * lu(k,1883) + lu(k,1896) = lu(k,1896) - lu(k,1254) * lu(k,1883) + lu(k,1897) = lu(k,1897) - lu(k,1255) * lu(k,1883) + lu(k,1898) = lu(k,1898) - lu(k,1256) * lu(k,1883) + lu(k,1899) = lu(k,1899) - lu(k,1257) * lu(k,1883) + lu(k,1900) = lu(k,1900) - lu(k,1258) * lu(k,1883) + lu(k,1901) = lu(k,1901) - lu(k,1259) * lu(k,1883) + lu(k,1902) = lu(k,1902) - lu(k,1260) * lu(k,1883) + lu(k,1925) = lu(k,1925) - lu(k,1242) * lu(k,1924) + lu(k,1926) = lu(k,1926) - lu(k,1243) * lu(k,1924) + lu(k,1927) = lu(k,1927) - lu(k,1244) * lu(k,1924) + lu(k,1928) = lu(k,1928) - lu(k,1245) * lu(k,1924) + lu(k,1929) = lu(k,1929) - lu(k,1246) * lu(k,1924) + lu(k,1930) = lu(k,1930) - lu(k,1247) * lu(k,1924) + lu(k,1931) = lu(k,1931) - lu(k,1248) * lu(k,1924) + lu(k,1932) = lu(k,1932) - lu(k,1249) * lu(k,1924) + lu(k,1933) = lu(k,1933) - lu(k,1250) * lu(k,1924) + lu(k,1934) = lu(k,1934) - lu(k,1251) * lu(k,1924) + lu(k,1935) = lu(k,1935) - lu(k,1252) * lu(k,1924) + lu(k,1936) = lu(k,1936) - lu(k,1253) * lu(k,1924) + lu(k,1937) = lu(k,1937) - lu(k,1254) * lu(k,1924) + lu(k,1938) = lu(k,1938) - lu(k,1255) * lu(k,1924) + lu(k,1939) = lu(k,1939) - lu(k,1256) * lu(k,1924) + lu(k,1940) = lu(k,1940) - lu(k,1257) * lu(k,1924) + lu(k,1941) = lu(k,1941) - lu(k,1258) * lu(k,1924) + lu(k,1942) = lu(k,1942) - lu(k,1259) * lu(k,1924) + lu(k,1943) = lu(k,1943) - lu(k,1260) * lu(k,1924) + lu(k,1967) = lu(k,1967) - lu(k,1242) * lu(k,1966) + lu(k,1968) = lu(k,1968) - lu(k,1243) * lu(k,1966) + lu(k,1969) = lu(k,1969) - lu(k,1244) * lu(k,1966) + lu(k,1970) = lu(k,1970) - lu(k,1245) * lu(k,1966) + lu(k,1971) = lu(k,1971) - lu(k,1246) * lu(k,1966) + lu(k,1972) = lu(k,1972) - lu(k,1247) * lu(k,1966) + lu(k,1973) = lu(k,1973) - lu(k,1248) * lu(k,1966) + lu(k,1974) = lu(k,1974) - lu(k,1249) * lu(k,1966) + lu(k,1975) = lu(k,1975) - lu(k,1250) * lu(k,1966) + lu(k,1976) = lu(k,1976) - lu(k,1251) * lu(k,1966) + lu(k,1977) = lu(k,1977) - lu(k,1252) * lu(k,1966) + lu(k,1978) = lu(k,1978) - lu(k,1253) * lu(k,1966) + lu(k,1979) = lu(k,1979) - lu(k,1254) * lu(k,1966) + lu(k,1980) = lu(k,1980) - lu(k,1255) * lu(k,1966) + lu(k,1981) = lu(k,1981) - lu(k,1256) * lu(k,1966) + lu(k,1982) = lu(k,1982) - lu(k,1257) * lu(k,1966) + lu(k,1983) = lu(k,1983) - lu(k,1258) * lu(k,1966) + lu(k,1984) = lu(k,1984) - lu(k,1259) * lu(k,1966) + lu(k,1985) = lu(k,1985) - lu(k,1260) * lu(k,1966) + lu(k,2012) = lu(k,2012) - lu(k,1242) * lu(k,2011) + lu(k,2013) = lu(k,2013) - lu(k,1243) * lu(k,2011) + lu(k,2014) = lu(k,2014) - lu(k,1244) * lu(k,2011) + lu(k,2015) = lu(k,2015) - lu(k,1245) * lu(k,2011) + lu(k,2016) = lu(k,2016) - lu(k,1246) * lu(k,2011) + lu(k,2017) = lu(k,2017) - lu(k,1247) * lu(k,2011) + lu(k,2018) = lu(k,2018) - lu(k,1248) * lu(k,2011) + lu(k,2019) = lu(k,2019) - lu(k,1249) * lu(k,2011) + lu(k,2020) = lu(k,2020) - lu(k,1250) * lu(k,2011) + lu(k,2021) = lu(k,2021) - lu(k,1251) * lu(k,2011) + lu(k,2022) = lu(k,2022) - lu(k,1252) * lu(k,2011) + lu(k,2023) = lu(k,2023) - lu(k,1253) * lu(k,2011) + lu(k,2024) = lu(k,2024) - lu(k,1254) * lu(k,2011) + lu(k,2025) = lu(k,2025) - lu(k,1255) * lu(k,2011) + lu(k,2026) = lu(k,2026) - lu(k,1256) * lu(k,2011) + lu(k,2027) = lu(k,2027) - lu(k,1257) * lu(k,2011) + lu(k,2028) = lu(k,2028) - lu(k,1258) * lu(k,2011) + lu(k,2029) = lu(k,2029) - lu(k,1259) * lu(k,2011) + lu(k,2030) = lu(k,2030) - lu(k,1260) * lu(k,2011) + lu(k,2072) = lu(k,2072) - lu(k,1242) * lu(k,2071) + lu(k,2073) = lu(k,2073) - lu(k,1243) * lu(k,2071) + lu(k,2074) = lu(k,2074) - lu(k,1244) * lu(k,2071) + lu(k,2075) = lu(k,2075) - lu(k,1245) * lu(k,2071) + lu(k,2076) = lu(k,2076) - lu(k,1246) * lu(k,2071) + lu(k,2077) = lu(k,2077) - lu(k,1247) * lu(k,2071) + lu(k,2078) = lu(k,2078) - lu(k,1248) * lu(k,2071) + lu(k,2079) = lu(k,2079) - lu(k,1249) * lu(k,2071) + lu(k,2080) = lu(k,2080) - lu(k,1250) * lu(k,2071) + lu(k,2081) = lu(k,2081) - lu(k,1251) * lu(k,2071) + lu(k,2082) = lu(k,2082) - lu(k,1252) * lu(k,2071) + lu(k,2083) = lu(k,2083) - lu(k,1253) * lu(k,2071) + lu(k,2084) = lu(k,2084) - lu(k,1254) * lu(k,2071) + lu(k,2085) = lu(k,2085) - lu(k,1255) * lu(k,2071) + lu(k,2086) = lu(k,2086) - lu(k,1256) * lu(k,2071) + lu(k,2087) = lu(k,2087) - lu(k,1257) * lu(k,2071) + lu(k,2088) = lu(k,2088) - lu(k,1258) * lu(k,2071) + lu(k,2089) = lu(k,2089) - lu(k,1259) * lu(k,2071) + lu(k,2090) = lu(k,2090) - lu(k,1260) * lu(k,2071) + lu(k,1284) = 1._r8 / lu(k,1284) + lu(k,1285) = lu(k,1285) * lu(k,1284) + lu(k,1286) = lu(k,1286) * lu(k,1284) + lu(k,1287) = lu(k,1287) * lu(k,1284) + lu(k,1288) = lu(k,1288) * lu(k,1284) + lu(k,1289) = lu(k,1289) * lu(k,1284) + lu(k,1290) = lu(k,1290) * lu(k,1284) + lu(k,1291) = lu(k,1291) * lu(k,1284) + lu(k,1292) = lu(k,1292) * lu(k,1284) + lu(k,1293) = lu(k,1293) * lu(k,1284) + lu(k,1294) = lu(k,1294) * lu(k,1284) + lu(k,1295) = lu(k,1295) * lu(k,1284) + lu(k,1296) = lu(k,1296) * lu(k,1284) + lu(k,1297) = lu(k,1297) * lu(k,1284) + lu(k,1298) = lu(k,1298) * lu(k,1284) + lu(k,1299) = lu(k,1299) * lu(k,1284) + lu(k,1300) = lu(k,1300) * lu(k,1284) + lu(k,1301) = lu(k,1301) * lu(k,1284) + lu(k,1302) = lu(k,1302) * lu(k,1284) + lu(k,1327) = lu(k,1327) - lu(k,1285) * lu(k,1326) + lu(k,1328) = lu(k,1328) - lu(k,1286) * lu(k,1326) + lu(k,1329) = lu(k,1329) - lu(k,1287) * lu(k,1326) + lu(k,1330) = lu(k,1330) - lu(k,1288) * lu(k,1326) + lu(k,1331) = lu(k,1331) - lu(k,1289) * lu(k,1326) + lu(k,1332) = lu(k,1332) - lu(k,1290) * lu(k,1326) + lu(k,1333) = lu(k,1333) - lu(k,1291) * lu(k,1326) + lu(k,1334) = lu(k,1334) - lu(k,1292) * lu(k,1326) + lu(k,1335) = lu(k,1335) - lu(k,1293) * lu(k,1326) + lu(k,1336) = lu(k,1336) - lu(k,1294) * lu(k,1326) + lu(k,1337) = lu(k,1337) - lu(k,1295) * lu(k,1326) + lu(k,1338) = lu(k,1338) - lu(k,1296) * lu(k,1326) + lu(k,1339) = lu(k,1339) - lu(k,1297) * lu(k,1326) + lu(k,1340) = lu(k,1340) - lu(k,1298) * lu(k,1326) + lu(k,1341) = lu(k,1341) - lu(k,1299) * lu(k,1326) + lu(k,1342) = lu(k,1342) - lu(k,1300) * lu(k,1326) + lu(k,1343) = lu(k,1343) - lu(k,1301) * lu(k,1326) + lu(k,1344) = lu(k,1344) - lu(k,1302) * lu(k,1326) + lu(k,1387) = lu(k,1387) - lu(k,1285) * lu(k,1386) + lu(k,1388) = lu(k,1388) - lu(k,1286) * lu(k,1386) + lu(k,1389) = lu(k,1389) - lu(k,1287) * lu(k,1386) + lu(k,1390) = lu(k,1390) - lu(k,1288) * lu(k,1386) + lu(k,1391) = lu(k,1391) - lu(k,1289) * lu(k,1386) + lu(k,1392) = lu(k,1392) - lu(k,1290) * lu(k,1386) + lu(k,1393) = lu(k,1393) - lu(k,1291) * lu(k,1386) + lu(k,1394) = lu(k,1394) - lu(k,1292) * lu(k,1386) + lu(k,1395) = lu(k,1395) - lu(k,1293) * lu(k,1386) + lu(k,1396) = lu(k,1396) - lu(k,1294) * lu(k,1386) + lu(k,1397) = lu(k,1397) - lu(k,1295) * lu(k,1386) + lu(k,1398) = lu(k,1398) - lu(k,1296) * lu(k,1386) + lu(k,1399) = lu(k,1399) - lu(k,1297) * lu(k,1386) + lu(k,1400) = lu(k,1400) - lu(k,1298) * lu(k,1386) + lu(k,1401) = lu(k,1401) - lu(k,1299) * lu(k,1386) + lu(k,1402) = lu(k,1402) - lu(k,1300) * lu(k,1386) + lu(k,1403) = lu(k,1403) - lu(k,1301) * lu(k,1386) + lu(k,1404) = lu(k,1404) - lu(k,1302) * lu(k,1386) + lu(k,1436) = lu(k,1436) - lu(k,1285) * lu(k,1435) + lu(k,1437) = lu(k,1437) - lu(k,1286) * lu(k,1435) + lu(k,1438) = lu(k,1438) - lu(k,1287) * lu(k,1435) + lu(k,1439) = lu(k,1439) - lu(k,1288) * lu(k,1435) + lu(k,1440) = lu(k,1440) - lu(k,1289) * lu(k,1435) + lu(k,1441) = lu(k,1441) - lu(k,1290) * lu(k,1435) + lu(k,1442) = lu(k,1442) - lu(k,1291) * lu(k,1435) + lu(k,1443) = lu(k,1443) - lu(k,1292) * lu(k,1435) + lu(k,1444) = lu(k,1444) - lu(k,1293) * lu(k,1435) + lu(k,1445) = lu(k,1445) - lu(k,1294) * lu(k,1435) + lu(k,1446) = lu(k,1446) - lu(k,1295) * lu(k,1435) + lu(k,1447) = lu(k,1447) - lu(k,1296) * lu(k,1435) + lu(k,1448) = lu(k,1448) - lu(k,1297) * lu(k,1435) + lu(k,1449) = lu(k,1449) - lu(k,1298) * lu(k,1435) + lu(k,1450) = lu(k,1450) - lu(k,1299) * lu(k,1435) + lu(k,1451) = lu(k,1451) - lu(k,1300) * lu(k,1435) + lu(k,1452) = lu(k,1452) - lu(k,1301) * lu(k,1435) + lu(k,1453) = lu(k,1453) - lu(k,1302) * lu(k,1435) + lu(k,1484) = lu(k,1484) - lu(k,1285) * lu(k,1483) + lu(k,1485) = lu(k,1485) - lu(k,1286) * lu(k,1483) + lu(k,1486) = lu(k,1486) - lu(k,1287) * lu(k,1483) + lu(k,1487) = lu(k,1487) - lu(k,1288) * lu(k,1483) + lu(k,1488) = lu(k,1488) - lu(k,1289) * lu(k,1483) + lu(k,1489) = lu(k,1489) - lu(k,1290) * lu(k,1483) + lu(k,1490) = lu(k,1490) - lu(k,1291) * lu(k,1483) + lu(k,1491) = lu(k,1491) - lu(k,1292) * lu(k,1483) + lu(k,1492) = lu(k,1492) - lu(k,1293) * lu(k,1483) + lu(k,1493) = lu(k,1493) - lu(k,1294) * lu(k,1483) + lu(k,1494) = lu(k,1494) - lu(k,1295) * lu(k,1483) + lu(k,1495) = lu(k,1495) - lu(k,1296) * lu(k,1483) + lu(k,1496) = lu(k,1496) - lu(k,1297) * lu(k,1483) + lu(k,1497) = lu(k,1497) - lu(k,1298) * lu(k,1483) + lu(k,1498) = lu(k,1498) - lu(k,1299) * lu(k,1483) + lu(k,1499) = lu(k,1499) - lu(k,1300) * lu(k,1483) + lu(k,1500) = lu(k,1500) - lu(k,1301) * lu(k,1483) + lu(k,1501) = lu(k,1501) - lu(k,1302) * lu(k,1483) + lu(k,1525) = lu(k,1525) - lu(k,1285) * lu(k,1524) + lu(k,1526) = lu(k,1526) - lu(k,1286) * lu(k,1524) + lu(k,1527) = lu(k,1527) - lu(k,1287) * lu(k,1524) + lu(k,1528) = lu(k,1528) - lu(k,1288) * lu(k,1524) + lu(k,1529) = lu(k,1529) - lu(k,1289) * lu(k,1524) + lu(k,1530) = lu(k,1530) - lu(k,1290) * lu(k,1524) + lu(k,1531) = lu(k,1531) - lu(k,1291) * lu(k,1524) + lu(k,1532) = lu(k,1532) - lu(k,1292) * lu(k,1524) + lu(k,1533) = lu(k,1533) - lu(k,1293) * lu(k,1524) + lu(k,1534) = lu(k,1534) - lu(k,1294) * lu(k,1524) + lu(k,1535) = lu(k,1535) - lu(k,1295) * lu(k,1524) + lu(k,1536) = lu(k,1536) - lu(k,1296) * lu(k,1524) + lu(k,1537) = lu(k,1537) - lu(k,1297) * lu(k,1524) + lu(k,1538) = lu(k,1538) - lu(k,1298) * lu(k,1524) + lu(k,1539) = lu(k,1539) - lu(k,1299) * lu(k,1524) + lu(k,1540) = lu(k,1540) - lu(k,1300) * lu(k,1524) + lu(k,1541) = lu(k,1541) - lu(k,1301) * lu(k,1524) + lu(k,1542) = lu(k,1542) - lu(k,1302) * lu(k,1524) + lu(k,1561) = lu(k,1561) - lu(k,1285) * lu(k,1560) + lu(k,1562) = lu(k,1562) - lu(k,1286) * lu(k,1560) + lu(k,1563) = lu(k,1563) - lu(k,1287) * lu(k,1560) + lu(k,1564) = lu(k,1564) - lu(k,1288) * lu(k,1560) + lu(k,1565) = lu(k,1565) - lu(k,1289) * lu(k,1560) + lu(k,1566) = lu(k,1566) - lu(k,1290) * lu(k,1560) + lu(k,1567) = lu(k,1567) - lu(k,1291) * lu(k,1560) + lu(k,1568) = lu(k,1568) - lu(k,1292) * lu(k,1560) + lu(k,1569) = lu(k,1569) - lu(k,1293) * lu(k,1560) + lu(k,1570) = lu(k,1570) - lu(k,1294) * lu(k,1560) + lu(k,1571) = lu(k,1571) - lu(k,1295) * lu(k,1560) + lu(k,1572) = lu(k,1572) - lu(k,1296) * lu(k,1560) + lu(k,1573) = lu(k,1573) - lu(k,1297) * lu(k,1560) + lu(k,1574) = lu(k,1574) - lu(k,1298) * lu(k,1560) + lu(k,1575) = lu(k,1575) - lu(k,1299) * lu(k,1560) + lu(k,1576) = lu(k,1576) - lu(k,1300) * lu(k,1560) + lu(k,1577) = lu(k,1577) - lu(k,1301) * lu(k,1560) + lu(k,1578) = lu(k,1578) - lu(k,1302) * lu(k,1560) + lu(k,1606) = lu(k,1606) - lu(k,1285) * lu(k,1605) + lu(k,1607) = lu(k,1607) - lu(k,1286) * lu(k,1605) + lu(k,1608) = lu(k,1608) - lu(k,1287) * lu(k,1605) + lu(k,1609) = lu(k,1609) - lu(k,1288) * lu(k,1605) + lu(k,1610) = lu(k,1610) - lu(k,1289) * lu(k,1605) + lu(k,1611) = lu(k,1611) - lu(k,1290) * lu(k,1605) + lu(k,1612) = lu(k,1612) - lu(k,1291) * lu(k,1605) + lu(k,1613) = lu(k,1613) - lu(k,1292) * lu(k,1605) + lu(k,1614) = lu(k,1614) - lu(k,1293) * lu(k,1605) + lu(k,1615) = lu(k,1615) - lu(k,1294) * lu(k,1605) + lu(k,1616) = lu(k,1616) - lu(k,1295) * lu(k,1605) + lu(k,1617) = lu(k,1617) - lu(k,1296) * lu(k,1605) + lu(k,1618) = lu(k,1618) - lu(k,1297) * lu(k,1605) + lu(k,1619) = lu(k,1619) - lu(k,1298) * lu(k,1605) + lu(k,1620) = lu(k,1620) - lu(k,1299) * lu(k,1605) + lu(k,1621) = lu(k,1621) - lu(k,1300) * lu(k,1605) + lu(k,1622) = lu(k,1622) - lu(k,1301) * lu(k,1605) + lu(k,1623) = lu(k,1623) - lu(k,1302) * lu(k,1605) + lu(k,1649) = lu(k,1649) - lu(k,1285) * lu(k,1648) + lu(k,1650) = lu(k,1650) - lu(k,1286) * lu(k,1648) + lu(k,1651) = lu(k,1651) - lu(k,1287) * lu(k,1648) + lu(k,1652) = lu(k,1652) - lu(k,1288) * lu(k,1648) + lu(k,1653) = lu(k,1653) - lu(k,1289) * lu(k,1648) + lu(k,1654) = lu(k,1654) - lu(k,1290) * lu(k,1648) + lu(k,1655) = lu(k,1655) - lu(k,1291) * lu(k,1648) + lu(k,1656) = lu(k,1656) - lu(k,1292) * lu(k,1648) + lu(k,1657) = lu(k,1657) - lu(k,1293) * lu(k,1648) + lu(k,1658) = lu(k,1658) - lu(k,1294) * lu(k,1648) + lu(k,1659) = lu(k,1659) - lu(k,1295) * lu(k,1648) + lu(k,1660) = lu(k,1660) - lu(k,1296) * lu(k,1648) + lu(k,1661) = lu(k,1661) - lu(k,1297) * lu(k,1648) + lu(k,1662) = lu(k,1662) - lu(k,1298) * lu(k,1648) + lu(k,1663) = lu(k,1663) - lu(k,1299) * lu(k,1648) + lu(k,1664) = lu(k,1664) - lu(k,1300) * lu(k,1648) + lu(k,1665) = lu(k,1665) - lu(k,1301) * lu(k,1648) + lu(k,1666) = lu(k,1666) - lu(k,1302) * lu(k,1648) + lu(k,1692) = lu(k,1692) - lu(k,1285) * lu(k,1691) + lu(k,1693) = lu(k,1693) - lu(k,1286) * lu(k,1691) + lu(k,1694) = lu(k,1694) - lu(k,1287) * lu(k,1691) + lu(k,1695) = lu(k,1695) - lu(k,1288) * lu(k,1691) + lu(k,1696) = lu(k,1696) - lu(k,1289) * lu(k,1691) + lu(k,1697) = lu(k,1697) - lu(k,1290) * lu(k,1691) + lu(k,1698) = lu(k,1698) - lu(k,1291) * lu(k,1691) + lu(k,1699) = lu(k,1699) - lu(k,1292) * lu(k,1691) + lu(k,1700) = lu(k,1700) - lu(k,1293) * lu(k,1691) + lu(k,1701) = lu(k,1701) - lu(k,1294) * lu(k,1691) + lu(k,1702) = lu(k,1702) - lu(k,1295) * lu(k,1691) + lu(k,1703) = lu(k,1703) - lu(k,1296) * lu(k,1691) + lu(k,1704) = lu(k,1704) - lu(k,1297) * lu(k,1691) + lu(k,1705) = lu(k,1705) - lu(k,1298) * lu(k,1691) + lu(k,1706) = lu(k,1706) - lu(k,1299) * lu(k,1691) + lu(k,1707) = lu(k,1707) - lu(k,1300) * lu(k,1691) + lu(k,1708) = lu(k,1708) - lu(k,1301) * lu(k,1691) + lu(k,1709) = lu(k,1709) - lu(k,1302) * lu(k,1691) + lu(k,1732) = lu(k,1732) - lu(k,1285) * lu(k,1731) + lu(k,1733) = lu(k,1733) - lu(k,1286) * lu(k,1731) + lu(k,1734) = lu(k,1734) - lu(k,1287) * lu(k,1731) + lu(k,1735) = lu(k,1735) - lu(k,1288) * lu(k,1731) + lu(k,1736) = lu(k,1736) - lu(k,1289) * lu(k,1731) + lu(k,1737) = lu(k,1737) - lu(k,1290) * lu(k,1731) + lu(k,1738) = lu(k,1738) - lu(k,1291) * lu(k,1731) + lu(k,1739) = lu(k,1739) - lu(k,1292) * lu(k,1731) + lu(k,1740) = lu(k,1740) - lu(k,1293) * lu(k,1731) + lu(k,1741) = lu(k,1741) - lu(k,1294) * lu(k,1731) + lu(k,1742) = lu(k,1742) - lu(k,1295) * lu(k,1731) + lu(k,1743) = lu(k,1743) - lu(k,1296) * lu(k,1731) + lu(k,1744) = lu(k,1744) - lu(k,1297) * lu(k,1731) + lu(k,1745) = lu(k,1745) - lu(k,1298) * lu(k,1731) + lu(k,1746) = lu(k,1746) - lu(k,1299) * lu(k,1731) + lu(k,1747) = lu(k,1747) - lu(k,1300) * lu(k,1731) + lu(k,1748) = lu(k,1748) - lu(k,1301) * lu(k,1731) + lu(k,1749) = lu(k,1749) - lu(k,1302) * lu(k,1731) + lu(k,1768) = lu(k,1768) - lu(k,1285) * lu(k,1767) + lu(k,1769) = lu(k,1769) - lu(k,1286) * lu(k,1767) + lu(k,1770) = lu(k,1770) - lu(k,1287) * lu(k,1767) + lu(k,1771) = lu(k,1771) - lu(k,1288) * lu(k,1767) + lu(k,1772) = lu(k,1772) - lu(k,1289) * lu(k,1767) + lu(k,1773) = lu(k,1773) - lu(k,1290) * lu(k,1767) + lu(k,1774) = lu(k,1774) - lu(k,1291) * lu(k,1767) + lu(k,1775) = lu(k,1775) - lu(k,1292) * lu(k,1767) + lu(k,1776) = lu(k,1776) - lu(k,1293) * lu(k,1767) + lu(k,1777) = lu(k,1777) - lu(k,1294) * lu(k,1767) + lu(k,1778) = lu(k,1778) - lu(k,1295) * lu(k,1767) + lu(k,1779) = lu(k,1779) - lu(k,1296) * lu(k,1767) + lu(k,1780) = lu(k,1780) - lu(k,1297) * lu(k,1767) + lu(k,1781) = lu(k,1781) - lu(k,1298) * lu(k,1767) + lu(k,1782) = lu(k,1782) - lu(k,1299) * lu(k,1767) + lu(k,1783) = lu(k,1783) - lu(k,1300) * lu(k,1767) + lu(k,1784) = lu(k,1784) - lu(k,1301) * lu(k,1767) + lu(k,1785) = lu(k,1785) - lu(k,1302) * lu(k,1767) + lu(k,1816) = lu(k,1816) - lu(k,1285) * lu(k,1815) + lu(k,1817) = lu(k,1817) - lu(k,1286) * lu(k,1815) + lu(k,1818) = lu(k,1818) - lu(k,1287) * lu(k,1815) + lu(k,1819) = lu(k,1819) - lu(k,1288) * lu(k,1815) + lu(k,1820) = lu(k,1820) - lu(k,1289) * lu(k,1815) + lu(k,1821) = lu(k,1821) - lu(k,1290) * lu(k,1815) + lu(k,1822) = lu(k,1822) - lu(k,1291) * lu(k,1815) + lu(k,1823) = lu(k,1823) - lu(k,1292) * lu(k,1815) + lu(k,1824) = lu(k,1824) - lu(k,1293) * lu(k,1815) + lu(k,1825) = lu(k,1825) - lu(k,1294) * lu(k,1815) + lu(k,1826) = lu(k,1826) - lu(k,1295) * lu(k,1815) + lu(k,1827) = lu(k,1827) - lu(k,1296) * lu(k,1815) + lu(k,1828) = lu(k,1828) - lu(k,1297) * lu(k,1815) + lu(k,1829) = lu(k,1829) - lu(k,1298) * lu(k,1815) + lu(k,1830) = lu(k,1830) - lu(k,1299) * lu(k,1815) + lu(k,1831) = lu(k,1831) - lu(k,1300) * lu(k,1815) + lu(k,1832) = lu(k,1832) - lu(k,1301) * lu(k,1815) + lu(k,1833) = lu(k,1833) - lu(k,1302) * lu(k,1815) + lu(k,1849) = lu(k,1849) - lu(k,1285) * lu(k,1848) + lu(k,1850) = lu(k,1850) - lu(k,1286) * lu(k,1848) + lu(k,1851) = lu(k,1851) - lu(k,1287) * lu(k,1848) + lu(k,1852) = lu(k,1852) - lu(k,1288) * lu(k,1848) + lu(k,1853) = lu(k,1853) - lu(k,1289) * lu(k,1848) + lu(k,1854) = lu(k,1854) - lu(k,1290) * lu(k,1848) + lu(k,1855) = lu(k,1855) - lu(k,1291) * lu(k,1848) + lu(k,1856) = lu(k,1856) - lu(k,1292) * lu(k,1848) + lu(k,1857) = lu(k,1857) - lu(k,1293) * lu(k,1848) + lu(k,1858) = lu(k,1858) - lu(k,1294) * lu(k,1848) + lu(k,1859) = lu(k,1859) - lu(k,1295) * lu(k,1848) + lu(k,1860) = lu(k,1860) - lu(k,1296) * lu(k,1848) + lu(k,1861) = lu(k,1861) - lu(k,1297) * lu(k,1848) + lu(k,1862) = lu(k,1862) - lu(k,1298) * lu(k,1848) + lu(k,1863) = lu(k,1863) - lu(k,1299) * lu(k,1848) + lu(k,1864) = lu(k,1864) - lu(k,1300) * lu(k,1848) + lu(k,1865) = lu(k,1865) - lu(k,1301) * lu(k,1848) + lu(k,1866) = lu(k,1866) - lu(k,1302) * lu(k,1848) + lu(k,1885) = lu(k,1885) - lu(k,1285) * lu(k,1884) + lu(k,1886) = lu(k,1886) - lu(k,1286) * lu(k,1884) + lu(k,1887) = lu(k,1887) - lu(k,1287) * lu(k,1884) + lu(k,1888) = lu(k,1888) - lu(k,1288) * lu(k,1884) + lu(k,1889) = lu(k,1889) - lu(k,1289) * lu(k,1884) + lu(k,1890) = lu(k,1890) - lu(k,1290) * lu(k,1884) + lu(k,1891) = lu(k,1891) - lu(k,1291) * lu(k,1884) + lu(k,1892) = lu(k,1892) - lu(k,1292) * lu(k,1884) + lu(k,1893) = lu(k,1893) - lu(k,1293) * lu(k,1884) + lu(k,1894) = lu(k,1894) - lu(k,1294) * lu(k,1884) + lu(k,1895) = lu(k,1895) - lu(k,1295) * lu(k,1884) + lu(k,1896) = lu(k,1896) - lu(k,1296) * lu(k,1884) + lu(k,1897) = lu(k,1897) - lu(k,1297) * lu(k,1884) + lu(k,1898) = lu(k,1898) - lu(k,1298) * lu(k,1884) + lu(k,1899) = lu(k,1899) - lu(k,1299) * lu(k,1884) + lu(k,1900) = lu(k,1900) - lu(k,1300) * lu(k,1884) + lu(k,1901) = lu(k,1901) - lu(k,1301) * lu(k,1884) + lu(k,1902) = lu(k,1902) - lu(k,1302) * lu(k,1884) + lu(k,1926) = lu(k,1926) - lu(k,1285) * lu(k,1925) + lu(k,1927) = lu(k,1927) - lu(k,1286) * lu(k,1925) + lu(k,1928) = lu(k,1928) - lu(k,1287) * lu(k,1925) + lu(k,1929) = lu(k,1929) - lu(k,1288) * lu(k,1925) + lu(k,1930) = lu(k,1930) - lu(k,1289) * lu(k,1925) + lu(k,1931) = lu(k,1931) - lu(k,1290) * lu(k,1925) + lu(k,1932) = lu(k,1932) - lu(k,1291) * lu(k,1925) + lu(k,1933) = lu(k,1933) - lu(k,1292) * lu(k,1925) + lu(k,1934) = lu(k,1934) - lu(k,1293) * lu(k,1925) + lu(k,1935) = lu(k,1935) - lu(k,1294) * lu(k,1925) + lu(k,1936) = lu(k,1936) - lu(k,1295) * lu(k,1925) + lu(k,1937) = lu(k,1937) - lu(k,1296) * lu(k,1925) + lu(k,1938) = lu(k,1938) - lu(k,1297) * lu(k,1925) + lu(k,1939) = lu(k,1939) - lu(k,1298) * lu(k,1925) + lu(k,1940) = lu(k,1940) - lu(k,1299) * lu(k,1925) + lu(k,1941) = lu(k,1941) - lu(k,1300) * lu(k,1925) + lu(k,1942) = lu(k,1942) - lu(k,1301) * lu(k,1925) + lu(k,1943) = lu(k,1943) - lu(k,1302) * lu(k,1925) + lu(k,1968) = lu(k,1968) - lu(k,1285) * lu(k,1967) + lu(k,1969) = lu(k,1969) - lu(k,1286) * lu(k,1967) + lu(k,1970) = lu(k,1970) - lu(k,1287) * lu(k,1967) + lu(k,1971) = lu(k,1971) - lu(k,1288) * lu(k,1967) + lu(k,1972) = lu(k,1972) - lu(k,1289) * lu(k,1967) + lu(k,1973) = lu(k,1973) - lu(k,1290) * lu(k,1967) + lu(k,1974) = lu(k,1974) - lu(k,1291) * lu(k,1967) + lu(k,1975) = lu(k,1975) - lu(k,1292) * lu(k,1967) + lu(k,1976) = lu(k,1976) - lu(k,1293) * lu(k,1967) + lu(k,1977) = lu(k,1977) - lu(k,1294) * lu(k,1967) + lu(k,1978) = lu(k,1978) - lu(k,1295) * lu(k,1967) + lu(k,1979) = lu(k,1979) - lu(k,1296) * lu(k,1967) + lu(k,1980) = lu(k,1980) - lu(k,1297) * lu(k,1967) + lu(k,1981) = lu(k,1981) - lu(k,1298) * lu(k,1967) + lu(k,1982) = lu(k,1982) - lu(k,1299) * lu(k,1967) + lu(k,1983) = lu(k,1983) - lu(k,1300) * lu(k,1967) + lu(k,1984) = lu(k,1984) - lu(k,1301) * lu(k,1967) + lu(k,1985) = lu(k,1985) - lu(k,1302) * lu(k,1967) + lu(k,2013) = lu(k,2013) - lu(k,1285) * lu(k,2012) + lu(k,2014) = lu(k,2014) - lu(k,1286) * lu(k,2012) + lu(k,2015) = lu(k,2015) - lu(k,1287) * lu(k,2012) + lu(k,2016) = lu(k,2016) - lu(k,1288) * lu(k,2012) + lu(k,2017) = lu(k,2017) - lu(k,1289) * lu(k,2012) + lu(k,2018) = lu(k,2018) - lu(k,1290) * lu(k,2012) + lu(k,2019) = lu(k,2019) - lu(k,1291) * lu(k,2012) + lu(k,2020) = lu(k,2020) - lu(k,1292) * lu(k,2012) + lu(k,2021) = lu(k,2021) - lu(k,1293) * lu(k,2012) + lu(k,2022) = lu(k,2022) - lu(k,1294) * lu(k,2012) + lu(k,2023) = lu(k,2023) - lu(k,1295) * lu(k,2012) + lu(k,2024) = lu(k,2024) - lu(k,1296) * lu(k,2012) + lu(k,2025) = lu(k,2025) - lu(k,1297) * lu(k,2012) + lu(k,2026) = lu(k,2026) - lu(k,1298) * lu(k,2012) + lu(k,2027) = lu(k,2027) - lu(k,1299) * lu(k,2012) + lu(k,2028) = lu(k,2028) - lu(k,1300) * lu(k,2012) + lu(k,2029) = lu(k,2029) - lu(k,1301) * lu(k,2012) + lu(k,2030) = lu(k,2030) - lu(k,1302) * lu(k,2012) + lu(k,2073) = lu(k,2073) - lu(k,1285) * lu(k,2072) + lu(k,2074) = lu(k,2074) - lu(k,1286) * lu(k,2072) + lu(k,2075) = lu(k,2075) - lu(k,1287) * lu(k,2072) + lu(k,2076) = lu(k,2076) - lu(k,1288) * lu(k,2072) + lu(k,2077) = lu(k,2077) - lu(k,1289) * lu(k,2072) + lu(k,2078) = lu(k,2078) - lu(k,1290) * lu(k,2072) + lu(k,2079) = lu(k,2079) - lu(k,1291) * lu(k,2072) + lu(k,2080) = lu(k,2080) - lu(k,1292) * lu(k,2072) + lu(k,2081) = lu(k,2081) - lu(k,1293) * lu(k,2072) + lu(k,2082) = lu(k,2082) - lu(k,1294) * lu(k,2072) + lu(k,2083) = lu(k,2083) - lu(k,1295) * lu(k,2072) + lu(k,2084) = lu(k,2084) - lu(k,1296) * lu(k,2072) + lu(k,2085) = lu(k,2085) - lu(k,1297) * lu(k,2072) + lu(k,2086) = lu(k,2086) - lu(k,1298) * lu(k,2072) + lu(k,2087) = lu(k,2087) - lu(k,1299) * lu(k,2072) + lu(k,2088) = lu(k,2088) - lu(k,1300) * lu(k,2072) + lu(k,2089) = lu(k,2089) - lu(k,1301) * lu(k,2072) + lu(k,2090) = lu(k,2090) - lu(k,1302) * lu(k,2072) + lu(k,1327) = 1._r8 / lu(k,1327) + lu(k,1328) = lu(k,1328) * lu(k,1327) + lu(k,1329) = lu(k,1329) * lu(k,1327) + lu(k,1330) = lu(k,1330) * lu(k,1327) + lu(k,1331) = lu(k,1331) * lu(k,1327) + lu(k,1332) = lu(k,1332) * lu(k,1327) + lu(k,1333) = lu(k,1333) * lu(k,1327) + lu(k,1334) = lu(k,1334) * lu(k,1327) + lu(k,1335) = lu(k,1335) * lu(k,1327) + lu(k,1336) = lu(k,1336) * lu(k,1327) + lu(k,1337) = lu(k,1337) * lu(k,1327) + lu(k,1338) = lu(k,1338) * lu(k,1327) + lu(k,1339) = lu(k,1339) * lu(k,1327) + lu(k,1340) = lu(k,1340) * lu(k,1327) + lu(k,1341) = lu(k,1341) * lu(k,1327) + lu(k,1342) = lu(k,1342) * lu(k,1327) + lu(k,1343) = lu(k,1343) * lu(k,1327) + lu(k,1344) = lu(k,1344) * lu(k,1327) + lu(k,1388) = lu(k,1388) - lu(k,1328) * lu(k,1387) + lu(k,1389) = lu(k,1389) - lu(k,1329) * lu(k,1387) + lu(k,1390) = lu(k,1390) - lu(k,1330) * lu(k,1387) + lu(k,1391) = lu(k,1391) - lu(k,1331) * lu(k,1387) + lu(k,1392) = lu(k,1392) - lu(k,1332) * lu(k,1387) + lu(k,1393) = lu(k,1393) - lu(k,1333) * lu(k,1387) + lu(k,1394) = lu(k,1394) - lu(k,1334) * lu(k,1387) + lu(k,1395) = lu(k,1395) - lu(k,1335) * lu(k,1387) + lu(k,1396) = lu(k,1396) - lu(k,1336) * lu(k,1387) + lu(k,1397) = lu(k,1397) - lu(k,1337) * lu(k,1387) + lu(k,1398) = lu(k,1398) - lu(k,1338) * lu(k,1387) + lu(k,1399) = lu(k,1399) - lu(k,1339) * lu(k,1387) + lu(k,1400) = lu(k,1400) - lu(k,1340) * lu(k,1387) + lu(k,1401) = lu(k,1401) - lu(k,1341) * lu(k,1387) + lu(k,1402) = lu(k,1402) - lu(k,1342) * lu(k,1387) + lu(k,1403) = lu(k,1403) - lu(k,1343) * lu(k,1387) + lu(k,1404) = lu(k,1404) - lu(k,1344) * lu(k,1387) + lu(k,1437) = lu(k,1437) - lu(k,1328) * lu(k,1436) + lu(k,1438) = lu(k,1438) - lu(k,1329) * lu(k,1436) + lu(k,1439) = lu(k,1439) - lu(k,1330) * lu(k,1436) + lu(k,1440) = lu(k,1440) - lu(k,1331) * lu(k,1436) + lu(k,1441) = lu(k,1441) - lu(k,1332) * lu(k,1436) + lu(k,1442) = lu(k,1442) - lu(k,1333) * lu(k,1436) + lu(k,1443) = lu(k,1443) - lu(k,1334) * lu(k,1436) + lu(k,1444) = lu(k,1444) - lu(k,1335) * lu(k,1436) + lu(k,1445) = lu(k,1445) - lu(k,1336) * lu(k,1436) + lu(k,1446) = lu(k,1446) - lu(k,1337) * lu(k,1436) + lu(k,1447) = lu(k,1447) - lu(k,1338) * lu(k,1436) + lu(k,1448) = lu(k,1448) - lu(k,1339) * lu(k,1436) + lu(k,1449) = lu(k,1449) - lu(k,1340) * lu(k,1436) + lu(k,1450) = lu(k,1450) - lu(k,1341) * lu(k,1436) + lu(k,1451) = lu(k,1451) - lu(k,1342) * lu(k,1436) + lu(k,1452) = lu(k,1452) - lu(k,1343) * lu(k,1436) + lu(k,1453) = lu(k,1453) - lu(k,1344) * lu(k,1436) + lu(k,1485) = lu(k,1485) - lu(k,1328) * lu(k,1484) + lu(k,1486) = lu(k,1486) - lu(k,1329) * lu(k,1484) + lu(k,1487) = lu(k,1487) - lu(k,1330) * lu(k,1484) + lu(k,1488) = lu(k,1488) - lu(k,1331) * lu(k,1484) + lu(k,1489) = lu(k,1489) - lu(k,1332) * lu(k,1484) + lu(k,1490) = lu(k,1490) - lu(k,1333) * lu(k,1484) + lu(k,1491) = lu(k,1491) - lu(k,1334) * lu(k,1484) + lu(k,1492) = lu(k,1492) - lu(k,1335) * lu(k,1484) + lu(k,1493) = lu(k,1493) - lu(k,1336) * lu(k,1484) + lu(k,1494) = lu(k,1494) - lu(k,1337) * lu(k,1484) + lu(k,1495) = lu(k,1495) - lu(k,1338) * lu(k,1484) + lu(k,1496) = lu(k,1496) - lu(k,1339) * lu(k,1484) + lu(k,1497) = lu(k,1497) - lu(k,1340) * lu(k,1484) + lu(k,1498) = lu(k,1498) - lu(k,1341) * lu(k,1484) + lu(k,1499) = lu(k,1499) - lu(k,1342) * lu(k,1484) + lu(k,1500) = lu(k,1500) - lu(k,1343) * lu(k,1484) + lu(k,1501) = lu(k,1501) - lu(k,1344) * lu(k,1484) + lu(k,1526) = lu(k,1526) - lu(k,1328) * lu(k,1525) + lu(k,1527) = lu(k,1527) - lu(k,1329) * lu(k,1525) + lu(k,1528) = lu(k,1528) - lu(k,1330) * lu(k,1525) + lu(k,1529) = lu(k,1529) - lu(k,1331) * lu(k,1525) + lu(k,1530) = lu(k,1530) - lu(k,1332) * lu(k,1525) + lu(k,1531) = lu(k,1531) - lu(k,1333) * lu(k,1525) + lu(k,1532) = lu(k,1532) - lu(k,1334) * lu(k,1525) + lu(k,1533) = lu(k,1533) - lu(k,1335) * lu(k,1525) + lu(k,1534) = lu(k,1534) - lu(k,1336) * lu(k,1525) + lu(k,1535) = lu(k,1535) - lu(k,1337) * lu(k,1525) + lu(k,1536) = lu(k,1536) - lu(k,1338) * lu(k,1525) + lu(k,1537) = lu(k,1537) - lu(k,1339) * lu(k,1525) + lu(k,1538) = lu(k,1538) - lu(k,1340) * lu(k,1525) + lu(k,1539) = lu(k,1539) - lu(k,1341) * lu(k,1525) + lu(k,1540) = lu(k,1540) - lu(k,1342) * lu(k,1525) + lu(k,1541) = lu(k,1541) - lu(k,1343) * lu(k,1525) + lu(k,1542) = lu(k,1542) - lu(k,1344) * lu(k,1525) + lu(k,1562) = lu(k,1562) - lu(k,1328) * lu(k,1561) + lu(k,1563) = lu(k,1563) - lu(k,1329) * lu(k,1561) + lu(k,1564) = lu(k,1564) - lu(k,1330) * lu(k,1561) + lu(k,1565) = lu(k,1565) - lu(k,1331) * lu(k,1561) + lu(k,1566) = lu(k,1566) - lu(k,1332) * lu(k,1561) + lu(k,1567) = lu(k,1567) - lu(k,1333) * lu(k,1561) + lu(k,1568) = lu(k,1568) - lu(k,1334) * lu(k,1561) + lu(k,1569) = lu(k,1569) - lu(k,1335) * lu(k,1561) + lu(k,1570) = lu(k,1570) - lu(k,1336) * lu(k,1561) + lu(k,1571) = lu(k,1571) - lu(k,1337) * lu(k,1561) + lu(k,1572) = lu(k,1572) - lu(k,1338) * lu(k,1561) + lu(k,1573) = lu(k,1573) - lu(k,1339) * lu(k,1561) + lu(k,1574) = lu(k,1574) - lu(k,1340) * lu(k,1561) + lu(k,1575) = lu(k,1575) - lu(k,1341) * lu(k,1561) + lu(k,1576) = lu(k,1576) - lu(k,1342) * lu(k,1561) + lu(k,1577) = lu(k,1577) - lu(k,1343) * lu(k,1561) + lu(k,1578) = lu(k,1578) - lu(k,1344) * lu(k,1561) + lu(k,1607) = lu(k,1607) - lu(k,1328) * lu(k,1606) + lu(k,1608) = lu(k,1608) - lu(k,1329) * lu(k,1606) + lu(k,1609) = lu(k,1609) - lu(k,1330) * lu(k,1606) + lu(k,1610) = lu(k,1610) - lu(k,1331) * lu(k,1606) + lu(k,1611) = lu(k,1611) - lu(k,1332) * lu(k,1606) + lu(k,1612) = lu(k,1612) - lu(k,1333) * lu(k,1606) + lu(k,1613) = lu(k,1613) - lu(k,1334) * lu(k,1606) + lu(k,1614) = lu(k,1614) - lu(k,1335) * lu(k,1606) + lu(k,1615) = lu(k,1615) - lu(k,1336) * lu(k,1606) + lu(k,1616) = lu(k,1616) - lu(k,1337) * lu(k,1606) + lu(k,1617) = lu(k,1617) - lu(k,1338) * lu(k,1606) + lu(k,1618) = lu(k,1618) - lu(k,1339) * lu(k,1606) + lu(k,1619) = lu(k,1619) - lu(k,1340) * lu(k,1606) + lu(k,1620) = lu(k,1620) - lu(k,1341) * lu(k,1606) + lu(k,1621) = lu(k,1621) - lu(k,1342) * lu(k,1606) + lu(k,1622) = lu(k,1622) - lu(k,1343) * lu(k,1606) + lu(k,1623) = lu(k,1623) - lu(k,1344) * lu(k,1606) + lu(k,1650) = lu(k,1650) - lu(k,1328) * lu(k,1649) + lu(k,1651) = lu(k,1651) - lu(k,1329) * lu(k,1649) + lu(k,1652) = lu(k,1652) - lu(k,1330) * lu(k,1649) + lu(k,1653) = lu(k,1653) - lu(k,1331) * lu(k,1649) + lu(k,1654) = lu(k,1654) - lu(k,1332) * lu(k,1649) + lu(k,1655) = lu(k,1655) - lu(k,1333) * lu(k,1649) + lu(k,1656) = lu(k,1656) - lu(k,1334) * lu(k,1649) + lu(k,1657) = lu(k,1657) - lu(k,1335) * lu(k,1649) + lu(k,1658) = lu(k,1658) - lu(k,1336) * lu(k,1649) + lu(k,1659) = lu(k,1659) - lu(k,1337) * lu(k,1649) + lu(k,1660) = lu(k,1660) - lu(k,1338) * lu(k,1649) + lu(k,1661) = lu(k,1661) - lu(k,1339) * lu(k,1649) + lu(k,1662) = lu(k,1662) - lu(k,1340) * lu(k,1649) + lu(k,1663) = lu(k,1663) - lu(k,1341) * lu(k,1649) + lu(k,1664) = lu(k,1664) - lu(k,1342) * lu(k,1649) + lu(k,1665) = lu(k,1665) - lu(k,1343) * lu(k,1649) + lu(k,1666) = lu(k,1666) - lu(k,1344) * lu(k,1649) + lu(k,1693) = lu(k,1693) - lu(k,1328) * lu(k,1692) + lu(k,1694) = lu(k,1694) - lu(k,1329) * lu(k,1692) + lu(k,1695) = lu(k,1695) - lu(k,1330) * lu(k,1692) + lu(k,1696) = lu(k,1696) - lu(k,1331) * lu(k,1692) + lu(k,1697) = lu(k,1697) - lu(k,1332) * lu(k,1692) + lu(k,1698) = lu(k,1698) - lu(k,1333) * lu(k,1692) + lu(k,1699) = lu(k,1699) - lu(k,1334) * lu(k,1692) + lu(k,1700) = lu(k,1700) - lu(k,1335) * lu(k,1692) + lu(k,1701) = lu(k,1701) - lu(k,1336) * lu(k,1692) + lu(k,1702) = lu(k,1702) - lu(k,1337) * lu(k,1692) + lu(k,1703) = lu(k,1703) - lu(k,1338) * lu(k,1692) + lu(k,1704) = lu(k,1704) - lu(k,1339) * lu(k,1692) + lu(k,1705) = lu(k,1705) - lu(k,1340) * lu(k,1692) + lu(k,1706) = lu(k,1706) - lu(k,1341) * lu(k,1692) + lu(k,1707) = lu(k,1707) - lu(k,1342) * lu(k,1692) + lu(k,1708) = lu(k,1708) - lu(k,1343) * lu(k,1692) + lu(k,1709) = lu(k,1709) - lu(k,1344) * lu(k,1692) + lu(k,1733) = lu(k,1733) - lu(k,1328) * lu(k,1732) + lu(k,1734) = lu(k,1734) - lu(k,1329) * lu(k,1732) + lu(k,1735) = lu(k,1735) - lu(k,1330) * lu(k,1732) + lu(k,1736) = lu(k,1736) - lu(k,1331) * lu(k,1732) + lu(k,1737) = lu(k,1737) - lu(k,1332) * lu(k,1732) + lu(k,1738) = lu(k,1738) - lu(k,1333) * lu(k,1732) + lu(k,1739) = lu(k,1739) - lu(k,1334) * lu(k,1732) + lu(k,1740) = lu(k,1740) - lu(k,1335) * lu(k,1732) + lu(k,1741) = lu(k,1741) - lu(k,1336) * lu(k,1732) + lu(k,1742) = lu(k,1742) - lu(k,1337) * lu(k,1732) + lu(k,1743) = lu(k,1743) - lu(k,1338) * lu(k,1732) + lu(k,1744) = lu(k,1744) - lu(k,1339) * lu(k,1732) + lu(k,1745) = lu(k,1745) - lu(k,1340) * lu(k,1732) + lu(k,1746) = lu(k,1746) - lu(k,1341) * lu(k,1732) + lu(k,1747) = lu(k,1747) - lu(k,1342) * lu(k,1732) + lu(k,1748) = lu(k,1748) - lu(k,1343) * lu(k,1732) + lu(k,1749) = lu(k,1749) - lu(k,1344) * lu(k,1732) + lu(k,1769) = lu(k,1769) - lu(k,1328) * lu(k,1768) + lu(k,1770) = lu(k,1770) - lu(k,1329) * lu(k,1768) + lu(k,1771) = lu(k,1771) - lu(k,1330) * lu(k,1768) + lu(k,1772) = lu(k,1772) - lu(k,1331) * lu(k,1768) + lu(k,1773) = lu(k,1773) - lu(k,1332) * lu(k,1768) + lu(k,1774) = lu(k,1774) - lu(k,1333) * lu(k,1768) + lu(k,1775) = lu(k,1775) - lu(k,1334) * lu(k,1768) + lu(k,1776) = lu(k,1776) - lu(k,1335) * lu(k,1768) + lu(k,1777) = lu(k,1777) - lu(k,1336) * lu(k,1768) + lu(k,1778) = lu(k,1778) - lu(k,1337) * lu(k,1768) + lu(k,1779) = lu(k,1779) - lu(k,1338) * lu(k,1768) + lu(k,1780) = lu(k,1780) - lu(k,1339) * lu(k,1768) + lu(k,1781) = lu(k,1781) - lu(k,1340) * lu(k,1768) + lu(k,1782) = lu(k,1782) - lu(k,1341) * lu(k,1768) + lu(k,1783) = lu(k,1783) - lu(k,1342) * lu(k,1768) + lu(k,1784) = lu(k,1784) - lu(k,1343) * lu(k,1768) + lu(k,1785) = lu(k,1785) - lu(k,1344) * lu(k,1768) + lu(k,1817) = lu(k,1817) - lu(k,1328) * lu(k,1816) + lu(k,1818) = lu(k,1818) - lu(k,1329) * lu(k,1816) + lu(k,1819) = lu(k,1819) - lu(k,1330) * lu(k,1816) + lu(k,1820) = lu(k,1820) - lu(k,1331) * lu(k,1816) + lu(k,1821) = lu(k,1821) - lu(k,1332) * lu(k,1816) + lu(k,1822) = lu(k,1822) - lu(k,1333) * lu(k,1816) + lu(k,1823) = lu(k,1823) - lu(k,1334) * lu(k,1816) + lu(k,1824) = lu(k,1824) - lu(k,1335) * lu(k,1816) + lu(k,1825) = lu(k,1825) - lu(k,1336) * lu(k,1816) + lu(k,1826) = lu(k,1826) - lu(k,1337) * lu(k,1816) + lu(k,1827) = lu(k,1827) - lu(k,1338) * lu(k,1816) + lu(k,1828) = lu(k,1828) - lu(k,1339) * lu(k,1816) + lu(k,1829) = lu(k,1829) - lu(k,1340) * lu(k,1816) + lu(k,1830) = lu(k,1830) - lu(k,1341) * lu(k,1816) + lu(k,1831) = lu(k,1831) - lu(k,1342) * lu(k,1816) + lu(k,1832) = lu(k,1832) - lu(k,1343) * lu(k,1816) + lu(k,1833) = lu(k,1833) - lu(k,1344) * lu(k,1816) + lu(k,1850) = lu(k,1850) - lu(k,1328) * lu(k,1849) + lu(k,1851) = lu(k,1851) - lu(k,1329) * lu(k,1849) + lu(k,1852) = lu(k,1852) - lu(k,1330) * lu(k,1849) + lu(k,1853) = lu(k,1853) - lu(k,1331) * lu(k,1849) + lu(k,1854) = lu(k,1854) - lu(k,1332) * lu(k,1849) + lu(k,1855) = lu(k,1855) - lu(k,1333) * lu(k,1849) + lu(k,1856) = lu(k,1856) - lu(k,1334) * lu(k,1849) + lu(k,1857) = lu(k,1857) - lu(k,1335) * lu(k,1849) + lu(k,1858) = lu(k,1858) - lu(k,1336) * lu(k,1849) + lu(k,1859) = lu(k,1859) - lu(k,1337) * lu(k,1849) + lu(k,1860) = lu(k,1860) - lu(k,1338) * lu(k,1849) + lu(k,1861) = lu(k,1861) - lu(k,1339) * lu(k,1849) + lu(k,1862) = lu(k,1862) - lu(k,1340) * lu(k,1849) + lu(k,1863) = lu(k,1863) - lu(k,1341) * lu(k,1849) + lu(k,1864) = lu(k,1864) - lu(k,1342) * lu(k,1849) + lu(k,1865) = lu(k,1865) - lu(k,1343) * lu(k,1849) + lu(k,1866) = lu(k,1866) - lu(k,1344) * lu(k,1849) + lu(k,1886) = lu(k,1886) - lu(k,1328) * lu(k,1885) + lu(k,1887) = lu(k,1887) - lu(k,1329) * lu(k,1885) + lu(k,1888) = lu(k,1888) - lu(k,1330) * lu(k,1885) + lu(k,1889) = lu(k,1889) - lu(k,1331) * lu(k,1885) + lu(k,1890) = lu(k,1890) - lu(k,1332) * lu(k,1885) + lu(k,1891) = lu(k,1891) - lu(k,1333) * lu(k,1885) + lu(k,1892) = lu(k,1892) - lu(k,1334) * lu(k,1885) + lu(k,1893) = lu(k,1893) - lu(k,1335) * lu(k,1885) + lu(k,1894) = lu(k,1894) - lu(k,1336) * lu(k,1885) + lu(k,1895) = lu(k,1895) - lu(k,1337) * lu(k,1885) + lu(k,1896) = lu(k,1896) - lu(k,1338) * lu(k,1885) + lu(k,1897) = lu(k,1897) - lu(k,1339) * lu(k,1885) + lu(k,1898) = lu(k,1898) - lu(k,1340) * lu(k,1885) + lu(k,1899) = lu(k,1899) - lu(k,1341) * lu(k,1885) + lu(k,1900) = lu(k,1900) - lu(k,1342) * lu(k,1885) + lu(k,1901) = lu(k,1901) - lu(k,1343) * lu(k,1885) + lu(k,1902) = lu(k,1902) - lu(k,1344) * lu(k,1885) + lu(k,1927) = lu(k,1927) - lu(k,1328) * lu(k,1926) + lu(k,1928) = lu(k,1928) - lu(k,1329) * lu(k,1926) + lu(k,1929) = lu(k,1929) - lu(k,1330) * lu(k,1926) + lu(k,1930) = lu(k,1930) - lu(k,1331) * lu(k,1926) + lu(k,1931) = lu(k,1931) - lu(k,1332) * lu(k,1926) + lu(k,1932) = lu(k,1932) - lu(k,1333) * lu(k,1926) + lu(k,1933) = lu(k,1933) - lu(k,1334) * lu(k,1926) + lu(k,1934) = lu(k,1934) - lu(k,1335) * lu(k,1926) + lu(k,1935) = lu(k,1935) - lu(k,1336) * lu(k,1926) + lu(k,1936) = lu(k,1936) - lu(k,1337) * lu(k,1926) + lu(k,1937) = lu(k,1937) - lu(k,1338) * lu(k,1926) + lu(k,1938) = lu(k,1938) - lu(k,1339) * lu(k,1926) + lu(k,1939) = lu(k,1939) - lu(k,1340) * lu(k,1926) + lu(k,1940) = lu(k,1940) - lu(k,1341) * lu(k,1926) + lu(k,1941) = lu(k,1941) - lu(k,1342) * lu(k,1926) + lu(k,1942) = lu(k,1942) - lu(k,1343) * lu(k,1926) + lu(k,1943) = lu(k,1943) - lu(k,1344) * lu(k,1926) + lu(k,1969) = lu(k,1969) - lu(k,1328) * lu(k,1968) + lu(k,1970) = lu(k,1970) - lu(k,1329) * lu(k,1968) + lu(k,1971) = lu(k,1971) - lu(k,1330) * lu(k,1968) + lu(k,1972) = lu(k,1972) - lu(k,1331) * lu(k,1968) + lu(k,1973) = lu(k,1973) - lu(k,1332) * lu(k,1968) + lu(k,1974) = lu(k,1974) - lu(k,1333) * lu(k,1968) + lu(k,1975) = lu(k,1975) - lu(k,1334) * lu(k,1968) + lu(k,1976) = lu(k,1976) - lu(k,1335) * lu(k,1968) + lu(k,1977) = lu(k,1977) - lu(k,1336) * lu(k,1968) + lu(k,1978) = lu(k,1978) - lu(k,1337) * lu(k,1968) + lu(k,1979) = lu(k,1979) - lu(k,1338) * lu(k,1968) + lu(k,1980) = lu(k,1980) - lu(k,1339) * lu(k,1968) + lu(k,1981) = lu(k,1981) - lu(k,1340) * lu(k,1968) + lu(k,1982) = lu(k,1982) - lu(k,1341) * lu(k,1968) + lu(k,1983) = lu(k,1983) - lu(k,1342) * lu(k,1968) + lu(k,1984) = lu(k,1984) - lu(k,1343) * lu(k,1968) + lu(k,1985) = lu(k,1985) - lu(k,1344) * lu(k,1968) + lu(k,2014) = lu(k,2014) - lu(k,1328) * lu(k,2013) + lu(k,2015) = lu(k,2015) - lu(k,1329) * lu(k,2013) + lu(k,2016) = lu(k,2016) - lu(k,1330) * lu(k,2013) + lu(k,2017) = lu(k,2017) - lu(k,1331) * lu(k,2013) + lu(k,2018) = lu(k,2018) - lu(k,1332) * lu(k,2013) + lu(k,2019) = lu(k,2019) - lu(k,1333) * lu(k,2013) + lu(k,2020) = lu(k,2020) - lu(k,1334) * lu(k,2013) + lu(k,2021) = lu(k,2021) - lu(k,1335) * lu(k,2013) + lu(k,2022) = lu(k,2022) - lu(k,1336) * lu(k,2013) + lu(k,2023) = lu(k,2023) - lu(k,1337) * lu(k,2013) + lu(k,2024) = lu(k,2024) - lu(k,1338) * lu(k,2013) + lu(k,2025) = lu(k,2025) - lu(k,1339) * lu(k,2013) + lu(k,2026) = lu(k,2026) - lu(k,1340) * lu(k,2013) + lu(k,2027) = lu(k,2027) - lu(k,1341) * lu(k,2013) + lu(k,2028) = lu(k,2028) - lu(k,1342) * lu(k,2013) + lu(k,2029) = lu(k,2029) - lu(k,1343) * lu(k,2013) + lu(k,2030) = lu(k,2030) - lu(k,1344) * lu(k,2013) + lu(k,2074) = lu(k,2074) - lu(k,1328) * lu(k,2073) + lu(k,2075) = lu(k,2075) - lu(k,1329) * lu(k,2073) + lu(k,2076) = lu(k,2076) - lu(k,1330) * lu(k,2073) + lu(k,2077) = lu(k,2077) - lu(k,1331) * lu(k,2073) + lu(k,2078) = lu(k,2078) - lu(k,1332) * lu(k,2073) + lu(k,2079) = lu(k,2079) - lu(k,1333) * lu(k,2073) + lu(k,2080) = lu(k,2080) - lu(k,1334) * lu(k,2073) + lu(k,2081) = lu(k,2081) - lu(k,1335) * lu(k,2073) + lu(k,2082) = lu(k,2082) - lu(k,1336) * lu(k,2073) + lu(k,2083) = lu(k,2083) - lu(k,1337) * lu(k,2073) + lu(k,2084) = lu(k,2084) - lu(k,1338) * lu(k,2073) + lu(k,2085) = lu(k,2085) - lu(k,1339) * lu(k,2073) + lu(k,2086) = lu(k,2086) - lu(k,1340) * lu(k,2073) + lu(k,2087) = lu(k,2087) - lu(k,1341) * lu(k,2073) + lu(k,2088) = lu(k,2088) - lu(k,1342) * lu(k,2073) + lu(k,2089) = lu(k,2089) - lu(k,1343) * lu(k,2073) + lu(k,2090) = lu(k,2090) - lu(k,1344) * lu(k,2073) + end do + end subroutine lu_fac23 + subroutine lu_fac24( 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,1388) = 1._r8 / lu(k,1388) + lu(k,1389) = lu(k,1389) * lu(k,1388) + lu(k,1390) = lu(k,1390) * lu(k,1388) + lu(k,1391) = lu(k,1391) * lu(k,1388) + lu(k,1392) = lu(k,1392) * lu(k,1388) + lu(k,1393) = lu(k,1393) * lu(k,1388) + lu(k,1394) = lu(k,1394) * lu(k,1388) + lu(k,1395) = lu(k,1395) * lu(k,1388) + lu(k,1396) = lu(k,1396) * lu(k,1388) + lu(k,1397) = lu(k,1397) * lu(k,1388) + lu(k,1398) = lu(k,1398) * lu(k,1388) + lu(k,1399) = lu(k,1399) * lu(k,1388) + lu(k,1400) = lu(k,1400) * lu(k,1388) + lu(k,1401) = lu(k,1401) * lu(k,1388) + lu(k,1402) = lu(k,1402) * lu(k,1388) + lu(k,1403) = lu(k,1403) * lu(k,1388) + lu(k,1404) = lu(k,1404) * lu(k,1388) + lu(k,1438) = lu(k,1438) - lu(k,1389) * lu(k,1437) + lu(k,1439) = lu(k,1439) - lu(k,1390) * lu(k,1437) + lu(k,1440) = lu(k,1440) - lu(k,1391) * lu(k,1437) + lu(k,1441) = lu(k,1441) - lu(k,1392) * lu(k,1437) + lu(k,1442) = lu(k,1442) - lu(k,1393) * lu(k,1437) + lu(k,1443) = lu(k,1443) - lu(k,1394) * lu(k,1437) + lu(k,1444) = lu(k,1444) - lu(k,1395) * lu(k,1437) + lu(k,1445) = lu(k,1445) - lu(k,1396) * lu(k,1437) + lu(k,1446) = lu(k,1446) - lu(k,1397) * lu(k,1437) + lu(k,1447) = lu(k,1447) - lu(k,1398) * lu(k,1437) + lu(k,1448) = lu(k,1448) - lu(k,1399) * lu(k,1437) + lu(k,1449) = lu(k,1449) - lu(k,1400) * lu(k,1437) + lu(k,1450) = lu(k,1450) - lu(k,1401) * lu(k,1437) + lu(k,1451) = lu(k,1451) - lu(k,1402) * lu(k,1437) + lu(k,1452) = lu(k,1452) - lu(k,1403) * lu(k,1437) + lu(k,1453) = lu(k,1453) - lu(k,1404) * lu(k,1437) + lu(k,1486) = lu(k,1486) - lu(k,1389) * lu(k,1485) + lu(k,1487) = lu(k,1487) - lu(k,1390) * lu(k,1485) + lu(k,1488) = lu(k,1488) - lu(k,1391) * lu(k,1485) + lu(k,1489) = lu(k,1489) - lu(k,1392) * lu(k,1485) + lu(k,1490) = lu(k,1490) - lu(k,1393) * lu(k,1485) + lu(k,1491) = lu(k,1491) - lu(k,1394) * lu(k,1485) + lu(k,1492) = lu(k,1492) - lu(k,1395) * lu(k,1485) + lu(k,1493) = lu(k,1493) - lu(k,1396) * lu(k,1485) + lu(k,1494) = lu(k,1494) - lu(k,1397) * lu(k,1485) + lu(k,1495) = lu(k,1495) - lu(k,1398) * lu(k,1485) + lu(k,1496) = lu(k,1496) - lu(k,1399) * lu(k,1485) + lu(k,1497) = lu(k,1497) - lu(k,1400) * lu(k,1485) + lu(k,1498) = lu(k,1498) - lu(k,1401) * lu(k,1485) + lu(k,1499) = lu(k,1499) - lu(k,1402) * lu(k,1485) + lu(k,1500) = lu(k,1500) - lu(k,1403) * lu(k,1485) + lu(k,1501) = lu(k,1501) - lu(k,1404) * lu(k,1485) + lu(k,1527) = lu(k,1527) - lu(k,1389) * lu(k,1526) + lu(k,1528) = lu(k,1528) - lu(k,1390) * lu(k,1526) + lu(k,1529) = lu(k,1529) - lu(k,1391) * lu(k,1526) + lu(k,1530) = lu(k,1530) - lu(k,1392) * lu(k,1526) + lu(k,1531) = lu(k,1531) - lu(k,1393) * lu(k,1526) + lu(k,1532) = lu(k,1532) - lu(k,1394) * lu(k,1526) + lu(k,1533) = lu(k,1533) - lu(k,1395) * lu(k,1526) + lu(k,1534) = lu(k,1534) - lu(k,1396) * lu(k,1526) + lu(k,1535) = lu(k,1535) - lu(k,1397) * lu(k,1526) + lu(k,1536) = lu(k,1536) - lu(k,1398) * lu(k,1526) + lu(k,1537) = lu(k,1537) - lu(k,1399) * lu(k,1526) + lu(k,1538) = lu(k,1538) - lu(k,1400) * lu(k,1526) + lu(k,1539) = lu(k,1539) - lu(k,1401) * lu(k,1526) + lu(k,1540) = lu(k,1540) - lu(k,1402) * lu(k,1526) + lu(k,1541) = lu(k,1541) - lu(k,1403) * lu(k,1526) + lu(k,1542) = lu(k,1542) - lu(k,1404) * lu(k,1526) + lu(k,1563) = lu(k,1563) - lu(k,1389) * lu(k,1562) + lu(k,1564) = lu(k,1564) - lu(k,1390) * lu(k,1562) + lu(k,1565) = lu(k,1565) - lu(k,1391) * lu(k,1562) + lu(k,1566) = lu(k,1566) - lu(k,1392) * lu(k,1562) + lu(k,1567) = lu(k,1567) - lu(k,1393) * lu(k,1562) + lu(k,1568) = lu(k,1568) - lu(k,1394) * lu(k,1562) + lu(k,1569) = lu(k,1569) - lu(k,1395) * lu(k,1562) + lu(k,1570) = lu(k,1570) - lu(k,1396) * lu(k,1562) + lu(k,1571) = lu(k,1571) - lu(k,1397) * lu(k,1562) + lu(k,1572) = lu(k,1572) - lu(k,1398) * lu(k,1562) + lu(k,1573) = lu(k,1573) - lu(k,1399) * lu(k,1562) + lu(k,1574) = lu(k,1574) - lu(k,1400) * lu(k,1562) + lu(k,1575) = lu(k,1575) - lu(k,1401) * lu(k,1562) + lu(k,1576) = lu(k,1576) - lu(k,1402) * lu(k,1562) + lu(k,1577) = lu(k,1577) - lu(k,1403) * lu(k,1562) + lu(k,1578) = lu(k,1578) - lu(k,1404) * lu(k,1562) + lu(k,1608) = lu(k,1608) - lu(k,1389) * lu(k,1607) + lu(k,1609) = lu(k,1609) - lu(k,1390) * lu(k,1607) + lu(k,1610) = lu(k,1610) - lu(k,1391) * lu(k,1607) + lu(k,1611) = lu(k,1611) - lu(k,1392) * lu(k,1607) + lu(k,1612) = lu(k,1612) - lu(k,1393) * lu(k,1607) + lu(k,1613) = lu(k,1613) - lu(k,1394) * lu(k,1607) + lu(k,1614) = lu(k,1614) - lu(k,1395) * lu(k,1607) + lu(k,1615) = lu(k,1615) - lu(k,1396) * lu(k,1607) + lu(k,1616) = lu(k,1616) - lu(k,1397) * lu(k,1607) + lu(k,1617) = lu(k,1617) - lu(k,1398) * lu(k,1607) + lu(k,1618) = lu(k,1618) - lu(k,1399) * lu(k,1607) + lu(k,1619) = lu(k,1619) - lu(k,1400) * lu(k,1607) + lu(k,1620) = lu(k,1620) - lu(k,1401) * lu(k,1607) + lu(k,1621) = lu(k,1621) - lu(k,1402) * lu(k,1607) + lu(k,1622) = lu(k,1622) - lu(k,1403) * lu(k,1607) + lu(k,1623) = lu(k,1623) - lu(k,1404) * lu(k,1607) + lu(k,1651) = lu(k,1651) - lu(k,1389) * lu(k,1650) + lu(k,1652) = lu(k,1652) - lu(k,1390) * lu(k,1650) + lu(k,1653) = lu(k,1653) - lu(k,1391) * lu(k,1650) + lu(k,1654) = lu(k,1654) - lu(k,1392) * lu(k,1650) + lu(k,1655) = lu(k,1655) - lu(k,1393) * lu(k,1650) + lu(k,1656) = lu(k,1656) - lu(k,1394) * lu(k,1650) + lu(k,1657) = lu(k,1657) - lu(k,1395) * lu(k,1650) + lu(k,1658) = lu(k,1658) - lu(k,1396) * lu(k,1650) + lu(k,1659) = lu(k,1659) - lu(k,1397) * lu(k,1650) + lu(k,1660) = lu(k,1660) - lu(k,1398) * lu(k,1650) + lu(k,1661) = lu(k,1661) - lu(k,1399) * lu(k,1650) + lu(k,1662) = lu(k,1662) - lu(k,1400) * lu(k,1650) + lu(k,1663) = lu(k,1663) - lu(k,1401) * lu(k,1650) + lu(k,1664) = lu(k,1664) - lu(k,1402) * lu(k,1650) + lu(k,1665) = lu(k,1665) - lu(k,1403) * lu(k,1650) + lu(k,1666) = lu(k,1666) - lu(k,1404) * lu(k,1650) + lu(k,1694) = lu(k,1694) - lu(k,1389) * lu(k,1693) + lu(k,1695) = lu(k,1695) - lu(k,1390) * lu(k,1693) + lu(k,1696) = lu(k,1696) - lu(k,1391) * lu(k,1693) + lu(k,1697) = lu(k,1697) - lu(k,1392) * lu(k,1693) + lu(k,1698) = lu(k,1698) - lu(k,1393) * lu(k,1693) + lu(k,1699) = lu(k,1699) - lu(k,1394) * lu(k,1693) + lu(k,1700) = lu(k,1700) - lu(k,1395) * lu(k,1693) + lu(k,1701) = lu(k,1701) - lu(k,1396) * lu(k,1693) + lu(k,1702) = lu(k,1702) - lu(k,1397) * lu(k,1693) + lu(k,1703) = lu(k,1703) - lu(k,1398) * lu(k,1693) + lu(k,1704) = lu(k,1704) - lu(k,1399) * lu(k,1693) + lu(k,1705) = lu(k,1705) - lu(k,1400) * lu(k,1693) + lu(k,1706) = lu(k,1706) - lu(k,1401) * lu(k,1693) + lu(k,1707) = lu(k,1707) - lu(k,1402) * lu(k,1693) + lu(k,1708) = lu(k,1708) - lu(k,1403) * lu(k,1693) + lu(k,1709) = lu(k,1709) - lu(k,1404) * lu(k,1693) + lu(k,1734) = lu(k,1734) - lu(k,1389) * lu(k,1733) + lu(k,1735) = lu(k,1735) - lu(k,1390) * lu(k,1733) + lu(k,1736) = lu(k,1736) - lu(k,1391) * lu(k,1733) + lu(k,1737) = lu(k,1737) - lu(k,1392) * lu(k,1733) + lu(k,1738) = lu(k,1738) - lu(k,1393) * lu(k,1733) + lu(k,1739) = lu(k,1739) - lu(k,1394) * lu(k,1733) + lu(k,1740) = lu(k,1740) - lu(k,1395) * lu(k,1733) + lu(k,1741) = lu(k,1741) - lu(k,1396) * lu(k,1733) + lu(k,1742) = lu(k,1742) - lu(k,1397) * lu(k,1733) + lu(k,1743) = lu(k,1743) - lu(k,1398) * lu(k,1733) + lu(k,1744) = lu(k,1744) - lu(k,1399) * lu(k,1733) + lu(k,1745) = lu(k,1745) - lu(k,1400) * lu(k,1733) + lu(k,1746) = lu(k,1746) - lu(k,1401) * lu(k,1733) + lu(k,1747) = lu(k,1747) - lu(k,1402) * lu(k,1733) + lu(k,1748) = lu(k,1748) - lu(k,1403) * lu(k,1733) + lu(k,1749) = lu(k,1749) - lu(k,1404) * lu(k,1733) + lu(k,1770) = lu(k,1770) - lu(k,1389) * lu(k,1769) + lu(k,1771) = lu(k,1771) - lu(k,1390) * lu(k,1769) + lu(k,1772) = lu(k,1772) - lu(k,1391) * lu(k,1769) + lu(k,1773) = lu(k,1773) - lu(k,1392) * lu(k,1769) + lu(k,1774) = lu(k,1774) - lu(k,1393) * lu(k,1769) + lu(k,1775) = lu(k,1775) - lu(k,1394) * lu(k,1769) + lu(k,1776) = lu(k,1776) - lu(k,1395) * lu(k,1769) + lu(k,1777) = lu(k,1777) - lu(k,1396) * lu(k,1769) + lu(k,1778) = lu(k,1778) - lu(k,1397) * lu(k,1769) + lu(k,1779) = lu(k,1779) - lu(k,1398) * lu(k,1769) + lu(k,1780) = lu(k,1780) - lu(k,1399) * lu(k,1769) + lu(k,1781) = lu(k,1781) - lu(k,1400) * lu(k,1769) + lu(k,1782) = lu(k,1782) - lu(k,1401) * lu(k,1769) + lu(k,1783) = lu(k,1783) - lu(k,1402) * lu(k,1769) + lu(k,1784) = lu(k,1784) - lu(k,1403) * lu(k,1769) + lu(k,1785) = lu(k,1785) - lu(k,1404) * lu(k,1769) + lu(k,1818) = lu(k,1818) - lu(k,1389) * lu(k,1817) + lu(k,1819) = lu(k,1819) - lu(k,1390) * lu(k,1817) + lu(k,1820) = lu(k,1820) - lu(k,1391) * lu(k,1817) + lu(k,1821) = lu(k,1821) - lu(k,1392) * lu(k,1817) + lu(k,1822) = lu(k,1822) - lu(k,1393) * lu(k,1817) + lu(k,1823) = lu(k,1823) - lu(k,1394) * lu(k,1817) + lu(k,1824) = lu(k,1824) - lu(k,1395) * lu(k,1817) + lu(k,1825) = lu(k,1825) - lu(k,1396) * lu(k,1817) + lu(k,1826) = lu(k,1826) - lu(k,1397) * lu(k,1817) + lu(k,1827) = lu(k,1827) - lu(k,1398) * lu(k,1817) + lu(k,1828) = lu(k,1828) - lu(k,1399) * lu(k,1817) + lu(k,1829) = lu(k,1829) - lu(k,1400) * lu(k,1817) + lu(k,1830) = lu(k,1830) - lu(k,1401) * lu(k,1817) + lu(k,1831) = lu(k,1831) - lu(k,1402) * lu(k,1817) + lu(k,1832) = lu(k,1832) - lu(k,1403) * lu(k,1817) + lu(k,1833) = lu(k,1833) - lu(k,1404) * lu(k,1817) + lu(k,1851) = lu(k,1851) - lu(k,1389) * lu(k,1850) + lu(k,1852) = lu(k,1852) - lu(k,1390) * lu(k,1850) + lu(k,1853) = lu(k,1853) - lu(k,1391) * lu(k,1850) + lu(k,1854) = lu(k,1854) - lu(k,1392) * lu(k,1850) + lu(k,1855) = lu(k,1855) - lu(k,1393) * lu(k,1850) + lu(k,1856) = lu(k,1856) - lu(k,1394) * lu(k,1850) + lu(k,1857) = lu(k,1857) - lu(k,1395) * lu(k,1850) + lu(k,1858) = lu(k,1858) - lu(k,1396) * lu(k,1850) + lu(k,1859) = lu(k,1859) - lu(k,1397) * lu(k,1850) + lu(k,1860) = lu(k,1860) - lu(k,1398) * lu(k,1850) + lu(k,1861) = lu(k,1861) - lu(k,1399) * lu(k,1850) + lu(k,1862) = lu(k,1862) - lu(k,1400) * lu(k,1850) + lu(k,1863) = lu(k,1863) - lu(k,1401) * lu(k,1850) + lu(k,1864) = lu(k,1864) - lu(k,1402) * lu(k,1850) + lu(k,1865) = lu(k,1865) - lu(k,1403) * lu(k,1850) + lu(k,1866) = lu(k,1866) - lu(k,1404) * lu(k,1850) + lu(k,1887) = lu(k,1887) - lu(k,1389) * lu(k,1886) + lu(k,1888) = lu(k,1888) - lu(k,1390) * lu(k,1886) + lu(k,1889) = lu(k,1889) - lu(k,1391) * lu(k,1886) + lu(k,1890) = lu(k,1890) - lu(k,1392) * lu(k,1886) + lu(k,1891) = lu(k,1891) - lu(k,1393) * lu(k,1886) + lu(k,1892) = lu(k,1892) - lu(k,1394) * lu(k,1886) + lu(k,1893) = lu(k,1893) - lu(k,1395) * lu(k,1886) + lu(k,1894) = lu(k,1894) - lu(k,1396) * lu(k,1886) + lu(k,1895) = lu(k,1895) - lu(k,1397) * lu(k,1886) + lu(k,1896) = lu(k,1896) - lu(k,1398) * lu(k,1886) + lu(k,1897) = lu(k,1897) - lu(k,1399) * lu(k,1886) + lu(k,1898) = lu(k,1898) - lu(k,1400) * lu(k,1886) + lu(k,1899) = lu(k,1899) - lu(k,1401) * lu(k,1886) + lu(k,1900) = lu(k,1900) - lu(k,1402) * lu(k,1886) + lu(k,1901) = lu(k,1901) - lu(k,1403) * lu(k,1886) + lu(k,1902) = lu(k,1902) - lu(k,1404) * lu(k,1886) + lu(k,1928) = lu(k,1928) - lu(k,1389) * lu(k,1927) + lu(k,1929) = lu(k,1929) - lu(k,1390) * lu(k,1927) + lu(k,1930) = lu(k,1930) - lu(k,1391) * lu(k,1927) + lu(k,1931) = lu(k,1931) - lu(k,1392) * lu(k,1927) + lu(k,1932) = lu(k,1932) - lu(k,1393) * lu(k,1927) + lu(k,1933) = lu(k,1933) - lu(k,1394) * lu(k,1927) + lu(k,1934) = lu(k,1934) - lu(k,1395) * lu(k,1927) + lu(k,1935) = lu(k,1935) - lu(k,1396) * lu(k,1927) + lu(k,1936) = lu(k,1936) - lu(k,1397) * lu(k,1927) + lu(k,1937) = lu(k,1937) - lu(k,1398) * lu(k,1927) + lu(k,1938) = lu(k,1938) - lu(k,1399) * lu(k,1927) + lu(k,1939) = lu(k,1939) - lu(k,1400) * lu(k,1927) + lu(k,1940) = lu(k,1940) - lu(k,1401) * lu(k,1927) + lu(k,1941) = lu(k,1941) - lu(k,1402) * lu(k,1927) + lu(k,1942) = lu(k,1942) - lu(k,1403) * lu(k,1927) + lu(k,1943) = lu(k,1943) - lu(k,1404) * lu(k,1927) + lu(k,1970) = lu(k,1970) - lu(k,1389) * lu(k,1969) + lu(k,1971) = lu(k,1971) - lu(k,1390) * lu(k,1969) + lu(k,1972) = lu(k,1972) - lu(k,1391) * lu(k,1969) + lu(k,1973) = lu(k,1973) - lu(k,1392) * lu(k,1969) + lu(k,1974) = lu(k,1974) - lu(k,1393) * lu(k,1969) + lu(k,1975) = lu(k,1975) - lu(k,1394) * lu(k,1969) + lu(k,1976) = lu(k,1976) - lu(k,1395) * lu(k,1969) + lu(k,1977) = lu(k,1977) - lu(k,1396) * lu(k,1969) + lu(k,1978) = lu(k,1978) - lu(k,1397) * lu(k,1969) + lu(k,1979) = lu(k,1979) - lu(k,1398) * lu(k,1969) + lu(k,1980) = lu(k,1980) - lu(k,1399) * lu(k,1969) + lu(k,1981) = lu(k,1981) - lu(k,1400) * lu(k,1969) + lu(k,1982) = lu(k,1982) - lu(k,1401) * lu(k,1969) + lu(k,1983) = lu(k,1983) - lu(k,1402) * lu(k,1969) + lu(k,1984) = lu(k,1984) - lu(k,1403) * lu(k,1969) + lu(k,1985) = lu(k,1985) - lu(k,1404) * lu(k,1969) + lu(k,2015) = lu(k,2015) - lu(k,1389) * lu(k,2014) + lu(k,2016) = lu(k,2016) - lu(k,1390) * lu(k,2014) + lu(k,2017) = lu(k,2017) - lu(k,1391) * lu(k,2014) + lu(k,2018) = lu(k,2018) - lu(k,1392) * lu(k,2014) + lu(k,2019) = lu(k,2019) - lu(k,1393) * lu(k,2014) + lu(k,2020) = lu(k,2020) - lu(k,1394) * lu(k,2014) + lu(k,2021) = lu(k,2021) - lu(k,1395) * lu(k,2014) + lu(k,2022) = lu(k,2022) - lu(k,1396) * lu(k,2014) + lu(k,2023) = lu(k,2023) - lu(k,1397) * lu(k,2014) + lu(k,2024) = lu(k,2024) - lu(k,1398) * lu(k,2014) + lu(k,2025) = lu(k,2025) - lu(k,1399) * lu(k,2014) + lu(k,2026) = lu(k,2026) - lu(k,1400) * lu(k,2014) + lu(k,2027) = lu(k,2027) - lu(k,1401) * lu(k,2014) + lu(k,2028) = lu(k,2028) - lu(k,1402) * lu(k,2014) + lu(k,2029) = lu(k,2029) - lu(k,1403) * lu(k,2014) + lu(k,2030) = lu(k,2030) - lu(k,1404) * lu(k,2014) + lu(k,2075) = lu(k,2075) - lu(k,1389) * lu(k,2074) + lu(k,2076) = lu(k,2076) - lu(k,1390) * lu(k,2074) + lu(k,2077) = lu(k,2077) - lu(k,1391) * lu(k,2074) + lu(k,2078) = lu(k,2078) - lu(k,1392) * lu(k,2074) + lu(k,2079) = lu(k,2079) - lu(k,1393) * lu(k,2074) + lu(k,2080) = lu(k,2080) - lu(k,1394) * lu(k,2074) + lu(k,2081) = lu(k,2081) - lu(k,1395) * lu(k,2074) + lu(k,2082) = lu(k,2082) - lu(k,1396) * lu(k,2074) + lu(k,2083) = lu(k,2083) - lu(k,1397) * lu(k,2074) + lu(k,2084) = lu(k,2084) - lu(k,1398) * lu(k,2074) + lu(k,2085) = lu(k,2085) - lu(k,1399) * lu(k,2074) + lu(k,2086) = lu(k,2086) - lu(k,1400) * lu(k,2074) + lu(k,2087) = lu(k,2087) - lu(k,1401) * lu(k,2074) + lu(k,2088) = lu(k,2088) - lu(k,1402) * lu(k,2074) + lu(k,2089) = lu(k,2089) - lu(k,1403) * lu(k,2074) + lu(k,2090) = lu(k,2090) - lu(k,1404) * lu(k,2074) + lu(k,1438) = 1._r8 / lu(k,1438) + lu(k,1439) = lu(k,1439) * lu(k,1438) + lu(k,1440) = lu(k,1440) * lu(k,1438) + lu(k,1441) = lu(k,1441) * lu(k,1438) + lu(k,1442) = lu(k,1442) * lu(k,1438) + lu(k,1443) = lu(k,1443) * lu(k,1438) + lu(k,1444) = lu(k,1444) * lu(k,1438) + lu(k,1445) = lu(k,1445) * lu(k,1438) + lu(k,1446) = lu(k,1446) * lu(k,1438) + lu(k,1447) = lu(k,1447) * lu(k,1438) + lu(k,1448) = lu(k,1448) * lu(k,1438) + lu(k,1449) = lu(k,1449) * lu(k,1438) + lu(k,1450) = lu(k,1450) * lu(k,1438) + lu(k,1451) = lu(k,1451) * lu(k,1438) + lu(k,1452) = lu(k,1452) * lu(k,1438) + lu(k,1453) = lu(k,1453) * lu(k,1438) + lu(k,1487) = lu(k,1487) - lu(k,1439) * lu(k,1486) + lu(k,1488) = lu(k,1488) - lu(k,1440) * lu(k,1486) + lu(k,1489) = lu(k,1489) - lu(k,1441) * lu(k,1486) + lu(k,1490) = lu(k,1490) - lu(k,1442) * lu(k,1486) + lu(k,1491) = lu(k,1491) - lu(k,1443) * lu(k,1486) + lu(k,1492) = lu(k,1492) - lu(k,1444) * lu(k,1486) + lu(k,1493) = lu(k,1493) - lu(k,1445) * lu(k,1486) + lu(k,1494) = lu(k,1494) - lu(k,1446) * lu(k,1486) + lu(k,1495) = lu(k,1495) - lu(k,1447) * lu(k,1486) + lu(k,1496) = lu(k,1496) - lu(k,1448) * lu(k,1486) + lu(k,1497) = lu(k,1497) - lu(k,1449) * lu(k,1486) + lu(k,1498) = lu(k,1498) - lu(k,1450) * lu(k,1486) + lu(k,1499) = lu(k,1499) - lu(k,1451) * lu(k,1486) + lu(k,1500) = lu(k,1500) - lu(k,1452) * lu(k,1486) + lu(k,1501) = lu(k,1501) - lu(k,1453) * lu(k,1486) + lu(k,1528) = lu(k,1528) - lu(k,1439) * lu(k,1527) + lu(k,1529) = lu(k,1529) - lu(k,1440) * lu(k,1527) + lu(k,1530) = lu(k,1530) - lu(k,1441) * lu(k,1527) + lu(k,1531) = lu(k,1531) - lu(k,1442) * lu(k,1527) + lu(k,1532) = lu(k,1532) - lu(k,1443) * lu(k,1527) + lu(k,1533) = lu(k,1533) - lu(k,1444) * lu(k,1527) + lu(k,1534) = lu(k,1534) - lu(k,1445) * lu(k,1527) + lu(k,1535) = lu(k,1535) - lu(k,1446) * lu(k,1527) + lu(k,1536) = lu(k,1536) - lu(k,1447) * lu(k,1527) + lu(k,1537) = lu(k,1537) - lu(k,1448) * lu(k,1527) + lu(k,1538) = lu(k,1538) - lu(k,1449) * lu(k,1527) + lu(k,1539) = lu(k,1539) - lu(k,1450) * lu(k,1527) + lu(k,1540) = lu(k,1540) - lu(k,1451) * lu(k,1527) + lu(k,1541) = lu(k,1541) - lu(k,1452) * lu(k,1527) + lu(k,1542) = lu(k,1542) - lu(k,1453) * lu(k,1527) + lu(k,1564) = lu(k,1564) - lu(k,1439) * lu(k,1563) + lu(k,1565) = lu(k,1565) - lu(k,1440) * lu(k,1563) + lu(k,1566) = lu(k,1566) - lu(k,1441) * lu(k,1563) + lu(k,1567) = lu(k,1567) - lu(k,1442) * lu(k,1563) + lu(k,1568) = lu(k,1568) - lu(k,1443) * lu(k,1563) + lu(k,1569) = lu(k,1569) - lu(k,1444) * lu(k,1563) + lu(k,1570) = lu(k,1570) - lu(k,1445) * lu(k,1563) + lu(k,1571) = lu(k,1571) - lu(k,1446) * lu(k,1563) + lu(k,1572) = lu(k,1572) - lu(k,1447) * lu(k,1563) + lu(k,1573) = lu(k,1573) - lu(k,1448) * lu(k,1563) + lu(k,1574) = lu(k,1574) - lu(k,1449) * lu(k,1563) + lu(k,1575) = lu(k,1575) - lu(k,1450) * lu(k,1563) + lu(k,1576) = lu(k,1576) - lu(k,1451) * lu(k,1563) + lu(k,1577) = lu(k,1577) - lu(k,1452) * lu(k,1563) + lu(k,1578) = lu(k,1578) - lu(k,1453) * lu(k,1563) + lu(k,1609) = lu(k,1609) - lu(k,1439) * lu(k,1608) + lu(k,1610) = lu(k,1610) - lu(k,1440) * lu(k,1608) + lu(k,1611) = lu(k,1611) - lu(k,1441) * lu(k,1608) + lu(k,1612) = lu(k,1612) - lu(k,1442) * lu(k,1608) + lu(k,1613) = lu(k,1613) - lu(k,1443) * lu(k,1608) + lu(k,1614) = lu(k,1614) - lu(k,1444) * lu(k,1608) + lu(k,1615) = lu(k,1615) - lu(k,1445) * lu(k,1608) + lu(k,1616) = lu(k,1616) - lu(k,1446) * lu(k,1608) + lu(k,1617) = lu(k,1617) - lu(k,1447) * lu(k,1608) + lu(k,1618) = lu(k,1618) - lu(k,1448) * lu(k,1608) + lu(k,1619) = lu(k,1619) - lu(k,1449) * lu(k,1608) + lu(k,1620) = lu(k,1620) - lu(k,1450) * lu(k,1608) + lu(k,1621) = lu(k,1621) - lu(k,1451) * lu(k,1608) + lu(k,1622) = lu(k,1622) - lu(k,1452) * lu(k,1608) + lu(k,1623) = lu(k,1623) - lu(k,1453) * lu(k,1608) + lu(k,1652) = lu(k,1652) - lu(k,1439) * lu(k,1651) + lu(k,1653) = lu(k,1653) - lu(k,1440) * lu(k,1651) + lu(k,1654) = lu(k,1654) - lu(k,1441) * lu(k,1651) + lu(k,1655) = lu(k,1655) - lu(k,1442) * lu(k,1651) + lu(k,1656) = lu(k,1656) - lu(k,1443) * lu(k,1651) + lu(k,1657) = lu(k,1657) - lu(k,1444) * lu(k,1651) + lu(k,1658) = lu(k,1658) - lu(k,1445) * lu(k,1651) + lu(k,1659) = lu(k,1659) - lu(k,1446) * lu(k,1651) + lu(k,1660) = lu(k,1660) - lu(k,1447) * lu(k,1651) + lu(k,1661) = lu(k,1661) - lu(k,1448) * lu(k,1651) + lu(k,1662) = lu(k,1662) - lu(k,1449) * lu(k,1651) + lu(k,1663) = lu(k,1663) - lu(k,1450) * lu(k,1651) + lu(k,1664) = lu(k,1664) - lu(k,1451) * lu(k,1651) + lu(k,1665) = lu(k,1665) - lu(k,1452) * lu(k,1651) + lu(k,1666) = lu(k,1666) - lu(k,1453) * lu(k,1651) + lu(k,1695) = lu(k,1695) - lu(k,1439) * lu(k,1694) + lu(k,1696) = lu(k,1696) - lu(k,1440) * lu(k,1694) + lu(k,1697) = lu(k,1697) - lu(k,1441) * lu(k,1694) + lu(k,1698) = lu(k,1698) - lu(k,1442) * lu(k,1694) + lu(k,1699) = lu(k,1699) - lu(k,1443) * lu(k,1694) + lu(k,1700) = lu(k,1700) - lu(k,1444) * lu(k,1694) + lu(k,1701) = lu(k,1701) - lu(k,1445) * lu(k,1694) + lu(k,1702) = lu(k,1702) - lu(k,1446) * lu(k,1694) + lu(k,1703) = lu(k,1703) - lu(k,1447) * lu(k,1694) + lu(k,1704) = lu(k,1704) - lu(k,1448) * lu(k,1694) + lu(k,1705) = lu(k,1705) - lu(k,1449) * lu(k,1694) + lu(k,1706) = lu(k,1706) - lu(k,1450) * lu(k,1694) + lu(k,1707) = lu(k,1707) - lu(k,1451) * lu(k,1694) + lu(k,1708) = lu(k,1708) - lu(k,1452) * lu(k,1694) + lu(k,1709) = lu(k,1709) - lu(k,1453) * lu(k,1694) + lu(k,1735) = lu(k,1735) - lu(k,1439) * lu(k,1734) + lu(k,1736) = lu(k,1736) - lu(k,1440) * lu(k,1734) + lu(k,1737) = lu(k,1737) - lu(k,1441) * lu(k,1734) + lu(k,1738) = lu(k,1738) - lu(k,1442) * lu(k,1734) + lu(k,1739) = lu(k,1739) - lu(k,1443) * lu(k,1734) + lu(k,1740) = lu(k,1740) - lu(k,1444) * lu(k,1734) + lu(k,1741) = lu(k,1741) - lu(k,1445) * lu(k,1734) + lu(k,1742) = lu(k,1742) - lu(k,1446) * lu(k,1734) + lu(k,1743) = lu(k,1743) - lu(k,1447) * lu(k,1734) + lu(k,1744) = lu(k,1744) - lu(k,1448) * lu(k,1734) + lu(k,1745) = lu(k,1745) - lu(k,1449) * lu(k,1734) + lu(k,1746) = lu(k,1746) - lu(k,1450) * lu(k,1734) + lu(k,1747) = lu(k,1747) - lu(k,1451) * lu(k,1734) + lu(k,1748) = lu(k,1748) - lu(k,1452) * lu(k,1734) + lu(k,1749) = lu(k,1749) - lu(k,1453) * lu(k,1734) + lu(k,1771) = lu(k,1771) - lu(k,1439) * lu(k,1770) + lu(k,1772) = lu(k,1772) - lu(k,1440) * lu(k,1770) + lu(k,1773) = lu(k,1773) - lu(k,1441) * lu(k,1770) + lu(k,1774) = lu(k,1774) - lu(k,1442) * lu(k,1770) + lu(k,1775) = lu(k,1775) - lu(k,1443) * lu(k,1770) + lu(k,1776) = lu(k,1776) - lu(k,1444) * lu(k,1770) + lu(k,1777) = lu(k,1777) - lu(k,1445) * lu(k,1770) + lu(k,1778) = lu(k,1778) - lu(k,1446) * lu(k,1770) + lu(k,1779) = lu(k,1779) - lu(k,1447) * lu(k,1770) + lu(k,1780) = lu(k,1780) - lu(k,1448) * lu(k,1770) + lu(k,1781) = lu(k,1781) - lu(k,1449) * lu(k,1770) + lu(k,1782) = lu(k,1782) - lu(k,1450) * lu(k,1770) + lu(k,1783) = lu(k,1783) - lu(k,1451) * lu(k,1770) + lu(k,1784) = lu(k,1784) - lu(k,1452) * lu(k,1770) + lu(k,1785) = lu(k,1785) - lu(k,1453) * lu(k,1770) + lu(k,1819) = lu(k,1819) - lu(k,1439) * lu(k,1818) + lu(k,1820) = lu(k,1820) - lu(k,1440) * lu(k,1818) + lu(k,1821) = lu(k,1821) - lu(k,1441) * lu(k,1818) + lu(k,1822) = lu(k,1822) - lu(k,1442) * lu(k,1818) + lu(k,1823) = lu(k,1823) - lu(k,1443) * lu(k,1818) + lu(k,1824) = lu(k,1824) - lu(k,1444) * lu(k,1818) + lu(k,1825) = lu(k,1825) - lu(k,1445) * lu(k,1818) + lu(k,1826) = lu(k,1826) - lu(k,1446) * lu(k,1818) + lu(k,1827) = lu(k,1827) - lu(k,1447) * lu(k,1818) + lu(k,1828) = lu(k,1828) - lu(k,1448) * lu(k,1818) + lu(k,1829) = lu(k,1829) - lu(k,1449) * lu(k,1818) + lu(k,1830) = lu(k,1830) - lu(k,1450) * lu(k,1818) + lu(k,1831) = lu(k,1831) - lu(k,1451) * lu(k,1818) + lu(k,1832) = lu(k,1832) - lu(k,1452) * lu(k,1818) + lu(k,1833) = lu(k,1833) - lu(k,1453) * lu(k,1818) + lu(k,1852) = lu(k,1852) - lu(k,1439) * lu(k,1851) + lu(k,1853) = lu(k,1853) - lu(k,1440) * lu(k,1851) + lu(k,1854) = lu(k,1854) - lu(k,1441) * lu(k,1851) + lu(k,1855) = lu(k,1855) - lu(k,1442) * lu(k,1851) + lu(k,1856) = lu(k,1856) - lu(k,1443) * lu(k,1851) + lu(k,1857) = lu(k,1857) - lu(k,1444) * lu(k,1851) + lu(k,1858) = lu(k,1858) - lu(k,1445) * lu(k,1851) + lu(k,1859) = lu(k,1859) - lu(k,1446) * lu(k,1851) + lu(k,1860) = lu(k,1860) - lu(k,1447) * lu(k,1851) + lu(k,1861) = lu(k,1861) - lu(k,1448) * lu(k,1851) + lu(k,1862) = lu(k,1862) - lu(k,1449) * lu(k,1851) + lu(k,1863) = lu(k,1863) - lu(k,1450) * lu(k,1851) + lu(k,1864) = lu(k,1864) - lu(k,1451) * lu(k,1851) + lu(k,1865) = lu(k,1865) - lu(k,1452) * lu(k,1851) + lu(k,1866) = lu(k,1866) - lu(k,1453) * lu(k,1851) + lu(k,1888) = lu(k,1888) - lu(k,1439) * lu(k,1887) + lu(k,1889) = lu(k,1889) - lu(k,1440) * lu(k,1887) + lu(k,1890) = lu(k,1890) - lu(k,1441) * lu(k,1887) + lu(k,1891) = lu(k,1891) - lu(k,1442) * lu(k,1887) + lu(k,1892) = lu(k,1892) - lu(k,1443) * lu(k,1887) + lu(k,1893) = lu(k,1893) - lu(k,1444) * lu(k,1887) + lu(k,1894) = lu(k,1894) - lu(k,1445) * lu(k,1887) + lu(k,1895) = lu(k,1895) - lu(k,1446) * lu(k,1887) + lu(k,1896) = lu(k,1896) - lu(k,1447) * lu(k,1887) + lu(k,1897) = lu(k,1897) - lu(k,1448) * lu(k,1887) + lu(k,1898) = lu(k,1898) - lu(k,1449) * lu(k,1887) + lu(k,1899) = lu(k,1899) - lu(k,1450) * lu(k,1887) + lu(k,1900) = lu(k,1900) - lu(k,1451) * lu(k,1887) + lu(k,1901) = lu(k,1901) - lu(k,1452) * lu(k,1887) + lu(k,1902) = lu(k,1902) - lu(k,1453) * lu(k,1887) + lu(k,1929) = lu(k,1929) - lu(k,1439) * lu(k,1928) + lu(k,1930) = lu(k,1930) - lu(k,1440) * lu(k,1928) + lu(k,1931) = lu(k,1931) - lu(k,1441) * lu(k,1928) + lu(k,1932) = lu(k,1932) - lu(k,1442) * lu(k,1928) + lu(k,1933) = lu(k,1933) - lu(k,1443) * lu(k,1928) + lu(k,1934) = lu(k,1934) - lu(k,1444) * lu(k,1928) + lu(k,1935) = lu(k,1935) - lu(k,1445) * lu(k,1928) + lu(k,1936) = lu(k,1936) - lu(k,1446) * lu(k,1928) + lu(k,1937) = lu(k,1937) - lu(k,1447) * lu(k,1928) + lu(k,1938) = lu(k,1938) - lu(k,1448) * lu(k,1928) + lu(k,1939) = lu(k,1939) - lu(k,1449) * lu(k,1928) + lu(k,1940) = lu(k,1940) - lu(k,1450) * lu(k,1928) + lu(k,1941) = lu(k,1941) - lu(k,1451) * lu(k,1928) + lu(k,1942) = lu(k,1942) - lu(k,1452) * lu(k,1928) + lu(k,1943) = lu(k,1943) - lu(k,1453) * lu(k,1928) + lu(k,1971) = lu(k,1971) - lu(k,1439) * lu(k,1970) + lu(k,1972) = lu(k,1972) - lu(k,1440) * lu(k,1970) + lu(k,1973) = lu(k,1973) - lu(k,1441) * lu(k,1970) + lu(k,1974) = lu(k,1974) - lu(k,1442) * lu(k,1970) + lu(k,1975) = lu(k,1975) - lu(k,1443) * lu(k,1970) + lu(k,1976) = lu(k,1976) - lu(k,1444) * lu(k,1970) + lu(k,1977) = lu(k,1977) - lu(k,1445) * lu(k,1970) + lu(k,1978) = lu(k,1978) - lu(k,1446) * lu(k,1970) + lu(k,1979) = lu(k,1979) - lu(k,1447) * lu(k,1970) + lu(k,1980) = lu(k,1980) - lu(k,1448) * lu(k,1970) + lu(k,1981) = lu(k,1981) - lu(k,1449) * lu(k,1970) + lu(k,1982) = lu(k,1982) - lu(k,1450) * lu(k,1970) + lu(k,1983) = lu(k,1983) - lu(k,1451) * lu(k,1970) + lu(k,1984) = lu(k,1984) - lu(k,1452) * lu(k,1970) + lu(k,1985) = lu(k,1985) - lu(k,1453) * lu(k,1970) + lu(k,2016) = lu(k,2016) - lu(k,1439) * lu(k,2015) + lu(k,2017) = lu(k,2017) - lu(k,1440) * lu(k,2015) + lu(k,2018) = lu(k,2018) - lu(k,1441) * lu(k,2015) + lu(k,2019) = lu(k,2019) - lu(k,1442) * lu(k,2015) + lu(k,2020) = lu(k,2020) - lu(k,1443) * lu(k,2015) + lu(k,2021) = lu(k,2021) - lu(k,1444) * lu(k,2015) + lu(k,2022) = lu(k,2022) - lu(k,1445) * lu(k,2015) + lu(k,2023) = lu(k,2023) - lu(k,1446) * lu(k,2015) + lu(k,2024) = lu(k,2024) - lu(k,1447) * lu(k,2015) + lu(k,2025) = lu(k,2025) - lu(k,1448) * lu(k,2015) + lu(k,2026) = lu(k,2026) - lu(k,1449) * lu(k,2015) + lu(k,2027) = lu(k,2027) - lu(k,1450) * lu(k,2015) + lu(k,2028) = lu(k,2028) - lu(k,1451) * lu(k,2015) + lu(k,2029) = lu(k,2029) - lu(k,1452) * lu(k,2015) + lu(k,2030) = lu(k,2030) - lu(k,1453) * lu(k,2015) + lu(k,2076) = lu(k,2076) - lu(k,1439) * lu(k,2075) + lu(k,2077) = lu(k,2077) - lu(k,1440) * lu(k,2075) + lu(k,2078) = lu(k,2078) - lu(k,1441) * lu(k,2075) + lu(k,2079) = lu(k,2079) - lu(k,1442) * lu(k,2075) + lu(k,2080) = lu(k,2080) - lu(k,1443) * lu(k,2075) + lu(k,2081) = lu(k,2081) - lu(k,1444) * lu(k,2075) + lu(k,2082) = lu(k,2082) - lu(k,1445) * lu(k,2075) + lu(k,2083) = lu(k,2083) - lu(k,1446) * lu(k,2075) + lu(k,2084) = lu(k,2084) - lu(k,1447) * lu(k,2075) + lu(k,2085) = lu(k,2085) - lu(k,1448) * lu(k,2075) + lu(k,2086) = lu(k,2086) - lu(k,1449) * lu(k,2075) + lu(k,2087) = lu(k,2087) - lu(k,1450) * lu(k,2075) + lu(k,2088) = lu(k,2088) - lu(k,1451) * lu(k,2075) + lu(k,2089) = lu(k,2089) - lu(k,1452) * lu(k,2075) + lu(k,2090) = lu(k,2090) - lu(k,1453) * lu(k,2075) + lu(k,1487) = 1._r8 / lu(k,1487) + lu(k,1488) = lu(k,1488) * lu(k,1487) + lu(k,1489) = lu(k,1489) * lu(k,1487) + lu(k,1490) = lu(k,1490) * lu(k,1487) + lu(k,1491) = lu(k,1491) * lu(k,1487) + lu(k,1492) = lu(k,1492) * lu(k,1487) + lu(k,1493) = lu(k,1493) * lu(k,1487) + lu(k,1494) = lu(k,1494) * lu(k,1487) + lu(k,1495) = lu(k,1495) * lu(k,1487) + lu(k,1496) = lu(k,1496) * lu(k,1487) + lu(k,1497) = lu(k,1497) * lu(k,1487) + lu(k,1498) = lu(k,1498) * lu(k,1487) + lu(k,1499) = lu(k,1499) * lu(k,1487) + lu(k,1500) = lu(k,1500) * lu(k,1487) + lu(k,1501) = lu(k,1501) * lu(k,1487) + lu(k,1529) = lu(k,1529) - lu(k,1488) * lu(k,1528) + lu(k,1530) = lu(k,1530) - lu(k,1489) * lu(k,1528) + lu(k,1531) = lu(k,1531) - lu(k,1490) * lu(k,1528) + lu(k,1532) = lu(k,1532) - lu(k,1491) * lu(k,1528) + lu(k,1533) = lu(k,1533) - lu(k,1492) * lu(k,1528) + lu(k,1534) = lu(k,1534) - lu(k,1493) * lu(k,1528) + lu(k,1535) = lu(k,1535) - lu(k,1494) * lu(k,1528) + lu(k,1536) = lu(k,1536) - lu(k,1495) * lu(k,1528) + lu(k,1537) = lu(k,1537) - lu(k,1496) * lu(k,1528) + lu(k,1538) = lu(k,1538) - lu(k,1497) * lu(k,1528) + lu(k,1539) = lu(k,1539) - lu(k,1498) * lu(k,1528) + lu(k,1540) = lu(k,1540) - lu(k,1499) * lu(k,1528) + lu(k,1541) = lu(k,1541) - lu(k,1500) * lu(k,1528) + lu(k,1542) = lu(k,1542) - lu(k,1501) * lu(k,1528) + lu(k,1565) = lu(k,1565) - lu(k,1488) * lu(k,1564) + lu(k,1566) = lu(k,1566) - lu(k,1489) * lu(k,1564) + lu(k,1567) = lu(k,1567) - lu(k,1490) * lu(k,1564) + lu(k,1568) = lu(k,1568) - lu(k,1491) * lu(k,1564) + lu(k,1569) = lu(k,1569) - lu(k,1492) * lu(k,1564) + lu(k,1570) = lu(k,1570) - lu(k,1493) * lu(k,1564) + lu(k,1571) = lu(k,1571) - lu(k,1494) * lu(k,1564) + lu(k,1572) = lu(k,1572) - lu(k,1495) * lu(k,1564) + lu(k,1573) = lu(k,1573) - lu(k,1496) * lu(k,1564) + lu(k,1574) = lu(k,1574) - lu(k,1497) * lu(k,1564) + lu(k,1575) = lu(k,1575) - lu(k,1498) * lu(k,1564) + lu(k,1576) = lu(k,1576) - lu(k,1499) * lu(k,1564) + lu(k,1577) = lu(k,1577) - lu(k,1500) * lu(k,1564) + lu(k,1578) = lu(k,1578) - lu(k,1501) * lu(k,1564) + lu(k,1610) = lu(k,1610) - lu(k,1488) * lu(k,1609) + lu(k,1611) = lu(k,1611) - lu(k,1489) * lu(k,1609) + lu(k,1612) = lu(k,1612) - lu(k,1490) * lu(k,1609) + lu(k,1613) = lu(k,1613) - lu(k,1491) * lu(k,1609) + lu(k,1614) = lu(k,1614) - lu(k,1492) * lu(k,1609) + lu(k,1615) = lu(k,1615) - lu(k,1493) * lu(k,1609) + lu(k,1616) = lu(k,1616) - lu(k,1494) * lu(k,1609) + lu(k,1617) = lu(k,1617) - lu(k,1495) * lu(k,1609) + lu(k,1618) = lu(k,1618) - lu(k,1496) * lu(k,1609) + lu(k,1619) = lu(k,1619) - lu(k,1497) * lu(k,1609) + lu(k,1620) = lu(k,1620) - lu(k,1498) * lu(k,1609) + lu(k,1621) = lu(k,1621) - lu(k,1499) * lu(k,1609) + lu(k,1622) = lu(k,1622) - lu(k,1500) * lu(k,1609) + lu(k,1623) = lu(k,1623) - lu(k,1501) * lu(k,1609) + lu(k,1653) = lu(k,1653) - lu(k,1488) * lu(k,1652) + lu(k,1654) = lu(k,1654) - lu(k,1489) * lu(k,1652) + lu(k,1655) = lu(k,1655) - lu(k,1490) * lu(k,1652) + lu(k,1656) = lu(k,1656) - lu(k,1491) * lu(k,1652) + lu(k,1657) = lu(k,1657) - lu(k,1492) * lu(k,1652) + lu(k,1658) = lu(k,1658) - lu(k,1493) * lu(k,1652) + lu(k,1659) = lu(k,1659) - lu(k,1494) * lu(k,1652) + lu(k,1660) = lu(k,1660) - lu(k,1495) * lu(k,1652) + lu(k,1661) = lu(k,1661) - lu(k,1496) * lu(k,1652) + lu(k,1662) = lu(k,1662) - lu(k,1497) * lu(k,1652) + lu(k,1663) = lu(k,1663) - lu(k,1498) * lu(k,1652) + lu(k,1664) = lu(k,1664) - lu(k,1499) * lu(k,1652) + lu(k,1665) = lu(k,1665) - lu(k,1500) * lu(k,1652) + lu(k,1666) = lu(k,1666) - lu(k,1501) * lu(k,1652) + lu(k,1696) = lu(k,1696) - lu(k,1488) * lu(k,1695) + lu(k,1697) = lu(k,1697) - lu(k,1489) * lu(k,1695) + lu(k,1698) = lu(k,1698) - lu(k,1490) * lu(k,1695) + lu(k,1699) = lu(k,1699) - lu(k,1491) * lu(k,1695) + lu(k,1700) = lu(k,1700) - lu(k,1492) * lu(k,1695) + lu(k,1701) = lu(k,1701) - lu(k,1493) * lu(k,1695) + lu(k,1702) = lu(k,1702) - lu(k,1494) * lu(k,1695) + lu(k,1703) = lu(k,1703) - lu(k,1495) * lu(k,1695) + lu(k,1704) = lu(k,1704) - lu(k,1496) * lu(k,1695) + lu(k,1705) = lu(k,1705) - lu(k,1497) * lu(k,1695) + lu(k,1706) = lu(k,1706) - lu(k,1498) * lu(k,1695) + lu(k,1707) = lu(k,1707) - lu(k,1499) * lu(k,1695) + lu(k,1708) = lu(k,1708) - lu(k,1500) * lu(k,1695) + lu(k,1709) = lu(k,1709) - lu(k,1501) * lu(k,1695) + lu(k,1736) = lu(k,1736) - lu(k,1488) * lu(k,1735) + lu(k,1737) = lu(k,1737) - lu(k,1489) * lu(k,1735) + lu(k,1738) = lu(k,1738) - lu(k,1490) * lu(k,1735) + lu(k,1739) = lu(k,1739) - lu(k,1491) * lu(k,1735) + lu(k,1740) = lu(k,1740) - lu(k,1492) * lu(k,1735) + lu(k,1741) = lu(k,1741) - lu(k,1493) * lu(k,1735) + lu(k,1742) = lu(k,1742) - lu(k,1494) * lu(k,1735) + lu(k,1743) = lu(k,1743) - lu(k,1495) * lu(k,1735) + lu(k,1744) = lu(k,1744) - lu(k,1496) * lu(k,1735) + lu(k,1745) = lu(k,1745) - lu(k,1497) * lu(k,1735) + lu(k,1746) = lu(k,1746) - lu(k,1498) * lu(k,1735) + lu(k,1747) = lu(k,1747) - lu(k,1499) * lu(k,1735) + lu(k,1748) = lu(k,1748) - lu(k,1500) * lu(k,1735) + lu(k,1749) = lu(k,1749) - lu(k,1501) * lu(k,1735) + lu(k,1772) = lu(k,1772) - lu(k,1488) * lu(k,1771) + lu(k,1773) = lu(k,1773) - lu(k,1489) * lu(k,1771) + lu(k,1774) = lu(k,1774) - lu(k,1490) * lu(k,1771) + lu(k,1775) = lu(k,1775) - lu(k,1491) * lu(k,1771) + lu(k,1776) = lu(k,1776) - lu(k,1492) * lu(k,1771) + lu(k,1777) = lu(k,1777) - lu(k,1493) * lu(k,1771) + lu(k,1778) = lu(k,1778) - lu(k,1494) * lu(k,1771) + lu(k,1779) = lu(k,1779) - lu(k,1495) * lu(k,1771) + lu(k,1780) = lu(k,1780) - lu(k,1496) * lu(k,1771) + lu(k,1781) = lu(k,1781) - lu(k,1497) * lu(k,1771) + lu(k,1782) = lu(k,1782) - lu(k,1498) * lu(k,1771) + lu(k,1783) = lu(k,1783) - lu(k,1499) * lu(k,1771) + lu(k,1784) = lu(k,1784) - lu(k,1500) * lu(k,1771) + lu(k,1785) = lu(k,1785) - lu(k,1501) * lu(k,1771) + lu(k,1820) = lu(k,1820) - lu(k,1488) * lu(k,1819) + lu(k,1821) = lu(k,1821) - lu(k,1489) * lu(k,1819) + lu(k,1822) = lu(k,1822) - lu(k,1490) * lu(k,1819) + lu(k,1823) = lu(k,1823) - lu(k,1491) * lu(k,1819) + lu(k,1824) = lu(k,1824) - lu(k,1492) * lu(k,1819) + lu(k,1825) = lu(k,1825) - lu(k,1493) * lu(k,1819) + lu(k,1826) = lu(k,1826) - lu(k,1494) * lu(k,1819) + lu(k,1827) = lu(k,1827) - lu(k,1495) * lu(k,1819) + lu(k,1828) = lu(k,1828) - lu(k,1496) * lu(k,1819) + lu(k,1829) = lu(k,1829) - lu(k,1497) * lu(k,1819) + lu(k,1830) = lu(k,1830) - lu(k,1498) * lu(k,1819) + lu(k,1831) = lu(k,1831) - lu(k,1499) * lu(k,1819) + lu(k,1832) = lu(k,1832) - lu(k,1500) * lu(k,1819) + lu(k,1833) = lu(k,1833) - lu(k,1501) * lu(k,1819) + lu(k,1853) = lu(k,1853) - lu(k,1488) * lu(k,1852) + lu(k,1854) = lu(k,1854) - lu(k,1489) * lu(k,1852) + lu(k,1855) = lu(k,1855) - lu(k,1490) * lu(k,1852) + lu(k,1856) = lu(k,1856) - lu(k,1491) * lu(k,1852) + lu(k,1857) = lu(k,1857) - lu(k,1492) * lu(k,1852) + lu(k,1858) = lu(k,1858) - lu(k,1493) * lu(k,1852) + lu(k,1859) = lu(k,1859) - lu(k,1494) * lu(k,1852) + lu(k,1860) = lu(k,1860) - lu(k,1495) * lu(k,1852) + lu(k,1861) = lu(k,1861) - lu(k,1496) * lu(k,1852) + lu(k,1862) = lu(k,1862) - lu(k,1497) * lu(k,1852) + lu(k,1863) = lu(k,1863) - lu(k,1498) * lu(k,1852) + lu(k,1864) = lu(k,1864) - lu(k,1499) * lu(k,1852) + lu(k,1865) = lu(k,1865) - lu(k,1500) * lu(k,1852) + lu(k,1866) = lu(k,1866) - lu(k,1501) * lu(k,1852) + lu(k,1889) = lu(k,1889) - lu(k,1488) * lu(k,1888) + lu(k,1890) = lu(k,1890) - lu(k,1489) * lu(k,1888) + lu(k,1891) = lu(k,1891) - lu(k,1490) * lu(k,1888) + lu(k,1892) = lu(k,1892) - lu(k,1491) * lu(k,1888) + lu(k,1893) = lu(k,1893) - lu(k,1492) * lu(k,1888) + lu(k,1894) = lu(k,1894) - lu(k,1493) * lu(k,1888) + lu(k,1895) = lu(k,1895) - lu(k,1494) * lu(k,1888) + lu(k,1896) = lu(k,1896) - lu(k,1495) * lu(k,1888) + lu(k,1897) = lu(k,1897) - lu(k,1496) * lu(k,1888) + lu(k,1898) = lu(k,1898) - lu(k,1497) * lu(k,1888) + lu(k,1899) = lu(k,1899) - lu(k,1498) * lu(k,1888) + lu(k,1900) = lu(k,1900) - lu(k,1499) * lu(k,1888) + lu(k,1901) = lu(k,1901) - lu(k,1500) * lu(k,1888) + lu(k,1902) = lu(k,1902) - lu(k,1501) * lu(k,1888) + lu(k,1930) = lu(k,1930) - lu(k,1488) * lu(k,1929) + lu(k,1931) = lu(k,1931) - lu(k,1489) * lu(k,1929) + lu(k,1932) = lu(k,1932) - lu(k,1490) * lu(k,1929) + lu(k,1933) = lu(k,1933) - lu(k,1491) * lu(k,1929) + lu(k,1934) = lu(k,1934) - lu(k,1492) * lu(k,1929) + lu(k,1935) = lu(k,1935) - lu(k,1493) * lu(k,1929) + lu(k,1936) = lu(k,1936) - lu(k,1494) * lu(k,1929) + lu(k,1937) = lu(k,1937) - lu(k,1495) * lu(k,1929) + lu(k,1938) = lu(k,1938) - lu(k,1496) * lu(k,1929) + lu(k,1939) = lu(k,1939) - lu(k,1497) * lu(k,1929) + lu(k,1940) = lu(k,1940) - lu(k,1498) * lu(k,1929) + lu(k,1941) = lu(k,1941) - lu(k,1499) * lu(k,1929) + lu(k,1942) = lu(k,1942) - lu(k,1500) * lu(k,1929) + lu(k,1943) = lu(k,1943) - lu(k,1501) * lu(k,1929) + lu(k,1972) = lu(k,1972) - lu(k,1488) * lu(k,1971) + lu(k,1973) = lu(k,1973) - lu(k,1489) * lu(k,1971) + lu(k,1974) = lu(k,1974) - lu(k,1490) * lu(k,1971) + lu(k,1975) = lu(k,1975) - lu(k,1491) * lu(k,1971) + lu(k,1976) = lu(k,1976) - lu(k,1492) * lu(k,1971) + lu(k,1977) = lu(k,1977) - lu(k,1493) * lu(k,1971) + lu(k,1978) = lu(k,1978) - lu(k,1494) * lu(k,1971) + lu(k,1979) = lu(k,1979) - lu(k,1495) * lu(k,1971) + lu(k,1980) = lu(k,1980) - lu(k,1496) * lu(k,1971) + lu(k,1981) = lu(k,1981) - lu(k,1497) * lu(k,1971) + lu(k,1982) = lu(k,1982) - lu(k,1498) * lu(k,1971) + lu(k,1983) = lu(k,1983) - lu(k,1499) * lu(k,1971) + lu(k,1984) = lu(k,1984) - lu(k,1500) * lu(k,1971) + lu(k,1985) = lu(k,1985) - lu(k,1501) * lu(k,1971) + lu(k,2017) = lu(k,2017) - lu(k,1488) * lu(k,2016) + lu(k,2018) = lu(k,2018) - lu(k,1489) * lu(k,2016) + lu(k,2019) = lu(k,2019) - lu(k,1490) * lu(k,2016) + lu(k,2020) = lu(k,2020) - lu(k,1491) * lu(k,2016) + lu(k,2021) = lu(k,2021) - lu(k,1492) * lu(k,2016) + lu(k,2022) = lu(k,2022) - lu(k,1493) * lu(k,2016) + lu(k,2023) = lu(k,2023) - lu(k,1494) * lu(k,2016) + lu(k,2024) = lu(k,2024) - lu(k,1495) * lu(k,2016) + lu(k,2025) = lu(k,2025) - lu(k,1496) * lu(k,2016) + lu(k,2026) = lu(k,2026) - lu(k,1497) * lu(k,2016) + lu(k,2027) = lu(k,2027) - lu(k,1498) * lu(k,2016) + lu(k,2028) = lu(k,2028) - lu(k,1499) * lu(k,2016) + lu(k,2029) = lu(k,2029) - lu(k,1500) * lu(k,2016) + lu(k,2030) = lu(k,2030) - lu(k,1501) * lu(k,2016) + lu(k,2077) = lu(k,2077) - lu(k,1488) * lu(k,2076) + lu(k,2078) = lu(k,2078) - lu(k,1489) * lu(k,2076) + lu(k,2079) = lu(k,2079) - lu(k,1490) * lu(k,2076) + lu(k,2080) = lu(k,2080) - lu(k,1491) * lu(k,2076) + lu(k,2081) = lu(k,2081) - lu(k,1492) * lu(k,2076) + lu(k,2082) = lu(k,2082) - lu(k,1493) * lu(k,2076) + lu(k,2083) = lu(k,2083) - lu(k,1494) * lu(k,2076) + lu(k,2084) = lu(k,2084) - lu(k,1495) * lu(k,2076) + lu(k,2085) = lu(k,2085) - lu(k,1496) * lu(k,2076) + lu(k,2086) = lu(k,2086) - lu(k,1497) * lu(k,2076) + lu(k,2087) = lu(k,2087) - lu(k,1498) * lu(k,2076) + lu(k,2088) = lu(k,2088) - lu(k,1499) * lu(k,2076) + lu(k,2089) = lu(k,2089) - lu(k,1500) * lu(k,2076) + lu(k,2090) = lu(k,2090) - lu(k,1501) * lu(k,2076) + lu(k,1529) = 1._r8 / lu(k,1529) + lu(k,1530) = lu(k,1530) * lu(k,1529) + lu(k,1531) = lu(k,1531) * lu(k,1529) + lu(k,1532) = lu(k,1532) * lu(k,1529) + lu(k,1533) = lu(k,1533) * lu(k,1529) + lu(k,1534) = lu(k,1534) * lu(k,1529) + lu(k,1535) = lu(k,1535) * lu(k,1529) + lu(k,1536) = lu(k,1536) * lu(k,1529) + lu(k,1537) = lu(k,1537) * lu(k,1529) + lu(k,1538) = lu(k,1538) * lu(k,1529) + lu(k,1539) = lu(k,1539) * lu(k,1529) + lu(k,1540) = lu(k,1540) * lu(k,1529) + lu(k,1541) = lu(k,1541) * lu(k,1529) + lu(k,1542) = lu(k,1542) * lu(k,1529) + lu(k,1566) = lu(k,1566) - lu(k,1530) * lu(k,1565) + lu(k,1567) = lu(k,1567) - lu(k,1531) * lu(k,1565) + lu(k,1568) = lu(k,1568) - lu(k,1532) * lu(k,1565) + lu(k,1569) = lu(k,1569) - lu(k,1533) * lu(k,1565) + lu(k,1570) = lu(k,1570) - lu(k,1534) * lu(k,1565) + lu(k,1571) = lu(k,1571) - lu(k,1535) * lu(k,1565) + lu(k,1572) = lu(k,1572) - lu(k,1536) * lu(k,1565) + lu(k,1573) = lu(k,1573) - lu(k,1537) * lu(k,1565) + lu(k,1574) = lu(k,1574) - lu(k,1538) * lu(k,1565) + lu(k,1575) = lu(k,1575) - lu(k,1539) * lu(k,1565) + lu(k,1576) = lu(k,1576) - lu(k,1540) * lu(k,1565) + lu(k,1577) = lu(k,1577) - lu(k,1541) * lu(k,1565) + lu(k,1578) = lu(k,1578) - lu(k,1542) * lu(k,1565) + lu(k,1611) = lu(k,1611) - lu(k,1530) * lu(k,1610) + lu(k,1612) = lu(k,1612) - lu(k,1531) * lu(k,1610) + lu(k,1613) = lu(k,1613) - lu(k,1532) * lu(k,1610) + lu(k,1614) = lu(k,1614) - lu(k,1533) * lu(k,1610) + lu(k,1615) = lu(k,1615) - lu(k,1534) * lu(k,1610) + lu(k,1616) = lu(k,1616) - lu(k,1535) * lu(k,1610) + lu(k,1617) = lu(k,1617) - lu(k,1536) * lu(k,1610) + lu(k,1618) = lu(k,1618) - lu(k,1537) * lu(k,1610) + lu(k,1619) = lu(k,1619) - lu(k,1538) * lu(k,1610) + lu(k,1620) = lu(k,1620) - lu(k,1539) * lu(k,1610) + lu(k,1621) = lu(k,1621) - lu(k,1540) * lu(k,1610) + lu(k,1622) = lu(k,1622) - lu(k,1541) * lu(k,1610) + lu(k,1623) = lu(k,1623) - lu(k,1542) * lu(k,1610) + lu(k,1654) = lu(k,1654) - lu(k,1530) * lu(k,1653) + lu(k,1655) = lu(k,1655) - lu(k,1531) * lu(k,1653) + lu(k,1656) = lu(k,1656) - lu(k,1532) * lu(k,1653) + lu(k,1657) = lu(k,1657) - lu(k,1533) * lu(k,1653) + lu(k,1658) = lu(k,1658) - lu(k,1534) * lu(k,1653) + lu(k,1659) = lu(k,1659) - lu(k,1535) * lu(k,1653) + lu(k,1660) = lu(k,1660) - lu(k,1536) * lu(k,1653) + lu(k,1661) = lu(k,1661) - lu(k,1537) * lu(k,1653) + lu(k,1662) = lu(k,1662) - lu(k,1538) * lu(k,1653) + lu(k,1663) = lu(k,1663) - lu(k,1539) * lu(k,1653) + lu(k,1664) = lu(k,1664) - lu(k,1540) * lu(k,1653) + lu(k,1665) = lu(k,1665) - lu(k,1541) * lu(k,1653) + lu(k,1666) = lu(k,1666) - lu(k,1542) * lu(k,1653) + lu(k,1697) = lu(k,1697) - lu(k,1530) * lu(k,1696) + lu(k,1698) = lu(k,1698) - lu(k,1531) * lu(k,1696) + lu(k,1699) = lu(k,1699) - lu(k,1532) * lu(k,1696) + lu(k,1700) = lu(k,1700) - lu(k,1533) * lu(k,1696) + lu(k,1701) = lu(k,1701) - lu(k,1534) * lu(k,1696) + lu(k,1702) = lu(k,1702) - lu(k,1535) * lu(k,1696) + lu(k,1703) = lu(k,1703) - lu(k,1536) * lu(k,1696) + lu(k,1704) = lu(k,1704) - lu(k,1537) * lu(k,1696) + lu(k,1705) = lu(k,1705) - lu(k,1538) * lu(k,1696) + lu(k,1706) = lu(k,1706) - lu(k,1539) * lu(k,1696) + lu(k,1707) = lu(k,1707) - lu(k,1540) * lu(k,1696) + lu(k,1708) = lu(k,1708) - lu(k,1541) * lu(k,1696) + lu(k,1709) = lu(k,1709) - lu(k,1542) * lu(k,1696) + lu(k,1737) = lu(k,1737) - lu(k,1530) * lu(k,1736) + lu(k,1738) = lu(k,1738) - lu(k,1531) * lu(k,1736) + lu(k,1739) = lu(k,1739) - lu(k,1532) * lu(k,1736) + lu(k,1740) = lu(k,1740) - lu(k,1533) * lu(k,1736) + lu(k,1741) = lu(k,1741) - lu(k,1534) * lu(k,1736) + lu(k,1742) = lu(k,1742) - lu(k,1535) * lu(k,1736) + lu(k,1743) = lu(k,1743) - lu(k,1536) * lu(k,1736) + lu(k,1744) = lu(k,1744) - lu(k,1537) * lu(k,1736) + lu(k,1745) = lu(k,1745) - lu(k,1538) * lu(k,1736) + lu(k,1746) = lu(k,1746) - lu(k,1539) * lu(k,1736) + lu(k,1747) = lu(k,1747) - lu(k,1540) * lu(k,1736) + lu(k,1748) = lu(k,1748) - lu(k,1541) * lu(k,1736) + lu(k,1749) = lu(k,1749) - lu(k,1542) * lu(k,1736) + lu(k,1773) = lu(k,1773) - lu(k,1530) * lu(k,1772) + lu(k,1774) = lu(k,1774) - lu(k,1531) * lu(k,1772) + lu(k,1775) = lu(k,1775) - lu(k,1532) * lu(k,1772) + lu(k,1776) = lu(k,1776) - lu(k,1533) * lu(k,1772) + lu(k,1777) = lu(k,1777) - lu(k,1534) * lu(k,1772) + lu(k,1778) = lu(k,1778) - lu(k,1535) * lu(k,1772) + lu(k,1779) = lu(k,1779) - lu(k,1536) * lu(k,1772) + lu(k,1780) = lu(k,1780) - lu(k,1537) * lu(k,1772) + lu(k,1781) = lu(k,1781) - lu(k,1538) * lu(k,1772) + lu(k,1782) = lu(k,1782) - lu(k,1539) * lu(k,1772) + lu(k,1783) = lu(k,1783) - lu(k,1540) * lu(k,1772) + lu(k,1784) = lu(k,1784) - lu(k,1541) * lu(k,1772) + lu(k,1785) = lu(k,1785) - lu(k,1542) * lu(k,1772) + lu(k,1821) = lu(k,1821) - lu(k,1530) * lu(k,1820) + lu(k,1822) = lu(k,1822) - lu(k,1531) * lu(k,1820) + lu(k,1823) = lu(k,1823) - lu(k,1532) * lu(k,1820) + lu(k,1824) = lu(k,1824) - lu(k,1533) * lu(k,1820) + lu(k,1825) = lu(k,1825) - lu(k,1534) * lu(k,1820) + lu(k,1826) = lu(k,1826) - lu(k,1535) * lu(k,1820) + lu(k,1827) = lu(k,1827) - lu(k,1536) * lu(k,1820) + lu(k,1828) = lu(k,1828) - lu(k,1537) * lu(k,1820) + lu(k,1829) = lu(k,1829) - lu(k,1538) * lu(k,1820) + lu(k,1830) = lu(k,1830) - lu(k,1539) * lu(k,1820) + lu(k,1831) = lu(k,1831) - lu(k,1540) * lu(k,1820) + lu(k,1832) = lu(k,1832) - lu(k,1541) * lu(k,1820) + lu(k,1833) = lu(k,1833) - lu(k,1542) * lu(k,1820) + lu(k,1854) = lu(k,1854) - lu(k,1530) * lu(k,1853) + lu(k,1855) = lu(k,1855) - lu(k,1531) * lu(k,1853) + lu(k,1856) = lu(k,1856) - lu(k,1532) * lu(k,1853) + lu(k,1857) = lu(k,1857) - lu(k,1533) * lu(k,1853) + lu(k,1858) = lu(k,1858) - lu(k,1534) * lu(k,1853) + lu(k,1859) = lu(k,1859) - lu(k,1535) * lu(k,1853) + lu(k,1860) = lu(k,1860) - lu(k,1536) * lu(k,1853) + lu(k,1861) = lu(k,1861) - lu(k,1537) * lu(k,1853) + lu(k,1862) = lu(k,1862) - lu(k,1538) * lu(k,1853) + lu(k,1863) = lu(k,1863) - lu(k,1539) * lu(k,1853) + lu(k,1864) = lu(k,1864) - lu(k,1540) * lu(k,1853) + lu(k,1865) = lu(k,1865) - lu(k,1541) * lu(k,1853) + lu(k,1866) = lu(k,1866) - lu(k,1542) * lu(k,1853) + lu(k,1890) = lu(k,1890) - lu(k,1530) * lu(k,1889) + lu(k,1891) = lu(k,1891) - lu(k,1531) * lu(k,1889) + lu(k,1892) = lu(k,1892) - lu(k,1532) * lu(k,1889) + lu(k,1893) = lu(k,1893) - lu(k,1533) * lu(k,1889) + lu(k,1894) = lu(k,1894) - lu(k,1534) * lu(k,1889) + lu(k,1895) = lu(k,1895) - lu(k,1535) * lu(k,1889) + lu(k,1896) = lu(k,1896) - lu(k,1536) * lu(k,1889) + lu(k,1897) = lu(k,1897) - lu(k,1537) * lu(k,1889) + lu(k,1898) = lu(k,1898) - lu(k,1538) * lu(k,1889) + lu(k,1899) = lu(k,1899) - lu(k,1539) * lu(k,1889) + lu(k,1900) = lu(k,1900) - lu(k,1540) * lu(k,1889) + lu(k,1901) = lu(k,1901) - lu(k,1541) * lu(k,1889) + lu(k,1902) = lu(k,1902) - lu(k,1542) * lu(k,1889) + lu(k,1931) = lu(k,1931) - lu(k,1530) * lu(k,1930) + lu(k,1932) = lu(k,1932) - lu(k,1531) * lu(k,1930) + lu(k,1933) = lu(k,1933) - lu(k,1532) * lu(k,1930) + lu(k,1934) = lu(k,1934) - lu(k,1533) * lu(k,1930) + lu(k,1935) = lu(k,1935) - lu(k,1534) * lu(k,1930) + lu(k,1936) = lu(k,1936) - lu(k,1535) * lu(k,1930) + lu(k,1937) = lu(k,1937) - lu(k,1536) * lu(k,1930) + lu(k,1938) = lu(k,1938) - lu(k,1537) * lu(k,1930) + lu(k,1939) = lu(k,1939) - lu(k,1538) * lu(k,1930) + lu(k,1940) = lu(k,1940) - lu(k,1539) * lu(k,1930) + lu(k,1941) = lu(k,1941) - lu(k,1540) * lu(k,1930) + lu(k,1942) = lu(k,1942) - lu(k,1541) * lu(k,1930) + lu(k,1943) = lu(k,1943) - lu(k,1542) * lu(k,1930) + lu(k,1973) = lu(k,1973) - lu(k,1530) * lu(k,1972) + lu(k,1974) = lu(k,1974) - lu(k,1531) * lu(k,1972) + lu(k,1975) = lu(k,1975) - lu(k,1532) * lu(k,1972) + lu(k,1976) = lu(k,1976) - lu(k,1533) * lu(k,1972) + lu(k,1977) = lu(k,1977) - lu(k,1534) * lu(k,1972) + lu(k,1978) = lu(k,1978) - lu(k,1535) * lu(k,1972) + lu(k,1979) = lu(k,1979) - lu(k,1536) * lu(k,1972) + lu(k,1980) = lu(k,1980) - lu(k,1537) * lu(k,1972) + lu(k,1981) = lu(k,1981) - lu(k,1538) * lu(k,1972) + lu(k,1982) = lu(k,1982) - lu(k,1539) * lu(k,1972) + lu(k,1983) = lu(k,1983) - lu(k,1540) * lu(k,1972) + lu(k,1984) = lu(k,1984) - lu(k,1541) * lu(k,1972) + lu(k,1985) = lu(k,1985) - lu(k,1542) * lu(k,1972) + lu(k,2018) = lu(k,2018) - lu(k,1530) * lu(k,2017) + lu(k,2019) = lu(k,2019) - lu(k,1531) * lu(k,2017) + lu(k,2020) = lu(k,2020) - lu(k,1532) * lu(k,2017) + lu(k,2021) = lu(k,2021) - lu(k,1533) * lu(k,2017) + lu(k,2022) = lu(k,2022) - lu(k,1534) * lu(k,2017) + lu(k,2023) = lu(k,2023) - lu(k,1535) * lu(k,2017) + lu(k,2024) = lu(k,2024) - lu(k,1536) * lu(k,2017) + lu(k,2025) = lu(k,2025) - lu(k,1537) * lu(k,2017) + lu(k,2026) = lu(k,2026) - lu(k,1538) * lu(k,2017) + lu(k,2027) = lu(k,2027) - lu(k,1539) * lu(k,2017) + lu(k,2028) = lu(k,2028) - lu(k,1540) * lu(k,2017) + lu(k,2029) = lu(k,2029) - lu(k,1541) * lu(k,2017) + lu(k,2030) = lu(k,2030) - lu(k,1542) * lu(k,2017) + lu(k,2078) = lu(k,2078) - lu(k,1530) * lu(k,2077) + lu(k,2079) = lu(k,2079) - lu(k,1531) * lu(k,2077) + lu(k,2080) = lu(k,2080) - lu(k,1532) * lu(k,2077) + lu(k,2081) = lu(k,2081) - lu(k,1533) * lu(k,2077) + lu(k,2082) = lu(k,2082) - lu(k,1534) * lu(k,2077) + lu(k,2083) = lu(k,2083) - lu(k,1535) * lu(k,2077) + lu(k,2084) = lu(k,2084) - lu(k,1536) * lu(k,2077) + lu(k,2085) = lu(k,2085) - lu(k,1537) * lu(k,2077) + lu(k,2086) = lu(k,2086) - lu(k,1538) * lu(k,2077) + lu(k,2087) = lu(k,2087) - lu(k,1539) * lu(k,2077) + lu(k,2088) = lu(k,2088) - lu(k,1540) * lu(k,2077) + lu(k,2089) = lu(k,2089) - lu(k,1541) * lu(k,2077) + lu(k,2090) = lu(k,2090) - lu(k,1542) * lu(k,2077) + end do + end subroutine lu_fac24 + subroutine lu_fac25( 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,1566) = 1._r8 / lu(k,1566) + lu(k,1567) = lu(k,1567) * lu(k,1566) + lu(k,1568) = lu(k,1568) * lu(k,1566) + lu(k,1569) = lu(k,1569) * lu(k,1566) + lu(k,1570) = lu(k,1570) * lu(k,1566) + lu(k,1571) = lu(k,1571) * lu(k,1566) + lu(k,1572) = lu(k,1572) * lu(k,1566) + lu(k,1573) = lu(k,1573) * lu(k,1566) + lu(k,1574) = lu(k,1574) * lu(k,1566) + lu(k,1575) = lu(k,1575) * lu(k,1566) + lu(k,1576) = lu(k,1576) * lu(k,1566) + lu(k,1577) = lu(k,1577) * lu(k,1566) + lu(k,1578) = lu(k,1578) * lu(k,1566) + lu(k,1612) = lu(k,1612) - lu(k,1567) * lu(k,1611) + lu(k,1613) = lu(k,1613) - lu(k,1568) * lu(k,1611) + lu(k,1614) = lu(k,1614) - lu(k,1569) * lu(k,1611) + lu(k,1615) = lu(k,1615) - lu(k,1570) * lu(k,1611) + lu(k,1616) = lu(k,1616) - lu(k,1571) * lu(k,1611) + lu(k,1617) = lu(k,1617) - lu(k,1572) * lu(k,1611) + lu(k,1618) = lu(k,1618) - lu(k,1573) * lu(k,1611) + lu(k,1619) = lu(k,1619) - lu(k,1574) * lu(k,1611) + lu(k,1620) = lu(k,1620) - lu(k,1575) * lu(k,1611) + lu(k,1621) = lu(k,1621) - lu(k,1576) * lu(k,1611) + lu(k,1622) = lu(k,1622) - lu(k,1577) * lu(k,1611) + lu(k,1623) = lu(k,1623) - lu(k,1578) * lu(k,1611) + lu(k,1655) = lu(k,1655) - lu(k,1567) * lu(k,1654) + lu(k,1656) = lu(k,1656) - lu(k,1568) * lu(k,1654) + lu(k,1657) = lu(k,1657) - lu(k,1569) * lu(k,1654) + lu(k,1658) = lu(k,1658) - lu(k,1570) * lu(k,1654) + lu(k,1659) = lu(k,1659) - lu(k,1571) * lu(k,1654) + lu(k,1660) = lu(k,1660) - lu(k,1572) * lu(k,1654) + lu(k,1661) = lu(k,1661) - lu(k,1573) * lu(k,1654) + lu(k,1662) = lu(k,1662) - lu(k,1574) * lu(k,1654) + lu(k,1663) = lu(k,1663) - lu(k,1575) * lu(k,1654) + lu(k,1664) = lu(k,1664) - lu(k,1576) * lu(k,1654) + lu(k,1665) = lu(k,1665) - lu(k,1577) * lu(k,1654) + lu(k,1666) = lu(k,1666) - lu(k,1578) * lu(k,1654) + lu(k,1698) = lu(k,1698) - lu(k,1567) * lu(k,1697) + lu(k,1699) = lu(k,1699) - lu(k,1568) * lu(k,1697) + lu(k,1700) = lu(k,1700) - lu(k,1569) * lu(k,1697) + lu(k,1701) = lu(k,1701) - lu(k,1570) * lu(k,1697) + lu(k,1702) = lu(k,1702) - lu(k,1571) * lu(k,1697) + lu(k,1703) = lu(k,1703) - lu(k,1572) * lu(k,1697) + lu(k,1704) = lu(k,1704) - lu(k,1573) * lu(k,1697) + lu(k,1705) = lu(k,1705) - lu(k,1574) * lu(k,1697) + lu(k,1706) = lu(k,1706) - lu(k,1575) * lu(k,1697) + lu(k,1707) = lu(k,1707) - lu(k,1576) * lu(k,1697) + lu(k,1708) = lu(k,1708) - lu(k,1577) * lu(k,1697) + lu(k,1709) = lu(k,1709) - lu(k,1578) * lu(k,1697) + lu(k,1738) = lu(k,1738) - lu(k,1567) * lu(k,1737) + lu(k,1739) = lu(k,1739) - lu(k,1568) * lu(k,1737) + lu(k,1740) = lu(k,1740) - lu(k,1569) * lu(k,1737) + lu(k,1741) = lu(k,1741) - lu(k,1570) * lu(k,1737) + lu(k,1742) = lu(k,1742) - lu(k,1571) * lu(k,1737) + lu(k,1743) = lu(k,1743) - lu(k,1572) * lu(k,1737) + lu(k,1744) = lu(k,1744) - lu(k,1573) * lu(k,1737) + lu(k,1745) = lu(k,1745) - lu(k,1574) * lu(k,1737) + lu(k,1746) = lu(k,1746) - lu(k,1575) * lu(k,1737) + lu(k,1747) = lu(k,1747) - lu(k,1576) * lu(k,1737) + lu(k,1748) = lu(k,1748) - lu(k,1577) * lu(k,1737) + lu(k,1749) = lu(k,1749) - lu(k,1578) * lu(k,1737) + lu(k,1774) = lu(k,1774) - lu(k,1567) * lu(k,1773) + lu(k,1775) = lu(k,1775) - lu(k,1568) * lu(k,1773) + lu(k,1776) = lu(k,1776) - lu(k,1569) * lu(k,1773) + lu(k,1777) = lu(k,1777) - lu(k,1570) * lu(k,1773) + lu(k,1778) = lu(k,1778) - lu(k,1571) * lu(k,1773) + lu(k,1779) = lu(k,1779) - lu(k,1572) * lu(k,1773) + lu(k,1780) = lu(k,1780) - lu(k,1573) * lu(k,1773) + lu(k,1781) = lu(k,1781) - lu(k,1574) * lu(k,1773) + lu(k,1782) = lu(k,1782) - lu(k,1575) * lu(k,1773) + lu(k,1783) = lu(k,1783) - lu(k,1576) * lu(k,1773) + lu(k,1784) = lu(k,1784) - lu(k,1577) * lu(k,1773) + lu(k,1785) = lu(k,1785) - lu(k,1578) * lu(k,1773) + lu(k,1822) = lu(k,1822) - lu(k,1567) * lu(k,1821) + lu(k,1823) = lu(k,1823) - lu(k,1568) * lu(k,1821) + lu(k,1824) = lu(k,1824) - lu(k,1569) * lu(k,1821) + lu(k,1825) = lu(k,1825) - lu(k,1570) * lu(k,1821) + lu(k,1826) = lu(k,1826) - lu(k,1571) * lu(k,1821) + lu(k,1827) = lu(k,1827) - lu(k,1572) * lu(k,1821) + lu(k,1828) = lu(k,1828) - lu(k,1573) * lu(k,1821) + lu(k,1829) = lu(k,1829) - lu(k,1574) * lu(k,1821) + lu(k,1830) = lu(k,1830) - lu(k,1575) * lu(k,1821) + lu(k,1831) = lu(k,1831) - lu(k,1576) * lu(k,1821) + lu(k,1832) = lu(k,1832) - lu(k,1577) * lu(k,1821) + lu(k,1833) = lu(k,1833) - lu(k,1578) * lu(k,1821) + lu(k,1855) = lu(k,1855) - lu(k,1567) * lu(k,1854) + lu(k,1856) = lu(k,1856) - lu(k,1568) * lu(k,1854) + lu(k,1857) = lu(k,1857) - lu(k,1569) * lu(k,1854) + lu(k,1858) = lu(k,1858) - lu(k,1570) * lu(k,1854) + lu(k,1859) = lu(k,1859) - lu(k,1571) * lu(k,1854) + lu(k,1860) = lu(k,1860) - lu(k,1572) * lu(k,1854) + lu(k,1861) = lu(k,1861) - lu(k,1573) * lu(k,1854) + lu(k,1862) = lu(k,1862) - lu(k,1574) * lu(k,1854) + lu(k,1863) = lu(k,1863) - lu(k,1575) * lu(k,1854) + lu(k,1864) = lu(k,1864) - lu(k,1576) * lu(k,1854) + lu(k,1865) = lu(k,1865) - lu(k,1577) * lu(k,1854) + lu(k,1866) = lu(k,1866) - lu(k,1578) * lu(k,1854) + lu(k,1891) = lu(k,1891) - lu(k,1567) * lu(k,1890) + lu(k,1892) = lu(k,1892) - lu(k,1568) * lu(k,1890) + lu(k,1893) = lu(k,1893) - lu(k,1569) * lu(k,1890) + lu(k,1894) = lu(k,1894) - lu(k,1570) * lu(k,1890) + lu(k,1895) = lu(k,1895) - lu(k,1571) * lu(k,1890) + lu(k,1896) = lu(k,1896) - lu(k,1572) * lu(k,1890) + lu(k,1897) = lu(k,1897) - lu(k,1573) * lu(k,1890) + lu(k,1898) = lu(k,1898) - lu(k,1574) * lu(k,1890) + lu(k,1899) = lu(k,1899) - lu(k,1575) * lu(k,1890) + lu(k,1900) = lu(k,1900) - lu(k,1576) * lu(k,1890) + lu(k,1901) = lu(k,1901) - lu(k,1577) * lu(k,1890) + lu(k,1902) = lu(k,1902) - lu(k,1578) * lu(k,1890) + lu(k,1932) = lu(k,1932) - lu(k,1567) * lu(k,1931) + lu(k,1933) = lu(k,1933) - lu(k,1568) * lu(k,1931) + lu(k,1934) = lu(k,1934) - lu(k,1569) * lu(k,1931) + lu(k,1935) = lu(k,1935) - lu(k,1570) * lu(k,1931) + lu(k,1936) = lu(k,1936) - lu(k,1571) * lu(k,1931) + lu(k,1937) = lu(k,1937) - lu(k,1572) * lu(k,1931) + lu(k,1938) = lu(k,1938) - lu(k,1573) * lu(k,1931) + lu(k,1939) = lu(k,1939) - lu(k,1574) * lu(k,1931) + lu(k,1940) = lu(k,1940) - lu(k,1575) * lu(k,1931) + lu(k,1941) = lu(k,1941) - lu(k,1576) * lu(k,1931) + lu(k,1942) = lu(k,1942) - lu(k,1577) * lu(k,1931) + lu(k,1943) = lu(k,1943) - lu(k,1578) * lu(k,1931) + lu(k,1974) = lu(k,1974) - lu(k,1567) * lu(k,1973) + lu(k,1975) = lu(k,1975) - lu(k,1568) * lu(k,1973) + lu(k,1976) = lu(k,1976) - lu(k,1569) * lu(k,1973) + lu(k,1977) = lu(k,1977) - lu(k,1570) * lu(k,1973) + lu(k,1978) = lu(k,1978) - lu(k,1571) * lu(k,1973) + lu(k,1979) = lu(k,1979) - lu(k,1572) * lu(k,1973) + lu(k,1980) = lu(k,1980) - lu(k,1573) * lu(k,1973) + lu(k,1981) = lu(k,1981) - lu(k,1574) * lu(k,1973) + lu(k,1982) = lu(k,1982) - lu(k,1575) * lu(k,1973) + lu(k,1983) = lu(k,1983) - lu(k,1576) * lu(k,1973) + lu(k,1984) = lu(k,1984) - lu(k,1577) * lu(k,1973) + lu(k,1985) = lu(k,1985) - lu(k,1578) * lu(k,1973) + lu(k,2019) = lu(k,2019) - lu(k,1567) * lu(k,2018) + lu(k,2020) = lu(k,2020) - lu(k,1568) * lu(k,2018) + lu(k,2021) = lu(k,2021) - lu(k,1569) * lu(k,2018) + lu(k,2022) = lu(k,2022) - lu(k,1570) * lu(k,2018) + lu(k,2023) = lu(k,2023) - lu(k,1571) * lu(k,2018) + lu(k,2024) = lu(k,2024) - lu(k,1572) * lu(k,2018) + lu(k,2025) = lu(k,2025) - lu(k,1573) * lu(k,2018) + lu(k,2026) = lu(k,2026) - lu(k,1574) * lu(k,2018) + lu(k,2027) = lu(k,2027) - lu(k,1575) * lu(k,2018) + lu(k,2028) = lu(k,2028) - lu(k,1576) * lu(k,2018) + lu(k,2029) = lu(k,2029) - lu(k,1577) * lu(k,2018) + lu(k,2030) = lu(k,2030) - lu(k,1578) * lu(k,2018) + lu(k,2079) = lu(k,2079) - lu(k,1567) * lu(k,2078) + lu(k,2080) = lu(k,2080) - lu(k,1568) * lu(k,2078) + lu(k,2081) = lu(k,2081) - lu(k,1569) * lu(k,2078) + lu(k,2082) = lu(k,2082) - lu(k,1570) * lu(k,2078) + lu(k,2083) = lu(k,2083) - lu(k,1571) * lu(k,2078) + lu(k,2084) = lu(k,2084) - lu(k,1572) * lu(k,2078) + lu(k,2085) = lu(k,2085) - lu(k,1573) * lu(k,2078) + lu(k,2086) = lu(k,2086) - lu(k,1574) * lu(k,2078) + lu(k,2087) = lu(k,2087) - lu(k,1575) * lu(k,2078) + lu(k,2088) = lu(k,2088) - lu(k,1576) * lu(k,2078) + lu(k,2089) = lu(k,2089) - lu(k,1577) * lu(k,2078) + lu(k,2090) = lu(k,2090) - lu(k,1578) * lu(k,2078) + lu(k,1612) = 1._r8 / lu(k,1612) + lu(k,1613) = lu(k,1613) * lu(k,1612) + lu(k,1614) = lu(k,1614) * lu(k,1612) + lu(k,1615) = lu(k,1615) * lu(k,1612) + lu(k,1616) = lu(k,1616) * lu(k,1612) + lu(k,1617) = lu(k,1617) * lu(k,1612) + lu(k,1618) = lu(k,1618) * lu(k,1612) + lu(k,1619) = lu(k,1619) * lu(k,1612) + lu(k,1620) = lu(k,1620) * lu(k,1612) + lu(k,1621) = lu(k,1621) * lu(k,1612) + lu(k,1622) = lu(k,1622) * lu(k,1612) + lu(k,1623) = lu(k,1623) * lu(k,1612) + lu(k,1656) = lu(k,1656) - lu(k,1613) * lu(k,1655) + lu(k,1657) = lu(k,1657) - lu(k,1614) * lu(k,1655) + lu(k,1658) = lu(k,1658) - lu(k,1615) * lu(k,1655) + lu(k,1659) = lu(k,1659) - lu(k,1616) * lu(k,1655) + lu(k,1660) = lu(k,1660) - lu(k,1617) * lu(k,1655) + lu(k,1661) = lu(k,1661) - lu(k,1618) * lu(k,1655) + lu(k,1662) = lu(k,1662) - lu(k,1619) * lu(k,1655) + lu(k,1663) = lu(k,1663) - lu(k,1620) * lu(k,1655) + lu(k,1664) = lu(k,1664) - lu(k,1621) * lu(k,1655) + lu(k,1665) = lu(k,1665) - lu(k,1622) * lu(k,1655) + lu(k,1666) = lu(k,1666) - lu(k,1623) * lu(k,1655) + lu(k,1699) = lu(k,1699) - lu(k,1613) * lu(k,1698) + lu(k,1700) = lu(k,1700) - lu(k,1614) * lu(k,1698) + lu(k,1701) = lu(k,1701) - lu(k,1615) * lu(k,1698) + lu(k,1702) = lu(k,1702) - lu(k,1616) * lu(k,1698) + lu(k,1703) = lu(k,1703) - lu(k,1617) * lu(k,1698) + lu(k,1704) = lu(k,1704) - lu(k,1618) * lu(k,1698) + lu(k,1705) = lu(k,1705) - lu(k,1619) * lu(k,1698) + lu(k,1706) = lu(k,1706) - lu(k,1620) * lu(k,1698) + lu(k,1707) = lu(k,1707) - lu(k,1621) * lu(k,1698) + lu(k,1708) = lu(k,1708) - lu(k,1622) * lu(k,1698) + lu(k,1709) = lu(k,1709) - lu(k,1623) * lu(k,1698) + lu(k,1739) = lu(k,1739) - lu(k,1613) * lu(k,1738) + lu(k,1740) = lu(k,1740) - lu(k,1614) * lu(k,1738) + lu(k,1741) = lu(k,1741) - lu(k,1615) * lu(k,1738) + lu(k,1742) = lu(k,1742) - lu(k,1616) * lu(k,1738) + lu(k,1743) = lu(k,1743) - lu(k,1617) * lu(k,1738) + lu(k,1744) = lu(k,1744) - lu(k,1618) * lu(k,1738) + lu(k,1745) = lu(k,1745) - lu(k,1619) * lu(k,1738) + lu(k,1746) = lu(k,1746) - lu(k,1620) * lu(k,1738) + lu(k,1747) = lu(k,1747) - lu(k,1621) * lu(k,1738) + lu(k,1748) = lu(k,1748) - lu(k,1622) * lu(k,1738) + lu(k,1749) = lu(k,1749) - lu(k,1623) * lu(k,1738) + lu(k,1775) = lu(k,1775) - lu(k,1613) * lu(k,1774) + lu(k,1776) = lu(k,1776) - lu(k,1614) * lu(k,1774) + lu(k,1777) = lu(k,1777) - lu(k,1615) * lu(k,1774) + lu(k,1778) = lu(k,1778) - lu(k,1616) * lu(k,1774) + lu(k,1779) = lu(k,1779) - lu(k,1617) * lu(k,1774) + lu(k,1780) = lu(k,1780) - lu(k,1618) * lu(k,1774) + lu(k,1781) = lu(k,1781) - lu(k,1619) * lu(k,1774) + lu(k,1782) = lu(k,1782) - lu(k,1620) * lu(k,1774) + lu(k,1783) = lu(k,1783) - lu(k,1621) * lu(k,1774) + lu(k,1784) = lu(k,1784) - lu(k,1622) * lu(k,1774) + lu(k,1785) = lu(k,1785) - lu(k,1623) * lu(k,1774) + lu(k,1823) = lu(k,1823) - lu(k,1613) * lu(k,1822) + lu(k,1824) = lu(k,1824) - lu(k,1614) * lu(k,1822) + lu(k,1825) = lu(k,1825) - lu(k,1615) * lu(k,1822) + lu(k,1826) = lu(k,1826) - lu(k,1616) * lu(k,1822) + lu(k,1827) = lu(k,1827) - lu(k,1617) * lu(k,1822) + lu(k,1828) = lu(k,1828) - lu(k,1618) * lu(k,1822) + lu(k,1829) = lu(k,1829) - lu(k,1619) * lu(k,1822) + lu(k,1830) = lu(k,1830) - lu(k,1620) * lu(k,1822) + lu(k,1831) = lu(k,1831) - lu(k,1621) * lu(k,1822) + lu(k,1832) = lu(k,1832) - lu(k,1622) * lu(k,1822) + lu(k,1833) = lu(k,1833) - lu(k,1623) * lu(k,1822) + lu(k,1856) = lu(k,1856) - lu(k,1613) * lu(k,1855) + lu(k,1857) = lu(k,1857) - lu(k,1614) * lu(k,1855) + lu(k,1858) = lu(k,1858) - lu(k,1615) * lu(k,1855) + lu(k,1859) = lu(k,1859) - lu(k,1616) * lu(k,1855) + lu(k,1860) = lu(k,1860) - lu(k,1617) * lu(k,1855) + lu(k,1861) = lu(k,1861) - lu(k,1618) * lu(k,1855) + lu(k,1862) = lu(k,1862) - lu(k,1619) * lu(k,1855) + lu(k,1863) = lu(k,1863) - lu(k,1620) * lu(k,1855) + lu(k,1864) = lu(k,1864) - lu(k,1621) * lu(k,1855) + lu(k,1865) = lu(k,1865) - lu(k,1622) * lu(k,1855) + lu(k,1866) = lu(k,1866) - lu(k,1623) * lu(k,1855) + lu(k,1892) = lu(k,1892) - lu(k,1613) * lu(k,1891) + lu(k,1893) = lu(k,1893) - lu(k,1614) * lu(k,1891) + lu(k,1894) = lu(k,1894) - lu(k,1615) * lu(k,1891) + lu(k,1895) = lu(k,1895) - lu(k,1616) * lu(k,1891) + lu(k,1896) = lu(k,1896) - lu(k,1617) * lu(k,1891) + lu(k,1897) = lu(k,1897) - lu(k,1618) * lu(k,1891) + lu(k,1898) = lu(k,1898) - lu(k,1619) * lu(k,1891) + lu(k,1899) = lu(k,1899) - lu(k,1620) * lu(k,1891) + lu(k,1900) = lu(k,1900) - lu(k,1621) * lu(k,1891) + lu(k,1901) = lu(k,1901) - lu(k,1622) * lu(k,1891) + lu(k,1902) = lu(k,1902) - lu(k,1623) * lu(k,1891) + lu(k,1933) = lu(k,1933) - lu(k,1613) * lu(k,1932) + lu(k,1934) = lu(k,1934) - lu(k,1614) * lu(k,1932) + lu(k,1935) = lu(k,1935) - lu(k,1615) * lu(k,1932) + lu(k,1936) = lu(k,1936) - lu(k,1616) * lu(k,1932) + lu(k,1937) = lu(k,1937) - lu(k,1617) * lu(k,1932) + lu(k,1938) = lu(k,1938) - lu(k,1618) * lu(k,1932) + lu(k,1939) = lu(k,1939) - lu(k,1619) * lu(k,1932) + lu(k,1940) = lu(k,1940) - lu(k,1620) * lu(k,1932) + lu(k,1941) = lu(k,1941) - lu(k,1621) * lu(k,1932) + lu(k,1942) = lu(k,1942) - lu(k,1622) * lu(k,1932) + lu(k,1943) = lu(k,1943) - lu(k,1623) * lu(k,1932) + lu(k,1975) = lu(k,1975) - lu(k,1613) * lu(k,1974) + lu(k,1976) = lu(k,1976) - lu(k,1614) * lu(k,1974) + lu(k,1977) = lu(k,1977) - lu(k,1615) * lu(k,1974) + lu(k,1978) = lu(k,1978) - lu(k,1616) * lu(k,1974) + lu(k,1979) = lu(k,1979) - lu(k,1617) * lu(k,1974) + lu(k,1980) = lu(k,1980) - lu(k,1618) * lu(k,1974) + lu(k,1981) = lu(k,1981) - lu(k,1619) * lu(k,1974) + lu(k,1982) = lu(k,1982) - lu(k,1620) * lu(k,1974) + lu(k,1983) = lu(k,1983) - lu(k,1621) * lu(k,1974) + lu(k,1984) = lu(k,1984) - lu(k,1622) * lu(k,1974) + lu(k,1985) = lu(k,1985) - lu(k,1623) * lu(k,1974) + lu(k,2020) = lu(k,2020) - lu(k,1613) * lu(k,2019) + lu(k,2021) = lu(k,2021) - lu(k,1614) * lu(k,2019) + lu(k,2022) = lu(k,2022) - lu(k,1615) * lu(k,2019) + lu(k,2023) = lu(k,2023) - lu(k,1616) * lu(k,2019) + lu(k,2024) = lu(k,2024) - lu(k,1617) * lu(k,2019) + lu(k,2025) = lu(k,2025) - lu(k,1618) * lu(k,2019) + lu(k,2026) = lu(k,2026) - lu(k,1619) * lu(k,2019) + lu(k,2027) = lu(k,2027) - lu(k,1620) * lu(k,2019) + lu(k,2028) = lu(k,2028) - lu(k,1621) * lu(k,2019) + lu(k,2029) = lu(k,2029) - lu(k,1622) * lu(k,2019) + lu(k,2030) = lu(k,2030) - lu(k,1623) * lu(k,2019) + lu(k,2080) = lu(k,2080) - lu(k,1613) * lu(k,2079) + lu(k,2081) = lu(k,2081) - lu(k,1614) * lu(k,2079) + lu(k,2082) = lu(k,2082) - lu(k,1615) * lu(k,2079) + lu(k,2083) = lu(k,2083) - lu(k,1616) * lu(k,2079) + lu(k,2084) = lu(k,2084) - lu(k,1617) * lu(k,2079) + lu(k,2085) = lu(k,2085) - lu(k,1618) * lu(k,2079) + lu(k,2086) = lu(k,2086) - lu(k,1619) * lu(k,2079) + lu(k,2087) = lu(k,2087) - lu(k,1620) * lu(k,2079) + lu(k,2088) = lu(k,2088) - lu(k,1621) * lu(k,2079) + lu(k,2089) = lu(k,2089) - lu(k,1622) * lu(k,2079) + lu(k,2090) = lu(k,2090) - lu(k,1623) * lu(k,2079) + lu(k,1656) = 1._r8 / lu(k,1656) + lu(k,1657) = lu(k,1657) * lu(k,1656) + lu(k,1658) = lu(k,1658) * lu(k,1656) + lu(k,1659) = lu(k,1659) * lu(k,1656) + lu(k,1660) = lu(k,1660) * lu(k,1656) + lu(k,1661) = lu(k,1661) * lu(k,1656) + lu(k,1662) = lu(k,1662) * lu(k,1656) + lu(k,1663) = lu(k,1663) * lu(k,1656) + lu(k,1664) = lu(k,1664) * lu(k,1656) + lu(k,1665) = lu(k,1665) * lu(k,1656) + lu(k,1666) = lu(k,1666) * lu(k,1656) + lu(k,1700) = lu(k,1700) - lu(k,1657) * lu(k,1699) + lu(k,1701) = lu(k,1701) - lu(k,1658) * lu(k,1699) + lu(k,1702) = lu(k,1702) - lu(k,1659) * lu(k,1699) + lu(k,1703) = lu(k,1703) - lu(k,1660) * lu(k,1699) + lu(k,1704) = lu(k,1704) - lu(k,1661) * lu(k,1699) + lu(k,1705) = lu(k,1705) - lu(k,1662) * lu(k,1699) + lu(k,1706) = lu(k,1706) - lu(k,1663) * lu(k,1699) + lu(k,1707) = lu(k,1707) - lu(k,1664) * lu(k,1699) + lu(k,1708) = lu(k,1708) - lu(k,1665) * lu(k,1699) + lu(k,1709) = lu(k,1709) - lu(k,1666) * lu(k,1699) + lu(k,1740) = lu(k,1740) - lu(k,1657) * lu(k,1739) + lu(k,1741) = lu(k,1741) - lu(k,1658) * lu(k,1739) + lu(k,1742) = lu(k,1742) - lu(k,1659) * lu(k,1739) + lu(k,1743) = lu(k,1743) - lu(k,1660) * lu(k,1739) + lu(k,1744) = lu(k,1744) - lu(k,1661) * lu(k,1739) + lu(k,1745) = lu(k,1745) - lu(k,1662) * lu(k,1739) + lu(k,1746) = lu(k,1746) - lu(k,1663) * lu(k,1739) + lu(k,1747) = lu(k,1747) - lu(k,1664) * lu(k,1739) + lu(k,1748) = lu(k,1748) - lu(k,1665) * lu(k,1739) + lu(k,1749) = lu(k,1749) - lu(k,1666) * lu(k,1739) + lu(k,1776) = lu(k,1776) - lu(k,1657) * lu(k,1775) + lu(k,1777) = lu(k,1777) - lu(k,1658) * lu(k,1775) + lu(k,1778) = lu(k,1778) - lu(k,1659) * lu(k,1775) + lu(k,1779) = lu(k,1779) - lu(k,1660) * lu(k,1775) + lu(k,1780) = lu(k,1780) - lu(k,1661) * lu(k,1775) + lu(k,1781) = lu(k,1781) - lu(k,1662) * lu(k,1775) + lu(k,1782) = lu(k,1782) - lu(k,1663) * lu(k,1775) + lu(k,1783) = lu(k,1783) - lu(k,1664) * lu(k,1775) + lu(k,1784) = lu(k,1784) - lu(k,1665) * lu(k,1775) + lu(k,1785) = lu(k,1785) - lu(k,1666) * lu(k,1775) + lu(k,1824) = lu(k,1824) - lu(k,1657) * lu(k,1823) + lu(k,1825) = lu(k,1825) - lu(k,1658) * lu(k,1823) + lu(k,1826) = lu(k,1826) - lu(k,1659) * lu(k,1823) + lu(k,1827) = lu(k,1827) - lu(k,1660) * lu(k,1823) + lu(k,1828) = lu(k,1828) - lu(k,1661) * lu(k,1823) + lu(k,1829) = lu(k,1829) - lu(k,1662) * lu(k,1823) + lu(k,1830) = lu(k,1830) - lu(k,1663) * lu(k,1823) + lu(k,1831) = lu(k,1831) - lu(k,1664) * lu(k,1823) + lu(k,1832) = lu(k,1832) - lu(k,1665) * lu(k,1823) + lu(k,1833) = lu(k,1833) - lu(k,1666) * lu(k,1823) + lu(k,1857) = lu(k,1857) - lu(k,1657) * lu(k,1856) + lu(k,1858) = lu(k,1858) - lu(k,1658) * lu(k,1856) + lu(k,1859) = lu(k,1859) - lu(k,1659) * lu(k,1856) + lu(k,1860) = lu(k,1860) - lu(k,1660) * lu(k,1856) + lu(k,1861) = lu(k,1861) - lu(k,1661) * lu(k,1856) + lu(k,1862) = lu(k,1862) - lu(k,1662) * lu(k,1856) + lu(k,1863) = lu(k,1863) - lu(k,1663) * lu(k,1856) + lu(k,1864) = lu(k,1864) - lu(k,1664) * lu(k,1856) + lu(k,1865) = lu(k,1865) - lu(k,1665) * lu(k,1856) + lu(k,1866) = lu(k,1866) - lu(k,1666) * lu(k,1856) + lu(k,1893) = lu(k,1893) - lu(k,1657) * lu(k,1892) + lu(k,1894) = lu(k,1894) - lu(k,1658) * lu(k,1892) + lu(k,1895) = lu(k,1895) - lu(k,1659) * lu(k,1892) + lu(k,1896) = lu(k,1896) - lu(k,1660) * lu(k,1892) + lu(k,1897) = lu(k,1897) - lu(k,1661) * lu(k,1892) + lu(k,1898) = lu(k,1898) - lu(k,1662) * lu(k,1892) + lu(k,1899) = lu(k,1899) - lu(k,1663) * lu(k,1892) + lu(k,1900) = lu(k,1900) - lu(k,1664) * lu(k,1892) + lu(k,1901) = lu(k,1901) - lu(k,1665) * lu(k,1892) + lu(k,1902) = lu(k,1902) - lu(k,1666) * lu(k,1892) + lu(k,1934) = lu(k,1934) - lu(k,1657) * lu(k,1933) + lu(k,1935) = lu(k,1935) - lu(k,1658) * lu(k,1933) + lu(k,1936) = lu(k,1936) - lu(k,1659) * lu(k,1933) + lu(k,1937) = lu(k,1937) - lu(k,1660) * lu(k,1933) + lu(k,1938) = lu(k,1938) - lu(k,1661) * lu(k,1933) + lu(k,1939) = lu(k,1939) - lu(k,1662) * lu(k,1933) + lu(k,1940) = lu(k,1940) - lu(k,1663) * lu(k,1933) + lu(k,1941) = lu(k,1941) - lu(k,1664) * lu(k,1933) + lu(k,1942) = lu(k,1942) - lu(k,1665) * lu(k,1933) + lu(k,1943) = lu(k,1943) - lu(k,1666) * lu(k,1933) + lu(k,1976) = lu(k,1976) - lu(k,1657) * lu(k,1975) + lu(k,1977) = lu(k,1977) - lu(k,1658) * lu(k,1975) + lu(k,1978) = lu(k,1978) - lu(k,1659) * lu(k,1975) + lu(k,1979) = lu(k,1979) - lu(k,1660) * lu(k,1975) + lu(k,1980) = lu(k,1980) - lu(k,1661) * lu(k,1975) + lu(k,1981) = lu(k,1981) - lu(k,1662) * lu(k,1975) + lu(k,1982) = lu(k,1982) - lu(k,1663) * lu(k,1975) + lu(k,1983) = lu(k,1983) - lu(k,1664) * lu(k,1975) + lu(k,1984) = lu(k,1984) - lu(k,1665) * lu(k,1975) + lu(k,1985) = lu(k,1985) - lu(k,1666) * lu(k,1975) + lu(k,2021) = lu(k,2021) - lu(k,1657) * lu(k,2020) + lu(k,2022) = lu(k,2022) - lu(k,1658) * lu(k,2020) + lu(k,2023) = lu(k,2023) - lu(k,1659) * lu(k,2020) + lu(k,2024) = lu(k,2024) - lu(k,1660) * lu(k,2020) + lu(k,2025) = lu(k,2025) - lu(k,1661) * lu(k,2020) + lu(k,2026) = lu(k,2026) - lu(k,1662) * lu(k,2020) + lu(k,2027) = lu(k,2027) - lu(k,1663) * lu(k,2020) + lu(k,2028) = lu(k,2028) - lu(k,1664) * lu(k,2020) + lu(k,2029) = lu(k,2029) - lu(k,1665) * lu(k,2020) + lu(k,2030) = lu(k,2030) - lu(k,1666) * lu(k,2020) + lu(k,2081) = lu(k,2081) - lu(k,1657) * lu(k,2080) + lu(k,2082) = lu(k,2082) - lu(k,1658) * lu(k,2080) + lu(k,2083) = lu(k,2083) - lu(k,1659) * lu(k,2080) + lu(k,2084) = lu(k,2084) - lu(k,1660) * lu(k,2080) + lu(k,2085) = lu(k,2085) - lu(k,1661) * lu(k,2080) + lu(k,2086) = lu(k,2086) - lu(k,1662) * lu(k,2080) + lu(k,2087) = lu(k,2087) - lu(k,1663) * lu(k,2080) + lu(k,2088) = lu(k,2088) - lu(k,1664) * lu(k,2080) + lu(k,2089) = lu(k,2089) - lu(k,1665) * lu(k,2080) + lu(k,2090) = lu(k,2090) - lu(k,1666) * lu(k,2080) + lu(k,1700) = 1._r8 / lu(k,1700) + lu(k,1701) = lu(k,1701) * lu(k,1700) + lu(k,1702) = lu(k,1702) * lu(k,1700) + lu(k,1703) = lu(k,1703) * lu(k,1700) + lu(k,1704) = lu(k,1704) * lu(k,1700) + lu(k,1705) = lu(k,1705) * lu(k,1700) + lu(k,1706) = lu(k,1706) * lu(k,1700) + lu(k,1707) = lu(k,1707) * lu(k,1700) + lu(k,1708) = lu(k,1708) * lu(k,1700) + lu(k,1709) = lu(k,1709) * lu(k,1700) + lu(k,1741) = lu(k,1741) - lu(k,1701) * lu(k,1740) + lu(k,1742) = lu(k,1742) - lu(k,1702) * lu(k,1740) + lu(k,1743) = lu(k,1743) - lu(k,1703) * lu(k,1740) + lu(k,1744) = lu(k,1744) - lu(k,1704) * lu(k,1740) + lu(k,1745) = lu(k,1745) - lu(k,1705) * lu(k,1740) + lu(k,1746) = lu(k,1746) - lu(k,1706) * lu(k,1740) + lu(k,1747) = lu(k,1747) - lu(k,1707) * lu(k,1740) + lu(k,1748) = lu(k,1748) - lu(k,1708) * lu(k,1740) + lu(k,1749) = lu(k,1749) - lu(k,1709) * lu(k,1740) + lu(k,1777) = lu(k,1777) - lu(k,1701) * lu(k,1776) + lu(k,1778) = lu(k,1778) - lu(k,1702) * lu(k,1776) + lu(k,1779) = lu(k,1779) - lu(k,1703) * lu(k,1776) + lu(k,1780) = lu(k,1780) - lu(k,1704) * lu(k,1776) + lu(k,1781) = lu(k,1781) - lu(k,1705) * lu(k,1776) + lu(k,1782) = lu(k,1782) - lu(k,1706) * lu(k,1776) + lu(k,1783) = lu(k,1783) - lu(k,1707) * lu(k,1776) + lu(k,1784) = lu(k,1784) - lu(k,1708) * lu(k,1776) + lu(k,1785) = lu(k,1785) - lu(k,1709) * lu(k,1776) + lu(k,1825) = lu(k,1825) - lu(k,1701) * lu(k,1824) + lu(k,1826) = lu(k,1826) - lu(k,1702) * lu(k,1824) + lu(k,1827) = lu(k,1827) - lu(k,1703) * lu(k,1824) + lu(k,1828) = lu(k,1828) - lu(k,1704) * lu(k,1824) + lu(k,1829) = lu(k,1829) - lu(k,1705) * lu(k,1824) + lu(k,1830) = lu(k,1830) - lu(k,1706) * lu(k,1824) + lu(k,1831) = lu(k,1831) - lu(k,1707) * lu(k,1824) + lu(k,1832) = lu(k,1832) - lu(k,1708) * lu(k,1824) + lu(k,1833) = lu(k,1833) - lu(k,1709) * lu(k,1824) + lu(k,1858) = lu(k,1858) - lu(k,1701) * lu(k,1857) + lu(k,1859) = lu(k,1859) - lu(k,1702) * lu(k,1857) + lu(k,1860) = lu(k,1860) - lu(k,1703) * lu(k,1857) + lu(k,1861) = lu(k,1861) - lu(k,1704) * lu(k,1857) + lu(k,1862) = lu(k,1862) - lu(k,1705) * lu(k,1857) + lu(k,1863) = lu(k,1863) - lu(k,1706) * lu(k,1857) + lu(k,1864) = lu(k,1864) - lu(k,1707) * lu(k,1857) + lu(k,1865) = lu(k,1865) - lu(k,1708) * lu(k,1857) + lu(k,1866) = lu(k,1866) - lu(k,1709) * lu(k,1857) + lu(k,1894) = lu(k,1894) - lu(k,1701) * lu(k,1893) + lu(k,1895) = lu(k,1895) - lu(k,1702) * lu(k,1893) + lu(k,1896) = lu(k,1896) - lu(k,1703) * lu(k,1893) + lu(k,1897) = lu(k,1897) - lu(k,1704) * lu(k,1893) + lu(k,1898) = lu(k,1898) - lu(k,1705) * lu(k,1893) + lu(k,1899) = lu(k,1899) - lu(k,1706) * lu(k,1893) + lu(k,1900) = lu(k,1900) - lu(k,1707) * lu(k,1893) + lu(k,1901) = lu(k,1901) - lu(k,1708) * lu(k,1893) + lu(k,1902) = lu(k,1902) - lu(k,1709) * lu(k,1893) + lu(k,1935) = lu(k,1935) - lu(k,1701) * lu(k,1934) + lu(k,1936) = lu(k,1936) - lu(k,1702) * lu(k,1934) + lu(k,1937) = lu(k,1937) - lu(k,1703) * lu(k,1934) + lu(k,1938) = lu(k,1938) - lu(k,1704) * lu(k,1934) + lu(k,1939) = lu(k,1939) - lu(k,1705) * lu(k,1934) + lu(k,1940) = lu(k,1940) - lu(k,1706) * lu(k,1934) + lu(k,1941) = lu(k,1941) - lu(k,1707) * lu(k,1934) + lu(k,1942) = lu(k,1942) - lu(k,1708) * lu(k,1934) + lu(k,1943) = lu(k,1943) - lu(k,1709) * lu(k,1934) + lu(k,1977) = lu(k,1977) - lu(k,1701) * lu(k,1976) + lu(k,1978) = lu(k,1978) - lu(k,1702) * lu(k,1976) + lu(k,1979) = lu(k,1979) - lu(k,1703) * lu(k,1976) + lu(k,1980) = lu(k,1980) - lu(k,1704) * lu(k,1976) + lu(k,1981) = lu(k,1981) - lu(k,1705) * lu(k,1976) + lu(k,1982) = lu(k,1982) - lu(k,1706) * lu(k,1976) + lu(k,1983) = lu(k,1983) - lu(k,1707) * lu(k,1976) + lu(k,1984) = lu(k,1984) - lu(k,1708) * lu(k,1976) + lu(k,1985) = lu(k,1985) - lu(k,1709) * lu(k,1976) + lu(k,2022) = lu(k,2022) - lu(k,1701) * lu(k,2021) + lu(k,2023) = lu(k,2023) - lu(k,1702) * lu(k,2021) + lu(k,2024) = lu(k,2024) - lu(k,1703) * lu(k,2021) + lu(k,2025) = lu(k,2025) - lu(k,1704) * lu(k,2021) + lu(k,2026) = lu(k,2026) - lu(k,1705) * lu(k,2021) + lu(k,2027) = lu(k,2027) - lu(k,1706) * lu(k,2021) + lu(k,2028) = lu(k,2028) - lu(k,1707) * lu(k,2021) + lu(k,2029) = lu(k,2029) - lu(k,1708) * lu(k,2021) + lu(k,2030) = lu(k,2030) - lu(k,1709) * lu(k,2021) + lu(k,2082) = lu(k,2082) - lu(k,1701) * lu(k,2081) + lu(k,2083) = lu(k,2083) - lu(k,1702) * lu(k,2081) + lu(k,2084) = lu(k,2084) - lu(k,1703) * lu(k,2081) + lu(k,2085) = lu(k,2085) - lu(k,1704) * lu(k,2081) + lu(k,2086) = lu(k,2086) - lu(k,1705) * lu(k,2081) + lu(k,2087) = lu(k,2087) - lu(k,1706) * lu(k,2081) + lu(k,2088) = lu(k,2088) - lu(k,1707) * lu(k,2081) + lu(k,2089) = lu(k,2089) - lu(k,1708) * lu(k,2081) + lu(k,2090) = lu(k,2090) - lu(k,1709) * lu(k,2081) + lu(k,1741) = 1._r8 / lu(k,1741) + lu(k,1742) = lu(k,1742) * lu(k,1741) + lu(k,1743) = lu(k,1743) * lu(k,1741) + lu(k,1744) = lu(k,1744) * lu(k,1741) + lu(k,1745) = lu(k,1745) * lu(k,1741) + lu(k,1746) = lu(k,1746) * lu(k,1741) + lu(k,1747) = lu(k,1747) * lu(k,1741) + lu(k,1748) = lu(k,1748) * lu(k,1741) + lu(k,1749) = lu(k,1749) * lu(k,1741) + lu(k,1778) = lu(k,1778) - lu(k,1742) * lu(k,1777) + lu(k,1779) = lu(k,1779) - lu(k,1743) * lu(k,1777) + lu(k,1780) = lu(k,1780) - lu(k,1744) * lu(k,1777) + lu(k,1781) = lu(k,1781) - lu(k,1745) * lu(k,1777) + lu(k,1782) = lu(k,1782) - lu(k,1746) * lu(k,1777) + lu(k,1783) = lu(k,1783) - lu(k,1747) * lu(k,1777) + lu(k,1784) = lu(k,1784) - lu(k,1748) * lu(k,1777) + lu(k,1785) = lu(k,1785) - lu(k,1749) * lu(k,1777) + lu(k,1826) = lu(k,1826) - lu(k,1742) * lu(k,1825) + lu(k,1827) = lu(k,1827) - lu(k,1743) * lu(k,1825) + lu(k,1828) = lu(k,1828) - lu(k,1744) * lu(k,1825) + lu(k,1829) = lu(k,1829) - lu(k,1745) * lu(k,1825) + lu(k,1830) = lu(k,1830) - lu(k,1746) * lu(k,1825) + lu(k,1831) = lu(k,1831) - lu(k,1747) * lu(k,1825) + lu(k,1832) = lu(k,1832) - lu(k,1748) * lu(k,1825) + lu(k,1833) = lu(k,1833) - lu(k,1749) * lu(k,1825) + lu(k,1859) = lu(k,1859) - lu(k,1742) * lu(k,1858) + lu(k,1860) = lu(k,1860) - lu(k,1743) * lu(k,1858) + lu(k,1861) = lu(k,1861) - lu(k,1744) * lu(k,1858) + lu(k,1862) = lu(k,1862) - lu(k,1745) * lu(k,1858) + lu(k,1863) = lu(k,1863) - lu(k,1746) * lu(k,1858) + lu(k,1864) = lu(k,1864) - lu(k,1747) * lu(k,1858) + lu(k,1865) = lu(k,1865) - lu(k,1748) * lu(k,1858) + lu(k,1866) = lu(k,1866) - lu(k,1749) * lu(k,1858) + lu(k,1895) = lu(k,1895) - lu(k,1742) * lu(k,1894) + lu(k,1896) = lu(k,1896) - lu(k,1743) * lu(k,1894) + lu(k,1897) = lu(k,1897) - lu(k,1744) * lu(k,1894) + lu(k,1898) = lu(k,1898) - lu(k,1745) * lu(k,1894) + lu(k,1899) = lu(k,1899) - lu(k,1746) * lu(k,1894) + lu(k,1900) = lu(k,1900) - lu(k,1747) * lu(k,1894) + lu(k,1901) = lu(k,1901) - lu(k,1748) * lu(k,1894) + lu(k,1902) = lu(k,1902) - lu(k,1749) * lu(k,1894) + lu(k,1936) = lu(k,1936) - lu(k,1742) * lu(k,1935) + lu(k,1937) = lu(k,1937) - lu(k,1743) * lu(k,1935) + lu(k,1938) = lu(k,1938) - lu(k,1744) * lu(k,1935) + lu(k,1939) = lu(k,1939) - lu(k,1745) * lu(k,1935) + lu(k,1940) = lu(k,1940) - lu(k,1746) * lu(k,1935) + lu(k,1941) = lu(k,1941) - lu(k,1747) * lu(k,1935) + lu(k,1942) = lu(k,1942) - lu(k,1748) * lu(k,1935) + lu(k,1943) = lu(k,1943) - lu(k,1749) * lu(k,1935) + lu(k,1978) = lu(k,1978) - lu(k,1742) * lu(k,1977) + lu(k,1979) = lu(k,1979) - lu(k,1743) * lu(k,1977) + lu(k,1980) = lu(k,1980) - lu(k,1744) * lu(k,1977) + lu(k,1981) = lu(k,1981) - lu(k,1745) * lu(k,1977) + lu(k,1982) = lu(k,1982) - lu(k,1746) * lu(k,1977) + lu(k,1983) = lu(k,1983) - lu(k,1747) * lu(k,1977) + lu(k,1984) = lu(k,1984) - lu(k,1748) * lu(k,1977) + lu(k,1985) = lu(k,1985) - lu(k,1749) * lu(k,1977) + lu(k,2023) = lu(k,2023) - lu(k,1742) * lu(k,2022) + lu(k,2024) = lu(k,2024) - lu(k,1743) * lu(k,2022) + lu(k,2025) = lu(k,2025) - lu(k,1744) * lu(k,2022) + lu(k,2026) = lu(k,2026) - lu(k,1745) * lu(k,2022) + lu(k,2027) = lu(k,2027) - lu(k,1746) * lu(k,2022) + lu(k,2028) = lu(k,2028) - lu(k,1747) * lu(k,2022) + lu(k,2029) = lu(k,2029) - lu(k,1748) * lu(k,2022) + lu(k,2030) = lu(k,2030) - lu(k,1749) * lu(k,2022) + lu(k,2083) = lu(k,2083) - lu(k,1742) * lu(k,2082) + lu(k,2084) = lu(k,2084) - lu(k,1743) * lu(k,2082) + lu(k,2085) = lu(k,2085) - lu(k,1744) * lu(k,2082) + lu(k,2086) = lu(k,2086) - lu(k,1745) * lu(k,2082) + lu(k,2087) = lu(k,2087) - lu(k,1746) * lu(k,2082) + lu(k,2088) = lu(k,2088) - lu(k,1747) * lu(k,2082) + lu(k,2089) = lu(k,2089) - lu(k,1748) * lu(k,2082) + lu(k,2090) = lu(k,2090) - lu(k,1749) * lu(k,2082) + end do + end subroutine lu_fac25 + subroutine lu_fac26( 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,1778) = 1._r8 / lu(k,1778) + lu(k,1779) = lu(k,1779) * lu(k,1778) + lu(k,1780) = lu(k,1780) * lu(k,1778) + lu(k,1781) = lu(k,1781) * lu(k,1778) + lu(k,1782) = lu(k,1782) * lu(k,1778) + lu(k,1783) = lu(k,1783) * lu(k,1778) + lu(k,1784) = lu(k,1784) * lu(k,1778) + lu(k,1785) = lu(k,1785) * lu(k,1778) + lu(k,1827) = lu(k,1827) - lu(k,1779) * lu(k,1826) + lu(k,1828) = lu(k,1828) - lu(k,1780) * lu(k,1826) + lu(k,1829) = lu(k,1829) - lu(k,1781) * lu(k,1826) + lu(k,1830) = lu(k,1830) - lu(k,1782) * lu(k,1826) + lu(k,1831) = lu(k,1831) - lu(k,1783) * lu(k,1826) + lu(k,1832) = lu(k,1832) - lu(k,1784) * lu(k,1826) + lu(k,1833) = lu(k,1833) - lu(k,1785) * lu(k,1826) + lu(k,1860) = lu(k,1860) - lu(k,1779) * lu(k,1859) + lu(k,1861) = lu(k,1861) - lu(k,1780) * lu(k,1859) + lu(k,1862) = lu(k,1862) - lu(k,1781) * lu(k,1859) + lu(k,1863) = lu(k,1863) - lu(k,1782) * lu(k,1859) + lu(k,1864) = lu(k,1864) - lu(k,1783) * lu(k,1859) + lu(k,1865) = lu(k,1865) - lu(k,1784) * lu(k,1859) + lu(k,1866) = lu(k,1866) - lu(k,1785) * lu(k,1859) + lu(k,1896) = lu(k,1896) - lu(k,1779) * lu(k,1895) + lu(k,1897) = lu(k,1897) - lu(k,1780) * lu(k,1895) + lu(k,1898) = lu(k,1898) - lu(k,1781) * lu(k,1895) + lu(k,1899) = lu(k,1899) - lu(k,1782) * lu(k,1895) + lu(k,1900) = lu(k,1900) - lu(k,1783) * lu(k,1895) + lu(k,1901) = lu(k,1901) - lu(k,1784) * lu(k,1895) + lu(k,1902) = lu(k,1902) - lu(k,1785) * lu(k,1895) + lu(k,1937) = lu(k,1937) - lu(k,1779) * lu(k,1936) + lu(k,1938) = lu(k,1938) - lu(k,1780) * lu(k,1936) + lu(k,1939) = lu(k,1939) - lu(k,1781) * lu(k,1936) + lu(k,1940) = lu(k,1940) - lu(k,1782) * lu(k,1936) + lu(k,1941) = lu(k,1941) - lu(k,1783) * lu(k,1936) + lu(k,1942) = lu(k,1942) - lu(k,1784) * lu(k,1936) + lu(k,1943) = lu(k,1943) - lu(k,1785) * lu(k,1936) + lu(k,1979) = lu(k,1979) - lu(k,1779) * lu(k,1978) + lu(k,1980) = lu(k,1980) - lu(k,1780) * lu(k,1978) + lu(k,1981) = lu(k,1981) - lu(k,1781) * lu(k,1978) + lu(k,1982) = lu(k,1982) - lu(k,1782) * lu(k,1978) + lu(k,1983) = lu(k,1983) - lu(k,1783) * lu(k,1978) + lu(k,1984) = lu(k,1984) - lu(k,1784) * lu(k,1978) + lu(k,1985) = lu(k,1985) - lu(k,1785) * lu(k,1978) + lu(k,2024) = lu(k,2024) - lu(k,1779) * lu(k,2023) + lu(k,2025) = lu(k,2025) - lu(k,1780) * lu(k,2023) + lu(k,2026) = lu(k,2026) - lu(k,1781) * lu(k,2023) + lu(k,2027) = lu(k,2027) - lu(k,1782) * lu(k,2023) + lu(k,2028) = lu(k,2028) - lu(k,1783) * lu(k,2023) + lu(k,2029) = lu(k,2029) - lu(k,1784) * lu(k,2023) + lu(k,2030) = lu(k,2030) - lu(k,1785) * lu(k,2023) + lu(k,2084) = lu(k,2084) - lu(k,1779) * lu(k,2083) + lu(k,2085) = lu(k,2085) - lu(k,1780) * lu(k,2083) + lu(k,2086) = lu(k,2086) - lu(k,1781) * lu(k,2083) + lu(k,2087) = lu(k,2087) - lu(k,1782) * lu(k,2083) + lu(k,2088) = lu(k,2088) - lu(k,1783) * lu(k,2083) + lu(k,2089) = lu(k,2089) - lu(k,1784) * lu(k,2083) + lu(k,2090) = lu(k,2090) - lu(k,1785) * lu(k,2083) + lu(k,1827) = 1._r8 / lu(k,1827) + lu(k,1828) = lu(k,1828) * lu(k,1827) + lu(k,1829) = lu(k,1829) * lu(k,1827) + lu(k,1830) = lu(k,1830) * lu(k,1827) + lu(k,1831) = lu(k,1831) * lu(k,1827) + lu(k,1832) = lu(k,1832) * lu(k,1827) + lu(k,1833) = lu(k,1833) * lu(k,1827) + lu(k,1861) = lu(k,1861) - lu(k,1828) * lu(k,1860) + lu(k,1862) = lu(k,1862) - lu(k,1829) * lu(k,1860) + lu(k,1863) = lu(k,1863) - lu(k,1830) * lu(k,1860) + lu(k,1864) = lu(k,1864) - lu(k,1831) * lu(k,1860) + lu(k,1865) = lu(k,1865) - lu(k,1832) * lu(k,1860) + lu(k,1866) = lu(k,1866) - lu(k,1833) * lu(k,1860) + lu(k,1897) = lu(k,1897) - lu(k,1828) * lu(k,1896) + lu(k,1898) = lu(k,1898) - lu(k,1829) * lu(k,1896) + lu(k,1899) = lu(k,1899) - lu(k,1830) * lu(k,1896) + lu(k,1900) = lu(k,1900) - lu(k,1831) * lu(k,1896) + lu(k,1901) = lu(k,1901) - lu(k,1832) * lu(k,1896) + lu(k,1902) = lu(k,1902) - lu(k,1833) * lu(k,1896) + lu(k,1938) = lu(k,1938) - lu(k,1828) * lu(k,1937) + lu(k,1939) = lu(k,1939) - lu(k,1829) * lu(k,1937) + lu(k,1940) = lu(k,1940) - lu(k,1830) * lu(k,1937) + lu(k,1941) = lu(k,1941) - lu(k,1831) * lu(k,1937) + lu(k,1942) = lu(k,1942) - lu(k,1832) * lu(k,1937) + lu(k,1943) = lu(k,1943) - lu(k,1833) * lu(k,1937) + lu(k,1980) = lu(k,1980) - lu(k,1828) * lu(k,1979) + lu(k,1981) = lu(k,1981) - lu(k,1829) * lu(k,1979) + lu(k,1982) = lu(k,1982) - lu(k,1830) * lu(k,1979) + lu(k,1983) = lu(k,1983) - lu(k,1831) * lu(k,1979) + lu(k,1984) = lu(k,1984) - lu(k,1832) * lu(k,1979) + lu(k,1985) = lu(k,1985) - lu(k,1833) * lu(k,1979) + lu(k,2025) = lu(k,2025) - lu(k,1828) * lu(k,2024) + lu(k,2026) = lu(k,2026) - lu(k,1829) * lu(k,2024) + lu(k,2027) = lu(k,2027) - lu(k,1830) * lu(k,2024) + lu(k,2028) = lu(k,2028) - lu(k,1831) * lu(k,2024) + lu(k,2029) = lu(k,2029) - lu(k,1832) * lu(k,2024) + lu(k,2030) = lu(k,2030) - lu(k,1833) * lu(k,2024) + lu(k,2085) = lu(k,2085) - lu(k,1828) * lu(k,2084) + lu(k,2086) = lu(k,2086) - lu(k,1829) * lu(k,2084) + lu(k,2087) = lu(k,2087) - lu(k,1830) * lu(k,2084) + lu(k,2088) = lu(k,2088) - lu(k,1831) * lu(k,2084) + lu(k,2089) = lu(k,2089) - lu(k,1832) * lu(k,2084) + lu(k,2090) = lu(k,2090) - lu(k,1833) * lu(k,2084) + lu(k,1861) = 1._r8 / lu(k,1861) + lu(k,1862) = lu(k,1862) * lu(k,1861) + lu(k,1863) = lu(k,1863) * lu(k,1861) + lu(k,1864) = lu(k,1864) * lu(k,1861) + lu(k,1865) = lu(k,1865) * lu(k,1861) + lu(k,1866) = lu(k,1866) * lu(k,1861) + lu(k,1898) = lu(k,1898) - lu(k,1862) * lu(k,1897) + lu(k,1899) = lu(k,1899) - lu(k,1863) * lu(k,1897) + lu(k,1900) = lu(k,1900) - lu(k,1864) * lu(k,1897) + lu(k,1901) = lu(k,1901) - lu(k,1865) * lu(k,1897) + lu(k,1902) = lu(k,1902) - lu(k,1866) * lu(k,1897) + lu(k,1939) = lu(k,1939) - lu(k,1862) * lu(k,1938) + lu(k,1940) = lu(k,1940) - lu(k,1863) * lu(k,1938) + lu(k,1941) = lu(k,1941) - lu(k,1864) * lu(k,1938) + lu(k,1942) = lu(k,1942) - lu(k,1865) * lu(k,1938) + lu(k,1943) = lu(k,1943) - lu(k,1866) * lu(k,1938) + lu(k,1981) = lu(k,1981) - lu(k,1862) * lu(k,1980) + lu(k,1982) = lu(k,1982) - lu(k,1863) * lu(k,1980) + lu(k,1983) = lu(k,1983) - lu(k,1864) * lu(k,1980) + lu(k,1984) = lu(k,1984) - lu(k,1865) * lu(k,1980) + lu(k,1985) = lu(k,1985) - lu(k,1866) * lu(k,1980) + lu(k,2026) = lu(k,2026) - lu(k,1862) * lu(k,2025) + lu(k,2027) = lu(k,2027) - lu(k,1863) * lu(k,2025) + lu(k,2028) = lu(k,2028) - lu(k,1864) * lu(k,2025) + lu(k,2029) = lu(k,2029) - lu(k,1865) * lu(k,2025) + lu(k,2030) = lu(k,2030) - lu(k,1866) * lu(k,2025) + lu(k,2086) = lu(k,2086) - lu(k,1862) * lu(k,2085) + lu(k,2087) = lu(k,2087) - lu(k,1863) * lu(k,2085) + lu(k,2088) = lu(k,2088) - lu(k,1864) * lu(k,2085) + lu(k,2089) = lu(k,2089) - lu(k,1865) * lu(k,2085) + lu(k,2090) = lu(k,2090) - lu(k,1866) * lu(k,2085) + lu(k,1898) = 1._r8 / lu(k,1898) + lu(k,1899) = lu(k,1899) * lu(k,1898) + lu(k,1900) = lu(k,1900) * lu(k,1898) + lu(k,1901) = lu(k,1901) * lu(k,1898) + lu(k,1902) = lu(k,1902) * lu(k,1898) + lu(k,1940) = lu(k,1940) - lu(k,1899) * lu(k,1939) + lu(k,1941) = lu(k,1941) - lu(k,1900) * lu(k,1939) + lu(k,1942) = lu(k,1942) - lu(k,1901) * lu(k,1939) + lu(k,1943) = lu(k,1943) - lu(k,1902) * lu(k,1939) + lu(k,1982) = lu(k,1982) - lu(k,1899) * lu(k,1981) + lu(k,1983) = lu(k,1983) - lu(k,1900) * lu(k,1981) + lu(k,1984) = lu(k,1984) - lu(k,1901) * lu(k,1981) + lu(k,1985) = lu(k,1985) - lu(k,1902) * lu(k,1981) + lu(k,2027) = lu(k,2027) - lu(k,1899) * lu(k,2026) + lu(k,2028) = lu(k,2028) - lu(k,1900) * lu(k,2026) + lu(k,2029) = lu(k,2029) - lu(k,1901) * lu(k,2026) + lu(k,2030) = lu(k,2030) - lu(k,1902) * lu(k,2026) + lu(k,2087) = lu(k,2087) - lu(k,1899) * lu(k,2086) + lu(k,2088) = lu(k,2088) - lu(k,1900) * lu(k,2086) + lu(k,2089) = lu(k,2089) - lu(k,1901) * lu(k,2086) + lu(k,2090) = lu(k,2090) - lu(k,1902) * lu(k,2086) + lu(k,1940) = 1._r8 / lu(k,1940) + lu(k,1941) = lu(k,1941) * lu(k,1940) + lu(k,1942) = lu(k,1942) * lu(k,1940) + lu(k,1943) = lu(k,1943) * lu(k,1940) + lu(k,1983) = lu(k,1983) - lu(k,1941) * lu(k,1982) + lu(k,1984) = lu(k,1984) - lu(k,1942) * lu(k,1982) + lu(k,1985) = lu(k,1985) - lu(k,1943) * lu(k,1982) + lu(k,2028) = lu(k,2028) - lu(k,1941) * lu(k,2027) + lu(k,2029) = lu(k,2029) - lu(k,1942) * lu(k,2027) + lu(k,2030) = lu(k,2030) - lu(k,1943) * lu(k,2027) + lu(k,2088) = lu(k,2088) - lu(k,1941) * lu(k,2087) + lu(k,2089) = lu(k,2089) - lu(k,1942) * lu(k,2087) + lu(k,2090) = lu(k,2090) - lu(k,1943) * lu(k,2087) + lu(k,1983) = 1._r8 / lu(k,1983) + lu(k,1984) = lu(k,1984) * lu(k,1983) + lu(k,1985) = lu(k,1985) * lu(k,1983) + lu(k,2029) = lu(k,2029) - lu(k,1984) * lu(k,2028) + lu(k,2030) = lu(k,2030) - lu(k,1985) * lu(k,2028) + lu(k,2089) = lu(k,2089) - lu(k,1984) * lu(k,2088) + lu(k,2090) = lu(k,2090) - lu(k,1985) * lu(k,2088) + lu(k,2029) = 1._r8 / lu(k,2029) + lu(k,2030) = lu(k,2030) * lu(k,2029) + lu(k,2090) = lu(k,2090) - lu(k,2030) * lu(k,2089) + lu(k,2090) = 1._r8 / lu(k,2090) + end do + end subroutine lu_fac26 + 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 ) + call lu_fac19( avec_len, lu ) + call lu_fac20( avec_len, lu ) + call lu_fac21( avec_len, lu ) + call lu_fac22( avec_len, lu ) + call lu_fac23( avec_len, lu ) + call lu_fac24( avec_len, lu ) + call lu_fac25( avec_len, lu ) + call lu_fac26( avec_len, lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_mad_mam5/mo_lu_solve.F90 b/src/chemistry/pp_waccm_mad_mam5/mo_lu_solve.F90 new file mode 100644 index 0000000000..d82dc6a373 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/mo_lu_solve.F90 @@ -0,0 +1,2341 @@ + 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,117) = b(k,117) - lu(k,27) * b(k,26) + b(k,125) = b(k,125) - lu(k,28) * b(k,26) + b(k,108) = b(k,108) - lu(k,30) * b(k,27) + b(k,125) = b(k,125) - lu(k,31) * b(k,27) + b(k,39) = b(k,39) - lu(k,33) * b(k,28) + b(k,99) = b(k,99) - lu(k,34) * b(k,28) + b(k,108) = b(k,108) - lu(k,35) * b(k,28) + b(k,41) = b(k,41) - lu(k,37) * b(k,29) + b(k,108) = b(k,108) - lu(k,38) * b(k,29) + b(k,125) = b(k,125) - lu(k,39) * b(k,29) + b(k,39) = b(k,39) - lu(k,41) * b(k,30) + b(k,108) = b(k,108) - lu(k,42) * b(k,30) + b(k,125) = b(k,125) - lu(k,43) * b(k,30) + b(k,39) = b(k,39) - lu(k,45) * b(k,31) + b(k,108) = b(k,108) - lu(k,46) * b(k,31) + b(k,125) = b(k,125) - lu(k,47) * b(k,31) + b(k,114) = b(k,114) - lu(k,49) * b(k,32) + b(k,125) = b(k,125) - lu(k,50) * b(k,32) + b(k,139) = b(k,139) - lu(k,51) * b(k,32) + b(k,45) = b(k,45) - lu(k,53) * b(k,33) + b(k,139) = b(k,139) - lu(k,54) * b(k,33) + b(k,39) = b(k,39) - lu(k,56) * b(k,34) + b(k,99) = b(k,99) - lu(k,57) * b(k,34) + b(k,108) = b(k,108) - lu(k,58) * b(k,34) + b(k,125) = b(k,125) - lu(k,59) * b(k,34) + b(k,39) = b(k,39) - lu(k,61) * b(k,35) + b(k,81) = b(k,81) - lu(k,62) * b(k,35) + b(k,99) = b(k,99) - lu(k,63) * b(k,35) + b(k,108) = b(k,108) - lu(k,64) * b(k,35) + b(k,39) = b(k,39) - lu(k,66) * b(k,36) + b(k,41) = b(k,41) - lu(k,67) * b(k,36) + b(k,108) = b(k,108) - lu(k,68) * b(k,36) + b(k,125) = b(k,125) - lu(k,69) * b(k,36) + b(k,39) = b(k,39) - lu(k,71) * b(k,37) + b(k,81) = b(k,81) - lu(k,72) * b(k,37) + b(k,108) = b(k,108) - lu(k,73) * b(k,37) + b(k,125) = b(k,125) - lu(k,74) * b(k,37) + b(k,125) = b(k,125) - lu(k,76) * b(k,38) + b(k,81) = b(k,81) - lu(k,78) * b(k,39) + b(k,108) = b(k,108) - lu(k,79) * b(k,39) + b(k,41) = b(k,41) - lu(k,81) * b(k,40) + b(k,108) = b(k,108) - lu(k,82) * b(k,40) + b(k,114) = b(k,114) - lu(k,83) * b(k,40) + b(k,125) = b(k,125) - lu(k,84) * b(k,40) + b(k,81) = b(k,81) - lu(k,86) * b(k,41) + b(k,108) = b(k,108) - lu(k,87) * b(k,41) + b(k,125) = b(k,125) - lu(k,88) * b(k,41) + b(k,81) = b(k,81) - lu(k,91) * b(k,42) + b(k,108) = b(k,108) - lu(k,92) * b(k,42) + b(k,114) = b(k,114) - lu(k,93) * b(k,42) + b(k,125) = b(k,125) - lu(k,94) * b(k,42) + b(k,99) = b(k,99) - lu(k,96) * b(k,43) + b(k,125) = b(k,125) - lu(k,97) * b(k,43) + b(k,108) = b(k,108) - lu(k,99) * b(k,44) + b(k,124) = b(k,124) - lu(k,100) * b(k,44) + b(k,137) = b(k,137) - lu(k,101) * b(k,44) + b(k,82) = b(k,82) - lu(k,104) * b(k,45) + b(k,123) = b(k,123) - lu(k,105) * b(k,45) + b(k,139) = b(k,139) - lu(k,106) * b(k,45) + b(k,126) = b(k,126) - lu(k,108) * b(k,46) + b(k,130) = b(k,130) - lu(k,109) * b(k,46) + b(k,139) = b(k,139) - lu(k,110) * b(k,46) + b(k,126) = b(k,126) - lu(k,112) * b(k,47) + b(k,129) = b(k,129) - lu(k,113) * b(k,47) + b(k,139) = b(k,139) - lu(k,114) * b(k,47) + b(k,81) = b(k,81) - lu(k,117) * b(k,48) + b(k,108) = b(k,108) - lu(k,118) * b(k,48) + b(k,114) = b(k,114) - lu(k,119) * b(k,48) + b(k,125) = b(k,125) - lu(k,120) * b(k,48) + b(k,139) = b(k,139) - lu(k,121) * b(k,48) + b(k,81) = b(k,81) - lu(k,123) * b(k,49) + b(k,132) = b(k,132) - lu(k,124) * b(k,49) + b(k,82) = b(k,82) - lu(k,126) * b(k,50) + b(k,112) = b(k,112) - lu(k,127) * b(k,50) + b(k,114) = b(k,114) - lu(k,128) * b(k,50) + b(k,126) = b(k,126) - lu(k,129) * b(k,50) + b(k,131) = b(k,131) - lu(k,130) * b(k,50) + b(k,85) = b(k,85) - lu(k,132) * b(k,51) + b(k,124) = b(k,124) - lu(k,133) * b(k,51) + b(k,82) = b(k,82) - lu(k,135) * b(k,52) + b(k,92) = b(k,92) - lu(k,136) * b(k,52) + b(k,117) = b(k,117) - lu(k,137) * b(k,52) + b(k,123) = b(k,123) - lu(k,138) * b(k,52) + b(k,69) = b(k,69) - lu(k,140) * b(k,53) + b(k,72) = b(k,72) - lu(k,141) * b(k,53) + b(k,82) = b(k,82) - lu(k,142) * b(k,53) + b(k,92) = b(k,92) - lu(k,143) * b(k,53) + b(k,114) = b(k,114) - lu(k,144) * b(k,53) + b(k,123) = b(k,123) - lu(k,145) * b(k,53) + b(k,132) = b(k,132) - lu(k,146) * b(k,53) + b(k,69) = b(k,69) - lu(k,148) * b(k,54) + b(k,89) = b(k,89) - lu(k,149) * b(k,54) + b(k,112) = b(k,112) - lu(k,150) * b(k,54) + b(k,114) = b(k,114) - lu(k,151) * b(k,54) + b(k,125) = b(k,125) - lu(k,152) * b(k,54) + b(k,138) = b(k,138) - lu(k,153) * b(k,54) + b(k,139) = b(k,139) - lu(k,154) * b(k,54) + b(k,89) = b(k,89) - lu(k,156) * b(k,55) + b(k,107) = b(k,107) - lu(k,157) * b(k,55) + b(k,114) = b(k,114) - lu(k,158) * b(k,55) + b(k,132) = b(k,132) - lu(k,159) * b(k,55) + b(k,139) = b(k,139) - lu(k,160) * b(k,55) + b(k,99) = b(k,99) - lu(k,162) * b(k,56) + b(k,108) = b(k,108) - lu(k,163) * b(k,56) + b(k,114) = b(k,114) - lu(k,164) * b(k,56) + b(k,125) = b(k,125) - lu(k,165) * b(k,56) + b(k,138) = b(k,138) - lu(k,166) * b(k,56) + b(k,68) = b(k,68) - lu(k,168) * b(k,57) + b(k,114) = b(k,114) - lu(k,169) * b(k,57) + b(k,116) = b(k,116) - lu(k,170) * b(k,57) + b(k,132) = b(k,132) - lu(k,171) * b(k,57) + b(k,139) = b(k,139) - lu(k,172) * b(k,57) + b(k,73) = b(k,73) - lu(k,174) * b(k,58) + b(k,116) = b(k,116) - lu(k,175) * b(k,58) + b(k,120) = b(k,120) - lu(k,176) * b(k,58) + b(k,137) = b(k,137) - lu(k,177) * b(k,58) + b(k,139) = b(k,139) - lu(k,178) * b(k,58) + b(k,112) = b(k,112) - lu(k,180) * b(k,59) + b(k,114) = b(k,114) - lu(k,181) * b(k,59) + b(k,124) = b(k,124) - lu(k,182) * b(k,59) + b(k,131) = b(k,131) - lu(k,183) * b(k,59) + b(k,133) = b(k,133) - lu(k,184) * b(k,59) + b(k,139) = b(k,139) - lu(k,185) * b(k,59) + b(k,99) = b(k,99) - lu(k,187) * b(k,60) + b(k,108) = b(k,108) - lu(k,188) * b(k,60) + b(k,114) = b(k,114) - lu(k,189) * b(k,60) + b(k,125) = b(k,125) - lu(k,190) * b(k,60) + b(k,138) = b(k,138) - lu(k,191) * b(k,60) + b(k,139) = b(k,139) - lu(k,192) * b(k,60) + b(k,62) = b(k,62) - lu(k,194) * b(k,61) + b(k,66) = b(k,66) - lu(k,195) * b(k,61) + b(k,78) = b(k,78) - lu(k,196) * b(k,61) + b(k,86) = b(k,86) - lu(k,197) * b(k,61) + b(k,123) = b(k,123) - lu(k,198) * b(k,61) + b(k,137) = b(k,137) - lu(k,199) * b(k,61) + b(k,66) = b(k,66) - lu(k,201) * b(k,62) + b(k,86) = b(k,86) - lu(k,202) * b(k,62) + b(k,123) = b(k,123) - lu(k,203) * b(k,62) + b(k,124) = b(k,124) - lu(k,204) * b(k,62) + b(k,128) = b(k,128) - lu(k,205) * b(k,62) + b(k,77) = b(k,77) - lu(k,207) * b(k,63) + b(k,99) = b(k,99) - lu(k,208) * b(k,63) + b(k,106) = b(k,106) - lu(k,209) * b(k,63) + b(k,123) = b(k,123) - lu(k,210) * b(k,63) + b(k,126) = b(k,126) - lu(k,211) * b(k,63) + b(k,131) = b(k,131) - lu(k,212) * b(k,63) + b(k,133) = b(k,133) - lu(k,213) * b(k,63) + b(k,112) = b(k,112) - lu(k,215) * b(k,64) + b(k,114) = b(k,114) - lu(k,216) * b(k,64) + b(k,123) = b(k,123) - lu(k,217) * b(k,64) + b(k,125) = b(k,125) - lu(k,218) * b(k,64) + b(k,138) = b(k,138) - lu(k,219) * b(k,64) + b(k,139) = b(k,139) - lu(k,220) * b(k,64) + b(k,89) = b(k,89) - lu(k,222) * b(k,65) + b(k,99) = b(k,99) - lu(k,223) * b(k,65) + b(k,108) = b(k,108) - lu(k,224) * b(k,65) + b(k,112) = b(k,112) - lu(k,225) * b(k,65) + b(k,114) = b(k,114) - lu(k,226) * b(k,65) + b(k,125) = b(k,125) - lu(k,227) * b(k,65) + b(k,138) = b(k,138) - lu(k,228) * b(k,65) + b(k,139) = b(k,139) - lu(k,229) * b(k,65) + b(k,76) = b(k,76) - lu(k,231) * b(k,66) + b(k,86) = b(k,86) - lu(k,232) * b(k,66) + b(k,90) = b(k,90) - lu(k,233) * b(k,66) + b(k,116) = b(k,116) - lu(k,234) * b(k,66) + b(k,118) = b(k,118) - lu(k,235) * b(k,66) + b(k,123) = b(k,123) - lu(k,236) * b(k,66) + b(k,124) = b(k,124) - lu(k,237) * b(k,66) + b(k,128) = b(k,128) - lu(k,238) * b(k,66) + b(k,100) = b(k,100) - lu(k,240) * b(k,67) + b(k,110) = b(k,110) - lu(k,241) * b(k,67) + b(k,121) = b(k,121) - lu(k,242) * b(k,67) + b(k,123) = b(k,123) - lu(k,243) * b(k,67) + b(k,124) = b(k,124) - lu(k,244) * b(k,67) + b(k,127) = b(k,127) - lu(k,245) * b(k,67) + b(k,74) = b(k,74) - lu(k,247) * b(k,68) + b(k,116) = b(k,116) - lu(k,248) * b(k,68) + b(k,120) = b(k,120) - lu(k,249) * b(k,68) + b(k,132) = b(k,132) - lu(k,250) * b(k,68) + b(k,139) = b(k,139) - lu(k,251) * b(k,68) + b(k,112) = b(k,112) - lu(k,253) * b(k,69) + b(k,114) = b(k,114) - lu(k,254) * b(k,69) + b(k,121) = b(k,121) - lu(k,255) * b(k,69) + b(k,71) = b(k,71) - lu(k,257) * b(k,70) + b(k,116) = b(k,116) - lu(k,258) * b(k,70) + b(k,118) = b(k,118) - lu(k,259) * b(k,70) + b(k,121) = b(k,121) - lu(k,260) * b(k,70) + b(k,122) = b(k,122) - lu(k,261) * b(k,70) + b(k,137) = b(k,137) - lu(k,262) * b(k,70) + b(k,139) = b(k,139) - lu(k,263) * b(k,70) + b(k,116) = b(k,116) - lu(k,265) * b(k,71) + b(k,118) = b(k,118) - lu(k,266) * b(k,71) + b(k,121) = b(k,121) - lu(k,267) * b(k,71) + b(k,122) = b(k,122) - lu(k,268) * b(k,71) + b(k,137) = b(k,137) - lu(k,269) * b(k,71) + b(k,139) = b(k,139) - lu(k,270) * b(k,71) + b(k,92) = b(k,92) - lu(k,272) * b(k,72) + b(k,114) = b(k,114) - lu(k,273) * b(k,72) + b(k,123) = b(k,123) - lu(k,274) * b(k,72) + b(k,124) = b(k,124) - lu(k,275) * b(k,72) + b(k,132) = b(k,132) - lu(k,276) * b(k,72) + b(k,136) = b(k,136) - lu(k,277) * b(k,72) + 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,114) = b(k,114) - lu(k,279) * b(k,73) + b(k,133) = b(k,133) - lu(k,280) * b(k,73) + b(k,137) = b(k,137) - lu(k,281) * b(k,73) + b(k,139) = b(k,139) - lu(k,282) * b(k,73) + b(k,116) = b(k,116) - lu(k,285) * b(k,74) + b(k,120) = b(k,120) - lu(k,286) * b(k,74) + b(k,132) = b(k,132) - lu(k,287) * b(k,74) + b(k,139) = b(k,139) - lu(k,288) * b(k,74) + b(k,114) = b(k,114) - lu(k,293) * b(k,75) + b(k,116) = b(k,116) - lu(k,294) * b(k,75) + b(k,120) = b(k,120) - lu(k,295) * b(k,75) + b(k,124) = b(k,124) - lu(k,296) * b(k,75) + b(k,128) = b(k,128) - lu(k,297) * b(k,75) + b(k,132) = b(k,132) - lu(k,298) * b(k,75) + b(k,139) = b(k,139) - lu(k,299) * b(k,75) + b(k,78) = b(k,78) - lu(k,301) * b(k,76) + b(k,86) = b(k,86) - lu(k,302) * b(k,76) + b(k,90) = b(k,90) - lu(k,303) * b(k,76) + b(k,108) = b(k,108) - lu(k,304) * b(k,76) + b(k,123) = b(k,123) - lu(k,305) * b(k,76) + b(k,124) = b(k,124) - lu(k,306) * b(k,76) + b(k,137) = b(k,137) - lu(k,307) * b(k,76) + b(k,99) = b(k,99) - lu(k,310) * b(k,77) + b(k,106) = b(k,106) - lu(k,311) * b(k,77) + b(k,114) = b(k,114) - lu(k,312) * b(k,77) + b(k,123) = b(k,123) - lu(k,313) * b(k,77) + b(k,125) = b(k,125) - lu(k,314) * b(k,77) + b(k,138) = b(k,138) - lu(k,315) * b(k,77) + b(k,139) = b(k,139) - lu(k,316) * b(k,77) + b(k,86) = b(k,86) - lu(k,318) * b(k,78) + b(k,90) = b(k,90) - lu(k,319) * b(k,78) + b(k,118) = b(k,118) - lu(k,320) * b(k,78) + b(k,123) = b(k,123) - lu(k,321) * b(k,78) + b(k,124) = b(k,124) - lu(k,322) * b(k,78) + b(k,128) = b(k,128) - lu(k,323) * b(k,78) + b(k,99) = b(k,99) - lu(k,325) * b(k,79) + b(k,106) = b(k,106) - lu(k,326) * b(k,79) + b(k,108) = b(k,108) - lu(k,327) * b(k,79) + b(k,114) = b(k,114) - lu(k,328) * b(k,79) + b(k,123) = b(k,123) - lu(k,329) * b(k,79) + b(k,132) = b(k,132) - lu(k,330) * b(k,79) + b(k,139) = b(k,139) - lu(k,331) * b(k,79) + b(k,114) = b(k,114) - lu(k,334) * b(k,80) + b(k,117) = b(k,117) - lu(k,335) * b(k,80) + b(k,123) = b(k,123) - lu(k,336) * b(k,80) + b(k,125) = b(k,125) - lu(k,337) * b(k,80) + b(k,138) = b(k,138) - lu(k,338) * b(k,80) + b(k,139) = b(k,139) - lu(k,339) * b(k,80) + b(k,88) = b(k,88) - lu(k,342) * b(k,81) + b(k,89) = b(k,89) - lu(k,343) * b(k,81) + b(k,103) = b(k,103) - lu(k,344) * b(k,81) + b(k,114) = b(k,114) - lu(k,345) * b(k,81) + b(k,126) = b(k,126) - lu(k,346) * b(k,81) + b(k,131) = b(k,131) - lu(k,347) * b(k,81) + b(k,132) = b(k,132) - lu(k,348) * b(k,81) + b(k,139) = b(k,139) - lu(k,349) * b(k,81) + b(k,92) = b(k,92) - lu(k,352) * b(k,82) + b(k,112) = b(k,112) - lu(k,353) * b(k,82) + b(k,114) = b(k,114) - lu(k,354) * b(k,82) + b(k,123) = b(k,123) - lu(k,355) * b(k,82) + b(k,139) = b(k,139) - lu(k,356) * b(k,82) + b(k,114) = b(k,114) - lu(k,360) * b(k,83) + b(k,117) = b(k,117) - lu(k,361) * b(k,83) + b(k,123) = b(k,123) - lu(k,362) * b(k,83) + b(k,125) = b(k,125) - lu(k,363) * b(k,83) + b(k,126) = b(k,126) - lu(k,364) * b(k,83) + b(k,131) = b(k,131) - lu(k,365) * b(k,83) + b(k,133) = b(k,133) - lu(k,366) * b(k,83) + b(k,138) = b(k,138) - lu(k,367) * b(k,83) + b(k,139) = b(k,139) - lu(k,368) * b(k,83) + b(k,109) = b(k,109) - lu(k,370) * b(k,84) + b(k,113) = b(k,113) - lu(k,371) * b(k,84) + b(k,123) = b(k,123) - lu(k,372) * b(k,84) + b(k,124) = b(k,124) - lu(k,373) * b(k,84) + b(k,125) = b(k,125) - lu(k,374) * b(k,84) + b(k,133) = b(k,133) - lu(k,375) * b(k,84) + b(k,137) = b(k,137) - lu(k,376) * b(k,84) + b(k,91) = b(k,91) - lu(k,378) * b(k,85) + b(k,116) = b(k,116) - lu(k,379) * b(k,85) + b(k,124) = b(k,124) - lu(k,380) * b(k,85) + b(k,127) = b(k,127) - lu(k,381) * b(k,85) + b(k,128) = b(k,128) - lu(k,382) * b(k,85) + b(k,135) = b(k,135) - lu(k,383) * b(k,85) + b(k,136) = b(k,136) - lu(k,384) * b(k,85) + b(k,90) = b(k,90) - lu(k,389) * b(k,86) + b(k,108) = b(k,108) - lu(k,390) * b(k,86) + b(k,112) = b(k,112) - lu(k,391) * b(k,86) + b(k,114) = b(k,114) - lu(k,392) * b(k,86) + b(k,118) = b(k,118) - lu(k,393) * b(k,86) + b(k,121) = b(k,121) - lu(k,394) * b(k,86) + b(k,123) = b(k,123) - lu(k,395) * b(k,86) + b(k,124) = b(k,124) - lu(k,396) * b(k,86) + b(k,128) = b(k,128) - lu(k,397) * b(k,86) + b(k,137) = b(k,137) - lu(k,398) * b(k,86) + b(k,101) = b(k,101) - lu(k,402) * b(k,87) + b(k,102) = b(k,102) - lu(k,403) * b(k,87) + b(k,105) = b(k,105) - lu(k,404) * b(k,87) + b(k,123) = b(k,123) - lu(k,405) * b(k,87) + b(k,126) = b(k,126) - lu(k,406) * b(k,87) + b(k,129) = b(k,129) - lu(k,407) * b(k,87) + b(k,130) = b(k,130) - lu(k,408) * b(k,87) + b(k,131) = b(k,131) - lu(k,409) * b(k,87) + b(k,133) = b(k,133) - lu(k,410) * b(k,87) + b(k,137) = b(k,137) - lu(k,411) * b(k,87) + b(k,139) = b(k,139) - lu(k,412) * b(k,87) + b(k,89) = b(k,89) - lu(k,417) * b(k,88) + b(k,103) = b(k,103) - lu(k,418) * b(k,88) + b(k,107) = b(k,107) - lu(k,419) * b(k,88) + b(k,108) = b(k,108) - lu(k,420) * b(k,88) + b(k,112) = b(k,112) - lu(k,421) * b(k,88) + b(k,114) = b(k,114) - lu(k,422) * b(k,88) + b(k,121) = b(k,121) - lu(k,423) * b(k,88) + b(k,123) = b(k,123) - lu(k,424) * b(k,88) + b(k,125) = b(k,125) - lu(k,425) * b(k,88) + b(k,126) = b(k,126) - lu(k,426) * b(k,88) + b(k,131) = b(k,131) - lu(k,427) * b(k,88) + b(k,132) = b(k,132) - lu(k,428) * b(k,88) + b(k,138) = b(k,138) - lu(k,429) * b(k,88) + b(k,139) = b(k,139) - lu(k,430) * b(k,88) + b(k,107) = b(k,107) - lu(k,433) * b(k,89) + b(k,112) = b(k,112) - lu(k,434) * b(k,89) + b(k,114) = b(k,114) - lu(k,435) * b(k,89) + b(k,117) = b(k,117) - lu(k,436) * b(k,89) + b(k,124) = b(k,124) - lu(k,437) * b(k,89) + b(k,125) = b(k,125) - lu(k,438) * b(k,89) + b(k,132) = b(k,132) - lu(k,439) * b(k,89) + b(k,133) = b(k,133) - lu(k,440) * b(k,89) + b(k,137) = b(k,137) - lu(k,441) * b(k,89) + b(k,139) = b(k,139) - lu(k,442) * b(k,89) + b(k,108) = b(k,108) - lu(k,447) * b(k,90) + b(k,112) = b(k,112) - lu(k,448) * b(k,90) + b(k,114) = b(k,114) - lu(k,449) * b(k,90) + b(k,116) = b(k,116) - lu(k,450) * b(k,90) + b(k,118) = b(k,118) - lu(k,451) * b(k,90) + b(k,121) = b(k,121) - lu(k,452) * b(k,90) + b(k,123) = b(k,123) - lu(k,453) * b(k,90) + b(k,124) = b(k,124) - lu(k,454) * b(k,90) + b(k,128) = b(k,128) - lu(k,455) * b(k,90) + b(k,132) = b(k,132) - lu(k,456) * b(k,90) + b(k,133) = b(k,133) - lu(k,457) * b(k,90) + b(k,137) = b(k,137) - lu(k,458) * b(k,90) + b(k,114) = b(k,114) - lu(k,462) * b(k,91) + b(k,116) = b(k,116) - lu(k,463) * b(k,91) + b(k,120) = b(k,120) - lu(k,464) * b(k,91) + b(k,123) = b(k,123) - lu(k,465) * b(k,91) + b(k,124) = b(k,124) - lu(k,466) * b(k,91) + b(k,127) = b(k,127) - lu(k,467) * b(k,91) + b(k,128) = b(k,128) - lu(k,468) * b(k,91) + b(k,132) = b(k,132) - lu(k,469) * b(k,91) + b(k,135) = b(k,135) - lu(k,470) * b(k,91) + b(k,136) = b(k,136) - lu(k,471) * b(k,91) + b(k,139) = b(k,139) - lu(k,472) * b(k,91) + b(k,99) = b(k,99) - lu(k,477) * b(k,92) + b(k,106) = b(k,106) - lu(k,478) * b(k,92) + b(k,112) = b(k,112) - lu(k,479) * b(k,92) + b(k,114) = b(k,114) - lu(k,480) * b(k,92) + b(k,117) = b(k,117) - lu(k,481) * b(k,92) + b(k,123) = b(k,123) - lu(k,482) * b(k,92) + b(k,124) = b(k,124) - lu(k,483) * b(k,92) + b(k,125) = b(k,125) - lu(k,484) * b(k,92) + b(k,132) = b(k,132) - lu(k,485) * b(k,92) + b(k,133) = b(k,133) - lu(k,486) * b(k,92) + b(k,136) = b(k,136) - lu(k,487) * b(k,92) + b(k,137) = b(k,137) - lu(k,488) * b(k,92) + b(k,139) = b(k,139) - lu(k,489) * b(k,92) + b(k,114) = b(k,114) - lu(k,491) * b(k,93) + b(k,118) = b(k,118) - lu(k,492) * b(k,93) + b(k,119) = b(k,119) - lu(k,493) * b(k,93) + b(k,120) = b(k,120) - lu(k,494) * b(k,93) + b(k,121) = b(k,121) - lu(k,495) * b(k,93) + b(k,122) = b(k,122) - lu(k,496) * b(k,93) + b(k,124) = b(k,124) - lu(k,497) * b(k,93) + b(k,128) = b(k,128) - lu(k,498) * b(k,93) + b(k,129) = b(k,129) - lu(k,499) * b(k,93) + b(k,130) = b(k,130) - lu(k,500) * b(k,93) + b(k,132) = b(k,132) - lu(k,501) * b(k,93) + b(k,137) = b(k,137) - lu(k,502) * b(k,93) + b(k,139) = b(k,139) - lu(k,503) * b(k,93) + b(k,104) = b(k,104) - lu(k,505) * b(k,94) + b(k,118) = b(k,118) - lu(k,506) * b(k,94) + b(k,119) = b(k,119) - lu(k,507) * b(k,94) + b(k,120) = b(k,120) - lu(k,508) * b(k,94) + b(k,121) = b(k,121) - lu(k,509) * b(k,94) + b(k,122) = b(k,122) - lu(k,510) * b(k,94) + b(k,123) = b(k,123) - lu(k,511) * b(k,94) + b(k,124) = b(k,124) - lu(k,512) * b(k,94) + b(k,128) = b(k,128) - lu(k,513) * b(k,94) + b(k,129) = b(k,129) - lu(k,514) * b(k,94) + b(k,130) = b(k,130) - lu(k,515) * b(k,94) + b(k,132) = b(k,132) - lu(k,516) * b(k,94) + b(k,137) = b(k,137) - lu(k,517) * b(k,94) + b(k,139) = b(k,139) - lu(k,518) * b(k,94) + b(k,109) = b(k,109) - lu(k,520) * b(k,95) + b(k,118) = b(k,118) - lu(k,521) * b(k,95) + b(k,119) = b(k,119) - lu(k,522) * b(k,95) + b(k,120) = b(k,120) - lu(k,523) * b(k,95) + b(k,122) = b(k,122) - lu(k,524) * b(k,95) + b(k,124) = b(k,124) - lu(k,525) * b(k,95) + b(k,125) = b(k,125) - lu(k,526) * b(k,95) + b(k,128) = b(k,128) - lu(k,527) * b(k,95) + b(k,129) = b(k,129) - lu(k,528) * b(k,95) + b(k,130) = b(k,130) - lu(k,529) * b(k,95) + b(k,132) = b(k,132) - lu(k,530) * b(k,95) + b(k,137) = b(k,137) - lu(k,531) * b(k,95) + b(k,138) = b(k,138) - lu(k,532) * b(k,95) + b(k,139) = b(k,139) - lu(k,533) * b(k,95) + 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,109) = b(k,109) - lu(k,536) * b(k,96) + b(k,118) = b(k,118) - lu(k,537) * b(k,96) + b(k,119) = b(k,119) - lu(k,538) * b(k,96) + b(k,120) = b(k,120) - lu(k,539) * b(k,96) + b(k,122) = b(k,122) - lu(k,540) * b(k,96) + b(k,124) = b(k,124) - lu(k,541) * b(k,96) + b(k,125) = b(k,125) - lu(k,542) * b(k,96) + b(k,128) = b(k,128) - lu(k,543) * b(k,96) + b(k,129) = b(k,129) - lu(k,544) * b(k,96) + b(k,130) = b(k,130) - lu(k,545) * b(k,96) + b(k,132) = b(k,132) - lu(k,546) * b(k,96) + b(k,137) = b(k,137) - lu(k,547) * b(k,96) + b(k,138) = b(k,138) - lu(k,548) * b(k,96) + b(k,139) = b(k,139) - lu(k,549) * b(k,96) + b(k,113) = b(k,113) - lu(k,551) * b(k,97) + b(k,118) = b(k,118) - lu(k,552) * b(k,97) + b(k,119) = b(k,119) - lu(k,553) * b(k,97) + b(k,120) = b(k,120) - lu(k,554) * b(k,97) + b(k,122) = b(k,122) - lu(k,555) * b(k,97) + b(k,124) = b(k,124) - lu(k,556) * b(k,97) + b(k,128) = b(k,128) - lu(k,557) * b(k,97) + b(k,129) = b(k,129) - lu(k,558) * b(k,97) + b(k,130) = b(k,130) - lu(k,559) * b(k,97) + b(k,132) = b(k,132) - lu(k,560) * b(k,97) + b(k,133) = b(k,133) - lu(k,561) * b(k,97) + b(k,137) = b(k,137) - lu(k,562) * b(k,97) + b(k,139) = b(k,139) - lu(k,563) * b(k,97) + b(k,101) = b(k,101) - lu(k,565) * b(k,98) + b(k,118) = b(k,118) - lu(k,566) * b(k,98) + b(k,119) = b(k,119) - lu(k,567) * b(k,98) + b(k,120) = b(k,120) - lu(k,568) * b(k,98) + b(k,122) = b(k,122) - lu(k,569) * b(k,98) + b(k,124) = b(k,124) - lu(k,570) * b(k,98) + b(k,126) = b(k,126) - lu(k,571) * b(k,98) + b(k,128) = b(k,128) - lu(k,572) * b(k,98) + b(k,129) = b(k,129) - lu(k,573) * b(k,98) + b(k,130) = b(k,130) - lu(k,574) * b(k,98) + b(k,131) = b(k,131) - lu(k,575) * b(k,98) + b(k,132) = b(k,132) - lu(k,576) * b(k,98) + b(k,137) = b(k,137) - lu(k,577) * b(k,98) + b(k,138) = b(k,138) - lu(k,578) * b(k,98) + b(k,139) = b(k,139) - lu(k,579) * b(k,98) + b(k,106) = b(k,106) - lu(k,583) * b(k,99) + b(k,107) = b(k,107) - lu(k,584) * b(k,99) + b(k,108) = b(k,108) - lu(k,585) * b(k,99) + b(k,112) = b(k,112) - lu(k,586) * b(k,99) + b(k,114) = b(k,114) - lu(k,587) * b(k,99) + b(k,121) = b(k,121) - lu(k,588) * b(k,99) + b(k,123) = b(k,123) - lu(k,589) * b(k,99) + b(k,124) = b(k,124) - lu(k,590) * b(k,99) + b(k,132) = b(k,132) - lu(k,591) * b(k,99) + b(k,136) = b(k,136) - lu(k,592) * b(k,99) + b(k,139) = b(k,139) - lu(k,593) * b(k,99) + b(k,111) = b(k,111) - lu(k,595) * b(k,100) + b(k,113) = b(k,113) - lu(k,596) * b(k,100) + b(k,115) = b(k,115) - lu(k,597) * b(k,100) + b(k,116) = b(k,116) - lu(k,598) * b(k,100) + b(k,121) = b(k,121) - lu(k,599) * b(k,100) + b(k,123) = b(k,123) - lu(k,600) * b(k,100) + b(k,124) = b(k,124) - lu(k,601) * b(k,100) + b(k,127) = b(k,127) - lu(k,602) * b(k,100) + b(k,132) = b(k,132) - lu(k,603) * b(k,100) + b(k,133) = b(k,133) - lu(k,604) * b(k,100) + b(k,134) = b(k,134) - lu(k,605) * b(k,100) + b(k,135) = b(k,135) - lu(k,606) * b(k,100) + b(k,136) = b(k,136) - lu(k,607) * b(k,100) + b(k,137) = b(k,137) - lu(k,608) * b(k,100) + b(k,111) = b(k,111) - lu(k,610) * b(k,101) + b(k,118) = b(k,118) - lu(k,611) * b(k,101) + b(k,119) = b(k,119) - lu(k,612) * b(k,101) + b(k,120) = b(k,120) - lu(k,613) * b(k,101) + b(k,122) = b(k,122) - lu(k,614) * b(k,101) + b(k,124) = b(k,124) - lu(k,615) * b(k,101) + b(k,126) = b(k,126) - lu(k,616) * b(k,101) + b(k,128) = b(k,128) - lu(k,617) * b(k,101) + b(k,129) = b(k,129) - lu(k,618) * b(k,101) + b(k,130) = b(k,130) - lu(k,619) * b(k,101) + b(k,131) = b(k,131) - lu(k,620) * b(k,101) + b(k,137) = b(k,137) - lu(k,621) * b(k,101) + b(k,139) = b(k,139) - lu(k,622) * b(k,101) + b(k,105) = b(k,105) - lu(k,626) * b(k,102) + b(k,111) = b(k,111) - lu(k,627) * b(k,102) + b(k,118) = b(k,118) - lu(k,628) * b(k,102) + b(k,119) = b(k,119) - lu(k,629) * b(k,102) + b(k,120) = b(k,120) - lu(k,630) * b(k,102) + b(k,122) = b(k,122) - lu(k,631) * b(k,102) + b(k,123) = b(k,123) - lu(k,632) * b(k,102) + b(k,124) = b(k,124) - lu(k,633) * b(k,102) + b(k,126) = b(k,126) - lu(k,634) * b(k,102) + b(k,128) = b(k,128) - lu(k,635) * b(k,102) + b(k,129) = b(k,129) - lu(k,636) * b(k,102) + b(k,130) = b(k,130) - lu(k,637) * b(k,102) + b(k,131) = b(k,131) - lu(k,638) * b(k,102) + b(k,132) = b(k,132) - lu(k,639) * b(k,102) + b(k,133) = b(k,133) - lu(k,640) * b(k,102) + b(k,137) = b(k,137) - lu(k,641) * b(k,102) + b(k,139) = b(k,139) - lu(k,642) * b(k,102) + b(k,107) = b(k,107) - lu(k,648) * b(k,103) + b(k,108) = b(k,108) - lu(k,649) * b(k,103) + b(k,112) = b(k,112) - lu(k,650) * b(k,103) + b(k,114) = b(k,114) - lu(k,651) * b(k,103) + b(k,116) = b(k,116) - lu(k,652) * b(k,103) + b(k,117) = b(k,117) - lu(k,653) * b(k,103) + b(k,121) = b(k,121) - lu(k,654) * b(k,103) + b(k,123) = b(k,123) - lu(k,655) * b(k,103) + b(k,124) = b(k,124) - lu(k,656) * b(k,103) + b(k,125) = b(k,125) - lu(k,657) * b(k,103) + b(k,126) = b(k,126) - lu(k,658) * b(k,103) + b(k,131) = b(k,131) - lu(k,659) * b(k,103) + b(k,132) = b(k,132) - lu(k,660) * b(k,103) + b(k,133) = b(k,133) - lu(k,661) * b(k,103) + b(k,134) = b(k,134) - lu(k,662) * b(k,103) + b(k,135) = b(k,135) - lu(k,663) * b(k,103) + b(k,137) = b(k,137) - lu(k,664) * b(k,103) + b(k,138) = b(k,138) - lu(k,665) * b(k,103) + b(k,139) = b(k,139) - lu(k,666) * b(k,103) + b(k,105) = b(k,105) - lu(k,670) * b(k,104) + b(k,111) = b(k,111) - lu(k,671) * b(k,104) + b(k,113) = b(k,113) - lu(k,672) * b(k,104) + b(k,115) = b(k,115) - lu(k,673) * b(k,104) + b(k,118) = b(k,118) - lu(k,674) * b(k,104) + b(k,119) = b(k,119) - lu(k,675) * b(k,104) + b(k,120) = b(k,120) - lu(k,676) * b(k,104) + b(k,121) = b(k,121) - lu(k,677) * b(k,104) + b(k,122) = b(k,122) - lu(k,678) * b(k,104) + b(k,123) = b(k,123) - lu(k,679) * b(k,104) + b(k,124) = b(k,124) - lu(k,680) * b(k,104) + b(k,128) = b(k,128) - lu(k,681) * b(k,104) + b(k,129) = b(k,129) - lu(k,682) * b(k,104) + b(k,130) = b(k,130) - lu(k,683) * b(k,104) + b(k,132) = b(k,132) - lu(k,684) * b(k,104) + b(k,133) = b(k,133) - lu(k,685) * b(k,104) + b(k,137) = b(k,137) - lu(k,686) * b(k,104) + b(k,139) = b(k,139) - lu(k,687) * b(k,104) + b(k,111) = b(k,111) - lu(k,692) * b(k,105) + b(k,118) = b(k,118) - lu(k,693) * b(k,105) + b(k,119) = b(k,119) - lu(k,694) * b(k,105) + b(k,120) = b(k,120) - lu(k,695) * b(k,105) + b(k,122) = b(k,122) - lu(k,696) * b(k,105) + b(k,123) = b(k,123) - lu(k,697) * b(k,105) + b(k,124) = b(k,124) - lu(k,698) * b(k,105) + b(k,126) = b(k,126) - lu(k,699) * b(k,105) + b(k,128) = b(k,128) - lu(k,700) * b(k,105) + b(k,129) = b(k,129) - lu(k,701) * b(k,105) + b(k,130) = b(k,130) - lu(k,702) * b(k,105) + b(k,131) = b(k,131) - lu(k,703) * b(k,105) + b(k,132) = b(k,132) - lu(k,704) * b(k,105) + b(k,133) = b(k,133) - lu(k,705) * b(k,105) + b(k,137) = b(k,137) - lu(k,706) * b(k,105) + b(k,139) = b(k,139) - lu(k,707) * b(k,105) + b(k,107) = b(k,107) - lu(k,716) * b(k,106) + b(k,108) = b(k,108) - lu(k,717) * b(k,106) + b(k,112) = b(k,112) - lu(k,718) * b(k,106) + b(k,114) = b(k,114) - lu(k,719) * b(k,106) + b(k,117) = b(k,117) - lu(k,720) * b(k,106) + b(k,121) = b(k,121) - lu(k,721) * b(k,106) + b(k,123) = b(k,123) - lu(k,722) * b(k,106) + b(k,124) = b(k,124) - lu(k,723) * b(k,106) + b(k,125) = b(k,125) - lu(k,724) * b(k,106) + b(k,126) = b(k,126) - lu(k,725) * b(k,106) + b(k,131) = b(k,131) - lu(k,726) * b(k,106) + b(k,132) = b(k,132) - lu(k,727) * b(k,106) + b(k,133) = b(k,133) - lu(k,728) * b(k,106) + b(k,136) = b(k,136) - lu(k,729) * b(k,106) + b(k,137) = b(k,137) - lu(k,730) * b(k,106) + b(k,138) = b(k,138) - lu(k,731) * b(k,106) + b(k,139) = b(k,139) - lu(k,732) * b(k,106) + b(k,108) = b(k,108) - lu(k,739) * b(k,107) + b(k,112) = b(k,112) - lu(k,740) * b(k,107) + b(k,114) = b(k,114) - lu(k,741) * b(k,107) + b(k,116) = b(k,116) - lu(k,742) * b(k,107) + b(k,117) = b(k,117) - lu(k,743) * b(k,107) + b(k,121) = b(k,121) - lu(k,744) * b(k,107) + b(k,123) = b(k,123) - lu(k,745) * b(k,107) + b(k,124) = b(k,124) - lu(k,746) * b(k,107) + b(k,125) = b(k,125) - lu(k,747) * b(k,107) + b(k,126) = b(k,126) - lu(k,748) * b(k,107) + b(k,131) = b(k,131) - lu(k,749) * b(k,107) + b(k,132) = b(k,132) - lu(k,750) * b(k,107) + b(k,133) = b(k,133) - lu(k,751) * b(k,107) + b(k,134) = b(k,134) - lu(k,752) * b(k,107) + b(k,135) = b(k,135) - lu(k,753) * b(k,107) + b(k,136) = b(k,136) - lu(k,754) * b(k,107) + b(k,137) = b(k,137) - lu(k,755) * b(k,107) + b(k,138) = b(k,138) - lu(k,756) * b(k,107) + b(k,139) = b(k,139) - lu(k,757) * b(k,107) + b(k,112) = b(k,112) - lu(k,788) * b(k,108) + b(k,114) = b(k,114) - lu(k,789) * b(k,108) + b(k,116) = b(k,116) - lu(k,790) * b(k,108) + b(k,117) = b(k,117) - lu(k,791) * b(k,108) + b(k,120) = b(k,120) - lu(k,792) * b(k,108) + b(k,121) = b(k,121) - lu(k,793) * b(k,108) + b(k,123) = b(k,123) - lu(k,794) * b(k,108) + b(k,124) = b(k,124) - lu(k,795) * b(k,108) + b(k,125) = b(k,125) - lu(k,796) * b(k,108) + b(k,126) = b(k,126) - lu(k,797) * b(k,108) + b(k,127) = b(k,127) - lu(k,798) * b(k,108) + b(k,128) = b(k,128) - lu(k,799) * b(k,108) + b(k,131) = b(k,131) - lu(k,800) * b(k,108) + b(k,132) = b(k,132) - lu(k,801) * b(k,108) + b(k,133) = b(k,133) - lu(k,802) * b(k,108) + b(k,134) = b(k,134) - lu(k,803) * b(k,108) + b(k,135) = b(k,135) - lu(k,804) * b(k,108) + b(k,136) = b(k,136) - lu(k,805) * b(k,108) + b(k,137) = b(k,137) - lu(k,806) * b(k,108) + b(k,138) = b(k,138) - lu(k,807) * b(k,108) + b(k,139) = b(k,139) - lu(k,808) * b(k,108) + 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,111) = b(k,111) - lu(k,812) * b(k,109) + b(k,113) = b(k,113) - lu(k,813) * b(k,109) + b(k,116) = b(k,116) - lu(k,814) * b(k,109) + b(k,118) = b(k,118) - lu(k,815) * b(k,109) + b(k,119) = b(k,119) - lu(k,816) * b(k,109) + b(k,120) = b(k,120) - lu(k,817) * b(k,109) + b(k,122) = b(k,122) - lu(k,818) * b(k,109) + b(k,124) = b(k,124) - lu(k,819) * b(k,109) + b(k,125) = b(k,125) - lu(k,820) * b(k,109) + b(k,126) = b(k,126) - lu(k,821) * b(k,109) + b(k,128) = b(k,128) - lu(k,822) * b(k,109) + b(k,129) = b(k,129) - lu(k,823) * b(k,109) + b(k,130) = b(k,130) - lu(k,824) * b(k,109) + b(k,132) = b(k,132) - lu(k,825) * b(k,109) + b(k,133) = b(k,133) - lu(k,826) * b(k,109) + b(k,137) = b(k,137) - lu(k,827) * b(k,109) + b(k,138) = b(k,138) - lu(k,828) * b(k,109) + b(k,139) = b(k,139) - lu(k,829) * b(k,109) + b(k,111) = b(k,111) - lu(k,834) * b(k,110) + b(k,112) = b(k,112) - lu(k,835) * b(k,110) + b(k,113) = b(k,113) - lu(k,836) * b(k,110) + b(k,114) = b(k,114) - lu(k,837) * b(k,110) + b(k,115) = b(k,115) - lu(k,838) * b(k,110) + b(k,116) = b(k,116) - lu(k,839) * b(k,110) + b(k,117) = b(k,117) - lu(k,840) * b(k,110) + b(k,118) = b(k,118) - lu(k,841) * b(k,110) + b(k,119) = b(k,119) - lu(k,842) * b(k,110) + b(k,120) = b(k,120) - lu(k,843) * b(k,110) + b(k,121) = b(k,121) - lu(k,844) * b(k,110) + b(k,122) = b(k,122) - lu(k,845) * b(k,110) + b(k,123) = b(k,123) - lu(k,846) * b(k,110) + b(k,124) = b(k,124) - lu(k,847) * b(k,110) + b(k,125) = b(k,125) - lu(k,848) * b(k,110) + b(k,126) = b(k,126) - lu(k,849) * b(k,110) + b(k,127) = b(k,127) - lu(k,850) * b(k,110) + b(k,128) = b(k,128) - lu(k,851) * b(k,110) + b(k,129) = b(k,129) - lu(k,852) * b(k,110) + b(k,130) = b(k,130) - lu(k,853) * b(k,110) + b(k,132) = b(k,132) - lu(k,854) * b(k,110) + b(k,133) = b(k,133) - lu(k,855) * b(k,110) + b(k,134) = b(k,134) - lu(k,856) * b(k,110) + b(k,135) = b(k,135) - lu(k,857) * b(k,110) + b(k,136) = b(k,136) - lu(k,858) * b(k,110) + b(k,137) = b(k,137) - lu(k,859) * b(k,110) + b(k,138) = b(k,138) - lu(k,860) * b(k,110) + b(k,139) = b(k,139) - lu(k,861) * b(k,110) + b(k,113) = b(k,113) - lu(k,867) * b(k,111) + b(k,116) = b(k,116) - lu(k,868) * b(k,111) + b(k,118) = b(k,118) - lu(k,869) * b(k,111) + b(k,119) = b(k,119) - lu(k,870) * b(k,111) + b(k,120) = b(k,120) - lu(k,871) * b(k,111) + b(k,122) = b(k,122) - lu(k,872) * b(k,111) + b(k,123) = b(k,123) - lu(k,873) * b(k,111) + b(k,124) = b(k,124) - lu(k,874) * b(k,111) + b(k,125) = b(k,125) - lu(k,875) * b(k,111) + b(k,126) = b(k,126) - lu(k,876) * b(k,111) + b(k,128) = b(k,128) - lu(k,877) * b(k,111) + b(k,129) = b(k,129) - lu(k,878) * b(k,111) + b(k,130) = b(k,130) - lu(k,879) * b(k,111) + b(k,131) = b(k,131) - lu(k,880) * b(k,111) + b(k,132) = b(k,132) - lu(k,881) * b(k,111) + b(k,133) = b(k,133) - lu(k,882) * b(k,111) + b(k,136) = b(k,136) - lu(k,883) * b(k,111) + b(k,137) = b(k,137) - lu(k,884) * b(k,111) + b(k,138) = b(k,138) - lu(k,885) * b(k,111) + b(k,139) = b(k,139) - lu(k,886) * b(k,111) + b(k,114) = b(k,114) - lu(k,901) * b(k,112) + b(k,116) = b(k,116) - lu(k,902) * b(k,112) + b(k,117) = b(k,117) - lu(k,903) * b(k,112) + b(k,120) = b(k,120) - lu(k,904) * b(k,112) + b(k,121) = b(k,121) - lu(k,905) * b(k,112) + b(k,122) = b(k,122) - lu(k,906) * b(k,112) + b(k,123) = b(k,123) - lu(k,907) * b(k,112) + b(k,124) = b(k,124) - lu(k,908) * b(k,112) + b(k,125) = b(k,125) - lu(k,909) * b(k,112) + b(k,126) = b(k,126) - lu(k,910) * b(k,112) + b(k,127) = b(k,127) - lu(k,911) * b(k,112) + b(k,128) = b(k,128) - lu(k,912) * b(k,112) + b(k,131) = b(k,131) - lu(k,913) * b(k,112) + b(k,132) = b(k,132) - lu(k,914) * b(k,112) + b(k,133) = b(k,133) - lu(k,915) * b(k,112) + b(k,134) = b(k,134) - lu(k,916) * b(k,112) + b(k,135) = b(k,135) - lu(k,917) * b(k,112) + b(k,136) = b(k,136) - lu(k,918) * b(k,112) + b(k,137) = b(k,137) - lu(k,919) * b(k,112) + b(k,138) = b(k,138) - lu(k,920) * b(k,112) + b(k,139) = b(k,139) - lu(k,921) * b(k,112) + b(k,114) = b(k,114) - lu(k,927) * b(k,113) + b(k,116) = b(k,116) - lu(k,928) * b(k,113) + b(k,117) = b(k,117) - lu(k,929) * b(k,113) + b(k,118) = b(k,118) - lu(k,930) * b(k,113) + b(k,119) = b(k,119) - lu(k,931) * b(k,113) + b(k,120) = b(k,120) - lu(k,932) * b(k,113) + b(k,122) = b(k,122) - lu(k,933) * b(k,113) + b(k,123) = b(k,123) - lu(k,934) * b(k,113) + b(k,124) = b(k,124) - lu(k,935) * b(k,113) + b(k,125) = b(k,125) - lu(k,936) * b(k,113) + b(k,126) = b(k,126) - lu(k,937) * b(k,113) + b(k,128) = b(k,128) - lu(k,938) * b(k,113) + b(k,129) = b(k,129) - lu(k,939) * b(k,113) + b(k,130) = b(k,130) - lu(k,940) * b(k,113) + b(k,131) = b(k,131) - lu(k,941) * b(k,113) + b(k,132) = b(k,132) - lu(k,942) * b(k,113) + b(k,133) = b(k,133) - lu(k,943) * b(k,113) + b(k,134) = b(k,134) - lu(k,944) * b(k,113) + b(k,136) = b(k,136) - lu(k,945) * b(k,113) + b(k,137) = b(k,137) - lu(k,946) * b(k,113) + b(k,138) = b(k,138) - lu(k,947) * b(k,113) + b(k,139) = b(k,139) - lu(k,948) * b(k,113) + b(k,116) = b(k,116) - lu(k,985) * b(k,114) + b(k,117) = b(k,117) - lu(k,986) * b(k,114) + b(k,118) = b(k,118) - lu(k,987) * b(k,114) + b(k,120) = b(k,120) - lu(k,988) * b(k,114) + b(k,121) = b(k,121) - lu(k,989) * b(k,114) + b(k,122) = b(k,122) - lu(k,990) * b(k,114) + b(k,123) = b(k,123) - lu(k,991) * b(k,114) + b(k,124) = b(k,124) - lu(k,992) * b(k,114) + b(k,125) = b(k,125) - lu(k,993) * b(k,114) + b(k,126) = b(k,126) - lu(k,994) * b(k,114) + b(k,127) = b(k,127) - lu(k,995) * b(k,114) + b(k,128) = b(k,128) - lu(k,996) * b(k,114) + b(k,131) = b(k,131) - lu(k,997) * b(k,114) + b(k,132) = b(k,132) - lu(k,998) * b(k,114) + b(k,133) = b(k,133) - lu(k,999) * b(k,114) + b(k,134) = b(k,134) - lu(k,1000) * b(k,114) + b(k,135) = b(k,135) - lu(k,1001) * b(k,114) + b(k,136) = b(k,136) - lu(k,1002) * b(k,114) + b(k,137) = b(k,137) - lu(k,1003) * b(k,114) + b(k,138) = b(k,138) - lu(k,1004) * b(k,114) + b(k,139) = b(k,139) - lu(k,1005) * b(k,114) + b(k,116) = b(k,116) - lu(k,1015) * b(k,115) + b(k,117) = b(k,117) - lu(k,1016) * b(k,115) + b(k,118) = b(k,118) - lu(k,1017) * b(k,115) + b(k,119) = b(k,119) - lu(k,1018) * b(k,115) + b(k,120) = b(k,120) - lu(k,1019) * b(k,115) + b(k,121) = b(k,121) - lu(k,1020) * b(k,115) + b(k,122) = b(k,122) - lu(k,1021) * b(k,115) + b(k,123) = b(k,123) - lu(k,1022) * b(k,115) + b(k,124) = b(k,124) - lu(k,1023) * b(k,115) + b(k,125) = b(k,125) - lu(k,1024) * b(k,115) + b(k,126) = b(k,126) - lu(k,1025) * b(k,115) + b(k,127) = b(k,127) - lu(k,1026) * b(k,115) + b(k,128) = b(k,128) - lu(k,1027) * b(k,115) + b(k,129) = b(k,129) - lu(k,1028) * b(k,115) + b(k,130) = b(k,130) - lu(k,1029) * b(k,115) + b(k,131) = b(k,131) - lu(k,1030) * b(k,115) + b(k,132) = b(k,132) - lu(k,1031) * b(k,115) + b(k,133) = b(k,133) - lu(k,1032) * b(k,115) + b(k,134) = b(k,134) - lu(k,1033) * b(k,115) + b(k,135) = b(k,135) - lu(k,1034) * b(k,115) + b(k,136) = b(k,136) - lu(k,1035) * b(k,115) + b(k,137) = b(k,137) - lu(k,1036) * b(k,115) + b(k,138) = b(k,138) - lu(k,1037) * b(k,115) + b(k,139) = b(k,139) - lu(k,1038) * b(k,115) + b(k,117) = b(k,117) - lu(k,1059) * b(k,116) + b(k,118) = b(k,118) - lu(k,1060) * b(k,116) + b(k,119) = b(k,119) - lu(k,1061) * b(k,116) + b(k,120) = b(k,120) - lu(k,1062) * b(k,116) + b(k,121) = b(k,121) - lu(k,1063) * b(k,116) + b(k,122) = b(k,122) - lu(k,1064) * b(k,116) + b(k,123) = b(k,123) - lu(k,1065) * b(k,116) + b(k,124) = b(k,124) - lu(k,1066) * b(k,116) + b(k,125) = b(k,125) - lu(k,1067) * b(k,116) + b(k,126) = b(k,126) - lu(k,1068) * b(k,116) + b(k,127) = b(k,127) - lu(k,1069) * b(k,116) + b(k,128) = b(k,128) - lu(k,1070) * b(k,116) + b(k,129) = b(k,129) - lu(k,1071) * b(k,116) + b(k,130) = b(k,130) - lu(k,1072) * b(k,116) + b(k,131) = b(k,131) - lu(k,1073) * b(k,116) + b(k,132) = b(k,132) - lu(k,1074) * b(k,116) + b(k,133) = b(k,133) - lu(k,1075) * b(k,116) + b(k,134) = b(k,134) - lu(k,1076) * b(k,116) + b(k,135) = b(k,135) - lu(k,1077) * b(k,116) + b(k,136) = b(k,136) - lu(k,1078) * b(k,116) + b(k,137) = b(k,137) - lu(k,1079) * b(k,116) + b(k,138) = b(k,138) - lu(k,1080) * b(k,116) + b(k,139) = b(k,139) - lu(k,1081) * b(k,116) + b(k,118) = b(k,118) - lu(k,1105) * b(k,117) + b(k,119) = b(k,119) - lu(k,1106) * b(k,117) + b(k,120) = b(k,120) - lu(k,1107) * b(k,117) + b(k,121) = b(k,121) - lu(k,1108) * b(k,117) + b(k,122) = b(k,122) - lu(k,1109) * b(k,117) + b(k,123) = b(k,123) - lu(k,1110) * b(k,117) + b(k,124) = b(k,124) - lu(k,1111) * b(k,117) + b(k,125) = b(k,125) - lu(k,1112) * b(k,117) + b(k,126) = b(k,126) - lu(k,1113) * b(k,117) + b(k,127) = b(k,127) - lu(k,1114) * b(k,117) + b(k,128) = b(k,128) - lu(k,1115) * b(k,117) + b(k,129) = b(k,129) - lu(k,1116) * b(k,117) + b(k,130) = b(k,130) - lu(k,1117) * b(k,117) + b(k,131) = b(k,131) - lu(k,1118) * b(k,117) + b(k,132) = b(k,132) - lu(k,1119) * b(k,117) + b(k,133) = b(k,133) - lu(k,1120) * b(k,117) + b(k,134) = b(k,134) - lu(k,1121) * b(k,117) + b(k,135) = b(k,135) - lu(k,1122) * b(k,117) + b(k,136) = b(k,136) - lu(k,1123) * b(k,117) + b(k,137) = b(k,137) - lu(k,1124) * b(k,117) + b(k,138) = b(k,138) - lu(k,1125) * b(k,117) + b(k,139) = b(k,139) - lu(k,1126) * b(k,117) + b(k,119) = b(k,119) - lu(k,1154) * b(k,118) + b(k,120) = b(k,120) - lu(k,1155) * b(k,118) + b(k,121) = b(k,121) - lu(k,1156) * b(k,118) + b(k,122) = b(k,122) - lu(k,1157) * b(k,118) + b(k,123) = b(k,123) - lu(k,1158) * b(k,118) + b(k,124) = b(k,124) - lu(k,1159) * b(k,118) + b(k,125) = b(k,125) - lu(k,1160) * b(k,118) + b(k,126) = b(k,126) - lu(k,1161) * b(k,118) + b(k,127) = b(k,127) - lu(k,1162) * b(k,118) + b(k,128) = b(k,128) - lu(k,1163) * b(k,118) + b(k,129) = b(k,129) - lu(k,1164) * b(k,118) + b(k,130) = b(k,130) - lu(k,1165) * b(k,118) + b(k,131) = b(k,131) - lu(k,1166) * b(k,118) + b(k,132) = b(k,132) - lu(k,1167) * b(k,118) + b(k,133) = b(k,133) - lu(k,1168) * b(k,118) + b(k,134) = b(k,134) - lu(k,1169) * b(k,118) + b(k,135) = b(k,135) - lu(k,1170) * b(k,118) + b(k,136) = b(k,136) - lu(k,1171) * b(k,118) + b(k,137) = b(k,137) - lu(k,1172) * b(k,118) + b(k,138) = b(k,138) - lu(k,1173) * b(k,118) + b(k,139) = b(k,139) - lu(k,1174) * b(k,118) + 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 + b(k,120) = b(k,120) - lu(k,1198) * b(k,119) + b(k,121) = b(k,121) - lu(k,1199) * b(k,119) + b(k,122) = b(k,122) - lu(k,1200) * b(k,119) + b(k,123) = b(k,123) - lu(k,1201) * b(k,119) + b(k,124) = b(k,124) - lu(k,1202) * b(k,119) + b(k,125) = b(k,125) - lu(k,1203) * b(k,119) + b(k,126) = b(k,126) - lu(k,1204) * b(k,119) + b(k,127) = b(k,127) - lu(k,1205) * b(k,119) + b(k,128) = b(k,128) - lu(k,1206) * b(k,119) + b(k,129) = b(k,129) - lu(k,1207) * b(k,119) + b(k,130) = b(k,130) - lu(k,1208) * b(k,119) + b(k,131) = b(k,131) - lu(k,1209) * b(k,119) + b(k,132) = b(k,132) - lu(k,1210) * b(k,119) + b(k,133) = b(k,133) - lu(k,1211) * b(k,119) + b(k,134) = b(k,134) - lu(k,1212) * b(k,119) + b(k,135) = b(k,135) - lu(k,1213) * b(k,119) + b(k,136) = b(k,136) - lu(k,1214) * b(k,119) + b(k,137) = b(k,137) - lu(k,1215) * b(k,119) + b(k,138) = b(k,138) - lu(k,1216) * b(k,119) + b(k,139) = b(k,139) - lu(k,1217) * b(k,119) + b(k,121) = b(k,121) - lu(k,1242) * b(k,120) + b(k,122) = b(k,122) - lu(k,1243) * b(k,120) + b(k,123) = b(k,123) - lu(k,1244) * b(k,120) + b(k,124) = b(k,124) - lu(k,1245) * b(k,120) + b(k,125) = b(k,125) - lu(k,1246) * b(k,120) + b(k,126) = b(k,126) - lu(k,1247) * b(k,120) + b(k,127) = b(k,127) - lu(k,1248) * b(k,120) + b(k,128) = b(k,128) - lu(k,1249) * b(k,120) + b(k,129) = b(k,129) - lu(k,1250) * b(k,120) + b(k,130) = b(k,130) - lu(k,1251) * b(k,120) + b(k,131) = b(k,131) - lu(k,1252) * b(k,120) + b(k,132) = b(k,132) - lu(k,1253) * b(k,120) + b(k,133) = b(k,133) - lu(k,1254) * b(k,120) + b(k,134) = b(k,134) - lu(k,1255) * b(k,120) + b(k,135) = b(k,135) - lu(k,1256) * b(k,120) + b(k,136) = b(k,136) - lu(k,1257) * b(k,120) + b(k,137) = b(k,137) - lu(k,1258) * b(k,120) + b(k,138) = b(k,138) - lu(k,1259) * b(k,120) + b(k,139) = b(k,139) - lu(k,1260) * b(k,120) + b(k,122) = b(k,122) - lu(k,1285) * b(k,121) + b(k,123) = b(k,123) - lu(k,1286) * b(k,121) + b(k,124) = b(k,124) - lu(k,1287) * b(k,121) + b(k,125) = b(k,125) - lu(k,1288) * b(k,121) + b(k,126) = b(k,126) - lu(k,1289) * b(k,121) + b(k,127) = b(k,127) - lu(k,1290) * b(k,121) + b(k,128) = b(k,128) - lu(k,1291) * b(k,121) + b(k,129) = b(k,129) - lu(k,1292) * b(k,121) + b(k,130) = b(k,130) - lu(k,1293) * b(k,121) + b(k,131) = b(k,131) - lu(k,1294) * b(k,121) + b(k,132) = b(k,132) - lu(k,1295) * b(k,121) + b(k,133) = b(k,133) - lu(k,1296) * b(k,121) + b(k,134) = b(k,134) - lu(k,1297) * b(k,121) + b(k,135) = b(k,135) - lu(k,1298) * b(k,121) + b(k,136) = b(k,136) - lu(k,1299) * b(k,121) + b(k,137) = b(k,137) - lu(k,1300) * b(k,121) + b(k,138) = b(k,138) - lu(k,1301) * b(k,121) + b(k,139) = b(k,139) - lu(k,1302) * b(k,121) + b(k,123) = b(k,123) - lu(k,1328) * b(k,122) + b(k,124) = b(k,124) - lu(k,1329) * b(k,122) + b(k,125) = b(k,125) - lu(k,1330) * b(k,122) + b(k,126) = b(k,126) - lu(k,1331) * b(k,122) + b(k,127) = b(k,127) - lu(k,1332) * b(k,122) + b(k,128) = b(k,128) - lu(k,1333) * b(k,122) + b(k,129) = b(k,129) - lu(k,1334) * b(k,122) + b(k,130) = b(k,130) - lu(k,1335) * b(k,122) + b(k,131) = b(k,131) - lu(k,1336) * b(k,122) + b(k,132) = b(k,132) - lu(k,1337) * b(k,122) + b(k,133) = b(k,133) - lu(k,1338) * b(k,122) + b(k,134) = b(k,134) - lu(k,1339) * b(k,122) + b(k,135) = b(k,135) - lu(k,1340) * b(k,122) + b(k,136) = b(k,136) - lu(k,1341) * b(k,122) + b(k,137) = b(k,137) - lu(k,1342) * b(k,122) + b(k,138) = b(k,138) - lu(k,1343) * b(k,122) + b(k,139) = b(k,139) - lu(k,1344) * b(k,122) + b(k,124) = b(k,124) - lu(k,1389) * b(k,123) + b(k,125) = b(k,125) - lu(k,1390) * b(k,123) + b(k,126) = b(k,126) - lu(k,1391) * b(k,123) + b(k,127) = b(k,127) - lu(k,1392) * b(k,123) + b(k,128) = b(k,128) - lu(k,1393) * b(k,123) + b(k,129) = b(k,129) - lu(k,1394) * b(k,123) + b(k,130) = b(k,130) - lu(k,1395) * b(k,123) + b(k,131) = b(k,131) - lu(k,1396) * b(k,123) + b(k,132) = b(k,132) - lu(k,1397) * b(k,123) + b(k,133) = b(k,133) - lu(k,1398) * b(k,123) + b(k,134) = b(k,134) - lu(k,1399) * b(k,123) + b(k,135) = b(k,135) - lu(k,1400) * b(k,123) + b(k,136) = b(k,136) - lu(k,1401) * b(k,123) + b(k,137) = b(k,137) - lu(k,1402) * b(k,123) + b(k,138) = b(k,138) - lu(k,1403) * b(k,123) + b(k,139) = b(k,139) - lu(k,1404) * b(k,123) + b(k,125) = b(k,125) - lu(k,1439) * b(k,124) + b(k,126) = b(k,126) - lu(k,1440) * b(k,124) + b(k,127) = b(k,127) - lu(k,1441) * b(k,124) + b(k,128) = b(k,128) - lu(k,1442) * b(k,124) + b(k,129) = b(k,129) - lu(k,1443) * b(k,124) + b(k,130) = b(k,130) - lu(k,1444) * b(k,124) + b(k,131) = b(k,131) - lu(k,1445) * b(k,124) + b(k,132) = b(k,132) - lu(k,1446) * b(k,124) + b(k,133) = b(k,133) - lu(k,1447) * b(k,124) + b(k,134) = b(k,134) - lu(k,1448) * b(k,124) + b(k,135) = b(k,135) - lu(k,1449) * b(k,124) + b(k,136) = b(k,136) - lu(k,1450) * b(k,124) + b(k,137) = b(k,137) - lu(k,1451) * b(k,124) + b(k,138) = b(k,138) - lu(k,1452) * b(k,124) + b(k,139) = b(k,139) - lu(k,1453) * b(k,124) + b(k,126) = b(k,126) - lu(k,1488) * b(k,125) + b(k,127) = b(k,127) - lu(k,1489) * b(k,125) + b(k,128) = b(k,128) - lu(k,1490) * b(k,125) + b(k,129) = b(k,129) - lu(k,1491) * b(k,125) + b(k,130) = b(k,130) - lu(k,1492) * b(k,125) + b(k,131) = b(k,131) - lu(k,1493) * b(k,125) + b(k,132) = b(k,132) - lu(k,1494) * b(k,125) + b(k,133) = b(k,133) - lu(k,1495) * b(k,125) + b(k,134) = b(k,134) - lu(k,1496) * b(k,125) + b(k,135) = b(k,135) - lu(k,1497) * b(k,125) + b(k,136) = b(k,136) - lu(k,1498) * b(k,125) + b(k,137) = b(k,137) - lu(k,1499) * b(k,125) + b(k,138) = b(k,138) - lu(k,1500) * b(k,125) + b(k,139) = b(k,139) - lu(k,1501) * b(k,125) + b(k,127) = b(k,127) - lu(k,1530) * b(k,126) + b(k,128) = b(k,128) - lu(k,1531) * b(k,126) + b(k,129) = b(k,129) - lu(k,1532) * b(k,126) + b(k,130) = b(k,130) - lu(k,1533) * b(k,126) + b(k,131) = b(k,131) - lu(k,1534) * b(k,126) + b(k,132) = b(k,132) - lu(k,1535) * b(k,126) + b(k,133) = b(k,133) - lu(k,1536) * b(k,126) + b(k,134) = b(k,134) - lu(k,1537) * b(k,126) + b(k,135) = b(k,135) - lu(k,1538) * b(k,126) + b(k,136) = b(k,136) - lu(k,1539) * b(k,126) + b(k,137) = b(k,137) - lu(k,1540) * b(k,126) + b(k,138) = b(k,138) - lu(k,1541) * b(k,126) + b(k,139) = b(k,139) - lu(k,1542) * b(k,126) + b(k,128) = b(k,128) - lu(k,1567) * b(k,127) + b(k,129) = b(k,129) - lu(k,1568) * b(k,127) + b(k,130) = b(k,130) - lu(k,1569) * b(k,127) + b(k,131) = b(k,131) - lu(k,1570) * b(k,127) + b(k,132) = b(k,132) - lu(k,1571) * b(k,127) + b(k,133) = b(k,133) - lu(k,1572) * b(k,127) + b(k,134) = b(k,134) - lu(k,1573) * b(k,127) + b(k,135) = b(k,135) - lu(k,1574) * b(k,127) + b(k,136) = b(k,136) - lu(k,1575) * b(k,127) + b(k,137) = b(k,137) - lu(k,1576) * b(k,127) + b(k,138) = b(k,138) - lu(k,1577) * b(k,127) + b(k,139) = b(k,139) - lu(k,1578) * b(k,127) + b(k,129) = b(k,129) - lu(k,1613) * b(k,128) + b(k,130) = b(k,130) - lu(k,1614) * b(k,128) + b(k,131) = b(k,131) - lu(k,1615) * b(k,128) + b(k,132) = b(k,132) - lu(k,1616) * b(k,128) + b(k,133) = b(k,133) - lu(k,1617) * b(k,128) + b(k,134) = b(k,134) - lu(k,1618) * b(k,128) + b(k,135) = b(k,135) - lu(k,1619) * b(k,128) + b(k,136) = b(k,136) - lu(k,1620) * b(k,128) + b(k,137) = b(k,137) - lu(k,1621) * b(k,128) + b(k,138) = b(k,138) - lu(k,1622) * b(k,128) + b(k,139) = b(k,139) - lu(k,1623) * b(k,128) + b(k,130) = b(k,130) - lu(k,1657) * b(k,129) + b(k,131) = b(k,131) - lu(k,1658) * b(k,129) + b(k,132) = b(k,132) - lu(k,1659) * b(k,129) + b(k,133) = b(k,133) - lu(k,1660) * b(k,129) + b(k,134) = b(k,134) - lu(k,1661) * b(k,129) + b(k,135) = b(k,135) - lu(k,1662) * b(k,129) + b(k,136) = b(k,136) - lu(k,1663) * b(k,129) + b(k,137) = b(k,137) - lu(k,1664) * b(k,129) + b(k,138) = b(k,138) - lu(k,1665) * b(k,129) + b(k,139) = b(k,139) - lu(k,1666) * b(k,129) + b(k,131) = b(k,131) - lu(k,1701) * b(k,130) + b(k,132) = b(k,132) - lu(k,1702) * b(k,130) + b(k,133) = b(k,133) - lu(k,1703) * b(k,130) + b(k,134) = b(k,134) - lu(k,1704) * b(k,130) + b(k,135) = b(k,135) - lu(k,1705) * b(k,130) + b(k,136) = b(k,136) - lu(k,1706) * b(k,130) + b(k,137) = b(k,137) - lu(k,1707) * b(k,130) + b(k,138) = b(k,138) - lu(k,1708) * b(k,130) + b(k,139) = b(k,139) - lu(k,1709) * b(k,130) + b(k,132) = b(k,132) - lu(k,1742) * b(k,131) + b(k,133) = b(k,133) - lu(k,1743) * b(k,131) + b(k,134) = b(k,134) - lu(k,1744) * b(k,131) + b(k,135) = b(k,135) - lu(k,1745) * b(k,131) + b(k,136) = b(k,136) - lu(k,1746) * b(k,131) + b(k,137) = b(k,137) - lu(k,1747) * b(k,131) + b(k,138) = b(k,138) - lu(k,1748) * b(k,131) + b(k,139) = b(k,139) - lu(k,1749) * b(k,131) + b(k,133) = b(k,133) - lu(k,1779) * b(k,132) + b(k,134) = b(k,134) - lu(k,1780) * b(k,132) + b(k,135) = b(k,135) - lu(k,1781) * b(k,132) + b(k,136) = b(k,136) - lu(k,1782) * b(k,132) + b(k,137) = b(k,137) - lu(k,1783) * b(k,132) + b(k,138) = b(k,138) - lu(k,1784) * b(k,132) + b(k,139) = b(k,139) - lu(k,1785) * b(k,132) + b(k,134) = b(k,134) - lu(k,1828) * b(k,133) + b(k,135) = b(k,135) - lu(k,1829) * b(k,133) + b(k,136) = b(k,136) - lu(k,1830) * b(k,133) + b(k,137) = b(k,137) - lu(k,1831) * b(k,133) + b(k,138) = b(k,138) - lu(k,1832) * b(k,133) + b(k,139) = b(k,139) - lu(k,1833) * b(k,133) + b(k,135) = b(k,135) - lu(k,1862) * b(k,134) + b(k,136) = b(k,136) - lu(k,1863) * b(k,134) + b(k,137) = b(k,137) - lu(k,1864) * b(k,134) + b(k,138) = b(k,138) - lu(k,1865) * b(k,134) + b(k,139) = b(k,139) - lu(k,1866) * b(k,134) + b(k,136) = b(k,136) - lu(k,1899) * b(k,135) + b(k,137) = b(k,137) - lu(k,1900) * b(k,135) + b(k,138) = b(k,138) - lu(k,1901) * b(k,135) + b(k,139) = b(k,139) - lu(k,1902) * 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,137) = b(k,137) - lu(k,1941) * b(k,136) + b(k,138) = b(k,138) - lu(k,1942) * b(k,136) + b(k,139) = b(k,139) - lu(k,1943) * b(k,136) + b(k,138) = b(k,138) - lu(k,1984) * b(k,137) + b(k,139) = b(k,139) - lu(k,1985) * b(k,137) + b(k,139) = b(k,139) - lu(k,2030) * b(k,138) + 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 +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,139) = b(k,139) * lu(k,2090) + b(k,138) = b(k,138) - lu(k,2089) * b(k,139) + b(k,137) = b(k,137) - lu(k,2088) * b(k,139) + b(k,136) = b(k,136) - lu(k,2087) * b(k,139) + b(k,135) = b(k,135) - lu(k,2086) * b(k,139) + b(k,134) = b(k,134) - lu(k,2085) * b(k,139) + b(k,133) = b(k,133) - lu(k,2084) * b(k,139) + b(k,132) = b(k,132) - lu(k,2083) * b(k,139) + b(k,131) = b(k,131) - lu(k,2082) * b(k,139) + b(k,130) = b(k,130) - lu(k,2081) * b(k,139) + b(k,129) = b(k,129) - lu(k,2080) * b(k,139) + b(k,128) = b(k,128) - lu(k,2079) * b(k,139) + b(k,127) = b(k,127) - lu(k,2078) * b(k,139) + b(k,126) = b(k,126) - lu(k,2077) * b(k,139) + b(k,125) = b(k,125) - lu(k,2076) * b(k,139) + b(k,124) = b(k,124) - lu(k,2075) * b(k,139) + b(k,123) = b(k,123) - lu(k,2074) * b(k,139) + b(k,122) = b(k,122) - lu(k,2073) * b(k,139) + b(k,121) = b(k,121) - lu(k,2072) * b(k,139) + b(k,120) = b(k,120) - lu(k,2071) * b(k,139) + b(k,119) = b(k,119) - lu(k,2070) * b(k,139) + b(k,118) = b(k,118) - lu(k,2069) * b(k,139) + b(k,117) = b(k,117) - lu(k,2068) * b(k,139) + b(k,116) = b(k,116) - lu(k,2067) * b(k,139) + b(k,115) = b(k,115) - lu(k,2066) * b(k,139) + b(k,114) = b(k,114) - lu(k,2065) * b(k,139) + b(k,113) = b(k,113) - lu(k,2064) * b(k,139) + b(k,112) = b(k,112) - lu(k,2063) * b(k,139) + b(k,111) = b(k,111) - lu(k,2062) * b(k,139) + b(k,109) = b(k,109) - lu(k,2061) * b(k,139) + b(k,108) = b(k,108) - lu(k,2060) * b(k,139) + b(k,107) = b(k,107) - lu(k,2059) * b(k,139) + b(k,106) = b(k,106) - lu(k,2058) * b(k,139) + b(k,105) = b(k,105) - lu(k,2057) * b(k,139) + b(k,104) = b(k,104) - lu(k,2056) * b(k,139) + b(k,103) = b(k,103) - lu(k,2055) * b(k,139) + b(k,102) = b(k,102) - lu(k,2054) * b(k,139) + b(k,99) = b(k,99) - lu(k,2053) * b(k,139) + b(k,97) = b(k,97) - lu(k,2052) * b(k,139) + b(k,96) = b(k,96) - lu(k,2051) * b(k,139) + b(k,94) = b(k,94) - lu(k,2050) * b(k,139) + b(k,92) = b(k,92) - lu(k,2049) * b(k,139) + b(k,91) = b(k,91) - lu(k,2048) * b(k,139) + b(k,89) = b(k,89) - lu(k,2047) * b(k,139) + b(k,88) = b(k,88) - lu(k,2046) * b(k,139) + b(k,82) = b(k,82) - lu(k,2045) * b(k,139) + b(k,81) = b(k,81) - lu(k,2044) * b(k,139) + b(k,75) = b(k,75) - lu(k,2043) * b(k,139) + b(k,74) = b(k,74) - lu(k,2042) * b(k,139) + b(k,73) = b(k,73) - lu(k,2041) * b(k,139) + b(k,71) = b(k,71) - lu(k,2040) * b(k,139) + b(k,70) = b(k,70) - lu(k,2039) * b(k,139) + b(k,68) = b(k,68) - lu(k,2038) * b(k,139) + b(k,58) = b(k,58) - lu(k,2037) * b(k,139) + b(k,57) = b(k,57) - lu(k,2036) * b(k,139) + b(k,49) = b(k,49) - lu(k,2035) * b(k,139) + b(k,47) = b(k,47) - lu(k,2034) * b(k,139) + b(k,46) = b(k,46) - lu(k,2033) * b(k,139) + b(k,45) = b(k,45) - lu(k,2032) * b(k,139) + b(k,33) = b(k,33) - lu(k,2031) * b(k,139) + b(k,138) = b(k,138) * lu(k,2029) + b(k,137) = b(k,137) - lu(k,2028) * b(k,138) + b(k,136) = b(k,136) - lu(k,2027) * b(k,138) + b(k,135) = b(k,135) - lu(k,2026) * b(k,138) + b(k,134) = b(k,134) - lu(k,2025) * b(k,138) + b(k,133) = b(k,133) - lu(k,2024) * b(k,138) + b(k,132) = b(k,132) - lu(k,2023) * b(k,138) + b(k,131) = b(k,131) - lu(k,2022) * b(k,138) + b(k,130) = b(k,130) - lu(k,2021) * b(k,138) + b(k,129) = b(k,129) - lu(k,2020) * b(k,138) + b(k,128) = b(k,128) - lu(k,2019) * b(k,138) + b(k,127) = b(k,127) - lu(k,2018) * b(k,138) + b(k,126) = b(k,126) - lu(k,2017) * b(k,138) + b(k,125) = b(k,125) - lu(k,2016) * b(k,138) + b(k,124) = b(k,124) - lu(k,2015) * b(k,138) + b(k,123) = b(k,123) - lu(k,2014) * b(k,138) + b(k,122) = b(k,122) - lu(k,2013) * b(k,138) + b(k,121) = b(k,121) - lu(k,2012) * b(k,138) + b(k,120) = b(k,120) - lu(k,2011) * b(k,138) + b(k,119) = b(k,119) - lu(k,2010) * b(k,138) + b(k,118) = b(k,118) - lu(k,2009) * b(k,138) + b(k,117) = b(k,117) - lu(k,2008) * b(k,138) + b(k,116) = b(k,116) - lu(k,2007) * b(k,138) + b(k,115) = b(k,115) - lu(k,2006) * b(k,138) + b(k,114) = b(k,114) - lu(k,2005) * b(k,138) + b(k,113) = b(k,113) - lu(k,2004) * b(k,138) + b(k,112) = b(k,112) - lu(k,2003) * b(k,138) + b(k,111) = b(k,111) - lu(k,2002) * b(k,138) + b(k,110) = b(k,110) - lu(k,2001) * b(k,138) + b(k,109) = b(k,109) - lu(k,2000) * b(k,138) + b(k,108) = b(k,108) - lu(k,1999) * b(k,138) + b(k,107) = b(k,107) - lu(k,1998) * b(k,138) + b(k,106) = b(k,106) - lu(k,1997) * b(k,138) + b(k,101) = b(k,101) - lu(k,1996) * b(k,138) + b(k,99) = b(k,99) - lu(k,1995) * b(k,138) + b(k,98) = b(k,98) - lu(k,1994) * b(k,138) + b(k,96) = b(k,96) - lu(k,1993) * b(k,138) + b(k,95) = b(k,95) - lu(k,1992) * b(k,138) + b(k,83) = b(k,83) - lu(k,1991) * b(k,138) + b(k,80) = b(k,80) - lu(k,1990) * b(k,138) + b(k,77) = b(k,77) - lu(k,1989) * b(k,138) + b(k,73) = b(k,73) - lu(k,1988) * b(k,138) + b(k,43) = b(k,43) - lu(k,1987) * b(k,138) + b(k,38) = b(k,38) - lu(k,1986) * b(k,138) + b(k,137) = b(k,137) * lu(k,1983) + b(k,136) = b(k,136) - lu(k,1982) * b(k,137) + b(k,135) = b(k,135) - lu(k,1981) * b(k,137) + b(k,134) = b(k,134) - lu(k,1980) * b(k,137) + b(k,133) = b(k,133) - lu(k,1979) * b(k,137) + b(k,132) = b(k,132) - lu(k,1978) * b(k,137) + b(k,131) = b(k,131) - lu(k,1977) * b(k,137) + b(k,130) = b(k,130) - lu(k,1976) * b(k,137) + b(k,129) = b(k,129) - lu(k,1975) * b(k,137) + b(k,128) = b(k,128) - lu(k,1974) * b(k,137) + b(k,127) = b(k,127) - lu(k,1973) * b(k,137) + b(k,126) = b(k,126) - lu(k,1972) * b(k,137) + b(k,125) = b(k,125) - lu(k,1971) * b(k,137) + b(k,124) = b(k,124) - lu(k,1970) * b(k,137) + b(k,123) = b(k,123) - lu(k,1969) * b(k,137) + b(k,122) = b(k,122) - lu(k,1968) * b(k,137) + b(k,121) = b(k,121) - lu(k,1967) * b(k,137) + b(k,120) = b(k,120) - lu(k,1966) * b(k,137) + b(k,119) = b(k,119) - lu(k,1965) * b(k,137) + b(k,118) = b(k,118) - lu(k,1964) * b(k,137) + b(k,117) = b(k,117) - lu(k,1963) * b(k,137) + b(k,116) = b(k,116) - lu(k,1962) * b(k,137) + b(k,115) = b(k,115) - lu(k,1961) * b(k,137) + b(k,114) = b(k,114) - lu(k,1960) * b(k,137) + b(k,113) = b(k,113) - lu(k,1959) * b(k,137) + b(k,112) = b(k,112) - lu(k,1958) * b(k,137) + b(k,111) = b(k,111) - lu(k,1957) * b(k,137) + b(k,109) = b(k,109) - lu(k,1956) * b(k,137) + b(k,108) = b(k,108) - lu(k,1955) * b(k,137) + b(k,107) = b(k,107) - lu(k,1954) * b(k,137) + b(k,106) = b(k,106) - lu(k,1953) * b(k,137) + b(k,105) = b(k,105) - lu(k,1952) * b(k,137) + b(k,104) = b(k,104) - lu(k,1951) * b(k,137) + b(k,100) = b(k,100) - lu(k,1950) * b(k,137) + b(k,99) = b(k,99) - lu(k,1949) * b(k,137) + b(k,97) = b(k,97) - lu(k,1948) * b(k,137) + b(k,90) = b(k,90) - lu(k,1947) * b(k,137) + b(k,89) = b(k,89) - lu(k,1946) * b(k,137) + b(k,84) = b(k,84) - lu(k,1945) * b(k,137) + b(k,73) = b(k,73) - lu(k,1944) * b(k,137) + b(k,136) = b(k,136) * lu(k,1940) + b(k,135) = b(k,135) - lu(k,1939) * b(k,136) + b(k,134) = b(k,134) - lu(k,1938) * b(k,136) + b(k,133) = b(k,133) - lu(k,1937) * b(k,136) + b(k,132) = b(k,132) - lu(k,1936) * b(k,136) + b(k,131) = b(k,131) - lu(k,1935) * b(k,136) + b(k,130) = b(k,130) - lu(k,1934) * b(k,136) + b(k,129) = b(k,129) - lu(k,1933) * b(k,136) + b(k,128) = b(k,128) - lu(k,1932) * b(k,136) + b(k,127) = b(k,127) - lu(k,1931) * b(k,136) + b(k,126) = b(k,126) - lu(k,1930) * b(k,136) + b(k,125) = b(k,125) - lu(k,1929) * b(k,136) + b(k,124) = b(k,124) - lu(k,1928) * b(k,136) + b(k,123) = b(k,123) - lu(k,1927) * b(k,136) + b(k,122) = b(k,122) - lu(k,1926) * b(k,136) + b(k,121) = b(k,121) - lu(k,1925) * b(k,136) + b(k,120) = b(k,120) - lu(k,1924) * b(k,136) + b(k,119) = b(k,119) - lu(k,1923) * b(k,136) + b(k,118) = b(k,118) - lu(k,1922) * b(k,136) + b(k,117) = b(k,117) - lu(k,1921) * b(k,136) + b(k,116) = b(k,116) - lu(k,1920) * b(k,136) + b(k,115) = b(k,115) - lu(k,1919) * b(k,136) + b(k,114) = b(k,114) - lu(k,1918) * b(k,136) + b(k,113) = b(k,113) - lu(k,1917) * b(k,136) + b(k,112) = b(k,112) - lu(k,1916) * b(k,136) + b(k,111) = b(k,111) - lu(k,1915) * b(k,136) + b(k,110) = b(k,110) - lu(k,1914) * b(k,136) + b(k,108) = b(k,108) - lu(k,1913) * b(k,136) + b(k,107) = b(k,107) - lu(k,1912) * b(k,136) + b(k,106) = b(k,106) - lu(k,1911) * b(k,136) + b(k,100) = b(k,100) - lu(k,1910) * b(k,136) + b(k,99) = b(k,99) - lu(k,1909) * b(k,136) + b(k,92) = b(k,92) - lu(k,1908) * b(k,136) + b(k,91) = b(k,91) - lu(k,1907) * b(k,136) + b(k,85) = b(k,85) - lu(k,1906) * b(k,136) + b(k,82) = b(k,82) - lu(k,1905) * b(k,136) + b(k,72) = b(k,72) - lu(k,1904) * b(k,136) + b(k,51) = b(k,51) - lu(k,1903) * b(k,136) + b(k,135) = b(k,135) * lu(k,1898) + b(k,134) = b(k,134) - lu(k,1897) * b(k,135) + b(k,133) = b(k,133) - lu(k,1896) * b(k,135) + b(k,132) = b(k,132) - lu(k,1895) * b(k,135) + b(k,131) = b(k,131) - lu(k,1894) * b(k,135) + b(k,130) = b(k,130) - lu(k,1893) * b(k,135) + b(k,129) = b(k,129) - lu(k,1892) * b(k,135) + b(k,128) = b(k,128) - lu(k,1891) * b(k,135) + b(k,127) = b(k,127) - lu(k,1890) * b(k,135) + b(k,126) = b(k,126) - lu(k,1889) * b(k,135) + b(k,125) = b(k,125) - lu(k,1888) * b(k,135) + b(k,124) = b(k,124) - lu(k,1887) * b(k,135) + b(k,123) = b(k,123) - lu(k,1886) * b(k,135) + b(k,122) = b(k,122) - lu(k,1885) * b(k,135) + b(k,121) = b(k,121) - lu(k,1884) * b(k,135) + b(k,120) = b(k,120) - lu(k,1883) * b(k,135) + b(k,119) = b(k,119) - lu(k,1882) * b(k,135) + b(k,118) = b(k,118) - lu(k,1881) * b(k,135) + b(k,117) = b(k,117) - lu(k,1880) * b(k,135) + b(k,116) = b(k,116) - lu(k,1879) * b(k,135) + b(k,115) = b(k,115) - lu(k,1878) * b(k,135) + b(k,114) = b(k,114) - lu(k,1877) * b(k,135) + b(k,113) = b(k,113) - lu(k,1876) * b(k,135) + b(k,112) = b(k,112) - lu(k,1875) * b(k,135) + b(k,111) = b(k,111) - lu(k,1874) * b(k,135) + b(k,109) = b(k,109) - lu(k,1873) * b(k,135) + b(k,108) = b(k,108) - lu(k,1872) * b(k,135) + b(k,107) = b(k,107) - lu(k,1871) * b(k,135) + b(k,103) = b(k,103) - lu(k,1870) * b(k,135) + b(k,100) = b(k,100) - lu(k,1869) * b(k,135) + b(k,91) = b(k,91) - lu(k,1868) * b(k,135) + b(k,85) = b(k,85) - lu(k,1867) * b(k,135) + 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,134) = b(k,134) * lu(k,1861) + b(k,133) = b(k,133) - lu(k,1860) * b(k,134) + b(k,132) = b(k,132) - lu(k,1859) * b(k,134) + b(k,131) = b(k,131) - lu(k,1858) * b(k,134) + b(k,130) = b(k,130) - lu(k,1857) * b(k,134) + b(k,129) = b(k,129) - lu(k,1856) * b(k,134) + b(k,128) = b(k,128) - lu(k,1855) * b(k,134) + b(k,127) = b(k,127) - lu(k,1854) * b(k,134) + b(k,126) = b(k,126) - lu(k,1853) * b(k,134) + b(k,125) = b(k,125) - lu(k,1852) * b(k,134) + b(k,124) = b(k,124) - lu(k,1851) * b(k,134) + b(k,123) = b(k,123) - lu(k,1850) * b(k,134) + b(k,122) = b(k,122) - lu(k,1849) * b(k,134) + b(k,121) = b(k,121) - lu(k,1848) * b(k,134) + b(k,120) = b(k,120) - lu(k,1847) * b(k,134) + b(k,119) = b(k,119) - lu(k,1846) * b(k,134) + b(k,118) = b(k,118) - lu(k,1845) * b(k,134) + b(k,117) = b(k,117) - lu(k,1844) * b(k,134) + b(k,116) = b(k,116) - lu(k,1843) * b(k,134) + b(k,115) = b(k,115) - lu(k,1842) * b(k,134) + b(k,114) = b(k,114) - lu(k,1841) * b(k,134) + b(k,113) = b(k,113) - lu(k,1840) * b(k,134) + b(k,112) = b(k,112) - lu(k,1839) * b(k,134) + b(k,111) = b(k,111) - lu(k,1838) * b(k,134) + b(k,109) = b(k,109) - lu(k,1837) * b(k,134) + b(k,100) = b(k,100) - lu(k,1836) * b(k,134) + b(k,93) = b(k,93) - lu(k,1835) * b(k,134) + b(k,84) = b(k,84) - lu(k,1834) * b(k,134) + b(k,133) = b(k,133) * lu(k,1827) + b(k,132) = b(k,132) - lu(k,1826) * b(k,133) + b(k,131) = b(k,131) - lu(k,1825) * b(k,133) + b(k,130) = b(k,130) - lu(k,1824) * b(k,133) + b(k,129) = b(k,129) - lu(k,1823) * b(k,133) + b(k,128) = b(k,128) - lu(k,1822) * b(k,133) + b(k,127) = b(k,127) - lu(k,1821) * b(k,133) + b(k,126) = b(k,126) - lu(k,1820) * b(k,133) + b(k,125) = b(k,125) - lu(k,1819) * b(k,133) + b(k,124) = b(k,124) - lu(k,1818) * b(k,133) + b(k,123) = b(k,123) - lu(k,1817) * b(k,133) + b(k,122) = b(k,122) - lu(k,1816) * b(k,133) + b(k,121) = b(k,121) - lu(k,1815) * b(k,133) + b(k,120) = b(k,120) - lu(k,1814) * b(k,133) + b(k,119) = b(k,119) - lu(k,1813) * b(k,133) + b(k,118) = b(k,118) - lu(k,1812) * b(k,133) + b(k,117) = b(k,117) - lu(k,1811) * b(k,133) + b(k,116) = b(k,116) - lu(k,1810) * b(k,133) + b(k,115) = b(k,115) - lu(k,1809) * b(k,133) + b(k,114) = b(k,114) - lu(k,1808) * b(k,133) + b(k,113) = b(k,113) - lu(k,1807) * b(k,133) + b(k,112) = b(k,112) - lu(k,1806) * b(k,133) + b(k,111) = b(k,111) - lu(k,1805) * b(k,133) + b(k,109) = b(k,109) - lu(k,1804) * b(k,133) + b(k,108) = b(k,108) - lu(k,1803) * b(k,133) + b(k,107) = b(k,107) - lu(k,1802) * b(k,133) + b(k,106) = b(k,106) - lu(k,1801) * b(k,133) + b(k,105) = b(k,105) - lu(k,1800) * b(k,133) + b(k,104) = b(k,104) - lu(k,1799) * b(k,133) + b(k,102) = b(k,102) - lu(k,1798) * b(k,133) + b(k,101) = b(k,101) - lu(k,1797) * b(k,133) + b(k,100) = b(k,100) - lu(k,1796) * b(k,133) + b(k,99) = b(k,99) - lu(k,1795) * b(k,133) + b(k,92) = b(k,92) - lu(k,1794) * b(k,133) + b(k,90) = b(k,90) - lu(k,1793) * b(k,133) + b(k,87) = b(k,87) - lu(k,1792) * b(k,133) + b(k,83) = b(k,83) - lu(k,1791) * b(k,133) + b(k,82) = b(k,82) - lu(k,1790) * b(k,133) + b(k,77) = b(k,77) - lu(k,1789) * b(k,133) + b(k,63) = b(k,63) - lu(k,1788) * b(k,133) + b(k,59) = b(k,59) - lu(k,1787) * b(k,133) + b(k,44) = b(k,44) - lu(k,1786) * b(k,133) + b(k,132) = b(k,132) * lu(k,1778) + b(k,131) = b(k,131) - lu(k,1777) * b(k,132) + b(k,130) = b(k,130) - lu(k,1776) * b(k,132) + b(k,129) = b(k,129) - lu(k,1775) * b(k,132) + b(k,128) = b(k,128) - lu(k,1774) * b(k,132) + b(k,127) = b(k,127) - lu(k,1773) * b(k,132) + b(k,126) = b(k,126) - lu(k,1772) * b(k,132) + b(k,125) = b(k,125) - lu(k,1771) * b(k,132) + b(k,124) = b(k,124) - lu(k,1770) * b(k,132) + b(k,123) = b(k,123) - lu(k,1769) * b(k,132) + b(k,122) = b(k,122) - lu(k,1768) * b(k,132) + b(k,121) = b(k,121) - lu(k,1767) * b(k,132) + b(k,120) = b(k,120) - lu(k,1766) * b(k,132) + b(k,119) = b(k,119) - lu(k,1765) * b(k,132) + b(k,118) = b(k,118) - lu(k,1764) * b(k,132) + b(k,117) = b(k,117) - lu(k,1763) * b(k,132) + b(k,116) = b(k,116) - lu(k,1762) * b(k,132) + b(k,115) = b(k,115) - lu(k,1761) * b(k,132) + b(k,114) = b(k,114) - lu(k,1760) * b(k,132) + b(k,113) = b(k,113) - lu(k,1759) * b(k,132) + b(k,112) = b(k,112) - lu(k,1758) * b(k,132) + b(k,111) = b(k,111) - lu(k,1757) * b(k,132) + b(k,110) = b(k,110) - lu(k,1756) * b(k,132) + b(k,109) = b(k,109) - lu(k,1755) * b(k,132) + b(k,108) = b(k,108) - lu(k,1754) * b(k,132) + b(k,107) = b(k,107) - lu(k,1753) * b(k,132) + b(k,103) = b(k,103) - lu(k,1752) * b(k,132) + b(k,100) = b(k,100) - lu(k,1751) * b(k,132) + b(k,74) = b(k,74) - lu(k,1750) * b(k,132) + b(k,131) = b(k,131) * lu(k,1741) + b(k,130) = b(k,130) - lu(k,1740) * b(k,131) + b(k,129) = b(k,129) - lu(k,1739) * b(k,131) + b(k,128) = b(k,128) - lu(k,1738) * b(k,131) + b(k,127) = b(k,127) - lu(k,1737) * b(k,131) + b(k,126) = b(k,126) - lu(k,1736) * b(k,131) + b(k,125) = b(k,125) - lu(k,1735) * b(k,131) + b(k,124) = b(k,124) - lu(k,1734) * b(k,131) + b(k,123) = b(k,123) - lu(k,1733) * b(k,131) + b(k,122) = b(k,122) - lu(k,1732) * b(k,131) + b(k,121) = b(k,121) - lu(k,1731) * b(k,131) + b(k,120) = b(k,120) - lu(k,1730) * b(k,131) + b(k,119) = b(k,119) - lu(k,1729) * b(k,131) + b(k,118) = b(k,118) - lu(k,1728) * b(k,131) + b(k,117) = b(k,117) - lu(k,1727) * b(k,131) + b(k,116) = b(k,116) - lu(k,1726) * b(k,131) + b(k,114) = b(k,114) - lu(k,1725) * b(k,131) + b(k,113) = b(k,113) - lu(k,1724) * b(k,131) + b(k,112) = b(k,112) - lu(k,1723) * b(k,131) + b(k,111) = b(k,111) - lu(k,1722) * b(k,131) + b(k,108) = b(k,108) - lu(k,1721) * b(k,131) + b(k,107) = b(k,107) - lu(k,1720) * b(k,131) + b(k,106) = b(k,106) - lu(k,1719) * b(k,131) + b(k,105) = b(k,105) - lu(k,1718) * b(k,131) + b(k,102) = b(k,102) - lu(k,1717) * b(k,131) + b(k,101) = b(k,101) - lu(k,1716) * b(k,131) + b(k,99) = b(k,99) - lu(k,1715) * b(k,131) + b(k,92) = b(k,92) - lu(k,1714) * b(k,131) + b(k,87) = b(k,87) - lu(k,1713) * b(k,131) + b(k,82) = b(k,82) - lu(k,1712) * b(k,131) + b(k,69) = b(k,69) - lu(k,1711) * b(k,131) + b(k,50) = b(k,50) - lu(k,1710) * b(k,131) + b(k,130) = b(k,130) * lu(k,1700) + b(k,129) = b(k,129) - lu(k,1699) * b(k,130) + b(k,128) = b(k,128) - lu(k,1698) * b(k,130) + b(k,127) = b(k,127) - lu(k,1697) * b(k,130) + b(k,126) = b(k,126) - lu(k,1696) * b(k,130) + b(k,125) = b(k,125) - lu(k,1695) * b(k,130) + b(k,124) = b(k,124) - lu(k,1694) * b(k,130) + b(k,123) = b(k,123) - lu(k,1693) * b(k,130) + b(k,122) = b(k,122) - lu(k,1692) * b(k,130) + b(k,121) = b(k,121) - lu(k,1691) * b(k,130) + b(k,120) = b(k,120) - lu(k,1690) * b(k,130) + b(k,119) = b(k,119) - lu(k,1689) * b(k,130) + b(k,118) = b(k,118) - lu(k,1688) * b(k,130) + b(k,117) = b(k,117) - lu(k,1687) * b(k,130) + b(k,116) = b(k,116) - lu(k,1686) * b(k,130) + b(k,115) = b(k,115) - lu(k,1685) * b(k,130) + b(k,114) = b(k,114) - lu(k,1684) * b(k,130) + b(k,113) = b(k,113) - lu(k,1683) * b(k,130) + b(k,112) = b(k,112) - lu(k,1682) * b(k,130) + b(k,111) = b(k,111) - lu(k,1681) * b(k,130) + b(k,110) = b(k,110) - lu(k,1680) * b(k,130) + b(k,109) = b(k,109) - lu(k,1679) * b(k,130) + b(k,105) = b(k,105) - lu(k,1678) * b(k,130) + b(k,104) = b(k,104) - lu(k,1677) * b(k,130) + b(k,102) = b(k,102) - lu(k,1676) * b(k,130) + b(k,101) = b(k,101) - lu(k,1675) * b(k,130) + b(k,98) = b(k,98) - lu(k,1674) * b(k,130) + b(k,97) = b(k,97) - lu(k,1673) * b(k,130) + b(k,96) = b(k,96) - lu(k,1672) * b(k,130) + b(k,95) = b(k,95) - lu(k,1671) * b(k,130) + b(k,94) = b(k,94) - lu(k,1670) * b(k,130) + b(k,93) = b(k,93) - lu(k,1669) * b(k,130) + b(k,87) = b(k,87) - lu(k,1668) * b(k,130) + b(k,46) = b(k,46) - lu(k,1667) * b(k,130) + b(k,129) = b(k,129) * lu(k,1656) + b(k,128) = b(k,128) - lu(k,1655) * b(k,129) + b(k,127) = b(k,127) - lu(k,1654) * b(k,129) + b(k,126) = b(k,126) - lu(k,1653) * b(k,129) + b(k,125) = b(k,125) - lu(k,1652) * b(k,129) + b(k,124) = b(k,124) - lu(k,1651) * b(k,129) + b(k,123) = b(k,123) - lu(k,1650) * b(k,129) + b(k,122) = b(k,122) - lu(k,1649) * b(k,129) + b(k,121) = b(k,121) - lu(k,1648) * b(k,129) + b(k,120) = b(k,120) - lu(k,1647) * b(k,129) + b(k,119) = b(k,119) - lu(k,1646) * b(k,129) + b(k,118) = b(k,118) - lu(k,1645) * b(k,129) + b(k,117) = b(k,117) - lu(k,1644) * b(k,129) + b(k,116) = b(k,116) - lu(k,1643) * b(k,129) + b(k,115) = b(k,115) - lu(k,1642) * b(k,129) + b(k,114) = b(k,114) - lu(k,1641) * b(k,129) + b(k,113) = b(k,113) - lu(k,1640) * b(k,129) + b(k,112) = b(k,112) - lu(k,1639) * b(k,129) + b(k,111) = b(k,111) - lu(k,1638) * b(k,129) + b(k,110) = b(k,110) - lu(k,1637) * b(k,129) + b(k,109) = b(k,109) - lu(k,1636) * b(k,129) + b(k,105) = b(k,105) - lu(k,1635) * b(k,129) + b(k,104) = b(k,104) - lu(k,1634) * b(k,129) + b(k,102) = b(k,102) - lu(k,1633) * b(k,129) + b(k,101) = b(k,101) - lu(k,1632) * b(k,129) + b(k,98) = b(k,98) - lu(k,1631) * b(k,129) + b(k,97) = b(k,97) - lu(k,1630) * b(k,129) + b(k,96) = b(k,96) - lu(k,1629) * b(k,129) + b(k,95) = b(k,95) - lu(k,1628) * b(k,129) + b(k,94) = b(k,94) - lu(k,1627) * b(k,129) + b(k,93) = b(k,93) - lu(k,1626) * b(k,129) + b(k,87) = b(k,87) - lu(k,1625) * b(k,129) + b(k,47) = b(k,47) - lu(k,1624) * b(k,129) + b(k,128) = b(k,128) * lu(k,1612) + b(k,127) = b(k,127) - lu(k,1611) * b(k,128) + b(k,126) = b(k,126) - lu(k,1610) * b(k,128) + b(k,125) = b(k,125) - lu(k,1609) * b(k,128) + b(k,124) = b(k,124) - lu(k,1608) * b(k,128) + b(k,123) = b(k,123) - lu(k,1607) * b(k,128) + b(k,122) = b(k,122) - lu(k,1606) * b(k,128) + b(k,121) = b(k,121) - lu(k,1605) * b(k,128) + b(k,120) = b(k,120) - lu(k,1604) * b(k,128) + b(k,119) = b(k,119) - lu(k,1603) * b(k,128) + b(k,118) = b(k,118) - lu(k,1602) * b(k,128) + b(k,117) = b(k,117) - lu(k,1601) * b(k,128) + b(k,116) = b(k,116) - lu(k,1600) * b(k,128) + b(k,115) = b(k,115) - lu(k,1599) * b(k,128) + b(k,114) = b(k,114) - lu(k,1598) * b(k,128) + b(k,113) = b(k,113) - lu(k,1597) * b(k,128) + b(k,112) = b(k,112) - lu(k,1596) * b(k,128) + b(k,111) = b(k,111) - lu(k,1595) * b(k,128) + b(k,110) = b(k,110) - lu(k,1594) * b(k,128) + b(k,109) = b(k,109) - lu(k,1593) * b(k,128) + b(k,108) = b(k,108) - lu(k,1592) * b(k,128) + b(k,105) = b(k,105) - lu(k,1591) * b(k,128) + b(k,104) = b(k,104) - lu(k,1590) * b(k,128) + b(k,102) = b(k,102) - lu(k,1589) * b(k,128) + b(k,101) = b(k,101) - lu(k,1588) * b(k,128) + b(k,98) = b(k,98) - lu(k,1587) * b(k,128) + b(k,97) = b(k,97) - lu(k,1586) * b(k,128) + b(k,96) = b(k,96) - lu(k,1585) * b(k,128) + b(k,95) = b(k,95) - lu(k,1584) * b(k,128) + b(k,94) = b(k,94) - lu(k,1583) * b(k,128) + b(k,93) = b(k,93) - lu(k,1582) * b(k,128) + b(k,91) = b(k,91) - lu(k,1581) * b(k,128) + b(k,90) = b(k,90) - lu(k,1580) * b(k,128) + b(k,75) = b(k,75) - lu(k,1579) * b(k,128) + end do + end subroutine lu_slv08 + subroutine lu_slv09( 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,1566) + b(k,126) = b(k,126) - lu(k,1565) * b(k,127) + b(k,125) = b(k,125) - lu(k,1564) * b(k,127) + b(k,124) = b(k,124) - lu(k,1563) * b(k,127) + b(k,123) = b(k,123) - lu(k,1562) * b(k,127) + b(k,122) = b(k,122) - lu(k,1561) * b(k,127) + b(k,121) = b(k,121) - lu(k,1560) * b(k,127) + b(k,120) = b(k,120) - lu(k,1559) * b(k,127) + b(k,119) = b(k,119) - lu(k,1558) * b(k,127) + b(k,118) = b(k,118) - lu(k,1557) * b(k,127) + b(k,117) = b(k,117) - lu(k,1556) * b(k,127) + b(k,116) = b(k,116) - lu(k,1555) * b(k,127) + b(k,115) = b(k,115) - lu(k,1554) * b(k,127) + b(k,114) = b(k,114) - lu(k,1553) * b(k,127) + b(k,113) = b(k,113) - lu(k,1552) * b(k,127) + b(k,112) = b(k,112) - lu(k,1551) * b(k,127) + b(k,111) = b(k,111) - lu(k,1550) * b(k,127) + b(k,110) = b(k,110) - lu(k,1549) * b(k,127) + b(k,109) = b(k,109) - lu(k,1548) * b(k,127) + b(k,100) = b(k,100) - lu(k,1547) * b(k,127) + b(k,91) = b(k,91) - lu(k,1546) * b(k,127) + b(k,85) = b(k,85) - lu(k,1545) * b(k,127) + b(k,84) = b(k,84) - lu(k,1544) * b(k,127) + b(k,67) = b(k,67) - lu(k,1543) * b(k,127) + b(k,126) = b(k,126) * lu(k,1529) + b(k,125) = b(k,125) - lu(k,1528) * b(k,126) + b(k,124) = b(k,124) - lu(k,1527) * b(k,126) + b(k,123) = b(k,123) - lu(k,1526) * b(k,126) + b(k,122) = b(k,122) - lu(k,1525) * b(k,126) + b(k,121) = b(k,121) - lu(k,1524) * b(k,126) + b(k,120) = b(k,120) - lu(k,1523) * b(k,126) + b(k,119) = b(k,119) - lu(k,1522) * b(k,126) + b(k,118) = b(k,118) - lu(k,1521) * b(k,126) + b(k,117) = b(k,117) - lu(k,1520) * b(k,126) + b(k,116) = b(k,116) - lu(k,1519) * b(k,126) + b(k,115) = b(k,115) - lu(k,1518) * b(k,126) + b(k,114) = b(k,114) - lu(k,1517) * b(k,126) + b(k,113) = b(k,113) - lu(k,1516) * b(k,126) + b(k,112) = b(k,112) - lu(k,1515) * b(k,126) + b(k,111) = b(k,111) - lu(k,1514) * b(k,126) + b(k,109) = b(k,109) - lu(k,1513) * b(k,126) + b(k,108) = b(k,108) - lu(k,1512) * b(k,126) + b(k,107) = b(k,107) - lu(k,1511) * b(k,126) + b(k,105) = b(k,105) - lu(k,1510) * b(k,126) + b(k,103) = b(k,103) - lu(k,1509) * b(k,126) + b(k,101) = b(k,101) - lu(k,1508) * b(k,126) + b(k,98) = b(k,98) - lu(k,1507) * b(k,126) + b(k,89) = b(k,89) - lu(k,1506) * b(k,126) + b(k,88) = b(k,88) - lu(k,1505) * b(k,126) + b(k,81) = b(k,81) - lu(k,1504) * b(k,126) + b(k,73) = b(k,73) - lu(k,1503) * b(k,126) + b(k,49) = b(k,49) - lu(k,1502) * b(k,126) + b(k,125) = b(k,125) * lu(k,1487) + b(k,124) = b(k,124) - lu(k,1486) * b(k,125) + b(k,123) = b(k,123) - lu(k,1485) * b(k,125) + b(k,122) = b(k,122) - lu(k,1484) * b(k,125) + b(k,121) = b(k,121) - lu(k,1483) * b(k,125) + b(k,120) = b(k,120) - lu(k,1482) * b(k,125) + b(k,119) = b(k,119) - lu(k,1481) * b(k,125) + b(k,118) = b(k,118) - lu(k,1480) * b(k,125) + b(k,117) = b(k,117) - lu(k,1479) * b(k,125) + b(k,116) = b(k,116) - lu(k,1478) * b(k,125) + b(k,115) = b(k,115) - lu(k,1477) * b(k,125) + b(k,114) = b(k,114) - lu(k,1476) * b(k,125) + b(k,113) = b(k,113) - lu(k,1475) * b(k,125) + b(k,112) = b(k,112) - lu(k,1474) * b(k,125) + b(k,111) = b(k,111) - lu(k,1473) * b(k,125) + b(k,110) = b(k,110) - lu(k,1472) * b(k,125) + b(k,109) = b(k,109) - lu(k,1471) * b(k,125) + b(k,108) = b(k,108) - lu(k,1470) * b(k,125) + b(k,107) = b(k,107) - lu(k,1469) * b(k,125) + b(k,106) = b(k,106) - lu(k,1468) * b(k,125) + b(k,103) = b(k,103) - lu(k,1467) * b(k,125) + b(k,99) = b(k,99) - lu(k,1466) * b(k,125) + b(k,89) = b(k,89) - lu(k,1465) * b(k,125) + b(k,88) = b(k,88) - lu(k,1464) * b(k,125) + b(k,84) = b(k,84) - lu(k,1463) * b(k,125) + b(k,83) = b(k,83) - lu(k,1462) * b(k,125) + b(k,80) = b(k,80) - lu(k,1461) * b(k,125) + b(k,69) = b(k,69) - lu(k,1460) * b(k,125) + b(k,65) = b(k,65) - lu(k,1459) * b(k,125) + b(k,64) = b(k,64) - lu(k,1458) * b(k,125) + b(k,60) = b(k,60) - lu(k,1457) * b(k,125) + b(k,56) = b(k,56) - lu(k,1456) * b(k,125) + b(k,54) = b(k,54) - lu(k,1455) * b(k,125) + b(k,38) = b(k,38) - lu(k,1454) * b(k,125) + b(k,124) = b(k,124) * lu(k,1438) + b(k,123) = b(k,123) - lu(k,1437) * b(k,124) + b(k,122) = b(k,122) - lu(k,1436) * b(k,124) + b(k,121) = b(k,121) - lu(k,1435) * b(k,124) + b(k,120) = b(k,120) - lu(k,1434) * b(k,124) + b(k,119) = b(k,119) - lu(k,1433) * b(k,124) + b(k,118) = b(k,118) - lu(k,1432) * b(k,124) + b(k,117) = b(k,117) - lu(k,1431) * b(k,124) + b(k,116) = b(k,116) - lu(k,1430) * b(k,124) + b(k,115) = b(k,115) - lu(k,1429) * b(k,124) + b(k,114) = b(k,114) - lu(k,1428) * b(k,124) + b(k,113) = b(k,113) - lu(k,1427) * b(k,124) + b(k,112) = b(k,112) - lu(k,1426) * b(k,124) + b(k,111) = b(k,111) - lu(k,1425) * b(k,124) + b(k,110) = b(k,110) - lu(k,1424) * b(k,124) + b(k,108) = b(k,108) - lu(k,1423) * b(k,124) + b(k,107) = b(k,107) - lu(k,1422) * b(k,124) + b(k,106) = b(k,106) - lu(k,1421) * b(k,124) + b(k,100) = b(k,100) - lu(k,1420) * b(k,124) + b(k,99) = b(k,99) - lu(k,1419) * b(k,124) + b(k,92) = b(k,92) - lu(k,1418) * b(k,124) + b(k,91) = b(k,91) - lu(k,1417) * b(k,124) + b(k,90) = b(k,90) - lu(k,1416) * b(k,124) + b(k,86) = b(k,86) - lu(k,1415) * b(k,124) + b(k,85) = b(k,85) - lu(k,1414) * b(k,124) + b(k,82) = b(k,82) - lu(k,1413) * b(k,124) + b(k,78) = b(k,78) - lu(k,1412) * b(k,124) + b(k,76) = b(k,76) - lu(k,1411) * b(k,124) + b(k,72) = b(k,72) - lu(k,1410) * b(k,124) + b(k,67) = b(k,67) - lu(k,1409) * b(k,124) + b(k,66) = b(k,66) - lu(k,1408) * b(k,124) + b(k,62) = b(k,62) - lu(k,1407) * b(k,124) + b(k,61) = b(k,61) - lu(k,1406) * b(k,124) + b(k,51) = b(k,51) - lu(k,1405) * b(k,124) + b(k,123) = b(k,123) * lu(k,1388) + b(k,122) = b(k,122) - lu(k,1387) * b(k,123) + b(k,121) = b(k,121) - lu(k,1386) * b(k,123) + b(k,120) = b(k,120) - lu(k,1385) * b(k,123) + b(k,119) = b(k,119) - lu(k,1384) * b(k,123) + b(k,118) = b(k,118) - lu(k,1383) * b(k,123) + b(k,117) = b(k,117) - lu(k,1382) * b(k,123) + b(k,116) = b(k,116) - lu(k,1381) * b(k,123) + b(k,115) = b(k,115) - lu(k,1380) * b(k,123) + b(k,114) = b(k,114) - lu(k,1379) * b(k,123) + b(k,113) = b(k,113) - lu(k,1378) * b(k,123) + b(k,112) = b(k,112) - lu(k,1377) * b(k,123) + b(k,111) = b(k,111) - lu(k,1376) * b(k,123) + b(k,110) = b(k,110) - lu(k,1375) * b(k,123) + b(k,109) = b(k,109) - lu(k,1374) * b(k,123) + b(k,108) = b(k,108) - lu(k,1373) * b(k,123) + b(k,107) = b(k,107) - lu(k,1372) * b(k,123) + b(k,106) = b(k,106) - lu(k,1371) * b(k,123) + b(k,103) = b(k,103) - lu(k,1370) * b(k,123) + b(k,100) = b(k,100) - lu(k,1369) * b(k,123) + b(k,99) = b(k,99) - lu(k,1368) * b(k,123) + b(k,92) = b(k,92) - lu(k,1367) * b(k,123) + b(k,91) = b(k,91) - lu(k,1366) * b(k,123) + b(k,90) = b(k,90) - lu(k,1365) * b(k,123) + b(k,86) = b(k,86) - lu(k,1364) * b(k,123) + b(k,85) = b(k,85) - lu(k,1363) * b(k,123) + b(k,84) = b(k,84) - lu(k,1362) * b(k,123) + b(k,83) = b(k,83) - lu(k,1361) * b(k,123) + b(k,82) = b(k,82) - lu(k,1360) * b(k,123) + b(k,80) = b(k,80) - lu(k,1359) * b(k,123) + b(k,79) = b(k,79) - lu(k,1358) * b(k,123) + b(k,78) = b(k,78) - lu(k,1357) * b(k,123) + b(k,77) = b(k,77) - lu(k,1356) * b(k,123) + b(k,76) = b(k,76) - lu(k,1355) * b(k,123) + b(k,72) = b(k,72) - lu(k,1354) * b(k,123) + b(k,69) = b(k,69) - lu(k,1353) * b(k,123) + b(k,67) = b(k,67) - lu(k,1352) * b(k,123) + b(k,66) = b(k,66) - lu(k,1351) * b(k,123) + b(k,64) = b(k,64) - lu(k,1350) * b(k,123) + b(k,63) = b(k,63) - lu(k,1349) * b(k,123) + b(k,62) = b(k,62) - lu(k,1348) * b(k,123) + b(k,61) = b(k,61) - lu(k,1347) * b(k,123) + b(k,53) = b(k,53) - lu(k,1346) * b(k,123) + b(k,51) = b(k,51) - lu(k,1345) * b(k,123) + b(k,122) = b(k,122) * lu(k,1327) + b(k,121) = b(k,121) - lu(k,1326) * b(k,122) + b(k,120) = b(k,120) - lu(k,1325) * b(k,122) + b(k,119) = b(k,119) - lu(k,1324) * b(k,122) + b(k,118) = b(k,118) - lu(k,1323) * b(k,122) + b(k,117) = b(k,117) - lu(k,1322) * b(k,122) + b(k,116) = b(k,116) - lu(k,1321) * b(k,122) + b(k,115) = b(k,115) - lu(k,1320) * b(k,122) + b(k,114) = b(k,114) - lu(k,1319) * b(k,122) + b(k,113) = b(k,113) - lu(k,1318) * b(k,122) + b(k,112) = b(k,112) - lu(k,1317) * b(k,122) + b(k,111) = b(k,111) - lu(k,1316) * b(k,122) + b(k,110) = b(k,110) - lu(k,1315) * b(k,122) + b(k,109) = b(k,109) - lu(k,1314) * b(k,122) + b(k,105) = b(k,105) - lu(k,1313) * b(k,122) + b(k,104) = b(k,104) - lu(k,1312) * b(k,122) + b(k,102) = b(k,102) - lu(k,1311) * b(k,122) + b(k,101) = b(k,101) - lu(k,1310) * b(k,122) + b(k,98) = b(k,98) - lu(k,1309) * b(k,122) + b(k,97) = b(k,97) - lu(k,1308) * b(k,122) + b(k,96) = b(k,96) - lu(k,1307) * b(k,122) + b(k,95) = b(k,95) - lu(k,1306) * b(k,122) + b(k,94) = b(k,94) - lu(k,1305) * b(k,122) + b(k,93) = b(k,93) - lu(k,1304) * b(k,122) + b(k,74) = b(k,74) - lu(k,1303) * b(k,122) + b(k,121) = b(k,121) * lu(k,1284) + b(k,120) = b(k,120) - lu(k,1283) * b(k,121) + b(k,119) = b(k,119) - lu(k,1282) * b(k,121) + b(k,118) = b(k,118) - lu(k,1281) * b(k,121) + b(k,117) = b(k,117) - lu(k,1280) * b(k,121) + b(k,116) = b(k,116) - lu(k,1279) * b(k,121) + b(k,115) = b(k,115) - lu(k,1278) * b(k,121) + b(k,114) = b(k,114) - lu(k,1277) * b(k,121) + b(k,113) = b(k,113) - lu(k,1276) * b(k,121) + b(k,112) = b(k,112) - lu(k,1275) * b(k,121) + b(k,111) = b(k,111) - lu(k,1274) * b(k,121) + b(k,110) = b(k,110) - lu(k,1273) * b(k,121) + b(k,108) = b(k,108) - lu(k,1272) * b(k,121) + b(k,100) = b(k,100) - lu(k,1271) * b(k,121) + b(k,93) = b(k,93) - lu(k,1270) * b(k,121) + b(k,91) = b(k,91) - lu(k,1269) * b(k,121) + b(k,90) = b(k,90) - lu(k,1268) * b(k,121) + b(k,86) = b(k,86) - lu(k,1267) * b(k,121) + b(k,85) = b(k,85) - lu(k,1266) * b(k,121) + b(k,71) = b(k,71) - lu(k,1265) * b(k,121) + b(k,70) = b(k,70) - lu(k,1264) * b(k,121) + b(k,69) = b(k,69) - lu(k,1263) * b(k,121) + b(k,67) = b(k,67) - lu(k,1262) * b(k,121) + b(k,51) = b(k,51) - lu(k,1261) * b(k,121) + end do + end subroutine lu_slv09 + subroutine lu_slv10( 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,120) = b(k,120) * lu(k,1241) + b(k,119) = b(k,119) - lu(k,1240) * b(k,120) + b(k,118) = b(k,118) - lu(k,1239) * b(k,120) + b(k,117) = b(k,117) - lu(k,1238) * b(k,120) + b(k,116) = b(k,116) - lu(k,1237) * b(k,120) + b(k,115) = b(k,115) - lu(k,1236) * b(k,120) + b(k,114) = b(k,114) - lu(k,1235) * b(k,120) + b(k,113) = b(k,113) - lu(k,1234) * b(k,120) + b(k,112) = b(k,112) - lu(k,1233) * b(k,120) + b(k,111) = b(k,111) - lu(k,1232) * b(k,120) + b(k,110) = b(k,110) - lu(k,1231) * b(k,120) + b(k,109) = b(k,109) - lu(k,1230) * b(k,120) + b(k,105) = b(k,105) - lu(k,1229) * b(k,120) + b(k,104) = b(k,104) - lu(k,1228) * b(k,120) + b(k,102) = b(k,102) - lu(k,1227) * b(k,120) + b(k,101) = b(k,101) - lu(k,1226) * b(k,120) + b(k,98) = b(k,98) - lu(k,1225) * b(k,120) + b(k,97) = b(k,97) - lu(k,1224) * b(k,120) + b(k,96) = b(k,96) - lu(k,1223) * b(k,120) + b(k,95) = b(k,95) - lu(k,1222) * b(k,120) + b(k,94) = b(k,94) - lu(k,1221) * b(k,120) + b(k,93) = b(k,93) - lu(k,1220) * b(k,120) + b(k,74) = b(k,74) - lu(k,1219) * b(k,120) + b(k,68) = b(k,68) - lu(k,1218) * b(k,120) + b(k,119) = b(k,119) * lu(k,1197) + b(k,118) = b(k,118) - lu(k,1196) * b(k,119) + b(k,117) = b(k,117) - lu(k,1195) * b(k,119) + b(k,116) = b(k,116) - lu(k,1194) * b(k,119) + b(k,115) = b(k,115) - lu(k,1193) * b(k,119) + b(k,114) = b(k,114) - lu(k,1192) * b(k,119) + b(k,113) = b(k,113) - lu(k,1191) * b(k,119) + b(k,112) = b(k,112) - lu(k,1190) * b(k,119) + b(k,111) = b(k,111) - lu(k,1189) * b(k,119) + b(k,110) = b(k,110) - lu(k,1188) * b(k,119) + b(k,109) = b(k,109) - lu(k,1187) * b(k,119) + b(k,105) = b(k,105) - lu(k,1186) * b(k,119) + b(k,104) = b(k,104) - lu(k,1185) * b(k,119) + b(k,102) = b(k,102) - lu(k,1184) * b(k,119) + b(k,101) = b(k,101) - lu(k,1183) * b(k,119) + b(k,98) = b(k,98) - lu(k,1182) * b(k,119) + b(k,97) = b(k,97) - lu(k,1181) * b(k,119) + b(k,96) = b(k,96) - lu(k,1180) * b(k,119) + b(k,95) = b(k,95) - lu(k,1179) * b(k,119) + b(k,94) = b(k,94) - lu(k,1178) * b(k,119) + b(k,93) = b(k,93) - lu(k,1177) * b(k,119) + b(k,73) = b(k,73) - lu(k,1176) * b(k,119) + b(k,58) = b(k,58) - lu(k,1175) * b(k,119) + b(k,118) = b(k,118) * lu(k,1153) + b(k,117) = b(k,117) - lu(k,1152) * b(k,118) + b(k,116) = b(k,116) - lu(k,1151) * b(k,118) + b(k,115) = b(k,115) - lu(k,1150) * b(k,118) + b(k,114) = b(k,114) - lu(k,1149) * b(k,118) + b(k,113) = b(k,113) - lu(k,1148) * b(k,118) + b(k,112) = b(k,112) - lu(k,1147) * b(k,118) + b(k,111) = b(k,111) - lu(k,1146) * b(k,118) + b(k,110) = b(k,110) - lu(k,1145) * b(k,118) + b(k,109) = b(k,109) - lu(k,1144) * b(k,118) + b(k,108) = b(k,108) - lu(k,1143) * b(k,118) + b(k,105) = b(k,105) - lu(k,1142) * b(k,118) + b(k,104) = b(k,104) - lu(k,1141) * b(k,118) + b(k,102) = b(k,102) - lu(k,1140) * b(k,118) + b(k,101) = b(k,101) - lu(k,1139) * b(k,118) + b(k,98) = b(k,98) - lu(k,1138) * b(k,118) + b(k,97) = b(k,97) - lu(k,1137) * b(k,118) + b(k,96) = b(k,96) - lu(k,1136) * b(k,118) + b(k,95) = b(k,95) - lu(k,1135) * b(k,118) + b(k,94) = b(k,94) - lu(k,1134) * b(k,118) + b(k,93) = b(k,93) - lu(k,1133) * b(k,118) + b(k,90) = b(k,90) - lu(k,1132) * b(k,118) + b(k,86) = b(k,86) - lu(k,1131) * b(k,118) + b(k,78) = b(k,78) - lu(k,1130) * b(k,118) + b(k,76) = b(k,76) - lu(k,1129) * b(k,118) + b(k,71) = b(k,71) - lu(k,1128) * b(k,118) + b(k,70) = b(k,70) - lu(k,1127) * b(k,118) + b(k,117) = b(k,117) * lu(k,1104) + b(k,116) = b(k,116) - lu(k,1103) * b(k,117) + b(k,115) = b(k,115) - lu(k,1102) * b(k,117) + b(k,114) = b(k,114) - lu(k,1101) * b(k,117) + b(k,113) = b(k,113) - lu(k,1100) * b(k,117) + b(k,112) = b(k,112) - lu(k,1099) * b(k,117) + b(k,111) = b(k,111) - lu(k,1098) * b(k,117) + b(k,110) = b(k,110) - lu(k,1097) * b(k,117) + b(k,109) = b(k,109) - lu(k,1096) * b(k,117) + b(k,108) = b(k,108) - lu(k,1095) * b(k,117) + b(k,107) = b(k,107) - lu(k,1094) * b(k,117) + b(k,106) = b(k,106) - lu(k,1093) * b(k,117) + b(k,99) = b(k,99) - lu(k,1092) * b(k,117) + b(k,92) = b(k,92) - lu(k,1091) * b(k,117) + b(k,89) = b(k,89) - lu(k,1090) * b(k,117) + b(k,84) = b(k,84) - lu(k,1089) * b(k,117) + b(k,83) = b(k,83) - lu(k,1088) * b(k,117) + b(k,82) = b(k,82) - lu(k,1087) * b(k,117) + b(k,80) = b(k,80) - lu(k,1086) * b(k,117) + b(k,52) = b(k,52) - lu(k,1085) * b(k,117) + b(k,43) = b(k,43) - lu(k,1084) * b(k,117) + b(k,38) = b(k,38) - lu(k,1083) * b(k,117) + b(k,26) = b(k,26) - lu(k,1082) * b(k,117) + b(k,116) = b(k,116) * lu(k,1058) + b(k,114) = b(k,114) - lu(k,1057) * b(k,116) + b(k,112) = b(k,112) - lu(k,1056) * b(k,116) + b(k,108) = b(k,108) - lu(k,1055) * b(k,116) + b(k,91) = b(k,91) - lu(k,1054) * b(k,116) + b(k,90) = b(k,90) - lu(k,1053) * b(k,116) + b(k,86) = b(k,86) - lu(k,1052) * b(k,116) + b(k,78) = b(k,78) - lu(k,1051) * b(k,116) + b(k,76) = b(k,76) - lu(k,1050) * b(k,116) + b(k,75) = b(k,75) - lu(k,1049) * b(k,116) + b(k,74) = b(k,74) - lu(k,1048) * b(k,116) + b(k,73) = b(k,73) - lu(k,1047) * b(k,116) + b(k,71) = b(k,71) - lu(k,1046) * b(k,116) + b(k,70) = b(k,70) - lu(k,1045) * b(k,116) + b(k,68) = b(k,68) - lu(k,1044) * b(k,116) + b(k,66) = b(k,66) - lu(k,1043) * b(k,116) + b(k,62) = b(k,62) - lu(k,1042) * b(k,116) + b(k,61) = b(k,61) - lu(k,1041) * b(k,116) + b(k,58) = b(k,58) - lu(k,1040) * b(k,116) + b(k,57) = b(k,57) - lu(k,1039) * b(k,116) + b(k,115) = b(k,115) * lu(k,1014) + b(k,114) = b(k,114) - lu(k,1013) * b(k,115) + b(k,113) = b(k,113) - lu(k,1012) * b(k,115) + b(k,111) = b(k,111) - lu(k,1011) * b(k,115) + b(k,109) = b(k,109) - lu(k,1010) * b(k,115) + b(k,105) = b(k,105) - lu(k,1009) * b(k,115) + b(k,104) = b(k,104) - lu(k,1008) * b(k,115) + b(k,100) = b(k,100) - lu(k,1007) * b(k,115) + b(k,84) = b(k,84) - lu(k,1006) * b(k,115) + b(k,114) = b(k,114) * lu(k,984) + b(k,112) = b(k,112) - lu(k,983) * b(k,114) + b(k,108) = b(k,108) - lu(k,982) * b(k,114) + b(k,107) = b(k,107) - lu(k,981) * b(k,114) + b(k,106) = b(k,106) - lu(k,980) * b(k,114) + b(k,103) = b(k,103) - lu(k,979) * b(k,114) + b(k,99) = b(k,99) - lu(k,978) * b(k,114) + b(k,92) = b(k,92) - lu(k,977) * b(k,114) + b(k,90) = b(k,90) - lu(k,976) * b(k,114) + b(k,89) = b(k,89) - lu(k,975) * b(k,114) + b(k,88) = b(k,88) - lu(k,974) * b(k,114) + b(k,83) = b(k,83) - lu(k,973) * b(k,114) + b(k,82) = b(k,82) - lu(k,972) * b(k,114) + b(k,81) = b(k,81) - lu(k,971) * b(k,114) + b(k,80) = b(k,80) - lu(k,970) * b(k,114) + b(k,79) = b(k,79) - lu(k,969) * b(k,114) + b(k,74) = b(k,74) - lu(k,968) * b(k,114) + b(k,73) = b(k,73) - lu(k,967) * b(k,114) + b(k,72) = b(k,72) - lu(k,966) * b(k,114) + b(k,69) = b(k,69) - lu(k,965) * b(k,114) + b(k,65) = b(k,65) - lu(k,964) * b(k,114) + b(k,64) = b(k,64) - lu(k,963) * b(k,114) + b(k,60) = b(k,60) - lu(k,962) * b(k,114) + b(k,59) = b(k,59) - lu(k,961) * b(k,114) + b(k,56) = b(k,56) - lu(k,960) * b(k,114) + b(k,55) = b(k,55) - lu(k,959) * b(k,114) + b(k,54) = b(k,54) - lu(k,958) * b(k,114) + b(k,53) = b(k,53) - lu(k,957) * b(k,114) + b(k,50) = b(k,50) - lu(k,956) * b(k,114) + b(k,48) = b(k,48) - lu(k,955) * b(k,114) + b(k,45) = b(k,45) - lu(k,954) * b(k,114) + b(k,42) = b(k,42) - lu(k,953) * b(k,114) + b(k,41) = b(k,41) - lu(k,952) * b(k,114) + b(k,40) = b(k,40) - lu(k,951) * b(k,114) + b(k,39) = b(k,39) - lu(k,950) * b(k,114) + b(k,32) = b(k,32) - lu(k,949) * b(k,114) + b(k,113) = b(k,113) * lu(k,926) + b(k,111) = b(k,111) - lu(k,925) * b(k,113) + b(k,109) = b(k,109) - lu(k,924) * b(k,113) + b(k,97) = b(k,97) - lu(k,923) * b(k,113) + b(k,73) = b(k,73) - lu(k,922) * b(k,113) + b(k,112) = b(k,112) * lu(k,900) + b(k,108) = b(k,108) - lu(k,899) * b(k,112) + b(k,107) = b(k,107) - lu(k,898) * b(k,112) + b(k,106) = b(k,106) - lu(k,897) * b(k,112) + b(k,103) = b(k,103) - lu(k,896) * b(k,112) + b(k,99) = b(k,99) - lu(k,895) * b(k,112) + b(k,89) = b(k,89) - lu(k,894) * b(k,112) + b(k,80) = b(k,80) - lu(k,893) * b(k,112) + b(k,79) = b(k,79) - lu(k,892) * b(k,112) + b(k,77) = b(k,77) - lu(k,891) * b(k,112) + b(k,74) = b(k,74) - lu(k,890) * b(k,112) + b(k,64) = b(k,64) - lu(k,889) * b(k,112) + b(k,59) = b(k,59) - lu(k,888) * b(k,112) + b(k,55) = b(k,55) - lu(k,887) * b(k,112) + b(k,111) = b(k,111) * lu(k,866) + b(k,109) = b(k,109) - lu(k,865) * b(k,111) + b(k,105) = b(k,105) - lu(k,864) * b(k,111) + b(k,101) = b(k,101) - lu(k,863) * b(k,111) + b(k,98) = b(k,98) - lu(k,862) * b(k,111) + b(k,110) = b(k,110) * lu(k,833) + b(k,109) = b(k,109) - lu(k,832) * b(k,110) + b(k,100) = b(k,100) - lu(k,831) * b(k,110) + b(k,84) = b(k,84) - lu(k,830) * b(k,110) + b(k,109) = b(k,109) * lu(k,811) + b(k,96) = b(k,96) - lu(k,810) * b(k,109) + b(k,95) = b(k,95) - lu(k,809) * b(k,109) + b(k,108) = b(k,108) * lu(k,787) + b(k,107) = b(k,107) - lu(k,786) * b(k,108) + b(k,106) = b(k,106) - lu(k,785) * b(k,108) + b(k,103) = b(k,103) - lu(k,784) * b(k,108) + b(k,99) = b(k,99) - lu(k,783) * b(k,108) + b(k,91) = b(k,91) - lu(k,782) * b(k,108) + b(k,89) = b(k,89) - lu(k,781) * b(k,108) + b(k,88) = b(k,88) - lu(k,780) * b(k,108) + b(k,85) = b(k,85) - lu(k,779) * b(k,108) + b(k,81) = b(k,81) - lu(k,778) * b(k,108) + b(k,79) = b(k,79) - lu(k,777) * b(k,108) + b(k,65) = b(k,65) - lu(k,776) * b(k,108) + b(k,60) = b(k,60) - lu(k,775) * b(k,108) + b(k,56) = b(k,56) - lu(k,774) * b(k,108) + b(k,51) = b(k,51) - lu(k,773) * b(k,108) + b(k,48) = b(k,48) - lu(k,772) * b(k,108) + b(k,44) = b(k,44) - lu(k,771) * b(k,108) + b(k,42) = b(k,42) - lu(k,770) * b(k,108) + b(k,41) = b(k,41) - lu(k,769) * b(k,108) + b(k,40) = b(k,40) - lu(k,768) * b(k,108) + b(k,39) = b(k,39) - lu(k,767) * b(k,108) + b(k,37) = b(k,37) - lu(k,766) * b(k,108) + b(k,36) = b(k,36) - lu(k,765) * b(k,108) + b(k,35) = b(k,35) - lu(k,764) * b(k,108) + b(k,34) = b(k,34) - lu(k,763) * b(k,108) + b(k,31) = b(k,31) - lu(k,762) * b(k,108) + b(k,30) = b(k,30) - lu(k,761) * b(k,108) + b(k,29) = b(k,29) - lu(k,760) * b(k,108) + b(k,28) = b(k,28) - lu(k,759) * b(k,108) + b(k,27) = b(k,27) - lu(k,758) * b(k,108) + end do + end subroutine lu_slv10 + subroutine lu_slv11( 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,107) = b(k,107) * lu(k,738) + b(k,106) = b(k,106) - lu(k,737) * b(k,107) + b(k,103) = b(k,103) - lu(k,736) * b(k,107) + b(k,99) = b(k,99) - lu(k,735) * b(k,107) + b(k,79) = b(k,79) - lu(k,734) * b(k,107) + b(k,69) = b(k,69) - lu(k,733) * b(k,107) + b(k,106) = b(k,106) * lu(k,715) + b(k,99) = b(k,99) - lu(k,714) * b(k,106) + b(k,92) = b(k,92) - lu(k,713) * b(k,106) + b(k,82) = b(k,82) - lu(k,712) * b(k,106) + b(k,77) = b(k,77) - lu(k,711) * b(k,106) + b(k,63) = b(k,63) - lu(k,710) * b(k,106) + b(k,52) = b(k,52) - lu(k,709) * b(k,106) + b(k,43) = b(k,43) - lu(k,708) * b(k,106) + b(k,105) = b(k,105) * lu(k,691) + b(k,102) = b(k,102) - lu(k,690) * b(k,105) + b(k,101) = b(k,101) - lu(k,689) * b(k,105) + b(k,87) = b(k,87) - lu(k,688) * b(k,105) + b(k,104) = b(k,104) * lu(k,669) + b(k,97) = b(k,97) - lu(k,668) * b(k,104) + b(k,94) = b(k,94) - lu(k,667) * b(k,104) + b(k,103) = b(k,103) * lu(k,647) + b(k,89) = b(k,89) - lu(k,646) * b(k,103) + b(k,88) = b(k,88) - lu(k,645) * b(k,103) + b(k,81) = b(k,81) - lu(k,644) * b(k,103) + b(k,49) = b(k,49) - lu(k,643) * b(k,103) + b(k,102) = b(k,102) * lu(k,625) + b(k,101) = b(k,101) - lu(k,624) * b(k,102) + b(k,87) = b(k,87) - lu(k,623) * b(k,102) + b(k,101) = b(k,101) * lu(k,609) + b(k,100) = b(k,100) * lu(k,594) + b(k,99) = b(k,99) * lu(k,582) + b(k,79) = b(k,79) - lu(k,581) * b(k,99) + b(k,69) = b(k,69) - lu(k,580) * b(k,99) + b(k,98) = b(k,98) * lu(k,564) + b(k,97) = b(k,97) * lu(k,550) + b(k,96) = b(k,96) * lu(k,535) + b(k,95) = b(k,95) - lu(k,534) * b(k,96) + b(k,95) = b(k,95) * lu(k,519) + b(k,94) = b(k,94) * lu(k,504) + b(k,93) = b(k,93) * lu(k,490) + b(k,92) = b(k,92) * lu(k,476) + b(k,82) = b(k,82) - lu(k,475) * b(k,92) + b(k,72) = b(k,72) - lu(k,474) * b(k,92) + b(k,52) = b(k,52) - lu(k,473) * b(k,92) + b(k,91) = b(k,91) * lu(k,461) + b(k,85) = b(k,85) - lu(k,460) * b(k,91) + b(k,75) = b(k,75) - lu(k,459) * b(k,91) + b(k,90) = b(k,90) * lu(k,446) + b(k,86) = b(k,86) - lu(k,445) * b(k,90) + b(k,78) = b(k,78) - lu(k,444) * b(k,90) + b(k,44) = b(k,44) - lu(k,443) * b(k,90) + b(k,89) = b(k,89) * lu(k,432) + b(k,55) = b(k,55) - lu(k,431) * b(k,89) + b(k,88) = b(k,88) * lu(k,416) + b(k,81) = b(k,81) - lu(k,415) * b(k,88) + b(k,69) = b(k,69) - lu(k,414) * b(k,88) + b(k,49) = b(k,49) - lu(k,413) * b(k,88) + b(k,87) = b(k,87) * lu(k,401) + b(k,47) = b(k,47) - lu(k,400) * b(k,87) + b(k,46) = b(k,46) - lu(k,399) * b(k,87) + b(k,86) = b(k,86) * lu(k,388) + b(k,78) = b(k,78) - lu(k,387) * b(k,86) + b(k,76) = b(k,76) - lu(k,386) * b(k,86) + b(k,69) = b(k,69) - lu(k,385) * b(k,86) + b(k,85) = b(k,85) * lu(k,377) + b(k,84) = b(k,84) * lu(k,369) + b(k,83) = b(k,83) * lu(k,359) + b(k,80) = b(k,80) - lu(k,358) * b(k,83) + b(k,38) = b(k,38) - lu(k,357) * b(k,83) + b(k,82) = b(k,82) * lu(k,351) + b(k,45) = b(k,45) - lu(k,350) * b(k,82) + b(k,81) = b(k,81) * lu(k,341) + b(k,49) = b(k,49) - lu(k,340) * b(k,81) + b(k,80) = b(k,80) * lu(k,333) + b(k,38) = b(k,38) - lu(k,332) * b(k,80) + b(k,79) = b(k,79) * lu(k,324) + b(k,78) = b(k,78) * lu(k,317) + b(k,77) = b(k,77) * lu(k,309) + b(k,43) = b(k,43) - lu(k,308) * b(k,77) + b(k,76) = b(k,76) * lu(k,300) + b(k,75) = b(k,75) * lu(k,292) + b(k,74) = b(k,74) - lu(k,291) * b(k,75) + b(k,68) = b(k,68) - lu(k,290) * b(k,75) + b(k,57) = b(k,57) - lu(k,289) * b(k,75) + b(k,74) = b(k,74) * lu(k,284) + b(k,68) = b(k,68) - lu(k,283) * b(k,74) + b(k,73) = b(k,73) * lu(k,278) + b(k,72) = b(k,72) * lu(k,271) + b(k,71) = b(k,71) * lu(k,264) + b(k,70) = b(k,70) * lu(k,256) + b(k,69) = b(k,69) * lu(k,252) + b(k,68) = b(k,68) * lu(k,246) + b(k,67) = b(k,67) * lu(k,239) + b(k,66) = b(k,66) * lu(k,230) + b(k,65) = b(k,65) * lu(k,221) + b(k,64) = b(k,64) * lu(k,214) + b(k,63) = b(k,63) * lu(k,206) + b(k,62) = b(k,62) * lu(k,200) + b(k,61) = b(k,61) * lu(k,193) + b(k,60) = b(k,60) * lu(k,186) + b(k,59) = b(k,59) * lu(k,179) + b(k,58) = b(k,58) * lu(k,173) + b(k,57) = b(k,57) * lu(k,167) + b(k,56) = b(k,56) * lu(k,161) + b(k,55) = b(k,55) * lu(k,155) + b(k,54) = b(k,54) * lu(k,147) + b(k,53) = b(k,53) * lu(k,139) + b(k,52) = b(k,52) * lu(k,134) + b(k,51) = b(k,51) * lu(k,131) + b(k,50) = b(k,50) * lu(k,125) + b(k,49) = b(k,49) * lu(k,122) + b(k,48) = b(k,48) * lu(k,116) + b(k,39) = b(k,39) - lu(k,115) * b(k,48) + b(k,47) = b(k,47) * lu(k,111) + b(k,46) = b(k,46) * lu(k,107) + b(k,45) = b(k,45) * lu(k,103) + b(k,33) = b(k,33) - lu(k,102) * b(k,45) + b(k,44) = b(k,44) * lu(k,98) + b(k,43) = b(k,43) * lu(k,95) + b(k,42) = b(k,42) * lu(k,90) + b(k,39) = b(k,39) - lu(k,89) * b(k,42) + b(k,41) = b(k,41) * lu(k,85) + b(k,40) = b(k,40) * lu(k,80) + b(k,39) = b(k,39) * lu(k,77) + b(k,38) = b(k,38) * lu(k,75) + b(k,37) = b(k,37) * lu(k,70) + b(k,36) = b(k,36) * lu(k,65) + b(k,35) = b(k,35) * lu(k,60) + b(k,34) = b(k,34) * lu(k,55) + b(k,33) = b(k,33) * lu(k,52) + b(k,32) = b(k,32) * lu(k,48) + b(k,31) = b(k,31) * lu(k,44) + b(k,30) = b(k,30) * lu(k,40) + b(k,29) = b(k,29) * lu(k,36) + b(k,28) = b(k,28) * lu(k,32) + b(k,27) = b(k,27) * lu(k,29) + b(k,26) = b(k,26) * lu(k,26) + b(k,25) = b(k,25) * lu(k,25) + b(k,24) = b(k,24) * lu(k,24) + b(k,23) = b(k,23) * lu(k,23) + b(k,22) = b(k,22) * lu(k,22) + b(k,21) = b(k,21) * lu(k,21) + b(k,20) = b(k,20) * lu(k,20) + b(k,19) = b(k,19) * lu(k,19) + b(k,18) = b(k,18) * lu(k,18) + b(k,17) = b(k,17) * lu(k,17) + b(k,16) = b(k,16) * lu(k,16) + b(k,15) = b(k,15) * lu(k,15) + b(k,14) = b(k,14) * lu(k,14) + b(k,13) = b(k,13) * lu(k,13) + b(k,12) = b(k,12) * lu(k,12) + b(k,11) = b(k,11) * lu(k,11) + b(k,10) = b(k,10) * lu(k,10) + 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_slv11 + 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 ) + call lu_slv09( avec_len, lu, b ) + call lu_slv10( avec_len, lu, b ) + call lu_slv11( avec_len, lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_mad_mam5/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_mad_mam5/mo_nln_matrix.F90 new file mode 100644 index 0000000000..a338a4d93a --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/mo_nln_matrix.F90 @@ -0,0 +1,3495 @@ + 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,582) = -(rxt(k,486)*y(k,17) + rxt(k,487)*y(k,101) + rxt(k,488)*y(k,73)) + mat(k,735) = -rxt(k,486)*y(k,3) + mat(k,895) = -rxt(k,487)*y(k,3) + mat(k,1909) = -rxt(k,488)*y(k,3) + mat(k,714) = 4.000_r8*rxt(k,489)*y(k,5) + (rxt(k,490)+rxt(k,491))*y(k,28) & + + rxt(k,494)*y(k,62) + rxt(k,497)*y(k,70) + rxt(k,548)*y(k,80) & + + rxt(k,498)*y(k,133) + mat(k,57) = rxt(k,476)*y(k,71) + mat(k,63) = rxt(k,502)*y(k,71) + mat(k,187) = 2.000_r8*rxt(k,513)*y(k,25) + 2.000_r8*rxt(k,525)*y(k,71) & + + 2.000_r8*rxt(k,514)*y(k,133) + mat(k,223) = rxt(k,515)*y(k,25) + rxt(k,526)*y(k,71) + rxt(k,516)*y(k,133) + mat(k,162) = 3.000_r8*rxt(k,520)*y(k,25) + 3.000_r8*rxt(k,503)*y(k,71) & + + 3.000_r8*rxt(k,521)*y(k,133) + mat(k,1466) = 2.000_r8*rxt(k,513)*y(k,16) + rxt(k,515)*y(k,18) & + + 3.000_r8*rxt(k,520)*y(k,24) + mat(k,1092) = (rxt(k,490)+rxt(k,491))*y(k,5) + mat(k,34) = 2.000_r8*rxt(k,504)*y(k,71) + mat(k,325) = rxt(k,499)*y(k,70) + rxt(k,505)*y(k,71) + rxt(k,500)*y(k,133) + mat(k,1949) = rxt(k,494)*y(k,5) + mat(k,1368) = rxt(k,497)*y(k,5) + rxt(k,499)*y(k,45) + mat(k,783) = rxt(k,476)*y(k,9) + rxt(k,502)*y(k,10) + 2.000_r8*rxt(k,525) & + *y(k,16) + rxt(k,526)*y(k,18) + 3.000_r8*rxt(k,503)*y(k,24) & + + 2.000_r8*rxt(k,504)*y(k,42) + rxt(k,505)*y(k,45) + mat(k,477) = rxt(k,548)*y(k,5) + mat(k,978) = rxt(k,498)*y(k,5) + 2.000_r8*rxt(k,514)*y(k,16) + rxt(k,516) & + *y(k,18) + 3.000_r8*rxt(k,521)*y(k,24) + rxt(k,500)*y(k,45) + mat(k,708) = rxt(k,492)*y(k,28) + mat(k,1084) = rxt(k,492)*y(k,5) + mat(k,1987) = (rxt(k,570)+rxt(k,575))*y(k,53) + mat(k,308) = (rxt(k,570)+rxt(k,575))*y(k,49) + mat(k,715) = -(4._r8*rxt(k,489)*y(k,5) + (rxt(k,490) + rxt(k,491) + rxt(k,492) & + ) * y(k,28) + rxt(k,493)*y(k,101) + rxt(k,494)*y(k,62) + rxt(k,495) & + *y(k,63) + rxt(k,497)*y(k,70) + rxt(k,498)*y(k,133) + rxt(k,548) & + *y(k,80)) + mat(k,1093) = -(rxt(k,490) + rxt(k,491) + rxt(k,492)) * y(k,5) + mat(k,897) = -rxt(k,493)*y(k,5) + mat(k,1953) = -rxt(k,494)*y(k,5) + mat(k,1801) = -rxt(k,495)*y(k,5) + mat(k,1371) = -rxt(k,497)*y(k,5) + mat(k,980) = -rxt(k,498)*y(k,5) + mat(k,478) = -rxt(k,548)*y(k,5) + mat(k,583) = rxt(k,488)*y(k,73) + mat(k,209) = rxt(k,496)*y(k,70) + mat(k,326) = rxt(k,506)*y(k,71) + mat(k,311) = rxt(k,501)*y(k,70) + mat(k,1371) = mat(k,1371) + rxt(k,496)*y(k,6) + rxt(k,501)*y(k,53) + mat(k,785) = rxt(k,506)*y(k,45) + mat(k,1911) = rxt(k,488)*y(k,3) + mat(k,206) = -(rxt(k,496)*y(k,70)) + mat(k,1349) = -rxt(k,496)*y(k,6) + mat(k,710) = rxt(k,495)*y(k,63) + mat(k,1788) = rxt(k,495)*y(k,5) + mat(k,29) = -(rxt(k,475)*y(k,71)) + mat(k,758) = -rxt(k,475)*y(k,8) + mat(k,55) = -(rxt(k,476)*y(k,71)) + mat(k,763) = -rxt(k,476)*y(k,9) + mat(k,60) = -(rxt(k,502)*y(k,71)) + mat(k,764) = -rxt(k,502)*y(k,10) + mat(k,36) = -(rxt(k,477)*y(k,71)) + mat(k,760) = -rxt(k,477)*y(k,11) + mat(k,65) = -(rxt(k,478)*y(k,71)) + mat(k,765) = -rxt(k,478)*y(k,12) + mat(k,40) = -(rxt(k,479)*y(k,71)) + mat(k,761) = -rxt(k,479)*y(k,13) + mat(k,70) = -(rxt(k,480)*y(k,71)) + mat(k,766) = -rxt(k,480)*y(k,14) + mat(k,44) = -(rxt(k,481)*y(k,71)) + mat(k,762) = -rxt(k,481)*y(k,15) + mat(k,186) = -(rxt(k,513)*y(k,25) + rxt(k,514)*y(k,133) + rxt(k,525)*y(k,71)) + mat(k,1457) = -rxt(k,513)*y(k,16) + mat(k,962) = -rxt(k,514)*y(k,16) + mat(k,775) = -rxt(k,525)*y(k,16) + mat(k,738) = -(rxt(k,450)*y(k,25) + rxt(k,486)*y(k,3) + rxt(k,530)*y(k,64) & + + rxt(k,531)*y(k,70) + rxt(k,532)*y(k,133)) + mat(k,1469) = -rxt(k,450)*y(k,17) + mat(k,584) = -rxt(k,486)*y(k,17) + mat(k,1720) = -rxt(k,530)*y(k,17) + mat(k,1372) = -rxt(k,531)*y(k,17) + mat(k,981) = -rxt(k,532)*y(k,17) + mat(k,433) = rxt(k,457)*y(k,28) + rxt(k,534)*y(k,62) + mat(k,157) = .300_r8*rxt(k,535)*y(k,133) + mat(k,419) = (rxt(k,538)+rxt(k,539))*y(k,71) + mat(k,1094) = rxt(k,457)*y(k,21) + mat(k,1954) = rxt(k,534)*y(k,21) + mat(k,786) = (rxt(k,538)+rxt(k,539))*y(k,23) + mat(k,981) = mat(k,981) + .300_r8*rxt(k,535)*y(k,22) + mat(k,221) = -(rxt(k,515)*y(k,25) + rxt(k,516)*y(k,133) + rxt(k,526)*y(k,71)) + mat(k,1459) = -rxt(k,515)*y(k,18) + mat(k,964) = -rxt(k,516)*y(k,18) + mat(k,776) = -rxt(k,526)*y(k,18) + mat(k,48) = -(rxt(k,517)*y(k,133)) + mat(k,949) = -rxt(k,517)*y(k,19) + mat(k,147) = -(rxt(k,518)*y(k,25) + rxt(k,519)*y(k,133)) + mat(k,1455) = -rxt(k,518)*y(k,20) + mat(k,958) = -rxt(k,519)*y(k,20) + mat(k,432) = -(rxt(k,457)*y(k,28) + rxt(k,533)*y(k,101) + rxt(k,534)*y(k,62)) + mat(k,1090) = -rxt(k,457)*y(k,21) + mat(k,894) = -rxt(k,533)*y(k,21) + mat(k,1946) = -rxt(k,534)*y(k,21) + mat(k,156) = .700_r8*rxt(k,535)*y(k,133) + mat(k,417) = rxt(k,451)*y(k,25) + rxt(k,507)*y(k,39) + rxt(k,537)*y(k,71) & + + rxt(k,536)*y(k,133) + mat(k,1465) = rxt(k,451)*y(k,23) + mat(k,343) = rxt(k,507)*y(k,23) + mat(k,781) = rxt(k,537)*y(k,23) + mat(k,975) = .700_r8*rxt(k,535)*y(k,22) + rxt(k,536)*y(k,23) + mat(k,155) = -(rxt(k,535)*y(k,133)) + mat(k,959) = -rxt(k,535)*y(k,22) + mat(k,431) = rxt(k,533)*y(k,101) + mat(k,887) = rxt(k,533)*y(k,21) + mat(k,416) = -(rxt(k,451)*y(k,25) + rxt(k,507)*y(k,39) + rxt(k,536)*y(k,133) & + + (rxt(k,537) + rxt(k,538) + rxt(k,539)) * y(k,71)) + mat(k,1464) = -rxt(k,451)*y(k,23) + mat(k,342) = -rxt(k,507)*y(k,23) + mat(k,974) = -rxt(k,536)*y(k,23) + mat(k,780) = -(rxt(k,537) + rxt(k,538) + rxt(k,539)) * y(k,23) + mat(k,161) = -(rxt(k,503)*y(k,71) + rxt(k,520)*y(k,25) + rxt(k,521)*y(k,133)) + mat(k,774) = -rxt(k,503)*y(k,24) + mat(k,1456) = -rxt(k,520)*y(k,24) + mat(k,960) = -rxt(k,521)*y(k,24) + mat(k,1487) = -((rxt(k,114) + rxt(k,115)) * y(k,94) + rxt(k,127)*y(k,97) & + + rxt(k,285)*y(k,111) + rxt(k,314)*y(k,127) + rxt(k,341) & + *y(k,134) + rxt(k,350)*y(k,135) + rxt(k,450)*y(k,17) + rxt(k,451) & + *y(k,23) + rxt(k,452)*y(k,41) + rxt(k,453)*y(k,43) + (rxt(k,454) & + + rxt(k,455)) * y(k,101) + rxt(k,456)*y(k,73) + rxt(k,463) & + *y(k,29) + rxt(k,472)*y(k,54) + rxt(k,513)*y(k,16) + rxt(k,515) & + *y(k,18) + rxt(k,518)*y(k,20) + rxt(k,520)*y(k,24)) + mat(k,1024) = -(rxt(k,114) + rxt(k,115)) * y(k,25) + mat(k,848) = -rxt(k,127)*y(k,25) + mat(k,936) = -rxt(k,285)*y(k,25) + mat(k,1564) = -rxt(k,314)*y(k,25) + mat(k,1852) = -rxt(k,341)*y(k,25) + mat(k,1888) = -rxt(k,350)*y(k,25) + mat(k,747) = -rxt(k,450)*y(k,25) + mat(k,425) = -rxt(k,451)*y(k,25) + mat(k,657) = -rxt(k,452)*y(k,25) + mat(k,218) = -rxt(k,453)*y(k,25) + mat(k,909) = -(rxt(k,454) + rxt(k,455)) * y(k,25) + mat(k,1929) = -rxt(k,456)*y(k,25) + mat(k,363) = -rxt(k,463)*y(k,25) + mat(k,337) = -rxt(k,472)*y(k,25) + mat(k,190) = -rxt(k,513)*y(k,25) + mat(k,227) = -rxt(k,515)*y(k,25) + mat(k,152) = -rxt(k,518)*y(k,25) + mat(k,165) = -rxt(k,520)*y(k,25) + mat(k,724) = rxt(k,491)*y(k,28) + mat(k,31) = 4.000_r8*rxt(k,475)*y(k,71) + mat(k,59) = rxt(k,476)*y(k,71) + mat(k,39) = 2.000_r8*rxt(k,477)*y(k,71) + mat(k,69) = 2.000_r8*rxt(k,478)*y(k,71) + mat(k,43) = 2.000_r8*rxt(k,479)*y(k,71) + mat(k,74) = rxt(k,480)*y(k,71) + mat(k,47) = 2.000_r8*rxt(k,481)*y(k,71) + mat(k,50) = 3.000_r8*rxt(k,517)*y(k,133) + mat(k,152) = mat(k,152) + rxt(k,519)*y(k,133) + mat(k,438) = rxt(k,457)*y(k,28) + mat(k,1112) = rxt(k,491)*y(k,5) + rxt(k,457)*y(k,21) + (4.000_r8*rxt(k,458) & + +2.000_r8*rxt(k,460))*y(k,28) + rxt(k,462)*y(k,62) + rxt(k,467) & + *y(k,70) + rxt(k,549)*y(k,80) + rxt(k,468)*y(k,133) + mat(k,88) = rxt(k,512)*y(k,71) + mat(k,84) = rxt(k,527)*y(k,71) + rxt(k,522)*y(k,133) + mat(k,94) = rxt(k,528)*y(k,71) + rxt(k,523)*y(k,133) + mat(k,120) = rxt(k,529)*y(k,71) + rxt(k,524)*y(k,133) + mat(k,2016) = rxt(k,470)*y(k,70) + rxt(k,482)*y(k,71) + rxt(k,471)*y(k,133) + mat(k,1971) = rxt(k,462)*y(k,28) + rxt(k,111)*y(k,93) + mat(k,1819) = rxt(k,110)*y(k,90) + mat(k,1390) = rxt(k,467)*y(k,28) + rxt(k,470)*y(k,49) + mat(k,796) = 4.000_r8*rxt(k,475)*y(k,8) + rxt(k,476)*y(k,9) & + + 2.000_r8*rxt(k,477)*y(k,11) + 2.000_r8*rxt(k,478)*y(k,12) & + + 2.000_r8*rxt(k,479)*y(k,13) + rxt(k,480)*y(k,14) & + + 2.000_r8*rxt(k,481)*y(k,15) + rxt(k,512)*y(k,34) + rxt(k,527) & + *y(k,46) + rxt(k,528)*y(k,47) + rxt(k,529)*y(k,48) + rxt(k,482) & + *y(k,49) + mat(k,484) = rxt(k,549)*y(k,28) + mat(k,820) = rxt(k,110)*y(k,63) + rxt(k,195)*y(k,103) + rxt(k,147)*y(k,105) & + + rxt(k,177)*y(k,107) + rxt(k,248)*y(k,118) + rxt(k,230) & + *y(k,119) + rxt(k,212)*y(k,122) + rxt(k,154)*y(k,128) + mat(k,542) = rxt(k,199)*y(k,103) + rxt(k,164)*y(k,105) + rxt(k,182)*y(k,107) & + + rxt(k,252)*y(k,118) + rxt(k,234)*y(k,119) + rxt(k,217) & + *y(k,122) + rxt(k,159)*y(k,128) + mat(k,526) = rxt(k,187)*y(k,103) + rxt(k,181)*y(k,105) + rxt(k,169)*y(k,107) & + + rxt(k,240)*y(k,118) + rxt(k,222)*y(k,119) + rxt(k,205) & + *y(k,122) + rxt(k,257)*y(k,128) + mat(k,374) = rxt(k,111)*y(k,62) + mat(k,1246) = rxt(k,195)*y(k,90) + rxt(k,199)*y(k,91) + rxt(k,187)*y(k,92) + mat(k,1695) = rxt(k,147)*y(k,90) + rxt(k,164)*y(k,91) + rxt(k,181)*y(k,92) + mat(k,1652) = rxt(k,177)*y(k,90) + rxt(k,182)*y(k,91) + rxt(k,169)*y(k,92) + mat(k,1160) = rxt(k,248)*y(k,90) + rxt(k,252)*y(k,91) + rxt(k,240)*y(k,92) + mat(k,1203) = rxt(k,230)*y(k,90) + rxt(k,234)*y(k,91) + rxt(k,222)*y(k,92) + mat(k,1330) = rxt(k,212)*y(k,90) + rxt(k,217)*y(k,91) + rxt(k,205)*y(k,92) + mat(k,1609) = rxt(k,154)*y(k,90) + rxt(k,159)*y(k,91) + rxt(k,257)*y(k,92) + mat(k,993) = 3.000_r8*rxt(k,517)*y(k,19) + rxt(k,519)*y(k,20) + rxt(k,468) & + *y(k,28) + rxt(k,522)*y(k,46) + rxt(k,523)*y(k,47) + rxt(k,524) & + *y(k,48) + rxt(k,471)*y(k,49) + mat(k,1454) = rxt(k,463)*y(k,29) + mat(k,1083) = 2.000_r8*rxt(k,459)*y(k,28) + mat(k,357) = rxt(k,463)*y(k,25) + (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,49) + mat(k,1986) = (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,29) + (rxt(k,563) & + +rxt(k,569)+rxt(k,574))*y(k,54) + mat(k,332) = (rxt(k,563)+rxt(k,569)+rxt(k,574))*y(k,49) + 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,1082) = 2.000_r8*rxt(k,484)*y(k,28) + mat(k,1104) = -(rxt(k,116)*y(k,94) + rxt(k,128)*y(k,97) + rxt(k,286)*y(k,111) & + + rxt(k,315)*y(k,127) + rxt(k,342)*y(k,134) + rxt(k,351) & + *y(k,135) + rxt(k,457)*y(k,21) + (4._r8*rxt(k,458) & + + 4._r8*rxt(k,459) + 4._r8*rxt(k,460) + 4._r8*rxt(k,484) & + ) * y(k,28) + rxt(k,461)*y(k,101) + rxt(k,462)*y(k,62) + rxt(k,464) & + *y(k,63) + rxt(k,467)*y(k,70) + (rxt(k,468) + rxt(k,469) & + ) * y(k,133) + (rxt(k,490) + rxt(k,491) + rxt(k,492)) * y(k,5) & + + rxt(k,549)*y(k,80)) + mat(k,1016) = -rxt(k,116)*y(k,28) + mat(k,840) = -rxt(k,128)*y(k,28) + mat(k,929) = -rxt(k,286)*y(k,28) + mat(k,1556) = -rxt(k,315)*y(k,28) + mat(k,1844) = -rxt(k,342)*y(k,28) + mat(k,1880) = -rxt(k,351)*y(k,28) + mat(k,436) = -rxt(k,457)*y(k,28) + mat(k,903) = -rxt(k,461)*y(k,28) + mat(k,1963) = -rxt(k,462)*y(k,28) + mat(k,1811) = -rxt(k,464)*y(k,28) + mat(k,1382) = -rxt(k,467)*y(k,28) + mat(k,986) = -(rxt(k,468) + rxt(k,469)) * y(k,28) + mat(k,720) = -(rxt(k,490) + rxt(k,491) + rxt(k,492)) * y(k,28) + mat(k,481) = -rxt(k,549)*y(k,28) + mat(k,1479) = rxt(k,472)*y(k,54) + rxt(k,456)*y(k,73) + rxt(k,455)*y(k,101) + mat(k,361) = rxt(k,465)*y(k,70) + mat(k,2008) = rxt(k,483)*y(k,71) + mat(k,335) = rxt(k,472)*y(k,25) + rxt(k,473)*y(k,70) + rxt(k,474)*y(k,133) + mat(k,1382) = mat(k,1382) + rxt(k,465)*y(k,29) + rxt(k,473)*y(k,54) + mat(k,791) = rxt(k,483)*y(k,49) + mat(k,1921) = rxt(k,456)*y(k,25) + mat(k,137) = rxt(k,554)*y(k,80) + mat(k,481) = mat(k,481) + rxt(k,554)*y(k,74) + mat(k,903) = mat(k,903) + rxt(k,455)*y(k,25) + mat(k,986) = mat(k,986) + rxt(k,474)*y(k,54) + mat(k,359) = -(rxt(k,463)*y(k,25) + rxt(k,465)*y(k,70) + rxt(k,466)*y(k,133) & + + (rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,49)) + mat(k,1462) = -rxt(k,463)*y(k,29) + mat(k,1361) = -rxt(k,465)*y(k,29) + mat(k,973) = -rxt(k,466)*y(k,29) + mat(k,1991) = -(rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,29) + mat(k,1088) = rxt(k,464)*y(k,63) + mat(k,1791) = rxt(k,464)*y(k,28) + mat(k,252) = -(rxt(k,540)*y(k,133)) + mat(k,965) = -rxt(k,540)*y(k,31) + mat(k,580) = rxt(k,486)*y(k,17) + mat(k,733) = rxt(k,486)*y(k,3) + rxt(k,450)*y(k,25) + rxt(k,530)*y(k,64) & + + rxt(k,531)*y(k,70) + rxt(k,532)*y(k,133) + mat(k,148) = rxt(k,518)*y(k,25) + mat(k,1460) = rxt(k,450)*y(k,17) + rxt(k,518)*y(k,20) + mat(k,1263) = rxt(k,594)*y(k,136) + mat(k,1711) = rxt(k,530)*y(k,17) + mat(k,1353) = rxt(k,531)*y(k,17) + rxt(k,543)*y(k,75) + mat(k,140) = rxt(k,543)*y(k,70) + rxt(k,544)*y(k,133) + mat(k,965) = mat(k,965) + rxt(k,532)*y(k,17) + rxt(k,544)*y(k,75) + mat(k,385) = rxt(k,594)*y(k,32) + mat(k,1284) = -(rxt(k,312)*y(k,123) + rxt(k,316)*y(k,127) + rxt(k,330) & + *y(k,130) + rxt(k,335)*y(k,131) + rxt(k,343)*y(k,134) + rxt(k,352) & + *y(k,135) + rxt(k,368)*y(k,118) + rxt(k,594)*y(k,136)) + mat(k,260) = -rxt(k,312)*y(k,32) + mat(k,1560) = -rxt(k,316)*y(k,32) + mat(k,599) = -rxt(k,330)*y(k,32) + mat(k,242) = -rxt(k,335)*y(k,32) + mat(k,1848) = -rxt(k,343)*y(k,32) + mat(k,1884) = -rxt(k,352)*y(k,32) + mat(k,1156) = -rxt(k,368)*y(k,32) + mat(k,394) = -rxt(k,594)*y(k,32) + mat(k,1483) = (rxt(k,114)+rxt(k,115))*y(k,94) + rxt(k,127)*y(k,97) + mat(k,1108) = rxt(k,116)*y(k,94) + rxt(k,128)*y(k,97) + mat(k,255) = rxt(k,540)*y(k,133) + mat(k,1767) = rxt(k,117)*y(k,94) + mat(k,2012) = rxt(k,130)*y(k,97) + mat(k,1524) = rxt(k,124)*y(k,94) + mat(k,1967) = rxt(k,280)*y(k,94) + (rxt(k,122)+rxt(k,123))*y(k,96) + mat(k,1815) = rxt(k,281)*y(k,94) + (rxt(k,120)+rxt(k,121))*y(k,96) + mat(k,1386) = rxt(k,125)*y(k,94) + mat(k,1435) = rxt(k,126)*y(k,94) + mat(k,1925) = rxt(k,132)*y(k,97) + mat(k,1020) = (rxt(k,114)+rxt(k,115))*y(k,25) + rxt(k,116)*y(k,28) & + + rxt(k,117)*y(k,40) + rxt(k,124)*y(k,51) + rxt(k,280)*y(k,62) & + + rxt(k,281)*y(k,63) + rxt(k,125)*y(k,70) + rxt(k,126)*y(k,72) & + + rxt(k,186)*y(k,103) + (rxt(k,170)+rxt(k,258))*y(k,105) + ( & + + rxt(k,168)+rxt(k,265))*y(k,107) + rxt(k,239)*y(k,118) & + + rxt(k,221)*y(k,119) + rxt(k,204)*y(k,122) + rxt(k,256) & + *y(k,128) + mat(k,509) = rxt(k,194)*y(k,103) + (rxt(k,247)+rxt(k,271))*y(k,105) + ( & + + rxt(k,176)+rxt(k,259))*y(k,107) + rxt(k,246)*y(k,118) & + + rxt(k,229)*y(k,119) + rxt(k,211)*y(k,122) + rxt(k,153) & + *y(k,128) + mat(k,677) = (rxt(k,122)+rxt(k,123))*y(k,62) + (rxt(k,120)+rxt(k,121)) & + *y(k,63) + rxt(k,196)*y(k,103) + (rxt(k,158)+rxt(k,260)) & + *y(k,105) + (rxt(k,178)+rxt(k,261))*y(k,107) + rxt(k,249) & + *y(k,118) + rxt(k,231)*y(k,119) + rxt(k,213)*y(k,122) & + + rxt(k,155)*y(k,128) + mat(k,844) = rxt(k,127)*y(k,25) + rxt(k,128)*y(k,28) + rxt(k,130)*y(k,49) & + + rxt(k,132)*y(k,73) + rxt(k,191)*y(k,103) + rxt(k,225)*y(k,105) & + + rxt(k,174)*y(k,107) + rxt(k,244)*y(k,118) + rxt(k,227) & + *y(k,119) + rxt(k,209)*y(k,122) + rxt(k,151)*y(k,128) + mat(k,1063) = rxt(k,306)*y(k,121) + mat(k,495) = rxt(k,189)*y(k,103) + rxt(k,203)*y(k,105) + rxt(k,172)*y(k,107) & + + rxt(k,242)*y(k,118) + rxt(k,224)*y(k,119) + rxt(k,207) & + *y(k,122) + rxt(k,149)*y(k,128) + mat(k,1242) = rxt(k,186)*y(k,94) + rxt(k,194)*y(k,95) + rxt(k,196)*y(k,96) & + + rxt(k,191)*y(k,97) + rxt(k,189)*y(k,100) + mat(k,1691) = (rxt(k,170)+rxt(k,258))*y(k,94) + (rxt(k,247)+rxt(k,271)) & + *y(k,95) + (rxt(k,158)+rxt(k,260))*y(k,96) + rxt(k,225)*y(k,97) & + + rxt(k,203)*y(k,100) + mat(k,1648) = (rxt(k,168)+rxt(k,265))*y(k,94) + (rxt(k,176)+rxt(k,259)) & + *y(k,95) + (rxt(k,178)+rxt(k,261))*y(k,96) + rxt(k,174)*y(k,97) & + + rxt(k,172)*y(k,100) + mat(k,1156) = mat(k,1156) + rxt(k,239)*y(k,94) + rxt(k,246)*y(k,95) & + + rxt(k,249)*y(k,96) + rxt(k,244)*y(k,97) + rxt(k,242)*y(k,100) + mat(k,1199) = rxt(k,221)*y(k,94) + rxt(k,229)*y(k,95) + rxt(k,231)*y(k,96) & + + rxt(k,227)*y(k,97) + rxt(k,224)*y(k,100) + mat(k,267) = rxt(k,306)*y(k,98) + rxt(k,307)*y(k,139) + mat(k,1326) = rxt(k,204)*y(k,94) + rxt(k,211)*y(k,95) + rxt(k,213)*y(k,96) & + + rxt(k,209)*y(k,97) + rxt(k,207)*y(k,100) + mat(k,1605) = rxt(k,256)*y(k,94) + rxt(k,153)*y(k,95) + rxt(k,155)*y(k,96) & + + rxt(k,151)*y(k,97) + rxt(k,149)*y(k,100) + mat(k,989) = rxt(k,540)*y(k,31) + mat(k,2072) = rxt(k,307)*y(k,121) + mat(k,77) = -(rxt(k,511)*y(k,71)) + mat(k,767) = -rxt(k,511)*y(k,33) + mat(k,56) = rxt(k,476)*y(k,71) + mat(k,61) = rxt(k,502)*y(k,71) + mat(k,66) = rxt(k,478)*y(k,71) + mat(k,41) = 2.000_r8*rxt(k,479)*y(k,71) + mat(k,71) = 2.000_r8*rxt(k,480)*y(k,71) + mat(k,45) = rxt(k,481)*y(k,71) + mat(k,33) = 2.000_r8*rxt(k,504)*y(k,71) + mat(k,89) = rxt(k,528)*y(k,71) + rxt(k,523)*y(k,133) + mat(k,115) = rxt(k,529)*y(k,71) + rxt(k,524)*y(k,133) + mat(k,767) = mat(k,767) + rxt(k,476)*y(k,9) + rxt(k,502)*y(k,10) + rxt(k,478) & + *y(k,12) + 2.000_r8*rxt(k,479)*y(k,13) + 2.000_r8*rxt(k,480) & + *y(k,14) + rxt(k,481)*y(k,15) + 2.000_r8*rxt(k,504)*y(k,42) & + + rxt(k,528)*y(k,47) + rxt(k,529)*y(k,48) + mat(k,950) = rxt(k,523)*y(k,47) + rxt(k,524)*y(k,48) + mat(k,85) = -(rxt(k,512)*y(k,71)) + mat(k,769) = -rxt(k,512)*y(k,34) + mat(k,37) = rxt(k,477)*y(k,71) + mat(k,67) = rxt(k,478)*y(k,71) + mat(k,81) = rxt(k,527)*y(k,71) + rxt(k,522)*y(k,133) + mat(k,769) = mat(k,769) + rxt(k,477)*y(k,11) + rxt(k,478)*y(k,12) & + + rxt(k,527)*y(k,46) + mat(k,952) = rxt(k,522)*y(k,46) + mat(k,125) = -(rxt(k,541)*y(k,64) + (rxt(k,542) + rxt(k,556)) * y(k,133)) + mat(k,1710) = -rxt(k,541)*y(k,35) + mat(k,956) = -(rxt(k,542) + rxt(k,556)) * y(k,35) + mat(k,341) = -(rxt(k,507)*y(k,23) + rxt(k,508)*y(k,41) + rxt(k,509)*y(k,139) & + + rxt(k,510)*y(k,51)) + mat(k,415) = -rxt(k,507)*y(k,39) + mat(k,644) = -rxt(k,508)*y(k,39) + mat(k,2044) = -rxt(k,509)*y(k,39) + mat(k,1504) = -rxt(k,510)*y(k,39) + mat(k,62) = rxt(k,502)*y(k,71) + mat(k,72) = rxt(k,480)*y(k,71) + mat(k,78) = 2.000_r8*rxt(k,511)*y(k,71) + mat(k,86) = rxt(k,512)*y(k,71) + mat(k,778) = rxt(k,502)*y(k,10) + rxt(k,480)*y(k,14) + 2.000_r8*rxt(k,511) & + *y(k,33) + rxt(k,512)*y(k,34) + mat(k,1778) = -(rxt(k,105)*y(k,90) + rxt(k,117)*y(k,94) + rxt(k,129)*y(k,97) & + + rxt(k,287)*y(k,111) + rxt(k,309)*y(k,122) + rxt(k,317) & + *y(k,127) + rxt(k,331)*y(k,130) + rxt(k,344)*y(k,134) + (rxt(k,408) & + + rxt(k,409) + rxt(k,410)) * y(k,101) + rxt(k,411)*y(k,72) & + + rxt(k,414)*y(k,73)) + mat(k,825) = -rxt(k,105)*y(k,40) + mat(k,1031) = -rxt(k,117)*y(k,40) + mat(k,854) = -rxt(k,129)*y(k,40) + mat(k,942) = -rxt(k,287)*y(k,40) + mat(k,1337) = -rxt(k,309)*y(k,40) + mat(k,1571) = -rxt(k,317)*y(k,40) + mat(k,603) = -rxt(k,331)*y(k,40) + mat(k,1859) = -rxt(k,344)*y(k,40) + mat(k,914) = -(rxt(k,408) + rxt(k,409) + rxt(k,410)) * y(k,40) + mat(k,1446) = -rxt(k,411)*y(k,40) + mat(k,1936) = -rxt(k,414)*y(k,40) + mat(k,750) = rxt(k,532)*y(k,133) + mat(k,428) = rxt(k,538)*y(k,71) + mat(k,1494) = rxt(k,452)*y(k,41) + mat(k,348) = rxt(k,508)*y(k,41) + mat(k,660) = rxt(k,452)*y(k,25) + rxt(k,508)*y(k,39) + rxt(k,406)*y(k,70) & + + rxt(k,389)*y(k,71) + rxt(k,415)*y(k,133) + rxt(k,354)*y(k,135) + mat(k,330) = rxt(k,506)*y(k,71) + mat(k,2023) = rxt(k,483)*y(k,71) + mat(k,456) = rxt(k,438)*y(k,133) + mat(k,1397) = rxt(k,406)*y(k,41) + rxt(k,418)*y(k,133) + mat(k,801) = rxt(k,538)*y(k,23) + rxt(k,389)*y(k,41) + rxt(k,506)*y(k,45) & + + rxt(k,483)*y(k,49) + mat(k,146) = rxt(k,544)*y(k,133) + mat(k,276) = rxt(k,550)*y(k,133) + mat(k,485) = rxt(k,555)*y(k,133) + mat(k,825) = mat(k,825) + rxt(k,195)*y(k,103) + rxt(k,147)*y(k,105) & + + rxt(k,177)*y(k,107) + mat(k,546) = rxt(k,199)*y(k,103) + rxt(k,164)*y(k,105) + rxt(k,182)*y(k,107) + mat(k,530) = rxt(k,187)*y(k,103) + rxt(k,181)*y(k,105) + rxt(k,169)*y(k,107) + mat(k,1031) = mat(k,1031) + rxt(k,186)*y(k,103) + (rxt(k,170)+rxt(k,258)) & + *y(k,105) + (rxt(k,168)+rxt(k,265))*y(k,107) + mat(k,516) = rxt(k,194)*y(k,103) + (rxt(k,247)+rxt(k,271))*y(k,105) + ( & + + rxt(k,176)+rxt(k,259))*y(k,107) + mat(k,684) = rxt(k,196)*y(k,103) + (rxt(k,158)+rxt(k,260))*y(k,105) + ( & + + rxt(k,178)+rxt(k,261))*y(k,107) + mat(k,854) = mat(k,854) + rxt(k,191)*y(k,103) + rxt(k,225)*y(k,105) & + + rxt(k,174)*y(k,107) + mat(k,1074) = rxt(k,138)*y(k,99) + rxt(k,382)*y(k,102) + rxt(k,383)*y(k,103) & + + rxt(k,141)*y(k,105) + rxt(k,144)*y(k,107) + rxt(k,381) & + *y(k,108) + mat(k,171) = rxt(k,138)*y(k,98) + mat(k,501) = rxt(k,189)*y(k,103) + rxt(k,203)*y(k,105) + rxt(k,172)*y(k,107) + mat(k,250) = rxt(k,382)*y(k,98) + mat(k,1253) = rxt(k,195)*y(k,90) + rxt(k,199)*y(k,91) + rxt(k,187)*y(k,92) & + + rxt(k,186)*y(k,94) + rxt(k,194)*y(k,95) + rxt(k,196)*y(k,96) & + + rxt(k,191)*y(k,97) + rxt(k,383)*y(k,98) + rxt(k,189)*y(k,100) & + + rxt(k,201)*y(k,111) + rxt(k,197)*y(k,112) + rxt(k,200) & + *y(k,114) + rxt(k,193)*y(k,115) + rxt(k,198)*y(k,116) & + + rxt(k,190)*y(k,127) + mat(k,1702) = rxt(k,147)*y(k,90) + rxt(k,164)*y(k,91) + rxt(k,181)*y(k,92) + ( & + + rxt(k,170)+rxt(k,258))*y(k,94) + (rxt(k,247)+rxt(k,271)) & + *y(k,95) + (rxt(k,158)+rxt(k,260))*y(k,96) + rxt(k,225)*y(k,97) & + + rxt(k,141)*y(k,98) + rxt(k,203)*y(k,100) + rxt(k,166)*y(k,111) & + + rxt(k,162)*y(k,112) + rxt(k,165)*y(k,114) + (rxt(k,236) & + +rxt(k,262))*y(k,115) + rxt(k,163)*y(k,116) + rxt(k,214) & + *y(k,127) + mat(k,1659) = rxt(k,177)*y(k,90) + rxt(k,182)*y(k,91) + rxt(k,169)*y(k,92) + ( & + + rxt(k,168)+rxt(k,265))*y(k,94) + (rxt(k,176)+rxt(k,259)) & + *y(k,95) + (rxt(k,178)+rxt(k,261))*y(k,96) + rxt(k,174)*y(k,97) & + + rxt(k,144)*y(k,98) + rxt(k,172)*y(k,100) + rxt(k,184)*y(k,111) & + + rxt(k,179)*y(k,112) + rxt(k,183)*y(k,114) + (rxt(k,175) & + +rxt(k,263))*y(k,115) + rxt(k,180)*y(k,116) + rxt(k,173) & + *y(k,127) + mat(k,287) = rxt(k,381)*y(k,98) + mat(k,942) = mat(k,942) + rxt(k,201)*y(k,103) + rxt(k,166)*y(k,105) & + + rxt(k,184)*y(k,107) + mat(k,560) = rxt(k,197)*y(k,103) + rxt(k,162)*y(k,105) + rxt(k,179)*y(k,107) + mat(k,639) = rxt(k,200)*y(k,103) + rxt(k,165)*y(k,105) + rxt(k,183)*y(k,107) + mat(k,704) = rxt(k,193)*y(k,103) + (rxt(k,236)+rxt(k,262))*y(k,105) + ( & + + rxt(k,175)+rxt(k,263))*y(k,107) + mat(k,576) = rxt(k,198)*y(k,103) + rxt(k,163)*y(k,105) + rxt(k,180)*y(k,107) + mat(k,1571) = mat(k,1571) + rxt(k,190)*y(k,103) + rxt(k,214)*y(k,105) & + + rxt(k,173)*y(k,107) + mat(k,998) = rxt(k,532)*y(k,17) + rxt(k,415)*y(k,41) + rxt(k,438)*y(k,56) & + + rxt(k,418)*y(k,70) + rxt(k,544)*y(k,75) + rxt(k,550)*y(k,78) & + + rxt(k,555)*y(k,80) + mat(k,1895) = rxt(k,354)*y(k,41) + 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,647) = -((rxt(k,353) + rxt(k,354)) * y(k,135) + rxt(k,389)*y(k,71) & + + rxt(k,406)*y(k,70) + rxt(k,415)*y(k,133) + rxt(k,452)*y(k,25) & + + rxt(k,508)*y(k,39)) + mat(k,1870) = -(rxt(k,353) + rxt(k,354)) * y(k,41) + mat(k,784) = -rxt(k,389)*y(k,41) + mat(k,1370) = -rxt(k,406)*y(k,41) + mat(k,979) = -rxt(k,415)*y(k,41) + mat(k,1467) = -rxt(k,452)*y(k,41) + mat(k,344) = -rxt(k,508)*y(k,41) + mat(k,418) = rxt(k,539)*y(k,71) + mat(k,1752) = rxt(k,408)*y(k,101) + mat(k,784) = mat(k,784) + rxt(k,539)*y(k,23) + mat(k,896) = rxt(k,408)*y(k,40) + mat(k,32) = -(rxt(k,504)*y(k,71)) + mat(k,759) = -rxt(k,504)*y(k,42) + mat(k,214) = -(rxt(k,407)*y(k,70) + rxt(k,416)*y(k,133) + rxt(k,453)*y(k,25)) + mat(k,1350) = -rxt(k,407)*y(k,43) + mat(k,963) = -rxt(k,416)*y(k,43) + mat(k,1458) = -rxt(k,453)*y(k,43) + mat(k,889) = 2.000_r8*rxt(k,422)*y(k,101) + mat(k,963) = mat(k,963) + 2.000_r8*rxt(k,421)*y(k,133) + mat(k,102) = rxt(k,557)*y(k,139) + mat(k,2031) = rxt(k,557)*y(k,82) + mat(k,324) = -(rxt(k,499)*y(k,70) + rxt(k,500)*y(k,133) + (rxt(k,505) & + + rxt(k,506)) * y(k,71)) + mat(k,1358) = -rxt(k,499)*y(k,45) + mat(k,969) = -rxt(k,500)*y(k,45) + mat(k,777) = -(rxt(k,505) + rxt(k,506)) * y(k,45) + mat(k,581) = rxt(k,486)*y(k,17) + rxt(k,487)*y(k,101) + mat(k,734) = rxt(k,486)*y(k,3) + mat(k,892) = rxt(k,487)*y(k,3) + mat(k,80) = -(rxt(k,522)*y(k,133) + rxt(k,527)*y(k,71)) + mat(k,951) = -rxt(k,522)*y(k,46) + mat(k,768) = -rxt(k,527)*y(k,46) + mat(k,90) = -(rxt(k,523)*y(k,133) + rxt(k,528)*y(k,71)) + mat(k,953) = -rxt(k,523)*y(k,47) + mat(k,770) = -rxt(k,528)*y(k,47) + mat(k,116) = -(rxt(k,524)*y(k,133) + rxt(k,529)*y(k,71)) + mat(k,955) = -rxt(k,524)*y(k,48) + mat(k,772) = -rxt(k,529)*y(k,48) + mat(k,2029) = -(rxt(k,106)*y(k,91) + rxt(k,108)*y(k,90) + rxt(k,130)*y(k,97) & + + (rxt(k,276) + rxt(k,298)) * y(k,113) + rxt(k,289)*y(k,111) & + + rxt(k,318)*y(k,127) + rxt(k,345)*y(k,134) + rxt(k,356) & + *y(k,135) + rxt(k,470)*y(k,70) + rxt(k,471)*y(k,133) + (rxt(k,482) & + + rxt(k,483)) * y(k,71) + (rxt(k,563) + rxt(k,569) + rxt(k,574) & + ) * y(k,54) + (rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,29) & + + (rxt(k,570) + rxt(k,575)) * y(k,53)) + mat(k,548) = -rxt(k,106)*y(k,49) + mat(k,828) = -rxt(k,108)*y(k,49) + mat(k,860) = -rxt(k,130)*y(k,49) + mat(k,885) = -(rxt(k,276) + rxt(k,298)) * y(k,49) + mat(k,947) = -rxt(k,289)*y(k,49) + mat(k,1577) = -rxt(k,318)*y(k,49) + mat(k,1865) = -rxt(k,345)*y(k,49) + mat(k,1901) = -rxt(k,356)*y(k,49) + mat(k,1403) = -rxt(k,470)*y(k,49) + mat(k,1004) = -rxt(k,471)*y(k,49) + mat(k,807) = -(rxt(k,482) + rxt(k,483)) * y(k,49) + mat(k,338) = -(rxt(k,563) + rxt(k,569) + rxt(k,574)) * y(k,49) + mat(k,367) = -(rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,49) + mat(k,315) = -(rxt(k,570) + rxt(k,575)) * y(k,49) + mat(k,191) = rxt(k,513)*y(k,25) + mat(k,756) = rxt(k,450)*y(k,25) + mat(k,228) = rxt(k,515)*y(k,25) + mat(k,153) = 2.000_r8*rxt(k,518)*y(k,25) + mat(k,429) = rxt(k,451)*y(k,25) + mat(k,166) = rxt(k,520)*y(k,25) + mat(k,1500) = rxt(k,513)*y(k,16) + rxt(k,450)*y(k,17) + rxt(k,515)*y(k,18) & + + 2.000_r8*rxt(k,518)*y(k,20) + rxt(k,451)*y(k,23) + rxt(k,520) & + *y(k,24) + rxt(k,452)*y(k,41) + rxt(k,453)*y(k,43) + rxt(k,472) & + *y(k,54) + rxt(k,454)*y(k,101) + mat(k,1125) = rxt(k,469)*y(k,133) + mat(k,1784) = rxt(k,105)*y(k,90) + mat(k,665) = rxt(k,452)*y(k,25) + mat(k,219) = rxt(k,453)*y(k,25) + mat(k,1541) = rxt(k,109)*y(k,90) + rxt(k,299)*y(k,116) + mat(k,338) = mat(k,338) + rxt(k,472)*y(k,25) + mat(k,828) = mat(k,828) + rxt(k,105)*y(k,40) + rxt(k,109)*y(k,51) + mat(k,532) = rxt(k,187)*y(k,103) + (rxt(k,181)+2.000_r8*rxt(k,267))*y(k,105) + ( & + + rxt(k,169)+2.000_r8*rxt(k,268))*y(k,107) + rxt(k,240)*y(k,118) & + + rxt(k,222)*y(k,119) + rxt(k,205)*y(k,122) + rxt(k,257) & + *y(k,128) + mat(k,920) = rxt(k,454)*y(k,25) + mat(k,1259) = rxt(k,187)*y(k,92) + rxt(k,198)*y(k,116) + mat(k,1708) = (rxt(k,181)+2.000_r8*rxt(k,267))*y(k,92) + rxt(k,163)*y(k,116) + mat(k,1665) = (rxt(k,169)+2.000_r8*rxt(k,268))*y(k,92) + rxt(k,180)*y(k,116) + mat(k,578) = rxt(k,299)*y(k,51) + rxt(k,198)*y(k,103) + rxt(k,163)*y(k,105) & + + rxt(k,180)*y(k,107) + rxt(k,251)*y(k,118) + rxt(k,233) & + *y(k,119) + rxt(k,216)*y(k,122) + rxt(k,157)*y(k,128) + mat(k,1173) = rxt(k,240)*y(k,92) + rxt(k,251)*y(k,116) + mat(k,1216) = rxt(k,222)*y(k,92) + rxt(k,233)*y(k,116) + mat(k,1343) = rxt(k,205)*y(k,92) + rxt(k,216)*y(k,116) + mat(k,1622) = rxt(k,257)*y(k,92) + rxt(k,157)*y(k,116) + mat(k,1004) = mat(k,1004) + rxt(k,469)*y(k,28) + mat(k,413) = rxt(k,507)*y(k,39) + mat(k,340) = rxt(k,507)*y(k,23) + rxt(k,508)*y(k,41) + rxt(k,510)*y(k,51) & + + rxt(k,509)*y(k,139) + mat(k,643) = rxt(k,508)*y(k,39) + mat(k,1502) = rxt(k,510)*y(k,39) + mat(k,2035) = rxt(k,509)*y(k,39) + mat(k,1529) = -(rxt(k,109)*y(k,90) + rxt(k,124)*y(k,94) + rxt(k,290)*y(k,111) & + + rxt(k,295)*y(k,115) + rxt(k,299)*y(k,116) + rxt(k,300) & + *y(k,113) + rxt(k,319)*y(k,127) + rxt(k,357)*y(k,135) + rxt(k,447) & + *y(k,133) + rxt(k,510)*y(k,39)) + mat(k,821) = -rxt(k,109)*y(k,51) + mat(k,1025) = -rxt(k,124)*y(k,51) + mat(k,937) = -rxt(k,290)*y(k,51) + mat(k,699) = -rxt(k,295)*y(k,51) + mat(k,571) = -rxt(k,299)*y(k,51) + mat(k,876) = -rxt(k,300)*y(k,51) + mat(k,1565) = -rxt(k,319)*y(k,51) + mat(k,1889) = -rxt(k,357)*y(k,51) + mat(k,994) = -rxt(k,447)*y(k,51) + mat(k,346) = -rxt(k,510)*y(k,51) + mat(k,748) = rxt(k,530)*y(k,64) + mat(k,364) = (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,49) + mat(k,129) = rxt(k,541)*y(k,64) + mat(k,2017) = (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,29) + rxt(k,298) & + *y(k,113) + mat(k,406) = rxt(k,142)*y(k,105) + rxt(k,145)*y(k,107) + rxt(k,293)*y(k,114) & + + rxt(k,297)*y(k,115) + mat(k,1820) = rxt(k,446)*y(k,133) + mat(k,1736) = rxt(k,530)*y(k,17) + rxt(k,541)*y(k,35) + mat(k,1247) = rxt(k,188)*y(k,113) + 2.000_r8*rxt(k,185)*y(k,117) + mat(k,108) = rxt(k,140)*y(k,139) + mat(k,1696) = rxt(k,142)*y(k,58) + (rxt(k,192)+rxt(k,264))*y(k,113) + ( & + + 2.000_r8*rxt(k,146)+2.000_r8*rxt(k,269))*y(k,117) + mat(k,112) = rxt(k,143)*y(k,139) + mat(k,1653) = rxt(k,145)*y(k,58) + (rxt(k,171)+rxt(k,266))*y(k,113) + ( & + + 2.000_r8*rxt(k,167)+2.000_r8*rxt(k,270))*y(k,117) + mat(k,876) = mat(k,876) + rxt(k,298)*y(k,49) + rxt(k,188)*y(k,103) + ( & + + rxt(k,192)+rxt(k,264))*y(k,105) + (rxt(k,171)+rxt(k,266)) & + *y(k,107) + mat(k,634) = rxt(k,293)*y(k,58) + mat(k,699) = mat(k,699) + rxt(k,297)*y(k,58) + mat(k,616) = 2.000_r8*rxt(k,185)*y(k,103) + (2.000_r8*rxt(k,146) & + +2.000_r8*rxt(k,269))*y(k,105) + (2.000_r8*rxt(k,167) & + +2.000_r8*rxt(k,270))*y(k,107) + rxt(k,238)*y(k,118) & + + rxt(k,220)*y(k,119) + rxt(k,202)*y(k,122) + rxt(k,255) & + *y(k,128) + mat(k,1161) = rxt(k,238)*y(k,117) + mat(k,1204) = rxt(k,220)*y(k,117) + mat(k,1331) = rxt(k,202)*y(k,117) + mat(k,1610) = rxt(k,255)*y(k,117) + mat(k,994) = mat(k,994) + rxt(k,446)*y(k,63) + mat(k,2077) = rxt(k,140)*y(k,104) + rxt(k,143)*y(k,106) + mat(k,179) = -(rxt(k,423)*y(k,133)) + mat(k,961) = -rxt(k,423)*y(k,52) + mat(k,1787) = rxt(k,444)*y(k,101) + mat(k,888) = rxt(k,444)*y(k,63) + mat(k,309) = -(rxt(k,501)*y(k,70) + (rxt(k,570) + rxt(k,575)) * y(k,49)) + mat(k,1356) = -rxt(k,501)*y(k,53) + mat(k,1989) = -(rxt(k,570) + rxt(k,575)) * y(k,53) + mat(k,711) = rxt(k,493)*y(k,101) + mat(k,891) = rxt(k,493)*y(k,5) + mat(k,333) = -(rxt(k,472)*y(k,25) + rxt(k,473)*y(k,70) + rxt(k,474)*y(k,133) & + + (rxt(k,563) + rxt(k,569) + rxt(k,574)) * y(k,49)) + mat(k,1461) = -rxt(k,472)*y(k,54) + mat(k,1359) = -rxt(k,473)*y(k,54) + mat(k,970) = -rxt(k,474)*y(k,54) + mat(k,1990) = -(rxt(k,563) + rxt(k,569) + rxt(k,574)) * y(k,54) + mat(k,1086) = rxt(k,461)*y(k,101) + mat(k,358) = rxt(k,466)*y(k,133) + mat(k,893) = rxt(k,461)*y(k,28) + mat(k,970) = mat(k,970) + rxt(k,466)*y(k,29) + mat(k,278) = -(rxt(k,340)*y(k,133)) + mat(k,967) = -rxt(k,340)*y(k,55) + mat(k,1988) = rxt(k,289)*y(k,111) + mat(k,1503) = rxt(k,290)*y(k,111) + mat(k,1944) = rxt(k,349)*y(k,133) + mat(k,922) = rxt(k,289)*y(k,49) + rxt(k,290)*y(k,51) + mat(k,174) = rxt(k,305)*y(k,139) + mat(k,967) = mat(k,967) + rxt(k,349)*y(k,62) + mat(k,2041) = rxt(k,305)*y(k,120) + mat(k,446) = -(rxt(k,426)*y(k,62) + (rxt(k,427) + rxt(k,428) + rxt(k,429) & + ) * y(k,63) + rxt(k,430)*y(k,72) + rxt(k,438)*y(k,133) + rxt(k,591) & + *y(k,128)) + mat(k,1947) = -rxt(k,426)*y(k,56) + mat(k,1793) = -(rxt(k,427) + rxt(k,428) + rxt(k,429)) * y(k,56) + mat(k,1416) = -rxt(k,430)*y(k,56) + mat(k,976) = -rxt(k,438)*y(k,56) + mat(k,1580) = -rxt(k,591)*y(k,56) + mat(k,1365) = rxt(k,424)*y(k,109) + rxt(k,588)*y(k,124) + mat(k,1416) = mat(k,1416) + rxt(k,589)*y(k,124) + mat(k,1053) = 1.100_r8*rxt(k,584)*y(k,110) + .200_r8*rxt(k,582)*y(k,118) + mat(k,303) = rxt(k,424)*y(k,70) + mat(k,233) = 1.100_r8*rxt(k,584)*y(k,98) + mat(k,1132) = .200_r8*rxt(k,582)*y(k,98) + mat(k,319) = rxt(k,588)*y(k,70) + rxt(k,589)*y(k,72) + mat(k,98) = -((rxt(k,442) + rxt(k,443)) * y(k,71)) + mat(k,771) = -(rxt(k,442) + rxt(k,443)) * y(k,57) + mat(k,443) = rxt(k,427)*y(k,63) + mat(k,1786) = rxt(k,427)*y(k,56) + mat(k,401) = -(rxt(k,142)*y(k,105) + rxt(k,145)*y(k,107) + rxt(k,293) & + *y(k,114) + rxt(k,297)*y(k,115)) + mat(k,1668) = -rxt(k,142)*y(k,58) + mat(k,1625) = -rxt(k,145)*y(k,58) + mat(k,623) = -rxt(k,293)*y(k,58) + mat(k,688) = -rxt(k,297)*y(k,58) + mat(k,1792) = rxt(k,445)*y(k,64) + mat(k,1713) = rxt(k,445)*y(k,63) + 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,1983) = -((rxt(k,111) + rxt(k,112)) * y(k,93) + (rxt(k,122) + rxt(k,123) & + ) * y(k,96) + rxt(k,136)*y(k,135) + (rxt(k,272) + rxt(k,279) & + ) * y(k,130) + rxt(k,280)*y(k,94) + rxt(k,349)*y(k,133) & + + rxt(k,426)*y(k,56) + rxt(k,435)*y(k,64) + rxt(k,439)*y(k,101) & + + rxt(k,440)*y(k,73) + rxt(k,441)*y(k,70) + rxt(k,462)*y(k,28) & + + rxt(k,494)*y(k,5) + rxt(k,534)*y(k,21) + rxt(k,593)*y(k,128)) + mat(k,376) = -(rxt(k,111) + rxt(k,112)) * y(k,62) + mat(k,686) = -(rxt(k,122) + rxt(k,123)) * y(k,62) + mat(k,1900) = -rxt(k,136)*y(k,62) + mat(k,608) = -(rxt(k,272) + rxt(k,279)) * y(k,62) + mat(k,1036) = -rxt(k,280)*y(k,62) + mat(k,1003) = -rxt(k,349)*y(k,62) + mat(k,458) = -rxt(k,426)*y(k,62) + mat(k,1747) = -rxt(k,435)*y(k,62) + mat(k,919) = -rxt(k,439)*y(k,62) + mat(k,1941) = -rxt(k,440)*y(k,62) + mat(k,1402) = -rxt(k,441)*y(k,62) + mat(k,1124) = -rxt(k,462)*y(k,62) + mat(k,730) = -rxt(k,494)*y(k,62) + mat(k,441) = -rxt(k,534)*y(k,62) + mat(k,1621) = -rxt(k,593)*y(k,62) + mat(k,1783) = rxt(k,287)*y(k,111) + rxt(k,309)*y(k,122) + mat(k,458) = mat(k,458) + 2.000_r8*rxt(k,428)*y(k,63) + rxt(k,430)*y(k,72) & + + rxt(k,438)*y(k,133) + mat(k,101) = 2.000_r8*rxt(k,442)*y(k,71) + mat(k,1831) = 2.000_r8*rxt(k,428)*y(k,56) + rxt(k,431)*y(k,70) + rxt(k,551) & + *y(k,80) + rxt(k,291)*y(k,111) + mat(k,1402) = mat(k,1402) + rxt(k,431)*y(k,63) + mat(k,806) = 2.000_r8*rxt(k,442)*y(k,57) + mat(k,1451) = rxt(k,430)*y(k,56) + rxt(k,425)*y(k,109) + mat(k,488) = rxt(k,551)*y(k,63) + mat(k,827) = rxt(k,248)*y(k,118) + rxt(k,230)*y(k,119) + rxt(k,212)*y(k,122) + mat(k,547) = rxt(k,252)*y(k,118) + rxt(k,234)*y(k,119) + rxt(k,217)*y(k,122) + mat(k,531) = rxt(k,240)*y(k,118) + rxt(k,222)*y(k,119) + rxt(k,205)*y(k,122) + mat(k,1036) = mat(k,1036) + rxt(k,239)*y(k,118) + rxt(k,221)*y(k,119) & + + rxt(k,204)*y(k,122) + mat(k,517) = rxt(k,246)*y(k,118) + rxt(k,229)*y(k,119) + rxt(k,211)*y(k,122) + mat(k,686) = mat(k,686) + rxt(k,249)*y(k,118) + rxt(k,231)*y(k,119) & + + rxt(k,213)*y(k,122) + mat(k,859) = rxt(k,244)*y(k,118) + rxt(k,227)*y(k,119) + rxt(k,209)*y(k,122) + mat(k,1079) = rxt(k,303)*y(k,119) + rxt(k,304)*y(k,120) + rxt(k,306)*y(k,121) & + + rxt(k,308)*y(k,122) + rxt(k,384)*y(k,123) + mat(k,502) = rxt(k,242)*y(k,118) + rxt(k,224)*y(k,119) + rxt(k,207)*y(k,122) + mat(k,307) = rxt(k,425)*y(k,72) + mat(k,946) = rxt(k,287)*y(k,40) + rxt(k,291)*y(k,63) + rxt(k,254)*y(k,118) & + + rxt(k,237)*y(k,119) + rxt(k,219)*y(k,122) + mat(k,562) = rxt(k,250)*y(k,118) + rxt(k,232)*y(k,119) + rxt(k,215)*y(k,122) + mat(k,884) = rxt(k,241)*y(k,118) + rxt(k,223)*y(k,119) + rxt(k,206)*y(k,122) + mat(k,641) = rxt(k,253)*y(k,118) + rxt(k,235)*y(k,119) + rxt(k,218)*y(k,122) + mat(k,706) = rxt(k,245)*y(k,118) + rxt(k,228)*y(k,119) + rxt(k,210)*y(k,122) + mat(k,577) = rxt(k,251)*y(k,118) + rxt(k,233)*y(k,119) + rxt(k,216)*y(k,122) + mat(k,621) = rxt(k,238)*y(k,118) + rxt(k,220)*y(k,119) + rxt(k,202)*y(k,122) + mat(k,1172) = rxt(k,248)*y(k,90) + rxt(k,252)*y(k,91) + rxt(k,240)*y(k,92) & + + rxt(k,239)*y(k,94) + rxt(k,246)*y(k,95) + rxt(k,249)*y(k,96) & + + rxt(k,244)*y(k,97) + rxt(k,242)*y(k,100) + rxt(k,254)*y(k,111) & + + rxt(k,250)*y(k,112) + rxt(k,241)*y(k,113) + rxt(k,253) & + *y(k,114) + rxt(k,245)*y(k,115) + rxt(k,251)*y(k,116) & + + rxt(k,238)*y(k,117) + rxt(k,243)*y(k,127) + mat(k,1215) = rxt(k,230)*y(k,90) + rxt(k,234)*y(k,91) + rxt(k,222)*y(k,92) & + + rxt(k,221)*y(k,94) + rxt(k,229)*y(k,95) + rxt(k,231)*y(k,96) & + + rxt(k,227)*y(k,97) + rxt(k,303)*y(k,98) + rxt(k,224)*y(k,100) & + + rxt(k,237)*y(k,111) + rxt(k,232)*y(k,112) + rxt(k,223) & + *y(k,113) + rxt(k,235)*y(k,114) + rxt(k,228)*y(k,115) & + + rxt(k,233)*y(k,116) + rxt(k,220)*y(k,117) + rxt(k,226) & + *y(k,127) + mat(k,177) = rxt(k,304)*y(k,98) + mat(k,269) = rxt(k,306)*y(k,98) + mat(k,1342) = rxt(k,309)*y(k,40) + rxt(k,212)*y(k,90) + rxt(k,217)*y(k,91) & + + rxt(k,205)*y(k,92) + rxt(k,204)*y(k,94) + rxt(k,211)*y(k,95) & + + rxt(k,213)*y(k,96) + rxt(k,209)*y(k,97) + rxt(k,308)*y(k,98) & + + rxt(k,207)*y(k,100) + rxt(k,219)*y(k,111) + rxt(k,215) & + *y(k,112) + rxt(k,206)*y(k,113) + rxt(k,218)*y(k,114) & + + rxt(k,210)*y(k,115) + rxt(k,216)*y(k,116) + rxt(k,202) & + *y(k,117) + rxt(k,208)*y(k,127) + mat(k,262) = rxt(k,384)*y(k,98) + mat(k,1576) = rxt(k,243)*y(k,118) + rxt(k,226)*y(k,119) + rxt(k,208)*y(k,122) + mat(k,1003) = mat(k,1003) + rxt(k,438)*y(k,56) + mat(k,1827) = -(rxt(k,110)*y(k,90) + (rxt(k,120) + rxt(k,121)) * y(k,96) & + + (rxt(k,277) + rxt(k,278)) * y(k,130) + rxt(k,281)*y(k,94) & + + rxt(k,291)*y(k,111) + rxt(k,320)*y(k,127) + rxt(k,346) & + *y(k,134) + rxt(k,359)*y(k,135) + (rxt(k,427) + rxt(k,428) & + + rxt(k,429)) * y(k,56) + (rxt(k,431) + rxt(k,433)) * y(k,70) & + + rxt(k,432)*y(k,73) + rxt(k,444)*y(k,101) + rxt(k,445)*y(k,64) & + + rxt(k,446)*y(k,133) + rxt(k,464)*y(k,28) + rxt(k,495)*y(k,5) & + + rxt(k,551)*y(k,80)) + mat(k,826) = -rxt(k,110)*y(k,63) + mat(k,685) = -(rxt(k,120) + rxt(k,121)) * y(k,63) + mat(k,604) = -(rxt(k,277) + rxt(k,278)) * y(k,63) + mat(k,1032) = -rxt(k,281)*y(k,63) + mat(k,943) = -rxt(k,291)*y(k,63) + mat(k,1572) = -rxt(k,320)*y(k,63) + mat(k,1860) = -rxt(k,346)*y(k,63) + mat(k,1896) = -rxt(k,359)*y(k,63) + mat(k,457) = -(rxt(k,427) + rxt(k,428) + rxt(k,429)) * y(k,63) + mat(k,1398) = -(rxt(k,431) + rxt(k,433)) * y(k,63) + mat(k,1937) = -rxt(k,432)*y(k,63) + mat(k,915) = -rxt(k,444)*y(k,63) + mat(k,1743) = -rxt(k,445)*y(k,63) + mat(k,999) = -rxt(k,446)*y(k,63) + mat(k,1120) = -rxt(k,464)*y(k,63) + mat(k,728) = -rxt(k,495)*y(k,63) + mat(k,486) = -rxt(k,551)*y(k,63) + mat(k,728) = mat(k,728) + rxt(k,494)*y(k,62) + mat(k,440) = rxt(k,534)*y(k,62) + mat(k,1495) = rxt(k,285)*y(k,111) + mat(k,1120) = mat(k,1120) + rxt(k,462)*y(k,62) + mat(k,184) = rxt(k,423)*y(k,133) + mat(k,280) = rxt(k,340)*y(k,133) + mat(k,1979) = rxt(k,494)*y(k,5) + rxt(k,534)*y(k,21) + rxt(k,462)*y(k,28) & + + 2.000_r8*rxt(k,435)*y(k,64) + rxt(k,441)*y(k,70) + rxt(k,440) & + *y(k,73) + rxt(k,112)*y(k,93) + rxt(k,439)*y(k,101) + rxt(k,136) & + *y(k,135) + mat(k,1743) = mat(k,1743) + 2.000_r8*rxt(k,435)*y(k,62) + rxt(k,436)*y(k,70) & + + rxt(k,434)*y(k,101) + rxt(k,437)*y(k,133) + mat(k,1398) = mat(k,1398) + rxt(k,441)*y(k,62) + rxt(k,436)*y(k,64) + mat(k,1937) = mat(k,1937) + rxt(k,440)*y(k,62) + mat(k,375) = rxt(k,112)*y(k,62) + mat(k,915) = mat(k,915) + rxt(k,439)*y(k,62) + rxt(k,434)*y(k,64) + mat(k,1254) = rxt(k,201)*y(k,111) + rxt(k,197)*y(k,112) + mat(k,1703) = rxt(k,166)*y(k,111) + rxt(k,162)*y(k,112) + mat(k,1660) = rxt(k,184)*y(k,111) + rxt(k,179)*y(k,112) + mat(k,943) = mat(k,943) + rxt(k,285)*y(k,25) + rxt(k,201)*y(k,103) & + + rxt(k,166)*y(k,105) + rxt(k,184)*y(k,107) + rxt(k,254) & + *y(k,118) + rxt(k,237)*y(k,119) + rxt(k,219)*y(k,122) & + + rxt(k,161)*y(k,128) + mat(k,561) = rxt(k,197)*y(k,103) + rxt(k,162)*y(k,105) + rxt(k,179)*y(k,107) & + + rxt(k,250)*y(k,118) + rxt(k,232)*y(k,119) + rxt(k,215) & + *y(k,122) + rxt(k,156)*y(k,128) + mat(k,1168) = rxt(k,254)*y(k,111) + rxt(k,250)*y(k,112) + mat(k,1211) = rxt(k,237)*y(k,111) + rxt(k,232)*y(k,112) + mat(k,1338) = rxt(k,219)*y(k,111) + rxt(k,215)*y(k,112) + rxt(k,311)*y(k,133) + mat(k,1617) = rxt(k,161)*y(k,111) + rxt(k,156)*y(k,112) + mat(k,999) = mat(k,999) + rxt(k,423)*y(k,52) + rxt(k,340)*y(k,55) & + + rxt(k,437)*y(k,64) + rxt(k,311)*y(k,122) + mat(k,1896) = mat(k,1896) + rxt(k,136)*y(k,62) + mat(k,1741) = -(rxt(k,434)*y(k,101) + rxt(k,435)*y(k,62) + rxt(k,436)*y(k,70) & + + rxt(k,437)*y(k,133) + rxt(k,445)*y(k,63) + rxt(k,530)*y(k,17) & + + rxt(k,541)*y(k,35)) + mat(k,913) = -rxt(k,434)*y(k,64) + mat(k,1977) = -rxt(k,435)*y(k,64) + mat(k,1396) = -rxt(k,436)*y(k,64) + mat(k,997) = -rxt(k,437)*y(k,64) + mat(k,1825) = -rxt(k,445)*y(k,64) + mat(k,749) = -rxt(k,530)*y(k,64) + mat(k,130) = -rxt(k,541)*y(k,64) + mat(k,212) = rxt(k,496)*y(k,70) + mat(k,1493) = rxt(k,463)*y(k,29) + mat(k,1118) = rxt(k,286)*y(k,111) + mat(k,365) = rxt(k,463)*y(k,25) + rxt(k,465)*y(k,70) + rxt(k,466)*y(k,133) + mat(k,347) = rxt(k,510)*y(k,51) + mat(k,1534) = rxt(k,510)*y(k,39) + rxt(k,447)*y(k,133) + mat(k,1825) = mat(k,1825) + rxt(k,433)*y(k,70) + rxt(k,432)*y(k,73) + mat(k,1396) = mat(k,1396) + rxt(k,496)*y(k,6) + rxt(k,465)*y(k,29) & + + rxt(k,433)*y(k,63) + mat(k,1935) = rxt(k,432)*y(k,63) + mat(k,913) = mat(k,913) + rxt(k,310)*y(k,122) + mat(k,1252) = rxt(k,200)*y(k,114) + rxt(k,193)*y(k,115) + rxt(k,198)*y(k,116) + mat(k,1701) = rxt(k,165)*y(k,114) + (rxt(k,236)+rxt(k,262))*y(k,115) & + + rxt(k,163)*y(k,116) + mat(k,1658) = rxt(k,183)*y(k,114) + (rxt(k,175)+rxt(k,263))*y(k,115) & + + rxt(k,180)*y(k,116) + mat(k,941) = rxt(k,286)*y(k,28) + mat(k,880) = rxt(k,241)*y(k,118) + rxt(k,223)*y(k,119) + rxt(k,206)*y(k,122) & + + rxt(k,148)*y(k,128) + mat(k,638) = rxt(k,200)*y(k,103) + rxt(k,165)*y(k,105) + rxt(k,183)*y(k,107) & + + rxt(k,253)*y(k,118) + rxt(k,235)*y(k,119) + rxt(k,218) & + *y(k,122) + rxt(k,160)*y(k,128) + mat(k,703) = rxt(k,193)*y(k,103) + (rxt(k,236)+rxt(k,262))*y(k,105) + ( & + + rxt(k,175)+rxt(k,263))*y(k,107) + rxt(k,245)*y(k,118) & + + rxt(k,228)*y(k,119) + rxt(k,210)*y(k,122) + rxt(k,152) & + *y(k,128) + mat(k,575) = rxt(k,198)*y(k,103) + rxt(k,163)*y(k,105) + rxt(k,180)*y(k,107) & + + rxt(k,251)*y(k,118) + rxt(k,233)*y(k,119) + rxt(k,216) & + *y(k,122) + rxt(k,157)*y(k,128) + mat(k,620) = rxt(k,238)*y(k,118) + rxt(k,220)*y(k,119) + rxt(k,202)*y(k,122) & + + rxt(k,255)*y(k,128) + mat(k,1166) = rxt(k,241)*y(k,113) + rxt(k,253)*y(k,114) + rxt(k,245)*y(k,115) & + + rxt(k,251)*y(k,116) + rxt(k,238)*y(k,117) + mat(k,1209) = rxt(k,223)*y(k,113) + rxt(k,235)*y(k,114) + rxt(k,228)*y(k,115) & + + rxt(k,233)*y(k,116) + rxt(k,220)*y(k,117) + mat(k,1336) = rxt(k,310)*y(k,101) + rxt(k,206)*y(k,113) + rxt(k,218)*y(k,114) & + + rxt(k,210)*y(k,115) + rxt(k,216)*y(k,116) + rxt(k,202) & + *y(k,117) + mat(k,1615) = rxt(k,148)*y(k,113) + rxt(k,160)*y(k,114) + rxt(k,152)*y(k,115) & + + rxt(k,157)*y(k,116) + rxt(k,255)*y(k,117) + mat(k,997) = mat(k,997) + rxt(k,466)*y(k,29) + rxt(k,447)*y(k,51) + mat(k,1388) = -(rxt(k,113)*y(k,93) + rxt(k,125)*y(k,94) + rxt(k,131)*y(k,97) & + + rxt(k,301)*y(k,113) + (rxt(k,324) + rxt(k,325)) * y(k,127) & + + (rxt(k,333) + rxt(k,334)) * y(k,130) + rxt(k,336)*y(k,131) & + + rxt(k,338)*y(k,132) + rxt(k,347)*y(k,134) + rxt(k,360) & + *y(k,135) + rxt(k,403)*y(k,73) + 4._r8*rxt(k,404)*y(k,70) & + + rxt(k,405)*y(k,72) + rxt(k,406)*y(k,41) + rxt(k,407)*y(k,43) & + + rxt(k,412)*y(k,101) + rxt(k,418)*y(k,133) + (rxt(k,431) & + + rxt(k,433)) * y(k,63) + rxt(k,436)*y(k,64) + rxt(k,441) & + *y(k,62) + rxt(k,465)*y(k,29) + rxt(k,467)*y(k,28) + rxt(k,470) & + *y(k,49) + rxt(k,473)*y(k,54) + rxt(k,496)*y(k,6) + rxt(k,497) & + *y(k,5) + rxt(k,499)*y(k,45) + rxt(k,501)*y(k,53) + rxt(k,531) & + *y(k,17) + rxt(k,543)*y(k,75) + (rxt(k,586) + rxt(k,587) & + ) * y(k,110) + rxt(k,588)*y(k,124)) + mat(k,372) = -rxt(k,113)*y(k,70) + mat(k,1022) = -rxt(k,125)*y(k,70) + mat(k,846) = -rxt(k,131)*y(k,70) + mat(k,873) = -rxt(k,301)*y(k,70) + mat(k,1562) = -(rxt(k,324) + rxt(k,325)) * y(k,70) + mat(k,600) = -(rxt(k,333) + rxt(k,334)) * y(k,70) + mat(k,243) = -rxt(k,336)*y(k,70) + mat(k,465) = -rxt(k,338)*y(k,70) + mat(k,1850) = -rxt(k,347)*y(k,70) + mat(k,1886) = -rxt(k,360)*y(k,70) + mat(k,1927) = -rxt(k,403)*y(k,70) + mat(k,1437) = -rxt(k,405)*y(k,70) + mat(k,655) = -rxt(k,406)*y(k,70) + mat(k,217) = -rxt(k,407)*y(k,70) + mat(k,907) = -rxt(k,412)*y(k,70) + mat(k,991) = -rxt(k,418)*y(k,70) + mat(k,1817) = -(rxt(k,431) + rxt(k,433)) * y(k,70) + mat(k,1733) = -rxt(k,436)*y(k,70) + mat(k,1969) = -rxt(k,441)*y(k,70) + mat(k,362) = -rxt(k,465)*y(k,70) + mat(k,1110) = -rxt(k,467)*y(k,70) + mat(k,2014) = -rxt(k,470)*y(k,70) + mat(k,336) = -rxt(k,473)*y(k,70) + mat(k,210) = -rxt(k,496)*y(k,70) + mat(k,722) = -rxt(k,497)*y(k,70) + mat(k,329) = -rxt(k,499)*y(k,70) + mat(k,313) = -rxt(k,501)*y(k,70) + mat(k,745) = -rxt(k,531)*y(k,70) + mat(k,145) = -rxt(k,543)*y(k,70) + mat(k,236) = -(rxt(k,586) + rxt(k,587)) * y(k,70) + mat(k,321) = -rxt(k,588)*y(k,70) + mat(k,1485) = rxt(k,114)*y(k,94) + rxt(k,350)*y(k,135) + mat(k,1769) = rxt(k,410)*y(k,101) + mat(k,453) = rxt(k,426)*y(k,62) + rxt(k,427)*y(k,63) + rxt(k,430)*y(k,72) & + + rxt(k,591)*y(k,128) + mat(k,1969) = mat(k,1969) + rxt(k,426)*y(k,56) + rxt(k,272)*y(k,130) + mat(k,1817) = mat(k,1817) + rxt(k,427)*y(k,56) + rxt(k,359)*y(k,135) + mat(k,794) = (rxt(k,392)+rxt(k,393))*y(k,72) + mat(k,1437) = mat(k,1437) + rxt(k,430)*y(k,56) + (rxt(k,392)+rxt(k,393)) & + *y(k,71) + rxt(k,545)*y(k,78) + rxt(k,552)*y(k,80) + rxt(k,590) & + *y(k,124) + rxt(k,597)*y(k,136) + rxt(k,601)*y(k,137) + mat(k,1927) = mat(k,1927) + rxt(k,363)*y(k,135) + mat(k,274) = rxt(k,545)*y(k,72) + mat(k,482) = rxt(k,552)*y(k,72) + mat(k,1022) = mat(k,1022) + rxt(k,114)*y(k,25) + rxt(k,186)*y(k,103) + ( & + + rxt(k,170)+rxt(k,258))*y(k,105) + (rxt(k,168)+rxt(k,265)) & + *y(k,107) + rxt(k,239)*y(k,118) + rxt(k,221)*y(k,119) & + + rxt(k,204)*y(k,122) + rxt(k,256)*y(k,128) + mat(k,511) = rxt(k,194)*y(k,103) + (rxt(k,247)+rxt(k,271))*y(k,105) + ( & + + rxt(k,176)+rxt(k,259))*y(k,107) + rxt(k,246)*y(k,118) & + + rxt(k,229)*y(k,119) + rxt(k,211)*y(k,122) + rxt(k,153) & + *y(k,128) + mat(k,679) = rxt(k,196)*y(k,103) + (rxt(k,158)+rxt(k,260))*y(k,105) + ( & + + rxt(k,178)+rxt(k,261))*y(k,107) + rxt(k,249)*y(k,118) & + + rxt(k,231)*y(k,119) + rxt(k,213)*y(k,122) + rxt(k,155) & + *y(k,128) + mat(k,1065) = rxt(k,582)*y(k,118) + 1.150_r8*rxt(k,583)*y(k,128) + mat(k,907) = mat(k,907) + rxt(k,410)*y(k,40) + mat(k,1244) = rxt(k,186)*y(k,94) + rxt(k,194)*y(k,95) + rxt(k,196)*y(k,96) + mat(k,1693) = (rxt(k,170)+rxt(k,258))*y(k,94) + (rxt(k,247)+rxt(k,271)) & + *y(k,95) + (rxt(k,158)+rxt(k,260))*y(k,96) + mat(k,1650) = (rxt(k,168)+rxt(k,265))*y(k,94) + (rxt(k,176)+rxt(k,259)) & + *y(k,95) + (rxt(k,178)+rxt(k,261))*y(k,96) + mat(k,305) = rxt(k,596)*y(k,136) + mat(k,1158) = rxt(k,239)*y(k,94) + rxt(k,246)*y(k,95) + rxt(k,249)*y(k,96) & + + rxt(k,582)*y(k,98) + mat(k,1201) = rxt(k,221)*y(k,94) + rxt(k,229)*y(k,95) + rxt(k,231)*y(k,96) + mat(k,1328) = rxt(k,204)*y(k,94) + rxt(k,211)*y(k,95) + rxt(k,213)*y(k,96) + mat(k,321) = mat(k,321) + rxt(k,590)*y(k,72) + mat(k,1607) = rxt(k,591)*y(k,56) + rxt(k,256)*y(k,94) + rxt(k,153)*y(k,95) & + + rxt(k,155)*y(k,96) + 1.150_r8*rxt(k,583)*y(k,98) + mat(k,600) = mat(k,600) + rxt(k,272)*y(k,62) + mat(k,991) = mat(k,991) + 2.000_r8*rxt(k,420)*y(k,133) + mat(k,1886) = mat(k,1886) + rxt(k,350)*y(k,25) + rxt(k,359)*y(k,63) & + + rxt(k,363)*y(k,73) + mat(k,395) = rxt(k,597)*y(k,72) + rxt(k,596)*y(k,109) + mat(k,203) = rxt(k,601)*y(k,72) + 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,787) = -(rxt(k,389)*y(k,41) + rxt(k,390)*y(k,139) + (rxt(k,392) & + + rxt(k,393)) * y(k,72) + rxt(k,394)*y(k,73) + (rxt(k,442) & + + rxt(k,443)) * y(k,57) + rxt(k,475)*y(k,8) + rxt(k,476)*y(k,9) & + + rxt(k,477)*y(k,11) + rxt(k,478)*y(k,12) + rxt(k,479)*y(k,13) & + + rxt(k,480)*y(k,14) + rxt(k,481)*y(k,15) + (rxt(k,482) & + + rxt(k,483)) * y(k,49) + rxt(k,502)*y(k,10) + rxt(k,503) & + *y(k,24) + rxt(k,504)*y(k,42) + (rxt(k,505) + rxt(k,506) & + ) * y(k,45) + rxt(k,511)*y(k,33) + rxt(k,512)*y(k,34) + rxt(k,525) & + *y(k,16) + rxt(k,526)*y(k,18) + rxt(k,527)*y(k,46) + rxt(k,528) & + *y(k,47) + rxt(k,529)*y(k,48) + (rxt(k,537) + rxt(k,538) & + + rxt(k,539)) * y(k,23)) + mat(k,649) = -rxt(k,389)*y(k,71) + mat(k,2060) = -rxt(k,390)*y(k,71) + mat(k,1423) = -(rxt(k,392) + rxt(k,393)) * y(k,71) + mat(k,1913) = -rxt(k,394)*y(k,71) + mat(k,99) = -(rxt(k,442) + rxt(k,443)) * y(k,71) + mat(k,30) = -rxt(k,475)*y(k,71) + mat(k,58) = -rxt(k,476)*y(k,71) + mat(k,38) = -rxt(k,477)*y(k,71) + mat(k,68) = -rxt(k,478)*y(k,71) + mat(k,42) = -rxt(k,479)*y(k,71) + mat(k,73) = -rxt(k,480)*y(k,71) + mat(k,46) = -rxt(k,481)*y(k,71) + mat(k,1999) = -(rxt(k,482) + rxt(k,483)) * y(k,71) + mat(k,64) = -rxt(k,502)*y(k,71) + mat(k,163) = -rxt(k,503)*y(k,71) + mat(k,35) = -rxt(k,504)*y(k,71) + mat(k,327) = -(rxt(k,505) + rxt(k,506)) * y(k,71) + mat(k,79) = -rxt(k,511)*y(k,71) + mat(k,87) = -rxt(k,512)*y(k,71) + mat(k,188) = -rxt(k,525)*y(k,71) + mat(k,224) = -rxt(k,526)*y(k,71) + mat(k,82) = -rxt(k,527)*y(k,71) + mat(k,92) = -rxt(k,528)*y(k,71) + mat(k,118) = -rxt(k,529)*y(k,71) + mat(k,420) = -(rxt(k,537) + rxt(k,538) + rxt(k,539)) * y(k,71) + mat(k,1423) = mat(k,1423) + rxt(k,425)*y(k,109) + mat(k,1055) = .850_r8*rxt(k,583)*y(k,128) + mat(k,304) = rxt(k,425)*y(k,72) + mat(k,1592) = .850_r8*rxt(k,583)*y(k,98) + mat(k,1438) = -(rxt(k,126)*y(k,94) + (rxt(k,133) + rxt(k,135)) * y(k,98) & + + rxt(k,322)*y(k,127) + rxt(k,362)*y(k,135) + rxt(k,364) & + *y(k,128) + rxt(k,392)*y(k,71) + rxt(k,397)*y(k,125) + rxt(k,405) & + *y(k,70) + rxt(k,411)*y(k,40) + rxt(k,425)*y(k,109) + rxt(k,430) & + *y(k,56) + rxt(k,545)*y(k,78) + rxt(k,552)*y(k,80) + rxt(k,585) & + *y(k,110) + (rxt(k,589) + rxt(k,590)) * y(k,124) + rxt(k,597) & + *y(k,136) + rxt(k,601)*y(k,137)) + mat(k,1023) = -rxt(k,126)*y(k,72) + mat(k,1066) = -(rxt(k,133) + rxt(k,135)) * y(k,72) + mat(k,1563) = -rxt(k,322)*y(k,72) + mat(k,1887) = -rxt(k,362)*y(k,72) + mat(k,1608) = -rxt(k,364)*y(k,72) + mat(k,795) = -rxt(k,392)*y(k,72) + mat(k,380) = -rxt(k,397)*y(k,72) + mat(k,1389) = -rxt(k,405)*y(k,72) + mat(k,1770) = -rxt(k,411)*y(k,72) + mat(k,306) = -rxt(k,425)*y(k,72) + mat(k,454) = -rxt(k,430)*y(k,72) + mat(k,275) = -rxt(k,545)*y(k,72) + mat(k,483) = -rxt(k,552)*y(k,72) + mat(k,237) = -rxt(k,585)*y(k,72) + mat(k,322) = -(rxt(k,589) + rxt(k,590)) * y(k,72) + mat(k,396) = -rxt(k,597)*y(k,72) + mat(k,204) = -rxt(k,601)*y(k,72) + mat(k,590) = rxt(k,488)*y(k,73) + rxt(k,487)*y(k,101) + mat(k,723) = 2.000_r8*rxt(k,489)*y(k,5) + (rxt(k,491)+rxt(k,492))*y(k,28) & + + rxt(k,497)*y(k,70) + rxt(k,493)*y(k,101) + mat(k,437) = rxt(k,533)*y(k,101) + mat(k,1486) = rxt(k,456)*y(k,73) + rxt(k,127)*y(k,97) + rxt(k,454)*y(k,101) & + + rxt(k,314)*y(k,127) + mat(k,1111) = (rxt(k,491)+rxt(k,492))*y(k,5) + (2.000_r8*rxt(k,458) & + +2.000_r8*rxt(k,459))*y(k,28) + rxt(k,467)*y(k,70) + rxt(k,116) & + *y(k,94) + rxt(k,128)*y(k,97) + rxt(k,461)*y(k,101) + rxt(k,315) & + *y(k,127) + rxt(k,469)*y(k,133) + rxt(k,351)*y(k,135) + mat(k,1287) = rxt(k,330)*y(k,130) + rxt(k,335)*y(k,131) + mat(k,1770) = mat(k,1770) + rxt(k,414)*y(k,73) + rxt(k,408)*y(k,101) & + + rxt(k,331)*y(k,130) + mat(k,182) = rxt(k,423)*y(k,133) + mat(k,454) = mat(k,454) + rxt(k,429)*y(k,63) + mat(k,100) = rxt(k,443)*y(k,71) + mat(k,1970) = rxt(k,440)*y(k,73) + rxt(k,593)*y(k,128) + rxt(k,279)*y(k,130) + mat(k,1818) = rxt(k,429)*y(k,56) + rxt(k,431)*y(k,70) + rxt(k,432)*y(k,73) & + + rxt(k,320)*y(k,127) + rxt(k,277)*y(k,130) + mat(k,1734) = rxt(k,436)*y(k,70) + rxt(k,434)*y(k,101) + mat(k,1389) = mat(k,1389) + rxt(k,497)*y(k,5) + rxt(k,467)*y(k,28) & + + rxt(k,431)*y(k,63) + rxt(k,436)*y(k,64) + 2.000_r8*rxt(k,404) & + *y(k,70) + 2.000_r8*rxt(k,403)*y(k,73) + rxt(k,113)*y(k,93) & + + rxt(k,131)*y(k,97) + rxt(k,412)*y(k,101) + rxt(k,301)*y(k,113) & + + rxt(k,396)*y(k,125) + rxt(k,325)*y(k,127) + ( & + + 2.000_r8*rxt(k,333)+rxt(k,334))*y(k,130) + rxt(k,336)*y(k,131) & + + rxt(k,418)*y(k,133) + rxt(k,360)*y(k,135) + mat(k,795) = mat(k,795) + rxt(k,443)*y(k,57) + 2.000_r8*rxt(k,394)*y(k,73) + mat(k,1438) = mat(k,1438) + 2.000_r8*rxt(k,397)*y(k,125) + mat(k,1928) = rxt(k,488)*y(k,3) + rxt(k,456)*y(k,25) + rxt(k,414)*y(k,40) & + + rxt(k,440)*y(k,62) + rxt(k,432)*y(k,63) + 2.000_r8*rxt(k,403) & + *y(k,70) + 2.000_r8*rxt(k,394)*y(k,71) + rxt(k,547)*y(k,78) & + + rxt(k,553)*y(k,80) + rxt(k,132)*y(k,97) + rxt(k,134)*y(k,98) & + + 2.000_r8*rxt(k,413)*y(k,101) + rxt(k,292)*y(k,111) & + + 2.000_r8*rxt(k,302)*y(k,113) + rxt(k,323)*y(k,127) & + + 3.000_r8*rxt(k,332)*y(k,130) + rxt(k,419)*y(k,133) + mat(k,275) = mat(k,275) + rxt(k,547)*y(k,73) + mat(k,483) = mat(k,483) + rxt(k,553)*y(k,73) + mat(k,819) = rxt(k,154)*y(k,128) + mat(k,541) = rxt(k,159)*y(k,128) + mat(k,525) = rxt(k,257)*y(k,128) + mat(k,373) = rxt(k,113)*y(k,70) + mat(k,1023) = mat(k,1023) + rxt(k,116)*y(k,28) + rxt(k,256)*y(k,128) + mat(k,512) = rxt(k,153)*y(k,128) + mat(k,680) = rxt(k,155)*y(k,128) + mat(k,847) = rxt(k,127)*y(k,25) + rxt(k,128)*y(k,28) + rxt(k,131)*y(k,70) & + + rxt(k,132)*y(k,73) + rxt(k,191)*y(k,103) + rxt(k,225)*y(k,105) & + + rxt(k,174)*y(k,107) + rxt(k,244)*y(k,118) + rxt(k,227) & + *y(k,119) + rxt(k,209)*y(k,122) + 2.000_r8*rxt(k,151)*y(k,128) + mat(k,1066) = mat(k,1066) + rxt(k,134)*y(k,73) + rxt(k,326)*y(k,129) & + + 2.000_r8*rxt(k,380)*y(k,132) + mat(k,497) = rxt(k,149)*y(k,128) + mat(k,908) = rxt(k,487)*y(k,3) + rxt(k,493)*y(k,5) + rxt(k,533)*y(k,21) & + + rxt(k,454)*y(k,25) + rxt(k,461)*y(k,28) + rxt(k,408)*y(k,40) & + + rxt(k,434)*y(k,64) + rxt(k,412)*y(k,70) + 2.000_r8*rxt(k,413) & + *y(k,73) + 2.000_r8*rxt(k,422)*y(k,101) + rxt(k,417)*y(k,133) + mat(k,1245) = rxt(k,191)*y(k,97) + rxt(k,190)*y(k,127) + mat(k,1694) = rxt(k,225)*y(k,97) + rxt(k,214)*y(k,127) + mat(k,1651) = rxt(k,174)*y(k,97) + rxt(k,173)*y(k,127) + mat(k,935) = rxt(k,292)*y(k,73) + rxt(k,161)*y(k,128) + mat(k,556) = rxt(k,156)*y(k,128) + mat(k,874) = rxt(k,301)*y(k,70) + 2.000_r8*rxt(k,302)*y(k,73) + rxt(k,148) & + *y(k,128) + mat(k,633) = rxt(k,160)*y(k,128) + mat(k,698) = rxt(k,152)*y(k,128) + mat(k,570) = rxt(k,157)*y(k,128) + mat(k,615) = rxt(k,255)*y(k,128) + mat(k,1159) = rxt(k,244)*y(k,97) + rxt(k,243)*y(k,127) + mat(k,1202) = rxt(k,227)*y(k,97) + rxt(k,226)*y(k,127) + mat(k,1329) = rxt(k,209)*y(k,97) + rxt(k,208)*y(k,127) + mat(k,380) = mat(k,380) + rxt(k,396)*y(k,70) + 2.000_r8*rxt(k,397)*y(k,72) & + + 2.000_r8*rxt(k,321)*y(k,127) + 2.000_r8*rxt(k,339)*y(k,132) + mat(k,1563) = mat(k,1563) + rxt(k,314)*y(k,25) + rxt(k,315)*y(k,28) & + + rxt(k,320)*y(k,63) + rxt(k,325)*y(k,70) + rxt(k,323)*y(k,73) & + + rxt(k,190)*y(k,103) + rxt(k,214)*y(k,105) + rxt(k,173) & + *y(k,107) + rxt(k,243)*y(k,118) + rxt(k,226)*y(k,119) & + + rxt(k,208)*y(k,122) + 2.000_r8*rxt(k,321)*y(k,125) + mat(k,1608) = mat(k,1608) + rxt(k,593)*y(k,62) + rxt(k,154)*y(k,90) & + + rxt(k,159)*y(k,91) + rxt(k,257)*y(k,92) + rxt(k,256)*y(k,94) & + + rxt(k,153)*y(k,95) + rxt(k,155)*y(k,96) + 2.000_r8*rxt(k,151) & + *y(k,97) + rxt(k,149)*y(k,100) + rxt(k,161)*y(k,111) & + + rxt(k,156)*y(k,112) + rxt(k,148)*y(k,113) + rxt(k,160) & + *y(k,114) + rxt(k,152)*y(k,115) + rxt(k,157)*y(k,116) & + + rxt(k,255)*y(k,117) + mat(k,296) = rxt(k,326)*y(k,98) + (rxt(k,327)+rxt(k,328))*y(k,139) + mat(k,601) = rxt(k,330)*y(k,32) + rxt(k,331)*y(k,40) + rxt(k,279)*y(k,62) & + + rxt(k,277)*y(k,63) + (2.000_r8*rxt(k,333)+rxt(k,334))*y(k,70) & + + 3.000_r8*rxt(k,332)*y(k,73) + mat(k,244) = rxt(k,335)*y(k,32) + rxt(k,336)*y(k,70) + mat(k,466) = 2.000_r8*rxt(k,380)*y(k,98) + 2.000_r8*rxt(k,339)*y(k,125) & + + rxt(k,337)*y(k,139) + mat(k,992) = rxt(k,469)*y(k,28) + rxt(k,423)*y(k,52) + rxt(k,418)*y(k,70) & + + rxt(k,419)*y(k,73) + rxt(k,417)*y(k,101) + mat(k,1887) = mat(k,1887) + rxt(k,351)*y(k,28) + rxt(k,360)*y(k,70) + mat(k,2075) = (rxt(k,327)+rxt(k,328))*y(k,129) + rxt(k,337)*y(k,132) + mat(k,1940) = -(rxt(k,132)*y(k,97) + rxt(k,134)*y(k,98) + rxt(k,292)*y(k,111) & + + rxt(k,302)*y(k,113) + rxt(k,323)*y(k,127) + rxt(k,332) & + *y(k,130) + rxt(k,348)*y(k,134) + rxt(k,363)*y(k,135) + rxt(k,394) & + *y(k,71) + rxt(k,403)*y(k,70) + rxt(k,413)*y(k,101) + rxt(k,414) & + *y(k,40) + rxt(k,419)*y(k,133) + rxt(k,432)*y(k,63) + rxt(k,440) & + *y(k,62) + rxt(k,456)*y(k,25) + rxt(k,488)*y(k,3) + rxt(k,547) & + *y(k,78) + rxt(k,553)*y(k,80)) + mat(k,858) = -rxt(k,132)*y(k,73) + mat(k,1078) = -rxt(k,134)*y(k,73) + mat(k,945) = -rxt(k,292)*y(k,73) + mat(k,883) = -rxt(k,302)*y(k,73) + mat(k,1575) = -rxt(k,323)*y(k,73) + mat(k,607) = -rxt(k,332)*y(k,73) + mat(k,1863) = -rxt(k,348)*y(k,73) + mat(k,1899) = -rxt(k,363)*y(k,73) + mat(k,805) = -rxt(k,394)*y(k,73) + mat(k,1401) = -rxt(k,403)*y(k,73) + mat(k,918) = -rxt(k,413)*y(k,73) + mat(k,1782) = -rxt(k,414)*y(k,73) + mat(k,1002) = -rxt(k,419)*y(k,73) + mat(k,1830) = -rxt(k,432)*y(k,73) + mat(k,1982) = -rxt(k,440)*y(k,73) + mat(k,1498) = -rxt(k,456)*y(k,73) + mat(k,592) = -rxt(k,488)*y(k,73) + mat(k,277) = -rxt(k,547)*y(k,73) + mat(k,487) = -rxt(k,553)*y(k,73) + mat(k,1830) = mat(k,1830) + rxt(k,278)*y(k,130) + mat(k,1401) = mat(k,1401) + rxt(k,405)*y(k,72) + rxt(k,324)*y(k,127) & + + rxt(k,338)*y(k,132) + mat(k,1450) = rxt(k,405)*y(k,70) + mat(k,384) = rxt(k,361)*y(k,135) + mat(k,1575) = mat(k,1575) + rxt(k,324)*y(k,70) + mat(k,607) = mat(k,607) + rxt(k,278)*y(k,63) + mat(k,471) = rxt(k,338)*y(k,70) + mat(k,1899) = mat(k,1899) + rxt(k,361)*y(k,125) + mat(k,134) = -(rxt(k,554)*y(k,80)) + mat(k,473) = -rxt(k,554)*y(k,74) + mat(k,709) = rxt(k,490)*y(k,28) + mat(k,1085) = rxt(k,490)*y(k,5) + 2.000_r8*rxt(k,460)*y(k,28) + mat(k,139) = -(rxt(k,543)*y(k,70) + rxt(k,544)*y(k,133)) + mat(k,1346) = -rxt(k,543)*y(k,75) + mat(k,957) = -rxt(k,544)*y(k,75) + mat(k,271) = -(rxt(k,545)*y(k,72) + rxt(k,547)*y(k,73) + rxt(k,550)*y(k,133)) + mat(k,1410) = -rxt(k,545)*y(k,78) + mat(k,1904) = -rxt(k,547)*y(k,78) + mat(k,966) = -rxt(k,550)*y(k,78) + mat(k,476) = -(rxt(k,548)*y(k,5) + rxt(k,549)*y(k,28) + rxt(k,551)*y(k,63) & + + rxt(k,552)*y(k,72) + rxt(k,553)*y(k,73) + rxt(k,554)*y(k,74) & + + rxt(k,555)*y(k,133)) + mat(k,713) = -rxt(k,548)*y(k,80) + mat(k,1091) = -rxt(k,549)*y(k,80) + mat(k,1794) = -rxt(k,551)*y(k,80) + mat(k,1418) = -rxt(k,552)*y(k,80) + mat(k,1908) = -rxt(k,553)*y(k,80) + mat(k,136) = -rxt(k,554)*y(k,80) + mat(k,977) = -rxt(k,555)*y(k,80) + mat(k,1367) = rxt(k,543)*y(k,75) + mat(k,1418) = mat(k,1418) + rxt(k,545)*y(k,78) + mat(k,1908) = mat(k,1908) + rxt(k,547)*y(k,78) + mat(k,143) = rxt(k,543)*y(k,70) + mat(k,272) = rxt(k,545)*y(k,72) + rxt(k,547)*y(k,73) + rxt(k,550)*y(k,133) + mat(k,977) = mat(k,977) + rxt(k,550)*y(k,78) + 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,351) = -(rxt(k,546)*y(k,133)) + mat(k,972) = -rxt(k,546)*y(k,81) + mat(k,712) = rxt(k,548)*y(k,80) + mat(k,1087) = rxt(k,549)*y(k,80) + mat(k,126) = rxt(k,541)*y(k,64) + (rxt(k,542)+.500_r8*rxt(k,556))*y(k,133) + mat(k,1790) = rxt(k,551)*y(k,80) + mat(k,1712) = rxt(k,541)*y(k,35) + mat(k,1413) = rxt(k,552)*y(k,80) + mat(k,1905) = rxt(k,553)*y(k,80) + mat(k,135) = rxt(k,554)*y(k,80) + mat(k,142) = rxt(k,544)*y(k,133) + mat(k,475) = rxt(k,548)*y(k,5) + rxt(k,549)*y(k,28) + rxt(k,551)*y(k,63) & + + rxt(k,552)*y(k,72) + rxt(k,553)*y(k,73) + rxt(k,554)*y(k,74) & + + rxt(k,555)*y(k,133) + mat(k,972) = mat(k,972) + (rxt(k,542)+.500_r8*rxt(k,556))*y(k,35) & + + rxt(k,544)*y(k,75) + rxt(k,555)*y(k,80) + mat(k,103) = -(rxt(k,557)*y(k,139)) + mat(k,2032) = -rxt(k,557)*y(k,82) + mat(k,350) = rxt(k,546)*y(k,133) + mat(k,954) = rxt(k,546)*y(k,81) + mat(k,811) = -(rxt(k,105)*y(k,40) + rxt(k,107)*y(k,139) + rxt(k,108)*y(k,49) & + + rxt(k,109)*y(k,51) + rxt(k,110)*y(k,63) + rxt(k,147)*y(k,105) & + + rxt(k,154)*y(k,128) + rxt(k,177)*y(k,107) + rxt(k,195) & + *y(k,103) + rxt(k,212)*y(k,122) + rxt(k,230)*y(k,119) + rxt(k,248) & + *y(k,118)) + mat(k,1755) = -rxt(k,105)*y(k,90) + mat(k,2061) = -rxt(k,107)*y(k,90) + mat(k,2000) = -rxt(k,108)*y(k,90) + mat(k,1513) = -rxt(k,109)*y(k,90) + mat(k,1804) = -rxt(k,110)*y(k,90) + mat(k,1679) = -rxt(k,147)*y(k,90) + mat(k,1593) = -rxt(k,154)*y(k,90) + mat(k,1636) = -rxt(k,177)*y(k,90) + mat(k,1230) = -rxt(k,195)*y(k,90) + mat(k,1314) = -rxt(k,212)*y(k,90) + mat(k,1187) = -rxt(k,230)*y(k,90) + mat(k,1144) = -rxt(k,248)*y(k,90) + mat(k,1471) = rxt(k,114)*y(k,94) + rxt(k,127)*y(k,97) + rxt(k,285)*y(k,111) & + + rxt(k,314)*y(k,127) + rxt(k,341)*y(k,134) + rxt(k,350) & + *y(k,135) + mat(k,1096) = rxt(k,116)*y(k,94) + rxt(k,286)*y(k,111) + rxt(k,351)*y(k,135) + mat(k,2000) = mat(k,2000) + rxt(k,130)*y(k,97) + rxt(k,289)*y(k,111) & + + rxt(k,298)*y(k,113) + rxt(k,318)*y(k,127) + rxt(k,345) & + *y(k,134) + rxt(k,356)*y(k,135) + mat(k,1956) = rxt(k,112)*y(k,93) + mat(k,1374) = rxt(k,113)*y(k,93) + mat(k,370) = rxt(k,112)*y(k,62) + rxt(k,113)*y(k,70) + mat(k,1010) = rxt(k,114)*y(k,25) + rxt(k,116)*y(k,28) + mat(k,832) = rxt(k,127)*y(k,25) + rxt(k,130)*y(k,49) + mat(k,924) = rxt(k,285)*y(k,25) + rxt(k,286)*y(k,28) + rxt(k,289)*y(k,49) + mat(k,865) = rxt(k,298)*y(k,49) + mat(k,1548) = rxt(k,314)*y(k,25) + rxt(k,318)*y(k,49) + mat(k,1837) = rxt(k,341)*y(k,25) + rxt(k,345)*y(k,49) + mat(k,1873) = rxt(k,350)*y(k,25) + rxt(k,351)*y(k,28) + rxt(k,356)*y(k,49) + mat(k,535) = -(rxt(k,106)*y(k,49) + rxt(k,159)*y(k,128) + rxt(k,164)*y(k,105) & + + rxt(k,182)*y(k,107) + rxt(k,199)*y(k,103) + rxt(k,217) & + *y(k,122) + rxt(k,234)*y(k,119) + rxt(k,252)*y(k,118)) + mat(k,1993) = -rxt(k,106)*y(k,91) + mat(k,1585) = -rxt(k,159)*y(k,91) + mat(k,1672) = -rxt(k,164)*y(k,91) + mat(k,1629) = -rxt(k,182)*y(k,91) + mat(k,1223) = -rxt(k,199)*y(k,91) + mat(k,1307) = -rxt(k,217)*y(k,91) + mat(k,1180) = -rxt(k,234)*y(k,91) + mat(k,1136) = -rxt(k,252)*y(k,91) + mat(k,810) = rxt(k,107)*y(k,139) + mat(k,2051) = rxt(k,107)*y(k,90) + mat(k,519) = -((rxt(k,169) + rxt(k,268)) * y(k,107) + (rxt(k,181) + rxt(k,267) & + ) * y(k,105) + rxt(k,187)*y(k,103) + rxt(k,205)*y(k,122) & + + rxt(k,222)*y(k,119) + rxt(k,240)*y(k,118) + rxt(k,257) & + *y(k,128)) + mat(k,1628) = -(rxt(k,169) + rxt(k,268)) * y(k,92) + mat(k,1671) = -(rxt(k,181) + rxt(k,267)) * y(k,92) + mat(k,1222) = -rxt(k,187)*y(k,92) + mat(k,1306) = -rxt(k,205)*y(k,92) + mat(k,1179) = -rxt(k,222)*y(k,92) + mat(k,1135) = -rxt(k,240)*y(k,92) + mat(k,1584) = -rxt(k,257)*y(k,92) + mat(k,1992) = rxt(k,108)*y(k,90) + rxt(k,106)*y(k,91) + mat(k,809) = rxt(k,108)*y(k,49) + mat(k,534) = rxt(k,106)*y(k,49) + mat(k,369) = -((rxt(k,111) + rxt(k,112)) * y(k,62) + rxt(k,113)*y(k,70)) + mat(k,1945) = -(rxt(k,111) + rxt(k,112)) * y(k,93) + mat(k,1362) = -rxt(k,113)*y(k,93) + mat(k,1463) = rxt(k,115)*y(k,94) + mat(k,1089) = rxt(k,128)*y(k,97) + rxt(k,315)*y(k,127) + rxt(k,342)*y(k,134) + mat(k,1006) = rxt(k,115)*y(k,25) + mat(k,830) = rxt(k,128)*y(k,28) + mat(k,1544) = rxt(k,315)*y(k,28) + mat(k,1834) = rxt(k,342)*y(k,28) + mat(k,1014) = -((rxt(k,114) + rxt(k,115)) * y(k,25) + rxt(k,116)*y(k,28) & + + rxt(k,117)*y(k,40) + rxt(k,119)*y(k,139) + rxt(k,124)*y(k,51) & + + rxt(k,125)*y(k,70) + rxt(k,126)*y(k,72) + (rxt(k,168) & + + rxt(k,265)) * y(k,107) + (rxt(k,170) + rxt(k,258)) * y(k,105) & + + rxt(k,186)*y(k,103) + rxt(k,204)*y(k,122) + rxt(k,221) & + *y(k,119) + rxt(k,239)*y(k,118) + rxt(k,256)*y(k,128) + rxt(k,280) & + *y(k,62) + rxt(k,281)*y(k,63)) + mat(k,1477) = -(rxt(k,114) + rxt(k,115)) * y(k,94) + mat(k,1102) = -rxt(k,116)*y(k,94) + mat(k,1761) = -rxt(k,117)*y(k,94) + mat(k,2066) = -rxt(k,119)*y(k,94) + mat(k,1518) = -rxt(k,124)*y(k,94) + mat(k,1380) = -rxt(k,125)*y(k,94) + mat(k,1429) = -rxt(k,126)*y(k,94) + mat(k,1642) = -(rxt(k,168) + rxt(k,265)) * y(k,94) + mat(k,1685) = -(rxt(k,170) + rxt(k,258)) * y(k,94) + mat(k,1236) = -rxt(k,186)*y(k,94) + mat(k,1320) = -rxt(k,204)*y(k,94) + mat(k,1193) = -rxt(k,221)*y(k,94) + mat(k,1150) = -rxt(k,239)*y(k,94) + mat(k,1599) = -rxt(k,256)*y(k,94) + mat(k,1961) = -rxt(k,280)*y(k,94) + mat(k,1809) = -rxt(k,281)*y(k,94) + mat(k,1278) = rxt(k,330)*y(k,130) + rxt(k,352)*y(k,135) + mat(k,1761) = mat(k,1761) + rxt(k,129)*y(k,97) + mat(k,1380) = mat(k,1380) + rxt(k,131)*y(k,97) + mat(k,838) = rxt(k,129)*y(k,40) + rxt(k,131)*y(k,70) + mat(k,597) = rxt(k,330)*y(k,32) + mat(k,1878) = rxt(k,352)*y(k,32) + mat(k,504) = -(rxt(k,153)*y(k,128) + (rxt(k,176) + rxt(k,259)) * y(k,107) & + + rxt(k,194)*y(k,103) + rxt(k,211)*y(k,122) + rxt(k,229) & + *y(k,119) + rxt(k,246)*y(k,118) + (rxt(k,247) + rxt(k,271) & + ) * y(k,105)) + mat(k,1583) = -rxt(k,153)*y(k,95) + mat(k,1627) = -(rxt(k,176) + rxt(k,259)) * y(k,95) + mat(k,1221) = -rxt(k,194)*y(k,95) + mat(k,1305) = -rxt(k,211)*y(k,95) + mat(k,1178) = -rxt(k,229)*y(k,95) + mat(k,1134) = -rxt(k,246)*y(k,95) + mat(k,1670) = -(rxt(k,247) + rxt(k,271)) * y(k,95) + mat(k,667) = rxt(k,118)*y(k,139) + mat(k,2050) = rxt(k,118)*y(k,96) + mat(k,669) = -(rxt(k,118)*y(k,139) + (rxt(k,120) + rxt(k,121)) * y(k,63) & + + (rxt(k,122) + rxt(k,123)) * y(k,62) + rxt(k,155)*y(k,128) & + + (rxt(k,158) + rxt(k,260)) * y(k,105) + (rxt(k,178) + rxt(k,261) & + ) * y(k,107) + rxt(k,196)*y(k,103) + rxt(k,213)*y(k,122) & + + rxt(k,231)*y(k,119) + rxt(k,249)*y(k,118)) + mat(k,2056) = -rxt(k,118)*y(k,96) + mat(k,1799) = -(rxt(k,120) + rxt(k,121)) * y(k,96) + mat(k,1951) = -(rxt(k,122) + rxt(k,123)) * y(k,96) + mat(k,1590) = -rxt(k,155)*y(k,96) + mat(k,1677) = -(rxt(k,158) + rxt(k,260)) * y(k,96) + mat(k,1634) = -(rxt(k,178) + rxt(k,261)) * y(k,96) + mat(k,1228) = -rxt(k,196)*y(k,96) + mat(k,1312) = -rxt(k,213)*y(k,96) + mat(k,1185) = -rxt(k,231)*y(k,96) + mat(k,1141) = -rxt(k,249)*y(k,96) + mat(k,1008) = rxt(k,119)*y(k,139) + mat(k,2056) = mat(k,2056) + rxt(k,119)*y(k,94) + mat(k,833) = -(rxt(k,127)*y(k,25) + rxt(k,128)*y(k,28) + rxt(k,129)*y(k,40) & + + rxt(k,130)*y(k,49) + rxt(k,131)*y(k,70) + rxt(k,132)*y(k,73) & + + rxt(k,151)*y(k,128) + rxt(k,174)*y(k,107) + rxt(k,191) & + *y(k,103) + rxt(k,209)*y(k,122) + rxt(k,225)*y(k,105) + rxt(k,227) & + *y(k,119) + rxt(k,244)*y(k,118)) + mat(k,1472) = -rxt(k,127)*y(k,97) + mat(k,1097) = -rxt(k,128)*y(k,97) + mat(k,1756) = -rxt(k,129)*y(k,97) + mat(k,2001) = -rxt(k,130)*y(k,97) + mat(k,1375) = -rxt(k,131)*y(k,97) + mat(k,1914) = -rxt(k,132)*y(k,97) + mat(k,1594) = -rxt(k,151)*y(k,97) + mat(k,1637) = -rxt(k,174)*y(k,97) + mat(k,1231) = -rxt(k,191)*y(k,97) + mat(k,1315) = -rxt(k,209)*y(k,97) + mat(k,1680) = -rxt(k,225)*y(k,97) + mat(k,1188) = -rxt(k,227)*y(k,97) + mat(k,1145) = -rxt(k,244)*y(k,97) + mat(k,1273) = rxt(k,316)*y(k,127) + rxt(k,335)*y(k,131) + mat(k,1549) = rxt(k,316)*y(k,32) + mat(k,241) = rxt(k,335)*y(k,32) + mat(k,1058) = -((rxt(k,133) + rxt(k,135)) * y(k,72) + rxt(k,134)*y(k,73) & + + rxt(k,138)*y(k,99) + rxt(k,141)*y(k,105) + rxt(k,144)*y(k,107) & + + rxt(k,303)*y(k,119) + rxt(k,304)*y(k,120) + rxt(k,306) & + *y(k,121) + rxt(k,308)*y(k,122) + rxt(k,326)*y(k,129) + rxt(k,380) & + *y(k,132) + rxt(k,381)*y(k,108) + rxt(k,382)*y(k,102) + rxt(k,383) & + *y(k,103) + rxt(k,384)*y(k,123) + rxt(k,582)*y(k,118) + rxt(k,583) & + *y(k,128) + rxt(k,584)*y(k,110)) + mat(k,1430) = -(rxt(k,133) + rxt(k,135)) * y(k,98) + mat(k,1920) = -rxt(k,134)*y(k,98) + mat(k,170) = -rxt(k,138)*y(k,98) + mat(k,1686) = -rxt(k,141)*y(k,98) + mat(k,1643) = -rxt(k,144)*y(k,98) + mat(k,1194) = -rxt(k,303)*y(k,98) + mat(k,175) = -rxt(k,304)*y(k,98) + mat(k,265) = -rxt(k,306)*y(k,98) + mat(k,1321) = -rxt(k,308)*y(k,98) + mat(k,294) = -rxt(k,326)*y(k,98) + mat(k,463) = -rxt(k,380)*y(k,98) + mat(k,285) = -rxt(k,381)*y(k,98) + mat(k,248) = -rxt(k,382)*y(k,98) + mat(k,1237) = -rxt(k,383)*y(k,98) + mat(k,258) = -rxt(k,384)*y(k,98) + mat(k,1151) = -rxt(k,582)*y(k,98) + mat(k,1600) = -rxt(k,583)*y(k,98) + mat(k,234) = -rxt(k,584)*y(k,98) + mat(k,1762) = rxt(k,105)*y(k,90) + rxt(k,317)*y(k,127) + rxt(k,344)*y(k,134) + mat(k,652) = rxt(k,353)*y(k,135) + mat(k,1962) = rxt(k,136)*y(k,135) + mat(k,1381) = rxt(k,324)*y(k,127) + rxt(k,333)*y(k,130) + rxt(k,347)*y(k,134) & + + rxt(k,360)*y(k,135) + mat(k,1920) = mat(k,1920) + rxt(k,332)*y(k,130) + mat(k,814) = rxt(k,105)*y(k,40) + mat(k,379) = rxt(k,321)*y(k,127) + rxt(k,361)*y(k,135) + mat(k,1555) = rxt(k,317)*y(k,40) + rxt(k,324)*y(k,70) + rxt(k,321)*y(k,125) + mat(k,598) = rxt(k,333)*y(k,70) + rxt(k,332)*y(k,73) + mat(k,1843) = rxt(k,344)*y(k,40) + rxt(k,347)*y(k,70) + mat(k,1879) = rxt(k,353)*y(k,41) + rxt(k,136)*y(k,62) + rxt(k,360)*y(k,70) & + + rxt(k,361)*y(k,125) + 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,167) = -(rxt(k,138)*y(k,98) + rxt(k,139)*y(k,139)) + mat(k,1039) = -rxt(k,138)*y(k,99) + mat(k,2036) = -rxt(k,139)*y(k,99) + mat(k,289) = rxt(k,327)*y(k,139) + mat(k,2036) = mat(k,2036) + rxt(k,327)*y(k,129) + mat(k,490) = -(rxt(k,149)*y(k,128) + rxt(k,172)*y(k,107) + rxt(k,189) & + *y(k,103) + rxt(k,203)*y(k,105) + rxt(k,207)*y(k,122) + rxt(k,224) & + *y(k,119) + rxt(k,242)*y(k,118)) + mat(k,1582) = -rxt(k,149)*y(k,100) + mat(k,1626) = -rxt(k,172)*y(k,100) + mat(k,1220) = -rxt(k,189)*y(k,100) + mat(k,1669) = -rxt(k,203)*y(k,100) + mat(k,1304) = -rxt(k,207)*y(k,100) + mat(k,1177) = -rxt(k,224)*y(k,100) + mat(k,1133) = -rxt(k,242)*y(k,100) + mat(k,1270) = rxt(k,343)*y(k,134) + mat(k,1835) = rxt(k,343)*y(k,32) + mat(k,900) = -(rxt(k,310)*y(k,122) + (rxt(k,408) + rxt(k,409) + rxt(k,410) & + ) * y(k,40) + rxt(k,412)*y(k,70) + rxt(k,413)*y(k,73) + rxt(k,417) & + *y(k,133) + 4._r8*rxt(k,422)*y(k,101) + rxt(k,434)*y(k,64) & + + rxt(k,439)*y(k,62) + rxt(k,444)*y(k,63) + (rxt(k,454) & + + rxt(k,455)) * y(k,25) + rxt(k,461)*y(k,28) + rxt(k,487)*y(k,3) & + + rxt(k,493)*y(k,5) + rxt(k,533)*y(k,21)) + mat(k,1317) = -rxt(k,310)*y(k,101) + mat(k,1758) = -(rxt(k,408) + rxt(k,409) + rxt(k,410)) * y(k,101) + mat(k,1377) = -rxt(k,412)*y(k,101) + mat(k,1916) = -rxt(k,413)*y(k,101) + mat(k,983) = -rxt(k,417)*y(k,101) + mat(k,1723) = -rxt(k,434)*y(k,101) + mat(k,1958) = -rxt(k,439)*y(k,101) + mat(k,1806) = -rxt(k,444)*y(k,101) + mat(k,1474) = -(rxt(k,454) + rxt(k,455)) * y(k,101) + mat(k,1099) = -rxt(k,461)*y(k,101) + mat(k,586) = -rxt(k,487)*y(k,101) + mat(k,718) = -rxt(k,493)*y(k,101) + mat(k,434) = -rxt(k,533)*y(k,101) + mat(k,586) = mat(k,586) + rxt(k,486)*y(k,17) + mat(k,718) = mat(k,718) + rxt(k,498)*y(k,133) + mat(k,740) = rxt(k,486)*y(k,3) + rxt(k,450)*y(k,25) + rxt(k,530)*y(k,64) & + + rxt(k,531)*y(k,70) + mat(k,225) = rxt(k,515)*y(k,25) + rxt(k,516)*y(k,133) + mat(k,150) = rxt(k,518)*y(k,25) + rxt(k,519)*y(k,133) + mat(k,434) = mat(k,434) + rxt(k,457)*y(k,28) + rxt(k,534)*y(k,62) + mat(k,421) = rxt(k,538)*y(k,71) + mat(k,1474) = mat(k,1474) + rxt(k,450)*y(k,17) + rxt(k,515)*y(k,18) & + + rxt(k,518)*y(k,20) + rxt(k,453)*y(k,43) + mat(k,1099) = mat(k,1099) + rxt(k,457)*y(k,21) + rxt(k,468)*y(k,133) + mat(k,253) = rxt(k,540)*y(k,133) + mat(k,127) = .500_r8*rxt(k,556)*y(k,133) + mat(k,1758) = mat(k,1758) + rxt(k,411)*y(k,72) + rxt(k,317)*y(k,127) + mat(k,215) = rxt(k,453)*y(k,25) + rxt(k,407)*y(k,70) + rxt(k,416)*y(k,133) + mat(k,2003) = rxt(k,130)*y(k,97) + rxt(k,318)*y(k,127) + mat(k,1515) = rxt(k,319)*y(k,127) + mat(k,1958) = mat(k,1958) + rxt(k,534)*y(k,21) + mat(k,1723) = mat(k,1723) + rxt(k,530)*y(k,17) + rxt(k,437)*y(k,133) + mat(k,1377) = mat(k,1377) + rxt(k,531)*y(k,17) + rxt(k,407)*y(k,43) & + + rxt(k,347)*y(k,134) + mat(k,788) = rxt(k,538)*y(k,23) + mat(k,1426) = rxt(k,411)*y(k,40) + mat(k,1916) = mat(k,1916) + rxt(k,419)*y(k,133) + mat(k,353) = rxt(k,546)*y(k,133) + mat(k,835) = rxt(k,130)*y(k,49) + mat(k,1551) = rxt(k,317)*y(k,40) + rxt(k,318)*y(k,49) + rxt(k,319)*y(k,51) + mat(k,983) = mat(k,983) + rxt(k,498)*y(k,5) + rxt(k,516)*y(k,18) + rxt(k,519) & + *y(k,20) + rxt(k,468)*y(k,28) + rxt(k,540)*y(k,31) & + + .500_r8*rxt(k,556)*y(k,35) + rxt(k,416)*y(k,43) + rxt(k,437) & + *y(k,64) + rxt(k,419)*y(k,73) + rxt(k,546)*y(k,81) + mat(k,1839) = rxt(k,347)*y(k,70) + mat(k,246) = -(rxt(k,374)*y(k,139) + rxt(k,382)*y(k,98)) + mat(k,2038) = -rxt(k,374)*y(k,102) + mat(k,1044) = -rxt(k,382)*y(k,102) + mat(k,168) = rxt(k,139)*y(k,139) + mat(k,283) = rxt(k,372)*y(k,139) + mat(k,2038) = mat(k,2038) + rxt(k,139)*y(k,99) + rxt(k,372)*y(k,108) + mat(k,1241) = -(rxt(k,185)*y(k,117) + rxt(k,186)*y(k,94) + rxt(k,187)*y(k,92) & + + rxt(k,188)*y(k,113) + rxt(k,189)*y(k,100) + rxt(k,190) & + *y(k,127) + rxt(k,191)*y(k,97) + rxt(k,193)*y(k,115) + rxt(k,194) & + *y(k,95) + rxt(k,195)*y(k,90) + rxt(k,196)*y(k,96) + rxt(k,197) & + *y(k,112) + rxt(k,198)*y(k,116) + rxt(k,199)*y(k,91) + rxt(k,200) & + *y(k,114) + rxt(k,201)*y(k,111) + rxt(k,376)*y(k,139) + rxt(k,383) & + *y(k,98)) + mat(k,613) = -rxt(k,185)*y(k,103) + mat(k,1019) = -rxt(k,186)*y(k,103) + mat(k,523) = -rxt(k,187)*y(k,103) + mat(k,871) = -rxt(k,188)*y(k,103) + mat(k,494) = -rxt(k,189)*y(k,103) + mat(k,1559) = -rxt(k,190)*y(k,103) + mat(k,843) = -rxt(k,191)*y(k,103) + mat(k,695) = -rxt(k,193)*y(k,103) + mat(k,508) = -rxt(k,194)*y(k,103) + mat(k,817) = -rxt(k,195)*y(k,103) + mat(k,676) = -rxt(k,196)*y(k,103) + mat(k,554) = -rxt(k,197)*y(k,103) + mat(k,568) = -rxt(k,198)*y(k,103) + mat(k,539) = -rxt(k,199)*y(k,103) + mat(k,630) = -rxt(k,200)*y(k,103) + mat(k,932) = -rxt(k,201)*y(k,103) + mat(k,2071) = -rxt(k,376)*y(k,103) + mat(k,1062) = -rxt(k,383)*y(k,103) + mat(k,249) = rxt(k,374)*y(k,139) + mat(k,176) = rxt(k,305)*y(k,139) + mat(k,2071) = mat(k,2071) + rxt(k,374)*y(k,102) + rxt(k,305)*y(k,120) + mat(k,107) = -(rxt(k,140)*y(k,139)) + mat(k,2033) = -rxt(k,140)*y(k,104) + mat(k,399) = rxt(k,142)*y(k,105) + mat(k,1667) = rxt(k,142)*y(k,58) + mat(k,1700) = -(rxt(k,141)*y(k,98) + rxt(k,142)*y(k,58) + (rxt(k,146) & + + rxt(k,269)) * y(k,117) + rxt(k,147)*y(k,90) + (rxt(k,158) & + + rxt(k,260)) * y(k,96) + rxt(k,162)*y(k,112) + rxt(k,163) & + *y(k,116) + rxt(k,164)*y(k,91) + rxt(k,165)*y(k,114) + rxt(k,166) & + *y(k,111) + (rxt(k,170) + rxt(k,258)) * y(k,94) + (rxt(k,181) & + + rxt(k,267)) * y(k,92) + (rxt(k,192) + rxt(k,264)) * y(k,113) & + + rxt(k,203)*y(k,100) + rxt(k,214)*y(k,127) + rxt(k,225)*y(k,97) & + + (rxt(k,236) + rxt(k,262)) * y(k,115) + (rxt(k,247) + rxt(k,271) & + ) * y(k,95) + rxt(k,378)*y(k,139)) + mat(k,1072) = -rxt(k,141)*y(k,105) + mat(k,408) = -rxt(k,142)*y(k,105) + mat(k,619) = -(rxt(k,146) + rxt(k,269)) * y(k,105) + mat(k,824) = -rxt(k,147)*y(k,105) + mat(k,683) = -(rxt(k,158) + rxt(k,260)) * y(k,105) + mat(k,559) = -rxt(k,162)*y(k,105) + mat(k,574) = -rxt(k,163)*y(k,105) + mat(k,545) = -rxt(k,164)*y(k,105) + mat(k,637) = -rxt(k,165)*y(k,105) + mat(k,940) = -rxt(k,166)*y(k,105) + mat(k,1029) = -(rxt(k,170) + rxt(k,258)) * y(k,105) + mat(k,529) = -(rxt(k,181) + rxt(k,267)) * y(k,105) + mat(k,879) = -(rxt(k,192) + rxt(k,264)) * y(k,105) + mat(k,500) = -rxt(k,203)*y(k,105) + mat(k,1569) = -rxt(k,214)*y(k,105) + mat(k,853) = -rxt(k,225)*y(k,105) + mat(k,702) = -(rxt(k,236) + rxt(k,262)) * y(k,105) + mat(k,515) = -(rxt(k,247) + rxt(k,271)) * y(k,105) + mat(k,2081) = -rxt(k,378)*y(k,105) + mat(k,1251) = rxt(k,376)*y(k,139) + mat(k,109) = rxt(k,140)*y(k,139) + mat(k,2081) = mat(k,2081) + rxt(k,376)*y(k,103) + rxt(k,140)*y(k,104) + mat(k,111) = -(rxt(k,143)*y(k,139)) + mat(k,2034) = -rxt(k,143)*y(k,106) + mat(k,400) = rxt(k,145)*y(k,107) + mat(k,1624) = rxt(k,145)*y(k,58) + mat(k,1656) = -(rxt(k,144)*y(k,98) + rxt(k,145)*y(k,58) + (rxt(k,167) & + + rxt(k,270)) * y(k,117) + (rxt(k,168) + rxt(k,265)) * y(k,94) & + + (rxt(k,169) + rxt(k,268)) * y(k,92) + (rxt(k,171) + rxt(k,266) & + ) * y(k,113) + rxt(k,172)*y(k,100) + rxt(k,173)*y(k,127) & + + rxt(k,174)*y(k,97) + (rxt(k,175) + rxt(k,263)) * y(k,115) & + + (rxt(k,176) + rxt(k,259)) * y(k,95) + rxt(k,177)*y(k,90) & + + (rxt(k,178) + rxt(k,261)) * y(k,96) + rxt(k,179)*y(k,112) & + + rxt(k,180)*y(k,116) + rxt(k,182)*y(k,91) + rxt(k,183)*y(k,114) & + + rxt(k,184)*y(k,111)) + mat(k,1071) = -rxt(k,144)*y(k,107) + mat(k,407) = -rxt(k,145)*y(k,107) + mat(k,618) = -(rxt(k,167) + rxt(k,270)) * y(k,107) + mat(k,1028) = -(rxt(k,168) + rxt(k,265)) * y(k,107) + mat(k,528) = -(rxt(k,169) + rxt(k,268)) * y(k,107) + mat(k,878) = -(rxt(k,171) + rxt(k,266)) * y(k,107) + mat(k,499) = -rxt(k,172)*y(k,107) + mat(k,1568) = -rxt(k,173)*y(k,107) + mat(k,852) = -rxt(k,174)*y(k,107) + mat(k,701) = -(rxt(k,175) + rxt(k,263)) * y(k,107) + mat(k,514) = -(rxt(k,176) + rxt(k,259)) * y(k,107) + mat(k,823) = -rxt(k,177)*y(k,107) + mat(k,682) = -(rxt(k,178) + rxt(k,261)) * y(k,107) + mat(k,558) = -rxt(k,179)*y(k,107) + mat(k,573) = -rxt(k,180)*y(k,107) + mat(k,544) = -rxt(k,182)*y(k,107) + mat(k,636) = -rxt(k,183)*y(k,107) + mat(k,939) = -rxt(k,184)*y(k,107) + mat(k,1699) = rxt(k,378)*y(k,139) + mat(k,113) = rxt(k,143)*y(k,139) + mat(k,2080) = rxt(k,378)*y(k,105) + rxt(k,143)*y(k,106) + mat(k,284) = -(rxt(k,372)*y(k,139) + rxt(k,381)*y(k,98)) + mat(k,2042) = -rxt(k,372)*y(k,108) + mat(k,1048) = -rxt(k,381)*y(k,108) + mat(k,1750) = rxt(k,309)*y(k,122) + mat(k,890) = rxt(k,310)*y(k,122) + mat(k,1303) = rxt(k,309)*y(k,40) + rxt(k,310)*y(k,101) + rxt(k,311)*y(k,133) + mat(k,291) = rxt(k,328)*y(k,139) + mat(k,968) = rxt(k,311)*y(k,122) + mat(k,2042) = mat(k,2042) + rxt(k,328)*y(k,129) + mat(k,300) = -(rxt(k,424)*y(k,70) + rxt(k,425)*y(k,72) + rxt(k,596)*y(k,136)) + mat(k,1355) = -rxt(k,424)*y(k,109) + mat(k,1411) = -rxt(k,425)*y(k,109) + mat(k,386) = -rxt(k,596)*y(k,109) + mat(k,1355) = mat(k,1355) + rxt(k,586)*y(k,110) + mat(k,1050) = .900_r8*rxt(k,584)*y(k,110) + .800_r8*rxt(k,582)*y(k,118) + mat(k,231) = rxt(k,586)*y(k,70) + .900_r8*rxt(k,584)*y(k,98) + mat(k,1129) = .800_r8*rxt(k,582)*y(k,98) + mat(k,230) = -(rxt(k,584)*y(k,98) + rxt(k,585)*y(k,72) + (rxt(k,586) & + + rxt(k,587)) * y(k,70)) + mat(k,1043) = -rxt(k,584)*y(k,110) + mat(k,1408) = -rxt(k,585)*y(k,110) + mat(k,1351) = -(rxt(k,586) + rxt(k,587)) * y(k,110) + mat(k,926) = -(rxt(k,161)*y(k,128) + rxt(k,166)*y(k,105) + rxt(k,184) & + *y(k,107) + rxt(k,201)*y(k,103) + rxt(k,219)*y(k,122) + rxt(k,237) & + *y(k,119) + rxt(k,254)*y(k,118) + rxt(k,285)*y(k,25) + rxt(k,286) & + *y(k,28) + rxt(k,287)*y(k,40) + rxt(k,288)*y(k,139) + rxt(k,289) & + *y(k,49) + rxt(k,290)*y(k,51) + rxt(k,291)*y(k,63) + rxt(k,292) & + *y(k,73)) + mat(k,1597) = -rxt(k,161)*y(k,111) + mat(k,1683) = -rxt(k,166)*y(k,111) + mat(k,1640) = -rxt(k,184)*y(k,111) + mat(k,1234) = -rxt(k,201)*y(k,111) + mat(k,1318) = -rxt(k,219)*y(k,111) + mat(k,1191) = -rxt(k,237)*y(k,111) + mat(k,1148) = -rxt(k,254)*y(k,111) + mat(k,1475) = -rxt(k,285)*y(k,111) + mat(k,1100) = -rxt(k,286)*y(k,111) + mat(k,1759) = -rxt(k,287)*y(k,111) + mat(k,2064) = -rxt(k,288)*y(k,111) + mat(k,2004) = -rxt(k,289)*y(k,111) + mat(k,1516) = -rxt(k,290)*y(k,111) + mat(k,1807) = -rxt(k,291)*y(k,111) + mat(k,1917) = -rxt(k,292)*y(k,111) + mat(k,1959) = rxt(k,111)*y(k,93) + rxt(k,280)*y(k,94) + rxt(k,123)*y(k,96) & + + rxt(k,279)*y(k,130) + mat(k,1807) = mat(k,1807) + rxt(k,110)*y(k,90) + rxt(k,320)*y(k,127) & + + rxt(k,278)*y(k,130) + rxt(k,346)*y(k,134) + rxt(k,359) & + *y(k,135) + mat(k,1378) = rxt(k,301)*y(k,113) + mat(k,1917) = mat(k,1917) + rxt(k,302)*y(k,113) + mat(k,813) = rxt(k,110)*y(k,63) + mat(k,371) = rxt(k,111)*y(k,62) + mat(k,1012) = rxt(k,280)*y(k,62) + mat(k,672) = rxt(k,123)*y(k,62) + mat(k,867) = rxt(k,301)*y(k,70) + rxt(k,302)*y(k,73) + mat(k,1552) = rxt(k,320)*y(k,63) + mat(k,596) = rxt(k,279)*y(k,62) + rxt(k,278)*y(k,63) + mat(k,1840) = rxt(k,346)*y(k,63) + mat(k,1876) = rxt(k,359)*y(k,63) + end do + end subroutine nlnmat07 + subroutine nlnmat08( 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,550) = -(rxt(k,156)*y(k,128) + rxt(k,162)*y(k,105) + rxt(k,179) & + *y(k,107) + rxt(k,197)*y(k,103) + rxt(k,215)*y(k,122) + rxt(k,232) & + *y(k,119) + rxt(k,250)*y(k,118)) + mat(k,1586) = -rxt(k,156)*y(k,112) + mat(k,1673) = -rxt(k,162)*y(k,112) + mat(k,1630) = -rxt(k,179)*y(k,112) + mat(k,1224) = -rxt(k,197)*y(k,112) + mat(k,1308) = -rxt(k,215)*y(k,112) + mat(k,1181) = -rxt(k,232)*y(k,112) + mat(k,1137) = -rxt(k,250)*y(k,112) + mat(k,1948) = rxt(k,122)*y(k,96) + mat(k,668) = rxt(k,122)*y(k,62) + mat(k,923) = rxt(k,288)*y(k,139) + mat(k,2052) = rxt(k,288)*y(k,111) + mat(k,866) = -(rxt(k,148)*y(k,128) + (rxt(k,171) + rxt(k,266)) * y(k,107) & + + rxt(k,188)*y(k,103) + (rxt(k,192) + rxt(k,264)) * y(k,105) & + + rxt(k,206)*y(k,122) + rxt(k,223)*y(k,119) + rxt(k,241) & + *y(k,118) + (rxt(k,276) + rxt(k,298)) * y(k,49) + rxt(k,296) & + *y(k,139) + rxt(k,300)*y(k,51) + rxt(k,301)*y(k,70) + rxt(k,302) & + *y(k,73)) + mat(k,1595) = -rxt(k,148)*y(k,113) + mat(k,1638) = -(rxt(k,171) + rxt(k,266)) * y(k,113) + mat(k,1232) = -rxt(k,188)*y(k,113) + mat(k,1681) = -(rxt(k,192) + rxt(k,264)) * y(k,113) + mat(k,1316) = -rxt(k,206)*y(k,113) + mat(k,1189) = -rxt(k,223)*y(k,113) + mat(k,1146) = -rxt(k,241)*y(k,113) + mat(k,2002) = -(rxt(k,276) + rxt(k,298)) * y(k,113) + mat(k,2062) = -rxt(k,296)*y(k,113) + mat(k,1514) = -rxt(k,300)*y(k,113) + mat(k,1376) = -rxt(k,301)*y(k,113) + mat(k,1915) = -rxt(k,302)*y(k,113) + mat(k,1514) = mat(k,1514) + rxt(k,109)*y(k,90) + rxt(k,124)*y(k,94) & + + rxt(k,290)*y(k,111) + rxt(k,319)*y(k,127) + rxt(k,357) & + *y(k,135) + mat(k,1957) = rxt(k,272)*y(k,130) + mat(k,1805) = rxt(k,281)*y(k,94) + rxt(k,120)*y(k,96) + rxt(k,291)*y(k,111) & + + rxt(k,277)*y(k,130) + mat(k,1915) = mat(k,1915) + rxt(k,292)*y(k,111) + mat(k,812) = rxt(k,109)*y(k,51) + mat(k,1011) = rxt(k,124)*y(k,51) + rxt(k,281)*y(k,63) + mat(k,671) = rxt(k,120)*y(k,63) + mat(k,925) = rxt(k,290)*y(k,51) + rxt(k,291)*y(k,63) + rxt(k,292)*y(k,73) + mat(k,1550) = rxt(k,319)*y(k,51) + mat(k,595) = rxt(k,272)*y(k,62) + rxt(k,277)*y(k,63) + mat(k,1874) = rxt(k,357)*y(k,51) + mat(k,625) = -(rxt(k,160)*y(k,128) + rxt(k,165)*y(k,105) + rxt(k,183) & + *y(k,107) + rxt(k,200)*y(k,103) + rxt(k,218)*y(k,122) + rxt(k,235) & + *y(k,119) + rxt(k,253)*y(k,118) + rxt(k,293)*y(k,58)) + mat(k,1589) = -rxt(k,160)*y(k,114) + mat(k,1676) = -rxt(k,165)*y(k,114) + mat(k,1633) = -rxt(k,183)*y(k,114) + mat(k,1227) = -rxt(k,200)*y(k,114) + mat(k,1311) = -rxt(k,218)*y(k,114) + mat(k,1184) = -rxt(k,235)*y(k,114) + mat(k,1140) = -rxt(k,253)*y(k,114) + mat(k,403) = -rxt(k,293)*y(k,114) + mat(k,690) = rxt(k,294)*y(k,139) + mat(k,2054) = rxt(k,294)*y(k,115) + mat(k,691) = -(rxt(k,152)*y(k,128) + (rxt(k,175) + rxt(k,263)) * y(k,107) & + + rxt(k,193)*y(k,103) + rxt(k,210)*y(k,122) + rxt(k,228) & + *y(k,119) + (rxt(k,236) + rxt(k,262)) * y(k,105) + rxt(k,245) & + *y(k,118) + rxt(k,294)*y(k,139) + rxt(k,295)*y(k,51) + rxt(k,297) & + *y(k,58)) + mat(k,1591) = -rxt(k,152)*y(k,115) + mat(k,1635) = -(rxt(k,175) + rxt(k,263)) * y(k,115) + mat(k,1229) = -rxt(k,193)*y(k,115) + mat(k,1313) = -rxt(k,210)*y(k,115) + mat(k,1186) = -rxt(k,228)*y(k,115) + mat(k,1678) = -(rxt(k,236) + rxt(k,262)) * y(k,115) + mat(k,1142) = -rxt(k,245)*y(k,115) + mat(k,2057) = -rxt(k,294)*y(k,115) + mat(k,1510) = -rxt(k,295)*y(k,115) + mat(k,404) = -rxt(k,297)*y(k,115) + mat(k,1800) = rxt(k,121)*y(k,96) + mat(k,670) = rxt(k,121)*y(k,63) + mat(k,864) = rxt(k,296)*y(k,139) + mat(k,2057) = mat(k,2057) + rxt(k,296)*y(k,113) + mat(k,564) = -(rxt(k,157)*y(k,128) + rxt(k,163)*y(k,105) + rxt(k,180) & + *y(k,107) + rxt(k,198)*y(k,103) + rxt(k,216)*y(k,122) + rxt(k,233) & + *y(k,119) + rxt(k,251)*y(k,118) + rxt(k,299)*y(k,51)) + mat(k,1587) = -rxt(k,157)*y(k,116) + mat(k,1674) = -rxt(k,163)*y(k,116) + mat(k,1631) = -rxt(k,180)*y(k,116) + mat(k,1225) = -rxt(k,198)*y(k,116) + mat(k,1309) = -rxt(k,216)*y(k,116) + mat(k,1182) = -rxt(k,233)*y(k,116) + mat(k,1138) = -rxt(k,251)*y(k,116) + mat(k,1507) = -rxt(k,299)*y(k,116) + mat(k,1994) = rxt(k,276)*y(k,113) + mat(k,862) = rxt(k,276)*y(k,49) + mat(k,609) = -((rxt(k,146) + rxt(k,269)) * y(k,105) + (rxt(k,167) + rxt(k,270) & + ) * y(k,107) + rxt(k,185)*y(k,103) + rxt(k,202)*y(k,122) & + + rxt(k,220)*y(k,119) + rxt(k,238)*y(k,118) + rxt(k,255) & + *y(k,128)) + mat(k,1675) = -(rxt(k,146) + rxt(k,269)) * y(k,117) + mat(k,1632) = -(rxt(k,167) + rxt(k,270)) * y(k,117) + mat(k,1226) = -rxt(k,185)*y(k,117) + mat(k,1310) = -rxt(k,202)*y(k,117) + mat(k,1183) = -rxt(k,220)*y(k,117) + mat(k,1139) = -rxt(k,238)*y(k,117) + mat(k,1588) = -rxt(k,255)*y(k,117) + mat(k,1508) = rxt(k,300)*y(k,113) + rxt(k,295)*y(k,115) + rxt(k,299)*y(k,116) + mat(k,402) = rxt(k,293)*y(k,114) + rxt(k,297)*y(k,115) + mat(k,863) = rxt(k,300)*y(k,51) + mat(k,624) = rxt(k,293)*y(k,58) + mat(k,689) = rxt(k,295)*y(k,51) + rxt(k,297)*y(k,58) + mat(k,565) = rxt(k,299)*y(k,51) + mat(k,1153) = -(rxt(k,238)*y(k,117) + rxt(k,239)*y(k,94) + rxt(k,240)*y(k,92) & + + rxt(k,241)*y(k,113) + rxt(k,242)*y(k,100) + rxt(k,243) & + *y(k,127) + rxt(k,244)*y(k,97) + rxt(k,245)*y(k,115) + rxt(k,246) & + *y(k,95) + rxt(k,248)*y(k,90) + rxt(k,249)*y(k,96) + rxt(k,250) & + *y(k,112) + rxt(k,251)*y(k,116) + rxt(k,252)*y(k,91) + rxt(k,253) & + *y(k,114) + rxt(k,254)*y(k,111) + rxt(k,365)*y(k,139) + rxt(k,368) & + *y(k,32) + rxt(k,582)*y(k,98)) + mat(k,611) = -rxt(k,238)*y(k,118) + mat(k,1017) = -rxt(k,239)*y(k,118) + mat(k,521) = -rxt(k,240)*y(k,118) + mat(k,869) = -rxt(k,241)*y(k,118) + mat(k,492) = -rxt(k,242)*y(k,118) + mat(k,1557) = -rxt(k,243)*y(k,118) + mat(k,841) = -rxt(k,244)*y(k,118) + mat(k,693) = -rxt(k,245)*y(k,118) + mat(k,506) = -rxt(k,246)*y(k,118) + mat(k,815) = -rxt(k,248)*y(k,118) + mat(k,674) = -rxt(k,249)*y(k,118) + mat(k,552) = -rxt(k,250)*y(k,118) + mat(k,566) = -rxt(k,251)*y(k,118) + mat(k,537) = -rxt(k,252)*y(k,118) + mat(k,628) = -rxt(k,253)*y(k,118) + mat(k,930) = -rxt(k,254)*y(k,118) + mat(k,2069) = -rxt(k,365)*y(k,118) + mat(k,1281) = -rxt(k,368)*y(k,118) + mat(k,1060) = -rxt(k,582)*y(k,118) + mat(k,451) = rxt(k,591)*y(k,128) + mat(k,1964) = rxt(k,593)*y(k,128) + mat(k,1383) = rxt(k,586)*y(k,110) + mat(k,1432) = rxt(k,590)*y(k,124) + mat(k,235) = rxt(k,586)*y(k,70) + mat(k,320) = rxt(k,590)*y(k,72) + mat(k,1602) = rxt(k,591)*y(k,56) + rxt(k,593)*y(k,62) + mat(k,1197) = -(rxt(k,220)*y(k,117) + rxt(k,221)*y(k,94) + rxt(k,222)*y(k,92) & + + rxt(k,223)*y(k,113) + rxt(k,224)*y(k,100) + rxt(k,226) & + *y(k,127) + rxt(k,227)*y(k,97) + rxt(k,228)*y(k,115) + rxt(k,229) & + *y(k,95) + rxt(k,230)*y(k,90) + rxt(k,231)*y(k,96) + rxt(k,232) & + *y(k,112) + rxt(k,233)*y(k,116) + rxt(k,234)*y(k,91) + rxt(k,235) & + *y(k,114) + rxt(k,237)*y(k,111) + rxt(k,303)*y(k,98) + rxt(k,367) & + *y(k,139)) + mat(k,612) = -rxt(k,220)*y(k,119) + mat(k,1018) = -rxt(k,221)*y(k,119) + mat(k,522) = -rxt(k,222)*y(k,119) + mat(k,870) = -rxt(k,223)*y(k,119) + mat(k,493) = -rxt(k,224)*y(k,119) + mat(k,1558) = -rxt(k,226)*y(k,119) + mat(k,842) = -rxt(k,227)*y(k,119) + mat(k,694) = -rxt(k,228)*y(k,119) + mat(k,507) = -rxt(k,229)*y(k,119) + mat(k,816) = -rxt(k,230)*y(k,119) + mat(k,675) = -rxt(k,231)*y(k,119) + mat(k,553) = -rxt(k,232)*y(k,119) + mat(k,567) = -rxt(k,233)*y(k,119) + mat(k,538) = -rxt(k,234)*y(k,119) + mat(k,629) = -rxt(k,235)*y(k,119) + mat(k,931) = -rxt(k,237)*y(k,119) + mat(k,1061) = -rxt(k,303)*y(k,119) + mat(k,2070) = -rxt(k,367)*y(k,119) + mat(k,1324) = rxt(k,366)*y(k,139) + mat(k,2070) = mat(k,2070) + rxt(k,366)*y(k,122) + mat(k,173) = -(rxt(k,304)*y(k,98) + rxt(k,305)*y(k,139)) + mat(k,1040) = -rxt(k,304)*y(k,120) + mat(k,2037) = -rxt(k,305)*y(k,120) + mat(k,1175) = rxt(k,367)*y(k,139) + mat(k,2037) = mat(k,2037) + rxt(k,367)*y(k,119) + mat(k,264) = -(rxt(k,306)*y(k,98) + rxt(k,307)*y(k,139)) + mat(k,1046) = -rxt(k,306)*y(k,121) + mat(k,2040) = -rxt(k,307)*y(k,121) + mat(k,1265) = rxt(k,368)*y(k,118) + rxt(k,312)*y(k,123) + mat(k,1128) = rxt(k,368)*y(k,32) + mat(k,257) = rxt(k,312)*y(k,32) + mat(k,1327) = -(rxt(k,202)*y(k,117) + rxt(k,204)*y(k,94) + rxt(k,205)*y(k,92) & + + rxt(k,206)*y(k,113) + rxt(k,207)*y(k,100) + rxt(k,208) & + *y(k,127) + rxt(k,209)*y(k,97) + rxt(k,210)*y(k,115) + rxt(k,211) & + *y(k,95) + rxt(k,212)*y(k,90) + rxt(k,213)*y(k,96) + rxt(k,215) & + *y(k,112) + rxt(k,216)*y(k,116) + rxt(k,217)*y(k,91) + rxt(k,218) & + *y(k,114) + rxt(k,219)*y(k,111) + rxt(k,308)*y(k,98) + rxt(k,309) & + *y(k,40) + rxt(k,310)*y(k,101) + rxt(k,311)*y(k,133) + rxt(k,366) & + *y(k,139)) + mat(k,614) = -rxt(k,202)*y(k,122) + mat(k,1021) = -rxt(k,204)*y(k,122) + mat(k,524) = -rxt(k,205)*y(k,122) + mat(k,872) = -rxt(k,206)*y(k,122) + mat(k,496) = -rxt(k,207)*y(k,122) + mat(k,1561) = -rxt(k,208)*y(k,122) + mat(k,845) = -rxt(k,209)*y(k,122) + mat(k,696) = -rxt(k,210)*y(k,122) + mat(k,510) = -rxt(k,211)*y(k,122) + mat(k,818) = -rxt(k,212)*y(k,122) + mat(k,678) = -rxt(k,213)*y(k,122) + mat(k,555) = -rxt(k,215)*y(k,122) + mat(k,569) = -rxt(k,216)*y(k,122) + mat(k,540) = -rxt(k,217)*y(k,122) + mat(k,631) = -rxt(k,218)*y(k,122) + mat(k,933) = -rxt(k,219)*y(k,122) + mat(k,1064) = -rxt(k,308)*y(k,122) + mat(k,1768) = -rxt(k,309)*y(k,122) + mat(k,906) = -rxt(k,310)*y(k,122) + mat(k,990) = -rxt(k,311)*y(k,122) + mat(k,2073) = -rxt(k,366)*y(k,122) + mat(k,1157) = rxt(k,365)*y(k,139) + mat(k,268) = rxt(k,307)*y(k,139) + mat(k,261) = rxt(k,313)*y(k,139) + mat(k,2073) = mat(k,2073) + rxt(k,365)*y(k,118) + rxt(k,307)*y(k,121) & + + rxt(k,313)*y(k,123) + end do + end subroutine nlnmat08 + subroutine nlnmat09( 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,256) = -(rxt(k,312)*y(k,32) + rxt(k,313)*y(k,139) + rxt(k,384)*y(k,98)) + mat(k,1264) = -rxt(k,312)*y(k,123) + mat(k,2039) = -rxt(k,313)*y(k,123) + mat(k,1045) = -rxt(k,384)*y(k,123) + mat(k,317) = -(rxt(k,588)*y(k,70) + (rxt(k,589) + rxt(k,590)) * y(k,72)) + mat(k,1357) = -rxt(k,588)*y(k,124) + mat(k,1412) = -(rxt(k,589) + rxt(k,590)) * y(k,124) + mat(k,301) = rxt(k,596)*y(k,136) + mat(k,387) = rxt(k,596)*y(k,109) + mat(k,377) = -(rxt(k,321)*y(k,127) + rxt(k,339)*y(k,132) + rxt(k,361) & + *y(k,135) + rxt(k,396)*y(k,70) + rxt(k,397)*y(k,72)) + mat(k,1545) = -rxt(k,321)*y(k,125) + mat(k,460) = -rxt(k,339)*y(k,125) + mat(k,1867) = -rxt(k,361)*y(k,125) + mat(k,1363) = -rxt(k,396)*y(k,125) + mat(k,1414) = -rxt(k,397)*y(k,125) + mat(k,1266) = rxt(k,398)*y(k,126) + mat(k,1363) = mat(k,1363) + rxt(k,400)*y(k,126) + mat(k,1414) = mat(k,1414) + rxt(k,401)*y(k,126) + mat(k,1906) = rxt(k,402)*y(k,126) + mat(k,132) = rxt(k,398)*y(k,32) + rxt(k,400)*y(k,70) + rxt(k,401)*y(k,72) & + + rxt(k,402)*y(k,73) + mat(k,131) = -(rxt(k,398)*y(k,32) + rxt(k,400)*y(k,70) + rxt(k,401)*y(k,72) & + + rxt(k,402)*y(k,73)) + mat(k,1261) = -rxt(k,398)*y(k,126) + mat(k,1345) = -rxt(k,400)*y(k,126) + mat(k,1405) = -rxt(k,401)*y(k,126) + mat(k,1903) = -rxt(k,402)*y(k,126) + mat(k,773) = rxt(k,392)*y(k,72) + mat(k,1405) = mat(k,1405) + rxt(k,392)*y(k,71) + mat(k,1566) = -(rxt(k,150)*y(k,128) + rxt(k,173)*y(k,107) + rxt(k,190) & + *y(k,103) + rxt(k,208)*y(k,122) + rxt(k,214)*y(k,105) + rxt(k,226) & + *y(k,119) + rxt(k,243)*y(k,118) + rxt(k,314)*y(k,25) + rxt(k,315) & + *y(k,28) + rxt(k,316)*y(k,32) + rxt(k,317)*y(k,40) + rxt(k,318) & + *y(k,49) + rxt(k,319)*y(k,51) + rxt(k,320)*y(k,63) + rxt(k,321) & + *y(k,125) + rxt(k,322)*y(k,72) + rxt(k,323)*y(k,73) + (rxt(k,324) & + + rxt(k,325)) * y(k,70)) + mat(k,1611) = -rxt(k,150)*y(k,127) + mat(k,1654) = -rxt(k,173)*y(k,127) + mat(k,1248) = -rxt(k,190)*y(k,127) + mat(k,1332) = -rxt(k,208)*y(k,127) + mat(k,1697) = -rxt(k,214)*y(k,127) + mat(k,1205) = -rxt(k,226)*y(k,127) + mat(k,1162) = -rxt(k,243)*y(k,127) + mat(k,1489) = -rxt(k,314)*y(k,127) + mat(k,1114) = -rxt(k,315)*y(k,127) + mat(k,1290) = -rxt(k,316)*y(k,127) + mat(k,1773) = -rxt(k,317)*y(k,127) + mat(k,2018) = -rxt(k,318)*y(k,127) + mat(k,1530) = -rxt(k,319)*y(k,127) + mat(k,1821) = -rxt(k,320)*y(k,127) + mat(k,381) = -rxt(k,321)*y(k,127) + mat(k,1441) = -rxt(k,322)*y(k,127) + mat(k,1931) = -rxt(k,323)*y(k,127) + mat(k,1392) = -(rxt(k,324) + rxt(k,325)) * y(k,127) + mat(k,1392) = mat(k,1392) + rxt(k,125)*y(k,94) + rxt(k,334)*y(k,130) + mat(k,1441) = mat(k,1441) + (rxt(k,133)+rxt(k,135))*y(k,98) + mat(k,1026) = rxt(k,125)*y(k,70) + mat(k,1069) = (rxt(k,133)+rxt(k,135))*y(k,72) + mat(k,602) = rxt(k,334)*y(k,70) + mat(k,1612) = -(rxt(k,148)*y(k,113) + rxt(k,149)*y(k,100) + rxt(k,150) & + *y(k,127) + rxt(k,151)*y(k,97) + rxt(k,152)*y(k,115) + rxt(k,153) & + *y(k,95) + rxt(k,154)*y(k,90) + rxt(k,155)*y(k,96) + rxt(k,156) & + *y(k,112) + rxt(k,157)*y(k,116) + rxt(k,159)*y(k,91) + rxt(k,160) & + *y(k,114) + rxt(k,161)*y(k,111) + rxt(k,255)*y(k,117) + rxt(k,256) & + *y(k,94) + rxt(k,257)*y(k,92) + rxt(k,329)*y(k,139) + rxt(k,364) & + *y(k,72) + rxt(k,583)*y(k,98) + rxt(k,591)*y(k,56) + rxt(k,593) & + *y(k,62)) + mat(k,877) = -rxt(k,148)*y(k,128) + mat(k,498) = -rxt(k,149)*y(k,128) + mat(k,1567) = -rxt(k,150)*y(k,128) + mat(k,851) = -rxt(k,151)*y(k,128) + mat(k,700) = -rxt(k,152)*y(k,128) + mat(k,513) = -rxt(k,153)*y(k,128) + mat(k,822) = -rxt(k,154)*y(k,128) + mat(k,681) = -rxt(k,155)*y(k,128) + mat(k,557) = -rxt(k,156)*y(k,128) + mat(k,572) = -rxt(k,157)*y(k,128) + mat(k,543) = -rxt(k,159)*y(k,128) + mat(k,635) = -rxt(k,160)*y(k,128) + mat(k,938) = -rxt(k,161)*y(k,128) + mat(k,617) = -rxt(k,255)*y(k,128) + mat(k,1027) = -rxt(k,256)*y(k,128) + mat(k,527) = -rxt(k,257)*y(k,128) + mat(k,2079) = -rxt(k,329)*y(k,128) + mat(k,1442) = -rxt(k,364)*y(k,128) + mat(k,1070) = -rxt(k,583)*y(k,128) + mat(k,455) = -rxt(k,591)*y(k,128) + mat(k,1974) = -rxt(k,593)*y(k,128) + mat(k,1291) = rxt(k,594)*y(k,136) + mat(k,1393) = rxt(k,338)*y(k,132) + mat(k,1442) = mat(k,1442) + rxt(k,585)*y(k,110) + rxt(k,589)*y(k,124) & + + rxt(k,597)*y(k,136) + rxt(k,601)*y(k,137) + mat(k,238) = rxt(k,585)*y(k,72) + mat(k,323) = rxt(k,589)*y(k,72) + mat(k,382) = rxt(k,339)*y(k,132) + mat(k,1567) = mat(k,1567) + 2.000_r8*rxt(k,150)*y(k,128) + mat(k,1612) = mat(k,1612) + 2.000_r8*rxt(k,150)*y(k,127) + mat(k,468) = rxt(k,338)*y(k,70) + rxt(k,339)*y(k,125) + mat(k,397) = rxt(k,594)*y(k,32) + rxt(k,597)*y(k,72) + mat(k,205) = rxt(k,601)*y(k,72) + mat(k,292) = -(rxt(k,326)*y(k,98) + (rxt(k,327) + rxt(k,328)) * y(k,139)) + mat(k,1049) = -rxt(k,326)*y(k,129) + mat(k,2043) = -(rxt(k,327) + rxt(k,328)) * y(k,129) + mat(k,1579) = rxt(k,329)*y(k,139) + mat(k,459) = rxt(k,337)*y(k,139) + mat(k,2043) = mat(k,2043) + rxt(k,329)*y(k,128) + rxt(k,337)*y(k,132) + mat(k,594) = -((rxt(k,272) + rxt(k,279)) * y(k,62) + (rxt(k,277) + rxt(k,278) & + ) * y(k,63) + rxt(k,330)*y(k,32) + rxt(k,331)*y(k,40) + rxt(k,332) & + *y(k,73) + (rxt(k,333) + rxt(k,334)) * y(k,70)) + mat(k,1950) = -(rxt(k,272) + rxt(k,279)) * y(k,130) + mat(k,1796) = -(rxt(k,277) + rxt(k,278)) * y(k,130) + mat(k,1271) = -rxt(k,330)*y(k,130) + mat(k,1751) = -rxt(k,331)*y(k,130) + mat(k,1910) = -rxt(k,332)*y(k,130) + mat(k,1369) = -(rxt(k,333) + rxt(k,334)) * y(k,130) + mat(k,1369) = mat(k,1369) + rxt(k,336)*y(k,131) + mat(k,1420) = rxt(k,126)*y(k,94) + rxt(k,362)*y(k,135) + mat(k,1910) = mat(k,1910) + rxt(k,132)*y(k,97) + rxt(k,323)*y(k,127) & + + rxt(k,348)*y(k,134) + rxt(k,363)*y(k,135) + mat(k,1007) = rxt(k,126)*y(k,72) + mat(k,831) = rxt(k,132)*y(k,73) + mat(k,1547) = rxt(k,323)*y(k,73) + mat(k,240) = rxt(k,336)*y(k,70) + mat(k,1836) = rxt(k,348)*y(k,73) + mat(k,1869) = rxt(k,362)*y(k,72) + rxt(k,363)*y(k,73) + mat(k,239) = -(rxt(k,335)*y(k,32) + rxt(k,336)*y(k,70)) + mat(k,1262) = -rxt(k,335)*y(k,131) + mat(k,1352) = -rxt(k,336)*y(k,131) + mat(k,1409) = rxt(k,322)*y(k,127) + mat(k,1543) = rxt(k,322)*y(k,72) + mat(k,461) = -(rxt(k,337)*y(k,139) + rxt(k,338)*y(k,70) + rxt(k,339)*y(k,125) & + + rxt(k,380)*y(k,98)) + mat(k,2048) = -rxt(k,337)*y(k,132) + mat(k,1366) = -rxt(k,338)*y(k,132) + mat(k,378) = -rxt(k,339)*y(k,132) + mat(k,1054) = -rxt(k,380)*y(k,132) + mat(k,1417) = rxt(k,364)*y(k,128) + mat(k,1581) = rxt(k,364)*y(k,72) + mat(k,984) = -(rxt(k,311)*y(k,122) + rxt(k,340)*y(k,55) + rxt(k,349)*y(k,62) & + + rxt(k,415)*y(k,41) + rxt(k,416)*y(k,43) + rxt(k,417)*y(k,101) & + + rxt(k,418)*y(k,70) + rxt(k,419)*y(k,73) + (4._r8*rxt(k,420) & + + 4._r8*rxt(k,421)) * y(k,133) + rxt(k,423)*y(k,52) + rxt(k,437) & + *y(k,64) + rxt(k,438)*y(k,56) + rxt(k,446)*y(k,63) + rxt(k,447) & + *y(k,51) + rxt(k,466)*y(k,29) + (rxt(k,468) + rxt(k,469) & + ) * y(k,28) + rxt(k,471)*y(k,49) + rxt(k,474)*y(k,54) + rxt(k,498) & + *y(k,5) + rxt(k,500)*y(k,45) + rxt(k,514)*y(k,16) + rxt(k,516) & + *y(k,18) + rxt(k,517)*y(k,19) + rxt(k,519)*y(k,20) + rxt(k,521) & + *y(k,24) + rxt(k,522)*y(k,46) + rxt(k,523)*y(k,47) + rxt(k,524) & + *y(k,48) + rxt(k,532)*y(k,17) + rxt(k,535)*y(k,22) + rxt(k,536) & + *y(k,23) + rxt(k,540)*y(k,31) + (rxt(k,542) + rxt(k,556) & + ) * y(k,35) + rxt(k,544)*y(k,75) + rxt(k,546)*y(k,81) + rxt(k,550) & + *y(k,78) + rxt(k,555)*y(k,80)) + mat(k,1319) = -rxt(k,311)*y(k,133) + mat(k,279) = -rxt(k,340)*y(k,133) + mat(k,1960) = -rxt(k,349)*y(k,133) + mat(k,651) = -rxt(k,415)*y(k,133) + mat(k,216) = -rxt(k,416)*y(k,133) + mat(k,901) = -rxt(k,417)*y(k,133) + mat(k,1379) = -rxt(k,418)*y(k,133) + mat(k,1918) = -rxt(k,419)*y(k,133) + mat(k,181) = -rxt(k,423)*y(k,133) + mat(k,1725) = -rxt(k,437)*y(k,133) + mat(k,449) = -rxt(k,438)*y(k,133) + mat(k,1808) = -rxt(k,446)*y(k,133) + mat(k,1517) = -rxt(k,447)*y(k,133) + mat(k,360) = -rxt(k,466)*y(k,133) + mat(k,1101) = -(rxt(k,468) + rxt(k,469)) * y(k,133) + mat(k,2005) = -rxt(k,471)*y(k,133) + mat(k,334) = -rxt(k,474)*y(k,133) + mat(k,719) = -rxt(k,498)*y(k,133) + mat(k,328) = -rxt(k,500)*y(k,133) + mat(k,189) = -rxt(k,514)*y(k,133) + mat(k,226) = -rxt(k,516)*y(k,133) + mat(k,49) = -rxt(k,517)*y(k,133) + mat(k,151) = -rxt(k,519)*y(k,133) + mat(k,164) = -rxt(k,521)*y(k,133) + mat(k,83) = -rxt(k,522)*y(k,133) + mat(k,93) = -rxt(k,523)*y(k,133) + mat(k,119) = -rxt(k,524)*y(k,133) + mat(k,741) = -rxt(k,532)*y(k,133) + mat(k,158) = -rxt(k,535)*y(k,133) + mat(k,422) = -rxt(k,536)*y(k,133) + mat(k,254) = -rxt(k,540)*y(k,133) + mat(k,128) = -(rxt(k,542) + rxt(k,556)) * y(k,133) + mat(k,144) = -rxt(k,544)*y(k,133) + mat(k,354) = -rxt(k,546)*y(k,133) + mat(k,273) = -rxt(k,550)*y(k,133) + mat(k,480) = -rxt(k,555)*y(k,133) + mat(k,741) = mat(k,741) + rxt(k,531)*y(k,70) + mat(k,158) = mat(k,158) + .300_r8*rxt(k,535)*y(k,133) + mat(k,422) = mat(k,422) + rxt(k,537)*y(k,71) + mat(k,1476) = rxt(k,455)*y(k,101) + rxt(k,341)*y(k,134) + mat(k,1101) = mat(k,1101) + rxt(k,342)*y(k,134) + mat(k,345) = rxt(k,509)*y(k,139) + mat(k,1760) = rxt(k,414)*y(k,73) + rxt(k,129)*y(k,97) + 2.000_r8*rxt(k,409) & + *y(k,101) + mat(k,651) = mat(k,651) + rxt(k,406)*y(k,70) + rxt(k,389)*y(k,71) + mat(k,216) = mat(k,216) + rxt(k,407)*y(k,70) + mat(k,328) = mat(k,328) + rxt(k,499)*y(k,70) + rxt(k,505)*y(k,71) + mat(k,2005) = mat(k,2005) + rxt(k,470)*y(k,70) + rxt(k,482)*y(k,71) & + + rxt(k,356)*y(k,135) + mat(k,1517) = mat(k,1517) + rxt(k,124)*y(k,94) + rxt(k,357)*y(k,135) + mat(k,312) = rxt(k,501)*y(k,70) + mat(k,334) = mat(k,334) + rxt(k,473)*y(k,70) + mat(k,1960) = mat(k,1960) + rxt(k,439)*y(k,101) + mat(k,1808) = mat(k,1808) + rxt(k,346)*y(k,134) + mat(k,1725) = mat(k,1725) + rxt(k,434)*y(k,101) + mat(k,1379) = mat(k,1379) + rxt(k,531)*y(k,17) + rxt(k,406)*y(k,41) & + + rxt(k,407)*y(k,43) + rxt(k,499)*y(k,45) + rxt(k,470)*y(k,49) & + + rxt(k,501)*y(k,53) + rxt(k,473)*y(k,54) + rxt(k,412)*y(k,101) + mat(k,789) = rxt(k,537)*y(k,23) + rxt(k,389)*y(k,41) + rxt(k,505)*y(k,45) & + + rxt(k,482)*y(k,49) + 2.000_r8*rxt(k,390)*y(k,139) + mat(k,1918) = mat(k,1918) + rxt(k,414)*y(k,40) + rxt(k,413)*y(k,101) & + + rxt(k,348)*y(k,134) + mat(k,1013) = rxt(k,124)*y(k,51) + mat(k,837) = rxt(k,129)*y(k,40) + mat(k,1057) = rxt(k,138)*y(k,99) + mat(k,169) = rxt(k,138)*y(k,98) + rxt(k,139)*y(k,139) + mat(k,491) = rxt(k,189)*y(k,103) + rxt(k,203)*y(k,105) + rxt(k,172)*y(k,107) & + + rxt(k,242)*y(k,118) + rxt(k,224)*y(k,119) + rxt(k,207) & + *y(k,122) + rxt(k,149)*y(k,128) + mat(k,901) = mat(k,901) + rxt(k,455)*y(k,25) + 2.000_r8*rxt(k,409)*y(k,40) & + + rxt(k,439)*y(k,62) + rxt(k,434)*y(k,64) + rxt(k,412)*y(k,70) & + + rxt(k,413)*y(k,73) + mat(k,1235) = rxt(k,189)*y(k,100) + mat(k,1684) = rxt(k,203)*y(k,100) + mat(k,1641) = rxt(k,172)*y(k,100) + mat(k,1149) = rxt(k,242)*y(k,100) + mat(k,1192) = rxt(k,224)*y(k,100) + mat(k,1319) = mat(k,1319) + rxt(k,207)*y(k,100) + mat(k,1598) = rxt(k,149)*y(k,100) + mat(k,293) = rxt(k,328)*y(k,139) + mat(k,984) = mat(k,984) + .300_r8*rxt(k,535)*y(k,22) + mat(k,1841) = rxt(k,341)*y(k,25) + rxt(k,342)*y(k,28) + rxt(k,346)*y(k,63) & + + rxt(k,348)*y(k,73) + mat(k,1877) = rxt(k,356)*y(k,49) + rxt(k,357)*y(k,51) + rxt(k,355)*y(k,139) + mat(k,2065) = rxt(k,509)*y(k,39) + 2.000_r8*rxt(k,390)*y(k,71) + rxt(k,139) & + *y(k,99) + rxt(k,328)*y(k,129) + rxt(k,355)*y(k,135) + end do + end subroutine nlnmat09 + subroutine nlnmat10( 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,1861) = -(rxt(k,341)*y(k,25) + rxt(k,342)*y(k,28) + rxt(k,343)*y(k,32) & + + rxt(k,344)*y(k,40) + rxt(k,345)*y(k,49) + rxt(k,346)*y(k,63) & + + rxt(k,347)*y(k,70) + rxt(k,348)*y(k,73)) + mat(k,1496) = -rxt(k,341)*y(k,134) + mat(k,1121) = -rxt(k,342)*y(k,134) + mat(k,1297) = -rxt(k,343)*y(k,134) + mat(k,1780) = -rxt(k,344)*y(k,134) + mat(k,2025) = -rxt(k,345)*y(k,134) + mat(k,1828) = -rxt(k,346)*y(k,134) + mat(k,1399) = -rxt(k,347)*y(k,134) + mat(k,1938) = -rxt(k,348)*y(k,134) + mat(k,1780) = mat(k,1780) + rxt(k,117)*y(k,94) + rxt(k,287)*y(k,111) & + + rxt(k,331)*y(k,130) + mat(k,662) = rxt(k,354)*y(k,135) + mat(k,1033) = rxt(k,117)*y(k,40) + mat(k,944) = rxt(k,287)*y(k,40) + mat(k,605) = rxt(k,331)*y(k,40) + mat(k,1897) = rxt(k,354)*y(k,41) + rxt(k,355)*y(k,139) + mat(k,2085) = rxt(k,355)*y(k,135) + mat(k,1898) = -(rxt(k,136)*y(k,62) + rxt(k,350)*y(k,25) + rxt(k,351)*y(k,28) & + + rxt(k,352)*y(k,32) + (rxt(k,353) + rxt(k,354)) * y(k,41) & + + rxt(k,355)*y(k,139) + rxt(k,356)*y(k,49) + rxt(k,357)*y(k,51) & + + rxt(k,359)*y(k,63) + rxt(k,360)*y(k,70) + rxt(k,361)*y(k,125) & + + rxt(k,362)*y(k,72) + rxt(k,363)*y(k,73)) + mat(k,1981) = -rxt(k,136)*y(k,135) + mat(k,1497) = -rxt(k,350)*y(k,135) + mat(k,1122) = -rxt(k,351)*y(k,135) + mat(k,1298) = -rxt(k,352)*y(k,135) + mat(k,663) = -(rxt(k,353) + rxt(k,354)) * y(k,135) + mat(k,2086) = -rxt(k,355)*y(k,135) + mat(k,2026) = -rxt(k,356)*y(k,135) + mat(k,1538) = -rxt(k,357)*y(k,135) + mat(k,1829) = -rxt(k,359)*y(k,135) + mat(k,1400) = -rxt(k,360)*y(k,135) + mat(k,383) = -rxt(k,361)*y(k,135) + mat(k,1449) = -rxt(k,362)*y(k,135) + mat(k,1939) = -rxt(k,363)*y(k,135) + mat(k,1400) = mat(k,1400) + rxt(k,325)*y(k,127) + mat(k,1939) = mat(k,1939) + rxt(k,134)*y(k,98) + mat(k,1077) = rxt(k,134)*y(k,73) + mat(k,1574) = rxt(k,325)*y(k,70) + mat(k,388) = -(rxt(k,594)*y(k,32) + rxt(k,596)*y(k,109) + rxt(k,597)*y(k,72)) + mat(k,1267) = -rxt(k,594)*y(k,136) + mat(k,302) = -rxt(k,596)*y(k,136) + mat(k,1415) = -rxt(k,597)*y(k,136) + mat(k,1364) = rxt(k,587)*y(k,110) + rxt(k,588)*y(k,124) + rxt(k,600)*y(k,137) & + + rxt(k,606)*y(k,138) + mat(k,1052) = rxt(k,598)*y(k,137) + rxt(k,603)*y(k,138) + mat(k,232) = rxt(k,587)*y(k,70) + mat(k,318) = rxt(k,588)*y(k,70) + mat(k,202) = rxt(k,600)*y(k,70) + rxt(k,598)*y(k,98) + mat(k,197) = rxt(k,606)*y(k,70) + rxt(k,603)*y(k,98) + mat(k,200) = -(rxt(k,598)*y(k,98) + rxt(k,600)*y(k,70) + rxt(k,601)*y(k,72)) + mat(k,1042) = -rxt(k,598)*y(k,137) + mat(k,1348) = -rxt(k,600)*y(k,137) + mat(k,1407) = -rxt(k,601)*y(k,137) + mat(k,1042) = mat(k,1042) + rxt(k,602)*y(k,138) + mat(k,194) = rxt(k,602)*y(k,98) + mat(k,193) = -((rxt(k,602) + rxt(k,603)) * y(k,98) + rxt(k,606)*y(k,70)) + mat(k,1041) = -(rxt(k,602) + rxt(k,603)) * y(k,138) + mat(k,1347) = -rxt(k,606)*y(k,138) + mat(k,2090) = -(rxt(k,107)*y(k,90) + rxt(k,118)*y(k,96) + rxt(k,119)*y(k,94) & + + rxt(k,139)*y(k,99) + rxt(k,140)*y(k,104) + rxt(k,143)*y(k,106) & + + rxt(k,288)*y(k,111) + rxt(k,294)*y(k,115) + rxt(k,296) & + *y(k,113) + rxt(k,305)*y(k,120) + rxt(k,307)*y(k,121) + rxt(k,313) & + *y(k,123) + (rxt(k,327) + rxt(k,328)) * y(k,129) + rxt(k,329) & + *y(k,128) + rxt(k,337)*y(k,132) + rxt(k,355)*y(k,135) + rxt(k,365) & + *y(k,118) + rxt(k,366)*y(k,122) + rxt(k,367)*y(k,119) + rxt(k,372) & + *y(k,108) + rxt(k,374)*y(k,102) + rxt(k,376)*y(k,103) + rxt(k,378) & + *y(k,105) + rxt(k,390)*y(k,71) + rxt(k,509)*y(k,39) + rxt(k,557) & + *y(k,82)) + mat(k,829) = -rxt(k,107)*y(k,139) + mat(k,687) = -rxt(k,118)*y(k,139) + mat(k,1038) = -rxt(k,119)*y(k,139) + mat(k,172) = -rxt(k,139)*y(k,139) + mat(k,110) = -rxt(k,140)*y(k,139) + mat(k,114) = -rxt(k,143)*y(k,139) + mat(k,948) = -rxt(k,288)*y(k,139) + mat(k,707) = -rxt(k,294)*y(k,139) + mat(k,886) = -rxt(k,296)*y(k,139) + mat(k,178) = -rxt(k,305)*y(k,139) + mat(k,270) = -rxt(k,307)*y(k,139) + mat(k,263) = -rxt(k,313)*y(k,139) + mat(k,299) = -(rxt(k,327) + rxt(k,328)) * y(k,139) + mat(k,1623) = -rxt(k,329)*y(k,139) + mat(k,472) = -rxt(k,337)*y(k,139) + mat(k,1902) = -rxt(k,355)*y(k,139) + mat(k,1174) = -rxt(k,365)*y(k,139) + mat(k,1344) = -rxt(k,366)*y(k,139) + mat(k,1217) = -rxt(k,367)*y(k,139) + mat(k,288) = -rxt(k,372)*y(k,139) + mat(k,251) = -rxt(k,374)*y(k,139) + mat(k,1260) = -rxt(k,376)*y(k,139) + mat(k,1709) = -rxt(k,378)*y(k,139) + mat(k,808) = -rxt(k,390)*y(k,139) + mat(k,349) = -rxt(k,509)*y(k,139) + mat(k,106) = -rxt(k,557)*y(k,139) + mat(k,192) = rxt(k,514)*y(k,133) + mat(k,757) = rxt(k,532)*y(k,133) + mat(k,229) = rxt(k,516)*y(k,133) + mat(k,51) = rxt(k,517)*y(k,133) + mat(k,154) = rxt(k,519)*y(k,133) + mat(k,160) = rxt(k,535)*y(k,133) + mat(k,430) = rxt(k,536)*y(k,133) + mat(k,1785) = rxt(k,410)*y(k,101) + rxt(k,344)*y(k,134) + mat(k,666) = rxt(k,415)*y(k,133) + rxt(k,353)*y(k,135) + mat(k,220) = rxt(k,416)*y(k,133) + mat(k,331) = rxt(k,500)*y(k,133) + mat(k,121) = rxt(k,524)*y(k,133) + mat(k,2030) = (rxt(k,570)+rxt(k,575))*y(k,53) + (rxt(k,563)+rxt(k,569) & + +rxt(k,574))*y(k,54) + rxt(k,106)*y(k,91) + rxt(k,471)*y(k,133) & + + rxt(k,345)*y(k,134) + mat(k,1542) = rxt(k,295)*y(k,115) + rxt(k,447)*y(k,133) + mat(k,185) = rxt(k,423)*y(k,133) + mat(k,316) = (rxt(k,570)+rxt(k,575))*y(k,49) + mat(k,339) = (rxt(k,563)+rxt(k,569)+rxt(k,574))*y(k,49) + rxt(k,474)*y(k,133) + mat(k,282) = rxt(k,340)*y(k,133) + mat(k,412) = rxt(k,293)*y(k,114) + mat(k,1985) = rxt(k,123)*y(k,96) + mat(k,1833) = rxt(k,120)*y(k,96) + mat(k,829) = mat(k,829) + 3.000_r8*rxt(k,195)*y(k,103) + 4.000_r8*rxt(k,147) & + *y(k,105) + 5.000_r8*rxt(k,177)*y(k,107) + 2.000_r8*rxt(k,230) & + *y(k,119) + rxt(k,212)*y(k,122) + mat(k,549) = rxt(k,106)*y(k,49) + 4.000_r8*rxt(k,199)*y(k,103) & + + 5.000_r8*rxt(k,164)*y(k,105) + 6.000_r8*rxt(k,182)*y(k,107) & + + rxt(k,252)*y(k,118) + 3.000_r8*rxt(k,234)*y(k,119) & + + 2.000_r8*rxt(k,217)*y(k,122) + rxt(k,159)*y(k,128) + mat(k,533) = 3.000_r8*rxt(k,187)*y(k,103) + (4.000_r8*rxt(k,181) & + +4.000_r8*rxt(k,267))*y(k,105) + (5.000_r8*rxt(k,169) & + +5.000_r8*rxt(k,268))*y(k,107) + 2.000_r8*rxt(k,222)*y(k,119) & + + rxt(k,205)*y(k,122) + mat(k,1038) = mat(k,1038) + 3.000_r8*rxt(k,186)*y(k,103) + ( & + + 4.000_r8*rxt(k,170)+4.000_r8*rxt(k,258))*y(k,105) + ( & + + 5.000_r8*rxt(k,168)+5.000_r8*rxt(k,265))*y(k,107) & + + 2.000_r8*rxt(k,221)*y(k,119) + rxt(k,204)*y(k,122) + mat(k,518) = 5.000_r8*rxt(k,194)*y(k,103) + (6.000_r8*rxt(k,247) & + +6.000_r8*rxt(k,271))*y(k,105) + (7.000_r8*rxt(k,176) & + +7.000_r8*rxt(k,259))*y(k,107) + 2.000_r8*rxt(k,246)*y(k,118) & + + 4.000_r8*rxt(k,229)*y(k,119) + 3.000_r8*rxt(k,211)*y(k,122) & + + 2.000_r8*rxt(k,153)*y(k,128) + mat(k,687) = mat(k,687) + rxt(k,123)*y(k,62) + rxt(k,120)*y(k,63) & + + 4.000_r8*rxt(k,196)*y(k,103) + (5.000_r8*rxt(k,158) & + +5.000_r8*rxt(k,260))*y(k,105) + (6.000_r8*rxt(k,178) & + +6.000_r8*rxt(k,261))*y(k,107) + rxt(k,249)*y(k,118) & + + 3.000_r8*rxt(k,231)*y(k,119) + 2.000_r8*rxt(k,213)*y(k,122) & + + rxt(k,155)*y(k,128) + mat(k,861) = 3.000_r8*rxt(k,191)*y(k,103) + 4.000_r8*rxt(k,225)*y(k,105) & + + 5.000_r8*rxt(k,174)*y(k,107) + 2.000_r8*rxt(k,227)*y(k,119) & + + rxt(k,209)*y(k,122) + mat(k,1081) = rxt(k,138)*y(k,99) + 2.000_r8*rxt(k,382)*y(k,102) & + + 3.000_r8*rxt(k,383)*y(k,103) + 4.000_r8*rxt(k,141)*y(k,105) & + + 5.000_r8*rxt(k,144)*y(k,107) + rxt(k,381)*y(k,108) & + + 2.000_r8*rxt(k,303)*y(k,119) + 3.000_r8*rxt(k,304)*y(k,120) & + + rxt(k,308)*y(k,122) + rxt(k,326)*y(k,129) + mat(k,172) = mat(k,172) + rxt(k,138)*y(k,98) + mat(k,503) = 3.000_r8*rxt(k,189)*y(k,103) + 4.000_r8*rxt(k,203)*y(k,105) & + + 5.000_r8*rxt(k,172)*y(k,107) + 2.000_r8*rxt(k,224)*y(k,119) & + + rxt(k,207)*y(k,122) + mat(k,921) = rxt(k,410)*y(k,40) + rxt(k,417)*y(k,133) + mat(k,251) = mat(k,251) + 2.000_r8*rxt(k,382)*y(k,98) + mat(k,1260) = mat(k,1260) + 3.000_r8*rxt(k,195)*y(k,90) + 4.000_r8*rxt(k,199) & + *y(k,91) + 3.000_r8*rxt(k,187)*y(k,92) + 3.000_r8*rxt(k,186) & + *y(k,94) + 5.000_r8*rxt(k,194)*y(k,95) + 4.000_r8*rxt(k,196) & + *y(k,96) + 3.000_r8*rxt(k,191)*y(k,97) + 3.000_r8*rxt(k,383) & + *y(k,98) + 3.000_r8*rxt(k,189)*y(k,100) + 3.000_r8*rxt(k,201) & + *y(k,111) + 4.000_r8*rxt(k,197)*y(k,112) + 3.000_r8*rxt(k,188) & + *y(k,113) + 5.000_r8*rxt(k,200)*y(k,114) + 4.000_r8*rxt(k,193) & + *y(k,115) + 3.000_r8*rxt(k,198)*y(k,116) + 3.000_r8*rxt(k,185) & + *y(k,117) + 3.000_r8*rxt(k,190)*y(k,127) + mat(k,1709) = mat(k,1709) + 4.000_r8*rxt(k,147)*y(k,90) + 5.000_r8*rxt(k,164) & + *y(k,91) + (4.000_r8*rxt(k,181)+4.000_r8*rxt(k,267))*y(k,92) + ( & + + 4.000_r8*rxt(k,170)+4.000_r8*rxt(k,258))*y(k,94) + ( & + + 6.000_r8*rxt(k,247)+6.000_r8*rxt(k,271))*y(k,95) + ( & + + 5.000_r8*rxt(k,158)+5.000_r8*rxt(k,260))*y(k,96) & + + 4.000_r8*rxt(k,225)*y(k,97) + 4.000_r8*rxt(k,141)*y(k,98) & + + 4.000_r8*rxt(k,203)*y(k,100) + 4.000_r8*rxt(k,166)*y(k,111) & + + 5.000_r8*rxt(k,162)*y(k,112) + (4.000_r8*rxt(k,192) & + +4.000_r8*rxt(k,264))*y(k,113) + 6.000_r8*rxt(k,165)*y(k,114) + ( & + + 5.000_r8*rxt(k,236)+5.000_r8*rxt(k,262))*y(k,115) & + + 4.000_r8*rxt(k,163)*y(k,116) + (4.000_r8*rxt(k,146) & + +4.000_r8*rxt(k,269))*y(k,117) + 4.000_r8*rxt(k,214)*y(k,127) + mat(k,1666) = 5.000_r8*rxt(k,177)*y(k,90) + 6.000_r8*rxt(k,182)*y(k,91) + ( & + + 5.000_r8*rxt(k,169)+5.000_r8*rxt(k,268))*y(k,92) + ( & + + 5.000_r8*rxt(k,168)+5.000_r8*rxt(k,265))*y(k,94) + ( & + + 7.000_r8*rxt(k,176)+7.000_r8*rxt(k,259))*y(k,95) + ( & + + 6.000_r8*rxt(k,178)+6.000_r8*rxt(k,261))*y(k,96) & + + 5.000_r8*rxt(k,174)*y(k,97) + 5.000_r8*rxt(k,144)*y(k,98) & + + 5.000_r8*rxt(k,172)*y(k,100) + 5.000_r8*rxt(k,184)*y(k,111) & + + 6.000_r8*rxt(k,179)*y(k,112) + (5.000_r8*rxt(k,171) & + +5.000_r8*rxt(k,266))*y(k,113) + 7.000_r8*rxt(k,183)*y(k,114) + ( & + + 6.000_r8*rxt(k,175)+6.000_r8*rxt(k,263))*y(k,115) & + + 5.000_r8*rxt(k,180)*y(k,116) + (5.000_r8*rxt(k,167) & + +5.000_r8*rxt(k,270))*y(k,117) + 5.000_r8*rxt(k,173)*y(k,127) + mat(k,288) = mat(k,288) + rxt(k,381)*y(k,98) + mat(k,948) = mat(k,948) + 3.000_r8*rxt(k,201)*y(k,103) + 4.000_r8*rxt(k,166) & + *y(k,105) + 5.000_r8*rxt(k,184)*y(k,107) + 2.000_r8*rxt(k,237) & + *y(k,119) + rxt(k,219)*y(k,122) + mat(k,563) = 4.000_r8*rxt(k,197)*y(k,103) + 5.000_r8*rxt(k,162)*y(k,105) & + + 6.000_r8*rxt(k,179)*y(k,107) + rxt(k,250)*y(k,118) & + + 3.000_r8*rxt(k,232)*y(k,119) + 2.000_r8*rxt(k,215)*y(k,122) & + + rxt(k,156)*y(k,128) + mat(k,886) = mat(k,886) + 3.000_r8*rxt(k,188)*y(k,103) + (4.000_r8*rxt(k,192) & + +4.000_r8*rxt(k,264))*y(k,105) + (5.000_r8*rxt(k,171) & + +5.000_r8*rxt(k,266))*y(k,107) + 2.000_r8*rxt(k,223)*y(k,119) & + + rxt(k,206)*y(k,122) + mat(k,642) = rxt(k,293)*y(k,58) + 5.000_r8*rxt(k,200)*y(k,103) & + + 6.000_r8*rxt(k,165)*y(k,105) + 7.000_r8*rxt(k,183)*y(k,107) & + + 2.000_r8*rxt(k,253)*y(k,118) + 4.000_r8*rxt(k,235)*y(k,119) & + + 3.000_r8*rxt(k,218)*y(k,122) + 2.000_r8*rxt(k,160)*y(k,128) + mat(k,707) = mat(k,707) + rxt(k,295)*y(k,51) + 4.000_r8*rxt(k,193)*y(k,103) + ( & + + 5.000_r8*rxt(k,236)+5.000_r8*rxt(k,262))*y(k,105) + ( & + + 6.000_r8*rxt(k,175)+6.000_r8*rxt(k,263))*y(k,107) + rxt(k,245) & + *y(k,118) + 3.000_r8*rxt(k,228)*y(k,119) + 2.000_r8*rxt(k,210) & + *y(k,122) + rxt(k,152)*y(k,128) + mat(k,579) = 3.000_r8*rxt(k,198)*y(k,103) + 4.000_r8*rxt(k,163)*y(k,105) & + + 5.000_r8*rxt(k,180)*y(k,107) + 2.000_r8*rxt(k,233)*y(k,119) & + + rxt(k,216)*y(k,122) + mat(k,622) = 3.000_r8*rxt(k,185)*y(k,103) + (4.000_r8*rxt(k,146) & + +4.000_r8*rxt(k,269))*y(k,105) + (5.000_r8*rxt(k,167) & + +5.000_r8*rxt(k,270))*y(k,107) + 2.000_r8*rxt(k,220)*y(k,119) & + + rxt(k,202)*y(k,122) + mat(k,1174) = mat(k,1174) + rxt(k,252)*y(k,91) + 2.000_r8*rxt(k,246)*y(k,95) & + + rxt(k,249)*y(k,96) + rxt(k,250)*y(k,112) + 2.000_r8*rxt(k,253) & + *y(k,114) + rxt(k,245)*y(k,115) + mat(k,1217) = mat(k,1217) + 2.000_r8*rxt(k,230)*y(k,90) + 3.000_r8*rxt(k,234) & + *y(k,91) + 2.000_r8*rxt(k,222)*y(k,92) + 2.000_r8*rxt(k,221) & + *y(k,94) + 4.000_r8*rxt(k,229)*y(k,95) + 3.000_r8*rxt(k,231) & + *y(k,96) + 2.000_r8*rxt(k,227)*y(k,97) + 2.000_r8*rxt(k,303) & + *y(k,98) + 2.000_r8*rxt(k,224)*y(k,100) + 2.000_r8*rxt(k,237) & + *y(k,111) + 3.000_r8*rxt(k,232)*y(k,112) + 2.000_r8*rxt(k,223) & + *y(k,113) + 4.000_r8*rxt(k,235)*y(k,114) + 3.000_r8*rxt(k,228) & + *y(k,115) + 2.000_r8*rxt(k,233)*y(k,116) + 2.000_r8*rxt(k,220) & + *y(k,117) + 2.000_r8*rxt(k,226)*y(k,127) + mat(k,178) = mat(k,178) + 3.000_r8*rxt(k,304)*y(k,98) + mat(k,1344) = mat(k,1344) + rxt(k,212)*y(k,90) + 2.000_r8*rxt(k,217)*y(k,91) & + + rxt(k,205)*y(k,92) + rxt(k,204)*y(k,94) + 3.000_r8*rxt(k,211) & + *y(k,95) + 2.000_r8*rxt(k,213)*y(k,96) + rxt(k,209)*y(k,97) & + + rxt(k,308)*y(k,98) + rxt(k,207)*y(k,100) + rxt(k,219)*y(k,111) & + + 2.000_r8*rxt(k,215)*y(k,112) + rxt(k,206)*y(k,113) & + + 3.000_r8*rxt(k,218)*y(k,114) + 2.000_r8*rxt(k,210)*y(k,115) & + + rxt(k,216)*y(k,116) + rxt(k,202)*y(k,117) + rxt(k,208) & + *y(k,127) + mat(k,1578) = 3.000_r8*rxt(k,190)*y(k,103) + 4.000_r8*rxt(k,214)*y(k,105) & + + 5.000_r8*rxt(k,173)*y(k,107) + 2.000_r8*rxt(k,226)*y(k,119) & + + rxt(k,208)*y(k,122) + mat(k,1623) = mat(k,1623) + rxt(k,159)*y(k,91) + 2.000_r8*rxt(k,153)*y(k,95) & + + rxt(k,155)*y(k,96) + rxt(k,156)*y(k,112) + 2.000_r8*rxt(k,160) & + *y(k,114) + rxt(k,152)*y(k,115) + mat(k,299) = mat(k,299) + rxt(k,326)*y(k,98) + mat(k,1005) = rxt(k,514)*y(k,16) + rxt(k,532)*y(k,17) + rxt(k,516)*y(k,18) & + + rxt(k,517)*y(k,19) + rxt(k,519)*y(k,20) + rxt(k,535)*y(k,22) & + + rxt(k,536)*y(k,23) + rxt(k,415)*y(k,41) + rxt(k,416)*y(k,43) & + + rxt(k,500)*y(k,45) + rxt(k,524)*y(k,48) + rxt(k,471)*y(k,49) & + + rxt(k,447)*y(k,51) + rxt(k,423)*y(k,52) + rxt(k,474)*y(k,54) & + + rxt(k,340)*y(k,55) + rxt(k,417)*y(k,101) + 2.000_r8*rxt(k,420) & + *y(k,133) + mat(k,1866) = rxt(k,344)*y(k,40) + rxt(k,345)*y(k,49) + mat(k,1902) = mat(k,1902) + rxt(k,353)*y(k,41) + end do + end subroutine nlnmat10 + 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) = mat(k, 29) + lmat(k, 29) + mat(k, 31) = mat(k, 31) + lmat(k, 31) + mat(k, 32) = mat(k, 32) + lmat(k, 32) + mat(k, 33) = mat(k, 33) + lmat(k, 33) + mat(k, 34) = mat(k, 34) + lmat(k, 34) + mat(k, 36) = mat(k, 36) + lmat(k, 36) + mat(k, 37) = mat(k, 37) + lmat(k, 37) + mat(k, 39) = mat(k, 39) + lmat(k, 39) + mat(k, 40) = mat(k, 40) + lmat(k, 40) + mat(k, 41) = mat(k, 41) + lmat(k, 41) + mat(k, 43) = mat(k, 43) + lmat(k, 43) + mat(k, 44) = mat(k, 44) + lmat(k, 44) + mat(k, 45) = mat(k, 45) + lmat(k, 45) + mat(k, 47) = mat(k, 47) + lmat(k, 47) + mat(k, 48) = mat(k, 48) + lmat(k, 48) + mat(k, 50) = mat(k, 50) + lmat(k, 50) + mat(k, 52) = lmat(k, 52) + mat(k, 53) = lmat(k, 53) + mat(k, 54) = lmat(k, 54) + mat(k, 55) = mat(k, 55) + lmat(k, 55) + mat(k, 56) = mat(k, 56) + lmat(k, 56) + mat(k, 57) = mat(k, 57) + lmat(k, 57) + mat(k, 59) = mat(k, 59) + lmat(k, 59) + mat(k, 60) = mat(k, 60) + lmat(k, 60) + mat(k, 61) = mat(k, 61) + lmat(k, 61) + mat(k, 62) = mat(k, 62) + lmat(k, 62) + mat(k, 63) = mat(k, 63) + lmat(k, 63) + mat(k, 65) = mat(k, 65) + lmat(k, 65) + 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, 70) = mat(k, 70) + lmat(k, 70) + mat(k, 71) = mat(k, 71) + lmat(k, 71) + mat(k, 72) = mat(k, 72) + lmat(k, 72) + mat(k, 74) = mat(k, 74) + lmat(k, 74) + mat(k, 75) = lmat(k, 75) + mat(k, 76) = lmat(k, 76) + mat(k, 77) = mat(k, 77) + lmat(k, 77) + mat(k, 78) = mat(k, 78) + lmat(k, 78) + mat(k, 80) = mat(k, 80) + lmat(k, 80) + mat(k, 81) = mat(k, 81) + lmat(k, 81) + mat(k, 84) = mat(k, 84) + lmat(k, 84) + mat(k, 85) = mat(k, 85) + lmat(k, 85) + mat(k, 86) = mat(k, 86) + lmat(k, 86) + mat(k, 88) = 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, 94) = mat(k, 94) + lmat(k, 94) + mat(k, 95) = lmat(k, 95) + mat(k, 96) = lmat(k, 96) + mat(k, 97) = lmat(k, 97) + mat(k, 98) = mat(k, 98) + lmat(k, 98) + mat(k, 99) = mat(k, 99) + lmat(k, 99) + mat(k, 103) = mat(k, 103) + lmat(k, 103) + mat(k, 104) = lmat(k, 104) + mat(k, 105) = lmat(k, 105) + mat(k, 107) = mat(k, 107) + lmat(k, 107) + mat(k, 111) = mat(k, 111) + lmat(k, 111) + mat(k, 115) = mat(k, 115) + lmat(k, 115) + mat(k, 116) = mat(k, 116) + lmat(k, 116) + mat(k, 120) = mat(k, 120) + lmat(k, 120) + mat(k, 122) = lmat(k, 122) + mat(k, 123) = lmat(k, 123) + mat(k, 124) = lmat(k, 124) + mat(k, 125) = mat(k, 125) + lmat(k, 125) + mat(k, 131) = mat(k, 131) + lmat(k, 131) + mat(k, 132) = mat(k, 132) + lmat(k, 132) + mat(k, 133) = lmat(k, 133) + mat(k, 134) = mat(k, 134) + lmat(k, 134) + mat(k, 137) = mat(k, 137) + lmat(k, 137) + mat(k, 138) = lmat(k, 138) + mat(k, 139) = mat(k, 139) + lmat(k, 139) + mat(k, 140) = mat(k, 140) + lmat(k, 140) + mat(k, 141) = lmat(k, 141) + mat(k, 147) = mat(k, 147) + lmat(k, 147) + mat(k, 149) = lmat(k, 149) + mat(k, 152) = mat(k, 152) + lmat(k, 152) + mat(k, 155) = mat(k, 155) + lmat(k, 155) + mat(k, 157) = mat(k, 157) + lmat(k, 157) + mat(k, 158) = mat(k, 158) + lmat(k, 158) + mat(k, 159) = lmat(k, 159) + mat(k, 161) = mat(k, 161) + lmat(k, 161) + mat(k, 162) = mat(k, 162) + lmat(k, 162) + mat(k, 167) = mat(k, 167) + lmat(k, 167) + mat(k, 173) = mat(k, 173) + lmat(k, 173) + mat(k, 179) = mat(k, 179) + lmat(k, 179) + mat(k, 180) = lmat(k, 180) + mat(k, 181) = mat(k, 181) + lmat(k, 181) + mat(k, 183) = lmat(k, 183) + mat(k, 184) = mat(k, 184) + lmat(k, 184) + mat(k, 186) = mat(k, 186) + lmat(k, 186) + mat(k, 187) = mat(k, 187) + lmat(k, 187) + mat(k, 193) = mat(k, 193) + lmat(k, 193) + mat(k, 194) = mat(k, 194) + lmat(k, 194) + mat(k, 195) = lmat(k, 195) + mat(k, 196) = lmat(k, 196) + mat(k, 197) = mat(k, 197) + lmat(k, 197) + mat(k, 198) = lmat(k, 198) + mat(k, 199) = lmat(k, 199) + mat(k, 200) = mat(k, 200) + lmat(k, 200) + mat(k, 201) = lmat(k, 201) + mat(k, 202) = mat(k, 202) + lmat(k, 202) + mat(k, 203) = mat(k, 203) + lmat(k, 203) + mat(k, 206) = mat(k, 206) + lmat(k, 206) + mat(k, 207) = lmat(k, 207) + mat(k, 208) = lmat(k, 208) + mat(k, 209) = mat(k, 209) + lmat(k, 209) + mat(k, 211) = lmat(k, 211) + mat(k, 212) = mat(k, 212) + lmat(k, 212) + mat(k, 213) = lmat(k, 213) + mat(k, 214) = mat(k, 214) + lmat(k, 214) + mat(k, 216) = mat(k, 216) + lmat(k, 216) + mat(k, 221) = mat(k, 221) + lmat(k, 221) + mat(k, 222) = lmat(k, 222) + mat(k, 223) = mat(k, 223) + lmat(k, 223) + mat(k, 230) = mat(k, 230) + lmat(k, 230) + mat(k, 239) = mat(k, 239) + lmat(k, 239) + mat(k, 244) = mat(k, 244) + lmat(k, 244) + mat(k, 245) = lmat(k, 245) + mat(k, 246) = mat(k, 246) + lmat(k, 246) + mat(k, 247) = lmat(k, 247) + mat(k, 251) = mat(k, 251) + lmat(k, 251) + mat(k, 252) = mat(k, 252) + lmat(k, 252) + mat(k, 256) = mat(k, 256) + lmat(k, 256) + mat(k, 259) = lmat(k, 259) + mat(k, 264) = mat(k, 264) + lmat(k, 264) + mat(k, 266) = lmat(k, 266) + mat(k, 267) = mat(k, 267) + lmat(k, 267) + mat(k, 271) = mat(k, 271) + lmat(k, 271) + mat(k, 278) = mat(k, 278) + lmat(k, 278) + mat(k, 279) = mat(k, 279) + lmat(k, 279) + mat(k, 281) = lmat(k, 281) + mat(k, 284) = mat(k, 284) + lmat(k, 284) + mat(k, 292) = mat(k, 292) + lmat(k, 292) + mat(k, 297) = lmat(k, 297) + mat(k, 299) = mat(k, 299) + lmat(k, 299) + mat(k, 300) = mat(k, 300) + lmat(k, 300) + mat(k, 309) = mat(k, 309) + lmat(k, 309) + mat(k, 310) = lmat(k, 310) + mat(k, 312) = mat(k, 312) + lmat(k, 312) + mat(k, 317) = mat(k, 317) + lmat(k, 317) + mat(k, 324) = mat(k, 324) + lmat(k, 324) + mat(k, 325) = mat(k, 325) + lmat(k, 325) + mat(k, 330) = mat(k, 330) + lmat(k, 330) + mat(k, 333) = mat(k, 333) + lmat(k, 333) + mat(k, 334) = mat(k, 334) + lmat(k, 334) + mat(k, 337) = mat(k, 337) + lmat(k, 337) + mat(k, 341) = mat(k, 341) + lmat(k, 341) + mat(k, 351) = mat(k, 351) + lmat(k, 351) + mat(k, 352) = lmat(k, 352) + mat(k, 355) = lmat(k, 355) + mat(k, 358) = mat(k, 358) + lmat(k, 358) + mat(k, 359) = mat(k, 359) + lmat(k, 359) + mat(k, 361) = mat(k, 361) + lmat(k, 361) + mat(k, 363) = mat(k, 363) + lmat(k, 363) + mat(k, 364) = mat(k, 364) + lmat(k, 364) + mat(k, 365) = mat(k, 365) + lmat(k, 365) + mat(k, 366) = lmat(k, 366) + mat(k, 369) = mat(k, 369) + lmat(k, 369) + mat(k, 377) = mat(k, 377) + lmat(k, 377) + mat(k, 380) = mat(k, 380) + lmat(k, 380) + mat(k, 388) = mat(k, 388) + lmat(k, 388) + mat(k, 389) = lmat(k, 389) + mat(k, 393) = lmat(k, 393) + mat(k, 401) = mat(k, 401) + lmat(k, 401) + mat(k, 405) = lmat(k, 405) + mat(k, 406) = mat(k, 406) + lmat(k, 406) + mat(k, 409) = lmat(k, 409) + mat(k, 410) = lmat(k, 410) + mat(k, 411) = lmat(k, 411) + mat(k, 414) = lmat(k, 414) + mat(k, 416) = mat(k, 416) + lmat(k, 416) + mat(k, 417) = mat(k, 417) + lmat(k, 417) + mat(k, 418) = mat(k, 418) + lmat(k, 418) + mat(k, 419) = mat(k, 419) + lmat(k, 419) + mat(k, 422) = mat(k, 422) + lmat(k, 422) + mat(k, 423) = lmat(k, 423) + mat(k, 424) = lmat(k, 424) + mat(k, 428) = mat(k, 428) + lmat(k, 428) + mat(k, 430) = mat(k, 430) + lmat(k, 430) + mat(k, 432) = mat(k, 432) + lmat(k, 432) + mat(k, 444) = lmat(k, 444) + mat(k, 446) = mat(k, 446) + lmat(k, 446) + mat(k, 450) = lmat(k, 450) + mat(k, 461) = mat(k, 461) + lmat(k, 461) + mat(k, 474) = lmat(k, 474) + mat(k, 476) = mat(k, 476) + lmat(k, 476) + mat(k, 482) = mat(k, 482) + lmat(k, 482) + mat(k, 490) = mat(k, 490) + lmat(k, 490) + mat(k, 504) = mat(k, 504) + lmat(k, 504) + mat(k, 505) = lmat(k, 505) + mat(k, 518) = mat(k, 518) + lmat(k, 518) + mat(k, 519) = mat(k, 519) + lmat(k, 519) + mat(k, 520) = lmat(k, 520) + mat(k, 532) = mat(k, 532) + lmat(k, 532) + mat(k, 535) = mat(k, 535) + lmat(k, 535) + mat(k, 536) = lmat(k, 536) + mat(k, 549) = mat(k, 549) + lmat(k, 549) + mat(k, 550) = mat(k, 550) + lmat(k, 550) + mat(k, 551) = lmat(k, 551) + mat(k, 563) = mat(k, 563) + lmat(k, 563) + mat(k, 564) = mat(k, 564) + lmat(k, 564) + mat(k, 582) = mat(k, 582) + lmat(k, 582) + mat(k, 594) = mat(k, 594) + lmat(k, 594) + mat(k, 598) = mat(k, 598) + lmat(k, 598) + mat(k, 601) = mat(k, 601) + lmat(k, 601) + mat(k, 606) = lmat(k, 606) + mat(k, 607) = mat(k, 607) + lmat(k, 607) + mat(k, 609) = mat(k, 609) + lmat(k, 609) + mat(k, 610) = lmat(k, 610) + mat(k, 616) = mat(k, 616) + lmat(k, 616) + mat(k, 625) = mat(k, 625) + lmat(k, 625) + mat(k, 626) = lmat(k, 626) + mat(k, 642) = mat(k, 642) + lmat(k, 642) + mat(k, 647) = mat(k, 647) + lmat(k, 647) + mat(k, 669) = mat(k, 669) + lmat(k, 669) + mat(k, 673) = lmat(k, 673) + mat(k, 687) = mat(k, 687) + lmat(k, 687) + mat(k, 691) = mat(k, 691) + lmat(k, 691) + mat(k, 692) = lmat(k, 692) + mat(k, 707) = mat(k, 707) + lmat(k, 707) + mat(k, 714) = mat(k, 714) + lmat(k, 714) + mat(k, 715) = mat(k, 715) + lmat(k, 715) + mat(k, 722) = mat(k, 722) + lmat(k, 722) + mat(k, 733) = mat(k, 733) + lmat(k, 733) + mat(k, 736) = lmat(k, 736) + mat(k, 738) = mat(k, 738) + lmat(k, 738) + mat(k, 750) = mat(k, 750) + lmat(k, 750) + mat(k, 787) = mat(k, 787) + lmat(k, 787) + mat(k, 794) = mat(k, 794) + lmat(k, 794) + mat(k, 811) = mat(k, 811) + lmat(k, 811) + mat(k, 833) = mat(k, 833) + lmat(k, 833) + mat(k, 844) = mat(k, 844) + lmat(k, 844) + mat(k, 850) = lmat(k, 850) + mat(k, 866) = mat(k, 866) + lmat(k, 866) + mat(k, 868) = lmat(k, 868) + mat(k, 880) = mat(k, 880) + lmat(k, 880) + mat(k, 889) = mat(k, 889) + lmat(k, 889) + mat(k, 900) = mat(k, 900) + lmat(k, 900) + mat(k, 926) = mat(k, 926) + lmat(k, 926) + mat(k, 928) = lmat(k, 928) + mat(k, 943) = mat(k, 943) + lmat(k, 943) + mat(k, 984) = mat(k, 984) + lmat(k, 984) + mat(k,1014) = mat(k,1014) + lmat(k,1014) + mat(k,1020) = mat(k,1020) + lmat(k,1020) + mat(k,1034) = lmat(k,1034) + mat(k,1058) = mat(k,1058) + lmat(k,1058) + mat(k,1104) = mat(k,1104) + lmat(k,1104) + mat(k,1110) = mat(k,1110) + lmat(k,1110) + mat(k,1112) = mat(k,1112) + lmat(k,1112) + mat(k,1127) = lmat(k,1127) + mat(k,1153) = mat(k,1153) + lmat(k,1153) + mat(k,1197) = mat(k,1197) + lmat(k,1197) + mat(k,1218) = lmat(k,1218) + mat(k,1241) = mat(k,1241) + lmat(k,1241) + mat(k,1260) = mat(k,1260) + lmat(k,1260) + mat(k,1263) = mat(k,1263) + lmat(k,1263) + mat(k,1284) = mat(k,1284) + lmat(k,1284) + mat(k,1286) = lmat(k,1286) + mat(k,1327) = mat(k,1327) + lmat(k,1327) + mat(k,1347) = mat(k,1347) + lmat(k,1347) + mat(k,1348) = mat(k,1348) + lmat(k,1348) + mat(k,1364) = mat(k,1364) + lmat(k,1364) + mat(k,1381) = mat(k,1381) + lmat(k,1381) + mat(k,1388) = mat(k,1388) + lmat(k,1388) + mat(k,1406) = lmat(k,1406) + mat(k,1407) = mat(k,1407) + lmat(k,1407) + mat(k,1415) = mat(k,1415) + lmat(k,1415) + mat(k,1423) = mat(k,1423) + lmat(k,1423) + mat(k,1430) = mat(k,1430) + lmat(k,1430) + mat(k,1437) = mat(k,1437) + lmat(k,1437) + mat(k,1438) = mat(k,1438) + lmat(k,1438) + mat(k,1442) = mat(k,1442) + lmat(k,1442) + mat(k,1487) = mat(k,1487) + lmat(k,1487) + mat(k,1517) = mat(k,1517) + lmat(k,1517) + mat(k,1529) = mat(k,1529) + lmat(k,1529) + mat(k,1536) = lmat(k,1536) + mat(k,1555) = mat(k,1555) + lmat(k,1555) + mat(k,1563) = mat(k,1563) + lmat(k,1563) + mat(k,1566) = mat(k,1566) + lmat(k,1566) + mat(k,1602) = mat(k,1602) + lmat(k,1602) + mat(k,1612) = mat(k,1612) + lmat(k,1612) + mat(k,1621) = mat(k,1621) + lmat(k,1621) + mat(k,1656) = mat(k,1656) + lmat(k,1656) + mat(k,1657) = lmat(k,1657) + mat(k,1666) = mat(k,1666) + lmat(k,1666) + mat(k,1690) = lmat(k,1690) + mat(k,1700) = mat(k,1700) + lmat(k,1700) + mat(k,1709) = mat(k,1709) + lmat(k,1709) + mat(k,1733) = mat(k,1733) + lmat(k,1733) + mat(k,1734) = mat(k,1734) + lmat(k,1734) + mat(k,1736) = mat(k,1736) + lmat(k,1736) + mat(k,1741) = mat(k,1741) + lmat(k,1741) + mat(k,1743) = mat(k,1743) + lmat(k,1743) + mat(k,1747) = mat(k,1747) + lmat(k,1747) + mat(k,1778) = mat(k,1778) + lmat(k,1778) + mat(k,1808) = mat(k,1808) + lmat(k,1808) + mat(k,1817) = mat(k,1817) + lmat(k,1817) + mat(k,1820) = mat(k,1820) + lmat(k,1820) + mat(k,1827) = mat(k,1827) + lmat(k,1827) + mat(k,1831) = mat(k,1831) + lmat(k,1831) + mat(k,1841) = mat(k,1841) + lmat(k,1841) + mat(k,1843) = mat(k,1843) + lmat(k,1843) + mat(k,1861) = mat(k,1861) + lmat(k,1861) + mat(k,1879) = mat(k,1879) + lmat(k,1879) + mat(k,1886) = mat(k,1886) + lmat(k,1886) + mat(k,1898) = mat(k,1898) + lmat(k,1898) + mat(k,1906) = mat(k,1906) + lmat(k,1906) + mat(k,1913) = mat(k,1913) + lmat(k,1913) + mat(k,1927) = mat(k,1927) + lmat(k,1927) + mat(k,1928) = mat(k,1928) + lmat(k,1928) + mat(k,1940) = mat(k,1940) + lmat(k,1940) + mat(k,1947) = mat(k,1947) + lmat(k,1947) + mat(k,1962) = mat(k,1962) + lmat(k,1962) + mat(k,1964) = mat(k,1964) + lmat(k,1964) + mat(k,1969) = mat(k,1969) + lmat(k,1969) + mat(k,1983) = mat(k,1983) + lmat(k,1983) + mat(k,2016) = mat(k,2016) + lmat(k,2016) + mat(k,2023) = mat(k,2023) + lmat(k,2023) + mat(k,2029) = mat(k,2029) + lmat(k,2029) + mat(k,2055) = lmat(k,2055) + mat(k,2060) = mat(k,2060) + lmat(k,2060) + mat(k,2065) = mat(k,2065) + lmat(k,2065) + mat(k,2074) = lmat(k,2074) + mat(k,2083) = lmat(k,2083) + mat(k,2090) = mat(k,2090) + lmat(k,2090) + mat(k, 91) = 0._r8 + mat(k, 117) = 0._r8 + mat(k, 286) = 0._r8 + mat(k, 290) = 0._r8 + mat(k, 295) = 0._r8 + mat(k, 298) = 0._r8 + mat(k, 314) = 0._r8 + mat(k, 356) = 0._r8 + mat(k, 368) = 0._r8 + mat(k, 390) = 0._r8 + mat(k, 391) = 0._r8 + mat(k, 392) = 0._r8 + mat(k, 398) = 0._r8 + mat(k, 426) = 0._r8 + mat(k, 427) = 0._r8 + mat(k, 435) = 0._r8 + mat(k, 439) = 0._r8 + mat(k, 442) = 0._r8 + mat(k, 445) = 0._r8 + mat(k, 447) = 0._r8 + mat(k, 448) = 0._r8 + mat(k, 452) = 0._r8 + mat(k, 462) = 0._r8 + mat(k, 464) = 0._r8 + mat(k, 467) = 0._r8 + mat(k, 469) = 0._r8 + mat(k, 470) = 0._r8 + mat(k, 479) = 0._r8 + mat(k, 489) = 0._r8 + mat(k, 585) = 0._r8 + mat(k, 587) = 0._r8 + mat(k, 588) = 0._r8 + mat(k, 589) = 0._r8 + mat(k, 591) = 0._r8 + mat(k, 593) = 0._r8 + mat(k, 627) = 0._r8 + mat(k, 632) = 0._r8 + mat(k, 640) = 0._r8 + mat(k, 645) = 0._r8 + mat(k, 646) = 0._r8 + mat(k, 648) = 0._r8 + mat(k, 650) = 0._r8 + mat(k, 653) = 0._r8 + mat(k, 654) = 0._r8 + mat(k, 656) = 0._r8 + mat(k, 658) = 0._r8 + mat(k, 659) = 0._r8 + mat(k, 661) = 0._r8 + mat(k, 664) = 0._r8 + mat(k, 697) = 0._r8 + mat(k, 705) = 0._r8 + mat(k, 716) = 0._r8 + mat(k, 717) = 0._r8 + mat(k, 721) = 0._r8 + mat(k, 725) = 0._r8 + mat(k, 726) = 0._r8 + mat(k, 727) = 0._r8 + mat(k, 729) = 0._r8 + mat(k, 731) = 0._r8 + mat(k, 732) = 0._r8 + mat(k, 737) = 0._r8 + mat(k, 739) = 0._r8 + mat(k, 742) = 0._r8 + mat(k, 743) = 0._r8 + mat(k, 744) = 0._r8 + mat(k, 746) = 0._r8 + mat(k, 751) = 0._r8 + mat(k, 752) = 0._r8 + mat(k, 753) = 0._r8 + mat(k, 754) = 0._r8 + mat(k, 755) = 0._r8 + mat(k, 779) = 0._r8 + mat(k, 782) = 0._r8 + mat(k, 790) = 0._r8 + mat(k, 792) = 0._r8 + mat(k, 793) = 0._r8 + mat(k, 797) = 0._r8 + mat(k, 798) = 0._r8 + mat(k, 799) = 0._r8 + mat(k, 800) = 0._r8 + mat(k, 802) = 0._r8 + mat(k, 803) = 0._r8 + mat(k, 804) = 0._r8 + mat(k, 834) = 0._r8 + mat(k, 836) = 0._r8 + mat(k, 839) = 0._r8 + mat(k, 849) = 0._r8 + mat(k, 855) = 0._r8 + mat(k, 856) = 0._r8 + mat(k, 857) = 0._r8 + mat(k, 875) = 0._r8 + mat(k, 881) = 0._r8 + mat(k, 882) = 0._r8 + mat(k, 898) = 0._r8 + mat(k, 899) = 0._r8 + mat(k, 902) = 0._r8 + mat(k, 904) = 0._r8 + mat(k, 905) = 0._r8 + mat(k, 910) = 0._r8 + mat(k, 911) = 0._r8 + mat(k, 912) = 0._r8 + mat(k, 916) = 0._r8 + mat(k, 917) = 0._r8 + mat(k, 927) = 0._r8 + mat(k, 934) = 0._r8 + mat(k, 971) = 0._r8 + mat(k, 982) = 0._r8 + mat(k, 985) = 0._r8 + mat(k, 987) = 0._r8 + mat(k, 988) = 0._r8 + mat(k, 995) = 0._r8 + mat(k, 996) = 0._r8 + mat(k,1000) = 0._r8 + mat(k,1001) = 0._r8 + mat(k,1009) = 0._r8 + mat(k,1015) = 0._r8 + mat(k,1030) = 0._r8 + mat(k,1035) = 0._r8 + mat(k,1037) = 0._r8 + mat(k,1047) = 0._r8 + mat(k,1051) = 0._r8 + mat(k,1056) = 0._r8 + mat(k,1059) = 0._r8 + mat(k,1067) = 0._r8 + mat(k,1068) = 0._r8 + mat(k,1073) = 0._r8 + mat(k,1075) = 0._r8 + mat(k,1076) = 0._r8 + mat(k,1080) = 0._r8 + mat(k,1095) = 0._r8 + mat(k,1098) = 0._r8 + mat(k,1103) = 0._r8 + mat(k,1105) = 0._r8 + mat(k,1106) = 0._r8 + mat(k,1107) = 0._r8 + mat(k,1109) = 0._r8 + mat(k,1113) = 0._r8 + mat(k,1115) = 0._r8 + mat(k,1116) = 0._r8 + mat(k,1117) = 0._r8 + mat(k,1119) = 0._r8 + mat(k,1123) = 0._r8 + mat(k,1126) = 0._r8 + mat(k,1130) = 0._r8 + mat(k,1131) = 0._r8 + mat(k,1143) = 0._r8 + mat(k,1147) = 0._r8 + mat(k,1152) = 0._r8 + mat(k,1154) = 0._r8 + mat(k,1155) = 0._r8 + mat(k,1163) = 0._r8 + mat(k,1164) = 0._r8 + mat(k,1165) = 0._r8 + mat(k,1167) = 0._r8 + mat(k,1169) = 0._r8 + mat(k,1170) = 0._r8 + mat(k,1171) = 0._r8 + mat(k,1176) = 0._r8 + mat(k,1190) = 0._r8 + mat(k,1195) = 0._r8 + mat(k,1196) = 0._r8 + mat(k,1198) = 0._r8 + mat(k,1200) = 0._r8 + mat(k,1206) = 0._r8 + mat(k,1207) = 0._r8 + mat(k,1208) = 0._r8 + mat(k,1210) = 0._r8 + mat(k,1212) = 0._r8 + mat(k,1213) = 0._r8 + mat(k,1214) = 0._r8 + mat(k,1219) = 0._r8 + mat(k,1233) = 0._r8 + mat(k,1238) = 0._r8 + mat(k,1239) = 0._r8 + mat(k,1240) = 0._r8 + mat(k,1243) = 0._r8 + mat(k,1249) = 0._r8 + mat(k,1250) = 0._r8 + mat(k,1255) = 0._r8 + mat(k,1256) = 0._r8 + mat(k,1257) = 0._r8 + mat(k,1258) = 0._r8 + mat(k,1268) = 0._r8 + mat(k,1269) = 0._r8 + mat(k,1272) = 0._r8 + mat(k,1274) = 0._r8 + mat(k,1275) = 0._r8 + mat(k,1276) = 0._r8 + mat(k,1277) = 0._r8 + mat(k,1279) = 0._r8 + mat(k,1280) = 0._r8 + mat(k,1282) = 0._r8 + mat(k,1283) = 0._r8 + mat(k,1285) = 0._r8 + mat(k,1288) = 0._r8 + mat(k,1289) = 0._r8 + mat(k,1292) = 0._r8 + mat(k,1293) = 0._r8 + mat(k,1294) = 0._r8 + mat(k,1295) = 0._r8 + mat(k,1296) = 0._r8 + mat(k,1299) = 0._r8 + mat(k,1300) = 0._r8 + mat(k,1301) = 0._r8 + mat(k,1302) = 0._r8 + mat(k,1322) = 0._r8 + mat(k,1323) = 0._r8 + mat(k,1325) = 0._r8 + mat(k,1333) = 0._r8 + mat(k,1334) = 0._r8 + mat(k,1335) = 0._r8 + mat(k,1339) = 0._r8 + mat(k,1340) = 0._r8 + mat(k,1341) = 0._r8 + mat(k,1354) = 0._r8 + mat(k,1360) = 0._r8 + mat(k,1373) = 0._r8 + mat(k,1384) = 0._r8 + mat(k,1385) = 0._r8 + mat(k,1387) = 0._r8 + mat(k,1391) = 0._r8 + mat(k,1394) = 0._r8 + mat(k,1395) = 0._r8 + mat(k,1404) = 0._r8 + mat(k,1419) = 0._r8 + mat(k,1421) = 0._r8 + mat(k,1422) = 0._r8 + mat(k,1424) = 0._r8 + mat(k,1425) = 0._r8 + mat(k,1427) = 0._r8 + mat(k,1428) = 0._r8 + mat(k,1431) = 0._r8 + mat(k,1433) = 0._r8 + mat(k,1434) = 0._r8 + mat(k,1436) = 0._r8 + mat(k,1439) = 0._r8 + mat(k,1440) = 0._r8 + mat(k,1443) = 0._r8 + mat(k,1444) = 0._r8 + mat(k,1445) = 0._r8 + mat(k,1447) = 0._r8 + mat(k,1448) = 0._r8 + mat(k,1452) = 0._r8 + mat(k,1453) = 0._r8 + mat(k,1468) = 0._r8 + mat(k,1470) = 0._r8 + mat(k,1473) = 0._r8 + mat(k,1478) = 0._r8 + mat(k,1480) = 0._r8 + mat(k,1481) = 0._r8 + mat(k,1482) = 0._r8 + mat(k,1484) = 0._r8 + mat(k,1488) = 0._r8 + mat(k,1490) = 0._r8 + mat(k,1491) = 0._r8 + mat(k,1492) = 0._r8 + mat(k,1499) = 0._r8 + mat(k,1501) = 0._r8 + mat(k,1505) = 0._r8 + mat(k,1506) = 0._r8 + mat(k,1509) = 0._r8 + mat(k,1511) = 0._r8 + mat(k,1512) = 0._r8 + mat(k,1519) = 0._r8 + mat(k,1520) = 0._r8 + mat(k,1521) = 0._r8 + mat(k,1522) = 0._r8 + mat(k,1523) = 0._r8 + mat(k,1525) = 0._r8 + mat(k,1526) = 0._r8 + mat(k,1527) = 0._r8 + mat(k,1528) = 0._r8 + mat(k,1531) = 0._r8 + mat(k,1532) = 0._r8 + mat(k,1533) = 0._r8 + mat(k,1535) = 0._r8 + mat(k,1537) = 0._r8 + mat(k,1539) = 0._r8 + mat(k,1540) = 0._r8 + mat(k,1546) = 0._r8 + mat(k,1553) = 0._r8 + mat(k,1554) = 0._r8 + mat(k,1570) = 0._r8 + mat(k,1573) = 0._r8 + mat(k,1596) = 0._r8 + mat(k,1601) = 0._r8 + mat(k,1603) = 0._r8 + mat(k,1604) = 0._r8 + mat(k,1606) = 0._r8 + mat(k,1613) = 0._r8 + mat(k,1614) = 0._r8 + mat(k,1616) = 0._r8 + mat(k,1618) = 0._r8 + mat(k,1619) = 0._r8 + mat(k,1620) = 0._r8 + mat(k,1639) = 0._r8 + mat(k,1644) = 0._r8 + mat(k,1645) = 0._r8 + mat(k,1646) = 0._r8 + mat(k,1647) = 0._r8 + mat(k,1649) = 0._r8 + mat(k,1655) = 0._r8 + mat(k,1661) = 0._r8 + mat(k,1662) = 0._r8 + mat(k,1663) = 0._r8 + mat(k,1664) = 0._r8 + mat(k,1682) = 0._r8 + mat(k,1687) = 0._r8 + mat(k,1688) = 0._r8 + mat(k,1689) = 0._r8 + mat(k,1692) = 0._r8 + mat(k,1698) = 0._r8 + mat(k,1704) = 0._r8 + mat(k,1705) = 0._r8 + mat(k,1706) = 0._r8 + mat(k,1707) = 0._r8 + mat(k,1714) = 0._r8 + mat(k,1715) = 0._r8 + mat(k,1716) = 0._r8 + mat(k,1717) = 0._r8 + mat(k,1718) = 0._r8 + mat(k,1719) = 0._r8 + mat(k,1721) = 0._r8 + mat(k,1722) = 0._r8 + mat(k,1724) = 0._r8 + mat(k,1726) = 0._r8 + mat(k,1727) = 0._r8 + mat(k,1728) = 0._r8 + mat(k,1729) = 0._r8 + mat(k,1730) = 0._r8 + mat(k,1731) = 0._r8 + mat(k,1732) = 0._r8 + mat(k,1735) = 0._r8 + mat(k,1737) = 0._r8 + mat(k,1738) = 0._r8 + mat(k,1739) = 0._r8 + mat(k,1740) = 0._r8 + mat(k,1742) = 0._r8 + mat(k,1744) = 0._r8 + mat(k,1745) = 0._r8 + mat(k,1746) = 0._r8 + mat(k,1748) = 0._r8 + mat(k,1749) = 0._r8 + mat(k,1753) = 0._r8 + mat(k,1754) = 0._r8 + mat(k,1757) = 0._r8 + mat(k,1763) = 0._r8 + mat(k,1764) = 0._r8 + mat(k,1765) = 0._r8 + mat(k,1766) = 0._r8 + mat(k,1771) = 0._r8 + mat(k,1772) = 0._r8 + mat(k,1774) = 0._r8 + mat(k,1775) = 0._r8 + mat(k,1776) = 0._r8 + mat(k,1777) = 0._r8 + mat(k,1779) = 0._r8 + mat(k,1781) = 0._r8 + mat(k,1789) = 0._r8 + mat(k,1795) = 0._r8 + mat(k,1797) = 0._r8 + mat(k,1798) = 0._r8 + mat(k,1802) = 0._r8 + mat(k,1803) = 0._r8 + mat(k,1810) = 0._r8 + mat(k,1812) = 0._r8 + mat(k,1813) = 0._r8 + mat(k,1814) = 0._r8 + mat(k,1816) = 0._r8 + mat(k,1822) = 0._r8 + mat(k,1823) = 0._r8 + mat(k,1824) = 0._r8 + mat(k,1826) = 0._r8 + mat(k,1832) = 0._r8 + mat(k,1838) = 0._r8 + mat(k,1842) = 0._r8 + mat(k,1845) = 0._r8 + mat(k,1846) = 0._r8 + mat(k,1847) = 0._r8 + mat(k,1849) = 0._r8 + mat(k,1851) = 0._r8 + mat(k,1853) = 0._r8 + mat(k,1854) = 0._r8 + mat(k,1855) = 0._r8 + mat(k,1856) = 0._r8 + mat(k,1857) = 0._r8 + mat(k,1858) = 0._r8 + mat(k,1862) = 0._r8 + mat(k,1864) = 0._r8 + mat(k,1868) = 0._r8 + mat(k,1871) = 0._r8 + mat(k,1872) = 0._r8 + mat(k,1875) = 0._r8 + mat(k,1881) = 0._r8 + mat(k,1882) = 0._r8 + mat(k,1883) = 0._r8 + mat(k,1885) = 0._r8 + mat(k,1890) = 0._r8 + mat(k,1891) = 0._r8 + mat(k,1892) = 0._r8 + mat(k,1893) = 0._r8 + mat(k,1894) = 0._r8 + mat(k,1907) = 0._r8 + mat(k,1912) = 0._r8 + mat(k,1919) = 0._r8 + mat(k,1922) = 0._r8 + mat(k,1923) = 0._r8 + mat(k,1924) = 0._r8 + mat(k,1926) = 0._r8 + mat(k,1930) = 0._r8 + mat(k,1932) = 0._r8 + mat(k,1933) = 0._r8 + mat(k,1934) = 0._r8 + mat(k,1942) = 0._r8 + mat(k,1943) = 0._r8 + mat(k,1952) = 0._r8 + mat(k,1955) = 0._r8 + mat(k,1965) = 0._r8 + mat(k,1966) = 0._r8 + mat(k,1968) = 0._r8 + mat(k,1972) = 0._r8 + mat(k,1973) = 0._r8 + mat(k,1975) = 0._r8 + mat(k,1976) = 0._r8 + mat(k,1978) = 0._r8 + mat(k,1980) = 0._r8 + mat(k,1984) = 0._r8 + mat(k,1995) = 0._r8 + mat(k,1996) = 0._r8 + mat(k,1997) = 0._r8 + mat(k,1998) = 0._r8 + mat(k,2006) = 0._r8 + mat(k,2007) = 0._r8 + mat(k,2009) = 0._r8 + mat(k,2010) = 0._r8 + mat(k,2011) = 0._r8 + mat(k,2013) = 0._r8 + mat(k,2015) = 0._r8 + mat(k,2019) = 0._r8 + mat(k,2020) = 0._r8 + mat(k,2021) = 0._r8 + mat(k,2022) = 0._r8 + mat(k,2024) = 0._r8 + mat(k,2027) = 0._r8 + mat(k,2028) = 0._r8 + mat(k,2045) = 0._r8 + mat(k,2046) = 0._r8 + mat(k,2047) = 0._r8 + mat(k,2049) = 0._r8 + mat(k,2053) = 0._r8 + mat(k,2058) = 0._r8 + mat(k,2059) = 0._r8 + mat(k,2063) = 0._r8 + mat(k,2067) = 0._r8 + mat(k,2068) = 0._r8 + mat(k,2076) = 0._r8 + mat(k,2078) = 0._r8 + mat(k,2082) = 0._r8 + mat(k,2084) = 0._r8 + mat(k,2087) = 0._r8 + mat(k,2088) = 0._r8 + mat(k,2089) = 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, 10) = mat(k, 10) - 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, 29) = mat(k, 29) - dti(k) + mat(k, 32) = mat(k, 32) - dti(k) + mat(k, 36) = mat(k, 36) - dti(k) + mat(k, 40) = mat(k, 40) - dti(k) + mat(k, 44) = mat(k, 44) - dti(k) + mat(k, 48) = mat(k, 48) - dti(k) + mat(k, 52) = mat(k, 52) - dti(k) + mat(k, 55) = mat(k, 55) - dti(k) + mat(k, 60) = mat(k, 60) - dti(k) + mat(k, 65) = mat(k, 65) - dti(k) + mat(k, 70) = mat(k, 70) - dti(k) + mat(k, 75) = mat(k, 75) - dti(k) + mat(k, 77) = mat(k, 77) - dti(k) + mat(k, 80) = mat(k, 80) - dti(k) + mat(k, 85) = mat(k, 85) - dti(k) + mat(k, 90) = mat(k, 90) - dti(k) + mat(k, 95) = mat(k, 95) - dti(k) + mat(k, 98) = mat(k, 98) - dti(k) + mat(k, 103) = mat(k, 103) - dti(k) + mat(k, 107) = mat(k, 107) - dti(k) + mat(k, 111) = mat(k, 111) - dti(k) + mat(k, 116) = mat(k, 116) - dti(k) + mat(k, 122) = mat(k, 122) - dti(k) + mat(k, 125) = mat(k, 125) - dti(k) + mat(k, 131) = mat(k, 131) - dti(k) + mat(k, 134) = mat(k, 134) - dti(k) + mat(k, 139) = mat(k, 139) - dti(k) + mat(k, 147) = mat(k, 147) - dti(k) + mat(k, 155) = mat(k, 155) - dti(k) + mat(k, 161) = mat(k, 161) - dti(k) + mat(k, 167) = mat(k, 167) - dti(k) + mat(k, 173) = mat(k, 173) - dti(k) + mat(k, 179) = mat(k, 179) - dti(k) + mat(k, 186) = mat(k, 186) - dti(k) + mat(k, 193) = mat(k, 193) - dti(k) + mat(k, 200) = mat(k, 200) - dti(k) + mat(k, 206) = mat(k, 206) - dti(k) + mat(k, 214) = mat(k, 214) - dti(k) + mat(k, 221) = mat(k, 221) - dti(k) + mat(k, 230) = mat(k, 230) - dti(k) + mat(k, 239) = mat(k, 239) - dti(k) + mat(k, 246) = mat(k, 246) - dti(k) + mat(k, 252) = mat(k, 252) - dti(k) + mat(k, 256) = mat(k, 256) - dti(k) + mat(k, 264) = mat(k, 264) - dti(k) + mat(k, 271) = mat(k, 271) - dti(k) + mat(k, 278) = mat(k, 278) - dti(k) + mat(k, 284) = mat(k, 284) - dti(k) + mat(k, 292) = mat(k, 292) - dti(k) + mat(k, 300) = mat(k, 300) - dti(k) + mat(k, 309) = mat(k, 309) - dti(k) + mat(k, 317) = mat(k, 317) - dti(k) + mat(k, 324) = mat(k, 324) - dti(k) + mat(k, 333) = mat(k, 333) - dti(k) + mat(k, 341) = mat(k, 341) - dti(k) + mat(k, 351) = mat(k, 351) - dti(k) + mat(k, 359) = mat(k, 359) - dti(k) + mat(k, 369) = mat(k, 369) - dti(k) + mat(k, 377) = mat(k, 377) - dti(k) + mat(k, 388) = mat(k, 388) - dti(k) + mat(k, 401) = mat(k, 401) - dti(k) + mat(k, 416) = mat(k, 416) - dti(k) + mat(k, 432) = mat(k, 432) - dti(k) + mat(k, 446) = mat(k, 446) - dti(k) + mat(k, 461) = mat(k, 461) - dti(k) + mat(k, 476) = mat(k, 476) - dti(k) + mat(k, 490) = mat(k, 490) - dti(k) + mat(k, 504) = mat(k, 504) - dti(k) + mat(k, 519) = mat(k, 519) - dti(k) + mat(k, 535) = mat(k, 535) - dti(k) + mat(k, 550) = mat(k, 550) - dti(k) + mat(k, 564) = mat(k, 564) - dti(k) + mat(k, 582) = mat(k, 582) - dti(k) + mat(k, 594) = mat(k, 594) - dti(k) + mat(k, 609) = mat(k, 609) - dti(k) + mat(k, 625) = mat(k, 625) - dti(k) + mat(k, 647) = mat(k, 647) - dti(k) + mat(k, 669) = mat(k, 669) - dti(k) + mat(k, 691) = mat(k, 691) - dti(k) + mat(k, 715) = mat(k, 715) - dti(k) + mat(k, 738) = mat(k, 738) - dti(k) + mat(k, 787) = mat(k, 787) - dti(k) + mat(k, 811) = mat(k, 811) - dti(k) + mat(k, 833) = mat(k, 833) - dti(k) + mat(k, 866) = mat(k, 866) - dti(k) + mat(k, 900) = mat(k, 900) - dti(k) + mat(k, 926) = mat(k, 926) - dti(k) + mat(k, 984) = mat(k, 984) - dti(k) + mat(k,1014) = mat(k,1014) - dti(k) + mat(k,1058) = mat(k,1058) - dti(k) + mat(k,1104) = mat(k,1104) - dti(k) + mat(k,1153) = mat(k,1153) - dti(k) + mat(k,1197) = mat(k,1197) - dti(k) + mat(k,1241) = mat(k,1241) - dti(k) + mat(k,1284) = mat(k,1284) - dti(k) + mat(k,1327) = mat(k,1327) - dti(k) + mat(k,1388) = mat(k,1388) - dti(k) + mat(k,1438) = mat(k,1438) - dti(k) + mat(k,1487) = mat(k,1487) - dti(k) + mat(k,1529) = mat(k,1529) - dti(k) + mat(k,1566) = mat(k,1566) - dti(k) + mat(k,1612) = mat(k,1612) - dti(k) + mat(k,1656) = mat(k,1656) - dti(k) + mat(k,1700) = mat(k,1700) - dti(k) + mat(k,1741) = mat(k,1741) - dti(k) + mat(k,1778) = mat(k,1778) - dti(k) + mat(k,1827) = mat(k,1827) - dti(k) + mat(k,1861) = mat(k,1861) - dti(k) + mat(k,1898) = mat(k,1898) - dti(k) + mat(k,1940) = mat(k,1940) - dti(k) + mat(k,1983) = mat(k,1983) - dti(k) + mat(k,2029) = mat(k,2029) - dti(k) + mat(k,2090) = mat(k,2090) - 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 nlnmat08( avec_len, mat, y, rxt ) + call nlnmat09( avec_len, mat, y, rxt ) + call nlnmat10( 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_waccm_mad_mam5/mo_phtadj.F90 b/src/chemistry/pp_waccm_mad_mam5/mo_phtadj.F90 new file mode 100644 index 0000000000..e53b559a64 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/mo_phtadj.F90 @@ -0,0 +1,33 @@ + 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, 67) = p_rate(:,k, 67) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 68) = p_rate(:,k, 68) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 69) = p_rate(:,k, 69) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 70) = p_rate(:,k, 70) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 71) = p_rate(:,k, 71) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 72) = p_rate(:,k, 72) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 73) = p_rate(:,k, 73) * inv(:,k, 2) * im(:,k) + p_rate(:,k, 74) = p_rate(:,k, 74) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_mad_mam5/mo_prod_loss.F90 b/src/chemistry/pp_waccm_mad_mam5/mo_prod_loss.F90 new file mode 100644 index 0000000000..992ad12ca5 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/mo_prod_loss.F90 @@ -0,0 +1,1061 @@ + 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) + 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,99) = (rxt(k,486)* y(k,17) +rxt(k,488)* y(k,73) +rxt(k,487)* y(k,101) & + + het_rates(k,3))* y(k,3) + prod(k,99) = (rxt(k,28) +2.000_r8*rxt(k,489)*y(k,5) +rxt(k,490)*y(k,28) + & + rxt(k,491)*y(k,28) +rxt(k,494)*y(k,62) +rxt(k,497)*y(k,70) + & + rxt(k,498)*y(k,133) +rxt(k,548)*y(k,80))*y(k,5) & + + (rxt(k,476)*y(k,9) +rxt(k,502)*y(k,10) + & + 3.000_r8*rxt(k,503)*y(k,24) +2.000_r8*rxt(k,504)*y(k,42) + & + rxt(k,505)*y(k,45) +2.000_r8*rxt(k,525)*y(k,16) +rxt(k,526)*y(k,18)) & + *y(k,71) + (rxt(k,500)*y(k,45) +2.000_r8*rxt(k,514)*y(k,16) + & + rxt(k,516)*y(k,18) +3.000_r8*rxt(k,521)*y(k,24))*y(k,133) & + + (2.000_r8*rxt(k,513)*y(k,16) +rxt(k,515)*y(k,18) + & + 3.000_r8*rxt(k,520)*y(k,24))*y(k,25) + (rxt(k,52) + & + rxt(k,499)*y(k,70))*y(k,45) +rxt(k,27)*y(k,4) +rxt(k,30)*y(k,6) & + +rxt(k,32)*y(k,9) +rxt(k,33)*y(k,10) +2.000_r8*rxt(k,39)*y(k,16) & + +rxt(k,40)*y(k,18) +3.000_r8*rxt(k,43)*y(k,24) +2.000_r8*rxt(k,51) & + *y(k,42) +rxt(k,58)*y(k,53) + loss(k,43) = ( + rxt(k,27) + het_rates(k,4))* y(k,4) + prod(k,43) = (rxt(k,570)*y(k,53) +rxt(k,575)*y(k,53))*y(k,49) & + +rxt(k,492)*y(k,28)*y(k,5) + loss(k,106) = (2._r8*rxt(k,489)* y(k,5) + (rxt(k,490) +rxt(k,491) + & + rxt(k,492))* y(k,28) +rxt(k,494)* y(k,62) +rxt(k,495)* y(k,63) & + +rxt(k,497)* y(k,70) +rxt(k,548)* y(k,80) +rxt(k,493)* y(k,101) & + +rxt(k,498)* y(k,133) + rxt(k,28) + het_rates(k,5))* y(k,5) + prod(k,106) = (rxt(k,29) +rxt(k,496)*y(k,70))*y(k,6) +rxt(k,488)*y(k,73) & + *y(k,3) +rxt(k,506)*y(k,71)*y(k,45) +rxt(k,501)*y(k,70)*y(k,53) + loss(k,63) = (rxt(k,496)* y(k,70) + rxt(k,29) + rxt(k,30) + rxt(k,564) & + + rxt(k,567) + rxt(k,572) + het_rates(k,6))* y(k,6) + prod(k,63) =rxt(k,495)*y(k,63)*y(k,5) + loss(k,3) = ( + het_rates(k,7))* y(k,7) + prod(k,3) = 0._r8 + loss(k,27) = (rxt(k,475)* y(k,71) + rxt(k,31) + het_rates(k,8))* y(k,8) + prod(k,27) = 0._r8 + loss(k,34) = (rxt(k,476)* y(k,71) + rxt(k,32) + het_rates(k,9))* y(k,9) + prod(k,34) = 0._r8 + loss(k,35) = (rxt(k,502)* y(k,71) + rxt(k,33) + het_rates(k,10))* y(k,10) + prod(k,35) = 0._r8 + loss(k,29) = (rxt(k,477)* y(k,71) + rxt(k,34) + het_rates(k,11))* y(k,11) + prod(k,29) = 0._r8 + loss(k,36) = (rxt(k,478)* y(k,71) + rxt(k,35) + het_rates(k,12))* y(k,12) + prod(k,36) = 0._r8 + loss(k,30) = (rxt(k,479)* y(k,71) + rxt(k,36) + het_rates(k,13))* y(k,13) + prod(k,30) = 0._r8 + loss(k,37) = (rxt(k,480)* y(k,71) + rxt(k,37) + het_rates(k,14))* y(k,14) + prod(k,37) = 0._r8 + loss(k,31) = (rxt(k,481)* y(k,71) + rxt(k,38) + het_rates(k,15))* y(k,15) + prod(k,31) = 0._r8 + loss(k,60) = (rxt(k,513)* y(k,25) +rxt(k,525)* y(k,71) +rxt(k,514)* y(k,133) & + + rxt(k,39) + het_rates(k,16))* y(k,16) + prod(k,60) = 0._r8 + loss(k,107) = (rxt(k,486)* y(k,3) +rxt(k,450)* y(k,25) +rxt(k,530)* y(k,64) & + +rxt(k,531)* y(k,70) +rxt(k,532)* y(k,133) + rxt(k,21) + rxt(k,22) & + + het_rates(k,17))* y(k,17) + prod(k,107) = (.180_r8*rxt(k,25) +rxt(k,538)*y(k,71) +rxt(k,539)*y(k,71)) & + *y(k,23) + (rxt(k,457)*y(k,28) +rxt(k,534)*y(k,62))*y(k,21) & + + (rxt(k,23) +.300_r8*rxt(k,535)*y(k,133))*y(k,22) + loss(k,65) = (rxt(k,515)* y(k,25) +rxt(k,526)* y(k,71) +rxt(k,516)* y(k,133) & + + rxt(k,40) + het_rates(k,18))* y(k,18) + prod(k,65) = 0._r8 + loss(k,32) = (rxt(k,517)* y(k,133) + rxt(k,41) + het_rates(k,19))* y(k,19) + prod(k,32) = 0._r8 + loss(k,54) = (rxt(k,518)* y(k,25) +rxt(k,519)* y(k,133) + rxt(k,42) & + + het_rates(k,20))* y(k,20) + prod(k,54) = 0._r8 + loss(k,89) = (rxt(k,457)* y(k,28) +rxt(k,534)* y(k,62) +rxt(k,533)* y(k,101) & + + het_rates(k,21))* y(k,21) + prod(k,89) = (rxt(k,24) +rxt(k,451)*y(k,25) +rxt(k,507)*y(k,39) + & + rxt(k,536)*y(k,133) +rxt(k,537)*y(k,71))*y(k,23) +rxt(k,40)*y(k,18) & + +rxt(k,42)*y(k,20) +.700_r8*rxt(k,535)*y(k,133)*y(k,22) + loss(k,55) = (rxt(k,535)* y(k,133) + rxt(k,23) + het_rates(k,22))* y(k,22) + prod(k,55) =rxt(k,533)*y(k,101)*y(k,21) + loss(k,88) = (rxt(k,451)* y(k,25) +rxt(k,507)* y(k,39) + (rxt(k,537) + & + rxt(k,538) +rxt(k,539))* y(k,71) +rxt(k,536)* y(k,133) + rxt(k,24) & + + rxt(k,25) + het_rates(k,23))* y(k,23) + prod(k,88) = 0._r8 + loss(k,56) = (rxt(k,520)* y(k,25) +rxt(k,503)* y(k,71) +rxt(k,521)* y(k,133) & + + rxt(k,43) + het_rates(k,24))* y(k,24) + prod(k,56) = 0._r8 + loss(k,125) = (rxt(k,513)* y(k,16) +rxt(k,450)* y(k,17) +rxt(k,515)* y(k,18) & + +rxt(k,518)* y(k,20) +rxt(k,451)* y(k,23) +rxt(k,520)* y(k,24) & + +rxt(k,463)* y(k,29) +rxt(k,452)* y(k,41) +rxt(k,453)* y(k,43) & + +rxt(k,472)* y(k,54) +rxt(k,456)* y(k,73) + (rxt(k,114) +rxt(k,115)) & + * y(k,94) +rxt(k,127)* y(k,97) + (rxt(k,454) +rxt(k,455))* y(k,101) & + +rxt(k,285)* y(k,111) +rxt(k,314)* y(k,127) +rxt(k,341)* y(k,134) & + +rxt(k,350)* y(k,135) + het_rates(k,25))* y(k,25) + prod(k,125) = (4.000_r8*rxt(k,475)*y(k,8) +rxt(k,476)*y(k,9) + & + 2.000_r8*rxt(k,477)*y(k,11) +2.000_r8*rxt(k,478)*y(k,12) + & + 2.000_r8*rxt(k,479)*y(k,13) +rxt(k,480)*y(k,14) + & + 2.000_r8*rxt(k,481)*y(k,15) +rxt(k,482)*y(k,49) +rxt(k,512)*y(k,34) + & + rxt(k,527)*y(k,46) +rxt(k,528)*y(k,47) +rxt(k,529)*y(k,48))*y(k,71) & + + (rxt(k,46) +rxt(k,457)*y(k,21) +2.000_r8*rxt(k,458)*y(k,28) + & + rxt(k,460)*y(k,28) +rxt(k,462)*y(k,62) +rxt(k,467)*y(k,70) + & + rxt(k,468)*y(k,133) +rxt(k,491)*y(k,5) +rxt(k,549)*y(k,80))*y(k,28) & + + (rxt(k,110)*y(k,63) +rxt(k,147)*y(k,105) +rxt(k,154)*y(k,128) + & + rxt(k,177)*y(k,107) +rxt(k,195)*y(k,103) +rxt(k,212)*y(k,122) + & + rxt(k,230)*y(k,119) +rxt(k,248)*y(k,118))*y(k,90) & + + (rxt(k,159)*y(k,128) +rxt(k,164)*y(k,105) +rxt(k,182)*y(k,107) + & + rxt(k,199)*y(k,103) +rxt(k,217)*y(k,122) +rxt(k,234)*y(k,119) + & + rxt(k,252)*y(k,118))*y(k,91) + (rxt(k,169)*y(k,107) + & + rxt(k,181)*y(k,105) +rxt(k,187)*y(k,103) +rxt(k,205)*y(k,122) + & + rxt(k,222)*y(k,119) +rxt(k,240)*y(k,118) +rxt(k,257)*y(k,128)) & + *y(k,92) + (rxt(k,471)*y(k,49) +3.000_r8*rxt(k,517)*y(k,19) + & + rxt(k,519)*y(k,20) +rxt(k,522)*y(k,46) +rxt(k,523)*y(k,47) + & + rxt(k,524)*y(k,48))*y(k,133) + (rxt(k,56) +rxt(k,470)*y(k,70)) & + *y(k,49) +rxt(k,27)*y(k,4) +4.000_r8*rxt(k,31)*y(k,8) +rxt(k,32) & + *y(k,9) +2.000_r8*rxt(k,34)*y(k,11) +2.000_r8*rxt(k,35)*y(k,12) & + +2.000_r8*rxt(k,36)*y(k,13) +rxt(k,37)*y(k,14) +2.000_r8*rxt(k,38) & + *y(k,15) +3.000_r8*rxt(k,41)*y(k,19) +rxt(k,42)*y(k,20) & + +2.000_r8*rxt(k,44)*y(k,26) +2.000_r8*rxt(k,45)*y(k,27) +rxt(k,47) & + *y(k,29) +rxt(k,50)*y(k,34) +rxt(k,53)*y(k,46) +rxt(k,54)*y(k,47) & + +rxt(k,55)*y(k,48) +rxt(k,59)*y(k,54) +rxt(k,111)*y(k,93)*y(k,62) + loss(k,38) = ( + rxt(k,44) + het_rates(k,26))* y(k,26) + prod(k,38) = (rxt(k,563)*y(k,54) +rxt(k,568)*y(k,29) +rxt(k,569)*y(k,54) + & + rxt(k,573)*y(k,29) +rxt(k,574)*y(k,54) +rxt(k,578)*y(k,29))*y(k,49) & + +rxt(k,463)*y(k,29)*y(k,25) +rxt(k,459)*y(k,28)*y(k,28) + loss(k,26) = ( + rxt(k,45) + rxt(k,485) + het_rates(k,27))* y(k,27) + prod(k,26) =rxt(k,484)*y(k,28)*y(k,28) + loss(k,117) = ((rxt(k,490) +rxt(k,491) +rxt(k,492))* y(k,5) +rxt(k,457) & + * y(k,21) + 2._r8*(rxt(k,458) +rxt(k,459) +rxt(k,460) +rxt(k,484)) & + * y(k,28) +rxt(k,462)* y(k,62) +rxt(k,464)* y(k,63) +rxt(k,467) & + * y(k,70) +rxt(k,549)* y(k,80) +rxt(k,116)* y(k,94) +rxt(k,128) & + * y(k,97) +rxt(k,461)* y(k,101) +rxt(k,286)* y(k,111) +rxt(k,315) & + * y(k,127) + (rxt(k,468) +rxt(k,469))* y(k,133) +rxt(k,342)* y(k,134) & + +rxt(k,351)* y(k,135) + rxt(k,46) + het_rates(k,28))* y(k,28) + prod(k,117) = (rxt(k,455)*y(k,101) +rxt(k,456)*y(k,73) +rxt(k,472)*y(k,54)) & + *y(k,25) + (rxt(k,48) +rxt(k,465)*y(k,70))*y(k,29) & + + (rxt(k,473)*y(k,70) +rxt(k,474)*y(k,133))*y(k,54) + (rxt(k,60) + & + rxt(k,554)*y(k,80))*y(k,74) +2.000_r8*rxt(k,485)*y(k,27) & + +rxt(k,483)*y(k,71)*y(k,49) + loss(k,83) = (rxt(k,463)* y(k,25) + (rxt(k,568) +rxt(k,573) +rxt(k,578)) & + * y(k,49) +rxt(k,465)* y(k,70) +rxt(k,466)* y(k,133) + rxt(k,47) & + + rxt(k,48) + rxt(k,566) + rxt(k,571) + rxt(k,577) & + + het_rates(k,29))* y(k,29) + prod(k,83) =rxt(k,464)*y(k,63)*y(k,28) + loss(k,4) = ( + het_rates(k,30))* y(k,30) + prod(k,4) = 0._r8 + loss(k,69) = (rxt(k,540)* y(k,133) + het_rates(k,31))* y(k,31) + prod(k,69) = (rxt(k,21) +rxt(k,22) +rxt(k,450)*y(k,25) +rxt(k,486)*y(k,3) + & + rxt(k,530)*y(k,64) +rxt(k,531)*y(k,70) +rxt(k,532)*y(k,133))*y(k,17) & + + (rxt(k,26) +rxt(k,62) +rxt(k,594)*y(k,136))*y(k,32) & + + (rxt(k,101) +rxt(k,543)*y(k,70) +rxt(k,544)*y(k,133))*y(k,75) & + +rxt(k,518)*y(k,25)*y(k,20) +.380_r8*rxt(k,25)*y(k,23) + loss(k,121) = (rxt(k,368)* y(k,118) +rxt(k,312)* y(k,123) +rxt(k,316) & + * y(k,127) +rxt(k,330)* y(k,130) +rxt(k,335)* y(k,131) +rxt(k,343) & + * y(k,134) +rxt(k,352)* y(k,135) +rxt(k,594)* y(k,136) + rxt(k,26) & + + rxt(k,62) + het_rates(k,32))* y(k,32) + prod(k,121) = (rxt(k,63) +rxt(k,114)*y(k,25) +rxt(k,115)*y(k,25) + & + rxt(k,116)*y(k,28) +rxt(k,117)*y(k,40) +rxt(k,124)*y(k,51) + & + rxt(k,125)*y(k,70) +rxt(k,126)*y(k,72) +rxt(k,168)*y(k,107) + & + rxt(k,170)*y(k,105) +rxt(k,186)*y(k,103) +rxt(k,204)*y(k,122) + & + rxt(k,221)*y(k,119) +rxt(k,239)*y(k,118) +rxt(k,256)*y(k,128) + & + rxt(k,258)*y(k,105) +rxt(k,265)*y(k,107) +rxt(k,280)*y(k,62) + & + rxt(k,281)*y(k,63))*y(k,94) + (rxt(k,120)*y(k,63) + & + rxt(k,121)*y(k,63) +rxt(k,122)*y(k,62) +rxt(k,123)*y(k,62) + & + rxt(k,155)*y(k,128) +rxt(k,158)*y(k,105) +rxt(k,178)*y(k,107) + & + rxt(k,196)*y(k,103) +rxt(k,213)*y(k,122) +rxt(k,231)*y(k,119) + & + rxt(k,249)*y(k,118) +rxt(k,260)*y(k,105) +rxt(k,261)*y(k,107)) & + *y(k,96) + (rxt(k,65) +rxt(k,127)*y(k,25) +rxt(k,128)*y(k,28) + & + rxt(k,130)*y(k,49) +rxt(k,132)*y(k,73) +rxt(k,151)*y(k,128) + & + rxt(k,174)*y(k,107) +rxt(k,191)*y(k,103) +rxt(k,209)*y(k,122) + & + rxt(k,225)*y(k,105) +rxt(k,227)*y(k,119) +rxt(k,244)*y(k,118)) & + *y(k,97) + (rxt(k,153)*y(k,128) +rxt(k,176)*y(k,107) + & + rxt(k,194)*y(k,103) +rxt(k,211)*y(k,122) +rxt(k,229)*y(k,119) + & + rxt(k,246)*y(k,118) +rxt(k,247)*y(k,105) +rxt(k,259)*y(k,107) + & + rxt(k,271)*y(k,105))*y(k,95) + (rxt(k,149)*y(k,128) + & + rxt(k,172)*y(k,107) +rxt(k,189)*y(k,103) +rxt(k,203)*y(k,105) + & + rxt(k,207)*y(k,122) +rxt(k,224)*y(k,119) +rxt(k,242)*y(k,118)) & + *y(k,100) + (rxt(k,369) +rxt(k,306)*y(k,98) +rxt(k,307)*y(k,139)) & + *y(k,121) +.440_r8*rxt(k,25)*y(k,23) +rxt(k,540)*y(k,133)*y(k,31) + loss(k,39) = (rxt(k,511)* y(k,71) + rxt(k,49) + het_rates(k,33))* y(k,33) + prod(k,39) = (rxt(k,476)*y(k,9) +rxt(k,478)*y(k,12) + & + 2.000_r8*rxt(k,479)*y(k,13) +2.000_r8*rxt(k,480)*y(k,14) + & + rxt(k,481)*y(k,15) +rxt(k,502)*y(k,10) +2.000_r8*rxt(k,504)*y(k,42) + & + rxt(k,528)*y(k,47) +rxt(k,529)*y(k,48))*y(k,71) + (rxt(k,54) + & + rxt(k,523)*y(k,133))*y(k,47) + (rxt(k,55) +rxt(k,524)*y(k,133)) & + *y(k,48) +rxt(k,32)*y(k,9) +rxt(k,33)*y(k,10) +rxt(k,35)*y(k,12) & + +2.000_r8*rxt(k,36)*y(k,13) +2.000_r8*rxt(k,37)*y(k,14) +rxt(k,38) & + *y(k,15) +2.000_r8*rxt(k,51)*y(k,42) + loss(k,41) = (rxt(k,512)* y(k,71) + rxt(k,50) + het_rates(k,34))* y(k,34) + prod(k,41) = (rxt(k,53) +rxt(k,522)*y(k,133) +rxt(k,527)*y(k,71))*y(k,46) & + + (rxt(k,34) +rxt(k,477)*y(k,71))*y(k,11) + (rxt(k,35) + & + rxt(k,478)*y(k,71))*y(k,12) + loss(k,50) = (rxt(k,541)* y(k,64) + (rxt(k,542) +rxt(k,556))* y(k,133) & + + het_rates(k,35))* y(k,35) + prod(k,50) = 0._r8 + loss(k,5) = ( + het_rates(k,36))* y(k,36) + prod(k,5) = 0._r8 + loss(k,6) = ( + het_rates(k,37))* y(k,37) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,38))* y(k,38) + prod(k,7) = 0._r8 + loss(k,81) = (rxt(k,507)* y(k,23) +rxt(k,508)* y(k,41) +rxt(k,510)* y(k,51) & + +rxt(k,509)* y(k,139) + het_rates(k,39))* y(k,39) + prod(k,81) = (rxt(k,480)*y(k,14) +rxt(k,502)*y(k,10) + & + 2.000_r8*rxt(k,511)*y(k,33) +rxt(k,512)*y(k,34))*y(k,71) +rxt(k,33) & + *y(k,10) +rxt(k,37)*y(k,14) +2.000_r8*rxt(k,49)*y(k,33) +rxt(k,50) & + *y(k,34) +rxt(k,57)*y(k,50) + loss(k,132) = (rxt(k,411)* y(k,72) +rxt(k,414)* y(k,73) +rxt(k,105)* y(k,90) & + +rxt(k,117)* y(k,94) +rxt(k,129)* y(k,97) + (rxt(k,408) + & + rxt(k,409) +rxt(k,410))* y(k,101) +rxt(k,287)* y(k,111) +rxt(k,309) & + * y(k,122) +rxt(k,317)* y(k,127) +rxt(k,331)* y(k,130) +rxt(k,344) & + * y(k,134) + het_rates(k,40))* y(k,40) + prod(k,132) = (rxt(k,141)*y(k,98) +rxt(k,147)*y(k,90) +rxt(k,158)*y(k,96) + & + rxt(k,162)*y(k,112) +rxt(k,163)*y(k,116) +rxt(k,164)*y(k,91) + & + rxt(k,165)*y(k,114) +rxt(k,166)*y(k,111) +rxt(k,170)*y(k,94) + & + rxt(k,181)*y(k,92) +rxt(k,203)*y(k,100) +rxt(k,214)*y(k,127) + & + rxt(k,225)*y(k,97) +rxt(k,236)*y(k,115) +rxt(k,247)*y(k,95) + & + rxt(k,258)*y(k,94) +rxt(k,260)*y(k,96) +rxt(k,262)*y(k,115) + & + rxt(k,271)*y(k,95))*y(k,105) + (rxt(k,144)*y(k,98) + & + rxt(k,168)*y(k,94) +rxt(k,169)*y(k,92) +rxt(k,172)*y(k,100) + & + rxt(k,173)*y(k,127) +rxt(k,174)*y(k,97) +rxt(k,175)*y(k,115) + & + rxt(k,176)*y(k,95) +rxt(k,177)*y(k,90) +rxt(k,178)*y(k,96) + & + rxt(k,179)*y(k,112) +rxt(k,180)*y(k,116) +rxt(k,182)*y(k,91) + & + rxt(k,183)*y(k,114) +rxt(k,184)*y(k,111) +rxt(k,259)*y(k,95) + & + rxt(k,261)*y(k,96) +rxt(k,263)*y(k,115) +rxt(k,265)*y(k,94))*y(k,107) & + + (rxt(k,186)*y(k,94) +rxt(k,187)*y(k,92) +rxt(k,189)*y(k,100) + & + rxt(k,190)*y(k,127) +rxt(k,191)*y(k,97) +rxt(k,193)*y(k,115) + & + rxt(k,194)*y(k,95) +rxt(k,195)*y(k,90) +rxt(k,196)*y(k,96) + & + rxt(k,197)*y(k,112) +rxt(k,198)*y(k,116) +rxt(k,199)*y(k,91) + & + rxt(k,200)*y(k,114) +rxt(k,201)*y(k,111) +rxt(k,383)*y(k,98)) & + *y(k,103) + (rxt(k,415)*y(k,41) +rxt(k,418)*y(k,70) + & + rxt(k,438)*y(k,56) +rxt(k,532)*y(k,17) +rxt(k,544)*y(k,75) + & + rxt(k,550)*y(k,78) +rxt(k,555)*y(k,80))*y(k,133) & + + (rxt(k,354)*y(k,135) +rxt(k,389)*y(k,71) +rxt(k,406)*y(k,70) + & + rxt(k,452)*y(k,25) +rxt(k,508)*y(k,39))*y(k,41) + (rxt(k,24) + & + .330_r8*rxt(k,25) +rxt(k,538)*y(k,71))*y(k,23) & + + (rxt(k,138)*y(k,99) +rxt(k,381)*y(k,108) +rxt(k,382)*y(k,102)) & + *y(k,98) + (rxt(k,52) +rxt(k,506)*y(k,71))*y(k,45) + (rxt(k,56) + & + rxt(k,483)*y(k,71))*y(k,49) + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,139) & + +2.000_r8*rxt(k,21)*y(k,17) +rxt(k,23)*y(k,22) +rxt(k,57)*y(k,50) + loss(k,103) = (rxt(k,452)* y(k,25) +rxt(k,508)* y(k,39) +rxt(k,406)* y(k,70) & + +rxt(k,389)* y(k,71) +rxt(k,415)* y(k,133) + (rxt(k,353) + & + rxt(k,354))* y(k,135) + het_rates(k,41))* y(k,41) + prod(k,103) = (1.440_r8*rxt(k,25) +rxt(k,539)*y(k,71))*y(k,23) +rxt(k,22) & + *y(k,17) +rxt(k,408)*y(k,101)*y(k,40) +rxt(k,1)*y(k,139) + loss(k,28) = (rxt(k,504)* y(k,71) + rxt(k,51) + het_rates(k,42))* y(k,42) + prod(k,28) = 0._r8 + loss(k,64) = (rxt(k,453)* y(k,25) +rxt(k,407)* y(k,70) +rxt(k,416)* y(k,133) & + + rxt(k,4) + het_rates(k,43))* y(k,43) + prod(k,64) = (.500_r8*rxt(k,558) +rxt(k,422)*y(k,101))*y(k,101) & + +rxt(k,421)*y(k,133)*y(k,133) + loss(k,33) = ( + rxt(k,100) + het_rates(k,44))* y(k,44) + prod(k,33) =rxt(k,557)*y(k,139)*y(k,82) + loss(k,79) = (rxt(k,499)* y(k,70) + (rxt(k,505) +rxt(k,506))* y(k,71) & + +rxt(k,500)* y(k,133) + rxt(k,52) + het_rates(k,45))* y(k,45) + prod(k,79) = (rxt(k,486)*y(k,17) +rxt(k,487)*y(k,101))*y(k,3) + loss(k,40) = (rxt(k,527)* y(k,71) +rxt(k,522)* y(k,133) + rxt(k,53) & + + het_rates(k,46))* y(k,46) + prod(k,40) = 0._r8 + loss(k,42) = (rxt(k,528)* y(k,71) +rxt(k,523)* y(k,133) + rxt(k,54) & + + het_rates(k,47))* y(k,47) + prod(k,42) = 0._r8 + loss(k,48) = (rxt(k,529)* y(k,71) +rxt(k,524)* y(k,133) + rxt(k,55) & + + het_rates(k,48))* y(k,48) + prod(k,48) = 0._r8 + loss(k,138) = ((rxt(k,568) +rxt(k,573) +rxt(k,578))* y(k,29) + (rxt(k,570) + & + rxt(k,575))* y(k,53) + (rxt(k,563) +rxt(k,569) +rxt(k,574))* y(k,54) & + +rxt(k,470)* y(k,70) + (rxt(k,482) +rxt(k,483))* y(k,71) +rxt(k,108) & + * y(k,90) +rxt(k,106)* y(k,91) +rxt(k,130)* y(k,97) +rxt(k,289) & + * y(k,111) + (rxt(k,276) +rxt(k,298))* y(k,113) +rxt(k,318)* y(k,127) & + +rxt(k,471)* y(k,133) +rxt(k,345)* y(k,134) +rxt(k,356)* y(k,135) & + + rxt(k,56) + het_rates(k,49))* y(k,49) + prod(k,138) = (rxt(k,450)*y(k,17) +rxt(k,451)*y(k,23) +rxt(k,452)*y(k,41) + & + rxt(k,453)*y(k,43) +rxt(k,454)*y(k,101) +rxt(k,472)*y(k,54) + & + rxt(k,513)*y(k,16) +rxt(k,515)*y(k,18) +2.000_r8*rxt(k,518)*y(k,20) + & + rxt(k,520)*y(k,24))*y(k,25) + (rxt(k,386) +rxt(k,169)*y(k,107) + & + rxt(k,181)*y(k,105) +rxt(k,187)*y(k,103) +rxt(k,205)*y(k,122) + & + rxt(k,222)*y(k,119) +rxt(k,240)*y(k,118) +rxt(k,257)*y(k,128) + & + 2.000_r8*rxt(k,267)*y(k,105) +2.000_r8*rxt(k,268)*y(k,107))*y(k,92) & + + (rxt(k,157)*y(k,128) +rxt(k,163)*y(k,105) +rxt(k,180)*y(k,107) + & + rxt(k,198)*y(k,103) +rxt(k,216)*y(k,122) +rxt(k,233)*y(k,119) + & + rxt(k,251)*y(k,118) +rxt(k,299)*y(k,51))*y(k,116) & + + (rxt(k,105)*y(k,40) +rxt(k,109)*y(k,51))*y(k,90) & + +rxt(k,469)*y(k,133)*y(k,28) + loss(k,49) = ( + rxt(k,57) + het_rates(k,50))* y(k,50) + prod(k,49) = (rxt(k,507)*y(k,23) +rxt(k,508)*y(k,41) +rxt(k,509)*y(k,139) + & + rxt(k,510)*y(k,51))*y(k,39) + loss(k,126) = (rxt(k,510)* y(k,39) +rxt(k,109)* y(k,90) +rxt(k,124)* y(k,94) & + +rxt(k,290)* y(k,111) +rxt(k,300)* y(k,113) +rxt(k,295)* y(k,115) & + +rxt(k,299)* y(k,116) +rxt(k,319)* y(k,127) +rxt(k,447)* y(k,133) & + +rxt(k,357)* y(k,135) + rxt(k,9) + het_rates(k,51))* y(k,51) + prod(k,126) = (rxt(k,275) +2.000_r8*rxt(k,146)*y(k,105) + & + 2.000_r8*rxt(k,167)*y(k,107) +2.000_r8*rxt(k,185)*y(k,103) + & + rxt(k,202)*y(k,122) +rxt(k,220)*y(k,119) +rxt(k,238)*y(k,118) + & + rxt(k,255)*y(k,128) +2.000_r8*rxt(k,269)*y(k,105) + & + 2.000_r8*rxt(k,270)*y(k,107))*y(k,117) + (2.000_r8*rxt(k,559) + & + 2.000_r8*rxt(k,562) +2.000_r8*rxt(k,565) +2.000_r8*rxt(k,576) + & + rxt(k,142)*y(k,105) +rxt(k,145)*y(k,107) +rxt(k,293)*y(k,114) + & + rxt(k,297)*y(k,115))*y(k,58) + (rxt(k,566) +rxt(k,571) +rxt(k,577) + & + rxt(k,568)*y(k,49) +rxt(k,573)*y(k,49) +rxt(k,578)*y(k,49))*y(k,29) & + + (rxt(k,171)*y(k,107) +rxt(k,188)*y(k,103) +rxt(k,192)*y(k,105) + & + rxt(k,264)*y(k,105) +rxt(k,266)*y(k,107) +rxt(k,298)*y(k,49)) & + *y(k,113) + (rxt(k,564) +rxt(k,567) +rxt(k,572))*y(k,6) & + + (rxt(k,561) +rxt(k,530)*y(k,17) +rxt(k,541)*y(k,35))*y(k,64) & + + (.500_r8*rxt(k,560) +rxt(k,446)*y(k,133))*y(k,63) & + + (rxt(k,140)*y(k,104) +rxt(k,143)*y(k,106))*y(k,139) + loss(k,59) = (rxt(k,423)* y(k,133) + rxt(k,10) + rxt(k,11) + rxt(k,448) & + + het_rates(k,52))* y(k,52) + prod(k,59) =rxt(k,444)*y(k,101)*y(k,63) + loss(k,77) = ((rxt(k,570) +rxt(k,575))* y(k,49) +rxt(k,501)* y(k,70) & + + rxt(k,58) + het_rates(k,53))* y(k,53) + prod(k,77) = (rxt(k,564) +rxt(k,567) +rxt(k,572))*y(k,6) +rxt(k,493)*y(k,101) & + *y(k,5) + loss(k,80) = (rxt(k,472)* y(k,25) + (rxt(k,563) +rxt(k,569) +rxt(k,574)) & + * y(k,49) +rxt(k,473)* y(k,70) +rxt(k,474)* y(k,133) + rxt(k,59) & + + het_rates(k,54))* y(k,54) + prod(k,80) = (rxt(k,566) +rxt(k,571) +rxt(k,577) +rxt(k,466)*y(k,133)) & + *y(k,29) +rxt(k,461)*y(k,101)*y(k,28) + loss(k,73) = (rxt(k,340)* y(k,133) + rxt(k,12) + het_rates(k,55))* y(k,55) + prod(k,73) = (rxt(k,289)*y(k,49) +rxt(k,290)*y(k,51))*y(k,111) & + +rxt(k,349)*y(k,133)*y(k,62) +rxt(k,305)*y(k,139)*y(k,120) + loss(k,90) = (rxt(k,426)* y(k,62) + (rxt(k,427) +rxt(k,428) +rxt(k,429)) & + * y(k,63) +rxt(k,430)* y(k,72) +rxt(k,591)* y(k,128) +rxt(k,438) & + * y(k,133) + rxt(k,66) + het_rates(k,56))* y(k,56) + prod(k,90) = (rxt(k,424)*y(k,109) +rxt(k,588)*y(k,124))*y(k,70) & + + (.200_r8*rxt(k,582)*y(k,118) +1.100_r8*rxt(k,584)*y(k,110)) & + *y(k,98) +rxt(k,17)*y(k,62) +rxt(k,589)*y(k,124)*y(k,72) +rxt(k,595) & + *y(k,136) + loss(k,44) = ((rxt(k,442) +rxt(k,443))* y(k,71) + rxt(k,13) & + + het_rates(k,57))* y(k,57) + prod(k,44) =rxt(k,427)*y(k,63)*y(k,56) + loss(k,87) = (rxt(k,142)* y(k,105) +rxt(k,145)* y(k,107) +rxt(k,293) & + * y(k,114) +rxt(k,297)* y(k,115) + rxt(k,14) + rxt(k,15) + rxt(k,449) & + + rxt(k,559) + rxt(k,562) + rxt(k,565) + rxt(k,576) & + + het_rates(k,58))* y(k,58) + prod(k,87) =rxt(k,445)*y(k,64)*y(k,63) + loss(k,8) = ( + het_rates(k,59))* y(k,59) + prod(k,8) = 0._r8 + loss(k,9) = ( + het_rates(k,60))* y(k,60) + prod(k,9) = 0._r8 + loss(k,10) = ( + het_rates(k,61))* y(k,61) + prod(k,10) = 0._r8 + loss(k,137) = (rxt(k,494)* y(k,5) +rxt(k,534)* y(k,21) +rxt(k,462)* y(k,28) & + +rxt(k,426)* y(k,56) +rxt(k,435)* y(k,64) +rxt(k,441)* y(k,70) & + +rxt(k,440)* y(k,73) + (rxt(k,111) +rxt(k,112))* y(k,93) +rxt(k,280) & + * y(k,94) + (rxt(k,122) +rxt(k,123))* y(k,96) +rxt(k,439)* y(k,101) & + +rxt(k,593)* y(k,128) + (rxt(k,272) +rxt(k,279))* y(k,130) & + +rxt(k,349)* y(k,133) +rxt(k,136)* y(k,135) + rxt(k,16) + rxt(k,17) & + + het_rates(k,62))* y(k,62) + prod(k,137) = (rxt(k,202)*y(k,117) +rxt(k,204)*y(k,94) +rxt(k,205)*y(k,92) + & + rxt(k,206)*y(k,113) +rxt(k,207)*y(k,100) +rxt(k,208)*y(k,127) + & + rxt(k,209)*y(k,97) +rxt(k,210)*y(k,115) +rxt(k,211)*y(k,95) + & + rxt(k,212)*y(k,90) +rxt(k,213)*y(k,96) +rxt(k,215)*y(k,112) + & + rxt(k,216)*y(k,116) +rxt(k,217)*y(k,91) +rxt(k,218)*y(k,114) + & + rxt(k,219)*y(k,111) +rxt(k,308)*y(k,98) +rxt(k,309)*y(k,40))*y(k,122) & + + (rxt(k,220)*y(k,117) +rxt(k,221)*y(k,94) +rxt(k,222)*y(k,92) + & + rxt(k,223)*y(k,113) +rxt(k,224)*y(k,100) +rxt(k,226)*y(k,127) + & + rxt(k,227)*y(k,97) +rxt(k,228)*y(k,115) +rxt(k,229)*y(k,95) + & + rxt(k,230)*y(k,90) +rxt(k,231)*y(k,96) +rxt(k,232)*y(k,112) + & + rxt(k,233)*y(k,116) +rxt(k,234)*y(k,91) +rxt(k,235)*y(k,114) + & + rxt(k,237)*y(k,111) +rxt(k,303)*y(k,98))*y(k,119) & + + (rxt(k,238)*y(k,117) +rxt(k,239)*y(k,94) +rxt(k,240)*y(k,92) + & + rxt(k,241)*y(k,113) +rxt(k,242)*y(k,100) +rxt(k,243)*y(k,127) + & + rxt(k,244)*y(k,97) +rxt(k,245)*y(k,115) +rxt(k,246)*y(k,95) + & + rxt(k,248)*y(k,90) +rxt(k,249)*y(k,96) +rxt(k,250)*y(k,112) + & + rxt(k,251)*y(k,116) +rxt(k,252)*y(k,91) +rxt(k,253)*y(k,114) + & + rxt(k,254)*y(k,111))*y(k,118) + (rxt(k,18) +.500_r8*rxt(k,560) + & + rxt(k,291)*y(k,111) +2.000_r8*rxt(k,428)*y(k,56) + & + rxt(k,431)*y(k,70) +rxt(k,551)*y(k,80))*y(k,63) & + + (rxt(k,304)*y(k,120) +rxt(k,306)*y(k,121) +rxt(k,384)*y(k,123)) & + *y(k,98) + (rxt(k,430)*y(k,72) +rxt(k,438)*y(k,133))*y(k,56) & + +rxt(k,287)*y(k,111)*y(k,40) +rxt(k,12)*y(k,55) & + +2.000_r8*rxt(k,442)*y(k,71)*y(k,57) +rxt(k,15)*y(k,58) +rxt(k,20) & + *y(k,64) +rxt(k,425)*y(k,109)*y(k,72) +rxt(k,592)*y(k,128) & + +rxt(k,605)*y(k,138) + loss(k,133) = (rxt(k,495)* y(k,5) +rxt(k,464)* y(k,28) + (rxt(k,427) + & + rxt(k,428) +rxt(k,429))* y(k,56) +rxt(k,445)* y(k,64) + (rxt(k,431) + & + rxt(k,433))* y(k,70) +rxt(k,432)* y(k,73) +rxt(k,551)* y(k,80) & + +rxt(k,110)* y(k,90) +rxt(k,281)* y(k,94) + (rxt(k,120) +rxt(k,121)) & + * y(k,96) +rxt(k,444)* y(k,101) +rxt(k,291)* y(k,111) +rxt(k,320) & + * y(k,127) + (rxt(k,277) +rxt(k,278))* y(k,130) +rxt(k,446)* y(k,133) & + +rxt(k,346)* y(k,134) +rxt(k,359)* y(k,135) + rxt(k,18) + rxt(k,560) & + + het_rates(k,63))* y(k,63) + prod(k,133) = (rxt(k,112)*y(k,93) +rxt(k,136)*y(k,135) + & + 2.000_r8*rxt(k,435)*y(k,64) +rxt(k,439)*y(k,101) + & + rxt(k,440)*y(k,73) +rxt(k,441)*y(k,70) +rxt(k,462)*y(k,28) + & + rxt(k,494)*y(k,5) +rxt(k,534)*y(k,21))*y(k,62) + (rxt(k,75) + & + rxt(k,161)*y(k,128) +rxt(k,166)*y(k,105) +rxt(k,184)*y(k,107) + & + rxt(k,201)*y(k,103) +rxt(k,219)*y(k,122) +rxt(k,237)*y(k,119) + & + rxt(k,254)*y(k,118) +rxt(k,285)*y(k,25))*y(k,111) & + + (rxt(k,156)*y(k,128) +rxt(k,162)*y(k,105) +rxt(k,179)*y(k,107) + & + rxt(k,197)*y(k,103) +rxt(k,215)*y(k,122) +rxt(k,232)*y(k,119) + & + rxt(k,250)*y(k,118))*y(k,112) + (rxt(k,19) +rxt(k,434)*y(k,101) + & + rxt(k,436)*y(k,70) +rxt(k,437)*y(k,133))*y(k,64) + (rxt(k,11) + & + rxt(k,448) +rxt(k,423)*y(k,133))*y(k,52) + (rxt(k,14) +rxt(k,449)) & + *y(k,58) + (rxt(k,311)*y(k,122) +rxt(k,340)*y(k,55))*y(k,133) & + +rxt(k,29)*y(k,6) +rxt(k,48)*y(k,29) +rxt(k,9)*y(k,51) + loss(k,131) = (rxt(k,530)* y(k,17) +rxt(k,541)* y(k,35) +rxt(k,435)* y(k,62) & + +rxt(k,445)* y(k,63) +rxt(k,436)* y(k,70) +rxt(k,434)* y(k,101) & + +rxt(k,437)* y(k,133) + rxt(k,19) + rxt(k,20) + rxt(k,561) & + + het_rates(k,64))* y(k,64) + prod(k,131) = (rxt(k,152)*y(k,128) +rxt(k,175)*y(k,107) + & + rxt(k,193)*y(k,103) +rxt(k,210)*y(k,122) +rxt(k,228)*y(k,119) + & + rxt(k,236)*y(k,105) +rxt(k,245)*y(k,118) +rxt(k,262)*y(k,105) + & + rxt(k,263)*y(k,107))*y(k,115) + (rxt(k,160)*y(k,128) + & + rxt(k,165)*y(k,105) +rxt(k,183)*y(k,107) +rxt(k,200)*y(k,103) + & + rxt(k,218)*y(k,122) +rxt(k,235)*y(k,119) +rxt(k,253)*y(k,118)) & + *y(k,114) + (rxt(k,157)*y(k,128) +rxt(k,163)*y(k,105) + & + rxt(k,180)*y(k,107) +rxt(k,198)*y(k,103) +rxt(k,216)*y(k,122) + & + rxt(k,233)*y(k,119) +rxt(k,251)*y(k,118))*y(k,116) + (rxt(k,76) + & + rxt(k,148)*y(k,128) +rxt(k,206)*y(k,122) +rxt(k,223)*y(k,119) + & + rxt(k,241)*y(k,118))*y(k,113) + (rxt(k,47) +rxt(k,463)*y(k,25) + & + rxt(k,465)*y(k,70) +rxt(k,466)*y(k,133))*y(k,29) & + + (rxt(k,202)*y(k,122) +rxt(k,220)*y(k,119) +rxt(k,238)*y(k,118) + & + rxt(k,255)*y(k,128))*y(k,117) + (rxt(k,14) +rxt(k,15) +rxt(k,449)) & + *y(k,58) + (rxt(k,30) +rxt(k,496)*y(k,70))*y(k,6) & + + (rxt(k,447)*y(k,133) +rxt(k,510)*y(k,39))*y(k,51) & + + (rxt(k,432)*y(k,73) +rxt(k,433)*y(k,70))*y(k,63) & + +rxt(k,286)*y(k,111)*y(k,28) +rxt(k,10)*y(k,52) +rxt(k,310)*y(k,122) & + *y(k,101) + loss(k,11) = ( + het_rates(k,65))* y(k,65) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,66))* y(k,66) + prod(k,12) = 0._r8 + loss(k,13) = ( + het_rates(k,67))* y(k,67) + prod(k,13) = 0._r8 + loss(k,14) = ( + het_rates(k,68))* y(k,68) + prod(k,14) = 0._r8 + loss(k,15) = ( + het_rates(k,69))* y(k,69) + prod(k,15) = 0._r8 + loss(k,123) = (rxt(k,497)* y(k,5) +rxt(k,496)* y(k,6) +rxt(k,531)* y(k,17) & + +rxt(k,467)* y(k,28) +rxt(k,465)* y(k,29) +rxt(k,406)* y(k,41) & + +rxt(k,407)* y(k,43) +rxt(k,499)* y(k,45) +rxt(k,470)* y(k,49) & + +rxt(k,501)* y(k,53) +rxt(k,473)* y(k,54) +rxt(k,441)* y(k,62) & + + (rxt(k,431) +rxt(k,433))* y(k,63) +rxt(k,436)* y(k,64) & + + 2._r8*rxt(k,404)* y(k,70) +rxt(k,405)* y(k,72) +rxt(k,403) & + * y(k,73) +rxt(k,543)* y(k,75) +rxt(k,113)* y(k,93) +rxt(k,125) & + * y(k,94) +rxt(k,131)* y(k,97) +rxt(k,412)* y(k,101) + (rxt(k,586) + & + rxt(k,587))* y(k,110) +rxt(k,301)* y(k,113) +rxt(k,588)* y(k,124) & + + (rxt(k,324) +rxt(k,325))* y(k,127) + (rxt(k,333) +rxt(k,334)) & + * y(k,130) +rxt(k,336)* y(k,131) +rxt(k,338)* y(k,132) +rxt(k,418) & + * y(k,133) +rxt(k,347)* y(k,134) +rxt(k,360)* y(k,135) + rxt(k,77) & + + rxt(k,78) + rxt(k,79) + rxt(k,80) + rxt(k,81) + rxt(k,82) & + + het_rates(k,70))* y(k,70) + prod(k,123) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,83) +rxt(k,85) +rxt(k,87) + & + 2.000_r8*rxt(k,88) +2.000_r8*rxt(k,89) +rxt(k,90) +rxt(k,91) + & + rxt(k,92) +rxt(k,392)*y(k,71) +rxt(k,393)*y(k,71) + & + rxt(k,430)*y(k,56) +rxt(k,545)*y(k,78) +rxt(k,552)*y(k,80) + & + rxt(k,590)*y(k,124) +rxt(k,597)*y(k,136) +rxt(k,601)*y(k,137)) & + *y(k,72) + (rxt(k,114)*y(k,25) +rxt(k,168)*y(k,107) + & + rxt(k,170)*y(k,105) +rxt(k,186)*y(k,103) +rxt(k,204)*y(k,122) + & + rxt(k,221)*y(k,119) +rxt(k,239)*y(k,118) +rxt(k,256)*y(k,128) + & + rxt(k,258)*y(k,105) +rxt(k,265)*y(k,107))*y(k,94) & + + (rxt(k,153)*y(k,128) +rxt(k,176)*y(k,107) +rxt(k,194)*y(k,103) + & + rxt(k,211)*y(k,122) +rxt(k,229)*y(k,119) +rxt(k,246)*y(k,118) + & + rxt(k,247)*y(k,105) +rxt(k,259)*y(k,107) +rxt(k,271)*y(k,105)) & + *y(k,95) + (rxt(k,155)*y(k,128) +rxt(k,158)*y(k,105) + & + rxt(k,178)*y(k,107) +rxt(k,196)*y(k,103) +rxt(k,213)*y(k,122) + & + rxt(k,231)*y(k,119) +rxt(k,249)*y(k,118) +rxt(k,260)*y(k,105) + & + rxt(k,261)*y(k,107))*y(k,96) + (rxt(k,99) +rxt(k,358) + & + rxt(k,350)*y(k,25) +rxt(k,359)*y(k,63) +rxt(k,363)*y(k,73))*y(k,135) & + + (rxt(k,426)*y(k,62) +rxt(k,427)*y(k,63) +rxt(k,591)*y(k,128)) & + *y(k,56) + (rxt(k,26) +rxt(k,62))*y(k,32) + (rxt(k,17) + & + rxt(k,272)*y(k,130))*y(k,62) + (rxt(k,582)*y(k,118) + & + 1.150_r8*rxt(k,583)*y(k,128))*y(k,98) +rxt(k,28)*y(k,5) & + +.180_r8*rxt(k,25)*y(k,23) +rxt(k,46)*y(k,28) +rxt(k,410)*y(k,101) & + *y(k,40) +rxt(k,15)*y(k,58) +rxt(k,18)*y(k,63) +rxt(k,19)*y(k,64) & + +rxt(k,391)*y(k,71) +rxt(k,8)*y(k,73) +rxt(k,60)*y(k,74) +rxt(k,102) & + *y(k,80) +rxt(k,103)*y(k,81) +rxt(k,104)*y(k,82) +rxt(k,596)*y(k,136) & + *y(k,109) +rxt(k,420)*y(k,133)*y(k,133) +rxt(k,599)*y(k,137) & + +rxt(k,604)*y(k,138) +rxt(k,2)*y(k,139) + loss(k,108) = (rxt(k,475)* y(k,8) +rxt(k,476)* y(k,9) +rxt(k,502)* y(k,10) & + +rxt(k,477)* y(k,11) +rxt(k,478)* y(k,12) +rxt(k,479)* y(k,13) & + +rxt(k,480)* y(k,14) +rxt(k,481)* y(k,15) +rxt(k,525)* y(k,16) & + +rxt(k,526)* y(k,18) + (rxt(k,537) +rxt(k,538) +rxt(k,539))* y(k,23) & + +rxt(k,503)* y(k,24) +rxt(k,511)* y(k,33) +rxt(k,512)* y(k,34) & + +rxt(k,389)* y(k,41) +rxt(k,504)* y(k,42) + (rxt(k,505) +rxt(k,506)) & + * y(k,45) +rxt(k,527)* y(k,46) +rxt(k,528)* y(k,47) +rxt(k,529) & + * y(k,48) + (rxt(k,482) +rxt(k,483))* y(k,49) + (rxt(k,442) + & + rxt(k,443))* y(k,57) + (rxt(k,392) +rxt(k,393))* y(k,72) +rxt(k,394) & + * y(k,73) +rxt(k,390)* y(k,139) + rxt(k,391) + het_rates(k,71)) & + * y(k,71) + prod(k,108) = (rxt(k,6) +rxt(k,425)*y(k,109))*y(k,72) +rxt(k,13)*y(k,57) & + +rxt(k,7)*y(k,73) +.850_r8*rxt(k,583)*y(k,128)*y(k,98) +rxt(k,1) & + *y(k,139) + loss(k,124) = (rxt(k,411)* y(k,40) +rxt(k,430)* y(k,56) +rxt(k,405)* y(k,70) & + +rxt(k,392)* y(k,71) +rxt(k,545)* y(k,78) +rxt(k,552)* y(k,80) & + +rxt(k,126)* y(k,94) + (rxt(k,133) +rxt(k,135))* y(k,98) +rxt(k,425) & + * y(k,109) +rxt(k,585)* y(k,110) + (rxt(k,589) +rxt(k,590))* y(k,124) & + +rxt(k,397)* y(k,125) +rxt(k,322)* y(k,127) +rxt(k,364)* y(k,128) & + +rxt(k,362)* y(k,135) +rxt(k,597)* y(k,136) +rxt(k,601)* y(k,137) & + + rxt(k,5) + rxt(k,6) + rxt(k,83) + rxt(k,84) + rxt(k,85) & + + rxt(k,86) + rxt(k,87) + rxt(k,88) + rxt(k,89) + rxt(k,90) & + + rxt(k,91) + rxt(k,92) + het_rates(k,72))* y(k,72) + prod(k,124) = (rxt(k,8) +rxt(k,132)*y(k,97) +rxt(k,134)*y(k,98) + & + rxt(k,292)*y(k,111) +2.000_r8*rxt(k,302)*y(k,113) + & + rxt(k,323)*y(k,127) +3.000_r8*rxt(k,332)*y(k,130) + & + 2.000_r8*rxt(k,394)*y(k,71) +2.000_r8*rxt(k,403)*y(k,70) + & + 2.000_r8*rxt(k,413)*y(k,101) +rxt(k,414)*y(k,40) + & + rxt(k,419)*y(k,133) +rxt(k,432)*y(k,63) +rxt(k,440)*y(k,62) + & + rxt(k,456)*y(k,25) +rxt(k,488)*y(k,3) +rxt(k,547)*y(k,78) + & + rxt(k,553)*y(k,80))*y(k,73) + (rxt(k,113)*y(k,93) + & + rxt(k,131)*y(k,97) +rxt(k,301)*y(k,113) +rxt(k,325)*y(k,127) + & + 2.000_r8*rxt(k,333)*y(k,130) +rxt(k,334)*y(k,130) + & + rxt(k,336)*y(k,131) +rxt(k,360)*y(k,135) +rxt(k,396)*y(k,125) + & + rxt(k,404)*y(k,70) +rxt(k,412)*y(k,101) +rxt(k,418)*y(k,133) + & + rxt(k,431)*y(k,63) +rxt(k,436)*y(k,64) +rxt(k,467)*y(k,28) + & + rxt(k,497)*y(k,5))*y(k,70) + (rxt(k,148)*y(k,113) + & + rxt(k,149)*y(k,100) +2.000_r8*rxt(k,151)*y(k,97) + & + rxt(k,152)*y(k,115) +rxt(k,153)*y(k,95) +rxt(k,154)*y(k,90) + & + rxt(k,155)*y(k,96) +rxt(k,156)*y(k,112) +rxt(k,157)*y(k,116) + & + rxt(k,159)*y(k,91) +rxt(k,160)*y(k,114) +rxt(k,161)*y(k,111) + & + rxt(k,255)*y(k,117) +rxt(k,256)*y(k,94) +rxt(k,257)*y(k,92) + & + rxt(k,593)*y(k,62))*y(k,128) + (rxt(k,93) +rxt(k,137) + & + rxt(k,173)*y(k,107) +rxt(k,190)*y(k,103) +rxt(k,208)*y(k,122) + & + rxt(k,214)*y(k,105) +rxt(k,226)*y(k,119) +rxt(k,243)*y(k,118) + & + rxt(k,314)*y(k,25) +rxt(k,315)*y(k,28) +rxt(k,320)*y(k,63) + & + 2.000_r8*rxt(k,321)*y(k,125))*y(k,127) + (rxt(k,116)*y(k,94) + & + rxt(k,128)*y(k,97) +rxt(k,351)*y(k,135) +rxt(k,458)*y(k,28) + & + rxt(k,459)*y(k,28) +rxt(k,461)*y(k,101) +rxt(k,469)*y(k,133) + & + rxt(k,491)*y(k,5) +rxt(k,492)*y(k,5))*y(k,28) + (rxt(k,408)*y(k,40) + & + rxt(k,417)*y(k,133) +rxt(k,422)*y(k,101) +rxt(k,434)*y(k,64) + & + rxt(k,454)*y(k,25) +rxt(k,487)*y(k,3) +rxt(k,493)*y(k,5) + & + rxt(k,533)*y(k,21))*y(k,101) + (rxt(k,127)*y(k,25) + & + rxt(k,174)*y(k,107) +rxt(k,191)*y(k,103) +rxt(k,209)*y(k,122) + & + rxt(k,225)*y(k,105) +rxt(k,227)*y(k,119) +rxt(k,244)*y(k,118)) & + *y(k,97) + (rxt(k,95) +rxt(k,277)*y(k,63) +rxt(k,279)*y(k,62) + & + rxt(k,330)*y(k,32) +rxt(k,331)*y(k,40))*y(k,130) + (rxt(k,387) + & + rxt(k,395) +2.000_r8*rxt(k,339)*y(k,132) + & + 2.000_r8*rxt(k,397)*y(k,72))*y(k,125) + (rxt(k,326)*y(k,98) + & + rxt(k,327)*y(k,139) +rxt(k,328)*y(k,139))*y(k,129) + (rxt(k,97) + & + rxt(k,335)*y(k,32))*y(k,131) + (rxt(k,337)*y(k,139) + & + 2.000_r8*rxt(k,380)*y(k,98))*y(k,132) +rxt(k,489)*y(k,5)*y(k,5) & + +rxt(k,423)*y(k,133)*y(k,52) +rxt(k,429)*y(k,63)*y(k,56) & + +rxt(k,443)*y(k,71)*y(k,57) +rxt(k,20)*y(k,64) +rxt(k,388)*y(k,126) + loss(k,136) = (rxt(k,488)* y(k,3) +rxt(k,456)* y(k,25) +rxt(k,414)* y(k,40) & + +rxt(k,440)* y(k,62) +rxt(k,432)* y(k,63) +rxt(k,403)* y(k,70) & + +rxt(k,394)* y(k,71) +rxt(k,547)* y(k,78) +rxt(k,553)* y(k,80) & + +rxt(k,132)* y(k,97) +rxt(k,134)* y(k,98) +rxt(k,413)* y(k,101) & + +rxt(k,292)* y(k,111) +rxt(k,302)* y(k,113) +rxt(k,323)* y(k,127) & + +rxt(k,332)* y(k,130) +rxt(k,419)* y(k,133) +rxt(k,348)* y(k,134) & + +rxt(k,363)* y(k,135) + rxt(k,7) + rxt(k,8) + het_rates(k,73)) & + * y(k,73) + prod(k,136) = (rxt(k,324)*y(k,127) +rxt(k,338)*y(k,132) +rxt(k,405)*y(k,72)) & + *y(k,70) + (rxt(k,96) +rxt(k,278)*y(k,63))*y(k,130) & + +rxt(k,361)*y(k,135)*y(k,125) + loss(k,52) = (rxt(k,554)* y(k,80) + rxt(k,60) + het_rates(k,74))* y(k,74) + prod(k,52) = (rxt(k,460)*y(k,28) +rxt(k,490)*y(k,5))*y(k,28) + loss(k,53) = (rxt(k,543)* y(k,70) +rxt(k,544)* y(k,133) + rxt(k,101) & + + het_rates(k,75))* y(k,75) + prod(k,53) = 0._r8 + loss(k,16) = ( + het_rates(k,76))* y(k,76) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,77))* y(k,77) + prod(k,17) = 0._r8 + loss(k,72) = (rxt(k,545)* y(k,72) +rxt(k,547)* y(k,73) +rxt(k,550)* y(k,133) & + + het_rates(k,78))* y(k,78) + prod(k,72) =rxt(k,101)*y(k,75) +rxt(k,102)*y(k,80) + loss(k,18) = ( + rxt(k,61) + het_rates(k,79))* y(k,79) + prod(k,18) = 0._r8 + loss(k,92) = (rxt(k,548)* y(k,5) +rxt(k,549)* y(k,28) +rxt(k,551)* y(k,63) & + +rxt(k,552)* y(k,72) +rxt(k,553)* y(k,73) +rxt(k,554)* y(k,74) & + +rxt(k,555)* y(k,133) + rxt(k,102) + het_rates(k,80))* y(k,80) + prod(k,92) = (rxt(k,545)*y(k,72) +rxt(k,547)*y(k,73) +rxt(k,550)*y(k,133)) & + *y(k,78) +rxt(k,543)*y(k,75)*y(k,70) +rxt(k,103)*y(k,81) + loss(k,82) = (rxt(k,546)* y(k,133) + rxt(k,103) + het_rates(k,81))* y(k,81) + prod(k,82) = (rxt(k,548)*y(k,5) +rxt(k,549)*y(k,28) +rxt(k,551)*y(k,63) + & + rxt(k,552)*y(k,72) +rxt(k,553)*y(k,73) +rxt(k,554)*y(k,74) + & + rxt(k,555)*y(k,133))*y(k,80) + (rxt(k,541)*y(k,64) + & + rxt(k,542)*y(k,133) +.500_r8*rxt(k,556)*y(k,133))*y(k,35) & + +rxt(k,544)*y(k,133)*y(k,75) +rxt(k,104)*y(k,82) + loss(k,45) = (rxt(k,557)* y(k,139) + rxt(k,104) + het_rates(k,82))* y(k,82) + prod(k,45) =rxt(k,100)*y(k,44) +rxt(k,546)*y(k,133)*y(k,81) + loss(k,19) = ( + het_rates(k,83))* y(k,83) + prod(k,19) = 0._r8 + loss(k,20) = ( + het_rates(k,84))* y(k,84) + prod(k,20) = 0._r8 + loss(k,21) = ( + het_rates(k,85))* y(k,85) + prod(k,21) = 0._r8 + loss(k,22) = ( + het_rates(k,86))* y(k,86) + prod(k,22) = 0._r8 + loss(k,23) = ( + het_rates(k,87))* y(k,87) + prod(k,23) = 0._r8 + loss(k,24) = ( + het_rates(k,88))* y(k,88) + prod(k,24) = 0._r8 + loss(k,25) = ( + het_rates(k,89))* y(k,89) + prod(k,25) = 0._r8 + loss(k,109) = (rxt(k,105)* y(k,40) +rxt(k,108)* y(k,49) +rxt(k,109)* y(k,51) & + +rxt(k,110)* y(k,63) +rxt(k,195)* y(k,103) +rxt(k,147)* y(k,105) & + +rxt(k,177)* y(k,107) +rxt(k,248)* y(k,118) +rxt(k,230)* y(k,119) & + +rxt(k,212)* y(k,122) +rxt(k,154)* y(k,128) +rxt(k,107)* y(k,139) & + + het_rates(k,90))* y(k,90) + prod(k,109) = (rxt(k,114)*y(k,94) +rxt(k,127)*y(k,97) +rxt(k,285)*y(k,111) + & + rxt(k,314)*y(k,127) +rxt(k,341)*y(k,134) +rxt(k,350)*y(k,135)) & + *y(k,25) + (rxt(k,130)*y(k,97) +rxt(k,289)*y(k,111) + & + rxt(k,298)*y(k,113) +rxt(k,318)*y(k,127) +rxt(k,345)*y(k,134) + & + rxt(k,356)*y(k,135))*y(k,49) + (rxt(k,116)*y(k,94) + & + rxt(k,286)*y(k,111) +rxt(k,351)*y(k,135))*y(k,28) & + + (rxt(k,112)*y(k,62) +rxt(k,113)*y(k,70))*y(k,93) +rxt(k,385) & + *y(k,91) +rxt(k,386)*y(k,92) + loss(k,96) = (rxt(k,106)* y(k,49) +rxt(k,199)* y(k,103) +rxt(k,164)* y(k,105) & + +rxt(k,182)* y(k,107) +rxt(k,252)* y(k,118) +rxt(k,234)* y(k,119) & + +rxt(k,217)* y(k,122) +rxt(k,159)* y(k,128) + rxt(k,385) & + + het_rates(k,91))* y(k,91) + prod(k,96) =rxt(k,107)*y(k,139)*y(k,90) + loss(k,95) = (rxt(k,187)* y(k,103) + (rxt(k,181) +rxt(k,267))* y(k,105) & + + (rxt(k,169) +rxt(k,268))* y(k,107) +rxt(k,240)* y(k,118) & + +rxt(k,222)* y(k,119) +rxt(k,205)* y(k,122) +rxt(k,257)* y(k,128) & + + rxt(k,386) + het_rates(k,92))* y(k,92) + prod(k,95) = (rxt(k,106)*y(k,91) +rxt(k,108)*y(k,90))*y(k,49) + loss(k,84) = ((rxt(k,111) +rxt(k,112))* y(k,62) +rxt(k,113)* y(k,70) & + + het_rates(k,93))* y(k,93) + prod(k,84) = (rxt(k,128)*y(k,97) +rxt(k,315)*y(k,127) +rxt(k,342)*y(k,134)) & + *y(k,28) +rxt(k,115)*y(k,94)*y(k,25) + loss(k,115) = ((rxt(k,114) +rxt(k,115))* y(k,25) +rxt(k,116)* y(k,28) & + +rxt(k,117)* y(k,40) +rxt(k,124)* y(k,51) +rxt(k,280)* y(k,62) & + +rxt(k,281)* y(k,63) +rxt(k,125)* y(k,70) +rxt(k,126)* y(k,72) & + +rxt(k,186)* y(k,103) + (rxt(k,170) +rxt(k,258))* y(k,105) & + + (rxt(k,168) +rxt(k,265))* y(k,107) +rxt(k,239)* y(k,118) & + +rxt(k,221)* y(k,119) +rxt(k,204)* y(k,122) +rxt(k,256)* y(k,128) & + +rxt(k,119)* y(k,139) + rxt(k,63) + het_rates(k,94))* y(k,94) + prod(k,115) = (rxt(k,330)*y(k,130) +rxt(k,352)*y(k,135))*y(k,32) & + + (rxt(k,64) +rxt(k,283))*y(k,96) + (rxt(k,129)*y(k,40) + & + rxt(k,131)*y(k,70))*y(k,97) + loss(k,94) = (rxt(k,194)* y(k,103) + (rxt(k,247) +rxt(k,271))* y(k,105) & + + (rxt(k,176) +rxt(k,259))* y(k,107) +rxt(k,246)* y(k,118) & + +rxt(k,229)* y(k,119) +rxt(k,211)* y(k,122) +rxt(k,153)* y(k,128) & + + rxt(k,284) + het_rates(k,95))* y(k,95) + prod(k,94) =rxt(k,118)*y(k,139)*y(k,96) + loss(k,104) = ((rxt(k,122) +rxt(k,123))* y(k,62) + (rxt(k,120) +rxt(k,121)) & + * y(k,63) +rxt(k,196)* y(k,103) + (rxt(k,158) +rxt(k,260))* y(k,105) & + + (rxt(k,178) +rxt(k,261))* y(k,107) +rxt(k,249)* y(k,118) & + +rxt(k,231)* y(k,119) +rxt(k,213)* y(k,122) +rxt(k,155)* y(k,128) & + +rxt(k,118)* y(k,139) + rxt(k,64) + rxt(k,283) + het_rates(k,96)) & + * y(k,96) + prod(k,104) =rxt(k,119)*y(k,139)*y(k,94) +rxt(k,284)*y(k,95) + loss(k,110) = (rxt(k,127)* y(k,25) +rxt(k,128)* y(k,28) +rxt(k,129)* y(k,40) & + +rxt(k,130)* y(k,49) +rxt(k,131)* y(k,70) +rxt(k,132)* y(k,73) & + +rxt(k,191)* y(k,103) +rxt(k,225)* y(k,105) +rxt(k,174)* y(k,107) & + +rxt(k,244)* y(k,118) +rxt(k,227)* y(k,119) +rxt(k,209)* y(k,122) & + +rxt(k,151)* y(k,128) + rxt(k,65) + het_rates(k,97))* y(k,97) + prod(k,110) = (rxt(k,316)*y(k,127) +rxt(k,335)*y(k,131))*y(k,32) + loss(k,116) = ((rxt(k,133) +rxt(k,135))* y(k,72) +rxt(k,134)* y(k,73) & + +rxt(k,138)* y(k,99) +rxt(k,382)* y(k,102) +rxt(k,383)* y(k,103) & + +rxt(k,141)* y(k,105) +rxt(k,144)* y(k,107) +rxt(k,381)* y(k,108) & + +rxt(k,584)* y(k,110) +rxt(k,582)* y(k,118) +rxt(k,303)* y(k,119) & + +rxt(k,304)* y(k,120) +rxt(k,306)* y(k,121) +rxt(k,308)* y(k,122) & + +rxt(k,384)* y(k,123) +rxt(k,583)* y(k,128) +rxt(k,326)* y(k,129) & + +rxt(k,380)* y(k,132) + het_rates(k,98))* y(k,98) + prod(k,116) = (rxt(k,77) +rxt(k,78) +rxt(k,79) +rxt(k,80) +rxt(k,81) + & + rxt(k,82) +rxt(k,324)*y(k,127) +rxt(k,333)*y(k,130) + & + rxt(k,347)*y(k,134) +rxt(k,360)*y(k,135))*y(k,70) + (rxt(k,83) + & + rxt(k,84) +rxt(k,85) +rxt(k,86) +rxt(k,87) +rxt(k,90) +rxt(k,91) + & + rxt(k,92))*y(k,72) + (rxt(k,99) +rxt(k,358) +rxt(k,136)*y(k,62) + & + rxt(k,353)*y(k,41) +rxt(k,361)*y(k,125))*y(k,135) + (rxt(k,93) + & + rxt(k,137) +rxt(k,317)*y(k,40) +rxt(k,321)*y(k,125))*y(k,127) & + + (rxt(k,105)*y(k,90) +rxt(k,344)*y(k,134))*y(k,40) + (rxt(k,96) + & + rxt(k,332)*y(k,73))*y(k,130) +rxt(k,66)*y(k,56) +rxt(k,16)*y(k,62) & + +rxt(k,75)*y(k,111) +rxt(k,76)*y(k,113) +rxt(k,98)*y(k,134) + loss(k,57) = (rxt(k,138)* y(k,98) +rxt(k,139)* y(k,139) + het_rates(k,99)) & + * y(k,99) + prod(k,57) =rxt(k,327)*y(k,139)*y(k,129) + loss(k,93) = (rxt(k,189)* y(k,103) +rxt(k,203)* y(k,105) +rxt(k,172) & + * y(k,107) +rxt(k,242)* y(k,118) +rxt(k,224)* y(k,119) +rxt(k,207) & + * y(k,122) +rxt(k,149)* y(k,128) + het_rates(k,100))* y(k,100) + prod(k,93) =rxt(k,343)*y(k,134)*y(k,32) + loss(k,112) = (rxt(k,487)* y(k,3) +rxt(k,493)* y(k,5) +rxt(k,533)* y(k,21) & + + (rxt(k,454) +rxt(k,455))* y(k,25) +rxt(k,461)* y(k,28) & + + (rxt(k,408) +rxt(k,409) +rxt(k,410))* y(k,40) +rxt(k,439)* y(k,62) & + +rxt(k,444)* y(k,63) +rxt(k,434)* y(k,64) +rxt(k,412)* y(k,70) & + +rxt(k,413)* y(k,73) + 2._r8*rxt(k,422)* y(k,101) +rxt(k,310) & + * y(k,122) +rxt(k,417)* y(k,133) + rxt(k,558) + het_rates(k,101)) & + * y(k,101) + prod(k,112) = (rxt(k,416)*y(k,43) +rxt(k,419)*y(k,73) +rxt(k,437)*y(k,64) + & + rxt(k,468)*y(k,28) +rxt(k,498)*y(k,5) +rxt(k,516)*y(k,18) + & + rxt(k,519)*y(k,20) +rxt(k,540)*y(k,31) +rxt(k,546)*y(k,81) + & + .500_r8*rxt(k,556)*y(k,35))*y(k,133) + (rxt(k,450)*y(k,25) + & + rxt(k,486)*y(k,3) +rxt(k,530)*y(k,64) +rxt(k,531)*y(k,70))*y(k,17) & + + (rxt(k,453)*y(k,43) +rxt(k,515)*y(k,18) +rxt(k,518)*y(k,20)) & + *y(k,25) + (rxt(k,317)*y(k,40) +rxt(k,318)*y(k,49) + & + rxt(k,319)*y(k,51))*y(k,127) + (rxt(k,457)*y(k,28) + & + rxt(k,534)*y(k,62))*y(k,21) + (rxt(k,11) +rxt(k,448))*y(k,52) & + + (rxt(k,347)*y(k,134) +rxt(k,407)*y(k,43))*y(k,70) & + +rxt(k,538)*y(k,71)*y(k,23) +rxt(k,411)*y(k,72)*y(k,40) & + +rxt(k,130)*y(k,97)*y(k,49) + loss(k,68) = (rxt(k,382)* y(k,98) +rxt(k,374)* y(k,139) + rxt(k,373) & + + het_rates(k,102))* y(k,102) + prod(k,68) = (rxt(k,139)*y(k,99) +rxt(k,372)*y(k,108))*y(k,139) +rxt(k,375) & + *y(k,103) + loss(k,120) = (rxt(k,195)* y(k,90) +rxt(k,199)* y(k,91) +rxt(k,187)* y(k,92) & + +rxt(k,186)* y(k,94) +rxt(k,194)* y(k,95) +rxt(k,196)* y(k,96) & + +rxt(k,191)* y(k,97) +rxt(k,383)* y(k,98) +rxt(k,189)* y(k,100) & + +rxt(k,201)* y(k,111) +rxt(k,197)* y(k,112) +rxt(k,188)* y(k,113) & + +rxt(k,200)* y(k,114) +rxt(k,193)* y(k,115) +rxt(k,198)* y(k,116) & + +rxt(k,185)* y(k,117) +rxt(k,190)* y(k,127) +rxt(k,376)* y(k,139) & + + rxt(k,375) + het_rates(k,103))* y(k,103) + prod(k,120) = (rxt(k,305)*y(k,120) +rxt(k,374)*y(k,102))*y(k,139) +rxt(k,377) & + *y(k,105) + loss(k,46) = (rxt(k,140)* y(k,139) + het_rates(k,104))* y(k,104) + prod(k,46) =rxt(k,142)*y(k,105)*y(k,58) + loss(k,130) = (rxt(k,142)* y(k,58) +rxt(k,147)* y(k,90) +rxt(k,164)* y(k,91) & + + (rxt(k,181) +rxt(k,267))* y(k,92) + (rxt(k,170) +rxt(k,258)) & + * y(k,94) + (rxt(k,247) +rxt(k,271))* y(k,95) + (rxt(k,158) + & + rxt(k,260))* y(k,96) +rxt(k,225)* y(k,97) +rxt(k,141)* y(k,98) & + +rxt(k,203)* y(k,100) +rxt(k,166)* y(k,111) +rxt(k,162)* y(k,112) & + + (rxt(k,192) +rxt(k,264))* y(k,113) +rxt(k,165)* y(k,114) & + + (rxt(k,236) +rxt(k,262))* y(k,115) +rxt(k,163)* y(k,116) & + + (rxt(k,146) +rxt(k,269))* y(k,117) +rxt(k,214)* y(k,127) & + +rxt(k,378)* y(k,139) + rxt(k,377) + het_rates(k,105))* y(k,105) + prod(k,130) = (rxt(k,140)*y(k,104) +rxt(k,376)*y(k,103))*y(k,139) +rxt(k,379) & + *y(k,107) + loss(k,47) = (rxt(k,143)* y(k,139) + het_rates(k,106))* y(k,106) + prod(k,47) =rxt(k,145)*y(k,107)*y(k,58) + loss(k,129) = (rxt(k,145)* y(k,58) +rxt(k,177)* y(k,90) +rxt(k,182)* y(k,91) & + + (rxt(k,169) +rxt(k,268))* y(k,92) + (rxt(k,168) +rxt(k,265)) & + * y(k,94) + (rxt(k,176) +rxt(k,259))* y(k,95) + (rxt(k,178) + & + rxt(k,261))* y(k,96) +rxt(k,174)* y(k,97) +rxt(k,144)* y(k,98) & + +rxt(k,172)* y(k,100) +rxt(k,184)* y(k,111) +rxt(k,179)* y(k,112) & + + (rxt(k,171) +rxt(k,266))* y(k,113) +rxt(k,183)* y(k,114) & + + (rxt(k,175) +rxt(k,263))* y(k,115) +rxt(k,180)* y(k,116) & + + (rxt(k,167) +rxt(k,270))* y(k,117) +rxt(k,173)* y(k,127) & + + rxt(k,379) + het_rates(k,107))* y(k,107) + prod(k,129) = (rxt(k,143)*y(k,106) +rxt(k,378)*y(k,105))*y(k,139) + loss(k,74) = (rxt(k,381)* y(k,98) +rxt(k,372)* y(k,139) + het_rates(k,108)) & + * y(k,108) + prod(k,74) = (rxt(k,309)*y(k,40) +rxt(k,310)*y(k,101) +rxt(k,311)*y(k,133)) & + *y(k,122) +rxt(k,373)*y(k,102) +rxt(k,328)*y(k,139)*y(k,129) + loss(k,76) = (rxt(k,424)* y(k,70) +rxt(k,425)* y(k,72) +rxt(k,596)* y(k,136) & + + het_rates(k,109))* y(k,109) + prod(k,76) = (.800_r8*rxt(k,582)*y(k,118) +.900_r8*rxt(k,584)*y(k,110)) & + *y(k,98) +rxt(k,586)*y(k,110)*y(k,70) + loss(k,66) = ((rxt(k,586) +rxt(k,587))* y(k,70) +rxt(k,585)* y(k,72) & + +rxt(k,584)* y(k,98) + het_rates(k,110))* y(k,110) + prod(k,66) =rxt(k,599)*y(k,137) +rxt(k,604)*y(k,138) + loss(k,113) = (rxt(k,285)* y(k,25) +rxt(k,286)* y(k,28) +rxt(k,287)* y(k,40) & + +rxt(k,289)* y(k,49) +rxt(k,290)* y(k,51) +rxt(k,291)* y(k,63) & + +rxt(k,292)* y(k,73) +rxt(k,201)* y(k,103) +rxt(k,166)* y(k,105) & + +rxt(k,184)* y(k,107) +rxt(k,254)* y(k,118) +rxt(k,237)* y(k,119) & + +rxt(k,219)* y(k,122) +rxt(k,161)* y(k,128) +rxt(k,288)* y(k,139) & + + rxt(k,75) + het_rates(k,111))* y(k,111) + prod(k,113) = (rxt(k,110)*y(k,90) +rxt(k,278)*y(k,130) +rxt(k,320)*y(k,127) + & + rxt(k,346)*y(k,134) +rxt(k,359)*y(k,135))*y(k,63) & + + (rxt(k,111)*y(k,93) +rxt(k,123)*y(k,96) +rxt(k,279)*y(k,130) + & + rxt(k,280)*y(k,94))*y(k,62) + (rxt(k,301)*y(k,70) + & + rxt(k,302)*y(k,73))*y(k,113) +rxt(k,273)*y(k,112) + loss(k,97) = (rxt(k,197)* y(k,103) +rxt(k,162)* y(k,105) +rxt(k,179) & + * y(k,107) +rxt(k,250)* y(k,118) +rxt(k,232)* y(k,119) +rxt(k,215) & + * y(k,122) +rxt(k,156)* y(k,128) + rxt(k,273) + het_rates(k,112)) & + * y(k,112) + prod(k,97) =rxt(k,122)*y(k,96)*y(k,62) +rxt(k,288)*y(k,139)*y(k,111) + loss(k,111) = ((rxt(k,276) +rxt(k,298))* y(k,49) +rxt(k,300)* y(k,51) & + +rxt(k,301)* y(k,70) +rxt(k,302)* y(k,73) +rxt(k,188)* y(k,103) & + + (rxt(k,192) +rxt(k,264))* y(k,105) + (rxt(k,171) +rxt(k,266)) & + * y(k,107) +rxt(k,241)* y(k,118) +rxt(k,223)* y(k,119) +rxt(k,206) & + * y(k,122) +rxt(k,148)* y(k,128) +rxt(k,296)* y(k,139) + rxt(k,76) & + + het_rates(k,113))* y(k,113) + prod(k,111) = (rxt(k,109)*y(k,90) +rxt(k,124)*y(k,94) +rxt(k,290)*y(k,111) + & + rxt(k,319)*y(k,127) +rxt(k,357)*y(k,135))*y(k,51) & + + (rxt(k,120)*y(k,96) +rxt(k,277)*y(k,130) +rxt(k,281)*y(k,94) + & + rxt(k,291)*y(k,111))*y(k,63) +rxt(k,272)*y(k,130)*y(k,62) & + +rxt(k,292)*y(k,111)*y(k,73) +rxt(k,282)*y(k,115) +rxt(k,275) & + *y(k,117) + loss(k,102) = (rxt(k,293)* y(k,58) +rxt(k,200)* y(k,103) +rxt(k,165) & + * y(k,105) +rxt(k,183)* y(k,107) +rxt(k,253)* y(k,118) +rxt(k,235) & + * y(k,119) +rxt(k,218)* y(k,122) +rxt(k,160)* y(k,128) + rxt(k,274) & + + het_rates(k,114))* y(k,114) + prod(k,102) =rxt(k,294)*y(k,139)*y(k,115) + loss(k,105) = (rxt(k,295)* y(k,51) +rxt(k,297)* y(k,58) +rxt(k,193)* y(k,103) & + + (rxt(k,236) +rxt(k,262))* y(k,105) + (rxt(k,175) +rxt(k,263)) & + * y(k,107) +rxt(k,245)* y(k,118) +rxt(k,228)* y(k,119) +rxt(k,210) & + * y(k,122) +rxt(k,152)* y(k,128) +rxt(k,294)* y(k,139) + rxt(k,282) & + + het_rates(k,115))* y(k,115) + prod(k,105) =rxt(k,121)*y(k,96)*y(k,63) +rxt(k,296)*y(k,139)*y(k,113) & + +rxt(k,274)*y(k,114) + loss(k,98) = (rxt(k,299)* y(k,51) +rxt(k,198)* y(k,103) +rxt(k,163)* y(k,105) & + +rxt(k,180)* y(k,107) +rxt(k,251)* y(k,118) +rxt(k,233)* y(k,119) & + +rxt(k,216)* y(k,122) +rxt(k,157)* y(k,128) + het_rates(k,116)) & + * y(k,116) + prod(k,98) =rxt(k,276)*y(k,113)*y(k,49) + loss(k,101) = (rxt(k,185)* y(k,103) + (rxt(k,146) +rxt(k,269))* y(k,105) & + + (rxt(k,167) +rxt(k,270))* y(k,107) +rxt(k,238)* y(k,118) & + +rxt(k,220)* y(k,119) +rxt(k,202)* y(k,122) +rxt(k,255)* y(k,128) & + + rxt(k,275) + het_rates(k,117))* y(k,117) + prod(k,101) = (rxt(k,295)*y(k,115) +rxt(k,299)*y(k,116) +rxt(k,300)*y(k,113)) & + *y(k,51) + (rxt(k,293)*y(k,114) +rxt(k,297)*y(k,115))*y(k,58) + loss(k,118) = (rxt(k,368)* y(k,32) +rxt(k,248)* y(k,90) +rxt(k,252)* y(k,91) & + +rxt(k,240)* y(k,92) +rxt(k,239)* y(k,94) +rxt(k,246)* y(k,95) & + +rxt(k,249)* y(k,96) +rxt(k,244)* y(k,97) +rxt(k,582)* y(k,98) & + +rxt(k,242)* y(k,100) +rxt(k,254)* y(k,111) +rxt(k,250)* y(k,112) & + +rxt(k,241)* y(k,113) +rxt(k,253)* y(k,114) +rxt(k,245)* y(k,115) & + +rxt(k,251)* y(k,116) +rxt(k,238)* y(k,117) +rxt(k,243)* y(k,127) & + +rxt(k,365)* y(k,139) + rxt(k,370) + het_rates(k,118))* y(k,118) + prod(k,118) = (rxt(k,592) +rxt(k,591)*y(k,56) +rxt(k,593)*y(k,62))*y(k,128) & + +rxt(k,16)*y(k,62) +rxt(k,586)*y(k,110)*y(k,70) +rxt(k,590)*y(k,124) & + *y(k,72) +rxt(k,369)*y(k,121) +rxt(k,371)*y(k,123) +rxt(k,595) & + *y(k,136) + loss(k,119) = (rxt(k,230)* y(k,90) +rxt(k,234)* y(k,91) +rxt(k,222)* y(k,92) & + +rxt(k,221)* y(k,94) +rxt(k,229)* y(k,95) +rxt(k,231)* y(k,96) & + +rxt(k,227)* y(k,97) +rxt(k,303)* y(k,98) +rxt(k,224)* y(k,100) & + +rxt(k,237)* y(k,111) +rxt(k,232)* y(k,112) +rxt(k,223)* y(k,113) & + +rxt(k,235)* y(k,114) +rxt(k,228)* y(k,115) +rxt(k,233)* y(k,116) & + +rxt(k,220)* y(k,117) +rxt(k,226)* y(k,127) +rxt(k,367)* y(k,139) & + + het_rates(k,119))* y(k,119) + prod(k,119) =rxt(k,366)*y(k,139)*y(k,122) + loss(k,58) = (rxt(k,304)* y(k,98) +rxt(k,305)* y(k,139) + het_rates(k,120)) & + * y(k,120) + prod(k,58) =rxt(k,367)*y(k,139)*y(k,119) + loss(k,71) = (rxt(k,306)* y(k,98) +rxt(k,307)* y(k,139) + rxt(k,369) & + + het_rates(k,121))* y(k,121) + prod(k,71) = (rxt(k,312)*y(k,123) +rxt(k,368)*y(k,118))*y(k,32) + loss(k,122) = (rxt(k,309)* y(k,40) +rxt(k,212)* y(k,90) +rxt(k,217)* y(k,91) & + +rxt(k,205)* y(k,92) +rxt(k,204)* y(k,94) +rxt(k,211)* y(k,95) & + +rxt(k,213)* y(k,96) +rxt(k,209)* y(k,97) +rxt(k,308)* y(k,98) & + +rxt(k,207)* y(k,100) +rxt(k,310)* y(k,101) +rxt(k,219)* y(k,111) & + +rxt(k,215)* y(k,112) +rxt(k,206)* y(k,113) +rxt(k,218)* y(k,114) & + +rxt(k,210)* y(k,115) +rxt(k,216)* y(k,116) +rxt(k,202)* y(k,117) & + +rxt(k,208)* y(k,127) +rxt(k,311)* y(k,133) +rxt(k,366)* y(k,139) & + + het_rates(k,122))* y(k,122) + prod(k,122) = (rxt(k,307)*y(k,121) +rxt(k,313)*y(k,123) +rxt(k,365)*y(k,118)) & + *y(k,139) + loss(k,70) = (rxt(k,312)* y(k,32) +rxt(k,384)* y(k,98) +rxt(k,313)* y(k,139) & + + rxt(k,371) + het_rates(k,123))* y(k,123) + prod(k,70) =rxt(k,370)*y(k,118) + loss(k,78) = (rxt(k,588)* y(k,70) + (rxt(k,589) +rxt(k,590))* y(k,72) & + + het_rates(k,124))* y(k,124) + prod(k,78) =rxt(k,66)*y(k,56) +rxt(k,596)*y(k,136)*y(k,109) +rxt(k,605) & + *y(k,138) + loss(k,85) = (rxt(k,396)* y(k,70) +rxt(k,397)* y(k,72) +rxt(k,321)* y(k,127) & + +rxt(k,339)* y(k,132) +rxt(k,361)* y(k,135) + rxt(k,387) & + + rxt(k,395) + het_rates(k,125))* y(k,125) + prod(k,85) = (rxt(k,399) +rxt(k,398)*y(k,32) +rxt(k,400)*y(k,70) + & + rxt(k,401)*y(k,72) +rxt(k,402)*y(k,73))*y(k,126) +rxt(k,7)*y(k,73) + loss(k,51) = (rxt(k,398)* y(k,32) +rxt(k,400)* y(k,70) +rxt(k,401)* y(k,72) & + +rxt(k,402)* y(k,73) + rxt(k,388) + rxt(k,399) + het_rates(k,126)) & + * y(k,126) + prod(k,51) =rxt(k,392)*y(k,72)*y(k,71) + loss(k,127) = (rxt(k,314)* y(k,25) +rxt(k,315)* y(k,28) +rxt(k,316)* y(k,32) & + +rxt(k,317)* y(k,40) +rxt(k,318)* y(k,49) +rxt(k,319)* y(k,51) & + +rxt(k,320)* y(k,63) + (rxt(k,324) +rxt(k,325))* y(k,70) +rxt(k,322) & + * y(k,72) +rxt(k,323)* y(k,73) +rxt(k,190)* y(k,103) +rxt(k,214) & + * y(k,105) +rxt(k,173)* y(k,107) +rxt(k,243)* y(k,118) +rxt(k,226) & + * y(k,119) +rxt(k,208)* y(k,122) +rxt(k,321)* y(k,125) +rxt(k,150) & + * y(k,128) + rxt(k,93) + rxt(k,137) + het_rates(k,127))* y(k,127) + prod(k,127) = (rxt(k,125)*y(k,94) +rxt(k,334)*y(k,130))*y(k,70) & + + (rxt(k,133)*y(k,98) +rxt(k,135)*y(k,98))*y(k,72) +rxt(k,65) & + *y(k,97) +rxt(k,97)*y(k,131) + loss(k,128) = (rxt(k,591)* y(k,56) +rxt(k,593)* y(k,62) +rxt(k,364)* y(k,72) & + +rxt(k,154)* y(k,90) +rxt(k,159)* y(k,91) +rxt(k,257)* y(k,92) & + +rxt(k,256)* y(k,94) +rxt(k,153)* y(k,95) +rxt(k,155)* y(k,96) & + +rxt(k,151)* y(k,97) +rxt(k,583)* y(k,98) +rxt(k,149)* y(k,100) & + +rxt(k,161)* y(k,111) +rxt(k,156)* y(k,112) +rxt(k,148)* y(k,113) & + +rxt(k,160)* y(k,114) +rxt(k,152)* y(k,115) +rxt(k,157)* y(k,116) & + +rxt(k,255)* y(k,117) +rxt(k,150)* y(k,127) +rxt(k,329)* y(k,139) & + + rxt(k,592) + het_rates(k,128))* y(k,128) + prod(k,128) = (rxt(k,84) +rxt(k,86) +rxt(k,585)*y(k,110) + & + rxt(k,589)*y(k,124) +rxt(k,597)*y(k,136) +rxt(k,601)*y(k,137)) & + *y(k,72) + (rxt(k,338)*y(k,70) +rxt(k,339)*y(k,125))*y(k,132) & + +rxt(k,594)*y(k,136)*y(k,32) +2.000_r8*rxt(k,150)*y(k,128)*y(k,127) & + +rxt(k,94)*y(k,129) + loss(k,75) = (rxt(k,326)* y(k,98) + (rxt(k,327) +rxt(k,328))* y(k,139) & + + rxt(k,94) + het_rates(k,129))* y(k,129) + prod(k,75) = (rxt(k,329)*y(k,128) +rxt(k,337)*y(k,132))*y(k,139) + loss(k,100) = (rxt(k,330)* y(k,32) +rxt(k,331)* y(k,40) + (rxt(k,272) + & + rxt(k,279))* y(k,62) + (rxt(k,277) +rxt(k,278))* y(k,63) & + + (rxt(k,333) +rxt(k,334))* y(k,70) +rxt(k,332)* y(k,73) + rxt(k,95) & + + rxt(k,96) + het_rates(k,130))* y(k,130) + prod(k,100) = (rxt(k,132)*y(k,97) +rxt(k,323)*y(k,127) +rxt(k,348)*y(k,134) + & + rxt(k,363)*y(k,135))*y(k,73) + (rxt(k,126)*y(k,94) + & + rxt(k,362)*y(k,135))*y(k,72) +rxt(k,336)*y(k,131)*y(k,70) + loss(k,67) = (rxt(k,335)* y(k,32) +rxt(k,336)* y(k,70) + rxt(k,97) & + + het_rates(k,131))* y(k,131) + prod(k,67) =rxt(k,322)*y(k,127)*y(k,72) + loss(k,91) = (rxt(k,338)* y(k,70) +rxt(k,380)* y(k,98) +rxt(k,339)* y(k,125) & + +rxt(k,337)* y(k,139) + het_rates(k,132))* y(k,132) + prod(k,91) =rxt(k,364)*y(k,128)*y(k,72) + loss(k,114) = (rxt(k,498)* y(k,5) +rxt(k,514)* y(k,16) +rxt(k,532)* y(k,17) & + +rxt(k,516)* y(k,18) +rxt(k,517)* y(k,19) +rxt(k,519)* y(k,20) & + +rxt(k,535)* y(k,22) +rxt(k,536)* y(k,23) +rxt(k,521)* y(k,24) & + + (rxt(k,468) +rxt(k,469))* y(k,28) +rxt(k,466)* y(k,29) +rxt(k,540) & + * y(k,31) + (rxt(k,542) +rxt(k,556))* y(k,35) +rxt(k,415)* y(k,41) & + +rxt(k,416)* y(k,43) +rxt(k,500)* y(k,45) +rxt(k,522)* y(k,46) & + +rxt(k,523)* y(k,47) +rxt(k,524)* y(k,48) +rxt(k,471)* y(k,49) & + +rxt(k,447)* y(k,51) +rxt(k,423)* y(k,52) +rxt(k,474)* y(k,54) & + +rxt(k,340)* y(k,55) +rxt(k,438)* y(k,56) +rxt(k,349)* y(k,62) & + +rxt(k,446)* y(k,63) +rxt(k,437)* y(k,64) +rxt(k,418)* y(k,70) & + +rxt(k,419)* y(k,73) +rxt(k,544)* y(k,75) +rxt(k,550)* y(k,78) & + +rxt(k,555)* y(k,80) +rxt(k,546)* y(k,81) +rxt(k,417)* y(k,101) & + +rxt(k,311)* y(k,122) + 2._r8*(rxt(k,420) +rxt(k,421))* y(k,133) & + + het_rates(k,133))* y(k,133) + prod(k,114) = (rxt(k,406)*y(k,41) +rxt(k,407)*y(k,43) +rxt(k,412)*y(k,101) + & + rxt(k,470)*y(k,49) +rxt(k,473)*y(k,54) +rxt(k,499)*y(k,45) + & + rxt(k,501)*y(k,53) +rxt(k,531)*y(k,17))*y(k,70) & + + (rxt(k,149)*y(k,128) +rxt(k,172)*y(k,107) +rxt(k,189)*y(k,103) + & + rxt(k,203)*y(k,105) +rxt(k,207)*y(k,122) +rxt(k,224)*y(k,119) + & + rxt(k,242)*y(k,118))*y(k,100) + (rxt(k,3) +rxt(k,139)*y(k,99) + & + rxt(k,328)*y(k,129) +rxt(k,355)*y(k,135) + & + 2.000_r8*rxt(k,390)*y(k,71) +rxt(k,509)*y(k,39))*y(k,139) & + + (2.000_r8*rxt(k,409)*y(k,40) +rxt(k,413)*y(k,73) + & + rxt(k,434)*y(k,64) +rxt(k,439)*y(k,62) +rxt(k,455)*y(k,25))*y(k,101) & + + (rxt(k,98) +rxt(k,341)*y(k,25) +rxt(k,342)*y(k,28) + & + rxt(k,346)*y(k,63) +rxt(k,348)*y(k,73))*y(k,134) & + + (rxt(k,389)*y(k,41) +rxt(k,482)*y(k,49) +rxt(k,505)*y(k,45) + & + rxt(k,537)*y(k,23))*y(k,71) + (rxt(k,9) +rxt(k,124)*y(k,94) + & + rxt(k,357)*y(k,135))*y(k,51) + (rxt(k,23) + & + .300_r8*rxt(k,535)*y(k,133))*y(k,22) + (rxt(k,129)*y(k,97) + & + rxt(k,414)*y(k,73))*y(k,40) +.330_r8*rxt(k,25)*y(k,23) & + +2.000_r8*rxt(k,4)*y(k,43) +rxt(k,356)*y(k,135)*y(k,49) +rxt(k,10) & + *y(k,52) +rxt(k,58)*y(k,53) +rxt(k,59)*y(k,54) +rxt(k,12)*y(k,55) & + +.500_r8*rxt(k,560)*y(k,63) +rxt(k,138)*y(k,99)*y(k,98) + loss(k,134) = (rxt(k,341)* y(k,25) +rxt(k,342)* y(k,28) +rxt(k,343)* y(k,32) & + +rxt(k,344)* y(k,40) +rxt(k,345)* y(k,49) +rxt(k,346)* y(k,63) & + +rxt(k,347)* y(k,70) +rxt(k,348)* y(k,73) + rxt(k,98) & + + het_rates(k,134))* y(k,134) + prod(k,134) = (rxt(k,117)*y(k,94) +rxt(k,287)*y(k,111) +rxt(k,331)*y(k,130)) & + *y(k,40) + (rxt(k,354)*y(k,41) +rxt(k,355)*y(k,139))*y(k,135) + loss(k,135) = (rxt(k,350)* y(k,25) +rxt(k,351)* y(k,28) +rxt(k,352)* y(k,32) & + + (rxt(k,353) +rxt(k,354))* y(k,41) +rxt(k,356)* y(k,49) +rxt(k,357) & + * y(k,51) +rxt(k,136)* y(k,62) +rxt(k,359)* y(k,63) +rxt(k,360) & + * y(k,70) +rxt(k,362)* y(k,72) +rxt(k,363)* y(k,73) +rxt(k,361) & + * y(k,125) +rxt(k,355)* y(k,139) + rxt(k,99) + rxt(k,358) & + + het_rates(k,135))* y(k,135) + prod(k,135) =rxt(k,325)*y(k,127)*y(k,70) +rxt(k,134)*y(k,98)*y(k,73) & + +rxt(k,63)*y(k,94) +rxt(k,95)*y(k,130) + loss(k,86) = (rxt(k,594)* y(k,32) +rxt(k,597)* y(k,72) +rxt(k,596)* y(k,109) & + + rxt(k,595) + het_rates(k,136))* y(k,136) + prod(k,86) = (rxt(k,77) +rxt(k,81) +rxt(k,587)*y(k,110) + & + rxt(k,588)*y(k,124) +rxt(k,600)*y(k,137) +rxt(k,606)*y(k,138)) & + *y(k,70) + (rxt(k,85) +rxt(k,87))*y(k,72) + (rxt(k,598)*y(k,137) + & + rxt(k,603)*y(k,138))*y(k,98) +rxt(k,580)*y(k,137) +rxt(k,579) & + *y(k,138) + loss(k,62) = (rxt(k,600)* y(k,70) +rxt(k,601)* y(k,72) +rxt(k,598)* y(k,98) & + + rxt(k,580) + rxt(k,599) + het_rates(k,137))* y(k,137) + prod(k,62) = (rxt(k,78) +rxt(k,82))*y(k,70) + (rxt(k,83) +rxt(k,92))*y(k,72) & + + (rxt(k,581) +rxt(k,602)*y(k,98))*y(k,138) + loss(k,61) = (rxt(k,606)* y(k,70) + (rxt(k,602) +rxt(k,603))* y(k,98) & + + rxt(k,579) + rxt(k,581) + rxt(k,604) + rxt(k,605) & + + het_rates(k,138))* y(k,138) + prod(k,61) = (rxt(k,79) +rxt(k,80))*y(k,70) + (rxt(k,90) +rxt(k,91))*y(k,72) + loss(k,139) = (rxt(k,509)* y(k,39) +rxt(k,390)* y(k,71) +rxt(k,557)* y(k,82) & + +rxt(k,107)* y(k,90) +rxt(k,119)* y(k,94) +rxt(k,118)* y(k,96) & + +rxt(k,139)* y(k,99) +rxt(k,374)* y(k,102) +rxt(k,376)* y(k,103) & + +rxt(k,140)* y(k,104) +rxt(k,378)* y(k,105) +rxt(k,143)* y(k,106) & + +rxt(k,372)* y(k,108) +rxt(k,288)* y(k,111) +rxt(k,296)* y(k,113) & + +rxt(k,294)* y(k,115) +rxt(k,365)* y(k,118) +rxt(k,367)* y(k,119) & + +rxt(k,305)* y(k,120) +rxt(k,307)* y(k,121) +rxt(k,366)* y(k,122) & + +rxt(k,313)* y(k,123) +rxt(k,329)* y(k,128) + (rxt(k,327) + & + rxt(k,328))* y(k,129) +rxt(k,337)* y(k,132) +rxt(k,355)* y(k,135) & + + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,139))* y(k,139) + prod(k,139) = (rxt(k,377) +4.000_r8*rxt(k,141)*y(k,98) + & + 4.000_r8*rxt(k,146)*y(k,117) +4.000_r8*rxt(k,147)*y(k,90) + & + 5.000_r8*rxt(k,158)*y(k,96) +5.000_r8*rxt(k,162)*y(k,112) + & + 4.000_r8*rxt(k,163)*y(k,116) +5.000_r8*rxt(k,164)*y(k,91) + & + 6.000_r8*rxt(k,165)*y(k,114) +4.000_r8*rxt(k,166)*y(k,111) + & + 4.000_r8*rxt(k,170)*y(k,94) +4.000_r8*rxt(k,181)*y(k,92) + & + 4.000_r8*rxt(k,192)*y(k,113) +4.000_r8*rxt(k,203)*y(k,100) + & + 4.000_r8*rxt(k,214)*y(k,127) +4.000_r8*rxt(k,225)*y(k,97) + & + 5.000_r8*rxt(k,236)*y(k,115) +6.000_r8*rxt(k,247)*y(k,95) + & + 4.000_r8*rxt(k,258)*y(k,94) +5.000_r8*rxt(k,260)*y(k,96) + & + 5.000_r8*rxt(k,262)*y(k,115) +4.000_r8*rxt(k,264)*y(k,113) + & + 4.000_r8*rxt(k,267)*y(k,92) +4.000_r8*rxt(k,269)*y(k,117) + & + 6.000_r8*rxt(k,271)*y(k,95))*y(k,105) + (rxt(k,379) + & + 5.000_r8*rxt(k,144)*y(k,98) +5.000_r8*rxt(k,167)*y(k,117) + & + 5.000_r8*rxt(k,168)*y(k,94) +5.000_r8*rxt(k,169)*y(k,92) + & + 5.000_r8*rxt(k,171)*y(k,113) +5.000_r8*rxt(k,172)*y(k,100) + & + 5.000_r8*rxt(k,173)*y(k,127) +5.000_r8*rxt(k,174)*y(k,97) + & + 6.000_r8*rxt(k,175)*y(k,115) +7.000_r8*rxt(k,176)*y(k,95) + & + 5.000_r8*rxt(k,177)*y(k,90) +6.000_r8*rxt(k,178)*y(k,96) + & + 6.000_r8*rxt(k,179)*y(k,112) +5.000_r8*rxt(k,180)*y(k,116) + & + 6.000_r8*rxt(k,182)*y(k,91) +7.000_r8*rxt(k,183)*y(k,114) + & + 5.000_r8*rxt(k,184)*y(k,111) +7.000_r8*rxt(k,259)*y(k,95) + & + 6.000_r8*rxt(k,261)*y(k,96) +6.000_r8*rxt(k,263)*y(k,115) + & + 5.000_r8*rxt(k,265)*y(k,94) +5.000_r8*rxt(k,266)*y(k,113) + & + 5.000_r8*rxt(k,268)*y(k,92) +5.000_r8*rxt(k,270)*y(k,117))*y(k,107) & + + (rxt(k,375) +3.000_r8*rxt(k,185)*y(k,117) + & + 3.000_r8*rxt(k,186)*y(k,94) +3.000_r8*rxt(k,187)*y(k,92) + & + 3.000_r8*rxt(k,188)*y(k,113) +3.000_r8*rxt(k,189)*y(k,100) + & + 3.000_r8*rxt(k,190)*y(k,127) +3.000_r8*rxt(k,191)*y(k,97) + & + 4.000_r8*rxt(k,193)*y(k,115) +5.000_r8*rxt(k,194)*y(k,95) + & + 3.000_r8*rxt(k,195)*y(k,90) +4.000_r8*rxt(k,196)*y(k,96) + & + 4.000_r8*rxt(k,197)*y(k,112) +3.000_r8*rxt(k,198)*y(k,116) + & + 4.000_r8*rxt(k,199)*y(k,91) +5.000_r8*rxt(k,200)*y(k,114) + & + 3.000_r8*rxt(k,201)*y(k,111) +3.000_r8*rxt(k,383)*y(k,98))*y(k,103) & + + (rxt(k,340)*y(k,55) +rxt(k,415)*y(k,41) +rxt(k,416)*y(k,43) + & + rxt(k,417)*y(k,101) +rxt(k,420)*y(k,133) +rxt(k,423)*y(k,52) + & + rxt(k,447)*y(k,51) +rxt(k,471)*y(k,49) +rxt(k,474)*y(k,54) + & + rxt(k,500)*y(k,45) +rxt(k,514)*y(k,16) +rxt(k,516)*y(k,18) + & + rxt(k,517)*y(k,19) +rxt(k,519)*y(k,20) +rxt(k,524)*y(k,48) + & + rxt(k,532)*y(k,17) +rxt(k,535)*y(k,22) +rxt(k,536)*y(k,23))*y(k,133) & + + (2.000_r8*rxt(k,220)*y(k,117) +2.000_r8*rxt(k,221)*y(k,94) + & + 2.000_r8*rxt(k,222)*y(k,92) +2.000_r8*rxt(k,223)*y(k,113) + & + 2.000_r8*rxt(k,224)*y(k,100) +2.000_r8*rxt(k,226)*y(k,127) + & + 2.000_r8*rxt(k,227)*y(k,97) +3.000_r8*rxt(k,228)*y(k,115) + & + 4.000_r8*rxt(k,229)*y(k,95) +2.000_r8*rxt(k,230)*y(k,90) + & + 3.000_r8*rxt(k,231)*y(k,96) +3.000_r8*rxt(k,232)*y(k,112) + & + 2.000_r8*rxt(k,233)*y(k,116) +3.000_r8*rxt(k,234)*y(k,91) + & + 4.000_r8*rxt(k,235)*y(k,114) +2.000_r8*rxt(k,237)*y(k,111) + & + 2.000_r8*rxt(k,303)*y(k,98))*y(k,119) + (rxt(k,202)*y(k,117) + & + rxt(k,204)*y(k,94) +rxt(k,205)*y(k,92) +rxt(k,206)*y(k,113) + & + rxt(k,207)*y(k,100) +rxt(k,208)*y(k,127) +rxt(k,209)*y(k,97) + & + 2.000_r8*rxt(k,210)*y(k,115) +3.000_r8*rxt(k,211)*y(k,95) + & + rxt(k,212)*y(k,90) +2.000_r8*rxt(k,213)*y(k,96) + & + 2.000_r8*rxt(k,215)*y(k,112) +rxt(k,216)*y(k,116) + & + 2.000_r8*rxt(k,217)*y(k,91) +3.000_r8*rxt(k,218)*y(k,114) + & + rxt(k,219)*y(k,111) +rxt(k,308)*y(k,98))*y(k,122) & + + (rxt(k,106)*y(k,91) +rxt(k,345)*y(k,134) +rxt(k,563)*y(k,54) + & + rxt(k,569)*y(k,54) +rxt(k,570)*y(k,53) +rxt(k,574)*y(k,54) + & + rxt(k,575)*y(k,53))*y(k,49) + (rxt(k,64) +rxt(k,283) + & + rxt(k,120)*y(k,63) +rxt(k,123)*y(k,62) +rxt(k,155)*y(k,128) + & + rxt(k,249)*y(k,118))*y(k,96) + (rxt(k,138)*y(k,99) + & + 3.000_r8*rxt(k,304)*y(k,120) +rxt(k,326)*y(k,129) + & + rxt(k,381)*y(k,108) +2.000_r8*rxt(k,382)*y(k,102))*y(k,98) & + + (rxt(k,245)*y(k,115) +2.000_r8*rxt(k,246)*y(k,95) + & + rxt(k,250)*y(k,112) +rxt(k,252)*y(k,91) + & + 2.000_r8*rxt(k,253)*y(k,114))*y(k,118) + (rxt(k,152)*y(k,115) + & + 2.000_r8*rxt(k,153)*y(k,95) +rxt(k,156)*y(k,112) + & + rxt(k,159)*y(k,91) +2.000_r8*rxt(k,160)*y(k,114))*y(k,128) & + + (rxt(k,344)*y(k,134) +rxt(k,410)*y(k,101))*y(k,40) + (rxt(k,274) + & + rxt(k,293)*y(k,58))*y(k,114) + (rxt(k,282) +rxt(k,295)*y(k,51)) & + *y(k,115) +.050_r8*rxt(k,25)*y(k,23) +rxt(k,353)*y(k,135)*y(k,41) & + +rxt(k,100)*y(k,44) +rxt(k,385)*y(k,91) +rxt(k,284)*y(k,95) & + +rxt(k,373)*y(k,102) +rxt(k,273)*y(k,112) +rxt(k,94)*y(k,129) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_mad_mam5/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_mad_mam5/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..e43e8ab899 --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/mo_rxt_rates_conv.F90 @@ -0,0 +1,618 @@ +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,:, 139) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 139) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 139) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 43) ! rate_const*H2O2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 72) ! rate_const*O2 + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 72) ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 73) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 73) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 51) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 52) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 52) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 55) ! rate_const*HONO + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 57) ! rate_const*N2O + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 58) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 58) ! rate_const*N2O5 + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 62) ! rate_const*NO + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 62) ! rate_const*NO + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 63) ! rate_const*NO2 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 64) ! rate_const*NO3 + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 64) ! rate_const*NO3 + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 17) ! rate_const*CH2O + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 17) ! rate_const*CH2O + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 22) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 23) ! rate_const*CH4 + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 23) ! rate_const*CH4 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 32) ! rate_const*CO2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 4) ! rate_const*BRCL + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 5) ! rate_const*BRO + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 8) ! rate_const*CCL4 + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 9) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 10) ! rate_const*CF3BR + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 11) ! rate_const*CFC11 + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 12) ! rate_const*CFC113 + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 13) ! rate_const*CFC114 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 14) ! rate_const*CFC115 + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 15) ! rate_const*CFC12 + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 16) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 18) ! rate_const*CH3BR + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 19) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 20) ! rate_const*CH3CL + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 24) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 26) ! rate_const*CL2 + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 27) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 28) ! rate_const*CLO + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 33) ! rate_const*COF2 + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 34) ! rate_const*COFCL + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 42) ! rate_const*H2402 + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 45) ! rate_const*HBR + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 46) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 47) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 48) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 49) ! rate_const*HCL + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 50) ! rate_const*HF + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 53) ! rate_const*HOBR + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 54) ! rate_const*HOCL + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 74) ! rate_const*OCLO + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 79) ! rate_const*SF6 + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 32) ! rate_const*CO2 + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 94) ! rate_const*CO3m + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 96) ! rate_const*CO3m_H2O + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 97) ! rate_const*CO4m + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 56) ! rate_const*N + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 111) ! rate_const*NO2m + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 113) ! rate_const*NO3m + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 70) ! rate_const*O + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 70) ! rate_const*O + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 70) ! rate_const*O + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 70) ! rate_const*O + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 70) ! rate_const*O + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 70) ! rate_const*O + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 72) ! rate_const*O2 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 72) ! rate_const*O2 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 72) ! rate_const*O2 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 72) ! rate_const*O2 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 72) ! rate_const*O2 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 72) ! rate_const*O2 + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 72) ! rate_const*O2 + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 72) ! rate_const*O2 + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 72) ! rate_const*O2 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 72) ! rate_const*O2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 127) ! rate_const*O2m + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 129) ! rate_const*O2p_H2O + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 130) ! rate_const*O3m + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 130) ! rate_const*O3m + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 131) ! rate_const*O4m + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 134) ! rate_const*OHm + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 135) ! rate_const*Om + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 44) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 75) ! rate_const*OCS + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 80) ! rate_const*SO + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 81) ! rate_const*SO2 + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 82) ! rate_const*SO3 + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 90)*sol(:ncol,:, 40) ! rate_const*CLm*H + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 91)*sol(:ncol,:, 49) ! rate_const*CLm_H2O*HCL + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 90)*sol(:ncol,:, 139) ! rate_const*M*CLm*H2O + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 49)*sol(:ncol,:, 90) ! rate_const*M*HCL*CLm + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 90)*sol(:ncol,:, 51) ! rate_const*CLm*HNO3 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 90)*sol(:ncol,:, 63) ! rate_const*CLm*NO2 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 93)*sol(:ncol,:, 62) ! rate_const*CLOm*NO + rxt_rates(:ncol,:, 112) = rxt_rates(:ncol,:, 112)*sol(:ncol,:, 93)*sol(:ncol,:, 62) ! rate_const*CLOm*NO + rxt_rates(:ncol,:, 113) = rxt_rates(:ncol,:, 113)*sol(:ncol,:, 93)*sol(:ncol,:, 70) ! rate_const*CLOm*O + rxt_rates(:ncol,:, 114) = rxt_rates(:ncol,:, 114)*sol(:ncol,:, 25)*sol(:ncol,:, 94) ! rate_const*CL*CO3m + rxt_rates(:ncol,:, 115) = rxt_rates(:ncol,:, 115)*sol(:ncol,:, 25)*sol(:ncol,:, 94) ! rate_const*CL*CO3m + rxt_rates(:ncol,:, 116) = rxt_rates(:ncol,:, 116)*sol(:ncol,:, 28)*sol(:ncol,:, 94) ! rate_const*CLO*CO3m + rxt_rates(:ncol,:, 117) = rxt_rates(:ncol,:, 117)*sol(:ncol,:, 40)*sol(:ncol,:, 94) ! rate_const*H*CO3m + rxt_rates(:ncol,:, 118) = rxt_rates(:ncol,:, 118)*sol(:ncol,:, 96)*sol(:ncol,:, 139) ! rate_const*M*CO3m_H2O*H2O + rxt_rates(:ncol,:, 119) = rxt_rates(:ncol,:, 119)*sol(:ncol,:, 94)*sol(:ncol,:, 139) ! rate_const*M*CO3m*H2O + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 96)*sol(:ncol,:, 63) ! rate_const*CO3m_H2O*NO2 + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 96)*sol(:ncol,:, 63) ! rate_const*CO3m_H2O*NO2 + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 96)*sol(:ncol,:, 62) ! rate_const*CO3m_H2O*NO + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 96)*sol(:ncol,:, 62) ! rate_const*CO3m_H2O*NO + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 94)*sol(:ncol,:, 51) ! rate_const*CO3m*HNO3 + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 94)*sol(:ncol,:, 70) ! rate_const*CO3m*O + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 72)*sol(:ncol,:, 94) ! rate_const*O2*CO3m + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 25)*sol(:ncol,:, 97) ! rate_const*CL*CO4m + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 28)*sol(:ncol,:, 97) ! rate_const*CLO*CO4m + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 97)*sol(:ncol,:, 40) ! rate_const*CO4m*H + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 97)*sol(:ncol,:, 49) ! rate_const*CO4m*HCL + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 97)*sol(:ncol,:, 70) ! rate_const*CO4m*O + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 97)*sol(:ncol,:, 73) ! rate_const*CO4m*O3 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 98)*sol(:ncol,:, 72) ! rate_const*N2*e*O2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 73)*sol(:ncol,:, 98) ! rate_const*O3*e + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 72)*sol(:ncol,:, 98) ! rate_const*M*O2*e + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 62)*sol(:ncol,:, 135) ! rate_const*NO*Om + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 127) ! rate_const*N2*O2m + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 99)*sol(:ncol,:, 98) ! rate_const*H3Op_OH*e + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 139)*sol(:ncol,:, 99) ! rate_const*H2O*H3Op_OH + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 139)*sol(:ncol,:, 104) ! rate_const*H2O*Hp_3N1 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 105)*sol(:ncol,:, 98) ! rate_const*Hp_4H2O*e + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 105)*sol(:ncol,:, 58) ! rate_const*Hp_4H2O*N2O5 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 139)*sol(:ncol,:, 106) ! rate_const*H2O*Hp_4N1 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 107)*sol(:ncol,:, 98) ! rate_const*Hp_5H2O*e + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 107)*sol(:ncol,:, 58) ! rate_const*Hp_5H2O*N2O5 + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 105)*sol(:ncol,:, 117) ! rate_const*Hp_4H2O*NO3mHNO3 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 90)*sol(:ncol,:, 105) ! rate_const*CLm*Hp_4H2O + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 113)*sol(:ncol,:, 128) ! rate_const*NO3m*O2p + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 100)*sol(:ncol,:, 128) ! rate_const*HCO3m*O2p + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 127)*sol(:ncol,:, 128) ! rate_const*O2m*O2p + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 97)*sol(:ncol,:, 128) ! rate_const*CO4m*O2p + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 115)*sol(:ncol,:, 128) ! rate_const*NO3m_H2O*O2p + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 95)*sol(:ncol,:, 128) ! rate_const*CO3m2H2O*O2p + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 90)*sol(:ncol,:, 128) ! rate_const*CLm*O2p + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 96)*sol(:ncol,:, 128) ! rate_const*CO3m_H2O*O2p + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 112)*sol(:ncol,:, 128) ! rate_const*NO2m_H2O*O2p + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 116)*sol(:ncol,:, 128) ! rate_const*NO3m_HCL*O2p + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 96)*sol(:ncol,:, 105) ! rate_const*CO3m_H2O*Hp_4H2O + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 128)*sol(:ncol,:, 91) ! rate_const*O2p*CLm_H2O + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 114)*sol(:ncol,:, 128) ! rate_const*NO3m2H2O*O2p + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 111)*sol(:ncol,:, 128) ! rate_const*NO2m*O2p + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 105)*sol(:ncol,:, 112) ! rate_const*Hp_4H2O*NO2m_H2O + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 105)*sol(:ncol,:, 116) ! rate_const*Hp_4H2O*NO3m_HCL + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 91)*sol(:ncol,:, 105) ! rate_const*CLm_H2O*Hp_4H2O + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 114)*sol(:ncol,:, 105) ! rate_const*NO3m2H2O*Hp_4H2O + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 105)*sol(:ncol,:, 111) ! rate_const*Hp_4H2O*NO2m + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 107)*sol(:ncol,:, 117) ! rate_const*Hp_5H2O*NO3mHNO3 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 94)*sol(:ncol,:, 107) ! rate_const*CO3m*Hp_5H2O + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 92)*sol(:ncol,:, 107) ! rate_const*CLm_HCL*Hp_5H2O + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 94)*sol(:ncol,:, 105) ! rate_const*CO3m*Hp_4H2O + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 113)*sol(:ncol,:, 107) ! rate_const*NO3m*Hp_5H2O + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 100)*sol(:ncol,:, 107) ! rate_const*HCO3m*Hp_5H2O + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 107)*sol(:ncol,:, 127) ! rate_const*Hp_5H2O*O2m + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 97)*sol(:ncol,:, 107) ! rate_const*CO4m*Hp_5H2O + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 107)*sol(:ncol,:, 115) ! rate_const*Hp_5H2O*NO3m_H2O + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 95)*sol(:ncol,:, 107) ! rate_const*CO3m2H2O*Hp_5H2O + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 90)*sol(:ncol,:, 107) ! rate_const*CLm*Hp_5H2O + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 96)*sol(:ncol,:, 107) ! rate_const*CO3m_H2O*Hp_5H2O + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 112)*sol(:ncol,:, 107) ! rate_const*NO2m_H2O*Hp_5H2O + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 107)*sol(:ncol,:, 116) ! rate_const*Hp_5H2O*NO3m_HCL + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 92)*sol(:ncol,:, 105) ! rate_const*CLm_HCL*Hp_4H2O + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 91)*sol(:ncol,:, 107) ! rate_const*CLm_H2O*Hp_5H2O + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 107)*sol(:ncol,:, 114) ! rate_const*Hp_5H2O*NO3m2H2O + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 107)*sol(:ncol,:, 111) ! rate_const*Hp_5H2O*NO2m + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 103)*sol(:ncol,:, 117) ! rate_const*Hp_3H2O*NO3mHNO3 + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 103)*sol(:ncol,:, 94) ! rate_const*Hp_3H2O*CO3m + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 92)*sol(:ncol,:, 103) ! rate_const*CLm_HCL*Hp_3H2O + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 103)*sol(:ncol,:, 113) ! rate_const*Hp_3H2O*NO3m + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 100)*sol(:ncol,:, 103) ! rate_const*HCO3m*Hp_3H2O + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 103)*sol(:ncol,:, 127) ! rate_const*Hp_3H2O*O2m + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 97)*sol(:ncol,:, 103) ! rate_const*CO4m*Hp_3H2O + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 105)*sol(:ncol,:, 113) ! rate_const*Hp_4H2O*NO3m + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 103)*sol(:ncol,:, 115) ! rate_const*Hp_3H2O*NO3m_H2O + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 95)*sol(:ncol,:, 103) ! rate_const*CO3m2H2O*Hp_3H2O + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 90)*sol(:ncol,:, 103) ! rate_const*CLm*Hp_3H2O + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 96)*sol(:ncol,:, 103) ! rate_const*CO3m_H2O*Hp_3H2O + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 103)*sol(:ncol,:, 112) ! rate_const*Hp_3H2O*NO2m_H2O + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 103)*sol(:ncol,:, 116) ! rate_const*Hp_3H2O*NO3m_HCL + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 91)*sol(:ncol,:, 103) ! rate_const*CLm_H2O*Hp_3H2O + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 103)*sol(:ncol,:, 114) ! rate_const*Hp_3H2O*NO3m2H2O + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 103)*sol(:ncol,:, 111) ! rate_const*Hp_3H2O*NO2m + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 117)*sol(:ncol,:, 122) ! rate_const*NO3mHNO3*NOp_H2O + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 100)*sol(:ncol,:, 105) ! rate_const*HCO3m*Hp_4H2O + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 94)*sol(:ncol,:, 122) ! rate_const*CO3m*NOp_H2O + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 92)*sol(:ncol,:, 122) ! rate_const*CLm_HCL*NOp_H2O + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 113)*sol(:ncol,:, 122) ! rate_const*NO3m*NOp_H2O + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 100)*sol(:ncol,:, 122) ! rate_const*HCO3m*NOp_H2O + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 122)*sol(:ncol,:, 127) ! rate_const*NOp_H2O*O2m + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 97)*sol(:ncol,:, 122) ! rate_const*CO4m*NOp_H2O + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 115)*sol(:ncol,:, 122) ! rate_const*NO3m_H2O*NOp_H2O + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 95)*sol(:ncol,:, 122) ! rate_const*CO3m2H2O*NOp_H2O + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 90)*sol(:ncol,:, 122) ! rate_const*CLm*NOp_H2O + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 96)*sol(:ncol,:, 122) ! rate_const*CO3m_H2O*NOp_H2O + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 105)*sol(:ncol,:, 127) ! rate_const*Hp_4H2O*O2m + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 112)*sol(:ncol,:, 122) ! rate_const*NO2m_H2O*NOp_H2O + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 116)*sol(:ncol,:, 122) ! rate_const*NO3m_HCL*NOp_H2O + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 91)*sol(:ncol,:, 122) ! rate_const*CLm_H2O*NOp_H2O + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 114)*sol(:ncol,:, 122) ! rate_const*NO3m2H2O*NOp_H2O + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 111)*sol(:ncol,:, 122) ! rate_const*NO2m*NOp_H2O + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 117)*sol(:ncol,:, 119) ! rate_const*NO3mHNO3*NOp_2H2O + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 94)*sol(:ncol,:, 119) ! rate_const*CO3m*NOp_2H2O + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 92)*sol(:ncol,:, 119) ! rate_const*CLm_HCL*NOp_2H2O + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 119)*sol(:ncol,:, 113) ! rate_const*NOp_2H2O*NO3m + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 100)*sol(:ncol,:, 119) ! rate_const*HCO3m*NOp_2H2O + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 97)*sol(:ncol,:, 105) ! rate_const*CO4m*Hp_4H2O + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 119)*sol(:ncol,:, 127) ! rate_const*NOp_2H2O*O2m + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 119)*sol(:ncol,:, 97) ! rate_const*NOp_2H2O*CO4m + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 115)*sol(:ncol,:, 119) ! rate_const*NO3m_H2O*NOp_2H2O + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 95)*sol(:ncol,:, 119) ! rate_const*CO3m2H2O*NOp_2H2O + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 90)*sol(:ncol,:, 119) ! rate_const*CLm*NOp_2H2O + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 96)*sol(:ncol,:, 119) ! rate_const*CO3m_H2O*NOp_2H2O + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 119)*sol(:ncol,:, 112) ! rate_const*NOp_2H2O*NO2m_H2O + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 116)*sol(:ncol,:, 119) ! rate_const*NO3m_HCL*NOp_2H2O + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 119)*sol(:ncol,:, 91) ! rate_const*NOp_2H2O*CLm_H2O + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 119)*sol(:ncol,:, 114) ! rate_const*NOp_2H2O*NO3m2H2O + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 105)*sol(:ncol,:, 115) ! rate_const*Hp_4H2O*NO3m_H2O + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 119)*sol(:ncol,:, 111) ! rate_const*NOp_2H2O*NO2m + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 118)*sol(:ncol,:, 117) ! rate_const*NOp*NO3mHNO3 + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 118)*sol(:ncol,:, 94) ! rate_const*NOp*CO3m + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 118)*sol(:ncol,:, 92) ! rate_const*NOp*CLm_HCL + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 113)*sol(:ncol,:, 118) ! rate_const*NO3m*NOp + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 118)*sol(:ncol,:, 100) ! rate_const*NOp*HCO3m + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 127)*sol(:ncol,:, 118) ! rate_const*O2m*NOp + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 118)*sol(:ncol,:, 97) ! rate_const*NOp*CO4m + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 118)*sol(:ncol,:, 115) ! rate_const*NOp*NO3m_H2O + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 118)*sol(:ncol,:, 95) ! rate_const*NOp*CO3m2H2O + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 95)*sol(:ncol,:, 105) ! rate_const*CO3m2H2O*Hp_4H2O + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 90)*sol(:ncol,:, 118) ! rate_const*CLm*NOp + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 96)*sol(:ncol,:, 118) ! rate_const*CO3m_H2O*NOp + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 112)*sol(:ncol,:, 118) ! rate_const*NO2m_H2O*NOp + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 116)*sol(:ncol,:, 118) ! rate_const*NO3m_HCL*NOp + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 91)*sol(:ncol,:, 118) ! rate_const*CLm_H2O*NOp + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 118)*sol(:ncol,:, 114) ! rate_const*NOp*NO3m2H2O + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 118)*sol(:ncol,:, 111) ! rate_const*NOp*NO2m + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 117)*sol(:ncol,:, 128) ! rate_const*NO3mHNO3*O2p + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 128)*sol(:ncol,:, 94) ! rate_const*O2p*CO3m + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 128)*sol(:ncol,:, 92) ! rate_const*O2p*CLm_HCL + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 105)*sol(:ncol,:, 94) ! rate_const*M*Hp_4H2O*CO3m + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 107)*sol(:ncol,:, 95) ! rate_const*M*Hp_5H2O*CO3m2H2O + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 96)*sol(:ncol,:, 105) ! rate_const*M*CO3m_H2O*Hp_4H2O + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 107)*sol(:ncol,:, 96) ! rate_const*M*Hp_5H2O*CO3m_H2O + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 115)*sol(:ncol,:, 105) ! rate_const*M*NO3m_H2O*Hp_4H2O + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 115)*sol(:ncol,:, 107) ! rate_const*M*NO3m_H2O*Hp_5H2O + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 113)*sol(:ncol,:, 105) ! rate_const*M*NO3m*Hp_4H2O + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 107)*sol(:ncol,:, 94) ! rate_const*M*Hp_5H2O*CO3m + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 107)*sol(:ncol,:, 113) ! rate_const*M*Hp_5H2O*NO3m + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 92)*sol(:ncol,:, 105) ! rate_const*M*CLm_HCL*Hp_4H2O + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 107)*sol(:ncol,:, 92) ! rate_const*M*Hp_5H2O*CLm_HCL + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 117)*sol(:ncol,:, 105) ! rate_const*M*NO3mHNO3*Hp_4H2O + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 107)*sol(:ncol,:, 117) ! rate_const*M*Hp_5H2O*NO3mHNO3 + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 95)*sol(:ncol,:, 105) ! rate_const*M*CO3m2H2O*Hp_4H2O + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 62)*sol(:ncol,:, 130) ! rate_const*NO*O3m + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 112) ! rate_const*M*NO2m_H2O + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 114) ! rate_const*M*NO3m2H2O + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 117) ! rate_const*M*NO3mHNO3 + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 49)*sol(:ncol,:, 113) ! rate_const*M*HCL*NO3m + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 63)*sol(:ncol,:, 130) ! rate_const*NO2*O3m + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 63)*sol(:ncol,:, 130) ! rate_const*NO2*O3m + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 62)*sol(:ncol,:, 130) ! rate_const*NO*O3m + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 94)*sol(:ncol,:, 62) ! rate_const*CO3m*NO + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 94)*sol(:ncol,:, 63) ! rate_const*CO3m*NO2 + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 115) ! rate_const*M*NO3m_H2O + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 96) ! rate_const*M*CO3m_H2O + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 95) ! rate_const*M*CO3m2H2O + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 25)*sol(:ncol,:, 111) ! rate_const*CL*NO2m + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 28)*sol(:ncol,:, 111) ! rate_const*CLO*NO2m + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 40)*sol(:ncol,:, 111) ! rate_const*H*NO2m + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 111)*sol(:ncol,:, 139) ! rate_const*M*NO2m*H2O + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 49)*sol(:ncol,:, 111) ! rate_const*HCL*NO2m + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 51)*sol(:ncol,:, 111) ! rate_const*HNO3*NO2m + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 63)*sol(:ncol,:, 111) ! rate_const*NO2*NO2m + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 111)*sol(:ncol,:, 73) ! rate_const*NO2m*O3 + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 114)*sol(:ncol,:, 58) ! rate_const*NO3m2H2O*N2O5 + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 115)*sol(:ncol,:, 139) ! rate_const*M*NO3m_H2O*H2O + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 51)*sol(:ncol,:, 115) ! rate_const*HNO3*NO3m_H2O + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 139)*sol(:ncol,:, 113) ! rate_const*M*H2O*NO3m + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 115)*sol(:ncol,:, 58) ! rate_const*NO3m_H2O*N2O5 + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 49)*sol(:ncol,:, 113) ! rate_const*HCL*NO3m + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 51)*sol(:ncol,:, 116) ! rate_const*HNO3*NO3m_HCL + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 113)*sol(:ncol,:, 51) ! rate_const*M*NO3m*HNO3 + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 113)*sol(:ncol,:, 70) ! rate_const*NO3m*O + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 73)*sol(:ncol,:, 113) ! rate_const*O3*NO3m + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 119)*sol(:ncol,:, 98) ! rate_const*NOp_2H2O*e + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 120)*sol(:ncol,:, 98) ! rate_const*NOp_3H2O*e + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 139)*sol(:ncol,:, 120) ! rate_const*H2O*NOp_3H2O + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 121)*sol(:ncol,:, 98) ! rate_const*NOp_CO2*e + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 121)*sol(:ncol,:, 139) ! rate_const*NOp_CO2*H2O + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 122)*sol(:ncol,:, 98) ! rate_const*NOp_H2O*e + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 40)*sol(:ncol,:, 122) ! rate_const*H*NOp_H2O + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 122)*sol(:ncol,:, 101) ! rate_const*NOp_H2O*HO2 + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 122)*sol(:ncol,:, 133) ! rate_const*NOp_H2O*OH + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 32)*sol(:ncol,:, 123) ! rate_const*CO2*NOp_N2 + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 123)*sol(:ncol,:, 139) ! rate_const*NOp_N2*H2O + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 127)*sol(:ncol,:, 25) ! rate_const*O2m*CL + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 28)*sol(:ncol,:, 127) ! rate_const*CLO*O2m + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 32)*sol(:ncol,:, 127) ! rate_const*M*CO2*O2m + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 40)*sol(:ncol,:, 127) ! rate_const*H*O2m + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 127)*sol(:ncol,:, 49) ! rate_const*O2m*HCL + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 127)*sol(:ncol,:, 51) ! rate_const*O2m*HNO3 + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 63)*sol(:ncol,:, 127) ! rate_const*NO2*O2m + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 125)*sol(:ncol,:, 127) ! rate_const*O2_1D*O2m + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 72)*sol(:ncol,:, 127) ! rate_const*M*O2*O2m + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 73)*sol(:ncol,:, 127) ! rate_const*O3*O2m + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 70)*sol(:ncol,:, 127) ! rate_const*O*O2m + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 127)*sol(:ncol,:, 70) ! rate_const*O2m*O + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 129)*sol(:ncol,:, 98) ! rate_const*O2p_H2O*e + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 129)*sol(:ncol,:, 139) ! rate_const*O2p_H2O*H2O + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 129)*sol(:ncol,:, 139) ! rate_const*O2p_H2O*H2O + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 139)*sol(:ncol,:, 128) ! rate_const*M*H2O*O2p + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 130)*sol(:ncol,:, 32) ! rate_const*O3m*CO2 + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 130)*sol(:ncol,:, 40) ! rate_const*O3m*H + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 73)*sol(:ncol,:, 130) ! rate_const*O3*O3m + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 130)*sol(:ncol,:, 70) ! rate_const*O3m*O + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 70)*sol(:ncol,:, 130) ! rate_const*O*O3m + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 32)*sol(:ncol,:, 131) ! rate_const*CO2*O4m + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 70)*sol(:ncol,:, 131) ! rate_const*O*O4m + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 139)*sol(:ncol,:, 132) ! rate_const*H2O*O4p + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 132)*sol(:ncol,:, 70) ! rate_const*O4p*O + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 132)*sol(:ncol,:, 125) ! rate_const*O4p*O2_1D + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 55)*sol(:ncol,:, 133) ! rate_const*HONO*OH + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 25)*sol(:ncol,:, 134) ! rate_const*CL*OHm + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 28)*sol(:ncol,:, 134) ! rate_const*CLO*OHm + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 32)*sol(:ncol,:, 134) ! rate_const*M*CO2*OHm + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 40)*sol(:ncol,:, 134) ! rate_const*H*OHm + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 134)*sol(:ncol,:, 49) ! rate_const*OHm*HCL + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 63)*sol(:ncol,:, 134) ! rate_const*NO2*OHm + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 134)*sol(:ncol,:, 70) ! rate_const*OHm*O + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 134)*sol(:ncol,:, 73) ! rate_const*OHm*O3 + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 133)*sol(:ncol,:, 62) ! rate_const*M*OH*NO + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 135)*sol(:ncol,:, 25) ! rate_const*Om*CL + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 28)*sol(:ncol,:, 135) ! rate_const*CLO*Om + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 135)*sol(:ncol,:, 32) ! rate_const*M*Om*CO2 + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 41)*sol(:ncol,:, 135) ! rate_const*H2*Om + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 135)*sol(:ncol,:, 41) ! rate_const*Om*H2 + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 135)*sol(:ncol,:, 139) ! rate_const*Om*H2O + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 135)*sol(:ncol,:, 49) ! rate_const*Om*HCL + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 135)*sol(:ncol,:, 51) ! rate_const*Om*HNO3 + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 135) ! rate_const*M*Om + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 63)*sol(:ncol,:, 135) ! rate_const*NO2*Om + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 135)*sol(:ncol,:, 70) ! rate_const*Om*O + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 135)*sol(:ncol,:, 125) ! rate_const*Om*O2_1D + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 135)*sol(:ncol,:, 72) ! rate_const*M*Om*O2 + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 73)*sol(:ncol,:, 135) ! rate_const*O3*Om + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 128)*sol(:ncol,:, 72) ! rate_const*M*O2p*O2 + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 139)*sol(:ncol,:, 118) ! rate_const*M*H2O*NOp + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 139)*sol(:ncol,:, 122) ! rate_const*M*H2O*NOp_H2O + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 139)*sol(:ncol,:, 119) ! rate_const*M*H2O*NOp_2H2O + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 118)*sol(:ncol,:, 32) ! rate_const*M*NOp*CO2 + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 121) ! rate_const*M*NOp_CO2 + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 118) ! rate_const*N2*M*NOp + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 123) ! rate_const*M*NOp_N2 + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 108)*sol(:ncol,:, 139) ! rate_const*M*Hp_H2O*H2O + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 102) ! rate_const*M*Hp_2H2O + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 139)*sol(:ncol,:, 102) ! rate_const*M*H2O*Hp_2H2O + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 103) ! rate_const*M*Hp_3H2O + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 103)*sol(:ncol,:, 139) ! rate_const*M*Hp_3H2O*H2O + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 105) ! rate_const*M*Hp_4H2O + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 105)*sol(:ncol,:, 139) ! rate_const*M*Hp_4H2O*H2O + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 107) ! rate_const*M*Hp_5H2O + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 98)*sol(:ncol,:, 132) ! rate_const*e*O4p + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 108)*sol(:ncol,:, 98) ! rate_const*Hp_H2O*e + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 102)*sol(:ncol,:, 98) ! rate_const*Hp_2H2O*e + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 103)*sol(:ncol,:, 98) ! rate_const*Hp_3H2O*e + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 98)*sol(:ncol,:, 123) ! rate_const*e*NOp_N2 + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 91) ! rate_const*M*CLm_H2O + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 92) ! rate_const*M*CLm_HCL + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 125) ! rate_const*O2_1D + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 126) ! rate_const*O2_1S + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 71)*sol(:ncol,:, 41) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 71)*sol(:ncol,:, 139) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 71) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 71)*sol(:ncol,:, 72) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 71)*sol(:ncol,:, 72) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 71)*sol(:ncol,:, 73) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 125) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 125)*sol(:ncol,:, 70) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 125)*sol(:ncol,:, 72) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 126)*sol(:ncol,:, 32) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 126) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 126)*sol(:ncol,:, 70) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 126)*sol(:ncol,:, 72) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 126)*sol(:ncol,:, 73) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 70)*sol(:ncol,:, 73) ! rate_const*O*O3 + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 70)*sol(:ncol,:, 70) ! rate_const*M*O*O + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 70)*sol(:ncol,:, 72) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 41)*sol(:ncol,:, 70) ! rate_const*H2*O + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 43)*sol(:ncol,:, 70) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 40)*sol(:ncol,:, 101) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 40)*sol(:ncol,:, 101) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 40)*sol(:ncol,:, 101) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 40)*sol(:ncol,:, 72) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 101)*sol(:ncol,:, 70) ! rate_const*HO2*O + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 101)*sol(:ncol,:, 73) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 40)*sol(:ncol,:, 73) ! rate_const*H*O3 + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 133)*sol(:ncol,:, 41) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 133)*sol(:ncol,:, 43) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 133)*sol(:ncol,:, 101) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 133)*sol(:ncol,:, 70) ! rate_const*OH*O + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 133)*sol(:ncol,:, 73) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 133)*sol(:ncol,:, 133) ! rate_const*OH*OH + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 133)*sol(:ncol,:, 133) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 101)*sol(:ncol,:, 101) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 52)*sol(:ncol,:, 133) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 109)*sol(:ncol,:, 70) ! rate_const*N2D*O + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 109)*sol(:ncol,:, 72) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 56)*sol(:ncol,:, 62) ! rate_const*N*NO + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 56)*sol(:ncol,:, 63) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 56)*sol(:ncol,:, 63) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 56)*sol(:ncol,:, 63) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 56)*sol(:ncol,:, 72) ! rate_const*N*O2 + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 63)*sol(:ncol,:, 70) ! rate_const*NO2*O + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 63)*sol(:ncol,:, 73) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 63)*sol(:ncol,:, 70) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 64)*sol(:ncol,:, 101) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 64)*sol(:ncol,:, 62) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 64)*sol(:ncol,:, 70) ! rate_const*NO3*O + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 64)*sol(:ncol,:, 133) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 56)*sol(:ncol,:, 133) ! rate_const*N*OH + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 62)*sol(:ncol,:, 101) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 62)*sol(:ncol,:, 73) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 62)*sol(:ncol,:, 70) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 71)*sol(:ncol,:, 57) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 71)*sol(:ncol,:, 57) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 63)*sol(:ncol,:, 101) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 63)*sol(:ncol,:, 64) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 63)*sol(:ncol,:, 133) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 51)*sol(:ncol,:, 133) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 52) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 58) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 25)*sol(:ncol,:, 17) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 25)*sol(:ncol,:, 23) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 25)*sol(:ncol,:, 41) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 25)*sol(:ncol,:, 43) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 25)*sol(:ncol,:, 101) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 25)*sol(:ncol,:, 101) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 25)*sol(:ncol,:, 73) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 28)*sol(:ncol,:, 21) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 28)*sol(:ncol,:, 101) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 28)*sol(:ncol,:, 62) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 29)*sol(:ncol,:, 25) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 28)*sol(:ncol,:, 63) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 29)*sol(:ncol,:, 70) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 29)*sol(:ncol,:, 133) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 28)*sol(:ncol,:, 70) ! rate_const*CLO*O + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 28)*sol(:ncol,:, 133) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 28)*sol(:ncol,:, 133) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 49)*sol(:ncol,:, 70) ! rate_const*HCL*O + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 49)*sol(:ncol,:, 133) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 54)*sol(:ncol,:, 25) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 54)*sol(:ncol,:, 70) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 54)*sol(:ncol,:, 133) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 71)*sol(:ncol,:, 8) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 71)*sol(:ncol,:, 9) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 71)*sol(:ncol,:, 11) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 71)*sol(:ncol,:, 12) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 71)*sol(:ncol,:, 13) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 71)*sol(:ncol,:, 14) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 71)*sol(:ncol,:, 15) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 71)*sol(:ncol,:, 49) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 71)*sol(:ncol,:, 49) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 28)*sol(:ncol,:, 28) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 27) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 3)*sol(:ncol,:, 17) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 3)*sol(:ncol,:, 101) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 3)*sol(:ncol,:, 73) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 5)*sol(:ncol,:, 5) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 5)*sol(:ncol,:, 28) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 5)*sol(:ncol,:, 28) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 5)*sol(:ncol,:, 28) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 5)*sol(:ncol,:, 101) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 5)*sol(:ncol,:, 62) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 5)*sol(:ncol,:, 63) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 6)*sol(:ncol,:, 70) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 5)*sol(:ncol,:, 70) ! rate_const*BRO*O + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 5)*sol(:ncol,:, 133) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 45)*sol(:ncol,:, 70) ! rate_const*HBR*O + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 45)*sol(:ncol,:, 133) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 53)*sol(:ncol,:, 70) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 71)*sol(:ncol,:, 10) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 71)*sol(:ncol,:, 24) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 71)*sol(:ncol,:, 42) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 71)*sol(:ncol,:, 45) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 71)*sol(:ncol,:, 45) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 39)*sol(:ncol,:, 23) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 39)*sol(:ncol,:, 41) ! rate_const*F*H2 + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 39)*sol(:ncol,:, 139) ! rate_const*F*H2O + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 39)*sol(:ncol,:, 51) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 71)*sol(:ncol,:, 33) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 71)*sol(:ncol,:, 34) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 16)*sol(:ncol,:, 25) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 16)*sol(:ncol,:, 133) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 18)*sol(:ncol,:, 25) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 18)*sol(:ncol,:, 133) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 19)*sol(:ncol,:, 133) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 20)*sol(:ncol,:, 25) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 20)*sol(:ncol,:, 133) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 24)*sol(:ncol,:, 25) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 24)*sol(:ncol,:, 133) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 46)*sol(:ncol,:, 133) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 47)*sol(:ncol,:, 133) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 48)*sol(:ncol,:, 133) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 71)*sol(:ncol,:, 16) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 71)*sol(:ncol,:, 18) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 71)*sol(:ncol,:, 46) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 71)*sol(:ncol,:, 47) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 71)*sol(:ncol,:, 48) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 17)*sol(:ncol,:, 64) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 17)*sol(:ncol,:, 70) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 17)*sol(:ncol,:, 133) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 21)*sol(:ncol,:, 101) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 21)*sol(:ncol,:, 62) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 22)*sol(:ncol,:, 133) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 23)*sol(:ncol,:, 133) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 71)*sol(:ncol,:, 23) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 71)*sol(:ncol,:, 23) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 71)*sol(:ncol,:, 23) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 31)*sol(:ncol,:, 133) ! rate_const*CO*OH + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 35)*sol(:ncol,:, 64) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 35)*sol(:ncol,:, 133) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 75)*sol(:ncol,:, 70) ! rate_const*OCS*O + rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 75)*sol(:ncol,:, 133) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 78)*sol(:ncol,:, 72) ! rate_const*S*O2 + rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 81)*sol(:ncol,:, 133) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 78)*sol(:ncol,:, 73) ! rate_const*S*O3 + rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 80)*sol(:ncol,:, 5) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 80)*sol(:ncol,:, 28) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 78)*sol(:ncol,:, 133) ! rate_const*S*OH + rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 80)*sol(:ncol,:, 63) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 80)*sol(:ncol,:, 72) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 80)*sol(:ncol,:, 73) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 80)*sol(:ncol,:, 74) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 80)*sol(:ncol,:, 133) ! rate_const*SO*OH + rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 35)*sol(:ncol,:, 133) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 82)*sol(:ncol,:, 139) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 101) ! rate_const*HO2 + rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 58) ! rate_const*N2O5 + rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 63) ! rate_const*NO2 + rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 64) ! rate_const*NO3 + rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 58) ! rate_const*N2O5 + rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 54)*sol(:ncol,:, 49) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 58) ! rate_const*N2O5 + rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 29)*sol(:ncol,:, 49) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 54)*sol(:ncol,:, 49) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 53)*sol(:ncol,:, 49) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 6) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 29)*sol(:ncol,:, 49) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 54)*sol(:ncol,:, 49) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 53)*sol(:ncol,:, 49) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 58) ! rate_const*N2O5 + rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 29) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 29)*sol(:ncol,:, 49) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 138) ! rate_const*Op2P + rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 137) ! rate_const*Op2D + rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 138) ! rate_const*Op2P + rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 118)*sol(:ncol,:, 98) ! rate_const*NOp*e + rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 128)*sol(:ncol,:, 98) ! rate_const*O2p*e + rxt_rates(:ncol,:, 584) = rxt_rates(:ncol,:, 584)*sol(:ncol,:, 110)*sol(:ncol,:, 98) ! rate_const*N2p*e + rxt_rates(:ncol,:, 585) = rxt_rates(:ncol,:, 585)*sol(:ncol,:, 110)*sol(:ncol,:, 72) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 586) = rxt_rates(:ncol,:, 586)*sol(:ncol,:, 110)*sol(:ncol,:, 70) ! rate_const*N2p*O + rxt_rates(:ncol,:, 587) = rxt_rates(:ncol,:, 587)*sol(:ncol,:, 110)*sol(:ncol,:, 70) ! rate_const*N2p*O + rxt_rates(:ncol,:, 588) = rxt_rates(:ncol,:, 588)*sol(:ncol,:, 124)*sol(:ncol,:, 70) ! rate_const*Np*O + rxt_rates(:ncol,:, 589) = rxt_rates(:ncol,:, 589)*sol(:ncol,:, 124)*sol(:ncol,:, 72) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 590) = rxt_rates(:ncol,:, 590)*sol(:ncol,:, 124)*sol(:ncol,:, 72) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 591) = rxt_rates(:ncol,:, 591)*sol(:ncol,:, 128)*sol(:ncol,:, 56) ! rate_const*O2p*N + rxt_rates(:ncol,:, 592) = rxt_rates(:ncol,:, 592)*sol(:ncol,:, 128) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 593) = rxt_rates(:ncol,:, 593)*sol(:ncol,:, 128)*sol(:ncol,:, 62) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 594) = rxt_rates(:ncol,:, 594)*sol(:ncol,:, 136)*sol(:ncol,:, 32) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 595) = rxt_rates(:ncol,:, 595)*sol(:ncol,:, 136) ! rate_const*N2*Op + rxt_rates(:ncol,:, 596) = rxt_rates(:ncol,:, 596)*sol(:ncol,:, 136)*sol(:ncol,:, 109) ! rate_const*Op*N2D + rxt_rates(:ncol,:, 597) = rxt_rates(:ncol,:, 597)*sol(:ncol,:, 136)*sol(:ncol,:, 72) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 598) = rxt_rates(:ncol,:, 598)*sol(:ncol,:, 137)*sol(:ncol,:, 98) ! rate_const*Op2D*e + rxt_rates(:ncol,:, 599) = rxt_rates(:ncol,:, 599)*sol(:ncol,:, 137) ! rate_const*N2*Op2D + rxt_rates(:ncol,:, 600) = rxt_rates(:ncol,:, 600)*sol(:ncol,:, 137)*sol(:ncol,:, 70) ! rate_const*Op2D*O + rxt_rates(:ncol,:, 601) = rxt_rates(:ncol,:, 601)*sol(:ncol,:, 137)*sol(:ncol,:, 72) ! rate_const*Op2D*O2 + rxt_rates(:ncol,:, 602) = rxt_rates(:ncol,:, 602)*sol(:ncol,:, 138)*sol(:ncol,:, 98) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 603) = rxt_rates(:ncol,:, 603)*sol(:ncol,:, 138)*sol(:ncol,:, 98) ! rate_const*Op2P*e + rxt_rates(:ncol,:, 604) = rxt_rates(:ncol,:, 604)*sol(:ncol,:, 138) ! rate_const*N2*Op2P + rxt_rates(:ncol,:, 605) = rxt_rates(:ncol,:, 605)*sol(:ncol,:, 138) ! rate_const*N2*Op2P + rxt_rates(:ncol,:, 606) = rxt_rates(:ncol,:, 606)*sol(:ncol,:, 138)*sol(:ncol,:, 70) ! rate_const*Op2P*O + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_mad_mam5/mo_setrxt.F90 b/src/chemistry/pp_waccm_mad_mam5/mo_setrxt.F90 new file mode 100644 index 0000000000..211122efbc --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/mo_setrxt.F90 @@ -0,0 +1,538 @@ + + 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(:,105) = 9.6e-10_r8 + rate(:,106) = 1.3e-09_r8 + rate(:,107) = 2e-29_r8 + rate(:,108) = 1e-27_r8 + rate(:,109) = 1.6e-09_r8 + rate(:,110) = 6e-12_r8 + rate(:,111) = 2.9e-12_r8 + rate(:,112) = 2.9e-11_r8 + rate(:,113) = 2e-10_r8 + rate(:,114) = 1e-10_r8 + rate(:,115) = 1e-10_r8 + rate(:,116) = 1e-11_r8 + rate(:,117) = 1.7e-10_r8 + rate(:,118) = 1e-28_r8 + rate(:,119) = 1e-28_r8 + rate(:,120) = 4e-11_r8 + rate(:,121) = 4e-11_r8 + rate(:,122) = 3.5e-12_r8 + rate(:,123) = 3.5e-12_r8 + rate(:,124) = 3.51e-10_r8 + rate(:,125) = 1.1e-10_r8 + rate(:,126) = 6e-15_r8 + rate(:,127) = 1e-10_r8 + rate(:,128) = 1e-10_r8 + rate(:,129) = 2.2e-10_r8 + rate(:,130) = 1.2e-09_r8 + rate(:,131) = 1.4e-10_r8 + rate(:,132) = 1.3e-10_r8 + rate(:,138) = 1.5e-06_r8 + rate(:,139) = 2e-09_r8 + rate(:,140) = 1e-09_r8 + rate(:,141) = 3.6e-06_r8 + rate(:,142) = 4e-12_r8 + rate(:,143) = 1e-09_r8 + rate(:,144) = 5e-06_r8 + rate(:,145) = 7e-12_r8 + rate(:,285) = 1e-10_r8 + rate(:,286) = 1e-10_r8 + rate(:,287) = 3e-10_r8 + rate(:,288) = 1.6e-28_r8 + rate(:,289) = 1.4e-09_r8 + rate(:,290) = 1.6e-09_r8 + rate(:,291) = 2e-13_r8 + rate(:,292) = 1.2e-10_r8 + rate(:,293) = 7e-10_r8 + rate(:,294) = 1.6e-28_r8 + rate(:,295) = 1.6e-09_r8 + rate(:,296) = 1.6e-28_r8 + rate(:,297) = 7e-10_r8 + rate(:,298) = 1e-12_r8 + rate(:,299) = 7.6e-10_r8 + rate(:,300) = 1.45e-26_r8 + rate(:,301) = 5e-12_r8 + rate(:,302) = 1e-13_r8 + rate(:,303) = 2e-06_r8 + rate(:,304) = 2e-06_r8 + rate(:,305) = 7e-11_r8 + rate(:,306) = 1.5e-06_r8 + rate(:,307) = 1e-09_r8 + rate(:,308) = 1.5e-06_r8 + rate(:,309) = 7e-12_r8 + rate(:,310) = 5e-10_r8 + rate(:,311) = 1e-10_r8 + rate(:,312) = 1e-09_r8 + rate(:,313) = 1e-09_r8 + rate(:,314) = 1e-10_r8 + rate(:,315) = 1e-10_r8 + rate(:,316) = 9.9e-30_r8 + rate(:,317) = 1.4e-09_r8 + rate(:,318) = 1.6e-09_r8 + rate(:,319) = 2.9e-09_r8 + rate(:,320) = 7e-10_r8 + rate(:,321) = 2e-10_r8 + rate(:,322) = 3.4e-31_r8 + rate(:,323) = 7.8e-10_r8 + rate(:,324) = 1.5e-10_r8 + rate(:,325) = 1.5e-10_r8 + rate(:,326) = 2e-06_r8 + rate(:,327) = 9e-10_r8 + rate(:,328) = 2.4e-10_r8 + rate(:,329) = 2.8e-28_r8 + rate(:,330) = 5.5e-10_r8 + rate(:,331) = 8.4e-10_r8 + rate(:,332) = 1e-10_r8 + rate(:,333) = 1e-10_r8 + rate(:,334) = 2.5e-10_r8 + rate(:,335) = 4.3e-10_r8 + rate(:,336) = 4e-10_r8 + rate(:,337) = 1.7e-09_r8 + rate(:,338) = 3e-10_r8 + rate(:,339) = 1.5e-10_r8 + rate(:,341) = 1e-10_r8 + rate(:,342) = 1e-10_r8 + rate(:,343) = 7.6e-28_r8 + rate(:,344) = 1.4e-09_r8 + rate(:,345) = 1e-09_r8 + rate(:,346) = 1.1e-09_r8 + rate(:,347) = 2e-10_r8 + rate(:,348) = 9e-10_r8 + rate(:,350) = 1e-10_r8 + rate(:,351) = 1e-10_r8 + rate(:,352) = 2e-28_r8 + rate(:,353) = 5.8e-10_r8 + rate(:,354) = 3.2e-11_r8 + rate(:,355) = 6e-13_r8 + rate(:,356) = 2e-09_r8 + rate(:,357) = 3.6e-09_r8 + rate(:,358) = 5e-13_r8 + rate(:,359) = 1e-09_r8 + rate(:,360) = 1.9e-10_r8 + rate(:,361) = 3e-10_r8 + rate(:,362) = 2.9e-31_r8 + rate(:,363) = 8e-10_r8 + rate(:,387) = 0.000258_r8 + rate(:,388) = 0.085_r8 + rate(:,389) = 1.2e-10_r8 + rate(:,394) = 1.2e-10_r8 + rate(:,395) = 1e-20_r8 + rate(:,396) = 1.3e-16_r8 + rate(:,398) = 4.2e-13_r8 + rate(:,400) = 8e-14_r8 + rate(:,401) = 3.9e-17_r8 + rate(:,408) = 6.9e-12_r8 + rate(:,409) = 7.2e-11_r8 + rate(:,410) = 1.6e-12_r8 + rate(:,416) = 1.8e-12_r8 + rate(:,420) = 1.8e-12_r8 + rate(:,424) = 7e-13_r8 + rate(:,425) = 5e-12_r8 + rate(:,434) = 3.5e-12_r8 + rate(:,436) = 1.3e-11_r8 + rate(:,437) = 2.2e-11_r8 + rate(:,438) = 5e-11_r8 + rate(:,473) = 1.7e-13_r8 + rate(:,475) = 2.607e-10_r8 + rate(:,476) = 9.75e-11_r8 + rate(:,477) = 2.07e-10_r8 + rate(:,478) = 2.088e-10_r8 + rate(:,479) = 1.17e-10_r8 + rate(:,480) = 4.644e-11_r8 + rate(:,481) = 1.204e-10_r8 + rate(:,482) = 9.9e-11_r8 + rate(:,483) = 3.3e-12_r8 + rate(:,502) = 4.5e-11_r8 + rate(:,503) = 4.62e-10_r8 + rate(:,504) = 1.2e-10_r8 + rate(:,505) = 9e-11_r8 + rate(:,506) = 3e-11_r8 + rate(:,511) = 2.14e-11_r8 + rate(:,512) = 1.9e-10_r8 + rate(:,525) = 2.57e-10_r8 + rate(:,526) = 1.8e-10_r8 + rate(:,527) = 1.794e-10_r8 + rate(:,528) = 1.3e-10_r8 + rate(:,529) = 7.65e-11_r8 + rate(:,537) = 1.31e-10_r8 + rate(:,538) = 3.5e-11_r8 + rate(:,539) = 9e-12_r8 + rate(:,545) = 2.3e-12_r8 + rate(:,547) = 1.2e-11_r8 + rate(:,548) = 5.7e-11_r8 + rate(:,549) = 2.8e-11_r8 + rate(:,550) = 6.6e-11_r8 + rate(:,551) = 1.4e-11_r8 + rate(:,554) = 1.9e-12_r8 + rate(:,579) = 0.047_r8 + rate(:,580) = 7.7e-05_r8 + rate(:,581) = 0.171_r8 + rate(:,585) = 6e-11_r8 + rate(:,588) = 1e-12_r8 + rate(:,589) = 4e-10_r8 + rate(:,590) = 2e-10_r8 + rate(:,591) = 1e-10_r8 + rate(:,592) = 5e-16_r8 + rate(:,593) = 4.4e-10_r8 + rate(:,594) = 9e-10_r8 + rate(:,596) = 1.3e-10_r8 + rate(:,599) = 8e-10_r8 + rate(:,600) = 5e-12_r8 + rate(:,601) = 7e-10_r8 + rate(:,604) = 4.8e-10_r8 + rate(:,605) = 1e-10_r8 + rate(:,606) = 4e-10_r8 + + do n = 1,pver + offset = (n-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,n) + end do + + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,340) = 3e-12_r8 * exp_fac(:) + rate(:,417) = 4.8e-11_r8 * exp_fac(:) + rate(:,498) = 1.7e-11_r8 * exp_fac(:) + rate(:,390) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,391) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:,392) = 2.64e-11_r8 * exp_fac(:) + rate(:,393) = 6.6e-12_r8 * exp_fac(:) + rate(:,397) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:,399) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:,402) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:,403) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,406) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + rate(:,407) = 1.4e-12_r8 * exp( -2000._r8 * itemp(:) ) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,412) = 3e-11_r8 * exp_fac(:) + rate(:,500) = 5.5e-12_r8 * exp_fac(:) + rate(:,535) = 3.8e-12_r8 * exp_fac(:) + rate(:,413) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,414) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,415) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + rate(:,418) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:,419) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,423) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) + rate(:,426) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,427) = 2.9e-12_r8 * exp_fac(:) + rate(:,428) = 1.45e-12_r8 * exp_fac(:) + rate(:,429) = 1.45e-12_r8 * exp_fac(:) + rate(:,430) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:,431) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,432) = 1.2e-13_r8 * exp_fac(:) + rate(:,458) = 3e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,435) = 1.7e-11_r8 * exp_fac(:) + rate(:,532) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,439) = 3.44e-12_r8 * exp_fac(:) + rate(:,491) = 2.3e-12_r8 * exp_fac(:) + rate(:,494) = 8.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,440) = 3e-12_r8 * exp_fac(:) + rate(:,499) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,442) = 7.26e-11_r8 * exp_fac(:) + rate(:,443) = 4.64e-11_r8 * exp_fac(:) + rate(:,450) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,451) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,452) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,453) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,454) = 1.4e-11_r8 * exp_fac(:) + rate(:,468) = 7.4e-12_r8 * exp_fac(:) + rate(:,455) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,456) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,457) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,459) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,460) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,461) = 2.6e-12_r8 * exp_fac(:) + rate(:,462) = 6.4e-12_r8 * exp_fac(:) + rate(:,492) = 4.1e-13_r8 * exp_fac(:) + rate(:,463) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,465) = 3.6e-12_r8 * exp_fac(:) + rate(:,514) = 2e-12_r8 * exp_fac(:) + rate(:,466) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,467) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,469) = 6e-13_r8 * exp_fac(:) + rate(:,489) = 1.5e-12_r8 * exp_fac(:) + rate(:,497) = 1.9e-11_r8 * exp_fac(:) + rate(:,470) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,471) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,472) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + exp_fac(:) = exp( -500._r8 * itemp(:) ) + rate(:,474) = 3e-12_r8 * exp_fac(:) + rate(:,508) = 1.4e-10_r8 * exp_fac(:) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,486) = 1.7e-11_r8 * exp_fac(:) + rate(:,513) = 6.3e-12_r8 * exp_fac(:) + rate(:,487) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,488) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,490) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + rate(:,493) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,496) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,501) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,507) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) + exp_fac(:) = exp( 0._r8 * itemp(:) ) + rate(:,509) = 1.4e-11_r8 * exp_fac(:) + rate(:,511) = 2.14e-11_r8 * exp_fac(:) + rate(:,512) = 1.9e-10_r8 * exp_fac(:) + rate(:,525) = 2.57e-10_r8 * exp_fac(:) + rate(:,526) = 1.8e-10_r8 * exp_fac(:) + rate(:,527) = 1.794e-10_r8 * exp_fac(:) + rate(:,528) = 1.3e-10_r8 * exp_fac(:) + rate(:,529) = 7.65e-11_r8 * exp_fac(:) + rate(:,537) = 1.31e-10_r8 * exp_fac(:) + rate(:,538) = 3.5e-11_r8 * exp_fac(:) + rate(:,539) = 9e-12_r8 * exp_fac(:) + rate(:,545) = 2.3e-12_r8 * exp_fac(:) + rate(:,547) = 1.2e-11_r8 * exp_fac(:) + rate(:,548) = 5.7e-11_r8 * exp_fac(:) + rate(:,549) = 2.8e-11_r8 * exp_fac(:) + rate(:,550) = 6.6e-11_r8 * exp_fac(:) + rate(:,551) = 1.4e-11_r8 * exp_fac(:) + rate(:,554) = 1.9e-12_r8 * exp_fac(:) + rate(:,579) = 0.047_r8 * exp_fac(:) + rate(:,580) = 7.7e-05_r8 * exp_fac(:) + rate(:,581) = 0.171_r8 * exp_fac(:) + rate(:,585) = 6e-11_r8 * exp_fac(:) + rate(:,588) = 1e-12_r8 * exp_fac(:) + rate(:,589) = 4e-10_r8 * exp_fac(:) + rate(:,590) = 2e-10_r8 * exp_fac(:) + rate(:,591) = 1e-10_r8 * exp_fac(:) + rate(:,592) = 5e-16_r8 * exp_fac(:) + rate(:,593) = 4.4e-10_r8 * exp_fac(:) + rate(:,594) = 9e-10_r8 * exp_fac(:) + rate(:,596) = 1.3e-10_r8 * exp_fac(:) + rate(:,599) = 8e-10_r8 * exp_fac(:) + rate(:,600) = 5e-12_r8 * exp_fac(:) + rate(:,601) = 7e-10_r8 * exp_fac(:) + rate(:,604) = 4.8e-10_r8 * exp_fac(:) + rate(:,605) = 1e-10_r8 * exp_fac(:) + rate(:,606) = 4e-10_r8 * exp_fac(:) + rate(:,510) = 6e-12_r8 * exp( 400._r8 * itemp(:) ) + rate(:,515) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,516) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + rate(:,517) = 1.64e-12_r8 * exp( -1520._r8 * itemp(:) ) + rate(:,518) = 2.03e-11_r8 * exp( -1110._r8 * itemp(:) ) + rate(:,519) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,520) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,521) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,522) = 1.25e-12_r8 * exp_fac(:) + rate(:,531) = 3.4e-11_r8 * exp_fac(:) + rate(:,523) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,524) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,530) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,533) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + rate(:,534) = 2.8e-12_r8 * exp( 300._r8 * itemp(:) ) + rate(:,536) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + rate(:,541) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,542) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,543) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,544) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,552) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,553) = 3.4e-12_r8 * exp( -1100._r8 * itemp(:) ) + rate(:,555) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) + + itemp(:) = 300._r8 * itemp(:) + + n = ncol*pver + + ko(:) = 7e-31_r8 * itemp(:)**2.6_r8 + kinf(:) = 3.6e-11_r8 * itemp(:)**0.1_r8 + call jpl( rate(:,349), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.3e-32_r8 * itemp(:)**1.8_r8 + kinf(:) = 9.5e-11_r8 * itemp(:)**(-0.4_r8) + call jpl( rate(:,411), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,421), 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(:,433), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,441), 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(:,444), 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(:,445), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,446), 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(:,464), 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(:,484), 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(:,495), 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(:,546), 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,395) = 1e-20_r8 + rate(:n,396) = 1.3e-16_r8 + rate(:n,400) = 8e-14_r8 + rate(:n,401) = 3.9e-17_r8 + rate(:n,408) = 6.9e-12_r8 + rate(:n,424) = 7e-13_r8 + rate(:n,425) = 5e-12_r8 + rate(:n,579) = 0.047_r8 + rate(:n,580) = 7.7e-05_r8 + rate(:n,581) = 0.171_r8 + rate(:n,585) = 6e-11_r8 + rate(:n,588) = 1e-12_r8 + rate(:n,589) = 4e-10_r8 + rate(:n,590) = 2e-10_r8 + rate(:n,591) = 1e-10_r8 + rate(:n,593) = 4.4e-10_r8 + rate(:n,596) = 1.3e-10_r8 + rate(:n,599) = 8e-10_r8 + rate(:n,600) = 5e-12_r8 + rate(:n,601) = 7e-10_r8 + rate(:n,604) = 4.8e-10_r8 + rate(:n,605) = 1e-10_r8 + rate(:n,606) = 4e-10_r8 + + do k = 1,kbot + offset = (k-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,k) + end do + + rate(:n,391) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:n,392) = 2.64e-11_r8 * exp_fac(:) + rate(:n,393) = 6.6e-12_r8 * exp_fac(:) + rate(:n,397) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:n,399) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:n,402) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:n,403) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,412) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,413) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,414) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,417) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,418) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,419) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,426) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,430) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:n,431) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,439) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) + rate(:n,440) = 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,411) = wrk(:) + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_mad_mam5/mo_sim_dat.F90 b/src/chemistry/pp_waccm_mad_mam5/mo_sim_dat.F90 new file mode 100644 index 0000000000..1602f0bced --- /dev/null +++ b/src/chemistry/pp_waccm_mad_mam5/mo_sim_dat.F90 @@ -0,0 +1,778 @@ + + 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(:) = (/ 0, 0, 0, 139, 0 /) + + cls_rxt_cnt(:,4) = (/ 8, 142, 456, 139 /) + + solsym(:139) = (/ 'bc_a1 ','bc_a4 ','BR ','BRCL ','BRO ', & + 'BRONO2 ','BRY ','CCL4 ','CF2CLBR ','CF3BR ', & + 'CFC11 ','CFC113 ','CFC114 ','CFC115 ','CFC12 ', & + 'CH2BR2 ','CH2O ','CH3BR ','CH3CCL3 ','CH3CL ', & + 'CH3O2 ','CH3OOH ','CH4 ','CHBR3 ','CL ', & + 'CL2 ','CL2O2 ','CLO ','CLONO2 ','CLY ', & + 'CO ','CO2 ','COF2 ','COFCL ','DMS ', & + 'dst_a1 ','dst_a2 ','dst_a3 ','F ','H ', & + 'H2 ','H2402 ','H2O2 ','H2SO4 ','HBR ', & + 'HCFC141B ','HCFC142B ','HCFC22 ','HCL ','HF ', & + 'HNO3 ','HO2NO2 ','HOBR ','HOCL ','HONO ', & + 'N ','N2O ','N2O5 ','ncl_a1 ','ncl_a2 ', & + 'ncl_a3 ','NO ','NO2 ','NO3 ','num_a1 ', & + 'num_a2 ','num_a3 ','num_a4 ','num_a5 ','O ', & + 'O1D ','O2 ','O3 ','OCLO ','OCS ', & + 'pom_a1 ','pom_a4 ','S ','SF6 ','SO ', & + 'SO2 ','SO3 ','so4_a1 ','so4_a2 ','so4_a3 ', & + 'so4_a5 ','soa_a1 ','soa_a2 ','SOAG ','CLm ', & + 'CLm_H2O ','CLm_HCL ','CLOm ','CO3m ','CO3m2H2O ', & + 'CO3m_H2O ','CO4m ','e ','H3Op_OH ','HCO3m ', & + 'HO2 ','Hp_2H2O ','Hp_3H2O ','Hp_3N1 ','Hp_4H2O ', & + 'Hp_4N1 ','Hp_5H2O ','Hp_H2O ','N2D ','N2p ', & + 'NO2m ','NO2m_H2O ','NO3m ','NO3m2H2O ','NO3m_H2O ', & + 'NO3m_HCL ','NO3mHNO3 ','NOp ','NOp_2H2O ','NOp_3H2O ', & + 'NOp_CO2 ','NOp_H2O ','NOp_N2 ','Np ','O2_1D ', & + 'O2_1S ','O2m ','O2p ','O2p_H2O ','O3m ', & + 'O4m ','O4p ','OH ','OHm ','Om ', & + 'Op ','Op2D ','Op2P ','H2O ' /) + + adv_mass(:139) = (/ 12.011000_r8, 12.011000_r8, 79.904000_r8, 115.356700_r8, 95.903400_r8, & + 141.908940_r8, 99.716850_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, 50.485900_r8, & + 47.032000_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, 66.007206_r8, 82.461503_r8, 62.132400_r8, & + 135.064039_r8, 135.064039_r8, 135.064039_r8, 18.998403_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, 47.012940_r8, & + 14.006740_r8, 44.012880_r8, 108.010480_r8, 58.442468_r8, 58.442468_r8, & + 58.442468_r8, 30.006140_r8, 46.005540_r8, 62.004940_r8, 1.007400_r8, & + 1.007400_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, 15.999400_r8, & + 15.999400_r8, 31.998800_r8, 47.998200_r8, 67.451500_r8, 60.076400_r8, & + 12.011000_r8, 12.011000_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, 35.452700_r8, & + 53.466900_r8, 71.912800_r8, 51.452100_r8, 60.009200_r8, 96.037600_r8, & + 78.023400_r8, 76.008600_r8, 0.548567E-03_r8, 36.028400_r8, 61.016600_r8, & + 33.006200_r8, 37.035800_r8, 55.050000_r8, 118.062340_r8, 73.064200_r8, & + 136.076540_r8, 91.078400_r8, 19.021600_r8, 14.006740_r8, 28.013480_r8, & + 46.005540_r8, 64.019740_r8, 62.004940_r8, 98.033340_r8, 80.019140_r8, & + 98.465040_r8, 125.017280_r8, 30.006140_r8, 66.034540_r8, 68.049340_r8, & + 74.015940_r8, 48.020340_r8, 58.019620_r8, 14.006740_r8, 31.998800_r8, & + 31.998800_r8, 31.998800_r8, 31.998800_r8, 50.013000_r8, 47.998200_r8, & + 63.997600_r8, 63.997600_r8, 17.006800_r8, 17.006800_r8, 15.999400_r8, & + 15.999400_r8, 15.999400_r8, 15.999400_r8, 18.014200_r8 /) + + crb_mass(:139) = (/ 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, & + 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, 12.011000_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, 12.011000_r8, 12.011000_r8, 24.022000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_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, 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, 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, 0.000000_r8, 0.000000_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, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 12.011000_r8, 12.011000_r8, 12.011000_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, 0.000000_r8, 0.000000_r8, 12.011000_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, 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, 0.000000_r8, 0.000000_r8, & + 12.011000_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, & + 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 /) + + fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) + + 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, 124, 125, 126, 127, 128, 129, 130, & + 131, 132, 133, 134, 135, 136, 137, 138, 139 /) + + permute(:139,4) = (/ 1, 2, 99, 43, 106, 63, 3, 27, 34, 35, & + 29, 36, 30, 37, 31, 60, 107, 65, 32, 54, & + 89, 55, 88, 56, 125, 38, 26, 117, 83, 4, & + 69, 121, 39, 41, 50, 5, 6, 7, 81, 132, & + 103, 28, 64, 33, 79, 40, 42, 48, 138, 49, & + 126, 59, 77, 80, 73, 90, 44, 87, 8, 9, & + 10, 137, 133, 131, 11, 12, 13, 14, 15, 123, & + 108, 124, 136, 52, 53, 16, 17, 72, 18, 92, & + 82, 45, 19, 20, 21, 22, 23, 24, 25, 109, & + 96, 95, 84, 115, 94, 104, 110, 116, 57, 93, & + 112, 68, 120, 46, 130, 47, 129, 74, 76, 66, & + 113, 97, 111, 102, 105, 98, 101, 118, 119, 58, & + 71, 122, 70, 78, 85, 51, 127, 128, 75, 100, & + 67, 91, 114, 134, 135, 86, 62, 61, 139 /) + + diag_map(:139) = (/ 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, 29, 32, 36, 40, & + 44, 48, 52, 55, 60, 65, 70, 75, 77, 80, & + 85, 90, 95, 98, 103, 107, 111, 116, 122, 125, & + 131, 134, 139, 147, 155, 161, 167, 173, 179, 186, & + 193, 200, 206, 214, 221, 230, 239, 246, 252, 256, & + 264, 271, 278, 284, 292, 300, 309, 317, 324, 333, & + 341, 351, 359, 369, 377, 388, 401, 416, 432, 446, & + 461, 476, 490, 504, 519, 535, 550, 564, 582, 594, & + 609, 625, 647, 669, 691, 715, 738, 787, 811, 833, & + 866, 900, 926, 984,1014,1058,1104,1153,1197,1241, & + 1284,1327,1388,1438,1487,1529,1566,1612,1656,1700, & + 1741,1778,1827,1861,1898,1940,1983,2029,2090 /) + + extfrc_lst(: 25) = (/ 'so4_a2 ','DMS ','NO2 ','SO2 ','bc_a1 ', & + 'bc_a4 ','num_a1 ','num_a2 ','num_a4 ','num_a5 ', & + 'pom_a1 ','pom_a4 ','so4_a1 ','so4_a5 ','CO ', & + 'NO ','N ','N2D ','N2p ','OH ', & + 'Op ','e ','Np ','O ','O2p ' /) + + frc_from_dataset(: 25) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .false., .false., .false., .false., & + .false., .false., .false., .false., .false. /) + + inv_lst(: 2) = (/ 'M ', 'N2 ' /) + + slvd_lst(: 49) = (/ 'CLm ', 'CLm_H2O ', 'CLm_HCL ', 'CLOm ', 'CO3m ', & + 'CO3m2H2O ', 'CO3m_H2O ', 'CO4m ', 'e ', 'H3Op_OH ', & + 'HCO3m ', 'HO2 ', 'Hp_2H2O ', 'Hp_3H2O ', 'Hp_3N1 ', & + 'Hp_4H2O ', 'Hp_4N1 ', 'Hp_5H2O ', 'Hp_H2O ', 'N2D ', & + 'N2p ', 'NO2m ', 'NO2m_H2O ', 'NO3m ', 'NO3m2H2O ', & + 'NO3m_H2O ', 'NO3m_HCL ', 'NO3mHNO3 ', 'NOp ', 'NOp_2H2O ', & + 'NOp_3H2O ', 'NOp_CO2 ', 'NOp_H2O ', 'NOp_N2 ', 'Np ', & + 'O2_1D ', 'O2_1S ', 'O2m ', 'O2p ', 'O2p_H2O ', & + 'O3m ', 'O4m ', 'O4p ', 'OH ', 'OHm ', & + 'Om ', 'Op ', 'Op2D ', 'Op2P ' /) + + 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_c ', & + 'jh2o_a ', 'jh2o2 ', & + 'jo2_b ', 'jo2_a ', & + 'jo3_a ', 'jo3_b ', & + 'jhno3 ', 'jho2no2_a ', & + 'jho2no2_b ', 'jhono ', & + 'jn2o ', 'jn2o5_a ', & + 'jn2o5_b ', 'jno_i ', & + 'jno ', 'jno2 ', & + 'jno3_a ', 'jno3_b ', & + 'jch2o_a ', 'jch2o_b ', & + 'jch3ooh ', 'jch4_a ', & + 'jch4_b ', 'jco2 ', & + 'jbrcl ', 'jbro ', & + 'jbrono2_b ', 'jbrono2_a ', & + 'jccl4 ', 'jcf2clbr ', & + 'jcf3br ', 'jcfcl3 ', & + 'jcfc113 ', 'jcfc114 ', & + 'jcfc115 ', 'jcf2cl2 ', & + 'jch2br2 ', 'jch3br ', & + 'jch3ccl3 ', 'jch3cl ', & + 'jchbr3 ', 'jcl2 ', & + 'jcl2o2 ', 'jclo ', & + 'jclono2_a ', 'jclono2_b ', & + 'jcof2 ', 'jcofcl ', & + 'jh2402 ', 'jhbr ', & + 'jhcfc141b ', 'jhcfc142b ', & + 'jhcfc22 ', 'jhcl ', & + 'jhf ', 'jhobr ', & + 'jhocl ', 'joclo ', & + 'jsf6 ', 'jeuv_26 ', & + 'jpni3 ', 'jpni5 ', & + 'jpni4 ', 'jeuv_4 ', & + 'jeuv_18 ', 'jeuv_11 ', & + 'jeuv_10 ', 'jeuv_22 ', & + 'jeuv_23 ', 'jeuv_25 ', & + 'jeuv_13 ', 'jeuv_6 ', & + 'jepn6 ', 'jepn7 ', & + 'jeuv_1 ', 'jeuv_2 ', & + 'jeuv_16 ', 'jeuv_3 ', & + 'jeuv_14 ', 'jeuv_15 ', & + 'jeuv_8 ', 'jeuv_17 ', & + 'jeuv_7 ', 'jeuv_5 ', & + 'jeuv_19 ', 'jeuv_24 ', & + 'jeuv_12 ', 'jeuv_21 ', & + 'jeuv_9 ', 'jeuv_20 ', & + 'jepn2 ', 'jppi ', & + 'jpni1 ', 'jepn3 ', & + 'jpni2 ', 'jepn4 ', & + 'jepn1 ', 'jh2so4 ', & + 'jocs ', 'jso ', & + 'jso2 ', 'jso3 ', & + 'CLm_H ', 'CLmH2O_HCL ', & + 'CLm_H2O_Ma ', 'CLmHCL_M ', & + 'CLm_HNO3 ', 'CLm_NO2 ', & + 'CLOm_NOa ', 'CLOm_NOb ', & + 'CLOm_O ', 'CO3m_CLa ', & + 'CO3m_CLb ', 'CO3m_CLO ', & + 'CO3m_H ', 'CO3mH2O_H2O_M ', & + 'CO3m_H2O_M ', 'CO3mH2O_NO2a ', & + 'CO3mH2O_NO2b ', 'CO3mH2O_NOa ', & + 'CO3mH2O_NOb ', 'CO3m_HNO3 ', & + 'CO3m_O ', 'CO3m_O2 ', & + 'CO4m_CL ', 'CO4m_CLO ', & + 'CO4m_H ', 'CO4m_HCL ', & + 'CO4m_O ', 'CO4m_O3 ', & + 'ean1 ', 'ean2 ', & + 'ean3 ', 'edn1 ', & + 'edn2 ', 'H3OpOH_e ', & + 'H3OpOH_H2O ', 'Hp3N1_H2O ', & + 'Hp4H2O_e ', 'Hp4H2O_N2O5 ', & + 'Hp4N1_H2O ', 'Hp5H2O_e ', & + 'Hp5H2O_N2O5 ', 'iira1 ', & + 'iira10 ', 'iira100 ', & + 'iira101 ', 'iira102 ', & + 'iira103 ', 'iira104 ', & + 'iira105 ', 'iira106 ', & + 'iira107 ', 'iira108 ', & + 'iira109 ', 'iira11 ', & + 'iira110 ', 'iira111 ', & + 'iira112 ', 'iira12 ', & + 'iira13 ', 'iira14 ', & + 'iira15 ', 'iira16 ', & + 'iira17 ', 'iira18 ', & + 'iira19 ', 'iira2 ', & + 'iira20 ', 'iira21 ', & + 'iira22 ', 'iira23 ', & + 'iira24 ', 'iira25 ', & + 'iira26 ', 'iira27 ', & + 'iira28 ', 'iira29 ', & + 'iira3 ', 'iira30 ', & + 'iira31 ', 'iira32 ', & + 'iira33 ', 'iira34 ', & + 'iira35 ', 'iira36 ', & + 'iira37 ', 'iira38 ', & + 'iira39 ', 'iira4 ', & + 'iira40 ', 'iira41 ', & + 'iira42 ', 'iira43 ', & + 'iira44 ', 'iira45 ', & + 'iira46 ', 'iira47 ' /) + rxt_tag_lst( 201: 400) = (/ 'iira48 ', 'iira49 ', & + 'iira5 ', 'iira50 ', & + 'iira51 ', 'iira52 ', & + 'iira53 ', 'iira54 ', & + 'iira55 ', 'iira56 ', & + 'iira57 ', 'iira58 ', & + 'iira59 ', 'iira6 ', & + 'iira60 ', 'iira61 ', & + 'iira62 ', 'iira63 ', & + 'iira64 ', 'iira65 ', & + 'iira66 ', 'iira67 ', & + 'iira68 ', 'iira69 ', & + 'iira7 ', 'iira70 ', & + 'iira71 ', 'iira72 ', & + 'iira73 ', 'iira74 ', & + 'iira75 ', 'iira76 ', & + 'iira77 ', 'iira78 ', & + 'iira79 ', 'iira8 ', & + 'iira80 ', 'iira81 ', & + 'iira82 ', 'iira83 ', & + 'iira84 ', 'iira85 ', & + 'iira86 ', 'iira87 ', & + 'iira88 ', 'iira89 ', & + 'iira9 ', 'iira90 ', & + 'iira91 ', 'iira92 ', & + 'iira93 ', 'iira94 ', & + 'iira95 ', 'iira96 ', & + 'iira97 ', 'iira98 ', & + 'iira99 ', 'iirb1 ', & + 'iirb10 ', 'iirb11 ', & + 'iirb12 ', 'iirb13 ', & + 'iirb14 ', 'iirb2 ', & + 'iirb3 ', 'iirb4 ', & + 'iirb5 ', 'iirb6 ', & + 'iirb7 ', 'iirb8 ', & + 'iirb9 ', 'nir1 ', & + 'nir10 ', 'nir11 ', & + 'nir12 ', 'nir13 ', & + 'nir2 ', 'nir3 ', & + 'nir4 ', 'nir5 ', & + 'nir6 ', 'nir7 ', & + 'nir8 ', 'nir9 ', & + 'NO2m_CL ', 'NO2m_CLO ', & + 'NO2m_H ', 'NO2m_H2O_M ', & + 'NO2m_HCL ', 'NO2m_HNO3 ', & + 'NO2m_NO2 ', 'NO2m_O3 ', & + 'NO3m2H2O_N2O5 ', 'NO3mH2O_H2O_M ', & + 'NO3mH2O_HNO3 ', 'NO3m_H2O_M ', & + 'NO3mH2O_N2O5 ', 'NO3m_HCLa ', & + 'NO3mHCL_HNO3 ', 'NO3m_HNO3_M ', & + 'NO3m_O ', 'NO3m_O3 ', & + 'NOp2H2O_e ', 'NOp3H2O_e ', & + 'NOp3H2O_H2O ', 'NOpCO2_e ', & + 'NOpCO2_H2O ', 'NOpH2O_e ', & + 'NOpH2O_H ', 'NOpH2O_HO2 ', & + 'NOpH2O_OH ', 'NOpN2_CO2 ', & + 'NOpN2_H2O ', 'O2m_CL ', & + 'O2m_CLO ', 'O2m_CO2_M ', & + 'O2m_H ', 'O2m_HCL ', & + 'O2m_HNO3 ', 'O2m_NO2 ', & + 'O2m_O21D ', 'O2m_O2_M ', & + 'O2m_O3 ', 'O2m_O_a ', & + 'O2m_O_b ', 'O2pH2O_e ', & + 'O2pH2O_H2Oa ', 'O2pH2O_H2Ob ', & + 'O2p_H2O_M ', 'O3m_CO2 ', & + 'O3m_H ', 'O3m_O3 ', & + 'O3m_O_a ', 'O3m_O_b ', & + 'O4m_CO2 ', 'O4m_O ', & + 'O4p_H2O ', 'O4p_O ', & + 'O4p_O21D ', 'OH_HONO ', & + 'OHm_CL ', 'OHm_CLO ', & + 'OHm_CO2 ', 'OHm_H ', & + 'OHm_HCL ', 'OHm_NO2 ', & + 'OHm_O ', 'OHm_O3 ', & + 'OH_NO_M ', 'Om_CL ', & + 'Om_CLO ', 'Om_CO2_M ', & + 'Om_H2_a ', 'Om_H2_b ', & + 'Om_H2O ', 'Om_HCL ', & + 'Om_HNO3 ', 'Om_M ', & + 'Om_NO2 ', 'Om_O ', & + 'Om_O21D ', 'Om_O2_M ', & + 'Om_O3 ', 'pir1 ', & + 'pir10 ', 'pir11 ', & + 'pir12 ', 'pir13 ', & + 'pir14 ', 'pir15 ', & + 'pir16 ', 'pir2 ', & + 'pir3 ', 'pir4 ', & + 'pir5 ', 'pir6 ', & + 'pir7 ', 'pir8 ', & + 'pir9 ', 'rpe1 ', & + 'rpe2 ', 'rpe3 ', & + 'rpe4 ', 'rpe5 ', & + 'usr_CLm_H2O_M ', 'usr_CLm_HCL_M ', & + 'ag1 ', 'ag2 ', & + 'O1D_H2 ', 'O1D_H2O ', & + 'O1D_N2 ', 'O1D_O2 ', & + 'O1D_O2b ', 'O1D_O3 ', & + 'O2_1D_N2 ', 'O2_1D_O ', & + 'O2_1D_O2 ', 'O2_1S_CO2 ', & + 'O2_1S_N2 ', 'O2_1S_O ' /) + rxt_tag_lst( 401: 600) = (/ 'O2_1S_O2 ', 'O2_1S_O3 ', & + '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 ', 'N2D_O ', & + 'N2D_O2 ', '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 ', & + 'F_CH4 ', 'F_H2 ', & + 'F_H2O ', 'F_HNO3 ', & + 'O1D_COF2 ', 'O1D_COFCL ', & + 'CH2BR2_CL ', 'CH2BR2_OH ', & + 'CH3BR_CL ', 'CH3BR_OH ', & + 'CH3CCL3_OH ', 'CH3CL_CL ', & + 'CH3CL_OH ', '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_HO2 ', 'CH3O2_NO ', & + 'CH3OOH_OH ', 'CH4_OH ', & + 'O1D_CH4a ', 'O1D_CH4b ', & + 'O1D_CH4c ', 'usr_CO_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 ', 'usr_HO2_aer ', & + 'usr_N2O5_aer ', 'usr_NO2_aer ', & + 'usr_NO3_aer ', 'het1 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ', & + 'het8 ', 'het9 ', & + 'ag247nm ', 'ag373nm ', & + 'ag732nm ', 'elec1 ', & + 'elec2 ', 'elec3 ', & + 'ion_N2p_O2 ', 'ion_N2p_Oa ', & + 'ion_N2p_Ob ', 'ion_Np_O ', & + 'ion_Np_O2a ', 'ion_Np_O2b ', & + 'ion_O2p_N ', 'ion_O2p_N2 ', & + 'ion_O2p_NO ', 'ion_Op_CO2 ', & + 'ion_Op_N2 ', 'ion_Op_N2D ', & + 'ion_Op_O2 ', 'Op2D_e ', & + 'Op2D_N2 ', 'Op2D_O ' /) + rxt_tag_lst( 601: 606) = (/ 'Op2D_O2 ', 'Op2P_ea ', & + 'Op2P_eb ', 'Op2P_N2a ', & + 'Op2P_N2b ', 'Op2P_O ' /) + 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, 364, 365, 366, 367, 368, 369, 370, & + 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, & + 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, & + 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, & + 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, & + 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, & + 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, & + 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, & + 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, & + 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, & + 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, & + 471, 472, 473, 474, 475, 476, 477, 478, 479, 480, & + 481, 482, 483, 484, 485, 486, 487, 488, 489, 490, & + 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, & + 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, & + 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, & + 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, & + 531, 532, 533, 534, 535, 536, 537, 538, 539, 540, & + 541, 542, 543, 544, 545, 546, 547, 548, 549, 550, & + 551, 552, 553, 554, 555, 556, 557, 558, 559, 560, & + 561, 562, 563, 564, 565, 566, 567, 568, 569, 570, & + 571, 572, 573, 574, 575, 576, 577, 578, 579, 580, & + 581, 582, 583, 584, 585, 586, 587, 588, 589, 590, & + 591, 592, 593, 594, 595, 596, 597, 598, 599, 600, & + 601, 602, 603, 604, 605, 606 /) + 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 ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', ' ', ' ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ' /) + 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, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 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, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._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(:) = (/ 391, 392, 393, 395, 396, & + 397, 399, 400, 401, 402, & + 403, 404, 405, 408, 411, & + 412, 413, 414, 417, 418, & + 419, 422, 424, 425, 426, & + 430, 431, 439, 440, 579, & + 580, 581, 582, 583, 584, & + 585, 586, 588, 589, 590, & + 591, 593, 595, 596, 597, & + 598, 599, 600, 601, 602, & + 603, 604, 605, 606 /) + cph_enthalpy(:) = (/ 189.810000_r8, 32.910000_r8, 189.810000_r8, 94.300000_r8, 94.300000_r8, & + 94.300000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, 62.600000_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, 229.610000_r8, 177.510000_r8, 313.750000_r8, & + 133.750000_r8, 193.020000_r8, 34.470000_r8, 199.170000_r8, 483.390000_r8, & + 321.300000_r8, 163.060000_r8, 82.389000_r8, 508.950000_r8, 354.830000_r8, & + 339.590000_r8, 67.530000_r8, 95.550000_r8, 239.840000_r8, 646.280000_r8, & + 406.160000_r8, 271.380000_r8, 105.040000_r8, 139.900000_r8, 150.110000_r8, & + 319.370000_r8, 128.320000_r8, 319.360000_r8, 469.400000_r8, 163.060000_r8, & + 482.430000_r8, 291.380000_r8, 67.540000_r8, 501.720000_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, 3, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 3, 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, 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, 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, 3, 3, 3, 3, 3, 3, & + 3, 3, 3, 3, 3, 3, 3, 2, 2, 2, & + 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 3, 2, 2, 2, 2, 2, 3, & + 2, 3, 2, 2, 2, 3, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 3, 2, 2, 2, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, & + 2, 2, 2, 2, 3, 2, 2, 3, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 3, 2, 3, & + 3, 3, 3, 3, 2, 3, 2, 3, 2, 3, & + 2, 3, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, & + 2, 2, 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, 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, 2, 2, 2, 2, 2, 2, 2, & + 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 1, 1, 1, 1, 1, 2, 1, & + 1, 1, 1, 2, 2, 2, 1, 1, 2, 2, & + 2, 1, 1, 2, 1, 1, 1, 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 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_sc_mam4/chem_mech.doc b/src/chemistry/pp_waccm_sc_mam4/chem_mech.doc index da0749a30d..a6828c0e6e 100644 --- a/src/chemistry/pp_waccm_sc_mam4/chem_mech.doc +++ b/src/chemistry/pp_waccm_sc_mam4/chem_mech.doc @@ -1,45 +1,46 @@ Solution species - ( 1) CH4 - ( 2) N2O + ( 1) bc_a1 (C) + ( 2) bc_a4 (C) ( 3) CFC11 (CFCl3) ( 4) CFC12 (CF2Cl2) - ( 5) H2O2 - ( 6) H2SO4 - ( 7) SO2 - ( 8) DMS (CH3SCH3) - ( 9) SOAG (C) - ( 10) so4_a1 (NH4HSO4) - ( 11) pom_a1 (C) - ( 12) soa_a1 (C) - ( 13) bc_a1 (C) - ( 14) dst_a1 (AlSiO5) - ( 15) ncl_a1 (NaCl) + ( 5) CH4 + ( 6) DMS (CH3SCH3) + ( 7) dst_a1 (AlSiO5) + ( 8) dst_a2 (AlSiO5) + ( 9) dst_a3 (AlSiO5) + ( 10) H2O2 + ( 11) H2SO4 + ( 12) N2O + ( 13) ncl_a1 (NaCl) + ( 14) ncl_a2 (NaCl) + ( 15) ncl_a3 (NaCl) ( 16) num_a1 (H) - ( 17) so4_a2 (NH4HSO4) - ( 18) soa_a2 (C) - ( 19) ncl_a2 (NaCl) - ( 20) num_a2 (H) - ( 21) dst_a2 (AlSiO5) - ( 22) dst_a3 (AlSiO5) - ( 23) ncl_a3 (NaCl) - ( 24) so4_a3 (NH4HSO4) - ( 25) num_a3 (H) - ( 26) pom_a4 (C) - ( 27) bc_a4 (C) - ( 28) num_a4 (H) - ( 29) H2O + ( 17) num_a2 (H) + ( 18) num_a3 (H) + ( 19) num_a4 (H) + ( 20) pom_a1 (C) + ( 21) pom_a4 (C) + ( 22) SO2 + ( 23) so4_a1 (NH4HSO4) + ( 24) so4_a2 (NH4HSO4) + ( 25) so4_a3 (NH4HSO4) + ( 26) soa_a1 (C) + ( 27) soa_a2 (C) + ( 28) SOAE (C) + ( 29) SOAG (C) + ( 30) H2O Invariant species ( 1) M - ( 2) N2 - ( 3) O2 - ( 4) O3 + ( 2) O2 + ( 3) N2 + ( 4) HO2 ( 5) OH ( 6) NO3 - ( 7) HO2 + ( 7) O3 ( 8) HALONS @@ -52,97 +53,104 @@ Class List Implicit -------- - ( 1) CH4 - ( 2) N2O + ( 1) bc_a1 + ( 2) bc_a4 ( 3) CFC11 ( 4) CFC12 - ( 5) H2O - ( 6) H2O2 - ( 7) H2SO4 - ( 8) SO2 - ( 9) DMS - ( 10) SOAG - ( 11) so4_a1 - ( 12) pom_a1 - ( 13) soa_a1 - ( 14) bc_a1 - ( 15) dst_a1 - ( 16) ncl_a1 - ( 17) num_a1 - ( 18) so4_a2 - ( 19) soa_a2 - ( 20) ncl_a2 - ( 21) num_a2 - ( 22) dst_a2 - ( 23) dst_a3 - ( 24) ncl_a3 + ( 5) CH4 + ( 6) DMS + ( 7) dst_a1 + ( 8) dst_a2 + ( 9) dst_a3 + ( 10) H2O2 + ( 11) H2SO4 + ( 12) N2O + ( 13) ncl_a1 + ( 14) ncl_a2 + ( 15) ncl_a3 + ( 16) num_a1 + ( 17) num_a2 + ( 18) num_a3 + ( 19) num_a4 + ( 20) pom_a1 + ( 21) pom_a4 + ( 22) SO2 + ( 23) so4_a1 + ( 24) so4_a2 ( 25) so4_a3 - ( 26) num_a3 - ( 27) pom_a4 - ( 28) bc_a4 - ( 29) num_a4 + ( 26) soa_a1 + ( 27) soa_a2 + ( 28) SOAE + ( 29) SOAG + ( 30) H2O Photolysis - jh2o2 ( 1) H2O2 + hv -> (No products) rate = ** User defined ** ( 1) + jh2o2 ( 1) H2O2 + hv -> 2*OH rate = ** User defined ** ( 1) + jsoa_a1 ( 2) soa_a1 + hv -> (No products) rate = ** User defined ** ( 2) + jsoa_a2 ( 3) soa_a2 + hv -> (No products) rate = ** User defined ** ( 3) Reactions - ch4_loss ( 1) CH4 -> 2.*H2O rate = ** User defined ** ( 2) - n2o_loss ( 2) N2O -> (No products) rate = ** User defined ** ( 3) - cfc11_loss ( 3) CFC11 -> (No products) rate = ** User defined ** ( 4) - cfc12_loss ( 4) CFC12 -> (No products) rate = ** User defined ** ( 5) - lyman_alpha ( 5) H2O -> (No products) rate = ** User defined ** ( 6) - usr_HO2_HO2 ( 6) HO2 + HO2 -> H2O2 rate = ** User defined ** ( 7) - ( 7) H2O2 + OH -> H2O + HO2 rate = 2.90E-12*exp( -160./t) ( 8) - usr_SO2_OH ( 8) SO2 + OH -> H2SO4 rate = ** User defined ** ( 9) - ( 9) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) ( 10) - usr_DMS_OH ( 10) DMS + OH -> .5*SO2 + .5*HO2 rate = ** User defined ** ( 11) - ( 11) DMS + NO3 -> SO2 + {HNO3} rate = 1.90E-13*exp( 520./t) ( 12) + lyman_alpha ( 1) H2O -> (No products) rate = ** User defined ** ( 4) + OH_H2O2 ( 2) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 ( 5) + usr_HO2_HO2 ( 3) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** ( 6) + n2o_loss ( 4) N2O -> (No products) rate = ** User defined ** ( 7) + cfc11_loss ( 5) CFC11 -> (No products) rate = ** User defined ** ( 8) + cfc12_loss ( 6) CFC12 -> (No products) rate = ** User defined ** ( 9) + ch4_loss ( 7) CH4 -> 2*H2O rate = ** User defined ** ( 10) + DMS_NO3 ( 8) DMS + NO3 -> SO2 + {HNO3} rate = 1.90E-13*exp( 520./t) ( 11) + DMS_OHa ( 9) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) ( 12) + SO2_OH_M ( 10) SO2 + OH + M -> H2SO4 troe : ko=2.90E-31*(300/t)**4.10 ( 13) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + usr_DMS_OH ( 11) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** ( 14) + SOAE_tau ( 12) SOAE -> SOAG rate = 1.16E-05 ( 15) Extraneous prod/loss species - ( 1) SO2 (dataset) - ( 2) so4_a1 (dataset) - ( 3) so4_a2 (dataset) - ( 4) pom_a1 (dataset) - ( 5) pom_a4 (dataset) - ( 6) bc_a1 (dataset) - ( 7) bc_a4 (dataset) - ( 8) num_a1 (dataset) - ( 9) num_a2 (dataset) - (10) num_a4 (dataset) - (11) H2O (dataset) + ( 1) bc_a1 (dataset) + ( 2) bc_a4 (dataset) + ( 3) H2O (dataset) + ( 4) num_a1 (dataset) + ( 5) num_a2 (dataset) + ( 6) num_a4 (dataset) + ( 7) pom_a1 (dataset) + ( 8) pom_a4 (dataset) + ( 9) SO2 (dataset) + (10) so4_a1 (dataset) + (11) so4_a2 (dataset) Equation Report - d(CH4)/dt = - r1*CH4 - d(N2O)/dt = - r2*N2O - d(CFC11)/dt = - r3*CFC11 - d(CFC12)/dt = - r4*CFC12 - d(H2O2)/dt = r6 - - j1*H2O2 - r7*OH*H2O2 - d(H2SO4)/dt = r8*OH*SO2 - d(SO2)/dt = r9*OH*DMS + .5*r10*OH*DMS + r11*NO3*DMS - - r8*OH*SO2 - d(DMS)/dt = - r9*OH*DMS - r10*OH*DMS - r11*NO3*DMS - d(SOAG)/dt = 0 - d(so4_a1)/dt = 0 - d(pom_a1)/dt = 0 - d(soa_a1)/dt = 0 d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(CFC11)/dt = - r5*CFC11 + d(CFC12)/dt = - r6*CFC12 + d(CH4)/dt = - r7*CH4 + d(DMS)/dt = - r8*NO3*DMS - r9*OH*DMS - r11*OH*DMS d(dst_a1)/dt = 0 - d(ncl_a1)/dt = 0 - d(num_a1)/dt = 0 - d(so4_a2)/dt = 0 - d(soa_a2)/dt = 0 - d(ncl_a2)/dt = 0 - d(num_a2)/dt = 0 d(dst_a2)/dt = 0 d(dst_a3)/dt = 0 + d(H2O2)/dt = r3 + - j1*H2O2 - r2*OH*H2O2 + d(H2SO4)/dt = r10*OH*M*SO2 + d(N2O)/dt = - r4*N2O + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 d(ncl_a3)/dt = 0 - d(so4_a3)/dt = 0 + d(num_a1)/dt = 0 + d(num_a2)/dt = 0 d(num_a3)/dt = 0 - d(pom_a4)/dt = 0 - d(bc_a4)/dt = 0 d(num_a4)/dt = 0 - d(H2O)/dt = 2*r1*CH4 + r7*OH*H2O2 - - r5*H2O + d(pom_a1)/dt = 0 + d(pom_a4)/dt = 0 + d(SO2)/dt = r8*NO3*DMS + r9*OH*DMS + .5*r11*OH*DMS + - r10*OH*M*SO2 + d(so4_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(so4_a3)/dt = 0 + d(soa_a1)/dt = - j2*soa_a1 + d(soa_a2)/dt = - j3*soa_a2 + d(SOAE)/dt = - r12*SOAE + d(SOAG)/dt = r12*SOAE + d(H2O)/dt = r2*OH*H2O2 + 2*r7*CH4 + - r1*H2O diff --git a/src/chemistry/pp_waccm_sc_mam4/chem_mech.in b/src/chemistry/pp_waccm_sc_mam4/chem_mech.in index 927087dff1..07c05ff57c 100644 --- a/src/chemistry/pp_waccm_sc_mam4/chem_mech.in +++ b/src/chemistry/pp_waccm_sc_mam4/chem_mech.in @@ -1,27 +1,51 @@ +* Comments +* User-given Tag Description: WACCM_SC_MAM4 +* Tag database identifier : MZ312_WACCM_SC_MAM4_20221214 +* Tag created by : lke +* Tag created from branch : WACCM_SC_MAM4 +* Tag created on : 2022-12-14 15:17:17.723566-07 +* Comments for this tag follow: +* lke : 2022-12-14 : Specified chemistry (SC) WACCM mechanism, with updated simple SOA. SPECIES Solution - CH4, N2O, CFC11 -> CFCl3, CFC12 -> CF2Cl2 - H2O2, H2SO4, SO2, DMS -> CH3SCH3, SOAG -> C - so4_a1 -> NH4HSO4 - pom_a1 -> C, soa_a1 -> C, bc_a1 -> C - dst_a1 -> AlSiO5, ncl_a1 -> NaCl - num_a1 -> H - so4_a2 -> NH4HSO4 - soa_a2 -> C, ncl_a2 -> NaCl - num_a2 -> H - dst_a2 -> AlSiO5 - dst_a3 -> AlSiO5, ncl_a3 -> NaCl - so4_a3 -> NH4HSO4 - num_a3 -> H - pom_a4 -> C, bc_a4 -> C - num_a4 -> H - H2O + bc_a1 -> C, + bc_a4 -> C, + CFC11 -> CFCl3, + CFC12 -> CF2Cl2, + CH4, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + H2O2, + H2SO4, + N2O, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + num_a1 -> H, + num_a2 -> H, + num_a3 -> H, + num_a4 -> H, + pom_a1 -> C, + pom_a4 -> C, + SO2, + so4_a1 -> NH4HSO4, + so4_a2 -> NH4HSO4, + so4_a3 -> NH4HSO4, + soa_a1 -> C, + soa_a2 -> C, + SOAE -> C, + SOAG -> C, + H2O + End Solution + Fixed - M, N2, O2, O3, OH, NO3, HO2, HALONS->CFCl3 + M, O2, N2, HO2, OH, NO3, O3, HALONS->CFCl3 End Fixed Col-int @@ -29,62 +53,119 @@ O2 = 0. End Col-int - End SPECIES + Not-Transported + + End Not-Transported + + END Species + - Solution Classes + Solution classes Explicit + End Explicit + Implicit - CH4, N2O, CFC11, CFC12, H2O - H2O2, H2SO4, SO2, DMS, SOAG - so4_a1, pom_a1 - soa_a1, bc_a1, dst_a1, ncl_a1 - num_a1 - so4_a2, soa_a2, ncl_a2, num_a2 - dst_a2 - dst_a3, ncl_a3, so4_a3, num_a3 - pom_a4, bc_a4, num_a4 + bc_a1 + bc_a4 + CFC11 + CFC12 + CH4 + DMS + dst_a1 + dst_a2 + dst_a3 + H2O2 + H2SO4 + N2O + ncl_a1 + ncl_a2 + ncl_a3 + num_a1 + num_a2 + num_a3 + num_a4 + pom_a1 + pom_a4 + SO2 + so4_a1 + so4_a2 + so4_a3 + soa_a1 + soa_a2 + SOAE + SOAG + H2O End Implicit - End Solution Classes + + End Solution classes + CHEMISTRY Photolysis - [jh2o2] H2O2 + hv -> +********************************* +*** odd-oxygen +********************************* +[jh2o2] H2O2 + hv -> 2*OH +********************************* +*** soa +********************************* +[jsoa_a1->,.0004*jno2] soa_a1 + hv -> +[jsoa_a2->,.0004*jno2] soa_a2 + hv -> End Photolysis Reactions - [ch4_loss] CH4 -> 2.* H2O - [n2o_loss] N2O -> - [cfc11_loss] CFC11 -> - [cfc12_loss] CFC12 -> - [lyman_alpha] H2O -> - [usr_HO2_HO2] HO2 + HO2 -> H2O2 - H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 - [usr_SO2_OH] SO2 + OH -> H2SO4 - DMS + OH -> SO2 ; 9.6e-12, -234. - [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 - DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. +********************************* +*** odd-hydrogen +********************************* +[lyman_alpha] H2O -> +[OH_H2O2] OH + H2O2 -> H2O + HO2 ; 1.8e-12 +[usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2 +********************************* +*** odd-nitrogen +********************************* +[n2o_loss] N2O -> +********************************* +*** odd-chlorine +********************************* +[cfc11_loss] CFC11 -> +[cfc12_loss] CFC12 -> +********************************* +*** C1 +********************************* +[ch4_loss] CH4 -> 2*H2O +********************************* +*** Sulfur +********************************* +[DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 +[DMS_OHa] DMS + OH -> SO2 ; 1.1e-11, -280 +[SO2_OH_M] SO2 + OH + M -> H2SO4 ; 2.9e-31, 4.1, 1.7e-12, -0.2, 0.6 +[usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 +********************************* +*** SOA +********************************* +[SOAE_tau] SOAE -> SOAG ; 1.157e-05 End Reactions Ext Forcing - SO2 <- dataset - so4_a1 <- dataset - so4_a2 <- dataset - pom_a1 <- dataset - pom_a4 <- dataset - bc_a1 <- dataset - bc_a4 <- dataset - num_a1 <- dataset - num_a2 <- dataset - num_a4 <- dataset - H2O <- dataset + bc_a1 <- dataset + bc_a4 <- dataset + H2O <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset + pom_a1 <- dataset + pom_a4 <- dataset + SO2 <- dataset + so4_a1 <- dataset + so4_a2 <- dataset End Ext Forcing - END CHEMISTRY + End Chemistry - SIMULATION PARAMETERS +SIMULATION PARAMETERS - Version Options + Version Options model = cam machine = intel architecture = hybrid @@ -92,7 +173,6 @@ multitask = on namemod = on modules = on - End Version Options - - END SIMULATION PARAMETERS + End Version Options +End Simulation Parameters diff --git a/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 index f75b1c9a8a..4792d4818c 100644 --- a/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/chem_mods.F90 @@ -5,25 +5,25 @@ module chem_mods use shr_kind_mod, only : r8 => shr_kind_r8 implicit none save - integer, parameter :: phtcnt = 1, & ! number of photolysis reactions - rxntot = 12, & ! number of total reactions - gascnt = 11, & ! number of gas phase reactions + integer, parameter :: phtcnt = 3, & ! number of photolysis reactions + rxntot = 15, & ! number of total reactions + gascnt = 12, & ! number of gas phase reactions nabscol = 2, & ! number of absorbing column densities - gas_pcnst = 29, & ! number of "gas phase" species + gas_pcnst = 30, & ! number of "gas phase" species nfs = 8, & ! number of "fixed" species relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members - nzcnt = 33, & ! number of non-zero matrix entries + nzcnt = 35, & ! number of non-zero matrix entries extcnt = 11, & ! number of species with external forcing clscnt1 = 0, & ! number of species in explicit class clscnt2 = 0, & ! number of species in hov class clscnt3 = 0, & ! number of species in ebi class - clscnt4 = 29, & ! number of species in implicit class + clscnt4 = 30, & ! 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 = 9, & + rxt_tag_cnt = 15, & enthalpy_cnt = 0, & nslvd = 0 integer :: clscnt(5) = 0 diff --git a/src/chemistry/pp_waccm_sc_mam4/m_rxt_id.F90 b/src/chemistry/pp_waccm_sc_mam4/m_rxt_id.F90 index d1114dd177..2c6a0ed8db 100644 --- a/src/chemistry/pp_waccm_sc_mam4/m_rxt_id.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/m_rxt_id.F90 @@ -1,15 +1,18 @@ module m_rxt_id implicit none integer, parameter :: rid_jh2o2 = 1 - integer, parameter :: rid_ch4_loss = 2 - integer, parameter :: rid_n2o_loss = 3 - integer, parameter :: rid_cfc11_loss = 4 - integer, parameter :: rid_cfc12_loss = 5 - integer, parameter :: rid_lyman_alpha = 6 - integer, parameter :: rid_usr_HO2_HO2 = 7 - integer, parameter :: rid_usr_SO2_OH = 9 - integer, parameter :: rid_usr_DMS_OH = 11 - integer, parameter :: rid_r0008 = 8 - integer, parameter :: rid_r0010 = 10 - integer, parameter :: rid_r0012 = 12 + integer, parameter :: rid_jsoa_a1 = 2 + integer, parameter :: rid_jsoa_a2 = 3 + integer, parameter :: rid_lyman_alpha = 4 + integer, parameter :: rid_OH_H2O2 = 5 + integer, parameter :: rid_usr_HO2_HO2 = 6 + integer, parameter :: rid_n2o_loss = 7 + integer, parameter :: rid_cfc11_loss = 8 + integer, parameter :: rid_cfc12_loss = 9 + integer, parameter :: rid_ch4_loss = 10 + integer, parameter :: rid_DMS_NO3 = 11 + integer, parameter :: rid_DMS_OHa = 12 + integer, parameter :: rid_SO2_OH_M = 13 + integer, parameter :: rid_usr_DMS_OH = 14 + integer, parameter :: rid_SOAE_tau = 15 end module m_rxt_id diff --git a/src/chemistry/pp_waccm_sc_mam4/m_spc_id.F90 b/src/chemistry/pp_waccm_sc_mam4/m_spc_id.F90 index 091e8d3969..345eebcbc4 100644 --- a/src/chemistry/pp_waccm_sc_mam4/m_spc_id.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/m_spc_id.F90 @@ -1,32 +1,33 @@ module m_spc_id implicit none - integer, parameter :: id_CH4 = 1 - integer, parameter :: id_N2O = 2 + integer, parameter :: id_bc_a1 = 1 + integer, parameter :: id_bc_a4 = 2 integer, parameter :: id_CFC11 = 3 integer, parameter :: id_CFC12 = 4 - integer, parameter :: id_H2O2 = 5 - integer, parameter :: id_H2SO4 = 6 - integer, parameter :: id_SO2 = 7 - integer, parameter :: id_DMS = 8 - integer, parameter :: id_SOAG = 9 - integer, parameter :: id_so4_a1 = 10 - integer, parameter :: id_pom_a1 = 11 - integer, parameter :: id_soa_a1 = 12 - integer, parameter :: id_bc_a1 = 13 - integer, parameter :: id_dst_a1 = 14 - integer, parameter :: id_ncl_a1 = 15 + integer, parameter :: id_CH4 = 5 + integer, parameter :: id_DMS = 6 + integer, parameter :: id_dst_a1 = 7 + integer, parameter :: id_dst_a2 = 8 + integer, parameter :: id_dst_a3 = 9 + integer, parameter :: id_H2O2 = 10 + integer, parameter :: id_H2SO4 = 11 + integer, parameter :: id_N2O = 12 + integer, parameter :: id_ncl_a1 = 13 + integer, parameter :: id_ncl_a2 = 14 + integer, parameter :: id_ncl_a3 = 15 integer, parameter :: id_num_a1 = 16 - integer, parameter :: id_so4_a2 = 17 - integer, parameter :: id_soa_a2 = 18 - integer, parameter :: id_ncl_a2 = 19 - integer, parameter :: id_num_a2 = 20 - integer, parameter :: id_dst_a2 = 21 - integer, parameter :: id_dst_a3 = 22 - integer, parameter :: id_ncl_a3 = 23 - integer, parameter :: id_so4_a3 = 24 - integer, parameter :: id_num_a3 = 25 - integer, parameter :: id_pom_a4 = 26 - integer, parameter :: id_bc_a4 = 27 - integer, parameter :: id_num_a4 = 28 - integer, parameter :: id_H2O = 29 + integer, parameter :: id_num_a2 = 17 + integer, parameter :: id_num_a3 = 18 + integer, parameter :: id_num_a4 = 19 + integer, parameter :: id_pom_a1 = 20 + integer, parameter :: id_pom_a4 = 21 + integer, parameter :: id_SO2 = 22 + integer, parameter :: id_so4_a1 = 23 + integer, parameter :: id_so4_a2 = 24 + integer, parameter :: id_so4_a3 = 25 + integer, parameter :: id_soa_a1 = 26 + integer, parameter :: id_soa_a2 = 27 + integer, parameter :: id_SOAE = 28 + integer, parameter :: id_SOAG = 29 + integer, parameter :: id_H2O = 30 end module m_spc_id diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_adjrxt.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_adjrxt.F90 index e1c3fe9281..09ad314f66 100644 --- a/src/chemistry/pp_waccm_sc_mam4/mo_adjrxt.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/mo_adjrxt.F90 @@ -18,11 +18,11 @@ subroutine adjrxt( rate, inv, m, ncol, nlev ) !-------------------------------------------------------------------- real(r8) :: im(ncol,nlev) im(:,:) = 1._r8 / m(:,:) - rate(:,:, 8) = rate(:,:, 8) * inv(:,:, 5) - rate(:,:, 9) = rate(:,:, 9) * inv(:,:, 5) - rate(:,:, 10) = rate(:,:, 10) * inv(:,:, 5) - rate(:,:, 11) = rate(:,:, 11) * inv(:,:, 5) - rate(:,:, 12) = rate(:,:, 12) * inv(:,:, 6) - rate(:,:, 7) = rate(:,:, 7) * inv(:,:, 7) * inv(:,:, 7) * im(:,:) + rate(:,:, 5) = rate(:,:, 5) * inv(:,:, 5) + rate(:,:, 11) = rate(:,:, 11) * inv(:,:, 6) + rate(:,:, 12) = rate(:,:, 12) * inv(:,:, 5) + rate(:,:, 14) = rate(:,:, 14) * inv(:,:, 5) + rate(:,:, 6) = rate(:,:, 6) * inv(:,:, 4) * inv(:,:, 4) * im(:,:) + rate(:,:, 13) = rate(:,:, 13) * inv(:,:, 5) * inv(:,:, 1) end subroutine adjrxt end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_indprd.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_indprd.F90 index 9a8ee552e7..2665cc9fbd 100644 --- a/src/chemistry/pp_waccm_sc_mam4/mo_indprd.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/mo_indprd.F90 @@ -21,35 +21,36 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol ) ! ... "independent" production for Implicit species !-------------------------------------------------------------------- if( class == 4 ) then - prod(:,:,1) = 0._r8 - prod(:,:,2) = 0._r8 + prod(:,:,1) = + extfrc(:,:,1) + prod(:,:,2) = + extfrc(:,:,2) prod(:,:,3) = 0._r8 prod(:,:,4) = 0._r8 - prod(:,:,5) = + extfrc(:,:,11) - prod(:,:,6) =rxt(:,:,7) + prod(:,:,5) = 0._r8 + prod(:,:,6) = 0._r8 prod(:,:,7) = 0._r8 - prod(:,:,8) = + extfrc(:,:,1) + prod(:,:,8) = 0._r8 prod(:,:,9) = 0._r8 - prod(:,:,10) = 0._r8 - prod(:,:,11) = + extfrc(:,:,2) - prod(:,:,12) = + extfrc(:,:,4) + prod(:,:,10) =rxt(:,:,6) + prod(:,:,11) = 0._r8 + prod(:,:,12) = 0._r8 prod(:,:,13) = 0._r8 - prod(:,:,14) = + extfrc(:,:,6) + prod(:,:,14) = 0._r8 prod(:,:,15) = 0._r8 - prod(:,:,16) = 0._r8 - prod(:,:,17) = + extfrc(:,:,8) - prod(:,:,18) = + extfrc(:,:,3) - prod(:,:,19) = 0._r8 - prod(:,:,20) = 0._r8 - prod(:,:,21) = + extfrc(:,:,9) - prod(:,:,22) = 0._r8 - prod(:,:,23) = 0._r8 - prod(:,:,24) = 0._r8 + prod(:,:,16) = + extfrc(:,:,4) + prod(:,:,17) = + extfrc(:,:,5) + prod(:,:,18) = 0._r8 + prod(:,:,19) = + extfrc(:,:,6) + prod(:,:,20) = + extfrc(:,:,7) + prod(:,:,21) = + extfrc(:,:,8) + prod(:,:,22) = + extfrc(:,:,9) + prod(:,:,23) = + extfrc(:,:,10) + prod(:,:,24) = + extfrc(:,:,11) prod(:,:,25) = 0._r8 prod(:,:,26) = 0._r8 - prod(:,:,27) = + extfrc(:,:,5) - prod(:,:,28) = + extfrc(:,:,7) - prod(:,:,29) = + extfrc(:,:,10) + prod(:,:,27) = 0._r8 + prod(:,:,28) = 0._r8 + prod(:,:,29) = 0._r8 + prod(:,:,30) = + extfrc(:,:,3) end if end subroutine indprd end module mo_indprd diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_lin_matrix.F90 index e42386a02a..a048b0dc3e 100644 --- a/src/chemistry/pp_waccm_sc_mam4/mo_lin_matrix.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/mo_lin_matrix.F90 @@ -16,39 +16,41 @@ subroutine linmat01( mat, y, rxt, het_rates ) real(r8), intent(in) :: rxt(rxntot) real(r8), intent(in) :: het_rates(max(1,gas_pcnst)) real(r8), intent(inout) :: mat(nzcnt) - mat(1) = -( rxt(2) + het_rates(1) ) - mat(3) = -( rxt(3) + het_rates(2) ) - mat(4) = -( rxt(4) + het_rates(3) ) - mat(5) = -( rxt(5) + het_rates(4) ) - mat(6) = -( rxt(6) + het_rates(29) ) - mat(2) = 2.000_r8*rxt(2) - mat(7) = rxt(8) - mat(8) = -( rxt(1) + rxt(8) + het_rates(5) ) - mat(9) = -( het_rates(6) ) - mat(10) = rxt(9) - mat(11) = -( rxt(9) + het_rates(7) ) - mat(12) = rxt(10) + .500_r8*rxt(11) + rxt(12) - mat(13) = -( rxt(10) + rxt(11) + rxt(12) + het_rates(8) ) - mat(14) = -( het_rates(9) ) - mat(15) = -( het_rates(10) ) - mat(16) = -( het_rates(11) ) - mat(17) = -( het_rates(12) ) - mat(18) = -( het_rates(13) ) - mat(19) = -( het_rates(14) ) - mat(20) = -( het_rates(15) ) - mat(21) = -( het_rates(16) ) - mat(22) = -( het_rates(17) ) - mat(23) = -( het_rates(18) ) - mat(24) = -( het_rates(19) ) - mat(25) = -( het_rates(20) ) - mat(26) = -( het_rates(21) ) - mat(27) = -( het_rates(22) ) - mat(28) = -( het_rates(23) ) - mat(29) = -( het_rates(24) ) - mat(30) = -( het_rates(25) ) - mat(31) = -( het_rates(26) ) - mat(32) = -( het_rates(27) ) - mat(33) = -( het_rates(28) ) + mat(1) = -( het_rates(1) ) + mat(2) = -( het_rates(2) ) + mat(3) = -( rxt(8) + het_rates(3) ) + mat(4) = -( rxt(9) + het_rates(4) ) + mat(5) = -( rxt(10) + het_rates(5) ) + mat(7) = -( rxt(11) + rxt(12) + rxt(14) + het_rates(6) ) + mat(9) = -( het_rates(7) ) + mat(10) = -( het_rates(8) ) + mat(11) = -( het_rates(9) ) + mat(12) = -( rxt(1) + rxt(5) + het_rates(10) ) + mat(14) = -( het_rates(11) ) + mat(25) = rxt(13) + mat(15) = -( rxt(7) + het_rates(12) ) + mat(16) = -( het_rates(13) ) + mat(17) = -( het_rates(14) ) + mat(18) = -( het_rates(15) ) + mat(19) = -( het_rates(16) ) + mat(20) = -( het_rates(17) ) + mat(21) = -( het_rates(18) ) + mat(22) = -( het_rates(19) ) + mat(23) = -( het_rates(20) ) + mat(24) = -( het_rates(21) ) + mat(26) = -( rxt(13) + het_rates(22) ) + mat(8) = rxt(11) + rxt(12) + .500_r8*rxt(14) + mat(27) = -( het_rates(23) ) + mat(28) = -( het_rates(24) ) + mat(29) = -( het_rates(25) ) + mat(30) = -( rxt(2) + het_rates(26) ) + mat(31) = -( rxt(3) + het_rates(27) ) + mat(32) = -( rxt(15) + het_rates(28) ) + mat(34) = -( het_rates(29) ) + mat(33) = rxt(15) + mat(35) = -( rxt(4) + het_rates(30) ) + mat(13) = rxt(5) + mat(6) = 2.000_r8*rxt(10) end subroutine linmat01 subroutine linmat( mat, y, rxt, het_rates ) !---------------------------------------------- diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_lu_factor.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_lu_factor.F90 index 555ac57311..d981e77137 100644 --- a/src/chemistry/pp_waccm_sc_mam4/mo_lu_factor.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/mo_lu_factor.F90 @@ -10,15 +10,18 @@ subroutine lu_fac01( lu ) !----------------------------------------------------------------------- real(r8), intent(inout) :: lu(:) lu(1) = 1._r8 / lu(1) - lu(2) = lu(2) * lu(1) + lu(2) = 1._r8 / lu(2) lu(3) = 1._r8 / lu(3) lu(4) = 1._r8 / lu(4) lu(5) = 1._r8 / lu(5) - lu(6) = 1._r8 / lu(6) - lu(8) = 1._r8 / lu(8) + lu(6) = lu(6) * lu(5) + lu(7) = 1._r8 / lu(7) + lu(8) = lu(8) * lu(7) lu(9) = 1._r8 / lu(9) + lu(10) = 1._r8 / lu(10) lu(11) = 1._r8 / lu(11) - lu(13) = 1._r8 / lu(13) + lu(12) = 1._r8 / lu(12) + lu(13) = lu(13) * lu(12) lu(14) = 1._r8 / lu(14) lu(15) = 1._r8 / lu(15) lu(16) = 1._r8 / lu(16) @@ -30,7 +33,6 @@ subroutine lu_fac01( lu ) lu(22) = 1._r8 / lu(22) lu(23) = 1._r8 / lu(23) lu(24) = 1._r8 / lu(24) - lu(25) = 1._r8 / lu(25) lu(26) = 1._r8 / lu(26) lu(27) = 1._r8 / lu(27) lu(28) = 1._r8 / lu(28) @@ -38,7 +40,9 @@ subroutine lu_fac01( lu ) lu(30) = 1._r8 / lu(30) lu(31) = 1._r8 / lu(31) lu(32) = 1._r8 / lu(32) - lu(33) = 1._r8 / lu(33) + lu(33) = lu(33) * lu(32) + lu(34) = 1._r8 / lu(34) + lu(35) = 1._r8 / lu(35) end subroutine lu_fac01 subroutine lu_fac( lu ) use shr_kind_mod, only : r8 => shr_kind_r8 diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_lu_solve.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_lu_solve.F90 index cc7266ce23..574861e9b1 100644 --- a/src/chemistry/pp_waccm_sc_mam4/mo_lu_solve.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/mo_lu_solve.F90 @@ -17,7 +17,10 @@ subroutine lu_slv01( lu, b ) !----------------------------------------------------------------------- ! ... solve L * y = b !----------------------------------------------------------------------- - b(5) = b(5) - lu(2) * b(1) + b(30) = b(30) - lu(6) * b(5) + b(22) = b(22) - lu(8) * b(6) + b(30) = b(30) - lu(13) * b(10) + b(29) = b(29) - lu(33) * b(28) end subroutine lu_slv01 subroutine lu_slv02( lu, b ) use shr_kind_mod, only : r8 => shr_kind_r8 @@ -37,7 +40,8 @@ subroutine lu_slv02( lu, b ) !----------------------------------------------------------------------- ! ... Solve U * x = y !----------------------------------------------------------------------- - b(29) = b(29) * lu(33) + b(30) = b(30) * lu(35) + b(29) = b(29) * lu(34) b(28) = b(28) * lu(32) b(27) = b(27) * lu(31) b(26) = b(26) * lu(30) @@ -45,29 +49,27 @@ subroutine lu_slv02( lu, b ) b(24) = b(24) * lu(28) b(23) = b(23) * lu(27) b(22) = b(22) * lu(26) - b(21) = b(21) * lu(25) - b(20) = b(20) * lu(24) - b(19) = b(19) * lu(23) - b(18) = b(18) * lu(22) - b(17) = b(17) * lu(21) - b(16) = b(16) * lu(20) - b(15) = b(15) * lu(19) - b(14) = b(14) * lu(18) - b(13) = b(13) * lu(17) - b(12) = b(12) * lu(16) - b(11) = b(11) * lu(15) - b(10) = b(10) * lu(14) - b(9) = b(9) * lu(13) - b(8) = b(8) - lu(12) * b(9) - b(8) = b(8) * lu(11) - b(7) = b(7) - lu(10) * b(8) + b(11) = b(11) - lu(25) * b(22) + b(21) = b(21) * lu(24) + b(20) = b(20) * lu(23) + b(19) = b(19) * lu(22) + b(18) = b(18) * lu(21) + b(17) = b(17) * lu(20) + b(16) = b(16) * lu(19) + b(15) = b(15) * lu(18) + b(14) = b(14) * lu(17) + b(13) = b(13) * lu(16) + b(12) = b(12) * lu(15) + b(11) = b(11) * lu(14) + b(10) = b(10) * lu(12) + b(9) = b(9) * lu(11) + b(8) = b(8) * lu(10) b(7) = b(7) * lu(9) - b(6) = b(6) * lu(8) - b(5) = b(5) - lu(7) * b(6) - b(5) = b(5) * lu(6) - b(4) = b(4) * lu(5) - b(3) = b(3) * lu(4) - b(2) = b(2) * lu(3) + b(6) = b(6) * lu(7) + b(5) = b(5) * lu(5) + b(4) = b(4) * lu(4) + b(3) = b(3) * lu(3) + b(2) = b(2) * lu(2) b(1) = b(1) * lu(1) end subroutine lu_slv02 subroutine lu_slv( lu, b ) diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_nln_matrix.F90 index 1606ff3b72..c48389b422 100644 --- a/src/chemistry/pp_waccm_sc_mam4/mo_nln_matrix.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/mo_nln_matrix.F90 @@ -64,15 +64,18 @@ subroutine nlnmat_finit( mat, lmat, dti ) mat( 31) = lmat( 31) mat( 32) = lmat( 32) mat( 33) = lmat( 33) + mat( 34) = lmat( 34) + mat( 35) = lmat( 35) mat( 1) = mat( 1) - dti + mat( 2) = mat( 2) - dti mat( 3) = mat( 3) - dti mat( 4) = mat( 4) - dti mat( 5) = mat( 5) - dti - mat( 6) = mat( 6) - dti - mat( 8) = mat( 8) - dti + mat( 7) = mat( 7) - dti mat( 9) = mat( 9) - dti + mat( 10) = mat( 10) - dti mat( 11) = mat( 11) - dti - mat( 13) = mat( 13) - dti + mat( 12) = mat( 12) - dti mat( 14) = mat( 14) - dti mat( 15) = mat( 15) - dti mat( 16) = mat( 16) - dti @@ -84,7 +87,6 @@ subroutine nlnmat_finit( mat, lmat, dti ) mat( 22) = mat( 22) - dti mat( 23) = mat( 23) - dti mat( 24) = mat( 24) - dti - mat( 25) = mat( 25) - dti mat( 26) = mat( 26) - dti mat( 27) = mat( 27) - dti mat( 28) = mat( 28) - dti @@ -92,6 +94,7 @@ subroutine nlnmat_finit( mat, lmat, dti ) mat( 30) = mat( 30) - dti mat( 31) = mat( 31) - dti mat( 32) = mat( 32) - dti - mat( 33) = mat( 33) - dti + mat( 34) = mat( 34) - dti + mat( 35) = mat( 35) - dti end subroutine nlnmat_finit end module mo_nln_matrix diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_prod_loss.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_prod_loss.F90 index 01b921b8c1..cbc6916fac 100644 --- a/src/chemistry/pp_waccm_sc_mam4/mo_prod_loss.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/mo_prod_loss.F90 @@ -32,63 +32,65 @@ subroutine imp_prod_loss( prod, loss, y, rxt, het_rates ) !-------------------------------------------------------------------- ! ... loss and production for Implicit method !-------------------------------------------------------------------- - loss(1) = ( + rxt(2) + het_rates(1))* y(1) + loss(1) = ( + het_rates(1))* y(1) prod(1) = 0._r8 - loss(2) = ( + rxt(3) + het_rates(2))* y(2) + loss(2) = ( + het_rates(2))* y(2) prod(2) = 0._r8 - loss(3) = ( + rxt(4) + het_rates(3))* y(3) + loss(3) = ( + rxt(8) + het_rates(3))* y(3) prod(3) = 0._r8 - loss(4) = ( + rxt(5) + het_rates(4))* y(4) + loss(4) = ( + rxt(9) + het_rates(4))* y(4) prod(4) = 0._r8 - loss(5) = ( + rxt(6) + het_rates(29))* y(29) - prod(5) =2.000_r8*rxt(2)*y(1) +rxt(8)*y(5) - loss(6) = ( + rxt(1) + rxt(8) + het_rates(5))* y(5) + loss(5) = ( + rxt(10) + het_rates(5))* y(5) + prod(5) = 0._r8 + loss(6) = ( + rxt(11) + rxt(12) + rxt(14) + het_rates(6))* y(6) prod(6) = 0._r8 - loss(7) = ( + het_rates(6))* y(6) - prod(7) =rxt(9)*y(7) - loss(8) = ( + rxt(9) + het_rates(7))* y(7) - prod(8) = (rxt(10) +.500_r8*rxt(11) +rxt(12))*y(8) - loss(9) = ( + rxt(10) + rxt(11) + rxt(12) + het_rates(8))* y(8) + loss(7) = ( + het_rates(7))* y(7) + prod(7) = 0._r8 + loss(8) = ( + het_rates(8))* y(8) + prod(8) = 0._r8 + loss(9) = ( + het_rates(9))* y(9) prod(9) = 0._r8 - loss(10) = ( + het_rates(9))* y(9) + loss(10) = ( + rxt(1) + rxt(5) + het_rates(10))* y(10) prod(10) = 0._r8 - loss(11) = ( + het_rates(10))* y(10) - prod(11) = 0._r8 - loss(12) = ( + het_rates(11))* y(11) + loss(11) = ( + het_rates(11))* y(11) + prod(11) =rxt(13)*y(22) + loss(12) = ( + rxt(7) + het_rates(12))* y(12) prod(12) = 0._r8 - loss(13) = ( + het_rates(12))* y(12) + loss(13) = ( + het_rates(13))* y(13) prod(13) = 0._r8 - loss(14) = ( + het_rates(13))* y(13) + loss(14) = ( + het_rates(14))* y(14) prod(14) = 0._r8 - loss(15) = ( + het_rates(14))* y(14) + loss(15) = ( + het_rates(15))* y(15) prod(15) = 0._r8 - loss(16) = ( + het_rates(15))* y(15) + loss(16) = ( + het_rates(16))* y(16) prod(16) = 0._r8 - loss(17) = ( + het_rates(16))* y(16) + loss(17) = ( + het_rates(17))* y(17) prod(17) = 0._r8 - loss(18) = ( + het_rates(17))* y(17) + loss(18) = ( + het_rates(18))* y(18) prod(18) = 0._r8 - loss(19) = ( + het_rates(18))* y(18) + loss(19) = ( + het_rates(19))* y(19) prod(19) = 0._r8 - loss(20) = ( + het_rates(19))* y(19) + loss(20) = ( + het_rates(20))* y(20) prod(20) = 0._r8 - loss(21) = ( + het_rates(20))* y(20) + loss(21) = ( + het_rates(21))* y(21) prod(21) = 0._r8 - loss(22) = ( + het_rates(21))* y(21) - prod(22) = 0._r8 - loss(23) = ( + het_rates(22))* y(22) + loss(22) = ( + rxt(13) + het_rates(22))* y(22) + prod(22) = (rxt(11) +rxt(12) +.500_r8*rxt(14))*y(6) + loss(23) = ( + het_rates(23))* y(23) prod(23) = 0._r8 - loss(24) = ( + het_rates(23))* y(23) + loss(24) = ( + het_rates(24))* y(24) prod(24) = 0._r8 - loss(25) = ( + het_rates(24))* y(24) + loss(25) = ( + het_rates(25))* y(25) prod(25) = 0._r8 - loss(26) = ( + het_rates(25))* y(25) + loss(26) = ( + rxt(2) + het_rates(26))* y(26) prod(26) = 0._r8 - loss(27) = ( + het_rates(26))* y(26) + loss(27) = ( + rxt(3) + het_rates(27))* y(27) prod(27) = 0._r8 - loss(28) = ( + het_rates(27))* y(27) + loss(28) = ( + rxt(15) + het_rates(28))* y(28) prod(28) = 0._r8 - loss(29) = ( + het_rates(28))* y(28) - prod(29) = 0._r8 + loss(29) = ( + het_rates(29))* y(29) + prod(29) =rxt(15)*y(28) + loss(30) = ( + rxt(4) + het_rates(30))* y(30) + prod(30) =2.000_r8*rxt(10)*y(5) +rxt(5)*y(10) end subroutine imp_prod_loss end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_rxt_rates_conv.F90 index 2ba4ae7b40..765de620a9 100644 --- a/src/chemistry/pp_waccm_sc_mam4/mo_rxt_rates_conv.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/mo_rxt_rates_conv.F90 @@ -8,17 +8,20 @@ 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,:, 5) ! rate_const*H2O2 - rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 1) ! rate_const*CH4 - rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 2) ! rate_const*N2O - rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 3) ! rate_const*CFC11 - rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 4) ! rate_const*CFC12 - rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 29) ! rate_const*H2O + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 10) ! rate_const*H2O2 + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 26) ! rate_const*soa_a1 + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 27) ! rate_const*soa_a2 + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 30) ! rate_const*H2O + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 10) ! rate_const*OH*H2O2 ! rate_const - rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 5) ! rate_const*OH*H2O2 - rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 7) ! rate_const*OH*SO2 - rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 8) ! rate_const*OH*DMS - rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 8) ! rate_const*OH*DMS - rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 8) ! rate_const*NO3*DMS + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 12) ! rate_const*N2O + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 3) ! rate_const*CFC11 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 4) ! rate_const*CFC12 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 5) ! rate_const*CH4 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 6) ! rate_const*NO3*DMS + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 6) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 22) ! rate_const*OH*M*SO2 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 6) ! rate_const*OH*DMS + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 28) ! rate_const*SOAE end subroutine set_rates end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_setrxt.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_setrxt.F90 index b649fc0d19..6b94705faa 100644 --- a/src/chemistry/pp_waccm_sc_mam4/mo_setrxt.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/mo_setrxt.F90 @@ -32,12 +32,21 @@ subroutine setrxt( rate, temp, m, ncol ) integer :: n real(r8) :: itemp(ncol,pver) real(r8) :: exp_fac(ncol,pver) + real(r8) :: ko(ncol,pver) + real(r8) :: kinf(ncol,pver) + rate(:,:,5) = 1.8e-12_r8 + rate(:,:,15) = 1.157e-05_r8 itemp(:ncol,:) = 1._r8 / temp(:ncol,:) n = ncol*pver - rate(:,:,8) = 2.9e-12_r8 * exp( -160._r8 * itemp(:,:) ) - rate(:,:,10) = 9.6e-12_r8 * exp( -234._r8 * itemp(:,:) ) - rate(:,:,12) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) ) + rate(:,:,11) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) ) + rate(:,:,12) = 1.1e-11_r8 * exp( -280._r8 * itemp(:,:) ) + + itemp(:,:) = 300._r8 * itemp(:,:) + + ko(:,:) = 2.9e-31_r8 * itemp(:,:)**4.1_r8 + kinf(:,:) = 1.7e-12_r8 * itemp(:,:)**(-0.2_r8) + call jpl( rate(1,1,13), m, 0.6_r8, ko, kinf, n ) end subroutine setrxt @@ -66,6 +75,9 @@ subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) integer :: n 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) end subroutine setrxt_hrates diff --git a/src/chemistry/pp_waccm_sc_mam4/mo_sim_dat.F90 b/src/chemistry/pp_waccm_sc_mam4/mo_sim_dat.F90 index 314b969a9e..bd7112ef69 100644 --- a/src/chemistry/pp_waccm_sc_mam4/mo_sim_dat.F90 +++ b/src/chemistry/pp_waccm_sc_mam4/mo_sim_dat.F90 @@ -31,56 +31,56 @@ subroutine set_sim_dat is_scalar = .true. is_vector = .false. - clscnt(:) = (/ 0, 0, 0, 29, 0 /) - - cls_rxt_cnt(:,4) = (/ 1, 11, 0, 29 /) - - solsym(: 29) = (/ 'CH4 ','N2O ','CFC11 ','CFC12 ','H2O2 ', & - 'H2SO4 ','SO2 ','DMS ','SOAG ','so4_a1 ', & - 'pom_a1 ','soa_a1 ','bc_a1 ','dst_a1 ','ncl_a1 ', & - 'num_a1 ','so4_a2 ','soa_a2 ','ncl_a2 ','num_a2 ', & - 'dst_a2 ','dst_a3 ','ncl_a3 ','so4_a3 ','num_a3 ', & - 'pom_a4 ','bc_a4 ','num_a4 ','H2O ' /) - - adv_mass(: 29) = (/ 16.040600_r8, 44.012880_r8, 137.367503_r8, 120.913206_r8, 34.013600_r8, & - 98.078400_r8, 64.064800_r8, 62.132400_r8, 12.011000_r8, 115.107340_r8, & - 12.011000_r8, 12.011000_r8, 12.011000_r8, 135.064039_r8, 58.442468_r8, & - 1.007400_r8, 115.107340_r8, 12.011000_r8, 58.442468_r8, 1.007400_r8, & - 135.064039_r8, 135.064039_r8, 58.442468_r8, 115.107340_r8, 1.007400_r8, & - 12.011000_r8, 12.011000_r8, 1.007400_r8, 18.014200_r8 /) - - crb_mass(: 29) = (/ 12.011000_r8, 0.000000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, & - 0.000000_r8, 0.000000_r8, 24.022000_r8, 12.011000_r8, 0.000000_r8, & - 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & - 0.000000_r8, 0.000000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, & + clscnt(:) = (/ 0, 0, 0, 30, 0 /) + + cls_rxt_cnt(:,4) = (/ 1, 14, 0, 30 /) + + solsym(: 30) = (/ 'bc_a1 ','bc_a4 ','CFC11 ','CFC12 ','CH4 ', & + 'DMS ','dst_a1 ','dst_a2 ','dst_a3 ','H2O2 ', & + 'H2SO4 ','N2O ','ncl_a1 ','ncl_a2 ','ncl_a3 ', & + 'num_a1 ','num_a2 ','num_a3 ','num_a4 ','pom_a1 ', & + 'pom_a4 ','SO2 ','so4_a1 ','so4_a2 ','so4_a3 ', & + 'soa_a1 ','soa_a2 ','SOAE ','SOAG ','H2O ' /) + + adv_mass(: 30) = (/ 12.011000_r8, 12.011000_r8, 137.367503_r8, 120.913206_r8, 16.040600_r8, & + 62.132400_r8, 135.064039_r8, 135.064039_r8, 135.064039_r8, 34.013600_r8, & + 98.078400_r8, 44.012880_r8, 58.442468_r8, 58.442468_r8, 58.442468_r8, & + 1.007400_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, 12.011000_r8, & + 12.011000_r8, 64.064800_r8, 115.107340_r8, 115.107340_r8, 115.107340_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 18.014200_r8 /) + + crb_mass(: 30) = (/ 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 24.022000_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, 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, 0.000000_r8, & + 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8 /) - fix_mass(: 8) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 47.9982000_r8, 17.0068000_r8, & - 62.0049400_r8, 33.0062000_r8, 137.367503_r8 /) + fix_mass(: 8) = (/ 0.00000000_r8, 31.9988000_r8, 28.0134800_r8, 33.0062000_r8, 17.0068000_r8, & + 62.0049400_r8, 47.9982000_r8, 137.367503_r8 /) - clsmap(: 29,4) = (/ 1, 2, 3, 4, 29, 5, 6, 7, 8, 9, & - 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, & - 20, 21, 22, 23, 24, 25, 26, 27, 28 /) + clsmap(: 30,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 /) - permute(: 29,4) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + permute(: 30,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 /) + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30 /) - diag_map(: 29) = (/ 1, 3, 4, 5, 6, 8, 9, 11, 13, 14, & - 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, & - 25, 26, 27, 28, 29, 30, 31, 32, 33 /) + diag_map(: 30) = (/ 1, 2, 3, 4, 5, 7, 9, 10, 11, 12, & + 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, & + 24, 26, 27, 28, 29, 30, 31, 32, 34, 35 /) - extfrc_lst(: 11) = (/ 'SO2 ','so4_a1 ','so4_a2 ','pom_a1 ','pom_a4 ', & - 'bc_a1 ','bc_a4 ','num_a1 ','num_a2 ','num_a4 ', & - 'H2O ' /) + extfrc_lst(: 11) = (/ 'bc_a1 ','bc_a4 ','H2O ','num_a1 ','num_a2 ', & + 'num_a4 ','pom_a1 ','pom_a4 ','SO2 ','so4_a1 ', & + 'so4_a2 ' /) frc_from_dataset(: 11) = (/ .true., .true., .true., .true., .true., & .true., .true., .true., .true., .true., & .true. /) - inv_lst(: 8) = (/ 'M ', 'N2 ', 'O2 ', 'O3 ', 'OH ', & - 'NO3 ', 'HO2 ', 'HALONS ' /) + inv_lst(: 8) = (/ 'M ', 'O2 ', 'N2 ', 'HO2 ', 'OH ', & + 'NO3 ', 'O3 ', 'HALONS ' /) if( allocated( rxt_tag_lst ) ) then deallocate( rxt_tag_lst ) @@ -98,12 +98,16 @@ subroutine set_sim_dat write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios call endrun end if - rxt_tag_lst( 1: 9) = (/ 'jh2o2 ', 'ch4_loss ', & + rxt_tag_lst( 1: 15) = (/ 'jh2o2 ', 'jsoa_a1 ', & + 'jsoa_a2 ', 'lyman_alpha ', & + 'OH_H2O2 ', 'usr_HO2_HO2 ', & 'n2o_loss ', 'cfc11_loss ', & - 'cfc12_loss ', 'lyman_alpha ', & - 'usr_HO2_HO2 ', 'usr_SO2_OH ', & - 'usr_DMS_OH ' /) - rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 9, 11 /) + 'cfc12_loss ', 'ch4_loss ', & + 'DMS_NO3 ', 'DMS_OHa ', & + 'SO2_OH_M ', 'usr_DMS_OH ', & + 'SOAE_tau ' /) + rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 11, 12, 13, 14, 15 /) if( allocated( pht_alias_lst ) ) then deallocate( pht_alias_lst ) end if @@ -120,17 +124,17 @@ subroutine set_sim_dat write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios call endrun end if - pht_alias_lst(:,1) = (/ ' ' /) - pht_alias_lst(:,2) = (/ ' ' /) - pht_alias_mult(:,1) = (/ 1._r8 /) - pht_alias_mult(:,2) = (/ 1._r8 /) + pht_alias_lst(:,1) = (/ ' ', ' ', ' ' /) + pht_alias_lst(:,2) = (/ ' ', 'jno2 ', 'jno2 ' /) + pht_alias_mult(:,1) = (/ 1._r8, 1._r8, 1._r8 /) + pht_alias_mult(:,2) = (/ 1._r8, .0004_r8, .0004_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(:) = (/ 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, & - 2 /) + num_rnts(:) = (/ 1, 2, 2, 1, 1, 1, 1, 2, 2, 3, & + 2, 1 /) end subroutine set_sim_dat diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc index d9c4a5a88b..e48dd51a78 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc +++ b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.doc @@ -90,18 +90,18 @@ ( 87) HCOOH ( 88) HF ( 89) HNO3 - ( 90) HO2NO2 - ( 91) HOBR (HOBr) - ( 92) HOCL (HOCl) - ( 93) HONITR (C4H9NO4) - ( 94) HPALD (HOOCH2CCH3CHCHO) - ( 95) HYAC (CH3COCH2OH) - ( 96) HYDRALD (HOCH2CCH3CHCHO) - ( 97) IEPOX (C5H10O3) - ( 98) ISOP (C5H8) - ( 99) ISOPNITA (C5H9NO4) - (100) ISOPNITB (C5H9NO4) - (101) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + ( 90) HO2 + ( 91) HO2NO2 + ( 92) HOBR (HOBr) + ( 93) HOCL (HOCl) + ( 94) HONITR (C4H9NO4) + ( 95) HPALD (HOOCH2CCH3CHCHO) + ( 96) HYAC (CH3COCH2OH) + ( 97) HYDRALD (HOCH2CCH3CHCHO) + ( 98) IEPOX (C5H10O3) + ( 99) ISOP (C5H8) + (100) ISOPNITA (C5H9NO4) + (101) ISOPNITB (C5H9NO4) (102) ISOPNOOH (C5H9NO5) (103) ISOPOOH (HOCH2COOHCH3CHCH2) (104) IVOC (C13H28) @@ -191,48 +191,55 @@ (188) NDEP (N) (189) ACBZO2 (C7H5O3) (190) ALKO2 (C5H11O2) - (191) BENZO2 (C6H7O5) - (192) BZOO (C7H7O2) - (193) C2H5O2 - (194) C3H7O2 - (195) C6H5O2 - (196) CH3CO3 - (197) CH3O2 - (198) DICARBO2 (C5H5O4) - (199) e (E) - (200) ENEO2 (C4H9O3) - (201) EO (HOCH2CH2O) - (202) EO2 (HOCH2CH2O2) - (203) HO2 - (204) HOCH2OO - (205) ISOPAO2 (HOC5H8O2) - (206) ISOPBO2 (HOC5H8O2) - (207) MACRO2 (CH3COCHO2CH2OH) - (208) MALO2 (C4H3O4) - (209) MCO3 (CH2CCH3CO3) - (210) MDIALO2 (C4H5O4) - (211) MEKO2 (C4H7O3) - (212) N2D (N) - (213) N2p (N2) - (214) NOp (NO) - (215) Np (N) - (216) NTERPO2 (C10H16NO5) - (217) O1D (O) - (218) O2_1D (O2) - (219) O2_1S (O2) - (220) O2p (O2) - (221) OH - (222) Op (O) - (223) PHENO2 (C6H7O6) - (224) PO2 (C3H6OHO2) - (225) RO2 (CH3COCH2O2) - (226) TERP2O2 (C10H15O4) - (227) TERPO2 (C10H17O3) - (228) TOLO2 (C7H9O5) - (229) XO2 (HOCH2COOCH3CHOHCHO) - (230) XYLENO2 (C8H11O5) - (231) XYLOLO2 (C8H11O6) - (232) H2O + (191) BCARYO2VBS (C15H25O3) + (192) BENZO2 (C6H7O5) + (193) BENZO2VBS (C6H7O5) + (194) BZOO (C7H7O2) + (195) C2H5O2 + (196) C3H7O2 + (197) C6H5O2 + (198) CH3CO3 + (199) CH3O2 + (200) DICARBO2 (C5H5O4) + (201) e (E) + (202) ENEO2 (C4H9O3) + (203) EO (HOCH2CH2O) + (204) EO2 (HOCH2CH2O2) + (205) HOCH2OO + (206) ISOPAO2 (HOC5H8O2) + (207) ISOPBO2 (HOC5H8O2) + (208) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + (209) ISOPO2VBS (C5H9O3) + (210) IVOCO2VBS (C13H29O3) + (211) MACRO2 (CH3COCHO2CH2OH) + (212) MALO2 (C4H3O4) + (213) MCO3 (CH2CCH3CO3) + (214) MDIALO2 (C4H5O4) + (215) MEKO2 (C4H7O3) + (216) MTERPO2VBS (C10H17O3) + (217) N2D (N) + (218) N2p (N2) + (219) NOp (NO) + (220) Np (N) + (221) NTERPO2 (C10H16NO5) + (222) O1D (O) + (223) O2_1D (O2) + (224) O2_1S (O2) + (225) O2p (O2) + (226) OH + (227) Op (O) + (228) PHENO2 (C6H7O6) + (229) PO2 (C3H6OHO2) + (230) RO2 (CH3COCH2O2) + (231) TERP2O2 (C10H15O4) + (232) TERPO2 (C10H17O3) + (233) TOLO2 (C7H9O5) + (234) TOLUO2VBS (C7H9O5) + (235) XO2 (HOCH2COOCH3CHOHCHO) + (236) XYLENO2 (C8H11O5) + (237) XYLEO2VBS (C8H11O5) + (238) XYLOLO2 (C8H11O6) + (239) H2O Invariant species @@ -248,241 +255,248 @@ Class List ========== Explicit -------- - ( 1) AOA_NH - ( 2) BRY - ( 3) CCL4 - ( 4) CF2CLBR - ( 5) CF3BR - ( 6) CFC11 - ( 7) CFC113 - ( 8) CFC114 - ( 9) CFC115 - ( 10) CFC12 - ( 11) CH2BR2 - ( 12) CH3BR - ( 13) CH3CCL3 - ( 14) CH3CL - ( 15) CH4 - ( 16) CHBR3 - ( 17) CLY - ( 18) CO2 - ( 19) E90 - ( 20) H2402 - ( 21) HCFC141B - ( 22) HCFC142B - ( 23) HCFC22 - ( 24) N2O - ( 25) NH_5 - ( 26) NH_50 - ( 27) SF6 - ( 28) ST80_25 - ( 29) NHDEP - ( 30) NDEP - ( 31) O3S + ( 1) NHDEP + ( 2) NDEP Implicit -------- ( 1) ALKNIT ( 2) ALKOOH - ( 3) bc_a1 - ( 4) bc_a4 - ( 5) BCARY - ( 6) BENZENE - ( 7) BENZOOH - ( 8) BEPOMUC - ( 9) BIGALD - ( 10) BIGALD1 - ( 11) BIGALD2 - ( 12) BIGALD3 - ( 13) BIGALD4 - ( 14) BIGALK - ( 15) BIGENE - ( 16) BR - ( 17) BRCL - ( 18) BRO - ( 19) BRONO2 - ( 20) BZALD - ( 21) BZOOH - ( 22) C2H2 - ( 23) C2H4 - ( 24) C2H5OH - ( 25) C2H5OOH - ( 26) C2H6 - ( 27) C3H6 - ( 28) C3H7OOH - ( 29) C3H8 - ( 30) C6H5OOH - ( 31) CH2O - ( 32) CH3CHO - ( 33) CH3CN - ( 34) CH3COCH3 - ( 35) CH3COCHO - ( 36) CH3COOH - ( 37) CH3COOOH - ( 38) CH3OH - ( 39) CH3OOH - ( 40) CL - ( 41) CL2 - ( 42) CL2O2 - ( 43) CLO - ( 44) CLONO2 - ( 45) CO - ( 46) COF2 - ( 47) COFCL - ( 48) CRESOL - ( 49) DMS - ( 50) dst_a1 - ( 51) dst_a2 - ( 52) dst_a3 - ( 53) EOOH - ( 54) F - ( 55) GLYALD - ( 56) GLYOXAL - ( 57) H - ( 58) H2 - ( 59) H2O2 - ( 60) H2SO4 - ( 61) HBR - ( 62) HCL - ( 63) HCN - ( 64) HCOOH - ( 65) HF - ( 66) HNO3 - ( 67) HO2NO2 - ( 68) HOBR - ( 69) HOCL - ( 70) HONITR - ( 71) HPALD - ( 72) HYAC - ( 73) HYDRALD - ( 74) IEPOX - ( 75) ISOP - ( 76) ISOPNITA - ( 77) ISOPNITB - ( 78) ISOPNO3 - ( 79) ISOPNOOH - ( 80) ISOPOOH - ( 81) IVOC - ( 82) MACR - ( 83) MACROOH - ( 84) MEK - ( 85) MEKOOH - ( 86) MPAN - ( 87) MTERP - ( 88) MVK - ( 89) N - ( 90) N2O5 - ( 91) NC4CH2OH - ( 92) NC4CHO - ( 93) ncl_a1 - ( 94) ncl_a2 - ( 95) ncl_a3 - ( 96) NH3 - ( 97) NH4 - ( 98) NO - ( 99) NO2 - (100) NO3 - (101) NOA - (102) NTERPOOH - (103) num_a1 - (104) num_a2 - (105) num_a3 - (106) num_a4 - (107) O - (108) O2 - (109) O3 - (110) OCLO - (111) OCS - (112) ONITR - (113) PAN - (114) PBZNIT - (115) PHENO - (116) PHENOL - (117) PHENOOH - (118) pom_a1 - (119) pom_a4 - (120) POOH - (121) ROOH - (122) S - (123) SO - (124) SO2 - (125) SO3 - (126) so4_a1 - (127) so4_a2 - (128) so4_a3 - (129) soa1_a1 - (130) soa1_a2 - (131) soa2_a1 - (132) soa2_a2 - (133) soa3_a1 - (134) soa3_a2 - (135) soa4_a1 - (136) soa4_a2 - (137) soa5_a1 - (138) soa5_a2 - (139) SOAG0 - (140) SOAG1 - (141) SOAG2 - (142) SOAG3 - (143) SOAG4 - (144) SVOC - (145) TEPOMUC - (146) TERP2OOH - (147) TERPNIT - (148) TERPOOH - (149) TERPROD1 - (150) TERPROD2 - (151) TOLOOH - (152) TOLUENE - (153) XOOH - (154) XYLENES - (155) XYLENOOH - (156) XYLOL - (157) XYLOLOOH - (158) ACBZO2 - (159) ALKO2 - (160) BENZO2 - (161) BZOO - (162) C2H5O2 - (163) C3H7O2 - (164) C6H5O2 - (165) CH3CO3 - (166) CH3O2 - (167) DICARBO2 - (168) e - (169) ENEO2 - (170) EO - (171) EO2 - (172) HO2 - (173) HOCH2OO - (174) ISOPAO2 - (175) ISOPBO2 - (176) MACRO2 - (177) MALO2 - (178) MCO3 - (179) MDIALO2 - (180) MEKO2 - (181) N2D - (182) N2p - (183) NOp - (184) Np - (185) NTERPO2 - (186) O1D - (187) O2_1D - (188) O2_1S - (189) O2p - (190) OH - (191) Op - (192) PHENO2 - (193) PO2 - (194) RO2 - (195) TERP2O2 - (196) TERPO2 - (197) TOLO2 - (198) XO2 - (199) XYLENO2 - (200) XYLOLO2 - (201) H2O + ( 3) AOA_NH + ( 4) bc_a1 + ( 5) bc_a4 + ( 6) BCARY + ( 7) BENZENE + ( 8) BENZOOH + ( 9) BEPOMUC + ( 10) BIGALD + ( 11) BIGALD1 + ( 12) BIGALD2 + ( 13) BIGALD3 + ( 14) BIGALD4 + ( 15) BIGALK + ( 16) BIGENE + ( 17) BR + ( 18) BRCL + ( 19) BRO + ( 20) BRONO2 + ( 21) BRY + ( 22) BZALD + ( 23) BZOOH + ( 24) C2H2 + ( 25) C2H4 + ( 26) C2H5OH + ( 27) C2H5OOH + ( 28) C2H6 + ( 29) C3H6 + ( 30) C3H7OOH + ( 31) C3H8 + ( 32) C6H5OOH + ( 33) CCL4 + ( 34) CF2CLBR + ( 35) CF3BR + ( 36) CFC11 + ( 37) CFC113 + ( 38) CFC114 + ( 39) CFC115 + ( 40) CFC12 + ( 41) CH2BR2 + ( 42) CH2O + ( 43) CH3BR + ( 44) CH3CCL3 + ( 45) CH3CHO + ( 46) CH3CL + ( 47) CH3CN + ( 48) CH3COCH3 + ( 49) CH3COCHO + ( 50) CH3COOH + ( 51) CH3COOOH + ( 52) CH3OH + ( 53) CH3OOH + ( 54) CH4 + ( 55) CHBR3 + ( 56) CL + ( 57) CL2 + ( 58) CL2O2 + ( 59) CLO + ( 60) CLONO2 + ( 61) CLY + ( 62) CO + ( 63) CO2 + ( 64) COF2 + ( 65) COFCL + ( 66) CRESOL + ( 67) DMS + ( 68) dst_a1 + ( 69) dst_a2 + ( 70) dst_a3 + ( 71) E90 + ( 72) EOOH + ( 73) F + ( 74) GLYALD + ( 75) GLYOXAL + ( 76) H + ( 77) H2 + ( 78) H2402 + ( 79) H2O2 + ( 80) H2SO4 + ( 81) HBR + ( 82) HCFC141B + ( 83) HCFC142B + ( 84) HCFC22 + ( 85) HCL + ( 86) HCN + ( 87) HCOOH + ( 88) HF + ( 89) HNO3 + ( 90) HO2 + ( 91) HO2NO2 + ( 92) HOBR + ( 93) HOCL + ( 94) HONITR + ( 95) HPALD + ( 96) HYAC + ( 97) HYDRALD + ( 98) IEPOX + ( 99) ISOP + (100) ISOPNITA + (101) ISOPNITB + (102) ISOPNOOH + (103) ISOPOOH + (104) IVOC + (105) MACR + (106) MACROOH + (107) MEK + (108) MEKOOH + (109) MPAN + (110) MTERP + (111) MVK + (112) N + (113) N2O + (114) N2O5 + (115) NC4CH2OH + (116) NC4CHO + (117) ncl_a1 + (118) ncl_a2 + (119) ncl_a3 + (120) NH3 + (121) NH4 + (122) NH_5 + (123) NH_50 + (124) NO + (125) NO2 + (126) NO3 + (127) NOA + (128) NTERPOOH + (129) num_a1 + (130) num_a2 + (131) num_a3 + (132) num_a4 + (133) O + (134) O2 + (135) O3 + (136) O3S + (137) OCLO + (138) OCS + (139) ONITR + (140) PAN + (141) PBZNIT + (142) PHENO + (143) PHENOL + (144) PHENOOH + (145) pom_a1 + (146) pom_a4 + (147) POOH + (148) ROOH + (149) S + (150) SF6 + (151) SO + (152) SO2 + (153) SO3 + (154) so4_a1 + (155) so4_a2 + (156) so4_a3 + (157) soa1_a1 + (158) soa1_a2 + (159) soa2_a1 + (160) soa2_a2 + (161) soa3_a1 + (162) soa3_a2 + (163) soa4_a1 + (164) soa4_a2 + (165) soa5_a1 + (166) soa5_a2 + (167) SOAG0 + (168) SOAG1 + (169) SOAG2 + (170) SOAG3 + (171) SOAG4 + (172) ST80_25 + (173) SVOC + (174) TEPOMUC + (175) TERP2OOH + (176) TERPNIT + (177) TERPOOH + (178) TERPROD1 + (179) TERPROD2 + (180) TOLOOH + (181) TOLUENE + (182) XOOH + (183) XYLENES + (184) XYLENOOH + (185) XYLOL + (186) XYLOLOOH + (187) ACBZO2 + (188) ALKO2 + (189) BCARYO2VBS + (190) BENZO2 + (191) BENZO2VBS + (192) BZOO + (193) C2H5O2 + (194) C3H7O2 + (195) C6H5O2 + (196) CH3CO3 + (197) CH3O2 + (198) DICARBO2 + (199) e + (200) ENEO2 + (201) EO + (202) EO2 + (203) HOCH2OO + (204) ISOPAO2 + (205) ISOPBO2 + (206) ISOPNO3 + (207) ISOPO2VBS + (208) IVOCO2VBS + (209) MACRO2 + (210) MALO2 + (211) MCO3 + (212) MDIALO2 + (213) MEKO2 + (214) MTERPO2VBS + (215) N2D + (216) N2p + (217) NOp + (218) Np + (219) NTERPO2 + (220) O1D + (221) O2_1D + (222) O2_1S + (223) O2p + (224) OH + (225) Op + (226) PHENO2 + (227) PO2 + (228) RO2 + (229) TERP2O2 + (230) TERPO2 + (231) TOLO2 + (232) TOLUO2VBS + (233) XO2 + (234) XYLENO2 + (235) XYLEO2VBS + (236) XYLOLO2 + (237) H2O Photolysis jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) @@ -520,16 +534,16 @@ Class List jc2h5ooh ( 30) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 30) jc3h7ooh ( 31) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 31) jc6h5ooh ( 32) C6H5OOH + hv -> PHENO + OH rate = ** User defined ** ( 32) - jch2o_a ( 33) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 33) - jch2o_b ( 34) CH2O + hv -> CO + H2 rate = ** User defined ** ( 34) + jch2o_b ( 33) CH2O + hv -> CO + H2 rate = ** User defined ** ( 33) + jch2o_a ( 34) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 34) jch3cho ( 35) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 35) jacet ( 36) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 36) jmgly ( 37) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 37) jch3co3h ( 38) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 38) jch3ooh ( 39) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 39) - jch4_a ( 40) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 40) - jch4_b ( 41) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 41) + jch4_b ( 40) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 40) + 0.44*CO2 + 0.38*CO + 0.05*H2O + jch4_a ( 41) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 41) jco2 ( 42) CO2 + hv -> CO + O rate = ** User defined ** ( 42) jeooh ( 43) EOOH + hv -> EO + OH rate = ** User defined ** ( 43) jglyald ( 44) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 44) @@ -540,7 +554,7 @@ Class List jhpald ( 47) HPALD + hv -> BIGALD3 + OH + HO2 rate = ** User defined ** ( 47) jhyac ( 48) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 48) jisopnooh ( 49) ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH rate = ** User defined ** ( 49) - jisopooh ( 50) ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 rate = ** User defined ** ( 50) + jisopooh ( 50) ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + CH2O + HO2 rate = ** User defined ** ( 50) jmacr_a ( 51) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 51) jmacr_b ( 52) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 52) jmek ( 53) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 53) @@ -672,8 +686,8 @@ Class List H_HO2 ( 22) H + HO2 -> H2 + O2 rate = 6.90E-12 (172) H_HO2a ( 23) H + HO2 -> 2*OH rate = 7.20E-11 (173) H_HO2b ( 24) H + HO2 -> H2O + O rate = 1.60E-12 (174) - H_O2 ( 25) H + O2 + M -> HO2 + M troe : ko=4.40E-32*(300/t)**1.30 (175) - ki=7.50E-11*(300/t)**-0.20 + H_O2 ( 25) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (175) + ki=9.50E-11*(300/t)**-0.40 f=0.60 HO2_O ( 26) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (176) HO2_O3 ( 27) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (177) @@ -688,25 +702,25 @@ Class List ki=2.60E-11 f=0.60 usr_HO2_HO2 ( 36) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (186) - HO2NO2_OH ( 37) HO2NO2 + OH -> H2O + NO2 + O2 rate = 1.30E-12*exp( 380./t) (187) + HO2NO2_OH ( 37) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (187) N2D_O ( 38) N2D + O -> N + O rate = 7.00E-13 (188) N2D_O2 ( 39) N2D + O2 -> NO + O1D rate = 5.00E-12 (189) N_NO ( 40) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (190) N_NO2a ( 41) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (191) N_NO2b ( 42) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (192) N_NO2c ( 43) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (193) - N_O2 ( 44) N + O2 -> NO + O rate = 1.50E-11*exp( -3600./t) (194) + N_O2 ( 44) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (194) NO2_O ( 45) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (195) NO2_O3 ( 46) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (196) NO2_O_M ( 47) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (197) ki=2.20E-11*(300/t)**0.70 f=0.60 NO3_HO2 ( 48) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (198) - NO3_NO ( 49) NO3 + NO -> 2*NO2 rate = 1.50E-11*exp( 170./t) (199) - NO3_O ( 50) NO3 + O -> NO2 + O2 rate = 1.00E-11 (200) + NO3_NO ( 49) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (199) + NO3_O ( 50) NO3 + O -> NO2 + O2 rate = 1.30E-11 (200) NO3_OH ( 51) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (201) N_OH ( 52) N + OH -> NO + H rate = 5.00E-11 (202) - NO_HO2 ( 53) NO + HO2 -> NO2 + OH rate = 3.30E-12*exp( 270./t) (203) + NO_HO2 ( 53) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (203) NO_O3 ( 54) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (204) NO_O_M ( 55) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (205) ki=3.00E-11 @@ -822,76 +836,74 @@ Class List CH3OH_OH (152) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (302) CH3OOH_OH (153) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (303) CH4_OH (154) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (304) - CO_OH_M (155) CO + OH + M -> CO2 + HO2 + M troe : ko=5.90E-33*(300/t)**1.00 (305) - ki=1.10E-12*(300/t)**-1.30 - f=0.60 - HCN_OH (156) HCN + OH + M -> HO2 + M troe : ko=4.28E-33 (306) - ki=9.30E-15*(300/t)**-4.42 + HCN_OH (155) HCN + OH + M -> HO2 + M troe : ko=6.10E-33*(300/t)**1.50 (305) + ki=9.80E-15*(300/t)**-4.60 f=0.80 - HCOOH_OH (157) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (307) - HOCH2OO_HO2 (158) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (308) - HOCH2OO_M (159) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (309) - HOCH2OO_NO (160) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (310) - O1D_CH4a (161) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (311) - O1D_CH4b (162) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (312) - O1D_CH4c (163) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (313) - O1D_HCN (164) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (314) - usr_CO_OH_b (165) CO + OH -> CO2 + H rate = ** User defined ** (315) - C2H2_CL_M (166) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (316) + HCOOH_OH (156) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (306) + HOCH2OO_HO2 (157) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (307) + HOCH2OO_M (158) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (308) + HOCH2OO_NO (159) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (309) + O1D_CH4a (160) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (310) + O1D_CH4b (161) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (311) + O1D_CH4c (162) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (312) + O1D_HCN (163) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (313) + usr_CO_OH (164) CO + OH -> CO2 + HO2 rate = ** User defined ** (314) + C2H2_CL_M (165) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (315) ki=2.20E-10*(300/t)**0.70 f=0.60 - C2H2_OH_M (167) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (317) + C2H2_OH_M (166) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (316) + 0.35*CO + M ki=8.30E-13*(300/t)**-2.00 f=0.60 - C2H4_CL_M (168) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (318) + C2H4_CL_M (167) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (317) ki=3.10E-10*(300/t) f=0.60 - C2H4_O3 (169) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (319) - C2H5O2_C2H5O2 (170) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (320) - C2H5O2_CH3O2 (171) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (321) + C2H4_O3 (168) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (318) + C2H5O2_C2H5O2 (169) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (319) + C2H5O2_CH3O2 (170) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (320) + 0.2*C2H5OH - C2H5O2_HO2 (172) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (322) - C2H5O2_NO (173) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (323) - C2H5OH_OH (174) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (324) - C2H5OOH_OH (175) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (325) - C2H6_CL (176) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (326) - C2H6_OH (177) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (327) - CH3CHO_NO3 (178) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (328) - CH3CHO_OH (179) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (329) - CH3CN_OH (180) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (330) - CH3CO3_CH3CO3 (181) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (331) - CH3CO3_CH3O2 (182) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (332) + C2H5O2_HO2 (171) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (321) + C2H5O2_NO (172) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (322) + C2H5OH_OH (173) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (323) + C2H5OOH_OH (174) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (324) + C2H6_CL (175) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (325) + C2H6_OH (176) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (326) + CH3CHO_NO3 (177) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (327) + CH3CHO_OH (178) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (328) + CH3CN_OH (179) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (329) + CH3CO3_CH3CO3 (180) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (330) + CH3CO3_CH3O2 (181) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (331) + 0.1*CH3COOH - CH3CO3_HO2 (183) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (333) + CH3CO3_HO2 (182) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (332) + 0.45*CH3O2 - CH3CO3_NO (184) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (334) - CH3COOH_OH (185) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 7.00E-13 (335) - CH3COOOH_OH (186) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (336) - EO2_HO2 (187) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (337) - EO2_NO (188) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (338) - EO_M (189) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (339) - EO_O2 (190) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (340) - GLYALD_OH (191) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (341) - GLYOXAL_OH (192) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (342) - PAN_OH (193) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (343) - tag_C2H4_OH (194) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (344) + CH3CO3_NO (183) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (333) + CH3COOH_OH (184) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 3.15E-14*exp( 920./t) (334) + CH3COOOH_OH (185) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (335) + EO2_HO2 (186) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (336) + EO2_NO (187) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (337) + EO_M (188) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (338) + EO_O2 (189) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (339) + GLYALD_OH (190) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (340) + GLYOXAL_OH (191) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (341) + PAN_OH (192) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (342) + tag_C2H4_OH (193) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (343) ki=9.00E-12*(300/t)**0.85 f=0.48 - tag_CH3CO3_NO2 (195) CH3CO3 + NO2 + M -> PAN + M troe : ko=9.70E-29*(300/t)**5.60 (345) - ki=9.30E-12*(300/t)**1.50 + tag_CH3CO3_NO2 (194) CH3CO3 + NO2 + M -> PAN + M troe : ko=7.30E-29*(300/t)**4.10 (344) + ki=9.50E-12*(300/t)**1.60 f=0.60 - usr_PAN_M (196) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (346) - C3H6_NO3 (197) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (347) - C3H6_O3 (198) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (348) + usr_PAN_M (195) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (345) + C3H6_NO3 (196) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (346) + C3H6_O3 (197) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (347) + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + 0.36*OH - C3H7O2_CH3O2 (199) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (349) - C3H7O2_HO2 (200) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (350) - C3H7O2_NO (201) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (351) - C3H7OOH_OH (202) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (352) - C3H8_OH (203) C3H8 + OH -> C3H7O2 + H2O rate = 8.70E-12*exp( -615./t) (353) - CH3COCHO_NO3 (204) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (354) - CH3COCHO_OH (205) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (355) + C3H7O2_CH3O2 (198) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (348) + C3H7O2_HO2 (199) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (349) + C3H7O2_NO (200) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (350) + C3H7OOH_OH (201) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (351) + C3H8_OH (202) C3H8 + OH -> C3H7O2 + H2O rate = 9.19E-12*exp( -630./t) (352) + CH3COCHO_NO3 (203) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (353) + CH3COCHO_OH (204) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (354) + CL_C3H8 (205) CL + C3H8 -> C3H7O2 + HCL rate = 1.45E-10 (355) HYAC_OH (206) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (356) NOA_OH (207) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (357) PO2_HO2 (208) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (358) @@ -944,7 +956,9 @@ Class List MVK_O3 (242) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (392) + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH MVK_OH (243) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (393) - usr_MCO3_NO2 (244) MCO3 + NO2 + M -> MPAN + M rate = ** User defined ** (394) + tag_MCO3_NO2 (244) MCO3 + NO2 + M -> MPAN + M troe : ko=9.70E-29*(300/t)**5.60 (394) + ki=9.30E-12*(300/t)**1.50 + f=0.60 usr_MPAN_M (245) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (395) ALKNIT_OH (246) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (396) ALKO2_HO2 (247) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (397) @@ -1098,25 +1112,27 @@ Class List TERPROD2_OH (351) TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 rate = 3.40E-11 (501) + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO DMS_NO3 (352) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (502) - DMS_OHa (353) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) (503) + DMS_OHa (353) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (503) OCS_O (354) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (504) OCS_OH (355) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (505) S_O2 (356) S + O2 -> SO + O rate = 2.30E-12 (506) - S_O3 (357) S + O3 -> SO + O2 rate = 1.20E-11 (507) - SO_BRO (358) SO + BRO -> SO2 + BR rate = 5.70E-11 (508) - SO_CLO (359) SO + CLO -> SO2 + CL rate = 2.80E-11 (509) - S_OH (360) S + OH -> SO + H rate = 6.60E-11 (510) - SO_NO2 (361) SO + NO2 -> SO2 + NO rate = 1.40E-11 (511) - SO_O2 (362) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (512) - SO_O3 (363) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (513) - SO_OCLO (364) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (514) - SO_OH (365) SO + OH -> SO2 + H rate = 2.70E-11*exp( 335./t) (515) - usr_DMS_OH (366) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (516) - usr_SO2_OH (367) SO2 + OH -> SO3 + HO2 rate = ** User defined ** (517) + SO2_OH_M (357) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (507) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + S_O3 (358) S + O3 -> SO + O2 rate = 1.20E-11 (508) + SO_BRO (359) SO + BRO -> SO2 + BR rate = 5.70E-11 (509) + SO_CLO (360) SO + CLO -> SO2 + CL rate = 2.80E-11 (510) + S_OH (361) S + OH -> SO + H rate = 6.60E-11 (511) + SO_NO2 (362) SO + NO2 -> SO2 + NO rate = 1.40E-11 (512) + SO_O2 (363) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (513) + SO_O3 (364) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (514) + SO_OCLO (365) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (515) + SO_OH (366) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (516) + usr_DMS_OH (367) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (517) usr_SO3_H2O (368) SO3 + H2O -> H2SO4 rate = ** User defined ** (518) NH3_OH (369) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (519) usr_GLYOXAL_aer (370) GLYOXAL -> SOAG0 rate = ** User defined ** (520) - usr_HO2_aer (371) HO2 -> 0.5*H2O2 rate = ** User defined ** (521) + usr_HO2_aer (371) HO2 -> H2O rate = ** User defined ** (521) usr_HONITR_aer (372) HONITR -> HNO3 rate = ** User defined ** (522) usr_ISOPNITA_aer (373) ISOPNITA -> HNO3 rate = ** User defined ** (523) usr_ISOPNITB_aer (374) ISOPNITB -> HNO3 rate = ** User defined ** (524) @@ -1130,90 +1146,108 @@ Class List usr_ONITR_aer (382) ONITR -> HNO3 rate = ** User defined ** (532) usr_TERPNIT_aer (383) TERPNIT -> HNO3 rate = ** User defined ** (533) BCARY_NO3_vbs (384) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.90E-11 (534) - BCARY_O3_vbs (385) BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 1.20E-14 (535) - + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 - BCARY_OH_vbs (386) BCARY + OH -> BCARY + OH + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 2.00E-10 (536) + BCARYO2_HO2_vbs (385) BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 2.75E-13*exp( 1300./t) (535) + + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 + BCARYO2_NO_vbs (386) BCARYO2VBS + NO -> NO + 0.1279*SOAG0 + 0.1792*SOAG1 + 0.0676*SOAG2 rate = 2.70E-12*exp( 360./t) (536) + + 0.079*SOAG3 + 0.1254*SOAG4 + BCARY_O3_vbs (387) BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 1.20E-14 (537) + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 - BENZENE_OH_vbs (387) BENZENE + OH -> BENZENE + OH + 0.0023*SOAG0 + 0.0008*SOAG1 rate = 2.30E-12*exp( -193./t) (537) - + 0.0843*SOAG2 + 0.0443*SOAG3 + 0.1621*SOAG4 - ISOP_NO3_vbs (388) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 rate = 3.03E-12*exp( -446./t) (538) - ISOP_O3_vbs (389) ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 rate = 1.05E-14*exp( -2000./t) (539) - ISOP_OH_vbs (390) ISOP + OH -> ISOP + OH + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 rate = 2.54E-11*exp( 410./t) (540) - + 0.0271*SOAG3 + 0.0474*SOAG4 - IVOC_OH (391) IVOC + OH -> OH + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 rate = 1.34E-11 (541) - + 0.0076*SOAG3 + 0.0113*SOAG4 - MTERP_NO3_vbs (392) MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.20E-12*exp( 490./t) (542) - MTERP_O3_vbs (393) MTERP + O3 -> MTERP + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 6.30E-16*exp( -580./t) (543) + BCARY_OH_vbs (388) BCARY + OH -> BCARY + OH + BCARYO2VBS rate = 2.00E-10 (538) + BENZENE_OH_vbs (389) BENZENE + OH -> BENZENE + OH + BENZO2VBS rate = 2.30E-12*exp( -193./t) (539) + BENZO2_HO2_vbs (390) BENZO2VBS + HO2 -> HO2 + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 rate = 7.50E-13*exp( 700./t) (540) + + 0.0443*SOAG3 + 0.1621*SOAG4 + BENZO2_NO_vbs (391) BENZO2VBS + NO -> NO + 0.0097*SOAG0 + 0.0034*SOAG1 + 0.1579*SOAG2 rate = 2.60E-12*exp( 365./t) (541) + + 0.0059*SOAG3 + 0.0536*SOAG4 + ISOP_NO3_vbs (392) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 rate = 3.03E-12*exp( -446./t) (542) + ISOPO2_HO2_vbs (393) ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 rate = 2.12E-13*exp( 1300./t) (543) + + 0.0271*SOAG3 + 0.0474*SOAG4 + ISOPO2_NO_vbs (394) ISOPO2VBS + NO -> NO + 0.0003*SOAG0 + 0.0003*SOAG1 + 0.0073*SOAG2 rate = 2.70E-12*exp( 350./t) (544) + + 0.0057*SOAG3 + 0.0623*SOAG4 + ISOP_O3_vbs (395) ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 rate = 1.05E-14*exp( -2000./t) (545) + ISOP_OH_vbs (396) ISOP + OH -> ISOP + OH + ISOPO2VBS rate = 2.54E-11*exp( 410./t) (546) + IVOCO2_HO2_vbs (397) IVOCO2VBS + HO2 -> HO2 + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 rate = 7.50E-13*exp( 700./t) (547) + + 0.0076*SOAG3 + 0.0113*SOAG4 + IVOCO2_NO_vbs (398) IVOCO2VBS + NO -> NO + 0.1056*SOAG0 + 0.1026*SOAG1 + 0.0521*SOAG2 rate = 2.60E-12*exp( 365./t) (548) + + 0.0143*SOAG3 + 0.0166*SOAG4 + IVOC_OH_vbs (399) IVOC + OH -> OH + IVOCO2VBS rate = 1.34E-11 (549) + MTERP_NO3_vbs (400) MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.20E-12*exp( 490./t) (550) + MTERPO2_HO2_vbs (401) MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 2.60E-13*exp( 1300./t) (551) + + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 + MTERPO2_NO_vbs (402) MTERPO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (552) + + 0.0332*SOAG3 + 0.13*SOAG4 + MTERP_O3_vbs (403) MTERP + O3 -> MTERP + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 6.30E-16*exp( -580./t) (553) + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 - MTERP_OH_vbs (394) MTERP + OH -> MTERP + OH + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 1.20E-11*exp( 440./t) (544) - + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 - SVOC_OH (395) SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 rate = 1.34E-11 (545) + MTERP_OH_vbs (404) MTERP + OH -> MTERP + OH + MTERPO2VBS rate = 1.20E-11*exp( 440./t) (554) + SVOC_OH (405) SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 rate = 1.34E-11 (555) + 0.0085*SOAG3 + 0.0128*SOAG4 - TOLUENE_OH_vbs (396) TOLUENE + OH -> TOLUENE + OH + 0.1364*SOAG0 + 0.0101*SOAG1 rate = 1.70E-12*exp( 352./t) (546) - + 0.0763*SOAG2 + 0.2157*SOAG3 + 0.0738*SOAG4 - XYLENES_OH_vbs (397) XYLENES + OH -> XYLENES + OH + 0.1677*SOAG0 + 0.0174*SOAG1 rate = 1.70E-11 (547) - + 0.086*SOAG2 + 0.0512*SOAG3 + 0.1598*SOAG4 - het1 (398) N2O5 -> 2*HNO3 rate = ** User defined ** (548) - het10 (399) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (549) - het11 (400) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (550) - het12 (401) N2O5 -> 2*HNO3 rate = ** User defined ** (551) - het13 (402) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (552) - het14 (403) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (553) - het15 (404) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (554) - het16 (405) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (555) - het17 (406) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (556) - het2 (407) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (557) - het3 (408) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (558) - het4 (409) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (559) - het5 (410) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (560) - het6 (411) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (561) - het7 (412) N2O5 -> 2*HNO3 rate = ** User defined ** (562) - het8 (413) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (563) - het9 (414) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (564) - elec1 (415) NOp + e -> 0.2*N + 0.8*N2D + O rate = ** User defined ** (565) - elec2 (416) O2p + e -> 1.15*O + 0.85*O1D rate = ** User defined ** (566) - elec3 (417) N2p + e -> 1.1*N + 0.9*N2D rate = ** User defined ** (567) - ion_N2p_O2 (418) N2p + O2 -> O2p + N2 rate = 6.00E-11 (568) - ion_N2p_Oa (419) N2p + O -> NOp + N2D rate = ** User defined ** (569) - ion_N2p_Ob (420) N2p + O -> Op + N2 rate = ** User defined ** (570) - ion_Np_O (421) Np + O -> Op + N rate = 1.00E-12 (571) - ion_Np_O2a (422) Np + O2 -> O2p + N rate = 4.00E-10 (572) - ion_Np_O2b (423) Np + O2 -> NOp + O rate = 2.00E-10 (573) - ion_O2p_N (424) O2p + N -> NOp + O rate = 1.00E-10 (574) - ion_O2p_N2 (425) O2p + N2 -> NOp + NO rate = 5.00E-16 (575) - ion_O2p_NO (426) O2p + NO -> NOp + O2 rate = 4.40E-10 (576) - ion_Op_CO2 (427) Op + CO2 -> O2p + CO rate = 9.00E-10 (577) - ion_Op_N2 (428) Op + N2 -> NOp + N rate = ** User defined ** (578) - ion_Op_O2 (429) Op + O2 -> O2p + O rate = ** User defined ** (579) - E90_tau (430) E90 -> {sink} rate = 1.29E-07 (580) - NH_50_tau (431) NH_50 -> (No products) rate = 2.31E-07 (581) - NH_5_tau (432) NH_5 -> (No products) rate = 2.31E-06 (582) - ST80_25_tau (433) ST80_25 -> (No products) rate = 4.63E-07 (583) + TOLUENE_OH_vbs (406) TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS rate = 1.70E-12*exp( 352./t) (556) + TOLUO2_HO2_vbs (407) TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 rate = 7.50E-13*exp( 700./t) (557) + + 0.2157*SOAG3 + 0.0738*SOAG4 + TOLUO2_NO_vbs (408) TOLUO2VBS + NO -> NO + 0.0154*SOAG0 + 0.0452*SOAG1 + 0.0966*SOAG2 rate = 2.60E-12*exp( 365./t) (558) + + 0.0073*SOAG3 + 0.238*SOAG4 + XYLENES_OH_vbs (409) XYLENES + OH -> XYLENES + OH + XYLEO2VBS rate = 1.70E-11 (559) + XYLEO2_HO2_vbs (410) XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 rate = 7.50E-13*exp( 700./t) (560) + + 0.0512*SOAG3 + 0.1598*SOAG4 + XYLEO2_NO_vbs (411) XYLEO2VBS + NO -> NO + 0.0063*SOAG0 + 0.0237*SOAG1 + 0.0025*SOAG2 rate = 2.60E-12*exp( 365./t) (561) + + 0.011*SOAG3 + 0.1185*SOAG4 + het1 (412) N2O5 -> 2*HNO3 rate = ** User defined ** (562) + het10 (413) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (563) + het11 (414) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (564) + het12 (415) N2O5 -> 2*HNO3 rate = ** User defined ** (565) + het13 (416) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (566) + het14 (417) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (567) + het15 (418) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (568) + het16 (419) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (569) + het17 (420) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (570) + het2 (421) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (571) + het3 (422) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (572) + het4 (423) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (573) + het5 (424) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (574) + het6 (425) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (575) + het7 (426) N2O5 -> 2*HNO3 rate = ** User defined ** (576) + het8 (427) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (577) + het9 (428) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (578) + elec1 (429) NOp + e -> 0.2*N + 0.8*N2D + O rate = ** User defined ** (579) + elec2 (430) O2p + e -> 1.15*O + 0.85*O1D rate = ** User defined ** (580) + elec3 (431) N2p + e -> 1.1*N + 0.9*N2D rate = ** User defined ** (581) + ion_N2p_O2 (432) N2p + O2 -> O2p + N2 rate = 6.00E-11 (582) + ion_N2p_Oa (433) N2p + O -> NOp + N2D rate = ** User defined ** (583) + ion_N2p_Ob (434) N2p + O -> Op + N2 rate = ** User defined ** (584) + ion_Np_O (435) Np + O -> Op + N rate = 1.00E-12 (585) + ion_Np_O2a (436) Np + O2 -> O2p + N rate = 4.00E-10 (586) + ion_Np_O2b (437) Np + O2 -> NOp + O rate = 2.00E-10 (587) + ion_O2p_N (438) O2p + N -> NOp + O rate = 1.00E-10 (588) + ion_O2p_N2 (439) O2p + N2 -> NOp + NO rate = 5.00E-16 (589) + ion_O2p_NO (440) O2p + NO -> NOp + O2 rate = 4.40E-10 (590) + ion_Op_CO2 (441) Op + CO2 -> O2p + CO rate = 9.00E-10 (591) + ion_Op_N2 (442) Op + N2 -> NOp + N rate = ** User defined ** (592) + ion_Op_O2 (443) Op + O2 -> O2p + O rate = ** User defined ** (593) + E90_tau (444) E90 -> {sink} rate = 1.29E-07 (594) + NH_50_tau (445) NH_50 -> (No products) rate = 2.31E-07 (595) + NH_5_tau (446) NH_5 -> (No products) rate = 2.31E-06 (596) + ST80_25_tau (447) ST80_25 -> (No products) rate = 4.63E-07 (597) Extraneous prod/loss species - ( 1) NO2 (dataset) - ( 2) NO (dataset) - ( 3) CO (dataset) - ( 4) SO2 (dataset) - ( 5) SVOC (dataset) - ( 6) so4_a1 (dataset) - ( 7) so4_a2 (dataset) - ( 8) pom_a1 (dataset) - ( 9) pom_a4 (dataset) - (10) num_a1 (dataset) - (11) num_a2 (dataset) - (12) num_a4 (dataset) - (13) bc_a1 (dataset) - (14) bc_a4 (dataset) - (15) AOA_NH - (16) O2p - (17) Np - (18) N2p - (19) N2D + ( 1) CO (dataset) + ( 2) SVOC (dataset) + ( 3) SO2 (dataset) + ( 4) NO2 (dataset) + ( 5) NO (dataset) + ( 6) num_a1 (dataset) + ( 7) num_a2 (dataset) + ( 8) so4_a1 (dataset) + ( 9) so4_a2 (dataset) + (10) num_a4 (dataset) + (11) pom_a4 (dataset) + (12) bc_a4 (dataset) + (13) O2p + (14) N2p + (15) N2D + (16) AOA_NH + (17) N + (18) OH + (19) Op (20) e - (21) N - (22) OH - (23) Op Equation Report @@ -1251,32 +1285,32 @@ Extraneous prod/loss species + r104*BRO*CLO + r105*BRO*CLO + r108*BRO*NO + r111*BRO*O + r112*BRO*OH + r113*HBR*O + r114*HBR*OH + r116*O1D*CF3BR + 3*r117*O1D*CHBR3 + 2*r118*O1D*H2402 + r119*O1D*HBR + 2*r127*CH2BR2*CL + 2*r128*CH2BR2*OH + r129*CH3BR*CL + r130*CH3BR*OH + 3*r134*CHBR3*CL - + 3*r135*CHBR3*OH + 2*r139*O1D*CH2BR2 + r140*O1D*CH3BR + r358*SO*BRO + + 3*r135*CHBR3*OH + 2*r139*O1D*CH2BR2 + r140*O1D*CH3BR + r359*SO*BRO - r100*CH2O*BR - r101*HO2*BR - r102*O3*BR - d(BRCL)/dt = r106*BRO*CLO + r406*HOBR*HCL + r411*HOBR*HCL + d(BRCL)/dt = r106*BRO*CLO + r420*HOBR*HCL + r425*HOBR*HCL - j75*BRCL d(BRO)/dt = j77*BRONO2 + r102*BR*O3 + r110*BRONO2*O + r115*HOBR*O + r120*O1D*HBR - j76*BRO - 2*r103*BRO*BRO - r104*CLO*BRO - r105*CLO*BRO - r106*CLO*BRO - r107*HO2*BRO - - r108*NO*BRO - r109*M*NO2*BRO - r111*O*BRO - r112*OH*BRO - r358*SO*BRO + - r108*NO*BRO - r109*M*NO2*BRO - r111*O*BRO - r112*OH*BRO - r359*SO*BRO d(BRONO2)/dt = r109*M*BRO*NO2 - - j77*BRONO2 - j78*BRONO2 - r400*BRONO2 - r403*BRONO2 - r408*BRONO2 - r110*O*BRONO2 + - j77*BRONO2 - j78*BRONO2 - r414*BRONO2 - r417*BRONO2 - r422*BRONO2 - r110*O*BRONO2 d(BRY)/dt = 0 d(BZALD)/dt = j29*BZOOH + r295*BZOO*NO - r292*OH*BZALD d(BZOOH)/dt = r293*BZOO*HO2 - j29*BZOOH - r294*OH*BZOOH - d(C2H2)/dt = - r166*M*CL*C2H2 - r167*M*OH*C2H2 - d(C2H4)/dt = - r168*M*CL*C2H4 - r169*O3*C2H4 - r194*M*OH*C2H4 - d(C2H5OH)/dt = .4*r170*C2H5O2*C2H5O2 + .2*r171*C2H5O2*CH3O2 - - r174*OH*C2H5OH - d(C2H5OOH)/dt = r172*C2H5O2*HO2 - - j30*C2H5OOH - r175*OH*C2H5OOH - d(C2H6)/dt = - r176*CL*C2H6 - r177*OH*C2H6 + d(C2H2)/dt = - r165*M*CL*C2H2 - r166*M*OH*C2H2 + d(C2H4)/dt = - r167*M*CL*C2H4 - r168*O3*C2H4 - r193*M*OH*C2H4 + d(C2H5OH)/dt = .4*r169*C2H5O2*C2H5O2 + .2*r170*C2H5O2*CH3O2 + - r173*OH*C2H5OH + d(C2H5OOH)/dt = r171*C2H5O2*HO2 + - j30*C2H5OOH - r174*OH*C2H5OOH + d(C2H6)/dt = - r175*CL*C2H6 - r176*OH*C2H6 d(C3H6)/dt = .7*j56*MVK + .13*r275*ISOP*O3 - - r197*NO3*C3H6 - r198*O3*C3H6 - r215*M*OH*C3H6 - d(C3H7OOH)/dt = r200*C3H7O2*HO2 - - j31*C3H7OOH - r202*OH*C3H7OOH - d(C3H8)/dt = - r203*OH*C3H8 + - r196*NO3*C3H6 - r197*O3*C3H6 - r215*M*OH*C3H6 + d(C3H7OOH)/dt = r199*C3H7O2*HO2 + - j31*C3H7OOH - r201*OH*C3H7OOH + d(C3H8)/dt = - r202*OH*C3H8 - r205*CL*C3H8 d(C6H5OOH)/dt = r296*C6H5O2*HO2 - j32*C6H5OOH - r298*OH*C6H5OOH d(CCL4)/dt = - j79*CCL4 - r89*O1D*CCL4 @@ -1288,17 +1322,17 @@ Extraneous prod/loss species d(CFC115)/dt = - j85*CFC115 - r94*O1D*CFC115 d(CFC12)/dt = - j86*CFC12 - r95*O1D*CFC12 d(CH2BR2)/dt = - j87*CH2BR2 - r127*CL*CH2BR2 - r128*OH*CH2BR2 - r139*O1D*CH2BR2 - d(CH2O)/dt = .1*j20*ALKNIT + .1*j21*ALKOOH + j39*CH3OOH + .18*j41*CH4 + j44*GLYALD + .33*j46*HONITR - + j48*HYAC + .69*j50*ISOPOOH + 1.34*j51*MACR + j58*NOA + j63*POOH + j64*ROOH - + .375*j66*TERP2OOH + .4*j68*TERPOOH + .68*j70*TERPROD2 + r159*HOCH2OO + 2*r189*EO - + r71*CLO*CH3O2 + 2*r148*CH3O2*CH3O2 + r149*CH3O2*CH3O2 + r151*CH3O2*NO + r152*CH3OH*OH - + .3*r153*CH3OOH*OH + r162*O1D*CH4 + r163*O1D*CH4 + r169*C2H4*O3 + .7*r171*C2H5O2*CH3O2 - + r182*CH3CO3*CH3O2 + .5*r186*CH3COOOH*OH + .5*r188*EO2*NO + .8*r191*GLYALD*OH + r193*PAN*OH - + .5*r198*C3H6*O3 + r199*C3H7O2*CH3O2 + r209*PO2*NO + .8*r211*RO2*CH3O2 + .15*r212*RO2*HO2 - + r213*RO2*NO + .5*r217*BIGENE*NO3 + .5*r219*ENEO2*NO + .25*r222*MACRO2*CH3CO3 - + .88*r223*MACRO2*CH3O2 + .25*r225*MACRO2*NO3 + .25*r226*MACRO2*NO + .12*r228*MACR*O3 - + r231*MCO3*CH3CO3 + 2*r232*MCO3*CH3O2 + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + r235*MCO3*NO - + r236*MCO3*NO3 + .5*r241*M*MPAN*OH + .6*r242*MVK*O3 + .4*r246*ALKNIT*OH + .1*r248*ALKO2*NO + d(CH2O)/dt = .1*j20*ALKNIT + .1*j21*ALKOOH + j39*CH3OOH + .18*j40*CH4 + j44*GLYALD + .33*j46*HONITR + + j48*HYAC + j50*ISOPOOH + 1.34*j51*MACR + j58*NOA + j63*POOH + j64*ROOH + .375*j66*TERP2OOH + + .4*j68*TERPOOH + .68*j70*TERPROD2 + r158*HOCH2OO + 2*r188*EO + r71*CLO*CH3O2 + + 2*r148*CH3O2*CH3O2 + r149*CH3O2*CH3O2 + r151*CH3O2*NO + r152*CH3OH*OH + .3*r153*CH3OOH*OH + + r161*O1D*CH4 + r162*O1D*CH4 + r168*C2H4*O3 + .7*r170*C2H5O2*CH3O2 + r181*CH3CO3*CH3O2 + + .5*r185*CH3COOOH*OH + .5*r187*EO2*NO + .8*r190*GLYALD*OH + r192*PAN*OH + .5*r197*C3H6*O3 + + r198*C3H7O2*CH3O2 + r209*PO2*NO + .8*r211*RO2*CH3O2 + .15*r212*RO2*HO2 + r213*RO2*NO + + .5*r217*BIGENE*NO3 + .5*r219*ENEO2*NO + .25*r222*MACRO2*CH3CO3 + .88*r223*MACRO2*CH3O2 + + .25*r225*MACRO2*NO3 + .25*r226*MACRO2*NO + .12*r228*MACR*O3 + r231*MCO3*CH3CO3 + + 2*r232*MCO3*CH3O2 + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + r235*MCO3*NO + r236*MCO3*NO3 + + .5*r241*M*MPAN*OH + .6*r242*MVK*O3 + .4*r246*ALKNIT*OH + .1*r248*ALKO2*NO + r255*ISOPAO2*CH3CO3 + 1.5*r256*ISOPAO2*CH3O2 + .92*r258*ISOPAO2*NO + r259*ISOPAO2*NO3 + .75*r261*ISOPBO2*CH3O2 + .3*r266*ISOPNITA*OH + .8*r270*ISOPNO3*CH3O2 + .91*r275*ISOP*O3 + .25*r280*XO2*CH3CO3 + .8*r281*XO2*CH3O2 + .25*r283*XO2*NO + .34*r330*BCARY*O3 @@ -1309,15 +1343,15 @@ Extraneous prod/loss species d(CH3BR)/dt = - j88*CH3BR - r129*CL*CH3BR - r130*OH*CH3BR - r140*O1D*CH3BR d(CH3CCL3)/dt = - j89*CH3CCL3 - r131*OH*CH3CCL3 d(CH3CHO)/dt = .4*j20*ALKNIT + .4*j21*ALKOOH + j30*C2H5OOH + .33*j46*HONITR + j54*MEKOOH + j63*POOH - + 1.6*r170*C2H5O2*C2H5O2 + .8*r171*C2H5O2*CH3O2 + r173*C2H5O2*NO + r174*C2H5OH*OH - + .5*r175*C2H5OOH*OH + .5*r198*C3H6*O3 + .27*r201*C3H7O2*NO + r209*PO2*NO + r217*BIGENE*NO3 + + 1.6*r169*C2H5O2*C2H5O2 + .8*r170*C2H5O2*CH3O2 + r172*C2H5O2*NO + r173*C2H5OH*OH + + .5*r174*C2H5OOH*OH + .5*r197*C3H6*O3 + .27*r200*C3H7O2*NO + r209*PO2*NO + r217*BIGENE*NO3 + r219*ENEO2*NO + .2*r237*MEKO2*HO2 + r238*MEKO2*NO + .1*r242*MVK*O3 + .8*r246*ALKNIT*OH + .4*r248*ALKO2*NO - - j35*CH3CHO - r178*NO3*CH3CHO - r179*OH*CH3CHO + - j35*CH3CHO - r177*NO3*CH3CHO - r178*OH*CH3CHO d(CH3CL)/dt = - j90*CH3CL - r132*CL*CH3CL - r133*OH*CH3CL - d(CH3CN)/dt = - r180*OH*CH3CN + d(CH3CN)/dt = - r179*OH*CH3CN d(CH3COCH3)/dt = .25*j20*ALKNIT + .25*j21*ALKOOH + .82*j31*C3H7OOH + .17*j46*HONITR + .3*j66*TERP2OOH - + .05*j68*TERPOOH + .5*j70*TERPROD2 + .82*r199*C3H7O2*CH3O2 + .82*r201*C3H7O2*NO + + .05*j68*TERPOOH + .5*j70*TERPROD2 + .82*r198*C3H7O2*CH3O2 + .82*r200*C3H7O2*NO + .5*r217*BIGENE*NO3 + .5*r219*ENEO2*NO + .8*r246*ALKNIT*OH + .25*r248*ALKO2*NO + .52*r330*BCARY*O3 + .52*r333*MTERP*O3 + .15*r340*TERP2O2*CH3O2 + .27*r342*TERP2O2*NO + .025*r345*TERPO2*CH3O2 + .04*r347*TERPO2*NO + .5*r351*TERPROD2*OH @@ -1329,20 +1363,20 @@ Extraneous prod/loss species + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + .07*r300*DICARBO2*HO2 + .17*r301*DICARBO2*NO + .07*r306*MDIALO2*HO2 + .17*r307*MDIALO2*NO + .4*r317*TOLO2*NO + .54*r323*XYLENO2*NO + .51*r326*XYLOLO2*NO - - j37*CH3COCHO - r204*NO3*CH3COCHO - r205*OH*CH3COCHO - d(CH3COOH)/dt = .1*r182*CH3CO3*CH3O2 + .15*r183*CH3CO3*HO2 + .12*r198*C3H6*O3 + .15*r233*MCO3*HO2 - - r185*OH*CH3COOH - d(CH3COOOH)/dt = .4*r183*CH3CO3*HO2 + .4*r233*MCO3*HO2 - - j38*CH3COOOH - r186*OH*CH3COOOH - d(CH3OH)/dt = r149*CH3O2*CH3O2 + .3*r171*C2H5O2*CH3O2 + .5*r211*RO2*CH3O2 + .25*r223*MACRO2*CH3O2 + - j37*CH3COCHO - r203*NO3*CH3COCHO - r204*OH*CH3COCHO + d(CH3COOH)/dt = .1*r181*CH3CO3*CH3O2 + .15*r182*CH3CO3*HO2 + .12*r197*C3H6*O3 + .15*r233*MCO3*HO2 + - r184*OH*CH3COOH + d(CH3COOOH)/dt = .4*r182*CH3CO3*HO2 + .4*r233*MCO3*HO2 + - j38*CH3COOOH - r185*OH*CH3COOOH + d(CH3OH)/dt = r149*CH3O2*CH3O2 + .3*r170*C2H5O2*CH3O2 + .5*r211*RO2*CH3O2 + .25*r223*MACRO2*CH3O2 + .25*r256*ISOPAO2*CH3O2 + .25*r261*ISOPBO2*CH3O2 + .2*r270*ISOPNO3*CH3O2 + .3*r281*XO2*CH3O2 + .25*r335*NTERPO2*CH3O2 + .25*r340*TERP2O2*CH3O2 + .25*r345*TERPO2*CH3O2 - r152*OH*CH3OH d(CH3OOH)/dt = r150*CH3O2*HO2 - j39*CH3OOH - r153*OH*CH3OOH - d(CH4)/dt = .1*r198*C3H6*O3 - - j40*CH4 - j41*CH4 - r65*CL*CH4 - r121*F*CH4 - r154*OH*CH4 - r161*O1D*CH4 - r162*O1D*CH4 - - r163*O1D*CH4 + d(CH4)/dt = .1*r197*C3H6*O3 + - j40*CH4 - j41*CH4 - r65*CL*CH4 - r121*F*CH4 - r154*OH*CH4 - r160*O1D*CH4 - r161*O1D*CH4 + - r162*O1D*CH4 d(CHBR3)/dt = - j91*CHBR3 - r117*O1D*CHBR3 - r134*CL*CHBR3 - r135*OH*CHBR3 d(CL)/dt = j75*BRCL + 4*j79*CCL4 + j80*CF2CLBR + 2*j82*CFC11 + 2*j83*CFC113 + 2*j84*CFC114 + j85*CFC115 + 2*j86*CFC12 + 3*j89*CH3CCL3 + j90*CH3CL + 2*j92*CL2 + 2*j93*CL2O2 + j94*CLO + j95*CLONO2 @@ -1351,44 +1385,44 @@ Extraneous prod/loss species + 4*r89*O1D*CCL4 + r90*O1D*CF2CLBR + 2*r91*O1D*CFC11 + 2*r92*O1D*CFC113 + 2*r93*O1D*CFC114 + r94*O1D*CFC115 + 2*r95*O1D*CFC12 + r96*O1D*HCL + r105*BRO*CLO + r126*O1D*COFCL + 3*r131*CH3CCL3*OH + r133*CH3CL*OH + r136*HCFC141B*OH + r137*HCFC142B*OH + r138*HCFC22*OH - + r141*O1D*HCFC141B + r142*O1D*HCFC142B + r143*O1D*HCFC22 + r359*SO*CLO + + r141*O1D*HCFC141B + r142*O1D*HCFC142B + r143*O1D*HCFC22 + r360*SO*CLO - r64*CH2O*CL - r65*CH4*CL - r66*H2*CL - r67*H2O2*CL - r68*HO2*CL - r69*HO2*CL - r70*O3*CL - r77*CLONO2*CL - r86*HOCL*CL - r127*CH2BR2*CL - r129*CH3BR*CL - r132*CH3CL*CL - r134*CHBR3*CL - - r176*C2H6*CL - d(CL2)/dt = r73*CLO*CLO + r77*CLONO2*CL + r399*HOCL*HCL + r404*CLONO2*HCL + r405*HOCL*HCL + r409*CLONO2*HCL - + r410*HOCL*HCL + r414*CLONO2*HCL + - r175*C2H6*CL - r205*C3H8*CL + d(CL2)/dt = r73*CLO*CLO + r77*CLONO2*CL + r413*HOCL*HCL + r418*CLONO2*HCL + r419*HOCL*HCL + r423*CLONO2*HCL + + r424*HOCL*HCL + r428*CLONO2*HCL - j92*CL2 d(CL2O2)/dt = r98*M*CLO*CLO - j93*CL2O2 - r99*M*CL2O2 d(CLO)/dt = j96*CLONO2 + j108*OCLO + r99*M*CL2O2 + r99*M*CL2O2 + r69*CL*HO2 + r70*CL*O3 + r79*CLONO2*O - + r86*HOCL*CL + r87*HOCL*O + r88*HOCL*OH + r97*O1D*HCL + r364*SO*OCLO + + r86*HOCL*CL + r87*HOCL*O + r88*HOCL*OH + r97*O1D*HCL + r365*SO*OCLO - j94*CLO - r71*CH3O2*CLO - 2*r72*CLO*CLO - 2*r73*CLO*CLO - 2*r74*CLO*CLO - r75*HO2*CLO - r76*NO*CLO - r78*M*NO2*CLO - r81*O*CLO - r82*OH*CLO - r83*OH*CLO - 2*r98*M*CLO*CLO - - r104*BRO*CLO - r105*BRO*CLO - r106*BRO*CLO - r359*SO*CLO + - r104*BRO*CLO - r105*BRO*CLO - r106*BRO*CLO - r360*SO*CLO d(CLONO2)/dt = r78*M*CLO*NO2 - - j95*CLONO2 - j96*CLONO2 - r402*CLONO2 - r407*CLONO2 - r413*CLONO2 - r77*CL*CLONO2 - - r79*O*CLONO2 - r80*OH*CLONO2 - r404*HCL*CLONO2 - r409*HCL*CLONO2 - r414*HCL*CLONO2 + - j95*CLONO2 - j96*CLONO2 - r416*CLONO2 - r421*CLONO2 - r427*CLONO2 - r77*CL*CLONO2 + - r79*O*CLONO2 - r80*OH*CLONO2 - r418*HCL*CLONO2 - r423*HCL*CLONO2 - r428*HCL*CLONO2 d(CLY)/dt = 0 d(CO)/dt = 1.5*j23*BEPOMUC + .45*j24*BIGALD + .6*j27*BIGALD3 + j28*BIGALD4 + j33*CH2O + j34*CH2O - + j35*CH3CHO + j37*CH3COCHO + .38*j41*CH4 + j42*CO2 + j44*GLYALD + 2*j45*GLYOXAL + + j35*CH3CHO + j37*CH3COCHO + .38*j40*CH4 + j42*CO2 + j44*GLYALD + 2*j45*GLYOXAL + .33*j46*HONITR + 1.34*j52*MACR + .7*j56*MVK + 1.5*j65*TEPOMUC + .25*j66*TERP2OOH + j69*TERPROD1 + 1.7*j70*TERPROD2 + j110*CO2 + j137*OCS + r64*CL*CH2O + r100*BR*CH2O + r132*CH3CL*CL - + r145*CH2O*NO3 + r146*CH2O*O + r147*CH2O*OH + .35*r167*M*C2H2*OH + .63*r169*C2H4*O3 - + r192*GLYOXAL*OH + .56*r198*C3H6*O3 + r204*CH3COCHO*NO3 + r205*CH3COCHO*OH + + r145*CH2O*NO3 + r146*CH2O*O + r147*CH2O*OH + .35*r166*M*C2H2*OH + .63*r168*C2H4*O3 + + r191*GLYOXAL*OH + .56*r197*C3H6*O3 + r203*CH3COCHO*NO3 + r204*CH3COCHO*OH + .22*r222*MACRO2*CH3CO3 + .11*r223*MACRO2*CH3O2 + .22*r225*MACRO2*NO3 + .22*r226*MACRO2*NO + .65*r228*MACR*O3 + .56*r242*MVK*O3 + .62*r275*ISOP*O3 + .25*r280*XO2*CH3CO3 + .2*r281*XO2*CH3O2 + .25*r283*XO2*NO + .5*r284*XO2*NO3 + .07*r300*DICARBO2*HO2 + .17*r301*DICARBO2*NO + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + .14*r306*MDIALO2*HO2 + .35*r307*MDIALO2*NO + .23*r330*BCARY*O3 + .23*r333*MTERP*O3 + .125*r340*TERP2O2*CH3O2 + .225*r342*TERP2O2*NO - + .7*r351*TERPROD2*OH + r354*OCS*O + r355*OCS*OH + r427*Op*CO2 - - r155*M*OH*CO - r165*OH*CO - d(CO2)/dt = j38*CH3COOOH + .44*j41*CH4 + .4*j61*PAN + j66*TERP2OOH + .8*j70*TERPROD2 + r155*M*CO*OH - + r157*HCOOH*OH + r165*CO*OH + 2*r181*CH3CO3*CH3CO3 + .9*r182*CH3CO3*CH3O2 + r184*CH3CO3*NO - + r185*CH3COOH*OH + .5*r186*CH3COOOH*OH + .8*r191*GLYALD*OH + r192*GLYOXAL*OH + .2*r198*C3H6*O3 + + .7*r351*TERPROD2*OH + r354*OCS*O + r355*OCS*OH + r441*Op*CO2 + - r164*OH*CO + d(CO2)/dt = j38*CH3COOOH + .44*j40*CH4 + .4*j61*PAN + j66*TERP2OOH + .8*j70*TERPROD2 + r156*HCOOH*OH + + r164*CO*OH + 2*r180*CH3CO3*CH3CO3 + .9*r181*CH3CO3*CH3O2 + r183*CH3CO3*NO + r184*CH3COOH*OH + + .5*r185*CH3COOOH*OH + .8*r190*GLYALD*OH + r191*GLYOXAL*OH + .2*r197*C3H6*O3 + 2*r231*MCO3*CH3CO3 + r232*MCO3*CH3O2 + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + .5*r241*M*MPAN*OH + .1*r242*MVK*O3 + r255*ISOPAO2*CH3CO3 + r280*XO2*CH3CO3 + .27*r330*BCARY*O3 + .27*r333*MTERP*O3 + .5*r340*TERP2O2*CH3O2 + .9*r342*TERP2O2*NO + 1.8*r351*TERPROD2*OH - - j42*CO2 - j110*CO2 - r427*Op*CO2 + - j42*CO2 - j110*CO2 - r441*Op*CO2 d(COF2)/dt = j80*CF2CLBR + j81*CF3BR + j83*CFC113 + 2*j84*CFC114 + 2*j85*CFC115 + j86*CFC12 + 2*j99*H2402 + j102*HCFC142B + j103*HCFC22 + r90*O1D*CF2CLBR + r92*O1D*CFC113 + 2*r93*O1D*CFC114 + 2*r94*O1D*CFC115 + r95*O1D*CFC12 + r116*O1D*CF3BR + 2*r118*O1D*H2402 + r137*HCFC142B*OH @@ -1399,38 +1433,37 @@ Extraneous prod/loss species - j98*COFCL - r126*O1D*COFCL d(CRESOL)/dt = .18*r319*TOLUENE*OH - r299*OH*CRESOL - d(DMS)/dt = - r352*NO3*DMS - r353*OH*DMS - r366*OH*DMS + d(DMS)/dt = - r352*NO3*DMS - r353*OH*DMS - r367*OH*DMS d(dst_a1)/dt = 0 d(dst_a2)/dt = 0 d(dst_a3)/dt = 0 - d(E90)/dt = - r430*E90 - d(EOOH)/dt = r187*EO2*HO2 + d(E90)/dt = - r444*E90 + d(EOOH)/dt = r186*EO2*HO2 - j43*EOOH d(F)/dt = j81*CF3BR + j85*CFC115 + 2*j97*COF2 + j98*COFCL + j105*HF + r94*O1D*CFC115 + r116*O1D*CF3BR + 2*r125*O1D*COF2 + r126*O1D*COFCL - r121*CH4*F - r122*H2*F - r123*H2O*F - r124*HNO3*F - d(GLYALD)/dt = .33*j46*HONITR + .25*j66*TERP2OOH + r190*EO*O2 + .53*r222*MACRO2*CH3CO3 + .26*r223*MACRO2*CH3O2 + d(GLYALD)/dt = .33*j46*HONITR + .25*j66*TERP2OOH + r189*EO*O2 + .53*r222*MACRO2*CH3CO3 + .26*r223*MACRO2*CH3O2 + .53*r225*MACRO2*NO3 + .53*r226*MACRO2*NO + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + .7*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH + r278*NC4CH2OH*OH + .25*r280*XO2*CH3CO3 + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + .125*r340*TERP2O2*CH3O2 + .225*r342*TERP2O2*NO - - j44*GLYALD - r191*OH*GLYALD + - j44*GLYALD - r190*OH*GLYALD d(GLYOXAL)/dt = j22*BENZOOH + .13*j24*BIGALD + .7*j62*PHENOOH + .6*j71*TOLOOH + .34*j73*XYLENOOH - + .17*j74*XYLOLOOH + .65*r167*M*C2H2*OH + .2*r191*GLYALD*OH + .05*r264*ISOPBO2*NO + + .17*j74*XYLOLOOH + .65*r166*M*C2H2*OH + .2*r190*GLYALD*OH + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + r279*NC4CHO*OH + .25*r280*XO2*CH3CO3 + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + r290*BENZO2*NO + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + .07*r306*MDIALO2*HO2 + .17*r307*MDIALO2*NO + .7*r310*PHENO2*NO + .6*r317*TOLO2*NO + .34*r323*XYLENO2*NO + .17*r326*XYLOLO2*NO - - j45*GLYOXAL - r370*GLYOXAL - r192*OH*GLYOXAL - d(H)/dt = 2*j2*H2O + j3*H2O + 2*j33*CH2O + j39*CH3OOH + j40*CH4 + .33*j41*CH4 + j100*HBR + j104*HCL + - j45*GLYOXAL - r370*GLYOXAL - r191*OH*GLYOXAL + d(H)/dt = 2*j2*H2O + j3*H2O + 2*j34*CH2O + j39*CH3OOH + .33*j40*CH4 + j41*CH4 + j100*HBR + j104*HCL + j105*HF + r3*O1D*H2 + r20*H2*O + r29*OH*H2 + r32*OH*O + r52*N*OH + r66*CL*H2 + r97*O1D*HCL - + r120*O1D*HBR + r122*F*H2 + r147*CH2O*OH + r162*O1D*CH4 + r165*CO*OH + r355*OCS*OH + r360*S*OH - + r365*SO*OH + + r120*O1D*HBR + r122*F*H2 + r147*CH2O*OH + r161*O1D*CH4 + r355*OCS*OH + r361*S*OH + r366*SO*OH - r22*HO2*H - r23*HO2*H - r24*HO2*H - r25*M*O2*H - r28*O3*H - d(H2)/dt = j1*H2O + j34*CH2O + 1.4400001*j41*CH4 + r22*H*HO2 + r163*O1D*CH4 + d(H2)/dt = j1*H2O + j33*CH2O + 1.4400001*j40*CH4 + r22*H*HO2 + r162*O1D*CH4 - r3*O1D*H2 - r20*O*H2 - r29*OH*H2 - r66*CL*H2 - r122*F*H2 d(H2402)/dt = - j99*H2402 - r118*O1D*H2402 - d(H2O2)/dt = .5*r371*HO2 + r35*M*OH*OH + r36*HO2*HO2 + d(H2O2)/dt = r35*M*OH*OH + r36*HO2*HO2 - j4*H2O2 - r21*O*H2O2 - r30*OH*H2O2 - r67*CL*H2O2 d(H2SO4)/dt = r368*SO3*H2O - j136*H2SO4 @@ -1440,29 +1473,67 @@ Extraneous prod/loss species d(HCFC142B)/dt = - j102*HCFC142B - r137*OH*HCFC142B - r142*O1D*HCFC142B d(HCFC22)/dt = - j103*HCFC22 - r138*OH*HCFC22 - r143*O1D*HCFC22 d(HCL)/dt = r64*CL*CH2O + r65*CL*CH4 + r66*CL*H2 + r67*CL*H2O2 + r68*CL*HO2 + r83*CLO*OH + r86*HOCL*CL - + r127*CH2BR2*CL + r129*CH3BR*CL + 2*r132*CH3CL*CL + r134*CHBR3*CL + r176*C2H6*CL - - j104*HCL - r84*O*HCL - r85*OH*HCL - r96*O1D*HCL - r97*O1D*HCL - r399*HOCL*HCL - - r404*CLONO2*HCL - r405*HOCL*HCL - r406*HOBR*HCL - r409*CLONO2*HCL - r410*HOCL*HCL - - r411*HOBR*HCL - r414*CLONO2*HCL - d(HCN)/dt = - r156*M*OH*HCN - r164*O1D*HCN - d(HCOOH)/dt = r158*HOCH2OO*HO2 + r160*HOCH2OO*NO + .35*r167*M*C2H2*OH + .37*r169*C2H4*O3 + .12*r198*C3H6*O3 + + r127*CH2BR2*CL + r129*CH3BR*CL + 2*r132*CH3CL*CL + r134*CHBR3*CL + r175*C2H6*CL + r205*CL*C3H8 + - j104*HCL - r84*O*HCL - r85*OH*HCL - r96*O1D*HCL - r97*O1D*HCL - r413*HOCL*HCL + - r418*CLONO2*HCL - r419*HOCL*HCL - r420*HOBR*HCL - r423*CLONO2*HCL - r424*HOCL*HCL + - r425*HOBR*HCL - r428*CLONO2*HCL + d(HCN)/dt = - r155*M*OH*HCN - r163*O1D*HCN + d(HCOOH)/dt = r157*HOCH2OO*HO2 + r159*HOCH2OO*NO + .35*r166*M*C2H2*OH + .37*r168*C2H4*O3 + .12*r197*C3H6*O3 + .33*r228*MACR*O3 + .12*r242*MVK*O3 + .11*r275*ISOP*O3 + .05*r330*BCARY*O3 + .05*r333*MTERP*O3 - - r157*OH*HCOOH + - r156*OH*HCOOH d(HF)/dt = r121*F*CH4 + r122*F*H2 + r123*F*H2O + r124*F*HNO3 - j105*HF d(HNO3)/dt = r372*HONITR + r373*ISOPNITA + r374*ISOPNITB + 2*r375*N2O5 + r376*NC4CH2OH + r377*NC4CHO - + .5*r379*NO2 + r380*NO3 + r381*NTERPOOH + r382*ONITR + r383*TERPNIT + 2*r398*N2O5 - + r400*BRONO2 + 2*r401*N2O5 + r402*CLONO2 + r403*BRONO2 + r407*CLONO2 + r408*BRONO2 - + 2*r412*N2O5 + r413*CLONO2 + r60*M*NO2*OH + r145*CH2O*NO3 + r178*CH3CHO*NO3 - + r204*CH3COCHO*NO3 + r352*DMS*NO3 + r404*CLONO2*HCL + r409*CLONO2*HCL + r414*CLONO2*HCL + + .5*r379*NO2 + r380*NO3 + r381*NTERPOOH + r382*ONITR + r383*TERPNIT + 2*r412*N2O5 + + r414*BRONO2 + 2*r415*N2O5 + r416*CLONO2 + r417*BRONO2 + r421*CLONO2 + r422*BRONO2 + + 2*r426*N2O5 + r427*CLONO2 + r60*M*NO2*OH + r145*CH2O*NO3 + r177*CH3CHO*NO3 + + r203*CH3COCHO*NO3 + r352*DMS*NO3 + r418*CLONO2*HCL + r423*CLONO2*HCL + r428*CLONO2*HCL - j9*HNO3 - r61*OH*HNO3 - r124*F*HNO3 + d(HO2)/dt = j11*HO2NO2 + j20*ALKNIT + .9*j21*ALKOOH + j22*BENZOOH + 1.5*j23*BEPOMUC + .56*j24*BIGALD + + j25*BIGALD1 + .6*j26*BIGALD2 + .6*j27*BIGALD3 + j28*BIGALD4 + j29*BZOOH + j30*C2H5OOH + + j31*C3H7OOH + j35*CH3CHO + j37*CH3COCHO + 2*j44*GLYALD + 2*j45*GLYOXAL + .67*j46*HONITR + + j47*HPALD + j48*HYAC + j49*ISOPNOOH + j50*ISOPOOH + 1.34*j51*MACR + .66*j52*MACR + j57*NC4CHO + + j62*PHENOOH + j63*POOH + j65*TEPOMUC + j66*TERP2OOH + j67*TERPNIT + j68*TERPOOH + + j69*TERPROD1 + 1.2*j70*TERPROD2 + j71*TOLOOH + j73*XYLENOOH + j74*XYLOLOOH + r62*M*HO2NO2 + + r158*HOCH2OO + r188*EO + r263*ISOPBO2 + r21*H2O2*O + r25*M*H*O2 + r30*OH*H2O2 + r33*OH*O3 + + r51*NO3*OH + r64*CL*CH2O + r67*CL*H2O2 + r71*CLO*CH3O2 + r82*CLO*OH + r100*BR*CH2O + + r112*BRO*OH + r129*CH3BR*CL + r130*CH3BR*OH + r132*CH3CL*CL + r133*CH3CL*OH + r145*CH2O*NO3 + + r146*CH2O*O + 2*r148*CH3O2*CH3O2 + r151*CH3O2*NO + r152*CH3OH*OH + r155*M*HCN*OH + + r156*HCOOH*OH + r159*HOCH2OO*NO + r161*O1D*CH4 + r164*CO*OH + .35*r166*M*C2H2*OH + + .13*r168*C2H4*O3 + 1.2*r169*C2H5O2*C2H5O2 + r170*C2H5O2*CH3O2 + r172*C2H5O2*NO + r173*C2H5OH*OH + + r179*CH3CN*OH + .9*r181*CH3CO3*CH3O2 + .25*r187*EO2*NO + r189*EO*O2 + r190*GLYALD*OH + + r191*GLYOXAL*OH + .28*r197*C3H6*O3 + r198*C3H7O2*CH3O2 + r200*C3H7O2*NO + r206*HYAC*OH + + r209*PO2*NO + .3*r211*RO2*CH3O2 + r219*ENEO2*NO + r221*HONITR*OH + .47*r222*MACRO2*CH3CO3 + + .73*r223*MACRO2*CH3O2 + .47*r225*MACRO2*NO3 + .47*r226*MACRO2*NO + .14*r228*MACR*O3 + + .2*r230*MACROOH*OH + r232*MCO3*CH3O2 + .5*r241*M*MPAN*OH + .28*r242*MVK*O3 + r248*ALKO2*NO + + r255*ISOPAO2*CH3CO3 + r256*ISOPAO2*CH3O2 + .92*r258*ISOPAO2*NO + r259*ISOPAO2*NO3 + + r260*ISOPBO2*CH3CO3 + r261*ISOPBO2*CH3O2 + .92*r264*ISOPBO2*NO + r265*ISOPBO2*NO3 + + .3*r266*ISOPNITA*OH + r267*ISOPNITB*OH + r269*ISOPNO3*CH3CO3 + 1.2*r270*ISOPNO3*CH3O2 + + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + r274*ISOPNOOH*OH + .37*r275*ISOP*O3 + r278*NC4CH2OH*OH + + r279*NC4CHO*OH + r280*XO2*CH3CO3 + .8*r281*XO2*CH3O2 + r283*XO2*NO + r284*XO2*NO3 + + .65*r288*BENZENE*OH + r290*BENZO2*NO + r295*BZOO*NO + .73*r299*CRESOL*OH + + .07*r300*DICARBO2*HO2 + .17*r301*DICARBO2*NO + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + + .33*r306*MDIALO2*HO2 + .83*r307*MDIALO2*NO + r310*PHENO2*NO + .8*r311*PHENOL*OH + r317*TOLO2*NO + + .28*r319*TOLUENE*OH + .38*r321*XYLENES*OH + r323*XYLENO2*NO + r326*XYLOLO2*NO + + .63*r327*XYLOL*OH + .57*r330*BCARY*O3 + .57*r333*MTERP*O3 + .5*r335*NTERPO2*CH3O2 + + r340*TERP2O2*CH3O2 + .9*r342*TERP2O2*NO + r345*TERPO2*CH3O2 + .8*r347*TERPO2*NO + + .2*r351*TERPROD2*OH + r357*M*SO2*OH + .5*r367*DMS*OH + - r371*HO2 - r22*H*HO2 - r23*H*HO2 - r24*H*HO2 - r26*O*HO2 - r27*O3*HO2 - r31*OH*HO2 + - 2*r36*HO2*HO2 - r48*NO3*HO2 - r53*NO*HO2 - r58*M*NO2*HO2 - r68*CL*HO2 - r69*CL*HO2 + - r75*CLO*HO2 - r101*BR*HO2 - r107*BRO*HO2 - r144*CH2O*HO2 - r150*CH3O2*HO2 - r157*HOCH2OO*HO2 + - r171*C2H5O2*HO2 - r182*CH3CO3*HO2 - r186*EO2*HO2 - r199*C3H7O2*HO2 - r208*PO2*HO2 + - r212*RO2*HO2 - r224*MACRO2*HO2 - r233*MCO3*HO2 - r237*MEKO2*HO2 - r247*ALKO2*HO2 + - r257*ISOPAO2*HO2 - r262*ISOPBO2*HO2 - r271*ISOPNO3*HO2 - r282*XO2*HO2 - r286*ACBZO2*HO2 + - r289*BENZO2*HO2 - r293*BZOO*HO2 - r296*C6H5O2*HO2 - r300*DICARBO2*HO2 - r303*MALO2*HO2 + - r306*MDIALO2*HO2 - r309*PHENO2*HO2 - r316*TOLO2*HO2 - r322*XYLENO2*HO2 - r325*XYLOLO2*HO2 + - r336*NTERPO2*HO2 - r341*TERP2O2*HO2 - r346*TERPO2*HO2 d(HO2NO2)/dt = r58*M*NO2*HO2 - j10*HO2NO2 - j11*HO2NO2 - r62*M*HO2NO2 - r37*OH*HO2NO2 - d(HOBR)/dt = r400*BRONO2 + r403*BRONO2 + r408*BRONO2 + r107*BRO*HO2 - - j106*HOBR - r115*O*HOBR - r406*HCL*HOBR - r411*HCL*HOBR - d(HOCL)/dt = r402*CLONO2 + r407*CLONO2 + r413*CLONO2 + r75*CLO*HO2 + r80*CLONO2*OH - - j107*HOCL - r86*CL*HOCL - r87*O*HOCL - r88*OH*HOCL - r399*HCL*HOCL - r405*HCL*HOCL - - r410*HCL*HOCL + d(HOBR)/dt = r414*BRONO2 + r417*BRONO2 + r422*BRONO2 + r107*BRO*HO2 + - j106*HOBR - r115*O*HOBR - r420*HCL*HOBR - r425*HCL*HOBR + d(HOCL)/dt = r416*CLONO2 + r421*CLONO2 + r427*CLONO2 + r75*CLO*HO2 + r80*CLONO2*OH + - j107*HOCL - r86*CL*HOCL - r87*O*HOCL - r88*OH*HOCL - r413*HCL*HOCL - r419*HCL*HOCL + - r424*HCL*HOCL d(HONITR)/dt = r220*ENEO2*NO + r227*MACRO2*NO + .3*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH - j46*HONITR - r372*HONITR - r221*OH*HONITR d(HPALD)/dt = r263*ISOPBO2 @@ -1481,15 +1552,12 @@ Extraneous prod/loss species - r373*ISOPNITA - r266*OH*ISOPNITA d(ISOPNITB)/dt = .08*r264*ISOPBO2*NO - r374*ISOPNITB - r267*OH*ISOPNITB - d(ISOPNO3)/dt = r268*ISOP*NO3 - - r269*CH3CO3*ISOPNO3 - r270*CH3O2*ISOPNO3 - r271*HO2*ISOPNO3 - r272*NO*ISOPNO3 - - r273*NO3*ISOPNO3 d(ISOPNOOH)/dt = r271*ISOPNO3*HO2 - j49*ISOPNOOH - r274*OH*ISOPNOOH d(ISOPOOH)/dt = j49*ISOPNOOH + r257*ISOPAO2*HO2 + r262*ISOPBO2*HO2 - j50*ISOPOOH - r277*OH*ISOPOOH - d(IVOC)/dt = - r391*OH*IVOC - d(MACR)/dt = .288*j50*ISOPOOH + .39*r255*ISOPAO2*CH3CO3 + .31*r256*ISOPAO2*CH3O2 + .36*r258*ISOPAO2*NO + d(IVOC)/dt = - r399*OH*IVOC + d(MACR)/dt = .3*j50*ISOPOOH + .39*r255*ISOPAO2*CH3CO3 + .31*r256*ISOPAO2*CH3O2 + .36*r258*ISOPAO2*NO + .4*r259*ISOPAO2*NO3 + .3*r275*ISOP*O3 - j51*MACR - j52*MACR - r228*O3*MACR - r229*OH*MACR d(MACROOH)/dt = r224*MACRO2*HO2 @@ -1501,16 +1569,16 @@ Extraneous prod/loss species d(MPAN)/dt = r244*M*MCO3*NO2 - j55*MPAN - r245*M*MPAN - r241*M*OH*MPAN d(MTERP)/dt = - r332*NO3*MTERP - r333*O3*MTERP - r334*OH*MTERP - d(MVK)/dt = .402*j50*ISOPOOH + .61*r255*ISOPAO2*CH3CO3 + .44*r256*ISOPAO2*CH3O2 + .56*r258*ISOPAO2*NO + d(MVK)/dt = .7*j50*ISOPOOH + .61*r255*ISOPAO2*CH3CO3 + .44*r256*ISOPAO2*CH3O2 + .56*r258*ISOPAO2*NO + .6*r259*ISOPAO2*NO3 + .2*r275*ISOP*O3 - j56*MVK - r242*O3*MVK - r243*OH*MVK - d(N)/dt = .8*j112*N2 + j115*N2 + j116*N2 + .8*j118*N2 + j15*NO + r428*N2*Op + r38*N2D*O + .2*r415*NOp*e - + 1.1*r417*N2p*e + r421*Np*O + r422*Np*O2 - - j111*N - r40*NO*N - r41*NO2*N - r42*NO2*N - r43*NO2*N - r44*O2*N - r52*OH*N - r424*O2p*N + d(N)/dt = .8*j112*N2 + j115*N2 + j116*N2 + .8*j118*N2 + j15*NO + r442*N2*Op + r38*N2D*O + .2*r429*NOp*e + + 1.1*r431*N2p*e + r435*Np*O + r436*Np*O2 + - j111*N - r40*NO*N - r41*NO2*N - r42*NO2*N - r43*NO2*N - r44*O2*N - r52*OH*N - r438*O2p*N d(N2O)/dt = r41*N*NO2 - j12*N2O - r56*O1D*N2O - r57*O1D*N2O d(N2O5)/dt = r59*M*NO2*NO3 - - j13*N2O5 - j14*N2O5 - r63*M*N2O5 - r375*N2O5 - r398*N2O5 - r401*N2O5 - r412*N2O5 + - j13*N2O5 - j14*N2O5 - r63*M*N2O5 - r375*N2O5 - r412*N2O5 - r415*N2O5 - r426*N2O5 d(NC4CH2OH)/dt = .2*r270*ISOPNO3*CH3O2 - r376*NC4CH2OH - r278*OH*NC4CH2OH d(NC4CHO)/dt = r269*ISOPNO3*CH3CO3 + .8*r270*ISOPNO3*CH3O2 + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 @@ -1520,24 +1588,24 @@ Extraneous prod/loss species d(ncl_a3)/dt = 0 d(NH3)/dt = - r369*OH*NH3 d(NH4)/dt = - r378*NH4 - d(NH_5)/dt = - r432*NH_5 - d(NH_50)/dt = - r431*NH_50 - d(NO)/dt = j14*N2O5 + j17*NO2 + j19*NO3 + .5*r379*NO2 + r425*N2*O2p + r39*N2D*O2 + 2*r42*N*NO2 + r44*N*O2 - + r45*NO2*O + r52*N*OH + 2*r56*O1D*N2O + r361*SO*NO2 + d(NH_5)/dt = - r446*NH_5 + d(NH_50)/dt = - r445*NH_50 + d(NO)/dt = j14*N2O5 + j17*NO2 + j19*NO3 + .5*r379*NO2 + r439*N2*O2p + r39*N2D*O2 + 2*r42*N*NO2 + r44*N*O2 + + r45*NO2*O + r52*N*OH + 2*r56*O1D*N2O + r362*SO*NO2 - j15*NO - j16*NO - r40*N*NO - r49*NO3*NO - r53*HO2*NO - r54*O3*NO - r55*M*O*NO - r76*CLO*NO - - r108*BRO*NO - r151*CH3O2*NO - r160*HOCH2OO*NO - r173*C2H5O2*NO - r184*CH3CO3*NO - r188*EO2*NO - - r201*C3H7O2*NO - r209*PO2*NO - r213*RO2*NO - r219*ENEO2*NO - r220*ENEO2*NO - r226*MACRO2*NO + - r108*BRO*NO - r151*CH3O2*NO - r159*HOCH2OO*NO - r172*C2H5O2*NO - r183*CH3CO3*NO - r187*EO2*NO + - r200*C3H7O2*NO - r209*PO2*NO - r213*RO2*NO - r219*ENEO2*NO - r220*ENEO2*NO - r226*MACRO2*NO - r227*MACRO2*NO - r235*MCO3*NO - r238*MEKO2*NO - r248*ALKO2*NO - r249*ALKO2*NO - r258*ISOPAO2*NO - r264*ISOPBO2*NO - r272*ISOPNO3*NO - r283*XO2*NO - r287*ACBZO2*NO - r290*BENZO2*NO - r295*BZOO*NO - r297*C6H5O2*NO - r301*DICARBO2*NO - r304*MALO2*NO - r307*MDIALO2*NO - r310*PHENO2*NO - r317*TOLO2*NO - r323*XYLENO2*NO - r326*XYLOLO2*NO - r337*NTERPO2*NO - - r342*TERP2O2*NO - r347*TERPO2*NO - r426*O2p*NO + - r342*TERP2O2*NO - r347*TERPO2*NO - r440*O2p*NO d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j20*ALKNIT + j46*HONITR + j49*ISOPNOOH + j55*MPAN + j57*NC4CHO + j58*NOA + j59*NTERPOOH + j60*ONITR + .6*j61*PAN + j67*TERPNIT + j77*BRONO2 - + j96*CLONO2 + r62*M*HO2NO2 + r63*M*N2O5 + r196*M*PAN + r245*M*MPAN + r320*M*PBZNIT + + j96*CLONO2 + r62*M*HO2NO2 + r63*M*N2O5 + r195*M*PAN + r245*M*MPAN + r320*M*PBZNIT + r37*HO2NO2*OH + r48*NO3*HO2 + 2*r49*NO3*NO + r50*NO3*O + r51*NO3*OH + r53*NO*HO2 + r54*NO*O3 - + r55*M*NO*O + r76*CLO*NO + r108*BRO*NO + r151*CH3O2*NO + r160*HOCH2OO*NO + r173*C2H5O2*NO - + r184*CH3CO3*NO + r188*EO2*NO + r201*C3H7O2*NO + r207*NOA*OH + r209*PO2*NO + r213*RO2*NO + + r55*M*NO*O + r76*CLO*NO + r108*BRO*NO + r151*CH3O2*NO + r159*HOCH2OO*NO + r172*C2H5O2*NO + + r183*CH3CO3*NO + r187*EO2*NO + r200*C3H7O2*NO + r207*NOA*OH + r209*PO2*NO + r213*RO2*NO + r217*BIGENE*NO3 + r219*ENEO2*NO + r225*MACRO2*NO3 + r226*MACRO2*NO + r235*MCO3*NO + r236*MCO3*NO3 + r238*MEKO2*NO + r246*ALKNIT*OH + r248*ALKO2*NO + .92*r258*ISOPAO2*NO + r259*ISOPAO2*NO3 + .92*r264*ISOPBO2*NO + r265*ISOPBO2*NO3 + .7*r266*ISOPNITA*OH @@ -1548,17 +1616,17 @@ Extraneous prod/loss species + r344*TERPNIT*OH + .8*r347*TERPO2*NO - j17*NO2 - r379*NO2 - r41*N*NO2 - r42*N*NO2 - r43*N*NO2 - r45*O*NO2 - r46*O3*NO2 - r47*M*O*NO2 - r58*M*HO2*NO2 - r59*M*NO3*NO2 - r60*M*OH*NO2 - r78*M*CLO*NO2 - r109*M*BRO*NO2 - - r195*M*CH3CO3*NO2 - r244*M*MCO3*NO2 - r302*M*DICARBO2*NO2 - r305*M*MALO2*NO2 - - r308*M*MDIALO2*NO2 - r312*PHENO*NO2 - r315*M*ACBZO2*NO2 - r361*SO*NO2 + - r194*M*CH3CO3*NO2 - r244*M*MCO3*NO2 - r302*M*DICARBO2*NO2 - r305*M*MALO2*NO2 + - r308*M*MDIALO2*NO2 - r312*PHENO*NO2 - r315*M*ACBZO2*NO2 - r362*SO*NO2 d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j61*PAN + j78*BRONO2 + j95*CLONO2 + r63*M*N2O5 + r46*NO2*O3 + r47*M*NO2*O + r61*HNO3*OH + r77*CLONO2*CL + r79*CLONO2*O + r80*CLONO2*OH - + r110*BRONO2*O + r124*F*HNO3 + r193*PAN*OH + .5*r241*M*MPAN*OH + + r110*BRONO2*O + r124*F*HNO3 + r192*PAN*OH + .5*r241*M*MPAN*OH - j18*NO3 - j19*NO3 - r380*NO3 - r48*HO2*NO3 - r49*NO*NO3 - r50*O*NO3 - r51*OH*NO3 - - r59*M*NO2*NO3 - r145*CH2O*NO3 - r178*CH3CHO*NO3 - r197*C3H6*NO3 - r204*CH3COCHO*NO3 + - r59*M*NO2*NO3 - r145*CH2O*NO3 - r177*CH3CHO*NO3 - r196*C3H6*NO3 - r203*CH3COCHO*NO3 - r217*BIGENE*NO3 - r225*MACRO2*NO3 - r236*MCO3*NO3 - r259*ISOPAO2*NO3 - r265*ISOPBO2*NO3 - r268*ISOP*NO3 - r273*ISOPNO3*NO3 - r284*XO2*NO3 - r329*BCARY*NO3 - r332*MTERP*NO3 - r338*NTERPO2*NO3 - r349*TERPROD1*NO3 - r352*DMS*NO3 - d(NOA)/dt = r197*C3H6*NO3 + .5*r267*ISOPNITB*OH + r274*ISOPNOOH*OH + r278*NC4CH2OH*OH + r279*NC4CHO*OH + d(NOA)/dt = r196*C3H6*NO3 + .5*r267*ISOPNITB*OH + r274*ISOPNOOH*OH + r278*NC4CH2OH*OH + r279*NC4CHO*OH - j58*NOA - r207*OH*NOA d(NTERPOOH)/dt = r336*NTERPO2*HO2 - j59*NTERPOOH - r381*NTERPOOH - r339*OH*NTERPOOH @@ -1566,38 +1634,38 @@ Extraneous prod/loss species d(num_a2)/dt = 0 d(num_a3)/dt = 0 d(num_a4)/dt = 0 - d(O)/dt = j2*H2O + 2*j5*O2 + j6*O2 + j8*O3 + j14*N2O5 + j15*NO + j17*NO2 + j18*NO3 + .18*j41*CH4 + d(O)/dt = j2*H2O + 2*j5*O2 + j6*O2 + j8*O3 + j14*N2O5 + j15*NO + j17*NO2 + j18*NO3 + .18*j40*CH4 + j42*CO2 + j76*BRO + j94*CLO + j108*OCLO + j110*CO2 + j127*O2 + j128*O2 + j129*O2 + j131*O2 + j132*O2 + j133*O2 + 2*j134*O2 + 2*j135*O2 + j138*SO + j139*SO2 + j140*SO3 + r5*N2*O1D + r6*O1D*O2 + r7*O1D*O2 + r24*H*HO2 + r34*OH*OH + r40*N*NO + r41*N*NO2 + r44*N*O2 + r356*S*O2 - + r362*SO*O2 + r415*NOp*e + 1.15*r416*O2p*e + r423*Np*O2 + r424*O2p*N + r429*Op*O2 + + r363*SO*O2 + r429*NOp*e + 1.15*r430*O2p*e + r437*Np*O2 + r438*O2p*N + r443*Op*O2 - j120*O - j121*O - j122*O - j123*O - j124*O - j125*O - r17*O3*O - 2*r18*M*O*O - r19*M*O2*O - r20*H2*O - r21*H2O2*O - r26*HO2*O - r32*OH*O - r45*NO2*O - r47*M*NO2*O - r50*NO3*O - r55*M*NO*O - r79*CLONO2*O - r81*CLO*O - r84*HCL*O - r87*HOCL*O - r110*BRONO2*O - r111*BRO*O - - r113*HBR*O - r115*HOBR*O - r146*CH2O*O - r354*OCS*O - r419*N2p*O - r420*N2p*O - r421*Np*O + - r113*HBR*O - r115*HOBR*O - r146*CH2O*O - r354*OCS*O - r433*N2p*O - r434*N2p*O - r435*Np*O d(O2)/dt = j8*O3 + j19*NO3 + r1*O2_1D + r2*O2_1S + r9*N2*O2_1D + r8*O1D*O3 + r8*O1D*O3 + r10*O2_1D*O + 2*r11*O2_1D*O2 + 2*r17*O*O3 + r18*M*O*O + r22*H*HO2 + r26*HO2*O + 2*r27*HO2*O3 + r28*H*O3 + r31*OH*HO2 + r32*OH*O + r33*OH*O3 + r36*HO2*HO2 + r37*HO2NO2*OH + r43*N*NO2 + r45*NO2*O + r46*NO2*O3 + r48*NO3*HO2 + r50*NO3*O + r54*NO*O3 + r57*O1D*N2O + r68*CL*HO2 + r70*CL*O3 + r72*CLO*CLO + r73*CLO*CLO + r75*CLO*HO2 + r81*CLO*O + r83*CLO*OH + r101*BR*HO2 + r102*BR*O3 + r103*BRO*BRO + r105*BRO*CLO + r106*BRO*CLO + r107*BRO*HO2 + r111*BRO*O + r150*CH3O2*HO2 - + r172*C2H5O2*HO2 + r200*C3H7O2*HO2 + r208*PO2*HO2 + r357*S*O3 + r363*SO*O3 + r426*O2p*NO + + r171*C2H5O2*HO2 + r199*C3H7O2*HO2 + r208*PO2*HO2 + r358*S*O3 + r364*SO*O3 + r440*O2p*NO - j5*O2 - j6*O2 - j126*O2 - j127*O2 - j128*O2 - j129*O2 - j130*O2 - j131*O2 - j132*O2 - j133*O2 - j134*O2 - j135*O2 - r6*O1D*O2 - r11*O2_1D*O2 - r19*M*O*O2 - r25*M*H*O2 - r39*N2D*O2 - - r44*N*O2 - r190*EO*O2 - r356*S*O2 - r362*SO*O2 - r418*N2p*O2 - r422*Np*O2 - r423*Np*O2 - - r429*Op*O2 - d(O3)/dt = r19*M*O*O2 + .15*r183*CH3CO3*HO2 + .15*r233*MCO3*HO2 + - r44*N*O2 - r189*EO*O2 - r356*S*O2 - r363*SO*O2 - r432*N2p*O2 - r436*Np*O2 - r437*Np*O2 + - r443*Op*O2 + d(O3)/dt = r19*M*O*O2 + .15*r182*CH3CO3*HO2 + .15*r233*MCO3*HO2 - j7*O3 - j8*O3 - r8*O1D*O3 - r17*O*O3 - r27*HO2*O3 - r28*H*O3 - r33*OH*O3 - r46*NO2*O3 - - r54*NO*O3 - r70*CL*O3 - r102*BR*O3 - r169*C2H4*O3 - r198*C3H6*O3 - r228*MACR*O3 - r242*MVK*O3 - - r275*ISOP*O3 - r313*PHENO*O3 - r330*BCARY*O3 - r333*MTERP*O3 - r357*S*O3 - r363*SO*O3 + - r54*NO*O3 - r70*CL*O3 - r102*BR*O3 - r168*C2H4*O3 - r197*C3H6*O3 - r228*MACR*O3 - r242*MVK*O3 + - r275*ISOP*O3 - r313*PHENO*O3 - r330*BCARY*O3 - r333*MTERP*O3 - r358*S*O3 - r364*SO*O3 d(O3S)/dt = 0 d(OCLO)/dt = r74*CLO*CLO + r104*BRO*CLO - - j108*OCLO - r364*SO*OCLO + - j108*OCLO - r365*SO*OCLO d(OCS)/dt = - j137*OCS - r354*O*OCS - r355*OH*OCS d(ONITR)/dt = r221*HONITR*OH + .1*r342*TERP2O2*NO - j60*ONITR - r382*ONITR - d(PAN)/dt = r195*M*CH3CO3*NO2 - - j61*PAN - r196*M*PAN - r193*OH*PAN + d(PAN)/dt = r194*M*CH3CO3*NO2 + - j61*PAN - r195*M*PAN - r192*OH*PAN d(PBZNIT)/dt = r315*M*ACBZO2*NO2 - r320*M*PBZNIT d(PHENO)/dt = j32*C6H5OOH + r297*C6H5O2*NO + .07*r299*CRESOL*OH + .06*r311*PHENOL*OH + .07*r327*XYLOL*OH @@ -1613,15 +1681,15 @@ Extraneous prod/loss species d(ROOH)/dt = .85*r212*RO2*HO2 - j64*ROOH - r214*OH*ROOH d(S)/dt = j137*OCS + j138*SO - - r356*O2*S - r357*O3*S - r360*OH*S + - r356*O2*S - r358*O3*S - r361*OH*S d(SF6)/dt = - j109*SF6 - d(SO)/dt = j139*SO2 + r354*OCS*O + r356*S*O2 + r357*S*O3 + r360*S*OH - - j138*SO - r358*BRO*SO - r359*CLO*SO - r361*NO2*SO - r362*O2*SO - r363*O3*SO - r364*OCLO*SO - - r365*OH*SO - d(SO2)/dt = j140*SO3 + r352*DMS*NO3 + r353*DMS*OH + r355*OCS*OH + r358*SO*BRO + r359*SO*CLO + r361*SO*NO2 - + r362*SO*O2 + r363*SO*O3 + r364*SO*OCLO + r365*SO*OH + .5*r366*DMS*OH - - j139*SO2 - r367*OH*SO2 - d(SO3)/dt = j136*H2SO4 + r367*SO2*OH + d(SO)/dt = j139*SO2 + r354*OCS*O + r356*S*O2 + r358*S*O3 + r361*S*OH + - j138*SO - r359*BRO*SO - r360*CLO*SO - r362*NO2*SO - r363*O2*SO - r364*O3*SO - r365*OCLO*SO + - r366*OH*SO + d(SO2)/dt = j140*SO3 + r352*DMS*NO3 + r353*DMS*OH + r355*OCS*OH + r359*SO*BRO + r360*SO*CLO + r362*SO*NO2 + + r363*SO*O2 + r364*SO*O3 + r365*SO*OCLO + r366*SO*OH + .5*r367*DMS*OH + - j139*SO2 - r357*M*OH*SO2 + d(SO3)/dt = j136*H2SO4 + r357*M*SO2*OH - j140*SO3 - r368*H2O*SO3 d(so4_a1)/dt = 0 d(so4_a2)/dt = 0 @@ -1636,25 +1704,39 @@ Extraneous prod/loss species d(soa4_a2)/dt = - j148*soa4_a2 d(soa5_a1)/dt = - j149*soa5_a1 d(soa5_a2)/dt = - j150*soa5_a2 - d(SOAG0)/dt = r370*GLYOXAL + .2202*r385*BCARY*O3 + .2202*r386*BCARY*OH + .0023*r387*BENZENE*OH - + .0031*r390*ISOP*OH + .2381*r391*IVOC*OH + .0508*r393*MTERP*O3 + .0508*r394*MTERP*OH - + .5931*r395*SVOC*OH + .1364*r396*TOLUENE*OH + .1677*r397*XYLENES*OH - d(SOAG1)/dt = .2067*r385*BCARY*O3 + .2067*r386*BCARY*OH + .0008*r387*BENZENE*OH + .0035*r390*ISOP*OH - + .1308*r391*IVOC*OH + .1149*r393*MTERP*O3 + .1149*r394*MTERP*OH + .1534*r395*SVOC*OH - + .0101*r396*TOLUENE*OH + .0174*r397*XYLENES*OH - d(SOAG2)/dt = .0653*r385*BCARY*O3 + .0653*r386*BCARY*OH + .0843*r387*BENZENE*OH + .0003*r390*ISOP*OH - + .0348*r391*IVOC*OH + .0348*r393*MTERP*O3 + .0348*r394*MTERP*OH + .0459*r395*SVOC*OH - + .0763*r396*TOLUENE*OH + .086*r397*XYLENES*OH - d(SOAG3)/dt = .17493*r384*BCARY*NO3 + .1284*r385*BCARY*O3 + .1284*r386*BCARY*OH + .0443*r387*BENZENE*OH - + .059024*r388*ISOP*NO3 + .0033*r389*ISOP*O3 + .0271*r390*ISOP*OH + .0076*r391*IVOC*OH - + .17493*r392*MTERP*NO3 + .0554*r393*MTERP*O3 + .0554*r394*MTERP*OH + .0085*r395*SVOC*OH - + .2157*r396*TOLUENE*OH + .0512*r397*XYLENES*OH - d(SOAG4)/dt = .59019*r384*BCARY*NO3 + .114*r385*BCARY*O3 + .114*r386*BCARY*OH + .1621*r387*BENZENE*OH - + .025024*r388*ISOP*NO3 + .0474*r390*ISOP*OH + .0113*r391*IVOC*OH + .59019*r392*MTERP*NO3 - + .1278*r393*MTERP*O3 + .1278*r394*MTERP*OH + .0128*r395*SVOC*OH + .0738*r396*TOLUENE*OH - + .1598*r397*XYLENES*OH - d(ST80_25)/dt = - r433*ST80_25 - d(SVOC)/dt = - r395*OH*SVOC + d(SOAG0)/dt = r370*GLYOXAL + .2202*r385*BCARYO2VBS*HO2 + .1279*r386*BCARYO2VBS*NO + .2202*r387*BCARY*O3 + + .0023*r390*BENZO2VBS*HO2 + .0097*r391*BENZO2VBS*NO + .0031*r393*ISOPO2VBS*HO2 + + .0003*r394*ISOPO2VBS*NO + .2381*r397*IVOCO2VBS*HO2 + .1056*r398*IVOCO2VBS*NO + + .0508*r401*MTERPO2VBS*HO2 + .0245*r402*MTERPO2VBS*NO + .0508*r403*MTERP*O3 + + .5931*r405*SVOC*OH + .1364*r407*TOLUO2VBS*HO2 + .0154*r408*TOLUO2VBS*NO + + .1677*r410*XYLEO2VBS*HO2 + .0063*r411*XYLEO2VBS*NO + d(SOAG1)/dt = .2067*r385*BCARYO2VBS*HO2 + .1792*r386*BCARYO2VBS*NO + .2067*r387*BCARY*O3 + + .0008*r390*BENZO2VBS*HO2 + .0034*r391*BENZO2VBS*NO + .0035*r393*ISOPO2VBS*HO2 + + .0003*r394*ISOPO2VBS*NO + .1308*r397*IVOCO2VBS*HO2 + .1026*r398*IVOCO2VBS*NO + + .1149*r401*MTERPO2VBS*HO2 + .0082*r402*MTERPO2VBS*NO + .1149*r403*MTERP*O3 + + .1534*r405*SVOC*OH + .0101*r407*TOLUO2VBS*HO2 + .0452*r408*TOLUO2VBS*NO + + .0174*r410*XYLEO2VBS*HO2 + .0237*r411*XYLEO2VBS*NO + d(SOAG2)/dt = .0653*r385*BCARYO2VBS*HO2 + .0676*r386*BCARYO2VBS*NO + .0653*r387*BCARY*O3 + + .0843*r390*BENZO2VBS*HO2 + .1579*r391*BENZO2VBS*NO + .0003*r393*ISOPO2VBS*HO2 + + .0073*r394*ISOPO2VBS*NO + .0348*r397*IVOCO2VBS*HO2 + .0521*r398*IVOCO2VBS*NO + + .0348*r401*MTERPO2VBS*HO2 + .0772*r402*MTERPO2VBS*NO + .0348*r403*MTERP*O3 + + .0459*r405*SVOC*OH + .0763*r407*TOLUO2VBS*HO2 + .0966*r408*TOLUO2VBS*NO + + .086*r410*XYLEO2VBS*HO2 + .0025*r411*XYLEO2VBS*NO + d(SOAG3)/dt = .17493*r384*BCARY*NO3 + .1284*r385*BCARYO2VBS*HO2 + .079*r386*BCARYO2VBS*NO + .1284*r387*BCARY*O3 + + .0443*r390*BENZO2VBS*HO2 + .0059*r391*BENZO2VBS*NO + .059024*r392*ISOP*NO3 + + .0271*r393*ISOPO2VBS*HO2 + .0057*r394*ISOPO2VBS*NO + .0033*r395*ISOP*O3 + + .0076*r397*IVOCO2VBS*HO2 + .0143*r398*IVOCO2VBS*NO + .17493*r400*MTERP*NO3 + + .0554*r401*MTERPO2VBS*HO2 + .0332*r402*MTERPO2VBS*NO + .0554*r403*MTERP*O3 + + .0085*r405*SVOC*OH + .2157*r407*TOLUO2VBS*HO2 + .0073*r408*TOLUO2VBS*NO + + .0512*r410*XYLEO2VBS*HO2 + .011*r411*XYLEO2VBS*NO + d(SOAG4)/dt = .59019*r384*BCARY*NO3 + .114*r385*BCARYO2VBS*HO2 + .1254*r386*BCARYO2VBS*NO + .114*r387*BCARY*O3 + + .1621*r390*BENZO2VBS*HO2 + .0536*r391*BENZO2VBS*NO + .025024*r392*ISOP*NO3 + + .0474*r393*ISOPO2VBS*HO2 + .0623*r394*ISOPO2VBS*NO + .0113*r397*IVOCO2VBS*HO2 + + .0166*r398*IVOCO2VBS*NO + .59019*r400*MTERP*NO3 + .1278*r401*MTERPO2VBS*HO2 + + .13*r402*MTERPO2VBS*NO + .1278*r403*MTERP*O3 + .0128*r405*SVOC*OH + .0738*r407*TOLUO2VBS*HO2 + + .238*r408*TOLUO2VBS*NO + .1598*r410*XYLEO2VBS*HO2 + .1185*r411*XYLEO2VBS*NO + d(ST80_25)/dt = - r447*ST80_25 + d(SVOC)/dt = - r405*OH*SVOC d(TEPOMUC)/dt = .1*r319*TOLUENE*OH + .23*r321*XYLENES*OH - j65*TEPOMUC d(TERP2OOH)/dt = r341*TERP2O2*HO2 @@ -1689,37 +1771,41 @@ Extraneous prod/loss species - r286*HO2*ACBZO2 - r287*NO*ACBZO2 - r315*M*NO2*ACBZO2 d(ALKO2)/dt = r250*ALKOOH*OH + r251*BIGALK*OH - r247*HO2*ALKO2 - r248*NO*ALKO2 - r249*NO*ALKO2 + d(BCARYO2VBS)/dt = r388*BCARY*OH + - r385*HO2*BCARYO2VBS - r386*NO*BCARYO2VBS d(BENZO2)/dt = .35*r288*BENZENE*OH + r291*BENZOOH*OH - r289*HO2*BENZO2 - r290*NO*BENZO2 + d(BENZO2VBS)/dt = r389*BENZENE*OH + - r390*HO2*BENZO2VBS - r391*NO*BENZO2VBS d(BZOO)/dt = r294*BZOOH*OH + .07*r319*TOLUENE*OH + .06*r321*XYLENES*OH - r293*HO2*BZOO - r295*NO*BZOO - d(C2H5O2)/dt = j53*MEK + .5*r175*C2H5OOH*OH + r176*C2H6*CL + r177*C2H6*OH - - 2*r170*C2H5O2*C2H5O2 - r171*CH3O2*C2H5O2 - r172*HO2*C2H5O2 - r173*NO*C2H5O2 - d(C3H7O2)/dt = r202*C3H7OOH*OH + r203*C3H8*OH - - r199*CH3O2*C3H7O2 - r200*HO2*C3H7O2 - r201*NO*C3H7O2 + d(C2H5O2)/dt = j53*MEK + .5*r174*C2H5OOH*OH + r175*C2H6*CL + r176*C2H6*OH + - 2*r169*C2H5O2*C2H5O2 - r170*CH3O2*C2H5O2 - r171*HO2*C2H5O2 - r172*NO*C2H5O2 + d(C3H7O2)/dt = r201*C3H7OOH*OH + r202*C3H8*OH + r205*CL*C3H8 + - r198*CH3O2*C3H7O2 - r199*HO2*C3H7O2 - r200*NO*C3H7O2 d(C6H5O2)/dt = .4*r286*ACBZO2*HO2 + r287*ACBZO2*NO + r298*C6H5OOH*OH + r313*PHENO*O3 - r296*HO2*C6H5O2 - r297*NO*C6H5O2 d(CH3CO3)/dt = .13*j24*BIGALD + j28*BIGALD4 + j36*CH3COCH3 + j37*CH3COCHO + .33*j46*HONITR + j48*HYAC + 1.34*j51*MACR + j53*MEK + j54*MEKOOH + .3*j56*MVK + j58*NOA + .6*j61*PAN + j64*ROOH - + .5*j65*TEPOMUC + .65*j70*TERPROD2 + r196*M*PAN + r178*CH3CHO*NO3 + r179*CH3CHO*OH - + .5*r186*CH3COOOH*OH + r204*CH3COCHO*NO3 + r205*CH3COCHO*OH + .3*r211*RO2*CH3O2 + + .5*j65*TEPOMUC + .65*j70*TERPROD2 + r195*M*PAN + r177*CH3CHO*NO3 + r178*CH3CHO*OH + + .5*r185*CH3COOOH*OH + r203*CH3COCHO*NO3 + r204*CH3COCHO*OH + .3*r211*RO2*CH3O2 + .15*r212*RO2*HO2 + r213*RO2*NO + .53*r222*MACRO2*CH3CO3 + .26*r223*MACRO2*CH3O2 + .53*r225*MACRO2*NO3 + .53*r226*MACRO2*NO + .1*r228*MACR*O3 + r232*MCO3*CH3O2 + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + r235*MCO3*NO + r236*MCO3*NO3 + .2*r237*MEKO2*HO2 + r238*MEKO2*NO + .28*r242*MVK*O3 + .08*r275*ISOP*O3 + .06*r330*BCARY*O3 + .06*r333*MTERP*O3 + .65*r351*TERPROD2*OH - - 2*r181*CH3CO3*CH3CO3 - r182*CH3O2*CH3CO3 - r183*HO2*CH3CO3 - r184*NO*CH3CO3 - - r195*M*NO2*CH3CO3 - r222*MACRO2*CH3CO3 - r255*ISOPAO2*CH3CO3 - r260*ISOPBO2*CH3CO3 + - 2*r180*CH3CO3*CH3CO3 - r181*CH3O2*CH3CO3 - r182*HO2*CH3CO3 - r183*NO*CH3CO3 + - r194*M*NO2*CH3CO3 - r222*MACRO2*CH3CO3 - r255*ISOPAO2*CH3CO3 - r260*ISOPBO2*CH3CO3 - r269*ISOPNO3*CH3CO3 - r280*XO2*CH3CO3 - d(CH3O2)/dt = j35*CH3CHO + j36*CH3COCH3 + j38*CH3COOOH + j40*CH4 + .3*j56*MVK + .4*j61*PAN + j88*CH3BR - + j90*CH3CL + r65*CL*CH4 + r121*F*CH4 + .7*r153*CH3OOH*OH + r154*CH4*OH + r161*O1D*CH4 - + 2*r181*CH3CO3*CH3CO3 + .9*r182*CH3CO3*CH3O2 + .45*r183*CH3CO3*HO2 + r184*CH3CO3*NO - + r185*CH3COOH*OH + .28*r198*C3H6*O3 + r222*MACRO2*CH3CO3 + r231*MCO3*CH3CO3 + d(CH3O2)/dt = j35*CH3CHO + j36*CH3COCH3 + j38*CH3COOOH + j41*CH4 + .3*j56*MVK + .4*j61*PAN + j88*CH3BR + + j90*CH3CL + r65*CL*CH4 + r121*F*CH4 + .7*r153*CH3OOH*OH + r154*CH4*OH + r160*O1D*CH4 + + 2*r180*CH3CO3*CH3CO3 + .9*r181*CH3CO3*CH3O2 + .45*r182*CH3CO3*HO2 + r183*CH3CO3*NO + + r184*CH3COOH*OH + .28*r197*C3H6*O3 + r222*MACRO2*CH3CO3 + r231*MCO3*CH3CO3 + r255*ISOPAO2*CH3CO3 + r260*ISOPBO2*CH3CO3 + r269*ISOPNO3*CH3CO3 + .05*r275*ISOP*O3 + r280*XO2*CH3CO3 + .33*r300*DICARBO2*HO2 + .83*r301*DICARBO2*NO + .07*r306*MDIALO2*HO2 + .17*r307*MDIALO2*NO - r71*CLO*CH3O2 - 2*r148*CH3O2*CH3O2 - 2*r149*CH3O2*CH3O2 - r150*HO2*CH3O2 - r151*NO*CH3O2 - - r171*C2H5O2*CH3O2 - r182*CH3CO3*CH3O2 - r199*C3H7O2*CH3O2 - r211*RO2*CH3O2 + - r170*C2H5O2*CH3O2 - r181*CH3CO3*CH3O2 - r198*C3H7O2*CH3O2 - r211*RO2*CH3O2 - r223*MACRO2*CH3O2 - r232*MCO3*CH3O2 - r256*ISOPAO2*CH3O2 - r261*ISOPBO2*CH3O2 - r270*ISOPNO3*CH3O2 - r281*XO2*CH3O2 - r335*NTERPO2*CH3O2 - r340*TERP2O2*CH3O2 - r345*TERPO2*CH3O2 @@ -1728,59 +1814,28 @@ Extraneous prod/loss species d(e)/dt = j113*N2 + j114*N2 + j115*N2 + j116*N2 + j117*N2 + j119*N2 + j16*NO + j111*N + j120*O + j121*O + j122*O + j123*O + j124*O + j125*O + j126*O2 + j127*O2 + j128*O2 + j129*O2 + j130*O2 + j131*O2 + j132*O2 + j133*O2 - - r415*NOp*e - r416*O2p*e - r417*N2p*e + - r429*NOp*e - r430*O2p*e - r431*N2p*e d(ENEO2)/dt = r218*BIGENE*OH - r219*NO*ENEO2 - r220*NO*ENEO2 - d(EO)/dt = j43*EOOH + .75*r188*EO2*NO - - r189*EO - r190*O2*EO - d(EO2)/dt = r194*M*C2H4*OH - - r187*HO2*EO2 - r188*NO*EO2 - d(HO2)/dt = j11*HO2NO2 + j20*ALKNIT + .9*j21*ALKOOH + j22*BENZOOH + 1.5*j23*BEPOMUC + .56*j24*BIGALD - + j25*BIGALD1 + .6*j26*BIGALD2 + .6*j27*BIGALD3 + j28*BIGALD4 + j29*BZOOH + j30*C2H5OOH - + j31*C3H7OOH + j35*CH3CHO + j37*CH3COCHO + 2*j44*GLYALD + 2*j45*GLYOXAL + .67*j46*HONITR - + j47*HPALD + j48*HYAC + j49*ISOPNOOH + j50*ISOPOOH + 1.34*j51*MACR + .66*j52*MACR + j57*NC4CHO - + j62*PHENOOH + j63*POOH + j65*TEPOMUC + j66*TERP2OOH + j67*TERPNIT + j68*TERPOOH - + j69*TERPROD1 + 1.2*j70*TERPROD2 + j71*TOLOOH + j73*XYLENOOH + j74*XYLOLOOH + r62*M*HO2NO2 - + r159*HOCH2OO + r189*EO + r263*ISOPBO2 + r21*H2O2*O + r25*M*H*O2 + r30*OH*H2O2 + r33*OH*O3 - + r51*NO3*OH + r64*CL*CH2O + r67*CL*H2O2 + r71*CLO*CH3O2 + r82*CLO*OH + r100*BR*CH2O - + r112*BRO*OH + r129*CH3BR*CL + r130*CH3BR*OH + r132*CH3CL*CL + r133*CH3CL*OH + r145*CH2O*NO3 - + r146*CH2O*O + 2*r148*CH3O2*CH3O2 + r151*CH3O2*NO + r152*CH3OH*OH + r155*M*CO*OH - + r156*M*HCN*OH + r157*HCOOH*OH + r160*HOCH2OO*NO + r162*O1D*CH4 + .35*r167*M*C2H2*OH - + .13*r169*C2H4*O3 + 1.2*r170*C2H5O2*C2H5O2 + r171*C2H5O2*CH3O2 + r173*C2H5O2*NO + r174*C2H5OH*OH - + r180*CH3CN*OH + .9*r182*CH3CO3*CH3O2 + .25*r188*EO2*NO + r190*EO*O2 + r191*GLYALD*OH - + r192*GLYOXAL*OH + .28*r198*C3H6*O3 + r199*C3H7O2*CH3O2 + r201*C3H7O2*NO + r206*HYAC*OH - + r209*PO2*NO + .3*r211*RO2*CH3O2 + r219*ENEO2*NO + r221*HONITR*OH + .47*r222*MACRO2*CH3CO3 - + .73*r223*MACRO2*CH3O2 + .47*r225*MACRO2*NO3 + .47*r226*MACRO2*NO + .14*r228*MACR*O3 - + .2*r230*MACROOH*OH + r232*MCO3*CH3O2 + .5*r241*M*MPAN*OH + .28*r242*MVK*O3 + r248*ALKO2*NO - + r255*ISOPAO2*CH3CO3 + r256*ISOPAO2*CH3O2 + .92*r258*ISOPAO2*NO + r259*ISOPAO2*NO3 - + r260*ISOPBO2*CH3CO3 + r261*ISOPBO2*CH3O2 + .92*r264*ISOPBO2*NO + r265*ISOPBO2*NO3 - + .3*r266*ISOPNITA*OH + r267*ISOPNITB*OH + r269*ISOPNO3*CH3CO3 + 1.2*r270*ISOPNO3*CH3O2 - + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + r274*ISOPNOOH*OH + .37*r275*ISOP*O3 + r278*NC4CH2OH*OH - + r279*NC4CHO*OH + r280*XO2*CH3CO3 + .8*r281*XO2*CH3O2 + r283*XO2*NO + r284*XO2*NO3 - + .65*r288*BENZENE*OH + r290*BENZO2*NO + r295*BZOO*NO + .73*r299*CRESOL*OH - + .07*r300*DICARBO2*HO2 + .17*r301*DICARBO2*NO + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO - + .33*r306*MDIALO2*HO2 + .83*r307*MDIALO2*NO + r310*PHENO2*NO + .8*r311*PHENOL*OH + r317*TOLO2*NO - + .28*r319*TOLUENE*OH + .38*r321*XYLENES*OH + r323*XYLENO2*NO + r326*XYLOLO2*NO - + .63*r327*XYLOL*OH + .57*r330*BCARY*O3 + .57*r333*MTERP*O3 + .5*r335*NTERPO2*CH3O2 - + r340*TERP2O2*CH3O2 + .9*r342*TERP2O2*NO + r345*TERPO2*CH3O2 + .8*r347*TERPO2*NO - + .2*r351*TERPROD2*OH + .5*r366*DMS*OH + r367*SO2*OH - - r371*HO2 - r22*H*HO2 - r23*H*HO2 - r24*H*HO2 - r26*O*HO2 - r27*O3*HO2 - r31*OH*HO2 - - 2*r36*HO2*HO2 - r48*NO3*HO2 - r53*NO*HO2 - r58*M*NO2*HO2 - r68*CL*HO2 - r69*CL*HO2 - - r75*CLO*HO2 - r101*BR*HO2 - r107*BRO*HO2 - r144*CH2O*HO2 - r150*CH3O2*HO2 - r158*HOCH2OO*HO2 - - r172*C2H5O2*HO2 - r183*CH3CO3*HO2 - r187*EO2*HO2 - r200*C3H7O2*HO2 - r208*PO2*HO2 - - r212*RO2*HO2 - r224*MACRO2*HO2 - r233*MCO3*HO2 - r237*MEKO2*HO2 - r247*ALKO2*HO2 - - r257*ISOPAO2*HO2 - r262*ISOPBO2*HO2 - r271*ISOPNO3*HO2 - r282*XO2*HO2 - r286*ACBZO2*HO2 - - r289*BENZO2*HO2 - r293*BZOO*HO2 - r296*C6H5O2*HO2 - r300*DICARBO2*HO2 - r303*MALO2*HO2 - - r306*MDIALO2*HO2 - r309*PHENO2*HO2 - r316*TOLO2*HO2 - r322*XYLENO2*HO2 - r325*XYLOLO2*HO2 - - r336*NTERPO2*HO2 - r341*TERP2O2*HO2 - r346*TERPO2*HO2 + d(EO)/dt = j43*EOOH + .75*r187*EO2*NO + - r188*EO - r189*O2*EO + d(EO2)/dt = r193*M*C2H4*OH + - r186*HO2*EO2 - r187*NO*EO2 d(HOCH2OO)/dt = r144*CH2O*HO2 - - r159*HOCH2OO - r158*HO2*HOCH2OO - r160*NO*HOCH2OO + - r158*HOCH2OO - r157*HO2*HOCH2OO - r159*NO*HOCH2OO d(ISOPAO2)/dt = .6*r276*ISOP*OH - r255*CH3CO3*ISOPAO2 - r256*CH3O2*ISOPAO2 - r257*HO2*ISOPAO2 - r258*NO*ISOPAO2 - r259*NO3*ISOPAO2 d(ISOPBO2)/dt = .4*r276*ISOP*OH - r263*ISOPBO2 - r260*CH3CO3*ISOPBO2 - r261*CH3O2*ISOPBO2 - r262*HO2*ISOPBO2 - r264*NO*ISOPBO2 - r265*NO3*ISOPBO2 + d(ISOPNO3)/dt = r268*ISOP*NO3 + - r269*CH3CO3*ISOPNO3 - r270*CH3O2*ISOPNO3 - r271*HO2*ISOPNO3 - r272*NO*ISOPNO3 + - r273*NO3*ISOPNO3 + d(ISOPO2VBS)/dt = r396*ISOP*OH + - r393*HO2*ISOPO2VBS - r394*NO*ISOPO2VBS + d(IVOCO2VBS)/dt = r399*IVOC*OH + - r397*HO2*IVOCO2VBS - r398*NO*IVOCO2VBS d(MACRO2)/dt = .5*r229*MACR*OH + .2*r230*MACROOH*OH + r243*MVK*OH - r222*CH3CO3*MACRO2 - r223*CH3O2*MACRO2 - r224*HO2*MACRO2 - r225*NO3*MACRO2 - r226*NO*MACRO2 - r227*NO*MACRO2 @@ -1793,51 +1848,53 @@ Extraneous prod/loss species - r306*HO2*MDIALO2 - r307*NO*MDIALO2 - r308*M*NO2*MDIALO2 d(MEKO2)/dt = r239*MEK*OH + r240*MEKOOH*OH - r237*HO2*MEKO2 - r238*NO*MEKO2 - d(N2D)/dt = 1.2*j112*N2 + j113*N2 + j117*N2 + 1.2*j118*N2 + .8*r415*NOp*e + .9*r417*N2p*e + r419*N2p*O + d(MTERPO2VBS)/dt = r404*MTERP*OH + - r401*HO2*MTERPO2VBS - r402*NO*MTERPO2VBS + d(N2D)/dt = 1.2*j112*N2 + j113*N2 + j117*N2 + 1.2*j118*N2 + .8*r429*NOp*e + .9*r431*N2p*e + r433*N2p*O - r38*O*N2D - r39*O2*N2D d(N2p)/dt = j114*N2 + j119*N2 - - r417*e*N2p - r418*O2*N2p - r419*O*N2p - r420*O*N2p - d(NOp)/dt = j16*NO + r425*N2*O2p + r428*N2*Op + r419*N2p*O + r423*Np*O2 + r424*O2p*N + r426*O2p*NO - - r415*e*NOp + - r431*e*N2p - r432*O2*N2p - r433*O*N2p - r434*O*N2p + d(NOp)/dt = j16*NO + r439*N2*O2p + r442*N2*Op + r433*N2p*O + r437*Np*O2 + r438*O2p*N + r440*O2p*NO + - r429*e*NOp d(Np)/dt = j113*N2 + j115*N2 + j116*N2 + j117*N2 + j111*N - - r421*O*Np - r422*O2*Np - r423*O2*Np + - r435*O*Np - r436*O2*Np - r437*O2*Np d(NTERPO2)/dt = r329*BCARY*NO3 + r332*MTERP*NO3 + r339*NTERPOOH*OH + .5*r349*TERPROD1*NO3 - r335*CH3O2*NTERPO2 - r336*HO2*NTERPO2 - r337*NO*NTERPO2 - r338*NO3*NTERPO2 - d(O1D)/dt = j1*H2O + j6*O2 + j7*O3 + j12*N2O + r39*N2D*O2 + .85*r416*O2p*e + d(O1D)/dt = j1*H2O + j6*O2 + j7*O3 + j12*N2O + r39*N2D*O2 + .85*r430*O2p*e - r5*N2*O1D - r3*H2*O1D - r4*H2O*O1D - r6*O2*O1D - r7*O2*O1D - r8*O3*O1D - r56*N2O*O1D - r57*N2O*O1D - r89*CCL4*O1D - r90*CF2CLBR*O1D - r91*CFC11*O1D - r92*CFC113*O1D - r93*CFC114*O1D - r94*CFC115*O1D - r95*CFC12*O1D - r96*HCL*O1D - r97*HCL*O1D - r116*CF3BR*O1D - r117*CHBR3*O1D - r118*H2402*O1D - r119*HBR*O1D - r120*HBR*O1D - r125*COF2*O1D - r126*COFCL*O1D - r139*CH2BR2*O1D - r140*CH3BR*O1D - r141*HCFC141B*O1D - r142*HCFC142B*O1D - r143*HCFC22*O1D - - r161*CH4*O1D - r162*CH4*O1D - r163*CH4*O1D - r164*HCN*O1D + - r160*CH4*O1D - r161*CH4*O1D - r162*CH4*O1D - r163*HCN*O1D d(O2_1D)/dt = j7*O3 + r13*N2*O2_1S + r12*O2_1S*CO2 + r14*O2_1S*O + r15*O2_1S*O2 + r16*O2_1S*O3 - r1*O2_1D - r9*N2*O2_1D - r10*O*O2_1D - r11*O2*O2_1D d(O2_1S)/dt = r6*O1D*O2 - r2*O2_1S - r13*N2*O2_1S - r12*CO2*O2_1S - r14*O*O2_1S - r15*O2*O2_1S - r16*O3*O2_1S - d(O2p)/dt = j126*O2 + j130*O2 + r418*N2p*O2 + r422*Np*O2 + r427*Op*CO2 + r429*Op*O2 - - r425*N2*O2p - r416*e*O2p - r424*N*O2p - r426*NO*O2p + d(O2p)/dt = j126*O2 + j130*O2 + r432*N2p*O2 + r436*Np*O2 + r441*Op*CO2 + r443*Op*O2 + - r439*N2*O2p - r430*e*O2p - r438*N*O2p - r440*NO*O2p d(OH)/dt = j3*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j21*ALKOOH + j22*BENZOOH + j29*BZOOH + j30*C2H5OOH - + j31*C3H7OOH + j32*C6H5OOH + j38*CH3COOOH + j39*CH3OOH + .33*j41*CH4 + j43*EOOH + j47*HPALD - + j54*MEKOOH + j59*NTERPOOH + j62*PHENOOH + j63*POOH + j64*ROOH + j66*TERP2OOH + j68*TERPOOH - + j71*TOLOOH + j72*XOOH + j73*XYLENOOH + j74*XYLOLOOH + j106*HOBR + j107*HOCL + .5*r379*NO2 - + r3*O1D*H2 + 2*r4*O1D*H2O + r20*H2*O + r21*H2O2*O + 2*r23*H*HO2 + r26*HO2*O + r27*HO2*O3 - + r28*H*O3 + r48*NO3*HO2 + r53*NO*HO2 + r69*CL*HO2 + r84*HCL*O + r87*HOCL*O + r96*O1D*HCL - + r113*HBR*O + r115*HOBR*O + r119*O1D*HBR + r123*F*H2O + r146*CH2O*O + .3*r153*CH3OOH*OH - + r161*O1D*CH4 + r164*O1D*HCN + .65*r167*M*C2H2*OH + .13*r169*C2H4*O3 + .5*r175*C2H5OOH*OH - + .45*r183*CH3CO3*HO2 + .36*r198*C3H6*O3 + .5*r210*POOH*OH + .15*r212*RO2*HO2 + .24*r228*MACR*O3 - + .1*r230*MACROOH*OH + .45*r233*MCO3*HO2 + .2*r237*MEKO2*HO2 + .36*r242*MVK*O3 + .32*r275*ISOP*O3 - + .6*r277*ISOPOOH*OH + .5*r285*XOOH*OH + .4*r286*ACBZO2*HO2 + .4*r300*DICARBO2*HO2 - + .4*r306*MDIALO2*HO2 + .63*r330*BCARY*O3 + .63*r333*MTERP*O3 + + j31*C3H7OOH + j32*C6H5OOH + j38*CH3COOOH + j39*CH3OOH + .33*j40*CH4 + j43*EOOH + j47*HPALD + + j50*ISOPOOH + j54*MEKOOH + j59*NTERPOOH + j62*PHENOOH + j63*POOH + j64*ROOH + j66*TERP2OOH + + j68*TERPOOH + j71*TOLOOH + j72*XOOH + j73*XYLENOOH + j74*XYLOLOOH + j106*HOBR + j107*HOCL + + .5*r379*NO2 + r3*O1D*H2 + 2*r4*O1D*H2O + r20*H2*O + r21*H2O2*O + 2*r23*H*HO2 + r26*HO2*O + + r27*HO2*O3 + r28*H*O3 + r48*NO3*HO2 + r53*NO*HO2 + r69*CL*HO2 + r84*HCL*O + r87*HOCL*O + + r96*O1D*HCL + r113*HBR*O + r115*HOBR*O + r119*O1D*HBR + r123*F*H2O + r146*CH2O*O + + .3*r153*CH3OOH*OH + r160*O1D*CH4 + r163*O1D*HCN + .65*r166*M*C2H2*OH + .13*r168*C2H4*O3 + + .5*r174*C2H5OOH*OH + .45*r182*CH3CO3*HO2 + .36*r197*C3H6*O3 + .5*r210*POOH*OH + .15*r212*RO2*HO2 + + .24*r228*MACR*O3 + .1*r230*MACROOH*OH + .45*r233*MCO3*HO2 + .2*r237*MEKO2*HO2 + .36*r242*MVK*O3 + + .32*r275*ISOP*O3 + .6*r277*ISOPOOH*OH + .5*r285*XOOH*OH + .4*r286*ACBZO2*HO2 + + .4*r300*DICARBO2*HO2 + .4*r306*MDIALO2*HO2 + .63*r330*BCARY*O3 + .63*r333*MTERP*O3 - r29*H2*OH - r30*H2O2*OH - r31*HO2*OH - r32*O*OH - r33*O3*OH - 2*r34*OH*OH - 2*r35*M*OH*OH - r37*HO2NO2*OH - r51*NO3*OH - r52*N*OH - r60*M*NO2*OH - r61*HNO3*OH - r80*CLONO2*OH - r82*CLO*OH - r83*CLO*OH - r85*HCL*OH - r88*HOCL*OH - r112*BRO*OH - r114*HBR*OH - r128*CH2BR2*OH - r130*CH3BR*OH - r131*CH3CCL3*OH - r133*CH3CL*OH - r135*CHBR3*OH - r136*HCFC141B*OH - r137*HCFC142B*OH - r138*HCFC22*OH - r147*CH2O*OH - r152*CH3OH*OH - - r153*CH3OOH*OH - r154*CH4*OH - r155*M*CO*OH - r156*M*HCN*OH - r157*HCOOH*OH - r165*CO*OH - - r167*M*C2H2*OH - r174*C2H5OH*OH - r175*C2H5OOH*OH - r177*C2H6*OH - r179*CH3CHO*OH - - r180*CH3CN*OH - r185*CH3COOH*OH - r186*CH3COOOH*OH - r191*GLYALD*OH - r192*GLYOXAL*OH - - r193*PAN*OH - r194*M*C2H4*OH - r202*C3H7OOH*OH - r203*C3H8*OH - r205*CH3COCHO*OH - r206*HYAC*OH - - r207*NOA*OH - r210*POOH*OH - r214*ROOH*OH - r215*M*C3H6*OH - r216*CH3COCH3*OH - r218*BIGENE*OH + - r153*CH3OOH*OH - r154*CH4*OH - r155*M*HCN*OH - r156*HCOOH*OH - r164*CO*OH - r166*M*C2H2*OH + - r173*C2H5OH*OH - r174*C2H5OOH*OH - r176*C2H6*OH - r178*CH3CHO*OH - r179*CH3CN*OH + - r184*CH3COOH*OH - r185*CH3COOOH*OH - r190*GLYALD*OH - r191*GLYOXAL*OH - r192*PAN*OH + - r193*M*C2H4*OH - r201*C3H7OOH*OH - r202*C3H8*OH - r204*CH3COCHO*OH - r206*HYAC*OH - r207*NOA*OH + - r210*POOH*OH - r214*ROOH*OH - r215*M*C3H6*OH - r216*CH3COCH3*OH - r218*BIGENE*OH - r221*HONITR*OH - r229*MACR*OH - r230*MACROOH*OH - r239*MEK*OH - r240*MEKOOH*OH - r241*M*MPAN*OH - r243*MVK*OH - r246*ALKNIT*OH - r250*ALKOOH*OH - r251*BIGALK*OH - r252*HPALD*OH - r253*HYDRALD*OH - r254*IEPOX*OH - r266*ISOPNITA*OH - r267*ISOPNITB*OH - r274*ISOPNOOH*OH @@ -1846,11 +1903,11 @@ Extraneous prod/loss species - r299*CRESOL*OH - r311*PHENOL*OH - r314*PHENOOH*OH - r318*TOLOOH*OH - r319*TOLUENE*OH - r321*XYLENES*OH - r324*XYLENOOH*OH - r327*XYLOL*OH - r328*XYLOLOOH*OH - r331*BCARY*OH - r334*MTERP*OH - r339*NTERPOOH*OH - r343*TERP2OOH*OH - r344*TERPNIT*OH - r348*TERPOOH*OH - - r350*TERPROD1*OH - r351*TERPROD2*OH - r353*DMS*OH - r355*OCS*OH - r360*S*OH - r365*SO*OH - - r366*DMS*OH - r367*SO2*OH - r369*NH3*OH + - r350*TERPROD1*OH - r351*TERPROD2*OH - r353*DMS*OH - r355*OCS*OH - r357*M*SO2*OH - r361*S*OH + - r366*SO*OH - r367*DMS*OH - r369*NH3*OH d(Op)/dt = j120*O + j121*O + j122*O + j123*O + j124*O + j125*O + j127*O2 + j128*O2 + j129*O2 + j131*O2 - + j132*O2 + j133*O2 + r420*N2p*O + r421*Np*O - - r428*N2*Op - r427*CO2*Op - r429*O2*Op + + j132*O2 + j133*O2 + r434*N2p*O + r435*Np*O + - r442*N2*Op - r441*CO2*Op - r443*O2*Op d(PHENO2)/dt = .2*r299*CRESOL*OH + .14*r311*PHENOL*OH + r314*PHENOOH*OH - r309*HO2*PHENO2 - r310*NO*PHENO2 d(PO2)/dt = .5*r210*POOH*OH + r215*M*C3H6*OH @@ -1864,17 +1921,21 @@ Extraneous prod/loss species - r345*CH3O2*TERPO2 - r346*HO2*TERPO2 - r347*NO*TERPO2 d(TOLO2)/dt = r318*TOLOOH*OH + .65*r319*TOLUENE*OH - r316*HO2*TOLO2 - r317*NO*TOLO2 + d(TOLUO2VBS)/dt = r406*TOLUENE*OH + - r407*HO2*TOLUO2VBS - r408*NO*TOLUO2VBS d(XO2)/dt = r252*HPALD*OH + r253*HYDRALD*OH + r254*IEPOX*OH + .4*r277*ISOPOOH*OH + .5*r285*XOOH*OH - r280*CH3CO3*XO2 - r281*CH3O2*XO2 - r282*HO2*XO2 - r283*NO*XO2 - r284*NO3*XO2 d(XYLENO2)/dt = .56*r321*XYLENES*OH + r324*XYLENOOH*OH - r322*HO2*XYLENO2 - r323*NO*XYLENO2 + d(XYLEO2VBS)/dt = r409*XYLENES*OH + - r410*HO2*XYLEO2VBS - r411*NO*XYLEO2VBS d(XYLOLO2)/dt = .3*r327*XYLOL*OH + r328*XYLOLOOH*OH - r325*HO2*XYLOLO2 - r326*NO*XYLOLO2 - d(H2O)/dt = .05*j41*CH4 + j136*H2SO4 + r24*H*HO2 + r29*OH*H2 + r30*OH*H2O2 + r31*OH*HO2 + r34*OH*OH - + r37*HO2NO2*OH + r61*HNO3*OH + r85*HCL*OH + r88*HOCL*OH + r114*HBR*OH + r128*CH2BR2*OH - + r130*CH3BR*OH + r131*CH3CCL3*OH + r133*CH3CL*OH + r138*HCFC22*OH + r147*CH2O*OH - + r153*CH3OOH*OH + r154*CH4*OH + r157*HCOOH*OH + r177*C2H6*OH + r179*CH3CHO*OH + r185*CH3COOH*OH - + r186*CH3COOOH*OH + r202*C3H7OOH*OH + r203*C3H8*OH + r205*CH3COCHO*OH + r210*POOH*OH - + r214*ROOH*OH + r216*CH3COCH3*OH + .5*r229*MACR*OH + r369*NH3*OH + r399*HOCL*HCL - + r405*HOCL*HCL + r406*HOBR*HCL + r410*HOCL*HCL + r411*HOBR*HCL + d(H2O)/dt = .05*j40*CH4 + j136*H2SO4 + r371*HO2 + r24*H*HO2 + r29*OH*H2 + r30*OH*H2O2 + r31*OH*HO2 + + r34*OH*OH + r37*HO2NO2*OH + r61*HNO3*OH + r85*HCL*OH + r88*HOCL*OH + r114*HBR*OH + + r128*CH2BR2*OH + r130*CH3BR*OH + r131*CH3CCL3*OH + r133*CH3CL*OH + r138*HCFC22*OH + + r147*CH2O*OH + r153*CH3OOH*OH + r154*CH4*OH + r156*HCOOH*OH + r176*C2H6*OH + r178*CH3CHO*OH + + r184*CH3COOH*OH + r185*CH3COOOH*OH + r201*C3H7OOH*OH + r202*C3H8*OH + r204*CH3COCHO*OH + + r210*POOH*OH + r214*ROOH*OH + r216*CH3COCH3*OH + .5*r229*MACR*OH + r369*NH3*OH + r413*HOCL*HCL + + r419*HOCL*HCL + r420*HOBR*HCL + r424*HOCL*HCL + r425*HOBR*HCL - j1*H2O - j2*H2O - j3*H2O - r4*O1D*H2O - r123*F*H2O - r368*SO3*H2O diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in index afecb26800..a3f7459a50 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in +++ b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mech.in @@ -1,11 +1,11 @@ * Comments -* User-given Tag Description: TSMLT1 for CESM2.2 -* Tag database identifier : MZ262_TSMLT1_20190611 +* User-given Tag Description: TSMLT1.2-simpleVBS +* Tag database identifier : MZ317_TSMLT1.2_simpleVBS_20221220 * Tag created by : lke -* Tag created from branch : TSMLT1 -* Tag created on : 2019-06-11 17:30:44.906645-06 +* Tag created from branch : TSMLT1.2-simpleVBS +* Tag created on : 2022-12-20 13:51:46.133926-07 * Comments for this tag follow: -* lke : 2019-06-11 : TSMLT for CESM2, correcting TERP2OOH chemical formula, and TOLUENE+OH VBS coefficient. With O3S. +* lke : 2022-12-20 : TSMLT1 with JPL19 updates, NOx-dependent VBS-SOA SPECIES @@ -99,6 +99,7 @@ HCOOH, HF, HNO3, + HO2, HO2NO2, HOBR -> HOBr, HOCL -> HOCl, @@ -110,7 +111,6 @@ ISOP -> C5H8, ISOPNITA -> C5H9NO4, ISOPNITB -> C5H9NO4, - ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ISOPNOOH -> C5H9NO5, ISOPOOH -> HOCH2COOHCH3CHCH2, IVOC -> C13H28, @@ -200,7 +200,9 @@ NDEP -> N, ACBZO2 -> C7H5O3, ALKO2 -> C5H11O2, + BCARYO2VBS -> C15H25O3, BENZO2 -> C6H7O5, + BENZO2VBS -> C6H7O5, BZOO -> C7H7O2, C2H5O2, C3H7O2, @@ -212,15 +214,18 @@ ENEO2 -> C4H9O3, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, - HO2, HOCH2OO, ISOPAO2 -> HOC5H8O2, ISOPBO2 -> HOC5H8O2, + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, + ISOPO2VBS -> C5H9O3, + IVOCO2VBS -> C13H29O3, MACRO2 -> CH3COCHO2CH2OH, MALO2 -> C4H3O4, MCO3 -> CH2CCH3CO3, MDIALO2 -> C4H5O4, MEKO2 -> C4H7O3, + MTERPO2VBS -> C10H17O3, N2D -> N, N2p -> N2, NOp -> NO, @@ -238,8 +243,10 @@ TERP2O2 -> C10H15O4, TERPO2 -> C10H17O3, TOLO2 -> C7H9O5, + TOLUO2VBS -> C7H9O5, XO2 -> HOCH2COOCH3CHOHCHO, XYLENO2 -> C8H11O5, + XYLEO2VBS -> C8H11O5, XYLOLO2 -> C8H11O6, H2O @@ -258,7 +265,9 @@ Not-Transported ACBZO2, ALKO2, + BCARYO2VBS, BENZO2, + BENZO2VBS, BZOO, C2H5O2, C3H7O2, @@ -270,15 +279,18 @@ ENEO2, EO, EO2, - HO2, HOCH2OO, ISOPAO2, ISOPBO2, + ISOPNO3, + ISOPO2VBS, + IVOCO2VBS, MACRO2, MALO2, MCO3, MDIALO2, MEKO2, + MTERPO2VBS, N2D, N2p, NOp, @@ -296,8 +308,10 @@ TERP2O2, TERPO2, TOLO2, + TOLUO2VBS, XO2, XYLENO2, + XYLEO2VBS, XYLOLO2 End Not-Transported @@ -306,42 +320,14 @@ Solution classes Explicit - AOA_NH - BRY - CCL4 - CF2CLBR - CF3BR - CFC11 - CFC113 - CFC114 - CFC115 - CFC12 - CH2BR2 - CH3BR - CH3CCL3 - CH3CL - CH4 - CHBR3 - CLY - CO2 - E90 - H2402 - HCFC141B - HCFC142B - HCFC22 - N2O - NH_5 - NH_50 - SF6 - ST80_25 NHDEP NDEP - O3S End Explicit Implicit ALKNIT ALKOOH + AOA_NH bc_a1 bc_a4 BCARY @@ -359,6 +345,7 @@ BRCL BRO BRONO2 + BRY BZALD BZOOH C2H2 @@ -370,8 +357,20 @@ C3H7OOH C3H8 C6H5OOH + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 CH2O + CH3BR + CH3CCL3 CH3CHO + CH3CL CH3CN CH3COCH3 CH3COCHO @@ -379,12 +378,16 @@ CH3COOOH CH3OH CH3OOH + CH4 + CHBR3 CL CL2 CL2O2 CLO CLONO2 + CLY CO + CO2 COF2 COFCL CRESOL @@ -392,20 +395,26 @@ dst_a1 dst_a2 dst_a3 + E90 EOOH F GLYALD GLYOXAL H H2 + H2402 H2O2 H2SO4 HBR + HCFC141B + HCFC142B + HCFC22 HCL HCN HCOOH HF HNO3 + HO2 HO2NO2 HOBR HOCL @@ -417,7 +426,6 @@ ISOP ISOPNITA ISOPNITB - ISOPNO3 ISOPNOOH ISOPOOH IVOC @@ -429,6 +437,7 @@ MTERP MVK N + N2O N2O5 NC4CH2OH NC4CHO @@ -437,6 +446,8 @@ ncl_a3 NH3 NH4 + NH_5 + NH_50 NO NO2 NO3 @@ -449,6 +460,7 @@ O O2 O3 + O3S OCLO OCS ONITR @@ -462,6 +474,7 @@ POOH ROOH S + SF6 SO SO2 SO3 @@ -483,6 +496,7 @@ SOAG2 SOAG3 SOAG4 + ST80_25 SVOC TEPOMUC TERP2OOH @@ -499,7 +513,9 @@ XYLOLOOH ACBZO2 ALKO2 + BCARYO2VBS BENZO2 + BENZO2VBS BZOO C2H5O2 C3H7O2 @@ -511,15 +527,18 @@ ENEO2 EO EO2 - HO2 HOCH2OO ISOPAO2 ISOPBO2 + ISOPNO3 + ISOPO2VBS + IVOCO2VBS MACRO2 MALO2 MCO3 MDIALO2 MEKO2 + MTERPO2VBS N2D N2p NOp @@ -537,8 +556,10 @@ TERP2O2 TERPO2 TOLO2 + TOLUO2VBS XO2 XYLENO2 + XYLEO2VBS XYLOLO2 H2O End Implicit @@ -589,15 +610,15 @@ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 [jc6h5ooh->,jch3ooh] C6H5OOH + hv -> PHENO + OH -[jch2o_a] CH2O + hv -> CO + 2*H [jch2o_b] CH2O + hv -> CO + H2 +[jch2o_a] CH2O + hv -> CO + 2*H [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_a] CH4 + hv -> H + CH3O2 [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 @@ -606,7 +627,7 @@ [jhpald->,.006*jno2] HPALD + hv -> BIGALD3 + OH + HO2 [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O [jisopnooh->,jch3ooh] ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH -[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.402*MVK + 0.288*MACR + 0.69*CH2O + HO2 +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + 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 [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 @@ -752,7 +773,7 @@ [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 ; 4.4e-32, 1.3, 7.5e-11, -0.2, 0.6 +[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 @@ -767,23 +788,23 @@ ********************************* *** odd-nitrogen ********************************* -[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380 +[HO2NO2_OH] HO2NO2 + OH -> H2O + NO2 + O2 ; 4.5e-13, 610 [N2D_O,cph=229.61] N2D + O -> N + O ; 7e-13 [N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5e-12 [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 ; 1.5e-11, -3600 +[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.5e-11, 170 -[NO3_O] NO3 + O -> NO2 + O2 ; 1e-11 +[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.3e-12, 270 +[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 @@ -900,8 +921,7 @@ [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 -[CO_OH_M] CO + OH + M -> CO2 + HO2 + M ; 5.9e-33, 1, 1.1e-12, -1.3, 0.6 -[HCN_OH] HCN + OH + M -> HO2 + M ; 4.28e-33, 0, 9.3e-15, -4.42, 0.8 +[HCN_OH] HCN + OH + M -> HO2 + M ; 6.1e-33, 1.5, 9.8e-15, -4.6, 0.8 [HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4e-13 [HOCH2OO_HO2] HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 [HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.4e+12, -7000 @@ -910,7 +930,7 @@ [O1D_CH4b] O1D + CH4 -> CH2O + H + HO2 ; 3.5e-11 [O1D_CH4c] O1D + CH4 -> CH2O + H2 ; 9e-12 [O1D_HCN] O1D + HCN -> OH ; 1.08e-10, 105 -[usr_CO_OH_b] CO + OH -> CO2 + H +[usr_CO_OH] CO + OH -> CO2 + HO2 ********************************* *** C2 ********************************* @@ -933,7 +953,7 @@ [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 ; 7e-13 +[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 @@ -943,7 +963,7 @@ [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 ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[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 @@ -954,9 +974,10 @@ [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 ; 8.7e-12, -615 +[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 +[CL_C3H8] CL + C3H8 -> C3H7O2 + HCL ; 1.45e-10 [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 @@ -998,7 +1019,7 @@ [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 -[usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M +[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 @@ -1119,10 +1140,11 @@ *** Sulfur ********************************* [DMS_NO3] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520 -[DMS_OHa] DMS + OH -> SO2 ; 9.6e-12, -234 +[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 @@ -1131,16 +1153,15 @@ [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.7e-11, 335 +[SO_OH] SO + OH -> SO2 + H ; 2.6e-11, 330 [usr_DMS_OH] DMS + OH -> 0.5*SO2 + 0.5*HO2 -[usr_SO2_OH] SO2 + OH -> SO3 + HO2 [usr_SO3_H2O] SO3 + H2O -> H2SO4 ********************************* *** Tropospheric Aerosol ********************************* [NH3_OH] NH3 + OH -> H2O + 1*NHDEP ; 1.7e-12, -710 [usr_GLYOXAL_aer] GLYOXAL -> SOAG0 -[usr_HO2_aer] HO2 -> 0.5*H2O2 +[usr_HO2_aer] HO2 -> H2O [usr_HONITR_aer] HONITR -> HNO3 [usr_ISOPNITA_aer] ISOPNITA -> HNO3 [usr_ISOPNITB_aer] ISOPNITB -> HNO3 @@ -1157,19 +1178,33 @@ *** SOA ********************************* [BCARY_NO3_vbs] BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.9e-11 +[BCARYO2_HO2_vbs] BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 2.75e-13, 1300 +[BCARYO2_NO_vbs] BCARYO2VBS + NO -> NO + 0.1279*SOAG0 + 0.1792*SOAG1 + 0.0676*SOAG2 + 0.079*SOAG3 + 0.1254*SOAG4 ; 2.7e-12, 360 [BCARY_O3_vbs] BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 1.2e-14 -[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 2e-10 -[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 + 0.0443*SOAG3 + 0.1621*SOAG4 ; 2.3e-12, -193 +[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + BCARYO2VBS ; 2e-10 +[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + BENZO2VBS ; 2.3e-12, -193 +[BENZO2_HO2_vbs] BENZO2VBS + HO2 -> HO2 + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 + 0.0443*SOAG3 + 0.1621*SOAG4 ; 7.5e-13, 700 +[BENZO2_NO_vbs] BENZO2VBS + NO -> NO + 0.0097*SOAG0 + 0.0034*SOAG1 + 0.1579*SOAG2 + 0.0059*SOAG3 + 0.0536*SOAG4 ; 2.6e-12, 365 [ISOP_NO3_vbs] ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 ; 3.03e-12, -446 +[ISOPO2_HO2_vbs] ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 + 0.0271*SOAG3 + 0.0474*SOAG4 ; 2.12e-13, 1300 +[ISOPO2_NO_vbs] ISOPO2VBS + NO -> NO + 0.0003*SOAG0 + 0.0003*SOAG1 + 0.0073*SOAG2 + 0.0057*SOAG3 + 0.0623*SOAG4 ; 2.7e-12, 350 [ISOP_O3_vbs] ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 ; 1.05e-14, -2000 -[ISOP_OH_vbs] ISOP + OH -> ISOP + OH + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 + 0.0271*SOAG3 + 0.0474*SOAG4 ; 2.54e-11, 410 -[IVOC_OH] IVOC + OH -> OH + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 + 0.0076*SOAG3 + 0.0113*SOAG4 ; 1.34e-11 +[ISOP_OH_vbs] ISOP + OH -> ISOP + OH + ISOPO2VBS ; 2.54e-11, 410 +[IVOCO2_HO2_vbs] IVOCO2VBS + HO2 -> HO2 + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 + 0.0076*SOAG3 + 0.0113*SOAG4 ; 7.5e-13, 700 +[IVOCO2_NO_vbs] IVOCO2VBS + NO -> NO + 0.1056*SOAG0 + 0.1026*SOAG1 + 0.0521*SOAG2 + 0.0143*SOAG3 + 0.0166*SOAG4 ; 2.6e-12, 365 +[IVOC_OH_vbs] IVOC + OH -> OH + IVOCO2VBS ; 1.34e-11 [MTERP_NO3_vbs] MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.2e-12, 490 +[MTERPO2_HO2_vbs] MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 2.6e-13, 1300 +[MTERPO2_NO_vbs] MTERPO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 + 0.0332*SOAG3 + 0.13*SOAG4 ; 2.7e-12, 360 [MTERP_O3_vbs] MTERP + O3 -> MTERP + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 6.3e-16, -580 -[MTERP_OH_vbs] MTERP + OH -> MTERP + OH + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 1.2e-11, 440 +[MTERP_OH_vbs] MTERP + OH -> MTERP + OH + MTERPO2VBS ; 1.2e-11, 440 [SVOC_OH] SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 + 0.0085*SOAG3 + 0.0128*SOAG4 ; 1.34e-11 -[TOLUENE_OH_vbs] TOLUENE + OH -> TOLUENE + OH + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 + 0.2157*SOAG3 + 0.0738*SOAG4 ; 1.7e-12, 352 -[XYLENES_OH_vbs] XYLENES + OH -> XYLENES + OH + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 + 0.0512*SOAG3 + 0.1598*SOAG4 ; 1.7e-11 +[TOLUENE_OH_vbs] TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS ; 1.7e-12, 352 +[TOLUO2_HO2_vbs] TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 + 0.2157*SOAG3 + 0.0738*SOAG4 ; 7.5e-13, 700 +[TOLUO2_NO_vbs] TOLUO2VBS + NO -> NO + 0.0154*SOAG0 + 0.0452*SOAG1 + 0.0966*SOAG2 + 0.0073*SOAG3 + 0.238*SOAG4 ; 2.6e-12, 365 +[XYLENES_OH_vbs] XYLENES + OH -> XYLENES + OH + XYLEO2VBS ; 1.7e-11 +[XYLEO2_HO2_vbs] XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 + 0.0512*SOAG3 + 0.1598*SOAG4 ; 7.5e-13, 700 +[XYLEO2_NO_vbs] XYLEO2VBS + NO -> NO + 0.0063*SOAG0 + 0.0237*SOAG1 + 0.0025*SOAG2 + 0.011*SOAG3 + 0.1185*SOAG4 ; 2.6e-12, 365 ********************************* *** Stratospheric Aerosol ********************************* @@ -1218,29 +1253,26 @@ End Reactions Ext Forcing - NO2 <- dataset - NO <- dataset CO <- dataset - SO2 <- dataset SVOC <- dataset - so4_a1 <- dataset - so4_a2 <- dataset - pom_a1 <- dataset - pom_a4 <- dataset + SO2 <- dataset + NO2 <- dataset + NO <- dataset num_a1 <- dataset num_a2 <- dataset + so4_a1 <- dataset + so4_a2 <- dataset num_a4 <- dataset - bc_a1 <- dataset + pom_a4 <- dataset bc_a4 <- dataset - AOA_NH O2p - Np N2p N2D - e + AOA_NH N OH Op + e End Ext Forcing End Chemistry diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 index 336ce725db..4e429ebf0a 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/chem_mods.F90 @@ -6,26 +6,26 @@ module chem_mods implicit none save integer, parameter :: phtcnt = 150, & ! number of photolysis reactions - rxntot = 583, & ! number of total reactions - gascnt = 433, & ! number of gas phase reactions + rxntot = 597, & ! number of total reactions + gascnt = 447, & ! number of gas phase reactions nabscol = 2, & ! number of absorbing column densities - gas_pcnst = 232, & ! number of "gas phase" species + gas_pcnst = 239, & ! number of "gas phase" species nfs = 2, & ! number of "fixed" species relcnt = 0, & ! number of relationship species grpcnt = 0, & ! number of group members - nzcnt = 2170, & ! number of non-zero matrix entries - extcnt = 23, & ! number of species with external forcing - clscnt1 = 31, & ! number of species in explicit class + nzcnt = 2447, & ! number of non-zero matrix entries + extcnt = 20, & ! 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 = 201, & ! number of species in implicit class + clscnt4 = 237, & ! 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 = 583, & + rxt_tag_cnt = 597, & enthalpy_cnt = 41, & - nslvd = 43 + nslvd = 50 integer :: clscnt(5) = 0 integer :: cls_rxt_cnt(4,5) = 0 integer :: clsmap(gas_pcnst,5) = 0 diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 index 2a0cdc7b73..4b7f2809d8 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/m_rxt_id.F90 @@ -32,15 +32,15 @@ module m_rxt_id integer, parameter :: rid_jc2h5ooh = 30 integer, parameter :: rid_jc3h7ooh = 31 integer, parameter :: rid_jc6h5ooh = 32 - integer, parameter :: rid_jch2o_a = 33 - integer, parameter :: rid_jch2o_b = 34 + integer, parameter :: rid_jch2o_b = 33 + integer, parameter :: rid_jch2o_a = 34 integer, parameter :: rid_jch3cho = 35 integer, parameter :: rid_jacet = 36 integer, parameter :: rid_jmgly = 37 integer, parameter :: rid_jch3co3h = 38 integer, parameter :: rid_jch3ooh = 39 - integer, parameter :: rid_jch4_a = 40 - integer, parameter :: rid_jch4_b = 41 + integer, parameter :: rid_jch4_b = 40 + integer, parameter :: rid_jch4_a = 41 integer, parameter :: rid_jco2 = 42 integer, parameter :: rid_jeooh = 43 integer, parameter :: rid_jglyald = 44 @@ -304,57 +304,57 @@ module m_rxt_id integer, parameter :: rid_CH3OH_OH = 302 integer, parameter :: rid_CH3OOH_OH = 303 integer, parameter :: rid_CH4_OH = 304 - integer, parameter :: rid_CO_OH_M = 305 - integer, parameter :: rid_HCN_OH = 306 - integer, parameter :: rid_HCOOH_OH = 307 - integer, parameter :: rid_HOCH2OO_HO2 = 308 - integer, parameter :: rid_HOCH2OO_M = 309 - integer, parameter :: rid_HOCH2OO_NO = 310 - integer, parameter :: rid_O1D_CH4a = 311 - integer, parameter :: rid_O1D_CH4b = 312 - integer, parameter :: rid_O1D_CH4c = 313 - integer, parameter :: rid_O1D_HCN = 314 - integer, parameter :: rid_usr_CO_OH_b = 315 - integer, parameter :: rid_C2H2_CL_M = 316 - integer, parameter :: rid_C2H2_OH_M = 317 - integer, parameter :: rid_C2H4_CL_M = 318 - integer, parameter :: rid_C2H4_O3 = 319 - integer, parameter :: rid_C2H5O2_C2H5O2 = 320 - integer, parameter :: rid_C2H5O2_CH3O2 = 321 - integer, parameter :: rid_C2H5O2_HO2 = 322 - integer, parameter :: rid_C2H5O2_NO = 323 - integer, parameter :: rid_C2H5OH_OH = 324 - integer, parameter :: rid_C2H5OOH_OH = 325 - integer, parameter :: rid_C2H6_CL = 326 - integer, parameter :: rid_C2H6_OH = 327 - integer, parameter :: rid_CH3CHO_NO3 = 328 - integer, parameter :: rid_CH3CHO_OH = 329 - integer, parameter :: rid_CH3CN_OH = 330 - integer, parameter :: rid_CH3CO3_CH3CO3 = 331 - integer, parameter :: rid_CH3CO3_CH3O2 = 332 - integer, parameter :: rid_CH3CO3_HO2 = 333 - integer, parameter :: rid_CH3CO3_NO = 334 - integer, parameter :: rid_CH3COOH_OH = 335 - integer, parameter :: rid_CH3COOOH_OH = 336 - integer, parameter :: rid_EO2_HO2 = 337 - integer, parameter :: rid_EO2_NO = 338 - integer, parameter :: rid_EO_M = 339 - integer, parameter :: rid_EO_O2 = 340 - integer, parameter :: rid_GLYALD_OH = 341 - integer, parameter :: rid_GLYOXAL_OH = 342 - integer, parameter :: rid_PAN_OH = 343 - integer, parameter :: rid_tag_C2H4_OH = 344 - integer, parameter :: rid_tag_CH3CO3_NO2 = 345 - integer, parameter :: rid_usr_PAN_M = 346 - integer, parameter :: rid_C3H6_NO3 = 347 - integer, parameter :: rid_C3H6_O3 = 348 - integer, parameter :: rid_C3H7O2_CH3O2 = 349 - integer, parameter :: rid_C3H7O2_HO2 = 350 - integer, parameter :: rid_C3H7O2_NO = 351 - integer, parameter :: rid_C3H7OOH_OH = 352 - integer, parameter :: rid_C3H8_OH = 353 - integer, parameter :: rid_CH3COCHO_NO3 = 354 - integer, parameter :: rid_CH3COCHO_OH = 355 + integer, parameter :: rid_HCN_OH = 305 + integer, parameter :: rid_HCOOH_OH = 306 + integer, parameter :: rid_HOCH2OO_HO2 = 307 + integer, parameter :: rid_HOCH2OO_M = 308 + integer, parameter :: rid_HOCH2OO_NO = 309 + integer, parameter :: rid_O1D_CH4a = 310 + integer, parameter :: rid_O1D_CH4b = 311 + integer, parameter :: rid_O1D_CH4c = 312 + integer, parameter :: rid_O1D_HCN = 313 + integer, parameter :: rid_usr_CO_OH = 314 + integer, parameter :: rid_C2H2_CL_M = 315 + integer, parameter :: rid_C2H2_OH_M = 316 + integer, parameter :: rid_C2H4_CL_M = 317 + integer, parameter :: rid_C2H4_O3 = 318 + integer, parameter :: rid_C2H5O2_C2H5O2 = 319 + integer, parameter :: rid_C2H5O2_CH3O2 = 320 + integer, parameter :: rid_C2H5O2_HO2 = 321 + integer, parameter :: rid_C2H5O2_NO = 322 + integer, parameter :: rid_C2H5OH_OH = 323 + integer, parameter :: rid_C2H5OOH_OH = 324 + integer, parameter :: rid_C2H6_CL = 325 + integer, parameter :: rid_C2H6_OH = 326 + integer, parameter :: rid_CH3CHO_NO3 = 327 + integer, parameter :: rid_CH3CHO_OH = 328 + integer, parameter :: rid_CH3CN_OH = 329 + integer, parameter :: rid_CH3CO3_CH3CO3 = 330 + integer, parameter :: rid_CH3CO3_CH3O2 = 331 + integer, parameter :: rid_CH3CO3_HO2 = 332 + integer, parameter :: rid_CH3CO3_NO = 333 + integer, parameter :: rid_CH3COOH_OH = 334 + integer, parameter :: rid_CH3COOOH_OH = 335 + integer, parameter :: rid_EO2_HO2 = 336 + integer, parameter :: rid_EO2_NO = 337 + integer, parameter :: rid_EO_M = 338 + integer, parameter :: rid_EO_O2 = 339 + integer, parameter :: rid_GLYALD_OH = 340 + integer, parameter :: rid_GLYOXAL_OH = 341 + integer, parameter :: rid_PAN_OH = 342 + integer, parameter :: rid_tag_C2H4_OH = 343 + integer, parameter :: rid_tag_CH3CO3_NO2 = 344 + integer, parameter :: rid_usr_PAN_M = 345 + integer, parameter :: rid_C3H6_NO3 = 346 + integer, parameter :: rid_C3H6_O3 = 347 + integer, parameter :: rid_C3H7O2_CH3O2 = 348 + integer, parameter :: rid_C3H7O2_HO2 = 349 + integer, parameter :: rid_C3H7O2_NO = 350 + integer, parameter :: rid_C3H7OOH_OH = 351 + integer, parameter :: rid_C3H8_OH = 352 + integer, parameter :: rid_CH3COCHO_NO3 = 353 + integer, parameter :: rid_CH3COCHO_OH = 354 + integer, parameter :: rid_CL_C3H8 = 355 integer, parameter :: rid_HYAC_OH = 356 integer, parameter :: rid_NOA_OH = 357 integer, parameter :: rid_PO2_HO2 = 358 @@ -393,7 +393,7 @@ module m_rxt_id integer, parameter :: rid_MPAN_OH_M = 391 integer, parameter :: rid_MVK_O3 = 392 integer, parameter :: rid_MVK_OH = 393 - integer, parameter :: rid_usr_MCO3_NO2 = 394 + integer, parameter :: rid_tag_MCO3_NO2 = 394 integer, parameter :: rid_usr_MPAN_M = 395 integer, parameter :: rid_ALKNIT_OH = 396 integer, parameter :: rid_ALKO2_HO2 = 397 @@ -506,17 +506,17 @@ module m_rxt_id integer, parameter :: rid_OCS_O = 504 integer, parameter :: rid_OCS_OH = 505 integer, parameter :: rid_S_O2 = 506 - integer, parameter :: rid_S_O3 = 507 - integer, parameter :: rid_SO_BRO = 508 - integer, parameter :: rid_SO_CLO = 509 - integer, parameter :: rid_S_OH = 510 - integer, parameter :: rid_SO_NO2 = 511 - integer, parameter :: rid_SO_O2 = 512 - integer, parameter :: rid_SO_O3 = 513 - integer, parameter :: rid_SO_OCLO = 514 - integer, parameter :: rid_SO_OH = 515 - integer, parameter :: rid_usr_DMS_OH = 516 - integer, parameter :: rid_usr_SO2_OH = 517 + integer, parameter :: rid_SO2_OH_M = 507 + integer, parameter :: rid_S_O3 = 508 + integer, parameter :: rid_SO_BRO = 509 + integer, parameter :: rid_SO_CLO = 510 + integer, parameter :: rid_S_OH = 511 + integer, parameter :: rid_SO_NO2 = 512 + integer, parameter :: rid_SO_O2 = 513 + integer, parameter :: rid_SO_O3 = 514 + integer, parameter :: rid_SO_OCLO = 515 + integer, parameter :: rid_SO_OH = 516 + integer, parameter :: rid_usr_DMS_OH = 517 integer, parameter :: rid_usr_SO3_H2O = 518 integer, parameter :: rid_NH3_OH = 519 integer, parameter :: rid_usr_GLYOXAL_aer = 520 @@ -534,53 +534,67 @@ module m_rxt_id integer, parameter :: rid_usr_ONITR_aer = 532 integer, parameter :: rid_usr_TERPNIT_aer = 533 integer, parameter :: rid_BCARY_NO3_vbs = 534 - integer, parameter :: rid_BCARY_O3_vbs = 535 - integer, parameter :: rid_BCARY_OH_vbs = 536 - integer, parameter :: rid_BENZENE_OH_vbs = 537 - integer, parameter :: rid_ISOP_NO3_vbs = 538 - integer, parameter :: rid_ISOP_O3_vbs = 539 - integer, parameter :: rid_ISOP_OH_vbs = 540 - integer, parameter :: rid_IVOC_OH = 541 - integer, parameter :: rid_MTERP_NO3_vbs = 542 - integer, parameter :: rid_MTERP_O3_vbs = 543 - integer, parameter :: rid_MTERP_OH_vbs = 544 - integer, parameter :: rid_SVOC_OH = 545 - integer, parameter :: rid_TOLUENE_OH_vbs = 546 - integer, parameter :: rid_XYLENES_OH_vbs = 547 - integer, parameter :: rid_het1 = 548 - integer, parameter :: rid_het10 = 549 - integer, parameter :: rid_het11 = 550 - integer, parameter :: rid_het12 = 551 - integer, parameter :: rid_het13 = 552 - integer, parameter :: rid_het14 = 553 - integer, parameter :: rid_het15 = 554 - integer, parameter :: rid_het16 = 555 - integer, parameter :: rid_het17 = 556 - integer, parameter :: rid_het2 = 557 - integer, parameter :: rid_het3 = 558 - integer, parameter :: rid_het4 = 559 - integer, parameter :: rid_het5 = 560 - integer, parameter :: rid_het6 = 561 - integer, parameter :: rid_het7 = 562 - integer, parameter :: rid_het8 = 563 - integer, parameter :: rid_het9 = 564 - integer, parameter :: rid_elec1 = 565 - integer, parameter :: rid_elec2 = 566 - integer, parameter :: rid_elec3 = 567 - integer, parameter :: rid_ion_N2p_O2 = 568 - integer, parameter :: rid_ion_N2p_Oa = 569 - integer, parameter :: rid_ion_N2p_Ob = 570 - integer, parameter :: rid_ion_Np_O = 571 - integer, parameter :: rid_ion_Np_O2a = 572 - integer, parameter :: rid_ion_Np_O2b = 573 - integer, parameter :: rid_ion_O2p_N = 574 - integer, parameter :: rid_ion_O2p_N2 = 575 - integer, parameter :: rid_ion_O2p_NO = 576 - integer, parameter :: rid_ion_Op_CO2 = 577 - integer, parameter :: rid_ion_Op_N2 = 578 - integer, parameter :: rid_ion_Op_O2 = 579 - integer, parameter :: rid_E90_tau = 580 - integer, parameter :: rid_NH_50_tau = 581 - integer, parameter :: rid_NH_5_tau = 582 - integer, parameter :: rid_ST80_25_tau = 583 + integer, parameter :: rid_BCARYO2_HO2_vbs = 535 + integer, parameter :: rid_BCARYO2_NO_vbs = 536 + integer, parameter :: rid_BCARY_O3_vbs = 537 + integer, parameter :: rid_BCARY_OH_vbs = 538 + integer, parameter :: rid_BENZENE_OH_vbs = 539 + integer, parameter :: rid_BENZO2_HO2_vbs = 540 + integer, parameter :: rid_BENZO2_NO_vbs = 541 + integer, parameter :: rid_ISOP_NO3_vbs = 542 + integer, parameter :: rid_ISOPO2_HO2_vbs = 543 + integer, parameter :: rid_ISOPO2_NO_vbs = 544 + integer, parameter :: rid_ISOP_O3_vbs = 545 + integer, parameter :: rid_ISOP_OH_vbs = 546 + integer, parameter :: rid_IVOCO2_HO2_vbs = 547 + integer, parameter :: rid_IVOCO2_NO_vbs = 548 + integer, parameter :: rid_IVOC_OH_vbs = 549 + integer, parameter :: rid_MTERP_NO3_vbs = 550 + integer, parameter :: rid_MTERPO2_HO2_vbs = 551 + integer, parameter :: rid_MTERPO2_NO_vbs = 552 + integer, parameter :: rid_MTERP_O3_vbs = 553 + integer, parameter :: rid_MTERP_OH_vbs = 554 + integer, parameter :: rid_SVOC_OH = 555 + integer, parameter :: rid_TOLUENE_OH_vbs = 556 + integer, parameter :: rid_TOLUO2_HO2_vbs = 557 + integer, parameter :: rid_TOLUO2_NO_vbs = 558 + integer, parameter :: rid_XYLENES_OH_vbs = 559 + integer, parameter :: rid_XYLEO2_HO2_vbs = 560 + integer, parameter :: rid_XYLEO2_NO_vbs = 561 + integer, parameter :: rid_het1 = 562 + integer, parameter :: rid_het10 = 563 + integer, parameter :: rid_het11 = 564 + integer, parameter :: rid_het12 = 565 + integer, parameter :: rid_het13 = 566 + integer, parameter :: rid_het14 = 567 + integer, parameter :: rid_het15 = 568 + integer, parameter :: rid_het16 = 569 + integer, parameter :: rid_het17 = 570 + integer, parameter :: rid_het2 = 571 + integer, parameter :: rid_het3 = 572 + integer, parameter :: rid_het4 = 573 + integer, parameter :: rid_het5 = 574 + integer, parameter :: rid_het6 = 575 + integer, parameter :: rid_het7 = 576 + integer, parameter :: rid_het8 = 577 + integer, parameter :: rid_het9 = 578 + integer, parameter :: rid_elec1 = 579 + integer, parameter :: rid_elec2 = 580 + integer, parameter :: rid_elec3 = 581 + integer, parameter :: rid_ion_N2p_O2 = 582 + integer, parameter :: rid_ion_N2p_Oa = 583 + integer, parameter :: rid_ion_N2p_Ob = 584 + integer, parameter :: rid_ion_Np_O = 585 + integer, parameter :: rid_ion_Np_O2a = 586 + integer, parameter :: rid_ion_Np_O2b = 587 + integer, parameter :: rid_ion_O2p_N = 588 + integer, parameter :: rid_ion_O2p_N2 = 589 + integer, parameter :: rid_ion_O2p_NO = 590 + integer, parameter :: rid_ion_Op_CO2 = 591 + integer, parameter :: rid_ion_Op_N2 = 592 + integer, parameter :: rid_ion_Op_O2 = 593 + integer, parameter :: rid_E90_tau = 594 + integer, parameter :: rid_NH_50_tau = 595 + integer, parameter :: rid_NH_5_tau = 596 + integer, parameter :: rid_ST80_25_tau = 597 end module m_rxt_id diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 index 62af654e12..08c074bf0d 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/m_spc_id.F90 @@ -89,18 +89,18 @@ module m_spc_id integer, parameter :: id_HCOOH = 87 integer, parameter :: id_HF = 88 integer, parameter :: id_HNO3 = 89 - integer, parameter :: id_HO2NO2 = 90 - integer, parameter :: id_HOBR = 91 - integer, parameter :: id_HOCL = 92 - integer, parameter :: id_HONITR = 93 - integer, parameter :: id_HPALD = 94 - integer, parameter :: id_HYAC = 95 - integer, parameter :: id_HYDRALD = 96 - integer, parameter :: id_IEPOX = 97 - integer, parameter :: id_ISOP = 98 - integer, parameter :: id_ISOPNITA = 99 - integer, parameter :: id_ISOPNITB = 100 - integer, parameter :: id_ISOPNO3 = 101 + integer, parameter :: id_HO2 = 90 + integer, parameter :: id_HO2NO2 = 91 + integer, parameter :: id_HOBR = 92 + integer, parameter :: id_HOCL = 93 + integer, parameter :: id_HONITR = 94 + integer, parameter :: id_HPALD = 95 + integer, parameter :: id_HYAC = 96 + integer, parameter :: id_HYDRALD = 97 + integer, parameter :: id_IEPOX = 98 + integer, parameter :: id_ISOP = 99 + integer, parameter :: id_ISOPNITA = 100 + integer, parameter :: id_ISOPNITB = 101 integer, parameter :: id_ISOPNOOH = 102 integer, parameter :: id_ISOPOOH = 103 integer, parameter :: id_IVOC = 104 @@ -190,46 +190,53 @@ module m_spc_id integer, parameter :: id_NDEP = 188 integer, parameter :: id_ACBZO2 = 189 integer, parameter :: id_ALKO2 = 190 - integer, parameter :: id_BENZO2 = 191 - integer, parameter :: id_BZOO = 192 - integer, parameter :: id_C2H5O2 = 193 - integer, parameter :: id_C3H7O2 = 194 - integer, parameter :: id_C6H5O2 = 195 - integer, parameter :: id_CH3CO3 = 196 - integer, parameter :: id_CH3O2 = 197 - integer, parameter :: id_DICARBO2 = 198 - integer, parameter :: id_e = 199 - integer, parameter :: id_ENEO2 = 200 - integer, parameter :: id_EO = 201 - integer, parameter :: id_EO2 = 202 - integer, parameter :: id_HO2 = 203 - integer, parameter :: id_HOCH2OO = 204 - integer, parameter :: id_ISOPAO2 = 205 - integer, parameter :: id_ISOPBO2 = 206 - integer, parameter :: id_MACRO2 = 207 - integer, parameter :: id_MALO2 = 208 - integer, parameter :: id_MCO3 = 209 - integer, parameter :: id_MDIALO2 = 210 - integer, parameter :: id_MEKO2 = 211 - integer, parameter :: id_N2D = 212 - integer, parameter :: id_N2p = 213 - integer, parameter :: id_NOp = 214 - integer, parameter :: id_Np = 215 - integer, parameter :: id_NTERPO2 = 216 - integer, parameter :: id_O1D = 217 - integer, parameter :: id_O2_1D = 218 - integer, parameter :: id_O2_1S = 219 - integer, parameter :: id_O2p = 220 - integer, parameter :: id_OH = 221 - integer, parameter :: id_Op = 222 - integer, parameter :: id_PHENO2 = 223 - integer, parameter :: id_PO2 = 224 - integer, parameter :: id_RO2 = 225 - integer, parameter :: id_TERP2O2 = 226 - integer, parameter :: id_TERPO2 = 227 - integer, parameter :: id_TOLO2 = 228 - integer, parameter :: id_XO2 = 229 - integer, parameter :: id_XYLENO2 = 230 - integer, parameter :: id_XYLOLO2 = 231 - integer, parameter :: id_H2O = 232 + integer, parameter :: id_BCARYO2VBS = 191 + integer, parameter :: id_BENZO2 = 192 + integer, parameter :: id_BENZO2VBS = 193 + integer, parameter :: id_BZOO = 194 + integer, parameter :: id_C2H5O2 = 195 + integer, parameter :: id_C3H7O2 = 196 + integer, parameter :: id_C6H5O2 = 197 + integer, parameter :: id_CH3CO3 = 198 + integer, parameter :: id_CH3O2 = 199 + integer, parameter :: id_DICARBO2 = 200 + integer, parameter :: id_e = 201 + integer, parameter :: id_ENEO2 = 202 + integer, parameter :: id_EO = 203 + integer, parameter :: id_EO2 = 204 + integer, parameter :: id_HOCH2OO = 205 + integer, parameter :: id_ISOPAO2 = 206 + integer, parameter :: id_ISOPBO2 = 207 + integer, parameter :: id_ISOPNO3 = 208 + integer, parameter :: id_ISOPO2VBS = 209 + integer, parameter :: id_IVOCO2VBS = 210 + integer, parameter :: id_MACRO2 = 211 + integer, parameter :: id_MALO2 = 212 + integer, parameter :: id_MCO3 = 213 + integer, parameter :: id_MDIALO2 = 214 + integer, parameter :: id_MEKO2 = 215 + integer, parameter :: id_MTERPO2VBS = 216 + integer, parameter :: id_N2D = 217 + integer, parameter :: id_N2p = 218 + integer, parameter :: id_NOp = 219 + integer, parameter :: id_Np = 220 + integer, parameter :: id_NTERPO2 = 221 + integer, parameter :: id_O1D = 222 + integer, parameter :: id_O2_1D = 223 + integer, parameter :: id_O2_1S = 224 + integer, parameter :: id_O2p = 225 + integer, parameter :: id_OH = 226 + integer, parameter :: id_Op = 227 + integer, parameter :: id_PHENO2 = 228 + integer, parameter :: id_PO2 = 229 + integer, parameter :: id_RO2 = 230 + integer, parameter :: id_TERP2O2 = 231 + integer, parameter :: id_TERPO2 = 232 + integer, parameter :: id_TOLO2 = 233 + integer, parameter :: id_TOLUO2VBS = 234 + integer, parameter :: id_XO2 = 235 + integer, parameter :: id_XYLENO2 = 236 + integer, parameter :: id_XYLEO2VBS = 237 + integer, parameter :: id_XYLOLO2 = 238 + integer, parameter :: id_H2O = 239 end module m_spc_id diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 index e97c5a1e39..a4ce68a0cf 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_adjrxt.F90 @@ -13,432 +13,446 @@ subroutine adjrxt( rate, inv, m, 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(:,:,155) = rate(:,:,155) * inv(:,:, 2) - rate(:,:,159) = rate(:,:,159) * inv(:,:, 2) - rate(:,:,163) = rate(:,:,163) * inv(:,:, 2) - rate(:,:,168) = rate(:,:,168) * inv(:,:, 1) - rate(:,:,169) = rate(:,:,169) * inv(:,:, 1) - rate(:,:,175) = rate(:,:,175) * inv(:,:, 1) - rate(:,:,185) = rate(:,:,185) * inv(:,:, 1) - rate(:,:,197) = rate(:,:,197) * inv(:,:, 1) - rate(:,:,205) = rate(:,:,205) * inv(:,:, 1) - rate(:,:,208) = rate(:,:,208) * inv(:,:, 1) - rate(:,:,209) = rate(:,:,209) * inv(:,:, 1) - rate(:,:,210) = rate(:,:,210) * inv(:,:, 1) - rate(:,:,212) = rate(:,:,212) * inv(:,:, 1) - rate(:,:,213) = rate(:,:,213) * inv(:,:, 1) - rate(:,:,228) = rate(:,:,228) * inv(:,:, 1) - rate(:,:,248) = rate(:,:,248) * inv(:,:, 1) - rate(:,:,249) = rate(:,:,249) * inv(:,:, 1) - rate(:,:,259) = rate(:,:,259) * inv(:,:, 1) - rate(:,:,305) = rate(:,:,305) * inv(:,:, 1) - rate(:,:,306) = rate(:,:,306) * inv(:,:, 1) - rate(:,:,316) = rate(:,:,316) * inv(:,:, 1) - rate(:,:,317) = rate(:,:,317) * inv(:,:, 1) - rate(:,:,318) = rate(:,:,318) * inv(:,:, 1) - rate(:,:,344) = rate(:,:,344) * inv(:,:, 1) - rate(:,:,345) = rate(:,:,345) * inv(:,:, 1) - rate(:,:,346) = rate(:,:,346) * inv(:,:, 1) - rate(:,:,365) = rate(:,:,365) * inv(:,:, 1) - rate(:,:,391) = rate(:,:,391) * inv(:,:, 1) - rate(:,:,394) = rate(:,:,394) * inv(:,:, 1) - rate(:,:,395) = rate(:,:,395) * inv(:,:, 1) - rate(:,:,452) = rate(:,:,452) * inv(:,:, 1) - rate(:,:,455) = rate(:,:,455) * inv(:,:, 1) - rate(:,:,458) = rate(:,:,458) * inv(:,:, 1) - rate(:,:,465) = rate(:,:,465) * inv(:,:, 1) - rate(:,:,470) = rate(:,:,470) * inv(:,:, 1) - rate(:,:,575) = rate(:,:,575) * inv(:,:, 2) - rate(:,:,578) = rate(:,:,578) * inv(:,:, 2) - rate(:,:,153) = rate(:,:,153) * m(:,:) - rate(:,:,154) = rate(:,:,154) * m(:,:) - rate(:,:,156) = rate(:,:,156) * m(:,:) - rate(:,:,157) = rate(:,:,157) * m(:,:) - rate(:,:,158) = rate(:,:,158) * m(:,:) - rate(:,:,160) = rate(:,:,160) * m(:,:) - rate(:,:,161) = rate(:,:,161) * m(:,:) - rate(:,:,162) = rate(:,:,162) * 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(:,:,172) = rate(:,:,172) * 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(:,:,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(:,:,245) = rate(:,:,245) * m(:,:) - rate(:,:,246) = rate(:,:,246) * m(:,:) - rate(:,:,247) = rate(:,:,247) * m(:,:) - rate(:,:,248) = rate(:,:,248) * m(:,:) - rate(:,:,250) = rate(:,:,250) * m(:,:) - rate(:,:,251) = rate(:,:,251) * m(:,:) - rate(:,:,252) = rate(:,:,252) * 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(:,:,292) = rate(:,:,292) * 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(:,:,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(:,:,322) = rate(:,:,322) * 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(:,:,329) = rate(:,:,329) * 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(:,:,336) = rate(:,:,336) * m(:,:) - rate(:,:,337) = rate(:,:,337) * m(:,:) - rate(:,:,338) = rate(:,:,338) * m(:,:) - rate(:,:,340) = rate(:,:,340) * m(:,:) - rate(:,:,341) = rate(:,:,341) * m(:,:) - rate(:,:,342) = rate(:,:,342) * m(:,:) - rate(:,:,343) = rate(:,:,343) * m(:,:) - rate(:,:,344) = rate(:,:,344) * m(:,:) - rate(:,:,345) = rate(:,:,345) * m(:,:) - rate(:,:,347) = rate(:,:,347) * m(:,:) - rate(:,:,348) = rate(:,:,348) * m(:,:) - rate(:,:,349) = rate(:,:,349) * m(:,:) - rate(:,:,350) = rate(:,:,350) * m(:,:) - rate(:,:,351) = rate(:,:,351) * m(:,:) - rate(:,:,352) = rate(:,:,352) * m(:,:) - rate(:,:,353) = rate(:,:,353) * m(:,:) - rate(:,:,354) = rate(:,:,354) * m(:,:) - rate(:,:,355) = rate(:,:,355) * m(:,:) - rate(:,:,356) = rate(:,:,356) * m(:,:) - rate(:,:,357) = rate(:,:,357) * m(:,:) - rate(:,:,358) = rate(:,:,358) * m(:,:) - rate(:,:,359) = rate(:,:,359) * m(:,:) - rate(:,:,360) = rate(:,:,360) * m(:,:) - rate(:,:,361) = rate(:,:,361) * m(:,:) - rate(:,:,362) = rate(:,:,362) * m(:,:) - rate(:,:,363) = rate(:,:,363) * m(:,:) - rate(:,:,364) = rate(:,:,364) * m(:,:) - rate(:,:,365) = rate(:,:,365) * m(:,:) - rate(:,:,366) = rate(:,:,366) * m(:,:) - rate(:,:,367) = rate(:,:,367) * m(:,:) - rate(:,:,368) = rate(:,:,368) * m(:,:) - rate(:,:,369) = rate(:,:,369) * m(:,:) - rate(:,:,370) = rate(:,:,370) * m(:,:) - rate(:,:,371) = rate(:,:,371) * m(:,:) - rate(:,:,372) = rate(:,:,372) * m(:,:) - rate(:,:,373) = rate(:,:,373) * m(:,:) - rate(:,:,374) = rate(:,:,374) * m(:,:) - rate(:,:,375) = rate(:,:,375) * m(:,:) - rate(:,:,376) = rate(:,:,376) * m(:,:) - rate(:,:,377) = rate(:,:,377) * m(:,:) - rate(:,:,378) = rate(:,:,378) * m(:,:) - rate(:,:,379) = rate(:,:,379) * m(:,:) - rate(:,:,380) = rate(:,:,380) * m(:,:) - rate(:,:,381) = rate(:,:,381) * m(:,:) - rate(:,:,382) = rate(:,:,382) * m(:,:) - rate(:,:,383) = rate(:,:,383) * m(:,:) - rate(:,:,384) = rate(:,:,384) * m(:,:) - rate(:,:,385) = rate(:,:,385) * m(:,:) - rate(:,:,386) = rate(:,:,386) * m(:,:) - rate(:,:,387) = rate(:,:,387) * m(:,:) - rate(:,:,388) = rate(:,:,388) * m(:,:) - rate(:,:,389) = rate(:,:,389) * m(:,:) - rate(:,:,390) = rate(:,:,390) * m(:,:) - rate(:,:,391) = rate(:,:,391) * m(:,:) - rate(:,:,392) = rate(:,:,392) * m(:,:) - rate(:,:,393) = rate(:,:,393) * m(:,:) - rate(:,:,394) = rate(:,:,394) * m(:,:) - rate(:,:,396) = rate(:,:,396) * m(:,:) - rate(:,:,397) = rate(:,:,397) * m(:,:) - rate(:,:,398) = rate(:,:,398) * m(:,:) - rate(:,:,399) = rate(:,:,399) * m(:,:) - rate(:,:,400) = rate(:,:,400) * m(:,:) - rate(:,:,401) = rate(:,:,401) * m(:,:) - rate(:,:,402) = rate(:,:,402) * m(:,:) - rate(:,:,403) = rate(:,:,403) * m(:,:) - rate(:,:,404) = rate(:,:,404) * m(:,:) - rate(:,:,405) = rate(:,:,405) * m(:,:) - rate(:,:,406) = rate(:,:,406) * m(:,:) - rate(:,:,407) = rate(:,:,407) * m(:,:) - rate(:,:,408) = rate(:,:,408) * m(:,:) - rate(:,:,409) = rate(:,:,409) * m(:,:) - rate(:,:,410) = rate(:,:,410) * m(:,:) - rate(:,:,411) = rate(:,:,411) * m(:,:) - rate(:,:,412) = rate(:,:,412) * m(:,:) - rate(:,:,414) = rate(:,:,414) * m(:,:) - rate(:,:,415) = rate(:,:,415) * m(:,:) - rate(:,:,416) = rate(:,:,416) * m(:,:) - rate(:,:,417) = rate(:,:,417) * m(:,:) - rate(:,:,418) = rate(:,:,418) * m(:,:) - rate(:,:,419) = rate(:,:,419) * m(:,:) - rate(:,:,420) = rate(:,:,420) * m(:,:) - rate(:,:,421) = rate(:,:,421) * m(:,:) - rate(:,:,422) = rate(:,:,422) * m(:,:) - rate(:,:,423) = rate(:,:,423) * m(:,:) - rate(:,:,424) = rate(:,:,424) * m(:,:) - rate(:,:,425) = rate(:,:,425) * m(:,:) - rate(:,:,426) = rate(:,:,426) * m(:,:) - rate(:,:,427) = rate(:,:,427) * m(:,:) - rate(:,:,428) = rate(:,:,428) * m(:,:) - rate(:,:,429) = rate(:,:,429) * m(:,:) - rate(:,:,430) = rate(:,:,430) * m(:,:) - rate(:,:,431) = rate(:,:,431) * m(:,:) - rate(:,:,432) = rate(:,:,432) * m(:,:) - rate(:,:,433) = rate(:,:,433) * m(:,:) - rate(:,:,434) = rate(:,:,434) * m(:,:) - rate(:,:,435) = rate(:,:,435) * m(:,:) - rate(:,:,436) = rate(:,:,436) * m(:,:) - rate(:,:,437) = rate(:,:,437) * m(:,:) - rate(:,:,438) = rate(:,:,438) * m(:,:) - rate(:,:,439) = rate(:,:,439) * m(:,:) - rate(:,:,440) = rate(:,:,440) * m(:,:) - rate(:,:,441) = rate(:,:,441) * m(:,:) - rate(:,:,442) = rate(:,:,442) * m(:,:) - rate(:,:,443) = rate(:,:,443) * m(:,:) - rate(:,:,444) = rate(:,:,444) * m(:,:) - rate(:,:,445) = rate(:,:,445) * m(:,:) - rate(:,:,446) = rate(:,:,446) * m(:,:) - rate(:,:,447) = rate(:,:,447) * m(:,:) - rate(:,:,448) = rate(:,:,448) * m(:,:) - rate(:,:,449) = rate(:,:,449) * m(:,:) - rate(:,:,450) = rate(:,:,450) * m(:,:) - rate(:,:,451) = rate(:,:,451) * m(:,:) - rate(:,:,452) = rate(:,:,452) * m(:,:) - rate(:,:,453) = rate(:,:,453) * m(:,:) - rate(:,:,454) = rate(:,:,454) * m(:,:) - rate(:,:,455) = rate(:,:,455) * m(:,:) - rate(:,:,456) = rate(:,:,456) * m(:,:) - rate(:,:,457) = rate(:,:,457) * m(:,:) - rate(:,:,458) = rate(:,:,458) * m(:,:) - rate(:,:,459) = rate(:,:,459) * m(:,:) - rate(:,:,460) = rate(:,:,460) * m(:,:) - rate(:,:,461) = rate(:,:,461) * m(:,:) - rate(:,:,462) = rate(:,:,462) * m(:,:) - rate(:,:,463) = rate(:,:,463) * m(:,:) - rate(:,:,464) = rate(:,:,464) * m(:,:) - rate(:,:,465) = rate(:,:,465) * m(:,:) - rate(:,:,466) = rate(:,:,466) * m(:,:) - rate(:,:,467) = rate(:,:,467) * m(:,:) - rate(:,:,468) = rate(:,:,468) * m(:,:) - rate(:,:,469) = rate(:,:,469) * m(:,:) - rate(:,:,471) = rate(:,:,471) * m(:,:) - rate(:,:,472) = rate(:,:,472) * m(:,:) - rate(:,:,473) = rate(:,:,473) * m(:,:) - rate(:,:,474) = rate(:,:,474) * m(:,:) - rate(:,:,475) = rate(:,:,475) * m(:,:) - rate(:,:,476) = rate(:,:,476) * m(:,:) - rate(:,:,477) = rate(:,:,477) * m(:,:) - rate(:,:,478) = rate(:,:,478) * m(:,:) - rate(:,:,479) = rate(:,:,479) * m(:,:) - rate(:,:,480) = rate(:,:,480) * m(:,:) - rate(:,:,481) = rate(:,:,481) * m(:,:) - rate(:,:,482) = rate(:,:,482) * m(:,:) - rate(:,:,483) = rate(:,:,483) * m(:,:) - rate(:,:,484) = rate(:,:,484) * m(:,:) - rate(:,:,485) = rate(:,:,485) * m(:,:) - rate(:,:,486) = rate(:,:,486) * m(:,:) - rate(:,:,487) = rate(:,:,487) * m(:,:) - rate(:,:,488) = rate(:,:,488) * m(:,:) - rate(:,:,489) = rate(:,:,489) * m(:,:) - rate(:,:,490) = rate(:,:,490) * m(:,:) - rate(:,:,491) = rate(:,:,491) * m(:,:) - rate(:,:,492) = rate(:,:,492) * m(:,:) - rate(:,:,493) = rate(:,:,493) * m(:,:) - rate(:,:,494) = rate(:,:,494) * m(:,:) - rate(:,:,495) = rate(:,:,495) * m(:,:) - rate(:,:,496) = rate(:,:,496) * m(:,:) - rate(:,:,497) = rate(:,:,497) * m(:,:) - rate(:,:,498) = rate(:,:,498) * m(:,:) - rate(:,:,499) = rate(:,:,499) * m(:,:) - rate(:,:,500) = rate(:,:,500) * m(:,:) - rate(:,:,501) = rate(:,:,501) * m(:,:) - rate(:,:,502) = rate(:,:,502) * m(:,:) - rate(:,:,503) = rate(:,:,503) * m(:,:) - rate(:,:,504) = rate(:,:,504) * m(:,:) - rate(:,:,505) = rate(:,:,505) * m(:,:) - rate(:,:,506) = rate(:,:,506) * m(:,:) - rate(:,:,507) = rate(:,:,507) * m(:,:) - rate(:,:,508) = rate(:,:,508) * m(:,:) - rate(:,:,509) = rate(:,:,509) * m(:,:) - rate(:,:,510) = rate(:,:,510) * m(:,:) - rate(:,:,511) = rate(:,:,511) * m(:,:) - rate(:,:,512) = rate(:,:,512) * m(:,:) - rate(:,:,513) = rate(:,:,513) * m(:,:) - rate(:,:,514) = rate(:,:,514) * m(:,:) - rate(:,:,515) = rate(:,:,515) * m(:,:) - rate(:,:,516) = rate(:,:,516) * m(:,:) - rate(:,:,517) = rate(:,:,517) * m(:,:) - rate(:,:,518) = rate(:,:,518) * m(:,:) - rate(:,:,519) = rate(:,:,519) * m(:,:) - rate(:,:,534) = rate(:,:,534) * m(:,:) - rate(:,:,535) = rate(:,:,535) * m(:,:) - rate(:,:,536) = rate(:,:,536) * m(:,:) - rate(:,:,537) = rate(:,:,537) * m(:,:) - rate(:,:,538) = rate(:,:,538) * m(:,:) - rate(:,:,539) = rate(:,:,539) * m(:,:) - rate(:,:,540) = rate(:,:,540) * m(:,:) - rate(:,:,541) = rate(:,:,541) * m(:,:) - rate(:,:,542) = rate(:,:,542) * m(:,:) - rate(:,:,543) = rate(:,:,543) * m(:,:) - rate(:,:,544) = rate(:,:,544) * m(:,:) - rate(:,:,545) = rate(:,:,545) * m(:,:) - rate(:,:,546) = rate(:,:,546) * m(:,:) - rate(:,:,547) = rate(:,:,547) * m(:,:) - rate(:,:,549) = rate(:,:,549) * m(:,:) - rate(:,:,554) = rate(:,:,554) * m(:,:) - rate(:,:,555) = rate(:,:,555) * m(:,:) - rate(:,:,556) = rate(:,:,556) * m(:,:) - rate(:,:,559) = rate(:,:,559) * m(:,:) - rate(:,:,560) = rate(:,:,560) * m(:,:) - rate(:,:,561) = rate(:,:,561) * m(:,:) - rate(:,:,564) = rate(:,:,564) * m(:,:) - rate(:,:,565) = rate(:,:,565) * m(:,:) - rate(:,:,566) = rate(:,:,566) * m(:,:) - rate(:,:,567) = rate(:,:,567) * m(:,:) - rate(:,:,568) = rate(:,:,568) * m(:,:) - rate(:,:,569) = rate(:,:,569) * m(:,:) - rate(:,:,570) = rate(:,:,570) * m(:,:) - rate(:,:,571) = rate(:,:,571) * m(:,:) - rate(:,:,572) = rate(:,:,572) * m(:,:) - rate(:,:,573) = rate(:,:,573) * m(:,:) - rate(:,:,574) = rate(:,:,574) * m(:,:) - rate(:,:,576) = rate(:,:,576) * m(:,:) - rate(:,:,577) = rate(:,:,577) * m(:,:) - rate(:,:,579) = rate(:,:,579) * m(:,:) + rate(:,:, 155) = rate(:,:, 155) * inv(:,:, 2) + rate(:,:, 159) = rate(:,:, 159) * inv(:,:, 2) + rate(:,:, 163) = rate(:,:, 163) * inv(:,:, 2) + rate(:,:, 168) = rate(:,:, 168) * inv(:,:, 1) + rate(:,:, 169) = rate(:,:, 169) * inv(:,:, 1) + rate(:,:, 175) = rate(:,:, 175) * inv(:,:, 1) + rate(:,:, 185) = rate(:,:, 185) * inv(:,:, 1) + rate(:,:, 197) = rate(:,:, 197) * inv(:,:, 1) + rate(:,:, 205) = rate(:,:, 205) * inv(:,:, 1) + rate(:,:, 208) = rate(:,:, 208) * inv(:,:, 1) + rate(:,:, 209) = rate(:,:, 209) * inv(:,:, 1) + rate(:,:, 210) = rate(:,:, 210) * inv(:,:, 1) + rate(:,:, 212) = rate(:,:, 212) * inv(:,:, 1) + rate(:,:, 213) = rate(:,:, 213) * inv(:,:, 1) + rate(:,:, 228) = rate(:,:, 228) * inv(:,:, 1) + rate(:,:, 248) = rate(:,:, 248) * inv(:,:, 1) + rate(:,:, 249) = rate(:,:, 249) * inv(:,:, 1) + rate(:,:, 259) = rate(:,:, 259) * inv(:,:, 1) + rate(:,:, 305) = rate(:,:, 305) * inv(:,:, 1) + rate(:,:, 315) = rate(:,:, 315) * inv(:,:, 1) + rate(:,:, 316) = rate(:,:, 316) * inv(:,:, 1) + rate(:,:, 317) = rate(:,:, 317) * inv(:,:, 1) + rate(:,:, 343) = rate(:,:, 343) * inv(:,:, 1) + rate(:,:, 344) = rate(:,:, 344) * inv(:,:, 1) + rate(:,:, 345) = rate(:,:, 345) * inv(:,:, 1) + rate(:,:, 365) = rate(:,:, 365) * inv(:,:, 1) + rate(:,:, 391) = rate(:,:, 391) * inv(:,:, 1) + rate(:,:, 394) = rate(:,:, 394) * inv(:,:, 1) + rate(:,:, 395) = rate(:,:, 395) * inv(:,:, 1) + rate(:,:, 452) = rate(:,:, 452) * inv(:,:, 1) + rate(:,:, 455) = rate(:,:, 455) * inv(:,:, 1) + rate(:,:, 458) = rate(:,:, 458) * inv(:,:, 1) + rate(:,:, 465) = rate(:,:, 465) * inv(:,:, 1) + rate(:,:, 470) = rate(:,:, 470) * inv(:,:, 1) + rate(:,:, 507) = rate(:,:, 507) * inv(:,:, 1) + rate(:,:, 589) = rate(:,:, 589) * inv(:,:, 2) + rate(:,:, 592) = rate(:,:, 592) * inv(:,:, 2) + rate(:,:, 153) = rate(:,:, 153) * m(:,:) + rate(:,:, 154) = rate(:,:, 154) * m(:,:) + rate(:,:, 156) = rate(:,:, 156) * m(:,:) + rate(:,:, 157) = rate(:,:, 157) * m(:,:) + rate(:,:, 158) = rate(:,:, 158) * m(:,:) + rate(:,:, 160) = rate(:,:, 160) * m(:,:) + rate(:,:, 161) = rate(:,:, 161) * m(:,:) + rate(:,:, 162) = rate(:,:, 162) * 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(:,:, 172) = rate(:,:, 172) * 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(:,:, 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * m(:,:) + rate(:,:, 247) = rate(:,:, 247) * m(:,:) + rate(:,:, 248) = rate(:,:, 248) * m(:,:) + rate(:,:, 250) = rate(:,:, 250) * m(:,:) + rate(:,:, 251) = rate(:,:, 251) * m(:,:) + rate(:,:, 252) = rate(:,:, 252) * 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(:,:, 292) = rate(:,:, 292) * 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(:,:, 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(:,:, 322) = rate(:,:, 322) * 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(:,:, 329) = rate(:,:, 329) * 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(:,:, 336) = rate(:,:, 336) * m(:,:) + rate(:,:, 337) = rate(:,:, 337) * m(:,:) + rate(:,:, 339) = rate(:,:, 339) * m(:,:) + rate(:,:, 340) = rate(:,:, 340) * m(:,:) + rate(:,:, 341) = rate(:,:, 341) * m(:,:) + rate(:,:, 342) = rate(:,:, 342) * m(:,:) + rate(:,:, 343) = rate(:,:, 343) * m(:,:) + rate(:,:, 344) = rate(:,:, 344) * m(:,:) + rate(:,:, 346) = rate(:,:, 346) * m(:,:) + rate(:,:, 347) = rate(:,:, 347) * m(:,:) + rate(:,:, 348) = rate(:,:, 348) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 352) = rate(:,:, 352) * m(:,:) + rate(:,:, 353) = rate(:,:, 353) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 357) = rate(:,:, 357) * m(:,:) + rate(:,:, 358) = rate(:,:, 358) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + rate(:,:, 360) = rate(:,:, 360) * m(:,:) + rate(:,:, 361) = rate(:,:, 361) * m(:,:) + rate(:,:, 362) = rate(:,:, 362) * m(:,:) + rate(:,:, 363) = rate(:,:, 363) * m(:,:) + rate(:,:, 364) = rate(:,:, 364) * m(:,:) + rate(:,:, 365) = rate(:,:, 365) * m(:,:) + rate(:,:, 366) = rate(:,:, 366) * m(:,:) + rate(:,:, 367) = rate(:,:, 367) * m(:,:) + rate(:,:, 368) = rate(:,:, 368) * m(:,:) + rate(:,:, 369) = rate(:,:, 369) * m(:,:) + rate(:,:, 370) = rate(:,:, 370) * m(:,:) + rate(:,:, 371) = rate(:,:, 371) * m(:,:) + rate(:,:, 372) = rate(:,:, 372) * m(:,:) + rate(:,:, 373) = rate(:,:, 373) * m(:,:) + rate(:,:, 374) = rate(:,:, 374) * m(:,:) + rate(:,:, 375) = rate(:,:, 375) * m(:,:) + rate(:,:, 376) = rate(:,:, 376) * m(:,:) + rate(:,:, 377) = rate(:,:, 377) * m(:,:) + rate(:,:, 378) = rate(:,:, 378) * m(:,:) + rate(:,:, 379) = rate(:,:, 379) * m(:,:) + rate(:,:, 380) = rate(:,:, 380) * m(:,:) + rate(:,:, 381) = rate(:,:, 381) * m(:,:) + rate(:,:, 382) = rate(:,:, 382) * m(:,:) + rate(:,:, 383) = rate(:,:, 383) * m(:,:) + rate(:,:, 384) = rate(:,:, 384) * m(:,:) + rate(:,:, 385) = rate(:,:, 385) * m(:,:) + rate(:,:, 386) = rate(:,:, 386) * m(:,:) + rate(:,:, 387) = rate(:,:, 387) * m(:,:) + rate(:,:, 388) = rate(:,:, 388) * m(:,:) + rate(:,:, 389) = rate(:,:, 389) * m(:,:) + rate(:,:, 390) = rate(:,:, 390) * m(:,:) + rate(:,:, 391) = rate(:,:, 391) * m(:,:) + rate(:,:, 392) = rate(:,:, 392) * m(:,:) + rate(:,:, 393) = rate(:,:, 393) * m(:,:) + rate(:,:, 394) = rate(:,:, 394) * m(:,:) + rate(:,:, 396) = rate(:,:, 396) * m(:,:) + rate(:,:, 397) = rate(:,:, 397) * m(:,:) + rate(:,:, 398) = rate(:,:, 398) * m(:,:) + rate(:,:, 399) = rate(:,:, 399) * m(:,:) + rate(:,:, 400) = rate(:,:, 400) * m(:,:) + rate(:,:, 401) = rate(:,:, 401) * m(:,:) + rate(:,:, 402) = rate(:,:, 402) * m(:,:) + rate(:,:, 403) = rate(:,:, 403) * m(:,:) + rate(:,:, 404) = rate(:,:, 404) * m(:,:) + rate(:,:, 405) = rate(:,:, 405) * m(:,:) + rate(:,:, 406) = rate(:,:, 406) * m(:,:) + rate(:,:, 407) = rate(:,:, 407) * m(:,:) + rate(:,:, 408) = rate(:,:, 408) * m(:,:) + rate(:,:, 409) = rate(:,:, 409) * m(:,:) + rate(:,:, 410) = rate(:,:, 410) * m(:,:) + rate(:,:, 411) = rate(:,:, 411) * m(:,:) + rate(:,:, 412) = rate(:,:, 412) * m(:,:) + rate(:,:, 414) = rate(:,:, 414) * m(:,:) + rate(:,:, 415) = rate(:,:, 415) * m(:,:) + rate(:,:, 416) = rate(:,:, 416) * m(:,:) + rate(:,:, 417) = rate(:,:, 417) * m(:,:) + rate(:,:, 418) = rate(:,:, 418) * m(:,:) + rate(:,:, 419) = rate(:,:, 419) * m(:,:) + rate(:,:, 420) = rate(:,:, 420) * m(:,:) + rate(:,:, 421) = rate(:,:, 421) * m(:,:) + rate(:,:, 422) = rate(:,:, 422) * m(:,:) + rate(:,:, 423) = rate(:,:, 423) * m(:,:) + rate(:,:, 424) = rate(:,:, 424) * m(:,:) + rate(:,:, 425) = rate(:,:, 425) * m(:,:) + rate(:,:, 426) = rate(:,:, 426) * m(:,:) + rate(:,:, 427) = rate(:,:, 427) * m(:,:) + rate(:,:, 428) = rate(:,:, 428) * m(:,:) + rate(:,:, 429) = rate(:,:, 429) * m(:,:) + rate(:,:, 430) = rate(:,:, 430) * m(:,:) + rate(:,:, 431) = rate(:,:, 431) * m(:,:) + rate(:,:, 432) = rate(:,:, 432) * m(:,:) + rate(:,:, 433) = rate(:,:, 433) * m(:,:) + rate(:,:, 434) = rate(:,:, 434) * m(:,:) + rate(:,:, 435) = rate(:,:, 435) * m(:,:) + rate(:,:, 436) = rate(:,:, 436) * m(:,:) + rate(:,:, 437) = rate(:,:, 437) * m(:,:) + rate(:,:, 438) = rate(:,:, 438) * m(:,:) + rate(:,:, 439) = rate(:,:, 439) * m(:,:) + rate(:,:, 440) = rate(:,:, 440) * m(:,:) + rate(:,:, 441) = rate(:,:, 441) * m(:,:) + rate(:,:, 442) = rate(:,:, 442) * m(:,:) + rate(:,:, 443) = rate(:,:, 443) * m(:,:) + rate(:,:, 444) = rate(:,:, 444) * m(:,:) + rate(:,:, 445) = rate(:,:, 445) * m(:,:) + rate(:,:, 446) = rate(:,:, 446) * m(:,:) + rate(:,:, 447) = rate(:,:, 447) * m(:,:) + rate(:,:, 448) = rate(:,:, 448) * m(:,:) + rate(:,:, 449) = rate(:,:, 449) * m(:,:) + rate(:,:, 450) = rate(:,:, 450) * m(:,:) + rate(:,:, 451) = rate(:,:, 451) * m(:,:) + rate(:,:, 452) = rate(:,:, 452) * m(:,:) + rate(:,:, 453) = rate(:,:, 453) * m(:,:) + rate(:,:, 454) = rate(:,:, 454) * m(:,:) + rate(:,:, 455) = rate(:,:, 455) * m(:,:) + rate(:,:, 456) = rate(:,:, 456) * m(:,:) + rate(:,:, 457) = rate(:,:, 457) * m(:,:) + rate(:,:, 458) = rate(:,:, 458) * m(:,:) + rate(:,:, 459) = rate(:,:, 459) * m(:,:) + rate(:,:, 460) = rate(:,:, 460) * m(:,:) + rate(:,:, 461) = rate(:,:, 461) * m(:,:) + rate(:,:, 462) = rate(:,:, 462) * m(:,:) + rate(:,:, 463) = rate(:,:, 463) * m(:,:) + rate(:,:, 464) = rate(:,:, 464) * m(:,:) + rate(:,:, 465) = rate(:,:, 465) * m(:,:) + rate(:,:, 466) = rate(:,:, 466) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * m(:,:) + rate(:,:, 468) = rate(:,:, 468) * m(:,:) + rate(:,:, 469) = rate(:,:, 469) * m(:,:) + rate(:,:, 471) = rate(:,:, 471) * m(:,:) + rate(:,:, 472) = rate(:,:, 472) * m(:,:) + rate(:,:, 473) = rate(:,:, 473) * m(:,:) + rate(:,:, 474) = rate(:,:, 474) * m(:,:) + rate(:,:, 475) = rate(:,:, 475) * m(:,:) + rate(:,:, 476) = rate(:,:, 476) * m(:,:) + rate(:,:, 477) = rate(:,:, 477) * m(:,:) + rate(:,:, 478) = rate(:,:, 478) * m(:,:) + rate(:,:, 479) = rate(:,:, 479) * m(:,:) + rate(:,:, 480) = rate(:,:, 480) * m(:,:) + rate(:,:, 481) = rate(:,:, 481) * m(:,:) + rate(:,:, 482) = rate(:,:, 482) * m(:,:) + rate(:,:, 483) = rate(:,:, 483) * m(:,:) + rate(:,:, 484) = rate(:,:, 484) * m(:,:) + rate(:,:, 485) = rate(:,:, 485) * m(:,:) + rate(:,:, 486) = rate(:,:, 486) * m(:,:) + rate(:,:, 487) = rate(:,:, 487) * m(:,:) + rate(:,:, 488) = rate(:,:, 488) * m(:,:) + rate(:,:, 489) = rate(:,:, 489) * m(:,:) + rate(:,:, 490) = rate(:,:, 490) * m(:,:) + rate(:,:, 491) = rate(:,:, 491) * m(:,:) + rate(:,:, 492) = rate(:,:, 492) * m(:,:) + rate(:,:, 493) = rate(:,:, 493) * m(:,:) + rate(:,:, 494) = rate(:,:, 494) * m(:,:) + rate(:,:, 495) = rate(:,:, 495) * m(:,:) + rate(:,:, 496) = rate(:,:, 496) * m(:,:) + rate(:,:, 497) = rate(:,:, 497) * m(:,:) + rate(:,:, 498) = rate(:,:, 498) * m(:,:) + rate(:,:, 499) = rate(:,:, 499) * m(:,:) + rate(:,:, 500) = rate(:,:, 500) * m(:,:) + rate(:,:, 501) = rate(:,:, 501) * m(:,:) + rate(:,:, 502) = rate(:,:, 502) * m(:,:) + rate(:,:, 503) = rate(:,:, 503) * m(:,:) + rate(:,:, 504) = rate(:,:, 504) * m(:,:) + rate(:,:, 505) = rate(:,:, 505) * m(:,:) + rate(:,:, 506) = rate(:,:, 506) * m(:,:) + rate(:,:, 507) = rate(:,:, 507) * m(:,:) + rate(:,:, 508) = rate(:,:, 508) * m(:,:) + rate(:,:, 509) = rate(:,:, 509) * m(:,:) + rate(:,:, 510) = rate(:,:, 510) * m(:,:) + rate(:,:, 511) = rate(:,:, 511) * m(:,:) + rate(:,:, 512) = rate(:,:, 512) * m(:,:) + rate(:,:, 513) = rate(:,:, 513) * m(:,:) + rate(:,:, 514) = rate(:,:, 514) * m(:,:) + rate(:,:, 515) = rate(:,:, 515) * m(:,:) + rate(:,:, 516) = rate(:,:, 516) * m(:,:) + rate(:,:, 517) = rate(:,:, 517) * m(:,:) + rate(:,:, 518) = rate(:,:, 518) * m(:,:) + rate(:,:, 519) = rate(:,:, 519) * m(:,:) + rate(:,:, 534) = rate(:,:, 534) * m(:,:) + rate(:,:, 535) = rate(:,:, 535) * m(:,:) + rate(:,:, 536) = rate(:,:, 536) * m(:,:) + rate(:,:, 537) = rate(:,:, 537) * m(:,:) + rate(:,:, 538) = rate(:,:, 538) * m(:,:) + rate(:,:, 539) = rate(:,:, 539) * m(:,:) + rate(:,:, 540) = rate(:,:, 540) * m(:,:) + rate(:,:, 541) = rate(:,:, 541) * m(:,:) + rate(:,:, 542) = rate(:,:, 542) * m(:,:) + rate(:,:, 543) = rate(:,:, 543) * m(:,:) + rate(:,:, 544) = rate(:,:, 544) * m(:,:) + rate(:,:, 545) = rate(:,:, 545) * m(:,:) + rate(:,:, 546) = rate(:,:, 546) * m(:,:) + rate(:,:, 547) = rate(:,:, 547) * m(:,:) + rate(:,:, 548) = rate(:,:, 548) * m(:,:) + rate(:,:, 549) = rate(:,:, 549) * m(:,:) + rate(:,:, 550) = rate(:,:, 550) * m(:,:) + rate(:,:, 551) = rate(:,:, 551) * m(:,:) + rate(:,:, 552) = rate(:,:, 552) * m(:,:) + rate(:,:, 553) = rate(:,:, 553) * m(:,:) + rate(:,:, 554) = rate(:,:, 554) * m(:,:) + rate(:,:, 555) = rate(:,:, 555) * m(:,:) + rate(:,:, 556) = rate(:,:, 556) * m(:,:) + rate(:,:, 557) = rate(:,:, 557) * m(:,:) + rate(:,:, 558) = rate(:,:, 558) * m(:,:) + rate(:,:, 559) = rate(:,:, 559) * m(:,:) + rate(:,:, 560) = rate(:,:, 560) * m(:,:) + rate(:,:, 561) = rate(:,:, 561) * m(:,:) + rate(:,:, 563) = rate(:,:, 563) * m(:,:) + rate(:,:, 568) = rate(:,:, 568) * m(:,:) + rate(:,:, 569) = rate(:,:, 569) * m(:,:) + rate(:,:, 570) = rate(:,:, 570) * m(:,:) + rate(:,:, 573) = rate(:,:, 573) * m(:,:) + rate(:,:, 574) = rate(:,:, 574) * m(:,:) + rate(:,:, 575) = rate(:,:, 575) * m(:,:) + rate(:,:, 578) = rate(:,:, 578) * m(:,:) + rate(:,:, 579) = rate(:,:, 579) * m(:,:) + rate(:,:, 580) = rate(:,:, 580) * m(:,:) + rate(:,:, 581) = rate(:,:, 581) * m(:,:) + rate(:,:, 582) = rate(:,:, 582) * m(:,:) + rate(:,:, 583) = rate(:,:, 583) * m(:,:) + rate(:,:, 584) = rate(:,:, 584) * m(:,:) + rate(:,:, 585) = rate(:,:, 585) * m(:,:) + rate(:,:, 586) = rate(:,:, 586) * m(:,:) + rate(:,:, 587) = rate(:,:, 587) * m(:,:) + rate(:,:, 588) = rate(:,:, 588) * m(:,:) + rate(:,:, 590) = rate(:,:, 590) * m(:,:) + rate(:,:, 591) = rate(:,:, 591) * m(:,:) + rate(:,:, 593) = rate(:,:, 593) * m(:,:) end subroutine adjrxt end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 index 9ba8c0982c..4fe59b6c58 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_indprd.F90 @@ -20,203 +20,171 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) ! ... "independent" production for Explicit species !-------------------------------------------------------------------- if( class == 1 ) then - prod(:,1) = + extfrc(:,15) - prod(:,2) = 0._r8 - prod(:,3) = 0._r8 - prod(:,4) = 0._r8 - prod(:,5) = 0._r8 - prod(:,6) = 0._r8 - prod(:,7) = 0._r8 - prod(:,8) = 0._r8 - prod(:,9) = 0._r8 - prod(:,10) = 0._r8 - prod(:,11) = 0._r8 - prod(:,12) = 0._r8 - prod(:,13) = 0._r8 - prod(:,14) = 0._r8 - prod(:,15) =.100_r8*rxt(:,348)*y(:,135)*y(:,29) - prod(:,16) = 0._r8 - prod(:,17) = 0._r8 - prod(:,18) = (rxt(:,305)*y(:,62) +rxt(:,307)*y(:,87) +rxt(:,315)*y(:,62) + & - rxt(:,335)*y(:,50) +.500_r8*rxt(:,336)*y(:,51) + & - .800_r8*rxt(:,341)*y(:,74) +rxt(:,342)*y(:,75) + & - .500_r8*rxt(:,391)*y(:,109) +1.800_r8*rxt(:,501)*y(:,179))*y(:,221) & - + (2.000_r8*rxt(:,331)*y(:,196) +.900_r8*rxt(:,332)*y(:,197) + & - rxt(:,334)*y(:,124) +2.000_r8*rxt(:,381)*y(:,209) + & - rxt(:,405)*y(:,205) +rxt(:,430)*y(:,229))*y(:,196) & - + (.200_r8*rxt(:,348)*y(:,29) +.100_r8*rxt(:,392)*y(:,111) + & - .270_r8*rxt(:,480)*y(:,6) +.270_r8*rxt(:,483)*y(:,110))*y(:,135) & - + (rxt(:,382)*y(:,197) +.450_r8*rxt(:,383)*y(:,203) + & - 2.000_r8*rxt(:,384)*y(:,209))*y(:,209) & - + (.500_r8*rxt(:,490)*y(:,197) +.900_r8*rxt(:,492)*y(:,124)) & - *y(:,226) +rxt(:,38)*y(:,51) +.400_r8*rxt(:,61)*y(:,140) +rxt(:,66) & - *y(:,175) +.800_r8*rxt(:,70)*y(:,179) - prod(:,19) = 0._r8 - prod(:,20) = 0._r8 - prod(:,21) = 0._r8 - prod(:,22) = 0._r8 - prod(:,23) = 0._r8 - prod(:,24) =rxt(:,191)*y(:,125)*y(:,112) - prod(:,25) = 0._r8 - prod(:,26) = 0._r8 - prod(:,27) = 0._r8 - prod(:,28) = 0._r8 - prod(:,29) =rxt(:,519)*y(:,221)*y(:,120) +rxt(:,528)*y(:,121) - prod(:,30) = (rxt(:,452)*y(:,198) +rxt(:,455)*y(:,208) +rxt(:,458)*y(:,210) + & - rxt(:,462)*y(:,142))*y(:,125) +.500_r8*rxt(:,391)*y(:,221)*y(:,109) & - +.200_r8*rxt(:,487)*y(:,216)*y(:,124) +.500_r8*rxt(:,499)*y(:,178) & + prod(:,1) =rxt(:,519)*y(:,226)*y(:,120) +rxt(:,528)*y(:,121) + prod(:,2) = (rxt(:,452)*y(:,200) +rxt(:,455)*y(:,212) +rxt(:,458)*y(:,214) + & + rxt(:,462)*y(:,142))*y(:,125) +.500_r8*rxt(:,391)*y(:,226)*y(:,109) & + +.200_r8*rxt(:,487)*y(:,221)*y(:,124) +.500_r8*rxt(:,499)*y(:,178) & *y(:,126) - prod(:,31) = 0._r8 !-------------------------------------------------------------------- ! ... "independent" production for Implicit species !-------------------------------------------------------------------- else if( class == 4 ) then - prod(:,123) = 0._r8 - prod(:,124) = 0._r8 - prod(:,1) = + extfrc(:,13) - prod(:,2) = + extfrc(:,14) prod(:,153) = 0._r8 - prod(:,48) = 0._r8 - prod(:,84) = 0._r8 - prod(:,49) = 0._r8 - prod(:,85) = 0._r8 - prod(:,95) = 0._r8 - prod(:,70) = 0._r8 - prod(:,118) = 0._r8 - prod(:,76) = 0._r8 - prod(:,62) = 0._r8 - prod(:,82) = 0._r8 - prod(:,184) =rxt(:,80)*y(:,34) +rxt(:,81)*y(:,35) +2.000_r8*rxt(:,87)*y(:,41) & - +rxt(:,88)*y(:,43) +3.000_r8*rxt(:,91)*y(:,55) +2.000_r8*rxt(:,99) & - *y(:,78) - prod(:,63) = 0._r8 - prod(:,198) = 0._r8 - prod(:,110) = 0._r8 - prod(:,64) = 0._r8 - prod(:,79) = 0._r8 - prod(:,71) = 0._r8 - prod(:,112) = 0._r8 - prod(:,66) = 0._r8 - prod(:,80) = 0._r8 - prod(:,72) = 0._r8 - prod(:,160) = 0._r8 - prod(:,89) = 0._r8 - prod(:,39) = 0._r8 - prod(:,67) = 0._r8 - prod(:,193) =.180_r8*rxt(:,41)*y(:,54) - prod(:,170) = 0._r8 - prod(:,38) = 0._r8 - prod(:,156) = 0._r8 - prod(:,175) = 0._r8 - prod(:,111) = 0._r8 - prod(:,105) = 0._r8 - prod(:,140) = 0._r8 - prod(:,90) = 0._r8 - prod(:,188) =4.000_r8*rxt(:,79)*y(:,33) +rxt(:,80)*y(:,34) & - +2.000_r8*rxt(:,82)*y(:,36) +2.000_r8*rxt(:,83)*y(:,37) & - +2.000_r8*rxt(:,84)*y(:,38) +rxt(:,85)*y(:,39) +2.000_r8*rxt(:,86) & - *y(:,40) +3.000_r8*rxt(:,89)*y(:,44) +rxt(:,90)*y(:,46) +rxt(:,101) & - *y(:,82) +rxt(:,102)*y(:,83) +rxt(:,103)*y(:,84) - prod(:,47) = 0._r8 - prod(:,36) = 0._r8 - prod(:,200) = 0._r8 prod(:,157) = 0._r8 - prod(:,165) = (rxt(:,42) +rxt(:,110))*y(:,63) +.380_r8*rxt(:,41)*y(:,54) & - + extfrc(:,3) - prod(:,40) =rxt(:,80)*y(:,34) +rxt(:,81)*y(:,35) +rxt(:,83)*y(:,37) & - +2.000_r8*rxt(:,84)*y(:,38) +2.000_r8*rxt(:,85)*y(:,39) +rxt(:,86) & - *y(:,40) +2.000_r8*rxt(:,99)*y(:,78) +rxt(:,102)*y(:,83) +rxt(:,103) & - *y(:,84) - prod(:,51) =rxt(:,82)*y(:,36) +rxt(:,83)*y(:,37) +rxt(:,101)*y(:,82) - prod(:,54) = 0._r8 + prod(:,1) = + extfrc(:,16) + prod(:,2) = 0._r8 + prod(:,3) = + extfrc(:,12) + prod(:,187) = 0._r8 prod(:,69) = 0._r8 - prod(:,3) = 0._r8 - prod(:,4) = 0._r8 - prod(:,5) = 0._r8 - prod(:,41) = 0._r8 - prod(:,136) =rxt(:,81)*y(:,35) +rxt(:,85)*y(:,39) - prod(:,161) = 0._r8 - prod(:,149) = 0._r8 - prod(:,195) = (rxt(:,40) +.330_r8*rxt(:,41))*y(:,54) - prod(:,172) =1.440_r8*rxt(:,41)*y(:,54) + prod(:,118) = 0._r8 + prod(:,70) = 0._r8 prod(:,115) = 0._r8 - prod(:,42) = 0._r8 - prod(:,145) = 0._r8 - prod(:,183) = 0._r8 - prod(:,52) = 0._r8 + prod(:,127) = 0._r8 + prod(:,97) = 0._r8 + prod(:,147) = 0._r8 + prod(:,106) = 0._r8 + prod(:,85) = 0._r8 + prod(:,111) = 0._r8 + prod(:,219) = 0._r8 + prod(:,86) = 0._r8 + prod(:,221) = 0._r8 + prod(:,143) = 0._r8 + prod(:,4) = 0._r8 + prod(:,89) = 0._r8 + prod(:,109) = 0._r8 + prod(:,99) = 0._r8 prod(:,141) = 0._r8 + prod(:,93) = 0._r8 + prod(:,110) = 0._r8 + prod(:,100) = 0._r8 + prod(:,197) = 0._r8 + prod(:,120) = 0._r8 + prod(:,101) = 0._r8 + prod(:,94) = 0._r8 + prod(:,54) = 0._r8 + prod(:,65) = 0._r8 + prod(:,66) = 0._r8 + prod(:,57) = 0._r8 + prod(:,67) = 0._r8 + prod(:,58) = 0._r8 + prod(:,68) = 0._r8 prod(:,59) = 0._r8 - prod(:,196) = 0._r8 - prod(:,99) = 0._r8 - prod(:,134) = 0._r8 - prod(:,146) = 0._r8 - prod(:,162) = 0._r8 - prod(:,60) = 0._r8 - prod(:,164) = 0._r8 - prod(:,73) = 0._r8 - prod(:,43) = 0._r8 + prod(:,130) = 0._r8 + prod(:,235) = 0._r8 prod(:,148) = 0._r8 - prod(:,119) = 0._r8 - prod(:,108) = 0._r8 - prod(:,173) = 0._r8 + prod(:,60) = 0._r8 + prod(:,198) = 0._r8 + prod(:,113) = 0._r8 + prod(:,55) = 0._r8 + prod(:,193) = 0._r8 + prod(:,208) = 0._r8 + prod(:,159) = 0._r8 + prod(:,150) = 0._r8 + prod(:,170) = 0._r8 + prod(:,116) = 0._r8 + prod(:,233) = 0._r8 + prod(:,125) = 0._r8 + prod(:,227) = 0._r8 + prod(:,72) = 0._r8 + prod(:,52) = 0._r8 + prod(:,222) = 0._r8 + prod(:,185) = 0._r8 + prod(:,5) = 0._r8 + prod(:,199) = + extfrc(:,1) + prod(:,215) = 0._r8 prod(:,88) = 0._r8 - prod(:,127) = 0._r8 - prod(:,34) = 0._r8 - prod(:,174) = 0._r8 - prod(:,74) = 0._r8 - prod(:,107) = 0._r8 - prod(:,75) = 0._r8 - prod(:,114) = 0._r8 - prod(:,151) = 0._r8 - prod(:,179) = 0._r8 - prod(:,144) = (.800_r8*rxt(:,112) +rxt(:,115) +rxt(:,116) + & - .800_r8*rxt(:,118)) + extfrc(:,21) - prod(:,68) = 0._r8 prod(:,83) = 0._r8 - prod(:,159) = 0._r8 + prod(:,77) = 0._r8 + prod(:,102) = 0._r8 prod(:,6) = 0._r8 prod(:,7) = 0._r8 prod(:,8) = 0._r8 - prod(:,37) = 0._r8 prod(:,9) = 0._r8 - prod(:,187) = + extfrc(:,2) - prod(:,197) = + extfrc(:,1) - prod(:,194) = 0._r8 - prod(:,147) = 0._r8 - prod(:,86) = 0._r8 - prod(:,10) = + extfrc(:,10) - prod(:,11) = + extfrc(:,11) - prod(:,12) = 0._r8 - prod(:,13) = + extfrc(:,12) - prod(:,192) = (rxt(:,42) +rxt(:,110))*y(:,63) +.180_r8*rxt(:,41)*y(:,54) - prod(:,186) = 0._r8 - prod(:,191) = 0._r8 - prod(:,77) = 0._r8 - prod(:,81) = 0._r8 prod(:,61) = 0._r8 - prod(:,97) = 0._r8 - prod(:,44) = 0._r8 - prod(:,98) = 0._r8 - prod(:,50) = 0._r8 - prod(:,78) = 0._r8 - prod(:,14) = + extfrc(:,8) - prod(:,15) = + extfrc(:,9) - prod(:,109) = 0._r8 - prod(:,87) = 0._r8 - prod(:,129) = 0._r8 prod(:,182) = 0._r8 - prod(:,155) = + extfrc(:,4) - prod(:,65) = 0._r8 + prod(:,200) = 0._r8 + prod(:,190) = 0._r8 + prod(:,230) = 0._r8 + prod(:,216) = 0._r8 + prod(:,56) = 0._r8 + prod(:,149) = 0._r8 + prod(:,62) = 0._r8 + prod(:,172) = 0._r8 + prod(:,82) = 0._r8 + prod(:,90) = 0._r8 + prod(:,95) = 0._r8 + prod(:,218) = 0._r8 + prod(:,75) = 0._r8 + prod(:,180) = 0._r8 + prod(:,98) = 0._r8 + prod(:,228) = 0._r8 + prod(:,231) = 0._r8 + prod(:,133) = 0._r8 + prod(:,167) = 0._r8 + prod(:,173) = 0._r8 + prod(:,202) = 0._r8 + prod(:,84) = 0._r8 + prod(:,203) = 0._r8 + prod(:,105) = 0._r8 + prod(:,63) = 0._r8 + prod(:,178) = 0._r8 + prod(:,146) = 0._r8 + prod(:,142) = 0._r8 + prod(:,121) = 0._r8 + prod(:,162) = 0._r8 + prod(:,48) = 0._r8 + prod(:,207) = 0._r8 + prod(:,103) = 0._r8 + prod(:,136) = 0._r8 + prod(:,104) = 0._r8 + prod(:,145) = 0._r8 + prod(:,188) = 0._r8 + prod(:,212) = 0._r8 + prod(:,186) = (.800_r8*rxt(:,112) +rxt(:,115) +rxt(:,116) + & + .800_r8*rxt(:,118)) + extfrc(:,17) + prod(:,91) = 0._r8 + prod(:,96) = 0._r8 + prod(:,114) = 0._r8 + prod(:,196) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,53) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) = 0._r8 + prod(:,229) = + extfrc(:,5) + prod(:,225) = + extfrc(:,4) + prod(:,226) = 0._r8 + prod(:,177) = 0._r8 + prod(:,117) = 0._r8 prod(:,16) = + extfrc(:,6) prod(:,17) = + extfrc(:,7) prod(:,18) = 0._r8 - prod(:,19) = 0._r8 + prod(:,19) = + extfrc(:,10) + prod(:,234) = 0._r8 + prod(:,220) = 0._r8 + prod(:,236) = 0._r8 prod(:,20) = 0._r8 + prod(:,107) = 0._r8 + prod(:,112) = 0._r8 + prod(:,87) = 0._r8 + prod(:,139) = 0._r8 + prod(:,64) = 0._r8 + prod(:,129) = 0._r8 + prod(:,71) = 0._r8 + prod(:,108) = 0._r8 prod(:,21) = 0._r8 - prod(:,22) = 0._r8 + prod(:,22) = + extfrc(:,11) + prod(:,140) = 0._r8 + prod(:,119) = 0._r8 + prod(:,160) = 0._r8 prod(:,23) = 0._r8 - prod(:,24) = 0._r8 - prod(:,25) = 0._r8 + prod(:,217) = 0._r8 + prod(:,184) = + extfrc(:,3) + prod(:,92) = 0._r8 + prod(:,24) = + extfrc(:,8) + prod(:,25) = + extfrc(:,9) prod(:,26) = 0._r8 prod(:,27) = 0._r8 prod(:,28) = 0._r8 @@ -225,66 +193,82 @@ subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts ) prod(:,31) = 0._r8 prod(:,32) = 0._r8 prod(:,33) = 0._r8 - prod(:,35) = + extfrc(:,5) - prod(:,55) = 0._r8 - prod(:,116) = 0._r8 - prod(:,121) = 0._r8 - prod(:,100) = 0._r8 - prod(:,158) = 0._r8 - prod(:,163) = 0._r8 - prod(:,117) = 0._r8 - prod(:,53) = 0._r8 - prod(:,56) = 0._r8 - prod(:,57) = 0._r8 - prod(:,128) = 0._r8 - prod(:,58) = 0._r8 - prod(:,91) = 0._r8 - prod(:,104) = 0._r8 + prod(:,34) = 0._r8 + prod(:,35) = 0._r8 + prod(:,36) = 0._r8 + prod(:,37) = 0._r8 + prod(:,38) = 0._r8 + prod(:,39) = 0._r8 + prod(:,40) = 0._r8 + prod(:,41) = 0._r8 + prod(:,42) = 0._r8 + prod(:,43) = + extfrc(:,2) + prod(:,78) = 0._r8 prod(:,154) = 0._r8 - prod(:,101) = 0._r8 - prod(:,92) = 0._r8 - prod(:,152) = 0._r8 - prod(:,143) = 0._r8 + prod(:,151) = 0._r8 + prod(:,131) = 0._r8 + prod(:,192) = 0._r8 + prod(:,195) = 0._r8 + prod(:,155) = 0._r8 + prod(:,76) = 0._r8 + prod(:,79) = 0._r8 + prod(:,80) = 0._r8 + prod(:,161) = 0._r8 + prod(:,81) = 0._r8 prod(:,122) = 0._r8 - prod(:,181) = 0._r8 - prod(:,185) =rxt(:,88)*y(:,43) +rxt(:,90)*y(:,46) +rxt(:,40)*y(:,54) - prod(:,133) = 0._r8 - prod(:,139) = (rxt(:,113) +rxt(:,114) +rxt(:,115) +rxt(:,116) +rxt(:,117) + & + prod(:,137) = 0._r8 + prod(:,189) = 0._r8 + prod(:,44) = 0._r8 + prod(:,132) = 0._r8 + prod(:,45) = 0._r8 + prod(:,123) = 0._r8 + prod(:,179) = 0._r8 + prod(:,183) = 0._r8 + prod(:,152) = 0._r8 + prod(:,214) = 0._r8 + prod(:,232) = 0._r8 + prod(:,166) = 0._r8 + prod(:,176) = (rxt(:,113) +rxt(:,114) +rxt(:,115) +rxt(:,116) +rxt(:,117) + & rxt(:,119)) + extfrc(:,20) - prod(:,113) = 0._r8 - prod(:,96) = 0._r8 - prod(:,135) = 0._r8 - prod(:,199) = 0._r8 - prod(:,93) = 0._r8 - prod(:,176) = 0._r8 - prod(:,177) = 0._r8 - prod(:,178) = 0._r8 - prod(:,130) = 0._r8 - prod(:,180) = 0._r8 - prod(:,150) = 0._r8 - prod(:,125) = 0._r8 - prod(:,106) = (1.200_r8*rxt(:,112) +rxt(:,113) +rxt(:,117) + & - 1.200_r8*rxt(:,118)) + extfrc(:,19) - prod(:,126) = (rxt(:,114) +rxt(:,119)) + extfrc(:,18) - prod(:,138) = 0._r8 - prod(:,102) = (rxt(:,113) +rxt(:,115) +rxt(:,116) +rxt(:,117)) + extfrc(:,17) + prod(:,144) = 0._r8 + prod(:,128) = 0._r8 prod(:,168) = 0._r8 - prod(:,189) =rxt(:,12)*y(:,113) - prod(:,45) = 0._r8 + prod(:,124) = 0._r8 + prod(:,209) = 0._r8 + prod(:,210) = 0._r8 + prod(:,206) = 0._r8 prod(:,46) = 0._r8 - prod(:,137) = + extfrc(:,16) - prod(:,190) =.330_r8*rxt(:,41)*y(:,54) + extfrc(:,22) - prod(:,120) = + extfrc(:,23) - prod(:,94) = 0._r8 - prod(:,142) = 0._r8 - prod(:,169) = 0._r8 - prod(:,167) = 0._r8 - prod(:,166) = 0._r8 - prod(:,131) = 0._r8 + prod(:,47) = 0._r8 + prod(:,211) = 0._r8 + prod(:,163) = 0._r8 + prod(:,213) = 0._r8 + prod(:,181) = 0._r8 + prod(:,158) = 0._r8 + prod(:,49) = 0._r8 + prod(:,138) = (1.200_r8*rxt(:,112) +rxt(:,113) +rxt(:,117) + & + 1.200_r8*rxt(:,118)) + extfrc(:,15) + prod(:,156) = (rxt(:,114) +rxt(:,119)) + extfrc(:,14) + prod(:,174) = 0._r8 + prod(:,134) = (rxt(:,113) +rxt(:,115) +rxt(:,116) +rxt(:,117)) + prod(:,194) = 0._r8 + prod(:,223) = 0._r8 + prod(:,73) = 0._r8 + prod(:,74) = 0._r8 + prod(:,175) = + extfrc(:,13) + prod(:,224) = + extfrc(:,18) + prod(:,169) = + extfrc(:,19) + prod(:,126) = 0._r8 prod(:,171) = 0._r8 - prod(:,132) = 0._r8 - prod(:,103) = 0._r8 - prod(:,201) =.050_r8*rxt(:,41)*y(:,54) + prod(:,204) = 0._r8 + prod(:,201) = 0._r8 + prod(:,191) = 0._r8 + prod(:,164) = 0._r8 + prod(:,50) = 0._r8 + prod(:,205) = 0._r8 + prod(:,165) = 0._r8 + prod(:,51) = 0._r8 + prod(:,135) = 0._r8 + prod(:,237) = 0._r8 end if end subroutine indprd end module mo_indprd diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 index cf3ec45189..37400b9613 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_lin_matrix.F90 @@ -23,221 +23,208 @@ subroutine linmat01( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,536) = -( rxt(k,20) + het_rates(k,1) ) - mat(k,547) = -( rxt(k,21) + het_rates(k,2) ) - mat(k,1) = -( het_rates(k,4) ) - mat(k,2) = -( het_rates(k,5) ) - mat(k,858) = -( het_rates(k,6) ) - mat(k,86) = -( het_rates(k,7) ) - mat(k,273) = -( rxt(k,22) + het_rates(k,8) ) - mat(k,92) = -( rxt(k,23) + het_rates(k,9) ) - mat(k,279) = -( rxt(k,24) + het_rates(k,10) ) - mat(k,342) = -( rxt(k,25) + het_rates(k,11) ) - mat(k,274) = .500_r8*rxt(k,22) - mat(k,93) = rxt(k,23) - mat(k,491) = .200_r8*rxt(k,71) - mat(k,587) = .060_r8*rxt(k,73) - mat(k,197) = -( rxt(k,26) + het_rates(k,12) ) - mat(k,490) = .200_r8*rxt(k,71) - mat(k,585) = .200_r8*rxt(k,73) - mat(k,501) = -( rxt(k,27) + het_rates(k,13) ) - mat(k,156) = rxt(k,47) - mat(k,924) = rxt(k,57) - mat(k,493) = .200_r8*rxt(k,71) - mat(k,588) = .150_r8*rxt(k,73) - mat(k,225) = -( rxt(k,28) + het_rates(k,14) ) - mat(k,586) = .210_r8*rxt(k,73) - mat(k,163) = -( het_rates(k,15) ) - mat(k,259) = -( het_rates(k,16) ) - mat(k,1352) = -( het_rates(k,17) ) - mat(k,167) = rxt(k,75) - mat(k,2006) = rxt(k,76) - mat(k,440) = rxt(k,78) - mat(k,754) = rxt(k,100) - mat(k,656) = rxt(k,106) - mat(k,1565) = rxt(k,240)*y(k,34) + rxt(k,266)*y(k,35) & - + 3.000_r8*rxt(k,267)*y(k,55) + 2.000_r8*rxt(k,268)*y(k,78) & - + 2.000_r8*rxt(k,289)*y(k,41) + rxt(k,290)*y(k,43) - mat(k,1539) = 2.000_r8*rxt(k,277)*y(k,41) + rxt(k,279)*y(k,43) & - + 3.000_r8*rxt(k,284)*y(k,55) - mat(k,1713) = 2.000_r8*rxt(k,278)*y(k,41) + rxt(k,280)*y(k,43) & - + 3.000_r8*rxt(k,285)*y(k,55) - mat(k,166) = -( rxt(k,75) + het_rates(k,18) ) - mat(k,2019) = -( rxt(k,76) + het_rates(k,19) ) - mat(k,445) = rxt(k,77) - mat(k,438) = -( rxt(k,77) + rxt(k,78) + rxt(k,550) + rxt(k,553) + rxt(k,558) & + mat(k,640) = -( rxt(k,20) + het_rates(k,1) ) + mat(k,685) = -( rxt(k,21) + het_rates(k,2) ) + mat(k,1) = -( het_rates(k,3) ) + mat(k,2) = -( het_rates(k,4) ) + mat(k,3) = -( het_rates(k,5) ) + mat(k,988) = -( het_rates(k,6) ) + mat(k,158) = -( het_rates(k,7) ) + mat(k,401) = -( rxt(k,22) + het_rates(k,8) ) + mat(k,164) = -( rxt(k,23) + het_rates(k,9) ) + mat(k,383) = -( rxt(k,24) + het_rates(k,10) ) + mat(k,458) = -( rxt(k,25) + het_rates(k,11) ) + mat(k,402) = .500_r8*rxt(k,22) + mat(k,165) = rxt(k,23) + mat(k,661) = .200_r8*rxt(k,71) + mat(k,717) = .060_r8*rxt(k,73) + mat(k,284) = -( rxt(k,26) + het_rates(k,12) ) + mat(k,660) = .200_r8*rxt(k,71) + mat(k,715) = .200_r8*rxt(k,73) + mat(k,598) = -( rxt(k,27) + het_rates(k,13) ) + mat(k,229) = rxt(k,47) + mat(k,1111) = rxt(k,57) + mat(k,662) = .200_r8*rxt(k,71) + mat(k,718) = .150_r8*rxt(k,73) + mat(k,327) = -( rxt(k,28) + het_rates(k,14) ) + mat(k,716) = .210_r8*rxt(k,73) + mat(k,233) = -( het_rates(k,15) ) + mat(k,353) = -( het_rates(k,16) ) + mat(k,1509) = -( het_rates(k,17) ) + mat(k,237) = rxt(k,75) + mat(k,1561) = rxt(k,76) + mat(k,566) = rxt(k,78) + mat(k,139) = rxt(k,80) + mat(k,145) = rxt(k,81) + mat(k,472) = 2.000_r8*rxt(k,87) + mat(k,604) = rxt(k,88) + mat(k,447) = 3.000_r8*rxt(k,91) + mat(k,107) = 2.000_r8*rxt(k,99) + mat(k,827) = rxt(k,100) + mat(k,787) = rxt(k,106) + mat(k,236) = -( rxt(k,75) + het_rates(k,18) ) + mat(k,1563) = -( rxt(k,76) + het_rates(k,19) ) + mat(k,567) = rxt(k,77) + mat(k,564) = -( rxt(k,77) + rxt(k,78) + rxt(k,564) + rxt(k,567) + rxt(k,572) & + het_rates(k,20) ) - mat(k,169) = -( het_rates(k,22) ) - mat(k,240) = rxt(k,29) - mat(k,241) = -( rxt(k,29) + het_rates(k,23) ) - mat(k,200) = -( het_rates(k,24) ) - mat(k,450) = -( het_rates(k,25) ) - mat(k,177) = -( het_rates(k,26) ) - mat(k,246) = -( rxt(k,30) + het_rates(k,27) ) - mat(k,206) = -( het_rates(k,28) ) - mat(k,943) = -( het_rates(k,29) ) - mat(k,1245) = .700_r8*rxt(k,56) - mat(k,303) = -( rxt(k,31) + het_rates(k,30) ) - mat(k,55) = -( het_rates(k,31) ) - mat(k,181) = -( rxt(k,32) + het_rates(k,32) ) - mat(k,1849) = -( rxt(k,33) + rxt(k,34) + het_rates(k,42) ) - mat(k,543) = .100_r8*rxt(k,20) - mat(k,555) = .100_r8*rxt(k,21) - mat(k,312) = rxt(k,39) - mat(k,963) = rxt(k,44) - mat(k,976) = .330_r8*rxt(k,46) - mat(k,995) = rxt(k,48) - mat(k,583) = .690_r8*rxt(k,50) - mat(k,1147) = 1.340_r8*rxt(k,51) - mat(k,773) = rxt(k,58) - mat(k,435) = rxt(k,63) - mat(k,295) = rxt(k,64) - mat(k,488) = .375_r8*rxt(k,66) - mat(k,373) = .400_r8*rxt(k,68) - mat(k,988) = .680_r8*rxt(k,70) - mat(k,332) = rxt(k,309) - mat(k,348) = 2.000_r8*rxt(k,339) - mat(k,1574) = rxt(k,312)*y(k,54) + rxt(k,313)*y(k,54) - mat(k,1076) = -( rxt(k,35) + het_rates(k,45) ) - mat(k,540) = .400_r8*rxt(k,20) - mat(k,552) = .400_r8*rxt(k,21) - mat(k,248) = rxt(k,30) - mat(k,972) = .330_r8*rxt(k,46) - mat(k,222) = rxt(k,54) - mat(k,433) = rxt(k,63) - mat(k,52) = -( het_rates(k,47) ) - mat(k,898) = -( rxt(k,36) + het_rates(k,48) ) - mat(k,539) = .250_r8*rxt(k,20) - mat(k,551) = .250_r8*rxt(k,21) - mat(k,305) = .820_r8*rxt(k,31) - mat(k,966) = .170_r8*rxt(k,46) - mat(k,482) = .300_r8*rxt(k,66) - mat(k,369) = .050_r8*rxt(k,68) - mat(k,981) = .500_r8*rxt(k,70) - mat(k,1152) = -( rxt(k,37) + het_rates(k,49) ) - mat(k,282) = .180_r8*rxt(k,24) - mat(k,227) = rxt(k,28) - mat(k,498) = .400_r8*rxt(k,71) - mat(k,596) = .540_r8*rxt(k,73) - mat(k,318) = .510_r8*rxt(k,74) - mat(k,446) = -( het_rates(k,50) ) - mat(k,406) = -( rxt(k,38) + het_rates(k,51) ) - mat(k,708) = -( het_rates(k,52) ) - mat(k,309) = -( rxt(k,39) + het_rates(k,53) ) - mat(k,1543) = -( rxt(k,215)*y(k,54) + rxt(k,277)*y(k,41) + rxt(k,279)*y(k,43) & - + rxt(k,282)*y(k,46) + rxt(k,284)*y(k,55) + het_rates(k,56) ) - mat(k,168) = rxt(k,75) - mat(k,80) = 2.000_r8*rxt(k,92) - mat(k,47) = 2.000_r8*rxt(k,93) - mat(k,2131) = rxt(k,94) - mat(k,908) = rxt(k,95) - mat(k,103) = rxt(k,98) - mat(k,1339) = rxt(k,104) - mat(k,764) = rxt(k,107) - mat(k,1569) = 4.000_r8*rxt(k,239)*y(k,33) + rxt(k,240)*y(k,34) & - + 2.000_r8*rxt(k,241)*y(k,36) + 2.000_r8*rxt(k,242)*y(k,37) & - + 2.000_r8*rxt(k,243)*y(k,38) + rxt(k,244)*y(k,39) & - + 2.000_r8*rxt(k,245)*y(k,40) + rxt(k,291)*y(k,82) & - + rxt(k,292)*y(k,83) + rxt(k,293)*y(k,84) - mat(k,1717) = 3.000_r8*rxt(k,281)*y(k,44) + rxt(k,283)*y(k,46) & - + rxt(k,286)*y(k,82) + rxt(k,287)*y(k,83) + rxt(k,288)*y(k,84) - mat(k,79) = -( rxt(k,92) + het_rates(k,57) ) - mat(k,46) = -( rxt(k,93) + rxt(k,249) + het_rates(k,58) ) - mat(k,2143) = -( rxt(k,94) + het_rates(k,59) ) - mat(k,914) = rxt(k,96) - mat(k,234) = rxt(k,108) - mat(k,48) = 2.000_r8*rxt(k,249) - mat(k,906) = -( rxt(k,95) + rxt(k,96) + rxt(k,552) + rxt(k,557) + rxt(k,563) & + mat(k,4) = -( het_rates(k,21) ) + mat(k,245) = -( het_rates(k,22) ) + mat(k,342) = rxt(k,29) + mat(k,343) = -( rxt(k,29) + het_rates(k,23) ) + mat(k,290) = -( het_rates(k,24) ) + mat(k,548) = -( het_rates(k,25) ) + mat(k,263) = -( het_rates(k,26) ) + mat(k,348) = -( rxt(k,30) + het_rates(k,27) ) + mat(k,296) = -( het_rates(k,28) ) + mat(k,1131) = -( het_rates(k,29) ) + mat(k,1368) = .700_r8*rxt(k,56) + mat(k,413) = -( rxt(k,31) + het_rates(k,30) ) + mat(k,302) = -( het_rates(k,31) ) + mat(k,267) = -( rxt(k,32) + het_rates(k,32) ) + mat(k,99) = -( rxt(k,79) + het_rates(k,33) ) + mat(k,137) = -( rxt(k,80) + het_rates(k,34) ) + mat(k,142) = -( rxt(k,81) + het_rates(k,35) ) + mat(k,109) = -( rxt(k,82) + het_rates(k,36) ) + mat(k,147) = -( rxt(k,83) + het_rates(k,37) ) + mat(k,113) = -( rxt(k,84) + het_rates(k,38) ) + mat(k,152) = -( rxt(k,85) + het_rates(k,39) ) + mat(k,117) = -( rxt(k,86) + het_rates(k,40) ) + mat(k,470) = -( rxt(k,87) + het_rates(k,41) ) + mat(k,2354) = -( rxt(k,33) + rxt(k,34) + het_rates(k,42) ) + mat(k,649) = .100_r8*rxt(k,20) + mat(k,694) = .100_r8*rxt(k,21) + mat(k,393) = rxt(k,39) + mat(k,2285) = .180_r8*rxt(k,40) + mat(k,1168) = rxt(k,44) + mat(k,1204) = .330_r8*rxt(k,46) + mat(k,1211) = rxt(k,48) + mat(k,737) = rxt(k,50) + mat(k,1275) = 1.340_r8*rxt(k,51) + mat(k,876) = rxt(k,58) + mat(k,546) = rxt(k,63) + mat(k,411) = rxt(k,64) + mat(k,659) = .375_r8*rxt(k,66) + mat(k,483) = .400_r8*rxt(k,68) + mat(k,1109) = .680_r8*rxt(k,70) + mat(k,444) = rxt(k,308) + mat(k,465) = 2.000_r8*rxt(k,338) + mat(k,602) = -( rxt(k,88) + het_rates(k,43) ) + mat(k,121) = -( rxt(k,89) + het_rates(k,44) ) + mat(k,1149) = -( rxt(k,35) + het_rates(k,45) ) + mat(k,644) = .400_r8*rxt(k,20) + mat(k,690) = .400_r8*rxt(k,21) + mat(k,350) = rxt(k,30) + mat(k,1190) = .330_r8*rxt(k,46) + mat(k,321) = rxt(k,54) + mat(k,542) = rxt(k,63) + mat(k,369) = -( rxt(k,90) + het_rates(k,46) ) + mat(k,102) = -( het_rates(k,47) ) + mat(k,1078) = -( rxt(k,36) + het_rates(k,48) ) + mat(k,643) = .250_r8*rxt(k,20) + mat(k,689) = .250_r8*rxt(k,21) + mat(k,415) = .820_r8*rxt(k,31) + mat(k,1189) = .170_r8*rxt(k,46) + mat(k,651) = .300_r8*rxt(k,66) + mat(k,480) = .050_r8*rxt(k,68) + mat(k,1100) = .500_r8*rxt(k,70) + mat(k,1279) = -( rxt(k,37) + het_rates(k,49) ) + mat(k,386) = .180_r8*rxt(k,24) + mat(k,329) = rxt(k,28) + mat(k,670) = .400_r8*rxt(k,71) + mat(k,726) = .540_r8*rxt(k,73) + mat(k,428) = .510_r8*rxt(k,74) + mat(k,703) = -( het_rates(k,50) ) + mat(k,618) = -( rxt(k,38) + het_rates(k,51) ) + mat(k,811) = -( het_rates(k,52) ) + mat(k,389) = -( rxt(k,39) + het_rates(k,53) ) + mat(k,2283) = -( rxt(k,40) + rxt(k,41) + het_rates(k,54) ) + mat(k,445) = -( rxt(k,91) + het_rates(k,55) ) + mat(k,1953) = -( het_rates(k,56) ) + mat(k,238) = rxt(k,75) + mat(k,101) = 4.000_r8*rxt(k,79) + mat(k,141) = rxt(k,80) + mat(k,112) = 2.000_r8*rxt(k,82) + mat(k,151) = 2.000_r8*rxt(k,83) + mat(k,116) = 2.000_r8*rxt(k,84) + mat(k,156) = rxt(k,85) + mat(k,120) = 2.000_r8*rxt(k,86) + mat(k,123) = 3.000_r8*rxt(k,89) + mat(k,373) = rxt(k,90) + mat(k,174) = 2.000_r8*rxt(k,92) + mat(k,95) = 2.000_r8*rxt(k,93) + mat(k,1595) = rxt(k,94) + mat(k,959) = rxt(k,95) + mat(k,227) = rxt(k,98) + mat(k,223) = rxt(k,101) + mat(k,253) = rxt(k,102) + mat(k,276) = rxt(k,103) + mat(k,1501) = rxt(k,104) + mat(k,839) = rxt(k,107) + mat(k,173) = -( rxt(k,92) + het_rates(k,57) ) + mat(k,93) = -( rxt(k,93) + rxt(k,249) + het_rates(k,58) ) + mat(k,1590) = -( rxt(k,94) + het_rates(k,59) ) + mat(k,955) = rxt(k,96) + mat(k,335) = rxt(k,108) + mat(k,94) = 2.000_r8*rxt(k,249) + mat(k,953) = -( rxt(k,95) + rxt(k,96) + rxt(k,566) + rxt(k,571) + rxt(k,577) & + het_rates(k,60) ) - mat(k,997) = -( het_rates(k,62) ) - mat(k,94) = 1.500_r8*rxt(k,23) - mat(k,281) = .450_r8*rxt(k,24) - mat(k,503) = .600_r8*rxt(k,27) - mat(k,226) = rxt(k,28) - mat(k,1837) = rxt(k,33) + rxt(k,34) - mat(k,1075) = rxt(k,35) - mat(k,1151) = rxt(k,37) - mat(k,961) = rxt(k,44) - mat(k,799) = 2.000_r8*rxt(k,45) - mat(k,970) = .330_r8*rxt(k,46) - mat(k,1139) = 1.340_r8*rxt(k,52) - mat(k,1247) = .700_r8*rxt(k,56) - mat(k,127) = 1.500_r8*rxt(k,65) - mat(k,485) = .250_r8*rxt(k,66) - mat(k,918) = rxt(k,69) - mat(k,983) = 1.700_r8*rxt(k,70) - mat(k,254) = rxt(k,137) - mat(k,1534) = rxt(k,282)*y(k,46) - mat(k,518) = rxt(k,577)*y(k,63) - mat(k,59) = -( rxt(k,97) + het_rates(k,64) ) - mat(k,1557) = rxt(k,240)*y(k,34) + rxt(k,242)*y(k,37) & - + 2.000_r8*rxt(k,243)*y(k,38) + 2.000_r8*rxt(k,244)*y(k,39) & - + rxt(k,245)*y(k,40) + rxt(k,266)*y(k,35) & - + 2.000_r8*rxt(k,268)*y(k,78) + rxt(k,292)*y(k,83) & - + rxt(k,293)*y(k,84) - mat(k,1593) = rxt(k,287)*y(k,83) + rxt(k,288)*y(k,84) - mat(k,101) = -( rxt(k,98) + het_rates(k,65) ) - mat(k,1559) = rxt(k,241)*y(k,36) + rxt(k,242)*y(k,37) + rxt(k,291)*y(k,82) - mat(k,1598) = rxt(k,286)*y(k,82) - mat(k,121) = -( het_rates(k,66) ) - mat(k,191) = -( het_rates(k,67) ) - mat(k,3) = -( het_rates(k,68) ) - mat(k,4) = -( het_rates(k,69) ) - mat(k,5) = -( het_rates(k,70) ) - mat(k,62) = -( rxt(k,43) + het_rates(k,72) ) - mat(k,673) = -( rxt(k,271)*y(k,54) + het_rates(k,73) ) - mat(k,60) = 2.000_r8*rxt(k,97) - mat(k,102) = rxt(k,98) - mat(k,153) = rxt(k,105) - mat(k,1561) = rxt(k,244)*y(k,39) + rxt(k,266)*y(k,35) - mat(k,960) = -( rxt(k,44) + het_rates(k,74) ) - mat(k,967) = .330_r8*rxt(k,46) - mat(k,483) = .250_r8*rxt(k,66) - mat(k,798) = -( rxt(k,45) + rxt(k,520) + het_rates(k,75) ) - mat(k,276) = rxt(k,22) - mat(k,280) = .130_r8*rxt(k,24) - mat(k,237) = .700_r8*rxt(k,62) - mat(k,497) = .600_r8*rxt(k,71) - mat(k,593) = .340_r8*rxt(k,73) - mat(k,317) = .170_r8*rxt(k,74) - mat(k,1928) = -( het_rates(k,76) ) - mat(k,2164) = 2.000_r8*rxt(k,2) + rxt(k,3) - mat(k,1851) = 2.000_r8*rxt(k,33) - mat(k,313) = rxt(k,39) - mat(k,758) = rxt(k,100) - mat(k,1344) = rxt(k,104) - mat(k,154) = rxt(k,105) - mat(k,1576) = rxt(k,312)*y(k,54) - mat(k,1104) = -( het_rates(k,77) ) - mat(k,2150) = rxt(k,1) - mat(k,1838) = rxt(k,34) - mat(k,1563) = rxt(k,313)*y(k,54) - mat(k,474) = -( rxt(k,4) + het_rates(k,79) ) - mat(k,2052) = .500_r8*rxt(k,521) - mat(k,65) = -( rxt(k,136) + het_rates(k,80) ) - mat(k,753) = -( rxt(k,100) + het_rates(k,81) ) - mat(k,1337) = -( rxt(k,104) + het_rates(k,85) ) - mat(k,1538) = rxt(k,215)*y(k,54) + rxt(k,277)*y(k,41) + rxt(k,279)*y(k,43) & - + 2.000_r8*rxt(k,282)*y(k,46) + rxt(k,284)*y(k,55) - mat(k,105) = -( het_rates(k,86) ) - mat(k,712) = -( het_rates(k,87) ) - mat(k,152) = -( rxt(k,105) + het_rates(k,88) ) - mat(k,672) = rxt(k,271)*y(k,54) - mat(k,1951) = -( rxt(k,9) + het_rates(k,89) ) - mat(k,977) = rxt(k,522) - mat(k,511) = rxt(k,523) - mat(k,428) = rxt(k,524) - mat(k,189) = 2.000_r8*rxt(k,525) + 2.000_r8*rxt(k,548) + 2.000_r8*rxt(k,551) & - + 2.000_r8*rxt(k,562) - mat(k,271) = rxt(k,526) - mat(k,936) = rxt(k,527) - mat(k,1993) = .500_r8*rxt(k,529) - mat(k,1909) = rxt(k,530) - mat(k,289) = rxt(k,531) - mat(k,161) = rxt(k,532) - mat(k,524) = rxt(k,533) - mat(k,443) = rxt(k,550) + rxt(k,553) + rxt(k,558) - mat(k,912) = rxt(k,552) + rxt(k,557) + rxt(k,563) + mat(k,5) = -( het_rates(k,61) ) + mat(k,1158) = -( het_rates(k,62) ) + mat(k,166) = 1.500_r8*rxt(k,23) + mat(k,385) = .450_r8*rxt(k,24) + mat(k,600) = .600_r8*rxt(k,27) + mat(k,328) = rxt(k,28) + mat(k,2334) = rxt(k,33) + rxt(k,34) + mat(k,1150) = rxt(k,35) + mat(k,1278) = rxt(k,37) + mat(k,2265) = .380_r8*rxt(k,40) + mat(k,1447) = rxt(k,42) + rxt(k,110) + mat(k,1163) = rxt(k,44) + mat(k,1053) = 2.000_r8*rxt(k,45) + mat(k,1191) = .330_r8*rxt(k,46) + mat(k,1266) = 1.340_r8*rxt(k,52) + mat(k,1370) = .700_r8*rxt(k,56) + mat(k,198) = 1.500_r8*rxt(k,65) + mat(k,653) = .250_r8*rxt(k,66) + mat(k,1073) = rxt(k,69) + mat(k,1102) = 1.700_r8*rxt(k,70) + mat(k,364) = rxt(k,137) + mat(k,1448) = -( rxt(k,42) + rxt(k,110) + het_rates(k,63) ) + mat(k,620) = rxt(k,38) + mat(k,2266) = .440_r8*rxt(k,40) + mat(k,534) = .400_r8*rxt(k,61) + mat(k,656) = rxt(k,66) + mat(k,1105) = .800_r8*rxt(k,70) + mat(k,242) = -( rxt(k,97) + het_rates(k,64) ) + mat(k,138) = rxt(k,80) + mat(k,143) = rxt(k,81) + mat(k,149) = rxt(k,83) + mat(k,114) = 2.000_r8*rxt(k,84) + mat(k,153) = 2.000_r8*rxt(k,85) + mat(k,118) = rxt(k,86) + mat(k,106) = 2.000_r8*rxt(k,99) + mat(k,248) = rxt(k,102) + mat(k,271) = rxt(k,103) + mat(k,224) = -( rxt(k,98) + het_rates(k,65) ) + mat(k,110) = rxt(k,82) + mat(k,148) = rxt(k,83) + mat(k,220) = rxt(k,101) + mat(k,192) = -( het_rates(k,66) ) + mat(k,308) = -( het_rates(k,67) ) + mat(k,6) = -( het_rates(k,68) ) + mat(k,7) = -( het_rates(k,69) ) + mat(k,8) = -( het_rates(k,70) ) + mat(k,9) = -( rxt(k,594) + het_rates(k,71) ) + mat(k,125) = -( rxt(k,43) + het_rates(k,72) ) + mat(k,923) = -( het_rates(k,73) ) + mat(k,144) = rxt(k,81) + mat(k,154) = rxt(k,85) + mat(k,243) = 2.000_r8*rxt(k,97) + mat(k,225) = rxt(k,98) + mat(k,288) = rxt(k,105) + mat(k,1164) = -( rxt(k,44) + het_rates(k,74) ) + mat(k,1192) = .330_r8*rxt(k,46) + mat(k,654) = .250_r8*rxt(k,66) end do end subroutine linmat01 subroutine linmat02( avec_len, mat, y, rxt, het_rates ) @@ -260,207 +247,207 @@ subroutine linmat02( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,361) = -( rxt(k,10) + rxt(k,11) + rxt(k,212) + het_rates(k,90) ) - mat(k,654) = -( rxt(k,106) + het_rates(k,91) ) - mat(k,439) = rxt(k,550) + rxt(k,553) + rxt(k,558) - mat(k,762) = -( rxt(k,107) + het_rates(k,92) ) - mat(k,905) = rxt(k,552) + rxt(k,557) + rxt(k,563) - mat(k,968) = -( rxt(k,46) + rxt(k,522) + het_rates(k,93) ) - mat(k,155) = -( rxt(k,47) + het_rates(k,94) ) - mat(k,1188) = rxt(k,413) - mat(k,991) = -( rxt(k,48) + het_rates(k,95) ) - mat(k,969) = .170_r8*rxt(k,46) - mat(k,212) = -( het_rates(k,96) ) - mat(k,68) = -( het_rates(k,97) ) - mat(k,781) = -( het_rates(k,98) ) - mat(k,505) = -( rxt(k,523) + het_rates(k,99) ) - mat(k,422) = -( rxt(k,524) + het_rates(k,100) ) - mat(k,1124) = -( het_rates(k,101) ) - mat(k,297) = -( rxt(k,49) + het_rates(k,102) ) - mat(k,578) = -( rxt(k,50) + het_rates(k,103) ) - mat(k,298) = rxt(k,49) - mat(k,39) = -( het_rates(k,104) ) - mat(k,1140) = -( rxt(k,51) + rxt(k,52) + het_rates(k,105) ) - mat(k,580) = .288_r8*rxt(k,50) - mat(k,215) = -( het_rates(k,106) ) - mat(k,417) = -( rxt(k,53) + het_rates(k,107) ) - mat(k,535) = .800_r8*rxt(k,20) - mat(k,546) = .800_r8*rxt(k,21) - mat(k,220) = -( rxt(k,54) + het_rates(k,108) ) - mat(k,466) = -( rxt(k,55) + rxt(k,395) + het_rates(k,109) ) - mat(k,820) = -( het_rates(k,110) ) - mat(k,1251) = -( rxt(k,56) + het_rates(k,111) ) - mat(k,581) = .402_r8*rxt(k,50) - mat(k,744) = -( rxt(k,111) + het_rates(k,112) ) - mat(k,1475) = rxt(k,15) - mat(k,517) = rxt(k,578) - mat(k,185) = -( rxt(k,13) + rxt(k,14) + rxt(k,213) + rxt(k,525) + rxt(k,548) & - + rxt(k,551) + rxt(k,562) + het_rates(k,114) ) - mat(k,267) = -( rxt(k,526) + het_rates(k,115) ) - mat(k,928) = -( rxt(k,57) + rxt(k,527) + het_rates(k,116) ) - mat(k,6) = -( het_rates(k,117) ) - mat(k,7) = -( het_rates(k,118) ) - mat(k,8) = -( het_rates(k,119) ) - mat(k,49) = -( het_rates(k,120) ) - mat(k,9) = -( rxt(k,528) + het_rates(k,121) ) - mat(k,1507) = -( rxt(k,15) + rxt(k,16) + het_rates(k,124) ) - mat(k,186) = rxt(k,14) - mat(k,1984) = rxt(k,17) + .500_r8*rxt(k,529) - mat(k,1900) = rxt(k,19) - mat(k,686) = rxt(k,575) - mat(k,1568) = 2.000_r8*rxt(k,206)*y(k,113) - mat(k,1994) = -( rxt(k,17) + rxt(k,529) + het_rates(k,125) ) - mat(k,1952) = rxt(k,9) - mat(k,365) = rxt(k,11) + rxt(k,212) - mat(k,190) = rxt(k,13) + rxt(k,213) - mat(k,1910) = rxt(k,18) - mat(k,544) = rxt(k,20) - mat(k,978) = rxt(k,46) - mat(k,301) = rxt(k,49) - mat(k,472) = rxt(k,55) + rxt(k,395) - mat(k,937) = rxt(k,57) - mat(k,774) = rxt(k,58) - mat(k,290) = rxt(k,59) - mat(k,162) = rxt(k,60) - mat(k,356) = .600_r8*rxt(k,61) + rxt(k,346) - mat(k,525) = rxt(k,67) - mat(k,444) = rxt(k,77) - mat(k,913) = rxt(k,96) - mat(k,73) = rxt(k,470) - mat(k,1907) = -( rxt(k,18) + rxt(k,19) + rxt(k,530) + het_rates(k,126) ) - mat(k,364) = rxt(k,10) - mat(k,188) = rxt(k,13) + rxt(k,14) + rxt(k,213) - mat(k,355) = .400_r8*rxt(k,61) - mat(k,442) = rxt(k,78) - mat(k,911) = rxt(k,95) - mat(k,769) = -( rxt(k,58) + het_rates(k,127) ) - mat(k,285) = -( rxt(k,59) + rxt(k,531) + het_rates(k,128) ) - mat(k,10) = -( het_rates(k,129) ) - mat(k,11) = -( het_rates(k,130) ) - mat(k,12) = -( het_rates(k,131) ) - mat(k,13) = -( het_rates(k,132) ) - mat(k,1824) = -( rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + mat(k,1052) = -( rxt(k,45) + rxt(k,520) + het_rates(k,75) ) + mat(k,404) = rxt(k,22) + mat(k,384) = .130_r8*rxt(k,24) + mat(k,339) = .700_r8*rxt(k,62) + mat(k,668) = .600_r8*rxt(k,71) + mat(k,724) = .340_r8*rxt(k,73) + mat(k,427) = .170_r8*rxt(k,74) + mat(k,2095) = -( het_rates(k,76) ) + mat(k,2440) = 2.000_r8*rxt(k,2) + rxt(k,3) + mat(k,2349) = 2.000_r8*rxt(k,34) + mat(k,391) = rxt(k,39) + mat(k,2280) = .330_r8*rxt(k,40) + rxt(k,41) + mat(k,831) = rxt(k,100) + mat(k,1503) = rxt(k,104) + mat(k,289) = rxt(k,105) + mat(k,1459) = -( het_rates(k,77) ) + mat(k,2426) = rxt(k,1) + mat(k,2336) = rxt(k,33) + mat(k,2267) = 1.440_r8*rxt(k,40) + mat(k,105) = -( rxt(k,99) + het_rates(k,78) ) + mat(k,611) = -( rxt(k,4) + het_rates(k,79) ) + mat(k,128) = -( rxt(k,136) + het_rates(k,80) ) + mat(k,826) = -( rxt(k,100) + het_rates(k,81) ) + mat(k,219) = -( rxt(k,101) + het_rates(k,82) ) + mat(k,249) = -( rxt(k,102) + het_rates(k,83) ) + mat(k,272) = -( rxt(k,103) + het_rates(k,84) ) + mat(k,1493) = -( rxt(k,104) + het_rates(k,85) ) + mat(k,180) = -( het_rates(k,86) ) + mat(k,908) = -( het_rates(k,87) ) + mat(k,287) = -( rxt(k,105) + het_rates(k,88) ) + mat(k,1977) = -( rxt(k,9) + het_rates(k,89) ) + mat(k,1201) = rxt(k,522) + mat(k,595) = rxt(k,523) + mat(k,562) = rxt(k,524) + mat(k,281) = 2.000_r8*rxt(k,525) + 2.000_r8*rxt(k,562) + 2.000_r8*rxt(k,565) & + + 2.000_r8*rxt(k,576) + mat(k,381) = rxt(k,526) + mat(k,1122) = rxt(k,527) + mat(k,1848) = .500_r8*rxt(k,529) + mat(k,1908) = rxt(k,530) + mat(k,400) = rxt(k,531) + mat(k,241) = rxt(k,532) + mat(k,629) = rxt(k,533) + mat(k,570) = rxt(k,564) + rxt(k,567) + rxt(k,572) + mat(k,960) = rxt(k,566) + rxt(k,571) + rxt(k,577) + mat(k,2204) = -( rxt(k,521) + het_rates(k,90) ) + mat(k,498) = rxt(k,11) + rxt(k,212) + mat(k,648) = rxt(k,20) + mat(k,693) = .900_r8*rxt(k,21) + mat(k,406) = rxt(k,22) + mat(k,167) = 1.500_r8*rxt(k,23) + mat(k,388) = .560_r8*rxt(k,24) + mat(k,460) = rxt(k,25) + mat(k,286) = .600_r8*rxt(k,26) + mat(k,601) = .600_r8*rxt(k,27) + mat(k,331) = rxt(k,28) + mat(k,347) = rxt(k,29) + mat(k,352) = rxt(k,30) + mat(k,417) = rxt(k,31) + mat(k,1155) = rxt(k,35) + mat(k,1285) = rxt(k,37) + mat(k,1167) = 2.000_r8*rxt(k,44) + mat(k,1056) = 2.000_r8*rxt(k,45) + mat(k,1202) = .670_r8*rxt(k,46) + mat(k,232) = rxt(k,47) + mat(k,1210) = rxt(k,48) + mat(k,424) = rxt(k,49) + mat(k,736) = rxt(k,50) + mat(k,1274) = 1.340_r8*rxt(k,51) + .660_r8*rxt(k,52) + mat(k,1124) = rxt(k,57) + mat(k,341) = rxt(k,62) + mat(k,545) = rxt(k,63) + mat(k,200) = rxt(k,65) + mat(k,658) = rxt(k,66) + mat(k,630) = rxt(k,67) + mat(k,482) = rxt(k,68) + mat(k,1077) = rxt(k,69) + mat(k,1107) = 1.200_r8*rxt(k,70) + mat(k,672) = rxt(k,71) + mat(k,729) = rxt(k,73) + mat(k,430) = rxt(k,74) + mat(k,443) = rxt(k,308) + mat(k,464) = rxt(k,338) + mat(k,1341) = rxt(k,413) + mat(k,493) = -( rxt(k,10) + rxt(k,11) + rxt(k,212) + het_rates(k,91) ) + mat(k,785) = -( rxt(k,106) + het_rates(k,92) ) + mat(k,565) = rxt(k,564) + rxt(k,567) + rxt(k,572) + mat(k,835) = -( rxt(k,107) + het_rates(k,93) ) + mat(k,952) = rxt(k,566) + rxt(k,571) + rxt(k,577) + mat(k,1193) = -( rxt(k,46) + rxt(k,522) + het_rates(k,94) ) + mat(k,228) = -( rxt(k,47) + het_rates(k,95) ) + mat(k,1313) = rxt(k,413) + mat(k,1206) = -( rxt(k,48) + het_rates(k,96) ) + mat(k,1194) = .170_r8*rxt(k,46) + mat(k,324) = -( het_rates(k,97) ) + mat(k,131) = -( het_rates(k,98) ) + mat(k,880) = -( het_rates(k,99) ) + mat(k,589) = -( rxt(k,523) + het_rates(k,100) ) + mat(k,556) = -( rxt(k,524) + het_rates(k,101) ) + mat(k,419) = -( rxt(k,49) + het_rates(k,102) ) + mat(k,731) = -( rxt(k,50) + het_rates(k,103) ) + mat(k,420) = rxt(k,49) + mat(k,74) = -( het_rates(k,104) ) + mat(k,1267) = -( rxt(k,51) + rxt(k,52) + het_rates(k,105) ) + mat(k,733) = .300_r8*rxt(k,50) + mat(k,314) = -( het_rates(k,106) ) + mat(k,515) = -( rxt(k,53) + het_rates(k,107) ) + mat(k,639) = .800_r8*rxt(k,20) + mat(k,684) = .800_r8*rxt(k,21) + mat(k,319) = -( rxt(k,54) + het_rates(k,108) ) + mat(k,580) = -( rxt(k,55) + rxt(k,395) + het_rates(k,109) ) + mat(k,1016) = -( het_rates(k,110) ) + mat(k,1374) = -( rxt(k,56) + het_rates(k,111) ) + mat(k,734) = .700_r8*rxt(k,50) + mat(k,969) = -( rxt(k,111) + het_rates(k,112) ) + mat(k,2036) = rxt(k,15) + mat(k,806) = rxt(k,592) + mat(k,254) = -( rxt(k,12) + het_rates(k,113) ) + mat(k,278) = -( rxt(k,13) + rxt(k,14) + rxt(k,213) + rxt(k,525) + rxt(k,562) & + + rxt(k,565) + rxt(k,576) + het_rates(k,114) ) + mat(k,377) = -( rxt(k,526) + het_rates(k,115) ) + mat(k,1115) = -( rxt(k,57) + rxt(k,527) + het_rates(k,116) ) + mat(k,10) = -( het_rates(k,117) ) + mat(k,11) = -( het_rates(k,118) ) + mat(k,12) = -( het_rates(k,119) ) + mat(k,96) = -( het_rates(k,120) ) + mat(k,13) = -( rxt(k,528) + het_rates(k,121) ) + mat(k,14) = -( rxt(k,596) + het_rates(k,122) ) + mat(k,15) = -( rxt(k,595) + het_rates(k,123) ) + mat(k,2073) = -( rxt(k,15) + rxt(k,16) + het_rates(k,124) ) + mat(k,282) = rxt(k,14) + mat(k,1849) = rxt(k,17) + .500_r8*rxt(k,529) + mat(k,1909) = rxt(k,19) + mat(k,856) = rxt(k,589) + mat(k,1845) = -( rxt(k,17) + rxt(k,529) + het_rates(k,125) ) + mat(k,1974) = rxt(k,9) + mat(k,496) = rxt(k,11) + rxt(k,212) + mat(k,279) = rxt(k,13) + rxt(k,213) + mat(k,1905) = rxt(k,18) + mat(k,647) = rxt(k,20) + mat(k,1199) = rxt(k,46) + mat(k,423) = rxt(k,49) + mat(k,585) = rxt(k,55) + rxt(k,395) + mat(k,1121) = rxt(k,57) + mat(k,875) = rxt(k,58) + mat(k,399) = rxt(k,59) + mat(k,240) = rxt(k,60) + mat(k,536) = .600_r8*rxt(k,61) + rxt(k,345) + mat(k,628) = rxt(k,67) + mat(k,568) = rxt(k,77) + mat(k,957) = rxt(k,96) + mat(k,136) = rxt(k,470) + mat(k,1906) = -( rxt(k,18) + rxt(k,19) + rxt(k,530) + het_rates(k,126) ) + mat(k,497) = rxt(k,10) + mat(k,280) = rxt(k,13) + rxt(k,14) + rxt(k,213) + mat(k,537) = .400_r8*rxt(k,61) + mat(k,569) = rxt(k,78) + mat(k,958) = rxt(k,95) + mat(k,871) = -( rxt(k,58) + het_rates(k,127) ) + mat(k,395) = -( rxt(k,59) + rxt(k,531) + het_rates(k,128) ) + mat(k,16) = -( het_rates(k,129) ) + mat(k,17) = -( het_rates(k,130) ) + mat(k,18) = -( het_rates(k,131) ) + mat(k,19) = -( het_rates(k,132) ) + mat(k,2327) = -( rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + rxt(k,125) + het_rates(k,133) ) - mat(k,2161) = rxt(k,2) - mat(k,1433) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,127) + rxt(k,128) + rxt(k,129) & + mat(k,2444) = rxt(k,2) + mat(k,1550) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,127) + rxt(k,128) + rxt(k,129) & + rxt(k,131) + rxt(k,132) + rxt(k,133) + 2.000_r8*rxt(k,134) & + 2.000_r8*rxt(k,135) - mat(k,1783) = rxt(k,8) - mat(k,187) = rxt(k,14) - mat(k,1512) = rxt(k,15) - mat(k,1989) = rxt(k,17) - mat(k,1905) = rxt(k,18) - mat(k,2013) = rxt(k,76) - mat(k,2135) = rxt(k,94) - mat(k,233) = rxt(k,108) - mat(k,1325) = rxt(k,138) - mat(k,895) = rxt(k,139) - mat(k,175) = rxt(k,140) - mat(k,1573) = rxt(k,155) - mat(k,1427) = -( rxt(k,5) + rxt(k,6) + rxt(k,126) + rxt(k,127) + rxt(k,128) & + mat(k,2417) = rxt(k,8) + mat(k,283) = rxt(k,14) + mat(k,2078) = rxt(k,15) + mat(k,1854) = rxt(k,17) + mat(k,1914) = rxt(k,18) + mat(k,2284) = .180_r8*rxt(k,40) + mat(k,1456) = rxt(k,42) + rxt(k,110) + mat(k,1574) = rxt(k,76) + mat(k,1601) = rxt(k,94) + mat(k,336) = rxt(k,108) + mat(k,1485) = rxt(k,138) + mat(k,949) = rxt(k,139) + mat(k,261) = rxt(k,140) + mat(k,1644) = rxt(k,155) + mat(k,1540) = -( rxt(k,5) + rxt(k,6) + rxt(k,126) + rxt(k,127) + rxt(k,128) & + rxt(k,129) + rxt(k,130) + rxt(k,131) + rxt(k,132) + rxt(k,133) & + rxt(k,134) + rxt(k,135) + het_rates(k,134) ) - mat(k,1777) = rxt(k,8) - mat(k,1899) = rxt(k,19) - mat(k,75) = rxt(k,151) + rxt(k,159) - mat(k,78) = rxt(k,152) - mat(k,1567) = rxt(k,207)*y(k,113) - mat(k,1782) = -( rxt(k,7) + rxt(k,8) + het_rates(k,135) ) - mat(k,230) = -( rxt(k,108) + het_rates(k,137) ) - mat(k,251) = -( rxt(k,137) + het_rates(k,138) ) - mat(k,160) = -( rxt(k,60) + rxt(k,532) + het_rates(k,139) ) - mat(k,350) = -( rxt(k,61) + rxt(k,346) + het_rates(k,140) ) - mat(k,71) = -( rxt(k,470) + het_rates(k,141) ) - mat(k,357) = -( het_rates(k,142) ) - mat(k,182) = rxt(k,32) - mat(k,96) = -( het_rates(k,143) ) - mat(k,235) = -( rxt(k,62) + het_rates(k,144) ) - mat(k,14) = -( het_rates(k,145) ) - mat(k,15) = -( het_rates(k,146) ) - mat(k,430) = -( rxt(k,63) + het_rates(k,147) ) - mat(k,291) = -( rxt(k,64) + het_rates(k,148) ) - mat(k,600) = -( het_rates(k,149) ) - mat(k,252) = rxt(k,137) - mat(k,1316) = rxt(k,138) - mat(k,1318) = -( rxt(k,138) + het_rates(k,151) ) - mat(k,893) = rxt(k,139) - mat(k,892) = -( rxt(k,139) + het_rates(k,152) ) - mat(k,174) = rxt(k,140) - mat(k,173) = -( rxt(k,140) + het_rates(k,153) ) - mat(k,66) = rxt(k,136) - mat(k,16) = -( het_rates(k,154) ) - mat(k,17) = -( het_rates(k,155) ) - mat(k,18) = -( het_rates(k,156) ) - mat(k,19) = -( rxt(k,141) + het_rates(k,157) ) - mat(k,20) = -( rxt(k,142) + het_rates(k,158) ) - mat(k,21) = -( rxt(k,143) + het_rates(k,159) ) - mat(k,22) = -( rxt(k,144) + het_rates(k,160) ) - mat(k,23) = -( rxt(k,145) + het_rates(k,161) ) - mat(k,24) = -( rxt(k,146) + het_rates(k,162) ) - mat(k,25) = -( rxt(k,147) + het_rates(k,163) ) - mat(k,26) = -( rxt(k,148) + het_rates(k,164) ) - mat(k,27) = -( rxt(k,149) + het_rates(k,165) ) - mat(k,28) = -( rxt(k,150) + het_rates(k,166) ) - mat(k,29) = -( het_rates(k,167) ) - mat(k,797) = rxt(k,520) - mat(k,30) = -( het_rates(k,168) ) - mat(k,31) = -( het_rates(k,169) ) - mat(k,32) = -( het_rates(k,170) ) - mat(k,33) = -( het_rates(k,171) ) - mat(k,45) = -( het_rates(k,173) ) - mat(k,126) = -( rxt(k,65) + het_rates(k,174) ) - mat(k,481) = -( rxt(k,66) + het_rates(k,175) ) - mat(k,521) = -( rxt(k,67) + rxt(k,533) + het_rates(k,176) ) - mat(k,368) = -( rxt(k,68) + het_rates(k,177) ) - mat(k,916) = -( rxt(k,69) + het_rates(k,178) ) - mat(k,286) = rxt(k,59) - mat(k,522) = rxt(k,67) - mat(k,370) = rxt(k,68) - mat(k,982) = -( rxt(k,70) + het_rates(k,179) ) - mat(k,484) = rxt(k,66) - mat(k,917) = rxt(k,69) - mat(k,492) = -( rxt(k,71) + het_rates(k,180) ) - mat(k,114) = -( het_rates(k,181) ) - mat(k,130) = -( rxt(k,72) + het_rates(k,182) ) - mat(k,139) = -( het_rates(k,183) ) - mat(k,589) = -( rxt(k,73) + het_rates(k,184) ) - mat(k,147) = -( het_rates(k,185) ) - mat(k,315) = -( rxt(k,74) + het_rates(k,186) ) - mat(k,400) = -( het_rates(k,189) ) - mat(k,72) = rxt(k,470) - mat(k,880) = -( het_rates(k,190) ) - mat(k,377) = -( het_rates(k,191) ) - mat(k,323) = -( het_rates(k,192) ) - mat(k,840) = -( het_rates(k,193) ) - mat(k,419) = rxt(k,53) - mat(k,728) = -( het_rates(k,194) ) - mat(k,529) = -( het_rates(k,195) ) - mat(k,1302) = -( het_rates(k,196) ) - mat(k,283) = .130_r8*rxt(k,24) - mat(k,228) = rxt(k,28) - mat(k,900) = rxt(k,36) - mat(k,1153) = rxt(k,37) - mat(k,973) = .330_r8*rxt(k,46) - mat(k,993) = rxt(k,48) - mat(k,1144) = 1.340_r8*rxt(k,51) - mat(k,420) = rxt(k,53) - mat(k,223) = rxt(k,54) - mat(k,1253) = .300_r8*rxt(k,56) - mat(k,771) = rxt(k,58) - mat(k,351) = .600_r8*rxt(k,61) + rxt(k,346) - mat(k,293) = rxt(k,64) - mat(k,128) = .500_r8*rxt(k,65) - mat(k,985) = .650_r8*rxt(k,70) - mat(k,1396) = -( het_rates(k,197) ) - mat(k,1078) = rxt(k,35) - mat(k,901) = rxt(k,36) - mat(k,408) = rxt(k,38) - mat(k,1254) = .300_r8*rxt(k,56) - mat(k,352) = .400_r8*rxt(k,61) - mat(k,1540) = rxt(k,215)*y(k,54) - mat(k,675) = rxt(k,271)*y(k,54) - mat(k,1714) = rxt(k,304)*y(k,54) - mat(k,1566) = rxt(k,311)*y(k,54) + mat(k,2403) = rxt(k,8) + mat(k,1900) = rxt(k,19) + mat(k,176) = rxt(k,151) + rxt(k,159) + mat(k,179) = rxt(k,152) + mat(k,2419) = -( rxt(k,7) + rxt(k,8) + het_rates(k,135) ) + mat(k,20) = -( het_rates(k,136) ) + mat(k,332) = -( rxt(k,108) + het_rates(k,137) ) + mat(k,361) = -( rxt(k,137) + het_rates(k,138) ) + mat(k,239) = -( rxt(k,60) + rxt(k,532) + het_rates(k,139) ) + mat(k,532) = -( rxt(k,61) + rxt(k,345) + het_rates(k,140) ) + mat(k,134) = -( rxt(k,470) + het_rates(k,141) ) + mat(k,466) = -( het_rates(k,142) ) + mat(k,268) = rxt(k,32) + mat(k,168) = -( het_rates(k,143) ) end do end subroutine linmat02 subroutine linmat03( avec_len, mat, y, rxt, het_rates ) @@ -483,152 +470,197 @@ subroutine linmat03( avec_len, mat, y, rxt, het_rates ) !---------------------------------------------- integer :: k do k = 1,avec_len - mat(k,645) = -( het_rates(k,198) ) - mat(k,198) = .600_r8*rxt(k,26) - mat(k,701) = -( het_rates(k,199) ) - mat(k,1471) = rxt(k,16) - mat(k,743) = rxt(k,111) - mat(k,1806) = rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + mat(k,337) = -( rxt(k,62) + het_rates(k,144) ) + mat(k,21) = -( het_rates(k,145) ) + mat(k,22) = -( het_rates(k,146) ) + mat(k,540) = -( rxt(k,63) + het_rates(k,147) ) + mat(k,407) = -( rxt(k,64) + het_rates(k,148) ) + mat(k,708) = -( het_rates(k,149) ) + mat(k,362) = rxt(k,137) + mat(k,1472) = rxt(k,138) + mat(k,23) = -( rxt(k,109) + het_rates(k,150) ) + mat(k,1474) = -( rxt(k,138) + het_rates(k,151) ) + mat(k,946) = rxt(k,139) + mat(k,945) = -( rxt(k,139) + het_rates(k,152) ) + mat(k,260) = rxt(k,140) + mat(k,259) = -( rxt(k,140) + het_rates(k,153) ) + mat(k,129) = rxt(k,136) + mat(k,24) = -( het_rates(k,154) ) + mat(k,25) = -( het_rates(k,155) ) + mat(k,26) = -( het_rates(k,156) ) + mat(k,27) = -( rxt(k,141) + het_rates(k,157) ) + mat(k,28) = -( rxt(k,142) + het_rates(k,158) ) + mat(k,29) = -( rxt(k,143) + het_rates(k,159) ) + mat(k,30) = -( rxt(k,144) + het_rates(k,160) ) + mat(k,31) = -( rxt(k,145) + het_rates(k,161) ) + mat(k,32) = -( rxt(k,146) + het_rates(k,162) ) + mat(k,33) = -( rxt(k,147) + het_rates(k,163) ) + mat(k,34) = -( rxt(k,148) + het_rates(k,164) ) + mat(k,35) = -( rxt(k,149) + het_rates(k,165) ) + mat(k,36) = -( rxt(k,150) + het_rates(k,166) ) + mat(k,37) = -( het_rates(k,167) ) + mat(k,1051) = rxt(k,520) + mat(k,38) = -( het_rates(k,168) ) + mat(k,39) = -( het_rates(k,169) ) + mat(k,40) = -( het_rates(k,170) ) + mat(k,41) = -( het_rates(k,171) ) + mat(k,42) = -( rxt(k,597) + het_rates(k,172) ) + mat(k,48) = -( het_rates(k,173) ) + mat(k,197) = -( rxt(k,65) + het_rates(k,174) ) + mat(k,650) = -( rxt(k,66) + het_rates(k,175) ) + mat(k,625) = -( rxt(k,67) + rxt(k,533) + het_rates(k,176) ) + mat(k,477) = -( rxt(k,68) + het_rates(k,177) ) + mat(k,1070) = -( rxt(k,69) + het_rates(k,178) ) + mat(k,396) = rxt(k,59) + mat(k,626) = rxt(k,67) + mat(k,479) = rxt(k,68) + mat(k,1101) = -( rxt(k,70) + het_rates(k,179) ) + mat(k,652) = rxt(k,66) + mat(k,1072) = rxt(k,69) + mat(k,663) = -( rxt(k,71) + het_rates(k,180) ) + mat(k,185) = -( het_rates(k,181) ) + mat(k,201) = -( rxt(k,72) + het_rates(k,182) ) + mat(k,206) = -( het_rates(k,183) ) + mat(k,719) = -( rxt(k,73) + het_rates(k,184) ) + mat(k,214) = -( het_rates(k,185) ) + mat(k,425) = -( rxt(k,74) + het_rates(k,186) ) + mat(k,521) = -( het_rates(k,189) ) + mat(k,135) = rxt(k,470) + mat(k,1040) = -( het_rates(k,190) ) + mat(k,54) = -( het_rates(k,191) ) + mat(k,486) = -( het_rates(k,192) ) + mat(k,60) = -( het_rates(k,193) ) + mat(k,433) = -( het_rates(k,194) ) + mat(k,899) = -( het_rates(k,195) ) + mat(k,517) = rxt(k,53) + mat(k,933) = -( het_rates(k,196) ) + mat(k,633) = -( het_rates(k,197) ) + mat(k,1426) = -( het_rates(k,198) ) + mat(k,387) = .130_r8*rxt(k,24) + mat(k,330) = rxt(k,28) + mat(k,1080) = rxt(k,36) + mat(k,1280) = rxt(k,37) + mat(k,1196) = .330_r8*rxt(k,46) + mat(k,1208) = rxt(k,48) + mat(k,1271) = 1.340_r8*rxt(k,51) + mat(k,518) = rxt(k,53) + mat(k,322) = rxt(k,54) + mat(k,1376) = .300_r8*rxt(k,56) + mat(k,873) = rxt(k,58) + mat(k,533) = .600_r8*rxt(k,61) + rxt(k,345) + mat(k,409) = rxt(k,64) + mat(k,199) = .500_r8*rxt(k,65) + mat(k,1104) = .650_r8*rxt(k,70) + mat(k,2257) = -( het_rates(k,199) ) + mat(k,1156) = rxt(k,35) + mat(k,1082) = rxt(k,36) + mat(k,622) = rxt(k,38) + mat(k,2282) = rxt(k,41) + mat(k,1385) = .300_r8*rxt(k,56) + mat(k,538) = .400_r8*rxt(k,61) + mat(k,609) = rxt(k,88) + mat(k,375) = rxt(k,90) + mat(k,776) = -( het_rates(k,200) ) + mat(k,285) = .600_r8*rxt(k,26) + mat(k,863) = -( het_rates(k,201) ) + mat(k,2030) = rxt(k,16) + mat(k,968) = rxt(k,111) + mat(k,2303) = rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + rxt(k,125) - mat(k,1420) = rxt(k,126) + rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,130) & + mat(k,1532) = rxt(k,126) + rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,130) & + rxt(k,131) + rxt(k,132) + rxt(k,133) - mat(k,458) = -( het_rates(k,200) ) - mat(k,345) = -( rxt(k,339) + het_rates(k,201) ) - mat(k,63) = rxt(k,43) - mat(k,664) = -( het_rates(k,202) ) - mat(k,2115) = -( rxt(k,521) + het_rates(k,203) ) - mat(k,366) = rxt(k,11) + rxt(k,212) - mat(k,545) = rxt(k,20) - mat(k,556) = .900_r8*rxt(k,21) - mat(k,278) = rxt(k,22) - mat(k,95) = 1.500_r8*rxt(k,23) - mat(k,284) = .560_r8*rxt(k,24) - mat(k,344) = rxt(k,25) - mat(k,199) = .600_r8*rxt(k,26) - mat(k,504) = .600_r8*rxt(k,27) - mat(k,229) = rxt(k,28) - mat(k,245) = rxt(k,29) - mat(k,250) = rxt(k,30) - mat(k,307) = rxt(k,31) - mat(k,1083) = rxt(k,35) - mat(k,1158) = rxt(k,37) - mat(k,964) = 2.000_r8*rxt(k,44) - mat(k,801) = 2.000_r8*rxt(k,45) - mat(k,979) = .670_r8*rxt(k,46) - mat(k,159) = rxt(k,47) - mat(k,996) = rxt(k,48) - mat(k,302) = rxt(k,49) - mat(k,584) = rxt(k,50) - mat(k,1149) = 1.340_r8*rxt(k,51) + .660_r8*rxt(k,52) - mat(k,938) = rxt(k,57) - mat(k,239) = rxt(k,62) - mat(k,436) = rxt(k,63) - mat(k,129) = rxt(k,65) - mat(k,489) = rxt(k,66) - mat(k,526) = rxt(k,67) - mat(k,374) = rxt(k,68) - mat(k,923) = rxt(k,69) - mat(k,989) = 1.200_r8*rxt(k,70) - mat(k,500) = rxt(k,71) - mat(k,599) = rxt(k,73) - mat(k,320) = rxt(k,74) - mat(k,334) = rxt(k,309) - mat(k,349) = rxt(k,339) - mat(k,1220) = rxt(k,413) - mat(k,1554) = rxt(k,279)*y(k,43) + rxt(k,282)*y(k,46) - mat(k,1728) = rxt(k,280)*y(k,43) + rxt(k,283)*y(k,46) - mat(k,1580) = rxt(k,312)*y(k,54) - mat(k,329) = -( rxt(k,309) + het_rates(k,204) ) - mat(k,1172) = -( het_rates(k,205) ) - mat(k,1206) = -( rxt(k,413) + het_rates(k,206) ) - mat(k,1231) = -( het_rates(k,207) ) - mat(k,607) = -( het_rates(k,208) ) - mat(k,343) = .600_r8*rxt(k,25) - mat(k,1271) = -( het_rates(k,209) ) - mat(k,1143) = .660_r8*rxt(k,51) - mat(k,468) = rxt(k,55) + rxt(k,395) - mat(k,803) = -( het_rates(k,210) ) - mat(k,502) = .600_r8*rxt(k,27) - mat(k,558) = -( het_rates(k,211) ) - mat(k,412) = -( het_rates(k,212) ) - mat(k,567) = -( het_rates(k,213) ) - mat(k,690) = -( het_rates(k,214) ) - mat(k,1470) = rxt(k,16) - mat(k,682) = rxt(k,575) - mat(k,516) = rxt(k,578) - mat(k,384) = -( het_rates(k,215) ) - mat(k,739) = rxt(k,111) - mat(k,1049) = -( het_rates(k,216) ) - mat(k,1570) = -( rxt(k,155) + rxt(k,206)*y(k,113) + rxt(k,207)*y(k,113) & - + rxt(k,239)*y(k,33) + rxt(k,240)*y(k,34) + rxt(k,241)*y(k,36) & - + rxt(k,242)*y(k,37) + rxt(k,243)*y(k,38) + rxt(k,244)*y(k,39) & - + rxt(k,245)*y(k,40) + rxt(k,266)*y(k,35) + rxt(k,267)*y(k,55) & - + rxt(k,268)*y(k,78) + rxt(k,289)*y(k,41) + rxt(k,290)*y(k,43) & - + rxt(k,291)*y(k,82) + rxt(k,292)*y(k,83) + rxt(k,293)*y(k,84) & - + rxt(k,311)*y(k,54) + rxt(k,312)*y(k,54) + rxt(k,313)*y(k,54) & - + het_rates(k,217) ) - mat(k,2158) = rxt(k,1) - mat(k,1430) = rxt(k,6) - mat(k,1780) = rxt(k,7) - mat(k,74) = -( rxt(k,151) + rxt(k,159) + het_rates(k,218) ) - mat(k,1736) = rxt(k,7) - mat(k,76) = rxt(k,163) + rxt(k,162)*y(k,63) - mat(k,77) = -( rxt(k,152) + rxt(k,163) + rxt(k,162)*y(k,63) + het_rates(k,219) ) - mat(k,681) = -( rxt(k,575) + het_rates(k,220) ) - mat(k,1418) = rxt(k,126) + rxt(k,130) - mat(k,515) = rxt(k,577)*y(k,63) - mat(k,1719) = -( rxt(k,278)*y(k,41) + rxt(k,280)*y(k,43) + rxt(k,281)*y(k,44) & - + rxt(k,283)*y(k,46) + rxt(k,285)*y(k,55) + rxt(k,286)*y(k,82) & - + rxt(k,287)*y(k,83) + rxt(k,288)*y(k,84) + rxt(k,304)*y(k,54) & - + het_rates(k,221) ) - mat(k,2159) = rxt(k,3) - mat(k,477) = 2.000_r8*rxt(k,4) - mat(k,1945) = rxt(k,9) - mat(k,363) = rxt(k,10) - mat(k,554) = rxt(k,21) - mat(k,277) = rxt(k,22) - mat(k,244) = rxt(k,29) - mat(k,249) = rxt(k,30) - mat(k,306) = rxt(k,31) - mat(k,184) = rxt(k,32) - mat(k,409) = rxt(k,38) - mat(k,311) = rxt(k,39) - mat(k,64) = rxt(k,43) - mat(k,158) = rxt(k,47) - mat(k,224) = rxt(k,54) - mat(k,288) = rxt(k,59) - mat(k,238) = rxt(k,62) - mat(k,434) = rxt(k,63) - mat(k,294) = rxt(k,64) - mat(k,487) = rxt(k,66) - mat(k,372) = rxt(k,68) - mat(k,499) = rxt(k,71) - mat(k,132) = rxt(k,72) - mat(k,598) = rxt(k,73) - mat(k,319) = rxt(k,74) - mat(k,658) = rxt(k,106) - mat(k,765) = rxt(k,107) - mat(k,1987) = .500_r8*rxt(k,529) - mat(k,1571) = rxt(k,311)*y(k,54) - mat(k,514) = -( rxt(k,578) + rxt(k,577)*y(k,63) + het_rates(k,222) ) - mat(k,1800) = rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + mat(k,572) = -( het_rates(k,202) ) + mat(k,461) = -( rxt(k,338) + het_rates(k,203) ) + mat(k,126) = rxt(k,43) + mat(k,795) = -( het_rates(k,204) ) + mat(k,439) = -( rxt(k,308) + het_rates(k,205) ) + mat(k,1297) = -( het_rates(k,206) ) + mat(k,1330) = -( rxt(k,413) + het_rates(k,207) ) + mat(k,1251) = -( het_rates(k,208) ) + mat(k,66) = -( het_rates(k,209) ) + mat(k,72) = -( het_rates(k,210) ) + mat(k,1354) = -( het_rates(k,211) ) + mat(k,738) = -( het_rates(k,212) ) + mat(k,459) = .600_r8*rxt(k,25) + mat(k,1395) = -( het_rates(k,213) ) + mat(k,1270) = .660_r8*rxt(k,51) + mat(k,582) = rxt(k,55) + rxt(k,395) + mat(k,913) = -( het_rates(k,214) ) + mat(k,599) = .600_r8*rxt(k,27) + mat(k,696) = -( het_rates(k,215) ) + mat(k,80) = -( het_rates(k,216) ) + mat(k,527) = -( het_rates(k,217) ) + mat(k,674) = -( het_rates(k,218) ) + mat(k,843) = -( het_rates(k,219) ) + mat(k,2028) = rxt(k,16) + mat(k,850) = rxt(k,589) + mat(k,804) = rxt(k,592) + mat(k,500) = -( het_rates(k,220) ) + mat(k,964) = rxt(k,111) + mat(k,1088) = -( het_rates(k,221) ) + mat(k,1633) = -( rxt(k,155) + het_rates(k,222) ) + mat(k,2433) = rxt(k,1) + mat(k,1543) = rxt(k,6) + mat(k,2406) = rxt(k,7) + mat(k,256) = rxt(k,12) + mat(k,175) = -( rxt(k,151) + rxt(k,159) + het_rates(k,223) ) + mat(k,2362) = rxt(k,7) + mat(k,177) = rxt(k,163) + mat(k,178) = -( rxt(k,152) + rxt(k,163) + het_rates(k,224) ) + mat(k,851) = -( rxt(k,589) + het_rates(k,225) ) + mat(k,1531) = rxt(k,126) + rxt(k,130) + mat(k,1799) = -( het_rates(k,226) ) + mat(k,2434) = rxt(k,3) + mat(k,613) = 2.000_r8*rxt(k,4) + mat(k,1973) = rxt(k,9) + mat(k,495) = rxt(k,10) + mat(k,692) = rxt(k,21) + mat(k,405) = rxt(k,22) + mat(k,346) = rxt(k,29) + mat(k,351) = rxt(k,30) + mat(k,416) = rxt(k,31) + mat(k,270) = rxt(k,32) + mat(k,621) = rxt(k,38) + mat(k,390) = rxt(k,39) + mat(k,2274) = .330_r8*rxt(k,40) + mat(k,127) = rxt(k,43) + mat(k,231) = rxt(k,47) + mat(k,735) = rxt(k,50) + mat(k,323) = rxt(k,54) + mat(k,398) = rxt(k,59) + mat(k,340) = rxt(k,62) + mat(k,544) = rxt(k,63) + mat(k,410) = rxt(k,64) + mat(k,657) = rxt(k,66) + mat(k,481) = rxt(k,68) + mat(k,671) = rxt(k,71) + mat(k,203) = rxt(k,72) + mat(k,728) = rxt(k,73) + mat(k,429) = rxt(k,74) + mat(k,789) = rxt(k,106) + mat(k,838) = rxt(k,107) + mat(k,1844) = .500_r8*rxt(k,529) + mat(k,803) = -( rxt(k,592) + het_rates(k,227) ) + mat(k,2298) = rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + rxt(k,125) - mat(k,1415) = rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,131) + rxt(k,132) & + mat(k,1529) = rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,131) + rxt(k,132) & + rxt(k,133) - mat(k,336) = -( het_rates(k,223) ) - mat(k,717) = -( het_rates(k,224) ) - mat(k,1065) = -( het_rates(k,225) ) - mat(k,984) = .150_r8*rxt(k,70) - mat(k,1030) = -( het_rates(k,226) ) - mat(k,1008) = -( het_rates(k,227) ) - mat(k,618) = -( het_rates(k,228) ) - mat(k,1091) = -( het_rates(k,229) ) - mat(k,634) = -( het_rates(k,230) ) - mat(k,392) = -( het_rates(k,231) ) - mat(k,2170) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,232) ) - mat(k,67) = rxt(k,136) - mat(k,1730) = rxt(k,278)*y(k,41) + rxt(k,280)*y(k,43) + rxt(k,281)*y(k,44) & - + rxt(k,283)*y(k,46) + rxt(k,288)*y(k,84) + rxt(k,304)*y(k,54) + mat(k,452) = -( het_rates(k,228) ) + mat(k,816) = -( het_rates(k,229) ) + mat(k,1215) = -( het_rates(k,230) ) + mat(k,1103) = .150_r8*rxt(k,70) + mat(k,1176) = -( het_rates(k,231) ) + mat(k,1060) = -( het_rates(k,232) ) + mat(k,749) = -( het_rates(k,233) ) + mat(k,86) = -( het_rates(k,234) ) + mat(k,1231) = -( het_rates(k,235) ) + mat(k,765) = -( het_rates(k,236) ) + mat(k,92) = -( het_rates(k,237) ) + mat(k,508) = -( het_rates(k,238) ) + mat(k,2447) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,239) ) + mat(k,2287) = .050_r8*rxt(k,40) + mat(k,130) = rxt(k,136) + mat(k,2210) = rxt(k,521) end do end subroutine linmat03 subroutine linmat( avec_len, mat, y, rxt, het_rates ) diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 index 94c56c85ac..01c6b243f3 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_factor.F90 @@ -50,37 +50,24 @@ subroutine lu_fac01( avec_len, lu ) lu(k,31) = 1._r8 / lu(k,31) lu(k,32) = 1._r8 / lu(k,32) lu(k,33) = 1._r8 / lu(k,33) + 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) = 1._r8 / lu(k,37) + lu(k,38) = 1._r8 / lu(k,38) lu(k,39) = 1._r8 / lu(k,39) - lu(k,45) = 1._r8 / lu(k,45) - lu(k,46) = 1._r8 / lu(k,46) - lu(k,47) = lu(k,47) * lu(k,46) - lu(k,48) = lu(k,48) * lu(k,46) - lu(k,2131) = lu(k,2131) - lu(k,47) * lu(k,2118) - lu(k,2143) = lu(k,2143) - lu(k,48) * lu(k,2118) - lu(k,49) = 1._r8 / lu(k,49) - lu(k,50) = lu(k,50) * lu(k,49) - lu(k,51) = lu(k,51) * lu(k,49) - lu(k,1719) = lu(k,1719) - lu(k,50) * lu(k,1590) - lu(k,1730) = lu(k,1730) - lu(k,51) * lu(k,1590) - lu(k,52) = 1._r8 / lu(k,52) - lu(k,53) = lu(k,53) * lu(k,52) - lu(k,54) = lu(k,54) * lu(k,52) - lu(k,1719) = lu(k,1719) - lu(k,53) * lu(k,1591) - lu(k,1728) = lu(k,1728) - lu(k,54) * lu(k,1591) - lu(k,55) = 1._r8 / lu(k,55) - lu(k,56) = lu(k,56) * lu(k,55) - lu(k,57) = lu(k,57) * lu(k,55) - lu(k,58) = lu(k,58) * lu(k,55) - lu(k,1672) = lu(k,1672) - lu(k,56) * lu(k,1592) - lu(k,1719) = lu(k,1719) - lu(k,57) * lu(k,1592) - lu(k,1730) = lu(k,1730) - lu(k,58) * lu(k,1592) - lu(k,59) = 1._r8 / lu(k,59) - lu(k,60) = lu(k,60) * lu(k,59) - lu(k,61) = lu(k,61) * lu(k,59) - lu(k,1561) = lu(k,1561) - lu(k,60) * lu(k,1557) - lu(k,1570) = lu(k,1570) - lu(k,61) * lu(k,1557) - lu(k,1668) = - lu(k,60) * lu(k,1593) - lu(k,1718) = - lu(k,61) * lu(k,1593) + lu(k,40) = 1._r8 / lu(k,40) + lu(k,41) = 1._r8 / lu(k,41) + lu(k,42) = 1._r8 / lu(k,42) + lu(k,48) = 1._r8 / lu(k,48) + lu(k,54) = 1._r8 / lu(k,54) + lu(k,60) = 1._r8 / lu(k,60) + lu(k,66) = 1._r8 / lu(k,66) + lu(k,72) = 1._r8 / lu(k,72) + lu(k,74) = 1._r8 / lu(k,74) + lu(k,80) = 1._r8 / lu(k,80) + lu(k,86) = 1._r8 / lu(k,86) + lu(k,92) = 1._r8 / lu(k,92) end do end subroutine lu_fac01 subroutine lu_fac02( avec_len, lu ) @@ -97,113 +84,98 @@ subroutine lu_fac02( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,62) = 1._r8 / lu(k,62) - lu(k,63) = lu(k,63) * lu(k,62) - lu(k,64) = lu(k,64) * lu(k,62) - lu(k,663) = lu(k,663) - lu(k,63) * lu(k,662) - lu(k,668) = - lu(k,64) * lu(k,662) - lu(k,2042) = - lu(k,63) * lu(k,2023) - lu(k,2106) = lu(k,2106) - lu(k,64) * lu(k,2023) - lu(k,65) = 1._r8 / lu(k,65) - lu(k,66) = lu(k,66) * lu(k,65) - lu(k,67) = lu(k,67) * lu(k,65) - lu(k,173) = lu(k,173) - lu(k,66) * lu(k,172) - lu(k,176) = lu(k,176) - lu(k,67) * lu(k,172) - lu(k,2147) = lu(k,2147) - lu(k,66) * lu(k,2145) - lu(k,2170) = lu(k,2170) - lu(k,67) * lu(k,2145) - lu(k,68) = 1._r8 / lu(k,68) - lu(k,69) = lu(k,69) * lu(k,68) - lu(k,70) = lu(k,70) * lu(k,68) - lu(k,579) = lu(k,579) - lu(k,69) * lu(k,577) - lu(k,582) = lu(k,582) - lu(k,70) * lu(k,577) - lu(k,1700) = lu(k,1700) - lu(k,69) * lu(k,1594) - lu(k,1719) = lu(k,1719) - lu(k,70) * lu(k,1594) - lu(k,71) = 1._r8 / lu(k,71) - lu(k,72) = lu(k,72) * lu(k,71) - lu(k,73) = lu(k,73) * lu(k,71) - lu(k,400) = lu(k,400) - lu(k,72) * lu(k,399) - lu(k,404) = lu(k,404) - lu(k,73) * lu(k,399) - lu(k,1962) = lu(k,1962) - lu(k,72) * lu(k,1957) - lu(k,1994) = lu(k,1994) - lu(k,73) * lu(k,1957) - lu(k,74) = 1._r8 / lu(k,74) - lu(k,75) = lu(k,75) * lu(k,74) - lu(k,78) = lu(k,78) - lu(k,75) * lu(k,76) - lu(k,1427) = lu(k,1427) - lu(k,75) * lu(k,1410) - lu(k,1777) = lu(k,1777) - lu(k,75) * lu(k,1736) - lu(k,1818) = lu(k,1818) - lu(k,75) * lu(k,1793) - lu(k,77) = 1._r8 / lu(k,77) - lu(k,78) = lu(k,78) * lu(k,77) - lu(k,1427) = lu(k,1427) - lu(k,78) * lu(k,1411) - lu(k,1567) = lu(k,1567) - lu(k,78) * lu(k,1558) - lu(k,1777) = lu(k,1777) - lu(k,78) * lu(k,1737) - lu(k,1818) = lu(k,1818) - lu(k,78) * lu(k,1794) - lu(k,79) = 1._r8 / lu(k,79) - lu(k,80) = lu(k,80) * lu(k,79) - lu(k,764) = lu(k,764) - lu(k,80) * lu(k,761) - lu(k,908) = lu(k,908) - lu(k,80) * lu(k,904) - lu(k,1339) = lu(k,1339) - lu(k,80) * lu(k,1332) - lu(k,1543) = lu(k,1543) - lu(k,80) * lu(k,1522) - lu(k,2131) = lu(k,2131) - lu(k,80) * lu(k,2119) - lu(k,86) = 1._r8 / lu(k,86) - lu(k,87) = lu(k,87) * lu(k,86) - lu(k,88) = lu(k,88) * lu(k,86) - lu(k,89) = lu(k,89) * lu(k,86) - lu(k,90) = lu(k,90) * lu(k,86) - lu(k,91) = lu(k,91) * lu(k,86) - lu(k,1596) = lu(k,1596) - lu(k,87) * lu(k,1595) - lu(k,1597) = lu(k,1597) - lu(k,88) * lu(k,1595) - lu(k,1639) = lu(k,1639) - lu(k,89) * lu(k,1595) - lu(k,1719) = lu(k,1719) - lu(k,90) * lu(k,1595) - lu(k,1728) = lu(k,1728) - lu(k,91) * lu(k,1595) - lu(k,92) = 1._r8 / lu(k,92) - lu(k,93) = lu(k,93) * lu(k,92) - lu(k,94) = lu(k,94) * lu(k,92) - lu(k,95) = lu(k,95) * lu(k,92) - lu(k,1634) = - lu(k,93) * lu(k,1596) - lu(k,1694) = lu(k,1694) - lu(k,94) * lu(k,1596) - lu(k,1728) = lu(k,1728) - lu(k,95) * lu(k,1596) + 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,1590) = lu(k,1590) - lu(k,94) * lu(k,1578) + lu(k,1595) = lu(k,1595) - lu(k,95) * lu(k,1578) lu(k,96) = 1._r8 / lu(k,96) lu(k,97) = lu(k,97) * lu(k,96) lu(k,98) = lu(k,98) * lu(k,96) - lu(k,99) = lu(k,99) * lu(k,96) - lu(k,100) = lu(k,100) * lu(k,96) - lu(k,1633) = lu(k,1633) - lu(k,97) * lu(k,1597) - lu(k,1636) = lu(k,1636) - lu(k,98) * lu(k,1597) - lu(k,1719) = lu(k,1719) - lu(k,99) * lu(k,1597) - lu(k,1728) = lu(k,1728) - lu(k,100) * lu(k,1597) - lu(k,101) = 1._r8 / lu(k,101) - lu(k,102) = lu(k,102) * lu(k,101) - lu(k,103) = lu(k,103) * lu(k,101) - lu(k,104) = lu(k,104) * lu(k,101) - lu(k,1561) = lu(k,1561) - lu(k,102) * lu(k,1559) - lu(k,1569) = lu(k,1569) - lu(k,103) * lu(k,1559) - lu(k,1570) = lu(k,1570) - lu(k,104) * lu(k,1559) - lu(k,1668) = lu(k,1668) - lu(k,102) * lu(k,1598) - lu(k,1717) = lu(k,1717) - lu(k,103) * lu(k,1598) - lu(k,1718) = lu(k,1718) - lu(k,104) * lu(k,1598) + lu(k,1799) = lu(k,1799) - lu(k,97) * lu(k,1662) + lu(k,1812) = lu(k,1812) - lu(k,98) * lu(k,1662) + lu(k,99) = 1._r8 / lu(k,99) + lu(k,100) = lu(k,100) * lu(k,99) + lu(k,101) = lu(k,101) * lu(k,99) + lu(k,1633) = lu(k,1633) - lu(k,100) * lu(k,1605) + lu(k,1637) = lu(k,1637) - lu(k,101) * lu(k,1605) + lu(k,102) = 1._r8 / lu(k,102) + lu(k,103) = lu(k,103) * lu(k,102) + lu(k,104) = lu(k,104) * lu(k,102) + lu(k,1799) = lu(k,1799) - lu(k,103) * lu(k,1663) + lu(k,1806) = lu(k,1806) - lu(k,104) * lu(k,1663) lu(k,105) = 1._r8 / lu(k,105) lu(k,106) = lu(k,106) * lu(k,105) lu(k,107) = lu(k,107) * lu(k,105) lu(k,108) = lu(k,108) * lu(k,105) - lu(k,1570) = lu(k,1570) - lu(k,106) * lu(k,1560) - lu(k,1571) = lu(k,1571) - lu(k,107) * lu(k,1560) - lu(k,1580) = lu(k,1580) - lu(k,108) * lu(k,1560) - lu(k,1718) = lu(k,1718) - lu(k,106) * lu(k,1599) - lu(k,1719) = lu(k,1719) - lu(k,107) * lu(k,1599) - lu(k,1728) = lu(k,1728) - lu(k,108) * lu(k,1599) - lu(k,114) = 1._r8 / lu(k,114) - lu(k,115) = lu(k,115) * lu(k,114) - lu(k,116) = lu(k,116) * lu(k,114) - lu(k,117) = lu(k,117) * lu(k,114) - lu(k,118) = lu(k,118) * lu(k,114) - lu(k,119) = lu(k,119) * lu(k,114) - lu(k,120) = lu(k,120) * lu(k,114) - lu(k,1601) = lu(k,1601) - lu(k,115) * lu(k,1600) - lu(k,1602) = lu(k,1602) - lu(k,116) * lu(k,1600) - lu(k,1632) = lu(k,1632) - lu(k,117) * lu(k,1600) - lu(k,1664) = lu(k,1664) - lu(k,118) * lu(k,1600) - lu(k,1719) = lu(k,1719) - lu(k,119) * lu(k,1600) - lu(k,1728) = lu(k,1728) - lu(k,120) * lu(k,1600) + lu(k,1618) = lu(k,1618) - lu(k,106) * lu(k,1606) + lu(k,1629) = lu(k,1629) - lu(k,107) * lu(k,1606) + lu(k,1633) = lu(k,1633) - lu(k,108) * lu(k,1606) + lu(k,109) = 1._r8 / lu(k,109) + lu(k,110) = lu(k,110) * lu(k,109) + lu(k,111) = lu(k,111) * lu(k,109) + lu(k,112) = lu(k,112) * lu(k,109) + lu(k,1617) = lu(k,1617) - lu(k,110) * lu(k,1607) + lu(k,1633) = lu(k,1633) - lu(k,111) * lu(k,1607) + lu(k,1637) = lu(k,1637) - lu(k,112) * lu(k,1607) + lu(k,113) = 1._r8 / lu(k,113) + lu(k,114) = lu(k,114) * lu(k,113) + lu(k,115) = lu(k,115) * lu(k,113) + lu(k,116) = lu(k,116) * lu(k,113) + lu(k,1618) = lu(k,1618) - lu(k,114) * lu(k,1608) + lu(k,1633) = lu(k,1633) - lu(k,115) * lu(k,1608) + lu(k,1637) = lu(k,1637) - lu(k,116) * lu(k,1608) + lu(k,117) = 1._r8 / lu(k,117) + lu(k,118) = lu(k,118) * lu(k,117) + lu(k,119) = lu(k,119) * lu(k,117) + lu(k,120) = lu(k,120) * lu(k,117) + lu(k,1618) = lu(k,1618) - lu(k,118) * lu(k,1609) + lu(k,1633) = lu(k,1633) - lu(k,119) * lu(k,1609) + lu(k,1637) = lu(k,1637) - lu(k,120) * lu(k,1609) + lu(k,121) = 1._r8 / lu(k,121) + lu(k,122) = lu(k,122) * lu(k,121) + lu(k,123) = lu(k,123) * lu(k,121) + lu(k,124) = lu(k,124) * lu(k,121) + lu(k,1799) = lu(k,1799) - lu(k,122) * lu(k,1664) + lu(k,1802) = lu(k,1802) - lu(k,123) * lu(k,1664) + lu(k,1812) = lu(k,1812) - lu(k,124) * lu(k,1664) + lu(k,125) = 1._r8 / lu(k,125) + lu(k,126) = lu(k,126) * lu(k,125) + lu(k,127) = lu(k,127) * lu(k,125) + lu(k,794) = lu(k,794) - lu(k,126) * lu(k,793) + lu(k,798) = - lu(k,127) * lu(k,793) + lu(k,2134) = - lu(k,126) * lu(k,2115) + lu(k,2197) = lu(k,2197) - lu(k,127) * lu(k,2115) + lu(k,128) = 1._r8 / lu(k,128) + lu(k,129) = lu(k,129) * lu(k,128) + lu(k,130) = lu(k,130) * lu(k,128) + lu(k,259) = lu(k,259) - lu(k,129) * lu(k,258) + lu(k,262) = lu(k,262) - lu(k,130) * lu(k,258) + lu(k,2422) = lu(k,2422) - lu(k,129) * lu(k,2421) + lu(k,2447) = lu(k,2447) - lu(k,130) * lu(k,2421) + lu(k,131) = 1._r8 / lu(k,131) + lu(k,132) = lu(k,132) * lu(k,131) + lu(k,133) = lu(k,133) * lu(k,131) + lu(k,732) = lu(k,732) - lu(k,132) * lu(k,730) + lu(k,735) = lu(k,735) - lu(k,133) * lu(k,730) + lu(k,1780) = lu(k,1780) - lu(k,132) * lu(k,1665) + lu(k,1799) = lu(k,1799) - lu(k,133) * lu(k,1665) + lu(k,134) = 1._r8 / lu(k,134) + lu(k,135) = lu(k,135) * lu(k,134) + lu(k,136) = lu(k,136) * lu(k,134) + lu(k,521) = lu(k,521) - lu(k,135) * lu(k,520) + lu(k,524) = lu(k,524) - lu(k,136) * lu(k,520) + lu(k,1818) = lu(k,1818) - lu(k,135) * lu(k,1813) + lu(k,1845) = lu(k,1845) - lu(k,136) * lu(k,1813) + lu(k,137) = 1._r8 / lu(k,137) + lu(k,138) = lu(k,138) * lu(k,137) + lu(k,139) = lu(k,139) * lu(k,137) + lu(k,140) = lu(k,140) * lu(k,137) + lu(k,141) = lu(k,141) * lu(k,137) + lu(k,1618) = lu(k,1618) - lu(k,138) * lu(k,1610) + lu(k,1629) = lu(k,1629) - lu(k,139) * lu(k,1610) + lu(k,1633) = lu(k,1633) - lu(k,140) * lu(k,1610) + lu(k,1637) = lu(k,1637) - lu(k,141) * lu(k,1610) end do end subroutine lu_fac02 subroutine lu_fac03( avec_len, lu ) @@ -220,245 +192,116 @@ subroutine lu_fac03( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,121) = 1._r8 / lu(k,121) - lu(k,122) = lu(k,122) * lu(k,121) - lu(k,123) = lu(k,123) * lu(k,121) - lu(k,124) = lu(k,124) * lu(k,121) - lu(k,125) = lu(k,125) * lu(k,121) - lu(k,1633) = lu(k,1633) - lu(k,122) * lu(k,1601) - lu(k,1636) = lu(k,1636) - lu(k,123) * lu(k,1601) - lu(k,1719) = lu(k,1719) - lu(k,124) * lu(k,1601) - lu(k,1728) = lu(k,1728) - lu(k,125) * lu(k,1601) - lu(k,126) = 1._r8 / lu(k,126) - lu(k,127) = lu(k,127) * lu(k,126) - lu(k,128) = lu(k,128) * lu(k,126) - lu(k,129) = lu(k,129) * lu(k,126) - lu(k,143) = - lu(k,127) * lu(k,138) - lu(k,144) = - lu(k,128) * lu(k,138) - lu(k,146) = lu(k,146) - lu(k,129) * lu(k,138) - lu(k,1694) = lu(k,1694) - lu(k,127) * lu(k,1602) - lu(k,1710) = lu(k,1710) - lu(k,128) * lu(k,1602) - lu(k,1728) = lu(k,1728) - lu(k,129) * lu(k,1602) - 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,1091) = lu(k,1091) - lu(k,131) * lu(k,1085) - lu(k,1096) = - lu(k,132) * lu(k,1085) - lu(k,1700) = lu(k,1700) - lu(k,131) * lu(k,1603) - lu(k,1719) = lu(k,1719) - lu(k,132) * lu(k,1603) - lu(k,2088) = lu(k,2088) - lu(k,131) * lu(k,2024) - lu(k,2106) = lu(k,2106) - lu(k,132) * lu(k,2024) - lu(k,139) = 1._r8 / lu(k,139) - lu(k,140) = lu(k,140) * lu(k,139) - lu(k,141) = lu(k,141) * lu(k,139) - lu(k,142) = lu(k,142) * lu(k,139) - lu(k,143) = lu(k,143) * lu(k,139) - lu(k,144) = lu(k,144) * lu(k,139) - lu(k,145) = lu(k,145) * lu(k,139) - lu(k,146) = lu(k,146) * lu(k,139) - lu(k,1605) = lu(k,1605) - lu(k,140) * lu(k,1604) - lu(k,1632) = lu(k,1632) - lu(k,141) * lu(k,1604) - lu(k,1665) = lu(k,1665) - lu(k,142) * lu(k,1604) - lu(k,1694) = lu(k,1694) - lu(k,143) * lu(k,1604) - lu(k,1710) = lu(k,1710) - lu(k,144) * lu(k,1604) - lu(k,1719) = lu(k,1719) - lu(k,145) * lu(k,1604) - lu(k,1728) = lu(k,1728) - lu(k,146) * lu(k,1604) + 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,1618) = lu(k,1618) - lu(k,143) * lu(k,1611) + lu(k,1626) = lu(k,1626) - lu(k,144) * lu(k,1611) + lu(k,1629) = lu(k,1629) - lu(k,145) * lu(k,1611) + lu(k,1633) = lu(k,1633) - lu(k,146) * lu(k,1611) 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,1636) = lu(k,1636) - lu(k,148) * lu(k,1605) - lu(k,1640) = lu(k,1640) - lu(k,149) * lu(k,1605) - lu(k,1719) = lu(k,1719) - lu(k,150) * lu(k,1605) - lu(k,1728) = lu(k,1728) - lu(k,151) * lu(k,1605) + lu(k,1617) = lu(k,1617) - lu(k,148) * lu(k,1612) + lu(k,1618) = lu(k,1618) - lu(k,149) * lu(k,1612) + lu(k,1633) = lu(k,1633) - lu(k,150) * lu(k,1612) + lu(k,1637) = lu(k,1637) - lu(k,151) * lu(k,1612) 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,673) = lu(k,673) - lu(k,153) * lu(k,672) - lu(k,678) = lu(k,678) - lu(k,154) * lu(k,672) - lu(k,1103) = lu(k,1103) - lu(k,153) * lu(k,1102) - lu(k,1112) = lu(k,1112) - lu(k,154) * lu(k,1102) - lu(k,1936) = lu(k,1936) - lu(k,153) * lu(k,1935) - lu(k,1950) = - lu(k,154) * lu(k,1935) - lu(k,2148) = lu(k,2148) - lu(k,153) * lu(k,2146) - lu(k,2164) = lu(k,2164) - lu(k,154) * lu(k,2146) - lu(k,155) = 1._r8 / lu(k,155) - lu(k,156) = lu(k,156) * lu(k,155) - lu(k,157) = lu(k,157) * lu(k,155) - lu(k,158) = lu(k,158) * lu(k,155) - lu(k,159) = lu(k,159) * lu(k,155) - lu(k,1191) = - lu(k,156) * lu(k,1188) - lu(k,1203) = - lu(k,157) * lu(k,1188) - lu(k,1213) = - lu(k,158) * lu(k,1188) - lu(k,1220) = lu(k,1220) - lu(k,159) * lu(k,1188) - lu(k,1653) = - lu(k,156) * lu(k,1606) - lu(k,1700) = lu(k,1700) - lu(k,157) * lu(k,1606) - lu(k,1719) = lu(k,1719) - lu(k,158) * lu(k,1606) - lu(k,1728) = lu(k,1728) - lu(k,159) * lu(k,1606) - 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,977) = lu(k,977) - lu(k,161) * lu(k,965) - lu(k,978) = lu(k,978) - lu(k,162) * lu(k,965) - lu(k,1038) = - lu(k,161) * lu(k,1023) - lu(k,1039) = lu(k,1039) - lu(k,162) * lu(k,1023) - lu(k,1516) = - lu(k,161) * lu(k,1441) - lu(k,1517) = lu(k,1517) - lu(k,162) * lu(k,1441) - lu(k,1725) = lu(k,1725) - lu(k,161) * lu(k,1607) - lu(k,1726) = lu(k,1726) - lu(k,162) * lu(k,1607) - lu(k,163) = 1._r8 / lu(k,163) - lu(k,164) = lu(k,164) * lu(k,163) - lu(k,165) = lu(k,165) * lu(k,163) - lu(k,821) = - lu(k,164) * lu(k,816) - lu(k,831) = lu(k,831) - lu(k,165) * lu(k,816) - lu(k,859) = - lu(k,164) * lu(k,854) - lu(k,869) = lu(k,869) - lu(k,165) * lu(k,854) - lu(k,1683) = lu(k,1683) - lu(k,164) * lu(k,1608) - lu(k,1719) = lu(k,1719) - lu(k,165) * lu(k,1608) - lu(k,1751) = - lu(k,164) * lu(k,1738) - lu(k,1781) = lu(k,1781) - lu(k,165) * lu(k,1738) - 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,166) = 1._r8 / lu(k,166) - lu(k,167) = lu(k,167) * lu(k,166) - lu(k,168) = lu(k,168) * lu(k,166) - lu(k,656) = lu(k,656) - lu(k,167) * lu(k,653) - lu(k,657) = - lu(k,168) * lu(k,653) - lu(k,1338) = - lu(k,167) * lu(k,1333) - lu(k,1339) = lu(k,1339) - lu(k,168) * lu(k,1333) - lu(k,2006) = lu(k,2006) - lu(k,167) * lu(k,1999) - lu(k,2009) = lu(k,2009) - lu(k,168) * lu(k,1999) - lu(k,2127) = lu(k,2127) - lu(k,167) * lu(k,2120) - lu(k,2131) = lu(k,2131) - lu(k,168) * lu(k,2120) - lu(k,169) = 1._r8 / lu(k,169) - lu(k,170) = lu(k,170) * lu(k,169) - lu(k,171) = lu(k,171) * lu(k,169) - lu(k,243) = - lu(k,170) * lu(k,240) - lu(k,244) = lu(k,244) - lu(k,171) * lu(k,240) - lu(k,324) = - lu(k,170) * lu(k,321) - lu(k,326) = - lu(k,171) * lu(k,321) - lu(k,1454) = lu(k,1454) - lu(k,170) * lu(k,1442) - lu(k,1510) = lu(k,1510) - lu(k,171) * lu(k,1442) - lu(k,1641) = lu(k,1641) - lu(k,170) * lu(k,1609) - lu(k,1719) = lu(k,1719) - lu(k,171) * lu(k,1609) + lu(k,155) = lu(k,155) * lu(k,152) + lu(k,156) = lu(k,156) * lu(k,152) + lu(k,1618) = lu(k,1618) - lu(k,153) * lu(k,1613) + lu(k,1626) = lu(k,1626) - lu(k,154) * lu(k,1613) + lu(k,1633) = lu(k,1633) - lu(k,155) * lu(k,1613) + lu(k,1637) = lu(k,1637) - lu(k,156) * lu(k,1613) + lu(k,158) = 1._r8 / lu(k,158) + lu(k,159) = lu(k,159) * lu(k,158) + lu(k,160) = lu(k,160) * lu(k,158) + lu(k,161) = lu(k,161) * lu(k,158) + lu(k,162) = lu(k,162) * lu(k,158) + lu(k,163) = lu(k,163) * lu(k,158) + lu(k,1667) = lu(k,1667) - lu(k,159) * lu(k,1666) + lu(k,1668) = lu(k,1668) - lu(k,160) * lu(k,1666) + lu(k,1716) = lu(k,1716) - lu(k,161) * lu(k,1666) + lu(k,1799) = lu(k,1799) - lu(k,162) * lu(k,1666) + lu(k,1806) = lu(k,1806) - lu(k,163) * lu(k,1666) + lu(k,164) = 1._r8 / lu(k,164) + lu(k,165) = lu(k,165) * lu(k,164) + lu(k,166) = lu(k,166) * lu(k,164) + lu(k,167) = lu(k,167) * lu(k,164) + lu(k,1712) = - lu(k,165) * lu(k,1667) + lu(k,1774) = lu(k,1774) - lu(k,166) * lu(k,1667) + lu(k,1806) = lu(k,1806) - lu(k,167) * lu(k,1667) + 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,1711) = lu(k,1711) - lu(k,169) * lu(k,1668) + lu(k,1713) = lu(k,1713) - lu(k,170) * lu(k,1668) + lu(k,1799) = lu(k,1799) - lu(k,171) * lu(k,1668) + lu(k,1806) = lu(k,1806) - lu(k,172) * lu(k,1668) lu(k,173) = 1._r8 / lu(k,173) lu(k,174) = lu(k,174) * lu(k,173) - lu(k,175) = lu(k,175) * lu(k,173) - lu(k,176) = lu(k,176) * lu(k,173) - lu(k,892) = lu(k,892) - lu(k,174) * lu(k,891) - lu(k,895) = lu(k,895) - lu(k,175) * lu(k,891) - lu(k,897) = - lu(k,176) * lu(k,891) - lu(k,1684) = lu(k,1684) - lu(k,174) * lu(k,1610) - lu(k,1721) = lu(k,1721) - lu(k,175) * lu(k,1610) - lu(k,1730) = lu(k,1730) - lu(k,176) * lu(k,1610) - lu(k,2149) = - lu(k,174) * lu(k,2147) - lu(k,2161) = lu(k,2161) - lu(k,175) * lu(k,2147) - lu(k,2170) = lu(k,2170) - lu(k,176) * lu(k,2147) - lu(k,177) = 1._r8 / lu(k,177) - lu(k,178) = lu(k,178) * lu(k,177) - lu(k,179) = lu(k,179) * lu(k,177) - lu(k,180) = lu(k,180) * lu(k,177) - lu(k,841) = lu(k,841) - lu(k,178) * lu(k,837) - lu(k,845) = - lu(k,179) * lu(k,837) - lu(k,848) = lu(k,848) - lu(k,180) * lu(k,837) - lu(k,1385) = lu(k,1385) - lu(k,178) * lu(k,1363) - lu(k,1400) = - lu(k,179) * lu(k,1363) - lu(k,1407) = lu(k,1407) - lu(k,180) * lu(k,1363) - lu(k,1699) = lu(k,1699) - lu(k,178) * lu(k,1611) - lu(k,1719) = lu(k,1719) - lu(k,179) * lu(k,1611) - lu(k,1728) = lu(k,1728) - lu(k,180) * lu(k,1611) - lu(k,181) = 1._r8 / lu(k,181) - lu(k,182) = lu(k,182) * lu(k,181) - lu(k,183) = lu(k,183) * lu(k,181) - lu(k,184) = lu(k,184) * lu(k,181) - lu(k,528) = lu(k,528) - lu(k,182) * lu(k,527) - lu(k,529) = lu(k,529) - lu(k,183) * lu(k,527) - lu(k,531) = - lu(k,184) * lu(k,527) - lu(k,1636) = lu(k,1636) - lu(k,182) * lu(k,1612) - lu(k,1656) = lu(k,1656) - lu(k,183) * lu(k,1612) - lu(k,1719) = lu(k,1719) - lu(k,184) * lu(k,1612) - lu(k,2043) = - lu(k,182) * lu(k,2025) - lu(k,2056) = lu(k,2056) - lu(k,183) * lu(k,2025) - lu(k,2106) = lu(k,2106) - lu(k,184) * lu(k,2025) + lu(k,839) = lu(k,839) - lu(k,174) * lu(k,834) + lu(k,959) = lu(k,959) - lu(k,174) * lu(k,951) + lu(k,1501) = lu(k,1501) - lu(k,174) * lu(k,1488) + lu(k,1595) = lu(k,1595) - lu(k,174) * lu(k,1579) + lu(k,1953) = lu(k,1953) - lu(k,174) * lu(k,1918) + lu(k,175) = 1._r8 / lu(k,175) + lu(k,176) = lu(k,176) * lu(k,175) + lu(k,179) = lu(k,179) - lu(k,176) * lu(k,177) + lu(k,1449) = - lu(k,176) * lu(k,1440) + lu(k,1540) = lu(k,1540) - lu(k,176) * lu(k,1522) + lu(k,2313) = lu(k,2313) - lu(k,176) * lu(k,2288) + lu(k,2403) = lu(k,2403) - lu(k,176) * lu(k,2362) + lu(k,178) = 1._r8 / lu(k,178) + lu(k,179) = lu(k,179) * lu(k,178) + lu(k,1449) = lu(k,1449) - lu(k,179) * lu(k,1441) + lu(k,1540) = lu(k,1540) - lu(k,179) * lu(k,1523) + lu(k,1630) = lu(k,1630) - lu(k,179) * lu(k,1614) + lu(k,2313) = lu(k,2313) - lu(k,179) * lu(k,2289) + lu(k,2403) = lu(k,2403) - lu(k,179) * lu(k,2363) + lu(k,180) = 1._r8 / lu(k,180) + lu(k,181) = lu(k,181) * lu(k,180) + lu(k,182) = lu(k,182) * lu(k,180) + lu(k,183) = lu(k,183) * lu(k,180) + lu(k,1633) = lu(k,1633) - lu(k,181) * lu(k,1615) + lu(k,1634) = lu(k,1634) - lu(k,182) * lu(k,1615) + lu(k,1641) = lu(k,1641) - lu(k,183) * lu(k,1615) + lu(k,1798) = - lu(k,181) * lu(k,1669) + lu(k,1799) = lu(k,1799) - lu(k,182) * lu(k,1669) + lu(k,1806) = lu(k,1806) - lu(k,183) * lu(k,1669) lu(k,185) = 1._r8 / lu(k,185) lu(k,186) = lu(k,186) * lu(k,185) lu(k,187) = lu(k,187) * lu(k,185) lu(k,188) = lu(k,188) * lu(k,185) lu(k,189) = lu(k,189) * lu(k,185) lu(k,190) = lu(k,190) * lu(k,185) - lu(k,1900) = lu(k,1900) - lu(k,186) * lu(k,1860) - lu(k,1905) = lu(k,1905) - lu(k,187) * lu(k,1860) - lu(k,1907) = lu(k,1907) - lu(k,188) * lu(k,1860) - lu(k,1909) = lu(k,1909) - lu(k,189) * lu(k,1860) - lu(k,1910) = lu(k,1910) - lu(k,190) * lu(k,1860) - lu(k,1984) = lu(k,1984) - lu(k,186) * lu(k,1958) - lu(k,1989) = lu(k,1989) - lu(k,187) * lu(k,1958) - lu(k,1991) = lu(k,1991) - lu(k,188) * lu(k,1958) - lu(k,1993) = lu(k,1993) - lu(k,189) * lu(k,1958) - lu(k,1994) = lu(k,1994) - lu(k,190) * lu(k,1958) - lu(k,191) = 1._r8 / lu(k,191) - lu(k,192) = lu(k,192) * lu(k,191) - lu(k,193) = lu(k,193) * lu(k,191) - lu(k,194) = lu(k,194) * lu(k,191) - lu(k,195) = lu(k,195) * lu(k,191) - lu(k,196) = lu(k,196) * lu(k,191) - lu(k,1684) = lu(k,1684) - lu(k,192) * lu(k,1613) - lu(k,1719) = lu(k,1719) - lu(k,193) * lu(k,1613) - lu(k,1723) = lu(k,1723) - lu(k,194) * lu(k,1613) - lu(k,1725) = lu(k,1725) - lu(k,195) * lu(k,1613) - lu(k,1728) = lu(k,1728) - lu(k,196) * lu(k,1613) - lu(k,1871) = lu(k,1871) - lu(k,192) * lu(k,1861) - lu(k,1903) = lu(k,1903) - lu(k,193) * lu(k,1861) - lu(k,1907) = lu(k,1907) - lu(k,194) * lu(k,1861) - lu(k,1909) = lu(k,1909) - lu(k,195) * lu(k,1861) - lu(k,1912) = lu(k,1912) - lu(k,196) * lu(k,1861) - lu(k,197) = 1._r8 / lu(k,197) - lu(k,198) = lu(k,198) * lu(k,197) - lu(k,199) = lu(k,199) * lu(k,197) - lu(k,496) = - lu(k,198) * lu(k,490) - lu(k,500) = lu(k,500) - lu(k,199) * lu(k,490) - lu(k,592) = - lu(k,198) * lu(k,585) - lu(k,599) = lu(k,599) - lu(k,199) * lu(k,585) - lu(k,619) = - lu(k,198) * lu(k,613) - lu(k,627) = lu(k,627) - lu(k,199) * lu(k,613) - lu(k,635) = - lu(k,198) * lu(k,628) - lu(k,644) = lu(k,644) - lu(k,199) * lu(k,628) - lu(k,1467) = lu(k,1467) - lu(k,198) * lu(k,1443) - lu(k,1519) = lu(k,1519) - lu(k,199) * lu(k,1443) - 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,1528) = - lu(k,201) * lu(k,1523) - lu(k,1530) = - lu(k,202) * lu(k,1523) - lu(k,1534) = lu(k,1534) - lu(k,203) * lu(k,1523) - lu(k,1545) = lu(k,1545) - lu(k,204) * lu(k,1523) - lu(k,1554) = lu(k,1554) - lu(k,205) * lu(k,1523) - lu(k,1670) = lu(k,1670) - lu(k,201) * lu(k,1614) - lu(k,1678) = lu(k,1678) - lu(k,202) * lu(k,1614) - lu(k,1694) = lu(k,1694) - lu(k,203) * lu(k,1614) - lu(k,1719) = lu(k,1719) - lu(k,204) * lu(k,1614) - lu(k,1728) = lu(k,1728) - lu(k,205) * lu(k,1614) + lu(k,191) = lu(k,191) * lu(k,185) + lu(k,1671) = lu(k,1671) - lu(k,186) * lu(k,1670) + lu(k,1672) = lu(k,1672) - lu(k,187) * lu(k,1670) + lu(k,1709) = lu(k,1709) - lu(k,188) * lu(k,1670) + lu(k,1744) = lu(k,1744) - lu(k,189) * lu(k,1670) + lu(k,1799) = lu(k,1799) - lu(k,190) * lu(k,1670) + lu(k,1806) = lu(k,1806) - lu(k,191) * lu(k,1670) + lu(k,192) = 1._r8 / lu(k,192) + lu(k,193) = lu(k,193) * lu(k,192) + lu(k,194) = lu(k,194) * lu(k,192) + lu(k,195) = lu(k,195) * lu(k,192) + lu(k,196) = lu(k,196) * lu(k,192) + lu(k,1711) = lu(k,1711) - lu(k,193) * lu(k,1671) + lu(k,1713) = lu(k,1713) - lu(k,194) * lu(k,1671) + lu(k,1799) = lu(k,1799) - lu(k,195) * lu(k,1671) + lu(k,1806) = lu(k,1806) - lu(k,196) * lu(k,1671) end do - end subroutine lu_fac04 - subroutine lu_fac05( avec_len, lu ) + 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 @@ -472,159 +315,110 @@ subroutine lu_fac05( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len + lu(k,197) = 1._r8 / lu(k,197) + lu(k,198) = lu(k,198) * lu(k,197) + lu(k,199) = lu(k,199) * lu(k,197) + lu(k,200) = lu(k,200) * lu(k,197) + lu(k,210) = - lu(k,198) * lu(k,205) + lu(k,211) = - lu(k,199) * lu(k,205) + lu(k,213) = lu(k,213) - lu(k,200) * lu(k,205) + lu(k,1774) = lu(k,1774) - lu(k,198) * lu(k,1672) + lu(k,1789) = lu(k,1789) - lu(k,199) * lu(k,1672) + lu(k,1806) = lu(k,1806) - lu(k,200) * lu(k,1672) + lu(k,201) = 1._r8 / lu(k,201) + lu(k,202) = lu(k,202) * lu(k,201) + lu(k,203) = lu(k,203) * lu(k,201) + lu(k,1231) = lu(k,1231) - lu(k,202) * lu(k,1225) + lu(k,1235) = - lu(k,203) * lu(k,1225) + lu(k,1780) = lu(k,1780) - lu(k,202) * lu(k,1673) + lu(k,1799) = lu(k,1799) - lu(k,203) * lu(k,1673) + lu(k,2179) = lu(k,2179) - lu(k,202) * lu(k,2116) + lu(k,2197) = lu(k,2197) - lu(k,203) * lu(k,2116) 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,1531) = lu(k,1531) - lu(k,207) * lu(k,1524) - lu(k,1538) = lu(k,1538) - lu(k,208) * lu(k,1524) - lu(k,1543) = lu(k,1543) - lu(k,209) * lu(k,1524) - lu(k,1545) = lu(k,1545) - lu(k,210) * lu(k,1524) - lu(k,1556) = - lu(k,211) * lu(k,1524) - lu(k,1681) = lu(k,1681) - lu(k,207) * lu(k,1615) - lu(k,1712) = lu(k,1712) - lu(k,208) * lu(k,1615) - lu(k,1717) = lu(k,1717) - lu(k,209) * lu(k,1615) - lu(k,1719) = lu(k,1719) - lu(k,210) * lu(k,1615) - lu(k,1730) = lu(k,1730) - lu(k,211) * lu(k,1615) - lu(k,212) = 1._r8 / lu(k,212) - lu(k,213) = lu(k,213) * lu(k,212) - lu(k,214) = lu(k,214) * lu(k,212) - lu(k,1203) = lu(k,1203) - lu(k,213) * lu(k,1189) - lu(k,1213) = lu(k,1213) - lu(k,214) * lu(k,1189) - lu(k,1293) = lu(k,1293) - lu(k,213) * lu(k,1284) - lu(k,1306) = lu(k,1306) - lu(k,214) * lu(k,1284) - lu(k,1386) = lu(k,1386) - lu(k,213) * lu(k,1364) - lu(k,1400) = lu(k,1400) - lu(k,214) * lu(k,1364) - lu(k,1494) = lu(k,1494) - lu(k,213) * lu(k,1444) - lu(k,1510) = lu(k,1510) - lu(k,214) * lu(k,1444) - lu(k,1700) = lu(k,1700) - lu(k,213) * lu(k,1616) - lu(k,1719) = lu(k,1719) - lu(k,214) * lu(k,1616) - lu(k,1886) = lu(k,1886) - lu(k,213) * lu(k,1862) - lu(k,1903) = lu(k,1903) - lu(k,214) * lu(k,1862) - lu(k,215) = 1._r8 / lu(k,215) - lu(k,216) = lu(k,216) * lu(k,215) - lu(k,217) = lu(k,217) * lu(k,215) - lu(k,218) = lu(k,218) * lu(k,215) - lu(k,219) = lu(k,219) * lu(k,215) - lu(k,1231) = lu(k,1231) - lu(k,216) * lu(k,1222) - lu(k,1232) = - lu(k,217) * lu(k,1222) - lu(k,1236) = - lu(k,218) * lu(k,1222) - lu(k,1242) = lu(k,1242) - lu(k,219) * lu(k,1222) - lu(k,1707) = lu(k,1707) - lu(k,216) * lu(k,1617) - lu(k,1709) = lu(k,1709) - lu(k,217) * lu(k,1617) - lu(k,1719) = lu(k,1719) - lu(k,218) * lu(k,1617) - lu(k,1728) = lu(k,1728) - lu(k,219) * lu(k,1617) - lu(k,2095) = lu(k,2095) - lu(k,216) * lu(k,2026) - lu(k,2097) = lu(k,2097) - lu(k,217) * lu(k,2026) - lu(k,2106) = lu(k,2106) - lu(k,218) * lu(k,2026) - lu(k,2115) = lu(k,2115) - lu(k,219) * lu(k,2026) - 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,558) = lu(k,558) - lu(k,221) * lu(k,557) - lu(k,559) = lu(k,559) - lu(k,222) * lu(k,557) - lu(k,560) = lu(k,560) - lu(k,223) * lu(k,557) - lu(k,562) = lu(k,562) - lu(k,224) * lu(k,557) - lu(k,1659) = lu(k,1659) - lu(k,221) * lu(k,1618) - lu(k,1699) = lu(k,1699) - lu(k,222) * lu(k,1618) - lu(k,1710) = lu(k,1710) - lu(k,223) * lu(k,1618) - lu(k,1719) = lu(k,1719) - lu(k,224) * lu(k,1618) - lu(k,2058) = lu(k,2058) - lu(k,221) * lu(k,2027) - lu(k,2087) = lu(k,2087) - lu(k,222) * lu(k,2027) - lu(k,2098) = lu(k,2098) - lu(k,223) * lu(k,2027) - lu(k,2106) = lu(k,2106) - lu(k,224) * lu(k,2027) - lu(k,225) = 1._r8 / lu(k,225) - lu(k,226) = lu(k,226) * lu(k,225) - lu(k,227) = lu(k,227) * lu(k,225) - lu(k,228) = lu(k,228) * lu(k,225) - lu(k,229) = lu(k,229) * lu(k,225) - lu(k,595) = - lu(k,226) * lu(k,586) - lu(k,596) = lu(k,596) - lu(k,227) * lu(k,586) - lu(k,597) = - lu(k,228) * lu(k,586) - lu(k,599) = lu(k,599) - lu(k,229) * lu(k,586) - lu(k,638) = - lu(k,226) * lu(k,629) - lu(k,639) = lu(k,639) - lu(k,227) * lu(k,629) - lu(k,640) = - lu(k,228) * lu(k,629) - lu(k,644) = lu(k,644) - lu(k,229) * lu(k,629) - lu(k,1488) = lu(k,1488) - lu(k,226) * lu(k,1445) - lu(k,1497) = lu(k,1497) - lu(k,227) * lu(k,1445) - lu(k,1503) = lu(k,1503) - lu(k,228) * lu(k,1445) - lu(k,1519) = lu(k,1519) - lu(k,229) * lu(k,1445) - lu(k,230) = 1._r8 / lu(k,230) - lu(k,231) = lu(k,231) * lu(k,230) - lu(k,232) = lu(k,232) * lu(k,230) - lu(k,233) = lu(k,233) * lu(k,230) - lu(k,234) = lu(k,234) * lu(k,230) - lu(k,1317) = lu(k,1317) - lu(k,231) * lu(k,1315) - lu(k,1318) = lu(k,1318) - lu(k,232) * lu(k,1315) - lu(k,1325) = lu(k,1325) - lu(k,233) * lu(k,1315) - lu(k,1330) = lu(k,1330) - lu(k,234) * lu(k,1315) - lu(k,2003) = lu(k,2003) - lu(k,231) * lu(k,2000) - lu(k,2004) = lu(k,2004) - lu(k,232) * lu(k,2000) - lu(k,2013) = lu(k,2013) - lu(k,233) * lu(k,2000) - lu(k,2021) = lu(k,2021) - lu(k,234) * lu(k,2000) - lu(k,2123) = lu(k,2123) - lu(k,231) * lu(k,2121) - lu(k,2125) = lu(k,2125) - lu(k,232) * lu(k,2121) - lu(k,2135) = lu(k,2135) - lu(k,233) * lu(k,2121) - lu(k,2143) = lu(k,2143) - lu(k,234) * lu(k,2121) - lu(k,235) = 1._r8 / lu(k,235) - lu(k,236) = lu(k,236) * lu(k,235) - lu(k,237) = lu(k,237) * lu(k,235) - lu(k,238) = lu(k,238) * lu(k,235) - lu(k,239) = lu(k,239) * lu(k,235) - lu(k,336) = lu(k,336) - lu(k,236) * lu(k,335) - lu(k,337) = lu(k,337) - lu(k,237) * lu(k,335) - lu(k,339) = - lu(k,238) * lu(k,335) - lu(k,341) = lu(k,341) - lu(k,239) * lu(k,335) - lu(k,1633) = lu(k,1633) - lu(k,236) * lu(k,1619) - lu(k,1678) = lu(k,1678) - lu(k,237) * lu(k,1619) - lu(k,1719) = lu(k,1719) - lu(k,238) * lu(k,1619) - lu(k,1728) = lu(k,1728) - lu(k,239) * lu(k,1619) - lu(k,2040) = lu(k,2040) - lu(k,236) * lu(k,2028) - lu(k,2073) = lu(k,2073) - lu(k,237) * lu(k,2028) - lu(k,2106) = lu(k,2106) - lu(k,238) * lu(k,2028) - lu(k,2115) = lu(k,2115) - lu(k,239) * lu(k,2028) - lu(k,241) = 1._r8 / lu(k,241) - lu(k,242) = lu(k,242) * lu(k,241) - lu(k,243) = lu(k,243) * lu(k,241) - lu(k,244) = lu(k,244) * lu(k,241) - lu(k,245) = lu(k,245) * lu(k,241) - lu(k,323) = lu(k,323) - lu(k,242) * lu(k,322) - lu(k,324) = lu(k,324) - lu(k,243) * lu(k,322) - lu(k,326) = lu(k,326) - lu(k,244) * lu(k,322) - lu(k,328) = lu(k,328) - lu(k,245) * lu(k,322) - lu(k,1632) = lu(k,1632) - lu(k,242) * lu(k,1620) - lu(k,1641) = lu(k,1641) - lu(k,243) * lu(k,1620) - lu(k,1719) = lu(k,1719) - lu(k,244) * lu(k,1620) - lu(k,1728) = lu(k,1728) - lu(k,245) * lu(k,1620) - lu(k,2038) = lu(k,2038) - lu(k,242) * lu(k,2029) - lu(k,2048) = lu(k,2048) - lu(k,243) * lu(k,2029) - lu(k,2106) = lu(k,2106) - lu(k,244) * lu(k,2029) - lu(k,2115) = lu(k,2115) - lu(k,245) * lu(k,2029) - lu(k,246) = 1._r8 / lu(k,246) - lu(k,247) = lu(k,247) * lu(k,246) - lu(k,248) = lu(k,248) * lu(k,246) - lu(k,249) = lu(k,249) * lu(k,246) - lu(k,250) = lu(k,250) * lu(k,246) - lu(k,840) = lu(k,840) - lu(k,247) * lu(k,838) - lu(k,841) = lu(k,841) - lu(k,248) * lu(k,838) - lu(k,845) = lu(k,845) - lu(k,249) * lu(k,838) - lu(k,848) = lu(k,848) - lu(k,250) * lu(k,838) - lu(k,1681) = lu(k,1681) - lu(k,247) * lu(k,1621) - lu(k,1699) = lu(k,1699) - lu(k,248) * lu(k,1621) - lu(k,1719) = lu(k,1719) - lu(k,249) * lu(k,1621) - lu(k,1728) = lu(k,1728) - lu(k,250) * lu(k,1621) - lu(k,2075) = lu(k,2075) - lu(k,247) * lu(k,2030) - lu(k,2087) = lu(k,2087) - lu(k,248) * lu(k,2030) - lu(k,2106) = lu(k,2106) - lu(k,249) * lu(k,2030) - lu(k,2115) = lu(k,2115) - lu(k,250) * lu(k,2030) + lu(k,212) = lu(k,212) * lu(k,206) + lu(k,213) = lu(k,213) * lu(k,206) + lu(k,1675) = lu(k,1675) - lu(k,207) * lu(k,1674) + lu(k,1709) = lu(k,1709) - lu(k,208) * lu(k,1674) + lu(k,1745) = lu(k,1745) - lu(k,209) * lu(k,1674) + lu(k,1774) = lu(k,1774) - lu(k,210) * lu(k,1674) + lu(k,1789) = lu(k,1789) - lu(k,211) * lu(k,1674) + lu(k,1799) = lu(k,1799) - lu(k,212) * lu(k,1674) + lu(k,1806) = lu(k,1806) - lu(k,213) * lu(k,1674) + lu(k,214) = 1._r8 / lu(k,214) + lu(k,215) = lu(k,215) * lu(k,214) + lu(k,216) = lu(k,216) * lu(k,214) + lu(k,217) = lu(k,217) * lu(k,214) + lu(k,218) = lu(k,218) * lu(k,214) + lu(k,1713) = lu(k,1713) - lu(k,215) * lu(k,1675) + lu(k,1718) = lu(k,1718) - lu(k,216) * lu(k,1675) + lu(k,1799) = lu(k,1799) - lu(k,217) * lu(k,1675) + lu(k,1806) = lu(k,1806) - lu(k,218) * lu(k,1675) + lu(k,219) = 1._r8 / lu(k,219) + lu(k,220) = lu(k,220) * lu(k,219) + lu(k,221) = lu(k,221) * lu(k,219) + lu(k,222) = lu(k,222) * lu(k,219) + lu(k,223) = lu(k,223) * lu(k,219) + lu(k,1617) = lu(k,1617) - lu(k,220) * lu(k,1616) + lu(k,1633) = lu(k,1633) - lu(k,221) * lu(k,1616) + lu(k,1634) = lu(k,1634) - lu(k,222) * lu(k,1616) + lu(k,1637) = lu(k,1637) - lu(k,223) * lu(k,1616) + lu(k,1677) = lu(k,1677) - lu(k,220) * lu(k,1676) + lu(k,1798) = lu(k,1798) - lu(k,221) * lu(k,1676) + lu(k,1799) = lu(k,1799) - lu(k,222) * lu(k,1676) + lu(k,1802) = lu(k,1802) - lu(k,223) * lu(k,1676) + lu(k,224) = 1._r8 / lu(k,224) + lu(k,225) = lu(k,225) * lu(k,224) + lu(k,226) = lu(k,226) * lu(k,224) + lu(k,227) = lu(k,227) * lu(k,224) + lu(k,1626) = lu(k,1626) - lu(k,225) * lu(k,1617) + lu(k,1633) = lu(k,1633) - lu(k,226) * lu(k,1617) + lu(k,1637) = lu(k,1637) - lu(k,227) * lu(k,1617) + lu(k,1757) = - lu(k,225) * lu(k,1677) + lu(k,1798) = lu(k,1798) - lu(k,226) * lu(k,1677) + lu(k,1802) = lu(k,1802) - lu(k,227) * lu(k,1677) + lu(k,228) = 1._r8 / lu(k,228) + lu(k,229) = lu(k,229) * lu(k,228) + lu(k,230) = lu(k,230) * lu(k,228) + lu(k,231) = lu(k,231) * lu(k,228) + lu(k,232) = lu(k,232) * lu(k,228) + lu(k,1316) = - lu(k,229) * lu(k,1313) + lu(k,1327) = - lu(k,230) * lu(k,1313) + lu(k,1336) = - lu(k,231) * lu(k,1313) + lu(k,1341) = lu(k,1341) - lu(k,232) * lu(k,1313) + lu(k,1728) = - lu(k,229) * lu(k,1678) + lu(k,1780) = lu(k,1780) - lu(k,230) * lu(k,1678) + lu(k,1799) = lu(k,1799) - lu(k,231) * lu(k,1678) + lu(k,1806) = lu(k,1806) - lu(k,232) * lu(k,1678) + lu(k,233) = 1._r8 / lu(k,233) + lu(k,234) = lu(k,234) * lu(k,233) + lu(k,235) = lu(k,235) * lu(k,233) + lu(k,989) = - lu(k,234) * lu(k,985) + lu(k,1001) = lu(k,1001) - lu(k,235) * lu(k,985) + lu(k,1017) = - lu(k,234) * lu(k,1013) + lu(k,1029) = lu(k,1029) - lu(k,235) * lu(k,1013) + lu(k,1764) = lu(k,1764) - lu(k,234) * lu(k,1679) + lu(k,1799) = lu(k,1799) - lu(k,235) * lu(k,1679) + lu(k,2377) = - lu(k,234) * lu(k,2364) + lu(k,2407) = lu(k,2407) - lu(k,235) * lu(k,2364) + lu(k,236) = 1._r8 / lu(k,236) + lu(k,237) = lu(k,237) * lu(k,236) + lu(k,238) = lu(k,238) * lu(k,236) + lu(k,787) = lu(k,787) - lu(k,237) * lu(k,784) + lu(k,790) = - lu(k,238) * lu(k,784) + lu(k,1494) = - lu(k,237) * lu(k,1489) + lu(k,1501) = lu(k,1501) - lu(k,238) * lu(k,1489) + lu(k,1561) = lu(k,1561) - lu(k,237) * lu(k,1554) + lu(k,1569) = lu(k,1569) - lu(k,238) * lu(k,1554) + lu(k,1587) = lu(k,1587) - lu(k,237) * lu(k,1580) + lu(k,1595) = lu(k,1595) - lu(k,238) * lu(k,1580) end do - end subroutine lu_fac05 - subroutine lu_fac06( avec_len, lu ) + 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 @@ -638,137 +432,123 @@ subroutine lu_fac06( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,251) = 1._r8 / lu(k,251) - lu(k,252) = lu(k,252) * lu(k,251) - lu(k,253) = lu(k,253) * lu(k,251) - lu(k,254) = lu(k,254) * lu(k,251) - lu(k,255) = lu(k,255) * lu(k,251) - lu(k,256) = lu(k,256) * lu(k,251) - lu(k,257) = lu(k,257) * lu(k,251) - lu(k,258) = lu(k,258) * lu(k,251) - lu(k,1662) = lu(k,1662) - lu(k,252) * lu(k,1622) - lu(k,1684) = lu(k,1684) - lu(k,253) * lu(k,1622) - lu(k,1694) = lu(k,1694) - lu(k,254) * lu(k,1622) - lu(k,1711) = lu(k,1711) - lu(k,255) * lu(k,1622) - lu(k,1719) = lu(k,1719) - lu(k,256) * lu(k,1622) - lu(k,1721) = lu(k,1721) - lu(k,257) * lu(k,1622) - lu(k,1724) = lu(k,1724) - lu(k,258) * lu(k,1622) - lu(k,1802) = - lu(k,252) * lu(k,1795) - lu(k,1810) = - lu(k,253) * lu(k,1795) - lu(k,1812) = lu(k,1812) - lu(k,254) * lu(k,1795) - lu(k,1814) = lu(k,1814) - lu(k,255) * lu(k,1795) - lu(k,1822) = lu(k,1822) - lu(k,256) * lu(k,1795) - lu(k,1824) = lu(k,1824) - lu(k,257) * lu(k,1795) - lu(k,1827) = lu(k,1827) - lu(k,258) * lu(k,1795) + lu(k,239) = 1._r8 / lu(k,239) + lu(k,240) = lu(k,240) * lu(k,239) + lu(k,241) = lu(k,241) * lu(k,239) + lu(k,1181) = lu(k,1181) - lu(k,240) * lu(k,1169) + lu(k,1182) = - lu(k,241) * lu(k,1169) + lu(k,1199) = lu(k,1199) - lu(k,240) * lu(k,1188) + lu(k,1201) = lu(k,1201) - lu(k,241) * lu(k,1188) + lu(k,1800) = lu(k,1800) - lu(k,240) * lu(k,1680) + lu(k,1803) = lu(k,1803) - lu(k,241) * lu(k,1680) + lu(k,2069) = lu(k,2069) - lu(k,240) * lu(k,1999) + lu(k,2072) = - lu(k,241) * lu(k,1999) + lu(k,242) = 1._r8 / lu(k,242) + lu(k,243) = lu(k,243) * lu(k,242) + lu(k,244) = lu(k,244) * lu(k,242) + lu(k,250) = - lu(k,243) * lu(k,248) + lu(k,251) = lu(k,251) - lu(k,244) * lu(k,248) + lu(k,273) = - lu(k,243) * lu(k,271) + lu(k,274) = lu(k,274) - lu(k,244) * lu(k,271) + lu(k,1626) = lu(k,1626) - lu(k,243) * lu(k,1618) + lu(k,1633) = lu(k,1633) - lu(k,244) * lu(k,1618) + lu(k,1757) = lu(k,1757) - lu(k,243) * lu(k,1681) + lu(k,1798) = lu(k,1798) - lu(k,244) * lu(k,1681) + lu(k,245) = 1._r8 / lu(k,245) + lu(k,246) = lu(k,246) * lu(k,245) + lu(k,247) = lu(k,247) * lu(k,245) + lu(k,345) = - lu(k,246) * lu(k,342) + lu(k,346) = lu(k,346) - lu(k,247) * lu(k,342) + lu(k,434) = - lu(k,246) * lu(k,431) + lu(k,435) = - lu(k,247) * lu(k,431) + lu(k,1720) = lu(k,1720) - lu(k,246) * lu(k,1682) + lu(k,1799) = lu(k,1799) - lu(k,247) * lu(k,1682) + lu(k,2013) = lu(k,2013) - lu(k,246) * lu(k,2000) + lu(k,2068) = lu(k,2068) - lu(k,247) * lu(k,2000) + lu(k,249) = 1._r8 / lu(k,249) + lu(k,250) = lu(k,250) * lu(k,249) + lu(k,251) = lu(k,251) * lu(k,249) + lu(k,252) = lu(k,252) * lu(k,249) + lu(k,253) = lu(k,253) * lu(k,249) + lu(k,1626) = lu(k,1626) - lu(k,250) * lu(k,1619) + lu(k,1633) = lu(k,1633) - lu(k,251) * lu(k,1619) + lu(k,1634) = lu(k,1634) - lu(k,252) * lu(k,1619) + lu(k,1637) = lu(k,1637) - lu(k,253) * lu(k,1619) + lu(k,1757) = lu(k,1757) - lu(k,250) * lu(k,1683) + lu(k,1798) = lu(k,1798) - lu(k,251) * lu(k,1683) + lu(k,1799) = lu(k,1799) - lu(k,252) * lu(k,1683) + lu(k,1802) = lu(k,1802) - lu(k,253) * lu(k,1683) + lu(k,254) = 1._r8 / lu(k,254) + lu(k,255) = lu(k,255) * lu(k,254) + lu(k,256) = lu(k,256) * lu(k,254) + lu(k,257) = lu(k,257) * lu(k,254) + lu(k,972) = lu(k,972) - lu(k,255) * lu(k,963) + lu(k,973) = - lu(k,256) * lu(k,963) + lu(k,976) = lu(k,976) - lu(k,257) * lu(k,963) + lu(k,1630) = lu(k,1630) - lu(k,255) * lu(k,1620) + lu(k,1633) = lu(k,1633) - lu(k,256) * lu(k,1620) + lu(k,1639) = lu(k,1639) - lu(k,257) * lu(k,1620) + lu(k,1840) = lu(k,1840) - lu(k,255) * lu(k,1814) + lu(k,1843) = - lu(k,256) * lu(k,1814) + lu(k,1849) = lu(k,1849) - lu(k,257) * lu(k,1814) lu(k,259) = 1._r8 / lu(k,259) lu(k,260) = lu(k,260) * lu(k,259) lu(k,261) = lu(k,261) * lu(k,259) lu(k,262) = lu(k,262) * lu(k,259) - lu(k,263) = lu(k,263) * lu(k,259) - lu(k,264) = lu(k,264) * lu(k,259) - lu(k,265) = lu(k,265) * lu(k,259) - lu(k,266) = lu(k,266) * lu(k,259) - lu(k,1648) = lu(k,1648) - lu(k,260) * lu(k,1623) - lu(k,1685) = lu(k,1685) - lu(k,261) * lu(k,1623) - lu(k,1699) = lu(k,1699) - lu(k,262) * lu(k,1623) - lu(k,1719) = lu(k,1719) - lu(k,263) * lu(k,1623) - lu(k,1722) = lu(k,1722) - lu(k,264) * lu(k,1623) - lu(k,1723) = lu(k,1723) - lu(k,265) * lu(k,1623) - lu(k,1726) = lu(k,1726) - lu(k,266) * lu(k,1623) - lu(k,1864) = - lu(k,260) * lu(k,1863) - lu(k,1872) = lu(k,1872) - lu(k,261) * lu(k,1863) - lu(k,1885) = lu(k,1885) - lu(k,262) * lu(k,1863) - lu(k,1903) = lu(k,1903) - lu(k,263) * lu(k,1863) - lu(k,1906) = lu(k,1906) - lu(k,264) * lu(k,1863) - lu(k,1907) = lu(k,1907) - lu(k,265) * lu(k,1863) - lu(k,1910) = lu(k,1910) - lu(k,266) * lu(k,1863) + lu(k,945) = lu(k,945) - lu(k,260) * lu(k,944) + lu(k,949) = lu(k,949) - lu(k,261) * lu(k,944) + lu(k,950) = - lu(k,262) * lu(k,944) + lu(k,1759) = lu(k,1759) - lu(k,260) * lu(k,1684) + lu(k,1809) = lu(k,1809) - lu(k,261) * lu(k,1684) + lu(k,1812) = lu(k,1812) - lu(k,262) * lu(k,1684) + lu(k,2425) = - lu(k,260) * lu(k,2422) + lu(k,2444) = lu(k,2444) - lu(k,261) * lu(k,2422) + lu(k,2447) = lu(k,2447) - lu(k,262) * lu(k,2422) + lu(k,263) = 1._r8 / lu(k,263) + lu(k,264) = lu(k,264) * lu(k,263) + lu(k,265) = lu(k,265) * lu(k,263) + lu(k,266) = lu(k,266) * lu(k,263) + lu(k,900) = lu(k,900) - lu(k,264) * lu(k,896) + lu(k,902) = - lu(k,265) * lu(k,896) + lu(k,905) = lu(k,905) - lu(k,266) * lu(k,896) + lu(k,1773) = lu(k,1773) - lu(k,264) * lu(k,1685) + lu(k,1799) = lu(k,1799) - lu(k,265) * lu(k,1685) + lu(k,1806) = lu(k,1806) - lu(k,266) * lu(k,1685) + lu(k,2228) = lu(k,2228) - lu(k,264) * lu(k,2211) + lu(k,2249) = - lu(k,265) * lu(k,2211) + lu(k,2256) = lu(k,2256) - lu(k,266) * lu(k,2211) lu(k,267) = 1._r8 / lu(k,267) lu(k,268) = lu(k,268) * lu(k,267) lu(k,269) = lu(k,269) * lu(k,267) lu(k,270) = lu(k,270) * lu(k,267) - lu(k,271) = lu(k,271) * lu(k,267) - lu(k,272) = lu(k,272) * lu(k,267) - lu(k,1119) = - lu(k,268) * lu(k,1115) - lu(k,1121) = - lu(k,269) * lu(k,1115) - lu(k,1131) = - lu(k,270) * lu(k,1115) - lu(k,1135) = - lu(k,271) * lu(k,1115) - lu(k,1137) = lu(k,1137) - lu(k,272) * lu(k,1115) - lu(k,1371) = - lu(k,268) * lu(k,1365) - lu(k,1377) = lu(k,1377) - lu(k,269) * lu(k,1365) - lu(k,1400) = lu(k,1400) - lu(k,270) * lu(k,1365) - lu(k,1405) = - lu(k,271) * lu(k,1365) - lu(k,1407) = lu(k,1407) - lu(k,272) * lu(k,1365) - lu(k,1676) = lu(k,1676) - lu(k,268) * lu(k,1624) - lu(k,1690) = lu(k,1690) - lu(k,269) * lu(k,1624) - lu(k,1719) = lu(k,1719) - lu(k,270) * lu(k,1624) - lu(k,1725) = lu(k,1725) - lu(k,271) * lu(k,1624) - lu(k,1728) = lu(k,1728) - lu(k,272) * lu(k,1624) - lu(k,273) = 1._r8 / lu(k,273) - lu(k,274) = lu(k,274) * lu(k,273) - lu(k,275) = lu(k,275) * lu(k,273) - lu(k,276) = lu(k,276) * lu(k,273) - lu(k,277) = lu(k,277) * lu(k,273) - lu(k,278) = lu(k,278) * lu(k,273) - lu(k,376) = lu(k,376) - lu(k,274) * lu(k,375) - lu(k,377) = lu(k,377) - lu(k,275) * lu(k,375) - lu(k,379) = lu(k,379) - lu(k,276) * lu(k,375) - lu(k,381) = - lu(k,277) * lu(k,375) - lu(k,383) = lu(k,383) - lu(k,278) * lu(k,375) - lu(k,1634) = lu(k,1634) - lu(k,274) * lu(k,1625) - lu(k,1639) = lu(k,1639) - lu(k,275) * lu(k,1625) - lu(k,1678) = lu(k,1678) - lu(k,276) * lu(k,1625) - lu(k,1719) = lu(k,1719) - lu(k,277) * lu(k,1625) - lu(k,1728) = lu(k,1728) - lu(k,278) * lu(k,1625) - lu(k,2041) = - lu(k,274) * lu(k,2031) - lu(k,2046) = lu(k,2046) - lu(k,275) * lu(k,2031) - lu(k,2073) = lu(k,2073) - lu(k,276) * lu(k,2031) - lu(k,2106) = lu(k,2106) - lu(k,277) * lu(k,2031) - lu(k,2115) = lu(k,2115) - lu(k,278) * lu(k,2031) - lu(k,279) = 1._r8 / lu(k,279) - lu(k,280) = lu(k,280) * lu(k,279) - lu(k,281) = lu(k,281) * lu(k,279) - lu(k,282) = lu(k,282) * lu(k,279) - lu(k,283) = lu(k,283) * lu(k,279) - lu(k,284) = lu(k,284) * lu(k,279) - lu(k,819) = - lu(k,280) * lu(k,817) - lu(k,825) = lu(k,825) - lu(k,281) * lu(k,817) - lu(k,829) = - lu(k,282) * lu(k,817) - lu(k,830) = lu(k,830) - lu(k,283) * lu(k,817) - lu(k,835) = lu(k,835) - lu(k,284) * lu(k,817) - lu(k,857) = - lu(k,280) * lu(k,855) - lu(k,863) = lu(k,863) - lu(k,281) * lu(k,855) - lu(k,867) = - lu(k,282) * lu(k,855) - lu(k,868) = lu(k,868) - lu(k,283) * lu(k,855) - lu(k,873) = lu(k,873) - lu(k,284) * lu(k,855) - lu(k,1748) = - lu(k,280) * lu(k,1739) - lu(k,1759) = lu(k,1759) - lu(k,281) * lu(k,1739) - lu(k,1767) = lu(k,1767) - lu(k,282) * lu(k,1739) - lu(k,1773) = lu(k,1773) - lu(k,283) * lu(k,1739) - lu(k,1790) = lu(k,1790) - lu(k,284) * lu(k,1739) - lu(k,285) = 1._r8 / lu(k,285) - lu(k,286) = lu(k,286) * lu(k,285) - lu(k,287) = lu(k,287) * lu(k,285) - lu(k,288) = lu(k,288) * lu(k,285) - lu(k,289) = lu(k,289) * lu(k,285) - lu(k,290) = lu(k,290) * lu(k,285) - lu(k,1045) = lu(k,1045) - lu(k,286) * lu(k,1042) - lu(k,1049) = lu(k,1049) - lu(k,287) * lu(k,1042) - lu(k,1054) = - lu(k,288) * lu(k,1042) - lu(k,1058) = - lu(k,289) * lu(k,1042) - lu(k,1059) = lu(k,1059) - lu(k,290) * lu(k,1042) - lu(k,1687) = lu(k,1687) - lu(k,286) * lu(k,1626) - lu(k,1697) = lu(k,1697) - lu(k,287) * lu(k,1626) - lu(k,1719) = lu(k,1719) - lu(k,288) * lu(k,1626) - lu(k,1725) = lu(k,1725) - lu(k,289) * lu(k,1626) - lu(k,1726) = lu(k,1726) - lu(k,290) * lu(k,1626) - lu(k,2078) = - lu(k,286) * lu(k,2032) - lu(k,2085) = lu(k,2085) - lu(k,287) * lu(k,2032) - lu(k,2106) = lu(k,2106) - lu(k,288) * lu(k,2032) - lu(k,2112) = - lu(k,289) * lu(k,2032) - lu(k,2113) = lu(k,2113) - lu(k,290) * lu(k,2032) + lu(k,632) = lu(k,632) - lu(k,268) * lu(k,631) + lu(k,633) = lu(k,633) - lu(k,269) * lu(k,631) + lu(k,634) = - lu(k,270) * lu(k,631) + lu(k,1713) = lu(k,1713) - lu(k,268) * lu(k,1686) + lu(k,1733) = lu(k,1733) - lu(k,269) * lu(k,1686) + lu(k,1799) = lu(k,1799) - lu(k,270) * lu(k,1686) + lu(k,2135) = - lu(k,268) * lu(k,2117) + lu(k,2144) = lu(k,2144) - lu(k,269) * lu(k,2117) + lu(k,2197) = lu(k,2197) - lu(k,270) * lu(k,2117) + lu(k,272) = 1._r8 / lu(k,272) + lu(k,273) = lu(k,273) * lu(k,272) + lu(k,274) = lu(k,274) * lu(k,272) + lu(k,275) = lu(k,275) * lu(k,272) + lu(k,276) = lu(k,276) * lu(k,272) + lu(k,277) = lu(k,277) * lu(k,272) + lu(k,1626) = lu(k,1626) - lu(k,273) * lu(k,1621) + lu(k,1633) = lu(k,1633) - lu(k,274) * lu(k,1621) + lu(k,1634) = lu(k,1634) - lu(k,275) * lu(k,1621) + lu(k,1637) = lu(k,1637) - lu(k,276) * lu(k,1621) + lu(k,1647) = lu(k,1647) - lu(k,277) * lu(k,1621) + lu(k,1757) = lu(k,1757) - lu(k,273) * lu(k,1687) + lu(k,1798) = lu(k,1798) - lu(k,274) * lu(k,1687) + lu(k,1799) = lu(k,1799) - lu(k,275) * lu(k,1687) + lu(k,1802) = lu(k,1802) - lu(k,276) * lu(k,1687) + lu(k,1812) = lu(k,1812) - lu(k,277) * lu(k,1687) end do - end subroutine lu_fac06 - subroutine lu_fac07( avec_len, lu ) + 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 @@ -782,156 +562,132 @@ subroutine lu_fac07( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,291) = 1._r8 / lu(k,291) - lu(k,292) = lu(k,292) * lu(k,291) - lu(k,293) = lu(k,293) * lu(k,291) - lu(k,294) = lu(k,294) * lu(k,291) - lu(k,295) = lu(k,295) * lu(k,291) - lu(k,296) = lu(k,296) * lu(k,291) - lu(k,1065) = lu(k,1065) - lu(k,292) * lu(k,1062) - lu(k,1067) = lu(k,1067) - lu(k,293) * lu(k,1062) - lu(k,1070) = lu(k,1070) - lu(k,294) * lu(k,1062) - lu(k,1071) = lu(k,1071) - lu(k,295) * lu(k,1062) - lu(k,1074) = - lu(k,296) * lu(k,1062) - lu(k,1698) = lu(k,1698) - lu(k,292) * lu(k,1627) - lu(k,1710) = lu(k,1710) - lu(k,293) * lu(k,1627) - lu(k,1719) = lu(k,1719) - lu(k,294) * lu(k,1627) - lu(k,1722) = lu(k,1722) - lu(k,295) * lu(k,1627) - lu(k,1730) = lu(k,1730) - lu(k,296) * lu(k,1627) - lu(k,2086) = lu(k,2086) - lu(k,292) * lu(k,2033) - lu(k,2098) = lu(k,2098) - lu(k,293) * lu(k,2033) - lu(k,2106) = lu(k,2106) - lu(k,294) * lu(k,2033) - lu(k,2109) = lu(k,2109) - lu(k,295) * lu(k,2033) - lu(k,2117) = lu(k,2117) - lu(k,296) * lu(k,2033) - lu(k,297) = 1._r8 / lu(k,297) - lu(k,298) = lu(k,298) * lu(k,297) - lu(k,299) = lu(k,299) * lu(k,297) - lu(k,300) = lu(k,300) * lu(k,297) - lu(k,301) = lu(k,301) * lu(k,297) - lu(k,302) = lu(k,302) * lu(k,297) - lu(k,1117) = - lu(k,298) * lu(k,1116) - lu(k,1119) = lu(k,1119) - lu(k,299) * lu(k,1116) - lu(k,1131) = lu(k,1131) - lu(k,300) * lu(k,1116) - lu(k,1136) = lu(k,1136) - lu(k,301) * lu(k,1116) - lu(k,1137) = lu(k,1137) - lu(k,302) * lu(k,1116) - lu(k,1660) = lu(k,1660) - lu(k,298) * lu(k,1628) - lu(k,1676) = lu(k,1676) - lu(k,299) * lu(k,1628) - lu(k,1719) = lu(k,1719) - lu(k,300) * lu(k,1628) - lu(k,1726) = lu(k,1726) - lu(k,301) * lu(k,1628) - lu(k,1728) = lu(k,1728) - lu(k,302) * lu(k,1628) - lu(k,2059) = lu(k,2059) - lu(k,298) * lu(k,2034) - lu(k,2072) = - lu(k,299) * lu(k,2034) - lu(k,2106) = lu(k,2106) - lu(k,300) * lu(k,2034) - lu(k,2113) = lu(k,2113) - lu(k,301) * lu(k,2034) - lu(k,2115) = lu(k,2115) - lu(k,302) * lu(k,2034) - lu(k,303) = 1._r8 / lu(k,303) - lu(k,304) = lu(k,304) * lu(k,303) - lu(k,305) = lu(k,305) * lu(k,303) - lu(k,306) = lu(k,306) * lu(k,303) - lu(k,307) = lu(k,307) * lu(k,303) - lu(k,308) = lu(k,308) * lu(k,303) - lu(k,728) = lu(k,728) - lu(k,304) * lu(k,727) - lu(k,729) = lu(k,729) - lu(k,305) * lu(k,727) - lu(k,734) = - lu(k,306) * lu(k,727) - lu(k,737) = lu(k,737) - lu(k,307) * lu(k,727) - lu(k,738) = - lu(k,308) * lu(k,727) - lu(k,1672) = lu(k,1672) - lu(k,304) * lu(k,1629) - lu(k,1685) = lu(k,1685) - lu(k,305) * lu(k,1629) - lu(k,1719) = lu(k,1719) - lu(k,306) * lu(k,1629) - lu(k,1728) = lu(k,1728) - lu(k,307) * lu(k,1629) - lu(k,1730) = lu(k,1730) - lu(k,308) * lu(k,1629) - lu(k,2069) = lu(k,2069) - lu(k,304) * lu(k,2035) - lu(k,2077) = - lu(k,305) * lu(k,2035) - lu(k,2106) = lu(k,2106) - lu(k,306) * lu(k,2035) - lu(k,2115) = lu(k,2115) - lu(k,307) * lu(k,2035) - lu(k,2117) = lu(k,2117) - lu(k,308) * lu(k,2035) - lu(k,309) = 1._r8 / lu(k,309) - lu(k,310) = lu(k,310) * lu(k,309) - lu(k,311) = lu(k,311) * lu(k,309) - lu(k,312) = lu(k,312) * lu(k,309) - lu(k,313) = lu(k,313) * lu(k,309) - lu(k,314) = lu(k,314) * lu(k,309) - lu(k,1396) = lu(k,1396) - lu(k,310) * lu(k,1366) - lu(k,1400) = lu(k,1400) - lu(k,311) * lu(k,1366) - lu(k,1402) = lu(k,1402) - lu(k,312) * lu(k,1366) - lu(k,1404) = - lu(k,313) * lu(k,1366) - lu(k,1409) = - lu(k,314) * lu(k,1366) - lu(k,1714) = lu(k,1714) - lu(k,310) * lu(k,1630) - lu(k,1719) = lu(k,1719) - lu(k,311) * lu(k,1630) - lu(k,1722) = lu(k,1722) - lu(k,312) * lu(k,1630) - lu(k,1724) = lu(k,1724) - lu(k,313) * lu(k,1630) - lu(k,1730) = lu(k,1730) - lu(k,314) * lu(k,1630) - lu(k,2101) = lu(k,2101) - lu(k,310) * lu(k,2036) - lu(k,2106) = lu(k,2106) - lu(k,311) * lu(k,2036) - lu(k,2109) = lu(k,2109) - lu(k,312) * lu(k,2036) - lu(k,2111) = lu(k,2111) - lu(k,313) * lu(k,2036) - lu(k,2117) = lu(k,2117) - lu(k,314) * lu(k,2036) - lu(k,315) = 1._r8 / lu(k,315) - lu(k,316) = lu(k,316) * lu(k,315) - lu(k,317) = lu(k,317) * lu(k,315) - lu(k,318) = lu(k,318) * lu(k,315) - lu(k,319) = lu(k,319) * lu(k,315) - lu(k,320) = lu(k,320) * lu(k,315) - lu(k,392) = lu(k,392) - lu(k,316) * lu(k,391) - lu(k,393) = lu(k,393) - lu(k,317) * lu(k,391) - lu(k,394) = lu(k,394) - lu(k,318) * lu(k,391) - lu(k,396) = - lu(k,319) * lu(k,391) - lu(k,398) = lu(k,398) - lu(k,320) * lu(k,391) - lu(k,1640) = lu(k,1640) - lu(k,316) * lu(k,1631) - lu(k,1678) = lu(k,1678) - lu(k,317) * lu(k,1631) - lu(k,1704) = lu(k,1704) - lu(k,318) * lu(k,1631) - lu(k,1719) = lu(k,1719) - lu(k,319) * lu(k,1631) - lu(k,1728) = lu(k,1728) - lu(k,320) * lu(k,1631) - lu(k,2047) = lu(k,2047) - lu(k,316) * lu(k,2037) - lu(k,2073) = lu(k,2073) - lu(k,317) * lu(k,2037) - lu(k,2092) = lu(k,2092) - lu(k,318) * lu(k,2037) - lu(k,2106) = lu(k,2106) - lu(k,319) * lu(k,2037) - lu(k,2115) = lu(k,2115) - lu(k,320) * lu(k,2037) - 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,326) = lu(k,326) * lu(k,323) - lu(k,327) = lu(k,327) * lu(k,323) - lu(k,328) = lu(k,328) * lu(k,323) - lu(k,1454) = lu(k,1454) - lu(k,324) * lu(k,1446) - lu(k,1507) = lu(k,1507) - lu(k,325) * lu(k,1446) - lu(k,1510) = lu(k,1510) - lu(k,326) * lu(k,1446) - lu(k,1517) = lu(k,1517) - lu(k,327) * lu(k,1446) - lu(k,1519) = lu(k,1519) - lu(k,328) * lu(k,1446) - lu(k,1641) = lu(k,1641) - lu(k,324) * lu(k,1632) - lu(k,1716) = lu(k,1716) - lu(k,325) * lu(k,1632) - lu(k,1719) = lu(k,1719) - lu(k,326) * lu(k,1632) - lu(k,1726) = lu(k,1726) - lu(k,327) * lu(k,1632) - lu(k,1728) = lu(k,1728) - lu(k,328) * lu(k,1632) - lu(k,2048) = lu(k,2048) - lu(k,324) * lu(k,2038) - lu(k,2103) = lu(k,2103) - lu(k,325) * lu(k,2038) - lu(k,2106) = lu(k,2106) - lu(k,326) * lu(k,2038) - lu(k,2113) = lu(k,2113) - lu(k,327) * lu(k,2038) - lu(k,2115) = lu(k,2115) - lu(k,328) * lu(k,2038) - lu(k,329) = 1._r8 / lu(k,329) - lu(k,330) = lu(k,330) * lu(k,329) - lu(k,331) = lu(k,331) * lu(k,329) - lu(k,332) = lu(k,332) * lu(k,329) - lu(k,333) = lu(k,333) * lu(k,329) - lu(k,334) = lu(k,334) * lu(k,329) - lu(k,1472) = lu(k,1472) - lu(k,330) * lu(k,1447) - lu(k,1507) = lu(k,1507) - lu(k,331) * lu(k,1447) - lu(k,1513) = lu(k,1513) - lu(k,332) * lu(k,1447) - lu(k,1517) = lu(k,1517) - lu(k,333) * lu(k,1447) - lu(k,1519) = lu(k,1519) - lu(k,334) * lu(k,1447) - lu(k,1835) = - lu(k,330) * lu(k,1834) - lu(k,1843) = - lu(k,331) * lu(k,1834) - lu(k,1849) = lu(k,1849) - lu(k,332) * lu(k,1834) - lu(k,1853) = - lu(k,333) * lu(k,1834) - lu(k,1855) = lu(k,1855) - lu(k,334) * lu(k,1834) - lu(k,2067) = lu(k,2067) - lu(k,330) * lu(k,2039) - lu(k,2103) = lu(k,2103) - lu(k,331) * lu(k,2039) - lu(k,2109) = lu(k,2109) - lu(k,332) * lu(k,2039) - lu(k,2113) = lu(k,2113) - lu(k,333) * lu(k,2039) - lu(k,2115) = lu(k,2115) - lu(k,334) * lu(k,2039) + lu(k,278) = 1._r8 / lu(k,278) + lu(k,279) = lu(k,279) * lu(k,278) + lu(k,280) = lu(k,280) * lu(k,278) + lu(k,281) = lu(k,281) * lu(k,278) + lu(k,282) = lu(k,282) * lu(k,278) + lu(k,283) = lu(k,283) * lu(k,278) + lu(k,1845) = lu(k,1845) - lu(k,279) * lu(k,1815) + lu(k,1846) = lu(k,1846) - lu(k,280) * lu(k,1815) + lu(k,1848) = lu(k,1848) - lu(k,281) * lu(k,1815) + lu(k,1849) = lu(k,1849) - lu(k,282) * lu(k,1815) + lu(k,1854) = lu(k,1854) - lu(k,283) * lu(k,1815) + lu(k,1905) = lu(k,1905) - lu(k,279) * lu(k,1860) + lu(k,1906) = lu(k,1906) - lu(k,280) * lu(k,1860) + lu(k,1908) = lu(k,1908) - lu(k,281) * lu(k,1860) + lu(k,1909) = lu(k,1909) - lu(k,282) * lu(k,1860) + lu(k,1914) = lu(k,1914) - lu(k,283) * lu(k,1860) + lu(k,284) = 1._r8 / lu(k,284) + lu(k,285) = lu(k,285) * lu(k,284) + lu(k,286) = lu(k,286) * lu(k,284) + lu(k,666) = - lu(k,285) * lu(k,660) + lu(k,672) = lu(k,672) - lu(k,286) * lu(k,660) + lu(k,722) = - lu(k,285) * lu(k,715) + lu(k,729) = lu(k,729) - lu(k,286) * lu(k,715) + lu(k,750) = - lu(k,285) * lu(k,744) + lu(k,758) = lu(k,758) - lu(k,286) * lu(k,744) + lu(k,766) = - lu(k,285) * lu(k,759) + lu(k,775) = lu(k,775) - lu(k,286) * lu(k,759) + lu(k,2025) = lu(k,2025) - lu(k,285) * lu(k,2001) + lu(k,2075) = lu(k,2075) - lu(k,286) * lu(k,2001) + lu(k,287) = 1._r8 / lu(k,287) + lu(k,288) = lu(k,288) * lu(k,287) + lu(k,289) = lu(k,289) * lu(k,287) + lu(k,923) = lu(k,923) - lu(k,288) * lu(k,922) + lu(k,928) = lu(k,928) - lu(k,289) * lu(k,922) + lu(k,1458) = lu(k,1458) - lu(k,288) * lu(k,1457) + lu(k,1466) = lu(k,1466) - lu(k,289) * lu(k,1457) + lu(k,1965) = lu(k,1965) - lu(k,288) * lu(k,1964) + lu(k,1979) = - lu(k,289) * lu(k,1964) + lu(k,2264) = lu(k,2264) - lu(k,288) * lu(k,2263) + lu(k,2280) = lu(k,2280) - lu(k,289) * lu(k,2263) + lu(k,2424) = lu(k,2424) - lu(k,288) * lu(k,2423) + lu(k,2440) = lu(k,2440) - lu(k,289) * lu(k,2423) + lu(k,290) = 1._r8 / lu(k,290) + lu(k,291) = lu(k,291) * lu(k,290) + lu(k,292) = lu(k,292) * lu(k,290) + lu(k,293) = lu(k,293) * lu(k,290) + lu(k,294) = lu(k,294) * lu(k,290) + lu(k,295) = lu(k,295) * lu(k,290) + lu(k,1755) = lu(k,1755) - lu(k,291) * lu(k,1688) + lu(k,1765) = lu(k,1765) - lu(k,292) * lu(k,1688) + lu(k,1774) = lu(k,1774) - lu(k,293) * lu(k,1688) + lu(k,1799) = lu(k,1799) - lu(k,294) * lu(k,1688) + lu(k,1806) = lu(k,1806) - lu(k,295) * lu(k,1688) + lu(k,1931) = - lu(k,291) * lu(k,1919) + lu(k,1934) = - lu(k,292) * lu(k,1919) + lu(k,1937) = lu(k,1937) - lu(k,293) * lu(k,1919) + lu(k,1950) = lu(k,1950) - lu(k,294) * lu(k,1919) + lu(k,1957) = lu(k,1957) - lu(k,295) * lu(k,1919) + lu(k,296) = 1._r8 / lu(k,296) + lu(k,297) = lu(k,297) * lu(k,296) + lu(k,298) = lu(k,298) * lu(k,296) + lu(k,299) = lu(k,299) * lu(k,296) + lu(k,300) = lu(k,300) * lu(k,296) + lu(k,301) = lu(k,301) * lu(k,296) + lu(k,1754) = lu(k,1754) - lu(k,297) * lu(k,1689) + lu(k,1793) = lu(k,1793) - lu(k,298) * lu(k,1689) + lu(k,1799) = lu(k,1799) - lu(k,299) * lu(k,1689) + lu(k,1802) = lu(k,1802) - lu(k,300) * lu(k,1689) + lu(k,1812) = lu(k,1812) - lu(k,301) * lu(k,1689) + lu(k,1930) = lu(k,1930) - lu(k,297) * lu(k,1920) + lu(k,1944) = lu(k,1944) - lu(k,298) * lu(k,1920) + lu(k,1950) = lu(k,1950) - lu(k,299) * lu(k,1920) + lu(k,1953) = lu(k,1953) - lu(k,300) * lu(k,1920) + lu(k,1963) = - lu(k,301) * lu(k,1920) + lu(k,302) = 1._r8 / lu(k,302) + lu(k,303) = lu(k,303) * lu(k,302) + lu(k,304) = lu(k,304) * lu(k,302) + lu(k,305) = lu(k,305) * lu(k,302) + lu(k,306) = lu(k,306) * lu(k,302) + lu(k,307) = lu(k,307) * lu(k,302) + lu(k,1758) = lu(k,1758) - lu(k,303) * lu(k,1690) + lu(k,1793) = lu(k,1793) - lu(k,304) * lu(k,1690) + lu(k,1799) = lu(k,1799) - lu(k,305) * lu(k,1690) + lu(k,1802) = lu(k,1802) - lu(k,306) * lu(k,1690) + lu(k,1812) = lu(k,1812) - lu(k,307) * lu(k,1690) + lu(k,1932) = lu(k,1932) - lu(k,303) * lu(k,1921) + lu(k,1944) = lu(k,1944) - lu(k,304) * lu(k,1921) + lu(k,1950) = lu(k,1950) - lu(k,305) * lu(k,1921) + lu(k,1953) = lu(k,1953) - lu(k,306) * lu(k,1921) + lu(k,1963) = lu(k,1963) - lu(k,307) * lu(k,1921) + 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,1759) = lu(k,1759) - lu(k,309) * lu(k,1691) + lu(k,1799) = lu(k,1799) - lu(k,310) * lu(k,1691) + lu(k,1801) = lu(k,1801) - lu(k,311) * lu(k,1691) + lu(k,1803) = lu(k,1803) - lu(k,312) * lu(k,1691) + lu(k,1806) = lu(k,1806) - lu(k,313) * lu(k,1691) + lu(k,1868) = lu(k,1868) - lu(k,309) * lu(k,1861) + lu(k,1904) = lu(k,1904) - lu(k,310) * lu(k,1861) + lu(k,1906) = lu(k,1906) - lu(k,311) * lu(k,1861) + lu(k,1908) = lu(k,1908) - lu(k,312) * lu(k,1861) + lu(k,1911) = lu(k,1911) - lu(k,313) * lu(k,1861) + lu(k,314) = 1._r8 / lu(k,314) + lu(k,315) = lu(k,315) * lu(k,314) + lu(k,316) = lu(k,316) * lu(k,314) + lu(k,317) = lu(k,317) * lu(k,314) + lu(k,318) = lu(k,318) * lu(k,314) + lu(k,1354) = lu(k,1354) - lu(k,315) * lu(k,1346) + lu(k,1355) = - lu(k,316) * lu(k,1346) + lu(k,1358) = - lu(k,317) * lu(k,1346) + lu(k,1363) = lu(k,1363) - lu(k,318) * lu(k,1346) + lu(k,1786) = lu(k,1786) - lu(k,315) * lu(k,1692) + lu(k,1788) = lu(k,1788) - lu(k,316) * lu(k,1692) + lu(k,1799) = lu(k,1799) - lu(k,317) * lu(k,1692) + lu(k,1806) = lu(k,1806) - lu(k,318) * lu(k,1692) + lu(k,2185) = lu(k,2185) - lu(k,315) * lu(k,2118) + lu(k,2187) = lu(k,2187) - lu(k,316) * lu(k,2118) + lu(k,2197) = lu(k,2197) - lu(k,317) * lu(k,2118) + lu(k,2204) = lu(k,2204) - lu(k,318) * lu(k,2118) end do - end subroutine lu_fac07 - subroutine lu_fac08( avec_len, lu ) + 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 @@ -945,114 +701,145 @@ subroutine lu_fac08( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - 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,341) = lu(k,341) * lu(k,336) - lu(k,1477) = lu(k,1477) - lu(k,337) * lu(k,1448) - lu(k,1507) = lu(k,1507) - lu(k,338) * lu(k,1448) - lu(k,1510) = lu(k,1510) - lu(k,339) * lu(k,1448) - lu(k,1517) = lu(k,1517) - lu(k,340) * lu(k,1448) - lu(k,1519) = lu(k,1519) - lu(k,341) * lu(k,1448) - lu(k,1678) = lu(k,1678) - lu(k,337) * lu(k,1633) - lu(k,1716) = lu(k,1716) - lu(k,338) * lu(k,1633) - lu(k,1719) = lu(k,1719) - lu(k,339) * lu(k,1633) - lu(k,1726) = lu(k,1726) - lu(k,340) * lu(k,1633) - lu(k,1728) = lu(k,1728) - lu(k,341) * lu(k,1633) - lu(k,2073) = lu(k,2073) - lu(k,337) * lu(k,2040) - lu(k,2103) = lu(k,2103) - lu(k,338) * lu(k,2040) - lu(k,2106) = lu(k,2106) - lu(k,339) * lu(k,2040) - lu(k,2113) = lu(k,2113) - lu(k,340) * lu(k,2040) - lu(k,2115) = lu(k,2115) - lu(k,341) * lu(k,2040) - 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,378) = - lu(k,343) * lu(k,376) - lu(k,383) = lu(k,383) - lu(k,344) * lu(k,376) - lu(k,494) = - lu(k,343) * lu(k,491) - lu(k,500) = lu(k,500) - lu(k,344) * lu(k,491) - lu(k,590) = - lu(k,343) * lu(k,587) - lu(k,599) = lu(k,599) - lu(k,344) * lu(k,587) - lu(k,617) = - lu(k,343) * lu(k,614) - lu(k,627) = lu(k,627) - lu(k,344) * lu(k,614) - lu(k,633) = - lu(k,343) * lu(k,630) - lu(k,644) = lu(k,644) - lu(k,344) * lu(k,630) - lu(k,1464) = lu(k,1464) - lu(k,343) * lu(k,1449) - lu(k,1519) = lu(k,1519) - lu(k,344) * lu(k,1449) - lu(k,1663) = - lu(k,343) * lu(k,1634) - lu(k,1728) = lu(k,1728) - lu(k,344) * lu(k,1634) - lu(k,2061) = lu(k,2061) - lu(k,343) * lu(k,2041) - lu(k,2115) = lu(k,2115) - lu(k,344) * lu(k,2041) - lu(k,345) = 1._r8 / lu(k,345) - lu(k,346) = lu(k,346) * lu(k,345) - lu(k,347) = lu(k,347) * lu(k,345) - lu(k,348) = lu(k,348) * lu(k,345) - lu(k,349) = lu(k,349) * lu(k,345) - lu(k,665) = - lu(k,346) * lu(k,663) - lu(k,666) = - lu(k,347) * lu(k,663) - lu(k,669) = lu(k,669) - lu(k,348) * lu(k,663) - lu(k,671) = lu(k,671) - lu(k,349) * lu(k,663) - lu(k,1423) = lu(k,1423) - lu(k,346) * lu(k,1412) - lu(k,1427) = lu(k,1427) - lu(k,347) * lu(k,1412) - lu(k,1434) = - lu(k,348) * lu(k,1412) - lu(k,1438) = lu(k,1438) - lu(k,349) * lu(k,1412) - lu(k,1484) = lu(k,1484) - lu(k,346) * lu(k,1450) - lu(k,1506) = lu(k,1506) - lu(k,347) * lu(k,1450) - lu(k,1513) = lu(k,1513) - lu(k,348) * lu(k,1450) - lu(k,1519) = lu(k,1519) - lu(k,349) * lu(k,1450) - lu(k,2079) = - lu(k,346) * lu(k,2042) - lu(k,2102) = lu(k,2102) - lu(k,347) * lu(k,2042) - lu(k,2109) = lu(k,2109) - lu(k,348) * lu(k,2042) - lu(k,2115) = lu(k,2115) - lu(k,349) * lu(k,2042) - lu(k,350) = 1._r8 / lu(k,350) - lu(k,351) = lu(k,351) * lu(k,350) - lu(k,352) = lu(k,352) * lu(k,350) - lu(k,353) = lu(k,353) * lu(k,350) - lu(k,354) = lu(k,354) * lu(k,350) - lu(k,355) = lu(k,355) * lu(k,350) - lu(k,356) = lu(k,356) * lu(k,350) - lu(k,1302) = lu(k,1302) - lu(k,351) * lu(k,1285) - lu(k,1303) = lu(k,1303) - lu(k,352) * lu(k,1285) - lu(k,1306) = lu(k,1306) - lu(k,353) * lu(k,1285) - lu(k,1308) = lu(k,1308) - lu(k,354) * lu(k,1285) - lu(k,1309) = - lu(k,355) * lu(k,1285) - lu(k,1312) = lu(k,1312) - lu(k,356) * lu(k,1285) - lu(k,1710) = lu(k,1710) - lu(k,351) * lu(k,1635) - lu(k,1714) = lu(k,1714) - lu(k,352) * lu(k,1635) - lu(k,1719) = lu(k,1719) - lu(k,353) * lu(k,1635) - lu(k,1722) = lu(k,1722) - lu(k,354) * lu(k,1635) - lu(k,1723) = lu(k,1723) - lu(k,355) * lu(k,1635) - lu(k,1726) = lu(k,1726) - lu(k,356) * lu(k,1635) - lu(k,1978) = lu(k,1978) - lu(k,351) * lu(k,1959) - lu(k,1982) = - lu(k,352) * lu(k,1959) - lu(k,1987) = lu(k,1987) - lu(k,353) * lu(k,1959) - lu(k,1990) = - lu(k,354) * lu(k,1959) - lu(k,1991) = lu(k,1991) - lu(k,355) * lu(k,1959) - lu(k,1994) = lu(k,1994) - lu(k,356) * lu(k,1959) - lu(k,357) = 1._r8 / lu(k,357) - lu(k,358) = lu(k,358) * lu(k,357) - lu(k,359) = lu(k,359) * lu(k,357) - lu(k,360) = lu(k,360) * lu(k,357) - lu(k,529) = lu(k,529) - lu(k,358) * lu(k,528) - lu(k,532) = - lu(k,359) * lu(k,528) - lu(k,533) = lu(k,533) - lu(k,360) * lu(k,528) - lu(k,1461) = lu(k,1461) - lu(k,358) * lu(k,1451) - lu(k,1511) = lu(k,1511) - lu(k,359) * lu(k,1451) - lu(k,1517) = lu(k,1517) - lu(k,360) * lu(k,1451) - lu(k,1656) = lu(k,1656) - lu(k,358) * lu(k,1636) - lu(k,1720) = lu(k,1720) - lu(k,359) * lu(k,1636) - lu(k,1726) = lu(k,1726) - lu(k,360) * lu(k,1636) - lu(k,1743) = lu(k,1743) - lu(k,358) * lu(k,1740) - lu(k,1782) = lu(k,1782) - lu(k,359) * lu(k,1740) - lu(k,1788) = lu(k,1788) - lu(k,360) * lu(k,1740) - lu(k,1965) = - lu(k,358) * lu(k,1960) - lu(k,1988) = lu(k,1988) - lu(k,359) * lu(k,1960) - lu(k,1994) = lu(k,1994) - lu(k,360) * lu(k,1960) - lu(k,2056) = lu(k,2056) - lu(k,358) * lu(k,2043) - lu(k,2107) = lu(k,2107) - lu(k,359) * lu(k,2043) - lu(k,2113) = lu(k,2113) - lu(k,360) * lu(k,2043) + lu(k,319) = 1._r8 / lu(k,319) + lu(k,320) = lu(k,320) * lu(k,319) + lu(k,321) = lu(k,321) * lu(k,319) + lu(k,322) = lu(k,322) * lu(k,319) + lu(k,323) = lu(k,323) * lu(k,319) + lu(k,696) = lu(k,696) - lu(k,320) * lu(k,695) + lu(k,697) = lu(k,697) - lu(k,321) * lu(k,695) + lu(k,698) = lu(k,698) - lu(k,322) * lu(k,695) + lu(k,699) = lu(k,699) - lu(k,323) * lu(k,695) + lu(k,1738) = lu(k,1738) - lu(k,320) * lu(k,1693) + lu(k,1773) = lu(k,1773) - lu(k,321) * lu(k,1693) + lu(k,1789) = lu(k,1789) - lu(k,322) * lu(k,1693) + lu(k,1799) = lu(k,1799) - lu(k,323) * lu(k,1693) + lu(k,2148) = lu(k,2148) - lu(k,320) * lu(k,2119) + lu(k,2173) = lu(k,2173) - lu(k,321) * lu(k,2119) + lu(k,2188) = lu(k,2188) - lu(k,322) * lu(k,2119) + lu(k,2197) = lu(k,2197) - lu(k,323) * lu(k,2119) + lu(k,324) = 1._r8 / lu(k,324) + lu(k,325) = lu(k,325) * lu(k,324) + lu(k,326) = lu(k,326) * lu(k,324) + lu(k,1327) = lu(k,1327) - lu(k,325) * lu(k,1314) + lu(k,1336) = lu(k,1336) - lu(k,326) * lu(k,1314) + lu(k,1417) = lu(k,1417) - lu(k,325) * lu(k,1408) + lu(k,1429) = lu(k,1429) - lu(k,326) * lu(k,1408) + lu(k,1780) = lu(k,1780) - lu(k,325) * lu(k,1694) + lu(k,1799) = lu(k,1799) - lu(k,326) * lu(k,1694) + lu(k,1887) = lu(k,1887) - lu(k,325) * lu(k,1862) + lu(k,1904) = lu(k,1904) - lu(k,326) * lu(k,1862) + lu(k,2052) = lu(k,2052) - lu(k,325) * lu(k,2002) + lu(k,2068) = lu(k,2068) - lu(k,326) * lu(k,2002) + lu(k,2234) = lu(k,2234) - lu(k,325) * lu(k,2212) + lu(k,2249) = lu(k,2249) - lu(k,326) * lu(k,2212) + lu(k,327) = 1._r8 / lu(k,327) + lu(k,328) = lu(k,328) * lu(k,327) + lu(k,329) = lu(k,329) * lu(k,327) + lu(k,330) = lu(k,330) * lu(k,327) + lu(k,331) = lu(k,331) * lu(k,327) + lu(k,725) = - lu(k,328) * lu(k,716) + lu(k,726) = lu(k,726) - lu(k,329) * lu(k,716) + lu(k,727) = - lu(k,330) * lu(k,716) + lu(k,729) = lu(k,729) - lu(k,331) * lu(k,716) + lu(k,769) = - lu(k,328) * lu(k,760) + lu(k,770) = lu(k,770) - lu(k,329) * lu(k,760) + lu(k,771) = - lu(k,330) * lu(k,760) + lu(k,775) = lu(k,775) - lu(k,331) * lu(k,760) + lu(k,2046) = lu(k,2046) - lu(k,328) * lu(k,2003) + lu(k,2055) = lu(k,2055) - lu(k,329) * lu(k,2003) + lu(k,2061) = lu(k,2061) - lu(k,330) * lu(k,2003) + lu(k,2075) = lu(k,2075) - lu(k,331) * lu(k,2003) + lu(k,332) = 1._r8 / lu(k,332) + lu(k,333) = lu(k,333) * lu(k,332) + lu(k,334) = lu(k,334) * lu(k,332) + lu(k,335) = lu(k,335) * lu(k,332) + lu(k,336) = lu(k,336) * lu(k,332) + lu(k,1473) = lu(k,1473) - lu(k,333) * lu(k,1471) + lu(k,1474) = lu(k,1474) - lu(k,334) * lu(k,1471) + lu(k,1478) = lu(k,1478) - lu(k,335) * lu(k,1471) + lu(k,1485) = lu(k,1485) - lu(k,336) * lu(k,1471) + lu(k,1558) = lu(k,1558) - lu(k,333) * lu(k,1555) + lu(k,1559) = lu(k,1559) - lu(k,334) * lu(k,1555) + lu(k,1564) = lu(k,1564) - lu(k,335) * lu(k,1555) + lu(k,1574) = lu(k,1574) - lu(k,336) * lu(k,1555) + lu(k,1583) = lu(k,1583) - lu(k,333) * lu(k,1581) + lu(k,1585) = lu(k,1585) - lu(k,334) * lu(k,1581) + lu(k,1590) = lu(k,1590) - lu(k,335) * lu(k,1581) + lu(k,1601) = lu(k,1601) - lu(k,336) * lu(k,1581) + lu(k,337) = 1._r8 / lu(k,337) + lu(k,338) = lu(k,338) * lu(k,337) + lu(k,339) = lu(k,339) * lu(k,337) + lu(k,340) = lu(k,340) * lu(k,337) + lu(k,341) = lu(k,341) * lu(k,337) + lu(k,452) = lu(k,452) - lu(k,338) * lu(k,451) + lu(k,453) = lu(k,453) - lu(k,339) * lu(k,451) + lu(k,454) = - lu(k,340) * lu(k,451) + lu(k,457) = lu(k,457) - lu(k,341) * lu(k,451) + lu(k,1711) = lu(k,1711) - lu(k,338) * lu(k,1695) + lu(k,1765) = lu(k,1765) - lu(k,339) * lu(k,1695) + lu(k,1799) = lu(k,1799) - lu(k,340) * lu(k,1695) + lu(k,1806) = lu(k,1806) - lu(k,341) * lu(k,1695) + lu(k,2132) = lu(k,2132) - lu(k,338) * lu(k,2120) + lu(k,2167) = lu(k,2167) - lu(k,339) * lu(k,2120) + lu(k,2197) = lu(k,2197) - lu(k,340) * lu(k,2120) + lu(k,2204) = lu(k,2204) - lu(k,341) * lu(k,2120) + lu(k,343) = 1._r8 / lu(k,343) + lu(k,344) = lu(k,344) * lu(k,343) + lu(k,345) = lu(k,345) * lu(k,343) + lu(k,346) = lu(k,346) * lu(k,343) + lu(k,347) = lu(k,347) * lu(k,343) + lu(k,433) = lu(k,433) - lu(k,344) * lu(k,432) + lu(k,434) = lu(k,434) - lu(k,345) * lu(k,432) + lu(k,435) = lu(k,435) - lu(k,346) * lu(k,432) + lu(k,438) = lu(k,438) - lu(k,347) * lu(k,432) + lu(k,1709) = lu(k,1709) - lu(k,344) * lu(k,1696) + lu(k,1720) = lu(k,1720) - lu(k,345) * lu(k,1696) + lu(k,1799) = lu(k,1799) - lu(k,346) * lu(k,1696) + lu(k,1806) = lu(k,1806) - lu(k,347) * lu(k,1696) + lu(k,2130) = lu(k,2130) - lu(k,344) * lu(k,2121) + lu(k,2140) = lu(k,2140) - lu(k,345) * lu(k,2121) + lu(k,2197) = lu(k,2197) - lu(k,346) * lu(k,2121) + lu(k,2204) = lu(k,2204) - lu(k,347) * lu(k,2121) + lu(k,348) = 1._r8 / lu(k,348) + lu(k,349) = lu(k,349) * lu(k,348) + lu(k,350) = lu(k,350) * lu(k,348) + lu(k,351) = lu(k,351) * lu(k,348) + lu(k,352) = lu(k,352) * lu(k,348) + lu(k,899) = lu(k,899) - lu(k,349) * lu(k,897) + lu(k,900) = lu(k,900) - lu(k,350) * lu(k,897) + lu(k,902) = lu(k,902) - lu(k,351) * lu(k,897) + lu(k,905) = lu(k,905) - lu(k,352) * lu(k,897) + lu(k,1754) = lu(k,1754) - lu(k,349) * lu(k,1697) + lu(k,1773) = lu(k,1773) - lu(k,350) * lu(k,1697) + lu(k,1799) = lu(k,1799) - lu(k,351) * lu(k,1697) + lu(k,1806) = lu(k,1806) - lu(k,352) * lu(k,1697) + lu(k,2162) = lu(k,2162) - lu(k,349) * lu(k,2122) + lu(k,2173) = lu(k,2173) - lu(k,350) * lu(k,2122) + lu(k,2197) = lu(k,2197) - lu(k,351) * lu(k,2122) + lu(k,2204) = lu(k,2204) - lu(k,352) * lu(k,2122) + lu(k,353) = 1._r8 / lu(k,353) + lu(k,354) = lu(k,354) * lu(k,353) + lu(k,355) = lu(k,355) * lu(k,353) + lu(k,356) = lu(k,356) * lu(k,353) + lu(k,357) = lu(k,357) * lu(k,353) + lu(k,358) = lu(k,358) * lu(k,353) + lu(k,359) = lu(k,359) * lu(k,353) + lu(k,360) = lu(k,360) * lu(k,353) + lu(k,1725) = lu(k,1725) - lu(k,354) * lu(k,1698) + lu(k,1768) = lu(k,1768) - lu(k,355) * lu(k,1698) + lu(k,1773) = lu(k,1773) - lu(k,356) * lu(k,1698) + lu(k,1799) = lu(k,1799) - lu(k,357) * lu(k,1698) + lu(k,1800) = lu(k,1800) - lu(k,358) * lu(k,1698) + lu(k,1801) = lu(k,1801) - lu(k,359) * lu(k,1698) + lu(k,1810) = lu(k,1810) - lu(k,360) * lu(k,1698) + lu(k,1864) = - lu(k,354) * lu(k,1863) + lu(k,1875) = lu(k,1875) - lu(k,355) * lu(k,1863) + lu(k,1880) = lu(k,1880) - lu(k,356) * lu(k,1863) + lu(k,1904) = lu(k,1904) - lu(k,357) * lu(k,1863) + lu(k,1905) = lu(k,1905) - lu(k,358) * lu(k,1863) + lu(k,1906) = lu(k,1906) - lu(k,359) * lu(k,1863) + lu(k,1915) = lu(k,1915) - lu(k,360) * lu(k,1863) lu(k,361) = 1._r8 / lu(k,361) lu(k,362) = lu(k,362) * lu(k,361) lu(k,363) = lu(k,363) * lu(k,361) @@ -1060,52 +847,24 @@ subroutine lu_fac08( avec_len, lu ) lu(k,365) = lu(k,365) * lu(k,361) lu(k,366) = lu(k,366) * lu(k,361) lu(k,367) = lu(k,367) * lu(k,361) - lu(k,1715) = lu(k,1715) - lu(k,362) * lu(k,1637) - lu(k,1719) = lu(k,1719) - lu(k,363) * lu(k,1637) - lu(k,1723) = lu(k,1723) - lu(k,364) * lu(k,1637) - lu(k,1726) = lu(k,1726) - lu(k,365) * lu(k,1637) - lu(k,1728) = lu(k,1728) - lu(k,366) * lu(k,1637) - lu(k,1730) = lu(k,1730) - lu(k,367) * lu(k,1637) - lu(k,1983) = lu(k,1983) - lu(k,362) * lu(k,1961) - lu(k,1987) = lu(k,1987) - lu(k,363) * lu(k,1961) - lu(k,1991) = lu(k,1991) - lu(k,364) * lu(k,1961) - lu(k,1994) = lu(k,1994) - lu(k,365) * lu(k,1961) - lu(k,1996) = lu(k,1996) - lu(k,366) * lu(k,1961) - lu(k,1998) = - lu(k,367) * lu(k,1961) - lu(k,2102) = lu(k,2102) - lu(k,362) * lu(k,2044) - lu(k,2106) = lu(k,2106) - lu(k,363) * lu(k,2044) - lu(k,2110) = lu(k,2110) - lu(k,364) * lu(k,2044) - lu(k,2113) = lu(k,2113) - lu(k,365) * lu(k,2044) - lu(k,2115) = lu(k,2115) - lu(k,366) * lu(k,2044) - lu(k,2117) = lu(k,2117) - lu(k,367) * lu(k,2044) - lu(k,368) = 1._r8 / lu(k,368) - lu(k,369) = lu(k,369) * lu(k,368) - lu(k,370) = lu(k,370) * lu(k,368) - lu(k,371) = lu(k,371) * lu(k,368) - lu(k,372) = lu(k,372) * lu(k,368) - lu(k,373) = lu(k,373) * lu(k,368) - lu(k,374) = lu(k,374) * lu(k,368) - lu(k,1004) = lu(k,1004) - lu(k,369) * lu(k,1001) - lu(k,1005) = lu(k,1005) - lu(k,370) * lu(k,1001) - lu(k,1008) = lu(k,1008) - lu(k,371) * lu(k,1001) - lu(k,1015) = - lu(k,372) * lu(k,1001) - lu(k,1016) = lu(k,1016) - lu(k,373) * lu(k,1001) - lu(k,1021) = lu(k,1021) - lu(k,374) * lu(k,1001) - lu(k,1685) = lu(k,1685) - lu(k,369) * lu(k,1638) - lu(k,1687) = lu(k,1687) - lu(k,370) * lu(k,1638) - lu(k,1695) = lu(k,1695) - lu(k,371) * lu(k,1638) - lu(k,1719) = lu(k,1719) - lu(k,372) * lu(k,1638) - lu(k,1722) = lu(k,1722) - lu(k,373) * lu(k,1638) - lu(k,1728) = lu(k,1728) - lu(k,374) * lu(k,1638) - lu(k,2077) = lu(k,2077) - lu(k,369) * lu(k,2045) - lu(k,2078) = lu(k,2078) - lu(k,370) * lu(k,2045) - lu(k,2083) = lu(k,2083) - lu(k,371) * lu(k,2045) - lu(k,2106) = lu(k,2106) - lu(k,372) * lu(k,2045) - lu(k,2109) = lu(k,2109) - lu(k,373) * lu(k,2045) - lu(k,2115) = lu(k,2115) - lu(k,374) * lu(k,2045) + lu(k,368) = lu(k,368) * lu(k,361) + lu(k,1740) = lu(k,1740) - lu(k,362) * lu(k,1699) + lu(k,1759) = lu(k,1759) - lu(k,363) * lu(k,1699) + lu(k,1774) = lu(k,1774) - lu(k,364) * lu(k,1699) + lu(k,1792) = lu(k,1792) - lu(k,365) * lu(k,1699) + lu(k,1799) = lu(k,1799) - lu(k,366) * lu(k,1699) + lu(k,1805) = lu(k,1805) - lu(k,367) * lu(k,1699) + lu(k,1809) = lu(k,1809) - lu(k,368) * lu(k,1699) + lu(k,2296) = - lu(k,362) * lu(k,2290) + lu(k,2304) = - lu(k,363) * lu(k,2290) + lu(k,2307) = lu(k,2307) - lu(k,364) * lu(k,2290) + lu(k,2310) = lu(k,2310) - lu(k,365) * lu(k,2290) + lu(k,2317) = lu(k,2317) - lu(k,366) * lu(k,2290) + lu(k,2323) = lu(k,2323) - lu(k,367) * lu(k,2290) + lu(k,2327) = lu(k,2327) - lu(k,368) * lu(k,2290) end do - end subroutine lu_fac08 - subroutine lu_fac09( avec_len, lu ) + 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 @@ -1119,186 +878,136 @@ subroutine lu_fac09( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len + 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,1774) = lu(k,1774) - lu(k,370) * lu(k,1700) + lu(k,1793) = lu(k,1793) - lu(k,371) * lu(k,1700) + lu(k,1799) = lu(k,1799) - lu(k,372) * lu(k,1700) + lu(k,1802) = lu(k,1802) - lu(k,373) * lu(k,1700) + lu(k,1806) = lu(k,1806) - lu(k,374) * lu(k,1700) + lu(k,1807) = lu(k,1807) - lu(k,375) * lu(k,1700) + lu(k,1812) = lu(k,1812) - lu(k,376) * lu(k,1700) + lu(k,1937) = lu(k,1937) - lu(k,370) * lu(k,1922) + lu(k,1944) = lu(k,1944) - lu(k,371) * lu(k,1922) + lu(k,1950) = lu(k,1950) - lu(k,372) * lu(k,1922) + lu(k,1953) = lu(k,1953) - lu(k,373) * lu(k,1922) + lu(k,1957) = lu(k,1957) - lu(k,374) * lu(k,1922) + lu(k,1958) = lu(k,1958) - lu(k,375) * lu(k,1922) + lu(k,1963) = lu(k,1963) - lu(k,376) * lu(k,1922) 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,1464) = lu(k,1464) - lu(k,378) * lu(k,1452) - lu(k,1477) = lu(k,1477) - lu(k,379) * lu(k,1452) - lu(k,1507) = lu(k,1507) - lu(k,380) * lu(k,1452) - lu(k,1510) = lu(k,1510) - lu(k,381) * lu(k,1452) - lu(k,1517) = lu(k,1517) - lu(k,382) * lu(k,1452) - lu(k,1519) = lu(k,1519) - lu(k,383) * lu(k,1452) - lu(k,1663) = lu(k,1663) - lu(k,378) * lu(k,1639) - lu(k,1678) = lu(k,1678) - lu(k,379) * lu(k,1639) - lu(k,1716) = lu(k,1716) - lu(k,380) * lu(k,1639) - lu(k,1719) = lu(k,1719) - lu(k,381) * lu(k,1639) - lu(k,1726) = lu(k,1726) - lu(k,382) * lu(k,1639) - lu(k,1728) = lu(k,1728) - lu(k,383) * lu(k,1639) - lu(k,2061) = lu(k,2061) - lu(k,378) * lu(k,2046) - lu(k,2073) = lu(k,2073) - lu(k,379) * lu(k,2046) - lu(k,2103) = lu(k,2103) - lu(k,380) * lu(k,2046) - lu(k,2106) = lu(k,2106) - lu(k,381) * lu(k,2046) - lu(k,2113) = lu(k,2113) - lu(k,382) * lu(k,2046) - lu(k,2115) = lu(k,2115) - lu(k,383) * lu(k,2046) - lu(k,384) = 1._r8 / lu(k,384) - lu(k,385) = lu(k,385) * lu(k,384) - lu(k,386) = lu(k,386) * lu(k,384) - lu(k,387) = lu(k,387) * lu(k,384) - lu(k,388) = lu(k,388) * lu(k,384) - lu(k,389) = lu(k,389) * lu(k,384) - lu(k,390) = lu(k,390) * lu(k,384) - lu(k,740) = - lu(k,385) * lu(k,739) - lu(k,741) = lu(k,741) - lu(k,386) * lu(k,739) - lu(k,742) = lu(k,742) - lu(k,387) * lu(k,739) - lu(k,744) = lu(k,744) - lu(k,388) * lu(k,739) - lu(k,746) = lu(k,746) - lu(k,389) * lu(k,739) - lu(k,750) = lu(k,750) - lu(k,390) * lu(k,739) - lu(k,1415) = lu(k,1415) - lu(k,385) * lu(k,1413) - lu(k,1418) = lu(k,1418) - lu(k,386) * lu(k,1413) - lu(k,1419) = lu(k,1419) - lu(k,387) * lu(k,1413) - lu(k,1421) = lu(k,1421) - lu(k,388) * lu(k,1413) - lu(k,1427) = lu(k,1427) - lu(k,389) * lu(k,1413) - lu(k,1433) = lu(k,1433) - lu(k,390) * lu(k,1413) - lu(k,1800) = lu(k,1800) - lu(k,385) * lu(k,1796) - lu(k,1804) = - lu(k,386) * lu(k,1796) - lu(k,1805) = lu(k,1805) - lu(k,387) * lu(k,1796) - lu(k,1807) = lu(k,1807) - lu(k,388) * lu(k,1796) - lu(k,1818) = lu(k,1818) - lu(k,389) * lu(k,1796) - lu(k,1824) = lu(k,1824) - lu(k,390) * lu(k,1796) - lu(k,392) = 1._r8 / lu(k,392) - lu(k,393) = lu(k,393) * lu(k,392) - lu(k,394) = lu(k,394) * lu(k,392) - lu(k,395) = lu(k,395) * lu(k,392) - lu(k,396) = lu(k,396) * lu(k,392) - lu(k,397) = lu(k,397) * lu(k,392) - lu(k,398) = lu(k,398) * lu(k,392) - lu(k,1477) = lu(k,1477) - lu(k,393) * lu(k,1453) - lu(k,1497) = lu(k,1497) - lu(k,394) * lu(k,1453) - lu(k,1507) = lu(k,1507) - lu(k,395) * lu(k,1453) - lu(k,1510) = lu(k,1510) - lu(k,396) * lu(k,1453) - lu(k,1517) = lu(k,1517) - lu(k,397) * lu(k,1453) - lu(k,1519) = lu(k,1519) - lu(k,398) * lu(k,1453) - lu(k,1678) = lu(k,1678) - lu(k,393) * lu(k,1640) - lu(k,1704) = lu(k,1704) - lu(k,394) * lu(k,1640) - lu(k,1716) = lu(k,1716) - lu(k,395) * lu(k,1640) - lu(k,1719) = lu(k,1719) - lu(k,396) * lu(k,1640) - lu(k,1726) = lu(k,1726) - lu(k,397) * lu(k,1640) - lu(k,1728) = lu(k,1728) - lu(k,398) * lu(k,1640) - lu(k,2073) = lu(k,2073) - lu(k,393) * lu(k,2047) - lu(k,2092) = lu(k,2092) - lu(k,394) * lu(k,2047) - lu(k,2103) = lu(k,2103) - lu(k,395) * lu(k,2047) - lu(k,2106) = lu(k,2106) - lu(k,396) * lu(k,2047) - lu(k,2113) = lu(k,2113) - lu(k,397) * lu(k,2047) - lu(k,2115) = lu(k,2115) - lu(k,398) * lu(k,2047) - lu(k,400) = 1._r8 / lu(k,400) - lu(k,401) = lu(k,401) * lu(k,400) - lu(k,402) = lu(k,402) * lu(k,400) - lu(k,403) = lu(k,403) * lu(k,400) - lu(k,404) = lu(k,404) * lu(k,400) - lu(k,405) = lu(k,405) * lu(k,400) - lu(k,1461) = lu(k,1461) - lu(k,401) * lu(k,1454) - lu(k,1507) = lu(k,1507) - lu(k,402) * lu(k,1454) - lu(k,1510) = lu(k,1510) - lu(k,403) * lu(k,1454) - lu(k,1517) = lu(k,1517) - lu(k,404) * lu(k,1454) - lu(k,1519) = lu(k,1519) - lu(k,405) * lu(k,1454) - lu(k,1656) = lu(k,1656) - lu(k,401) * lu(k,1641) - lu(k,1716) = lu(k,1716) - lu(k,402) * lu(k,1641) - lu(k,1719) = lu(k,1719) - lu(k,403) * lu(k,1641) - lu(k,1726) = lu(k,1726) - lu(k,404) * lu(k,1641) - lu(k,1728) = lu(k,1728) - lu(k,405) * lu(k,1641) - lu(k,1965) = lu(k,1965) - lu(k,401) * lu(k,1962) - lu(k,1984) = lu(k,1984) - lu(k,402) * lu(k,1962) - lu(k,1987) = lu(k,1987) - lu(k,403) * lu(k,1962) - lu(k,1994) = lu(k,1994) - lu(k,404) * lu(k,1962) - lu(k,1996) = lu(k,1996) - lu(k,405) * lu(k,1962) - lu(k,2056) = lu(k,2056) - lu(k,401) * lu(k,2048) - lu(k,2103) = lu(k,2103) - lu(k,402) * lu(k,2048) - lu(k,2106) = lu(k,2106) - lu(k,403) * lu(k,2048) - lu(k,2113) = lu(k,2113) - lu(k,404) * lu(k,2048) - lu(k,2115) = lu(k,2115) - lu(k,405) * lu(k,2048) - lu(k,406) = 1._r8 / lu(k,406) - lu(k,407) = lu(k,407) * lu(k,406) - lu(k,408) = lu(k,408) * lu(k,406) - lu(k,409) = lu(k,409) * lu(k,406) - lu(k,410) = lu(k,410) * lu(k,406) - lu(k,411) = lu(k,411) * lu(k,406) - lu(k,1272) = lu(k,1272) - lu(k,407) * lu(k,1266) - lu(k,1273) = lu(k,1273) - lu(k,408) * lu(k,1266) - lu(k,1275) = lu(k,1275) - lu(k,409) * lu(k,1266) - lu(k,1277) = lu(k,1277) - lu(k,410) * lu(k,1266) - lu(k,1283) = - lu(k,411) * lu(k,1266) - lu(k,1302) = lu(k,1302) - lu(k,407) * lu(k,1286) - lu(k,1303) = lu(k,1303) - lu(k,408) * lu(k,1286) - lu(k,1306) = lu(k,1306) - lu(k,409) * lu(k,1286) - lu(k,1308) = lu(k,1308) - lu(k,410) * lu(k,1286) - lu(k,1314) = - lu(k,411) * lu(k,1286) - lu(k,1710) = lu(k,1710) - lu(k,407) * lu(k,1642) - lu(k,1714) = lu(k,1714) - lu(k,408) * lu(k,1642) - lu(k,1719) = lu(k,1719) - lu(k,409) * lu(k,1642) - lu(k,1722) = lu(k,1722) - lu(k,410) * lu(k,1642) - lu(k,1730) = lu(k,1730) - lu(k,411) * lu(k,1642) - lu(k,2098) = lu(k,2098) - lu(k,407) * lu(k,2049) - lu(k,2101) = lu(k,2101) - lu(k,408) * lu(k,2049) - lu(k,2106) = lu(k,2106) - lu(k,409) * lu(k,2049) - lu(k,2109) = lu(k,2109) - lu(k,410) * lu(k,2049) - lu(k,2117) = lu(k,2117) - lu(k,411) * lu(k,2049) - lu(k,412) = 1._r8 / lu(k,412) - lu(k,413) = lu(k,413) * lu(k,412) - lu(k,414) = lu(k,414) * lu(k,412) - lu(k,415) = lu(k,415) * lu(k,412) - lu(k,416) = lu(k,416) * lu(k,412) - lu(k,571) = lu(k,571) - lu(k,413) * lu(k,565) - lu(k,573) = lu(k,573) - lu(k,414) * lu(k,565) - lu(k,574) = - lu(k,415) * lu(k,565) - lu(k,575) = - lu(k,416) * lu(k,565) - lu(k,692) = lu(k,692) - lu(k,413) * lu(k,689) - lu(k,693) = - lu(k,414) * lu(k,689) - lu(k,694) = - lu(k,415) * lu(k,689) - lu(k,695) = - lu(k,416) * lu(k,689) - lu(k,702) = lu(k,702) - lu(k,413) * lu(k,697) - lu(k,704) = - lu(k,414) * lu(k,697) - lu(k,705) = - lu(k,415) * lu(k,697) - lu(k,706) = lu(k,706) - lu(k,416) * lu(k,697) - lu(k,1421) = lu(k,1421) - lu(k,413) * lu(k,1414) - lu(k,1427) = lu(k,1427) - lu(k,414) * lu(k,1414) - lu(k,1428) = lu(k,1428) - lu(k,415) * lu(k,1414) - lu(k,1430) = lu(k,1430) - lu(k,416) * lu(k,1414) - lu(k,1807) = lu(k,1807) - lu(k,413) * lu(k,1797) - lu(k,1818) = lu(k,1818) - lu(k,414) * lu(k,1797) - lu(k,1819) = lu(k,1819) - lu(k,415) * lu(k,1797) - lu(k,1821) = - lu(k,416) * lu(k,1797) - lu(k,417) = 1._r8 / lu(k,417) - lu(k,418) = lu(k,418) * lu(k,417) - lu(k,419) = lu(k,419) * lu(k,417) - lu(k,420) = lu(k,420) * lu(k,417) - lu(k,421) = lu(k,421) * lu(k,417) - lu(k,537) = - lu(k,418) * lu(k,535) - lu(k,538) = - lu(k,419) * lu(k,535) - lu(k,541) = - lu(k,420) * lu(k,535) - lu(k,542) = lu(k,542) - lu(k,421) * lu(k,535) - lu(k,548) = - lu(k,418) * lu(k,546) - lu(k,549) = - lu(k,419) * lu(k,546) - lu(k,553) = - lu(k,420) * lu(k,546) - lu(k,554) = lu(k,554) - lu(k,421) * lu(k,546) - lu(k,878) = - lu(k,418) * lu(k,875) - lu(k,879) = - lu(k,419) * lu(k,875) - lu(k,883) = - lu(k,420) * lu(k,875) - lu(k,887) = - lu(k,421) * lu(k,875) - lu(k,1463) = lu(k,1463) - lu(k,418) * lu(k,1455) - lu(k,1479) = lu(k,1479) - lu(k,419) * lu(k,1455) - lu(k,1503) = lu(k,1503) - lu(k,420) * lu(k,1455) - lu(k,1510) = lu(k,1510) - lu(k,421) * lu(k,1455) - lu(k,1659) = lu(k,1659) - lu(k,418) * lu(k,1643) - lu(k,1681) = lu(k,1681) - lu(k,419) * lu(k,1643) - lu(k,1710) = lu(k,1710) - lu(k,420) * lu(k,1643) - lu(k,1719) = lu(k,1719) - lu(k,421) * lu(k,1643) + lu(k,1246) = - lu(k,378) * lu(k,1242) + lu(k,1249) = - lu(k,379) * lu(k,1242) + lu(k,1257) = - lu(k,380) * lu(k,1242) + lu(k,1260) = - lu(k,381) * lu(k,1242) + lu(k,1262) = lu(k,1262) - lu(k,382) * lu(k,1242) + lu(k,1752) = lu(k,1752) - lu(k,378) * lu(k,1701) + lu(k,1775) = lu(k,1775) - lu(k,379) * lu(k,1701) + lu(k,1799) = lu(k,1799) - lu(k,380) * lu(k,1701) + lu(k,1803) = lu(k,1803) - lu(k,381) * lu(k,1701) + lu(k,1806) = lu(k,1806) - lu(k,382) * lu(k,1701) + lu(k,2218) = - lu(k,378) * lu(k,2213) + lu(k,2230) = lu(k,2230) - lu(k,379) * lu(k,2213) + lu(k,2249) = lu(k,2249) - lu(k,380) * lu(k,2213) + lu(k,2253) = - lu(k,381) * lu(k,2213) + lu(k,2256) = lu(k,2256) - lu(k,382) * lu(k,2213) + lu(k,383) = 1._r8 / lu(k,383) + lu(k,384) = lu(k,384) * lu(k,383) + lu(k,385) = lu(k,385) * lu(k,383) + lu(k,386) = lu(k,386) * lu(k,383) + lu(k,387) = lu(k,387) * lu(k,383) + lu(k,388) = lu(k,388) * lu(k,383) + lu(k,990) = - lu(k,384) * lu(k,986) + lu(k,996) = lu(k,996) - lu(k,385) * lu(k,986) + lu(k,998) = - lu(k,386) * lu(k,986) + lu(k,999) = lu(k,999) - lu(k,387) * lu(k,986) + lu(k,1003) = lu(k,1003) - lu(k,388) * lu(k,986) + lu(k,1018) = - lu(k,384) * lu(k,1014) + lu(k,1024) = lu(k,1024) - lu(k,385) * lu(k,1014) + lu(k,1026) = - lu(k,386) * lu(k,1014) + lu(k,1027) = lu(k,1027) - lu(k,387) * lu(k,1014) + lu(k,1031) = lu(k,1031) - lu(k,388) * lu(k,1014) + lu(k,2378) = - lu(k,384) * lu(k,2365) + lu(k,2386) = lu(k,2386) - lu(k,385) * lu(k,2365) + lu(k,2393) = lu(k,2393) - lu(k,386) * lu(k,2365) + lu(k,2399) = lu(k,2399) - lu(k,387) * lu(k,2365) + lu(k,2414) = lu(k,2414) - lu(k,388) * lu(k,2365) + 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,1799) = lu(k,1799) - lu(k,390) * lu(k,1702) + lu(k,1805) = lu(k,1805) - lu(k,391) * lu(k,1702) + lu(k,1807) = lu(k,1807) - lu(k,392) * lu(k,1702) + lu(k,1810) = lu(k,1810) - lu(k,393) * lu(k,1702) + lu(k,1812) = lu(k,1812) - lu(k,394) * lu(k,1702) + lu(k,2197) = lu(k,2197) - lu(k,390) * lu(k,2123) + lu(k,2203) = lu(k,2203) - lu(k,391) * lu(k,2123) + lu(k,2205) = lu(k,2205) - lu(k,392) * lu(k,2123) + lu(k,2208) = lu(k,2208) - lu(k,393) * lu(k,2123) + lu(k,2210) = lu(k,2210) - lu(k,394) * lu(k,2123) + lu(k,2249) = lu(k,2249) - lu(k,390) * lu(k,2214) + lu(k,2255) = - lu(k,391) * lu(k,2214) + lu(k,2257) = lu(k,2257) - lu(k,392) * lu(k,2214) + lu(k,2260) = lu(k,2260) - lu(k,393) * lu(k,2214) + lu(k,2262) = - lu(k,394) * lu(k,2214) + lu(k,395) = 1._r8 / lu(k,395) + lu(k,396) = lu(k,396) * lu(k,395) + lu(k,397) = lu(k,397) * lu(k,395) + lu(k,398) = lu(k,398) * lu(k,395) + lu(k,399) = lu(k,399) * lu(k,395) + lu(k,400) = lu(k,400) * lu(k,395) + lu(k,1087) = lu(k,1087) - lu(k,396) * lu(k,1084) + lu(k,1088) = lu(k,1088) - lu(k,397) * lu(k,1084) + lu(k,1092) = - lu(k,398) * lu(k,1084) + lu(k,1093) = lu(k,1093) - lu(k,399) * lu(k,1084) + lu(k,1095) = - lu(k,400) * lu(k,1084) + lu(k,1767) = lu(k,1767) - lu(k,396) * lu(k,1703) + lu(k,1769) = lu(k,1769) - lu(k,397) * lu(k,1703) + lu(k,1799) = lu(k,1799) - lu(k,398) * lu(k,1703) + lu(k,1800) = lu(k,1800) - lu(k,399) * lu(k,1703) + lu(k,1803) = lu(k,1803) - lu(k,400) * lu(k,1703) + lu(k,2169) = - lu(k,396) * lu(k,2124) + lu(k,2171) = lu(k,2171) - lu(k,397) * lu(k,2124) + lu(k,2197) = lu(k,2197) - lu(k,398) * lu(k,2124) + lu(k,2198) = lu(k,2198) - lu(k,399) * lu(k,2124) + lu(k,2201) = - lu(k,400) * lu(k,2124) + 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,485) = lu(k,485) - lu(k,402) * lu(k,484) + lu(k,486) = lu(k,486) - lu(k,403) * lu(k,484) + lu(k,488) = lu(k,488) - lu(k,404) * lu(k,484) + lu(k,489) = - lu(k,405) * lu(k,484) + lu(k,492) = lu(k,492) - lu(k,406) * lu(k,484) + lu(k,1712) = lu(k,1712) - lu(k,402) * lu(k,1704) + lu(k,1716) = lu(k,1716) - lu(k,403) * lu(k,1704) + lu(k,1765) = lu(k,1765) - lu(k,404) * lu(k,1704) + lu(k,1799) = lu(k,1799) - lu(k,405) * lu(k,1704) + lu(k,1806) = lu(k,1806) - lu(k,406) * lu(k,1704) + lu(k,2133) = - lu(k,402) * lu(k,2125) + lu(k,2137) = lu(k,2137) - lu(k,403) * lu(k,2125) + lu(k,2167) = lu(k,2167) - lu(k,404) * lu(k,2125) + lu(k,2197) = lu(k,2197) - lu(k,405) * lu(k,2125) + lu(k,2204) = lu(k,2204) - lu(k,406) * lu(k,2125) end do - end subroutine lu_fac09 - subroutine lu_fac10( avec_len, lu ) + 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 @@ -1312,150 +1021,156 @@ subroutine lu_fac10( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - 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,428) = lu(k,428) * lu(k,422) - lu(k,429) = lu(k,429) * lu(k,422) - lu(k,1194) = - lu(k,423) * lu(k,1190) - lu(k,1197) = lu(k,1197) - lu(k,424) * lu(k,1190) - lu(k,1198) = - lu(k,425) * lu(k,1190) - lu(k,1199) = lu(k,1199) - lu(k,426) * lu(k,1190) - lu(k,1213) = lu(k,1213) - lu(k,427) * lu(k,1190) - lu(k,1218) = - lu(k,428) * lu(k,1190) - lu(k,1220) = lu(k,1220) - lu(k,429) * lu(k,1190) - lu(k,1476) = - lu(k,423) * lu(k,1456) - lu(k,1484) = lu(k,1484) - lu(k,424) * lu(k,1456) - lu(k,1485) = lu(k,1485) - lu(k,425) * lu(k,1456) - lu(k,1487) = lu(k,1487) - lu(k,426) * lu(k,1456) - lu(k,1510) = lu(k,1510) - lu(k,427) * lu(k,1456) - lu(k,1516) = lu(k,1516) - lu(k,428) * lu(k,1456) - lu(k,1519) = lu(k,1519) - lu(k,429) * lu(k,1456) - lu(k,1676) = lu(k,1676) - lu(k,423) * lu(k,1644) - lu(k,1690) = lu(k,1690) - lu(k,424) * lu(k,1644) - lu(k,1691) = lu(k,1691) - lu(k,425) * lu(k,1644) - lu(k,1693) = lu(k,1693) - lu(k,426) * lu(k,1644) - lu(k,1719) = lu(k,1719) - lu(k,427) * lu(k,1644) - lu(k,1725) = lu(k,1725) - lu(k,428) * lu(k,1644) - lu(k,1728) = lu(k,1728) - lu(k,429) * lu(k,1644) - lu(k,430) = 1._r8 / lu(k,430) - lu(k,431) = lu(k,431) * lu(k,430) - lu(k,432) = lu(k,432) * lu(k,430) - lu(k,433) = lu(k,433) * lu(k,430) - lu(k,434) = lu(k,434) * lu(k,430) - lu(k,435) = lu(k,435) * lu(k,430) - lu(k,436) = lu(k,436) * lu(k,430) - lu(k,437) = lu(k,437) * lu(k,430) - lu(k,717) = lu(k,717) - lu(k,431) * lu(k,716) - lu(k,718) = - lu(k,432) * lu(k,716) - lu(k,719) = lu(k,719) - lu(k,433) * lu(k,716) - lu(k,722) = - lu(k,434) * lu(k,716) - lu(k,723) = lu(k,723) - lu(k,435) * lu(k,716) - lu(k,725) = lu(k,725) - lu(k,436) * lu(k,716) - lu(k,726) = - lu(k,437) * lu(k,716) - lu(k,1671) = lu(k,1671) - lu(k,431) * lu(k,1645) - lu(k,1693) = lu(k,1693) - lu(k,432) * lu(k,1645) - lu(k,1699) = lu(k,1699) - lu(k,433) * lu(k,1645) - lu(k,1719) = lu(k,1719) - lu(k,434) * lu(k,1645) - lu(k,1722) = lu(k,1722) - lu(k,435) * lu(k,1645) - lu(k,1728) = lu(k,1728) - lu(k,436) * lu(k,1645) - lu(k,1730) = lu(k,1730) - lu(k,437) * lu(k,1645) - lu(k,2068) = lu(k,2068) - lu(k,431) * lu(k,2050) - lu(k,2081) = - lu(k,432) * lu(k,2050) - lu(k,2087) = lu(k,2087) - lu(k,433) * lu(k,2050) - lu(k,2106) = lu(k,2106) - lu(k,434) * lu(k,2050) - lu(k,2109) = lu(k,2109) - lu(k,435) * lu(k,2050) - lu(k,2115) = lu(k,2115) - lu(k,436) * lu(k,2050) - lu(k,2117) = lu(k,2117) - lu(k,437) * lu(k,2050) - lu(k,438) = 1._r8 / lu(k,438) - lu(k,439) = lu(k,439) * lu(k,438) - lu(k,440) = lu(k,440) * lu(k,438) - lu(k,441) = lu(k,441) * lu(k,438) - lu(k,442) = lu(k,442) * lu(k,438) - lu(k,443) = lu(k,443) * lu(k,438) - lu(k,444) = lu(k,444) * lu(k,438) - lu(k,445) = lu(k,445) * lu(k,438) - lu(k,1803) = lu(k,1803) - lu(k,439) * lu(k,1798) - lu(k,1816) = lu(k,1816) - lu(k,440) * lu(k,1798) - lu(k,1824) = lu(k,1824) - lu(k,441) * lu(k,1798) - lu(k,1826) = lu(k,1826) - lu(k,442) * lu(k,1798) - lu(k,1828) = - lu(k,443) * lu(k,1798) - lu(k,1829) = lu(k,1829) - lu(k,444) * lu(k,1798) - lu(k,1830) = lu(k,1830) - lu(k,445) * lu(k,1798) - lu(k,1968) = - lu(k,439) * lu(k,1963) - lu(k,1981) = - lu(k,440) * lu(k,1963) - lu(k,1989) = lu(k,1989) - lu(k,441) * lu(k,1963) - lu(k,1991) = lu(k,1991) - lu(k,442) * lu(k,1963) - lu(k,1993) = lu(k,1993) - lu(k,443) * lu(k,1963) - lu(k,1994) = lu(k,1994) - lu(k,444) * lu(k,1963) - lu(k,1995) = lu(k,1995) - lu(k,445) * lu(k,1963) - lu(k,2002) = lu(k,2002) - lu(k,439) * lu(k,2001) - lu(k,2006) = lu(k,2006) - lu(k,440) * lu(k,2001) - lu(k,2013) = lu(k,2013) - lu(k,441) * lu(k,2001) - lu(k,2015) = - lu(k,442) * lu(k,2001) - lu(k,2017) = - lu(k,443) * lu(k,2001) - lu(k,2018) = lu(k,2018) - lu(k,444) * lu(k,2001) - lu(k,2019) = lu(k,2019) - lu(k,445) * lu(k,2001) - lu(k,446) = 1._r8 / lu(k,446) - lu(k,447) = lu(k,447) * lu(k,446) - lu(k,448) = lu(k,448) * lu(k,446) - lu(k,449) = lu(k,449) * lu(k,446) - lu(k,949) = lu(k,949) - lu(k,447) * lu(k,939) - lu(k,952) = lu(k,952) - lu(k,448) * lu(k,939) - lu(k,958) = - lu(k,449) * lu(k,939) - lu(k,1273) = lu(k,1273) - lu(k,447) * lu(k,1267) - lu(k,1275) = lu(k,1275) - lu(k,448) * lu(k,1267) - lu(k,1283) = lu(k,1283) - lu(k,449) * lu(k,1267) - lu(k,1303) = lu(k,1303) - lu(k,447) * lu(k,1287) - lu(k,1306) = lu(k,1306) - lu(k,448) * lu(k,1287) - lu(k,1314) = lu(k,1314) - lu(k,449) * lu(k,1287) - lu(k,1396) = lu(k,1396) - lu(k,447) * lu(k,1367) - lu(k,1400) = lu(k,1400) - lu(k,448) * lu(k,1367) - lu(k,1409) = lu(k,1409) - lu(k,449) * lu(k,1367) - lu(k,1714) = lu(k,1714) - lu(k,447) * lu(k,1646) - lu(k,1719) = lu(k,1719) - lu(k,448) * lu(k,1646) - lu(k,1730) = lu(k,1730) - lu(k,449) * lu(k,1646) - lu(k,1776) = lu(k,1776) - lu(k,447) * lu(k,1741) - lu(k,1781) = lu(k,1781) - lu(k,448) * lu(k,1741) - lu(k,1792) = - lu(k,449) * lu(k,1741) - lu(k,2101) = lu(k,2101) - lu(k,447) * lu(k,2051) - lu(k,2106) = lu(k,2106) - lu(k,448) * lu(k,2051) - lu(k,2117) = lu(k,2117) - lu(k,449) * lu(k,2051) - lu(k,450) = 1._r8 / lu(k,450) - lu(k,451) = lu(k,451) * lu(k,450) - lu(k,452) = lu(k,452) * lu(k,450) - lu(k,453) = lu(k,453) * lu(k,450) - lu(k,454) = lu(k,454) * lu(k,450) - lu(k,455) = lu(k,455) * lu(k,450) - lu(k,456) = lu(k,456) * lu(k,450) - lu(k,457) = lu(k,457) * lu(k,450) - lu(k,1527) = - lu(k,451) * lu(k,1525) - lu(k,1528) = lu(k,1528) - lu(k,452) * lu(k,1525) - lu(k,1534) = lu(k,1534) - lu(k,453) * lu(k,1525) - lu(k,1545) = lu(k,1545) - lu(k,454) * lu(k,1525) - lu(k,1546) = lu(k,1546) - lu(k,455) * lu(k,1525) - lu(k,1548) = lu(k,1548) - lu(k,456) * lu(k,1525) - lu(k,1554) = lu(k,1554) - lu(k,457) * lu(k,1525) - lu(k,1667) = lu(k,1667) - lu(k,451) * lu(k,1647) - lu(k,1670) = lu(k,1670) - lu(k,452) * lu(k,1647) - lu(k,1694) = lu(k,1694) - lu(k,453) * lu(k,1647) - lu(k,1719) = lu(k,1719) - lu(k,454) * lu(k,1647) - lu(k,1720) = lu(k,1720) - lu(k,455) * lu(k,1647) - lu(k,1722) = lu(k,1722) - lu(k,456) * lu(k,1647) - lu(k,1728) = lu(k,1728) - lu(k,457) * lu(k,1647) - lu(k,1745) = - lu(k,451) * lu(k,1742) - lu(k,1746) = lu(k,1746) - lu(k,452) * lu(k,1742) - lu(k,1759) = lu(k,1759) - lu(k,453) * lu(k,1742) - lu(k,1781) = lu(k,1781) - lu(k,454) * lu(k,1742) - lu(k,1782) = lu(k,1782) - lu(k,455) * lu(k,1742) - lu(k,1784) = lu(k,1784) - lu(k,456) * lu(k,1742) - lu(k,1790) = lu(k,1790) - lu(k,457) * lu(k,1742) + lu(k,407) = 1._r8 / lu(k,407) + lu(k,408) = lu(k,408) * lu(k,407) + lu(k,409) = lu(k,409) * lu(k,407) + lu(k,410) = lu(k,410) * lu(k,407) + lu(k,411) = lu(k,411) * lu(k,407) + lu(k,412) = lu(k,412) * lu(k,407) + lu(k,1215) = lu(k,1215) - lu(k,408) * lu(k,1212) + lu(k,1217) = lu(k,1217) - lu(k,409) * lu(k,1212) + lu(k,1218) = lu(k,1218) - lu(k,410) * lu(k,1212) + lu(k,1223) = lu(k,1223) - lu(k,411) * lu(k,1212) + lu(k,1224) = - lu(k,412) * lu(k,1212) + lu(k,1779) = lu(k,1779) - lu(k,408) * lu(k,1705) + lu(k,1789) = lu(k,1789) - lu(k,409) * lu(k,1705) + lu(k,1799) = lu(k,1799) - lu(k,410) * lu(k,1705) + lu(k,1810) = lu(k,1810) - lu(k,411) * lu(k,1705) + lu(k,1812) = lu(k,1812) - lu(k,412) * lu(k,1705) + lu(k,2178) = lu(k,2178) - lu(k,408) * lu(k,2126) + lu(k,2188) = lu(k,2188) - lu(k,409) * lu(k,2126) + lu(k,2197) = lu(k,2197) - lu(k,410) * lu(k,2126) + lu(k,2208) = lu(k,2208) - lu(k,411) * lu(k,2126) + lu(k,2210) = lu(k,2210) - lu(k,412) * lu(k,2126) + lu(k,413) = 1._r8 / lu(k,413) + lu(k,414) = lu(k,414) * lu(k,413) + lu(k,415) = lu(k,415) * lu(k,413) + lu(k,416) = lu(k,416) * lu(k,413) + lu(k,417) = lu(k,417) * lu(k,413) + lu(k,418) = lu(k,418) * lu(k,413) + lu(k,933) = lu(k,933) - lu(k,414) * lu(k,932) + lu(k,934) = lu(k,934) - lu(k,415) * lu(k,932) + lu(k,937) = - lu(k,416) * lu(k,932) + lu(k,940) = lu(k,940) - lu(k,417) * lu(k,932) + lu(k,943) = - lu(k,418) * lu(k,932) + lu(k,1758) = lu(k,1758) - lu(k,414) * lu(k,1706) + lu(k,1768) = lu(k,1768) - lu(k,415) * lu(k,1706) + lu(k,1799) = lu(k,1799) - lu(k,416) * lu(k,1706) + lu(k,1806) = lu(k,1806) - lu(k,417) * lu(k,1706) + lu(k,1812) = lu(k,1812) - lu(k,418) * lu(k,1706) + lu(k,2165) = lu(k,2165) - lu(k,414) * lu(k,2127) + lu(k,2170) = - lu(k,415) * lu(k,2127) + lu(k,2197) = lu(k,2197) - lu(k,416) * lu(k,2127) + lu(k,2204) = lu(k,2204) - lu(k,417) * lu(k,2127) + lu(k,2210) = lu(k,2210) - lu(k,418) * lu(k,2127) + lu(k,419) = 1._r8 / lu(k,419) + lu(k,420) = lu(k,420) * lu(k,419) + lu(k,421) = lu(k,421) * lu(k,419) + lu(k,422) = lu(k,422) * lu(k,419) + lu(k,423) = lu(k,423) * lu(k,419) + lu(k,424) = lu(k,424) * lu(k,419) + lu(k,1244) = - lu(k,420) * lu(k,1243) + lu(k,1246) = lu(k,1246) - lu(k,421) * lu(k,1243) + lu(k,1257) = lu(k,1257) - lu(k,422) * lu(k,1243) + lu(k,1258) = lu(k,1258) - lu(k,423) * lu(k,1243) + lu(k,1262) = lu(k,1262) - lu(k,424) * lu(k,1243) + lu(k,1742) = lu(k,1742) - lu(k,420) * lu(k,1707) + lu(k,1752) = lu(k,1752) - lu(k,421) * lu(k,1707) + lu(k,1799) = lu(k,1799) - lu(k,422) * lu(k,1707) + lu(k,1800) = lu(k,1800) - lu(k,423) * lu(k,1707) + lu(k,1806) = lu(k,1806) - lu(k,424) * lu(k,1707) + lu(k,2151) = lu(k,2151) - lu(k,420) * lu(k,2128) + lu(k,2161) = - lu(k,421) * lu(k,2128) + lu(k,2197) = lu(k,2197) - lu(k,422) * lu(k,2128) + lu(k,2198) = lu(k,2198) - lu(k,423) * lu(k,2128) + lu(k,2204) = lu(k,2204) - lu(k,424) * lu(k,2128) + lu(k,425) = 1._r8 / lu(k,425) + lu(k,426) = lu(k,426) * lu(k,425) + lu(k,427) = lu(k,427) * lu(k,425) + lu(k,428) = lu(k,428) * lu(k,425) + lu(k,429) = lu(k,429) * lu(k,425) + lu(k,430) = lu(k,430) * lu(k,425) + lu(k,508) = lu(k,508) - lu(k,426) * lu(k,507) + lu(k,509) = lu(k,509) - lu(k,427) * lu(k,507) + lu(k,510) = lu(k,510) - lu(k,428) * lu(k,507) + lu(k,511) = - lu(k,429) * lu(k,507) + lu(k,514) = lu(k,514) - lu(k,430) * lu(k,507) + lu(k,1718) = lu(k,1718) - lu(k,426) * lu(k,1708) + lu(k,1765) = lu(k,1765) - lu(k,427) * lu(k,1708) + lu(k,1783) = lu(k,1783) - lu(k,428) * lu(k,1708) + lu(k,1799) = lu(k,1799) - lu(k,429) * lu(k,1708) + lu(k,1806) = lu(k,1806) - lu(k,430) * lu(k,1708) + lu(k,2139) = lu(k,2139) - lu(k,426) * lu(k,2129) + lu(k,2167) = lu(k,2167) - lu(k,427) * lu(k,2129) + lu(k,2182) = lu(k,2182) - lu(k,428) * lu(k,2129) + lu(k,2197) = lu(k,2197) - lu(k,429) * lu(k,2129) + lu(k,2204) = lu(k,2204) - lu(k,430) * lu(k,2129) + lu(k,433) = 1._r8 / lu(k,433) + lu(k,434) = lu(k,434) * lu(k,433) + lu(k,435) = lu(k,435) * lu(k,433) + lu(k,436) = lu(k,436) * lu(k,433) + lu(k,437) = lu(k,437) * lu(k,433) + lu(k,438) = lu(k,438) * lu(k,433) + lu(k,1720) = lu(k,1720) - lu(k,434) * lu(k,1709) + lu(k,1799) = lu(k,1799) - lu(k,435) * lu(k,1709) + lu(k,1800) = lu(k,1800) - lu(k,436) * lu(k,1709) + lu(k,1804) = lu(k,1804) - lu(k,437) * lu(k,1709) + lu(k,1806) = lu(k,1806) - lu(k,438) * lu(k,1709) + lu(k,2013) = lu(k,2013) - lu(k,434) * lu(k,2004) + lu(k,2068) = lu(k,2068) - lu(k,435) * lu(k,2004) + lu(k,2069) = lu(k,2069) - lu(k,436) * lu(k,2004) + lu(k,2073) = lu(k,2073) - lu(k,437) * lu(k,2004) + lu(k,2075) = lu(k,2075) - lu(k,438) * lu(k,2004) + lu(k,2140) = lu(k,2140) - lu(k,434) * lu(k,2130) + lu(k,2197) = lu(k,2197) - lu(k,435) * lu(k,2130) + lu(k,2198) = lu(k,2198) - lu(k,436) * lu(k,2130) + lu(k,2202) = lu(k,2202) - lu(k,437) * lu(k,2130) + lu(k,2204) = lu(k,2204) - lu(k,438) * lu(k,2130) + lu(k,439) = 1._r8 / lu(k,439) + lu(k,440) = lu(k,440) * lu(k,439) + lu(k,441) = lu(k,441) * lu(k,439) + lu(k,442) = lu(k,442) * lu(k,439) + lu(k,443) = lu(k,443) * lu(k,439) + lu(k,444) = lu(k,444) * lu(k,439) + lu(k,2033) = lu(k,2033) - lu(k,440) * lu(k,2005) + lu(k,2069) = lu(k,2069) - lu(k,441) * lu(k,2005) + lu(k,2073) = lu(k,2073) - lu(k,442) * lu(k,2005) + lu(k,2075) = lu(k,2075) - lu(k,443) * lu(k,2005) + lu(k,2079) = lu(k,2079) - lu(k,444) * lu(k,2005) + lu(k,2163) = lu(k,2163) - lu(k,440) * lu(k,2131) + lu(k,2198) = lu(k,2198) - lu(k,441) * lu(k,2131) + lu(k,2202) = lu(k,2202) - lu(k,442) * lu(k,2131) + lu(k,2204) = lu(k,2204) - lu(k,443) * lu(k,2131) + lu(k,2208) = lu(k,2208) - lu(k,444) * lu(k,2131) + lu(k,2333) = - lu(k,440) * lu(k,2331) + lu(k,2344) = - lu(k,441) * lu(k,2331) + lu(k,2348) = - lu(k,442) * lu(k,2331) + lu(k,2350) = lu(k,2350) - lu(k,443) * lu(k,2331) + lu(k,2354) = lu(k,2354) - lu(k,444) * lu(k,2331) + lu(k,445) = 1._r8 / lu(k,445) + lu(k,446) = lu(k,446) * lu(k,445) + lu(k,447) = lu(k,447) * lu(k,445) + lu(k,448) = lu(k,448) * lu(k,445) + lu(k,449) = lu(k,449) * lu(k,445) + lu(k,450) = lu(k,450) * lu(k,445) + lu(k,1628) = lu(k,1628) - lu(k,446) * lu(k,1622) + lu(k,1629) = lu(k,1629) - lu(k,447) * lu(k,1622) + lu(k,1633) = lu(k,1633) - lu(k,448) * lu(k,1622) + lu(k,1634) = lu(k,1634) - lu(k,449) * lu(k,1622) + lu(k,1637) = lu(k,1637) - lu(k,450) * lu(k,1622) + lu(k,1793) = lu(k,1793) - lu(k,446) * lu(k,1710) + lu(k,1794) = lu(k,1794) - lu(k,447) * lu(k,1710) + lu(k,1798) = lu(k,1798) - lu(k,448) * lu(k,1710) + lu(k,1799) = lu(k,1799) - lu(k,449) * lu(k,1710) + lu(k,1802) = lu(k,1802) - lu(k,450) * lu(k,1710) + lu(k,1944) = lu(k,1944) - lu(k,446) * lu(k,1923) + lu(k,1945) = lu(k,1945) - lu(k,447) * lu(k,1923) + lu(k,1949) = - lu(k,448) * lu(k,1923) + lu(k,1950) = lu(k,1950) - lu(k,449) * lu(k,1923) + lu(k,1953) = lu(k,1953) - lu(k,450) * lu(k,1923) end do - end subroutine lu_fac10 - subroutine lu_fac11( avec_len, lu ) + 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 @@ -1469,164 +1184,167 @@ subroutine lu_fac11( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len + lu(k,452) = 1._r8 / lu(k,452) + lu(k,453) = lu(k,453) * lu(k,452) + lu(k,454) = lu(k,454) * lu(k,452) + lu(k,455) = lu(k,455) * lu(k,452) + lu(k,456) = lu(k,456) * lu(k,452) + lu(k,457) = lu(k,457) * lu(k,452) + lu(k,1765) = lu(k,1765) - lu(k,453) * lu(k,1711) + lu(k,1799) = lu(k,1799) - lu(k,454) * lu(k,1711) + lu(k,1800) = lu(k,1800) - lu(k,455) * lu(k,1711) + lu(k,1804) = lu(k,1804) - lu(k,456) * lu(k,1711) + lu(k,1806) = lu(k,1806) - lu(k,457) * lu(k,1711) + lu(k,2038) = lu(k,2038) - lu(k,453) * lu(k,2006) + lu(k,2068) = lu(k,2068) - lu(k,454) * lu(k,2006) + lu(k,2069) = lu(k,2069) - lu(k,455) * lu(k,2006) + lu(k,2073) = lu(k,2073) - lu(k,456) * lu(k,2006) + lu(k,2075) = lu(k,2075) - lu(k,457) * lu(k,2006) + lu(k,2167) = lu(k,2167) - lu(k,453) * lu(k,2132) + lu(k,2197) = lu(k,2197) - lu(k,454) * lu(k,2132) + lu(k,2198) = lu(k,2198) - lu(k,455) * lu(k,2132) + lu(k,2202) = lu(k,2202) - lu(k,456) * lu(k,2132) + lu(k,2204) = lu(k,2204) - lu(k,457) * lu(k,2132) lu(k,458) = 1._r8 / lu(k,458) lu(k,459) = lu(k,459) * lu(k,458) lu(k,460) = lu(k,460) * lu(k,458) - lu(k,461) = lu(k,461) * lu(k,458) - lu(k,462) = lu(k,462) * lu(k,458) - lu(k,463) = lu(k,463) * lu(k,458) - lu(k,464) = lu(k,464) * lu(k,458) - lu(k,465) = lu(k,465) * lu(k,458) - lu(k,1481) = lu(k,1481) - lu(k,459) * lu(k,1457) - lu(k,1485) = lu(k,1485) - lu(k,460) * lu(k,1457) - lu(k,1493) = lu(k,1493) - lu(k,461) * lu(k,1457) - lu(k,1507) = lu(k,1507) - lu(k,462) * lu(k,1457) - lu(k,1513) = lu(k,1513) - lu(k,463) * lu(k,1457) - lu(k,1517) = lu(k,1517) - lu(k,464) * lu(k,1457) - lu(k,1519) = lu(k,1519) - lu(k,465) * lu(k,1457) - lu(k,1685) = lu(k,1685) - lu(k,459) * lu(k,1648) - lu(k,1691) = lu(k,1691) - lu(k,460) * lu(k,1648) - lu(k,1699) = lu(k,1699) - lu(k,461) * lu(k,1648) - lu(k,1716) = lu(k,1716) - lu(k,462) * lu(k,1648) - lu(k,1722) = lu(k,1722) - lu(k,463) * lu(k,1648) - lu(k,1726) = lu(k,1726) - lu(k,464) * lu(k,1648) - lu(k,1728) = lu(k,1728) - lu(k,465) * lu(k,1648) - lu(k,1872) = lu(k,1872) - lu(k,459) * lu(k,1864) - lu(k,1877) = - lu(k,460) * lu(k,1864) - lu(k,1885) = lu(k,1885) - lu(k,461) * lu(k,1864) - lu(k,1900) = lu(k,1900) - lu(k,462) * lu(k,1864) - lu(k,1906) = lu(k,1906) - lu(k,463) * lu(k,1864) - lu(k,1910) = lu(k,1910) - lu(k,464) * lu(k,1864) - lu(k,1912) = lu(k,1912) - lu(k,465) * lu(k,1864) + lu(k,487) = - lu(k,459) * lu(k,485) + lu(k,492) = lu(k,492) - lu(k,460) * lu(k,485) + lu(k,664) = - lu(k,459) * lu(k,661) + lu(k,672) = lu(k,672) - lu(k,460) * lu(k,661) + lu(k,720) = - lu(k,459) * lu(k,717) + lu(k,729) = lu(k,729) - lu(k,460) * lu(k,717) + lu(k,748) = - lu(k,459) * lu(k,745) + lu(k,758) = lu(k,758) - lu(k,460) * lu(k,745) + lu(k,764) = - lu(k,459) * lu(k,761) + lu(k,775) = lu(k,775) - lu(k,460) * lu(k,761) + lu(k,1743) = - lu(k,459) * lu(k,1712) + lu(k,1806) = lu(k,1806) - lu(k,460) * lu(k,1712) + lu(k,2022) = lu(k,2022) - lu(k,459) * lu(k,2007) + lu(k,2075) = lu(k,2075) - lu(k,460) * lu(k,2007) + lu(k,2152) = lu(k,2152) - lu(k,459) * lu(k,2133) + lu(k,2204) = lu(k,2204) - lu(k,460) * lu(k,2133) + lu(k,461) = 1._r8 / lu(k,461) + lu(k,462) = lu(k,462) * lu(k,461) + lu(k,463) = lu(k,463) * lu(k,461) + lu(k,464) = lu(k,464) * lu(k,461) + lu(k,465) = lu(k,465) * lu(k,461) + lu(k,796) = - lu(k,462) * lu(k,794) + lu(k,797) = - lu(k,463) * lu(k,794) + lu(k,801) = lu(k,801) - lu(k,464) * lu(k,794) + lu(k,802) = lu(k,802) - lu(k,465) * lu(k,794) + lu(k,1536) = lu(k,1536) - lu(k,462) * lu(k,1524) + lu(k,1540) = lu(k,1540) - lu(k,463) * lu(k,1524) + lu(k,1549) = lu(k,1549) - lu(k,464) * lu(k,1524) + lu(k,1551) = - lu(k,465) * lu(k,1524) + lu(k,2047) = lu(k,2047) - lu(k,462) * lu(k,2008) + lu(k,2064) = lu(k,2064) - lu(k,463) * lu(k,2008) + lu(k,2075) = lu(k,2075) - lu(k,464) * lu(k,2008) + lu(k,2079) = lu(k,2079) - lu(k,465) * lu(k,2008) + lu(k,2175) = - lu(k,462) * lu(k,2134) + lu(k,2193) = lu(k,2193) - lu(k,463) * lu(k,2134) + lu(k,2204) = lu(k,2204) - lu(k,464) * lu(k,2134) + lu(k,2208) = lu(k,2208) - lu(k,465) * lu(k,2134) lu(k,466) = 1._r8 / lu(k,466) lu(k,467) = lu(k,467) * lu(k,466) lu(k,468) = lu(k,468) * lu(k,466) lu(k,469) = lu(k,469) * lu(k,466) - lu(k,470) = lu(k,470) * lu(k,466) - lu(k,471) = lu(k,471) * lu(k,466) - lu(k,472) = lu(k,472) * lu(k,466) - lu(k,473) = lu(k,473) * lu(k,466) - lu(k,1269) = - lu(k,467) * lu(k,1268) - lu(k,1271) = lu(k,1271) - lu(k,468) * lu(k,1268) - lu(k,1275) = lu(k,1275) - lu(k,469) * lu(k,1268) - lu(k,1277) = lu(k,1277) - lu(k,470) * lu(k,1268) - lu(k,1278) = lu(k,1278) - lu(k,471) * lu(k,1268) - lu(k,1281) = lu(k,1281) - lu(k,472) * lu(k,1268) - lu(k,1282) = lu(k,1282) - lu(k,473) * lu(k,1268) - lu(k,1693) = lu(k,1693) - lu(k,467) * lu(k,1649) - lu(k,1709) = lu(k,1709) - lu(k,468) * lu(k,1649) - lu(k,1719) = lu(k,1719) - lu(k,469) * lu(k,1649) - lu(k,1722) = lu(k,1722) - lu(k,470) * lu(k,1649) - lu(k,1723) = lu(k,1723) - lu(k,471) * lu(k,1649) - lu(k,1726) = lu(k,1726) - lu(k,472) * lu(k,1649) - lu(k,1728) = lu(k,1728) - lu(k,473) * lu(k,1649) - lu(k,1974) = - lu(k,467) * lu(k,1964) - lu(k,1977) = lu(k,1977) - lu(k,468) * lu(k,1964) - lu(k,1987) = lu(k,1987) - lu(k,469) * lu(k,1964) - lu(k,1990) = lu(k,1990) - lu(k,470) * lu(k,1964) - lu(k,1991) = lu(k,1991) - lu(k,471) * lu(k,1964) - lu(k,1994) = lu(k,1994) - lu(k,472) * lu(k,1964) - lu(k,1996) = lu(k,1996) - lu(k,473) * lu(k,1964) - lu(k,474) = 1._r8 / lu(k,474) - lu(k,475) = lu(k,475) * lu(k,474) - lu(k,476) = lu(k,476) * lu(k,474) - lu(k,477) = lu(k,477) * lu(k,474) - lu(k,478) = lu(k,478) * lu(k,474) - lu(k,479) = lu(k,479) * lu(k,474) - lu(k,480) = lu(k,480) * lu(k,474) - lu(k,1538) = lu(k,1538) - lu(k,475) * lu(k,1526) - lu(k,1543) = lu(k,1543) - lu(k,476) * lu(k,1526) - lu(k,1545) = lu(k,1545) - lu(k,477) * lu(k,1526) - lu(k,1547) = - lu(k,478) * lu(k,1526) - lu(k,1554) = lu(k,1554) - lu(k,479) * lu(k,1526) - lu(k,1556) = lu(k,1556) - lu(k,480) * lu(k,1526) - lu(k,1712) = lu(k,1712) - lu(k,475) * lu(k,1650) - lu(k,1717) = lu(k,1717) - lu(k,476) * lu(k,1650) - lu(k,1719) = lu(k,1719) - lu(k,477) * lu(k,1650) - lu(k,1721) = lu(k,1721) - lu(k,478) * lu(k,1650) - lu(k,1728) = lu(k,1728) - lu(k,479) * lu(k,1650) - lu(k,1730) = lu(k,1730) - lu(k,480) * lu(k,1650) - lu(k,1815) = lu(k,1815) - lu(k,475) * lu(k,1799) - lu(k,1820) = lu(k,1820) - lu(k,476) * lu(k,1799) - lu(k,1822) = lu(k,1822) - lu(k,477) * lu(k,1799) - lu(k,1824) = lu(k,1824) - lu(k,478) * lu(k,1799) - lu(k,1831) = lu(k,1831) - lu(k,479) * lu(k,1799) - lu(k,1833) = - lu(k,480) * lu(k,1799) - lu(k,2099) = lu(k,2099) - lu(k,475) * lu(k,2052) - lu(k,2104) = lu(k,2104) - lu(k,476) * lu(k,2052) - lu(k,2106) = lu(k,2106) - lu(k,477) * lu(k,2052) - lu(k,2108) = lu(k,2108) - lu(k,478) * lu(k,2052) - lu(k,2115) = lu(k,2115) - lu(k,479) * lu(k,2052) - lu(k,2117) = lu(k,2117) - lu(k,480) * lu(k,2052) - lu(k,481) = 1._r8 / lu(k,481) - lu(k,482) = lu(k,482) * lu(k,481) - lu(k,483) = lu(k,483) * lu(k,481) - lu(k,484) = lu(k,484) * lu(k,481) - lu(k,485) = lu(k,485) * lu(k,481) - lu(k,486) = lu(k,486) * lu(k,481) - lu(k,487) = lu(k,487) * lu(k,481) - lu(k,488) = lu(k,488) * lu(k,481) - lu(k,489) = lu(k,489) * lu(k,481) - lu(k,1026) = lu(k,1026) - lu(k,482) * lu(k,1024) - lu(k,1027) = lu(k,1027) - lu(k,483) * lu(k,1024) - lu(k,1028) = lu(k,1028) - lu(k,484) * lu(k,1024) - lu(k,1029) = lu(k,1029) - lu(k,485) * lu(k,1024) - lu(k,1030) = lu(k,1030) - lu(k,486) * lu(k,1024) - lu(k,1035) = - lu(k,487) * lu(k,1024) - lu(k,1036) = lu(k,1036) - lu(k,488) * lu(k,1024) - lu(k,1040) = lu(k,1040) - lu(k,489) * lu(k,1024) - lu(k,1685) = lu(k,1685) - lu(k,482) * lu(k,1651) - lu(k,1690) = lu(k,1690) - lu(k,483) * lu(k,1651) - lu(k,1692) = lu(k,1692) - lu(k,484) * lu(k,1651) - lu(k,1694) = lu(k,1694) - lu(k,485) * lu(k,1651) - lu(k,1696) = lu(k,1696) - lu(k,486) * lu(k,1651) - lu(k,1719) = lu(k,1719) - lu(k,487) * lu(k,1651) - lu(k,1722) = lu(k,1722) - lu(k,488) * lu(k,1651) - lu(k,1728) = lu(k,1728) - lu(k,489) * lu(k,1651) - lu(k,2077) = lu(k,2077) - lu(k,482) * lu(k,2053) - lu(k,2079) = lu(k,2079) - lu(k,483) * lu(k,2053) - lu(k,2080) = - lu(k,484) * lu(k,2053) - lu(k,2082) = lu(k,2082) - lu(k,485) * lu(k,2053) - lu(k,2084) = lu(k,2084) - lu(k,486) * lu(k,2053) - lu(k,2106) = lu(k,2106) - lu(k,487) * lu(k,2053) - lu(k,2109) = lu(k,2109) - lu(k,488) * lu(k,2053) - lu(k,2115) = lu(k,2115) - lu(k,489) * lu(k,2053) - 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,616) = lu(k,616) - lu(k,493) * lu(k,615) - lu(k,617) = lu(k,617) - lu(k,494) * lu(k,615) - lu(k,618) = lu(k,618) - lu(k,495) * lu(k,615) - lu(k,619) = lu(k,619) - lu(k,496) * lu(k,615) - lu(k,620) = lu(k,620) - lu(k,497) * lu(k,615) - lu(k,623) = lu(k,623) - lu(k,498) * lu(k,615) - lu(k,625) = - lu(k,499) * lu(k,615) - lu(k,627) = lu(k,627) - lu(k,500) * lu(k,615) - lu(k,1653) = lu(k,1653) - lu(k,493) * lu(k,1652) - lu(k,1663) = lu(k,1663) - lu(k,494) * lu(k,1652) - lu(k,1664) = lu(k,1664) - lu(k,495) * lu(k,1652) - lu(k,1666) = - lu(k,496) * lu(k,1652) - lu(k,1678) = lu(k,1678) - lu(k,497) * lu(k,1652) - lu(k,1704) = lu(k,1704) - lu(k,498) * lu(k,1652) - lu(k,1719) = lu(k,1719) - lu(k,499) * lu(k,1652) - lu(k,1728) = lu(k,1728) - lu(k,500) * lu(k,1652) - lu(k,2055) = - lu(k,493) * lu(k,2054) - lu(k,2061) = lu(k,2061) - lu(k,494) * lu(k,2054) - lu(k,2062) = lu(k,2062) - lu(k,495) * lu(k,2054) - lu(k,2064) = lu(k,2064) - lu(k,496) * lu(k,2054) - lu(k,2073) = lu(k,2073) - lu(k,497) * lu(k,2054) - lu(k,2092) = lu(k,2092) - lu(k,498) * lu(k,2054) - lu(k,2106) = lu(k,2106) - lu(k,499) * lu(k,2054) - lu(k,2115) = lu(k,2115) - lu(k,500) * lu(k,2054) + lu(k,633) = lu(k,633) - lu(k,467) * lu(k,632) + lu(k,635) = lu(k,635) - lu(k,468) * lu(k,632) + lu(k,638) = - lu(k,469) * lu(k,632) + lu(k,1733) = lu(k,1733) - lu(k,467) * lu(k,1713) + lu(k,1800) = lu(k,1800) - lu(k,468) * lu(k,1713) + lu(k,1811) = lu(k,1811) - lu(k,469) * lu(k,1713) + lu(k,1822) = - lu(k,467) * lu(k,1816) + lu(k,1845) = lu(k,1845) - lu(k,468) * lu(k,1816) + lu(k,1856) = lu(k,1856) - lu(k,469) * lu(k,1816) + lu(k,2019) = lu(k,2019) - lu(k,467) * lu(k,2009) + lu(k,2069) = lu(k,2069) - lu(k,468) * lu(k,2009) + lu(k,2080) = lu(k,2080) - lu(k,469) * lu(k,2009) + lu(k,2144) = lu(k,2144) - lu(k,467) * lu(k,2135) + lu(k,2198) = lu(k,2198) - lu(k,468) * lu(k,2135) + lu(k,2209) = lu(k,2209) - lu(k,469) * lu(k,2135) + lu(k,2368) = lu(k,2368) - lu(k,467) * lu(k,2366) + lu(k,2408) = lu(k,2408) - lu(k,468) * lu(k,2366) + lu(k,2419) = lu(k,2419) - lu(k,469) * lu(k,2366) + lu(k,470) = 1._r8 / lu(k,470) + lu(k,471) = lu(k,471) * lu(k,470) + lu(k,472) = lu(k,472) * lu(k,470) + lu(k,473) = lu(k,473) * lu(k,470) + lu(k,474) = lu(k,474) * lu(k,470) + lu(k,475) = lu(k,475) * lu(k,470) + lu(k,476) = lu(k,476) * lu(k,470) + lu(k,1628) = lu(k,1628) - lu(k,471) * lu(k,1623) + lu(k,1629) = lu(k,1629) - lu(k,472) * lu(k,1623) + lu(k,1633) = lu(k,1633) - lu(k,473) * lu(k,1623) + lu(k,1634) = lu(k,1634) - lu(k,474) * lu(k,1623) + lu(k,1637) = lu(k,1637) - lu(k,475) * lu(k,1623) + lu(k,1647) = lu(k,1647) - lu(k,476) * lu(k,1623) + lu(k,1793) = lu(k,1793) - lu(k,471) * lu(k,1714) + lu(k,1794) = lu(k,1794) - lu(k,472) * lu(k,1714) + lu(k,1798) = lu(k,1798) - lu(k,473) * lu(k,1714) + lu(k,1799) = lu(k,1799) - lu(k,474) * lu(k,1714) + lu(k,1802) = lu(k,1802) - lu(k,475) * lu(k,1714) + lu(k,1812) = lu(k,1812) - lu(k,476) * lu(k,1714) + lu(k,1944) = lu(k,1944) - lu(k,471) * lu(k,1924) + lu(k,1945) = lu(k,1945) - lu(k,472) * lu(k,1924) + lu(k,1949) = lu(k,1949) - lu(k,473) * lu(k,1924) + lu(k,1950) = lu(k,1950) - lu(k,474) * lu(k,1924) + lu(k,1953) = lu(k,1953) - lu(k,475) * lu(k,1924) + lu(k,1963) = lu(k,1963) - lu(k,476) * lu(k,1924) + 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,1060) = lu(k,1060) - lu(k,478) * lu(k,1057) + lu(k,1061) = lu(k,1061) - lu(k,479) * lu(k,1057) + lu(k,1062) = lu(k,1062) - lu(k,480) * lu(k,1057) + lu(k,1063) = - lu(k,481) * lu(k,1057) + lu(k,1067) = lu(k,1067) - lu(k,482) * lu(k,1057) + lu(k,1069) = lu(k,1069) - lu(k,483) * lu(k,1057) + lu(k,1766) = lu(k,1766) - lu(k,478) * lu(k,1715) + lu(k,1767) = lu(k,1767) - lu(k,479) * lu(k,1715) + lu(k,1768) = lu(k,1768) - lu(k,480) * lu(k,1715) + lu(k,1799) = lu(k,1799) - lu(k,481) * lu(k,1715) + lu(k,1806) = lu(k,1806) - lu(k,482) * lu(k,1715) + lu(k,1810) = lu(k,1810) - lu(k,483) * lu(k,1715) + lu(k,2168) = lu(k,2168) - lu(k,478) * lu(k,2136) + lu(k,2169) = lu(k,2169) - lu(k,479) * lu(k,2136) + lu(k,2170) = lu(k,2170) - lu(k,480) * lu(k,2136) + lu(k,2197) = lu(k,2197) - lu(k,481) * lu(k,2136) + lu(k,2204) = lu(k,2204) - lu(k,482) * lu(k,2136) + lu(k,2208) = lu(k,2208) - lu(k,483) * lu(k,2136) + lu(k,486) = 1._r8 / lu(k,486) + lu(k,487) = lu(k,487) * lu(k,486) + lu(k,488) = lu(k,488) * lu(k,486) + lu(k,489) = lu(k,489) * lu(k,486) + lu(k,490) = lu(k,490) * lu(k,486) + lu(k,491) = lu(k,491) * lu(k,486) + lu(k,492) = lu(k,492) * lu(k,486) + lu(k,1743) = lu(k,1743) - lu(k,487) * lu(k,1716) + lu(k,1765) = lu(k,1765) - lu(k,488) * lu(k,1716) + lu(k,1799) = lu(k,1799) - lu(k,489) * lu(k,1716) + lu(k,1800) = lu(k,1800) - lu(k,490) * lu(k,1716) + lu(k,1804) = lu(k,1804) - lu(k,491) * lu(k,1716) + lu(k,1806) = lu(k,1806) - lu(k,492) * lu(k,1716) + lu(k,2022) = lu(k,2022) - lu(k,487) * lu(k,2010) + lu(k,2038) = lu(k,2038) - lu(k,488) * lu(k,2010) + lu(k,2068) = lu(k,2068) - lu(k,489) * lu(k,2010) + lu(k,2069) = lu(k,2069) - lu(k,490) * lu(k,2010) + lu(k,2073) = lu(k,2073) - lu(k,491) * lu(k,2010) + lu(k,2075) = lu(k,2075) - lu(k,492) * lu(k,2010) + lu(k,2152) = lu(k,2152) - lu(k,487) * lu(k,2137) + lu(k,2167) = lu(k,2167) - lu(k,488) * lu(k,2137) + lu(k,2197) = lu(k,2197) - lu(k,489) * lu(k,2137) + lu(k,2198) = lu(k,2198) - lu(k,490) * lu(k,2137) + lu(k,2202) = lu(k,2202) - lu(k,491) * lu(k,2137) + lu(k,2204) = lu(k,2204) - lu(k,492) * lu(k,2137) end do - end subroutine lu_fac11 - subroutine lu_fac12( avec_len, lu ) + 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 @@ -1640,197 +1358,318 @@ subroutine lu_fac12( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,501) = 1._r8 / lu(k,501) - lu(k,502) = lu(k,502) * lu(k,501) - lu(k,503) = lu(k,503) * lu(k,501) - lu(k,504) = lu(k,504) * lu(k,501) - lu(k,594) = - lu(k,502) * lu(k,588) - lu(k,595) = lu(k,595) - lu(k,503) * lu(k,588) - lu(k,599) = lu(k,599) - lu(k,504) * lu(k,588) - lu(k,621) = - lu(k,502) * lu(k,616) - lu(k,622) = - lu(k,503) * lu(k,616) - lu(k,627) = lu(k,627) - lu(k,504) * lu(k,616) - lu(k,637) = - lu(k,502) * lu(k,631) - lu(k,638) = lu(k,638) - lu(k,503) * lu(k,631) - lu(k,644) = lu(k,644) - lu(k,504) * lu(k,631) - lu(k,927) = - lu(k,502) * lu(k,924) - lu(k,929) = - lu(k,503) * lu(k,924) - lu(k,938) = lu(k,938) - lu(k,504) * lu(k,924) - lu(k,1196) = - lu(k,502) * lu(k,1191) - lu(k,1200) = - lu(k,503) * lu(k,1191) - lu(k,1220) = lu(k,1220) - lu(k,504) * lu(k,1191) - lu(k,1478) = lu(k,1478) - lu(k,502) * lu(k,1458) - lu(k,1488) = lu(k,1488) - lu(k,503) * lu(k,1458) - lu(k,1519) = lu(k,1519) - lu(k,504) * lu(k,1458) - lu(k,1679) = - lu(k,502) * lu(k,1653) - lu(k,1694) = lu(k,1694) - lu(k,503) * lu(k,1653) - lu(k,1728) = lu(k,1728) - lu(k,504) * lu(k,1653) - lu(k,2074) = lu(k,2074) - lu(k,502) * lu(k,2055) - lu(k,2082) = lu(k,2082) - lu(k,503) * lu(k,2055) - lu(k,2115) = lu(k,2115) - lu(k,504) * lu(k,2055) - lu(k,505) = 1._r8 / lu(k,505) - lu(k,506) = lu(k,506) * lu(k,505) - lu(k,507) = lu(k,507) * lu(k,505) - lu(k,508) = lu(k,508) * lu(k,505) - lu(k,509) = lu(k,509) * lu(k,505) - lu(k,510) = lu(k,510) * lu(k,505) - lu(k,511) = lu(k,511) * lu(k,505) - lu(k,512) = lu(k,512) * lu(k,505) - lu(k,513) = lu(k,513) * lu(k,505) - lu(k,1163) = - lu(k,506) * lu(k,1160) - lu(k,1164) = - lu(k,507) * lu(k,1160) - lu(k,1165) = - lu(k,508) * lu(k,1160) - lu(k,1179) = - lu(k,509) * lu(k,1160) - lu(k,1181) = lu(k,1181) - lu(k,510) * lu(k,1160) - lu(k,1184) = - lu(k,511) * lu(k,1160) - lu(k,1185) = lu(k,1185) - lu(k,512) * lu(k,1160) - lu(k,1186) = lu(k,1186) - lu(k,513) * lu(k,1160) - lu(k,1484) = lu(k,1484) - lu(k,506) * lu(k,1459) - lu(k,1485) = lu(k,1485) - lu(k,507) * lu(k,1459) - lu(k,1487) = lu(k,1487) - lu(k,508) * lu(k,1459) - lu(k,1510) = lu(k,1510) - lu(k,509) * lu(k,1459) - lu(k,1513) = lu(k,1513) - lu(k,510) * lu(k,1459) - lu(k,1516) = lu(k,1516) - lu(k,511) * lu(k,1459) - lu(k,1517) = lu(k,1517) - lu(k,512) * lu(k,1459) - lu(k,1519) = lu(k,1519) - lu(k,513) * lu(k,1459) - lu(k,1690) = lu(k,1690) - lu(k,506) * lu(k,1654) - lu(k,1691) = lu(k,1691) - lu(k,507) * lu(k,1654) - lu(k,1693) = lu(k,1693) - lu(k,508) * lu(k,1654) - lu(k,1719) = lu(k,1719) - lu(k,509) * lu(k,1654) - lu(k,1722) = lu(k,1722) - lu(k,510) * lu(k,1654) - lu(k,1725) = lu(k,1725) - lu(k,511) * lu(k,1654) - lu(k,1726) = lu(k,1726) - lu(k,512) * lu(k,1654) - lu(k,1728) = lu(k,1728) - lu(k,513) * lu(k,1654) - 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,568) = lu(k,568) - lu(k,515) * lu(k,566) - lu(k,569) = lu(k,569) - lu(k,516) * lu(k,566) - lu(k,571) = lu(k,571) - lu(k,517) * lu(k,566) - lu(k,572) = - lu(k,518) * lu(k,566) - lu(k,573) = lu(k,573) - lu(k,519) * lu(k,566) - lu(k,576) = lu(k,576) - lu(k,520) * lu(k,566) - lu(k,741) = lu(k,741) - lu(k,515) * lu(k,740) - lu(k,742) = lu(k,742) - lu(k,516) * lu(k,740) - lu(k,744) = lu(k,744) - lu(k,517) * lu(k,740) - lu(k,745) = - lu(k,518) * lu(k,740) - lu(k,746) = lu(k,746) - lu(k,519) * lu(k,740) - lu(k,750) = lu(k,750) - lu(k,520) * lu(k,740) - lu(k,1418) = lu(k,1418) - lu(k,515) * lu(k,1415) - lu(k,1419) = lu(k,1419) - lu(k,516) * lu(k,1415) - lu(k,1421) = lu(k,1421) - lu(k,517) * lu(k,1415) - lu(k,1424) = - lu(k,518) * lu(k,1415) - lu(k,1427) = lu(k,1427) - lu(k,519) * lu(k,1415) - lu(k,1433) = lu(k,1433) - lu(k,520) * lu(k,1415) - lu(k,1804) = lu(k,1804) - lu(k,515) * lu(k,1800) - lu(k,1805) = lu(k,1805) - lu(k,516) * lu(k,1800) - lu(k,1807) = lu(k,1807) - lu(k,517) * lu(k,1800) - lu(k,1812) = lu(k,1812) - lu(k,518) * lu(k,1800) - lu(k,1818) = lu(k,1818) - lu(k,519) * lu(k,1800) - lu(k,1824) = lu(k,1824) - lu(k,520) * lu(k,1800) + lu(k,493) = 1._r8 / lu(k,493) + lu(k,494) = lu(k,494) * lu(k,493) + lu(k,495) = lu(k,495) * lu(k,493) + lu(k,496) = lu(k,496) * lu(k,493) + lu(k,497) = lu(k,497) * lu(k,493) + lu(k,498) = lu(k,498) * lu(k,493) + lu(k,499) = lu(k,499) * lu(k,493) + lu(k,1795) = lu(k,1795) - lu(k,494) * lu(k,1717) + lu(k,1799) = lu(k,1799) - lu(k,495) * lu(k,1717) + lu(k,1800) = lu(k,1800) - lu(k,496) * lu(k,1717) + lu(k,1801) = lu(k,1801) - lu(k,497) * lu(k,1717) + lu(k,1806) = lu(k,1806) - lu(k,498) * lu(k,1717) + lu(k,1812) = lu(k,1812) - lu(k,499) * lu(k,1717) + lu(k,1840) = lu(k,1840) - lu(k,494) * lu(k,1817) + lu(k,1844) = lu(k,1844) - lu(k,495) * lu(k,1817) + lu(k,1845) = lu(k,1845) - lu(k,496) * lu(k,1817) + lu(k,1846) = lu(k,1846) - lu(k,497) * lu(k,1817) + lu(k,1851) = lu(k,1851) - lu(k,498) * lu(k,1817) + lu(k,1857) = - lu(k,499) * lu(k,1817) + lu(k,2193) = lu(k,2193) - lu(k,494) * lu(k,2138) + lu(k,2197) = lu(k,2197) - lu(k,495) * lu(k,2138) + lu(k,2198) = lu(k,2198) - lu(k,496) * lu(k,2138) + lu(k,2199) = lu(k,2199) - lu(k,497) * lu(k,2138) + lu(k,2204) = lu(k,2204) - lu(k,498) * lu(k,2138) + lu(k,2210) = lu(k,2210) - lu(k,499) * lu(k,2138) + lu(k,500) = 1._r8 / lu(k,500) + lu(k,501) = lu(k,501) * lu(k,500) + lu(k,502) = lu(k,502) * lu(k,500) + lu(k,503) = lu(k,503) * lu(k,500) + lu(k,504) = lu(k,504) * lu(k,500) + lu(k,505) = lu(k,505) * lu(k,500) + lu(k,506) = lu(k,506) * lu(k,500) + lu(k,965) = - lu(k,501) * lu(k,964) + lu(k,966) = lu(k,966) - lu(k,502) * lu(k,964) + lu(k,967) = lu(k,967) - lu(k,503) * lu(k,964) + lu(k,969) = lu(k,969) - lu(k,504) * lu(k,964) + lu(k,972) = lu(k,972) - lu(k,505) * lu(k,964) + lu(k,978) = lu(k,978) - lu(k,506) * lu(k,964) + lu(k,1529) = lu(k,1529) - lu(k,501) * lu(k,1525) + lu(k,1530) = lu(k,1530) - lu(k,502) * lu(k,1525) + lu(k,1531) = lu(k,1531) - lu(k,503) * lu(k,1525) + lu(k,1534) = lu(k,1534) - lu(k,504) * lu(k,1525) + lu(k,1540) = lu(k,1540) - lu(k,505) * lu(k,1525) + lu(k,1550) = lu(k,1550) - lu(k,506) * lu(k,1525) + lu(k,2298) = lu(k,2298) - lu(k,501) * lu(k,2291) + lu(k,2301) = lu(k,2301) - lu(k,502) * lu(k,2291) + lu(k,2302) = - lu(k,503) * lu(k,2291) + lu(k,2306) = lu(k,2306) - lu(k,504) * lu(k,2291) + lu(k,2313) = lu(k,2313) - lu(k,505) * lu(k,2291) + lu(k,2327) = lu(k,2327) - lu(k,506) * lu(k,2291) + lu(k,508) = 1._r8 / lu(k,508) + lu(k,509) = lu(k,509) * lu(k,508) + lu(k,510) = lu(k,510) * lu(k,508) + lu(k,511) = lu(k,511) * lu(k,508) + lu(k,512) = lu(k,512) * lu(k,508) + lu(k,513) = lu(k,513) * lu(k,508) + lu(k,514) = lu(k,514) * lu(k,508) + lu(k,1765) = lu(k,1765) - lu(k,509) * lu(k,1718) + lu(k,1783) = lu(k,1783) - lu(k,510) * lu(k,1718) + lu(k,1799) = lu(k,1799) - lu(k,511) * lu(k,1718) + lu(k,1800) = lu(k,1800) - lu(k,512) * lu(k,1718) + lu(k,1804) = lu(k,1804) - lu(k,513) * lu(k,1718) + lu(k,1806) = lu(k,1806) - lu(k,514) * lu(k,1718) + lu(k,2038) = lu(k,2038) - lu(k,509) * lu(k,2011) + lu(k,2055) = lu(k,2055) - lu(k,510) * lu(k,2011) + lu(k,2068) = lu(k,2068) - lu(k,511) * lu(k,2011) + lu(k,2069) = lu(k,2069) - lu(k,512) * lu(k,2011) + lu(k,2073) = lu(k,2073) - lu(k,513) * lu(k,2011) + lu(k,2075) = lu(k,2075) - lu(k,514) * lu(k,2011) + lu(k,2167) = lu(k,2167) - lu(k,509) * lu(k,2139) + lu(k,2182) = lu(k,2182) - lu(k,510) * lu(k,2139) + lu(k,2197) = lu(k,2197) - lu(k,511) * lu(k,2139) + lu(k,2198) = lu(k,2198) - lu(k,512) * lu(k,2139) + lu(k,2202) = lu(k,2202) - lu(k,513) * lu(k,2139) + lu(k,2204) = lu(k,2204) - lu(k,514) * lu(k,2139) + lu(k,515) = 1._r8 / lu(k,515) + lu(k,516) = lu(k,516) * lu(k,515) + lu(k,517) = lu(k,517) * lu(k,515) + lu(k,518) = lu(k,518) * lu(k,515) + lu(k,519) = lu(k,519) * lu(k,515) + lu(k,641) = - lu(k,516) * lu(k,639) + lu(k,642) = - lu(k,517) * lu(k,639) + lu(k,645) = - lu(k,518) * lu(k,639) + lu(k,646) = lu(k,646) - lu(k,519) * lu(k,639) + lu(k,686) = - lu(k,516) * lu(k,684) + lu(k,687) = - lu(k,517) * lu(k,684) + lu(k,691) = - lu(k,518) * lu(k,684) + lu(k,692) = lu(k,692) - lu(k,519) * lu(k,684) + lu(k,1038) = - lu(k,516) * lu(k,1035) + lu(k,1039) = - lu(k,517) * lu(k,1035) + lu(k,1043) = - lu(k,518) * lu(k,1035) + lu(k,1045) = - lu(k,519) * lu(k,1035) + lu(k,1738) = lu(k,1738) - lu(k,516) * lu(k,1719) + lu(k,1754) = lu(k,1754) - lu(k,517) * lu(k,1719) + lu(k,1789) = lu(k,1789) - lu(k,518) * lu(k,1719) + lu(k,1799) = lu(k,1799) - lu(k,519) * lu(k,1719) + lu(k,2021) = lu(k,2021) - lu(k,516) * lu(k,2012) + lu(k,2032) = lu(k,2032) - lu(k,517) * lu(k,2012) + lu(k,2061) = lu(k,2061) - lu(k,518) * lu(k,2012) + lu(k,2068) = lu(k,2068) - lu(k,519) * lu(k,2012) lu(k,521) = 1._r8 / lu(k,521) lu(k,522) = lu(k,522) * lu(k,521) lu(k,523) = lu(k,523) * lu(k,521) lu(k,524) = lu(k,524) * lu(k,521) lu(k,525) = lu(k,525) * lu(k,521) lu(k,526) = lu(k,526) * lu(k,521) - lu(k,1005) = lu(k,1005) - lu(k,522) * lu(k,1002) - lu(k,1015) = lu(k,1015) - lu(k,523) * lu(k,1002) - lu(k,1019) = - lu(k,524) * lu(k,1002) - lu(k,1020) = lu(k,1020) - lu(k,525) * lu(k,1002) - lu(k,1021) = lu(k,1021) - lu(k,526) * lu(k,1002) - lu(k,1045) = lu(k,1045) - lu(k,522) * lu(k,1043) - lu(k,1054) = lu(k,1054) - lu(k,523) * lu(k,1043) - lu(k,1058) = lu(k,1058) - lu(k,524) * lu(k,1043) - lu(k,1059) = lu(k,1059) - lu(k,525) * lu(k,1043) - lu(k,1060) = lu(k,1060) - lu(k,526) * lu(k,1043) - lu(k,1375) = lu(k,1375) - lu(k,522) * lu(k,1368) - lu(k,1400) = lu(k,1400) - lu(k,523) * lu(k,1368) - lu(k,1405) = lu(k,1405) - lu(k,524) * lu(k,1368) - lu(k,1406) = lu(k,1406) - lu(k,525) * lu(k,1368) - lu(k,1407) = lu(k,1407) - lu(k,526) * lu(k,1368) - lu(k,1482) = lu(k,1482) - lu(k,522) * lu(k,1460) - lu(k,1510) = lu(k,1510) - lu(k,523) * lu(k,1460) - lu(k,1516) = lu(k,1516) - lu(k,524) * lu(k,1460) - lu(k,1517) = lu(k,1517) - lu(k,525) * lu(k,1460) - lu(k,1519) = lu(k,1519) - lu(k,526) * lu(k,1460) - lu(k,1687) = lu(k,1687) - lu(k,522) * lu(k,1655) - lu(k,1719) = lu(k,1719) - lu(k,523) * lu(k,1655) - lu(k,1725) = lu(k,1725) - lu(k,524) * lu(k,1655) - lu(k,1726) = lu(k,1726) - lu(k,525) * lu(k,1655) - lu(k,1728) = lu(k,1728) - lu(k,526) * lu(k,1655) - lu(k,529) = 1._r8 / lu(k,529) - lu(k,530) = lu(k,530) * lu(k,529) - lu(k,531) = lu(k,531) * lu(k,529) - lu(k,532) = lu(k,532) * lu(k,529) - lu(k,533) = lu(k,533) * lu(k,529) - lu(k,534) = lu(k,534) * lu(k,529) - lu(k,1507) = lu(k,1507) - lu(k,530) * lu(k,1461) - lu(k,1510) = lu(k,1510) - lu(k,531) * lu(k,1461) - lu(k,1511) = lu(k,1511) - lu(k,532) * lu(k,1461) - lu(k,1517) = lu(k,1517) - lu(k,533) * lu(k,1461) - lu(k,1519) = lu(k,1519) - lu(k,534) * lu(k,1461) - lu(k,1716) = lu(k,1716) - lu(k,530) * lu(k,1656) - lu(k,1719) = lu(k,1719) - lu(k,531) * lu(k,1656) - lu(k,1720) = lu(k,1720) - lu(k,532) * lu(k,1656) - lu(k,1726) = lu(k,1726) - lu(k,533) * lu(k,1656) - lu(k,1728) = lu(k,1728) - lu(k,534) * lu(k,1656) - lu(k,1778) = lu(k,1778) - lu(k,530) * lu(k,1743) - lu(k,1781) = lu(k,1781) - lu(k,531) * lu(k,1743) - lu(k,1782) = lu(k,1782) - lu(k,532) * lu(k,1743) - lu(k,1788) = lu(k,1788) - lu(k,533) * lu(k,1743) - lu(k,1790) = lu(k,1790) - lu(k,534) * lu(k,1743) - lu(k,1984) = lu(k,1984) - lu(k,530) * lu(k,1965) - lu(k,1987) = lu(k,1987) - lu(k,531) * lu(k,1965) - lu(k,1988) = lu(k,1988) - lu(k,532) * lu(k,1965) - lu(k,1994) = lu(k,1994) - lu(k,533) * lu(k,1965) - lu(k,1996) = lu(k,1996) - lu(k,534) * lu(k,1965) - lu(k,2103) = lu(k,2103) - lu(k,530) * lu(k,2056) - lu(k,2106) = lu(k,2106) - lu(k,531) * lu(k,2056) - lu(k,2107) = lu(k,2107) - lu(k,532) * lu(k,2056) - lu(k,2113) = lu(k,2113) - lu(k,533) * lu(k,2056) - lu(k,2115) = lu(k,2115) - lu(k,534) * lu(k,2056) - lu(k,536) = 1._r8 / lu(k,536) - lu(k,537) = lu(k,537) * lu(k,536) - lu(k,538) = lu(k,538) * lu(k,536) - lu(k,539) = lu(k,539) * lu(k,536) - lu(k,540) = lu(k,540) * lu(k,536) - lu(k,541) = lu(k,541) * lu(k,536) - lu(k,542) = lu(k,542) * lu(k,536) - lu(k,543) = lu(k,543) * lu(k,536) - lu(k,544) = lu(k,544) * lu(k,536) - lu(k,545) = lu(k,545) * lu(k,536) - lu(k,878) = lu(k,878) - lu(k,537) * lu(k,876) - lu(k,879) = lu(k,879) - lu(k,538) * lu(k,876) - lu(k,881) = lu(k,881) - lu(k,539) * lu(k,876) - lu(k,882) = lu(k,882) - lu(k,540) * lu(k,876) - lu(k,883) = lu(k,883) - lu(k,541) * lu(k,876) - lu(k,887) = lu(k,887) - lu(k,542) * lu(k,876) - lu(k,888) = lu(k,888) - lu(k,543) * lu(k,876) - lu(k,889) = lu(k,889) - lu(k,544) * lu(k,876) - lu(k,890) = lu(k,890) - lu(k,545) * lu(k,876) - lu(k,1463) = lu(k,1463) - lu(k,537) * lu(k,1462) - lu(k,1479) = lu(k,1479) - lu(k,538) * lu(k,1462) - lu(k,1481) = lu(k,1481) - lu(k,539) * lu(k,1462) - lu(k,1493) = lu(k,1493) - lu(k,540) * lu(k,1462) - lu(k,1503) = lu(k,1503) - lu(k,541) * lu(k,1462) - lu(k,1510) = lu(k,1510) - lu(k,542) * lu(k,1462) - lu(k,1513) = lu(k,1513) - lu(k,543) * lu(k,1462) - lu(k,1517) = lu(k,1517) - lu(k,544) * lu(k,1462) - lu(k,1519) = lu(k,1519) - lu(k,545) * lu(k,1462) - lu(k,1659) = lu(k,1659) - lu(k,537) * lu(k,1657) - lu(k,1681) = lu(k,1681) - lu(k,538) * lu(k,1657) - lu(k,1685) = lu(k,1685) - lu(k,539) * lu(k,1657) - lu(k,1699) = lu(k,1699) - lu(k,540) * lu(k,1657) - lu(k,1710) = lu(k,1710) - lu(k,541) * lu(k,1657) - lu(k,1719) = lu(k,1719) - lu(k,542) * lu(k,1657) - lu(k,1722) = lu(k,1722) - lu(k,543) * lu(k,1657) - lu(k,1726) = lu(k,1726) - lu(k,544) * lu(k,1657) - lu(k,1728) = lu(k,1728) - lu(k,545) * lu(k,1657) + lu(k,1733) = lu(k,1733) - lu(k,522) * lu(k,1720) + lu(k,1799) = lu(k,1799) - lu(k,523) * lu(k,1720) + lu(k,1800) = lu(k,1800) - lu(k,524) * lu(k,1720) + lu(k,1804) = lu(k,1804) - lu(k,525) * lu(k,1720) + lu(k,1806) = lu(k,1806) - lu(k,526) * lu(k,1720) + lu(k,1822) = lu(k,1822) - lu(k,522) * lu(k,1818) + lu(k,1844) = lu(k,1844) - lu(k,523) * lu(k,1818) + lu(k,1845) = lu(k,1845) - lu(k,524) * lu(k,1818) + lu(k,1849) = lu(k,1849) - lu(k,525) * lu(k,1818) + lu(k,1851) = lu(k,1851) - lu(k,526) * lu(k,1818) + lu(k,2019) = lu(k,2019) - lu(k,522) * lu(k,2013) + lu(k,2068) = lu(k,2068) - lu(k,523) * lu(k,2013) + lu(k,2069) = lu(k,2069) - lu(k,524) * lu(k,2013) + lu(k,2073) = lu(k,2073) - lu(k,525) * lu(k,2013) + lu(k,2075) = lu(k,2075) - lu(k,526) * lu(k,2013) + lu(k,2144) = lu(k,2144) - lu(k,522) * lu(k,2140) + lu(k,2197) = lu(k,2197) - lu(k,523) * lu(k,2140) + lu(k,2198) = lu(k,2198) - lu(k,524) * lu(k,2140) + lu(k,2202) = lu(k,2202) - lu(k,525) * lu(k,2140) + lu(k,2204) = lu(k,2204) - lu(k,526) * lu(k,2140) + lu(k,527) = 1._r8 / lu(k,527) + lu(k,528) = lu(k,528) * lu(k,527) + lu(k,529) = lu(k,529) * lu(k,527) + lu(k,530) = lu(k,530) * lu(k,527) + lu(k,531) = lu(k,531) * lu(k,527) + lu(k,679) = lu(k,679) - lu(k,528) * lu(k,673) + lu(k,680) = lu(k,680) - lu(k,529) * lu(k,673) + lu(k,681) = - lu(k,530) * lu(k,673) + lu(k,682) = - lu(k,531) * lu(k,673) + lu(k,845) = lu(k,845) - lu(k,528) * lu(k,842) + lu(k,846) = - lu(k,529) * lu(k,842) + lu(k,847) = - lu(k,530) * lu(k,842) + lu(k,848) = - lu(k,531) * lu(k,842) + lu(k,864) = lu(k,864) - lu(k,528) * lu(k,858) + lu(k,867) = - lu(k,529) * lu(k,858) + lu(k,868) = lu(k,868) - lu(k,530) * lu(k,858) + lu(k,869) = - lu(k,531) * lu(k,858) + lu(k,1534) = lu(k,1534) - lu(k,528) * lu(k,1526) + lu(k,1540) = lu(k,1540) - lu(k,529) * lu(k,1526) + lu(k,1543) = lu(k,1543) - lu(k,530) * lu(k,1526) + lu(k,1547) = lu(k,1547) - lu(k,531) * lu(k,1526) + lu(k,2306) = lu(k,2306) - lu(k,528) * lu(k,2292) + lu(k,2313) = lu(k,2313) - lu(k,529) * lu(k,2292) + lu(k,2316) = - lu(k,530) * lu(k,2292) + lu(k,2322) = lu(k,2322) - lu(k,531) * lu(k,2292) + 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,532) = 1._r8 / lu(k,532) + lu(k,533) = lu(k,533) * lu(k,532) + lu(k,534) = lu(k,534) * lu(k,532) + lu(k,535) = lu(k,535) * lu(k,532) + lu(k,536) = lu(k,536) * lu(k,532) + lu(k,537) = lu(k,537) * lu(k,532) + lu(k,538) = lu(k,538) * lu(k,532) + lu(k,539) = lu(k,539) * lu(k,532) + lu(k,1426) = lu(k,1426) - lu(k,533) * lu(k,1409) + lu(k,1427) = lu(k,1427) - lu(k,534) * lu(k,1409) + lu(k,1429) = lu(k,1429) - lu(k,535) * lu(k,1409) + lu(k,1430) = lu(k,1430) - lu(k,536) * lu(k,1409) + lu(k,1431) = - lu(k,537) * lu(k,1409) + lu(k,1435) = lu(k,1435) - lu(k,538) * lu(k,1409) + lu(k,1437) = lu(k,1437) - lu(k,539) * lu(k,1409) + lu(k,1789) = lu(k,1789) - lu(k,533) * lu(k,1721) + lu(k,1790) = lu(k,1790) - lu(k,534) * lu(k,1721) + lu(k,1799) = lu(k,1799) - lu(k,535) * lu(k,1721) + lu(k,1800) = lu(k,1800) - lu(k,536) * lu(k,1721) + lu(k,1801) = lu(k,1801) - lu(k,537) * lu(k,1721) + lu(k,1807) = lu(k,1807) - lu(k,538) * lu(k,1721) + lu(k,1810) = lu(k,1810) - lu(k,539) * lu(k,1721) + lu(k,1835) = lu(k,1835) - lu(k,533) * lu(k,1819) + lu(k,1836) = - lu(k,534) * lu(k,1819) + lu(k,1844) = lu(k,1844) - lu(k,535) * lu(k,1819) + lu(k,1845) = lu(k,1845) - lu(k,536) * lu(k,1819) + lu(k,1846) = lu(k,1846) - lu(k,537) * lu(k,1819) + lu(k,1852) = - lu(k,538) * lu(k,1819) + lu(k,1855) = - lu(k,539) * lu(k,1819) + lu(k,540) = 1._r8 / lu(k,540) + lu(k,541) = lu(k,541) * lu(k,540) + lu(k,542) = lu(k,542) * lu(k,540) + lu(k,543) = lu(k,543) * lu(k,540) + lu(k,544) = lu(k,544) * lu(k,540) + lu(k,545) = lu(k,545) * lu(k,540) + lu(k,546) = lu(k,546) * lu(k,540) + lu(k,547) = lu(k,547) * lu(k,540) + lu(k,816) = lu(k,816) - lu(k,541) * lu(k,815) + lu(k,817) = lu(k,817) - lu(k,542) * lu(k,815) + lu(k,818) = - lu(k,543) * lu(k,815) + lu(k,820) = - lu(k,544) * lu(k,815) + lu(k,823) = lu(k,823) - lu(k,545) * lu(k,815) + lu(k,824) = lu(k,824) - lu(k,546) * lu(k,815) + lu(k,825) = - lu(k,547) * lu(k,815) + lu(k,1749) = lu(k,1749) - lu(k,541) * lu(k,1722) + lu(k,1773) = lu(k,1773) - lu(k,542) * lu(k,1722) + lu(k,1778) = lu(k,1778) - lu(k,543) * lu(k,1722) + lu(k,1799) = lu(k,1799) - lu(k,544) * lu(k,1722) + lu(k,1806) = lu(k,1806) - lu(k,545) * lu(k,1722) + lu(k,1810) = lu(k,1810) - lu(k,546) * lu(k,1722) + lu(k,1812) = lu(k,1812) - lu(k,547) * lu(k,1722) + lu(k,2158) = lu(k,2158) - lu(k,541) * lu(k,2141) + lu(k,2173) = lu(k,2173) - lu(k,542) * lu(k,2141) + lu(k,2177) = - lu(k,543) * lu(k,2141) + lu(k,2197) = lu(k,2197) - lu(k,544) * lu(k,2141) + lu(k,2204) = lu(k,2204) - lu(k,545) * lu(k,2141) + lu(k,2208) = lu(k,2208) - lu(k,546) * lu(k,2141) + lu(k,2210) = lu(k,2210) - lu(k,547) * lu(k,2141) + lu(k,548) = 1._r8 / lu(k,548) + lu(k,549) = lu(k,549) * lu(k,548) + lu(k,550) = lu(k,550) * lu(k,548) + lu(k,551) = lu(k,551) * lu(k,548) + lu(k,552) = lu(k,552) * lu(k,548) + lu(k,553) = lu(k,553) * lu(k,548) + lu(k,554) = lu(k,554) * lu(k,548) + lu(k,555) = lu(k,555) * lu(k,548) + lu(k,1747) = lu(k,1747) - lu(k,549) * lu(k,1723) + lu(k,1755) = lu(k,1755) - lu(k,550) * lu(k,1723) + lu(k,1774) = lu(k,1774) - lu(k,551) * lu(k,1723) + lu(k,1799) = lu(k,1799) - lu(k,552) * lu(k,1723) + lu(k,1806) = lu(k,1806) - lu(k,553) * lu(k,1723) + lu(k,1810) = lu(k,1810) - lu(k,554) * lu(k,1723) + lu(k,1811) = lu(k,1811) - lu(k,555) * lu(k,1723) + lu(k,1928) = - lu(k,549) * lu(k,1925) + lu(k,1931) = lu(k,1931) - lu(k,550) * lu(k,1925) + lu(k,1937) = lu(k,1937) - lu(k,551) * lu(k,1925) + lu(k,1950) = lu(k,1950) - lu(k,552) * lu(k,1925) + lu(k,1957) = lu(k,1957) - lu(k,553) * lu(k,1925) + lu(k,1961) = lu(k,1961) - lu(k,554) * lu(k,1925) + lu(k,1962) = lu(k,1962) - lu(k,555) * lu(k,1925) + lu(k,2371) = - lu(k,549) * lu(k,2367) + lu(k,2373) = lu(k,2373) - lu(k,550) * lu(k,2367) + lu(k,2386) = lu(k,2386) - lu(k,551) * lu(k,2367) + lu(k,2407) = lu(k,2407) - lu(k,552) * lu(k,2367) + lu(k,2414) = lu(k,2414) - lu(k,553) * lu(k,2367) + lu(k,2418) = lu(k,2418) - lu(k,554) * lu(k,2367) + lu(k,2419) = lu(k,2419) - lu(k,555) * lu(k,2367) + lu(k,556) = 1._r8 / lu(k,556) + lu(k,557) = lu(k,557) * lu(k,556) + lu(k,558) = lu(k,558) * lu(k,556) + lu(k,559) = lu(k,559) * lu(k,556) + lu(k,560) = lu(k,560) * lu(k,556) + lu(k,561) = lu(k,561) * lu(k,556) + lu(k,562) = lu(k,562) * lu(k,556) + lu(k,563) = lu(k,563) * lu(k,556) + lu(k,1319) = - lu(k,557) * lu(k,1315) + lu(k,1323) = lu(k,1323) - lu(k,558) * lu(k,1315) + lu(k,1324) = - lu(k,559) * lu(k,1315) + lu(k,1325) = lu(k,1325) - lu(k,560) * lu(k,1315) + lu(k,1336) = lu(k,1336) - lu(k,561) * lu(k,1315) + lu(k,1339) = - lu(k,562) * lu(k,1315) + lu(k,1341) = lu(k,1341) - lu(k,563) * lu(k,1315) + lu(k,1752) = lu(k,1752) - lu(k,557) * lu(k,1724) + lu(k,1775) = lu(k,1775) - lu(k,558) * lu(k,1724) + lu(k,1777) = lu(k,1777) - lu(k,559) * lu(k,1724) + lu(k,1778) = lu(k,1778) - lu(k,560) * lu(k,1724) + lu(k,1799) = lu(k,1799) - lu(k,561) * lu(k,1724) + lu(k,1803) = lu(k,1803) - lu(k,562) * lu(k,1724) + lu(k,1806) = lu(k,1806) - lu(k,563) * lu(k,1724) + lu(k,2031) = - lu(k,557) * lu(k,2014) + lu(k,2047) = lu(k,2047) - lu(k,558) * lu(k,2014) + lu(k,2049) = lu(k,2049) - lu(k,559) * lu(k,2014) + lu(k,2050) = lu(k,2050) - lu(k,560) * lu(k,2014) + lu(k,2068) = lu(k,2068) - lu(k,561) * lu(k,2014) + lu(k,2072) = lu(k,2072) - lu(k,562) * lu(k,2014) + lu(k,2075) = lu(k,2075) - lu(k,563) * lu(k,2014) + lu(k,564) = 1._r8 / lu(k,564) + lu(k,565) = lu(k,565) * lu(k,564) + lu(k,566) = lu(k,566) * lu(k,564) + lu(k,567) = lu(k,567) * lu(k,564) + lu(k,568) = lu(k,568) * lu(k,564) + lu(k,569) = lu(k,569) * lu(k,564) + lu(k,570) = lu(k,570) * lu(k,564) + lu(k,571) = lu(k,571) * lu(k,564) + lu(k,1557) = lu(k,1557) - lu(k,565) * lu(k,1556) + lu(k,1561) = lu(k,1561) - lu(k,566) * lu(k,1556) + lu(k,1563) = lu(k,1563) - lu(k,567) * lu(k,1556) + lu(k,1567) = lu(k,1567) - lu(k,568) * lu(k,1556) + lu(k,1568) = - lu(k,569) * lu(k,1556) + lu(k,1570) = - lu(k,570) * lu(k,1556) + lu(k,1574) = lu(k,1574) - lu(k,571) * lu(k,1556) + lu(k,1825) = - lu(k,565) * lu(k,1820) + lu(k,1839) = - lu(k,566) * lu(k,1820) + lu(k,1841) = lu(k,1841) - lu(k,567) * lu(k,1820) + lu(k,1845) = lu(k,1845) - lu(k,568) * lu(k,1820) + lu(k,1846) = lu(k,1846) - lu(k,569) * lu(k,1820) + lu(k,1848) = lu(k,1848) - lu(k,570) * lu(k,1820) + lu(k,1854) = lu(k,1854) - lu(k,571) * lu(k,1820) + lu(k,2297) = lu(k,2297) - lu(k,565) * lu(k,2293) + lu(k,2312) = lu(k,2312) - lu(k,566) * lu(k,2293) + lu(k,2314) = lu(k,2314) - lu(k,567) * lu(k,2293) + lu(k,2318) = lu(k,2318) - lu(k,568) * lu(k,2293) + lu(k,2319) = lu(k,2319) - lu(k,569) * lu(k,2293) + lu(k,2321) = - lu(k,570) * lu(k,2293) + lu(k,2327) = lu(k,2327) - lu(k,571) * lu(k,2293) end do end subroutine lu_fac12 subroutine lu_fac13( avec_len, lu ) @@ -1847,148 +1686,68 @@ subroutine lu_fac13( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,547) = 1._r8 / lu(k,547) - lu(k,548) = lu(k,548) * lu(k,547) - lu(k,549) = lu(k,549) * lu(k,547) - lu(k,550) = lu(k,550) * lu(k,547) - lu(k,551) = lu(k,551) * lu(k,547) - lu(k,552) = lu(k,552) * lu(k,547) - lu(k,553) = lu(k,553) * lu(k,547) - lu(k,554) = lu(k,554) * lu(k,547) - lu(k,555) = lu(k,555) * lu(k,547) - lu(k,556) = lu(k,556) * lu(k,547) - lu(k,878) = lu(k,878) - lu(k,548) * lu(k,877) - lu(k,879) = lu(k,879) - lu(k,549) * lu(k,877) - lu(k,880) = lu(k,880) - lu(k,550) * lu(k,877) - lu(k,881) = lu(k,881) - lu(k,551) * lu(k,877) - lu(k,882) = lu(k,882) - lu(k,552) * lu(k,877) - lu(k,883) = lu(k,883) - lu(k,553) * lu(k,877) - lu(k,887) = lu(k,887) - lu(k,554) * lu(k,877) - lu(k,888) = lu(k,888) - lu(k,555) * lu(k,877) - lu(k,890) = lu(k,890) - lu(k,556) * lu(k,877) - lu(k,1659) = lu(k,1659) - lu(k,548) * lu(k,1658) - lu(k,1681) = lu(k,1681) - lu(k,549) * lu(k,1658) - lu(k,1683) = lu(k,1683) - lu(k,550) * lu(k,1658) - lu(k,1685) = lu(k,1685) - lu(k,551) * lu(k,1658) - lu(k,1699) = lu(k,1699) - lu(k,552) * lu(k,1658) - lu(k,1710) = lu(k,1710) - lu(k,553) * lu(k,1658) - lu(k,1719) = lu(k,1719) - lu(k,554) * lu(k,1658) - lu(k,1722) = lu(k,1722) - lu(k,555) * lu(k,1658) - lu(k,1728) = lu(k,1728) - lu(k,556) * lu(k,1658) - lu(k,2058) = lu(k,2058) - lu(k,548) * lu(k,2057) - lu(k,2075) = lu(k,2075) - lu(k,549) * lu(k,2057) - lu(k,2076) = lu(k,2076) - lu(k,550) * lu(k,2057) - lu(k,2077) = lu(k,2077) - lu(k,551) * lu(k,2057) - lu(k,2087) = lu(k,2087) - lu(k,552) * lu(k,2057) - lu(k,2098) = lu(k,2098) - lu(k,553) * lu(k,2057) - lu(k,2106) = lu(k,2106) - lu(k,554) * lu(k,2057) - lu(k,2109) = lu(k,2109) - lu(k,555) * lu(k,2057) - lu(k,2115) = lu(k,2115) - lu(k,556) * lu(k,2057) - lu(k,558) = 1._r8 / lu(k,558) - lu(k,559) = lu(k,559) * lu(k,558) - lu(k,560) = lu(k,560) * lu(k,558) - lu(k,561) = lu(k,561) * lu(k,558) - lu(k,562) = lu(k,562) * lu(k,558) - lu(k,563) = lu(k,563) * lu(k,558) - lu(k,564) = lu(k,564) * lu(k,558) - lu(k,882) = lu(k,882) - lu(k,559) * lu(k,878) - lu(k,883) = lu(k,883) - lu(k,560) * lu(k,878) - lu(k,886) = lu(k,886) - lu(k,561) * lu(k,878) - lu(k,887) = lu(k,887) - lu(k,562) * lu(k,878) - lu(k,889) = lu(k,889) - lu(k,563) * lu(k,878) - lu(k,890) = lu(k,890) - lu(k,564) * lu(k,878) - lu(k,1493) = lu(k,1493) - lu(k,559) * lu(k,1463) - lu(k,1503) = lu(k,1503) - lu(k,560) * lu(k,1463) - lu(k,1507) = lu(k,1507) - lu(k,561) * lu(k,1463) - lu(k,1510) = lu(k,1510) - lu(k,562) * lu(k,1463) - lu(k,1517) = lu(k,1517) - lu(k,563) * lu(k,1463) - lu(k,1519) = lu(k,1519) - lu(k,564) * lu(k,1463) - lu(k,1699) = lu(k,1699) - lu(k,559) * lu(k,1659) - lu(k,1710) = lu(k,1710) - lu(k,560) * lu(k,1659) - lu(k,1716) = lu(k,1716) - lu(k,561) * lu(k,1659) - lu(k,1719) = lu(k,1719) - lu(k,562) * lu(k,1659) - lu(k,1726) = lu(k,1726) - lu(k,563) * lu(k,1659) - lu(k,1728) = lu(k,1728) - lu(k,564) * lu(k,1659) - lu(k,2087) = lu(k,2087) - lu(k,559) * lu(k,2058) - lu(k,2098) = lu(k,2098) - lu(k,560) * lu(k,2058) - lu(k,2103) = lu(k,2103) - lu(k,561) * lu(k,2058) - lu(k,2106) = lu(k,2106) - lu(k,562) * lu(k,2058) - lu(k,2113) = lu(k,2113) - lu(k,563) * lu(k,2058) - lu(k,2115) = lu(k,2115) - lu(k,564) * lu(k,2058) - lu(k,567) = 1._r8 / lu(k,567) - lu(k,568) = lu(k,568) * lu(k,567) - lu(k,569) = lu(k,569) * lu(k,567) - lu(k,570) = lu(k,570) * lu(k,567) - lu(k,571) = lu(k,571) * lu(k,567) - lu(k,572) = lu(k,572) * lu(k,567) - lu(k,573) = lu(k,573) * lu(k,567) - lu(k,574) = lu(k,574) * lu(k,567) - lu(k,575) = lu(k,575) * lu(k,567) - lu(k,576) = lu(k,576) * lu(k,567) - lu(k,699) = lu(k,699) - lu(k,568) * lu(k,698) - lu(k,700) = lu(k,700) - lu(k,569) * lu(k,698) - lu(k,701) = lu(k,701) - lu(k,570) * lu(k,698) - lu(k,702) = lu(k,702) - lu(k,571) * lu(k,698) - lu(k,703) = - lu(k,572) * lu(k,698) - lu(k,704) = lu(k,704) - lu(k,573) * lu(k,698) - lu(k,705) = lu(k,705) - lu(k,574) * lu(k,698) - lu(k,706) = lu(k,706) - lu(k,575) * lu(k,698) - lu(k,707) = lu(k,707) - lu(k,576) * lu(k,698) - lu(k,1418) = lu(k,1418) - lu(k,568) * lu(k,1416) - lu(k,1419) = lu(k,1419) - lu(k,569) * lu(k,1416) - lu(k,1420) = lu(k,1420) - lu(k,570) * lu(k,1416) - lu(k,1421) = lu(k,1421) - lu(k,571) * lu(k,1416) - lu(k,1424) = lu(k,1424) - lu(k,572) * lu(k,1416) - lu(k,1427) = lu(k,1427) - lu(k,573) * lu(k,1416) - lu(k,1428) = lu(k,1428) - lu(k,574) * lu(k,1416) - lu(k,1430) = lu(k,1430) - lu(k,575) * lu(k,1416) - lu(k,1433) = lu(k,1433) - lu(k,576) * lu(k,1416) - lu(k,1804) = lu(k,1804) - lu(k,568) * lu(k,1801) - lu(k,1805) = lu(k,1805) - lu(k,569) * lu(k,1801) - lu(k,1806) = lu(k,1806) - lu(k,570) * lu(k,1801) - lu(k,1807) = lu(k,1807) - lu(k,571) * lu(k,1801) - lu(k,1812) = lu(k,1812) - lu(k,572) * lu(k,1801) - lu(k,1818) = lu(k,1818) - lu(k,573) * lu(k,1801) - lu(k,1819) = lu(k,1819) - lu(k,574) * lu(k,1801) - lu(k,1821) = lu(k,1821) - lu(k,575) * lu(k,1801) - lu(k,1824) = lu(k,1824) - lu(k,576) * lu(k,1801) - 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,1123) = - lu(k,579) * lu(k,1117) - lu(k,1125) = - lu(k,580) * lu(k,1117) - lu(k,1127) = - lu(k,581) * lu(k,1117) - lu(k,1131) = lu(k,1131) - lu(k,582) * lu(k,1117) - lu(k,1132) = lu(k,1132) - lu(k,583) * lu(k,1117) - lu(k,1137) = lu(k,1137) - lu(k,584) * lu(k,1117) - lu(k,1169) = - lu(k,579) * lu(k,1161) - lu(k,1170) = lu(k,1170) - lu(k,580) * lu(k,1161) - lu(k,1174) = lu(k,1174) - lu(k,581) * lu(k,1161) - lu(k,1179) = lu(k,1179) - lu(k,582) * lu(k,1161) - lu(k,1181) = lu(k,1181) - lu(k,583) * lu(k,1161) - lu(k,1186) = lu(k,1186) - lu(k,584) * lu(k,1161) - lu(k,1203) = lu(k,1203) - lu(k,579) * lu(k,1192) - lu(k,1204) = - lu(k,580) * lu(k,1192) - lu(k,1208) = - lu(k,581) * lu(k,1192) - lu(k,1213) = lu(k,1213) - lu(k,582) * lu(k,1192) - lu(k,1215) = lu(k,1215) - lu(k,583) * lu(k,1192) - lu(k,1220) = lu(k,1220) - lu(k,584) * lu(k,1192) - lu(k,1700) = lu(k,1700) - lu(k,579) * lu(k,1660) - lu(k,1703) = lu(k,1703) - lu(k,580) * lu(k,1660) - lu(k,1708) = lu(k,1708) - lu(k,581) * lu(k,1660) - lu(k,1719) = lu(k,1719) - lu(k,582) * lu(k,1660) - lu(k,1722) = lu(k,1722) - lu(k,583) * lu(k,1660) - lu(k,1728) = lu(k,1728) - lu(k,584) * lu(k,1660) - lu(k,2088) = lu(k,2088) - lu(k,579) * lu(k,2059) - lu(k,2091) = - lu(k,580) * lu(k,2059) - lu(k,2096) = - lu(k,581) * lu(k,2059) - lu(k,2106) = lu(k,2106) - lu(k,582) * lu(k,2059) - lu(k,2109) = lu(k,2109) - lu(k,583) * lu(k,2059) - lu(k,2115) = lu(k,2115) - lu(k,584) * lu(k,2059) + lu(k,572) = 1._r8 / lu(k,572) + lu(k,573) = lu(k,573) * lu(k,572) + lu(k,574) = lu(k,574) * lu(k,572) + lu(k,575) = lu(k,575) * lu(k,572) + lu(k,576) = lu(k,576) * lu(k,572) + lu(k,577) = lu(k,577) * lu(k,572) + lu(k,578) = lu(k,578) * lu(k,572) + lu(k,579) = lu(k,579) * lu(k,572) + lu(k,1768) = lu(k,1768) - lu(k,573) * lu(k,1725) + lu(k,1773) = lu(k,1773) - lu(k,574) * lu(k,1725) + lu(k,1777) = lu(k,1777) - lu(k,575) * lu(k,1725) + lu(k,1800) = lu(k,1800) - lu(k,576) * lu(k,1725) + lu(k,1804) = lu(k,1804) - lu(k,577) * lu(k,1725) + lu(k,1806) = lu(k,1806) - lu(k,578) * lu(k,1725) + lu(k,1810) = lu(k,1810) - lu(k,579) * lu(k,1725) + lu(k,1875) = lu(k,1875) - lu(k,573) * lu(k,1864) + lu(k,1880) = lu(k,1880) - lu(k,574) * lu(k,1864) + lu(k,1884) = - lu(k,575) * lu(k,1864) + lu(k,1905) = lu(k,1905) - lu(k,576) * lu(k,1864) + lu(k,1909) = lu(k,1909) - lu(k,577) * lu(k,1864) + lu(k,1911) = lu(k,1911) - lu(k,578) * lu(k,1864) + lu(k,1915) = lu(k,1915) - lu(k,579) * lu(k,1864) + lu(k,2041) = lu(k,2041) - lu(k,573) * lu(k,2015) + lu(k,2045) = lu(k,2045) - lu(k,574) * lu(k,2015) + lu(k,2049) = lu(k,2049) - lu(k,575) * lu(k,2015) + lu(k,2069) = lu(k,2069) - lu(k,576) * lu(k,2015) + lu(k,2073) = lu(k,2073) - lu(k,577) * lu(k,2015) + lu(k,2075) = lu(k,2075) - lu(k,578) * lu(k,2015) + lu(k,2079) = lu(k,2079) - lu(k,579) * lu(k,2015) + lu(k,580) = 1._r8 / lu(k,580) + lu(k,581) = lu(k,581) * lu(k,580) + lu(k,582) = lu(k,582) * lu(k,580) + lu(k,583) = lu(k,583) * lu(k,580) + lu(k,584) = lu(k,584) * lu(k,580) + lu(k,585) = lu(k,585) * lu(k,580) + lu(k,586) = lu(k,586) * lu(k,580) + lu(k,587) = lu(k,587) * lu(k,580) + lu(k,588) = lu(k,588) * lu(k,580) + lu(k,1393) = - lu(k,581) * lu(k,1390) + lu(k,1395) = lu(k,1395) - lu(k,582) * lu(k,1390) + lu(k,1397) = lu(k,1397) - lu(k,583) * lu(k,1390) + lu(k,1398) = lu(k,1398) - lu(k,584) * lu(k,1390) + lu(k,1399) = lu(k,1399) - lu(k,585) * lu(k,1390) + lu(k,1400) = lu(k,1400) - lu(k,586) * lu(k,1390) + lu(k,1403) = lu(k,1403) - lu(k,587) * lu(k,1390) + lu(k,1405) = lu(k,1405) - lu(k,588) * lu(k,1390) + lu(k,1778) = lu(k,1778) - lu(k,581) * lu(k,1726) + lu(k,1788) = lu(k,1788) - lu(k,582) * lu(k,1726) + lu(k,1790) = lu(k,1790) - lu(k,583) * lu(k,1726) + lu(k,1799) = lu(k,1799) - lu(k,584) * lu(k,1726) + lu(k,1800) = lu(k,1800) - lu(k,585) * lu(k,1726) + lu(k,1801) = lu(k,1801) - lu(k,586) * lu(k,1726) + lu(k,1806) = lu(k,1806) - lu(k,587) * lu(k,1726) + lu(k,1810) = lu(k,1810) - lu(k,588) * lu(k,1726) + lu(k,1832) = - lu(k,581) * lu(k,1821) + lu(k,1834) = lu(k,1834) - lu(k,582) * lu(k,1821) + lu(k,1836) = lu(k,1836) - lu(k,583) * lu(k,1821) + lu(k,1844) = lu(k,1844) - lu(k,584) * lu(k,1821) + lu(k,1845) = lu(k,1845) - lu(k,585) * lu(k,1821) + lu(k,1846) = lu(k,1846) - lu(k,586) * lu(k,1821) + lu(k,1851) = lu(k,1851) - lu(k,587) * lu(k,1821) + lu(k,1855) = lu(k,1855) - lu(k,588) * lu(k,1821) lu(k,589) = 1._r8 / lu(k,589) lu(k,590) = lu(k,590) * lu(k,589) lu(k,591) = lu(k,591) * lu(k,589) @@ -1998,38 +1757,91 @@ subroutine lu_fac13( avec_len, lu ) lu(k,595) = lu(k,595) * lu(k,589) lu(k,596) = lu(k,596) * lu(k,589) lu(k,597) = lu(k,597) * lu(k,589) - lu(k,598) = lu(k,598) * lu(k,589) - lu(k,599) = lu(k,599) * lu(k,589) - lu(k,633) = lu(k,633) - lu(k,590) * lu(k,632) - lu(k,634) = lu(k,634) - lu(k,591) * lu(k,632) - lu(k,635) = lu(k,635) - lu(k,592) * lu(k,632) - lu(k,636) = lu(k,636) - lu(k,593) * lu(k,632) - lu(k,637) = lu(k,637) - lu(k,594) * lu(k,632) - lu(k,638) = lu(k,638) - lu(k,595) * lu(k,632) - lu(k,639) = lu(k,639) - lu(k,596) * lu(k,632) - lu(k,640) = lu(k,640) - lu(k,597) * lu(k,632) - lu(k,642) = - lu(k,598) * lu(k,632) - lu(k,644) = lu(k,644) - lu(k,599) * lu(k,632) - lu(k,1663) = lu(k,1663) - lu(k,590) * lu(k,1661) - lu(k,1665) = lu(k,1665) - lu(k,591) * lu(k,1661) - lu(k,1666) = lu(k,1666) - lu(k,592) * lu(k,1661) - lu(k,1678) = lu(k,1678) - lu(k,593) * lu(k,1661) - lu(k,1679) = lu(k,1679) - lu(k,594) * lu(k,1661) - lu(k,1694) = lu(k,1694) - lu(k,595) * lu(k,1661) - lu(k,1704) = lu(k,1704) - lu(k,596) * lu(k,1661) - lu(k,1710) = lu(k,1710) - lu(k,597) * lu(k,1661) - lu(k,1719) = lu(k,1719) - lu(k,598) * lu(k,1661) - lu(k,1728) = lu(k,1728) - lu(k,599) * lu(k,1661) - lu(k,2061) = lu(k,2061) - lu(k,590) * lu(k,2060) - lu(k,2063) = lu(k,2063) - lu(k,591) * lu(k,2060) - lu(k,2064) = lu(k,2064) - lu(k,592) * lu(k,2060) - lu(k,2073) = lu(k,2073) - lu(k,593) * lu(k,2060) - lu(k,2074) = lu(k,2074) - lu(k,594) * lu(k,2060) - lu(k,2082) = lu(k,2082) - lu(k,595) * lu(k,2060) - lu(k,2092) = lu(k,2092) - lu(k,596) * lu(k,2060) - lu(k,2098) = lu(k,2098) - lu(k,597) * lu(k,2060) - lu(k,2106) = lu(k,2106) - lu(k,598) * lu(k,2060) - lu(k,2115) = lu(k,2115) - lu(k,599) * lu(k,2060) + lu(k,1290) = - lu(k,590) * lu(k,1287) + lu(k,1291) = - lu(k,591) * lu(k,1287) + lu(k,1292) = - lu(k,592) * lu(k,1287) + lu(k,1303) = - lu(k,593) * lu(k,1287) + lu(k,1304) = lu(k,1304) - lu(k,594) * lu(k,1287) + lu(k,1306) = - lu(k,595) * lu(k,1287) + lu(k,1308) = lu(k,1308) - lu(k,596) * lu(k,1287) + lu(k,1310) = lu(k,1310) - lu(k,597) * lu(k,1287) + lu(k,1775) = lu(k,1775) - lu(k,590) * lu(k,1727) + lu(k,1777) = lu(k,1777) - lu(k,591) * lu(k,1727) + lu(k,1778) = lu(k,1778) - lu(k,592) * lu(k,1727) + lu(k,1799) = lu(k,1799) - lu(k,593) * lu(k,1727) + lu(k,1800) = lu(k,1800) - lu(k,594) * lu(k,1727) + lu(k,1803) = lu(k,1803) - lu(k,595) * lu(k,1727) + lu(k,1806) = lu(k,1806) - lu(k,596) * lu(k,1727) + lu(k,1810) = lu(k,1810) - lu(k,597) * lu(k,1727) + lu(k,2047) = lu(k,2047) - lu(k,590) * lu(k,2016) + lu(k,2049) = lu(k,2049) - lu(k,591) * lu(k,2016) + lu(k,2050) = lu(k,2050) - lu(k,592) * lu(k,2016) + lu(k,2068) = lu(k,2068) - lu(k,593) * lu(k,2016) + lu(k,2069) = lu(k,2069) - lu(k,594) * lu(k,2016) + lu(k,2072) = lu(k,2072) - lu(k,595) * lu(k,2016) + lu(k,2075) = lu(k,2075) - lu(k,596) * lu(k,2016) + lu(k,2079) = lu(k,2079) - lu(k,597) * lu(k,2016) + lu(k,598) = 1._r8 / lu(k,598) + lu(k,599) = lu(k,599) * lu(k,598) + lu(k,600) = lu(k,600) * lu(k,598) + lu(k,601) = lu(k,601) * lu(k,598) + lu(k,667) = - lu(k,599) * lu(k,662) + lu(k,669) = - lu(k,600) * lu(k,662) + lu(k,672) = lu(k,672) - lu(k,601) * lu(k,662) + lu(k,723) = - lu(k,599) * lu(k,718) + lu(k,725) = lu(k,725) - lu(k,600) * lu(k,718) + lu(k,729) = lu(k,729) - lu(k,601) * lu(k,718) + lu(k,751) = - lu(k,599) * lu(k,746) + lu(k,753) = - lu(k,600) * lu(k,746) + lu(k,758) = lu(k,758) - lu(k,601) * lu(k,746) + lu(k,767) = - lu(k,599) * lu(k,762) + lu(k,769) = lu(k,769) - lu(k,600) * lu(k,762) + lu(k,775) = lu(k,775) - lu(k,601) * lu(k,762) + lu(k,1113) = - lu(k,599) * lu(k,1111) + lu(k,1116) = - lu(k,600) * lu(k,1111) + lu(k,1124) = lu(k,1124) - lu(k,601) * lu(k,1111) + lu(k,1320) = - lu(k,599) * lu(k,1316) + lu(k,1322) = - lu(k,600) * lu(k,1316) + lu(k,1341) = lu(k,1341) - lu(k,601) * lu(k,1316) + lu(k,1756) = - lu(k,599) * lu(k,1728) + lu(k,1774) = lu(k,1774) - lu(k,600) * lu(k,1728) + lu(k,1806) = lu(k,1806) - lu(k,601) * lu(k,1728) + lu(k,2034) = lu(k,2034) - lu(k,599) * lu(k,2017) + lu(k,2046) = lu(k,2046) - lu(k,600) * lu(k,2017) + lu(k,2075) = lu(k,2075) - lu(k,601) * lu(k,2017) + 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,1628) = lu(k,1628) - lu(k,603) * lu(k,1624) + lu(k,1629) = lu(k,1629) - lu(k,604) * lu(k,1624) + lu(k,1633) = lu(k,1633) - lu(k,605) * lu(k,1624) + lu(k,1634) = lu(k,1634) - lu(k,606) * lu(k,1624) + lu(k,1637) = lu(k,1637) - lu(k,607) * lu(k,1624) + lu(k,1641) = lu(k,1641) - lu(k,608) * lu(k,1624) + lu(k,1642) = lu(k,1642) - lu(k,609) * lu(k,1624) + lu(k,1647) = lu(k,1647) - lu(k,610) * lu(k,1624) + lu(k,1793) = lu(k,1793) - lu(k,603) * lu(k,1729) + lu(k,1794) = lu(k,1794) - lu(k,604) * lu(k,1729) + lu(k,1798) = lu(k,1798) - lu(k,605) * lu(k,1729) + lu(k,1799) = lu(k,1799) - lu(k,606) * lu(k,1729) + lu(k,1802) = lu(k,1802) - lu(k,607) * lu(k,1729) + lu(k,1806) = lu(k,1806) - lu(k,608) * lu(k,1729) + lu(k,1807) = lu(k,1807) - lu(k,609) * lu(k,1729) + lu(k,1812) = lu(k,1812) - lu(k,610) * lu(k,1729) + lu(k,1944) = lu(k,1944) - lu(k,603) * lu(k,1926) + lu(k,1945) = lu(k,1945) - lu(k,604) * lu(k,1926) + lu(k,1949) = lu(k,1949) - lu(k,605) * lu(k,1926) + lu(k,1950) = lu(k,1950) - lu(k,606) * lu(k,1926) + lu(k,1953) = lu(k,1953) - lu(k,607) * lu(k,1926) + lu(k,1957) = lu(k,1957) - lu(k,608) * lu(k,1926) + lu(k,1958) = lu(k,1958) - lu(k,609) * lu(k,1926) + lu(k,1963) = lu(k,1963) - lu(k,610) * lu(k,1926) end do end subroutine lu_fac13 subroutine lu_fac14( avec_len, lu ) @@ -2046,79 +1858,37 @@ subroutine lu_fac14( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,600) = 1._r8 / lu(k,600) - lu(k,601) = lu(k,601) * lu(k,600) - lu(k,602) = lu(k,602) * lu(k,600) - lu(k,603) = lu(k,603) * lu(k,600) - lu(k,604) = lu(k,604) * lu(k,600) - lu(k,605) = lu(k,605) * lu(k,600) - lu(k,606) = lu(k,606) * lu(k,600) - lu(k,1318) = lu(k,1318) - lu(k,601) * lu(k,1316) - lu(k,1320) = lu(k,1320) - lu(k,602) * lu(k,1316) - lu(k,1323) = lu(k,1323) - lu(k,603) * lu(k,1316) - lu(k,1324) = lu(k,1324) - lu(k,604) * lu(k,1316) - lu(k,1325) = lu(k,1325) - lu(k,605) * lu(k,1316) - lu(k,1326) = lu(k,1326) - lu(k,606) * lu(k,1316) - lu(k,1425) = lu(k,1425) - lu(k,601) * lu(k,1417) - lu(k,1427) = lu(k,1427) - lu(k,602) * lu(k,1417) - lu(k,1431) = - lu(k,603) * lu(k,1417) - lu(k,1432) = lu(k,1432) - lu(k,604) * lu(k,1417) - lu(k,1433) = lu(k,1433) - lu(k,605) * lu(k,1417) - lu(k,1435) = lu(k,1435) - lu(k,606) * lu(k,1417) - lu(k,1711) = lu(k,1711) - lu(k,601) * lu(k,1662) - lu(k,1715) = lu(k,1715) - lu(k,602) * lu(k,1662) - lu(k,1719) = lu(k,1719) - lu(k,603) * lu(k,1662) - lu(k,1720) = lu(k,1720) - lu(k,604) * lu(k,1662) - lu(k,1721) = lu(k,1721) - lu(k,605) * lu(k,1662) - lu(k,1724) = lu(k,1724) - lu(k,606) * lu(k,1662) - lu(k,1774) = lu(k,1774) - lu(k,601) * lu(k,1744) - lu(k,1777) = lu(k,1777) - lu(k,602) * lu(k,1744) - lu(k,1781) = lu(k,1781) - lu(k,603) * lu(k,1744) - lu(k,1782) = lu(k,1782) - lu(k,604) * lu(k,1744) - lu(k,1783) = lu(k,1783) - lu(k,605) * lu(k,1744) - lu(k,1786) = lu(k,1786) - lu(k,606) * lu(k,1744) - lu(k,1814) = lu(k,1814) - lu(k,601) * lu(k,1802) - lu(k,1818) = lu(k,1818) - lu(k,602) * lu(k,1802) - lu(k,1822) = lu(k,1822) - lu(k,603) * lu(k,1802) - lu(k,1823) = lu(k,1823) - lu(k,604) * lu(k,1802) - lu(k,1824) = lu(k,1824) - lu(k,605) * lu(k,1802) - lu(k,1827) = lu(k,1827) - lu(k,606) * lu(k,1802) - lu(k,607) = 1._r8 / lu(k,607) - lu(k,608) = lu(k,608) * lu(k,607) - lu(k,609) = lu(k,609) * lu(k,607) - lu(k,610) = lu(k,610) * lu(k,607) - lu(k,611) = lu(k,611) * lu(k,607) - lu(k,612) = lu(k,612) * lu(k,607) - lu(k,620) = lu(k,620) - lu(k,608) * lu(k,617) - lu(k,622) = lu(k,622) - lu(k,609) * lu(k,617) - lu(k,624) = lu(k,624) - lu(k,610) * lu(k,617) - lu(k,626) = lu(k,626) - lu(k,611) * lu(k,617) - lu(k,627) = lu(k,627) - lu(k,612) * lu(k,617) - lu(k,636) = lu(k,636) - lu(k,608) * lu(k,633) - lu(k,638) = lu(k,638) - lu(k,609) * lu(k,633) - lu(k,641) = lu(k,641) - lu(k,610) * lu(k,633) - lu(k,643) = lu(k,643) - lu(k,611) * lu(k,633) - lu(k,644) = lu(k,644) - lu(k,612) * lu(k,633) - lu(k,1477) = lu(k,1477) - lu(k,608) * lu(k,1464) - lu(k,1488) = lu(k,1488) - lu(k,609) * lu(k,1464) - lu(k,1507) = lu(k,1507) - lu(k,610) * lu(k,1464) - lu(k,1517) = lu(k,1517) - lu(k,611) * lu(k,1464) - lu(k,1519) = lu(k,1519) - lu(k,612) * lu(k,1464) - lu(k,1678) = lu(k,1678) - lu(k,608) * lu(k,1663) - lu(k,1694) = lu(k,1694) - lu(k,609) * lu(k,1663) - lu(k,1716) = lu(k,1716) - lu(k,610) * lu(k,1663) - lu(k,1726) = lu(k,1726) - lu(k,611) * lu(k,1663) - lu(k,1728) = lu(k,1728) - lu(k,612) * lu(k,1663) - lu(k,1970) = - lu(k,608) * lu(k,1966) - lu(k,1975) = - lu(k,609) * lu(k,1966) - lu(k,1984) = lu(k,1984) - lu(k,610) * lu(k,1966) - lu(k,1994) = lu(k,1994) - lu(k,611) * lu(k,1966) - lu(k,1996) = lu(k,1996) - lu(k,612) * lu(k,1966) - lu(k,2073) = lu(k,2073) - lu(k,608) * lu(k,2061) - lu(k,2082) = lu(k,2082) - lu(k,609) * lu(k,2061) - lu(k,2103) = lu(k,2103) - lu(k,610) * lu(k,2061) - lu(k,2113) = lu(k,2113) - lu(k,611) * lu(k,2061) - lu(k,2115) = lu(k,2115) - lu(k,612) * lu(k,2061) + lu(k,611) = 1._r8 / lu(k,611) + lu(k,612) = lu(k,612) * lu(k,611) + lu(k,613) = lu(k,613) * lu(k,611) + lu(k,614) = lu(k,614) * lu(k,611) + lu(k,615) = lu(k,615) * lu(k,611) + lu(k,616) = lu(k,616) * lu(k,611) + lu(k,617) = lu(k,617) * lu(k,611) + lu(k,1793) = lu(k,1793) - lu(k,612) * lu(k,1730) + lu(k,1799) = lu(k,1799) - lu(k,613) * lu(k,1730) + lu(k,1802) = lu(k,1802) - lu(k,614) * lu(k,1730) + lu(k,1806) = lu(k,1806) - lu(k,615) * lu(k,1730) + lu(k,1809) = lu(k,1809) - lu(k,616) * lu(k,1730) + lu(k,1812) = lu(k,1812) - lu(k,617) * lu(k,1730) + lu(k,1944) = lu(k,1944) - lu(k,612) * lu(k,1927) + lu(k,1950) = lu(k,1950) - lu(k,613) * lu(k,1927) + lu(k,1953) = lu(k,1953) - lu(k,614) * lu(k,1927) + lu(k,1957) = lu(k,1957) - lu(k,615) * lu(k,1927) + lu(k,1960) = - lu(k,616) * lu(k,1927) + lu(k,1963) = lu(k,1963) - lu(k,617) * lu(k,1927) + lu(k,2191) = lu(k,2191) - lu(k,612) * lu(k,2142) + lu(k,2197) = lu(k,2197) - lu(k,613) * lu(k,2142) + lu(k,2200) = lu(k,2200) - lu(k,614) * lu(k,2142) + lu(k,2204) = lu(k,2204) - lu(k,615) * lu(k,2142) + lu(k,2207) = lu(k,2207) - lu(k,616) * lu(k,2142) + lu(k,2210) = lu(k,2210) - lu(k,617) * lu(k,2142) + lu(k,2311) = lu(k,2311) - lu(k,612) * lu(k,2294) + lu(k,2317) = lu(k,2317) - lu(k,613) * lu(k,2294) + lu(k,2320) = lu(k,2320) - lu(k,614) * lu(k,2294) + lu(k,2324) = lu(k,2324) - lu(k,615) * lu(k,2294) + lu(k,2327) = lu(k,2327) - lu(k,616) * lu(k,2294) + lu(k,2330) = - lu(k,617) * lu(k,2294) lu(k,618) = 1._r8 / lu(k,618) lu(k,619) = lu(k,619) * lu(k,618) lu(k,620) = lu(k,620) * lu(k,618) @@ -2126,156 +1896,166 @@ subroutine lu_fac14( avec_len, lu ) lu(k,622) = lu(k,622) * lu(k,618) lu(k,623) = lu(k,623) * lu(k,618) lu(k,624) = lu(k,624) * lu(k,618) - lu(k,625) = lu(k,625) * lu(k,618) - lu(k,626) = lu(k,626) * lu(k,618) - lu(k,627) = lu(k,627) * lu(k,618) - lu(k,1467) = lu(k,1467) - lu(k,619) * lu(k,1465) - lu(k,1477) = lu(k,1477) - lu(k,620) * lu(k,1465) - lu(k,1478) = lu(k,1478) - lu(k,621) * lu(k,1465) - lu(k,1488) = lu(k,1488) - lu(k,622) * lu(k,1465) - lu(k,1497) = lu(k,1497) - lu(k,623) * lu(k,1465) - lu(k,1507) = lu(k,1507) - lu(k,624) * lu(k,1465) - lu(k,1510) = lu(k,1510) - lu(k,625) * lu(k,1465) - lu(k,1517) = lu(k,1517) - lu(k,626) * lu(k,1465) - lu(k,1519) = lu(k,1519) - lu(k,627) * lu(k,1465) - lu(k,1666) = lu(k,1666) - lu(k,619) * lu(k,1664) - lu(k,1678) = lu(k,1678) - lu(k,620) * lu(k,1664) - lu(k,1679) = lu(k,1679) - lu(k,621) * lu(k,1664) - lu(k,1694) = lu(k,1694) - lu(k,622) * lu(k,1664) - lu(k,1704) = lu(k,1704) - lu(k,623) * lu(k,1664) - lu(k,1716) = lu(k,1716) - lu(k,624) * lu(k,1664) - lu(k,1719) = lu(k,1719) - lu(k,625) * lu(k,1664) - lu(k,1726) = lu(k,1726) - lu(k,626) * lu(k,1664) - lu(k,1728) = lu(k,1728) - lu(k,627) * lu(k,1664) - lu(k,2064) = lu(k,2064) - lu(k,619) * lu(k,2062) - lu(k,2073) = lu(k,2073) - lu(k,620) * lu(k,2062) - lu(k,2074) = lu(k,2074) - lu(k,621) * lu(k,2062) - lu(k,2082) = lu(k,2082) - lu(k,622) * lu(k,2062) - lu(k,2092) = lu(k,2092) - lu(k,623) * lu(k,2062) - lu(k,2103) = lu(k,2103) - lu(k,624) * lu(k,2062) - lu(k,2106) = lu(k,2106) - lu(k,625) * lu(k,2062) - lu(k,2113) = lu(k,2113) - lu(k,626) * lu(k,2062) - lu(k,2115) = lu(k,2115) - lu(k,627) * lu(k,2062) - lu(k,634) = 1._r8 / lu(k,634) - lu(k,635) = lu(k,635) * lu(k,634) - lu(k,636) = lu(k,636) * lu(k,634) - lu(k,637) = lu(k,637) * lu(k,634) - lu(k,638) = lu(k,638) * lu(k,634) - lu(k,639) = lu(k,639) * lu(k,634) - lu(k,640) = lu(k,640) * lu(k,634) - lu(k,641) = lu(k,641) * lu(k,634) - lu(k,642) = lu(k,642) * lu(k,634) - lu(k,643) = lu(k,643) * lu(k,634) - lu(k,644) = lu(k,644) * lu(k,634) - lu(k,1467) = lu(k,1467) - lu(k,635) * lu(k,1466) - lu(k,1477) = lu(k,1477) - lu(k,636) * lu(k,1466) - lu(k,1478) = lu(k,1478) - lu(k,637) * lu(k,1466) - lu(k,1488) = lu(k,1488) - lu(k,638) * lu(k,1466) - lu(k,1497) = lu(k,1497) - lu(k,639) * lu(k,1466) - lu(k,1503) = lu(k,1503) - lu(k,640) * lu(k,1466) - lu(k,1507) = lu(k,1507) - lu(k,641) * lu(k,1466) - lu(k,1510) = lu(k,1510) - lu(k,642) * lu(k,1466) - lu(k,1517) = lu(k,1517) - lu(k,643) * lu(k,1466) - lu(k,1519) = lu(k,1519) - lu(k,644) * lu(k,1466) - lu(k,1666) = lu(k,1666) - lu(k,635) * lu(k,1665) - lu(k,1678) = lu(k,1678) - lu(k,636) * lu(k,1665) - lu(k,1679) = lu(k,1679) - lu(k,637) * lu(k,1665) - lu(k,1694) = lu(k,1694) - lu(k,638) * lu(k,1665) - lu(k,1704) = lu(k,1704) - lu(k,639) * lu(k,1665) - lu(k,1710) = lu(k,1710) - lu(k,640) * lu(k,1665) - lu(k,1716) = lu(k,1716) - lu(k,641) * lu(k,1665) - lu(k,1719) = lu(k,1719) - lu(k,642) * lu(k,1665) - lu(k,1726) = lu(k,1726) - lu(k,643) * lu(k,1665) - lu(k,1728) = lu(k,1728) - lu(k,644) * lu(k,1665) - lu(k,2064) = lu(k,2064) - lu(k,635) * lu(k,2063) - lu(k,2073) = lu(k,2073) - lu(k,636) * lu(k,2063) - lu(k,2074) = lu(k,2074) - lu(k,637) * lu(k,2063) - lu(k,2082) = lu(k,2082) - lu(k,638) * lu(k,2063) - lu(k,2092) = lu(k,2092) - lu(k,639) * lu(k,2063) - lu(k,2098) = lu(k,2098) - lu(k,640) * lu(k,2063) - lu(k,2103) = lu(k,2103) - lu(k,641) * lu(k,2063) - lu(k,2106) = lu(k,2106) - lu(k,642) * lu(k,2063) - lu(k,2113) = lu(k,2113) - lu(k,643) * lu(k,2063) - lu(k,2115) = lu(k,2115) - lu(k,644) * lu(k,2063) - lu(k,645) = 1._r8 / lu(k,645) - lu(k,646) = lu(k,646) * lu(k,645) - lu(k,647) = lu(k,647) * lu(k,645) - lu(k,648) = lu(k,648) * lu(k,645) - lu(k,649) = lu(k,649) * lu(k,645) - lu(k,650) = lu(k,650) * lu(k,645) - lu(k,651) = lu(k,651) * lu(k,645) - lu(k,652) = lu(k,652) * lu(k,645) - lu(k,1488) = lu(k,1488) - lu(k,646) * lu(k,1467) - lu(k,1497) = lu(k,1497) - lu(k,647) * lu(k,1467) - lu(k,1505) = lu(k,1505) - lu(k,648) * lu(k,1467) - lu(k,1507) = lu(k,1507) - lu(k,649) * lu(k,1467) - lu(k,1510) = lu(k,1510) - lu(k,650) * lu(k,1467) - lu(k,1517) = lu(k,1517) - lu(k,651) * lu(k,1467) - lu(k,1519) = lu(k,1519) - lu(k,652) * lu(k,1467) - lu(k,1694) = lu(k,1694) - lu(k,646) * lu(k,1666) - lu(k,1704) = lu(k,1704) - lu(k,647) * lu(k,1666) - lu(k,1714) = lu(k,1714) - lu(k,648) * lu(k,1666) - lu(k,1716) = lu(k,1716) - lu(k,649) * lu(k,1666) - lu(k,1719) = lu(k,1719) - lu(k,650) * lu(k,1666) - lu(k,1726) = lu(k,1726) - lu(k,651) * lu(k,1666) - lu(k,1728) = lu(k,1728) - lu(k,652) * lu(k,1666) - lu(k,1975) = lu(k,1975) - lu(k,646) * lu(k,1967) - lu(k,1976) = - lu(k,647) * lu(k,1967) - lu(k,1982) = lu(k,1982) - lu(k,648) * lu(k,1967) - lu(k,1984) = lu(k,1984) - lu(k,649) * lu(k,1967) - lu(k,1987) = lu(k,1987) - lu(k,650) * lu(k,1967) - lu(k,1994) = lu(k,1994) - lu(k,651) * lu(k,1967) - lu(k,1996) = lu(k,1996) - lu(k,652) * lu(k,1967) - lu(k,2082) = lu(k,2082) - lu(k,646) * lu(k,2064) - lu(k,2092) = lu(k,2092) - lu(k,647) * lu(k,2064) - lu(k,2101) = lu(k,2101) - lu(k,648) * lu(k,2064) - lu(k,2103) = lu(k,2103) - lu(k,649) * lu(k,2064) - lu(k,2106) = lu(k,2106) - lu(k,650) * lu(k,2064) - lu(k,2113) = lu(k,2113) - lu(k,651) * lu(k,2064) - lu(k,2115) = lu(k,2115) - lu(k,652) * lu(k,2064) - lu(k,654) = 1._r8 / lu(k,654) - lu(k,655) = lu(k,655) * lu(k,654) - lu(k,656) = lu(k,656) * lu(k,654) - lu(k,657) = lu(k,657) * lu(k,654) - lu(k,658) = lu(k,658) * lu(k,654) - lu(k,659) = lu(k,659) * lu(k,654) - lu(k,660) = lu(k,660) * lu(k,654) - lu(k,661) = lu(k,661) * lu(k,654) - lu(k,1337) = lu(k,1337) - lu(k,655) * lu(k,1334) - lu(k,1338) = lu(k,1338) - lu(k,656) * lu(k,1334) - lu(k,1339) = lu(k,1339) - lu(k,657) * lu(k,1334) - lu(k,1341) = lu(k,1341) - lu(k,658) * lu(k,1334) - lu(k,1342) = lu(k,1342) - lu(k,659) * lu(k,1334) - lu(k,1347) = - lu(k,660) * lu(k,1334) - lu(k,1349) = lu(k,1349) - lu(k,661) * lu(k,1334) - lu(k,1815) = lu(k,1815) - lu(k,655) * lu(k,1803) - lu(k,1816) = lu(k,1816) - lu(k,656) * lu(k,1803) - lu(k,1820) = lu(k,1820) - lu(k,657) * lu(k,1803) - lu(k,1822) = lu(k,1822) - lu(k,658) * lu(k,1803) - lu(k,1824) = lu(k,1824) - lu(k,659) * lu(k,1803) - lu(k,1830) = lu(k,1830) - lu(k,660) * lu(k,1803) - lu(k,1833) = lu(k,1833) - lu(k,661) * lu(k,1803) - lu(k,1980) = - lu(k,655) * lu(k,1968) - lu(k,1981) = lu(k,1981) - lu(k,656) * lu(k,1968) - lu(k,1985) = - lu(k,657) * lu(k,1968) - lu(k,1987) = lu(k,1987) - lu(k,658) * lu(k,1968) - lu(k,1989) = lu(k,1989) - lu(k,659) * lu(k,1968) - lu(k,1995) = lu(k,1995) - lu(k,660) * lu(k,1968) - lu(k,1998) = lu(k,1998) - lu(k,661) * lu(k,1968) - lu(k,2005) = - lu(k,655) * lu(k,2002) - lu(k,2006) = lu(k,2006) - lu(k,656) * lu(k,2002) - lu(k,2009) = lu(k,2009) - lu(k,657) * lu(k,2002) - lu(k,2011) = lu(k,2011) - lu(k,658) * lu(k,2002) - lu(k,2013) = lu(k,2013) - lu(k,659) * lu(k,2002) - lu(k,2019) = lu(k,2019) - lu(k,660) * lu(k,2002) - lu(k,2022) = - lu(k,661) * lu(k,2002) - lu(k,2099) = lu(k,2099) - lu(k,655) * lu(k,2065) - lu(k,2100) = lu(k,2100) - lu(k,656) * lu(k,2065) - lu(k,2104) = lu(k,2104) - lu(k,657) * lu(k,2065) - lu(k,2106) = lu(k,2106) - lu(k,658) * lu(k,2065) - lu(k,2108) = lu(k,2108) - lu(k,659) * lu(k,2065) - lu(k,2114) = lu(k,2114) - lu(k,660) * lu(k,2065) - lu(k,2117) = lu(k,2117) - lu(k,661) * lu(k,2065) + lu(k,1396) = lu(k,1396) - lu(k,619) * lu(k,1391) + lu(k,1397) = lu(k,1397) - lu(k,620) * lu(k,1391) + lu(k,1398) = lu(k,1398) - lu(k,621) * lu(k,1391) + lu(k,1404) = lu(k,1404) - lu(k,622) * lu(k,1391) + lu(k,1405) = lu(k,1405) - lu(k,623) * lu(k,1391) + lu(k,1407) = - lu(k,624) * lu(k,1391) + lu(k,1426) = lu(k,1426) - lu(k,619) * lu(k,1410) + lu(k,1427) = lu(k,1427) - lu(k,620) * lu(k,1410) + lu(k,1429) = lu(k,1429) - lu(k,621) * lu(k,1410) + lu(k,1435) = lu(k,1435) - lu(k,622) * lu(k,1410) + lu(k,1437) = lu(k,1437) - lu(k,623) * lu(k,1410) + lu(k,1439) = - lu(k,624) * lu(k,1410) + lu(k,1789) = lu(k,1789) - lu(k,619) * lu(k,1731) + lu(k,1790) = lu(k,1790) - lu(k,620) * lu(k,1731) + lu(k,1799) = lu(k,1799) - lu(k,621) * lu(k,1731) + lu(k,1807) = lu(k,1807) - lu(k,622) * lu(k,1731) + lu(k,1810) = lu(k,1810) - lu(k,623) * lu(k,1731) + lu(k,1812) = lu(k,1812) - lu(k,624) * lu(k,1731) + lu(k,2188) = lu(k,2188) - lu(k,619) * lu(k,2143) + lu(k,2189) = lu(k,2189) - lu(k,620) * lu(k,2143) + lu(k,2197) = lu(k,2197) - lu(k,621) * lu(k,2143) + lu(k,2205) = lu(k,2205) - lu(k,622) * lu(k,2143) + lu(k,2208) = lu(k,2208) - lu(k,623) * lu(k,2143) + lu(k,2210) = lu(k,2210) - lu(k,624) * lu(k,2143) + lu(k,625) = 1._r8 / lu(k,625) + lu(k,626) = lu(k,626) * lu(k,625) + lu(k,627) = lu(k,627) * lu(k,625) + lu(k,628) = lu(k,628) * lu(k,625) + lu(k,629) = lu(k,629) * lu(k,625) + lu(k,630) = lu(k,630) * lu(k,625) + lu(k,1061) = lu(k,1061) - lu(k,626) * lu(k,1058) + lu(k,1063) = lu(k,1063) - lu(k,627) * lu(k,1058) + lu(k,1064) = lu(k,1064) - lu(k,628) * lu(k,1058) + lu(k,1065) = - lu(k,629) * lu(k,1058) + lu(k,1067) = lu(k,1067) - lu(k,630) * lu(k,1058) + lu(k,1087) = lu(k,1087) - lu(k,626) * lu(k,1085) + lu(k,1092) = lu(k,1092) - lu(k,627) * lu(k,1085) + lu(k,1093) = lu(k,1093) - lu(k,628) * lu(k,1085) + lu(k,1095) = lu(k,1095) - lu(k,629) * lu(k,1085) + lu(k,1097) = lu(k,1097) - lu(k,630) * lu(k,1085) + lu(k,1767) = lu(k,1767) - lu(k,626) * lu(k,1732) + lu(k,1799) = lu(k,1799) - lu(k,627) * lu(k,1732) + lu(k,1800) = lu(k,1800) - lu(k,628) * lu(k,1732) + lu(k,1803) = lu(k,1803) - lu(k,629) * lu(k,1732) + lu(k,1806) = lu(k,1806) - lu(k,630) * lu(k,1732) + lu(k,2040) = lu(k,2040) - lu(k,626) * lu(k,2018) + lu(k,2068) = lu(k,2068) - lu(k,627) * lu(k,2018) + lu(k,2069) = lu(k,2069) - lu(k,628) * lu(k,2018) + lu(k,2072) = lu(k,2072) - lu(k,629) * lu(k,2018) + lu(k,2075) = lu(k,2075) - lu(k,630) * lu(k,2018) + lu(k,2223) = lu(k,2223) - lu(k,626) * lu(k,2215) + lu(k,2249) = lu(k,2249) - lu(k,627) * lu(k,2215) + lu(k,2250) = lu(k,2250) - lu(k,628) * lu(k,2215) + lu(k,2253) = lu(k,2253) - lu(k,629) * lu(k,2215) + lu(k,2256) = lu(k,2256) - lu(k,630) * lu(k,2215) + lu(k,633) = 1._r8 / lu(k,633) + lu(k,634) = lu(k,634) * lu(k,633) + lu(k,635) = lu(k,635) * lu(k,633) + lu(k,636) = lu(k,636) * lu(k,633) + lu(k,637) = lu(k,637) * lu(k,633) + lu(k,638) = lu(k,638) * lu(k,633) + lu(k,1799) = lu(k,1799) - lu(k,634) * lu(k,1733) + lu(k,1800) = lu(k,1800) - lu(k,635) * lu(k,1733) + lu(k,1804) = lu(k,1804) - lu(k,636) * lu(k,1733) + lu(k,1806) = lu(k,1806) - lu(k,637) * lu(k,1733) + lu(k,1811) = lu(k,1811) - lu(k,638) * lu(k,1733) + lu(k,1844) = lu(k,1844) - lu(k,634) * lu(k,1822) + lu(k,1845) = lu(k,1845) - lu(k,635) * lu(k,1822) + lu(k,1849) = lu(k,1849) - lu(k,636) * lu(k,1822) + lu(k,1851) = lu(k,1851) - lu(k,637) * lu(k,1822) + lu(k,1856) = lu(k,1856) - lu(k,638) * lu(k,1822) + lu(k,2068) = lu(k,2068) - lu(k,634) * lu(k,2019) + lu(k,2069) = lu(k,2069) - lu(k,635) * lu(k,2019) + lu(k,2073) = lu(k,2073) - lu(k,636) * lu(k,2019) + lu(k,2075) = lu(k,2075) - lu(k,637) * lu(k,2019) + lu(k,2080) = lu(k,2080) - lu(k,638) * lu(k,2019) + lu(k,2197) = lu(k,2197) - lu(k,634) * lu(k,2144) + lu(k,2198) = lu(k,2198) - lu(k,635) * lu(k,2144) + lu(k,2202) = lu(k,2202) - lu(k,636) * lu(k,2144) + lu(k,2204) = lu(k,2204) - lu(k,637) * lu(k,2144) + lu(k,2209) = lu(k,2209) - lu(k,638) * lu(k,2144) + lu(k,2407) = lu(k,2407) - lu(k,634) * lu(k,2368) + lu(k,2408) = lu(k,2408) - lu(k,635) * lu(k,2368) + lu(k,2412) = lu(k,2412) - lu(k,636) * lu(k,2368) + lu(k,2414) = lu(k,2414) - lu(k,637) * lu(k,2368) + lu(k,2419) = lu(k,2419) - lu(k,638) * lu(k,2368) + lu(k,640) = 1._r8 / lu(k,640) + lu(k,641) = lu(k,641) * lu(k,640) + lu(k,642) = lu(k,642) * lu(k,640) + lu(k,643) = lu(k,643) * lu(k,640) + lu(k,644) = lu(k,644) * lu(k,640) + lu(k,645) = lu(k,645) * lu(k,640) + lu(k,646) = lu(k,646) * lu(k,640) + lu(k,647) = lu(k,647) * lu(k,640) + lu(k,648) = lu(k,648) * lu(k,640) + lu(k,649) = lu(k,649) * lu(k,640) + lu(k,1038) = lu(k,1038) - lu(k,641) * lu(k,1036) + lu(k,1039) = lu(k,1039) - lu(k,642) * lu(k,1036) + lu(k,1041) = lu(k,1041) - lu(k,643) * lu(k,1036) + lu(k,1042) = lu(k,1042) - lu(k,644) * lu(k,1036) + lu(k,1043) = lu(k,1043) - lu(k,645) * lu(k,1036) + lu(k,1045) = lu(k,1045) - lu(k,646) * lu(k,1036) + lu(k,1046) = lu(k,1046) - lu(k,647) * lu(k,1036) + lu(k,1048) = lu(k,1048) - lu(k,648) * lu(k,1036) + lu(k,1050) = lu(k,1050) - lu(k,649) * lu(k,1036) + lu(k,1738) = lu(k,1738) - lu(k,641) * lu(k,1734) + lu(k,1754) = lu(k,1754) - lu(k,642) * lu(k,1734) + lu(k,1768) = lu(k,1768) - lu(k,643) * lu(k,1734) + lu(k,1773) = lu(k,1773) - lu(k,644) * lu(k,1734) + lu(k,1789) = lu(k,1789) - lu(k,645) * lu(k,1734) + lu(k,1799) = lu(k,1799) - lu(k,646) * lu(k,1734) + lu(k,1800) = lu(k,1800) - lu(k,647) * lu(k,1734) + lu(k,1806) = lu(k,1806) - lu(k,648) * lu(k,1734) + lu(k,1810) = lu(k,1810) - lu(k,649) * lu(k,1734) + lu(k,2021) = lu(k,2021) - lu(k,641) * lu(k,2020) + lu(k,2032) = lu(k,2032) - lu(k,642) * lu(k,2020) + lu(k,2041) = lu(k,2041) - lu(k,643) * lu(k,2020) + lu(k,2045) = lu(k,2045) - lu(k,644) * lu(k,2020) + lu(k,2061) = lu(k,2061) - lu(k,645) * lu(k,2020) + lu(k,2068) = lu(k,2068) - lu(k,646) * lu(k,2020) + lu(k,2069) = lu(k,2069) - lu(k,647) * lu(k,2020) + lu(k,2075) = lu(k,2075) - lu(k,648) * lu(k,2020) + lu(k,2079) = lu(k,2079) - lu(k,649) * lu(k,2020) + lu(k,650) = 1._r8 / lu(k,650) + lu(k,651) = lu(k,651) * lu(k,650) + lu(k,652) = lu(k,652) * lu(k,650) + lu(k,653) = lu(k,653) * lu(k,650) + lu(k,654) = lu(k,654) * lu(k,650) + lu(k,655) = lu(k,655) * lu(k,650) + lu(k,656) = lu(k,656) * lu(k,650) + lu(k,657) = lu(k,657) * lu(k,650) + lu(k,658) = lu(k,658) * lu(k,650) + lu(k,659) = lu(k,659) * lu(k,650) + lu(k,1172) = lu(k,1172) - lu(k,651) * lu(k,1170) + lu(k,1173) = lu(k,1173) - lu(k,652) * lu(k,1170) + lu(k,1174) = lu(k,1174) - lu(k,653) * lu(k,1170) + lu(k,1175) = lu(k,1175) - lu(k,654) * lu(k,1170) + lu(k,1176) = lu(k,1176) - lu(k,655) * lu(k,1170) + lu(k,1179) = lu(k,1179) - lu(k,656) * lu(k,1170) + lu(k,1180) = - lu(k,657) * lu(k,1170) + lu(k,1184) = lu(k,1184) - lu(k,658) * lu(k,1170) + lu(k,1186) = lu(k,1186) - lu(k,659) * lu(k,1170) + lu(k,1768) = lu(k,1768) - lu(k,651) * lu(k,1735) + lu(k,1770) = lu(k,1770) - lu(k,652) * lu(k,1735) + lu(k,1774) = lu(k,1774) - lu(k,653) * lu(k,1735) + lu(k,1775) = lu(k,1775) - lu(k,654) * lu(k,1735) + lu(k,1776) = lu(k,1776) - lu(k,655) * lu(k,1735) + lu(k,1790) = lu(k,1790) - lu(k,656) * lu(k,1735) + lu(k,1799) = lu(k,1799) - lu(k,657) * lu(k,1735) + lu(k,1806) = lu(k,1806) - lu(k,658) * lu(k,1735) + lu(k,1810) = lu(k,1810) - lu(k,659) * lu(k,1735) + lu(k,2170) = lu(k,2170) - lu(k,651) * lu(k,2145) + lu(k,2172) = - lu(k,652) * lu(k,2145) + lu(k,2174) = lu(k,2174) - lu(k,653) * lu(k,2145) + lu(k,2175) = lu(k,2175) - lu(k,654) * lu(k,2145) + lu(k,2176) = lu(k,2176) - lu(k,655) * lu(k,2145) + lu(k,2189) = lu(k,2189) - lu(k,656) * lu(k,2145) + lu(k,2197) = lu(k,2197) - lu(k,657) * lu(k,2145) + lu(k,2204) = lu(k,2204) - lu(k,658) * lu(k,2145) + lu(k,2208) = lu(k,2208) - lu(k,659) * lu(k,2145) end do end subroutine lu_fac14 subroutine lu_fac15( avec_len, lu ) @@ -2292,203 +2072,218 @@ subroutine lu_fac15( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,664) = 1._r8 / lu(k,664) - lu(k,665) = lu(k,665) * lu(k,664) - lu(k,666) = lu(k,666) * lu(k,664) - lu(k,667) = lu(k,667) * lu(k,664) - lu(k,668) = lu(k,668) * lu(k,664) - lu(k,669) = lu(k,669) * lu(k,664) - lu(k,670) = lu(k,670) * lu(k,664) - lu(k,671) = lu(k,671) * lu(k,664) - lu(k,1484) = lu(k,1484) - lu(k,665) * lu(k,1468) - lu(k,1506) = lu(k,1506) - lu(k,666) * lu(k,1468) - lu(k,1507) = lu(k,1507) - lu(k,667) * lu(k,1468) - lu(k,1510) = lu(k,1510) - lu(k,668) * lu(k,1468) - lu(k,1513) = lu(k,1513) - lu(k,669) * lu(k,1468) - lu(k,1517) = lu(k,1517) - lu(k,670) * lu(k,1468) - lu(k,1519) = lu(k,1519) - lu(k,671) * lu(k,1468) - lu(k,1533) = - lu(k,665) * lu(k,1527) - lu(k,1541) = lu(k,1541) - lu(k,666) * lu(k,1527) - lu(k,1542) = - lu(k,667) * lu(k,1527) - lu(k,1545) = lu(k,1545) - lu(k,668) * lu(k,1527) - lu(k,1548) = lu(k,1548) - lu(k,669) * lu(k,1527) - lu(k,1552) = - lu(k,670) * lu(k,1527) - lu(k,1554) = lu(k,1554) - lu(k,671) * lu(k,1527) - lu(k,1690) = lu(k,1690) - lu(k,665) * lu(k,1667) - lu(k,1715) = lu(k,1715) - lu(k,666) * lu(k,1667) - lu(k,1716) = lu(k,1716) - lu(k,667) * lu(k,1667) - lu(k,1719) = lu(k,1719) - lu(k,668) * lu(k,1667) - lu(k,1722) = lu(k,1722) - lu(k,669) * lu(k,1667) - lu(k,1726) = lu(k,1726) - lu(k,670) * lu(k,1667) - lu(k,1728) = lu(k,1728) - lu(k,671) * lu(k,1667) - lu(k,1756) = - lu(k,665) * lu(k,1745) - lu(k,1777) = lu(k,1777) - lu(k,666) * lu(k,1745) - lu(k,1778) = lu(k,1778) - lu(k,667) * lu(k,1745) - lu(k,1781) = lu(k,1781) - lu(k,668) * lu(k,1745) - lu(k,1784) = lu(k,1784) - lu(k,669) * lu(k,1745) - lu(k,1788) = lu(k,1788) - lu(k,670) * lu(k,1745) - lu(k,1790) = lu(k,1790) - lu(k,671) * lu(k,1745) - lu(k,2079) = lu(k,2079) - lu(k,665) * lu(k,2066) - lu(k,2102) = lu(k,2102) - lu(k,666) * lu(k,2066) - lu(k,2103) = lu(k,2103) - lu(k,667) * lu(k,2066) - lu(k,2106) = lu(k,2106) - lu(k,668) * lu(k,2066) - lu(k,2109) = lu(k,2109) - lu(k,669) * lu(k,2066) - lu(k,2113) = lu(k,2113) - lu(k,670) * lu(k,2066) - lu(k,2115) = lu(k,2115) - lu(k,671) * lu(k,2066) - lu(k,673) = 1._r8 / lu(k,673) - lu(k,674) = lu(k,674) * lu(k,673) - lu(k,675) = lu(k,675) * lu(k,673) - lu(k,676) = lu(k,676) * lu(k,673) - lu(k,677) = lu(k,677) * lu(k,673) - lu(k,678) = lu(k,678) * lu(k,673) - lu(k,679) = lu(k,679) * lu(k,673) - lu(k,680) = lu(k,680) * lu(k,673) - lu(k,1104) = lu(k,1104) - lu(k,674) * lu(k,1103) - lu(k,1106) = - lu(k,675) * lu(k,1103) - lu(k,1109) = lu(k,1109) - lu(k,676) * lu(k,1103) - lu(k,1111) = - lu(k,677) * lu(k,1103) - lu(k,1112) = lu(k,1112) - lu(k,678) * lu(k,1103) - lu(k,1113) = - lu(k,679) * lu(k,1103) - lu(k,1114) = lu(k,1114) - lu(k,680) * lu(k,1103) - lu(k,1563) = lu(k,1563) - lu(k,674) * lu(k,1561) - lu(k,1566) = lu(k,1566) - lu(k,675) * lu(k,1561) - lu(k,1571) = lu(k,1571) - lu(k,676) * lu(k,1561) - lu(k,1575) = - lu(k,677) * lu(k,1561) - lu(k,1576) = lu(k,1576) - lu(k,678) * lu(k,1561) - lu(k,1577) = - lu(k,679) * lu(k,1561) - lu(k,1582) = lu(k,1582) - lu(k,680) * lu(k,1561) - lu(k,1701) = lu(k,1701) - lu(k,674) * lu(k,1668) - lu(k,1714) = lu(k,1714) - lu(k,675) * lu(k,1668) - lu(k,1719) = lu(k,1719) - lu(k,676) * lu(k,1668) - lu(k,1723) = lu(k,1723) - lu(k,677) * lu(k,1668) - lu(k,1724) = lu(k,1724) - lu(k,678) * lu(k,1668) - lu(k,1725) = lu(k,1725) - lu(k,679) * lu(k,1668) - lu(k,1730) = lu(k,1730) - lu(k,680) * lu(k,1668) - lu(k,1937) = - lu(k,674) * lu(k,1936) - lu(k,1940) = - lu(k,675) * lu(k,1936) - lu(k,1945) = lu(k,1945) - lu(k,676) * lu(k,1936) - lu(k,1949) = lu(k,1949) - lu(k,677) * lu(k,1936) - lu(k,1950) = lu(k,1950) - lu(k,678) * lu(k,1936) - lu(k,1951) = lu(k,1951) - lu(k,679) * lu(k,1936) - lu(k,1956) = lu(k,1956) - lu(k,680) * lu(k,1936) - lu(k,2150) = lu(k,2150) - lu(k,674) * lu(k,2148) - lu(k,2154) = - lu(k,675) * lu(k,2148) - lu(k,2159) = lu(k,2159) - lu(k,676) * lu(k,2148) - lu(k,2163) = - lu(k,677) * lu(k,2148) - lu(k,2164) = lu(k,2164) - lu(k,678) * lu(k,2148) - lu(k,2165) = - lu(k,679) * lu(k,2148) - lu(k,2170) = lu(k,2170) - lu(k,680) * lu(k,2148) - lu(k,681) = 1._r8 / lu(k,681) - lu(k,682) = lu(k,682) * lu(k,681) - lu(k,683) = lu(k,683) * lu(k,681) - lu(k,684) = lu(k,684) * lu(k,681) - lu(k,685) = lu(k,685) * lu(k,681) - lu(k,686) = lu(k,686) * lu(k,681) - lu(k,687) = lu(k,687) * lu(k,681) - lu(k,688) = lu(k,688) * lu(k,681) - lu(k,700) = lu(k,700) - lu(k,682) * lu(k,699) - lu(k,701) = lu(k,701) - lu(k,683) * lu(k,699) - lu(k,702) = lu(k,702) - lu(k,684) * lu(k,699) - lu(k,704) = lu(k,704) - lu(k,685) * lu(k,699) - lu(k,705) = lu(k,705) - lu(k,686) * lu(k,699) - lu(k,706) = lu(k,706) - lu(k,687) * lu(k,699) - lu(k,707) = lu(k,707) - lu(k,688) * lu(k,699) - lu(k,742) = lu(k,742) - lu(k,682) * lu(k,741) - lu(k,743) = lu(k,743) - lu(k,683) * lu(k,741) - lu(k,744) = lu(k,744) - lu(k,684) * lu(k,741) - lu(k,746) = lu(k,746) - lu(k,685) * lu(k,741) - lu(k,747) = lu(k,747) - lu(k,686) * lu(k,741) - lu(k,748) = - lu(k,687) * lu(k,741) - lu(k,750) = lu(k,750) - lu(k,688) * lu(k,741) - lu(k,1419) = lu(k,1419) - lu(k,682) * lu(k,1418) - lu(k,1420) = lu(k,1420) - lu(k,683) * lu(k,1418) - lu(k,1421) = lu(k,1421) - lu(k,684) * lu(k,1418) - lu(k,1427) = lu(k,1427) - lu(k,685) * lu(k,1418) - lu(k,1428) = lu(k,1428) - lu(k,686) * lu(k,1418) - lu(k,1430) = lu(k,1430) - lu(k,687) * lu(k,1418) - lu(k,1433) = lu(k,1433) - lu(k,688) * lu(k,1418) - lu(k,1470) = lu(k,1470) - lu(k,682) * lu(k,1469) - lu(k,1471) = lu(k,1471) - lu(k,683) * lu(k,1469) - lu(k,1475) = lu(k,1475) - lu(k,684) * lu(k,1469) - lu(k,1506) = lu(k,1506) - lu(k,685) * lu(k,1469) - lu(k,1507) = lu(k,1507) - lu(k,686) * lu(k,1469) - lu(k,1509) = - lu(k,687) * lu(k,1469) - lu(k,1512) = lu(k,1512) - lu(k,688) * lu(k,1469) - lu(k,1805) = lu(k,1805) - lu(k,682) * lu(k,1804) - lu(k,1806) = lu(k,1806) - lu(k,683) * lu(k,1804) - lu(k,1807) = lu(k,1807) - lu(k,684) * lu(k,1804) - lu(k,1818) = lu(k,1818) - lu(k,685) * lu(k,1804) - lu(k,1819) = lu(k,1819) - lu(k,686) * lu(k,1804) - lu(k,1821) = lu(k,1821) - lu(k,687) * lu(k,1804) - lu(k,1824) = lu(k,1824) - lu(k,688) * lu(k,1804) - lu(k,690) = 1._r8 / lu(k,690) - lu(k,691) = lu(k,691) * lu(k,690) - lu(k,692) = lu(k,692) * lu(k,690) - lu(k,693) = lu(k,693) * lu(k,690) - lu(k,694) = lu(k,694) * lu(k,690) - lu(k,695) = lu(k,695) * lu(k,690) - lu(k,696) = lu(k,696) * lu(k,690) - lu(k,701) = lu(k,701) - lu(k,691) * lu(k,700) - lu(k,702) = lu(k,702) - lu(k,692) * lu(k,700) - lu(k,704) = lu(k,704) - lu(k,693) * lu(k,700) - lu(k,705) = lu(k,705) - lu(k,694) * lu(k,700) - lu(k,706) = lu(k,706) - lu(k,695) * lu(k,700) - lu(k,707) = lu(k,707) - lu(k,696) * lu(k,700) - lu(k,743) = lu(k,743) - lu(k,691) * lu(k,742) - lu(k,744) = lu(k,744) - lu(k,692) * lu(k,742) - lu(k,746) = lu(k,746) - lu(k,693) * lu(k,742) - lu(k,747) = lu(k,747) - lu(k,694) * lu(k,742) - lu(k,748) = lu(k,748) - lu(k,695) * lu(k,742) - lu(k,750) = lu(k,750) - lu(k,696) * lu(k,742) - lu(k,1420) = lu(k,1420) - lu(k,691) * lu(k,1419) - lu(k,1421) = lu(k,1421) - lu(k,692) * lu(k,1419) - lu(k,1427) = lu(k,1427) - lu(k,693) * lu(k,1419) - lu(k,1428) = lu(k,1428) - lu(k,694) * lu(k,1419) - lu(k,1430) = lu(k,1430) - lu(k,695) * lu(k,1419) - lu(k,1433) = lu(k,1433) - lu(k,696) * lu(k,1419) - lu(k,1471) = lu(k,1471) - lu(k,691) * lu(k,1470) - lu(k,1475) = lu(k,1475) - lu(k,692) * lu(k,1470) - lu(k,1506) = lu(k,1506) - lu(k,693) * lu(k,1470) - lu(k,1507) = lu(k,1507) - lu(k,694) * lu(k,1470) - lu(k,1509) = lu(k,1509) - lu(k,695) * lu(k,1470) - lu(k,1512) = lu(k,1512) - lu(k,696) * lu(k,1470) - lu(k,1806) = lu(k,1806) - lu(k,691) * lu(k,1805) - lu(k,1807) = lu(k,1807) - lu(k,692) * lu(k,1805) - lu(k,1818) = lu(k,1818) - lu(k,693) * lu(k,1805) - lu(k,1819) = lu(k,1819) - lu(k,694) * lu(k,1805) - lu(k,1821) = lu(k,1821) - lu(k,695) * lu(k,1805) - lu(k,1824) = lu(k,1824) - lu(k,696) * lu(k,1805) - lu(k,701) = 1._r8 / lu(k,701) - lu(k,702) = lu(k,702) * lu(k,701) - lu(k,703) = lu(k,703) * lu(k,701) - lu(k,704) = lu(k,704) * lu(k,701) - lu(k,705) = lu(k,705) * lu(k,701) - lu(k,706) = lu(k,706) * lu(k,701) - lu(k,707) = lu(k,707) * lu(k,701) - lu(k,744) = lu(k,744) - lu(k,702) * lu(k,743) - lu(k,745) = lu(k,745) - lu(k,703) * lu(k,743) - lu(k,746) = lu(k,746) - lu(k,704) * lu(k,743) - lu(k,747) = lu(k,747) - lu(k,705) * lu(k,743) - lu(k,748) = lu(k,748) - lu(k,706) * lu(k,743) - lu(k,750) = lu(k,750) - lu(k,707) * lu(k,743) - lu(k,1421) = lu(k,1421) - lu(k,702) * lu(k,1420) - lu(k,1424) = lu(k,1424) - lu(k,703) * lu(k,1420) - lu(k,1427) = lu(k,1427) - lu(k,704) * lu(k,1420) - lu(k,1428) = lu(k,1428) - lu(k,705) * lu(k,1420) - lu(k,1430) = lu(k,1430) - lu(k,706) * lu(k,1420) - lu(k,1433) = lu(k,1433) - lu(k,707) * lu(k,1420) - lu(k,1475) = lu(k,1475) - lu(k,702) * lu(k,1471) - lu(k,1488) = lu(k,1488) - lu(k,703) * lu(k,1471) - lu(k,1506) = lu(k,1506) - lu(k,704) * lu(k,1471) - lu(k,1507) = lu(k,1507) - lu(k,705) * lu(k,1471) - lu(k,1509) = lu(k,1509) - lu(k,706) * lu(k,1471) - lu(k,1512) = lu(k,1512) - lu(k,707) * lu(k,1471) - lu(k,1807) = lu(k,1807) - lu(k,702) * lu(k,1806) - lu(k,1812) = lu(k,1812) - lu(k,703) * lu(k,1806) - lu(k,1818) = lu(k,1818) - lu(k,704) * lu(k,1806) - lu(k,1819) = lu(k,1819) - lu(k,705) * lu(k,1806) - lu(k,1821) = lu(k,1821) - lu(k,706) * lu(k,1806) - lu(k,1824) = lu(k,1824) - lu(k,707) * lu(k,1806) + lu(k,663) = 1._r8 / lu(k,663) + lu(k,664) = lu(k,664) * lu(k,663) + lu(k,665) = lu(k,665) * lu(k,663) + lu(k,666) = lu(k,666) * lu(k,663) + lu(k,667) = lu(k,667) * lu(k,663) + lu(k,668) = lu(k,668) * lu(k,663) + lu(k,669) = lu(k,669) * lu(k,663) + lu(k,670) = lu(k,670) * lu(k,663) + lu(k,671) = lu(k,671) * lu(k,663) + lu(k,672) = lu(k,672) * lu(k,663) + lu(k,748) = lu(k,748) - lu(k,664) * lu(k,747) + lu(k,749) = lu(k,749) - lu(k,665) * lu(k,747) + lu(k,750) = lu(k,750) - lu(k,666) * lu(k,747) + lu(k,751) = lu(k,751) - lu(k,667) * lu(k,747) + lu(k,752) = lu(k,752) - lu(k,668) * lu(k,747) + lu(k,753) = lu(k,753) - lu(k,669) * lu(k,747) + lu(k,754) = lu(k,754) - lu(k,670) * lu(k,747) + lu(k,755) = - lu(k,671) * lu(k,747) + lu(k,758) = lu(k,758) - lu(k,672) * lu(k,747) + lu(k,1743) = lu(k,1743) - lu(k,664) * lu(k,1736) + lu(k,1744) = lu(k,1744) - lu(k,665) * lu(k,1736) + lu(k,1746) = - lu(k,666) * lu(k,1736) + lu(k,1756) = lu(k,1756) - lu(k,667) * lu(k,1736) + lu(k,1765) = lu(k,1765) - lu(k,668) * lu(k,1736) + lu(k,1774) = lu(k,1774) - lu(k,669) * lu(k,1736) + lu(k,1783) = lu(k,1783) - lu(k,670) * lu(k,1736) + lu(k,1799) = lu(k,1799) - lu(k,671) * lu(k,1736) + lu(k,1806) = lu(k,1806) - lu(k,672) * lu(k,1736) + lu(k,2152) = lu(k,2152) - lu(k,664) * lu(k,2146) + lu(k,2153) = lu(k,2153) - lu(k,665) * lu(k,2146) + lu(k,2155) = lu(k,2155) - lu(k,666) * lu(k,2146) + lu(k,2164) = lu(k,2164) - lu(k,667) * lu(k,2146) + lu(k,2167) = lu(k,2167) - lu(k,668) * lu(k,2146) + lu(k,2174) = lu(k,2174) - lu(k,669) * lu(k,2146) + lu(k,2182) = lu(k,2182) - lu(k,670) * lu(k,2146) + lu(k,2197) = lu(k,2197) - lu(k,671) * lu(k,2146) + lu(k,2204) = lu(k,2204) - lu(k,672) * lu(k,2146) + lu(k,674) = 1._r8 / lu(k,674) + lu(k,675) = lu(k,675) * lu(k,674) + lu(k,676) = lu(k,676) * lu(k,674) + lu(k,677) = lu(k,677) * lu(k,674) + lu(k,678) = lu(k,678) * lu(k,674) + lu(k,679) = lu(k,679) * lu(k,674) + lu(k,680) = lu(k,680) * lu(k,674) + lu(k,681) = lu(k,681) * lu(k,674) + lu(k,682) = lu(k,682) * lu(k,674) + lu(k,683) = lu(k,683) * lu(k,674) + lu(k,860) = - lu(k,675) * lu(k,859) + lu(k,861) = lu(k,861) - lu(k,676) * lu(k,859) + lu(k,862) = lu(k,862) - lu(k,677) * lu(k,859) + lu(k,863) = lu(k,863) - lu(k,678) * lu(k,859) + lu(k,864) = lu(k,864) - lu(k,679) * lu(k,859) + lu(k,867) = lu(k,867) - lu(k,680) * lu(k,859) + lu(k,868) = lu(k,868) - lu(k,681) * lu(k,859) + lu(k,869) = lu(k,869) - lu(k,682) * lu(k,859) + lu(k,870) = lu(k,870) - lu(k,683) * lu(k,859) + lu(k,1529) = lu(k,1529) - lu(k,675) * lu(k,1527) + lu(k,1530) = lu(k,1530) - lu(k,676) * lu(k,1527) + lu(k,1531) = lu(k,1531) - lu(k,677) * lu(k,1527) + lu(k,1532) = lu(k,1532) - lu(k,678) * lu(k,1527) + lu(k,1534) = lu(k,1534) - lu(k,679) * lu(k,1527) + lu(k,1540) = lu(k,1540) - lu(k,680) * lu(k,1527) + lu(k,1543) = lu(k,1543) - lu(k,681) * lu(k,1527) + lu(k,1547) = lu(k,1547) - lu(k,682) * lu(k,1527) + lu(k,1550) = lu(k,1550) - lu(k,683) * lu(k,1527) + lu(k,2298) = lu(k,2298) - lu(k,675) * lu(k,2295) + lu(k,2301) = lu(k,2301) - lu(k,676) * lu(k,2295) + lu(k,2302) = lu(k,2302) - lu(k,677) * lu(k,2295) + lu(k,2303) = lu(k,2303) - lu(k,678) * lu(k,2295) + lu(k,2306) = lu(k,2306) - lu(k,679) * lu(k,2295) + lu(k,2313) = lu(k,2313) - lu(k,680) * lu(k,2295) + lu(k,2316) = lu(k,2316) - lu(k,681) * lu(k,2295) + lu(k,2322) = lu(k,2322) - lu(k,682) * lu(k,2295) + lu(k,2327) = lu(k,2327) - lu(k,683) * lu(k,2295) + lu(k,685) = 1._r8 / lu(k,685) + lu(k,686) = lu(k,686) * lu(k,685) + lu(k,687) = lu(k,687) * lu(k,685) + lu(k,688) = lu(k,688) * lu(k,685) + lu(k,689) = lu(k,689) * lu(k,685) + lu(k,690) = lu(k,690) * lu(k,685) + lu(k,691) = lu(k,691) * lu(k,685) + lu(k,692) = lu(k,692) * lu(k,685) + lu(k,693) = lu(k,693) * lu(k,685) + lu(k,694) = lu(k,694) * lu(k,685) + lu(k,1038) = lu(k,1038) - lu(k,686) * lu(k,1037) + lu(k,1039) = lu(k,1039) - lu(k,687) * lu(k,1037) + lu(k,1040) = lu(k,1040) - lu(k,688) * lu(k,1037) + lu(k,1041) = lu(k,1041) - lu(k,689) * lu(k,1037) + lu(k,1042) = lu(k,1042) - lu(k,690) * lu(k,1037) + lu(k,1043) = lu(k,1043) - lu(k,691) * lu(k,1037) + lu(k,1045) = lu(k,1045) - lu(k,692) * lu(k,1037) + lu(k,1048) = lu(k,1048) - lu(k,693) * lu(k,1037) + lu(k,1050) = lu(k,1050) - lu(k,694) * lu(k,1037) + lu(k,1738) = lu(k,1738) - lu(k,686) * lu(k,1737) + lu(k,1754) = lu(k,1754) - lu(k,687) * lu(k,1737) + lu(k,1764) = lu(k,1764) - lu(k,688) * lu(k,1737) + lu(k,1768) = lu(k,1768) - lu(k,689) * lu(k,1737) + lu(k,1773) = lu(k,1773) - lu(k,690) * lu(k,1737) + lu(k,1789) = lu(k,1789) - lu(k,691) * lu(k,1737) + lu(k,1799) = lu(k,1799) - lu(k,692) * lu(k,1737) + lu(k,1806) = lu(k,1806) - lu(k,693) * lu(k,1737) + lu(k,1810) = lu(k,1810) - lu(k,694) * lu(k,1737) + lu(k,2148) = lu(k,2148) - lu(k,686) * lu(k,2147) + lu(k,2162) = lu(k,2162) - lu(k,687) * lu(k,2147) + lu(k,2166) = lu(k,2166) - lu(k,688) * lu(k,2147) + lu(k,2170) = lu(k,2170) - lu(k,689) * lu(k,2147) + lu(k,2173) = lu(k,2173) - lu(k,690) * lu(k,2147) + lu(k,2188) = lu(k,2188) - lu(k,691) * lu(k,2147) + lu(k,2197) = lu(k,2197) - lu(k,692) * lu(k,2147) + lu(k,2204) = lu(k,2204) - lu(k,693) * lu(k,2147) + lu(k,2208) = lu(k,2208) - lu(k,694) * lu(k,2147) + lu(k,696) = 1._r8 / lu(k,696) + lu(k,697) = lu(k,697) * lu(k,696) + lu(k,698) = lu(k,698) * lu(k,696) + lu(k,699) = lu(k,699) * lu(k,696) + lu(k,700) = lu(k,700) * lu(k,696) + lu(k,701) = lu(k,701) * lu(k,696) + lu(k,702) = lu(k,702) * lu(k,696) + lu(k,1042) = lu(k,1042) - lu(k,697) * lu(k,1038) + lu(k,1043) = lu(k,1043) - lu(k,698) * lu(k,1038) + lu(k,1045) = lu(k,1045) - lu(k,699) * lu(k,1038) + lu(k,1046) = lu(k,1046) - lu(k,700) * lu(k,1038) + lu(k,1047) = lu(k,1047) - lu(k,701) * lu(k,1038) + lu(k,1048) = lu(k,1048) - lu(k,702) * lu(k,1038) + lu(k,1773) = lu(k,1773) - lu(k,697) * lu(k,1738) + lu(k,1789) = lu(k,1789) - lu(k,698) * lu(k,1738) + lu(k,1799) = lu(k,1799) - lu(k,699) * lu(k,1738) + lu(k,1800) = lu(k,1800) - lu(k,700) * lu(k,1738) + lu(k,1804) = lu(k,1804) - lu(k,701) * lu(k,1738) + lu(k,1806) = lu(k,1806) - lu(k,702) * lu(k,1738) + lu(k,2045) = lu(k,2045) - lu(k,697) * lu(k,2021) + lu(k,2061) = lu(k,2061) - lu(k,698) * lu(k,2021) + lu(k,2068) = lu(k,2068) - lu(k,699) * lu(k,2021) + lu(k,2069) = lu(k,2069) - lu(k,700) * lu(k,2021) + lu(k,2073) = lu(k,2073) - lu(k,701) * lu(k,2021) + lu(k,2075) = lu(k,2075) - lu(k,702) * lu(k,2021) + lu(k,2173) = lu(k,2173) - lu(k,697) * lu(k,2148) + lu(k,2188) = lu(k,2188) - lu(k,698) * lu(k,2148) + lu(k,2197) = lu(k,2197) - lu(k,699) * lu(k,2148) + lu(k,2198) = lu(k,2198) - lu(k,700) * lu(k,2148) + lu(k,2202) = lu(k,2202) - lu(k,701) * lu(k,2148) + lu(k,2204) = lu(k,2204) - lu(k,702) * lu(k,2148) + lu(k,703) = 1._r8 / lu(k,703) + lu(k,704) = lu(k,704) * lu(k,703) + lu(k,705) = lu(k,705) * lu(k,703) + lu(k,706) = lu(k,706) * lu(k,703) + lu(k,707) = lu(k,707) * lu(k,703) + lu(k,1137) = lu(k,1137) - lu(k,704) * lu(k,1127) + lu(k,1139) = lu(k,1139) - lu(k,705) * lu(k,1127) + lu(k,1144) = lu(k,1144) - lu(k,706) * lu(k,1127) + lu(k,1148) = - lu(k,707) * lu(k,1127) + lu(k,1397) = lu(k,1397) - lu(k,704) * lu(k,1392) + lu(k,1398) = lu(k,1398) - lu(k,705) * lu(k,1392) + lu(k,1404) = lu(k,1404) - lu(k,706) * lu(k,1392) + lu(k,1407) = lu(k,1407) - lu(k,707) * lu(k,1392) + lu(k,1427) = lu(k,1427) - lu(k,704) * lu(k,1411) + lu(k,1429) = lu(k,1429) - lu(k,705) * lu(k,1411) + lu(k,1435) = lu(k,1435) - lu(k,706) * lu(k,1411) + lu(k,1439) = lu(k,1439) - lu(k,707) * lu(k,1411) + lu(k,1790) = lu(k,1790) - lu(k,704) * lu(k,1739) + lu(k,1799) = lu(k,1799) - lu(k,705) * lu(k,1739) + lu(k,1807) = lu(k,1807) - lu(k,706) * lu(k,1739) + lu(k,1812) = lu(k,1812) - lu(k,707) * lu(k,1739) + lu(k,2189) = lu(k,2189) - lu(k,704) * lu(k,2149) + lu(k,2197) = lu(k,2197) - lu(k,705) * lu(k,2149) + lu(k,2205) = lu(k,2205) - lu(k,706) * lu(k,2149) + lu(k,2210) = lu(k,2210) - lu(k,707) * lu(k,2149) + lu(k,2244) = lu(k,2244) - lu(k,704) * lu(k,2216) + lu(k,2249) = lu(k,2249) - lu(k,705) * lu(k,2216) + lu(k,2257) = lu(k,2257) - lu(k,706) * lu(k,2216) + lu(k,2262) = lu(k,2262) - lu(k,707) * lu(k,2216) + lu(k,2400) = lu(k,2400) - lu(k,704) * lu(k,2369) + lu(k,2407) = lu(k,2407) - lu(k,705) * lu(k,2369) + lu(k,2415) = lu(k,2415) - lu(k,706) * lu(k,2369) + lu(k,2420) = - lu(k,707) * lu(k,2369) + lu(k,708) = 1._r8 / lu(k,708) + lu(k,709) = lu(k,709) * lu(k,708) + lu(k,710) = lu(k,710) * lu(k,708) + lu(k,711) = lu(k,711) * lu(k,708) + lu(k,712) = lu(k,712) * lu(k,708) + lu(k,713) = lu(k,713) * lu(k,708) + lu(k,714) = lu(k,714) * lu(k,708) + lu(k,1474) = lu(k,1474) - lu(k,709) * lu(k,1472) + lu(k,1476) = lu(k,1476) - lu(k,710) * lu(k,1472) + lu(k,1479) = lu(k,1479) - lu(k,711) * lu(k,1472) + lu(k,1483) = lu(k,1483) - lu(k,712) * lu(k,1472) + lu(k,1485) = lu(k,1485) - lu(k,713) * lu(k,1472) + lu(k,1486) = lu(k,1486) - lu(k,714) * lu(k,1472) + lu(k,1538) = lu(k,1538) - lu(k,709) * lu(k,1528) + lu(k,1540) = lu(k,1540) - lu(k,710) * lu(k,1528) + lu(k,1544) = - lu(k,711) * lu(k,1528) + lu(k,1548) = lu(k,1548) - lu(k,712) * lu(k,1528) + lu(k,1550) = lu(k,1550) - lu(k,713) * lu(k,1528) + lu(k,1552) = lu(k,1552) - lu(k,714) * lu(k,1528) + lu(k,1792) = lu(k,1792) - lu(k,709) * lu(k,1740) + lu(k,1795) = lu(k,1795) - lu(k,710) * lu(k,1740) + lu(k,1799) = lu(k,1799) - lu(k,711) * lu(k,1740) + lu(k,1805) = lu(k,1805) - lu(k,712) * lu(k,1740) + lu(k,1809) = lu(k,1809) - lu(k,713) * lu(k,1740) + lu(k,1811) = lu(k,1811) - lu(k,714) * lu(k,1740) + lu(k,2310) = lu(k,2310) - lu(k,709) * lu(k,2296) + lu(k,2313) = lu(k,2313) - lu(k,710) * lu(k,2296) + lu(k,2317) = lu(k,2317) - lu(k,711) * lu(k,2296) + lu(k,2323) = lu(k,2323) - lu(k,712) * lu(k,2296) + lu(k,2327) = lu(k,2327) - lu(k,713) * lu(k,2296) + lu(k,2329) = lu(k,2329) - lu(k,714) * lu(k,2296) + lu(k,2401) = lu(k,2401) - lu(k,709) * lu(k,2370) + lu(k,2403) = lu(k,2403) - lu(k,710) * lu(k,2370) + lu(k,2407) = lu(k,2407) - lu(k,711) * lu(k,2370) + lu(k,2413) = lu(k,2413) - lu(k,712) * lu(k,2370) + lu(k,2417) = lu(k,2417) - lu(k,713) * lu(k,2370) + lu(k,2419) = lu(k,2419) - lu(k,714) * lu(k,2370) end do end subroutine lu_fac15 subroutine lu_fac16( avec_len, lu ) @@ -2505,232 +2300,198 @@ subroutine lu_fac16( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,708) = 1._r8 / lu(k,708) - lu(k,709) = lu(k,709) * lu(k,708) - lu(k,710) = lu(k,710) * lu(k,708) - lu(k,711) = lu(k,711) * lu(k,708) - lu(k,845) = lu(k,845) - lu(k,709) * lu(k,839) - lu(k,846) = lu(k,846) - lu(k,710) * lu(k,839) - lu(k,848) = lu(k,848) - lu(k,711) * lu(k,839) - lu(k,1015) = lu(k,1015) - lu(k,709) * lu(k,1003) - lu(k,1016) = lu(k,1016) - lu(k,710) * lu(k,1003) - lu(k,1021) = lu(k,1021) - lu(k,711) * lu(k,1003) - lu(k,1035) = lu(k,1035) - lu(k,709) * lu(k,1025) - lu(k,1036) = lu(k,1036) - lu(k,710) * lu(k,1025) - lu(k,1040) = lu(k,1040) - lu(k,711) * lu(k,1025) - lu(k,1054) = lu(k,1054) - lu(k,709) * lu(k,1044) - lu(k,1055) = lu(k,1055) - lu(k,710) * lu(k,1044) - lu(k,1060) = lu(k,1060) - lu(k,711) * lu(k,1044) - lu(k,1070) = lu(k,1070) - lu(k,709) * lu(k,1063) - lu(k,1071) = lu(k,1071) - lu(k,710) * lu(k,1063) - lu(k,1073) = lu(k,1073) - lu(k,711) * lu(k,1063) - lu(k,1096) = lu(k,1096) - lu(k,709) * lu(k,1086) - lu(k,1097) = lu(k,1097) - lu(k,710) * lu(k,1086) - lu(k,1101) = lu(k,1101) - lu(k,711) * lu(k,1086) - lu(k,1131) = lu(k,1131) - lu(k,709) * lu(k,1118) - lu(k,1132) = lu(k,1132) - lu(k,710) * lu(k,1118) - lu(k,1137) = lu(k,1137) - lu(k,711) * lu(k,1118) - lu(k,1179) = lu(k,1179) - lu(k,709) * lu(k,1162) - lu(k,1181) = lu(k,1181) - lu(k,710) * lu(k,1162) - lu(k,1186) = lu(k,1186) - lu(k,711) * lu(k,1162) - lu(k,1213) = lu(k,1213) - lu(k,709) * lu(k,1193) - lu(k,1215) = lu(k,1215) - lu(k,710) * lu(k,1193) - lu(k,1220) = lu(k,1220) - lu(k,711) * lu(k,1193) - lu(k,1236) = lu(k,1236) - lu(k,709) * lu(k,1223) - lu(k,1237) = lu(k,1237) - lu(k,710) * lu(k,1223) - lu(k,1242) = lu(k,1242) - lu(k,711) * lu(k,1223) - lu(k,1400) = lu(k,1400) - lu(k,709) * lu(k,1369) - lu(k,1402) = lu(k,1402) - lu(k,710) * lu(k,1369) - lu(k,1407) = lu(k,1407) - lu(k,711) * lu(k,1369) - lu(k,1719) = lu(k,1719) - lu(k,709) * lu(k,1669) - lu(k,1722) = lu(k,1722) - lu(k,710) * lu(k,1669) - lu(k,1728) = lu(k,1728) - lu(k,711) * lu(k,1669) - lu(k,712) = 1._r8 / lu(k,712) - lu(k,713) = lu(k,713) * lu(k,712) - lu(k,714) = lu(k,714) * lu(k,712) - lu(k,715) = lu(k,715) * lu(k,712) - lu(k,791) = lu(k,791) - lu(k,713) * lu(k,780) - lu(k,795) = lu(k,795) - lu(k,714) * lu(k,780) - lu(k,796) = - lu(k,715) * lu(k,780) - lu(k,831) = lu(k,831) - lu(k,713) * lu(k,818) - lu(k,835) = lu(k,835) - lu(k,714) * lu(k,818) - lu(k,836) = - lu(k,715) * lu(k,818) - lu(k,869) = lu(k,869) - lu(k,713) * lu(k,856) - lu(k,873) = lu(k,873) - lu(k,714) * lu(k,856) - lu(k,874) = - lu(k,715) * lu(k,856) - lu(k,952) = lu(k,952) - lu(k,713) * lu(k,940) - lu(k,957) = lu(k,957) - lu(k,714) * lu(k,940) - lu(k,958) = lu(k,958) - lu(k,715) * lu(k,940) - lu(k,1145) = lu(k,1145) - lu(k,713) * lu(k,1138) - lu(k,1149) = lu(k,1149) - lu(k,714) * lu(k,1138) - lu(k,1150) = lu(k,1150) - lu(k,715) * lu(k,1138) - lu(k,1257) = lu(k,1257) - lu(k,713) * lu(k,1244) - lu(k,1264) = lu(k,1264) - lu(k,714) * lu(k,1244) - lu(k,1265) = - lu(k,715) * lu(k,1244) - lu(k,1510) = lu(k,1510) - lu(k,713) * lu(k,1472) - lu(k,1519) = lu(k,1519) - lu(k,714) * lu(k,1472) - lu(k,1521) = - lu(k,715) * lu(k,1472) - lu(k,1545) = lu(k,1545) - lu(k,713) * lu(k,1528) - lu(k,1554) = lu(k,1554) - lu(k,714) * lu(k,1528) - lu(k,1556) = lu(k,1556) - lu(k,715) * lu(k,1528) - lu(k,1719) = lu(k,1719) - lu(k,713) * lu(k,1670) - lu(k,1728) = lu(k,1728) - lu(k,714) * lu(k,1670) - lu(k,1730) = lu(k,1730) - lu(k,715) * lu(k,1670) - lu(k,1781) = lu(k,1781) - lu(k,713) * lu(k,1746) - lu(k,1790) = lu(k,1790) - lu(k,714) * lu(k,1746) - lu(k,1792) = lu(k,1792) - lu(k,715) * lu(k,1746) - lu(k,1846) = lu(k,1846) - lu(k,713) * lu(k,1835) - lu(k,1855) = lu(k,1855) - lu(k,714) * lu(k,1835) - lu(k,1857) = lu(k,1857) - lu(k,715) * lu(k,1835) - lu(k,2106) = lu(k,2106) - lu(k,713) * lu(k,2067) - lu(k,2115) = lu(k,2115) - lu(k,714) * lu(k,2067) - lu(k,2117) = lu(k,2117) - lu(k,715) * lu(k,2067) - lu(k,717) = 1._r8 / lu(k,717) - lu(k,718) = lu(k,718) * lu(k,717) - lu(k,719) = lu(k,719) * lu(k,717) - lu(k,720) = lu(k,720) * lu(k,717) - lu(k,721) = lu(k,721) * lu(k,717) - lu(k,722) = lu(k,722) * lu(k,717) - lu(k,723) = lu(k,723) * lu(k,717) - lu(k,724) = lu(k,724) * lu(k,717) - lu(k,725) = lu(k,725) * lu(k,717) - lu(k,726) = lu(k,726) * lu(k,717) - lu(k,944) = - lu(k,718) * lu(k,941) - lu(k,946) = lu(k,946) - lu(k,719) * lu(k,941) - lu(k,950) = - lu(k,720) * lu(k,941) - lu(k,951) = - lu(k,721) * lu(k,941) - lu(k,952) = lu(k,952) - lu(k,722) * lu(k,941) - lu(k,954) = lu(k,954) - lu(k,723) * lu(k,941) - lu(k,956) = - lu(k,724) * lu(k,941) - lu(k,957) = lu(k,957) - lu(k,725) * lu(k,941) - lu(k,958) = lu(k,958) - lu(k,726) * lu(k,941) - lu(k,1487) = lu(k,1487) - lu(k,718) * lu(k,1473) - lu(k,1493) = lu(k,1493) - lu(k,719) * lu(k,1473) - lu(k,1506) = lu(k,1506) - lu(k,720) * lu(k,1473) - lu(k,1507) = lu(k,1507) - lu(k,721) * lu(k,1473) - lu(k,1510) = lu(k,1510) - lu(k,722) * lu(k,1473) - lu(k,1513) = lu(k,1513) - lu(k,723) * lu(k,1473) - lu(k,1517) = lu(k,1517) - lu(k,724) * lu(k,1473) - lu(k,1519) = lu(k,1519) - lu(k,725) * lu(k,1473) - lu(k,1521) = lu(k,1521) - lu(k,726) * lu(k,1473) - lu(k,1693) = lu(k,1693) - lu(k,718) * lu(k,1671) - lu(k,1699) = lu(k,1699) - lu(k,719) * lu(k,1671) - lu(k,1715) = lu(k,1715) - lu(k,720) * lu(k,1671) - lu(k,1716) = lu(k,1716) - lu(k,721) * lu(k,1671) - lu(k,1719) = lu(k,1719) - lu(k,722) * lu(k,1671) - lu(k,1722) = lu(k,1722) - lu(k,723) * lu(k,1671) - lu(k,1726) = lu(k,1726) - lu(k,724) * lu(k,1671) - lu(k,1728) = lu(k,1728) - lu(k,725) * lu(k,1671) - lu(k,1730) = lu(k,1730) - lu(k,726) * lu(k,1671) - lu(k,2081) = lu(k,2081) - lu(k,718) * lu(k,2068) - lu(k,2087) = lu(k,2087) - lu(k,719) * lu(k,2068) - lu(k,2102) = lu(k,2102) - lu(k,720) * lu(k,2068) - lu(k,2103) = lu(k,2103) - lu(k,721) * lu(k,2068) - lu(k,2106) = lu(k,2106) - lu(k,722) * lu(k,2068) - lu(k,2109) = lu(k,2109) - lu(k,723) * lu(k,2068) - lu(k,2113) = lu(k,2113) - lu(k,724) * lu(k,2068) - lu(k,2115) = lu(k,2115) - lu(k,725) * lu(k,2068) - lu(k,2117) = lu(k,2117) - lu(k,726) * lu(k,2068) - lu(k,728) = 1._r8 / lu(k,728) - lu(k,729) = lu(k,729) * lu(k,728) - lu(k,730) = lu(k,730) * lu(k,728) - lu(k,731) = lu(k,731) * lu(k,728) - lu(k,732) = lu(k,732) * lu(k,728) - lu(k,733) = lu(k,733) * lu(k,728) - lu(k,734) = lu(k,734) * lu(k,728) - lu(k,735) = lu(k,735) * lu(k,728) - lu(k,736) = lu(k,736) * lu(k,728) - lu(k,737) = lu(k,737) * lu(k,728) - lu(k,738) = lu(k,738) * lu(k,728) - lu(k,1374) = lu(k,1374) - lu(k,729) * lu(k,1370) - lu(k,1385) = lu(k,1385) - lu(k,730) * lu(k,1370) - lu(k,1396) = lu(k,1396) - lu(k,731) * lu(k,1370) - lu(k,1397) = lu(k,1397) - lu(k,732) * lu(k,1370) - lu(k,1398) = lu(k,1398) - lu(k,733) * lu(k,1370) - lu(k,1400) = lu(k,1400) - lu(k,734) * lu(k,1370) - lu(k,1402) = lu(k,1402) - lu(k,735) * lu(k,1370) - lu(k,1406) = lu(k,1406) - lu(k,736) * lu(k,1370) - lu(k,1407) = lu(k,1407) - lu(k,737) * lu(k,1370) - lu(k,1409) = lu(k,1409) - lu(k,738) * lu(k,1370) - lu(k,1481) = lu(k,1481) - lu(k,729) * lu(k,1474) - lu(k,1493) = lu(k,1493) - lu(k,730) * lu(k,1474) - lu(k,1505) = lu(k,1505) - lu(k,731) * lu(k,1474) - lu(k,1506) = lu(k,1506) - lu(k,732) * lu(k,1474) - lu(k,1507) = lu(k,1507) - lu(k,733) * lu(k,1474) - lu(k,1510) = lu(k,1510) - lu(k,734) * lu(k,1474) - lu(k,1513) = lu(k,1513) - lu(k,735) * lu(k,1474) - lu(k,1517) = lu(k,1517) - lu(k,736) * lu(k,1474) - lu(k,1519) = lu(k,1519) - lu(k,737) * lu(k,1474) - lu(k,1521) = lu(k,1521) - lu(k,738) * lu(k,1474) - lu(k,1685) = lu(k,1685) - lu(k,729) * lu(k,1672) - lu(k,1699) = lu(k,1699) - lu(k,730) * lu(k,1672) - lu(k,1714) = lu(k,1714) - lu(k,731) * lu(k,1672) - lu(k,1715) = lu(k,1715) - lu(k,732) * lu(k,1672) - lu(k,1716) = lu(k,1716) - lu(k,733) * lu(k,1672) - lu(k,1719) = lu(k,1719) - lu(k,734) * lu(k,1672) - lu(k,1722) = lu(k,1722) - lu(k,735) * lu(k,1672) - lu(k,1726) = lu(k,1726) - lu(k,736) * lu(k,1672) - lu(k,1728) = lu(k,1728) - lu(k,737) * lu(k,1672) - lu(k,1730) = lu(k,1730) - lu(k,738) * lu(k,1672) - lu(k,2077) = lu(k,2077) - lu(k,729) * lu(k,2069) - lu(k,2087) = lu(k,2087) - lu(k,730) * lu(k,2069) - lu(k,2101) = lu(k,2101) - lu(k,731) * lu(k,2069) - lu(k,2102) = lu(k,2102) - lu(k,732) * lu(k,2069) - lu(k,2103) = lu(k,2103) - lu(k,733) * lu(k,2069) - lu(k,2106) = lu(k,2106) - lu(k,734) * lu(k,2069) - lu(k,2109) = lu(k,2109) - lu(k,735) * lu(k,2069) - lu(k,2113) = lu(k,2113) - lu(k,736) * lu(k,2069) - lu(k,2115) = lu(k,2115) - lu(k,737) * lu(k,2069) - lu(k,2117) = lu(k,2117) - lu(k,738) * lu(k,2069) - lu(k,744) = 1._r8 / lu(k,744) - lu(k,745) = lu(k,745) * lu(k,744) - lu(k,746) = lu(k,746) * lu(k,744) - lu(k,747) = lu(k,747) * lu(k,744) - lu(k,748) = lu(k,748) * lu(k,744) - lu(k,749) = lu(k,749) * lu(k,744) - lu(k,750) = lu(k,750) * lu(k,744) - lu(k,751) = lu(k,751) * lu(k,744) - lu(k,752) = lu(k,752) * lu(k,744) - lu(k,1424) = lu(k,1424) - lu(k,745) * lu(k,1421) - lu(k,1427) = lu(k,1427) - lu(k,746) * lu(k,1421) - lu(k,1428) = lu(k,1428) - lu(k,747) * lu(k,1421) - lu(k,1430) = lu(k,1430) - lu(k,748) * lu(k,1421) - lu(k,1431) = lu(k,1431) - lu(k,749) * lu(k,1421) - lu(k,1433) = lu(k,1433) - lu(k,750) * lu(k,1421) - lu(k,1435) = lu(k,1435) - lu(k,751) * lu(k,1421) - lu(k,1436) = - lu(k,752) * lu(k,1421) - lu(k,1488) = lu(k,1488) - lu(k,745) * lu(k,1475) - lu(k,1506) = lu(k,1506) - lu(k,746) * lu(k,1475) - lu(k,1507) = lu(k,1507) - lu(k,747) * lu(k,1475) - lu(k,1509) = lu(k,1509) - lu(k,748) * lu(k,1475) - lu(k,1510) = lu(k,1510) - lu(k,749) * lu(k,1475) - lu(k,1512) = lu(k,1512) - lu(k,750) * lu(k,1475) - lu(k,1515) = - lu(k,751) * lu(k,1475) - lu(k,1517) = lu(k,1517) - lu(k,752) * lu(k,1475) - lu(k,1694) = lu(k,1694) - lu(k,745) * lu(k,1673) - lu(k,1715) = lu(k,1715) - lu(k,746) * lu(k,1673) - lu(k,1716) = lu(k,1716) - lu(k,747) * lu(k,1673) - lu(k,1718) = lu(k,1718) - lu(k,748) * lu(k,1673) - lu(k,1719) = lu(k,1719) - lu(k,749) * lu(k,1673) - lu(k,1721) = lu(k,1721) - lu(k,750) * lu(k,1673) - lu(k,1724) = lu(k,1724) - lu(k,751) * lu(k,1673) - lu(k,1726) = lu(k,1726) - lu(k,752) * lu(k,1673) - lu(k,1812) = lu(k,1812) - lu(k,745) * lu(k,1807) - lu(k,1818) = lu(k,1818) - lu(k,746) * lu(k,1807) - lu(k,1819) = lu(k,1819) - lu(k,747) * lu(k,1807) - lu(k,1821) = lu(k,1821) - lu(k,748) * lu(k,1807) - lu(k,1822) = lu(k,1822) - lu(k,749) * lu(k,1807) - lu(k,1824) = lu(k,1824) - lu(k,750) * lu(k,1807) - lu(k,1827) = lu(k,1827) - lu(k,751) * lu(k,1807) - lu(k,1829) = lu(k,1829) - lu(k,752) * lu(k,1807) - lu(k,1975) = lu(k,1975) - lu(k,745) * lu(k,1969) - lu(k,1983) = lu(k,1983) - lu(k,746) * lu(k,1969) - lu(k,1984) = lu(k,1984) - lu(k,747) * lu(k,1969) - lu(k,1986) = - lu(k,748) * lu(k,1969) - lu(k,1987) = lu(k,1987) - lu(k,749) * lu(k,1969) - lu(k,1989) = lu(k,1989) - lu(k,750) * lu(k,1969) - lu(k,1992) = - lu(k,751) * lu(k,1969) - lu(k,1994) = lu(k,1994) - lu(k,752) * lu(k,1969) + lu(k,719) = 1._r8 / lu(k,719) + lu(k,720) = lu(k,720) * lu(k,719) + lu(k,721) = lu(k,721) * lu(k,719) + lu(k,722) = lu(k,722) * lu(k,719) + lu(k,723) = lu(k,723) * lu(k,719) + lu(k,724) = lu(k,724) * lu(k,719) + lu(k,725) = lu(k,725) * lu(k,719) + lu(k,726) = lu(k,726) * lu(k,719) + lu(k,727) = lu(k,727) * lu(k,719) + lu(k,728) = lu(k,728) * lu(k,719) + lu(k,729) = lu(k,729) * lu(k,719) + lu(k,764) = lu(k,764) - lu(k,720) * lu(k,763) + lu(k,765) = lu(k,765) - lu(k,721) * lu(k,763) + lu(k,766) = lu(k,766) - lu(k,722) * lu(k,763) + lu(k,767) = lu(k,767) - lu(k,723) * lu(k,763) + lu(k,768) = lu(k,768) - lu(k,724) * lu(k,763) + lu(k,769) = lu(k,769) - lu(k,725) * lu(k,763) + lu(k,770) = lu(k,770) - lu(k,726) * lu(k,763) + lu(k,771) = lu(k,771) - lu(k,727) * lu(k,763) + lu(k,772) = - lu(k,728) * lu(k,763) + lu(k,775) = lu(k,775) - lu(k,729) * lu(k,763) + lu(k,1743) = lu(k,1743) - lu(k,720) * lu(k,1741) + lu(k,1745) = lu(k,1745) - lu(k,721) * lu(k,1741) + lu(k,1746) = lu(k,1746) - lu(k,722) * lu(k,1741) + lu(k,1756) = lu(k,1756) - lu(k,723) * lu(k,1741) + lu(k,1765) = lu(k,1765) - lu(k,724) * lu(k,1741) + lu(k,1774) = lu(k,1774) - lu(k,725) * lu(k,1741) + lu(k,1783) = lu(k,1783) - lu(k,726) * lu(k,1741) + lu(k,1789) = lu(k,1789) - lu(k,727) * lu(k,1741) + lu(k,1799) = lu(k,1799) - lu(k,728) * lu(k,1741) + lu(k,1806) = lu(k,1806) - lu(k,729) * lu(k,1741) + lu(k,2152) = lu(k,2152) - lu(k,720) * lu(k,2150) + lu(k,2154) = lu(k,2154) - lu(k,721) * lu(k,2150) + lu(k,2155) = lu(k,2155) - lu(k,722) * lu(k,2150) + lu(k,2164) = lu(k,2164) - lu(k,723) * lu(k,2150) + lu(k,2167) = lu(k,2167) - lu(k,724) * lu(k,2150) + lu(k,2174) = lu(k,2174) - lu(k,725) * lu(k,2150) + lu(k,2182) = lu(k,2182) - lu(k,726) * lu(k,2150) + lu(k,2188) = lu(k,2188) - lu(k,727) * lu(k,2150) + lu(k,2197) = lu(k,2197) - lu(k,728) * lu(k,2150) + lu(k,2204) = lu(k,2204) - lu(k,729) * lu(k,2150) + lu(k,731) = 1._r8 / lu(k,731) + lu(k,732) = lu(k,732) * lu(k,731) + lu(k,733) = lu(k,733) * lu(k,731) + lu(k,734) = lu(k,734) * lu(k,731) + lu(k,735) = lu(k,735) * lu(k,731) + lu(k,736) = lu(k,736) * lu(k,731) + lu(k,737) = lu(k,737) * lu(k,731) + lu(k,1250) = - lu(k,732) * lu(k,1244) + lu(k,1252) = - lu(k,733) * lu(k,1244) + lu(k,1254) = - lu(k,734) * lu(k,1244) + lu(k,1257) = lu(k,1257) - lu(k,735) * lu(k,1244) + lu(k,1262) = lu(k,1262) - lu(k,736) * lu(k,1244) + lu(k,1264) = lu(k,1264) - lu(k,737) * lu(k,1244) + lu(k,1294) = - lu(k,732) * lu(k,1288) + lu(k,1295) = lu(k,1295) - lu(k,733) * lu(k,1288) + lu(k,1299) = lu(k,1299) - lu(k,734) * lu(k,1288) + lu(k,1303) = lu(k,1303) - lu(k,735) * lu(k,1288) + lu(k,1308) = lu(k,1308) - lu(k,736) * lu(k,1288) + lu(k,1310) = lu(k,1310) - lu(k,737) * lu(k,1288) + lu(k,1327) = lu(k,1327) - lu(k,732) * lu(k,1317) + lu(k,1328) = - lu(k,733) * lu(k,1317) + lu(k,1332) = - lu(k,734) * lu(k,1317) + lu(k,1336) = lu(k,1336) - lu(k,735) * lu(k,1317) + lu(k,1341) = lu(k,1341) - lu(k,736) * lu(k,1317) + lu(k,1343) = lu(k,1343) - lu(k,737) * lu(k,1317) + lu(k,1780) = lu(k,1780) - lu(k,732) * lu(k,1742) + lu(k,1782) = lu(k,1782) - lu(k,733) * lu(k,1742) + lu(k,1787) = lu(k,1787) - lu(k,734) * lu(k,1742) + lu(k,1799) = lu(k,1799) - lu(k,735) * lu(k,1742) + lu(k,1806) = lu(k,1806) - lu(k,736) * lu(k,1742) + lu(k,1810) = lu(k,1810) - lu(k,737) * lu(k,1742) + lu(k,2179) = lu(k,2179) - lu(k,732) * lu(k,2151) + lu(k,2181) = - lu(k,733) * lu(k,2151) + lu(k,2186) = - lu(k,734) * lu(k,2151) + lu(k,2197) = lu(k,2197) - lu(k,735) * lu(k,2151) + lu(k,2204) = lu(k,2204) - lu(k,736) * lu(k,2151) + lu(k,2208) = lu(k,2208) - lu(k,737) * lu(k,2151) + lu(k,738) = 1._r8 / lu(k,738) + lu(k,739) = lu(k,739) * lu(k,738) + lu(k,740) = lu(k,740) * lu(k,738) + lu(k,741) = lu(k,741) * lu(k,738) + lu(k,742) = lu(k,742) * lu(k,738) + lu(k,743) = lu(k,743) * lu(k,738) + lu(k,752) = lu(k,752) - lu(k,739) * lu(k,748) + lu(k,753) = lu(k,753) - lu(k,740) * lu(k,748) + lu(k,756) = lu(k,756) - lu(k,741) * lu(k,748) + lu(k,757) = lu(k,757) - lu(k,742) * lu(k,748) + lu(k,758) = lu(k,758) - lu(k,743) * lu(k,748) + lu(k,768) = lu(k,768) - lu(k,739) * lu(k,764) + lu(k,769) = lu(k,769) - lu(k,740) * lu(k,764) + lu(k,773) = lu(k,773) - lu(k,741) * lu(k,764) + lu(k,774) = lu(k,774) - lu(k,742) * lu(k,764) + lu(k,775) = lu(k,775) - lu(k,743) * lu(k,764) + lu(k,1765) = lu(k,1765) - lu(k,739) * lu(k,1743) + lu(k,1774) = lu(k,1774) - lu(k,740) * lu(k,1743) + lu(k,1800) = lu(k,1800) - lu(k,741) * lu(k,1743) + lu(k,1804) = lu(k,1804) - lu(k,742) * lu(k,1743) + lu(k,1806) = lu(k,1806) - lu(k,743) * lu(k,1743) + lu(k,1830) = - lu(k,739) * lu(k,1823) + lu(k,1831) = - lu(k,740) * lu(k,1823) + lu(k,1845) = lu(k,1845) - lu(k,741) * lu(k,1823) + lu(k,1849) = lu(k,1849) - lu(k,742) * lu(k,1823) + lu(k,1851) = lu(k,1851) - lu(k,743) * lu(k,1823) + lu(k,2038) = lu(k,2038) - lu(k,739) * lu(k,2022) + lu(k,2046) = lu(k,2046) - lu(k,740) * lu(k,2022) + lu(k,2069) = lu(k,2069) - lu(k,741) * lu(k,2022) + lu(k,2073) = lu(k,2073) - lu(k,742) * lu(k,2022) + lu(k,2075) = lu(k,2075) - lu(k,743) * lu(k,2022) + lu(k,2167) = lu(k,2167) - lu(k,739) * lu(k,2152) + lu(k,2174) = lu(k,2174) - lu(k,740) * lu(k,2152) + lu(k,2198) = lu(k,2198) - lu(k,741) * lu(k,2152) + lu(k,2202) = lu(k,2202) - lu(k,742) * lu(k,2152) + lu(k,2204) = lu(k,2204) - lu(k,743) * lu(k,2152) + lu(k,749) = 1._r8 / lu(k,749) + lu(k,750) = lu(k,750) * lu(k,749) + lu(k,751) = lu(k,751) * lu(k,749) + lu(k,752) = lu(k,752) * lu(k,749) + lu(k,753) = lu(k,753) * lu(k,749) + lu(k,754) = lu(k,754) * lu(k,749) + lu(k,755) = lu(k,755) * lu(k,749) + lu(k,756) = lu(k,756) * lu(k,749) + lu(k,757) = lu(k,757) * lu(k,749) + lu(k,758) = lu(k,758) * lu(k,749) + lu(k,1746) = lu(k,1746) - lu(k,750) * lu(k,1744) + lu(k,1756) = lu(k,1756) - lu(k,751) * lu(k,1744) + lu(k,1765) = lu(k,1765) - lu(k,752) * lu(k,1744) + lu(k,1774) = lu(k,1774) - lu(k,753) * lu(k,1744) + lu(k,1783) = lu(k,1783) - lu(k,754) * lu(k,1744) + lu(k,1799) = lu(k,1799) - lu(k,755) * lu(k,1744) + lu(k,1800) = lu(k,1800) - lu(k,756) * lu(k,1744) + lu(k,1804) = lu(k,1804) - lu(k,757) * lu(k,1744) + lu(k,1806) = lu(k,1806) - lu(k,758) * lu(k,1744) + lu(k,2025) = lu(k,2025) - lu(k,750) * lu(k,2023) + lu(k,2034) = lu(k,2034) - lu(k,751) * lu(k,2023) + lu(k,2038) = lu(k,2038) - lu(k,752) * lu(k,2023) + lu(k,2046) = lu(k,2046) - lu(k,753) * lu(k,2023) + lu(k,2055) = lu(k,2055) - lu(k,754) * lu(k,2023) + lu(k,2068) = lu(k,2068) - lu(k,755) * lu(k,2023) + lu(k,2069) = lu(k,2069) - lu(k,756) * lu(k,2023) + lu(k,2073) = lu(k,2073) - lu(k,757) * lu(k,2023) + lu(k,2075) = lu(k,2075) - lu(k,758) * lu(k,2023) + lu(k,2155) = lu(k,2155) - lu(k,750) * lu(k,2153) + lu(k,2164) = lu(k,2164) - lu(k,751) * lu(k,2153) + lu(k,2167) = lu(k,2167) - lu(k,752) * lu(k,2153) + lu(k,2174) = lu(k,2174) - lu(k,753) * lu(k,2153) + lu(k,2182) = lu(k,2182) - lu(k,754) * lu(k,2153) + lu(k,2197) = lu(k,2197) - lu(k,755) * lu(k,2153) + lu(k,2198) = lu(k,2198) - lu(k,756) * lu(k,2153) + lu(k,2202) = lu(k,2202) - lu(k,757) * lu(k,2153) + lu(k,2204) = lu(k,2204) - lu(k,758) * lu(k,2153) + lu(k,765) = 1._r8 / lu(k,765) + lu(k,766) = lu(k,766) * lu(k,765) + lu(k,767) = lu(k,767) * lu(k,765) + lu(k,768) = lu(k,768) * lu(k,765) + lu(k,769) = lu(k,769) * lu(k,765) + lu(k,770) = lu(k,770) * lu(k,765) + lu(k,771) = lu(k,771) * lu(k,765) + lu(k,772) = lu(k,772) * lu(k,765) + lu(k,773) = lu(k,773) * lu(k,765) + lu(k,774) = lu(k,774) * lu(k,765) + lu(k,775) = lu(k,775) * lu(k,765) + lu(k,1746) = lu(k,1746) - lu(k,766) * lu(k,1745) + lu(k,1756) = lu(k,1756) - lu(k,767) * lu(k,1745) + lu(k,1765) = lu(k,1765) - lu(k,768) * lu(k,1745) + lu(k,1774) = lu(k,1774) - lu(k,769) * lu(k,1745) + lu(k,1783) = lu(k,1783) - lu(k,770) * lu(k,1745) + lu(k,1789) = lu(k,1789) - lu(k,771) * lu(k,1745) + lu(k,1799) = lu(k,1799) - lu(k,772) * lu(k,1745) + lu(k,1800) = lu(k,1800) - lu(k,773) * lu(k,1745) + lu(k,1804) = lu(k,1804) - lu(k,774) * lu(k,1745) + lu(k,1806) = lu(k,1806) - lu(k,775) * lu(k,1745) + lu(k,2025) = lu(k,2025) - lu(k,766) * lu(k,2024) + lu(k,2034) = lu(k,2034) - lu(k,767) * lu(k,2024) + lu(k,2038) = lu(k,2038) - lu(k,768) * lu(k,2024) + lu(k,2046) = lu(k,2046) - lu(k,769) * lu(k,2024) + lu(k,2055) = lu(k,2055) - lu(k,770) * lu(k,2024) + lu(k,2061) = lu(k,2061) - lu(k,771) * lu(k,2024) + lu(k,2068) = lu(k,2068) - lu(k,772) * lu(k,2024) + lu(k,2069) = lu(k,2069) - lu(k,773) * lu(k,2024) + lu(k,2073) = lu(k,2073) - lu(k,774) * lu(k,2024) + lu(k,2075) = lu(k,2075) - lu(k,775) * lu(k,2024) + lu(k,2155) = lu(k,2155) - lu(k,766) * lu(k,2154) + lu(k,2164) = lu(k,2164) - lu(k,767) * lu(k,2154) + lu(k,2167) = lu(k,2167) - lu(k,768) * lu(k,2154) + lu(k,2174) = lu(k,2174) - lu(k,769) * lu(k,2154) + lu(k,2182) = lu(k,2182) - lu(k,770) * lu(k,2154) + lu(k,2188) = lu(k,2188) - lu(k,771) * lu(k,2154) + lu(k,2197) = lu(k,2197) - lu(k,772) * lu(k,2154) + lu(k,2198) = lu(k,2198) - lu(k,773) * lu(k,2154) + lu(k,2202) = lu(k,2202) - lu(k,774) * lu(k,2154) + lu(k,2204) = lu(k,2204) - lu(k,775) * lu(k,2154) end do end subroutine lu_fac16 subroutine lu_fac17( avec_len, lu ) @@ -2747,217 +2508,171 @@ subroutine lu_fac17( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - 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,1352) = lu(k,1352) - lu(k,754) * lu(k,1350) - lu(k,1354) = - lu(k,755) * lu(k,1350) - lu(k,1355) = - lu(k,756) * lu(k,1350) - lu(k,1357) = - lu(k,757) * lu(k,1350) - lu(k,1359) = - lu(k,758) * lu(k,1350) - lu(k,1360) = lu(k,1360) - lu(k,759) * lu(k,1350) - lu(k,1362) = - lu(k,760) * lu(k,1350) - lu(k,1565) = lu(k,1565) - lu(k,754) * lu(k,1562) - lu(k,1570) = lu(k,1570) - lu(k,755) * lu(k,1562) - lu(k,1571) = lu(k,1571) - lu(k,756) * lu(k,1562) - lu(k,1573) = lu(k,1573) - lu(k,757) * lu(k,1562) - lu(k,1576) = lu(k,1576) - lu(k,758) * lu(k,1562) - lu(k,1579) = lu(k,1579) - lu(k,759) * lu(k,1562) - lu(k,1582) = lu(k,1582) - lu(k,760) * lu(k,1562) - lu(k,1713) = lu(k,1713) - lu(k,754) * lu(k,1674) - lu(k,1718) = lu(k,1718) - lu(k,755) * lu(k,1674) - lu(k,1719) = lu(k,1719) - lu(k,756) * lu(k,1674) - lu(k,1721) = lu(k,1721) - lu(k,757) * lu(k,1674) - lu(k,1724) = lu(k,1724) - lu(k,758) * lu(k,1674) - lu(k,1727) = lu(k,1727) - lu(k,759) * lu(k,1674) - lu(k,1730) = lu(k,1730) - lu(k,760) * lu(k,1674) - lu(k,1816) = lu(k,1816) - lu(k,754) * lu(k,1808) - lu(k,1821) = lu(k,1821) - lu(k,755) * lu(k,1808) - lu(k,1822) = lu(k,1822) - lu(k,756) * lu(k,1808) - lu(k,1824) = lu(k,1824) - lu(k,757) * lu(k,1808) - lu(k,1827) = lu(k,1827) - lu(k,758) * lu(k,1808) - lu(k,1830) = lu(k,1830) - lu(k,759) * lu(k,1808) - lu(k,1833) = lu(k,1833) - lu(k,760) * lu(k,1808) - lu(k,1840) = lu(k,1840) - lu(k,754) * lu(k,1836) - lu(k,1845) = - lu(k,755) * lu(k,1836) - lu(k,1846) = lu(k,1846) - lu(k,756) * lu(k,1836) - lu(k,1848) = lu(k,1848) - lu(k,757) * lu(k,1836) - lu(k,1851) = lu(k,1851) - lu(k,758) * lu(k,1836) - lu(k,1854) = - lu(k,759) * lu(k,1836) - lu(k,1857) = lu(k,1857) - lu(k,760) * lu(k,1836) - lu(k,2100) = lu(k,2100) - lu(k,754) * lu(k,2070) - lu(k,2105) = - lu(k,755) * lu(k,2070) - lu(k,2106) = lu(k,2106) - lu(k,756) * lu(k,2070) - lu(k,2108) = lu(k,2108) - lu(k,757) * lu(k,2070) - lu(k,2111) = lu(k,2111) - lu(k,758) * lu(k,2070) - lu(k,2114) = lu(k,2114) - lu(k,759) * lu(k,2070) - lu(k,2117) = lu(k,2117) - lu(k,760) * lu(k,2070) - lu(k,762) = 1._r8 / lu(k,762) - lu(k,763) = lu(k,763) * lu(k,762) - lu(k,764) = lu(k,764) * lu(k,762) - lu(k,765) = lu(k,765) * lu(k,762) - lu(k,766) = lu(k,766) * lu(k,762) - lu(k,767) = lu(k,767) * lu(k,762) - lu(k,768) = lu(k,768) * lu(k,762) - lu(k,907) = lu(k,907) - lu(k,763) * lu(k,905) - lu(k,908) = lu(k,908) - lu(k,764) * lu(k,905) - lu(k,909) = lu(k,909) - lu(k,765) * lu(k,905) - lu(k,910) = lu(k,910) - lu(k,766) * lu(k,905) - lu(k,914) = lu(k,914) - lu(k,767) * lu(k,905) - lu(k,915) = - lu(k,768) * lu(k,905) - lu(k,1337) = lu(k,1337) - lu(k,763) * lu(k,1335) - lu(k,1339) = lu(k,1339) - lu(k,764) * lu(k,1335) - lu(k,1341) = lu(k,1341) - lu(k,765) * lu(k,1335) - lu(k,1342) = lu(k,1342) - lu(k,766) * lu(k,1335) - lu(k,1348) = lu(k,1348) - lu(k,767) * lu(k,1335) - lu(k,1349) = lu(k,1349) - lu(k,768) * lu(k,1335) - lu(k,1538) = lu(k,1538) - lu(k,763) * lu(k,1529) - lu(k,1543) = lu(k,1543) - lu(k,764) * lu(k,1529) - lu(k,1545) = lu(k,1545) - lu(k,765) * lu(k,1529) - lu(k,1547) = lu(k,1547) - lu(k,766) * lu(k,1529) - lu(k,1555) = lu(k,1555) - lu(k,767) * lu(k,1529) - lu(k,1556) = lu(k,1556) - lu(k,768) * lu(k,1529) - lu(k,1712) = lu(k,1712) - lu(k,763) * lu(k,1675) - lu(k,1717) = lu(k,1717) - lu(k,764) * lu(k,1675) - lu(k,1719) = lu(k,1719) - lu(k,765) * lu(k,1675) - lu(k,1721) = lu(k,1721) - lu(k,766) * lu(k,1675) - lu(k,1729) = lu(k,1729) - lu(k,767) * lu(k,1675) - lu(k,1730) = lu(k,1730) - lu(k,768) * lu(k,1675) - lu(k,1815) = lu(k,1815) - lu(k,763) * lu(k,1809) - lu(k,1820) = lu(k,1820) - lu(k,764) * lu(k,1809) - lu(k,1822) = lu(k,1822) - lu(k,765) * lu(k,1809) - lu(k,1824) = lu(k,1824) - lu(k,766) * lu(k,1809) - lu(k,1832) = lu(k,1832) - lu(k,767) * lu(k,1809) - lu(k,1833) = lu(k,1833) - lu(k,768) * lu(k,1809) - lu(k,2099) = lu(k,2099) - lu(k,763) * lu(k,2071) - lu(k,2104) = lu(k,2104) - lu(k,764) * lu(k,2071) - lu(k,2106) = lu(k,2106) - lu(k,765) * lu(k,2071) - lu(k,2108) = lu(k,2108) - lu(k,766) * lu(k,2071) - lu(k,2116) = lu(k,2116) - lu(k,767) * lu(k,2071) - lu(k,2117) = lu(k,2117) - lu(k,768) * lu(k,2071) - lu(k,2126) = lu(k,2126) - lu(k,763) * lu(k,2122) - lu(k,2131) = lu(k,2131) - lu(k,764) * lu(k,2122) - lu(k,2133) = lu(k,2133) - lu(k,765) * lu(k,2122) - lu(k,2135) = lu(k,2135) - lu(k,766) * lu(k,2122) - lu(k,2143) = lu(k,2143) - lu(k,767) * lu(k,2122) - lu(k,2144) = - lu(k,768) * lu(k,2122) - 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,930) = - lu(k,770) * lu(k,925) - lu(k,931) = - lu(k,771) * lu(k,925) - lu(k,934) = lu(k,934) - lu(k,772) * lu(k,925) - lu(k,935) = - lu(k,773) * lu(k,925) - lu(k,937) = lu(k,937) - lu(k,774) * lu(k,925) - lu(k,947) = - lu(k,770) * lu(k,942) - lu(k,948) = - lu(k,771) * lu(k,942) - lu(k,952) = lu(k,952) - lu(k,772) * lu(k,942) - lu(k,954) = lu(k,954) - lu(k,773) * lu(k,942) - lu(k,956) = lu(k,956) - lu(k,774) * lu(k,942) - lu(k,1126) = - lu(k,770) * lu(k,1119) - lu(k,1128) = lu(k,1128) - lu(k,771) * lu(k,1119) - lu(k,1131) = lu(k,1131) - lu(k,772) * lu(k,1119) - lu(k,1132) = lu(k,1132) - lu(k,773) * lu(k,1119) - lu(k,1136) = lu(k,1136) - lu(k,774) * lu(k,1119) - lu(k,1205) = lu(k,1205) - lu(k,770) * lu(k,1194) - lu(k,1210) = lu(k,1210) - lu(k,771) * lu(k,1194) - lu(k,1213) = lu(k,1213) - lu(k,772) * lu(k,1194) - lu(k,1215) = lu(k,1215) - lu(k,773) * lu(k,1194) - lu(k,1219) = lu(k,1219) - lu(k,774) * lu(k,1194) - lu(k,1389) = lu(k,1389) - lu(k,770) * lu(k,1371) - lu(k,1395) = lu(k,1395) - lu(k,771) * lu(k,1371) - lu(k,1400) = lu(k,1400) - lu(k,772) * lu(k,1371) - lu(k,1402) = lu(k,1402) - lu(k,773) * lu(k,1371) - lu(k,1406) = lu(k,1406) - lu(k,774) * lu(k,1371) - lu(k,1497) = lu(k,1497) - lu(k,770) * lu(k,1476) - lu(k,1503) = lu(k,1503) - lu(k,771) * lu(k,1476) - lu(k,1510) = lu(k,1510) - lu(k,772) * lu(k,1476) - lu(k,1513) = lu(k,1513) - lu(k,773) * lu(k,1476) - lu(k,1517) = lu(k,1517) - lu(k,774) * lu(k,1476) - lu(k,1704) = lu(k,1704) - lu(k,770) * lu(k,1676) - lu(k,1710) = lu(k,1710) - lu(k,771) * lu(k,1676) - lu(k,1719) = lu(k,1719) - lu(k,772) * lu(k,1676) - lu(k,1722) = lu(k,1722) - lu(k,773) * lu(k,1676) - lu(k,1726) = lu(k,1726) - lu(k,774) * lu(k,1676) - lu(k,1889) = lu(k,1889) - lu(k,770) * lu(k,1865) - lu(k,1895) = lu(k,1895) - lu(k,771) * lu(k,1865) - lu(k,1903) = lu(k,1903) - lu(k,772) * lu(k,1865) - lu(k,1906) = lu(k,1906) - lu(k,773) * lu(k,1865) - lu(k,1910) = lu(k,1910) - lu(k,774) * lu(k,1865) - lu(k,2092) = lu(k,2092) - lu(k,770) * lu(k,2072) - lu(k,2098) = lu(k,2098) - lu(k,771) * lu(k,2072) - lu(k,2106) = lu(k,2106) - lu(k,772) * lu(k,2072) - lu(k,2109) = lu(k,2109) - lu(k,773) * lu(k,2072) - lu(k,2113) = lu(k,2113) - lu(k,774) * lu(k,2072) - lu(k,781) = 1._r8 / lu(k,781) - lu(k,782) = lu(k,782) * lu(k,781) - lu(k,783) = lu(k,783) * lu(k,781) - lu(k,784) = lu(k,784) * lu(k,781) - lu(k,785) = lu(k,785) * lu(k,781) - lu(k,786) = lu(k,786) * lu(k,781) - lu(k,787) = lu(k,787) * lu(k,781) - lu(k,788) = lu(k,788) * lu(k,781) - lu(k,789) = lu(k,789) * lu(k,781) - lu(k,790) = lu(k,790) * lu(k,781) - lu(k,791) = lu(k,791) * lu(k,781) - lu(k,792) = lu(k,792) * lu(k,781) - lu(k,793) = lu(k,793) * lu(k,781) - lu(k,794) = lu(k,794) * lu(k,781) - lu(k,795) = lu(k,795) * lu(k,781) - lu(k,796) = lu(k,796) * lu(k,781) - lu(k,1689) = lu(k,1689) - lu(k,782) * lu(k,1677) - lu(k,1694) = lu(k,1694) - lu(k,783) * lu(k,1677) - lu(k,1702) = - lu(k,784) * lu(k,1677) - lu(k,1703) = lu(k,1703) - lu(k,785) * lu(k,1677) - lu(k,1705) = lu(k,1705) - lu(k,786) * lu(k,1677) - lu(k,1706) = lu(k,1706) - lu(k,787) * lu(k,1677) - lu(k,1708) = lu(k,1708) - lu(k,788) * lu(k,1677) - lu(k,1710) = lu(k,1710) - lu(k,789) * lu(k,1677) - lu(k,1714) = lu(k,1714) - lu(k,790) * lu(k,1677) - lu(k,1719) = lu(k,1719) - lu(k,791) * lu(k,1677) - lu(k,1720) = lu(k,1720) - lu(k,792) * lu(k,1677) - lu(k,1722) = lu(k,1722) - lu(k,793) * lu(k,1677) - lu(k,1723) = lu(k,1723) - lu(k,794) * lu(k,1677) - lu(k,1728) = lu(k,1728) - lu(k,795) * lu(k,1677) - lu(k,1730) = lu(k,1730) - lu(k,796) * lu(k,1677) - lu(k,1755) = lu(k,1755) - lu(k,782) * lu(k,1747) - lu(k,1759) = lu(k,1759) - lu(k,783) * lu(k,1747) - lu(k,1765) = - lu(k,784) * lu(k,1747) - lu(k,1766) = lu(k,1766) - lu(k,785) * lu(k,1747) - lu(k,1768) = - lu(k,786) * lu(k,1747) - lu(k,1769) = - lu(k,787) * lu(k,1747) - lu(k,1771) = lu(k,1771) - lu(k,788) * lu(k,1747) - lu(k,1773) = lu(k,1773) - lu(k,789) * lu(k,1747) - lu(k,1776) = lu(k,1776) - lu(k,790) * lu(k,1747) - lu(k,1781) = lu(k,1781) - lu(k,791) * lu(k,1747) - lu(k,1782) = lu(k,1782) - lu(k,792) * lu(k,1747) - lu(k,1784) = lu(k,1784) - lu(k,793) * lu(k,1747) - lu(k,1785) = lu(k,1785) - lu(k,794) * lu(k,1747) - lu(k,1790) = lu(k,1790) - lu(k,795) * lu(k,1747) - lu(k,1792) = lu(k,1792) - lu(k,796) * lu(k,1747) - lu(k,1875) = lu(k,1875) - lu(k,782) * lu(k,1866) - lu(k,1880) = lu(k,1880) - lu(k,783) * lu(k,1866) - lu(k,1887) = lu(k,1887) - lu(k,784) * lu(k,1866) - lu(k,1888) = lu(k,1888) - lu(k,785) * lu(k,1866) - lu(k,1890) = lu(k,1890) - lu(k,786) * lu(k,1866) - lu(k,1891) = lu(k,1891) - lu(k,787) * lu(k,1866) - lu(k,1893) = lu(k,1893) - lu(k,788) * lu(k,1866) - lu(k,1895) = lu(k,1895) - lu(k,789) * lu(k,1866) - lu(k,1898) = - lu(k,790) * lu(k,1866) - lu(k,1903) = lu(k,1903) - lu(k,791) * lu(k,1866) - lu(k,1904) = - lu(k,792) * lu(k,1866) - lu(k,1906) = lu(k,1906) - lu(k,793) * lu(k,1866) - lu(k,1907) = lu(k,1907) - lu(k,794) * lu(k,1866) - lu(k,1912) = lu(k,1912) - lu(k,795) * lu(k,1866) - lu(k,1914) = - lu(k,796) * lu(k,1866) + lu(k,776) = 1._r8 / lu(k,776) + lu(k,777) = lu(k,777) * lu(k,776) + lu(k,778) = lu(k,778) * lu(k,776) + lu(k,779) = lu(k,779) * lu(k,776) + lu(k,780) = lu(k,780) * lu(k,776) + lu(k,781) = lu(k,781) * lu(k,776) + lu(k,782) = lu(k,782) * lu(k,776) + lu(k,783) = lu(k,783) * lu(k,776) + lu(k,1774) = lu(k,1774) - lu(k,777) * lu(k,1746) + lu(k,1783) = lu(k,1783) - lu(k,778) * lu(k,1746) + lu(k,1799) = lu(k,1799) - lu(k,779) * lu(k,1746) + lu(k,1800) = lu(k,1800) - lu(k,780) * lu(k,1746) + lu(k,1804) = lu(k,1804) - lu(k,781) * lu(k,1746) + lu(k,1806) = lu(k,1806) - lu(k,782) * lu(k,1746) + lu(k,1807) = lu(k,1807) - lu(k,783) * lu(k,1746) + lu(k,1831) = lu(k,1831) - lu(k,777) * lu(k,1824) + lu(k,1833) = - lu(k,778) * lu(k,1824) + lu(k,1844) = lu(k,1844) - lu(k,779) * lu(k,1824) + lu(k,1845) = lu(k,1845) - lu(k,780) * lu(k,1824) + lu(k,1849) = lu(k,1849) - lu(k,781) * lu(k,1824) + lu(k,1851) = lu(k,1851) - lu(k,782) * lu(k,1824) + lu(k,1852) = lu(k,1852) - lu(k,783) * lu(k,1824) + lu(k,2046) = lu(k,2046) - lu(k,777) * lu(k,2025) + lu(k,2055) = lu(k,2055) - lu(k,778) * lu(k,2025) + lu(k,2068) = lu(k,2068) - lu(k,779) * lu(k,2025) + lu(k,2069) = lu(k,2069) - lu(k,780) * lu(k,2025) + lu(k,2073) = lu(k,2073) - lu(k,781) * lu(k,2025) + lu(k,2075) = lu(k,2075) - lu(k,782) * lu(k,2025) + lu(k,2076) = lu(k,2076) - lu(k,783) * lu(k,2025) + lu(k,2174) = lu(k,2174) - lu(k,777) * lu(k,2155) + lu(k,2182) = lu(k,2182) - lu(k,778) * lu(k,2155) + lu(k,2197) = lu(k,2197) - lu(k,779) * lu(k,2155) + lu(k,2198) = lu(k,2198) - lu(k,780) * lu(k,2155) + lu(k,2202) = lu(k,2202) - lu(k,781) * lu(k,2155) + lu(k,2204) = lu(k,2204) - lu(k,782) * lu(k,2155) + lu(k,2205) = lu(k,2205) - lu(k,783) * lu(k,2155) + lu(k,785) = 1._r8 / lu(k,785) + lu(k,786) = lu(k,786) * lu(k,785) + lu(k,787) = lu(k,787) * lu(k,785) + lu(k,788) = lu(k,788) * lu(k,785) + lu(k,789) = lu(k,789) * lu(k,785) + lu(k,790) = lu(k,790) * lu(k,785) + lu(k,791) = lu(k,791) * lu(k,785) + lu(k,792) = lu(k,792) * lu(k,785) + lu(k,1493) = lu(k,1493) - lu(k,786) * lu(k,1490) + lu(k,1494) = lu(k,1494) - lu(k,787) * lu(k,1490) + lu(k,1495) = - lu(k,788) * lu(k,1490) + lu(k,1498) = lu(k,1498) - lu(k,789) * lu(k,1490) + lu(k,1501) = lu(k,1501) - lu(k,790) * lu(k,1490) + lu(k,1504) = lu(k,1504) - lu(k,791) * lu(k,1490) + lu(k,1505) = lu(k,1505) - lu(k,792) * lu(k,1490) + lu(k,1560) = - lu(k,786) * lu(k,1557) + lu(k,1561) = lu(k,1561) - lu(k,787) * lu(k,1557) + lu(k,1563) = lu(k,1563) - lu(k,788) * lu(k,1557) + lu(k,1566) = lu(k,1566) - lu(k,789) * lu(k,1557) + lu(k,1569) = lu(k,1569) - lu(k,790) * lu(k,1557) + lu(k,1574) = lu(k,1574) - lu(k,791) * lu(k,1557) + lu(k,1577) = - lu(k,792) * lu(k,1557) + lu(k,1838) = - lu(k,786) * lu(k,1825) + lu(k,1839) = lu(k,1839) - lu(k,787) * lu(k,1825) + lu(k,1841) = lu(k,1841) - lu(k,788) * lu(k,1825) + lu(k,1844) = lu(k,1844) - lu(k,789) * lu(k,1825) + lu(k,1847) = - lu(k,790) * lu(k,1825) + lu(k,1854) = lu(k,1854) - lu(k,791) * lu(k,1825) + lu(k,1857) = lu(k,1857) - lu(k,792) * lu(k,1825) + lu(k,2191) = lu(k,2191) - lu(k,786) * lu(k,2156) + lu(k,2192) = lu(k,2192) - lu(k,787) * lu(k,2156) + lu(k,2194) = lu(k,2194) - lu(k,788) * lu(k,2156) + lu(k,2197) = lu(k,2197) - lu(k,789) * lu(k,2156) + lu(k,2200) = lu(k,2200) - lu(k,790) * lu(k,2156) + lu(k,2207) = lu(k,2207) - lu(k,791) * lu(k,2156) + lu(k,2210) = lu(k,2210) - lu(k,792) * lu(k,2156) + lu(k,2311) = lu(k,2311) - lu(k,786) * lu(k,2297) + lu(k,2312) = lu(k,2312) - lu(k,787) * lu(k,2297) + lu(k,2314) = lu(k,2314) - lu(k,788) * lu(k,2297) + lu(k,2317) = lu(k,2317) - lu(k,789) * lu(k,2297) + lu(k,2320) = lu(k,2320) - lu(k,790) * lu(k,2297) + lu(k,2327) = lu(k,2327) - lu(k,791) * lu(k,2297) + lu(k,2330) = lu(k,2330) - lu(k,792) * lu(k,2297) + lu(k,795) = 1._r8 / lu(k,795) + lu(k,796) = lu(k,796) * lu(k,795) + lu(k,797) = lu(k,797) * lu(k,795) + lu(k,798) = lu(k,798) * lu(k,795) + lu(k,799) = lu(k,799) * lu(k,795) + lu(k,800) = lu(k,800) * lu(k,795) + lu(k,801) = lu(k,801) * lu(k,795) + lu(k,802) = lu(k,802) * lu(k,795) + lu(k,1775) = lu(k,1775) - lu(k,796) * lu(k,1747) + lu(k,1795) = lu(k,1795) - lu(k,797) * lu(k,1747) + lu(k,1799) = lu(k,1799) - lu(k,798) * lu(k,1747) + lu(k,1800) = lu(k,1800) - lu(k,799) * lu(k,1747) + lu(k,1804) = lu(k,1804) - lu(k,800) * lu(k,1747) + lu(k,1806) = lu(k,1806) - lu(k,801) * lu(k,1747) + lu(k,1810) = lu(k,1810) - lu(k,802) * lu(k,1747) + lu(k,1938) = - lu(k,796) * lu(k,1928) + lu(k,1946) = lu(k,1946) - lu(k,797) * lu(k,1928) + lu(k,1950) = lu(k,1950) - lu(k,798) * lu(k,1928) + lu(k,1951) = - lu(k,799) * lu(k,1928) + lu(k,1955) = - lu(k,800) * lu(k,1928) + lu(k,1957) = lu(k,1957) - lu(k,801) * lu(k,1928) + lu(k,1961) = lu(k,1961) - lu(k,802) * lu(k,1928) + lu(k,2047) = lu(k,2047) - lu(k,796) * lu(k,2026) + lu(k,2064) = lu(k,2064) - lu(k,797) * lu(k,2026) + lu(k,2068) = lu(k,2068) - lu(k,798) * lu(k,2026) + lu(k,2069) = lu(k,2069) - lu(k,799) * lu(k,2026) + lu(k,2073) = lu(k,2073) - lu(k,800) * lu(k,2026) + lu(k,2075) = lu(k,2075) - lu(k,801) * lu(k,2026) + lu(k,2079) = lu(k,2079) - lu(k,802) * lu(k,2026) + lu(k,2175) = lu(k,2175) - lu(k,796) * lu(k,2157) + lu(k,2193) = lu(k,2193) - lu(k,797) * lu(k,2157) + lu(k,2197) = lu(k,2197) - lu(k,798) * lu(k,2157) + lu(k,2198) = lu(k,2198) - lu(k,799) * lu(k,2157) + lu(k,2202) = lu(k,2202) - lu(k,800) * lu(k,2157) + lu(k,2204) = lu(k,2204) - lu(k,801) * lu(k,2157) + lu(k,2208) = lu(k,2208) - lu(k,802) * lu(k,2157) + lu(k,2387) = - lu(k,796) * lu(k,2371) + lu(k,2403) = lu(k,2403) - lu(k,797) * lu(k,2371) + lu(k,2407) = lu(k,2407) - lu(k,798) * lu(k,2371) + lu(k,2408) = lu(k,2408) - lu(k,799) * lu(k,2371) + lu(k,2412) = lu(k,2412) - lu(k,800) * lu(k,2371) + lu(k,2414) = lu(k,2414) - lu(k,801) * lu(k,2371) + lu(k,2418) = lu(k,2418) - lu(k,802) * lu(k,2371) + lu(k,803) = 1._r8 / lu(k,803) + lu(k,804) = lu(k,804) * lu(k,803) + lu(k,805) = lu(k,805) * lu(k,803) + lu(k,806) = lu(k,806) * lu(k,803) + lu(k,807) = lu(k,807) * lu(k,803) + lu(k,808) = lu(k,808) * lu(k,803) + lu(k,809) = lu(k,809) * lu(k,803) + lu(k,810) = lu(k,810) * lu(k,803) + lu(k,861) = lu(k,861) - lu(k,804) * lu(k,860) + lu(k,862) = lu(k,862) - lu(k,805) * lu(k,860) + lu(k,864) = lu(k,864) - lu(k,806) * lu(k,860) + lu(k,865) = - lu(k,807) * lu(k,860) + lu(k,866) = - lu(k,808) * lu(k,860) + lu(k,867) = lu(k,867) - lu(k,809) * lu(k,860) + lu(k,870) = lu(k,870) - lu(k,810) * lu(k,860) + lu(k,966) = lu(k,966) - lu(k,804) * lu(k,965) + lu(k,967) = lu(k,967) - lu(k,805) * lu(k,965) + lu(k,969) = lu(k,969) - lu(k,806) * lu(k,965) + lu(k,970) = - lu(k,807) * lu(k,965) + lu(k,971) = - lu(k,808) * lu(k,965) + lu(k,972) = lu(k,972) - lu(k,809) * lu(k,965) + lu(k,978) = lu(k,978) - lu(k,810) * lu(k,965) + lu(k,1443) = - lu(k,804) * lu(k,1442) + lu(k,1444) = lu(k,1444) - lu(k,805) * lu(k,1442) + lu(k,1446) = - lu(k,806) * lu(k,1442) + lu(k,1447) = lu(k,1447) - lu(k,807) * lu(k,1442) + lu(k,1448) = lu(k,1448) - lu(k,808) * lu(k,1442) + lu(k,1449) = lu(k,1449) - lu(k,809) * lu(k,1442) + lu(k,1456) = lu(k,1456) - lu(k,810) * lu(k,1442) + lu(k,1530) = lu(k,1530) - lu(k,804) * lu(k,1529) + lu(k,1531) = lu(k,1531) - lu(k,805) * lu(k,1529) + lu(k,1534) = lu(k,1534) - lu(k,806) * lu(k,1529) + lu(k,1535) = - lu(k,807) * lu(k,1529) + lu(k,1537) = - lu(k,808) * lu(k,1529) + lu(k,1540) = lu(k,1540) - lu(k,809) * lu(k,1529) + lu(k,1550) = lu(k,1550) - lu(k,810) * lu(k,1529) + lu(k,2301) = lu(k,2301) - lu(k,804) * lu(k,2298) + lu(k,2302) = lu(k,2302) - lu(k,805) * lu(k,2298) + lu(k,2306) = lu(k,2306) - lu(k,806) * lu(k,2298) + lu(k,2307) = lu(k,2307) - lu(k,807) * lu(k,2298) + lu(k,2308) = - lu(k,808) * lu(k,2298) + lu(k,2313) = lu(k,2313) - lu(k,809) * lu(k,2298) + lu(k,2327) = lu(k,2327) - lu(k,810) * lu(k,2298) end do end subroutine lu_fac17 subroutine lu_fac18( avec_len, lu ) @@ -2974,295 +2689,240 @@ subroutine lu_fac18( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,798) = 1._r8 / lu(k,798) - lu(k,799) = lu(k,799) * lu(k,798) - lu(k,800) = lu(k,800) * lu(k,798) - lu(k,801) = lu(k,801) * lu(k,798) - lu(k,804) = lu(k,804) - lu(k,799) * lu(k,802) - lu(k,808) = lu(k,808) - lu(k,800) * lu(k,802) - lu(k,810) = lu(k,810) - lu(k,801) * lu(k,802) - lu(k,825) = lu(k,825) - lu(k,799) * lu(k,819) - lu(k,831) = lu(k,831) - lu(k,800) * lu(k,819) - lu(k,835) = lu(k,835) - lu(k,801) * lu(k,819) - lu(k,863) = lu(k,863) - lu(k,799) * lu(k,857) - lu(k,869) = lu(k,869) - lu(k,800) * lu(k,857) - lu(k,873) = lu(k,873) - lu(k,801) * lu(k,857) - lu(k,929) = lu(k,929) - lu(k,799) * lu(k,926) - lu(k,934) = lu(k,934) - lu(k,800) * lu(k,926) - lu(k,938) = lu(k,938) - lu(k,801) * lu(k,926) - lu(k,961) = lu(k,961) - lu(k,799) * lu(k,959) - lu(k,962) = lu(k,962) - lu(k,800) * lu(k,959) - lu(k,964) = lu(k,964) - lu(k,801) * lu(k,959) - lu(k,1090) = lu(k,1090) - lu(k,799) * lu(k,1087) - lu(k,1096) = lu(k,1096) - lu(k,800) * lu(k,1087) - lu(k,1101) = lu(k,1101) - lu(k,801) * lu(k,1087) - lu(k,1200) = lu(k,1200) - lu(k,799) * lu(k,1195) - lu(k,1213) = lu(k,1213) - lu(k,800) * lu(k,1195) - lu(k,1220) = lu(k,1220) - lu(k,801) * lu(k,1195) - lu(k,1292) = lu(k,1292) - lu(k,799) * lu(k,1288) - lu(k,1306) = lu(k,1306) - lu(k,800) * lu(k,1288) - lu(k,1313) = lu(k,1313) - lu(k,801) * lu(k,1288) - lu(k,1380) = lu(k,1380) - lu(k,799) * lu(k,1372) - lu(k,1400) = lu(k,1400) - lu(k,800) * lu(k,1372) - lu(k,1407) = lu(k,1407) - lu(k,801) * lu(k,1372) - lu(k,1488) = lu(k,1488) - lu(k,799) * lu(k,1477) - lu(k,1510) = lu(k,1510) - lu(k,800) * lu(k,1477) - lu(k,1519) = lu(k,1519) - lu(k,801) * lu(k,1477) - lu(k,1534) = lu(k,1534) - lu(k,799) * lu(k,1530) - lu(k,1545) = lu(k,1545) - lu(k,800) * lu(k,1530) - lu(k,1554) = lu(k,1554) - lu(k,801) * lu(k,1530) - lu(k,1694) = lu(k,1694) - lu(k,799) * lu(k,1678) - lu(k,1719) = lu(k,1719) - lu(k,800) * lu(k,1678) - lu(k,1728) = lu(k,1728) - lu(k,801) * lu(k,1678) - lu(k,1759) = lu(k,1759) - lu(k,799) * lu(k,1748) - lu(k,1781) = lu(k,1781) - lu(k,800) * lu(k,1748) - lu(k,1790) = lu(k,1790) - lu(k,801) * lu(k,1748) - lu(k,1880) = lu(k,1880) - lu(k,799) * lu(k,1867) - lu(k,1903) = lu(k,1903) - lu(k,800) * lu(k,1867) - lu(k,1912) = lu(k,1912) - lu(k,801) * lu(k,1867) - lu(k,1975) = lu(k,1975) - lu(k,799) * lu(k,1970) - lu(k,1987) = lu(k,1987) - lu(k,800) * lu(k,1970) - lu(k,1996) = lu(k,1996) - lu(k,801) * lu(k,1970) - lu(k,2082) = lu(k,2082) - lu(k,799) * lu(k,2073) - lu(k,2106) = lu(k,2106) - lu(k,800) * lu(k,2073) - lu(k,2115) = lu(k,2115) - lu(k,801) * lu(k,2073) - lu(k,803) = 1._r8 / lu(k,803) - lu(k,804) = lu(k,804) * lu(k,803) - lu(k,805) = lu(k,805) * lu(k,803) - lu(k,806) = lu(k,806) * lu(k,803) - lu(k,807) = lu(k,807) * lu(k,803) - lu(k,808) = lu(k,808) * lu(k,803) - lu(k,809) = lu(k,809) * lu(k,803) - lu(k,810) = lu(k,810) * lu(k,803) - lu(k,929) = lu(k,929) - lu(k,804) * lu(k,927) - lu(k,930) = lu(k,930) - lu(k,805) * lu(k,927) - lu(k,932) = - lu(k,806) * lu(k,927) - lu(k,933) = - lu(k,807) * lu(k,927) - lu(k,934) = lu(k,934) - lu(k,808) * lu(k,927) - lu(k,937) = lu(k,937) - lu(k,809) * lu(k,927) - lu(k,938) = lu(k,938) - lu(k,810) * lu(k,927) - lu(k,1200) = lu(k,1200) - lu(k,804) * lu(k,1196) - lu(k,1205) = lu(k,1205) - lu(k,805) * lu(k,1196) - lu(k,1211) = lu(k,1211) - lu(k,806) * lu(k,1196) - lu(k,1212) = lu(k,1212) - lu(k,807) * lu(k,1196) - lu(k,1213) = lu(k,1213) - lu(k,808) * lu(k,1196) - lu(k,1219) = lu(k,1219) - lu(k,809) * lu(k,1196) - lu(k,1220) = lu(k,1220) - lu(k,810) * lu(k,1196) - lu(k,1488) = lu(k,1488) - lu(k,804) * lu(k,1478) - lu(k,1497) = lu(k,1497) - lu(k,805) * lu(k,1478) - lu(k,1505) = lu(k,1505) - lu(k,806) * lu(k,1478) - lu(k,1507) = lu(k,1507) - lu(k,807) * lu(k,1478) - lu(k,1510) = lu(k,1510) - lu(k,808) * lu(k,1478) - lu(k,1517) = lu(k,1517) - lu(k,809) * lu(k,1478) - lu(k,1519) = lu(k,1519) - lu(k,810) * lu(k,1478) - lu(k,1694) = lu(k,1694) - lu(k,804) * lu(k,1679) - lu(k,1704) = lu(k,1704) - lu(k,805) * lu(k,1679) - lu(k,1714) = lu(k,1714) - lu(k,806) * lu(k,1679) - lu(k,1716) = lu(k,1716) - lu(k,807) * lu(k,1679) - lu(k,1719) = lu(k,1719) - lu(k,808) * lu(k,1679) - lu(k,1726) = lu(k,1726) - lu(k,809) * lu(k,1679) - lu(k,1728) = lu(k,1728) - lu(k,810) * lu(k,1679) - lu(k,1975) = lu(k,1975) - lu(k,804) * lu(k,1971) - lu(k,1976) = lu(k,1976) - lu(k,805) * lu(k,1971) - lu(k,1982) = lu(k,1982) - lu(k,806) * lu(k,1971) - lu(k,1984) = lu(k,1984) - lu(k,807) * lu(k,1971) - lu(k,1987) = lu(k,1987) - lu(k,808) * lu(k,1971) - lu(k,1994) = lu(k,1994) - lu(k,809) * lu(k,1971) - lu(k,1996) = lu(k,1996) - lu(k,810) * lu(k,1971) - lu(k,2082) = lu(k,2082) - lu(k,804) * lu(k,2074) - lu(k,2092) = lu(k,2092) - lu(k,805) * lu(k,2074) - lu(k,2101) = lu(k,2101) - lu(k,806) * lu(k,2074) - lu(k,2103) = lu(k,2103) - lu(k,807) * lu(k,2074) - lu(k,2106) = lu(k,2106) - lu(k,808) * lu(k,2074) - lu(k,2113) = lu(k,2113) - lu(k,809) * lu(k,2074) - lu(k,2115) = lu(k,2115) - lu(k,810) * lu(k,2074) - 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,832) = lu(k,832) * lu(k,820) - lu(k,833) = lu(k,833) * lu(k,820) - lu(k,834) = lu(k,834) * lu(k,820) - lu(k,835) = lu(k,835) * lu(k,820) - lu(k,836) = lu(k,836) * lu(k,820) - lu(k,1683) = lu(k,1683) - lu(k,821) * lu(k,1680) - lu(k,1685) = lu(k,1685) - lu(k,822) * lu(k,1680) - lu(k,1687) = lu(k,1687) - lu(k,823) * lu(k,1680) - lu(k,1692) = lu(k,1692) - lu(k,824) * lu(k,1680) - lu(k,1694) = lu(k,1694) - lu(k,825) * lu(k,1680) - lu(k,1695) = lu(k,1695) - lu(k,826) * lu(k,1680) - lu(k,1697) = lu(k,1697) - lu(k,827) * lu(k,1680) - lu(k,1698) = lu(k,1698) - lu(k,828) * lu(k,1680) - lu(k,1704) = lu(k,1704) - lu(k,829) * lu(k,1680) - lu(k,1710) = lu(k,1710) - lu(k,830) * lu(k,1680) - lu(k,1719) = lu(k,1719) - lu(k,831) * lu(k,1680) - lu(k,1720) = lu(k,1720) - lu(k,832) * lu(k,1680) - lu(k,1722) = lu(k,1722) - lu(k,833) * lu(k,1680) - lu(k,1723) = lu(k,1723) - lu(k,834) * lu(k,1680) - lu(k,1728) = lu(k,1728) - lu(k,835) * lu(k,1680) - lu(k,1730) = lu(k,1730) - lu(k,836) * lu(k,1680) - lu(k,1751) = lu(k,1751) - lu(k,821) * lu(k,1749) - lu(k,1753) = lu(k,1753) - lu(k,822) * lu(k,1749) - lu(k,1754) = lu(k,1754) - lu(k,823) * lu(k,1749) - lu(k,1757) = lu(k,1757) - lu(k,824) * lu(k,1749) - lu(k,1759) = lu(k,1759) - lu(k,825) * lu(k,1749) - lu(k,1760) = - lu(k,826) * lu(k,1749) - lu(k,1762) = - lu(k,827) * lu(k,1749) - lu(k,1763) = lu(k,1763) - lu(k,828) * lu(k,1749) - lu(k,1767) = lu(k,1767) - lu(k,829) * lu(k,1749) - lu(k,1773) = lu(k,1773) - lu(k,830) * lu(k,1749) - lu(k,1781) = lu(k,1781) - lu(k,831) * lu(k,1749) - lu(k,1782) = lu(k,1782) - lu(k,832) * lu(k,1749) - lu(k,1784) = lu(k,1784) - lu(k,833) * lu(k,1749) - lu(k,1785) = lu(k,1785) - lu(k,834) * lu(k,1749) - lu(k,1790) = lu(k,1790) - lu(k,835) * lu(k,1749) - lu(k,1792) = lu(k,1792) - lu(k,836) * lu(k,1749) - lu(k,1870) = - lu(k,821) * lu(k,1868) - lu(k,1872) = lu(k,1872) - lu(k,822) * lu(k,1868) - lu(k,1873) = lu(k,1873) - lu(k,823) * lu(k,1868) - lu(k,1878) = - lu(k,824) * lu(k,1868) - lu(k,1880) = lu(k,1880) - lu(k,825) * lu(k,1868) - lu(k,1881) = - lu(k,826) * lu(k,1868) - lu(k,1883) = lu(k,1883) - lu(k,827) * lu(k,1868) - lu(k,1884) = - lu(k,828) * lu(k,1868) - lu(k,1889) = lu(k,1889) - lu(k,829) * lu(k,1868) - lu(k,1895) = lu(k,1895) - lu(k,830) * lu(k,1868) - lu(k,1903) = lu(k,1903) - lu(k,831) * lu(k,1868) - lu(k,1904) = lu(k,1904) - lu(k,832) * lu(k,1868) - lu(k,1906) = lu(k,1906) - lu(k,833) * lu(k,1868) - lu(k,1907) = lu(k,1907) - lu(k,834) * lu(k,1868) - lu(k,1912) = lu(k,1912) - lu(k,835) * lu(k,1868) - lu(k,1914) = lu(k,1914) - lu(k,836) * lu(k,1868) - lu(k,840) = 1._r8 / lu(k,840) - lu(k,841) = lu(k,841) * lu(k,840) - lu(k,842) = lu(k,842) * lu(k,840) - lu(k,843) = lu(k,843) * lu(k,840) - lu(k,844) = lu(k,844) * lu(k,840) - lu(k,845) = lu(k,845) * lu(k,840) - lu(k,846) = lu(k,846) * lu(k,840) - lu(k,847) = lu(k,847) * lu(k,840) - lu(k,848) = lu(k,848) * lu(k,840) - lu(k,882) = lu(k,882) - lu(k,841) * lu(k,879) - lu(k,884) = - lu(k,842) * lu(k,879) - lu(k,885) = - lu(k,843) * lu(k,879) - lu(k,886) = lu(k,886) - lu(k,844) * lu(k,879) - lu(k,887) = lu(k,887) - lu(k,845) * lu(k,879) - lu(k,888) = lu(k,888) - lu(k,846) * lu(k,879) - lu(k,889) = lu(k,889) - lu(k,847) * lu(k,879) - lu(k,890) = lu(k,890) - lu(k,848) * lu(k,879) - lu(k,1385) = lu(k,1385) - lu(k,841) * lu(k,1373) - lu(k,1396) = lu(k,1396) - lu(k,842) * lu(k,1373) - lu(k,1397) = lu(k,1397) - lu(k,843) * lu(k,1373) - lu(k,1398) = lu(k,1398) - lu(k,844) * lu(k,1373) - lu(k,1400) = lu(k,1400) - lu(k,845) * lu(k,1373) - lu(k,1402) = lu(k,1402) - lu(k,846) * lu(k,1373) - lu(k,1406) = lu(k,1406) - lu(k,847) * lu(k,1373) - lu(k,1407) = lu(k,1407) - lu(k,848) * lu(k,1373) - lu(k,1493) = lu(k,1493) - lu(k,841) * lu(k,1479) - lu(k,1505) = lu(k,1505) - lu(k,842) * lu(k,1479) - lu(k,1506) = lu(k,1506) - lu(k,843) * lu(k,1479) - lu(k,1507) = lu(k,1507) - lu(k,844) * lu(k,1479) - lu(k,1510) = lu(k,1510) - lu(k,845) * lu(k,1479) - lu(k,1513) = lu(k,1513) - lu(k,846) * lu(k,1479) - lu(k,1517) = lu(k,1517) - lu(k,847) * lu(k,1479) - lu(k,1519) = lu(k,1519) - lu(k,848) * lu(k,1479) - lu(k,1535) = - lu(k,841) * lu(k,1531) - lu(k,1540) = lu(k,1540) - lu(k,842) * lu(k,1531) - lu(k,1541) = lu(k,1541) - lu(k,843) * lu(k,1531) - lu(k,1542) = lu(k,1542) - lu(k,844) * lu(k,1531) - lu(k,1545) = lu(k,1545) - lu(k,845) * lu(k,1531) - lu(k,1548) = lu(k,1548) - lu(k,846) * lu(k,1531) - lu(k,1552) = lu(k,1552) - lu(k,847) * lu(k,1531) - lu(k,1554) = lu(k,1554) - lu(k,848) * lu(k,1531) - lu(k,1699) = lu(k,1699) - lu(k,841) * lu(k,1681) - lu(k,1714) = lu(k,1714) - lu(k,842) * lu(k,1681) - lu(k,1715) = lu(k,1715) - lu(k,843) * lu(k,1681) - lu(k,1716) = lu(k,1716) - lu(k,844) * lu(k,1681) - lu(k,1719) = lu(k,1719) - lu(k,845) * lu(k,1681) - lu(k,1722) = lu(k,1722) - lu(k,846) * lu(k,1681) - lu(k,1726) = lu(k,1726) - lu(k,847) * lu(k,1681) - lu(k,1728) = lu(k,1728) - lu(k,848) * lu(k,1681) - lu(k,2087) = lu(k,2087) - lu(k,841) * lu(k,2075) - lu(k,2101) = lu(k,2101) - lu(k,842) * lu(k,2075) - lu(k,2102) = lu(k,2102) - lu(k,843) * lu(k,2075) - lu(k,2103) = lu(k,2103) - lu(k,844) * lu(k,2075) - lu(k,2106) = lu(k,2106) - lu(k,845) * lu(k,2075) - lu(k,2109) = lu(k,2109) - lu(k,846) * lu(k,2075) - lu(k,2113) = lu(k,2113) - lu(k,847) * lu(k,2075) - lu(k,2115) = lu(k,2115) - lu(k,848) * lu(k,2075) - lu(k,858) = 1._r8 / lu(k,858) - lu(k,859) = lu(k,859) * lu(k,858) - lu(k,860) = lu(k,860) * lu(k,858) - lu(k,861) = lu(k,861) * lu(k,858) - lu(k,862) = lu(k,862) * lu(k,858) - lu(k,863) = lu(k,863) * lu(k,858) - lu(k,864) = lu(k,864) * lu(k,858) - lu(k,865) = lu(k,865) * lu(k,858) - lu(k,866) = lu(k,866) * lu(k,858) - lu(k,867) = lu(k,867) * lu(k,858) - lu(k,868) = lu(k,868) * lu(k,858) - lu(k,869) = lu(k,869) * lu(k,858) - lu(k,870) = lu(k,870) * lu(k,858) - lu(k,871) = lu(k,871) * lu(k,858) - lu(k,872) = lu(k,872) * lu(k,858) - lu(k,873) = lu(k,873) * lu(k,858) - lu(k,874) = lu(k,874) * lu(k,858) - lu(k,1683) = lu(k,1683) - lu(k,859) * lu(k,1682) - lu(k,1685) = lu(k,1685) - lu(k,860) * lu(k,1682) - lu(k,1687) = lu(k,1687) - lu(k,861) * lu(k,1682) - lu(k,1692) = lu(k,1692) - lu(k,862) * lu(k,1682) - lu(k,1694) = lu(k,1694) - lu(k,863) * lu(k,1682) - lu(k,1695) = lu(k,1695) - lu(k,864) * lu(k,1682) - lu(k,1697) = lu(k,1697) - lu(k,865) * lu(k,1682) - lu(k,1698) = lu(k,1698) - lu(k,866) * lu(k,1682) - lu(k,1704) = lu(k,1704) - lu(k,867) * lu(k,1682) - lu(k,1710) = lu(k,1710) - lu(k,868) * lu(k,1682) - lu(k,1719) = lu(k,1719) - lu(k,869) * lu(k,1682) - lu(k,1720) = lu(k,1720) - lu(k,870) * lu(k,1682) - lu(k,1722) = lu(k,1722) - lu(k,871) * lu(k,1682) - lu(k,1723) = lu(k,1723) - lu(k,872) * lu(k,1682) - lu(k,1728) = lu(k,1728) - lu(k,873) * lu(k,1682) - lu(k,1730) = lu(k,1730) - lu(k,874) * lu(k,1682) - lu(k,1751) = lu(k,1751) - lu(k,859) * lu(k,1750) - lu(k,1753) = lu(k,1753) - lu(k,860) * lu(k,1750) - lu(k,1754) = lu(k,1754) - lu(k,861) * lu(k,1750) - lu(k,1757) = lu(k,1757) - lu(k,862) * lu(k,1750) - lu(k,1759) = lu(k,1759) - lu(k,863) * lu(k,1750) - lu(k,1760) = lu(k,1760) - lu(k,864) * lu(k,1750) - lu(k,1762) = lu(k,1762) - lu(k,865) * lu(k,1750) - lu(k,1763) = lu(k,1763) - lu(k,866) * lu(k,1750) - lu(k,1767) = lu(k,1767) - lu(k,867) * lu(k,1750) - lu(k,1773) = lu(k,1773) - lu(k,868) * lu(k,1750) - lu(k,1781) = lu(k,1781) - lu(k,869) * lu(k,1750) - lu(k,1782) = lu(k,1782) - lu(k,870) * lu(k,1750) - lu(k,1784) = lu(k,1784) - lu(k,871) * lu(k,1750) - lu(k,1785) = lu(k,1785) - lu(k,872) * lu(k,1750) - lu(k,1790) = lu(k,1790) - lu(k,873) * lu(k,1750) - lu(k,1792) = lu(k,1792) - lu(k,874) * lu(k,1750) - lu(k,1870) = lu(k,1870) - lu(k,859) * lu(k,1869) - lu(k,1872) = lu(k,1872) - lu(k,860) * lu(k,1869) - lu(k,1873) = lu(k,1873) - lu(k,861) * lu(k,1869) - lu(k,1878) = lu(k,1878) - lu(k,862) * lu(k,1869) - lu(k,1880) = lu(k,1880) - lu(k,863) * lu(k,1869) - lu(k,1881) = lu(k,1881) - lu(k,864) * lu(k,1869) - lu(k,1883) = lu(k,1883) - lu(k,865) * lu(k,1869) - lu(k,1884) = lu(k,1884) - lu(k,866) * lu(k,1869) - lu(k,1889) = lu(k,1889) - lu(k,867) * lu(k,1869) - lu(k,1895) = lu(k,1895) - lu(k,868) * lu(k,1869) - lu(k,1903) = lu(k,1903) - lu(k,869) * lu(k,1869) - lu(k,1904) = lu(k,1904) - lu(k,870) * lu(k,1869) - lu(k,1906) = lu(k,1906) - lu(k,871) * lu(k,1869) - lu(k,1907) = lu(k,1907) - lu(k,872) * lu(k,1869) - lu(k,1912) = lu(k,1912) - lu(k,873) * lu(k,1869) - lu(k,1914) = lu(k,1914) - lu(k,874) * lu(k,1869) + lu(k,811) = 1._r8 / lu(k,811) + lu(k,812) = lu(k,812) * lu(k,811) + lu(k,813) = lu(k,813) * lu(k,811) + lu(k,814) = lu(k,814) * lu(k,811) + lu(k,902) = lu(k,902) - lu(k,812) * lu(k,898) + lu(k,905) = lu(k,905) - lu(k,813) * lu(k,898) + lu(k,907) = lu(k,907) - lu(k,814) * lu(k,898) + lu(k,1063) = lu(k,1063) - lu(k,812) * lu(k,1059) + lu(k,1067) = lu(k,1067) - lu(k,813) * lu(k,1059) + lu(k,1069) = lu(k,1069) - lu(k,814) * lu(k,1059) + lu(k,1092) = lu(k,1092) - lu(k,812) * lu(k,1086) + lu(k,1097) = lu(k,1097) - lu(k,813) * lu(k,1086) + lu(k,1099) = lu(k,1099) - lu(k,814) * lu(k,1086) + lu(k,1180) = lu(k,1180) - lu(k,812) * lu(k,1171) + lu(k,1184) = lu(k,1184) - lu(k,813) * lu(k,1171) + lu(k,1186) = lu(k,1186) - lu(k,814) * lu(k,1171) + lu(k,1218) = lu(k,1218) - lu(k,812) * lu(k,1213) + lu(k,1221) = lu(k,1221) - lu(k,813) * lu(k,1213) + lu(k,1223) = lu(k,1223) - lu(k,814) * lu(k,1213) + lu(k,1235) = lu(k,1235) - lu(k,812) * lu(k,1226) + lu(k,1239) = lu(k,1239) - lu(k,813) * lu(k,1226) + lu(k,1241) = lu(k,1241) - lu(k,814) * lu(k,1226) + lu(k,1257) = lu(k,1257) - lu(k,812) * lu(k,1245) + lu(k,1262) = lu(k,1262) - lu(k,813) * lu(k,1245) + lu(k,1264) = lu(k,1264) - lu(k,814) * lu(k,1245) + lu(k,1303) = lu(k,1303) - lu(k,812) * lu(k,1289) + lu(k,1308) = lu(k,1308) - lu(k,813) * lu(k,1289) + lu(k,1310) = lu(k,1310) - lu(k,814) * lu(k,1289) + lu(k,1336) = lu(k,1336) - lu(k,812) * lu(k,1318) + lu(k,1341) = lu(k,1341) - lu(k,813) * lu(k,1318) + lu(k,1343) = lu(k,1343) - lu(k,814) * lu(k,1318) + lu(k,1358) = lu(k,1358) - lu(k,812) * lu(k,1347) + lu(k,1363) = lu(k,1363) - lu(k,813) * lu(k,1347) + lu(k,1365) = lu(k,1365) - lu(k,814) * lu(k,1347) + lu(k,1799) = lu(k,1799) - lu(k,812) * lu(k,1748) + lu(k,1806) = lu(k,1806) - lu(k,813) * lu(k,1748) + lu(k,1810) = lu(k,1810) - lu(k,814) * lu(k,1748) + lu(k,2249) = lu(k,2249) - lu(k,812) * lu(k,2217) + lu(k,2256) = lu(k,2256) - lu(k,813) * lu(k,2217) + lu(k,2260) = lu(k,2260) - lu(k,814) * lu(k,2217) + lu(k,816) = 1._r8 / lu(k,816) + lu(k,817) = lu(k,817) * lu(k,816) + lu(k,818) = lu(k,818) * lu(k,816) + lu(k,819) = lu(k,819) * lu(k,816) + lu(k,820) = lu(k,820) * lu(k,816) + lu(k,821) = lu(k,821) * lu(k,816) + lu(k,822) = lu(k,822) * lu(k,816) + lu(k,823) = lu(k,823) * lu(k,816) + lu(k,824) = lu(k,824) * lu(k,816) + lu(k,825) = lu(k,825) * lu(k,816) + lu(k,1132) = lu(k,1132) - lu(k,817) * lu(k,1128) + lu(k,1134) = - lu(k,818) * lu(k,1128) + lu(k,1138) = - lu(k,819) * lu(k,1128) + lu(k,1139) = lu(k,1139) - lu(k,820) * lu(k,1128) + lu(k,1140) = - lu(k,821) * lu(k,1128) + lu(k,1142) = - lu(k,822) * lu(k,1128) + lu(k,1143) = lu(k,1143) - lu(k,823) * lu(k,1128) + lu(k,1146) = lu(k,1146) - lu(k,824) * lu(k,1128) + lu(k,1148) = lu(k,1148) - lu(k,825) * lu(k,1128) + lu(k,1773) = lu(k,1773) - lu(k,817) * lu(k,1749) + lu(k,1778) = lu(k,1778) - lu(k,818) * lu(k,1749) + lu(k,1795) = lu(k,1795) - lu(k,819) * lu(k,1749) + lu(k,1799) = lu(k,1799) - lu(k,820) * lu(k,1749) + lu(k,1800) = lu(k,1800) - lu(k,821) * lu(k,1749) + lu(k,1804) = lu(k,1804) - lu(k,822) * lu(k,1749) + lu(k,1806) = lu(k,1806) - lu(k,823) * lu(k,1749) + lu(k,1810) = lu(k,1810) - lu(k,824) * lu(k,1749) + lu(k,1812) = lu(k,1812) - lu(k,825) * lu(k,1749) + lu(k,2045) = lu(k,2045) - lu(k,817) * lu(k,2027) + lu(k,2050) = lu(k,2050) - lu(k,818) * lu(k,2027) + lu(k,2064) = lu(k,2064) - lu(k,819) * lu(k,2027) + lu(k,2068) = lu(k,2068) - lu(k,820) * lu(k,2027) + lu(k,2069) = lu(k,2069) - lu(k,821) * lu(k,2027) + lu(k,2073) = lu(k,2073) - lu(k,822) * lu(k,2027) + lu(k,2075) = lu(k,2075) - lu(k,823) * lu(k,2027) + lu(k,2079) = lu(k,2079) - lu(k,824) * lu(k,2027) + lu(k,2081) = - lu(k,825) * lu(k,2027) + lu(k,2173) = lu(k,2173) - lu(k,817) * lu(k,2158) + lu(k,2177) = lu(k,2177) - lu(k,818) * lu(k,2158) + lu(k,2193) = lu(k,2193) - lu(k,819) * lu(k,2158) + lu(k,2197) = lu(k,2197) - lu(k,820) * lu(k,2158) + lu(k,2198) = lu(k,2198) - lu(k,821) * lu(k,2158) + lu(k,2202) = lu(k,2202) - lu(k,822) * lu(k,2158) + lu(k,2204) = lu(k,2204) - lu(k,823) * lu(k,2158) + lu(k,2208) = lu(k,2208) - lu(k,824) * lu(k,2158) + lu(k,2210) = lu(k,2210) - lu(k,825) * lu(k,2158) + lu(k,826) = 1._r8 / lu(k,826) + lu(k,827) = lu(k,827) * lu(k,826) + lu(k,828) = lu(k,828) * lu(k,826) + lu(k,829) = lu(k,829) * lu(k,826) + lu(k,830) = lu(k,830) * lu(k,826) + lu(k,831) = lu(k,831) * lu(k,826) + lu(k,832) = lu(k,832) * lu(k,826) + lu(k,833) = lu(k,833) * lu(k,826) + lu(k,1509) = lu(k,1509) - lu(k,827) * lu(k,1506) + lu(k,1511) = lu(k,1511) - lu(k,828) * lu(k,1506) + lu(k,1512) = - lu(k,829) * lu(k,1506) + lu(k,1513) = - lu(k,830) * lu(k,1506) + lu(k,1516) = - lu(k,831) * lu(k,1506) + lu(k,1518) = - lu(k,832) * lu(k,1506) + lu(k,1521) = - lu(k,833) * lu(k,1506) + lu(k,1629) = lu(k,1629) - lu(k,827) * lu(k,1625) + lu(k,1631) = lu(k,1631) - lu(k,828) * lu(k,1625) + lu(k,1633) = lu(k,1633) - lu(k,829) * lu(k,1625) + lu(k,1634) = lu(k,1634) - lu(k,830) * lu(k,1625) + lu(k,1640) = lu(k,1640) - lu(k,831) * lu(k,1625) + lu(k,1644) = lu(k,1644) - lu(k,832) * lu(k,1625) + lu(k,1647) = lu(k,1647) - lu(k,833) * lu(k,1625) + lu(k,1794) = lu(k,1794) - lu(k,827) * lu(k,1750) + lu(k,1796) = lu(k,1796) - lu(k,828) * lu(k,1750) + lu(k,1798) = lu(k,1798) - lu(k,829) * lu(k,1750) + lu(k,1799) = lu(k,1799) - lu(k,830) * lu(k,1750) + lu(k,1805) = lu(k,1805) - lu(k,831) * lu(k,1750) + lu(k,1809) = lu(k,1809) - lu(k,832) * lu(k,1750) + lu(k,1812) = lu(k,1812) - lu(k,833) * lu(k,1750) + lu(k,2192) = lu(k,2192) - lu(k,827) * lu(k,2159) + lu(k,2194) = lu(k,2194) - lu(k,828) * lu(k,2159) + lu(k,2196) = - lu(k,829) * lu(k,2159) + lu(k,2197) = lu(k,2197) - lu(k,830) * lu(k,2159) + lu(k,2203) = lu(k,2203) - lu(k,831) * lu(k,2159) + lu(k,2207) = lu(k,2207) - lu(k,832) * lu(k,2159) + lu(k,2210) = lu(k,2210) - lu(k,833) * lu(k,2159) + lu(k,2312) = lu(k,2312) - lu(k,827) * lu(k,2299) + lu(k,2314) = lu(k,2314) - lu(k,828) * lu(k,2299) + lu(k,2316) = lu(k,2316) - lu(k,829) * lu(k,2299) + lu(k,2317) = lu(k,2317) - lu(k,830) * lu(k,2299) + lu(k,2323) = lu(k,2323) - lu(k,831) * lu(k,2299) + lu(k,2327) = lu(k,2327) - lu(k,832) * lu(k,2299) + lu(k,2330) = lu(k,2330) - lu(k,833) * lu(k,2299) + lu(k,2338) = lu(k,2338) - lu(k,827) * lu(k,2332) + lu(k,2340) = - lu(k,828) * lu(k,2332) + lu(k,2342) = - lu(k,829) * lu(k,2332) + lu(k,2343) = lu(k,2343) - lu(k,830) * lu(k,2332) + lu(k,2349) = lu(k,2349) - lu(k,831) * lu(k,2332) + lu(k,2353) = lu(k,2353) - lu(k,832) * lu(k,2332) + lu(k,2356) = lu(k,2356) - lu(k,833) * lu(k,2332) + lu(k,835) = 1._r8 / lu(k,835) + lu(k,836) = lu(k,836) * lu(k,835) + lu(k,837) = lu(k,837) * lu(k,835) + lu(k,838) = lu(k,838) * lu(k,835) + lu(k,839) = lu(k,839) * lu(k,835) + lu(k,840) = lu(k,840) * lu(k,835) + lu(k,841) = lu(k,841) * lu(k,835) + lu(k,954) = lu(k,954) - lu(k,836) * lu(k,952) + lu(k,955) = lu(k,955) - lu(k,837) * lu(k,952) + lu(k,956) = lu(k,956) - lu(k,838) * lu(k,952) + lu(k,959) = lu(k,959) - lu(k,839) * lu(k,952) + lu(k,961) = lu(k,961) - lu(k,840) * lu(k,952) + lu(k,962) = - lu(k,841) * lu(k,952) + lu(k,1493) = lu(k,1493) - lu(k,836) * lu(k,1491) + lu(k,1496) = lu(k,1496) - lu(k,837) * lu(k,1491) + lu(k,1498) = lu(k,1498) - lu(k,838) * lu(k,1491) + lu(k,1501) = lu(k,1501) - lu(k,839) * lu(k,1491) + lu(k,1504) = lu(k,1504) - lu(k,840) * lu(k,1491) + lu(k,1505) = lu(k,1505) - lu(k,841) * lu(k,1491) + lu(k,1586) = lu(k,1586) - lu(k,836) * lu(k,1582) + lu(k,1590) = lu(k,1590) - lu(k,837) * lu(k,1582) + lu(k,1592) = lu(k,1592) - lu(k,838) * lu(k,1582) + lu(k,1595) = lu(k,1595) - lu(k,839) * lu(k,1582) + lu(k,1601) = lu(k,1601) - lu(k,840) * lu(k,1582) + lu(k,1604) = - lu(k,841) * lu(k,1582) + lu(k,1793) = lu(k,1793) - lu(k,836) * lu(k,1751) + lu(k,1797) = lu(k,1797) - lu(k,837) * lu(k,1751) + lu(k,1799) = lu(k,1799) - lu(k,838) * lu(k,1751) + lu(k,1802) = lu(k,1802) - lu(k,839) * lu(k,1751) + lu(k,1809) = lu(k,1809) - lu(k,840) * lu(k,1751) + lu(k,1812) = lu(k,1812) - lu(k,841) * lu(k,1751) + lu(k,1944) = lu(k,1944) - lu(k,836) * lu(k,1929) + lu(k,1948) = lu(k,1948) - lu(k,837) * lu(k,1929) + lu(k,1950) = lu(k,1950) - lu(k,838) * lu(k,1929) + lu(k,1953) = lu(k,1953) - lu(k,839) * lu(k,1929) + lu(k,1960) = lu(k,1960) - lu(k,840) * lu(k,1929) + lu(k,1963) = lu(k,1963) - lu(k,841) * lu(k,1929) + lu(k,2191) = lu(k,2191) - lu(k,836) * lu(k,2160) + lu(k,2195) = lu(k,2195) - lu(k,837) * lu(k,2160) + lu(k,2197) = lu(k,2197) - lu(k,838) * lu(k,2160) + lu(k,2200) = lu(k,2200) - lu(k,839) * lu(k,2160) + lu(k,2207) = lu(k,2207) - lu(k,840) * lu(k,2160) + lu(k,2210) = lu(k,2210) - lu(k,841) * lu(k,2160) + lu(k,2311) = lu(k,2311) - lu(k,836) * lu(k,2300) + lu(k,2315) = lu(k,2315) - lu(k,837) * lu(k,2300) + lu(k,2317) = lu(k,2317) - lu(k,838) * lu(k,2300) + lu(k,2320) = lu(k,2320) - lu(k,839) * lu(k,2300) + lu(k,2327) = lu(k,2327) - lu(k,840) * lu(k,2300) + lu(k,2330) = lu(k,2330) - lu(k,841) * lu(k,2300) + lu(k,843) = 1._r8 / lu(k,843) + lu(k,844) = lu(k,844) * lu(k,843) + lu(k,845) = lu(k,845) * lu(k,843) + lu(k,846) = lu(k,846) * lu(k,843) + lu(k,847) = lu(k,847) * lu(k,843) + lu(k,848) = lu(k,848) * lu(k,843) + lu(k,849) = lu(k,849) * lu(k,843) + lu(k,852) = lu(k,852) - lu(k,844) * lu(k,850) + lu(k,853) = lu(k,853) - lu(k,845) * lu(k,850) + lu(k,854) = lu(k,854) - lu(k,846) * lu(k,850) + lu(k,855) = lu(k,855) - lu(k,847) * lu(k,850) + lu(k,856) = lu(k,856) - lu(k,848) * lu(k,850) + lu(k,857) = lu(k,857) - lu(k,849) * lu(k,850) + lu(k,863) = lu(k,863) - lu(k,844) * lu(k,861) + lu(k,864) = lu(k,864) - lu(k,845) * lu(k,861) + lu(k,867) = lu(k,867) - lu(k,846) * lu(k,861) + lu(k,868) = lu(k,868) - lu(k,847) * lu(k,861) + lu(k,869) = lu(k,869) - lu(k,848) * lu(k,861) + lu(k,870) = lu(k,870) - lu(k,849) * lu(k,861) + lu(k,968) = lu(k,968) - lu(k,844) * lu(k,966) + lu(k,969) = lu(k,969) - lu(k,845) * lu(k,966) + lu(k,972) = lu(k,972) - lu(k,846) * lu(k,966) + lu(k,973) = lu(k,973) - lu(k,847) * lu(k,966) + lu(k,976) = lu(k,976) - lu(k,848) * lu(k,966) + lu(k,978) = lu(k,978) - lu(k,849) * lu(k,966) + lu(k,1445) = - lu(k,844) * lu(k,1443) + lu(k,1446) = lu(k,1446) - lu(k,845) * lu(k,1443) + lu(k,1449) = lu(k,1449) - lu(k,846) * lu(k,1443) + lu(k,1450) = - lu(k,847) * lu(k,1443) + lu(k,1453) = - lu(k,848) * lu(k,1443) + lu(k,1456) = lu(k,1456) - lu(k,849) * lu(k,1443) + lu(k,1532) = lu(k,1532) - lu(k,844) * lu(k,1530) + lu(k,1534) = lu(k,1534) - lu(k,845) * lu(k,1530) + lu(k,1540) = lu(k,1540) - lu(k,846) * lu(k,1530) + lu(k,1543) = lu(k,1543) - lu(k,847) * lu(k,1530) + lu(k,1547) = lu(k,1547) - lu(k,848) * lu(k,1530) + lu(k,1550) = lu(k,1550) - lu(k,849) * lu(k,1530) + lu(k,2030) = lu(k,2030) - lu(k,844) * lu(k,2028) + lu(k,2036) = lu(k,2036) - lu(k,845) * lu(k,2028) + lu(k,2064) = lu(k,2064) - lu(k,846) * lu(k,2028) + lu(k,2067) = - lu(k,847) * lu(k,2028) + lu(k,2073) = lu(k,2073) - lu(k,848) * lu(k,2028) + lu(k,2078) = lu(k,2078) - lu(k,849) * lu(k,2028) + lu(k,2303) = lu(k,2303) - lu(k,844) * lu(k,2301) + lu(k,2306) = lu(k,2306) - lu(k,845) * lu(k,2301) + lu(k,2313) = lu(k,2313) - lu(k,846) * lu(k,2301) + lu(k,2316) = lu(k,2316) - lu(k,847) * lu(k,2301) + lu(k,2322) = lu(k,2322) - lu(k,848) * lu(k,2301) + lu(k,2327) = lu(k,2327) - lu(k,849) * lu(k,2301) end do end subroutine lu_fac18 subroutine lu_fac19( avec_len, lu ) @@ -3279,6 +2939,143 @@ subroutine lu_fac19( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len + lu(k,851) = 1._r8 / lu(k,851) + lu(k,852) = lu(k,852) * lu(k,851) + lu(k,853) = lu(k,853) * lu(k,851) + lu(k,854) = lu(k,854) * lu(k,851) + lu(k,855) = lu(k,855) * lu(k,851) + lu(k,856) = lu(k,856) * lu(k,851) + lu(k,857) = lu(k,857) * lu(k,851) + lu(k,863) = lu(k,863) - lu(k,852) * lu(k,862) + lu(k,864) = lu(k,864) - lu(k,853) * lu(k,862) + lu(k,867) = lu(k,867) - lu(k,854) * lu(k,862) + lu(k,868) = lu(k,868) - lu(k,855) * lu(k,862) + lu(k,869) = lu(k,869) - lu(k,856) * lu(k,862) + lu(k,870) = lu(k,870) - lu(k,857) * lu(k,862) + lu(k,968) = lu(k,968) - lu(k,852) * lu(k,967) + lu(k,969) = lu(k,969) - lu(k,853) * lu(k,967) + lu(k,972) = lu(k,972) - lu(k,854) * lu(k,967) + lu(k,973) = lu(k,973) - lu(k,855) * lu(k,967) + lu(k,976) = lu(k,976) - lu(k,856) * lu(k,967) + lu(k,978) = lu(k,978) - lu(k,857) * lu(k,967) + lu(k,1445) = lu(k,1445) - lu(k,852) * lu(k,1444) + lu(k,1446) = lu(k,1446) - lu(k,853) * lu(k,1444) + lu(k,1449) = lu(k,1449) - lu(k,854) * lu(k,1444) + lu(k,1450) = lu(k,1450) - lu(k,855) * lu(k,1444) + lu(k,1453) = lu(k,1453) - lu(k,856) * lu(k,1444) + lu(k,1456) = lu(k,1456) - lu(k,857) * lu(k,1444) + lu(k,1532) = lu(k,1532) - lu(k,852) * lu(k,1531) + lu(k,1534) = lu(k,1534) - lu(k,853) * lu(k,1531) + lu(k,1540) = lu(k,1540) - lu(k,854) * lu(k,1531) + lu(k,1543) = lu(k,1543) - lu(k,855) * lu(k,1531) + lu(k,1547) = lu(k,1547) - lu(k,856) * lu(k,1531) + lu(k,1550) = lu(k,1550) - lu(k,857) * lu(k,1531) + lu(k,2030) = lu(k,2030) - lu(k,852) * lu(k,2029) + lu(k,2036) = lu(k,2036) - lu(k,853) * lu(k,2029) + lu(k,2064) = lu(k,2064) - lu(k,854) * lu(k,2029) + lu(k,2067) = lu(k,2067) - lu(k,855) * lu(k,2029) + lu(k,2073) = lu(k,2073) - lu(k,856) * lu(k,2029) + lu(k,2078) = lu(k,2078) - lu(k,857) * lu(k,2029) + lu(k,2303) = lu(k,2303) - lu(k,852) * lu(k,2302) + lu(k,2306) = lu(k,2306) - lu(k,853) * lu(k,2302) + lu(k,2313) = lu(k,2313) - lu(k,854) * lu(k,2302) + lu(k,2316) = lu(k,2316) - lu(k,855) * lu(k,2302) + lu(k,2322) = lu(k,2322) - lu(k,856) * lu(k,2302) + lu(k,2327) = lu(k,2327) - lu(k,857) * lu(k,2302) + lu(k,863) = 1._r8 / lu(k,863) + lu(k,864) = lu(k,864) * lu(k,863) + lu(k,865) = lu(k,865) * lu(k,863) + lu(k,866) = lu(k,866) * lu(k,863) + lu(k,867) = lu(k,867) * lu(k,863) + lu(k,868) = lu(k,868) * lu(k,863) + lu(k,869) = lu(k,869) * lu(k,863) + lu(k,870) = lu(k,870) * lu(k,863) + lu(k,969) = lu(k,969) - lu(k,864) * lu(k,968) + lu(k,970) = lu(k,970) - lu(k,865) * lu(k,968) + lu(k,971) = lu(k,971) - lu(k,866) * lu(k,968) + lu(k,972) = lu(k,972) - lu(k,867) * lu(k,968) + lu(k,973) = lu(k,973) - lu(k,868) * lu(k,968) + lu(k,976) = lu(k,976) - lu(k,869) * lu(k,968) + lu(k,978) = lu(k,978) - lu(k,870) * lu(k,968) + lu(k,1446) = lu(k,1446) - lu(k,864) * lu(k,1445) + lu(k,1447) = lu(k,1447) - lu(k,865) * lu(k,1445) + lu(k,1448) = lu(k,1448) - lu(k,866) * lu(k,1445) + lu(k,1449) = lu(k,1449) - lu(k,867) * lu(k,1445) + lu(k,1450) = lu(k,1450) - lu(k,868) * lu(k,1445) + lu(k,1453) = lu(k,1453) - lu(k,869) * lu(k,1445) + lu(k,1456) = lu(k,1456) - lu(k,870) * lu(k,1445) + lu(k,1534) = lu(k,1534) - lu(k,864) * lu(k,1532) + lu(k,1535) = lu(k,1535) - lu(k,865) * lu(k,1532) + lu(k,1537) = lu(k,1537) - lu(k,866) * lu(k,1532) + lu(k,1540) = lu(k,1540) - lu(k,867) * lu(k,1532) + lu(k,1543) = lu(k,1543) - lu(k,868) * lu(k,1532) + lu(k,1547) = lu(k,1547) - lu(k,869) * lu(k,1532) + lu(k,1550) = lu(k,1550) - lu(k,870) * lu(k,1532) + lu(k,2036) = lu(k,2036) - lu(k,864) * lu(k,2030) + lu(k,2046) = lu(k,2046) - lu(k,865) * lu(k,2030) + lu(k,2062) = lu(k,2062) - lu(k,866) * lu(k,2030) + lu(k,2064) = lu(k,2064) - lu(k,867) * lu(k,2030) + lu(k,2067) = lu(k,2067) - lu(k,868) * lu(k,2030) + lu(k,2073) = lu(k,2073) - lu(k,869) * lu(k,2030) + lu(k,2078) = lu(k,2078) - lu(k,870) * lu(k,2030) + lu(k,2306) = lu(k,2306) - lu(k,864) * lu(k,2303) + lu(k,2307) = lu(k,2307) - lu(k,865) * lu(k,2303) + lu(k,2308) = lu(k,2308) - lu(k,866) * lu(k,2303) + lu(k,2313) = lu(k,2313) - lu(k,867) * lu(k,2303) + lu(k,2316) = lu(k,2316) - lu(k,868) * lu(k,2303) + lu(k,2322) = lu(k,2322) - lu(k,869) * lu(k,2303) + lu(k,2327) = lu(k,2327) - lu(k,870) * lu(k,2303) + lu(k,871) = 1._r8 / lu(k,871) + lu(k,872) = lu(k,872) * lu(k,871) + lu(k,873) = lu(k,873) * lu(k,871) + lu(k,874) = lu(k,874) * lu(k,871) + lu(k,875) = lu(k,875) * lu(k,871) + lu(k,876) = lu(k,876) * lu(k,871) + lu(k,1117) = - lu(k,872) * lu(k,1112) + lu(k,1118) = - lu(k,873) * lu(k,1112) + lu(k,1120) = lu(k,1120) - lu(k,874) * lu(k,1112) + lu(k,1121) = lu(k,1121) - lu(k,875) * lu(k,1112) + lu(k,1126) = - lu(k,876) * lu(k,1112) + lu(k,1135) = - lu(k,872) * lu(k,1129) + lu(k,1136) = - lu(k,873) * lu(k,1129) + lu(k,1139) = lu(k,1139) - lu(k,874) * lu(k,1129) + lu(k,1140) = lu(k,1140) - lu(k,875) * lu(k,1129) + lu(k,1146) = lu(k,1146) - lu(k,876) * lu(k,1129) + lu(k,1253) = - lu(k,872) * lu(k,1246) + lu(k,1255) = lu(k,1255) - lu(k,873) * lu(k,1246) + lu(k,1257) = lu(k,1257) - lu(k,874) * lu(k,1246) + lu(k,1258) = lu(k,1258) - lu(k,875) * lu(k,1246) + lu(k,1264) = lu(k,1264) - lu(k,876) * lu(k,1246) + lu(k,1329) = lu(k,1329) - lu(k,872) * lu(k,1319) + lu(k,1334) = lu(k,1334) - lu(k,873) * lu(k,1319) + lu(k,1336) = lu(k,1336) - lu(k,874) * lu(k,1319) + lu(k,1337) = lu(k,1337) - lu(k,875) * lu(k,1319) + lu(k,1343) = lu(k,1343) - lu(k,876) * lu(k,1319) + lu(k,1783) = lu(k,1783) - lu(k,872) * lu(k,1752) + lu(k,1789) = lu(k,1789) - lu(k,873) * lu(k,1752) + lu(k,1799) = lu(k,1799) - lu(k,874) * lu(k,1752) + lu(k,1800) = lu(k,1800) - lu(k,875) * lu(k,1752) + lu(k,1810) = lu(k,1810) - lu(k,876) * lu(k,1752) + lu(k,1890) = lu(k,1890) - lu(k,872) * lu(k,1865) + lu(k,1896) = lu(k,1896) - lu(k,873) * lu(k,1865) + lu(k,1904) = lu(k,1904) - lu(k,874) * lu(k,1865) + lu(k,1905) = lu(k,1905) - lu(k,875) * lu(k,1865) + lu(k,1915) = lu(k,1915) - lu(k,876) * lu(k,1865) + lu(k,2055) = lu(k,2055) - lu(k,872) * lu(k,2031) + lu(k,2061) = lu(k,2061) - lu(k,873) * lu(k,2031) + lu(k,2068) = lu(k,2068) - lu(k,874) * lu(k,2031) + lu(k,2069) = lu(k,2069) - lu(k,875) * lu(k,2031) + lu(k,2079) = lu(k,2079) - lu(k,876) * lu(k,2031) + lu(k,2182) = lu(k,2182) - lu(k,872) * lu(k,2161) + lu(k,2188) = lu(k,2188) - lu(k,873) * lu(k,2161) + lu(k,2197) = lu(k,2197) - lu(k,874) * lu(k,2161) + lu(k,2198) = lu(k,2198) - lu(k,875) * lu(k,2161) + lu(k,2208) = lu(k,2208) - lu(k,876) * lu(k,2161) + lu(k,2237) = lu(k,2237) - lu(k,872) * lu(k,2218) + lu(k,2243) = lu(k,2243) - lu(k,873) * lu(k,2218) + lu(k,2249) = lu(k,2249) - lu(k,874) * lu(k,2218) + lu(k,2250) = lu(k,2250) - lu(k,875) * lu(k,2218) + lu(k,2260) = lu(k,2260) - lu(k,876) * lu(k,2218) lu(k,880) = 1._r8 / lu(k,880) lu(k,881) = lu(k,881) * lu(k,880) lu(k,882) = lu(k,882) * lu(k,880) @@ -3290,232 +3087,113 @@ subroutine lu_fac19( avec_len, lu ) lu(k,888) = lu(k,888) * lu(k,880) lu(k,889) = lu(k,889) * lu(k,880) lu(k,890) = lu(k,890) * lu(k,880) - lu(k,1481) = lu(k,1481) - lu(k,881) * lu(k,1480) - lu(k,1493) = lu(k,1493) - lu(k,882) * lu(k,1480) - lu(k,1503) = lu(k,1503) - lu(k,883) * lu(k,1480) - lu(k,1505) = lu(k,1505) - lu(k,884) * lu(k,1480) - lu(k,1506) = lu(k,1506) - lu(k,885) * lu(k,1480) - lu(k,1507) = lu(k,1507) - lu(k,886) * lu(k,1480) - lu(k,1510) = lu(k,1510) - lu(k,887) * lu(k,1480) - lu(k,1513) = lu(k,1513) - lu(k,888) * lu(k,1480) - lu(k,1517) = lu(k,1517) - lu(k,889) * lu(k,1480) - lu(k,1519) = lu(k,1519) - lu(k,890) * lu(k,1480) - lu(k,1685) = lu(k,1685) - lu(k,881) * lu(k,1683) - lu(k,1699) = lu(k,1699) - lu(k,882) * lu(k,1683) - lu(k,1710) = lu(k,1710) - lu(k,883) * lu(k,1683) - lu(k,1714) = lu(k,1714) - lu(k,884) * lu(k,1683) - lu(k,1715) = lu(k,1715) - lu(k,885) * lu(k,1683) - lu(k,1716) = lu(k,1716) - lu(k,886) * lu(k,1683) - lu(k,1719) = lu(k,1719) - lu(k,887) * lu(k,1683) - lu(k,1722) = lu(k,1722) - lu(k,888) * lu(k,1683) - lu(k,1726) = lu(k,1726) - lu(k,889) * lu(k,1683) - lu(k,1728) = lu(k,1728) - lu(k,890) * lu(k,1683) - lu(k,1753) = lu(k,1753) - lu(k,881) * lu(k,1751) - lu(k,1764) = lu(k,1764) - lu(k,882) * lu(k,1751) - lu(k,1773) = lu(k,1773) - lu(k,883) * lu(k,1751) - lu(k,1776) = lu(k,1776) - lu(k,884) * lu(k,1751) - lu(k,1777) = lu(k,1777) - lu(k,885) * lu(k,1751) - lu(k,1778) = lu(k,1778) - lu(k,886) * lu(k,1751) - lu(k,1781) = lu(k,1781) - lu(k,887) * lu(k,1751) - lu(k,1784) = lu(k,1784) - lu(k,888) * lu(k,1751) - lu(k,1788) = lu(k,1788) - lu(k,889) * lu(k,1751) - lu(k,1790) = lu(k,1790) - lu(k,890) * lu(k,1751) - lu(k,1872) = lu(k,1872) - lu(k,881) * lu(k,1870) - lu(k,1885) = lu(k,1885) - lu(k,882) * lu(k,1870) - lu(k,1895) = lu(k,1895) - lu(k,883) * lu(k,1870) - lu(k,1898) = lu(k,1898) - lu(k,884) * lu(k,1870) - lu(k,1899) = lu(k,1899) - lu(k,885) * lu(k,1870) - lu(k,1900) = lu(k,1900) - lu(k,886) * lu(k,1870) - lu(k,1903) = lu(k,1903) - lu(k,887) * lu(k,1870) - lu(k,1906) = lu(k,1906) - lu(k,888) * lu(k,1870) - lu(k,1910) = lu(k,1910) - lu(k,889) * lu(k,1870) - lu(k,1912) = lu(k,1912) - lu(k,890) * lu(k,1870) - lu(k,2077) = lu(k,2077) - lu(k,881) * lu(k,2076) - lu(k,2087) = lu(k,2087) - lu(k,882) * lu(k,2076) - lu(k,2098) = lu(k,2098) - lu(k,883) * lu(k,2076) - lu(k,2101) = lu(k,2101) - lu(k,884) * lu(k,2076) - lu(k,2102) = lu(k,2102) - lu(k,885) * lu(k,2076) - lu(k,2103) = lu(k,2103) - lu(k,886) * lu(k,2076) - lu(k,2106) = lu(k,2106) - lu(k,887) * lu(k,2076) - lu(k,2109) = lu(k,2109) - lu(k,888) * lu(k,2076) - lu(k,2113) = lu(k,2113) - lu(k,889) * lu(k,2076) - lu(k,2115) = lu(k,2115) - lu(k,890) * lu(k,2076) - lu(k,892) = 1._r8 / lu(k,892) - lu(k,893) = lu(k,893) * lu(k,892) - lu(k,894) = lu(k,894) * lu(k,892) - lu(k,895) = lu(k,895) * lu(k,892) - lu(k,896) = lu(k,896) * lu(k,892) - lu(k,897) = lu(k,897) * lu(k,892) - lu(k,1318) = lu(k,1318) - lu(k,893) * lu(k,1317) - lu(k,1323) = lu(k,1323) - lu(k,894) * lu(k,1317) - lu(k,1325) = lu(k,1325) - lu(k,895) * lu(k,1317) - lu(k,1329) = - lu(k,896) * lu(k,1317) - lu(k,1331) = - lu(k,897) * lu(k,1317) - lu(k,1425) = lu(k,1425) - lu(k,893) * lu(k,1422) - lu(k,1431) = lu(k,1431) - lu(k,894) * lu(k,1422) - lu(k,1433) = lu(k,1433) - lu(k,895) * lu(k,1422) - lu(k,1438) = lu(k,1438) - lu(k,896) * lu(k,1422) - lu(k,1440) = - lu(k,897) * lu(k,1422) - lu(k,1711) = lu(k,1711) - lu(k,893) * lu(k,1684) - lu(k,1719) = lu(k,1719) - lu(k,894) * lu(k,1684) - lu(k,1721) = lu(k,1721) - lu(k,895) * lu(k,1684) - lu(k,1728) = lu(k,1728) - lu(k,896) * lu(k,1684) - lu(k,1730) = lu(k,1730) - lu(k,897) * lu(k,1684) - lu(k,1774) = lu(k,1774) - lu(k,893) * lu(k,1752) - lu(k,1781) = lu(k,1781) - lu(k,894) * lu(k,1752) - lu(k,1783) = lu(k,1783) - lu(k,895) * lu(k,1752) - lu(k,1790) = lu(k,1790) - lu(k,896) * lu(k,1752) - lu(k,1792) = lu(k,1792) - lu(k,897) * lu(k,1752) - lu(k,1814) = lu(k,1814) - lu(k,893) * lu(k,1810) - lu(k,1822) = lu(k,1822) - lu(k,894) * lu(k,1810) - lu(k,1824) = lu(k,1824) - lu(k,895) * lu(k,1810) - lu(k,1831) = lu(k,1831) - lu(k,896) * lu(k,1810) - lu(k,1833) = lu(k,1833) - lu(k,897) * lu(k,1810) - lu(k,1896) = - lu(k,893) * lu(k,1871) - lu(k,1903) = lu(k,1903) - lu(k,894) * lu(k,1871) - lu(k,1905) = lu(k,1905) - lu(k,895) * lu(k,1871) - lu(k,1912) = lu(k,1912) - lu(k,896) * lu(k,1871) - lu(k,1914) = lu(k,1914) - lu(k,897) * lu(k,1871) - lu(k,1979) = lu(k,1979) - lu(k,893) * lu(k,1972) - lu(k,1987) = lu(k,1987) - lu(k,894) * lu(k,1972) - lu(k,1989) = lu(k,1989) - lu(k,895) * lu(k,1972) - lu(k,1996) = lu(k,1996) - lu(k,896) * lu(k,1972) - lu(k,1998) = lu(k,1998) - lu(k,897) * lu(k,1972) - lu(k,2004) = lu(k,2004) - lu(k,893) * lu(k,2003) - lu(k,2011) = lu(k,2011) - lu(k,894) * lu(k,2003) - lu(k,2013) = lu(k,2013) - lu(k,895) * lu(k,2003) - lu(k,2020) = lu(k,2020) - lu(k,896) * lu(k,2003) - lu(k,2022) = lu(k,2022) - lu(k,897) * lu(k,2003) - lu(k,2125) = lu(k,2125) - lu(k,893) * lu(k,2123) - lu(k,2133) = lu(k,2133) - lu(k,894) * lu(k,2123) - lu(k,2135) = lu(k,2135) - lu(k,895) * lu(k,2123) - lu(k,2142) = lu(k,2142) - lu(k,896) * lu(k,2123) - lu(k,2144) = lu(k,2144) - lu(k,897) * lu(k,2123) - lu(k,2151) = - lu(k,893) * lu(k,2149) - lu(k,2159) = lu(k,2159) - lu(k,894) * lu(k,2149) - lu(k,2161) = lu(k,2161) - lu(k,895) * lu(k,2149) - lu(k,2168) = - lu(k,896) * lu(k,2149) - lu(k,2170) = lu(k,2170) - lu(k,897) * lu(k,2149) - lu(k,898) = 1._r8 / lu(k,898) - lu(k,899) = lu(k,899) * lu(k,898) - lu(k,900) = lu(k,900) * lu(k,898) - lu(k,901) = lu(k,901) * lu(k,898) - lu(k,902) = lu(k,902) * lu(k,898) - lu(k,903) = lu(k,903) * lu(k,898) - lu(k,971) = - lu(k,899) * lu(k,966) - lu(k,973) = lu(k,973) - lu(k,900) * lu(k,966) - lu(k,974) = - lu(k,901) * lu(k,966) - lu(k,975) = lu(k,975) - lu(k,902) * lu(k,966) - lu(k,980) = - lu(k,903) * lu(k,966) - lu(k,984) = lu(k,984) - lu(k,899) * lu(k,981) - lu(k,985) = lu(k,985) - lu(k,900) * lu(k,981) - lu(k,986) = - lu(k,901) * lu(k,981) - lu(k,987) = lu(k,987) - lu(k,902) * lu(k,981) - lu(k,990) = - lu(k,903) * lu(k,981) - lu(k,1011) = - lu(k,899) * lu(k,1004) - lu(k,1012) = - lu(k,900) * lu(k,1004) - lu(k,1013) = lu(k,1013) - lu(k,901) * lu(k,1004) - lu(k,1015) = lu(k,1015) - lu(k,902) * lu(k,1004) - lu(k,1022) = - lu(k,903) * lu(k,1004) - lu(k,1031) = - lu(k,899) * lu(k,1026) - lu(k,1032) = - lu(k,900) * lu(k,1026) - lu(k,1033) = lu(k,1033) - lu(k,901) * lu(k,1026) - lu(k,1035) = lu(k,1035) - lu(k,902) * lu(k,1026) - lu(k,1041) = - lu(k,903) * lu(k,1026) - lu(k,1384) = lu(k,1384) - lu(k,899) * lu(k,1374) - lu(k,1395) = lu(k,1395) - lu(k,900) * lu(k,1374) - lu(k,1396) = lu(k,1396) - lu(k,901) * lu(k,1374) - lu(k,1400) = lu(k,1400) - lu(k,902) * lu(k,1374) - lu(k,1409) = lu(k,1409) - lu(k,903) * lu(k,1374) - lu(k,1492) = lu(k,1492) - lu(k,899) * lu(k,1481) - lu(k,1503) = lu(k,1503) - lu(k,900) * lu(k,1481) - lu(k,1505) = lu(k,1505) - lu(k,901) * lu(k,1481) - lu(k,1510) = lu(k,1510) - lu(k,902) * lu(k,1481) - lu(k,1521) = lu(k,1521) - lu(k,903) * lu(k,1481) - lu(k,1698) = lu(k,1698) - lu(k,899) * lu(k,1685) - lu(k,1710) = lu(k,1710) - lu(k,900) * lu(k,1685) - lu(k,1714) = lu(k,1714) - lu(k,901) * lu(k,1685) - lu(k,1719) = lu(k,1719) - lu(k,902) * lu(k,1685) - lu(k,1730) = lu(k,1730) - lu(k,903) * lu(k,1685) - lu(k,1763) = lu(k,1763) - lu(k,899) * lu(k,1753) - lu(k,1773) = lu(k,1773) - lu(k,900) * lu(k,1753) - lu(k,1776) = lu(k,1776) - lu(k,901) * lu(k,1753) - lu(k,1781) = lu(k,1781) - lu(k,902) * lu(k,1753) - lu(k,1792) = lu(k,1792) - lu(k,903) * lu(k,1753) - lu(k,1884) = lu(k,1884) - lu(k,899) * lu(k,1872) - lu(k,1895) = lu(k,1895) - lu(k,900) * lu(k,1872) - lu(k,1898) = lu(k,1898) - lu(k,901) * lu(k,1872) - lu(k,1903) = lu(k,1903) - lu(k,902) * lu(k,1872) - lu(k,1914) = lu(k,1914) - lu(k,903) * lu(k,1872) - lu(k,2086) = lu(k,2086) - lu(k,899) * lu(k,2077) - lu(k,2098) = lu(k,2098) - lu(k,900) * lu(k,2077) - lu(k,2101) = lu(k,2101) - lu(k,901) * lu(k,2077) - lu(k,2106) = lu(k,2106) - lu(k,902) * lu(k,2077) - lu(k,2117) = lu(k,2117) - lu(k,903) * lu(k,2077) - lu(k,906) = 1._r8 / lu(k,906) - lu(k,907) = lu(k,907) * lu(k,906) - lu(k,908) = lu(k,908) * lu(k,906) - lu(k,909) = lu(k,909) * lu(k,906) - lu(k,910) = lu(k,910) * lu(k,906) - lu(k,911) = lu(k,911) * lu(k,906) - lu(k,912) = lu(k,912) * lu(k,906) - lu(k,913) = lu(k,913) * lu(k,906) - lu(k,914) = lu(k,914) * lu(k,906) - lu(k,915) = lu(k,915) * lu(k,906) - lu(k,1337) = lu(k,1337) - lu(k,907) * lu(k,1336) - lu(k,1339) = lu(k,1339) - lu(k,908) * lu(k,1336) - lu(k,1341) = lu(k,1341) - lu(k,909) * lu(k,1336) - lu(k,1342) = lu(k,1342) - lu(k,910) * lu(k,1336) - lu(k,1343) = - lu(k,911) * lu(k,1336) - lu(k,1345) = lu(k,1345) - lu(k,912) * lu(k,1336) - lu(k,1346) = - lu(k,913) * lu(k,1336) - lu(k,1348) = lu(k,1348) - lu(k,914) * lu(k,1336) - lu(k,1349) = lu(k,1349) - lu(k,915) * lu(k,1336) - lu(k,1538) = lu(k,1538) - lu(k,907) * lu(k,1532) - lu(k,1543) = lu(k,1543) - lu(k,908) * lu(k,1532) - lu(k,1545) = lu(k,1545) - lu(k,909) * lu(k,1532) - lu(k,1547) = lu(k,1547) - lu(k,910) * lu(k,1532) - lu(k,1549) = lu(k,1549) - lu(k,911) * lu(k,1532) - lu(k,1551) = - lu(k,912) * lu(k,1532) - lu(k,1552) = lu(k,1552) - lu(k,913) * lu(k,1532) - lu(k,1555) = lu(k,1555) - lu(k,914) * lu(k,1532) - lu(k,1556) = lu(k,1556) - lu(k,915) * lu(k,1532) - lu(k,1712) = lu(k,1712) - lu(k,907) * lu(k,1686) - lu(k,1717) = lu(k,1717) - lu(k,908) * lu(k,1686) - lu(k,1719) = lu(k,1719) - lu(k,909) * lu(k,1686) - lu(k,1721) = lu(k,1721) - lu(k,910) * lu(k,1686) - lu(k,1723) = lu(k,1723) - lu(k,911) * lu(k,1686) - lu(k,1725) = lu(k,1725) - lu(k,912) * lu(k,1686) - lu(k,1726) = lu(k,1726) - lu(k,913) * lu(k,1686) - lu(k,1729) = lu(k,1729) - lu(k,914) * lu(k,1686) - lu(k,1730) = lu(k,1730) - lu(k,915) * lu(k,1686) - lu(k,1815) = lu(k,1815) - lu(k,907) * lu(k,1811) - lu(k,1820) = lu(k,1820) - lu(k,908) * lu(k,1811) - lu(k,1822) = lu(k,1822) - lu(k,909) * lu(k,1811) - lu(k,1824) = lu(k,1824) - lu(k,910) * lu(k,1811) - lu(k,1826) = lu(k,1826) - lu(k,911) * lu(k,1811) - lu(k,1828) = lu(k,1828) - lu(k,912) * lu(k,1811) - lu(k,1829) = lu(k,1829) - lu(k,913) * lu(k,1811) - lu(k,1832) = lu(k,1832) - lu(k,914) * lu(k,1811) - lu(k,1833) = lu(k,1833) - lu(k,915) * lu(k,1811) - lu(k,1980) = lu(k,1980) - lu(k,907) * lu(k,1973) - lu(k,1985) = lu(k,1985) - lu(k,908) * lu(k,1973) - lu(k,1987) = lu(k,1987) - lu(k,909) * lu(k,1973) - lu(k,1989) = lu(k,1989) - lu(k,910) * lu(k,1973) - lu(k,1991) = lu(k,1991) - lu(k,911) * lu(k,1973) - lu(k,1993) = lu(k,1993) - lu(k,912) * lu(k,1973) - lu(k,1994) = lu(k,1994) - lu(k,913) * lu(k,1973) - lu(k,1997) = lu(k,1997) - lu(k,914) * lu(k,1973) - lu(k,1998) = lu(k,1998) - lu(k,915) * lu(k,1973) - lu(k,2126) = lu(k,2126) - lu(k,907) * lu(k,2124) - lu(k,2131) = lu(k,2131) - lu(k,908) * lu(k,2124) - lu(k,2133) = lu(k,2133) - lu(k,909) * lu(k,2124) - lu(k,2135) = lu(k,2135) - lu(k,910) * lu(k,2124) - lu(k,2137) = - lu(k,911) * lu(k,2124) - lu(k,2139) = - lu(k,912) * lu(k,2124) - lu(k,2140) = lu(k,2140) - lu(k,913) * lu(k,2124) - lu(k,2143) = lu(k,2143) - lu(k,914) * lu(k,2124) - lu(k,2144) = lu(k,2144) - lu(k,915) * lu(k,2124) + lu(k,891) = lu(k,891) * lu(k,880) + lu(k,892) = lu(k,892) * lu(k,880) + lu(k,893) = lu(k,893) * lu(k,880) + lu(k,894) = lu(k,894) * lu(k,880) + lu(k,895) = lu(k,895) * lu(k,880) + lu(k,1755) = lu(k,1755) - lu(k,881) * lu(k,1753) + lu(k,1772) = lu(k,1772) - lu(k,882) * lu(k,1753) + lu(k,1774) = lu(k,1774) - lu(k,883) * lu(k,1753) + lu(k,1781) = - lu(k,884) * lu(k,1753) + lu(k,1782) = lu(k,1782) - lu(k,885) * lu(k,1753) + lu(k,1784) = lu(k,1784) - lu(k,886) * lu(k,1753) + lu(k,1785) = lu(k,1785) - lu(k,887) * lu(k,1753) + lu(k,1787) = lu(k,1787) - lu(k,888) * lu(k,1753) + lu(k,1789) = lu(k,1789) - lu(k,889) * lu(k,1753) + lu(k,1799) = lu(k,1799) - lu(k,890) * lu(k,1753) + lu(k,1801) = lu(k,1801) - lu(k,891) * lu(k,1753) + lu(k,1806) = lu(k,1806) - lu(k,892) * lu(k,1753) + lu(k,1807) = lu(k,1807) - lu(k,893) * lu(k,1753) + lu(k,1810) = lu(k,1810) - lu(k,894) * lu(k,1753) + lu(k,1811) = lu(k,1811) - lu(k,895) * lu(k,1753) + lu(k,1867) = - lu(k,881) * lu(k,1866) + lu(k,1879) = lu(k,1879) - lu(k,882) * lu(k,1866) + lu(k,1881) = lu(k,1881) - lu(k,883) * lu(k,1866) + lu(k,1888) = lu(k,1888) - lu(k,884) * lu(k,1866) + lu(k,1889) = lu(k,1889) - lu(k,885) * lu(k,1866) + lu(k,1891) = lu(k,1891) - lu(k,886) * lu(k,1866) + lu(k,1892) = lu(k,1892) - lu(k,887) * lu(k,1866) + lu(k,1894) = lu(k,1894) - lu(k,888) * lu(k,1866) + lu(k,1896) = lu(k,1896) - lu(k,889) * lu(k,1866) + lu(k,1904) = lu(k,1904) - lu(k,890) * lu(k,1866) + lu(k,1906) = lu(k,1906) - lu(k,891) * lu(k,1866) + lu(k,1911) = lu(k,1911) - lu(k,892) * lu(k,1866) + lu(k,1912) = - lu(k,893) * lu(k,1866) + lu(k,1915) = lu(k,1915) - lu(k,894) * lu(k,1866) + lu(k,1916) = - lu(k,895) * lu(k,1866) + lu(k,2373) = lu(k,2373) - lu(k,881) * lu(k,2372) + lu(k,2384) = lu(k,2384) - lu(k,882) * lu(k,2372) + lu(k,2386) = lu(k,2386) - lu(k,883) * lu(k,2372) + lu(k,2391) = - lu(k,884) * lu(k,2372) + lu(k,2392) = lu(k,2392) - lu(k,885) * lu(k,2372) + lu(k,2394) = - lu(k,886) * lu(k,2372) + lu(k,2395) = - lu(k,887) * lu(k,2372) + lu(k,2397) = lu(k,2397) - lu(k,888) * lu(k,2372) + lu(k,2399) = lu(k,2399) - lu(k,889) * lu(k,2372) + lu(k,2407) = lu(k,2407) - lu(k,890) * lu(k,2372) + lu(k,2409) = lu(k,2409) - lu(k,891) * lu(k,2372) + lu(k,2414) = lu(k,2414) - lu(k,892) * lu(k,2372) + lu(k,2415) = lu(k,2415) - lu(k,893) * lu(k,2372) + lu(k,2418) = lu(k,2418) - lu(k,894) * lu(k,2372) + lu(k,2419) = lu(k,2419) - lu(k,895) * lu(k,2372) + lu(k,899) = 1._r8 / lu(k,899) + lu(k,900) = lu(k,900) * lu(k,899) + lu(k,901) = lu(k,901) * lu(k,899) + lu(k,902) = lu(k,902) * lu(k,899) + lu(k,903) = lu(k,903) * lu(k,899) + lu(k,904) = lu(k,904) * lu(k,899) + lu(k,905) = lu(k,905) * lu(k,899) + lu(k,906) = lu(k,906) * lu(k,899) + lu(k,907) = lu(k,907) * lu(k,899) + lu(k,1042) = lu(k,1042) - lu(k,900) * lu(k,1039) + lu(k,1044) = - lu(k,901) * lu(k,1039) + lu(k,1045) = lu(k,1045) - lu(k,902) * lu(k,1039) + lu(k,1046) = lu(k,1046) - lu(k,903) * lu(k,1039) + lu(k,1047) = lu(k,1047) - lu(k,904) * lu(k,1039) + lu(k,1048) = lu(k,1048) - lu(k,905) * lu(k,1039) + lu(k,1049) = - lu(k,906) * lu(k,1039) + lu(k,1050) = lu(k,1050) - lu(k,907) * lu(k,1039) + lu(k,1773) = lu(k,1773) - lu(k,900) * lu(k,1754) + lu(k,1795) = lu(k,1795) - lu(k,901) * lu(k,1754) + lu(k,1799) = lu(k,1799) - lu(k,902) * lu(k,1754) + lu(k,1800) = lu(k,1800) - lu(k,903) * lu(k,1754) + lu(k,1804) = lu(k,1804) - lu(k,904) * lu(k,1754) + lu(k,1806) = lu(k,1806) - lu(k,905) * lu(k,1754) + lu(k,1807) = lu(k,1807) - lu(k,906) * lu(k,1754) + lu(k,1810) = lu(k,1810) - lu(k,907) * lu(k,1754) + lu(k,1936) = - lu(k,900) * lu(k,1930) + lu(k,1946) = lu(k,1946) - lu(k,901) * lu(k,1930) + lu(k,1950) = lu(k,1950) - lu(k,902) * lu(k,1930) + lu(k,1951) = lu(k,1951) - lu(k,903) * lu(k,1930) + lu(k,1955) = lu(k,1955) - lu(k,904) * lu(k,1930) + lu(k,1957) = lu(k,1957) - lu(k,905) * lu(k,1930) + lu(k,1958) = lu(k,1958) - lu(k,906) * lu(k,1930) + lu(k,1961) = lu(k,1961) - lu(k,907) * lu(k,1930) + lu(k,2045) = lu(k,2045) - lu(k,900) * lu(k,2032) + lu(k,2064) = lu(k,2064) - lu(k,901) * lu(k,2032) + lu(k,2068) = lu(k,2068) - lu(k,902) * lu(k,2032) + lu(k,2069) = lu(k,2069) - lu(k,903) * lu(k,2032) + lu(k,2073) = lu(k,2073) - lu(k,904) * lu(k,2032) + lu(k,2075) = lu(k,2075) - lu(k,905) * lu(k,2032) + lu(k,2076) = lu(k,2076) - lu(k,906) * lu(k,2032) + lu(k,2079) = lu(k,2079) - lu(k,907) * lu(k,2032) + lu(k,2173) = lu(k,2173) - lu(k,900) * lu(k,2162) + lu(k,2193) = lu(k,2193) - lu(k,901) * lu(k,2162) + lu(k,2197) = lu(k,2197) - lu(k,902) * lu(k,2162) + lu(k,2198) = lu(k,2198) - lu(k,903) * lu(k,2162) + lu(k,2202) = lu(k,2202) - lu(k,904) * lu(k,2162) + lu(k,2204) = lu(k,2204) - lu(k,905) * lu(k,2162) + lu(k,2205) = lu(k,2205) - lu(k,906) * lu(k,2162) + lu(k,2208) = lu(k,2208) - lu(k,907) * lu(k,2162) + lu(k,2228) = lu(k,2228) - lu(k,900) * lu(k,2219) + lu(k,2245) = lu(k,2245) - lu(k,901) * lu(k,2219) + lu(k,2249) = lu(k,2249) - lu(k,902) * lu(k,2219) + lu(k,2250) = lu(k,2250) - lu(k,903) * lu(k,2219) + lu(k,2254) = lu(k,2254) - lu(k,904) * lu(k,2219) + lu(k,2256) = lu(k,2256) - lu(k,905) * lu(k,2219) + lu(k,2257) = lu(k,2257) - lu(k,906) * lu(k,2219) + lu(k,2260) = lu(k,2260) - lu(k,907) * lu(k,2219) end do end subroutine lu_fac19 subroutine lu_fac20( avec_len, lu ) @@ -3532,217 +3210,234 @@ subroutine lu_fac20( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,916) = 1._r8 / lu(k,916) - lu(k,917) = lu(k,917) * lu(k,916) - lu(k,918) = lu(k,918) * lu(k,916) - lu(k,919) = lu(k,919) * lu(k,916) - lu(k,920) = lu(k,920) * lu(k,916) - lu(k,921) = lu(k,921) * lu(k,916) - lu(k,922) = lu(k,922) * lu(k,916) - lu(k,923) = lu(k,923) * lu(k,916) - lu(k,1006) = - lu(k,917) * lu(k,1005) - lu(k,1007) = - lu(k,918) * lu(k,1005) - lu(k,1009) = - lu(k,919) * lu(k,1005) - lu(k,1010) = - lu(k,920) * lu(k,1005) - lu(k,1015) = lu(k,1015) - lu(k,921) * lu(k,1005) - lu(k,1017) = - lu(k,922) * lu(k,1005) - lu(k,1021) = lu(k,1021) - lu(k,923) * lu(k,1005) - lu(k,1046) = - lu(k,917) * lu(k,1045) - lu(k,1047) = - lu(k,918) * lu(k,1045) - lu(k,1048) = - lu(k,919) * lu(k,1045) - lu(k,1049) = lu(k,1049) - lu(k,920) * lu(k,1045) - lu(k,1054) = lu(k,1054) - lu(k,921) * lu(k,1045) - lu(k,1056) = lu(k,1056) - lu(k,922) * lu(k,1045) - lu(k,1060) = lu(k,1060) - lu(k,923) * lu(k,1045) - lu(k,1378) = lu(k,1378) - lu(k,917) * lu(k,1375) - lu(k,1380) = lu(k,1380) - lu(k,918) * lu(k,1375) - lu(k,1382) = lu(k,1382) - lu(k,919) * lu(k,1375) - lu(k,1383) = lu(k,1383) - lu(k,920) * lu(k,1375) - lu(k,1400) = lu(k,1400) - lu(k,921) * lu(k,1375) - lu(k,1403) = - lu(k,922) * lu(k,1375) - lu(k,1407) = lu(k,1407) - lu(k,923) * lu(k,1375) - lu(k,1486) = lu(k,1486) - lu(k,917) * lu(k,1482) - lu(k,1488) = lu(k,1488) - lu(k,918) * lu(k,1482) - lu(k,1490) = lu(k,1490) - lu(k,919) * lu(k,1482) - lu(k,1491) = lu(k,1491) - lu(k,920) * lu(k,1482) - lu(k,1510) = lu(k,1510) - lu(k,921) * lu(k,1482) - lu(k,1514) = lu(k,1514) - lu(k,922) * lu(k,1482) - lu(k,1519) = lu(k,1519) - lu(k,923) * lu(k,1482) - lu(k,1692) = lu(k,1692) - lu(k,917) * lu(k,1687) - lu(k,1694) = lu(k,1694) - lu(k,918) * lu(k,1687) - lu(k,1696) = lu(k,1696) - lu(k,919) * lu(k,1687) - lu(k,1697) = lu(k,1697) - lu(k,920) * lu(k,1687) - lu(k,1719) = lu(k,1719) - lu(k,921) * lu(k,1687) - lu(k,1723) = lu(k,1723) - lu(k,922) * lu(k,1687) - lu(k,1728) = lu(k,1728) - lu(k,923) * lu(k,1687) - lu(k,1757) = lu(k,1757) - lu(k,917) * lu(k,1754) - lu(k,1759) = lu(k,1759) - lu(k,918) * lu(k,1754) - lu(k,1761) = - lu(k,919) * lu(k,1754) - lu(k,1762) = lu(k,1762) - lu(k,920) * lu(k,1754) - lu(k,1781) = lu(k,1781) - lu(k,921) * lu(k,1754) - lu(k,1785) = lu(k,1785) - lu(k,922) * lu(k,1754) - lu(k,1790) = lu(k,1790) - lu(k,923) * lu(k,1754) - lu(k,1878) = lu(k,1878) - lu(k,917) * lu(k,1873) - lu(k,1880) = lu(k,1880) - lu(k,918) * lu(k,1873) - lu(k,1882) = lu(k,1882) - lu(k,919) * lu(k,1873) - lu(k,1883) = lu(k,1883) - lu(k,920) * lu(k,1873) - lu(k,1903) = lu(k,1903) - lu(k,921) * lu(k,1873) - lu(k,1907) = lu(k,1907) - lu(k,922) * lu(k,1873) - lu(k,1912) = lu(k,1912) - lu(k,923) * lu(k,1873) - lu(k,2080) = lu(k,2080) - lu(k,917) * lu(k,2078) - lu(k,2082) = lu(k,2082) - lu(k,918) * lu(k,2078) - lu(k,2084) = lu(k,2084) - lu(k,919) * lu(k,2078) - lu(k,2085) = lu(k,2085) - lu(k,920) * lu(k,2078) - lu(k,2106) = lu(k,2106) - lu(k,921) * lu(k,2078) - lu(k,2110) = lu(k,2110) - lu(k,922) * lu(k,2078) - lu(k,2115) = lu(k,2115) - lu(k,923) * lu(k,2078) - lu(k,928) = 1._r8 / lu(k,928) - lu(k,929) = lu(k,929) * lu(k,928) - lu(k,930) = lu(k,930) * lu(k,928) - lu(k,931) = lu(k,931) * lu(k,928) - lu(k,932) = lu(k,932) * lu(k,928) - lu(k,933) = lu(k,933) * lu(k,928) - lu(k,934) = lu(k,934) * lu(k,928) - lu(k,935) = lu(k,935) * lu(k,928) - lu(k,936) = lu(k,936) * lu(k,928) - lu(k,937) = lu(k,937) * lu(k,928) - lu(k,938) = lu(k,938) * lu(k,928) - lu(k,1122) = - lu(k,929) * lu(k,1120) - lu(k,1126) = lu(k,1126) - lu(k,930) * lu(k,1120) - lu(k,1128) = lu(k,1128) - lu(k,931) * lu(k,1120) - lu(k,1129) = lu(k,1129) - lu(k,932) * lu(k,1120) - lu(k,1130) = lu(k,1130) - lu(k,933) * lu(k,1120) - lu(k,1131) = lu(k,1131) - lu(k,934) * lu(k,1120) - lu(k,1132) = lu(k,1132) - lu(k,935) * lu(k,1120) - lu(k,1135) = lu(k,1135) - lu(k,936) * lu(k,1120) - lu(k,1136) = lu(k,1136) - lu(k,937) * lu(k,1120) - lu(k,1137) = lu(k,1137) - lu(k,938) * lu(k,1120) - lu(k,1292) = lu(k,1292) - lu(k,929) * lu(k,1289) - lu(k,1296) = lu(k,1296) - lu(k,930) * lu(k,1289) - lu(k,1302) = lu(k,1302) - lu(k,931) * lu(k,1289) - lu(k,1303) = lu(k,1303) - lu(k,932) * lu(k,1289) - lu(k,1305) = lu(k,1305) - lu(k,933) * lu(k,1289) - lu(k,1306) = lu(k,1306) - lu(k,934) * lu(k,1289) - lu(k,1308) = lu(k,1308) - lu(k,935) * lu(k,1289) - lu(k,1311) = - lu(k,936) * lu(k,1289) - lu(k,1312) = lu(k,1312) - lu(k,937) * lu(k,1289) - lu(k,1313) = lu(k,1313) - lu(k,938) * lu(k,1289) - lu(k,1380) = lu(k,1380) - lu(k,929) * lu(k,1376) - lu(k,1389) = lu(k,1389) - lu(k,930) * lu(k,1376) - lu(k,1395) = lu(k,1395) - lu(k,931) * lu(k,1376) - lu(k,1396) = lu(k,1396) - lu(k,932) * lu(k,1376) - lu(k,1398) = lu(k,1398) - lu(k,933) * lu(k,1376) - lu(k,1400) = lu(k,1400) - lu(k,934) * lu(k,1376) - lu(k,1402) = lu(k,1402) - lu(k,935) * lu(k,1376) - lu(k,1405) = lu(k,1405) - lu(k,936) * lu(k,1376) - lu(k,1406) = lu(k,1406) - lu(k,937) * lu(k,1376) - lu(k,1407) = lu(k,1407) - lu(k,938) * lu(k,1376) - lu(k,1488) = lu(k,1488) - lu(k,929) * lu(k,1483) - lu(k,1497) = lu(k,1497) - lu(k,930) * lu(k,1483) - lu(k,1503) = lu(k,1503) - lu(k,931) * lu(k,1483) - lu(k,1505) = lu(k,1505) - lu(k,932) * lu(k,1483) - lu(k,1507) = lu(k,1507) - lu(k,933) * lu(k,1483) - lu(k,1510) = lu(k,1510) - lu(k,934) * lu(k,1483) - lu(k,1513) = lu(k,1513) - lu(k,935) * lu(k,1483) - lu(k,1516) = lu(k,1516) - lu(k,936) * lu(k,1483) - lu(k,1517) = lu(k,1517) - lu(k,937) * lu(k,1483) - lu(k,1519) = lu(k,1519) - lu(k,938) * lu(k,1483) - lu(k,1694) = lu(k,1694) - lu(k,929) * lu(k,1688) - lu(k,1704) = lu(k,1704) - lu(k,930) * lu(k,1688) - lu(k,1710) = lu(k,1710) - lu(k,931) * lu(k,1688) - lu(k,1714) = lu(k,1714) - lu(k,932) * lu(k,1688) - lu(k,1716) = lu(k,1716) - lu(k,933) * lu(k,1688) - lu(k,1719) = lu(k,1719) - lu(k,934) * lu(k,1688) - lu(k,1722) = lu(k,1722) - lu(k,935) * lu(k,1688) - lu(k,1725) = lu(k,1725) - lu(k,936) * lu(k,1688) - lu(k,1726) = lu(k,1726) - lu(k,937) * lu(k,1688) - lu(k,1728) = lu(k,1728) - lu(k,938) * lu(k,1688) - lu(k,1880) = lu(k,1880) - lu(k,929) * lu(k,1874) - lu(k,1889) = lu(k,1889) - lu(k,930) * lu(k,1874) - lu(k,1895) = lu(k,1895) - lu(k,931) * lu(k,1874) - lu(k,1898) = lu(k,1898) - lu(k,932) * lu(k,1874) - lu(k,1900) = lu(k,1900) - lu(k,933) * lu(k,1874) - lu(k,1903) = lu(k,1903) - lu(k,934) * lu(k,1874) - lu(k,1906) = lu(k,1906) - lu(k,935) * lu(k,1874) - lu(k,1909) = lu(k,1909) - lu(k,936) * lu(k,1874) - lu(k,1910) = lu(k,1910) - lu(k,937) * lu(k,1874) - lu(k,1912) = lu(k,1912) - lu(k,938) * lu(k,1874) - 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,953) = lu(k,953) * lu(k,943) - lu(k,954) = lu(k,954) * lu(k,943) - lu(k,955) = lu(k,955) * lu(k,943) - lu(k,956) = lu(k,956) * lu(k,943) - lu(k,957) = lu(k,957) * lu(k,943) - lu(k,958) = lu(k,958) * lu(k,943) - lu(k,1246) = - lu(k,944) * lu(k,1245) - lu(k,1247) = lu(k,1247) - lu(k,945) * lu(k,1245) - lu(k,1248) = lu(k,1248) - lu(k,946) * lu(k,1245) - lu(k,1249) = lu(k,1249) - lu(k,947) * lu(k,1245) - lu(k,1253) = lu(k,1253) - lu(k,948) * lu(k,1245) - lu(k,1254) = lu(k,1254) - lu(k,949) * lu(k,1245) - lu(k,1255) = - lu(k,950) * lu(k,1245) - lu(k,1256) = - lu(k,951) * lu(k,1245) - lu(k,1257) = lu(k,1257) - lu(k,952) * lu(k,1245) - lu(k,1258) = lu(k,1258) - lu(k,953) * lu(k,1245) - lu(k,1259) = lu(k,1259) - lu(k,954) * lu(k,1245) - lu(k,1260) = - lu(k,955) * lu(k,1245) - lu(k,1263) = - lu(k,956) * lu(k,1245) - lu(k,1264) = lu(k,1264) - lu(k,957) * lu(k,1245) - lu(k,1265) = lu(k,1265) - lu(k,958) * lu(k,1245) - lu(k,1693) = lu(k,1693) - lu(k,944) * lu(k,1689) - lu(k,1694) = lu(k,1694) - lu(k,945) * lu(k,1689) - lu(k,1699) = lu(k,1699) - lu(k,946) * lu(k,1689) - lu(k,1704) = lu(k,1704) - lu(k,947) * lu(k,1689) - lu(k,1710) = lu(k,1710) - lu(k,948) * lu(k,1689) - lu(k,1714) = lu(k,1714) - lu(k,949) * lu(k,1689) - lu(k,1715) = lu(k,1715) - lu(k,950) * lu(k,1689) - lu(k,1716) = lu(k,1716) - lu(k,951) * lu(k,1689) - lu(k,1719) = lu(k,1719) - lu(k,952) * lu(k,1689) - lu(k,1720) = lu(k,1720) - lu(k,953) * lu(k,1689) - lu(k,1722) = lu(k,1722) - lu(k,954) * lu(k,1689) - lu(k,1723) = lu(k,1723) - lu(k,955) * lu(k,1689) - lu(k,1726) = lu(k,1726) - lu(k,956) * lu(k,1689) - lu(k,1728) = lu(k,1728) - lu(k,957) * lu(k,1689) - lu(k,1730) = lu(k,1730) - lu(k,958) * lu(k,1689) - lu(k,1758) = - lu(k,944) * lu(k,1755) - lu(k,1759) = lu(k,1759) - lu(k,945) * lu(k,1755) - lu(k,1764) = lu(k,1764) - lu(k,946) * lu(k,1755) - lu(k,1767) = lu(k,1767) - lu(k,947) * lu(k,1755) - lu(k,1773) = lu(k,1773) - lu(k,948) * lu(k,1755) - lu(k,1776) = lu(k,1776) - lu(k,949) * lu(k,1755) - lu(k,1777) = lu(k,1777) - lu(k,950) * lu(k,1755) - lu(k,1778) = lu(k,1778) - lu(k,951) * lu(k,1755) - lu(k,1781) = lu(k,1781) - lu(k,952) * lu(k,1755) - lu(k,1782) = lu(k,1782) - lu(k,953) * lu(k,1755) - lu(k,1784) = lu(k,1784) - lu(k,954) * lu(k,1755) - lu(k,1785) = lu(k,1785) - lu(k,955) * lu(k,1755) - lu(k,1788) = lu(k,1788) - lu(k,956) * lu(k,1755) - lu(k,1790) = lu(k,1790) - lu(k,957) * lu(k,1755) - lu(k,1792) = lu(k,1792) - lu(k,958) * lu(k,1755) - lu(k,1879) = lu(k,1879) - lu(k,944) * lu(k,1875) - lu(k,1880) = lu(k,1880) - lu(k,945) * lu(k,1875) - lu(k,1885) = lu(k,1885) - lu(k,946) * lu(k,1875) - lu(k,1889) = lu(k,1889) - lu(k,947) * lu(k,1875) - lu(k,1895) = lu(k,1895) - lu(k,948) * lu(k,1875) - lu(k,1898) = lu(k,1898) - lu(k,949) * lu(k,1875) - lu(k,1899) = lu(k,1899) - lu(k,950) * lu(k,1875) - lu(k,1900) = lu(k,1900) - lu(k,951) * lu(k,1875) - lu(k,1903) = lu(k,1903) - lu(k,952) * lu(k,1875) - lu(k,1904) = lu(k,1904) - lu(k,953) * lu(k,1875) - lu(k,1906) = lu(k,1906) - lu(k,954) * lu(k,1875) - lu(k,1907) = lu(k,1907) - lu(k,955) * lu(k,1875) - lu(k,1910) = lu(k,1910) - lu(k,956) * lu(k,1875) - lu(k,1912) = lu(k,1912) - lu(k,957) * lu(k,1875) - lu(k,1914) = lu(k,1914) - lu(k,958) * lu(k,1875) + lu(k,908) = 1._r8 / lu(k,908) + lu(k,909) = lu(k,909) * lu(k,908) + lu(k,910) = lu(k,910) * lu(k,908) + lu(k,911) = lu(k,911) * lu(k,908) + lu(k,912) = lu(k,912) * lu(k,908) + lu(k,1000) = lu(k,1000) - lu(k,909) * lu(k,987) + lu(k,1001) = lu(k,1001) - lu(k,910) * lu(k,987) + lu(k,1003) = lu(k,1003) - lu(k,911) * lu(k,987) + lu(k,1006) = - lu(k,912) * lu(k,987) + lu(k,1028) = lu(k,1028) - lu(k,909) * lu(k,1015) + lu(k,1029) = lu(k,1029) - lu(k,910) * lu(k,1015) + lu(k,1031) = lu(k,1031) - lu(k,911) * lu(k,1015) + lu(k,1034) = - lu(k,912) * lu(k,1015) + lu(k,1137) = lu(k,1137) - lu(k,909) * lu(k,1130) + lu(k,1139) = lu(k,1139) - lu(k,910) * lu(k,1130) + lu(k,1143) = lu(k,1143) - lu(k,911) * lu(k,1130) + lu(k,1148) = lu(k,1148) - lu(k,912) * lu(k,1130) + lu(k,1272) = - lu(k,909) * lu(k,1265) + lu(k,1273) = lu(k,1273) - lu(k,910) * lu(k,1265) + lu(k,1274) = lu(k,1274) - lu(k,911) * lu(k,1265) + lu(k,1277) = lu(k,1277) - lu(k,912) * lu(k,1265) + lu(k,1377) = lu(k,1377) - lu(k,909) * lu(k,1367) + lu(k,1379) = lu(k,1379) - lu(k,910) * lu(k,1367) + lu(k,1384) = lu(k,1384) - lu(k,911) * lu(k,1367) + lu(k,1389) = - lu(k,912) * lu(k,1367) + lu(k,1790) = lu(k,1790) - lu(k,909) * lu(k,1755) + lu(k,1799) = lu(k,1799) - lu(k,910) * lu(k,1755) + lu(k,1806) = lu(k,1806) - lu(k,911) * lu(k,1755) + lu(k,1812) = lu(k,1812) - lu(k,912) * lu(k,1755) + lu(k,1897) = - lu(k,909) * lu(k,1867) + lu(k,1904) = lu(k,1904) - lu(k,910) * lu(k,1867) + lu(k,1911) = lu(k,1911) - lu(k,911) * lu(k,1867) + lu(k,1917) = - lu(k,912) * lu(k,1867) + lu(k,1942) = - lu(k,909) * lu(k,1931) + lu(k,1950) = lu(k,1950) - lu(k,910) * lu(k,1931) + lu(k,1957) = lu(k,1957) - lu(k,911) * lu(k,1931) + lu(k,1963) = lu(k,1963) - lu(k,912) * lu(k,1931) + lu(k,2062) = lu(k,2062) - lu(k,909) * lu(k,2033) + lu(k,2068) = lu(k,2068) - lu(k,910) * lu(k,2033) + lu(k,2075) = lu(k,2075) - lu(k,911) * lu(k,2033) + lu(k,2081) = lu(k,2081) - lu(k,912) * lu(k,2033) + lu(k,2189) = lu(k,2189) - lu(k,909) * lu(k,2163) + lu(k,2197) = lu(k,2197) - lu(k,910) * lu(k,2163) + lu(k,2204) = lu(k,2204) - lu(k,911) * lu(k,2163) + lu(k,2210) = lu(k,2210) - lu(k,912) * lu(k,2163) + lu(k,2335) = - lu(k,909) * lu(k,2333) + lu(k,2343) = lu(k,2343) - lu(k,910) * lu(k,2333) + lu(k,2350) = lu(k,2350) - lu(k,911) * lu(k,2333) + lu(k,2356) = lu(k,2356) - lu(k,912) * lu(k,2333) + lu(k,2400) = lu(k,2400) - lu(k,909) * lu(k,2373) + lu(k,2407) = lu(k,2407) - lu(k,910) * lu(k,2373) + lu(k,2414) = lu(k,2414) - lu(k,911) * lu(k,2373) + lu(k,2420) = lu(k,2420) - lu(k,912) * lu(k,2373) + lu(k,913) = 1._r8 / lu(k,913) + lu(k,914) = lu(k,914) * lu(k,913) + lu(k,915) = lu(k,915) * lu(k,913) + lu(k,916) = lu(k,916) * lu(k,913) + lu(k,917) = lu(k,917) * lu(k,913) + lu(k,918) = lu(k,918) * lu(k,913) + lu(k,919) = lu(k,919) * lu(k,913) + lu(k,920) = lu(k,920) * lu(k,913) + lu(k,921) = lu(k,921) * lu(k,913) + lu(k,1114) = lu(k,1114) - lu(k,914) * lu(k,1113) + lu(k,1116) = lu(k,1116) - lu(k,915) * lu(k,1113) + lu(k,1117) = lu(k,1117) - lu(k,916) * lu(k,1113) + lu(k,1120) = lu(k,1120) - lu(k,917) * lu(k,1113) + lu(k,1121) = lu(k,1121) - lu(k,918) * lu(k,1113) + lu(k,1123) = - lu(k,919) * lu(k,1113) + lu(k,1124) = lu(k,1124) - lu(k,920) * lu(k,1113) + lu(k,1125) = - lu(k,921) * lu(k,1113) + lu(k,1321) = lu(k,1321) - lu(k,914) * lu(k,1320) + lu(k,1322) = lu(k,1322) - lu(k,915) * lu(k,1320) + lu(k,1329) = lu(k,1329) - lu(k,916) * lu(k,1320) + lu(k,1336) = lu(k,1336) - lu(k,917) * lu(k,1320) + lu(k,1337) = lu(k,1337) - lu(k,918) * lu(k,1320) + lu(k,1340) = lu(k,1340) - lu(k,919) * lu(k,1320) + lu(k,1341) = lu(k,1341) - lu(k,920) * lu(k,1320) + lu(k,1342) = lu(k,1342) - lu(k,921) * lu(k,1320) + lu(k,1765) = lu(k,1765) - lu(k,914) * lu(k,1756) + lu(k,1774) = lu(k,1774) - lu(k,915) * lu(k,1756) + lu(k,1783) = lu(k,1783) - lu(k,916) * lu(k,1756) + lu(k,1799) = lu(k,1799) - lu(k,917) * lu(k,1756) + lu(k,1800) = lu(k,1800) - lu(k,918) * lu(k,1756) + lu(k,1804) = lu(k,1804) - lu(k,919) * lu(k,1756) + lu(k,1806) = lu(k,1806) - lu(k,920) * lu(k,1756) + lu(k,1807) = lu(k,1807) - lu(k,921) * lu(k,1756) + lu(k,1830) = lu(k,1830) - lu(k,914) * lu(k,1826) + lu(k,1831) = lu(k,1831) - lu(k,915) * lu(k,1826) + lu(k,1833) = lu(k,1833) - lu(k,916) * lu(k,1826) + lu(k,1844) = lu(k,1844) - lu(k,917) * lu(k,1826) + lu(k,1845) = lu(k,1845) - lu(k,918) * lu(k,1826) + lu(k,1849) = lu(k,1849) - lu(k,919) * lu(k,1826) + lu(k,1851) = lu(k,1851) - lu(k,920) * lu(k,1826) + lu(k,1852) = lu(k,1852) - lu(k,921) * lu(k,1826) + lu(k,2038) = lu(k,2038) - lu(k,914) * lu(k,2034) + lu(k,2046) = lu(k,2046) - lu(k,915) * lu(k,2034) + lu(k,2055) = lu(k,2055) - lu(k,916) * lu(k,2034) + lu(k,2068) = lu(k,2068) - lu(k,917) * lu(k,2034) + lu(k,2069) = lu(k,2069) - lu(k,918) * lu(k,2034) + lu(k,2073) = lu(k,2073) - lu(k,919) * lu(k,2034) + lu(k,2075) = lu(k,2075) - lu(k,920) * lu(k,2034) + lu(k,2076) = lu(k,2076) - lu(k,921) * lu(k,2034) + lu(k,2167) = lu(k,2167) - lu(k,914) * lu(k,2164) + lu(k,2174) = lu(k,2174) - lu(k,915) * lu(k,2164) + lu(k,2182) = lu(k,2182) - lu(k,916) * lu(k,2164) + lu(k,2197) = lu(k,2197) - lu(k,917) * lu(k,2164) + lu(k,2198) = lu(k,2198) - lu(k,918) * lu(k,2164) + lu(k,2202) = lu(k,2202) - lu(k,919) * lu(k,2164) + lu(k,2204) = lu(k,2204) - lu(k,920) * lu(k,2164) + lu(k,2205) = lu(k,2205) - lu(k,921) * lu(k,2164) + lu(k,923) = 1._r8 / lu(k,923) + lu(k,924) = lu(k,924) * lu(k,923) + lu(k,925) = lu(k,925) * lu(k,923) + lu(k,926) = lu(k,926) * lu(k,923) + lu(k,927) = lu(k,927) * lu(k,923) + lu(k,928) = lu(k,928) * lu(k,923) + lu(k,929) = lu(k,929) * lu(k,923) + lu(k,930) = lu(k,930) * lu(k,923) + lu(k,931) = lu(k,931) * lu(k,923) + lu(k,1459) = lu(k,1459) - lu(k,924) * lu(k,1458) + lu(k,1462) = lu(k,1462) - lu(k,925) * lu(k,1458) + lu(k,1463) = - lu(k,926) * lu(k,1458) + lu(k,1465) = - lu(k,927) * lu(k,1458) + lu(k,1466) = lu(k,1466) - lu(k,928) * lu(k,1458) + lu(k,1467) = - lu(k,929) * lu(k,1458) + lu(k,1468) = - lu(k,930) * lu(k,1458) + lu(k,1470) = lu(k,1470) - lu(k,931) * lu(k,1458) + lu(k,1627) = lu(k,1627) - lu(k,924) * lu(k,1626) + lu(k,1634) = lu(k,1634) - lu(k,925) * lu(k,1626) + lu(k,1636) = - lu(k,926) * lu(k,1626) + lu(k,1638) = - lu(k,927) * lu(k,1626) + lu(k,1640) = lu(k,1640) - lu(k,928) * lu(k,1626) + lu(k,1642) = lu(k,1642) - lu(k,929) * lu(k,1626) + lu(k,1643) = lu(k,1643) - lu(k,930) * lu(k,1626) + lu(k,1647) = lu(k,1647) - lu(k,931) * lu(k,1626) + lu(k,1791) = lu(k,1791) - lu(k,924) * lu(k,1757) + lu(k,1799) = lu(k,1799) - lu(k,925) * lu(k,1757) + lu(k,1801) = lu(k,1801) - lu(k,926) * lu(k,1757) + lu(k,1803) = lu(k,1803) - lu(k,927) * lu(k,1757) + lu(k,1805) = lu(k,1805) - lu(k,928) * lu(k,1757) + lu(k,1807) = lu(k,1807) - lu(k,929) * lu(k,1757) + lu(k,1808) = lu(k,1808) - lu(k,930) * lu(k,1757) + lu(k,1812) = lu(k,1812) - lu(k,931) * lu(k,1757) + lu(k,1966) = - lu(k,924) * lu(k,1965) + lu(k,1973) = lu(k,1973) - lu(k,925) * lu(k,1965) + lu(k,1975) = lu(k,1975) - lu(k,926) * lu(k,1965) + lu(k,1977) = lu(k,1977) - lu(k,927) * lu(k,1965) + lu(k,1979) = lu(k,1979) - lu(k,928) * lu(k,1965) + lu(k,1981) = - lu(k,929) * lu(k,1965) + lu(k,1982) = - lu(k,930) * lu(k,1965) + lu(k,1986) = lu(k,1986) - lu(k,931) * lu(k,1965) + lu(k,2267) = lu(k,2267) - lu(k,924) * lu(k,2264) + lu(k,2274) = lu(k,2274) - lu(k,925) * lu(k,2264) + lu(k,2276) = - lu(k,926) * lu(k,2264) + lu(k,2278) = - lu(k,927) * lu(k,2264) + lu(k,2280) = lu(k,2280) - lu(k,928) * lu(k,2264) + lu(k,2282) = lu(k,2282) - lu(k,929) * lu(k,2264) + lu(k,2283) = lu(k,2283) - lu(k,930) * lu(k,2264) + lu(k,2287) = lu(k,2287) - lu(k,931) * lu(k,2264) + lu(k,2426) = lu(k,2426) - lu(k,924) * lu(k,2424) + lu(k,2434) = lu(k,2434) - lu(k,925) * lu(k,2424) + lu(k,2436) = - lu(k,926) * lu(k,2424) + lu(k,2438) = - lu(k,927) * lu(k,2424) + lu(k,2440) = lu(k,2440) - lu(k,928) * lu(k,2424) + lu(k,2442) = - lu(k,929) * lu(k,2424) + lu(k,2443) = - lu(k,930) * lu(k,2424) + lu(k,2447) = lu(k,2447) - lu(k,931) * lu(k,2424) + lu(k,933) = 1._r8 / lu(k,933) + lu(k,934) = lu(k,934) * lu(k,933) + lu(k,935) = lu(k,935) * lu(k,933) + lu(k,936) = lu(k,936) * lu(k,933) + lu(k,937) = lu(k,937) * lu(k,933) + lu(k,938) = lu(k,938) * lu(k,933) + lu(k,939) = lu(k,939) * lu(k,933) + lu(k,940) = lu(k,940) * lu(k,933) + lu(k,941) = lu(k,941) * lu(k,933) + lu(k,942) = lu(k,942) * lu(k,933) + lu(k,943) = lu(k,943) * lu(k,933) + lu(k,1768) = lu(k,1768) - lu(k,934) * lu(k,1758) + lu(k,1773) = lu(k,1773) - lu(k,935) * lu(k,1758) + lu(k,1795) = lu(k,1795) - lu(k,936) * lu(k,1758) + lu(k,1799) = lu(k,1799) - lu(k,937) * lu(k,1758) + lu(k,1800) = lu(k,1800) - lu(k,938) * lu(k,1758) + lu(k,1804) = lu(k,1804) - lu(k,939) * lu(k,1758) + lu(k,1806) = lu(k,1806) - lu(k,940) * lu(k,1758) + lu(k,1807) = lu(k,1807) - lu(k,941) * lu(k,1758) + lu(k,1810) = lu(k,1810) - lu(k,942) * lu(k,1758) + lu(k,1812) = lu(k,1812) - lu(k,943) * lu(k,1758) + lu(k,1935) = - lu(k,934) * lu(k,1932) + lu(k,1936) = lu(k,1936) - lu(k,935) * lu(k,1932) + lu(k,1946) = lu(k,1946) - lu(k,936) * lu(k,1932) + lu(k,1950) = lu(k,1950) - lu(k,937) * lu(k,1932) + lu(k,1951) = lu(k,1951) - lu(k,938) * lu(k,1932) + lu(k,1955) = lu(k,1955) - lu(k,939) * lu(k,1932) + lu(k,1957) = lu(k,1957) - lu(k,940) * lu(k,1932) + lu(k,1958) = lu(k,1958) - lu(k,941) * lu(k,1932) + lu(k,1961) = lu(k,1961) - lu(k,942) * lu(k,1932) + lu(k,1963) = lu(k,1963) - lu(k,943) * lu(k,1932) + lu(k,2041) = lu(k,2041) - lu(k,934) * lu(k,2035) + lu(k,2045) = lu(k,2045) - lu(k,935) * lu(k,2035) + lu(k,2064) = lu(k,2064) - lu(k,936) * lu(k,2035) + lu(k,2068) = lu(k,2068) - lu(k,937) * lu(k,2035) + lu(k,2069) = lu(k,2069) - lu(k,938) * lu(k,2035) + lu(k,2073) = lu(k,2073) - lu(k,939) * lu(k,2035) + lu(k,2075) = lu(k,2075) - lu(k,940) * lu(k,2035) + lu(k,2076) = lu(k,2076) - lu(k,941) * lu(k,2035) + lu(k,2079) = lu(k,2079) - lu(k,942) * lu(k,2035) + lu(k,2081) = lu(k,2081) - lu(k,943) * lu(k,2035) + lu(k,2170) = lu(k,2170) - lu(k,934) * lu(k,2165) + lu(k,2173) = lu(k,2173) - lu(k,935) * lu(k,2165) + lu(k,2193) = lu(k,2193) - lu(k,936) * lu(k,2165) + lu(k,2197) = lu(k,2197) - lu(k,937) * lu(k,2165) + lu(k,2198) = lu(k,2198) - lu(k,938) * lu(k,2165) + lu(k,2202) = lu(k,2202) - lu(k,939) * lu(k,2165) + lu(k,2204) = lu(k,2204) - lu(k,940) * lu(k,2165) + lu(k,2205) = lu(k,2205) - lu(k,941) * lu(k,2165) + lu(k,2208) = lu(k,2208) - lu(k,942) * lu(k,2165) + lu(k,2210) = lu(k,2210) - lu(k,943) * lu(k,2165) + lu(k,2224) = lu(k,2224) - lu(k,934) * lu(k,2220) + lu(k,2228) = lu(k,2228) - lu(k,935) * lu(k,2220) + lu(k,2245) = lu(k,2245) - lu(k,936) * lu(k,2220) + lu(k,2249) = lu(k,2249) - lu(k,937) * lu(k,2220) + lu(k,2250) = lu(k,2250) - lu(k,938) * lu(k,2220) + lu(k,2254) = lu(k,2254) - lu(k,939) * lu(k,2220) + lu(k,2256) = lu(k,2256) - lu(k,940) * lu(k,2220) + lu(k,2257) = lu(k,2257) - lu(k,941) * lu(k,2220) + lu(k,2260) = lu(k,2260) - lu(k,942) * lu(k,2220) + lu(k,2262) = lu(k,2262) - lu(k,943) * lu(k,2220) end do end subroutine lu_fac20 subroutine lu_fac21( avec_len, lu ) @@ -3759,401 +3454,263 @@ subroutine lu_fac21( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,960) = 1._r8 / lu(k,960) - lu(k,961) = lu(k,961) * lu(k,960) - lu(k,962) = lu(k,962) * lu(k,960) - lu(k,963) = lu(k,963) * lu(k,960) - lu(k,964) = lu(k,964) * lu(k,960) - lu(k,970) = lu(k,970) - lu(k,961) * lu(k,967) - lu(k,975) = lu(k,975) - lu(k,962) * lu(k,967) - lu(k,976) = lu(k,976) - lu(k,963) * lu(k,967) - lu(k,979) = lu(k,979) - lu(k,964) * lu(k,967) - lu(k,1029) = lu(k,1029) - lu(k,961) * lu(k,1027) - lu(k,1035) = lu(k,1035) - lu(k,962) * lu(k,1027) - lu(k,1036) = lu(k,1036) - lu(k,963) * lu(k,1027) - lu(k,1040) = lu(k,1040) - lu(k,964) * lu(k,1027) - lu(k,1090) = lu(k,1090) - lu(k,961) * lu(k,1088) - lu(k,1096) = lu(k,1096) - lu(k,962) * lu(k,1088) - lu(k,1097) = lu(k,1097) - lu(k,963) * lu(k,1088) - lu(k,1101) = lu(k,1101) - lu(k,964) * lu(k,1088) - lu(k,1122) = lu(k,1122) - lu(k,961) * lu(k,1121) - lu(k,1131) = lu(k,1131) - lu(k,962) * lu(k,1121) - lu(k,1132) = lu(k,1132) - lu(k,963) * lu(k,1121) - lu(k,1137) = lu(k,1137) - lu(k,964) * lu(k,1121) - lu(k,1166) = - lu(k,961) * lu(k,1163) - lu(k,1179) = lu(k,1179) - lu(k,962) * lu(k,1163) - lu(k,1181) = lu(k,1181) - lu(k,963) * lu(k,1163) - lu(k,1186) = lu(k,1186) - lu(k,964) * lu(k,1163) - lu(k,1200) = lu(k,1200) - lu(k,961) * lu(k,1197) - lu(k,1213) = lu(k,1213) - lu(k,962) * lu(k,1197) - lu(k,1215) = lu(k,1215) - lu(k,963) * lu(k,1197) - lu(k,1220) = lu(k,1220) - lu(k,964) * lu(k,1197) - lu(k,1227) = lu(k,1227) - lu(k,961) * lu(k,1224) - lu(k,1236) = lu(k,1236) - lu(k,962) * lu(k,1224) - lu(k,1237) = lu(k,1237) - lu(k,963) * lu(k,1224) - lu(k,1242) = lu(k,1242) - lu(k,964) * lu(k,1224) - lu(k,1292) = lu(k,1292) - lu(k,961) * lu(k,1290) - lu(k,1306) = lu(k,1306) - lu(k,962) * lu(k,1290) - lu(k,1308) = lu(k,1308) - lu(k,963) * lu(k,1290) - lu(k,1313) = lu(k,1313) - lu(k,964) * lu(k,1290) - lu(k,1380) = lu(k,1380) - lu(k,961) * lu(k,1377) - lu(k,1400) = lu(k,1400) - lu(k,962) * lu(k,1377) - lu(k,1402) = lu(k,1402) - lu(k,963) * lu(k,1377) - lu(k,1407) = lu(k,1407) - lu(k,964) * lu(k,1377) - lu(k,1424) = lu(k,1424) - lu(k,961) * lu(k,1423) - lu(k,1431) = lu(k,1431) - lu(k,962) * lu(k,1423) - lu(k,1434) = lu(k,1434) - lu(k,963) * lu(k,1423) - lu(k,1438) = lu(k,1438) - lu(k,964) * lu(k,1423) - lu(k,1488) = lu(k,1488) - lu(k,961) * lu(k,1484) - lu(k,1510) = lu(k,1510) - lu(k,962) * lu(k,1484) - lu(k,1513) = lu(k,1513) - lu(k,963) * lu(k,1484) - lu(k,1519) = lu(k,1519) - lu(k,964) * lu(k,1484) - lu(k,1534) = lu(k,1534) - lu(k,961) * lu(k,1533) - lu(k,1545) = lu(k,1545) - lu(k,962) * lu(k,1533) - lu(k,1548) = lu(k,1548) - lu(k,963) * lu(k,1533) - lu(k,1554) = lu(k,1554) - lu(k,964) * lu(k,1533) - lu(k,1694) = lu(k,1694) - lu(k,961) * lu(k,1690) - lu(k,1719) = lu(k,1719) - lu(k,962) * lu(k,1690) - lu(k,1722) = lu(k,1722) - lu(k,963) * lu(k,1690) - lu(k,1728) = lu(k,1728) - lu(k,964) * lu(k,1690) - lu(k,1759) = lu(k,1759) - lu(k,961) * lu(k,1756) - lu(k,1781) = lu(k,1781) - lu(k,962) * lu(k,1756) - lu(k,1784) = lu(k,1784) - lu(k,963) * lu(k,1756) - lu(k,1790) = lu(k,1790) - lu(k,964) * lu(k,1756) - lu(k,1880) = lu(k,1880) - lu(k,961) * lu(k,1876) - lu(k,1903) = lu(k,1903) - lu(k,962) * lu(k,1876) - lu(k,1906) = lu(k,1906) - lu(k,963) * lu(k,1876) - lu(k,1912) = lu(k,1912) - lu(k,964) * lu(k,1876) - lu(k,2082) = lu(k,2082) - lu(k,961) * lu(k,2079) - lu(k,2106) = lu(k,2106) - lu(k,962) * lu(k,2079) - lu(k,2109) = lu(k,2109) - lu(k,963) * lu(k,2079) - lu(k,2115) = lu(k,2115) - lu(k,964) * lu(k,2079) - lu(k,968) = 1._r8 / lu(k,968) - lu(k,969) = lu(k,969) * lu(k,968) - lu(k,970) = lu(k,970) * lu(k,968) - lu(k,971) = lu(k,971) * lu(k,968) - lu(k,972) = lu(k,972) * lu(k,968) - lu(k,973) = lu(k,973) * lu(k,968) - lu(k,974) = lu(k,974) * lu(k,968) - lu(k,975) = lu(k,975) * lu(k,968) - lu(k,976) = lu(k,976) * lu(k,968) - lu(k,977) = lu(k,977) * lu(k,968) - lu(k,978) = lu(k,978) * lu(k,968) - lu(k,979) = lu(k,979) * lu(k,968) - lu(k,980) = lu(k,980) * lu(k,968) - lu(k,1165) = lu(k,1165) - lu(k,969) * lu(k,1164) - lu(k,1166) = lu(k,1166) - lu(k,970) * lu(k,1164) - lu(k,1167) = - lu(k,971) * lu(k,1164) - lu(k,1168) = - lu(k,972) * lu(k,1164) - lu(k,1176) = lu(k,1176) - lu(k,973) * lu(k,1164) - lu(k,1177) = lu(k,1177) - lu(k,974) * lu(k,1164) - lu(k,1179) = lu(k,1179) - lu(k,975) * lu(k,1164) - lu(k,1181) = lu(k,1181) - lu(k,976) * lu(k,1164) - lu(k,1184) = lu(k,1184) - lu(k,977) * lu(k,1164) - lu(k,1185) = lu(k,1185) - lu(k,978) * lu(k,1164) - lu(k,1186) = lu(k,1186) - lu(k,979) * lu(k,1164) - lu(k,1187) = - lu(k,980) * lu(k,1164) - lu(k,1199) = lu(k,1199) - lu(k,969) * lu(k,1198) - lu(k,1200) = lu(k,1200) - lu(k,970) * lu(k,1198) - lu(k,1201) = - lu(k,971) * lu(k,1198) - lu(k,1202) = - lu(k,972) * lu(k,1198) - lu(k,1210) = lu(k,1210) - lu(k,973) * lu(k,1198) - lu(k,1211) = lu(k,1211) - lu(k,974) * lu(k,1198) - lu(k,1213) = lu(k,1213) - lu(k,975) * lu(k,1198) - lu(k,1215) = lu(k,1215) - lu(k,976) * lu(k,1198) - lu(k,1218) = lu(k,1218) - lu(k,977) * lu(k,1198) - lu(k,1219) = lu(k,1219) - lu(k,978) * lu(k,1198) - lu(k,1220) = lu(k,1220) - lu(k,979) * lu(k,1198) - lu(k,1221) = - lu(k,980) * lu(k,1198) - lu(k,1226) = lu(k,1226) - lu(k,969) * lu(k,1225) - lu(k,1227) = lu(k,1227) - lu(k,970) * lu(k,1225) - lu(k,1228) = - lu(k,971) * lu(k,1225) - lu(k,1229) = - lu(k,972) * lu(k,1225) - lu(k,1233) = lu(k,1233) - lu(k,973) * lu(k,1225) - lu(k,1234) = lu(k,1234) - lu(k,974) * lu(k,1225) - lu(k,1236) = lu(k,1236) - lu(k,975) * lu(k,1225) - lu(k,1237) = lu(k,1237) - lu(k,976) * lu(k,1225) - lu(k,1240) = - lu(k,977) * lu(k,1225) - lu(k,1241) = lu(k,1241) - lu(k,978) * lu(k,1225) - lu(k,1242) = lu(k,1242) - lu(k,979) * lu(k,1225) - lu(k,1243) = - lu(k,980) * lu(k,1225) - lu(k,1487) = lu(k,1487) - lu(k,969) * lu(k,1485) - lu(k,1488) = lu(k,1488) - lu(k,970) * lu(k,1485) - lu(k,1492) = lu(k,1492) - lu(k,971) * lu(k,1485) - lu(k,1493) = lu(k,1493) - lu(k,972) * lu(k,1485) - lu(k,1503) = lu(k,1503) - lu(k,973) * lu(k,1485) - lu(k,1505) = lu(k,1505) - lu(k,974) * lu(k,1485) - lu(k,1510) = lu(k,1510) - lu(k,975) * lu(k,1485) - lu(k,1513) = lu(k,1513) - lu(k,976) * lu(k,1485) - lu(k,1516) = lu(k,1516) - lu(k,977) * lu(k,1485) - lu(k,1517) = lu(k,1517) - lu(k,978) * lu(k,1485) - lu(k,1519) = lu(k,1519) - lu(k,979) * lu(k,1485) - lu(k,1521) = lu(k,1521) - lu(k,980) * lu(k,1485) - lu(k,1693) = lu(k,1693) - lu(k,969) * lu(k,1691) - lu(k,1694) = lu(k,1694) - lu(k,970) * lu(k,1691) - lu(k,1698) = lu(k,1698) - lu(k,971) * lu(k,1691) - lu(k,1699) = lu(k,1699) - lu(k,972) * lu(k,1691) - lu(k,1710) = lu(k,1710) - lu(k,973) * lu(k,1691) - lu(k,1714) = lu(k,1714) - lu(k,974) * lu(k,1691) - lu(k,1719) = lu(k,1719) - lu(k,975) * lu(k,1691) - lu(k,1722) = lu(k,1722) - lu(k,976) * lu(k,1691) - lu(k,1725) = lu(k,1725) - lu(k,977) * lu(k,1691) - lu(k,1726) = lu(k,1726) - lu(k,978) * lu(k,1691) - lu(k,1728) = lu(k,1728) - lu(k,979) * lu(k,1691) - lu(k,1730) = lu(k,1730) - lu(k,980) * lu(k,1691) - lu(k,1879) = lu(k,1879) - lu(k,969) * lu(k,1877) - lu(k,1880) = lu(k,1880) - lu(k,970) * lu(k,1877) - lu(k,1884) = lu(k,1884) - lu(k,971) * lu(k,1877) - lu(k,1885) = lu(k,1885) - lu(k,972) * lu(k,1877) - lu(k,1895) = lu(k,1895) - lu(k,973) * lu(k,1877) - lu(k,1898) = lu(k,1898) - lu(k,974) * lu(k,1877) - lu(k,1903) = lu(k,1903) - lu(k,975) * lu(k,1877) - lu(k,1906) = lu(k,1906) - lu(k,976) * lu(k,1877) - lu(k,1909) = lu(k,1909) - lu(k,977) * lu(k,1877) - lu(k,1910) = lu(k,1910) - lu(k,978) * lu(k,1877) - lu(k,1912) = lu(k,1912) - lu(k,979) * lu(k,1877) - lu(k,1914) = lu(k,1914) - lu(k,980) * lu(k,1877) - lu(k,982) = 1._r8 / lu(k,982) - lu(k,983) = lu(k,983) * lu(k,982) - lu(k,984) = lu(k,984) * lu(k,982) - lu(k,985) = lu(k,985) * lu(k,982) - lu(k,986) = lu(k,986) * lu(k,982) - lu(k,987) = lu(k,987) * lu(k,982) - lu(k,988) = lu(k,988) * lu(k,982) - lu(k,989) = lu(k,989) * lu(k,982) - lu(k,990) = lu(k,990) * lu(k,982) - lu(k,1007) = lu(k,1007) - lu(k,983) * lu(k,1006) - lu(k,1011) = lu(k,1011) - lu(k,984) * lu(k,1006) - lu(k,1012) = lu(k,1012) - lu(k,985) * lu(k,1006) - lu(k,1013) = lu(k,1013) - lu(k,986) * lu(k,1006) - lu(k,1015) = lu(k,1015) - lu(k,987) * lu(k,1006) - lu(k,1016) = lu(k,1016) - lu(k,988) * lu(k,1006) - lu(k,1021) = lu(k,1021) - lu(k,989) * lu(k,1006) - lu(k,1022) = lu(k,1022) - lu(k,990) * lu(k,1006) - lu(k,1029) = lu(k,1029) - lu(k,983) * lu(k,1028) - lu(k,1031) = lu(k,1031) - lu(k,984) * lu(k,1028) - lu(k,1032) = lu(k,1032) - lu(k,985) * lu(k,1028) - lu(k,1033) = lu(k,1033) - lu(k,986) * lu(k,1028) - lu(k,1035) = lu(k,1035) - lu(k,987) * lu(k,1028) - lu(k,1036) = lu(k,1036) - lu(k,988) * lu(k,1028) - lu(k,1040) = lu(k,1040) - lu(k,989) * lu(k,1028) - lu(k,1041) = lu(k,1041) - lu(k,990) * lu(k,1028) - lu(k,1047) = lu(k,1047) - lu(k,983) * lu(k,1046) - lu(k,1050) = - lu(k,984) * lu(k,1046) - lu(k,1051) = - lu(k,985) * lu(k,1046) - lu(k,1052) = lu(k,1052) - lu(k,986) * lu(k,1046) - lu(k,1054) = lu(k,1054) - lu(k,987) * lu(k,1046) - lu(k,1055) = lu(k,1055) - lu(k,988) * lu(k,1046) - lu(k,1060) = lu(k,1060) - lu(k,989) * lu(k,1046) - lu(k,1061) = - lu(k,990) * lu(k,1046) - lu(k,1380) = lu(k,1380) - lu(k,983) * lu(k,1378) - lu(k,1384) = lu(k,1384) - lu(k,984) * lu(k,1378) - lu(k,1395) = lu(k,1395) - lu(k,985) * lu(k,1378) - lu(k,1396) = lu(k,1396) - lu(k,986) * lu(k,1378) - lu(k,1400) = lu(k,1400) - lu(k,987) * lu(k,1378) - lu(k,1402) = lu(k,1402) - lu(k,988) * lu(k,1378) - lu(k,1407) = lu(k,1407) - lu(k,989) * lu(k,1378) - lu(k,1409) = lu(k,1409) - lu(k,990) * lu(k,1378) - lu(k,1488) = lu(k,1488) - lu(k,983) * lu(k,1486) - lu(k,1492) = lu(k,1492) - lu(k,984) * lu(k,1486) - lu(k,1503) = lu(k,1503) - lu(k,985) * lu(k,1486) - lu(k,1505) = lu(k,1505) - lu(k,986) * lu(k,1486) - lu(k,1510) = lu(k,1510) - lu(k,987) * lu(k,1486) - lu(k,1513) = lu(k,1513) - lu(k,988) * lu(k,1486) - lu(k,1519) = lu(k,1519) - lu(k,989) * lu(k,1486) - lu(k,1521) = lu(k,1521) - lu(k,990) * lu(k,1486) - lu(k,1694) = lu(k,1694) - lu(k,983) * lu(k,1692) - lu(k,1698) = lu(k,1698) - lu(k,984) * lu(k,1692) - lu(k,1710) = lu(k,1710) - lu(k,985) * lu(k,1692) - lu(k,1714) = lu(k,1714) - lu(k,986) * lu(k,1692) - lu(k,1719) = lu(k,1719) - lu(k,987) * lu(k,1692) - lu(k,1722) = lu(k,1722) - lu(k,988) * lu(k,1692) - lu(k,1728) = lu(k,1728) - lu(k,989) * lu(k,1692) - lu(k,1730) = lu(k,1730) - lu(k,990) * lu(k,1692) - lu(k,1759) = lu(k,1759) - lu(k,983) * lu(k,1757) - lu(k,1763) = lu(k,1763) - lu(k,984) * lu(k,1757) - lu(k,1773) = lu(k,1773) - lu(k,985) * lu(k,1757) - lu(k,1776) = lu(k,1776) - lu(k,986) * lu(k,1757) - lu(k,1781) = lu(k,1781) - lu(k,987) * lu(k,1757) - lu(k,1784) = lu(k,1784) - lu(k,988) * lu(k,1757) - lu(k,1790) = lu(k,1790) - lu(k,989) * lu(k,1757) - lu(k,1792) = lu(k,1792) - lu(k,990) * lu(k,1757) - lu(k,1880) = lu(k,1880) - lu(k,983) * lu(k,1878) - lu(k,1884) = lu(k,1884) - lu(k,984) * lu(k,1878) - lu(k,1895) = lu(k,1895) - lu(k,985) * lu(k,1878) - lu(k,1898) = lu(k,1898) - lu(k,986) * lu(k,1878) - lu(k,1903) = lu(k,1903) - lu(k,987) * lu(k,1878) - lu(k,1906) = lu(k,1906) - lu(k,988) * lu(k,1878) - lu(k,1912) = lu(k,1912) - lu(k,989) * lu(k,1878) - lu(k,1914) = lu(k,1914) - lu(k,990) * lu(k,1878) - lu(k,2082) = lu(k,2082) - lu(k,983) * lu(k,2080) - lu(k,2086) = lu(k,2086) - lu(k,984) * lu(k,2080) - lu(k,2098) = lu(k,2098) - lu(k,985) * lu(k,2080) - lu(k,2101) = lu(k,2101) - lu(k,986) * lu(k,2080) - lu(k,2106) = lu(k,2106) - lu(k,987) * lu(k,2080) - lu(k,2109) = lu(k,2109) - lu(k,988) * lu(k,2080) - lu(k,2115) = lu(k,2115) - lu(k,989) * lu(k,2080) - lu(k,2117) = lu(k,2117) - lu(k,990) * lu(k,2080) - lu(k,991) = 1._r8 / lu(k,991) - lu(k,992) = lu(k,992) * lu(k,991) - lu(k,993) = lu(k,993) * lu(k,991) - lu(k,994) = lu(k,994) * lu(k,991) - lu(k,995) = lu(k,995) * lu(k,991) - lu(k,996) = lu(k,996) * lu(k,991) - lu(k,1066) = lu(k,1066) - lu(k,992) * lu(k,1064) - lu(k,1067) = lu(k,1067) - lu(k,993) * lu(k,1064) - lu(k,1070) = lu(k,1070) - lu(k,994) * lu(k,1064) - lu(k,1071) = lu(k,1071) - lu(k,995) * lu(k,1064) - lu(k,1073) = lu(k,1073) - lu(k,996) * lu(k,1064) - lu(k,1092) = lu(k,1092) - lu(k,992) * lu(k,1089) - lu(k,1093) = lu(k,1093) - lu(k,993) * lu(k,1089) - lu(k,1096) = lu(k,1096) - lu(k,994) * lu(k,1089) - lu(k,1097) = lu(k,1097) - lu(k,995) * lu(k,1089) - lu(k,1101) = lu(k,1101) - lu(k,996) * lu(k,1089) - lu(k,1171) = - lu(k,992) * lu(k,1165) - lu(k,1176) = lu(k,1176) - lu(k,993) * lu(k,1165) - lu(k,1179) = lu(k,1179) - lu(k,994) * lu(k,1165) - lu(k,1181) = lu(k,1181) - lu(k,995) * lu(k,1165) - lu(k,1186) = lu(k,1186) - lu(k,996) * lu(k,1165) - lu(k,1205) = lu(k,1205) - lu(k,992) * lu(k,1199) - lu(k,1210) = lu(k,1210) - lu(k,993) * lu(k,1199) - lu(k,1213) = lu(k,1213) - lu(k,994) * lu(k,1199) - lu(k,1215) = lu(k,1215) - lu(k,995) * lu(k,1199) - lu(k,1220) = lu(k,1220) - lu(k,996) * lu(k,1199) - lu(k,1230) = lu(k,1230) - lu(k,992) * lu(k,1226) - lu(k,1233) = lu(k,1233) - lu(k,993) * lu(k,1226) - lu(k,1236) = lu(k,1236) - lu(k,994) * lu(k,1226) - lu(k,1237) = lu(k,1237) - lu(k,995) * lu(k,1226) - lu(k,1242) = lu(k,1242) - lu(k,996) * lu(k,1226) - lu(k,1249) = lu(k,1249) - lu(k,992) * lu(k,1246) - lu(k,1253) = lu(k,1253) - lu(k,993) * lu(k,1246) - lu(k,1257) = lu(k,1257) - lu(k,994) * lu(k,1246) - lu(k,1259) = lu(k,1259) - lu(k,995) * lu(k,1246) - lu(k,1264) = lu(k,1264) - lu(k,996) * lu(k,1246) - lu(k,1270) = - lu(k,992) * lu(k,1269) - lu(k,1272) = lu(k,1272) - lu(k,993) * lu(k,1269) - lu(k,1275) = lu(k,1275) - lu(k,994) * lu(k,1269) - lu(k,1277) = lu(k,1277) - lu(k,995) * lu(k,1269) - lu(k,1282) = lu(k,1282) - lu(k,996) * lu(k,1269) - lu(k,1296) = lu(k,1296) - lu(k,992) * lu(k,1291) - lu(k,1302) = lu(k,1302) - lu(k,993) * lu(k,1291) - lu(k,1306) = lu(k,1306) - lu(k,994) * lu(k,1291) - lu(k,1308) = lu(k,1308) - lu(k,995) * lu(k,1291) - lu(k,1313) = lu(k,1313) - lu(k,996) * lu(k,1291) - lu(k,1389) = lu(k,1389) - lu(k,992) * lu(k,1379) - lu(k,1395) = lu(k,1395) - lu(k,993) * lu(k,1379) - lu(k,1400) = lu(k,1400) - lu(k,994) * lu(k,1379) - lu(k,1402) = lu(k,1402) - lu(k,995) * lu(k,1379) - lu(k,1407) = lu(k,1407) - lu(k,996) * lu(k,1379) - lu(k,1497) = lu(k,1497) - lu(k,992) * lu(k,1487) - lu(k,1503) = lu(k,1503) - lu(k,993) * lu(k,1487) - lu(k,1510) = lu(k,1510) - lu(k,994) * lu(k,1487) - lu(k,1513) = lu(k,1513) - lu(k,995) * lu(k,1487) - lu(k,1519) = lu(k,1519) - lu(k,996) * lu(k,1487) - lu(k,1704) = lu(k,1704) - lu(k,992) * lu(k,1693) - lu(k,1710) = lu(k,1710) - lu(k,993) * lu(k,1693) - lu(k,1719) = lu(k,1719) - lu(k,994) * lu(k,1693) - lu(k,1722) = lu(k,1722) - lu(k,995) * lu(k,1693) - lu(k,1728) = lu(k,1728) - lu(k,996) * lu(k,1693) - lu(k,1767) = lu(k,1767) - lu(k,992) * lu(k,1758) - lu(k,1773) = lu(k,1773) - lu(k,993) * lu(k,1758) - lu(k,1781) = lu(k,1781) - lu(k,994) * lu(k,1758) - lu(k,1784) = lu(k,1784) - lu(k,995) * lu(k,1758) - lu(k,1790) = lu(k,1790) - lu(k,996) * lu(k,1758) - lu(k,1889) = lu(k,1889) - lu(k,992) * lu(k,1879) - lu(k,1895) = lu(k,1895) - lu(k,993) * lu(k,1879) - lu(k,1903) = lu(k,1903) - lu(k,994) * lu(k,1879) - lu(k,1906) = lu(k,1906) - lu(k,995) * lu(k,1879) - lu(k,1912) = lu(k,1912) - lu(k,996) * lu(k,1879) - lu(k,1976) = lu(k,1976) - lu(k,992) * lu(k,1974) - lu(k,1978) = lu(k,1978) - lu(k,993) * lu(k,1974) - lu(k,1987) = lu(k,1987) - lu(k,994) * lu(k,1974) - lu(k,1990) = lu(k,1990) - lu(k,995) * lu(k,1974) - lu(k,1996) = lu(k,1996) - lu(k,996) * lu(k,1974) - lu(k,2092) = lu(k,2092) - lu(k,992) * lu(k,2081) - lu(k,2098) = lu(k,2098) - lu(k,993) * lu(k,2081) - lu(k,2106) = lu(k,2106) - lu(k,994) * lu(k,2081) - lu(k,2109) = lu(k,2109) - lu(k,995) * lu(k,2081) - lu(k,2115) = lu(k,2115) - lu(k,996) * lu(k,2081) - lu(k,997) = 1._r8 / lu(k,997) - lu(k,998) = lu(k,998) * lu(k,997) - lu(k,999) = lu(k,999) * lu(k,997) - lu(k,1000) = lu(k,1000) * lu(k,997) - lu(k,1015) = lu(k,1015) - lu(k,998) * lu(k,1007) - lu(k,1018) = - lu(k,999) * lu(k,1007) - lu(k,1021) = lu(k,1021) - lu(k,1000) * lu(k,1007) - lu(k,1035) = lu(k,1035) - lu(k,998) * lu(k,1029) - lu(k,1037) = - lu(k,999) * lu(k,1029) - lu(k,1040) = lu(k,1040) - lu(k,1000) * lu(k,1029) - lu(k,1054) = lu(k,1054) - lu(k,998) * lu(k,1047) - lu(k,1057) = - lu(k,999) * lu(k,1047) - lu(k,1060) = lu(k,1060) - lu(k,1000) * lu(k,1047) - lu(k,1079) = lu(k,1079) - lu(k,998) * lu(k,1075) - lu(k,1081) = - lu(k,999) * lu(k,1075) - lu(k,1083) = lu(k,1083) - lu(k,1000) * lu(k,1075) - lu(k,1096) = lu(k,1096) - lu(k,998) * lu(k,1090) - lu(k,1099) = - lu(k,999) * lu(k,1090) - lu(k,1101) = lu(k,1101) - lu(k,1000) * lu(k,1090) - lu(k,1131) = lu(k,1131) - lu(k,998) * lu(k,1122) - lu(k,1134) = - lu(k,999) * lu(k,1122) - lu(k,1137) = lu(k,1137) - lu(k,1000) * lu(k,1122) - lu(k,1145) = lu(k,1145) - lu(k,998) * lu(k,1139) - lu(k,1148) = - lu(k,999) * lu(k,1139) - lu(k,1149) = lu(k,1149) - lu(k,1000) * lu(k,1139) - lu(k,1154) = lu(k,1154) - lu(k,998) * lu(k,1151) - lu(k,1156) = - lu(k,999) * lu(k,1151) - lu(k,1158) = lu(k,1158) - lu(k,1000) * lu(k,1151) - lu(k,1179) = lu(k,1179) - lu(k,998) * lu(k,1166) - lu(k,1183) = - lu(k,999) * lu(k,1166) - lu(k,1186) = lu(k,1186) - lu(k,1000) * lu(k,1166) - lu(k,1213) = lu(k,1213) - lu(k,998) * lu(k,1200) - lu(k,1217) = - lu(k,999) * lu(k,1200) - lu(k,1220) = lu(k,1220) - lu(k,1000) * lu(k,1200) - lu(k,1236) = lu(k,1236) - lu(k,998) * lu(k,1227) - lu(k,1239) = - lu(k,999) * lu(k,1227) - lu(k,1242) = lu(k,1242) - lu(k,1000) * lu(k,1227) - lu(k,1257) = lu(k,1257) - lu(k,998) * lu(k,1247) - lu(k,1261) = - lu(k,999) * lu(k,1247) - lu(k,1264) = lu(k,1264) - lu(k,1000) * lu(k,1247) - lu(k,1306) = lu(k,1306) - lu(k,998) * lu(k,1292) - lu(k,1310) = - lu(k,999) * lu(k,1292) - lu(k,1313) = lu(k,1313) - lu(k,1000) * lu(k,1292) - lu(k,1355) = lu(k,1355) - lu(k,998) * lu(k,1351) - lu(k,1359) = lu(k,1359) - lu(k,999) * lu(k,1351) - lu(k,1361) = lu(k,1361) - lu(k,1000) * lu(k,1351) - lu(k,1400) = lu(k,1400) - lu(k,998) * lu(k,1380) - lu(k,1404) = lu(k,1404) - lu(k,999) * lu(k,1380) - lu(k,1407) = lu(k,1407) - lu(k,1000) * lu(k,1380) - lu(k,1431) = lu(k,1431) - lu(k,998) * lu(k,1424) - lu(k,1435) = lu(k,1435) - lu(k,999) * lu(k,1424) - lu(k,1438) = lu(k,1438) - lu(k,1000) * lu(k,1424) - lu(k,1510) = lu(k,1510) - lu(k,998) * lu(k,1488) - lu(k,1515) = lu(k,1515) - lu(k,999) * lu(k,1488) - lu(k,1519) = lu(k,1519) - lu(k,1000) * lu(k,1488) - lu(k,1545) = lu(k,1545) - lu(k,998) * lu(k,1534) - lu(k,1550) = lu(k,1550) - lu(k,999) * lu(k,1534) - lu(k,1554) = lu(k,1554) - lu(k,1000) * lu(k,1534) - lu(k,1719) = lu(k,1719) - lu(k,998) * lu(k,1694) - lu(k,1724) = lu(k,1724) - lu(k,999) * lu(k,1694) - lu(k,1728) = lu(k,1728) - lu(k,1000) * lu(k,1694) - lu(k,1781) = lu(k,1781) - lu(k,998) * lu(k,1759) - lu(k,1786) = lu(k,1786) - lu(k,999) * lu(k,1759) - lu(k,1790) = lu(k,1790) - lu(k,1000) * lu(k,1759) - lu(k,1822) = lu(k,1822) - lu(k,998) * lu(k,1812) - lu(k,1827) = lu(k,1827) - lu(k,999) * lu(k,1812) - lu(k,1831) = lu(k,1831) - lu(k,1000) * lu(k,1812) - lu(k,1846) = lu(k,1846) - lu(k,998) * lu(k,1837) - lu(k,1851) = lu(k,1851) - lu(k,999) * lu(k,1837) - lu(k,1855) = lu(k,1855) - lu(k,1000) * lu(k,1837) - lu(k,1903) = lu(k,1903) - lu(k,998) * lu(k,1880) - lu(k,1908) = - lu(k,999) * lu(k,1880) - lu(k,1912) = lu(k,1912) - lu(k,1000) * lu(k,1880) - lu(k,1987) = lu(k,1987) - lu(k,998) * lu(k,1975) - lu(k,1992) = lu(k,1992) - lu(k,999) * lu(k,1975) - lu(k,1996) = lu(k,1996) - lu(k,1000) * lu(k,1975) - lu(k,2106) = lu(k,2106) - lu(k,998) * lu(k,2082) - lu(k,2111) = lu(k,2111) - lu(k,999) * lu(k,2082) - lu(k,2115) = lu(k,2115) - lu(k,1000) * lu(k,2082) + lu(k,945) = 1._r8 / lu(k,945) + lu(k,946) = lu(k,946) * lu(k,945) + lu(k,947) = lu(k,947) * lu(k,945) + lu(k,948) = lu(k,948) * lu(k,945) + lu(k,949) = lu(k,949) * lu(k,945) + lu(k,950) = lu(k,950) * lu(k,945) + lu(k,1474) = lu(k,1474) - lu(k,946) * lu(k,1473) + lu(k,1479) = lu(k,1479) - lu(k,947) * lu(k,1473) + lu(k,1484) = - lu(k,948) * lu(k,1473) + lu(k,1485) = lu(k,1485) - lu(k,949) * lu(k,1473) + lu(k,1487) = - lu(k,950) * lu(k,1473) + lu(k,1538) = lu(k,1538) - lu(k,946) * lu(k,1533) + lu(k,1544) = lu(k,1544) - lu(k,947) * lu(k,1533) + lu(k,1549) = lu(k,1549) - lu(k,948) * lu(k,1533) + lu(k,1550) = lu(k,1550) - lu(k,949) * lu(k,1533) + lu(k,1553) = - lu(k,950) * lu(k,1533) + lu(k,1559) = lu(k,1559) - lu(k,946) * lu(k,1558) + lu(k,1566) = lu(k,1566) - lu(k,947) * lu(k,1558) + lu(k,1573) = lu(k,1573) - lu(k,948) * lu(k,1558) + lu(k,1574) = lu(k,1574) - lu(k,949) * lu(k,1558) + lu(k,1577) = lu(k,1577) - lu(k,950) * lu(k,1558) + lu(k,1585) = lu(k,1585) - lu(k,946) * lu(k,1583) + lu(k,1592) = lu(k,1592) - lu(k,947) * lu(k,1583) + lu(k,1599) = lu(k,1599) - lu(k,948) * lu(k,1583) + lu(k,1601) = lu(k,1601) - lu(k,949) * lu(k,1583) + lu(k,1604) = lu(k,1604) - lu(k,950) * lu(k,1583) + lu(k,1792) = lu(k,1792) - lu(k,946) * lu(k,1759) + lu(k,1799) = lu(k,1799) - lu(k,947) * lu(k,1759) + lu(k,1806) = lu(k,1806) - lu(k,948) * lu(k,1759) + lu(k,1809) = lu(k,1809) - lu(k,949) * lu(k,1759) + lu(k,1812) = lu(k,1812) - lu(k,950) * lu(k,1759) + lu(k,1837) = lu(k,1837) - lu(k,946) * lu(k,1827) + lu(k,1844) = lu(k,1844) - lu(k,947) * lu(k,1827) + lu(k,1851) = lu(k,1851) - lu(k,948) * lu(k,1827) + lu(k,1854) = lu(k,1854) - lu(k,949) * lu(k,1827) + lu(k,1857) = lu(k,1857) - lu(k,950) * lu(k,1827) + lu(k,1898) = - lu(k,946) * lu(k,1868) + lu(k,1904) = lu(k,1904) - lu(k,947) * lu(k,1868) + lu(k,1911) = lu(k,1911) - lu(k,948) * lu(k,1868) + lu(k,1914) = lu(k,1914) - lu(k,949) * lu(k,1868) + lu(k,1917) = lu(k,1917) - lu(k,950) * lu(k,1868) + lu(k,2310) = lu(k,2310) - lu(k,946) * lu(k,2304) + lu(k,2317) = lu(k,2317) - lu(k,947) * lu(k,2304) + lu(k,2324) = lu(k,2324) - lu(k,948) * lu(k,2304) + lu(k,2327) = lu(k,2327) - lu(k,949) * lu(k,2304) + lu(k,2330) = lu(k,2330) - lu(k,950) * lu(k,2304) + lu(k,2401) = lu(k,2401) - lu(k,946) * lu(k,2374) + lu(k,2407) = lu(k,2407) - lu(k,947) * lu(k,2374) + lu(k,2414) = lu(k,2414) - lu(k,948) * lu(k,2374) + lu(k,2417) = lu(k,2417) - lu(k,949) * lu(k,2374) + lu(k,2420) = lu(k,2420) - lu(k,950) * lu(k,2374) + lu(k,2427) = - lu(k,946) * lu(k,2425) + lu(k,2434) = lu(k,2434) - lu(k,947) * lu(k,2425) + lu(k,2441) = - lu(k,948) * lu(k,2425) + lu(k,2444) = lu(k,2444) - lu(k,949) * lu(k,2425) + lu(k,2447) = lu(k,2447) - lu(k,950) * lu(k,2425) + lu(k,953) = 1._r8 / lu(k,953) + lu(k,954) = lu(k,954) * lu(k,953) + lu(k,955) = lu(k,955) * lu(k,953) + lu(k,956) = lu(k,956) * lu(k,953) + lu(k,957) = lu(k,957) * lu(k,953) + lu(k,958) = lu(k,958) * lu(k,953) + lu(k,959) = lu(k,959) * lu(k,953) + lu(k,960) = lu(k,960) * lu(k,953) + lu(k,961) = lu(k,961) * lu(k,953) + lu(k,962) = lu(k,962) * lu(k,953) + lu(k,1493) = lu(k,1493) - lu(k,954) * lu(k,1492) + lu(k,1496) = lu(k,1496) - lu(k,955) * lu(k,1492) + lu(k,1498) = lu(k,1498) - lu(k,956) * lu(k,1492) + lu(k,1499) = - lu(k,957) * lu(k,1492) + lu(k,1500) = - lu(k,958) * lu(k,1492) + lu(k,1501) = lu(k,1501) - lu(k,959) * lu(k,1492) + lu(k,1502) = lu(k,1502) - lu(k,960) * lu(k,1492) + lu(k,1504) = lu(k,1504) - lu(k,961) * lu(k,1492) + lu(k,1505) = lu(k,1505) - lu(k,962) * lu(k,1492) + lu(k,1586) = lu(k,1586) - lu(k,954) * lu(k,1584) + lu(k,1590) = lu(k,1590) - lu(k,955) * lu(k,1584) + lu(k,1592) = lu(k,1592) - lu(k,956) * lu(k,1584) + lu(k,1593) = lu(k,1593) - lu(k,957) * lu(k,1584) + lu(k,1594) = - lu(k,958) * lu(k,1584) + lu(k,1595) = lu(k,1595) - lu(k,959) * lu(k,1584) + lu(k,1596) = - lu(k,960) * lu(k,1584) + lu(k,1601) = lu(k,1601) - lu(k,961) * lu(k,1584) + lu(k,1604) = lu(k,1604) - lu(k,962) * lu(k,1584) + lu(k,1793) = lu(k,1793) - lu(k,954) * lu(k,1760) + lu(k,1797) = lu(k,1797) - lu(k,955) * lu(k,1760) + lu(k,1799) = lu(k,1799) - lu(k,956) * lu(k,1760) + lu(k,1800) = lu(k,1800) - lu(k,957) * lu(k,1760) + lu(k,1801) = lu(k,1801) - lu(k,958) * lu(k,1760) + lu(k,1802) = lu(k,1802) - lu(k,959) * lu(k,1760) + lu(k,1803) = lu(k,1803) - lu(k,960) * lu(k,1760) + lu(k,1809) = lu(k,1809) - lu(k,961) * lu(k,1760) + lu(k,1812) = lu(k,1812) - lu(k,962) * lu(k,1760) + lu(k,1838) = lu(k,1838) - lu(k,954) * lu(k,1828) + lu(k,1842) = lu(k,1842) - lu(k,955) * lu(k,1828) + lu(k,1844) = lu(k,1844) - lu(k,956) * lu(k,1828) + lu(k,1845) = lu(k,1845) - lu(k,957) * lu(k,1828) + lu(k,1846) = lu(k,1846) - lu(k,958) * lu(k,1828) + lu(k,1847) = lu(k,1847) - lu(k,959) * lu(k,1828) + lu(k,1848) = lu(k,1848) - lu(k,960) * lu(k,1828) + lu(k,1854) = lu(k,1854) - lu(k,961) * lu(k,1828) + lu(k,1857) = lu(k,1857) - lu(k,962) * lu(k,1828) + lu(k,1944) = lu(k,1944) - lu(k,954) * lu(k,1933) + lu(k,1948) = lu(k,1948) - lu(k,955) * lu(k,1933) + lu(k,1950) = lu(k,1950) - lu(k,956) * lu(k,1933) + lu(k,1951) = lu(k,1951) - lu(k,957) * lu(k,1933) + lu(k,1952) = lu(k,1952) - lu(k,958) * lu(k,1933) + lu(k,1953) = lu(k,1953) - lu(k,959) * lu(k,1933) + lu(k,1954) = - lu(k,960) * lu(k,1933) + lu(k,1960) = lu(k,1960) - lu(k,961) * lu(k,1933) + lu(k,1963) = lu(k,1963) - lu(k,962) * lu(k,1933) + lu(k,2311) = lu(k,2311) - lu(k,954) * lu(k,2305) + lu(k,2315) = lu(k,2315) - lu(k,955) * lu(k,2305) + lu(k,2317) = lu(k,2317) - lu(k,956) * lu(k,2305) + lu(k,2318) = lu(k,2318) - lu(k,957) * lu(k,2305) + lu(k,2319) = lu(k,2319) - lu(k,958) * lu(k,2305) + lu(k,2320) = lu(k,2320) - lu(k,959) * lu(k,2305) + lu(k,2321) = lu(k,2321) - lu(k,960) * lu(k,2305) + lu(k,2327) = lu(k,2327) - lu(k,961) * lu(k,2305) + lu(k,2330) = lu(k,2330) - lu(k,962) * lu(k,2305) + lu(k,969) = 1._r8 / lu(k,969) + lu(k,970) = lu(k,970) * lu(k,969) + lu(k,971) = lu(k,971) * lu(k,969) + lu(k,972) = lu(k,972) * lu(k,969) + lu(k,973) = lu(k,973) * lu(k,969) + lu(k,974) = lu(k,974) * lu(k,969) + lu(k,975) = lu(k,975) * lu(k,969) + lu(k,976) = lu(k,976) * lu(k,969) + lu(k,977) = lu(k,977) * lu(k,969) + lu(k,978) = lu(k,978) * lu(k,969) + lu(k,1447) = lu(k,1447) - lu(k,970) * lu(k,1446) + lu(k,1448) = lu(k,1448) - lu(k,971) * lu(k,1446) + lu(k,1449) = lu(k,1449) - lu(k,972) * lu(k,1446) + lu(k,1450) = lu(k,1450) - lu(k,973) * lu(k,1446) + lu(k,1451) = - lu(k,974) * lu(k,1446) + lu(k,1452) = - lu(k,975) * lu(k,1446) + lu(k,1453) = lu(k,1453) - lu(k,976) * lu(k,1446) + lu(k,1454) = - lu(k,977) * lu(k,1446) + lu(k,1456) = lu(k,1456) - lu(k,978) * lu(k,1446) + lu(k,1535) = lu(k,1535) - lu(k,970) * lu(k,1534) + lu(k,1537) = lu(k,1537) - lu(k,971) * lu(k,1534) + lu(k,1540) = lu(k,1540) - lu(k,972) * lu(k,1534) + lu(k,1543) = lu(k,1543) - lu(k,973) * lu(k,1534) + lu(k,1544) = lu(k,1544) - lu(k,974) * lu(k,1534) + lu(k,1545) = - lu(k,975) * lu(k,1534) + lu(k,1547) = lu(k,1547) - lu(k,976) * lu(k,1534) + lu(k,1548) = lu(k,1548) - lu(k,977) * lu(k,1534) + lu(k,1550) = lu(k,1550) - lu(k,978) * lu(k,1534) + lu(k,1774) = lu(k,1774) - lu(k,970) * lu(k,1761) + lu(k,1790) = lu(k,1790) - lu(k,971) * lu(k,1761) + lu(k,1795) = lu(k,1795) - lu(k,972) * lu(k,1761) + lu(k,1798) = lu(k,1798) - lu(k,973) * lu(k,1761) + lu(k,1799) = lu(k,1799) - lu(k,974) * lu(k,1761) + lu(k,1800) = lu(k,1800) - lu(k,975) * lu(k,1761) + lu(k,1804) = lu(k,1804) - lu(k,976) * lu(k,1761) + lu(k,1805) = lu(k,1805) - lu(k,977) * lu(k,1761) + lu(k,1809) = lu(k,1809) - lu(k,978) * lu(k,1761) + lu(k,1831) = lu(k,1831) - lu(k,970) * lu(k,1829) + lu(k,1836) = lu(k,1836) - lu(k,971) * lu(k,1829) + lu(k,1840) = lu(k,1840) - lu(k,972) * lu(k,1829) + lu(k,1843) = lu(k,1843) - lu(k,973) * lu(k,1829) + lu(k,1844) = lu(k,1844) - lu(k,974) * lu(k,1829) + lu(k,1845) = lu(k,1845) - lu(k,975) * lu(k,1829) + lu(k,1849) = lu(k,1849) - lu(k,976) * lu(k,1829) + lu(k,1850) = - lu(k,977) * lu(k,1829) + lu(k,1854) = lu(k,1854) - lu(k,978) * lu(k,1829) + lu(k,2046) = lu(k,2046) - lu(k,970) * lu(k,2036) + lu(k,2062) = lu(k,2062) - lu(k,971) * lu(k,2036) + lu(k,2064) = lu(k,2064) - lu(k,972) * lu(k,2036) + lu(k,2067) = lu(k,2067) - lu(k,973) * lu(k,2036) + lu(k,2068) = lu(k,2068) - lu(k,974) * lu(k,2036) + lu(k,2069) = lu(k,2069) - lu(k,975) * lu(k,2036) + lu(k,2073) = lu(k,2073) - lu(k,976) * lu(k,2036) + lu(k,2074) = - lu(k,977) * lu(k,2036) + lu(k,2078) = lu(k,2078) - lu(k,978) * lu(k,2036) + lu(k,2307) = lu(k,2307) - lu(k,970) * lu(k,2306) + lu(k,2308) = lu(k,2308) - lu(k,971) * lu(k,2306) + lu(k,2313) = lu(k,2313) - lu(k,972) * lu(k,2306) + lu(k,2316) = lu(k,2316) - lu(k,973) * lu(k,2306) + lu(k,2317) = lu(k,2317) - lu(k,974) * lu(k,2306) + lu(k,2318) = lu(k,2318) - lu(k,975) * lu(k,2306) + lu(k,2322) = lu(k,2322) - lu(k,976) * lu(k,2306) + lu(k,2323) = lu(k,2323) - lu(k,977) * lu(k,2306) + lu(k,2327) = lu(k,2327) - lu(k,978) * lu(k,2306) + lu(k,988) = 1._r8 / lu(k,988) + lu(k,989) = lu(k,989) * lu(k,988) + lu(k,990) = lu(k,990) * lu(k,988) + lu(k,991) = lu(k,991) * lu(k,988) + lu(k,992) = lu(k,992) * lu(k,988) + lu(k,993) = lu(k,993) * lu(k,988) + lu(k,994) = lu(k,994) * lu(k,988) + lu(k,995) = lu(k,995) * lu(k,988) + lu(k,996) = lu(k,996) * lu(k,988) + lu(k,997) = lu(k,997) * lu(k,988) + lu(k,998) = lu(k,998) * lu(k,988) + lu(k,999) = lu(k,999) * lu(k,988) + lu(k,1000) = lu(k,1000) * lu(k,988) + lu(k,1001) = lu(k,1001) * lu(k,988) + lu(k,1002) = lu(k,1002) * lu(k,988) + lu(k,1003) = lu(k,1003) * lu(k,988) + lu(k,1004) = lu(k,1004) * lu(k,988) + lu(k,1005) = lu(k,1005) * lu(k,988) + lu(k,1006) = lu(k,1006) * lu(k,988) + lu(k,1764) = lu(k,1764) - lu(k,989) * lu(k,1762) + lu(k,1765) = lu(k,1765) - lu(k,990) * lu(k,1762) + lu(k,1766) = lu(k,1766) - lu(k,991) * lu(k,1762) + lu(k,1767) = lu(k,1767) - lu(k,992) * lu(k,1762) + lu(k,1768) = lu(k,1768) - lu(k,993) * lu(k,1762) + lu(k,1769) = lu(k,1769) - lu(k,994) * lu(k,1762) + lu(k,1770) = lu(k,1770) - lu(k,995) * lu(k,1762) + lu(k,1774) = lu(k,1774) - lu(k,996) * lu(k,1762) + lu(k,1779) = lu(k,1779) - lu(k,997) * lu(k,1762) + lu(k,1783) = lu(k,1783) - lu(k,998) * lu(k,1762) + lu(k,1789) = lu(k,1789) - lu(k,999) * lu(k,1762) + lu(k,1790) = lu(k,1790) - lu(k,1000) * lu(k,1762) + lu(k,1799) = lu(k,1799) - lu(k,1001) * lu(k,1762) + lu(k,1801) = lu(k,1801) - lu(k,1002) * lu(k,1762) + lu(k,1806) = lu(k,1806) - lu(k,1003) * lu(k,1762) + lu(k,1810) = lu(k,1810) - lu(k,1004) * lu(k,1762) + lu(k,1811) = lu(k,1811) - lu(k,1005) * lu(k,1762) + lu(k,1812) = lu(k,1812) - lu(k,1006) * lu(k,1762) + lu(k,1871) = - lu(k,989) * lu(k,1869) + lu(k,1872) = lu(k,1872) - lu(k,990) * lu(k,1869) + lu(k,1873) = - lu(k,991) * lu(k,1869) + lu(k,1874) = lu(k,1874) - lu(k,992) * lu(k,1869) + lu(k,1875) = lu(k,1875) - lu(k,993) * lu(k,1869) + lu(k,1876) = lu(k,1876) - lu(k,994) * lu(k,1869) + lu(k,1877) = - lu(k,995) * lu(k,1869) + lu(k,1881) = lu(k,1881) - lu(k,996) * lu(k,1869) + lu(k,1886) = - lu(k,997) * lu(k,1869) + lu(k,1890) = lu(k,1890) - lu(k,998) * lu(k,1869) + lu(k,1896) = lu(k,1896) - lu(k,999) * lu(k,1869) + lu(k,1897) = lu(k,1897) - lu(k,1000) * lu(k,1869) + lu(k,1904) = lu(k,1904) - lu(k,1001) * lu(k,1869) + lu(k,1906) = lu(k,1906) - lu(k,1002) * lu(k,1869) + lu(k,1911) = lu(k,1911) - lu(k,1003) * lu(k,1869) + lu(k,1915) = lu(k,1915) - lu(k,1004) * lu(k,1869) + lu(k,1916) = lu(k,1916) - lu(k,1005) * lu(k,1869) + lu(k,1917) = lu(k,1917) - lu(k,1006) * lu(k,1869) + lu(k,2377) = lu(k,2377) - lu(k,989) * lu(k,2375) + lu(k,2378) = lu(k,2378) - lu(k,990) * lu(k,2375) + lu(k,2379) = - lu(k,991) * lu(k,2375) + lu(k,2380) = lu(k,2380) - lu(k,992) * lu(k,2375) + lu(k,2381) = lu(k,2381) - lu(k,993) * lu(k,2375) + lu(k,2382) = - lu(k,994) * lu(k,2375) + lu(k,2383) = lu(k,2383) - lu(k,995) * lu(k,2375) + lu(k,2386) = lu(k,2386) - lu(k,996) * lu(k,2375) + lu(k,2390) = lu(k,2390) - lu(k,997) * lu(k,2375) + lu(k,2393) = lu(k,2393) - lu(k,998) * lu(k,2375) + lu(k,2399) = lu(k,2399) - lu(k,999) * lu(k,2375) + lu(k,2400) = lu(k,2400) - lu(k,1000) * lu(k,2375) + lu(k,2407) = lu(k,2407) - lu(k,1001) * lu(k,2375) + lu(k,2409) = lu(k,2409) - lu(k,1002) * lu(k,2375) + lu(k,2414) = lu(k,2414) - lu(k,1003) * lu(k,2375) + lu(k,2418) = lu(k,2418) - lu(k,1004) * lu(k,2375) + lu(k,2419) = lu(k,2419) - lu(k,1005) * lu(k,2375) + lu(k,2420) = lu(k,2420) - lu(k,1006) * lu(k,2375) end do end subroutine lu_fac21 subroutine lu_fac22( avec_len, lu ) @@ -4170,370 +3727,318 @@ subroutine lu_fac22( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1008) = 1._r8 / lu(k,1008) - lu(k,1009) = lu(k,1009) * lu(k,1008) - lu(k,1010) = lu(k,1010) * lu(k,1008) - lu(k,1011) = lu(k,1011) * lu(k,1008) - lu(k,1012) = lu(k,1012) * lu(k,1008) - lu(k,1013) = lu(k,1013) * lu(k,1008) - lu(k,1014) = lu(k,1014) * lu(k,1008) - lu(k,1015) = lu(k,1015) * lu(k,1008) - lu(k,1016) = lu(k,1016) * lu(k,1008) - lu(k,1017) = lu(k,1017) * lu(k,1008) - lu(k,1018) = lu(k,1018) * lu(k,1008) - lu(k,1019) = lu(k,1019) * lu(k,1008) - lu(k,1020) = lu(k,1020) * lu(k,1008) - lu(k,1021) = lu(k,1021) * lu(k,1008) - lu(k,1022) = lu(k,1022) * lu(k,1008) - lu(k,1382) = lu(k,1382) - lu(k,1009) * lu(k,1381) - lu(k,1383) = lu(k,1383) - lu(k,1010) * lu(k,1381) - lu(k,1384) = lu(k,1384) - lu(k,1011) * lu(k,1381) - lu(k,1395) = lu(k,1395) - lu(k,1012) * lu(k,1381) - lu(k,1396) = lu(k,1396) - lu(k,1013) * lu(k,1381) - lu(k,1398) = lu(k,1398) - lu(k,1014) * lu(k,1381) - lu(k,1400) = lu(k,1400) - lu(k,1015) * lu(k,1381) - lu(k,1402) = lu(k,1402) - lu(k,1016) * lu(k,1381) - lu(k,1403) = lu(k,1403) - lu(k,1017) * lu(k,1381) - lu(k,1404) = lu(k,1404) - lu(k,1018) * lu(k,1381) - lu(k,1405) = lu(k,1405) - lu(k,1019) * lu(k,1381) - lu(k,1406) = lu(k,1406) - lu(k,1020) * lu(k,1381) - lu(k,1407) = lu(k,1407) - lu(k,1021) * lu(k,1381) - lu(k,1409) = lu(k,1409) - lu(k,1022) * lu(k,1381) - lu(k,1490) = lu(k,1490) - lu(k,1009) * lu(k,1489) - lu(k,1491) = lu(k,1491) - lu(k,1010) * lu(k,1489) - lu(k,1492) = lu(k,1492) - lu(k,1011) * lu(k,1489) - lu(k,1503) = lu(k,1503) - lu(k,1012) * lu(k,1489) - lu(k,1505) = lu(k,1505) - lu(k,1013) * lu(k,1489) - lu(k,1507) = lu(k,1507) - lu(k,1014) * lu(k,1489) - lu(k,1510) = lu(k,1510) - lu(k,1015) * lu(k,1489) - lu(k,1513) = lu(k,1513) - lu(k,1016) * lu(k,1489) - lu(k,1514) = lu(k,1514) - lu(k,1017) * lu(k,1489) - lu(k,1515) = lu(k,1515) - lu(k,1018) * lu(k,1489) - lu(k,1516) = lu(k,1516) - lu(k,1019) * lu(k,1489) - lu(k,1517) = lu(k,1517) - lu(k,1020) * lu(k,1489) - lu(k,1519) = lu(k,1519) - lu(k,1021) * lu(k,1489) - lu(k,1521) = lu(k,1521) - lu(k,1022) * lu(k,1489) - lu(k,1696) = lu(k,1696) - lu(k,1009) * lu(k,1695) - lu(k,1697) = lu(k,1697) - lu(k,1010) * lu(k,1695) - lu(k,1698) = lu(k,1698) - lu(k,1011) * lu(k,1695) - lu(k,1710) = lu(k,1710) - lu(k,1012) * lu(k,1695) - lu(k,1714) = lu(k,1714) - lu(k,1013) * lu(k,1695) - lu(k,1716) = lu(k,1716) - lu(k,1014) * lu(k,1695) - lu(k,1719) = lu(k,1719) - lu(k,1015) * lu(k,1695) - lu(k,1722) = lu(k,1722) - lu(k,1016) * lu(k,1695) - lu(k,1723) = lu(k,1723) - lu(k,1017) * lu(k,1695) - lu(k,1724) = lu(k,1724) - lu(k,1018) * lu(k,1695) - lu(k,1725) = lu(k,1725) - lu(k,1019) * lu(k,1695) - lu(k,1726) = lu(k,1726) - lu(k,1020) * lu(k,1695) - lu(k,1728) = lu(k,1728) - lu(k,1021) * lu(k,1695) - lu(k,1730) = lu(k,1730) - lu(k,1022) * lu(k,1695) - lu(k,1761) = lu(k,1761) - lu(k,1009) * lu(k,1760) - lu(k,1762) = lu(k,1762) - lu(k,1010) * lu(k,1760) - lu(k,1763) = lu(k,1763) - lu(k,1011) * lu(k,1760) - lu(k,1773) = lu(k,1773) - lu(k,1012) * lu(k,1760) - lu(k,1776) = lu(k,1776) - lu(k,1013) * lu(k,1760) - lu(k,1778) = lu(k,1778) - lu(k,1014) * lu(k,1760) - lu(k,1781) = lu(k,1781) - lu(k,1015) * lu(k,1760) - lu(k,1784) = lu(k,1784) - lu(k,1016) * lu(k,1760) - lu(k,1785) = lu(k,1785) - lu(k,1017) * lu(k,1760) - lu(k,1786) = lu(k,1786) - lu(k,1018) * lu(k,1760) - lu(k,1787) = - lu(k,1019) * lu(k,1760) - lu(k,1788) = lu(k,1788) - lu(k,1020) * lu(k,1760) - lu(k,1790) = lu(k,1790) - lu(k,1021) * lu(k,1760) - lu(k,1792) = lu(k,1792) - lu(k,1022) * lu(k,1760) - lu(k,1882) = lu(k,1882) - lu(k,1009) * lu(k,1881) - lu(k,1883) = lu(k,1883) - lu(k,1010) * lu(k,1881) - lu(k,1884) = lu(k,1884) - lu(k,1011) * lu(k,1881) - lu(k,1895) = lu(k,1895) - lu(k,1012) * lu(k,1881) - lu(k,1898) = lu(k,1898) - lu(k,1013) * lu(k,1881) - lu(k,1900) = lu(k,1900) - lu(k,1014) * lu(k,1881) - lu(k,1903) = lu(k,1903) - lu(k,1015) * lu(k,1881) - lu(k,1906) = lu(k,1906) - lu(k,1016) * lu(k,1881) - lu(k,1907) = lu(k,1907) - lu(k,1017) * lu(k,1881) - lu(k,1908) = lu(k,1908) - lu(k,1018) * lu(k,1881) - lu(k,1909) = lu(k,1909) - lu(k,1019) * lu(k,1881) - lu(k,1910) = lu(k,1910) - lu(k,1020) * lu(k,1881) - lu(k,1912) = lu(k,1912) - lu(k,1021) * lu(k,1881) - lu(k,1914) = lu(k,1914) - lu(k,1022) * lu(k,1881) - lu(k,2084) = lu(k,2084) - lu(k,1009) * lu(k,2083) - lu(k,2085) = lu(k,2085) - lu(k,1010) * lu(k,2083) - lu(k,2086) = lu(k,2086) - lu(k,1011) * lu(k,2083) - lu(k,2098) = lu(k,2098) - lu(k,1012) * lu(k,2083) - lu(k,2101) = lu(k,2101) - lu(k,1013) * lu(k,2083) - lu(k,2103) = lu(k,2103) - lu(k,1014) * lu(k,2083) - lu(k,2106) = lu(k,2106) - lu(k,1015) * lu(k,2083) - lu(k,2109) = lu(k,2109) - lu(k,1016) * lu(k,2083) - lu(k,2110) = lu(k,2110) - lu(k,1017) * lu(k,2083) - lu(k,2111) = lu(k,2111) - lu(k,1018) * lu(k,2083) - lu(k,2112) = lu(k,2112) - lu(k,1019) * lu(k,2083) - lu(k,2113) = lu(k,2113) - lu(k,1020) * lu(k,2083) - lu(k,2115) = lu(k,2115) - lu(k,1021) * lu(k,2083) - lu(k,2117) = lu(k,2117) - lu(k,1022) * lu(k,2083) - lu(k,1030) = 1._r8 / lu(k,1030) - lu(k,1031) = lu(k,1031) * lu(k,1030) - lu(k,1032) = lu(k,1032) * lu(k,1030) - lu(k,1033) = lu(k,1033) * lu(k,1030) - lu(k,1034) = lu(k,1034) * lu(k,1030) - lu(k,1035) = lu(k,1035) * lu(k,1030) - lu(k,1036) = lu(k,1036) * lu(k,1030) - lu(k,1037) = lu(k,1037) * lu(k,1030) - lu(k,1038) = lu(k,1038) * lu(k,1030) - lu(k,1039) = lu(k,1039) * lu(k,1030) - lu(k,1040) = lu(k,1040) * lu(k,1030) - lu(k,1041) = lu(k,1041) * lu(k,1030) - lu(k,1050) = lu(k,1050) - lu(k,1031) * lu(k,1048) - lu(k,1051) = lu(k,1051) - lu(k,1032) * lu(k,1048) - lu(k,1052) = lu(k,1052) - lu(k,1033) * lu(k,1048) - lu(k,1053) = lu(k,1053) - lu(k,1034) * lu(k,1048) - lu(k,1054) = lu(k,1054) - lu(k,1035) * lu(k,1048) - lu(k,1055) = lu(k,1055) - lu(k,1036) * lu(k,1048) - lu(k,1057) = lu(k,1057) - lu(k,1037) * lu(k,1048) - lu(k,1058) = lu(k,1058) - lu(k,1038) * lu(k,1048) - lu(k,1059) = lu(k,1059) - lu(k,1039) * lu(k,1048) - lu(k,1060) = lu(k,1060) - lu(k,1040) * lu(k,1048) - lu(k,1061) = lu(k,1061) - lu(k,1041) * lu(k,1048) - lu(k,1384) = lu(k,1384) - lu(k,1031) * lu(k,1382) - lu(k,1395) = lu(k,1395) - lu(k,1032) * lu(k,1382) - lu(k,1396) = lu(k,1396) - lu(k,1033) * lu(k,1382) - lu(k,1398) = lu(k,1398) - lu(k,1034) * lu(k,1382) - lu(k,1400) = lu(k,1400) - lu(k,1035) * lu(k,1382) - lu(k,1402) = lu(k,1402) - lu(k,1036) * lu(k,1382) - lu(k,1404) = lu(k,1404) - lu(k,1037) * lu(k,1382) - lu(k,1405) = lu(k,1405) - lu(k,1038) * lu(k,1382) - lu(k,1406) = lu(k,1406) - lu(k,1039) * lu(k,1382) - lu(k,1407) = lu(k,1407) - lu(k,1040) * lu(k,1382) - lu(k,1409) = lu(k,1409) - lu(k,1041) * lu(k,1382) - lu(k,1492) = lu(k,1492) - lu(k,1031) * lu(k,1490) - lu(k,1503) = lu(k,1503) - lu(k,1032) * lu(k,1490) - lu(k,1505) = lu(k,1505) - lu(k,1033) * lu(k,1490) - lu(k,1507) = lu(k,1507) - lu(k,1034) * lu(k,1490) - lu(k,1510) = lu(k,1510) - lu(k,1035) * lu(k,1490) - lu(k,1513) = lu(k,1513) - lu(k,1036) * lu(k,1490) - lu(k,1515) = lu(k,1515) - lu(k,1037) * lu(k,1490) - lu(k,1516) = lu(k,1516) - lu(k,1038) * lu(k,1490) - lu(k,1517) = lu(k,1517) - lu(k,1039) * lu(k,1490) - lu(k,1519) = lu(k,1519) - lu(k,1040) * lu(k,1490) - lu(k,1521) = lu(k,1521) - lu(k,1041) * lu(k,1490) - lu(k,1698) = lu(k,1698) - lu(k,1031) * lu(k,1696) - lu(k,1710) = lu(k,1710) - lu(k,1032) * lu(k,1696) - lu(k,1714) = lu(k,1714) - lu(k,1033) * lu(k,1696) - lu(k,1716) = lu(k,1716) - lu(k,1034) * lu(k,1696) - lu(k,1719) = lu(k,1719) - lu(k,1035) * lu(k,1696) - lu(k,1722) = lu(k,1722) - lu(k,1036) * lu(k,1696) - lu(k,1724) = lu(k,1724) - lu(k,1037) * lu(k,1696) - lu(k,1725) = lu(k,1725) - lu(k,1038) * lu(k,1696) - lu(k,1726) = lu(k,1726) - lu(k,1039) * lu(k,1696) - lu(k,1728) = lu(k,1728) - lu(k,1040) * lu(k,1696) - lu(k,1730) = lu(k,1730) - lu(k,1041) * lu(k,1696) - lu(k,1763) = lu(k,1763) - lu(k,1031) * lu(k,1761) - lu(k,1773) = lu(k,1773) - lu(k,1032) * lu(k,1761) - lu(k,1776) = lu(k,1776) - lu(k,1033) * lu(k,1761) - lu(k,1778) = lu(k,1778) - lu(k,1034) * lu(k,1761) - lu(k,1781) = lu(k,1781) - lu(k,1035) * lu(k,1761) - lu(k,1784) = lu(k,1784) - lu(k,1036) * lu(k,1761) - lu(k,1786) = lu(k,1786) - lu(k,1037) * lu(k,1761) - lu(k,1787) = lu(k,1787) - lu(k,1038) * lu(k,1761) - lu(k,1788) = lu(k,1788) - lu(k,1039) * lu(k,1761) - lu(k,1790) = lu(k,1790) - lu(k,1040) * lu(k,1761) - lu(k,1792) = lu(k,1792) - lu(k,1041) * lu(k,1761) - lu(k,1884) = lu(k,1884) - lu(k,1031) * lu(k,1882) - lu(k,1895) = lu(k,1895) - lu(k,1032) * lu(k,1882) - lu(k,1898) = lu(k,1898) - lu(k,1033) * lu(k,1882) - lu(k,1900) = lu(k,1900) - lu(k,1034) * lu(k,1882) - lu(k,1903) = lu(k,1903) - lu(k,1035) * lu(k,1882) - lu(k,1906) = lu(k,1906) - lu(k,1036) * lu(k,1882) - lu(k,1908) = lu(k,1908) - lu(k,1037) * lu(k,1882) - lu(k,1909) = lu(k,1909) - lu(k,1038) * lu(k,1882) - lu(k,1910) = lu(k,1910) - lu(k,1039) * lu(k,1882) - lu(k,1912) = lu(k,1912) - lu(k,1040) * lu(k,1882) - lu(k,1914) = lu(k,1914) - lu(k,1041) * lu(k,1882) - lu(k,2086) = lu(k,2086) - lu(k,1031) * lu(k,2084) - lu(k,2098) = lu(k,2098) - lu(k,1032) * lu(k,2084) - lu(k,2101) = lu(k,2101) - lu(k,1033) * lu(k,2084) - lu(k,2103) = lu(k,2103) - lu(k,1034) * lu(k,2084) - lu(k,2106) = lu(k,2106) - lu(k,1035) * lu(k,2084) - lu(k,2109) = lu(k,2109) - lu(k,1036) * lu(k,2084) - lu(k,2111) = lu(k,2111) - lu(k,1037) * lu(k,2084) - lu(k,2112) = lu(k,2112) - lu(k,1038) * lu(k,2084) - lu(k,2113) = lu(k,2113) - lu(k,1039) * lu(k,2084) - lu(k,2115) = lu(k,2115) - lu(k,1040) * lu(k,2084) - lu(k,2117) = lu(k,2117) - lu(k,1041) * lu(k,2084) - lu(k,1049) = 1._r8 / lu(k,1049) - lu(k,1050) = lu(k,1050) * lu(k,1049) - lu(k,1051) = lu(k,1051) * lu(k,1049) - lu(k,1052) = lu(k,1052) * lu(k,1049) - lu(k,1053) = lu(k,1053) * lu(k,1049) - lu(k,1054) = lu(k,1054) * lu(k,1049) - lu(k,1055) = lu(k,1055) * lu(k,1049) - lu(k,1056) = lu(k,1056) * lu(k,1049) - lu(k,1057) = lu(k,1057) * lu(k,1049) - lu(k,1058) = lu(k,1058) * lu(k,1049) - lu(k,1059) = lu(k,1059) * lu(k,1049) - lu(k,1060) = lu(k,1060) * lu(k,1049) - lu(k,1061) = lu(k,1061) * lu(k,1049) - lu(k,1384) = lu(k,1384) - lu(k,1050) * lu(k,1383) - lu(k,1395) = lu(k,1395) - lu(k,1051) * lu(k,1383) - lu(k,1396) = lu(k,1396) - lu(k,1052) * lu(k,1383) - lu(k,1398) = lu(k,1398) - lu(k,1053) * lu(k,1383) - lu(k,1400) = lu(k,1400) - lu(k,1054) * lu(k,1383) - lu(k,1402) = lu(k,1402) - lu(k,1055) * lu(k,1383) - lu(k,1403) = lu(k,1403) - lu(k,1056) * lu(k,1383) - lu(k,1404) = lu(k,1404) - lu(k,1057) * lu(k,1383) - lu(k,1405) = lu(k,1405) - lu(k,1058) * lu(k,1383) - lu(k,1406) = lu(k,1406) - lu(k,1059) * lu(k,1383) - lu(k,1407) = lu(k,1407) - lu(k,1060) * lu(k,1383) - lu(k,1409) = lu(k,1409) - lu(k,1061) * lu(k,1383) - lu(k,1492) = lu(k,1492) - lu(k,1050) * lu(k,1491) - lu(k,1503) = lu(k,1503) - lu(k,1051) * lu(k,1491) - lu(k,1505) = lu(k,1505) - lu(k,1052) * lu(k,1491) - lu(k,1507) = lu(k,1507) - lu(k,1053) * lu(k,1491) - lu(k,1510) = lu(k,1510) - lu(k,1054) * lu(k,1491) - lu(k,1513) = lu(k,1513) - lu(k,1055) * lu(k,1491) - lu(k,1514) = lu(k,1514) - lu(k,1056) * lu(k,1491) - lu(k,1515) = lu(k,1515) - lu(k,1057) * lu(k,1491) - lu(k,1516) = lu(k,1516) - lu(k,1058) * lu(k,1491) - lu(k,1517) = lu(k,1517) - lu(k,1059) * lu(k,1491) - lu(k,1519) = lu(k,1519) - lu(k,1060) * lu(k,1491) - lu(k,1521) = lu(k,1521) - lu(k,1061) * lu(k,1491) - lu(k,1698) = lu(k,1698) - lu(k,1050) * lu(k,1697) - lu(k,1710) = lu(k,1710) - lu(k,1051) * lu(k,1697) - lu(k,1714) = lu(k,1714) - lu(k,1052) * lu(k,1697) - lu(k,1716) = lu(k,1716) - lu(k,1053) * lu(k,1697) - lu(k,1719) = lu(k,1719) - lu(k,1054) * lu(k,1697) - lu(k,1722) = lu(k,1722) - lu(k,1055) * lu(k,1697) - lu(k,1723) = lu(k,1723) - lu(k,1056) * lu(k,1697) - lu(k,1724) = lu(k,1724) - lu(k,1057) * lu(k,1697) - lu(k,1725) = lu(k,1725) - lu(k,1058) * lu(k,1697) - lu(k,1726) = lu(k,1726) - lu(k,1059) * lu(k,1697) - lu(k,1728) = lu(k,1728) - lu(k,1060) * lu(k,1697) - lu(k,1730) = lu(k,1730) - lu(k,1061) * lu(k,1697) - lu(k,1763) = lu(k,1763) - lu(k,1050) * lu(k,1762) - lu(k,1773) = lu(k,1773) - lu(k,1051) * lu(k,1762) - lu(k,1776) = lu(k,1776) - lu(k,1052) * lu(k,1762) - lu(k,1778) = lu(k,1778) - lu(k,1053) * lu(k,1762) - lu(k,1781) = lu(k,1781) - lu(k,1054) * lu(k,1762) - lu(k,1784) = lu(k,1784) - lu(k,1055) * lu(k,1762) - lu(k,1785) = lu(k,1785) - lu(k,1056) * lu(k,1762) - lu(k,1786) = lu(k,1786) - lu(k,1057) * lu(k,1762) - lu(k,1787) = lu(k,1787) - lu(k,1058) * lu(k,1762) - lu(k,1788) = lu(k,1788) - lu(k,1059) * lu(k,1762) - lu(k,1790) = lu(k,1790) - lu(k,1060) * lu(k,1762) - lu(k,1792) = lu(k,1792) - lu(k,1061) * lu(k,1762) - lu(k,1884) = lu(k,1884) - lu(k,1050) * lu(k,1883) - lu(k,1895) = lu(k,1895) - lu(k,1051) * lu(k,1883) - lu(k,1898) = lu(k,1898) - lu(k,1052) * lu(k,1883) - lu(k,1900) = lu(k,1900) - lu(k,1053) * lu(k,1883) - lu(k,1903) = lu(k,1903) - lu(k,1054) * lu(k,1883) - lu(k,1906) = lu(k,1906) - lu(k,1055) * lu(k,1883) - lu(k,1907) = lu(k,1907) - lu(k,1056) * lu(k,1883) - lu(k,1908) = lu(k,1908) - lu(k,1057) * lu(k,1883) - lu(k,1909) = lu(k,1909) - lu(k,1058) * lu(k,1883) - lu(k,1910) = lu(k,1910) - lu(k,1059) * lu(k,1883) - lu(k,1912) = lu(k,1912) - lu(k,1060) * lu(k,1883) - lu(k,1914) = lu(k,1914) - lu(k,1061) * lu(k,1883) - lu(k,2086) = lu(k,2086) - lu(k,1050) * lu(k,2085) - lu(k,2098) = lu(k,2098) - lu(k,1051) * lu(k,2085) - lu(k,2101) = lu(k,2101) - lu(k,1052) * lu(k,2085) - lu(k,2103) = lu(k,2103) - lu(k,1053) * lu(k,2085) - lu(k,2106) = lu(k,2106) - lu(k,1054) * lu(k,2085) - lu(k,2109) = lu(k,2109) - lu(k,1055) * lu(k,2085) - lu(k,2110) = lu(k,2110) - lu(k,1056) * lu(k,2085) - lu(k,2111) = lu(k,2111) - lu(k,1057) * lu(k,2085) - lu(k,2112) = lu(k,2112) - lu(k,1058) * lu(k,2085) - lu(k,2113) = lu(k,2113) - lu(k,1059) * lu(k,2085) - lu(k,2115) = lu(k,2115) - lu(k,1060) * lu(k,2085) - lu(k,2117) = lu(k,2117) - lu(k,1061) * lu(k,2085) - lu(k,1065) = 1._r8 / lu(k,1065) - lu(k,1066) = lu(k,1066) * lu(k,1065) - lu(k,1067) = lu(k,1067) * lu(k,1065) - lu(k,1068) = lu(k,1068) * lu(k,1065) - lu(k,1069) = lu(k,1069) * lu(k,1065) - lu(k,1070) = lu(k,1070) * lu(k,1065) - lu(k,1071) = lu(k,1071) * lu(k,1065) - lu(k,1072) = lu(k,1072) * lu(k,1065) - lu(k,1073) = lu(k,1073) * lu(k,1065) - lu(k,1074) = lu(k,1074) * lu(k,1065) - lu(k,1171) = lu(k,1171) - lu(k,1066) * lu(k,1167) - lu(k,1176) = lu(k,1176) - lu(k,1067) * lu(k,1167) - lu(k,1177) = lu(k,1177) - lu(k,1068) * lu(k,1167) - lu(k,1178) = lu(k,1178) - lu(k,1069) * lu(k,1167) - lu(k,1179) = lu(k,1179) - lu(k,1070) * lu(k,1167) - lu(k,1181) = lu(k,1181) - lu(k,1071) * lu(k,1167) - lu(k,1185) = lu(k,1185) - lu(k,1072) * lu(k,1167) - lu(k,1186) = lu(k,1186) - lu(k,1073) * lu(k,1167) - lu(k,1187) = lu(k,1187) - lu(k,1074) * lu(k,1167) - lu(k,1205) = lu(k,1205) - lu(k,1066) * lu(k,1201) - lu(k,1210) = lu(k,1210) - lu(k,1067) * lu(k,1201) - lu(k,1211) = lu(k,1211) - lu(k,1068) * lu(k,1201) - lu(k,1212) = lu(k,1212) - lu(k,1069) * lu(k,1201) - lu(k,1213) = lu(k,1213) - lu(k,1070) * lu(k,1201) - lu(k,1215) = lu(k,1215) - lu(k,1071) * lu(k,1201) - lu(k,1219) = lu(k,1219) - lu(k,1072) * lu(k,1201) - lu(k,1220) = lu(k,1220) - lu(k,1073) * lu(k,1201) - lu(k,1221) = lu(k,1221) - lu(k,1074) * lu(k,1201) - lu(k,1230) = lu(k,1230) - lu(k,1066) * lu(k,1228) - lu(k,1233) = lu(k,1233) - lu(k,1067) * lu(k,1228) - lu(k,1234) = lu(k,1234) - lu(k,1068) * lu(k,1228) - lu(k,1235) = lu(k,1235) - lu(k,1069) * lu(k,1228) - lu(k,1236) = lu(k,1236) - lu(k,1070) * lu(k,1228) - lu(k,1237) = lu(k,1237) - lu(k,1071) * lu(k,1228) - lu(k,1241) = lu(k,1241) - lu(k,1072) * lu(k,1228) - lu(k,1242) = lu(k,1242) - lu(k,1073) * lu(k,1228) - lu(k,1243) = lu(k,1243) - lu(k,1074) * lu(k,1228) - lu(k,1389) = lu(k,1389) - lu(k,1066) * lu(k,1384) - lu(k,1395) = lu(k,1395) - lu(k,1067) * lu(k,1384) - lu(k,1396) = lu(k,1396) - lu(k,1068) * lu(k,1384) - lu(k,1398) = lu(k,1398) - lu(k,1069) * lu(k,1384) - lu(k,1400) = lu(k,1400) - lu(k,1070) * lu(k,1384) - lu(k,1402) = lu(k,1402) - lu(k,1071) * lu(k,1384) - lu(k,1406) = lu(k,1406) - lu(k,1072) * lu(k,1384) - lu(k,1407) = lu(k,1407) - lu(k,1073) * lu(k,1384) - lu(k,1409) = lu(k,1409) - lu(k,1074) * lu(k,1384) - lu(k,1497) = lu(k,1497) - lu(k,1066) * lu(k,1492) - lu(k,1503) = lu(k,1503) - lu(k,1067) * lu(k,1492) - lu(k,1505) = lu(k,1505) - lu(k,1068) * lu(k,1492) - lu(k,1507) = lu(k,1507) - lu(k,1069) * lu(k,1492) - lu(k,1510) = lu(k,1510) - lu(k,1070) * lu(k,1492) - lu(k,1513) = lu(k,1513) - lu(k,1071) * lu(k,1492) - lu(k,1517) = lu(k,1517) - lu(k,1072) * lu(k,1492) - lu(k,1519) = lu(k,1519) - lu(k,1073) * lu(k,1492) - lu(k,1521) = lu(k,1521) - lu(k,1074) * lu(k,1492) - lu(k,1704) = lu(k,1704) - lu(k,1066) * lu(k,1698) - lu(k,1710) = lu(k,1710) - lu(k,1067) * lu(k,1698) - lu(k,1714) = lu(k,1714) - lu(k,1068) * lu(k,1698) - lu(k,1716) = lu(k,1716) - lu(k,1069) * lu(k,1698) - lu(k,1719) = lu(k,1719) - lu(k,1070) * lu(k,1698) - lu(k,1722) = lu(k,1722) - lu(k,1071) * lu(k,1698) - lu(k,1726) = lu(k,1726) - lu(k,1072) * lu(k,1698) - lu(k,1728) = lu(k,1728) - lu(k,1073) * lu(k,1698) - lu(k,1730) = lu(k,1730) - lu(k,1074) * lu(k,1698) - lu(k,1767) = lu(k,1767) - lu(k,1066) * lu(k,1763) - lu(k,1773) = lu(k,1773) - lu(k,1067) * lu(k,1763) - lu(k,1776) = lu(k,1776) - lu(k,1068) * lu(k,1763) - lu(k,1778) = lu(k,1778) - lu(k,1069) * lu(k,1763) - lu(k,1781) = lu(k,1781) - lu(k,1070) * lu(k,1763) - lu(k,1784) = lu(k,1784) - lu(k,1071) * lu(k,1763) - lu(k,1788) = lu(k,1788) - lu(k,1072) * lu(k,1763) - lu(k,1790) = lu(k,1790) - lu(k,1073) * lu(k,1763) - lu(k,1792) = lu(k,1792) - lu(k,1074) * lu(k,1763) - lu(k,1889) = lu(k,1889) - lu(k,1066) * lu(k,1884) - lu(k,1895) = lu(k,1895) - lu(k,1067) * lu(k,1884) - lu(k,1898) = lu(k,1898) - lu(k,1068) * lu(k,1884) - lu(k,1900) = lu(k,1900) - lu(k,1069) * lu(k,1884) - lu(k,1903) = lu(k,1903) - lu(k,1070) * lu(k,1884) - lu(k,1906) = lu(k,1906) - lu(k,1071) * lu(k,1884) - lu(k,1910) = lu(k,1910) - lu(k,1072) * lu(k,1884) - lu(k,1912) = lu(k,1912) - lu(k,1073) * lu(k,1884) - lu(k,1914) = lu(k,1914) - lu(k,1074) * lu(k,1884) - lu(k,2092) = lu(k,2092) - lu(k,1066) * lu(k,2086) - lu(k,2098) = lu(k,2098) - lu(k,1067) * lu(k,2086) - lu(k,2101) = lu(k,2101) - lu(k,1068) * lu(k,2086) - lu(k,2103) = lu(k,2103) - lu(k,1069) * lu(k,2086) - lu(k,2106) = lu(k,2106) - lu(k,1070) * lu(k,2086) - lu(k,2109) = lu(k,2109) - lu(k,1071) * lu(k,2086) - lu(k,2113) = lu(k,2113) - lu(k,1072) * lu(k,2086) - lu(k,2115) = lu(k,2115) - lu(k,1073) * lu(k,2086) - lu(k,2117) = lu(k,2117) - lu(k,1074) * lu(k,2086) + lu(k,1016) = 1._r8 / lu(k,1016) + lu(k,1017) = lu(k,1017) * lu(k,1016) + lu(k,1018) = lu(k,1018) * lu(k,1016) + lu(k,1019) = lu(k,1019) * lu(k,1016) + lu(k,1020) = lu(k,1020) * lu(k,1016) + lu(k,1021) = lu(k,1021) * lu(k,1016) + lu(k,1022) = lu(k,1022) * lu(k,1016) + lu(k,1023) = lu(k,1023) * lu(k,1016) + lu(k,1024) = lu(k,1024) * lu(k,1016) + lu(k,1025) = lu(k,1025) * lu(k,1016) + lu(k,1026) = lu(k,1026) * lu(k,1016) + lu(k,1027) = lu(k,1027) * lu(k,1016) + lu(k,1028) = lu(k,1028) * lu(k,1016) + lu(k,1029) = lu(k,1029) * lu(k,1016) + lu(k,1030) = lu(k,1030) * lu(k,1016) + lu(k,1031) = lu(k,1031) * lu(k,1016) + lu(k,1032) = lu(k,1032) * lu(k,1016) + lu(k,1033) = lu(k,1033) * lu(k,1016) + lu(k,1034) = lu(k,1034) * lu(k,1016) + lu(k,1764) = lu(k,1764) - lu(k,1017) * lu(k,1763) + lu(k,1765) = lu(k,1765) - lu(k,1018) * lu(k,1763) + lu(k,1766) = lu(k,1766) - lu(k,1019) * lu(k,1763) + lu(k,1767) = lu(k,1767) - lu(k,1020) * lu(k,1763) + lu(k,1768) = lu(k,1768) - lu(k,1021) * lu(k,1763) + lu(k,1769) = lu(k,1769) - lu(k,1022) * lu(k,1763) + lu(k,1770) = lu(k,1770) - lu(k,1023) * lu(k,1763) + lu(k,1774) = lu(k,1774) - lu(k,1024) * lu(k,1763) + lu(k,1779) = lu(k,1779) - lu(k,1025) * lu(k,1763) + lu(k,1783) = lu(k,1783) - lu(k,1026) * lu(k,1763) + lu(k,1789) = lu(k,1789) - lu(k,1027) * lu(k,1763) + lu(k,1790) = lu(k,1790) - lu(k,1028) * lu(k,1763) + lu(k,1799) = lu(k,1799) - lu(k,1029) * lu(k,1763) + lu(k,1801) = lu(k,1801) - lu(k,1030) * lu(k,1763) + lu(k,1806) = lu(k,1806) - lu(k,1031) * lu(k,1763) + lu(k,1810) = lu(k,1810) - lu(k,1032) * lu(k,1763) + lu(k,1811) = lu(k,1811) - lu(k,1033) * lu(k,1763) + lu(k,1812) = lu(k,1812) - lu(k,1034) * lu(k,1763) + lu(k,1871) = lu(k,1871) - lu(k,1017) * lu(k,1870) + lu(k,1872) = lu(k,1872) - lu(k,1018) * lu(k,1870) + lu(k,1873) = lu(k,1873) - lu(k,1019) * lu(k,1870) + lu(k,1874) = lu(k,1874) - lu(k,1020) * lu(k,1870) + lu(k,1875) = lu(k,1875) - lu(k,1021) * lu(k,1870) + lu(k,1876) = lu(k,1876) - lu(k,1022) * lu(k,1870) + lu(k,1877) = lu(k,1877) - lu(k,1023) * lu(k,1870) + lu(k,1881) = lu(k,1881) - lu(k,1024) * lu(k,1870) + lu(k,1886) = lu(k,1886) - lu(k,1025) * lu(k,1870) + lu(k,1890) = lu(k,1890) - lu(k,1026) * lu(k,1870) + lu(k,1896) = lu(k,1896) - lu(k,1027) * lu(k,1870) + lu(k,1897) = lu(k,1897) - lu(k,1028) * lu(k,1870) + lu(k,1904) = lu(k,1904) - lu(k,1029) * lu(k,1870) + lu(k,1906) = lu(k,1906) - lu(k,1030) * lu(k,1870) + lu(k,1911) = lu(k,1911) - lu(k,1031) * lu(k,1870) + lu(k,1915) = lu(k,1915) - lu(k,1032) * lu(k,1870) + lu(k,1916) = lu(k,1916) - lu(k,1033) * lu(k,1870) + lu(k,1917) = lu(k,1917) - lu(k,1034) * lu(k,1870) + lu(k,2377) = lu(k,2377) - lu(k,1017) * lu(k,2376) + lu(k,2378) = lu(k,2378) - lu(k,1018) * lu(k,2376) + lu(k,2379) = lu(k,2379) - lu(k,1019) * lu(k,2376) + lu(k,2380) = lu(k,2380) - lu(k,1020) * lu(k,2376) + lu(k,2381) = lu(k,2381) - lu(k,1021) * lu(k,2376) + lu(k,2382) = lu(k,2382) - lu(k,1022) * lu(k,2376) + lu(k,2383) = lu(k,2383) - lu(k,1023) * lu(k,2376) + lu(k,2386) = lu(k,2386) - lu(k,1024) * lu(k,2376) + lu(k,2390) = lu(k,2390) - lu(k,1025) * lu(k,2376) + lu(k,2393) = lu(k,2393) - lu(k,1026) * lu(k,2376) + lu(k,2399) = lu(k,2399) - lu(k,1027) * lu(k,2376) + lu(k,2400) = lu(k,2400) - lu(k,1028) * lu(k,2376) + lu(k,2407) = lu(k,2407) - lu(k,1029) * lu(k,2376) + lu(k,2409) = lu(k,2409) - lu(k,1030) * lu(k,2376) + lu(k,2414) = lu(k,2414) - lu(k,1031) * lu(k,2376) + lu(k,2418) = lu(k,2418) - lu(k,1032) * lu(k,2376) + lu(k,2419) = lu(k,2419) - lu(k,1033) * lu(k,2376) + lu(k,2420) = lu(k,2420) - lu(k,1034) * lu(k,2376) + lu(k,1040) = 1._r8 / lu(k,1040) + lu(k,1041) = lu(k,1041) * lu(k,1040) + lu(k,1042) = lu(k,1042) * lu(k,1040) + lu(k,1043) = lu(k,1043) * lu(k,1040) + lu(k,1044) = lu(k,1044) * lu(k,1040) + lu(k,1045) = lu(k,1045) * lu(k,1040) + lu(k,1046) = lu(k,1046) * lu(k,1040) + lu(k,1047) = lu(k,1047) * lu(k,1040) + lu(k,1048) = lu(k,1048) * lu(k,1040) + lu(k,1049) = lu(k,1049) * lu(k,1040) + lu(k,1050) = lu(k,1050) * lu(k,1040) + lu(k,1768) = lu(k,1768) - lu(k,1041) * lu(k,1764) + lu(k,1773) = lu(k,1773) - lu(k,1042) * lu(k,1764) + lu(k,1789) = lu(k,1789) - lu(k,1043) * lu(k,1764) + lu(k,1795) = lu(k,1795) - lu(k,1044) * lu(k,1764) + lu(k,1799) = lu(k,1799) - lu(k,1045) * lu(k,1764) + lu(k,1800) = lu(k,1800) - lu(k,1046) * lu(k,1764) + lu(k,1804) = lu(k,1804) - lu(k,1047) * lu(k,1764) + lu(k,1806) = lu(k,1806) - lu(k,1048) * lu(k,1764) + lu(k,1807) = lu(k,1807) - lu(k,1049) * lu(k,1764) + lu(k,1810) = lu(k,1810) - lu(k,1050) * lu(k,1764) + lu(k,1875) = lu(k,1875) - lu(k,1041) * lu(k,1871) + lu(k,1880) = lu(k,1880) - lu(k,1042) * lu(k,1871) + lu(k,1896) = lu(k,1896) - lu(k,1043) * lu(k,1871) + lu(k,1900) = lu(k,1900) - lu(k,1044) * lu(k,1871) + lu(k,1904) = lu(k,1904) - lu(k,1045) * lu(k,1871) + lu(k,1905) = lu(k,1905) - lu(k,1046) * lu(k,1871) + lu(k,1909) = lu(k,1909) - lu(k,1047) * lu(k,1871) + lu(k,1911) = lu(k,1911) - lu(k,1048) * lu(k,1871) + lu(k,1912) = lu(k,1912) - lu(k,1049) * lu(k,1871) + lu(k,1915) = lu(k,1915) - lu(k,1050) * lu(k,1871) + lu(k,2041) = lu(k,2041) - lu(k,1041) * lu(k,2037) + lu(k,2045) = lu(k,2045) - lu(k,1042) * lu(k,2037) + lu(k,2061) = lu(k,2061) - lu(k,1043) * lu(k,2037) + lu(k,2064) = lu(k,2064) - lu(k,1044) * lu(k,2037) + lu(k,2068) = lu(k,2068) - lu(k,1045) * lu(k,2037) + lu(k,2069) = lu(k,2069) - lu(k,1046) * lu(k,2037) + lu(k,2073) = lu(k,2073) - lu(k,1047) * lu(k,2037) + lu(k,2075) = lu(k,2075) - lu(k,1048) * lu(k,2037) + lu(k,2076) = lu(k,2076) - lu(k,1049) * lu(k,2037) + lu(k,2079) = lu(k,2079) - lu(k,1050) * lu(k,2037) + lu(k,2170) = lu(k,2170) - lu(k,1041) * lu(k,2166) + lu(k,2173) = lu(k,2173) - lu(k,1042) * lu(k,2166) + lu(k,2188) = lu(k,2188) - lu(k,1043) * lu(k,2166) + lu(k,2193) = lu(k,2193) - lu(k,1044) * lu(k,2166) + lu(k,2197) = lu(k,2197) - lu(k,1045) * lu(k,2166) + lu(k,2198) = lu(k,2198) - lu(k,1046) * lu(k,2166) + lu(k,2202) = lu(k,2202) - lu(k,1047) * lu(k,2166) + lu(k,2204) = lu(k,2204) - lu(k,1048) * lu(k,2166) + lu(k,2205) = lu(k,2205) - lu(k,1049) * lu(k,2166) + lu(k,2208) = lu(k,2208) - lu(k,1050) * lu(k,2166) + lu(k,2381) = lu(k,2381) - lu(k,1041) * lu(k,2377) + lu(k,2385) = lu(k,2385) - lu(k,1042) * lu(k,2377) + lu(k,2399) = lu(k,2399) - lu(k,1043) * lu(k,2377) + lu(k,2403) = lu(k,2403) - lu(k,1044) * lu(k,2377) + lu(k,2407) = lu(k,2407) - lu(k,1045) * lu(k,2377) + lu(k,2408) = lu(k,2408) - lu(k,1046) * lu(k,2377) + lu(k,2412) = lu(k,2412) - lu(k,1047) * lu(k,2377) + lu(k,2414) = lu(k,2414) - lu(k,1048) * lu(k,2377) + lu(k,2415) = lu(k,2415) - lu(k,1049) * lu(k,2377) + lu(k,2418) = lu(k,2418) - lu(k,1050) * lu(k,2377) + lu(k,1052) = 1._r8 / lu(k,1052) + lu(k,1053) = lu(k,1053) * lu(k,1052) + lu(k,1054) = lu(k,1054) * lu(k,1052) + lu(k,1055) = lu(k,1055) * lu(k,1052) + lu(k,1056) = lu(k,1056) * lu(k,1052) + lu(k,1116) = lu(k,1116) - lu(k,1053) * lu(k,1114) + lu(k,1119) = - lu(k,1054) * lu(k,1114) + lu(k,1120) = lu(k,1120) - lu(k,1055) * lu(k,1114) + lu(k,1124) = lu(k,1124) - lu(k,1056) * lu(k,1114) + lu(k,1163) = lu(k,1163) - lu(k,1053) * lu(k,1162) + lu(k,1165) = lu(k,1165) - lu(k,1054) * lu(k,1162) + lu(k,1166) = lu(k,1166) - lu(k,1055) * lu(k,1162) + lu(k,1167) = lu(k,1167) - lu(k,1056) * lu(k,1162) + lu(k,1228) = lu(k,1228) - lu(k,1053) * lu(k,1227) + lu(k,1234) = lu(k,1234) - lu(k,1054) * lu(k,1227) + lu(k,1235) = lu(k,1235) - lu(k,1055) * lu(k,1227) + lu(k,1239) = lu(k,1239) - lu(k,1056) * lu(k,1227) + lu(k,1322) = lu(k,1322) - lu(k,1053) * lu(k,1321) + lu(k,1335) = - lu(k,1054) * lu(k,1321) + lu(k,1336) = lu(k,1336) - lu(k,1055) * lu(k,1321) + lu(k,1341) = lu(k,1341) - lu(k,1056) * lu(k,1321) + lu(k,1414) = lu(k,1414) - lu(k,1053) * lu(k,1412) + lu(k,1427) = lu(k,1427) - lu(k,1054) * lu(k,1412) + lu(k,1429) = lu(k,1429) - lu(k,1055) * lu(k,1412) + lu(k,1434) = lu(k,1434) - lu(k,1056) * lu(k,1412) + lu(k,1774) = lu(k,1774) - lu(k,1053) * lu(k,1765) + lu(k,1790) = lu(k,1790) - lu(k,1054) * lu(k,1765) + lu(k,1799) = lu(k,1799) - lu(k,1055) * lu(k,1765) + lu(k,1806) = lu(k,1806) - lu(k,1056) * lu(k,1765) + lu(k,1831) = lu(k,1831) - lu(k,1053) * lu(k,1830) + lu(k,1836) = lu(k,1836) - lu(k,1054) * lu(k,1830) + lu(k,1844) = lu(k,1844) - lu(k,1055) * lu(k,1830) + lu(k,1851) = lu(k,1851) - lu(k,1056) * lu(k,1830) + lu(k,1881) = lu(k,1881) - lu(k,1053) * lu(k,1872) + lu(k,1897) = lu(k,1897) - lu(k,1054) * lu(k,1872) + lu(k,1904) = lu(k,1904) - lu(k,1055) * lu(k,1872) + lu(k,1911) = lu(k,1911) - lu(k,1056) * lu(k,1872) + lu(k,1937) = lu(k,1937) - lu(k,1053) * lu(k,1934) + lu(k,1942) = lu(k,1942) - lu(k,1054) * lu(k,1934) + lu(k,1950) = lu(k,1950) - lu(k,1055) * lu(k,1934) + lu(k,1957) = lu(k,1957) - lu(k,1056) * lu(k,1934) + lu(k,2046) = lu(k,2046) - lu(k,1053) * lu(k,2038) + lu(k,2062) = lu(k,2062) - lu(k,1054) * lu(k,2038) + lu(k,2068) = lu(k,2068) - lu(k,1055) * lu(k,2038) + lu(k,2075) = lu(k,2075) - lu(k,1056) * lu(k,2038) + lu(k,2174) = lu(k,2174) - lu(k,1053) * lu(k,2167) + lu(k,2189) = lu(k,2189) - lu(k,1054) * lu(k,2167) + lu(k,2197) = lu(k,2197) - lu(k,1055) * lu(k,2167) + lu(k,2204) = lu(k,2204) - lu(k,1056) * lu(k,2167) + lu(k,2229) = lu(k,2229) - lu(k,1053) * lu(k,2221) + lu(k,2244) = lu(k,2244) - lu(k,1054) * lu(k,2221) + lu(k,2249) = lu(k,2249) - lu(k,1055) * lu(k,2221) + lu(k,2256) = lu(k,2256) - lu(k,1056) * lu(k,2221) + lu(k,2386) = lu(k,2386) - lu(k,1053) * lu(k,2378) + lu(k,2400) = lu(k,2400) - lu(k,1054) * lu(k,2378) + lu(k,2407) = lu(k,2407) - lu(k,1055) * lu(k,2378) + lu(k,2414) = lu(k,2414) - lu(k,1056) * lu(k,2378) + lu(k,1060) = 1._r8 / lu(k,1060) + lu(k,1061) = lu(k,1061) * lu(k,1060) + lu(k,1062) = lu(k,1062) * lu(k,1060) + lu(k,1063) = lu(k,1063) * lu(k,1060) + lu(k,1064) = lu(k,1064) * lu(k,1060) + lu(k,1065) = lu(k,1065) * lu(k,1060) + lu(k,1066) = lu(k,1066) * lu(k,1060) + lu(k,1067) = lu(k,1067) * lu(k,1060) + lu(k,1068) = lu(k,1068) * lu(k,1060) + lu(k,1069) = lu(k,1069) * lu(k,1060) + lu(k,1767) = lu(k,1767) - lu(k,1061) * lu(k,1766) + lu(k,1768) = lu(k,1768) - lu(k,1062) * lu(k,1766) + lu(k,1799) = lu(k,1799) - lu(k,1063) * lu(k,1766) + lu(k,1800) = lu(k,1800) - lu(k,1064) * lu(k,1766) + lu(k,1803) = lu(k,1803) - lu(k,1065) * lu(k,1766) + lu(k,1804) = lu(k,1804) - lu(k,1066) * lu(k,1766) + lu(k,1806) = lu(k,1806) - lu(k,1067) * lu(k,1766) + lu(k,1807) = lu(k,1807) - lu(k,1068) * lu(k,1766) + lu(k,1810) = lu(k,1810) - lu(k,1069) * lu(k,1766) + lu(k,1874) = lu(k,1874) - lu(k,1061) * lu(k,1873) + lu(k,1875) = lu(k,1875) - lu(k,1062) * lu(k,1873) + lu(k,1904) = lu(k,1904) - lu(k,1063) * lu(k,1873) + lu(k,1905) = lu(k,1905) - lu(k,1064) * lu(k,1873) + lu(k,1908) = lu(k,1908) - lu(k,1065) * lu(k,1873) + lu(k,1909) = lu(k,1909) - lu(k,1066) * lu(k,1873) + lu(k,1911) = lu(k,1911) - lu(k,1067) * lu(k,1873) + lu(k,1912) = lu(k,1912) - lu(k,1068) * lu(k,1873) + lu(k,1915) = lu(k,1915) - lu(k,1069) * lu(k,1873) + lu(k,2040) = lu(k,2040) - lu(k,1061) * lu(k,2039) + lu(k,2041) = lu(k,2041) - lu(k,1062) * lu(k,2039) + lu(k,2068) = lu(k,2068) - lu(k,1063) * lu(k,2039) + lu(k,2069) = lu(k,2069) - lu(k,1064) * lu(k,2039) + lu(k,2072) = lu(k,2072) - lu(k,1065) * lu(k,2039) + lu(k,2073) = lu(k,2073) - lu(k,1066) * lu(k,2039) + lu(k,2075) = lu(k,2075) - lu(k,1067) * lu(k,2039) + lu(k,2076) = lu(k,2076) - lu(k,1068) * lu(k,2039) + lu(k,2079) = lu(k,2079) - lu(k,1069) * lu(k,2039) + lu(k,2169) = lu(k,2169) - lu(k,1061) * lu(k,2168) + lu(k,2170) = lu(k,2170) - lu(k,1062) * lu(k,2168) + lu(k,2197) = lu(k,2197) - lu(k,1063) * lu(k,2168) + lu(k,2198) = lu(k,2198) - lu(k,1064) * lu(k,2168) + lu(k,2201) = lu(k,2201) - lu(k,1065) * lu(k,2168) + lu(k,2202) = lu(k,2202) - lu(k,1066) * lu(k,2168) + lu(k,2204) = lu(k,2204) - lu(k,1067) * lu(k,2168) + lu(k,2205) = lu(k,2205) - lu(k,1068) * lu(k,2168) + lu(k,2208) = lu(k,2208) - lu(k,1069) * lu(k,2168) + lu(k,2223) = lu(k,2223) - lu(k,1061) * lu(k,2222) + lu(k,2224) = lu(k,2224) - lu(k,1062) * lu(k,2222) + lu(k,2249) = lu(k,2249) - lu(k,1063) * lu(k,2222) + lu(k,2250) = lu(k,2250) - lu(k,1064) * lu(k,2222) + lu(k,2253) = lu(k,2253) - lu(k,1065) * lu(k,2222) + lu(k,2254) = lu(k,2254) - lu(k,1066) * lu(k,2222) + lu(k,2256) = lu(k,2256) - lu(k,1067) * lu(k,2222) + lu(k,2257) = lu(k,2257) - lu(k,1068) * lu(k,2222) + lu(k,2260) = lu(k,2260) - lu(k,1069) * lu(k,2222) + lu(k,2380) = lu(k,2380) - lu(k,1061) * lu(k,2379) + lu(k,2381) = lu(k,2381) - lu(k,1062) * lu(k,2379) + lu(k,2407) = lu(k,2407) - lu(k,1063) * lu(k,2379) + lu(k,2408) = lu(k,2408) - lu(k,1064) * lu(k,2379) + lu(k,2411) = - lu(k,1065) * lu(k,2379) + lu(k,2412) = lu(k,2412) - lu(k,1066) * lu(k,2379) + lu(k,2414) = lu(k,2414) - lu(k,1067) * lu(k,2379) + lu(k,2415) = lu(k,2415) - lu(k,1068) * lu(k,2379) + lu(k,2418) = lu(k,2418) - lu(k,1069) * lu(k,2379) + lu(k,1070) = 1._r8 / lu(k,1070) + lu(k,1071) = lu(k,1071) * lu(k,1070) + lu(k,1072) = lu(k,1072) * lu(k,1070) + lu(k,1073) = lu(k,1073) * lu(k,1070) + lu(k,1074) = lu(k,1074) * lu(k,1070) + lu(k,1075) = lu(k,1075) * lu(k,1070) + lu(k,1076) = lu(k,1076) * lu(k,1070) + lu(k,1077) = lu(k,1077) * lu(k,1070) + lu(k,1088) = lu(k,1088) - lu(k,1071) * lu(k,1087) + lu(k,1089) = - lu(k,1072) * lu(k,1087) + lu(k,1090) = - lu(k,1073) * lu(k,1087) + lu(k,1091) = - lu(k,1074) * lu(k,1087) + lu(k,1092) = lu(k,1092) - lu(k,1075) * lu(k,1087) + lu(k,1094) = lu(k,1094) - lu(k,1076) * lu(k,1087) + lu(k,1097) = lu(k,1097) - lu(k,1077) * lu(k,1087) + lu(k,1769) = lu(k,1769) - lu(k,1071) * lu(k,1767) + lu(k,1770) = lu(k,1770) - lu(k,1072) * lu(k,1767) + lu(k,1774) = lu(k,1774) - lu(k,1073) * lu(k,1767) + lu(k,1776) = lu(k,1776) - lu(k,1074) * lu(k,1767) + lu(k,1799) = lu(k,1799) - lu(k,1075) * lu(k,1767) + lu(k,1801) = lu(k,1801) - lu(k,1076) * lu(k,1767) + lu(k,1806) = lu(k,1806) - lu(k,1077) * lu(k,1767) + lu(k,1876) = lu(k,1876) - lu(k,1071) * lu(k,1874) + lu(k,1877) = lu(k,1877) - lu(k,1072) * lu(k,1874) + lu(k,1881) = lu(k,1881) - lu(k,1073) * lu(k,1874) + lu(k,1883) = lu(k,1883) - lu(k,1074) * lu(k,1874) + lu(k,1904) = lu(k,1904) - lu(k,1075) * lu(k,1874) + lu(k,1906) = lu(k,1906) - lu(k,1076) * lu(k,1874) + lu(k,1911) = lu(k,1911) - lu(k,1077) * lu(k,1874) + lu(k,2042) = lu(k,2042) - lu(k,1071) * lu(k,2040) + lu(k,2043) = lu(k,2043) - lu(k,1072) * lu(k,2040) + lu(k,2046) = lu(k,2046) - lu(k,1073) * lu(k,2040) + lu(k,2048) = lu(k,2048) - lu(k,1074) * lu(k,2040) + lu(k,2068) = lu(k,2068) - lu(k,1075) * lu(k,2040) + lu(k,2070) = lu(k,2070) - lu(k,1076) * lu(k,2040) + lu(k,2075) = lu(k,2075) - lu(k,1077) * lu(k,2040) + lu(k,2171) = lu(k,2171) - lu(k,1071) * lu(k,2169) + lu(k,2172) = lu(k,2172) - lu(k,1072) * lu(k,2169) + lu(k,2174) = lu(k,2174) - lu(k,1073) * lu(k,2169) + lu(k,2176) = lu(k,2176) - lu(k,1074) * lu(k,2169) + lu(k,2197) = lu(k,2197) - lu(k,1075) * lu(k,2169) + lu(k,2199) = lu(k,2199) - lu(k,1076) * lu(k,2169) + lu(k,2204) = lu(k,2204) - lu(k,1077) * lu(k,2169) + lu(k,2225) = lu(k,2225) - lu(k,1071) * lu(k,2223) + lu(k,2226) = lu(k,2226) - lu(k,1072) * lu(k,2223) + lu(k,2229) = lu(k,2229) - lu(k,1073) * lu(k,2223) + lu(k,2231) = lu(k,2231) - lu(k,1074) * lu(k,2223) + lu(k,2249) = lu(k,2249) - lu(k,1075) * lu(k,2223) + lu(k,2251) = - lu(k,1076) * lu(k,2223) + lu(k,2256) = lu(k,2256) - lu(k,1077) * lu(k,2223) + lu(k,2382) = lu(k,2382) - lu(k,1071) * lu(k,2380) + lu(k,2383) = lu(k,2383) - lu(k,1072) * lu(k,2380) + lu(k,2386) = lu(k,2386) - lu(k,1073) * lu(k,2380) + lu(k,2388) = - lu(k,1074) * lu(k,2380) + lu(k,2407) = lu(k,2407) - lu(k,1075) * lu(k,2380) + lu(k,2409) = lu(k,2409) - lu(k,1076) * lu(k,2380) + lu(k,2414) = lu(k,2414) - lu(k,1077) * lu(k,2380) end do end subroutine lu_fac22 subroutine lu_fac23( avec_len, lu ) @@ -4550,410 +4055,291 @@ subroutine lu_fac23( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1076) = 1._r8 / lu(k,1076) - lu(k,1077) = lu(k,1077) * lu(k,1076) - lu(k,1078) = lu(k,1078) * lu(k,1076) - lu(k,1079) = lu(k,1079) * lu(k,1076) - lu(k,1080) = lu(k,1080) * lu(k,1076) - lu(k,1081) = lu(k,1081) * lu(k,1076) - lu(k,1082) = lu(k,1082) * lu(k,1076) - lu(k,1083) = lu(k,1083) * lu(k,1076) - lu(k,1084) = lu(k,1084) * lu(k,1076) - lu(k,1176) = lu(k,1176) - lu(k,1077) * lu(k,1168) - lu(k,1177) = lu(k,1177) - lu(k,1078) * lu(k,1168) - lu(k,1179) = lu(k,1179) - lu(k,1079) * lu(k,1168) - lu(k,1182) = lu(k,1182) - lu(k,1080) * lu(k,1168) - lu(k,1183) = lu(k,1183) - lu(k,1081) * lu(k,1168) - lu(k,1184) = lu(k,1184) - lu(k,1082) * lu(k,1168) - lu(k,1186) = lu(k,1186) - lu(k,1083) * lu(k,1168) - lu(k,1187) = lu(k,1187) - lu(k,1084) * lu(k,1168) - lu(k,1210) = lu(k,1210) - lu(k,1077) * lu(k,1202) - lu(k,1211) = lu(k,1211) - lu(k,1078) * lu(k,1202) - lu(k,1213) = lu(k,1213) - lu(k,1079) * lu(k,1202) - lu(k,1216) = lu(k,1216) - lu(k,1080) * lu(k,1202) - lu(k,1217) = lu(k,1217) - lu(k,1081) * lu(k,1202) - lu(k,1218) = lu(k,1218) - lu(k,1082) * lu(k,1202) - lu(k,1220) = lu(k,1220) - lu(k,1083) * lu(k,1202) - lu(k,1221) = lu(k,1221) - lu(k,1084) * lu(k,1202) - lu(k,1233) = lu(k,1233) - lu(k,1077) * lu(k,1229) - lu(k,1234) = lu(k,1234) - lu(k,1078) * lu(k,1229) - lu(k,1236) = lu(k,1236) - lu(k,1079) * lu(k,1229) - lu(k,1238) = lu(k,1238) - lu(k,1080) * lu(k,1229) - lu(k,1239) = lu(k,1239) - lu(k,1081) * lu(k,1229) - lu(k,1240) = lu(k,1240) - lu(k,1082) * lu(k,1229) - lu(k,1242) = lu(k,1242) - lu(k,1083) * lu(k,1229) - lu(k,1243) = lu(k,1243) - lu(k,1084) * lu(k,1229) - lu(k,1253) = lu(k,1253) - lu(k,1077) * lu(k,1248) - lu(k,1254) = lu(k,1254) - lu(k,1078) * lu(k,1248) - lu(k,1257) = lu(k,1257) - lu(k,1079) * lu(k,1248) - lu(k,1260) = lu(k,1260) - lu(k,1080) * lu(k,1248) - lu(k,1261) = lu(k,1261) - lu(k,1081) * lu(k,1248) - lu(k,1262) = - lu(k,1082) * lu(k,1248) - lu(k,1264) = lu(k,1264) - lu(k,1083) * lu(k,1248) - lu(k,1265) = lu(k,1265) - lu(k,1084) * lu(k,1248) - lu(k,1395) = lu(k,1395) - lu(k,1077) * lu(k,1385) - lu(k,1396) = lu(k,1396) - lu(k,1078) * lu(k,1385) - lu(k,1400) = lu(k,1400) - lu(k,1079) * lu(k,1385) - lu(k,1403) = lu(k,1403) - lu(k,1080) * lu(k,1385) - lu(k,1404) = lu(k,1404) - lu(k,1081) * lu(k,1385) - lu(k,1405) = lu(k,1405) - lu(k,1082) * lu(k,1385) - lu(k,1407) = lu(k,1407) - lu(k,1083) * lu(k,1385) - lu(k,1409) = lu(k,1409) - lu(k,1084) * lu(k,1385) - lu(k,1503) = lu(k,1503) - lu(k,1077) * lu(k,1493) - lu(k,1505) = lu(k,1505) - lu(k,1078) * lu(k,1493) - lu(k,1510) = lu(k,1510) - lu(k,1079) * lu(k,1493) - lu(k,1514) = lu(k,1514) - lu(k,1080) * lu(k,1493) - lu(k,1515) = lu(k,1515) - lu(k,1081) * lu(k,1493) - lu(k,1516) = lu(k,1516) - lu(k,1082) * lu(k,1493) - lu(k,1519) = lu(k,1519) - lu(k,1083) * lu(k,1493) - lu(k,1521) = lu(k,1521) - lu(k,1084) * lu(k,1493) - lu(k,1537) = - lu(k,1077) * lu(k,1535) - lu(k,1540) = lu(k,1540) - lu(k,1078) * lu(k,1535) - lu(k,1545) = lu(k,1545) - lu(k,1079) * lu(k,1535) - lu(k,1549) = lu(k,1549) - lu(k,1080) * lu(k,1535) - lu(k,1550) = lu(k,1550) - lu(k,1081) * lu(k,1535) - lu(k,1551) = lu(k,1551) - lu(k,1082) * lu(k,1535) - lu(k,1554) = lu(k,1554) - lu(k,1083) * lu(k,1535) - lu(k,1556) = lu(k,1556) - lu(k,1084) * lu(k,1535) - lu(k,1710) = lu(k,1710) - lu(k,1077) * lu(k,1699) - lu(k,1714) = lu(k,1714) - lu(k,1078) * lu(k,1699) - lu(k,1719) = lu(k,1719) - lu(k,1079) * lu(k,1699) - lu(k,1723) = lu(k,1723) - lu(k,1080) * lu(k,1699) - lu(k,1724) = lu(k,1724) - lu(k,1081) * lu(k,1699) - lu(k,1725) = lu(k,1725) - lu(k,1082) * lu(k,1699) - lu(k,1728) = lu(k,1728) - lu(k,1083) * lu(k,1699) - lu(k,1730) = lu(k,1730) - lu(k,1084) * lu(k,1699) - lu(k,1773) = lu(k,1773) - lu(k,1077) * lu(k,1764) - lu(k,1776) = lu(k,1776) - lu(k,1078) * lu(k,1764) - lu(k,1781) = lu(k,1781) - lu(k,1079) * lu(k,1764) - lu(k,1785) = lu(k,1785) - lu(k,1080) * lu(k,1764) - lu(k,1786) = lu(k,1786) - lu(k,1081) * lu(k,1764) - lu(k,1787) = lu(k,1787) - lu(k,1082) * lu(k,1764) - lu(k,1790) = lu(k,1790) - lu(k,1083) * lu(k,1764) - lu(k,1792) = lu(k,1792) - lu(k,1084) * lu(k,1764) - lu(k,1895) = lu(k,1895) - lu(k,1077) * lu(k,1885) - lu(k,1898) = lu(k,1898) - lu(k,1078) * lu(k,1885) - lu(k,1903) = lu(k,1903) - lu(k,1079) * lu(k,1885) - lu(k,1907) = lu(k,1907) - lu(k,1080) * lu(k,1885) - lu(k,1908) = lu(k,1908) - lu(k,1081) * lu(k,1885) - lu(k,1909) = lu(k,1909) - lu(k,1082) * lu(k,1885) - lu(k,1912) = lu(k,1912) - lu(k,1083) * lu(k,1885) - lu(k,1914) = lu(k,1914) - lu(k,1084) * lu(k,1885) - lu(k,2098) = lu(k,2098) - lu(k,1077) * lu(k,2087) - lu(k,2101) = lu(k,2101) - lu(k,1078) * lu(k,2087) - lu(k,2106) = lu(k,2106) - lu(k,1079) * lu(k,2087) - lu(k,2110) = lu(k,2110) - lu(k,1080) * lu(k,2087) - lu(k,2111) = lu(k,2111) - lu(k,1081) * lu(k,2087) - lu(k,2112) = lu(k,2112) - lu(k,1082) * lu(k,2087) - lu(k,2115) = lu(k,2115) - lu(k,1083) * lu(k,2087) - lu(k,2117) = lu(k,2117) - lu(k,1084) * lu(k,2087) - lu(k,1091) = 1._r8 / lu(k,1091) - lu(k,1092) = lu(k,1092) * lu(k,1091) - lu(k,1093) = lu(k,1093) * lu(k,1091) - lu(k,1094) = lu(k,1094) * lu(k,1091) - lu(k,1095) = lu(k,1095) * lu(k,1091) - lu(k,1096) = lu(k,1096) * lu(k,1091) - lu(k,1097) = lu(k,1097) * lu(k,1091) - lu(k,1098) = lu(k,1098) * lu(k,1091) - lu(k,1099) = lu(k,1099) * lu(k,1091) - lu(k,1100) = lu(k,1100) * lu(k,1091) - lu(k,1101) = lu(k,1101) * lu(k,1091) - lu(k,1126) = lu(k,1126) - lu(k,1092) * lu(k,1123) - lu(k,1128) = lu(k,1128) - lu(k,1093) * lu(k,1123) - lu(k,1129) = lu(k,1129) - lu(k,1094) * lu(k,1123) - lu(k,1130) = lu(k,1130) - lu(k,1095) * lu(k,1123) - lu(k,1131) = lu(k,1131) - lu(k,1096) * lu(k,1123) - lu(k,1132) = lu(k,1132) - lu(k,1097) * lu(k,1123) - lu(k,1133) = lu(k,1133) - lu(k,1098) * lu(k,1123) - lu(k,1134) = lu(k,1134) - lu(k,1099) * lu(k,1123) - lu(k,1136) = lu(k,1136) - lu(k,1100) * lu(k,1123) - lu(k,1137) = lu(k,1137) - lu(k,1101) * lu(k,1123) - lu(k,1171) = lu(k,1171) - lu(k,1092) * lu(k,1169) - lu(k,1176) = lu(k,1176) - lu(k,1093) * lu(k,1169) - lu(k,1177) = lu(k,1177) - lu(k,1094) * lu(k,1169) - lu(k,1178) = lu(k,1178) - lu(k,1095) * lu(k,1169) - lu(k,1179) = lu(k,1179) - lu(k,1096) * lu(k,1169) - lu(k,1181) = lu(k,1181) - lu(k,1097) * lu(k,1169) - lu(k,1182) = lu(k,1182) - lu(k,1098) * lu(k,1169) - lu(k,1183) = lu(k,1183) - lu(k,1099) * lu(k,1169) - lu(k,1185) = lu(k,1185) - lu(k,1100) * lu(k,1169) - lu(k,1186) = lu(k,1186) - lu(k,1101) * lu(k,1169) - lu(k,1205) = lu(k,1205) - lu(k,1092) * lu(k,1203) - lu(k,1210) = lu(k,1210) - lu(k,1093) * lu(k,1203) - lu(k,1211) = lu(k,1211) - lu(k,1094) * lu(k,1203) - lu(k,1212) = lu(k,1212) - lu(k,1095) * lu(k,1203) - lu(k,1213) = lu(k,1213) - lu(k,1096) * lu(k,1203) - lu(k,1215) = lu(k,1215) - lu(k,1097) * lu(k,1203) - lu(k,1216) = lu(k,1216) - lu(k,1098) * lu(k,1203) - lu(k,1217) = lu(k,1217) - lu(k,1099) * lu(k,1203) - lu(k,1219) = lu(k,1219) - lu(k,1100) * lu(k,1203) - lu(k,1220) = lu(k,1220) - lu(k,1101) * lu(k,1203) - lu(k,1296) = lu(k,1296) - lu(k,1092) * lu(k,1293) - lu(k,1302) = lu(k,1302) - lu(k,1093) * lu(k,1293) - lu(k,1303) = lu(k,1303) - lu(k,1094) * lu(k,1293) - lu(k,1305) = lu(k,1305) - lu(k,1095) * lu(k,1293) - lu(k,1306) = lu(k,1306) - lu(k,1096) * lu(k,1293) - lu(k,1308) = lu(k,1308) - lu(k,1097) * lu(k,1293) - lu(k,1309) = lu(k,1309) - lu(k,1098) * lu(k,1293) - lu(k,1310) = lu(k,1310) - lu(k,1099) * lu(k,1293) - lu(k,1312) = lu(k,1312) - lu(k,1100) * lu(k,1293) - lu(k,1313) = lu(k,1313) - lu(k,1101) * lu(k,1293) - lu(k,1389) = lu(k,1389) - lu(k,1092) * lu(k,1386) - lu(k,1395) = lu(k,1395) - lu(k,1093) * lu(k,1386) - lu(k,1396) = lu(k,1396) - lu(k,1094) * lu(k,1386) - lu(k,1398) = lu(k,1398) - lu(k,1095) * lu(k,1386) - lu(k,1400) = lu(k,1400) - lu(k,1096) * lu(k,1386) - lu(k,1402) = lu(k,1402) - lu(k,1097) * lu(k,1386) - lu(k,1403) = lu(k,1403) - lu(k,1098) * lu(k,1386) - lu(k,1404) = lu(k,1404) - lu(k,1099) * lu(k,1386) - lu(k,1406) = lu(k,1406) - lu(k,1100) * lu(k,1386) - lu(k,1407) = lu(k,1407) - lu(k,1101) * lu(k,1386) - lu(k,1497) = lu(k,1497) - lu(k,1092) * lu(k,1494) - lu(k,1503) = lu(k,1503) - lu(k,1093) * lu(k,1494) - lu(k,1505) = lu(k,1505) - lu(k,1094) * lu(k,1494) - lu(k,1507) = lu(k,1507) - lu(k,1095) * lu(k,1494) - lu(k,1510) = lu(k,1510) - lu(k,1096) * lu(k,1494) - lu(k,1513) = lu(k,1513) - lu(k,1097) * lu(k,1494) - lu(k,1514) = lu(k,1514) - lu(k,1098) * lu(k,1494) - lu(k,1515) = lu(k,1515) - lu(k,1099) * lu(k,1494) - lu(k,1517) = lu(k,1517) - lu(k,1100) * lu(k,1494) - lu(k,1519) = lu(k,1519) - lu(k,1101) * lu(k,1494) - lu(k,1704) = lu(k,1704) - lu(k,1092) * lu(k,1700) - lu(k,1710) = lu(k,1710) - lu(k,1093) * lu(k,1700) - lu(k,1714) = lu(k,1714) - lu(k,1094) * lu(k,1700) - lu(k,1716) = lu(k,1716) - lu(k,1095) * lu(k,1700) - lu(k,1719) = lu(k,1719) - lu(k,1096) * lu(k,1700) - lu(k,1722) = lu(k,1722) - lu(k,1097) * lu(k,1700) - lu(k,1723) = lu(k,1723) - lu(k,1098) * lu(k,1700) - lu(k,1724) = lu(k,1724) - lu(k,1099) * lu(k,1700) - lu(k,1726) = lu(k,1726) - lu(k,1100) * lu(k,1700) - lu(k,1728) = lu(k,1728) - lu(k,1101) * lu(k,1700) - lu(k,1889) = lu(k,1889) - lu(k,1092) * lu(k,1886) - lu(k,1895) = lu(k,1895) - lu(k,1093) * lu(k,1886) - lu(k,1898) = lu(k,1898) - lu(k,1094) * lu(k,1886) - lu(k,1900) = lu(k,1900) - lu(k,1095) * lu(k,1886) - lu(k,1903) = lu(k,1903) - lu(k,1096) * lu(k,1886) - lu(k,1906) = lu(k,1906) - lu(k,1097) * lu(k,1886) - lu(k,1907) = lu(k,1907) - lu(k,1098) * lu(k,1886) - lu(k,1908) = lu(k,1908) - lu(k,1099) * lu(k,1886) - lu(k,1910) = lu(k,1910) - lu(k,1100) * lu(k,1886) - lu(k,1912) = lu(k,1912) - lu(k,1101) * lu(k,1886) - lu(k,2092) = lu(k,2092) - lu(k,1092) * lu(k,2088) - lu(k,2098) = lu(k,2098) - lu(k,1093) * lu(k,2088) - lu(k,2101) = lu(k,2101) - lu(k,1094) * lu(k,2088) - lu(k,2103) = lu(k,2103) - lu(k,1095) * lu(k,2088) - lu(k,2106) = lu(k,2106) - lu(k,1096) * lu(k,2088) - lu(k,2109) = lu(k,2109) - lu(k,1097) * lu(k,2088) - lu(k,2110) = lu(k,2110) - lu(k,1098) * lu(k,2088) - lu(k,2111) = lu(k,2111) - lu(k,1099) * lu(k,2088) - lu(k,2113) = lu(k,2113) - lu(k,1100) * lu(k,2088) - lu(k,2115) = lu(k,2115) - lu(k,1101) * lu(k,2088) - lu(k,1104) = 1._r8 / lu(k,1104) - lu(k,1105) = lu(k,1105) * lu(k,1104) - lu(k,1106) = lu(k,1106) * lu(k,1104) - lu(k,1107) = lu(k,1107) * lu(k,1104) - lu(k,1108) = lu(k,1108) * lu(k,1104) - lu(k,1109) = lu(k,1109) * lu(k,1104) - lu(k,1110) = lu(k,1110) * lu(k,1104) - lu(k,1111) = lu(k,1111) * lu(k,1104) - lu(k,1112) = lu(k,1112) * lu(k,1104) - lu(k,1113) = lu(k,1113) * lu(k,1104) - lu(k,1114) = lu(k,1114) * lu(k,1104) - lu(k,1538) = lu(k,1538) - lu(k,1105) * lu(k,1536) - lu(k,1540) = lu(k,1540) - lu(k,1106) * lu(k,1536) - lu(k,1543) = lu(k,1543) - lu(k,1107) * lu(k,1536) - lu(k,1544) = - lu(k,1108) * lu(k,1536) - lu(k,1545) = lu(k,1545) - lu(k,1109) * lu(k,1536) - lu(k,1547) = lu(k,1547) - lu(k,1110) * lu(k,1536) - lu(k,1549) = lu(k,1549) - lu(k,1111) * lu(k,1536) - lu(k,1550) = lu(k,1550) - lu(k,1112) * lu(k,1536) - lu(k,1551) = lu(k,1551) - lu(k,1113) * lu(k,1536) - lu(k,1556) = lu(k,1556) - lu(k,1114) * lu(k,1536) - lu(k,1564) = lu(k,1564) - lu(k,1105) * lu(k,1563) - lu(k,1566) = lu(k,1566) - lu(k,1106) * lu(k,1563) - lu(k,1569) = lu(k,1569) - lu(k,1107) * lu(k,1563) - lu(k,1570) = lu(k,1570) - lu(k,1108) * lu(k,1563) - lu(k,1571) = lu(k,1571) - lu(k,1109) * lu(k,1563) - lu(k,1573) = lu(k,1573) - lu(k,1110) * lu(k,1563) - lu(k,1575) = lu(k,1575) - lu(k,1111) * lu(k,1563) - lu(k,1576) = lu(k,1576) - lu(k,1112) * lu(k,1563) - lu(k,1577) = lu(k,1577) - lu(k,1113) * lu(k,1563) - lu(k,1582) = lu(k,1582) - lu(k,1114) * lu(k,1563) - lu(k,1712) = lu(k,1712) - lu(k,1105) * lu(k,1701) - lu(k,1714) = lu(k,1714) - lu(k,1106) * lu(k,1701) - lu(k,1717) = lu(k,1717) - lu(k,1107) * lu(k,1701) - lu(k,1718) = lu(k,1718) - lu(k,1108) * lu(k,1701) - lu(k,1719) = lu(k,1719) - lu(k,1109) * lu(k,1701) - lu(k,1721) = lu(k,1721) - lu(k,1110) * lu(k,1701) - lu(k,1723) = lu(k,1723) - lu(k,1111) * lu(k,1701) - lu(k,1724) = lu(k,1724) - lu(k,1112) * lu(k,1701) - lu(k,1725) = lu(k,1725) - lu(k,1113) * lu(k,1701) - lu(k,1730) = lu(k,1730) - lu(k,1114) * lu(k,1701) - lu(k,1815) = lu(k,1815) - lu(k,1105) * lu(k,1813) - lu(k,1817) = - lu(k,1106) * lu(k,1813) - lu(k,1820) = lu(k,1820) - lu(k,1107) * lu(k,1813) - lu(k,1821) = lu(k,1821) - lu(k,1108) * lu(k,1813) - lu(k,1822) = lu(k,1822) - lu(k,1109) * lu(k,1813) - lu(k,1824) = lu(k,1824) - lu(k,1110) * lu(k,1813) - lu(k,1826) = lu(k,1826) - lu(k,1111) * lu(k,1813) - lu(k,1827) = lu(k,1827) - lu(k,1112) * lu(k,1813) - lu(k,1828) = lu(k,1828) - lu(k,1113) * lu(k,1813) - lu(k,1833) = lu(k,1833) - lu(k,1114) * lu(k,1813) - lu(k,1839) = lu(k,1839) - lu(k,1105) * lu(k,1838) - lu(k,1841) = - lu(k,1106) * lu(k,1838) - lu(k,1844) = lu(k,1844) - lu(k,1107) * lu(k,1838) - lu(k,1845) = lu(k,1845) - lu(k,1108) * lu(k,1838) - lu(k,1846) = lu(k,1846) - lu(k,1109) * lu(k,1838) - lu(k,1848) = lu(k,1848) - lu(k,1110) * lu(k,1838) - lu(k,1850) = lu(k,1850) - lu(k,1111) * lu(k,1838) - lu(k,1851) = lu(k,1851) - lu(k,1112) * lu(k,1838) - lu(k,1852) = lu(k,1852) - lu(k,1113) * lu(k,1838) - lu(k,1857) = lu(k,1857) - lu(k,1114) * lu(k,1838) - lu(k,1916) = - lu(k,1105) * lu(k,1915) - lu(k,1918) = - lu(k,1106) * lu(k,1915) - lu(k,1921) = - lu(k,1107) * lu(k,1915) - lu(k,1922) = - lu(k,1108) * lu(k,1915) - lu(k,1923) = lu(k,1923) - lu(k,1109) * lu(k,1915) - lu(k,1925) = lu(k,1925) - lu(k,1110) * lu(k,1915) - lu(k,1927) = - lu(k,1111) * lu(k,1915) - lu(k,1928) = lu(k,1928) - lu(k,1112) * lu(k,1915) - lu(k,1929) = - lu(k,1113) * lu(k,1915) - lu(k,1934) = lu(k,1934) - lu(k,1114) * lu(k,1915) - lu(k,1938) = - lu(k,1105) * lu(k,1937) - lu(k,1940) = lu(k,1940) - lu(k,1106) * lu(k,1937) - lu(k,1943) = - lu(k,1107) * lu(k,1937) - lu(k,1944) = - lu(k,1108) * lu(k,1937) - lu(k,1945) = lu(k,1945) - lu(k,1109) * lu(k,1937) - lu(k,1947) = - lu(k,1110) * lu(k,1937) - lu(k,1949) = lu(k,1949) - lu(k,1111) * lu(k,1937) - lu(k,1950) = lu(k,1950) - lu(k,1112) * lu(k,1937) - lu(k,1951) = lu(k,1951) - lu(k,1113) * lu(k,1937) - lu(k,1956) = lu(k,1956) - lu(k,1114) * lu(k,1937) - lu(k,2099) = lu(k,2099) - lu(k,1105) * lu(k,2089) - lu(k,2101) = lu(k,2101) - lu(k,1106) * lu(k,2089) - lu(k,2104) = lu(k,2104) - lu(k,1107) * lu(k,2089) - lu(k,2105) = lu(k,2105) - lu(k,1108) * lu(k,2089) - lu(k,2106) = lu(k,2106) - lu(k,1109) * lu(k,2089) - lu(k,2108) = lu(k,2108) - lu(k,1110) * lu(k,2089) - lu(k,2110) = lu(k,2110) - lu(k,1111) * lu(k,2089) - lu(k,2111) = lu(k,2111) - lu(k,1112) * lu(k,2089) - lu(k,2112) = lu(k,2112) - lu(k,1113) * lu(k,2089) - lu(k,2117) = lu(k,2117) - lu(k,1114) * lu(k,2089) - lu(k,2152) = - lu(k,1105) * lu(k,2150) - lu(k,2154) = lu(k,2154) - lu(k,1106) * lu(k,2150) - lu(k,2157) = - lu(k,1107) * lu(k,2150) - lu(k,2158) = lu(k,2158) - lu(k,1108) * lu(k,2150) - lu(k,2159) = lu(k,2159) - lu(k,1109) * lu(k,2150) - lu(k,2161) = lu(k,2161) - lu(k,1110) * lu(k,2150) - lu(k,2163) = lu(k,2163) - lu(k,1111) * lu(k,2150) - lu(k,2164) = lu(k,2164) - lu(k,1112) * lu(k,2150) - lu(k,2165) = lu(k,2165) - lu(k,1113) * lu(k,2150) - lu(k,2170) = lu(k,2170) - lu(k,1114) * lu(k,2150) - lu(k,1124) = 1._r8 / lu(k,1124) - lu(k,1125) = lu(k,1125) * lu(k,1124) - lu(k,1126) = lu(k,1126) * lu(k,1124) - lu(k,1127) = lu(k,1127) * lu(k,1124) - lu(k,1128) = lu(k,1128) * lu(k,1124) - lu(k,1129) = lu(k,1129) * lu(k,1124) - lu(k,1130) = lu(k,1130) * lu(k,1124) - lu(k,1131) = lu(k,1131) * lu(k,1124) - lu(k,1132) = lu(k,1132) * lu(k,1124) - lu(k,1133) = lu(k,1133) * lu(k,1124) - lu(k,1134) = lu(k,1134) * lu(k,1124) - lu(k,1135) = lu(k,1135) * lu(k,1124) - lu(k,1136) = lu(k,1136) * lu(k,1124) - lu(k,1137) = lu(k,1137) * lu(k,1124) - lu(k,1295) = lu(k,1295) - lu(k,1125) * lu(k,1294) - lu(k,1296) = lu(k,1296) - lu(k,1126) * lu(k,1294) - lu(k,1300) = lu(k,1300) - lu(k,1127) * lu(k,1294) - lu(k,1302) = lu(k,1302) - lu(k,1128) * lu(k,1294) - lu(k,1303) = lu(k,1303) - lu(k,1129) * lu(k,1294) - lu(k,1305) = lu(k,1305) - lu(k,1130) * lu(k,1294) - lu(k,1306) = lu(k,1306) - lu(k,1131) * lu(k,1294) - lu(k,1308) = lu(k,1308) - lu(k,1132) * lu(k,1294) - lu(k,1309) = lu(k,1309) - lu(k,1133) * lu(k,1294) - lu(k,1310) = lu(k,1310) - lu(k,1134) * lu(k,1294) - lu(k,1311) = lu(k,1311) - lu(k,1135) * lu(k,1294) - lu(k,1312) = lu(k,1312) - lu(k,1136) * lu(k,1294) - lu(k,1313) = lu(k,1313) - lu(k,1137) * lu(k,1294) - lu(k,1388) = lu(k,1388) - lu(k,1125) * lu(k,1387) - lu(k,1389) = lu(k,1389) - lu(k,1126) * lu(k,1387) - lu(k,1393) = lu(k,1393) - lu(k,1127) * lu(k,1387) - lu(k,1395) = lu(k,1395) - lu(k,1128) * lu(k,1387) - lu(k,1396) = lu(k,1396) - lu(k,1129) * lu(k,1387) - lu(k,1398) = lu(k,1398) - lu(k,1130) * lu(k,1387) - lu(k,1400) = lu(k,1400) - lu(k,1131) * lu(k,1387) - lu(k,1402) = lu(k,1402) - lu(k,1132) * lu(k,1387) - lu(k,1403) = lu(k,1403) - lu(k,1133) * lu(k,1387) - lu(k,1404) = lu(k,1404) - lu(k,1134) * lu(k,1387) - lu(k,1405) = lu(k,1405) - lu(k,1135) * lu(k,1387) - lu(k,1406) = lu(k,1406) - lu(k,1136) * lu(k,1387) - lu(k,1407) = lu(k,1407) - lu(k,1137) * lu(k,1387) - lu(k,1496) = lu(k,1496) - lu(k,1125) * lu(k,1495) - lu(k,1497) = lu(k,1497) - lu(k,1126) * lu(k,1495) - lu(k,1501) = lu(k,1501) - lu(k,1127) * lu(k,1495) - lu(k,1503) = lu(k,1503) - lu(k,1128) * lu(k,1495) - lu(k,1505) = lu(k,1505) - lu(k,1129) * lu(k,1495) - lu(k,1507) = lu(k,1507) - lu(k,1130) * lu(k,1495) - lu(k,1510) = lu(k,1510) - lu(k,1131) * lu(k,1495) - lu(k,1513) = lu(k,1513) - lu(k,1132) * lu(k,1495) - lu(k,1514) = lu(k,1514) - lu(k,1133) * lu(k,1495) - lu(k,1515) = lu(k,1515) - lu(k,1134) * lu(k,1495) - lu(k,1516) = lu(k,1516) - lu(k,1135) * lu(k,1495) - lu(k,1517) = lu(k,1517) - lu(k,1136) * lu(k,1495) - lu(k,1519) = lu(k,1519) - lu(k,1137) * lu(k,1495) - lu(k,1703) = lu(k,1703) - lu(k,1125) * lu(k,1702) - lu(k,1704) = lu(k,1704) - lu(k,1126) * lu(k,1702) - lu(k,1708) = lu(k,1708) - lu(k,1127) * lu(k,1702) - lu(k,1710) = lu(k,1710) - lu(k,1128) * lu(k,1702) - lu(k,1714) = lu(k,1714) - lu(k,1129) * lu(k,1702) - lu(k,1716) = lu(k,1716) - lu(k,1130) * lu(k,1702) - lu(k,1719) = lu(k,1719) - lu(k,1131) * lu(k,1702) - lu(k,1722) = lu(k,1722) - lu(k,1132) * lu(k,1702) - lu(k,1723) = lu(k,1723) - lu(k,1133) * lu(k,1702) - lu(k,1724) = lu(k,1724) - lu(k,1134) * lu(k,1702) - lu(k,1725) = lu(k,1725) - lu(k,1135) * lu(k,1702) - lu(k,1726) = lu(k,1726) - lu(k,1136) * lu(k,1702) - lu(k,1728) = lu(k,1728) - lu(k,1137) * lu(k,1702) - lu(k,1766) = lu(k,1766) - lu(k,1125) * lu(k,1765) - lu(k,1767) = lu(k,1767) - lu(k,1126) * lu(k,1765) - lu(k,1771) = lu(k,1771) - lu(k,1127) * lu(k,1765) - lu(k,1773) = lu(k,1773) - lu(k,1128) * lu(k,1765) - lu(k,1776) = lu(k,1776) - lu(k,1129) * lu(k,1765) - lu(k,1778) = lu(k,1778) - lu(k,1130) * lu(k,1765) - lu(k,1781) = lu(k,1781) - lu(k,1131) * lu(k,1765) - lu(k,1784) = lu(k,1784) - lu(k,1132) * lu(k,1765) - lu(k,1785) = lu(k,1785) - lu(k,1133) * lu(k,1765) - lu(k,1786) = lu(k,1786) - lu(k,1134) * lu(k,1765) - lu(k,1787) = lu(k,1787) - lu(k,1135) * lu(k,1765) - lu(k,1788) = lu(k,1788) - lu(k,1136) * lu(k,1765) - lu(k,1790) = lu(k,1790) - lu(k,1137) * lu(k,1765) - lu(k,1888) = lu(k,1888) - lu(k,1125) * lu(k,1887) - lu(k,1889) = lu(k,1889) - lu(k,1126) * lu(k,1887) - lu(k,1893) = lu(k,1893) - lu(k,1127) * lu(k,1887) - lu(k,1895) = lu(k,1895) - lu(k,1128) * lu(k,1887) - lu(k,1898) = lu(k,1898) - lu(k,1129) * lu(k,1887) - lu(k,1900) = lu(k,1900) - lu(k,1130) * lu(k,1887) - lu(k,1903) = lu(k,1903) - lu(k,1131) * lu(k,1887) - lu(k,1906) = lu(k,1906) - lu(k,1132) * lu(k,1887) - lu(k,1907) = lu(k,1907) - lu(k,1133) * lu(k,1887) - lu(k,1908) = lu(k,1908) - lu(k,1134) * lu(k,1887) - lu(k,1909) = lu(k,1909) - lu(k,1135) * lu(k,1887) - lu(k,1910) = lu(k,1910) - lu(k,1136) * lu(k,1887) - lu(k,1912) = lu(k,1912) - lu(k,1137) * lu(k,1887) - lu(k,2091) = lu(k,2091) - lu(k,1125) * lu(k,2090) - lu(k,2092) = lu(k,2092) - lu(k,1126) * lu(k,2090) - lu(k,2096) = lu(k,2096) - lu(k,1127) * lu(k,2090) - lu(k,2098) = lu(k,2098) - lu(k,1128) * lu(k,2090) - lu(k,2101) = lu(k,2101) - lu(k,1129) * lu(k,2090) - lu(k,2103) = lu(k,2103) - lu(k,1130) * lu(k,2090) - lu(k,2106) = lu(k,2106) - lu(k,1131) * lu(k,2090) - lu(k,2109) = lu(k,2109) - lu(k,1132) * lu(k,2090) - lu(k,2110) = lu(k,2110) - lu(k,1133) * lu(k,2090) - lu(k,2111) = lu(k,2111) - lu(k,1134) * lu(k,2090) - lu(k,2112) = lu(k,2112) - lu(k,1135) * lu(k,2090) - lu(k,2113) = lu(k,2113) - lu(k,1136) * lu(k,2090) - lu(k,2115) = lu(k,2115) - lu(k,1137) * lu(k,2090) + lu(k,1078) = 1._r8 / lu(k,1078) + lu(k,1079) = lu(k,1079) * lu(k,1078) + lu(k,1080) = lu(k,1080) * lu(k,1078) + lu(k,1081) = lu(k,1081) * lu(k,1078) + lu(k,1082) = lu(k,1082) * lu(k,1078) + lu(k,1083) = lu(k,1083) * lu(k,1078) + lu(k,1103) = lu(k,1103) - lu(k,1079) * lu(k,1100) + lu(k,1104) = lu(k,1104) - lu(k,1080) * lu(k,1100) + lu(k,1106) = lu(k,1106) - lu(k,1081) * lu(k,1100) + lu(k,1108) = - lu(k,1082) * lu(k,1100) + lu(k,1110) = - lu(k,1083) * lu(k,1100) + lu(k,1177) = - lu(k,1079) * lu(k,1172) + lu(k,1178) = - lu(k,1080) * lu(k,1172) + lu(k,1180) = lu(k,1180) - lu(k,1081) * lu(k,1172) + lu(k,1185) = lu(k,1185) - lu(k,1082) * lu(k,1172) + lu(k,1187) = - lu(k,1083) * lu(k,1172) + lu(k,1195) = - lu(k,1079) * lu(k,1189) + lu(k,1196) = lu(k,1196) - lu(k,1080) * lu(k,1189) + lu(k,1198) = lu(k,1198) - lu(k,1081) * lu(k,1189) + lu(k,1203) = - lu(k,1082) * lu(k,1189) + lu(k,1205) = - lu(k,1083) * lu(k,1189) + lu(k,1779) = lu(k,1779) - lu(k,1079) * lu(k,1768) + lu(k,1789) = lu(k,1789) - lu(k,1080) * lu(k,1768) + lu(k,1799) = lu(k,1799) - lu(k,1081) * lu(k,1768) + lu(k,1807) = lu(k,1807) - lu(k,1082) * lu(k,1768) + lu(k,1812) = lu(k,1812) - lu(k,1083) * lu(k,1768) + lu(k,1886) = lu(k,1886) - lu(k,1079) * lu(k,1875) + lu(k,1896) = lu(k,1896) - lu(k,1080) * lu(k,1875) + lu(k,1904) = lu(k,1904) - lu(k,1081) * lu(k,1875) + lu(k,1912) = lu(k,1912) - lu(k,1082) * lu(k,1875) + lu(k,1917) = lu(k,1917) - lu(k,1083) * lu(k,1875) + lu(k,1939) = - lu(k,1079) * lu(k,1935) + lu(k,1941) = - lu(k,1080) * lu(k,1935) + lu(k,1950) = lu(k,1950) - lu(k,1081) * lu(k,1935) + lu(k,1958) = lu(k,1958) - lu(k,1082) * lu(k,1935) + lu(k,1963) = lu(k,1963) - lu(k,1083) * lu(k,1935) + lu(k,2051) = lu(k,2051) - lu(k,1079) * lu(k,2041) + lu(k,2061) = lu(k,2061) - lu(k,1080) * lu(k,2041) + lu(k,2068) = lu(k,2068) - lu(k,1081) * lu(k,2041) + lu(k,2076) = lu(k,2076) - lu(k,1082) * lu(k,2041) + lu(k,2081) = lu(k,2081) - lu(k,1083) * lu(k,2041) + lu(k,2178) = lu(k,2178) - lu(k,1079) * lu(k,2170) + lu(k,2188) = lu(k,2188) - lu(k,1080) * lu(k,2170) + lu(k,2197) = lu(k,2197) - lu(k,1081) * lu(k,2170) + lu(k,2205) = lu(k,2205) - lu(k,1082) * lu(k,2170) + lu(k,2210) = lu(k,2210) - lu(k,1083) * lu(k,2170) + lu(k,2233) = lu(k,2233) - lu(k,1079) * lu(k,2224) + lu(k,2243) = lu(k,2243) - lu(k,1080) * lu(k,2224) + lu(k,2249) = lu(k,2249) - lu(k,1081) * lu(k,2224) + lu(k,2257) = lu(k,2257) - lu(k,1082) * lu(k,2224) + lu(k,2262) = lu(k,2262) - lu(k,1083) * lu(k,2224) + lu(k,2390) = lu(k,2390) - lu(k,1079) * lu(k,2381) + lu(k,2399) = lu(k,2399) - lu(k,1080) * lu(k,2381) + lu(k,2407) = lu(k,2407) - lu(k,1081) * lu(k,2381) + lu(k,2415) = lu(k,2415) - lu(k,1082) * lu(k,2381) + lu(k,2420) = lu(k,2420) - lu(k,1083) * lu(k,2381) + lu(k,1088) = 1._r8 / lu(k,1088) + lu(k,1089) = lu(k,1089) * lu(k,1088) + lu(k,1090) = lu(k,1090) * lu(k,1088) + lu(k,1091) = lu(k,1091) * lu(k,1088) + lu(k,1092) = lu(k,1092) * lu(k,1088) + lu(k,1093) = lu(k,1093) * lu(k,1088) + lu(k,1094) = lu(k,1094) * lu(k,1088) + lu(k,1095) = lu(k,1095) * lu(k,1088) + lu(k,1096) = lu(k,1096) * lu(k,1088) + lu(k,1097) = lu(k,1097) * lu(k,1088) + lu(k,1098) = lu(k,1098) * lu(k,1088) + lu(k,1099) = lu(k,1099) * lu(k,1088) + lu(k,1770) = lu(k,1770) - lu(k,1089) * lu(k,1769) + lu(k,1774) = lu(k,1774) - lu(k,1090) * lu(k,1769) + lu(k,1776) = lu(k,1776) - lu(k,1091) * lu(k,1769) + lu(k,1799) = lu(k,1799) - lu(k,1092) * lu(k,1769) + lu(k,1800) = lu(k,1800) - lu(k,1093) * lu(k,1769) + lu(k,1801) = lu(k,1801) - lu(k,1094) * lu(k,1769) + lu(k,1803) = lu(k,1803) - lu(k,1095) * lu(k,1769) + lu(k,1804) = lu(k,1804) - lu(k,1096) * lu(k,1769) + lu(k,1806) = lu(k,1806) - lu(k,1097) * lu(k,1769) + lu(k,1807) = lu(k,1807) - lu(k,1098) * lu(k,1769) + lu(k,1810) = lu(k,1810) - lu(k,1099) * lu(k,1769) + lu(k,1877) = lu(k,1877) - lu(k,1089) * lu(k,1876) + lu(k,1881) = lu(k,1881) - lu(k,1090) * lu(k,1876) + lu(k,1883) = lu(k,1883) - lu(k,1091) * lu(k,1876) + lu(k,1904) = lu(k,1904) - lu(k,1092) * lu(k,1876) + lu(k,1905) = lu(k,1905) - lu(k,1093) * lu(k,1876) + lu(k,1906) = lu(k,1906) - lu(k,1094) * lu(k,1876) + lu(k,1908) = lu(k,1908) - lu(k,1095) * lu(k,1876) + lu(k,1909) = lu(k,1909) - lu(k,1096) * lu(k,1876) + lu(k,1911) = lu(k,1911) - lu(k,1097) * lu(k,1876) + lu(k,1912) = lu(k,1912) - lu(k,1098) * lu(k,1876) + lu(k,1915) = lu(k,1915) - lu(k,1099) * lu(k,1876) + lu(k,2043) = lu(k,2043) - lu(k,1089) * lu(k,2042) + lu(k,2046) = lu(k,2046) - lu(k,1090) * lu(k,2042) + lu(k,2048) = lu(k,2048) - lu(k,1091) * lu(k,2042) + lu(k,2068) = lu(k,2068) - lu(k,1092) * lu(k,2042) + lu(k,2069) = lu(k,2069) - lu(k,1093) * lu(k,2042) + lu(k,2070) = lu(k,2070) - lu(k,1094) * lu(k,2042) + lu(k,2072) = lu(k,2072) - lu(k,1095) * lu(k,2042) + lu(k,2073) = lu(k,2073) - lu(k,1096) * lu(k,2042) + lu(k,2075) = lu(k,2075) - lu(k,1097) * lu(k,2042) + lu(k,2076) = lu(k,2076) - lu(k,1098) * lu(k,2042) + lu(k,2079) = lu(k,2079) - lu(k,1099) * lu(k,2042) + lu(k,2172) = lu(k,2172) - lu(k,1089) * lu(k,2171) + lu(k,2174) = lu(k,2174) - lu(k,1090) * lu(k,2171) + lu(k,2176) = lu(k,2176) - lu(k,1091) * lu(k,2171) + lu(k,2197) = lu(k,2197) - lu(k,1092) * lu(k,2171) + lu(k,2198) = lu(k,2198) - lu(k,1093) * lu(k,2171) + lu(k,2199) = lu(k,2199) - lu(k,1094) * lu(k,2171) + lu(k,2201) = lu(k,2201) - lu(k,1095) * lu(k,2171) + lu(k,2202) = lu(k,2202) - lu(k,1096) * lu(k,2171) + lu(k,2204) = lu(k,2204) - lu(k,1097) * lu(k,2171) + lu(k,2205) = lu(k,2205) - lu(k,1098) * lu(k,2171) + lu(k,2208) = lu(k,2208) - lu(k,1099) * lu(k,2171) + lu(k,2226) = lu(k,2226) - lu(k,1089) * lu(k,2225) + lu(k,2229) = lu(k,2229) - lu(k,1090) * lu(k,2225) + lu(k,2231) = lu(k,2231) - lu(k,1091) * lu(k,2225) + lu(k,2249) = lu(k,2249) - lu(k,1092) * lu(k,2225) + lu(k,2250) = lu(k,2250) - lu(k,1093) * lu(k,2225) + lu(k,2251) = lu(k,2251) - lu(k,1094) * lu(k,2225) + lu(k,2253) = lu(k,2253) - lu(k,1095) * lu(k,2225) + lu(k,2254) = lu(k,2254) - lu(k,1096) * lu(k,2225) + lu(k,2256) = lu(k,2256) - lu(k,1097) * lu(k,2225) + lu(k,2257) = lu(k,2257) - lu(k,1098) * lu(k,2225) + lu(k,2260) = lu(k,2260) - lu(k,1099) * lu(k,2225) + lu(k,2383) = lu(k,2383) - lu(k,1089) * lu(k,2382) + lu(k,2386) = lu(k,2386) - lu(k,1090) * lu(k,2382) + lu(k,2388) = lu(k,2388) - lu(k,1091) * lu(k,2382) + lu(k,2407) = lu(k,2407) - lu(k,1092) * lu(k,2382) + lu(k,2408) = lu(k,2408) - lu(k,1093) * lu(k,2382) + lu(k,2409) = lu(k,2409) - lu(k,1094) * lu(k,2382) + lu(k,2411) = lu(k,2411) - lu(k,1095) * lu(k,2382) + lu(k,2412) = lu(k,2412) - lu(k,1096) * lu(k,2382) + lu(k,2414) = lu(k,2414) - lu(k,1097) * lu(k,2382) + lu(k,2415) = lu(k,2415) - lu(k,1098) * lu(k,2382) + lu(k,2418) = lu(k,2418) - lu(k,1099) * lu(k,2382) + lu(k,1101) = 1._r8 / lu(k,1101) + lu(k,1102) = lu(k,1102) * lu(k,1101) + lu(k,1103) = lu(k,1103) * lu(k,1101) + lu(k,1104) = lu(k,1104) * lu(k,1101) + lu(k,1105) = lu(k,1105) * lu(k,1101) + lu(k,1106) = lu(k,1106) * lu(k,1101) + lu(k,1107) = lu(k,1107) * lu(k,1101) + lu(k,1108) = lu(k,1108) * lu(k,1101) + lu(k,1109) = lu(k,1109) * lu(k,1101) + lu(k,1110) = lu(k,1110) * lu(k,1101) + lu(k,1174) = lu(k,1174) - lu(k,1102) * lu(k,1173) + lu(k,1177) = lu(k,1177) - lu(k,1103) * lu(k,1173) + lu(k,1178) = lu(k,1178) - lu(k,1104) * lu(k,1173) + lu(k,1179) = lu(k,1179) - lu(k,1105) * lu(k,1173) + lu(k,1180) = lu(k,1180) - lu(k,1106) * lu(k,1173) + lu(k,1184) = lu(k,1184) - lu(k,1107) * lu(k,1173) + lu(k,1185) = lu(k,1185) - lu(k,1108) * lu(k,1173) + lu(k,1186) = lu(k,1186) - lu(k,1109) * lu(k,1173) + lu(k,1187) = lu(k,1187) - lu(k,1110) * lu(k,1173) + lu(k,1774) = lu(k,1774) - lu(k,1102) * lu(k,1770) + lu(k,1779) = lu(k,1779) - lu(k,1103) * lu(k,1770) + lu(k,1789) = lu(k,1789) - lu(k,1104) * lu(k,1770) + lu(k,1790) = lu(k,1790) - lu(k,1105) * lu(k,1770) + lu(k,1799) = lu(k,1799) - lu(k,1106) * lu(k,1770) + lu(k,1806) = lu(k,1806) - lu(k,1107) * lu(k,1770) + lu(k,1807) = lu(k,1807) - lu(k,1108) * lu(k,1770) + lu(k,1810) = lu(k,1810) - lu(k,1109) * lu(k,1770) + lu(k,1812) = lu(k,1812) - lu(k,1110) * lu(k,1770) + lu(k,1881) = lu(k,1881) - lu(k,1102) * lu(k,1877) + lu(k,1886) = lu(k,1886) - lu(k,1103) * lu(k,1877) + lu(k,1896) = lu(k,1896) - lu(k,1104) * lu(k,1877) + lu(k,1897) = lu(k,1897) - lu(k,1105) * lu(k,1877) + lu(k,1904) = lu(k,1904) - lu(k,1106) * lu(k,1877) + lu(k,1911) = lu(k,1911) - lu(k,1107) * lu(k,1877) + lu(k,1912) = lu(k,1912) - lu(k,1108) * lu(k,1877) + lu(k,1915) = lu(k,1915) - lu(k,1109) * lu(k,1877) + lu(k,1917) = lu(k,1917) - lu(k,1110) * lu(k,1877) + lu(k,2046) = lu(k,2046) - lu(k,1102) * lu(k,2043) + lu(k,2051) = lu(k,2051) - lu(k,1103) * lu(k,2043) + lu(k,2061) = lu(k,2061) - lu(k,1104) * lu(k,2043) + lu(k,2062) = lu(k,2062) - lu(k,1105) * lu(k,2043) + lu(k,2068) = lu(k,2068) - lu(k,1106) * lu(k,2043) + lu(k,2075) = lu(k,2075) - lu(k,1107) * lu(k,2043) + lu(k,2076) = lu(k,2076) - lu(k,1108) * lu(k,2043) + lu(k,2079) = lu(k,2079) - lu(k,1109) * lu(k,2043) + lu(k,2081) = lu(k,2081) - lu(k,1110) * lu(k,2043) + lu(k,2174) = lu(k,2174) - lu(k,1102) * lu(k,2172) + lu(k,2178) = lu(k,2178) - lu(k,1103) * lu(k,2172) + lu(k,2188) = lu(k,2188) - lu(k,1104) * lu(k,2172) + lu(k,2189) = lu(k,2189) - lu(k,1105) * lu(k,2172) + lu(k,2197) = lu(k,2197) - lu(k,1106) * lu(k,2172) + lu(k,2204) = lu(k,2204) - lu(k,1107) * lu(k,2172) + lu(k,2205) = lu(k,2205) - lu(k,1108) * lu(k,2172) + lu(k,2208) = lu(k,2208) - lu(k,1109) * lu(k,2172) + lu(k,2210) = lu(k,2210) - lu(k,1110) * lu(k,2172) + lu(k,2229) = lu(k,2229) - lu(k,1102) * lu(k,2226) + lu(k,2233) = lu(k,2233) - lu(k,1103) * lu(k,2226) + lu(k,2243) = lu(k,2243) - lu(k,1104) * lu(k,2226) + lu(k,2244) = lu(k,2244) - lu(k,1105) * lu(k,2226) + lu(k,2249) = lu(k,2249) - lu(k,1106) * lu(k,2226) + lu(k,2256) = lu(k,2256) - lu(k,1107) * lu(k,2226) + lu(k,2257) = lu(k,2257) - lu(k,1108) * lu(k,2226) + lu(k,2260) = lu(k,2260) - lu(k,1109) * lu(k,2226) + lu(k,2262) = lu(k,2262) - lu(k,1110) * lu(k,2226) + lu(k,2386) = lu(k,2386) - lu(k,1102) * lu(k,2383) + lu(k,2390) = lu(k,2390) - lu(k,1103) * lu(k,2383) + lu(k,2399) = lu(k,2399) - lu(k,1104) * lu(k,2383) + lu(k,2400) = lu(k,2400) - lu(k,1105) * lu(k,2383) + lu(k,2407) = lu(k,2407) - lu(k,1106) * lu(k,2383) + lu(k,2414) = lu(k,2414) - lu(k,1107) * lu(k,2383) + lu(k,2415) = lu(k,2415) - lu(k,1108) * lu(k,2383) + lu(k,2418) = lu(k,2418) - lu(k,1109) * lu(k,2383) + lu(k,2420) = lu(k,2420) - lu(k,1110) * lu(k,2383) + lu(k,1115) = 1._r8 / lu(k,1115) + lu(k,1116) = lu(k,1116) * lu(k,1115) + lu(k,1117) = lu(k,1117) * lu(k,1115) + lu(k,1118) = lu(k,1118) * lu(k,1115) + lu(k,1119) = lu(k,1119) * lu(k,1115) + lu(k,1120) = lu(k,1120) * lu(k,1115) + lu(k,1121) = lu(k,1121) * lu(k,1115) + lu(k,1122) = lu(k,1122) * lu(k,1115) + lu(k,1123) = lu(k,1123) * lu(k,1115) + lu(k,1124) = lu(k,1124) * lu(k,1115) + lu(k,1125) = lu(k,1125) * lu(k,1115) + lu(k,1126) = lu(k,1126) * lu(k,1115) + lu(k,1248) = - lu(k,1116) * lu(k,1247) + lu(k,1253) = lu(k,1253) - lu(k,1117) * lu(k,1247) + lu(k,1255) = lu(k,1255) - lu(k,1118) * lu(k,1247) + lu(k,1256) = - lu(k,1119) * lu(k,1247) + lu(k,1257) = lu(k,1257) - lu(k,1120) * lu(k,1247) + lu(k,1258) = lu(k,1258) - lu(k,1121) * lu(k,1247) + lu(k,1260) = lu(k,1260) - lu(k,1122) * lu(k,1247) + lu(k,1261) = lu(k,1261) - lu(k,1123) * lu(k,1247) + lu(k,1262) = lu(k,1262) - lu(k,1124) * lu(k,1247) + lu(k,1263) = lu(k,1263) - lu(k,1125) * lu(k,1247) + lu(k,1264) = lu(k,1264) - lu(k,1126) * lu(k,1247) + lu(k,1414) = lu(k,1414) - lu(k,1116) * lu(k,1413) + lu(k,1420) = lu(k,1420) - lu(k,1117) * lu(k,1413) + lu(k,1426) = lu(k,1426) - lu(k,1118) * lu(k,1413) + lu(k,1427) = lu(k,1427) - lu(k,1119) * lu(k,1413) + lu(k,1429) = lu(k,1429) - lu(k,1120) * lu(k,1413) + lu(k,1430) = lu(k,1430) - lu(k,1121) * lu(k,1413) + lu(k,1432) = - lu(k,1122) * lu(k,1413) + lu(k,1433) = lu(k,1433) - lu(k,1123) * lu(k,1413) + lu(k,1434) = lu(k,1434) - lu(k,1124) * lu(k,1413) + lu(k,1435) = lu(k,1435) - lu(k,1125) * lu(k,1413) + lu(k,1437) = lu(k,1437) - lu(k,1126) * lu(k,1413) + lu(k,1774) = lu(k,1774) - lu(k,1116) * lu(k,1771) + lu(k,1783) = lu(k,1783) - lu(k,1117) * lu(k,1771) + lu(k,1789) = lu(k,1789) - lu(k,1118) * lu(k,1771) + lu(k,1790) = lu(k,1790) - lu(k,1119) * lu(k,1771) + lu(k,1799) = lu(k,1799) - lu(k,1120) * lu(k,1771) + lu(k,1800) = lu(k,1800) - lu(k,1121) * lu(k,1771) + lu(k,1803) = lu(k,1803) - lu(k,1122) * lu(k,1771) + lu(k,1804) = lu(k,1804) - lu(k,1123) * lu(k,1771) + lu(k,1806) = lu(k,1806) - lu(k,1124) * lu(k,1771) + lu(k,1807) = lu(k,1807) - lu(k,1125) * lu(k,1771) + lu(k,1810) = lu(k,1810) - lu(k,1126) * lu(k,1771) + lu(k,1881) = lu(k,1881) - lu(k,1116) * lu(k,1878) + lu(k,1890) = lu(k,1890) - lu(k,1117) * lu(k,1878) + lu(k,1896) = lu(k,1896) - lu(k,1118) * lu(k,1878) + lu(k,1897) = lu(k,1897) - lu(k,1119) * lu(k,1878) + lu(k,1904) = lu(k,1904) - lu(k,1120) * lu(k,1878) + lu(k,1905) = lu(k,1905) - lu(k,1121) * lu(k,1878) + lu(k,1908) = lu(k,1908) - lu(k,1122) * lu(k,1878) + lu(k,1909) = lu(k,1909) - lu(k,1123) * lu(k,1878) + lu(k,1911) = lu(k,1911) - lu(k,1124) * lu(k,1878) + lu(k,1912) = lu(k,1912) - lu(k,1125) * lu(k,1878) + lu(k,1915) = lu(k,1915) - lu(k,1126) * lu(k,1878) + lu(k,2046) = lu(k,2046) - lu(k,1116) * lu(k,2044) + lu(k,2055) = lu(k,2055) - lu(k,1117) * lu(k,2044) + lu(k,2061) = lu(k,2061) - lu(k,1118) * lu(k,2044) + lu(k,2062) = lu(k,2062) - lu(k,1119) * lu(k,2044) + lu(k,2068) = lu(k,2068) - lu(k,1120) * lu(k,2044) + lu(k,2069) = lu(k,2069) - lu(k,1121) * lu(k,2044) + lu(k,2072) = lu(k,2072) - lu(k,1122) * lu(k,2044) + lu(k,2073) = lu(k,2073) - lu(k,1123) * lu(k,2044) + lu(k,2075) = lu(k,2075) - lu(k,1124) * lu(k,2044) + lu(k,2076) = lu(k,2076) - lu(k,1125) * lu(k,2044) + lu(k,2079) = lu(k,2079) - lu(k,1126) * lu(k,2044) + lu(k,2229) = lu(k,2229) - lu(k,1116) * lu(k,2227) + lu(k,2237) = lu(k,2237) - lu(k,1117) * lu(k,2227) + lu(k,2243) = lu(k,2243) - lu(k,1118) * lu(k,2227) + lu(k,2244) = lu(k,2244) - lu(k,1119) * lu(k,2227) + lu(k,2249) = lu(k,2249) - lu(k,1120) * lu(k,2227) + lu(k,2250) = lu(k,2250) - lu(k,1121) * lu(k,2227) + lu(k,2253) = lu(k,2253) - lu(k,1122) * lu(k,2227) + lu(k,2254) = lu(k,2254) - lu(k,1123) * lu(k,2227) + lu(k,2256) = lu(k,2256) - lu(k,1124) * lu(k,2227) + lu(k,2257) = lu(k,2257) - lu(k,1125) * lu(k,2227) + lu(k,2260) = lu(k,2260) - lu(k,1126) * lu(k,2227) end do end subroutine lu_fac23 subroutine lu_fac24( avec_len, lu ) @@ -4970,451 +4356,684 @@ subroutine lu_fac24( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1140) = 1._r8 / lu(k,1140) - lu(k,1141) = lu(k,1141) * lu(k,1140) - lu(k,1142) = lu(k,1142) * lu(k,1140) - lu(k,1143) = lu(k,1143) * lu(k,1140) - lu(k,1144) = lu(k,1144) * lu(k,1140) - lu(k,1145) = lu(k,1145) * lu(k,1140) - lu(k,1146) = lu(k,1146) * lu(k,1140) - lu(k,1147) = lu(k,1147) * lu(k,1140) - lu(k,1148) = lu(k,1148) * lu(k,1140) - lu(k,1149) = lu(k,1149) * lu(k,1140) - lu(k,1150) = lu(k,1150) * lu(k,1140) - lu(k,1171) = lu(k,1171) - lu(k,1141) * lu(k,1170) - lu(k,1173) = - lu(k,1142) * lu(k,1170) - lu(k,1175) = - lu(k,1143) * lu(k,1170) - lu(k,1176) = lu(k,1176) - lu(k,1144) * lu(k,1170) - lu(k,1179) = lu(k,1179) - lu(k,1145) * lu(k,1170) - lu(k,1180) = - lu(k,1146) * lu(k,1170) - lu(k,1181) = lu(k,1181) - lu(k,1147) * lu(k,1170) - lu(k,1183) = lu(k,1183) - lu(k,1148) * lu(k,1170) - lu(k,1186) = lu(k,1186) - lu(k,1149) * lu(k,1170) - lu(k,1187) = lu(k,1187) - lu(k,1150) * lu(k,1170) - lu(k,1205) = lu(k,1205) - lu(k,1141) * lu(k,1204) - lu(k,1207) = - lu(k,1142) * lu(k,1204) - lu(k,1209) = - lu(k,1143) * lu(k,1204) - lu(k,1210) = lu(k,1210) - lu(k,1144) * lu(k,1204) - lu(k,1213) = lu(k,1213) - lu(k,1145) * lu(k,1204) - lu(k,1214) = - lu(k,1146) * lu(k,1204) - lu(k,1215) = lu(k,1215) - lu(k,1147) * lu(k,1204) - lu(k,1217) = lu(k,1217) - lu(k,1148) * lu(k,1204) - lu(k,1220) = lu(k,1220) - lu(k,1149) * lu(k,1204) - lu(k,1221) = lu(k,1221) - lu(k,1150) * lu(k,1204) - lu(k,1296) = lu(k,1296) - lu(k,1141) * lu(k,1295) - lu(k,1299) = lu(k,1299) - lu(k,1142) * lu(k,1295) - lu(k,1301) = lu(k,1301) - lu(k,1143) * lu(k,1295) - lu(k,1302) = lu(k,1302) - lu(k,1144) * lu(k,1295) - lu(k,1306) = lu(k,1306) - lu(k,1145) * lu(k,1295) - lu(k,1307) = lu(k,1307) - lu(k,1146) * lu(k,1295) - lu(k,1308) = lu(k,1308) - lu(k,1147) * lu(k,1295) - lu(k,1310) = lu(k,1310) - lu(k,1148) * lu(k,1295) - lu(k,1313) = lu(k,1313) - lu(k,1149) * lu(k,1295) - lu(k,1314) = lu(k,1314) - lu(k,1150) * lu(k,1295) - lu(k,1389) = lu(k,1389) - lu(k,1141) * lu(k,1388) - lu(k,1392) = lu(k,1392) - lu(k,1142) * lu(k,1388) - lu(k,1394) = lu(k,1394) - lu(k,1143) * lu(k,1388) - lu(k,1395) = lu(k,1395) - lu(k,1144) * lu(k,1388) - lu(k,1400) = lu(k,1400) - lu(k,1145) * lu(k,1388) - lu(k,1401) = - lu(k,1146) * lu(k,1388) - lu(k,1402) = lu(k,1402) - lu(k,1147) * lu(k,1388) - lu(k,1404) = lu(k,1404) - lu(k,1148) * lu(k,1388) - lu(k,1407) = lu(k,1407) - lu(k,1149) * lu(k,1388) - lu(k,1409) = lu(k,1409) - lu(k,1150) * lu(k,1388) - lu(k,1497) = lu(k,1497) - lu(k,1141) * lu(k,1496) - lu(k,1500) = lu(k,1500) - lu(k,1142) * lu(k,1496) - lu(k,1502) = lu(k,1502) - lu(k,1143) * lu(k,1496) - lu(k,1503) = lu(k,1503) - lu(k,1144) * lu(k,1496) - lu(k,1510) = lu(k,1510) - lu(k,1145) * lu(k,1496) - lu(k,1511) = lu(k,1511) - lu(k,1146) * lu(k,1496) - lu(k,1513) = lu(k,1513) - lu(k,1147) * lu(k,1496) - lu(k,1515) = lu(k,1515) - lu(k,1148) * lu(k,1496) - lu(k,1519) = lu(k,1519) - lu(k,1149) * lu(k,1496) - lu(k,1521) = lu(k,1521) - lu(k,1150) * lu(k,1496) - lu(k,1704) = lu(k,1704) - lu(k,1141) * lu(k,1703) - lu(k,1707) = lu(k,1707) - lu(k,1142) * lu(k,1703) - lu(k,1709) = lu(k,1709) - lu(k,1143) * lu(k,1703) - lu(k,1710) = lu(k,1710) - lu(k,1144) * lu(k,1703) - lu(k,1719) = lu(k,1719) - lu(k,1145) * lu(k,1703) - lu(k,1720) = lu(k,1720) - lu(k,1146) * lu(k,1703) - lu(k,1722) = lu(k,1722) - lu(k,1147) * lu(k,1703) - lu(k,1724) = lu(k,1724) - lu(k,1148) * lu(k,1703) - lu(k,1728) = lu(k,1728) - lu(k,1149) * lu(k,1703) - lu(k,1730) = lu(k,1730) - lu(k,1150) * lu(k,1703) - lu(k,1767) = lu(k,1767) - lu(k,1141) * lu(k,1766) - lu(k,1770) = - lu(k,1142) * lu(k,1766) - lu(k,1772) = - lu(k,1143) * lu(k,1766) - lu(k,1773) = lu(k,1773) - lu(k,1144) * lu(k,1766) - lu(k,1781) = lu(k,1781) - lu(k,1145) * lu(k,1766) - lu(k,1782) = lu(k,1782) - lu(k,1146) * lu(k,1766) - lu(k,1784) = lu(k,1784) - lu(k,1147) * lu(k,1766) - lu(k,1786) = lu(k,1786) - lu(k,1148) * lu(k,1766) - lu(k,1790) = lu(k,1790) - lu(k,1149) * lu(k,1766) - lu(k,1792) = lu(k,1792) - lu(k,1150) * lu(k,1766) - lu(k,1889) = lu(k,1889) - lu(k,1141) * lu(k,1888) - lu(k,1892) = lu(k,1892) - lu(k,1142) * lu(k,1888) - lu(k,1894) = lu(k,1894) - lu(k,1143) * lu(k,1888) - lu(k,1895) = lu(k,1895) - lu(k,1144) * lu(k,1888) - lu(k,1903) = lu(k,1903) - lu(k,1145) * lu(k,1888) - lu(k,1904) = lu(k,1904) - lu(k,1146) * lu(k,1888) - lu(k,1906) = lu(k,1906) - lu(k,1147) * lu(k,1888) - lu(k,1908) = lu(k,1908) - lu(k,1148) * lu(k,1888) - lu(k,1912) = lu(k,1912) - lu(k,1149) * lu(k,1888) - lu(k,1914) = lu(k,1914) - lu(k,1150) * lu(k,1888) - lu(k,2092) = lu(k,2092) - lu(k,1141) * lu(k,2091) - lu(k,2095) = lu(k,2095) - lu(k,1142) * lu(k,2091) - lu(k,2097) = lu(k,2097) - lu(k,1143) * lu(k,2091) - lu(k,2098) = lu(k,2098) - lu(k,1144) * lu(k,2091) - lu(k,2106) = lu(k,2106) - lu(k,1145) * lu(k,2091) - lu(k,2107) = lu(k,2107) - lu(k,1146) * lu(k,2091) - lu(k,2109) = lu(k,2109) - lu(k,1147) * lu(k,2091) - lu(k,2111) = lu(k,2111) - lu(k,1148) * lu(k,2091) - lu(k,2115) = lu(k,2115) - lu(k,1149) * lu(k,2091) - lu(k,2117) = lu(k,2117) - lu(k,1150) * lu(k,2091) - lu(k,1152) = 1._r8 / lu(k,1152) - lu(k,1153) = lu(k,1153) * lu(k,1152) - lu(k,1154) = lu(k,1154) * lu(k,1152) - lu(k,1155) = lu(k,1155) * lu(k,1152) - lu(k,1156) = lu(k,1156) * lu(k,1152) - lu(k,1157) = lu(k,1157) * lu(k,1152) - lu(k,1158) = lu(k,1158) * lu(k,1152) - lu(k,1159) = lu(k,1159) * lu(k,1152) - lu(k,1176) = lu(k,1176) - lu(k,1153) * lu(k,1171) - lu(k,1179) = lu(k,1179) - lu(k,1154) * lu(k,1171) - lu(k,1182) = lu(k,1182) - lu(k,1155) * lu(k,1171) - lu(k,1183) = lu(k,1183) - lu(k,1156) * lu(k,1171) - lu(k,1184) = lu(k,1184) - lu(k,1157) * lu(k,1171) - lu(k,1186) = lu(k,1186) - lu(k,1158) * lu(k,1171) - lu(k,1187) = lu(k,1187) - lu(k,1159) * lu(k,1171) - lu(k,1210) = lu(k,1210) - lu(k,1153) * lu(k,1205) - lu(k,1213) = lu(k,1213) - lu(k,1154) * lu(k,1205) - lu(k,1216) = lu(k,1216) - lu(k,1155) * lu(k,1205) - lu(k,1217) = lu(k,1217) - lu(k,1156) * lu(k,1205) - lu(k,1218) = lu(k,1218) - lu(k,1157) * lu(k,1205) - lu(k,1220) = lu(k,1220) - lu(k,1158) * lu(k,1205) - lu(k,1221) = lu(k,1221) - lu(k,1159) * lu(k,1205) - lu(k,1233) = lu(k,1233) - lu(k,1153) * lu(k,1230) - lu(k,1236) = lu(k,1236) - lu(k,1154) * lu(k,1230) - lu(k,1238) = lu(k,1238) - lu(k,1155) * lu(k,1230) - lu(k,1239) = lu(k,1239) - lu(k,1156) * lu(k,1230) - lu(k,1240) = lu(k,1240) - lu(k,1157) * lu(k,1230) - lu(k,1242) = lu(k,1242) - lu(k,1158) * lu(k,1230) - lu(k,1243) = lu(k,1243) - lu(k,1159) * lu(k,1230) - lu(k,1253) = lu(k,1253) - lu(k,1153) * lu(k,1249) - lu(k,1257) = lu(k,1257) - lu(k,1154) * lu(k,1249) - lu(k,1260) = lu(k,1260) - lu(k,1155) * lu(k,1249) - lu(k,1261) = lu(k,1261) - lu(k,1156) * lu(k,1249) - lu(k,1262) = lu(k,1262) - lu(k,1157) * lu(k,1249) - lu(k,1264) = lu(k,1264) - lu(k,1158) * lu(k,1249) - lu(k,1265) = lu(k,1265) - lu(k,1159) * lu(k,1249) - lu(k,1272) = lu(k,1272) - lu(k,1153) * lu(k,1270) - lu(k,1275) = lu(k,1275) - lu(k,1154) * lu(k,1270) - lu(k,1278) = lu(k,1278) - lu(k,1155) * lu(k,1270) - lu(k,1279) = - lu(k,1156) * lu(k,1270) - lu(k,1280) = - lu(k,1157) * lu(k,1270) - lu(k,1282) = lu(k,1282) - lu(k,1158) * lu(k,1270) - lu(k,1283) = lu(k,1283) - lu(k,1159) * lu(k,1270) - lu(k,1302) = lu(k,1302) - lu(k,1153) * lu(k,1296) - lu(k,1306) = lu(k,1306) - lu(k,1154) * lu(k,1296) - lu(k,1309) = lu(k,1309) - lu(k,1155) * lu(k,1296) - lu(k,1310) = lu(k,1310) - lu(k,1156) * lu(k,1296) - lu(k,1311) = lu(k,1311) - lu(k,1157) * lu(k,1296) - lu(k,1313) = lu(k,1313) - lu(k,1158) * lu(k,1296) - lu(k,1314) = lu(k,1314) - lu(k,1159) * lu(k,1296) - lu(k,1395) = lu(k,1395) - lu(k,1153) * lu(k,1389) - lu(k,1400) = lu(k,1400) - lu(k,1154) * lu(k,1389) - lu(k,1403) = lu(k,1403) - lu(k,1155) * lu(k,1389) - lu(k,1404) = lu(k,1404) - lu(k,1156) * lu(k,1389) - lu(k,1405) = lu(k,1405) - lu(k,1157) * lu(k,1389) - lu(k,1407) = lu(k,1407) - lu(k,1158) * lu(k,1389) - lu(k,1409) = lu(k,1409) - lu(k,1159) * lu(k,1389) - lu(k,1503) = lu(k,1503) - lu(k,1153) * lu(k,1497) - lu(k,1510) = lu(k,1510) - lu(k,1154) * lu(k,1497) - lu(k,1514) = lu(k,1514) - lu(k,1155) * lu(k,1497) - lu(k,1515) = lu(k,1515) - lu(k,1156) * lu(k,1497) - lu(k,1516) = lu(k,1516) - lu(k,1157) * lu(k,1497) - lu(k,1519) = lu(k,1519) - lu(k,1158) * lu(k,1497) - lu(k,1521) = lu(k,1521) - lu(k,1159) * lu(k,1497) - lu(k,1710) = lu(k,1710) - lu(k,1153) * lu(k,1704) - lu(k,1719) = lu(k,1719) - lu(k,1154) * lu(k,1704) - lu(k,1723) = lu(k,1723) - lu(k,1155) * lu(k,1704) - lu(k,1724) = lu(k,1724) - lu(k,1156) * lu(k,1704) - lu(k,1725) = lu(k,1725) - lu(k,1157) * lu(k,1704) - lu(k,1728) = lu(k,1728) - lu(k,1158) * lu(k,1704) - lu(k,1730) = lu(k,1730) - lu(k,1159) * lu(k,1704) - lu(k,1773) = lu(k,1773) - lu(k,1153) * lu(k,1767) - lu(k,1781) = lu(k,1781) - lu(k,1154) * lu(k,1767) - lu(k,1785) = lu(k,1785) - lu(k,1155) * lu(k,1767) - lu(k,1786) = lu(k,1786) - lu(k,1156) * lu(k,1767) - lu(k,1787) = lu(k,1787) - lu(k,1157) * lu(k,1767) - lu(k,1790) = lu(k,1790) - lu(k,1158) * lu(k,1767) - lu(k,1792) = lu(k,1792) - lu(k,1159) * lu(k,1767) - lu(k,1895) = lu(k,1895) - lu(k,1153) * lu(k,1889) - lu(k,1903) = lu(k,1903) - lu(k,1154) * lu(k,1889) - lu(k,1907) = lu(k,1907) - lu(k,1155) * lu(k,1889) - lu(k,1908) = lu(k,1908) - lu(k,1156) * lu(k,1889) - lu(k,1909) = lu(k,1909) - lu(k,1157) * lu(k,1889) - lu(k,1912) = lu(k,1912) - lu(k,1158) * lu(k,1889) - lu(k,1914) = lu(k,1914) - lu(k,1159) * lu(k,1889) - lu(k,1978) = lu(k,1978) - lu(k,1153) * lu(k,1976) - lu(k,1987) = lu(k,1987) - lu(k,1154) * lu(k,1976) - lu(k,1991) = lu(k,1991) - lu(k,1155) * lu(k,1976) - lu(k,1992) = lu(k,1992) - lu(k,1156) * lu(k,1976) - lu(k,1993) = lu(k,1993) - lu(k,1157) * lu(k,1976) - lu(k,1996) = lu(k,1996) - lu(k,1158) * lu(k,1976) - lu(k,1998) = lu(k,1998) - lu(k,1159) * lu(k,1976) - lu(k,2098) = lu(k,2098) - lu(k,1153) * lu(k,2092) - lu(k,2106) = lu(k,2106) - lu(k,1154) * lu(k,2092) - lu(k,2110) = lu(k,2110) - lu(k,1155) * lu(k,2092) - lu(k,2111) = lu(k,2111) - lu(k,1156) * lu(k,2092) - lu(k,2112) = lu(k,2112) - lu(k,1157) * lu(k,2092) - lu(k,2115) = lu(k,2115) - lu(k,1158) * lu(k,2092) - lu(k,2117) = lu(k,2117) - lu(k,1159) * lu(k,2092) - 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,1177) = lu(k,1177) * lu(k,1172) - lu(k,1178) = lu(k,1178) * lu(k,1172) - lu(k,1179) = lu(k,1179) * lu(k,1172) - lu(k,1180) = lu(k,1180) * lu(k,1172) - lu(k,1181) = lu(k,1181) * lu(k,1172) - lu(k,1182) = lu(k,1182) * lu(k,1172) - lu(k,1183) = lu(k,1183) * lu(k,1172) - lu(k,1184) = lu(k,1184) * lu(k,1172) - lu(k,1185) = lu(k,1185) * lu(k,1172) - lu(k,1186) = lu(k,1186) * lu(k,1172) - lu(k,1187) = lu(k,1187) * lu(k,1172) - lu(k,1299) = lu(k,1299) - lu(k,1173) * lu(k,1297) - lu(k,1300) = lu(k,1300) - lu(k,1174) * lu(k,1297) - lu(k,1301) = lu(k,1301) - lu(k,1175) * lu(k,1297) - lu(k,1302) = lu(k,1302) - lu(k,1176) * lu(k,1297) - lu(k,1303) = lu(k,1303) - lu(k,1177) * lu(k,1297) - lu(k,1305) = lu(k,1305) - lu(k,1178) * lu(k,1297) - lu(k,1306) = lu(k,1306) - lu(k,1179) * lu(k,1297) - lu(k,1307) = lu(k,1307) - lu(k,1180) * lu(k,1297) - lu(k,1308) = lu(k,1308) - lu(k,1181) * lu(k,1297) - lu(k,1309) = lu(k,1309) - lu(k,1182) * lu(k,1297) - lu(k,1310) = lu(k,1310) - lu(k,1183) * lu(k,1297) - lu(k,1311) = lu(k,1311) - lu(k,1184) * lu(k,1297) - lu(k,1312) = lu(k,1312) - lu(k,1185) * lu(k,1297) - lu(k,1313) = lu(k,1313) - lu(k,1186) * lu(k,1297) - lu(k,1314) = lu(k,1314) - lu(k,1187) * lu(k,1297) - lu(k,1392) = lu(k,1392) - lu(k,1173) * lu(k,1390) - lu(k,1393) = lu(k,1393) - lu(k,1174) * lu(k,1390) - lu(k,1394) = lu(k,1394) - lu(k,1175) * lu(k,1390) - lu(k,1395) = lu(k,1395) - lu(k,1176) * lu(k,1390) - lu(k,1396) = lu(k,1396) - lu(k,1177) * lu(k,1390) - lu(k,1398) = lu(k,1398) - lu(k,1178) * lu(k,1390) - lu(k,1400) = lu(k,1400) - lu(k,1179) * lu(k,1390) - lu(k,1401) = lu(k,1401) - lu(k,1180) * lu(k,1390) - lu(k,1402) = lu(k,1402) - lu(k,1181) * lu(k,1390) - lu(k,1403) = lu(k,1403) - lu(k,1182) * lu(k,1390) - lu(k,1404) = lu(k,1404) - lu(k,1183) * lu(k,1390) - lu(k,1405) = lu(k,1405) - lu(k,1184) * lu(k,1390) - lu(k,1406) = lu(k,1406) - lu(k,1185) * lu(k,1390) - lu(k,1407) = lu(k,1407) - lu(k,1186) * lu(k,1390) - lu(k,1409) = lu(k,1409) - lu(k,1187) * lu(k,1390) - lu(k,1500) = lu(k,1500) - lu(k,1173) * lu(k,1498) - lu(k,1501) = lu(k,1501) - lu(k,1174) * lu(k,1498) - lu(k,1502) = lu(k,1502) - lu(k,1175) * lu(k,1498) - lu(k,1503) = lu(k,1503) - lu(k,1176) * lu(k,1498) - lu(k,1505) = lu(k,1505) - lu(k,1177) * lu(k,1498) - lu(k,1507) = lu(k,1507) - lu(k,1178) * lu(k,1498) - lu(k,1510) = lu(k,1510) - lu(k,1179) * lu(k,1498) - lu(k,1511) = lu(k,1511) - lu(k,1180) * lu(k,1498) - lu(k,1513) = lu(k,1513) - lu(k,1181) * lu(k,1498) - lu(k,1514) = lu(k,1514) - lu(k,1182) * lu(k,1498) - lu(k,1515) = lu(k,1515) - lu(k,1183) * lu(k,1498) - lu(k,1516) = lu(k,1516) - lu(k,1184) * lu(k,1498) - lu(k,1517) = lu(k,1517) - lu(k,1185) * lu(k,1498) - lu(k,1519) = lu(k,1519) - lu(k,1186) * lu(k,1498) - lu(k,1521) = lu(k,1521) - lu(k,1187) * lu(k,1498) - lu(k,1707) = lu(k,1707) - lu(k,1173) * lu(k,1705) - lu(k,1708) = lu(k,1708) - lu(k,1174) * lu(k,1705) - lu(k,1709) = lu(k,1709) - lu(k,1175) * lu(k,1705) - lu(k,1710) = lu(k,1710) - lu(k,1176) * lu(k,1705) - lu(k,1714) = lu(k,1714) - lu(k,1177) * lu(k,1705) - lu(k,1716) = lu(k,1716) - lu(k,1178) * lu(k,1705) - lu(k,1719) = lu(k,1719) - lu(k,1179) * lu(k,1705) - lu(k,1720) = lu(k,1720) - lu(k,1180) * lu(k,1705) - lu(k,1722) = lu(k,1722) - lu(k,1181) * lu(k,1705) - lu(k,1723) = lu(k,1723) - lu(k,1182) * lu(k,1705) - lu(k,1724) = lu(k,1724) - lu(k,1183) * lu(k,1705) - lu(k,1725) = lu(k,1725) - lu(k,1184) * lu(k,1705) - lu(k,1726) = lu(k,1726) - lu(k,1185) * lu(k,1705) - lu(k,1728) = lu(k,1728) - lu(k,1186) * lu(k,1705) - lu(k,1730) = lu(k,1730) - lu(k,1187) * lu(k,1705) - lu(k,1770) = lu(k,1770) - lu(k,1173) * lu(k,1768) - lu(k,1771) = lu(k,1771) - lu(k,1174) * lu(k,1768) - lu(k,1772) = lu(k,1772) - lu(k,1175) * lu(k,1768) - lu(k,1773) = lu(k,1773) - lu(k,1176) * lu(k,1768) - lu(k,1776) = lu(k,1776) - lu(k,1177) * lu(k,1768) - lu(k,1778) = lu(k,1778) - lu(k,1178) * lu(k,1768) - lu(k,1781) = lu(k,1781) - lu(k,1179) * lu(k,1768) - lu(k,1782) = lu(k,1782) - lu(k,1180) * lu(k,1768) - lu(k,1784) = lu(k,1784) - lu(k,1181) * lu(k,1768) - lu(k,1785) = lu(k,1785) - lu(k,1182) * lu(k,1768) - lu(k,1786) = lu(k,1786) - lu(k,1183) * lu(k,1768) - lu(k,1787) = lu(k,1787) - lu(k,1184) * lu(k,1768) - lu(k,1788) = lu(k,1788) - lu(k,1185) * lu(k,1768) - lu(k,1790) = lu(k,1790) - lu(k,1186) * lu(k,1768) - lu(k,1792) = lu(k,1792) - lu(k,1187) * lu(k,1768) - lu(k,1892) = lu(k,1892) - lu(k,1173) * lu(k,1890) - lu(k,1893) = lu(k,1893) - lu(k,1174) * lu(k,1890) - lu(k,1894) = lu(k,1894) - lu(k,1175) * lu(k,1890) - lu(k,1895) = lu(k,1895) - lu(k,1176) * lu(k,1890) - lu(k,1898) = lu(k,1898) - lu(k,1177) * lu(k,1890) - lu(k,1900) = lu(k,1900) - lu(k,1178) * lu(k,1890) - lu(k,1903) = lu(k,1903) - lu(k,1179) * lu(k,1890) - lu(k,1904) = lu(k,1904) - lu(k,1180) * lu(k,1890) - lu(k,1906) = lu(k,1906) - lu(k,1181) * lu(k,1890) - lu(k,1907) = lu(k,1907) - lu(k,1182) * lu(k,1890) - lu(k,1908) = lu(k,1908) - lu(k,1183) * lu(k,1890) - lu(k,1909) = lu(k,1909) - lu(k,1184) * lu(k,1890) - lu(k,1910) = lu(k,1910) - lu(k,1185) * lu(k,1890) - lu(k,1912) = lu(k,1912) - lu(k,1186) * lu(k,1890) - lu(k,1914) = lu(k,1914) - lu(k,1187) * lu(k,1890) - lu(k,2095) = lu(k,2095) - lu(k,1173) * lu(k,2093) - lu(k,2096) = lu(k,2096) - lu(k,1174) * lu(k,2093) - lu(k,2097) = lu(k,2097) - lu(k,1175) * lu(k,2093) - lu(k,2098) = lu(k,2098) - lu(k,1176) * lu(k,2093) - lu(k,2101) = lu(k,2101) - lu(k,1177) * lu(k,2093) - lu(k,2103) = lu(k,2103) - lu(k,1178) * lu(k,2093) - lu(k,2106) = lu(k,2106) - lu(k,1179) * lu(k,2093) - lu(k,2107) = lu(k,2107) - lu(k,1180) * lu(k,2093) - lu(k,2109) = lu(k,2109) - lu(k,1181) * lu(k,2093) - lu(k,2110) = lu(k,2110) - lu(k,1182) * lu(k,2093) - lu(k,2111) = lu(k,2111) - lu(k,1183) * lu(k,2093) - lu(k,2112) = lu(k,2112) - lu(k,1184) * lu(k,2093) - lu(k,2113) = lu(k,2113) - lu(k,1185) * lu(k,2093) - lu(k,2115) = lu(k,2115) - lu(k,1186) * lu(k,2093) - lu(k,2117) = lu(k,2117) - lu(k,1187) * lu(k,2093) + lu(k,1131) = 1._r8 / lu(k,1131) + lu(k,1132) = lu(k,1132) * lu(k,1131) + lu(k,1133) = lu(k,1133) * lu(k,1131) + lu(k,1134) = lu(k,1134) * lu(k,1131) + lu(k,1135) = lu(k,1135) * lu(k,1131) + lu(k,1136) = lu(k,1136) * lu(k,1131) + lu(k,1137) = lu(k,1137) * lu(k,1131) + lu(k,1138) = lu(k,1138) * lu(k,1131) + lu(k,1139) = lu(k,1139) * lu(k,1131) + lu(k,1140) = lu(k,1140) * lu(k,1131) + lu(k,1141) = lu(k,1141) * lu(k,1131) + lu(k,1142) = lu(k,1142) * lu(k,1131) + lu(k,1143) = lu(k,1143) * lu(k,1131) + lu(k,1144) = lu(k,1144) * lu(k,1131) + lu(k,1145) = lu(k,1145) * lu(k,1131) + lu(k,1146) = lu(k,1146) * lu(k,1131) + lu(k,1147) = lu(k,1147) * lu(k,1131) + lu(k,1148) = lu(k,1148) * lu(k,1131) + lu(k,1369) = lu(k,1369) - lu(k,1132) * lu(k,1368) + lu(k,1370) = lu(k,1370) - lu(k,1133) * lu(k,1368) + lu(k,1371) = - lu(k,1134) * lu(k,1368) + lu(k,1372) = lu(k,1372) - lu(k,1135) * lu(k,1368) + lu(k,1376) = lu(k,1376) - lu(k,1136) * lu(k,1368) + lu(k,1377) = lu(k,1377) - lu(k,1137) * lu(k,1368) + lu(k,1378) = - lu(k,1138) * lu(k,1368) + lu(k,1379) = lu(k,1379) - lu(k,1139) * lu(k,1368) + lu(k,1380) = - lu(k,1140) * lu(k,1368) + lu(k,1381) = - lu(k,1141) * lu(k,1368) + lu(k,1383) = - lu(k,1142) * lu(k,1368) + lu(k,1384) = lu(k,1384) - lu(k,1143) * lu(k,1368) + lu(k,1385) = lu(k,1385) - lu(k,1144) * lu(k,1368) + lu(k,1386) = - lu(k,1145) * lu(k,1368) + lu(k,1387) = lu(k,1387) - lu(k,1146) * lu(k,1368) + lu(k,1388) = lu(k,1388) - lu(k,1147) * lu(k,1368) + lu(k,1389) = lu(k,1389) - lu(k,1148) * lu(k,1368) + lu(k,1773) = lu(k,1773) - lu(k,1132) * lu(k,1772) + lu(k,1774) = lu(k,1774) - lu(k,1133) * lu(k,1772) + lu(k,1778) = lu(k,1778) - lu(k,1134) * lu(k,1772) + lu(k,1783) = lu(k,1783) - lu(k,1135) * lu(k,1772) + lu(k,1789) = lu(k,1789) - lu(k,1136) * lu(k,1772) + lu(k,1790) = lu(k,1790) - lu(k,1137) * lu(k,1772) + lu(k,1795) = lu(k,1795) - lu(k,1138) * lu(k,1772) + lu(k,1799) = lu(k,1799) - lu(k,1139) * lu(k,1772) + lu(k,1800) = lu(k,1800) - lu(k,1140) * lu(k,1772) + lu(k,1801) = lu(k,1801) - lu(k,1141) * lu(k,1772) + lu(k,1804) = lu(k,1804) - lu(k,1142) * lu(k,1772) + lu(k,1806) = lu(k,1806) - lu(k,1143) * lu(k,1772) + lu(k,1807) = lu(k,1807) - lu(k,1144) * lu(k,1772) + lu(k,1808) = lu(k,1808) - lu(k,1145) * lu(k,1772) + lu(k,1810) = lu(k,1810) - lu(k,1146) * lu(k,1772) + lu(k,1811) = lu(k,1811) - lu(k,1147) * lu(k,1772) + lu(k,1812) = lu(k,1812) - lu(k,1148) * lu(k,1772) + lu(k,1880) = lu(k,1880) - lu(k,1132) * lu(k,1879) + lu(k,1881) = lu(k,1881) - lu(k,1133) * lu(k,1879) + lu(k,1885) = lu(k,1885) - lu(k,1134) * lu(k,1879) + lu(k,1890) = lu(k,1890) - lu(k,1135) * lu(k,1879) + lu(k,1896) = lu(k,1896) - lu(k,1136) * lu(k,1879) + lu(k,1897) = lu(k,1897) - lu(k,1137) * lu(k,1879) + lu(k,1900) = lu(k,1900) - lu(k,1138) * lu(k,1879) + lu(k,1904) = lu(k,1904) - lu(k,1139) * lu(k,1879) + lu(k,1905) = lu(k,1905) - lu(k,1140) * lu(k,1879) + lu(k,1906) = lu(k,1906) - lu(k,1141) * lu(k,1879) + lu(k,1909) = lu(k,1909) - lu(k,1142) * lu(k,1879) + lu(k,1911) = lu(k,1911) - lu(k,1143) * lu(k,1879) + lu(k,1912) = lu(k,1912) - lu(k,1144) * lu(k,1879) + lu(k,1913) = - lu(k,1145) * lu(k,1879) + lu(k,1915) = lu(k,1915) - lu(k,1146) * lu(k,1879) + lu(k,1916) = lu(k,1916) - lu(k,1147) * lu(k,1879) + lu(k,1917) = lu(k,1917) - lu(k,1148) * lu(k,1879) + lu(k,2385) = lu(k,2385) - lu(k,1132) * lu(k,2384) + lu(k,2386) = lu(k,2386) - lu(k,1133) * lu(k,2384) + lu(k,2389) = - lu(k,1134) * lu(k,2384) + lu(k,2393) = lu(k,2393) - lu(k,1135) * lu(k,2384) + lu(k,2399) = lu(k,2399) - lu(k,1136) * lu(k,2384) + lu(k,2400) = lu(k,2400) - lu(k,1137) * lu(k,2384) + lu(k,2403) = lu(k,2403) - lu(k,1138) * lu(k,2384) + lu(k,2407) = lu(k,2407) - lu(k,1139) * lu(k,2384) + lu(k,2408) = lu(k,2408) - lu(k,1140) * lu(k,2384) + lu(k,2409) = lu(k,2409) - lu(k,1141) * lu(k,2384) + lu(k,2412) = lu(k,2412) - lu(k,1142) * lu(k,2384) + lu(k,2414) = lu(k,2414) - lu(k,1143) * lu(k,2384) + lu(k,2415) = lu(k,2415) - lu(k,1144) * lu(k,2384) + lu(k,2416) = lu(k,2416) - lu(k,1145) * lu(k,2384) + lu(k,2418) = lu(k,2418) - lu(k,1146) * lu(k,2384) + lu(k,2419) = lu(k,2419) - lu(k,1147) * lu(k,2384) + lu(k,2420) = lu(k,2420) - lu(k,1148) * lu(k,2384) + lu(k,1149) = 1._r8 / lu(k,1149) + lu(k,1150) = lu(k,1150) * lu(k,1149) + lu(k,1151) = lu(k,1151) * lu(k,1149) + lu(k,1152) = lu(k,1152) * lu(k,1149) + lu(k,1153) = lu(k,1153) * lu(k,1149) + lu(k,1154) = lu(k,1154) * lu(k,1149) + lu(k,1155) = lu(k,1155) * lu(k,1149) + lu(k,1156) = lu(k,1156) * lu(k,1149) + lu(k,1157) = lu(k,1157) * lu(k,1149) + lu(k,1191) = lu(k,1191) - lu(k,1150) * lu(k,1190) + lu(k,1196) = lu(k,1196) - lu(k,1151) * lu(k,1190) + lu(k,1198) = lu(k,1198) - lu(k,1152) * lu(k,1190) + lu(k,1200) = - lu(k,1153) * lu(k,1190) + lu(k,1201) = lu(k,1201) - lu(k,1154) * lu(k,1190) + lu(k,1202) = lu(k,1202) - lu(k,1155) * lu(k,1190) + lu(k,1203) = lu(k,1203) - lu(k,1156) * lu(k,1190) + lu(k,1205) = lu(k,1205) - lu(k,1157) * lu(k,1190) + lu(k,1370) = lu(k,1370) - lu(k,1150) * lu(k,1369) + lu(k,1376) = lu(k,1376) - lu(k,1151) * lu(k,1369) + lu(k,1379) = lu(k,1379) - lu(k,1152) * lu(k,1369) + lu(k,1381) = lu(k,1381) - lu(k,1153) * lu(k,1369) + lu(k,1382) = - lu(k,1154) * lu(k,1369) + lu(k,1384) = lu(k,1384) - lu(k,1155) * lu(k,1369) + lu(k,1385) = lu(k,1385) - lu(k,1156) * lu(k,1369) + lu(k,1389) = lu(k,1389) - lu(k,1157) * lu(k,1369) + lu(k,1774) = lu(k,1774) - lu(k,1150) * lu(k,1773) + lu(k,1789) = lu(k,1789) - lu(k,1151) * lu(k,1773) + lu(k,1799) = lu(k,1799) - lu(k,1152) * lu(k,1773) + lu(k,1801) = lu(k,1801) - lu(k,1153) * lu(k,1773) + lu(k,1803) = lu(k,1803) - lu(k,1154) * lu(k,1773) + lu(k,1806) = lu(k,1806) - lu(k,1155) * lu(k,1773) + lu(k,1807) = lu(k,1807) - lu(k,1156) * lu(k,1773) + lu(k,1812) = lu(k,1812) - lu(k,1157) * lu(k,1773) + lu(k,1881) = lu(k,1881) - lu(k,1150) * lu(k,1880) + lu(k,1896) = lu(k,1896) - lu(k,1151) * lu(k,1880) + lu(k,1904) = lu(k,1904) - lu(k,1152) * lu(k,1880) + lu(k,1906) = lu(k,1906) - lu(k,1153) * lu(k,1880) + lu(k,1908) = lu(k,1908) - lu(k,1154) * lu(k,1880) + lu(k,1911) = lu(k,1911) - lu(k,1155) * lu(k,1880) + lu(k,1912) = lu(k,1912) - lu(k,1156) * lu(k,1880) + lu(k,1917) = lu(k,1917) - lu(k,1157) * lu(k,1880) + lu(k,1937) = lu(k,1937) - lu(k,1150) * lu(k,1936) + lu(k,1941) = lu(k,1941) - lu(k,1151) * lu(k,1936) + lu(k,1950) = lu(k,1950) - lu(k,1152) * lu(k,1936) + lu(k,1952) = lu(k,1952) - lu(k,1153) * lu(k,1936) + lu(k,1954) = lu(k,1954) - lu(k,1154) * lu(k,1936) + lu(k,1957) = lu(k,1957) - lu(k,1155) * lu(k,1936) + lu(k,1958) = lu(k,1958) - lu(k,1156) * lu(k,1936) + lu(k,1963) = lu(k,1963) - lu(k,1157) * lu(k,1936) + lu(k,2046) = lu(k,2046) - lu(k,1150) * lu(k,2045) + lu(k,2061) = lu(k,2061) - lu(k,1151) * lu(k,2045) + lu(k,2068) = lu(k,2068) - lu(k,1152) * lu(k,2045) + lu(k,2070) = lu(k,2070) - lu(k,1153) * lu(k,2045) + lu(k,2072) = lu(k,2072) - lu(k,1154) * lu(k,2045) + lu(k,2075) = lu(k,2075) - lu(k,1155) * lu(k,2045) + lu(k,2076) = lu(k,2076) - lu(k,1156) * lu(k,2045) + lu(k,2081) = lu(k,2081) - lu(k,1157) * lu(k,2045) + lu(k,2174) = lu(k,2174) - lu(k,1150) * lu(k,2173) + lu(k,2188) = lu(k,2188) - lu(k,1151) * lu(k,2173) + lu(k,2197) = lu(k,2197) - lu(k,1152) * lu(k,2173) + lu(k,2199) = lu(k,2199) - lu(k,1153) * lu(k,2173) + lu(k,2201) = lu(k,2201) - lu(k,1154) * lu(k,2173) + lu(k,2204) = lu(k,2204) - lu(k,1155) * lu(k,2173) + lu(k,2205) = lu(k,2205) - lu(k,1156) * lu(k,2173) + lu(k,2210) = lu(k,2210) - lu(k,1157) * lu(k,2173) + lu(k,2229) = lu(k,2229) - lu(k,1150) * lu(k,2228) + lu(k,2243) = lu(k,2243) - lu(k,1151) * lu(k,2228) + lu(k,2249) = lu(k,2249) - lu(k,1152) * lu(k,2228) + lu(k,2251) = lu(k,2251) - lu(k,1153) * lu(k,2228) + lu(k,2253) = lu(k,2253) - lu(k,1154) * lu(k,2228) + lu(k,2256) = lu(k,2256) - lu(k,1155) * lu(k,2228) + lu(k,2257) = lu(k,2257) - lu(k,1156) * lu(k,2228) + lu(k,2262) = lu(k,2262) - lu(k,1157) * lu(k,2228) + lu(k,2386) = lu(k,2386) - lu(k,1150) * lu(k,2385) + lu(k,2399) = lu(k,2399) - lu(k,1151) * lu(k,2385) + lu(k,2407) = lu(k,2407) - lu(k,1152) * lu(k,2385) + lu(k,2409) = lu(k,2409) - lu(k,1153) * lu(k,2385) + lu(k,2411) = lu(k,2411) - lu(k,1154) * lu(k,2385) + lu(k,2414) = lu(k,2414) - lu(k,1155) * lu(k,2385) + lu(k,2415) = lu(k,2415) - lu(k,1156) * lu(k,2385) + lu(k,2420) = lu(k,2420) - lu(k,1157) * lu(k,2385) + lu(k,1158) = 1._r8 / lu(k,1158) + lu(k,1159) = lu(k,1159) * lu(k,1158) + lu(k,1160) = lu(k,1160) * lu(k,1158) + lu(k,1161) = lu(k,1161) * lu(k,1158) + lu(k,1165) = lu(k,1165) - lu(k,1159) * lu(k,1163) + lu(k,1166) = lu(k,1166) - lu(k,1160) * lu(k,1163) + lu(k,1167) = lu(k,1167) - lu(k,1161) * lu(k,1163) + lu(k,1179) = lu(k,1179) - lu(k,1159) * lu(k,1174) + lu(k,1180) = lu(k,1180) - lu(k,1160) * lu(k,1174) + lu(k,1184) = lu(k,1184) - lu(k,1161) * lu(k,1174) + lu(k,1197) = - lu(k,1159) * lu(k,1191) + lu(k,1198) = lu(k,1198) - lu(k,1160) * lu(k,1191) + lu(k,1202) = lu(k,1202) - lu(k,1161) * lu(k,1191) + lu(k,1234) = lu(k,1234) - lu(k,1159) * lu(k,1228) + lu(k,1235) = lu(k,1235) - lu(k,1160) * lu(k,1228) + lu(k,1239) = lu(k,1239) - lu(k,1161) * lu(k,1228) + lu(k,1256) = lu(k,1256) - lu(k,1159) * lu(k,1248) + lu(k,1257) = lu(k,1257) - lu(k,1160) * lu(k,1248) + lu(k,1262) = lu(k,1262) - lu(k,1161) * lu(k,1248) + lu(k,1272) = lu(k,1272) - lu(k,1159) * lu(k,1266) + lu(k,1273) = lu(k,1273) - lu(k,1160) * lu(k,1266) + lu(k,1274) = lu(k,1274) - lu(k,1161) * lu(k,1266) + lu(k,1281) = - lu(k,1159) * lu(k,1278) + lu(k,1282) = lu(k,1282) - lu(k,1160) * lu(k,1278) + lu(k,1285) = lu(k,1285) - lu(k,1161) * lu(k,1278) + lu(k,1335) = lu(k,1335) - lu(k,1159) * lu(k,1322) + lu(k,1336) = lu(k,1336) - lu(k,1160) * lu(k,1322) + lu(k,1341) = lu(k,1341) - lu(k,1161) * lu(k,1322) + lu(k,1357) = - lu(k,1159) * lu(k,1348) + lu(k,1358) = lu(k,1358) - lu(k,1160) * lu(k,1348) + lu(k,1363) = lu(k,1363) - lu(k,1161) * lu(k,1348) + lu(k,1377) = lu(k,1377) - lu(k,1159) * lu(k,1370) + lu(k,1379) = lu(k,1379) - lu(k,1160) * lu(k,1370) + lu(k,1384) = lu(k,1384) - lu(k,1161) * lu(k,1370) + lu(k,1427) = lu(k,1427) - lu(k,1159) * lu(k,1414) + lu(k,1429) = lu(k,1429) - lu(k,1160) * lu(k,1414) + lu(k,1434) = lu(k,1434) - lu(k,1161) * lu(k,1414) + lu(k,1448) = lu(k,1448) - lu(k,1159) * lu(k,1447) + lu(k,1451) = lu(k,1451) - lu(k,1160) * lu(k,1447) + lu(k,1455) = - lu(k,1161) * lu(k,1447) + lu(k,1508) = - lu(k,1159) * lu(k,1507) + lu(k,1513) = lu(k,1513) - lu(k,1160) * lu(k,1507) + lu(k,1517) = lu(k,1517) - lu(k,1161) * lu(k,1507) + lu(k,1537) = lu(k,1537) - lu(k,1159) * lu(k,1535) + lu(k,1544) = lu(k,1544) - lu(k,1160) * lu(k,1535) + lu(k,1549) = lu(k,1549) - lu(k,1161) * lu(k,1535) + lu(k,1790) = lu(k,1790) - lu(k,1159) * lu(k,1774) + lu(k,1799) = lu(k,1799) - lu(k,1160) * lu(k,1774) + lu(k,1806) = lu(k,1806) - lu(k,1161) * lu(k,1774) + lu(k,1836) = lu(k,1836) - lu(k,1159) * lu(k,1831) + lu(k,1844) = lu(k,1844) - lu(k,1160) * lu(k,1831) + lu(k,1851) = lu(k,1851) - lu(k,1161) * lu(k,1831) + lu(k,1897) = lu(k,1897) - lu(k,1159) * lu(k,1881) + lu(k,1904) = lu(k,1904) - lu(k,1160) * lu(k,1881) + lu(k,1911) = lu(k,1911) - lu(k,1161) * lu(k,1881) + lu(k,1942) = lu(k,1942) - lu(k,1159) * lu(k,1937) + lu(k,1950) = lu(k,1950) - lu(k,1160) * lu(k,1937) + lu(k,1957) = lu(k,1957) - lu(k,1161) * lu(k,1937) + lu(k,2062) = lu(k,2062) - lu(k,1159) * lu(k,2046) + lu(k,2068) = lu(k,2068) - lu(k,1160) * lu(k,2046) + lu(k,2075) = lu(k,2075) - lu(k,1161) * lu(k,2046) + lu(k,2189) = lu(k,2189) - lu(k,1159) * lu(k,2174) + lu(k,2197) = lu(k,2197) - lu(k,1160) * lu(k,2174) + lu(k,2204) = lu(k,2204) - lu(k,1161) * lu(k,2174) + lu(k,2244) = lu(k,2244) - lu(k,1159) * lu(k,2229) + lu(k,2249) = lu(k,2249) - lu(k,1160) * lu(k,2229) + lu(k,2256) = lu(k,2256) - lu(k,1161) * lu(k,2229) + lu(k,2266) = lu(k,2266) - lu(k,1159) * lu(k,2265) + lu(k,2274) = lu(k,2274) - lu(k,1160) * lu(k,2265) + lu(k,2281) = lu(k,2281) - lu(k,1161) * lu(k,2265) + lu(k,2308) = lu(k,2308) - lu(k,1159) * lu(k,2307) + lu(k,2317) = lu(k,2317) - lu(k,1160) * lu(k,2307) + lu(k,2324) = lu(k,2324) - lu(k,1161) * lu(k,2307) + lu(k,2335) = lu(k,2335) - lu(k,1159) * lu(k,2334) + lu(k,2343) = lu(k,2343) - lu(k,1160) * lu(k,2334) + lu(k,2350) = lu(k,2350) - lu(k,1161) * lu(k,2334) + lu(k,2400) = lu(k,2400) - lu(k,1159) * lu(k,2386) + lu(k,2407) = lu(k,2407) - lu(k,1160) * lu(k,2386) + lu(k,2414) = lu(k,2414) - lu(k,1161) * lu(k,2386) + lu(k,1164) = 1._r8 / lu(k,1164) + lu(k,1165) = lu(k,1165) * lu(k,1164) + lu(k,1166) = lu(k,1166) * lu(k,1164) + lu(k,1167) = lu(k,1167) * lu(k,1164) + lu(k,1168) = lu(k,1168) * lu(k,1164) + lu(k,1179) = lu(k,1179) - lu(k,1165) * lu(k,1175) + lu(k,1180) = lu(k,1180) - lu(k,1166) * lu(k,1175) + lu(k,1184) = lu(k,1184) - lu(k,1167) * lu(k,1175) + lu(k,1186) = lu(k,1186) - lu(k,1168) * lu(k,1175) + lu(k,1197) = lu(k,1197) - lu(k,1165) * lu(k,1192) + lu(k,1198) = lu(k,1198) - lu(k,1166) * lu(k,1192) + lu(k,1202) = lu(k,1202) - lu(k,1167) * lu(k,1192) + lu(k,1204) = lu(k,1204) - lu(k,1168) * lu(k,1192) + lu(k,1234) = lu(k,1234) - lu(k,1165) * lu(k,1229) + lu(k,1235) = lu(k,1235) - lu(k,1166) * lu(k,1229) + lu(k,1239) = lu(k,1239) - lu(k,1167) * lu(k,1229) + lu(k,1241) = lu(k,1241) - lu(k,1168) * lu(k,1229) + lu(k,1256) = lu(k,1256) - lu(k,1165) * lu(k,1249) + lu(k,1257) = lu(k,1257) - lu(k,1166) * lu(k,1249) + lu(k,1262) = lu(k,1262) - lu(k,1167) * lu(k,1249) + lu(k,1264) = lu(k,1264) - lu(k,1168) * lu(k,1249) + lu(k,1302) = lu(k,1302) - lu(k,1165) * lu(k,1290) + lu(k,1303) = lu(k,1303) - lu(k,1166) * lu(k,1290) + lu(k,1308) = lu(k,1308) - lu(k,1167) * lu(k,1290) + lu(k,1310) = lu(k,1310) - lu(k,1168) * lu(k,1290) + lu(k,1335) = lu(k,1335) - lu(k,1165) * lu(k,1323) + lu(k,1336) = lu(k,1336) - lu(k,1166) * lu(k,1323) + lu(k,1341) = lu(k,1341) - lu(k,1167) * lu(k,1323) + lu(k,1343) = lu(k,1343) - lu(k,1168) * lu(k,1323) + lu(k,1357) = lu(k,1357) - lu(k,1165) * lu(k,1349) + lu(k,1358) = lu(k,1358) - lu(k,1166) * lu(k,1349) + lu(k,1363) = lu(k,1363) - lu(k,1167) * lu(k,1349) + lu(k,1365) = lu(k,1365) - lu(k,1168) * lu(k,1349) + lu(k,1427) = lu(k,1427) - lu(k,1165) * lu(k,1415) + lu(k,1429) = lu(k,1429) - lu(k,1166) * lu(k,1415) + lu(k,1434) = lu(k,1434) - lu(k,1167) * lu(k,1415) + lu(k,1437) = lu(k,1437) - lu(k,1168) * lu(k,1415) + lu(k,1537) = lu(k,1537) - lu(k,1165) * lu(k,1536) + lu(k,1544) = lu(k,1544) - lu(k,1166) * lu(k,1536) + lu(k,1549) = lu(k,1549) - lu(k,1167) * lu(k,1536) + lu(k,1551) = lu(k,1551) - lu(k,1168) * lu(k,1536) + lu(k,1790) = lu(k,1790) - lu(k,1165) * lu(k,1775) + lu(k,1799) = lu(k,1799) - lu(k,1166) * lu(k,1775) + lu(k,1806) = lu(k,1806) - lu(k,1167) * lu(k,1775) + lu(k,1810) = lu(k,1810) - lu(k,1168) * lu(k,1775) + lu(k,1897) = lu(k,1897) - lu(k,1165) * lu(k,1882) + lu(k,1904) = lu(k,1904) - lu(k,1166) * lu(k,1882) + lu(k,1911) = lu(k,1911) - lu(k,1167) * lu(k,1882) + lu(k,1915) = lu(k,1915) - lu(k,1168) * lu(k,1882) + lu(k,1942) = lu(k,1942) - lu(k,1165) * lu(k,1938) + lu(k,1950) = lu(k,1950) - lu(k,1166) * lu(k,1938) + lu(k,1957) = lu(k,1957) - lu(k,1167) * lu(k,1938) + lu(k,1961) = lu(k,1961) - lu(k,1168) * lu(k,1938) + lu(k,2062) = lu(k,2062) - lu(k,1165) * lu(k,2047) + lu(k,2068) = lu(k,2068) - lu(k,1166) * lu(k,2047) + lu(k,2075) = lu(k,2075) - lu(k,1167) * lu(k,2047) + lu(k,2079) = lu(k,2079) - lu(k,1168) * lu(k,2047) + lu(k,2189) = lu(k,2189) - lu(k,1165) * lu(k,2175) + lu(k,2197) = lu(k,2197) - lu(k,1166) * lu(k,2175) + lu(k,2204) = lu(k,2204) - lu(k,1167) * lu(k,2175) + lu(k,2208) = lu(k,2208) - lu(k,1168) * lu(k,2175) + lu(k,2244) = lu(k,2244) - lu(k,1165) * lu(k,2230) + lu(k,2249) = lu(k,2249) - lu(k,1166) * lu(k,2230) + lu(k,2256) = lu(k,2256) - lu(k,1167) * lu(k,2230) + lu(k,2260) = lu(k,2260) - lu(k,1168) * lu(k,2230) + lu(k,2400) = lu(k,2400) - lu(k,1165) * lu(k,2387) + lu(k,2407) = lu(k,2407) - lu(k,1166) * lu(k,2387) + lu(k,2414) = lu(k,2414) - lu(k,1167) * lu(k,2387) + lu(k,2418) = lu(k,2418) - lu(k,1168) * lu(k,2387) + end do + end subroutine lu_fac24 + subroutine lu_fac25( 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,1176) = 1._r8 / lu(k,1176) + lu(k,1177) = lu(k,1177) * lu(k,1176) + lu(k,1178) = lu(k,1178) * lu(k,1176) + lu(k,1179) = lu(k,1179) * lu(k,1176) + lu(k,1180) = lu(k,1180) * lu(k,1176) + lu(k,1181) = lu(k,1181) * lu(k,1176) + lu(k,1182) = lu(k,1182) * lu(k,1176) + lu(k,1183) = lu(k,1183) * lu(k,1176) + lu(k,1184) = lu(k,1184) * lu(k,1176) + lu(k,1185) = lu(k,1185) * lu(k,1176) + lu(k,1186) = lu(k,1186) * lu(k,1176) + lu(k,1187) = lu(k,1187) * lu(k,1176) + lu(k,1779) = lu(k,1779) - lu(k,1177) * lu(k,1776) + lu(k,1789) = lu(k,1789) - lu(k,1178) * lu(k,1776) + lu(k,1790) = lu(k,1790) - lu(k,1179) * lu(k,1776) + lu(k,1799) = lu(k,1799) - lu(k,1180) * lu(k,1776) + lu(k,1800) = lu(k,1800) - lu(k,1181) * lu(k,1776) + lu(k,1803) = lu(k,1803) - lu(k,1182) * lu(k,1776) + lu(k,1804) = lu(k,1804) - lu(k,1183) * lu(k,1776) + lu(k,1806) = lu(k,1806) - lu(k,1184) * lu(k,1776) + lu(k,1807) = lu(k,1807) - lu(k,1185) * lu(k,1776) + lu(k,1810) = lu(k,1810) - lu(k,1186) * lu(k,1776) + lu(k,1812) = lu(k,1812) - lu(k,1187) * lu(k,1776) + lu(k,1886) = lu(k,1886) - lu(k,1177) * lu(k,1883) + lu(k,1896) = lu(k,1896) - lu(k,1178) * lu(k,1883) + lu(k,1897) = lu(k,1897) - lu(k,1179) * lu(k,1883) + lu(k,1904) = lu(k,1904) - lu(k,1180) * lu(k,1883) + lu(k,1905) = lu(k,1905) - lu(k,1181) * lu(k,1883) + lu(k,1908) = lu(k,1908) - lu(k,1182) * lu(k,1883) + lu(k,1909) = lu(k,1909) - lu(k,1183) * lu(k,1883) + lu(k,1911) = lu(k,1911) - lu(k,1184) * lu(k,1883) + lu(k,1912) = lu(k,1912) - lu(k,1185) * lu(k,1883) + lu(k,1915) = lu(k,1915) - lu(k,1186) * lu(k,1883) + lu(k,1917) = lu(k,1917) - lu(k,1187) * lu(k,1883) + lu(k,2051) = lu(k,2051) - lu(k,1177) * lu(k,2048) + lu(k,2061) = lu(k,2061) - lu(k,1178) * lu(k,2048) + lu(k,2062) = lu(k,2062) - lu(k,1179) * lu(k,2048) + lu(k,2068) = lu(k,2068) - lu(k,1180) * lu(k,2048) + lu(k,2069) = lu(k,2069) - lu(k,1181) * lu(k,2048) + lu(k,2072) = lu(k,2072) - lu(k,1182) * lu(k,2048) + lu(k,2073) = lu(k,2073) - lu(k,1183) * lu(k,2048) + lu(k,2075) = lu(k,2075) - lu(k,1184) * lu(k,2048) + lu(k,2076) = lu(k,2076) - lu(k,1185) * lu(k,2048) + lu(k,2079) = lu(k,2079) - lu(k,1186) * lu(k,2048) + lu(k,2081) = lu(k,2081) - lu(k,1187) * lu(k,2048) + lu(k,2178) = lu(k,2178) - lu(k,1177) * lu(k,2176) + lu(k,2188) = lu(k,2188) - lu(k,1178) * lu(k,2176) + lu(k,2189) = lu(k,2189) - lu(k,1179) * lu(k,2176) + lu(k,2197) = lu(k,2197) - lu(k,1180) * lu(k,2176) + lu(k,2198) = lu(k,2198) - lu(k,1181) * lu(k,2176) + lu(k,2201) = lu(k,2201) - lu(k,1182) * lu(k,2176) + lu(k,2202) = lu(k,2202) - lu(k,1183) * lu(k,2176) + lu(k,2204) = lu(k,2204) - lu(k,1184) * lu(k,2176) + lu(k,2205) = lu(k,2205) - lu(k,1185) * lu(k,2176) + lu(k,2208) = lu(k,2208) - lu(k,1186) * lu(k,2176) + lu(k,2210) = lu(k,2210) - lu(k,1187) * lu(k,2176) + lu(k,2233) = lu(k,2233) - lu(k,1177) * lu(k,2231) + lu(k,2243) = lu(k,2243) - lu(k,1178) * lu(k,2231) + lu(k,2244) = lu(k,2244) - lu(k,1179) * lu(k,2231) + lu(k,2249) = lu(k,2249) - lu(k,1180) * lu(k,2231) + lu(k,2250) = lu(k,2250) - lu(k,1181) * lu(k,2231) + lu(k,2253) = lu(k,2253) - lu(k,1182) * lu(k,2231) + lu(k,2254) = lu(k,2254) - lu(k,1183) * lu(k,2231) + lu(k,2256) = lu(k,2256) - lu(k,1184) * lu(k,2231) + lu(k,2257) = lu(k,2257) - lu(k,1185) * lu(k,2231) + lu(k,2260) = lu(k,2260) - lu(k,1186) * lu(k,2231) + lu(k,2262) = lu(k,2262) - lu(k,1187) * lu(k,2231) + lu(k,2390) = lu(k,2390) - lu(k,1177) * lu(k,2388) + lu(k,2399) = lu(k,2399) - lu(k,1178) * lu(k,2388) + lu(k,2400) = lu(k,2400) - lu(k,1179) * lu(k,2388) + lu(k,2407) = lu(k,2407) - lu(k,1180) * lu(k,2388) + lu(k,2408) = lu(k,2408) - lu(k,1181) * lu(k,2388) + lu(k,2411) = lu(k,2411) - lu(k,1182) * lu(k,2388) + lu(k,2412) = lu(k,2412) - lu(k,1183) * lu(k,2388) + lu(k,2414) = lu(k,2414) - lu(k,1184) * lu(k,2388) + lu(k,2415) = lu(k,2415) - lu(k,1185) * lu(k,2388) + lu(k,2418) = lu(k,2418) - lu(k,1186) * lu(k,2388) + lu(k,2420) = lu(k,2420) - lu(k,1187) * lu(k,2388) + lu(k,1193) = 1._r8 / lu(k,1193) + lu(k,1194) = lu(k,1194) * lu(k,1193) + lu(k,1195) = lu(k,1195) * lu(k,1193) + lu(k,1196) = lu(k,1196) * lu(k,1193) + lu(k,1197) = lu(k,1197) * lu(k,1193) + lu(k,1198) = lu(k,1198) * lu(k,1193) + lu(k,1199) = lu(k,1199) * lu(k,1193) + lu(k,1200) = lu(k,1200) * lu(k,1193) + lu(k,1201) = lu(k,1201) * lu(k,1193) + lu(k,1202) = lu(k,1202) * lu(k,1193) + lu(k,1203) = lu(k,1203) * lu(k,1193) + lu(k,1204) = lu(k,1204) * lu(k,1193) + lu(k,1205) = lu(k,1205) * lu(k,1193) + lu(k,1292) = lu(k,1292) - lu(k,1194) * lu(k,1291) + lu(k,1293) = - lu(k,1195) * lu(k,1291) + lu(k,1301) = lu(k,1301) - lu(k,1196) * lu(k,1291) + lu(k,1302) = lu(k,1302) - lu(k,1197) * lu(k,1291) + lu(k,1303) = lu(k,1303) - lu(k,1198) * lu(k,1291) + lu(k,1304) = lu(k,1304) - lu(k,1199) * lu(k,1291) + lu(k,1305) = lu(k,1305) - lu(k,1200) * lu(k,1291) + lu(k,1306) = lu(k,1306) - lu(k,1201) * lu(k,1291) + lu(k,1308) = lu(k,1308) - lu(k,1202) * lu(k,1291) + lu(k,1309) = lu(k,1309) - lu(k,1203) * lu(k,1291) + lu(k,1310) = lu(k,1310) - lu(k,1204) * lu(k,1291) + lu(k,1312) = - lu(k,1205) * lu(k,1291) + lu(k,1325) = lu(k,1325) - lu(k,1194) * lu(k,1324) + lu(k,1326) = - lu(k,1195) * lu(k,1324) + lu(k,1334) = lu(k,1334) - lu(k,1196) * lu(k,1324) + lu(k,1335) = lu(k,1335) - lu(k,1197) * lu(k,1324) + lu(k,1336) = lu(k,1336) - lu(k,1198) * lu(k,1324) + lu(k,1337) = lu(k,1337) - lu(k,1199) * lu(k,1324) + lu(k,1338) = lu(k,1338) - lu(k,1200) * lu(k,1324) + lu(k,1339) = lu(k,1339) - lu(k,1201) * lu(k,1324) + lu(k,1341) = lu(k,1341) - lu(k,1202) * lu(k,1324) + lu(k,1342) = lu(k,1342) - lu(k,1203) * lu(k,1324) + lu(k,1343) = lu(k,1343) - lu(k,1204) * lu(k,1324) + lu(k,1345) = - lu(k,1205) * lu(k,1324) + lu(k,1351) = lu(k,1351) - lu(k,1194) * lu(k,1350) + lu(k,1352) = - lu(k,1195) * lu(k,1350) + lu(k,1356) = lu(k,1356) - lu(k,1196) * lu(k,1350) + lu(k,1357) = lu(k,1357) - lu(k,1197) * lu(k,1350) + lu(k,1358) = lu(k,1358) - lu(k,1198) * lu(k,1350) + lu(k,1359) = lu(k,1359) - lu(k,1199) * lu(k,1350) + lu(k,1360) = lu(k,1360) - lu(k,1200) * lu(k,1350) + lu(k,1361) = - lu(k,1201) * lu(k,1350) + lu(k,1363) = lu(k,1363) - lu(k,1202) * lu(k,1350) + lu(k,1364) = lu(k,1364) - lu(k,1203) * lu(k,1350) + lu(k,1365) = lu(k,1365) - lu(k,1204) * lu(k,1350) + lu(k,1366) = - lu(k,1205) * lu(k,1350) + lu(k,1778) = lu(k,1778) - lu(k,1194) * lu(k,1777) + lu(k,1779) = lu(k,1779) - lu(k,1195) * lu(k,1777) + lu(k,1789) = lu(k,1789) - lu(k,1196) * lu(k,1777) + lu(k,1790) = lu(k,1790) - lu(k,1197) * lu(k,1777) + lu(k,1799) = lu(k,1799) - lu(k,1198) * lu(k,1777) + lu(k,1800) = lu(k,1800) - lu(k,1199) * lu(k,1777) + lu(k,1801) = lu(k,1801) - lu(k,1200) * lu(k,1777) + lu(k,1803) = lu(k,1803) - lu(k,1201) * lu(k,1777) + lu(k,1806) = lu(k,1806) - lu(k,1202) * lu(k,1777) + lu(k,1807) = lu(k,1807) - lu(k,1203) * lu(k,1777) + lu(k,1810) = lu(k,1810) - lu(k,1204) * lu(k,1777) + lu(k,1812) = lu(k,1812) - lu(k,1205) * lu(k,1777) + lu(k,1885) = lu(k,1885) - lu(k,1194) * lu(k,1884) + lu(k,1886) = lu(k,1886) - lu(k,1195) * lu(k,1884) + lu(k,1896) = lu(k,1896) - lu(k,1196) * lu(k,1884) + lu(k,1897) = lu(k,1897) - lu(k,1197) * lu(k,1884) + lu(k,1904) = lu(k,1904) - lu(k,1198) * lu(k,1884) + lu(k,1905) = lu(k,1905) - lu(k,1199) * lu(k,1884) + lu(k,1906) = lu(k,1906) - lu(k,1200) * lu(k,1884) + lu(k,1908) = lu(k,1908) - lu(k,1201) * lu(k,1884) + lu(k,1911) = lu(k,1911) - lu(k,1202) * lu(k,1884) + lu(k,1912) = lu(k,1912) - lu(k,1203) * lu(k,1884) + lu(k,1915) = lu(k,1915) - lu(k,1204) * lu(k,1884) + lu(k,1917) = lu(k,1917) - lu(k,1205) * lu(k,1884) + lu(k,2050) = lu(k,2050) - lu(k,1194) * lu(k,2049) + lu(k,2051) = lu(k,2051) - lu(k,1195) * lu(k,2049) + lu(k,2061) = lu(k,2061) - lu(k,1196) * lu(k,2049) + lu(k,2062) = lu(k,2062) - lu(k,1197) * lu(k,2049) + lu(k,2068) = lu(k,2068) - lu(k,1198) * lu(k,2049) + lu(k,2069) = lu(k,2069) - lu(k,1199) * lu(k,2049) + lu(k,2070) = lu(k,2070) - lu(k,1200) * lu(k,2049) + lu(k,2072) = lu(k,2072) - lu(k,1201) * lu(k,2049) + lu(k,2075) = lu(k,2075) - lu(k,1202) * lu(k,2049) + lu(k,2076) = lu(k,2076) - lu(k,1203) * lu(k,2049) + lu(k,2079) = lu(k,2079) - lu(k,1204) * lu(k,2049) + lu(k,2081) = lu(k,2081) - lu(k,1205) * lu(k,2049) lu(k,1206) = 1._r8 / lu(k,1206) lu(k,1207) = lu(k,1207) * lu(k,1206) lu(k,1208) = lu(k,1208) * lu(k,1206) lu(k,1209) = lu(k,1209) * lu(k,1206) lu(k,1210) = lu(k,1210) * lu(k,1206) lu(k,1211) = lu(k,1211) * lu(k,1206) - lu(k,1212) = lu(k,1212) * lu(k,1206) - lu(k,1213) = lu(k,1213) * lu(k,1206) - lu(k,1214) = lu(k,1214) * lu(k,1206) - lu(k,1215) = lu(k,1215) * lu(k,1206) - lu(k,1216) = lu(k,1216) * lu(k,1206) - lu(k,1217) = lu(k,1217) * lu(k,1206) - lu(k,1218) = lu(k,1218) * lu(k,1206) - lu(k,1219) = lu(k,1219) * lu(k,1206) - lu(k,1220) = lu(k,1220) * lu(k,1206) - lu(k,1221) = lu(k,1221) * lu(k,1206) - lu(k,1299) = lu(k,1299) - lu(k,1207) * lu(k,1298) - lu(k,1300) = lu(k,1300) - lu(k,1208) * lu(k,1298) - lu(k,1301) = lu(k,1301) - lu(k,1209) * lu(k,1298) - lu(k,1302) = lu(k,1302) - lu(k,1210) * lu(k,1298) - lu(k,1303) = lu(k,1303) - lu(k,1211) * lu(k,1298) - lu(k,1305) = lu(k,1305) - lu(k,1212) * lu(k,1298) - lu(k,1306) = lu(k,1306) - lu(k,1213) * lu(k,1298) - lu(k,1307) = lu(k,1307) - lu(k,1214) * lu(k,1298) - lu(k,1308) = lu(k,1308) - lu(k,1215) * lu(k,1298) - lu(k,1309) = lu(k,1309) - lu(k,1216) * lu(k,1298) - lu(k,1310) = lu(k,1310) - lu(k,1217) * lu(k,1298) - lu(k,1311) = lu(k,1311) - lu(k,1218) * lu(k,1298) - lu(k,1312) = lu(k,1312) - lu(k,1219) * lu(k,1298) - lu(k,1313) = lu(k,1313) - lu(k,1220) * lu(k,1298) - lu(k,1314) = lu(k,1314) - lu(k,1221) * lu(k,1298) - lu(k,1392) = lu(k,1392) - lu(k,1207) * lu(k,1391) - lu(k,1393) = lu(k,1393) - lu(k,1208) * lu(k,1391) - lu(k,1394) = lu(k,1394) - lu(k,1209) * lu(k,1391) - lu(k,1395) = lu(k,1395) - lu(k,1210) * lu(k,1391) - lu(k,1396) = lu(k,1396) - lu(k,1211) * lu(k,1391) - lu(k,1398) = lu(k,1398) - lu(k,1212) * lu(k,1391) - lu(k,1400) = lu(k,1400) - lu(k,1213) * lu(k,1391) - lu(k,1401) = lu(k,1401) - lu(k,1214) * lu(k,1391) - lu(k,1402) = lu(k,1402) - lu(k,1215) * lu(k,1391) - lu(k,1403) = lu(k,1403) - lu(k,1216) * lu(k,1391) - lu(k,1404) = lu(k,1404) - lu(k,1217) * lu(k,1391) - lu(k,1405) = lu(k,1405) - lu(k,1218) * lu(k,1391) - lu(k,1406) = lu(k,1406) - lu(k,1219) * lu(k,1391) - lu(k,1407) = lu(k,1407) - lu(k,1220) * lu(k,1391) - lu(k,1409) = lu(k,1409) - lu(k,1221) * lu(k,1391) - lu(k,1500) = lu(k,1500) - lu(k,1207) * lu(k,1499) - lu(k,1501) = lu(k,1501) - lu(k,1208) * lu(k,1499) - lu(k,1502) = lu(k,1502) - lu(k,1209) * lu(k,1499) - lu(k,1503) = lu(k,1503) - lu(k,1210) * lu(k,1499) - lu(k,1505) = lu(k,1505) - lu(k,1211) * lu(k,1499) - lu(k,1507) = lu(k,1507) - lu(k,1212) * lu(k,1499) - lu(k,1510) = lu(k,1510) - lu(k,1213) * lu(k,1499) - lu(k,1511) = lu(k,1511) - lu(k,1214) * lu(k,1499) - lu(k,1513) = lu(k,1513) - lu(k,1215) * lu(k,1499) - lu(k,1514) = lu(k,1514) - lu(k,1216) * lu(k,1499) - lu(k,1515) = lu(k,1515) - lu(k,1217) * lu(k,1499) - lu(k,1516) = lu(k,1516) - lu(k,1218) * lu(k,1499) - lu(k,1517) = lu(k,1517) - lu(k,1219) * lu(k,1499) - lu(k,1519) = lu(k,1519) - lu(k,1220) * lu(k,1499) - lu(k,1521) = lu(k,1521) - lu(k,1221) * lu(k,1499) - lu(k,1707) = lu(k,1707) - lu(k,1207) * lu(k,1706) - lu(k,1708) = lu(k,1708) - lu(k,1208) * lu(k,1706) - lu(k,1709) = lu(k,1709) - lu(k,1209) * lu(k,1706) - lu(k,1710) = lu(k,1710) - lu(k,1210) * lu(k,1706) - lu(k,1714) = lu(k,1714) - lu(k,1211) * lu(k,1706) - lu(k,1716) = lu(k,1716) - lu(k,1212) * lu(k,1706) - lu(k,1719) = lu(k,1719) - lu(k,1213) * lu(k,1706) - lu(k,1720) = lu(k,1720) - lu(k,1214) * lu(k,1706) - lu(k,1722) = lu(k,1722) - lu(k,1215) * lu(k,1706) - lu(k,1723) = lu(k,1723) - lu(k,1216) * lu(k,1706) - lu(k,1724) = lu(k,1724) - lu(k,1217) * lu(k,1706) - lu(k,1725) = lu(k,1725) - lu(k,1218) * lu(k,1706) - lu(k,1726) = lu(k,1726) - lu(k,1219) * lu(k,1706) - lu(k,1728) = lu(k,1728) - lu(k,1220) * lu(k,1706) - lu(k,1730) = lu(k,1730) - lu(k,1221) * lu(k,1706) - lu(k,1770) = lu(k,1770) - lu(k,1207) * lu(k,1769) - lu(k,1771) = lu(k,1771) - lu(k,1208) * lu(k,1769) - lu(k,1772) = lu(k,1772) - lu(k,1209) * lu(k,1769) - lu(k,1773) = lu(k,1773) - lu(k,1210) * lu(k,1769) - lu(k,1776) = lu(k,1776) - lu(k,1211) * lu(k,1769) - lu(k,1778) = lu(k,1778) - lu(k,1212) * lu(k,1769) - lu(k,1781) = lu(k,1781) - lu(k,1213) * lu(k,1769) - lu(k,1782) = lu(k,1782) - lu(k,1214) * lu(k,1769) - lu(k,1784) = lu(k,1784) - lu(k,1215) * lu(k,1769) - lu(k,1785) = lu(k,1785) - lu(k,1216) * lu(k,1769) - lu(k,1786) = lu(k,1786) - lu(k,1217) * lu(k,1769) - lu(k,1787) = lu(k,1787) - lu(k,1218) * lu(k,1769) - lu(k,1788) = lu(k,1788) - lu(k,1219) * lu(k,1769) - lu(k,1790) = lu(k,1790) - lu(k,1220) * lu(k,1769) - lu(k,1792) = lu(k,1792) - lu(k,1221) * lu(k,1769) - lu(k,1892) = lu(k,1892) - lu(k,1207) * lu(k,1891) - lu(k,1893) = lu(k,1893) - lu(k,1208) * lu(k,1891) - lu(k,1894) = lu(k,1894) - lu(k,1209) * lu(k,1891) - lu(k,1895) = lu(k,1895) - lu(k,1210) * lu(k,1891) - lu(k,1898) = lu(k,1898) - lu(k,1211) * lu(k,1891) - lu(k,1900) = lu(k,1900) - lu(k,1212) * lu(k,1891) - lu(k,1903) = lu(k,1903) - lu(k,1213) * lu(k,1891) - lu(k,1904) = lu(k,1904) - lu(k,1214) * lu(k,1891) - lu(k,1906) = lu(k,1906) - lu(k,1215) * lu(k,1891) - lu(k,1907) = lu(k,1907) - lu(k,1216) * lu(k,1891) - lu(k,1908) = lu(k,1908) - lu(k,1217) * lu(k,1891) - lu(k,1909) = lu(k,1909) - lu(k,1218) * lu(k,1891) - lu(k,1910) = lu(k,1910) - lu(k,1219) * lu(k,1891) - lu(k,1912) = lu(k,1912) - lu(k,1220) * lu(k,1891) - lu(k,1914) = lu(k,1914) - lu(k,1221) * lu(k,1891) - lu(k,2095) = lu(k,2095) - lu(k,1207) * lu(k,2094) - lu(k,2096) = lu(k,2096) - lu(k,1208) * lu(k,2094) - lu(k,2097) = lu(k,2097) - lu(k,1209) * lu(k,2094) - lu(k,2098) = lu(k,2098) - lu(k,1210) * lu(k,2094) - lu(k,2101) = lu(k,2101) - lu(k,1211) * lu(k,2094) - lu(k,2103) = lu(k,2103) - lu(k,1212) * lu(k,2094) - lu(k,2106) = lu(k,2106) - lu(k,1213) * lu(k,2094) - lu(k,2107) = lu(k,2107) - lu(k,1214) * lu(k,2094) - lu(k,2109) = lu(k,2109) - lu(k,1215) * lu(k,2094) - lu(k,2110) = lu(k,2110) - lu(k,1216) * lu(k,2094) - lu(k,2111) = lu(k,2111) - lu(k,1217) * lu(k,2094) - lu(k,2112) = lu(k,2112) - lu(k,1218) * lu(k,2094) - lu(k,2113) = lu(k,2113) - lu(k,1219) * lu(k,2094) - lu(k,2115) = lu(k,2115) - lu(k,1220) * lu(k,2094) - lu(k,2117) = lu(k,2117) - lu(k,1221) * lu(k,2094) + lu(k,1216) = lu(k,1216) - lu(k,1207) * lu(k,1214) + lu(k,1217) = lu(k,1217) - lu(k,1208) * lu(k,1214) + lu(k,1218) = lu(k,1218) - lu(k,1209) * lu(k,1214) + lu(k,1221) = lu(k,1221) - lu(k,1210) * lu(k,1214) + lu(k,1223) = lu(k,1223) - lu(k,1211) * lu(k,1214) + lu(k,1232) = lu(k,1232) - lu(k,1207) * lu(k,1230) + lu(k,1233) = lu(k,1233) - lu(k,1208) * lu(k,1230) + lu(k,1235) = lu(k,1235) - lu(k,1209) * lu(k,1230) + lu(k,1239) = lu(k,1239) - lu(k,1210) * lu(k,1230) + lu(k,1241) = lu(k,1241) - lu(k,1211) * lu(k,1230) + lu(k,1296) = - lu(k,1207) * lu(k,1292) + lu(k,1301) = lu(k,1301) - lu(k,1208) * lu(k,1292) + lu(k,1303) = lu(k,1303) - lu(k,1209) * lu(k,1292) + lu(k,1308) = lu(k,1308) - lu(k,1210) * lu(k,1292) + lu(k,1310) = lu(k,1310) - lu(k,1211) * lu(k,1292) + lu(k,1329) = lu(k,1329) - lu(k,1207) * lu(k,1325) + lu(k,1334) = lu(k,1334) - lu(k,1208) * lu(k,1325) + lu(k,1336) = lu(k,1336) - lu(k,1209) * lu(k,1325) + lu(k,1341) = lu(k,1341) - lu(k,1210) * lu(k,1325) + lu(k,1343) = lu(k,1343) - lu(k,1211) * lu(k,1325) + lu(k,1353) = lu(k,1353) - lu(k,1207) * lu(k,1351) + lu(k,1356) = lu(k,1356) - lu(k,1208) * lu(k,1351) + lu(k,1358) = lu(k,1358) - lu(k,1209) * lu(k,1351) + lu(k,1363) = lu(k,1363) - lu(k,1210) * lu(k,1351) + lu(k,1365) = lu(k,1365) - lu(k,1211) * lu(k,1351) + lu(k,1372) = lu(k,1372) - lu(k,1207) * lu(k,1371) + lu(k,1376) = lu(k,1376) - lu(k,1208) * lu(k,1371) + lu(k,1379) = lu(k,1379) - lu(k,1209) * lu(k,1371) + lu(k,1384) = lu(k,1384) - lu(k,1210) * lu(k,1371) + lu(k,1387) = lu(k,1387) - lu(k,1211) * lu(k,1371) + lu(k,1394) = - lu(k,1207) * lu(k,1393) + lu(k,1396) = lu(k,1396) - lu(k,1208) * lu(k,1393) + lu(k,1398) = lu(k,1398) - lu(k,1209) * lu(k,1393) + lu(k,1403) = lu(k,1403) - lu(k,1210) * lu(k,1393) + lu(k,1405) = lu(k,1405) - lu(k,1211) * lu(k,1393) + lu(k,1420) = lu(k,1420) - lu(k,1207) * lu(k,1416) + lu(k,1426) = lu(k,1426) - lu(k,1208) * lu(k,1416) + lu(k,1429) = lu(k,1429) - lu(k,1209) * lu(k,1416) + lu(k,1434) = lu(k,1434) - lu(k,1210) * lu(k,1416) + lu(k,1437) = lu(k,1437) - lu(k,1211) * lu(k,1416) + lu(k,1783) = lu(k,1783) - lu(k,1207) * lu(k,1778) + lu(k,1789) = lu(k,1789) - lu(k,1208) * lu(k,1778) + lu(k,1799) = lu(k,1799) - lu(k,1209) * lu(k,1778) + lu(k,1806) = lu(k,1806) - lu(k,1210) * lu(k,1778) + lu(k,1810) = lu(k,1810) - lu(k,1211) * lu(k,1778) + lu(k,1833) = lu(k,1833) - lu(k,1207) * lu(k,1832) + lu(k,1835) = lu(k,1835) - lu(k,1208) * lu(k,1832) + lu(k,1844) = lu(k,1844) - lu(k,1209) * lu(k,1832) + lu(k,1851) = lu(k,1851) - lu(k,1210) * lu(k,1832) + lu(k,1855) = lu(k,1855) - lu(k,1211) * lu(k,1832) + lu(k,1890) = lu(k,1890) - lu(k,1207) * lu(k,1885) + lu(k,1896) = lu(k,1896) - lu(k,1208) * lu(k,1885) + lu(k,1904) = lu(k,1904) - lu(k,1209) * lu(k,1885) + lu(k,1911) = lu(k,1911) - lu(k,1210) * lu(k,1885) + lu(k,1915) = lu(k,1915) - lu(k,1211) * lu(k,1885) + lu(k,2055) = lu(k,2055) - lu(k,1207) * lu(k,2050) + lu(k,2061) = lu(k,2061) - lu(k,1208) * lu(k,2050) + lu(k,2068) = lu(k,2068) - lu(k,1209) * lu(k,2050) + lu(k,2075) = lu(k,2075) - lu(k,1210) * lu(k,2050) + lu(k,2079) = lu(k,2079) - lu(k,1211) * lu(k,2050) + lu(k,2182) = lu(k,2182) - lu(k,1207) * lu(k,2177) + lu(k,2188) = lu(k,2188) - lu(k,1208) * lu(k,2177) + lu(k,2197) = lu(k,2197) - lu(k,1209) * lu(k,2177) + lu(k,2204) = lu(k,2204) - lu(k,1210) * lu(k,2177) + lu(k,2208) = lu(k,2208) - lu(k,1211) * lu(k,2177) + lu(k,2237) = lu(k,2237) - lu(k,1207) * lu(k,2232) + lu(k,2243) = lu(k,2243) - lu(k,1208) * lu(k,2232) + lu(k,2249) = lu(k,2249) - lu(k,1209) * lu(k,2232) + lu(k,2256) = lu(k,2256) - lu(k,1210) * lu(k,2232) + lu(k,2260) = lu(k,2260) - lu(k,1211) * lu(k,2232) + lu(k,2393) = lu(k,2393) - lu(k,1207) * lu(k,2389) + lu(k,2399) = lu(k,2399) - lu(k,1208) * lu(k,2389) + lu(k,2407) = lu(k,2407) - lu(k,1209) * lu(k,2389) + lu(k,2414) = lu(k,2414) - lu(k,1210) * lu(k,2389) + lu(k,2418) = lu(k,2418) - lu(k,1211) * lu(k,2389) + lu(k,1215) = 1._r8 / lu(k,1215) + lu(k,1216) = lu(k,1216) * lu(k,1215) + lu(k,1217) = lu(k,1217) * lu(k,1215) + lu(k,1218) = lu(k,1218) * lu(k,1215) + lu(k,1219) = lu(k,1219) * lu(k,1215) + lu(k,1220) = lu(k,1220) * lu(k,1215) + lu(k,1221) = lu(k,1221) * lu(k,1215) + lu(k,1222) = lu(k,1222) * lu(k,1215) + lu(k,1223) = lu(k,1223) * lu(k,1215) + lu(k,1224) = lu(k,1224) * lu(k,1215) + lu(k,1296) = lu(k,1296) - lu(k,1216) * lu(k,1293) + lu(k,1301) = lu(k,1301) - lu(k,1217) * lu(k,1293) + lu(k,1303) = lu(k,1303) - lu(k,1218) * lu(k,1293) + lu(k,1304) = lu(k,1304) - lu(k,1219) * lu(k,1293) + lu(k,1307) = lu(k,1307) - lu(k,1220) * lu(k,1293) + lu(k,1308) = lu(k,1308) - lu(k,1221) * lu(k,1293) + lu(k,1309) = lu(k,1309) - lu(k,1222) * lu(k,1293) + lu(k,1310) = lu(k,1310) - lu(k,1223) * lu(k,1293) + lu(k,1312) = lu(k,1312) - lu(k,1224) * lu(k,1293) + lu(k,1329) = lu(k,1329) - lu(k,1216) * lu(k,1326) + lu(k,1334) = lu(k,1334) - lu(k,1217) * lu(k,1326) + lu(k,1336) = lu(k,1336) - lu(k,1218) * lu(k,1326) + lu(k,1337) = lu(k,1337) - lu(k,1219) * lu(k,1326) + lu(k,1340) = lu(k,1340) - lu(k,1220) * lu(k,1326) + lu(k,1341) = lu(k,1341) - lu(k,1221) * lu(k,1326) + lu(k,1342) = lu(k,1342) - lu(k,1222) * lu(k,1326) + lu(k,1343) = lu(k,1343) - lu(k,1223) * lu(k,1326) + lu(k,1345) = lu(k,1345) - lu(k,1224) * lu(k,1326) + lu(k,1353) = lu(k,1353) - lu(k,1216) * lu(k,1352) + lu(k,1356) = lu(k,1356) - lu(k,1217) * lu(k,1352) + lu(k,1358) = lu(k,1358) - lu(k,1218) * lu(k,1352) + lu(k,1359) = lu(k,1359) - lu(k,1219) * lu(k,1352) + lu(k,1362) = lu(k,1362) - lu(k,1220) * lu(k,1352) + lu(k,1363) = lu(k,1363) - lu(k,1221) * lu(k,1352) + lu(k,1364) = lu(k,1364) - lu(k,1222) * lu(k,1352) + lu(k,1365) = lu(k,1365) - lu(k,1223) * lu(k,1352) + lu(k,1366) = lu(k,1366) - lu(k,1224) * lu(k,1352) + lu(k,1783) = lu(k,1783) - lu(k,1216) * lu(k,1779) + lu(k,1789) = lu(k,1789) - lu(k,1217) * lu(k,1779) + lu(k,1799) = lu(k,1799) - lu(k,1218) * lu(k,1779) + lu(k,1800) = lu(k,1800) - lu(k,1219) * lu(k,1779) + lu(k,1804) = lu(k,1804) - lu(k,1220) * lu(k,1779) + lu(k,1806) = lu(k,1806) - lu(k,1221) * lu(k,1779) + lu(k,1807) = lu(k,1807) - lu(k,1222) * lu(k,1779) + lu(k,1810) = lu(k,1810) - lu(k,1223) * lu(k,1779) + lu(k,1812) = lu(k,1812) - lu(k,1224) * lu(k,1779) + lu(k,1890) = lu(k,1890) - lu(k,1216) * lu(k,1886) + lu(k,1896) = lu(k,1896) - lu(k,1217) * lu(k,1886) + lu(k,1904) = lu(k,1904) - lu(k,1218) * lu(k,1886) + lu(k,1905) = lu(k,1905) - lu(k,1219) * lu(k,1886) + lu(k,1909) = lu(k,1909) - lu(k,1220) * lu(k,1886) + lu(k,1911) = lu(k,1911) - lu(k,1221) * lu(k,1886) + lu(k,1912) = lu(k,1912) - lu(k,1222) * lu(k,1886) + lu(k,1915) = lu(k,1915) - lu(k,1223) * lu(k,1886) + lu(k,1917) = lu(k,1917) - lu(k,1224) * lu(k,1886) + lu(k,1940) = - lu(k,1216) * lu(k,1939) + lu(k,1941) = lu(k,1941) - lu(k,1217) * lu(k,1939) + lu(k,1950) = lu(k,1950) - lu(k,1218) * lu(k,1939) + lu(k,1951) = lu(k,1951) - lu(k,1219) * lu(k,1939) + lu(k,1955) = lu(k,1955) - lu(k,1220) * lu(k,1939) + lu(k,1957) = lu(k,1957) - lu(k,1221) * lu(k,1939) + lu(k,1958) = lu(k,1958) - lu(k,1222) * lu(k,1939) + lu(k,1961) = lu(k,1961) - lu(k,1223) * lu(k,1939) + lu(k,1963) = lu(k,1963) - lu(k,1224) * lu(k,1939) + lu(k,2055) = lu(k,2055) - lu(k,1216) * lu(k,2051) + lu(k,2061) = lu(k,2061) - lu(k,1217) * lu(k,2051) + lu(k,2068) = lu(k,2068) - lu(k,1218) * lu(k,2051) + lu(k,2069) = lu(k,2069) - lu(k,1219) * lu(k,2051) + lu(k,2073) = lu(k,2073) - lu(k,1220) * lu(k,2051) + lu(k,2075) = lu(k,2075) - lu(k,1221) * lu(k,2051) + lu(k,2076) = lu(k,2076) - lu(k,1222) * lu(k,2051) + lu(k,2079) = lu(k,2079) - lu(k,1223) * lu(k,2051) + lu(k,2081) = lu(k,2081) - lu(k,1224) * lu(k,2051) + lu(k,2182) = lu(k,2182) - lu(k,1216) * lu(k,2178) + lu(k,2188) = lu(k,2188) - lu(k,1217) * lu(k,2178) + lu(k,2197) = lu(k,2197) - lu(k,1218) * lu(k,2178) + lu(k,2198) = lu(k,2198) - lu(k,1219) * lu(k,2178) + lu(k,2202) = lu(k,2202) - lu(k,1220) * lu(k,2178) + lu(k,2204) = lu(k,2204) - lu(k,1221) * lu(k,2178) + lu(k,2205) = lu(k,2205) - lu(k,1222) * lu(k,2178) + lu(k,2208) = lu(k,2208) - lu(k,1223) * lu(k,2178) + lu(k,2210) = lu(k,2210) - lu(k,1224) * lu(k,2178) + lu(k,2237) = lu(k,2237) - lu(k,1216) * lu(k,2233) + lu(k,2243) = lu(k,2243) - lu(k,1217) * lu(k,2233) + lu(k,2249) = lu(k,2249) - lu(k,1218) * lu(k,2233) + lu(k,2250) = lu(k,2250) - lu(k,1219) * lu(k,2233) + lu(k,2254) = lu(k,2254) - lu(k,1220) * lu(k,2233) + lu(k,2256) = lu(k,2256) - lu(k,1221) * lu(k,2233) + lu(k,2257) = lu(k,2257) - lu(k,1222) * lu(k,2233) + lu(k,2260) = lu(k,2260) - lu(k,1223) * lu(k,2233) + lu(k,2262) = lu(k,2262) - lu(k,1224) * lu(k,2233) + lu(k,2393) = lu(k,2393) - lu(k,1216) * lu(k,2390) + lu(k,2399) = lu(k,2399) - lu(k,1217) * lu(k,2390) + lu(k,2407) = lu(k,2407) - lu(k,1218) * lu(k,2390) + lu(k,2408) = lu(k,2408) - lu(k,1219) * lu(k,2390) + lu(k,2412) = lu(k,2412) - lu(k,1220) * lu(k,2390) + lu(k,2414) = lu(k,2414) - lu(k,1221) * lu(k,2390) + lu(k,2415) = lu(k,2415) - lu(k,1222) * lu(k,2390) + lu(k,2418) = lu(k,2418) - lu(k,1223) * lu(k,2390) + lu(k,2420) = lu(k,2420) - lu(k,1224) * lu(k,2390) end do - end subroutine lu_fac24 - subroutine lu_fac25( avec_len, lu ) + end subroutine lu_fac25 + subroutine lu_fac26( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 implicit none @@ -5439,104 +5058,96 @@ subroutine lu_fac25( avec_len, lu ) lu(k,1239) = lu(k,1239) * lu(k,1231) lu(k,1240) = lu(k,1240) * lu(k,1231) lu(k,1241) = lu(k,1241) * lu(k,1231) - lu(k,1242) = lu(k,1242) * lu(k,1231) - lu(k,1243) = lu(k,1243) * lu(k,1231) - lu(k,1252) = - lu(k,1232) * lu(k,1250) - lu(k,1253) = lu(k,1253) - lu(k,1233) * lu(k,1250) - lu(k,1254) = lu(k,1254) - lu(k,1234) * lu(k,1250) - lu(k,1256) = lu(k,1256) - lu(k,1235) * lu(k,1250) - lu(k,1257) = lu(k,1257) - lu(k,1236) * lu(k,1250) + lu(k,1253) = lu(k,1253) - lu(k,1232) * lu(k,1250) + lu(k,1255) = lu(k,1255) - lu(k,1233) * lu(k,1250) + lu(k,1256) = lu(k,1256) - lu(k,1234) * lu(k,1250) + lu(k,1257) = lu(k,1257) - lu(k,1235) * lu(k,1250) + lu(k,1258) = lu(k,1258) - lu(k,1236) * lu(k,1250) lu(k,1259) = lu(k,1259) - lu(k,1237) * lu(k,1250) - lu(k,1260) = lu(k,1260) - lu(k,1238) * lu(k,1250) - lu(k,1261) = lu(k,1261) - lu(k,1239) * lu(k,1250) - lu(k,1262) = lu(k,1262) - lu(k,1240) * lu(k,1250) - lu(k,1263) = lu(k,1263) - lu(k,1241) * lu(k,1250) - lu(k,1264) = lu(k,1264) - lu(k,1242) * lu(k,1250) - lu(k,1265) = lu(k,1265) - lu(k,1243) * lu(k,1250) - lu(k,1301) = lu(k,1301) - lu(k,1232) * lu(k,1299) - lu(k,1302) = lu(k,1302) - lu(k,1233) * lu(k,1299) - lu(k,1303) = lu(k,1303) - lu(k,1234) * lu(k,1299) - lu(k,1305) = lu(k,1305) - lu(k,1235) * lu(k,1299) - lu(k,1306) = lu(k,1306) - lu(k,1236) * lu(k,1299) - lu(k,1308) = lu(k,1308) - lu(k,1237) * lu(k,1299) - lu(k,1309) = lu(k,1309) - lu(k,1238) * lu(k,1299) - lu(k,1310) = lu(k,1310) - lu(k,1239) * lu(k,1299) - lu(k,1311) = lu(k,1311) - lu(k,1240) * lu(k,1299) - lu(k,1312) = lu(k,1312) - lu(k,1241) * lu(k,1299) - lu(k,1313) = lu(k,1313) - lu(k,1242) * lu(k,1299) - lu(k,1314) = lu(k,1314) - lu(k,1243) * lu(k,1299) - lu(k,1394) = lu(k,1394) - lu(k,1232) * lu(k,1392) - lu(k,1395) = lu(k,1395) - lu(k,1233) * lu(k,1392) - lu(k,1396) = lu(k,1396) - lu(k,1234) * lu(k,1392) - lu(k,1398) = lu(k,1398) - lu(k,1235) * lu(k,1392) - lu(k,1400) = lu(k,1400) - lu(k,1236) * lu(k,1392) - lu(k,1402) = lu(k,1402) - lu(k,1237) * lu(k,1392) - lu(k,1403) = lu(k,1403) - lu(k,1238) * lu(k,1392) - lu(k,1404) = lu(k,1404) - lu(k,1239) * lu(k,1392) - lu(k,1405) = lu(k,1405) - lu(k,1240) * lu(k,1392) - lu(k,1406) = lu(k,1406) - lu(k,1241) * lu(k,1392) - lu(k,1407) = lu(k,1407) - lu(k,1242) * lu(k,1392) - lu(k,1409) = lu(k,1409) - lu(k,1243) * lu(k,1392) - lu(k,1502) = lu(k,1502) - lu(k,1232) * lu(k,1500) - lu(k,1503) = lu(k,1503) - lu(k,1233) * lu(k,1500) - lu(k,1505) = lu(k,1505) - lu(k,1234) * lu(k,1500) - lu(k,1507) = lu(k,1507) - lu(k,1235) * lu(k,1500) - lu(k,1510) = lu(k,1510) - lu(k,1236) * lu(k,1500) - lu(k,1513) = lu(k,1513) - lu(k,1237) * lu(k,1500) - lu(k,1514) = lu(k,1514) - lu(k,1238) * lu(k,1500) - lu(k,1515) = lu(k,1515) - lu(k,1239) * lu(k,1500) - lu(k,1516) = lu(k,1516) - lu(k,1240) * lu(k,1500) - lu(k,1517) = lu(k,1517) - lu(k,1241) * lu(k,1500) - lu(k,1519) = lu(k,1519) - lu(k,1242) * lu(k,1500) - lu(k,1521) = lu(k,1521) - lu(k,1243) * lu(k,1500) - lu(k,1709) = lu(k,1709) - lu(k,1232) * lu(k,1707) - lu(k,1710) = lu(k,1710) - lu(k,1233) * lu(k,1707) - lu(k,1714) = lu(k,1714) - lu(k,1234) * lu(k,1707) - lu(k,1716) = lu(k,1716) - lu(k,1235) * lu(k,1707) - lu(k,1719) = lu(k,1719) - lu(k,1236) * lu(k,1707) - lu(k,1722) = lu(k,1722) - lu(k,1237) * lu(k,1707) - lu(k,1723) = lu(k,1723) - lu(k,1238) * lu(k,1707) - lu(k,1724) = lu(k,1724) - lu(k,1239) * lu(k,1707) - lu(k,1725) = lu(k,1725) - lu(k,1240) * lu(k,1707) - lu(k,1726) = lu(k,1726) - lu(k,1241) * lu(k,1707) - lu(k,1728) = lu(k,1728) - lu(k,1242) * lu(k,1707) - lu(k,1730) = lu(k,1730) - lu(k,1243) * lu(k,1707) - lu(k,1772) = lu(k,1772) - lu(k,1232) * lu(k,1770) - lu(k,1773) = lu(k,1773) - lu(k,1233) * lu(k,1770) - lu(k,1776) = lu(k,1776) - lu(k,1234) * lu(k,1770) - lu(k,1778) = lu(k,1778) - lu(k,1235) * lu(k,1770) - lu(k,1781) = lu(k,1781) - lu(k,1236) * lu(k,1770) - lu(k,1784) = lu(k,1784) - lu(k,1237) * lu(k,1770) - lu(k,1785) = lu(k,1785) - lu(k,1238) * lu(k,1770) - lu(k,1786) = lu(k,1786) - lu(k,1239) * lu(k,1770) - lu(k,1787) = lu(k,1787) - lu(k,1240) * lu(k,1770) - lu(k,1788) = lu(k,1788) - lu(k,1241) * lu(k,1770) - lu(k,1790) = lu(k,1790) - lu(k,1242) * lu(k,1770) - lu(k,1792) = lu(k,1792) - lu(k,1243) * lu(k,1770) - lu(k,1894) = lu(k,1894) - lu(k,1232) * lu(k,1892) - lu(k,1895) = lu(k,1895) - lu(k,1233) * lu(k,1892) - lu(k,1898) = lu(k,1898) - lu(k,1234) * lu(k,1892) - lu(k,1900) = lu(k,1900) - lu(k,1235) * lu(k,1892) - lu(k,1903) = lu(k,1903) - lu(k,1236) * lu(k,1892) - lu(k,1906) = lu(k,1906) - lu(k,1237) * lu(k,1892) - lu(k,1907) = lu(k,1907) - lu(k,1238) * lu(k,1892) - lu(k,1908) = lu(k,1908) - lu(k,1239) * lu(k,1892) - lu(k,1909) = lu(k,1909) - lu(k,1240) * lu(k,1892) - lu(k,1910) = lu(k,1910) - lu(k,1241) * lu(k,1892) - lu(k,1912) = lu(k,1912) - lu(k,1242) * lu(k,1892) - lu(k,1914) = lu(k,1914) - lu(k,1243) * lu(k,1892) - lu(k,2097) = lu(k,2097) - lu(k,1232) * lu(k,2095) - lu(k,2098) = lu(k,2098) - lu(k,1233) * lu(k,2095) - lu(k,2101) = lu(k,2101) - lu(k,1234) * lu(k,2095) - lu(k,2103) = lu(k,2103) - lu(k,1235) * lu(k,2095) - lu(k,2106) = lu(k,2106) - lu(k,1236) * lu(k,2095) - lu(k,2109) = lu(k,2109) - lu(k,1237) * lu(k,2095) - lu(k,2110) = lu(k,2110) - lu(k,1238) * lu(k,2095) - lu(k,2111) = lu(k,2111) - lu(k,1239) * lu(k,2095) - lu(k,2112) = lu(k,2112) - lu(k,1240) * lu(k,2095) - lu(k,2113) = lu(k,2113) - lu(k,1241) * lu(k,2095) - lu(k,2115) = lu(k,2115) - lu(k,1242) * lu(k,2095) - lu(k,2117) = lu(k,2117) - lu(k,1243) * lu(k,2095) + lu(k,1261) = lu(k,1261) - lu(k,1238) * lu(k,1250) + lu(k,1262) = lu(k,1262) - lu(k,1239) * lu(k,1250) + lu(k,1263) = lu(k,1263) - lu(k,1240) * lu(k,1250) + lu(k,1264) = lu(k,1264) - lu(k,1241) * lu(k,1250) + lu(k,1296) = lu(k,1296) - lu(k,1232) * lu(k,1294) + lu(k,1301) = lu(k,1301) - lu(k,1233) * lu(k,1294) + lu(k,1302) = lu(k,1302) - lu(k,1234) * lu(k,1294) + lu(k,1303) = lu(k,1303) - lu(k,1235) * lu(k,1294) + lu(k,1304) = lu(k,1304) - lu(k,1236) * lu(k,1294) + lu(k,1305) = lu(k,1305) - lu(k,1237) * lu(k,1294) + lu(k,1307) = lu(k,1307) - lu(k,1238) * lu(k,1294) + lu(k,1308) = lu(k,1308) - lu(k,1239) * lu(k,1294) + lu(k,1309) = lu(k,1309) - lu(k,1240) * lu(k,1294) + lu(k,1310) = lu(k,1310) - lu(k,1241) * lu(k,1294) + lu(k,1329) = lu(k,1329) - lu(k,1232) * lu(k,1327) + lu(k,1334) = lu(k,1334) - lu(k,1233) * lu(k,1327) + lu(k,1335) = lu(k,1335) - lu(k,1234) * lu(k,1327) + lu(k,1336) = lu(k,1336) - lu(k,1235) * lu(k,1327) + lu(k,1337) = lu(k,1337) - lu(k,1236) * lu(k,1327) + lu(k,1338) = lu(k,1338) - lu(k,1237) * lu(k,1327) + lu(k,1340) = lu(k,1340) - lu(k,1238) * lu(k,1327) + lu(k,1341) = lu(k,1341) - lu(k,1239) * lu(k,1327) + lu(k,1342) = lu(k,1342) - lu(k,1240) * lu(k,1327) + lu(k,1343) = lu(k,1343) - lu(k,1241) * lu(k,1327) + lu(k,1420) = lu(k,1420) - lu(k,1232) * lu(k,1417) + lu(k,1426) = lu(k,1426) - lu(k,1233) * lu(k,1417) + lu(k,1427) = lu(k,1427) - lu(k,1234) * lu(k,1417) + lu(k,1429) = lu(k,1429) - lu(k,1235) * lu(k,1417) + lu(k,1430) = lu(k,1430) - lu(k,1236) * lu(k,1417) + lu(k,1431) = lu(k,1431) - lu(k,1237) * lu(k,1417) + lu(k,1433) = lu(k,1433) - lu(k,1238) * lu(k,1417) + lu(k,1434) = lu(k,1434) - lu(k,1239) * lu(k,1417) + lu(k,1435) = lu(k,1435) - lu(k,1240) * lu(k,1417) + lu(k,1437) = lu(k,1437) - lu(k,1241) * lu(k,1417) + lu(k,1783) = lu(k,1783) - lu(k,1232) * lu(k,1780) + lu(k,1789) = lu(k,1789) - lu(k,1233) * lu(k,1780) + lu(k,1790) = lu(k,1790) - lu(k,1234) * lu(k,1780) + lu(k,1799) = lu(k,1799) - lu(k,1235) * lu(k,1780) + lu(k,1800) = lu(k,1800) - lu(k,1236) * lu(k,1780) + lu(k,1801) = lu(k,1801) - lu(k,1237) * lu(k,1780) + lu(k,1804) = lu(k,1804) - lu(k,1238) * lu(k,1780) + lu(k,1806) = lu(k,1806) - lu(k,1239) * lu(k,1780) + lu(k,1807) = lu(k,1807) - lu(k,1240) * lu(k,1780) + lu(k,1810) = lu(k,1810) - lu(k,1241) * lu(k,1780) + lu(k,1890) = lu(k,1890) - lu(k,1232) * lu(k,1887) + lu(k,1896) = lu(k,1896) - lu(k,1233) * lu(k,1887) + lu(k,1897) = lu(k,1897) - lu(k,1234) * lu(k,1887) + lu(k,1904) = lu(k,1904) - lu(k,1235) * lu(k,1887) + lu(k,1905) = lu(k,1905) - lu(k,1236) * lu(k,1887) + lu(k,1906) = lu(k,1906) - lu(k,1237) * lu(k,1887) + lu(k,1909) = lu(k,1909) - lu(k,1238) * lu(k,1887) + lu(k,1911) = lu(k,1911) - lu(k,1239) * lu(k,1887) + lu(k,1912) = lu(k,1912) - lu(k,1240) * lu(k,1887) + lu(k,1915) = lu(k,1915) - lu(k,1241) * lu(k,1887) + lu(k,2055) = lu(k,2055) - lu(k,1232) * lu(k,2052) + lu(k,2061) = lu(k,2061) - lu(k,1233) * lu(k,2052) + lu(k,2062) = lu(k,2062) - lu(k,1234) * lu(k,2052) + lu(k,2068) = lu(k,2068) - lu(k,1235) * lu(k,2052) + lu(k,2069) = lu(k,2069) - lu(k,1236) * lu(k,2052) + lu(k,2070) = lu(k,2070) - lu(k,1237) * lu(k,2052) + lu(k,2073) = lu(k,2073) - lu(k,1238) * lu(k,2052) + lu(k,2075) = lu(k,2075) - lu(k,1239) * lu(k,2052) + lu(k,2076) = lu(k,2076) - lu(k,1240) * lu(k,2052) + lu(k,2079) = lu(k,2079) - lu(k,1241) * lu(k,2052) + lu(k,2182) = lu(k,2182) - lu(k,1232) * lu(k,2179) + lu(k,2188) = lu(k,2188) - lu(k,1233) * lu(k,2179) + lu(k,2189) = lu(k,2189) - lu(k,1234) * lu(k,2179) + lu(k,2197) = lu(k,2197) - lu(k,1235) * lu(k,2179) + lu(k,2198) = lu(k,2198) - lu(k,1236) * lu(k,2179) + lu(k,2199) = lu(k,2199) - lu(k,1237) * lu(k,2179) + lu(k,2202) = lu(k,2202) - lu(k,1238) * lu(k,2179) + lu(k,2204) = lu(k,2204) - lu(k,1239) * lu(k,2179) + lu(k,2205) = lu(k,2205) - lu(k,1240) * lu(k,2179) + lu(k,2208) = lu(k,2208) - lu(k,1241) * lu(k,2179) + lu(k,2237) = lu(k,2237) - lu(k,1232) * lu(k,2234) + lu(k,2243) = lu(k,2243) - lu(k,1233) * lu(k,2234) + lu(k,2244) = lu(k,2244) - lu(k,1234) * lu(k,2234) + lu(k,2249) = lu(k,2249) - lu(k,1235) * lu(k,2234) + lu(k,2250) = lu(k,2250) - lu(k,1236) * lu(k,2234) + lu(k,2251) = lu(k,2251) - lu(k,1237) * lu(k,2234) + lu(k,2254) = lu(k,2254) - lu(k,1238) * lu(k,2234) + lu(k,2256) = lu(k,2256) - lu(k,1239) * lu(k,2234) + lu(k,2257) = lu(k,2257) - lu(k,1240) * lu(k,2234) + lu(k,2260) = lu(k,2260) - lu(k,1241) * lu(k,2234) lu(k,1251) = 1._r8 / lu(k,1251) lu(k,1252) = lu(k,1252) * lu(k,1251) lu(k,1253) = lu(k,1253) * lu(k,1251) @@ -5551,326 +5162,307 @@ subroutine lu_fac25( avec_len, lu ) lu(k,1262) = lu(k,1262) * lu(k,1251) lu(k,1263) = lu(k,1263) * lu(k,1251) lu(k,1264) = lu(k,1264) * lu(k,1251) - lu(k,1265) = lu(k,1265) * lu(k,1251) - lu(k,1301) = lu(k,1301) - lu(k,1252) * lu(k,1300) - lu(k,1302) = lu(k,1302) - lu(k,1253) * lu(k,1300) - lu(k,1303) = lu(k,1303) - lu(k,1254) * lu(k,1300) - lu(k,1304) = - lu(k,1255) * lu(k,1300) - lu(k,1305) = lu(k,1305) - lu(k,1256) * lu(k,1300) - lu(k,1306) = lu(k,1306) - lu(k,1257) * lu(k,1300) - lu(k,1307) = lu(k,1307) - lu(k,1258) * lu(k,1300) - lu(k,1308) = lu(k,1308) - lu(k,1259) * lu(k,1300) - lu(k,1309) = lu(k,1309) - lu(k,1260) * lu(k,1300) - lu(k,1310) = lu(k,1310) - lu(k,1261) * lu(k,1300) - lu(k,1311) = lu(k,1311) - lu(k,1262) * lu(k,1300) - lu(k,1312) = lu(k,1312) - lu(k,1263) * lu(k,1300) - lu(k,1313) = lu(k,1313) - lu(k,1264) * lu(k,1300) - lu(k,1314) = lu(k,1314) - lu(k,1265) * lu(k,1300) - lu(k,1394) = lu(k,1394) - lu(k,1252) * lu(k,1393) - lu(k,1395) = lu(k,1395) - lu(k,1253) * lu(k,1393) - lu(k,1396) = lu(k,1396) - lu(k,1254) * lu(k,1393) - lu(k,1397) = lu(k,1397) - lu(k,1255) * lu(k,1393) - lu(k,1398) = lu(k,1398) - lu(k,1256) * lu(k,1393) - lu(k,1400) = lu(k,1400) - lu(k,1257) * lu(k,1393) - lu(k,1401) = lu(k,1401) - lu(k,1258) * lu(k,1393) - lu(k,1402) = lu(k,1402) - lu(k,1259) * lu(k,1393) - lu(k,1403) = lu(k,1403) - lu(k,1260) * lu(k,1393) - lu(k,1404) = lu(k,1404) - lu(k,1261) * lu(k,1393) - lu(k,1405) = lu(k,1405) - lu(k,1262) * lu(k,1393) - lu(k,1406) = lu(k,1406) - lu(k,1263) * lu(k,1393) - lu(k,1407) = lu(k,1407) - lu(k,1264) * lu(k,1393) - lu(k,1409) = lu(k,1409) - lu(k,1265) * lu(k,1393) - lu(k,1502) = lu(k,1502) - lu(k,1252) * lu(k,1501) - lu(k,1503) = lu(k,1503) - lu(k,1253) * lu(k,1501) - lu(k,1505) = lu(k,1505) - lu(k,1254) * lu(k,1501) - lu(k,1506) = lu(k,1506) - lu(k,1255) * lu(k,1501) - lu(k,1507) = lu(k,1507) - lu(k,1256) * lu(k,1501) - lu(k,1510) = lu(k,1510) - lu(k,1257) * lu(k,1501) - lu(k,1511) = lu(k,1511) - lu(k,1258) * lu(k,1501) - lu(k,1513) = lu(k,1513) - lu(k,1259) * lu(k,1501) - lu(k,1514) = lu(k,1514) - lu(k,1260) * lu(k,1501) - lu(k,1515) = lu(k,1515) - lu(k,1261) * lu(k,1501) - lu(k,1516) = lu(k,1516) - lu(k,1262) * lu(k,1501) - lu(k,1517) = lu(k,1517) - lu(k,1263) * lu(k,1501) - lu(k,1519) = lu(k,1519) - lu(k,1264) * lu(k,1501) - lu(k,1521) = lu(k,1521) - lu(k,1265) * lu(k,1501) - lu(k,1709) = lu(k,1709) - lu(k,1252) * lu(k,1708) - lu(k,1710) = lu(k,1710) - lu(k,1253) * lu(k,1708) - lu(k,1714) = lu(k,1714) - lu(k,1254) * lu(k,1708) - lu(k,1715) = lu(k,1715) - lu(k,1255) * lu(k,1708) - lu(k,1716) = lu(k,1716) - lu(k,1256) * lu(k,1708) - lu(k,1719) = lu(k,1719) - lu(k,1257) * lu(k,1708) - lu(k,1720) = lu(k,1720) - lu(k,1258) * lu(k,1708) - lu(k,1722) = lu(k,1722) - lu(k,1259) * lu(k,1708) - lu(k,1723) = lu(k,1723) - lu(k,1260) * lu(k,1708) - lu(k,1724) = lu(k,1724) - lu(k,1261) * lu(k,1708) - lu(k,1725) = lu(k,1725) - lu(k,1262) * lu(k,1708) - lu(k,1726) = lu(k,1726) - lu(k,1263) * lu(k,1708) - lu(k,1728) = lu(k,1728) - lu(k,1264) * lu(k,1708) - lu(k,1730) = lu(k,1730) - lu(k,1265) * lu(k,1708) - lu(k,1772) = lu(k,1772) - lu(k,1252) * lu(k,1771) - lu(k,1773) = lu(k,1773) - lu(k,1253) * lu(k,1771) - lu(k,1776) = lu(k,1776) - lu(k,1254) * lu(k,1771) - lu(k,1777) = lu(k,1777) - lu(k,1255) * lu(k,1771) - lu(k,1778) = lu(k,1778) - lu(k,1256) * lu(k,1771) - lu(k,1781) = lu(k,1781) - lu(k,1257) * lu(k,1771) - lu(k,1782) = lu(k,1782) - lu(k,1258) * lu(k,1771) - lu(k,1784) = lu(k,1784) - lu(k,1259) * lu(k,1771) - lu(k,1785) = lu(k,1785) - lu(k,1260) * lu(k,1771) - lu(k,1786) = lu(k,1786) - lu(k,1261) * lu(k,1771) - lu(k,1787) = lu(k,1787) - lu(k,1262) * lu(k,1771) - lu(k,1788) = lu(k,1788) - lu(k,1263) * lu(k,1771) - lu(k,1790) = lu(k,1790) - lu(k,1264) * lu(k,1771) - lu(k,1792) = lu(k,1792) - lu(k,1265) * lu(k,1771) - lu(k,1894) = lu(k,1894) - lu(k,1252) * lu(k,1893) - lu(k,1895) = lu(k,1895) - lu(k,1253) * lu(k,1893) - lu(k,1898) = lu(k,1898) - lu(k,1254) * lu(k,1893) - lu(k,1899) = lu(k,1899) - lu(k,1255) * lu(k,1893) - lu(k,1900) = lu(k,1900) - lu(k,1256) * lu(k,1893) - lu(k,1903) = lu(k,1903) - lu(k,1257) * lu(k,1893) - lu(k,1904) = lu(k,1904) - lu(k,1258) * lu(k,1893) - lu(k,1906) = lu(k,1906) - lu(k,1259) * lu(k,1893) - lu(k,1907) = lu(k,1907) - lu(k,1260) * lu(k,1893) - lu(k,1908) = lu(k,1908) - lu(k,1261) * lu(k,1893) - lu(k,1909) = lu(k,1909) - lu(k,1262) * lu(k,1893) - lu(k,1910) = lu(k,1910) - lu(k,1263) * lu(k,1893) - lu(k,1912) = lu(k,1912) - lu(k,1264) * lu(k,1893) - lu(k,1914) = lu(k,1914) - lu(k,1265) * lu(k,1893) - lu(k,2097) = lu(k,2097) - lu(k,1252) * lu(k,2096) - lu(k,2098) = lu(k,2098) - lu(k,1253) * lu(k,2096) - lu(k,2101) = lu(k,2101) - lu(k,1254) * lu(k,2096) - lu(k,2102) = lu(k,2102) - lu(k,1255) * lu(k,2096) - lu(k,2103) = lu(k,2103) - lu(k,1256) * lu(k,2096) - lu(k,2106) = lu(k,2106) - lu(k,1257) * lu(k,2096) - lu(k,2107) = lu(k,2107) - lu(k,1258) * lu(k,2096) - lu(k,2109) = lu(k,2109) - lu(k,1259) * lu(k,2096) - lu(k,2110) = lu(k,2110) - lu(k,1260) * lu(k,2096) - lu(k,2111) = lu(k,2111) - lu(k,1261) * lu(k,2096) - lu(k,2112) = lu(k,2112) - lu(k,1262) * lu(k,2096) - lu(k,2113) = lu(k,2113) - lu(k,1263) * lu(k,2096) - lu(k,2115) = lu(k,2115) - lu(k,1264) * lu(k,2096) - lu(k,2117) = lu(k,2117) - lu(k,1265) * lu(k,2096) - lu(k,1271) = 1._r8 / lu(k,1271) - lu(k,1272) = lu(k,1272) * lu(k,1271) - lu(k,1273) = lu(k,1273) * lu(k,1271) - lu(k,1274) = lu(k,1274) * lu(k,1271) - lu(k,1275) = lu(k,1275) * lu(k,1271) - lu(k,1276) = lu(k,1276) * lu(k,1271) - lu(k,1277) = lu(k,1277) * lu(k,1271) - lu(k,1278) = lu(k,1278) * lu(k,1271) - lu(k,1279) = lu(k,1279) * lu(k,1271) - lu(k,1280) = lu(k,1280) * lu(k,1271) - lu(k,1281) = lu(k,1281) * lu(k,1271) - lu(k,1282) = lu(k,1282) * lu(k,1271) - lu(k,1283) = lu(k,1283) * lu(k,1271) - lu(k,1302) = lu(k,1302) - lu(k,1272) * lu(k,1301) - lu(k,1303) = lu(k,1303) - lu(k,1273) * lu(k,1301) - lu(k,1305) = lu(k,1305) - lu(k,1274) * lu(k,1301) - lu(k,1306) = lu(k,1306) - lu(k,1275) * lu(k,1301) - lu(k,1307) = lu(k,1307) - lu(k,1276) * lu(k,1301) - lu(k,1308) = lu(k,1308) - lu(k,1277) * lu(k,1301) - lu(k,1309) = lu(k,1309) - lu(k,1278) * lu(k,1301) - lu(k,1310) = lu(k,1310) - lu(k,1279) * lu(k,1301) - lu(k,1311) = lu(k,1311) - lu(k,1280) * lu(k,1301) - lu(k,1312) = lu(k,1312) - lu(k,1281) * lu(k,1301) - lu(k,1313) = lu(k,1313) - lu(k,1282) * lu(k,1301) - lu(k,1314) = lu(k,1314) - lu(k,1283) * lu(k,1301) - lu(k,1395) = lu(k,1395) - lu(k,1272) * lu(k,1394) - lu(k,1396) = lu(k,1396) - lu(k,1273) * lu(k,1394) - lu(k,1398) = lu(k,1398) - lu(k,1274) * lu(k,1394) - lu(k,1400) = lu(k,1400) - lu(k,1275) * lu(k,1394) - lu(k,1401) = lu(k,1401) - lu(k,1276) * lu(k,1394) - lu(k,1402) = lu(k,1402) - lu(k,1277) * lu(k,1394) - lu(k,1403) = lu(k,1403) - lu(k,1278) * lu(k,1394) - lu(k,1404) = lu(k,1404) - lu(k,1279) * lu(k,1394) - lu(k,1405) = lu(k,1405) - lu(k,1280) * lu(k,1394) - lu(k,1406) = lu(k,1406) - lu(k,1281) * lu(k,1394) - lu(k,1407) = lu(k,1407) - lu(k,1282) * lu(k,1394) - lu(k,1409) = lu(k,1409) - lu(k,1283) * lu(k,1394) - lu(k,1503) = lu(k,1503) - lu(k,1272) * lu(k,1502) - lu(k,1505) = lu(k,1505) - lu(k,1273) * lu(k,1502) - lu(k,1507) = lu(k,1507) - lu(k,1274) * lu(k,1502) - lu(k,1510) = lu(k,1510) - lu(k,1275) * lu(k,1502) - lu(k,1511) = lu(k,1511) - lu(k,1276) * lu(k,1502) - lu(k,1513) = lu(k,1513) - lu(k,1277) * lu(k,1502) - lu(k,1514) = lu(k,1514) - lu(k,1278) * lu(k,1502) - lu(k,1515) = lu(k,1515) - lu(k,1279) * lu(k,1502) - lu(k,1516) = lu(k,1516) - lu(k,1280) * lu(k,1502) - lu(k,1517) = lu(k,1517) - lu(k,1281) * lu(k,1502) - lu(k,1519) = lu(k,1519) - lu(k,1282) * lu(k,1502) - lu(k,1521) = lu(k,1521) - lu(k,1283) * lu(k,1502) - lu(k,1710) = lu(k,1710) - lu(k,1272) * lu(k,1709) - lu(k,1714) = lu(k,1714) - lu(k,1273) * lu(k,1709) - lu(k,1716) = lu(k,1716) - lu(k,1274) * lu(k,1709) - lu(k,1719) = lu(k,1719) - lu(k,1275) * lu(k,1709) - lu(k,1720) = lu(k,1720) - lu(k,1276) * lu(k,1709) - lu(k,1722) = lu(k,1722) - lu(k,1277) * lu(k,1709) - lu(k,1723) = lu(k,1723) - lu(k,1278) * lu(k,1709) - lu(k,1724) = lu(k,1724) - lu(k,1279) * lu(k,1709) - lu(k,1725) = lu(k,1725) - lu(k,1280) * lu(k,1709) - lu(k,1726) = lu(k,1726) - lu(k,1281) * lu(k,1709) - lu(k,1728) = lu(k,1728) - lu(k,1282) * lu(k,1709) - lu(k,1730) = lu(k,1730) - lu(k,1283) * lu(k,1709) - lu(k,1773) = lu(k,1773) - lu(k,1272) * lu(k,1772) - lu(k,1776) = lu(k,1776) - lu(k,1273) * lu(k,1772) - lu(k,1778) = lu(k,1778) - lu(k,1274) * lu(k,1772) - lu(k,1781) = lu(k,1781) - lu(k,1275) * lu(k,1772) - lu(k,1782) = lu(k,1782) - lu(k,1276) * lu(k,1772) - lu(k,1784) = lu(k,1784) - lu(k,1277) * lu(k,1772) - lu(k,1785) = lu(k,1785) - lu(k,1278) * lu(k,1772) - lu(k,1786) = lu(k,1786) - lu(k,1279) * lu(k,1772) - lu(k,1787) = lu(k,1787) - lu(k,1280) * lu(k,1772) - lu(k,1788) = lu(k,1788) - lu(k,1281) * lu(k,1772) - lu(k,1790) = lu(k,1790) - lu(k,1282) * lu(k,1772) - lu(k,1792) = lu(k,1792) - lu(k,1283) * lu(k,1772) - lu(k,1895) = lu(k,1895) - lu(k,1272) * lu(k,1894) - lu(k,1898) = lu(k,1898) - lu(k,1273) * lu(k,1894) - lu(k,1900) = lu(k,1900) - lu(k,1274) * lu(k,1894) - lu(k,1903) = lu(k,1903) - lu(k,1275) * lu(k,1894) - lu(k,1904) = lu(k,1904) - lu(k,1276) * lu(k,1894) - lu(k,1906) = lu(k,1906) - lu(k,1277) * lu(k,1894) - lu(k,1907) = lu(k,1907) - lu(k,1278) * lu(k,1894) - lu(k,1908) = lu(k,1908) - lu(k,1279) * lu(k,1894) - lu(k,1909) = lu(k,1909) - lu(k,1280) * lu(k,1894) - lu(k,1910) = lu(k,1910) - lu(k,1281) * lu(k,1894) - lu(k,1912) = lu(k,1912) - lu(k,1282) * lu(k,1894) - lu(k,1914) = lu(k,1914) - lu(k,1283) * lu(k,1894) - lu(k,1978) = lu(k,1978) - lu(k,1272) * lu(k,1977) - lu(k,1982) = lu(k,1982) - lu(k,1273) * lu(k,1977) - lu(k,1984) = lu(k,1984) - lu(k,1274) * lu(k,1977) - lu(k,1987) = lu(k,1987) - lu(k,1275) * lu(k,1977) - lu(k,1988) = lu(k,1988) - lu(k,1276) * lu(k,1977) - lu(k,1990) = lu(k,1990) - lu(k,1277) * lu(k,1977) - lu(k,1991) = lu(k,1991) - lu(k,1278) * lu(k,1977) - lu(k,1992) = lu(k,1992) - lu(k,1279) * lu(k,1977) - lu(k,1993) = lu(k,1993) - lu(k,1280) * lu(k,1977) - lu(k,1994) = lu(k,1994) - lu(k,1281) * lu(k,1977) - lu(k,1996) = lu(k,1996) - lu(k,1282) * lu(k,1977) - lu(k,1998) = lu(k,1998) - lu(k,1283) * lu(k,1977) - lu(k,2098) = lu(k,2098) - lu(k,1272) * lu(k,2097) - lu(k,2101) = lu(k,2101) - lu(k,1273) * lu(k,2097) - lu(k,2103) = lu(k,2103) - lu(k,1274) * lu(k,2097) - lu(k,2106) = lu(k,2106) - lu(k,1275) * lu(k,2097) - lu(k,2107) = lu(k,2107) - lu(k,1276) * lu(k,2097) - lu(k,2109) = lu(k,2109) - lu(k,1277) * lu(k,2097) - lu(k,2110) = lu(k,2110) - lu(k,1278) * lu(k,2097) - lu(k,2111) = lu(k,2111) - lu(k,1279) * lu(k,2097) - lu(k,2112) = lu(k,2112) - lu(k,1280) * lu(k,2097) - lu(k,2113) = lu(k,2113) - lu(k,1281) * lu(k,2097) - lu(k,2115) = lu(k,2115) - lu(k,1282) * lu(k,2097) - lu(k,2117) = lu(k,2117) - lu(k,1283) * lu(k,2097) - lu(k,1302) = 1._r8 / lu(k,1302) - lu(k,1303) = lu(k,1303) * lu(k,1302) - lu(k,1304) = lu(k,1304) * lu(k,1302) - lu(k,1305) = lu(k,1305) * lu(k,1302) - lu(k,1306) = lu(k,1306) * lu(k,1302) - lu(k,1307) = lu(k,1307) * lu(k,1302) - lu(k,1308) = lu(k,1308) * lu(k,1302) - lu(k,1309) = lu(k,1309) * lu(k,1302) - lu(k,1310) = lu(k,1310) * lu(k,1302) - lu(k,1311) = lu(k,1311) * lu(k,1302) - lu(k,1312) = lu(k,1312) * lu(k,1302) - lu(k,1313) = lu(k,1313) * lu(k,1302) - lu(k,1314) = lu(k,1314) * lu(k,1302) - lu(k,1396) = lu(k,1396) - lu(k,1303) * lu(k,1395) - lu(k,1397) = lu(k,1397) - lu(k,1304) * lu(k,1395) - lu(k,1398) = lu(k,1398) - lu(k,1305) * lu(k,1395) - lu(k,1400) = lu(k,1400) - lu(k,1306) * lu(k,1395) - lu(k,1401) = lu(k,1401) - lu(k,1307) * lu(k,1395) - lu(k,1402) = lu(k,1402) - lu(k,1308) * lu(k,1395) - lu(k,1403) = lu(k,1403) - lu(k,1309) * lu(k,1395) - lu(k,1404) = lu(k,1404) - lu(k,1310) * lu(k,1395) - lu(k,1405) = lu(k,1405) - lu(k,1311) * lu(k,1395) - lu(k,1406) = lu(k,1406) - lu(k,1312) * lu(k,1395) - lu(k,1407) = lu(k,1407) - lu(k,1313) * lu(k,1395) - lu(k,1409) = lu(k,1409) - lu(k,1314) * lu(k,1395) - lu(k,1505) = lu(k,1505) - lu(k,1303) * lu(k,1503) - lu(k,1506) = lu(k,1506) - lu(k,1304) * lu(k,1503) - lu(k,1507) = lu(k,1507) - lu(k,1305) * lu(k,1503) - lu(k,1510) = lu(k,1510) - lu(k,1306) * lu(k,1503) - lu(k,1511) = lu(k,1511) - lu(k,1307) * lu(k,1503) - lu(k,1513) = lu(k,1513) - lu(k,1308) * lu(k,1503) - lu(k,1514) = lu(k,1514) - lu(k,1309) * lu(k,1503) - lu(k,1515) = lu(k,1515) - lu(k,1310) * lu(k,1503) - lu(k,1516) = lu(k,1516) - lu(k,1311) * lu(k,1503) - lu(k,1517) = lu(k,1517) - lu(k,1312) * lu(k,1503) - lu(k,1519) = lu(k,1519) - lu(k,1313) * lu(k,1503) - lu(k,1521) = lu(k,1521) - lu(k,1314) * lu(k,1503) - lu(k,1540) = lu(k,1540) - lu(k,1303) * lu(k,1537) - lu(k,1541) = lu(k,1541) - lu(k,1304) * lu(k,1537) - lu(k,1542) = lu(k,1542) - lu(k,1305) * lu(k,1537) - lu(k,1545) = lu(k,1545) - lu(k,1306) * lu(k,1537) - lu(k,1546) = lu(k,1546) - lu(k,1307) * lu(k,1537) - lu(k,1548) = lu(k,1548) - lu(k,1308) * lu(k,1537) - lu(k,1549) = lu(k,1549) - lu(k,1309) * lu(k,1537) - lu(k,1550) = lu(k,1550) - lu(k,1310) * lu(k,1537) - lu(k,1551) = lu(k,1551) - lu(k,1311) * lu(k,1537) - lu(k,1552) = lu(k,1552) - lu(k,1312) * lu(k,1537) - lu(k,1554) = lu(k,1554) - lu(k,1313) * lu(k,1537) - lu(k,1556) = lu(k,1556) - lu(k,1314) * lu(k,1537) - lu(k,1714) = lu(k,1714) - lu(k,1303) * lu(k,1710) - lu(k,1715) = lu(k,1715) - lu(k,1304) * lu(k,1710) - lu(k,1716) = lu(k,1716) - lu(k,1305) * lu(k,1710) - lu(k,1719) = lu(k,1719) - lu(k,1306) * lu(k,1710) - lu(k,1720) = lu(k,1720) - lu(k,1307) * lu(k,1710) - lu(k,1722) = lu(k,1722) - lu(k,1308) * lu(k,1710) - lu(k,1723) = lu(k,1723) - lu(k,1309) * lu(k,1710) - lu(k,1724) = lu(k,1724) - lu(k,1310) * lu(k,1710) - lu(k,1725) = lu(k,1725) - lu(k,1311) * lu(k,1710) - lu(k,1726) = lu(k,1726) - lu(k,1312) * lu(k,1710) - lu(k,1728) = lu(k,1728) - lu(k,1313) * lu(k,1710) - lu(k,1730) = lu(k,1730) - lu(k,1314) * lu(k,1710) - lu(k,1776) = lu(k,1776) - lu(k,1303) * lu(k,1773) - lu(k,1777) = lu(k,1777) - lu(k,1304) * lu(k,1773) - lu(k,1778) = lu(k,1778) - lu(k,1305) * lu(k,1773) - lu(k,1781) = lu(k,1781) - lu(k,1306) * lu(k,1773) - lu(k,1782) = lu(k,1782) - lu(k,1307) * lu(k,1773) - lu(k,1784) = lu(k,1784) - lu(k,1308) * lu(k,1773) - lu(k,1785) = lu(k,1785) - lu(k,1309) * lu(k,1773) - lu(k,1786) = lu(k,1786) - lu(k,1310) * lu(k,1773) - lu(k,1787) = lu(k,1787) - lu(k,1311) * lu(k,1773) - lu(k,1788) = lu(k,1788) - lu(k,1312) * lu(k,1773) - lu(k,1790) = lu(k,1790) - lu(k,1313) * lu(k,1773) - lu(k,1792) = lu(k,1792) - lu(k,1314) * lu(k,1773) - lu(k,1898) = lu(k,1898) - lu(k,1303) * lu(k,1895) - lu(k,1899) = lu(k,1899) - lu(k,1304) * lu(k,1895) - lu(k,1900) = lu(k,1900) - lu(k,1305) * lu(k,1895) - lu(k,1903) = lu(k,1903) - lu(k,1306) * lu(k,1895) - lu(k,1904) = lu(k,1904) - lu(k,1307) * lu(k,1895) - lu(k,1906) = lu(k,1906) - lu(k,1308) * lu(k,1895) - lu(k,1907) = lu(k,1907) - lu(k,1309) * lu(k,1895) - lu(k,1908) = lu(k,1908) - lu(k,1310) * lu(k,1895) - lu(k,1909) = lu(k,1909) - lu(k,1311) * lu(k,1895) - lu(k,1910) = lu(k,1910) - lu(k,1312) * lu(k,1895) - lu(k,1912) = lu(k,1912) - lu(k,1313) * lu(k,1895) - lu(k,1914) = lu(k,1914) - lu(k,1314) * lu(k,1895) - lu(k,1982) = lu(k,1982) - lu(k,1303) * lu(k,1978) - lu(k,1983) = lu(k,1983) - lu(k,1304) * lu(k,1978) - lu(k,1984) = lu(k,1984) - lu(k,1305) * lu(k,1978) - lu(k,1987) = lu(k,1987) - lu(k,1306) * lu(k,1978) - lu(k,1988) = lu(k,1988) - lu(k,1307) * lu(k,1978) - lu(k,1990) = lu(k,1990) - lu(k,1308) * lu(k,1978) - lu(k,1991) = lu(k,1991) - lu(k,1309) * lu(k,1978) - lu(k,1992) = lu(k,1992) - lu(k,1310) * lu(k,1978) - lu(k,1993) = lu(k,1993) - lu(k,1311) * lu(k,1978) - lu(k,1994) = lu(k,1994) - lu(k,1312) * lu(k,1978) - lu(k,1996) = lu(k,1996) - lu(k,1313) * lu(k,1978) - lu(k,1998) = lu(k,1998) - lu(k,1314) * lu(k,1978) - lu(k,2101) = lu(k,2101) - lu(k,1303) * lu(k,2098) - lu(k,2102) = lu(k,2102) - lu(k,1304) * lu(k,2098) - lu(k,2103) = lu(k,2103) - lu(k,1305) * lu(k,2098) - lu(k,2106) = lu(k,2106) - lu(k,1306) * lu(k,2098) - lu(k,2107) = lu(k,2107) - lu(k,1307) * lu(k,2098) - lu(k,2109) = lu(k,2109) - lu(k,1308) * lu(k,2098) - lu(k,2110) = lu(k,2110) - lu(k,1309) * lu(k,2098) - lu(k,2111) = lu(k,2111) - lu(k,1310) * lu(k,2098) - lu(k,2112) = lu(k,2112) - lu(k,1311) * lu(k,2098) - lu(k,2113) = lu(k,2113) - lu(k,1312) * lu(k,2098) - lu(k,2115) = lu(k,2115) - lu(k,1313) * lu(k,2098) - lu(k,2117) = lu(k,2117) - lu(k,1314) * lu(k,2098) + lu(k,1419) = lu(k,1419) - lu(k,1252) * lu(k,1418) + lu(k,1420) = lu(k,1420) - lu(k,1253) * lu(k,1418) + lu(k,1424) = lu(k,1424) - lu(k,1254) * lu(k,1418) + lu(k,1426) = lu(k,1426) - lu(k,1255) * lu(k,1418) + lu(k,1427) = lu(k,1427) - lu(k,1256) * lu(k,1418) + lu(k,1429) = lu(k,1429) - lu(k,1257) * lu(k,1418) + lu(k,1430) = lu(k,1430) - lu(k,1258) * lu(k,1418) + lu(k,1431) = lu(k,1431) - lu(k,1259) * lu(k,1418) + lu(k,1432) = lu(k,1432) - lu(k,1260) * lu(k,1418) + lu(k,1433) = lu(k,1433) - lu(k,1261) * lu(k,1418) + lu(k,1434) = lu(k,1434) - lu(k,1262) * lu(k,1418) + lu(k,1435) = lu(k,1435) - lu(k,1263) * lu(k,1418) + lu(k,1437) = lu(k,1437) - lu(k,1264) * lu(k,1418) + lu(k,1782) = lu(k,1782) - lu(k,1252) * lu(k,1781) + lu(k,1783) = lu(k,1783) - lu(k,1253) * lu(k,1781) + lu(k,1787) = lu(k,1787) - lu(k,1254) * lu(k,1781) + lu(k,1789) = lu(k,1789) - lu(k,1255) * lu(k,1781) + lu(k,1790) = lu(k,1790) - lu(k,1256) * lu(k,1781) + lu(k,1799) = lu(k,1799) - lu(k,1257) * lu(k,1781) + lu(k,1800) = lu(k,1800) - lu(k,1258) * lu(k,1781) + lu(k,1801) = lu(k,1801) - lu(k,1259) * lu(k,1781) + lu(k,1803) = lu(k,1803) - lu(k,1260) * lu(k,1781) + lu(k,1804) = lu(k,1804) - lu(k,1261) * lu(k,1781) + lu(k,1806) = lu(k,1806) - lu(k,1262) * lu(k,1781) + lu(k,1807) = lu(k,1807) - lu(k,1263) * lu(k,1781) + lu(k,1810) = lu(k,1810) - lu(k,1264) * lu(k,1781) + lu(k,1889) = lu(k,1889) - lu(k,1252) * lu(k,1888) + lu(k,1890) = lu(k,1890) - lu(k,1253) * lu(k,1888) + lu(k,1894) = lu(k,1894) - lu(k,1254) * lu(k,1888) + lu(k,1896) = lu(k,1896) - lu(k,1255) * lu(k,1888) + lu(k,1897) = lu(k,1897) - lu(k,1256) * lu(k,1888) + lu(k,1904) = lu(k,1904) - lu(k,1257) * lu(k,1888) + lu(k,1905) = lu(k,1905) - lu(k,1258) * lu(k,1888) + lu(k,1906) = lu(k,1906) - lu(k,1259) * lu(k,1888) + lu(k,1908) = lu(k,1908) - lu(k,1260) * lu(k,1888) + lu(k,1909) = lu(k,1909) - lu(k,1261) * lu(k,1888) + lu(k,1911) = lu(k,1911) - lu(k,1262) * lu(k,1888) + lu(k,1912) = lu(k,1912) - lu(k,1263) * lu(k,1888) + lu(k,1915) = lu(k,1915) - lu(k,1264) * lu(k,1888) + lu(k,2054) = lu(k,2054) - lu(k,1252) * lu(k,2053) + lu(k,2055) = lu(k,2055) - lu(k,1253) * lu(k,2053) + lu(k,2059) = lu(k,2059) - lu(k,1254) * lu(k,2053) + lu(k,2061) = lu(k,2061) - lu(k,1255) * lu(k,2053) + lu(k,2062) = lu(k,2062) - lu(k,1256) * lu(k,2053) + lu(k,2068) = lu(k,2068) - lu(k,1257) * lu(k,2053) + lu(k,2069) = lu(k,2069) - lu(k,1258) * lu(k,2053) + lu(k,2070) = lu(k,2070) - lu(k,1259) * lu(k,2053) + lu(k,2072) = lu(k,2072) - lu(k,1260) * lu(k,2053) + lu(k,2073) = lu(k,2073) - lu(k,1261) * lu(k,2053) + lu(k,2075) = lu(k,2075) - lu(k,1262) * lu(k,2053) + lu(k,2076) = lu(k,2076) - lu(k,1263) * lu(k,2053) + lu(k,2079) = lu(k,2079) - lu(k,1264) * lu(k,2053) + lu(k,2181) = lu(k,2181) - lu(k,1252) * lu(k,2180) + lu(k,2182) = lu(k,2182) - lu(k,1253) * lu(k,2180) + lu(k,2186) = lu(k,2186) - lu(k,1254) * lu(k,2180) + lu(k,2188) = lu(k,2188) - lu(k,1255) * lu(k,2180) + lu(k,2189) = lu(k,2189) - lu(k,1256) * lu(k,2180) + lu(k,2197) = lu(k,2197) - lu(k,1257) * lu(k,2180) + lu(k,2198) = lu(k,2198) - lu(k,1258) * lu(k,2180) + lu(k,2199) = lu(k,2199) - lu(k,1259) * lu(k,2180) + lu(k,2201) = lu(k,2201) - lu(k,1260) * lu(k,2180) + lu(k,2202) = lu(k,2202) - lu(k,1261) * lu(k,2180) + lu(k,2204) = lu(k,2204) - lu(k,1262) * lu(k,2180) + lu(k,2205) = lu(k,2205) - lu(k,1263) * lu(k,2180) + lu(k,2208) = lu(k,2208) - lu(k,1264) * lu(k,2180) + lu(k,2236) = lu(k,2236) - lu(k,1252) * lu(k,2235) + lu(k,2237) = lu(k,2237) - lu(k,1253) * lu(k,2235) + lu(k,2241) = lu(k,2241) - lu(k,1254) * lu(k,2235) + lu(k,2243) = lu(k,2243) - lu(k,1255) * lu(k,2235) + lu(k,2244) = lu(k,2244) - lu(k,1256) * lu(k,2235) + lu(k,2249) = lu(k,2249) - lu(k,1257) * lu(k,2235) + lu(k,2250) = lu(k,2250) - lu(k,1258) * lu(k,2235) + lu(k,2251) = lu(k,2251) - lu(k,1259) * lu(k,2235) + lu(k,2253) = lu(k,2253) - lu(k,1260) * lu(k,2235) + lu(k,2254) = lu(k,2254) - lu(k,1261) * lu(k,2235) + lu(k,2256) = lu(k,2256) - lu(k,1262) * lu(k,2235) + lu(k,2257) = lu(k,2257) - lu(k,1263) * lu(k,2235) + lu(k,2260) = lu(k,2260) - lu(k,1264) * lu(k,2235) + lu(k,2392) = lu(k,2392) - lu(k,1252) * lu(k,2391) + lu(k,2393) = lu(k,2393) - lu(k,1253) * lu(k,2391) + lu(k,2397) = lu(k,2397) - lu(k,1254) * lu(k,2391) + lu(k,2399) = lu(k,2399) - lu(k,1255) * lu(k,2391) + lu(k,2400) = lu(k,2400) - lu(k,1256) * lu(k,2391) + lu(k,2407) = lu(k,2407) - lu(k,1257) * lu(k,2391) + lu(k,2408) = lu(k,2408) - lu(k,1258) * lu(k,2391) + lu(k,2409) = lu(k,2409) - lu(k,1259) * lu(k,2391) + lu(k,2411) = lu(k,2411) - lu(k,1260) * lu(k,2391) + lu(k,2412) = lu(k,2412) - lu(k,1261) * lu(k,2391) + lu(k,2414) = lu(k,2414) - lu(k,1262) * lu(k,2391) + lu(k,2415) = lu(k,2415) - lu(k,1263) * lu(k,2391) + lu(k,2418) = lu(k,2418) - lu(k,1264) * lu(k,2391) + lu(k,1267) = 1._r8 / lu(k,1267) + lu(k,1268) = lu(k,1268) * lu(k,1267) + lu(k,1269) = lu(k,1269) * lu(k,1267) + lu(k,1270) = lu(k,1270) * lu(k,1267) + lu(k,1271) = lu(k,1271) * lu(k,1267) + lu(k,1272) = lu(k,1272) * lu(k,1267) + lu(k,1273) = lu(k,1273) * lu(k,1267) + lu(k,1274) = lu(k,1274) * lu(k,1267) + lu(k,1275) = lu(k,1275) * lu(k,1267) + lu(k,1276) = lu(k,1276) * lu(k,1267) + lu(k,1277) = lu(k,1277) * lu(k,1267) + lu(k,1296) = lu(k,1296) - lu(k,1268) * lu(k,1295) + lu(k,1298) = - lu(k,1269) * lu(k,1295) + lu(k,1300) = - lu(k,1270) * lu(k,1295) + lu(k,1301) = lu(k,1301) - lu(k,1271) * lu(k,1295) + lu(k,1302) = lu(k,1302) - lu(k,1272) * lu(k,1295) + lu(k,1303) = lu(k,1303) - lu(k,1273) * lu(k,1295) + lu(k,1308) = lu(k,1308) - lu(k,1274) * lu(k,1295) + lu(k,1310) = lu(k,1310) - lu(k,1275) * lu(k,1295) + lu(k,1311) = - lu(k,1276) * lu(k,1295) + lu(k,1312) = lu(k,1312) - lu(k,1277) * lu(k,1295) + lu(k,1329) = lu(k,1329) - lu(k,1268) * lu(k,1328) + lu(k,1331) = - lu(k,1269) * lu(k,1328) + lu(k,1333) = - lu(k,1270) * lu(k,1328) + lu(k,1334) = lu(k,1334) - lu(k,1271) * lu(k,1328) + lu(k,1335) = lu(k,1335) - lu(k,1272) * lu(k,1328) + lu(k,1336) = lu(k,1336) - lu(k,1273) * lu(k,1328) + lu(k,1341) = lu(k,1341) - lu(k,1274) * lu(k,1328) + lu(k,1343) = lu(k,1343) - lu(k,1275) * lu(k,1328) + lu(k,1344) = - lu(k,1276) * lu(k,1328) + lu(k,1345) = lu(k,1345) - lu(k,1277) * lu(k,1328) + lu(k,1420) = lu(k,1420) - lu(k,1268) * lu(k,1419) + lu(k,1423) = lu(k,1423) - lu(k,1269) * lu(k,1419) + lu(k,1425) = lu(k,1425) - lu(k,1270) * lu(k,1419) + lu(k,1426) = lu(k,1426) - lu(k,1271) * lu(k,1419) + lu(k,1427) = lu(k,1427) - lu(k,1272) * lu(k,1419) + lu(k,1429) = lu(k,1429) - lu(k,1273) * lu(k,1419) + lu(k,1434) = lu(k,1434) - lu(k,1274) * lu(k,1419) + lu(k,1437) = lu(k,1437) - lu(k,1275) * lu(k,1419) + lu(k,1438) = lu(k,1438) - lu(k,1276) * lu(k,1419) + lu(k,1439) = lu(k,1439) - lu(k,1277) * lu(k,1419) + lu(k,1783) = lu(k,1783) - lu(k,1268) * lu(k,1782) + lu(k,1786) = lu(k,1786) - lu(k,1269) * lu(k,1782) + lu(k,1788) = lu(k,1788) - lu(k,1270) * lu(k,1782) + lu(k,1789) = lu(k,1789) - lu(k,1271) * lu(k,1782) + lu(k,1790) = lu(k,1790) - lu(k,1272) * lu(k,1782) + lu(k,1799) = lu(k,1799) - lu(k,1273) * lu(k,1782) + lu(k,1806) = lu(k,1806) - lu(k,1274) * lu(k,1782) + lu(k,1810) = lu(k,1810) - lu(k,1275) * lu(k,1782) + lu(k,1811) = lu(k,1811) - lu(k,1276) * lu(k,1782) + lu(k,1812) = lu(k,1812) - lu(k,1277) * lu(k,1782) + lu(k,1890) = lu(k,1890) - lu(k,1268) * lu(k,1889) + lu(k,1893) = lu(k,1893) - lu(k,1269) * lu(k,1889) + lu(k,1895) = lu(k,1895) - lu(k,1270) * lu(k,1889) + lu(k,1896) = lu(k,1896) - lu(k,1271) * lu(k,1889) + lu(k,1897) = lu(k,1897) - lu(k,1272) * lu(k,1889) + lu(k,1904) = lu(k,1904) - lu(k,1273) * lu(k,1889) + lu(k,1911) = lu(k,1911) - lu(k,1274) * lu(k,1889) + lu(k,1915) = lu(k,1915) - lu(k,1275) * lu(k,1889) + lu(k,1916) = lu(k,1916) - lu(k,1276) * lu(k,1889) + lu(k,1917) = lu(k,1917) - lu(k,1277) * lu(k,1889) + lu(k,2055) = lu(k,2055) - lu(k,1268) * lu(k,2054) + lu(k,2058) = lu(k,2058) - lu(k,1269) * lu(k,2054) + lu(k,2060) = lu(k,2060) - lu(k,1270) * lu(k,2054) + lu(k,2061) = lu(k,2061) - lu(k,1271) * lu(k,2054) + lu(k,2062) = lu(k,2062) - lu(k,1272) * lu(k,2054) + lu(k,2068) = lu(k,2068) - lu(k,1273) * lu(k,2054) + lu(k,2075) = lu(k,2075) - lu(k,1274) * lu(k,2054) + lu(k,2079) = lu(k,2079) - lu(k,1275) * lu(k,2054) + lu(k,2080) = lu(k,2080) - lu(k,1276) * lu(k,2054) + lu(k,2081) = lu(k,2081) - lu(k,1277) * lu(k,2054) + lu(k,2182) = lu(k,2182) - lu(k,1268) * lu(k,2181) + lu(k,2185) = lu(k,2185) - lu(k,1269) * lu(k,2181) + lu(k,2187) = lu(k,2187) - lu(k,1270) * lu(k,2181) + lu(k,2188) = lu(k,2188) - lu(k,1271) * lu(k,2181) + lu(k,2189) = lu(k,2189) - lu(k,1272) * lu(k,2181) + lu(k,2197) = lu(k,2197) - lu(k,1273) * lu(k,2181) + lu(k,2204) = lu(k,2204) - lu(k,1274) * lu(k,2181) + lu(k,2208) = lu(k,2208) - lu(k,1275) * lu(k,2181) + lu(k,2209) = lu(k,2209) - lu(k,1276) * lu(k,2181) + lu(k,2210) = lu(k,2210) - lu(k,1277) * lu(k,2181) + lu(k,2237) = lu(k,2237) - lu(k,1268) * lu(k,2236) + lu(k,2240) = lu(k,2240) - lu(k,1269) * lu(k,2236) + lu(k,2242) = lu(k,2242) - lu(k,1270) * lu(k,2236) + lu(k,2243) = lu(k,2243) - lu(k,1271) * lu(k,2236) + lu(k,2244) = lu(k,2244) - lu(k,1272) * lu(k,2236) + lu(k,2249) = lu(k,2249) - lu(k,1273) * lu(k,2236) + lu(k,2256) = lu(k,2256) - lu(k,1274) * lu(k,2236) + lu(k,2260) = lu(k,2260) - lu(k,1275) * lu(k,2236) + lu(k,2261) = - lu(k,1276) * lu(k,2236) + lu(k,2262) = lu(k,2262) - lu(k,1277) * lu(k,2236) + lu(k,2393) = lu(k,2393) - lu(k,1268) * lu(k,2392) + lu(k,2396) = - lu(k,1269) * lu(k,2392) + lu(k,2398) = - lu(k,1270) * lu(k,2392) + lu(k,2399) = lu(k,2399) - lu(k,1271) * lu(k,2392) + lu(k,2400) = lu(k,2400) - lu(k,1272) * lu(k,2392) + lu(k,2407) = lu(k,2407) - lu(k,1273) * lu(k,2392) + lu(k,2414) = lu(k,2414) - lu(k,1274) * lu(k,2392) + lu(k,2418) = lu(k,2418) - lu(k,1275) * lu(k,2392) + lu(k,2419) = lu(k,2419) - lu(k,1276) * lu(k,2392) + lu(k,2420) = lu(k,2420) - lu(k,1277) * lu(k,2392) + lu(k,1279) = 1._r8 / lu(k,1279) + lu(k,1280) = lu(k,1280) * lu(k,1279) + lu(k,1281) = lu(k,1281) * lu(k,1279) + lu(k,1282) = lu(k,1282) * lu(k,1279) + lu(k,1283) = lu(k,1283) * lu(k,1279) + lu(k,1284) = lu(k,1284) * lu(k,1279) + lu(k,1285) = lu(k,1285) * lu(k,1279) + lu(k,1286) = lu(k,1286) * lu(k,1279) + lu(k,1301) = lu(k,1301) - lu(k,1280) * lu(k,1296) + lu(k,1302) = lu(k,1302) - lu(k,1281) * lu(k,1296) + lu(k,1303) = lu(k,1303) - lu(k,1282) * lu(k,1296) + lu(k,1305) = lu(k,1305) - lu(k,1283) * lu(k,1296) + lu(k,1306) = lu(k,1306) - lu(k,1284) * lu(k,1296) + lu(k,1308) = lu(k,1308) - lu(k,1285) * lu(k,1296) + lu(k,1312) = lu(k,1312) - lu(k,1286) * lu(k,1296) + lu(k,1334) = lu(k,1334) - lu(k,1280) * lu(k,1329) + lu(k,1335) = lu(k,1335) - lu(k,1281) * lu(k,1329) + lu(k,1336) = lu(k,1336) - lu(k,1282) * lu(k,1329) + lu(k,1338) = lu(k,1338) - lu(k,1283) * lu(k,1329) + lu(k,1339) = lu(k,1339) - lu(k,1284) * lu(k,1329) + lu(k,1341) = lu(k,1341) - lu(k,1285) * lu(k,1329) + lu(k,1345) = lu(k,1345) - lu(k,1286) * lu(k,1329) + lu(k,1356) = lu(k,1356) - lu(k,1280) * lu(k,1353) + lu(k,1357) = lu(k,1357) - lu(k,1281) * lu(k,1353) + lu(k,1358) = lu(k,1358) - lu(k,1282) * lu(k,1353) + lu(k,1360) = lu(k,1360) - lu(k,1283) * lu(k,1353) + lu(k,1361) = lu(k,1361) - lu(k,1284) * lu(k,1353) + lu(k,1363) = lu(k,1363) - lu(k,1285) * lu(k,1353) + lu(k,1366) = lu(k,1366) - lu(k,1286) * lu(k,1353) + lu(k,1376) = lu(k,1376) - lu(k,1280) * lu(k,1372) + lu(k,1377) = lu(k,1377) - lu(k,1281) * lu(k,1372) + lu(k,1379) = lu(k,1379) - lu(k,1282) * lu(k,1372) + lu(k,1381) = lu(k,1381) - lu(k,1283) * lu(k,1372) + lu(k,1382) = lu(k,1382) - lu(k,1284) * lu(k,1372) + lu(k,1384) = lu(k,1384) - lu(k,1285) * lu(k,1372) + lu(k,1389) = lu(k,1389) - lu(k,1286) * lu(k,1372) + lu(k,1396) = lu(k,1396) - lu(k,1280) * lu(k,1394) + lu(k,1397) = lu(k,1397) - lu(k,1281) * lu(k,1394) + lu(k,1398) = lu(k,1398) - lu(k,1282) * lu(k,1394) + lu(k,1400) = lu(k,1400) - lu(k,1283) * lu(k,1394) + lu(k,1401) = - lu(k,1284) * lu(k,1394) + lu(k,1403) = lu(k,1403) - lu(k,1285) * lu(k,1394) + lu(k,1407) = lu(k,1407) - lu(k,1286) * lu(k,1394) + lu(k,1426) = lu(k,1426) - lu(k,1280) * lu(k,1420) + lu(k,1427) = lu(k,1427) - lu(k,1281) * lu(k,1420) + lu(k,1429) = lu(k,1429) - lu(k,1282) * lu(k,1420) + lu(k,1431) = lu(k,1431) - lu(k,1283) * lu(k,1420) + lu(k,1432) = lu(k,1432) - lu(k,1284) * lu(k,1420) + lu(k,1434) = lu(k,1434) - lu(k,1285) * lu(k,1420) + lu(k,1439) = lu(k,1439) - lu(k,1286) * lu(k,1420) + lu(k,1789) = lu(k,1789) - lu(k,1280) * lu(k,1783) + lu(k,1790) = lu(k,1790) - lu(k,1281) * lu(k,1783) + lu(k,1799) = lu(k,1799) - lu(k,1282) * lu(k,1783) + lu(k,1801) = lu(k,1801) - lu(k,1283) * lu(k,1783) + lu(k,1803) = lu(k,1803) - lu(k,1284) * lu(k,1783) + lu(k,1806) = lu(k,1806) - lu(k,1285) * lu(k,1783) + lu(k,1812) = lu(k,1812) - lu(k,1286) * lu(k,1783) + lu(k,1835) = lu(k,1835) - lu(k,1280) * lu(k,1833) + lu(k,1836) = lu(k,1836) - lu(k,1281) * lu(k,1833) + lu(k,1844) = lu(k,1844) - lu(k,1282) * lu(k,1833) + lu(k,1846) = lu(k,1846) - lu(k,1283) * lu(k,1833) + lu(k,1848) = lu(k,1848) - lu(k,1284) * lu(k,1833) + lu(k,1851) = lu(k,1851) - lu(k,1285) * lu(k,1833) + lu(k,1857) = lu(k,1857) - lu(k,1286) * lu(k,1833) + lu(k,1896) = lu(k,1896) - lu(k,1280) * lu(k,1890) + lu(k,1897) = lu(k,1897) - lu(k,1281) * lu(k,1890) + lu(k,1904) = lu(k,1904) - lu(k,1282) * lu(k,1890) + lu(k,1906) = lu(k,1906) - lu(k,1283) * lu(k,1890) + lu(k,1908) = lu(k,1908) - lu(k,1284) * lu(k,1890) + lu(k,1911) = lu(k,1911) - lu(k,1285) * lu(k,1890) + lu(k,1917) = lu(k,1917) - lu(k,1286) * lu(k,1890) + lu(k,1941) = lu(k,1941) - lu(k,1280) * lu(k,1940) + lu(k,1942) = lu(k,1942) - lu(k,1281) * lu(k,1940) + lu(k,1950) = lu(k,1950) - lu(k,1282) * lu(k,1940) + lu(k,1952) = lu(k,1952) - lu(k,1283) * lu(k,1940) + lu(k,1954) = lu(k,1954) - lu(k,1284) * lu(k,1940) + lu(k,1957) = lu(k,1957) - lu(k,1285) * lu(k,1940) + lu(k,1963) = lu(k,1963) - lu(k,1286) * lu(k,1940) + lu(k,2061) = lu(k,2061) - lu(k,1280) * lu(k,2055) + lu(k,2062) = lu(k,2062) - lu(k,1281) * lu(k,2055) + lu(k,2068) = lu(k,2068) - lu(k,1282) * lu(k,2055) + lu(k,2070) = lu(k,2070) - lu(k,1283) * lu(k,2055) + lu(k,2072) = lu(k,2072) - lu(k,1284) * lu(k,2055) + lu(k,2075) = lu(k,2075) - lu(k,1285) * lu(k,2055) + lu(k,2081) = lu(k,2081) - lu(k,1286) * lu(k,2055) + lu(k,2188) = lu(k,2188) - lu(k,1280) * lu(k,2182) + lu(k,2189) = lu(k,2189) - lu(k,1281) * lu(k,2182) + lu(k,2197) = lu(k,2197) - lu(k,1282) * lu(k,2182) + lu(k,2199) = lu(k,2199) - lu(k,1283) * lu(k,2182) + lu(k,2201) = lu(k,2201) - lu(k,1284) * lu(k,2182) + lu(k,2204) = lu(k,2204) - lu(k,1285) * lu(k,2182) + lu(k,2210) = lu(k,2210) - lu(k,1286) * lu(k,2182) + lu(k,2243) = lu(k,2243) - lu(k,1280) * lu(k,2237) + lu(k,2244) = lu(k,2244) - lu(k,1281) * lu(k,2237) + lu(k,2249) = lu(k,2249) - lu(k,1282) * lu(k,2237) + lu(k,2251) = lu(k,2251) - lu(k,1283) * lu(k,2237) + lu(k,2253) = lu(k,2253) - lu(k,1284) * lu(k,2237) + lu(k,2256) = lu(k,2256) - lu(k,1285) * lu(k,2237) + lu(k,2262) = lu(k,2262) - lu(k,1286) * lu(k,2237) + lu(k,2399) = lu(k,2399) - lu(k,1280) * lu(k,2393) + lu(k,2400) = lu(k,2400) - lu(k,1281) * lu(k,2393) + lu(k,2407) = lu(k,2407) - lu(k,1282) * lu(k,2393) + lu(k,2409) = lu(k,2409) - lu(k,1283) * lu(k,2393) + lu(k,2411) = lu(k,2411) - lu(k,1284) * lu(k,2393) + lu(k,2414) = lu(k,2414) - lu(k,1285) * lu(k,2393) + lu(k,2420) = lu(k,2420) - lu(k,1286) * lu(k,2393) end do - end subroutine lu_fac25 - subroutine lu_fac26( avec_len, lu ) + end subroutine lu_fac26 + subroutine lu_fac27( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 implicit none @@ -5884,297 +5476,481 @@ subroutine lu_fac26( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1318) = 1._r8 / lu(k,1318) - lu(k,1319) = lu(k,1319) * lu(k,1318) - lu(k,1320) = lu(k,1320) * lu(k,1318) - lu(k,1321) = lu(k,1321) * lu(k,1318) - lu(k,1322) = lu(k,1322) * lu(k,1318) - lu(k,1323) = lu(k,1323) * lu(k,1318) - lu(k,1324) = lu(k,1324) * lu(k,1318) - lu(k,1325) = lu(k,1325) * lu(k,1318) - lu(k,1326) = lu(k,1326) * lu(k,1318) - lu(k,1327) = lu(k,1327) * lu(k,1318) - lu(k,1328) = lu(k,1328) * lu(k,1318) - lu(k,1329) = lu(k,1329) * lu(k,1318) - lu(k,1330) = lu(k,1330) * lu(k,1318) - lu(k,1331) = lu(k,1331) * lu(k,1318) - lu(k,1426) = - lu(k,1319) * lu(k,1425) - lu(k,1427) = lu(k,1427) - lu(k,1320) * lu(k,1425) - lu(k,1428) = lu(k,1428) - lu(k,1321) * lu(k,1425) - lu(k,1429) = - lu(k,1322) * lu(k,1425) - lu(k,1431) = lu(k,1431) - lu(k,1323) * lu(k,1425) - lu(k,1432) = lu(k,1432) - lu(k,1324) * lu(k,1425) - lu(k,1433) = lu(k,1433) - lu(k,1325) * lu(k,1425) - lu(k,1435) = lu(k,1435) - lu(k,1326) * lu(k,1425) - lu(k,1436) = lu(k,1436) - lu(k,1327) * lu(k,1425) - lu(k,1437) = - lu(k,1328) * lu(k,1425) - lu(k,1438) = lu(k,1438) - lu(k,1329) * lu(k,1425) - lu(k,1439) = - lu(k,1330) * lu(k,1425) - lu(k,1440) = lu(k,1440) - lu(k,1331) * lu(k,1425) - lu(k,1713) = lu(k,1713) - lu(k,1319) * lu(k,1711) - lu(k,1715) = lu(k,1715) - lu(k,1320) * lu(k,1711) - lu(k,1716) = lu(k,1716) - lu(k,1321) * lu(k,1711) - lu(k,1717) = lu(k,1717) - lu(k,1322) * lu(k,1711) - lu(k,1719) = lu(k,1719) - lu(k,1323) * lu(k,1711) - lu(k,1720) = lu(k,1720) - lu(k,1324) * lu(k,1711) - lu(k,1721) = lu(k,1721) - lu(k,1325) * lu(k,1711) - lu(k,1724) = lu(k,1724) - lu(k,1326) * lu(k,1711) - lu(k,1726) = lu(k,1726) - lu(k,1327) * lu(k,1711) - lu(k,1727) = lu(k,1727) - lu(k,1328) * lu(k,1711) - lu(k,1728) = lu(k,1728) - lu(k,1329) * lu(k,1711) - lu(k,1729) = lu(k,1729) - lu(k,1330) * lu(k,1711) - lu(k,1730) = lu(k,1730) - lu(k,1331) * lu(k,1711) - lu(k,1775) = lu(k,1775) - lu(k,1319) * lu(k,1774) - lu(k,1777) = lu(k,1777) - lu(k,1320) * lu(k,1774) - lu(k,1778) = lu(k,1778) - lu(k,1321) * lu(k,1774) - lu(k,1779) = lu(k,1779) - lu(k,1322) * lu(k,1774) - lu(k,1781) = lu(k,1781) - lu(k,1323) * lu(k,1774) - lu(k,1782) = lu(k,1782) - lu(k,1324) * lu(k,1774) - lu(k,1783) = lu(k,1783) - lu(k,1325) * lu(k,1774) - lu(k,1786) = lu(k,1786) - lu(k,1326) * lu(k,1774) - lu(k,1788) = lu(k,1788) - lu(k,1327) * lu(k,1774) - lu(k,1789) = lu(k,1789) - lu(k,1328) * lu(k,1774) - lu(k,1790) = lu(k,1790) - lu(k,1329) * lu(k,1774) - lu(k,1791) = lu(k,1791) - lu(k,1330) * lu(k,1774) - lu(k,1792) = lu(k,1792) - lu(k,1331) * lu(k,1774) - lu(k,1816) = lu(k,1816) - lu(k,1319) * lu(k,1814) - lu(k,1818) = lu(k,1818) - lu(k,1320) * lu(k,1814) - lu(k,1819) = lu(k,1819) - lu(k,1321) * lu(k,1814) - lu(k,1820) = lu(k,1820) - lu(k,1322) * lu(k,1814) - lu(k,1822) = lu(k,1822) - lu(k,1323) * lu(k,1814) - lu(k,1823) = lu(k,1823) - lu(k,1324) * lu(k,1814) - lu(k,1824) = lu(k,1824) - lu(k,1325) * lu(k,1814) - lu(k,1827) = lu(k,1827) - lu(k,1326) * lu(k,1814) - lu(k,1829) = lu(k,1829) - lu(k,1327) * lu(k,1814) - lu(k,1830) = lu(k,1830) - lu(k,1328) * lu(k,1814) - lu(k,1831) = lu(k,1831) - lu(k,1329) * lu(k,1814) - lu(k,1832) = lu(k,1832) - lu(k,1330) * lu(k,1814) - lu(k,1833) = lu(k,1833) - lu(k,1331) * lu(k,1814) - lu(k,1897) = - lu(k,1319) * lu(k,1896) - lu(k,1899) = lu(k,1899) - lu(k,1320) * lu(k,1896) - lu(k,1900) = lu(k,1900) - lu(k,1321) * lu(k,1896) - lu(k,1901) = - lu(k,1322) * lu(k,1896) - lu(k,1903) = lu(k,1903) - lu(k,1323) * lu(k,1896) - lu(k,1904) = lu(k,1904) - lu(k,1324) * lu(k,1896) - lu(k,1905) = lu(k,1905) - lu(k,1325) * lu(k,1896) - lu(k,1908) = lu(k,1908) - lu(k,1326) * lu(k,1896) - lu(k,1910) = lu(k,1910) - lu(k,1327) * lu(k,1896) - lu(k,1911) = - lu(k,1328) * lu(k,1896) - lu(k,1912) = lu(k,1912) - lu(k,1329) * lu(k,1896) - lu(k,1913) = - lu(k,1330) * lu(k,1896) - lu(k,1914) = lu(k,1914) - lu(k,1331) * lu(k,1896) - lu(k,1981) = lu(k,1981) - lu(k,1319) * lu(k,1979) - lu(k,1983) = lu(k,1983) - lu(k,1320) * lu(k,1979) - lu(k,1984) = lu(k,1984) - lu(k,1321) * lu(k,1979) - lu(k,1985) = lu(k,1985) - lu(k,1322) * lu(k,1979) - lu(k,1987) = lu(k,1987) - lu(k,1323) * lu(k,1979) - lu(k,1988) = lu(k,1988) - lu(k,1324) * lu(k,1979) - lu(k,1989) = lu(k,1989) - lu(k,1325) * lu(k,1979) - lu(k,1992) = lu(k,1992) - lu(k,1326) * lu(k,1979) - lu(k,1994) = lu(k,1994) - lu(k,1327) * lu(k,1979) - lu(k,1995) = lu(k,1995) - lu(k,1328) * lu(k,1979) - lu(k,1996) = lu(k,1996) - lu(k,1329) * lu(k,1979) - lu(k,1997) = lu(k,1997) - lu(k,1330) * lu(k,1979) - lu(k,1998) = lu(k,1998) - lu(k,1331) * lu(k,1979) - lu(k,2006) = lu(k,2006) - lu(k,1319) * lu(k,2004) - lu(k,2007) = lu(k,2007) - lu(k,1320) * lu(k,2004) - lu(k,2008) = lu(k,2008) - lu(k,1321) * lu(k,2004) - lu(k,2009) = lu(k,2009) - lu(k,1322) * lu(k,2004) - lu(k,2011) = lu(k,2011) - lu(k,1323) * lu(k,2004) - lu(k,2012) = - lu(k,1324) * lu(k,2004) - lu(k,2013) = lu(k,2013) - lu(k,1325) * lu(k,2004) - lu(k,2016) = - lu(k,1326) * lu(k,2004) - lu(k,2018) = lu(k,2018) - lu(k,1327) * lu(k,2004) - lu(k,2019) = lu(k,2019) - lu(k,1328) * lu(k,2004) - lu(k,2020) = lu(k,2020) - lu(k,1329) * lu(k,2004) - lu(k,2021) = lu(k,2021) - lu(k,1330) * lu(k,2004) - lu(k,2022) = lu(k,2022) - lu(k,1331) * lu(k,2004) - lu(k,2127) = lu(k,2127) - lu(k,1319) * lu(k,2125) - lu(k,2129) = lu(k,2129) - lu(k,1320) * lu(k,2125) - lu(k,2130) = lu(k,2130) - lu(k,1321) * lu(k,2125) - lu(k,2131) = lu(k,2131) - lu(k,1322) * lu(k,2125) - lu(k,2133) = lu(k,2133) - lu(k,1323) * lu(k,2125) - lu(k,2134) = - lu(k,1324) * lu(k,2125) - lu(k,2135) = lu(k,2135) - lu(k,1325) * lu(k,2125) - lu(k,2138) = - lu(k,1326) * lu(k,2125) - lu(k,2140) = lu(k,2140) - lu(k,1327) * lu(k,2125) - lu(k,2141) = lu(k,2141) - lu(k,1328) * lu(k,2125) - lu(k,2142) = lu(k,2142) - lu(k,1329) * lu(k,2125) - lu(k,2143) = lu(k,2143) - lu(k,1330) * lu(k,2125) - lu(k,2144) = lu(k,2144) - lu(k,1331) * lu(k,2125) - lu(k,2153) = - lu(k,1319) * lu(k,2151) - lu(k,2155) = - lu(k,1320) * lu(k,2151) - lu(k,2156) = - lu(k,1321) * lu(k,2151) - lu(k,2157) = lu(k,2157) - lu(k,1322) * lu(k,2151) - lu(k,2159) = lu(k,2159) - lu(k,1323) * lu(k,2151) - lu(k,2160) = - lu(k,1324) * lu(k,2151) - lu(k,2161) = lu(k,2161) - lu(k,1325) * lu(k,2151) - lu(k,2164) = lu(k,2164) - lu(k,1326) * lu(k,2151) - lu(k,2166) = - lu(k,1327) * lu(k,2151) - lu(k,2167) = - lu(k,1328) * lu(k,2151) - lu(k,2168) = lu(k,2168) - lu(k,1329) * lu(k,2151) - lu(k,2169) = - lu(k,1330) * lu(k,2151) - lu(k,2170) = lu(k,2170) - lu(k,1331) * lu(k,2151) - lu(k,1337) = 1._r8 / lu(k,1337) - lu(k,1338) = lu(k,1338) * lu(k,1337) - lu(k,1339) = lu(k,1339) * lu(k,1337) - lu(k,1340) = lu(k,1340) * lu(k,1337) - lu(k,1341) = lu(k,1341) * lu(k,1337) - lu(k,1342) = lu(k,1342) * lu(k,1337) - lu(k,1343) = lu(k,1343) * lu(k,1337) - lu(k,1344) = lu(k,1344) * lu(k,1337) - lu(k,1345) = lu(k,1345) * lu(k,1337) - lu(k,1346) = lu(k,1346) * lu(k,1337) - lu(k,1347) = lu(k,1347) * lu(k,1337) - lu(k,1348) = lu(k,1348) * lu(k,1337) - lu(k,1349) = lu(k,1349) * lu(k,1337) - lu(k,1539) = lu(k,1539) - lu(k,1338) * lu(k,1538) - lu(k,1543) = lu(k,1543) - lu(k,1339) * lu(k,1538) - lu(k,1544) = lu(k,1544) - lu(k,1340) * lu(k,1538) - lu(k,1545) = lu(k,1545) - lu(k,1341) * lu(k,1538) - lu(k,1547) = lu(k,1547) - lu(k,1342) * lu(k,1538) - lu(k,1549) = lu(k,1549) - lu(k,1343) * lu(k,1538) - lu(k,1550) = lu(k,1550) - lu(k,1344) * lu(k,1538) - lu(k,1551) = lu(k,1551) - lu(k,1345) * lu(k,1538) - lu(k,1552) = lu(k,1552) - lu(k,1346) * lu(k,1538) - lu(k,1553) = - lu(k,1347) * lu(k,1538) - lu(k,1555) = lu(k,1555) - lu(k,1348) * lu(k,1538) - lu(k,1556) = lu(k,1556) - lu(k,1349) * lu(k,1538) - lu(k,1565) = lu(k,1565) - lu(k,1338) * lu(k,1564) - lu(k,1569) = lu(k,1569) - lu(k,1339) * lu(k,1564) - lu(k,1570) = lu(k,1570) - lu(k,1340) * lu(k,1564) - lu(k,1571) = lu(k,1571) - lu(k,1341) * lu(k,1564) - lu(k,1573) = lu(k,1573) - lu(k,1342) * lu(k,1564) - lu(k,1575) = lu(k,1575) - lu(k,1343) * lu(k,1564) - lu(k,1576) = lu(k,1576) - lu(k,1344) * lu(k,1564) - lu(k,1577) = lu(k,1577) - lu(k,1345) * lu(k,1564) - lu(k,1578) = - lu(k,1346) * lu(k,1564) - lu(k,1579) = lu(k,1579) - lu(k,1347) * lu(k,1564) - lu(k,1581) = lu(k,1581) - lu(k,1348) * lu(k,1564) - lu(k,1582) = lu(k,1582) - lu(k,1349) * lu(k,1564) - lu(k,1713) = lu(k,1713) - lu(k,1338) * lu(k,1712) - lu(k,1717) = lu(k,1717) - lu(k,1339) * lu(k,1712) - lu(k,1718) = lu(k,1718) - lu(k,1340) * lu(k,1712) - lu(k,1719) = lu(k,1719) - lu(k,1341) * lu(k,1712) - lu(k,1721) = lu(k,1721) - lu(k,1342) * lu(k,1712) - lu(k,1723) = lu(k,1723) - lu(k,1343) * lu(k,1712) - lu(k,1724) = lu(k,1724) - lu(k,1344) * lu(k,1712) - lu(k,1725) = lu(k,1725) - lu(k,1345) * lu(k,1712) - lu(k,1726) = lu(k,1726) - lu(k,1346) * lu(k,1712) - lu(k,1727) = lu(k,1727) - lu(k,1347) * lu(k,1712) - lu(k,1729) = lu(k,1729) - lu(k,1348) * lu(k,1712) - lu(k,1730) = lu(k,1730) - lu(k,1349) * lu(k,1712) - lu(k,1816) = lu(k,1816) - lu(k,1338) * lu(k,1815) - lu(k,1820) = lu(k,1820) - lu(k,1339) * lu(k,1815) - lu(k,1821) = lu(k,1821) - lu(k,1340) * lu(k,1815) - lu(k,1822) = lu(k,1822) - lu(k,1341) * lu(k,1815) - lu(k,1824) = lu(k,1824) - lu(k,1342) * lu(k,1815) - lu(k,1826) = lu(k,1826) - lu(k,1343) * lu(k,1815) - lu(k,1827) = lu(k,1827) - lu(k,1344) * lu(k,1815) - lu(k,1828) = lu(k,1828) - lu(k,1345) * lu(k,1815) - lu(k,1829) = lu(k,1829) - lu(k,1346) * lu(k,1815) - lu(k,1830) = lu(k,1830) - lu(k,1347) * lu(k,1815) - lu(k,1832) = lu(k,1832) - lu(k,1348) * lu(k,1815) - lu(k,1833) = lu(k,1833) - lu(k,1349) * lu(k,1815) - lu(k,1840) = lu(k,1840) - lu(k,1338) * lu(k,1839) - lu(k,1844) = lu(k,1844) - lu(k,1339) * lu(k,1839) - lu(k,1845) = lu(k,1845) - lu(k,1340) * lu(k,1839) - lu(k,1846) = lu(k,1846) - lu(k,1341) * lu(k,1839) - lu(k,1848) = lu(k,1848) - lu(k,1342) * lu(k,1839) - lu(k,1850) = lu(k,1850) - lu(k,1343) * lu(k,1839) - lu(k,1851) = lu(k,1851) - lu(k,1344) * lu(k,1839) - lu(k,1852) = lu(k,1852) - lu(k,1345) * lu(k,1839) - lu(k,1853) = lu(k,1853) - lu(k,1346) * lu(k,1839) - lu(k,1854) = lu(k,1854) - lu(k,1347) * lu(k,1839) - lu(k,1856) = - lu(k,1348) * lu(k,1839) - lu(k,1857) = lu(k,1857) - lu(k,1349) * lu(k,1839) - lu(k,1917) = - lu(k,1338) * lu(k,1916) - lu(k,1921) = lu(k,1921) - lu(k,1339) * lu(k,1916) - lu(k,1922) = lu(k,1922) - lu(k,1340) * lu(k,1916) - lu(k,1923) = lu(k,1923) - lu(k,1341) * lu(k,1916) - lu(k,1925) = lu(k,1925) - lu(k,1342) * lu(k,1916) - lu(k,1927) = lu(k,1927) - lu(k,1343) * lu(k,1916) - lu(k,1928) = lu(k,1928) - lu(k,1344) * lu(k,1916) - lu(k,1929) = lu(k,1929) - lu(k,1345) * lu(k,1916) - lu(k,1930) = - lu(k,1346) * lu(k,1916) - lu(k,1931) = - lu(k,1347) * lu(k,1916) - lu(k,1933) = - lu(k,1348) * lu(k,1916) - lu(k,1934) = lu(k,1934) - lu(k,1349) * lu(k,1916) - lu(k,1939) = - lu(k,1338) * lu(k,1938) - lu(k,1943) = lu(k,1943) - lu(k,1339) * lu(k,1938) - lu(k,1944) = lu(k,1944) - lu(k,1340) * lu(k,1938) - lu(k,1945) = lu(k,1945) - lu(k,1341) * lu(k,1938) - lu(k,1947) = lu(k,1947) - lu(k,1342) * lu(k,1938) - lu(k,1949) = lu(k,1949) - lu(k,1343) * lu(k,1938) - lu(k,1950) = lu(k,1950) - lu(k,1344) * lu(k,1938) - lu(k,1951) = lu(k,1951) - lu(k,1345) * lu(k,1938) - lu(k,1952) = lu(k,1952) - lu(k,1346) * lu(k,1938) - lu(k,1953) = - lu(k,1347) * lu(k,1938) - lu(k,1955) = - lu(k,1348) * lu(k,1938) - lu(k,1956) = lu(k,1956) - lu(k,1349) * lu(k,1938) - lu(k,1981) = lu(k,1981) - lu(k,1338) * lu(k,1980) - lu(k,1985) = lu(k,1985) - lu(k,1339) * lu(k,1980) - lu(k,1986) = lu(k,1986) - lu(k,1340) * lu(k,1980) - lu(k,1987) = lu(k,1987) - lu(k,1341) * lu(k,1980) - lu(k,1989) = lu(k,1989) - lu(k,1342) * lu(k,1980) - lu(k,1991) = lu(k,1991) - lu(k,1343) * lu(k,1980) - lu(k,1992) = lu(k,1992) - lu(k,1344) * lu(k,1980) - lu(k,1993) = lu(k,1993) - lu(k,1345) * lu(k,1980) - lu(k,1994) = lu(k,1994) - lu(k,1346) * lu(k,1980) - lu(k,1995) = lu(k,1995) - lu(k,1347) * lu(k,1980) - lu(k,1997) = lu(k,1997) - lu(k,1348) * lu(k,1980) - lu(k,1998) = lu(k,1998) - lu(k,1349) * lu(k,1980) - lu(k,2006) = lu(k,2006) - lu(k,1338) * lu(k,2005) - lu(k,2009) = lu(k,2009) - lu(k,1339) * lu(k,2005) - lu(k,2010) = - lu(k,1340) * lu(k,2005) - lu(k,2011) = lu(k,2011) - lu(k,1341) * lu(k,2005) - lu(k,2013) = lu(k,2013) - lu(k,1342) * lu(k,2005) - lu(k,2015) = lu(k,2015) - lu(k,1343) * lu(k,2005) - lu(k,2016) = lu(k,2016) - lu(k,1344) * lu(k,2005) - lu(k,2017) = lu(k,2017) - lu(k,1345) * lu(k,2005) - lu(k,2018) = lu(k,2018) - lu(k,1346) * lu(k,2005) - lu(k,2019) = lu(k,2019) - lu(k,1347) * lu(k,2005) - lu(k,2021) = lu(k,2021) - lu(k,1348) * lu(k,2005) - lu(k,2022) = lu(k,2022) - lu(k,1349) * lu(k,2005) - lu(k,2100) = lu(k,2100) - lu(k,1338) * lu(k,2099) - lu(k,2104) = lu(k,2104) - lu(k,1339) * lu(k,2099) - lu(k,2105) = lu(k,2105) - lu(k,1340) * lu(k,2099) - lu(k,2106) = lu(k,2106) - lu(k,1341) * lu(k,2099) - lu(k,2108) = lu(k,2108) - lu(k,1342) * lu(k,2099) - lu(k,2110) = lu(k,2110) - lu(k,1343) * lu(k,2099) - lu(k,2111) = lu(k,2111) - lu(k,1344) * lu(k,2099) - lu(k,2112) = lu(k,2112) - lu(k,1345) * lu(k,2099) - lu(k,2113) = lu(k,2113) - lu(k,1346) * lu(k,2099) - lu(k,2114) = lu(k,2114) - lu(k,1347) * lu(k,2099) - lu(k,2116) = lu(k,2116) - lu(k,1348) * lu(k,2099) - lu(k,2117) = lu(k,2117) - lu(k,1349) * lu(k,2099) - lu(k,2127) = lu(k,2127) - lu(k,1338) * lu(k,2126) - lu(k,2131) = lu(k,2131) - lu(k,1339) * lu(k,2126) - lu(k,2132) = - lu(k,1340) * lu(k,2126) - lu(k,2133) = lu(k,2133) - lu(k,1341) * lu(k,2126) - lu(k,2135) = lu(k,2135) - lu(k,1342) * lu(k,2126) - lu(k,2137) = lu(k,2137) - lu(k,1343) * lu(k,2126) - lu(k,2138) = lu(k,2138) - lu(k,1344) * lu(k,2126) - lu(k,2139) = lu(k,2139) - lu(k,1345) * lu(k,2126) - lu(k,2140) = lu(k,2140) - lu(k,1346) * lu(k,2126) - lu(k,2141) = lu(k,2141) - lu(k,1347) * lu(k,2126) - lu(k,2143) = lu(k,2143) - lu(k,1348) * lu(k,2126) - lu(k,2144) = lu(k,2144) - lu(k,1349) * lu(k,2126) - lu(k,2153) = lu(k,2153) - lu(k,1338) * lu(k,2152) - lu(k,2157) = lu(k,2157) - lu(k,1339) * lu(k,2152) - lu(k,2158) = lu(k,2158) - lu(k,1340) * lu(k,2152) - lu(k,2159) = lu(k,2159) - lu(k,1341) * lu(k,2152) - lu(k,2161) = lu(k,2161) - lu(k,1342) * lu(k,2152) - lu(k,2163) = lu(k,2163) - lu(k,1343) * lu(k,2152) - lu(k,2164) = lu(k,2164) - lu(k,1344) * lu(k,2152) - lu(k,2165) = lu(k,2165) - lu(k,1345) * lu(k,2152) - lu(k,2166) = lu(k,2166) - lu(k,1346) * lu(k,2152) - lu(k,2167) = lu(k,2167) - lu(k,1347) * lu(k,2152) - lu(k,2169) = lu(k,2169) - lu(k,1348) * lu(k,2152) - lu(k,2170) = lu(k,2170) - lu(k,1349) * lu(k,2152) + lu(k,1297) = 1._r8 / lu(k,1297) + lu(k,1298) = lu(k,1298) * lu(k,1297) + lu(k,1299) = lu(k,1299) * lu(k,1297) + lu(k,1300) = lu(k,1300) * lu(k,1297) + lu(k,1301) = lu(k,1301) * lu(k,1297) + lu(k,1302) = lu(k,1302) * lu(k,1297) + lu(k,1303) = lu(k,1303) * lu(k,1297) + lu(k,1304) = lu(k,1304) * lu(k,1297) + lu(k,1305) = lu(k,1305) * lu(k,1297) + lu(k,1306) = lu(k,1306) * lu(k,1297) + lu(k,1307) = lu(k,1307) * lu(k,1297) + lu(k,1308) = lu(k,1308) * lu(k,1297) + lu(k,1309) = lu(k,1309) * lu(k,1297) + lu(k,1310) = lu(k,1310) * lu(k,1297) + lu(k,1311) = lu(k,1311) * lu(k,1297) + lu(k,1312) = lu(k,1312) * lu(k,1297) + lu(k,1423) = lu(k,1423) - lu(k,1298) * lu(k,1421) + lu(k,1424) = lu(k,1424) - lu(k,1299) * lu(k,1421) + lu(k,1425) = lu(k,1425) - lu(k,1300) * lu(k,1421) + lu(k,1426) = lu(k,1426) - lu(k,1301) * lu(k,1421) + lu(k,1427) = lu(k,1427) - lu(k,1302) * lu(k,1421) + lu(k,1429) = lu(k,1429) - lu(k,1303) * lu(k,1421) + lu(k,1430) = lu(k,1430) - lu(k,1304) * lu(k,1421) + lu(k,1431) = lu(k,1431) - lu(k,1305) * lu(k,1421) + lu(k,1432) = lu(k,1432) - lu(k,1306) * lu(k,1421) + lu(k,1433) = lu(k,1433) - lu(k,1307) * lu(k,1421) + lu(k,1434) = lu(k,1434) - lu(k,1308) * lu(k,1421) + lu(k,1435) = lu(k,1435) - lu(k,1309) * lu(k,1421) + lu(k,1437) = lu(k,1437) - lu(k,1310) * lu(k,1421) + lu(k,1438) = lu(k,1438) - lu(k,1311) * lu(k,1421) + lu(k,1439) = lu(k,1439) - lu(k,1312) * lu(k,1421) + lu(k,1786) = lu(k,1786) - lu(k,1298) * lu(k,1784) + lu(k,1787) = lu(k,1787) - lu(k,1299) * lu(k,1784) + lu(k,1788) = lu(k,1788) - lu(k,1300) * lu(k,1784) + lu(k,1789) = lu(k,1789) - lu(k,1301) * lu(k,1784) + lu(k,1790) = lu(k,1790) - lu(k,1302) * lu(k,1784) + lu(k,1799) = lu(k,1799) - lu(k,1303) * lu(k,1784) + lu(k,1800) = lu(k,1800) - lu(k,1304) * lu(k,1784) + lu(k,1801) = lu(k,1801) - lu(k,1305) * lu(k,1784) + lu(k,1803) = lu(k,1803) - lu(k,1306) * lu(k,1784) + lu(k,1804) = lu(k,1804) - lu(k,1307) * lu(k,1784) + lu(k,1806) = lu(k,1806) - lu(k,1308) * lu(k,1784) + lu(k,1807) = lu(k,1807) - lu(k,1309) * lu(k,1784) + lu(k,1810) = lu(k,1810) - lu(k,1310) * lu(k,1784) + lu(k,1811) = lu(k,1811) - lu(k,1311) * lu(k,1784) + lu(k,1812) = lu(k,1812) - lu(k,1312) * lu(k,1784) + lu(k,1893) = lu(k,1893) - lu(k,1298) * lu(k,1891) + lu(k,1894) = lu(k,1894) - lu(k,1299) * lu(k,1891) + lu(k,1895) = lu(k,1895) - lu(k,1300) * lu(k,1891) + lu(k,1896) = lu(k,1896) - lu(k,1301) * lu(k,1891) + lu(k,1897) = lu(k,1897) - lu(k,1302) * lu(k,1891) + lu(k,1904) = lu(k,1904) - lu(k,1303) * lu(k,1891) + lu(k,1905) = lu(k,1905) - lu(k,1304) * lu(k,1891) + lu(k,1906) = lu(k,1906) - lu(k,1305) * lu(k,1891) + lu(k,1908) = lu(k,1908) - lu(k,1306) * lu(k,1891) + lu(k,1909) = lu(k,1909) - lu(k,1307) * lu(k,1891) + lu(k,1911) = lu(k,1911) - lu(k,1308) * lu(k,1891) + lu(k,1912) = lu(k,1912) - lu(k,1309) * lu(k,1891) + lu(k,1915) = lu(k,1915) - lu(k,1310) * lu(k,1891) + lu(k,1916) = lu(k,1916) - lu(k,1311) * lu(k,1891) + lu(k,1917) = lu(k,1917) - lu(k,1312) * lu(k,1891) + lu(k,2058) = lu(k,2058) - lu(k,1298) * lu(k,2056) + lu(k,2059) = lu(k,2059) - lu(k,1299) * lu(k,2056) + lu(k,2060) = lu(k,2060) - lu(k,1300) * lu(k,2056) + lu(k,2061) = lu(k,2061) - lu(k,1301) * lu(k,2056) + lu(k,2062) = lu(k,2062) - lu(k,1302) * lu(k,2056) + lu(k,2068) = lu(k,2068) - lu(k,1303) * lu(k,2056) + lu(k,2069) = lu(k,2069) - lu(k,1304) * lu(k,2056) + lu(k,2070) = lu(k,2070) - lu(k,1305) * lu(k,2056) + lu(k,2072) = lu(k,2072) - lu(k,1306) * lu(k,2056) + lu(k,2073) = lu(k,2073) - lu(k,1307) * lu(k,2056) + lu(k,2075) = lu(k,2075) - lu(k,1308) * lu(k,2056) + lu(k,2076) = lu(k,2076) - lu(k,1309) * lu(k,2056) + lu(k,2079) = lu(k,2079) - lu(k,1310) * lu(k,2056) + lu(k,2080) = lu(k,2080) - lu(k,1311) * lu(k,2056) + lu(k,2081) = lu(k,2081) - lu(k,1312) * lu(k,2056) + lu(k,2185) = lu(k,2185) - lu(k,1298) * lu(k,2183) + lu(k,2186) = lu(k,2186) - lu(k,1299) * lu(k,2183) + lu(k,2187) = lu(k,2187) - lu(k,1300) * lu(k,2183) + lu(k,2188) = lu(k,2188) - lu(k,1301) * lu(k,2183) + lu(k,2189) = lu(k,2189) - lu(k,1302) * lu(k,2183) + lu(k,2197) = lu(k,2197) - lu(k,1303) * lu(k,2183) + lu(k,2198) = lu(k,2198) - lu(k,1304) * lu(k,2183) + lu(k,2199) = lu(k,2199) - lu(k,1305) * lu(k,2183) + lu(k,2201) = lu(k,2201) - lu(k,1306) * lu(k,2183) + lu(k,2202) = lu(k,2202) - lu(k,1307) * lu(k,2183) + lu(k,2204) = lu(k,2204) - lu(k,1308) * lu(k,2183) + lu(k,2205) = lu(k,2205) - lu(k,1309) * lu(k,2183) + lu(k,2208) = lu(k,2208) - lu(k,1310) * lu(k,2183) + lu(k,2209) = lu(k,2209) - lu(k,1311) * lu(k,2183) + lu(k,2210) = lu(k,2210) - lu(k,1312) * lu(k,2183) + lu(k,2240) = lu(k,2240) - lu(k,1298) * lu(k,2238) + lu(k,2241) = lu(k,2241) - lu(k,1299) * lu(k,2238) + lu(k,2242) = lu(k,2242) - lu(k,1300) * lu(k,2238) + lu(k,2243) = lu(k,2243) - lu(k,1301) * lu(k,2238) + lu(k,2244) = lu(k,2244) - lu(k,1302) * lu(k,2238) + lu(k,2249) = lu(k,2249) - lu(k,1303) * lu(k,2238) + lu(k,2250) = lu(k,2250) - lu(k,1304) * lu(k,2238) + lu(k,2251) = lu(k,2251) - lu(k,1305) * lu(k,2238) + lu(k,2253) = lu(k,2253) - lu(k,1306) * lu(k,2238) + lu(k,2254) = lu(k,2254) - lu(k,1307) * lu(k,2238) + lu(k,2256) = lu(k,2256) - lu(k,1308) * lu(k,2238) + lu(k,2257) = lu(k,2257) - lu(k,1309) * lu(k,2238) + lu(k,2260) = lu(k,2260) - lu(k,1310) * lu(k,2238) + lu(k,2261) = lu(k,2261) - lu(k,1311) * lu(k,2238) + lu(k,2262) = lu(k,2262) - lu(k,1312) * lu(k,2238) + lu(k,2396) = lu(k,2396) - lu(k,1298) * lu(k,2394) + lu(k,2397) = lu(k,2397) - lu(k,1299) * lu(k,2394) + lu(k,2398) = lu(k,2398) - lu(k,1300) * lu(k,2394) + lu(k,2399) = lu(k,2399) - lu(k,1301) * lu(k,2394) + lu(k,2400) = lu(k,2400) - lu(k,1302) * lu(k,2394) + lu(k,2407) = lu(k,2407) - lu(k,1303) * lu(k,2394) + lu(k,2408) = lu(k,2408) - lu(k,1304) * lu(k,2394) + lu(k,2409) = lu(k,2409) - lu(k,1305) * lu(k,2394) + lu(k,2411) = lu(k,2411) - lu(k,1306) * lu(k,2394) + lu(k,2412) = lu(k,2412) - lu(k,1307) * lu(k,2394) + lu(k,2414) = lu(k,2414) - lu(k,1308) * lu(k,2394) + lu(k,2415) = lu(k,2415) - lu(k,1309) * lu(k,2394) + lu(k,2418) = lu(k,2418) - lu(k,1310) * lu(k,2394) + lu(k,2419) = lu(k,2419) - lu(k,1311) * lu(k,2394) + lu(k,2420) = lu(k,2420) - lu(k,1312) * lu(k,2394) + lu(k,1330) = 1._r8 / lu(k,1330) + lu(k,1331) = lu(k,1331) * lu(k,1330) + lu(k,1332) = lu(k,1332) * lu(k,1330) + lu(k,1333) = lu(k,1333) * lu(k,1330) + lu(k,1334) = lu(k,1334) * lu(k,1330) + lu(k,1335) = lu(k,1335) * lu(k,1330) + lu(k,1336) = lu(k,1336) * lu(k,1330) + lu(k,1337) = lu(k,1337) * lu(k,1330) + lu(k,1338) = lu(k,1338) * lu(k,1330) + lu(k,1339) = lu(k,1339) * lu(k,1330) + lu(k,1340) = lu(k,1340) * lu(k,1330) + lu(k,1341) = lu(k,1341) * lu(k,1330) + lu(k,1342) = lu(k,1342) * lu(k,1330) + lu(k,1343) = lu(k,1343) * lu(k,1330) + lu(k,1344) = lu(k,1344) * lu(k,1330) + lu(k,1345) = lu(k,1345) * lu(k,1330) + lu(k,1423) = lu(k,1423) - lu(k,1331) * lu(k,1422) + lu(k,1424) = lu(k,1424) - lu(k,1332) * lu(k,1422) + lu(k,1425) = lu(k,1425) - lu(k,1333) * lu(k,1422) + lu(k,1426) = lu(k,1426) - lu(k,1334) * lu(k,1422) + lu(k,1427) = lu(k,1427) - lu(k,1335) * lu(k,1422) + lu(k,1429) = lu(k,1429) - lu(k,1336) * lu(k,1422) + lu(k,1430) = lu(k,1430) - lu(k,1337) * lu(k,1422) + lu(k,1431) = lu(k,1431) - lu(k,1338) * lu(k,1422) + lu(k,1432) = lu(k,1432) - lu(k,1339) * lu(k,1422) + lu(k,1433) = lu(k,1433) - lu(k,1340) * lu(k,1422) + lu(k,1434) = lu(k,1434) - lu(k,1341) * lu(k,1422) + lu(k,1435) = lu(k,1435) - lu(k,1342) * lu(k,1422) + lu(k,1437) = lu(k,1437) - lu(k,1343) * lu(k,1422) + lu(k,1438) = lu(k,1438) - lu(k,1344) * lu(k,1422) + lu(k,1439) = lu(k,1439) - lu(k,1345) * lu(k,1422) + lu(k,1786) = lu(k,1786) - lu(k,1331) * lu(k,1785) + lu(k,1787) = lu(k,1787) - lu(k,1332) * lu(k,1785) + lu(k,1788) = lu(k,1788) - lu(k,1333) * lu(k,1785) + lu(k,1789) = lu(k,1789) - lu(k,1334) * lu(k,1785) + lu(k,1790) = lu(k,1790) - lu(k,1335) * lu(k,1785) + lu(k,1799) = lu(k,1799) - lu(k,1336) * lu(k,1785) + lu(k,1800) = lu(k,1800) - lu(k,1337) * lu(k,1785) + lu(k,1801) = lu(k,1801) - lu(k,1338) * lu(k,1785) + lu(k,1803) = lu(k,1803) - lu(k,1339) * lu(k,1785) + lu(k,1804) = lu(k,1804) - lu(k,1340) * lu(k,1785) + lu(k,1806) = lu(k,1806) - lu(k,1341) * lu(k,1785) + lu(k,1807) = lu(k,1807) - lu(k,1342) * lu(k,1785) + lu(k,1810) = lu(k,1810) - lu(k,1343) * lu(k,1785) + lu(k,1811) = lu(k,1811) - lu(k,1344) * lu(k,1785) + lu(k,1812) = lu(k,1812) - lu(k,1345) * lu(k,1785) + lu(k,1893) = lu(k,1893) - lu(k,1331) * lu(k,1892) + lu(k,1894) = lu(k,1894) - lu(k,1332) * lu(k,1892) + lu(k,1895) = lu(k,1895) - lu(k,1333) * lu(k,1892) + lu(k,1896) = lu(k,1896) - lu(k,1334) * lu(k,1892) + lu(k,1897) = lu(k,1897) - lu(k,1335) * lu(k,1892) + lu(k,1904) = lu(k,1904) - lu(k,1336) * lu(k,1892) + lu(k,1905) = lu(k,1905) - lu(k,1337) * lu(k,1892) + lu(k,1906) = lu(k,1906) - lu(k,1338) * lu(k,1892) + lu(k,1908) = lu(k,1908) - lu(k,1339) * lu(k,1892) + lu(k,1909) = lu(k,1909) - lu(k,1340) * lu(k,1892) + lu(k,1911) = lu(k,1911) - lu(k,1341) * lu(k,1892) + lu(k,1912) = lu(k,1912) - lu(k,1342) * lu(k,1892) + lu(k,1915) = lu(k,1915) - lu(k,1343) * lu(k,1892) + lu(k,1916) = lu(k,1916) - lu(k,1344) * lu(k,1892) + lu(k,1917) = lu(k,1917) - lu(k,1345) * lu(k,1892) + lu(k,2058) = lu(k,2058) - lu(k,1331) * lu(k,2057) + lu(k,2059) = lu(k,2059) - lu(k,1332) * lu(k,2057) + lu(k,2060) = lu(k,2060) - lu(k,1333) * lu(k,2057) + lu(k,2061) = lu(k,2061) - lu(k,1334) * lu(k,2057) + lu(k,2062) = lu(k,2062) - lu(k,1335) * lu(k,2057) + lu(k,2068) = lu(k,2068) - lu(k,1336) * lu(k,2057) + lu(k,2069) = lu(k,2069) - lu(k,1337) * lu(k,2057) + lu(k,2070) = lu(k,2070) - lu(k,1338) * lu(k,2057) + lu(k,2072) = lu(k,2072) - lu(k,1339) * lu(k,2057) + lu(k,2073) = lu(k,2073) - lu(k,1340) * lu(k,2057) + lu(k,2075) = lu(k,2075) - lu(k,1341) * lu(k,2057) + lu(k,2076) = lu(k,2076) - lu(k,1342) * lu(k,2057) + lu(k,2079) = lu(k,2079) - lu(k,1343) * lu(k,2057) + lu(k,2080) = lu(k,2080) - lu(k,1344) * lu(k,2057) + lu(k,2081) = lu(k,2081) - lu(k,1345) * lu(k,2057) + lu(k,2185) = lu(k,2185) - lu(k,1331) * lu(k,2184) + lu(k,2186) = lu(k,2186) - lu(k,1332) * lu(k,2184) + lu(k,2187) = lu(k,2187) - lu(k,1333) * lu(k,2184) + lu(k,2188) = lu(k,2188) - lu(k,1334) * lu(k,2184) + lu(k,2189) = lu(k,2189) - lu(k,1335) * lu(k,2184) + lu(k,2197) = lu(k,2197) - lu(k,1336) * lu(k,2184) + lu(k,2198) = lu(k,2198) - lu(k,1337) * lu(k,2184) + lu(k,2199) = lu(k,2199) - lu(k,1338) * lu(k,2184) + lu(k,2201) = lu(k,2201) - lu(k,1339) * lu(k,2184) + lu(k,2202) = lu(k,2202) - lu(k,1340) * lu(k,2184) + lu(k,2204) = lu(k,2204) - lu(k,1341) * lu(k,2184) + lu(k,2205) = lu(k,2205) - lu(k,1342) * lu(k,2184) + lu(k,2208) = lu(k,2208) - lu(k,1343) * lu(k,2184) + lu(k,2209) = lu(k,2209) - lu(k,1344) * lu(k,2184) + lu(k,2210) = lu(k,2210) - lu(k,1345) * lu(k,2184) + lu(k,2240) = lu(k,2240) - lu(k,1331) * lu(k,2239) + lu(k,2241) = lu(k,2241) - lu(k,1332) * lu(k,2239) + lu(k,2242) = lu(k,2242) - lu(k,1333) * lu(k,2239) + lu(k,2243) = lu(k,2243) - lu(k,1334) * lu(k,2239) + lu(k,2244) = lu(k,2244) - lu(k,1335) * lu(k,2239) + lu(k,2249) = lu(k,2249) - lu(k,1336) * lu(k,2239) + lu(k,2250) = lu(k,2250) - lu(k,1337) * lu(k,2239) + lu(k,2251) = lu(k,2251) - lu(k,1338) * lu(k,2239) + lu(k,2253) = lu(k,2253) - lu(k,1339) * lu(k,2239) + lu(k,2254) = lu(k,2254) - lu(k,1340) * lu(k,2239) + lu(k,2256) = lu(k,2256) - lu(k,1341) * lu(k,2239) + lu(k,2257) = lu(k,2257) - lu(k,1342) * lu(k,2239) + lu(k,2260) = lu(k,2260) - lu(k,1343) * lu(k,2239) + lu(k,2261) = lu(k,2261) - lu(k,1344) * lu(k,2239) + lu(k,2262) = lu(k,2262) - lu(k,1345) * lu(k,2239) + lu(k,2396) = lu(k,2396) - lu(k,1331) * lu(k,2395) + lu(k,2397) = lu(k,2397) - lu(k,1332) * lu(k,2395) + lu(k,2398) = lu(k,2398) - lu(k,1333) * lu(k,2395) + lu(k,2399) = lu(k,2399) - lu(k,1334) * lu(k,2395) + lu(k,2400) = lu(k,2400) - lu(k,1335) * lu(k,2395) + lu(k,2407) = lu(k,2407) - lu(k,1336) * lu(k,2395) + lu(k,2408) = lu(k,2408) - lu(k,1337) * lu(k,2395) + lu(k,2409) = lu(k,2409) - lu(k,1338) * lu(k,2395) + lu(k,2411) = lu(k,2411) - lu(k,1339) * lu(k,2395) + lu(k,2412) = lu(k,2412) - lu(k,1340) * lu(k,2395) + lu(k,2414) = lu(k,2414) - lu(k,1341) * lu(k,2395) + lu(k,2415) = lu(k,2415) - lu(k,1342) * lu(k,2395) + lu(k,2418) = lu(k,2418) - lu(k,1343) * lu(k,2395) + lu(k,2419) = lu(k,2419) - lu(k,1344) * lu(k,2395) + lu(k,2420) = lu(k,2420) - lu(k,1345) * lu(k,2395) + lu(k,1354) = 1._r8 / lu(k,1354) + lu(k,1355) = lu(k,1355) * lu(k,1354) + lu(k,1356) = lu(k,1356) * lu(k,1354) + lu(k,1357) = lu(k,1357) * lu(k,1354) + lu(k,1358) = lu(k,1358) * lu(k,1354) + lu(k,1359) = lu(k,1359) * lu(k,1354) + lu(k,1360) = lu(k,1360) * lu(k,1354) + lu(k,1361) = lu(k,1361) * lu(k,1354) + lu(k,1362) = lu(k,1362) * lu(k,1354) + lu(k,1363) = lu(k,1363) * lu(k,1354) + lu(k,1364) = lu(k,1364) * lu(k,1354) + lu(k,1365) = lu(k,1365) * lu(k,1354) + lu(k,1366) = lu(k,1366) * lu(k,1354) + lu(k,1375) = - lu(k,1355) * lu(k,1373) + lu(k,1376) = lu(k,1376) - lu(k,1356) * lu(k,1373) + lu(k,1377) = lu(k,1377) - lu(k,1357) * lu(k,1373) + lu(k,1379) = lu(k,1379) - lu(k,1358) * lu(k,1373) + lu(k,1380) = lu(k,1380) - lu(k,1359) * lu(k,1373) + lu(k,1381) = lu(k,1381) - lu(k,1360) * lu(k,1373) + lu(k,1382) = lu(k,1382) - lu(k,1361) * lu(k,1373) + lu(k,1383) = lu(k,1383) - lu(k,1362) * lu(k,1373) + lu(k,1384) = lu(k,1384) - lu(k,1363) * lu(k,1373) + lu(k,1385) = lu(k,1385) - lu(k,1364) * lu(k,1373) + lu(k,1387) = lu(k,1387) - lu(k,1365) * lu(k,1373) + lu(k,1389) = lu(k,1389) - lu(k,1366) * lu(k,1373) + lu(k,1425) = lu(k,1425) - lu(k,1355) * lu(k,1423) + lu(k,1426) = lu(k,1426) - lu(k,1356) * lu(k,1423) + lu(k,1427) = lu(k,1427) - lu(k,1357) * lu(k,1423) + lu(k,1429) = lu(k,1429) - lu(k,1358) * lu(k,1423) + lu(k,1430) = lu(k,1430) - lu(k,1359) * lu(k,1423) + lu(k,1431) = lu(k,1431) - lu(k,1360) * lu(k,1423) + lu(k,1432) = lu(k,1432) - lu(k,1361) * lu(k,1423) + lu(k,1433) = lu(k,1433) - lu(k,1362) * lu(k,1423) + lu(k,1434) = lu(k,1434) - lu(k,1363) * lu(k,1423) + lu(k,1435) = lu(k,1435) - lu(k,1364) * lu(k,1423) + lu(k,1437) = lu(k,1437) - lu(k,1365) * lu(k,1423) + lu(k,1439) = lu(k,1439) - lu(k,1366) * lu(k,1423) + lu(k,1788) = lu(k,1788) - lu(k,1355) * lu(k,1786) + lu(k,1789) = lu(k,1789) - lu(k,1356) * lu(k,1786) + lu(k,1790) = lu(k,1790) - lu(k,1357) * lu(k,1786) + lu(k,1799) = lu(k,1799) - lu(k,1358) * lu(k,1786) + lu(k,1800) = lu(k,1800) - lu(k,1359) * lu(k,1786) + lu(k,1801) = lu(k,1801) - lu(k,1360) * lu(k,1786) + lu(k,1803) = lu(k,1803) - lu(k,1361) * lu(k,1786) + lu(k,1804) = lu(k,1804) - lu(k,1362) * lu(k,1786) + lu(k,1806) = lu(k,1806) - lu(k,1363) * lu(k,1786) + lu(k,1807) = lu(k,1807) - lu(k,1364) * lu(k,1786) + lu(k,1810) = lu(k,1810) - lu(k,1365) * lu(k,1786) + lu(k,1812) = lu(k,1812) - lu(k,1366) * lu(k,1786) + lu(k,1895) = lu(k,1895) - lu(k,1355) * lu(k,1893) + lu(k,1896) = lu(k,1896) - lu(k,1356) * lu(k,1893) + lu(k,1897) = lu(k,1897) - lu(k,1357) * lu(k,1893) + lu(k,1904) = lu(k,1904) - lu(k,1358) * lu(k,1893) + lu(k,1905) = lu(k,1905) - lu(k,1359) * lu(k,1893) + lu(k,1906) = lu(k,1906) - lu(k,1360) * lu(k,1893) + lu(k,1908) = lu(k,1908) - lu(k,1361) * lu(k,1893) + lu(k,1909) = lu(k,1909) - lu(k,1362) * lu(k,1893) + lu(k,1911) = lu(k,1911) - lu(k,1363) * lu(k,1893) + lu(k,1912) = lu(k,1912) - lu(k,1364) * lu(k,1893) + lu(k,1915) = lu(k,1915) - lu(k,1365) * lu(k,1893) + lu(k,1917) = lu(k,1917) - lu(k,1366) * lu(k,1893) + lu(k,2060) = lu(k,2060) - lu(k,1355) * lu(k,2058) + lu(k,2061) = lu(k,2061) - lu(k,1356) * lu(k,2058) + lu(k,2062) = lu(k,2062) - lu(k,1357) * lu(k,2058) + lu(k,2068) = lu(k,2068) - lu(k,1358) * lu(k,2058) + lu(k,2069) = lu(k,2069) - lu(k,1359) * lu(k,2058) + lu(k,2070) = lu(k,2070) - lu(k,1360) * lu(k,2058) + lu(k,2072) = lu(k,2072) - lu(k,1361) * lu(k,2058) + lu(k,2073) = lu(k,2073) - lu(k,1362) * lu(k,2058) + lu(k,2075) = lu(k,2075) - lu(k,1363) * lu(k,2058) + lu(k,2076) = lu(k,2076) - lu(k,1364) * lu(k,2058) + lu(k,2079) = lu(k,2079) - lu(k,1365) * lu(k,2058) + lu(k,2081) = lu(k,2081) - lu(k,1366) * lu(k,2058) + lu(k,2187) = lu(k,2187) - lu(k,1355) * lu(k,2185) + lu(k,2188) = lu(k,2188) - lu(k,1356) * lu(k,2185) + lu(k,2189) = lu(k,2189) - lu(k,1357) * lu(k,2185) + lu(k,2197) = lu(k,2197) - lu(k,1358) * lu(k,2185) + lu(k,2198) = lu(k,2198) - lu(k,1359) * lu(k,2185) + lu(k,2199) = lu(k,2199) - lu(k,1360) * lu(k,2185) + lu(k,2201) = lu(k,2201) - lu(k,1361) * lu(k,2185) + lu(k,2202) = lu(k,2202) - lu(k,1362) * lu(k,2185) + lu(k,2204) = lu(k,2204) - lu(k,1363) * lu(k,2185) + lu(k,2205) = lu(k,2205) - lu(k,1364) * lu(k,2185) + lu(k,2208) = lu(k,2208) - lu(k,1365) * lu(k,2185) + lu(k,2210) = lu(k,2210) - lu(k,1366) * lu(k,2185) + lu(k,2242) = lu(k,2242) - lu(k,1355) * lu(k,2240) + lu(k,2243) = lu(k,2243) - lu(k,1356) * lu(k,2240) + lu(k,2244) = lu(k,2244) - lu(k,1357) * lu(k,2240) + lu(k,2249) = lu(k,2249) - lu(k,1358) * lu(k,2240) + lu(k,2250) = lu(k,2250) - lu(k,1359) * lu(k,2240) + lu(k,2251) = lu(k,2251) - lu(k,1360) * lu(k,2240) + lu(k,2253) = lu(k,2253) - lu(k,1361) * lu(k,2240) + lu(k,2254) = lu(k,2254) - lu(k,1362) * lu(k,2240) + lu(k,2256) = lu(k,2256) - lu(k,1363) * lu(k,2240) + lu(k,2257) = lu(k,2257) - lu(k,1364) * lu(k,2240) + lu(k,2260) = lu(k,2260) - lu(k,1365) * lu(k,2240) + lu(k,2262) = lu(k,2262) - lu(k,1366) * lu(k,2240) + lu(k,2398) = lu(k,2398) - lu(k,1355) * lu(k,2396) + lu(k,2399) = lu(k,2399) - lu(k,1356) * lu(k,2396) + lu(k,2400) = lu(k,2400) - lu(k,1357) * lu(k,2396) + lu(k,2407) = lu(k,2407) - lu(k,1358) * lu(k,2396) + lu(k,2408) = lu(k,2408) - lu(k,1359) * lu(k,2396) + lu(k,2409) = lu(k,2409) - lu(k,1360) * lu(k,2396) + lu(k,2411) = lu(k,2411) - lu(k,1361) * lu(k,2396) + lu(k,2412) = lu(k,2412) - lu(k,1362) * lu(k,2396) + lu(k,2414) = lu(k,2414) - lu(k,1363) * lu(k,2396) + lu(k,2415) = lu(k,2415) - lu(k,1364) * lu(k,2396) + lu(k,2418) = lu(k,2418) - lu(k,1365) * lu(k,2396) + lu(k,2420) = lu(k,2420) - lu(k,1366) * lu(k,2396) + lu(k,1374) = 1._r8 / lu(k,1374) + lu(k,1375) = lu(k,1375) * lu(k,1374) + lu(k,1376) = lu(k,1376) * lu(k,1374) + lu(k,1377) = lu(k,1377) * lu(k,1374) + lu(k,1378) = lu(k,1378) * lu(k,1374) + lu(k,1379) = lu(k,1379) * lu(k,1374) + lu(k,1380) = lu(k,1380) * lu(k,1374) + lu(k,1381) = lu(k,1381) * lu(k,1374) + lu(k,1382) = lu(k,1382) * lu(k,1374) + lu(k,1383) = lu(k,1383) * lu(k,1374) + lu(k,1384) = lu(k,1384) * lu(k,1374) + lu(k,1385) = lu(k,1385) * lu(k,1374) + lu(k,1386) = lu(k,1386) * lu(k,1374) + lu(k,1387) = lu(k,1387) * lu(k,1374) + lu(k,1388) = lu(k,1388) * lu(k,1374) + lu(k,1389) = lu(k,1389) * lu(k,1374) + lu(k,1425) = lu(k,1425) - lu(k,1375) * lu(k,1424) + lu(k,1426) = lu(k,1426) - lu(k,1376) * lu(k,1424) + lu(k,1427) = lu(k,1427) - lu(k,1377) * lu(k,1424) + lu(k,1428) = - lu(k,1378) * lu(k,1424) + lu(k,1429) = lu(k,1429) - lu(k,1379) * lu(k,1424) + lu(k,1430) = lu(k,1430) - lu(k,1380) * lu(k,1424) + lu(k,1431) = lu(k,1431) - lu(k,1381) * lu(k,1424) + lu(k,1432) = lu(k,1432) - lu(k,1382) * lu(k,1424) + lu(k,1433) = lu(k,1433) - lu(k,1383) * lu(k,1424) + lu(k,1434) = lu(k,1434) - lu(k,1384) * lu(k,1424) + lu(k,1435) = lu(k,1435) - lu(k,1385) * lu(k,1424) + lu(k,1436) = - lu(k,1386) * lu(k,1424) + lu(k,1437) = lu(k,1437) - lu(k,1387) * lu(k,1424) + lu(k,1438) = lu(k,1438) - lu(k,1388) * lu(k,1424) + lu(k,1439) = lu(k,1439) - lu(k,1389) * lu(k,1424) + lu(k,1788) = lu(k,1788) - lu(k,1375) * lu(k,1787) + lu(k,1789) = lu(k,1789) - lu(k,1376) * lu(k,1787) + lu(k,1790) = lu(k,1790) - lu(k,1377) * lu(k,1787) + lu(k,1795) = lu(k,1795) - lu(k,1378) * lu(k,1787) + lu(k,1799) = lu(k,1799) - lu(k,1379) * lu(k,1787) + lu(k,1800) = lu(k,1800) - lu(k,1380) * lu(k,1787) + lu(k,1801) = lu(k,1801) - lu(k,1381) * lu(k,1787) + lu(k,1803) = lu(k,1803) - lu(k,1382) * lu(k,1787) + lu(k,1804) = lu(k,1804) - lu(k,1383) * lu(k,1787) + lu(k,1806) = lu(k,1806) - lu(k,1384) * lu(k,1787) + lu(k,1807) = lu(k,1807) - lu(k,1385) * lu(k,1787) + lu(k,1808) = lu(k,1808) - lu(k,1386) * lu(k,1787) + lu(k,1810) = lu(k,1810) - lu(k,1387) * lu(k,1787) + lu(k,1811) = lu(k,1811) - lu(k,1388) * lu(k,1787) + lu(k,1812) = lu(k,1812) - lu(k,1389) * lu(k,1787) + lu(k,1895) = lu(k,1895) - lu(k,1375) * lu(k,1894) + lu(k,1896) = lu(k,1896) - lu(k,1376) * lu(k,1894) + lu(k,1897) = lu(k,1897) - lu(k,1377) * lu(k,1894) + lu(k,1900) = lu(k,1900) - lu(k,1378) * lu(k,1894) + lu(k,1904) = lu(k,1904) - lu(k,1379) * lu(k,1894) + lu(k,1905) = lu(k,1905) - lu(k,1380) * lu(k,1894) + lu(k,1906) = lu(k,1906) - lu(k,1381) * lu(k,1894) + lu(k,1908) = lu(k,1908) - lu(k,1382) * lu(k,1894) + lu(k,1909) = lu(k,1909) - lu(k,1383) * lu(k,1894) + lu(k,1911) = lu(k,1911) - lu(k,1384) * lu(k,1894) + lu(k,1912) = lu(k,1912) - lu(k,1385) * lu(k,1894) + lu(k,1913) = lu(k,1913) - lu(k,1386) * lu(k,1894) + lu(k,1915) = lu(k,1915) - lu(k,1387) * lu(k,1894) + lu(k,1916) = lu(k,1916) - lu(k,1388) * lu(k,1894) + lu(k,1917) = lu(k,1917) - lu(k,1389) * lu(k,1894) + lu(k,2060) = lu(k,2060) - lu(k,1375) * lu(k,2059) + lu(k,2061) = lu(k,2061) - lu(k,1376) * lu(k,2059) + lu(k,2062) = lu(k,2062) - lu(k,1377) * lu(k,2059) + lu(k,2064) = lu(k,2064) - lu(k,1378) * lu(k,2059) + lu(k,2068) = lu(k,2068) - lu(k,1379) * lu(k,2059) + lu(k,2069) = lu(k,2069) - lu(k,1380) * lu(k,2059) + lu(k,2070) = lu(k,2070) - lu(k,1381) * lu(k,2059) + lu(k,2072) = lu(k,2072) - lu(k,1382) * lu(k,2059) + lu(k,2073) = lu(k,2073) - lu(k,1383) * lu(k,2059) + lu(k,2075) = lu(k,2075) - lu(k,1384) * lu(k,2059) + lu(k,2076) = lu(k,2076) - lu(k,1385) * lu(k,2059) + lu(k,2077) = - lu(k,1386) * lu(k,2059) + lu(k,2079) = lu(k,2079) - lu(k,1387) * lu(k,2059) + lu(k,2080) = lu(k,2080) - lu(k,1388) * lu(k,2059) + lu(k,2081) = lu(k,2081) - lu(k,1389) * lu(k,2059) + lu(k,2187) = lu(k,2187) - lu(k,1375) * lu(k,2186) + lu(k,2188) = lu(k,2188) - lu(k,1376) * lu(k,2186) + lu(k,2189) = lu(k,2189) - lu(k,1377) * lu(k,2186) + lu(k,2193) = lu(k,2193) - lu(k,1378) * lu(k,2186) + lu(k,2197) = lu(k,2197) - lu(k,1379) * lu(k,2186) + lu(k,2198) = lu(k,2198) - lu(k,1380) * lu(k,2186) + lu(k,2199) = lu(k,2199) - lu(k,1381) * lu(k,2186) + lu(k,2201) = lu(k,2201) - lu(k,1382) * lu(k,2186) + lu(k,2202) = lu(k,2202) - lu(k,1383) * lu(k,2186) + lu(k,2204) = lu(k,2204) - lu(k,1384) * lu(k,2186) + lu(k,2205) = lu(k,2205) - lu(k,1385) * lu(k,2186) + lu(k,2206) = - lu(k,1386) * lu(k,2186) + lu(k,2208) = lu(k,2208) - lu(k,1387) * lu(k,2186) + lu(k,2209) = lu(k,2209) - lu(k,1388) * lu(k,2186) + lu(k,2210) = lu(k,2210) - lu(k,1389) * lu(k,2186) + lu(k,2242) = lu(k,2242) - lu(k,1375) * lu(k,2241) + lu(k,2243) = lu(k,2243) - lu(k,1376) * lu(k,2241) + lu(k,2244) = lu(k,2244) - lu(k,1377) * lu(k,2241) + lu(k,2245) = lu(k,2245) - lu(k,1378) * lu(k,2241) + lu(k,2249) = lu(k,2249) - lu(k,1379) * lu(k,2241) + lu(k,2250) = lu(k,2250) - lu(k,1380) * lu(k,2241) + lu(k,2251) = lu(k,2251) - lu(k,1381) * lu(k,2241) + lu(k,2253) = lu(k,2253) - lu(k,1382) * lu(k,2241) + lu(k,2254) = lu(k,2254) - lu(k,1383) * lu(k,2241) + lu(k,2256) = lu(k,2256) - lu(k,1384) * lu(k,2241) + lu(k,2257) = lu(k,2257) - lu(k,1385) * lu(k,2241) + lu(k,2258) = - lu(k,1386) * lu(k,2241) + lu(k,2260) = lu(k,2260) - lu(k,1387) * lu(k,2241) + lu(k,2261) = lu(k,2261) - lu(k,1388) * lu(k,2241) + lu(k,2262) = lu(k,2262) - lu(k,1389) * lu(k,2241) + lu(k,2398) = lu(k,2398) - lu(k,1375) * lu(k,2397) + lu(k,2399) = lu(k,2399) - lu(k,1376) * lu(k,2397) + lu(k,2400) = lu(k,2400) - lu(k,1377) * lu(k,2397) + lu(k,2403) = lu(k,2403) - lu(k,1378) * lu(k,2397) + lu(k,2407) = lu(k,2407) - lu(k,1379) * lu(k,2397) + lu(k,2408) = lu(k,2408) - lu(k,1380) * lu(k,2397) + lu(k,2409) = lu(k,2409) - lu(k,1381) * lu(k,2397) + lu(k,2411) = lu(k,2411) - lu(k,1382) * lu(k,2397) + lu(k,2412) = lu(k,2412) - lu(k,1383) * lu(k,2397) + lu(k,2414) = lu(k,2414) - lu(k,1384) * lu(k,2397) + lu(k,2415) = lu(k,2415) - lu(k,1385) * lu(k,2397) + lu(k,2416) = lu(k,2416) - lu(k,1386) * lu(k,2397) + lu(k,2418) = lu(k,2418) - lu(k,1387) * lu(k,2397) + lu(k,2419) = lu(k,2419) - lu(k,1388) * lu(k,2397) + lu(k,2420) = lu(k,2420) - lu(k,1389) * lu(k,2397) end do - end subroutine lu_fac26 - subroutine lu_fac27( avec_len, lu ) + end subroutine lu_fac27 + subroutine lu_fac28( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 implicit none @@ -6188,585 +5964,471 @@ subroutine lu_fac27( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1352) = 1._r8 / lu(k,1352) - lu(k,1353) = lu(k,1353) * lu(k,1352) - lu(k,1354) = lu(k,1354) * lu(k,1352) - lu(k,1355) = lu(k,1355) * lu(k,1352) - lu(k,1356) = lu(k,1356) * lu(k,1352) - lu(k,1357) = lu(k,1357) * lu(k,1352) - lu(k,1358) = lu(k,1358) * lu(k,1352) - lu(k,1359) = lu(k,1359) * lu(k,1352) - lu(k,1360) = lu(k,1360) * lu(k,1352) - lu(k,1361) = lu(k,1361) * lu(k,1352) - lu(k,1362) = lu(k,1362) * lu(k,1352) - lu(k,1427) = lu(k,1427) - lu(k,1353) * lu(k,1426) - lu(k,1430) = lu(k,1430) - lu(k,1354) * lu(k,1426) - lu(k,1431) = lu(k,1431) - lu(k,1355) * lu(k,1426) - lu(k,1432) = lu(k,1432) - lu(k,1356) * lu(k,1426) - lu(k,1433) = lu(k,1433) - lu(k,1357) * lu(k,1426) - lu(k,1434) = lu(k,1434) - lu(k,1358) * lu(k,1426) - lu(k,1435) = lu(k,1435) - lu(k,1359) * lu(k,1426) - lu(k,1437) = lu(k,1437) - lu(k,1360) * lu(k,1426) - lu(k,1438) = lu(k,1438) - lu(k,1361) * lu(k,1426) - lu(k,1440) = lu(k,1440) - lu(k,1362) * lu(k,1426) - lu(k,1506) = lu(k,1506) - lu(k,1353) * lu(k,1504) - lu(k,1509) = lu(k,1509) - lu(k,1354) * lu(k,1504) - lu(k,1510) = lu(k,1510) - lu(k,1355) * lu(k,1504) - lu(k,1511) = lu(k,1511) - lu(k,1356) * lu(k,1504) - lu(k,1512) = lu(k,1512) - lu(k,1357) * lu(k,1504) - lu(k,1513) = lu(k,1513) - lu(k,1358) * lu(k,1504) - lu(k,1515) = lu(k,1515) - lu(k,1359) * lu(k,1504) - lu(k,1518) = lu(k,1518) - lu(k,1360) * lu(k,1504) - lu(k,1519) = lu(k,1519) - lu(k,1361) * lu(k,1504) - lu(k,1521) = lu(k,1521) - lu(k,1362) * lu(k,1504) - lu(k,1541) = lu(k,1541) - lu(k,1353) * lu(k,1539) - lu(k,1544) = lu(k,1544) - lu(k,1354) * lu(k,1539) - lu(k,1545) = lu(k,1545) - lu(k,1355) * lu(k,1539) - lu(k,1546) = lu(k,1546) - lu(k,1356) * lu(k,1539) - lu(k,1547) = lu(k,1547) - lu(k,1357) * lu(k,1539) - lu(k,1548) = lu(k,1548) - lu(k,1358) * lu(k,1539) - lu(k,1550) = lu(k,1550) - lu(k,1359) * lu(k,1539) - lu(k,1553) = lu(k,1553) - lu(k,1360) * lu(k,1539) - lu(k,1554) = lu(k,1554) - lu(k,1361) * lu(k,1539) - lu(k,1556) = lu(k,1556) - lu(k,1362) * lu(k,1539) - lu(k,1567) = lu(k,1567) - lu(k,1353) * lu(k,1565) - lu(k,1570) = lu(k,1570) - lu(k,1354) * lu(k,1565) - lu(k,1571) = lu(k,1571) - lu(k,1355) * lu(k,1565) - lu(k,1572) = lu(k,1572) - lu(k,1356) * lu(k,1565) - lu(k,1573) = lu(k,1573) - lu(k,1357) * lu(k,1565) - lu(k,1574) = lu(k,1574) - lu(k,1358) * lu(k,1565) - lu(k,1576) = lu(k,1576) - lu(k,1359) * lu(k,1565) - lu(k,1579) = lu(k,1579) - lu(k,1360) * lu(k,1565) - lu(k,1580) = lu(k,1580) - lu(k,1361) * lu(k,1565) - lu(k,1582) = lu(k,1582) - lu(k,1362) * lu(k,1565) - lu(k,1715) = lu(k,1715) - lu(k,1353) * lu(k,1713) - lu(k,1718) = lu(k,1718) - lu(k,1354) * lu(k,1713) - lu(k,1719) = lu(k,1719) - lu(k,1355) * lu(k,1713) - lu(k,1720) = lu(k,1720) - lu(k,1356) * lu(k,1713) - lu(k,1721) = lu(k,1721) - lu(k,1357) * lu(k,1713) - lu(k,1722) = lu(k,1722) - lu(k,1358) * lu(k,1713) - lu(k,1724) = lu(k,1724) - lu(k,1359) * lu(k,1713) - lu(k,1727) = lu(k,1727) - lu(k,1360) * lu(k,1713) - lu(k,1728) = lu(k,1728) - lu(k,1361) * lu(k,1713) - lu(k,1730) = lu(k,1730) - lu(k,1362) * lu(k,1713) - lu(k,1777) = lu(k,1777) - lu(k,1353) * lu(k,1775) - lu(k,1780) = lu(k,1780) - lu(k,1354) * lu(k,1775) - lu(k,1781) = lu(k,1781) - lu(k,1355) * lu(k,1775) - lu(k,1782) = lu(k,1782) - lu(k,1356) * lu(k,1775) - lu(k,1783) = lu(k,1783) - lu(k,1357) * lu(k,1775) - lu(k,1784) = lu(k,1784) - lu(k,1358) * lu(k,1775) - lu(k,1786) = lu(k,1786) - lu(k,1359) * lu(k,1775) - lu(k,1789) = lu(k,1789) - lu(k,1360) * lu(k,1775) - lu(k,1790) = lu(k,1790) - lu(k,1361) * lu(k,1775) - lu(k,1792) = lu(k,1792) - lu(k,1362) * lu(k,1775) - lu(k,1818) = lu(k,1818) - lu(k,1353) * lu(k,1816) - lu(k,1821) = lu(k,1821) - lu(k,1354) * lu(k,1816) - lu(k,1822) = lu(k,1822) - lu(k,1355) * lu(k,1816) - lu(k,1823) = lu(k,1823) - lu(k,1356) * lu(k,1816) - lu(k,1824) = lu(k,1824) - lu(k,1357) * lu(k,1816) - lu(k,1825) = lu(k,1825) - lu(k,1358) * lu(k,1816) - lu(k,1827) = lu(k,1827) - lu(k,1359) * lu(k,1816) - lu(k,1830) = lu(k,1830) - lu(k,1360) * lu(k,1816) - lu(k,1831) = lu(k,1831) - lu(k,1361) * lu(k,1816) - lu(k,1833) = lu(k,1833) - lu(k,1362) * lu(k,1816) - lu(k,1842) = - lu(k,1353) * lu(k,1840) - lu(k,1845) = lu(k,1845) - lu(k,1354) * lu(k,1840) - lu(k,1846) = lu(k,1846) - lu(k,1355) * lu(k,1840) - lu(k,1847) = - lu(k,1356) * lu(k,1840) - lu(k,1848) = lu(k,1848) - lu(k,1357) * lu(k,1840) - lu(k,1849) = lu(k,1849) - lu(k,1358) * lu(k,1840) - lu(k,1851) = lu(k,1851) - lu(k,1359) * lu(k,1840) - lu(k,1854) = lu(k,1854) - lu(k,1360) * lu(k,1840) - lu(k,1855) = lu(k,1855) - lu(k,1361) * lu(k,1840) - lu(k,1857) = lu(k,1857) - lu(k,1362) * lu(k,1840) - lu(k,1899) = lu(k,1899) - lu(k,1353) * lu(k,1897) - lu(k,1902) = - lu(k,1354) * lu(k,1897) - lu(k,1903) = lu(k,1903) - lu(k,1355) * lu(k,1897) - lu(k,1904) = lu(k,1904) - lu(k,1356) * lu(k,1897) - lu(k,1905) = lu(k,1905) - lu(k,1357) * lu(k,1897) - lu(k,1906) = lu(k,1906) - lu(k,1358) * lu(k,1897) - lu(k,1908) = lu(k,1908) - lu(k,1359) * lu(k,1897) - lu(k,1911) = lu(k,1911) - lu(k,1360) * lu(k,1897) - lu(k,1912) = lu(k,1912) - lu(k,1361) * lu(k,1897) - lu(k,1914) = lu(k,1914) - lu(k,1362) * lu(k,1897) - lu(k,1919) = lu(k,1919) - lu(k,1353) * lu(k,1917) - lu(k,1922) = lu(k,1922) - lu(k,1354) * lu(k,1917) - lu(k,1923) = lu(k,1923) - lu(k,1355) * lu(k,1917) - lu(k,1924) = lu(k,1924) - lu(k,1356) * lu(k,1917) - lu(k,1925) = lu(k,1925) - lu(k,1357) * lu(k,1917) - lu(k,1926) = - lu(k,1358) * lu(k,1917) - lu(k,1928) = lu(k,1928) - lu(k,1359) * lu(k,1917) - lu(k,1931) = lu(k,1931) - lu(k,1360) * lu(k,1917) - lu(k,1932) = lu(k,1932) - lu(k,1361) * lu(k,1917) - lu(k,1934) = lu(k,1934) - lu(k,1362) * lu(k,1917) - lu(k,1941) = - lu(k,1353) * lu(k,1939) - lu(k,1944) = lu(k,1944) - lu(k,1354) * lu(k,1939) - lu(k,1945) = lu(k,1945) - lu(k,1355) * lu(k,1939) - lu(k,1946) = - lu(k,1356) * lu(k,1939) - lu(k,1947) = lu(k,1947) - lu(k,1357) * lu(k,1939) - lu(k,1948) = - lu(k,1358) * lu(k,1939) - lu(k,1950) = lu(k,1950) - lu(k,1359) * lu(k,1939) - lu(k,1953) = lu(k,1953) - lu(k,1360) * lu(k,1939) - lu(k,1954) = - lu(k,1361) * lu(k,1939) - lu(k,1956) = lu(k,1956) - lu(k,1362) * lu(k,1939) - lu(k,1983) = lu(k,1983) - lu(k,1353) * lu(k,1981) - lu(k,1986) = lu(k,1986) - lu(k,1354) * lu(k,1981) - lu(k,1987) = lu(k,1987) - lu(k,1355) * lu(k,1981) - lu(k,1988) = lu(k,1988) - lu(k,1356) * lu(k,1981) - lu(k,1989) = lu(k,1989) - lu(k,1357) * lu(k,1981) - lu(k,1990) = lu(k,1990) - lu(k,1358) * lu(k,1981) - lu(k,1992) = lu(k,1992) - lu(k,1359) * lu(k,1981) - lu(k,1995) = lu(k,1995) - lu(k,1360) * lu(k,1981) - lu(k,1996) = lu(k,1996) - lu(k,1361) * lu(k,1981) - lu(k,1998) = lu(k,1998) - lu(k,1362) * lu(k,1981) - lu(k,2007) = lu(k,2007) - lu(k,1353) * lu(k,2006) - lu(k,2010) = lu(k,2010) - lu(k,1354) * lu(k,2006) - lu(k,2011) = lu(k,2011) - lu(k,1355) * lu(k,2006) - lu(k,2012) = lu(k,2012) - lu(k,1356) * lu(k,2006) - lu(k,2013) = lu(k,2013) - lu(k,1357) * lu(k,2006) - lu(k,2014) = - lu(k,1358) * lu(k,2006) - lu(k,2016) = lu(k,2016) - lu(k,1359) * lu(k,2006) - lu(k,2019) = lu(k,2019) - lu(k,1360) * lu(k,2006) - lu(k,2020) = lu(k,2020) - lu(k,1361) * lu(k,2006) - lu(k,2022) = lu(k,2022) - lu(k,1362) * lu(k,2006) - lu(k,2102) = lu(k,2102) - lu(k,1353) * lu(k,2100) - lu(k,2105) = lu(k,2105) - lu(k,1354) * lu(k,2100) - lu(k,2106) = lu(k,2106) - lu(k,1355) * lu(k,2100) - lu(k,2107) = lu(k,2107) - lu(k,1356) * lu(k,2100) - lu(k,2108) = lu(k,2108) - lu(k,1357) * lu(k,2100) - lu(k,2109) = lu(k,2109) - lu(k,1358) * lu(k,2100) - lu(k,2111) = lu(k,2111) - lu(k,1359) * lu(k,2100) - lu(k,2114) = lu(k,2114) - lu(k,1360) * lu(k,2100) - lu(k,2115) = lu(k,2115) - lu(k,1361) * lu(k,2100) - lu(k,2117) = lu(k,2117) - lu(k,1362) * lu(k,2100) - lu(k,2129) = lu(k,2129) - lu(k,1353) * lu(k,2127) - lu(k,2132) = lu(k,2132) - lu(k,1354) * lu(k,2127) - lu(k,2133) = lu(k,2133) - lu(k,1355) * lu(k,2127) - lu(k,2134) = lu(k,2134) - lu(k,1356) * lu(k,2127) - lu(k,2135) = lu(k,2135) - lu(k,1357) * lu(k,2127) - lu(k,2136) = lu(k,2136) - lu(k,1358) * lu(k,2127) - lu(k,2138) = lu(k,2138) - lu(k,1359) * lu(k,2127) - lu(k,2141) = lu(k,2141) - lu(k,1360) * lu(k,2127) - lu(k,2142) = lu(k,2142) - lu(k,1361) * lu(k,2127) - lu(k,2144) = lu(k,2144) - lu(k,1362) * lu(k,2127) - lu(k,2155) = lu(k,2155) - lu(k,1353) * lu(k,2153) - lu(k,2158) = lu(k,2158) - lu(k,1354) * lu(k,2153) - lu(k,2159) = lu(k,2159) - lu(k,1355) * lu(k,2153) - lu(k,2160) = lu(k,2160) - lu(k,1356) * lu(k,2153) - lu(k,2161) = lu(k,2161) - lu(k,1357) * lu(k,2153) - lu(k,2162) = - lu(k,1358) * lu(k,2153) - lu(k,2164) = lu(k,2164) - lu(k,1359) * lu(k,2153) - lu(k,2167) = lu(k,2167) - lu(k,1360) * lu(k,2153) - lu(k,2168) = lu(k,2168) - lu(k,1361) * lu(k,2153) - lu(k,2170) = lu(k,2170) - lu(k,1362) * lu(k,2153) - lu(k,1396) = 1._r8 / lu(k,1396) - lu(k,1397) = lu(k,1397) * lu(k,1396) - lu(k,1398) = lu(k,1398) * lu(k,1396) - lu(k,1399) = lu(k,1399) * lu(k,1396) - lu(k,1400) = lu(k,1400) * lu(k,1396) - lu(k,1401) = lu(k,1401) * lu(k,1396) - lu(k,1402) = lu(k,1402) * lu(k,1396) - lu(k,1403) = lu(k,1403) * lu(k,1396) - lu(k,1404) = lu(k,1404) * lu(k,1396) - lu(k,1405) = lu(k,1405) * lu(k,1396) - lu(k,1406) = lu(k,1406) * lu(k,1396) - lu(k,1407) = lu(k,1407) * lu(k,1396) - lu(k,1408) = lu(k,1408) * lu(k,1396) - lu(k,1409) = lu(k,1409) * lu(k,1396) - lu(k,1506) = lu(k,1506) - lu(k,1397) * lu(k,1505) - lu(k,1507) = lu(k,1507) - lu(k,1398) * lu(k,1505) - lu(k,1508) = lu(k,1508) - lu(k,1399) * lu(k,1505) - lu(k,1510) = lu(k,1510) - lu(k,1400) * lu(k,1505) - lu(k,1511) = lu(k,1511) - lu(k,1401) * lu(k,1505) - lu(k,1513) = lu(k,1513) - lu(k,1402) * lu(k,1505) - lu(k,1514) = lu(k,1514) - lu(k,1403) * lu(k,1505) - lu(k,1515) = lu(k,1515) - lu(k,1404) * lu(k,1505) - lu(k,1516) = lu(k,1516) - lu(k,1405) * lu(k,1505) - lu(k,1517) = lu(k,1517) - lu(k,1406) * lu(k,1505) - lu(k,1519) = lu(k,1519) - lu(k,1407) * lu(k,1505) - lu(k,1520) = lu(k,1520) - lu(k,1408) * lu(k,1505) - lu(k,1521) = lu(k,1521) - lu(k,1409) * lu(k,1505) - lu(k,1541) = lu(k,1541) - lu(k,1397) * lu(k,1540) - lu(k,1542) = lu(k,1542) - lu(k,1398) * lu(k,1540) - lu(k,1543) = lu(k,1543) - lu(k,1399) * lu(k,1540) - lu(k,1545) = lu(k,1545) - lu(k,1400) * lu(k,1540) - lu(k,1546) = lu(k,1546) - lu(k,1401) * lu(k,1540) - lu(k,1548) = lu(k,1548) - lu(k,1402) * lu(k,1540) - lu(k,1549) = lu(k,1549) - lu(k,1403) * lu(k,1540) - lu(k,1550) = lu(k,1550) - lu(k,1404) * lu(k,1540) - lu(k,1551) = lu(k,1551) - lu(k,1405) * lu(k,1540) - lu(k,1552) = lu(k,1552) - lu(k,1406) * lu(k,1540) - lu(k,1554) = lu(k,1554) - lu(k,1407) * lu(k,1540) - lu(k,1555) = lu(k,1555) - lu(k,1408) * lu(k,1540) - lu(k,1556) = lu(k,1556) - lu(k,1409) * lu(k,1540) - lu(k,1567) = lu(k,1567) - lu(k,1397) * lu(k,1566) - lu(k,1568) = lu(k,1568) - lu(k,1398) * lu(k,1566) - lu(k,1569) = lu(k,1569) - lu(k,1399) * lu(k,1566) - lu(k,1571) = lu(k,1571) - lu(k,1400) * lu(k,1566) - lu(k,1572) = lu(k,1572) - lu(k,1401) * lu(k,1566) - lu(k,1574) = lu(k,1574) - lu(k,1402) * lu(k,1566) - lu(k,1575) = lu(k,1575) - lu(k,1403) * lu(k,1566) - lu(k,1576) = lu(k,1576) - lu(k,1404) * lu(k,1566) - lu(k,1577) = lu(k,1577) - lu(k,1405) * lu(k,1566) - lu(k,1578) = lu(k,1578) - lu(k,1406) * lu(k,1566) - lu(k,1580) = lu(k,1580) - lu(k,1407) * lu(k,1566) - lu(k,1581) = lu(k,1581) - lu(k,1408) * lu(k,1566) - lu(k,1582) = lu(k,1582) - lu(k,1409) * lu(k,1566) - lu(k,1715) = lu(k,1715) - lu(k,1397) * lu(k,1714) - lu(k,1716) = lu(k,1716) - lu(k,1398) * lu(k,1714) - lu(k,1717) = lu(k,1717) - lu(k,1399) * lu(k,1714) - lu(k,1719) = lu(k,1719) - lu(k,1400) * lu(k,1714) - lu(k,1720) = lu(k,1720) - lu(k,1401) * lu(k,1714) - lu(k,1722) = lu(k,1722) - lu(k,1402) * lu(k,1714) - lu(k,1723) = lu(k,1723) - lu(k,1403) * lu(k,1714) - lu(k,1724) = lu(k,1724) - lu(k,1404) * lu(k,1714) - lu(k,1725) = lu(k,1725) - lu(k,1405) * lu(k,1714) - lu(k,1726) = lu(k,1726) - lu(k,1406) * lu(k,1714) - lu(k,1728) = lu(k,1728) - lu(k,1407) * lu(k,1714) - lu(k,1729) = lu(k,1729) - lu(k,1408) * lu(k,1714) - lu(k,1730) = lu(k,1730) - lu(k,1409) * lu(k,1714) - lu(k,1777) = lu(k,1777) - lu(k,1397) * lu(k,1776) - lu(k,1778) = lu(k,1778) - lu(k,1398) * lu(k,1776) - lu(k,1779) = lu(k,1779) - lu(k,1399) * lu(k,1776) - lu(k,1781) = lu(k,1781) - lu(k,1400) * lu(k,1776) - lu(k,1782) = lu(k,1782) - lu(k,1401) * lu(k,1776) - lu(k,1784) = lu(k,1784) - lu(k,1402) * lu(k,1776) - lu(k,1785) = lu(k,1785) - lu(k,1403) * lu(k,1776) - lu(k,1786) = lu(k,1786) - lu(k,1404) * lu(k,1776) - lu(k,1787) = lu(k,1787) - lu(k,1405) * lu(k,1776) - lu(k,1788) = lu(k,1788) - lu(k,1406) * lu(k,1776) - lu(k,1790) = lu(k,1790) - lu(k,1407) * lu(k,1776) - lu(k,1791) = lu(k,1791) - lu(k,1408) * lu(k,1776) - lu(k,1792) = lu(k,1792) - lu(k,1409) * lu(k,1776) - lu(k,1818) = lu(k,1818) - lu(k,1397) * lu(k,1817) - lu(k,1819) = lu(k,1819) - lu(k,1398) * lu(k,1817) - lu(k,1820) = lu(k,1820) - lu(k,1399) * lu(k,1817) - lu(k,1822) = lu(k,1822) - lu(k,1400) * lu(k,1817) - lu(k,1823) = lu(k,1823) - lu(k,1401) * lu(k,1817) - lu(k,1825) = lu(k,1825) - lu(k,1402) * lu(k,1817) - lu(k,1826) = lu(k,1826) - lu(k,1403) * lu(k,1817) - lu(k,1827) = lu(k,1827) - lu(k,1404) * lu(k,1817) - lu(k,1828) = lu(k,1828) - lu(k,1405) * lu(k,1817) - lu(k,1829) = lu(k,1829) - lu(k,1406) * lu(k,1817) - lu(k,1831) = lu(k,1831) - lu(k,1407) * lu(k,1817) - lu(k,1832) = lu(k,1832) - lu(k,1408) * lu(k,1817) - lu(k,1833) = lu(k,1833) - lu(k,1409) * lu(k,1817) - lu(k,1842) = lu(k,1842) - lu(k,1397) * lu(k,1841) - lu(k,1843) = lu(k,1843) - lu(k,1398) * lu(k,1841) - lu(k,1844) = lu(k,1844) - lu(k,1399) * lu(k,1841) - lu(k,1846) = lu(k,1846) - lu(k,1400) * lu(k,1841) - lu(k,1847) = lu(k,1847) - lu(k,1401) * lu(k,1841) - lu(k,1849) = lu(k,1849) - lu(k,1402) * lu(k,1841) - lu(k,1850) = lu(k,1850) - lu(k,1403) * lu(k,1841) - lu(k,1851) = lu(k,1851) - lu(k,1404) * lu(k,1841) - lu(k,1852) = lu(k,1852) - lu(k,1405) * lu(k,1841) - lu(k,1853) = lu(k,1853) - lu(k,1406) * lu(k,1841) - lu(k,1855) = lu(k,1855) - lu(k,1407) * lu(k,1841) - lu(k,1856) = lu(k,1856) - lu(k,1408) * lu(k,1841) - lu(k,1857) = lu(k,1857) - lu(k,1409) * lu(k,1841) - lu(k,1899) = lu(k,1899) - lu(k,1397) * lu(k,1898) - lu(k,1900) = lu(k,1900) - lu(k,1398) * lu(k,1898) - lu(k,1901) = lu(k,1901) - lu(k,1399) * lu(k,1898) - lu(k,1903) = lu(k,1903) - lu(k,1400) * lu(k,1898) - lu(k,1904) = lu(k,1904) - lu(k,1401) * lu(k,1898) - lu(k,1906) = lu(k,1906) - lu(k,1402) * lu(k,1898) - lu(k,1907) = lu(k,1907) - lu(k,1403) * lu(k,1898) - lu(k,1908) = lu(k,1908) - lu(k,1404) * lu(k,1898) - lu(k,1909) = lu(k,1909) - lu(k,1405) * lu(k,1898) - lu(k,1910) = lu(k,1910) - lu(k,1406) * lu(k,1898) - lu(k,1912) = lu(k,1912) - lu(k,1407) * lu(k,1898) - lu(k,1913) = lu(k,1913) - lu(k,1408) * lu(k,1898) - lu(k,1914) = lu(k,1914) - lu(k,1409) * lu(k,1898) - lu(k,1919) = lu(k,1919) - lu(k,1397) * lu(k,1918) - lu(k,1920) = - lu(k,1398) * lu(k,1918) - lu(k,1921) = lu(k,1921) - lu(k,1399) * lu(k,1918) - lu(k,1923) = lu(k,1923) - lu(k,1400) * lu(k,1918) - lu(k,1924) = lu(k,1924) - lu(k,1401) * lu(k,1918) - lu(k,1926) = lu(k,1926) - lu(k,1402) * lu(k,1918) - lu(k,1927) = lu(k,1927) - lu(k,1403) * lu(k,1918) - lu(k,1928) = lu(k,1928) - lu(k,1404) * lu(k,1918) - lu(k,1929) = lu(k,1929) - lu(k,1405) * lu(k,1918) - lu(k,1930) = lu(k,1930) - lu(k,1406) * lu(k,1918) - lu(k,1932) = lu(k,1932) - lu(k,1407) * lu(k,1918) - lu(k,1933) = lu(k,1933) - lu(k,1408) * lu(k,1918) - lu(k,1934) = lu(k,1934) - lu(k,1409) * lu(k,1918) - lu(k,1941) = lu(k,1941) - lu(k,1397) * lu(k,1940) - lu(k,1942) = - lu(k,1398) * lu(k,1940) - lu(k,1943) = lu(k,1943) - lu(k,1399) * lu(k,1940) - lu(k,1945) = lu(k,1945) - lu(k,1400) * lu(k,1940) - lu(k,1946) = lu(k,1946) - lu(k,1401) * lu(k,1940) - lu(k,1948) = lu(k,1948) - lu(k,1402) * lu(k,1940) - lu(k,1949) = lu(k,1949) - lu(k,1403) * lu(k,1940) - lu(k,1950) = lu(k,1950) - lu(k,1404) * lu(k,1940) - lu(k,1951) = lu(k,1951) - lu(k,1405) * lu(k,1940) - lu(k,1952) = lu(k,1952) - lu(k,1406) * lu(k,1940) - lu(k,1954) = lu(k,1954) - lu(k,1407) * lu(k,1940) - lu(k,1955) = lu(k,1955) - lu(k,1408) * lu(k,1940) - lu(k,1956) = lu(k,1956) - lu(k,1409) * lu(k,1940) - lu(k,1983) = lu(k,1983) - lu(k,1397) * lu(k,1982) - lu(k,1984) = lu(k,1984) - lu(k,1398) * lu(k,1982) - lu(k,1985) = lu(k,1985) - lu(k,1399) * lu(k,1982) - lu(k,1987) = lu(k,1987) - lu(k,1400) * lu(k,1982) - lu(k,1988) = lu(k,1988) - lu(k,1401) * lu(k,1982) - lu(k,1990) = lu(k,1990) - lu(k,1402) * lu(k,1982) - lu(k,1991) = lu(k,1991) - lu(k,1403) * lu(k,1982) - lu(k,1992) = lu(k,1992) - lu(k,1404) * lu(k,1982) - lu(k,1993) = lu(k,1993) - lu(k,1405) * lu(k,1982) - lu(k,1994) = lu(k,1994) - lu(k,1406) * lu(k,1982) - lu(k,1996) = lu(k,1996) - lu(k,1407) * lu(k,1982) - lu(k,1997) = lu(k,1997) - lu(k,1408) * lu(k,1982) - lu(k,1998) = lu(k,1998) - lu(k,1409) * lu(k,1982) - lu(k,2102) = lu(k,2102) - lu(k,1397) * lu(k,2101) - lu(k,2103) = lu(k,2103) - lu(k,1398) * lu(k,2101) - lu(k,2104) = lu(k,2104) - lu(k,1399) * lu(k,2101) - lu(k,2106) = lu(k,2106) - lu(k,1400) * lu(k,2101) - lu(k,2107) = lu(k,2107) - lu(k,1401) * lu(k,2101) - lu(k,2109) = lu(k,2109) - lu(k,1402) * lu(k,2101) - lu(k,2110) = lu(k,2110) - lu(k,1403) * lu(k,2101) - lu(k,2111) = lu(k,2111) - lu(k,1404) * lu(k,2101) - lu(k,2112) = lu(k,2112) - lu(k,1405) * lu(k,2101) - lu(k,2113) = lu(k,2113) - lu(k,1406) * lu(k,2101) - lu(k,2115) = lu(k,2115) - lu(k,1407) * lu(k,2101) - lu(k,2116) = lu(k,2116) - lu(k,1408) * lu(k,2101) - lu(k,2117) = lu(k,2117) - lu(k,1409) * lu(k,2101) - lu(k,2129) = lu(k,2129) - lu(k,1397) * lu(k,2128) - lu(k,2130) = lu(k,2130) - lu(k,1398) * lu(k,2128) - lu(k,2131) = lu(k,2131) - lu(k,1399) * lu(k,2128) - lu(k,2133) = lu(k,2133) - lu(k,1400) * lu(k,2128) - lu(k,2134) = lu(k,2134) - lu(k,1401) * lu(k,2128) - lu(k,2136) = lu(k,2136) - lu(k,1402) * lu(k,2128) - lu(k,2137) = lu(k,2137) - lu(k,1403) * lu(k,2128) - lu(k,2138) = lu(k,2138) - lu(k,1404) * lu(k,2128) - lu(k,2139) = lu(k,2139) - lu(k,1405) * lu(k,2128) - lu(k,2140) = lu(k,2140) - lu(k,1406) * lu(k,2128) - lu(k,2142) = lu(k,2142) - lu(k,1407) * lu(k,2128) - lu(k,2143) = lu(k,2143) - lu(k,1408) * lu(k,2128) - lu(k,2144) = lu(k,2144) - lu(k,1409) * lu(k,2128) - lu(k,2155) = lu(k,2155) - lu(k,1397) * lu(k,2154) - lu(k,2156) = lu(k,2156) - lu(k,1398) * lu(k,2154) - lu(k,2157) = lu(k,2157) - lu(k,1399) * lu(k,2154) - lu(k,2159) = lu(k,2159) - lu(k,1400) * lu(k,2154) - lu(k,2160) = lu(k,2160) - lu(k,1401) * lu(k,2154) - lu(k,2162) = lu(k,2162) - lu(k,1402) * lu(k,2154) - lu(k,2163) = lu(k,2163) - lu(k,1403) * lu(k,2154) - lu(k,2164) = lu(k,2164) - lu(k,1404) * lu(k,2154) - lu(k,2165) = lu(k,2165) - lu(k,1405) * lu(k,2154) - lu(k,2166) = lu(k,2166) - lu(k,1406) * lu(k,2154) - lu(k,2168) = lu(k,2168) - lu(k,1407) * lu(k,2154) - lu(k,2169) = lu(k,2169) - lu(k,1408) * lu(k,2154) - lu(k,2170) = lu(k,2170) - lu(k,1409) * lu(k,2154) - lu(k,1427) = 1._r8 / lu(k,1427) - lu(k,1428) = lu(k,1428) * lu(k,1427) - lu(k,1429) = lu(k,1429) * lu(k,1427) - lu(k,1430) = lu(k,1430) * lu(k,1427) - lu(k,1431) = lu(k,1431) * lu(k,1427) - lu(k,1432) = lu(k,1432) * lu(k,1427) - lu(k,1433) = lu(k,1433) * lu(k,1427) - lu(k,1434) = lu(k,1434) * lu(k,1427) - lu(k,1435) = lu(k,1435) * lu(k,1427) - lu(k,1436) = lu(k,1436) * lu(k,1427) - lu(k,1437) = lu(k,1437) * lu(k,1427) - lu(k,1438) = lu(k,1438) * lu(k,1427) - lu(k,1439) = lu(k,1439) * lu(k,1427) - lu(k,1440) = lu(k,1440) * lu(k,1427) - lu(k,1507) = lu(k,1507) - lu(k,1428) * lu(k,1506) - lu(k,1508) = lu(k,1508) - lu(k,1429) * lu(k,1506) - lu(k,1509) = lu(k,1509) - lu(k,1430) * lu(k,1506) - lu(k,1510) = lu(k,1510) - lu(k,1431) * lu(k,1506) - lu(k,1511) = lu(k,1511) - lu(k,1432) * lu(k,1506) - lu(k,1512) = lu(k,1512) - lu(k,1433) * lu(k,1506) - lu(k,1513) = lu(k,1513) - lu(k,1434) * lu(k,1506) - lu(k,1515) = lu(k,1515) - lu(k,1435) * lu(k,1506) - lu(k,1517) = lu(k,1517) - lu(k,1436) * lu(k,1506) - lu(k,1518) = lu(k,1518) - lu(k,1437) * lu(k,1506) - lu(k,1519) = lu(k,1519) - lu(k,1438) * lu(k,1506) - lu(k,1520) = lu(k,1520) - lu(k,1439) * lu(k,1506) - lu(k,1521) = lu(k,1521) - lu(k,1440) * lu(k,1506) - lu(k,1542) = lu(k,1542) - lu(k,1428) * lu(k,1541) - lu(k,1543) = lu(k,1543) - lu(k,1429) * lu(k,1541) - lu(k,1544) = lu(k,1544) - lu(k,1430) * lu(k,1541) - lu(k,1545) = lu(k,1545) - lu(k,1431) * lu(k,1541) - lu(k,1546) = lu(k,1546) - lu(k,1432) * lu(k,1541) - lu(k,1547) = lu(k,1547) - lu(k,1433) * lu(k,1541) - lu(k,1548) = lu(k,1548) - lu(k,1434) * lu(k,1541) - lu(k,1550) = lu(k,1550) - lu(k,1435) * lu(k,1541) - lu(k,1552) = lu(k,1552) - lu(k,1436) * lu(k,1541) - lu(k,1553) = lu(k,1553) - lu(k,1437) * lu(k,1541) - lu(k,1554) = lu(k,1554) - lu(k,1438) * lu(k,1541) - lu(k,1555) = lu(k,1555) - lu(k,1439) * lu(k,1541) - lu(k,1556) = lu(k,1556) - lu(k,1440) * lu(k,1541) - lu(k,1568) = lu(k,1568) - lu(k,1428) * lu(k,1567) - lu(k,1569) = lu(k,1569) - lu(k,1429) * lu(k,1567) - lu(k,1570) = lu(k,1570) - lu(k,1430) * lu(k,1567) - lu(k,1571) = lu(k,1571) - lu(k,1431) * lu(k,1567) - lu(k,1572) = lu(k,1572) - lu(k,1432) * lu(k,1567) - lu(k,1573) = lu(k,1573) - lu(k,1433) * lu(k,1567) - lu(k,1574) = lu(k,1574) - lu(k,1434) * lu(k,1567) - lu(k,1576) = lu(k,1576) - lu(k,1435) * lu(k,1567) - lu(k,1578) = lu(k,1578) - lu(k,1436) * lu(k,1567) - lu(k,1579) = lu(k,1579) - lu(k,1437) * lu(k,1567) - lu(k,1580) = lu(k,1580) - lu(k,1438) * lu(k,1567) - lu(k,1581) = lu(k,1581) - lu(k,1439) * lu(k,1567) - lu(k,1582) = lu(k,1582) - lu(k,1440) * lu(k,1567) - lu(k,1716) = lu(k,1716) - lu(k,1428) * lu(k,1715) - lu(k,1717) = lu(k,1717) - lu(k,1429) * lu(k,1715) - lu(k,1718) = lu(k,1718) - lu(k,1430) * lu(k,1715) - lu(k,1719) = lu(k,1719) - lu(k,1431) * lu(k,1715) - lu(k,1720) = lu(k,1720) - lu(k,1432) * lu(k,1715) - lu(k,1721) = lu(k,1721) - lu(k,1433) * lu(k,1715) - lu(k,1722) = lu(k,1722) - lu(k,1434) * lu(k,1715) - lu(k,1724) = lu(k,1724) - lu(k,1435) * lu(k,1715) - lu(k,1726) = lu(k,1726) - lu(k,1436) * lu(k,1715) - lu(k,1727) = lu(k,1727) - lu(k,1437) * lu(k,1715) - lu(k,1728) = lu(k,1728) - lu(k,1438) * lu(k,1715) - lu(k,1729) = lu(k,1729) - lu(k,1439) * lu(k,1715) - lu(k,1730) = lu(k,1730) - lu(k,1440) * lu(k,1715) - lu(k,1778) = lu(k,1778) - lu(k,1428) * lu(k,1777) - lu(k,1779) = lu(k,1779) - lu(k,1429) * lu(k,1777) - lu(k,1780) = lu(k,1780) - lu(k,1430) * lu(k,1777) - lu(k,1781) = lu(k,1781) - lu(k,1431) * lu(k,1777) - lu(k,1782) = lu(k,1782) - lu(k,1432) * lu(k,1777) - lu(k,1783) = lu(k,1783) - lu(k,1433) * lu(k,1777) - lu(k,1784) = lu(k,1784) - lu(k,1434) * lu(k,1777) - lu(k,1786) = lu(k,1786) - lu(k,1435) * lu(k,1777) - lu(k,1788) = lu(k,1788) - lu(k,1436) * lu(k,1777) - lu(k,1789) = lu(k,1789) - lu(k,1437) * lu(k,1777) - lu(k,1790) = lu(k,1790) - lu(k,1438) * lu(k,1777) - lu(k,1791) = lu(k,1791) - lu(k,1439) * lu(k,1777) - lu(k,1792) = lu(k,1792) - lu(k,1440) * lu(k,1777) - lu(k,1819) = lu(k,1819) - lu(k,1428) * lu(k,1818) - lu(k,1820) = lu(k,1820) - lu(k,1429) * lu(k,1818) - lu(k,1821) = lu(k,1821) - lu(k,1430) * lu(k,1818) - lu(k,1822) = lu(k,1822) - lu(k,1431) * lu(k,1818) - lu(k,1823) = lu(k,1823) - lu(k,1432) * lu(k,1818) - lu(k,1824) = lu(k,1824) - lu(k,1433) * lu(k,1818) - lu(k,1825) = lu(k,1825) - lu(k,1434) * lu(k,1818) - lu(k,1827) = lu(k,1827) - lu(k,1435) * lu(k,1818) - lu(k,1829) = lu(k,1829) - lu(k,1436) * lu(k,1818) - lu(k,1830) = lu(k,1830) - lu(k,1437) * lu(k,1818) - lu(k,1831) = lu(k,1831) - lu(k,1438) * lu(k,1818) - lu(k,1832) = lu(k,1832) - lu(k,1439) * lu(k,1818) - lu(k,1833) = lu(k,1833) - lu(k,1440) * lu(k,1818) - lu(k,1843) = lu(k,1843) - lu(k,1428) * lu(k,1842) - lu(k,1844) = lu(k,1844) - lu(k,1429) * lu(k,1842) - lu(k,1845) = lu(k,1845) - lu(k,1430) * lu(k,1842) - lu(k,1846) = lu(k,1846) - lu(k,1431) * lu(k,1842) - lu(k,1847) = lu(k,1847) - lu(k,1432) * lu(k,1842) - lu(k,1848) = lu(k,1848) - lu(k,1433) * lu(k,1842) - lu(k,1849) = lu(k,1849) - lu(k,1434) * lu(k,1842) - lu(k,1851) = lu(k,1851) - lu(k,1435) * lu(k,1842) - lu(k,1853) = lu(k,1853) - lu(k,1436) * lu(k,1842) - lu(k,1854) = lu(k,1854) - lu(k,1437) * lu(k,1842) - lu(k,1855) = lu(k,1855) - lu(k,1438) * lu(k,1842) - lu(k,1856) = lu(k,1856) - lu(k,1439) * lu(k,1842) - lu(k,1857) = lu(k,1857) - lu(k,1440) * lu(k,1842) - lu(k,1900) = lu(k,1900) - lu(k,1428) * lu(k,1899) - lu(k,1901) = lu(k,1901) - lu(k,1429) * lu(k,1899) - lu(k,1902) = lu(k,1902) - lu(k,1430) * lu(k,1899) - lu(k,1903) = lu(k,1903) - lu(k,1431) * lu(k,1899) - lu(k,1904) = lu(k,1904) - lu(k,1432) * lu(k,1899) - lu(k,1905) = lu(k,1905) - lu(k,1433) * lu(k,1899) - lu(k,1906) = lu(k,1906) - lu(k,1434) * lu(k,1899) - lu(k,1908) = lu(k,1908) - lu(k,1435) * lu(k,1899) - lu(k,1910) = lu(k,1910) - lu(k,1436) * lu(k,1899) - lu(k,1911) = lu(k,1911) - lu(k,1437) * lu(k,1899) - lu(k,1912) = lu(k,1912) - lu(k,1438) * lu(k,1899) - lu(k,1913) = lu(k,1913) - lu(k,1439) * lu(k,1899) - lu(k,1914) = lu(k,1914) - lu(k,1440) * lu(k,1899) - lu(k,1920) = lu(k,1920) - lu(k,1428) * lu(k,1919) - lu(k,1921) = lu(k,1921) - lu(k,1429) * lu(k,1919) - lu(k,1922) = lu(k,1922) - lu(k,1430) * lu(k,1919) - lu(k,1923) = lu(k,1923) - lu(k,1431) * lu(k,1919) - lu(k,1924) = lu(k,1924) - lu(k,1432) * lu(k,1919) - lu(k,1925) = lu(k,1925) - lu(k,1433) * lu(k,1919) - lu(k,1926) = lu(k,1926) - lu(k,1434) * lu(k,1919) - lu(k,1928) = lu(k,1928) - lu(k,1435) * lu(k,1919) - lu(k,1930) = lu(k,1930) - lu(k,1436) * lu(k,1919) - lu(k,1931) = lu(k,1931) - lu(k,1437) * lu(k,1919) - lu(k,1932) = lu(k,1932) - lu(k,1438) * lu(k,1919) - lu(k,1933) = lu(k,1933) - lu(k,1439) * lu(k,1919) - lu(k,1934) = lu(k,1934) - lu(k,1440) * lu(k,1919) - lu(k,1942) = lu(k,1942) - lu(k,1428) * lu(k,1941) - lu(k,1943) = lu(k,1943) - lu(k,1429) * lu(k,1941) - lu(k,1944) = lu(k,1944) - lu(k,1430) * lu(k,1941) - lu(k,1945) = lu(k,1945) - lu(k,1431) * lu(k,1941) - lu(k,1946) = lu(k,1946) - lu(k,1432) * lu(k,1941) - lu(k,1947) = lu(k,1947) - lu(k,1433) * lu(k,1941) - lu(k,1948) = lu(k,1948) - lu(k,1434) * lu(k,1941) - lu(k,1950) = lu(k,1950) - lu(k,1435) * lu(k,1941) - lu(k,1952) = lu(k,1952) - lu(k,1436) * lu(k,1941) - lu(k,1953) = lu(k,1953) - lu(k,1437) * lu(k,1941) - lu(k,1954) = lu(k,1954) - lu(k,1438) * lu(k,1941) - lu(k,1955) = lu(k,1955) - lu(k,1439) * lu(k,1941) - lu(k,1956) = lu(k,1956) - lu(k,1440) * lu(k,1941) - lu(k,1984) = lu(k,1984) - lu(k,1428) * lu(k,1983) - lu(k,1985) = lu(k,1985) - lu(k,1429) * lu(k,1983) - lu(k,1986) = lu(k,1986) - lu(k,1430) * lu(k,1983) - lu(k,1987) = lu(k,1987) - lu(k,1431) * lu(k,1983) - lu(k,1988) = lu(k,1988) - lu(k,1432) * lu(k,1983) - lu(k,1989) = lu(k,1989) - lu(k,1433) * lu(k,1983) - lu(k,1990) = lu(k,1990) - lu(k,1434) * lu(k,1983) - lu(k,1992) = lu(k,1992) - lu(k,1435) * lu(k,1983) - lu(k,1994) = lu(k,1994) - lu(k,1436) * lu(k,1983) - lu(k,1995) = lu(k,1995) - lu(k,1437) * lu(k,1983) - lu(k,1996) = lu(k,1996) - lu(k,1438) * lu(k,1983) - lu(k,1997) = lu(k,1997) - lu(k,1439) * lu(k,1983) - lu(k,1998) = lu(k,1998) - lu(k,1440) * lu(k,1983) - lu(k,2008) = lu(k,2008) - lu(k,1428) * lu(k,2007) - lu(k,2009) = lu(k,2009) - lu(k,1429) * lu(k,2007) - lu(k,2010) = lu(k,2010) - lu(k,1430) * lu(k,2007) - lu(k,2011) = lu(k,2011) - lu(k,1431) * lu(k,2007) - lu(k,2012) = lu(k,2012) - lu(k,1432) * lu(k,2007) - lu(k,2013) = lu(k,2013) - lu(k,1433) * lu(k,2007) - lu(k,2014) = lu(k,2014) - lu(k,1434) * lu(k,2007) - lu(k,2016) = lu(k,2016) - lu(k,1435) * lu(k,2007) - lu(k,2018) = lu(k,2018) - lu(k,1436) * lu(k,2007) - lu(k,2019) = lu(k,2019) - lu(k,1437) * lu(k,2007) - lu(k,2020) = lu(k,2020) - lu(k,1438) * lu(k,2007) - lu(k,2021) = lu(k,2021) - lu(k,1439) * lu(k,2007) - lu(k,2022) = lu(k,2022) - lu(k,1440) * lu(k,2007) - lu(k,2103) = lu(k,2103) - lu(k,1428) * lu(k,2102) - lu(k,2104) = lu(k,2104) - lu(k,1429) * lu(k,2102) - lu(k,2105) = lu(k,2105) - lu(k,1430) * lu(k,2102) - lu(k,2106) = lu(k,2106) - lu(k,1431) * lu(k,2102) - lu(k,2107) = lu(k,2107) - lu(k,1432) * lu(k,2102) - lu(k,2108) = lu(k,2108) - lu(k,1433) * lu(k,2102) - lu(k,2109) = lu(k,2109) - lu(k,1434) * lu(k,2102) - lu(k,2111) = lu(k,2111) - lu(k,1435) * lu(k,2102) - lu(k,2113) = lu(k,2113) - lu(k,1436) * lu(k,2102) - lu(k,2114) = lu(k,2114) - lu(k,1437) * lu(k,2102) - lu(k,2115) = lu(k,2115) - lu(k,1438) * lu(k,2102) - lu(k,2116) = lu(k,2116) - lu(k,1439) * lu(k,2102) - lu(k,2117) = lu(k,2117) - lu(k,1440) * lu(k,2102) - lu(k,2130) = lu(k,2130) - lu(k,1428) * lu(k,2129) - lu(k,2131) = lu(k,2131) - lu(k,1429) * lu(k,2129) - lu(k,2132) = lu(k,2132) - lu(k,1430) * lu(k,2129) - lu(k,2133) = lu(k,2133) - lu(k,1431) * lu(k,2129) - lu(k,2134) = lu(k,2134) - lu(k,1432) * lu(k,2129) - lu(k,2135) = lu(k,2135) - lu(k,1433) * lu(k,2129) - lu(k,2136) = lu(k,2136) - lu(k,1434) * lu(k,2129) - lu(k,2138) = lu(k,2138) - lu(k,1435) * lu(k,2129) - lu(k,2140) = lu(k,2140) - lu(k,1436) * lu(k,2129) - lu(k,2141) = lu(k,2141) - lu(k,1437) * lu(k,2129) - lu(k,2142) = lu(k,2142) - lu(k,1438) * lu(k,2129) - lu(k,2143) = lu(k,2143) - lu(k,1439) * lu(k,2129) - lu(k,2144) = lu(k,2144) - lu(k,1440) * lu(k,2129) - lu(k,2156) = lu(k,2156) - lu(k,1428) * lu(k,2155) - lu(k,2157) = lu(k,2157) - lu(k,1429) * lu(k,2155) - lu(k,2158) = lu(k,2158) - lu(k,1430) * lu(k,2155) - lu(k,2159) = lu(k,2159) - lu(k,1431) * lu(k,2155) - lu(k,2160) = lu(k,2160) - lu(k,1432) * lu(k,2155) - lu(k,2161) = lu(k,2161) - lu(k,1433) * lu(k,2155) - lu(k,2162) = lu(k,2162) - lu(k,1434) * lu(k,2155) - lu(k,2164) = lu(k,2164) - lu(k,1435) * lu(k,2155) - lu(k,2166) = lu(k,2166) - lu(k,1436) * lu(k,2155) - lu(k,2167) = lu(k,2167) - lu(k,1437) * lu(k,2155) - lu(k,2168) = lu(k,2168) - lu(k,1438) * lu(k,2155) - lu(k,2169) = lu(k,2169) - lu(k,1439) * lu(k,2155) - lu(k,2170) = lu(k,2170) - lu(k,1440) * lu(k,2155) + lu(k,1395) = 1._r8 / lu(k,1395) + lu(k,1396) = lu(k,1396) * lu(k,1395) + lu(k,1397) = lu(k,1397) * lu(k,1395) + lu(k,1398) = lu(k,1398) * lu(k,1395) + lu(k,1399) = lu(k,1399) * lu(k,1395) + lu(k,1400) = lu(k,1400) * lu(k,1395) + lu(k,1401) = lu(k,1401) * lu(k,1395) + lu(k,1402) = lu(k,1402) * lu(k,1395) + lu(k,1403) = lu(k,1403) * lu(k,1395) + lu(k,1404) = lu(k,1404) * lu(k,1395) + lu(k,1405) = lu(k,1405) * lu(k,1395) + lu(k,1406) = lu(k,1406) * lu(k,1395) + lu(k,1407) = lu(k,1407) * lu(k,1395) + lu(k,1426) = lu(k,1426) - lu(k,1396) * lu(k,1425) + lu(k,1427) = lu(k,1427) - lu(k,1397) * lu(k,1425) + lu(k,1429) = lu(k,1429) - lu(k,1398) * lu(k,1425) + lu(k,1430) = lu(k,1430) - lu(k,1399) * lu(k,1425) + lu(k,1431) = lu(k,1431) - lu(k,1400) * lu(k,1425) + lu(k,1432) = lu(k,1432) - lu(k,1401) * lu(k,1425) + lu(k,1433) = lu(k,1433) - lu(k,1402) * lu(k,1425) + lu(k,1434) = lu(k,1434) - lu(k,1403) * lu(k,1425) + lu(k,1435) = lu(k,1435) - lu(k,1404) * lu(k,1425) + lu(k,1437) = lu(k,1437) - lu(k,1405) * lu(k,1425) + lu(k,1438) = lu(k,1438) - lu(k,1406) * lu(k,1425) + lu(k,1439) = lu(k,1439) - lu(k,1407) * lu(k,1425) + lu(k,1789) = lu(k,1789) - lu(k,1396) * lu(k,1788) + lu(k,1790) = lu(k,1790) - lu(k,1397) * lu(k,1788) + lu(k,1799) = lu(k,1799) - lu(k,1398) * lu(k,1788) + lu(k,1800) = lu(k,1800) - lu(k,1399) * lu(k,1788) + lu(k,1801) = lu(k,1801) - lu(k,1400) * lu(k,1788) + lu(k,1803) = lu(k,1803) - lu(k,1401) * lu(k,1788) + lu(k,1804) = lu(k,1804) - lu(k,1402) * lu(k,1788) + lu(k,1806) = lu(k,1806) - lu(k,1403) * lu(k,1788) + lu(k,1807) = lu(k,1807) - lu(k,1404) * lu(k,1788) + lu(k,1810) = lu(k,1810) - lu(k,1405) * lu(k,1788) + lu(k,1811) = lu(k,1811) - lu(k,1406) * lu(k,1788) + lu(k,1812) = lu(k,1812) - lu(k,1407) * lu(k,1788) + lu(k,1835) = lu(k,1835) - lu(k,1396) * lu(k,1834) + lu(k,1836) = lu(k,1836) - lu(k,1397) * lu(k,1834) + lu(k,1844) = lu(k,1844) - lu(k,1398) * lu(k,1834) + lu(k,1845) = lu(k,1845) - lu(k,1399) * lu(k,1834) + lu(k,1846) = lu(k,1846) - lu(k,1400) * lu(k,1834) + lu(k,1848) = lu(k,1848) - lu(k,1401) * lu(k,1834) + lu(k,1849) = lu(k,1849) - lu(k,1402) * lu(k,1834) + lu(k,1851) = lu(k,1851) - lu(k,1403) * lu(k,1834) + lu(k,1852) = lu(k,1852) - lu(k,1404) * lu(k,1834) + lu(k,1855) = lu(k,1855) - lu(k,1405) * lu(k,1834) + lu(k,1856) = lu(k,1856) - lu(k,1406) * lu(k,1834) + lu(k,1857) = lu(k,1857) - lu(k,1407) * lu(k,1834) + lu(k,1896) = lu(k,1896) - lu(k,1396) * lu(k,1895) + lu(k,1897) = lu(k,1897) - lu(k,1397) * lu(k,1895) + lu(k,1904) = lu(k,1904) - lu(k,1398) * lu(k,1895) + lu(k,1905) = lu(k,1905) - lu(k,1399) * lu(k,1895) + lu(k,1906) = lu(k,1906) - lu(k,1400) * lu(k,1895) + lu(k,1908) = lu(k,1908) - lu(k,1401) * lu(k,1895) + lu(k,1909) = lu(k,1909) - lu(k,1402) * lu(k,1895) + lu(k,1911) = lu(k,1911) - lu(k,1403) * lu(k,1895) + lu(k,1912) = lu(k,1912) - lu(k,1404) * lu(k,1895) + lu(k,1915) = lu(k,1915) - lu(k,1405) * lu(k,1895) + lu(k,1916) = lu(k,1916) - lu(k,1406) * lu(k,1895) + lu(k,1917) = lu(k,1917) - lu(k,1407) * lu(k,1895) + lu(k,2061) = lu(k,2061) - lu(k,1396) * lu(k,2060) + lu(k,2062) = lu(k,2062) - lu(k,1397) * lu(k,2060) + lu(k,2068) = lu(k,2068) - lu(k,1398) * lu(k,2060) + lu(k,2069) = lu(k,2069) - lu(k,1399) * lu(k,2060) + lu(k,2070) = lu(k,2070) - lu(k,1400) * lu(k,2060) + lu(k,2072) = lu(k,2072) - lu(k,1401) * lu(k,2060) + lu(k,2073) = lu(k,2073) - lu(k,1402) * lu(k,2060) + lu(k,2075) = lu(k,2075) - lu(k,1403) * lu(k,2060) + lu(k,2076) = lu(k,2076) - lu(k,1404) * lu(k,2060) + lu(k,2079) = lu(k,2079) - lu(k,1405) * lu(k,2060) + lu(k,2080) = lu(k,2080) - lu(k,1406) * lu(k,2060) + lu(k,2081) = lu(k,2081) - lu(k,1407) * lu(k,2060) + lu(k,2188) = lu(k,2188) - lu(k,1396) * lu(k,2187) + lu(k,2189) = lu(k,2189) - lu(k,1397) * lu(k,2187) + lu(k,2197) = lu(k,2197) - lu(k,1398) * lu(k,2187) + lu(k,2198) = lu(k,2198) - lu(k,1399) * lu(k,2187) + lu(k,2199) = lu(k,2199) - lu(k,1400) * lu(k,2187) + lu(k,2201) = lu(k,2201) - lu(k,1401) * lu(k,2187) + lu(k,2202) = lu(k,2202) - lu(k,1402) * lu(k,2187) + lu(k,2204) = lu(k,2204) - lu(k,1403) * lu(k,2187) + lu(k,2205) = lu(k,2205) - lu(k,1404) * lu(k,2187) + lu(k,2208) = lu(k,2208) - lu(k,1405) * lu(k,2187) + lu(k,2209) = lu(k,2209) - lu(k,1406) * lu(k,2187) + lu(k,2210) = lu(k,2210) - lu(k,1407) * lu(k,2187) + lu(k,2243) = lu(k,2243) - lu(k,1396) * lu(k,2242) + lu(k,2244) = lu(k,2244) - lu(k,1397) * lu(k,2242) + lu(k,2249) = lu(k,2249) - lu(k,1398) * lu(k,2242) + lu(k,2250) = lu(k,2250) - lu(k,1399) * lu(k,2242) + lu(k,2251) = lu(k,2251) - lu(k,1400) * lu(k,2242) + lu(k,2253) = lu(k,2253) - lu(k,1401) * lu(k,2242) + lu(k,2254) = lu(k,2254) - lu(k,1402) * lu(k,2242) + lu(k,2256) = lu(k,2256) - lu(k,1403) * lu(k,2242) + lu(k,2257) = lu(k,2257) - lu(k,1404) * lu(k,2242) + lu(k,2260) = lu(k,2260) - lu(k,1405) * lu(k,2242) + lu(k,2261) = lu(k,2261) - lu(k,1406) * lu(k,2242) + lu(k,2262) = lu(k,2262) - lu(k,1407) * lu(k,2242) + lu(k,2399) = lu(k,2399) - lu(k,1396) * lu(k,2398) + lu(k,2400) = lu(k,2400) - lu(k,1397) * lu(k,2398) + lu(k,2407) = lu(k,2407) - lu(k,1398) * lu(k,2398) + lu(k,2408) = lu(k,2408) - lu(k,1399) * lu(k,2398) + lu(k,2409) = lu(k,2409) - lu(k,1400) * lu(k,2398) + lu(k,2411) = lu(k,2411) - lu(k,1401) * lu(k,2398) + lu(k,2412) = lu(k,2412) - lu(k,1402) * lu(k,2398) + lu(k,2414) = lu(k,2414) - lu(k,1403) * lu(k,2398) + lu(k,2415) = lu(k,2415) - lu(k,1404) * lu(k,2398) + lu(k,2418) = lu(k,2418) - lu(k,1405) * lu(k,2398) + lu(k,2419) = lu(k,2419) - lu(k,1406) * lu(k,2398) + lu(k,2420) = lu(k,2420) - lu(k,1407) * lu(k,2398) + lu(k,1426) = 1._r8 / lu(k,1426) + lu(k,1427) = lu(k,1427) * lu(k,1426) + lu(k,1428) = lu(k,1428) * lu(k,1426) + lu(k,1429) = lu(k,1429) * lu(k,1426) + lu(k,1430) = lu(k,1430) * lu(k,1426) + lu(k,1431) = lu(k,1431) * lu(k,1426) + lu(k,1432) = lu(k,1432) * lu(k,1426) + lu(k,1433) = lu(k,1433) * lu(k,1426) + lu(k,1434) = lu(k,1434) * lu(k,1426) + lu(k,1435) = lu(k,1435) * lu(k,1426) + lu(k,1436) = lu(k,1436) * lu(k,1426) + lu(k,1437) = lu(k,1437) * lu(k,1426) + lu(k,1438) = lu(k,1438) * lu(k,1426) + lu(k,1439) = lu(k,1439) * lu(k,1426) + lu(k,1790) = lu(k,1790) - lu(k,1427) * lu(k,1789) + lu(k,1795) = lu(k,1795) - lu(k,1428) * lu(k,1789) + lu(k,1799) = lu(k,1799) - lu(k,1429) * lu(k,1789) + lu(k,1800) = lu(k,1800) - lu(k,1430) * lu(k,1789) + lu(k,1801) = lu(k,1801) - lu(k,1431) * lu(k,1789) + lu(k,1803) = lu(k,1803) - lu(k,1432) * lu(k,1789) + lu(k,1804) = lu(k,1804) - lu(k,1433) * lu(k,1789) + lu(k,1806) = lu(k,1806) - lu(k,1434) * lu(k,1789) + lu(k,1807) = lu(k,1807) - lu(k,1435) * lu(k,1789) + lu(k,1808) = lu(k,1808) - lu(k,1436) * lu(k,1789) + lu(k,1810) = lu(k,1810) - lu(k,1437) * lu(k,1789) + lu(k,1811) = lu(k,1811) - lu(k,1438) * lu(k,1789) + lu(k,1812) = lu(k,1812) - lu(k,1439) * lu(k,1789) + lu(k,1836) = lu(k,1836) - lu(k,1427) * lu(k,1835) + lu(k,1840) = lu(k,1840) - lu(k,1428) * lu(k,1835) + lu(k,1844) = lu(k,1844) - lu(k,1429) * lu(k,1835) + lu(k,1845) = lu(k,1845) - lu(k,1430) * lu(k,1835) + lu(k,1846) = lu(k,1846) - lu(k,1431) * lu(k,1835) + lu(k,1848) = lu(k,1848) - lu(k,1432) * lu(k,1835) + lu(k,1849) = lu(k,1849) - lu(k,1433) * lu(k,1835) + lu(k,1851) = lu(k,1851) - lu(k,1434) * lu(k,1835) + lu(k,1852) = lu(k,1852) - lu(k,1435) * lu(k,1835) + lu(k,1853) = - lu(k,1436) * lu(k,1835) + lu(k,1855) = lu(k,1855) - lu(k,1437) * lu(k,1835) + lu(k,1856) = lu(k,1856) - lu(k,1438) * lu(k,1835) + lu(k,1857) = lu(k,1857) - lu(k,1439) * lu(k,1835) + lu(k,1897) = lu(k,1897) - lu(k,1427) * lu(k,1896) + lu(k,1900) = lu(k,1900) - lu(k,1428) * lu(k,1896) + lu(k,1904) = lu(k,1904) - lu(k,1429) * lu(k,1896) + lu(k,1905) = lu(k,1905) - lu(k,1430) * lu(k,1896) + lu(k,1906) = lu(k,1906) - lu(k,1431) * lu(k,1896) + lu(k,1908) = lu(k,1908) - lu(k,1432) * lu(k,1896) + lu(k,1909) = lu(k,1909) - lu(k,1433) * lu(k,1896) + lu(k,1911) = lu(k,1911) - lu(k,1434) * lu(k,1896) + lu(k,1912) = lu(k,1912) - lu(k,1435) * lu(k,1896) + lu(k,1913) = lu(k,1913) - lu(k,1436) * lu(k,1896) + lu(k,1915) = lu(k,1915) - lu(k,1437) * lu(k,1896) + lu(k,1916) = lu(k,1916) - lu(k,1438) * lu(k,1896) + lu(k,1917) = lu(k,1917) - lu(k,1439) * lu(k,1896) + lu(k,1942) = lu(k,1942) - lu(k,1427) * lu(k,1941) + lu(k,1946) = lu(k,1946) - lu(k,1428) * lu(k,1941) + lu(k,1950) = lu(k,1950) - lu(k,1429) * lu(k,1941) + lu(k,1951) = lu(k,1951) - lu(k,1430) * lu(k,1941) + lu(k,1952) = lu(k,1952) - lu(k,1431) * lu(k,1941) + lu(k,1954) = lu(k,1954) - lu(k,1432) * lu(k,1941) + lu(k,1955) = lu(k,1955) - lu(k,1433) * lu(k,1941) + lu(k,1957) = lu(k,1957) - lu(k,1434) * lu(k,1941) + lu(k,1958) = lu(k,1958) - lu(k,1435) * lu(k,1941) + lu(k,1959) = lu(k,1959) - lu(k,1436) * lu(k,1941) + lu(k,1961) = lu(k,1961) - lu(k,1437) * lu(k,1941) + lu(k,1962) = lu(k,1962) - lu(k,1438) * lu(k,1941) + lu(k,1963) = lu(k,1963) - lu(k,1439) * lu(k,1941) + lu(k,2062) = lu(k,2062) - lu(k,1427) * lu(k,2061) + lu(k,2064) = lu(k,2064) - lu(k,1428) * lu(k,2061) + lu(k,2068) = lu(k,2068) - lu(k,1429) * lu(k,2061) + lu(k,2069) = lu(k,2069) - lu(k,1430) * lu(k,2061) + lu(k,2070) = lu(k,2070) - lu(k,1431) * lu(k,2061) + lu(k,2072) = lu(k,2072) - lu(k,1432) * lu(k,2061) + lu(k,2073) = lu(k,2073) - lu(k,1433) * lu(k,2061) + lu(k,2075) = lu(k,2075) - lu(k,1434) * lu(k,2061) + lu(k,2076) = lu(k,2076) - lu(k,1435) * lu(k,2061) + lu(k,2077) = lu(k,2077) - lu(k,1436) * lu(k,2061) + lu(k,2079) = lu(k,2079) - lu(k,1437) * lu(k,2061) + lu(k,2080) = lu(k,2080) - lu(k,1438) * lu(k,2061) + lu(k,2081) = lu(k,2081) - lu(k,1439) * lu(k,2061) + lu(k,2189) = lu(k,2189) - lu(k,1427) * lu(k,2188) + lu(k,2193) = lu(k,2193) - lu(k,1428) * lu(k,2188) + lu(k,2197) = lu(k,2197) - lu(k,1429) * lu(k,2188) + lu(k,2198) = lu(k,2198) - lu(k,1430) * lu(k,2188) + lu(k,2199) = lu(k,2199) - lu(k,1431) * lu(k,2188) + lu(k,2201) = lu(k,2201) - lu(k,1432) * lu(k,2188) + lu(k,2202) = lu(k,2202) - lu(k,1433) * lu(k,2188) + lu(k,2204) = lu(k,2204) - lu(k,1434) * lu(k,2188) + lu(k,2205) = lu(k,2205) - lu(k,1435) * lu(k,2188) + lu(k,2206) = lu(k,2206) - lu(k,1436) * lu(k,2188) + lu(k,2208) = lu(k,2208) - lu(k,1437) * lu(k,2188) + lu(k,2209) = lu(k,2209) - lu(k,1438) * lu(k,2188) + lu(k,2210) = lu(k,2210) - lu(k,1439) * lu(k,2188) + lu(k,2244) = lu(k,2244) - lu(k,1427) * lu(k,2243) + lu(k,2245) = lu(k,2245) - lu(k,1428) * lu(k,2243) + lu(k,2249) = lu(k,2249) - lu(k,1429) * lu(k,2243) + lu(k,2250) = lu(k,2250) - lu(k,1430) * lu(k,2243) + lu(k,2251) = lu(k,2251) - lu(k,1431) * lu(k,2243) + lu(k,2253) = lu(k,2253) - lu(k,1432) * lu(k,2243) + lu(k,2254) = lu(k,2254) - lu(k,1433) * lu(k,2243) + lu(k,2256) = lu(k,2256) - lu(k,1434) * lu(k,2243) + lu(k,2257) = lu(k,2257) - lu(k,1435) * lu(k,2243) + lu(k,2258) = lu(k,2258) - lu(k,1436) * lu(k,2243) + lu(k,2260) = lu(k,2260) - lu(k,1437) * lu(k,2243) + lu(k,2261) = lu(k,2261) - lu(k,1438) * lu(k,2243) + lu(k,2262) = lu(k,2262) - lu(k,1439) * lu(k,2243) + lu(k,2400) = lu(k,2400) - lu(k,1427) * lu(k,2399) + lu(k,2403) = lu(k,2403) - lu(k,1428) * lu(k,2399) + lu(k,2407) = lu(k,2407) - lu(k,1429) * lu(k,2399) + lu(k,2408) = lu(k,2408) - lu(k,1430) * lu(k,2399) + lu(k,2409) = lu(k,2409) - lu(k,1431) * lu(k,2399) + lu(k,2411) = lu(k,2411) - lu(k,1432) * lu(k,2399) + lu(k,2412) = lu(k,2412) - lu(k,1433) * lu(k,2399) + lu(k,2414) = lu(k,2414) - lu(k,1434) * lu(k,2399) + lu(k,2415) = lu(k,2415) - lu(k,1435) * lu(k,2399) + lu(k,2416) = lu(k,2416) - lu(k,1436) * lu(k,2399) + lu(k,2418) = lu(k,2418) - lu(k,1437) * lu(k,2399) + lu(k,2419) = lu(k,2419) - lu(k,1438) * lu(k,2399) + lu(k,2420) = lu(k,2420) - lu(k,1439) * lu(k,2399) + lu(k,1448) = 1._r8 / lu(k,1448) + lu(k,1449) = lu(k,1449) * lu(k,1448) + lu(k,1450) = lu(k,1450) * lu(k,1448) + lu(k,1451) = lu(k,1451) * lu(k,1448) + lu(k,1452) = lu(k,1452) * lu(k,1448) + lu(k,1453) = lu(k,1453) * lu(k,1448) + lu(k,1454) = lu(k,1454) * lu(k,1448) + lu(k,1455) = lu(k,1455) * lu(k,1448) + lu(k,1456) = lu(k,1456) * lu(k,1448) + lu(k,1510) = lu(k,1510) - lu(k,1449) * lu(k,1508) + lu(k,1512) = lu(k,1512) - lu(k,1450) * lu(k,1508) + lu(k,1513) = lu(k,1513) - lu(k,1451) * lu(k,1508) + lu(k,1514) = - lu(k,1452) * lu(k,1508) + lu(k,1515) = - lu(k,1453) * lu(k,1508) + lu(k,1516) = lu(k,1516) - lu(k,1454) * lu(k,1508) + lu(k,1517) = lu(k,1517) - lu(k,1455) * lu(k,1508) + lu(k,1518) = lu(k,1518) - lu(k,1456) * lu(k,1508) + lu(k,1540) = lu(k,1540) - lu(k,1449) * lu(k,1537) + lu(k,1543) = lu(k,1543) - lu(k,1450) * lu(k,1537) + lu(k,1544) = lu(k,1544) - lu(k,1451) * lu(k,1537) + lu(k,1545) = lu(k,1545) - lu(k,1452) * lu(k,1537) + lu(k,1547) = lu(k,1547) - lu(k,1453) * lu(k,1537) + lu(k,1548) = lu(k,1548) - lu(k,1454) * lu(k,1537) + lu(k,1549) = lu(k,1549) - lu(k,1455) * lu(k,1537) + lu(k,1550) = lu(k,1550) - lu(k,1456) * lu(k,1537) + lu(k,1795) = lu(k,1795) - lu(k,1449) * lu(k,1790) + lu(k,1798) = lu(k,1798) - lu(k,1450) * lu(k,1790) + lu(k,1799) = lu(k,1799) - lu(k,1451) * lu(k,1790) + lu(k,1800) = lu(k,1800) - lu(k,1452) * lu(k,1790) + lu(k,1804) = lu(k,1804) - lu(k,1453) * lu(k,1790) + lu(k,1805) = lu(k,1805) - lu(k,1454) * lu(k,1790) + lu(k,1806) = lu(k,1806) - lu(k,1455) * lu(k,1790) + lu(k,1809) = lu(k,1809) - lu(k,1456) * lu(k,1790) + lu(k,1840) = lu(k,1840) - lu(k,1449) * lu(k,1836) + lu(k,1843) = lu(k,1843) - lu(k,1450) * lu(k,1836) + lu(k,1844) = lu(k,1844) - lu(k,1451) * lu(k,1836) + lu(k,1845) = lu(k,1845) - lu(k,1452) * lu(k,1836) + lu(k,1849) = lu(k,1849) - lu(k,1453) * lu(k,1836) + lu(k,1850) = lu(k,1850) - lu(k,1454) * lu(k,1836) + lu(k,1851) = lu(k,1851) - lu(k,1455) * lu(k,1836) + lu(k,1854) = lu(k,1854) - lu(k,1456) * lu(k,1836) + lu(k,1900) = lu(k,1900) - lu(k,1449) * lu(k,1897) + lu(k,1903) = - lu(k,1450) * lu(k,1897) + lu(k,1904) = lu(k,1904) - lu(k,1451) * lu(k,1897) + lu(k,1905) = lu(k,1905) - lu(k,1452) * lu(k,1897) + lu(k,1909) = lu(k,1909) - lu(k,1453) * lu(k,1897) + lu(k,1910) = - lu(k,1454) * lu(k,1897) + lu(k,1911) = lu(k,1911) - lu(k,1455) * lu(k,1897) + lu(k,1914) = lu(k,1914) - lu(k,1456) * lu(k,1897) + lu(k,1946) = lu(k,1946) - lu(k,1449) * lu(k,1942) + lu(k,1949) = lu(k,1949) - lu(k,1450) * lu(k,1942) + lu(k,1950) = lu(k,1950) - lu(k,1451) * lu(k,1942) + lu(k,1951) = lu(k,1951) - lu(k,1452) * lu(k,1942) + lu(k,1955) = lu(k,1955) - lu(k,1453) * lu(k,1942) + lu(k,1956) = lu(k,1956) - lu(k,1454) * lu(k,1942) + lu(k,1957) = lu(k,1957) - lu(k,1455) * lu(k,1942) + lu(k,1960) = lu(k,1960) - lu(k,1456) * lu(k,1942) + lu(k,2064) = lu(k,2064) - lu(k,1449) * lu(k,2062) + lu(k,2067) = lu(k,2067) - lu(k,1450) * lu(k,2062) + lu(k,2068) = lu(k,2068) - lu(k,1451) * lu(k,2062) + lu(k,2069) = lu(k,2069) - lu(k,1452) * lu(k,2062) + lu(k,2073) = lu(k,2073) - lu(k,1453) * lu(k,2062) + lu(k,2074) = lu(k,2074) - lu(k,1454) * lu(k,2062) + lu(k,2075) = lu(k,2075) - lu(k,1455) * lu(k,2062) + lu(k,2078) = lu(k,2078) - lu(k,1456) * lu(k,2062) + lu(k,2193) = lu(k,2193) - lu(k,1449) * lu(k,2189) + lu(k,2196) = lu(k,2196) - lu(k,1450) * lu(k,2189) + lu(k,2197) = lu(k,2197) - lu(k,1451) * lu(k,2189) + lu(k,2198) = lu(k,2198) - lu(k,1452) * lu(k,2189) + lu(k,2202) = lu(k,2202) - lu(k,1453) * lu(k,2189) + lu(k,2203) = lu(k,2203) - lu(k,1454) * lu(k,2189) + lu(k,2204) = lu(k,2204) - lu(k,1455) * lu(k,2189) + lu(k,2207) = lu(k,2207) - lu(k,1456) * lu(k,2189) + lu(k,2245) = lu(k,2245) - lu(k,1449) * lu(k,2244) + lu(k,2248) = - lu(k,1450) * lu(k,2244) + lu(k,2249) = lu(k,2249) - lu(k,1451) * lu(k,2244) + lu(k,2250) = lu(k,2250) - lu(k,1452) * lu(k,2244) + lu(k,2254) = lu(k,2254) - lu(k,1453) * lu(k,2244) + lu(k,2255) = lu(k,2255) - lu(k,1454) * lu(k,2244) + lu(k,2256) = lu(k,2256) - lu(k,1455) * lu(k,2244) + lu(k,2259) = - lu(k,1456) * lu(k,2244) + lu(k,2270) = - lu(k,1449) * lu(k,2266) + lu(k,2273) = lu(k,2273) - lu(k,1450) * lu(k,2266) + lu(k,2274) = lu(k,2274) - lu(k,1451) * lu(k,2266) + lu(k,2275) = - lu(k,1452) * lu(k,2266) + lu(k,2279) = - lu(k,1453) * lu(k,2266) + lu(k,2280) = lu(k,2280) - lu(k,1454) * lu(k,2266) + lu(k,2281) = lu(k,2281) - lu(k,1455) * lu(k,2266) + lu(k,2284) = lu(k,2284) - lu(k,1456) * lu(k,2266) + lu(k,2313) = lu(k,2313) - lu(k,1449) * lu(k,2308) + lu(k,2316) = lu(k,2316) - lu(k,1450) * lu(k,2308) + lu(k,2317) = lu(k,2317) - lu(k,1451) * lu(k,2308) + lu(k,2318) = lu(k,2318) - lu(k,1452) * lu(k,2308) + lu(k,2322) = lu(k,2322) - lu(k,1453) * lu(k,2308) + lu(k,2323) = lu(k,2323) - lu(k,1454) * lu(k,2308) + lu(k,2324) = lu(k,2324) - lu(k,1455) * lu(k,2308) + lu(k,2327) = lu(k,2327) - lu(k,1456) * lu(k,2308) + lu(k,2339) = - lu(k,1449) * lu(k,2335) + lu(k,2342) = lu(k,2342) - lu(k,1450) * lu(k,2335) + lu(k,2343) = lu(k,2343) - lu(k,1451) * lu(k,2335) + lu(k,2344) = lu(k,2344) - lu(k,1452) * lu(k,2335) + lu(k,2348) = lu(k,2348) - lu(k,1453) * lu(k,2335) + lu(k,2349) = lu(k,2349) - lu(k,1454) * lu(k,2335) + lu(k,2350) = lu(k,2350) - lu(k,1455) * lu(k,2335) + lu(k,2353) = lu(k,2353) - lu(k,1456) * lu(k,2335) + lu(k,2403) = lu(k,2403) - lu(k,1449) * lu(k,2400) + lu(k,2406) = lu(k,2406) - lu(k,1450) * lu(k,2400) + lu(k,2407) = lu(k,2407) - lu(k,1451) * lu(k,2400) + lu(k,2408) = lu(k,2408) - lu(k,1452) * lu(k,2400) + lu(k,2412) = lu(k,2412) - lu(k,1453) * lu(k,2400) + lu(k,2413) = lu(k,2413) - lu(k,1454) * lu(k,2400) + lu(k,2414) = lu(k,2414) - lu(k,1455) * lu(k,2400) + lu(k,2417) = lu(k,2417) - lu(k,1456) * lu(k,2400) + lu(k,1459) = 1._r8 / lu(k,1459) + lu(k,1460) = lu(k,1460) * lu(k,1459) + lu(k,1461) = lu(k,1461) * lu(k,1459) + lu(k,1462) = lu(k,1462) * lu(k,1459) + lu(k,1463) = lu(k,1463) * lu(k,1459) + lu(k,1464) = lu(k,1464) * lu(k,1459) + lu(k,1465) = lu(k,1465) * lu(k,1459) + lu(k,1466) = lu(k,1466) * lu(k,1459) + lu(k,1467) = lu(k,1467) * lu(k,1459) + lu(k,1468) = lu(k,1468) * lu(k,1459) + lu(k,1469) = lu(k,1469) * lu(k,1459) + lu(k,1470) = lu(k,1470) * lu(k,1459) + lu(k,1628) = lu(k,1628) - lu(k,1460) * lu(k,1627) + lu(k,1633) = lu(k,1633) - lu(k,1461) * lu(k,1627) + lu(k,1634) = lu(k,1634) - lu(k,1462) * lu(k,1627) + lu(k,1636) = lu(k,1636) - lu(k,1463) * lu(k,1627) + lu(k,1637) = lu(k,1637) - lu(k,1464) * lu(k,1627) + lu(k,1638) = lu(k,1638) - lu(k,1465) * lu(k,1627) + lu(k,1640) = lu(k,1640) - lu(k,1466) * lu(k,1627) + lu(k,1642) = lu(k,1642) - lu(k,1467) * lu(k,1627) + lu(k,1643) = lu(k,1643) - lu(k,1468) * lu(k,1627) + lu(k,1644) = lu(k,1644) - lu(k,1469) * lu(k,1627) + lu(k,1647) = lu(k,1647) - lu(k,1470) * lu(k,1627) + lu(k,1793) = lu(k,1793) - lu(k,1460) * lu(k,1791) + lu(k,1798) = lu(k,1798) - lu(k,1461) * lu(k,1791) + lu(k,1799) = lu(k,1799) - lu(k,1462) * lu(k,1791) + lu(k,1801) = lu(k,1801) - lu(k,1463) * lu(k,1791) + lu(k,1802) = lu(k,1802) - lu(k,1464) * lu(k,1791) + lu(k,1803) = lu(k,1803) - lu(k,1465) * lu(k,1791) + lu(k,1805) = lu(k,1805) - lu(k,1466) * lu(k,1791) + lu(k,1807) = lu(k,1807) - lu(k,1467) * lu(k,1791) + lu(k,1808) = lu(k,1808) - lu(k,1468) * lu(k,1791) + lu(k,1809) = lu(k,1809) - lu(k,1469) * lu(k,1791) + lu(k,1812) = lu(k,1812) - lu(k,1470) * lu(k,1791) + lu(k,1944) = lu(k,1944) - lu(k,1460) * lu(k,1943) + lu(k,1949) = lu(k,1949) - lu(k,1461) * lu(k,1943) + lu(k,1950) = lu(k,1950) - lu(k,1462) * lu(k,1943) + lu(k,1952) = lu(k,1952) - lu(k,1463) * lu(k,1943) + lu(k,1953) = lu(k,1953) - lu(k,1464) * lu(k,1943) + lu(k,1954) = lu(k,1954) - lu(k,1465) * lu(k,1943) + lu(k,1956) = lu(k,1956) - lu(k,1466) * lu(k,1943) + lu(k,1958) = lu(k,1958) - lu(k,1467) * lu(k,1943) + lu(k,1959) = lu(k,1959) - lu(k,1468) * lu(k,1943) + lu(k,1960) = lu(k,1960) - lu(k,1469) * lu(k,1943) + lu(k,1963) = lu(k,1963) - lu(k,1470) * lu(k,1943) + lu(k,1967) = - lu(k,1460) * lu(k,1966) + lu(k,1972) = - lu(k,1461) * lu(k,1966) + lu(k,1973) = lu(k,1973) - lu(k,1462) * lu(k,1966) + lu(k,1975) = lu(k,1975) - lu(k,1463) * lu(k,1966) + lu(k,1976) = - lu(k,1464) * lu(k,1966) + lu(k,1977) = lu(k,1977) - lu(k,1465) * lu(k,1966) + lu(k,1979) = lu(k,1979) - lu(k,1466) * lu(k,1966) + lu(k,1981) = lu(k,1981) - lu(k,1467) * lu(k,1966) + lu(k,1982) = lu(k,1982) - lu(k,1468) * lu(k,1966) + lu(k,1983) = - lu(k,1469) * lu(k,1966) + lu(k,1986) = lu(k,1986) - lu(k,1470) * lu(k,1966) + lu(k,2083) = - lu(k,1460) * lu(k,2082) + lu(k,2088) = - lu(k,1461) * lu(k,2082) + lu(k,2089) = lu(k,2089) - lu(k,1462) * lu(k,2082) + lu(k,2091) = - lu(k,1463) * lu(k,2082) + lu(k,2092) = - lu(k,1464) * lu(k,2082) + lu(k,2093) = - lu(k,1465) * lu(k,2082) + lu(k,2095) = lu(k,2095) - lu(k,1466) * lu(k,2082) + lu(k,2097) = - lu(k,1467) * lu(k,2082) + lu(k,2098) = - lu(k,1468) * lu(k,2082) + lu(k,2099) = lu(k,2099) - lu(k,1469) * lu(k,2082) + lu(k,2102) = lu(k,2102) - lu(k,1470) * lu(k,2082) + lu(k,2191) = lu(k,2191) - lu(k,1460) * lu(k,2190) + lu(k,2196) = lu(k,2196) - lu(k,1461) * lu(k,2190) + lu(k,2197) = lu(k,2197) - lu(k,1462) * lu(k,2190) + lu(k,2199) = lu(k,2199) - lu(k,1463) * lu(k,2190) + lu(k,2200) = lu(k,2200) - lu(k,1464) * lu(k,2190) + lu(k,2201) = lu(k,2201) - lu(k,1465) * lu(k,2190) + lu(k,2203) = lu(k,2203) - lu(k,1466) * lu(k,2190) + lu(k,2205) = lu(k,2205) - lu(k,1467) * lu(k,2190) + lu(k,2206) = lu(k,2206) - lu(k,1468) * lu(k,2190) + lu(k,2207) = lu(k,2207) - lu(k,1469) * lu(k,2190) + lu(k,2210) = lu(k,2210) - lu(k,1470) * lu(k,2190) + lu(k,2268) = lu(k,2268) - lu(k,1460) * lu(k,2267) + lu(k,2273) = lu(k,2273) - lu(k,1461) * lu(k,2267) + lu(k,2274) = lu(k,2274) - lu(k,1462) * lu(k,2267) + lu(k,2276) = lu(k,2276) - lu(k,1463) * lu(k,2267) + lu(k,2277) = lu(k,2277) - lu(k,1464) * lu(k,2267) + lu(k,2278) = lu(k,2278) - lu(k,1465) * lu(k,2267) + lu(k,2280) = lu(k,2280) - lu(k,1466) * lu(k,2267) + lu(k,2282) = lu(k,2282) - lu(k,1467) * lu(k,2267) + lu(k,2283) = lu(k,2283) - lu(k,1468) * lu(k,2267) + lu(k,2284) = lu(k,2284) - lu(k,1469) * lu(k,2267) + lu(k,2287) = lu(k,2287) - lu(k,1470) * lu(k,2267) + lu(k,2311) = lu(k,2311) - lu(k,1460) * lu(k,2309) + lu(k,2316) = lu(k,2316) - lu(k,1461) * lu(k,2309) + lu(k,2317) = lu(k,2317) - lu(k,1462) * lu(k,2309) + lu(k,2319) = lu(k,2319) - lu(k,1463) * lu(k,2309) + lu(k,2320) = lu(k,2320) - lu(k,1464) * lu(k,2309) + lu(k,2321) = lu(k,2321) - lu(k,1465) * lu(k,2309) + lu(k,2323) = lu(k,2323) - lu(k,1466) * lu(k,2309) + lu(k,2325) = - lu(k,1467) * lu(k,2309) + lu(k,2326) = - lu(k,1468) * lu(k,2309) + lu(k,2327) = lu(k,2327) - lu(k,1469) * lu(k,2309) + lu(k,2330) = lu(k,2330) - lu(k,1470) * lu(k,2309) + lu(k,2337) = lu(k,2337) - lu(k,1460) * lu(k,2336) + lu(k,2342) = lu(k,2342) - lu(k,1461) * lu(k,2336) + lu(k,2343) = lu(k,2343) - lu(k,1462) * lu(k,2336) + lu(k,2345) = lu(k,2345) - lu(k,1463) * lu(k,2336) + lu(k,2346) = lu(k,2346) - lu(k,1464) * lu(k,2336) + lu(k,2347) = lu(k,2347) - lu(k,1465) * lu(k,2336) + lu(k,2349) = lu(k,2349) - lu(k,1466) * lu(k,2336) + lu(k,2351) = - lu(k,1467) * lu(k,2336) + lu(k,2352) = - lu(k,1468) * lu(k,2336) + lu(k,2353) = lu(k,2353) - lu(k,1469) * lu(k,2336) + lu(k,2356) = lu(k,2356) - lu(k,1470) * lu(k,2336) + lu(k,2428) = - lu(k,1460) * lu(k,2426) + lu(k,2433) = lu(k,2433) - lu(k,1461) * lu(k,2426) + lu(k,2434) = lu(k,2434) - lu(k,1462) * lu(k,2426) + lu(k,2436) = lu(k,2436) - lu(k,1463) * lu(k,2426) + lu(k,2437) = - lu(k,1464) * lu(k,2426) + lu(k,2438) = lu(k,2438) - lu(k,1465) * lu(k,2426) + lu(k,2440) = lu(k,2440) - lu(k,1466) * lu(k,2426) + lu(k,2442) = lu(k,2442) - lu(k,1467) * lu(k,2426) + lu(k,2443) = lu(k,2443) - lu(k,1468) * lu(k,2426) + lu(k,2444) = lu(k,2444) - lu(k,1469) * lu(k,2426) + lu(k,2447) = lu(k,2447) - lu(k,1470) * lu(k,2426) end do - end subroutine lu_fac27 - subroutine lu_fac28( avec_len, lu ) + end subroutine lu_fac28 + subroutine lu_fac29( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 implicit none @@ -6780,693 +6442,309 @@ subroutine lu_fac28( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1507) = 1._r8 / lu(k,1507) - lu(k,1508) = lu(k,1508) * lu(k,1507) - lu(k,1509) = lu(k,1509) * lu(k,1507) - lu(k,1510) = lu(k,1510) * lu(k,1507) - lu(k,1511) = lu(k,1511) * lu(k,1507) - lu(k,1512) = lu(k,1512) * lu(k,1507) - lu(k,1513) = lu(k,1513) * lu(k,1507) - lu(k,1514) = lu(k,1514) * lu(k,1507) - lu(k,1515) = lu(k,1515) * lu(k,1507) - lu(k,1516) = lu(k,1516) * lu(k,1507) - lu(k,1517) = lu(k,1517) * lu(k,1507) - lu(k,1518) = lu(k,1518) * lu(k,1507) - lu(k,1519) = lu(k,1519) * lu(k,1507) - lu(k,1520) = lu(k,1520) * lu(k,1507) - lu(k,1521) = lu(k,1521) * lu(k,1507) - lu(k,1543) = lu(k,1543) - lu(k,1508) * lu(k,1542) - lu(k,1544) = lu(k,1544) - lu(k,1509) * lu(k,1542) - lu(k,1545) = lu(k,1545) - lu(k,1510) * lu(k,1542) - lu(k,1546) = lu(k,1546) - lu(k,1511) * lu(k,1542) - lu(k,1547) = lu(k,1547) - lu(k,1512) * lu(k,1542) - lu(k,1548) = lu(k,1548) - lu(k,1513) * lu(k,1542) - lu(k,1549) = lu(k,1549) - lu(k,1514) * lu(k,1542) - lu(k,1550) = lu(k,1550) - lu(k,1515) * lu(k,1542) - lu(k,1551) = lu(k,1551) - lu(k,1516) * lu(k,1542) - lu(k,1552) = lu(k,1552) - lu(k,1517) * lu(k,1542) - lu(k,1553) = lu(k,1553) - lu(k,1518) * lu(k,1542) - lu(k,1554) = lu(k,1554) - lu(k,1519) * lu(k,1542) - lu(k,1555) = lu(k,1555) - lu(k,1520) * lu(k,1542) - lu(k,1556) = lu(k,1556) - lu(k,1521) * lu(k,1542) - lu(k,1569) = lu(k,1569) - lu(k,1508) * lu(k,1568) - lu(k,1570) = lu(k,1570) - lu(k,1509) * lu(k,1568) - lu(k,1571) = lu(k,1571) - lu(k,1510) * lu(k,1568) - lu(k,1572) = lu(k,1572) - lu(k,1511) * lu(k,1568) - lu(k,1573) = lu(k,1573) - lu(k,1512) * lu(k,1568) - lu(k,1574) = lu(k,1574) - lu(k,1513) * lu(k,1568) - lu(k,1575) = lu(k,1575) - lu(k,1514) * lu(k,1568) - lu(k,1576) = lu(k,1576) - lu(k,1515) * lu(k,1568) - lu(k,1577) = lu(k,1577) - lu(k,1516) * lu(k,1568) - lu(k,1578) = lu(k,1578) - lu(k,1517) * lu(k,1568) - lu(k,1579) = lu(k,1579) - lu(k,1518) * lu(k,1568) - lu(k,1580) = lu(k,1580) - lu(k,1519) * lu(k,1568) - lu(k,1581) = lu(k,1581) - lu(k,1520) * lu(k,1568) - lu(k,1582) = lu(k,1582) - lu(k,1521) * lu(k,1568) - lu(k,1717) = lu(k,1717) - lu(k,1508) * lu(k,1716) - lu(k,1718) = lu(k,1718) - lu(k,1509) * lu(k,1716) - lu(k,1719) = lu(k,1719) - lu(k,1510) * lu(k,1716) - lu(k,1720) = lu(k,1720) - lu(k,1511) * lu(k,1716) - lu(k,1721) = lu(k,1721) - lu(k,1512) * lu(k,1716) - lu(k,1722) = lu(k,1722) - lu(k,1513) * lu(k,1716) - lu(k,1723) = lu(k,1723) - lu(k,1514) * lu(k,1716) - lu(k,1724) = lu(k,1724) - lu(k,1515) * lu(k,1716) - lu(k,1725) = lu(k,1725) - lu(k,1516) * lu(k,1716) - lu(k,1726) = lu(k,1726) - lu(k,1517) * lu(k,1716) - lu(k,1727) = lu(k,1727) - lu(k,1518) * lu(k,1716) - lu(k,1728) = lu(k,1728) - lu(k,1519) * lu(k,1716) - lu(k,1729) = lu(k,1729) - lu(k,1520) * lu(k,1716) - lu(k,1730) = lu(k,1730) - lu(k,1521) * lu(k,1716) - lu(k,1779) = lu(k,1779) - lu(k,1508) * lu(k,1778) - lu(k,1780) = lu(k,1780) - lu(k,1509) * lu(k,1778) - lu(k,1781) = lu(k,1781) - lu(k,1510) * lu(k,1778) - lu(k,1782) = lu(k,1782) - lu(k,1511) * lu(k,1778) - lu(k,1783) = lu(k,1783) - lu(k,1512) * lu(k,1778) - lu(k,1784) = lu(k,1784) - lu(k,1513) * lu(k,1778) - lu(k,1785) = lu(k,1785) - lu(k,1514) * lu(k,1778) - lu(k,1786) = lu(k,1786) - lu(k,1515) * lu(k,1778) - lu(k,1787) = lu(k,1787) - lu(k,1516) * lu(k,1778) - lu(k,1788) = lu(k,1788) - lu(k,1517) * lu(k,1778) - lu(k,1789) = lu(k,1789) - lu(k,1518) * lu(k,1778) - lu(k,1790) = lu(k,1790) - lu(k,1519) * lu(k,1778) - lu(k,1791) = lu(k,1791) - lu(k,1520) * lu(k,1778) - lu(k,1792) = lu(k,1792) - lu(k,1521) * lu(k,1778) - lu(k,1820) = lu(k,1820) - lu(k,1508) * lu(k,1819) - lu(k,1821) = lu(k,1821) - lu(k,1509) * lu(k,1819) - lu(k,1822) = lu(k,1822) - lu(k,1510) * lu(k,1819) - lu(k,1823) = lu(k,1823) - lu(k,1511) * lu(k,1819) - lu(k,1824) = lu(k,1824) - lu(k,1512) * lu(k,1819) - lu(k,1825) = lu(k,1825) - lu(k,1513) * lu(k,1819) - lu(k,1826) = lu(k,1826) - lu(k,1514) * lu(k,1819) - lu(k,1827) = lu(k,1827) - lu(k,1515) * lu(k,1819) - lu(k,1828) = lu(k,1828) - lu(k,1516) * lu(k,1819) - lu(k,1829) = lu(k,1829) - lu(k,1517) * lu(k,1819) - lu(k,1830) = lu(k,1830) - lu(k,1518) * lu(k,1819) - lu(k,1831) = lu(k,1831) - lu(k,1519) * lu(k,1819) - lu(k,1832) = lu(k,1832) - lu(k,1520) * lu(k,1819) - lu(k,1833) = lu(k,1833) - lu(k,1521) * lu(k,1819) - lu(k,1844) = lu(k,1844) - lu(k,1508) * lu(k,1843) - lu(k,1845) = lu(k,1845) - lu(k,1509) * lu(k,1843) - lu(k,1846) = lu(k,1846) - lu(k,1510) * lu(k,1843) - lu(k,1847) = lu(k,1847) - lu(k,1511) * lu(k,1843) - lu(k,1848) = lu(k,1848) - lu(k,1512) * lu(k,1843) - lu(k,1849) = lu(k,1849) - lu(k,1513) * lu(k,1843) - lu(k,1850) = lu(k,1850) - lu(k,1514) * lu(k,1843) - lu(k,1851) = lu(k,1851) - lu(k,1515) * lu(k,1843) - lu(k,1852) = lu(k,1852) - lu(k,1516) * lu(k,1843) - lu(k,1853) = lu(k,1853) - lu(k,1517) * lu(k,1843) - lu(k,1854) = lu(k,1854) - lu(k,1518) * lu(k,1843) - lu(k,1855) = lu(k,1855) - lu(k,1519) * lu(k,1843) - lu(k,1856) = lu(k,1856) - lu(k,1520) * lu(k,1843) - lu(k,1857) = lu(k,1857) - lu(k,1521) * lu(k,1843) - lu(k,1901) = lu(k,1901) - lu(k,1508) * lu(k,1900) - lu(k,1902) = lu(k,1902) - lu(k,1509) * lu(k,1900) - lu(k,1903) = lu(k,1903) - lu(k,1510) * lu(k,1900) - lu(k,1904) = lu(k,1904) - lu(k,1511) * lu(k,1900) - lu(k,1905) = lu(k,1905) - lu(k,1512) * lu(k,1900) - lu(k,1906) = lu(k,1906) - lu(k,1513) * lu(k,1900) - lu(k,1907) = lu(k,1907) - lu(k,1514) * lu(k,1900) - lu(k,1908) = lu(k,1908) - lu(k,1515) * lu(k,1900) - lu(k,1909) = lu(k,1909) - lu(k,1516) * lu(k,1900) - lu(k,1910) = lu(k,1910) - lu(k,1517) * lu(k,1900) - lu(k,1911) = lu(k,1911) - lu(k,1518) * lu(k,1900) - lu(k,1912) = lu(k,1912) - lu(k,1519) * lu(k,1900) - lu(k,1913) = lu(k,1913) - lu(k,1520) * lu(k,1900) - lu(k,1914) = lu(k,1914) - lu(k,1521) * lu(k,1900) - lu(k,1921) = lu(k,1921) - lu(k,1508) * lu(k,1920) - lu(k,1922) = lu(k,1922) - lu(k,1509) * lu(k,1920) - lu(k,1923) = lu(k,1923) - lu(k,1510) * lu(k,1920) - lu(k,1924) = lu(k,1924) - lu(k,1511) * lu(k,1920) - lu(k,1925) = lu(k,1925) - lu(k,1512) * lu(k,1920) - lu(k,1926) = lu(k,1926) - lu(k,1513) * lu(k,1920) - lu(k,1927) = lu(k,1927) - lu(k,1514) * lu(k,1920) - lu(k,1928) = lu(k,1928) - lu(k,1515) * lu(k,1920) - lu(k,1929) = lu(k,1929) - lu(k,1516) * lu(k,1920) - lu(k,1930) = lu(k,1930) - lu(k,1517) * lu(k,1920) - lu(k,1931) = lu(k,1931) - lu(k,1518) * lu(k,1920) - lu(k,1932) = lu(k,1932) - lu(k,1519) * lu(k,1920) - lu(k,1933) = lu(k,1933) - lu(k,1520) * lu(k,1920) - lu(k,1934) = lu(k,1934) - lu(k,1521) * lu(k,1920) - lu(k,1943) = lu(k,1943) - lu(k,1508) * lu(k,1942) - lu(k,1944) = lu(k,1944) - lu(k,1509) * lu(k,1942) - lu(k,1945) = lu(k,1945) - lu(k,1510) * lu(k,1942) - lu(k,1946) = lu(k,1946) - lu(k,1511) * lu(k,1942) - lu(k,1947) = lu(k,1947) - lu(k,1512) * lu(k,1942) - lu(k,1948) = lu(k,1948) - lu(k,1513) * lu(k,1942) - lu(k,1949) = lu(k,1949) - lu(k,1514) * lu(k,1942) - lu(k,1950) = lu(k,1950) - lu(k,1515) * lu(k,1942) - lu(k,1951) = lu(k,1951) - lu(k,1516) * lu(k,1942) - lu(k,1952) = lu(k,1952) - lu(k,1517) * lu(k,1942) - lu(k,1953) = lu(k,1953) - lu(k,1518) * lu(k,1942) - lu(k,1954) = lu(k,1954) - lu(k,1519) * lu(k,1942) - lu(k,1955) = lu(k,1955) - lu(k,1520) * lu(k,1942) - lu(k,1956) = lu(k,1956) - lu(k,1521) * lu(k,1942) - lu(k,1985) = lu(k,1985) - lu(k,1508) * lu(k,1984) - lu(k,1986) = lu(k,1986) - lu(k,1509) * lu(k,1984) - lu(k,1987) = lu(k,1987) - lu(k,1510) * lu(k,1984) - lu(k,1988) = lu(k,1988) - lu(k,1511) * lu(k,1984) - lu(k,1989) = lu(k,1989) - lu(k,1512) * lu(k,1984) - lu(k,1990) = lu(k,1990) - lu(k,1513) * lu(k,1984) - lu(k,1991) = lu(k,1991) - lu(k,1514) * lu(k,1984) - lu(k,1992) = lu(k,1992) - lu(k,1515) * lu(k,1984) - lu(k,1993) = lu(k,1993) - lu(k,1516) * lu(k,1984) - lu(k,1994) = lu(k,1994) - lu(k,1517) * lu(k,1984) - lu(k,1995) = lu(k,1995) - lu(k,1518) * lu(k,1984) - lu(k,1996) = lu(k,1996) - lu(k,1519) * lu(k,1984) - lu(k,1997) = lu(k,1997) - lu(k,1520) * lu(k,1984) - lu(k,1998) = lu(k,1998) - lu(k,1521) * lu(k,1984) - lu(k,2009) = lu(k,2009) - lu(k,1508) * lu(k,2008) - lu(k,2010) = lu(k,2010) - lu(k,1509) * lu(k,2008) - lu(k,2011) = lu(k,2011) - lu(k,1510) * lu(k,2008) - lu(k,2012) = lu(k,2012) - lu(k,1511) * lu(k,2008) - lu(k,2013) = lu(k,2013) - lu(k,1512) * lu(k,2008) - lu(k,2014) = lu(k,2014) - lu(k,1513) * lu(k,2008) - lu(k,2015) = lu(k,2015) - lu(k,1514) * lu(k,2008) - lu(k,2016) = lu(k,2016) - lu(k,1515) * lu(k,2008) - lu(k,2017) = lu(k,2017) - lu(k,1516) * lu(k,2008) - lu(k,2018) = lu(k,2018) - lu(k,1517) * lu(k,2008) - lu(k,2019) = lu(k,2019) - lu(k,1518) * lu(k,2008) - lu(k,2020) = lu(k,2020) - lu(k,1519) * lu(k,2008) - lu(k,2021) = lu(k,2021) - lu(k,1520) * lu(k,2008) - lu(k,2022) = lu(k,2022) - lu(k,1521) * lu(k,2008) - lu(k,2104) = lu(k,2104) - lu(k,1508) * lu(k,2103) - lu(k,2105) = lu(k,2105) - lu(k,1509) * lu(k,2103) - lu(k,2106) = lu(k,2106) - lu(k,1510) * lu(k,2103) - lu(k,2107) = lu(k,2107) - lu(k,1511) * lu(k,2103) - lu(k,2108) = lu(k,2108) - lu(k,1512) * lu(k,2103) - lu(k,2109) = lu(k,2109) - lu(k,1513) * lu(k,2103) - lu(k,2110) = lu(k,2110) - lu(k,1514) * lu(k,2103) - lu(k,2111) = lu(k,2111) - lu(k,1515) * lu(k,2103) - lu(k,2112) = lu(k,2112) - lu(k,1516) * lu(k,2103) - lu(k,2113) = lu(k,2113) - lu(k,1517) * lu(k,2103) - lu(k,2114) = lu(k,2114) - lu(k,1518) * lu(k,2103) - lu(k,2115) = lu(k,2115) - lu(k,1519) * lu(k,2103) - lu(k,2116) = lu(k,2116) - lu(k,1520) * lu(k,2103) - lu(k,2117) = lu(k,2117) - lu(k,1521) * lu(k,2103) - lu(k,2131) = lu(k,2131) - lu(k,1508) * lu(k,2130) - lu(k,2132) = lu(k,2132) - lu(k,1509) * lu(k,2130) - lu(k,2133) = lu(k,2133) - lu(k,1510) * lu(k,2130) - lu(k,2134) = lu(k,2134) - lu(k,1511) * lu(k,2130) - lu(k,2135) = lu(k,2135) - lu(k,1512) * lu(k,2130) - lu(k,2136) = lu(k,2136) - lu(k,1513) * lu(k,2130) - lu(k,2137) = lu(k,2137) - lu(k,1514) * lu(k,2130) - lu(k,2138) = lu(k,2138) - lu(k,1515) * lu(k,2130) - lu(k,2139) = lu(k,2139) - lu(k,1516) * lu(k,2130) - lu(k,2140) = lu(k,2140) - lu(k,1517) * lu(k,2130) - lu(k,2141) = lu(k,2141) - lu(k,1518) * lu(k,2130) - lu(k,2142) = lu(k,2142) - lu(k,1519) * lu(k,2130) - lu(k,2143) = lu(k,2143) - lu(k,1520) * lu(k,2130) - lu(k,2144) = lu(k,2144) - lu(k,1521) * lu(k,2130) - lu(k,2157) = lu(k,2157) - lu(k,1508) * lu(k,2156) - lu(k,2158) = lu(k,2158) - lu(k,1509) * lu(k,2156) - lu(k,2159) = lu(k,2159) - lu(k,1510) * lu(k,2156) - lu(k,2160) = lu(k,2160) - lu(k,1511) * lu(k,2156) - lu(k,2161) = lu(k,2161) - lu(k,1512) * lu(k,2156) - lu(k,2162) = lu(k,2162) - lu(k,1513) * lu(k,2156) - lu(k,2163) = lu(k,2163) - lu(k,1514) * lu(k,2156) - lu(k,2164) = lu(k,2164) - lu(k,1515) * lu(k,2156) - lu(k,2165) = lu(k,2165) - lu(k,1516) * lu(k,2156) - lu(k,2166) = lu(k,2166) - lu(k,1517) * lu(k,2156) - lu(k,2167) = lu(k,2167) - lu(k,1518) * lu(k,2156) - lu(k,2168) = lu(k,2168) - lu(k,1519) * lu(k,2156) - lu(k,2169) = lu(k,2169) - lu(k,1520) * lu(k,2156) - lu(k,2170) = lu(k,2170) - lu(k,1521) * lu(k,2156) - lu(k,1543) = 1._r8 / lu(k,1543) - lu(k,1544) = lu(k,1544) * lu(k,1543) - lu(k,1545) = lu(k,1545) * lu(k,1543) - lu(k,1546) = lu(k,1546) * lu(k,1543) - lu(k,1547) = lu(k,1547) * lu(k,1543) - lu(k,1548) = lu(k,1548) * lu(k,1543) - lu(k,1549) = lu(k,1549) * lu(k,1543) - lu(k,1550) = lu(k,1550) * lu(k,1543) - lu(k,1551) = lu(k,1551) * lu(k,1543) - lu(k,1552) = lu(k,1552) * lu(k,1543) - lu(k,1553) = lu(k,1553) * lu(k,1543) - lu(k,1554) = lu(k,1554) * lu(k,1543) - lu(k,1555) = lu(k,1555) * lu(k,1543) - lu(k,1556) = lu(k,1556) * lu(k,1543) - lu(k,1570) = lu(k,1570) - lu(k,1544) * lu(k,1569) - lu(k,1571) = lu(k,1571) - lu(k,1545) * lu(k,1569) - lu(k,1572) = lu(k,1572) - lu(k,1546) * lu(k,1569) - lu(k,1573) = lu(k,1573) - lu(k,1547) * lu(k,1569) - lu(k,1574) = lu(k,1574) - lu(k,1548) * lu(k,1569) - lu(k,1575) = lu(k,1575) - lu(k,1549) * lu(k,1569) - lu(k,1576) = lu(k,1576) - lu(k,1550) * lu(k,1569) - lu(k,1577) = lu(k,1577) - lu(k,1551) * lu(k,1569) - lu(k,1578) = lu(k,1578) - lu(k,1552) * lu(k,1569) - lu(k,1579) = lu(k,1579) - lu(k,1553) * lu(k,1569) - lu(k,1580) = lu(k,1580) - lu(k,1554) * lu(k,1569) - lu(k,1581) = lu(k,1581) - lu(k,1555) * lu(k,1569) - lu(k,1582) = lu(k,1582) - lu(k,1556) * lu(k,1569) - lu(k,1718) = lu(k,1718) - lu(k,1544) * lu(k,1717) - lu(k,1719) = lu(k,1719) - lu(k,1545) * lu(k,1717) - lu(k,1720) = lu(k,1720) - lu(k,1546) * lu(k,1717) - lu(k,1721) = lu(k,1721) - lu(k,1547) * lu(k,1717) - lu(k,1722) = lu(k,1722) - lu(k,1548) * lu(k,1717) - lu(k,1723) = lu(k,1723) - lu(k,1549) * lu(k,1717) - lu(k,1724) = lu(k,1724) - lu(k,1550) * lu(k,1717) - lu(k,1725) = lu(k,1725) - lu(k,1551) * lu(k,1717) - lu(k,1726) = lu(k,1726) - lu(k,1552) * lu(k,1717) - lu(k,1727) = lu(k,1727) - lu(k,1553) * lu(k,1717) - lu(k,1728) = lu(k,1728) - lu(k,1554) * lu(k,1717) - lu(k,1729) = lu(k,1729) - lu(k,1555) * lu(k,1717) - lu(k,1730) = lu(k,1730) - lu(k,1556) * lu(k,1717) - lu(k,1780) = lu(k,1780) - lu(k,1544) * lu(k,1779) - lu(k,1781) = lu(k,1781) - lu(k,1545) * lu(k,1779) - lu(k,1782) = lu(k,1782) - lu(k,1546) * lu(k,1779) - lu(k,1783) = lu(k,1783) - lu(k,1547) * lu(k,1779) - lu(k,1784) = lu(k,1784) - lu(k,1548) * lu(k,1779) - lu(k,1785) = lu(k,1785) - lu(k,1549) * lu(k,1779) - lu(k,1786) = lu(k,1786) - lu(k,1550) * lu(k,1779) - lu(k,1787) = lu(k,1787) - lu(k,1551) * lu(k,1779) - lu(k,1788) = lu(k,1788) - lu(k,1552) * lu(k,1779) - lu(k,1789) = lu(k,1789) - lu(k,1553) * lu(k,1779) - lu(k,1790) = lu(k,1790) - lu(k,1554) * lu(k,1779) - lu(k,1791) = lu(k,1791) - lu(k,1555) * lu(k,1779) - lu(k,1792) = lu(k,1792) - lu(k,1556) * lu(k,1779) - lu(k,1821) = lu(k,1821) - lu(k,1544) * lu(k,1820) - lu(k,1822) = lu(k,1822) - lu(k,1545) * lu(k,1820) - lu(k,1823) = lu(k,1823) - lu(k,1546) * lu(k,1820) - lu(k,1824) = lu(k,1824) - lu(k,1547) * lu(k,1820) - lu(k,1825) = lu(k,1825) - lu(k,1548) * lu(k,1820) - lu(k,1826) = lu(k,1826) - lu(k,1549) * lu(k,1820) - lu(k,1827) = lu(k,1827) - lu(k,1550) * lu(k,1820) - lu(k,1828) = lu(k,1828) - lu(k,1551) * lu(k,1820) - lu(k,1829) = lu(k,1829) - lu(k,1552) * lu(k,1820) - lu(k,1830) = lu(k,1830) - lu(k,1553) * lu(k,1820) - lu(k,1831) = lu(k,1831) - lu(k,1554) * lu(k,1820) - lu(k,1832) = lu(k,1832) - lu(k,1555) * lu(k,1820) - lu(k,1833) = lu(k,1833) - lu(k,1556) * lu(k,1820) - lu(k,1845) = lu(k,1845) - lu(k,1544) * lu(k,1844) - lu(k,1846) = lu(k,1846) - lu(k,1545) * lu(k,1844) - lu(k,1847) = lu(k,1847) - lu(k,1546) * lu(k,1844) - lu(k,1848) = lu(k,1848) - lu(k,1547) * lu(k,1844) - lu(k,1849) = lu(k,1849) - lu(k,1548) * lu(k,1844) - lu(k,1850) = lu(k,1850) - lu(k,1549) * lu(k,1844) - lu(k,1851) = lu(k,1851) - lu(k,1550) * lu(k,1844) - lu(k,1852) = lu(k,1852) - lu(k,1551) * lu(k,1844) - lu(k,1853) = lu(k,1853) - lu(k,1552) * lu(k,1844) - lu(k,1854) = lu(k,1854) - lu(k,1553) * lu(k,1844) - lu(k,1855) = lu(k,1855) - lu(k,1554) * lu(k,1844) - lu(k,1856) = lu(k,1856) - lu(k,1555) * lu(k,1844) - lu(k,1857) = lu(k,1857) - lu(k,1556) * lu(k,1844) - lu(k,1902) = lu(k,1902) - lu(k,1544) * lu(k,1901) - lu(k,1903) = lu(k,1903) - lu(k,1545) * lu(k,1901) - lu(k,1904) = lu(k,1904) - lu(k,1546) * lu(k,1901) - lu(k,1905) = lu(k,1905) - lu(k,1547) * lu(k,1901) - lu(k,1906) = lu(k,1906) - lu(k,1548) * lu(k,1901) - lu(k,1907) = lu(k,1907) - lu(k,1549) * lu(k,1901) - lu(k,1908) = lu(k,1908) - lu(k,1550) * lu(k,1901) - lu(k,1909) = lu(k,1909) - lu(k,1551) * lu(k,1901) - lu(k,1910) = lu(k,1910) - lu(k,1552) * lu(k,1901) - lu(k,1911) = lu(k,1911) - lu(k,1553) * lu(k,1901) - lu(k,1912) = lu(k,1912) - lu(k,1554) * lu(k,1901) - lu(k,1913) = lu(k,1913) - lu(k,1555) * lu(k,1901) - lu(k,1914) = lu(k,1914) - lu(k,1556) * lu(k,1901) - lu(k,1922) = lu(k,1922) - lu(k,1544) * lu(k,1921) - lu(k,1923) = lu(k,1923) - lu(k,1545) * lu(k,1921) - lu(k,1924) = lu(k,1924) - lu(k,1546) * lu(k,1921) - lu(k,1925) = lu(k,1925) - lu(k,1547) * lu(k,1921) - lu(k,1926) = lu(k,1926) - lu(k,1548) * lu(k,1921) - lu(k,1927) = lu(k,1927) - lu(k,1549) * lu(k,1921) - lu(k,1928) = lu(k,1928) - lu(k,1550) * lu(k,1921) - lu(k,1929) = lu(k,1929) - lu(k,1551) * lu(k,1921) - lu(k,1930) = lu(k,1930) - lu(k,1552) * lu(k,1921) - lu(k,1931) = lu(k,1931) - lu(k,1553) * lu(k,1921) - lu(k,1932) = lu(k,1932) - lu(k,1554) * lu(k,1921) - lu(k,1933) = lu(k,1933) - lu(k,1555) * lu(k,1921) - lu(k,1934) = lu(k,1934) - lu(k,1556) * lu(k,1921) - lu(k,1944) = lu(k,1944) - lu(k,1544) * lu(k,1943) - lu(k,1945) = lu(k,1945) - lu(k,1545) * lu(k,1943) - lu(k,1946) = lu(k,1946) - lu(k,1546) * lu(k,1943) - lu(k,1947) = lu(k,1947) - lu(k,1547) * lu(k,1943) - lu(k,1948) = lu(k,1948) - lu(k,1548) * lu(k,1943) - lu(k,1949) = lu(k,1949) - lu(k,1549) * lu(k,1943) - lu(k,1950) = lu(k,1950) - lu(k,1550) * lu(k,1943) - lu(k,1951) = lu(k,1951) - lu(k,1551) * lu(k,1943) - lu(k,1952) = lu(k,1952) - lu(k,1552) * lu(k,1943) - lu(k,1953) = lu(k,1953) - lu(k,1553) * lu(k,1943) - lu(k,1954) = lu(k,1954) - lu(k,1554) * lu(k,1943) - lu(k,1955) = lu(k,1955) - lu(k,1555) * lu(k,1943) - lu(k,1956) = lu(k,1956) - lu(k,1556) * lu(k,1943) - lu(k,1986) = lu(k,1986) - lu(k,1544) * lu(k,1985) - lu(k,1987) = lu(k,1987) - lu(k,1545) * lu(k,1985) - lu(k,1988) = lu(k,1988) - lu(k,1546) * lu(k,1985) - lu(k,1989) = lu(k,1989) - lu(k,1547) * lu(k,1985) - lu(k,1990) = lu(k,1990) - lu(k,1548) * lu(k,1985) - lu(k,1991) = lu(k,1991) - lu(k,1549) * lu(k,1985) - lu(k,1992) = lu(k,1992) - lu(k,1550) * lu(k,1985) - lu(k,1993) = lu(k,1993) - lu(k,1551) * lu(k,1985) - lu(k,1994) = lu(k,1994) - lu(k,1552) * lu(k,1985) - lu(k,1995) = lu(k,1995) - lu(k,1553) * lu(k,1985) - lu(k,1996) = lu(k,1996) - lu(k,1554) * lu(k,1985) - lu(k,1997) = lu(k,1997) - lu(k,1555) * lu(k,1985) - lu(k,1998) = lu(k,1998) - lu(k,1556) * lu(k,1985) - lu(k,2010) = lu(k,2010) - lu(k,1544) * lu(k,2009) - lu(k,2011) = lu(k,2011) - lu(k,1545) * lu(k,2009) - lu(k,2012) = lu(k,2012) - lu(k,1546) * lu(k,2009) - lu(k,2013) = lu(k,2013) - lu(k,1547) * lu(k,2009) - lu(k,2014) = lu(k,2014) - lu(k,1548) * lu(k,2009) - lu(k,2015) = lu(k,2015) - lu(k,1549) * lu(k,2009) - lu(k,2016) = lu(k,2016) - lu(k,1550) * lu(k,2009) - lu(k,2017) = lu(k,2017) - lu(k,1551) * lu(k,2009) - lu(k,2018) = lu(k,2018) - lu(k,1552) * lu(k,2009) - lu(k,2019) = lu(k,2019) - lu(k,1553) * lu(k,2009) - lu(k,2020) = lu(k,2020) - lu(k,1554) * lu(k,2009) - lu(k,2021) = lu(k,2021) - lu(k,1555) * lu(k,2009) - lu(k,2022) = lu(k,2022) - lu(k,1556) * lu(k,2009) - lu(k,2105) = lu(k,2105) - lu(k,1544) * lu(k,2104) - lu(k,2106) = lu(k,2106) - lu(k,1545) * lu(k,2104) - lu(k,2107) = lu(k,2107) - lu(k,1546) * lu(k,2104) - lu(k,2108) = lu(k,2108) - lu(k,1547) * lu(k,2104) - lu(k,2109) = lu(k,2109) - lu(k,1548) * lu(k,2104) - lu(k,2110) = lu(k,2110) - lu(k,1549) * lu(k,2104) - lu(k,2111) = lu(k,2111) - lu(k,1550) * lu(k,2104) - lu(k,2112) = lu(k,2112) - lu(k,1551) * lu(k,2104) - lu(k,2113) = lu(k,2113) - lu(k,1552) * lu(k,2104) - lu(k,2114) = lu(k,2114) - lu(k,1553) * lu(k,2104) - lu(k,2115) = lu(k,2115) - lu(k,1554) * lu(k,2104) - lu(k,2116) = lu(k,2116) - lu(k,1555) * lu(k,2104) - lu(k,2117) = lu(k,2117) - lu(k,1556) * lu(k,2104) - lu(k,2132) = lu(k,2132) - lu(k,1544) * lu(k,2131) - lu(k,2133) = lu(k,2133) - lu(k,1545) * lu(k,2131) - lu(k,2134) = lu(k,2134) - lu(k,1546) * lu(k,2131) - lu(k,2135) = lu(k,2135) - lu(k,1547) * lu(k,2131) - lu(k,2136) = lu(k,2136) - lu(k,1548) * lu(k,2131) - lu(k,2137) = lu(k,2137) - lu(k,1549) * lu(k,2131) - lu(k,2138) = lu(k,2138) - lu(k,1550) * lu(k,2131) - lu(k,2139) = lu(k,2139) - lu(k,1551) * lu(k,2131) - lu(k,2140) = lu(k,2140) - lu(k,1552) * lu(k,2131) - lu(k,2141) = lu(k,2141) - lu(k,1553) * lu(k,2131) - lu(k,2142) = lu(k,2142) - lu(k,1554) * lu(k,2131) - lu(k,2143) = lu(k,2143) - lu(k,1555) * lu(k,2131) - lu(k,2144) = lu(k,2144) - lu(k,1556) * lu(k,2131) - lu(k,2158) = lu(k,2158) - lu(k,1544) * lu(k,2157) - lu(k,2159) = lu(k,2159) - lu(k,1545) * lu(k,2157) - lu(k,2160) = lu(k,2160) - lu(k,1546) * lu(k,2157) - lu(k,2161) = lu(k,2161) - lu(k,1547) * lu(k,2157) - lu(k,2162) = lu(k,2162) - lu(k,1548) * lu(k,2157) - lu(k,2163) = lu(k,2163) - lu(k,1549) * lu(k,2157) - lu(k,2164) = lu(k,2164) - lu(k,1550) * lu(k,2157) - lu(k,2165) = lu(k,2165) - lu(k,1551) * lu(k,2157) - lu(k,2166) = lu(k,2166) - lu(k,1552) * lu(k,2157) - lu(k,2167) = lu(k,2167) - lu(k,1553) * lu(k,2157) - lu(k,2168) = lu(k,2168) - lu(k,1554) * lu(k,2157) - lu(k,2169) = lu(k,2169) - lu(k,1555) * lu(k,2157) - lu(k,2170) = lu(k,2170) - lu(k,1556) * lu(k,2157) - lu(k,1570) = 1._r8 / lu(k,1570) - lu(k,1571) = lu(k,1571) * lu(k,1570) - lu(k,1572) = lu(k,1572) * lu(k,1570) - lu(k,1573) = lu(k,1573) * lu(k,1570) - lu(k,1574) = lu(k,1574) * lu(k,1570) - lu(k,1575) = lu(k,1575) * lu(k,1570) - lu(k,1576) = lu(k,1576) * lu(k,1570) - lu(k,1577) = lu(k,1577) * lu(k,1570) - lu(k,1578) = lu(k,1578) * lu(k,1570) - lu(k,1579) = lu(k,1579) * lu(k,1570) - lu(k,1580) = lu(k,1580) * lu(k,1570) - lu(k,1581) = lu(k,1581) * lu(k,1570) - lu(k,1582) = lu(k,1582) * lu(k,1570) - lu(k,1719) = lu(k,1719) - lu(k,1571) * lu(k,1718) - lu(k,1720) = lu(k,1720) - lu(k,1572) * lu(k,1718) - lu(k,1721) = lu(k,1721) - lu(k,1573) * lu(k,1718) - lu(k,1722) = lu(k,1722) - lu(k,1574) * lu(k,1718) - lu(k,1723) = lu(k,1723) - lu(k,1575) * lu(k,1718) - lu(k,1724) = lu(k,1724) - lu(k,1576) * lu(k,1718) - lu(k,1725) = lu(k,1725) - lu(k,1577) * lu(k,1718) - lu(k,1726) = lu(k,1726) - lu(k,1578) * lu(k,1718) - lu(k,1727) = lu(k,1727) - lu(k,1579) * lu(k,1718) - lu(k,1728) = lu(k,1728) - lu(k,1580) * lu(k,1718) - lu(k,1729) = lu(k,1729) - lu(k,1581) * lu(k,1718) - lu(k,1730) = lu(k,1730) - lu(k,1582) * lu(k,1718) - lu(k,1781) = lu(k,1781) - lu(k,1571) * lu(k,1780) - lu(k,1782) = lu(k,1782) - lu(k,1572) * lu(k,1780) - lu(k,1783) = lu(k,1783) - lu(k,1573) * lu(k,1780) - lu(k,1784) = lu(k,1784) - lu(k,1574) * lu(k,1780) - lu(k,1785) = lu(k,1785) - lu(k,1575) * lu(k,1780) - lu(k,1786) = lu(k,1786) - lu(k,1576) * lu(k,1780) - lu(k,1787) = lu(k,1787) - lu(k,1577) * lu(k,1780) - lu(k,1788) = lu(k,1788) - lu(k,1578) * lu(k,1780) - lu(k,1789) = lu(k,1789) - lu(k,1579) * lu(k,1780) - lu(k,1790) = lu(k,1790) - lu(k,1580) * lu(k,1780) - lu(k,1791) = lu(k,1791) - lu(k,1581) * lu(k,1780) - lu(k,1792) = lu(k,1792) - lu(k,1582) * lu(k,1780) - lu(k,1822) = lu(k,1822) - lu(k,1571) * lu(k,1821) - lu(k,1823) = lu(k,1823) - lu(k,1572) * lu(k,1821) - lu(k,1824) = lu(k,1824) - lu(k,1573) * lu(k,1821) - lu(k,1825) = lu(k,1825) - lu(k,1574) * lu(k,1821) - lu(k,1826) = lu(k,1826) - lu(k,1575) * lu(k,1821) - lu(k,1827) = lu(k,1827) - lu(k,1576) * lu(k,1821) - lu(k,1828) = lu(k,1828) - lu(k,1577) * lu(k,1821) - lu(k,1829) = lu(k,1829) - lu(k,1578) * lu(k,1821) - lu(k,1830) = lu(k,1830) - lu(k,1579) * lu(k,1821) - lu(k,1831) = lu(k,1831) - lu(k,1580) * lu(k,1821) - lu(k,1832) = lu(k,1832) - lu(k,1581) * lu(k,1821) - lu(k,1833) = lu(k,1833) - lu(k,1582) * lu(k,1821) - lu(k,1846) = lu(k,1846) - lu(k,1571) * lu(k,1845) - lu(k,1847) = lu(k,1847) - lu(k,1572) * lu(k,1845) - lu(k,1848) = lu(k,1848) - lu(k,1573) * lu(k,1845) - lu(k,1849) = lu(k,1849) - lu(k,1574) * lu(k,1845) - lu(k,1850) = lu(k,1850) - lu(k,1575) * lu(k,1845) - lu(k,1851) = lu(k,1851) - lu(k,1576) * lu(k,1845) - lu(k,1852) = lu(k,1852) - lu(k,1577) * lu(k,1845) - lu(k,1853) = lu(k,1853) - lu(k,1578) * lu(k,1845) - lu(k,1854) = lu(k,1854) - lu(k,1579) * lu(k,1845) - lu(k,1855) = lu(k,1855) - lu(k,1580) * lu(k,1845) - lu(k,1856) = lu(k,1856) - lu(k,1581) * lu(k,1845) - lu(k,1857) = lu(k,1857) - lu(k,1582) * lu(k,1845) - lu(k,1903) = lu(k,1903) - lu(k,1571) * lu(k,1902) - lu(k,1904) = lu(k,1904) - lu(k,1572) * lu(k,1902) - lu(k,1905) = lu(k,1905) - lu(k,1573) * lu(k,1902) - lu(k,1906) = lu(k,1906) - lu(k,1574) * lu(k,1902) - lu(k,1907) = lu(k,1907) - lu(k,1575) * lu(k,1902) - lu(k,1908) = lu(k,1908) - lu(k,1576) * lu(k,1902) - lu(k,1909) = lu(k,1909) - lu(k,1577) * lu(k,1902) - lu(k,1910) = lu(k,1910) - lu(k,1578) * lu(k,1902) - lu(k,1911) = lu(k,1911) - lu(k,1579) * lu(k,1902) - lu(k,1912) = lu(k,1912) - lu(k,1580) * lu(k,1902) - lu(k,1913) = lu(k,1913) - lu(k,1581) * lu(k,1902) - lu(k,1914) = lu(k,1914) - lu(k,1582) * lu(k,1902) - lu(k,1923) = lu(k,1923) - lu(k,1571) * lu(k,1922) - lu(k,1924) = lu(k,1924) - lu(k,1572) * lu(k,1922) - lu(k,1925) = lu(k,1925) - lu(k,1573) * lu(k,1922) - lu(k,1926) = lu(k,1926) - lu(k,1574) * lu(k,1922) - lu(k,1927) = lu(k,1927) - lu(k,1575) * lu(k,1922) - lu(k,1928) = lu(k,1928) - lu(k,1576) * lu(k,1922) - lu(k,1929) = lu(k,1929) - lu(k,1577) * lu(k,1922) - lu(k,1930) = lu(k,1930) - lu(k,1578) * lu(k,1922) - lu(k,1931) = lu(k,1931) - lu(k,1579) * lu(k,1922) - lu(k,1932) = lu(k,1932) - lu(k,1580) * lu(k,1922) - lu(k,1933) = lu(k,1933) - lu(k,1581) * lu(k,1922) - lu(k,1934) = lu(k,1934) - lu(k,1582) * lu(k,1922) - lu(k,1945) = lu(k,1945) - lu(k,1571) * lu(k,1944) - lu(k,1946) = lu(k,1946) - lu(k,1572) * lu(k,1944) - lu(k,1947) = lu(k,1947) - lu(k,1573) * lu(k,1944) - lu(k,1948) = lu(k,1948) - lu(k,1574) * lu(k,1944) - lu(k,1949) = lu(k,1949) - lu(k,1575) * lu(k,1944) - lu(k,1950) = lu(k,1950) - lu(k,1576) * lu(k,1944) - lu(k,1951) = lu(k,1951) - lu(k,1577) * lu(k,1944) - lu(k,1952) = lu(k,1952) - lu(k,1578) * lu(k,1944) - lu(k,1953) = lu(k,1953) - lu(k,1579) * lu(k,1944) - lu(k,1954) = lu(k,1954) - lu(k,1580) * lu(k,1944) - lu(k,1955) = lu(k,1955) - lu(k,1581) * lu(k,1944) - lu(k,1956) = lu(k,1956) - lu(k,1582) * lu(k,1944) - lu(k,1987) = lu(k,1987) - lu(k,1571) * lu(k,1986) - lu(k,1988) = lu(k,1988) - lu(k,1572) * lu(k,1986) - lu(k,1989) = lu(k,1989) - lu(k,1573) * lu(k,1986) - lu(k,1990) = lu(k,1990) - lu(k,1574) * lu(k,1986) - lu(k,1991) = lu(k,1991) - lu(k,1575) * lu(k,1986) - lu(k,1992) = lu(k,1992) - lu(k,1576) * lu(k,1986) - lu(k,1993) = lu(k,1993) - lu(k,1577) * lu(k,1986) - lu(k,1994) = lu(k,1994) - lu(k,1578) * lu(k,1986) - lu(k,1995) = lu(k,1995) - lu(k,1579) * lu(k,1986) - lu(k,1996) = lu(k,1996) - lu(k,1580) * lu(k,1986) - lu(k,1997) = lu(k,1997) - lu(k,1581) * lu(k,1986) - lu(k,1998) = lu(k,1998) - lu(k,1582) * lu(k,1986) - lu(k,2011) = lu(k,2011) - lu(k,1571) * lu(k,2010) - lu(k,2012) = lu(k,2012) - lu(k,1572) * lu(k,2010) - lu(k,2013) = lu(k,2013) - lu(k,1573) * lu(k,2010) - lu(k,2014) = lu(k,2014) - lu(k,1574) * lu(k,2010) - lu(k,2015) = lu(k,2015) - lu(k,1575) * lu(k,2010) - lu(k,2016) = lu(k,2016) - lu(k,1576) * lu(k,2010) - lu(k,2017) = lu(k,2017) - lu(k,1577) * lu(k,2010) - lu(k,2018) = lu(k,2018) - lu(k,1578) * lu(k,2010) - lu(k,2019) = lu(k,2019) - lu(k,1579) * lu(k,2010) - lu(k,2020) = lu(k,2020) - lu(k,1580) * lu(k,2010) - lu(k,2021) = lu(k,2021) - lu(k,1581) * lu(k,2010) - lu(k,2022) = lu(k,2022) - lu(k,1582) * lu(k,2010) - lu(k,2106) = lu(k,2106) - lu(k,1571) * lu(k,2105) - lu(k,2107) = lu(k,2107) - lu(k,1572) * lu(k,2105) - lu(k,2108) = lu(k,2108) - lu(k,1573) * lu(k,2105) - lu(k,2109) = lu(k,2109) - lu(k,1574) * lu(k,2105) - lu(k,2110) = lu(k,2110) - lu(k,1575) * lu(k,2105) - lu(k,2111) = lu(k,2111) - lu(k,1576) * lu(k,2105) - lu(k,2112) = lu(k,2112) - lu(k,1577) * lu(k,2105) - lu(k,2113) = lu(k,2113) - lu(k,1578) * lu(k,2105) - lu(k,2114) = lu(k,2114) - lu(k,1579) * lu(k,2105) - lu(k,2115) = lu(k,2115) - lu(k,1580) * lu(k,2105) - lu(k,2116) = lu(k,2116) - lu(k,1581) * lu(k,2105) - lu(k,2117) = lu(k,2117) - lu(k,1582) * lu(k,2105) - lu(k,2133) = lu(k,2133) - lu(k,1571) * lu(k,2132) - lu(k,2134) = lu(k,2134) - lu(k,1572) * lu(k,2132) - lu(k,2135) = lu(k,2135) - lu(k,1573) * lu(k,2132) - lu(k,2136) = lu(k,2136) - lu(k,1574) * lu(k,2132) - lu(k,2137) = lu(k,2137) - lu(k,1575) * lu(k,2132) - lu(k,2138) = lu(k,2138) - lu(k,1576) * lu(k,2132) - lu(k,2139) = lu(k,2139) - lu(k,1577) * lu(k,2132) - lu(k,2140) = lu(k,2140) - lu(k,1578) * lu(k,2132) - lu(k,2141) = lu(k,2141) - lu(k,1579) * lu(k,2132) - lu(k,2142) = lu(k,2142) - lu(k,1580) * lu(k,2132) - lu(k,2143) = lu(k,2143) - lu(k,1581) * lu(k,2132) - lu(k,2144) = lu(k,2144) - lu(k,1582) * lu(k,2132) - lu(k,2159) = lu(k,2159) - lu(k,1571) * lu(k,2158) - lu(k,2160) = lu(k,2160) - lu(k,1572) * lu(k,2158) - lu(k,2161) = lu(k,2161) - lu(k,1573) * lu(k,2158) - lu(k,2162) = lu(k,2162) - lu(k,1574) * lu(k,2158) - lu(k,2163) = lu(k,2163) - lu(k,1575) * lu(k,2158) - lu(k,2164) = lu(k,2164) - lu(k,1576) * lu(k,2158) - lu(k,2165) = lu(k,2165) - lu(k,1577) * lu(k,2158) - lu(k,2166) = lu(k,2166) - lu(k,1578) * lu(k,2158) - lu(k,2167) = lu(k,2167) - lu(k,1579) * lu(k,2158) - lu(k,2168) = lu(k,2168) - lu(k,1580) * lu(k,2158) - lu(k,2169) = lu(k,2169) - lu(k,1581) * lu(k,2158) - lu(k,2170) = lu(k,2170) - lu(k,1582) * lu(k,2158) - lu(k,1719) = 1._r8 / lu(k,1719) - lu(k,1720) = lu(k,1720) * lu(k,1719) - lu(k,1721) = lu(k,1721) * lu(k,1719) - lu(k,1722) = lu(k,1722) * lu(k,1719) - lu(k,1723) = lu(k,1723) * lu(k,1719) - lu(k,1724) = lu(k,1724) * lu(k,1719) - lu(k,1725) = lu(k,1725) * lu(k,1719) - lu(k,1726) = lu(k,1726) * lu(k,1719) - lu(k,1727) = lu(k,1727) * lu(k,1719) - lu(k,1728) = lu(k,1728) * lu(k,1719) - lu(k,1729) = lu(k,1729) * lu(k,1719) - lu(k,1730) = lu(k,1730) * lu(k,1719) - lu(k,1782) = lu(k,1782) - lu(k,1720) * lu(k,1781) - lu(k,1783) = lu(k,1783) - lu(k,1721) * lu(k,1781) - lu(k,1784) = lu(k,1784) - lu(k,1722) * lu(k,1781) - lu(k,1785) = lu(k,1785) - lu(k,1723) * lu(k,1781) - lu(k,1786) = lu(k,1786) - lu(k,1724) * lu(k,1781) - lu(k,1787) = lu(k,1787) - lu(k,1725) * lu(k,1781) - lu(k,1788) = lu(k,1788) - lu(k,1726) * lu(k,1781) - lu(k,1789) = lu(k,1789) - lu(k,1727) * lu(k,1781) - lu(k,1790) = lu(k,1790) - lu(k,1728) * lu(k,1781) - lu(k,1791) = lu(k,1791) - lu(k,1729) * lu(k,1781) - lu(k,1792) = lu(k,1792) - lu(k,1730) * lu(k,1781) - lu(k,1823) = lu(k,1823) - lu(k,1720) * lu(k,1822) - lu(k,1824) = lu(k,1824) - lu(k,1721) * lu(k,1822) - lu(k,1825) = lu(k,1825) - lu(k,1722) * lu(k,1822) - lu(k,1826) = lu(k,1826) - lu(k,1723) * lu(k,1822) - lu(k,1827) = lu(k,1827) - lu(k,1724) * lu(k,1822) - lu(k,1828) = lu(k,1828) - lu(k,1725) * lu(k,1822) - lu(k,1829) = lu(k,1829) - lu(k,1726) * lu(k,1822) - lu(k,1830) = lu(k,1830) - lu(k,1727) * lu(k,1822) - lu(k,1831) = lu(k,1831) - lu(k,1728) * lu(k,1822) - lu(k,1832) = lu(k,1832) - lu(k,1729) * lu(k,1822) - lu(k,1833) = lu(k,1833) - lu(k,1730) * lu(k,1822) - lu(k,1847) = lu(k,1847) - lu(k,1720) * lu(k,1846) - lu(k,1848) = lu(k,1848) - lu(k,1721) * lu(k,1846) - lu(k,1849) = lu(k,1849) - lu(k,1722) * lu(k,1846) - lu(k,1850) = lu(k,1850) - lu(k,1723) * lu(k,1846) - lu(k,1851) = lu(k,1851) - lu(k,1724) * lu(k,1846) - lu(k,1852) = lu(k,1852) - lu(k,1725) * lu(k,1846) - lu(k,1853) = lu(k,1853) - lu(k,1726) * lu(k,1846) - lu(k,1854) = lu(k,1854) - lu(k,1727) * lu(k,1846) - lu(k,1855) = lu(k,1855) - lu(k,1728) * lu(k,1846) - lu(k,1856) = lu(k,1856) - lu(k,1729) * lu(k,1846) - lu(k,1857) = lu(k,1857) - lu(k,1730) * lu(k,1846) - lu(k,1904) = lu(k,1904) - lu(k,1720) * lu(k,1903) - lu(k,1905) = lu(k,1905) - lu(k,1721) * lu(k,1903) - lu(k,1906) = lu(k,1906) - lu(k,1722) * lu(k,1903) - lu(k,1907) = lu(k,1907) - lu(k,1723) * lu(k,1903) - lu(k,1908) = lu(k,1908) - lu(k,1724) * lu(k,1903) - lu(k,1909) = lu(k,1909) - lu(k,1725) * lu(k,1903) - lu(k,1910) = lu(k,1910) - lu(k,1726) * lu(k,1903) - lu(k,1911) = lu(k,1911) - lu(k,1727) * lu(k,1903) - lu(k,1912) = lu(k,1912) - lu(k,1728) * lu(k,1903) - lu(k,1913) = lu(k,1913) - lu(k,1729) * lu(k,1903) - lu(k,1914) = lu(k,1914) - lu(k,1730) * lu(k,1903) - lu(k,1924) = lu(k,1924) - lu(k,1720) * lu(k,1923) - lu(k,1925) = lu(k,1925) - lu(k,1721) * lu(k,1923) - lu(k,1926) = lu(k,1926) - lu(k,1722) * lu(k,1923) - lu(k,1927) = lu(k,1927) - lu(k,1723) * lu(k,1923) - lu(k,1928) = lu(k,1928) - lu(k,1724) * lu(k,1923) - lu(k,1929) = lu(k,1929) - lu(k,1725) * lu(k,1923) - lu(k,1930) = lu(k,1930) - lu(k,1726) * lu(k,1923) - lu(k,1931) = lu(k,1931) - lu(k,1727) * lu(k,1923) - lu(k,1932) = lu(k,1932) - lu(k,1728) * lu(k,1923) - lu(k,1933) = lu(k,1933) - lu(k,1729) * lu(k,1923) - lu(k,1934) = lu(k,1934) - lu(k,1730) * lu(k,1923) - lu(k,1946) = lu(k,1946) - lu(k,1720) * lu(k,1945) - lu(k,1947) = lu(k,1947) - lu(k,1721) * lu(k,1945) - lu(k,1948) = lu(k,1948) - lu(k,1722) * lu(k,1945) - lu(k,1949) = lu(k,1949) - lu(k,1723) * lu(k,1945) - lu(k,1950) = lu(k,1950) - lu(k,1724) * lu(k,1945) - lu(k,1951) = lu(k,1951) - lu(k,1725) * lu(k,1945) - lu(k,1952) = lu(k,1952) - lu(k,1726) * lu(k,1945) - lu(k,1953) = lu(k,1953) - lu(k,1727) * lu(k,1945) - lu(k,1954) = lu(k,1954) - lu(k,1728) * lu(k,1945) - lu(k,1955) = lu(k,1955) - lu(k,1729) * lu(k,1945) - lu(k,1956) = lu(k,1956) - lu(k,1730) * lu(k,1945) - lu(k,1988) = lu(k,1988) - lu(k,1720) * lu(k,1987) - lu(k,1989) = lu(k,1989) - lu(k,1721) * lu(k,1987) - lu(k,1990) = lu(k,1990) - lu(k,1722) * lu(k,1987) - lu(k,1991) = lu(k,1991) - lu(k,1723) * lu(k,1987) - lu(k,1992) = lu(k,1992) - lu(k,1724) * lu(k,1987) - lu(k,1993) = lu(k,1993) - lu(k,1725) * lu(k,1987) - lu(k,1994) = lu(k,1994) - lu(k,1726) * lu(k,1987) - lu(k,1995) = lu(k,1995) - lu(k,1727) * lu(k,1987) - lu(k,1996) = lu(k,1996) - lu(k,1728) * lu(k,1987) - lu(k,1997) = lu(k,1997) - lu(k,1729) * lu(k,1987) - lu(k,1998) = lu(k,1998) - lu(k,1730) * lu(k,1987) - lu(k,2012) = lu(k,2012) - lu(k,1720) * lu(k,2011) - lu(k,2013) = lu(k,2013) - lu(k,1721) * lu(k,2011) - lu(k,2014) = lu(k,2014) - lu(k,1722) * lu(k,2011) - lu(k,2015) = lu(k,2015) - lu(k,1723) * lu(k,2011) - lu(k,2016) = lu(k,2016) - lu(k,1724) * lu(k,2011) - lu(k,2017) = lu(k,2017) - lu(k,1725) * lu(k,2011) - lu(k,2018) = lu(k,2018) - lu(k,1726) * lu(k,2011) - lu(k,2019) = lu(k,2019) - lu(k,1727) * lu(k,2011) - lu(k,2020) = lu(k,2020) - lu(k,1728) * lu(k,2011) - lu(k,2021) = lu(k,2021) - lu(k,1729) * lu(k,2011) - lu(k,2022) = lu(k,2022) - lu(k,1730) * lu(k,2011) - lu(k,2107) = lu(k,2107) - lu(k,1720) * lu(k,2106) - lu(k,2108) = lu(k,2108) - lu(k,1721) * lu(k,2106) - lu(k,2109) = lu(k,2109) - lu(k,1722) * lu(k,2106) - lu(k,2110) = lu(k,2110) - lu(k,1723) * lu(k,2106) - lu(k,2111) = lu(k,2111) - lu(k,1724) * lu(k,2106) - lu(k,2112) = lu(k,2112) - lu(k,1725) * lu(k,2106) - lu(k,2113) = lu(k,2113) - lu(k,1726) * lu(k,2106) - lu(k,2114) = lu(k,2114) - lu(k,1727) * lu(k,2106) - lu(k,2115) = lu(k,2115) - lu(k,1728) * lu(k,2106) - lu(k,2116) = lu(k,2116) - lu(k,1729) * lu(k,2106) - lu(k,2117) = lu(k,2117) - lu(k,1730) * lu(k,2106) - lu(k,2134) = lu(k,2134) - lu(k,1720) * lu(k,2133) - lu(k,2135) = lu(k,2135) - lu(k,1721) * lu(k,2133) - lu(k,2136) = lu(k,2136) - lu(k,1722) * lu(k,2133) - lu(k,2137) = lu(k,2137) - lu(k,1723) * lu(k,2133) - lu(k,2138) = lu(k,2138) - lu(k,1724) * lu(k,2133) - lu(k,2139) = lu(k,2139) - lu(k,1725) * lu(k,2133) - lu(k,2140) = lu(k,2140) - lu(k,1726) * lu(k,2133) - lu(k,2141) = lu(k,2141) - lu(k,1727) * lu(k,2133) - lu(k,2142) = lu(k,2142) - lu(k,1728) * lu(k,2133) - lu(k,2143) = lu(k,2143) - lu(k,1729) * lu(k,2133) - lu(k,2144) = lu(k,2144) - lu(k,1730) * lu(k,2133) - lu(k,2160) = lu(k,2160) - lu(k,1720) * lu(k,2159) - lu(k,2161) = lu(k,2161) - lu(k,1721) * lu(k,2159) - lu(k,2162) = lu(k,2162) - lu(k,1722) * lu(k,2159) - lu(k,2163) = lu(k,2163) - lu(k,1723) * lu(k,2159) - lu(k,2164) = lu(k,2164) - lu(k,1724) * lu(k,2159) - lu(k,2165) = lu(k,2165) - lu(k,1725) * lu(k,2159) - lu(k,2166) = lu(k,2166) - lu(k,1726) * lu(k,2159) - lu(k,2167) = lu(k,2167) - lu(k,1727) * lu(k,2159) - lu(k,2168) = lu(k,2168) - lu(k,1728) * lu(k,2159) - lu(k,2169) = lu(k,2169) - lu(k,1729) * lu(k,2159) - lu(k,2170) = lu(k,2170) - lu(k,1730) * lu(k,2159) + lu(k,1474) = 1._r8 / lu(k,1474) + lu(k,1475) = lu(k,1475) * lu(k,1474) + lu(k,1476) = lu(k,1476) * lu(k,1474) + lu(k,1477) = lu(k,1477) * lu(k,1474) + lu(k,1478) = lu(k,1478) * lu(k,1474) + lu(k,1479) = lu(k,1479) * lu(k,1474) + lu(k,1480) = lu(k,1480) * lu(k,1474) + lu(k,1481) = lu(k,1481) * lu(k,1474) + lu(k,1482) = lu(k,1482) * lu(k,1474) + lu(k,1483) = lu(k,1483) * lu(k,1474) + lu(k,1484) = lu(k,1484) * lu(k,1474) + lu(k,1485) = lu(k,1485) * lu(k,1474) + lu(k,1486) = lu(k,1486) * lu(k,1474) + lu(k,1487) = lu(k,1487) * lu(k,1474) + lu(k,1539) = - lu(k,1475) * lu(k,1538) + lu(k,1540) = lu(k,1540) - lu(k,1476) * lu(k,1538) + lu(k,1541) = - lu(k,1477) * lu(k,1538) + lu(k,1542) = - lu(k,1478) * lu(k,1538) + lu(k,1544) = lu(k,1544) - lu(k,1479) * lu(k,1538) + lu(k,1545) = lu(k,1545) - lu(k,1480) * lu(k,1538) + lu(k,1546) = - lu(k,1481) * lu(k,1538) + lu(k,1547) = lu(k,1547) - lu(k,1482) * lu(k,1538) + lu(k,1548) = lu(k,1548) - lu(k,1483) * lu(k,1538) + lu(k,1549) = lu(k,1549) - lu(k,1484) * lu(k,1538) + lu(k,1550) = lu(k,1550) - lu(k,1485) * lu(k,1538) + lu(k,1552) = lu(k,1552) - lu(k,1486) * lu(k,1538) + lu(k,1553) = lu(k,1553) - lu(k,1487) * lu(k,1538) + lu(k,1561) = lu(k,1561) - lu(k,1475) * lu(k,1559) + lu(k,1562) = lu(k,1562) - lu(k,1476) * lu(k,1559) + lu(k,1563) = lu(k,1563) - lu(k,1477) * lu(k,1559) + lu(k,1564) = lu(k,1564) - lu(k,1478) * lu(k,1559) + lu(k,1566) = lu(k,1566) - lu(k,1479) * lu(k,1559) + lu(k,1567) = lu(k,1567) - lu(k,1480) * lu(k,1559) + lu(k,1569) = lu(k,1569) - lu(k,1481) * lu(k,1559) + lu(k,1571) = lu(k,1571) - lu(k,1482) * lu(k,1559) + lu(k,1572) = - lu(k,1483) * lu(k,1559) + lu(k,1573) = lu(k,1573) - lu(k,1484) * lu(k,1559) + lu(k,1574) = lu(k,1574) - lu(k,1485) * lu(k,1559) + lu(k,1576) = - lu(k,1486) * lu(k,1559) + lu(k,1577) = lu(k,1577) - lu(k,1487) * lu(k,1559) + lu(k,1587) = lu(k,1587) - lu(k,1475) * lu(k,1585) + lu(k,1588) = lu(k,1588) - lu(k,1476) * lu(k,1585) + lu(k,1589) = lu(k,1589) - lu(k,1477) * lu(k,1585) + lu(k,1590) = lu(k,1590) - lu(k,1478) * lu(k,1585) + lu(k,1592) = lu(k,1592) - lu(k,1479) * lu(k,1585) + lu(k,1593) = lu(k,1593) - lu(k,1480) * lu(k,1585) + lu(k,1595) = lu(k,1595) - lu(k,1481) * lu(k,1585) + lu(k,1597) = lu(k,1597) - lu(k,1482) * lu(k,1585) + lu(k,1598) = - lu(k,1483) * lu(k,1585) + lu(k,1599) = lu(k,1599) - lu(k,1484) * lu(k,1585) + lu(k,1601) = lu(k,1601) - lu(k,1485) * lu(k,1585) + lu(k,1603) = - lu(k,1486) * lu(k,1585) + lu(k,1604) = lu(k,1604) - lu(k,1487) * lu(k,1585) + lu(k,1794) = lu(k,1794) - lu(k,1475) * lu(k,1792) + lu(k,1795) = lu(k,1795) - lu(k,1476) * lu(k,1792) + lu(k,1796) = lu(k,1796) - lu(k,1477) * lu(k,1792) + lu(k,1797) = lu(k,1797) - lu(k,1478) * lu(k,1792) + lu(k,1799) = lu(k,1799) - lu(k,1479) * lu(k,1792) + lu(k,1800) = lu(k,1800) - lu(k,1480) * lu(k,1792) + lu(k,1802) = lu(k,1802) - lu(k,1481) * lu(k,1792) + lu(k,1804) = lu(k,1804) - lu(k,1482) * lu(k,1792) + lu(k,1805) = lu(k,1805) - lu(k,1483) * lu(k,1792) + lu(k,1806) = lu(k,1806) - lu(k,1484) * lu(k,1792) + lu(k,1809) = lu(k,1809) - lu(k,1485) * lu(k,1792) + lu(k,1811) = lu(k,1811) - lu(k,1486) * lu(k,1792) + lu(k,1812) = lu(k,1812) - lu(k,1487) * lu(k,1792) + lu(k,1839) = lu(k,1839) - lu(k,1475) * lu(k,1837) + lu(k,1840) = lu(k,1840) - lu(k,1476) * lu(k,1837) + lu(k,1841) = lu(k,1841) - lu(k,1477) * lu(k,1837) + lu(k,1842) = lu(k,1842) - lu(k,1478) * lu(k,1837) + lu(k,1844) = lu(k,1844) - lu(k,1479) * lu(k,1837) + lu(k,1845) = lu(k,1845) - lu(k,1480) * lu(k,1837) + lu(k,1847) = lu(k,1847) - lu(k,1481) * lu(k,1837) + lu(k,1849) = lu(k,1849) - lu(k,1482) * lu(k,1837) + lu(k,1850) = lu(k,1850) - lu(k,1483) * lu(k,1837) + lu(k,1851) = lu(k,1851) - lu(k,1484) * lu(k,1837) + lu(k,1854) = lu(k,1854) - lu(k,1485) * lu(k,1837) + lu(k,1856) = lu(k,1856) - lu(k,1486) * lu(k,1837) + lu(k,1857) = lu(k,1857) - lu(k,1487) * lu(k,1837) + lu(k,1899) = - lu(k,1475) * lu(k,1898) + lu(k,1900) = lu(k,1900) - lu(k,1476) * lu(k,1898) + lu(k,1901) = - lu(k,1477) * lu(k,1898) + lu(k,1902) = - lu(k,1478) * lu(k,1898) + lu(k,1904) = lu(k,1904) - lu(k,1479) * lu(k,1898) + lu(k,1905) = lu(k,1905) - lu(k,1480) * lu(k,1898) + lu(k,1907) = - lu(k,1481) * lu(k,1898) + lu(k,1909) = lu(k,1909) - lu(k,1482) * lu(k,1898) + lu(k,1910) = lu(k,1910) - lu(k,1483) * lu(k,1898) + lu(k,1911) = lu(k,1911) - lu(k,1484) * lu(k,1898) + lu(k,1914) = lu(k,1914) - lu(k,1485) * lu(k,1898) + lu(k,1916) = lu(k,1916) - lu(k,1486) * lu(k,1898) + lu(k,1917) = lu(k,1917) - lu(k,1487) * lu(k,1898) + lu(k,2312) = lu(k,2312) - lu(k,1475) * lu(k,2310) + lu(k,2313) = lu(k,2313) - lu(k,1476) * lu(k,2310) + lu(k,2314) = lu(k,2314) - lu(k,1477) * lu(k,2310) + lu(k,2315) = lu(k,2315) - lu(k,1478) * lu(k,2310) + lu(k,2317) = lu(k,2317) - lu(k,1479) * lu(k,2310) + lu(k,2318) = lu(k,2318) - lu(k,1480) * lu(k,2310) + lu(k,2320) = lu(k,2320) - lu(k,1481) * lu(k,2310) + lu(k,2322) = lu(k,2322) - lu(k,1482) * lu(k,2310) + lu(k,2323) = lu(k,2323) - lu(k,1483) * lu(k,2310) + lu(k,2324) = lu(k,2324) - lu(k,1484) * lu(k,2310) + lu(k,2327) = lu(k,2327) - lu(k,1485) * lu(k,2310) + lu(k,2329) = lu(k,2329) - lu(k,1486) * lu(k,2310) + lu(k,2330) = lu(k,2330) - lu(k,1487) * lu(k,2310) + lu(k,2402) = lu(k,2402) - lu(k,1475) * lu(k,2401) + lu(k,2403) = lu(k,2403) - lu(k,1476) * lu(k,2401) + lu(k,2404) = lu(k,2404) - lu(k,1477) * lu(k,2401) + lu(k,2405) = lu(k,2405) - lu(k,1478) * lu(k,2401) + lu(k,2407) = lu(k,2407) - lu(k,1479) * lu(k,2401) + lu(k,2408) = lu(k,2408) - lu(k,1480) * lu(k,2401) + lu(k,2410) = lu(k,2410) - lu(k,1481) * lu(k,2401) + lu(k,2412) = lu(k,2412) - lu(k,1482) * lu(k,2401) + lu(k,2413) = lu(k,2413) - lu(k,1483) * lu(k,2401) + lu(k,2414) = lu(k,2414) - lu(k,1484) * lu(k,2401) + lu(k,2417) = lu(k,2417) - lu(k,1485) * lu(k,2401) + lu(k,2419) = lu(k,2419) - lu(k,1486) * lu(k,2401) + lu(k,2420) = lu(k,2420) - lu(k,1487) * lu(k,2401) + lu(k,2429) = - lu(k,1475) * lu(k,2427) + lu(k,2430) = - lu(k,1476) * lu(k,2427) + lu(k,2431) = - lu(k,1477) * lu(k,2427) + lu(k,2432) = - lu(k,1478) * lu(k,2427) + lu(k,2434) = lu(k,2434) - lu(k,1479) * lu(k,2427) + lu(k,2435) = - lu(k,1480) * lu(k,2427) + lu(k,2437) = lu(k,2437) - lu(k,1481) * lu(k,2427) + lu(k,2439) = - lu(k,1482) * lu(k,2427) + lu(k,2440) = lu(k,2440) - lu(k,1483) * lu(k,2427) + lu(k,2441) = lu(k,2441) - lu(k,1484) * lu(k,2427) + lu(k,2444) = lu(k,2444) - lu(k,1485) * lu(k,2427) + lu(k,2446) = - lu(k,1486) * lu(k,2427) + lu(k,2447) = lu(k,2447) - lu(k,1487) * lu(k,2427) + lu(k,1493) = 1._r8 / lu(k,1493) + lu(k,1494) = lu(k,1494) * lu(k,1493) + lu(k,1495) = lu(k,1495) * lu(k,1493) + lu(k,1496) = lu(k,1496) * lu(k,1493) + lu(k,1497) = lu(k,1497) * lu(k,1493) + lu(k,1498) = lu(k,1498) * lu(k,1493) + lu(k,1499) = lu(k,1499) * lu(k,1493) + lu(k,1500) = lu(k,1500) * lu(k,1493) + lu(k,1501) = lu(k,1501) * lu(k,1493) + lu(k,1502) = lu(k,1502) * lu(k,1493) + lu(k,1503) = lu(k,1503) * lu(k,1493) + lu(k,1504) = lu(k,1504) * lu(k,1493) + lu(k,1505) = lu(k,1505) * lu(k,1493) + lu(k,1561) = lu(k,1561) - lu(k,1494) * lu(k,1560) + lu(k,1563) = lu(k,1563) - lu(k,1495) * lu(k,1560) + lu(k,1564) = lu(k,1564) - lu(k,1496) * lu(k,1560) + lu(k,1565) = - lu(k,1497) * lu(k,1560) + lu(k,1566) = lu(k,1566) - lu(k,1498) * lu(k,1560) + lu(k,1567) = lu(k,1567) - lu(k,1499) * lu(k,1560) + lu(k,1568) = lu(k,1568) - lu(k,1500) * lu(k,1560) + lu(k,1569) = lu(k,1569) - lu(k,1501) * lu(k,1560) + lu(k,1570) = lu(k,1570) - lu(k,1502) * lu(k,1560) + lu(k,1572) = lu(k,1572) - lu(k,1503) * lu(k,1560) + lu(k,1574) = lu(k,1574) - lu(k,1504) * lu(k,1560) + lu(k,1577) = lu(k,1577) - lu(k,1505) * lu(k,1560) + lu(k,1587) = lu(k,1587) - lu(k,1494) * lu(k,1586) + lu(k,1589) = lu(k,1589) - lu(k,1495) * lu(k,1586) + lu(k,1590) = lu(k,1590) - lu(k,1496) * lu(k,1586) + lu(k,1591) = - lu(k,1497) * lu(k,1586) + lu(k,1592) = lu(k,1592) - lu(k,1498) * lu(k,1586) + lu(k,1593) = lu(k,1593) - lu(k,1499) * lu(k,1586) + lu(k,1594) = lu(k,1594) - lu(k,1500) * lu(k,1586) + lu(k,1595) = lu(k,1595) - lu(k,1501) * lu(k,1586) + lu(k,1596) = lu(k,1596) - lu(k,1502) * lu(k,1586) + lu(k,1598) = lu(k,1598) - lu(k,1503) * lu(k,1586) + lu(k,1601) = lu(k,1601) - lu(k,1504) * lu(k,1586) + lu(k,1604) = lu(k,1604) - lu(k,1505) * lu(k,1586) + lu(k,1629) = lu(k,1629) - lu(k,1494) * lu(k,1628) + lu(k,1631) = lu(k,1631) - lu(k,1495) * lu(k,1628) + lu(k,1632) = lu(k,1632) - lu(k,1496) * lu(k,1628) + lu(k,1633) = lu(k,1633) - lu(k,1497) * lu(k,1628) + lu(k,1634) = lu(k,1634) - lu(k,1498) * lu(k,1628) + lu(k,1635) = - lu(k,1499) * lu(k,1628) + lu(k,1636) = lu(k,1636) - lu(k,1500) * lu(k,1628) + lu(k,1637) = lu(k,1637) - lu(k,1501) * lu(k,1628) + lu(k,1638) = lu(k,1638) - lu(k,1502) * lu(k,1628) + lu(k,1640) = lu(k,1640) - lu(k,1503) * lu(k,1628) + lu(k,1644) = lu(k,1644) - lu(k,1504) * lu(k,1628) + lu(k,1647) = lu(k,1647) - lu(k,1505) * lu(k,1628) + lu(k,1794) = lu(k,1794) - lu(k,1494) * lu(k,1793) + lu(k,1796) = lu(k,1796) - lu(k,1495) * lu(k,1793) + lu(k,1797) = lu(k,1797) - lu(k,1496) * lu(k,1793) + lu(k,1798) = lu(k,1798) - lu(k,1497) * lu(k,1793) + lu(k,1799) = lu(k,1799) - lu(k,1498) * lu(k,1793) + lu(k,1800) = lu(k,1800) - lu(k,1499) * lu(k,1793) + lu(k,1801) = lu(k,1801) - lu(k,1500) * lu(k,1793) + lu(k,1802) = lu(k,1802) - lu(k,1501) * lu(k,1793) + lu(k,1803) = lu(k,1803) - lu(k,1502) * lu(k,1793) + lu(k,1805) = lu(k,1805) - lu(k,1503) * lu(k,1793) + lu(k,1809) = lu(k,1809) - lu(k,1504) * lu(k,1793) + lu(k,1812) = lu(k,1812) - lu(k,1505) * lu(k,1793) + lu(k,1839) = lu(k,1839) - lu(k,1494) * lu(k,1838) + lu(k,1841) = lu(k,1841) - lu(k,1495) * lu(k,1838) + lu(k,1842) = lu(k,1842) - lu(k,1496) * lu(k,1838) + lu(k,1843) = lu(k,1843) - lu(k,1497) * lu(k,1838) + lu(k,1844) = lu(k,1844) - lu(k,1498) * lu(k,1838) + lu(k,1845) = lu(k,1845) - lu(k,1499) * lu(k,1838) + lu(k,1846) = lu(k,1846) - lu(k,1500) * lu(k,1838) + lu(k,1847) = lu(k,1847) - lu(k,1501) * lu(k,1838) + lu(k,1848) = lu(k,1848) - lu(k,1502) * lu(k,1838) + lu(k,1850) = lu(k,1850) - lu(k,1503) * lu(k,1838) + lu(k,1854) = lu(k,1854) - lu(k,1504) * lu(k,1838) + lu(k,1857) = lu(k,1857) - lu(k,1505) * lu(k,1838) + lu(k,1945) = lu(k,1945) - lu(k,1494) * lu(k,1944) + lu(k,1947) = - lu(k,1495) * lu(k,1944) + lu(k,1948) = lu(k,1948) - lu(k,1496) * lu(k,1944) + lu(k,1949) = lu(k,1949) - lu(k,1497) * lu(k,1944) + lu(k,1950) = lu(k,1950) - lu(k,1498) * lu(k,1944) + lu(k,1951) = lu(k,1951) - lu(k,1499) * lu(k,1944) + lu(k,1952) = lu(k,1952) - lu(k,1500) * lu(k,1944) + lu(k,1953) = lu(k,1953) - lu(k,1501) * lu(k,1944) + lu(k,1954) = lu(k,1954) - lu(k,1502) * lu(k,1944) + lu(k,1956) = lu(k,1956) - lu(k,1503) * lu(k,1944) + lu(k,1960) = lu(k,1960) - lu(k,1504) * lu(k,1944) + lu(k,1963) = lu(k,1963) - lu(k,1505) * lu(k,1944) + lu(k,1968) = - lu(k,1494) * lu(k,1967) + lu(k,1970) = - lu(k,1495) * lu(k,1967) + lu(k,1971) = - lu(k,1496) * lu(k,1967) + lu(k,1972) = lu(k,1972) - lu(k,1497) * lu(k,1967) + lu(k,1973) = lu(k,1973) - lu(k,1498) * lu(k,1967) + lu(k,1974) = lu(k,1974) - lu(k,1499) * lu(k,1967) + lu(k,1975) = lu(k,1975) - lu(k,1500) * lu(k,1967) + lu(k,1976) = lu(k,1976) - lu(k,1501) * lu(k,1967) + lu(k,1977) = lu(k,1977) - lu(k,1502) * lu(k,1967) + lu(k,1979) = lu(k,1979) - lu(k,1503) * lu(k,1967) + lu(k,1983) = lu(k,1983) - lu(k,1504) * lu(k,1967) + lu(k,1986) = lu(k,1986) - lu(k,1505) * lu(k,1967) + lu(k,2084) = - lu(k,1494) * lu(k,2083) + lu(k,2086) = - lu(k,1495) * lu(k,2083) + lu(k,2087) = - lu(k,1496) * lu(k,2083) + lu(k,2088) = lu(k,2088) - lu(k,1497) * lu(k,2083) + lu(k,2089) = lu(k,2089) - lu(k,1498) * lu(k,2083) + lu(k,2090) = - lu(k,1499) * lu(k,2083) + lu(k,2091) = lu(k,2091) - lu(k,1500) * lu(k,2083) + lu(k,2092) = lu(k,2092) - lu(k,1501) * lu(k,2083) + lu(k,2093) = lu(k,2093) - lu(k,1502) * lu(k,2083) + lu(k,2095) = lu(k,2095) - lu(k,1503) * lu(k,2083) + lu(k,2099) = lu(k,2099) - lu(k,1504) * lu(k,2083) + lu(k,2102) = lu(k,2102) - lu(k,1505) * lu(k,2083) + lu(k,2192) = lu(k,2192) - lu(k,1494) * lu(k,2191) + lu(k,2194) = lu(k,2194) - lu(k,1495) * lu(k,2191) + lu(k,2195) = lu(k,2195) - lu(k,1496) * lu(k,2191) + lu(k,2196) = lu(k,2196) - lu(k,1497) * lu(k,2191) + lu(k,2197) = lu(k,2197) - lu(k,1498) * lu(k,2191) + lu(k,2198) = lu(k,2198) - lu(k,1499) * lu(k,2191) + lu(k,2199) = lu(k,2199) - lu(k,1500) * lu(k,2191) + lu(k,2200) = lu(k,2200) - lu(k,1501) * lu(k,2191) + lu(k,2201) = lu(k,2201) - lu(k,1502) * lu(k,2191) + lu(k,2203) = lu(k,2203) - lu(k,1503) * lu(k,2191) + lu(k,2207) = lu(k,2207) - lu(k,1504) * lu(k,2191) + lu(k,2210) = lu(k,2210) - lu(k,1505) * lu(k,2191) + lu(k,2269) = - lu(k,1494) * lu(k,2268) + lu(k,2271) = - lu(k,1495) * lu(k,2268) + lu(k,2272) = - lu(k,1496) * lu(k,2268) + lu(k,2273) = lu(k,2273) - lu(k,1497) * lu(k,2268) + lu(k,2274) = lu(k,2274) - lu(k,1498) * lu(k,2268) + lu(k,2275) = lu(k,2275) - lu(k,1499) * lu(k,2268) + lu(k,2276) = lu(k,2276) - lu(k,1500) * lu(k,2268) + lu(k,2277) = lu(k,2277) - lu(k,1501) * lu(k,2268) + lu(k,2278) = lu(k,2278) - lu(k,1502) * lu(k,2268) + lu(k,2280) = lu(k,2280) - lu(k,1503) * lu(k,2268) + lu(k,2284) = lu(k,2284) - lu(k,1504) * lu(k,2268) + lu(k,2287) = lu(k,2287) - lu(k,1505) * lu(k,2268) + lu(k,2312) = lu(k,2312) - lu(k,1494) * lu(k,2311) + lu(k,2314) = lu(k,2314) - lu(k,1495) * lu(k,2311) + lu(k,2315) = lu(k,2315) - lu(k,1496) * lu(k,2311) + lu(k,2316) = lu(k,2316) - lu(k,1497) * lu(k,2311) + lu(k,2317) = lu(k,2317) - lu(k,1498) * lu(k,2311) + lu(k,2318) = lu(k,2318) - lu(k,1499) * lu(k,2311) + lu(k,2319) = lu(k,2319) - lu(k,1500) * lu(k,2311) + lu(k,2320) = lu(k,2320) - lu(k,1501) * lu(k,2311) + lu(k,2321) = lu(k,2321) - lu(k,1502) * lu(k,2311) + lu(k,2323) = lu(k,2323) - lu(k,1503) * lu(k,2311) + lu(k,2327) = lu(k,2327) - lu(k,1504) * lu(k,2311) + lu(k,2330) = lu(k,2330) - lu(k,1505) * lu(k,2311) + lu(k,2338) = lu(k,2338) - lu(k,1494) * lu(k,2337) + lu(k,2340) = lu(k,2340) - lu(k,1495) * lu(k,2337) + lu(k,2341) = - lu(k,1496) * lu(k,2337) + lu(k,2342) = lu(k,2342) - lu(k,1497) * lu(k,2337) + lu(k,2343) = lu(k,2343) - lu(k,1498) * lu(k,2337) + lu(k,2344) = lu(k,2344) - lu(k,1499) * lu(k,2337) + lu(k,2345) = lu(k,2345) - lu(k,1500) * lu(k,2337) + lu(k,2346) = lu(k,2346) - lu(k,1501) * lu(k,2337) + lu(k,2347) = lu(k,2347) - lu(k,1502) * lu(k,2337) + lu(k,2349) = lu(k,2349) - lu(k,1503) * lu(k,2337) + lu(k,2353) = lu(k,2353) - lu(k,1504) * lu(k,2337) + lu(k,2356) = lu(k,2356) - lu(k,1505) * lu(k,2337) + lu(k,2429) = lu(k,2429) - lu(k,1494) * lu(k,2428) + lu(k,2431) = lu(k,2431) - lu(k,1495) * lu(k,2428) + lu(k,2432) = lu(k,2432) - lu(k,1496) * lu(k,2428) + lu(k,2433) = lu(k,2433) - lu(k,1497) * lu(k,2428) + lu(k,2434) = lu(k,2434) - lu(k,1498) * lu(k,2428) + lu(k,2435) = lu(k,2435) - lu(k,1499) * lu(k,2428) + lu(k,2436) = lu(k,2436) - lu(k,1500) * lu(k,2428) + lu(k,2437) = lu(k,2437) - lu(k,1501) * lu(k,2428) + lu(k,2438) = lu(k,2438) - lu(k,1502) * lu(k,2428) + lu(k,2440) = lu(k,2440) - lu(k,1503) * lu(k,2428) + lu(k,2444) = lu(k,2444) - lu(k,1504) * lu(k,2428) + lu(k,2447) = lu(k,2447) - lu(k,1505) * lu(k,2428) end do - end subroutine lu_fac28 - subroutine lu_fac29( avec_len, lu ) + end subroutine lu_fac29 + subroutine lu_fac30( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 implicit none @@ -7480,415 +6758,700 @@ subroutine lu_fac29( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1782) = 1._r8 / lu(k,1782) - lu(k,1783) = lu(k,1783) * lu(k,1782) - lu(k,1784) = lu(k,1784) * lu(k,1782) - lu(k,1785) = lu(k,1785) * lu(k,1782) - lu(k,1786) = lu(k,1786) * lu(k,1782) - lu(k,1787) = lu(k,1787) * lu(k,1782) - lu(k,1788) = lu(k,1788) * lu(k,1782) - lu(k,1789) = lu(k,1789) * lu(k,1782) - lu(k,1790) = lu(k,1790) * lu(k,1782) - lu(k,1791) = lu(k,1791) * lu(k,1782) - lu(k,1792) = lu(k,1792) * lu(k,1782) - lu(k,1824) = lu(k,1824) - lu(k,1783) * lu(k,1823) - lu(k,1825) = lu(k,1825) - lu(k,1784) * lu(k,1823) - lu(k,1826) = lu(k,1826) - lu(k,1785) * lu(k,1823) - lu(k,1827) = lu(k,1827) - lu(k,1786) * lu(k,1823) - lu(k,1828) = lu(k,1828) - lu(k,1787) * lu(k,1823) - lu(k,1829) = lu(k,1829) - lu(k,1788) * lu(k,1823) - lu(k,1830) = lu(k,1830) - lu(k,1789) * lu(k,1823) - lu(k,1831) = lu(k,1831) - lu(k,1790) * lu(k,1823) - lu(k,1832) = lu(k,1832) - lu(k,1791) * lu(k,1823) - lu(k,1833) = lu(k,1833) - lu(k,1792) * lu(k,1823) - lu(k,1848) = lu(k,1848) - lu(k,1783) * lu(k,1847) - lu(k,1849) = lu(k,1849) - lu(k,1784) * lu(k,1847) - lu(k,1850) = lu(k,1850) - lu(k,1785) * lu(k,1847) - lu(k,1851) = lu(k,1851) - lu(k,1786) * lu(k,1847) - lu(k,1852) = lu(k,1852) - lu(k,1787) * lu(k,1847) - lu(k,1853) = lu(k,1853) - lu(k,1788) * lu(k,1847) - lu(k,1854) = lu(k,1854) - lu(k,1789) * lu(k,1847) - lu(k,1855) = lu(k,1855) - lu(k,1790) * lu(k,1847) - lu(k,1856) = lu(k,1856) - lu(k,1791) * lu(k,1847) - lu(k,1857) = lu(k,1857) - lu(k,1792) * lu(k,1847) - lu(k,1905) = lu(k,1905) - lu(k,1783) * lu(k,1904) - lu(k,1906) = lu(k,1906) - lu(k,1784) * lu(k,1904) - lu(k,1907) = lu(k,1907) - lu(k,1785) * lu(k,1904) - lu(k,1908) = lu(k,1908) - lu(k,1786) * lu(k,1904) - lu(k,1909) = lu(k,1909) - lu(k,1787) * lu(k,1904) - lu(k,1910) = lu(k,1910) - lu(k,1788) * lu(k,1904) - lu(k,1911) = lu(k,1911) - lu(k,1789) * lu(k,1904) - lu(k,1912) = lu(k,1912) - lu(k,1790) * lu(k,1904) - lu(k,1913) = lu(k,1913) - lu(k,1791) * lu(k,1904) - lu(k,1914) = lu(k,1914) - lu(k,1792) * lu(k,1904) - lu(k,1925) = lu(k,1925) - lu(k,1783) * lu(k,1924) - lu(k,1926) = lu(k,1926) - lu(k,1784) * lu(k,1924) - lu(k,1927) = lu(k,1927) - lu(k,1785) * lu(k,1924) - lu(k,1928) = lu(k,1928) - lu(k,1786) * lu(k,1924) - lu(k,1929) = lu(k,1929) - lu(k,1787) * lu(k,1924) - lu(k,1930) = lu(k,1930) - lu(k,1788) * lu(k,1924) - lu(k,1931) = lu(k,1931) - lu(k,1789) * lu(k,1924) - lu(k,1932) = lu(k,1932) - lu(k,1790) * lu(k,1924) - lu(k,1933) = lu(k,1933) - lu(k,1791) * lu(k,1924) - lu(k,1934) = lu(k,1934) - lu(k,1792) * lu(k,1924) - lu(k,1947) = lu(k,1947) - lu(k,1783) * lu(k,1946) - lu(k,1948) = lu(k,1948) - lu(k,1784) * lu(k,1946) - lu(k,1949) = lu(k,1949) - lu(k,1785) * lu(k,1946) - lu(k,1950) = lu(k,1950) - lu(k,1786) * lu(k,1946) - lu(k,1951) = lu(k,1951) - lu(k,1787) * lu(k,1946) - lu(k,1952) = lu(k,1952) - lu(k,1788) * lu(k,1946) - lu(k,1953) = lu(k,1953) - lu(k,1789) * lu(k,1946) - lu(k,1954) = lu(k,1954) - lu(k,1790) * lu(k,1946) - lu(k,1955) = lu(k,1955) - lu(k,1791) * lu(k,1946) - lu(k,1956) = lu(k,1956) - lu(k,1792) * lu(k,1946) - lu(k,1989) = lu(k,1989) - lu(k,1783) * lu(k,1988) - lu(k,1990) = lu(k,1990) - lu(k,1784) * lu(k,1988) - lu(k,1991) = lu(k,1991) - lu(k,1785) * lu(k,1988) - lu(k,1992) = lu(k,1992) - lu(k,1786) * lu(k,1988) - lu(k,1993) = lu(k,1993) - lu(k,1787) * lu(k,1988) - lu(k,1994) = lu(k,1994) - lu(k,1788) * lu(k,1988) - lu(k,1995) = lu(k,1995) - lu(k,1789) * lu(k,1988) - lu(k,1996) = lu(k,1996) - lu(k,1790) * lu(k,1988) - lu(k,1997) = lu(k,1997) - lu(k,1791) * lu(k,1988) - lu(k,1998) = lu(k,1998) - lu(k,1792) * lu(k,1988) - lu(k,2013) = lu(k,2013) - lu(k,1783) * lu(k,2012) - lu(k,2014) = lu(k,2014) - lu(k,1784) * lu(k,2012) - lu(k,2015) = lu(k,2015) - lu(k,1785) * lu(k,2012) - lu(k,2016) = lu(k,2016) - lu(k,1786) * lu(k,2012) - lu(k,2017) = lu(k,2017) - lu(k,1787) * lu(k,2012) - lu(k,2018) = lu(k,2018) - lu(k,1788) * lu(k,2012) - lu(k,2019) = lu(k,2019) - lu(k,1789) * lu(k,2012) - lu(k,2020) = lu(k,2020) - lu(k,1790) * lu(k,2012) - lu(k,2021) = lu(k,2021) - lu(k,1791) * lu(k,2012) - lu(k,2022) = lu(k,2022) - lu(k,1792) * lu(k,2012) - lu(k,2108) = lu(k,2108) - lu(k,1783) * lu(k,2107) - lu(k,2109) = lu(k,2109) - lu(k,1784) * lu(k,2107) - lu(k,2110) = lu(k,2110) - lu(k,1785) * lu(k,2107) - lu(k,2111) = lu(k,2111) - lu(k,1786) * lu(k,2107) - lu(k,2112) = lu(k,2112) - lu(k,1787) * lu(k,2107) - lu(k,2113) = lu(k,2113) - lu(k,1788) * lu(k,2107) - lu(k,2114) = lu(k,2114) - lu(k,1789) * lu(k,2107) - lu(k,2115) = lu(k,2115) - lu(k,1790) * lu(k,2107) - lu(k,2116) = lu(k,2116) - lu(k,1791) * lu(k,2107) - lu(k,2117) = lu(k,2117) - lu(k,1792) * lu(k,2107) - lu(k,2135) = lu(k,2135) - lu(k,1783) * lu(k,2134) - lu(k,2136) = lu(k,2136) - lu(k,1784) * lu(k,2134) - lu(k,2137) = lu(k,2137) - lu(k,1785) * lu(k,2134) - lu(k,2138) = lu(k,2138) - lu(k,1786) * lu(k,2134) - lu(k,2139) = lu(k,2139) - lu(k,1787) * lu(k,2134) - lu(k,2140) = lu(k,2140) - lu(k,1788) * lu(k,2134) - lu(k,2141) = lu(k,2141) - lu(k,1789) * lu(k,2134) - lu(k,2142) = lu(k,2142) - lu(k,1790) * lu(k,2134) - lu(k,2143) = lu(k,2143) - lu(k,1791) * lu(k,2134) - lu(k,2144) = lu(k,2144) - lu(k,1792) * lu(k,2134) - lu(k,2161) = lu(k,2161) - lu(k,1783) * lu(k,2160) - lu(k,2162) = lu(k,2162) - lu(k,1784) * lu(k,2160) - lu(k,2163) = lu(k,2163) - lu(k,1785) * lu(k,2160) - lu(k,2164) = lu(k,2164) - lu(k,1786) * lu(k,2160) - lu(k,2165) = lu(k,2165) - lu(k,1787) * lu(k,2160) - lu(k,2166) = lu(k,2166) - lu(k,1788) * lu(k,2160) - lu(k,2167) = lu(k,2167) - lu(k,1789) * lu(k,2160) - lu(k,2168) = lu(k,2168) - lu(k,1790) * lu(k,2160) - lu(k,2169) = lu(k,2169) - lu(k,1791) * lu(k,2160) - lu(k,2170) = lu(k,2170) - lu(k,1792) * lu(k,2160) - lu(k,1824) = 1._r8 / lu(k,1824) - lu(k,1825) = lu(k,1825) * lu(k,1824) - lu(k,1826) = lu(k,1826) * lu(k,1824) - lu(k,1827) = lu(k,1827) * lu(k,1824) - lu(k,1828) = lu(k,1828) * lu(k,1824) - lu(k,1829) = lu(k,1829) * lu(k,1824) - lu(k,1830) = lu(k,1830) * lu(k,1824) - lu(k,1831) = lu(k,1831) * lu(k,1824) - lu(k,1832) = lu(k,1832) * lu(k,1824) - lu(k,1833) = lu(k,1833) * lu(k,1824) - lu(k,1849) = lu(k,1849) - lu(k,1825) * lu(k,1848) - lu(k,1850) = lu(k,1850) - lu(k,1826) * lu(k,1848) - lu(k,1851) = lu(k,1851) - lu(k,1827) * lu(k,1848) - lu(k,1852) = lu(k,1852) - lu(k,1828) * lu(k,1848) - lu(k,1853) = lu(k,1853) - lu(k,1829) * lu(k,1848) - lu(k,1854) = lu(k,1854) - lu(k,1830) * lu(k,1848) - lu(k,1855) = lu(k,1855) - lu(k,1831) * lu(k,1848) - lu(k,1856) = lu(k,1856) - lu(k,1832) * lu(k,1848) - lu(k,1857) = lu(k,1857) - lu(k,1833) * lu(k,1848) - lu(k,1906) = lu(k,1906) - lu(k,1825) * lu(k,1905) - lu(k,1907) = lu(k,1907) - lu(k,1826) * lu(k,1905) - lu(k,1908) = lu(k,1908) - lu(k,1827) * lu(k,1905) - lu(k,1909) = lu(k,1909) - lu(k,1828) * lu(k,1905) - lu(k,1910) = lu(k,1910) - lu(k,1829) * lu(k,1905) - lu(k,1911) = lu(k,1911) - lu(k,1830) * lu(k,1905) - lu(k,1912) = lu(k,1912) - lu(k,1831) * lu(k,1905) - lu(k,1913) = lu(k,1913) - lu(k,1832) * lu(k,1905) - lu(k,1914) = lu(k,1914) - lu(k,1833) * lu(k,1905) - lu(k,1926) = lu(k,1926) - lu(k,1825) * lu(k,1925) - lu(k,1927) = lu(k,1927) - lu(k,1826) * lu(k,1925) - lu(k,1928) = lu(k,1928) - lu(k,1827) * lu(k,1925) - lu(k,1929) = lu(k,1929) - lu(k,1828) * lu(k,1925) - lu(k,1930) = lu(k,1930) - lu(k,1829) * lu(k,1925) - lu(k,1931) = lu(k,1931) - lu(k,1830) * lu(k,1925) - lu(k,1932) = lu(k,1932) - lu(k,1831) * lu(k,1925) - lu(k,1933) = lu(k,1933) - lu(k,1832) * lu(k,1925) - lu(k,1934) = lu(k,1934) - lu(k,1833) * lu(k,1925) - lu(k,1948) = lu(k,1948) - lu(k,1825) * lu(k,1947) - lu(k,1949) = lu(k,1949) - lu(k,1826) * lu(k,1947) - lu(k,1950) = lu(k,1950) - lu(k,1827) * lu(k,1947) - lu(k,1951) = lu(k,1951) - lu(k,1828) * lu(k,1947) - lu(k,1952) = lu(k,1952) - lu(k,1829) * lu(k,1947) - lu(k,1953) = lu(k,1953) - lu(k,1830) * lu(k,1947) - lu(k,1954) = lu(k,1954) - lu(k,1831) * lu(k,1947) - lu(k,1955) = lu(k,1955) - lu(k,1832) * lu(k,1947) - lu(k,1956) = lu(k,1956) - lu(k,1833) * lu(k,1947) - lu(k,1990) = lu(k,1990) - lu(k,1825) * lu(k,1989) - lu(k,1991) = lu(k,1991) - lu(k,1826) * lu(k,1989) - lu(k,1992) = lu(k,1992) - lu(k,1827) * lu(k,1989) - lu(k,1993) = lu(k,1993) - lu(k,1828) * lu(k,1989) - lu(k,1994) = lu(k,1994) - lu(k,1829) * lu(k,1989) - lu(k,1995) = lu(k,1995) - lu(k,1830) * lu(k,1989) - lu(k,1996) = lu(k,1996) - lu(k,1831) * lu(k,1989) - lu(k,1997) = lu(k,1997) - lu(k,1832) * lu(k,1989) - lu(k,1998) = lu(k,1998) - lu(k,1833) * lu(k,1989) - lu(k,2014) = lu(k,2014) - lu(k,1825) * lu(k,2013) - lu(k,2015) = lu(k,2015) - lu(k,1826) * lu(k,2013) - lu(k,2016) = lu(k,2016) - lu(k,1827) * lu(k,2013) - lu(k,2017) = lu(k,2017) - lu(k,1828) * lu(k,2013) - lu(k,2018) = lu(k,2018) - lu(k,1829) * lu(k,2013) - lu(k,2019) = lu(k,2019) - lu(k,1830) * lu(k,2013) - lu(k,2020) = lu(k,2020) - lu(k,1831) * lu(k,2013) - lu(k,2021) = lu(k,2021) - lu(k,1832) * lu(k,2013) - lu(k,2022) = lu(k,2022) - lu(k,1833) * lu(k,2013) - lu(k,2109) = lu(k,2109) - lu(k,1825) * lu(k,2108) - lu(k,2110) = lu(k,2110) - lu(k,1826) * lu(k,2108) - lu(k,2111) = lu(k,2111) - lu(k,1827) * lu(k,2108) - lu(k,2112) = lu(k,2112) - lu(k,1828) * lu(k,2108) - lu(k,2113) = lu(k,2113) - lu(k,1829) * lu(k,2108) - lu(k,2114) = lu(k,2114) - lu(k,1830) * lu(k,2108) - lu(k,2115) = lu(k,2115) - lu(k,1831) * lu(k,2108) - lu(k,2116) = lu(k,2116) - lu(k,1832) * lu(k,2108) - lu(k,2117) = lu(k,2117) - lu(k,1833) * lu(k,2108) - lu(k,2136) = lu(k,2136) - lu(k,1825) * lu(k,2135) - lu(k,2137) = lu(k,2137) - lu(k,1826) * lu(k,2135) - lu(k,2138) = lu(k,2138) - lu(k,1827) * lu(k,2135) - lu(k,2139) = lu(k,2139) - lu(k,1828) * lu(k,2135) - lu(k,2140) = lu(k,2140) - lu(k,1829) * lu(k,2135) - lu(k,2141) = lu(k,2141) - lu(k,1830) * lu(k,2135) - lu(k,2142) = lu(k,2142) - lu(k,1831) * lu(k,2135) - lu(k,2143) = lu(k,2143) - lu(k,1832) * lu(k,2135) - lu(k,2144) = lu(k,2144) - lu(k,1833) * lu(k,2135) - lu(k,2162) = lu(k,2162) - lu(k,1825) * lu(k,2161) - lu(k,2163) = lu(k,2163) - lu(k,1826) * lu(k,2161) - lu(k,2164) = lu(k,2164) - lu(k,1827) * lu(k,2161) - lu(k,2165) = lu(k,2165) - lu(k,1828) * lu(k,2161) - lu(k,2166) = lu(k,2166) - lu(k,1829) * lu(k,2161) - lu(k,2167) = lu(k,2167) - lu(k,1830) * lu(k,2161) - lu(k,2168) = lu(k,2168) - lu(k,1831) * lu(k,2161) - lu(k,2169) = lu(k,2169) - lu(k,1832) * lu(k,2161) - lu(k,2170) = lu(k,2170) - lu(k,1833) * lu(k,2161) - lu(k,1849) = 1._r8 / lu(k,1849) - lu(k,1850) = lu(k,1850) * lu(k,1849) - lu(k,1851) = lu(k,1851) * lu(k,1849) - lu(k,1852) = lu(k,1852) * lu(k,1849) - lu(k,1853) = lu(k,1853) * lu(k,1849) - lu(k,1854) = lu(k,1854) * lu(k,1849) - lu(k,1855) = lu(k,1855) * lu(k,1849) - lu(k,1856) = lu(k,1856) * lu(k,1849) - lu(k,1857) = lu(k,1857) * lu(k,1849) - lu(k,1907) = lu(k,1907) - lu(k,1850) * lu(k,1906) - lu(k,1908) = lu(k,1908) - lu(k,1851) * lu(k,1906) - lu(k,1909) = lu(k,1909) - lu(k,1852) * lu(k,1906) - lu(k,1910) = lu(k,1910) - lu(k,1853) * lu(k,1906) - lu(k,1911) = lu(k,1911) - lu(k,1854) * lu(k,1906) - lu(k,1912) = lu(k,1912) - lu(k,1855) * lu(k,1906) - lu(k,1913) = lu(k,1913) - lu(k,1856) * lu(k,1906) - lu(k,1914) = lu(k,1914) - lu(k,1857) * lu(k,1906) - lu(k,1927) = lu(k,1927) - lu(k,1850) * lu(k,1926) - lu(k,1928) = lu(k,1928) - lu(k,1851) * lu(k,1926) - lu(k,1929) = lu(k,1929) - lu(k,1852) * lu(k,1926) - lu(k,1930) = lu(k,1930) - lu(k,1853) * lu(k,1926) - lu(k,1931) = lu(k,1931) - lu(k,1854) * lu(k,1926) - lu(k,1932) = lu(k,1932) - lu(k,1855) * lu(k,1926) - lu(k,1933) = lu(k,1933) - lu(k,1856) * lu(k,1926) - lu(k,1934) = lu(k,1934) - lu(k,1857) * lu(k,1926) - lu(k,1949) = lu(k,1949) - lu(k,1850) * lu(k,1948) - lu(k,1950) = lu(k,1950) - lu(k,1851) * lu(k,1948) - lu(k,1951) = lu(k,1951) - lu(k,1852) * lu(k,1948) - lu(k,1952) = lu(k,1952) - lu(k,1853) * lu(k,1948) - lu(k,1953) = lu(k,1953) - lu(k,1854) * lu(k,1948) - lu(k,1954) = lu(k,1954) - lu(k,1855) * lu(k,1948) - lu(k,1955) = lu(k,1955) - lu(k,1856) * lu(k,1948) - lu(k,1956) = lu(k,1956) - lu(k,1857) * lu(k,1948) - lu(k,1991) = lu(k,1991) - lu(k,1850) * lu(k,1990) - lu(k,1992) = lu(k,1992) - lu(k,1851) * lu(k,1990) - lu(k,1993) = lu(k,1993) - lu(k,1852) * lu(k,1990) - lu(k,1994) = lu(k,1994) - lu(k,1853) * lu(k,1990) - lu(k,1995) = lu(k,1995) - lu(k,1854) * lu(k,1990) - lu(k,1996) = lu(k,1996) - lu(k,1855) * lu(k,1990) - lu(k,1997) = lu(k,1997) - lu(k,1856) * lu(k,1990) - lu(k,1998) = lu(k,1998) - lu(k,1857) * lu(k,1990) - lu(k,2015) = lu(k,2015) - lu(k,1850) * lu(k,2014) - lu(k,2016) = lu(k,2016) - lu(k,1851) * lu(k,2014) - lu(k,2017) = lu(k,2017) - lu(k,1852) * lu(k,2014) - lu(k,2018) = lu(k,2018) - lu(k,1853) * lu(k,2014) - lu(k,2019) = lu(k,2019) - lu(k,1854) * lu(k,2014) - lu(k,2020) = lu(k,2020) - lu(k,1855) * lu(k,2014) - lu(k,2021) = lu(k,2021) - lu(k,1856) * lu(k,2014) - lu(k,2022) = lu(k,2022) - lu(k,1857) * lu(k,2014) - lu(k,2110) = lu(k,2110) - lu(k,1850) * lu(k,2109) - lu(k,2111) = lu(k,2111) - lu(k,1851) * lu(k,2109) - lu(k,2112) = lu(k,2112) - lu(k,1852) * lu(k,2109) - lu(k,2113) = lu(k,2113) - lu(k,1853) * lu(k,2109) - lu(k,2114) = lu(k,2114) - lu(k,1854) * lu(k,2109) - lu(k,2115) = lu(k,2115) - lu(k,1855) * lu(k,2109) - lu(k,2116) = lu(k,2116) - lu(k,1856) * lu(k,2109) - lu(k,2117) = lu(k,2117) - lu(k,1857) * lu(k,2109) - lu(k,2137) = lu(k,2137) - lu(k,1850) * lu(k,2136) - lu(k,2138) = lu(k,2138) - lu(k,1851) * lu(k,2136) - lu(k,2139) = lu(k,2139) - lu(k,1852) * lu(k,2136) - lu(k,2140) = lu(k,2140) - lu(k,1853) * lu(k,2136) - lu(k,2141) = lu(k,2141) - lu(k,1854) * lu(k,2136) - lu(k,2142) = lu(k,2142) - lu(k,1855) * lu(k,2136) - lu(k,2143) = lu(k,2143) - lu(k,1856) * lu(k,2136) - lu(k,2144) = lu(k,2144) - lu(k,1857) * lu(k,2136) - lu(k,2163) = lu(k,2163) - lu(k,1850) * lu(k,2162) - lu(k,2164) = lu(k,2164) - lu(k,1851) * lu(k,2162) - lu(k,2165) = lu(k,2165) - lu(k,1852) * lu(k,2162) - lu(k,2166) = lu(k,2166) - lu(k,1853) * lu(k,2162) - lu(k,2167) = lu(k,2167) - lu(k,1854) * lu(k,2162) - lu(k,2168) = lu(k,2168) - lu(k,1855) * lu(k,2162) - lu(k,2169) = lu(k,2169) - lu(k,1856) * lu(k,2162) - lu(k,2170) = lu(k,2170) - lu(k,1857) * lu(k,2162) - lu(k,1907) = 1._r8 / lu(k,1907) - lu(k,1908) = lu(k,1908) * lu(k,1907) - lu(k,1909) = lu(k,1909) * lu(k,1907) - lu(k,1910) = lu(k,1910) * lu(k,1907) - lu(k,1911) = lu(k,1911) * lu(k,1907) - lu(k,1912) = lu(k,1912) * lu(k,1907) - lu(k,1913) = lu(k,1913) * lu(k,1907) - lu(k,1914) = lu(k,1914) * lu(k,1907) - lu(k,1928) = lu(k,1928) - lu(k,1908) * lu(k,1927) - lu(k,1929) = lu(k,1929) - lu(k,1909) * lu(k,1927) - lu(k,1930) = lu(k,1930) - lu(k,1910) * lu(k,1927) - lu(k,1931) = lu(k,1931) - lu(k,1911) * lu(k,1927) - lu(k,1932) = lu(k,1932) - lu(k,1912) * lu(k,1927) - lu(k,1933) = lu(k,1933) - lu(k,1913) * lu(k,1927) - lu(k,1934) = lu(k,1934) - lu(k,1914) * lu(k,1927) - lu(k,1950) = lu(k,1950) - lu(k,1908) * lu(k,1949) - lu(k,1951) = lu(k,1951) - lu(k,1909) * lu(k,1949) - lu(k,1952) = lu(k,1952) - lu(k,1910) * lu(k,1949) - lu(k,1953) = lu(k,1953) - lu(k,1911) * lu(k,1949) - lu(k,1954) = lu(k,1954) - lu(k,1912) * lu(k,1949) - lu(k,1955) = lu(k,1955) - lu(k,1913) * lu(k,1949) - lu(k,1956) = lu(k,1956) - lu(k,1914) * lu(k,1949) - lu(k,1992) = lu(k,1992) - lu(k,1908) * lu(k,1991) - lu(k,1993) = lu(k,1993) - lu(k,1909) * lu(k,1991) - lu(k,1994) = lu(k,1994) - lu(k,1910) * lu(k,1991) - lu(k,1995) = lu(k,1995) - lu(k,1911) * lu(k,1991) - lu(k,1996) = lu(k,1996) - lu(k,1912) * lu(k,1991) - lu(k,1997) = lu(k,1997) - lu(k,1913) * lu(k,1991) - lu(k,1998) = lu(k,1998) - lu(k,1914) * lu(k,1991) - lu(k,2016) = lu(k,2016) - lu(k,1908) * lu(k,2015) - lu(k,2017) = lu(k,2017) - lu(k,1909) * lu(k,2015) - lu(k,2018) = lu(k,2018) - lu(k,1910) * lu(k,2015) - lu(k,2019) = lu(k,2019) - lu(k,1911) * lu(k,2015) - lu(k,2020) = lu(k,2020) - lu(k,1912) * lu(k,2015) - lu(k,2021) = lu(k,2021) - lu(k,1913) * lu(k,2015) - lu(k,2022) = lu(k,2022) - lu(k,1914) * lu(k,2015) - lu(k,2111) = lu(k,2111) - lu(k,1908) * lu(k,2110) - lu(k,2112) = lu(k,2112) - lu(k,1909) * lu(k,2110) - lu(k,2113) = lu(k,2113) - lu(k,1910) * lu(k,2110) - lu(k,2114) = lu(k,2114) - lu(k,1911) * lu(k,2110) - lu(k,2115) = lu(k,2115) - lu(k,1912) * lu(k,2110) - lu(k,2116) = lu(k,2116) - lu(k,1913) * lu(k,2110) - lu(k,2117) = lu(k,2117) - lu(k,1914) * lu(k,2110) - lu(k,2138) = lu(k,2138) - lu(k,1908) * lu(k,2137) - lu(k,2139) = lu(k,2139) - lu(k,1909) * lu(k,2137) - lu(k,2140) = lu(k,2140) - lu(k,1910) * lu(k,2137) - lu(k,2141) = lu(k,2141) - lu(k,1911) * lu(k,2137) - lu(k,2142) = lu(k,2142) - lu(k,1912) * lu(k,2137) - lu(k,2143) = lu(k,2143) - lu(k,1913) * lu(k,2137) - lu(k,2144) = lu(k,2144) - lu(k,1914) * lu(k,2137) - lu(k,2164) = lu(k,2164) - lu(k,1908) * lu(k,2163) - lu(k,2165) = lu(k,2165) - lu(k,1909) * lu(k,2163) - lu(k,2166) = lu(k,2166) - lu(k,1910) * lu(k,2163) - lu(k,2167) = lu(k,2167) - lu(k,1911) * lu(k,2163) - lu(k,2168) = lu(k,2168) - lu(k,1912) * lu(k,2163) - lu(k,2169) = lu(k,2169) - lu(k,1913) * lu(k,2163) - lu(k,2170) = lu(k,2170) - lu(k,1914) * lu(k,2163) - lu(k,1928) = 1._r8 / lu(k,1928) - lu(k,1929) = lu(k,1929) * lu(k,1928) - lu(k,1930) = lu(k,1930) * lu(k,1928) - lu(k,1931) = lu(k,1931) * lu(k,1928) - lu(k,1932) = lu(k,1932) * lu(k,1928) - lu(k,1933) = lu(k,1933) * lu(k,1928) - lu(k,1934) = lu(k,1934) * lu(k,1928) - lu(k,1951) = lu(k,1951) - lu(k,1929) * lu(k,1950) - lu(k,1952) = lu(k,1952) - lu(k,1930) * lu(k,1950) - lu(k,1953) = lu(k,1953) - lu(k,1931) * lu(k,1950) - lu(k,1954) = lu(k,1954) - lu(k,1932) * lu(k,1950) - lu(k,1955) = lu(k,1955) - lu(k,1933) * lu(k,1950) - lu(k,1956) = lu(k,1956) - lu(k,1934) * lu(k,1950) - lu(k,1993) = lu(k,1993) - lu(k,1929) * lu(k,1992) - lu(k,1994) = lu(k,1994) - lu(k,1930) * lu(k,1992) - lu(k,1995) = lu(k,1995) - lu(k,1931) * lu(k,1992) - lu(k,1996) = lu(k,1996) - lu(k,1932) * lu(k,1992) - lu(k,1997) = lu(k,1997) - lu(k,1933) * lu(k,1992) - lu(k,1998) = lu(k,1998) - lu(k,1934) * lu(k,1992) - lu(k,2017) = lu(k,2017) - lu(k,1929) * lu(k,2016) - lu(k,2018) = lu(k,2018) - lu(k,1930) * lu(k,2016) - lu(k,2019) = lu(k,2019) - lu(k,1931) * lu(k,2016) - lu(k,2020) = lu(k,2020) - lu(k,1932) * lu(k,2016) - lu(k,2021) = lu(k,2021) - lu(k,1933) * lu(k,2016) - lu(k,2022) = lu(k,2022) - lu(k,1934) * lu(k,2016) - lu(k,2112) = lu(k,2112) - lu(k,1929) * lu(k,2111) - lu(k,2113) = lu(k,2113) - lu(k,1930) * lu(k,2111) - lu(k,2114) = lu(k,2114) - lu(k,1931) * lu(k,2111) - lu(k,2115) = lu(k,2115) - lu(k,1932) * lu(k,2111) - lu(k,2116) = lu(k,2116) - lu(k,1933) * lu(k,2111) - lu(k,2117) = lu(k,2117) - lu(k,1934) * lu(k,2111) - lu(k,2139) = lu(k,2139) - lu(k,1929) * lu(k,2138) - lu(k,2140) = lu(k,2140) - lu(k,1930) * lu(k,2138) - lu(k,2141) = lu(k,2141) - lu(k,1931) * lu(k,2138) - lu(k,2142) = lu(k,2142) - lu(k,1932) * lu(k,2138) - lu(k,2143) = lu(k,2143) - lu(k,1933) * lu(k,2138) - lu(k,2144) = lu(k,2144) - lu(k,1934) * lu(k,2138) - lu(k,2165) = lu(k,2165) - lu(k,1929) * lu(k,2164) - lu(k,2166) = lu(k,2166) - lu(k,1930) * lu(k,2164) - lu(k,2167) = lu(k,2167) - lu(k,1931) * lu(k,2164) - lu(k,2168) = lu(k,2168) - lu(k,1932) * lu(k,2164) - lu(k,2169) = lu(k,2169) - lu(k,1933) * lu(k,2164) - lu(k,2170) = lu(k,2170) - lu(k,1934) * lu(k,2164) - lu(k,1951) = 1._r8 / lu(k,1951) - lu(k,1952) = lu(k,1952) * lu(k,1951) - lu(k,1953) = lu(k,1953) * lu(k,1951) - lu(k,1954) = lu(k,1954) * lu(k,1951) - lu(k,1955) = lu(k,1955) * lu(k,1951) - lu(k,1956) = lu(k,1956) * lu(k,1951) - lu(k,1994) = lu(k,1994) - lu(k,1952) * lu(k,1993) - lu(k,1995) = lu(k,1995) - lu(k,1953) * lu(k,1993) - lu(k,1996) = lu(k,1996) - lu(k,1954) * lu(k,1993) - lu(k,1997) = lu(k,1997) - lu(k,1955) * lu(k,1993) - lu(k,1998) = lu(k,1998) - lu(k,1956) * lu(k,1993) - lu(k,2018) = lu(k,2018) - lu(k,1952) * lu(k,2017) - lu(k,2019) = lu(k,2019) - lu(k,1953) * lu(k,2017) - lu(k,2020) = lu(k,2020) - lu(k,1954) * lu(k,2017) - lu(k,2021) = lu(k,2021) - lu(k,1955) * lu(k,2017) - lu(k,2022) = lu(k,2022) - lu(k,1956) * lu(k,2017) - lu(k,2113) = lu(k,2113) - lu(k,1952) * lu(k,2112) - lu(k,2114) = lu(k,2114) - lu(k,1953) * lu(k,2112) - lu(k,2115) = lu(k,2115) - lu(k,1954) * lu(k,2112) - lu(k,2116) = lu(k,2116) - lu(k,1955) * lu(k,2112) - lu(k,2117) = lu(k,2117) - lu(k,1956) * lu(k,2112) - lu(k,2140) = lu(k,2140) - lu(k,1952) * lu(k,2139) - lu(k,2141) = lu(k,2141) - lu(k,1953) * lu(k,2139) - lu(k,2142) = lu(k,2142) - lu(k,1954) * lu(k,2139) - lu(k,2143) = lu(k,2143) - lu(k,1955) * lu(k,2139) - lu(k,2144) = lu(k,2144) - lu(k,1956) * lu(k,2139) - lu(k,2166) = lu(k,2166) - lu(k,1952) * lu(k,2165) - lu(k,2167) = lu(k,2167) - lu(k,1953) * lu(k,2165) - lu(k,2168) = lu(k,2168) - lu(k,1954) * lu(k,2165) - lu(k,2169) = lu(k,2169) - lu(k,1955) * lu(k,2165) - lu(k,2170) = lu(k,2170) - lu(k,1956) * lu(k,2165) + lu(k,1509) = 1._r8 / lu(k,1509) + lu(k,1510) = lu(k,1510) * lu(k,1509) + lu(k,1511) = lu(k,1511) * lu(k,1509) + lu(k,1512) = lu(k,1512) * lu(k,1509) + lu(k,1513) = lu(k,1513) * lu(k,1509) + lu(k,1514) = lu(k,1514) * lu(k,1509) + lu(k,1515) = lu(k,1515) * lu(k,1509) + lu(k,1516) = lu(k,1516) * lu(k,1509) + lu(k,1517) = lu(k,1517) * lu(k,1509) + lu(k,1518) = lu(k,1518) * lu(k,1509) + lu(k,1519) = lu(k,1519) * lu(k,1509) + lu(k,1520) = lu(k,1520) * lu(k,1509) + lu(k,1521) = lu(k,1521) * lu(k,1509) + lu(k,1540) = lu(k,1540) - lu(k,1510) * lu(k,1539) + lu(k,1541) = lu(k,1541) - lu(k,1511) * lu(k,1539) + lu(k,1543) = lu(k,1543) - lu(k,1512) * lu(k,1539) + lu(k,1544) = lu(k,1544) - lu(k,1513) * lu(k,1539) + lu(k,1545) = lu(k,1545) - lu(k,1514) * lu(k,1539) + lu(k,1547) = lu(k,1547) - lu(k,1515) * lu(k,1539) + lu(k,1548) = lu(k,1548) - lu(k,1516) * lu(k,1539) + lu(k,1549) = lu(k,1549) - lu(k,1517) * lu(k,1539) + lu(k,1550) = lu(k,1550) - lu(k,1518) * lu(k,1539) + lu(k,1551) = lu(k,1551) - lu(k,1519) * lu(k,1539) + lu(k,1552) = lu(k,1552) - lu(k,1520) * lu(k,1539) + lu(k,1553) = lu(k,1553) - lu(k,1521) * lu(k,1539) + lu(k,1562) = lu(k,1562) - lu(k,1510) * lu(k,1561) + lu(k,1563) = lu(k,1563) - lu(k,1511) * lu(k,1561) + lu(k,1565) = lu(k,1565) - lu(k,1512) * lu(k,1561) + lu(k,1566) = lu(k,1566) - lu(k,1513) * lu(k,1561) + lu(k,1567) = lu(k,1567) - lu(k,1514) * lu(k,1561) + lu(k,1571) = lu(k,1571) - lu(k,1515) * lu(k,1561) + lu(k,1572) = lu(k,1572) - lu(k,1516) * lu(k,1561) + lu(k,1573) = lu(k,1573) - lu(k,1517) * lu(k,1561) + lu(k,1574) = lu(k,1574) - lu(k,1518) * lu(k,1561) + lu(k,1575) = - lu(k,1519) * lu(k,1561) + lu(k,1576) = lu(k,1576) - lu(k,1520) * lu(k,1561) + lu(k,1577) = lu(k,1577) - lu(k,1521) * lu(k,1561) + lu(k,1588) = lu(k,1588) - lu(k,1510) * lu(k,1587) + lu(k,1589) = lu(k,1589) - lu(k,1511) * lu(k,1587) + lu(k,1591) = lu(k,1591) - lu(k,1512) * lu(k,1587) + lu(k,1592) = lu(k,1592) - lu(k,1513) * lu(k,1587) + lu(k,1593) = lu(k,1593) - lu(k,1514) * lu(k,1587) + lu(k,1597) = lu(k,1597) - lu(k,1515) * lu(k,1587) + lu(k,1598) = lu(k,1598) - lu(k,1516) * lu(k,1587) + lu(k,1599) = lu(k,1599) - lu(k,1517) * lu(k,1587) + lu(k,1601) = lu(k,1601) - lu(k,1518) * lu(k,1587) + lu(k,1602) = lu(k,1602) - lu(k,1519) * lu(k,1587) + lu(k,1603) = lu(k,1603) - lu(k,1520) * lu(k,1587) + lu(k,1604) = lu(k,1604) - lu(k,1521) * lu(k,1587) + lu(k,1630) = lu(k,1630) - lu(k,1510) * lu(k,1629) + lu(k,1631) = lu(k,1631) - lu(k,1511) * lu(k,1629) + lu(k,1633) = lu(k,1633) - lu(k,1512) * lu(k,1629) + lu(k,1634) = lu(k,1634) - lu(k,1513) * lu(k,1629) + lu(k,1635) = lu(k,1635) - lu(k,1514) * lu(k,1629) + lu(k,1639) = lu(k,1639) - lu(k,1515) * lu(k,1629) + lu(k,1640) = lu(k,1640) - lu(k,1516) * lu(k,1629) + lu(k,1641) = lu(k,1641) - lu(k,1517) * lu(k,1629) + lu(k,1644) = lu(k,1644) - lu(k,1518) * lu(k,1629) + lu(k,1645) = lu(k,1645) - lu(k,1519) * lu(k,1629) + lu(k,1646) = lu(k,1646) - lu(k,1520) * lu(k,1629) + lu(k,1647) = lu(k,1647) - lu(k,1521) * lu(k,1629) + lu(k,1795) = lu(k,1795) - lu(k,1510) * lu(k,1794) + lu(k,1796) = lu(k,1796) - lu(k,1511) * lu(k,1794) + lu(k,1798) = lu(k,1798) - lu(k,1512) * lu(k,1794) + lu(k,1799) = lu(k,1799) - lu(k,1513) * lu(k,1794) + lu(k,1800) = lu(k,1800) - lu(k,1514) * lu(k,1794) + lu(k,1804) = lu(k,1804) - lu(k,1515) * lu(k,1794) + lu(k,1805) = lu(k,1805) - lu(k,1516) * lu(k,1794) + lu(k,1806) = lu(k,1806) - lu(k,1517) * lu(k,1794) + lu(k,1809) = lu(k,1809) - lu(k,1518) * lu(k,1794) + lu(k,1810) = lu(k,1810) - lu(k,1519) * lu(k,1794) + lu(k,1811) = lu(k,1811) - lu(k,1520) * lu(k,1794) + lu(k,1812) = lu(k,1812) - lu(k,1521) * lu(k,1794) + lu(k,1840) = lu(k,1840) - lu(k,1510) * lu(k,1839) + lu(k,1841) = lu(k,1841) - lu(k,1511) * lu(k,1839) + lu(k,1843) = lu(k,1843) - lu(k,1512) * lu(k,1839) + lu(k,1844) = lu(k,1844) - lu(k,1513) * lu(k,1839) + lu(k,1845) = lu(k,1845) - lu(k,1514) * lu(k,1839) + lu(k,1849) = lu(k,1849) - lu(k,1515) * lu(k,1839) + lu(k,1850) = lu(k,1850) - lu(k,1516) * lu(k,1839) + lu(k,1851) = lu(k,1851) - lu(k,1517) * lu(k,1839) + lu(k,1854) = lu(k,1854) - lu(k,1518) * lu(k,1839) + lu(k,1855) = lu(k,1855) - lu(k,1519) * lu(k,1839) + lu(k,1856) = lu(k,1856) - lu(k,1520) * lu(k,1839) + lu(k,1857) = lu(k,1857) - lu(k,1521) * lu(k,1839) + lu(k,1900) = lu(k,1900) - lu(k,1510) * lu(k,1899) + lu(k,1901) = lu(k,1901) - lu(k,1511) * lu(k,1899) + lu(k,1903) = lu(k,1903) - lu(k,1512) * lu(k,1899) + lu(k,1904) = lu(k,1904) - lu(k,1513) * lu(k,1899) + lu(k,1905) = lu(k,1905) - lu(k,1514) * lu(k,1899) + lu(k,1909) = lu(k,1909) - lu(k,1515) * lu(k,1899) + lu(k,1910) = lu(k,1910) - lu(k,1516) * lu(k,1899) + lu(k,1911) = lu(k,1911) - lu(k,1517) * lu(k,1899) + lu(k,1914) = lu(k,1914) - lu(k,1518) * lu(k,1899) + lu(k,1915) = lu(k,1915) - lu(k,1519) * lu(k,1899) + lu(k,1916) = lu(k,1916) - lu(k,1520) * lu(k,1899) + lu(k,1917) = lu(k,1917) - lu(k,1521) * lu(k,1899) + lu(k,1946) = lu(k,1946) - lu(k,1510) * lu(k,1945) + lu(k,1947) = lu(k,1947) - lu(k,1511) * lu(k,1945) + lu(k,1949) = lu(k,1949) - lu(k,1512) * lu(k,1945) + lu(k,1950) = lu(k,1950) - lu(k,1513) * lu(k,1945) + lu(k,1951) = lu(k,1951) - lu(k,1514) * lu(k,1945) + lu(k,1955) = lu(k,1955) - lu(k,1515) * lu(k,1945) + lu(k,1956) = lu(k,1956) - lu(k,1516) * lu(k,1945) + lu(k,1957) = lu(k,1957) - lu(k,1517) * lu(k,1945) + lu(k,1960) = lu(k,1960) - lu(k,1518) * lu(k,1945) + lu(k,1961) = lu(k,1961) - lu(k,1519) * lu(k,1945) + lu(k,1962) = lu(k,1962) - lu(k,1520) * lu(k,1945) + lu(k,1963) = lu(k,1963) - lu(k,1521) * lu(k,1945) + lu(k,1969) = - lu(k,1510) * lu(k,1968) + lu(k,1970) = lu(k,1970) - lu(k,1511) * lu(k,1968) + lu(k,1972) = lu(k,1972) - lu(k,1512) * lu(k,1968) + lu(k,1973) = lu(k,1973) - lu(k,1513) * lu(k,1968) + lu(k,1974) = lu(k,1974) - lu(k,1514) * lu(k,1968) + lu(k,1978) = - lu(k,1515) * lu(k,1968) + lu(k,1979) = lu(k,1979) - lu(k,1516) * lu(k,1968) + lu(k,1980) = - lu(k,1517) * lu(k,1968) + lu(k,1983) = lu(k,1983) - lu(k,1518) * lu(k,1968) + lu(k,1984) = - lu(k,1519) * lu(k,1968) + lu(k,1985) = - lu(k,1520) * lu(k,1968) + lu(k,1986) = lu(k,1986) - lu(k,1521) * lu(k,1968) + lu(k,2064) = lu(k,2064) - lu(k,1510) * lu(k,2063) + lu(k,2065) = lu(k,2065) - lu(k,1511) * lu(k,2063) + lu(k,2067) = lu(k,2067) - lu(k,1512) * lu(k,2063) + lu(k,2068) = lu(k,2068) - lu(k,1513) * lu(k,2063) + lu(k,2069) = lu(k,2069) - lu(k,1514) * lu(k,2063) + lu(k,2073) = lu(k,2073) - lu(k,1515) * lu(k,2063) + lu(k,2074) = lu(k,2074) - lu(k,1516) * lu(k,2063) + lu(k,2075) = lu(k,2075) - lu(k,1517) * lu(k,2063) + lu(k,2078) = lu(k,2078) - lu(k,1518) * lu(k,2063) + lu(k,2079) = lu(k,2079) - lu(k,1519) * lu(k,2063) + lu(k,2080) = lu(k,2080) - lu(k,1520) * lu(k,2063) + lu(k,2081) = lu(k,2081) - lu(k,1521) * lu(k,2063) + lu(k,2085) = lu(k,2085) - lu(k,1510) * lu(k,2084) + lu(k,2086) = lu(k,2086) - lu(k,1511) * lu(k,2084) + lu(k,2088) = lu(k,2088) - lu(k,1512) * lu(k,2084) + lu(k,2089) = lu(k,2089) - lu(k,1513) * lu(k,2084) + lu(k,2090) = lu(k,2090) - lu(k,1514) * lu(k,2084) + lu(k,2094) = - lu(k,1515) * lu(k,2084) + lu(k,2095) = lu(k,2095) - lu(k,1516) * lu(k,2084) + lu(k,2096) = lu(k,2096) - lu(k,1517) * lu(k,2084) + lu(k,2099) = lu(k,2099) - lu(k,1518) * lu(k,2084) + lu(k,2100) = - lu(k,1519) * lu(k,2084) + lu(k,2101) = lu(k,2101) - lu(k,1520) * lu(k,2084) + lu(k,2102) = lu(k,2102) - lu(k,1521) * lu(k,2084) + lu(k,2193) = lu(k,2193) - lu(k,1510) * lu(k,2192) + lu(k,2194) = lu(k,2194) - lu(k,1511) * lu(k,2192) + lu(k,2196) = lu(k,2196) - lu(k,1512) * lu(k,2192) + lu(k,2197) = lu(k,2197) - lu(k,1513) * lu(k,2192) + lu(k,2198) = lu(k,2198) - lu(k,1514) * lu(k,2192) + lu(k,2202) = lu(k,2202) - lu(k,1515) * lu(k,2192) + lu(k,2203) = lu(k,2203) - lu(k,1516) * lu(k,2192) + lu(k,2204) = lu(k,2204) - lu(k,1517) * lu(k,2192) + lu(k,2207) = lu(k,2207) - lu(k,1518) * lu(k,2192) + lu(k,2208) = lu(k,2208) - lu(k,1519) * lu(k,2192) + lu(k,2209) = lu(k,2209) - lu(k,1520) * lu(k,2192) + lu(k,2210) = lu(k,2210) - lu(k,1521) * lu(k,2192) + lu(k,2270) = lu(k,2270) - lu(k,1510) * lu(k,2269) + lu(k,2271) = lu(k,2271) - lu(k,1511) * lu(k,2269) + lu(k,2273) = lu(k,2273) - lu(k,1512) * lu(k,2269) + lu(k,2274) = lu(k,2274) - lu(k,1513) * lu(k,2269) + lu(k,2275) = lu(k,2275) - lu(k,1514) * lu(k,2269) + lu(k,2279) = lu(k,2279) - lu(k,1515) * lu(k,2269) + lu(k,2280) = lu(k,2280) - lu(k,1516) * lu(k,2269) + lu(k,2281) = lu(k,2281) - lu(k,1517) * lu(k,2269) + lu(k,2284) = lu(k,2284) - lu(k,1518) * lu(k,2269) + lu(k,2285) = lu(k,2285) - lu(k,1519) * lu(k,2269) + lu(k,2286) = - lu(k,1520) * lu(k,2269) + lu(k,2287) = lu(k,2287) - lu(k,1521) * lu(k,2269) + lu(k,2313) = lu(k,2313) - lu(k,1510) * lu(k,2312) + lu(k,2314) = lu(k,2314) - lu(k,1511) * lu(k,2312) + lu(k,2316) = lu(k,2316) - lu(k,1512) * lu(k,2312) + lu(k,2317) = lu(k,2317) - lu(k,1513) * lu(k,2312) + lu(k,2318) = lu(k,2318) - lu(k,1514) * lu(k,2312) + lu(k,2322) = lu(k,2322) - lu(k,1515) * lu(k,2312) + lu(k,2323) = lu(k,2323) - lu(k,1516) * lu(k,2312) + lu(k,2324) = lu(k,2324) - lu(k,1517) * lu(k,2312) + lu(k,2327) = lu(k,2327) - lu(k,1518) * lu(k,2312) + lu(k,2328) = lu(k,2328) - lu(k,1519) * lu(k,2312) + lu(k,2329) = lu(k,2329) - lu(k,1520) * lu(k,2312) + lu(k,2330) = lu(k,2330) - lu(k,1521) * lu(k,2312) + lu(k,2339) = lu(k,2339) - lu(k,1510) * lu(k,2338) + lu(k,2340) = lu(k,2340) - lu(k,1511) * lu(k,2338) + lu(k,2342) = lu(k,2342) - lu(k,1512) * lu(k,2338) + lu(k,2343) = lu(k,2343) - lu(k,1513) * lu(k,2338) + lu(k,2344) = lu(k,2344) - lu(k,1514) * lu(k,2338) + lu(k,2348) = lu(k,2348) - lu(k,1515) * lu(k,2338) + lu(k,2349) = lu(k,2349) - lu(k,1516) * lu(k,2338) + lu(k,2350) = lu(k,2350) - lu(k,1517) * lu(k,2338) + lu(k,2353) = lu(k,2353) - lu(k,1518) * lu(k,2338) + lu(k,2354) = lu(k,2354) - lu(k,1519) * lu(k,2338) + lu(k,2355) = - lu(k,1520) * lu(k,2338) + lu(k,2356) = lu(k,2356) - lu(k,1521) * lu(k,2338) + lu(k,2403) = lu(k,2403) - lu(k,1510) * lu(k,2402) + lu(k,2404) = lu(k,2404) - lu(k,1511) * lu(k,2402) + lu(k,2406) = lu(k,2406) - lu(k,1512) * lu(k,2402) + lu(k,2407) = lu(k,2407) - lu(k,1513) * lu(k,2402) + lu(k,2408) = lu(k,2408) - lu(k,1514) * lu(k,2402) + lu(k,2412) = lu(k,2412) - lu(k,1515) * lu(k,2402) + lu(k,2413) = lu(k,2413) - lu(k,1516) * lu(k,2402) + lu(k,2414) = lu(k,2414) - lu(k,1517) * lu(k,2402) + lu(k,2417) = lu(k,2417) - lu(k,1518) * lu(k,2402) + lu(k,2418) = lu(k,2418) - lu(k,1519) * lu(k,2402) + lu(k,2419) = lu(k,2419) - lu(k,1520) * lu(k,2402) + lu(k,2420) = lu(k,2420) - lu(k,1521) * lu(k,2402) + lu(k,2430) = lu(k,2430) - lu(k,1510) * lu(k,2429) + lu(k,2431) = lu(k,2431) - lu(k,1511) * lu(k,2429) + lu(k,2433) = lu(k,2433) - lu(k,1512) * lu(k,2429) + lu(k,2434) = lu(k,2434) - lu(k,1513) * lu(k,2429) + lu(k,2435) = lu(k,2435) - lu(k,1514) * lu(k,2429) + lu(k,2439) = lu(k,2439) - lu(k,1515) * lu(k,2429) + lu(k,2440) = lu(k,2440) - lu(k,1516) * lu(k,2429) + lu(k,2441) = lu(k,2441) - lu(k,1517) * lu(k,2429) + lu(k,2444) = lu(k,2444) - lu(k,1518) * lu(k,2429) + lu(k,2445) = - lu(k,1519) * lu(k,2429) + lu(k,2446) = lu(k,2446) - lu(k,1520) * lu(k,2429) + lu(k,2447) = lu(k,2447) - lu(k,1521) * lu(k,2429) + lu(k,1540) = 1._r8 / lu(k,1540) + lu(k,1541) = lu(k,1541) * lu(k,1540) + lu(k,1542) = lu(k,1542) * lu(k,1540) + lu(k,1543) = lu(k,1543) * lu(k,1540) + lu(k,1544) = lu(k,1544) * lu(k,1540) + lu(k,1545) = lu(k,1545) * lu(k,1540) + lu(k,1546) = lu(k,1546) * lu(k,1540) + lu(k,1547) = lu(k,1547) * lu(k,1540) + lu(k,1548) = lu(k,1548) * lu(k,1540) + lu(k,1549) = lu(k,1549) * lu(k,1540) + lu(k,1550) = lu(k,1550) * lu(k,1540) + lu(k,1551) = lu(k,1551) * lu(k,1540) + lu(k,1552) = lu(k,1552) * lu(k,1540) + lu(k,1553) = lu(k,1553) * lu(k,1540) + lu(k,1563) = lu(k,1563) - lu(k,1541) * lu(k,1562) + lu(k,1564) = lu(k,1564) - lu(k,1542) * lu(k,1562) + lu(k,1565) = lu(k,1565) - lu(k,1543) * lu(k,1562) + lu(k,1566) = lu(k,1566) - lu(k,1544) * lu(k,1562) + lu(k,1567) = lu(k,1567) - lu(k,1545) * lu(k,1562) + lu(k,1569) = lu(k,1569) - lu(k,1546) * lu(k,1562) + lu(k,1571) = lu(k,1571) - lu(k,1547) * lu(k,1562) + lu(k,1572) = lu(k,1572) - lu(k,1548) * lu(k,1562) + lu(k,1573) = lu(k,1573) - lu(k,1549) * lu(k,1562) + lu(k,1574) = lu(k,1574) - lu(k,1550) * lu(k,1562) + lu(k,1575) = lu(k,1575) - lu(k,1551) * lu(k,1562) + lu(k,1576) = lu(k,1576) - lu(k,1552) * lu(k,1562) + lu(k,1577) = lu(k,1577) - lu(k,1553) * lu(k,1562) + lu(k,1589) = lu(k,1589) - lu(k,1541) * lu(k,1588) + lu(k,1590) = lu(k,1590) - lu(k,1542) * lu(k,1588) + lu(k,1591) = lu(k,1591) - lu(k,1543) * lu(k,1588) + lu(k,1592) = lu(k,1592) - lu(k,1544) * lu(k,1588) + lu(k,1593) = lu(k,1593) - lu(k,1545) * lu(k,1588) + lu(k,1595) = lu(k,1595) - lu(k,1546) * lu(k,1588) + lu(k,1597) = lu(k,1597) - lu(k,1547) * lu(k,1588) + lu(k,1598) = lu(k,1598) - lu(k,1548) * lu(k,1588) + lu(k,1599) = lu(k,1599) - lu(k,1549) * lu(k,1588) + lu(k,1601) = lu(k,1601) - lu(k,1550) * lu(k,1588) + lu(k,1602) = lu(k,1602) - lu(k,1551) * lu(k,1588) + lu(k,1603) = lu(k,1603) - lu(k,1552) * lu(k,1588) + lu(k,1604) = lu(k,1604) - lu(k,1553) * lu(k,1588) + lu(k,1631) = lu(k,1631) - lu(k,1541) * lu(k,1630) + lu(k,1632) = lu(k,1632) - lu(k,1542) * lu(k,1630) + lu(k,1633) = lu(k,1633) - lu(k,1543) * lu(k,1630) + lu(k,1634) = lu(k,1634) - lu(k,1544) * lu(k,1630) + lu(k,1635) = lu(k,1635) - lu(k,1545) * lu(k,1630) + lu(k,1637) = lu(k,1637) - lu(k,1546) * lu(k,1630) + lu(k,1639) = lu(k,1639) - lu(k,1547) * lu(k,1630) + lu(k,1640) = lu(k,1640) - lu(k,1548) * lu(k,1630) + lu(k,1641) = lu(k,1641) - lu(k,1549) * lu(k,1630) + lu(k,1644) = lu(k,1644) - lu(k,1550) * lu(k,1630) + lu(k,1645) = lu(k,1645) - lu(k,1551) * lu(k,1630) + lu(k,1646) = lu(k,1646) - lu(k,1552) * lu(k,1630) + lu(k,1647) = lu(k,1647) - lu(k,1553) * lu(k,1630) + lu(k,1796) = lu(k,1796) - lu(k,1541) * lu(k,1795) + lu(k,1797) = lu(k,1797) - lu(k,1542) * lu(k,1795) + lu(k,1798) = lu(k,1798) - lu(k,1543) * lu(k,1795) + lu(k,1799) = lu(k,1799) - lu(k,1544) * lu(k,1795) + lu(k,1800) = lu(k,1800) - lu(k,1545) * lu(k,1795) + lu(k,1802) = lu(k,1802) - lu(k,1546) * lu(k,1795) + lu(k,1804) = lu(k,1804) - lu(k,1547) * lu(k,1795) + lu(k,1805) = lu(k,1805) - lu(k,1548) * lu(k,1795) + lu(k,1806) = lu(k,1806) - lu(k,1549) * lu(k,1795) + lu(k,1809) = lu(k,1809) - lu(k,1550) * lu(k,1795) + lu(k,1810) = lu(k,1810) - lu(k,1551) * lu(k,1795) + lu(k,1811) = lu(k,1811) - lu(k,1552) * lu(k,1795) + lu(k,1812) = lu(k,1812) - lu(k,1553) * lu(k,1795) + lu(k,1841) = lu(k,1841) - lu(k,1541) * lu(k,1840) + lu(k,1842) = lu(k,1842) - lu(k,1542) * lu(k,1840) + lu(k,1843) = lu(k,1843) - lu(k,1543) * lu(k,1840) + lu(k,1844) = lu(k,1844) - lu(k,1544) * lu(k,1840) + lu(k,1845) = lu(k,1845) - lu(k,1545) * lu(k,1840) + lu(k,1847) = lu(k,1847) - lu(k,1546) * lu(k,1840) + lu(k,1849) = lu(k,1849) - lu(k,1547) * lu(k,1840) + lu(k,1850) = lu(k,1850) - lu(k,1548) * lu(k,1840) + lu(k,1851) = lu(k,1851) - lu(k,1549) * lu(k,1840) + lu(k,1854) = lu(k,1854) - lu(k,1550) * lu(k,1840) + lu(k,1855) = lu(k,1855) - lu(k,1551) * lu(k,1840) + lu(k,1856) = lu(k,1856) - lu(k,1552) * lu(k,1840) + lu(k,1857) = lu(k,1857) - lu(k,1553) * lu(k,1840) + lu(k,1901) = lu(k,1901) - lu(k,1541) * lu(k,1900) + lu(k,1902) = lu(k,1902) - lu(k,1542) * lu(k,1900) + lu(k,1903) = lu(k,1903) - lu(k,1543) * lu(k,1900) + lu(k,1904) = lu(k,1904) - lu(k,1544) * lu(k,1900) + lu(k,1905) = lu(k,1905) - lu(k,1545) * lu(k,1900) + lu(k,1907) = lu(k,1907) - lu(k,1546) * lu(k,1900) + lu(k,1909) = lu(k,1909) - lu(k,1547) * lu(k,1900) + lu(k,1910) = lu(k,1910) - lu(k,1548) * lu(k,1900) + lu(k,1911) = lu(k,1911) - lu(k,1549) * lu(k,1900) + lu(k,1914) = lu(k,1914) - lu(k,1550) * lu(k,1900) + lu(k,1915) = lu(k,1915) - lu(k,1551) * lu(k,1900) + lu(k,1916) = lu(k,1916) - lu(k,1552) * lu(k,1900) + lu(k,1917) = lu(k,1917) - lu(k,1553) * lu(k,1900) + lu(k,1947) = lu(k,1947) - lu(k,1541) * lu(k,1946) + lu(k,1948) = lu(k,1948) - lu(k,1542) * lu(k,1946) + lu(k,1949) = lu(k,1949) - lu(k,1543) * lu(k,1946) + lu(k,1950) = lu(k,1950) - lu(k,1544) * lu(k,1946) + lu(k,1951) = lu(k,1951) - lu(k,1545) * lu(k,1946) + lu(k,1953) = lu(k,1953) - lu(k,1546) * lu(k,1946) + lu(k,1955) = lu(k,1955) - lu(k,1547) * lu(k,1946) + lu(k,1956) = lu(k,1956) - lu(k,1548) * lu(k,1946) + lu(k,1957) = lu(k,1957) - lu(k,1549) * lu(k,1946) + lu(k,1960) = lu(k,1960) - lu(k,1550) * lu(k,1946) + lu(k,1961) = lu(k,1961) - lu(k,1551) * lu(k,1946) + lu(k,1962) = lu(k,1962) - lu(k,1552) * lu(k,1946) + lu(k,1963) = lu(k,1963) - lu(k,1553) * lu(k,1946) + lu(k,1970) = lu(k,1970) - lu(k,1541) * lu(k,1969) + lu(k,1971) = lu(k,1971) - lu(k,1542) * lu(k,1969) + lu(k,1972) = lu(k,1972) - lu(k,1543) * lu(k,1969) + lu(k,1973) = lu(k,1973) - lu(k,1544) * lu(k,1969) + lu(k,1974) = lu(k,1974) - lu(k,1545) * lu(k,1969) + lu(k,1976) = lu(k,1976) - lu(k,1546) * lu(k,1969) + lu(k,1978) = lu(k,1978) - lu(k,1547) * lu(k,1969) + lu(k,1979) = lu(k,1979) - lu(k,1548) * lu(k,1969) + lu(k,1980) = lu(k,1980) - lu(k,1549) * lu(k,1969) + lu(k,1983) = lu(k,1983) - lu(k,1550) * lu(k,1969) + lu(k,1984) = lu(k,1984) - lu(k,1551) * lu(k,1969) + lu(k,1985) = lu(k,1985) - lu(k,1552) * lu(k,1969) + lu(k,1986) = lu(k,1986) - lu(k,1553) * lu(k,1969) + lu(k,2065) = lu(k,2065) - lu(k,1541) * lu(k,2064) + lu(k,2066) = lu(k,2066) - lu(k,1542) * lu(k,2064) + lu(k,2067) = lu(k,2067) - lu(k,1543) * lu(k,2064) + lu(k,2068) = lu(k,2068) - lu(k,1544) * lu(k,2064) + lu(k,2069) = lu(k,2069) - lu(k,1545) * lu(k,2064) + lu(k,2071) = lu(k,2071) - lu(k,1546) * lu(k,2064) + lu(k,2073) = lu(k,2073) - lu(k,1547) * lu(k,2064) + lu(k,2074) = lu(k,2074) - lu(k,1548) * lu(k,2064) + lu(k,2075) = lu(k,2075) - lu(k,1549) * lu(k,2064) + lu(k,2078) = lu(k,2078) - lu(k,1550) * lu(k,2064) + lu(k,2079) = lu(k,2079) - lu(k,1551) * lu(k,2064) + lu(k,2080) = lu(k,2080) - lu(k,1552) * lu(k,2064) + lu(k,2081) = lu(k,2081) - lu(k,1553) * lu(k,2064) + lu(k,2086) = lu(k,2086) - lu(k,1541) * lu(k,2085) + lu(k,2087) = lu(k,2087) - lu(k,1542) * lu(k,2085) + lu(k,2088) = lu(k,2088) - lu(k,1543) * lu(k,2085) + lu(k,2089) = lu(k,2089) - lu(k,1544) * lu(k,2085) + lu(k,2090) = lu(k,2090) - lu(k,1545) * lu(k,2085) + lu(k,2092) = lu(k,2092) - lu(k,1546) * lu(k,2085) + lu(k,2094) = lu(k,2094) - lu(k,1547) * lu(k,2085) + lu(k,2095) = lu(k,2095) - lu(k,1548) * lu(k,2085) + lu(k,2096) = lu(k,2096) - lu(k,1549) * lu(k,2085) + lu(k,2099) = lu(k,2099) - lu(k,1550) * lu(k,2085) + lu(k,2100) = lu(k,2100) - lu(k,1551) * lu(k,2085) + lu(k,2101) = lu(k,2101) - lu(k,1552) * lu(k,2085) + lu(k,2102) = lu(k,2102) - lu(k,1553) * lu(k,2085) + lu(k,2194) = lu(k,2194) - lu(k,1541) * lu(k,2193) + lu(k,2195) = lu(k,2195) - lu(k,1542) * lu(k,2193) + lu(k,2196) = lu(k,2196) - lu(k,1543) * lu(k,2193) + lu(k,2197) = lu(k,2197) - lu(k,1544) * lu(k,2193) + lu(k,2198) = lu(k,2198) - lu(k,1545) * lu(k,2193) + lu(k,2200) = lu(k,2200) - lu(k,1546) * lu(k,2193) + lu(k,2202) = lu(k,2202) - lu(k,1547) * lu(k,2193) + lu(k,2203) = lu(k,2203) - lu(k,1548) * lu(k,2193) + lu(k,2204) = lu(k,2204) - lu(k,1549) * lu(k,2193) + lu(k,2207) = lu(k,2207) - lu(k,1550) * lu(k,2193) + lu(k,2208) = lu(k,2208) - lu(k,1551) * lu(k,2193) + lu(k,2209) = lu(k,2209) - lu(k,1552) * lu(k,2193) + lu(k,2210) = lu(k,2210) - lu(k,1553) * lu(k,2193) + lu(k,2246) = - lu(k,1541) * lu(k,2245) + lu(k,2247) = lu(k,2247) - lu(k,1542) * lu(k,2245) + lu(k,2248) = lu(k,2248) - lu(k,1543) * lu(k,2245) + lu(k,2249) = lu(k,2249) - lu(k,1544) * lu(k,2245) + lu(k,2250) = lu(k,2250) - lu(k,1545) * lu(k,2245) + lu(k,2252) = lu(k,2252) - lu(k,1546) * lu(k,2245) + lu(k,2254) = lu(k,2254) - lu(k,1547) * lu(k,2245) + lu(k,2255) = lu(k,2255) - lu(k,1548) * lu(k,2245) + lu(k,2256) = lu(k,2256) - lu(k,1549) * lu(k,2245) + lu(k,2259) = lu(k,2259) - lu(k,1550) * lu(k,2245) + lu(k,2260) = lu(k,2260) - lu(k,1551) * lu(k,2245) + lu(k,2261) = lu(k,2261) - lu(k,1552) * lu(k,2245) + lu(k,2262) = lu(k,2262) - lu(k,1553) * lu(k,2245) + lu(k,2271) = lu(k,2271) - lu(k,1541) * lu(k,2270) + lu(k,2272) = lu(k,2272) - lu(k,1542) * lu(k,2270) + lu(k,2273) = lu(k,2273) - lu(k,1543) * lu(k,2270) + lu(k,2274) = lu(k,2274) - lu(k,1544) * lu(k,2270) + lu(k,2275) = lu(k,2275) - lu(k,1545) * lu(k,2270) + lu(k,2277) = lu(k,2277) - lu(k,1546) * lu(k,2270) + lu(k,2279) = lu(k,2279) - lu(k,1547) * lu(k,2270) + lu(k,2280) = lu(k,2280) - lu(k,1548) * lu(k,2270) + lu(k,2281) = lu(k,2281) - lu(k,1549) * lu(k,2270) + lu(k,2284) = lu(k,2284) - lu(k,1550) * lu(k,2270) + lu(k,2285) = lu(k,2285) - lu(k,1551) * lu(k,2270) + lu(k,2286) = lu(k,2286) - lu(k,1552) * lu(k,2270) + lu(k,2287) = lu(k,2287) - lu(k,1553) * lu(k,2270) + lu(k,2314) = lu(k,2314) - lu(k,1541) * lu(k,2313) + lu(k,2315) = lu(k,2315) - lu(k,1542) * lu(k,2313) + lu(k,2316) = lu(k,2316) - lu(k,1543) * lu(k,2313) + lu(k,2317) = lu(k,2317) - lu(k,1544) * lu(k,2313) + lu(k,2318) = lu(k,2318) - lu(k,1545) * lu(k,2313) + lu(k,2320) = lu(k,2320) - lu(k,1546) * lu(k,2313) + lu(k,2322) = lu(k,2322) - lu(k,1547) * lu(k,2313) + lu(k,2323) = lu(k,2323) - lu(k,1548) * lu(k,2313) + lu(k,2324) = lu(k,2324) - lu(k,1549) * lu(k,2313) + lu(k,2327) = lu(k,2327) - lu(k,1550) * lu(k,2313) + lu(k,2328) = lu(k,2328) - lu(k,1551) * lu(k,2313) + lu(k,2329) = lu(k,2329) - lu(k,1552) * lu(k,2313) + lu(k,2330) = lu(k,2330) - lu(k,1553) * lu(k,2313) + lu(k,2340) = lu(k,2340) - lu(k,1541) * lu(k,2339) + lu(k,2341) = lu(k,2341) - lu(k,1542) * lu(k,2339) + lu(k,2342) = lu(k,2342) - lu(k,1543) * lu(k,2339) + lu(k,2343) = lu(k,2343) - lu(k,1544) * lu(k,2339) + lu(k,2344) = lu(k,2344) - lu(k,1545) * lu(k,2339) + lu(k,2346) = lu(k,2346) - lu(k,1546) * lu(k,2339) + lu(k,2348) = lu(k,2348) - lu(k,1547) * lu(k,2339) + lu(k,2349) = lu(k,2349) - lu(k,1548) * lu(k,2339) + lu(k,2350) = lu(k,2350) - lu(k,1549) * lu(k,2339) + lu(k,2353) = lu(k,2353) - lu(k,1550) * lu(k,2339) + lu(k,2354) = lu(k,2354) - lu(k,1551) * lu(k,2339) + lu(k,2355) = lu(k,2355) - lu(k,1552) * lu(k,2339) + lu(k,2356) = lu(k,2356) - lu(k,1553) * lu(k,2339) + lu(k,2404) = lu(k,2404) - lu(k,1541) * lu(k,2403) + lu(k,2405) = lu(k,2405) - lu(k,1542) * lu(k,2403) + lu(k,2406) = lu(k,2406) - lu(k,1543) * lu(k,2403) + lu(k,2407) = lu(k,2407) - lu(k,1544) * lu(k,2403) + lu(k,2408) = lu(k,2408) - lu(k,1545) * lu(k,2403) + lu(k,2410) = lu(k,2410) - lu(k,1546) * lu(k,2403) + lu(k,2412) = lu(k,2412) - lu(k,1547) * lu(k,2403) + lu(k,2413) = lu(k,2413) - lu(k,1548) * lu(k,2403) + lu(k,2414) = lu(k,2414) - lu(k,1549) * lu(k,2403) + lu(k,2417) = lu(k,2417) - lu(k,1550) * lu(k,2403) + lu(k,2418) = lu(k,2418) - lu(k,1551) * lu(k,2403) + lu(k,2419) = lu(k,2419) - lu(k,1552) * lu(k,2403) + lu(k,2420) = lu(k,2420) - lu(k,1553) * lu(k,2403) + lu(k,2431) = lu(k,2431) - lu(k,1541) * lu(k,2430) + lu(k,2432) = lu(k,2432) - lu(k,1542) * lu(k,2430) + lu(k,2433) = lu(k,2433) - lu(k,1543) * lu(k,2430) + lu(k,2434) = lu(k,2434) - lu(k,1544) * lu(k,2430) + lu(k,2435) = lu(k,2435) - lu(k,1545) * lu(k,2430) + lu(k,2437) = lu(k,2437) - lu(k,1546) * lu(k,2430) + lu(k,2439) = lu(k,2439) - lu(k,1547) * lu(k,2430) + lu(k,2440) = lu(k,2440) - lu(k,1548) * lu(k,2430) + lu(k,2441) = lu(k,2441) - lu(k,1549) * lu(k,2430) + lu(k,2444) = lu(k,2444) - lu(k,1550) * lu(k,2430) + lu(k,2445) = lu(k,2445) - lu(k,1551) * lu(k,2430) + lu(k,2446) = lu(k,2446) - lu(k,1552) * lu(k,2430) + lu(k,2447) = lu(k,2447) - lu(k,1553) * lu(k,2430) + lu(k,1563) = 1._r8 / lu(k,1563) + lu(k,1564) = lu(k,1564) * lu(k,1563) + lu(k,1565) = lu(k,1565) * lu(k,1563) + lu(k,1566) = lu(k,1566) * lu(k,1563) + lu(k,1567) = lu(k,1567) * lu(k,1563) + lu(k,1568) = lu(k,1568) * lu(k,1563) + lu(k,1569) = lu(k,1569) * lu(k,1563) + lu(k,1570) = lu(k,1570) * lu(k,1563) + lu(k,1571) = lu(k,1571) * lu(k,1563) + lu(k,1572) = lu(k,1572) * lu(k,1563) + lu(k,1573) = lu(k,1573) * lu(k,1563) + lu(k,1574) = lu(k,1574) * lu(k,1563) + lu(k,1575) = lu(k,1575) * lu(k,1563) + lu(k,1576) = lu(k,1576) * lu(k,1563) + lu(k,1577) = lu(k,1577) * lu(k,1563) + lu(k,1590) = lu(k,1590) - lu(k,1564) * lu(k,1589) + lu(k,1591) = lu(k,1591) - lu(k,1565) * lu(k,1589) + lu(k,1592) = lu(k,1592) - lu(k,1566) * lu(k,1589) + lu(k,1593) = lu(k,1593) - lu(k,1567) * lu(k,1589) + lu(k,1594) = lu(k,1594) - lu(k,1568) * lu(k,1589) + lu(k,1595) = lu(k,1595) - lu(k,1569) * lu(k,1589) + lu(k,1596) = lu(k,1596) - lu(k,1570) * lu(k,1589) + lu(k,1597) = lu(k,1597) - lu(k,1571) * lu(k,1589) + lu(k,1598) = lu(k,1598) - lu(k,1572) * lu(k,1589) + lu(k,1599) = lu(k,1599) - lu(k,1573) * lu(k,1589) + lu(k,1601) = lu(k,1601) - lu(k,1574) * lu(k,1589) + lu(k,1602) = lu(k,1602) - lu(k,1575) * lu(k,1589) + lu(k,1603) = lu(k,1603) - lu(k,1576) * lu(k,1589) + lu(k,1604) = lu(k,1604) - lu(k,1577) * lu(k,1589) + lu(k,1632) = lu(k,1632) - lu(k,1564) * lu(k,1631) + lu(k,1633) = lu(k,1633) - lu(k,1565) * lu(k,1631) + lu(k,1634) = lu(k,1634) - lu(k,1566) * lu(k,1631) + lu(k,1635) = lu(k,1635) - lu(k,1567) * lu(k,1631) + lu(k,1636) = lu(k,1636) - lu(k,1568) * lu(k,1631) + lu(k,1637) = lu(k,1637) - lu(k,1569) * lu(k,1631) + lu(k,1638) = lu(k,1638) - lu(k,1570) * lu(k,1631) + lu(k,1639) = lu(k,1639) - lu(k,1571) * lu(k,1631) + lu(k,1640) = lu(k,1640) - lu(k,1572) * lu(k,1631) + lu(k,1641) = lu(k,1641) - lu(k,1573) * lu(k,1631) + lu(k,1644) = lu(k,1644) - lu(k,1574) * lu(k,1631) + lu(k,1645) = lu(k,1645) - lu(k,1575) * lu(k,1631) + lu(k,1646) = lu(k,1646) - lu(k,1576) * lu(k,1631) + lu(k,1647) = lu(k,1647) - lu(k,1577) * lu(k,1631) + lu(k,1797) = lu(k,1797) - lu(k,1564) * lu(k,1796) + lu(k,1798) = lu(k,1798) - lu(k,1565) * lu(k,1796) + lu(k,1799) = lu(k,1799) - lu(k,1566) * lu(k,1796) + lu(k,1800) = lu(k,1800) - lu(k,1567) * lu(k,1796) + lu(k,1801) = lu(k,1801) - lu(k,1568) * lu(k,1796) + lu(k,1802) = lu(k,1802) - lu(k,1569) * lu(k,1796) + lu(k,1803) = lu(k,1803) - lu(k,1570) * lu(k,1796) + lu(k,1804) = lu(k,1804) - lu(k,1571) * lu(k,1796) + lu(k,1805) = lu(k,1805) - lu(k,1572) * lu(k,1796) + lu(k,1806) = lu(k,1806) - lu(k,1573) * lu(k,1796) + lu(k,1809) = lu(k,1809) - lu(k,1574) * lu(k,1796) + lu(k,1810) = lu(k,1810) - lu(k,1575) * lu(k,1796) + lu(k,1811) = lu(k,1811) - lu(k,1576) * lu(k,1796) + lu(k,1812) = lu(k,1812) - lu(k,1577) * lu(k,1796) + lu(k,1842) = lu(k,1842) - lu(k,1564) * lu(k,1841) + lu(k,1843) = lu(k,1843) - lu(k,1565) * lu(k,1841) + lu(k,1844) = lu(k,1844) - lu(k,1566) * lu(k,1841) + lu(k,1845) = lu(k,1845) - lu(k,1567) * lu(k,1841) + lu(k,1846) = lu(k,1846) - lu(k,1568) * lu(k,1841) + lu(k,1847) = lu(k,1847) - lu(k,1569) * lu(k,1841) + lu(k,1848) = lu(k,1848) - lu(k,1570) * lu(k,1841) + lu(k,1849) = lu(k,1849) - lu(k,1571) * lu(k,1841) + lu(k,1850) = lu(k,1850) - lu(k,1572) * lu(k,1841) + lu(k,1851) = lu(k,1851) - lu(k,1573) * lu(k,1841) + lu(k,1854) = lu(k,1854) - lu(k,1574) * lu(k,1841) + lu(k,1855) = lu(k,1855) - lu(k,1575) * lu(k,1841) + lu(k,1856) = lu(k,1856) - lu(k,1576) * lu(k,1841) + lu(k,1857) = lu(k,1857) - lu(k,1577) * lu(k,1841) + lu(k,1902) = lu(k,1902) - lu(k,1564) * lu(k,1901) + lu(k,1903) = lu(k,1903) - lu(k,1565) * lu(k,1901) + lu(k,1904) = lu(k,1904) - lu(k,1566) * lu(k,1901) + lu(k,1905) = lu(k,1905) - lu(k,1567) * lu(k,1901) + lu(k,1906) = lu(k,1906) - lu(k,1568) * lu(k,1901) + lu(k,1907) = lu(k,1907) - lu(k,1569) * lu(k,1901) + lu(k,1908) = lu(k,1908) - lu(k,1570) * lu(k,1901) + lu(k,1909) = lu(k,1909) - lu(k,1571) * lu(k,1901) + lu(k,1910) = lu(k,1910) - lu(k,1572) * lu(k,1901) + lu(k,1911) = lu(k,1911) - lu(k,1573) * lu(k,1901) + lu(k,1914) = lu(k,1914) - lu(k,1574) * lu(k,1901) + lu(k,1915) = lu(k,1915) - lu(k,1575) * lu(k,1901) + lu(k,1916) = lu(k,1916) - lu(k,1576) * lu(k,1901) + lu(k,1917) = lu(k,1917) - lu(k,1577) * lu(k,1901) + lu(k,1948) = lu(k,1948) - lu(k,1564) * lu(k,1947) + lu(k,1949) = lu(k,1949) - lu(k,1565) * lu(k,1947) + lu(k,1950) = lu(k,1950) - lu(k,1566) * lu(k,1947) + lu(k,1951) = lu(k,1951) - lu(k,1567) * lu(k,1947) + lu(k,1952) = lu(k,1952) - lu(k,1568) * lu(k,1947) + lu(k,1953) = lu(k,1953) - lu(k,1569) * lu(k,1947) + lu(k,1954) = lu(k,1954) - lu(k,1570) * lu(k,1947) + lu(k,1955) = lu(k,1955) - lu(k,1571) * lu(k,1947) + lu(k,1956) = lu(k,1956) - lu(k,1572) * lu(k,1947) + lu(k,1957) = lu(k,1957) - lu(k,1573) * lu(k,1947) + lu(k,1960) = lu(k,1960) - lu(k,1574) * lu(k,1947) + lu(k,1961) = lu(k,1961) - lu(k,1575) * lu(k,1947) + lu(k,1962) = lu(k,1962) - lu(k,1576) * lu(k,1947) + lu(k,1963) = lu(k,1963) - lu(k,1577) * lu(k,1947) + lu(k,1971) = lu(k,1971) - lu(k,1564) * lu(k,1970) + lu(k,1972) = lu(k,1972) - lu(k,1565) * lu(k,1970) + lu(k,1973) = lu(k,1973) - lu(k,1566) * lu(k,1970) + lu(k,1974) = lu(k,1974) - lu(k,1567) * lu(k,1970) + lu(k,1975) = lu(k,1975) - lu(k,1568) * lu(k,1970) + lu(k,1976) = lu(k,1976) - lu(k,1569) * lu(k,1970) + lu(k,1977) = lu(k,1977) - lu(k,1570) * lu(k,1970) + lu(k,1978) = lu(k,1978) - lu(k,1571) * lu(k,1970) + lu(k,1979) = lu(k,1979) - lu(k,1572) * lu(k,1970) + lu(k,1980) = lu(k,1980) - lu(k,1573) * lu(k,1970) + lu(k,1983) = lu(k,1983) - lu(k,1574) * lu(k,1970) + lu(k,1984) = lu(k,1984) - lu(k,1575) * lu(k,1970) + lu(k,1985) = lu(k,1985) - lu(k,1576) * lu(k,1970) + lu(k,1986) = lu(k,1986) - lu(k,1577) * lu(k,1970) + lu(k,2066) = lu(k,2066) - lu(k,1564) * lu(k,2065) + lu(k,2067) = lu(k,2067) - lu(k,1565) * lu(k,2065) + lu(k,2068) = lu(k,2068) - lu(k,1566) * lu(k,2065) + lu(k,2069) = lu(k,2069) - lu(k,1567) * lu(k,2065) + lu(k,2070) = lu(k,2070) - lu(k,1568) * lu(k,2065) + lu(k,2071) = lu(k,2071) - lu(k,1569) * lu(k,2065) + lu(k,2072) = lu(k,2072) - lu(k,1570) * lu(k,2065) + lu(k,2073) = lu(k,2073) - lu(k,1571) * lu(k,2065) + lu(k,2074) = lu(k,2074) - lu(k,1572) * lu(k,2065) + lu(k,2075) = lu(k,2075) - lu(k,1573) * lu(k,2065) + lu(k,2078) = lu(k,2078) - lu(k,1574) * lu(k,2065) + lu(k,2079) = lu(k,2079) - lu(k,1575) * lu(k,2065) + lu(k,2080) = lu(k,2080) - lu(k,1576) * lu(k,2065) + lu(k,2081) = lu(k,2081) - lu(k,1577) * lu(k,2065) + lu(k,2087) = lu(k,2087) - lu(k,1564) * lu(k,2086) + lu(k,2088) = lu(k,2088) - lu(k,1565) * lu(k,2086) + lu(k,2089) = lu(k,2089) - lu(k,1566) * lu(k,2086) + lu(k,2090) = lu(k,2090) - lu(k,1567) * lu(k,2086) + lu(k,2091) = lu(k,2091) - lu(k,1568) * lu(k,2086) + lu(k,2092) = lu(k,2092) - lu(k,1569) * lu(k,2086) + lu(k,2093) = lu(k,2093) - lu(k,1570) * lu(k,2086) + lu(k,2094) = lu(k,2094) - lu(k,1571) * lu(k,2086) + lu(k,2095) = lu(k,2095) - lu(k,1572) * lu(k,2086) + lu(k,2096) = lu(k,2096) - lu(k,1573) * lu(k,2086) + lu(k,2099) = lu(k,2099) - lu(k,1574) * lu(k,2086) + lu(k,2100) = lu(k,2100) - lu(k,1575) * lu(k,2086) + lu(k,2101) = lu(k,2101) - lu(k,1576) * lu(k,2086) + lu(k,2102) = lu(k,2102) - lu(k,1577) * lu(k,2086) + lu(k,2195) = lu(k,2195) - lu(k,1564) * lu(k,2194) + lu(k,2196) = lu(k,2196) - lu(k,1565) * lu(k,2194) + lu(k,2197) = lu(k,2197) - lu(k,1566) * lu(k,2194) + lu(k,2198) = lu(k,2198) - lu(k,1567) * lu(k,2194) + lu(k,2199) = lu(k,2199) - lu(k,1568) * lu(k,2194) + lu(k,2200) = lu(k,2200) - lu(k,1569) * lu(k,2194) + lu(k,2201) = lu(k,2201) - lu(k,1570) * lu(k,2194) + lu(k,2202) = lu(k,2202) - lu(k,1571) * lu(k,2194) + lu(k,2203) = lu(k,2203) - lu(k,1572) * lu(k,2194) + lu(k,2204) = lu(k,2204) - lu(k,1573) * lu(k,2194) + lu(k,2207) = lu(k,2207) - lu(k,1574) * lu(k,2194) + lu(k,2208) = lu(k,2208) - lu(k,1575) * lu(k,2194) + lu(k,2209) = lu(k,2209) - lu(k,1576) * lu(k,2194) + lu(k,2210) = lu(k,2210) - lu(k,1577) * lu(k,2194) + lu(k,2247) = lu(k,2247) - lu(k,1564) * lu(k,2246) + lu(k,2248) = lu(k,2248) - lu(k,1565) * lu(k,2246) + lu(k,2249) = lu(k,2249) - lu(k,1566) * lu(k,2246) + lu(k,2250) = lu(k,2250) - lu(k,1567) * lu(k,2246) + lu(k,2251) = lu(k,2251) - lu(k,1568) * lu(k,2246) + lu(k,2252) = lu(k,2252) - lu(k,1569) * lu(k,2246) + lu(k,2253) = lu(k,2253) - lu(k,1570) * lu(k,2246) + lu(k,2254) = lu(k,2254) - lu(k,1571) * lu(k,2246) + lu(k,2255) = lu(k,2255) - lu(k,1572) * lu(k,2246) + lu(k,2256) = lu(k,2256) - lu(k,1573) * lu(k,2246) + lu(k,2259) = lu(k,2259) - lu(k,1574) * lu(k,2246) + lu(k,2260) = lu(k,2260) - lu(k,1575) * lu(k,2246) + lu(k,2261) = lu(k,2261) - lu(k,1576) * lu(k,2246) + lu(k,2262) = lu(k,2262) - lu(k,1577) * lu(k,2246) + lu(k,2272) = lu(k,2272) - lu(k,1564) * lu(k,2271) + lu(k,2273) = lu(k,2273) - lu(k,1565) * lu(k,2271) + lu(k,2274) = lu(k,2274) - lu(k,1566) * lu(k,2271) + lu(k,2275) = lu(k,2275) - lu(k,1567) * lu(k,2271) + lu(k,2276) = lu(k,2276) - lu(k,1568) * lu(k,2271) + lu(k,2277) = lu(k,2277) - lu(k,1569) * lu(k,2271) + lu(k,2278) = lu(k,2278) - lu(k,1570) * lu(k,2271) + lu(k,2279) = lu(k,2279) - lu(k,1571) * lu(k,2271) + lu(k,2280) = lu(k,2280) - lu(k,1572) * lu(k,2271) + lu(k,2281) = lu(k,2281) - lu(k,1573) * lu(k,2271) + lu(k,2284) = lu(k,2284) - lu(k,1574) * lu(k,2271) + lu(k,2285) = lu(k,2285) - lu(k,1575) * lu(k,2271) + lu(k,2286) = lu(k,2286) - lu(k,1576) * lu(k,2271) + lu(k,2287) = lu(k,2287) - lu(k,1577) * lu(k,2271) + lu(k,2315) = lu(k,2315) - lu(k,1564) * lu(k,2314) + lu(k,2316) = lu(k,2316) - lu(k,1565) * lu(k,2314) + lu(k,2317) = lu(k,2317) - lu(k,1566) * lu(k,2314) + lu(k,2318) = lu(k,2318) - lu(k,1567) * lu(k,2314) + lu(k,2319) = lu(k,2319) - lu(k,1568) * lu(k,2314) + lu(k,2320) = lu(k,2320) - lu(k,1569) * lu(k,2314) + lu(k,2321) = lu(k,2321) - lu(k,1570) * lu(k,2314) + lu(k,2322) = lu(k,2322) - lu(k,1571) * lu(k,2314) + lu(k,2323) = lu(k,2323) - lu(k,1572) * lu(k,2314) + lu(k,2324) = lu(k,2324) - lu(k,1573) * lu(k,2314) + lu(k,2327) = lu(k,2327) - lu(k,1574) * lu(k,2314) + lu(k,2328) = lu(k,2328) - lu(k,1575) * lu(k,2314) + lu(k,2329) = lu(k,2329) - lu(k,1576) * lu(k,2314) + lu(k,2330) = lu(k,2330) - lu(k,1577) * lu(k,2314) + lu(k,2341) = lu(k,2341) - lu(k,1564) * lu(k,2340) + lu(k,2342) = lu(k,2342) - lu(k,1565) * lu(k,2340) + lu(k,2343) = lu(k,2343) - lu(k,1566) * lu(k,2340) + lu(k,2344) = lu(k,2344) - lu(k,1567) * lu(k,2340) + lu(k,2345) = lu(k,2345) - lu(k,1568) * lu(k,2340) + lu(k,2346) = lu(k,2346) - lu(k,1569) * lu(k,2340) + lu(k,2347) = lu(k,2347) - lu(k,1570) * lu(k,2340) + lu(k,2348) = lu(k,2348) - lu(k,1571) * lu(k,2340) + lu(k,2349) = lu(k,2349) - lu(k,1572) * lu(k,2340) + lu(k,2350) = lu(k,2350) - lu(k,1573) * lu(k,2340) + lu(k,2353) = lu(k,2353) - lu(k,1574) * lu(k,2340) + lu(k,2354) = lu(k,2354) - lu(k,1575) * lu(k,2340) + lu(k,2355) = lu(k,2355) - lu(k,1576) * lu(k,2340) + lu(k,2356) = lu(k,2356) - lu(k,1577) * lu(k,2340) + lu(k,2405) = lu(k,2405) - lu(k,1564) * lu(k,2404) + lu(k,2406) = lu(k,2406) - lu(k,1565) * lu(k,2404) + lu(k,2407) = lu(k,2407) - lu(k,1566) * lu(k,2404) + lu(k,2408) = lu(k,2408) - lu(k,1567) * lu(k,2404) + lu(k,2409) = lu(k,2409) - lu(k,1568) * lu(k,2404) + lu(k,2410) = lu(k,2410) - lu(k,1569) * lu(k,2404) + lu(k,2411) = lu(k,2411) - lu(k,1570) * lu(k,2404) + lu(k,2412) = lu(k,2412) - lu(k,1571) * lu(k,2404) + lu(k,2413) = lu(k,2413) - lu(k,1572) * lu(k,2404) + lu(k,2414) = lu(k,2414) - lu(k,1573) * lu(k,2404) + lu(k,2417) = lu(k,2417) - lu(k,1574) * lu(k,2404) + lu(k,2418) = lu(k,2418) - lu(k,1575) * lu(k,2404) + lu(k,2419) = lu(k,2419) - lu(k,1576) * lu(k,2404) + lu(k,2420) = lu(k,2420) - lu(k,1577) * lu(k,2404) + lu(k,2432) = lu(k,2432) - lu(k,1564) * lu(k,2431) + lu(k,2433) = lu(k,2433) - lu(k,1565) * lu(k,2431) + lu(k,2434) = lu(k,2434) - lu(k,1566) * lu(k,2431) + lu(k,2435) = lu(k,2435) - lu(k,1567) * lu(k,2431) + lu(k,2436) = lu(k,2436) - lu(k,1568) * lu(k,2431) + lu(k,2437) = lu(k,2437) - lu(k,1569) * lu(k,2431) + lu(k,2438) = lu(k,2438) - lu(k,1570) * lu(k,2431) + lu(k,2439) = lu(k,2439) - lu(k,1571) * lu(k,2431) + lu(k,2440) = lu(k,2440) - lu(k,1572) * lu(k,2431) + lu(k,2441) = lu(k,2441) - lu(k,1573) * lu(k,2431) + lu(k,2444) = lu(k,2444) - lu(k,1574) * lu(k,2431) + lu(k,2445) = lu(k,2445) - lu(k,1575) * lu(k,2431) + lu(k,2446) = lu(k,2446) - lu(k,1576) * lu(k,2431) + lu(k,2447) = lu(k,2447) - lu(k,1577) * lu(k,2431) end do - end subroutine lu_fac29 - subroutine lu_fac30( avec_len, lu ) + end subroutine lu_fac30 + subroutine lu_fac31( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 implicit none @@ -7902,53 +7465,1400 @@ subroutine lu_fac30( avec_len, lu ) !----------------------------------------------------------------------- integer :: k do k = 1,avec_len - lu(k,1994) = 1._r8 / lu(k,1994) - lu(k,1995) = lu(k,1995) * lu(k,1994) - lu(k,1996) = lu(k,1996) * lu(k,1994) - lu(k,1997) = lu(k,1997) * lu(k,1994) - lu(k,1998) = lu(k,1998) * lu(k,1994) - lu(k,2019) = lu(k,2019) - lu(k,1995) * lu(k,2018) - lu(k,2020) = lu(k,2020) - lu(k,1996) * lu(k,2018) - lu(k,2021) = lu(k,2021) - lu(k,1997) * lu(k,2018) - lu(k,2022) = lu(k,2022) - lu(k,1998) * lu(k,2018) - lu(k,2114) = lu(k,2114) - lu(k,1995) * lu(k,2113) - lu(k,2115) = lu(k,2115) - lu(k,1996) * lu(k,2113) - lu(k,2116) = lu(k,2116) - lu(k,1997) * lu(k,2113) - lu(k,2117) = lu(k,2117) - lu(k,1998) * lu(k,2113) - lu(k,2141) = lu(k,2141) - lu(k,1995) * lu(k,2140) - lu(k,2142) = lu(k,2142) - lu(k,1996) * lu(k,2140) - lu(k,2143) = lu(k,2143) - lu(k,1997) * lu(k,2140) - lu(k,2144) = lu(k,2144) - lu(k,1998) * lu(k,2140) - lu(k,2167) = lu(k,2167) - lu(k,1995) * lu(k,2166) - lu(k,2168) = lu(k,2168) - lu(k,1996) * lu(k,2166) - lu(k,2169) = lu(k,2169) - lu(k,1997) * lu(k,2166) - lu(k,2170) = lu(k,2170) - lu(k,1998) * lu(k,2166) - lu(k,2019) = 1._r8 / lu(k,2019) - lu(k,2020) = lu(k,2020) * lu(k,2019) - lu(k,2021) = lu(k,2021) * lu(k,2019) - lu(k,2022) = lu(k,2022) * lu(k,2019) - lu(k,2115) = lu(k,2115) - lu(k,2020) * lu(k,2114) - lu(k,2116) = lu(k,2116) - lu(k,2021) * lu(k,2114) - lu(k,2117) = lu(k,2117) - lu(k,2022) * lu(k,2114) - lu(k,2142) = lu(k,2142) - lu(k,2020) * lu(k,2141) - lu(k,2143) = lu(k,2143) - lu(k,2021) * lu(k,2141) - lu(k,2144) = lu(k,2144) - lu(k,2022) * lu(k,2141) - lu(k,2168) = lu(k,2168) - lu(k,2020) * lu(k,2167) - lu(k,2169) = lu(k,2169) - lu(k,2021) * lu(k,2167) - lu(k,2170) = lu(k,2170) - lu(k,2022) * lu(k,2167) - lu(k,2115) = 1._r8 / lu(k,2115) - lu(k,2116) = lu(k,2116) * lu(k,2115) - lu(k,2117) = lu(k,2117) * lu(k,2115) - lu(k,2143) = lu(k,2143) - lu(k,2116) * lu(k,2142) - lu(k,2144) = lu(k,2144) - lu(k,2117) * lu(k,2142) - lu(k,2169) = lu(k,2169) - lu(k,2116) * lu(k,2168) - lu(k,2170) = lu(k,2170) - lu(k,2117) * lu(k,2168) - lu(k,2143) = 1._r8 / lu(k,2143) - lu(k,2144) = lu(k,2144) * lu(k,2143) - lu(k,2170) = lu(k,2170) - lu(k,2144) * lu(k,2169) - lu(k,2170) = 1._r8 / lu(k,2170) + lu(k,1590) = 1._r8 / lu(k,1590) + lu(k,1591) = lu(k,1591) * lu(k,1590) + lu(k,1592) = lu(k,1592) * lu(k,1590) + lu(k,1593) = lu(k,1593) * lu(k,1590) + lu(k,1594) = lu(k,1594) * lu(k,1590) + lu(k,1595) = lu(k,1595) * lu(k,1590) + lu(k,1596) = lu(k,1596) * lu(k,1590) + lu(k,1597) = lu(k,1597) * lu(k,1590) + lu(k,1598) = lu(k,1598) * lu(k,1590) + lu(k,1599) = lu(k,1599) * lu(k,1590) + lu(k,1600) = lu(k,1600) * lu(k,1590) + lu(k,1601) = lu(k,1601) * lu(k,1590) + lu(k,1602) = lu(k,1602) * lu(k,1590) + lu(k,1603) = lu(k,1603) * lu(k,1590) + lu(k,1604) = lu(k,1604) * lu(k,1590) + lu(k,1633) = lu(k,1633) - lu(k,1591) * lu(k,1632) + lu(k,1634) = lu(k,1634) - lu(k,1592) * lu(k,1632) + lu(k,1635) = lu(k,1635) - lu(k,1593) * lu(k,1632) + lu(k,1636) = lu(k,1636) - lu(k,1594) * lu(k,1632) + lu(k,1637) = lu(k,1637) - lu(k,1595) * lu(k,1632) + lu(k,1638) = lu(k,1638) - lu(k,1596) * lu(k,1632) + lu(k,1639) = lu(k,1639) - lu(k,1597) * lu(k,1632) + lu(k,1640) = lu(k,1640) - lu(k,1598) * lu(k,1632) + lu(k,1641) = lu(k,1641) - lu(k,1599) * lu(k,1632) + lu(k,1642) = lu(k,1642) - lu(k,1600) * lu(k,1632) + lu(k,1644) = lu(k,1644) - lu(k,1601) * lu(k,1632) + lu(k,1645) = lu(k,1645) - lu(k,1602) * lu(k,1632) + lu(k,1646) = lu(k,1646) - lu(k,1603) * lu(k,1632) + lu(k,1647) = lu(k,1647) - lu(k,1604) * lu(k,1632) + lu(k,1798) = lu(k,1798) - lu(k,1591) * lu(k,1797) + lu(k,1799) = lu(k,1799) - lu(k,1592) * lu(k,1797) + lu(k,1800) = lu(k,1800) - lu(k,1593) * lu(k,1797) + lu(k,1801) = lu(k,1801) - lu(k,1594) * lu(k,1797) + lu(k,1802) = lu(k,1802) - lu(k,1595) * lu(k,1797) + lu(k,1803) = lu(k,1803) - lu(k,1596) * lu(k,1797) + lu(k,1804) = lu(k,1804) - lu(k,1597) * lu(k,1797) + lu(k,1805) = lu(k,1805) - lu(k,1598) * lu(k,1797) + lu(k,1806) = lu(k,1806) - lu(k,1599) * lu(k,1797) + lu(k,1807) = lu(k,1807) - lu(k,1600) * lu(k,1797) + lu(k,1809) = lu(k,1809) - lu(k,1601) * lu(k,1797) + lu(k,1810) = lu(k,1810) - lu(k,1602) * lu(k,1797) + lu(k,1811) = lu(k,1811) - lu(k,1603) * lu(k,1797) + lu(k,1812) = lu(k,1812) - lu(k,1604) * lu(k,1797) + lu(k,1843) = lu(k,1843) - lu(k,1591) * lu(k,1842) + lu(k,1844) = lu(k,1844) - lu(k,1592) * lu(k,1842) + lu(k,1845) = lu(k,1845) - lu(k,1593) * lu(k,1842) + lu(k,1846) = lu(k,1846) - lu(k,1594) * lu(k,1842) + lu(k,1847) = lu(k,1847) - lu(k,1595) * lu(k,1842) + lu(k,1848) = lu(k,1848) - lu(k,1596) * lu(k,1842) + lu(k,1849) = lu(k,1849) - lu(k,1597) * lu(k,1842) + lu(k,1850) = lu(k,1850) - lu(k,1598) * lu(k,1842) + lu(k,1851) = lu(k,1851) - lu(k,1599) * lu(k,1842) + lu(k,1852) = lu(k,1852) - lu(k,1600) * lu(k,1842) + lu(k,1854) = lu(k,1854) - lu(k,1601) * lu(k,1842) + lu(k,1855) = lu(k,1855) - lu(k,1602) * lu(k,1842) + lu(k,1856) = lu(k,1856) - lu(k,1603) * lu(k,1842) + lu(k,1857) = lu(k,1857) - lu(k,1604) * lu(k,1842) + lu(k,1903) = lu(k,1903) - lu(k,1591) * lu(k,1902) + lu(k,1904) = lu(k,1904) - lu(k,1592) * lu(k,1902) + lu(k,1905) = lu(k,1905) - lu(k,1593) * lu(k,1902) + lu(k,1906) = lu(k,1906) - lu(k,1594) * lu(k,1902) + lu(k,1907) = lu(k,1907) - lu(k,1595) * lu(k,1902) + lu(k,1908) = lu(k,1908) - lu(k,1596) * lu(k,1902) + lu(k,1909) = lu(k,1909) - lu(k,1597) * lu(k,1902) + lu(k,1910) = lu(k,1910) - lu(k,1598) * lu(k,1902) + lu(k,1911) = lu(k,1911) - lu(k,1599) * lu(k,1902) + lu(k,1912) = lu(k,1912) - lu(k,1600) * lu(k,1902) + lu(k,1914) = lu(k,1914) - lu(k,1601) * lu(k,1902) + lu(k,1915) = lu(k,1915) - lu(k,1602) * lu(k,1902) + lu(k,1916) = lu(k,1916) - lu(k,1603) * lu(k,1902) + lu(k,1917) = lu(k,1917) - lu(k,1604) * lu(k,1902) + lu(k,1949) = lu(k,1949) - lu(k,1591) * lu(k,1948) + lu(k,1950) = lu(k,1950) - lu(k,1592) * lu(k,1948) + lu(k,1951) = lu(k,1951) - lu(k,1593) * lu(k,1948) + lu(k,1952) = lu(k,1952) - lu(k,1594) * lu(k,1948) + lu(k,1953) = lu(k,1953) - lu(k,1595) * lu(k,1948) + lu(k,1954) = lu(k,1954) - lu(k,1596) * lu(k,1948) + lu(k,1955) = lu(k,1955) - lu(k,1597) * lu(k,1948) + lu(k,1956) = lu(k,1956) - lu(k,1598) * lu(k,1948) + lu(k,1957) = lu(k,1957) - lu(k,1599) * lu(k,1948) + lu(k,1958) = lu(k,1958) - lu(k,1600) * lu(k,1948) + lu(k,1960) = lu(k,1960) - lu(k,1601) * lu(k,1948) + lu(k,1961) = lu(k,1961) - lu(k,1602) * lu(k,1948) + lu(k,1962) = lu(k,1962) - lu(k,1603) * lu(k,1948) + lu(k,1963) = lu(k,1963) - lu(k,1604) * lu(k,1948) + lu(k,1972) = lu(k,1972) - lu(k,1591) * lu(k,1971) + lu(k,1973) = lu(k,1973) - lu(k,1592) * lu(k,1971) + lu(k,1974) = lu(k,1974) - lu(k,1593) * lu(k,1971) + lu(k,1975) = lu(k,1975) - lu(k,1594) * lu(k,1971) + lu(k,1976) = lu(k,1976) - lu(k,1595) * lu(k,1971) + lu(k,1977) = lu(k,1977) - lu(k,1596) * lu(k,1971) + lu(k,1978) = lu(k,1978) - lu(k,1597) * lu(k,1971) + lu(k,1979) = lu(k,1979) - lu(k,1598) * lu(k,1971) + lu(k,1980) = lu(k,1980) - lu(k,1599) * lu(k,1971) + lu(k,1981) = lu(k,1981) - lu(k,1600) * lu(k,1971) + lu(k,1983) = lu(k,1983) - lu(k,1601) * lu(k,1971) + lu(k,1984) = lu(k,1984) - lu(k,1602) * lu(k,1971) + lu(k,1985) = lu(k,1985) - lu(k,1603) * lu(k,1971) + lu(k,1986) = lu(k,1986) - lu(k,1604) * lu(k,1971) + lu(k,2067) = lu(k,2067) - lu(k,1591) * lu(k,2066) + lu(k,2068) = lu(k,2068) - lu(k,1592) * lu(k,2066) + lu(k,2069) = lu(k,2069) - lu(k,1593) * lu(k,2066) + lu(k,2070) = lu(k,2070) - lu(k,1594) * lu(k,2066) + lu(k,2071) = lu(k,2071) - lu(k,1595) * lu(k,2066) + lu(k,2072) = lu(k,2072) - lu(k,1596) * lu(k,2066) + lu(k,2073) = lu(k,2073) - lu(k,1597) * lu(k,2066) + lu(k,2074) = lu(k,2074) - lu(k,1598) * lu(k,2066) + lu(k,2075) = lu(k,2075) - lu(k,1599) * lu(k,2066) + lu(k,2076) = lu(k,2076) - lu(k,1600) * lu(k,2066) + lu(k,2078) = lu(k,2078) - lu(k,1601) * lu(k,2066) + lu(k,2079) = lu(k,2079) - lu(k,1602) * lu(k,2066) + lu(k,2080) = lu(k,2080) - lu(k,1603) * lu(k,2066) + lu(k,2081) = lu(k,2081) - lu(k,1604) * lu(k,2066) + lu(k,2088) = lu(k,2088) - lu(k,1591) * lu(k,2087) + lu(k,2089) = lu(k,2089) - lu(k,1592) * lu(k,2087) + lu(k,2090) = lu(k,2090) - lu(k,1593) * lu(k,2087) + lu(k,2091) = lu(k,2091) - lu(k,1594) * lu(k,2087) + lu(k,2092) = lu(k,2092) - lu(k,1595) * lu(k,2087) + lu(k,2093) = lu(k,2093) - lu(k,1596) * lu(k,2087) + lu(k,2094) = lu(k,2094) - lu(k,1597) * lu(k,2087) + lu(k,2095) = lu(k,2095) - lu(k,1598) * lu(k,2087) + lu(k,2096) = lu(k,2096) - lu(k,1599) * lu(k,2087) + lu(k,2097) = lu(k,2097) - lu(k,1600) * lu(k,2087) + lu(k,2099) = lu(k,2099) - lu(k,1601) * lu(k,2087) + lu(k,2100) = lu(k,2100) - lu(k,1602) * lu(k,2087) + lu(k,2101) = lu(k,2101) - lu(k,1603) * lu(k,2087) + lu(k,2102) = lu(k,2102) - lu(k,1604) * lu(k,2087) + lu(k,2196) = lu(k,2196) - lu(k,1591) * lu(k,2195) + lu(k,2197) = lu(k,2197) - lu(k,1592) * lu(k,2195) + lu(k,2198) = lu(k,2198) - lu(k,1593) * lu(k,2195) + lu(k,2199) = lu(k,2199) - lu(k,1594) * lu(k,2195) + lu(k,2200) = lu(k,2200) - lu(k,1595) * lu(k,2195) + lu(k,2201) = lu(k,2201) - lu(k,1596) * lu(k,2195) + lu(k,2202) = lu(k,2202) - lu(k,1597) * lu(k,2195) + lu(k,2203) = lu(k,2203) - lu(k,1598) * lu(k,2195) + lu(k,2204) = lu(k,2204) - lu(k,1599) * lu(k,2195) + lu(k,2205) = lu(k,2205) - lu(k,1600) * lu(k,2195) + lu(k,2207) = lu(k,2207) - lu(k,1601) * lu(k,2195) + lu(k,2208) = lu(k,2208) - lu(k,1602) * lu(k,2195) + lu(k,2209) = lu(k,2209) - lu(k,1603) * lu(k,2195) + lu(k,2210) = lu(k,2210) - lu(k,1604) * lu(k,2195) + lu(k,2248) = lu(k,2248) - lu(k,1591) * lu(k,2247) + lu(k,2249) = lu(k,2249) - lu(k,1592) * lu(k,2247) + lu(k,2250) = lu(k,2250) - lu(k,1593) * lu(k,2247) + lu(k,2251) = lu(k,2251) - lu(k,1594) * lu(k,2247) + lu(k,2252) = lu(k,2252) - lu(k,1595) * lu(k,2247) + lu(k,2253) = lu(k,2253) - lu(k,1596) * lu(k,2247) + lu(k,2254) = lu(k,2254) - lu(k,1597) * lu(k,2247) + lu(k,2255) = lu(k,2255) - lu(k,1598) * lu(k,2247) + lu(k,2256) = lu(k,2256) - lu(k,1599) * lu(k,2247) + lu(k,2257) = lu(k,2257) - lu(k,1600) * lu(k,2247) + lu(k,2259) = lu(k,2259) - lu(k,1601) * lu(k,2247) + lu(k,2260) = lu(k,2260) - lu(k,1602) * lu(k,2247) + lu(k,2261) = lu(k,2261) - lu(k,1603) * lu(k,2247) + lu(k,2262) = lu(k,2262) - lu(k,1604) * lu(k,2247) + lu(k,2273) = lu(k,2273) - lu(k,1591) * lu(k,2272) + lu(k,2274) = lu(k,2274) - lu(k,1592) * lu(k,2272) + lu(k,2275) = lu(k,2275) - lu(k,1593) * lu(k,2272) + lu(k,2276) = lu(k,2276) - lu(k,1594) * lu(k,2272) + lu(k,2277) = lu(k,2277) - lu(k,1595) * lu(k,2272) + lu(k,2278) = lu(k,2278) - lu(k,1596) * lu(k,2272) + lu(k,2279) = lu(k,2279) - lu(k,1597) * lu(k,2272) + lu(k,2280) = lu(k,2280) - lu(k,1598) * lu(k,2272) + lu(k,2281) = lu(k,2281) - lu(k,1599) * lu(k,2272) + lu(k,2282) = lu(k,2282) - lu(k,1600) * lu(k,2272) + lu(k,2284) = lu(k,2284) - lu(k,1601) * lu(k,2272) + lu(k,2285) = lu(k,2285) - lu(k,1602) * lu(k,2272) + lu(k,2286) = lu(k,2286) - lu(k,1603) * lu(k,2272) + lu(k,2287) = lu(k,2287) - lu(k,1604) * lu(k,2272) + lu(k,2316) = lu(k,2316) - lu(k,1591) * lu(k,2315) + lu(k,2317) = lu(k,2317) - lu(k,1592) * lu(k,2315) + lu(k,2318) = lu(k,2318) - lu(k,1593) * lu(k,2315) + lu(k,2319) = lu(k,2319) - lu(k,1594) * lu(k,2315) + lu(k,2320) = lu(k,2320) - lu(k,1595) * lu(k,2315) + lu(k,2321) = lu(k,2321) - lu(k,1596) * lu(k,2315) + lu(k,2322) = lu(k,2322) - lu(k,1597) * lu(k,2315) + lu(k,2323) = lu(k,2323) - lu(k,1598) * lu(k,2315) + lu(k,2324) = lu(k,2324) - lu(k,1599) * lu(k,2315) + lu(k,2325) = lu(k,2325) - lu(k,1600) * lu(k,2315) + lu(k,2327) = lu(k,2327) - lu(k,1601) * lu(k,2315) + lu(k,2328) = lu(k,2328) - lu(k,1602) * lu(k,2315) + lu(k,2329) = lu(k,2329) - lu(k,1603) * lu(k,2315) + lu(k,2330) = lu(k,2330) - lu(k,1604) * lu(k,2315) + lu(k,2342) = lu(k,2342) - lu(k,1591) * lu(k,2341) + lu(k,2343) = lu(k,2343) - lu(k,1592) * lu(k,2341) + lu(k,2344) = lu(k,2344) - lu(k,1593) * lu(k,2341) + lu(k,2345) = lu(k,2345) - lu(k,1594) * lu(k,2341) + lu(k,2346) = lu(k,2346) - lu(k,1595) * lu(k,2341) + lu(k,2347) = lu(k,2347) - lu(k,1596) * lu(k,2341) + lu(k,2348) = lu(k,2348) - lu(k,1597) * lu(k,2341) + lu(k,2349) = lu(k,2349) - lu(k,1598) * lu(k,2341) + lu(k,2350) = lu(k,2350) - lu(k,1599) * lu(k,2341) + lu(k,2351) = lu(k,2351) - lu(k,1600) * lu(k,2341) + lu(k,2353) = lu(k,2353) - lu(k,1601) * lu(k,2341) + lu(k,2354) = lu(k,2354) - lu(k,1602) * lu(k,2341) + lu(k,2355) = lu(k,2355) - lu(k,1603) * lu(k,2341) + lu(k,2356) = lu(k,2356) - lu(k,1604) * lu(k,2341) + lu(k,2406) = lu(k,2406) - lu(k,1591) * lu(k,2405) + lu(k,2407) = lu(k,2407) - lu(k,1592) * lu(k,2405) + lu(k,2408) = lu(k,2408) - lu(k,1593) * lu(k,2405) + lu(k,2409) = lu(k,2409) - lu(k,1594) * lu(k,2405) + lu(k,2410) = lu(k,2410) - lu(k,1595) * lu(k,2405) + lu(k,2411) = lu(k,2411) - lu(k,1596) * lu(k,2405) + lu(k,2412) = lu(k,2412) - lu(k,1597) * lu(k,2405) + lu(k,2413) = lu(k,2413) - lu(k,1598) * lu(k,2405) + lu(k,2414) = lu(k,2414) - lu(k,1599) * lu(k,2405) + lu(k,2415) = lu(k,2415) - lu(k,1600) * lu(k,2405) + lu(k,2417) = lu(k,2417) - lu(k,1601) * lu(k,2405) + lu(k,2418) = lu(k,2418) - lu(k,1602) * lu(k,2405) + lu(k,2419) = lu(k,2419) - lu(k,1603) * lu(k,2405) + lu(k,2420) = lu(k,2420) - lu(k,1604) * lu(k,2405) + lu(k,2433) = lu(k,2433) - lu(k,1591) * lu(k,2432) + lu(k,2434) = lu(k,2434) - lu(k,1592) * lu(k,2432) + lu(k,2435) = lu(k,2435) - lu(k,1593) * lu(k,2432) + lu(k,2436) = lu(k,2436) - lu(k,1594) * lu(k,2432) + lu(k,2437) = lu(k,2437) - lu(k,1595) * lu(k,2432) + lu(k,2438) = lu(k,2438) - lu(k,1596) * lu(k,2432) + lu(k,2439) = lu(k,2439) - lu(k,1597) * lu(k,2432) + lu(k,2440) = lu(k,2440) - lu(k,1598) * lu(k,2432) + lu(k,2441) = lu(k,2441) - lu(k,1599) * lu(k,2432) + lu(k,2442) = lu(k,2442) - lu(k,1600) * lu(k,2432) + lu(k,2444) = lu(k,2444) - lu(k,1601) * lu(k,2432) + lu(k,2445) = lu(k,2445) - lu(k,1602) * lu(k,2432) + lu(k,2446) = lu(k,2446) - lu(k,1603) * lu(k,2432) + lu(k,2447) = lu(k,2447) - lu(k,1604) * lu(k,2432) + lu(k,1633) = 1._r8 / lu(k,1633) + lu(k,1634) = lu(k,1634) * lu(k,1633) + lu(k,1635) = lu(k,1635) * lu(k,1633) + lu(k,1636) = lu(k,1636) * lu(k,1633) + lu(k,1637) = lu(k,1637) * lu(k,1633) + lu(k,1638) = lu(k,1638) * lu(k,1633) + lu(k,1639) = lu(k,1639) * lu(k,1633) + lu(k,1640) = lu(k,1640) * lu(k,1633) + lu(k,1641) = lu(k,1641) * lu(k,1633) + lu(k,1642) = lu(k,1642) * lu(k,1633) + lu(k,1643) = lu(k,1643) * lu(k,1633) + lu(k,1644) = lu(k,1644) * lu(k,1633) + lu(k,1645) = lu(k,1645) * lu(k,1633) + lu(k,1646) = lu(k,1646) * lu(k,1633) + lu(k,1647) = lu(k,1647) * lu(k,1633) + lu(k,1799) = lu(k,1799) - lu(k,1634) * lu(k,1798) + lu(k,1800) = lu(k,1800) - lu(k,1635) * lu(k,1798) + lu(k,1801) = lu(k,1801) - lu(k,1636) * lu(k,1798) + lu(k,1802) = lu(k,1802) - lu(k,1637) * lu(k,1798) + lu(k,1803) = lu(k,1803) - lu(k,1638) * lu(k,1798) + lu(k,1804) = lu(k,1804) - lu(k,1639) * lu(k,1798) + lu(k,1805) = lu(k,1805) - lu(k,1640) * lu(k,1798) + lu(k,1806) = lu(k,1806) - lu(k,1641) * lu(k,1798) + lu(k,1807) = lu(k,1807) - lu(k,1642) * lu(k,1798) + lu(k,1808) = lu(k,1808) - lu(k,1643) * lu(k,1798) + lu(k,1809) = lu(k,1809) - lu(k,1644) * lu(k,1798) + lu(k,1810) = lu(k,1810) - lu(k,1645) * lu(k,1798) + lu(k,1811) = lu(k,1811) - lu(k,1646) * lu(k,1798) + lu(k,1812) = lu(k,1812) - lu(k,1647) * lu(k,1798) + lu(k,1844) = lu(k,1844) - lu(k,1634) * lu(k,1843) + lu(k,1845) = lu(k,1845) - lu(k,1635) * lu(k,1843) + lu(k,1846) = lu(k,1846) - lu(k,1636) * lu(k,1843) + lu(k,1847) = lu(k,1847) - lu(k,1637) * lu(k,1843) + lu(k,1848) = lu(k,1848) - lu(k,1638) * lu(k,1843) + lu(k,1849) = lu(k,1849) - lu(k,1639) * lu(k,1843) + lu(k,1850) = lu(k,1850) - lu(k,1640) * lu(k,1843) + lu(k,1851) = lu(k,1851) - lu(k,1641) * lu(k,1843) + lu(k,1852) = lu(k,1852) - lu(k,1642) * lu(k,1843) + lu(k,1853) = lu(k,1853) - lu(k,1643) * lu(k,1843) + lu(k,1854) = lu(k,1854) - lu(k,1644) * lu(k,1843) + lu(k,1855) = lu(k,1855) - lu(k,1645) * lu(k,1843) + lu(k,1856) = lu(k,1856) - lu(k,1646) * lu(k,1843) + lu(k,1857) = lu(k,1857) - lu(k,1647) * lu(k,1843) + lu(k,1904) = lu(k,1904) - lu(k,1634) * lu(k,1903) + lu(k,1905) = lu(k,1905) - lu(k,1635) * lu(k,1903) + lu(k,1906) = lu(k,1906) - lu(k,1636) * lu(k,1903) + lu(k,1907) = lu(k,1907) - lu(k,1637) * lu(k,1903) + lu(k,1908) = lu(k,1908) - lu(k,1638) * lu(k,1903) + lu(k,1909) = lu(k,1909) - lu(k,1639) * lu(k,1903) + lu(k,1910) = lu(k,1910) - lu(k,1640) * lu(k,1903) + lu(k,1911) = lu(k,1911) - lu(k,1641) * lu(k,1903) + lu(k,1912) = lu(k,1912) - lu(k,1642) * lu(k,1903) + lu(k,1913) = lu(k,1913) - lu(k,1643) * lu(k,1903) + lu(k,1914) = lu(k,1914) - lu(k,1644) * lu(k,1903) + lu(k,1915) = lu(k,1915) - lu(k,1645) * lu(k,1903) + lu(k,1916) = lu(k,1916) - lu(k,1646) * lu(k,1903) + lu(k,1917) = lu(k,1917) - lu(k,1647) * lu(k,1903) + lu(k,1950) = lu(k,1950) - lu(k,1634) * lu(k,1949) + lu(k,1951) = lu(k,1951) - lu(k,1635) * lu(k,1949) + lu(k,1952) = lu(k,1952) - lu(k,1636) * lu(k,1949) + lu(k,1953) = lu(k,1953) - lu(k,1637) * lu(k,1949) + lu(k,1954) = lu(k,1954) - lu(k,1638) * lu(k,1949) + lu(k,1955) = lu(k,1955) - lu(k,1639) * lu(k,1949) + lu(k,1956) = lu(k,1956) - lu(k,1640) * lu(k,1949) + lu(k,1957) = lu(k,1957) - lu(k,1641) * lu(k,1949) + lu(k,1958) = lu(k,1958) - lu(k,1642) * lu(k,1949) + lu(k,1959) = lu(k,1959) - lu(k,1643) * lu(k,1949) + lu(k,1960) = lu(k,1960) - lu(k,1644) * lu(k,1949) + lu(k,1961) = lu(k,1961) - lu(k,1645) * lu(k,1949) + lu(k,1962) = lu(k,1962) - lu(k,1646) * lu(k,1949) + lu(k,1963) = lu(k,1963) - lu(k,1647) * lu(k,1949) + lu(k,1973) = lu(k,1973) - lu(k,1634) * lu(k,1972) + lu(k,1974) = lu(k,1974) - lu(k,1635) * lu(k,1972) + lu(k,1975) = lu(k,1975) - lu(k,1636) * lu(k,1972) + lu(k,1976) = lu(k,1976) - lu(k,1637) * lu(k,1972) + lu(k,1977) = lu(k,1977) - lu(k,1638) * lu(k,1972) + lu(k,1978) = lu(k,1978) - lu(k,1639) * lu(k,1972) + lu(k,1979) = lu(k,1979) - lu(k,1640) * lu(k,1972) + lu(k,1980) = lu(k,1980) - lu(k,1641) * lu(k,1972) + lu(k,1981) = lu(k,1981) - lu(k,1642) * lu(k,1972) + lu(k,1982) = lu(k,1982) - lu(k,1643) * lu(k,1972) + lu(k,1983) = lu(k,1983) - lu(k,1644) * lu(k,1972) + lu(k,1984) = lu(k,1984) - lu(k,1645) * lu(k,1972) + lu(k,1985) = lu(k,1985) - lu(k,1646) * lu(k,1972) + lu(k,1986) = lu(k,1986) - lu(k,1647) * lu(k,1972) + lu(k,2068) = lu(k,2068) - lu(k,1634) * lu(k,2067) + lu(k,2069) = lu(k,2069) - lu(k,1635) * lu(k,2067) + lu(k,2070) = lu(k,2070) - lu(k,1636) * lu(k,2067) + lu(k,2071) = lu(k,2071) - lu(k,1637) * lu(k,2067) + lu(k,2072) = lu(k,2072) - lu(k,1638) * lu(k,2067) + lu(k,2073) = lu(k,2073) - lu(k,1639) * lu(k,2067) + lu(k,2074) = lu(k,2074) - lu(k,1640) * lu(k,2067) + lu(k,2075) = lu(k,2075) - lu(k,1641) * lu(k,2067) + lu(k,2076) = lu(k,2076) - lu(k,1642) * lu(k,2067) + lu(k,2077) = lu(k,2077) - lu(k,1643) * lu(k,2067) + lu(k,2078) = lu(k,2078) - lu(k,1644) * lu(k,2067) + lu(k,2079) = lu(k,2079) - lu(k,1645) * lu(k,2067) + lu(k,2080) = lu(k,2080) - lu(k,1646) * lu(k,2067) + lu(k,2081) = lu(k,2081) - lu(k,1647) * lu(k,2067) + lu(k,2089) = lu(k,2089) - lu(k,1634) * lu(k,2088) + lu(k,2090) = lu(k,2090) - lu(k,1635) * lu(k,2088) + lu(k,2091) = lu(k,2091) - lu(k,1636) * lu(k,2088) + lu(k,2092) = lu(k,2092) - lu(k,1637) * lu(k,2088) + lu(k,2093) = lu(k,2093) - lu(k,1638) * lu(k,2088) + lu(k,2094) = lu(k,2094) - lu(k,1639) * lu(k,2088) + lu(k,2095) = lu(k,2095) - lu(k,1640) * lu(k,2088) + lu(k,2096) = lu(k,2096) - lu(k,1641) * lu(k,2088) + lu(k,2097) = lu(k,2097) - lu(k,1642) * lu(k,2088) + lu(k,2098) = lu(k,2098) - lu(k,1643) * lu(k,2088) + lu(k,2099) = lu(k,2099) - lu(k,1644) * lu(k,2088) + lu(k,2100) = lu(k,2100) - lu(k,1645) * lu(k,2088) + lu(k,2101) = lu(k,2101) - lu(k,1646) * lu(k,2088) + lu(k,2102) = lu(k,2102) - lu(k,1647) * lu(k,2088) + lu(k,2197) = lu(k,2197) - lu(k,1634) * lu(k,2196) + lu(k,2198) = lu(k,2198) - lu(k,1635) * lu(k,2196) + lu(k,2199) = lu(k,2199) - lu(k,1636) * lu(k,2196) + lu(k,2200) = lu(k,2200) - lu(k,1637) * lu(k,2196) + lu(k,2201) = lu(k,2201) - lu(k,1638) * lu(k,2196) + lu(k,2202) = lu(k,2202) - lu(k,1639) * lu(k,2196) + lu(k,2203) = lu(k,2203) - lu(k,1640) * lu(k,2196) + lu(k,2204) = lu(k,2204) - lu(k,1641) * lu(k,2196) + lu(k,2205) = lu(k,2205) - lu(k,1642) * lu(k,2196) + lu(k,2206) = lu(k,2206) - lu(k,1643) * lu(k,2196) + lu(k,2207) = lu(k,2207) - lu(k,1644) * lu(k,2196) + lu(k,2208) = lu(k,2208) - lu(k,1645) * lu(k,2196) + lu(k,2209) = lu(k,2209) - lu(k,1646) * lu(k,2196) + lu(k,2210) = lu(k,2210) - lu(k,1647) * lu(k,2196) + lu(k,2249) = lu(k,2249) - lu(k,1634) * lu(k,2248) + lu(k,2250) = lu(k,2250) - lu(k,1635) * lu(k,2248) + lu(k,2251) = lu(k,2251) - lu(k,1636) * lu(k,2248) + lu(k,2252) = lu(k,2252) - lu(k,1637) * lu(k,2248) + lu(k,2253) = lu(k,2253) - lu(k,1638) * lu(k,2248) + lu(k,2254) = lu(k,2254) - lu(k,1639) * lu(k,2248) + lu(k,2255) = lu(k,2255) - lu(k,1640) * lu(k,2248) + lu(k,2256) = lu(k,2256) - lu(k,1641) * lu(k,2248) + lu(k,2257) = lu(k,2257) - lu(k,1642) * lu(k,2248) + lu(k,2258) = lu(k,2258) - lu(k,1643) * lu(k,2248) + lu(k,2259) = lu(k,2259) - lu(k,1644) * lu(k,2248) + lu(k,2260) = lu(k,2260) - lu(k,1645) * lu(k,2248) + lu(k,2261) = lu(k,2261) - lu(k,1646) * lu(k,2248) + lu(k,2262) = lu(k,2262) - lu(k,1647) * lu(k,2248) + lu(k,2274) = lu(k,2274) - lu(k,1634) * lu(k,2273) + lu(k,2275) = lu(k,2275) - lu(k,1635) * lu(k,2273) + lu(k,2276) = lu(k,2276) - lu(k,1636) * lu(k,2273) + lu(k,2277) = lu(k,2277) - lu(k,1637) * lu(k,2273) + lu(k,2278) = lu(k,2278) - lu(k,1638) * lu(k,2273) + lu(k,2279) = lu(k,2279) - lu(k,1639) * lu(k,2273) + lu(k,2280) = lu(k,2280) - lu(k,1640) * lu(k,2273) + lu(k,2281) = lu(k,2281) - lu(k,1641) * lu(k,2273) + lu(k,2282) = lu(k,2282) - lu(k,1642) * lu(k,2273) + lu(k,2283) = lu(k,2283) - lu(k,1643) * lu(k,2273) + lu(k,2284) = lu(k,2284) - lu(k,1644) * lu(k,2273) + lu(k,2285) = lu(k,2285) - lu(k,1645) * lu(k,2273) + lu(k,2286) = lu(k,2286) - lu(k,1646) * lu(k,2273) + lu(k,2287) = lu(k,2287) - lu(k,1647) * lu(k,2273) + lu(k,2317) = lu(k,2317) - lu(k,1634) * lu(k,2316) + lu(k,2318) = lu(k,2318) - lu(k,1635) * lu(k,2316) + lu(k,2319) = lu(k,2319) - lu(k,1636) * lu(k,2316) + lu(k,2320) = lu(k,2320) - lu(k,1637) * lu(k,2316) + lu(k,2321) = lu(k,2321) - lu(k,1638) * lu(k,2316) + lu(k,2322) = lu(k,2322) - lu(k,1639) * lu(k,2316) + lu(k,2323) = lu(k,2323) - lu(k,1640) * lu(k,2316) + lu(k,2324) = lu(k,2324) - lu(k,1641) * lu(k,2316) + lu(k,2325) = lu(k,2325) - lu(k,1642) * lu(k,2316) + lu(k,2326) = lu(k,2326) - lu(k,1643) * lu(k,2316) + lu(k,2327) = lu(k,2327) - lu(k,1644) * lu(k,2316) + lu(k,2328) = lu(k,2328) - lu(k,1645) * lu(k,2316) + lu(k,2329) = lu(k,2329) - lu(k,1646) * lu(k,2316) + lu(k,2330) = lu(k,2330) - lu(k,1647) * lu(k,2316) + lu(k,2343) = lu(k,2343) - lu(k,1634) * lu(k,2342) + lu(k,2344) = lu(k,2344) - lu(k,1635) * lu(k,2342) + lu(k,2345) = lu(k,2345) - lu(k,1636) * lu(k,2342) + lu(k,2346) = lu(k,2346) - lu(k,1637) * lu(k,2342) + lu(k,2347) = lu(k,2347) - lu(k,1638) * lu(k,2342) + lu(k,2348) = lu(k,2348) - lu(k,1639) * lu(k,2342) + lu(k,2349) = lu(k,2349) - lu(k,1640) * lu(k,2342) + lu(k,2350) = lu(k,2350) - lu(k,1641) * lu(k,2342) + lu(k,2351) = lu(k,2351) - lu(k,1642) * lu(k,2342) + lu(k,2352) = lu(k,2352) - lu(k,1643) * lu(k,2342) + lu(k,2353) = lu(k,2353) - lu(k,1644) * lu(k,2342) + lu(k,2354) = lu(k,2354) - lu(k,1645) * lu(k,2342) + lu(k,2355) = lu(k,2355) - lu(k,1646) * lu(k,2342) + lu(k,2356) = lu(k,2356) - lu(k,1647) * lu(k,2342) + lu(k,2407) = lu(k,2407) - lu(k,1634) * lu(k,2406) + lu(k,2408) = lu(k,2408) - lu(k,1635) * lu(k,2406) + lu(k,2409) = lu(k,2409) - lu(k,1636) * lu(k,2406) + lu(k,2410) = lu(k,2410) - lu(k,1637) * lu(k,2406) + lu(k,2411) = lu(k,2411) - lu(k,1638) * lu(k,2406) + lu(k,2412) = lu(k,2412) - lu(k,1639) * lu(k,2406) + lu(k,2413) = lu(k,2413) - lu(k,1640) * lu(k,2406) + lu(k,2414) = lu(k,2414) - lu(k,1641) * lu(k,2406) + lu(k,2415) = lu(k,2415) - lu(k,1642) * lu(k,2406) + lu(k,2416) = lu(k,2416) - lu(k,1643) * lu(k,2406) + lu(k,2417) = lu(k,2417) - lu(k,1644) * lu(k,2406) + lu(k,2418) = lu(k,2418) - lu(k,1645) * lu(k,2406) + lu(k,2419) = lu(k,2419) - lu(k,1646) * lu(k,2406) + lu(k,2420) = lu(k,2420) - lu(k,1647) * lu(k,2406) + lu(k,2434) = lu(k,2434) - lu(k,1634) * lu(k,2433) + lu(k,2435) = lu(k,2435) - lu(k,1635) * lu(k,2433) + lu(k,2436) = lu(k,2436) - lu(k,1636) * lu(k,2433) + lu(k,2437) = lu(k,2437) - lu(k,1637) * lu(k,2433) + lu(k,2438) = lu(k,2438) - lu(k,1638) * lu(k,2433) + lu(k,2439) = lu(k,2439) - lu(k,1639) * lu(k,2433) + lu(k,2440) = lu(k,2440) - lu(k,1640) * lu(k,2433) + lu(k,2441) = lu(k,2441) - lu(k,1641) * lu(k,2433) + lu(k,2442) = lu(k,2442) - lu(k,1642) * lu(k,2433) + lu(k,2443) = lu(k,2443) - lu(k,1643) * lu(k,2433) + lu(k,2444) = lu(k,2444) - lu(k,1644) * lu(k,2433) + lu(k,2445) = lu(k,2445) - lu(k,1645) * lu(k,2433) + lu(k,2446) = lu(k,2446) - lu(k,1646) * lu(k,2433) + lu(k,2447) = lu(k,2447) - lu(k,1647) * lu(k,2433) + lu(k,1799) = 1._r8 / lu(k,1799) + lu(k,1800) = lu(k,1800) * lu(k,1799) + lu(k,1801) = lu(k,1801) * lu(k,1799) + lu(k,1802) = lu(k,1802) * lu(k,1799) + lu(k,1803) = lu(k,1803) * lu(k,1799) + lu(k,1804) = lu(k,1804) * lu(k,1799) + lu(k,1805) = lu(k,1805) * lu(k,1799) + lu(k,1806) = lu(k,1806) * lu(k,1799) + lu(k,1807) = lu(k,1807) * lu(k,1799) + lu(k,1808) = lu(k,1808) * lu(k,1799) + lu(k,1809) = lu(k,1809) * lu(k,1799) + lu(k,1810) = lu(k,1810) * lu(k,1799) + lu(k,1811) = lu(k,1811) * lu(k,1799) + lu(k,1812) = lu(k,1812) * lu(k,1799) + lu(k,1845) = lu(k,1845) - lu(k,1800) * lu(k,1844) + lu(k,1846) = lu(k,1846) - lu(k,1801) * lu(k,1844) + lu(k,1847) = lu(k,1847) - lu(k,1802) * lu(k,1844) + lu(k,1848) = lu(k,1848) - lu(k,1803) * lu(k,1844) + lu(k,1849) = lu(k,1849) - lu(k,1804) * lu(k,1844) + lu(k,1850) = lu(k,1850) - lu(k,1805) * lu(k,1844) + lu(k,1851) = lu(k,1851) - lu(k,1806) * lu(k,1844) + lu(k,1852) = lu(k,1852) - lu(k,1807) * lu(k,1844) + lu(k,1853) = lu(k,1853) - lu(k,1808) * lu(k,1844) + lu(k,1854) = lu(k,1854) - lu(k,1809) * lu(k,1844) + lu(k,1855) = lu(k,1855) - lu(k,1810) * lu(k,1844) + lu(k,1856) = lu(k,1856) - lu(k,1811) * lu(k,1844) + lu(k,1857) = lu(k,1857) - lu(k,1812) * lu(k,1844) + lu(k,1905) = lu(k,1905) - lu(k,1800) * lu(k,1904) + lu(k,1906) = lu(k,1906) - lu(k,1801) * lu(k,1904) + lu(k,1907) = lu(k,1907) - lu(k,1802) * lu(k,1904) + lu(k,1908) = lu(k,1908) - lu(k,1803) * lu(k,1904) + lu(k,1909) = lu(k,1909) - lu(k,1804) * lu(k,1904) + lu(k,1910) = lu(k,1910) - lu(k,1805) * lu(k,1904) + lu(k,1911) = lu(k,1911) - lu(k,1806) * lu(k,1904) + lu(k,1912) = lu(k,1912) - lu(k,1807) * lu(k,1904) + lu(k,1913) = lu(k,1913) - lu(k,1808) * lu(k,1904) + lu(k,1914) = lu(k,1914) - lu(k,1809) * lu(k,1904) + lu(k,1915) = lu(k,1915) - lu(k,1810) * lu(k,1904) + lu(k,1916) = lu(k,1916) - lu(k,1811) * lu(k,1904) + lu(k,1917) = lu(k,1917) - lu(k,1812) * lu(k,1904) + lu(k,1951) = lu(k,1951) - lu(k,1800) * lu(k,1950) + lu(k,1952) = lu(k,1952) - lu(k,1801) * lu(k,1950) + lu(k,1953) = lu(k,1953) - lu(k,1802) * lu(k,1950) + lu(k,1954) = lu(k,1954) - lu(k,1803) * lu(k,1950) + lu(k,1955) = lu(k,1955) - lu(k,1804) * lu(k,1950) + lu(k,1956) = lu(k,1956) - lu(k,1805) * lu(k,1950) + lu(k,1957) = lu(k,1957) - lu(k,1806) * lu(k,1950) + lu(k,1958) = lu(k,1958) - lu(k,1807) * lu(k,1950) + lu(k,1959) = lu(k,1959) - lu(k,1808) * lu(k,1950) + lu(k,1960) = lu(k,1960) - lu(k,1809) * lu(k,1950) + lu(k,1961) = lu(k,1961) - lu(k,1810) * lu(k,1950) + lu(k,1962) = lu(k,1962) - lu(k,1811) * lu(k,1950) + lu(k,1963) = lu(k,1963) - lu(k,1812) * lu(k,1950) + lu(k,1974) = lu(k,1974) - lu(k,1800) * lu(k,1973) + lu(k,1975) = lu(k,1975) - lu(k,1801) * lu(k,1973) + lu(k,1976) = lu(k,1976) - lu(k,1802) * lu(k,1973) + lu(k,1977) = lu(k,1977) - lu(k,1803) * lu(k,1973) + lu(k,1978) = lu(k,1978) - lu(k,1804) * lu(k,1973) + lu(k,1979) = lu(k,1979) - lu(k,1805) * lu(k,1973) + lu(k,1980) = lu(k,1980) - lu(k,1806) * lu(k,1973) + lu(k,1981) = lu(k,1981) - lu(k,1807) * lu(k,1973) + lu(k,1982) = lu(k,1982) - lu(k,1808) * lu(k,1973) + lu(k,1983) = lu(k,1983) - lu(k,1809) * lu(k,1973) + lu(k,1984) = lu(k,1984) - lu(k,1810) * lu(k,1973) + lu(k,1985) = lu(k,1985) - lu(k,1811) * lu(k,1973) + lu(k,1986) = lu(k,1986) - lu(k,1812) * lu(k,1973) + lu(k,2069) = lu(k,2069) - lu(k,1800) * lu(k,2068) + lu(k,2070) = lu(k,2070) - lu(k,1801) * lu(k,2068) + lu(k,2071) = lu(k,2071) - lu(k,1802) * lu(k,2068) + lu(k,2072) = lu(k,2072) - lu(k,1803) * lu(k,2068) + lu(k,2073) = lu(k,2073) - lu(k,1804) * lu(k,2068) + lu(k,2074) = lu(k,2074) - lu(k,1805) * lu(k,2068) + lu(k,2075) = lu(k,2075) - lu(k,1806) * lu(k,2068) + lu(k,2076) = lu(k,2076) - lu(k,1807) * lu(k,2068) + lu(k,2077) = lu(k,2077) - lu(k,1808) * lu(k,2068) + lu(k,2078) = lu(k,2078) - lu(k,1809) * lu(k,2068) + lu(k,2079) = lu(k,2079) - lu(k,1810) * lu(k,2068) + lu(k,2080) = lu(k,2080) - lu(k,1811) * lu(k,2068) + lu(k,2081) = lu(k,2081) - lu(k,1812) * lu(k,2068) + lu(k,2090) = lu(k,2090) - lu(k,1800) * lu(k,2089) + lu(k,2091) = lu(k,2091) - lu(k,1801) * lu(k,2089) + lu(k,2092) = lu(k,2092) - lu(k,1802) * lu(k,2089) + lu(k,2093) = lu(k,2093) - lu(k,1803) * lu(k,2089) + lu(k,2094) = lu(k,2094) - lu(k,1804) * lu(k,2089) + lu(k,2095) = lu(k,2095) - lu(k,1805) * lu(k,2089) + lu(k,2096) = lu(k,2096) - lu(k,1806) * lu(k,2089) + lu(k,2097) = lu(k,2097) - lu(k,1807) * lu(k,2089) + lu(k,2098) = lu(k,2098) - lu(k,1808) * lu(k,2089) + lu(k,2099) = lu(k,2099) - lu(k,1809) * lu(k,2089) + lu(k,2100) = lu(k,2100) - lu(k,1810) * lu(k,2089) + lu(k,2101) = lu(k,2101) - lu(k,1811) * lu(k,2089) + lu(k,2102) = lu(k,2102) - lu(k,1812) * lu(k,2089) + lu(k,2198) = lu(k,2198) - lu(k,1800) * lu(k,2197) + lu(k,2199) = lu(k,2199) - lu(k,1801) * lu(k,2197) + lu(k,2200) = lu(k,2200) - lu(k,1802) * lu(k,2197) + lu(k,2201) = lu(k,2201) - lu(k,1803) * lu(k,2197) + lu(k,2202) = lu(k,2202) - lu(k,1804) * lu(k,2197) + lu(k,2203) = lu(k,2203) - lu(k,1805) * lu(k,2197) + lu(k,2204) = lu(k,2204) - lu(k,1806) * lu(k,2197) + lu(k,2205) = lu(k,2205) - lu(k,1807) * lu(k,2197) + lu(k,2206) = lu(k,2206) - lu(k,1808) * lu(k,2197) + lu(k,2207) = lu(k,2207) - lu(k,1809) * lu(k,2197) + lu(k,2208) = lu(k,2208) - lu(k,1810) * lu(k,2197) + lu(k,2209) = lu(k,2209) - lu(k,1811) * lu(k,2197) + lu(k,2210) = lu(k,2210) - lu(k,1812) * lu(k,2197) + lu(k,2250) = lu(k,2250) - lu(k,1800) * lu(k,2249) + lu(k,2251) = lu(k,2251) - lu(k,1801) * lu(k,2249) + lu(k,2252) = lu(k,2252) - lu(k,1802) * lu(k,2249) + lu(k,2253) = lu(k,2253) - lu(k,1803) * lu(k,2249) + lu(k,2254) = lu(k,2254) - lu(k,1804) * lu(k,2249) + lu(k,2255) = lu(k,2255) - lu(k,1805) * lu(k,2249) + lu(k,2256) = lu(k,2256) - lu(k,1806) * lu(k,2249) + lu(k,2257) = lu(k,2257) - lu(k,1807) * lu(k,2249) + lu(k,2258) = lu(k,2258) - lu(k,1808) * lu(k,2249) + lu(k,2259) = lu(k,2259) - lu(k,1809) * lu(k,2249) + lu(k,2260) = lu(k,2260) - lu(k,1810) * lu(k,2249) + lu(k,2261) = lu(k,2261) - lu(k,1811) * lu(k,2249) + lu(k,2262) = lu(k,2262) - lu(k,1812) * lu(k,2249) + lu(k,2275) = lu(k,2275) - lu(k,1800) * lu(k,2274) + lu(k,2276) = lu(k,2276) - lu(k,1801) * lu(k,2274) + lu(k,2277) = lu(k,2277) - lu(k,1802) * lu(k,2274) + lu(k,2278) = lu(k,2278) - lu(k,1803) * lu(k,2274) + lu(k,2279) = lu(k,2279) - lu(k,1804) * lu(k,2274) + lu(k,2280) = lu(k,2280) - lu(k,1805) * lu(k,2274) + lu(k,2281) = lu(k,2281) - lu(k,1806) * lu(k,2274) + lu(k,2282) = lu(k,2282) - lu(k,1807) * lu(k,2274) + lu(k,2283) = lu(k,2283) - lu(k,1808) * lu(k,2274) + lu(k,2284) = lu(k,2284) - lu(k,1809) * lu(k,2274) + lu(k,2285) = lu(k,2285) - lu(k,1810) * lu(k,2274) + lu(k,2286) = lu(k,2286) - lu(k,1811) * lu(k,2274) + lu(k,2287) = lu(k,2287) - lu(k,1812) * lu(k,2274) + lu(k,2318) = lu(k,2318) - lu(k,1800) * lu(k,2317) + lu(k,2319) = lu(k,2319) - lu(k,1801) * lu(k,2317) + lu(k,2320) = lu(k,2320) - lu(k,1802) * lu(k,2317) + lu(k,2321) = lu(k,2321) - lu(k,1803) * lu(k,2317) + lu(k,2322) = lu(k,2322) - lu(k,1804) * lu(k,2317) + lu(k,2323) = lu(k,2323) - lu(k,1805) * lu(k,2317) + lu(k,2324) = lu(k,2324) - lu(k,1806) * lu(k,2317) + lu(k,2325) = lu(k,2325) - lu(k,1807) * lu(k,2317) + lu(k,2326) = lu(k,2326) - lu(k,1808) * lu(k,2317) + lu(k,2327) = lu(k,2327) - lu(k,1809) * lu(k,2317) + lu(k,2328) = lu(k,2328) - lu(k,1810) * lu(k,2317) + lu(k,2329) = lu(k,2329) - lu(k,1811) * lu(k,2317) + lu(k,2330) = lu(k,2330) - lu(k,1812) * lu(k,2317) + lu(k,2344) = lu(k,2344) - lu(k,1800) * lu(k,2343) + lu(k,2345) = lu(k,2345) - lu(k,1801) * lu(k,2343) + lu(k,2346) = lu(k,2346) - lu(k,1802) * lu(k,2343) + lu(k,2347) = lu(k,2347) - lu(k,1803) * lu(k,2343) + lu(k,2348) = lu(k,2348) - lu(k,1804) * lu(k,2343) + lu(k,2349) = lu(k,2349) - lu(k,1805) * lu(k,2343) + lu(k,2350) = lu(k,2350) - lu(k,1806) * lu(k,2343) + lu(k,2351) = lu(k,2351) - lu(k,1807) * lu(k,2343) + lu(k,2352) = lu(k,2352) - lu(k,1808) * lu(k,2343) + lu(k,2353) = lu(k,2353) - lu(k,1809) * lu(k,2343) + lu(k,2354) = lu(k,2354) - lu(k,1810) * lu(k,2343) + lu(k,2355) = lu(k,2355) - lu(k,1811) * lu(k,2343) + lu(k,2356) = lu(k,2356) - lu(k,1812) * lu(k,2343) + lu(k,2408) = lu(k,2408) - lu(k,1800) * lu(k,2407) + lu(k,2409) = lu(k,2409) - lu(k,1801) * lu(k,2407) + lu(k,2410) = lu(k,2410) - lu(k,1802) * lu(k,2407) + lu(k,2411) = lu(k,2411) - lu(k,1803) * lu(k,2407) + lu(k,2412) = lu(k,2412) - lu(k,1804) * lu(k,2407) + lu(k,2413) = lu(k,2413) - lu(k,1805) * lu(k,2407) + lu(k,2414) = lu(k,2414) - lu(k,1806) * lu(k,2407) + lu(k,2415) = lu(k,2415) - lu(k,1807) * lu(k,2407) + lu(k,2416) = lu(k,2416) - lu(k,1808) * lu(k,2407) + lu(k,2417) = lu(k,2417) - lu(k,1809) * lu(k,2407) + lu(k,2418) = lu(k,2418) - lu(k,1810) * lu(k,2407) + lu(k,2419) = lu(k,2419) - lu(k,1811) * lu(k,2407) + lu(k,2420) = lu(k,2420) - lu(k,1812) * lu(k,2407) + lu(k,2435) = lu(k,2435) - lu(k,1800) * lu(k,2434) + lu(k,2436) = lu(k,2436) - lu(k,1801) * lu(k,2434) + lu(k,2437) = lu(k,2437) - lu(k,1802) * lu(k,2434) + lu(k,2438) = lu(k,2438) - lu(k,1803) * lu(k,2434) + lu(k,2439) = lu(k,2439) - lu(k,1804) * lu(k,2434) + lu(k,2440) = lu(k,2440) - lu(k,1805) * lu(k,2434) + lu(k,2441) = lu(k,2441) - lu(k,1806) * lu(k,2434) + lu(k,2442) = lu(k,2442) - lu(k,1807) * lu(k,2434) + lu(k,2443) = lu(k,2443) - lu(k,1808) * lu(k,2434) + lu(k,2444) = lu(k,2444) - lu(k,1809) * lu(k,2434) + lu(k,2445) = lu(k,2445) - lu(k,1810) * lu(k,2434) + lu(k,2446) = lu(k,2446) - lu(k,1811) * lu(k,2434) + lu(k,2447) = lu(k,2447) - lu(k,1812) * lu(k,2434) + lu(k,1845) = 1._r8 / lu(k,1845) + lu(k,1846) = lu(k,1846) * lu(k,1845) + lu(k,1847) = lu(k,1847) * lu(k,1845) + lu(k,1848) = lu(k,1848) * lu(k,1845) + lu(k,1849) = lu(k,1849) * lu(k,1845) + lu(k,1850) = lu(k,1850) * lu(k,1845) + lu(k,1851) = lu(k,1851) * lu(k,1845) + lu(k,1852) = lu(k,1852) * lu(k,1845) + lu(k,1853) = lu(k,1853) * lu(k,1845) + lu(k,1854) = lu(k,1854) * lu(k,1845) + lu(k,1855) = lu(k,1855) * lu(k,1845) + lu(k,1856) = lu(k,1856) * lu(k,1845) + lu(k,1857) = lu(k,1857) * lu(k,1845) + lu(k,1906) = lu(k,1906) - lu(k,1846) * lu(k,1905) + lu(k,1907) = lu(k,1907) - lu(k,1847) * lu(k,1905) + lu(k,1908) = lu(k,1908) - lu(k,1848) * lu(k,1905) + lu(k,1909) = lu(k,1909) - lu(k,1849) * lu(k,1905) + lu(k,1910) = lu(k,1910) - lu(k,1850) * lu(k,1905) + lu(k,1911) = lu(k,1911) - lu(k,1851) * lu(k,1905) + lu(k,1912) = lu(k,1912) - lu(k,1852) * lu(k,1905) + lu(k,1913) = lu(k,1913) - lu(k,1853) * lu(k,1905) + lu(k,1914) = lu(k,1914) - lu(k,1854) * lu(k,1905) + lu(k,1915) = lu(k,1915) - lu(k,1855) * lu(k,1905) + lu(k,1916) = lu(k,1916) - lu(k,1856) * lu(k,1905) + lu(k,1917) = lu(k,1917) - lu(k,1857) * lu(k,1905) + lu(k,1952) = lu(k,1952) - lu(k,1846) * lu(k,1951) + lu(k,1953) = lu(k,1953) - lu(k,1847) * lu(k,1951) + lu(k,1954) = lu(k,1954) - lu(k,1848) * lu(k,1951) + lu(k,1955) = lu(k,1955) - lu(k,1849) * lu(k,1951) + lu(k,1956) = lu(k,1956) - lu(k,1850) * lu(k,1951) + lu(k,1957) = lu(k,1957) - lu(k,1851) * lu(k,1951) + lu(k,1958) = lu(k,1958) - lu(k,1852) * lu(k,1951) + lu(k,1959) = lu(k,1959) - lu(k,1853) * lu(k,1951) + lu(k,1960) = lu(k,1960) - lu(k,1854) * lu(k,1951) + lu(k,1961) = lu(k,1961) - lu(k,1855) * lu(k,1951) + lu(k,1962) = lu(k,1962) - lu(k,1856) * lu(k,1951) + lu(k,1963) = lu(k,1963) - lu(k,1857) * lu(k,1951) + lu(k,1975) = lu(k,1975) - lu(k,1846) * lu(k,1974) + lu(k,1976) = lu(k,1976) - lu(k,1847) * lu(k,1974) + lu(k,1977) = lu(k,1977) - lu(k,1848) * lu(k,1974) + lu(k,1978) = lu(k,1978) - lu(k,1849) * lu(k,1974) + lu(k,1979) = lu(k,1979) - lu(k,1850) * lu(k,1974) + lu(k,1980) = lu(k,1980) - lu(k,1851) * lu(k,1974) + lu(k,1981) = lu(k,1981) - lu(k,1852) * lu(k,1974) + lu(k,1982) = lu(k,1982) - lu(k,1853) * lu(k,1974) + lu(k,1983) = lu(k,1983) - lu(k,1854) * lu(k,1974) + lu(k,1984) = lu(k,1984) - lu(k,1855) * lu(k,1974) + lu(k,1985) = lu(k,1985) - lu(k,1856) * lu(k,1974) + lu(k,1986) = lu(k,1986) - lu(k,1857) * lu(k,1974) + lu(k,2070) = lu(k,2070) - lu(k,1846) * lu(k,2069) + lu(k,2071) = lu(k,2071) - lu(k,1847) * lu(k,2069) + lu(k,2072) = lu(k,2072) - lu(k,1848) * lu(k,2069) + lu(k,2073) = lu(k,2073) - lu(k,1849) * lu(k,2069) + lu(k,2074) = lu(k,2074) - lu(k,1850) * lu(k,2069) + lu(k,2075) = lu(k,2075) - lu(k,1851) * lu(k,2069) + lu(k,2076) = lu(k,2076) - lu(k,1852) * lu(k,2069) + lu(k,2077) = lu(k,2077) - lu(k,1853) * lu(k,2069) + lu(k,2078) = lu(k,2078) - lu(k,1854) * lu(k,2069) + lu(k,2079) = lu(k,2079) - lu(k,1855) * lu(k,2069) + lu(k,2080) = lu(k,2080) - lu(k,1856) * lu(k,2069) + lu(k,2081) = lu(k,2081) - lu(k,1857) * lu(k,2069) + lu(k,2091) = lu(k,2091) - lu(k,1846) * lu(k,2090) + lu(k,2092) = lu(k,2092) - lu(k,1847) * lu(k,2090) + lu(k,2093) = lu(k,2093) - lu(k,1848) * lu(k,2090) + lu(k,2094) = lu(k,2094) - lu(k,1849) * lu(k,2090) + lu(k,2095) = lu(k,2095) - lu(k,1850) * lu(k,2090) + lu(k,2096) = lu(k,2096) - lu(k,1851) * lu(k,2090) + lu(k,2097) = lu(k,2097) - lu(k,1852) * lu(k,2090) + lu(k,2098) = lu(k,2098) - lu(k,1853) * lu(k,2090) + lu(k,2099) = lu(k,2099) - lu(k,1854) * lu(k,2090) + lu(k,2100) = lu(k,2100) - lu(k,1855) * lu(k,2090) + lu(k,2101) = lu(k,2101) - lu(k,1856) * lu(k,2090) + lu(k,2102) = lu(k,2102) - lu(k,1857) * lu(k,2090) + lu(k,2199) = lu(k,2199) - lu(k,1846) * lu(k,2198) + lu(k,2200) = lu(k,2200) - lu(k,1847) * lu(k,2198) + lu(k,2201) = lu(k,2201) - lu(k,1848) * lu(k,2198) + lu(k,2202) = lu(k,2202) - lu(k,1849) * lu(k,2198) + lu(k,2203) = lu(k,2203) - lu(k,1850) * lu(k,2198) + lu(k,2204) = lu(k,2204) - lu(k,1851) * lu(k,2198) + lu(k,2205) = lu(k,2205) - lu(k,1852) * lu(k,2198) + lu(k,2206) = lu(k,2206) - lu(k,1853) * lu(k,2198) + lu(k,2207) = lu(k,2207) - lu(k,1854) * lu(k,2198) + lu(k,2208) = lu(k,2208) - lu(k,1855) * lu(k,2198) + lu(k,2209) = lu(k,2209) - lu(k,1856) * lu(k,2198) + lu(k,2210) = lu(k,2210) - lu(k,1857) * lu(k,2198) + lu(k,2251) = lu(k,2251) - lu(k,1846) * lu(k,2250) + lu(k,2252) = lu(k,2252) - lu(k,1847) * lu(k,2250) + lu(k,2253) = lu(k,2253) - lu(k,1848) * lu(k,2250) + lu(k,2254) = lu(k,2254) - lu(k,1849) * lu(k,2250) + lu(k,2255) = lu(k,2255) - lu(k,1850) * lu(k,2250) + lu(k,2256) = lu(k,2256) - lu(k,1851) * lu(k,2250) + lu(k,2257) = lu(k,2257) - lu(k,1852) * lu(k,2250) + lu(k,2258) = lu(k,2258) - lu(k,1853) * lu(k,2250) + lu(k,2259) = lu(k,2259) - lu(k,1854) * lu(k,2250) + lu(k,2260) = lu(k,2260) - lu(k,1855) * lu(k,2250) + lu(k,2261) = lu(k,2261) - lu(k,1856) * lu(k,2250) + lu(k,2262) = lu(k,2262) - lu(k,1857) * lu(k,2250) + lu(k,2276) = lu(k,2276) - lu(k,1846) * lu(k,2275) + lu(k,2277) = lu(k,2277) - lu(k,1847) * lu(k,2275) + lu(k,2278) = lu(k,2278) - lu(k,1848) * lu(k,2275) + lu(k,2279) = lu(k,2279) - lu(k,1849) * lu(k,2275) + lu(k,2280) = lu(k,2280) - lu(k,1850) * lu(k,2275) + lu(k,2281) = lu(k,2281) - lu(k,1851) * lu(k,2275) + lu(k,2282) = lu(k,2282) - lu(k,1852) * lu(k,2275) + lu(k,2283) = lu(k,2283) - lu(k,1853) * lu(k,2275) + lu(k,2284) = lu(k,2284) - lu(k,1854) * lu(k,2275) + lu(k,2285) = lu(k,2285) - lu(k,1855) * lu(k,2275) + lu(k,2286) = lu(k,2286) - lu(k,1856) * lu(k,2275) + lu(k,2287) = lu(k,2287) - lu(k,1857) * lu(k,2275) + lu(k,2319) = lu(k,2319) - lu(k,1846) * lu(k,2318) + lu(k,2320) = lu(k,2320) - lu(k,1847) * lu(k,2318) + lu(k,2321) = lu(k,2321) - lu(k,1848) * lu(k,2318) + lu(k,2322) = lu(k,2322) - lu(k,1849) * lu(k,2318) + lu(k,2323) = lu(k,2323) - lu(k,1850) * lu(k,2318) + lu(k,2324) = lu(k,2324) - lu(k,1851) * lu(k,2318) + lu(k,2325) = lu(k,2325) - lu(k,1852) * lu(k,2318) + lu(k,2326) = lu(k,2326) - lu(k,1853) * lu(k,2318) + lu(k,2327) = lu(k,2327) - lu(k,1854) * lu(k,2318) + lu(k,2328) = lu(k,2328) - lu(k,1855) * lu(k,2318) + lu(k,2329) = lu(k,2329) - lu(k,1856) * lu(k,2318) + lu(k,2330) = lu(k,2330) - lu(k,1857) * lu(k,2318) + lu(k,2345) = lu(k,2345) - lu(k,1846) * lu(k,2344) + lu(k,2346) = lu(k,2346) - lu(k,1847) * lu(k,2344) + lu(k,2347) = lu(k,2347) - lu(k,1848) * lu(k,2344) + lu(k,2348) = lu(k,2348) - lu(k,1849) * lu(k,2344) + lu(k,2349) = lu(k,2349) - lu(k,1850) * lu(k,2344) + lu(k,2350) = lu(k,2350) - lu(k,1851) * lu(k,2344) + lu(k,2351) = lu(k,2351) - lu(k,1852) * lu(k,2344) + lu(k,2352) = lu(k,2352) - lu(k,1853) * lu(k,2344) + lu(k,2353) = lu(k,2353) - lu(k,1854) * lu(k,2344) + lu(k,2354) = lu(k,2354) - lu(k,1855) * lu(k,2344) + lu(k,2355) = lu(k,2355) - lu(k,1856) * lu(k,2344) + lu(k,2356) = lu(k,2356) - lu(k,1857) * lu(k,2344) + lu(k,2409) = lu(k,2409) - lu(k,1846) * lu(k,2408) + lu(k,2410) = lu(k,2410) - lu(k,1847) * lu(k,2408) + lu(k,2411) = lu(k,2411) - lu(k,1848) * lu(k,2408) + lu(k,2412) = lu(k,2412) - lu(k,1849) * lu(k,2408) + lu(k,2413) = lu(k,2413) - lu(k,1850) * lu(k,2408) + lu(k,2414) = lu(k,2414) - lu(k,1851) * lu(k,2408) + lu(k,2415) = lu(k,2415) - lu(k,1852) * lu(k,2408) + lu(k,2416) = lu(k,2416) - lu(k,1853) * lu(k,2408) + lu(k,2417) = lu(k,2417) - lu(k,1854) * lu(k,2408) + lu(k,2418) = lu(k,2418) - lu(k,1855) * lu(k,2408) + lu(k,2419) = lu(k,2419) - lu(k,1856) * lu(k,2408) + lu(k,2420) = lu(k,2420) - lu(k,1857) * lu(k,2408) + lu(k,2436) = lu(k,2436) - lu(k,1846) * lu(k,2435) + lu(k,2437) = lu(k,2437) - lu(k,1847) * lu(k,2435) + lu(k,2438) = lu(k,2438) - lu(k,1848) * lu(k,2435) + lu(k,2439) = lu(k,2439) - lu(k,1849) * lu(k,2435) + lu(k,2440) = lu(k,2440) - lu(k,1850) * lu(k,2435) + lu(k,2441) = lu(k,2441) - lu(k,1851) * lu(k,2435) + lu(k,2442) = lu(k,2442) - lu(k,1852) * lu(k,2435) + lu(k,2443) = lu(k,2443) - lu(k,1853) * lu(k,2435) + lu(k,2444) = lu(k,2444) - lu(k,1854) * lu(k,2435) + lu(k,2445) = lu(k,2445) - lu(k,1855) * lu(k,2435) + lu(k,2446) = lu(k,2446) - lu(k,1856) * lu(k,2435) + lu(k,2447) = lu(k,2447) - lu(k,1857) * lu(k,2435) end do - end subroutine lu_fac30 + end subroutine lu_fac31 + subroutine lu_fac32( 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,1906) = 1._r8 / lu(k,1906) + lu(k,1907) = lu(k,1907) * lu(k,1906) + lu(k,1908) = lu(k,1908) * lu(k,1906) + lu(k,1909) = lu(k,1909) * lu(k,1906) + lu(k,1910) = lu(k,1910) * lu(k,1906) + lu(k,1911) = lu(k,1911) * lu(k,1906) + lu(k,1912) = lu(k,1912) * lu(k,1906) + lu(k,1913) = lu(k,1913) * lu(k,1906) + lu(k,1914) = lu(k,1914) * lu(k,1906) + lu(k,1915) = lu(k,1915) * lu(k,1906) + lu(k,1916) = lu(k,1916) * lu(k,1906) + lu(k,1917) = lu(k,1917) * lu(k,1906) + lu(k,1953) = lu(k,1953) - lu(k,1907) * lu(k,1952) + lu(k,1954) = lu(k,1954) - lu(k,1908) * lu(k,1952) + lu(k,1955) = lu(k,1955) - lu(k,1909) * lu(k,1952) + lu(k,1956) = lu(k,1956) - lu(k,1910) * lu(k,1952) + lu(k,1957) = lu(k,1957) - lu(k,1911) * lu(k,1952) + lu(k,1958) = lu(k,1958) - lu(k,1912) * lu(k,1952) + lu(k,1959) = lu(k,1959) - lu(k,1913) * lu(k,1952) + lu(k,1960) = lu(k,1960) - lu(k,1914) * lu(k,1952) + lu(k,1961) = lu(k,1961) - lu(k,1915) * lu(k,1952) + lu(k,1962) = lu(k,1962) - lu(k,1916) * lu(k,1952) + lu(k,1963) = lu(k,1963) - lu(k,1917) * lu(k,1952) + lu(k,1976) = lu(k,1976) - lu(k,1907) * lu(k,1975) + lu(k,1977) = lu(k,1977) - lu(k,1908) * lu(k,1975) + lu(k,1978) = lu(k,1978) - lu(k,1909) * lu(k,1975) + lu(k,1979) = lu(k,1979) - lu(k,1910) * lu(k,1975) + lu(k,1980) = lu(k,1980) - lu(k,1911) * lu(k,1975) + lu(k,1981) = lu(k,1981) - lu(k,1912) * lu(k,1975) + lu(k,1982) = lu(k,1982) - lu(k,1913) * lu(k,1975) + lu(k,1983) = lu(k,1983) - lu(k,1914) * lu(k,1975) + lu(k,1984) = lu(k,1984) - lu(k,1915) * lu(k,1975) + lu(k,1985) = lu(k,1985) - lu(k,1916) * lu(k,1975) + lu(k,1986) = lu(k,1986) - lu(k,1917) * lu(k,1975) + lu(k,2071) = lu(k,2071) - lu(k,1907) * lu(k,2070) + lu(k,2072) = lu(k,2072) - lu(k,1908) * lu(k,2070) + lu(k,2073) = lu(k,2073) - lu(k,1909) * lu(k,2070) + lu(k,2074) = lu(k,2074) - lu(k,1910) * lu(k,2070) + lu(k,2075) = lu(k,2075) - lu(k,1911) * lu(k,2070) + lu(k,2076) = lu(k,2076) - lu(k,1912) * lu(k,2070) + lu(k,2077) = lu(k,2077) - lu(k,1913) * lu(k,2070) + lu(k,2078) = lu(k,2078) - lu(k,1914) * lu(k,2070) + lu(k,2079) = lu(k,2079) - lu(k,1915) * lu(k,2070) + lu(k,2080) = lu(k,2080) - lu(k,1916) * lu(k,2070) + lu(k,2081) = lu(k,2081) - lu(k,1917) * lu(k,2070) + lu(k,2092) = lu(k,2092) - lu(k,1907) * lu(k,2091) + lu(k,2093) = lu(k,2093) - lu(k,1908) * lu(k,2091) + lu(k,2094) = lu(k,2094) - lu(k,1909) * lu(k,2091) + lu(k,2095) = lu(k,2095) - lu(k,1910) * lu(k,2091) + lu(k,2096) = lu(k,2096) - lu(k,1911) * lu(k,2091) + lu(k,2097) = lu(k,2097) - lu(k,1912) * lu(k,2091) + lu(k,2098) = lu(k,2098) - lu(k,1913) * lu(k,2091) + lu(k,2099) = lu(k,2099) - lu(k,1914) * lu(k,2091) + lu(k,2100) = lu(k,2100) - lu(k,1915) * lu(k,2091) + lu(k,2101) = lu(k,2101) - lu(k,1916) * lu(k,2091) + lu(k,2102) = lu(k,2102) - lu(k,1917) * lu(k,2091) + lu(k,2200) = lu(k,2200) - lu(k,1907) * lu(k,2199) + lu(k,2201) = lu(k,2201) - lu(k,1908) * lu(k,2199) + lu(k,2202) = lu(k,2202) - lu(k,1909) * lu(k,2199) + lu(k,2203) = lu(k,2203) - lu(k,1910) * lu(k,2199) + lu(k,2204) = lu(k,2204) - lu(k,1911) * lu(k,2199) + lu(k,2205) = lu(k,2205) - lu(k,1912) * lu(k,2199) + lu(k,2206) = lu(k,2206) - lu(k,1913) * lu(k,2199) + lu(k,2207) = lu(k,2207) - lu(k,1914) * lu(k,2199) + lu(k,2208) = lu(k,2208) - lu(k,1915) * lu(k,2199) + lu(k,2209) = lu(k,2209) - lu(k,1916) * lu(k,2199) + lu(k,2210) = lu(k,2210) - lu(k,1917) * lu(k,2199) + lu(k,2252) = lu(k,2252) - lu(k,1907) * lu(k,2251) + lu(k,2253) = lu(k,2253) - lu(k,1908) * lu(k,2251) + lu(k,2254) = lu(k,2254) - lu(k,1909) * lu(k,2251) + lu(k,2255) = lu(k,2255) - lu(k,1910) * lu(k,2251) + lu(k,2256) = lu(k,2256) - lu(k,1911) * lu(k,2251) + lu(k,2257) = lu(k,2257) - lu(k,1912) * lu(k,2251) + lu(k,2258) = lu(k,2258) - lu(k,1913) * lu(k,2251) + lu(k,2259) = lu(k,2259) - lu(k,1914) * lu(k,2251) + lu(k,2260) = lu(k,2260) - lu(k,1915) * lu(k,2251) + lu(k,2261) = lu(k,2261) - lu(k,1916) * lu(k,2251) + lu(k,2262) = lu(k,2262) - lu(k,1917) * lu(k,2251) + lu(k,2277) = lu(k,2277) - lu(k,1907) * lu(k,2276) + lu(k,2278) = lu(k,2278) - lu(k,1908) * lu(k,2276) + lu(k,2279) = lu(k,2279) - lu(k,1909) * lu(k,2276) + lu(k,2280) = lu(k,2280) - lu(k,1910) * lu(k,2276) + lu(k,2281) = lu(k,2281) - lu(k,1911) * lu(k,2276) + lu(k,2282) = lu(k,2282) - lu(k,1912) * lu(k,2276) + lu(k,2283) = lu(k,2283) - lu(k,1913) * lu(k,2276) + lu(k,2284) = lu(k,2284) - lu(k,1914) * lu(k,2276) + lu(k,2285) = lu(k,2285) - lu(k,1915) * lu(k,2276) + lu(k,2286) = lu(k,2286) - lu(k,1916) * lu(k,2276) + lu(k,2287) = lu(k,2287) - lu(k,1917) * lu(k,2276) + lu(k,2320) = lu(k,2320) - lu(k,1907) * lu(k,2319) + lu(k,2321) = lu(k,2321) - lu(k,1908) * lu(k,2319) + lu(k,2322) = lu(k,2322) - lu(k,1909) * lu(k,2319) + lu(k,2323) = lu(k,2323) - lu(k,1910) * lu(k,2319) + lu(k,2324) = lu(k,2324) - lu(k,1911) * lu(k,2319) + lu(k,2325) = lu(k,2325) - lu(k,1912) * lu(k,2319) + lu(k,2326) = lu(k,2326) - lu(k,1913) * lu(k,2319) + lu(k,2327) = lu(k,2327) - lu(k,1914) * lu(k,2319) + lu(k,2328) = lu(k,2328) - lu(k,1915) * lu(k,2319) + lu(k,2329) = lu(k,2329) - lu(k,1916) * lu(k,2319) + lu(k,2330) = lu(k,2330) - lu(k,1917) * lu(k,2319) + lu(k,2346) = lu(k,2346) - lu(k,1907) * lu(k,2345) + lu(k,2347) = lu(k,2347) - lu(k,1908) * lu(k,2345) + lu(k,2348) = lu(k,2348) - lu(k,1909) * lu(k,2345) + lu(k,2349) = lu(k,2349) - lu(k,1910) * lu(k,2345) + lu(k,2350) = lu(k,2350) - lu(k,1911) * lu(k,2345) + lu(k,2351) = lu(k,2351) - lu(k,1912) * lu(k,2345) + lu(k,2352) = lu(k,2352) - lu(k,1913) * lu(k,2345) + lu(k,2353) = lu(k,2353) - lu(k,1914) * lu(k,2345) + lu(k,2354) = lu(k,2354) - lu(k,1915) * lu(k,2345) + lu(k,2355) = lu(k,2355) - lu(k,1916) * lu(k,2345) + lu(k,2356) = lu(k,2356) - lu(k,1917) * lu(k,2345) + lu(k,2410) = lu(k,2410) - lu(k,1907) * lu(k,2409) + lu(k,2411) = lu(k,2411) - lu(k,1908) * lu(k,2409) + lu(k,2412) = lu(k,2412) - lu(k,1909) * lu(k,2409) + lu(k,2413) = lu(k,2413) - lu(k,1910) * lu(k,2409) + lu(k,2414) = lu(k,2414) - lu(k,1911) * lu(k,2409) + lu(k,2415) = lu(k,2415) - lu(k,1912) * lu(k,2409) + lu(k,2416) = lu(k,2416) - lu(k,1913) * lu(k,2409) + lu(k,2417) = lu(k,2417) - lu(k,1914) * lu(k,2409) + lu(k,2418) = lu(k,2418) - lu(k,1915) * lu(k,2409) + lu(k,2419) = lu(k,2419) - lu(k,1916) * lu(k,2409) + lu(k,2420) = lu(k,2420) - lu(k,1917) * lu(k,2409) + lu(k,2437) = lu(k,2437) - lu(k,1907) * lu(k,2436) + lu(k,2438) = lu(k,2438) - lu(k,1908) * lu(k,2436) + lu(k,2439) = lu(k,2439) - lu(k,1909) * lu(k,2436) + lu(k,2440) = lu(k,2440) - lu(k,1910) * lu(k,2436) + lu(k,2441) = lu(k,2441) - lu(k,1911) * lu(k,2436) + lu(k,2442) = lu(k,2442) - lu(k,1912) * lu(k,2436) + lu(k,2443) = lu(k,2443) - lu(k,1913) * lu(k,2436) + lu(k,2444) = lu(k,2444) - lu(k,1914) * lu(k,2436) + lu(k,2445) = lu(k,2445) - lu(k,1915) * lu(k,2436) + lu(k,2446) = lu(k,2446) - lu(k,1916) * lu(k,2436) + lu(k,2447) = lu(k,2447) - lu(k,1917) * lu(k,2436) + lu(k,1953) = 1._r8 / lu(k,1953) + lu(k,1954) = lu(k,1954) * lu(k,1953) + lu(k,1955) = lu(k,1955) * lu(k,1953) + lu(k,1956) = lu(k,1956) * lu(k,1953) + lu(k,1957) = lu(k,1957) * lu(k,1953) + lu(k,1958) = lu(k,1958) * lu(k,1953) + lu(k,1959) = lu(k,1959) * lu(k,1953) + lu(k,1960) = lu(k,1960) * lu(k,1953) + lu(k,1961) = lu(k,1961) * lu(k,1953) + lu(k,1962) = lu(k,1962) * lu(k,1953) + lu(k,1963) = lu(k,1963) * lu(k,1953) + lu(k,1977) = lu(k,1977) - lu(k,1954) * lu(k,1976) + lu(k,1978) = lu(k,1978) - lu(k,1955) * lu(k,1976) + lu(k,1979) = lu(k,1979) - lu(k,1956) * lu(k,1976) + lu(k,1980) = lu(k,1980) - lu(k,1957) * lu(k,1976) + lu(k,1981) = lu(k,1981) - lu(k,1958) * lu(k,1976) + lu(k,1982) = lu(k,1982) - lu(k,1959) * lu(k,1976) + lu(k,1983) = lu(k,1983) - lu(k,1960) * lu(k,1976) + lu(k,1984) = lu(k,1984) - lu(k,1961) * lu(k,1976) + lu(k,1985) = lu(k,1985) - lu(k,1962) * lu(k,1976) + lu(k,1986) = lu(k,1986) - lu(k,1963) * lu(k,1976) + lu(k,2072) = lu(k,2072) - lu(k,1954) * lu(k,2071) + lu(k,2073) = lu(k,2073) - lu(k,1955) * lu(k,2071) + lu(k,2074) = lu(k,2074) - lu(k,1956) * lu(k,2071) + lu(k,2075) = lu(k,2075) - lu(k,1957) * lu(k,2071) + lu(k,2076) = lu(k,2076) - lu(k,1958) * lu(k,2071) + lu(k,2077) = lu(k,2077) - lu(k,1959) * lu(k,2071) + lu(k,2078) = lu(k,2078) - lu(k,1960) * lu(k,2071) + lu(k,2079) = lu(k,2079) - lu(k,1961) * lu(k,2071) + lu(k,2080) = lu(k,2080) - lu(k,1962) * lu(k,2071) + lu(k,2081) = lu(k,2081) - lu(k,1963) * lu(k,2071) + lu(k,2093) = lu(k,2093) - lu(k,1954) * lu(k,2092) + lu(k,2094) = lu(k,2094) - lu(k,1955) * lu(k,2092) + lu(k,2095) = lu(k,2095) - lu(k,1956) * lu(k,2092) + lu(k,2096) = lu(k,2096) - lu(k,1957) * lu(k,2092) + lu(k,2097) = lu(k,2097) - lu(k,1958) * lu(k,2092) + lu(k,2098) = lu(k,2098) - lu(k,1959) * lu(k,2092) + lu(k,2099) = lu(k,2099) - lu(k,1960) * lu(k,2092) + lu(k,2100) = lu(k,2100) - lu(k,1961) * lu(k,2092) + lu(k,2101) = lu(k,2101) - lu(k,1962) * lu(k,2092) + lu(k,2102) = lu(k,2102) - lu(k,1963) * lu(k,2092) + lu(k,2201) = lu(k,2201) - lu(k,1954) * lu(k,2200) + lu(k,2202) = lu(k,2202) - lu(k,1955) * lu(k,2200) + lu(k,2203) = lu(k,2203) - lu(k,1956) * lu(k,2200) + lu(k,2204) = lu(k,2204) - lu(k,1957) * lu(k,2200) + lu(k,2205) = lu(k,2205) - lu(k,1958) * lu(k,2200) + lu(k,2206) = lu(k,2206) - lu(k,1959) * lu(k,2200) + lu(k,2207) = lu(k,2207) - lu(k,1960) * lu(k,2200) + lu(k,2208) = lu(k,2208) - lu(k,1961) * lu(k,2200) + lu(k,2209) = lu(k,2209) - lu(k,1962) * lu(k,2200) + lu(k,2210) = lu(k,2210) - lu(k,1963) * lu(k,2200) + lu(k,2253) = lu(k,2253) - lu(k,1954) * lu(k,2252) + lu(k,2254) = lu(k,2254) - lu(k,1955) * lu(k,2252) + lu(k,2255) = lu(k,2255) - lu(k,1956) * lu(k,2252) + lu(k,2256) = lu(k,2256) - lu(k,1957) * lu(k,2252) + lu(k,2257) = lu(k,2257) - lu(k,1958) * lu(k,2252) + lu(k,2258) = lu(k,2258) - lu(k,1959) * lu(k,2252) + lu(k,2259) = lu(k,2259) - lu(k,1960) * lu(k,2252) + lu(k,2260) = lu(k,2260) - lu(k,1961) * lu(k,2252) + lu(k,2261) = lu(k,2261) - lu(k,1962) * lu(k,2252) + lu(k,2262) = lu(k,2262) - lu(k,1963) * lu(k,2252) + lu(k,2278) = lu(k,2278) - lu(k,1954) * lu(k,2277) + lu(k,2279) = lu(k,2279) - lu(k,1955) * lu(k,2277) + lu(k,2280) = lu(k,2280) - lu(k,1956) * lu(k,2277) + lu(k,2281) = lu(k,2281) - lu(k,1957) * lu(k,2277) + lu(k,2282) = lu(k,2282) - lu(k,1958) * lu(k,2277) + lu(k,2283) = lu(k,2283) - lu(k,1959) * lu(k,2277) + lu(k,2284) = lu(k,2284) - lu(k,1960) * lu(k,2277) + lu(k,2285) = lu(k,2285) - lu(k,1961) * lu(k,2277) + lu(k,2286) = lu(k,2286) - lu(k,1962) * lu(k,2277) + lu(k,2287) = lu(k,2287) - lu(k,1963) * lu(k,2277) + lu(k,2321) = lu(k,2321) - lu(k,1954) * lu(k,2320) + lu(k,2322) = lu(k,2322) - lu(k,1955) * lu(k,2320) + lu(k,2323) = lu(k,2323) - lu(k,1956) * lu(k,2320) + lu(k,2324) = lu(k,2324) - lu(k,1957) * lu(k,2320) + lu(k,2325) = lu(k,2325) - lu(k,1958) * lu(k,2320) + lu(k,2326) = lu(k,2326) - lu(k,1959) * lu(k,2320) + lu(k,2327) = lu(k,2327) - lu(k,1960) * lu(k,2320) + lu(k,2328) = lu(k,2328) - lu(k,1961) * lu(k,2320) + lu(k,2329) = lu(k,2329) - lu(k,1962) * lu(k,2320) + lu(k,2330) = lu(k,2330) - lu(k,1963) * lu(k,2320) + lu(k,2347) = lu(k,2347) - lu(k,1954) * lu(k,2346) + lu(k,2348) = lu(k,2348) - lu(k,1955) * lu(k,2346) + lu(k,2349) = lu(k,2349) - lu(k,1956) * lu(k,2346) + lu(k,2350) = lu(k,2350) - lu(k,1957) * lu(k,2346) + lu(k,2351) = lu(k,2351) - lu(k,1958) * lu(k,2346) + lu(k,2352) = lu(k,2352) - lu(k,1959) * lu(k,2346) + lu(k,2353) = lu(k,2353) - lu(k,1960) * lu(k,2346) + lu(k,2354) = lu(k,2354) - lu(k,1961) * lu(k,2346) + lu(k,2355) = lu(k,2355) - lu(k,1962) * lu(k,2346) + lu(k,2356) = lu(k,2356) - lu(k,1963) * lu(k,2346) + lu(k,2411) = lu(k,2411) - lu(k,1954) * lu(k,2410) + lu(k,2412) = lu(k,2412) - lu(k,1955) * lu(k,2410) + lu(k,2413) = lu(k,2413) - lu(k,1956) * lu(k,2410) + lu(k,2414) = lu(k,2414) - lu(k,1957) * lu(k,2410) + lu(k,2415) = lu(k,2415) - lu(k,1958) * lu(k,2410) + lu(k,2416) = lu(k,2416) - lu(k,1959) * lu(k,2410) + lu(k,2417) = lu(k,2417) - lu(k,1960) * lu(k,2410) + lu(k,2418) = lu(k,2418) - lu(k,1961) * lu(k,2410) + lu(k,2419) = lu(k,2419) - lu(k,1962) * lu(k,2410) + lu(k,2420) = lu(k,2420) - lu(k,1963) * lu(k,2410) + lu(k,2438) = lu(k,2438) - lu(k,1954) * lu(k,2437) + lu(k,2439) = lu(k,2439) - lu(k,1955) * lu(k,2437) + lu(k,2440) = lu(k,2440) - lu(k,1956) * lu(k,2437) + lu(k,2441) = lu(k,2441) - lu(k,1957) * lu(k,2437) + lu(k,2442) = lu(k,2442) - lu(k,1958) * lu(k,2437) + lu(k,2443) = lu(k,2443) - lu(k,1959) * lu(k,2437) + lu(k,2444) = lu(k,2444) - lu(k,1960) * lu(k,2437) + lu(k,2445) = lu(k,2445) - lu(k,1961) * lu(k,2437) + lu(k,2446) = lu(k,2446) - lu(k,1962) * lu(k,2437) + lu(k,2447) = lu(k,2447) - lu(k,1963) * lu(k,2437) + lu(k,1977) = 1._r8 / lu(k,1977) + lu(k,1978) = lu(k,1978) * lu(k,1977) + lu(k,1979) = lu(k,1979) * lu(k,1977) + lu(k,1980) = lu(k,1980) * lu(k,1977) + lu(k,1981) = lu(k,1981) * lu(k,1977) + lu(k,1982) = lu(k,1982) * lu(k,1977) + lu(k,1983) = lu(k,1983) * lu(k,1977) + lu(k,1984) = lu(k,1984) * lu(k,1977) + lu(k,1985) = lu(k,1985) * lu(k,1977) + lu(k,1986) = lu(k,1986) * lu(k,1977) + lu(k,2073) = lu(k,2073) - lu(k,1978) * lu(k,2072) + lu(k,2074) = lu(k,2074) - lu(k,1979) * lu(k,2072) + lu(k,2075) = lu(k,2075) - lu(k,1980) * lu(k,2072) + lu(k,2076) = lu(k,2076) - lu(k,1981) * lu(k,2072) + lu(k,2077) = lu(k,2077) - lu(k,1982) * lu(k,2072) + lu(k,2078) = lu(k,2078) - lu(k,1983) * lu(k,2072) + lu(k,2079) = lu(k,2079) - lu(k,1984) * lu(k,2072) + lu(k,2080) = lu(k,2080) - lu(k,1985) * lu(k,2072) + lu(k,2081) = lu(k,2081) - lu(k,1986) * lu(k,2072) + lu(k,2094) = lu(k,2094) - lu(k,1978) * lu(k,2093) + lu(k,2095) = lu(k,2095) - lu(k,1979) * lu(k,2093) + lu(k,2096) = lu(k,2096) - lu(k,1980) * lu(k,2093) + lu(k,2097) = lu(k,2097) - lu(k,1981) * lu(k,2093) + lu(k,2098) = lu(k,2098) - lu(k,1982) * lu(k,2093) + lu(k,2099) = lu(k,2099) - lu(k,1983) * lu(k,2093) + lu(k,2100) = lu(k,2100) - lu(k,1984) * lu(k,2093) + lu(k,2101) = lu(k,2101) - lu(k,1985) * lu(k,2093) + lu(k,2102) = lu(k,2102) - lu(k,1986) * lu(k,2093) + lu(k,2202) = lu(k,2202) - lu(k,1978) * lu(k,2201) + lu(k,2203) = lu(k,2203) - lu(k,1979) * lu(k,2201) + lu(k,2204) = lu(k,2204) - lu(k,1980) * lu(k,2201) + lu(k,2205) = lu(k,2205) - lu(k,1981) * lu(k,2201) + lu(k,2206) = lu(k,2206) - lu(k,1982) * lu(k,2201) + lu(k,2207) = lu(k,2207) - lu(k,1983) * lu(k,2201) + lu(k,2208) = lu(k,2208) - lu(k,1984) * lu(k,2201) + lu(k,2209) = lu(k,2209) - lu(k,1985) * lu(k,2201) + lu(k,2210) = lu(k,2210) - lu(k,1986) * lu(k,2201) + lu(k,2254) = lu(k,2254) - lu(k,1978) * lu(k,2253) + lu(k,2255) = lu(k,2255) - lu(k,1979) * lu(k,2253) + lu(k,2256) = lu(k,2256) - lu(k,1980) * lu(k,2253) + lu(k,2257) = lu(k,2257) - lu(k,1981) * lu(k,2253) + lu(k,2258) = lu(k,2258) - lu(k,1982) * lu(k,2253) + lu(k,2259) = lu(k,2259) - lu(k,1983) * lu(k,2253) + lu(k,2260) = lu(k,2260) - lu(k,1984) * lu(k,2253) + lu(k,2261) = lu(k,2261) - lu(k,1985) * lu(k,2253) + lu(k,2262) = lu(k,2262) - lu(k,1986) * lu(k,2253) + lu(k,2279) = lu(k,2279) - lu(k,1978) * lu(k,2278) + lu(k,2280) = lu(k,2280) - lu(k,1979) * lu(k,2278) + lu(k,2281) = lu(k,2281) - lu(k,1980) * lu(k,2278) + lu(k,2282) = lu(k,2282) - lu(k,1981) * lu(k,2278) + lu(k,2283) = lu(k,2283) - lu(k,1982) * lu(k,2278) + lu(k,2284) = lu(k,2284) - lu(k,1983) * lu(k,2278) + lu(k,2285) = lu(k,2285) - lu(k,1984) * lu(k,2278) + lu(k,2286) = lu(k,2286) - lu(k,1985) * lu(k,2278) + lu(k,2287) = lu(k,2287) - lu(k,1986) * lu(k,2278) + lu(k,2322) = lu(k,2322) - lu(k,1978) * lu(k,2321) + lu(k,2323) = lu(k,2323) - lu(k,1979) * lu(k,2321) + lu(k,2324) = lu(k,2324) - lu(k,1980) * lu(k,2321) + lu(k,2325) = lu(k,2325) - lu(k,1981) * lu(k,2321) + lu(k,2326) = lu(k,2326) - lu(k,1982) * lu(k,2321) + lu(k,2327) = lu(k,2327) - lu(k,1983) * lu(k,2321) + lu(k,2328) = lu(k,2328) - lu(k,1984) * lu(k,2321) + lu(k,2329) = lu(k,2329) - lu(k,1985) * lu(k,2321) + lu(k,2330) = lu(k,2330) - lu(k,1986) * lu(k,2321) + lu(k,2348) = lu(k,2348) - lu(k,1978) * lu(k,2347) + lu(k,2349) = lu(k,2349) - lu(k,1979) * lu(k,2347) + lu(k,2350) = lu(k,2350) - lu(k,1980) * lu(k,2347) + lu(k,2351) = lu(k,2351) - lu(k,1981) * lu(k,2347) + lu(k,2352) = lu(k,2352) - lu(k,1982) * lu(k,2347) + lu(k,2353) = lu(k,2353) - lu(k,1983) * lu(k,2347) + lu(k,2354) = lu(k,2354) - lu(k,1984) * lu(k,2347) + lu(k,2355) = lu(k,2355) - lu(k,1985) * lu(k,2347) + lu(k,2356) = lu(k,2356) - lu(k,1986) * lu(k,2347) + lu(k,2412) = lu(k,2412) - lu(k,1978) * lu(k,2411) + lu(k,2413) = lu(k,2413) - lu(k,1979) * lu(k,2411) + lu(k,2414) = lu(k,2414) - lu(k,1980) * lu(k,2411) + lu(k,2415) = lu(k,2415) - lu(k,1981) * lu(k,2411) + lu(k,2416) = lu(k,2416) - lu(k,1982) * lu(k,2411) + lu(k,2417) = lu(k,2417) - lu(k,1983) * lu(k,2411) + lu(k,2418) = lu(k,2418) - lu(k,1984) * lu(k,2411) + lu(k,2419) = lu(k,2419) - lu(k,1985) * lu(k,2411) + lu(k,2420) = lu(k,2420) - lu(k,1986) * lu(k,2411) + lu(k,2439) = lu(k,2439) - lu(k,1978) * lu(k,2438) + lu(k,2440) = lu(k,2440) - lu(k,1979) * lu(k,2438) + lu(k,2441) = lu(k,2441) - lu(k,1980) * lu(k,2438) + lu(k,2442) = lu(k,2442) - lu(k,1981) * lu(k,2438) + lu(k,2443) = lu(k,2443) - lu(k,1982) * lu(k,2438) + lu(k,2444) = lu(k,2444) - lu(k,1983) * lu(k,2438) + lu(k,2445) = lu(k,2445) - lu(k,1984) * lu(k,2438) + lu(k,2446) = lu(k,2446) - lu(k,1985) * lu(k,2438) + lu(k,2447) = lu(k,2447) - lu(k,1986) * lu(k,2438) + lu(k,2073) = 1._r8 / lu(k,2073) + lu(k,2074) = lu(k,2074) * lu(k,2073) + lu(k,2075) = lu(k,2075) * lu(k,2073) + lu(k,2076) = lu(k,2076) * lu(k,2073) + lu(k,2077) = lu(k,2077) * lu(k,2073) + lu(k,2078) = lu(k,2078) * lu(k,2073) + lu(k,2079) = lu(k,2079) * lu(k,2073) + lu(k,2080) = lu(k,2080) * lu(k,2073) + lu(k,2081) = lu(k,2081) * lu(k,2073) + lu(k,2095) = lu(k,2095) - lu(k,2074) * lu(k,2094) + lu(k,2096) = lu(k,2096) - lu(k,2075) * lu(k,2094) + lu(k,2097) = lu(k,2097) - lu(k,2076) * lu(k,2094) + lu(k,2098) = lu(k,2098) - lu(k,2077) * lu(k,2094) + lu(k,2099) = lu(k,2099) - lu(k,2078) * lu(k,2094) + lu(k,2100) = lu(k,2100) - lu(k,2079) * lu(k,2094) + lu(k,2101) = lu(k,2101) - lu(k,2080) * lu(k,2094) + lu(k,2102) = lu(k,2102) - lu(k,2081) * lu(k,2094) + lu(k,2203) = lu(k,2203) - lu(k,2074) * lu(k,2202) + lu(k,2204) = lu(k,2204) - lu(k,2075) * lu(k,2202) + lu(k,2205) = lu(k,2205) - lu(k,2076) * lu(k,2202) + lu(k,2206) = lu(k,2206) - lu(k,2077) * lu(k,2202) + lu(k,2207) = lu(k,2207) - lu(k,2078) * lu(k,2202) + lu(k,2208) = lu(k,2208) - lu(k,2079) * lu(k,2202) + lu(k,2209) = lu(k,2209) - lu(k,2080) * lu(k,2202) + lu(k,2210) = lu(k,2210) - lu(k,2081) * lu(k,2202) + lu(k,2255) = lu(k,2255) - lu(k,2074) * lu(k,2254) + lu(k,2256) = lu(k,2256) - lu(k,2075) * lu(k,2254) + lu(k,2257) = lu(k,2257) - lu(k,2076) * lu(k,2254) + lu(k,2258) = lu(k,2258) - lu(k,2077) * lu(k,2254) + lu(k,2259) = lu(k,2259) - lu(k,2078) * lu(k,2254) + lu(k,2260) = lu(k,2260) - lu(k,2079) * lu(k,2254) + lu(k,2261) = lu(k,2261) - lu(k,2080) * lu(k,2254) + lu(k,2262) = lu(k,2262) - lu(k,2081) * lu(k,2254) + lu(k,2280) = lu(k,2280) - lu(k,2074) * lu(k,2279) + lu(k,2281) = lu(k,2281) - lu(k,2075) * lu(k,2279) + lu(k,2282) = lu(k,2282) - lu(k,2076) * lu(k,2279) + lu(k,2283) = lu(k,2283) - lu(k,2077) * lu(k,2279) + lu(k,2284) = lu(k,2284) - lu(k,2078) * lu(k,2279) + lu(k,2285) = lu(k,2285) - lu(k,2079) * lu(k,2279) + lu(k,2286) = lu(k,2286) - lu(k,2080) * lu(k,2279) + lu(k,2287) = lu(k,2287) - lu(k,2081) * lu(k,2279) + lu(k,2323) = lu(k,2323) - lu(k,2074) * lu(k,2322) + lu(k,2324) = lu(k,2324) - lu(k,2075) * lu(k,2322) + lu(k,2325) = lu(k,2325) - lu(k,2076) * lu(k,2322) + lu(k,2326) = lu(k,2326) - lu(k,2077) * lu(k,2322) + lu(k,2327) = lu(k,2327) - lu(k,2078) * lu(k,2322) + lu(k,2328) = lu(k,2328) - lu(k,2079) * lu(k,2322) + lu(k,2329) = lu(k,2329) - lu(k,2080) * lu(k,2322) + lu(k,2330) = lu(k,2330) - lu(k,2081) * lu(k,2322) + lu(k,2349) = lu(k,2349) - lu(k,2074) * lu(k,2348) + lu(k,2350) = lu(k,2350) - lu(k,2075) * lu(k,2348) + lu(k,2351) = lu(k,2351) - lu(k,2076) * lu(k,2348) + lu(k,2352) = lu(k,2352) - lu(k,2077) * lu(k,2348) + lu(k,2353) = lu(k,2353) - lu(k,2078) * lu(k,2348) + lu(k,2354) = lu(k,2354) - lu(k,2079) * lu(k,2348) + lu(k,2355) = lu(k,2355) - lu(k,2080) * lu(k,2348) + lu(k,2356) = lu(k,2356) - lu(k,2081) * lu(k,2348) + lu(k,2413) = lu(k,2413) - lu(k,2074) * lu(k,2412) + lu(k,2414) = lu(k,2414) - lu(k,2075) * lu(k,2412) + lu(k,2415) = lu(k,2415) - lu(k,2076) * lu(k,2412) + lu(k,2416) = lu(k,2416) - lu(k,2077) * lu(k,2412) + lu(k,2417) = lu(k,2417) - lu(k,2078) * lu(k,2412) + lu(k,2418) = lu(k,2418) - lu(k,2079) * lu(k,2412) + lu(k,2419) = lu(k,2419) - lu(k,2080) * lu(k,2412) + lu(k,2420) = lu(k,2420) - lu(k,2081) * lu(k,2412) + lu(k,2440) = lu(k,2440) - lu(k,2074) * lu(k,2439) + lu(k,2441) = lu(k,2441) - lu(k,2075) * lu(k,2439) + lu(k,2442) = lu(k,2442) - lu(k,2076) * lu(k,2439) + lu(k,2443) = lu(k,2443) - lu(k,2077) * lu(k,2439) + lu(k,2444) = lu(k,2444) - lu(k,2078) * lu(k,2439) + lu(k,2445) = lu(k,2445) - lu(k,2079) * lu(k,2439) + lu(k,2446) = lu(k,2446) - lu(k,2080) * lu(k,2439) + lu(k,2447) = lu(k,2447) - lu(k,2081) * lu(k,2439) + lu(k,2095) = 1._r8 / lu(k,2095) + lu(k,2096) = lu(k,2096) * lu(k,2095) + lu(k,2097) = lu(k,2097) * lu(k,2095) + lu(k,2098) = lu(k,2098) * lu(k,2095) + lu(k,2099) = lu(k,2099) * lu(k,2095) + lu(k,2100) = lu(k,2100) * lu(k,2095) + lu(k,2101) = lu(k,2101) * lu(k,2095) + lu(k,2102) = lu(k,2102) * lu(k,2095) + lu(k,2204) = lu(k,2204) - lu(k,2096) * lu(k,2203) + lu(k,2205) = lu(k,2205) - lu(k,2097) * lu(k,2203) + lu(k,2206) = lu(k,2206) - lu(k,2098) * lu(k,2203) + lu(k,2207) = lu(k,2207) - lu(k,2099) * lu(k,2203) + lu(k,2208) = lu(k,2208) - lu(k,2100) * lu(k,2203) + lu(k,2209) = lu(k,2209) - lu(k,2101) * lu(k,2203) + lu(k,2210) = lu(k,2210) - lu(k,2102) * lu(k,2203) + lu(k,2256) = lu(k,2256) - lu(k,2096) * lu(k,2255) + lu(k,2257) = lu(k,2257) - lu(k,2097) * lu(k,2255) + lu(k,2258) = lu(k,2258) - lu(k,2098) * lu(k,2255) + lu(k,2259) = lu(k,2259) - lu(k,2099) * lu(k,2255) + lu(k,2260) = lu(k,2260) - lu(k,2100) * lu(k,2255) + lu(k,2261) = lu(k,2261) - lu(k,2101) * lu(k,2255) + lu(k,2262) = lu(k,2262) - lu(k,2102) * lu(k,2255) + lu(k,2281) = lu(k,2281) - lu(k,2096) * lu(k,2280) + lu(k,2282) = lu(k,2282) - lu(k,2097) * lu(k,2280) + lu(k,2283) = lu(k,2283) - lu(k,2098) * lu(k,2280) + lu(k,2284) = lu(k,2284) - lu(k,2099) * lu(k,2280) + lu(k,2285) = lu(k,2285) - lu(k,2100) * lu(k,2280) + lu(k,2286) = lu(k,2286) - lu(k,2101) * lu(k,2280) + lu(k,2287) = lu(k,2287) - lu(k,2102) * lu(k,2280) + lu(k,2324) = lu(k,2324) - lu(k,2096) * lu(k,2323) + lu(k,2325) = lu(k,2325) - lu(k,2097) * lu(k,2323) + lu(k,2326) = lu(k,2326) - lu(k,2098) * lu(k,2323) + lu(k,2327) = lu(k,2327) - lu(k,2099) * lu(k,2323) + lu(k,2328) = lu(k,2328) - lu(k,2100) * lu(k,2323) + lu(k,2329) = lu(k,2329) - lu(k,2101) * lu(k,2323) + lu(k,2330) = lu(k,2330) - lu(k,2102) * lu(k,2323) + lu(k,2350) = lu(k,2350) - lu(k,2096) * lu(k,2349) + lu(k,2351) = lu(k,2351) - lu(k,2097) * lu(k,2349) + lu(k,2352) = lu(k,2352) - lu(k,2098) * lu(k,2349) + lu(k,2353) = lu(k,2353) - lu(k,2099) * lu(k,2349) + lu(k,2354) = lu(k,2354) - lu(k,2100) * lu(k,2349) + lu(k,2355) = lu(k,2355) - lu(k,2101) * lu(k,2349) + lu(k,2356) = lu(k,2356) - lu(k,2102) * lu(k,2349) + lu(k,2414) = lu(k,2414) - lu(k,2096) * lu(k,2413) + lu(k,2415) = lu(k,2415) - lu(k,2097) * lu(k,2413) + lu(k,2416) = lu(k,2416) - lu(k,2098) * lu(k,2413) + lu(k,2417) = lu(k,2417) - lu(k,2099) * lu(k,2413) + lu(k,2418) = lu(k,2418) - lu(k,2100) * lu(k,2413) + lu(k,2419) = lu(k,2419) - lu(k,2101) * lu(k,2413) + lu(k,2420) = lu(k,2420) - lu(k,2102) * lu(k,2413) + lu(k,2441) = lu(k,2441) - lu(k,2096) * lu(k,2440) + lu(k,2442) = lu(k,2442) - lu(k,2097) * lu(k,2440) + lu(k,2443) = lu(k,2443) - lu(k,2098) * lu(k,2440) + lu(k,2444) = lu(k,2444) - lu(k,2099) * lu(k,2440) + lu(k,2445) = lu(k,2445) - lu(k,2100) * lu(k,2440) + lu(k,2446) = lu(k,2446) - lu(k,2101) * lu(k,2440) + lu(k,2447) = lu(k,2447) - lu(k,2102) * lu(k,2440) + lu(k,2204) = 1._r8 / lu(k,2204) + lu(k,2205) = lu(k,2205) * lu(k,2204) + lu(k,2206) = lu(k,2206) * lu(k,2204) + lu(k,2207) = lu(k,2207) * lu(k,2204) + lu(k,2208) = lu(k,2208) * lu(k,2204) + lu(k,2209) = lu(k,2209) * lu(k,2204) + lu(k,2210) = lu(k,2210) * lu(k,2204) + lu(k,2257) = lu(k,2257) - lu(k,2205) * lu(k,2256) + lu(k,2258) = lu(k,2258) - lu(k,2206) * lu(k,2256) + lu(k,2259) = lu(k,2259) - lu(k,2207) * lu(k,2256) + lu(k,2260) = lu(k,2260) - lu(k,2208) * lu(k,2256) + lu(k,2261) = lu(k,2261) - lu(k,2209) * lu(k,2256) + lu(k,2262) = lu(k,2262) - lu(k,2210) * lu(k,2256) + lu(k,2282) = lu(k,2282) - lu(k,2205) * lu(k,2281) + lu(k,2283) = lu(k,2283) - lu(k,2206) * lu(k,2281) + lu(k,2284) = lu(k,2284) - lu(k,2207) * lu(k,2281) + lu(k,2285) = lu(k,2285) - lu(k,2208) * lu(k,2281) + lu(k,2286) = lu(k,2286) - lu(k,2209) * lu(k,2281) + lu(k,2287) = lu(k,2287) - lu(k,2210) * lu(k,2281) + lu(k,2325) = lu(k,2325) - lu(k,2205) * lu(k,2324) + lu(k,2326) = lu(k,2326) - lu(k,2206) * lu(k,2324) + lu(k,2327) = lu(k,2327) - lu(k,2207) * lu(k,2324) + lu(k,2328) = lu(k,2328) - lu(k,2208) * lu(k,2324) + lu(k,2329) = lu(k,2329) - lu(k,2209) * lu(k,2324) + lu(k,2330) = lu(k,2330) - lu(k,2210) * lu(k,2324) + lu(k,2351) = lu(k,2351) - lu(k,2205) * lu(k,2350) + lu(k,2352) = lu(k,2352) - lu(k,2206) * lu(k,2350) + lu(k,2353) = lu(k,2353) - lu(k,2207) * lu(k,2350) + lu(k,2354) = lu(k,2354) - lu(k,2208) * lu(k,2350) + lu(k,2355) = lu(k,2355) - lu(k,2209) * lu(k,2350) + lu(k,2356) = lu(k,2356) - lu(k,2210) * lu(k,2350) + lu(k,2415) = lu(k,2415) - lu(k,2205) * lu(k,2414) + lu(k,2416) = lu(k,2416) - lu(k,2206) * lu(k,2414) + lu(k,2417) = lu(k,2417) - lu(k,2207) * lu(k,2414) + lu(k,2418) = lu(k,2418) - lu(k,2208) * lu(k,2414) + lu(k,2419) = lu(k,2419) - lu(k,2209) * lu(k,2414) + lu(k,2420) = lu(k,2420) - lu(k,2210) * lu(k,2414) + lu(k,2442) = lu(k,2442) - lu(k,2205) * lu(k,2441) + lu(k,2443) = lu(k,2443) - lu(k,2206) * lu(k,2441) + lu(k,2444) = lu(k,2444) - lu(k,2207) * lu(k,2441) + lu(k,2445) = lu(k,2445) - lu(k,2208) * lu(k,2441) + lu(k,2446) = lu(k,2446) - lu(k,2209) * lu(k,2441) + lu(k,2447) = lu(k,2447) - lu(k,2210) * lu(k,2441) + end do + end subroutine lu_fac32 + subroutine lu_fac33( 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,2257) = 1._r8 / lu(k,2257) + lu(k,2258) = lu(k,2258) * lu(k,2257) + lu(k,2259) = lu(k,2259) * lu(k,2257) + lu(k,2260) = lu(k,2260) * lu(k,2257) + lu(k,2261) = lu(k,2261) * lu(k,2257) + lu(k,2262) = lu(k,2262) * lu(k,2257) + lu(k,2283) = lu(k,2283) - lu(k,2258) * lu(k,2282) + lu(k,2284) = lu(k,2284) - lu(k,2259) * lu(k,2282) + lu(k,2285) = lu(k,2285) - lu(k,2260) * lu(k,2282) + lu(k,2286) = lu(k,2286) - lu(k,2261) * lu(k,2282) + lu(k,2287) = lu(k,2287) - lu(k,2262) * lu(k,2282) + lu(k,2326) = lu(k,2326) - lu(k,2258) * lu(k,2325) + lu(k,2327) = lu(k,2327) - lu(k,2259) * lu(k,2325) + lu(k,2328) = lu(k,2328) - lu(k,2260) * lu(k,2325) + lu(k,2329) = lu(k,2329) - lu(k,2261) * lu(k,2325) + lu(k,2330) = lu(k,2330) - lu(k,2262) * lu(k,2325) + lu(k,2352) = lu(k,2352) - lu(k,2258) * lu(k,2351) + lu(k,2353) = lu(k,2353) - lu(k,2259) * lu(k,2351) + lu(k,2354) = lu(k,2354) - lu(k,2260) * lu(k,2351) + lu(k,2355) = lu(k,2355) - lu(k,2261) * lu(k,2351) + lu(k,2356) = lu(k,2356) - lu(k,2262) * lu(k,2351) + lu(k,2416) = lu(k,2416) - lu(k,2258) * lu(k,2415) + lu(k,2417) = lu(k,2417) - lu(k,2259) * lu(k,2415) + lu(k,2418) = lu(k,2418) - lu(k,2260) * lu(k,2415) + lu(k,2419) = lu(k,2419) - lu(k,2261) * lu(k,2415) + lu(k,2420) = lu(k,2420) - lu(k,2262) * lu(k,2415) + lu(k,2443) = lu(k,2443) - lu(k,2258) * lu(k,2442) + lu(k,2444) = lu(k,2444) - lu(k,2259) * lu(k,2442) + lu(k,2445) = lu(k,2445) - lu(k,2260) * lu(k,2442) + lu(k,2446) = lu(k,2446) - lu(k,2261) * lu(k,2442) + lu(k,2447) = lu(k,2447) - lu(k,2262) * lu(k,2442) + lu(k,2283) = 1._r8 / lu(k,2283) + lu(k,2284) = lu(k,2284) * lu(k,2283) + lu(k,2285) = lu(k,2285) * lu(k,2283) + lu(k,2286) = lu(k,2286) * lu(k,2283) + lu(k,2287) = lu(k,2287) * lu(k,2283) + lu(k,2327) = lu(k,2327) - lu(k,2284) * lu(k,2326) + lu(k,2328) = lu(k,2328) - lu(k,2285) * lu(k,2326) + lu(k,2329) = lu(k,2329) - lu(k,2286) * lu(k,2326) + lu(k,2330) = lu(k,2330) - lu(k,2287) * lu(k,2326) + lu(k,2353) = lu(k,2353) - lu(k,2284) * lu(k,2352) + lu(k,2354) = lu(k,2354) - lu(k,2285) * lu(k,2352) + lu(k,2355) = lu(k,2355) - lu(k,2286) * lu(k,2352) + lu(k,2356) = lu(k,2356) - lu(k,2287) * lu(k,2352) + lu(k,2417) = lu(k,2417) - lu(k,2284) * lu(k,2416) + lu(k,2418) = lu(k,2418) - lu(k,2285) * lu(k,2416) + lu(k,2419) = lu(k,2419) - lu(k,2286) * lu(k,2416) + lu(k,2420) = lu(k,2420) - lu(k,2287) * lu(k,2416) + lu(k,2444) = lu(k,2444) - lu(k,2284) * lu(k,2443) + lu(k,2445) = lu(k,2445) - lu(k,2285) * lu(k,2443) + lu(k,2446) = lu(k,2446) - lu(k,2286) * lu(k,2443) + lu(k,2447) = lu(k,2447) - lu(k,2287) * lu(k,2443) + lu(k,2327) = 1._r8 / lu(k,2327) + lu(k,2328) = lu(k,2328) * lu(k,2327) + lu(k,2329) = lu(k,2329) * lu(k,2327) + lu(k,2330) = lu(k,2330) * lu(k,2327) + lu(k,2354) = lu(k,2354) - lu(k,2328) * lu(k,2353) + lu(k,2355) = lu(k,2355) - lu(k,2329) * lu(k,2353) + lu(k,2356) = lu(k,2356) - lu(k,2330) * lu(k,2353) + lu(k,2418) = lu(k,2418) - lu(k,2328) * lu(k,2417) + lu(k,2419) = lu(k,2419) - lu(k,2329) * lu(k,2417) + lu(k,2420) = lu(k,2420) - lu(k,2330) * lu(k,2417) + lu(k,2445) = lu(k,2445) - lu(k,2328) * lu(k,2444) + lu(k,2446) = lu(k,2446) - lu(k,2329) * lu(k,2444) + lu(k,2447) = lu(k,2447) - lu(k,2330) * lu(k,2444) + lu(k,2354) = 1._r8 / lu(k,2354) + lu(k,2355) = lu(k,2355) * lu(k,2354) + lu(k,2356) = lu(k,2356) * lu(k,2354) + lu(k,2419) = lu(k,2419) - lu(k,2355) * lu(k,2418) + lu(k,2420) = lu(k,2420) - lu(k,2356) * lu(k,2418) + lu(k,2446) = lu(k,2446) - lu(k,2355) * lu(k,2445) + lu(k,2447) = lu(k,2447) - lu(k,2356) * lu(k,2445) + lu(k,2419) = 1._r8 / lu(k,2419) + lu(k,2420) = lu(k,2420) * lu(k,2419) + lu(k,2447) = lu(k,2447) - lu(k,2420) * lu(k,2446) + lu(k,2447) = 1._r8 / lu(k,2447) + end do + end subroutine lu_fac33 subroutine lu_fac( avec_len, lu ) use chem_mods, only : nzcnt use shr_kind_mod, only : r8 => shr_kind_r8 @@ -7988,5 +8898,8 @@ subroutine lu_fac( avec_len, lu ) call lu_fac28( avec_len, lu ) call lu_fac29( avec_len, lu ) call lu_fac30( avec_len, lu ) + call lu_fac31( avec_len, lu ) + call lu_fac32( avec_len, lu ) + call lu_fac33( avec_len, lu ) end subroutine lu_fac end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 index 8af64dbcbd..84fa5321f2 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_lu_solve.F90 @@ -21,211 +21,212 @@ subroutine lu_slv01( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,188) = b(k,188) - lu(k,47) * b(k,36) - b(k,200) = b(k,200) - lu(k,48) * b(k,36) - b(k,190) = b(k,190) - lu(k,50) * b(k,37) - b(k,201) = b(k,201) - lu(k,51) * b(k,37) - b(k,190) = b(k,190) - lu(k,53) * b(k,38) - b(k,199) = b(k,199) - lu(k,54) * b(k,38) - b(k,143) = b(k,143) - lu(k,56) * b(k,39) - b(k,190) = b(k,190) - lu(k,57) * b(k,39) - b(k,201) = b(k,201) - lu(k,58) * b(k,39) - b(k,136) = b(k,136) - lu(k,60) * b(k,40) - b(k,189) = b(k,189) - lu(k,61) * b(k,40) - b(k,96) = b(k,96) - lu(k,63) * b(k,41) - b(k,190) = b(k,190) - lu(k,64) * b(k,41) - b(k,65) = b(k,65) - lu(k,66) * b(k,42) - b(k,201) = b(k,201) - lu(k,67) * b(k,42) - b(k,171) = b(k,171) - lu(k,69) * b(k,43) - b(k,190) = b(k,190) - lu(k,70) * b(k,43) - b(k,104) = b(k,104) - lu(k,72) * b(k,44) - b(k,197) = b(k,197) - lu(k,73) * b(k,44) - b(k,186) = b(k,186) - lu(k,75) * b(k,45) - b(k,186) = b(k,186) - lu(k,78) * b(k,46) - b(k,188) = b(k,188) - lu(k,80) * b(k,47) - b(k,49) = b(k,49) - lu(k,87) * b(k,48) - b(k,50) = b(k,50) - lu(k,88) * b(k,48) - b(k,101) = b(k,101) - lu(k,89) * b(k,48) - b(k,190) = b(k,190) - lu(k,90) * b(k,48) - b(k,199) = b(k,199) - lu(k,91) * b(k,48) - b(k,95) = b(k,95) - lu(k,93) * b(k,49) - b(k,165) = b(k,165) - lu(k,94) * b(k,49) - b(k,199) = b(k,199) - lu(k,95) * b(k,49) - b(k,94) = b(k,94) - lu(k,97) * b(k,50) - b(k,98) = b(k,98) - lu(k,98) * b(k,50) - b(k,190) = b(k,190) - lu(k,99) * b(k,50) - b(k,199) = b(k,199) - lu(k,100) * b(k,50) - b(k,136) = b(k,136) - lu(k,102) * b(k,51) - b(k,188) = b(k,188) - lu(k,103) * b(k,51) - b(k,189) = b(k,189) - lu(k,104) * b(k,51) - b(k,189) = b(k,189) - lu(k,106) * b(k,52) - b(k,190) = b(k,190) - lu(k,107) * b(k,52) - b(k,199) = b(k,199) - lu(k,108) * b(k,52) - b(k,54) = b(k,54) - lu(k,115) * b(k,53) - b(k,55) = b(k,55) - lu(k,116) * b(k,53) - b(k,92) = b(k,92) - lu(k,117) * b(k,53) - b(k,131) = b(k,131) - lu(k,118) * b(k,53) - b(k,190) = b(k,190) - lu(k,119) * b(k,53) - b(k,199) = b(k,199) - lu(k,120) * b(k,53) - b(k,94) = b(k,94) - lu(k,122) * b(k,54) - b(k,98) = b(k,98) - lu(k,123) * b(k,54) - b(k,190) = b(k,190) - lu(k,124) * b(k,54) - b(k,199) = b(k,199) - lu(k,125) * b(k,54) - b(k,165) = b(k,165) - lu(k,127) * b(k,55) - b(k,181) = b(k,181) - lu(k,128) * b(k,55) - b(k,199) = b(k,199) - lu(k,129) * b(k,55) - b(k,171) = b(k,171) - lu(k,131) * b(k,56) - b(k,190) = b(k,190) - lu(k,132) * b(k,56) - b(k,58) = b(k,58) - lu(k,140) * b(k,57) - b(k,92) = b(k,92) - lu(k,141) * b(k,57) - b(k,132) = b(k,132) - lu(k,142) * b(k,57) - b(k,165) = b(k,165) - lu(k,143) * b(k,57) - b(k,181) = b(k,181) - lu(k,144) * b(k,57) - b(k,190) = b(k,190) - lu(k,145) * b(k,57) - b(k,199) = b(k,199) - lu(k,146) * b(k,57) - b(k,98) = b(k,98) - lu(k,148) * b(k,58) - b(k,103) = b(k,103) - lu(k,149) * b(k,58) - b(k,190) = b(k,190) - lu(k,150) * b(k,58) - b(k,199) = b(k,199) - lu(k,151) * b(k,58) - b(k,136) = b(k,136) - lu(k,153) * b(k,59) - b(k,195) = b(k,195) - lu(k,154) * b(k,59) - b(k,118) = b(k,118) - lu(k,156) * b(k,60) - b(k,171) = b(k,171) - lu(k,157) * b(k,60) - b(k,190) = b(k,190) - lu(k,158) * b(k,60) - b(k,199) = b(k,199) - lu(k,159) * b(k,60) - b(k,196) = b(k,196) - lu(k,161) * b(k,61) - b(k,197) = b(k,197) - lu(k,162) * b(k,61) - b(k,154) = b(k,154) - lu(k,164) * b(k,62) - b(k,190) = b(k,190) - lu(k,165) * b(k,62) - b(k,184) = b(k,184) - lu(k,167) * b(k,63) - b(k,188) = b(k,188) - lu(k,168) * b(k,63) - b(k,104) = b(k,104) - lu(k,170) * b(k,64) - b(k,190) = b(k,190) - lu(k,171) * b(k,64) - b(k,155) = b(k,155) - lu(k,174) * b(k,65) - b(k,192) = b(k,192) - lu(k,175) * b(k,65) - b(k,201) = b(k,201) - lu(k,176) * b(k,65) - b(k,170) = b(k,170) - lu(k,178) * b(k,66) - b(k,190) = b(k,190) - lu(k,179) * b(k,66) - b(k,199) = b(k,199) - lu(k,180) * b(k,66) - b(k,98) = b(k,98) - lu(k,182) * b(k,67) - b(k,122) = b(k,122) - lu(k,183) * b(k,67) - b(k,190) = b(k,190) - lu(k,184) * b(k,67) - b(k,187) = b(k,187) - lu(k,186) * b(k,68) - b(k,192) = b(k,192) - lu(k,187) * b(k,68) - b(k,194) = b(k,194) - lu(k,188) * b(k,68) - b(k,196) = b(k,196) - lu(k,189) * b(k,68) - b(k,197) = b(k,197) - lu(k,190) * b(k,68) - b(k,155) = b(k,155) - lu(k,192) * b(k,69) - b(k,190) = b(k,190) - lu(k,193) * b(k,69) - b(k,194) = b(k,194) - lu(k,194) * b(k,69) - b(k,196) = b(k,196) - lu(k,195) * b(k,69) - b(k,199) = b(k,199) - lu(k,196) * b(k,69) - b(k,133) = b(k,133) - lu(k,198) * b(k,70) - b(k,199) = b(k,199) - lu(k,199) * b(k,70) - b(k,141) = b(k,141) - lu(k,201) * b(k,71) - b(k,149) = b(k,149) - lu(k,202) * b(k,71) - b(k,165) = b(k,165) - lu(k,203) * b(k,71) - b(k,190) = b(k,190) - lu(k,204) * b(k,71) - b(k,199) = b(k,199) - lu(k,205) * b(k,71) - b(k,152) = b(k,152) - lu(k,207) * b(k,72) - b(k,183) = b(k,183) - lu(k,208) * b(k,72) - b(k,188) = b(k,188) - lu(k,209) * b(k,72) - b(k,190) = b(k,190) - lu(k,210) * b(k,72) - b(k,201) = b(k,201) - lu(k,211) * b(k,72) - b(k,171) = b(k,171) - lu(k,213) * b(k,73) - b(k,190) = b(k,190) - lu(k,214) * b(k,73) - b(k,178) = b(k,178) - lu(k,216) * b(k,74) - b(k,180) = b(k,180) - lu(k,217) * b(k,74) - b(k,190) = b(k,190) - lu(k,218) * b(k,74) - b(k,199) = b(k,199) - lu(k,219) * b(k,74) - b(k,125) = b(k,125) - lu(k,221) * b(k,75) - b(k,170) = b(k,170) - lu(k,222) * b(k,75) - b(k,181) = b(k,181) - lu(k,223) * b(k,75) - b(k,190) = b(k,190) - lu(k,224) * b(k,75) - b(k,165) = b(k,165) - lu(k,226) * b(k,76) - b(k,175) = b(k,175) - lu(k,227) * b(k,76) - b(k,181) = b(k,181) - lu(k,228) * b(k,76) - b(k,199) = b(k,199) - lu(k,229) * b(k,76) - b(k,155) = b(k,155) - lu(k,231) * b(k,77) - b(k,182) = b(k,182) - lu(k,232) * b(k,77) - b(k,192) = b(k,192) - lu(k,233) * b(k,77) - b(k,200) = b(k,200) - lu(k,234) * b(k,77) - b(k,94) = b(k,94) - lu(k,236) * b(k,78) - b(k,149) = b(k,149) - lu(k,237) * b(k,78) - b(k,190) = b(k,190) - lu(k,238) * b(k,78) - b(k,199) = b(k,199) - lu(k,239) * b(k,78) - b(k,92) = b(k,92) - lu(k,242) * b(k,79) - b(k,104) = b(k,104) - lu(k,243) * b(k,79) - b(k,190) = b(k,190) - lu(k,244) * b(k,79) - b(k,199) = b(k,199) - lu(k,245) * b(k,79) - b(k,152) = b(k,152) - lu(k,247) * b(k,80) - b(k,170) = b(k,170) - lu(k,248) * b(k,80) - b(k,190) = b(k,190) - lu(k,249) * b(k,80) - b(k,199) = b(k,199) - lu(k,250) * b(k,80) - b(k,129) = b(k,129) - lu(k,252) * b(k,81) - b(k,155) = b(k,155) - lu(k,253) * b(k,81) - b(k,165) = b(k,165) - lu(k,254) * b(k,81) - b(k,182) = b(k,182) - lu(k,255) * b(k,81) - b(k,190) = b(k,190) - lu(k,256) * b(k,81) - b(k,192) = b(k,192) - lu(k,257) * b(k,81) - b(k,195) = b(k,195) - lu(k,258) * b(k,81) - b(k,113) = b(k,113) - lu(k,260) * b(k,82) - b(k,156) = b(k,156) - lu(k,261) * b(k,82) - b(k,170) = b(k,170) - lu(k,262) * b(k,82) - b(k,190) = b(k,190) - lu(k,263) * b(k,82) - b(k,193) = b(k,193) - lu(k,264) * b(k,82) - b(k,194) = b(k,194) - lu(k,265) * b(k,82) - b(k,197) = b(k,197) - lu(k,266) * b(k,82) - b(k,147) = b(k,147) - lu(k,268) * b(k,83) - b(k,161) = b(k,161) - lu(k,269) * b(k,83) - b(k,190) = b(k,190) - lu(k,270) * b(k,83) - b(k,196) = b(k,196) - lu(k,271) * b(k,83) - b(k,199) = b(k,199) - lu(k,272) * b(k,83) - b(k,95) = b(k,95) - lu(k,274) * b(k,84) - b(k,101) = b(k,101) - lu(k,275) * b(k,84) - b(k,149) = b(k,149) - lu(k,276) * b(k,84) - b(k,190) = b(k,190) - lu(k,277) * b(k,84) - b(k,199) = b(k,199) - lu(k,278) * b(k,84) - b(k,149) = b(k,149) - lu(k,280) * b(k,85) - b(k,165) = b(k,165) - lu(k,281) * b(k,85) - b(k,175) = b(k,175) - lu(k,282) * b(k,85) - b(k,181) = b(k,181) - lu(k,283) * b(k,85) - b(k,199) = b(k,199) - lu(k,284) * b(k,85) - b(k,158) = b(k,158) - lu(k,286) * b(k,86) - b(k,168) = b(k,168) - lu(k,287) * b(k,86) - b(k,190) = b(k,190) - lu(k,288) * b(k,86) - b(k,196) = b(k,196) - lu(k,289) * b(k,86) - b(k,197) = b(k,197) - lu(k,290) * b(k,86) - b(k,169) = b(k,169) - lu(k,292) * b(k,87) - b(k,181) = b(k,181) - lu(k,293) * b(k,87) - b(k,190) = b(k,190) - lu(k,294) * b(k,87) - b(k,193) = b(k,193) - lu(k,295) * b(k,87) - b(k,201) = b(k,201) - lu(k,296) * b(k,87) - b(k,127) = b(k,127) - lu(k,298) * b(k,88) - b(k,147) = b(k,147) - lu(k,299) * b(k,88) - b(k,190) = b(k,190) - lu(k,300) * b(k,88) - b(k,197) = b(k,197) - lu(k,301) * b(k,88) - b(k,199) = b(k,199) - lu(k,302) * b(k,88) - b(k,143) = b(k,143) - lu(k,304) * b(k,89) - b(k,156) = b(k,156) - lu(k,305) * b(k,89) - b(k,190) = b(k,190) - lu(k,306) * b(k,89) - b(k,199) = b(k,199) - lu(k,307) * b(k,89) - b(k,201) = b(k,201) - lu(k,308) * b(k,89) - b(k,185) = b(k,185) - lu(k,310) * b(k,90) - b(k,190) = b(k,190) - lu(k,311) * b(k,90) - b(k,193) = b(k,193) - lu(k,312) * b(k,90) - b(k,195) = b(k,195) - lu(k,313) * b(k,90) - b(k,201) = b(k,201) - lu(k,314) * b(k,90) - b(k,103) = b(k,103) - lu(k,316) * b(k,91) - b(k,149) = b(k,149) - lu(k,317) * b(k,91) - b(k,175) = b(k,175) - lu(k,318) * b(k,91) - b(k,190) = b(k,190) - lu(k,319) * b(k,91) - b(k,199) = b(k,199) - lu(k,320) * b(k,91) - b(k,104) = b(k,104) - lu(k,324) * b(k,92) - b(k,187) = b(k,187) - lu(k,325) * b(k,92) - b(k,190) = b(k,190) - lu(k,326) * b(k,92) - b(k,197) = b(k,197) - lu(k,327) * b(k,92) - b(k,199) = b(k,199) - lu(k,328) * b(k,92) + b(k,222) = b(k,222) - lu(k,94) * b(k,52) + b(k,227) = b(k,227) - lu(k,95) * b(k,52) + b(k,224) = b(k,224) - lu(k,97) * b(k,53) + b(k,237) = b(k,237) - lu(k,98) * b(k,53) + b(k,223) = b(k,223) - lu(k,100) * b(k,54) + b(k,227) = b(k,227) - lu(k,101) * b(k,54) + b(k,224) = b(k,224) - lu(k,103) * b(k,55) + b(k,231) = b(k,231) - lu(k,104) * b(k,55) + b(k,88) = b(k,88) - lu(k,106) * b(k,56) + b(k,219) = b(k,219) - lu(k,107) * b(k,56) + b(k,223) = b(k,223) - lu(k,108) * b(k,56) + b(k,83) = b(k,83) - lu(k,110) * b(k,57) + b(k,223) = b(k,223) - lu(k,111) * b(k,57) + b(k,227) = b(k,227) - lu(k,112) * b(k,57) + b(k,88) = b(k,88) - lu(k,114) * b(k,58) + b(k,223) = b(k,223) - lu(k,115) * b(k,58) + b(k,227) = b(k,227) - lu(k,116) * b(k,58) + b(k,88) = b(k,88) - lu(k,118) * b(k,59) + b(k,223) = b(k,223) - lu(k,119) * b(k,59) + b(k,227) = b(k,227) - lu(k,120) * b(k,59) + b(k,224) = b(k,224) - lu(k,122) * b(k,60) + b(k,227) = b(k,227) - lu(k,123) * b(k,60) + b(k,237) = b(k,237) - lu(k,124) * b(k,60) + b(k,128) = b(k,128) - lu(k,126) * b(k,61) + b(k,224) = b(k,224) - lu(k,127) * b(k,61) + b(k,92) = b(k,92) - lu(k,129) * b(k,62) + b(k,237) = b(k,237) - lu(k,130) * b(k,62) + b(k,205) = b(k,205) - lu(k,132) * b(k,63) + b(k,224) = b(k,224) - lu(k,133) * b(k,63) + b(k,137) = b(k,137) - lu(k,135) * b(k,64) + b(k,225) = b(k,225) - lu(k,136) * b(k,64) + b(k,88) = b(k,88) - lu(k,138) * b(k,65) + b(k,219) = b(k,219) - lu(k,139) * b(k,65) + b(k,223) = b(k,223) - lu(k,140) * b(k,65) + b(k,227) = b(k,227) - lu(k,141) * b(k,65) + b(k,88) = b(k,88) - lu(k,143) * b(k,66) + b(k,182) = b(k,182) - lu(k,144) * b(k,66) + b(k,219) = b(k,219) - lu(k,145) * b(k,66) + b(k,223) = b(k,223) - lu(k,146) * b(k,66) + b(k,83) = b(k,83) - lu(k,148) * b(k,67) + b(k,88) = b(k,88) - lu(k,149) * b(k,67) + b(k,223) = b(k,223) - lu(k,150) * b(k,67) + b(k,227) = b(k,227) - lu(k,151) * b(k,67) + b(k,88) = b(k,88) - lu(k,153) * b(k,68) + b(k,182) = b(k,182) - lu(k,154) * b(k,68) + b(k,223) = b(k,223) - lu(k,155) * b(k,68) + b(k,227) = b(k,227) - lu(k,156) * b(k,68) + b(k,70) = b(k,70) - lu(k,159) * b(k,69) + b(k,71) = b(k,71) - lu(k,160) * b(k,69) + b(k,132) = b(k,132) - lu(k,161) * b(k,69) + b(k,224) = b(k,224) - lu(k,162) * b(k,69) + b(k,231) = b(k,231) - lu(k,163) * b(k,69) + b(k,127) = b(k,127) - lu(k,165) * b(k,70) + b(k,199) = b(k,199) - lu(k,166) * b(k,70) + b(k,231) = b(k,231) - lu(k,167) * b(k,70) + b(k,126) = b(k,126) - lu(k,169) * b(k,71) + b(k,129) = b(k,129) - lu(k,170) * b(k,71) + b(k,224) = b(k,224) - lu(k,171) * b(k,71) + b(k,231) = b(k,231) - lu(k,172) * b(k,71) + b(k,227) = b(k,227) - lu(k,174) * b(k,72) + b(k,220) = b(k,220) - lu(k,176) * b(k,73) + b(k,220) = b(k,220) - lu(k,179) * b(k,74) + b(k,223) = b(k,223) - lu(k,181) * b(k,75) + b(k,224) = b(k,224) - lu(k,182) * b(k,75) + b(k,231) = b(k,231) - lu(k,183) * b(k,75) + b(k,77) = b(k,77) - lu(k,186) * b(k,76) + b(k,78) = b(k,78) - lu(k,187) * b(k,76) + b(k,123) = b(k,123) - lu(k,188) * b(k,76) + b(k,164) = b(k,164) - lu(k,189) * b(k,76) + b(k,224) = b(k,224) - lu(k,190) * b(k,76) + b(k,231) = b(k,231) - lu(k,191) * b(k,76) + b(k,126) = b(k,126) - lu(k,193) * b(k,77) + b(k,129) = b(k,129) - lu(k,194) * b(k,77) + b(k,224) = b(k,224) - lu(k,195) * b(k,77) + b(k,231) = b(k,231) - lu(k,196) * b(k,77) + b(k,199) = b(k,199) - lu(k,198) * b(k,78) + b(k,214) = b(k,214) - lu(k,199) * b(k,78) + b(k,231) = b(k,231) - lu(k,200) * b(k,78) + b(k,205) = b(k,205) - lu(k,202) * b(k,79) + b(k,224) = b(k,224) - lu(k,203) * b(k,79) + b(k,81) = b(k,81) - lu(k,207) * b(k,80) + b(k,123) = b(k,123) - lu(k,208) * b(k,80) + b(k,165) = b(k,165) - lu(k,209) * b(k,80) + b(k,199) = b(k,199) - lu(k,210) * b(k,80) + b(k,214) = b(k,214) - lu(k,211) * b(k,80) + b(k,224) = b(k,224) - lu(k,212) * b(k,80) + b(k,231) = b(k,231) - lu(k,213) * b(k,80) + b(k,129) = b(k,129) - lu(k,215) * b(k,81) + b(k,135) = b(k,135) - lu(k,216) * b(k,81) + b(k,224) = b(k,224) - lu(k,217) * b(k,81) + b(k,231) = b(k,231) - lu(k,218) * b(k,81) + b(k,83) = b(k,83) - lu(k,220) * b(k,82) + b(k,223) = b(k,223) - lu(k,221) * b(k,82) + b(k,224) = b(k,224) - lu(k,222) * b(k,82) + b(k,227) = b(k,227) - lu(k,223) * b(k,82) + b(k,182) = b(k,182) - lu(k,225) * b(k,83) + b(k,223) = b(k,223) - lu(k,226) * b(k,83) + b(k,227) = b(k,227) - lu(k,227) * b(k,83) + b(k,147) = b(k,147) - lu(k,229) * b(k,84) + b(k,205) = b(k,205) - lu(k,230) * b(k,84) + b(k,224) = b(k,224) - lu(k,231) * b(k,84) + b(k,231) = b(k,231) - lu(k,232) * b(k,84) + b(k,189) = b(k,189) - lu(k,234) * b(k,85) + b(k,224) = b(k,224) - lu(k,235) * b(k,85) + b(k,219) = b(k,219) - lu(k,237) * b(k,86) + b(k,227) = b(k,227) - lu(k,238) * b(k,86) + b(k,225) = b(k,225) - lu(k,240) * b(k,87) + b(k,228) = b(k,228) - lu(k,241) * b(k,87) + b(k,182) = b(k,182) - lu(k,243) * b(k,88) + b(k,223) = b(k,223) - lu(k,244) * b(k,88) + b(k,137) = b(k,137) - lu(k,246) * b(k,89) + b(k,224) = b(k,224) - lu(k,247) * b(k,89) + b(k,182) = b(k,182) - lu(k,250) * b(k,90) + b(k,223) = b(k,223) - lu(k,251) * b(k,90) + b(k,224) = b(k,224) - lu(k,252) * b(k,90) + b(k,227) = b(k,227) - lu(k,253) * b(k,90) + b(k,220) = b(k,220) - lu(k,255) * b(k,91) + b(k,223) = b(k,223) - lu(k,256) * b(k,91) + b(k,229) = b(k,229) - lu(k,257) * b(k,91) + b(k,184) = b(k,184) - lu(k,260) * b(k,92) + b(k,234) = b(k,234) - lu(k,261) * b(k,92) + b(k,237) = b(k,237) - lu(k,262) * b(k,92) + b(k,198) = b(k,198) - lu(k,264) * b(k,93) + b(k,224) = b(k,224) - lu(k,265) * b(k,93) + b(k,231) = b(k,231) - lu(k,266) * b(k,93) + b(k,129) = b(k,129) - lu(k,268) * b(k,94) + b(k,152) = b(k,152) - lu(k,269) * b(k,94) + b(k,224) = b(k,224) - lu(k,270) * b(k,94) + b(k,182) = b(k,182) - lu(k,273) * b(k,95) + b(k,223) = b(k,223) - lu(k,274) * b(k,95) + b(k,224) = b(k,224) - lu(k,275) * b(k,95) + b(k,227) = b(k,227) - lu(k,276) * b(k,95) + b(k,237) = b(k,237) - lu(k,277) * b(k,95) + b(k,225) = b(k,225) - lu(k,279) * b(k,96) + b(k,226) = b(k,226) - lu(k,280) * b(k,96) + b(k,228) = b(k,228) - lu(k,281) * b(k,96) + b(k,229) = b(k,229) - lu(k,282) * b(k,96) + b(k,234) = b(k,234) - lu(k,283) * b(k,96) + b(k,166) = b(k,166) - lu(k,285) * b(k,97) + b(k,231) = b(k,231) - lu(k,286) * b(k,97) + b(k,182) = b(k,182) - lu(k,288) * b(k,98) + b(k,230) = b(k,230) - lu(k,289) * b(k,98) + b(k,180) = b(k,180) - lu(k,291) * b(k,99) + b(k,190) = b(k,190) - lu(k,292) * b(k,99) + b(k,199) = b(k,199) - lu(k,293) * b(k,99) + b(k,224) = b(k,224) - lu(k,294) * b(k,99) + b(k,231) = b(k,231) - lu(k,295) * b(k,99) + b(k,179) = b(k,179) - lu(k,297) * b(k,100) + b(k,218) = b(k,218) - lu(k,298) * b(k,100) + b(k,224) = b(k,224) - lu(k,299) * b(k,100) + b(k,227) = b(k,227) - lu(k,300) * b(k,100) + b(k,237) = b(k,237) - lu(k,301) * b(k,100) + b(k,183) = b(k,183) - lu(k,303) * b(k,101) + b(k,218) = b(k,218) - lu(k,304) * b(k,101) + b(k,224) = b(k,224) - lu(k,305) * b(k,101) + b(k,227) = b(k,227) - lu(k,306) * b(k,101) + b(k,237) = b(k,237) - lu(k,307) * b(k,101) + b(k,184) = b(k,184) - lu(k,309) * b(k,102) + b(k,224) = b(k,224) - lu(k,310) * b(k,102) + b(k,226) = b(k,226) - lu(k,311) * b(k,102) + b(k,228) = b(k,228) - lu(k,312) * b(k,102) + b(k,231) = b(k,231) - lu(k,313) * b(k,102) + b(k,211) = b(k,211) - lu(k,315) * b(k,103) + b(k,213) = b(k,213) - lu(k,316) * b(k,103) + b(k,224) = b(k,224) - lu(k,317) * b(k,103) + b(k,231) = b(k,231) - lu(k,318) * b(k,103) + b(k,158) = b(k,158) - lu(k,320) * b(k,104) + b(k,198) = b(k,198) - lu(k,321) * b(k,104) + b(k,214) = b(k,214) - lu(k,322) * b(k,104) + b(k,224) = b(k,224) - lu(k,323) * b(k,104) + b(k,205) = b(k,205) - lu(k,325) * b(k,105) + b(k,224) = b(k,224) - lu(k,326) * b(k,105) + b(k,199) = b(k,199) - lu(k,328) * b(k,106) + b(k,208) = b(k,208) - lu(k,329) * b(k,106) + b(k,214) = b(k,214) - lu(k,330) * b(k,106) + b(k,231) = b(k,231) - lu(k,331) * b(k,106) + b(k,184) = b(k,184) - lu(k,333) * b(k,107) + b(k,217) = b(k,217) - lu(k,334) * b(k,107) + b(k,222) = b(k,222) - lu(k,335) * b(k,107) + b(k,234) = b(k,234) - lu(k,336) * b(k,107) + b(k,126) = b(k,126) - lu(k,338) * b(k,108) + b(k,190) = b(k,190) - lu(k,339) * b(k,108) + b(k,224) = b(k,224) - lu(k,340) * b(k,108) + b(k,231) = b(k,231) - lu(k,341) * b(k,108) + b(k,123) = b(k,123) - lu(k,344) * b(k,109) + b(k,137) = b(k,137) - lu(k,345) * b(k,109) + b(k,224) = b(k,224) - lu(k,346) * b(k,109) + b(k,231) = b(k,231) - lu(k,347) * b(k,109) + b(k,179) = b(k,179) - lu(k,349) * b(k,110) + b(k,198) = b(k,198) - lu(k,350) * b(k,110) + b(k,224) = b(k,224) - lu(k,351) * b(k,110) + b(k,231) = b(k,231) - lu(k,352) * b(k,110) + b(k,144) = b(k,144) - lu(k,354) * b(k,111) + b(k,193) = b(k,193) - lu(k,355) * b(k,111) + b(k,198) = b(k,198) - lu(k,356) * b(k,111) + b(k,224) = b(k,224) - lu(k,357) * b(k,111) + b(k,225) = b(k,225) - lu(k,358) * b(k,111) + b(k,226) = b(k,226) - lu(k,359) * b(k,111) + b(k,235) = b(k,235) - lu(k,360) * b(k,111) + b(k,160) = b(k,160) - lu(k,362) * b(k,112) + b(k,184) = b(k,184) - lu(k,363) * b(k,112) + b(k,199) = b(k,199) - lu(k,364) * b(k,112) + b(k,217) = b(k,217) - lu(k,365) * b(k,112) + b(k,224) = b(k,224) - lu(k,366) * b(k,112) + b(k,230) = b(k,230) - lu(k,367) * b(k,112) + b(k,234) = b(k,234) - lu(k,368) * b(k,112) end do end subroutine lu_slv01 subroutine lu_slv02( avec_len, lu, b ) @@ -246,212 +247,211 @@ subroutine lu_slv02( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,141) = b(k,141) - lu(k,330) * b(k,93) - b(k,187) = b(k,187) - lu(k,331) * b(k,93) - b(k,193) = b(k,193) - lu(k,332) * b(k,93) - b(k,197) = b(k,197) - lu(k,333) * b(k,93) - b(k,199) = b(k,199) - lu(k,334) * b(k,93) - b(k,149) = b(k,149) - lu(k,337) * b(k,94) - b(k,187) = b(k,187) - lu(k,338) * b(k,94) - b(k,190) = b(k,190) - lu(k,339) * b(k,94) - b(k,197) = b(k,197) - lu(k,340) * b(k,94) - b(k,199) = b(k,199) - lu(k,341) * b(k,94) - b(k,130) = b(k,130) - lu(k,343) * b(k,95) - b(k,199) = b(k,199) - lu(k,344) * b(k,95) - b(k,161) = b(k,161) - lu(k,346) * b(k,96) - b(k,186) = b(k,186) - lu(k,347) * b(k,96) - b(k,193) = b(k,193) - lu(k,348) * b(k,96) - b(k,199) = b(k,199) - lu(k,349) * b(k,96) - b(k,181) = b(k,181) - lu(k,351) * b(k,97) - b(k,185) = b(k,185) - lu(k,352) * b(k,97) - b(k,190) = b(k,190) - lu(k,353) * b(k,97) - b(k,193) = b(k,193) - lu(k,354) * b(k,97) - b(k,194) = b(k,194) - lu(k,355) * b(k,97) - b(k,197) = b(k,197) - lu(k,356) * b(k,97) - b(k,122) = b(k,122) - lu(k,358) * b(k,98) - b(k,191) = b(k,191) - lu(k,359) * b(k,98) - b(k,197) = b(k,197) - lu(k,360) * b(k,98) - b(k,186) = b(k,186) - lu(k,362) * b(k,99) - b(k,190) = b(k,190) - lu(k,363) * b(k,99) - b(k,194) = b(k,194) - lu(k,364) * b(k,99) - b(k,197) = b(k,197) - lu(k,365) * b(k,99) - b(k,199) = b(k,199) - lu(k,366) * b(k,99) - b(k,201) = b(k,201) - lu(k,367) * b(k,99) - b(k,156) = b(k,156) - lu(k,369) * b(k,100) - b(k,158) = b(k,158) - lu(k,370) * b(k,100) - b(k,166) = b(k,166) - lu(k,371) * b(k,100) - b(k,190) = b(k,190) - lu(k,372) * b(k,100) - b(k,193) = b(k,193) - lu(k,373) * b(k,100) - b(k,199) = b(k,199) - lu(k,374) * b(k,100) - b(k,130) = b(k,130) - lu(k,378) * b(k,101) - b(k,149) = b(k,149) - lu(k,379) * b(k,101) - b(k,187) = b(k,187) - lu(k,380) * b(k,101) - b(k,190) = b(k,190) - lu(k,381) * b(k,101) - b(k,197) = b(k,197) - lu(k,382) * b(k,101) - b(k,199) = b(k,199) - lu(k,383) * b(k,101) - b(k,120) = b(k,120) - lu(k,385) * b(k,102) - b(k,137) = b(k,137) - lu(k,386) * b(k,102) - b(k,138) = b(k,138) - lu(k,387) * b(k,102) - b(k,144) = b(k,144) - lu(k,388) * b(k,102) - b(k,186) = b(k,186) - lu(k,389) * b(k,102) - b(k,192) = b(k,192) - lu(k,390) * b(k,102) - b(k,149) = b(k,149) - lu(k,393) * b(k,103) - b(k,175) = b(k,175) - lu(k,394) * b(k,103) - b(k,187) = b(k,187) - lu(k,395) * b(k,103) - b(k,190) = b(k,190) - lu(k,396) * b(k,103) - b(k,197) = b(k,197) - lu(k,397) * b(k,103) - b(k,199) = b(k,199) - lu(k,398) * b(k,103) - b(k,122) = b(k,122) - lu(k,401) * b(k,104) - b(k,187) = b(k,187) - lu(k,402) * b(k,104) - b(k,190) = b(k,190) - lu(k,403) * b(k,104) - b(k,197) = b(k,197) - lu(k,404) * b(k,104) - b(k,199) = b(k,199) - lu(k,405) * b(k,104) - b(k,181) = b(k,181) - lu(k,407) * b(k,105) - b(k,185) = b(k,185) - lu(k,408) * b(k,105) - b(k,190) = b(k,190) - lu(k,409) * b(k,105) - b(k,193) = b(k,193) - lu(k,410) * b(k,105) - b(k,201) = b(k,201) - lu(k,411) * b(k,105) - b(k,144) = b(k,144) - lu(k,413) * b(k,106) - b(k,186) = b(k,186) - lu(k,414) * b(k,106) - b(k,187) = b(k,187) - lu(k,415) * b(k,106) - b(k,189) = b(k,189) - lu(k,416) * b(k,106) - b(k,125) = b(k,125) - lu(k,418) * b(k,107) - b(k,152) = b(k,152) - lu(k,419) * b(k,107) - b(k,181) = b(k,181) - lu(k,420) * b(k,107) - b(k,190) = b(k,190) - lu(k,421) * b(k,107) - b(k,147) = b(k,147) - lu(k,423) * b(k,108) - b(k,161) = b(k,161) - lu(k,424) * b(k,108) - b(k,162) = b(k,162) - lu(k,425) * b(k,108) - b(k,164) = b(k,164) - lu(k,426) * b(k,108) - b(k,190) = b(k,190) - lu(k,427) * b(k,108) - b(k,196) = b(k,196) - lu(k,428) * b(k,108) - b(k,199) = b(k,199) - lu(k,429) * b(k,108) - b(k,142) = b(k,142) - lu(k,431) * b(k,109) - b(k,164) = b(k,164) - lu(k,432) * b(k,109) - b(k,170) = b(k,170) - lu(k,433) * b(k,109) - b(k,190) = b(k,190) - lu(k,434) * b(k,109) - b(k,193) = b(k,193) - lu(k,435) * b(k,109) - b(k,199) = b(k,199) - lu(k,436) * b(k,109) - b(k,201) = b(k,201) - lu(k,437) * b(k,109) - b(k,134) = b(k,134) - lu(k,439) * b(k,110) - b(k,184) = b(k,184) - lu(k,440) * b(k,110) - b(k,192) = b(k,192) - lu(k,441) * b(k,110) - b(k,194) = b(k,194) - lu(k,442) * b(k,110) - b(k,196) = b(k,196) - lu(k,443) * b(k,110) - b(k,197) = b(k,197) - lu(k,444) * b(k,110) - b(k,198) = b(k,198) - lu(k,445) * b(k,110) - b(k,185) = b(k,185) - lu(k,447) * b(k,111) - b(k,190) = b(k,190) - lu(k,448) * b(k,111) - b(k,201) = b(k,201) - lu(k,449) * b(k,111) - b(k,135) = b(k,135) - lu(k,451) * b(k,112) - b(k,141) = b(k,141) - lu(k,452) * b(k,112) - b(k,165) = b(k,165) - lu(k,453) * b(k,112) - b(k,190) = b(k,190) - lu(k,454) * b(k,112) - b(k,191) = b(k,191) - lu(k,455) * b(k,112) - b(k,193) = b(k,193) - lu(k,456) * b(k,112) - b(k,199) = b(k,199) - lu(k,457) * b(k,112) - b(k,156) = b(k,156) - lu(k,459) * b(k,113) - b(k,162) = b(k,162) - lu(k,460) * b(k,113) - b(k,170) = b(k,170) - lu(k,461) * b(k,113) - b(k,187) = b(k,187) - lu(k,462) * b(k,113) - b(k,193) = b(k,193) - lu(k,463) * b(k,113) - b(k,197) = b(k,197) - lu(k,464) * b(k,113) - b(k,199) = b(k,199) - lu(k,465) * b(k,113) - b(k,164) = b(k,164) - lu(k,467) * b(k,114) - b(k,180) = b(k,180) - lu(k,468) * b(k,114) - b(k,190) = b(k,190) - lu(k,469) * b(k,114) - b(k,193) = b(k,193) - lu(k,470) * b(k,114) - b(k,194) = b(k,194) - lu(k,471) * b(k,114) - b(k,197) = b(k,197) - lu(k,472) * b(k,114) - b(k,199) = b(k,199) - lu(k,473) * b(k,114) - b(k,183) = b(k,183) - lu(k,475) * b(k,115) - b(k,188) = b(k,188) - lu(k,476) * b(k,115) - b(k,190) = b(k,190) - lu(k,477) * b(k,115) - b(k,192) = b(k,192) - lu(k,478) * b(k,115) - b(k,199) = b(k,199) - lu(k,479) * b(k,115) - b(k,201) = b(k,201) - lu(k,480) * b(k,115) - b(k,156) = b(k,156) - lu(k,482) * b(k,116) - b(k,161) = b(k,161) - lu(k,483) * b(k,116) - b(k,163) = b(k,163) - lu(k,484) * b(k,116) - b(k,165) = b(k,165) - lu(k,485) * b(k,116) - b(k,167) = b(k,167) - lu(k,486) * b(k,116) - b(k,190) = b(k,190) - lu(k,487) * b(k,116) - b(k,193) = b(k,193) - lu(k,488) * b(k,116) - b(k,199) = b(k,199) - lu(k,489) * b(k,116) - b(k,118) = b(k,118) - lu(k,493) * b(k,117) - b(k,130) = b(k,130) - lu(k,494) * b(k,117) - b(k,131) = b(k,131) - lu(k,495) * b(k,117) - b(k,133) = b(k,133) - lu(k,496) * b(k,117) - b(k,149) = b(k,149) - lu(k,497) * b(k,117) - b(k,175) = b(k,175) - lu(k,498) * b(k,117) - b(k,190) = b(k,190) - lu(k,499) * b(k,117) - b(k,199) = b(k,199) - lu(k,500) * b(k,117) - b(k,150) = b(k,150) - lu(k,502) * b(k,118) - b(k,165) = b(k,165) - lu(k,503) * b(k,118) - b(k,199) = b(k,199) - lu(k,504) * b(k,118) - b(k,161) = b(k,161) - lu(k,506) * b(k,119) - b(k,162) = b(k,162) - lu(k,507) * b(k,119) - b(k,164) = b(k,164) - lu(k,508) * b(k,119) - b(k,190) = b(k,190) - lu(k,509) * b(k,119) - b(k,193) = b(k,193) - lu(k,510) * b(k,119) - b(k,196) = b(k,196) - lu(k,511) * b(k,119) - b(k,197) = b(k,197) - lu(k,512) * b(k,119) - b(k,199) = b(k,199) - lu(k,513) * b(k,119) - b(k,137) = b(k,137) - lu(k,515) * b(k,120) - b(k,138) = b(k,138) - lu(k,516) * b(k,120) - b(k,144) = b(k,144) - lu(k,517) * b(k,120) - b(k,165) = b(k,165) - lu(k,518) * b(k,120) - b(k,186) = b(k,186) - lu(k,519) * b(k,120) - b(k,192) = b(k,192) - lu(k,520) * b(k,120) - b(k,158) = b(k,158) - lu(k,522) * b(k,121) - b(k,190) = b(k,190) - lu(k,523) * b(k,121) - b(k,196) = b(k,196) - lu(k,524) * b(k,121) - b(k,197) = b(k,197) - lu(k,525) * b(k,121) - b(k,199) = b(k,199) - lu(k,526) * b(k,121) - b(k,187) = b(k,187) - lu(k,530) * b(k,122) - b(k,190) = b(k,190) - lu(k,531) * b(k,122) - b(k,191) = b(k,191) - lu(k,532) * b(k,122) - b(k,197) = b(k,197) - lu(k,533) * b(k,122) - b(k,199) = b(k,199) - lu(k,534) * b(k,122) - b(k,125) = b(k,125) - lu(k,537) * b(k,123) - b(k,152) = b(k,152) - lu(k,538) * b(k,123) - b(k,156) = b(k,156) - lu(k,539) * b(k,123) - b(k,170) = b(k,170) - lu(k,540) * b(k,123) - b(k,181) = b(k,181) - lu(k,541) * b(k,123) - b(k,190) = b(k,190) - lu(k,542) * b(k,123) - b(k,193) = b(k,193) - lu(k,543) * b(k,123) - b(k,197) = b(k,197) - lu(k,544) * b(k,123) - b(k,199) = b(k,199) - lu(k,545) * b(k,123) - b(k,125) = b(k,125) - lu(k,548) * b(k,124) - b(k,152) = b(k,152) - lu(k,549) * b(k,124) - b(k,154) = b(k,154) - lu(k,550) * b(k,124) - b(k,156) = b(k,156) - lu(k,551) * b(k,124) - b(k,170) = b(k,170) - lu(k,552) * b(k,124) - b(k,181) = b(k,181) - lu(k,553) * b(k,124) - b(k,190) = b(k,190) - lu(k,554) * b(k,124) - b(k,193) = b(k,193) - lu(k,555) * b(k,124) - b(k,199) = b(k,199) - lu(k,556) * b(k,124) - b(k,170) = b(k,170) - lu(k,559) * b(k,125) - b(k,181) = b(k,181) - lu(k,560) * b(k,125) - b(k,187) = b(k,187) - lu(k,561) * b(k,125) - b(k,190) = b(k,190) - lu(k,562) * b(k,125) - b(k,197) = b(k,197) - lu(k,563) * b(k,125) - b(k,199) = b(k,199) - lu(k,564) * b(k,125) - b(k,137) = b(k,137) - lu(k,568) * b(k,126) - b(k,138) = b(k,138) - lu(k,569) * b(k,126) - b(k,139) = b(k,139) - lu(k,570) * b(k,126) - b(k,144) = b(k,144) - lu(k,571) * b(k,126) - b(k,165) = b(k,165) - lu(k,572) * b(k,126) - b(k,186) = b(k,186) - lu(k,573) * b(k,126) - b(k,187) = b(k,187) - lu(k,574) * b(k,126) - b(k,189) = b(k,189) - lu(k,575) * b(k,126) - b(k,192) = b(k,192) - lu(k,576) * b(k,126) - b(k,171) = b(k,171) - lu(k,579) * b(k,127) - b(k,174) = b(k,174) - lu(k,580) * b(k,127) - b(k,179) = b(k,179) - lu(k,581) * b(k,127) - b(k,190) = b(k,190) - lu(k,582) * b(k,127) - b(k,193) = b(k,193) - lu(k,583) * b(k,127) - b(k,199) = b(k,199) - lu(k,584) * b(k,127) + b(k,199) = b(k,199) - lu(k,370) * b(k,113) + b(k,218) = b(k,218) - lu(k,371) * b(k,113) + b(k,224) = b(k,224) - lu(k,372) * b(k,113) + b(k,227) = b(k,227) - lu(k,373) * b(k,113) + b(k,231) = b(k,231) - lu(k,374) * b(k,113) + b(k,232) = b(k,232) - lu(k,375) * b(k,113) + b(k,237) = b(k,237) - lu(k,376) * b(k,113) + b(k,177) = b(k,177) - lu(k,378) * b(k,114) + b(k,200) = b(k,200) - lu(k,379) * b(k,114) + b(k,224) = b(k,224) - lu(k,380) * b(k,114) + b(k,228) = b(k,228) - lu(k,381) * b(k,114) + b(k,231) = b(k,231) - lu(k,382) * b(k,114) + b(k,190) = b(k,190) - lu(k,384) * b(k,115) + b(k,199) = b(k,199) - lu(k,385) * b(k,115) + b(k,208) = b(k,208) - lu(k,386) * b(k,115) + b(k,214) = b(k,214) - lu(k,387) * b(k,115) + b(k,231) = b(k,231) - lu(k,388) * b(k,115) + b(k,224) = b(k,224) - lu(k,390) * b(k,116) + b(k,230) = b(k,230) - lu(k,391) * b(k,116) + b(k,232) = b(k,232) - lu(k,392) * b(k,116) + b(k,235) = b(k,235) - lu(k,393) * b(k,116) + b(k,237) = b(k,237) - lu(k,394) * b(k,116) + b(k,192) = b(k,192) - lu(k,396) * b(k,117) + b(k,194) = b(k,194) - lu(k,397) * b(k,117) + b(k,224) = b(k,224) - lu(k,398) * b(k,117) + b(k,225) = b(k,225) - lu(k,399) * b(k,117) + b(k,228) = b(k,228) - lu(k,400) * b(k,117) + b(k,127) = b(k,127) - lu(k,402) * b(k,118) + b(k,132) = b(k,132) - lu(k,403) * b(k,118) + b(k,190) = b(k,190) - lu(k,404) * b(k,118) + b(k,224) = b(k,224) - lu(k,405) * b(k,118) + b(k,231) = b(k,231) - lu(k,406) * b(k,118) + b(k,204) = b(k,204) - lu(k,408) * b(k,119) + b(k,214) = b(k,214) - lu(k,409) * b(k,119) + b(k,224) = b(k,224) - lu(k,410) * b(k,119) + b(k,235) = b(k,235) - lu(k,411) * b(k,119) + b(k,237) = b(k,237) - lu(k,412) * b(k,119) + b(k,183) = b(k,183) - lu(k,414) * b(k,120) + b(k,193) = b(k,193) - lu(k,415) * b(k,120) + b(k,224) = b(k,224) - lu(k,416) * b(k,120) + b(k,231) = b(k,231) - lu(k,417) * b(k,120) + b(k,237) = b(k,237) - lu(k,418) * b(k,120) + b(k,162) = b(k,162) - lu(k,420) * b(k,121) + b(k,177) = b(k,177) - lu(k,421) * b(k,121) + b(k,224) = b(k,224) - lu(k,422) * b(k,121) + b(k,225) = b(k,225) - lu(k,423) * b(k,121) + b(k,231) = b(k,231) - lu(k,424) * b(k,121) + b(k,135) = b(k,135) - lu(k,426) * b(k,122) + b(k,190) = b(k,190) - lu(k,427) * b(k,122) + b(k,208) = b(k,208) - lu(k,428) * b(k,122) + b(k,224) = b(k,224) - lu(k,429) * b(k,122) + b(k,231) = b(k,231) - lu(k,430) * b(k,122) + b(k,137) = b(k,137) - lu(k,434) * b(k,123) + b(k,224) = b(k,224) - lu(k,435) * b(k,123) + b(k,225) = b(k,225) - lu(k,436) * b(k,123) + b(k,229) = b(k,229) - lu(k,437) * b(k,123) + b(k,231) = b(k,231) - lu(k,438) * b(k,123) + b(k,180) = b(k,180) - lu(k,440) * b(k,124) + b(k,225) = b(k,225) - lu(k,441) * b(k,124) + b(k,229) = b(k,229) - lu(k,442) * b(k,124) + b(k,231) = b(k,231) - lu(k,443) * b(k,124) + b(k,235) = b(k,235) - lu(k,444) * b(k,124) + b(k,218) = b(k,218) - lu(k,446) * b(k,125) + b(k,219) = b(k,219) - lu(k,447) * b(k,125) + b(k,223) = b(k,223) - lu(k,448) * b(k,125) + b(k,224) = b(k,224) - lu(k,449) * b(k,125) + b(k,227) = b(k,227) - lu(k,450) * b(k,125) + b(k,190) = b(k,190) - lu(k,453) * b(k,126) + b(k,224) = b(k,224) - lu(k,454) * b(k,126) + b(k,225) = b(k,225) - lu(k,455) * b(k,126) + b(k,229) = b(k,229) - lu(k,456) * b(k,126) + b(k,231) = b(k,231) - lu(k,457) * b(k,126) + b(k,163) = b(k,163) - lu(k,459) * b(k,127) + b(k,231) = b(k,231) - lu(k,460) * b(k,127) + b(k,200) = b(k,200) - lu(k,462) * b(k,128) + b(k,220) = b(k,220) - lu(k,463) * b(k,128) + b(k,231) = b(k,231) - lu(k,464) * b(k,128) + b(k,235) = b(k,235) - lu(k,465) * b(k,128) + b(k,152) = b(k,152) - lu(k,467) * b(k,129) + b(k,225) = b(k,225) - lu(k,468) * b(k,129) + b(k,236) = b(k,236) - lu(k,469) * b(k,129) + b(k,218) = b(k,218) - lu(k,471) * b(k,130) + b(k,219) = b(k,219) - lu(k,472) * b(k,130) + b(k,223) = b(k,223) - lu(k,473) * b(k,130) + b(k,224) = b(k,224) - lu(k,474) * b(k,130) + b(k,227) = b(k,227) - lu(k,475) * b(k,130) + b(k,237) = b(k,237) - lu(k,476) * b(k,130) + b(k,191) = b(k,191) - lu(k,478) * b(k,131) + b(k,192) = b(k,192) - lu(k,479) * b(k,131) + b(k,193) = b(k,193) - lu(k,480) * b(k,131) + b(k,224) = b(k,224) - lu(k,481) * b(k,131) + b(k,231) = b(k,231) - lu(k,482) * b(k,131) + b(k,235) = b(k,235) - lu(k,483) * b(k,131) + b(k,163) = b(k,163) - lu(k,487) * b(k,132) + b(k,190) = b(k,190) - lu(k,488) * b(k,132) + b(k,224) = b(k,224) - lu(k,489) * b(k,132) + b(k,225) = b(k,225) - lu(k,490) * b(k,132) + b(k,229) = b(k,229) - lu(k,491) * b(k,132) + b(k,231) = b(k,231) - lu(k,492) * b(k,132) + b(k,220) = b(k,220) - lu(k,494) * b(k,133) + b(k,224) = b(k,224) - lu(k,495) * b(k,133) + b(k,225) = b(k,225) - lu(k,496) * b(k,133) + b(k,226) = b(k,226) - lu(k,497) * b(k,133) + b(k,231) = b(k,231) - lu(k,498) * b(k,133) + b(k,237) = b(k,237) - lu(k,499) * b(k,133) + b(k,169) = b(k,169) - lu(k,501) * b(k,134) + b(k,174) = b(k,174) - lu(k,502) * b(k,134) + b(k,175) = b(k,175) - lu(k,503) * b(k,134) + b(k,186) = b(k,186) - lu(k,504) * b(k,134) + b(k,220) = b(k,220) - lu(k,505) * b(k,134) + b(k,234) = b(k,234) - lu(k,506) * b(k,134) + b(k,190) = b(k,190) - lu(k,509) * b(k,135) + b(k,208) = b(k,208) - lu(k,510) * b(k,135) + b(k,224) = b(k,224) - lu(k,511) * b(k,135) + b(k,225) = b(k,225) - lu(k,512) * b(k,135) + b(k,229) = b(k,229) - lu(k,513) * b(k,135) + b(k,231) = b(k,231) - lu(k,514) * b(k,135) + b(k,158) = b(k,158) - lu(k,516) * b(k,136) + b(k,179) = b(k,179) - lu(k,517) * b(k,136) + b(k,214) = b(k,214) - lu(k,518) * b(k,136) + b(k,224) = b(k,224) - lu(k,519) * b(k,136) + b(k,152) = b(k,152) - lu(k,522) * b(k,137) + b(k,224) = b(k,224) - lu(k,523) * b(k,137) + b(k,225) = b(k,225) - lu(k,524) * b(k,137) + b(k,229) = b(k,229) - lu(k,525) * b(k,137) + b(k,231) = b(k,231) - lu(k,526) * b(k,137) + b(k,186) = b(k,186) - lu(k,528) * b(k,138) + b(k,220) = b(k,220) - lu(k,529) * b(k,138) + b(k,223) = b(k,223) - lu(k,530) * b(k,138) + b(k,229) = b(k,229) - lu(k,531) * b(k,138) + b(k,214) = b(k,214) - lu(k,533) * b(k,139) + b(k,215) = b(k,215) - lu(k,534) * b(k,139) + b(k,224) = b(k,224) - lu(k,535) * b(k,139) + b(k,225) = b(k,225) - lu(k,536) * b(k,139) + b(k,226) = b(k,226) - lu(k,537) * b(k,139) + b(k,232) = b(k,232) - lu(k,538) * b(k,139) + b(k,235) = b(k,235) - lu(k,539) * b(k,139) + b(k,171) = b(k,171) - lu(k,541) * b(k,140) + b(k,198) = b(k,198) - lu(k,542) * b(k,140) + b(k,203) = b(k,203) - lu(k,543) * b(k,140) + b(k,224) = b(k,224) - lu(k,544) * b(k,140) + b(k,231) = b(k,231) - lu(k,545) * b(k,140) + b(k,235) = b(k,235) - lu(k,546) * b(k,140) + b(k,237) = b(k,237) - lu(k,547) * b(k,140) + b(k,168) = b(k,168) - lu(k,549) * b(k,141) + b(k,180) = b(k,180) - lu(k,550) * b(k,141) + b(k,199) = b(k,199) - lu(k,551) * b(k,141) + b(k,224) = b(k,224) - lu(k,552) * b(k,141) + b(k,231) = b(k,231) - lu(k,553) * b(k,141) + b(k,235) = b(k,235) - lu(k,554) * b(k,141) + b(k,236) = b(k,236) - lu(k,555) * b(k,141) + b(k,177) = b(k,177) - lu(k,557) * b(k,142) + b(k,200) = b(k,200) - lu(k,558) * b(k,142) + b(k,202) = b(k,202) - lu(k,559) * b(k,142) + b(k,203) = b(k,203) - lu(k,560) * b(k,142) + b(k,224) = b(k,224) - lu(k,561) * b(k,142) + b(k,228) = b(k,228) - lu(k,562) * b(k,142) + b(k,231) = b(k,231) - lu(k,563) * b(k,142) + b(k,167) = b(k,167) - lu(k,565) * b(k,143) + b(k,219) = b(k,219) - lu(k,566) * b(k,143) + b(k,221) = b(k,221) - lu(k,567) * b(k,143) + b(k,225) = b(k,225) - lu(k,568) * b(k,143) + b(k,226) = b(k,226) - lu(k,569) * b(k,143) + b(k,228) = b(k,228) - lu(k,570) * b(k,143) + b(k,234) = b(k,234) - lu(k,571) * b(k,143) + b(k,193) = b(k,193) - lu(k,573) * b(k,144) + b(k,198) = b(k,198) - lu(k,574) * b(k,144) + b(k,202) = b(k,202) - lu(k,575) * b(k,144) + b(k,225) = b(k,225) - lu(k,576) * b(k,144) + b(k,229) = b(k,229) - lu(k,577) * b(k,144) + b(k,231) = b(k,231) - lu(k,578) * b(k,144) + b(k,235) = b(k,235) - lu(k,579) * b(k,144) + b(k,203) = b(k,203) - lu(k,581) * b(k,145) + b(k,213) = b(k,213) - lu(k,582) * b(k,145) + b(k,215) = b(k,215) - lu(k,583) * b(k,145) + b(k,224) = b(k,224) - lu(k,584) * b(k,145) + b(k,225) = b(k,225) - lu(k,585) * b(k,145) + b(k,226) = b(k,226) - lu(k,586) * b(k,145) + b(k,231) = b(k,231) - lu(k,587) * b(k,145) + b(k,235) = b(k,235) - lu(k,588) * b(k,145) + b(k,200) = b(k,200) - lu(k,590) * b(k,146) + b(k,202) = b(k,202) - lu(k,591) * b(k,146) + b(k,203) = b(k,203) - lu(k,592) * b(k,146) + b(k,224) = b(k,224) - lu(k,593) * b(k,146) + b(k,225) = b(k,225) - lu(k,594) * b(k,146) + b(k,228) = b(k,228) - lu(k,595) * b(k,146) + b(k,231) = b(k,231) - lu(k,596) * b(k,146) + b(k,235) = b(k,235) - lu(k,597) * b(k,146) + b(k,181) = b(k,181) - lu(k,599) * b(k,147) + b(k,199) = b(k,199) - lu(k,600) * b(k,147) + b(k,231) = b(k,231) - lu(k,601) * b(k,147) + b(k,218) = b(k,218) - lu(k,603) * b(k,148) + b(k,219) = b(k,219) - lu(k,604) * b(k,148) + b(k,223) = b(k,223) - lu(k,605) * b(k,148) + b(k,224) = b(k,224) - lu(k,606) * b(k,148) + b(k,227) = b(k,227) - lu(k,607) * b(k,148) + b(k,231) = b(k,231) - lu(k,608) * b(k,148) + b(k,232) = b(k,232) - lu(k,609) * b(k,148) + b(k,237) = b(k,237) - lu(k,610) * b(k,148) + b(k,218) = b(k,218) - lu(k,612) * b(k,149) + b(k,224) = b(k,224) - lu(k,613) * b(k,149) + b(k,227) = b(k,227) - lu(k,614) * b(k,149) + b(k,231) = b(k,231) - lu(k,615) * b(k,149) + b(k,234) = b(k,234) - lu(k,616) * b(k,149) + b(k,237) = b(k,237) - lu(k,617) * b(k,149) end do end subroutine lu_slv02 subroutine lu_slv03( avec_len, lu, b ) @@ -472,209 +472,215 @@ subroutine lu_slv03( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,130) = b(k,130) - lu(k,590) * b(k,128) - b(k,132) = b(k,132) - lu(k,591) * b(k,128) - b(k,133) = b(k,133) - lu(k,592) * b(k,128) - b(k,149) = b(k,149) - lu(k,593) * b(k,128) - b(k,150) = b(k,150) - lu(k,594) * b(k,128) - b(k,165) = b(k,165) - lu(k,595) * b(k,128) - b(k,175) = b(k,175) - lu(k,596) * b(k,128) - b(k,181) = b(k,181) - lu(k,597) * b(k,128) - b(k,190) = b(k,190) - lu(k,598) * b(k,128) - b(k,199) = b(k,199) - lu(k,599) * b(k,128) - b(k,182) = b(k,182) - lu(k,601) * b(k,129) - b(k,186) = b(k,186) - lu(k,602) * b(k,129) - b(k,190) = b(k,190) - lu(k,603) * b(k,129) - b(k,191) = b(k,191) - lu(k,604) * b(k,129) - b(k,192) = b(k,192) - lu(k,605) * b(k,129) - b(k,195) = b(k,195) - lu(k,606) * b(k,129) - b(k,149) = b(k,149) - lu(k,608) * b(k,130) - b(k,165) = b(k,165) - lu(k,609) * b(k,130) - b(k,187) = b(k,187) - lu(k,610) * b(k,130) - b(k,197) = b(k,197) - lu(k,611) * b(k,130) - b(k,199) = b(k,199) - lu(k,612) * b(k,130) - b(k,133) = b(k,133) - lu(k,619) * b(k,131) - b(k,149) = b(k,149) - lu(k,620) * b(k,131) - b(k,150) = b(k,150) - lu(k,621) * b(k,131) - b(k,165) = b(k,165) - lu(k,622) * b(k,131) - b(k,175) = b(k,175) - lu(k,623) * b(k,131) - b(k,187) = b(k,187) - lu(k,624) * b(k,131) - b(k,190) = b(k,190) - lu(k,625) * b(k,131) - b(k,197) = b(k,197) - lu(k,626) * b(k,131) - b(k,199) = b(k,199) - lu(k,627) * b(k,131) - b(k,133) = b(k,133) - lu(k,635) * b(k,132) - b(k,149) = b(k,149) - lu(k,636) * b(k,132) - b(k,150) = b(k,150) - lu(k,637) * b(k,132) - b(k,165) = b(k,165) - lu(k,638) * b(k,132) - b(k,175) = b(k,175) - lu(k,639) * b(k,132) - b(k,181) = b(k,181) - lu(k,640) * b(k,132) - b(k,187) = b(k,187) - lu(k,641) * b(k,132) - b(k,190) = b(k,190) - lu(k,642) * b(k,132) - b(k,197) = b(k,197) - lu(k,643) * b(k,132) - b(k,199) = b(k,199) - lu(k,644) * b(k,132) - b(k,165) = b(k,165) - lu(k,646) * b(k,133) - b(k,175) = b(k,175) - lu(k,647) * b(k,133) - b(k,185) = b(k,185) - lu(k,648) * b(k,133) - b(k,187) = b(k,187) - lu(k,649) * b(k,133) - b(k,190) = b(k,190) - lu(k,650) * b(k,133) - b(k,197) = b(k,197) - lu(k,651) * b(k,133) - b(k,199) = b(k,199) - lu(k,652) * b(k,133) - b(k,183) = b(k,183) - lu(k,655) * b(k,134) - b(k,184) = b(k,184) - lu(k,656) * b(k,134) - b(k,188) = b(k,188) - lu(k,657) * b(k,134) - b(k,190) = b(k,190) - lu(k,658) * b(k,134) - b(k,192) = b(k,192) - lu(k,659) * b(k,134) - b(k,198) = b(k,198) - lu(k,660) * b(k,134) - b(k,201) = b(k,201) - lu(k,661) * b(k,134) - b(k,161) = b(k,161) - lu(k,665) * b(k,135) - b(k,186) = b(k,186) - lu(k,666) * b(k,135) - b(k,187) = b(k,187) - lu(k,667) * b(k,135) - b(k,190) = b(k,190) - lu(k,668) * b(k,135) - b(k,193) = b(k,193) - lu(k,669) * b(k,135) - b(k,197) = b(k,197) - lu(k,670) * b(k,135) - b(k,199) = b(k,199) - lu(k,671) * b(k,135) - b(k,172) = b(k,172) - lu(k,674) * b(k,136) - b(k,185) = b(k,185) - lu(k,675) * b(k,136) - b(k,190) = b(k,190) - lu(k,676) * b(k,136) - b(k,194) = b(k,194) - lu(k,677) * b(k,136) - b(k,195) = b(k,195) - lu(k,678) * b(k,136) - b(k,196) = b(k,196) - lu(k,679) * b(k,136) - b(k,201) = b(k,201) - lu(k,680) * b(k,136) - b(k,138) = b(k,138) - lu(k,682) * b(k,137) - b(k,139) = b(k,139) - lu(k,683) * b(k,137) - b(k,144) = b(k,144) - lu(k,684) * b(k,137) - b(k,186) = b(k,186) - lu(k,685) * b(k,137) - b(k,187) = b(k,187) - lu(k,686) * b(k,137) - b(k,189) = b(k,189) - lu(k,687) * b(k,137) - b(k,192) = b(k,192) - lu(k,688) * b(k,137) - b(k,139) = b(k,139) - lu(k,691) * b(k,138) - b(k,144) = b(k,144) - lu(k,692) * b(k,138) - b(k,186) = b(k,186) - lu(k,693) * b(k,138) - b(k,187) = b(k,187) - lu(k,694) * b(k,138) - b(k,189) = b(k,189) - lu(k,695) * b(k,138) - b(k,192) = b(k,192) - lu(k,696) * b(k,138) - b(k,144) = b(k,144) - lu(k,702) * b(k,139) - b(k,165) = b(k,165) - lu(k,703) * b(k,139) - b(k,186) = b(k,186) - lu(k,704) * b(k,139) - b(k,187) = b(k,187) - lu(k,705) * b(k,139) - b(k,189) = b(k,189) - lu(k,706) * b(k,139) - b(k,192) = b(k,192) - lu(k,707) * b(k,139) - b(k,190) = b(k,190) - lu(k,709) * b(k,140) - b(k,193) = b(k,193) - lu(k,710) * b(k,140) - b(k,199) = b(k,199) - lu(k,711) * b(k,140) - b(k,190) = b(k,190) - lu(k,713) * b(k,141) - b(k,199) = b(k,199) - lu(k,714) * b(k,141) - b(k,201) = b(k,201) - lu(k,715) * b(k,141) - b(k,164) = b(k,164) - lu(k,718) * b(k,142) - b(k,170) = b(k,170) - lu(k,719) * b(k,142) - b(k,186) = b(k,186) - lu(k,720) * b(k,142) - b(k,187) = b(k,187) - lu(k,721) * b(k,142) - b(k,190) = b(k,190) - lu(k,722) * b(k,142) - b(k,193) = b(k,193) - lu(k,723) * b(k,142) - b(k,197) = b(k,197) - lu(k,724) * b(k,142) - b(k,199) = b(k,199) - lu(k,725) * b(k,142) - b(k,201) = b(k,201) - lu(k,726) * b(k,142) - b(k,156) = b(k,156) - lu(k,729) * b(k,143) - b(k,170) = b(k,170) - lu(k,730) * b(k,143) - b(k,185) = b(k,185) - lu(k,731) * b(k,143) - b(k,186) = b(k,186) - lu(k,732) * b(k,143) - b(k,187) = b(k,187) - lu(k,733) * b(k,143) - b(k,190) = b(k,190) - lu(k,734) * b(k,143) - b(k,193) = b(k,193) - lu(k,735) * b(k,143) - b(k,197) = b(k,197) - lu(k,736) * b(k,143) - b(k,199) = b(k,199) - lu(k,737) * b(k,143) - b(k,201) = b(k,201) - lu(k,738) * b(k,143) - b(k,165) = b(k,165) - lu(k,745) * b(k,144) - b(k,186) = b(k,186) - lu(k,746) * b(k,144) - b(k,187) = b(k,187) - lu(k,747) * b(k,144) - b(k,189) = b(k,189) - lu(k,748) * b(k,144) - b(k,190) = b(k,190) - lu(k,749) * b(k,144) - b(k,192) = b(k,192) - lu(k,750) * b(k,144) - b(k,195) = b(k,195) - lu(k,751) * b(k,144) - b(k,197) = b(k,197) - lu(k,752) * b(k,144) - b(k,184) = b(k,184) - lu(k,754) * b(k,145) - b(k,189) = b(k,189) - lu(k,755) * b(k,145) - b(k,190) = b(k,190) - lu(k,756) * b(k,145) - b(k,192) = b(k,192) - lu(k,757) * b(k,145) - b(k,195) = b(k,195) - lu(k,758) * b(k,145) - b(k,198) = b(k,198) - lu(k,759) * b(k,145) - b(k,201) = b(k,201) - lu(k,760) * b(k,145) - b(k,183) = b(k,183) - lu(k,763) * b(k,146) - b(k,188) = b(k,188) - lu(k,764) * b(k,146) - b(k,190) = b(k,190) - lu(k,765) * b(k,146) - b(k,192) = b(k,192) - lu(k,766) * b(k,146) - b(k,200) = b(k,200) - lu(k,767) * b(k,146) - b(k,201) = b(k,201) - lu(k,768) * b(k,146) - b(k,175) = b(k,175) - lu(k,770) * b(k,147) - b(k,181) = b(k,181) - lu(k,771) * b(k,147) - b(k,190) = b(k,190) - lu(k,772) * b(k,147) - b(k,193) = b(k,193) - lu(k,773) * b(k,147) - b(k,197) = b(k,197) - lu(k,774) * b(k,147) - b(k,160) = b(k,160) - lu(k,782) * b(k,148) - b(k,165) = b(k,165) - lu(k,783) * b(k,148) - b(k,173) = b(k,173) - lu(k,784) * b(k,148) - b(k,174) = b(k,174) - lu(k,785) * b(k,148) - b(k,176) = b(k,176) - lu(k,786) * b(k,148) - b(k,177) = b(k,177) - lu(k,787) * b(k,148) - b(k,179) = b(k,179) - lu(k,788) * b(k,148) - b(k,181) = b(k,181) - lu(k,789) * b(k,148) - b(k,185) = b(k,185) - lu(k,790) * b(k,148) - b(k,190) = b(k,190) - lu(k,791) * b(k,148) - b(k,191) = b(k,191) - lu(k,792) * b(k,148) - b(k,193) = b(k,193) - lu(k,793) * b(k,148) - b(k,194) = b(k,194) - lu(k,794) * b(k,148) - b(k,199) = b(k,199) - lu(k,795) * b(k,148) - b(k,201) = b(k,201) - lu(k,796) * b(k,148) - b(k,165) = b(k,165) - lu(k,799) * b(k,149) - b(k,190) = b(k,190) - lu(k,800) * b(k,149) - b(k,199) = b(k,199) - lu(k,801) * b(k,149) - b(k,165) = b(k,165) - lu(k,804) * b(k,150) - b(k,175) = b(k,175) - lu(k,805) * b(k,150) - b(k,185) = b(k,185) - lu(k,806) * b(k,150) - b(k,187) = b(k,187) - lu(k,807) * b(k,150) - b(k,190) = b(k,190) - lu(k,808) * b(k,150) - b(k,197) = b(k,197) - lu(k,809) * b(k,150) - b(k,199) = b(k,199) - lu(k,810) * b(k,150) - b(k,154) = b(k,154) - lu(k,821) * b(k,151) - b(k,156) = b(k,156) - lu(k,822) * b(k,151) - b(k,158) = b(k,158) - lu(k,823) * b(k,151) - b(k,163) = b(k,163) - lu(k,824) * b(k,151) - b(k,165) = b(k,165) - lu(k,825) * b(k,151) - b(k,166) = b(k,166) - lu(k,826) * b(k,151) - b(k,168) = b(k,168) - lu(k,827) * b(k,151) - b(k,169) = b(k,169) - lu(k,828) * b(k,151) - b(k,175) = b(k,175) - lu(k,829) * b(k,151) - b(k,181) = b(k,181) - lu(k,830) * b(k,151) - b(k,190) = b(k,190) - lu(k,831) * b(k,151) - b(k,191) = b(k,191) - lu(k,832) * b(k,151) - b(k,193) = b(k,193) - lu(k,833) * b(k,151) - b(k,194) = b(k,194) - lu(k,834) * b(k,151) - b(k,199) = b(k,199) - lu(k,835) * b(k,151) - b(k,201) = b(k,201) - lu(k,836) * b(k,151) - b(k,170) = b(k,170) - lu(k,841) * b(k,152) - b(k,185) = b(k,185) - lu(k,842) * b(k,152) - b(k,186) = b(k,186) - lu(k,843) * b(k,152) - b(k,187) = b(k,187) - lu(k,844) * b(k,152) - b(k,190) = b(k,190) - lu(k,845) * b(k,152) - b(k,193) = b(k,193) - lu(k,846) * b(k,152) - b(k,197) = b(k,197) - lu(k,847) * b(k,152) - b(k,199) = b(k,199) - lu(k,848) * b(k,152) - b(k,154) = b(k,154) - lu(k,859) * b(k,153) - b(k,156) = b(k,156) - lu(k,860) * b(k,153) - b(k,158) = b(k,158) - lu(k,861) * b(k,153) - b(k,163) = b(k,163) - lu(k,862) * b(k,153) - b(k,165) = b(k,165) - lu(k,863) * b(k,153) - b(k,166) = b(k,166) - lu(k,864) * b(k,153) - b(k,168) = b(k,168) - lu(k,865) * b(k,153) - b(k,169) = b(k,169) - lu(k,866) * b(k,153) - b(k,175) = b(k,175) - lu(k,867) * b(k,153) - b(k,181) = b(k,181) - lu(k,868) * b(k,153) - b(k,190) = b(k,190) - lu(k,869) * b(k,153) - b(k,191) = b(k,191) - lu(k,870) * b(k,153) - b(k,193) = b(k,193) - lu(k,871) * b(k,153) - b(k,194) = b(k,194) - lu(k,872) * b(k,153) - b(k,199) = b(k,199) - lu(k,873) * b(k,153) - b(k,201) = b(k,201) - lu(k,874) * b(k,153) + b(k,214) = b(k,214) - lu(k,619) * b(k,150) + b(k,215) = b(k,215) - lu(k,620) * b(k,150) + b(k,224) = b(k,224) - lu(k,621) * b(k,150) + b(k,232) = b(k,232) - lu(k,622) * b(k,150) + b(k,235) = b(k,235) - lu(k,623) * b(k,150) + b(k,237) = b(k,237) - lu(k,624) * b(k,150) + b(k,192) = b(k,192) - lu(k,626) * b(k,151) + b(k,224) = b(k,224) - lu(k,627) * b(k,151) + b(k,225) = b(k,225) - lu(k,628) * b(k,151) + b(k,228) = b(k,228) - lu(k,629) * b(k,151) + b(k,231) = b(k,231) - lu(k,630) * b(k,151) + b(k,224) = b(k,224) - lu(k,634) * b(k,152) + b(k,225) = b(k,225) - lu(k,635) * b(k,152) + b(k,229) = b(k,229) - lu(k,636) * b(k,152) + b(k,231) = b(k,231) - lu(k,637) * b(k,152) + b(k,236) = b(k,236) - lu(k,638) * b(k,152) + b(k,158) = b(k,158) - lu(k,641) * b(k,153) + b(k,179) = b(k,179) - lu(k,642) * b(k,153) + b(k,193) = b(k,193) - lu(k,643) * b(k,153) + b(k,198) = b(k,198) - lu(k,644) * b(k,153) + b(k,214) = b(k,214) - lu(k,645) * b(k,153) + b(k,224) = b(k,224) - lu(k,646) * b(k,153) + b(k,225) = b(k,225) - lu(k,647) * b(k,153) + b(k,231) = b(k,231) - lu(k,648) * b(k,153) + b(k,235) = b(k,235) - lu(k,649) * b(k,153) + b(k,193) = b(k,193) - lu(k,651) * b(k,154) + b(k,195) = b(k,195) - lu(k,652) * b(k,154) + b(k,199) = b(k,199) - lu(k,653) * b(k,154) + b(k,200) = b(k,200) - lu(k,654) * b(k,154) + b(k,201) = b(k,201) - lu(k,655) * b(k,154) + b(k,215) = b(k,215) - lu(k,656) * b(k,154) + b(k,224) = b(k,224) - lu(k,657) * b(k,154) + b(k,231) = b(k,231) - lu(k,658) * b(k,154) + b(k,235) = b(k,235) - lu(k,659) * b(k,154) + b(k,163) = b(k,163) - lu(k,664) * b(k,155) + b(k,164) = b(k,164) - lu(k,665) * b(k,155) + b(k,166) = b(k,166) - lu(k,666) * b(k,155) + b(k,181) = b(k,181) - lu(k,667) * b(k,155) + b(k,190) = b(k,190) - lu(k,668) * b(k,155) + b(k,199) = b(k,199) - lu(k,669) * b(k,155) + b(k,208) = b(k,208) - lu(k,670) * b(k,155) + b(k,224) = b(k,224) - lu(k,671) * b(k,155) + b(k,231) = b(k,231) - lu(k,672) * b(k,155) + b(k,169) = b(k,169) - lu(k,675) * b(k,156) + b(k,174) = b(k,174) - lu(k,676) * b(k,156) + b(k,175) = b(k,175) - lu(k,677) * b(k,156) + b(k,176) = b(k,176) - lu(k,678) * b(k,156) + b(k,186) = b(k,186) - lu(k,679) * b(k,156) + b(k,220) = b(k,220) - lu(k,680) * b(k,156) + b(k,223) = b(k,223) - lu(k,681) * b(k,156) + b(k,229) = b(k,229) - lu(k,682) * b(k,156) + b(k,234) = b(k,234) - lu(k,683) * b(k,156) + b(k,158) = b(k,158) - lu(k,686) * b(k,157) + b(k,179) = b(k,179) - lu(k,687) * b(k,157) + b(k,189) = b(k,189) - lu(k,688) * b(k,157) + b(k,193) = b(k,193) - lu(k,689) * b(k,157) + b(k,198) = b(k,198) - lu(k,690) * b(k,157) + b(k,214) = b(k,214) - lu(k,691) * b(k,157) + b(k,224) = b(k,224) - lu(k,692) * b(k,157) + b(k,231) = b(k,231) - lu(k,693) * b(k,157) + b(k,235) = b(k,235) - lu(k,694) * b(k,157) + b(k,198) = b(k,198) - lu(k,697) * b(k,158) + b(k,214) = b(k,214) - lu(k,698) * b(k,158) + b(k,224) = b(k,224) - lu(k,699) * b(k,158) + b(k,225) = b(k,225) - lu(k,700) * b(k,158) + b(k,229) = b(k,229) - lu(k,701) * b(k,158) + b(k,231) = b(k,231) - lu(k,702) * b(k,158) + b(k,215) = b(k,215) - lu(k,704) * b(k,159) + b(k,224) = b(k,224) - lu(k,705) * b(k,159) + b(k,232) = b(k,232) - lu(k,706) * b(k,159) + b(k,237) = b(k,237) - lu(k,707) * b(k,159) + b(k,217) = b(k,217) - lu(k,709) * b(k,160) + b(k,220) = b(k,220) - lu(k,710) * b(k,160) + b(k,224) = b(k,224) - lu(k,711) * b(k,160) + b(k,230) = b(k,230) - lu(k,712) * b(k,160) + b(k,234) = b(k,234) - lu(k,713) * b(k,160) + b(k,236) = b(k,236) - lu(k,714) * b(k,160) + b(k,163) = b(k,163) - lu(k,720) * b(k,161) + b(k,165) = b(k,165) - lu(k,721) * b(k,161) + b(k,166) = b(k,166) - lu(k,722) * b(k,161) + b(k,181) = b(k,181) - lu(k,723) * b(k,161) + b(k,190) = b(k,190) - lu(k,724) * b(k,161) + b(k,199) = b(k,199) - lu(k,725) * b(k,161) + b(k,208) = b(k,208) - lu(k,726) * b(k,161) + b(k,214) = b(k,214) - lu(k,727) * b(k,161) + b(k,224) = b(k,224) - lu(k,728) * b(k,161) + b(k,231) = b(k,231) - lu(k,729) * b(k,161) + b(k,205) = b(k,205) - lu(k,732) * b(k,162) + b(k,207) = b(k,207) - lu(k,733) * b(k,162) + b(k,212) = b(k,212) - lu(k,734) * b(k,162) + b(k,224) = b(k,224) - lu(k,735) * b(k,162) + b(k,231) = b(k,231) - lu(k,736) * b(k,162) + b(k,235) = b(k,235) - lu(k,737) * b(k,162) + b(k,190) = b(k,190) - lu(k,739) * b(k,163) + b(k,199) = b(k,199) - lu(k,740) * b(k,163) + b(k,225) = b(k,225) - lu(k,741) * b(k,163) + b(k,229) = b(k,229) - lu(k,742) * b(k,163) + b(k,231) = b(k,231) - lu(k,743) * b(k,163) + b(k,166) = b(k,166) - lu(k,750) * b(k,164) + b(k,181) = b(k,181) - lu(k,751) * b(k,164) + b(k,190) = b(k,190) - lu(k,752) * b(k,164) + b(k,199) = b(k,199) - lu(k,753) * b(k,164) + b(k,208) = b(k,208) - lu(k,754) * b(k,164) + b(k,224) = b(k,224) - lu(k,755) * b(k,164) + b(k,225) = b(k,225) - lu(k,756) * b(k,164) + b(k,229) = b(k,229) - lu(k,757) * b(k,164) + b(k,231) = b(k,231) - lu(k,758) * b(k,164) + b(k,166) = b(k,166) - lu(k,766) * b(k,165) + b(k,181) = b(k,181) - lu(k,767) * b(k,165) + b(k,190) = b(k,190) - lu(k,768) * b(k,165) + b(k,199) = b(k,199) - lu(k,769) * b(k,165) + b(k,208) = b(k,208) - lu(k,770) * b(k,165) + b(k,214) = b(k,214) - lu(k,771) * b(k,165) + b(k,224) = b(k,224) - lu(k,772) * b(k,165) + b(k,225) = b(k,225) - lu(k,773) * b(k,165) + b(k,229) = b(k,229) - lu(k,774) * b(k,165) + b(k,231) = b(k,231) - lu(k,775) * b(k,165) + b(k,199) = b(k,199) - lu(k,777) * b(k,166) + b(k,208) = b(k,208) - lu(k,778) * b(k,166) + b(k,224) = b(k,224) - lu(k,779) * b(k,166) + b(k,225) = b(k,225) - lu(k,780) * b(k,166) + b(k,229) = b(k,229) - lu(k,781) * b(k,166) + b(k,231) = b(k,231) - lu(k,782) * b(k,166) + b(k,232) = b(k,232) - lu(k,783) * b(k,166) + b(k,218) = b(k,218) - lu(k,786) * b(k,167) + b(k,219) = b(k,219) - lu(k,787) * b(k,167) + b(k,221) = b(k,221) - lu(k,788) * b(k,167) + b(k,224) = b(k,224) - lu(k,789) * b(k,167) + b(k,227) = b(k,227) - lu(k,790) * b(k,167) + b(k,234) = b(k,234) - lu(k,791) * b(k,167) + b(k,237) = b(k,237) - lu(k,792) * b(k,167) + b(k,200) = b(k,200) - lu(k,796) * b(k,168) + b(k,220) = b(k,220) - lu(k,797) * b(k,168) + b(k,224) = b(k,224) - lu(k,798) * b(k,168) + b(k,225) = b(k,225) - lu(k,799) * b(k,168) + b(k,229) = b(k,229) - lu(k,800) * b(k,168) + b(k,231) = b(k,231) - lu(k,801) * b(k,168) + b(k,235) = b(k,235) - lu(k,802) * b(k,168) + b(k,174) = b(k,174) - lu(k,804) * b(k,169) + b(k,175) = b(k,175) - lu(k,805) * b(k,169) + b(k,186) = b(k,186) - lu(k,806) * b(k,169) + b(k,199) = b(k,199) - lu(k,807) * b(k,169) + b(k,215) = b(k,215) - lu(k,808) * b(k,169) + b(k,220) = b(k,220) - lu(k,809) * b(k,169) + b(k,234) = b(k,234) - lu(k,810) * b(k,169) + b(k,224) = b(k,224) - lu(k,812) * b(k,170) + b(k,231) = b(k,231) - lu(k,813) * b(k,170) + b(k,235) = b(k,235) - lu(k,814) * b(k,170) + b(k,198) = b(k,198) - lu(k,817) * b(k,171) + b(k,203) = b(k,203) - lu(k,818) * b(k,171) + b(k,220) = b(k,220) - lu(k,819) * b(k,171) + b(k,224) = b(k,224) - lu(k,820) * b(k,171) + b(k,225) = b(k,225) - lu(k,821) * b(k,171) + b(k,229) = b(k,229) - lu(k,822) * b(k,171) + b(k,231) = b(k,231) - lu(k,823) * b(k,171) + b(k,235) = b(k,235) - lu(k,824) * b(k,171) + b(k,237) = b(k,237) - lu(k,825) * b(k,171) + b(k,219) = b(k,219) - lu(k,827) * b(k,172) + b(k,221) = b(k,221) - lu(k,828) * b(k,172) + b(k,223) = b(k,223) - lu(k,829) * b(k,172) + b(k,224) = b(k,224) - lu(k,830) * b(k,172) + b(k,230) = b(k,230) - lu(k,831) * b(k,172) + b(k,234) = b(k,234) - lu(k,832) * b(k,172) + b(k,237) = b(k,237) - lu(k,833) * b(k,172) + b(k,218) = b(k,218) - lu(k,836) * b(k,173) + b(k,222) = b(k,222) - lu(k,837) * b(k,173) + b(k,224) = b(k,224) - lu(k,838) * b(k,173) + b(k,227) = b(k,227) - lu(k,839) * b(k,173) + b(k,234) = b(k,234) - lu(k,840) * b(k,173) + b(k,237) = b(k,237) - lu(k,841) * b(k,173) + b(k,176) = b(k,176) - lu(k,844) * b(k,174) + b(k,186) = b(k,186) - lu(k,845) * b(k,174) + b(k,220) = b(k,220) - lu(k,846) * b(k,174) + b(k,223) = b(k,223) - lu(k,847) * b(k,174) + b(k,229) = b(k,229) - lu(k,848) * b(k,174) + b(k,234) = b(k,234) - lu(k,849) * b(k,174) + b(k,176) = b(k,176) - lu(k,852) * b(k,175) + b(k,186) = b(k,186) - lu(k,853) * b(k,175) + b(k,220) = b(k,220) - lu(k,854) * b(k,175) + b(k,223) = b(k,223) - lu(k,855) * b(k,175) + b(k,229) = b(k,229) - lu(k,856) * b(k,175) + b(k,234) = b(k,234) - lu(k,857) * b(k,175) + b(k,186) = b(k,186) - lu(k,864) * b(k,176) + b(k,199) = b(k,199) - lu(k,865) * b(k,176) + b(k,215) = b(k,215) - lu(k,866) * b(k,176) + b(k,220) = b(k,220) - lu(k,867) * b(k,176) + b(k,223) = b(k,223) - lu(k,868) * b(k,176) + b(k,229) = b(k,229) - lu(k,869) * b(k,176) + b(k,234) = b(k,234) - lu(k,870) * b(k,176) + b(k,208) = b(k,208) - lu(k,872) * b(k,177) + b(k,214) = b(k,214) - lu(k,873) * b(k,177) + b(k,224) = b(k,224) - lu(k,874) * b(k,177) + b(k,225) = b(k,225) - lu(k,875) * b(k,177) + b(k,235) = b(k,235) - lu(k,876) * b(k,177) + b(k,180) = b(k,180) - lu(k,881) * b(k,178) + b(k,197) = b(k,197) - lu(k,882) * b(k,178) + b(k,199) = b(k,199) - lu(k,883) * b(k,178) + b(k,206) = b(k,206) - lu(k,884) * b(k,178) + b(k,207) = b(k,207) - lu(k,885) * b(k,178) + b(k,209) = b(k,209) - lu(k,886) * b(k,178) + b(k,210) = b(k,210) - lu(k,887) * b(k,178) + b(k,212) = b(k,212) - lu(k,888) * b(k,178) + b(k,214) = b(k,214) - lu(k,889) * b(k,178) + b(k,224) = b(k,224) - lu(k,890) * b(k,178) + b(k,226) = b(k,226) - lu(k,891) * b(k,178) + b(k,231) = b(k,231) - lu(k,892) * b(k,178) + b(k,232) = b(k,232) - lu(k,893) * b(k,178) + b(k,235) = b(k,235) - lu(k,894) * b(k,178) + b(k,236) = b(k,236) - lu(k,895) * b(k,178) end do end subroutine lu_slv03 subroutine lu_slv04( avec_len, lu, b ) @@ -695,218 +701,212 @@ subroutine lu_slv04( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,156) = b(k,156) - lu(k,881) * b(k,154) - b(k,170) = b(k,170) - lu(k,882) * b(k,154) - b(k,181) = b(k,181) - lu(k,883) * b(k,154) - b(k,185) = b(k,185) - lu(k,884) * b(k,154) - b(k,186) = b(k,186) - lu(k,885) * b(k,154) - b(k,187) = b(k,187) - lu(k,886) * b(k,154) - b(k,190) = b(k,190) - lu(k,887) * b(k,154) - b(k,193) = b(k,193) - lu(k,888) * b(k,154) - b(k,197) = b(k,197) - lu(k,889) * b(k,154) - b(k,199) = b(k,199) - lu(k,890) * b(k,154) - b(k,182) = b(k,182) - lu(k,893) * b(k,155) - b(k,190) = b(k,190) - lu(k,894) * b(k,155) - b(k,192) = b(k,192) - lu(k,895) * b(k,155) - b(k,199) = b(k,199) - lu(k,896) * b(k,155) - b(k,201) = b(k,201) - lu(k,897) * b(k,155) - b(k,169) = b(k,169) - lu(k,899) * b(k,156) - b(k,181) = b(k,181) - lu(k,900) * b(k,156) - b(k,185) = b(k,185) - lu(k,901) * b(k,156) - b(k,190) = b(k,190) - lu(k,902) * b(k,156) - b(k,201) = b(k,201) - lu(k,903) * b(k,156) - b(k,183) = b(k,183) - lu(k,907) * b(k,157) - b(k,188) = b(k,188) - lu(k,908) * b(k,157) - b(k,190) = b(k,190) - lu(k,909) * b(k,157) - b(k,192) = b(k,192) - lu(k,910) * b(k,157) - b(k,194) = b(k,194) - lu(k,911) * b(k,157) - b(k,196) = b(k,196) - lu(k,912) * b(k,157) - b(k,197) = b(k,197) - lu(k,913) * b(k,157) - b(k,200) = b(k,200) - lu(k,914) * b(k,157) - b(k,201) = b(k,201) - lu(k,915) * b(k,157) - b(k,163) = b(k,163) - lu(k,917) * b(k,158) - b(k,165) = b(k,165) - lu(k,918) * b(k,158) - b(k,167) = b(k,167) - lu(k,919) * b(k,158) - b(k,168) = b(k,168) - lu(k,920) * b(k,158) - b(k,190) = b(k,190) - lu(k,921) * b(k,158) - b(k,194) = b(k,194) - lu(k,922) * b(k,158) - b(k,199) = b(k,199) - lu(k,923) * b(k,158) - b(k,165) = b(k,165) - lu(k,929) * b(k,159) - b(k,175) = b(k,175) - lu(k,930) * b(k,159) - b(k,181) = b(k,181) - lu(k,931) * b(k,159) - b(k,185) = b(k,185) - lu(k,932) * b(k,159) - b(k,187) = b(k,187) - lu(k,933) * b(k,159) - b(k,190) = b(k,190) - lu(k,934) * b(k,159) - b(k,193) = b(k,193) - lu(k,935) * b(k,159) - b(k,196) = b(k,196) - lu(k,936) * b(k,159) - b(k,197) = b(k,197) - lu(k,937) * b(k,159) - b(k,199) = b(k,199) - lu(k,938) * b(k,159) - b(k,164) = b(k,164) - lu(k,944) * b(k,160) - b(k,165) = b(k,165) - lu(k,945) * b(k,160) - b(k,170) = b(k,170) - lu(k,946) * b(k,160) - b(k,175) = b(k,175) - lu(k,947) * b(k,160) - b(k,181) = b(k,181) - lu(k,948) * b(k,160) - b(k,185) = b(k,185) - lu(k,949) * b(k,160) - b(k,186) = b(k,186) - lu(k,950) * b(k,160) - b(k,187) = b(k,187) - lu(k,951) * b(k,160) - b(k,190) = b(k,190) - lu(k,952) * b(k,160) - b(k,191) = b(k,191) - lu(k,953) * b(k,160) - b(k,193) = b(k,193) - lu(k,954) * b(k,160) - b(k,194) = b(k,194) - lu(k,955) * b(k,160) - b(k,197) = b(k,197) - lu(k,956) * b(k,160) - b(k,199) = b(k,199) - lu(k,957) * b(k,160) - b(k,201) = b(k,201) - lu(k,958) * b(k,160) - b(k,165) = b(k,165) - lu(k,961) * b(k,161) - b(k,190) = b(k,190) - lu(k,962) * b(k,161) - b(k,193) = b(k,193) - lu(k,963) * b(k,161) - b(k,199) = b(k,199) - lu(k,964) * b(k,161) - b(k,164) = b(k,164) - lu(k,969) * b(k,162) - b(k,165) = b(k,165) - lu(k,970) * b(k,162) - b(k,169) = b(k,169) - lu(k,971) * b(k,162) - b(k,170) = b(k,170) - lu(k,972) * b(k,162) - b(k,181) = b(k,181) - lu(k,973) * b(k,162) - b(k,185) = b(k,185) - lu(k,974) * b(k,162) - b(k,190) = b(k,190) - lu(k,975) * b(k,162) - b(k,193) = b(k,193) - lu(k,976) * b(k,162) - b(k,196) = b(k,196) - lu(k,977) * b(k,162) - b(k,197) = b(k,197) - lu(k,978) * b(k,162) - b(k,199) = b(k,199) - lu(k,979) * b(k,162) - b(k,201) = b(k,201) - lu(k,980) * b(k,162) - b(k,165) = b(k,165) - lu(k,983) * b(k,163) - b(k,169) = b(k,169) - lu(k,984) * b(k,163) - b(k,181) = b(k,181) - lu(k,985) * b(k,163) - b(k,185) = b(k,185) - lu(k,986) * b(k,163) - b(k,190) = b(k,190) - lu(k,987) * b(k,163) - b(k,193) = b(k,193) - lu(k,988) * b(k,163) - b(k,199) = b(k,199) - lu(k,989) * b(k,163) - b(k,201) = b(k,201) - lu(k,990) * b(k,163) - b(k,175) = b(k,175) - lu(k,992) * b(k,164) - b(k,181) = b(k,181) - lu(k,993) * b(k,164) - b(k,190) = b(k,190) - lu(k,994) * b(k,164) - b(k,193) = b(k,193) - lu(k,995) * b(k,164) - b(k,199) = b(k,199) - lu(k,996) * b(k,164) - b(k,190) = b(k,190) - lu(k,998) * b(k,165) - b(k,195) = b(k,195) - lu(k,999) * b(k,165) - b(k,199) = b(k,199) - lu(k,1000) * b(k,165) - b(k,167) = b(k,167) - lu(k,1009) * b(k,166) - b(k,168) = b(k,168) - lu(k,1010) * b(k,166) - b(k,169) = b(k,169) - lu(k,1011) * b(k,166) - b(k,181) = b(k,181) - lu(k,1012) * b(k,166) - b(k,185) = b(k,185) - lu(k,1013) * b(k,166) - b(k,187) = b(k,187) - lu(k,1014) * b(k,166) - b(k,190) = b(k,190) - lu(k,1015) * b(k,166) - b(k,193) = b(k,193) - lu(k,1016) * b(k,166) - b(k,194) = b(k,194) - lu(k,1017) * b(k,166) - b(k,195) = b(k,195) - lu(k,1018) * b(k,166) - b(k,196) = b(k,196) - lu(k,1019) * b(k,166) - b(k,197) = b(k,197) - lu(k,1020) * b(k,166) - b(k,199) = b(k,199) - lu(k,1021) * b(k,166) - b(k,201) = b(k,201) - lu(k,1022) * b(k,166) - b(k,169) = b(k,169) - lu(k,1031) * b(k,167) - b(k,181) = b(k,181) - lu(k,1032) * b(k,167) - b(k,185) = b(k,185) - lu(k,1033) * b(k,167) - b(k,187) = b(k,187) - lu(k,1034) * b(k,167) - b(k,190) = b(k,190) - lu(k,1035) * b(k,167) - b(k,193) = b(k,193) - lu(k,1036) * b(k,167) - b(k,195) = b(k,195) - lu(k,1037) * b(k,167) - b(k,196) = b(k,196) - lu(k,1038) * b(k,167) - b(k,197) = b(k,197) - lu(k,1039) * b(k,167) - b(k,199) = b(k,199) - lu(k,1040) * b(k,167) - b(k,201) = b(k,201) - lu(k,1041) * b(k,167) - b(k,169) = b(k,169) - lu(k,1050) * b(k,168) - b(k,181) = b(k,181) - lu(k,1051) * b(k,168) - b(k,185) = b(k,185) - lu(k,1052) * b(k,168) - b(k,187) = b(k,187) - lu(k,1053) * b(k,168) - b(k,190) = b(k,190) - lu(k,1054) * b(k,168) - b(k,193) = b(k,193) - lu(k,1055) * b(k,168) - b(k,194) = b(k,194) - lu(k,1056) * b(k,168) - b(k,195) = b(k,195) - lu(k,1057) * b(k,168) - b(k,196) = b(k,196) - lu(k,1058) * b(k,168) - b(k,197) = b(k,197) - lu(k,1059) * b(k,168) - b(k,199) = b(k,199) - lu(k,1060) * b(k,168) - b(k,201) = b(k,201) - lu(k,1061) * b(k,168) - b(k,175) = b(k,175) - lu(k,1066) * b(k,169) - b(k,181) = b(k,181) - lu(k,1067) * b(k,169) - b(k,185) = b(k,185) - lu(k,1068) * b(k,169) - b(k,187) = b(k,187) - lu(k,1069) * b(k,169) - b(k,190) = b(k,190) - lu(k,1070) * b(k,169) - b(k,193) = b(k,193) - lu(k,1071) * b(k,169) - b(k,197) = b(k,197) - lu(k,1072) * b(k,169) - b(k,199) = b(k,199) - lu(k,1073) * b(k,169) - b(k,201) = b(k,201) - lu(k,1074) * b(k,169) - b(k,181) = b(k,181) - lu(k,1077) * b(k,170) - b(k,185) = b(k,185) - lu(k,1078) * b(k,170) - b(k,190) = b(k,190) - lu(k,1079) * b(k,170) - b(k,194) = b(k,194) - lu(k,1080) * b(k,170) - b(k,195) = b(k,195) - lu(k,1081) * b(k,170) - b(k,196) = b(k,196) - lu(k,1082) * b(k,170) - b(k,199) = b(k,199) - lu(k,1083) * b(k,170) - b(k,201) = b(k,201) - lu(k,1084) * b(k,170) - b(k,175) = b(k,175) - lu(k,1092) * b(k,171) - b(k,181) = b(k,181) - lu(k,1093) * b(k,171) - b(k,185) = b(k,185) - lu(k,1094) * b(k,171) - b(k,187) = b(k,187) - lu(k,1095) * b(k,171) - b(k,190) = b(k,190) - lu(k,1096) * b(k,171) - b(k,193) = b(k,193) - lu(k,1097) * b(k,171) - b(k,194) = b(k,194) - lu(k,1098) * b(k,171) - b(k,195) = b(k,195) - lu(k,1099) * b(k,171) - b(k,197) = b(k,197) - lu(k,1100) * b(k,171) - b(k,199) = b(k,199) - lu(k,1101) * b(k,171) - b(k,183) = b(k,183) - lu(k,1105) * b(k,172) - b(k,185) = b(k,185) - lu(k,1106) * b(k,172) - b(k,188) = b(k,188) - lu(k,1107) * b(k,172) - b(k,189) = b(k,189) - lu(k,1108) * b(k,172) - b(k,190) = b(k,190) - lu(k,1109) * b(k,172) - b(k,192) = b(k,192) - lu(k,1110) * b(k,172) - b(k,194) = b(k,194) - lu(k,1111) * b(k,172) - b(k,195) = b(k,195) - lu(k,1112) * b(k,172) - b(k,196) = b(k,196) - lu(k,1113) * b(k,172) - b(k,201) = b(k,201) - lu(k,1114) * b(k,172) - b(k,174) = b(k,174) - lu(k,1125) * b(k,173) - b(k,175) = b(k,175) - lu(k,1126) * b(k,173) - b(k,179) = b(k,179) - lu(k,1127) * b(k,173) - b(k,181) = b(k,181) - lu(k,1128) * b(k,173) - b(k,185) = b(k,185) - lu(k,1129) * b(k,173) - b(k,187) = b(k,187) - lu(k,1130) * b(k,173) - b(k,190) = b(k,190) - lu(k,1131) * b(k,173) - b(k,193) = b(k,193) - lu(k,1132) * b(k,173) - b(k,194) = b(k,194) - lu(k,1133) * b(k,173) - b(k,195) = b(k,195) - lu(k,1134) * b(k,173) - b(k,196) = b(k,196) - lu(k,1135) * b(k,173) - b(k,197) = b(k,197) - lu(k,1136) * b(k,173) - b(k,199) = b(k,199) - lu(k,1137) * b(k,173) - b(k,175) = b(k,175) - lu(k,1141) * b(k,174) - b(k,178) = b(k,178) - lu(k,1142) * b(k,174) - b(k,180) = b(k,180) - lu(k,1143) * b(k,174) - b(k,181) = b(k,181) - lu(k,1144) * b(k,174) - b(k,190) = b(k,190) - lu(k,1145) * b(k,174) - b(k,191) = b(k,191) - lu(k,1146) * b(k,174) - b(k,193) = b(k,193) - lu(k,1147) * b(k,174) - b(k,195) = b(k,195) - lu(k,1148) * b(k,174) - b(k,199) = b(k,199) - lu(k,1149) * b(k,174) - b(k,201) = b(k,201) - lu(k,1150) * b(k,174) - b(k,181) = b(k,181) - lu(k,1153) * b(k,175) - b(k,190) = b(k,190) - lu(k,1154) * b(k,175) - b(k,194) = b(k,194) - lu(k,1155) * b(k,175) - b(k,195) = b(k,195) - lu(k,1156) * b(k,175) - b(k,196) = b(k,196) - lu(k,1157) * b(k,175) - b(k,199) = b(k,199) - lu(k,1158) * b(k,175) - b(k,201) = b(k,201) - lu(k,1159) * b(k,175) - b(k,178) = b(k,178) - lu(k,1173) * b(k,176) - b(k,179) = b(k,179) - lu(k,1174) * b(k,176) - b(k,180) = b(k,180) - lu(k,1175) * b(k,176) - b(k,181) = b(k,181) - lu(k,1176) * b(k,176) - b(k,185) = b(k,185) - lu(k,1177) * b(k,176) - b(k,187) = b(k,187) - lu(k,1178) * b(k,176) - b(k,190) = b(k,190) - lu(k,1179) * b(k,176) - b(k,191) = b(k,191) - lu(k,1180) * b(k,176) - b(k,193) = b(k,193) - lu(k,1181) * b(k,176) - b(k,194) = b(k,194) - lu(k,1182) * b(k,176) - b(k,195) = b(k,195) - lu(k,1183) * b(k,176) - b(k,196) = b(k,196) - lu(k,1184) * b(k,176) - b(k,197) = b(k,197) - lu(k,1185) * b(k,176) - b(k,199) = b(k,199) - lu(k,1186) * b(k,176) - b(k,201) = b(k,201) - lu(k,1187) * b(k,176) + b(k,198) = b(k,198) - lu(k,900) * b(k,179) + b(k,220) = b(k,220) - lu(k,901) * b(k,179) + b(k,224) = b(k,224) - lu(k,902) * b(k,179) + b(k,225) = b(k,225) - lu(k,903) * b(k,179) + b(k,229) = b(k,229) - lu(k,904) * b(k,179) + b(k,231) = b(k,231) - lu(k,905) * b(k,179) + b(k,232) = b(k,232) - lu(k,906) * b(k,179) + b(k,235) = b(k,235) - lu(k,907) * b(k,179) + b(k,215) = b(k,215) - lu(k,909) * b(k,180) + b(k,224) = b(k,224) - lu(k,910) * b(k,180) + b(k,231) = b(k,231) - lu(k,911) * b(k,180) + b(k,237) = b(k,237) - lu(k,912) * b(k,180) + b(k,190) = b(k,190) - lu(k,914) * b(k,181) + b(k,199) = b(k,199) - lu(k,915) * b(k,181) + b(k,208) = b(k,208) - lu(k,916) * b(k,181) + b(k,224) = b(k,224) - lu(k,917) * b(k,181) + b(k,225) = b(k,225) - lu(k,918) * b(k,181) + b(k,229) = b(k,229) - lu(k,919) * b(k,181) + b(k,231) = b(k,231) - lu(k,920) * b(k,181) + b(k,232) = b(k,232) - lu(k,921) * b(k,181) + b(k,216) = b(k,216) - lu(k,924) * b(k,182) + b(k,224) = b(k,224) - lu(k,925) * b(k,182) + b(k,226) = b(k,226) - lu(k,926) * b(k,182) + b(k,228) = b(k,228) - lu(k,927) * b(k,182) + b(k,230) = b(k,230) - lu(k,928) * b(k,182) + b(k,232) = b(k,232) - lu(k,929) * b(k,182) + b(k,233) = b(k,233) - lu(k,930) * b(k,182) + b(k,237) = b(k,237) - lu(k,931) * b(k,182) + b(k,193) = b(k,193) - lu(k,934) * b(k,183) + b(k,198) = b(k,198) - lu(k,935) * b(k,183) + b(k,220) = b(k,220) - lu(k,936) * b(k,183) + b(k,224) = b(k,224) - lu(k,937) * b(k,183) + b(k,225) = b(k,225) - lu(k,938) * b(k,183) + b(k,229) = b(k,229) - lu(k,939) * b(k,183) + b(k,231) = b(k,231) - lu(k,940) * b(k,183) + b(k,232) = b(k,232) - lu(k,941) * b(k,183) + b(k,235) = b(k,235) - lu(k,942) * b(k,183) + b(k,237) = b(k,237) - lu(k,943) * b(k,183) + b(k,217) = b(k,217) - lu(k,946) * b(k,184) + b(k,224) = b(k,224) - lu(k,947) * b(k,184) + b(k,231) = b(k,231) - lu(k,948) * b(k,184) + b(k,234) = b(k,234) - lu(k,949) * b(k,184) + b(k,237) = b(k,237) - lu(k,950) * b(k,184) + b(k,218) = b(k,218) - lu(k,954) * b(k,185) + b(k,222) = b(k,222) - lu(k,955) * b(k,185) + b(k,224) = b(k,224) - lu(k,956) * b(k,185) + b(k,225) = b(k,225) - lu(k,957) * b(k,185) + b(k,226) = b(k,226) - lu(k,958) * b(k,185) + b(k,227) = b(k,227) - lu(k,959) * b(k,185) + b(k,228) = b(k,228) - lu(k,960) * b(k,185) + b(k,234) = b(k,234) - lu(k,961) * b(k,185) + b(k,237) = b(k,237) - lu(k,962) * b(k,185) + b(k,199) = b(k,199) - lu(k,970) * b(k,186) + b(k,215) = b(k,215) - lu(k,971) * b(k,186) + b(k,220) = b(k,220) - lu(k,972) * b(k,186) + b(k,223) = b(k,223) - lu(k,973) * b(k,186) + b(k,224) = b(k,224) - lu(k,974) * b(k,186) + b(k,225) = b(k,225) - lu(k,975) * b(k,186) + b(k,229) = b(k,229) - lu(k,976) * b(k,186) + b(k,230) = b(k,230) - lu(k,977) * b(k,186) + b(k,234) = b(k,234) - lu(k,978) * b(k,186) + b(k,189) = b(k,189) - lu(k,989) * b(k,187) + b(k,190) = b(k,190) - lu(k,990) * b(k,187) + b(k,191) = b(k,191) - lu(k,991) * b(k,187) + b(k,192) = b(k,192) - lu(k,992) * b(k,187) + b(k,193) = b(k,193) - lu(k,993) * b(k,187) + b(k,194) = b(k,194) - lu(k,994) * b(k,187) + b(k,195) = b(k,195) - lu(k,995) * b(k,187) + b(k,199) = b(k,199) - lu(k,996) * b(k,187) + b(k,204) = b(k,204) - lu(k,997) * b(k,187) + b(k,208) = b(k,208) - lu(k,998) * b(k,187) + b(k,214) = b(k,214) - lu(k,999) * b(k,187) + b(k,215) = b(k,215) - lu(k,1000) * b(k,187) + b(k,224) = b(k,224) - lu(k,1001) * b(k,187) + b(k,226) = b(k,226) - lu(k,1002) * b(k,187) + b(k,231) = b(k,231) - lu(k,1003) * b(k,187) + b(k,235) = b(k,235) - lu(k,1004) * b(k,187) + b(k,236) = b(k,236) - lu(k,1005) * b(k,187) + b(k,237) = b(k,237) - lu(k,1006) * b(k,187) + b(k,189) = b(k,189) - lu(k,1017) * b(k,188) + b(k,190) = b(k,190) - lu(k,1018) * b(k,188) + b(k,191) = b(k,191) - lu(k,1019) * b(k,188) + b(k,192) = b(k,192) - lu(k,1020) * b(k,188) + b(k,193) = b(k,193) - lu(k,1021) * b(k,188) + b(k,194) = b(k,194) - lu(k,1022) * b(k,188) + b(k,195) = b(k,195) - lu(k,1023) * b(k,188) + b(k,199) = b(k,199) - lu(k,1024) * b(k,188) + b(k,204) = b(k,204) - lu(k,1025) * b(k,188) + b(k,208) = b(k,208) - lu(k,1026) * b(k,188) + b(k,214) = b(k,214) - lu(k,1027) * b(k,188) + b(k,215) = b(k,215) - lu(k,1028) * b(k,188) + b(k,224) = b(k,224) - lu(k,1029) * b(k,188) + b(k,226) = b(k,226) - lu(k,1030) * b(k,188) + b(k,231) = b(k,231) - lu(k,1031) * b(k,188) + b(k,235) = b(k,235) - lu(k,1032) * b(k,188) + b(k,236) = b(k,236) - lu(k,1033) * b(k,188) + b(k,237) = b(k,237) - lu(k,1034) * b(k,188) + b(k,193) = b(k,193) - lu(k,1041) * b(k,189) + b(k,198) = b(k,198) - lu(k,1042) * b(k,189) + b(k,214) = b(k,214) - lu(k,1043) * b(k,189) + b(k,220) = b(k,220) - lu(k,1044) * b(k,189) + b(k,224) = b(k,224) - lu(k,1045) * b(k,189) + b(k,225) = b(k,225) - lu(k,1046) * b(k,189) + b(k,229) = b(k,229) - lu(k,1047) * b(k,189) + b(k,231) = b(k,231) - lu(k,1048) * b(k,189) + b(k,232) = b(k,232) - lu(k,1049) * b(k,189) + b(k,235) = b(k,235) - lu(k,1050) * b(k,189) + b(k,199) = b(k,199) - lu(k,1053) * b(k,190) + b(k,215) = b(k,215) - lu(k,1054) * b(k,190) + b(k,224) = b(k,224) - lu(k,1055) * b(k,190) + b(k,231) = b(k,231) - lu(k,1056) * b(k,190) + b(k,192) = b(k,192) - lu(k,1061) * b(k,191) + b(k,193) = b(k,193) - lu(k,1062) * b(k,191) + b(k,224) = b(k,224) - lu(k,1063) * b(k,191) + b(k,225) = b(k,225) - lu(k,1064) * b(k,191) + b(k,228) = b(k,228) - lu(k,1065) * b(k,191) + b(k,229) = b(k,229) - lu(k,1066) * b(k,191) + b(k,231) = b(k,231) - lu(k,1067) * b(k,191) + b(k,232) = b(k,232) - lu(k,1068) * b(k,191) + b(k,235) = b(k,235) - lu(k,1069) * b(k,191) + b(k,194) = b(k,194) - lu(k,1071) * b(k,192) + b(k,195) = b(k,195) - lu(k,1072) * b(k,192) + b(k,199) = b(k,199) - lu(k,1073) * b(k,192) + b(k,201) = b(k,201) - lu(k,1074) * b(k,192) + b(k,224) = b(k,224) - lu(k,1075) * b(k,192) + b(k,226) = b(k,226) - lu(k,1076) * b(k,192) + b(k,231) = b(k,231) - lu(k,1077) * b(k,192) + b(k,204) = b(k,204) - lu(k,1079) * b(k,193) + b(k,214) = b(k,214) - lu(k,1080) * b(k,193) + b(k,224) = b(k,224) - lu(k,1081) * b(k,193) + b(k,232) = b(k,232) - lu(k,1082) * b(k,193) + b(k,237) = b(k,237) - lu(k,1083) * b(k,193) + b(k,195) = b(k,195) - lu(k,1089) * b(k,194) + b(k,199) = b(k,199) - lu(k,1090) * b(k,194) + b(k,201) = b(k,201) - lu(k,1091) * b(k,194) + b(k,224) = b(k,224) - lu(k,1092) * b(k,194) + b(k,225) = b(k,225) - lu(k,1093) * b(k,194) + b(k,226) = b(k,226) - lu(k,1094) * b(k,194) + b(k,228) = b(k,228) - lu(k,1095) * b(k,194) + b(k,229) = b(k,229) - lu(k,1096) * b(k,194) + b(k,231) = b(k,231) - lu(k,1097) * b(k,194) + b(k,232) = b(k,232) - lu(k,1098) * b(k,194) + b(k,235) = b(k,235) - lu(k,1099) * b(k,194) + b(k,199) = b(k,199) - lu(k,1102) * b(k,195) + b(k,204) = b(k,204) - lu(k,1103) * b(k,195) + b(k,214) = b(k,214) - lu(k,1104) * b(k,195) + b(k,215) = b(k,215) - lu(k,1105) * b(k,195) + b(k,224) = b(k,224) - lu(k,1106) * b(k,195) + b(k,231) = b(k,231) - lu(k,1107) * b(k,195) + b(k,232) = b(k,232) - lu(k,1108) * b(k,195) + b(k,235) = b(k,235) - lu(k,1109) * b(k,195) + b(k,237) = b(k,237) - lu(k,1110) * b(k,195) + b(k,199) = b(k,199) - lu(k,1116) * b(k,196) + b(k,208) = b(k,208) - lu(k,1117) * b(k,196) + b(k,214) = b(k,214) - lu(k,1118) * b(k,196) + b(k,215) = b(k,215) - lu(k,1119) * b(k,196) + b(k,224) = b(k,224) - lu(k,1120) * b(k,196) + b(k,225) = b(k,225) - lu(k,1121) * b(k,196) + b(k,228) = b(k,228) - lu(k,1122) * b(k,196) + b(k,229) = b(k,229) - lu(k,1123) * b(k,196) + b(k,231) = b(k,231) - lu(k,1124) * b(k,196) + b(k,232) = b(k,232) - lu(k,1125) * b(k,196) + b(k,235) = b(k,235) - lu(k,1126) * b(k,196) + b(k,198) = b(k,198) - lu(k,1132) * b(k,197) + b(k,199) = b(k,199) - lu(k,1133) * b(k,197) + b(k,203) = b(k,203) - lu(k,1134) * b(k,197) + b(k,208) = b(k,208) - lu(k,1135) * b(k,197) + b(k,214) = b(k,214) - lu(k,1136) * b(k,197) + b(k,215) = b(k,215) - lu(k,1137) * b(k,197) + b(k,220) = b(k,220) - lu(k,1138) * b(k,197) + b(k,224) = b(k,224) - lu(k,1139) * b(k,197) + b(k,225) = b(k,225) - lu(k,1140) * b(k,197) + b(k,226) = b(k,226) - lu(k,1141) * b(k,197) + b(k,229) = b(k,229) - lu(k,1142) * b(k,197) + b(k,231) = b(k,231) - lu(k,1143) * b(k,197) + b(k,232) = b(k,232) - lu(k,1144) * b(k,197) + b(k,233) = b(k,233) - lu(k,1145) * b(k,197) + b(k,235) = b(k,235) - lu(k,1146) * b(k,197) + b(k,236) = b(k,236) - lu(k,1147) * b(k,197) + b(k,237) = b(k,237) - lu(k,1148) * b(k,197) + b(k,199) = b(k,199) - lu(k,1150) * b(k,198) + b(k,214) = b(k,214) - lu(k,1151) * b(k,198) + b(k,224) = b(k,224) - lu(k,1152) * b(k,198) + b(k,226) = b(k,226) - lu(k,1153) * b(k,198) + b(k,228) = b(k,228) - lu(k,1154) * b(k,198) + b(k,231) = b(k,231) - lu(k,1155) * b(k,198) + b(k,232) = b(k,232) - lu(k,1156) * b(k,198) + b(k,237) = b(k,237) - lu(k,1157) * b(k,198) + b(k,215) = b(k,215) - lu(k,1159) * b(k,199) + b(k,224) = b(k,224) - lu(k,1160) * b(k,199) + b(k,231) = b(k,231) - lu(k,1161) * b(k,199) + b(k,215) = b(k,215) - lu(k,1165) * b(k,200) + b(k,224) = b(k,224) - lu(k,1166) * b(k,200) + b(k,231) = b(k,231) - lu(k,1167) * b(k,200) + b(k,235) = b(k,235) - lu(k,1168) * b(k,200) + b(k,204) = b(k,204) - lu(k,1177) * b(k,201) + b(k,214) = b(k,214) - lu(k,1178) * b(k,201) + b(k,215) = b(k,215) - lu(k,1179) * b(k,201) + b(k,224) = b(k,224) - lu(k,1180) * b(k,201) + b(k,225) = b(k,225) - lu(k,1181) * b(k,201) + b(k,228) = b(k,228) - lu(k,1182) * b(k,201) + b(k,229) = b(k,229) - lu(k,1183) * b(k,201) + b(k,231) = b(k,231) - lu(k,1184) * b(k,201) + b(k,232) = b(k,232) - lu(k,1185) * b(k,201) + b(k,235) = b(k,235) - lu(k,1186) * b(k,201) + b(k,237) = b(k,237) - lu(k,1187) * b(k,201) end do end subroutine lu_slv04 subroutine lu_slv05( avec_len, lu, b ) @@ -927,209 +927,210 @@ subroutine lu_slv05( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,178) = b(k,178) - lu(k,1207) * b(k,177) - b(k,179) = b(k,179) - lu(k,1208) * b(k,177) - b(k,180) = b(k,180) - lu(k,1209) * b(k,177) - b(k,181) = b(k,181) - lu(k,1210) * b(k,177) - b(k,185) = b(k,185) - lu(k,1211) * b(k,177) - b(k,187) = b(k,187) - lu(k,1212) * b(k,177) - b(k,190) = b(k,190) - lu(k,1213) * b(k,177) - b(k,191) = b(k,191) - lu(k,1214) * b(k,177) - b(k,193) = b(k,193) - lu(k,1215) * b(k,177) - b(k,194) = b(k,194) - lu(k,1216) * b(k,177) - b(k,195) = b(k,195) - lu(k,1217) * b(k,177) - b(k,196) = b(k,196) - lu(k,1218) * b(k,177) - b(k,197) = b(k,197) - lu(k,1219) * b(k,177) - b(k,199) = b(k,199) - lu(k,1220) * b(k,177) - b(k,201) = b(k,201) - lu(k,1221) * b(k,177) - b(k,180) = b(k,180) - lu(k,1232) * b(k,178) - b(k,181) = b(k,181) - lu(k,1233) * b(k,178) - b(k,185) = b(k,185) - lu(k,1234) * b(k,178) - b(k,187) = b(k,187) - lu(k,1235) * b(k,178) - b(k,190) = b(k,190) - lu(k,1236) * b(k,178) - b(k,193) = b(k,193) - lu(k,1237) * b(k,178) - b(k,194) = b(k,194) - lu(k,1238) * b(k,178) - b(k,195) = b(k,195) - lu(k,1239) * b(k,178) - b(k,196) = b(k,196) - lu(k,1240) * b(k,178) - b(k,197) = b(k,197) - lu(k,1241) * b(k,178) - b(k,199) = b(k,199) - lu(k,1242) * b(k,178) - b(k,201) = b(k,201) - lu(k,1243) * b(k,178) - b(k,180) = b(k,180) - lu(k,1252) * b(k,179) - b(k,181) = b(k,181) - lu(k,1253) * b(k,179) - b(k,185) = b(k,185) - lu(k,1254) * b(k,179) - b(k,186) = b(k,186) - lu(k,1255) * b(k,179) - b(k,187) = b(k,187) - lu(k,1256) * b(k,179) - b(k,190) = b(k,190) - lu(k,1257) * b(k,179) - b(k,191) = b(k,191) - lu(k,1258) * b(k,179) - b(k,193) = b(k,193) - lu(k,1259) * b(k,179) - b(k,194) = b(k,194) - lu(k,1260) * b(k,179) - b(k,195) = b(k,195) - lu(k,1261) * b(k,179) - b(k,196) = b(k,196) - lu(k,1262) * b(k,179) - b(k,197) = b(k,197) - lu(k,1263) * b(k,179) - b(k,199) = b(k,199) - lu(k,1264) * b(k,179) - b(k,201) = b(k,201) - lu(k,1265) * b(k,179) - b(k,181) = b(k,181) - lu(k,1272) * b(k,180) - b(k,185) = b(k,185) - lu(k,1273) * b(k,180) - b(k,187) = b(k,187) - lu(k,1274) * b(k,180) - b(k,190) = b(k,190) - lu(k,1275) * b(k,180) - b(k,191) = b(k,191) - lu(k,1276) * b(k,180) - b(k,193) = b(k,193) - lu(k,1277) * b(k,180) - b(k,194) = b(k,194) - lu(k,1278) * b(k,180) - b(k,195) = b(k,195) - lu(k,1279) * b(k,180) - b(k,196) = b(k,196) - lu(k,1280) * b(k,180) - b(k,197) = b(k,197) - lu(k,1281) * b(k,180) - b(k,199) = b(k,199) - lu(k,1282) * b(k,180) - b(k,201) = b(k,201) - lu(k,1283) * b(k,180) - b(k,185) = b(k,185) - lu(k,1303) * b(k,181) - b(k,186) = b(k,186) - lu(k,1304) * b(k,181) - b(k,187) = b(k,187) - lu(k,1305) * b(k,181) - b(k,190) = b(k,190) - lu(k,1306) * b(k,181) - b(k,191) = b(k,191) - lu(k,1307) * b(k,181) - b(k,193) = b(k,193) - lu(k,1308) * b(k,181) - b(k,194) = b(k,194) - lu(k,1309) * b(k,181) - b(k,195) = b(k,195) - lu(k,1310) * b(k,181) - b(k,196) = b(k,196) - lu(k,1311) * b(k,181) - b(k,197) = b(k,197) - lu(k,1312) * b(k,181) - b(k,199) = b(k,199) - lu(k,1313) * b(k,181) - b(k,201) = b(k,201) - lu(k,1314) * b(k,181) - b(k,184) = b(k,184) - lu(k,1319) * b(k,182) - b(k,186) = b(k,186) - lu(k,1320) * b(k,182) - b(k,187) = b(k,187) - lu(k,1321) * b(k,182) - b(k,188) = b(k,188) - lu(k,1322) * b(k,182) - b(k,190) = b(k,190) - lu(k,1323) * b(k,182) - b(k,191) = b(k,191) - lu(k,1324) * b(k,182) - b(k,192) = b(k,192) - lu(k,1325) * b(k,182) - b(k,195) = b(k,195) - lu(k,1326) * b(k,182) - b(k,197) = b(k,197) - lu(k,1327) * b(k,182) - b(k,198) = b(k,198) - lu(k,1328) * b(k,182) - b(k,199) = b(k,199) - lu(k,1329) * b(k,182) - b(k,200) = b(k,200) - lu(k,1330) * b(k,182) - b(k,201) = b(k,201) - lu(k,1331) * b(k,182) - b(k,184) = b(k,184) - lu(k,1338) * b(k,183) - b(k,188) = b(k,188) - lu(k,1339) * b(k,183) - b(k,189) = b(k,189) - lu(k,1340) * b(k,183) - b(k,190) = b(k,190) - lu(k,1341) * b(k,183) - b(k,192) = b(k,192) - lu(k,1342) * b(k,183) - b(k,194) = b(k,194) - lu(k,1343) * b(k,183) - b(k,195) = b(k,195) - lu(k,1344) * b(k,183) - b(k,196) = b(k,196) - lu(k,1345) * b(k,183) - b(k,197) = b(k,197) - lu(k,1346) * b(k,183) - b(k,198) = b(k,198) - lu(k,1347) * b(k,183) - b(k,200) = b(k,200) - lu(k,1348) * b(k,183) - b(k,201) = b(k,201) - lu(k,1349) * b(k,183) - b(k,186) = b(k,186) - lu(k,1353) * b(k,184) - b(k,189) = b(k,189) - lu(k,1354) * b(k,184) - b(k,190) = b(k,190) - lu(k,1355) * b(k,184) - b(k,191) = b(k,191) - lu(k,1356) * b(k,184) - b(k,192) = b(k,192) - lu(k,1357) * b(k,184) - b(k,193) = b(k,193) - lu(k,1358) * b(k,184) - b(k,195) = b(k,195) - lu(k,1359) * b(k,184) - b(k,198) = b(k,198) - lu(k,1360) * b(k,184) - b(k,199) = b(k,199) - lu(k,1361) * b(k,184) - b(k,201) = b(k,201) - lu(k,1362) * b(k,184) - b(k,186) = b(k,186) - lu(k,1397) * b(k,185) - b(k,187) = b(k,187) - lu(k,1398) * b(k,185) - b(k,188) = b(k,188) - lu(k,1399) * b(k,185) - b(k,190) = b(k,190) - lu(k,1400) * b(k,185) - b(k,191) = b(k,191) - lu(k,1401) * b(k,185) - b(k,193) = b(k,193) - lu(k,1402) * b(k,185) - b(k,194) = b(k,194) - lu(k,1403) * b(k,185) - b(k,195) = b(k,195) - lu(k,1404) * b(k,185) - b(k,196) = b(k,196) - lu(k,1405) * b(k,185) - b(k,197) = b(k,197) - lu(k,1406) * b(k,185) - b(k,199) = b(k,199) - lu(k,1407) * b(k,185) - b(k,200) = b(k,200) - lu(k,1408) * b(k,185) - b(k,201) = b(k,201) - lu(k,1409) * b(k,185) - b(k,187) = b(k,187) - lu(k,1428) * b(k,186) - b(k,188) = b(k,188) - lu(k,1429) * b(k,186) - b(k,189) = b(k,189) - lu(k,1430) * b(k,186) - b(k,190) = b(k,190) - lu(k,1431) * b(k,186) - b(k,191) = b(k,191) - lu(k,1432) * b(k,186) - b(k,192) = b(k,192) - lu(k,1433) * b(k,186) - b(k,193) = b(k,193) - lu(k,1434) * b(k,186) - b(k,195) = b(k,195) - lu(k,1435) * b(k,186) - b(k,197) = b(k,197) - lu(k,1436) * b(k,186) - b(k,198) = b(k,198) - lu(k,1437) * b(k,186) - b(k,199) = b(k,199) - lu(k,1438) * b(k,186) - b(k,200) = b(k,200) - lu(k,1439) * b(k,186) - b(k,201) = b(k,201) - lu(k,1440) * b(k,186) - b(k,188) = b(k,188) - lu(k,1508) * b(k,187) - b(k,189) = b(k,189) - lu(k,1509) * b(k,187) - b(k,190) = b(k,190) - lu(k,1510) * b(k,187) - b(k,191) = b(k,191) - lu(k,1511) * b(k,187) - b(k,192) = b(k,192) - lu(k,1512) * b(k,187) - b(k,193) = b(k,193) - lu(k,1513) * b(k,187) - b(k,194) = b(k,194) - lu(k,1514) * b(k,187) - b(k,195) = b(k,195) - lu(k,1515) * b(k,187) - b(k,196) = b(k,196) - lu(k,1516) * b(k,187) - b(k,197) = b(k,197) - lu(k,1517) * b(k,187) - b(k,198) = b(k,198) - lu(k,1518) * b(k,187) - b(k,199) = b(k,199) - lu(k,1519) * b(k,187) - b(k,200) = b(k,200) - lu(k,1520) * b(k,187) - b(k,201) = b(k,201) - lu(k,1521) * b(k,187) - b(k,189) = b(k,189) - lu(k,1544) * b(k,188) - b(k,190) = b(k,190) - lu(k,1545) * b(k,188) - b(k,191) = b(k,191) - lu(k,1546) * b(k,188) - b(k,192) = b(k,192) - lu(k,1547) * b(k,188) - b(k,193) = b(k,193) - lu(k,1548) * b(k,188) - b(k,194) = b(k,194) - lu(k,1549) * b(k,188) - b(k,195) = b(k,195) - lu(k,1550) * b(k,188) - b(k,196) = b(k,196) - lu(k,1551) * b(k,188) - b(k,197) = b(k,197) - lu(k,1552) * b(k,188) - b(k,198) = b(k,198) - lu(k,1553) * b(k,188) - b(k,199) = b(k,199) - lu(k,1554) * b(k,188) - b(k,200) = b(k,200) - lu(k,1555) * b(k,188) - b(k,201) = b(k,201) - lu(k,1556) * b(k,188) - b(k,190) = b(k,190) - lu(k,1571) * b(k,189) - b(k,191) = b(k,191) - lu(k,1572) * b(k,189) - b(k,192) = b(k,192) - lu(k,1573) * b(k,189) - b(k,193) = b(k,193) - lu(k,1574) * b(k,189) - b(k,194) = b(k,194) - lu(k,1575) * b(k,189) - b(k,195) = b(k,195) - lu(k,1576) * b(k,189) - b(k,196) = b(k,196) - lu(k,1577) * b(k,189) - b(k,197) = b(k,197) - lu(k,1578) * b(k,189) - b(k,198) = b(k,198) - lu(k,1579) * b(k,189) - b(k,199) = b(k,199) - lu(k,1580) * b(k,189) - b(k,200) = b(k,200) - lu(k,1581) * b(k,189) - b(k,201) = b(k,201) - lu(k,1582) * b(k,189) - b(k,191) = b(k,191) - lu(k,1720) * b(k,190) - b(k,192) = b(k,192) - lu(k,1721) * b(k,190) - b(k,193) = b(k,193) - lu(k,1722) * b(k,190) - b(k,194) = b(k,194) - lu(k,1723) * b(k,190) - b(k,195) = b(k,195) - lu(k,1724) * b(k,190) - b(k,196) = b(k,196) - lu(k,1725) * b(k,190) - b(k,197) = b(k,197) - lu(k,1726) * b(k,190) - b(k,198) = b(k,198) - lu(k,1727) * b(k,190) - b(k,199) = b(k,199) - lu(k,1728) * b(k,190) - b(k,200) = b(k,200) - lu(k,1729) * b(k,190) - b(k,201) = b(k,201) - lu(k,1730) * b(k,190) - b(k,192) = b(k,192) - lu(k,1783) * b(k,191) - b(k,193) = b(k,193) - lu(k,1784) * b(k,191) - b(k,194) = b(k,194) - lu(k,1785) * b(k,191) - b(k,195) = b(k,195) - lu(k,1786) * b(k,191) - b(k,196) = b(k,196) - lu(k,1787) * b(k,191) - b(k,197) = b(k,197) - lu(k,1788) * b(k,191) - b(k,198) = b(k,198) - lu(k,1789) * b(k,191) - b(k,199) = b(k,199) - lu(k,1790) * b(k,191) - b(k,200) = b(k,200) - lu(k,1791) * b(k,191) - b(k,201) = b(k,201) - lu(k,1792) * b(k,191) - b(k,193) = b(k,193) - lu(k,1825) * b(k,192) - b(k,194) = b(k,194) - lu(k,1826) * b(k,192) - b(k,195) = b(k,195) - lu(k,1827) * b(k,192) - b(k,196) = b(k,196) - lu(k,1828) * b(k,192) - b(k,197) = b(k,197) - lu(k,1829) * b(k,192) - b(k,198) = b(k,198) - lu(k,1830) * b(k,192) - b(k,199) = b(k,199) - lu(k,1831) * b(k,192) - b(k,200) = b(k,200) - lu(k,1832) * b(k,192) - b(k,201) = b(k,201) - lu(k,1833) * b(k,192) - b(k,194) = b(k,194) - lu(k,1850) * b(k,193) - b(k,195) = b(k,195) - lu(k,1851) * b(k,193) - b(k,196) = b(k,196) - lu(k,1852) * b(k,193) - b(k,197) = b(k,197) - lu(k,1853) * b(k,193) - b(k,198) = b(k,198) - lu(k,1854) * b(k,193) - b(k,199) = b(k,199) - lu(k,1855) * b(k,193) - b(k,200) = b(k,200) - lu(k,1856) * b(k,193) - b(k,201) = b(k,201) - lu(k,1857) * b(k,193) + b(k,203) = b(k,203) - lu(k,1194) * b(k,202) + b(k,204) = b(k,204) - lu(k,1195) * b(k,202) + b(k,214) = b(k,214) - lu(k,1196) * b(k,202) + b(k,215) = b(k,215) - lu(k,1197) * b(k,202) + b(k,224) = b(k,224) - lu(k,1198) * b(k,202) + b(k,225) = b(k,225) - lu(k,1199) * b(k,202) + b(k,226) = b(k,226) - lu(k,1200) * b(k,202) + b(k,228) = b(k,228) - lu(k,1201) * b(k,202) + b(k,231) = b(k,231) - lu(k,1202) * b(k,202) + b(k,232) = b(k,232) - lu(k,1203) * b(k,202) + b(k,235) = b(k,235) - lu(k,1204) * b(k,202) + b(k,237) = b(k,237) - lu(k,1205) * b(k,202) + b(k,208) = b(k,208) - lu(k,1207) * b(k,203) + b(k,214) = b(k,214) - lu(k,1208) * b(k,203) + b(k,224) = b(k,224) - lu(k,1209) * b(k,203) + b(k,231) = b(k,231) - lu(k,1210) * b(k,203) + b(k,235) = b(k,235) - lu(k,1211) * b(k,203) + b(k,208) = b(k,208) - lu(k,1216) * b(k,204) + b(k,214) = b(k,214) - lu(k,1217) * b(k,204) + b(k,224) = b(k,224) - lu(k,1218) * b(k,204) + b(k,225) = b(k,225) - lu(k,1219) * b(k,204) + b(k,229) = b(k,229) - lu(k,1220) * b(k,204) + b(k,231) = b(k,231) - lu(k,1221) * b(k,204) + b(k,232) = b(k,232) - lu(k,1222) * b(k,204) + b(k,235) = b(k,235) - lu(k,1223) * b(k,204) + b(k,237) = b(k,237) - lu(k,1224) * b(k,204) + b(k,208) = b(k,208) - lu(k,1232) * b(k,205) + b(k,214) = b(k,214) - lu(k,1233) * b(k,205) + b(k,215) = b(k,215) - lu(k,1234) * b(k,205) + b(k,224) = b(k,224) - lu(k,1235) * b(k,205) + b(k,225) = b(k,225) - lu(k,1236) * b(k,205) + b(k,226) = b(k,226) - lu(k,1237) * b(k,205) + b(k,229) = b(k,229) - lu(k,1238) * b(k,205) + b(k,231) = b(k,231) - lu(k,1239) * b(k,205) + b(k,232) = b(k,232) - lu(k,1240) * b(k,205) + b(k,235) = b(k,235) - lu(k,1241) * b(k,205) + b(k,207) = b(k,207) - lu(k,1252) * b(k,206) + b(k,208) = b(k,208) - lu(k,1253) * b(k,206) + b(k,212) = b(k,212) - lu(k,1254) * b(k,206) + b(k,214) = b(k,214) - lu(k,1255) * b(k,206) + b(k,215) = b(k,215) - lu(k,1256) * b(k,206) + b(k,224) = b(k,224) - lu(k,1257) * b(k,206) + b(k,225) = b(k,225) - lu(k,1258) * b(k,206) + b(k,226) = b(k,226) - lu(k,1259) * b(k,206) + b(k,228) = b(k,228) - lu(k,1260) * b(k,206) + b(k,229) = b(k,229) - lu(k,1261) * b(k,206) + b(k,231) = b(k,231) - lu(k,1262) * b(k,206) + b(k,232) = b(k,232) - lu(k,1263) * b(k,206) + b(k,235) = b(k,235) - lu(k,1264) * b(k,206) + b(k,208) = b(k,208) - lu(k,1268) * b(k,207) + b(k,211) = b(k,211) - lu(k,1269) * b(k,207) + b(k,213) = b(k,213) - lu(k,1270) * b(k,207) + b(k,214) = b(k,214) - lu(k,1271) * b(k,207) + b(k,215) = b(k,215) - lu(k,1272) * b(k,207) + b(k,224) = b(k,224) - lu(k,1273) * b(k,207) + b(k,231) = b(k,231) - lu(k,1274) * b(k,207) + b(k,235) = b(k,235) - lu(k,1275) * b(k,207) + b(k,236) = b(k,236) - lu(k,1276) * b(k,207) + b(k,237) = b(k,237) - lu(k,1277) * b(k,207) + b(k,214) = b(k,214) - lu(k,1280) * b(k,208) + b(k,215) = b(k,215) - lu(k,1281) * b(k,208) + b(k,224) = b(k,224) - lu(k,1282) * b(k,208) + b(k,226) = b(k,226) - lu(k,1283) * b(k,208) + b(k,228) = b(k,228) - lu(k,1284) * b(k,208) + b(k,231) = b(k,231) - lu(k,1285) * b(k,208) + b(k,237) = b(k,237) - lu(k,1286) * b(k,208) + b(k,211) = b(k,211) - lu(k,1298) * b(k,209) + b(k,212) = b(k,212) - lu(k,1299) * b(k,209) + b(k,213) = b(k,213) - lu(k,1300) * b(k,209) + b(k,214) = b(k,214) - lu(k,1301) * b(k,209) + b(k,215) = b(k,215) - lu(k,1302) * b(k,209) + b(k,224) = b(k,224) - lu(k,1303) * b(k,209) + b(k,225) = b(k,225) - lu(k,1304) * b(k,209) + b(k,226) = b(k,226) - lu(k,1305) * b(k,209) + b(k,228) = b(k,228) - lu(k,1306) * b(k,209) + b(k,229) = b(k,229) - lu(k,1307) * b(k,209) + b(k,231) = b(k,231) - lu(k,1308) * b(k,209) + b(k,232) = b(k,232) - lu(k,1309) * b(k,209) + b(k,235) = b(k,235) - lu(k,1310) * b(k,209) + b(k,236) = b(k,236) - lu(k,1311) * b(k,209) + b(k,237) = b(k,237) - lu(k,1312) * b(k,209) + b(k,211) = b(k,211) - lu(k,1331) * b(k,210) + b(k,212) = b(k,212) - lu(k,1332) * b(k,210) + b(k,213) = b(k,213) - lu(k,1333) * b(k,210) + b(k,214) = b(k,214) - lu(k,1334) * b(k,210) + b(k,215) = b(k,215) - lu(k,1335) * b(k,210) + b(k,224) = b(k,224) - lu(k,1336) * b(k,210) + b(k,225) = b(k,225) - lu(k,1337) * b(k,210) + b(k,226) = b(k,226) - lu(k,1338) * b(k,210) + b(k,228) = b(k,228) - lu(k,1339) * b(k,210) + b(k,229) = b(k,229) - lu(k,1340) * b(k,210) + b(k,231) = b(k,231) - lu(k,1341) * b(k,210) + b(k,232) = b(k,232) - lu(k,1342) * b(k,210) + b(k,235) = b(k,235) - lu(k,1343) * b(k,210) + b(k,236) = b(k,236) - lu(k,1344) * b(k,210) + b(k,237) = b(k,237) - lu(k,1345) * b(k,210) + b(k,213) = b(k,213) - lu(k,1355) * b(k,211) + b(k,214) = b(k,214) - lu(k,1356) * b(k,211) + b(k,215) = b(k,215) - lu(k,1357) * b(k,211) + b(k,224) = b(k,224) - lu(k,1358) * b(k,211) + b(k,225) = b(k,225) - lu(k,1359) * b(k,211) + b(k,226) = b(k,226) - lu(k,1360) * b(k,211) + b(k,228) = b(k,228) - lu(k,1361) * b(k,211) + b(k,229) = b(k,229) - lu(k,1362) * b(k,211) + b(k,231) = b(k,231) - lu(k,1363) * b(k,211) + b(k,232) = b(k,232) - lu(k,1364) * b(k,211) + b(k,235) = b(k,235) - lu(k,1365) * b(k,211) + b(k,237) = b(k,237) - lu(k,1366) * b(k,211) + b(k,213) = b(k,213) - lu(k,1375) * b(k,212) + b(k,214) = b(k,214) - lu(k,1376) * b(k,212) + b(k,215) = b(k,215) - lu(k,1377) * b(k,212) + b(k,220) = b(k,220) - lu(k,1378) * b(k,212) + b(k,224) = b(k,224) - lu(k,1379) * b(k,212) + b(k,225) = b(k,225) - lu(k,1380) * b(k,212) + b(k,226) = b(k,226) - lu(k,1381) * b(k,212) + b(k,228) = b(k,228) - lu(k,1382) * b(k,212) + b(k,229) = b(k,229) - lu(k,1383) * b(k,212) + b(k,231) = b(k,231) - lu(k,1384) * b(k,212) + b(k,232) = b(k,232) - lu(k,1385) * b(k,212) + b(k,233) = b(k,233) - lu(k,1386) * b(k,212) + b(k,235) = b(k,235) - lu(k,1387) * b(k,212) + b(k,236) = b(k,236) - lu(k,1388) * b(k,212) + b(k,237) = b(k,237) - lu(k,1389) * b(k,212) + b(k,214) = b(k,214) - lu(k,1396) * b(k,213) + b(k,215) = b(k,215) - lu(k,1397) * b(k,213) + b(k,224) = b(k,224) - lu(k,1398) * b(k,213) + b(k,225) = b(k,225) - lu(k,1399) * b(k,213) + b(k,226) = b(k,226) - lu(k,1400) * b(k,213) + b(k,228) = b(k,228) - lu(k,1401) * b(k,213) + b(k,229) = b(k,229) - lu(k,1402) * b(k,213) + b(k,231) = b(k,231) - lu(k,1403) * b(k,213) + b(k,232) = b(k,232) - lu(k,1404) * b(k,213) + b(k,235) = b(k,235) - lu(k,1405) * b(k,213) + b(k,236) = b(k,236) - lu(k,1406) * b(k,213) + b(k,237) = b(k,237) - lu(k,1407) * b(k,213) + b(k,215) = b(k,215) - lu(k,1427) * b(k,214) + b(k,220) = b(k,220) - lu(k,1428) * b(k,214) + b(k,224) = b(k,224) - lu(k,1429) * b(k,214) + b(k,225) = b(k,225) - lu(k,1430) * b(k,214) + b(k,226) = b(k,226) - lu(k,1431) * b(k,214) + b(k,228) = b(k,228) - lu(k,1432) * b(k,214) + b(k,229) = b(k,229) - lu(k,1433) * b(k,214) + b(k,231) = b(k,231) - lu(k,1434) * b(k,214) + b(k,232) = b(k,232) - lu(k,1435) * b(k,214) + b(k,233) = b(k,233) - lu(k,1436) * b(k,214) + b(k,235) = b(k,235) - lu(k,1437) * b(k,214) + b(k,236) = b(k,236) - lu(k,1438) * b(k,214) + b(k,237) = b(k,237) - lu(k,1439) * b(k,214) + b(k,220) = b(k,220) - lu(k,1449) * b(k,215) + b(k,223) = b(k,223) - lu(k,1450) * b(k,215) + b(k,224) = b(k,224) - lu(k,1451) * b(k,215) + b(k,225) = b(k,225) - lu(k,1452) * b(k,215) + b(k,229) = b(k,229) - lu(k,1453) * b(k,215) + b(k,230) = b(k,230) - lu(k,1454) * b(k,215) + b(k,231) = b(k,231) - lu(k,1455) * b(k,215) + b(k,234) = b(k,234) - lu(k,1456) * b(k,215) + b(k,218) = b(k,218) - lu(k,1460) * b(k,216) + b(k,223) = b(k,223) - lu(k,1461) * b(k,216) + b(k,224) = b(k,224) - lu(k,1462) * b(k,216) + b(k,226) = b(k,226) - lu(k,1463) * b(k,216) + b(k,227) = b(k,227) - lu(k,1464) * b(k,216) + b(k,228) = b(k,228) - lu(k,1465) * b(k,216) + b(k,230) = b(k,230) - lu(k,1466) * b(k,216) + b(k,232) = b(k,232) - lu(k,1467) * b(k,216) + b(k,233) = b(k,233) - lu(k,1468) * b(k,216) + b(k,234) = b(k,234) - lu(k,1469) * b(k,216) + b(k,237) = b(k,237) - lu(k,1470) * b(k,216) + b(k,219) = b(k,219) - lu(k,1475) * b(k,217) + b(k,220) = b(k,220) - lu(k,1476) * b(k,217) + b(k,221) = b(k,221) - lu(k,1477) * b(k,217) + b(k,222) = b(k,222) - lu(k,1478) * b(k,217) + b(k,224) = b(k,224) - lu(k,1479) * b(k,217) + b(k,225) = b(k,225) - lu(k,1480) * b(k,217) + b(k,227) = b(k,227) - lu(k,1481) * b(k,217) + b(k,229) = b(k,229) - lu(k,1482) * b(k,217) + b(k,230) = b(k,230) - lu(k,1483) * b(k,217) + b(k,231) = b(k,231) - lu(k,1484) * b(k,217) + b(k,234) = b(k,234) - lu(k,1485) * b(k,217) + b(k,236) = b(k,236) - lu(k,1486) * b(k,217) + b(k,237) = b(k,237) - lu(k,1487) * b(k,217) + b(k,219) = b(k,219) - lu(k,1494) * b(k,218) + b(k,221) = b(k,221) - lu(k,1495) * b(k,218) + b(k,222) = b(k,222) - lu(k,1496) * b(k,218) + b(k,223) = b(k,223) - lu(k,1497) * b(k,218) + b(k,224) = b(k,224) - lu(k,1498) * b(k,218) + b(k,225) = b(k,225) - lu(k,1499) * b(k,218) + b(k,226) = b(k,226) - lu(k,1500) * b(k,218) + b(k,227) = b(k,227) - lu(k,1501) * b(k,218) + b(k,228) = b(k,228) - lu(k,1502) * b(k,218) + b(k,230) = b(k,230) - lu(k,1503) * b(k,218) + b(k,234) = b(k,234) - lu(k,1504) * b(k,218) + b(k,237) = b(k,237) - lu(k,1505) * b(k,218) + b(k,220) = b(k,220) - lu(k,1510) * b(k,219) + b(k,221) = b(k,221) - lu(k,1511) * b(k,219) + b(k,223) = b(k,223) - lu(k,1512) * b(k,219) + b(k,224) = b(k,224) - lu(k,1513) * b(k,219) + b(k,225) = b(k,225) - lu(k,1514) * b(k,219) + b(k,229) = b(k,229) - lu(k,1515) * b(k,219) + b(k,230) = b(k,230) - lu(k,1516) * b(k,219) + b(k,231) = b(k,231) - lu(k,1517) * b(k,219) + b(k,234) = b(k,234) - lu(k,1518) * b(k,219) + b(k,235) = b(k,235) - lu(k,1519) * b(k,219) + b(k,236) = b(k,236) - lu(k,1520) * b(k,219) + b(k,237) = b(k,237) - lu(k,1521) * b(k,219) end do end subroutine lu_slv05 subroutine lu_slv06( avec_len, lu, b ) @@ -1150,34 +1151,152 @@ subroutine lu_slv06( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,195) = b(k,195) - lu(k,1908) * b(k,194) - b(k,196) = b(k,196) - lu(k,1909) * b(k,194) - b(k,197) = b(k,197) - lu(k,1910) * b(k,194) - b(k,198) = b(k,198) - lu(k,1911) * b(k,194) - b(k,199) = b(k,199) - lu(k,1912) * b(k,194) - b(k,200) = b(k,200) - lu(k,1913) * b(k,194) - b(k,201) = b(k,201) - lu(k,1914) * b(k,194) - b(k,196) = b(k,196) - lu(k,1929) * b(k,195) - b(k,197) = b(k,197) - lu(k,1930) * b(k,195) - b(k,198) = b(k,198) - lu(k,1931) * b(k,195) - b(k,199) = b(k,199) - lu(k,1932) * b(k,195) - b(k,200) = b(k,200) - lu(k,1933) * b(k,195) - b(k,201) = b(k,201) - lu(k,1934) * b(k,195) - b(k,197) = b(k,197) - lu(k,1952) * b(k,196) - b(k,198) = b(k,198) - lu(k,1953) * b(k,196) - b(k,199) = b(k,199) - lu(k,1954) * b(k,196) - b(k,200) = b(k,200) - lu(k,1955) * b(k,196) - b(k,201) = b(k,201) - lu(k,1956) * b(k,196) - b(k,198) = b(k,198) - lu(k,1995) * b(k,197) - b(k,199) = b(k,199) - lu(k,1996) * b(k,197) - b(k,200) = b(k,200) - lu(k,1997) * b(k,197) - b(k,201) = b(k,201) - lu(k,1998) * b(k,197) - b(k,199) = b(k,199) - lu(k,2020) * b(k,198) - b(k,200) = b(k,200) - lu(k,2021) * b(k,198) - b(k,201) = b(k,201) - lu(k,2022) * b(k,198) - b(k,200) = b(k,200) - lu(k,2116) * b(k,199) - b(k,201) = b(k,201) - lu(k,2117) * b(k,199) - b(k,201) = b(k,201) - lu(k,2144) * b(k,200) + b(k,221) = b(k,221) - lu(k,1541) * b(k,220) + b(k,222) = b(k,222) - lu(k,1542) * b(k,220) + b(k,223) = b(k,223) - lu(k,1543) * b(k,220) + b(k,224) = b(k,224) - lu(k,1544) * b(k,220) + b(k,225) = b(k,225) - lu(k,1545) * b(k,220) + b(k,227) = b(k,227) - lu(k,1546) * b(k,220) + b(k,229) = b(k,229) - lu(k,1547) * b(k,220) + b(k,230) = b(k,230) - lu(k,1548) * b(k,220) + b(k,231) = b(k,231) - lu(k,1549) * b(k,220) + b(k,234) = b(k,234) - lu(k,1550) * b(k,220) + b(k,235) = b(k,235) - lu(k,1551) * b(k,220) + b(k,236) = b(k,236) - lu(k,1552) * b(k,220) + b(k,237) = b(k,237) - lu(k,1553) * b(k,220) + b(k,222) = b(k,222) - lu(k,1564) * b(k,221) + b(k,223) = b(k,223) - lu(k,1565) * b(k,221) + b(k,224) = b(k,224) - lu(k,1566) * b(k,221) + b(k,225) = b(k,225) - lu(k,1567) * b(k,221) + b(k,226) = b(k,226) - lu(k,1568) * b(k,221) + b(k,227) = b(k,227) - lu(k,1569) * b(k,221) + b(k,228) = b(k,228) - lu(k,1570) * b(k,221) + b(k,229) = b(k,229) - lu(k,1571) * b(k,221) + b(k,230) = b(k,230) - lu(k,1572) * b(k,221) + b(k,231) = b(k,231) - lu(k,1573) * b(k,221) + b(k,234) = b(k,234) - lu(k,1574) * b(k,221) + b(k,235) = b(k,235) - lu(k,1575) * b(k,221) + b(k,236) = b(k,236) - lu(k,1576) * b(k,221) + b(k,237) = b(k,237) - lu(k,1577) * b(k,221) + b(k,223) = b(k,223) - lu(k,1591) * b(k,222) + b(k,224) = b(k,224) - lu(k,1592) * b(k,222) + b(k,225) = b(k,225) - lu(k,1593) * b(k,222) + b(k,226) = b(k,226) - lu(k,1594) * b(k,222) + b(k,227) = b(k,227) - lu(k,1595) * b(k,222) + b(k,228) = b(k,228) - lu(k,1596) * b(k,222) + b(k,229) = b(k,229) - lu(k,1597) * b(k,222) + b(k,230) = b(k,230) - lu(k,1598) * b(k,222) + b(k,231) = b(k,231) - lu(k,1599) * b(k,222) + b(k,232) = b(k,232) - lu(k,1600) * b(k,222) + b(k,234) = b(k,234) - lu(k,1601) * b(k,222) + b(k,235) = b(k,235) - lu(k,1602) * b(k,222) + b(k,236) = b(k,236) - lu(k,1603) * b(k,222) + b(k,237) = b(k,237) - lu(k,1604) * b(k,222) + b(k,224) = b(k,224) - lu(k,1634) * b(k,223) + b(k,225) = b(k,225) - lu(k,1635) * b(k,223) + b(k,226) = b(k,226) - lu(k,1636) * b(k,223) + b(k,227) = b(k,227) - lu(k,1637) * b(k,223) + b(k,228) = b(k,228) - lu(k,1638) * b(k,223) + b(k,229) = b(k,229) - lu(k,1639) * b(k,223) + b(k,230) = b(k,230) - lu(k,1640) * b(k,223) + b(k,231) = b(k,231) - lu(k,1641) * b(k,223) + b(k,232) = b(k,232) - lu(k,1642) * b(k,223) + b(k,233) = b(k,233) - lu(k,1643) * b(k,223) + b(k,234) = b(k,234) - lu(k,1644) * b(k,223) + b(k,235) = b(k,235) - lu(k,1645) * b(k,223) + b(k,236) = b(k,236) - lu(k,1646) * b(k,223) + b(k,237) = b(k,237) - lu(k,1647) * b(k,223) + b(k,225) = b(k,225) - lu(k,1800) * b(k,224) + b(k,226) = b(k,226) - lu(k,1801) * b(k,224) + b(k,227) = b(k,227) - lu(k,1802) * b(k,224) + b(k,228) = b(k,228) - lu(k,1803) * b(k,224) + b(k,229) = b(k,229) - lu(k,1804) * b(k,224) + b(k,230) = b(k,230) - lu(k,1805) * b(k,224) + b(k,231) = b(k,231) - lu(k,1806) * b(k,224) + b(k,232) = b(k,232) - lu(k,1807) * b(k,224) + b(k,233) = b(k,233) - lu(k,1808) * b(k,224) + b(k,234) = b(k,234) - lu(k,1809) * b(k,224) + b(k,235) = b(k,235) - lu(k,1810) * b(k,224) + b(k,236) = b(k,236) - lu(k,1811) * b(k,224) + b(k,237) = b(k,237) - lu(k,1812) * b(k,224) + b(k,226) = b(k,226) - lu(k,1846) * b(k,225) + b(k,227) = b(k,227) - lu(k,1847) * b(k,225) + b(k,228) = b(k,228) - lu(k,1848) * b(k,225) + b(k,229) = b(k,229) - lu(k,1849) * b(k,225) + b(k,230) = b(k,230) - lu(k,1850) * b(k,225) + b(k,231) = b(k,231) - lu(k,1851) * b(k,225) + b(k,232) = b(k,232) - lu(k,1852) * b(k,225) + b(k,233) = b(k,233) - lu(k,1853) * b(k,225) + b(k,234) = b(k,234) - lu(k,1854) * b(k,225) + b(k,235) = b(k,235) - lu(k,1855) * b(k,225) + b(k,236) = b(k,236) - lu(k,1856) * b(k,225) + b(k,237) = b(k,237) - lu(k,1857) * b(k,225) + b(k,227) = b(k,227) - lu(k,1907) * b(k,226) + b(k,228) = b(k,228) - lu(k,1908) * b(k,226) + b(k,229) = b(k,229) - lu(k,1909) * b(k,226) + b(k,230) = b(k,230) - lu(k,1910) * b(k,226) + b(k,231) = b(k,231) - lu(k,1911) * b(k,226) + b(k,232) = b(k,232) - lu(k,1912) * b(k,226) + b(k,233) = b(k,233) - lu(k,1913) * b(k,226) + b(k,234) = b(k,234) - lu(k,1914) * b(k,226) + b(k,235) = b(k,235) - lu(k,1915) * b(k,226) + b(k,236) = b(k,236) - lu(k,1916) * b(k,226) + b(k,237) = b(k,237) - lu(k,1917) * b(k,226) + b(k,228) = b(k,228) - lu(k,1954) * b(k,227) + b(k,229) = b(k,229) - lu(k,1955) * b(k,227) + b(k,230) = b(k,230) - lu(k,1956) * b(k,227) + b(k,231) = b(k,231) - lu(k,1957) * b(k,227) + b(k,232) = b(k,232) - lu(k,1958) * b(k,227) + b(k,233) = b(k,233) - lu(k,1959) * b(k,227) + b(k,234) = b(k,234) - lu(k,1960) * b(k,227) + b(k,235) = b(k,235) - lu(k,1961) * b(k,227) + b(k,236) = b(k,236) - lu(k,1962) * b(k,227) + b(k,237) = b(k,237) - lu(k,1963) * b(k,227) + b(k,229) = b(k,229) - lu(k,1978) * b(k,228) + b(k,230) = b(k,230) - lu(k,1979) * b(k,228) + b(k,231) = b(k,231) - lu(k,1980) * b(k,228) + b(k,232) = b(k,232) - lu(k,1981) * b(k,228) + b(k,233) = b(k,233) - lu(k,1982) * b(k,228) + b(k,234) = b(k,234) - lu(k,1983) * b(k,228) + b(k,235) = b(k,235) - lu(k,1984) * b(k,228) + b(k,236) = b(k,236) - lu(k,1985) * b(k,228) + b(k,237) = b(k,237) - lu(k,1986) * b(k,228) + b(k,230) = b(k,230) - lu(k,2074) * b(k,229) + b(k,231) = b(k,231) - lu(k,2075) * b(k,229) + b(k,232) = b(k,232) - lu(k,2076) * b(k,229) + b(k,233) = b(k,233) - lu(k,2077) * b(k,229) + b(k,234) = b(k,234) - lu(k,2078) * b(k,229) + b(k,235) = b(k,235) - lu(k,2079) * b(k,229) + b(k,236) = b(k,236) - lu(k,2080) * b(k,229) + b(k,237) = b(k,237) - lu(k,2081) * b(k,229) + b(k,231) = b(k,231) - lu(k,2096) * b(k,230) + b(k,232) = b(k,232) - lu(k,2097) * b(k,230) + b(k,233) = b(k,233) - lu(k,2098) * b(k,230) + b(k,234) = b(k,234) - lu(k,2099) * b(k,230) + b(k,235) = b(k,235) - lu(k,2100) * b(k,230) + b(k,236) = b(k,236) - lu(k,2101) * b(k,230) + b(k,237) = b(k,237) - lu(k,2102) * b(k,230) + b(k,232) = b(k,232) - lu(k,2205) * b(k,231) + b(k,233) = b(k,233) - lu(k,2206) * b(k,231) + b(k,234) = b(k,234) - lu(k,2207) * b(k,231) + b(k,235) = b(k,235) - lu(k,2208) * b(k,231) + b(k,236) = b(k,236) - lu(k,2209) * b(k,231) + b(k,237) = b(k,237) - lu(k,2210) * b(k,231) + b(k,233) = b(k,233) - lu(k,2258) * b(k,232) + b(k,234) = b(k,234) - lu(k,2259) * b(k,232) + b(k,235) = b(k,235) - lu(k,2260) * b(k,232) + b(k,236) = b(k,236) - lu(k,2261) * b(k,232) + b(k,237) = b(k,237) - lu(k,2262) * b(k,232) + b(k,234) = b(k,234) - lu(k,2284) * b(k,233) + b(k,235) = b(k,235) - lu(k,2285) * b(k,233) + b(k,236) = b(k,236) - lu(k,2286) * b(k,233) + b(k,237) = b(k,237) - lu(k,2287) * b(k,233) + b(k,235) = b(k,235) - lu(k,2328) * b(k,234) + b(k,236) = b(k,236) - lu(k,2329) * b(k,234) + b(k,237) = b(k,237) - lu(k,2330) * b(k,234) + b(k,236) = b(k,236) - lu(k,2355) * b(k,235) + b(k,237) = b(k,237) - lu(k,2356) * b(k,235) + b(k,237) = b(k,237) - lu(k,2420) * b(k,236) end do end subroutine lu_slv06 subroutine lu_slv07( avec_len, lu, b ) @@ -1201,210 +1320,228 @@ subroutine lu_slv07( avec_len, lu, b ) !----------------------------------------------------------------------- ! ... Solve U * x = y !----------------------------------------------------------------------- - b(k,201) = b(k,201) * lu(k,2170) - b(k,200) = b(k,200) - lu(k,2169) * b(k,201) - b(k,199) = b(k,199) - lu(k,2168) * b(k,201) - b(k,198) = b(k,198) - lu(k,2167) * b(k,201) - b(k,197) = b(k,197) - lu(k,2166) * b(k,201) - b(k,196) = b(k,196) - lu(k,2165) * b(k,201) - b(k,195) = b(k,195) - lu(k,2164) * b(k,201) - b(k,194) = b(k,194) - lu(k,2163) * b(k,201) - b(k,193) = b(k,193) - lu(k,2162) * b(k,201) - b(k,192) = b(k,192) - lu(k,2161) * b(k,201) - b(k,191) = b(k,191) - lu(k,2160) * b(k,201) - b(k,190) = b(k,190) - lu(k,2159) * b(k,201) - b(k,189) = b(k,189) - lu(k,2158) * b(k,201) - b(k,188) = b(k,188) - lu(k,2157) * b(k,201) - b(k,187) = b(k,187) - lu(k,2156) * b(k,201) - b(k,186) = b(k,186) - lu(k,2155) * b(k,201) - b(k,185) = b(k,185) - lu(k,2154) * b(k,201) - b(k,184) = b(k,184) - lu(k,2153) * b(k,201) - b(k,183) = b(k,183) - lu(k,2152) * b(k,201) - b(k,182) = b(k,182) - lu(k,2151) * b(k,201) - b(k,172) = b(k,172) - lu(k,2150) * b(k,201) - b(k,155) = b(k,155) - lu(k,2149) * b(k,201) - b(k,136) = b(k,136) - lu(k,2148) * b(k,201) - b(k,65) = b(k,65) - lu(k,2147) * b(k,201) - b(k,59) = b(k,59) - lu(k,2146) * b(k,201) - b(k,42) = b(k,42) - lu(k,2145) * b(k,201) - b(k,200) = b(k,200) * lu(k,2143) - b(k,199) = b(k,199) - lu(k,2142) * b(k,200) - b(k,198) = b(k,198) - lu(k,2141) * b(k,200) - b(k,197) = b(k,197) - lu(k,2140) * b(k,200) - b(k,196) = b(k,196) - lu(k,2139) * b(k,200) - b(k,195) = b(k,195) - lu(k,2138) * b(k,200) - b(k,194) = b(k,194) - lu(k,2137) * b(k,200) - b(k,193) = b(k,193) - lu(k,2136) * b(k,200) - b(k,192) = b(k,192) - lu(k,2135) * b(k,200) - b(k,191) = b(k,191) - lu(k,2134) * b(k,200) - b(k,190) = b(k,190) - lu(k,2133) * b(k,200) - b(k,189) = b(k,189) - lu(k,2132) * b(k,200) - b(k,188) = b(k,188) - lu(k,2131) * b(k,200) - b(k,187) = b(k,187) - lu(k,2130) * b(k,200) - b(k,186) = b(k,186) - lu(k,2129) * b(k,200) - b(k,185) = b(k,185) - lu(k,2128) * b(k,200) - b(k,184) = b(k,184) - lu(k,2127) * b(k,200) - b(k,183) = b(k,183) - lu(k,2126) * b(k,200) - b(k,182) = b(k,182) - lu(k,2125) * b(k,200) - b(k,157) = b(k,157) - lu(k,2124) * b(k,200) - b(k,155) = b(k,155) - lu(k,2123) * b(k,200) - b(k,146) = b(k,146) - lu(k,2122) * b(k,200) - b(k,77) = b(k,77) - lu(k,2121) * b(k,200) - b(k,63) = b(k,63) - lu(k,2120) * b(k,200) - b(k,47) = b(k,47) - lu(k,2119) * b(k,200) - b(k,36) = b(k,36) - lu(k,2118) * b(k,200) - b(k,199) = b(k,199) * lu(k,2115) - b(k,198) = b(k,198) - lu(k,2114) * b(k,199) - b(k,197) = b(k,197) - lu(k,2113) * b(k,199) - b(k,196) = b(k,196) - lu(k,2112) * b(k,199) - b(k,195) = b(k,195) - lu(k,2111) * b(k,199) - b(k,194) = b(k,194) - lu(k,2110) * b(k,199) - b(k,193) = b(k,193) - lu(k,2109) * b(k,199) - b(k,192) = b(k,192) - lu(k,2108) * b(k,199) - b(k,191) = b(k,191) - lu(k,2107) * b(k,199) - b(k,190) = b(k,190) - lu(k,2106) * b(k,199) - b(k,189) = b(k,189) - lu(k,2105) * b(k,199) - b(k,188) = b(k,188) - lu(k,2104) * b(k,199) - b(k,187) = b(k,187) - lu(k,2103) * b(k,199) - b(k,186) = b(k,186) - lu(k,2102) * b(k,199) - b(k,185) = b(k,185) - lu(k,2101) * b(k,199) - b(k,184) = b(k,184) - lu(k,2100) * b(k,199) - b(k,183) = b(k,183) - lu(k,2099) * b(k,199) - b(k,181) = b(k,181) - lu(k,2098) * b(k,199) - b(k,180) = b(k,180) - lu(k,2097) * b(k,199) - b(k,179) = b(k,179) - lu(k,2096) * b(k,199) - b(k,178) = b(k,178) - lu(k,2095) * b(k,199) - b(k,177) = b(k,177) - lu(k,2094) * b(k,199) - b(k,176) = b(k,176) - lu(k,2093) * b(k,199) - b(k,175) = b(k,175) - lu(k,2092) * b(k,199) - b(k,174) = b(k,174) - lu(k,2091) * b(k,199) - b(k,173) = b(k,173) - lu(k,2090) * b(k,199) - b(k,172) = b(k,172) - lu(k,2089) * b(k,199) - b(k,171) = b(k,171) - lu(k,2088) * b(k,199) - b(k,170) = b(k,170) - lu(k,2087) * b(k,199) - b(k,169) = b(k,169) - lu(k,2086) * b(k,199) - b(k,168) = b(k,168) - lu(k,2085) * b(k,199) - b(k,167) = b(k,167) - lu(k,2084) * b(k,199) - b(k,166) = b(k,166) - lu(k,2083) * b(k,199) - b(k,165) = b(k,165) - lu(k,2082) * b(k,199) - b(k,164) = b(k,164) - lu(k,2081) * b(k,199) - b(k,163) = b(k,163) - lu(k,2080) * b(k,199) - b(k,161) = b(k,161) - lu(k,2079) * b(k,199) - b(k,158) = b(k,158) - lu(k,2078) * b(k,199) - b(k,156) = b(k,156) - lu(k,2077) * b(k,199) - b(k,154) = b(k,154) - lu(k,2076) * b(k,199) - b(k,152) = b(k,152) - lu(k,2075) * b(k,199) - b(k,150) = b(k,150) - lu(k,2074) * b(k,199) - b(k,149) = b(k,149) - lu(k,2073) * b(k,199) - b(k,147) = b(k,147) - lu(k,2072) * b(k,199) - b(k,146) = b(k,146) - lu(k,2071) * b(k,199) - b(k,145) = b(k,145) - lu(k,2070) * b(k,199) - b(k,143) = b(k,143) - lu(k,2069) * b(k,199) - b(k,142) = b(k,142) - lu(k,2068) * b(k,199) - b(k,141) = b(k,141) - lu(k,2067) * b(k,199) - b(k,135) = b(k,135) - lu(k,2066) * b(k,199) - b(k,134) = b(k,134) - lu(k,2065) * b(k,199) - b(k,133) = b(k,133) - lu(k,2064) * b(k,199) - b(k,132) = b(k,132) - lu(k,2063) * b(k,199) - b(k,131) = b(k,131) - lu(k,2062) * b(k,199) - b(k,130) = b(k,130) - lu(k,2061) * b(k,199) - b(k,128) = b(k,128) - lu(k,2060) * b(k,199) - b(k,127) = b(k,127) - lu(k,2059) * b(k,199) - b(k,125) = b(k,125) - lu(k,2058) * b(k,199) - b(k,124) = b(k,124) - lu(k,2057) * b(k,199) - b(k,122) = b(k,122) - lu(k,2056) * b(k,199) - b(k,118) = b(k,118) - lu(k,2055) * b(k,199) - b(k,117) = b(k,117) - lu(k,2054) * b(k,199) - b(k,116) = b(k,116) - lu(k,2053) * b(k,199) - b(k,115) = b(k,115) - lu(k,2052) * b(k,199) - b(k,111) = b(k,111) - lu(k,2051) * b(k,199) - b(k,109) = b(k,109) - lu(k,2050) * b(k,199) - b(k,105) = b(k,105) - lu(k,2049) * b(k,199) - b(k,104) = b(k,104) - lu(k,2048) * b(k,199) - b(k,103) = b(k,103) - lu(k,2047) * b(k,199) - b(k,101) = b(k,101) - lu(k,2046) * b(k,199) - b(k,100) = b(k,100) - lu(k,2045) * b(k,199) - b(k,99) = b(k,99) - lu(k,2044) * b(k,199) - b(k,98) = b(k,98) - lu(k,2043) * b(k,199) - b(k,96) = b(k,96) - lu(k,2042) * b(k,199) - b(k,95) = b(k,95) - lu(k,2041) * b(k,199) - b(k,94) = b(k,94) - lu(k,2040) * b(k,199) - b(k,93) = b(k,93) - lu(k,2039) * b(k,199) - b(k,92) = b(k,92) - lu(k,2038) * b(k,199) - b(k,91) = b(k,91) - lu(k,2037) * b(k,199) - b(k,90) = b(k,90) - lu(k,2036) * b(k,199) - b(k,89) = b(k,89) - lu(k,2035) * b(k,199) - b(k,88) = b(k,88) - lu(k,2034) * b(k,199) - b(k,87) = b(k,87) - lu(k,2033) * b(k,199) - b(k,86) = b(k,86) - lu(k,2032) * b(k,199) - b(k,84) = b(k,84) - lu(k,2031) * b(k,199) - b(k,80) = b(k,80) - lu(k,2030) * b(k,199) - b(k,79) = b(k,79) - lu(k,2029) * b(k,199) - b(k,78) = b(k,78) - lu(k,2028) * b(k,199) - b(k,75) = b(k,75) - lu(k,2027) * b(k,199) - b(k,74) = b(k,74) - lu(k,2026) * b(k,199) - b(k,67) = b(k,67) - lu(k,2025) * b(k,199) - b(k,56) = b(k,56) - lu(k,2024) * b(k,199) - b(k,41) = b(k,41) - lu(k,2023) * b(k,199) - b(k,198) = b(k,198) * lu(k,2019) - b(k,197) = b(k,197) - lu(k,2018) * b(k,198) - b(k,196) = b(k,196) - lu(k,2017) * b(k,198) - b(k,195) = b(k,195) - lu(k,2016) * b(k,198) - b(k,194) = b(k,194) - lu(k,2015) * b(k,198) - b(k,193) = b(k,193) - lu(k,2014) * b(k,198) - b(k,192) = b(k,192) - lu(k,2013) * b(k,198) - b(k,191) = b(k,191) - lu(k,2012) * b(k,198) - b(k,190) = b(k,190) - lu(k,2011) * b(k,198) - b(k,189) = b(k,189) - lu(k,2010) * b(k,198) - b(k,188) = b(k,188) - lu(k,2009) * b(k,198) - b(k,187) = b(k,187) - lu(k,2008) * b(k,198) - b(k,186) = b(k,186) - lu(k,2007) * b(k,198) - b(k,184) = b(k,184) - lu(k,2006) * b(k,198) - b(k,183) = b(k,183) - lu(k,2005) * b(k,198) - b(k,182) = b(k,182) - lu(k,2004) * b(k,198) - b(k,155) = b(k,155) - lu(k,2003) * b(k,198) - b(k,134) = b(k,134) - lu(k,2002) * b(k,198) - b(k,110) = b(k,110) - lu(k,2001) * b(k,198) - b(k,77) = b(k,77) - lu(k,2000) * b(k,198) - b(k,63) = b(k,63) - lu(k,1999) * b(k,198) - b(k,197) = b(k,197) * lu(k,1994) - b(k,196) = b(k,196) - lu(k,1993) * b(k,197) - b(k,195) = b(k,195) - lu(k,1992) * b(k,197) - b(k,194) = b(k,194) - lu(k,1991) * b(k,197) - b(k,193) = b(k,193) - lu(k,1990) * b(k,197) - b(k,192) = b(k,192) - lu(k,1989) * b(k,197) - b(k,191) = b(k,191) - lu(k,1988) * b(k,197) - b(k,190) = b(k,190) - lu(k,1987) * b(k,197) - b(k,189) = b(k,189) - lu(k,1986) * b(k,197) - b(k,188) = b(k,188) - lu(k,1985) * b(k,197) - b(k,187) = b(k,187) - lu(k,1984) * b(k,197) - b(k,186) = b(k,186) - lu(k,1983) * b(k,197) - b(k,185) = b(k,185) - lu(k,1982) * b(k,197) - b(k,184) = b(k,184) - lu(k,1981) * b(k,197) - b(k,183) = b(k,183) - lu(k,1980) * b(k,197) - b(k,182) = b(k,182) - lu(k,1979) * b(k,197) - b(k,181) = b(k,181) - lu(k,1978) * b(k,197) - b(k,180) = b(k,180) - lu(k,1977) * b(k,197) - b(k,175) = b(k,175) - lu(k,1976) * b(k,197) - b(k,165) = b(k,165) - lu(k,1975) * b(k,197) - b(k,164) = b(k,164) - lu(k,1974) * b(k,197) - b(k,157) = b(k,157) - lu(k,1973) * b(k,197) - b(k,155) = b(k,155) - lu(k,1972) * b(k,197) - b(k,150) = b(k,150) - lu(k,1971) * b(k,197) - b(k,149) = b(k,149) - lu(k,1970) * b(k,197) - b(k,144) = b(k,144) - lu(k,1969) * b(k,197) - b(k,134) = b(k,134) - lu(k,1968) * b(k,197) - b(k,133) = b(k,133) - lu(k,1967) * b(k,197) - b(k,130) = b(k,130) - lu(k,1966) * b(k,197) - b(k,122) = b(k,122) - lu(k,1965) * b(k,197) - b(k,114) = b(k,114) - lu(k,1964) * b(k,197) - b(k,110) = b(k,110) - lu(k,1963) * b(k,197) - b(k,104) = b(k,104) - lu(k,1962) * b(k,197) - b(k,99) = b(k,99) - lu(k,1961) * b(k,197) - b(k,98) = b(k,98) - lu(k,1960) * b(k,197) - b(k,97) = b(k,97) - lu(k,1959) * b(k,197) - b(k,68) = b(k,68) - lu(k,1958) * b(k,197) - b(k,44) = b(k,44) - lu(k,1957) * b(k,197) + b(k,237) = b(k,237) * lu(k,2447) + b(k,236) = b(k,236) - lu(k,2446) * b(k,237) + b(k,235) = b(k,235) - lu(k,2445) * b(k,237) + b(k,234) = b(k,234) - lu(k,2444) * b(k,237) + b(k,233) = b(k,233) - lu(k,2443) * b(k,237) + b(k,232) = b(k,232) - lu(k,2442) * b(k,237) + b(k,231) = b(k,231) - lu(k,2441) * b(k,237) + b(k,230) = b(k,230) - lu(k,2440) * b(k,237) + b(k,229) = b(k,229) - lu(k,2439) * b(k,237) + b(k,228) = b(k,228) - lu(k,2438) * b(k,237) + b(k,227) = b(k,227) - lu(k,2437) * b(k,237) + b(k,226) = b(k,226) - lu(k,2436) * b(k,237) + b(k,225) = b(k,225) - lu(k,2435) * b(k,237) + b(k,224) = b(k,224) - lu(k,2434) * b(k,237) + b(k,223) = b(k,223) - lu(k,2433) * b(k,237) + b(k,222) = b(k,222) - lu(k,2432) * b(k,237) + b(k,221) = b(k,221) - lu(k,2431) * b(k,237) + b(k,220) = b(k,220) - lu(k,2430) * b(k,237) + b(k,219) = b(k,219) - lu(k,2429) * b(k,237) + b(k,218) = b(k,218) - lu(k,2428) * b(k,237) + b(k,217) = b(k,217) - lu(k,2427) * b(k,237) + b(k,216) = b(k,216) - lu(k,2426) * b(k,237) + b(k,184) = b(k,184) - lu(k,2425) * b(k,237) + b(k,182) = b(k,182) - lu(k,2424) * b(k,237) + b(k,98) = b(k,98) - lu(k,2423) * b(k,237) + b(k,92) = b(k,92) - lu(k,2422) * b(k,237) + b(k,62) = b(k,62) - lu(k,2421) * b(k,237) + b(k,236) = b(k,236) * lu(k,2419) + b(k,235) = b(k,235) - lu(k,2418) * b(k,236) + b(k,234) = b(k,234) - lu(k,2417) * b(k,236) + b(k,233) = b(k,233) - lu(k,2416) * b(k,236) + b(k,232) = b(k,232) - lu(k,2415) * b(k,236) + b(k,231) = b(k,231) - lu(k,2414) * b(k,236) + b(k,230) = b(k,230) - lu(k,2413) * b(k,236) + b(k,229) = b(k,229) - lu(k,2412) * b(k,236) + b(k,228) = b(k,228) - lu(k,2411) * b(k,236) + b(k,227) = b(k,227) - lu(k,2410) * b(k,236) + b(k,226) = b(k,226) - lu(k,2409) * b(k,236) + b(k,225) = b(k,225) - lu(k,2408) * b(k,236) + b(k,224) = b(k,224) - lu(k,2407) * b(k,236) + b(k,223) = b(k,223) - lu(k,2406) * b(k,236) + b(k,222) = b(k,222) - lu(k,2405) * b(k,236) + b(k,221) = b(k,221) - lu(k,2404) * b(k,236) + b(k,220) = b(k,220) - lu(k,2403) * b(k,236) + b(k,219) = b(k,219) - lu(k,2402) * b(k,236) + b(k,217) = b(k,217) - lu(k,2401) * b(k,236) + b(k,215) = b(k,215) - lu(k,2400) * b(k,236) + b(k,214) = b(k,214) - lu(k,2399) * b(k,236) + b(k,213) = b(k,213) - lu(k,2398) * b(k,236) + b(k,212) = b(k,212) - lu(k,2397) * b(k,236) + b(k,211) = b(k,211) - lu(k,2396) * b(k,236) + b(k,210) = b(k,210) - lu(k,2395) * b(k,236) + b(k,209) = b(k,209) - lu(k,2394) * b(k,236) + b(k,208) = b(k,208) - lu(k,2393) * b(k,236) + b(k,207) = b(k,207) - lu(k,2392) * b(k,236) + b(k,206) = b(k,206) - lu(k,2391) * b(k,236) + b(k,204) = b(k,204) - lu(k,2390) * b(k,236) + b(k,203) = b(k,203) - lu(k,2389) * b(k,236) + b(k,201) = b(k,201) - lu(k,2388) * b(k,236) + b(k,200) = b(k,200) - lu(k,2387) * b(k,236) + b(k,199) = b(k,199) - lu(k,2386) * b(k,236) + b(k,198) = b(k,198) - lu(k,2385) * b(k,236) + b(k,197) = b(k,197) - lu(k,2384) * b(k,236) + b(k,195) = b(k,195) - lu(k,2383) * b(k,236) + b(k,194) = b(k,194) - lu(k,2382) * b(k,236) + b(k,193) = b(k,193) - lu(k,2381) * b(k,236) + b(k,192) = b(k,192) - lu(k,2380) * b(k,236) + b(k,191) = b(k,191) - lu(k,2379) * b(k,236) + b(k,190) = b(k,190) - lu(k,2378) * b(k,236) + b(k,189) = b(k,189) - lu(k,2377) * b(k,236) + b(k,188) = b(k,188) - lu(k,2376) * b(k,236) + b(k,187) = b(k,187) - lu(k,2375) * b(k,236) + b(k,184) = b(k,184) - lu(k,2374) * b(k,236) + b(k,180) = b(k,180) - lu(k,2373) * b(k,236) + b(k,178) = b(k,178) - lu(k,2372) * b(k,236) + b(k,168) = b(k,168) - lu(k,2371) * b(k,236) + b(k,160) = b(k,160) - lu(k,2370) * b(k,236) + b(k,159) = b(k,159) - lu(k,2369) * b(k,236) + b(k,152) = b(k,152) - lu(k,2368) * b(k,236) + b(k,141) = b(k,141) - lu(k,2367) * b(k,236) + b(k,129) = b(k,129) - lu(k,2366) * b(k,236) + b(k,115) = b(k,115) - lu(k,2365) * b(k,236) + b(k,85) = b(k,85) - lu(k,2364) * b(k,236) + b(k,74) = b(k,74) - lu(k,2363) * b(k,236) + b(k,73) = b(k,73) - lu(k,2362) * b(k,236) + b(k,41) = b(k,41) - lu(k,2361) * b(k,236) + b(k,40) = b(k,40) - lu(k,2360) * b(k,236) + b(k,39) = b(k,39) - lu(k,2359) * b(k,236) + b(k,38) = b(k,38) - lu(k,2358) * b(k,236) + b(k,37) = b(k,37) - lu(k,2357) * b(k,236) + b(k,235) = b(k,235) * lu(k,2354) + b(k,234) = b(k,234) - lu(k,2353) * b(k,235) + b(k,233) = b(k,233) - lu(k,2352) * b(k,235) + b(k,232) = b(k,232) - lu(k,2351) * b(k,235) + b(k,231) = b(k,231) - lu(k,2350) * b(k,235) + b(k,230) = b(k,230) - lu(k,2349) * b(k,235) + b(k,229) = b(k,229) - lu(k,2348) * b(k,235) + b(k,228) = b(k,228) - lu(k,2347) * b(k,235) + b(k,227) = b(k,227) - lu(k,2346) * b(k,235) + b(k,226) = b(k,226) - lu(k,2345) * b(k,235) + b(k,225) = b(k,225) - lu(k,2344) * b(k,235) + b(k,224) = b(k,224) - lu(k,2343) * b(k,235) + b(k,223) = b(k,223) - lu(k,2342) * b(k,235) + b(k,222) = b(k,222) - lu(k,2341) * b(k,235) + b(k,221) = b(k,221) - lu(k,2340) * b(k,235) + b(k,220) = b(k,220) - lu(k,2339) * b(k,235) + b(k,219) = b(k,219) - lu(k,2338) * b(k,235) + b(k,218) = b(k,218) - lu(k,2337) * b(k,235) + b(k,216) = b(k,216) - lu(k,2336) * b(k,235) + b(k,215) = b(k,215) - lu(k,2335) * b(k,235) + b(k,199) = b(k,199) - lu(k,2334) * b(k,235) + b(k,180) = b(k,180) - lu(k,2333) * b(k,235) + b(k,172) = b(k,172) - lu(k,2332) * b(k,235) + b(k,124) = b(k,124) - lu(k,2331) * b(k,235) + b(k,234) = b(k,234) * lu(k,2327) + b(k,233) = b(k,233) - lu(k,2326) * b(k,234) + b(k,232) = b(k,232) - lu(k,2325) * b(k,234) + b(k,231) = b(k,231) - lu(k,2324) * b(k,234) + b(k,230) = b(k,230) - lu(k,2323) * b(k,234) + b(k,229) = b(k,229) - lu(k,2322) * b(k,234) + b(k,228) = b(k,228) - lu(k,2321) * b(k,234) + b(k,227) = b(k,227) - lu(k,2320) * b(k,234) + b(k,226) = b(k,226) - lu(k,2319) * b(k,234) + b(k,225) = b(k,225) - lu(k,2318) * b(k,234) + b(k,224) = b(k,224) - lu(k,2317) * b(k,234) + b(k,223) = b(k,223) - lu(k,2316) * b(k,234) + b(k,222) = b(k,222) - lu(k,2315) * b(k,234) + b(k,221) = b(k,221) - lu(k,2314) * b(k,234) + b(k,220) = b(k,220) - lu(k,2313) * b(k,234) + b(k,219) = b(k,219) - lu(k,2312) * b(k,234) + b(k,218) = b(k,218) - lu(k,2311) * b(k,234) + b(k,217) = b(k,217) - lu(k,2310) * b(k,234) + b(k,216) = b(k,216) - lu(k,2309) * b(k,234) + b(k,215) = b(k,215) - lu(k,2308) * b(k,234) + b(k,199) = b(k,199) - lu(k,2307) * b(k,234) + b(k,186) = b(k,186) - lu(k,2306) * b(k,234) + b(k,185) = b(k,185) - lu(k,2305) * b(k,234) + b(k,184) = b(k,184) - lu(k,2304) * b(k,234) + b(k,176) = b(k,176) - lu(k,2303) * b(k,234) + b(k,175) = b(k,175) - lu(k,2302) * b(k,234) + b(k,174) = b(k,174) - lu(k,2301) * b(k,234) + b(k,173) = b(k,173) - lu(k,2300) * b(k,234) + b(k,172) = b(k,172) - lu(k,2299) * b(k,234) + b(k,169) = b(k,169) - lu(k,2298) * b(k,234) + b(k,167) = b(k,167) - lu(k,2297) * b(k,234) + b(k,160) = b(k,160) - lu(k,2296) * b(k,234) + b(k,156) = b(k,156) - lu(k,2295) * b(k,234) + b(k,149) = b(k,149) - lu(k,2294) * b(k,234) + b(k,143) = b(k,143) - lu(k,2293) * b(k,234) + b(k,138) = b(k,138) - lu(k,2292) * b(k,234) + b(k,134) = b(k,134) - lu(k,2291) * b(k,234) + b(k,112) = b(k,112) - lu(k,2290) * b(k,234) + b(k,74) = b(k,74) - lu(k,2289) * b(k,234) + b(k,73) = b(k,73) - lu(k,2288) * b(k,234) + b(k,233) = b(k,233) * lu(k,2283) + b(k,232) = b(k,232) - lu(k,2282) * b(k,233) + b(k,231) = b(k,231) - lu(k,2281) * b(k,233) + b(k,230) = b(k,230) - lu(k,2280) * b(k,233) + b(k,229) = b(k,229) - lu(k,2279) * b(k,233) + b(k,228) = b(k,228) - lu(k,2278) * b(k,233) + b(k,227) = b(k,227) - lu(k,2277) * b(k,233) + b(k,226) = b(k,226) - lu(k,2276) * b(k,233) + b(k,225) = b(k,225) - lu(k,2275) * b(k,233) + b(k,224) = b(k,224) - lu(k,2274) * b(k,233) + b(k,223) = b(k,223) - lu(k,2273) * b(k,233) + b(k,222) = b(k,222) - lu(k,2272) * b(k,233) + b(k,221) = b(k,221) - lu(k,2271) * b(k,233) + b(k,220) = b(k,220) - lu(k,2270) * b(k,233) + b(k,219) = b(k,219) - lu(k,2269) * b(k,233) + b(k,218) = b(k,218) - lu(k,2268) * b(k,233) + b(k,216) = b(k,216) - lu(k,2267) * b(k,233) + b(k,215) = b(k,215) - lu(k,2266) * b(k,233) + b(k,199) = b(k,199) - lu(k,2265) * b(k,233) + b(k,182) = b(k,182) - lu(k,2264) * b(k,233) + b(k,98) = b(k,98) - lu(k,2263) * b(k,233) + b(k,232) = b(k,232) * lu(k,2257) + b(k,231) = b(k,231) - lu(k,2256) * b(k,232) + b(k,230) = b(k,230) - lu(k,2255) * b(k,232) + b(k,229) = b(k,229) - lu(k,2254) * b(k,232) + b(k,228) = b(k,228) - lu(k,2253) * b(k,232) + b(k,227) = b(k,227) - lu(k,2252) * b(k,232) + b(k,226) = b(k,226) - lu(k,2251) * b(k,232) + b(k,225) = b(k,225) - lu(k,2250) * b(k,232) + b(k,224) = b(k,224) - lu(k,2249) * b(k,232) + b(k,223) = b(k,223) - lu(k,2248) * b(k,232) + b(k,222) = b(k,222) - lu(k,2247) * b(k,232) + b(k,221) = b(k,221) - lu(k,2246) * b(k,232) + b(k,220) = b(k,220) - lu(k,2245) * b(k,232) + b(k,215) = b(k,215) - lu(k,2244) * b(k,232) + b(k,214) = b(k,214) - lu(k,2243) * b(k,232) + b(k,213) = b(k,213) - lu(k,2242) * b(k,232) + b(k,212) = b(k,212) - lu(k,2241) * b(k,232) + b(k,211) = b(k,211) - lu(k,2240) * b(k,232) + b(k,210) = b(k,210) - lu(k,2239) * b(k,232) + b(k,209) = b(k,209) - lu(k,2238) * b(k,232) + b(k,208) = b(k,208) - lu(k,2237) * b(k,232) + b(k,207) = b(k,207) - lu(k,2236) * b(k,232) + b(k,206) = b(k,206) - lu(k,2235) * b(k,232) + b(k,205) = b(k,205) - lu(k,2234) * b(k,232) + b(k,204) = b(k,204) - lu(k,2233) * b(k,232) + b(k,203) = b(k,203) - lu(k,2232) * b(k,232) + b(k,201) = b(k,201) - lu(k,2231) * b(k,232) + b(k,200) = b(k,200) - lu(k,2230) * b(k,232) + b(k,199) = b(k,199) - lu(k,2229) * b(k,232) + b(k,198) = b(k,198) - lu(k,2228) * b(k,232) + b(k,196) = b(k,196) - lu(k,2227) * b(k,232) + b(k,195) = b(k,195) - lu(k,2226) * b(k,232) + b(k,194) = b(k,194) - lu(k,2225) * b(k,232) + b(k,193) = b(k,193) - lu(k,2224) * b(k,232) + b(k,192) = b(k,192) - lu(k,2223) * b(k,232) + b(k,191) = b(k,191) - lu(k,2222) * b(k,232) + b(k,190) = b(k,190) - lu(k,2221) * b(k,232) + b(k,183) = b(k,183) - lu(k,2220) * b(k,232) + b(k,179) = b(k,179) - lu(k,2219) * b(k,232) + b(k,177) = b(k,177) - lu(k,2218) * b(k,232) + b(k,170) = b(k,170) - lu(k,2217) * b(k,232) + b(k,159) = b(k,159) - lu(k,2216) * b(k,232) + b(k,151) = b(k,151) - lu(k,2215) * b(k,232) + b(k,116) = b(k,116) - lu(k,2214) * b(k,232) + b(k,114) = b(k,114) - lu(k,2213) * b(k,232) + b(k,105) = b(k,105) - lu(k,2212) * b(k,232) + b(k,93) = b(k,93) - lu(k,2211) * b(k,232) end do end subroutine lu_slv07 subroutine lu_slv08( avec_len, lu, b ) @@ -1425,324 +1562,209 @@ subroutine lu_slv08( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,196) = b(k,196) * lu(k,1951) - b(k,195) = b(k,195) - lu(k,1950) * b(k,196) - b(k,194) = b(k,194) - lu(k,1949) * b(k,196) - b(k,193) = b(k,193) - lu(k,1948) * b(k,196) - b(k,192) = b(k,192) - lu(k,1947) * b(k,196) - b(k,191) = b(k,191) - lu(k,1946) * b(k,196) - b(k,190) = b(k,190) - lu(k,1945) * b(k,196) - b(k,189) = b(k,189) - lu(k,1944) * b(k,196) - b(k,188) = b(k,188) - lu(k,1943) * b(k,196) - b(k,187) = b(k,187) - lu(k,1942) * b(k,196) - b(k,186) = b(k,186) - lu(k,1941) * b(k,196) - b(k,185) = b(k,185) - lu(k,1940) * b(k,196) - b(k,184) = b(k,184) - lu(k,1939) * b(k,196) - b(k,183) = b(k,183) - lu(k,1938) * b(k,196) - b(k,172) = b(k,172) - lu(k,1937) * b(k,196) - b(k,136) = b(k,136) - lu(k,1936) * b(k,196) - b(k,59) = b(k,59) - lu(k,1935) * b(k,196) - b(k,195) = b(k,195) * lu(k,1928) - b(k,194) = b(k,194) - lu(k,1927) * b(k,195) - b(k,193) = b(k,193) - lu(k,1926) * b(k,195) - b(k,192) = b(k,192) - lu(k,1925) * b(k,195) - b(k,191) = b(k,191) - lu(k,1924) * b(k,195) - b(k,190) = b(k,190) - lu(k,1923) * b(k,195) - b(k,189) = b(k,189) - lu(k,1922) * b(k,195) - b(k,188) = b(k,188) - lu(k,1921) * b(k,195) - b(k,187) = b(k,187) - lu(k,1920) * b(k,195) - b(k,186) = b(k,186) - lu(k,1919) * b(k,195) - b(k,185) = b(k,185) - lu(k,1918) * b(k,195) - b(k,184) = b(k,184) - lu(k,1917) * b(k,195) - b(k,183) = b(k,183) - lu(k,1916) * b(k,195) - b(k,172) = b(k,172) - lu(k,1915) * b(k,195) - b(k,194) = b(k,194) * lu(k,1907) - b(k,193) = b(k,193) - lu(k,1906) * b(k,194) - b(k,192) = b(k,192) - lu(k,1905) * b(k,194) - b(k,191) = b(k,191) - lu(k,1904) * b(k,194) - b(k,190) = b(k,190) - lu(k,1903) * b(k,194) - b(k,189) = b(k,189) - lu(k,1902) * b(k,194) - b(k,188) = b(k,188) - lu(k,1901) * b(k,194) - b(k,187) = b(k,187) - lu(k,1900) * b(k,194) - b(k,186) = b(k,186) - lu(k,1899) * b(k,194) - b(k,185) = b(k,185) - lu(k,1898) * b(k,194) - b(k,184) = b(k,184) - lu(k,1897) * b(k,194) - b(k,182) = b(k,182) - lu(k,1896) * b(k,194) - b(k,181) = b(k,181) - lu(k,1895) * b(k,194) - b(k,180) = b(k,180) - lu(k,1894) * b(k,194) - b(k,179) = b(k,179) - lu(k,1893) * b(k,194) - b(k,178) = b(k,178) - lu(k,1892) * b(k,194) - b(k,177) = b(k,177) - lu(k,1891) * b(k,194) - b(k,176) = b(k,176) - lu(k,1890) * b(k,194) - b(k,175) = b(k,175) - lu(k,1889) * b(k,194) - b(k,174) = b(k,174) - lu(k,1888) * b(k,194) - b(k,173) = b(k,173) - lu(k,1887) * b(k,194) - b(k,171) = b(k,171) - lu(k,1886) * b(k,194) - b(k,170) = b(k,170) - lu(k,1885) * b(k,194) - b(k,169) = b(k,169) - lu(k,1884) * b(k,194) - b(k,168) = b(k,168) - lu(k,1883) * b(k,194) - b(k,167) = b(k,167) - lu(k,1882) * b(k,194) - b(k,166) = b(k,166) - lu(k,1881) * b(k,194) - b(k,165) = b(k,165) - lu(k,1880) * b(k,194) - b(k,164) = b(k,164) - lu(k,1879) * b(k,194) - b(k,163) = b(k,163) - lu(k,1878) * b(k,194) - b(k,162) = b(k,162) - lu(k,1877) * b(k,194) - b(k,161) = b(k,161) - lu(k,1876) * b(k,194) - b(k,160) = b(k,160) - lu(k,1875) * b(k,194) - b(k,159) = b(k,159) - lu(k,1874) * b(k,194) - b(k,158) = b(k,158) - lu(k,1873) * b(k,194) - b(k,156) = b(k,156) - lu(k,1872) * b(k,194) - b(k,155) = b(k,155) - lu(k,1871) * b(k,194) - b(k,154) = b(k,154) - lu(k,1870) * b(k,194) - b(k,153) = b(k,153) - lu(k,1869) * b(k,194) - b(k,151) = b(k,151) - lu(k,1868) * b(k,194) - b(k,149) = b(k,149) - lu(k,1867) * b(k,194) - b(k,148) = b(k,148) - lu(k,1866) * b(k,194) - b(k,147) = b(k,147) - lu(k,1865) * b(k,194) - b(k,113) = b(k,113) - lu(k,1864) * b(k,194) - b(k,82) = b(k,82) - lu(k,1863) * b(k,194) - b(k,73) = b(k,73) - lu(k,1862) * b(k,194) - b(k,69) = b(k,69) - lu(k,1861) * b(k,194) - b(k,68) = b(k,68) - lu(k,1860) * b(k,194) - b(k,33) = b(k,33) - lu(k,1859) * b(k,194) - b(k,32) = b(k,32) - lu(k,1858) * b(k,194) - b(k,193) = b(k,193) * lu(k,1849) - b(k,192) = b(k,192) - lu(k,1848) * b(k,193) - b(k,191) = b(k,191) - lu(k,1847) * b(k,193) - b(k,190) = b(k,190) - lu(k,1846) * b(k,193) - b(k,189) = b(k,189) - lu(k,1845) * b(k,193) - b(k,188) = b(k,188) - lu(k,1844) * b(k,193) - b(k,187) = b(k,187) - lu(k,1843) * b(k,193) - b(k,186) = b(k,186) - lu(k,1842) * b(k,193) - b(k,185) = b(k,185) - lu(k,1841) * b(k,193) - b(k,184) = b(k,184) - lu(k,1840) * b(k,193) - b(k,183) = b(k,183) - lu(k,1839) * b(k,193) - b(k,172) = b(k,172) - lu(k,1838) * b(k,193) - b(k,165) = b(k,165) - lu(k,1837) * b(k,193) - b(k,145) = b(k,145) - lu(k,1836) * b(k,193) - b(k,141) = b(k,141) - lu(k,1835) * b(k,193) - b(k,93) = b(k,93) - lu(k,1834) * b(k,193) - b(k,192) = b(k,192) * lu(k,1824) - b(k,191) = b(k,191) - lu(k,1823) * b(k,192) - b(k,190) = b(k,190) - lu(k,1822) * b(k,192) - b(k,189) = b(k,189) - lu(k,1821) * b(k,192) - b(k,188) = b(k,188) - lu(k,1820) * b(k,192) - b(k,187) = b(k,187) - lu(k,1819) * b(k,192) - b(k,186) = b(k,186) - lu(k,1818) * b(k,192) - b(k,185) = b(k,185) - lu(k,1817) * b(k,192) - b(k,184) = b(k,184) - lu(k,1816) * b(k,192) - b(k,183) = b(k,183) - lu(k,1815) * b(k,192) - b(k,182) = b(k,182) - lu(k,1814) * b(k,192) - b(k,172) = b(k,172) - lu(k,1813) * b(k,192) - b(k,165) = b(k,165) - lu(k,1812) * b(k,192) - b(k,157) = b(k,157) - lu(k,1811) * b(k,192) - b(k,155) = b(k,155) - lu(k,1810) * b(k,192) - b(k,146) = b(k,146) - lu(k,1809) * b(k,192) - b(k,145) = b(k,145) - lu(k,1808) * b(k,192) - b(k,144) = b(k,144) - lu(k,1807) * b(k,192) - b(k,139) = b(k,139) - lu(k,1806) * b(k,192) - b(k,138) = b(k,138) - lu(k,1805) * b(k,192) - b(k,137) = b(k,137) - lu(k,1804) * b(k,192) - b(k,134) = b(k,134) - lu(k,1803) * b(k,192) - b(k,129) = b(k,129) - lu(k,1802) * b(k,192) - b(k,126) = b(k,126) - lu(k,1801) * b(k,192) - b(k,120) = b(k,120) - lu(k,1800) * b(k,192) - b(k,115) = b(k,115) - lu(k,1799) * b(k,192) - b(k,110) = b(k,110) - lu(k,1798) * b(k,192) - b(k,106) = b(k,106) - lu(k,1797) * b(k,192) - b(k,102) = b(k,102) - lu(k,1796) * b(k,192) - b(k,81) = b(k,81) - lu(k,1795) * b(k,192) - b(k,46) = b(k,46) - lu(k,1794) * b(k,192) - b(k,45) = b(k,45) - lu(k,1793) * b(k,192) - b(k,191) = b(k,191) * lu(k,1782) - b(k,190) = b(k,190) - lu(k,1781) * b(k,191) - b(k,189) = b(k,189) - lu(k,1780) * b(k,191) - b(k,188) = b(k,188) - lu(k,1779) * b(k,191) - b(k,187) = b(k,187) - lu(k,1778) * b(k,191) - b(k,186) = b(k,186) - lu(k,1777) * b(k,191) - b(k,185) = b(k,185) - lu(k,1776) * b(k,191) - b(k,184) = b(k,184) - lu(k,1775) * b(k,191) - b(k,182) = b(k,182) - lu(k,1774) * b(k,191) - b(k,181) = b(k,181) - lu(k,1773) * b(k,191) - b(k,180) = b(k,180) - lu(k,1772) * b(k,191) - b(k,179) = b(k,179) - lu(k,1771) * b(k,191) - b(k,178) = b(k,178) - lu(k,1770) * b(k,191) - b(k,177) = b(k,177) - lu(k,1769) * b(k,191) - b(k,176) = b(k,176) - lu(k,1768) * b(k,191) - b(k,175) = b(k,175) - lu(k,1767) * b(k,191) - b(k,174) = b(k,174) - lu(k,1766) * b(k,191) - b(k,173) = b(k,173) - lu(k,1765) * b(k,191) - b(k,170) = b(k,170) - lu(k,1764) * b(k,191) - b(k,169) = b(k,169) - lu(k,1763) * b(k,191) - b(k,168) = b(k,168) - lu(k,1762) * b(k,191) - b(k,167) = b(k,167) - lu(k,1761) * b(k,191) - b(k,166) = b(k,166) - lu(k,1760) * b(k,191) - b(k,165) = b(k,165) - lu(k,1759) * b(k,191) - b(k,164) = b(k,164) - lu(k,1758) * b(k,191) - b(k,163) = b(k,163) - lu(k,1757) * b(k,191) - b(k,161) = b(k,161) - lu(k,1756) * b(k,191) - b(k,160) = b(k,160) - lu(k,1755) * b(k,191) - b(k,158) = b(k,158) - lu(k,1754) * b(k,191) - b(k,156) = b(k,156) - lu(k,1753) * b(k,191) - b(k,155) = b(k,155) - lu(k,1752) * b(k,191) - b(k,154) = b(k,154) - lu(k,1751) * b(k,191) - b(k,153) = b(k,153) - lu(k,1750) * b(k,191) - b(k,151) = b(k,151) - lu(k,1749) * b(k,191) - b(k,149) = b(k,149) - lu(k,1748) * b(k,191) - b(k,148) = b(k,148) - lu(k,1747) * b(k,191) - b(k,141) = b(k,141) - lu(k,1746) * b(k,191) - b(k,135) = b(k,135) - lu(k,1745) * b(k,191) - b(k,129) = b(k,129) - lu(k,1744) * b(k,191) - b(k,122) = b(k,122) - lu(k,1743) * b(k,191) - b(k,112) = b(k,112) - lu(k,1742) * b(k,191) - b(k,111) = b(k,111) - lu(k,1741) * b(k,191) - b(k,98) = b(k,98) - lu(k,1740) * b(k,191) - b(k,85) = b(k,85) - lu(k,1739) * b(k,191) - b(k,62) = b(k,62) - lu(k,1738) * b(k,191) - b(k,46) = b(k,46) - lu(k,1737) * b(k,191) - b(k,45) = b(k,45) - lu(k,1736) * b(k,191) - b(k,33) = b(k,33) - lu(k,1735) * b(k,191) - b(k,32) = b(k,32) - lu(k,1734) * b(k,191) - b(k,31) = b(k,31) - lu(k,1733) * b(k,191) - b(k,30) = b(k,30) - lu(k,1732) * b(k,191) - b(k,29) = b(k,29) - lu(k,1731) * b(k,191) - b(k,190) = b(k,190) * lu(k,1719) - b(k,189) = b(k,189) - lu(k,1718) * b(k,190) - b(k,188) = b(k,188) - lu(k,1717) * b(k,190) - b(k,187) = b(k,187) - lu(k,1716) * b(k,190) - b(k,186) = b(k,186) - lu(k,1715) * b(k,190) - b(k,185) = b(k,185) - lu(k,1714) * b(k,190) - b(k,184) = b(k,184) - lu(k,1713) * b(k,190) - b(k,183) = b(k,183) - lu(k,1712) * b(k,190) - b(k,182) = b(k,182) - lu(k,1711) * b(k,190) - b(k,181) = b(k,181) - lu(k,1710) * b(k,190) - b(k,180) = b(k,180) - lu(k,1709) * b(k,190) - b(k,179) = b(k,179) - lu(k,1708) * b(k,190) - b(k,178) = b(k,178) - lu(k,1707) * b(k,190) - b(k,177) = b(k,177) - lu(k,1706) * b(k,190) - b(k,176) = b(k,176) - lu(k,1705) * b(k,190) - b(k,175) = b(k,175) - lu(k,1704) * b(k,190) - b(k,174) = b(k,174) - lu(k,1703) * b(k,190) - b(k,173) = b(k,173) - lu(k,1702) * b(k,190) - b(k,172) = b(k,172) - lu(k,1701) * b(k,190) - b(k,171) = b(k,171) - lu(k,1700) * b(k,190) - b(k,170) = b(k,170) - lu(k,1699) * b(k,190) - b(k,169) = b(k,169) - lu(k,1698) * b(k,190) - b(k,168) = b(k,168) - lu(k,1697) * b(k,190) - b(k,167) = b(k,167) - lu(k,1696) * b(k,190) - b(k,166) = b(k,166) - lu(k,1695) * b(k,190) - b(k,165) = b(k,165) - lu(k,1694) * b(k,190) - b(k,164) = b(k,164) - lu(k,1693) * b(k,190) - b(k,163) = b(k,163) - lu(k,1692) * b(k,190) - b(k,162) = b(k,162) - lu(k,1691) * b(k,190) - b(k,161) = b(k,161) - lu(k,1690) * b(k,190) - b(k,160) = b(k,160) - lu(k,1689) * b(k,190) - b(k,159) = b(k,159) - lu(k,1688) * b(k,190) - b(k,158) = b(k,158) - lu(k,1687) * b(k,190) - b(k,157) = b(k,157) - lu(k,1686) * b(k,190) - b(k,156) = b(k,156) - lu(k,1685) * b(k,190) - b(k,155) = b(k,155) - lu(k,1684) * b(k,190) - b(k,154) = b(k,154) - lu(k,1683) * b(k,190) - b(k,153) = b(k,153) - lu(k,1682) * b(k,190) - b(k,152) = b(k,152) - lu(k,1681) * b(k,190) - b(k,151) = b(k,151) - lu(k,1680) * b(k,190) - b(k,150) = b(k,150) - lu(k,1679) * b(k,190) - b(k,149) = b(k,149) - lu(k,1678) * b(k,190) - b(k,148) = b(k,148) - lu(k,1677) * b(k,190) - b(k,147) = b(k,147) - lu(k,1676) * b(k,190) - b(k,146) = b(k,146) - lu(k,1675) * b(k,190) - b(k,145) = b(k,145) - lu(k,1674) * b(k,190) - b(k,144) = b(k,144) - lu(k,1673) * b(k,190) - b(k,143) = b(k,143) - lu(k,1672) * b(k,190) - b(k,142) = b(k,142) - lu(k,1671) * b(k,190) - b(k,141) = b(k,141) - lu(k,1670) * b(k,190) - b(k,140) = b(k,140) - lu(k,1669) * b(k,190) - b(k,136) = b(k,136) - lu(k,1668) * b(k,190) - b(k,135) = b(k,135) - lu(k,1667) * b(k,190) - b(k,133) = b(k,133) - lu(k,1666) * b(k,190) - b(k,132) = b(k,132) - lu(k,1665) * b(k,190) - b(k,131) = b(k,131) - lu(k,1664) * b(k,190) - b(k,130) = b(k,130) - lu(k,1663) * b(k,190) - b(k,129) = b(k,129) - lu(k,1662) * b(k,190) - b(k,128) = b(k,128) - lu(k,1661) * b(k,190) - b(k,127) = b(k,127) - lu(k,1660) * b(k,190) - b(k,125) = b(k,125) - lu(k,1659) * b(k,190) - b(k,124) = b(k,124) - lu(k,1658) * b(k,190) - b(k,123) = b(k,123) - lu(k,1657) * b(k,190) - b(k,122) = b(k,122) - lu(k,1656) * b(k,190) - b(k,121) = b(k,121) - lu(k,1655) * b(k,190) - b(k,119) = b(k,119) - lu(k,1654) * b(k,190) - b(k,118) = b(k,118) - lu(k,1653) * b(k,190) - b(k,117) = b(k,117) - lu(k,1652) * b(k,190) - b(k,116) = b(k,116) - lu(k,1651) * b(k,190) - b(k,115) = b(k,115) - lu(k,1650) * b(k,190) - b(k,114) = b(k,114) - lu(k,1649) * b(k,190) - b(k,113) = b(k,113) - lu(k,1648) * b(k,190) - b(k,112) = b(k,112) - lu(k,1647) * b(k,190) - b(k,111) = b(k,111) - lu(k,1646) * b(k,190) - b(k,109) = b(k,109) - lu(k,1645) * b(k,190) - b(k,108) = b(k,108) - lu(k,1644) * b(k,190) - b(k,107) = b(k,107) - lu(k,1643) * b(k,190) - b(k,105) = b(k,105) - lu(k,1642) * b(k,190) - b(k,104) = b(k,104) - lu(k,1641) * b(k,190) - b(k,103) = b(k,103) - lu(k,1640) * b(k,190) - b(k,101) = b(k,101) - lu(k,1639) * b(k,190) - b(k,100) = b(k,100) - lu(k,1638) * b(k,190) - b(k,99) = b(k,99) - lu(k,1637) * b(k,190) - b(k,98) = b(k,98) - lu(k,1636) * b(k,190) - b(k,97) = b(k,97) - lu(k,1635) * b(k,190) - b(k,95) = b(k,95) - lu(k,1634) * b(k,190) - b(k,94) = b(k,94) - lu(k,1633) * b(k,190) - b(k,92) = b(k,92) - lu(k,1632) * b(k,190) - b(k,91) = b(k,91) - lu(k,1631) * b(k,190) - b(k,90) = b(k,90) - lu(k,1630) * b(k,190) - b(k,89) = b(k,89) - lu(k,1629) * b(k,190) - b(k,88) = b(k,88) - lu(k,1628) * b(k,190) - b(k,87) = b(k,87) - lu(k,1627) * b(k,190) - b(k,86) = b(k,86) - lu(k,1626) * b(k,190) - b(k,84) = b(k,84) - lu(k,1625) * b(k,190) - b(k,83) = b(k,83) - lu(k,1624) * b(k,190) - b(k,82) = b(k,82) - lu(k,1623) * b(k,190) - b(k,81) = b(k,81) - lu(k,1622) * b(k,190) - b(k,80) = b(k,80) - lu(k,1621) * b(k,190) - b(k,79) = b(k,79) - lu(k,1620) * b(k,190) - b(k,78) = b(k,78) - lu(k,1619) * b(k,190) - b(k,75) = b(k,75) - lu(k,1618) * b(k,190) - b(k,74) = b(k,74) - lu(k,1617) * b(k,190) - b(k,73) = b(k,73) - lu(k,1616) * b(k,190) - b(k,72) = b(k,72) - lu(k,1615) * b(k,190) - b(k,71) = b(k,71) - lu(k,1614) * b(k,190) - b(k,69) = b(k,69) - lu(k,1613) * b(k,190) - b(k,67) = b(k,67) - lu(k,1612) * b(k,190) - b(k,66) = b(k,66) - lu(k,1611) * b(k,190) - b(k,65) = b(k,65) - lu(k,1610) * b(k,190) - b(k,64) = b(k,64) - lu(k,1609) * b(k,190) - b(k,62) = b(k,62) - lu(k,1608) * b(k,190) - b(k,61) = b(k,61) - lu(k,1607) * b(k,190) - b(k,60) = b(k,60) - lu(k,1606) * b(k,190) - b(k,58) = b(k,58) - lu(k,1605) * b(k,190) - b(k,57) = b(k,57) - lu(k,1604) * b(k,190) - b(k,56) = b(k,56) - lu(k,1603) * b(k,190) - b(k,55) = b(k,55) - lu(k,1602) * b(k,190) - b(k,54) = b(k,54) - lu(k,1601) * b(k,190) - b(k,53) = b(k,53) - lu(k,1600) * b(k,190) - b(k,52) = b(k,52) - lu(k,1599) * b(k,190) - b(k,51) = b(k,51) - lu(k,1598) * b(k,190) - b(k,50) = b(k,50) - lu(k,1597) * b(k,190) - b(k,49) = b(k,49) - lu(k,1596) * b(k,190) - b(k,48) = b(k,48) - lu(k,1595) * b(k,190) - b(k,43) = b(k,43) - lu(k,1594) * b(k,190) - b(k,40) = b(k,40) - lu(k,1593) * b(k,190) - b(k,39) = b(k,39) - lu(k,1592) * b(k,190) - b(k,38) = b(k,38) - lu(k,1591) * b(k,190) - b(k,37) = b(k,37) - lu(k,1590) * b(k,190) - b(k,35) = b(k,35) - lu(k,1589) * b(k,190) - b(k,34) = b(k,34) - lu(k,1588) * b(k,190) - b(k,33) = b(k,33) - lu(k,1587) * b(k,190) - b(k,32) = b(k,32) - lu(k,1586) * b(k,190) - b(k,31) = b(k,31) - lu(k,1585) * b(k,190) - b(k,30) = b(k,30) - lu(k,1584) * b(k,190) - b(k,29) = b(k,29) - lu(k,1583) * b(k,190) + b(k,231) = b(k,231) * lu(k,2204) + b(k,230) = b(k,230) - lu(k,2203) * b(k,231) + b(k,229) = b(k,229) - lu(k,2202) * b(k,231) + b(k,228) = b(k,228) - lu(k,2201) * b(k,231) + b(k,227) = b(k,227) - lu(k,2200) * b(k,231) + b(k,226) = b(k,226) - lu(k,2199) * b(k,231) + b(k,225) = b(k,225) - lu(k,2198) * b(k,231) + b(k,224) = b(k,224) - lu(k,2197) * b(k,231) + b(k,223) = b(k,223) - lu(k,2196) * b(k,231) + b(k,222) = b(k,222) - lu(k,2195) * b(k,231) + b(k,221) = b(k,221) - lu(k,2194) * b(k,231) + b(k,220) = b(k,220) - lu(k,2193) * b(k,231) + b(k,219) = b(k,219) - lu(k,2192) * b(k,231) + b(k,218) = b(k,218) - lu(k,2191) * b(k,231) + b(k,216) = b(k,216) - lu(k,2190) * b(k,231) + b(k,215) = b(k,215) - lu(k,2189) * b(k,231) + b(k,214) = b(k,214) - lu(k,2188) * b(k,231) + b(k,213) = b(k,213) - lu(k,2187) * b(k,231) + b(k,212) = b(k,212) - lu(k,2186) * b(k,231) + b(k,211) = b(k,211) - lu(k,2185) * b(k,231) + b(k,210) = b(k,210) - lu(k,2184) * b(k,231) + b(k,209) = b(k,209) - lu(k,2183) * b(k,231) + b(k,208) = b(k,208) - lu(k,2182) * b(k,231) + b(k,207) = b(k,207) - lu(k,2181) * b(k,231) + b(k,206) = b(k,206) - lu(k,2180) * b(k,231) + b(k,205) = b(k,205) - lu(k,2179) * b(k,231) + b(k,204) = b(k,204) - lu(k,2178) * b(k,231) + b(k,203) = b(k,203) - lu(k,2177) * b(k,231) + b(k,201) = b(k,201) - lu(k,2176) * b(k,231) + b(k,200) = b(k,200) - lu(k,2175) * b(k,231) + b(k,199) = b(k,199) - lu(k,2174) * b(k,231) + b(k,198) = b(k,198) - lu(k,2173) * b(k,231) + b(k,195) = b(k,195) - lu(k,2172) * b(k,231) + b(k,194) = b(k,194) - lu(k,2171) * b(k,231) + b(k,193) = b(k,193) - lu(k,2170) * b(k,231) + b(k,192) = b(k,192) - lu(k,2169) * b(k,231) + b(k,191) = b(k,191) - lu(k,2168) * b(k,231) + b(k,190) = b(k,190) - lu(k,2167) * b(k,231) + b(k,189) = b(k,189) - lu(k,2166) * b(k,231) + b(k,183) = b(k,183) - lu(k,2165) * b(k,231) + b(k,181) = b(k,181) - lu(k,2164) * b(k,231) + b(k,180) = b(k,180) - lu(k,2163) * b(k,231) + b(k,179) = b(k,179) - lu(k,2162) * b(k,231) + b(k,177) = b(k,177) - lu(k,2161) * b(k,231) + b(k,173) = b(k,173) - lu(k,2160) * b(k,231) + b(k,172) = b(k,172) - lu(k,2159) * b(k,231) + b(k,171) = b(k,171) - lu(k,2158) * b(k,231) + b(k,168) = b(k,168) - lu(k,2157) * b(k,231) + b(k,167) = b(k,167) - lu(k,2156) * b(k,231) + b(k,166) = b(k,166) - lu(k,2155) * b(k,231) + b(k,165) = b(k,165) - lu(k,2154) * b(k,231) + b(k,164) = b(k,164) - lu(k,2153) * b(k,231) + b(k,163) = b(k,163) - lu(k,2152) * b(k,231) + b(k,162) = b(k,162) - lu(k,2151) * b(k,231) + b(k,161) = b(k,161) - lu(k,2150) * b(k,231) + b(k,159) = b(k,159) - lu(k,2149) * b(k,231) + b(k,158) = b(k,158) - lu(k,2148) * b(k,231) + b(k,157) = b(k,157) - lu(k,2147) * b(k,231) + b(k,155) = b(k,155) - lu(k,2146) * b(k,231) + b(k,154) = b(k,154) - lu(k,2145) * b(k,231) + b(k,152) = b(k,152) - lu(k,2144) * b(k,231) + b(k,150) = b(k,150) - lu(k,2143) * b(k,231) + b(k,149) = b(k,149) - lu(k,2142) * b(k,231) + b(k,140) = b(k,140) - lu(k,2141) * b(k,231) + b(k,137) = b(k,137) - lu(k,2140) * b(k,231) + b(k,135) = b(k,135) - lu(k,2139) * b(k,231) + b(k,133) = b(k,133) - lu(k,2138) * b(k,231) + b(k,132) = b(k,132) - lu(k,2137) * b(k,231) + b(k,131) = b(k,131) - lu(k,2136) * b(k,231) + b(k,129) = b(k,129) - lu(k,2135) * b(k,231) + b(k,128) = b(k,128) - lu(k,2134) * b(k,231) + b(k,127) = b(k,127) - lu(k,2133) * b(k,231) + b(k,126) = b(k,126) - lu(k,2132) * b(k,231) + b(k,124) = b(k,124) - lu(k,2131) * b(k,231) + b(k,123) = b(k,123) - lu(k,2130) * b(k,231) + b(k,122) = b(k,122) - lu(k,2129) * b(k,231) + b(k,121) = b(k,121) - lu(k,2128) * b(k,231) + b(k,120) = b(k,120) - lu(k,2127) * b(k,231) + b(k,119) = b(k,119) - lu(k,2126) * b(k,231) + b(k,118) = b(k,118) - lu(k,2125) * b(k,231) + b(k,117) = b(k,117) - lu(k,2124) * b(k,231) + b(k,116) = b(k,116) - lu(k,2123) * b(k,231) + b(k,110) = b(k,110) - lu(k,2122) * b(k,231) + b(k,109) = b(k,109) - lu(k,2121) * b(k,231) + b(k,108) = b(k,108) - lu(k,2120) * b(k,231) + b(k,104) = b(k,104) - lu(k,2119) * b(k,231) + b(k,103) = b(k,103) - lu(k,2118) * b(k,231) + b(k,94) = b(k,94) - lu(k,2117) * b(k,231) + b(k,79) = b(k,79) - lu(k,2116) * b(k,231) + b(k,61) = b(k,61) - lu(k,2115) * b(k,231) + b(k,51) = b(k,51) - lu(k,2114) * b(k,231) + b(k,50) = b(k,50) - lu(k,2113) * b(k,231) + b(k,49) = b(k,49) - lu(k,2112) * b(k,231) + b(k,47) = b(k,47) - lu(k,2111) * b(k,231) + b(k,46) = b(k,46) - lu(k,2110) * b(k,231) + b(k,45) = b(k,45) - lu(k,2109) * b(k,231) + b(k,44) = b(k,44) - lu(k,2108) * b(k,231) + b(k,41) = b(k,41) - lu(k,2107) * b(k,231) + b(k,40) = b(k,40) - lu(k,2106) * b(k,231) + b(k,39) = b(k,39) - lu(k,2105) * b(k,231) + b(k,38) = b(k,38) - lu(k,2104) * b(k,231) + b(k,37) = b(k,37) - lu(k,2103) * b(k,231) + b(k,230) = b(k,230) * lu(k,2095) + b(k,229) = b(k,229) - lu(k,2094) * b(k,230) + b(k,228) = b(k,228) - lu(k,2093) * b(k,230) + b(k,227) = b(k,227) - lu(k,2092) * b(k,230) + b(k,226) = b(k,226) - lu(k,2091) * b(k,230) + b(k,225) = b(k,225) - lu(k,2090) * b(k,230) + b(k,224) = b(k,224) - lu(k,2089) * b(k,230) + b(k,223) = b(k,223) - lu(k,2088) * b(k,230) + b(k,222) = b(k,222) - lu(k,2087) * b(k,230) + b(k,221) = b(k,221) - lu(k,2086) * b(k,230) + b(k,220) = b(k,220) - lu(k,2085) * b(k,230) + b(k,219) = b(k,219) - lu(k,2084) * b(k,230) + b(k,218) = b(k,218) - lu(k,2083) * b(k,230) + b(k,216) = b(k,216) - lu(k,2082) * b(k,230) + b(k,229) = b(k,229) * lu(k,2073) + b(k,228) = b(k,228) - lu(k,2072) * b(k,229) + b(k,227) = b(k,227) - lu(k,2071) * b(k,229) + b(k,226) = b(k,226) - lu(k,2070) * b(k,229) + b(k,225) = b(k,225) - lu(k,2069) * b(k,229) + b(k,224) = b(k,224) - lu(k,2068) * b(k,229) + b(k,223) = b(k,223) - lu(k,2067) * b(k,229) + b(k,222) = b(k,222) - lu(k,2066) * b(k,229) + b(k,221) = b(k,221) - lu(k,2065) * b(k,229) + b(k,220) = b(k,220) - lu(k,2064) * b(k,229) + b(k,219) = b(k,219) - lu(k,2063) * b(k,229) + b(k,215) = b(k,215) - lu(k,2062) * b(k,229) + b(k,214) = b(k,214) - lu(k,2061) * b(k,229) + b(k,213) = b(k,213) - lu(k,2060) * b(k,229) + b(k,212) = b(k,212) - lu(k,2059) * b(k,229) + b(k,211) = b(k,211) - lu(k,2058) * b(k,229) + b(k,210) = b(k,210) - lu(k,2057) * b(k,229) + b(k,209) = b(k,209) - lu(k,2056) * b(k,229) + b(k,208) = b(k,208) - lu(k,2055) * b(k,229) + b(k,207) = b(k,207) - lu(k,2054) * b(k,229) + b(k,206) = b(k,206) - lu(k,2053) * b(k,229) + b(k,205) = b(k,205) - lu(k,2052) * b(k,229) + b(k,204) = b(k,204) - lu(k,2051) * b(k,229) + b(k,203) = b(k,203) - lu(k,2050) * b(k,229) + b(k,202) = b(k,202) - lu(k,2049) * b(k,229) + b(k,201) = b(k,201) - lu(k,2048) * b(k,229) + b(k,200) = b(k,200) - lu(k,2047) * b(k,229) + b(k,199) = b(k,199) - lu(k,2046) * b(k,229) + b(k,198) = b(k,198) - lu(k,2045) * b(k,229) + b(k,196) = b(k,196) - lu(k,2044) * b(k,229) + b(k,195) = b(k,195) - lu(k,2043) * b(k,229) + b(k,194) = b(k,194) - lu(k,2042) * b(k,229) + b(k,193) = b(k,193) - lu(k,2041) * b(k,229) + b(k,192) = b(k,192) - lu(k,2040) * b(k,229) + b(k,191) = b(k,191) - lu(k,2039) * b(k,229) + b(k,190) = b(k,190) - lu(k,2038) * b(k,229) + b(k,189) = b(k,189) - lu(k,2037) * b(k,229) + b(k,186) = b(k,186) - lu(k,2036) * b(k,229) + b(k,183) = b(k,183) - lu(k,2035) * b(k,229) + b(k,181) = b(k,181) - lu(k,2034) * b(k,229) + b(k,180) = b(k,180) - lu(k,2033) * b(k,229) + b(k,179) = b(k,179) - lu(k,2032) * b(k,229) + b(k,177) = b(k,177) - lu(k,2031) * b(k,229) + b(k,176) = b(k,176) - lu(k,2030) * b(k,229) + b(k,175) = b(k,175) - lu(k,2029) * b(k,229) + b(k,174) = b(k,174) - lu(k,2028) * b(k,229) + b(k,171) = b(k,171) - lu(k,2027) * b(k,229) + b(k,168) = b(k,168) - lu(k,2026) * b(k,229) + b(k,166) = b(k,166) - lu(k,2025) * b(k,229) + b(k,165) = b(k,165) - lu(k,2024) * b(k,229) + b(k,164) = b(k,164) - lu(k,2023) * b(k,229) + b(k,163) = b(k,163) - lu(k,2022) * b(k,229) + b(k,158) = b(k,158) - lu(k,2021) * b(k,229) + b(k,153) = b(k,153) - lu(k,2020) * b(k,229) + b(k,152) = b(k,152) - lu(k,2019) * b(k,229) + b(k,151) = b(k,151) - lu(k,2018) * b(k,229) + b(k,147) = b(k,147) - lu(k,2017) * b(k,229) + b(k,146) = b(k,146) - lu(k,2016) * b(k,229) + b(k,144) = b(k,144) - lu(k,2015) * b(k,229) + b(k,142) = b(k,142) - lu(k,2014) * b(k,229) + b(k,137) = b(k,137) - lu(k,2013) * b(k,229) + b(k,136) = b(k,136) - lu(k,2012) * b(k,229) + b(k,135) = b(k,135) - lu(k,2011) * b(k,229) + b(k,132) = b(k,132) - lu(k,2010) * b(k,229) + b(k,129) = b(k,129) - lu(k,2009) * b(k,229) + b(k,128) = b(k,128) - lu(k,2008) * b(k,229) + b(k,127) = b(k,127) - lu(k,2007) * b(k,229) + b(k,126) = b(k,126) - lu(k,2006) * b(k,229) + b(k,124) = b(k,124) - lu(k,2005) * b(k,229) + b(k,123) = b(k,123) - lu(k,2004) * b(k,229) + b(k,106) = b(k,106) - lu(k,2003) * b(k,229) + b(k,105) = b(k,105) - lu(k,2002) * b(k,229) + b(k,97) = b(k,97) - lu(k,2001) * b(k,229) + b(k,89) = b(k,89) - lu(k,2000) * b(k,229) + b(k,87) = b(k,87) - lu(k,1999) * b(k,229) + b(k,51) = b(k,51) - lu(k,1998) * b(k,229) + b(k,50) = b(k,50) - lu(k,1997) * b(k,229) + b(k,49) = b(k,49) - lu(k,1996) * b(k,229) + b(k,47) = b(k,47) - lu(k,1995) * b(k,229) + b(k,46) = b(k,46) - lu(k,1994) * b(k,229) + b(k,45) = b(k,45) - lu(k,1993) * b(k,229) + b(k,44) = b(k,44) - lu(k,1992) * b(k,229) + b(k,41) = b(k,41) - lu(k,1991) * b(k,229) + b(k,40) = b(k,40) - lu(k,1990) * b(k,229) + b(k,39) = b(k,39) - lu(k,1989) * b(k,229) + b(k,38) = b(k,38) - lu(k,1988) * b(k,229) + b(k,37) = b(k,37) - lu(k,1987) * b(k,229) end do end subroutine lu_slv08 subroutine lu_slv09( avec_len, lu, b ) @@ -1763,207 +1785,290 @@ subroutine lu_slv09( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,189) = b(k,189) * lu(k,1570) - b(k,188) = b(k,188) - lu(k,1569) * b(k,189) - b(k,187) = b(k,187) - lu(k,1568) * b(k,189) - b(k,186) = b(k,186) - lu(k,1567) * b(k,189) - b(k,185) = b(k,185) - lu(k,1566) * b(k,189) - b(k,184) = b(k,184) - lu(k,1565) * b(k,189) - b(k,183) = b(k,183) - lu(k,1564) * b(k,189) - b(k,172) = b(k,172) - lu(k,1563) * b(k,189) - b(k,145) = b(k,145) - lu(k,1562) * b(k,189) - b(k,136) = b(k,136) - lu(k,1561) * b(k,189) - b(k,52) = b(k,52) - lu(k,1560) * b(k,189) - b(k,51) = b(k,51) - lu(k,1559) * b(k,189) - b(k,46) = b(k,46) - lu(k,1558) * b(k,189) - b(k,40) = b(k,40) - lu(k,1557) * b(k,189) - b(k,188) = b(k,188) * lu(k,1543) - b(k,187) = b(k,187) - lu(k,1542) * b(k,188) - b(k,186) = b(k,186) - lu(k,1541) * b(k,188) - b(k,185) = b(k,185) - lu(k,1540) * b(k,188) - b(k,184) = b(k,184) - lu(k,1539) * b(k,188) - b(k,183) = b(k,183) - lu(k,1538) * b(k,188) - b(k,181) = b(k,181) - lu(k,1537) * b(k,188) - b(k,172) = b(k,172) - lu(k,1536) * b(k,188) - b(k,170) = b(k,170) - lu(k,1535) * b(k,188) - b(k,165) = b(k,165) - lu(k,1534) * b(k,188) - b(k,161) = b(k,161) - lu(k,1533) * b(k,188) - b(k,157) = b(k,157) - lu(k,1532) * b(k,188) - b(k,152) = b(k,152) - lu(k,1531) * b(k,188) - b(k,149) = b(k,149) - lu(k,1530) * b(k,188) - b(k,146) = b(k,146) - lu(k,1529) * b(k,188) - b(k,141) = b(k,141) - lu(k,1528) * b(k,188) - b(k,135) = b(k,135) - lu(k,1527) * b(k,188) - b(k,115) = b(k,115) - lu(k,1526) * b(k,188) - b(k,112) = b(k,112) - lu(k,1525) * b(k,188) - b(k,72) = b(k,72) - lu(k,1524) * b(k,188) - b(k,71) = b(k,71) - lu(k,1523) * b(k,188) - b(k,47) = b(k,47) - lu(k,1522) * b(k,188) - b(k,187) = b(k,187) * lu(k,1507) - b(k,186) = b(k,186) - lu(k,1506) * b(k,187) - b(k,185) = b(k,185) - lu(k,1505) * b(k,187) - b(k,184) = b(k,184) - lu(k,1504) * b(k,187) - b(k,181) = b(k,181) - lu(k,1503) * b(k,187) - b(k,180) = b(k,180) - lu(k,1502) * b(k,187) - b(k,179) = b(k,179) - lu(k,1501) * b(k,187) - b(k,178) = b(k,178) - lu(k,1500) * b(k,187) - b(k,177) = b(k,177) - lu(k,1499) * b(k,187) - b(k,176) = b(k,176) - lu(k,1498) * b(k,187) - b(k,175) = b(k,175) - lu(k,1497) * b(k,187) - b(k,174) = b(k,174) - lu(k,1496) * b(k,187) - b(k,173) = b(k,173) - lu(k,1495) * b(k,187) - b(k,171) = b(k,171) - lu(k,1494) * b(k,187) - b(k,170) = b(k,170) - lu(k,1493) * b(k,187) - b(k,169) = b(k,169) - lu(k,1492) * b(k,187) - b(k,168) = b(k,168) - lu(k,1491) * b(k,187) - b(k,167) = b(k,167) - lu(k,1490) * b(k,187) - b(k,166) = b(k,166) - lu(k,1489) * b(k,187) - b(k,165) = b(k,165) - lu(k,1488) * b(k,187) - b(k,164) = b(k,164) - lu(k,1487) * b(k,187) - b(k,163) = b(k,163) - lu(k,1486) * b(k,187) - b(k,162) = b(k,162) - lu(k,1485) * b(k,187) - b(k,161) = b(k,161) - lu(k,1484) * b(k,187) - b(k,159) = b(k,159) - lu(k,1483) * b(k,187) - b(k,158) = b(k,158) - lu(k,1482) * b(k,187) - b(k,156) = b(k,156) - lu(k,1481) * b(k,187) - b(k,154) = b(k,154) - lu(k,1480) * b(k,187) - b(k,152) = b(k,152) - lu(k,1479) * b(k,187) - b(k,150) = b(k,150) - lu(k,1478) * b(k,187) - b(k,149) = b(k,149) - lu(k,1477) * b(k,187) - b(k,147) = b(k,147) - lu(k,1476) * b(k,187) - b(k,144) = b(k,144) - lu(k,1475) * b(k,187) - b(k,143) = b(k,143) - lu(k,1474) * b(k,187) - b(k,142) = b(k,142) - lu(k,1473) * b(k,187) - b(k,141) = b(k,141) - lu(k,1472) * b(k,187) - b(k,139) = b(k,139) - lu(k,1471) * b(k,187) - b(k,138) = b(k,138) - lu(k,1470) * b(k,187) - b(k,137) = b(k,137) - lu(k,1469) * b(k,187) - b(k,135) = b(k,135) - lu(k,1468) * b(k,187) - b(k,133) = b(k,133) - lu(k,1467) * b(k,187) - b(k,132) = b(k,132) - lu(k,1466) * b(k,187) - b(k,131) = b(k,131) - lu(k,1465) * b(k,187) - b(k,130) = b(k,130) - lu(k,1464) * b(k,187) - b(k,125) = b(k,125) - lu(k,1463) * b(k,187) - b(k,123) = b(k,123) - lu(k,1462) * b(k,187) - b(k,122) = b(k,122) - lu(k,1461) * b(k,187) - b(k,121) = b(k,121) - lu(k,1460) * b(k,187) - b(k,119) = b(k,119) - lu(k,1459) * b(k,187) - b(k,118) = b(k,118) - lu(k,1458) * b(k,187) - b(k,113) = b(k,113) - lu(k,1457) * b(k,187) - b(k,108) = b(k,108) - lu(k,1456) * b(k,187) - b(k,107) = b(k,107) - lu(k,1455) * b(k,187) - b(k,104) = b(k,104) - lu(k,1454) * b(k,187) - b(k,103) = b(k,103) - lu(k,1453) * b(k,187) - b(k,101) = b(k,101) - lu(k,1452) * b(k,187) - b(k,98) = b(k,98) - lu(k,1451) * b(k,187) - b(k,96) = b(k,96) - lu(k,1450) * b(k,187) - b(k,95) = b(k,95) - lu(k,1449) * b(k,187) - b(k,94) = b(k,94) - lu(k,1448) * b(k,187) - b(k,93) = b(k,93) - lu(k,1447) * b(k,187) - b(k,92) = b(k,92) - lu(k,1446) * b(k,187) - b(k,76) = b(k,76) - lu(k,1445) * b(k,187) - b(k,73) = b(k,73) - lu(k,1444) * b(k,187) - b(k,70) = b(k,70) - lu(k,1443) * b(k,187) - b(k,64) = b(k,64) - lu(k,1442) * b(k,187) - b(k,61) = b(k,61) - lu(k,1441) * b(k,187) - b(k,186) = b(k,186) * lu(k,1427) - b(k,184) = b(k,184) - lu(k,1426) * b(k,186) - b(k,182) = b(k,182) - lu(k,1425) * b(k,186) - b(k,165) = b(k,165) - lu(k,1424) * b(k,186) - b(k,161) = b(k,161) - lu(k,1423) * b(k,186) - b(k,155) = b(k,155) - lu(k,1422) * b(k,186) - b(k,144) = b(k,144) - lu(k,1421) * b(k,186) - b(k,139) = b(k,139) - lu(k,1420) * b(k,186) - b(k,138) = b(k,138) - lu(k,1419) * b(k,186) - b(k,137) = b(k,137) - lu(k,1418) * b(k,186) - b(k,129) = b(k,129) - lu(k,1417) * b(k,186) - b(k,126) = b(k,126) - lu(k,1416) * b(k,186) - b(k,120) = b(k,120) - lu(k,1415) * b(k,186) - b(k,106) = b(k,106) - lu(k,1414) * b(k,186) - b(k,102) = b(k,102) - lu(k,1413) * b(k,186) - b(k,96) = b(k,96) - lu(k,1412) * b(k,186) - b(k,46) = b(k,46) - lu(k,1411) * b(k,186) - b(k,45) = b(k,45) - lu(k,1410) * b(k,186) - b(k,185) = b(k,185) * lu(k,1396) - b(k,181) = b(k,181) - lu(k,1395) * b(k,185) - b(k,180) = b(k,180) - lu(k,1394) * b(k,185) - b(k,179) = b(k,179) - lu(k,1393) * b(k,185) - b(k,178) = b(k,178) - lu(k,1392) * b(k,185) - b(k,177) = b(k,177) - lu(k,1391) * b(k,185) - b(k,176) = b(k,176) - lu(k,1390) * b(k,185) - b(k,175) = b(k,175) - lu(k,1389) * b(k,185) - b(k,174) = b(k,174) - lu(k,1388) * b(k,185) - b(k,173) = b(k,173) - lu(k,1387) * b(k,185) - b(k,171) = b(k,171) - lu(k,1386) * b(k,185) - b(k,170) = b(k,170) - lu(k,1385) * b(k,185) - b(k,169) = b(k,169) - lu(k,1384) * b(k,185) - b(k,168) = b(k,168) - lu(k,1383) * b(k,185) - b(k,167) = b(k,167) - lu(k,1382) * b(k,185) - b(k,166) = b(k,166) - lu(k,1381) * b(k,185) - b(k,165) = b(k,165) - lu(k,1380) * b(k,185) - b(k,164) = b(k,164) - lu(k,1379) * b(k,185) - b(k,163) = b(k,163) - lu(k,1378) * b(k,185) - b(k,161) = b(k,161) - lu(k,1377) * b(k,185) - b(k,159) = b(k,159) - lu(k,1376) * b(k,185) - b(k,158) = b(k,158) - lu(k,1375) * b(k,185) - b(k,156) = b(k,156) - lu(k,1374) * b(k,185) - b(k,152) = b(k,152) - lu(k,1373) * b(k,185) - b(k,149) = b(k,149) - lu(k,1372) * b(k,185) - b(k,147) = b(k,147) - lu(k,1371) * b(k,185) - b(k,143) = b(k,143) - lu(k,1370) * b(k,185) - b(k,140) = b(k,140) - lu(k,1369) * b(k,185) - b(k,121) = b(k,121) - lu(k,1368) * b(k,185) - b(k,111) = b(k,111) - lu(k,1367) * b(k,185) - b(k,90) = b(k,90) - lu(k,1366) * b(k,185) - b(k,83) = b(k,83) - lu(k,1365) * b(k,185) - b(k,73) = b(k,73) - lu(k,1364) * b(k,185) - b(k,66) = b(k,66) - lu(k,1363) * b(k,185) - b(k,184) = b(k,184) * lu(k,1352) - b(k,165) = b(k,165) - lu(k,1351) * b(k,184) - b(k,145) = b(k,145) - lu(k,1350) * b(k,184) - b(k,183) = b(k,183) * lu(k,1337) - b(k,157) = b(k,157) - lu(k,1336) * b(k,183) - b(k,146) = b(k,146) - lu(k,1335) * b(k,183) - b(k,134) = b(k,134) - lu(k,1334) * b(k,183) - b(k,63) = b(k,63) - lu(k,1333) * b(k,183) - b(k,47) = b(k,47) - lu(k,1332) * b(k,183) - b(k,182) = b(k,182) * lu(k,1318) - b(k,155) = b(k,155) - lu(k,1317) * b(k,182) - b(k,129) = b(k,129) - lu(k,1316) * b(k,182) - b(k,77) = b(k,77) - lu(k,1315) * b(k,182) - b(k,181) = b(k,181) * lu(k,1302) - b(k,180) = b(k,180) - lu(k,1301) * b(k,181) - b(k,179) = b(k,179) - lu(k,1300) * b(k,181) - b(k,178) = b(k,178) - lu(k,1299) * b(k,181) - b(k,177) = b(k,177) - lu(k,1298) * b(k,181) - b(k,176) = b(k,176) - lu(k,1297) * b(k,181) - b(k,175) = b(k,175) - lu(k,1296) * b(k,181) - b(k,174) = b(k,174) - lu(k,1295) * b(k,181) - b(k,173) = b(k,173) - lu(k,1294) * b(k,181) - b(k,171) = b(k,171) - lu(k,1293) * b(k,181) - b(k,165) = b(k,165) - lu(k,1292) * b(k,181) - b(k,164) = b(k,164) - lu(k,1291) * b(k,181) - b(k,161) = b(k,161) - lu(k,1290) * b(k,181) - b(k,159) = b(k,159) - lu(k,1289) * b(k,181) - b(k,149) = b(k,149) - lu(k,1288) * b(k,181) - b(k,111) = b(k,111) - lu(k,1287) * b(k,181) - b(k,105) = b(k,105) - lu(k,1286) * b(k,181) - b(k,97) = b(k,97) - lu(k,1285) * b(k,181) - b(k,73) = b(k,73) - lu(k,1284) * b(k,181) - b(k,180) = b(k,180) * lu(k,1271) - b(k,175) = b(k,175) - lu(k,1270) * b(k,180) - b(k,164) = b(k,164) - lu(k,1269) * b(k,180) - b(k,114) = b(k,114) - lu(k,1268) * b(k,180) - b(k,111) = b(k,111) - lu(k,1267) * b(k,180) - b(k,105) = b(k,105) - lu(k,1266) * b(k,180) - b(k,179) = b(k,179) * lu(k,1251) - b(k,178) = b(k,178) - lu(k,1250) * b(k,179) - b(k,175) = b(k,175) - lu(k,1249) * b(k,179) - b(k,170) = b(k,170) - lu(k,1248) * b(k,179) - b(k,165) = b(k,165) - lu(k,1247) * b(k,179) - b(k,164) = b(k,164) - lu(k,1246) * b(k,179) - b(k,160) = b(k,160) - lu(k,1245) * b(k,179) - b(k,141) = b(k,141) - lu(k,1244) * b(k,179) + b(k,228) = b(k,228) * lu(k,1977) + b(k,227) = b(k,227) - lu(k,1976) * b(k,228) + b(k,226) = b(k,226) - lu(k,1975) * b(k,228) + b(k,225) = b(k,225) - lu(k,1974) * b(k,228) + b(k,224) = b(k,224) - lu(k,1973) * b(k,228) + b(k,223) = b(k,223) - lu(k,1972) * b(k,228) + b(k,222) = b(k,222) - lu(k,1971) * b(k,228) + b(k,221) = b(k,221) - lu(k,1970) * b(k,228) + b(k,220) = b(k,220) - lu(k,1969) * b(k,228) + b(k,219) = b(k,219) - lu(k,1968) * b(k,228) + b(k,218) = b(k,218) - lu(k,1967) * b(k,228) + b(k,216) = b(k,216) - lu(k,1966) * b(k,228) + b(k,182) = b(k,182) - lu(k,1965) * b(k,228) + b(k,98) = b(k,98) - lu(k,1964) * b(k,228) + b(k,227) = b(k,227) * lu(k,1953) + b(k,226) = b(k,226) - lu(k,1952) * b(k,227) + b(k,225) = b(k,225) - lu(k,1951) * b(k,227) + b(k,224) = b(k,224) - lu(k,1950) * b(k,227) + b(k,223) = b(k,223) - lu(k,1949) * b(k,227) + b(k,222) = b(k,222) - lu(k,1948) * b(k,227) + b(k,221) = b(k,221) - lu(k,1947) * b(k,227) + b(k,220) = b(k,220) - lu(k,1946) * b(k,227) + b(k,219) = b(k,219) - lu(k,1945) * b(k,227) + b(k,218) = b(k,218) - lu(k,1944) * b(k,227) + b(k,216) = b(k,216) - lu(k,1943) * b(k,227) + b(k,215) = b(k,215) - lu(k,1942) * b(k,227) + b(k,214) = b(k,214) - lu(k,1941) * b(k,227) + b(k,208) = b(k,208) - lu(k,1940) * b(k,227) + b(k,204) = b(k,204) - lu(k,1939) * b(k,227) + b(k,200) = b(k,200) - lu(k,1938) * b(k,227) + b(k,199) = b(k,199) - lu(k,1937) * b(k,227) + b(k,198) = b(k,198) - lu(k,1936) * b(k,227) + b(k,193) = b(k,193) - lu(k,1935) * b(k,227) + b(k,190) = b(k,190) - lu(k,1934) * b(k,227) + b(k,185) = b(k,185) - lu(k,1933) * b(k,227) + b(k,183) = b(k,183) - lu(k,1932) * b(k,227) + b(k,180) = b(k,180) - lu(k,1931) * b(k,227) + b(k,179) = b(k,179) - lu(k,1930) * b(k,227) + b(k,173) = b(k,173) - lu(k,1929) * b(k,227) + b(k,168) = b(k,168) - lu(k,1928) * b(k,227) + b(k,149) = b(k,149) - lu(k,1927) * b(k,227) + b(k,148) = b(k,148) - lu(k,1926) * b(k,227) + b(k,141) = b(k,141) - lu(k,1925) * b(k,227) + b(k,130) = b(k,130) - lu(k,1924) * b(k,227) + b(k,125) = b(k,125) - lu(k,1923) * b(k,227) + b(k,113) = b(k,113) - lu(k,1922) * b(k,227) + b(k,101) = b(k,101) - lu(k,1921) * b(k,227) + b(k,100) = b(k,100) - lu(k,1920) * b(k,227) + b(k,99) = b(k,99) - lu(k,1919) * b(k,227) + b(k,72) = b(k,72) - lu(k,1918) * b(k,227) + b(k,226) = b(k,226) * lu(k,1906) + b(k,225) = b(k,225) - lu(k,1905) * b(k,226) + b(k,224) = b(k,224) - lu(k,1904) * b(k,226) + b(k,223) = b(k,223) - lu(k,1903) * b(k,226) + b(k,222) = b(k,222) - lu(k,1902) * b(k,226) + b(k,221) = b(k,221) - lu(k,1901) * b(k,226) + b(k,220) = b(k,220) - lu(k,1900) * b(k,226) + b(k,219) = b(k,219) - lu(k,1899) * b(k,226) + b(k,217) = b(k,217) - lu(k,1898) * b(k,226) + b(k,215) = b(k,215) - lu(k,1897) * b(k,226) + b(k,214) = b(k,214) - lu(k,1896) * b(k,226) + b(k,213) = b(k,213) - lu(k,1895) * b(k,226) + b(k,212) = b(k,212) - lu(k,1894) * b(k,226) + b(k,211) = b(k,211) - lu(k,1893) * b(k,226) + b(k,210) = b(k,210) - lu(k,1892) * b(k,226) + b(k,209) = b(k,209) - lu(k,1891) * b(k,226) + b(k,208) = b(k,208) - lu(k,1890) * b(k,226) + b(k,207) = b(k,207) - lu(k,1889) * b(k,226) + b(k,206) = b(k,206) - lu(k,1888) * b(k,226) + b(k,205) = b(k,205) - lu(k,1887) * b(k,226) + b(k,204) = b(k,204) - lu(k,1886) * b(k,226) + b(k,203) = b(k,203) - lu(k,1885) * b(k,226) + b(k,202) = b(k,202) - lu(k,1884) * b(k,226) + b(k,201) = b(k,201) - lu(k,1883) * b(k,226) + b(k,200) = b(k,200) - lu(k,1882) * b(k,226) + b(k,199) = b(k,199) - lu(k,1881) * b(k,226) + b(k,198) = b(k,198) - lu(k,1880) * b(k,226) + b(k,197) = b(k,197) - lu(k,1879) * b(k,226) + b(k,196) = b(k,196) - lu(k,1878) * b(k,226) + b(k,195) = b(k,195) - lu(k,1877) * b(k,226) + b(k,194) = b(k,194) - lu(k,1876) * b(k,226) + b(k,193) = b(k,193) - lu(k,1875) * b(k,226) + b(k,192) = b(k,192) - lu(k,1874) * b(k,226) + b(k,191) = b(k,191) - lu(k,1873) * b(k,226) + b(k,190) = b(k,190) - lu(k,1872) * b(k,226) + b(k,189) = b(k,189) - lu(k,1871) * b(k,226) + b(k,188) = b(k,188) - lu(k,1870) * b(k,226) + b(k,187) = b(k,187) - lu(k,1869) * b(k,226) + b(k,184) = b(k,184) - lu(k,1868) * b(k,226) + b(k,180) = b(k,180) - lu(k,1867) * b(k,226) + b(k,178) = b(k,178) - lu(k,1866) * b(k,226) + b(k,177) = b(k,177) - lu(k,1865) * b(k,226) + b(k,144) = b(k,144) - lu(k,1864) * b(k,226) + b(k,111) = b(k,111) - lu(k,1863) * b(k,226) + b(k,105) = b(k,105) - lu(k,1862) * b(k,226) + b(k,102) = b(k,102) - lu(k,1861) * b(k,226) + b(k,96) = b(k,96) - lu(k,1860) * b(k,226) + b(k,41) = b(k,41) - lu(k,1859) * b(k,226) + b(k,40) = b(k,40) - lu(k,1858) * b(k,226) + b(k,225) = b(k,225) * lu(k,1845) + b(k,224) = b(k,224) - lu(k,1844) * b(k,225) + b(k,223) = b(k,223) - lu(k,1843) * b(k,225) + b(k,222) = b(k,222) - lu(k,1842) * b(k,225) + b(k,221) = b(k,221) - lu(k,1841) * b(k,225) + b(k,220) = b(k,220) - lu(k,1840) * b(k,225) + b(k,219) = b(k,219) - lu(k,1839) * b(k,225) + b(k,218) = b(k,218) - lu(k,1838) * b(k,225) + b(k,217) = b(k,217) - lu(k,1837) * b(k,225) + b(k,215) = b(k,215) - lu(k,1836) * b(k,225) + b(k,214) = b(k,214) - lu(k,1835) * b(k,225) + b(k,213) = b(k,213) - lu(k,1834) * b(k,225) + b(k,208) = b(k,208) - lu(k,1833) * b(k,225) + b(k,203) = b(k,203) - lu(k,1832) * b(k,225) + b(k,199) = b(k,199) - lu(k,1831) * b(k,225) + b(k,190) = b(k,190) - lu(k,1830) * b(k,225) + b(k,186) = b(k,186) - lu(k,1829) * b(k,225) + b(k,185) = b(k,185) - lu(k,1828) * b(k,225) + b(k,184) = b(k,184) - lu(k,1827) * b(k,225) + b(k,181) = b(k,181) - lu(k,1826) * b(k,225) + b(k,167) = b(k,167) - lu(k,1825) * b(k,225) + b(k,166) = b(k,166) - lu(k,1824) * b(k,225) + b(k,163) = b(k,163) - lu(k,1823) * b(k,225) + b(k,152) = b(k,152) - lu(k,1822) * b(k,225) + b(k,145) = b(k,145) - lu(k,1821) * b(k,225) + b(k,143) = b(k,143) - lu(k,1820) * b(k,225) + b(k,139) = b(k,139) - lu(k,1819) * b(k,225) + b(k,137) = b(k,137) - lu(k,1818) * b(k,225) + b(k,133) = b(k,133) - lu(k,1817) * b(k,225) + b(k,129) = b(k,129) - lu(k,1816) * b(k,225) + b(k,96) = b(k,96) - lu(k,1815) * b(k,225) + b(k,91) = b(k,91) - lu(k,1814) * b(k,225) + b(k,64) = b(k,64) - lu(k,1813) * b(k,225) + b(k,224) = b(k,224) * lu(k,1799) + b(k,223) = b(k,223) - lu(k,1798) * b(k,224) + b(k,222) = b(k,222) - lu(k,1797) * b(k,224) + b(k,221) = b(k,221) - lu(k,1796) * b(k,224) + b(k,220) = b(k,220) - lu(k,1795) * b(k,224) + b(k,219) = b(k,219) - lu(k,1794) * b(k,224) + b(k,218) = b(k,218) - lu(k,1793) * b(k,224) + b(k,217) = b(k,217) - lu(k,1792) * b(k,224) + b(k,216) = b(k,216) - lu(k,1791) * b(k,224) + b(k,215) = b(k,215) - lu(k,1790) * b(k,224) + b(k,214) = b(k,214) - lu(k,1789) * b(k,224) + b(k,213) = b(k,213) - lu(k,1788) * b(k,224) + b(k,212) = b(k,212) - lu(k,1787) * b(k,224) + b(k,211) = b(k,211) - lu(k,1786) * b(k,224) + b(k,210) = b(k,210) - lu(k,1785) * b(k,224) + b(k,209) = b(k,209) - lu(k,1784) * b(k,224) + b(k,208) = b(k,208) - lu(k,1783) * b(k,224) + b(k,207) = b(k,207) - lu(k,1782) * b(k,224) + b(k,206) = b(k,206) - lu(k,1781) * b(k,224) + b(k,205) = b(k,205) - lu(k,1780) * b(k,224) + b(k,204) = b(k,204) - lu(k,1779) * b(k,224) + b(k,203) = b(k,203) - lu(k,1778) * b(k,224) + b(k,202) = b(k,202) - lu(k,1777) * b(k,224) + b(k,201) = b(k,201) - lu(k,1776) * b(k,224) + b(k,200) = b(k,200) - lu(k,1775) * b(k,224) + b(k,199) = b(k,199) - lu(k,1774) * b(k,224) + b(k,198) = b(k,198) - lu(k,1773) * b(k,224) + b(k,197) = b(k,197) - lu(k,1772) * b(k,224) + b(k,196) = b(k,196) - lu(k,1771) * b(k,224) + b(k,195) = b(k,195) - lu(k,1770) * b(k,224) + b(k,194) = b(k,194) - lu(k,1769) * b(k,224) + b(k,193) = b(k,193) - lu(k,1768) * b(k,224) + b(k,192) = b(k,192) - lu(k,1767) * b(k,224) + b(k,191) = b(k,191) - lu(k,1766) * b(k,224) + b(k,190) = b(k,190) - lu(k,1765) * b(k,224) + b(k,189) = b(k,189) - lu(k,1764) * b(k,224) + b(k,188) = b(k,188) - lu(k,1763) * b(k,224) + b(k,187) = b(k,187) - lu(k,1762) * b(k,224) + b(k,186) = b(k,186) - lu(k,1761) * b(k,224) + b(k,185) = b(k,185) - lu(k,1760) * b(k,224) + b(k,184) = b(k,184) - lu(k,1759) * b(k,224) + b(k,183) = b(k,183) - lu(k,1758) * b(k,224) + b(k,182) = b(k,182) - lu(k,1757) * b(k,224) + b(k,181) = b(k,181) - lu(k,1756) * b(k,224) + b(k,180) = b(k,180) - lu(k,1755) * b(k,224) + b(k,179) = b(k,179) - lu(k,1754) * b(k,224) + b(k,178) = b(k,178) - lu(k,1753) * b(k,224) + b(k,177) = b(k,177) - lu(k,1752) * b(k,224) + b(k,173) = b(k,173) - lu(k,1751) * b(k,224) + b(k,172) = b(k,172) - lu(k,1750) * b(k,224) + b(k,171) = b(k,171) - lu(k,1749) * b(k,224) + b(k,170) = b(k,170) - lu(k,1748) * b(k,224) + b(k,168) = b(k,168) - lu(k,1747) * b(k,224) + b(k,166) = b(k,166) - lu(k,1746) * b(k,224) + b(k,165) = b(k,165) - lu(k,1745) * b(k,224) + b(k,164) = b(k,164) - lu(k,1744) * b(k,224) + b(k,163) = b(k,163) - lu(k,1743) * b(k,224) + b(k,162) = b(k,162) - lu(k,1742) * b(k,224) + b(k,161) = b(k,161) - lu(k,1741) * b(k,224) + b(k,160) = b(k,160) - lu(k,1740) * b(k,224) + b(k,159) = b(k,159) - lu(k,1739) * b(k,224) + b(k,158) = b(k,158) - lu(k,1738) * b(k,224) + b(k,157) = b(k,157) - lu(k,1737) * b(k,224) + b(k,155) = b(k,155) - lu(k,1736) * b(k,224) + b(k,154) = b(k,154) - lu(k,1735) * b(k,224) + b(k,153) = b(k,153) - lu(k,1734) * b(k,224) + b(k,152) = b(k,152) - lu(k,1733) * b(k,224) + b(k,151) = b(k,151) - lu(k,1732) * b(k,224) + b(k,150) = b(k,150) - lu(k,1731) * b(k,224) + b(k,149) = b(k,149) - lu(k,1730) * b(k,224) + b(k,148) = b(k,148) - lu(k,1729) * b(k,224) + b(k,147) = b(k,147) - lu(k,1728) * b(k,224) + b(k,146) = b(k,146) - lu(k,1727) * b(k,224) + b(k,145) = b(k,145) - lu(k,1726) * b(k,224) + b(k,144) = b(k,144) - lu(k,1725) * b(k,224) + b(k,142) = b(k,142) - lu(k,1724) * b(k,224) + b(k,141) = b(k,141) - lu(k,1723) * b(k,224) + b(k,140) = b(k,140) - lu(k,1722) * b(k,224) + b(k,139) = b(k,139) - lu(k,1721) * b(k,224) + b(k,137) = b(k,137) - lu(k,1720) * b(k,224) + b(k,136) = b(k,136) - lu(k,1719) * b(k,224) + b(k,135) = b(k,135) - lu(k,1718) * b(k,224) + b(k,133) = b(k,133) - lu(k,1717) * b(k,224) + b(k,132) = b(k,132) - lu(k,1716) * b(k,224) + b(k,131) = b(k,131) - lu(k,1715) * b(k,224) + b(k,130) = b(k,130) - lu(k,1714) * b(k,224) + b(k,129) = b(k,129) - lu(k,1713) * b(k,224) + b(k,127) = b(k,127) - lu(k,1712) * b(k,224) + b(k,126) = b(k,126) - lu(k,1711) * b(k,224) + b(k,125) = b(k,125) - lu(k,1710) * b(k,224) + b(k,123) = b(k,123) - lu(k,1709) * b(k,224) + b(k,122) = b(k,122) - lu(k,1708) * b(k,224) + b(k,121) = b(k,121) - lu(k,1707) * b(k,224) + b(k,120) = b(k,120) - lu(k,1706) * b(k,224) + b(k,119) = b(k,119) - lu(k,1705) * b(k,224) + b(k,118) = b(k,118) - lu(k,1704) * b(k,224) + b(k,117) = b(k,117) - lu(k,1703) * b(k,224) + b(k,116) = b(k,116) - lu(k,1702) * b(k,224) + b(k,114) = b(k,114) - lu(k,1701) * b(k,224) + b(k,113) = b(k,113) - lu(k,1700) * b(k,224) + b(k,112) = b(k,112) - lu(k,1699) * b(k,224) + b(k,111) = b(k,111) - lu(k,1698) * b(k,224) + b(k,110) = b(k,110) - lu(k,1697) * b(k,224) + b(k,109) = b(k,109) - lu(k,1696) * b(k,224) + b(k,108) = b(k,108) - lu(k,1695) * b(k,224) + b(k,105) = b(k,105) - lu(k,1694) * b(k,224) + b(k,104) = b(k,104) - lu(k,1693) * b(k,224) + b(k,103) = b(k,103) - lu(k,1692) * b(k,224) + b(k,102) = b(k,102) - lu(k,1691) * b(k,224) + b(k,101) = b(k,101) - lu(k,1690) * b(k,224) + b(k,100) = b(k,100) - lu(k,1689) * b(k,224) + b(k,99) = b(k,99) - lu(k,1688) * b(k,224) + b(k,95) = b(k,95) - lu(k,1687) * b(k,224) + b(k,94) = b(k,94) - lu(k,1686) * b(k,224) + b(k,93) = b(k,93) - lu(k,1685) * b(k,224) + b(k,92) = b(k,92) - lu(k,1684) * b(k,224) + b(k,90) = b(k,90) - lu(k,1683) * b(k,224) + b(k,89) = b(k,89) - lu(k,1682) * b(k,224) + b(k,88) = b(k,88) - lu(k,1681) * b(k,224) + b(k,87) = b(k,87) - lu(k,1680) * b(k,224) + b(k,85) = b(k,85) - lu(k,1679) * b(k,224) + b(k,84) = b(k,84) - lu(k,1678) * b(k,224) + b(k,83) = b(k,83) - lu(k,1677) * b(k,224) + b(k,82) = b(k,82) - lu(k,1676) * b(k,224) + b(k,81) = b(k,81) - lu(k,1675) * b(k,224) + b(k,80) = b(k,80) - lu(k,1674) * b(k,224) + b(k,79) = b(k,79) - lu(k,1673) * b(k,224) + b(k,78) = b(k,78) - lu(k,1672) * b(k,224) + b(k,77) = b(k,77) - lu(k,1671) * b(k,224) + b(k,76) = b(k,76) - lu(k,1670) * b(k,224) + b(k,75) = b(k,75) - lu(k,1669) * b(k,224) + b(k,71) = b(k,71) - lu(k,1668) * b(k,224) + b(k,70) = b(k,70) - lu(k,1667) * b(k,224) + b(k,69) = b(k,69) - lu(k,1666) * b(k,224) + b(k,63) = b(k,63) - lu(k,1665) * b(k,224) + b(k,60) = b(k,60) - lu(k,1664) * b(k,224) + b(k,55) = b(k,55) - lu(k,1663) * b(k,224) + b(k,53) = b(k,53) - lu(k,1662) * b(k,224) + b(k,51) = b(k,51) - lu(k,1661) * b(k,224) + b(k,50) = b(k,50) - lu(k,1660) * b(k,224) + b(k,49) = b(k,49) - lu(k,1659) * b(k,224) + b(k,48) = b(k,48) - lu(k,1658) * b(k,224) + b(k,47) = b(k,47) - lu(k,1657) * b(k,224) + b(k,46) = b(k,46) - lu(k,1656) * b(k,224) + b(k,45) = b(k,45) - lu(k,1655) * b(k,224) + b(k,44) = b(k,44) - lu(k,1654) * b(k,224) + b(k,43) = b(k,43) - lu(k,1653) * b(k,224) + b(k,41) = b(k,41) - lu(k,1652) * b(k,224) + b(k,40) = b(k,40) - lu(k,1651) * b(k,224) + b(k,39) = b(k,39) - lu(k,1650) * b(k,224) + b(k,38) = b(k,38) - lu(k,1649) * b(k,224) + b(k,37) = b(k,37) - lu(k,1648) * b(k,224) end do end subroutine lu_slv09 subroutine lu_slv10( avec_len, lu, b ) @@ -1984,210 +2089,207 @@ subroutine lu_slv10( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,178) = b(k,178) * lu(k,1231) - b(k,175) = b(k,175) - lu(k,1230) * b(k,178) - b(k,170) = b(k,170) - lu(k,1229) * b(k,178) - b(k,169) = b(k,169) - lu(k,1228) * b(k,178) - b(k,165) = b(k,165) - lu(k,1227) * b(k,178) - b(k,164) = b(k,164) - lu(k,1226) * b(k,178) - b(k,162) = b(k,162) - lu(k,1225) * b(k,178) - b(k,161) = b(k,161) - lu(k,1224) * b(k,178) - b(k,140) = b(k,140) - lu(k,1223) * b(k,178) - b(k,74) = b(k,74) - lu(k,1222) * b(k,178) - b(k,177) = b(k,177) * lu(k,1206) - b(k,175) = b(k,175) - lu(k,1205) * b(k,177) - b(k,174) = b(k,174) - lu(k,1204) * b(k,177) - b(k,171) = b(k,171) - lu(k,1203) * b(k,177) - b(k,170) = b(k,170) - lu(k,1202) * b(k,177) - b(k,169) = b(k,169) - lu(k,1201) * b(k,177) - b(k,165) = b(k,165) - lu(k,1200) * b(k,177) - b(k,164) = b(k,164) - lu(k,1199) * b(k,177) - b(k,162) = b(k,162) - lu(k,1198) * b(k,177) - b(k,161) = b(k,161) - lu(k,1197) * b(k,177) - b(k,150) = b(k,150) - lu(k,1196) * b(k,177) - b(k,149) = b(k,149) - lu(k,1195) * b(k,177) - b(k,147) = b(k,147) - lu(k,1194) * b(k,177) - b(k,140) = b(k,140) - lu(k,1193) * b(k,177) - b(k,127) = b(k,127) - lu(k,1192) * b(k,177) - b(k,118) = b(k,118) - lu(k,1191) * b(k,177) - b(k,108) = b(k,108) - lu(k,1190) * b(k,177) - b(k,73) = b(k,73) - lu(k,1189) * b(k,177) - b(k,60) = b(k,60) - lu(k,1188) * b(k,177) - b(k,176) = b(k,176) * lu(k,1172) - b(k,175) = b(k,175) - lu(k,1171) * b(k,176) - b(k,174) = b(k,174) - lu(k,1170) * b(k,176) - b(k,171) = b(k,171) - lu(k,1169) * b(k,176) - b(k,170) = b(k,170) - lu(k,1168) * b(k,176) - b(k,169) = b(k,169) - lu(k,1167) * b(k,176) - b(k,165) = b(k,165) - lu(k,1166) * b(k,176) - b(k,164) = b(k,164) - lu(k,1165) * b(k,176) - b(k,162) = b(k,162) - lu(k,1164) * b(k,176) - b(k,161) = b(k,161) - lu(k,1163) * b(k,176) - b(k,140) = b(k,140) - lu(k,1162) * b(k,176) - b(k,127) = b(k,127) - lu(k,1161) * b(k,176) - b(k,119) = b(k,119) - lu(k,1160) * b(k,176) - b(k,175) = b(k,175) * lu(k,1152) - b(k,165) = b(k,165) - lu(k,1151) * b(k,175) - b(k,174) = b(k,174) * lu(k,1140) - b(k,165) = b(k,165) - lu(k,1139) * b(k,174) - b(k,141) = b(k,141) - lu(k,1138) * b(k,174) - b(k,173) = b(k,173) * lu(k,1124) - b(k,171) = b(k,171) - lu(k,1123) * b(k,173) - b(k,165) = b(k,165) - lu(k,1122) * b(k,173) - b(k,161) = b(k,161) - lu(k,1121) * b(k,173) - b(k,159) = b(k,159) - lu(k,1120) * b(k,173) - b(k,147) = b(k,147) - lu(k,1119) * b(k,173) - b(k,140) = b(k,140) - lu(k,1118) * b(k,173) - b(k,127) = b(k,127) - lu(k,1117) * b(k,173) - b(k,88) = b(k,88) - lu(k,1116) * b(k,173) - b(k,83) = b(k,83) - lu(k,1115) * b(k,173) - b(k,172) = b(k,172) * lu(k,1104) - b(k,136) = b(k,136) - lu(k,1103) * b(k,172) - b(k,59) = b(k,59) - lu(k,1102) * b(k,172) - b(k,171) = b(k,171) * lu(k,1091) - b(k,165) = b(k,165) - lu(k,1090) * b(k,171) - b(k,164) = b(k,164) - lu(k,1089) * b(k,171) - b(k,161) = b(k,161) - lu(k,1088) * b(k,171) - b(k,149) = b(k,149) - lu(k,1087) * b(k,171) - b(k,140) = b(k,140) - lu(k,1086) * b(k,171) - b(k,56) = b(k,56) - lu(k,1085) * b(k,171) - b(k,170) = b(k,170) * lu(k,1076) - b(k,165) = b(k,165) - lu(k,1075) * b(k,170) - b(k,169) = b(k,169) * lu(k,1065) - b(k,164) = b(k,164) - lu(k,1064) * b(k,169) - b(k,140) = b(k,140) - lu(k,1063) * b(k,169) - b(k,87) = b(k,87) - lu(k,1062) * b(k,169) - b(k,168) = b(k,168) * lu(k,1049) - b(k,167) = b(k,167) - lu(k,1048) * b(k,168) - b(k,165) = b(k,165) - lu(k,1047) * b(k,168) - b(k,163) = b(k,163) - lu(k,1046) * b(k,168) - b(k,158) = b(k,158) - lu(k,1045) * b(k,168) - b(k,140) = b(k,140) - lu(k,1044) * b(k,168) - b(k,121) = b(k,121) - lu(k,1043) * b(k,168) - b(k,86) = b(k,86) - lu(k,1042) * b(k,168) - b(k,167) = b(k,167) * lu(k,1030) - b(k,165) = b(k,165) - lu(k,1029) * b(k,167) - b(k,163) = b(k,163) - lu(k,1028) * b(k,167) - b(k,161) = b(k,161) - lu(k,1027) * b(k,167) - b(k,156) = b(k,156) - lu(k,1026) * b(k,167) - b(k,140) = b(k,140) - lu(k,1025) * b(k,167) - b(k,116) = b(k,116) - lu(k,1024) * b(k,167) - b(k,61) = b(k,61) - lu(k,1023) * b(k,167) - b(k,166) = b(k,166) * lu(k,1008) - b(k,165) = b(k,165) - lu(k,1007) * b(k,166) - b(k,163) = b(k,163) - lu(k,1006) * b(k,166) - b(k,158) = b(k,158) - lu(k,1005) * b(k,166) - b(k,156) = b(k,156) - lu(k,1004) * b(k,166) - b(k,140) = b(k,140) - lu(k,1003) * b(k,166) - b(k,121) = b(k,121) - lu(k,1002) * b(k,166) - b(k,100) = b(k,100) - lu(k,1001) * b(k,166) - b(k,165) = b(k,165) * lu(k,997) - b(k,164) = b(k,164) * lu(k,991) - b(k,163) = b(k,163) * lu(k,982) - b(k,156) = b(k,156) - lu(k,981) * b(k,163) - b(k,162) = b(k,162) * lu(k,968) - b(k,161) = b(k,161) - lu(k,967) * b(k,162) - b(k,156) = b(k,156) - lu(k,966) * b(k,162) - b(k,61) = b(k,61) - lu(k,965) * b(k,162) - b(k,161) = b(k,161) * lu(k,960) - b(k,149) = b(k,149) - lu(k,959) * b(k,161) - b(k,160) = b(k,160) * lu(k,943) - b(k,147) = b(k,147) - lu(k,942) * b(k,160) - b(k,142) = b(k,142) - lu(k,941) * b(k,160) - b(k,141) = b(k,141) - lu(k,940) * b(k,160) - b(k,111) = b(k,111) - lu(k,939) * b(k,160) - b(k,159) = b(k,159) * lu(k,928) - b(k,150) = b(k,150) - lu(k,927) * b(k,159) - b(k,149) = b(k,149) - lu(k,926) * b(k,159) - b(k,147) = b(k,147) - lu(k,925) * b(k,159) - b(k,118) = b(k,118) - lu(k,924) * b(k,159) - b(k,158) = b(k,158) * lu(k,916) - b(k,157) = b(k,157) * lu(k,906) - b(k,146) = b(k,146) - lu(k,905) * b(k,157) - b(k,47) = b(k,47) - lu(k,904) * b(k,157) - b(k,156) = b(k,156) * lu(k,898) - b(k,155) = b(k,155) * lu(k,892) - b(k,65) = b(k,65) - lu(k,891) * b(k,155) - b(k,154) = b(k,154) * lu(k,880) - b(k,152) = b(k,152) - lu(k,879) * b(k,154) - b(k,125) = b(k,125) - lu(k,878) * b(k,154) - b(k,124) = b(k,124) - lu(k,877) * b(k,154) - b(k,123) = b(k,123) - lu(k,876) * b(k,154) - b(k,107) = b(k,107) - lu(k,875) * b(k,154) - b(k,153) = b(k,153) * lu(k,858) - b(k,149) = b(k,149) - lu(k,857) * b(k,153) - b(k,141) = b(k,141) - lu(k,856) * b(k,153) - b(k,85) = b(k,85) - lu(k,855) * b(k,153) - b(k,62) = b(k,62) - lu(k,854) * b(k,153) - b(k,33) = b(k,33) - lu(k,853) * b(k,153) - b(k,32) = b(k,32) - lu(k,852) * b(k,153) - b(k,31) = b(k,31) - lu(k,851) * b(k,153) - b(k,30) = b(k,30) - lu(k,850) * b(k,153) - b(k,29) = b(k,29) - lu(k,849) * b(k,153) - b(k,152) = b(k,152) * lu(k,840) - b(k,140) = b(k,140) - lu(k,839) * b(k,152) - b(k,80) = b(k,80) - lu(k,838) * b(k,152) - b(k,66) = b(k,66) - lu(k,837) * b(k,152) - b(k,151) = b(k,151) * lu(k,820) - b(k,149) = b(k,149) - lu(k,819) * b(k,151) - b(k,141) = b(k,141) - lu(k,818) * b(k,151) - b(k,85) = b(k,85) - lu(k,817) * b(k,151) - b(k,62) = b(k,62) - lu(k,816) * b(k,151) - b(k,33) = b(k,33) - lu(k,815) * b(k,151) - b(k,32) = b(k,32) - lu(k,814) * b(k,151) - b(k,31) = b(k,31) - lu(k,813) * b(k,151) - b(k,30) = b(k,30) - lu(k,812) * b(k,151) - b(k,29) = b(k,29) - lu(k,811) * b(k,151) - b(k,150) = b(k,150) * lu(k,803) - b(k,149) = b(k,149) - lu(k,802) * b(k,150) - b(k,149) = b(k,149) * lu(k,798) - b(k,29) = b(k,29) - lu(k,797) * b(k,149) - b(k,148) = b(k,148) * lu(k,781) - b(k,141) = b(k,141) - lu(k,780) * b(k,148) - b(k,33) = b(k,33) - lu(k,779) * b(k,148) - b(k,32) = b(k,32) - lu(k,778) * b(k,148) - b(k,31) = b(k,31) - lu(k,777) * b(k,148) - b(k,30) = b(k,30) - lu(k,776) * b(k,148) - b(k,29) = b(k,29) - lu(k,775) * b(k,148) - b(k,147) = b(k,147) * lu(k,769) - b(k,146) = b(k,146) * lu(k,762) - b(k,47) = b(k,47) - lu(k,761) * b(k,146) - b(k,145) = b(k,145) * lu(k,753) - b(k,144) = b(k,144) * lu(k,744) - b(k,139) = b(k,139) - lu(k,743) * b(k,144) - b(k,138) = b(k,138) - lu(k,742) * b(k,144) - b(k,137) = b(k,137) - lu(k,741) * b(k,144) - b(k,120) = b(k,120) - lu(k,740) * b(k,144) - b(k,102) = b(k,102) - lu(k,739) * b(k,144) - b(k,143) = b(k,143) * lu(k,728) - b(k,89) = b(k,89) - lu(k,727) * b(k,143) - b(k,142) = b(k,142) * lu(k,717) - b(k,109) = b(k,109) - lu(k,716) * b(k,142) - b(k,141) = b(k,141) * lu(k,712) - b(k,140) = b(k,140) * lu(k,708) - b(k,139) = b(k,139) * lu(k,701) - b(k,138) = b(k,138) - lu(k,700) * b(k,139) - b(k,137) = b(k,137) - lu(k,699) * b(k,139) - b(k,126) = b(k,126) - lu(k,698) * b(k,139) - b(k,106) = b(k,106) - lu(k,697) * b(k,139) - b(k,138) = b(k,138) * lu(k,690) - b(k,106) = b(k,106) - lu(k,689) * b(k,138) - b(k,137) = b(k,137) * lu(k,681) - b(k,136) = b(k,136) * lu(k,673) - b(k,59) = b(k,59) - lu(k,672) * b(k,136) - b(k,135) = b(k,135) * lu(k,664) - b(k,96) = b(k,96) - lu(k,663) * b(k,135) - b(k,41) = b(k,41) - lu(k,662) * b(k,135) - b(k,134) = b(k,134) * lu(k,654) - b(k,63) = b(k,63) - lu(k,653) * b(k,134) - b(k,133) = b(k,133) * lu(k,645) - b(k,132) = b(k,132) * lu(k,634) - b(k,130) = b(k,130) - lu(k,633) * b(k,132) - b(k,128) = b(k,128) - lu(k,632) * b(k,132) - b(k,118) = b(k,118) - lu(k,631) * b(k,132) - b(k,95) = b(k,95) - lu(k,630) * b(k,132) - b(k,76) = b(k,76) - lu(k,629) * b(k,132) - b(k,70) = b(k,70) - lu(k,628) * b(k,132) + b(k,223) = b(k,223) * lu(k,1633) + b(k,222) = b(k,222) - lu(k,1632) * b(k,223) + b(k,221) = b(k,221) - lu(k,1631) * b(k,223) + b(k,220) = b(k,220) - lu(k,1630) * b(k,223) + b(k,219) = b(k,219) - lu(k,1629) * b(k,223) + b(k,218) = b(k,218) - lu(k,1628) * b(k,223) + b(k,216) = b(k,216) - lu(k,1627) * b(k,223) + b(k,182) = b(k,182) - lu(k,1626) * b(k,223) + b(k,172) = b(k,172) - lu(k,1625) * b(k,223) + b(k,148) = b(k,148) - lu(k,1624) * b(k,223) + b(k,130) = b(k,130) - lu(k,1623) * b(k,223) + b(k,125) = b(k,125) - lu(k,1622) * b(k,223) + b(k,95) = b(k,95) - lu(k,1621) * b(k,223) + b(k,91) = b(k,91) - lu(k,1620) * b(k,223) + b(k,90) = b(k,90) - lu(k,1619) * b(k,223) + b(k,88) = b(k,88) - lu(k,1618) * b(k,223) + b(k,83) = b(k,83) - lu(k,1617) * b(k,223) + b(k,82) = b(k,82) - lu(k,1616) * b(k,223) + b(k,75) = b(k,75) - lu(k,1615) * b(k,223) + b(k,74) = b(k,74) - lu(k,1614) * b(k,223) + b(k,68) = b(k,68) - lu(k,1613) * b(k,223) + b(k,67) = b(k,67) - lu(k,1612) * b(k,223) + b(k,66) = b(k,66) - lu(k,1611) * b(k,223) + b(k,65) = b(k,65) - lu(k,1610) * b(k,223) + b(k,59) = b(k,59) - lu(k,1609) * b(k,223) + b(k,58) = b(k,58) - lu(k,1608) * b(k,223) + b(k,57) = b(k,57) - lu(k,1607) * b(k,223) + b(k,56) = b(k,56) - lu(k,1606) * b(k,223) + b(k,54) = b(k,54) - lu(k,1605) * b(k,223) + b(k,222) = b(k,222) * lu(k,1590) + b(k,221) = b(k,221) - lu(k,1589) * b(k,222) + b(k,220) = b(k,220) - lu(k,1588) * b(k,222) + b(k,219) = b(k,219) - lu(k,1587) * b(k,222) + b(k,218) = b(k,218) - lu(k,1586) * b(k,222) + b(k,217) = b(k,217) - lu(k,1585) * b(k,222) + b(k,185) = b(k,185) - lu(k,1584) * b(k,222) + b(k,184) = b(k,184) - lu(k,1583) * b(k,222) + b(k,173) = b(k,173) - lu(k,1582) * b(k,222) + b(k,107) = b(k,107) - lu(k,1581) * b(k,222) + b(k,86) = b(k,86) - lu(k,1580) * b(k,222) + b(k,72) = b(k,72) - lu(k,1579) * b(k,222) + b(k,52) = b(k,52) - lu(k,1578) * b(k,222) + b(k,221) = b(k,221) * lu(k,1563) + b(k,220) = b(k,220) - lu(k,1562) * b(k,221) + b(k,219) = b(k,219) - lu(k,1561) * b(k,221) + b(k,218) = b(k,218) - lu(k,1560) * b(k,221) + b(k,217) = b(k,217) - lu(k,1559) * b(k,221) + b(k,184) = b(k,184) - lu(k,1558) * b(k,221) + b(k,167) = b(k,167) - lu(k,1557) * b(k,221) + b(k,143) = b(k,143) - lu(k,1556) * b(k,221) + b(k,107) = b(k,107) - lu(k,1555) * b(k,221) + b(k,86) = b(k,86) - lu(k,1554) * b(k,221) + b(k,220) = b(k,220) * lu(k,1540) + b(k,219) = b(k,219) - lu(k,1539) * b(k,220) + b(k,217) = b(k,217) - lu(k,1538) * b(k,220) + b(k,215) = b(k,215) - lu(k,1537) * b(k,220) + b(k,200) = b(k,200) - lu(k,1536) * b(k,220) + b(k,199) = b(k,199) - lu(k,1535) * b(k,220) + b(k,186) = b(k,186) - lu(k,1534) * b(k,220) + b(k,184) = b(k,184) - lu(k,1533) * b(k,220) + b(k,176) = b(k,176) - lu(k,1532) * b(k,220) + b(k,175) = b(k,175) - lu(k,1531) * b(k,220) + b(k,174) = b(k,174) - lu(k,1530) * b(k,220) + b(k,169) = b(k,169) - lu(k,1529) * b(k,220) + b(k,160) = b(k,160) - lu(k,1528) * b(k,220) + b(k,156) = b(k,156) - lu(k,1527) * b(k,220) + b(k,138) = b(k,138) - lu(k,1526) * b(k,220) + b(k,134) = b(k,134) - lu(k,1525) * b(k,220) + b(k,128) = b(k,128) - lu(k,1524) * b(k,220) + b(k,74) = b(k,74) - lu(k,1523) * b(k,220) + b(k,73) = b(k,73) - lu(k,1522) * b(k,220) + b(k,219) = b(k,219) * lu(k,1509) + b(k,215) = b(k,215) - lu(k,1508) * b(k,219) + b(k,199) = b(k,199) - lu(k,1507) * b(k,219) + b(k,172) = b(k,172) - lu(k,1506) * b(k,219) + b(k,218) = b(k,218) * lu(k,1493) + b(k,185) = b(k,185) - lu(k,1492) * b(k,218) + b(k,173) = b(k,173) - lu(k,1491) * b(k,218) + b(k,167) = b(k,167) - lu(k,1490) * b(k,218) + b(k,86) = b(k,86) - lu(k,1489) * b(k,218) + b(k,72) = b(k,72) - lu(k,1488) * b(k,218) + b(k,217) = b(k,217) * lu(k,1474) + b(k,184) = b(k,184) - lu(k,1473) * b(k,217) + b(k,160) = b(k,160) - lu(k,1472) * b(k,217) + b(k,107) = b(k,107) - lu(k,1471) * b(k,217) + b(k,216) = b(k,216) * lu(k,1459) + b(k,182) = b(k,182) - lu(k,1458) * b(k,216) + b(k,98) = b(k,98) - lu(k,1457) * b(k,216) + b(k,215) = b(k,215) * lu(k,1448) + b(k,199) = b(k,199) - lu(k,1447) * b(k,215) + b(k,186) = b(k,186) - lu(k,1446) * b(k,215) + b(k,176) = b(k,176) - lu(k,1445) * b(k,215) + b(k,175) = b(k,175) - lu(k,1444) * b(k,215) + b(k,174) = b(k,174) - lu(k,1443) * b(k,215) + b(k,169) = b(k,169) - lu(k,1442) * b(k,215) + b(k,74) = b(k,74) - lu(k,1441) * b(k,215) + b(k,73) = b(k,73) - lu(k,1440) * b(k,215) + b(k,214) = b(k,214) * lu(k,1426) + b(k,213) = b(k,213) - lu(k,1425) * b(k,214) + b(k,212) = b(k,212) - lu(k,1424) * b(k,214) + b(k,211) = b(k,211) - lu(k,1423) * b(k,214) + b(k,210) = b(k,210) - lu(k,1422) * b(k,214) + b(k,209) = b(k,209) - lu(k,1421) * b(k,214) + b(k,208) = b(k,208) - lu(k,1420) * b(k,214) + b(k,207) = b(k,207) - lu(k,1419) * b(k,214) + b(k,206) = b(k,206) - lu(k,1418) * b(k,214) + b(k,205) = b(k,205) - lu(k,1417) * b(k,214) + b(k,203) = b(k,203) - lu(k,1416) * b(k,214) + b(k,200) = b(k,200) - lu(k,1415) * b(k,214) + b(k,199) = b(k,199) - lu(k,1414) * b(k,214) + b(k,196) = b(k,196) - lu(k,1413) * b(k,214) + b(k,190) = b(k,190) - lu(k,1412) * b(k,214) + b(k,159) = b(k,159) - lu(k,1411) * b(k,214) + b(k,150) = b(k,150) - lu(k,1410) * b(k,214) + b(k,139) = b(k,139) - lu(k,1409) * b(k,214) + b(k,105) = b(k,105) - lu(k,1408) * b(k,214) + b(k,213) = b(k,213) * lu(k,1395) + b(k,208) = b(k,208) - lu(k,1394) * b(k,213) + b(k,203) = b(k,203) - lu(k,1393) * b(k,213) + b(k,159) = b(k,159) - lu(k,1392) * b(k,213) + b(k,150) = b(k,150) - lu(k,1391) * b(k,213) + b(k,145) = b(k,145) - lu(k,1390) * b(k,213) + b(k,212) = b(k,212) * lu(k,1374) + b(k,211) = b(k,211) - lu(k,1373) * b(k,212) + b(k,208) = b(k,208) - lu(k,1372) * b(k,212) + b(k,203) = b(k,203) - lu(k,1371) * b(k,212) + b(k,199) = b(k,199) - lu(k,1370) * b(k,212) + b(k,198) = b(k,198) - lu(k,1369) * b(k,212) + b(k,197) = b(k,197) - lu(k,1368) * b(k,212) + b(k,180) = b(k,180) - lu(k,1367) * b(k,212) + b(k,211) = b(k,211) * lu(k,1354) + b(k,208) = b(k,208) - lu(k,1353) * b(k,211) + b(k,204) = b(k,204) - lu(k,1352) * b(k,211) + b(k,203) = b(k,203) - lu(k,1351) * b(k,211) + b(k,202) = b(k,202) - lu(k,1350) * b(k,211) + b(k,200) = b(k,200) - lu(k,1349) * b(k,211) + b(k,199) = b(k,199) - lu(k,1348) * b(k,211) + b(k,170) = b(k,170) - lu(k,1347) * b(k,211) + b(k,103) = b(k,103) - lu(k,1346) * b(k,211) + b(k,210) = b(k,210) * lu(k,1330) + b(k,208) = b(k,208) - lu(k,1329) * b(k,210) + b(k,207) = b(k,207) - lu(k,1328) * b(k,210) + b(k,205) = b(k,205) - lu(k,1327) * b(k,210) + b(k,204) = b(k,204) - lu(k,1326) * b(k,210) + b(k,203) = b(k,203) - lu(k,1325) * b(k,210) + b(k,202) = b(k,202) - lu(k,1324) * b(k,210) + b(k,200) = b(k,200) - lu(k,1323) * b(k,210) + b(k,199) = b(k,199) - lu(k,1322) * b(k,210) + b(k,190) = b(k,190) - lu(k,1321) * b(k,210) + b(k,181) = b(k,181) - lu(k,1320) * b(k,210) + b(k,177) = b(k,177) - lu(k,1319) * b(k,210) + b(k,170) = b(k,170) - lu(k,1318) * b(k,210) + b(k,162) = b(k,162) - lu(k,1317) * b(k,210) + b(k,147) = b(k,147) - lu(k,1316) * b(k,210) + b(k,142) = b(k,142) - lu(k,1315) * b(k,210) + b(k,105) = b(k,105) - lu(k,1314) * b(k,210) + b(k,84) = b(k,84) - lu(k,1313) * b(k,210) + b(k,209) = b(k,209) * lu(k,1297) + b(k,208) = b(k,208) - lu(k,1296) * b(k,209) + b(k,207) = b(k,207) - lu(k,1295) * b(k,209) + b(k,205) = b(k,205) - lu(k,1294) * b(k,209) + b(k,204) = b(k,204) - lu(k,1293) * b(k,209) + b(k,203) = b(k,203) - lu(k,1292) * b(k,209) + b(k,202) = b(k,202) - lu(k,1291) * b(k,209) + b(k,200) = b(k,200) - lu(k,1290) * b(k,209) + b(k,170) = b(k,170) - lu(k,1289) * b(k,209) + b(k,162) = b(k,162) - lu(k,1288) * b(k,209) + b(k,146) = b(k,146) - lu(k,1287) * b(k,209) + b(k,208) = b(k,208) * lu(k,1279) + b(k,199) = b(k,199) - lu(k,1278) * b(k,208) + b(k,207) = b(k,207) * lu(k,1267) + b(k,199) = b(k,199) - lu(k,1266) * b(k,207) + b(k,180) = b(k,180) - lu(k,1265) * b(k,207) + b(k,206) = b(k,206) * lu(k,1251) + b(k,205) = b(k,205) - lu(k,1250) * b(k,206) + b(k,200) = b(k,200) - lu(k,1249) * b(k,206) + b(k,199) = b(k,199) - lu(k,1248) * b(k,206) + b(k,196) = b(k,196) - lu(k,1247) * b(k,206) + b(k,177) = b(k,177) - lu(k,1246) * b(k,206) + b(k,170) = b(k,170) - lu(k,1245) * b(k,206) + b(k,162) = b(k,162) - lu(k,1244) * b(k,206) + b(k,121) = b(k,121) - lu(k,1243) * b(k,206) + b(k,114) = b(k,114) - lu(k,1242) * b(k,206) + b(k,205) = b(k,205) * lu(k,1231) + b(k,203) = b(k,203) - lu(k,1230) * b(k,205) + b(k,200) = b(k,200) - lu(k,1229) * b(k,205) + b(k,199) = b(k,199) - lu(k,1228) * b(k,205) + b(k,190) = b(k,190) - lu(k,1227) * b(k,205) + b(k,170) = b(k,170) - lu(k,1226) * b(k,205) + b(k,79) = b(k,79) - lu(k,1225) * b(k,205) + b(k,204) = b(k,204) * lu(k,1215) + b(k,203) = b(k,203) - lu(k,1214) * b(k,204) + b(k,170) = b(k,170) - lu(k,1213) * b(k,204) + b(k,119) = b(k,119) - lu(k,1212) * b(k,204) + b(k,203) = b(k,203) * lu(k,1206) + b(k,202) = b(k,202) * lu(k,1193) + b(k,200) = b(k,200) - lu(k,1192) * b(k,202) + b(k,199) = b(k,199) - lu(k,1191) * b(k,202) + b(k,198) = b(k,198) - lu(k,1190) * b(k,202) + b(k,193) = b(k,193) - lu(k,1189) * b(k,202) + b(k,87) = b(k,87) - lu(k,1188) * b(k,202) end do end subroutine lu_slv10 subroutine lu_slv11( avec_len, lu, b ) @@ -2208,159 +2310,354 @@ subroutine lu_slv11( avec_len, lu, b ) ! ... solve L * y = b !----------------------------------------------------------------------- do k = 1,avec_len - b(k,131) = b(k,131) * lu(k,618) - b(k,130) = b(k,130) - lu(k,617) * b(k,131) - b(k,118) = b(k,118) - lu(k,616) * b(k,131) - b(k,117) = b(k,117) - lu(k,615) * b(k,131) - b(k,95) = b(k,95) - lu(k,614) * b(k,131) - b(k,70) = b(k,70) - lu(k,613) * b(k,131) - b(k,130) = b(k,130) * lu(k,607) - b(k,129) = b(k,129) * lu(k,600) - b(k,128) = b(k,128) * lu(k,589) - b(k,118) = b(k,118) - lu(k,588) * b(k,128) - b(k,95) = b(k,95) - lu(k,587) * b(k,128) - b(k,76) = b(k,76) - lu(k,586) * b(k,128) - b(k,70) = b(k,70) - lu(k,585) * b(k,128) - b(k,127) = b(k,127) * lu(k,578) - b(k,43) = b(k,43) - lu(k,577) * b(k,127) - b(k,126) = b(k,126) * lu(k,567) - b(k,120) = b(k,120) - lu(k,566) * b(k,126) - b(k,106) = b(k,106) - lu(k,565) * b(k,126) - b(k,125) = b(k,125) * lu(k,558) - b(k,75) = b(k,75) - lu(k,557) * b(k,125) - b(k,124) = b(k,124) * lu(k,547) - b(k,107) = b(k,107) - lu(k,546) * b(k,124) - b(k,123) = b(k,123) * lu(k,536) - b(k,107) = b(k,107) - lu(k,535) * b(k,123) - b(k,122) = b(k,122) * lu(k,529) - b(k,98) = b(k,98) - lu(k,528) * b(k,122) - b(k,67) = b(k,67) - lu(k,527) * b(k,122) - b(k,121) = b(k,121) * lu(k,521) - b(k,120) = b(k,120) * lu(k,514) - b(k,119) = b(k,119) * lu(k,505) - b(k,118) = b(k,118) * lu(k,501) - b(k,117) = b(k,117) * lu(k,492) - b(k,95) = b(k,95) - lu(k,491) * b(k,117) - b(k,70) = b(k,70) - lu(k,490) * b(k,117) - b(k,116) = b(k,116) * lu(k,481) - b(k,115) = b(k,115) * lu(k,474) - b(k,114) = b(k,114) * lu(k,466) - b(k,113) = b(k,113) * lu(k,458) - b(k,112) = b(k,112) * lu(k,450) - b(k,111) = b(k,111) * lu(k,446) - b(k,110) = b(k,110) * lu(k,438) - b(k,109) = b(k,109) * lu(k,430) - b(k,108) = b(k,108) * lu(k,422) - b(k,107) = b(k,107) * lu(k,417) - b(k,106) = b(k,106) * lu(k,412) - b(k,105) = b(k,105) * lu(k,406) - b(k,104) = b(k,104) * lu(k,400) - b(k,44) = b(k,44) - lu(k,399) * b(k,104) - b(k,103) = b(k,103) * lu(k,392) - b(k,91) = b(k,91) - lu(k,391) * b(k,103) - b(k,102) = b(k,102) * lu(k,384) - b(k,101) = b(k,101) * lu(k,377) - b(k,95) = b(k,95) - lu(k,376) * b(k,101) - b(k,84) = b(k,84) - lu(k,375) * b(k,101) - b(k,100) = b(k,100) * lu(k,368) - b(k,99) = b(k,99) * lu(k,361) - b(k,98) = b(k,98) * lu(k,357) - b(k,97) = b(k,97) * lu(k,350) - b(k,96) = b(k,96) * lu(k,345) - b(k,95) = b(k,95) * lu(k,342) - b(k,94) = b(k,94) * lu(k,336) - b(k,78) = b(k,78) - lu(k,335) * b(k,94) - b(k,93) = b(k,93) * lu(k,329) - b(k,92) = b(k,92) * lu(k,323) - b(k,79) = b(k,79) - lu(k,322) * b(k,92) - b(k,64) = b(k,64) - lu(k,321) * b(k,92) - b(k,91) = b(k,91) * lu(k,315) - b(k,90) = b(k,90) * lu(k,309) - b(k,89) = b(k,89) * lu(k,303) - b(k,88) = b(k,88) * lu(k,297) - b(k,87) = b(k,87) * lu(k,291) - b(k,86) = b(k,86) * lu(k,285) - b(k,85) = b(k,85) * lu(k,279) - b(k,84) = b(k,84) * lu(k,273) - b(k,83) = b(k,83) * lu(k,267) - b(k,82) = b(k,82) * lu(k,259) - b(k,81) = b(k,81) * lu(k,251) - b(k,80) = b(k,80) * lu(k,246) - b(k,79) = b(k,79) * lu(k,241) - b(k,64) = b(k,64) - lu(k,240) * b(k,79) - b(k,78) = b(k,78) * lu(k,235) - b(k,77) = b(k,77) * lu(k,230) - b(k,76) = b(k,76) * lu(k,225) - b(k,75) = b(k,75) * lu(k,220) - b(k,74) = b(k,74) * lu(k,215) - b(k,73) = b(k,73) * lu(k,212) - b(k,72) = b(k,72) * lu(k,206) - b(k,71) = b(k,71) * lu(k,200) - b(k,70) = b(k,70) * lu(k,197) - b(k,69) = b(k,69) * lu(k,191) - b(k,68) = b(k,68) * lu(k,185) - b(k,67) = b(k,67) * lu(k,181) - b(k,66) = b(k,66) * lu(k,177) - b(k,65) = b(k,65) * lu(k,173) - b(k,42) = b(k,42) - lu(k,172) * b(k,65) - b(k,64) = b(k,64) * lu(k,169) - b(k,63) = b(k,63) * lu(k,166) - b(k,62) = b(k,62) * lu(k,163) - b(k,61) = b(k,61) * lu(k,160) - b(k,60) = b(k,60) * lu(k,155) - b(k,59) = b(k,59) * lu(k,152) - b(k,58) = b(k,58) * lu(k,147) - b(k,57) = b(k,57) * lu(k,139) - b(k,55) = b(k,55) - lu(k,138) * b(k,57) - b(k,33) = b(k,33) - lu(k,137) * b(k,57) - b(k,32) = b(k,32) - lu(k,136) * b(k,57) - b(k,31) = b(k,31) - lu(k,135) * b(k,57) - b(k,30) = b(k,30) - lu(k,134) * b(k,57) - b(k,29) = b(k,29) - lu(k,133) * b(k,57) - b(k,56) = b(k,56) * lu(k,130) - b(k,55) = b(k,55) * lu(k,126) - b(k,54) = b(k,54) * lu(k,121) - b(k,53) = b(k,53) * lu(k,114) - b(k,33) = b(k,33) - lu(k,113) * b(k,53) - b(k,32) = b(k,32) - lu(k,112) * b(k,53) - b(k,31) = b(k,31) - lu(k,111) * b(k,53) - b(k,30) = b(k,30) - lu(k,110) * b(k,53) - b(k,29) = b(k,29) - lu(k,109) * b(k,53) - b(k,52) = b(k,52) * lu(k,105) - b(k,51) = b(k,51) * lu(k,101) - b(k,50) = b(k,50) * lu(k,96) - b(k,49) = b(k,49) * lu(k,92) - b(k,48) = b(k,48) * lu(k,86) - b(k,33) = b(k,33) - lu(k,85) * b(k,48) - b(k,32) = b(k,32) - lu(k,84) * b(k,48) - b(k,31) = b(k,31) - lu(k,83) * b(k,48) - b(k,30) = b(k,30) - lu(k,82) * b(k,48) - b(k,29) = b(k,29) - lu(k,81) * b(k,48) - b(k,47) = b(k,47) * lu(k,79) - b(k,46) = b(k,46) * lu(k,77) - b(k,45) = b(k,45) - lu(k,76) * b(k,46) - b(k,45) = b(k,45) * lu(k,74) - b(k,44) = b(k,44) * lu(k,71) - b(k,43) = b(k,43) * lu(k,68) - b(k,42) = b(k,42) * lu(k,65) - b(k,41) = b(k,41) * lu(k,62) - b(k,40) = b(k,40) * lu(k,59) - b(k,39) = b(k,39) * lu(k,55) - b(k,38) = b(k,38) * lu(k,52) - b(k,37) = b(k,37) * lu(k,49) - b(k,36) = b(k,36) * lu(k,46) - b(k,35) = b(k,35) * lu(k,45) - b(k,33) = b(k,33) - lu(k,44) * b(k,35) - b(k,32) = b(k,32) - lu(k,43) * b(k,35) - b(k,31) = b(k,31) - lu(k,42) * b(k,35) - b(k,30) = b(k,30) - lu(k,41) * b(k,35) - b(k,29) = b(k,29) - lu(k,40) * b(k,35) - b(k,34) = b(k,34) * lu(k,39) - b(k,33) = b(k,33) - lu(k,38) * b(k,34) - b(k,32) = b(k,32) - lu(k,37) * b(k,34) - b(k,31) = b(k,31) - lu(k,36) * b(k,34) - b(k,30) = b(k,30) - lu(k,35) * b(k,34) - b(k,29) = b(k,29) - lu(k,34) * b(k,34) + b(k,201) = b(k,201) * lu(k,1176) + b(k,200) = b(k,200) - lu(k,1175) * b(k,201) + b(k,199) = b(k,199) - lu(k,1174) * b(k,201) + b(k,195) = b(k,195) - lu(k,1173) * b(k,201) + b(k,193) = b(k,193) - lu(k,1172) * b(k,201) + b(k,170) = b(k,170) - lu(k,1171) * b(k,201) + b(k,154) = b(k,154) - lu(k,1170) * b(k,201) + b(k,87) = b(k,87) - lu(k,1169) * b(k,201) + b(k,200) = b(k,200) * lu(k,1164) + b(k,199) = b(k,199) - lu(k,1163) * b(k,200) + b(k,190) = b(k,190) - lu(k,1162) * b(k,200) + b(k,199) = b(k,199) * lu(k,1158) + b(k,198) = b(k,198) * lu(k,1149) + b(k,197) = b(k,197) * lu(k,1131) + b(k,180) = b(k,180) - lu(k,1130) * b(k,197) + b(k,177) = b(k,177) - lu(k,1129) * b(k,197) + b(k,171) = b(k,171) - lu(k,1128) * b(k,197) + b(k,159) = b(k,159) - lu(k,1127) * b(k,197) + b(k,196) = b(k,196) * lu(k,1115) + b(k,190) = b(k,190) - lu(k,1114) * b(k,196) + b(k,181) = b(k,181) - lu(k,1113) * b(k,196) + b(k,177) = b(k,177) - lu(k,1112) * b(k,196) + b(k,147) = b(k,147) - lu(k,1111) * b(k,196) + b(k,195) = b(k,195) * lu(k,1101) + b(k,193) = b(k,193) - lu(k,1100) * b(k,195) + b(k,194) = b(k,194) * lu(k,1088) + b(k,192) = b(k,192) - lu(k,1087) * b(k,194) + b(k,170) = b(k,170) - lu(k,1086) * b(k,194) + b(k,151) = b(k,151) - lu(k,1085) * b(k,194) + b(k,117) = b(k,117) - lu(k,1084) * b(k,194) + b(k,193) = b(k,193) * lu(k,1078) + b(k,192) = b(k,192) * lu(k,1070) + b(k,191) = b(k,191) * lu(k,1060) + b(k,170) = b(k,170) - lu(k,1059) * b(k,191) + b(k,151) = b(k,151) - lu(k,1058) * b(k,191) + b(k,131) = b(k,131) - lu(k,1057) * b(k,191) + b(k,190) = b(k,190) * lu(k,1052) + b(k,37) = b(k,37) - lu(k,1051) * b(k,190) + b(k,189) = b(k,189) * lu(k,1040) + b(k,179) = b(k,179) - lu(k,1039) * b(k,189) + b(k,158) = b(k,158) - lu(k,1038) * b(k,189) + b(k,157) = b(k,157) - lu(k,1037) * b(k,189) + b(k,153) = b(k,153) - lu(k,1036) * b(k,189) + b(k,136) = b(k,136) - lu(k,1035) * b(k,189) + b(k,188) = b(k,188) * lu(k,1016) + b(k,180) = b(k,180) - lu(k,1015) * b(k,188) + b(k,115) = b(k,115) - lu(k,1014) * b(k,188) + b(k,85) = b(k,85) - lu(k,1013) * b(k,188) + b(k,49) = b(k,49) - lu(k,1012) * b(k,188) + b(k,41) = b(k,41) - lu(k,1011) * b(k,188) + b(k,40) = b(k,40) - lu(k,1010) * b(k,188) + b(k,39) = b(k,39) - lu(k,1009) * b(k,188) + b(k,38) = b(k,38) - lu(k,1008) * b(k,188) + b(k,37) = b(k,37) - lu(k,1007) * b(k,188) + b(k,187) = b(k,187) * lu(k,988) + b(k,180) = b(k,180) - lu(k,987) * b(k,187) + b(k,115) = b(k,115) - lu(k,986) * b(k,187) + b(k,85) = b(k,85) - lu(k,985) * b(k,187) + b(k,44) = b(k,44) - lu(k,984) * b(k,187) + b(k,41) = b(k,41) - lu(k,983) * b(k,187) + b(k,40) = b(k,40) - lu(k,982) * b(k,187) + b(k,39) = b(k,39) - lu(k,981) * b(k,187) + b(k,38) = b(k,38) - lu(k,980) * b(k,187) + b(k,37) = b(k,37) - lu(k,979) * b(k,187) + b(k,186) = b(k,186) * lu(k,969) + b(k,176) = b(k,176) - lu(k,968) * b(k,186) + b(k,175) = b(k,175) - lu(k,967) * b(k,186) + b(k,174) = b(k,174) - lu(k,966) * b(k,186) + b(k,169) = b(k,169) - lu(k,965) * b(k,186) + b(k,134) = b(k,134) - lu(k,964) * b(k,186) + b(k,91) = b(k,91) - lu(k,963) * b(k,186) + b(k,185) = b(k,185) * lu(k,953) + b(k,173) = b(k,173) - lu(k,952) * b(k,185) + b(k,72) = b(k,72) - lu(k,951) * b(k,185) + b(k,184) = b(k,184) * lu(k,945) + b(k,92) = b(k,92) - lu(k,944) * b(k,184) + b(k,183) = b(k,183) * lu(k,933) + b(k,120) = b(k,120) - lu(k,932) * b(k,183) + b(k,182) = b(k,182) * lu(k,923) + b(k,98) = b(k,98) - lu(k,922) * b(k,182) + b(k,181) = b(k,181) * lu(k,913) + b(k,180) = b(k,180) * lu(k,908) + b(k,179) = b(k,179) * lu(k,899) + b(k,170) = b(k,170) - lu(k,898) * b(k,179) + b(k,110) = b(k,110) - lu(k,897) * b(k,179) + b(k,93) = b(k,93) - lu(k,896) * b(k,179) + b(k,178) = b(k,178) * lu(k,880) + b(k,46) = b(k,46) - lu(k,879) * b(k,178) + b(k,41) = b(k,41) - lu(k,878) * b(k,178) + b(k,40) = b(k,40) - lu(k,877) * b(k,178) + b(k,177) = b(k,177) * lu(k,871) + b(k,176) = b(k,176) * lu(k,863) + b(k,175) = b(k,175) - lu(k,862) * b(k,176) + b(k,174) = b(k,174) - lu(k,861) * b(k,176) + b(k,169) = b(k,169) - lu(k,860) * b(k,176) + b(k,156) = b(k,156) - lu(k,859) * b(k,176) + b(k,138) = b(k,138) - lu(k,858) * b(k,176) + b(k,175) = b(k,175) * lu(k,851) + b(k,174) = b(k,174) - lu(k,850) * b(k,175) + b(k,174) = b(k,174) * lu(k,843) + b(k,138) = b(k,138) - lu(k,842) * b(k,174) + b(k,173) = b(k,173) * lu(k,835) + b(k,72) = b(k,72) - lu(k,834) * b(k,173) + b(k,172) = b(k,172) * lu(k,826) + b(k,171) = b(k,171) * lu(k,816) + b(k,140) = b(k,140) - lu(k,815) * b(k,171) + b(k,170) = b(k,170) * lu(k,811) + b(k,169) = b(k,169) * lu(k,803) + b(k,168) = b(k,168) * lu(k,795) + b(k,128) = b(k,128) - lu(k,794) * b(k,168) + b(k,61) = b(k,61) - lu(k,793) * b(k,168) + b(k,167) = b(k,167) * lu(k,785) + b(k,86) = b(k,86) - lu(k,784) * b(k,167) + b(k,166) = b(k,166) * lu(k,776) + b(k,165) = b(k,165) * lu(k,765) + b(k,163) = b(k,163) - lu(k,764) * b(k,165) + b(k,161) = b(k,161) - lu(k,763) * b(k,165) + b(k,147) = b(k,147) - lu(k,762) * b(k,165) + b(k,127) = b(k,127) - lu(k,761) * b(k,165) + b(k,106) = b(k,106) - lu(k,760) * b(k,165) + b(k,97) = b(k,97) - lu(k,759) * b(k,165) + b(k,164) = b(k,164) * lu(k,749) + b(k,163) = b(k,163) - lu(k,748) * b(k,164) + b(k,155) = b(k,155) - lu(k,747) * b(k,164) + b(k,147) = b(k,147) - lu(k,746) * b(k,164) + b(k,127) = b(k,127) - lu(k,745) * b(k,164) + b(k,97) = b(k,97) - lu(k,744) * b(k,164) + b(k,163) = b(k,163) * lu(k,738) + b(k,162) = b(k,162) * lu(k,731) + b(k,63) = b(k,63) - lu(k,730) * b(k,162) + b(k,161) = b(k,161) * lu(k,719) + b(k,147) = b(k,147) - lu(k,718) * b(k,161) + b(k,127) = b(k,127) - lu(k,717) * b(k,161) + b(k,106) = b(k,106) - lu(k,716) * b(k,161) + b(k,97) = b(k,97) - lu(k,715) * b(k,161) + b(k,160) = b(k,160) * lu(k,708) + b(k,159) = b(k,159) * lu(k,703) + b(k,158) = b(k,158) * lu(k,696) + b(k,104) = b(k,104) - lu(k,695) * b(k,158) + b(k,157) = b(k,157) * lu(k,685) + b(k,136) = b(k,136) - lu(k,684) * b(k,157) + b(k,156) = b(k,156) * lu(k,674) + b(k,138) = b(k,138) - lu(k,673) * b(k,156) + b(k,155) = b(k,155) * lu(k,663) + b(k,147) = b(k,147) - lu(k,662) * b(k,155) + b(k,127) = b(k,127) - lu(k,661) * b(k,155) + b(k,97) = b(k,97) - lu(k,660) * b(k,155) + b(k,154) = b(k,154) * lu(k,650) + b(k,153) = b(k,153) * lu(k,640) + b(k,136) = b(k,136) - lu(k,639) * b(k,153) + b(k,152) = b(k,152) * lu(k,633) + b(k,129) = b(k,129) - lu(k,632) * b(k,152) + b(k,94) = b(k,94) - lu(k,631) * b(k,152) + b(k,151) = b(k,151) * lu(k,625) + b(k,150) = b(k,150) * lu(k,618) + b(k,149) = b(k,149) * lu(k,611) + b(k,148) = b(k,148) * lu(k,602) + b(k,147) = b(k,147) * lu(k,598) + b(k,146) = b(k,146) * lu(k,589) + b(k,145) = b(k,145) * lu(k,580) + b(k,144) = b(k,144) * lu(k,572) + b(k,143) = b(k,143) * lu(k,564) + b(k,142) = b(k,142) * lu(k,556) + b(k,141) = b(k,141) * lu(k,548) + b(k,140) = b(k,140) * lu(k,540) + b(k,139) = b(k,139) * lu(k,532) + b(k,138) = b(k,138) * lu(k,527) + b(k,137) = b(k,137) * lu(k,521) + b(k,64) = b(k,64) - lu(k,520) * b(k,137) + b(k,136) = b(k,136) * lu(k,515) + b(k,135) = b(k,135) * lu(k,508) + b(k,122) = b(k,122) - lu(k,507) * b(k,135) + b(k,134) = b(k,134) * lu(k,500) + b(k,133) = b(k,133) * lu(k,493) + b(k,132) = b(k,132) * lu(k,486) + b(k,127) = b(k,127) - lu(k,485) * b(k,132) + b(k,118) = b(k,118) - lu(k,484) * b(k,132) + b(k,131) = b(k,131) * lu(k,477) + b(k,130) = b(k,130) * lu(k,470) + b(k,129) = b(k,129) * lu(k,466) + b(k,128) = b(k,128) * lu(k,461) + b(k,127) = b(k,127) * lu(k,458) + b(k,126) = b(k,126) * lu(k,452) + b(k,108) = b(k,108) - lu(k,451) * b(k,126) + b(k,125) = b(k,125) * lu(k,445) + b(k,124) = b(k,124) * lu(k,439) + b(k,123) = b(k,123) * lu(k,433) + b(k,109) = b(k,109) - lu(k,432) * b(k,123) + b(k,89) = b(k,89) - lu(k,431) * b(k,123) + b(k,122) = b(k,122) * lu(k,425) + b(k,121) = b(k,121) * lu(k,419) + b(k,120) = b(k,120) * lu(k,413) + b(k,119) = b(k,119) * lu(k,407) + b(k,118) = b(k,118) * lu(k,401) + b(k,117) = b(k,117) * lu(k,395) + b(k,116) = b(k,116) * lu(k,389) + b(k,115) = b(k,115) * lu(k,383) + b(k,114) = b(k,114) * lu(k,377) + b(k,113) = b(k,113) * lu(k,369) + b(k,112) = b(k,112) * lu(k,361) + b(k,111) = b(k,111) * lu(k,353) + end do + end subroutine lu_slv11 + subroutine lu_slv12( 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,110) = b(k,110) * lu(k,348) + b(k,109) = b(k,109) * lu(k,343) + b(k,89) = b(k,89) - lu(k,342) * b(k,109) + b(k,108) = b(k,108) * lu(k,337) + b(k,107) = b(k,107) * lu(k,332) + b(k,106) = b(k,106) * lu(k,327) + b(k,105) = b(k,105) * lu(k,324) + b(k,104) = b(k,104) * lu(k,319) + b(k,103) = b(k,103) * lu(k,314) + b(k,102) = b(k,102) * lu(k,308) + b(k,101) = b(k,101) * lu(k,302) + b(k,100) = b(k,100) * lu(k,296) + b(k,99) = b(k,99) * lu(k,290) + b(k,98) = b(k,98) * lu(k,287) + b(k,97) = b(k,97) * lu(k,284) + b(k,96) = b(k,96) * lu(k,278) + b(k,95) = b(k,95) * lu(k,272) + b(k,88) = b(k,88) - lu(k,271) * b(k,95) + b(k,94) = b(k,94) * lu(k,267) + b(k,93) = b(k,93) * lu(k,263) + b(k,92) = b(k,92) * lu(k,259) + b(k,62) = b(k,62) - lu(k,258) * b(k,92) + b(k,91) = b(k,91) * lu(k,254) + b(k,90) = b(k,90) * lu(k,249) + b(k,88) = b(k,88) - lu(k,248) * b(k,90) + b(k,89) = b(k,89) * lu(k,245) + b(k,88) = b(k,88) * lu(k,242) + b(k,87) = b(k,87) * lu(k,239) + b(k,86) = b(k,86) * lu(k,236) + b(k,85) = b(k,85) * lu(k,233) + b(k,84) = b(k,84) * lu(k,228) + b(k,83) = b(k,83) * lu(k,224) + b(k,82) = b(k,82) * lu(k,219) + b(k,81) = b(k,81) * lu(k,214) + b(k,80) = b(k,80) * lu(k,206) + b(k,78) = b(k,78) - lu(k,205) * b(k,80) + b(k,51) = b(k,51) - lu(k,204) * b(k,80) + b(k,79) = b(k,79) * lu(k,201) + b(k,78) = b(k,78) * lu(k,197) + b(k,77) = b(k,77) * lu(k,192) + b(k,76) = b(k,76) * lu(k,185) + b(k,50) = b(k,50) - lu(k,184) * b(k,76) + b(k,75) = b(k,75) * lu(k,180) + b(k,74) = b(k,74) * lu(k,178) + b(k,73) = b(k,73) - lu(k,177) * b(k,74) + b(k,73) = b(k,73) * lu(k,175) + b(k,72) = b(k,72) * lu(k,173) + b(k,71) = b(k,71) * lu(k,168) + b(k,70) = b(k,70) * lu(k,164) + b(k,69) = b(k,69) * lu(k,158) + b(k,45) = b(k,45) - lu(k,157) * b(k,69) + b(k,68) = b(k,68) * lu(k,152) + b(k,67) = b(k,67) * lu(k,147) + b(k,66) = b(k,66) * lu(k,142) + b(k,65) = b(k,65) * lu(k,137) + b(k,64) = b(k,64) * lu(k,134) + b(k,63) = b(k,63) * lu(k,131) + b(k,62) = b(k,62) * lu(k,128) + b(k,61) = b(k,61) * lu(k,125) + b(k,60) = b(k,60) * lu(k,121) + b(k,59) = b(k,59) * lu(k,117) + b(k,58) = b(k,58) * lu(k,113) + b(k,57) = b(k,57) * lu(k,109) + b(k,56) = b(k,56) * lu(k,105) + b(k,55) = b(k,55) * lu(k,102) + b(k,54) = b(k,54) * lu(k,99) + b(k,53) = b(k,53) * lu(k,96) + b(k,52) = b(k,52) * lu(k,93) + b(k,51) = b(k,51) * lu(k,92) + b(k,41) = b(k,41) - lu(k,91) * b(k,51) + b(k,40) = b(k,40) - lu(k,90) * b(k,51) + b(k,39) = b(k,39) - lu(k,89) * b(k,51) + b(k,38) = b(k,38) - lu(k,88) * b(k,51) + b(k,37) = b(k,37) - lu(k,87) * b(k,51) + b(k,50) = b(k,50) * lu(k,86) + b(k,41) = b(k,41) - lu(k,85) * b(k,50) + b(k,40) = b(k,40) - lu(k,84) * b(k,50) + b(k,39) = b(k,39) - lu(k,83) * b(k,50) + b(k,38) = b(k,38) - lu(k,82) * b(k,50) + b(k,37) = b(k,37) - lu(k,81) * b(k,50) + b(k,49) = b(k,49) * lu(k,80) + b(k,41) = b(k,41) - lu(k,79) * b(k,49) + b(k,40) = b(k,40) - lu(k,78) * b(k,49) + b(k,39) = b(k,39) - lu(k,77) * b(k,49) + b(k,38) = b(k,38) - lu(k,76) * b(k,49) + b(k,37) = b(k,37) - lu(k,75) * b(k,49) + b(k,48) = b(k,48) * lu(k,74) + b(k,47) = b(k,47) - lu(k,73) * b(k,48) + b(k,47) = b(k,47) * lu(k,72) + b(k,41) = b(k,41) - lu(k,71) * b(k,47) + b(k,40) = b(k,40) - lu(k,70) * b(k,47) + b(k,39) = b(k,39) - lu(k,69) * b(k,47) + b(k,38) = b(k,38) - lu(k,68) * b(k,47) + b(k,37) = b(k,37) - lu(k,67) * b(k,47) + b(k,46) = b(k,46) * lu(k,66) + b(k,41) = b(k,41) - lu(k,65) * b(k,46) + b(k,40) = b(k,40) - lu(k,64) * b(k,46) + b(k,39) = b(k,39) - lu(k,63) * b(k,46) + b(k,38) = b(k,38) - lu(k,62) * b(k,46) + b(k,37) = b(k,37) - lu(k,61) * b(k,46) + b(k,45) = b(k,45) * lu(k,60) + b(k,41) = b(k,41) - lu(k,59) * b(k,45) + b(k,40) = b(k,40) - lu(k,58) * b(k,45) + b(k,39) = b(k,39) - lu(k,57) * b(k,45) + b(k,38) = b(k,38) - lu(k,56) * b(k,45) + b(k,37) = b(k,37) - lu(k,55) * b(k,45) + b(k,44) = b(k,44) * lu(k,54) + b(k,41) = b(k,41) - lu(k,53) * b(k,44) + b(k,40) = b(k,40) - lu(k,52) * b(k,44) + b(k,39) = b(k,39) - lu(k,51) * b(k,44) + b(k,38) = b(k,38) - lu(k,50) * b(k,44) + b(k,37) = b(k,37) - lu(k,49) * b(k,44) + b(k,43) = b(k,43) * lu(k,48) + b(k,41) = b(k,41) - lu(k,47) * b(k,43) + b(k,40) = b(k,40) - lu(k,46) * b(k,43) + b(k,39) = b(k,39) - lu(k,45) * b(k,43) + b(k,38) = b(k,38) - lu(k,44) * b(k,43) + b(k,37) = b(k,37) - lu(k,43) * b(k,43) + b(k,42) = b(k,42) * lu(k,42) + b(k,41) = b(k,41) * lu(k,41) + b(k,40) = b(k,40) * lu(k,40) + b(k,39) = b(k,39) * lu(k,39) + b(k,38) = b(k,38) * lu(k,38) + b(k,37) = b(k,37) * lu(k,37) + b(k,36) = b(k,36) * lu(k,36) + b(k,35) = b(k,35) * lu(k,35) + b(k,34) = b(k,34) * lu(k,34) b(k,33) = b(k,33) * lu(k,33) b(k,32) = b(k,32) * lu(k,32) b(k,31) = b(k,31) * lu(k,31) @@ -2395,7 +2692,7 @@ subroutine lu_slv11( avec_len, lu, b ) b(k,2) = b(k,2) * lu(k,2) b(k,1) = b(k,1) * lu(k,1) end do - end subroutine lu_slv11 + end subroutine lu_slv12 subroutine lu_slv( avec_len, lu, b ) use shr_kind_mod, only : r8 => shr_kind_r8 use chem_mods, only : clscnt4, nzcnt @@ -2417,5 +2714,6 @@ subroutine lu_slv( avec_len, lu, b ) call lu_slv09( avec_len, lu, b ) call lu_slv10( avec_len, lu, b ) call lu_slv11( avec_len, lu, b ) + call lu_slv12( avec_len, lu, b ) end subroutine lu_slv end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 index e34a77f800..2e7d0ee660 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_nln_matrix.F90 @@ -22,213 +22,248 @@ subroutine nlnmat01( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,536) = -(rxt(k,396)*y(k,221)) - mat(k,1657) = -rxt(k,396)*y(k,1) - mat(k,1462) = rxt(k,399)*y(k,190) - mat(k,876) = rxt(k,399)*y(k,124) - mat(k,547) = -(rxt(k,400)*y(k,221)) - mat(k,1658) = -rxt(k,400)*y(k,2) - mat(k,877) = rxt(k,397)*y(k,203) - mat(k,2057) = rxt(k,397)*y(k,190) - mat(k,858) = -(rxt(k,479)*y(k,126) + rxt(k,480)*y(k,135) + rxt(k,481) & - *y(k,221)) + mat(k,640) = -(rxt(k,396)*y(k,226)) + mat(k,1734) = -rxt(k,396)*y(k,1) + mat(k,2020) = rxt(k,399)*y(k,190) + mat(k,1036) = rxt(k,399)*y(k,124) + mat(k,685) = -(rxt(k,400)*y(k,226)) + mat(k,1737) = -rxt(k,400)*y(k,2) + mat(k,2147) = rxt(k,397)*y(k,190) + mat(k,1037) = rxt(k,397)*y(k,90) + mat(k,988) = -(rxt(k,479)*y(k,126) + rxt(k,480)*y(k,135) + rxt(k,481) & + *y(k,226)) mat(k,1869) = -rxt(k,479)*y(k,6) - mat(k,1750) = -rxt(k,480)*y(k,6) - mat(k,1682) = -rxt(k,481)*y(k,6) - mat(k,86) = -(rxt(k,438)*y(k,221)) - mat(k,1595) = -rxt(k,438)*y(k,7) - mat(k,273) = -(rxt(k,441)*y(k,221)) - mat(k,1625) = -rxt(k,441)*y(k,8) - mat(k,375) = rxt(k,439)*y(k,203) - mat(k,2031) = rxt(k,439)*y(k,191) - mat(k,87) = .120_r8*rxt(k,438)*y(k,221) - mat(k,1596) = .120_r8*rxt(k,438)*y(k,7) - mat(k,855) = .100_r8*rxt(k,480)*y(k,135) - mat(k,817) = .100_r8*rxt(k,483)*y(k,135) - mat(k,1739) = .100_r8*rxt(k,480)*y(k,6) + .100_r8*rxt(k,483)*y(k,110) - mat(k,1449) = .500_r8*rxt(k,440)*y(k,191) + .200_r8*rxt(k,467)*y(k,228) & - + .060_r8*rxt(k,473)*y(k,230) - mat(k,376) = .500_r8*rxt(k,440)*y(k,124) - mat(k,614) = .200_r8*rxt(k,467)*y(k,124) - mat(k,630) = .060_r8*rxt(k,473)*y(k,124) - mat(k,1443) = .200_r8*rxt(k,467)*y(k,228) + .200_r8*rxt(k,473)*y(k,230) - mat(k,613) = .200_r8*rxt(k,467)*y(k,124) - mat(k,628) = .200_r8*rxt(k,473)*y(k,124) - mat(k,1458) = .200_r8*rxt(k,467)*y(k,228) + .150_r8*rxt(k,473)*y(k,230) - mat(k,616) = .200_r8*rxt(k,467)*y(k,124) - mat(k,631) = .150_r8*rxt(k,473)*y(k,124) - mat(k,1445) = .210_r8*rxt(k,473)*y(k,230) - mat(k,629) = .210_r8*rxt(k,473)*y(k,124) - mat(k,163) = -(rxt(k,401)*y(k,221)) - mat(k,1608) = -rxt(k,401)*y(k,15) - mat(k,854) = .050_r8*rxt(k,480)*y(k,135) - mat(k,816) = .050_r8*rxt(k,483)*y(k,135) - mat(k,1738) = .050_r8*rxt(k,480)*y(k,6) + .050_r8*rxt(k,483)*y(k,110) - mat(k,259) = -(rxt(k,367)*y(k,126) + rxt(k,368)*y(k,221)) + mat(k,2375) = -rxt(k,480)*y(k,6) + mat(k,1762) = -rxt(k,481)*y(k,6) + mat(k,158) = -(rxt(k,438)*y(k,226)) + mat(k,1666) = -rxt(k,438)*y(k,7) + mat(k,401) = -(rxt(k,441)*y(k,226)) + mat(k,1704) = -rxt(k,441)*y(k,8) + mat(k,2125) = rxt(k,439)*y(k,192) + mat(k,484) = rxt(k,439)*y(k,90) + mat(k,159) = .120_r8*rxt(k,438)*y(k,226) + mat(k,1667) = .120_r8*rxt(k,438)*y(k,7) + mat(k,986) = .100_r8*rxt(k,480)*y(k,135) + mat(k,1014) = .100_r8*rxt(k,483)*y(k,135) + mat(k,2365) = .100_r8*rxt(k,480)*y(k,6) + .100_r8*rxt(k,483)*y(k,110) + mat(k,2007) = .500_r8*rxt(k,440)*y(k,192) + .200_r8*rxt(k,467)*y(k,233) & + + .060_r8*rxt(k,473)*y(k,236) + mat(k,485) = .500_r8*rxt(k,440)*y(k,124) + mat(k,745) = .200_r8*rxt(k,467)*y(k,124) + mat(k,761) = .060_r8*rxt(k,473)*y(k,124) + mat(k,2001) = .200_r8*rxt(k,467)*y(k,233) + .200_r8*rxt(k,473)*y(k,236) + mat(k,744) = .200_r8*rxt(k,467)*y(k,124) + mat(k,759) = .200_r8*rxt(k,473)*y(k,124) + mat(k,2017) = .200_r8*rxt(k,467)*y(k,233) + .150_r8*rxt(k,473)*y(k,236) + mat(k,746) = .200_r8*rxt(k,467)*y(k,124) + mat(k,762) = .150_r8*rxt(k,473)*y(k,124) + mat(k,2003) = .210_r8*rxt(k,473)*y(k,236) + mat(k,760) = .210_r8*rxt(k,473)*y(k,124) + mat(k,233) = -(rxt(k,401)*y(k,226)) + mat(k,1679) = -rxt(k,401)*y(k,15) + mat(k,985) = .050_r8*rxt(k,480)*y(k,135) + mat(k,1013) = .050_r8*rxt(k,483)*y(k,135) + mat(k,2364) = .050_r8*rxt(k,480)*y(k,6) + .050_r8*rxt(k,483)*y(k,110) + mat(k,353) = -(rxt(k,367)*y(k,126) + rxt(k,368)*y(k,226)) mat(k,1863) = -rxt(k,367)*y(k,16) - mat(k,1623) = -rxt(k,368)*y(k,16) - mat(k,1352) = -(rxt(k,250)*y(k,42) + rxt(k,251)*y(k,203) + rxt(k,252) & - *y(k,135)) - mat(k,1840) = -rxt(k,250)*y(k,17) - mat(k,2100) = -rxt(k,251)*y(k,17) - mat(k,1775) = -rxt(k,252)*y(k,17) - mat(k,2006) = 4.000_r8*rxt(k,253)*y(k,19) + (rxt(k,254)+rxt(k,255))*y(k,59) & - + rxt(k,258)*y(k,124) + rxt(k,261)*y(k,133) + rxt(k,508) & - *y(k,151) + rxt(k,262)*y(k,221) - mat(k,2127) = (rxt(k,254)+rxt(k,255))*y(k,19) - mat(k,754) = rxt(k,263)*y(k,133) + rxt(k,269)*y(k,217) + rxt(k,264)*y(k,221) - mat(k,1504) = rxt(k,258)*y(k,19) - mat(k,1816) = rxt(k,261)*y(k,19) + rxt(k,263)*y(k,81) - mat(k,1319) = rxt(k,508)*y(k,19) - mat(k,1565) = rxt(k,269)*y(k,81) - mat(k,1713) = rxt(k,262)*y(k,19) + rxt(k,264)*y(k,81) - mat(k,1999) = rxt(k,256)*y(k,59) - mat(k,2120) = rxt(k,256)*y(k,19) - mat(k,1333) = (rxt(k,556)+rxt(k,561))*y(k,91) - mat(k,653) = (rxt(k,556)+rxt(k,561))*y(k,85) - mat(k,2019) = -(4._r8*rxt(k,253)*y(k,19) + (rxt(k,254) + rxt(k,255) + rxt(k,256) & - ) * y(k,59) + rxt(k,257)*y(k,203) + rxt(k,258)*y(k,124) & - + rxt(k,259)*y(k,125) + rxt(k,261)*y(k,133) + rxt(k,262) & - *y(k,221) + rxt(k,508)*y(k,151)) - mat(k,2141) = -(rxt(k,254) + rxt(k,255) + rxt(k,256)) * y(k,19) - mat(k,2114) = -rxt(k,257)*y(k,19) - mat(k,1518) = -rxt(k,258)*y(k,19) - mat(k,1995) = -rxt(k,259)*y(k,19) - mat(k,1830) = -rxt(k,261)*y(k,19) - mat(k,1727) = -rxt(k,262)*y(k,19) - mat(k,1328) = -rxt(k,508)*y(k,19) - mat(k,1360) = rxt(k,252)*y(k,135) - mat(k,445) = rxt(k,260)*y(k,133) - mat(k,759) = rxt(k,270)*y(k,217) - mat(k,660) = rxt(k,265)*y(k,133) - mat(k,1830) = mat(k,1830) + rxt(k,260)*y(k,20) + rxt(k,265)*y(k,91) - mat(k,1789) = rxt(k,252)*y(k,17) - mat(k,1579) = rxt(k,270)*y(k,81) - mat(k,438) = -(rxt(k,260)*y(k,133)) - mat(k,1798) = -rxt(k,260)*y(k,20) - mat(k,2001) = rxt(k,259)*y(k,125) - mat(k,1963) = rxt(k,259)*y(k,19) - mat(k,169) = -(rxt(k,442)*y(k,221)) - mat(k,1609) = -rxt(k,442)*y(k,22) - mat(k,1442) = rxt(k,445)*y(k,192) - mat(k,321) = rxt(k,445)*y(k,124) - mat(k,241) = -(rxt(k,444)*y(k,221)) - mat(k,1620) = -rxt(k,444)*y(k,23) - mat(k,322) = rxt(k,443)*y(k,203) - mat(k,2029) = rxt(k,443)*y(k,192) - mat(k,200) = -(rxt(k,316)*y(k,56) + rxt(k,317)*y(k,221)) - mat(k,1523) = -rxt(k,316)*y(k,24) - mat(k,1614) = -rxt(k,317)*y(k,24) - mat(k,450) = -(rxt(k,318)*y(k,56) + rxt(k,319)*y(k,135) + rxt(k,344)*y(k,221)) - mat(k,1525) = -rxt(k,318)*y(k,25) - mat(k,1742) = -rxt(k,319)*y(k,25) - mat(k,1647) = -rxt(k,344)*y(k,25) - mat(k,177) = -(rxt(k,324)*y(k,221)) - mat(k,1611) = -rxt(k,324)*y(k,26) - mat(k,837) = .800_r8*rxt(k,320)*y(k,193) + .200_r8*rxt(k,321)*y(k,197) - mat(k,1363) = .200_r8*rxt(k,321)*y(k,193) - mat(k,246) = -(rxt(k,325)*y(k,221)) - mat(k,1621) = -rxt(k,325)*y(k,27) - mat(k,838) = rxt(k,322)*y(k,203) - mat(k,2030) = rxt(k,322)*y(k,193) - mat(k,206) = -(rxt(k,326)*y(k,56) + rxt(k,327)*y(k,221)) - mat(k,1524) = -rxt(k,326)*y(k,28) - mat(k,1615) = -rxt(k,327)*y(k,28) - mat(k,943) = -(rxt(k,347)*y(k,126) + rxt(k,348)*y(k,135) + rxt(k,365) & - *y(k,221)) - mat(k,1875) = -rxt(k,347)*y(k,29) - mat(k,1755) = -rxt(k,348)*y(k,29) - mat(k,1689) = -rxt(k,365)*y(k,29) - mat(k,782) = .130_r8*rxt(k,425)*y(k,135) - mat(k,1755) = mat(k,1755) + .130_r8*rxt(k,425)*y(k,98) - mat(k,303) = -(rxt(k,352)*y(k,221)) - mat(k,1629) = -rxt(k,352)*y(k,30) - mat(k,727) = rxt(k,350)*y(k,203) - mat(k,2035) = rxt(k,350)*y(k,194) - mat(k,55) = -(rxt(k,353)*y(k,221)) - mat(k,1592) = -rxt(k,353)*y(k,31) - mat(k,181) = -(rxt(k,448)*y(k,221)) - mat(k,1612) = -rxt(k,448)*y(k,32) - mat(k,527) = rxt(k,446)*y(k,203) - mat(k,2025) = rxt(k,446)*y(k,195) - mat(k,1849) = -(rxt(k,214)*y(k,56) + rxt(k,250)*y(k,17) + rxt(k,294)*y(k,203) & + mat(k,1698) = -rxt(k,368)*y(k,16) + mat(k,1509) = -(rxt(k,250)*y(k,42) + rxt(k,251)*y(k,90) + rxt(k,252)*y(k,135)) + mat(k,2338) = -rxt(k,250)*y(k,17) + mat(k,2192) = -rxt(k,251)*y(k,17) + mat(k,2402) = -rxt(k,252)*y(k,17) + mat(k,1561) = 4.000_r8*rxt(k,253)*y(k,19) + (rxt(k,254)+rxt(k,255))*y(k,59) & + + rxt(k,258)*y(k,124) + rxt(k,261)*y(k,133) + rxt(k,509) & + *y(k,151) + rxt(k,262)*y(k,226) + mat(k,139) = rxt(k,240)*y(k,222) + mat(k,145) = rxt(k,266)*y(k,222) + mat(k,472) = 2.000_r8*rxt(k,277)*y(k,56) + 2.000_r8*rxt(k,289)*y(k,222) & + + 2.000_r8*rxt(k,278)*y(k,226) + mat(k,604) = rxt(k,279)*y(k,56) + rxt(k,290)*y(k,222) + rxt(k,280)*y(k,226) + mat(k,447) = 3.000_r8*rxt(k,284)*y(k,56) + 3.000_r8*rxt(k,267)*y(k,222) & + + 3.000_r8*rxt(k,285)*y(k,226) + mat(k,1945) = 2.000_r8*rxt(k,277)*y(k,41) + rxt(k,279)*y(k,43) & + + 3.000_r8*rxt(k,284)*y(k,55) + mat(k,1587) = (rxt(k,254)+rxt(k,255))*y(k,19) + mat(k,107) = 2.000_r8*rxt(k,268)*y(k,222) + mat(k,827) = rxt(k,263)*y(k,133) + rxt(k,269)*y(k,222) + rxt(k,264)*y(k,226) + mat(k,2063) = rxt(k,258)*y(k,19) + mat(k,2312) = rxt(k,261)*y(k,19) + rxt(k,263)*y(k,81) + mat(k,1475) = rxt(k,509)*y(k,19) + mat(k,1629) = rxt(k,240)*y(k,34) + rxt(k,266)*y(k,35) + 2.000_r8*rxt(k,289) & + *y(k,41) + rxt(k,290)*y(k,43) + 3.000_r8*rxt(k,267)*y(k,55) & + + 2.000_r8*rxt(k,268)*y(k,78) + rxt(k,269)*y(k,81) + mat(k,1794) = rxt(k,262)*y(k,19) + 2.000_r8*rxt(k,278)*y(k,41) + rxt(k,280) & + *y(k,43) + 3.000_r8*rxt(k,285)*y(k,55) + rxt(k,264)*y(k,81) + mat(k,1554) = rxt(k,256)*y(k,59) + mat(k,1580) = rxt(k,256)*y(k,19) + mat(k,1489) = (rxt(k,570)+rxt(k,575))*y(k,92) + mat(k,784) = (rxt(k,570)+rxt(k,575))*y(k,85) + mat(k,1563) = -(4._r8*rxt(k,253)*y(k,19) + (rxt(k,254) + rxt(k,255) + rxt(k,256) & + ) * y(k,59) + rxt(k,257)*y(k,90) + rxt(k,258)*y(k,124) + rxt(k,259) & + *y(k,125) + rxt(k,261)*y(k,133) + rxt(k,262)*y(k,226) + rxt(k,509) & + *y(k,151)) + mat(k,1589) = -(rxt(k,254) + rxt(k,255) + rxt(k,256)) * y(k,19) + mat(k,2194) = -rxt(k,257)*y(k,19) + mat(k,2065) = -rxt(k,258)*y(k,19) + mat(k,1841) = -rxt(k,259)*y(k,19) + mat(k,2314) = -rxt(k,261)*y(k,19) + mat(k,1796) = -rxt(k,262)*y(k,19) + mat(k,1477) = -rxt(k,509)*y(k,19) + mat(k,1511) = rxt(k,252)*y(k,135) + mat(k,567) = rxt(k,260)*y(k,133) + mat(k,828) = rxt(k,270)*y(k,222) + mat(k,788) = rxt(k,265)*y(k,133) + mat(k,2314) = mat(k,2314) + rxt(k,260)*y(k,20) + rxt(k,265)*y(k,92) + mat(k,2404) = rxt(k,252)*y(k,17) + mat(k,1631) = rxt(k,270)*y(k,81) + mat(k,564) = -(rxt(k,260)*y(k,133)) + mat(k,2293) = -rxt(k,260)*y(k,20) + mat(k,1556) = rxt(k,259)*y(k,125) + mat(k,1820) = rxt(k,259)*y(k,19) + mat(k,245) = -(rxt(k,442)*y(k,226)) + mat(k,1682) = -rxt(k,442)*y(k,22) + mat(k,2000) = rxt(k,445)*y(k,194) + mat(k,431) = rxt(k,445)*y(k,124) + mat(k,343) = -(rxt(k,444)*y(k,226)) + mat(k,1696) = -rxt(k,444)*y(k,23) + mat(k,2121) = rxt(k,443)*y(k,194) + mat(k,432) = rxt(k,443)*y(k,90) + mat(k,290) = -(rxt(k,315)*y(k,56) + rxt(k,316)*y(k,226)) + mat(k,1919) = -rxt(k,315)*y(k,24) + mat(k,1688) = -rxt(k,316)*y(k,24) + mat(k,548) = -(rxt(k,317)*y(k,56) + rxt(k,318)*y(k,135) + rxt(k,343)*y(k,226)) + mat(k,1925) = -rxt(k,317)*y(k,25) + mat(k,2367) = -rxt(k,318)*y(k,25) + mat(k,1723) = -rxt(k,343)*y(k,25) + mat(k,263) = -(rxt(k,323)*y(k,226)) + mat(k,1685) = -rxt(k,323)*y(k,26) + mat(k,896) = .800_r8*rxt(k,319)*y(k,195) + .200_r8*rxt(k,320)*y(k,199) + mat(k,2211) = .200_r8*rxt(k,320)*y(k,195) + mat(k,348) = -(rxt(k,324)*y(k,226)) + mat(k,1697) = -rxt(k,324)*y(k,27) + mat(k,2122) = rxt(k,321)*y(k,195) + mat(k,897) = rxt(k,321)*y(k,90) + mat(k,296) = -(rxt(k,325)*y(k,56) + rxt(k,326)*y(k,226)) + mat(k,1920) = -rxt(k,325)*y(k,28) + mat(k,1689) = -rxt(k,326)*y(k,28) + mat(k,1131) = -(rxt(k,346)*y(k,126) + rxt(k,347)*y(k,135) + rxt(k,365) & + *y(k,226)) + mat(k,1879) = -rxt(k,346)*y(k,29) + mat(k,2384) = -rxt(k,347)*y(k,29) + mat(k,1772) = -rxt(k,365)*y(k,29) + mat(k,882) = .130_r8*rxt(k,425)*y(k,135) + mat(k,2384) = mat(k,2384) + .130_r8*rxt(k,425)*y(k,99) + mat(k,413) = -(rxt(k,351)*y(k,226)) + mat(k,1706) = -rxt(k,351)*y(k,30) + mat(k,2127) = rxt(k,349)*y(k,196) + mat(k,932) = rxt(k,349)*y(k,90) + mat(k,302) = -(rxt(k,352)*y(k,226) + rxt(k,355)*y(k,56)) + mat(k,1690) = -rxt(k,352)*y(k,31) + mat(k,1921) = -rxt(k,355)*y(k,31) + mat(k,267) = -(rxt(k,448)*y(k,226)) + mat(k,1686) = -rxt(k,448)*y(k,32) + mat(k,2117) = rxt(k,446)*y(k,197) + mat(k,631) = rxt(k,446)*y(k,90) + mat(k,99) = -(rxt(k,239)*y(k,222)) + mat(k,1605) = -rxt(k,239)*y(k,33) + mat(k,137) = -(rxt(k,240)*y(k,222)) + mat(k,1610) = -rxt(k,240)*y(k,34) + mat(k,142) = -(rxt(k,266)*y(k,222)) + mat(k,1611) = -rxt(k,266)*y(k,35) + mat(k,109) = -(rxt(k,241)*y(k,222)) + mat(k,1607) = -rxt(k,241)*y(k,36) + mat(k,147) = -(rxt(k,242)*y(k,222)) + mat(k,1612) = -rxt(k,242)*y(k,37) + mat(k,113) = -(rxt(k,243)*y(k,222)) + mat(k,1608) = -rxt(k,243)*y(k,38) + mat(k,152) = -(rxt(k,244)*y(k,222)) + mat(k,1613) = -rxt(k,244)*y(k,39) + mat(k,117) = -(rxt(k,245)*y(k,222)) + mat(k,1609) = -rxt(k,245)*y(k,40) + mat(k,470) = -(rxt(k,277)*y(k,56) + rxt(k,278)*y(k,226) + rxt(k,289)*y(k,222)) + mat(k,1924) = -rxt(k,277)*y(k,41) + mat(k,1714) = -rxt(k,278)*y(k,41) + mat(k,1623) = -rxt(k,289)*y(k,41) + mat(k,2354) = -(rxt(k,214)*y(k,56) + rxt(k,250)*y(k,17) + rxt(k,294)*y(k,90) & + rxt(k,295)*y(k,126) + rxt(k,296)*y(k,133) + rxt(k,297) & - *y(k,221)) - mat(k,1548) = -rxt(k,214)*y(k,42) - mat(k,1358) = -rxt(k,250)*y(k,42) - mat(k,2109) = -rxt(k,294)*y(k,42) - mat(k,1906) = -rxt(k,295)*y(k,42) - mat(k,1825) = -rxt(k,296)*y(k,42) - mat(k,1722) = -rxt(k,297)*y(k,42) - mat(k,543) = .400_r8*rxt(k,396)*y(k,221) - mat(k,871) = .340_r8*rxt(k,480)*y(k,135) - mat(k,264) = .500_r8*rxt(k,367)*y(k,126) - mat(k,456) = rxt(k,319)*y(k,135) - mat(k,954) = .500_r8*rxt(k,348)*y(k,135) - mat(k,410) = .500_r8*rxt(k,336)*y(k,221) - mat(k,710) = rxt(k,302)*y(k,221) - mat(k,312) = .300_r8*rxt(k,303)*y(k,221) - mat(k,2136) = rxt(k,221)*y(k,197) - mat(k,963) = .800_r8*rxt(k,341)*y(k,221) - mat(k,793) = .910_r8*rxt(k,425)*y(k,135) - mat(k,510) = .300_r8*rxt(k,416)*y(k,221) - mat(k,1132) = .800_r8*rxt(k,420)*y(k,197) - mat(k,1147) = .120_r8*rxt(k,378)*y(k,135) - mat(k,470) = .500_r8*rxt(k,391)*y(k,221) - mat(k,833) = .340_r8*rxt(k,483)*y(k,135) - mat(k,1259) = .600_r8*rxt(k,392)*y(k,135) - mat(k,1513) = .100_r8*rxt(k,398)*y(k,190) + rxt(k,301)*y(k,197) & - + .500_r8*rxt(k,369)*y(k,200) + .500_r8*rxt(k,338)*y(k,202) & - + .920_r8*rxt(k,408)*y(k,205) + .250_r8*rxt(k,376)*y(k,207) & - + rxt(k,385)*y(k,209) + rxt(k,359)*y(k,224) + rxt(k,363) & - *y(k,225) + .340_r8*rxt(k,492)*y(k,226) + .320_r8*rxt(k,497) & - *y(k,227) + .250_r8*rxt(k,433)*y(k,229) - mat(k,1906) = mat(k,1906) + .500_r8*rxt(k,367)*y(k,16) + rxt(k,409)*y(k,205) & - + .250_r8*rxt(k,375)*y(k,207) + rxt(k,386)*y(k,209) - mat(k,1784) = .340_r8*rxt(k,480)*y(k,6) + rxt(k,319)*y(k,25) & - + .500_r8*rxt(k,348)*y(k,29) + .910_r8*rxt(k,425)*y(k,98) & + *y(k,226)) + mat(k,1961) = -rxt(k,214)*y(k,42) + mat(k,1519) = -rxt(k,250)*y(k,42) + mat(k,2208) = -rxt(k,294)*y(k,42) + mat(k,1915) = -rxt(k,295)*y(k,42) + mat(k,2328) = -rxt(k,296)*y(k,42) + mat(k,1810) = -rxt(k,297)*y(k,42) + mat(k,649) = .400_r8*rxt(k,396)*y(k,226) + mat(k,1004) = .340_r8*rxt(k,480)*y(k,135) + mat(k,360) = .500_r8*rxt(k,367)*y(k,126) + mat(k,554) = rxt(k,318)*y(k,135) + mat(k,1146) = .500_r8*rxt(k,347)*y(k,135) + mat(k,623) = .500_r8*rxt(k,335)*y(k,226) + mat(k,814) = rxt(k,302)*y(k,226) + mat(k,393) = .300_r8*rxt(k,303)*y(k,226) + mat(k,2285) = (rxt(k,311)+rxt(k,312))*y(k,222) + mat(k,1602) = rxt(k,221)*y(k,199) + mat(k,1168) = .800_r8*rxt(k,340)*y(k,226) + mat(k,2208) = mat(k,2208) + .450_r8*rxt(k,383)*y(k,213) + .150_r8*rxt(k,362) & + *y(k,230) + mat(k,894) = .910_r8*rxt(k,425)*y(k,135) + mat(k,597) = .300_r8*rxt(k,416)*y(k,226) + mat(k,1275) = .120_r8*rxt(k,378)*y(k,135) + mat(k,588) = .500_r8*rxt(k,391)*y(k,226) + mat(k,1032) = .340_r8*rxt(k,483)*y(k,135) + mat(k,1387) = .600_r8*rxt(k,392)*y(k,135) + mat(k,2079) = .100_r8*rxt(k,398)*y(k,190) + rxt(k,301)*y(k,199) & + + .500_r8*rxt(k,369)*y(k,202) + .500_r8*rxt(k,337)*y(k,204) & + + .920_r8*rxt(k,408)*y(k,206) + .250_r8*rxt(k,376)*y(k,211) & + + rxt(k,385)*y(k,213) + rxt(k,359)*y(k,229) + rxt(k,363) & + *y(k,230) + .340_r8*rxt(k,492)*y(k,231) + .320_r8*rxt(k,497) & + *y(k,232) + .250_r8*rxt(k,433)*y(k,235) + mat(k,1915) = mat(k,1915) + .500_r8*rxt(k,367)*y(k,16) + rxt(k,409)*y(k,206) & + + .250_r8*rxt(k,375)*y(k,211) + rxt(k,386)*y(k,213) + mat(k,2418) = .340_r8*rxt(k,480)*y(k,6) + rxt(k,318)*y(k,25) & + + .500_r8*rxt(k,347)*y(k,29) + .910_r8*rxt(k,425)*y(k,99) & + .120_r8*rxt(k,378)*y(k,105) + .340_r8*rxt(k,483)*y(k,110) & + .600_r8*rxt(k,392)*y(k,111) - mat(k,354) = rxt(k,343)*y(k,221) - mat(k,988) = .680_r8*rxt(k,501)*y(k,221) - mat(k,888) = .100_r8*rxt(k,398)*y(k,124) - mat(k,846) = .700_r8*rxt(k,321)*y(k,197) - mat(k,735) = rxt(k,349)*y(k,197) - mat(k,1308) = rxt(k,332)*y(k,197) + rxt(k,405)*y(k,205) + .250_r8*rxt(k,372) & - *y(k,207) + rxt(k,381)*y(k,209) + .250_r8*rxt(k,430)*y(k,229) - mat(k,1402) = rxt(k,221)*y(k,59) + .800_r8*rxt(k,420)*y(k,101) + rxt(k,301) & - *y(k,124) + .700_r8*rxt(k,321)*y(k,193) + rxt(k,349)*y(k,194) & - + rxt(k,332)*y(k,196) + (4.000_r8*rxt(k,298)+2.000_r8*rxt(k,299)) & - *y(k,197) + 1.500_r8*rxt(k,406)*y(k,205) + .750_r8*rxt(k,411) & - *y(k,206) + .880_r8*rxt(k,373)*y(k,207) + 2.000_r8*rxt(k,382) & - *y(k,209) + .750_r8*rxt(k,485)*y(k,216) + .800_r8*rxt(k,361) & - *y(k,225) + .930_r8*rxt(k,490)*y(k,226) + .950_r8*rxt(k,495) & - *y(k,227) + .800_r8*rxt(k,431)*y(k,229) - mat(k,463) = .500_r8*rxt(k,369)*y(k,124) - mat(k,669) = .500_r8*rxt(k,338)*y(k,124) - mat(k,2109) = mat(k,2109) + .450_r8*rxt(k,383)*y(k,209) + .150_r8*rxt(k,362) & - *y(k,225) - mat(k,1181) = .920_r8*rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126) + rxt(k,405) & - *y(k,196) + 1.500_r8*rxt(k,406)*y(k,197) - mat(k,1215) = .750_r8*rxt(k,411)*y(k,197) - mat(k,1237) = .250_r8*rxt(k,376)*y(k,124) + .250_r8*rxt(k,375)*y(k,126) & - + .250_r8*rxt(k,372)*y(k,196) + .880_r8*rxt(k,373)*y(k,197) - mat(k,1277) = rxt(k,385)*y(k,124) + rxt(k,386)*y(k,126) + rxt(k,381)*y(k,196) & - + 2.000_r8*rxt(k,382)*y(k,197) + .450_r8*rxt(k,383)*y(k,203) & - + 4.000_r8*rxt(k,384)*y(k,209) - mat(k,1055) = .750_r8*rxt(k,485)*y(k,197) - mat(k,1722) = mat(k,1722) + .400_r8*rxt(k,396)*y(k,1) + .500_r8*rxt(k,336) & + mat(k,539) = rxt(k,342)*y(k,226) + mat(k,1109) = .680_r8*rxt(k,501)*y(k,226) + mat(k,1050) = .100_r8*rxt(k,398)*y(k,124) + mat(k,907) = .700_r8*rxt(k,320)*y(k,199) + mat(k,942) = rxt(k,348)*y(k,199) + mat(k,1437) = rxt(k,331)*y(k,199) + rxt(k,405)*y(k,206) + .250_r8*rxt(k,372) & + *y(k,211) + rxt(k,381)*y(k,213) + .250_r8*rxt(k,430)*y(k,235) + mat(k,2260) = rxt(k,221)*y(k,59) + rxt(k,301)*y(k,124) + .700_r8*rxt(k,320) & + *y(k,195) + rxt(k,348)*y(k,196) + rxt(k,331)*y(k,198) + ( & + + 4.000_r8*rxt(k,298)+2.000_r8*rxt(k,299))*y(k,199) & + + 1.500_r8*rxt(k,406)*y(k,206) + .750_r8*rxt(k,411)*y(k,207) & + + .800_r8*rxt(k,420)*y(k,208) + .880_r8*rxt(k,373)*y(k,211) & + + 2.000_r8*rxt(k,382)*y(k,213) + .750_r8*rxt(k,485)*y(k,221) & + + .800_r8*rxt(k,361)*y(k,230) + .930_r8*rxt(k,490)*y(k,231) & + + .950_r8*rxt(k,495)*y(k,232) + .800_r8*rxt(k,431)*y(k,235) + mat(k,579) = .500_r8*rxt(k,369)*y(k,124) + mat(k,802) = .500_r8*rxt(k,337)*y(k,124) + mat(k,1310) = .920_r8*rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126) + rxt(k,405) & + *y(k,198) + 1.500_r8*rxt(k,406)*y(k,199) + mat(k,1343) = .750_r8*rxt(k,411)*y(k,199) + mat(k,1264) = .800_r8*rxt(k,420)*y(k,199) + mat(k,1365) = .250_r8*rxt(k,376)*y(k,124) + .250_r8*rxt(k,375)*y(k,126) & + + .250_r8*rxt(k,372)*y(k,198) + .880_r8*rxt(k,373)*y(k,199) + mat(k,1405) = .450_r8*rxt(k,383)*y(k,90) + rxt(k,385)*y(k,124) + rxt(k,386) & + *y(k,126) + rxt(k,381)*y(k,198) + 2.000_r8*rxt(k,382)*y(k,199) & + + 4.000_r8*rxt(k,384)*y(k,213) + mat(k,1099) = .750_r8*rxt(k,485)*y(k,199) + mat(k,1645) = (rxt(k,311)+rxt(k,312))*y(k,54) + mat(k,1810) = mat(k,1810) + .400_r8*rxt(k,396)*y(k,1) + .500_r8*rxt(k,335) & *y(k,51) + rxt(k,302)*y(k,52) + .300_r8*rxt(k,303)*y(k,53) & - + .800_r8*rxt(k,341)*y(k,74) + .300_r8*rxt(k,416)*y(k,99) & - + .500_r8*rxt(k,391)*y(k,109) + rxt(k,343)*y(k,140) & + + .800_r8*rxt(k,340)*y(k,74) + .300_r8*rxt(k,416)*y(k,100) & + + .500_r8*rxt(k,391)*y(k,109) + rxt(k,342)*y(k,140) & + .680_r8*rxt(k,501)*y(k,179) - mat(k,723) = rxt(k,359)*y(k,124) - mat(k,1071) = rxt(k,363)*y(k,124) + .800_r8*rxt(k,361)*y(k,197) & - + .150_r8*rxt(k,362)*y(k,203) - mat(k,1036) = .340_r8*rxt(k,492)*y(k,124) + .930_r8*rxt(k,490)*y(k,197) - mat(k,1016) = .320_r8*rxt(k,497)*y(k,124) + .950_r8*rxt(k,495)*y(k,197) - mat(k,1097) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,430)*y(k,196) & - + .800_r8*rxt(k,431)*y(k,197) + mat(k,824) = rxt(k,359)*y(k,124) + mat(k,1223) = .150_r8*rxt(k,362)*y(k,90) + rxt(k,363)*y(k,124) & + + .800_r8*rxt(k,361)*y(k,199) + mat(k,1186) = .340_r8*rxt(k,492)*y(k,124) + .930_r8*rxt(k,490)*y(k,199) + mat(k,1069) = .320_r8*rxt(k,497)*y(k,124) + .950_r8*rxt(k,495)*y(k,199) + mat(k,1241) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,430)*y(k,198) & + + .800_r8*rxt(k,431)*y(k,199) end do end subroutine nlnmat01 subroutine nlnmat02( avec_len, mat, y, rxt ) @@ -249,226 +284,222 @@ subroutine nlnmat02( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,1076) = -(rxt(k,328)*y(k,126) + rxt(k,329)*y(k,221)) - mat(k,1885) = -rxt(k,328)*y(k,45) - mat(k,1699) = -rxt(k,329)*y(k,45) - mat(k,540) = .800_r8*rxt(k,396)*y(k,221) - mat(k,262) = rxt(k,367)*y(k,126) - mat(k,178) = rxt(k,324)*y(k,221) - mat(k,248) = .500_r8*rxt(k,325)*y(k,221) - mat(k,946) = .500_r8*rxt(k,348)*y(k,135) - mat(k,1248) = .100_r8*rxt(k,392)*y(k,135) - mat(k,1493) = .400_r8*rxt(k,398)*y(k,190) + rxt(k,323)*y(k,193) & - + .270_r8*rxt(k,351)*y(k,194) + rxt(k,369)*y(k,200) + rxt(k,388) & - *y(k,211) + rxt(k,359)*y(k,224) - mat(k,1885) = mat(k,1885) + rxt(k,367)*y(k,16) - mat(k,1764) = .500_r8*rxt(k,348)*y(k,29) + .100_r8*rxt(k,392)*y(k,111) - mat(k,882) = .400_r8*rxt(k,398)*y(k,124) - mat(k,841) = rxt(k,323)*y(k,124) + 3.200_r8*rxt(k,320)*y(k,193) & - + .800_r8*rxt(k,321)*y(k,197) - mat(k,730) = .270_r8*rxt(k,351)*y(k,124) - mat(k,1385) = .800_r8*rxt(k,321)*y(k,193) - mat(k,461) = rxt(k,369)*y(k,124) - mat(k,2087) = .200_r8*rxt(k,387)*y(k,211) - mat(k,559) = rxt(k,388)*y(k,124) + .200_r8*rxt(k,387)*y(k,203) - mat(k,1699) = mat(k,1699) + .800_r8*rxt(k,396)*y(k,1) + rxt(k,324)*y(k,26) & - + .500_r8*rxt(k,325)*y(k,27) - mat(k,719) = rxt(k,359)*y(k,124) - mat(k,52) = -(rxt(k,330)*y(k,221)) - mat(k,1591) = -rxt(k,330)*y(k,47) - mat(k,898) = -(rxt(k,366)*y(k,221)) - mat(k,1685) = -rxt(k,366)*y(k,48) - mat(k,539) = .800_r8*rxt(k,396)*y(k,221) - mat(k,860) = .520_r8*rxt(k,480)*y(k,135) - mat(k,261) = .500_r8*rxt(k,367)*y(k,126) - mat(k,822) = .520_r8*rxt(k,483)*y(k,135) - mat(k,1481) = .250_r8*rxt(k,398)*y(k,190) + .820_r8*rxt(k,351)*y(k,194) & - + .500_r8*rxt(k,369)*y(k,200) + .270_r8*rxt(k,492)*y(k,226) & - + .040_r8*rxt(k,497)*y(k,227) - mat(k,1872) = .500_r8*rxt(k,367)*y(k,16) - mat(k,1753) = .520_r8*rxt(k,480)*y(k,6) + .520_r8*rxt(k,483)*y(k,110) - mat(k,981) = .500_r8*rxt(k,501)*y(k,221) - mat(k,881) = .250_r8*rxt(k,398)*y(k,124) - mat(k,729) = .820_r8*rxt(k,351)*y(k,124) + .820_r8*rxt(k,349)*y(k,197) - mat(k,1374) = .820_r8*rxt(k,349)*y(k,194) + .150_r8*rxt(k,490)*y(k,226) & - + .025_r8*rxt(k,495)*y(k,227) - mat(k,459) = .500_r8*rxt(k,369)*y(k,124) - mat(k,1685) = mat(k,1685) + .800_r8*rxt(k,396)*y(k,1) + .500_r8*rxt(k,501) & + mat(k,602) = -(rxt(k,279)*y(k,56) + rxt(k,280)*y(k,226) + rxt(k,290)*y(k,222)) + mat(k,1926) = -rxt(k,279)*y(k,43) + mat(k,1729) = -rxt(k,280)*y(k,43) + mat(k,1624) = -rxt(k,290)*y(k,43) + mat(k,121) = -(rxt(k,281)*y(k,226)) + mat(k,1664) = -rxt(k,281)*y(k,44) + mat(k,1149) = -(rxt(k,327)*y(k,126) + rxt(k,328)*y(k,226)) + mat(k,1880) = -rxt(k,327)*y(k,45) + mat(k,1773) = -rxt(k,328)*y(k,45) + mat(k,644) = .800_r8*rxt(k,396)*y(k,226) + mat(k,356) = rxt(k,367)*y(k,126) + mat(k,264) = rxt(k,323)*y(k,226) + mat(k,350) = .500_r8*rxt(k,324)*y(k,226) + mat(k,1132) = .500_r8*rxt(k,347)*y(k,135) + mat(k,2173) = .200_r8*rxt(k,387)*y(k,215) + mat(k,1369) = .100_r8*rxt(k,392)*y(k,135) + mat(k,2045) = .400_r8*rxt(k,398)*y(k,190) + rxt(k,322)*y(k,195) & + + .270_r8*rxt(k,350)*y(k,196) + rxt(k,369)*y(k,202) + rxt(k,388) & + *y(k,215) + rxt(k,359)*y(k,229) + mat(k,1880) = mat(k,1880) + rxt(k,367)*y(k,16) + mat(k,2385) = .500_r8*rxt(k,347)*y(k,29) + .100_r8*rxt(k,392)*y(k,111) + mat(k,1042) = .400_r8*rxt(k,398)*y(k,124) + mat(k,900) = rxt(k,322)*y(k,124) + 3.200_r8*rxt(k,319)*y(k,195) & + + .800_r8*rxt(k,320)*y(k,199) + mat(k,935) = .270_r8*rxt(k,350)*y(k,124) + mat(k,2228) = .800_r8*rxt(k,320)*y(k,195) + mat(k,574) = rxt(k,369)*y(k,124) + mat(k,697) = .200_r8*rxt(k,387)*y(k,90) + rxt(k,388)*y(k,124) + mat(k,1773) = mat(k,1773) + .800_r8*rxt(k,396)*y(k,1) + rxt(k,323)*y(k,26) & + + .500_r8*rxt(k,324)*y(k,27) + mat(k,817) = rxt(k,359)*y(k,124) + mat(k,369) = -(rxt(k,282)*y(k,56) + rxt(k,283)*y(k,226)) + mat(k,1922) = -rxt(k,282)*y(k,46) + mat(k,1700) = -rxt(k,283)*y(k,46) + mat(k,102) = -(rxt(k,329)*y(k,226)) + mat(k,1663) = -rxt(k,329)*y(k,47) + mat(k,1078) = -(rxt(k,366)*y(k,226)) + mat(k,1768) = -rxt(k,366)*y(k,48) + mat(k,643) = .800_r8*rxt(k,396)*y(k,226) + mat(k,993) = .520_r8*rxt(k,480)*y(k,135) + mat(k,355) = .500_r8*rxt(k,367)*y(k,126) + mat(k,1021) = .520_r8*rxt(k,483)*y(k,135) + mat(k,2041) = .250_r8*rxt(k,398)*y(k,190) + .820_r8*rxt(k,350)*y(k,196) & + + .500_r8*rxt(k,369)*y(k,202) + .270_r8*rxt(k,492)*y(k,231) & + + .040_r8*rxt(k,497)*y(k,232) + mat(k,1875) = .500_r8*rxt(k,367)*y(k,16) + mat(k,2381) = .520_r8*rxt(k,480)*y(k,6) + .520_r8*rxt(k,483)*y(k,110) + mat(k,1100) = .500_r8*rxt(k,501)*y(k,226) + mat(k,1041) = .250_r8*rxt(k,398)*y(k,124) + mat(k,934) = .820_r8*rxt(k,350)*y(k,124) + .820_r8*rxt(k,348)*y(k,199) + mat(k,2224) = .820_r8*rxt(k,348)*y(k,196) + .150_r8*rxt(k,490)*y(k,231) & + + .025_r8*rxt(k,495)*y(k,232) + mat(k,573) = .500_r8*rxt(k,369)*y(k,124) + mat(k,1768) = mat(k,1768) + .800_r8*rxt(k,396)*y(k,1) + .500_r8*rxt(k,501) & *y(k,179) - mat(k,1026) = .270_r8*rxt(k,492)*y(k,124) + .150_r8*rxt(k,490)*y(k,197) - mat(k,1004) = .040_r8*rxt(k,497)*y(k,124) + .025_r8*rxt(k,495)*y(k,197) - mat(k,1152) = -(rxt(k,354)*y(k,126) + rxt(k,355)*y(k,221)) - mat(k,1889) = -rxt(k,354)*y(k,49) - mat(k,1704) = -rxt(k,355)*y(k,49) - mat(k,992) = rxt(k,356)*y(k,221) - mat(k,1141) = .880_r8*rxt(k,378)*y(k,135) - mat(k,1249) = .500_r8*rxt(k,392)*y(k,135) - mat(k,1497) = .170_r8*rxt(k,451)*y(k,198) + .050_r8*rxt(k,414)*y(k,206) & - + .250_r8*rxt(k,376)*y(k,207) + .170_r8*rxt(k,457)*y(k,210) & - + .400_r8*rxt(k,467)*y(k,228) + .250_r8*rxt(k,433)*y(k,229) & - + .540_r8*rxt(k,473)*y(k,230) + .510_r8*rxt(k,476)*y(k,231) - mat(k,1889) = mat(k,1889) + .050_r8*rxt(k,415)*y(k,206) + .250_r8*rxt(k,375) & - *y(k,207) + .250_r8*rxt(k,434)*y(k,229) - mat(k,770) = rxt(k,357)*y(k,221) - mat(k,1767) = .880_r8*rxt(k,378)*y(k,105) + .500_r8*rxt(k,392)*y(k,111) - mat(k,1296) = .250_r8*rxt(k,372)*y(k,207) + .250_r8*rxt(k,430)*y(k,229) - mat(k,1389) = .240_r8*rxt(k,373)*y(k,207) + .500_r8*rxt(k,361)*y(k,225) & - + .100_r8*rxt(k,431)*y(k,229) - mat(k,647) = .170_r8*rxt(k,451)*y(k,124) + .070_r8*rxt(k,450)*y(k,203) - mat(k,2092) = .070_r8*rxt(k,450)*y(k,198) + .070_r8*rxt(k,456)*y(k,210) - mat(k,1205) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) - mat(k,1230) = .250_r8*rxt(k,376)*y(k,124) + .250_r8*rxt(k,375)*y(k,126) & - + .250_r8*rxt(k,372)*y(k,196) + .240_r8*rxt(k,373)*y(k,197) - mat(k,805) = .170_r8*rxt(k,457)*y(k,124) + .070_r8*rxt(k,456)*y(k,203) - mat(k,1704) = mat(k,1704) + rxt(k,356)*y(k,95) + rxt(k,357)*y(k,127) - mat(k,1066) = .500_r8*rxt(k,361)*y(k,197) - mat(k,623) = .400_r8*rxt(k,467)*y(k,124) - mat(k,1092) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & - + .250_r8*rxt(k,430)*y(k,196) + .100_r8*rxt(k,431)*y(k,197) - mat(k,639) = .540_r8*rxt(k,473)*y(k,124) - mat(k,394) = .510_r8*rxt(k,476)*y(k,124) - mat(k,446) = -(rxt(k,335)*y(k,221)) - mat(k,1646) = -rxt(k,335)*y(k,50) - mat(k,939) = .120_r8*rxt(k,348)*y(k,135) - mat(k,1741) = .120_r8*rxt(k,348)*y(k,29) - mat(k,1287) = .100_r8*rxt(k,332)*y(k,197) + .150_r8*rxt(k,333)*y(k,203) - mat(k,1367) = .100_r8*rxt(k,332)*y(k,196) - mat(k,2051) = .150_r8*rxt(k,333)*y(k,196) + .150_r8*rxt(k,383)*y(k,209) - mat(k,1267) = .150_r8*rxt(k,383)*y(k,203) - mat(k,406) = -(rxt(k,336)*y(k,221)) - mat(k,1642) = -rxt(k,336)*y(k,51) - mat(k,1286) = .400_r8*rxt(k,333)*y(k,203) - mat(k,2049) = .400_r8*rxt(k,333)*y(k,196) + .400_r8*rxt(k,383)*y(k,209) - mat(k,1266) = .400_r8*rxt(k,383)*y(k,203) - mat(k,708) = -(rxt(k,302)*y(k,221)) - mat(k,1669) = -rxt(k,302)*y(k,52) - mat(k,1118) = .200_r8*rxt(k,420)*y(k,197) - mat(k,839) = .300_r8*rxt(k,321)*y(k,197) - mat(k,1369) = .200_r8*rxt(k,420)*y(k,101) + .300_r8*rxt(k,321)*y(k,193) & - + 2.000_r8*rxt(k,299)*y(k,197) + .250_r8*rxt(k,406)*y(k,205) & - + .250_r8*rxt(k,411)*y(k,206) + .250_r8*rxt(k,373)*y(k,207) & - + .250_r8*rxt(k,485)*y(k,216) + .500_r8*rxt(k,361)*y(k,225) & - + .250_r8*rxt(k,490)*y(k,226) + .250_r8*rxt(k,495)*y(k,227) & - + .300_r8*rxt(k,431)*y(k,229) - mat(k,1162) = .250_r8*rxt(k,406)*y(k,197) - mat(k,1193) = .250_r8*rxt(k,411)*y(k,197) - mat(k,1223) = .250_r8*rxt(k,373)*y(k,197) - mat(k,1044) = .250_r8*rxt(k,485)*y(k,197) - mat(k,1063) = .500_r8*rxt(k,361)*y(k,197) - mat(k,1025) = .250_r8*rxt(k,490)*y(k,197) - mat(k,1003) = .250_r8*rxt(k,495)*y(k,197) - mat(k,1086) = .300_r8*rxt(k,431)*y(k,197) - mat(k,309) = -(rxt(k,303)*y(k,221)) - mat(k,1630) = -rxt(k,303)*y(k,53) - mat(k,1366) = rxt(k,300)*y(k,203) - mat(k,2036) = rxt(k,300)*y(k,197) - mat(k,1543) = -(rxt(k,214)*y(k,42) + rxt(k,216)*y(k,77) + rxt(k,217)*y(k,79) & - + (rxt(k,218) + rxt(k,219)) * y(k,203) + rxt(k,220)*y(k,135) & - + rxt(k,227)*y(k,60) + rxt(k,236)*y(k,92) + rxt(k,326)*y(k,28)) - mat(k,1844) = -rxt(k,214)*y(k,56) - mat(k,1107) = -rxt(k,216)*y(k,56) - mat(k,476) = -rxt(k,217)*y(k,56) - mat(k,2104) = -(rxt(k,218) + rxt(k,219)) * y(k,56) - mat(k,1779) = -rxt(k,220)*y(k,56) - mat(k,908) = -rxt(k,227)*y(k,56) - mat(k,764) = -rxt(k,236)*y(k,56) - mat(k,209) = -rxt(k,326)*y(k,56) - mat(k,2009) = rxt(k,255)*y(k,59) - mat(k,2131) = rxt(k,255)*y(k,19) + (4.000_r8*rxt(k,222)+2.000_r8*rxt(k,224)) & + mat(k,1172) = .270_r8*rxt(k,492)*y(k,124) + .150_r8*rxt(k,490)*y(k,199) + mat(k,1062) = .040_r8*rxt(k,497)*y(k,124) + .025_r8*rxt(k,495)*y(k,199) + mat(k,1279) = -(rxt(k,353)*y(k,126) + rxt(k,354)*y(k,226)) + mat(k,1890) = -rxt(k,353)*y(k,49) + mat(k,1783) = -rxt(k,354)*y(k,49) + mat(k,2182) = .070_r8*rxt(k,450)*y(k,200) + .070_r8*rxt(k,456)*y(k,214) + mat(k,1207) = rxt(k,356)*y(k,226) + mat(k,1268) = .880_r8*rxt(k,378)*y(k,135) + mat(k,1372) = .500_r8*rxt(k,392)*y(k,135) + mat(k,2055) = .170_r8*rxt(k,451)*y(k,200) + .050_r8*rxt(k,414)*y(k,207) & + + .250_r8*rxt(k,376)*y(k,211) + .170_r8*rxt(k,457)*y(k,214) & + + .400_r8*rxt(k,467)*y(k,233) + .250_r8*rxt(k,433)*y(k,235) & + + .540_r8*rxt(k,473)*y(k,236) + .510_r8*rxt(k,476)*y(k,238) + mat(k,1890) = mat(k,1890) + .050_r8*rxt(k,415)*y(k,207) + .250_r8*rxt(k,375) & + *y(k,211) + .250_r8*rxt(k,434)*y(k,235) + mat(k,872) = rxt(k,357)*y(k,226) + mat(k,2393) = .880_r8*rxt(k,378)*y(k,105) + .500_r8*rxt(k,392)*y(k,111) + mat(k,1420) = .250_r8*rxt(k,372)*y(k,211) + .250_r8*rxt(k,430)*y(k,235) + mat(k,2237) = .240_r8*rxt(k,373)*y(k,211) + .500_r8*rxt(k,361)*y(k,230) & + + .100_r8*rxt(k,431)*y(k,235) + mat(k,778) = .070_r8*rxt(k,450)*y(k,90) + .170_r8*rxt(k,451)*y(k,124) + mat(k,1329) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) + mat(k,1353) = .250_r8*rxt(k,376)*y(k,124) + .250_r8*rxt(k,375)*y(k,126) & + + .250_r8*rxt(k,372)*y(k,198) + .240_r8*rxt(k,373)*y(k,199) + mat(k,916) = .070_r8*rxt(k,456)*y(k,90) + .170_r8*rxt(k,457)*y(k,124) + mat(k,1783) = mat(k,1783) + rxt(k,356)*y(k,96) + rxt(k,357)*y(k,127) + mat(k,1216) = .500_r8*rxt(k,361)*y(k,199) + mat(k,754) = .400_r8*rxt(k,467)*y(k,124) + mat(k,1232) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,198) + .100_r8*rxt(k,431)*y(k,199) + mat(k,770) = .540_r8*rxt(k,473)*y(k,124) + mat(k,510) = .510_r8*rxt(k,476)*y(k,124) + mat(k,703) = -(rxt(k,334)*y(k,226)) + mat(k,1739) = -rxt(k,334)*y(k,50) + mat(k,1127) = .120_r8*rxt(k,347)*y(k,135) + mat(k,2149) = .150_r8*rxt(k,332)*y(k,198) + .150_r8*rxt(k,383)*y(k,213) + mat(k,2369) = .120_r8*rxt(k,347)*y(k,29) + mat(k,1411) = .150_r8*rxt(k,332)*y(k,90) + .100_r8*rxt(k,331)*y(k,199) + mat(k,2216) = .100_r8*rxt(k,331)*y(k,198) + mat(k,1392) = .150_r8*rxt(k,383)*y(k,90) + mat(k,618) = -(rxt(k,335)*y(k,226)) + mat(k,1731) = -rxt(k,335)*y(k,51) + mat(k,2143) = .400_r8*rxt(k,332)*y(k,198) + .400_r8*rxt(k,383)*y(k,213) + mat(k,1410) = .400_r8*rxt(k,332)*y(k,90) + mat(k,1391) = .400_r8*rxt(k,383)*y(k,90) + mat(k,811) = -(rxt(k,302)*y(k,226)) + mat(k,1748) = -rxt(k,302)*y(k,52) + mat(k,898) = .300_r8*rxt(k,320)*y(k,199) + mat(k,2217) = .300_r8*rxt(k,320)*y(k,195) + 2.000_r8*rxt(k,299)*y(k,199) & + + .250_r8*rxt(k,406)*y(k,206) + .250_r8*rxt(k,411)*y(k,207) & + + .200_r8*rxt(k,420)*y(k,208) + .250_r8*rxt(k,373)*y(k,211) & + + .250_r8*rxt(k,485)*y(k,221) + .500_r8*rxt(k,361)*y(k,230) & + + .250_r8*rxt(k,490)*y(k,231) + .250_r8*rxt(k,495)*y(k,232) & + + .300_r8*rxt(k,431)*y(k,235) + mat(k,1289) = .250_r8*rxt(k,406)*y(k,199) + mat(k,1318) = .250_r8*rxt(k,411)*y(k,199) + mat(k,1245) = .200_r8*rxt(k,420)*y(k,199) + mat(k,1347) = .250_r8*rxt(k,373)*y(k,199) + mat(k,1086) = .250_r8*rxt(k,485)*y(k,199) + mat(k,1213) = .500_r8*rxt(k,361)*y(k,199) + mat(k,1171) = .250_r8*rxt(k,490)*y(k,199) + mat(k,1059) = .250_r8*rxt(k,495)*y(k,199) + mat(k,1226) = .300_r8*rxt(k,431)*y(k,199) + mat(k,389) = -(rxt(k,303)*y(k,226)) + mat(k,1702) = -rxt(k,303)*y(k,53) + mat(k,2123) = rxt(k,300)*y(k,199) + mat(k,2214) = rxt(k,300)*y(k,90) + mat(k,2283) = -(rxt(k,215)*y(k,56) + rxt(k,271)*y(k,73) + rxt(k,304)*y(k,226) & + + (rxt(k,310) + rxt(k,311) + rxt(k,312)) * y(k,222)) + mat(k,1959) = -rxt(k,215)*y(k,54) + mat(k,930) = -rxt(k,271)*y(k,54) + mat(k,1808) = -rxt(k,304)*y(k,54) + mat(k,1643) = -(rxt(k,310) + rxt(k,311) + rxt(k,312)) * y(k,54) + mat(k,1145) = .100_r8*rxt(k,347)*y(k,135) + mat(k,2416) = .100_r8*rxt(k,347)*y(k,29) + mat(k,445) = -(rxt(k,267)*y(k,222) + rxt(k,284)*y(k,56) + rxt(k,285)*y(k,226)) + mat(k,1622) = -rxt(k,267)*y(k,55) + mat(k,1923) = -rxt(k,284)*y(k,55) + mat(k,1710) = -rxt(k,285)*y(k,55) + mat(k,1953) = -(rxt(k,214)*y(k,42) + rxt(k,215)*y(k,54) + rxt(k,216)*y(k,77) & + + rxt(k,217)*y(k,79) + (rxt(k,218) + rxt(k,219)) * y(k,90) & + + rxt(k,220)*y(k,135) + rxt(k,227)*y(k,60) + rxt(k,236)*y(k,93) & + + rxt(k,277)*y(k,41) + rxt(k,279)*y(k,43) + rxt(k,282)*y(k,46) & + + rxt(k,284)*y(k,55) + rxt(k,325)*y(k,28) + rxt(k,355)*y(k,31)) + mat(k,2346) = -rxt(k,214)*y(k,56) + mat(k,2277) = -rxt(k,215)*y(k,56) + mat(k,1464) = -rxt(k,216)*y(k,56) + mat(k,614) = -rxt(k,217)*y(k,56) + mat(k,2200) = -(rxt(k,218) + rxt(k,219)) * y(k,56) + mat(k,2410) = -rxt(k,220)*y(k,56) + mat(k,959) = -rxt(k,227)*y(k,56) + mat(k,839) = -rxt(k,236)*y(k,56) + mat(k,475) = -rxt(k,277)*y(k,56) + mat(k,607) = -rxt(k,279)*y(k,56) + mat(k,373) = -rxt(k,282)*y(k,56) + mat(k,450) = -rxt(k,284)*y(k,56) + mat(k,300) = -rxt(k,325)*y(k,56) + mat(k,306) = -rxt(k,355)*y(k,56) + mat(k,1569) = rxt(k,255)*y(k,59) + mat(k,101) = 4.000_r8*rxt(k,239)*y(k,222) + mat(k,141) = rxt(k,240)*y(k,222) + mat(k,112) = 2.000_r8*rxt(k,241)*y(k,222) + mat(k,151) = 2.000_r8*rxt(k,242)*y(k,222) + mat(k,116) = 2.000_r8*rxt(k,243)*y(k,222) + mat(k,156) = rxt(k,244)*y(k,222) + mat(k,120) = 2.000_r8*rxt(k,245)*y(k,222) + mat(k,123) = 3.000_r8*rxt(k,281)*y(k,226) + mat(k,373) = mat(k,373) + rxt(k,283)*y(k,226) + mat(k,1595) = rxt(k,255)*y(k,19) + (4.000_r8*rxt(k,222)+2.000_r8*rxt(k,224)) & *y(k,59) + rxt(k,226)*y(k,124) + rxt(k,231)*y(k,133) & - + rxt(k,509)*y(k,151) + rxt(k,221)*y(k,197) + rxt(k,232) & - *y(k,221) - mat(k,103) = rxt(k,276)*y(k,217) - mat(k,1339) = rxt(k,234)*y(k,133) + rxt(k,246)*y(k,217) + rxt(k,235)*y(k,221) - mat(k,1508) = rxt(k,226)*y(k,59) - mat(k,1820) = rxt(k,231)*y(k,59) + rxt(k,234)*y(k,85) - mat(k,1322) = rxt(k,509)*y(k,59) - mat(k,1399) = rxt(k,221)*y(k,59) - mat(k,1569) = rxt(k,276)*y(k,65) + rxt(k,246)*y(k,85) - mat(k,1717) = rxt(k,232)*y(k,59) + rxt(k,235)*y(k,85) - mat(k,1522) = rxt(k,227)*y(k,60) - mat(k,2119) = 2.000_r8*rxt(k,223)*y(k,59) - mat(k,904) = rxt(k,227)*y(k,56) + (rxt(k,554)+rxt(k,559)+rxt(k,564))*y(k,85) - mat(k,1332) = (rxt(k,554)+rxt(k,559)+rxt(k,564))*y(k,60) + (rxt(k,549) & - +rxt(k,555)+rxt(k,560))*y(k,92) - mat(k,761) = (rxt(k,549)+rxt(k,555)+rxt(k,560))*y(k,85) - mat(k,2118) = 2.000_r8*rxt(k,248)*y(k,59) - mat(k,2143) = -(rxt(k,221)*y(k,197) + (4._r8*rxt(k,222) + 4._r8*rxt(k,223) & + + rxt(k,510)*y(k,151) + rxt(k,221)*y(k,199) + rxt(k,232) & + *y(k,226) + mat(k,227) = rxt(k,276)*y(k,222) + mat(k,223) = rxt(k,291)*y(k,222) + rxt(k,286)*y(k,226) + mat(k,253) = rxt(k,292)*y(k,222) + rxt(k,287)*y(k,226) + mat(k,276) = rxt(k,293)*y(k,222) + rxt(k,288)*y(k,226) + mat(k,1501) = rxt(k,234)*y(k,133) + rxt(k,246)*y(k,222) + rxt(k,235)*y(k,226) + mat(k,2071) = rxt(k,226)*y(k,59) + mat(k,2320) = rxt(k,231)*y(k,59) + rxt(k,234)*y(k,85) + mat(k,1481) = rxt(k,510)*y(k,59) + mat(k,2252) = rxt(k,221)*y(k,59) + mat(k,1637) = 4.000_r8*rxt(k,239)*y(k,33) + rxt(k,240)*y(k,34) & + + 2.000_r8*rxt(k,241)*y(k,36) + 2.000_r8*rxt(k,242)*y(k,37) & + + 2.000_r8*rxt(k,243)*y(k,38) + rxt(k,244)*y(k,39) & + + 2.000_r8*rxt(k,245)*y(k,40) + rxt(k,276)*y(k,65) + rxt(k,291) & + *y(k,82) + rxt(k,292)*y(k,83) + rxt(k,293)*y(k,84) + rxt(k,246) & + *y(k,85) + mat(k,1802) = 3.000_r8*rxt(k,281)*y(k,44) + rxt(k,283)*y(k,46) + rxt(k,232) & + *y(k,59) + rxt(k,286)*y(k,82) + rxt(k,287)*y(k,83) + rxt(k,288) & + *y(k,84) + rxt(k,235)*y(k,85) + mat(k,1918) = rxt(k,227)*y(k,60) + mat(k,1579) = 2.000_r8*rxt(k,223)*y(k,59) + mat(k,951) = rxt(k,227)*y(k,56) + (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,85) + mat(k,1488) = (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,60) + (rxt(k,563) & + +rxt(k,569)+rxt(k,574))*y(k,93) + mat(k,834) = (rxt(k,563)+rxt(k,569)+rxt(k,574))*y(k,85) + mat(k,1578) = 2.000_r8*rxt(k,248)*y(k,59) + mat(k,1590) = -(rxt(k,221)*y(k,199) + (4._r8*rxt(k,222) + 4._r8*rxt(k,223) & + 4._r8*rxt(k,224) + 4._r8*rxt(k,248)) * y(k,59) + rxt(k,225) & - *y(k,203) + rxt(k,226)*y(k,124) + rxt(k,228)*y(k,125) + rxt(k,231) & - *y(k,133) + (rxt(k,232) + rxt(k,233)) * y(k,221) + (rxt(k,254) & - + rxt(k,255) + rxt(k,256)) * y(k,19) + rxt(k,509)*y(k,151)) - mat(k,1408) = -rxt(k,221)*y(k,59) - mat(k,2116) = -rxt(k,225)*y(k,59) - mat(k,1520) = -rxt(k,226)*y(k,59) - mat(k,1997) = -rxt(k,228)*y(k,59) - mat(k,1832) = -rxt(k,231)*y(k,59) - mat(k,1729) = -(rxt(k,232) + rxt(k,233)) * y(k,59) - mat(k,2021) = -(rxt(k,254) + rxt(k,255) + rxt(k,256)) * y(k,59) - mat(k,1330) = -rxt(k,509)*y(k,59) - mat(k,1555) = rxt(k,236)*y(k,92) + rxt(k,220)*y(k,135) + rxt(k,219)*y(k,203) - mat(k,914) = rxt(k,229)*y(k,133) - mat(k,1348) = rxt(k,247)*y(k,217) - mat(k,767) = rxt(k,236)*y(k,56) + rxt(k,237)*y(k,133) + rxt(k,238)*y(k,221) - mat(k,1832) = mat(k,1832) + rxt(k,229)*y(k,60) + rxt(k,237)*y(k,92) - mat(k,1791) = rxt(k,220)*y(k,56) - mat(k,234) = rxt(k,514)*y(k,151) - mat(k,1330) = mat(k,1330) + rxt(k,514)*y(k,137) - mat(k,2116) = mat(k,2116) + rxt(k,219)*y(k,56) - mat(k,1581) = rxt(k,247)*y(k,85) - mat(k,1729) = mat(k,1729) + rxt(k,238)*y(k,92) - mat(k,906) = -(rxt(k,227)*y(k,56) + rxt(k,229)*y(k,133) + rxt(k,230)*y(k,221) & - + (rxt(k,554) + rxt(k,559) + rxt(k,564)) * y(k,85)) - mat(k,1532) = -rxt(k,227)*y(k,60) - mat(k,1811) = -rxt(k,229)*y(k,60) - mat(k,1686) = -rxt(k,230)*y(k,60) - mat(k,1336) = -(rxt(k,554) + rxt(k,559) + rxt(k,564)) * y(k,60) - mat(k,2124) = rxt(k,228)*y(k,125) - mat(k,1973) = rxt(k,228)*y(k,59) - mat(k,997) = -((rxt(k,305) + rxt(k,315)) * y(k,221)) - mat(k,1694) = -(rxt(k,305) + rxt(k,315)) * y(k,62) - mat(k,863) = .230_r8*rxt(k,480)*y(k,135) - mat(k,1351) = rxt(k,250)*y(k,42) - mat(k,203) = .350_r8*rxt(k,317)*y(k,221) - mat(k,453) = .630_r8*rxt(k,319)*y(k,135) - mat(k,945) = .560_r8*rxt(k,348)*y(k,135) - mat(k,1837) = rxt(k,250)*y(k,17) + rxt(k,214)*y(k,56) + rxt(k,295)*y(k,126) & - + rxt(k,296)*y(k,133) + rxt(k,297)*y(k,221) - mat(k,1151) = rxt(k,354)*y(k,126) + rxt(k,355)*y(k,221) - mat(k,1534) = rxt(k,214)*y(k,42) - mat(k,799) = rxt(k,342)*y(k,221) - mat(k,783) = .620_r8*rxt(k,425)*y(k,135) - mat(k,1139) = .650_r8*rxt(k,378)*y(k,135) - mat(k,825) = .230_r8*rxt(k,483)*y(k,135) - mat(k,1247) = .560_r8*rxt(k,392)*y(k,135) - mat(k,1488) = .170_r8*rxt(k,451)*y(k,198) + .220_r8*rxt(k,376)*y(k,207) & - + .400_r8*rxt(k,454)*y(k,208) + .350_r8*rxt(k,457)*y(k,210) & - + .225_r8*rxt(k,492)*y(k,226) + .250_r8*rxt(k,433)*y(k,229) - mat(k,1880) = rxt(k,295)*y(k,42) + rxt(k,354)*y(k,49) + .220_r8*rxt(k,375) & - *y(k,207) + .500_r8*rxt(k,434)*y(k,229) - mat(k,1812) = rxt(k,296)*y(k,42) + rxt(k,504)*y(k,138) - mat(k,1759) = .230_r8*rxt(k,480)*y(k,6) + .630_r8*rxt(k,319)*y(k,25) & - + .560_r8*rxt(k,348)*y(k,29) + .620_r8*rxt(k,425)*y(k,98) & - + .650_r8*rxt(k,378)*y(k,105) + .230_r8*rxt(k,483)*y(k,110) & - + .560_r8*rxt(k,392)*y(k,111) - mat(k,254) = rxt(k,504)*y(k,133) + rxt(k,505)*y(k,221) - mat(k,983) = .700_r8*rxt(k,501)*y(k,221) - mat(k,1292) = .220_r8*rxt(k,372)*y(k,207) + .250_r8*rxt(k,430)*y(k,229) - mat(k,1380) = .110_r8*rxt(k,373)*y(k,207) + .125_r8*rxt(k,490)*y(k,226) & - + .200_r8*rxt(k,431)*y(k,229) - mat(k,646) = .170_r8*rxt(k,451)*y(k,124) + .070_r8*rxt(k,450)*y(k,203) - mat(k,2082) = .070_r8*rxt(k,450)*y(k,198) + .160_r8*rxt(k,453)*y(k,208) & - + .140_r8*rxt(k,456)*y(k,210) - mat(k,1227) = .220_r8*rxt(k,376)*y(k,124) + .220_r8*rxt(k,375)*y(k,126) & - + .220_r8*rxt(k,372)*y(k,196) + .110_r8*rxt(k,373)*y(k,197) - mat(k,609) = .400_r8*rxt(k,454)*y(k,124) + .160_r8*rxt(k,453)*y(k,203) - mat(k,804) = .350_r8*rxt(k,457)*y(k,124) + .140_r8*rxt(k,456)*y(k,203) - mat(k,1694) = mat(k,1694) + .350_r8*rxt(k,317)*y(k,24) + rxt(k,297)*y(k,42) & - + rxt(k,355)*y(k,49) + rxt(k,342)*y(k,75) + rxt(k,505)*y(k,138) & - + .700_r8*rxt(k,501)*y(k,179) - mat(k,1029) = .225_r8*rxt(k,492)*y(k,124) + .125_r8*rxt(k,490)*y(k,197) - mat(k,1090) = .250_r8*rxt(k,433)*y(k,124) + .500_r8*rxt(k,434)*y(k,126) & - + .250_r8*rxt(k,430)*y(k,196) + .200_r8*rxt(k,431)*y(k,197) + *y(k,90) + rxt(k,226)*y(k,124) + rxt(k,228)*y(k,125) + rxt(k,231) & + *y(k,133) + (rxt(k,232) + rxt(k,233)) * y(k,226) + (rxt(k,254) & + + rxt(k,255) + rxt(k,256)) * y(k,19) + rxt(k,510)*y(k,151)) + mat(k,2247) = -rxt(k,221)*y(k,59) + mat(k,2195) = -rxt(k,225)*y(k,59) + mat(k,2066) = -rxt(k,226)*y(k,59) + mat(k,1842) = -rxt(k,228)*y(k,59) + mat(k,2315) = -rxt(k,231)*y(k,59) + mat(k,1797) = -(rxt(k,232) + rxt(k,233)) * y(k,59) + mat(k,1564) = -(rxt(k,254) + rxt(k,255) + rxt(k,256)) * y(k,59) + mat(k,1478) = -rxt(k,510)*y(k,59) + mat(k,1948) = rxt(k,219)*y(k,90) + rxt(k,236)*y(k,93) + rxt(k,220)*y(k,135) + mat(k,955) = rxt(k,229)*y(k,133) + mat(k,1496) = rxt(k,247)*y(k,222) + mat(k,2195) = mat(k,2195) + rxt(k,219)*y(k,56) + mat(k,837) = rxt(k,236)*y(k,56) + rxt(k,237)*y(k,133) + rxt(k,238)*y(k,226) + mat(k,2315) = mat(k,2315) + rxt(k,229)*y(k,60) + rxt(k,237)*y(k,93) + mat(k,2405) = rxt(k,220)*y(k,56) + mat(k,335) = rxt(k,515)*y(k,151) + mat(k,1478) = mat(k,1478) + rxt(k,515)*y(k,137) + mat(k,1632) = rxt(k,247)*y(k,85) + mat(k,1797) = mat(k,1797) + rxt(k,238)*y(k,93) end do end subroutine nlnmat02 subroutine nlnmat03( avec_len, mat, y, rxt ) @@ -489,210 +520,529 @@ subroutine nlnmat03( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,59) = -(rxt(k,275)*y(k,217)) - mat(k,1557) = -rxt(k,275)*y(k,64) - mat(k,101) = -(rxt(k,276)*y(k,217)) - mat(k,1559) = -rxt(k,276)*y(k,65) - mat(k,121) = -(rxt(k,449)*y(k,221)) - mat(k,1601) = -rxt(k,449)*y(k,66) - mat(k,115) = .180_r8*rxt(k,469)*y(k,221) - mat(k,1601) = mat(k,1601) + .180_r8*rxt(k,469)*y(k,181) - mat(k,191) = -(rxt(k,502)*y(k,126) + (rxt(k,503) + rxt(k,516)) * y(k,221)) + mat(k,953) = -(rxt(k,227)*y(k,56) + rxt(k,229)*y(k,133) + rxt(k,230)*y(k,226) & + + (rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,85)) + mat(k,1933) = -rxt(k,227)*y(k,60) + mat(k,2305) = -rxt(k,229)*y(k,60) + mat(k,1760) = -rxt(k,230)*y(k,60) + mat(k,1492) = -(rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,60) + mat(k,1584) = rxt(k,228)*y(k,125) + mat(k,1828) = rxt(k,228)*y(k,59) + mat(k,1158) = -(rxt(k,314)*y(k,226)) + mat(k,1774) = -rxt(k,314)*y(k,62) + mat(k,996) = .230_r8*rxt(k,480)*y(k,135) + mat(k,1507) = rxt(k,250)*y(k,42) + mat(k,293) = .350_r8*rxt(k,316)*y(k,226) + mat(k,551) = .630_r8*rxt(k,318)*y(k,135) + mat(k,1133) = .560_r8*rxt(k,347)*y(k,135) + mat(k,2334) = rxt(k,250)*y(k,17) + rxt(k,214)*y(k,56) + rxt(k,295)*y(k,126) & + + rxt(k,296)*y(k,133) + rxt(k,297)*y(k,226) + mat(k,370) = rxt(k,282)*y(k,56) + mat(k,1278) = rxt(k,353)*y(k,126) + rxt(k,354)*y(k,226) + mat(k,1937) = rxt(k,214)*y(k,42) + rxt(k,282)*y(k,46) + mat(k,1447) = rxt(k,591)*y(k,227) + mat(k,1053) = rxt(k,341)*y(k,226) + mat(k,2174) = .070_r8*rxt(k,450)*y(k,200) + .160_r8*rxt(k,453)*y(k,212) & + + .140_r8*rxt(k,456)*y(k,214) + mat(k,883) = .620_r8*rxt(k,425)*y(k,135) + mat(k,1266) = .650_r8*rxt(k,378)*y(k,135) + mat(k,1024) = .230_r8*rxt(k,483)*y(k,135) + mat(k,1370) = .560_r8*rxt(k,392)*y(k,135) + mat(k,2046) = .170_r8*rxt(k,451)*y(k,200) + .220_r8*rxt(k,376)*y(k,211) & + + .400_r8*rxt(k,454)*y(k,212) + .350_r8*rxt(k,457)*y(k,214) & + + .225_r8*rxt(k,492)*y(k,231) + .250_r8*rxt(k,433)*y(k,235) + mat(k,1881) = rxt(k,295)*y(k,42) + rxt(k,353)*y(k,49) + .220_r8*rxt(k,375) & + *y(k,211) + .500_r8*rxt(k,434)*y(k,235) + mat(k,2307) = rxt(k,296)*y(k,42) + rxt(k,504)*y(k,138) + mat(k,2386) = .230_r8*rxt(k,480)*y(k,6) + .630_r8*rxt(k,318)*y(k,25) & + + .560_r8*rxt(k,347)*y(k,29) + .620_r8*rxt(k,425)*y(k,99) & + + .650_r8*rxt(k,378)*y(k,105) + .230_r8*rxt(k,483)*y(k,110) & + + .560_r8*rxt(k,392)*y(k,111) + mat(k,364) = rxt(k,504)*y(k,133) + rxt(k,505)*y(k,226) + mat(k,1102) = .700_r8*rxt(k,501)*y(k,226) + mat(k,1414) = .220_r8*rxt(k,372)*y(k,211) + .250_r8*rxt(k,430)*y(k,235) + mat(k,2229) = .110_r8*rxt(k,373)*y(k,211) + .125_r8*rxt(k,490)*y(k,231) & + + .200_r8*rxt(k,431)*y(k,235) + mat(k,777) = .070_r8*rxt(k,450)*y(k,90) + .170_r8*rxt(k,451)*y(k,124) + mat(k,1348) = .220_r8*rxt(k,376)*y(k,124) + .220_r8*rxt(k,375)*y(k,126) & + + .220_r8*rxt(k,372)*y(k,198) + .110_r8*rxt(k,373)*y(k,199) + mat(k,740) = .160_r8*rxt(k,453)*y(k,90) + .400_r8*rxt(k,454)*y(k,124) + mat(k,915) = .140_r8*rxt(k,456)*y(k,90) + .350_r8*rxt(k,457)*y(k,124) + mat(k,1774) = mat(k,1774) + .350_r8*rxt(k,316)*y(k,24) + rxt(k,297)*y(k,42) & + + rxt(k,354)*y(k,49) + rxt(k,341)*y(k,75) + rxt(k,505)*y(k,138) & + + .700_r8*rxt(k,501)*y(k,179) + mat(k,807) = rxt(k,591)*y(k,63) + mat(k,1174) = .225_r8*rxt(k,492)*y(k,124) + .125_r8*rxt(k,490)*y(k,199) + mat(k,1228) = .250_r8*rxt(k,433)*y(k,124) + .500_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,198) + .200_r8*rxt(k,431)*y(k,199) + mat(k,1448) = -(rxt(k,591)*y(k,227)) + mat(k,808) = -rxt(k,591)*y(k,63) + mat(k,1000) = .270_r8*rxt(k,480)*y(k,135) + mat(k,1137) = .200_r8*rxt(k,347)*y(k,135) + mat(k,704) = rxt(k,334)*y(k,226) + mat(k,620) = .500_r8*rxt(k,335)*y(k,226) + mat(k,1159) = rxt(k,314)*y(k,226) + mat(k,1165) = .800_r8*rxt(k,340)*y(k,226) + mat(k,1054) = rxt(k,341)*y(k,226) + mat(k,909) = rxt(k,306)*y(k,226) + mat(k,2189) = .450_r8*rxt(k,383)*y(k,213) + mat(k,583) = .500_r8*rxt(k,391)*y(k,226) + mat(k,1028) = .270_r8*rxt(k,483)*y(k,135) + mat(k,1377) = .100_r8*rxt(k,392)*y(k,135) + mat(k,2062) = rxt(k,333)*y(k,198) + .900_r8*rxt(k,492)*y(k,231) + mat(k,2400) = .270_r8*rxt(k,480)*y(k,6) + .200_r8*rxt(k,347)*y(k,29) & + + .270_r8*rxt(k,483)*y(k,110) + .100_r8*rxt(k,392)*y(k,111) + mat(k,1105) = 1.800_r8*rxt(k,501)*y(k,226) + mat(k,1427) = rxt(k,333)*y(k,124) + 4.000_r8*rxt(k,330)*y(k,198) & + + .900_r8*rxt(k,331)*y(k,199) + rxt(k,405)*y(k,206) & + + 2.000_r8*rxt(k,381)*y(k,213) + rxt(k,430)*y(k,235) + mat(k,2244) = .900_r8*rxt(k,331)*y(k,198) + rxt(k,382)*y(k,213) & + + .500_r8*rxt(k,490)*y(k,231) + mat(k,1302) = rxt(k,405)*y(k,198) + mat(k,1397) = .450_r8*rxt(k,383)*y(k,90) + 2.000_r8*rxt(k,381)*y(k,198) & + + rxt(k,382)*y(k,199) + 4.000_r8*rxt(k,384)*y(k,213) + mat(k,1790) = rxt(k,334)*y(k,50) + .500_r8*rxt(k,335)*y(k,51) + rxt(k,314) & + *y(k,62) + .800_r8*rxt(k,340)*y(k,74) + rxt(k,341)*y(k,75) & + + rxt(k,306)*y(k,87) + .500_r8*rxt(k,391)*y(k,109) & + + 1.800_r8*rxt(k,501)*y(k,179) + mat(k,1179) = .900_r8*rxt(k,492)*y(k,124) + .500_r8*rxt(k,490)*y(k,199) + mat(k,1234) = rxt(k,430)*y(k,198) + mat(k,242) = -(rxt(k,275)*y(k,222)) + mat(k,1618) = -rxt(k,275)*y(k,64) + mat(k,138) = rxt(k,240)*y(k,222) + mat(k,143) = rxt(k,266)*y(k,222) + mat(k,149) = rxt(k,242)*y(k,222) + mat(k,114) = 2.000_r8*rxt(k,243)*y(k,222) + mat(k,153) = 2.000_r8*rxt(k,244)*y(k,222) + mat(k,118) = rxt(k,245)*y(k,222) + mat(k,106) = 2.000_r8*rxt(k,268)*y(k,222) + mat(k,248) = rxt(k,292)*y(k,222) + rxt(k,287)*y(k,226) + mat(k,271) = rxt(k,293)*y(k,222) + rxt(k,288)*y(k,226) + mat(k,1618) = mat(k,1618) + rxt(k,240)*y(k,34) + rxt(k,266)*y(k,35) & + + rxt(k,242)*y(k,37) + 2.000_r8*rxt(k,243)*y(k,38) & + + 2.000_r8*rxt(k,244)*y(k,39) + rxt(k,245)*y(k,40) & + + 2.000_r8*rxt(k,268)*y(k,78) + rxt(k,292)*y(k,83) + rxt(k,293) & + *y(k,84) + mat(k,1681) = rxt(k,287)*y(k,83) + rxt(k,288)*y(k,84) + mat(k,224) = -(rxt(k,276)*y(k,222)) + mat(k,1617) = -rxt(k,276)*y(k,65) + mat(k,110) = rxt(k,241)*y(k,222) + mat(k,148) = rxt(k,242)*y(k,222) + mat(k,220) = rxt(k,291)*y(k,222) + rxt(k,286)*y(k,226) + mat(k,1617) = mat(k,1617) + rxt(k,241)*y(k,36) + rxt(k,242)*y(k,37) & + + rxt(k,291)*y(k,82) + mat(k,1677) = rxt(k,286)*y(k,82) + mat(k,192) = -(rxt(k,449)*y(k,226)) + mat(k,1671) = -rxt(k,449)*y(k,66) + mat(k,186) = .180_r8*rxt(k,469)*y(k,226) + mat(k,1671) = mat(k,1671) + .180_r8*rxt(k,469)*y(k,181) + mat(k,308) = -(rxt(k,502)*y(k,126) + (rxt(k,503) + rxt(k,517)) * y(k,226)) mat(k,1861) = -rxt(k,502)*y(k,67) - mat(k,1613) = -(rxt(k,503) + rxt(k,516)) * y(k,67) - mat(k,662) = rxt(k,337)*y(k,203) - mat(k,2023) = rxt(k,337)*y(k,202) - mat(k,673) = -(rxt(k,272)*y(k,77) + rxt(k,273)*y(k,232) + rxt(k,274)*y(k,89)) - mat(k,1103) = -rxt(k,272)*y(k,73) - mat(k,2148) = -rxt(k,273)*y(k,73) - mat(k,1936) = -rxt(k,274)*y(k,73) - mat(k,60) = 2.000_r8*rxt(k,275)*y(k,217) - mat(k,102) = rxt(k,276)*y(k,217) - mat(k,1561) = 2.000_r8*rxt(k,275)*y(k,64) + rxt(k,276)*y(k,65) - mat(k,960) = -(rxt(k,341)*y(k,221)) - mat(k,1690) = -rxt(k,341)*y(k,74) - mat(k,506) = .700_r8*rxt(k,416)*y(k,221) - mat(k,424) = .500_r8*rxt(k,417)*y(k,221) - mat(k,269) = rxt(k,428)*y(k,221) - mat(k,1484) = .050_r8*rxt(k,414)*y(k,206) + .530_r8*rxt(k,376)*y(k,207) & - + .225_r8*rxt(k,492)*y(k,226) + .250_r8*rxt(k,433)*y(k,229) - mat(k,1876) = .050_r8*rxt(k,415)*y(k,206) + .530_r8*rxt(k,375)*y(k,207) & - + .250_r8*rxt(k,434)*y(k,229) - mat(k,1423) = rxt(k,340)*y(k,201) - mat(k,1290) = .530_r8*rxt(k,372)*y(k,207) + .250_r8*rxt(k,430)*y(k,229) - mat(k,1377) = .260_r8*rxt(k,373)*y(k,207) + .125_r8*rxt(k,490)*y(k,226) & - + .100_r8*rxt(k,431)*y(k,229) - mat(k,346) = rxt(k,340)*y(k,134) - mat(k,1197) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) - mat(k,1224) = .530_r8*rxt(k,376)*y(k,124) + .530_r8*rxt(k,375)*y(k,126) & - + .530_r8*rxt(k,372)*y(k,196) + .260_r8*rxt(k,373)*y(k,197) - mat(k,1690) = mat(k,1690) + .700_r8*rxt(k,416)*y(k,99) + .500_r8*rxt(k,417) & - *y(k,100) + rxt(k,428)*y(k,115) - mat(k,1027) = .225_r8*rxt(k,492)*y(k,124) + .125_r8*rxt(k,490)*y(k,197) - mat(k,1088) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & - + .250_r8*rxt(k,430)*y(k,196) + .100_r8*rxt(k,431)*y(k,197) - mat(k,798) = -(rxt(k,342)*y(k,221)) - mat(k,1678) = -rxt(k,342)*y(k,75) - mat(k,202) = .650_r8*rxt(k,317)*y(k,221) - mat(k,959) = .200_r8*rxt(k,341)*y(k,221) - mat(k,926) = rxt(k,429)*y(k,221) - mat(k,1477) = rxt(k,440)*y(k,191) + .050_r8*rxt(k,414)*y(k,206) & - + .400_r8*rxt(k,454)*y(k,208) + .170_r8*rxt(k,457)*y(k,210) & - + .700_r8*rxt(k,460)*y(k,223) + .600_r8*rxt(k,467)*y(k,228) & - + .250_r8*rxt(k,433)*y(k,229) + .340_r8*rxt(k,473)*y(k,230) & - + .170_r8*rxt(k,476)*y(k,231) - mat(k,1867) = .050_r8*rxt(k,415)*y(k,206) + .250_r8*rxt(k,434)*y(k,229) - mat(k,379) = rxt(k,440)*y(k,124) - mat(k,1288) = .250_r8*rxt(k,430)*y(k,229) - mat(k,1372) = .100_r8*rxt(k,431)*y(k,229) - mat(k,2073) = .160_r8*rxt(k,453)*y(k,208) + .070_r8*rxt(k,456)*y(k,210) - mat(k,1195) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) - mat(k,608) = .400_r8*rxt(k,454)*y(k,124) + .160_r8*rxt(k,453)*y(k,203) - mat(k,802) = .170_r8*rxt(k,457)*y(k,124) + .070_r8*rxt(k,456)*y(k,203) - mat(k,1678) = mat(k,1678) + .650_r8*rxt(k,317)*y(k,24) + .200_r8*rxt(k,341) & + mat(k,1691) = -(rxt(k,503) + rxt(k,517)) * y(k,67) + mat(k,2115) = rxt(k,336)*y(k,204) + mat(k,793) = rxt(k,336)*y(k,90) + mat(k,923) = -(rxt(k,271)*y(k,54) + rxt(k,272)*y(k,77) + rxt(k,273)*y(k,239) & + + rxt(k,274)*y(k,89)) + mat(k,2264) = -rxt(k,271)*y(k,73) + mat(k,1458) = -rxt(k,272)*y(k,73) + mat(k,2424) = -rxt(k,273)*y(k,73) + mat(k,1965) = -rxt(k,274)*y(k,73) + mat(k,144) = rxt(k,266)*y(k,222) + mat(k,154) = rxt(k,244)*y(k,222) + mat(k,243) = 2.000_r8*rxt(k,275)*y(k,222) + mat(k,225) = rxt(k,276)*y(k,222) + mat(k,1626) = rxt(k,266)*y(k,35) + rxt(k,244)*y(k,39) + 2.000_r8*rxt(k,275) & + *y(k,64) + rxt(k,276)*y(k,65) + mat(k,1164) = -(rxt(k,340)*y(k,226)) + mat(k,1775) = -rxt(k,340)*y(k,74) + mat(k,590) = .700_r8*rxt(k,416)*y(k,226) + mat(k,558) = .500_r8*rxt(k,417)*y(k,226) + mat(k,379) = rxt(k,428)*y(k,226) + mat(k,2047) = .050_r8*rxt(k,414)*y(k,207) + .530_r8*rxt(k,376)*y(k,211) & + + .225_r8*rxt(k,492)*y(k,231) + .250_r8*rxt(k,433)*y(k,235) + mat(k,1882) = .050_r8*rxt(k,415)*y(k,207) + .530_r8*rxt(k,375)*y(k,211) & + + .250_r8*rxt(k,434)*y(k,235) + mat(k,1536) = rxt(k,339)*y(k,203) + mat(k,1415) = .530_r8*rxt(k,372)*y(k,211) + .250_r8*rxt(k,430)*y(k,235) + mat(k,2230) = .260_r8*rxt(k,373)*y(k,211) + .125_r8*rxt(k,490)*y(k,231) & + + .100_r8*rxt(k,431)*y(k,235) + mat(k,462) = rxt(k,339)*y(k,134) + mat(k,1323) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) + mat(k,1349) = .530_r8*rxt(k,376)*y(k,124) + .530_r8*rxt(k,375)*y(k,126) & + + .530_r8*rxt(k,372)*y(k,198) + .260_r8*rxt(k,373)*y(k,199) + mat(k,1775) = mat(k,1775) + .700_r8*rxt(k,416)*y(k,100) + .500_r8*rxt(k,417) & + *y(k,101) + rxt(k,428)*y(k,115) + mat(k,1175) = .225_r8*rxt(k,492)*y(k,124) + .125_r8*rxt(k,490)*y(k,199) + mat(k,1229) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,198) + .100_r8*rxt(k,431)*y(k,199) + mat(k,1052) = -(rxt(k,341)*y(k,226)) + mat(k,1765) = -rxt(k,341)*y(k,75) + mat(k,292) = .650_r8*rxt(k,316)*y(k,226) + mat(k,1162) = .200_r8*rxt(k,340)*y(k,226) + mat(k,2167) = .160_r8*rxt(k,453)*y(k,212) + .070_r8*rxt(k,456)*y(k,214) + mat(k,1114) = rxt(k,429)*y(k,226) + mat(k,2038) = rxt(k,440)*y(k,192) + .050_r8*rxt(k,414)*y(k,207) & + + .400_r8*rxt(k,454)*y(k,212) + .170_r8*rxt(k,457)*y(k,214) & + + .700_r8*rxt(k,460)*y(k,228) + .600_r8*rxt(k,467)*y(k,233) & + + .250_r8*rxt(k,433)*y(k,235) + .340_r8*rxt(k,473)*y(k,236) & + + .170_r8*rxt(k,476)*y(k,238) + mat(k,1872) = .050_r8*rxt(k,415)*y(k,207) + .250_r8*rxt(k,434)*y(k,235) + mat(k,488) = rxt(k,440)*y(k,124) + mat(k,1412) = .250_r8*rxt(k,430)*y(k,235) + mat(k,2221) = .100_r8*rxt(k,431)*y(k,235) + mat(k,1321) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) + mat(k,739) = .160_r8*rxt(k,453)*y(k,90) + .400_r8*rxt(k,454)*y(k,124) + mat(k,914) = .070_r8*rxt(k,456)*y(k,90) + .170_r8*rxt(k,457)*y(k,124) + mat(k,1765) = mat(k,1765) + .650_r8*rxt(k,316)*y(k,24) + .200_r8*rxt(k,340) & *y(k,74) + rxt(k,429)*y(k,116) - mat(k,337) = .700_r8*rxt(k,460)*y(k,124) - mat(k,620) = .600_r8*rxt(k,467)*y(k,124) - mat(k,1087) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & - + .250_r8*rxt(k,430)*y(k,196) + .100_r8*rxt(k,431)*y(k,197) - mat(k,636) = .340_r8*rxt(k,473)*y(k,124) - mat(k,393) = .170_r8*rxt(k,476)*y(k,124) - mat(k,1928) = -((rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,203) + rxt(k,175) & + mat(k,453) = .700_r8*rxt(k,460)*y(k,124) + mat(k,752) = .600_r8*rxt(k,467)*y(k,124) + mat(k,1227) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,198) + .100_r8*rxt(k,431)*y(k,199) + mat(k,768) = .340_r8*rxt(k,473)*y(k,124) + mat(k,509) = .170_r8*rxt(k,476)*y(k,124) + mat(k,2095) = -((rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,90) + rxt(k,175) & *y(k,134) + rxt(k,178)*y(k,135)) - mat(k,2111) = -(rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,76) - mat(k,1435) = -rxt(k,175)*y(k,76) - mat(k,1786) = -rxt(k,178)*y(k,76) - mat(k,1851) = rxt(k,297)*y(k,221) - mat(k,1550) = rxt(k,216)*y(k,77) - mat(k,999) = rxt(k,315)*y(k,221) - mat(k,678) = rxt(k,272)*y(k,77) - mat(k,1112) = rxt(k,216)*y(k,56) + rxt(k,272)*y(k,73) + rxt(k,170)*y(k,133) & - + rxt(k,153)*y(k,217) + rxt(k,179)*y(k,221) - mat(k,758) = rxt(k,270)*y(k,217) - mat(k,1344) = rxt(k,247)*y(k,217) - mat(k,751) = rxt(k,202)*y(k,221) - mat(k,1827) = rxt(k,170)*y(k,77) + rxt(k,182)*y(k,221) - mat(k,258) = rxt(k,505)*y(k,221) - mat(k,606) = rxt(k,510)*y(k,221) - mat(k,1326) = rxt(k,515)*y(k,221) - mat(k,1576) = rxt(k,153)*y(k,77) + rxt(k,270)*y(k,81) + rxt(k,247)*y(k,85) - mat(k,1724) = rxt(k,297)*y(k,42) + rxt(k,315)*y(k,62) + rxt(k,179)*y(k,77) & - + rxt(k,202)*y(k,112) + rxt(k,182)*y(k,133) + rxt(k,505) & - *y(k,138) + rxt(k,510)*y(k,149) + rxt(k,515)*y(k,151) - mat(k,1104) = -(rxt(k,153)*y(k,217) + rxt(k,170)*y(k,133) + rxt(k,179) & - *y(k,221) + rxt(k,216)*y(k,56) + rxt(k,272)*y(k,73)) - mat(k,1563) = -rxt(k,153)*y(k,77) - mat(k,1813) = -rxt(k,170)*y(k,77) - mat(k,1701) = -rxt(k,179)*y(k,77) - mat(k,1536) = -rxt(k,216)*y(k,77) - mat(k,674) = -rxt(k,272)*y(k,77) - mat(k,1915) = rxt(k,172)*y(k,203) - mat(k,2089) = rxt(k,172)*y(k,76) - mat(k,474) = -(rxt(k,171)*y(k,133) + rxt(k,180)*y(k,221) + rxt(k,217)*y(k,56)) - mat(k,1799) = -rxt(k,171)*y(k,79) - mat(k,1650) = -rxt(k,180)*y(k,79) - mat(k,1526) = -rxt(k,217)*y(k,79) - mat(k,2052) = 2.000_r8*rxt(k,186)*y(k,203) - mat(k,1650) = mat(k,1650) + 2.000_r8*rxt(k,185)*y(k,221) - mat(k,172) = rxt(k,518)*y(k,232) - mat(k,2145) = rxt(k,518)*y(k,153) - mat(k,753) = -(rxt(k,263)*y(k,133) + rxt(k,264)*y(k,221) + (rxt(k,269) & - + rxt(k,270)) * y(k,217)) - mat(k,1808) = -rxt(k,263)*y(k,81) - mat(k,1674) = -rxt(k,264)*y(k,81) - mat(k,1562) = -(rxt(k,269) + rxt(k,270)) * y(k,81) - mat(k,1350) = rxt(k,250)*y(k,42) + rxt(k,251)*y(k,203) - mat(k,1836) = rxt(k,250)*y(k,17) - mat(k,2070) = rxt(k,251)*y(k,17) - mat(k,1337) = -(rxt(k,234)*y(k,133) + rxt(k,235)*y(k,221) + (rxt(k,246) & - + rxt(k,247)) * y(k,217) + (rxt(k,549) + rxt(k,555) + rxt(k,560) & - ) * y(k,92) + (rxt(k,554) + rxt(k,559) + rxt(k,564)) * y(k,60) & - + (rxt(k,556) + rxt(k,561)) * y(k,91)) - mat(k,1815) = -rxt(k,234)*y(k,85) - mat(k,1712) = -rxt(k,235)*y(k,85) - mat(k,1564) = -(rxt(k,246) + rxt(k,247)) * y(k,85) - mat(k,763) = -(rxt(k,549) + rxt(k,555) + rxt(k,560)) * y(k,85) - mat(k,907) = -(rxt(k,554) + rxt(k,559) + rxt(k,564)) * y(k,85) - mat(k,655) = -(rxt(k,556) + rxt(k,561)) * y(k,85) - mat(k,208) = rxt(k,326)*y(k,56) - mat(k,1839) = rxt(k,214)*y(k,56) - mat(k,1538) = rxt(k,326)*y(k,28) + rxt(k,214)*y(k,42) + rxt(k,216)*y(k,77) & - + rxt(k,217)*y(k,79) + rxt(k,236)*y(k,92) + rxt(k,218)*y(k,203) - mat(k,2126) = rxt(k,233)*y(k,221) - mat(k,1105) = rxt(k,216)*y(k,56) - mat(k,475) = rxt(k,217)*y(k,56) - mat(k,763) = mat(k,763) + rxt(k,236)*y(k,56) - mat(k,2099) = rxt(k,218)*y(k,56) - mat(k,1712) = mat(k,1712) + rxt(k,233)*y(k,59) - mat(k,105) = -(rxt(k,306)*y(k,221) + rxt(k,314)*y(k,217)) - mat(k,1599) = -rxt(k,306)*y(k,86) - mat(k,1560) = -rxt(k,314)*y(k,86) - mat(k,712) = -(rxt(k,307)*y(k,221)) - mat(k,1670) = -rxt(k,307)*y(k,87) - mat(k,856) = .050_r8*rxt(k,480)*y(k,135) - mat(k,201) = .350_r8*rxt(k,317)*y(k,221) - mat(k,452) = .370_r8*rxt(k,319)*y(k,135) - mat(k,940) = .120_r8*rxt(k,348)*y(k,135) - mat(k,780) = .110_r8*rxt(k,425)*y(k,135) - mat(k,1138) = .330_r8*rxt(k,378)*y(k,135) - mat(k,818) = .050_r8*rxt(k,483)*y(k,135) - mat(k,1244) = .120_r8*rxt(k,392)*y(k,135) - mat(k,1472) = rxt(k,310)*y(k,204) - mat(k,1746) = .050_r8*rxt(k,480)*y(k,6) + .370_r8*rxt(k,319)*y(k,25) & - + .120_r8*rxt(k,348)*y(k,29) + .110_r8*rxt(k,425)*y(k,98) & + mat(k,2203) = -(rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,76) + mat(k,1548) = -rxt(k,175)*y(k,76) + mat(k,2413) = -rxt(k,178)*y(k,76) + mat(k,2349) = rxt(k,297)*y(k,226) + mat(k,2280) = rxt(k,311)*y(k,222) + mat(k,1956) = rxt(k,216)*y(k,77) + mat(k,928) = rxt(k,272)*y(k,77) + mat(k,1466) = rxt(k,216)*y(k,56) + rxt(k,272)*y(k,73) + rxt(k,170)*y(k,133) & + + rxt(k,153)*y(k,222) + rxt(k,179)*y(k,226) + mat(k,831) = rxt(k,270)*y(k,222) + mat(k,1503) = rxt(k,247)*y(k,222) + mat(k,977) = rxt(k,202)*y(k,226) + mat(k,2323) = rxt(k,170)*y(k,77) + rxt(k,182)*y(k,226) + mat(k,367) = rxt(k,505)*y(k,226) + mat(k,712) = rxt(k,511)*y(k,226) + mat(k,1483) = rxt(k,516)*y(k,226) + mat(k,1640) = rxt(k,311)*y(k,54) + rxt(k,153)*y(k,77) + rxt(k,270)*y(k,81) & + + rxt(k,247)*y(k,85) + mat(k,1805) = rxt(k,297)*y(k,42) + rxt(k,179)*y(k,77) + rxt(k,202)*y(k,112) & + + rxt(k,182)*y(k,133) + rxt(k,505)*y(k,138) + rxt(k,511) & + *y(k,149) + rxt(k,516)*y(k,151) + 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,1459) = -(rxt(k,153)*y(k,222) + rxt(k,170)*y(k,133) + rxt(k,179) & + *y(k,226) + rxt(k,216)*y(k,56) + rxt(k,272)*y(k,73)) + mat(k,1627) = -rxt(k,153)*y(k,77) + mat(k,2309) = -rxt(k,170)*y(k,77) + mat(k,1791) = -rxt(k,179)*y(k,77) + mat(k,1943) = -rxt(k,216)*y(k,77) + mat(k,924) = -rxt(k,272)*y(k,77) + mat(k,2267) = rxt(k,312)*y(k,222) + mat(k,2082) = rxt(k,172)*y(k,90) + mat(k,2190) = rxt(k,172)*y(k,76) + mat(k,1627) = mat(k,1627) + rxt(k,312)*y(k,54) + mat(k,105) = -(rxt(k,268)*y(k,222)) + mat(k,1606) = -rxt(k,268)*y(k,78) + mat(k,611) = -(rxt(k,171)*y(k,133) + rxt(k,180)*y(k,226) + rxt(k,217)*y(k,56)) + mat(k,2294) = -rxt(k,171)*y(k,79) + mat(k,1730) = -rxt(k,180)*y(k,79) + mat(k,1927) = -rxt(k,217)*y(k,79) + mat(k,2142) = 2.000_r8*rxt(k,186)*y(k,90) + mat(k,1730) = mat(k,1730) + 2.000_r8*rxt(k,185)*y(k,226) + mat(k,258) = rxt(k,518)*y(k,239) + mat(k,2421) = rxt(k,518)*y(k,153) + mat(k,826) = -(rxt(k,263)*y(k,133) + rxt(k,264)*y(k,226) + (rxt(k,269) & + + rxt(k,270)) * y(k,222)) + mat(k,2299) = -rxt(k,263)*y(k,81) + mat(k,1750) = -rxt(k,264)*y(k,81) + mat(k,1625) = -(rxt(k,269) + rxt(k,270)) * y(k,81) + mat(k,1506) = rxt(k,250)*y(k,42) + rxt(k,251)*y(k,90) + mat(k,2332) = rxt(k,250)*y(k,17) + mat(k,2159) = rxt(k,251)*y(k,17) + mat(k,219) = -(rxt(k,286)*y(k,226) + rxt(k,291)*y(k,222)) + mat(k,1676) = -rxt(k,286)*y(k,82) + mat(k,1616) = -rxt(k,291)*y(k,82) + mat(k,249) = -(rxt(k,287)*y(k,226) + rxt(k,292)*y(k,222)) + mat(k,1683) = -rxt(k,287)*y(k,83) + mat(k,1619) = -rxt(k,292)*y(k,83) + mat(k,272) = -(rxt(k,288)*y(k,226) + rxt(k,293)*y(k,222)) + mat(k,1687) = -rxt(k,288)*y(k,84) + mat(k,1621) = -rxt(k,293)*y(k,84) + mat(k,1493) = -(rxt(k,234)*y(k,133) + rxt(k,235)*y(k,226) + (rxt(k,246) & + + rxt(k,247)) * y(k,222) + (rxt(k,563) + rxt(k,569) + rxt(k,574) & + ) * y(k,93) + (rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,60) & + + (rxt(k,570) + rxt(k,575)) * y(k,92)) + mat(k,2311) = -rxt(k,234)*y(k,85) + mat(k,1793) = -rxt(k,235)*y(k,85) + mat(k,1628) = -(rxt(k,246) + rxt(k,247)) * y(k,85) + mat(k,836) = -(rxt(k,563) + rxt(k,569) + rxt(k,574)) * y(k,85) + mat(k,954) = -(rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,85) + mat(k,786) = -(rxt(k,570) + rxt(k,575)) * y(k,85) + mat(k,298) = rxt(k,325)*y(k,56) + mat(k,304) = rxt(k,355)*y(k,56) + mat(k,471) = rxt(k,277)*y(k,56) + mat(k,2337) = rxt(k,214)*y(k,56) + mat(k,603) = rxt(k,279)*y(k,56) + mat(k,371) = 2.000_r8*rxt(k,282)*y(k,56) + mat(k,2268) = rxt(k,215)*y(k,56) + mat(k,446) = rxt(k,284)*y(k,56) + mat(k,1944) = rxt(k,325)*y(k,28) + rxt(k,355)*y(k,31) + rxt(k,277)*y(k,41) & + + rxt(k,214)*y(k,42) + rxt(k,279)*y(k,43) + 2.000_r8*rxt(k,282) & + *y(k,46) + rxt(k,215)*y(k,54) + rxt(k,284)*y(k,55) + rxt(k,216) & + *y(k,77) + rxt(k,217)*y(k,79) + rxt(k,218)*y(k,90) + rxt(k,236) & + *y(k,93) + mat(k,1586) = rxt(k,233)*y(k,226) + mat(k,1460) = rxt(k,216)*y(k,56) + mat(k,612) = rxt(k,217)*y(k,56) + mat(k,2191) = rxt(k,218)*y(k,56) + mat(k,836) = mat(k,836) + rxt(k,236)*y(k,56) + mat(k,1793) = mat(k,1793) + rxt(k,233)*y(k,59) + mat(k,180) = -(rxt(k,305)*y(k,226) + rxt(k,313)*y(k,222)) + mat(k,1669) = -rxt(k,305)*y(k,86) + mat(k,1615) = -rxt(k,313)*y(k,86) + mat(k,908) = -(rxt(k,306)*y(k,226)) + mat(k,1755) = -rxt(k,306)*y(k,87) + mat(k,987) = .050_r8*rxt(k,480)*y(k,135) + mat(k,291) = .350_r8*rxt(k,316)*y(k,226) + mat(k,550) = .370_r8*rxt(k,318)*y(k,135) + mat(k,1130) = .120_r8*rxt(k,347)*y(k,135) + mat(k,2163) = rxt(k,307)*y(k,205) + mat(k,881) = .110_r8*rxt(k,425)*y(k,135) + mat(k,1265) = .330_r8*rxt(k,378)*y(k,135) + mat(k,1015) = .050_r8*rxt(k,483)*y(k,135) + mat(k,1367) = .120_r8*rxt(k,392)*y(k,135) + mat(k,2033) = rxt(k,309)*y(k,205) + mat(k,2373) = .050_r8*rxt(k,480)*y(k,6) + .370_r8*rxt(k,318)*y(k,25) & + + .120_r8*rxt(k,347)*y(k,29) + .110_r8*rxt(k,425)*y(k,99) & + .330_r8*rxt(k,378)*y(k,105) + .050_r8*rxt(k,483)*y(k,110) & + .120_r8*rxt(k,392)*y(k,111) - mat(k,2067) = rxt(k,308)*y(k,204) - mat(k,330) = rxt(k,310)*y(k,124) + rxt(k,308)*y(k,203) - mat(k,1670) = mat(k,1670) + .350_r8*rxt(k,317)*y(k,24) - mat(k,672) = rxt(k,272)*y(k,77) + rxt(k,274)*y(k,89) + rxt(k,273)*y(k,232) - mat(k,1102) = rxt(k,272)*y(k,73) - mat(k,1935) = rxt(k,274)*y(k,73) - mat(k,2146) = rxt(k,273)*y(k,73) - mat(k,1951) = -(rxt(k,211)*y(k,221) + rxt(k,274)*y(k,73)) - mat(k,1725) = -rxt(k,211)*y(k,89) - mat(k,679) = -rxt(k,274)*y(k,89) - mat(k,1852) = rxt(k,295)*y(k,126) - mat(k,1082) = rxt(k,328)*y(k,126) - mat(k,1157) = rxt(k,354)*y(k,126) - mat(k,912) = (rxt(k,554)+rxt(k,559)+rxt(k,564))*y(k,85) - mat(k,195) = rxt(k,502)*y(k,126) - mat(k,1345) = (rxt(k,554)+rxt(k,559)+rxt(k,564))*y(k,60) - mat(k,1993) = rxt(k,210)*y(k,221) - mat(k,1909) = rxt(k,295)*y(k,42) + rxt(k,328)*y(k,45) + rxt(k,354)*y(k,49) & + mat(k,440) = rxt(k,307)*y(k,90) + rxt(k,309)*y(k,124) + mat(k,1755) = mat(k,1755) + .350_r8*rxt(k,316)*y(k,24) + mat(k,2263) = rxt(k,271)*y(k,73) + mat(k,922) = rxt(k,271)*y(k,54) + rxt(k,272)*y(k,77) + rxt(k,274)*y(k,89) & + + rxt(k,273)*y(k,239) + mat(k,1457) = rxt(k,272)*y(k,73) + mat(k,1964) = rxt(k,274)*y(k,73) + mat(k,2423) = rxt(k,273)*y(k,73) + mat(k,1977) = -(rxt(k,211)*y(k,226) + rxt(k,274)*y(k,73)) + mat(k,1803) = -rxt(k,211)*y(k,89) + mat(k,927) = -rxt(k,274)*y(k,89) + mat(k,2347) = rxt(k,295)*y(k,126) + mat(k,1154) = rxt(k,327)*y(k,126) + mat(k,1284) = rxt(k,353)*y(k,126) + mat(k,960) = (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,85) + mat(k,312) = rxt(k,502)*y(k,126) + mat(k,1502) = (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,60) + mat(k,1848) = rxt(k,210)*y(k,226) + mat(k,1908) = rxt(k,295)*y(k,42) + rxt(k,327)*y(k,45) + rxt(k,353)*y(k,49) & + rxt(k,502)*y(k,67) - mat(k,1725) = mat(k,1725) + rxt(k,210)*y(k,125) - mat(k,361) = -(rxt(k,187)*y(k,221)) - mat(k,1637) = -rxt(k,187)*y(k,90) - mat(k,1961) = rxt(k,208)*y(k,203) - mat(k,2044) = rxt(k,208)*y(k,125) - mat(k,654) = -(rxt(k,265)*y(k,133) + (rxt(k,556) + rxt(k,561)) * y(k,85)) - mat(k,1803) = -rxt(k,265)*y(k,91) - mat(k,1334) = -(rxt(k,556) + rxt(k,561)) * y(k,91) - mat(k,2002) = rxt(k,257)*y(k,203) - mat(k,2065) = rxt(k,257)*y(k,19) - mat(k,762) = -(rxt(k,236)*y(k,56) + rxt(k,237)*y(k,133) + rxt(k,238)*y(k,221) & - + (rxt(k,549) + rxt(k,555) + rxt(k,560)) * y(k,85)) - mat(k,1529) = -rxt(k,236)*y(k,92) - mat(k,1809) = -rxt(k,237)*y(k,92) - mat(k,1675) = -rxt(k,238)*y(k,92) - mat(k,1335) = -(rxt(k,549) + rxt(k,555) + rxt(k,560)) * y(k,92) - mat(k,2122) = rxt(k,225)*y(k,203) - mat(k,905) = rxt(k,230)*y(k,221) - mat(k,2071) = rxt(k,225)*y(k,59) - mat(k,1675) = mat(k,1675) + rxt(k,230)*y(k,60) - mat(k,968) = -(rxt(k,371)*y(k,221)) - mat(k,1691) = -rxt(k,371)*y(k,93) - mat(k,507) = .300_r8*rxt(k,416)*y(k,221) - mat(k,425) = .500_r8*rxt(k,417)*y(k,221) - mat(k,1485) = rxt(k,370)*y(k,200) + rxt(k,377)*y(k,207) - mat(k,460) = rxt(k,370)*y(k,124) - mat(k,1225) = rxt(k,377)*y(k,124) - mat(k,1691) = mat(k,1691) + .300_r8*rxt(k,416)*y(k,99) + .500_r8*rxt(k,417) & - *y(k,100) + mat(k,1803) = mat(k,1803) + rxt(k,210)*y(k,125) + mat(k,2204) = -((rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,76) + rxt(k,176) & + *y(k,133) + rxt(k,177)*y(k,135) + rxt(k,181)*y(k,226) & + + 4._r8*rxt(k,186)*y(k,90) + rxt(k,198)*y(k,126) + rxt(k,203) & + *y(k,124) + rxt(k,208)*y(k,125) + (rxt(k,218) + rxt(k,219) & + ) * y(k,56) + rxt(k,225)*y(k,59) + rxt(k,251)*y(k,17) + rxt(k,257) & + *y(k,19) + rxt(k,294)*y(k,42) + rxt(k,300)*y(k,199) + rxt(k,307) & + *y(k,205) + rxt(k,321)*y(k,195) + rxt(k,332)*y(k,198) + rxt(k,336) & + *y(k,204) + rxt(k,349)*y(k,196) + rxt(k,358)*y(k,229) + rxt(k,362) & + *y(k,230) + rxt(k,374)*y(k,211) + rxt(k,383)*y(k,213) + rxt(k,387) & + *y(k,215) + rxt(k,397)*y(k,190) + rxt(k,407)*y(k,206) + rxt(k,412) & + *y(k,207) + rxt(k,421)*y(k,208) + rxt(k,432)*y(k,235) + rxt(k,436) & + *y(k,189) + rxt(k,439)*y(k,192) + rxt(k,443)*y(k,194) + rxt(k,446) & + *y(k,197) + rxt(k,450)*y(k,200) + rxt(k,453)*y(k,212) + rxt(k,456) & + *y(k,214) + rxt(k,459)*y(k,228) + rxt(k,466)*y(k,233) + rxt(k,472) & + *y(k,236) + rxt(k,475)*y(k,238) + rxt(k,486)*y(k,221) + rxt(k,491) & + *y(k,231) + rxt(k,496)*y(k,232)) + mat(k,2096) = -(rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,90) + mat(k,2324) = -rxt(k,176)*y(k,90) + mat(k,2414) = -rxt(k,177)*y(k,90) + mat(k,1806) = -rxt(k,181)*y(k,90) + mat(k,1911) = -rxt(k,198)*y(k,90) + mat(k,2075) = -rxt(k,203)*y(k,90) + mat(k,1851) = -rxt(k,208)*y(k,90) + mat(k,1957) = -(rxt(k,218) + rxt(k,219)) * y(k,90) + mat(k,1599) = -rxt(k,225)*y(k,90) + mat(k,1517) = -rxt(k,251)*y(k,90) + mat(k,1573) = -rxt(k,257)*y(k,90) + mat(k,2350) = -rxt(k,294)*y(k,90) + mat(k,2256) = -rxt(k,300)*y(k,90) + mat(k,443) = -rxt(k,307)*y(k,90) + mat(k,905) = -rxt(k,321)*y(k,90) + mat(k,1434) = -rxt(k,332)*y(k,90) + mat(k,801) = -rxt(k,336)*y(k,90) + mat(k,940) = -rxt(k,349)*y(k,90) + mat(k,823) = -rxt(k,358)*y(k,90) + mat(k,1221) = -rxt(k,362)*y(k,90) + mat(k,1363) = -rxt(k,374)*y(k,90) + mat(k,1403) = -rxt(k,383)*y(k,90) + mat(k,702) = -rxt(k,387)*y(k,90) + mat(k,1048) = -rxt(k,397)*y(k,90) + mat(k,1308) = -rxt(k,407)*y(k,90) + mat(k,1341) = -rxt(k,412)*y(k,90) + mat(k,1262) = -rxt(k,421)*y(k,90) + mat(k,1239) = -rxt(k,432)*y(k,90) + mat(k,526) = -rxt(k,436)*y(k,90) + mat(k,492) = -rxt(k,439)*y(k,90) + mat(k,438) = -rxt(k,443)*y(k,90) + mat(k,637) = -rxt(k,446)*y(k,90) + mat(k,782) = -rxt(k,450)*y(k,90) + mat(k,743) = -rxt(k,453)*y(k,90) + mat(k,920) = -rxt(k,456)*y(k,90) + mat(k,457) = -rxt(k,459)*y(k,90) + mat(k,758) = -rxt(k,466)*y(k,90) + mat(k,775) = -rxt(k,472)*y(k,90) + mat(k,514) = -rxt(k,475)*y(k,90) + mat(k,1097) = -rxt(k,486)*y(k,90) + mat(k,1184) = -rxt(k,491)*y(k,90) + mat(k,1067) = -rxt(k,496)*y(k,90) + mat(k,1003) = .570_r8*rxt(k,480)*y(k,135) + mat(k,163) = .650_r8*rxt(k,438)*y(k,226) + mat(k,1517) = mat(k,1517) + rxt(k,250)*y(k,42) + mat(k,1573) = mat(k,1573) + rxt(k,262)*y(k,226) + mat(k,295) = .350_r8*rxt(k,316)*y(k,226) + mat(k,553) = .130_r8*rxt(k,318)*y(k,135) + mat(k,266) = rxt(k,323)*y(k,226) + mat(k,1143) = .280_r8*rxt(k,347)*y(k,135) + mat(k,2350) = mat(k,2350) + rxt(k,250)*y(k,17) + rxt(k,214)*y(k,56) & + + rxt(k,295)*y(k,126) + rxt(k,296)*y(k,133) + mat(k,608) = rxt(k,279)*y(k,56) + rxt(k,280)*y(k,226) + mat(k,374) = rxt(k,282)*y(k,56) + rxt(k,283)*y(k,226) + mat(k,104) = rxt(k,329)*y(k,226) + mat(k,813) = rxt(k,302)*y(k,226) + mat(k,2281) = rxt(k,311)*y(k,222) + mat(k,1957) = mat(k,1957) + rxt(k,214)*y(k,42) + rxt(k,279)*y(k,43) & + + rxt(k,282)*y(k,46) + rxt(k,217)*y(k,79) + mat(k,1599) = mat(k,1599) + rxt(k,221)*y(k,199) + rxt(k,232)*y(k,226) + mat(k,1161) = rxt(k,314)*y(k,226) + mat(k,196) = .730_r8*rxt(k,449)*y(k,226) + mat(k,313) = .500_r8*rxt(k,517)*y(k,226) + mat(k,1167) = rxt(k,340)*y(k,226) + mat(k,1056) = rxt(k,341)*y(k,226) + mat(k,2096) = mat(k,2096) + rxt(k,175)*y(k,134) + mat(k,615) = rxt(k,217)*y(k,56) + rxt(k,171)*y(k,133) + rxt(k,180)*y(k,226) + mat(k,183) = rxt(k,305)*y(k,226) + mat(k,911) = rxt(k,306)*y(k,226) + mat(k,2204) = mat(k,2204) + .070_r8*rxt(k,450)*y(k,200) + .160_r8*rxt(k,453) & + *y(k,212) + .330_r8*rxt(k,456)*y(k,214) + mat(k,1202) = rxt(k,371)*y(k,226) + mat(k,1210) = rxt(k,356)*y(k,226) + mat(k,892) = .370_r8*rxt(k,425)*y(k,135) + mat(k,596) = .300_r8*rxt(k,416)*y(k,226) + mat(k,563) = rxt(k,417)*y(k,226) + mat(k,424) = rxt(k,424)*y(k,226) + mat(k,1274) = .140_r8*rxt(k,378)*y(k,135) + mat(k,318) = .200_r8*rxt(k,380)*y(k,226) + mat(k,587) = .500_r8*rxt(k,391)*y(k,226) + mat(k,1031) = .570_r8*rxt(k,483)*y(k,135) + mat(k,1384) = .280_r8*rxt(k,392)*y(k,135) + mat(k,382) = rxt(k,428)*y(k,226) + mat(k,1124) = rxt(k,429)*y(k,226) + mat(k,2075) = mat(k,2075) + rxt(k,398)*y(k,190) + rxt(k,440)*y(k,192) & + + rxt(k,445)*y(k,194) + rxt(k,322)*y(k,195) + rxt(k,350) & + *y(k,196) + rxt(k,301)*y(k,199) + .170_r8*rxt(k,451)*y(k,200) & + + rxt(k,369)*y(k,202) + .250_r8*rxt(k,337)*y(k,204) + rxt(k,309) & + *y(k,205) + .920_r8*rxt(k,408)*y(k,206) + .920_r8*rxt(k,414) & + *y(k,207) + rxt(k,422)*y(k,208) + .470_r8*rxt(k,376)*y(k,211) & + + .400_r8*rxt(k,454)*y(k,212) + .830_r8*rxt(k,457)*y(k,214) & + + rxt(k,460)*y(k,228) + rxt(k,359)*y(k,229) + .900_r8*rxt(k,492) & + *y(k,231) + .800_r8*rxt(k,497)*y(k,232) + rxt(k,467)*y(k,233) & + + rxt(k,433)*y(k,235) + rxt(k,473)*y(k,236) + rxt(k,476) & + *y(k,238) + mat(k,1911) = mat(k,1911) + rxt(k,295)*y(k,42) + rxt(k,409)*y(k,206) & + + rxt(k,415)*y(k,207) + rxt(k,423)*y(k,208) + .470_r8*rxt(k,375) & + *y(k,211) + rxt(k,201)*y(k,226) + rxt(k,434)*y(k,235) + mat(k,2324) = mat(k,2324) + rxt(k,296)*y(k,42) + rxt(k,171)*y(k,79) + mat(k,1549) = rxt(k,175)*y(k,76) + rxt(k,339)*y(k,203) + mat(k,2414) = mat(k,2414) + .570_r8*rxt(k,480)*y(k,6) + .130_r8*rxt(k,318) & + *y(k,25) + .280_r8*rxt(k,347)*y(k,29) + .370_r8*rxt(k,425) & + *y(k,99) + .140_r8*rxt(k,378)*y(k,105) + .570_r8*rxt(k,483) & + *y(k,110) + .280_r8*rxt(k,392)*y(k,111) + rxt(k,183)*y(k,226) + mat(k,172) = .800_r8*rxt(k,461)*y(k,226) + mat(k,948) = rxt(k,507)*y(k,226) + mat(k,1107) = .200_r8*rxt(k,501)*y(k,226) + mat(k,191) = .280_r8*rxt(k,469)*y(k,226) + mat(k,213) = .380_r8*rxt(k,471)*y(k,226) + mat(k,218) = .630_r8*rxt(k,477)*y(k,226) + mat(k,1048) = mat(k,1048) + rxt(k,398)*y(k,124) + mat(k,492) = mat(k,492) + rxt(k,440)*y(k,124) + mat(k,438) = mat(k,438) + rxt(k,445)*y(k,124) + mat(k,905) = mat(k,905) + rxt(k,322)*y(k,124) + 2.400_r8*rxt(k,319)*y(k,195) & + + rxt(k,320)*y(k,199) + mat(k,940) = mat(k,940) + rxt(k,350)*y(k,124) + rxt(k,348)*y(k,199) + mat(k,1434) = mat(k,1434) + .900_r8*rxt(k,331)*y(k,199) + rxt(k,405)*y(k,206) & + + rxt(k,410)*y(k,207) + rxt(k,419)*y(k,208) + .470_r8*rxt(k,372) & + *y(k,211) + rxt(k,430)*y(k,235) + mat(k,2256) = mat(k,2256) + rxt(k,221)*y(k,59) + rxt(k,301)*y(k,124) & + + rxt(k,320)*y(k,195) + rxt(k,348)*y(k,196) + .900_r8*rxt(k,331) & + *y(k,198) + 4.000_r8*rxt(k,298)*y(k,199) + rxt(k,406)*y(k,206) & + + rxt(k,411)*y(k,207) + 1.200_r8*rxt(k,420)*y(k,208) & + + .730_r8*rxt(k,373)*y(k,211) + rxt(k,382)*y(k,213) & + + .500_r8*rxt(k,485)*y(k,221) + .300_r8*rxt(k,361)*y(k,230) & + + rxt(k,490)*y(k,231) + rxt(k,495)*y(k,232) + .800_r8*rxt(k,431) & + *y(k,235) + mat(k,782) = mat(k,782) + .070_r8*rxt(k,450)*y(k,90) + .170_r8*rxt(k,451) & + *y(k,124) + mat(k,578) = rxt(k,369)*y(k,124) + mat(k,464) = rxt(k,339)*y(k,134) + mat(k,801) = mat(k,801) + .250_r8*rxt(k,337)*y(k,124) + mat(k,443) = mat(k,443) + rxt(k,309)*y(k,124) + mat(k,1308) = mat(k,1308) + .920_r8*rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126) & + + rxt(k,405)*y(k,198) + rxt(k,406)*y(k,199) + mat(k,1341) = mat(k,1341) + .920_r8*rxt(k,414)*y(k,124) + rxt(k,415)*y(k,126) & + + rxt(k,410)*y(k,198) + rxt(k,411)*y(k,199) + mat(k,1262) = mat(k,1262) + rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126) & + + rxt(k,419)*y(k,198) + 1.200_r8*rxt(k,420)*y(k,199) + mat(k,1363) = mat(k,1363) + .470_r8*rxt(k,376)*y(k,124) + .470_r8*rxt(k,375) & + *y(k,126) + .470_r8*rxt(k,372)*y(k,198) + .730_r8*rxt(k,373) & + *y(k,199) + mat(k,743) = mat(k,743) + .160_r8*rxt(k,453)*y(k,90) + .400_r8*rxt(k,454) & + *y(k,124) + mat(k,1403) = mat(k,1403) + rxt(k,382)*y(k,199) + mat(k,920) = mat(k,920) + .330_r8*rxt(k,456)*y(k,90) + .830_r8*rxt(k,457) & + *y(k,124) + mat(k,1097) = mat(k,1097) + .500_r8*rxt(k,485)*y(k,199) + mat(k,1641) = rxt(k,311)*y(k,54) + mat(k,1806) = mat(k,1806) + .650_r8*rxt(k,438)*y(k,7) + rxt(k,262)*y(k,19) & + + .350_r8*rxt(k,316)*y(k,24) + rxt(k,323)*y(k,26) + rxt(k,280) & + *y(k,43) + rxt(k,283)*y(k,46) + rxt(k,329)*y(k,47) + rxt(k,302) & + *y(k,52) + rxt(k,232)*y(k,59) + rxt(k,314)*y(k,62) & + + .730_r8*rxt(k,449)*y(k,66) + .500_r8*rxt(k,517)*y(k,67) & + + rxt(k,340)*y(k,74) + rxt(k,341)*y(k,75) + rxt(k,180)*y(k,79) & + + rxt(k,305)*y(k,86) + rxt(k,306)*y(k,87) + rxt(k,371)*y(k,94) & + + rxt(k,356)*y(k,96) + .300_r8*rxt(k,416)*y(k,100) + rxt(k,417) & + *y(k,101) + rxt(k,424)*y(k,102) + .200_r8*rxt(k,380)*y(k,106) & + + .500_r8*rxt(k,391)*y(k,109) + rxt(k,428)*y(k,115) + rxt(k,429) & + *y(k,116) + rxt(k,201)*y(k,126) + rxt(k,183)*y(k,135) & + + .800_r8*rxt(k,461)*y(k,143) + rxt(k,507)*y(k,152) & + + .200_r8*rxt(k,501)*y(k,179) + .280_r8*rxt(k,469)*y(k,181) & + + .380_r8*rxt(k,471)*y(k,183) + .630_r8*rxt(k,477)*y(k,185) + mat(k,457) = mat(k,457) + rxt(k,460)*y(k,124) + mat(k,823) = mat(k,823) + rxt(k,359)*y(k,124) + mat(k,1221) = mat(k,1221) + .300_r8*rxt(k,361)*y(k,199) + mat(k,1184) = mat(k,1184) + .900_r8*rxt(k,492)*y(k,124) + rxt(k,490)*y(k,199) + mat(k,1067) = mat(k,1067) + .800_r8*rxt(k,497)*y(k,124) + rxt(k,495)*y(k,199) + mat(k,758) = mat(k,758) + rxt(k,467)*y(k,124) + mat(k,1239) = mat(k,1239) + rxt(k,433)*y(k,124) + rxt(k,434)*y(k,126) & + + rxt(k,430)*y(k,198) + .800_r8*rxt(k,431)*y(k,199) + mat(k,775) = mat(k,775) + rxt(k,473)*y(k,124) + mat(k,514) = mat(k,514) + rxt(k,476)*y(k,124) end do - end subroutine nlnmat03 - subroutine nlnmat04( avec_len, mat, y, rxt ) + end subroutine nlnmat04 + subroutine nlnmat05( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -710,215 +1060,240 @@ subroutine nlnmat04( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,155) = -(rxt(k,402)*y(k,221)) - mat(k,1606) = -rxt(k,402)*y(k,94) - mat(k,991) = -(rxt(k,356)*y(k,221)) - mat(k,1693) = -rxt(k,356)*y(k,95) - mat(k,508) = .700_r8*rxt(k,416)*y(k,221) - mat(k,426) = .500_r8*rxt(k,417)*y(k,221) - mat(k,467) = .500_r8*rxt(k,391)*y(k,221) - mat(k,1487) = .050_r8*rxt(k,414)*y(k,206) + .220_r8*rxt(k,376)*y(k,207) & - + .250_r8*rxt(k,433)*y(k,229) - mat(k,1879) = .050_r8*rxt(k,415)*y(k,206) + .220_r8*rxt(k,375)*y(k,207) & - + .250_r8*rxt(k,434)*y(k,229) - mat(k,432) = .500_r8*rxt(k,360)*y(k,221) - mat(k,1291) = .220_r8*rxt(k,372)*y(k,207) + .250_r8*rxt(k,430)*y(k,229) - mat(k,1379) = .230_r8*rxt(k,373)*y(k,207) + .200_r8*rxt(k,361)*y(k,225) & - + .100_r8*rxt(k,431)*y(k,229) - mat(k,1199) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) - mat(k,1226) = .220_r8*rxt(k,376)*y(k,124) + .220_r8*rxt(k,375)*y(k,126) & - + .220_r8*rxt(k,372)*y(k,196) + .230_r8*rxt(k,373)*y(k,197) - mat(k,1693) = mat(k,1693) + .700_r8*rxt(k,416)*y(k,99) + .500_r8*rxt(k,417) & - *y(k,100) + .500_r8*rxt(k,391)*y(k,109) + .500_r8*rxt(k,360) & + mat(k,493) = -(rxt(k,187)*y(k,226)) + mat(k,1717) = -rxt(k,187)*y(k,91) + mat(k,2138) = rxt(k,208)*y(k,125) + mat(k,1817) = rxt(k,208)*y(k,90) + mat(k,785) = -(rxt(k,265)*y(k,133) + (rxt(k,570) + rxt(k,575)) * y(k,85)) + mat(k,2297) = -rxt(k,265)*y(k,92) + mat(k,1490) = -(rxt(k,570) + rxt(k,575)) * y(k,92) + mat(k,1557) = rxt(k,257)*y(k,90) + mat(k,2156) = rxt(k,257)*y(k,19) + mat(k,835) = -(rxt(k,236)*y(k,56) + rxt(k,237)*y(k,133) + rxt(k,238)*y(k,226) & + + (rxt(k,563) + rxt(k,569) + rxt(k,574)) * y(k,85)) + mat(k,1929) = -rxt(k,236)*y(k,93) + mat(k,2300) = -rxt(k,237)*y(k,93) + mat(k,1751) = -rxt(k,238)*y(k,93) + mat(k,1491) = -(rxt(k,563) + rxt(k,569) + rxt(k,574)) * y(k,93) + mat(k,1582) = rxt(k,225)*y(k,90) + mat(k,952) = rxt(k,230)*y(k,226) + mat(k,2160) = rxt(k,225)*y(k,59) + mat(k,1751) = mat(k,1751) + rxt(k,230)*y(k,60) + mat(k,1193) = -(rxt(k,371)*y(k,226)) + mat(k,1777) = -rxt(k,371)*y(k,94) + mat(k,591) = .300_r8*rxt(k,416)*y(k,226) + mat(k,559) = .500_r8*rxt(k,417)*y(k,226) + mat(k,2049) = rxt(k,370)*y(k,202) + rxt(k,377)*y(k,211) + mat(k,575) = rxt(k,370)*y(k,124) + mat(k,1350) = rxt(k,377)*y(k,124) + mat(k,1777) = mat(k,1777) + .300_r8*rxt(k,416)*y(k,100) + .500_r8*rxt(k,417) & + *y(k,101) + mat(k,228) = -(rxt(k,402)*y(k,226)) + mat(k,1678) = -rxt(k,402)*y(k,95) + mat(k,1206) = -(rxt(k,356)*y(k,226)) + mat(k,1778) = -rxt(k,356)*y(k,96) + mat(k,592) = .700_r8*rxt(k,416)*y(k,226) + mat(k,560) = .500_r8*rxt(k,417)*y(k,226) + mat(k,581) = .500_r8*rxt(k,391)*y(k,226) + mat(k,2050) = .050_r8*rxt(k,414)*y(k,207) + .220_r8*rxt(k,376)*y(k,211) & + + .250_r8*rxt(k,433)*y(k,235) + mat(k,1885) = .050_r8*rxt(k,415)*y(k,207) + .220_r8*rxt(k,375)*y(k,211) & + + .250_r8*rxt(k,434)*y(k,235) + mat(k,543) = .500_r8*rxt(k,360)*y(k,226) + mat(k,1416) = .220_r8*rxt(k,372)*y(k,211) + .250_r8*rxt(k,430)*y(k,235) + mat(k,2232) = .230_r8*rxt(k,373)*y(k,211) + .200_r8*rxt(k,361)*y(k,230) & + + .100_r8*rxt(k,431)*y(k,235) + mat(k,1325) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) + mat(k,1351) = .220_r8*rxt(k,376)*y(k,124) + .220_r8*rxt(k,375)*y(k,126) & + + .220_r8*rxt(k,372)*y(k,198) + .230_r8*rxt(k,373)*y(k,199) + mat(k,1778) = mat(k,1778) + .700_r8*rxt(k,416)*y(k,100) + .500_r8*rxt(k,417) & + *y(k,101) + .500_r8*rxt(k,391)*y(k,109) + .500_r8*rxt(k,360) & *y(k,147) - mat(k,1064) = .200_r8*rxt(k,361)*y(k,197) - mat(k,1089) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & - + .250_r8*rxt(k,430)*y(k,196) + .100_r8*rxt(k,431)*y(k,197) - mat(k,212) = -(rxt(k,403)*y(k,221)) - mat(k,1616) = -rxt(k,403)*y(k,96) - mat(k,1444) = .870_r8*rxt(k,414)*y(k,206) - mat(k,1862) = .950_r8*rxt(k,415)*y(k,206) - mat(k,1284) = rxt(k,410)*y(k,206) - mat(k,1364) = .750_r8*rxt(k,411)*y(k,206) - mat(k,1189) = .870_r8*rxt(k,414)*y(k,124) + .950_r8*rxt(k,415)*y(k,126) & - + rxt(k,410)*y(k,196) + .750_r8*rxt(k,411)*y(k,197) - mat(k,68) = -(rxt(k,404)*y(k,221)) - mat(k,1594) = -rxt(k,404)*y(k,97) - mat(k,577) = .600_r8*rxt(k,427)*y(k,221) - mat(k,1594) = mat(k,1594) + .600_r8*rxt(k,427)*y(k,103) - mat(k,781) = -(rxt(k,418)*y(k,126) + rxt(k,425)*y(k,135) + rxt(k,426) & - *y(k,221)) - mat(k,1866) = -rxt(k,418)*y(k,98) - mat(k,1747) = -rxt(k,425)*y(k,98) - mat(k,1677) = -rxt(k,426)*y(k,98) - mat(k,505) = -(rxt(k,416)*y(k,221)) - mat(k,1654) = -rxt(k,416)*y(k,99) - mat(k,1459) = .080_r8*rxt(k,408)*y(k,205) - mat(k,1160) = .080_r8*rxt(k,408)*y(k,124) - mat(k,422) = -(rxt(k,417)*y(k,221)) - mat(k,1644) = -rxt(k,417)*y(k,100) - mat(k,1456) = .080_r8*rxt(k,414)*y(k,206) - mat(k,1190) = .080_r8*rxt(k,414)*y(k,124) - mat(k,1124) = -(rxt(k,419)*y(k,196) + rxt(k,420)*y(k,197) + rxt(k,421) & - *y(k,203) + rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126)) - mat(k,1294) = -rxt(k,419)*y(k,101) - mat(k,1387) = -rxt(k,420)*y(k,101) - mat(k,2090) = -rxt(k,421)*y(k,101) - mat(k,1495) = -rxt(k,422)*y(k,101) - mat(k,1887) = -rxt(k,423)*y(k,101) - mat(k,784) = rxt(k,418)*y(k,126) - mat(k,1887) = mat(k,1887) + rxt(k,418)*y(k,98) - mat(k,297) = -(rxt(k,424)*y(k,221)) - mat(k,1628) = -rxt(k,424)*y(k,102) - mat(k,1116) = rxt(k,421)*y(k,203) - mat(k,2034) = rxt(k,421)*y(k,101) - mat(k,578) = -(rxt(k,427)*y(k,221)) - mat(k,1660) = -rxt(k,427)*y(k,103) - mat(k,2059) = rxt(k,407)*y(k,205) + rxt(k,412)*y(k,206) - mat(k,1161) = rxt(k,407)*y(k,203) - mat(k,1192) = rxt(k,412)*y(k,203) - mat(k,39) = -(rxt(k,541)*y(k,221)) - mat(k,1588) = -rxt(k,541)*y(k,104) - mat(k,1140) = -(rxt(k,378)*y(k,135) + rxt(k,379)*y(k,221)) - mat(k,1766) = -rxt(k,378)*y(k,105) - mat(k,1703) = -rxt(k,379)*y(k,105) - mat(k,785) = .300_r8*rxt(k,425)*y(k,135) - mat(k,1496) = .360_r8*rxt(k,408)*y(k,205) - mat(k,1888) = .400_r8*rxt(k,409)*y(k,205) - mat(k,1766) = mat(k,1766) + .300_r8*rxt(k,425)*y(k,98) - mat(k,1295) = .390_r8*rxt(k,405)*y(k,205) - mat(k,1388) = .310_r8*rxt(k,406)*y(k,205) - mat(k,1170) = .360_r8*rxt(k,408)*y(k,124) + .400_r8*rxt(k,409)*y(k,126) & - + .390_r8*rxt(k,405)*y(k,196) + .310_r8*rxt(k,406)*y(k,197) - mat(k,215) = -(rxt(k,380)*y(k,221)) - mat(k,1617) = -rxt(k,380)*y(k,106) - mat(k,2026) = rxt(k,374)*y(k,207) - mat(k,1222) = rxt(k,374)*y(k,203) - mat(k,417) = -(rxt(k,389)*y(k,221)) - mat(k,1643) = -rxt(k,389)*y(k,107) - mat(k,1455) = .800_r8*rxt(k,398)*y(k,190) - mat(k,875) = .800_r8*rxt(k,398)*y(k,124) - mat(k,220) = -(rxt(k,390)*y(k,221)) - mat(k,1618) = -rxt(k,390)*y(k,108) - mat(k,2027) = .800_r8*rxt(k,387)*y(k,211) - mat(k,557) = .800_r8*rxt(k,387)*y(k,203) - mat(k,466) = -(rxt(k,391)*y(k,221)) - mat(k,1649) = -rxt(k,391)*y(k,109) - mat(k,1964) = rxt(k,394)*y(k,209) - mat(k,1268) = rxt(k,394)*y(k,125) - mat(k,820) = -(rxt(k,482)*y(k,126) + rxt(k,483)*y(k,135) + rxt(k,484) & - *y(k,221)) - mat(k,1868) = -rxt(k,482)*y(k,110) - mat(k,1749) = -rxt(k,483)*y(k,110) - mat(k,1680) = -rxt(k,484)*y(k,110) - mat(k,1251) = -(rxt(k,392)*y(k,135) + rxt(k,393)*y(k,221)) - mat(k,1771) = -rxt(k,392)*y(k,111) - mat(k,1708) = -rxt(k,393)*y(k,111) - mat(k,788) = .200_r8*rxt(k,425)*y(k,135) - mat(k,1501) = .560_r8*rxt(k,408)*y(k,205) - mat(k,1893) = .600_r8*rxt(k,409)*y(k,205) - mat(k,1771) = mat(k,1771) + .200_r8*rxt(k,425)*y(k,98) - mat(k,1300) = .610_r8*rxt(k,405)*y(k,205) - mat(k,1393) = .440_r8*rxt(k,406)*y(k,205) - mat(k,1174) = .560_r8*rxt(k,408)*y(k,124) + .600_r8*rxt(k,409)*y(k,126) & - + .610_r8*rxt(k,405)*y(k,196) + .440_r8*rxt(k,406)*y(k,197) - mat(k,744) = -(rxt(k,190)*y(k,124) + (rxt(k,191) + rxt(k,192) + rxt(k,193) & - ) * y(k,125) + rxt(k,194)*y(k,134) + rxt(k,202)*y(k,221) & - + rxt(k,574)*y(k,220)) - mat(k,1475) = -rxt(k,190)*y(k,112) - mat(k,1969) = -(rxt(k,191) + rxt(k,192) + rxt(k,193)) * y(k,112) - mat(k,1421) = -rxt(k,194)*y(k,112) - mat(k,1673) = -rxt(k,202)*y(k,112) - mat(k,684) = -rxt(k,574)*y(k,112) - mat(k,1807) = rxt(k,188)*y(k,212) + rxt(k,571)*y(k,215) - mat(k,1421) = mat(k,1421) + rxt(k,572)*y(k,215) - mat(k,702) = 1.100_r8*rxt(k,567)*y(k,213) + .200_r8*rxt(k,565)*y(k,214) - mat(k,413) = rxt(k,188)*y(k,133) - mat(k,571) = 1.100_r8*rxt(k,567)*y(k,199) - mat(k,692) = .200_r8*rxt(k,565)*y(k,199) - mat(k,388) = rxt(k,571)*y(k,133) + rxt(k,572)*y(k,134) - mat(k,1958) = rxt(k,209)*y(k,126) + mat(k,1214) = .200_r8*rxt(k,361)*y(k,199) + mat(k,1230) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,198) + .100_r8*rxt(k,431)*y(k,199) + mat(k,324) = -(rxt(k,403)*y(k,226)) + mat(k,1694) = -rxt(k,403)*y(k,97) + mat(k,2002) = .870_r8*rxt(k,414)*y(k,207) + mat(k,1862) = .950_r8*rxt(k,415)*y(k,207) + mat(k,1408) = rxt(k,410)*y(k,207) + mat(k,2212) = .750_r8*rxt(k,411)*y(k,207) + mat(k,1314) = .870_r8*rxt(k,414)*y(k,124) + .950_r8*rxt(k,415)*y(k,126) & + + rxt(k,410)*y(k,198) + .750_r8*rxt(k,411)*y(k,199) + mat(k,131) = -(rxt(k,404)*y(k,226)) + mat(k,1665) = -rxt(k,404)*y(k,98) + mat(k,730) = .600_r8*rxt(k,427)*y(k,226) + mat(k,1665) = mat(k,1665) + .600_r8*rxt(k,427)*y(k,103) + mat(k,880) = -(rxt(k,418)*y(k,126) + rxt(k,425)*y(k,135) + rxt(k,426) & + *y(k,226)) + mat(k,1866) = -rxt(k,418)*y(k,99) + mat(k,2372) = -rxt(k,425)*y(k,99) + mat(k,1753) = -rxt(k,426)*y(k,99) + mat(k,589) = -(rxt(k,416)*y(k,226)) + mat(k,1727) = -rxt(k,416)*y(k,100) + mat(k,2016) = .080_r8*rxt(k,408)*y(k,206) + mat(k,1287) = .080_r8*rxt(k,408)*y(k,124) + mat(k,556) = -(rxt(k,417)*y(k,226)) + mat(k,1724) = -rxt(k,417)*y(k,101) + mat(k,2014) = .080_r8*rxt(k,414)*y(k,207) + mat(k,1315) = .080_r8*rxt(k,414)*y(k,124) + mat(k,419) = -(rxt(k,424)*y(k,226)) + mat(k,1707) = -rxt(k,424)*y(k,102) + mat(k,2128) = rxt(k,421)*y(k,208) + mat(k,1243) = rxt(k,421)*y(k,90) + mat(k,731) = -(rxt(k,427)*y(k,226)) + mat(k,1742) = -rxt(k,427)*y(k,103) + mat(k,2151) = rxt(k,407)*y(k,206) + rxt(k,412)*y(k,207) + mat(k,1288) = rxt(k,407)*y(k,90) + mat(k,1317) = rxt(k,412)*y(k,90) + mat(k,74) = -(rxt(k,549)*y(k,226)) + mat(k,1658) = -rxt(k,549)*y(k,104) + mat(k,1267) = -(rxt(k,378)*y(k,135) + rxt(k,379)*y(k,226)) + mat(k,2392) = -rxt(k,378)*y(k,105) + mat(k,1782) = -rxt(k,379)*y(k,105) + mat(k,885) = .300_r8*rxt(k,425)*y(k,135) + mat(k,2054) = .360_r8*rxt(k,408)*y(k,206) + mat(k,1889) = .400_r8*rxt(k,409)*y(k,206) + mat(k,2392) = mat(k,2392) + .300_r8*rxt(k,425)*y(k,99) + mat(k,1419) = .390_r8*rxt(k,405)*y(k,206) + mat(k,2236) = .310_r8*rxt(k,406)*y(k,206) + mat(k,1295) = .360_r8*rxt(k,408)*y(k,124) + .400_r8*rxt(k,409)*y(k,126) & + + .390_r8*rxt(k,405)*y(k,198) + .310_r8*rxt(k,406)*y(k,199) + mat(k,314) = -(rxt(k,380)*y(k,226)) + mat(k,1692) = -rxt(k,380)*y(k,106) + mat(k,2118) = rxt(k,374)*y(k,211) + mat(k,1346) = rxt(k,374)*y(k,90) + mat(k,515) = -(rxt(k,389)*y(k,226)) + mat(k,1719) = -rxt(k,389)*y(k,107) + mat(k,2012) = .800_r8*rxt(k,398)*y(k,190) + mat(k,1035) = .800_r8*rxt(k,398)*y(k,124) + mat(k,319) = -(rxt(k,390)*y(k,226)) + mat(k,1693) = -rxt(k,390)*y(k,108) + mat(k,2119) = .800_r8*rxt(k,387)*y(k,215) + mat(k,695) = .800_r8*rxt(k,387)*y(k,90) + mat(k,580) = -(rxt(k,391)*y(k,226)) + mat(k,1726) = -rxt(k,391)*y(k,109) + mat(k,1821) = rxt(k,394)*y(k,213) + mat(k,1390) = rxt(k,394)*y(k,125) + mat(k,1016) = -(rxt(k,482)*y(k,126) + rxt(k,483)*y(k,135) + rxt(k,484) & + *y(k,226)) + mat(k,1870) = -rxt(k,482)*y(k,110) + mat(k,2376) = -rxt(k,483)*y(k,110) + mat(k,1763) = -rxt(k,484)*y(k,110) + mat(k,1374) = -(rxt(k,392)*y(k,135) + rxt(k,393)*y(k,226)) + mat(k,2397) = -rxt(k,392)*y(k,111) + mat(k,1787) = -rxt(k,393)*y(k,111) + mat(k,888) = .200_r8*rxt(k,425)*y(k,135) + mat(k,2059) = .560_r8*rxt(k,408)*y(k,206) + mat(k,1894) = .600_r8*rxt(k,409)*y(k,206) + mat(k,2397) = mat(k,2397) + .200_r8*rxt(k,425)*y(k,99) + mat(k,1424) = .610_r8*rxt(k,405)*y(k,206) + mat(k,2241) = .440_r8*rxt(k,406)*y(k,206) + mat(k,1299) = .560_r8*rxt(k,408)*y(k,124) + .600_r8*rxt(k,409)*y(k,126) & + + .610_r8*rxt(k,405)*y(k,198) + .440_r8*rxt(k,406)*y(k,199) + mat(k,969) = -(rxt(k,190)*y(k,124) + (rxt(k,191) + rxt(k,192) + rxt(k,193) & + ) * y(k,125) + rxt(k,194)*y(k,134) + rxt(k,202)*y(k,226) & + + rxt(k,588)*y(k,225)) + mat(k,2036) = -rxt(k,190)*y(k,112) + mat(k,1829) = -(rxt(k,191) + rxt(k,192) + rxt(k,193)) * y(k,112) + mat(k,1534) = -rxt(k,194)*y(k,112) + mat(k,1761) = -rxt(k,202)*y(k,112) + mat(k,853) = -rxt(k,588)*y(k,112) + mat(k,2306) = rxt(k,188)*y(k,217) + rxt(k,585)*y(k,220) + mat(k,1534) = mat(k,1534) + rxt(k,586)*y(k,220) + mat(k,864) = 1.100_r8*rxt(k,581)*y(k,218) + .200_r8*rxt(k,579)*y(k,219) + mat(k,528) = rxt(k,188)*y(k,133) + mat(k,679) = 1.100_r8*rxt(k,581)*y(k,201) + mat(k,845) = .200_r8*rxt(k,579)*y(k,201) + mat(k,504) = rxt(k,585)*y(k,133) + rxt(k,586)*y(k,134) + mat(k,254) = -((rxt(k,206) + rxt(k,207)) * y(k,222)) + mat(k,1620) = -(rxt(k,206) + rxt(k,207)) * y(k,113) + mat(k,963) = rxt(k,191)*y(k,125) + mat(k,1814) = rxt(k,191)*y(k,112) + mat(k,1815) = rxt(k,209)*y(k,126) mat(k,1860) = rxt(k,209)*y(k,125) - mat(k,267) = -(rxt(k,428)*y(k,221)) - mat(k,1624) = -rxt(k,428)*y(k,115) - mat(k,1115) = .200_r8*rxt(k,420)*y(k,197) - mat(k,1365) = .200_r8*rxt(k,420)*y(k,101) - mat(k,928) = -(rxt(k,429)*y(k,221)) - mat(k,1688) = -rxt(k,429)*y(k,116) - mat(k,1120) = rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126) + rxt(k,419)*y(k,196) & - + .800_r8*rxt(k,420)*y(k,197) - mat(k,1483) = rxt(k,422)*y(k,101) - mat(k,1874) = rxt(k,423)*y(k,101) - mat(k,1289) = rxt(k,419)*y(k,101) - mat(k,1376) = .800_r8*rxt(k,420)*y(k,101) - mat(k,49) = -(rxt(k,519)*y(k,221)) - mat(k,1590) = -rxt(k,519)*y(k,120) - mat(k,1507) = -(rxt(k,190)*y(k,112) + rxt(k,199)*y(k,126) + rxt(k,203) & - *y(k,203) + rxt(k,204)*y(k,135) + rxt(k,205)*y(k,133) + rxt(k,226) & - *y(k,59) + rxt(k,258)*y(k,19) + rxt(k,301)*y(k,197) + rxt(k,310) & - *y(k,204) + rxt(k,323)*y(k,193) + rxt(k,334)*y(k,196) + rxt(k,338) & - *y(k,202) + rxt(k,351)*y(k,194) + rxt(k,359)*y(k,224) + rxt(k,363) & - *y(k,225) + (rxt(k,369) + rxt(k,370)) * y(k,200) + (rxt(k,376) & - + rxt(k,377)) * y(k,207) + rxt(k,385)*y(k,209) + rxt(k,388) & - *y(k,211) + (rxt(k,398) + rxt(k,399)) * y(k,190) + rxt(k,408) & - *y(k,205) + rxt(k,414)*y(k,206) + rxt(k,422)*y(k,101) + rxt(k,433) & - *y(k,229) + rxt(k,437)*y(k,189) + rxt(k,440)*y(k,191) + rxt(k,445) & - *y(k,192) + rxt(k,447)*y(k,195) + rxt(k,451)*y(k,198) + rxt(k,454) & - *y(k,208) + rxt(k,457)*y(k,210) + rxt(k,460)*y(k,223) + rxt(k,467) & - *y(k,228) + rxt(k,473)*y(k,230) + rxt(k,476)*y(k,231) + rxt(k,487) & - *y(k,216) + rxt(k,492)*y(k,226) + rxt(k,497)*y(k,227) + rxt(k,576) & - *y(k,220)) - mat(k,747) = -rxt(k,190)*y(k,124) - mat(k,1900) = -rxt(k,199)*y(k,124) - mat(k,2103) = -rxt(k,203)*y(k,124) - mat(k,1778) = -rxt(k,204)*y(k,124) - mat(k,1819) = -rxt(k,205)*y(k,124) - mat(k,2130) = -rxt(k,226)*y(k,124) - mat(k,2008) = -rxt(k,258)*y(k,124) - mat(k,1398) = -rxt(k,301)*y(k,124) - mat(k,331) = -rxt(k,310)*y(k,124) - mat(k,844) = -rxt(k,323)*y(k,124) - mat(k,1305) = -rxt(k,334)*y(k,124) - mat(k,667) = -rxt(k,338)*y(k,124) - mat(k,733) = -rxt(k,351)*y(k,124) - mat(k,721) = -rxt(k,359)*y(k,124) - mat(k,1069) = -rxt(k,363)*y(k,124) - mat(k,462) = -(rxt(k,369) + rxt(k,370)) * y(k,124) - mat(k,1235) = -(rxt(k,376) + rxt(k,377)) * y(k,124) - mat(k,1274) = -rxt(k,385)*y(k,124) - mat(k,561) = -rxt(k,388)*y(k,124) - mat(k,886) = -(rxt(k,398) + rxt(k,399)) * y(k,124) - mat(k,1178) = -rxt(k,408)*y(k,124) - mat(k,1212) = -rxt(k,414)*y(k,124) - mat(k,1130) = -rxt(k,422)*y(k,124) - mat(k,1095) = -rxt(k,433)*y(k,124) - mat(k,402) = -rxt(k,437)*y(k,124) - mat(k,380) = -rxt(k,440)*y(k,124) - mat(k,325) = -rxt(k,445)*y(k,124) - mat(k,530) = -rxt(k,447)*y(k,124) - mat(k,649) = -rxt(k,451)*y(k,124) - mat(k,610) = -rxt(k,454)*y(k,124) - mat(k,807) = -rxt(k,457)*y(k,124) - mat(k,338) = -rxt(k,460)*y(k,124) - mat(k,624) = -rxt(k,467)*y(k,124) - mat(k,641) = -rxt(k,473)*y(k,124) - mat(k,395) = -rxt(k,476)*y(k,124) - mat(k,1053) = -rxt(k,487)*y(k,124) - mat(k,1034) = -rxt(k,492)*y(k,124) - mat(k,1014) = -rxt(k,497)*y(k,124) - mat(k,686) = -rxt(k,576)*y(k,124) - mat(k,747) = mat(k,747) + 2.000_r8*rxt(k,192)*y(k,125) + rxt(k,194)*y(k,134) & - + rxt(k,202)*y(k,221) - mat(k,1984) = 2.000_r8*rxt(k,192)*y(k,112) + rxt(k,195)*y(k,133) + rxt(k,511) & + mat(k,377) = -(rxt(k,428)*y(k,226)) + mat(k,1701) = -rxt(k,428)*y(k,115) + mat(k,2213) = .200_r8*rxt(k,420)*y(k,208) + mat(k,1242) = .200_r8*rxt(k,420)*y(k,199) + mat(k,1115) = -(rxt(k,429)*y(k,226)) + mat(k,1771) = -rxt(k,429)*y(k,116) + mat(k,2044) = rxt(k,422)*y(k,208) + mat(k,1878) = rxt(k,423)*y(k,208) + mat(k,1413) = rxt(k,419)*y(k,208) + mat(k,2227) = .800_r8*rxt(k,420)*y(k,208) + mat(k,1247) = rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126) + rxt(k,419)*y(k,198) & + + .800_r8*rxt(k,420)*y(k,199) + mat(k,96) = -(rxt(k,519)*y(k,226)) + mat(k,1662) = -rxt(k,519)*y(k,120) + mat(k,2073) = -(rxt(k,190)*y(k,112) + rxt(k,199)*y(k,126) + rxt(k,203) & + *y(k,90) + rxt(k,204)*y(k,135) + rxt(k,205)*y(k,133) + rxt(k,226) & + *y(k,59) + rxt(k,258)*y(k,19) + rxt(k,301)*y(k,199) + rxt(k,309) & + *y(k,205) + rxt(k,322)*y(k,195) + rxt(k,333)*y(k,198) + rxt(k,337) & + *y(k,204) + rxt(k,350)*y(k,196) + rxt(k,359)*y(k,229) + rxt(k,363) & + *y(k,230) + (rxt(k,369) + rxt(k,370)) * y(k,202) + (rxt(k,376) & + + rxt(k,377)) * y(k,211) + rxt(k,385)*y(k,213) + rxt(k,388) & + *y(k,215) + (rxt(k,398) + rxt(k,399)) * y(k,190) + rxt(k,408) & + *y(k,206) + rxt(k,414)*y(k,207) + rxt(k,422)*y(k,208) + rxt(k,433) & + *y(k,235) + rxt(k,437)*y(k,189) + rxt(k,440)*y(k,192) + rxt(k,445) & + *y(k,194) + rxt(k,447)*y(k,197) + rxt(k,451)*y(k,200) + rxt(k,454) & + *y(k,212) + rxt(k,457)*y(k,214) + rxt(k,460)*y(k,228) + rxt(k,467) & + *y(k,233) + rxt(k,473)*y(k,236) + rxt(k,476)*y(k,238) + rxt(k,487) & + *y(k,221) + rxt(k,492)*y(k,231) + rxt(k,497)*y(k,232) + rxt(k,590) & + *y(k,225)) + mat(k,976) = -rxt(k,190)*y(k,124) + mat(k,1909) = -rxt(k,199)*y(k,124) + mat(k,2202) = -rxt(k,203)*y(k,124) + mat(k,2412) = -rxt(k,204)*y(k,124) + mat(k,2322) = -rxt(k,205)*y(k,124) + mat(k,1597) = -rxt(k,226)*y(k,124) + mat(k,1571) = -rxt(k,258)*y(k,124) + mat(k,2254) = -rxt(k,301)*y(k,124) + mat(k,442) = -rxt(k,309)*y(k,124) + mat(k,904) = -rxt(k,322)*y(k,124) + mat(k,1433) = -rxt(k,333)*y(k,124) + mat(k,800) = -rxt(k,337)*y(k,124) + mat(k,939) = -rxt(k,350)*y(k,124) + mat(k,822) = -rxt(k,359)*y(k,124) + mat(k,1220) = -rxt(k,363)*y(k,124) + mat(k,577) = -(rxt(k,369) + rxt(k,370)) * y(k,124) + mat(k,1362) = -(rxt(k,376) + rxt(k,377)) * y(k,124) + mat(k,1402) = -rxt(k,385)*y(k,124) + mat(k,701) = -rxt(k,388)*y(k,124) + mat(k,1047) = -(rxt(k,398) + rxt(k,399)) * y(k,124) + mat(k,1307) = -rxt(k,408)*y(k,124) + mat(k,1340) = -rxt(k,414)*y(k,124) + mat(k,1261) = -rxt(k,422)*y(k,124) + mat(k,1238) = -rxt(k,433)*y(k,124) + mat(k,525) = -rxt(k,437)*y(k,124) + mat(k,491) = -rxt(k,440)*y(k,124) + mat(k,437) = -rxt(k,445)*y(k,124) + mat(k,636) = -rxt(k,447)*y(k,124) + mat(k,781) = -rxt(k,451)*y(k,124) + mat(k,742) = -rxt(k,454)*y(k,124) + mat(k,919) = -rxt(k,457)*y(k,124) + mat(k,456) = -rxt(k,460)*y(k,124) + mat(k,757) = -rxt(k,467)*y(k,124) + mat(k,774) = -rxt(k,473)*y(k,124) + mat(k,513) = -rxt(k,476)*y(k,124) + mat(k,1096) = -rxt(k,487)*y(k,124) + mat(k,1183) = -rxt(k,492)*y(k,124) + mat(k,1066) = -rxt(k,497)*y(k,124) + mat(k,856) = -rxt(k,590)*y(k,124) + mat(k,976) = mat(k,976) + 2.000_r8*rxt(k,192)*y(k,125) + rxt(k,194)*y(k,134) & + + rxt(k,202)*y(k,226) + mat(k,257) = 2.000_r8*rxt(k,206)*y(k,222) + mat(k,1849) = 2.000_r8*rxt(k,192)*y(k,112) + rxt(k,195)*y(k,133) + rxt(k,512) & *y(k,151) - mat(k,1819) = mat(k,1819) + rxt(k,195)*y(k,125) - mat(k,1428) = rxt(k,194)*y(k,112) + rxt(k,189)*y(k,212) - mat(k,1321) = rxt(k,511)*y(k,125) - mat(k,415) = rxt(k,189)*y(k,134) - mat(k,1716) = rxt(k,202)*y(k,112) + mat(k,2322) = mat(k,2322) + rxt(k,195)*y(k,125) + mat(k,1547) = rxt(k,194)*y(k,112) + rxt(k,189)*y(k,217) + mat(k,1482) = rxt(k,512)*y(k,125) + mat(k,531) = rxt(k,189)*y(k,134) + mat(k,1639) = 2.000_r8*rxt(k,206)*y(k,113) + mat(k,1804) = rxt(k,202)*y(k,112) end do - end subroutine nlnmat04 - subroutine nlnmat05( avec_len, mat, y, rxt ) + end subroutine nlnmat05 + subroutine nlnmat06( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -936,263 +1311,264 @@ subroutine nlnmat05( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,1994) = -((rxt(k,191) + rxt(k,192) + rxt(k,193)) * y(k,112) + (rxt(k,195) & + mat(k,1845) = -((rxt(k,191) + rxt(k,192) + rxt(k,193)) * y(k,112) + (rxt(k,195) & + rxt(k,197)) * y(k,133) + rxt(k,196)*y(k,135) + rxt(k,208) & - *y(k,203) + rxt(k,209)*y(k,126) + rxt(k,210)*y(k,221) + rxt(k,228) & - *y(k,59) + rxt(k,259)*y(k,19) + rxt(k,345)*y(k,196) + rxt(k,394) & - *y(k,209) + rxt(k,452)*y(k,198) + rxt(k,455)*y(k,208) + rxt(k,458) & - *y(k,210) + rxt(k,462)*y(k,142) + rxt(k,465)*y(k,189) + rxt(k,511) & + *y(k,90) + rxt(k,209)*y(k,126) + rxt(k,210)*y(k,226) + rxt(k,228) & + *y(k,59) + rxt(k,259)*y(k,19) + rxt(k,344)*y(k,198) + rxt(k,394) & + *y(k,213) + rxt(k,452)*y(k,200) + rxt(k,455)*y(k,212) + rxt(k,458) & + *y(k,214) + rxt(k,462)*y(k,142) + rxt(k,465)*y(k,189) + rxt(k,512) & *y(k,151)) - mat(k,752) = -(rxt(k,191) + rxt(k,192) + rxt(k,193)) * y(k,125) - mat(k,1829) = -(rxt(k,195) + rxt(k,197)) * y(k,125) - mat(k,1788) = -rxt(k,196)*y(k,125) - mat(k,2113) = -rxt(k,208)*y(k,125) - mat(k,1910) = -rxt(k,209)*y(k,125) - mat(k,1726) = -rxt(k,210)*y(k,125) - mat(k,2140) = -rxt(k,228)*y(k,125) - mat(k,2018) = -rxt(k,259)*y(k,125) - mat(k,1312) = -rxt(k,345)*y(k,125) - mat(k,1281) = -rxt(k,394)*y(k,125) - mat(k,651) = -rxt(k,452)*y(k,125) - mat(k,611) = -rxt(k,455)*y(k,125) - mat(k,809) = -rxt(k,458)*y(k,125) - mat(k,360) = -rxt(k,462)*y(k,125) - mat(k,404) = -rxt(k,465)*y(k,125) - mat(k,1327) = -rxt(k,511)*y(k,125) - mat(k,544) = rxt(k,396)*y(k,221) - mat(k,266) = rxt(k,367)*y(k,126) - mat(k,2018) = mat(k,2018) + rxt(k,258)*y(k,124) - mat(k,2140) = mat(k,2140) + rxt(k,226)*y(k,124) - mat(k,365) = rxt(k,187)*y(k,221) - mat(k,512) = .700_r8*rxt(k,416)*y(k,221) - mat(k,1136) = rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126) - mat(k,1517) = rxt(k,258)*y(k,19) + rxt(k,226)*y(k,59) + rxt(k,422)*y(k,101) & + mat(k,975) = -(rxt(k,191) + rxt(k,192) + rxt(k,193)) * y(k,125) + mat(k,2318) = -(rxt(k,195) + rxt(k,197)) * y(k,125) + mat(k,2408) = -rxt(k,196)*y(k,125) + mat(k,2198) = -rxt(k,208)*y(k,125) + mat(k,1905) = -rxt(k,209)*y(k,125) + mat(k,1800) = -rxt(k,210)*y(k,125) + mat(k,1593) = -rxt(k,228)*y(k,125) + mat(k,1567) = -rxt(k,259)*y(k,125) + mat(k,1430) = -rxt(k,344)*y(k,125) + mat(k,1399) = -rxt(k,394)*y(k,125) + mat(k,780) = -rxt(k,452)*y(k,125) + mat(k,741) = -rxt(k,455)*y(k,125) + mat(k,918) = -rxt(k,458)*y(k,125) + mat(k,468) = -rxt(k,462)*y(k,125) + mat(k,524) = -rxt(k,465)*y(k,125) + mat(k,1480) = -rxt(k,512)*y(k,125) + mat(k,647) = rxt(k,396)*y(k,226) + mat(k,358) = rxt(k,367)*y(k,126) + mat(k,1567) = mat(k,1567) + rxt(k,258)*y(k,124) + mat(k,1593) = mat(k,1593) + rxt(k,226)*y(k,124) + mat(k,2198) = mat(k,2198) + rxt(k,203)*y(k,124) + rxt(k,198)*y(k,126) + mat(k,496) = rxt(k,187)*y(k,226) + mat(k,594) = .700_r8*rxt(k,416)*y(k,226) + mat(k,2069) = rxt(k,258)*y(k,19) + rxt(k,226)*y(k,59) + rxt(k,203)*y(k,90) & + 2.000_r8*rxt(k,199)*y(k,126) + rxt(k,205)*y(k,133) & + rxt(k,204)*y(k,135) + rxt(k,437)*y(k,189) + rxt(k,398) & - *y(k,190) + rxt(k,440)*y(k,191) + rxt(k,445)*y(k,192) & - + rxt(k,323)*y(k,193) + rxt(k,351)*y(k,194) + rxt(k,447) & - *y(k,195) + rxt(k,334)*y(k,196) + rxt(k,301)*y(k,197) & - + rxt(k,451)*y(k,198) + rxt(k,369)*y(k,200) + rxt(k,338) & - *y(k,202) + rxt(k,203)*y(k,203) + rxt(k,310)*y(k,204) & - + .920_r8*rxt(k,408)*y(k,205) + .920_r8*rxt(k,414)*y(k,206) & - + rxt(k,376)*y(k,207) + rxt(k,454)*y(k,208) + rxt(k,385) & - *y(k,209) + rxt(k,457)*y(k,210) + rxt(k,388)*y(k,211) & - + 1.600_r8*rxt(k,487)*y(k,216) + rxt(k,460)*y(k,223) & - + rxt(k,359)*y(k,224) + rxt(k,363)*y(k,225) + .900_r8*rxt(k,492) & - *y(k,226) + .800_r8*rxt(k,497)*y(k,227) + rxt(k,467)*y(k,228) & - + rxt(k,433)*y(k,229) + rxt(k,473)*y(k,230) + rxt(k,476) & - *y(k,231) - mat(k,1910) = mat(k,1910) + rxt(k,367)*y(k,16) + rxt(k,423)*y(k,101) & + *y(k,190) + rxt(k,440)*y(k,192) + rxt(k,445)*y(k,194) & + + rxt(k,322)*y(k,195) + rxt(k,350)*y(k,196) + rxt(k,447) & + *y(k,197) + rxt(k,333)*y(k,198) + rxt(k,301)*y(k,199) & + + rxt(k,451)*y(k,200) + rxt(k,369)*y(k,202) + rxt(k,337) & + *y(k,204) + rxt(k,309)*y(k,205) + .920_r8*rxt(k,408)*y(k,206) & + + .920_r8*rxt(k,414)*y(k,207) + rxt(k,422)*y(k,208) + rxt(k,376) & + *y(k,211) + rxt(k,454)*y(k,212) + rxt(k,385)*y(k,213) & + + rxt(k,457)*y(k,214) + rxt(k,388)*y(k,215) & + + 1.600_r8*rxt(k,487)*y(k,221) + rxt(k,460)*y(k,228) & + + rxt(k,359)*y(k,229) + rxt(k,363)*y(k,230) + .900_r8*rxt(k,492) & + *y(k,231) + .800_r8*rxt(k,497)*y(k,232) + rxt(k,467)*y(k,233) & + + rxt(k,433)*y(k,235) + rxt(k,473)*y(k,236) + rxt(k,476) & + *y(k,238) + mat(k,1905) = mat(k,1905) + rxt(k,367)*y(k,16) + rxt(k,198)*y(k,90) & + 2.000_r8*rxt(k,199)*y(k,124) + rxt(k,200)*y(k,133) & - + rxt(k,198)*y(k,203) + rxt(k,409)*y(k,205) + rxt(k,415) & - *y(k,206) + rxt(k,375)*y(k,207) + rxt(k,386)*y(k,209) & - + 2.000_r8*rxt(k,488)*y(k,216) + rxt(k,201)*y(k,221) & - + rxt(k,434)*y(k,229) - mat(k,774) = rxt(k,357)*y(k,221) - mat(k,1829) = mat(k,1829) + rxt(k,205)*y(k,124) + rxt(k,200)*y(k,126) - mat(k,1788) = mat(k,1788) + rxt(k,204)*y(k,124) - mat(k,525) = rxt(k,494)*y(k,221) - mat(k,404) = mat(k,404) + rxt(k,437)*y(k,124) - mat(k,889) = rxt(k,398)*y(k,124) - mat(k,382) = rxt(k,440)*y(k,124) - mat(k,327) = rxt(k,445)*y(k,124) - mat(k,847) = rxt(k,323)*y(k,124) - mat(k,736) = rxt(k,351)*y(k,124) - mat(k,533) = rxt(k,447)*y(k,124) - mat(k,1312) = mat(k,1312) + rxt(k,334)*y(k,124) - mat(k,1406) = rxt(k,301)*y(k,124) + .500_r8*rxt(k,485)*y(k,216) - mat(k,651) = mat(k,651) + rxt(k,451)*y(k,124) - mat(k,464) = rxt(k,369)*y(k,124) - mat(k,670) = rxt(k,338)*y(k,124) - mat(k,2113) = mat(k,2113) + rxt(k,203)*y(k,124) + rxt(k,198)*y(k,126) - mat(k,333) = rxt(k,310)*y(k,124) - mat(k,1185) = .920_r8*rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126) - mat(k,1219) = .920_r8*rxt(k,414)*y(k,124) + rxt(k,415)*y(k,126) - mat(k,1241) = rxt(k,376)*y(k,124) + rxt(k,375)*y(k,126) - mat(k,611) = mat(k,611) + rxt(k,454)*y(k,124) - mat(k,1281) = mat(k,1281) + rxt(k,385)*y(k,124) + rxt(k,386)*y(k,126) - mat(k,809) = mat(k,809) + rxt(k,457)*y(k,124) - mat(k,563) = rxt(k,388)*y(k,124) - mat(k,1059) = 1.600_r8*rxt(k,487)*y(k,124) + 2.000_r8*rxt(k,488)*y(k,126) & - + .500_r8*rxt(k,485)*y(k,197) - mat(k,1726) = mat(k,1726) + rxt(k,396)*y(k,1) + rxt(k,187)*y(k,90) & - + .700_r8*rxt(k,416)*y(k,99) + rxt(k,201)*y(k,126) + rxt(k,357) & + + rxt(k,409)*y(k,206) + rxt(k,415)*y(k,207) + rxt(k,423) & + *y(k,208) + rxt(k,375)*y(k,211) + rxt(k,386)*y(k,213) & + + 2.000_r8*rxt(k,488)*y(k,221) + rxt(k,201)*y(k,226) & + + rxt(k,434)*y(k,235) + mat(k,875) = rxt(k,357)*y(k,226) + mat(k,2318) = mat(k,2318) + rxt(k,205)*y(k,124) + rxt(k,200)*y(k,126) + mat(k,2408) = mat(k,2408) + rxt(k,204)*y(k,124) + mat(k,628) = rxt(k,494)*y(k,226) + mat(k,524) = mat(k,524) + rxt(k,437)*y(k,124) + mat(k,1046) = rxt(k,398)*y(k,124) + mat(k,490) = rxt(k,440)*y(k,124) + mat(k,436) = rxt(k,445)*y(k,124) + mat(k,903) = rxt(k,322)*y(k,124) + mat(k,938) = rxt(k,350)*y(k,124) + mat(k,635) = rxt(k,447)*y(k,124) + mat(k,1430) = mat(k,1430) + rxt(k,333)*y(k,124) + mat(k,2250) = rxt(k,301)*y(k,124) + .500_r8*rxt(k,485)*y(k,221) + mat(k,780) = mat(k,780) + rxt(k,451)*y(k,124) + mat(k,576) = rxt(k,369)*y(k,124) + mat(k,799) = rxt(k,337)*y(k,124) + mat(k,441) = rxt(k,309)*y(k,124) + mat(k,1304) = .920_r8*rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126) + mat(k,1337) = .920_r8*rxt(k,414)*y(k,124) + rxt(k,415)*y(k,126) + mat(k,1258) = rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126) + mat(k,1359) = rxt(k,376)*y(k,124) + rxt(k,375)*y(k,126) + mat(k,741) = mat(k,741) + rxt(k,454)*y(k,124) + mat(k,1399) = mat(k,1399) + rxt(k,385)*y(k,124) + rxt(k,386)*y(k,126) + mat(k,918) = mat(k,918) + rxt(k,457)*y(k,124) + mat(k,700) = rxt(k,388)*y(k,124) + mat(k,1093) = 1.600_r8*rxt(k,487)*y(k,124) + 2.000_r8*rxt(k,488)*y(k,126) & + + .500_r8*rxt(k,485)*y(k,199) + mat(k,1800) = mat(k,1800) + rxt(k,396)*y(k,1) + rxt(k,187)*y(k,91) & + + .700_r8*rxt(k,416)*y(k,100) + rxt(k,201)*y(k,126) + rxt(k,357) & *y(k,127) + rxt(k,494)*y(k,176) - mat(k,340) = rxt(k,460)*y(k,124) - mat(k,724) = rxt(k,359)*y(k,124) - mat(k,1072) = rxt(k,363)*y(k,124) - mat(k,1039) = .900_r8*rxt(k,492)*y(k,124) - mat(k,1020) = .800_r8*rxt(k,497)*y(k,124) - mat(k,626) = rxt(k,467)*y(k,124) - mat(k,1100) = rxt(k,433)*y(k,124) + rxt(k,434)*y(k,126) - mat(k,643) = rxt(k,473)*y(k,124) - mat(k,397) = rxt(k,476)*y(k,124) - mat(k,1907) = -(rxt(k,198)*y(k,203) + rxt(k,199)*y(k,124) + rxt(k,200) & - *y(k,133) + rxt(k,201)*y(k,221) + rxt(k,209)*y(k,125) + rxt(k,295) & - *y(k,42) + rxt(k,328)*y(k,45) + rxt(k,347)*y(k,29) + rxt(k,354) & - *y(k,49) + rxt(k,367)*y(k,16) + rxt(k,375)*y(k,207) + rxt(k,386) & - *y(k,209) + rxt(k,409)*y(k,205) + rxt(k,415)*y(k,206) + rxt(k,418) & - *y(k,98) + rxt(k,423)*y(k,101) + rxt(k,434)*y(k,229) + rxt(k,479) & - *y(k,6) + rxt(k,482)*y(k,110) + rxt(k,488)*y(k,216) + rxt(k,499) & + mat(k,455) = rxt(k,460)*y(k,124) + mat(k,821) = rxt(k,359)*y(k,124) + mat(k,1219) = rxt(k,363)*y(k,124) + mat(k,1181) = .900_r8*rxt(k,492)*y(k,124) + mat(k,1064) = .800_r8*rxt(k,497)*y(k,124) + mat(k,756) = rxt(k,467)*y(k,124) + mat(k,1236) = rxt(k,433)*y(k,124) + rxt(k,434)*y(k,126) + mat(k,773) = rxt(k,473)*y(k,124) + mat(k,512) = rxt(k,476)*y(k,124) + mat(k,1906) = -(rxt(k,198)*y(k,90) + rxt(k,199)*y(k,124) + rxt(k,200) & + *y(k,133) + rxt(k,201)*y(k,226) + rxt(k,209)*y(k,125) + rxt(k,295) & + *y(k,42) + rxt(k,327)*y(k,45) + rxt(k,346)*y(k,29) + rxt(k,353) & + *y(k,49) + rxt(k,367)*y(k,16) + rxt(k,375)*y(k,211) + rxt(k,386) & + *y(k,213) + rxt(k,409)*y(k,206) + rxt(k,415)*y(k,207) + rxt(k,418) & + *y(k,99) + rxt(k,423)*y(k,208) + rxt(k,434)*y(k,235) + rxt(k,479) & + *y(k,6) + rxt(k,482)*y(k,110) + rxt(k,488)*y(k,221) + rxt(k,499) & *y(k,178) + rxt(k,502)*y(k,67)) - mat(k,2110) = -rxt(k,198)*y(k,126) - mat(k,1514) = -rxt(k,199)*y(k,126) - mat(k,1826) = -rxt(k,200)*y(k,126) - mat(k,1723) = -rxt(k,201)*y(k,126) - mat(k,1991) = -rxt(k,209)*y(k,126) - mat(k,1850) = -rxt(k,295)*y(k,126) - mat(k,1080) = -rxt(k,328)*y(k,126) - mat(k,955) = -rxt(k,347)*y(k,126) - mat(k,1155) = -rxt(k,354)*y(k,126) - mat(k,265) = -rxt(k,367)*y(k,126) - mat(k,1238) = -rxt(k,375)*y(k,126) - mat(k,1278) = -rxt(k,386)*y(k,126) - mat(k,1182) = -rxt(k,409)*y(k,126) - mat(k,1216) = -rxt(k,415)*y(k,126) - mat(k,794) = -rxt(k,418)*y(k,126) - mat(k,1133) = -rxt(k,423)*y(k,126) - mat(k,1098) = -rxt(k,434)*y(k,126) - mat(k,872) = -rxt(k,479)*y(k,126) - mat(k,834) = -rxt(k,482)*y(k,126) - mat(k,1056) = -rxt(k,488)*y(k,126) - mat(k,922) = -rxt(k,499)*y(k,126) - mat(k,194) = -rxt(k,502)*y(k,126) - mat(k,442) = rxt(k,260)*y(k,133) - mat(k,1549) = rxt(k,227)*y(k,60) - mat(k,911) = rxt(k,227)*y(k,56) + rxt(k,229)*y(k,133) + rxt(k,230)*y(k,221) - mat(k,677) = rxt(k,274)*y(k,89) - mat(k,1949) = rxt(k,274)*y(k,73) + rxt(k,211)*y(k,221) - mat(k,471) = .500_r8*rxt(k,391)*y(k,221) - mat(k,1991) = mat(k,1991) + rxt(k,197)*y(k,133) + rxt(k,196)*y(k,135) - mat(k,1826) = mat(k,1826) + rxt(k,260)*y(k,20) + rxt(k,229)*y(k,60) & + mat(k,2199) = -rxt(k,198)*y(k,126) + mat(k,2070) = -rxt(k,199)*y(k,126) + mat(k,2319) = -rxt(k,200)*y(k,126) + mat(k,1801) = -rxt(k,201)*y(k,126) + mat(k,1846) = -rxt(k,209)*y(k,126) + mat(k,2345) = -rxt(k,295)*y(k,126) + mat(k,1153) = -rxt(k,327)*y(k,126) + mat(k,1141) = -rxt(k,346)*y(k,126) + mat(k,1283) = -rxt(k,353)*y(k,126) + mat(k,359) = -rxt(k,367)*y(k,126) + mat(k,1360) = -rxt(k,375)*y(k,126) + mat(k,1400) = -rxt(k,386)*y(k,126) + mat(k,1305) = -rxt(k,409)*y(k,126) + mat(k,1338) = -rxt(k,415)*y(k,126) + mat(k,891) = -rxt(k,418)*y(k,126) + mat(k,1259) = -rxt(k,423)*y(k,126) + mat(k,1237) = -rxt(k,434)*y(k,126) + mat(k,1002) = -rxt(k,479)*y(k,126) + mat(k,1030) = -rxt(k,482)*y(k,126) + mat(k,1094) = -rxt(k,488)*y(k,126) + mat(k,1076) = -rxt(k,499)*y(k,126) + mat(k,311) = -rxt(k,502)*y(k,126) + mat(k,569) = rxt(k,260)*y(k,133) + mat(k,1952) = rxt(k,227)*y(k,60) + mat(k,958) = rxt(k,227)*y(k,56) + rxt(k,229)*y(k,133) + rxt(k,230)*y(k,226) + mat(k,926) = rxt(k,274)*y(k,89) + mat(k,1975) = rxt(k,274)*y(k,73) + rxt(k,211)*y(k,226) + mat(k,586) = .500_r8*rxt(k,391)*y(k,226) + mat(k,1846) = mat(k,1846) + rxt(k,197)*y(k,133) + rxt(k,196)*y(k,135) + mat(k,2319) = mat(k,2319) + rxt(k,260)*y(k,20) + rxt(k,229)*y(k,60) & + rxt(k,197)*y(k,125) - mat(k,1785) = rxt(k,196)*y(k,125) - mat(k,355) = rxt(k,343)*y(k,221) - mat(k,1723) = mat(k,1723) + rxt(k,230)*y(k,60) + rxt(k,211)*y(k,89) & - + .500_r8*rxt(k,391)*y(k,109) + rxt(k,343)*y(k,140) - mat(k,769) = -(rxt(k,357)*y(k,221)) - mat(k,1676) = -rxt(k,357)*y(k,127) - mat(k,942) = rxt(k,347)*y(k,126) - mat(k,423) = .500_r8*rxt(k,417)*y(k,221) - mat(k,299) = rxt(k,424)*y(k,221) - mat(k,268) = rxt(k,428)*y(k,221) - mat(k,925) = rxt(k,429)*y(k,221) - mat(k,1865) = rxt(k,347)*y(k,29) - mat(k,1676) = mat(k,1676) + .500_r8*rxt(k,417)*y(k,100) + rxt(k,424)*y(k,102) & + mat(k,2409) = rxt(k,196)*y(k,125) + mat(k,537) = rxt(k,342)*y(k,226) + mat(k,1801) = mat(k,1801) + rxt(k,230)*y(k,60) + rxt(k,211)*y(k,89) & + + .500_r8*rxt(k,391)*y(k,109) + rxt(k,342)*y(k,140) + mat(k,871) = -(rxt(k,357)*y(k,226)) + mat(k,1752) = -rxt(k,357)*y(k,127) + mat(k,1129) = rxt(k,346)*y(k,126) + mat(k,557) = .500_r8*rxt(k,417)*y(k,226) + mat(k,421) = rxt(k,424)*y(k,226) + mat(k,378) = rxt(k,428)*y(k,226) + mat(k,1112) = rxt(k,429)*y(k,226) + mat(k,1865) = rxt(k,346)*y(k,29) + mat(k,1752) = mat(k,1752) + .500_r8*rxt(k,417)*y(k,101) + rxt(k,424)*y(k,102) & + rxt(k,428)*y(k,115) + rxt(k,429)*y(k,116) - mat(k,285) = -(rxt(k,489)*y(k,221)) - mat(k,1626) = -rxt(k,489)*y(k,128) - mat(k,2032) = rxt(k,486)*y(k,216) - mat(k,1042) = rxt(k,486)*y(k,203) - mat(k,1824) = -(rxt(k,167)*y(k,135) + 4._r8*rxt(k,168)*y(k,133) + rxt(k,169) & + mat(k,395) = -(rxt(k,489)*y(k,226)) + mat(k,1703) = -rxt(k,489)*y(k,128) + mat(k,2124) = rxt(k,486)*y(k,221) + mat(k,1084) = rxt(k,486)*y(k,90) + mat(k,2327) = -(rxt(k,167)*y(k,135) + 4._r8*rxt(k,168)*y(k,133) + rxt(k,169) & *y(k,134) + rxt(k,170)*y(k,77) + rxt(k,171)*y(k,79) + rxt(k,176) & - *y(k,203) + rxt(k,182)*y(k,221) + (rxt(k,195) + rxt(k,197) & + *y(k,90) + rxt(k,182)*y(k,226) + (rxt(k,195) + rxt(k,197) & ) * y(k,125) + rxt(k,200)*y(k,126) + rxt(k,205)*y(k,124) & + rxt(k,229)*y(k,60) + rxt(k,231)*y(k,59) + rxt(k,234)*y(k,85) & - + rxt(k,237)*y(k,92) + rxt(k,260)*y(k,20) + rxt(k,261)*y(k,19) & - + rxt(k,263)*y(k,81) + rxt(k,265)*y(k,91) + rxt(k,296)*y(k,42) & - + rxt(k,504)*y(k,138) + (rxt(k,569) + rxt(k,570)) * y(k,213) & - + rxt(k,571)*y(k,215)) - mat(k,1783) = -rxt(k,167)*y(k,133) - mat(k,1433) = -rxt(k,169)*y(k,133) - mat(k,1110) = -rxt(k,170)*y(k,133) - mat(k,478) = -rxt(k,171)*y(k,133) - mat(k,2108) = -rxt(k,176)*y(k,133) - mat(k,1721) = -rxt(k,182)*y(k,133) - mat(k,1989) = -(rxt(k,195) + rxt(k,197)) * y(k,133) - mat(k,1905) = -rxt(k,200)*y(k,133) - mat(k,1512) = -rxt(k,205)*y(k,133) - mat(k,910) = -rxt(k,229)*y(k,133) - mat(k,2135) = -rxt(k,231)*y(k,133) - mat(k,1342) = -rxt(k,234)*y(k,133) - mat(k,766) = -rxt(k,237)*y(k,133) - mat(k,441) = -rxt(k,260)*y(k,133) - mat(k,2013) = -rxt(k,261)*y(k,133) - mat(k,757) = -rxt(k,263)*y(k,133) - mat(k,659) = -rxt(k,265)*y(k,133) - mat(k,1848) = -rxt(k,296)*y(k,133) - mat(k,257) = -rxt(k,504)*y(k,133) - mat(k,576) = -(rxt(k,569) + rxt(k,570)) * y(k,133) - mat(k,390) = -rxt(k,571)*y(k,133) - mat(k,1925) = rxt(k,174)*y(k,203) - mat(k,750) = rxt(k,190)*y(k,124) + rxt(k,191)*y(k,125) + rxt(k,194)*y(k,134) & - + rxt(k,574)*y(k,220) - mat(k,1512) = mat(k,1512) + rxt(k,190)*y(k,112) - mat(k,1989) = mat(k,1989) + rxt(k,191)*y(k,112) - mat(k,1433) = mat(k,1433) + rxt(k,194)*y(k,112) + rxt(k,506)*y(k,149) & - + rxt(k,512)*y(k,151) + rxt(k,573)*y(k,215) + (rxt(k,156) & - +rxt(k,157))*y(k,217) + rxt(k,579)*y(k,222) - mat(k,605) = rxt(k,506)*y(k,134) - mat(k,1325) = rxt(k,512)*y(k,134) - mat(k,707) = rxt(k,565)*y(k,214) + 1.150_r8*rxt(k,566)*y(k,220) - mat(k,2108) = mat(k,2108) + rxt(k,174)*y(k,76) - mat(k,696) = rxt(k,565)*y(k,199) - mat(k,390) = mat(k,390) + rxt(k,573)*y(k,134) - mat(k,1573) = (rxt(k,156)+rxt(k,157))*y(k,134) - mat(k,688) = rxt(k,574)*y(k,112) + 1.150_r8*rxt(k,566)*y(k,199) - mat(k,1721) = mat(k,1721) + 2.000_r8*rxt(k,184)*y(k,221) - mat(k,520) = rxt(k,579)*y(k,134) - mat(k,1427) = -(rxt(k,156)*y(k,217) + rxt(k,161)*y(k,218) + rxt(k,169) & - *y(k,133) + rxt(k,175)*y(k,76) + rxt(k,189)*y(k,212) + rxt(k,194) & - *y(k,112) + rxt(k,340)*y(k,201) + rxt(k,506)*y(k,149) + rxt(k,512) & - *y(k,151) + rxt(k,568)*y(k,213) + (rxt(k,572) + rxt(k,573) & - ) * y(k,215) + rxt(k,579)*y(k,222)) - mat(k,1567) = -rxt(k,156)*y(k,134) - mat(k,75) = -rxt(k,161)*y(k,134) - mat(k,1818) = -rxt(k,169)*y(k,134) - mat(k,1919) = -rxt(k,175)*y(k,134) - mat(k,414) = -rxt(k,189)*y(k,134) - mat(k,746) = -rxt(k,194)*y(k,134) - mat(k,347) = -rxt(k,340)*y(k,134) - mat(k,602) = -rxt(k,506)*y(k,134) - mat(k,1320) = -rxt(k,512)*y(k,134) - mat(k,573) = -rxt(k,568)*y(k,134) - mat(k,389) = -(rxt(k,572) + rxt(k,573)) * y(k,134) - mat(k,519) = -rxt(k,579)*y(k,134) - mat(k,1353) = rxt(k,252)*y(k,135) + rxt(k,251)*y(k,203) - mat(k,2007) = 2.000_r8*rxt(k,253)*y(k,19) + (rxt(k,255)+rxt(k,256))*y(k,59) & - + rxt(k,261)*y(k,133) + rxt(k,257)*y(k,203) - mat(k,1541) = rxt(k,220)*y(k,135) + rxt(k,218)*y(k,203) - mat(k,2129) = (rxt(k,255)+rxt(k,256))*y(k,19) + (2.000_r8*rxt(k,222) & - +2.000_r8*rxt(k,223))*y(k,59) + rxt(k,231)*y(k,133) & - + rxt(k,225)*y(k,203) + rxt(k,233)*y(k,221) - mat(k,1919) = mat(k,1919) + rxt(k,178)*y(k,135) + rxt(k,172)*y(k,203) - mat(k,362) = rxt(k,187)*y(k,221) - mat(k,746) = mat(k,746) + rxt(k,193)*y(k,125) - mat(k,1506) = rxt(k,204)*y(k,135) + rxt(k,576)*y(k,220) - mat(k,1983) = rxt(k,193)*y(k,112) + rxt(k,195)*y(k,133) + rxt(k,196)*y(k,135) - mat(k,1899) = rxt(k,200)*y(k,133) + rxt(k,198)*y(k,203) - mat(k,1818) = mat(k,1818) + rxt(k,261)*y(k,19) + rxt(k,231)*y(k,59) & - + rxt(k,195)*y(k,125) + rxt(k,200)*y(k,126) & + + rxt(k,237)*y(k,93) + rxt(k,260)*y(k,20) + rxt(k,261)*y(k,19) & + + rxt(k,263)*y(k,81) + rxt(k,265)*y(k,92) + rxt(k,296)*y(k,42) & + + rxt(k,504)*y(k,138) + (rxt(k,583) + rxt(k,584)) * y(k,218) & + + rxt(k,585)*y(k,220)) + mat(k,2417) = -rxt(k,167)*y(k,133) + mat(k,1550) = -rxt(k,169)*y(k,133) + mat(k,1469) = -rxt(k,170)*y(k,133) + mat(k,616) = -rxt(k,171)*y(k,133) + mat(k,2207) = -rxt(k,176)*y(k,133) + mat(k,1809) = -rxt(k,182)*y(k,133) + mat(k,1854) = -(rxt(k,195) + rxt(k,197)) * y(k,133) + mat(k,1914) = -rxt(k,200)*y(k,133) + mat(k,2078) = -rxt(k,205)*y(k,133) + mat(k,961) = -rxt(k,229)*y(k,133) + mat(k,1601) = -rxt(k,231)*y(k,133) + mat(k,1504) = -rxt(k,234)*y(k,133) + mat(k,840) = -rxt(k,237)*y(k,133) + mat(k,571) = -rxt(k,260)*y(k,133) + mat(k,1574) = -rxt(k,261)*y(k,133) + mat(k,832) = -rxt(k,263)*y(k,133) + mat(k,791) = -rxt(k,265)*y(k,133) + mat(k,2353) = -rxt(k,296)*y(k,133) + mat(k,368) = -rxt(k,504)*y(k,133) + mat(k,683) = -(rxt(k,583) + rxt(k,584)) * y(k,133) + mat(k,506) = -rxt(k,585)*y(k,133) + mat(k,2099) = rxt(k,174)*y(k,90) + mat(k,2207) = mat(k,2207) + rxt(k,174)*y(k,76) + mat(k,978) = rxt(k,190)*y(k,124) + rxt(k,191)*y(k,125) + rxt(k,194)*y(k,134) & + + rxt(k,588)*y(k,225) + mat(k,2078) = mat(k,2078) + rxt(k,190)*y(k,112) + mat(k,1854) = mat(k,1854) + rxt(k,191)*y(k,112) + mat(k,1550) = mat(k,1550) + rxt(k,194)*y(k,112) + rxt(k,506)*y(k,149) & + + rxt(k,513)*y(k,151) + rxt(k,587)*y(k,220) + (rxt(k,156) & + +rxt(k,157))*y(k,222) + rxt(k,593)*y(k,227) + mat(k,713) = rxt(k,506)*y(k,134) + mat(k,1485) = rxt(k,513)*y(k,134) + mat(k,870) = rxt(k,579)*y(k,219) + 1.150_r8*rxt(k,580)*y(k,225) + mat(k,849) = rxt(k,579)*y(k,201) + mat(k,506) = mat(k,506) + rxt(k,587)*y(k,134) + mat(k,1644) = (rxt(k,156)+rxt(k,157))*y(k,134) + mat(k,857) = rxt(k,588)*y(k,112) + 1.150_r8*rxt(k,580)*y(k,201) + mat(k,1809) = mat(k,1809) + 2.000_r8*rxt(k,184)*y(k,226) + mat(k,810) = rxt(k,593)*y(k,134) + mat(k,1540) = -(rxt(k,156)*y(k,222) + rxt(k,161)*y(k,223) + rxt(k,169) & + *y(k,133) + rxt(k,175)*y(k,76) + rxt(k,189)*y(k,217) + rxt(k,194) & + *y(k,112) + rxt(k,339)*y(k,203) + rxt(k,506)*y(k,149) + rxt(k,513) & + *y(k,151) + rxt(k,582)*y(k,218) + (rxt(k,586) + rxt(k,587) & + ) * y(k,220) + rxt(k,593)*y(k,227)) + mat(k,1630) = -rxt(k,156)*y(k,134) + mat(k,176) = -rxt(k,161)*y(k,134) + mat(k,2313) = -rxt(k,169)*y(k,134) + mat(k,2085) = -rxt(k,175)*y(k,134) + mat(k,529) = -rxt(k,189)*y(k,134) + mat(k,972) = -rxt(k,194)*y(k,134) + mat(k,463) = -rxt(k,339)*y(k,134) + mat(k,710) = -rxt(k,506)*y(k,134) + mat(k,1476) = -rxt(k,513)*y(k,134) + mat(k,680) = -rxt(k,582)*y(k,134) + mat(k,505) = -(rxt(k,586) + rxt(k,587)) * y(k,134) + mat(k,809) = -rxt(k,593)*y(k,134) + mat(k,1510) = rxt(k,251)*y(k,90) + rxt(k,252)*y(k,135) + mat(k,1562) = 2.000_r8*rxt(k,253)*y(k,19) + (rxt(k,255)+rxt(k,256))*y(k,59) & + + rxt(k,257)*y(k,90) + rxt(k,261)*y(k,133) + mat(k,1946) = rxt(k,218)*y(k,90) + rxt(k,220)*y(k,135) + mat(k,1588) = (rxt(k,255)+rxt(k,256))*y(k,19) + (2.000_r8*rxt(k,222) & + +2.000_r8*rxt(k,223))*y(k,59) + rxt(k,225)*y(k,90) + rxt(k,231) & + *y(k,133) + rxt(k,233)*y(k,226) + mat(k,2085) = mat(k,2085) + rxt(k,172)*y(k,90) + rxt(k,178)*y(k,135) + mat(k,2193) = rxt(k,251)*y(k,17) + rxt(k,257)*y(k,19) + rxt(k,218)*y(k,56) & + + rxt(k,225)*y(k,59) + rxt(k,172)*y(k,76) + 2.000_r8*rxt(k,186) & + *y(k,90) + rxt(k,198)*y(k,126) + rxt(k,176)*y(k,133) & + + 2.000_r8*rxt(k,177)*y(k,135) + rxt(k,321)*y(k,195) & + + rxt(k,349)*y(k,196) + rxt(k,300)*y(k,199) + rxt(k,181) & + *y(k,226) + rxt(k,358)*y(k,229) + mat(k,494) = rxt(k,187)*y(k,226) + mat(k,972) = mat(k,972) + rxt(k,193)*y(k,125) + mat(k,255) = rxt(k,207)*y(k,222) + mat(k,2064) = rxt(k,204)*y(k,135) + rxt(k,590)*y(k,225) + mat(k,1840) = rxt(k,193)*y(k,112) + rxt(k,195)*y(k,133) + rxt(k,196)*y(k,135) + mat(k,1900) = rxt(k,198)*y(k,90) + rxt(k,200)*y(k,133) + mat(k,2313) = mat(k,2313) + rxt(k,261)*y(k,19) + rxt(k,231)*y(k,59) & + + rxt(k,176)*y(k,90) + rxt(k,195)*y(k,125) + rxt(k,200)*y(k,126) & + 2.000_r8*rxt(k,168)*y(k,133) + 2.000_r8*rxt(k,167)*y(k,135) & - + rxt(k,176)*y(k,203) + rxt(k,160)*y(k,218) + rxt(k,182) & - *y(k,221) - mat(k,1427) = mat(k,1427) + 2.000_r8*rxt(k,161)*y(k,218) - mat(k,1777) = rxt(k,252)*y(k,17) + rxt(k,220)*y(k,56) + rxt(k,178)*y(k,76) & - + rxt(k,204)*y(k,124) + rxt(k,196)*y(k,125) & - + 2.000_r8*rxt(k,167)*y(k,133) + rxt(k,507)*y(k,149) & - + rxt(k,513)*y(k,151) + 2.000_r8*rxt(k,177)*y(k,203) & - + 2.000_r8*rxt(k,158)*y(k,217) + rxt(k,183)*y(k,221) - mat(k,602) = mat(k,602) + rxt(k,507)*y(k,135) - mat(k,1320) = mat(k,1320) + rxt(k,513)*y(k,135) - mat(k,843) = rxt(k,322)*y(k,203) - mat(k,732) = rxt(k,350)*y(k,203) - mat(k,1397) = rxt(k,300)*y(k,203) - mat(k,2102) = rxt(k,251)*y(k,17) + rxt(k,257)*y(k,19) + rxt(k,218)*y(k,56) & - + rxt(k,225)*y(k,59) + rxt(k,172)*y(k,76) + rxt(k,198)*y(k,126) & - + rxt(k,176)*y(k,133) + 2.000_r8*rxt(k,177)*y(k,135) & - + rxt(k,322)*y(k,193) + rxt(k,350)*y(k,194) + rxt(k,300) & - *y(k,197) + 2.000_r8*rxt(k,186)*y(k,203) + rxt(k,181)*y(k,221) & - + rxt(k,358)*y(k,224) - mat(k,1567) = mat(k,1567) + 2.000_r8*rxt(k,158)*y(k,135) - mat(k,75) = mat(k,75) + rxt(k,160)*y(k,133) + 2.000_r8*rxt(k,161)*y(k,134) - mat(k,685) = rxt(k,576)*y(k,124) - mat(k,1715) = rxt(k,233)*y(k,59) + rxt(k,187)*y(k,90) + rxt(k,182)*y(k,133) & - + rxt(k,183)*y(k,135) + rxt(k,181)*y(k,203) - mat(k,720) = rxt(k,358)*y(k,203) + + rxt(k,160)*y(k,223) + rxt(k,182)*y(k,226) + mat(k,1540) = mat(k,1540) + 2.000_r8*rxt(k,161)*y(k,223) + mat(k,2403) = rxt(k,252)*y(k,17) + rxt(k,220)*y(k,56) + rxt(k,178)*y(k,76) & + + 2.000_r8*rxt(k,177)*y(k,90) + rxt(k,204)*y(k,124) + rxt(k,196) & + *y(k,125) + 2.000_r8*rxt(k,167)*y(k,133) + rxt(k,508)*y(k,149) & + + rxt(k,514)*y(k,151) + 2.000_r8*rxt(k,158)*y(k,222) & + + rxt(k,183)*y(k,226) + mat(k,710) = mat(k,710) + rxt(k,508)*y(k,135) + mat(k,1476) = mat(k,1476) + rxt(k,514)*y(k,135) + mat(k,901) = rxt(k,321)*y(k,90) + mat(k,936) = rxt(k,349)*y(k,90) + mat(k,2245) = rxt(k,300)*y(k,90) + mat(k,1630) = mat(k,1630) + rxt(k,207)*y(k,113) + 2.000_r8*rxt(k,158) & + *y(k,135) + mat(k,176) = mat(k,176) + rxt(k,160)*y(k,133) + 2.000_r8*rxt(k,161)*y(k,134) + mat(k,854) = rxt(k,590)*y(k,124) + mat(k,1795) = rxt(k,233)*y(k,59) + rxt(k,181)*y(k,90) + rxt(k,187)*y(k,91) & + + rxt(k,182)*y(k,133) + rxt(k,183)*y(k,135) + mat(k,819) = rxt(k,358)*y(k,90) end do - end subroutine nlnmat05 - subroutine nlnmat06( avec_len, mat, y, rxt ) + end subroutine nlnmat06 + subroutine nlnmat07( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -1210,212 +1586,219 @@ subroutine nlnmat06( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,1782) = -(rxt(k,158)*y(k,217) + rxt(k,167)*y(k,133) + rxt(k,177) & - *y(k,203) + rxt(k,178)*y(k,76) + rxt(k,183)*y(k,221) + rxt(k,196) & + mat(k,2419) = -(rxt(k,158)*y(k,222) + rxt(k,167)*y(k,133) + rxt(k,177) & + *y(k,90) + rxt(k,178)*y(k,76) + rxt(k,183)*y(k,226) + rxt(k,196) & *y(k,125) + rxt(k,204)*y(k,124) + rxt(k,220)*y(k,56) + rxt(k,252) & - *y(k,17) + rxt(k,319)*y(k,25) + rxt(k,348)*y(k,29) + rxt(k,378) & - *y(k,105) + rxt(k,392)*y(k,111) + rxt(k,425)*y(k,98) + rxt(k,463) & - *y(k,142) + rxt(k,480)*y(k,6) + rxt(k,483)*y(k,110) + rxt(k,507) & - *y(k,149) + rxt(k,513)*y(k,151)) - mat(k,1572) = -rxt(k,158)*y(k,135) - mat(k,1823) = -rxt(k,167)*y(k,135) - mat(k,2107) = -rxt(k,177)*y(k,135) - mat(k,1924) = -rxt(k,178)*y(k,135) - mat(k,1720) = -rxt(k,183)*y(k,135) - mat(k,1988) = -rxt(k,196)*y(k,135) - mat(k,1511) = -rxt(k,204)*y(k,135) - mat(k,1546) = -rxt(k,220)*y(k,135) - mat(k,1356) = -rxt(k,252)*y(k,135) - mat(k,455) = -rxt(k,319)*y(k,135) - mat(k,953) = -rxt(k,348)*y(k,135) - mat(k,1146) = -rxt(k,378)*y(k,135) - mat(k,1258) = -rxt(k,392)*y(k,135) - mat(k,792) = -rxt(k,425)*y(k,135) - mat(k,359) = -rxt(k,463)*y(k,135) - mat(k,870) = -rxt(k,480)*y(k,135) - mat(k,832) = -rxt(k,483)*y(k,135) - mat(k,604) = -rxt(k,507)*y(k,135) - mat(k,1324) = -rxt(k,513)*y(k,135) - mat(k,1823) = mat(k,1823) + rxt(k,169)*y(k,134) - mat(k,1432) = rxt(k,169)*y(k,133) - mat(k,1307) = .150_r8*rxt(k,333)*y(k,203) - mat(k,2107) = mat(k,2107) + .150_r8*rxt(k,333)*y(k,196) + .150_r8*rxt(k,383) & - *y(k,209) - mat(k,1276) = .150_r8*rxt(k,383)*y(k,203) - mat(k,230) = -(rxt(k,514)*y(k,151)) - mat(k,1315) = -rxt(k,514)*y(k,137) - mat(k,2000) = rxt(k,254)*y(k,59) - mat(k,2121) = rxt(k,254)*y(k,19) + 2.000_r8*rxt(k,224)*y(k,59) - mat(k,251) = -(rxt(k,504)*y(k,133) + rxt(k,505)*y(k,221)) - mat(k,1795) = -rxt(k,504)*y(k,138) - mat(k,1622) = -rxt(k,505)*y(k,138) - mat(k,965) = rxt(k,371)*y(k,221) - mat(k,1441) = .100_r8*rxt(k,492)*y(k,226) - mat(k,1607) = rxt(k,371)*y(k,93) - mat(k,1023) = .100_r8*rxt(k,492)*y(k,124) - mat(k,350) = -(rxt(k,343)*y(k,221)) - mat(k,1635) = -rxt(k,343)*y(k,140) - mat(k,1959) = rxt(k,345)*y(k,196) - mat(k,1285) = rxt(k,345)*y(k,125) - mat(k,1957) = rxt(k,465)*y(k,189) - mat(k,399) = rxt(k,465)*y(k,125) - mat(k,357) = -(rxt(k,462)*y(k,125) + rxt(k,463)*y(k,135)) - mat(k,1960) = -rxt(k,462)*y(k,142) - mat(k,1740) = -rxt(k,463)*y(k,142) - mat(k,123) = .070_r8*rxt(k,449)*y(k,221) - mat(k,1451) = rxt(k,447)*y(k,195) - mat(k,98) = .060_r8*rxt(k,461)*y(k,221) - mat(k,148) = .070_r8*rxt(k,477)*y(k,221) - mat(k,528) = rxt(k,447)*y(k,124) - mat(k,1636) = .070_r8*rxt(k,449)*y(k,66) + .060_r8*rxt(k,461)*y(k,143) & + *y(k,17) + rxt(k,318)*y(k,25) + rxt(k,347)*y(k,29) + rxt(k,378) & + *y(k,105) + rxt(k,392)*y(k,111) + rxt(k,425)*y(k,99) + rxt(k,463) & + *y(k,142) + rxt(k,480)*y(k,6) + rxt(k,483)*y(k,110) + rxt(k,508) & + *y(k,149) + rxt(k,514)*y(k,151)) + mat(k,1646) = -rxt(k,158)*y(k,135) + mat(k,2329) = -rxt(k,167)*y(k,135) + mat(k,2209) = -rxt(k,177)*y(k,135) + mat(k,2101) = -rxt(k,178)*y(k,135) + mat(k,1811) = -rxt(k,183)*y(k,135) + mat(k,1856) = -rxt(k,196)*y(k,135) + mat(k,2080) = -rxt(k,204)*y(k,135) + mat(k,1962) = -rxt(k,220)*y(k,135) + mat(k,1520) = -rxt(k,252)*y(k,135) + mat(k,555) = -rxt(k,318)*y(k,135) + mat(k,1147) = -rxt(k,347)*y(k,135) + mat(k,1276) = -rxt(k,378)*y(k,135) + mat(k,1388) = -rxt(k,392)*y(k,135) + mat(k,895) = -rxt(k,425)*y(k,135) + mat(k,469) = -rxt(k,463)*y(k,135) + mat(k,1005) = -rxt(k,480)*y(k,135) + mat(k,1033) = -rxt(k,483)*y(k,135) + mat(k,714) = -rxt(k,508)*y(k,135) + mat(k,1486) = -rxt(k,514)*y(k,135) + mat(k,2209) = mat(k,2209) + .150_r8*rxt(k,332)*y(k,198) + .150_r8*rxt(k,383) & + *y(k,213) + mat(k,2329) = mat(k,2329) + rxt(k,169)*y(k,134) + mat(k,1552) = rxt(k,169)*y(k,133) + mat(k,1438) = .150_r8*rxt(k,332)*y(k,90) + mat(k,1406) = .150_r8*rxt(k,383)*y(k,90) + mat(k,332) = -(rxt(k,515)*y(k,151)) + mat(k,1471) = -rxt(k,515)*y(k,137) + mat(k,1555) = rxt(k,254)*y(k,59) + mat(k,1581) = rxt(k,254)*y(k,19) + 2.000_r8*rxt(k,224)*y(k,59) + mat(k,361) = -(rxt(k,504)*y(k,133) + rxt(k,505)*y(k,226)) + mat(k,2290) = -rxt(k,504)*y(k,138) + mat(k,1699) = -rxt(k,505)*y(k,138) + mat(k,1188) = rxt(k,371)*y(k,226) + mat(k,1999) = .100_r8*rxt(k,492)*y(k,231) + mat(k,1680) = rxt(k,371)*y(k,94) + mat(k,1169) = .100_r8*rxt(k,492)*y(k,124) + mat(k,532) = -(rxt(k,342)*y(k,226)) + mat(k,1721) = -rxt(k,342)*y(k,140) + mat(k,1819) = rxt(k,344)*y(k,198) + mat(k,1409) = rxt(k,344)*y(k,125) + mat(k,1813) = rxt(k,465)*y(k,189) + mat(k,520) = rxt(k,465)*y(k,125) + mat(k,466) = -(rxt(k,462)*y(k,125) + rxt(k,463)*y(k,135)) + mat(k,1816) = -rxt(k,462)*y(k,142) + mat(k,2366) = -rxt(k,463)*y(k,142) + mat(k,194) = .070_r8*rxt(k,449)*y(k,226) + mat(k,2009) = rxt(k,447)*y(k,197) + mat(k,170) = .060_r8*rxt(k,461)*y(k,226) + mat(k,215) = .070_r8*rxt(k,477)*y(k,226) + mat(k,632) = rxt(k,447)*y(k,124) + mat(k,1713) = .070_r8*rxt(k,449)*y(k,66) + .060_r8*rxt(k,461)*y(k,143) & + .070_r8*rxt(k,477)*y(k,185) - mat(k,96) = -(rxt(k,461)*y(k,221)) - mat(k,1597) = -rxt(k,461)*y(k,143) - mat(k,88) = .530_r8*rxt(k,438)*y(k,221) - mat(k,1597) = mat(k,1597) + .530_r8*rxt(k,438)*y(k,7) - mat(k,235) = -(rxt(k,464)*y(k,221)) - mat(k,1619) = -rxt(k,464)*y(k,144) - mat(k,2028) = rxt(k,459)*y(k,223) - mat(k,335) = rxt(k,459)*y(k,203) - mat(k,430) = -(rxt(k,360)*y(k,221)) - mat(k,1645) = -rxt(k,360)*y(k,147) - mat(k,2050) = rxt(k,358)*y(k,224) - mat(k,716) = rxt(k,358)*y(k,203) - mat(k,291) = -(rxt(k,364)*y(k,221)) - mat(k,1627) = -rxt(k,364)*y(k,148) - mat(k,2033) = .850_r8*rxt(k,362)*y(k,225) - mat(k,1062) = .850_r8*rxt(k,362)*y(k,203) - mat(k,600) = -(rxt(k,506)*y(k,134) + rxt(k,507)*y(k,135) + rxt(k,510) & - *y(k,221)) - mat(k,1417) = -rxt(k,506)*y(k,149) - mat(k,1744) = -rxt(k,507)*y(k,149) - mat(k,1662) = -rxt(k,510)*y(k,149) - mat(k,1318) = -(rxt(k,508)*y(k,19) + rxt(k,509)*y(k,59) + rxt(k,511)*y(k,125) & - + rxt(k,512)*y(k,134) + rxt(k,513)*y(k,135) + rxt(k,514) & - *y(k,137) + rxt(k,515)*y(k,221)) - mat(k,2004) = -rxt(k,508)*y(k,151) - mat(k,2125) = -rxt(k,509)*y(k,151) - mat(k,1979) = -rxt(k,511)*y(k,151) - mat(k,1425) = -rxt(k,512)*y(k,151) - mat(k,1774) = -rxt(k,513)*y(k,151) - mat(k,232) = -rxt(k,514)*y(k,151) - mat(k,1711) = -rxt(k,515)*y(k,151) - mat(k,1814) = rxt(k,504)*y(k,138) - mat(k,1425) = mat(k,1425) + rxt(k,506)*y(k,149) - mat(k,1774) = mat(k,1774) + rxt(k,507)*y(k,149) - mat(k,255) = rxt(k,504)*y(k,133) - mat(k,601) = rxt(k,506)*y(k,134) + rxt(k,507)*y(k,135) + rxt(k,510)*y(k,221) - mat(k,1711) = mat(k,1711) + rxt(k,510)*y(k,149) - mat(k,892) = -(rxt(k,517)*y(k,221)) - mat(k,1684) = -rxt(k,517)*y(k,152) - mat(k,2003) = rxt(k,508)*y(k,151) - mat(k,2123) = rxt(k,509)*y(k,151) - mat(k,192) = rxt(k,502)*y(k,126) + (rxt(k,503)+.500_r8*rxt(k,516))*y(k,221) - mat(k,1972) = rxt(k,511)*y(k,151) - mat(k,1871) = rxt(k,502)*y(k,67) - mat(k,1422) = rxt(k,512)*y(k,151) - mat(k,1752) = rxt(k,513)*y(k,151) - mat(k,231) = rxt(k,514)*y(k,151) - mat(k,253) = rxt(k,505)*y(k,221) - mat(k,1317) = rxt(k,508)*y(k,19) + rxt(k,509)*y(k,59) + rxt(k,511)*y(k,125) & - + rxt(k,512)*y(k,134) + rxt(k,513)*y(k,135) + rxt(k,514) & - *y(k,137) + rxt(k,515)*y(k,221) - mat(k,1684) = mat(k,1684) + (rxt(k,503)+.500_r8*rxt(k,516))*y(k,67) & - + rxt(k,505)*y(k,138) + rxt(k,515)*y(k,151) - mat(k,173) = -(rxt(k,518)*y(k,232)) - mat(k,2147) = -rxt(k,518)*y(k,153) - mat(k,891) = rxt(k,517)*y(k,221) - mat(k,1610) = rxt(k,517)*y(k,152) - mat(k,849) = .2202005_r8*rxt(k,535)*y(k,135) + .2202005_r8*rxt(k,536) & - *y(k,221) - mat(k,81) = .0023005_r8*rxt(k,537)*y(k,221) - mat(k,775) = .0031005_r8*rxt(k,540)*y(k,221) - mat(k,34) = .2381005_r8*rxt(k,541)*y(k,221) - mat(k,811) = .0508005_r8*rxt(k,543)*y(k,135) + .0508005_r8*rxt(k,544) & - *y(k,221) - mat(k,1731) = .2202005_r8*rxt(k,535)*y(k,6) + .0508005_r8*rxt(k,543)*y(k,110) - mat(k,40) = .5931005_r8*rxt(k,545)*y(k,221) - mat(k,109) = .1364005_r8*rxt(k,546)*y(k,221) - mat(k,133) = .1677005_r8*rxt(k,547)*y(k,221) - mat(k,1583) = .2202005_r8*rxt(k,536)*y(k,6) + .0023005_r8*rxt(k,537)*y(k,7) & - + .0031005_r8*rxt(k,540)*y(k,98) + .2381005_r8*rxt(k,541) & - *y(k,104) + .0508005_r8*rxt(k,544)*y(k,110) & - + .5931005_r8*rxt(k,545)*y(k,173) + .1364005_r8*rxt(k,546) & - *y(k,181) + .1677005_r8*rxt(k,547)*y(k,183) - mat(k,850) = .2067005_r8*rxt(k,535)*y(k,135) + .2067005_r8*rxt(k,536) & - *y(k,221) - mat(k,82) = .0008005_r8*rxt(k,537)*y(k,221) - mat(k,776) = .0035005_r8*rxt(k,540)*y(k,221) - mat(k,35) = .1308005_r8*rxt(k,541)*y(k,221) - mat(k,812) = .1149005_r8*rxt(k,543)*y(k,135) + .1149005_r8*rxt(k,544) & - *y(k,221) - mat(k,1732) = .2067005_r8*rxt(k,535)*y(k,6) + .1149005_r8*rxt(k,543)*y(k,110) - mat(k,41) = .1534005_r8*rxt(k,545)*y(k,221) - mat(k,110) = .0101005_r8*rxt(k,546)*y(k,221) - mat(k,134) = .0174005_r8*rxt(k,547)*y(k,221) - mat(k,1584) = .2067005_r8*rxt(k,536)*y(k,6) + .0008005_r8*rxt(k,537)*y(k,7) & - + .0035005_r8*rxt(k,540)*y(k,98) + .1308005_r8*rxt(k,541) & - *y(k,104) + .1149005_r8*rxt(k,544)*y(k,110) & - + .1534005_r8*rxt(k,545)*y(k,173) + .0101005_r8*rxt(k,546) & - *y(k,181) + .0174005_r8*rxt(k,547)*y(k,183) - mat(k,851) = .0653005_r8*rxt(k,535)*y(k,135) + .0653005_r8*rxt(k,536) & - *y(k,221) - mat(k,83) = .0843005_r8*rxt(k,537)*y(k,221) - mat(k,777) = .0003005_r8*rxt(k,540)*y(k,221) - mat(k,36) = .0348005_r8*rxt(k,541)*y(k,221) - mat(k,813) = .0348005_r8*rxt(k,543)*y(k,135) + .0348005_r8*rxt(k,544) & - *y(k,221) - mat(k,1733) = .0653005_r8*rxt(k,535)*y(k,6) + .0348005_r8*rxt(k,543)*y(k,110) - mat(k,42) = .0459005_r8*rxt(k,545)*y(k,221) - mat(k,111) = .0763005_r8*rxt(k,546)*y(k,221) - mat(k,135) = .086_r8*rxt(k,547)*y(k,221) - mat(k,1585) = .0653005_r8*rxt(k,536)*y(k,6) + .0843005_r8*rxt(k,537)*y(k,7) & - + .0003005_r8*rxt(k,540)*y(k,98) + .0348005_r8*rxt(k,541) & - *y(k,104) + .0348005_r8*rxt(k,544)*y(k,110) & - + .0459005_r8*rxt(k,545)*y(k,173) + .0763005_r8*rxt(k,546) & - *y(k,181) + .086_r8*rxt(k,547)*y(k,183) - mat(k,852) = .1749305_r8*rxt(k,534)*y(k,126) + .1284005_r8*rxt(k,535) & - *y(k,135) + .1284005_r8*rxt(k,536)*y(k,221) - mat(k,84) = .0443005_r8*rxt(k,537)*y(k,221) - mat(k,778) = .0590245_r8*rxt(k,538)*y(k,126) + .0033005_r8*rxt(k,539) & - *y(k,135) + .0271005_r8*rxt(k,540)*y(k,221) - mat(k,37) = .0076005_r8*rxt(k,541)*y(k,221) - mat(k,814) = .1749305_r8*rxt(k,542)*y(k,126) + .0554005_r8*rxt(k,543) & - *y(k,135) + .0554005_r8*rxt(k,544)*y(k,221) - mat(k,1858) = .1749305_r8*rxt(k,534)*y(k,6) + .0590245_r8*rxt(k,538)*y(k,98) & - + .1749305_r8*rxt(k,542)*y(k,110) - mat(k,1734) = .1284005_r8*rxt(k,535)*y(k,6) + .0033005_r8*rxt(k,539)*y(k,98) & - + .0554005_r8*rxt(k,543)*y(k,110) - mat(k,43) = .0085005_r8*rxt(k,545)*y(k,221) - mat(k,112) = .2157005_r8*rxt(k,546)*y(k,221) - mat(k,136) = .0512005_r8*rxt(k,547)*y(k,221) - mat(k,1586) = .1284005_r8*rxt(k,536)*y(k,6) + .0443005_r8*rxt(k,537)*y(k,7) & - + .0271005_r8*rxt(k,540)*y(k,98) + .0076005_r8*rxt(k,541) & - *y(k,104) + .0554005_r8*rxt(k,544)*y(k,110) & - + .0085005_r8*rxt(k,545)*y(k,173) + .2157005_r8*rxt(k,546) & - *y(k,181) + .0512005_r8*rxt(k,547)*y(k,183) - mat(k,853) = .5901905_r8*rxt(k,534)*y(k,126) + .114_r8*rxt(k,535)*y(k,135) & - + .114_r8*rxt(k,536)*y(k,221) - mat(k,85) = .1621005_r8*rxt(k,537)*y(k,221) - mat(k,779) = .0250245_r8*rxt(k,538)*y(k,126) + .0474005_r8*rxt(k,540) & - *y(k,221) - mat(k,38) = .0113005_r8*rxt(k,541)*y(k,221) - mat(k,815) = .5901905_r8*rxt(k,542)*y(k,126) + .1278005_r8*rxt(k,543) & - *y(k,135) + .1278005_r8*rxt(k,544)*y(k,221) - mat(k,1859) = .5901905_r8*rxt(k,534)*y(k,6) + .0250245_r8*rxt(k,538)*y(k,98) & - + .5901905_r8*rxt(k,542)*y(k,110) - mat(k,1735) = .114_r8*rxt(k,535)*y(k,6) + .1278005_r8*rxt(k,543)*y(k,110) - mat(k,44) = .0128005_r8*rxt(k,545)*y(k,221) - mat(k,113) = .0738005_r8*rxt(k,546)*y(k,221) - mat(k,137) = .1598005_r8*rxt(k,547)*y(k,221) - mat(k,1587) = .114_r8*rxt(k,536)*y(k,6) + .1621005_r8*rxt(k,537)*y(k,7) & - + .0474005_r8*rxt(k,540)*y(k,98) + .0113005_r8*rxt(k,541) & - *y(k,104) + .1278005_r8*rxt(k,544)*y(k,110) & - + .0128005_r8*rxt(k,545)*y(k,173) + .0738005_r8*rxt(k,546) & - *y(k,181) + .1598005_r8*rxt(k,547)*y(k,183) + mat(k,168) = -(rxt(k,461)*y(k,226)) + mat(k,1668) = -rxt(k,461)*y(k,143) + mat(k,160) = .530_r8*rxt(k,438)*y(k,226) + mat(k,1668) = mat(k,1668) + .530_r8*rxt(k,438)*y(k,7) + mat(k,337) = -(rxt(k,464)*y(k,226)) + mat(k,1695) = -rxt(k,464)*y(k,144) + mat(k,2120) = rxt(k,459)*y(k,228) + mat(k,451) = rxt(k,459)*y(k,90) + mat(k,540) = -(rxt(k,360)*y(k,226)) + mat(k,1722) = -rxt(k,360)*y(k,147) + mat(k,2141) = rxt(k,358)*y(k,229) + mat(k,815) = rxt(k,358)*y(k,90) + mat(k,407) = -(rxt(k,364)*y(k,226)) + mat(k,1705) = -rxt(k,364)*y(k,148) + mat(k,2126) = .850_r8*rxt(k,362)*y(k,230) + mat(k,1212) = .850_r8*rxt(k,362)*y(k,90) + mat(k,708) = -(rxt(k,506)*y(k,134) + rxt(k,508)*y(k,135) + rxt(k,511) & + *y(k,226)) + mat(k,1528) = -rxt(k,506)*y(k,149) + mat(k,2370) = -rxt(k,508)*y(k,149) + mat(k,1740) = -rxt(k,511)*y(k,149) + mat(k,1474) = -(rxt(k,509)*y(k,19) + rxt(k,510)*y(k,59) + rxt(k,512)*y(k,125) & + + rxt(k,513)*y(k,134) + rxt(k,514)*y(k,135) + rxt(k,515) & + *y(k,137) + rxt(k,516)*y(k,226)) + mat(k,1559) = -rxt(k,509)*y(k,151) + mat(k,1585) = -rxt(k,510)*y(k,151) + mat(k,1837) = -rxt(k,512)*y(k,151) + mat(k,1538) = -rxt(k,513)*y(k,151) + mat(k,2401) = -rxt(k,514)*y(k,151) + mat(k,334) = -rxt(k,515)*y(k,151) + mat(k,1792) = -rxt(k,516)*y(k,151) + mat(k,2310) = rxt(k,504)*y(k,138) + mat(k,1538) = mat(k,1538) + rxt(k,506)*y(k,149) + mat(k,2401) = mat(k,2401) + rxt(k,508)*y(k,149) + mat(k,365) = rxt(k,504)*y(k,133) + mat(k,709) = rxt(k,506)*y(k,134) + rxt(k,508)*y(k,135) + rxt(k,511)*y(k,226) + mat(k,1792) = mat(k,1792) + rxt(k,511)*y(k,149) + mat(k,945) = -(rxt(k,507)*y(k,226)) + mat(k,1759) = -rxt(k,507)*y(k,152) + mat(k,1558) = rxt(k,509)*y(k,151) + mat(k,1583) = rxt(k,510)*y(k,151) + mat(k,309) = rxt(k,502)*y(k,126) + (rxt(k,503)+.500_r8*rxt(k,517))*y(k,226) + mat(k,1827) = rxt(k,512)*y(k,151) + mat(k,1868) = rxt(k,502)*y(k,67) + mat(k,1533) = rxt(k,513)*y(k,151) + mat(k,2374) = rxt(k,514)*y(k,151) + mat(k,333) = rxt(k,515)*y(k,151) + mat(k,363) = rxt(k,505)*y(k,226) + mat(k,1473) = rxt(k,509)*y(k,19) + rxt(k,510)*y(k,59) + rxt(k,512)*y(k,125) & + + rxt(k,513)*y(k,134) + rxt(k,514)*y(k,135) + rxt(k,515) & + *y(k,137) + rxt(k,516)*y(k,226) + mat(k,1759) = mat(k,1759) + (rxt(k,503)+.500_r8*rxt(k,517))*y(k,67) & + + rxt(k,505)*y(k,138) + rxt(k,516)*y(k,151) + mat(k,259) = -(rxt(k,518)*y(k,239)) + mat(k,2422) = -rxt(k,518)*y(k,153) + mat(k,944) = rxt(k,507)*y(k,226) + mat(k,1684) = rxt(k,507)*y(k,152) + mat(k,979) = .2202005_r8*rxt(k,537)*y(k,135) + mat(k,2103) = .2202005_r8*rxt(k,535)*y(k,191) + .0023005_r8*rxt(k,540) & + *y(k,193) + .0031005_r8*rxt(k,543)*y(k,209) & + + .2381005_r8*rxt(k,547)*y(k,210) + .0508005_r8*rxt(k,551) & + *y(k,216) + .1364005_r8*rxt(k,557)*y(k,234) & + + .1677005_r8*rxt(k,560)*y(k,237) + mat(k,1007) = .0508005_r8*rxt(k,553)*y(k,135) + mat(k,1987) = .1279005_r8*rxt(k,536)*y(k,191) + .0097005_r8*rxt(k,541) & + *y(k,193) + .0003005_r8*rxt(k,544)*y(k,209) & + + .1056005_r8*rxt(k,548)*y(k,210) + .0245005_r8*rxt(k,552) & + *y(k,216) + .0154005_r8*rxt(k,558)*y(k,234) & + + .0063005_r8*rxt(k,561)*y(k,237) + mat(k,2357) = .2202005_r8*rxt(k,537)*y(k,6) + .0508005_r8*rxt(k,553)*y(k,110) + mat(k,43) = .5931005_r8*rxt(k,555)*y(k,226) + mat(k,49) = .2202005_r8*rxt(k,535)*y(k,90) + .1279005_r8*rxt(k,536)*y(k,124) + mat(k,55) = .0023005_r8*rxt(k,540)*y(k,90) + .0097005_r8*rxt(k,541)*y(k,124) + mat(k,61) = .0031005_r8*rxt(k,543)*y(k,90) + .0003005_r8*rxt(k,544)*y(k,124) + mat(k,67) = .2381005_r8*rxt(k,547)*y(k,90) + .1056005_r8*rxt(k,548)*y(k,124) + mat(k,75) = .0508005_r8*rxt(k,551)*y(k,90) + .0245005_r8*rxt(k,552)*y(k,124) + mat(k,1648) = .5931005_r8*rxt(k,555)*y(k,173) + mat(k,81) = .1364005_r8*rxt(k,557)*y(k,90) + .0154005_r8*rxt(k,558)*y(k,124) + mat(k,87) = .1677005_r8*rxt(k,560)*y(k,90) + .0063005_r8*rxt(k,561)*y(k,124) + mat(k,980) = .2067005_r8*rxt(k,537)*y(k,135) + mat(k,2104) = .2067005_r8*rxt(k,535)*y(k,191) + .0008005_r8*rxt(k,540) & + *y(k,193) + .0035005_r8*rxt(k,543)*y(k,209) & + + .1308005_r8*rxt(k,547)*y(k,210) + .1149005_r8*rxt(k,551) & + *y(k,216) + .0101005_r8*rxt(k,557)*y(k,234) & + + .0174005_r8*rxt(k,560)*y(k,237) + mat(k,1008) = .1149005_r8*rxt(k,553)*y(k,135) + mat(k,1988) = .1792005_r8*rxt(k,536)*y(k,191) + .0034005_r8*rxt(k,541) & + *y(k,193) + .0003005_r8*rxt(k,544)*y(k,209) & + + .1026005_r8*rxt(k,548)*y(k,210) + .0082005_r8*rxt(k,552) & + *y(k,216) + .0452005_r8*rxt(k,558)*y(k,234) & + + .0237005_r8*rxt(k,561)*y(k,237) + mat(k,2358) = .2067005_r8*rxt(k,537)*y(k,6) + .1149005_r8*rxt(k,553)*y(k,110) + mat(k,44) = .1534005_r8*rxt(k,555)*y(k,226) + mat(k,50) = .2067005_r8*rxt(k,535)*y(k,90) + .1792005_r8*rxt(k,536)*y(k,124) + mat(k,56) = .0008005_r8*rxt(k,540)*y(k,90) + .0034005_r8*rxt(k,541)*y(k,124) + mat(k,62) = .0035005_r8*rxt(k,543)*y(k,90) + .0003005_r8*rxt(k,544)*y(k,124) + mat(k,68) = .1308005_r8*rxt(k,547)*y(k,90) + .1026005_r8*rxt(k,548)*y(k,124) + mat(k,76) = .1149005_r8*rxt(k,551)*y(k,90) + .0082005_r8*rxt(k,552)*y(k,124) + mat(k,1649) = .1534005_r8*rxt(k,555)*y(k,173) + mat(k,82) = .0101005_r8*rxt(k,557)*y(k,90) + .0452005_r8*rxt(k,558)*y(k,124) + mat(k,88) = .0174005_r8*rxt(k,560)*y(k,90) + .0237005_r8*rxt(k,561)*y(k,124) + mat(k,981) = .0653005_r8*rxt(k,537)*y(k,135) + mat(k,2105) = .0653005_r8*rxt(k,535)*y(k,191) + .0843005_r8*rxt(k,540) & + *y(k,193) + .0003005_r8*rxt(k,543)*y(k,209) & + + .0348005_r8*rxt(k,547)*y(k,210) + .0348005_r8*rxt(k,551) & + *y(k,216) + .0763005_r8*rxt(k,557)*y(k,234) + .086_r8*rxt(k,560) & + *y(k,237) + mat(k,1009) = .0348005_r8*rxt(k,553)*y(k,135) + mat(k,1989) = .0676005_r8*rxt(k,536)*y(k,191) + .1579005_r8*rxt(k,541) & + *y(k,193) + .0073005_r8*rxt(k,544)*y(k,209) & + + .0521005_r8*rxt(k,548)*y(k,210) + .0772005_r8*rxt(k,552) & + *y(k,216) + .0966005_r8*rxt(k,558)*y(k,234) & + + .0025005_r8*rxt(k,561)*y(k,237) + mat(k,2359) = .0653005_r8*rxt(k,537)*y(k,6) + .0348005_r8*rxt(k,553)*y(k,110) + mat(k,45) = .0459005_r8*rxt(k,555)*y(k,226) + mat(k,51) = .0653005_r8*rxt(k,535)*y(k,90) + .0676005_r8*rxt(k,536)*y(k,124) + mat(k,57) = .0843005_r8*rxt(k,540)*y(k,90) + .1579005_r8*rxt(k,541)*y(k,124) + mat(k,63) = .0003005_r8*rxt(k,543)*y(k,90) + .0073005_r8*rxt(k,544)*y(k,124) + mat(k,69) = .0348005_r8*rxt(k,547)*y(k,90) + .0521005_r8*rxt(k,548)*y(k,124) + mat(k,77) = .0348005_r8*rxt(k,551)*y(k,90) + .0772005_r8*rxt(k,552)*y(k,124) + mat(k,1650) = .0459005_r8*rxt(k,555)*y(k,173) + mat(k,83) = .0763005_r8*rxt(k,557)*y(k,90) + .0966005_r8*rxt(k,558)*y(k,124) + mat(k,89) = .086_r8*rxt(k,560)*y(k,90) + .0025005_r8*rxt(k,561)*y(k,124) + mat(k,982) = .1749305_r8*rxt(k,534)*y(k,126) + .1284005_r8*rxt(k,537) & + *y(k,135) + mat(k,2106) = .1284005_r8*rxt(k,535)*y(k,191) + .0443005_r8*rxt(k,540) & + *y(k,193) + .0271005_r8*rxt(k,543)*y(k,209) & + + .0076005_r8*rxt(k,547)*y(k,210) + .0554005_r8*rxt(k,551) & + *y(k,216) + .2157005_r8*rxt(k,557)*y(k,234) & + + .0512005_r8*rxt(k,560)*y(k,237) + mat(k,877) = .0590245_r8*rxt(k,542)*y(k,126) + .0033005_r8*rxt(k,545) & + *y(k,135) + mat(k,1010) = .1749305_r8*rxt(k,550)*y(k,126) + .0554005_r8*rxt(k,553) & + *y(k,135) + mat(k,1990) = .079_r8*rxt(k,536)*y(k,191) + .0059005_r8*rxt(k,541)*y(k,193) & + + .0057005_r8*rxt(k,544)*y(k,209) + .0143005_r8*rxt(k,548) & + *y(k,210) + .0332005_r8*rxt(k,552)*y(k,216) & + + .0073005_r8*rxt(k,558)*y(k,234) + .011_r8*rxt(k,561)*y(k,237) + mat(k,1858) = .1749305_r8*rxt(k,534)*y(k,6) + .0590245_r8*rxt(k,542)*y(k,99) & + + .1749305_r8*rxt(k,550)*y(k,110) + mat(k,2360) = .1284005_r8*rxt(k,537)*y(k,6) + .0033005_r8*rxt(k,545)*y(k,99) & + + .0554005_r8*rxt(k,553)*y(k,110) + mat(k,46) = .0085005_r8*rxt(k,555)*y(k,226) + mat(k,52) = .1284005_r8*rxt(k,535)*y(k,90) + .079_r8*rxt(k,536)*y(k,124) + mat(k,58) = .0443005_r8*rxt(k,540)*y(k,90) + .0059005_r8*rxt(k,541)*y(k,124) + mat(k,64) = .0271005_r8*rxt(k,543)*y(k,90) + .0057005_r8*rxt(k,544)*y(k,124) + mat(k,70) = .0076005_r8*rxt(k,547)*y(k,90) + .0143005_r8*rxt(k,548)*y(k,124) + mat(k,78) = .0554005_r8*rxt(k,551)*y(k,90) + .0332005_r8*rxt(k,552)*y(k,124) + mat(k,1651) = .0085005_r8*rxt(k,555)*y(k,173) + mat(k,84) = .2157005_r8*rxt(k,557)*y(k,90) + .0073005_r8*rxt(k,558)*y(k,124) + mat(k,90) = .0512005_r8*rxt(k,560)*y(k,90) + .011_r8*rxt(k,561)*y(k,124) end do - end subroutine nlnmat06 - subroutine nlnmat07( avec_len, mat, y, rxt ) + end subroutine nlnmat07 + subroutine nlnmat08( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -1433,219 +1816,259 @@ subroutine nlnmat07( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,45) = -(rxt(k,545)*y(k,221)) - mat(k,1589) = -rxt(k,545)*y(k,173) - mat(k,116) = .100_r8*rxt(k,469)*y(k,221) - mat(k,138) = .230_r8*rxt(k,471)*y(k,221) - mat(k,1602) = .100_r8*rxt(k,469)*y(k,181) + .230_r8*rxt(k,471)*y(k,183) - mat(k,481) = -(rxt(k,493)*y(k,221)) - mat(k,1651) = -rxt(k,493)*y(k,175) - mat(k,2053) = rxt(k,491)*y(k,226) - mat(k,1024) = rxt(k,491)*y(k,203) - mat(k,521) = -(rxt(k,494)*y(k,221)) - mat(k,1655) = -rxt(k,494)*y(k,176) - mat(k,1460) = .200_r8*rxt(k,487)*y(k,216) + .200_r8*rxt(k,497)*y(k,227) - mat(k,1368) = .500_r8*rxt(k,485)*y(k,216) - mat(k,1043) = .200_r8*rxt(k,487)*y(k,124) + .500_r8*rxt(k,485)*y(k,197) - mat(k,1002) = .200_r8*rxt(k,497)*y(k,124) - mat(k,368) = -(rxt(k,498)*y(k,221)) - mat(k,1638) = -rxt(k,498)*y(k,177) - mat(k,2045) = rxt(k,496)*y(k,227) - mat(k,1001) = rxt(k,496)*y(k,203) - mat(k,916) = -(rxt(k,499)*y(k,126) + rxt(k,500)*y(k,221)) - mat(k,1873) = -rxt(k,499)*y(k,178) - mat(k,1687) = -rxt(k,500)*y(k,178) - mat(k,861) = .330_r8*rxt(k,480)*y(k,135) - mat(k,823) = .330_r8*rxt(k,483)*y(k,135) - mat(k,1482) = .800_r8*rxt(k,487)*y(k,216) + .800_r8*rxt(k,497)*y(k,227) - mat(k,1873) = mat(k,1873) + rxt(k,488)*y(k,216) - mat(k,1754) = .330_r8*rxt(k,480)*y(k,6) + .330_r8*rxt(k,483)*y(k,110) - mat(k,522) = rxt(k,494)*y(k,221) - mat(k,1375) = .500_r8*rxt(k,485)*y(k,216) + rxt(k,495)*y(k,227) - mat(k,1045) = .800_r8*rxt(k,487)*y(k,124) + rxt(k,488)*y(k,126) & - + .500_r8*rxt(k,485)*y(k,197) - mat(k,1687) = mat(k,1687) + rxt(k,494)*y(k,176) - mat(k,1005) = .800_r8*rxt(k,497)*y(k,124) + rxt(k,495)*y(k,197) - mat(k,982) = -(rxt(k,501)*y(k,221)) - mat(k,1692) = -rxt(k,501)*y(k,179) - mat(k,862) = .300_r8*rxt(k,480)*y(k,135) - mat(k,824) = .300_r8*rxt(k,483)*y(k,135) - mat(k,1486) = .900_r8*rxt(k,492)*y(k,226) - mat(k,1757) = .300_r8*rxt(k,480)*y(k,6) + .300_r8*rxt(k,483)*y(k,110) - mat(k,1378) = rxt(k,490)*y(k,226) - mat(k,1028) = .900_r8*rxt(k,492)*y(k,124) + rxt(k,490)*y(k,197) - mat(k,492) = -(rxt(k,468)*y(k,221)) - mat(k,1652) = -rxt(k,468)*y(k,180) - mat(k,2054) = rxt(k,466)*y(k,228) - mat(k,615) = rxt(k,466)*y(k,203) - mat(k,114) = -(rxt(k,469)*y(k,221)) - mat(k,1600) = -rxt(k,469)*y(k,181) - mat(k,130) = -(rxt(k,435)*y(k,221)) - mat(k,1603) = -rxt(k,435)*y(k,182) - mat(k,2024) = rxt(k,432)*y(k,229) - mat(k,1085) = rxt(k,432)*y(k,203) - mat(k,139) = -(rxt(k,471)*y(k,221)) - mat(k,1604) = -rxt(k,471)*y(k,183) - mat(k,589) = -(rxt(k,474)*y(k,221)) - mat(k,1661) = -rxt(k,474)*y(k,184) - mat(k,2060) = rxt(k,472)*y(k,230) - mat(k,632) = rxt(k,472)*y(k,203) - mat(k,147) = -(rxt(k,477)*y(k,221)) - mat(k,1605) = -rxt(k,477)*y(k,185) - mat(k,140) = .150_r8*rxt(k,471)*y(k,221) - mat(k,1605) = mat(k,1605) + .150_r8*rxt(k,471)*y(k,183) - mat(k,315) = -(rxt(k,478)*y(k,221)) - mat(k,1631) = -rxt(k,478)*y(k,186) - mat(k,2037) = rxt(k,475)*y(k,231) - mat(k,391) = rxt(k,475)*y(k,203) - mat(k,400) = -(rxt(k,436)*y(k,203) + rxt(k,437)*y(k,124) + rxt(k,465) & - *y(k,125)) - mat(k,2048) = -rxt(k,436)*y(k,189) - mat(k,1454) = -rxt(k,437)*y(k,189) - mat(k,1962) = -rxt(k,465)*y(k,189) - mat(k,170) = rxt(k,442)*y(k,221) - mat(k,1641) = rxt(k,442)*y(k,22) - mat(k,880) = -(rxt(k,397)*y(k,203) + (rxt(k,398) + rxt(k,399)) * y(k,124)) - mat(k,2076) = -rxt(k,397)*y(k,190) - mat(k,1480) = -(rxt(k,398) + rxt(k,399)) * y(k,190) - mat(k,550) = rxt(k,400)*y(k,221) - mat(k,164) = rxt(k,401)*y(k,221) - mat(k,1683) = rxt(k,400)*y(k,2) + rxt(k,401)*y(k,15) - mat(k,377) = -(rxt(k,439)*y(k,203) + rxt(k,440)*y(k,124)) - mat(k,2046) = -rxt(k,439)*y(k,191) - mat(k,1452) = -rxt(k,440)*y(k,191) - mat(k,89) = .350_r8*rxt(k,438)*y(k,221) - mat(k,275) = rxt(k,441)*y(k,221) - mat(k,1639) = .350_r8*rxt(k,438)*y(k,7) + rxt(k,441)*y(k,8) - mat(k,323) = -(rxt(k,443)*y(k,203) + rxt(k,445)*y(k,124)) - mat(k,2038) = -rxt(k,443)*y(k,192) - mat(k,1446) = -rxt(k,445)*y(k,192) - mat(k,242) = rxt(k,444)*y(k,221) - mat(k,117) = .070_r8*rxt(k,469)*y(k,221) - mat(k,141) = .060_r8*rxt(k,471)*y(k,221) - mat(k,1632) = rxt(k,444)*y(k,23) + .070_r8*rxt(k,469)*y(k,181) & + mat(k,983) = .5901905_r8*rxt(k,534)*y(k,126) + .114_r8*rxt(k,537)*y(k,135) + mat(k,2107) = .114_r8*rxt(k,535)*y(k,191) + .1621005_r8*rxt(k,540)*y(k,193) & + + .0474005_r8*rxt(k,543)*y(k,209) + .0113005_r8*rxt(k,547) & + *y(k,210) + .1278005_r8*rxt(k,551)*y(k,216) & + + .0738005_r8*rxt(k,557)*y(k,234) + .1598005_r8*rxt(k,560) & + *y(k,237) + mat(k,878) = .0250245_r8*rxt(k,542)*y(k,126) + mat(k,1011) = .5901905_r8*rxt(k,550)*y(k,126) + .1278005_r8*rxt(k,553) & + *y(k,135) + mat(k,1991) = .1254005_r8*rxt(k,536)*y(k,191) + .0536005_r8*rxt(k,541) & + *y(k,193) + .0623005_r8*rxt(k,544)*y(k,209) & + + .0166005_r8*rxt(k,548)*y(k,210) + .130_r8*rxt(k,552)*y(k,216) & + + .238_r8*rxt(k,558)*y(k,234) + .1185005_r8*rxt(k,561)*y(k,237) + mat(k,1859) = .5901905_r8*rxt(k,534)*y(k,6) + .0250245_r8*rxt(k,542)*y(k,99) & + + .5901905_r8*rxt(k,550)*y(k,110) + mat(k,2361) = .114_r8*rxt(k,537)*y(k,6) + .1278005_r8*rxt(k,553)*y(k,110) + mat(k,47) = .0128005_r8*rxt(k,555)*y(k,226) + mat(k,53) = .114_r8*rxt(k,535)*y(k,90) + .1254005_r8*rxt(k,536)*y(k,124) + mat(k,59) = .1621005_r8*rxt(k,540)*y(k,90) + .0536005_r8*rxt(k,541)*y(k,124) + mat(k,65) = .0474005_r8*rxt(k,543)*y(k,90) + .0623005_r8*rxt(k,544)*y(k,124) + mat(k,71) = .0113005_r8*rxt(k,547)*y(k,90) + .0166005_r8*rxt(k,548)*y(k,124) + mat(k,79) = .1278005_r8*rxt(k,551)*y(k,90) + .130_r8*rxt(k,552)*y(k,124) + mat(k,1652) = .0128005_r8*rxt(k,555)*y(k,173) + mat(k,85) = .0738005_r8*rxt(k,557)*y(k,90) + .238_r8*rxt(k,558)*y(k,124) + mat(k,91) = .1598005_r8*rxt(k,560)*y(k,90) + .1185005_r8*rxt(k,561)*y(k,124) + mat(k,48) = -(rxt(k,555)*y(k,226)) + mat(k,1653) = -rxt(k,555)*y(k,173) + mat(k,187) = .100_r8*rxt(k,469)*y(k,226) + mat(k,205) = .230_r8*rxt(k,471)*y(k,226) + mat(k,1672) = .100_r8*rxt(k,469)*y(k,181) + .230_r8*rxt(k,471)*y(k,183) + mat(k,650) = -(rxt(k,493)*y(k,226)) + mat(k,1735) = -rxt(k,493)*y(k,175) + mat(k,2145) = rxt(k,491)*y(k,231) + mat(k,1170) = rxt(k,491)*y(k,90) + mat(k,625) = -(rxt(k,494)*y(k,226)) + mat(k,1732) = -rxt(k,494)*y(k,176) + mat(k,2018) = .200_r8*rxt(k,487)*y(k,221) + .200_r8*rxt(k,497)*y(k,232) + mat(k,2215) = .500_r8*rxt(k,485)*y(k,221) + mat(k,1085) = .200_r8*rxt(k,487)*y(k,124) + .500_r8*rxt(k,485)*y(k,199) + mat(k,1058) = .200_r8*rxt(k,497)*y(k,124) + mat(k,477) = -(rxt(k,498)*y(k,226)) + mat(k,1715) = -rxt(k,498)*y(k,177) + mat(k,2136) = rxt(k,496)*y(k,232) + mat(k,1057) = rxt(k,496)*y(k,90) + mat(k,1070) = -(rxt(k,499)*y(k,126) + rxt(k,500)*y(k,226)) + mat(k,1874) = -rxt(k,499)*y(k,178) + mat(k,1767) = -rxt(k,500)*y(k,178) + mat(k,992) = .330_r8*rxt(k,480)*y(k,135) + mat(k,1020) = .330_r8*rxt(k,483)*y(k,135) + mat(k,2040) = .800_r8*rxt(k,487)*y(k,221) + .800_r8*rxt(k,497)*y(k,232) + mat(k,1874) = mat(k,1874) + rxt(k,488)*y(k,221) + mat(k,2380) = .330_r8*rxt(k,480)*y(k,6) + .330_r8*rxt(k,483)*y(k,110) + mat(k,626) = rxt(k,494)*y(k,226) + mat(k,2223) = .500_r8*rxt(k,485)*y(k,221) + rxt(k,495)*y(k,232) + mat(k,1087) = .800_r8*rxt(k,487)*y(k,124) + rxt(k,488)*y(k,126) & + + .500_r8*rxt(k,485)*y(k,199) + mat(k,1767) = mat(k,1767) + rxt(k,494)*y(k,176) + mat(k,1061) = .800_r8*rxt(k,497)*y(k,124) + rxt(k,495)*y(k,199) + mat(k,1101) = -(rxt(k,501)*y(k,226)) + mat(k,1770) = -rxt(k,501)*y(k,179) + mat(k,995) = .300_r8*rxt(k,480)*y(k,135) + mat(k,1023) = .300_r8*rxt(k,483)*y(k,135) + mat(k,2043) = .900_r8*rxt(k,492)*y(k,231) + mat(k,2383) = .300_r8*rxt(k,480)*y(k,6) + .300_r8*rxt(k,483)*y(k,110) + mat(k,2226) = rxt(k,490)*y(k,231) + mat(k,1173) = .900_r8*rxt(k,492)*y(k,124) + rxt(k,490)*y(k,199) + mat(k,663) = -(rxt(k,468)*y(k,226)) + mat(k,1736) = -rxt(k,468)*y(k,180) + mat(k,2146) = rxt(k,466)*y(k,233) + mat(k,747) = rxt(k,466)*y(k,90) + mat(k,185) = -(rxt(k,469)*y(k,226)) + mat(k,1670) = -rxt(k,469)*y(k,181) + mat(k,201) = -(rxt(k,435)*y(k,226)) + mat(k,1673) = -rxt(k,435)*y(k,182) + mat(k,2116) = rxt(k,432)*y(k,235) + mat(k,1225) = rxt(k,432)*y(k,90) + mat(k,206) = -(rxt(k,471)*y(k,226)) + mat(k,1674) = -rxt(k,471)*y(k,183) + mat(k,719) = -(rxt(k,474)*y(k,226)) + mat(k,1741) = -rxt(k,474)*y(k,184) + mat(k,2150) = rxt(k,472)*y(k,236) + mat(k,763) = rxt(k,472)*y(k,90) + mat(k,214) = -(rxt(k,477)*y(k,226)) + mat(k,1675) = -rxt(k,477)*y(k,185) + mat(k,207) = .150_r8*rxt(k,471)*y(k,226) + mat(k,1675) = mat(k,1675) + .150_r8*rxt(k,471)*y(k,183) + mat(k,425) = -(rxt(k,478)*y(k,226)) + mat(k,1708) = -rxt(k,478)*y(k,186) + mat(k,2129) = rxt(k,475)*y(k,238) + mat(k,507) = rxt(k,475)*y(k,90) + mat(k,521) = -(rxt(k,436)*y(k,90) + rxt(k,437)*y(k,124) + rxt(k,465)*y(k,125)) + mat(k,2140) = -rxt(k,436)*y(k,189) + mat(k,2013) = -rxt(k,437)*y(k,189) + mat(k,1818) = -rxt(k,465)*y(k,189) + mat(k,246) = rxt(k,442)*y(k,226) + mat(k,1720) = rxt(k,442)*y(k,22) + mat(k,1040) = -(rxt(k,397)*y(k,90) + (rxt(k,398) + rxt(k,399)) * y(k,124)) + mat(k,2166) = -rxt(k,397)*y(k,190) + mat(k,2037) = -(rxt(k,398) + rxt(k,399)) * y(k,190) + mat(k,688) = rxt(k,400)*y(k,226) + mat(k,234) = rxt(k,401)*y(k,226) + mat(k,1764) = rxt(k,400)*y(k,2) + rxt(k,401)*y(k,15) + mat(k,54) = -(rxt(k,535)*y(k,90) + rxt(k,536)*y(k,124)) + mat(k,2108) = -rxt(k,535)*y(k,191) + mat(k,1992) = -rxt(k,536)*y(k,191) + mat(k,984) = rxt(k,538)*y(k,226) + mat(k,1654) = rxt(k,538)*y(k,6) + mat(k,486) = -(rxt(k,439)*y(k,90) + rxt(k,440)*y(k,124)) + mat(k,2137) = -rxt(k,439)*y(k,192) + mat(k,2010) = -rxt(k,440)*y(k,192) + mat(k,161) = .350_r8*rxt(k,438)*y(k,226) + mat(k,403) = rxt(k,441)*y(k,226) + mat(k,1716) = .350_r8*rxt(k,438)*y(k,7) + rxt(k,441)*y(k,8) + mat(k,60) = -(rxt(k,540)*y(k,90) + rxt(k,541)*y(k,124)) + mat(k,2109) = -rxt(k,540)*y(k,193) + mat(k,1993) = -rxt(k,541)*y(k,193) + mat(k,157) = rxt(k,539)*y(k,226) + mat(k,1655) = rxt(k,539)*y(k,7) + mat(k,433) = -(rxt(k,443)*y(k,90) + rxt(k,445)*y(k,124)) + mat(k,2130) = -rxt(k,443)*y(k,194) + mat(k,2004) = -rxt(k,445)*y(k,194) + mat(k,344) = rxt(k,444)*y(k,226) + mat(k,188) = .070_r8*rxt(k,469)*y(k,226) + mat(k,208) = .060_r8*rxt(k,471)*y(k,226) + mat(k,1709) = rxt(k,444)*y(k,23) + .070_r8*rxt(k,469)*y(k,181) & + .060_r8*rxt(k,471)*y(k,183) - mat(k,840) = -(4._r8*rxt(k,320)*y(k,193) + rxt(k,321)*y(k,197) + rxt(k,322) & - *y(k,203) + rxt(k,323)*y(k,124)) - mat(k,1373) = -rxt(k,321)*y(k,193) - mat(k,2075) = -rxt(k,322)*y(k,193) - mat(k,1479) = -rxt(k,323)*y(k,193) - mat(k,247) = .500_r8*rxt(k,325)*y(k,221) - mat(k,207) = rxt(k,326)*y(k,56) + rxt(k,327)*y(k,221) - mat(k,1531) = rxt(k,326)*y(k,28) - mat(k,1681) = .500_r8*rxt(k,325)*y(k,27) + rxt(k,327)*y(k,28) - mat(k,728) = -(rxt(k,349)*y(k,197) + rxt(k,350)*y(k,203) + rxt(k,351) & - *y(k,124)) - mat(k,1370) = -rxt(k,349)*y(k,194) - mat(k,2069) = -rxt(k,350)*y(k,194) - mat(k,1474) = -rxt(k,351)*y(k,194) - mat(k,304) = rxt(k,352)*y(k,221) - mat(k,56) = rxt(k,353)*y(k,221) - mat(k,1672) = rxt(k,352)*y(k,30) + rxt(k,353)*y(k,31) - mat(k,529) = -(rxt(k,446)*y(k,203) + rxt(k,447)*y(k,124)) - mat(k,2056) = -rxt(k,446)*y(k,195) - mat(k,1461) = -rxt(k,447)*y(k,195) - mat(k,183) = rxt(k,448)*y(k,221) - mat(k,1461) = mat(k,1461) + rxt(k,437)*y(k,189) - mat(k,1743) = rxt(k,463)*y(k,142) - mat(k,358) = rxt(k,463)*y(k,135) - mat(k,401) = rxt(k,437)*y(k,124) + .400_r8*rxt(k,436)*y(k,203) - mat(k,2056) = mat(k,2056) + .400_r8*rxt(k,436)*y(k,189) - mat(k,1656) = rxt(k,448)*y(k,32) - mat(k,1302) = -(4._r8*rxt(k,331)*y(k,196) + rxt(k,332)*y(k,197) + rxt(k,333) & - *y(k,203) + rxt(k,334)*y(k,124) + rxt(k,345)*y(k,125) + rxt(k,372) & - *y(k,207) + rxt(k,405)*y(k,205) + rxt(k,410)*y(k,206) + rxt(k,419) & - *y(k,101) + rxt(k,430)*y(k,229)) - mat(k,1395) = -rxt(k,332)*y(k,196) - mat(k,2098) = -rxt(k,333)*y(k,196) - mat(k,1503) = -rxt(k,334)*y(k,196) - mat(k,1978) = -rxt(k,345)*y(k,196) - mat(k,1233) = -rxt(k,372)*y(k,196) - mat(k,1176) = -rxt(k,405)*y(k,196) - mat(k,1210) = -rxt(k,410)*y(k,196) - mat(k,1128) = -rxt(k,419)*y(k,196) - mat(k,1093) = -rxt(k,430)*y(k,196) - mat(k,868) = .060_r8*rxt(k,480)*y(k,135) - mat(k,1077) = rxt(k,328)*y(k,126) + rxt(k,329)*y(k,221) - mat(k,1153) = rxt(k,354)*y(k,126) + rxt(k,355)*y(k,221) - mat(k,407) = .500_r8*rxt(k,336)*y(k,221) - mat(k,789) = .080_r8*rxt(k,425)*y(k,135) - mat(k,1144) = .100_r8*rxt(k,378)*y(k,135) - mat(k,830) = .060_r8*rxt(k,483)*y(k,135) - mat(k,1253) = .280_r8*rxt(k,392)*y(k,135) - mat(k,1503) = mat(k,1503) + .530_r8*rxt(k,376)*y(k,207) + rxt(k,385)*y(k,209) & - + rxt(k,388)*y(k,211) + rxt(k,363)*y(k,225) - mat(k,1895) = rxt(k,328)*y(k,45) + rxt(k,354)*y(k,49) + .530_r8*rxt(k,375) & - *y(k,207) + rxt(k,386)*y(k,209) - mat(k,1773) = .060_r8*rxt(k,480)*y(k,6) + .080_r8*rxt(k,425)*y(k,98) & + mat(k,899) = -(4._r8*rxt(k,319)*y(k,195) + rxt(k,320)*y(k,199) + rxt(k,321) & + *y(k,90) + rxt(k,322)*y(k,124)) + mat(k,2219) = -rxt(k,320)*y(k,195) + mat(k,2162) = -rxt(k,321)*y(k,195) + mat(k,2032) = -rxt(k,322)*y(k,195) + mat(k,349) = .500_r8*rxt(k,324)*y(k,226) + mat(k,297) = rxt(k,325)*y(k,56) + rxt(k,326)*y(k,226) + mat(k,1930) = rxt(k,325)*y(k,28) + mat(k,1754) = .500_r8*rxt(k,324)*y(k,27) + rxt(k,326)*y(k,28) + mat(k,933) = -(rxt(k,348)*y(k,199) + rxt(k,349)*y(k,90) + rxt(k,350)*y(k,124)) + mat(k,2220) = -rxt(k,348)*y(k,196) + mat(k,2165) = -rxt(k,349)*y(k,196) + mat(k,2035) = -rxt(k,350)*y(k,196) + mat(k,414) = rxt(k,351)*y(k,226) + mat(k,303) = rxt(k,355)*y(k,56) + rxt(k,352)*y(k,226) + mat(k,1932) = rxt(k,355)*y(k,31) + mat(k,1758) = rxt(k,351)*y(k,30) + rxt(k,352)*y(k,31) + mat(k,633) = -(rxt(k,446)*y(k,90) + rxt(k,447)*y(k,124)) + mat(k,2144) = -rxt(k,446)*y(k,197) + mat(k,2019) = -rxt(k,447)*y(k,197) + mat(k,269) = rxt(k,448)*y(k,226) + mat(k,2144) = mat(k,2144) + .400_r8*rxt(k,436)*y(k,189) + mat(k,2019) = mat(k,2019) + rxt(k,437)*y(k,189) + mat(k,2368) = rxt(k,463)*y(k,142) + mat(k,467) = rxt(k,463)*y(k,135) + mat(k,522) = .400_r8*rxt(k,436)*y(k,90) + rxt(k,437)*y(k,124) + mat(k,1733) = rxt(k,448)*y(k,32) + mat(k,1426) = -(4._r8*rxt(k,330)*y(k,198) + rxt(k,331)*y(k,199) + rxt(k,332) & + *y(k,90) + rxt(k,333)*y(k,124) + rxt(k,344)*y(k,125) + rxt(k,372) & + *y(k,211) + rxt(k,405)*y(k,206) + rxt(k,410)*y(k,207) + rxt(k,419) & + *y(k,208) + rxt(k,430)*y(k,235)) + mat(k,2243) = -rxt(k,331)*y(k,198) + mat(k,2188) = -rxt(k,332)*y(k,198) + mat(k,2061) = -rxt(k,333)*y(k,198) + mat(k,1835) = -rxt(k,344)*y(k,198) + mat(k,1356) = -rxt(k,372)*y(k,198) + mat(k,1301) = -rxt(k,405)*y(k,198) + mat(k,1334) = -rxt(k,410)*y(k,198) + mat(k,1255) = -rxt(k,419)*y(k,198) + mat(k,1233) = -rxt(k,430)*y(k,198) + mat(k,999) = .060_r8*rxt(k,480)*y(k,135) + mat(k,1151) = rxt(k,327)*y(k,126) + rxt(k,328)*y(k,226) + mat(k,1280) = rxt(k,353)*y(k,126) + rxt(k,354)*y(k,226) + mat(k,619) = .500_r8*rxt(k,335)*y(k,226) + mat(k,2188) = mat(k,2188) + .450_r8*rxt(k,383)*y(k,213) + .200_r8*rxt(k,387) & + *y(k,215) + .150_r8*rxt(k,362)*y(k,230) + mat(k,889) = .080_r8*rxt(k,425)*y(k,135) + mat(k,1271) = .100_r8*rxt(k,378)*y(k,135) + mat(k,1027) = .060_r8*rxt(k,483)*y(k,135) + mat(k,1376) = .280_r8*rxt(k,392)*y(k,135) + mat(k,2061) = mat(k,2061) + .530_r8*rxt(k,376)*y(k,211) + rxt(k,385)*y(k,213) & + + rxt(k,388)*y(k,215) + rxt(k,363)*y(k,230) + mat(k,1896) = rxt(k,327)*y(k,45) + rxt(k,353)*y(k,49) + .530_r8*rxt(k,375) & + *y(k,211) + rxt(k,386)*y(k,213) + mat(k,2399) = .060_r8*rxt(k,480)*y(k,6) + .080_r8*rxt(k,425)*y(k,99) & + .100_r8*rxt(k,378)*y(k,105) + .060_r8*rxt(k,483)*y(k,110) & + .280_r8*rxt(k,392)*y(k,111) - mat(k,985) = .650_r8*rxt(k,501)*y(k,221) - mat(k,1302) = mat(k,1302) + .530_r8*rxt(k,372)*y(k,207) - mat(k,1395) = mat(k,1395) + .260_r8*rxt(k,373)*y(k,207) + rxt(k,382)*y(k,209) & - + .300_r8*rxt(k,361)*y(k,225) - mat(k,2098) = mat(k,2098) + .450_r8*rxt(k,383)*y(k,209) + .200_r8*rxt(k,387) & - *y(k,211) + .150_r8*rxt(k,362)*y(k,225) - mat(k,1233) = mat(k,1233) + .530_r8*rxt(k,376)*y(k,124) + .530_r8*rxt(k,375) & - *y(k,126) + .530_r8*rxt(k,372)*y(k,196) + .260_r8*rxt(k,373) & - *y(k,197) - mat(k,1272) = rxt(k,385)*y(k,124) + rxt(k,386)*y(k,126) + rxt(k,382)*y(k,197) & - + .450_r8*rxt(k,383)*y(k,203) + 4.000_r8*rxt(k,384)*y(k,209) - mat(k,560) = rxt(k,388)*y(k,124) + .200_r8*rxt(k,387)*y(k,203) - mat(k,1710) = rxt(k,329)*y(k,45) + rxt(k,355)*y(k,49) + .500_r8*rxt(k,336) & + mat(k,1104) = .650_r8*rxt(k,501)*y(k,226) + mat(k,1426) = mat(k,1426) + .530_r8*rxt(k,372)*y(k,211) + mat(k,2243) = mat(k,2243) + .260_r8*rxt(k,373)*y(k,211) + rxt(k,382)*y(k,213) & + + .300_r8*rxt(k,361)*y(k,230) + mat(k,1356) = mat(k,1356) + .530_r8*rxt(k,376)*y(k,124) + .530_r8*rxt(k,375) & + *y(k,126) + .530_r8*rxt(k,372)*y(k,198) + .260_r8*rxt(k,373) & + *y(k,199) + mat(k,1396) = .450_r8*rxt(k,383)*y(k,90) + rxt(k,385)*y(k,124) + rxt(k,386) & + *y(k,126) + rxt(k,382)*y(k,199) + 4.000_r8*rxt(k,384)*y(k,213) + mat(k,698) = .200_r8*rxt(k,387)*y(k,90) + rxt(k,388)*y(k,124) + mat(k,1789) = rxt(k,328)*y(k,45) + rxt(k,354)*y(k,49) + .500_r8*rxt(k,335) & *y(k,51) + .650_r8*rxt(k,501)*y(k,179) - mat(k,1067) = rxt(k,363)*y(k,124) + .300_r8*rxt(k,361)*y(k,197) & - + .150_r8*rxt(k,362)*y(k,203) - mat(k,1396) = -(rxt(k,221)*y(k,59) + (4._r8*rxt(k,298) + 4._r8*rxt(k,299) & - ) * y(k,197) + rxt(k,300)*y(k,203) + rxt(k,301)*y(k,124) & - + rxt(k,321)*y(k,193) + rxt(k,332)*y(k,196) + rxt(k,349) & - *y(k,194) + rxt(k,361)*y(k,225) + rxt(k,373)*y(k,207) + rxt(k,382) & - *y(k,209) + rxt(k,406)*y(k,205) + rxt(k,411)*y(k,206) + rxt(k,420) & - *y(k,101) + rxt(k,431)*y(k,229) + rxt(k,485)*y(k,216) + rxt(k,490) & - *y(k,226) + rxt(k,495)*y(k,227)) - mat(k,2128) = -rxt(k,221)*y(k,197) - mat(k,2101) = -rxt(k,300)*y(k,197) - mat(k,1505) = -rxt(k,301)*y(k,197) - mat(k,842) = -rxt(k,321)*y(k,197) - mat(k,1303) = -rxt(k,332)*y(k,197) - mat(k,731) = -rxt(k,349)*y(k,197) - mat(k,1068) = -rxt(k,361)*y(k,197) - mat(k,1234) = -rxt(k,373)*y(k,197) - mat(k,1273) = -rxt(k,382)*y(k,197) - mat(k,1177) = -rxt(k,406)*y(k,197) - mat(k,1211) = -rxt(k,411)*y(k,197) - mat(k,1129) = -rxt(k,420)*y(k,197) - mat(k,1094) = -rxt(k,431)*y(k,197) - mat(k,1052) = -rxt(k,485)*y(k,197) - mat(k,1033) = -rxt(k,490)*y(k,197) - mat(k,1013) = -rxt(k,495)*y(k,197) - mat(k,949) = .280_r8*rxt(k,348)*y(k,135) - mat(k,447) = rxt(k,335)*y(k,221) - mat(k,310) = .700_r8*rxt(k,303)*y(k,221) - mat(k,790) = .050_r8*rxt(k,425)*y(k,135) - mat(k,1129) = mat(k,1129) + rxt(k,419)*y(k,196) - mat(k,1505) = mat(k,1505) + rxt(k,334)*y(k,196) + .830_r8*rxt(k,451)*y(k,198) & - + .170_r8*rxt(k,457)*y(k,210) - mat(k,1776) = .280_r8*rxt(k,348)*y(k,29) + .050_r8*rxt(k,425)*y(k,98) - mat(k,1303) = mat(k,1303) + rxt(k,419)*y(k,101) + rxt(k,334)*y(k,124) & - + 4.000_r8*rxt(k,331)*y(k,196) + .900_r8*rxt(k,332)*y(k,197) & - + .450_r8*rxt(k,333)*y(k,203) + rxt(k,405)*y(k,205) + rxt(k,410) & - *y(k,206) + rxt(k,372)*y(k,207) + rxt(k,381)*y(k,209) & - + rxt(k,430)*y(k,229) - mat(k,1396) = mat(k,1396) + .900_r8*rxt(k,332)*y(k,196) - mat(k,648) = .830_r8*rxt(k,451)*y(k,124) + .330_r8*rxt(k,450)*y(k,203) - mat(k,2101) = mat(k,2101) + .450_r8*rxt(k,333)*y(k,196) + .330_r8*rxt(k,450) & - *y(k,198) + .070_r8*rxt(k,456)*y(k,210) - mat(k,1177) = mat(k,1177) + rxt(k,405)*y(k,196) - mat(k,1211) = mat(k,1211) + rxt(k,410)*y(k,196) - mat(k,1234) = mat(k,1234) + rxt(k,372)*y(k,196) - mat(k,1273) = mat(k,1273) + rxt(k,381)*y(k,196) - mat(k,806) = .170_r8*rxt(k,457)*y(k,124) + .070_r8*rxt(k,456)*y(k,203) - mat(k,1714) = rxt(k,335)*y(k,50) + .700_r8*rxt(k,303)*y(k,53) - mat(k,1094) = mat(k,1094) + rxt(k,430)*y(k,196) + mat(k,1217) = .150_r8*rxt(k,362)*y(k,90) + rxt(k,363)*y(k,124) & + + .300_r8*rxt(k,361)*y(k,199) + mat(k,2257) = -(rxt(k,221)*y(k,59) + (4._r8*rxt(k,298) + 4._r8*rxt(k,299) & + ) * y(k,199) + rxt(k,300)*y(k,90) + rxt(k,301)*y(k,124) & + + rxt(k,320)*y(k,195) + rxt(k,331)*y(k,198) + rxt(k,348) & + *y(k,196) + rxt(k,361)*y(k,230) + rxt(k,373)*y(k,211) + rxt(k,382) & + *y(k,213) + rxt(k,406)*y(k,206) + rxt(k,411)*y(k,207) + rxt(k,420) & + *y(k,208) + rxt(k,431)*y(k,235) + rxt(k,485)*y(k,221) + rxt(k,490) & + *y(k,231) + rxt(k,495)*y(k,232)) + mat(k,1600) = -rxt(k,221)*y(k,199) + mat(k,2205) = -rxt(k,300)*y(k,199) + mat(k,2076) = -rxt(k,301)*y(k,199) + mat(k,906) = -rxt(k,320)*y(k,199) + mat(k,1435) = -rxt(k,331)*y(k,199) + mat(k,941) = -rxt(k,348)*y(k,199) + mat(k,1222) = -rxt(k,361)*y(k,199) + mat(k,1364) = -rxt(k,373)*y(k,199) + mat(k,1404) = -rxt(k,382)*y(k,199) + mat(k,1309) = -rxt(k,406)*y(k,199) + mat(k,1342) = -rxt(k,411)*y(k,199) + mat(k,1263) = -rxt(k,420)*y(k,199) + mat(k,1240) = -rxt(k,431)*y(k,199) + mat(k,1098) = -rxt(k,485)*y(k,199) + mat(k,1185) = -rxt(k,490)*y(k,199) + mat(k,1068) = -rxt(k,495)*y(k,199) + mat(k,1144) = .280_r8*rxt(k,347)*y(k,135) + mat(k,706) = rxt(k,334)*y(k,226) + mat(k,392) = .700_r8*rxt(k,303)*y(k,226) + mat(k,2282) = rxt(k,215)*y(k,56) + rxt(k,271)*y(k,73) + rxt(k,310)*y(k,222) & + + rxt(k,304)*y(k,226) + mat(k,1958) = rxt(k,215)*y(k,54) + mat(k,929) = rxt(k,271)*y(k,54) + mat(k,2205) = mat(k,2205) + .450_r8*rxt(k,332)*y(k,198) + .330_r8*rxt(k,450) & + *y(k,200) + .070_r8*rxt(k,456)*y(k,214) + mat(k,893) = .050_r8*rxt(k,425)*y(k,135) + mat(k,2076) = mat(k,2076) + rxt(k,333)*y(k,198) + .830_r8*rxt(k,451)*y(k,200) & + + .170_r8*rxt(k,457)*y(k,214) + mat(k,2415) = .280_r8*rxt(k,347)*y(k,29) + .050_r8*rxt(k,425)*y(k,99) + mat(k,1435) = mat(k,1435) + .450_r8*rxt(k,332)*y(k,90) + rxt(k,333)*y(k,124) & + + 4.000_r8*rxt(k,330)*y(k,198) + .900_r8*rxt(k,331)*y(k,199) & + + rxt(k,405)*y(k,206) + rxt(k,410)*y(k,207) + rxt(k,419) & + *y(k,208) + rxt(k,372)*y(k,211) + rxt(k,381)*y(k,213) & + + rxt(k,430)*y(k,235) + mat(k,2257) = mat(k,2257) + .900_r8*rxt(k,331)*y(k,198) + mat(k,783) = .330_r8*rxt(k,450)*y(k,90) + .830_r8*rxt(k,451)*y(k,124) + mat(k,1309) = mat(k,1309) + rxt(k,405)*y(k,198) + mat(k,1342) = mat(k,1342) + rxt(k,410)*y(k,198) + mat(k,1263) = mat(k,1263) + rxt(k,419)*y(k,198) + mat(k,1364) = mat(k,1364) + rxt(k,372)*y(k,198) + mat(k,1404) = mat(k,1404) + rxt(k,381)*y(k,198) + mat(k,921) = .070_r8*rxt(k,456)*y(k,90) + .170_r8*rxt(k,457)*y(k,124) + mat(k,1642) = rxt(k,310)*y(k,54) + mat(k,1807) = rxt(k,334)*y(k,50) + .700_r8*rxt(k,303)*y(k,53) + rxt(k,304) & + *y(k,54) + mat(k,1240) = mat(k,1240) + rxt(k,430)*y(k,198) end do - end subroutine nlnmat07 - subroutine nlnmat08( avec_len, mat, y, rxt ) + end subroutine nlnmat08 + subroutine nlnmat09( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -1663,215 +2086,212 @@ subroutine nlnmat08( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,645) = -(rxt(k,450)*y(k,203) + rxt(k,451)*y(k,124) + rxt(k,452) & - *y(k,125)) - mat(k,2064) = -rxt(k,450)*y(k,198) - mat(k,1467) = -rxt(k,451)*y(k,198) - mat(k,1967) = -rxt(k,452)*y(k,198) - mat(k,701) = -(rxt(k,565)*y(k,214) + rxt(k,566)*y(k,220) + rxt(k,567) & - *y(k,213)) - mat(k,691) = -rxt(k,565)*y(k,199) - mat(k,683) = -rxt(k,566)*y(k,199) - mat(k,570) = -rxt(k,567)*y(k,199) - mat(k,458) = -((rxt(k,369) + rxt(k,370)) * y(k,124)) - mat(k,1457) = -(rxt(k,369) + rxt(k,370)) * y(k,200) - mat(k,260) = rxt(k,368)*y(k,221) - mat(k,1648) = rxt(k,368)*y(k,16) - mat(k,345) = -(rxt(k,340)*y(k,134)) - mat(k,1412) = -rxt(k,340)*y(k,201) - mat(k,1450) = .750_r8*rxt(k,338)*y(k,202) - mat(k,663) = .750_r8*rxt(k,338)*y(k,124) - mat(k,664) = -(rxt(k,337)*y(k,203) + rxt(k,338)*y(k,124)) - mat(k,2066) = -rxt(k,337)*y(k,202) - mat(k,1468) = -rxt(k,338)*y(k,202) - mat(k,451) = rxt(k,344)*y(k,221) - mat(k,1667) = rxt(k,344)*y(k,25) - mat(k,2115) = -((rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,76) + rxt(k,176) & - *y(k,133) + rxt(k,177)*y(k,135) + rxt(k,181)*y(k,221) & - + 4._r8*rxt(k,186)*y(k,203) + rxt(k,198)*y(k,126) + rxt(k,203) & - *y(k,124) + rxt(k,208)*y(k,125) + (rxt(k,218) + rxt(k,219) & - ) * y(k,56) + rxt(k,225)*y(k,59) + rxt(k,251)*y(k,17) + rxt(k,257) & - *y(k,19) + rxt(k,294)*y(k,42) + rxt(k,300)*y(k,197) + rxt(k,308) & - *y(k,204) + rxt(k,322)*y(k,193) + rxt(k,333)*y(k,196) + rxt(k,337) & - *y(k,202) + rxt(k,350)*y(k,194) + rxt(k,358)*y(k,224) + rxt(k,362) & - *y(k,225) + rxt(k,374)*y(k,207) + rxt(k,383)*y(k,209) + rxt(k,387) & - *y(k,211) + rxt(k,397)*y(k,190) + rxt(k,407)*y(k,205) + rxt(k,412) & - *y(k,206) + rxt(k,421)*y(k,101) + rxt(k,432)*y(k,229) + rxt(k,436) & - *y(k,189) + rxt(k,439)*y(k,191) + rxt(k,443)*y(k,192) + rxt(k,446) & - *y(k,195) + rxt(k,450)*y(k,198) + rxt(k,453)*y(k,208) + rxt(k,456) & - *y(k,210) + rxt(k,459)*y(k,223) + rxt(k,466)*y(k,228) + rxt(k,472) & - *y(k,230) + rxt(k,475)*y(k,231) + rxt(k,486)*y(k,216) + rxt(k,491) & - *y(k,226) + rxt(k,496)*y(k,227)) - mat(k,1932) = -(rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,203) - mat(k,1831) = -rxt(k,176)*y(k,203) - mat(k,1790) = -rxt(k,177)*y(k,203) - mat(k,1728) = -rxt(k,181)*y(k,203) - mat(k,1912) = -rxt(k,198)*y(k,203) - mat(k,1519) = -rxt(k,203)*y(k,203) - mat(k,1996) = -rxt(k,208)*y(k,203) - mat(k,1554) = -(rxt(k,218) + rxt(k,219)) * y(k,203) - mat(k,2142) = -rxt(k,225)*y(k,203) - mat(k,1361) = -rxt(k,251)*y(k,203) - mat(k,2020) = -rxt(k,257)*y(k,203) - mat(k,1855) = -rxt(k,294)*y(k,203) - mat(k,1407) = -rxt(k,300)*y(k,203) - mat(k,334) = -rxt(k,308)*y(k,203) - mat(k,848) = -rxt(k,322)*y(k,203) - mat(k,1313) = -rxt(k,333)*y(k,203) - mat(k,671) = -rxt(k,337)*y(k,203) - mat(k,737) = -rxt(k,350)*y(k,203) - mat(k,725) = -rxt(k,358)*y(k,203) - mat(k,1073) = -rxt(k,362)*y(k,203) - mat(k,1242) = -rxt(k,374)*y(k,203) - mat(k,1282) = -rxt(k,383)*y(k,203) - mat(k,564) = -rxt(k,387)*y(k,203) - mat(k,890) = -rxt(k,397)*y(k,203) - mat(k,1186) = -rxt(k,407)*y(k,203) - mat(k,1220) = -rxt(k,412)*y(k,203) - mat(k,1137) = -rxt(k,421)*y(k,203) - mat(k,1101) = -rxt(k,432)*y(k,203) - mat(k,405) = -rxt(k,436)*y(k,203) - mat(k,383) = -rxt(k,439)*y(k,203) - mat(k,328) = -rxt(k,443)*y(k,203) - mat(k,534) = -rxt(k,446)*y(k,203) - mat(k,652) = -rxt(k,450)*y(k,203) - mat(k,612) = -rxt(k,453)*y(k,203) - mat(k,810) = -rxt(k,456)*y(k,203) - mat(k,341) = -rxt(k,459)*y(k,203) - mat(k,627) = -rxt(k,466)*y(k,203) - mat(k,644) = -rxt(k,472)*y(k,203) - mat(k,398) = -rxt(k,475)*y(k,203) - mat(k,1060) = -rxt(k,486)*y(k,203) - mat(k,1040) = -rxt(k,491)*y(k,203) - mat(k,1021) = -rxt(k,496)*y(k,203) - mat(k,873) = .570_r8*rxt(k,480)*y(k,135) - mat(k,91) = .650_r8*rxt(k,438)*y(k,221) - mat(k,1361) = mat(k,1361) + rxt(k,250)*y(k,42) - mat(k,2020) = mat(k,2020) + rxt(k,262)*y(k,221) - mat(k,205) = .350_r8*rxt(k,317)*y(k,221) - mat(k,457) = .130_r8*rxt(k,319)*y(k,135) - mat(k,180) = rxt(k,324)*y(k,221) - mat(k,957) = .280_r8*rxt(k,348)*y(k,135) - mat(k,1855) = mat(k,1855) + rxt(k,250)*y(k,17) + rxt(k,214)*y(k,56) & - + rxt(k,295)*y(k,126) + rxt(k,296)*y(k,133) - mat(k,54) = rxt(k,330)*y(k,221) - mat(k,711) = rxt(k,302)*y(k,221) - mat(k,1554) = mat(k,1554) + rxt(k,214)*y(k,42) + rxt(k,217)*y(k,79) - mat(k,2142) = mat(k,2142) + rxt(k,221)*y(k,197) + rxt(k,232)*y(k,221) - mat(k,1000) = rxt(k,305)*y(k,221) - mat(k,125) = .730_r8*rxt(k,449)*y(k,221) - mat(k,196) = .500_r8*rxt(k,516)*y(k,221) - mat(k,964) = rxt(k,341)*y(k,221) - mat(k,801) = rxt(k,342)*y(k,221) - mat(k,1932) = mat(k,1932) + rxt(k,175)*y(k,134) - mat(k,479) = rxt(k,217)*y(k,56) + rxt(k,171)*y(k,133) + rxt(k,180)*y(k,221) - mat(k,108) = rxt(k,306)*y(k,221) - mat(k,714) = rxt(k,307)*y(k,221) - mat(k,979) = rxt(k,371)*y(k,221) - mat(k,996) = rxt(k,356)*y(k,221) - mat(k,795) = .370_r8*rxt(k,425)*y(k,135) - mat(k,513) = .300_r8*rxt(k,416)*y(k,221) - mat(k,429) = rxt(k,417)*y(k,221) - mat(k,1137) = mat(k,1137) + rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126) & - + rxt(k,419)*y(k,196) + 1.200_r8*rxt(k,420)*y(k,197) - mat(k,302) = rxt(k,424)*y(k,221) - mat(k,1149) = .140_r8*rxt(k,378)*y(k,135) - mat(k,219) = .200_r8*rxt(k,380)*y(k,221) - mat(k,473) = .500_r8*rxt(k,391)*y(k,221) - mat(k,835) = .570_r8*rxt(k,483)*y(k,135) - mat(k,1264) = .280_r8*rxt(k,392)*y(k,135) - mat(k,272) = rxt(k,428)*y(k,221) - mat(k,938) = rxt(k,429)*y(k,221) - mat(k,1519) = mat(k,1519) + rxt(k,422)*y(k,101) + rxt(k,398)*y(k,190) & - + rxt(k,440)*y(k,191) + rxt(k,445)*y(k,192) + rxt(k,323) & - *y(k,193) + rxt(k,351)*y(k,194) + rxt(k,301)*y(k,197) & - + .170_r8*rxt(k,451)*y(k,198) + rxt(k,369)*y(k,200) & - + .250_r8*rxt(k,338)*y(k,202) + rxt(k,310)*y(k,204) & - + .920_r8*rxt(k,408)*y(k,205) + .920_r8*rxt(k,414)*y(k,206) & - + .470_r8*rxt(k,376)*y(k,207) + .400_r8*rxt(k,454)*y(k,208) & - + .830_r8*rxt(k,457)*y(k,210) + rxt(k,460)*y(k,223) + rxt(k,359) & - *y(k,224) + .900_r8*rxt(k,492)*y(k,226) + .800_r8*rxt(k,497) & - *y(k,227) + rxt(k,467)*y(k,228) + rxt(k,433)*y(k,229) & - + rxt(k,473)*y(k,230) + rxt(k,476)*y(k,231) - mat(k,1912) = mat(k,1912) + rxt(k,295)*y(k,42) + rxt(k,423)*y(k,101) & - + rxt(k,409)*y(k,205) + rxt(k,415)*y(k,206) + .470_r8*rxt(k,375) & - *y(k,207) + rxt(k,201)*y(k,221) + rxt(k,434)*y(k,229) - mat(k,1831) = mat(k,1831) + rxt(k,296)*y(k,42) + rxt(k,171)*y(k,79) - mat(k,1438) = rxt(k,175)*y(k,76) + rxt(k,340)*y(k,201) - mat(k,1790) = mat(k,1790) + .570_r8*rxt(k,480)*y(k,6) + .130_r8*rxt(k,319) & - *y(k,25) + .280_r8*rxt(k,348)*y(k,29) + .370_r8*rxt(k,425) & - *y(k,98) + .140_r8*rxt(k,378)*y(k,105) + .570_r8*rxt(k,483) & - *y(k,110) + .280_r8*rxt(k,392)*y(k,111) + rxt(k,183)*y(k,221) - mat(k,100) = .800_r8*rxt(k,461)*y(k,221) - mat(k,896) = rxt(k,517)*y(k,221) - mat(k,989) = .200_r8*rxt(k,501)*y(k,221) - mat(k,120) = .280_r8*rxt(k,469)*y(k,221) - mat(k,146) = .380_r8*rxt(k,471)*y(k,221) - mat(k,151) = .630_r8*rxt(k,477)*y(k,221) - mat(k,890) = mat(k,890) + rxt(k,398)*y(k,124) - mat(k,383) = mat(k,383) + rxt(k,440)*y(k,124) - mat(k,328) = mat(k,328) + rxt(k,445)*y(k,124) - mat(k,848) = mat(k,848) + rxt(k,323)*y(k,124) + 2.400_r8*rxt(k,320)*y(k,193) & - + rxt(k,321)*y(k,197) - mat(k,737) = mat(k,737) + rxt(k,351)*y(k,124) + rxt(k,349)*y(k,197) - mat(k,1313) = mat(k,1313) + rxt(k,419)*y(k,101) + .900_r8*rxt(k,332)*y(k,197) & - + rxt(k,405)*y(k,205) + rxt(k,410)*y(k,206) + .470_r8*rxt(k,372) & - *y(k,207) + rxt(k,430)*y(k,229) - mat(k,1407) = mat(k,1407) + rxt(k,221)*y(k,59) + 1.200_r8*rxt(k,420)*y(k,101) & - + rxt(k,301)*y(k,124) + rxt(k,321)*y(k,193) + rxt(k,349) & - *y(k,194) + .900_r8*rxt(k,332)*y(k,196) + 4.000_r8*rxt(k,298) & - *y(k,197) + rxt(k,406)*y(k,205) + rxt(k,411)*y(k,206) & - + .730_r8*rxt(k,373)*y(k,207) + rxt(k,382)*y(k,209) & - + .500_r8*rxt(k,485)*y(k,216) + .300_r8*rxt(k,361)*y(k,225) & - + rxt(k,490)*y(k,226) + rxt(k,495)*y(k,227) + .800_r8*rxt(k,431) & - *y(k,229) - mat(k,652) = mat(k,652) + .170_r8*rxt(k,451)*y(k,124) + .070_r8*rxt(k,450) & - *y(k,203) - mat(k,465) = rxt(k,369)*y(k,124) - mat(k,349) = rxt(k,340)*y(k,134) - mat(k,671) = mat(k,671) + .250_r8*rxt(k,338)*y(k,124) - mat(k,2115) = mat(k,2115) + .070_r8*rxt(k,450)*y(k,198) + .160_r8*rxt(k,453) & - *y(k,208) + .330_r8*rxt(k,456)*y(k,210) - mat(k,334) = mat(k,334) + rxt(k,310)*y(k,124) - mat(k,1186) = mat(k,1186) + .920_r8*rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126) & - + rxt(k,405)*y(k,196) + rxt(k,406)*y(k,197) - mat(k,1220) = mat(k,1220) + .920_r8*rxt(k,414)*y(k,124) + rxt(k,415)*y(k,126) & - + rxt(k,410)*y(k,196) + rxt(k,411)*y(k,197) - mat(k,1242) = mat(k,1242) + .470_r8*rxt(k,376)*y(k,124) + .470_r8*rxt(k,375) & - *y(k,126) + .470_r8*rxt(k,372)*y(k,196) + .730_r8*rxt(k,373) & - *y(k,197) - mat(k,612) = mat(k,612) + .400_r8*rxt(k,454)*y(k,124) + .160_r8*rxt(k,453) & - *y(k,203) - mat(k,1282) = mat(k,1282) + rxt(k,382)*y(k,197) - mat(k,810) = mat(k,810) + .830_r8*rxt(k,457)*y(k,124) + .330_r8*rxt(k,456) & - *y(k,203) - mat(k,1060) = mat(k,1060) + .500_r8*rxt(k,485)*y(k,197) - mat(k,1728) = mat(k,1728) + .650_r8*rxt(k,438)*y(k,7) + rxt(k,262)*y(k,19) & - + .350_r8*rxt(k,317)*y(k,24) + rxt(k,324)*y(k,26) + rxt(k,330) & - *y(k,47) + rxt(k,302)*y(k,52) + rxt(k,232)*y(k,59) + rxt(k,305) & - *y(k,62) + .730_r8*rxt(k,449)*y(k,66) + .500_r8*rxt(k,516) & - *y(k,67) + rxt(k,341)*y(k,74) + rxt(k,342)*y(k,75) + rxt(k,180) & - *y(k,79) + rxt(k,306)*y(k,86) + rxt(k,307)*y(k,87) + rxt(k,371) & - *y(k,93) + rxt(k,356)*y(k,95) + .300_r8*rxt(k,416)*y(k,99) & - + rxt(k,417)*y(k,100) + rxt(k,424)*y(k,102) + .200_r8*rxt(k,380) & - *y(k,106) + .500_r8*rxt(k,391)*y(k,109) + rxt(k,428)*y(k,115) & - + rxt(k,429)*y(k,116) + rxt(k,201)*y(k,126) + rxt(k,183) & - *y(k,135) + .800_r8*rxt(k,461)*y(k,143) + rxt(k,517)*y(k,152) & - + .200_r8*rxt(k,501)*y(k,179) + .280_r8*rxt(k,469)*y(k,181) & - + .380_r8*rxt(k,471)*y(k,183) + .630_r8*rxt(k,477)*y(k,185) - mat(k,341) = mat(k,341) + rxt(k,460)*y(k,124) - mat(k,725) = mat(k,725) + rxt(k,359)*y(k,124) - mat(k,1073) = mat(k,1073) + .300_r8*rxt(k,361)*y(k,197) - mat(k,1040) = mat(k,1040) + .900_r8*rxt(k,492)*y(k,124) + rxt(k,490)*y(k,197) - mat(k,1021) = mat(k,1021) + .800_r8*rxt(k,497)*y(k,124) + rxt(k,495)*y(k,197) - mat(k,627) = mat(k,627) + rxt(k,467)*y(k,124) - mat(k,1101) = mat(k,1101) + rxt(k,433)*y(k,124) + rxt(k,434)*y(k,126) & - + rxt(k,430)*y(k,196) + .800_r8*rxt(k,431)*y(k,197) - mat(k,644) = mat(k,644) + rxt(k,473)*y(k,124) - mat(k,398) = mat(k,398) + rxt(k,476)*y(k,124) + mat(k,776) = -(rxt(k,450)*y(k,90) + rxt(k,451)*y(k,124) + rxt(k,452)*y(k,125)) + mat(k,2155) = -rxt(k,450)*y(k,200) + mat(k,2025) = -rxt(k,451)*y(k,200) + mat(k,1824) = -rxt(k,452)*y(k,200) + mat(k,863) = -(rxt(k,579)*y(k,219) + rxt(k,580)*y(k,225) + rxt(k,581) & + *y(k,218)) + mat(k,844) = -rxt(k,579)*y(k,201) + mat(k,852) = -rxt(k,580)*y(k,201) + mat(k,678) = -rxt(k,581)*y(k,201) + mat(k,572) = -((rxt(k,369) + rxt(k,370)) * y(k,124)) + mat(k,2015) = -(rxt(k,369) + rxt(k,370)) * y(k,202) + mat(k,354) = rxt(k,368)*y(k,226) + mat(k,1725) = rxt(k,368)*y(k,16) + mat(k,461) = -(rxt(k,339)*y(k,134)) + mat(k,1524) = -rxt(k,339)*y(k,203) + mat(k,2008) = .750_r8*rxt(k,337)*y(k,204) + mat(k,794) = .750_r8*rxt(k,337)*y(k,124) + mat(k,795) = -(rxt(k,336)*y(k,90) + rxt(k,337)*y(k,124)) + mat(k,2157) = -rxt(k,336)*y(k,204) + mat(k,2026) = -rxt(k,337)*y(k,204) + mat(k,549) = rxt(k,343)*y(k,226) + mat(k,1747) = rxt(k,343)*y(k,25) + mat(k,439) = -(rxt(k,307)*y(k,90) + rxt(k,309)*y(k,124)) + mat(k,2131) = -rxt(k,307)*y(k,205) + mat(k,2005) = -rxt(k,309)*y(k,205) + mat(k,2331) = rxt(k,294)*y(k,90) + mat(k,2131) = mat(k,2131) + rxt(k,294)*y(k,42) + mat(k,1297) = -(rxt(k,405)*y(k,198) + rxt(k,406)*y(k,199) + rxt(k,407) & + *y(k,90) + rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126)) + mat(k,1421) = -rxt(k,405)*y(k,206) + mat(k,2238) = -rxt(k,406)*y(k,206) + mat(k,2183) = -rxt(k,407)*y(k,206) + mat(k,2056) = -rxt(k,408)*y(k,206) + mat(k,1891) = -rxt(k,409)*y(k,206) + mat(k,886) = .600_r8*rxt(k,426)*y(k,226) + mat(k,1784) = .600_r8*rxt(k,426)*y(k,99) + mat(k,1330) = -(rxt(k,410)*y(k,198) + rxt(k,411)*y(k,199) + rxt(k,412) & + *y(k,90) + rxt(k,414)*y(k,124) + rxt(k,415)*y(k,126)) + mat(k,1422) = -rxt(k,410)*y(k,207) + mat(k,2239) = -rxt(k,411)*y(k,207) + mat(k,2184) = -rxt(k,412)*y(k,207) + mat(k,2057) = -rxt(k,414)*y(k,207) + mat(k,1892) = -rxt(k,415)*y(k,207) + mat(k,887) = .400_r8*rxt(k,426)*y(k,226) + mat(k,1785) = .400_r8*rxt(k,426)*y(k,99) + mat(k,1251) = -(rxt(k,419)*y(k,198) + rxt(k,420)*y(k,199) + rxt(k,421) & + *y(k,90) + rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126)) + mat(k,1418) = -rxt(k,419)*y(k,208) + mat(k,2235) = -rxt(k,420)*y(k,208) + mat(k,2180) = -rxt(k,421)*y(k,208) + mat(k,2053) = -rxt(k,422)*y(k,208) + mat(k,1888) = -rxt(k,423)*y(k,208) + mat(k,884) = rxt(k,418)*y(k,126) + mat(k,1888) = mat(k,1888) + rxt(k,418)*y(k,99) + mat(k,66) = -(rxt(k,543)*y(k,90) + rxt(k,544)*y(k,124)) + mat(k,2110) = -rxt(k,543)*y(k,209) + mat(k,1994) = -rxt(k,544)*y(k,209) + mat(k,879) = rxt(k,546)*y(k,226) + mat(k,1656) = rxt(k,546)*y(k,99) + mat(k,72) = -(rxt(k,547)*y(k,90) + rxt(k,548)*y(k,124)) + mat(k,2111) = -rxt(k,547)*y(k,210) + mat(k,1995) = -rxt(k,548)*y(k,210) + mat(k,73) = rxt(k,549)*y(k,226) + mat(k,1657) = rxt(k,549)*y(k,104) + mat(k,1354) = -(rxt(k,372)*y(k,198) + rxt(k,373)*y(k,199) + rxt(k,374) & + *y(k,90) + rxt(k,375)*y(k,126) + (rxt(k,376) + rxt(k,377) & + ) * y(k,124)) + mat(k,1423) = -rxt(k,372)*y(k,211) + mat(k,2240) = -rxt(k,373)*y(k,211) + mat(k,2185) = -rxt(k,374)*y(k,211) + mat(k,1893) = -rxt(k,375)*y(k,211) + mat(k,2058) = -(rxt(k,376) + rxt(k,377)) * y(k,211) + mat(k,1269) = .500_r8*rxt(k,379)*y(k,226) + mat(k,315) = .200_r8*rxt(k,380)*y(k,226) + mat(k,1373) = rxt(k,393)*y(k,226) + mat(k,1786) = .500_r8*rxt(k,379)*y(k,105) + .200_r8*rxt(k,380)*y(k,106) & + + rxt(k,393)*y(k,111) + mat(k,738) = -(rxt(k,453)*y(k,90) + rxt(k,454)*y(k,124) + rxt(k,455)*y(k,125)) + mat(k,2152) = -rxt(k,453)*y(k,212) + mat(k,2022) = -rxt(k,454)*y(k,212) + mat(k,1823) = -rxt(k,455)*y(k,212) + mat(k,1395) = -(rxt(k,381)*y(k,198) + rxt(k,382)*y(k,199) + rxt(k,383) & + *y(k,90) + 4._r8*rxt(k,384)*y(k,213) + rxt(k,385)*y(k,124) & + + rxt(k,386)*y(k,126) + rxt(k,394)*y(k,125)) + mat(k,1425) = -rxt(k,381)*y(k,213) + mat(k,2242) = -rxt(k,382)*y(k,213) + mat(k,2187) = -rxt(k,383)*y(k,213) + mat(k,2060) = -rxt(k,385)*y(k,213) + mat(k,1895) = -rxt(k,386)*y(k,213) + mat(k,1834) = -rxt(k,394)*y(k,213) + mat(k,1270) = .500_r8*rxt(k,379)*y(k,226) + mat(k,316) = .500_r8*rxt(k,380)*y(k,226) + mat(k,1788) = .500_r8*rxt(k,379)*y(k,105) + .500_r8*rxt(k,380)*y(k,106) + mat(k,913) = -(rxt(k,456)*y(k,90) + rxt(k,457)*y(k,124) + rxt(k,458)*y(k,125)) + mat(k,2164) = -rxt(k,456)*y(k,214) + mat(k,2034) = -rxt(k,457)*y(k,214) + mat(k,1826) = -rxt(k,458)*y(k,214) + mat(k,696) = -(rxt(k,387)*y(k,90) + rxt(k,388)*y(k,124)) + mat(k,2148) = -rxt(k,387)*y(k,215) + mat(k,2021) = -rxt(k,388)*y(k,215) + mat(k,516) = rxt(k,389)*y(k,226) + mat(k,320) = rxt(k,390)*y(k,226) + mat(k,1738) = rxt(k,389)*y(k,107) + rxt(k,390)*y(k,108) + mat(k,80) = -(rxt(k,551)*y(k,90) + rxt(k,552)*y(k,124)) + mat(k,2112) = -rxt(k,551)*y(k,216) + mat(k,1996) = -rxt(k,552)*y(k,216) + mat(k,1012) = rxt(k,554)*y(k,226) + mat(k,1659) = rxt(k,554)*y(k,110) + mat(k,527) = -(rxt(k,188)*y(k,133) + rxt(k,189)*y(k,134)) + mat(k,2292) = -rxt(k,188)*y(k,217) + mat(k,1526) = -rxt(k,189)*y(k,217) + mat(k,2292) = mat(k,2292) + rxt(k,583)*y(k,218) + mat(k,858) = .900_r8*rxt(k,581)*y(k,218) + .800_r8*rxt(k,579)*y(k,219) + mat(k,673) = rxt(k,583)*y(k,133) + .900_r8*rxt(k,581)*y(k,201) + mat(k,842) = .800_r8*rxt(k,579)*y(k,201) + mat(k,674) = -(rxt(k,581)*y(k,201) + rxt(k,582)*y(k,134) + (rxt(k,583) & + + rxt(k,584)) * y(k,133)) + mat(k,859) = -rxt(k,581)*y(k,218) + mat(k,1527) = -rxt(k,582)*y(k,218) + mat(k,2295) = -(rxt(k,583) + rxt(k,584)) * y(k,218) + mat(k,843) = -(rxt(k,579)*y(k,201)) + mat(k,861) = -rxt(k,579)*y(k,219) + mat(k,966) = rxt(k,588)*y(k,225) + mat(k,2028) = rxt(k,590)*y(k,225) + mat(k,2301) = rxt(k,583)*y(k,218) + mat(k,1530) = rxt(k,587)*y(k,220) + mat(k,676) = rxt(k,583)*y(k,133) + mat(k,502) = rxt(k,587)*y(k,134) + mat(k,850) = rxt(k,588)*y(k,112) + rxt(k,590)*y(k,124) + mat(k,500) = -(rxt(k,585)*y(k,133) + (rxt(k,586) + rxt(k,587)) * y(k,134)) + mat(k,2291) = -rxt(k,585)*y(k,220) + mat(k,1525) = -(rxt(k,586) + rxt(k,587)) * y(k,220) + mat(k,1088) = -(rxt(k,485)*y(k,199) + rxt(k,486)*y(k,90) + rxt(k,487) & + *y(k,124) + rxt(k,488)*y(k,126)) + mat(k,2225) = -rxt(k,485)*y(k,221) + mat(k,2171) = -rxt(k,486)*y(k,221) + mat(k,2042) = -rxt(k,487)*y(k,221) + mat(k,1876) = -rxt(k,488)*y(k,221) + mat(k,994) = rxt(k,479)*y(k,126) + mat(k,1022) = rxt(k,482)*y(k,126) + mat(k,1876) = mat(k,1876) + rxt(k,479)*y(k,6) + rxt(k,482)*y(k,110) & + + .500_r8*rxt(k,499)*y(k,178) + mat(k,397) = rxt(k,489)*y(k,226) + mat(k,1071) = .500_r8*rxt(k,499)*y(k,126) + mat(k,1769) = rxt(k,489)*y(k,128) + mat(k,1633) = -(rxt(k,153)*y(k,77) + rxt(k,154)*y(k,239) + (rxt(k,156) & + + rxt(k,157)) * y(k,134) + rxt(k,158)*y(k,135) + (rxt(k,206) & + + rxt(k,207)) * y(k,113) + rxt(k,239)*y(k,33) + rxt(k,240) & + *y(k,34) + rxt(k,241)*y(k,36) + rxt(k,242)*y(k,37) + rxt(k,243) & + *y(k,38) + rxt(k,244)*y(k,39) + rxt(k,245)*y(k,40) + (rxt(k,246) & + + rxt(k,247)) * y(k,85) + rxt(k,266)*y(k,35) + rxt(k,267) & + *y(k,55) + rxt(k,268)*y(k,78) + (rxt(k,269) + rxt(k,270) & + ) * y(k,81) + rxt(k,275)*y(k,64) + rxt(k,276)*y(k,65) + rxt(k,289) & + *y(k,41) + rxt(k,290)*y(k,43) + rxt(k,291)*y(k,82) + rxt(k,292) & + *y(k,83) + rxt(k,293)*y(k,84) + (rxt(k,310) + rxt(k,311) & + + rxt(k,312)) * y(k,54) + rxt(k,313)*y(k,86)) + mat(k,1461) = -rxt(k,153)*y(k,222) + mat(k,2433) = -rxt(k,154)*y(k,222) + mat(k,1543) = -(rxt(k,156) + rxt(k,157)) * y(k,222) + mat(k,2406) = -rxt(k,158)*y(k,222) + mat(k,256) = -(rxt(k,206) + rxt(k,207)) * y(k,222) + mat(k,100) = -rxt(k,239)*y(k,222) + mat(k,140) = -rxt(k,240)*y(k,222) + mat(k,111) = -rxt(k,241)*y(k,222) + mat(k,150) = -rxt(k,242)*y(k,222) + mat(k,115) = -rxt(k,243)*y(k,222) + mat(k,155) = -rxt(k,244)*y(k,222) + mat(k,119) = -rxt(k,245)*y(k,222) + mat(k,1497) = -(rxt(k,246) + rxt(k,247)) * y(k,222) + mat(k,146) = -rxt(k,266)*y(k,222) + mat(k,448) = -rxt(k,267)*y(k,222) + mat(k,108) = -rxt(k,268)*y(k,222) + mat(k,829) = -(rxt(k,269) + rxt(k,270)) * y(k,222) + mat(k,244) = -rxt(k,275)*y(k,222) + mat(k,226) = -rxt(k,276)*y(k,222) + mat(k,473) = -rxt(k,289)*y(k,222) + mat(k,605) = -rxt(k,290)*y(k,222) + mat(k,221) = -rxt(k,291)*y(k,222) + mat(k,251) = -rxt(k,292)*y(k,222) + mat(k,274) = -rxt(k,293)*y(k,222) + mat(k,2273) = -(rxt(k,310) + rxt(k,311) + rxt(k,312)) * y(k,222) + mat(k,181) = -rxt(k,313)*y(k,222) + mat(k,1543) = mat(k,1543) + rxt(k,189)*y(k,217) + mat(k,868) = .850_r8*rxt(k,580)*y(k,225) + mat(k,530) = rxt(k,189)*y(k,134) + mat(k,855) = .850_r8*rxt(k,580)*y(k,201) + mat(k,175) = -(rxt(k,160)*y(k,133) + rxt(k,161)*y(k,134)) + mat(k,2288) = -rxt(k,160)*y(k,223) + mat(k,1522) = -rxt(k,161)*y(k,223) + mat(k,1440) = rxt(k,162)*y(k,224) + mat(k,2288) = mat(k,2288) + rxt(k,164)*y(k,224) + mat(k,1522) = mat(k,1522) + rxt(k,165)*y(k,224) + mat(k,2362) = rxt(k,166)*y(k,224) + mat(k,177) = rxt(k,162)*y(k,63) + rxt(k,164)*y(k,133) + rxt(k,165)*y(k,134) & + + rxt(k,166)*y(k,135) + mat(k,178) = -(rxt(k,162)*y(k,63) + rxt(k,164)*y(k,133) + rxt(k,165)*y(k,134) & + + rxt(k,166)*y(k,135)) + mat(k,1441) = -rxt(k,162)*y(k,224) + mat(k,2289) = -rxt(k,164)*y(k,224) + mat(k,1523) = -rxt(k,165)*y(k,224) + mat(k,2363) = -rxt(k,166)*y(k,224) + mat(k,1523) = mat(k,1523) + rxt(k,156)*y(k,222) + mat(k,1614) = rxt(k,156)*y(k,134) end do - end subroutine nlnmat08 - subroutine nlnmat09( avec_len, mat, y, rxt ) + end subroutine nlnmat09 + subroutine nlnmat10( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -1889,331 +2309,214 @@ subroutine nlnmat09( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,329) = -(rxt(k,308)*y(k,203) + rxt(k,310)*y(k,124)) - mat(k,2039) = -rxt(k,308)*y(k,204) - mat(k,1447) = -rxt(k,310)*y(k,204) - mat(k,1834) = rxt(k,294)*y(k,203) - mat(k,2039) = mat(k,2039) + rxt(k,294)*y(k,42) - mat(k,1172) = -(rxt(k,405)*y(k,196) + rxt(k,406)*y(k,197) + rxt(k,407) & - *y(k,203) + rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126)) - mat(k,1297) = -rxt(k,405)*y(k,205) - mat(k,1390) = -rxt(k,406)*y(k,205) - mat(k,2093) = -rxt(k,407)*y(k,205) - mat(k,1498) = -rxt(k,408)*y(k,205) - mat(k,1890) = -rxt(k,409)*y(k,205) - mat(k,786) = .600_r8*rxt(k,426)*y(k,221) - mat(k,1705) = .600_r8*rxt(k,426)*y(k,98) - mat(k,1206) = -(rxt(k,410)*y(k,196) + rxt(k,411)*y(k,197) + rxt(k,412) & - *y(k,203) + rxt(k,414)*y(k,124) + rxt(k,415)*y(k,126)) - mat(k,1298) = -rxt(k,410)*y(k,206) - mat(k,1391) = -rxt(k,411)*y(k,206) - mat(k,2094) = -rxt(k,412)*y(k,206) - mat(k,1499) = -rxt(k,414)*y(k,206) - mat(k,1891) = -rxt(k,415)*y(k,206) - mat(k,787) = .400_r8*rxt(k,426)*y(k,221) - mat(k,1706) = .400_r8*rxt(k,426)*y(k,98) - mat(k,1231) = -(rxt(k,372)*y(k,196) + rxt(k,373)*y(k,197) + rxt(k,374) & - *y(k,203) + rxt(k,375)*y(k,126) + (rxt(k,376) + rxt(k,377) & - ) * y(k,124)) - mat(k,1299) = -rxt(k,372)*y(k,207) - mat(k,1392) = -rxt(k,373)*y(k,207) - mat(k,2095) = -rxt(k,374)*y(k,207) - mat(k,1892) = -rxt(k,375)*y(k,207) - mat(k,1500) = -(rxt(k,376) + rxt(k,377)) * y(k,207) - mat(k,1142) = .500_r8*rxt(k,379)*y(k,221) - mat(k,216) = .200_r8*rxt(k,380)*y(k,221) - mat(k,1250) = rxt(k,393)*y(k,221) - mat(k,1707) = .500_r8*rxt(k,379)*y(k,105) + .200_r8*rxt(k,380)*y(k,106) & - + rxt(k,393)*y(k,111) - mat(k,607) = -(rxt(k,453)*y(k,203) + rxt(k,454)*y(k,124) + rxt(k,455) & - *y(k,125)) - mat(k,2061) = -rxt(k,453)*y(k,208) - mat(k,1464) = -rxt(k,454)*y(k,208) - mat(k,1966) = -rxt(k,455)*y(k,208) - mat(k,1271) = -(rxt(k,381)*y(k,196) + rxt(k,382)*y(k,197) + rxt(k,383) & - *y(k,203) + 4._r8*rxt(k,384)*y(k,209) + rxt(k,385)*y(k,124) & - + rxt(k,386)*y(k,126) + rxt(k,394)*y(k,125)) - mat(k,1301) = -rxt(k,381)*y(k,209) - mat(k,1394) = -rxt(k,382)*y(k,209) - mat(k,2097) = -rxt(k,383)*y(k,209) - mat(k,1502) = -rxt(k,385)*y(k,209) - mat(k,1894) = -rxt(k,386)*y(k,209) - mat(k,1977) = -rxt(k,394)*y(k,209) - mat(k,1143) = .500_r8*rxt(k,379)*y(k,221) - mat(k,217) = .500_r8*rxt(k,380)*y(k,221) - mat(k,1709) = .500_r8*rxt(k,379)*y(k,105) + .500_r8*rxt(k,380)*y(k,106) - mat(k,803) = -(rxt(k,456)*y(k,203) + rxt(k,457)*y(k,124) + rxt(k,458) & - *y(k,125)) - mat(k,2074) = -rxt(k,456)*y(k,210) - mat(k,1478) = -rxt(k,457)*y(k,210) - mat(k,1971) = -rxt(k,458)*y(k,210) - mat(k,558) = -(rxt(k,387)*y(k,203) + rxt(k,388)*y(k,124)) - mat(k,2058) = -rxt(k,387)*y(k,211) - mat(k,1463) = -rxt(k,388)*y(k,211) - mat(k,418) = rxt(k,389)*y(k,221) - mat(k,221) = rxt(k,390)*y(k,221) - mat(k,1659) = rxt(k,389)*y(k,107) + rxt(k,390)*y(k,108) - mat(k,412) = -(rxt(k,188)*y(k,133) + rxt(k,189)*y(k,134)) - mat(k,1797) = -rxt(k,188)*y(k,212) - mat(k,1414) = -rxt(k,189)*y(k,212) - mat(k,1797) = mat(k,1797) + rxt(k,569)*y(k,213) - mat(k,697) = .900_r8*rxt(k,567)*y(k,213) + .800_r8*rxt(k,565)*y(k,214) - mat(k,565) = rxt(k,569)*y(k,133) + .900_r8*rxt(k,567)*y(k,199) - mat(k,689) = .800_r8*rxt(k,565)*y(k,199) - mat(k,567) = -(rxt(k,567)*y(k,199) + rxt(k,568)*y(k,134) + (rxt(k,569) & - + rxt(k,570)) * y(k,133)) - mat(k,698) = -rxt(k,567)*y(k,213) - mat(k,1416) = -rxt(k,568)*y(k,213) - mat(k,1801) = -(rxt(k,569) + rxt(k,570)) * y(k,213) - mat(k,690) = -(rxt(k,565)*y(k,199)) - mat(k,700) = -rxt(k,565)*y(k,214) - mat(k,742) = rxt(k,574)*y(k,220) - mat(k,1470) = rxt(k,576)*y(k,220) - mat(k,1805) = rxt(k,569)*y(k,213) - mat(k,1419) = rxt(k,573)*y(k,215) - mat(k,569) = rxt(k,569)*y(k,133) - mat(k,387) = rxt(k,573)*y(k,134) - mat(k,682) = rxt(k,574)*y(k,112) + rxt(k,576)*y(k,124) - mat(k,384) = -(rxt(k,571)*y(k,133) + (rxt(k,572) + rxt(k,573)) * y(k,134)) - mat(k,1796) = -rxt(k,571)*y(k,215) - mat(k,1413) = -(rxt(k,572) + rxt(k,573)) * y(k,215) - mat(k,1049) = -(rxt(k,485)*y(k,197) + rxt(k,486)*y(k,203) + rxt(k,487) & - *y(k,124) + rxt(k,488)*y(k,126)) - mat(k,1383) = -rxt(k,485)*y(k,216) - mat(k,2085) = -rxt(k,486)*y(k,216) - mat(k,1491) = -rxt(k,487)*y(k,216) - mat(k,1883) = -rxt(k,488)*y(k,216) - mat(k,865) = rxt(k,479)*y(k,126) - mat(k,827) = rxt(k,482)*y(k,126) - mat(k,1883) = mat(k,1883) + rxt(k,479)*y(k,6) + rxt(k,482)*y(k,110) & - + .500_r8*rxt(k,499)*y(k,178) - mat(k,287) = rxt(k,489)*y(k,221) - mat(k,920) = .500_r8*rxt(k,499)*y(k,126) - mat(k,1697) = rxt(k,489)*y(k,128) - mat(k,1570) = -(rxt(k,153)*y(k,77) + rxt(k,154)*y(k,232) + (rxt(k,156) & - + rxt(k,157)) * y(k,134) + rxt(k,158)*y(k,135) + (rxt(k,246) & - + rxt(k,247)) * y(k,85) + (rxt(k,269) + rxt(k,270)) * y(k,81) & - + rxt(k,275)*y(k,64) + rxt(k,276)*y(k,65) + rxt(k,314)*y(k,86)) - mat(k,1108) = -rxt(k,153)*y(k,217) - mat(k,2158) = -rxt(k,154)*y(k,217) - mat(k,1430) = -(rxt(k,156) + rxt(k,157)) * y(k,217) - mat(k,1780) = -rxt(k,158)*y(k,217) - mat(k,1340) = -(rxt(k,246) + rxt(k,247)) * y(k,217) - mat(k,755) = -(rxt(k,269) + rxt(k,270)) * y(k,217) - mat(k,61) = -rxt(k,275)*y(k,217) - mat(k,104) = -rxt(k,276)*y(k,217) - mat(k,106) = -rxt(k,314)*y(k,217) - mat(k,1430) = mat(k,1430) + rxt(k,189)*y(k,212) - mat(k,706) = .850_r8*rxt(k,566)*y(k,220) - mat(k,416) = rxt(k,189)*y(k,134) - mat(k,687) = .850_r8*rxt(k,566)*y(k,199) - mat(k,74) = -(rxt(k,160)*y(k,133) + rxt(k,161)*y(k,134)) - mat(k,1793) = -rxt(k,160)*y(k,218) - mat(k,1410) = -rxt(k,161)*y(k,218) - mat(k,1793) = mat(k,1793) + rxt(k,164)*y(k,219) - mat(k,1410) = mat(k,1410) + rxt(k,165)*y(k,219) - mat(k,1736) = rxt(k,166)*y(k,219) - mat(k,76) = rxt(k,164)*y(k,133) + rxt(k,165)*y(k,134) + rxt(k,166)*y(k,135) - mat(k,77) = -(rxt(k,164)*y(k,133) + rxt(k,165)*y(k,134) + rxt(k,166)*y(k,135)) - mat(k,1794) = -rxt(k,164)*y(k,219) - mat(k,1411) = -rxt(k,165)*y(k,219) - mat(k,1737) = -rxt(k,166)*y(k,219) - mat(k,1411) = mat(k,1411) + rxt(k,156)*y(k,217) - mat(k,1558) = rxt(k,156)*y(k,134) - mat(k,681) = -(rxt(k,566)*y(k,199) + rxt(k,574)*y(k,112) + rxt(k,576) & + mat(k,851) = -(rxt(k,580)*y(k,201) + rxt(k,588)*y(k,112) + rxt(k,590) & *y(k,124)) - mat(k,699) = -rxt(k,566)*y(k,220) - mat(k,741) = -rxt(k,574)*y(k,220) - mat(k,1469) = -rxt(k,576)*y(k,220) - mat(k,1418) = rxt(k,568)*y(k,213) + rxt(k,572)*y(k,215) + rxt(k,579)*y(k,222) - mat(k,568) = rxt(k,568)*y(k,134) - mat(k,386) = rxt(k,572)*y(k,134) - mat(k,515) = rxt(k,579)*y(k,134) - mat(k,1719) = -(rxt(k,179)*y(k,77) + rxt(k,180)*y(k,79) + rxt(k,181)*y(k,203) & + mat(k,862) = -rxt(k,580)*y(k,225) + mat(k,967) = -rxt(k,588)*y(k,225) + mat(k,2029) = -rxt(k,590)*y(k,225) + mat(k,1444) = rxt(k,591)*y(k,227) + mat(k,1531) = rxt(k,582)*y(k,218) + rxt(k,586)*y(k,220) + rxt(k,593)*y(k,227) + mat(k,677) = rxt(k,582)*y(k,134) + mat(k,503) = rxt(k,586)*y(k,134) + mat(k,805) = rxt(k,591)*y(k,63) + rxt(k,593)*y(k,134) + mat(k,1799) = -(rxt(k,179)*y(k,77) + rxt(k,180)*y(k,79) + rxt(k,181)*y(k,90) & + rxt(k,182)*y(k,133) + rxt(k,183)*y(k,135) + (4._r8*rxt(k,184) & - + 4._r8*rxt(k,185)) * y(k,221) + rxt(k,187)*y(k,90) + rxt(k,201) & + + 4._r8*rxt(k,185)) * y(k,226) + rxt(k,187)*y(k,91) + rxt(k,201) & *y(k,126) + rxt(k,202)*y(k,112) + rxt(k,210)*y(k,125) + rxt(k,211) & *y(k,89) + rxt(k,230)*y(k,60) + (rxt(k,232) + rxt(k,233) & - ) * y(k,59) + rxt(k,235)*y(k,85) + rxt(k,238)*y(k,92) + rxt(k,262) & - *y(k,19) + rxt(k,264)*y(k,81) + rxt(k,297)*y(k,42) + rxt(k,302) & - *y(k,52) + rxt(k,303)*y(k,53) + (rxt(k,305) + rxt(k,315) & - ) * y(k,62) + rxt(k,306)*y(k,86) + rxt(k,307)*y(k,87) + rxt(k,317) & - *y(k,24) + rxt(k,324)*y(k,26) + rxt(k,325)*y(k,27) + rxt(k,327) & - *y(k,28) + rxt(k,329)*y(k,45) + rxt(k,330)*y(k,47) + rxt(k,335) & - *y(k,50) + rxt(k,336)*y(k,51) + rxt(k,341)*y(k,74) + rxt(k,342) & - *y(k,75) + rxt(k,343)*y(k,140) + rxt(k,344)*y(k,25) + rxt(k,352) & - *y(k,30) + rxt(k,353)*y(k,31) + rxt(k,355)*y(k,49) + rxt(k,356) & - *y(k,95) + rxt(k,357)*y(k,127) + rxt(k,360)*y(k,147) + rxt(k,364) & - *y(k,148) + rxt(k,365)*y(k,29) + rxt(k,366)*y(k,48) + rxt(k,368) & - *y(k,16) + rxt(k,371)*y(k,93) + rxt(k,379)*y(k,105) + rxt(k,380) & - *y(k,106) + rxt(k,389)*y(k,107) + rxt(k,390)*y(k,108) + rxt(k,391) & - *y(k,109) + rxt(k,393)*y(k,111) + rxt(k,396)*y(k,1) + rxt(k,400) & - *y(k,2) + rxt(k,401)*y(k,15) + rxt(k,402)*y(k,94) + rxt(k,403) & - *y(k,96) + rxt(k,404)*y(k,97) + rxt(k,416)*y(k,99) + rxt(k,417) & - *y(k,100) + rxt(k,424)*y(k,102) + rxt(k,426)*y(k,98) + rxt(k,427) & - *y(k,103) + rxt(k,428)*y(k,115) + rxt(k,429)*y(k,116) + rxt(k,435) & - *y(k,182) + rxt(k,438)*y(k,7) + rxt(k,441)*y(k,8) + rxt(k,442) & - *y(k,22) + rxt(k,444)*y(k,23) + rxt(k,448)*y(k,32) + rxt(k,449) & - *y(k,66) + rxt(k,461)*y(k,143) + rxt(k,464)*y(k,144) + rxt(k,468) & - *y(k,180) + rxt(k,469)*y(k,181) + rxt(k,471)*y(k,183) + rxt(k,474) & - *y(k,184) + rxt(k,477)*y(k,185) + rxt(k,478)*y(k,186) + rxt(k,481) & - *y(k,6) + rxt(k,484)*y(k,110) + rxt(k,489)*y(k,128) + rxt(k,493) & - *y(k,175) + rxt(k,494)*y(k,176) + rxt(k,498)*y(k,177) + rxt(k,500) & - *y(k,178) + rxt(k,501)*y(k,179) + (rxt(k,503) + rxt(k,516) & - ) * y(k,67) + rxt(k,505)*y(k,138) + rxt(k,510)*y(k,149) & - + rxt(k,515)*y(k,151) + rxt(k,517)*y(k,152) + rxt(k,519) & - *y(k,120)) - mat(k,1109) = -rxt(k,179)*y(k,221) - mat(k,477) = -rxt(k,180)*y(k,221) - mat(k,2106) = -rxt(k,181)*y(k,221) - mat(k,1822) = -rxt(k,182)*y(k,221) - mat(k,1781) = -rxt(k,183)*y(k,221) - mat(k,363) = -rxt(k,187)*y(k,221) - mat(k,1903) = -rxt(k,201)*y(k,221) - mat(k,749) = -rxt(k,202)*y(k,221) - mat(k,1987) = -rxt(k,210)*y(k,221) - mat(k,1945) = -rxt(k,211)*y(k,221) - mat(k,909) = -rxt(k,230)*y(k,221) - mat(k,2133) = -(rxt(k,232) + rxt(k,233)) * y(k,221) - mat(k,1341) = -rxt(k,235)*y(k,221) - mat(k,765) = -rxt(k,238)*y(k,221) - mat(k,2011) = -rxt(k,262)*y(k,221) - mat(k,756) = -rxt(k,264)*y(k,221) - mat(k,1846) = -rxt(k,297)*y(k,221) - mat(k,709) = -rxt(k,302)*y(k,221) - mat(k,311) = -rxt(k,303)*y(k,221) - mat(k,998) = -(rxt(k,305) + rxt(k,315)) * y(k,221) - mat(k,107) = -rxt(k,306)*y(k,221) - mat(k,713) = -rxt(k,307)*y(k,221) - mat(k,204) = -rxt(k,317)*y(k,221) - mat(k,179) = -rxt(k,324)*y(k,221) - mat(k,249) = -rxt(k,325)*y(k,221) - mat(k,210) = -rxt(k,327)*y(k,221) - mat(k,1079) = -rxt(k,329)*y(k,221) - mat(k,53) = -rxt(k,330)*y(k,221) - mat(k,448) = -rxt(k,335)*y(k,221) - mat(k,409) = -rxt(k,336)*y(k,221) - mat(k,962) = -rxt(k,341)*y(k,221) - mat(k,800) = -rxt(k,342)*y(k,221) - mat(k,353) = -rxt(k,343)*y(k,221) - mat(k,454) = -rxt(k,344)*y(k,221) - mat(k,306) = -rxt(k,352)*y(k,221) - mat(k,57) = -rxt(k,353)*y(k,221) - mat(k,1154) = -rxt(k,355)*y(k,221) - mat(k,994) = -rxt(k,356)*y(k,221) - mat(k,772) = -rxt(k,357)*y(k,221) - mat(k,434) = -rxt(k,360)*y(k,221) - mat(k,294) = -rxt(k,364)*y(k,221) - mat(k,952) = -rxt(k,365)*y(k,221) - mat(k,902) = -rxt(k,366)*y(k,221) - mat(k,263) = -rxt(k,368)*y(k,221) - mat(k,975) = -rxt(k,371)*y(k,221) - mat(k,1145) = -rxt(k,379)*y(k,221) - mat(k,218) = -rxt(k,380)*y(k,221) - mat(k,421) = -rxt(k,389)*y(k,221) - mat(k,224) = -rxt(k,390)*y(k,221) - mat(k,469) = -rxt(k,391)*y(k,221) - mat(k,1257) = -rxt(k,393)*y(k,221) - mat(k,542) = -rxt(k,396)*y(k,221) - mat(k,554) = -rxt(k,400)*y(k,221) - mat(k,165) = -rxt(k,401)*y(k,221) - mat(k,158) = -rxt(k,402)*y(k,221) - mat(k,214) = -rxt(k,403)*y(k,221) - mat(k,70) = -rxt(k,404)*y(k,221) - mat(k,509) = -rxt(k,416)*y(k,221) - mat(k,427) = -rxt(k,417)*y(k,221) - mat(k,300) = -rxt(k,424)*y(k,221) - mat(k,791) = -rxt(k,426)*y(k,221) - mat(k,582) = -rxt(k,427)*y(k,221) - mat(k,270) = -rxt(k,428)*y(k,221) - mat(k,934) = -rxt(k,429)*y(k,221) - mat(k,132) = -rxt(k,435)*y(k,221) - mat(k,90) = -rxt(k,438)*y(k,221) - mat(k,277) = -rxt(k,441)*y(k,221) - mat(k,171) = -rxt(k,442)*y(k,221) - mat(k,244) = -rxt(k,444)*y(k,221) - mat(k,184) = -rxt(k,448)*y(k,221) - mat(k,124) = -rxt(k,449)*y(k,221) - mat(k,99) = -rxt(k,461)*y(k,221) - mat(k,238) = -rxt(k,464)*y(k,221) - mat(k,499) = -rxt(k,468)*y(k,221) - mat(k,119) = -rxt(k,469)*y(k,221) - mat(k,145) = -rxt(k,471)*y(k,221) - mat(k,598) = -rxt(k,474)*y(k,221) - mat(k,150) = -rxt(k,477)*y(k,221) - mat(k,319) = -rxt(k,478)*y(k,221) - mat(k,869) = -rxt(k,481)*y(k,221) - mat(k,831) = -rxt(k,484)*y(k,221) - mat(k,288) = -rxt(k,489)*y(k,221) - mat(k,487) = -rxt(k,493)*y(k,221) - mat(k,523) = -rxt(k,494)*y(k,221) - mat(k,372) = -rxt(k,498)*y(k,221) - mat(k,921) = -rxt(k,500)*y(k,221) - mat(k,987) = -rxt(k,501)*y(k,221) - mat(k,193) = -(rxt(k,503) + rxt(k,516)) * y(k,221) - mat(k,256) = -rxt(k,505)*y(k,221) - mat(k,603) = -rxt(k,510)*y(k,221) - mat(k,1323) = -rxt(k,515)*y(k,221) - mat(k,894) = -rxt(k,517)*y(k,221) - mat(k,50) = -rxt(k,519)*y(k,221) - mat(k,869) = mat(k,869) + .630_r8*rxt(k,480)*y(k,135) - mat(k,204) = mat(k,204) + .650_r8*rxt(k,317)*y(k,221) - mat(k,454) = mat(k,454) + .130_r8*rxt(k,319)*y(k,135) - mat(k,249) = mat(k,249) + .500_r8*rxt(k,325)*y(k,221) - mat(k,952) = mat(k,952) + .360_r8*rxt(k,348)*y(k,135) - mat(k,1846) = mat(k,1846) + rxt(k,296)*y(k,133) - mat(k,311) = mat(k,311) + .300_r8*rxt(k,303)*y(k,221) - mat(k,1545) = rxt(k,219)*y(k,203) - mat(k,676) = rxt(k,273)*y(k,232) - mat(k,1923) = rxt(k,178)*y(k,135) + 2.000_r8*rxt(k,173)*y(k,203) - mat(k,1109) = mat(k,1109) + rxt(k,170)*y(k,133) + rxt(k,153)*y(k,217) - mat(k,477) = mat(k,477) + rxt(k,171)*y(k,133) - mat(k,756) = mat(k,756) + rxt(k,263)*y(k,133) + rxt(k,269)*y(k,217) - mat(k,1341) = mat(k,1341) + rxt(k,234)*y(k,133) + rxt(k,246)*y(k,217) - mat(k,107) = mat(k,107) + rxt(k,314)*y(k,217) - mat(k,658) = rxt(k,265)*y(k,133) - mat(k,765) = mat(k,765) + rxt(k,237)*y(k,133) - mat(k,791) = mat(k,791) + .320_r8*rxt(k,425)*y(k,135) - mat(k,582) = mat(k,582) + .600_r8*rxt(k,427)*y(k,221) - mat(k,1145) = mat(k,1145) + .240_r8*rxt(k,378)*y(k,135) - mat(k,218) = mat(k,218) + .100_r8*rxt(k,380)*y(k,221) - mat(k,831) = mat(k,831) + .630_r8*rxt(k,483)*y(k,135) - mat(k,1257) = mat(k,1257) + .360_r8*rxt(k,392)*y(k,135) - mat(k,1510) = rxt(k,203)*y(k,203) - mat(k,1903) = mat(k,1903) + rxt(k,198)*y(k,203) - mat(k,1822) = mat(k,1822) + rxt(k,296)*y(k,42) + rxt(k,170)*y(k,77) & - + rxt(k,171)*y(k,79) + rxt(k,263)*y(k,81) + rxt(k,234)*y(k,85) & - + rxt(k,265)*y(k,91) + rxt(k,237)*y(k,92) + rxt(k,176)*y(k,203) - mat(k,1781) = mat(k,1781) + .630_r8*rxt(k,480)*y(k,6) + .130_r8*rxt(k,319) & - *y(k,25) + .360_r8*rxt(k,348)*y(k,29) + rxt(k,178)*y(k,76) & - + .320_r8*rxt(k,425)*y(k,98) + .240_r8*rxt(k,378)*y(k,105) & - + .630_r8*rxt(k,483)*y(k,110) + .360_r8*rxt(k,392)*y(k,111) & - + rxt(k,177)*y(k,203) - mat(k,434) = mat(k,434) + .500_r8*rxt(k,360)*y(k,221) - mat(k,132) = mat(k,132) + .500_r8*rxt(k,435)*y(k,221) - mat(k,403) = .400_r8*rxt(k,436)*y(k,203) - mat(k,1306) = .450_r8*rxt(k,333)*y(k,203) - mat(k,650) = .400_r8*rxt(k,450)*y(k,203) - mat(k,2106) = mat(k,2106) + rxt(k,219)*y(k,56) + 2.000_r8*rxt(k,173)*y(k,76) & + ) * y(k,59) + rxt(k,235)*y(k,85) + rxt(k,238)*y(k,93) + rxt(k,262) & + *y(k,19) + rxt(k,264)*y(k,81) + rxt(k,278)*y(k,41) + rxt(k,280) & + *y(k,43) + rxt(k,281)*y(k,44) + rxt(k,283)*y(k,46) + rxt(k,285) & + *y(k,55) + rxt(k,286)*y(k,82) + rxt(k,287)*y(k,83) + rxt(k,288) & + *y(k,84) + rxt(k,297)*y(k,42) + rxt(k,302)*y(k,52) + rxt(k,303) & + *y(k,53) + rxt(k,304)*y(k,54) + rxt(k,305)*y(k,86) + rxt(k,306) & + *y(k,87) + rxt(k,314)*y(k,62) + rxt(k,316)*y(k,24) + rxt(k,323) & + *y(k,26) + rxt(k,324)*y(k,27) + rxt(k,326)*y(k,28) + rxt(k,328) & + *y(k,45) + rxt(k,329)*y(k,47) + rxt(k,334)*y(k,50) + rxt(k,335) & + *y(k,51) + rxt(k,340)*y(k,74) + rxt(k,341)*y(k,75) + rxt(k,342) & + *y(k,140) + rxt(k,343)*y(k,25) + rxt(k,351)*y(k,30) + rxt(k,352) & + *y(k,31) + rxt(k,354)*y(k,49) + rxt(k,356)*y(k,96) + rxt(k,357) & + *y(k,127) + rxt(k,360)*y(k,147) + rxt(k,364)*y(k,148) + rxt(k,365) & + *y(k,29) + rxt(k,366)*y(k,48) + rxt(k,368)*y(k,16) + rxt(k,371) & + *y(k,94) + rxt(k,379)*y(k,105) + rxt(k,380)*y(k,106) + rxt(k,389) & + *y(k,107) + rxt(k,390)*y(k,108) + rxt(k,391)*y(k,109) + rxt(k,393) & + *y(k,111) + rxt(k,396)*y(k,1) + rxt(k,400)*y(k,2) + rxt(k,401) & + *y(k,15) + rxt(k,402)*y(k,95) + rxt(k,403)*y(k,97) + rxt(k,404) & + *y(k,98) + rxt(k,416)*y(k,100) + rxt(k,417)*y(k,101) + rxt(k,424) & + *y(k,102) + rxt(k,426)*y(k,99) + rxt(k,427)*y(k,103) + rxt(k,428) & + *y(k,115) + rxt(k,429)*y(k,116) + rxt(k,435)*y(k,182) + rxt(k,438) & + *y(k,7) + rxt(k,441)*y(k,8) + rxt(k,442)*y(k,22) + rxt(k,444) & + *y(k,23) + rxt(k,448)*y(k,32) + rxt(k,449)*y(k,66) + rxt(k,461) & + *y(k,143) + rxt(k,464)*y(k,144) + rxt(k,468)*y(k,180) + rxt(k,469) & + *y(k,181) + rxt(k,471)*y(k,183) + rxt(k,474)*y(k,184) + rxt(k,477) & + *y(k,185) + rxt(k,478)*y(k,186) + rxt(k,481)*y(k,6) + rxt(k,484) & + *y(k,110) + rxt(k,489)*y(k,128) + rxt(k,493)*y(k,175) + rxt(k,494) & + *y(k,176) + rxt(k,498)*y(k,177) + rxt(k,500)*y(k,178) + rxt(k,501) & + *y(k,179) + (rxt(k,503) + rxt(k,517)) * y(k,67) + rxt(k,505) & + *y(k,138) + rxt(k,507)*y(k,152) + rxt(k,511)*y(k,149) + rxt(k,516) & + *y(k,151) + rxt(k,519)*y(k,120)) + mat(k,1462) = -rxt(k,179)*y(k,226) + mat(k,613) = -rxt(k,180)*y(k,226) + mat(k,2197) = -rxt(k,181)*y(k,226) + mat(k,2317) = -rxt(k,182)*y(k,226) + mat(k,2407) = -rxt(k,183)*y(k,226) + mat(k,495) = -rxt(k,187)*y(k,226) + mat(k,1904) = -rxt(k,201)*y(k,226) + mat(k,974) = -rxt(k,202)*y(k,226) + mat(k,1844) = -rxt(k,210)*y(k,226) + mat(k,1973) = -rxt(k,211)*y(k,226) + mat(k,956) = -rxt(k,230)*y(k,226) + mat(k,1592) = -(rxt(k,232) + rxt(k,233)) * y(k,226) + mat(k,1498) = -rxt(k,235)*y(k,226) + mat(k,838) = -rxt(k,238)*y(k,226) + mat(k,1566) = -rxt(k,262)*y(k,226) + mat(k,830) = -rxt(k,264)*y(k,226) + mat(k,474) = -rxt(k,278)*y(k,226) + mat(k,606) = -rxt(k,280)*y(k,226) + mat(k,122) = -rxt(k,281)*y(k,226) + mat(k,372) = -rxt(k,283)*y(k,226) + mat(k,449) = -rxt(k,285)*y(k,226) + mat(k,222) = -rxt(k,286)*y(k,226) + mat(k,252) = -rxt(k,287)*y(k,226) + mat(k,275) = -rxt(k,288)*y(k,226) + mat(k,2343) = -rxt(k,297)*y(k,226) + mat(k,812) = -rxt(k,302)*y(k,226) + mat(k,390) = -rxt(k,303)*y(k,226) + mat(k,2274) = -rxt(k,304)*y(k,226) + mat(k,182) = -rxt(k,305)*y(k,226) + mat(k,910) = -rxt(k,306)*y(k,226) + mat(k,1160) = -rxt(k,314)*y(k,226) + mat(k,294) = -rxt(k,316)*y(k,226) + mat(k,265) = -rxt(k,323)*y(k,226) + mat(k,351) = -rxt(k,324)*y(k,226) + mat(k,299) = -rxt(k,326)*y(k,226) + mat(k,1152) = -rxt(k,328)*y(k,226) + mat(k,103) = -rxt(k,329)*y(k,226) + mat(k,705) = -rxt(k,334)*y(k,226) + mat(k,621) = -rxt(k,335)*y(k,226) + mat(k,1166) = -rxt(k,340)*y(k,226) + mat(k,1055) = -rxt(k,341)*y(k,226) + mat(k,535) = -rxt(k,342)*y(k,226) + mat(k,552) = -rxt(k,343)*y(k,226) + mat(k,416) = -rxt(k,351)*y(k,226) + mat(k,305) = -rxt(k,352)*y(k,226) + mat(k,1282) = -rxt(k,354)*y(k,226) + mat(k,1209) = -rxt(k,356)*y(k,226) + mat(k,874) = -rxt(k,357)*y(k,226) + mat(k,544) = -rxt(k,360)*y(k,226) + mat(k,410) = -rxt(k,364)*y(k,226) + mat(k,1139) = -rxt(k,365)*y(k,226) + mat(k,1081) = -rxt(k,366)*y(k,226) + mat(k,357) = -rxt(k,368)*y(k,226) + mat(k,1198) = -rxt(k,371)*y(k,226) + mat(k,1273) = -rxt(k,379)*y(k,226) + mat(k,317) = -rxt(k,380)*y(k,226) + mat(k,519) = -rxt(k,389)*y(k,226) + mat(k,323) = -rxt(k,390)*y(k,226) + mat(k,584) = -rxt(k,391)*y(k,226) + mat(k,1379) = -rxt(k,393)*y(k,226) + mat(k,646) = -rxt(k,396)*y(k,226) + mat(k,692) = -rxt(k,400)*y(k,226) + mat(k,235) = -rxt(k,401)*y(k,226) + mat(k,231) = -rxt(k,402)*y(k,226) + mat(k,326) = -rxt(k,403)*y(k,226) + mat(k,133) = -rxt(k,404)*y(k,226) + mat(k,593) = -rxt(k,416)*y(k,226) + mat(k,561) = -rxt(k,417)*y(k,226) + mat(k,422) = -rxt(k,424)*y(k,226) + mat(k,890) = -rxt(k,426)*y(k,226) + mat(k,735) = -rxt(k,427)*y(k,226) + mat(k,380) = -rxt(k,428)*y(k,226) + mat(k,1120) = -rxt(k,429)*y(k,226) + mat(k,203) = -rxt(k,435)*y(k,226) + mat(k,162) = -rxt(k,438)*y(k,226) + mat(k,405) = -rxt(k,441)*y(k,226) + mat(k,247) = -rxt(k,442)*y(k,226) + mat(k,346) = -rxt(k,444)*y(k,226) + mat(k,270) = -rxt(k,448)*y(k,226) + mat(k,195) = -rxt(k,449)*y(k,226) + mat(k,171) = -rxt(k,461)*y(k,226) + mat(k,340) = -rxt(k,464)*y(k,226) + mat(k,671) = -rxt(k,468)*y(k,226) + mat(k,190) = -rxt(k,469)*y(k,226) + mat(k,212) = -rxt(k,471)*y(k,226) + mat(k,728) = -rxt(k,474)*y(k,226) + mat(k,217) = -rxt(k,477)*y(k,226) + mat(k,429) = -rxt(k,478)*y(k,226) + mat(k,1001) = -rxt(k,481)*y(k,226) + mat(k,1029) = -rxt(k,484)*y(k,226) + mat(k,398) = -rxt(k,489)*y(k,226) + mat(k,657) = -rxt(k,493)*y(k,226) + mat(k,627) = -rxt(k,494)*y(k,226) + mat(k,481) = -rxt(k,498)*y(k,226) + mat(k,1075) = -rxt(k,500)*y(k,226) + mat(k,1106) = -rxt(k,501)*y(k,226) + mat(k,310) = -(rxt(k,503) + rxt(k,517)) * y(k,226) + mat(k,366) = -rxt(k,505)*y(k,226) + mat(k,947) = -rxt(k,507)*y(k,226) + mat(k,711) = -rxt(k,511)*y(k,226) + mat(k,1479) = -rxt(k,516)*y(k,226) + mat(k,97) = -rxt(k,519)*y(k,226) + mat(k,1001) = mat(k,1001) + .630_r8*rxt(k,480)*y(k,135) + mat(k,294) = mat(k,294) + .650_r8*rxt(k,316)*y(k,226) + mat(k,552) = mat(k,552) + .130_r8*rxt(k,318)*y(k,135) + mat(k,351) = mat(k,351) + .500_r8*rxt(k,324)*y(k,226) + mat(k,1139) = mat(k,1139) + .360_r8*rxt(k,347)*y(k,135) + mat(k,2343) = mat(k,2343) + rxt(k,296)*y(k,133) + mat(k,390) = mat(k,390) + .300_r8*rxt(k,303)*y(k,226) + mat(k,2274) = mat(k,2274) + rxt(k,310)*y(k,222) + mat(k,1950) = rxt(k,219)*y(k,90) + mat(k,925) = rxt(k,273)*y(k,239) + mat(k,2089) = 2.000_r8*rxt(k,173)*y(k,90) + rxt(k,178)*y(k,135) + mat(k,1462) = mat(k,1462) + rxt(k,170)*y(k,133) + rxt(k,153)*y(k,222) + mat(k,613) = mat(k,613) + rxt(k,171)*y(k,133) + mat(k,830) = mat(k,830) + rxt(k,263)*y(k,133) + rxt(k,269)*y(k,222) + mat(k,1498) = mat(k,1498) + rxt(k,234)*y(k,133) + rxt(k,246)*y(k,222) + mat(k,182) = mat(k,182) + rxt(k,313)*y(k,222) + mat(k,2197) = mat(k,2197) + rxt(k,219)*y(k,56) + 2.000_r8*rxt(k,173)*y(k,76) & + rxt(k,203)*y(k,124) + rxt(k,198)*y(k,126) + rxt(k,176) & *y(k,133) + rxt(k,177)*y(k,135) + .400_r8*rxt(k,436)*y(k,189) & - + .450_r8*rxt(k,333)*y(k,196) + .400_r8*rxt(k,450)*y(k,198) & - + .450_r8*rxt(k,383)*y(k,209) + .400_r8*rxt(k,456)*y(k,210) & - + .200_r8*rxt(k,387)*y(k,211) + .150_r8*rxt(k,362)*y(k,225) - mat(k,1275) = .450_r8*rxt(k,383)*y(k,203) - mat(k,808) = .400_r8*rxt(k,456)*y(k,203) - mat(k,562) = .200_r8*rxt(k,387)*y(k,203) - mat(k,1571) = rxt(k,153)*y(k,77) + rxt(k,269)*y(k,81) + rxt(k,246)*y(k,85) & - + rxt(k,314)*y(k,86) + 2.000_r8*rxt(k,154)*y(k,232) - mat(k,1719) = mat(k,1719) + .650_r8*rxt(k,317)*y(k,24) + .500_r8*rxt(k,325) & + + .450_r8*rxt(k,332)*y(k,198) + .400_r8*rxt(k,450)*y(k,200) & + + .450_r8*rxt(k,383)*y(k,213) + .400_r8*rxt(k,456)*y(k,214) & + + .200_r8*rxt(k,387)*y(k,215) + .150_r8*rxt(k,362)*y(k,230) + mat(k,789) = rxt(k,265)*y(k,133) + mat(k,838) = mat(k,838) + rxt(k,237)*y(k,133) + mat(k,890) = mat(k,890) + .320_r8*rxt(k,425)*y(k,135) + mat(k,735) = mat(k,735) + .600_r8*rxt(k,427)*y(k,226) + mat(k,1273) = mat(k,1273) + .240_r8*rxt(k,378)*y(k,135) + mat(k,317) = mat(k,317) + .100_r8*rxt(k,380)*y(k,226) + mat(k,1029) = mat(k,1029) + .630_r8*rxt(k,483)*y(k,135) + mat(k,1379) = mat(k,1379) + .360_r8*rxt(k,392)*y(k,135) + mat(k,2068) = rxt(k,203)*y(k,90) + mat(k,1904) = mat(k,1904) + rxt(k,198)*y(k,90) + mat(k,2317) = mat(k,2317) + rxt(k,296)*y(k,42) + rxt(k,170)*y(k,77) & + + rxt(k,171)*y(k,79) + rxt(k,263)*y(k,81) + rxt(k,234)*y(k,85) & + + rxt(k,176)*y(k,90) + rxt(k,265)*y(k,92) + rxt(k,237)*y(k,93) + mat(k,2407) = mat(k,2407) + .630_r8*rxt(k,480)*y(k,6) + .130_r8*rxt(k,318) & + *y(k,25) + .360_r8*rxt(k,347)*y(k,29) + rxt(k,178)*y(k,76) & + + rxt(k,177)*y(k,90) + .320_r8*rxt(k,425)*y(k,99) & + + .240_r8*rxt(k,378)*y(k,105) + .630_r8*rxt(k,483)*y(k,110) & + + .360_r8*rxt(k,392)*y(k,111) + mat(k,544) = mat(k,544) + .500_r8*rxt(k,360)*y(k,226) + mat(k,203) = mat(k,203) + .500_r8*rxt(k,435)*y(k,226) + mat(k,523) = .400_r8*rxt(k,436)*y(k,90) + mat(k,1429) = .450_r8*rxt(k,332)*y(k,90) + mat(k,779) = .400_r8*rxt(k,450)*y(k,90) + mat(k,1398) = .450_r8*rxt(k,383)*y(k,90) + mat(k,917) = .400_r8*rxt(k,456)*y(k,90) + mat(k,699) = .200_r8*rxt(k,387)*y(k,90) + mat(k,1634) = rxt(k,310)*y(k,54) + rxt(k,153)*y(k,77) + rxt(k,269)*y(k,81) & + + rxt(k,246)*y(k,85) + rxt(k,313)*y(k,86) + 2.000_r8*rxt(k,154) & + *y(k,239) + mat(k,1799) = mat(k,1799) + .650_r8*rxt(k,316)*y(k,24) + .500_r8*rxt(k,324) & *y(k,27) + .300_r8*rxt(k,303)*y(k,53) + .600_r8*rxt(k,427) & *y(k,103) + .100_r8*rxt(k,380)*y(k,106) + .500_r8*rxt(k,360) & *y(k,147) + .500_r8*rxt(k,435)*y(k,182) - mat(k,1070) = .150_r8*rxt(k,362)*y(k,203) - mat(k,2159) = rxt(k,273)*y(k,73) + 2.000_r8*rxt(k,154)*y(k,217) + mat(k,1218) = .150_r8*rxt(k,362)*y(k,90) + mat(k,2434) = rxt(k,273)*y(k,73) + 2.000_r8*rxt(k,154)*y(k,222) end do - end subroutine nlnmat09 - subroutine nlnmat10( avec_len, mat, y, rxt ) + end subroutine nlnmat10 + subroutine nlnmat11( avec_len, mat, y, rxt ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none !---------------------------------------------- @@ -2231,130 +2534,149 @@ subroutine nlnmat10( avec_len, mat, y, rxt ) ! ... complete matrix entries implicit species !---------------------------------------------- do k = 1,avec_len - mat(k,514) = -(rxt(k,579)*y(k,134)) - mat(k,1415) = -rxt(k,579)*y(k,222) - mat(k,1800) = rxt(k,570)*y(k,213) + rxt(k,571)*y(k,215) - mat(k,566) = rxt(k,570)*y(k,133) - mat(k,385) = rxt(k,571)*y(k,133) - mat(k,336) = -(rxt(k,459)*y(k,203) + rxt(k,460)*y(k,124)) - mat(k,2040) = -rxt(k,459)*y(k,223) - mat(k,1448) = -rxt(k,460)*y(k,223) - mat(k,122) = .200_r8*rxt(k,449)*y(k,221) - mat(k,97) = .140_r8*rxt(k,461)*y(k,221) - mat(k,236) = rxt(k,464)*y(k,221) - mat(k,1633) = .200_r8*rxt(k,449)*y(k,66) + .140_r8*rxt(k,461)*y(k,143) & + mat(k,803) = -(rxt(k,591)*y(k,63) + rxt(k,593)*y(k,134)) + mat(k,1442) = -rxt(k,591)*y(k,227) + mat(k,1529) = -rxt(k,593)*y(k,227) + mat(k,2298) = rxt(k,584)*y(k,218) + rxt(k,585)*y(k,220) + mat(k,675) = rxt(k,584)*y(k,133) + mat(k,501) = rxt(k,585)*y(k,133) + mat(k,452) = -(rxt(k,459)*y(k,90) + rxt(k,460)*y(k,124)) + mat(k,2132) = -rxt(k,459)*y(k,228) + mat(k,2006) = -rxt(k,460)*y(k,228) + mat(k,193) = .200_r8*rxt(k,449)*y(k,226) + mat(k,169) = .140_r8*rxt(k,461)*y(k,226) + mat(k,338) = rxt(k,464)*y(k,226) + mat(k,1711) = .200_r8*rxt(k,449)*y(k,66) + .140_r8*rxt(k,461)*y(k,143) & + rxt(k,464)*y(k,144) - mat(k,717) = -(rxt(k,358)*y(k,203) + rxt(k,359)*y(k,124)) - mat(k,2068) = -rxt(k,358)*y(k,224) - mat(k,1473) = -rxt(k,359)*y(k,224) - mat(k,941) = rxt(k,365)*y(k,221) - mat(k,431) = .500_r8*rxt(k,360)*y(k,221) - mat(k,1671) = rxt(k,365)*y(k,29) + .500_r8*rxt(k,360)*y(k,147) - mat(k,1065) = -(rxt(k,361)*y(k,197) + rxt(k,362)*y(k,203) + rxt(k,363) & + mat(k,816) = -(rxt(k,358)*y(k,90) + rxt(k,359)*y(k,124)) + mat(k,2158) = -rxt(k,358)*y(k,229) + mat(k,2027) = -rxt(k,359)*y(k,229) + mat(k,1128) = rxt(k,365)*y(k,226) + mat(k,541) = .500_r8*rxt(k,360)*y(k,226) + mat(k,1749) = rxt(k,365)*y(k,29) + .500_r8*rxt(k,360)*y(k,147) + mat(k,1215) = -(rxt(k,361)*y(k,199) + rxt(k,362)*y(k,90) + rxt(k,363) & *y(k,124)) - mat(k,1384) = -rxt(k,361)*y(k,225) - mat(k,2086) = -rxt(k,362)*y(k,225) - mat(k,1492) = -rxt(k,363)*y(k,225) - mat(k,866) = .060_r8*rxt(k,480)*y(k,135) - mat(k,899) = rxt(k,366)*y(k,221) - mat(k,828) = .060_r8*rxt(k,483)*y(k,135) - mat(k,1763) = .060_r8*rxt(k,480)*y(k,6) + .060_r8*rxt(k,483)*y(k,110) - mat(k,292) = rxt(k,364)*y(k,221) - mat(k,984) = .150_r8*rxt(k,501)*y(k,221) - mat(k,1698) = rxt(k,366)*y(k,48) + rxt(k,364)*y(k,148) + .150_r8*rxt(k,501) & + mat(k,2233) = -rxt(k,361)*y(k,230) + mat(k,2178) = -rxt(k,362)*y(k,230) + mat(k,2051) = -rxt(k,363)*y(k,230) + mat(k,997) = .060_r8*rxt(k,480)*y(k,135) + mat(k,1079) = rxt(k,366)*y(k,226) + mat(k,1025) = .060_r8*rxt(k,483)*y(k,135) + mat(k,2390) = .060_r8*rxt(k,480)*y(k,6) + .060_r8*rxt(k,483)*y(k,110) + mat(k,408) = rxt(k,364)*y(k,226) + mat(k,1103) = .150_r8*rxt(k,501)*y(k,226) + mat(k,1779) = rxt(k,366)*y(k,48) + rxt(k,364)*y(k,148) + .150_r8*rxt(k,501) & *y(k,179) - mat(k,1030) = -(rxt(k,490)*y(k,197) + rxt(k,491)*y(k,203) + rxt(k,492) & + mat(k,1176) = -(rxt(k,490)*y(k,199) + rxt(k,491)*y(k,90) + rxt(k,492) & *y(k,124)) - mat(k,1382) = -rxt(k,490)*y(k,226) - mat(k,2084) = -rxt(k,491)*y(k,226) - mat(k,1490) = -rxt(k,492)*y(k,226) - mat(k,1882) = .500_r8*rxt(k,499)*y(k,178) - mat(k,486) = rxt(k,493)*y(k,221) - mat(k,919) = .500_r8*rxt(k,499)*y(k,126) + rxt(k,500)*y(k,221) - mat(k,1696) = rxt(k,493)*y(k,175) + rxt(k,500)*y(k,178) - mat(k,1008) = -(rxt(k,495)*y(k,197) + rxt(k,496)*y(k,203) + rxt(k,497) & + mat(k,2231) = -rxt(k,490)*y(k,231) + mat(k,2176) = -rxt(k,491)*y(k,231) + mat(k,2048) = -rxt(k,492)*y(k,231) + mat(k,1883) = .500_r8*rxt(k,499)*y(k,178) + mat(k,655) = rxt(k,493)*y(k,226) + mat(k,1074) = .500_r8*rxt(k,499)*y(k,126) + rxt(k,500)*y(k,226) + mat(k,1776) = rxt(k,493)*y(k,175) + rxt(k,500)*y(k,178) + mat(k,1060) = -(rxt(k,495)*y(k,199) + rxt(k,496)*y(k,90) + rxt(k,497) & *y(k,124)) - mat(k,1381) = -rxt(k,495)*y(k,227) - mat(k,2083) = -rxt(k,496)*y(k,227) - mat(k,1489) = -rxt(k,497)*y(k,227) - mat(k,864) = rxt(k,481)*y(k,221) - mat(k,826) = rxt(k,484)*y(k,221) - mat(k,371) = rxt(k,498)*y(k,221) - mat(k,1695) = rxt(k,481)*y(k,6) + rxt(k,484)*y(k,110) + rxt(k,498)*y(k,177) - mat(k,618) = -(rxt(k,466)*y(k,203) + rxt(k,467)*y(k,124)) - mat(k,2062) = -rxt(k,466)*y(k,228) - mat(k,1465) = -rxt(k,467)*y(k,228) - mat(k,495) = rxt(k,468)*y(k,221) - mat(k,118) = .650_r8*rxt(k,469)*y(k,221) - mat(k,1664) = rxt(k,468)*y(k,180) + .650_r8*rxt(k,469)*y(k,181) - mat(k,1091) = -(rxt(k,430)*y(k,196) + rxt(k,431)*y(k,197) + rxt(k,432) & - *y(k,203) + rxt(k,433)*y(k,124) + rxt(k,434)*y(k,126)) - mat(k,1293) = -rxt(k,430)*y(k,229) - mat(k,1386) = -rxt(k,431)*y(k,229) - mat(k,2088) = -rxt(k,432)*y(k,229) - mat(k,1494) = -rxt(k,433)*y(k,229) - mat(k,1886) = -rxt(k,434)*y(k,229) - mat(k,157) = rxt(k,402)*y(k,221) - mat(k,213) = rxt(k,403)*y(k,221) - mat(k,69) = rxt(k,404)*y(k,221) - mat(k,579) = .400_r8*rxt(k,427)*y(k,221) - mat(k,131) = .500_r8*rxt(k,435)*y(k,221) - mat(k,1700) = rxt(k,402)*y(k,94) + rxt(k,403)*y(k,96) + rxt(k,404)*y(k,97) & + mat(k,2222) = -rxt(k,495)*y(k,232) + mat(k,2168) = -rxt(k,496)*y(k,232) + mat(k,2039) = -rxt(k,497)*y(k,232) + mat(k,991) = rxt(k,481)*y(k,226) + mat(k,1019) = rxt(k,484)*y(k,226) + mat(k,478) = rxt(k,498)*y(k,226) + mat(k,1766) = rxt(k,481)*y(k,6) + rxt(k,484)*y(k,110) + rxt(k,498)*y(k,177) + mat(k,749) = -(rxt(k,466)*y(k,90) + rxt(k,467)*y(k,124)) + mat(k,2153) = -rxt(k,466)*y(k,233) + mat(k,2023) = -rxt(k,467)*y(k,233) + mat(k,665) = rxt(k,468)*y(k,226) + mat(k,189) = .650_r8*rxt(k,469)*y(k,226) + mat(k,1744) = rxt(k,468)*y(k,180) + .650_r8*rxt(k,469)*y(k,181) + mat(k,86) = -(rxt(k,557)*y(k,90) + rxt(k,558)*y(k,124)) + mat(k,2113) = -rxt(k,557)*y(k,234) + mat(k,1997) = -rxt(k,558)*y(k,234) + mat(k,184) = rxt(k,556)*y(k,226) + mat(k,1660) = rxt(k,556)*y(k,181) + mat(k,1231) = -(rxt(k,430)*y(k,198) + rxt(k,431)*y(k,199) + rxt(k,432) & + *y(k,90) + rxt(k,433)*y(k,124) + rxt(k,434)*y(k,126)) + mat(k,1417) = -rxt(k,430)*y(k,235) + mat(k,2234) = -rxt(k,431)*y(k,235) + mat(k,2179) = -rxt(k,432)*y(k,235) + mat(k,2052) = -rxt(k,433)*y(k,235) + mat(k,1887) = -rxt(k,434)*y(k,235) + mat(k,230) = rxt(k,402)*y(k,226) + mat(k,325) = rxt(k,403)*y(k,226) + mat(k,132) = rxt(k,404)*y(k,226) + mat(k,732) = .400_r8*rxt(k,427)*y(k,226) + mat(k,202) = .500_r8*rxt(k,435)*y(k,226) + mat(k,1780) = rxt(k,402)*y(k,95) + rxt(k,403)*y(k,97) + rxt(k,404)*y(k,98) & + .400_r8*rxt(k,427)*y(k,103) + .500_r8*rxt(k,435)*y(k,182) - mat(k,634) = -(rxt(k,472)*y(k,203) + rxt(k,473)*y(k,124)) - mat(k,2063) = -rxt(k,472)*y(k,230) - mat(k,1466) = -rxt(k,473)*y(k,230) - mat(k,142) = .560_r8*rxt(k,471)*y(k,221) - mat(k,591) = rxt(k,474)*y(k,221) - mat(k,1665) = .560_r8*rxt(k,471)*y(k,183) + rxt(k,474)*y(k,184) - mat(k,392) = -(rxt(k,475)*y(k,203) + rxt(k,476)*y(k,124)) - mat(k,2047) = -rxt(k,475)*y(k,231) - mat(k,1453) = -rxt(k,476)*y(k,231) - mat(k,149) = .300_r8*rxt(k,477)*y(k,221) - mat(k,316) = rxt(k,478)*y(k,221) - mat(k,1640) = .300_r8*rxt(k,477)*y(k,185) + rxt(k,478)*y(k,186) - mat(k,2170) = -(rxt(k,154)*y(k,217) + rxt(k,273)*y(k,73) + rxt(k,518) & + mat(k,765) = -(rxt(k,472)*y(k,90) + rxt(k,473)*y(k,124)) + mat(k,2154) = -rxt(k,472)*y(k,236) + mat(k,2024) = -rxt(k,473)*y(k,236) + mat(k,209) = .560_r8*rxt(k,471)*y(k,226) + mat(k,721) = rxt(k,474)*y(k,226) + mat(k,1745) = .560_r8*rxt(k,471)*y(k,183) + rxt(k,474)*y(k,184) + mat(k,92) = -(rxt(k,560)*y(k,90) + rxt(k,561)*y(k,124)) + mat(k,2114) = -rxt(k,560)*y(k,237) + mat(k,1998) = -rxt(k,561)*y(k,237) + mat(k,204) = rxt(k,559)*y(k,226) + mat(k,1661) = rxt(k,559)*y(k,183) + mat(k,508) = -(rxt(k,475)*y(k,90) + rxt(k,476)*y(k,124)) + mat(k,2139) = -rxt(k,475)*y(k,238) + mat(k,2011) = -rxt(k,476)*y(k,238) + mat(k,216) = .300_r8*rxt(k,477)*y(k,226) + mat(k,426) = rxt(k,478)*y(k,226) + mat(k,1718) = .300_r8*rxt(k,477)*y(k,185) + rxt(k,478)*y(k,186) + mat(k,2447) = -(rxt(k,154)*y(k,222) + rxt(k,273)*y(k,73) + rxt(k,518) & *y(k,153)) - mat(k,1582) = -rxt(k,154)*y(k,232) - mat(k,680) = -rxt(k,273)*y(k,232) - mat(k,176) = -rxt(k,518)*y(k,232) - mat(k,211) = rxt(k,327)*y(k,221) - mat(k,308) = rxt(k,352)*y(k,221) - mat(k,58) = rxt(k,353)*y(k,221) - mat(k,1857) = rxt(k,297)*y(k,221) - mat(k,1084) = rxt(k,329)*y(k,221) - mat(k,903) = rxt(k,366)*y(k,221) - mat(k,1159) = rxt(k,355)*y(k,221) - mat(k,449) = rxt(k,335)*y(k,221) - mat(k,411) = rxt(k,336)*y(k,221) - mat(k,314) = rxt(k,303)*y(k,221) - mat(k,1934) = rxt(k,174)*y(k,203) - mat(k,1114) = rxt(k,179)*y(k,221) - mat(k,480) = rxt(k,180)*y(k,221) - mat(k,760) = rxt(k,264)*y(k,221) - mat(k,1349) = (rxt(k,556)+rxt(k,561))*y(k,91) + (rxt(k,549)+rxt(k,555) & - +rxt(k,560))*y(k,92) + rxt(k,235)*y(k,221) - mat(k,715) = rxt(k,307)*y(k,221) - mat(k,1956) = rxt(k,211)*y(k,221) - mat(k,367) = rxt(k,187)*y(k,221) - mat(k,661) = (rxt(k,556)+rxt(k,561))*y(k,85) - mat(k,768) = (rxt(k,549)+rxt(k,555)+rxt(k,560))*y(k,85) + rxt(k,238)*y(k,221) - mat(k,1150) = .500_r8*rxt(k,379)*y(k,221) - mat(k,51) = rxt(k,519)*y(k,221) - mat(k,437) = rxt(k,360)*y(k,221) - mat(k,296) = rxt(k,364)*y(k,221) - mat(k,2117) = rxt(k,174)*y(k,76) + rxt(k,181)*y(k,221) - mat(k,1730) = rxt(k,327)*y(k,28) + rxt(k,352)*y(k,30) + rxt(k,353)*y(k,31) & - + rxt(k,297)*y(k,42) + rxt(k,329)*y(k,45) + rxt(k,366)*y(k,48) & - + rxt(k,355)*y(k,49) + rxt(k,335)*y(k,50) + rxt(k,336)*y(k,51) & - + rxt(k,303)*y(k,53) + rxt(k,179)*y(k,77) + rxt(k,180)*y(k,79) & - + rxt(k,264)*y(k,81) + rxt(k,235)*y(k,85) + rxt(k,307)*y(k,87) & - + rxt(k,211)*y(k,89) + rxt(k,187)*y(k,90) + rxt(k,238)*y(k,92) & - + .500_r8*rxt(k,379)*y(k,105) + rxt(k,519)*y(k,120) + rxt(k,360) & - *y(k,147) + rxt(k,364)*y(k,148) + rxt(k,181)*y(k,203) & - + 2.000_r8*rxt(k,184)*y(k,221) + mat(k,1647) = -rxt(k,154)*y(k,239) + mat(k,931) = -rxt(k,273)*y(k,239) + mat(k,262) = -rxt(k,518)*y(k,239) + mat(k,301) = rxt(k,326)*y(k,226) + mat(k,418) = rxt(k,351)*y(k,226) + mat(k,307) = rxt(k,352)*y(k,226) + mat(k,476) = rxt(k,278)*y(k,226) + mat(k,2356) = rxt(k,297)*y(k,226) + mat(k,610) = rxt(k,280)*y(k,226) + mat(k,124) = rxt(k,281)*y(k,226) + mat(k,1157) = rxt(k,328)*y(k,226) + mat(k,376) = rxt(k,283)*y(k,226) + mat(k,1083) = rxt(k,366)*y(k,226) + mat(k,1286) = rxt(k,354)*y(k,226) + mat(k,707) = rxt(k,334)*y(k,226) + mat(k,624) = rxt(k,335)*y(k,226) + mat(k,394) = rxt(k,303)*y(k,226) + mat(k,2287) = rxt(k,304)*y(k,226) + mat(k,2102) = rxt(k,174)*y(k,90) + mat(k,1470) = rxt(k,179)*y(k,226) + mat(k,617) = rxt(k,180)*y(k,226) + mat(k,833) = rxt(k,264)*y(k,226) + mat(k,277) = rxt(k,288)*y(k,226) + mat(k,1505) = (rxt(k,570)+rxt(k,575))*y(k,92) + (rxt(k,563)+rxt(k,569) & + +rxt(k,574))*y(k,93) + rxt(k,235)*y(k,226) + mat(k,912) = rxt(k,306)*y(k,226) + mat(k,1986) = rxt(k,211)*y(k,226) + mat(k,2210) = rxt(k,174)*y(k,76) + rxt(k,181)*y(k,226) + mat(k,499) = rxt(k,187)*y(k,226) + mat(k,792) = (rxt(k,570)+rxt(k,575))*y(k,85) + mat(k,841) = (rxt(k,563)+rxt(k,569)+rxt(k,574))*y(k,85) + rxt(k,238)*y(k,226) + mat(k,1277) = .500_r8*rxt(k,379)*y(k,226) + mat(k,98) = rxt(k,519)*y(k,226) + mat(k,547) = rxt(k,360)*y(k,226) + mat(k,412) = rxt(k,364)*y(k,226) + mat(k,1812) = rxt(k,326)*y(k,28) + rxt(k,351)*y(k,30) + rxt(k,352)*y(k,31) & + + rxt(k,278)*y(k,41) + rxt(k,297)*y(k,42) + rxt(k,280)*y(k,43) & + + rxt(k,281)*y(k,44) + rxt(k,328)*y(k,45) + rxt(k,283)*y(k,46) & + + rxt(k,366)*y(k,48) + rxt(k,354)*y(k,49) + rxt(k,334)*y(k,50) & + + rxt(k,335)*y(k,51) + rxt(k,303)*y(k,53) + rxt(k,304)*y(k,54) & + + rxt(k,179)*y(k,77) + rxt(k,180)*y(k,79) + rxt(k,264)*y(k,81) & + + rxt(k,288)*y(k,84) + rxt(k,235)*y(k,85) + rxt(k,306)*y(k,87) & + + rxt(k,211)*y(k,89) + rxt(k,181)*y(k,90) + rxt(k,187)*y(k,91) & + + rxt(k,238)*y(k,93) + .500_r8*rxt(k,379)*y(k,105) + rxt(k,519) & + *y(k,120) + rxt(k,360)*y(k,147) + rxt(k,364)*y(k,148) & + + 2.000_r8*rxt(k,184)*y(k,226) end do - end subroutine nlnmat10 + end subroutine nlnmat11 subroutine nlnmat_finit( avec_len, mat, lmat, dti ) use chem_mods, only : gas_pcnst, rxntot, nzcnt implicit none @@ -2406,123 +2728,130 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 31) = lmat(k, 31) mat(k, 32) = lmat(k, 32) mat(k, 33) = lmat(k, 33) - mat(k, 39) = mat(k, 39) + lmat(k, 39) - mat(k, 45) = mat(k, 45) + lmat(k, 45) - mat(k, 46) = lmat(k, 46) - mat(k, 47) = lmat(k, 47) - mat(k, 48) = lmat(k, 48) - mat(k, 49) = mat(k, 49) + lmat(k, 49) - mat(k, 52) = mat(k, 52) + lmat(k, 52) - mat(k, 55) = mat(k, 55) + lmat(k, 55) - mat(k, 59) = mat(k, 59) + lmat(k, 59) + 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) = lmat(k, 39) + mat(k, 40) = lmat(k, 40) + mat(k, 41) = lmat(k, 41) + mat(k, 42) = lmat(k, 42) + mat(k, 48) = mat(k, 48) + lmat(k, 48) + mat(k, 54) = mat(k, 54) + lmat(k, 54) mat(k, 60) = mat(k, 60) + lmat(k, 60) - mat(k, 62) = lmat(k, 62) - mat(k, 63) = lmat(k, 63) - mat(k, 64) = lmat(k, 64) - mat(k, 65) = lmat(k, 65) - mat(k, 66) = lmat(k, 66) - mat(k, 67) = lmat(k, 67) - mat(k, 68) = mat(k, 68) + lmat(k, 68) - mat(k, 71) = lmat(k, 71) - mat(k, 72) = lmat(k, 72) - mat(k, 73) = lmat(k, 73) + mat(k, 66) = mat(k, 66) + lmat(k, 66) + mat(k, 72) = mat(k, 72) + lmat(k, 72) mat(k, 74) = mat(k, 74) + lmat(k, 74) - mat(k, 75) = mat(k, 75) + lmat(k, 75) - mat(k, 76) = mat(k, 76) + lmat(k, 76) - mat(k, 77) = mat(k, 77) + lmat(k, 77) - mat(k, 78) = lmat(k, 78) - mat(k, 79) = lmat(k, 79) - mat(k, 80) = lmat(k, 80) + mat(k, 80) = mat(k, 80) + lmat(k, 80) mat(k, 86) = mat(k, 86) + lmat(k, 86) - mat(k, 92) = lmat(k, 92) + mat(k, 92) = mat(k, 92) + lmat(k, 92) mat(k, 93) = lmat(k, 93) mat(k, 94) = lmat(k, 94) mat(k, 95) = lmat(k, 95) mat(k, 96) = mat(k, 96) + lmat(k, 96) + mat(k, 99) = mat(k, 99) + lmat(k, 99) mat(k, 101) = mat(k, 101) + lmat(k, 101) mat(k, 102) = mat(k, 102) + lmat(k, 102) - mat(k, 103) = mat(k, 103) + lmat(k, 103) mat(k, 105) = mat(k, 105) + lmat(k, 105) + mat(k, 106) = mat(k, 106) + lmat(k, 106) + mat(k, 107) = mat(k, 107) + lmat(k, 107) + mat(k, 109) = mat(k, 109) + lmat(k, 109) + mat(k, 110) = mat(k, 110) + lmat(k, 110) + mat(k, 112) = mat(k, 112) + lmat(k, 112) + mat(k, 113) = mat(k, 113) + lmat(k, 113) mat(k, 114) = mat(k, 114) + lmat(k, 114) + mat(k, 116) = mat(k, 116) + lmat(k, 116) + mat(k, 117) = mat(k, 117) + lmat(k, 117) + mat(k, 118) = mat(k, 118) + lmat(k, 118) + mat(k, 120) = mat(k, 120) + lmat(k, 120) mat(k, 121) = mat(k, 121) + lmat(k, 121) + mat(k, 123) = mat(k, 123) + lmat(k, 123) + 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, 132) = mat(k, 132) + lmat(k, 132) + mat(k, 130) = lmat(k, 130) + mat(k, 131) = mat(k, 131) + lmat(k, 131) + mat(k, 134) = lmat(k, 134) + mat(k, 135) = lmat(k, 135) + mat(k, 136) = lmat(k, 136) + mat(k, 137) = mat(k, 137) + lmat(k, 137) + mat(k, 138) = mat(k, 138) + lmat(k, 138) mat(k, 139) = mat(k, 139) + lmat(k, 139) + mat(k, 141) = mat(k, 141) + lmat(k, 141) + mat(k, 142) = mat(k, 142) + lmat(k, 142) + mat(k, 143) = mat(k, 143) + lmat(k, 143) + mat(k, 144) = mat(k, 144) + lmat(k, 144) + mat(k, 145) = mat(k, 145) + lmat(k, 145) mat(k, 147) = mat(k, 147) + lmat(k, 147) - mat(k, 152) = lmat(k, 152) - mat(k, 153) = lmat(k, 153) - mat(k, 154) = lmat(k, 154) - mat(k, 155) = mat(k, 155) + lmat(k, 155) - mat(k, 156) = lmat(k, 156) + mat(k, 148) = mat(k, 148) + lmat(k, 148) + mat(k, 149) = mat(k, 149) + lmat(k, 149) + mat(k, 151) = mat(k, 151) + lmat(k, 151) + mat(k, 152) = mat(k, 152) + lmat(k, 152) + mat(k, 153) = mat(k, 153) + lmat(k, 153) + mat(k, 154) = mat(k, 154) + lmat(k, 154) + mat(k, 156) = mat(k, 156) + lmat(k, 156) mat(k, 158) = mat(k, 158) + lmat(k, 158) - mat(k, 159) = lmat(k, 159) - mat(k, 160) = lmat(k, 160) - mat(k, 161) = lmat(k, 161) - mat(k, 162) = lmat(k, 162) - mat(k, 163) = mat(k, 163) + lmat(k, 163) + mat(k, 164) = lmat(k, 164) + mat(k, 165) = lmat(k, 165) mat(k, 166) = lmat(k, 166) mat(k, 167) = lmat(k, 167) - mat(k, 168) = lmat(k, 168) - mat(k, 169) = mat(k, 169) + lmat(k, 169) - mat(k, 173) = mat(k, 173) + lmat(k, 173) + mat(k, 168) = mat(k, 168) + lmat(k, 168) + mat(k, 173) = lmat(k, 173) mat(k, 174) = lmat(k, 174) - mat(k, 175) = lmat(k, 175) + mat(k, 175) = mat(k, 175) + lmat(k, 175) + mat(k, 176) = mat(k, 176) + lmat(k, 176) mat(k, 177) = mat(k, 177) + lmat(k, 177) - mat(k, 181) = mat(k, 181) + lmat(k, 181) - mat(k, 182) = lmat(k, 182) - mat(k, 184) = mat(k, 184) + lmat(k, 184) - mat(k, 185) = lmat(k, 185) - mat(k, 186) = lmat(k, 186) - mat(k, 187) = lmat(k, 187) - mat(k, 188) = lmat(k, 188) - mat(k, 189) = lmat(k, 189) - mat(k, 190) = lmat(k, 190) - mat(k, 191) = mat(k, 191) + lmat(k, 191) + mat(k, 178) = mat(k, 178) + lmat(k, 178) + mat(k, 179) = lmat(k, 179) + mat(k, 180) = mat(k, 180) + lmat(k, 180) + mat(k, 185) = mat(k, 185) + lmat(k, 185) + mat(k, 192) = mat(k, 192) + lmat(k, 192) mat(k, 197) = lmat(k, 197) mat(k, 198) = lmat(k, 198) mat(k, 199) = lmat(k, 199) - mat(k, 200) = mat(k, 200) + lmat(k, 200) + mat(k, 200) = lmat(k, 200) + mat(k, 201) = mat(k, 201) + lmat(k, 201) + mat(k, 203) = mat(k, 203) + lmat(k, 203) mat(k, 206) = mat(k, 206) + lmat(k, 206) - mat(k, 212) = mat(k, 212) + lmat(k, 212) - mat(k, 215) = mat(k, 215) + lmat(k, 215) + mat(k, 214) = mat(k, 214) + lmat(k, 214) + mat(k, 219) = mat(k, 219) + lmat(k, 219) mat(k, 220) = mat(k, 220) + lmat(k, 220) - mat(k, 222) = lmat(k, 222) - mat(k, 223) = lmat(k, 223) + mat(k, 223) = mat(k, 223) + lmat(k, 223) mat(k, 224) = mat(k, 224) + lmat(k, 224) - mat(k, 225) = lmat(k, 225) - mat(k, 226) = lmat(k, 226) - mat(k, 227) = lmat(k, 227) - mat(k, 228) = lmat(k, 228) + mat(k, 225) = mat(k, 225) + lmat(k, 225) + mat(k, 227) = mat(k, 227) + lmat(k, 227) + mat(k, 228) = mat(k, 228) + lmat(k, 228) mat(k, 229) = lmat(k, 229) - mat(k, 230) = mat(k, 230) + lmat(k, 230) - mat(k, 233) = lmat(k, 233) - mat(k, 234) = mat(k, 234) + lmat(k, 234) - mat(k, 235) = mat(k, 235) + lmat(k, 235) + mat(k, 231) = mat(k, 231) + lmat(k, 231) + mat(k, 232) = lmat(k, 232) + mat(k, 233) = mat(k, 233) + lmat(k, 233) + mat(k, 236) = lmat(k, 236) mat(k, 237) = lmat(k, 237) - mat(k, 238) = mat(k, 238) + lmat(k, 238) + mat(k, 238) = lmat(k, 238) mat(k, 239) = lmat(k, 239) mat(k, 240) = lmat(k, 240) - mat(k, 241) = mat(k, 241) + lmat(k, 241) - mat(k, 244) = mat(k, 244) + lmat(k, 244) - mat(k, 245) = lmat(k, 245) - mat(k, 246) = mat(k, 246) + lmat(k, 246) + mat(k, 241) = lmat(k, 241) + mat(k, 242) = mat(k, 242) + lmat(k, 242) + mat(k, 243) = mat(k, 243) + lmat(k, 243) + mat(k, 245) = mat(k, 245) + lmat(k, 245) mat(k, 248) = mat(k, 248) + lmat(k, 248) mat(k, 249) = mat(k, 249) + lmat(k, 249) - mat(k, 250) = lmat(k, 250) - mat(k, 251) = mat(k, 251) + lmat(k, 251) - mat(k, 252) = lmat(k, 252) + mat(k, 253) = mat(k, 253) + lmat(k, 253) mat(k, 254) = mat(k, 254) + lmat(k, 254) + mat(k, 256) = mat(k, 256) + lmat(k, 256) mat(k, 259) = mat(k, 259) + lmat(k, 259) + mat(k, 260) = lmat(k, 260) + mat(k, 261) = lmat(k, 261) + mat(k, 263) = mat(k, 263) + lmat(k, 263) mat(k, 267) = mat(k, 267) + lmat(k, 267) - mat(k, 271) = lmat(k, 271) - mat(k, 273) = mat(k, 273) + lmat(k, 273) - mat(k, 274) = lmat(k, 274) - mat(k, 276) = lmat(k, 276) - mat(k, 277) = mat(k, 277) + lmat(k, 277) + mat(k, 268) = lmat(k, 268) + mat(k, 270) = mat(k, 270) + lmat(k, 270) + mat(k, 271) = mat(k, 271) + lmat(k, 271) + mat(k, 272) = mat(k, 272) + lmat(k, 272) + mat(k, 276) = mat(k, 276) + lmat(k, 276) mat(k, 278) = lmat(k, 278) mat(k, 279) = lmat(k, 279) mat(k, 280) = lmat(k, 280) @@ -2530,757 +2859,839 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 282) = lmat(k, 282) mat(k, 283) = lmat(k, 283) mat(k, 284) = lmat(k, 284) - mat(k, 285) = mat(k, 285) + lmat(k, 285) + mat(k, 285) = lmat(k, 285) mat(k, 286) = lmat(k, 286) - mat(k, 288) = mat(k, 288) + lmat(k, 288) + mat(k, 287) = lmat(k, 287) + mat(k, 288) = lmat(k, 288) mat(k, 289) = lmat(k, 289) - mat(k, 290) = lmat(k, 290) - mat(k, 291) = mat(k, 291) + lmat(k, 291) - mat(k, 293) = lmat(k, 293) - mat(k, 294) = mat(k, 294) + lmat(k, 294) - mat(k, 295) = lmat(k, 295) - mat(k, 297) = mat(k, 297) + lmat(k, 297) - mat(k, 298) = lmat(k, 298) - mat(k, 301) = lmat(k, 301) + mat(k, 290) = mat(k, 290) + lmat(k, 290) + mat(k, 296) = mat(k, 296) + lmat(k, 296) mat(k, 302) = mat(k, 302) + lmat(k, 302) - mat(k, 303) = mat(k, 303) + lmat(k, 303) - mat(k, 305) = lmat(k, 305) - mat(k, 306) = mat(k, 306) + lmat(k, 306) - mat(k, 307) = lmat(k, 307) - mat(k, 309) = mat(k, 309) + lmat(k, 309) - mat(k, 311) = mat(k, 311) + lmat(k, 311) - mat(k, 312) = mat(k, 312) + lmat(k, 312) - mat(k, 313) = lmat(k, 313) - mat(k, 315) = mat(k, 315) + lmat(k, 315) - mat(k, 317) = lmat(k, 317) - mat(k, 318) = lmat(k, 318) + mat(k, 308) = mat(k, 308) + lmat(k, 308) + mat(k, 314) = mat(k, 314) + lmat(k, 314) mat(k, 319) = mat(k, 319) + lmat(k, 319) - mat(k, 320) = lmat(k, 320) + mat(k, 321) = lmat(k, 321) + mat(k, 322) = lmat(k, 322) mat(k, 323) = mat(k, 323) + lmat(k, 323) - mat(k, 329) = mat(k, 329) + lmat(k, 329) - mat(k, 332) = lmat(k, 332) - mat(k, 334) = mat(k, 334) + lmat(k, 334) - mat(k, 336) = mat(k, 336) + lmat(k, 336) + mat(k, 324) = mat(k, 324) + lmat(k, 324) + mat(k, 327) = lmat(k, 327) + mat(k, 328) = lmat(k, 328) + mat(k, 329) = lmat(k, 329) + mat(k, 330) = lmat(k, 330) + mat(k, 331) = lmat(k, 331) + mat(k, 332) = mat(k, 332) + lmat(k, 332) + mat(k, 335) = mat(k, 335) + lmat(k, 335) + mat(k, 336) = lmat(k, 336) + mat(k, 337) = mat(k, 337) + lmat(k, 337) + mat(k, 339) = lmat(k, 339) + mat(k, 340) = mat(k, 340) + lmat(k, 340) + mat(k, 341) = lmat(k, 341) mat(k, 342) = lmat(k, 342) - mat(k, 343) = lmat(k, 343) - mat(k, 344) = lmat(k, 344) - mat(k, 345) = mat(k, 345) + lmat(k, 345) - mat(k, 348) = lmat(k, 348) - mat(k, 349) = mat(k, 349) + lmat(k, 349) + mat(k, 343) = mat(k, 343) + lmat(k, 343) + mat(k, 346) = mat(k, 346) + lmat(k, 346) + mat(k, 347) = lmat(k, 347) + mat(k, 348) = mat(k, 348) + lmat(k, 348) mat(k, 350) = mat(k, 350) + lmat(k, 350) - mat(k, 351) = lmat(k, 351) + mat(k, 351) = mat(k, 351) + lmat(k, 351) mat(k, 352) = lmat(k, 352) - mat(k, 355) = mat(k, 355) + lmat(k, 355) - mat(k, 356) = lmat(k, 356) - mat(k, 357) = mat(k, 357) + lmat(k, 357) + mat(k, 353) = mat(k, 353) + lmat(k, 353) mat(k, 361) = mat(k, 361) + lmat(k, 361) - mat(k, 363) = mat(k, 363) + lmat(k, 363) - mat(k, 364) = lmat(k, 364) - mat(k, 365) = mat(k, 365) + lmat(k, 365) - mat(k, 366) = lmat(k, 366) - mat(k, 368) = mat(k, 368) + lmat(k, 368) - mat(k, 369) = lmat(k, 369) - mat(k, 370) = lmat(k, 370) - mat(k, 372) = mat(k, 372) + lmat(k, 372) - mat(k, 373) = lmat(k, 373) - mat(k, 374) = lmat(k, 374) + mat(k, 362) = lmat(k, 362) + mat(k, 364) = mat(k, 364) + lmat(k, 364) + mat(k, 369) = mat(k, 369) + lmat(k, 369) + mat(k, 373) = mat(k, 373) + lmat(k, 373) + mat(k, 375) = lmat(k, 375) mat(k, 377) = mat(k, 377) + lmat(k, 377) - mat(k, 384) = mat(k, 384) + lmat(k, 384) - mat(k, 392) = mat(k, 392) + lmat(k, 392) - mat(k, 400) = mat(k, 400) + lmat(k, 400) - mat(k, 406) = mat(k, 406) + lmat(k, 406) - mat(k, 408) = lmat(k, 408) - mat(k, 409) = mat(k, 409) + lmat(k, 409) - mat(k, 412) = mat(k, 412) + lmat(k, 412) - mat(k, 417) = mat(k, 417) + lmat(k, 417) - mat(k, 419) = lmat(k, 419) + mat(k, 381) = lmat(k, 381) + mat(k, 383) = lmat(k, 383) + mat(k, 384) = lmat(k, 384) + mat(k, 385) = lmat(k, 385) + mat(k, 386) = lmat(k, 386) + mat(k, 387) = lmat(k, 387) + mat(k, 388) = lmat(k, 388) + mat(k, 389) = mat(k, 389) + lmat(k, 389) + mat(k, 390) = mat(k, 390) + lmat(k, 390) + mat(k, 391) = lmat(k, 391) + mat(k, 393) = mat(k, 393) + lmat(k, 393) + mat(k, 395) = mat(k, 395) + lmat(k, 395) + mat(k, 396) = lmat(k, 396) + mat(k, 398) = mat(k, 398) + lmat(k, 398) + mat(k, 399) = lmat(k, 399) + mat(k, 400) = lmat(k, 400) + mat(k, 401) = mat(k, 401) + lmat(k, 401) + mat(k, 402) = lmat(k, 402) + mat(k, 404) = lmat(k, 404) + mat(k, 405) = mat(k, 405) + lmat(k, 405) + mat(k, 406) = lmat(k, 406) + mat(k, 407) = mat(k, 407) + lmat(k, 407) + mat(k, 409) = lmat(k, 409) + mat(k, 410) = mat(k, 410) + lmat(k, 410) + mat(k, 411) = lmat(k, 411) + mat(k, 413) = mat(k, 413) + lmat(k, 413) + mat(k, 415) = lmat(k, 415) + mat(k, 416) = mat(k, 416) + lmat(k, 416) + mat(k, 417) = lmat(k, 417) + mat(k, 419) = mat(k, 419) + lmat(k, 419) mat(k, 420) = lmat(k, 420) - mat(k, 422) = mat(k, 422) + lmat(k, 422) + mat(k, 423) = lmat(k, 423) + mat(k, 424) = mat(k, 424) + lmat(k, 424) + mat(k, 425) = mat(k, 425) + lmat(k, 425) + mat(k, 427) = lmat(k, 427) mat(k, 428) = lmat(k, 428) - mat(k, 430) = mat(k, 430) + lmat(k, 430) - mat(k, 433) = lmat(k, 433) - mat(k, 434) = mat(k, 434) + lmat(k, 434) - mat(k, 435) = lmat(k, 435) - mat(k, 436) = lmat(k, 436) - mat(k, 438) = mat(k, 438) + lmat(k, 438) - mat(k, 439) = lmat(k, 439) - mat(k, 440) = lmat(k, 440) - mat(k, 442) = mat(k, 442) + lmat(k, 442) - mat(k, 443) = lmat(k, 443) + mat(k, 429) = mat(k, 429) + lmat(k, 429) + mat(k, 430) = lmat(k, 430) + mat(k, 433) = mat(k, 433) + lmat(k, 433) + mat(k, 439) = mat(k, 439) + lmat(k, 439) + mat(k, 443) = mat(k, 443) + lmat(k, 443) mat(k, 444) = lmat(k, 444) mat(k, 445) = mat(k, 445) + lmat(k, 445) - mat(k, 446) = mat(k, 446) + lmat(k, 446) - mat(k, 450) = mat(k, 450) + lmat(k, 450) - mat(k, 458) = mat(k, 458) + lmat(k, 458) + mat(k, 447) = mat(k, 447) + lmat(k, 447) + mat(k, 452) = mat(k, 452) + lmat(k, 452) + mat(k, 458) = lmat(k, 458) + mat(k, 459) = lmat(k, 459) + mat(k, 460) = lmat(k, 460) + mat(k, 461) = mat(k, 461) + lmat(k, 461) + mat(k, 464) = mat(k, 464) + lmat(k, 464) + mat(k, 465) = lmat(k, 465) mat(k, 466) = mat(k, 466) + lmat(k, 466) - mat(k, 468) = lmat(k, 468) - mat(k, 472) = lmat(k, 472) - mat(k, 474) = mat(k, 474) + lmat(k, 474) + mat(k, 470) = mat(k, 470) + lmat(k, 470) + mat(k, 472) = mat(k, 472) + lmat(k, 472) mat(k, 477) = mat(k, 477) + lmat(k, 477) + mat(k, 479) = lmat(k, 479) + mat(k, 480) = lmat(k, 480) mat(k, 481) = mat(k, 481) + lmat(k, 481) mat(k, 482) = lmat(k, 482) mat(k, 483) = lmat(k, 483) - mat(k, 484) = lmat(k, 484) - mat(k, 485) = lmat(k, 485) - mat(k, 487) = mat(k, 487) + lmat(k, 487) - mat(k, 488) = lmat(k, 488) - mat(k, 489) = lmat(k, 489) - mat(k, 490) = lmat(k, 490) - mat(k, 491) = lmat(k, 491) - mat(k, 492) = mat(k, 492) + lmat(k, 492) - mat(k, 493) = lmat(k, 493) + mat(k, 486) = mat(k, 486) + lmat(k, 486) + mat(k, 493) = mat(k, 493) + lmat(k, 493) + mat(k, 495) = mat(k, 495) + lmat(k, 495) + mat(k, 496) = mat(k, 496) + lmat(k, 496) mat(k, 497) = lmat(k, 497) mat(k, 498) = lmat(k, 498) - mat(k, 499) = mat(k, 499) + lmat(k, 499) - mat(k, 500) = lmat(k, 500) - mat(k, 501) = lmat(k, 501) - mat(k, 502) = lmat(k, 502) - mat(k, 503) = lmat(k, 503) - mat(k, 504) = lmat(k, 504) - mat(k, 505) = mat(k, 505) + lmat(k, 505) - mat(k, 511) = lmat(k, 511) - mat(k, 514) = mat(k, 514) + lmat(k, 514) + mat(k, 500) = mat(k, 500) + lmat(k, 500) + mat(k, 508) = mat(k, 508) + lmat(k, 508) mat(k, 515) = mat(k, 515) + lmat(k, 515) - mat(k, 516) = lmat(k, 516) mat(k, 517) = lmat(k, 517) mat(k, 518) = lmat(k, 518) mat(k, 521) = mat(k, 521) + lmat(k, 521) - mat(k, 522) = mat(k, 522) + lmat(k, 522) - mat(k, 524) = lmat(k, 524) - mat(k, 525) = mat(k, 525) + lmat(k, 525) - mat(k, 526) = lmat(k, 526) - mat(k, 529) = mat(k, 529) + lmat(k, 529) - mat(k, 535) = lmat(k, 535) - mat(k, 536) = mat(k, 536) + lmat(k, 536) - mat(k, 539) = mat(k, 539) + lmat(k, 539) + mat(k, 527) = mat(k, 527) + lmat(k, 527) + mat(k, 532) = mat(k, 532) + lmat(k, 532) + mat(k, 533) = lmat(k, 533) + mat(k, 534) = lmat(k, 534) + mat(k, 536) = lmat(k, 536) + mat(k, 537) = mat(k, 537) + lmat(k, 537) + mat(k, 538) = lmat(k, 538) mat(k, 540) = mat(k, 540) + lmat(k, 540) - mat(k, 543) = mat(k, 543) + lmat(k, 543) + mat(k, 542) = lmat(k, 542) mat(k, 544) = mat(k, 544) + lmat(k, 544) mat(k, 545) = lmat(k, 545) mat(k, 546) = lmat(k, 546) - mat(k, 547) = mat(k, 547) + lmat(k, 547) - mat(k, 551) = lmat(k, 551) - mat(k, 552) = lmat(k, 552) - mat(k, 554) = mat(k, 554) + lmat(k, 554) - mat(k, 555) = lmat(k, 555) - mat(k, 556) = lmat(k, 556) - mat(k, 558) = mat(k, 558) + lmat(k, 558) + mat(k, 548) = mat(k, 548) + lmat(k, 548) + mat(k, 556) = mat(k, 556) + lmat(k, 556) + mat(k, 562) = lmat(k, 562) + mat(k, 564) = mat(k, 564) + lmat(k, 564) + mat(k, 565) = lmat(k, 565) + mat(k, 566) = lmat(k, 566) mat(k, 567) = mat(k, 567) + lmat(k, 567) - mat(k, 578) = mat(k, 578) + lmat(k, 578) - mat(k, 580) = lmat(k, 580) - mat(k, 581) = lmat(k, 581) - mat(k, 583) = lmat(k, 583) - mat(k, 584) = lmat(k, 584) + mat(k, 568) = lmat(k, 568) + mat(k, 569) = mat(k, 569) + lmat(k, 569) + mat(k, 570) = lmat(k, 570) + mat(k, 572) = mat(k, 572) + lmat(k, 572) + mat(k, 580) = mat(k, 580) + lmat(k, 580) + mat(k, 582) = lmat(k, 582) mat(k, 585) = lmat(k, 585) - mat(k, 586) = lmat(k, 586) - mat(k, 587) = lmat(k, 587) - mat(k, 588) = lmat(k, 588) mat(k, 589) = mat(k, 589) + lmat(k, 589) - mat(k, 593) = lmat(k, 593) - mat(k, 596) = lmat(k, 596) - mat(k, 598) = mat(k, 598) + lmat(k, 598) + mat(k, 595) = lmat(k, 595) + mat(k, 598) = lmat(k, 598) mat(k, 599) = lmat(k, 599) - mat(k, 600) = mat(k, 600) + lmat(k, 600) - mat(k, 607) = mat(k, 607) + lmat(k, 607) + mat(k, 600) = lmat(k, 600) + mat(k, 601) = lmat(k, 601) + mat(k, 602) = mat(k, 602) + lmat(k, 602) + mat(k, 604) = mat(k, 604) + lmat(k, 604) + mat(k, 609) = lmat(k, 609) + mat(k, 611) = mat(k, 611) + lmat(k, 611) + mat(k, 613) = mat(k, 613) + lmat(k, 613) mat(k, 618) = mat(k, 618) + lmat(k, 618) - mat(k, 634) = mat(k, 634) + lmat(k, 634) - mat(k, 645) = mat(k, 645) + lmat(k, 645) - mat(k, 654) = mat(k, 654) + lmat(k, 654) + mat(k, 620) = mat(k, 620) + lmat(k, 620) + mat(k, 621) = mat(k, 621) + lmat(k, 621) + mat(k, 622) = lmat(k, 622) + mat(k, 625) = mat(k, 625) + lmat(k, 625) + mat(k, 626) = mat(k, 626) + lmat(k, 626) + mat(k, 628) = mat(k, 628) + lmat(k, 628) + mat(k, 629) = lmat(k, 629) + mat(k, 630) = lmat(k, 630) + mat(k, 633) = mat(k, 633) + lmat(k, 633) + mat(k, 639) = lmat(k, 639) + mat(k, 640) = mat(k, 640) + lmat(k, 640) + mat(k, 643) = mat(k, 643) + lmat(k, 643) + mat(k, 644) = mat(k, 644) + lmat(k, 644) + mat(k, 647) = mat(k, 647) + lmat(k, 647) + mat(k, 648) = lmat(k, 648) + mat(k, 649) = mat(k, 649) + lmat(k, 649) + mat(k, 650) = mat(k, 650) + lmat(k, 650) + mat(k, 651) = lmat(k, 651) + mat(k, 652) = lmat(k, 652) + mat(k, 653) = lmat(k, 653) + mat(k, 654) = lmat(k, 654) mat(k, 656) = lmat(k, 656) - mat(k, 658) = mat(k, 658) + lmat(k, 658) - mat(k, 664) = mat(k, 664) + lmat(k, 664) - mat(k, 672) = mat(k, 672) + lmat(k, 672) - mat(k, 673) = mat(k, 673) + lmat(k, 673) - mat(k, 675) = lmat(k, 675) - mat(k, 681) = mat(k, 681) + lmat(k, 681) - mat(k, 682) = mat(k, 682) + lmat(k, 682) - mat(k, 686) = mat(k, 686) + lmat(k, 686) - mat(k, 690) = mat(k, 690) + lmat(k, 690) - mat(k, 701) = mat(k, 701) + lmat(k, 701) + mat(k, 657) = mat(k, 657) + lmat(k, 657) + mat(k, 658) = lmat(k, 658) + mat(k, 659) = lmat(k, 659) + mat(k, 660) = lmat(k, 660) + mat(k, 661) = lmat(k, 661) + mat(k, 662) = lmat(k, 662) + mat(k, 663) = mat(k, 663) + lmat(k, 663) + mat(k, 668) = lmat(k, 668) + mat(k, 670) = lmat(k, 670) + mat(k, 671) = mat(k, 671) + lmat(k, 671) + mat(k, 672) = lmat(k, 672) + mat(k, 674) = mat(k, 674) + lmat(k, 674) + mat(k, 684) = lmat(k, 684) + mat(k, 685) = mat(k, 685) + lmat(k, 685) + mat(k, 689) = lmat(k, 689) + mat(k, 690) = lmat(k, 690) + mat(k, 692) = mat(k, 692) + lmat(k, 692) + mat(k, 693) = lmat(k, 693) + mat(k, 694) = lmat(k, 694) + mat(k, 696) = mat(k, 696) + lmat(k, 696) + mat(k, 703) = mat(k, 703) + lmat(k, 703) mat(k, 708) = mat(k, 708) + lmat(k, 708) - mat(k, 712) = mat(k, 712) + lmat(k, 712) - mat(k, 717) = mat(k, 717) + lmat(k, 717) + mat(k, 715) = lmat(k, 715) + mat(k, 716) = lmat(k, 716) + mat(k, 717) = lmat(k, 717) + mat(k, 718) = lmat(k, 718) + mat(k, 719) = mat(k, 719) + lmat(k, 719) + mat(k, 724) = lmat(k, 724) + mat(k, 726) = lmat(k, 726) mat(k, 728) = mat(k, 728) + lmat(k, 728) - mat(k, 739) = lmat(k, 739) - mat(k, 743) = lmat(k, 743) - mat(k, 744) = mat(k, 744) + lmat(k, 744) - mat(k, 753) = mat(k, 753) + lmat(k, 753) - mat(k, 754) = mat(k, 754) + lmat(k, 754) - mat(k, 758) = mat(k, 758) + lmat(k, 758) - mat(k, 762) = mat(k, 762) + lmat(k, 762) - mat(k, 764) = mat(k, 764) + lmat(k, 764) + mat(k, 729) = lmat(k, 729) + mat(k, 731) = mat(k, 731) + lmat(k, 731) + mat(k, 733) = lmat(k, 733) + mat(k, 734) = lmat(k, 734) + mat(k, 735) = mat(k, 735) + lmat(k, 735) + mat(k, 736) = lmat(k, 736) + mat(k, 737) = lmat(k, 737) + mat(k, 738) = mat(k, 738) + lmat(k, 738) + mat(k, 749) = mat(k, 749) + lmat(k, 749) mat(k, 765) = mat(k, 765) + lmat(k, 765) - mat(k, 769) = mat(k, 769) + lmat(k, 769) - mat(k, 771) = lmat(k, 771) - mat(k, 773) = lmat(k, 773) - mat(k, 774) = mat(k, 774) + lmat(k, 774) - mat(k, 781) = mat(k, 781) + lmat(k, 781) - mat(k, 797) = lmat(k, 797) - mat(k, 798) = mat(k, 798) + lmat(k, 798) - mat(k, 799) = mat(k, 799) + lmat(k, 799) - mat(k, 801) = mat(k, 801) + lmat(k, 801) + mat(k, 776) = mat(k, 776) + lmat(k, 776) + mat(k, 785) = mat(k, 785) + lmat(k, 785) + mat(k, 787) = lmat(k, 787) + mat(k, 789) = mat(k, 789) + lmat(k, 789) + mat(k, 795) = mat(k, 795) + lmat(k, 795) mat(k, 803) = mat(k, 803) + lmat(k, 803) - mat(k, 820) = mat(k, 820) + lmat(k, 820) - mat(k, 840) = mat(k, 840) + lmat(k, 840) - mat(k, 858) = mat(k, 858) + lmat(k, 858) + mat(k, 804) = lmat(k, 804) + mat(k, 806) = lmat(k, 806) + mat(k, 811) = mat(k, 811) + lmat(k, 811) + mat(k, 816) = mat(k, 816) + lmat(k, 816) + mat(k, 826) = mat(k, 826) + lmat(k, 826) + mat(k, 827) = mat(k, 827) + lmat(k, 827) + mat(k, 831) = mat(k, 831) + lmat(k, 831) + mat(k, 835) = mat(k, 835) + lmat(k, 835) + mat(k, 838) = mat(k, 838) + lmat(k, 838) + mat(k, 839) = mat(k, 839) + lmat(k, 839) + mat(k, 843) = mat(k, 843) + lmat(k, 843) + mat(k, 850) = mat(k, 850) + lmat(k, 850) + mat(k, 851) = mat(k, 851) + lmat(k, 851) + mat(k, 856) = mat(k, 856) + lmat(k, 856) + mat(k, 863) = mat(k, 863) + lmat(k, 863) + mat(k, 871) = mat(k, 871) + lmat(k, 871) + mat(k, 873) = lmat(k, 873) + mat(k, 875) = mat(k, 875) + lmat(k, 875) + mat(k, 876) = lmat(k, 876) mat(k, 880) = mat(k, 880) + lmat(k, 880) - mat(k, 892) = mat(k, 892) + lmat(k, 892) - mat(k, 893) = lmat(k, 893) - mat(k, 895) = lmat(k, 895) - mat(k, 898) = mat(k, 898) + lmat(k, 898) - mat(k, 900) = lmat(k, 900) - mat(k, 901) = lmat(k, 901) - mat(k, 905) = mat(k, 905) + lmat(k, 905) - mat(k, 906) = mat(k, 906) + lmat(k, 906) + mat(k, 899) = mat(k, 899) + lmat(k, 899) mat(k, 908) = mat(k, 908) + lmat(k, 908) - mat(k, 911) = mat(k, 911) + lmat(k, 911) - mat(k, 912) = mat(k, 912) + lmat(k, 912) - mat(k, 913) = lmat(k, 913) - mat(k, 914) = mat(k, 914) + lmat(k, 914) - mat(k, 916) = mat(k, 916) + lmat(k, 916) - mat(k, 917) = lmat(k, 917) - mat(k, 918) = lmat(k, 918) - mat(k, 923) = lmat(k, 923) - mat(k, 924) = lmat(k, 924) - mat(k, 928) = mat(k, 928) + lmat(k, 928) - mat(k, 936) = lmat(k, 936) - mat(k, 937) = lmat(k, 937) - mat(k, 938) = mat(k, 938) + lmat(k, 938) - mat(k, 943) = mat(k, 943) + lmat(k, 943) + mat(k, 913) = mat(k, 913) + lmat(k, 913) + mat(k, 923) = mat(k, 923) + lmat(k, 923) + mat(k, 933) = mat(k, 933) + lmat(k, 933) + mat(k, 945) = mat(k, 945) + lmat(k, 945) + mat(k, 946) = lmat(k, 946) + mat(k, 949) = lmat(k, 949) + mat(k, 952) = mat(k, 952) + lmat(k, 952) + mat(k, 953) = mat(k, 953) + lmat(k, 953) + mat(k, 955) = mat(k, 955) + lmat(k, 955) + mat(k, 957) = lmat(k, 957) + mat(k, 958) = mat(k, 958) + lmat(k, 958) + mat(k, 959) = mat(k, 959) + lmat(k, 959) mat(k, 960) = mat(k, 960) + lmat(k, 960) - mat(k, 961) = lmat(k, 961) - mat(k, 963) = mat(k, 963) + lmat(k, 963) - mat(k, 964) = mat(k, 964) + lmat(k, 964) - mat(k, 966) = lmat(k, 966) - mat(k, 967) = lmat(k, 967) - mat(k, 968) = mat(k, 968) + lmat(k, 968) - mat(k, 969) = lmat(k, 969) - mat(k, 970) = lmat(k, 970) - mat(k, 972) = lmat(k, 972) - mat(k, 973) = lmat(k, 973) - mat(k, 976) = lmat(k, 976) - mat(k, 977) = lmat(k, 977) - mat(k, 978) = lmat(k, 978) - mat(k, 979) = mat(k, 979) + lmat(k, 979) - mat(k, 981) = mat(k, 981) + lmat(k, 981) - mat(k, 982) = mat(k, 982) + lmat(k, 982) - mat(k, 983) = mat(k, 983) + lmat(k, 983) - mat(k, 984) = mat(k, 984) + lmat(k, 984) - mat(k, 985) = mat(k, 985) + lmat(k, 985) + mat(k, 964) = lmat(k, 964) + mat(k, 968) = lmat(k, 968) + mat(k, 969) = mat(k, 969) + lmat(k, 969) mat(k, 988) = mat(k, 988) + lmat(k, 988) - mat(k, 989) = mat(k, 989) + lmat(k, 989) - mat(k, 991) = mat(k, 991) + lmat(k, 991) - mat(k, 993) = lmat(k, 993) - mat(k, 995) = lmat(k, 995) - mat(k, 996) = mat(k, 996) + lmat(k, 996) - mat(k, 997) = mat(k, 997) + lmat(k, 997) - mat(k,1008) = mat(k,1008) + lmat(k,1008) - mat(k,1030) = mat(k,1030) + lmat(k,1030) - mat(k,1049) = mat(k,1049) + lmat(k,1049) - mat(k,1065) = mat(k,1065) + lmat(k,1065) - mat(k,1075) = lmat(k,1075) - mat(k,1076) = mat(k,1076) + lmat(k,1076) - mat(k,1078) = lmat(k,1078) - mat(k,1083) = lmat(k,1083) - mat(k,1091) = mat(k,1091) + lmat(k,1091) + mat(k,1016) = mat(k,1016) + lmat(k,1016) + mat(k,1040) = mat(k,1040) + lmat(k,1040) + mat(k,1051) = lmat(k,1051) + mat(k,1052) = mat(k,1052) + lmat(k,1052) + mat(k,1053) = mat(k,1053) + lmat(k,1053) + mat(k,1056) = mat(k,1056) + lmat(k,1056) + mat(k,1060) = mat(k,1060) + lmat(k,1060) + mat(k,1070) = mat(k,1070) + lmat(k,1070) + mat(k,1072) = lmat(k,1072) + mat(k,1073) = lmat(k,1073) + mat(k,1077) = lmat(k,1077) + mat(k,1078) = mat(k,1078) + lmat(k,1078) + mat(k,1080) = lmat(k,1080) + mat(k,1082) = lmat(k,1082) + mat(k,1088) = mat(k,1088) + lmat(k,1088) + mat(k,1100) = mat(k,1100) + lmat(k,1100) + mat(k,1101) = mat(k,1101) + lmat(k,1101) + mat(k,1102) = mat(k,1102) + lmat(k,1102) + mat(k,1103) = mat(k,1103) + lmat(k,1103) mat(k,1104) = mat(k,1104) + lmat(k,1104) + mat(k,1105) = mat(k,1105) + lmat(k,1105) + mat(k,1107) = mat(k,1107) + lmat(k,1107) + mat(k,1109) = mat(k,1109) + lmat(k,1109) + mat(k,1111) = lmat(k,1111) + mat(k,1115) = mat(k,1115) + lmat(k,1115) + mat(k,1121) = lmat(k,1121) + mat(k,1122) = lmat(k,1122) mat(k,1124) = mat(k,1124) + lmat(k,1124) - mat(k,1139) = mat(k,1139) + lmat(k,1139) - mat(k,1140) = mat(k,1140) + lmat(k,1140) - mat(k,1143) = mat(k,1143) + lmat(k,1143) - mat(k,1144) = mat(k,1144) + lmat(k,1144) - mat(k,1147) = mat(k,1147) + lmat(k,1147) + mat(k,1131) = mat(k,1131) + lmat(k,1131) mat(k,1149) = mat(k,1149) + lmat(k,1149) - mat(k,1151) = mat(k,1151) + lmat(k,1151) - mat(k,1152) = mat(k,1152) + lmat(k,1152) - mat(k,1153) = mat(k,1153) + lmat(k,1153) - mat(k,1158) = lmat(k,1158) - mat(k,1172) = mat(k,1172) + lmat(k,1172) - mat(k,1188) = lmat(k,1188) + mat(k,1150) = lmat(k,1150) + mat(k,1155) = lmat(k,1155) + mat(k,1156) = lmat(k,1156) + mat(k,1158) = mat(k,1158) + lmat(k,1158) + mat(k,1163) = lmat(k,1163) + mat(k,1164) = mat(k,1164) + lmat(k,1164) + mat(k,1167) = mat(k,1167) + lmat(k,1167) + mat(k,1168) = mat(k,1168) + lmat(k,1168) + mat(k,1176) = mat(k,1176) + lmat(k,1176) + mat(k,1189) = lmat(k,1189) + mat(k,1190) = lmat(k,1190) + mat(k,1191) = lmat(k,1191) + mat(k,1192) = lmat(k,1192) + mat(k,1193) = mat(k,1193) + lmat(k,1193) + mat(k,1194) = lmat(k,1194) + mat(k,1196) = lmat(k,1196) + mat(k,1199) = lmat(k,1199) + mat(k,1201) = lmat(k,1201) + mat(k,1202) = mat(k,1202) + lmat(k,1202) + mat(k,1204) = lmat(k,1204) mat(k,1206) = mat(k,1206) + lmat(k,1206) - mat(k,1220) = mat(k,1220) + lmat(k,1220) + mat(k,1208) = lmat(k,1208) + mat(k,1210) = mat(k,1210) + lmat(k,1210) + mat(k,1211) = lmat(k,1211) + mat(k,1215) = mat(k,1215) + lmat(k,1215) mat(k,1231) = mat(k,1231) + lmat(k,1231) - mat(k,1245) = lmat(k,1245) - mat(k,1247) = mat(k,1247) + lmat(k,1247) mat(k,1251) = mat(k,1251) + lmat(k,1251) - mat(k,1253) = mat(k,1253) + lmat(k,1253) - mat(k,1254) = lmat(k,1254) + mat(k,1266) = mat(k,1266) + lmat(k,1266) + mat(k,1267) = mat(k,1267) + lmat(k,1267) + mat(k,1270) = mat(k,1270) + lmat(k,1270) mat(k,1271) = mat(k,1271) + lmat(k,1271) - mat(k,1302) = mat(k,1302) + lmat(k,1302) - mat(k,1316) = lmat(k,1316) - mat(k,1318) = mat(k,1318) + lmat(k,1318) - mat(k,1325) = mat(k,1325) + lmat(k,1325) - mat(k,1337) = mat(k,1337) + lmat(k,1337) - mat(k,1339) = mat(k,1339) + lmat(k,1339) - mat(k,1344) = mat(k,1344) + lmat(k,1344) - mat(k,1352) = mat(k,1352) + lmat(k,1352) - mat(k,1396) = mat(k,1396) + lmat(k,1396) - mat(k,1415) = mat(k,1415) + lmat(k,1415) - mat(k,1418) = mat(k,1418) + lmat(k,1418) - mat(k,1420) = lmat(k,1420) - mat(k,1427) = mat(k,1427) + lmat(k,1427) - mat(k,1430) = mat(k,1430) + lmat(k,1430) - mat(k,1433) = mat(k,1433) + lmat(k,1433) - mat(k,1470) = mat(k,1470) + lmat(k,1470) - mat(k,1471) = lmat(k,1471) - mat(k,1475) = mat(k,1475) + lmat(k,1475) - mat(k,1507) = mat(k,1507) + lmat(k,1507) - mat(k,1512) = mat(k,1512) + lmat(k,1512) - mat(k,1534) = mat(k,1534) + lmat(k,1534) - mat(k,1538) = mat(k,1538) + lmat(k,1538) - mat(k,1539) = lmat(k,1539) - mat(k,1540) = lmat(k,1540) + mat(k,1274) = mat(k,1274) + lmat(k,1274) + mat(k,1275) = mat(k,1275) + lmat(k,1275) + mat(k,1278) = mat(k,1278) + lmat(k,1278) + mat(k,1279) = mat(k,1279) + lmat(k,1279) + mat(k,1280) = mat(k,1280) + lmat(k,1280) + mat(k,1285) = lmat(k,1285) + mat(k,1297) = mat(k,1297) + lmat(k,1297) + mat(k,1313) = lmat(k,1313) + mat(k,1330) = mat(k,1330) + lmat(k,1330) + mat(k,1341) = mat(k,1341) + lmat(k,1341) + mat(k,1354) = mat(k,1354) + lmat(k,1354) + mat(k,1368) = lmat(k,1368) + mat(k,1370) = mat(k,1370) + lmat(k,1370) + mat(k,1374) = mat(k,1374) + lmat(k,1374) + mat(k,1376) = mat(k,1376) + lmat(k,1376) + mat(k,1385) = lmat(k,1385) + mat(k,1395) = mat(k,1395) + lmat(k,1395) + mat(k,1426) = mat(k,1426) + lmat(k,1426) + mat(k,1447) = mat(k,1447) + lmat(k,1447) + mat(k,1448) = mat(k,1448) + lmat(k,1448) + mat(k,1456) = lmat(k,1456) + mat(k,1459) = mat(k,1459) + lmat(k,1459) + mat(k,1472) = lmat(k,1472) + mat(k,1474) = mat(k,1474) + lmat(k,1474) + mat(k,1485) = mat(k,1485) + lmat(k,1485) + mat(k,1493) = mat(k,1493) + lmat(k,1493) + mat(k,1501) = mat(k,1501) + lmat(k,1501) + mat(k,1503) = mat(k,1503) + lmat(k,1503) + mat(k,1509) = mat(k,1509) + lmat(k,1509) + mat(k,1529) = mat(k,1529) + lmat(k,1529) + mat(k,1531) = mat(k,1531) + lmat(k,1531) + mat(k,1532) = lmat(k,1532) + mat(k,1540) = mat(k,1540) + lmat(k,1540) mat(k,1543) = mat(k,1543) + lmat(k,1543) - mat(k,1554) = mat(k,1554) + lmat(k,1554) - mat(k,1557) = mat(k,1557) + lmat(k,1557) - mat(k,1559) = mat(k,1559) + lmat(k,1559) + mat(k,1550) = mat(k,1550) + lmat(k,1550) mat(k,1561) = mat(k,1561) + lmat(k,1561) mat(k,1563) = mat(k,1563) + lmat(k,1563) - mat(k,1565) = mat(k,1565) + lmat(k,1565) - mat(k,1566) = lmat(k,1566) - mat(k,1567) = mat(k,1567) + lmat(k,1567) - mat(k,1568) = lmat(k,1568) - mat(k,1569) = mat(k,1569) + lmat(k,1569) - mat(k,1570) = mat(k,1570) + lmat(k,1570) - mat(k,1571) = mat(k,1571) + lmat(k,1571) - mat(k,1573) = mat(k,1573) + lmat(k,1573) - mat(k,1574) = lmat(k,1574) - mat(k,1576) = mat(k,1576) + lmat(k,1576) - mat(k,1580) = lmat(k,1580) - mat(k,1593) = lmat(k,1593) - mat(k,1598) = lmat(k,1598) - mat(k,1713) = mat(k,1713) + lmat(k,1713) - mat(k,1714) = mat(k,1714) + lmat(k,1714) - mat(k,1717) = mat(k,1717) + lmat(k,1717) - mat(k,1719) = mat(k,1719) + lmat(k,1719) - mat(k,1728) = mat(k,1728) + lmat(k,1728) - mat(k,1730) = mat(k,1730) + lmat(k,1730) - mat(k,1736) = mat(k,1736) + lmat(k,1736) - mat(k,1777) = mat(k,1777) + lmat(k,1777) - mat(k,1780) = mat(k,1780) + lmat(k,1780) - mat(k,1782) = mat(k,1782) + lmat(k,1782) - mat(k,1783) = mat(k,1783) + lmat(k,1783) - mat(k,1800) = mat(k,1800) + lmat(k,1800) - mat(k,1806) = lmat(k,1806) - mat(k,1824) = mat(k,1824) + lmat(k,1824) - mat(k,1837) = mat(k,1837) + lmat(k,1837) - mat(k,1838) = lmat(k,1838) + mat(k,1574) = mat(k,1574) + lmat(k,1574) + mat(k,1590) = mat(k,1590) + lmat(k,1590) + mat(k,1595) = mat(k,1595) + lmat(k,1595) + mat(k,1601) = mat(k,1601) + lmat(k,1601) + mat(k,1633) = mat(k,1633) + lmat(k,1633) + mat(k,1644) = mat(k,1644) + lmat(k,1644) + mat(k,1799) = mat(k,1799) + lmat(k,1799) + mat(k,1844) = mat(k,1844) + lmat(k,1844) + mat(k,1845) = mat(k,1845) + lmat(k,1845) + mat(k,1848) = mat(k,1848) + lmat(k,1848) mat(k,1849) = mat(k,1849) + lmat(k,1849) - mat(k,1851) = mat(k,1851) + lmat(k,1851) - mat(k,1899) = mat(k,1899) + lmat(k,1899) + mat(k,1854) = mat(k,1854) + lmat(k,1854) mat(k,1900) = mat(k,1900) + lmat(k,1900) mat(k,1905) = mat(k,1905) + lmat(k,1905) - mat(k,1907) = mat(k,1907) + lmat(k,1907) + mat(k,1906) = mat(k,1906) + lmat(k,1906) + mat(k,1908) = mat(k,1908) + lmat(k,1908) mat(k,1909) = mat(k,1909) + lmat(k,1909) - mat(k,1910) = mat(k,1910) + lmat(k,1910) - mat(k,1928) = mat(k,1928) + lmat(k,1928) - mat(k,1945) = mat(k,1945) + lmat(k,1945) - mat(k,1951) = mat(k,1951) + lmat(k,1951) - mat(k,1952) = lmat(k,1952) - mat(k,1984) = mat(k,1984) + lmat(k,1984) - mat(k,1987) = mat(k,1987) + lmat(k,1987) - mat(k,1989) = mat(k,1989) + lmat(k,1989) - mat(k,1993) = mat(k,1993) + lmat(k,1993) - mat(k,1994) = mat(k,1994) + lmat(k,1994) - mat(k,2006) = mat(k,2006) + lmat(k,2006) - mat(k,2013) = mat(k,2013) + lmat(k,2013) - mat(k,2019) = mat(k,2019) + lmat(k,2019) - mat(k,2052) = mat(k,2052) + lmat(k,2052) - mat(k,2115) = mat(k,2115) + lmat(k,2115) - mat(k,2131) = mat(k,2131) + lmat(k,2131) - mat(k,2135) = mat(k,2135) + lmat(k,2135) - mat(k,2143) = mat(k,2143) + lmat(k,2143) - mat(k,2150) = lmat(k,2150) - mat(k,2158) = mat(k,2158) + lmat(k,2158) - mat(k,2159) = mat(k,2159) + lmat(k,2159) - mat(k,2161) = lmat(k,2161) - mat(k,2164) = lmat(k,2164) - mat(k,2170) = mat(k,2170) + lmat(k,2170) - mat(k, 143) = 0._r8 - mat(k, 144) = 0._r8 - mat(k, 243) = 0._r8 - mat(k, 324) = 0._r8 - mat(k, 326) = 0._r8 - mat(k, 339) = 0._r8 - mat(k, 378) = 0._r8 - mat(k, 381) = 0._r8 - mat(k, 396) = 0._r8 - mat(k, 494) = 0._r8 - mat(k, 496) = 0._r8 - mat(k, 531) = 0._r8 - mat(k, 532) = 0._r8 - mat(k, 537) = 0._r8 - mat(k, 538) = 0._r8 - mat(k, 541) = 0._r8 - mat(k, 548) = 0._r8 - mat(k, 549) = 0._r8 - mat(k, 553) = 0._r8 - mat(k, 572) = 0._r8 - mat(k, 574) = 0._r8 - mat(k, 575) = 0._r8 - mat(k, 590) = 0._r8 - mat(k, 592) = 0._r8 - mat(k, 594) = 0._r8 - mat(k, 595) = 0._r8 - mat(k, 597) = 0._r8 - mat(k, 617) = 0._r8 - mat(k, 619) = 0._r8 - mat(k, 621) = 0._r8 - mat(k, 622) = 0._r8 - mat(k, 625) = 0._r8 - mat(k, 633) = 0._r8 - mat(k, 635) = 0._r8 - mat(k, 637) = 0._r8 + mat(k,1914) = mat(k,1914) + lmat(k,1914) + mat(k,1953) = mat(k,1953) + lmat(k,1953) + mat(k,1973) = mat(k,1973) + lmat(k,1973) + mat(k,1974) = lmat(k,1974) + mat(k,1977) = mat(k,1977) + lmat(k,1977) + mat(k,2028) = mat(k,2028) + lmat(k,2028) + mat(k,2030) = lmat(k,2030) + mat(k,2036) = mat(k,2036) + lmat(k,2036) + mat(k,2073) = mat(k,2073) + lmat(k,2073) + mat(k,2078) = mat(k,2078) + lmat(k,2078) + mat(k,2095) = mat(k,2095) + lmat(k,2095) + mat(k,2204) = mat(k,2204) + lmat(k,2204) + mat(k,2210) = mat(k,2210) + lmat(k,2210) + mat(k,2257) = mat(k,2257) + lmat(k,2257) + mat(k,2265) = lmat(k,2265) + mat(k,2266) = lmat(k,2266) + mat(k,2267) = mat(k,2267) + lmat(k,2267) + mat(k,2274) = mat(k,2274) + lmat(k,2274) + mat(k,2280) = mat(k,2280) + lmat(k,2280) + mat(k,2282) = mat(k,2282) + lmat(k,2282) + mat(k,2283) = mat(k,2283) + lmat(k,2283) + mat(k,2284) = lmat(k,2284) + mat(k,2285) = mat(k,2285) + lmat(k,2285) + mat(k,2287) = mat(k,2287) + lmat(k,2287) + mat(k,2298) = mat(k,2298) + lmat(k,2298) + mat(k,2303) = lmat(k,2303) + mat(k,2327) = mat(k,2327) + lmat(k,2327) + mat(k,2334) = mat(k,2334) + lmat(k,2334) + mat(k,2336) = lmat(k,2336) + mat(k,2349) = mat(k,2349) + lmat(k,2349) + mat(k,2354) = mat(k,2354) + lmat(k,2354) + mat(k,2362) = mat(k,2362) + lmat(k,2362) + mat(k,2403) = mat(k,2403) + lmat(k,2403) + mat(k,2406) = mat(k,2406) + lmat(k,2406) + mat(k,2417) = mat(k,2417) + lmat(k,2417) + mat(k,2419) = mat(k,2419) + lmat(k,2419) + mat(k,2426) = lmat(k,2426) + mat(k,2433) = mat(k,2433) + lmat(k,2433) + mat(k,2434) = mat(k,2434) + lmat(k,2434) + mat(k,2440) = lmat(k,2440) + mat(k,2444) = lmat(k,2444) + mat(k,2447) = mat(k,2447) + lmat(k,2447) + mat(k, 210) = 0._r8 + mat(k, 211) = 0._r8 + mat(k, 250) = 0._r8 + mat(k, 273) = 0._r8 + mat(k, 345) = 0._r8 + mat(k, 434) = 0._r8 + mat(k, 435) = 0._r8 + mat(k, 454) = 0._r8 + mat(k, 487) = 0._r8 + mat(k, 489) = 0._r8 + mat(k, 511) = 0._r8 + mat(k, 634) = 0._r8 mat(k, 638) = 0._r8 - mat(k, 640) = 0._r8 + mat(k, 641) = 0._r8 mat(k, 642) = 0._r8 - mat(k, 657) = 0._r8 - mat(k, 665) = 0._r8 + mat(k, 645) = 0._r8 + mat(k, 664) = 0._r8 mat(k, 666) = 0._r8 - mat(k, 668) = 0._r8 - mat(k, 693) = 0._r8 - mat(k, 694) = 0._r8 - mat(k, 695) = 0._r8 - mat(k, 703) = 0._r8 - mat(k, 704) = 0._r8 - mat(k, 705) = 0._r8 - mat(k, 718) = 0._r8 + mat(k, 667) = 0._r8 + mat(k, 669) = 0._r8 + mat(k, 681) = 0._r8 + mat(k, 682) = 0._r8 + mat(k, 686) = 0._r8 + mat(k, 687) = 0._r8 + mat(k, 691) = 0._r8 + mat(k, 720) = 0._r8 mat(k, 722) = 0._r8 - mat(k, 726) = 0._r8 - mat(k, 734) = 0._r8 - mat(k, 738) = 0._r8 - mat(k, 740) = 0._r8 - mat(k, 745) = 0._r8 + mat(k, 723) = 0._r8 + mat(k, 725) = 0._r8 + mat(k, 727) = 0._r8 mat(k, 748) = 0._r8 + mat(k, 750) = 0._r8 + mat(k, 751) = 0._r8 + mat(k, 753) = 0._r8 + mat(k, 755) = 0._r8 + mat(k, 764) = 0._r8 + mat(k, 766) = 0._r8 + mat(k, 767) = 0._r8 + mat(k, 769) = 0._r8 + mat(k, 771) = 0._r8 + mat(k, 772) = 0._r8 + mat(k, 790) = 0._r8 mat(k, 796) = 0._r8 - mat(k, 819) = 0._r8 - mat(k, 821) = 0._r8 - mat(k, 829) = 0._r8 - mat(k, 836) = 0._r8 - mat(k, 845) = 0._r8 - mat(k, 857) = 0._r8 - mat(k, 859) = 0._r8 + mat(k, 797) = 0._r8 + mat(k, 798) = 0._r8 + mat(k, 818) = 0._r8 + mat(k, 820) = 0._r8 + mat(k, 825) = 0._r8 + mat(k, 846) = 0._r8 + mat(k, 847) = 0._r8 + mat(k, 848) = 0._r8 + mat(k, 860) = 0._r8 + mat(k, 865) = 0._r8 + mat(k, 866) = 0._r8 mat(k, 867) = 0._r8 - mat(k, 874) = 0._r8 - mat(k, 878) = 0._r8 - mat(k, 879) = 0._r8 - mat(k, 883) = 0._r8 - mat(k, 884) = 0._r8 - mat(k, 885) = 0._r8 - mat(k, 887) = 0._r8 - mat(k, 897) = 0._r8 - mat(k, 915) = 0._r8 - mat(k, 927) = 0._r8 - mat(k, 929) = 0._r8 - mat(k, 930) = 0._r8 - mat(k, 931) = 0._r8 - mat(k, 932) = 0._r8 - mat(k, 933) = 0._r8 - mat(k, 935) = 0._r8 - mat(k, 944) = 0._r8 - mat(k, 947) = 0._r8 - mat(k, 948) = 0._r8 + mat(k, 869) = 0._r8 + mat(k, 902) = 0._r8 + mat(k, 937) = 0._r8 + mat(k, 943) = 0._r8 mat(k, 950) = 0._r8 - mat(k, 951) = 0._r8 - mat(k, 956) = 0._r8 - mat(k, 958) = 0._r8 + mat(k, 962) = 0._r8 + mat(k, 965) = 0._r8 + mat(k, 970) = 0._r8 mat(k, 971) = 0._r8 - mat(k, 974) = 0._r8 - mat(k, 980) = 0._r8 - mat(k, 986) = 0._r8 + mat(k, 973) = 0._r8 + mat(k, 989) = 0._r8 mat(k, 990) = 0._r8 + mat(k, 998) = 0._r8 mat(k,1006) = 0._r8 - mat(k,1007) = 0._r8 - mat(k,1009) = 0._r8 - mat(k,1010) = 0._r8 - mat(k,1011) = 0._r8 - mat(k,1012) = 0._r8 - mat(k,1015) = 0._r8 mat(k,1017) = 0._r8 mat(k,1018) = 0._r8 - mat(k,1019) = 0._r8 - mat(k,1022) = 0._r8 - mat(k,1031) = 0._r8 - mat(k,1032) = 0._r8 - mat(k,1035) = 0._r8 - mat(k,1037) = 0._r8 + mat(k,1026) = 0._r8 + mat(k,1034) = 0._r8 mat(k,1038) = 0._r8 - mat(k,1041) = 0._r8 - mat(k,1046) = 0._r8 - mat(k,1047) = 0._r8 - mat(k,1048) = 0._r8 - mat(k,1050) = 0._r8 - mat(k,1051) = 0._r8 - mat(k,1054) = 0._r8 - mat(k,1057) = 0._r8 - mat(k,1058) = 0._r8 - mat(k,1061) = 0._r8 - mat(k,1074) = 0._r8 - mat(k,1081) = 0._r8 - mat(k,1096) = 0._r8 - mat(k,1099) = 0._r8 - mat(k,1106) = 0._r8 - mat(k,1111) = 0._r8 + mat(k,1039) = 0._r8 + mat(k,1043) = 0._r8 + mat(k,1044) = 0._r8 + mat(k,1045) = 0._r8 + mat(k,1049) = 0._r8 + mat(k,1063) = 0._r8 + mat(k,1065) = 0._r8 + mat(k,1089) = 0._r8 + mat(k,1090) = 0._r8 + mat(k,1091) = 0._r8 + mat(k,1092) = 0._r8 + mat(k,1095) = 0._r8 + mat(k,1108) = 0._r8 + mat(k,1110) = 0._r8 mat(k,1113) = 0._r8 + mat(k,1116) = 0._r8 mat(k,1117) = 0._r8 + mat(k,1118) = 0._r8 mat(k,1119) = 0._r8 - mat(k,1121) = 0._r8 - mat(k,1122) = 0._r8 mat(k,1123) = 0._r8 mat(k,1125) = 0._r8 mat(k,1126) = 0._r8 - mat(k,1127) = 0._r8 - mat(k,1131) = 0._r8 mat(k,1134) = 0._r8 mat(k,1135) = 0._r8 + mat(k,1136) = 0._r8 + mat(k,1138) = 0._r8 + mat(k,1140) = 0._r8 + mat(k,1142) = 0._r8 mat(k,1148) = 0._r8 - mat(k,1156) = 0._r8 - mat(k,1163) = 0._r8 - mat(k,1164) = 0._r8 - mat(k,1165) = 0._r8 - mat(k,1166) = 0._r8 - mat(k,1167) = 0._r8 - mat(k,1168) = 0._r8 - mat(k,1169) = 0._r8 - mat(k,1171) = 0._r8 - mat(k,1173) = 0._r8 - mat(k,1175) = 0._r8 - mat(k,1179) = 0._r8 + mat(k,1177) = 0._r8 + mat(k,1178) = 0._r8 mat(k,1180) = 0._r8 - mat(k,1183) = 0._r8 - mat(k,1184) = 0._r8 + mat(k,1182) = 0._r8 mat(k,1187) = 0._r8 - mat(k,1191) = 0._r8 - mat(k,1194) = 0._r8 - mat(k,1196) = 0._r8 - mat(k,1198) = 0._r8 + mat(k,1195) = 0._r8 + mat(k,1197) = 0._r8 mat(k,1200) = 0._r8 - mat(k,1201) = 0._r8 - mat(k,1202) = 0._r8 mat(k,1203) = 0._r8 - mat(k,1204) = 0._r8 - mat(k,1207) = 0._r8 - mat(k,1208) = 0._r8 - mat(k,1209) = 0._r8 - mat(k,1213) = 0._r8 - mat(k,1214) = 0._r8 - mat(k,1217) = 0._r8 - mat(k,1218) = 0._r8 - mat(k,1221) = 0._r8 - mat(k,1228) = 0._r8 - mat(k,1229) = 0._r8 - mat(k,1232) = 0._r8 - mat(k,1236) = 0._r8 - mat(k,1239) = 0._r8 - mat(k,1240) = 0._r8 - mat(k,1243) = 0._r8 + mat(k,1205) = 0._r8 + mat(k,1224) = 0._r8 + mat(k,1235) = 0._r8 + mat(k,1244) = 0._r8 mat(k,1246) = 0._r8 + mat(k,1248) = 0._r8 + mat(k,1249) = 0._r8 + mat(k,1250) = 0._r8 mat(k,1252) = 0._r8 - mat(k,1255) = 0._r8 + mat(k,1253) = 0._r8 + mat(k,1254) = 0._r8 mat(k,1256) = 0._r8 + mat(k,1257) = 0._r8 mat(k,1260) = 0._r8 - mat(k,1261) = 0._r8 - mat(k,1262) = 0._r8 - mat(k,1263) = 0._r8 - mat(k,1265) = 0._r8 - mat(k,1269) = 0._r8 - mat(k,1270) = 0._r8 - mat(k,1279) = 0._r8 - mat(k,1280) = 0._r8 - mat(k,1283) = 0._r8 - mat(k,1304) = 0._r8 - mat(k,1309) = 0._r8 - mat(k,1310) = 0._r8 + mat(k,1272) = 0._r8 + mat(k,1281) = 0._r8 + mat(k,1290) = 0._r8 + mat(k,1291) = 0._r8 + mat(k,1292) = 0._r8 + mat(k,1293) = 0._r8 + mat(k,1294) = 0._r8 + mat(k,1296) = 0._r8 + mat(k,1298) = 0._r8 + mat(k,1300) = 0._r8 + mat(k,1303) = 0._r8 + mat(k,1306) = 0._r8 mat(k,1311) = 0._r8 - mat(k,1314) = 0._r8 - mat(k,1329) = 0._r8 + mat(k,1312) = 0._r8 + mat(k,1316) = 0._r8 + mat(k,1319) = 0._r8 + mat(k,1320) = 0._r8 + mat(k,1322) = 0._r8 + mat(k,1324) = 0._r8 + mat(k,1326) = 0._r8 + mat(k,1327) = 0._r8 + mat(k,1328) = 0._r8 mat(k,1331) = 0._r8 - mat(k,1338) = 0._r8 - mat(k,1343) = 0._r8 - mat(k,1346) = 0._r8 - mat(k,1347) = 0._r8 - mat(k,1354) = 0._r8 + mat(k,1332) = 0._r8 + mat(k,1333) = 0._r8 + mat(k,1335) = 0._r8 + mat(k,1336) = 0._r8 + mat(k,1339) = 0._r8 + mat(k,1344) = 0._r8 + mat(k,1345) = 0._r8 + mat(k,1352) = 0._r8 mat(k,1355) = 0._r8 mat(k,1357) = 0._r8 - mat(k,1359) = 0._r8 - mat(k,1362) = 0._r8 + mat(k,1358) = 0._r8 + mat(k,1361) = 0._r8 + mat(k,1366) = 0._r8 mat(k,1371) = 0._r8 - mat(k,1400) = 0._r8 + mat(k,1375) = 0._r8 + mat(k,1378) = 0._r8 + mat(k,1380) = 0._r8 + mat(k,1381) = 0._r8 + mat(k,1382) = 0._r8 + mat(k,1383) = 0._r8 + mat(k,1386) = 0._r8 + mat(k,1389) = 0._r8 + mat(k,1393) = 0._r8 + mat(k,1394) = 0._r8 mat(k,1401) = 0._r8 - mat(k,1403) = 0._r8 - mat(k,1404) = 0._r8 - mat(k,1405) = 0._r8 - mat(k,1409) = 0._r8 - mat(k,1424) = 0._r8 - mat(k,1426) = 0._r8 - mat(k,1429) = 0._r8 + mat(k,1407) = 0._r8 + mat(k,1428) = 0._r8 mat(k,1431) = 0._r8 - mat(k,1434) = 0._r8 + mat(k,1432) = 0._r8 mat(k,1436) = 0._r8 - mat(k,1437) = 0._r8 mat(k,1439) = 0._r8 - mat(k,1440) = 0._r8 - mat(k,1476) = 0._r8 - mat(k,1509) = 0._r8 + mat(k,1443) = 0._r8 + mat(k,1445) = 0._r8 + mat(k,1446) = 0._r8 + mat(k,1449) = 0._r8 + mat(k,1450) = 0._r8 + mat(k,1451) = 0._r8 + mat(k,1452) = 0._r8 + mat(k,1453) = 0._r8 + mat(k,1454) = 0._r8 + mat(k,1455) = 0._r8 + mat(k,1463) = 0._r8 + mat(k,1465) = 0._r8 + mat(k,1467) = 0._r8 + mat(k,1468) = 0._r8 + mat(k,1484) = 0._r8 + mat(k,1487) = 0._r8 + mat(k,1494) = 0._r8 + mat(k,1495) = 0._r8 + mat(k,1499) = 0._r8 + mat(k,1500) = 0._r8 + mat(k,1508) = 0._r8 + mat(k,1512) = 0._r8 + mat(k,1513) = 0._r8 + mat(k,1514) = 0._r8 mat(k,1515) = 0._r8 mat(k,1516) = 0._r8 + mat(k,1518) = 0._r8 mat(k,1521) = 0._r8 - mat(k,1527) = 0._r8 - mat(k,1528) = 0._r8 - mat(k,1530) = 0._r8 - mat(k,1533) = 0._r8 mat(k,1535) = 0._r8 mat(k,1537) = 0._r8 + mat(k,1539) = 0._r8 + mat(k,1541) = 0._r8 mat(k,1542) = 0._r8 mat(k,1544) = 0._r8 - mat(k,1547) = 0._r8 + mat(k,1545) = 0._r8 + mat(k,1546) = 0._r8 mat(k,1551) = 0._r8 - mat(k,1552) = 0._r8 mat(k,1553) = 0._r8 - mat(k,1556) = 0._r8 + mat(k,1560) = 0._r8 + mat(k,1565) = 0._r8 + mat(k,1568) = 0._r8 + mat(k,1570) = 0._r8 + mat(k,1572) = 0._r8 mat(k,1575) = 0._r8 + mat(k,1576) = 0._r8 mat(k,1577) = 0._r8 - mat(k,1578) = 0._r8 - mat(k,1634) = 0._r8 - mat(k,1653) = 0._r8 - mat(k,1663) = 0._r8 - mat(k,1666) = 0._r8 - mat(k,1668) = 0._r8 - mat(k,1679) = 0._r8 - mat(k,1702) = 0._r8 - mat(k,1718) = 0._r8 - mat(k,1745) = 0._r8 - mat(k,1748) = 0._r8 - mat(k,1751) = 0._r8 + mat(k,1591) = 0._r8 + mat(k,1594) = 0._r8 + mat(k,1596) = 0._r8 + mat(k,1598) = 0._r8 + mat(k,1603) = 0._r8 + mat(k,1604) = 0._r8 + mat(k,1635) = 0._r8 + mat(k,1636) = 0._r8 + mat(k,1638) = 0._r8 + mat(k,1712) = 0._r8 + mat(k,1728) = 0._r8 + mat(k,1743) = 0._r8 + mat(k,1746) = 0._r8 mat(k,1756) = 0._r8 - mat(k,1758) = 0._r8 - mat(k,1760) = 0._r8 - mat(k,1761) = 0._r8 - mat(k,1762) = 0._r8 - mat(k,1765) = 0._r8 - mat(k,1768) = 0._r8 - mat(k,1769) = 0._r8 - mat(k,1770) = 0._r8 - mat(k,1772) = 0._r8 - mat(k,1787) = 0._r8 - mat(k,1792) = 0._r8 - mat(k,1802) = 0._r8 - mat(k,1804) = 0._r8 - mat(k,1810) = 0._r8 - mat(k,1817) = 0._r8 - mat(k,1821) = 0._r8 - mat(k,1828) = 0._r8 + mat(k,1757) = 0._r8 + mat(k,1781) = 0._r8 + mat(k,1798) = 0._r8 + mat(k,1822) = 0._r8 + mat(k,1825) = 0._r8 + mat(k,1830) = 0._r8 + mat(k,1831) = 0._r8 + mat(k,1832) = 0._r8 mat(k,1833) = 0._r8 - mat(k,1835) = 0._r8 - mat(k,1841) = 0._r8 - mat(k,1842) = 0._r8 + mat(k,1836) = 0._r8 + mat(k,1838) = 0._r8 + mat(k,1839) = 0._r8 mat(k,1843) = 0._r8 - mat(k,1845) = 0._r8 mat(k,1847) = 0._r8 + mat(k,1850) = 0._r8 + mat(k,1852) = 0._r8 mat(k,1853) = 0._r8 - mat(k,1854) = 0._r8 - mat(k,1856) = 0._r8 + mat(k,1855) = 0._r8 + mat(k,1857) = 0._r8 mat(k,1864) = 0._r8 - mat(k,1870) = 0._r8 + mat(k,1867) = 0._r8 + mat(k,1871) = 0._r8 + mat(k,1873) = 0._r8 mat(k,1877) = 0._r8 - mat(k,1878) = 0._r8 - mat(k,1881) = 0._r8 mat(k,1884) = 0._r8 - mat(k,1896) = 0._r8 + mat(k,1886) = 0._r8 mat(k,1897) = 0._r8 mat(k,1898) = 0._r8 + mat(k,1899) = 0._r8 mat(k,1901) = 0._r8 mat(k,1902) = 0._r8 - mat(k,1904) = 0._r8 - mat(k,1908) = 0._r8 - mat(k,1911) = 0._r8 + mat(k,1903) = 0._r8 + mat(k,1907) = 0._r8 + mat(k,1910) = 0._r8 + mat(k,1912) = 0._r8 mat(k,1913) = 0._r8 - mat(k,1914) = 0._r8 mat(k,1916) = 0._r8 mat(k,1917) = 0._r8 - mat(k,1918) = 0._r8 - mat(k,1920) = 0._r8 - mat(k,1921) = 0._r8 - mat(k,1922) = 0._r8 - mat(k,1926) = 0._r8 - mat(k,1927) = 0._r8 - mat(k,1929) = 0._r8 - mat(k,1930) = 0._r8 + mat(k,1928) = 0._r8 mat(k,1931) = 0._r8 - mat(k,1933) = 0._r8 - mat(k,1937) = 0._r8 + mat(k,1934) = 0._r8 + mat(k,1935) = 0._r8 + mat(k,1936) = 0._r8 mat(k,1938) = 0._r8 mat(k,1939) = 0._r8 mat(k,1940) = 0._r8 mat(k,1941) = 0._r8 mat(k,1942) = 0._r8 - mat(k,1943) = 0._r8 - mat(k,1944) = 0._r8 - mat(k,1946) = 0._r8 mat(k,1947) = 0._r8 - mat(k,1948) = 0._r8 - mat(k,1950) = 0._r8 - mat(k,1953) = 0._r8 + mat(k,1949) = 0._r8 + mat(k,1951) = 0._r8 mat(k,1954) = 0._r8 mat(k,1955) = 0._r8 - mat(k,1965) = 0._r8 + mat(k,1960) = 0._r8 + mat(k,1963) = 0._r8 + mat(k,1966) = 0._r8 + mat(k,1967) = 0._r8 mat(k,1968) = 0._r8 + mat(k,1969) = 0._r8 mat(k,1970) = 0._r8 - mat(k,1974) = 0._r8 - mat(k,1975) = 0._r8 + mat(k,1971) = 0._r8 + mat(k,1972) = 0._r8 mat(k,1976) = 0._r8 + mat(k,1978) = 0._r8 + mat(k,1979) = 0._r8 mat(k,1980) = 0._r8 mat(k,1981) = 0._r8 mat(k,1982) = 0._r8 + mat(k,1983) = 0._r8 + mat(k,1984) = 0._r8 mat(k,1985) = 0._r8 - mat(k,1986) = 0._r8 - mat(k,1990) = 0._r8 - mat(k,1992) = 0._r8 - mat(k,1998) = 0._r8 - mat(k,2005) = 0._r8 - mat(k,2010) = 0._r8 - mat(k,2012) = 0._r8 - mat(k,2014) = 0._r8 - mat(k,2015) = 0._r8 - mat(k,2016) = 0._r8 - mat(k,2017) = 0._r8 - mat(k,2022) = 0._r8 - mat(k,2041) = 0._r8 - mat(k,2042) = 0._r8 - mat(k,2043) = 0._r8 - mat(k,2055) = 0._r8 + mat(k,2031) = 0._r8 + mat(k,2067) = 0._r8 mat(k,2072) = 0._r8 + mat(k,2074) = 0._r8 mat(k,2077) = 0._r8 - mat(k,2078) = 0._r8 - mat(k,2079) = 0._r8 - mat(k,2080) = 0._r8 mat(k,2081) = 0._r8 + mat(k,2083) = 0._r8 + mat(k,2084) = 0._r8 + mat(k,2086) = 0._r8 + mat(k,2087) = 0._r8 + mat(k,2088) = 0._r8 + mat(k,2090) = 0._r8 mat(k,2091) = 0._r8 - mat(k,2096) = 0._r8 - mat(k,2105) = 0._r8 - mat(k,2112) = 0._r8 - mat(k,2132) = 0._r8 + mat(k,2092) = 0._r8 + mat(k,2093) = 0._r8 + mat(k,2094) = 0._r8 + mat(k,2097) = 0._r8 + mat(k,2098) = 0._r8 + mat(k,2100) = 0._r8 + mat(k,2133) = 0._r8 mat(k,2134) = 0._r8 - mat(k,2137) = 0._r8 - mat(k,2138) = 0._r8 - mat(k,2139) = 0._r8 - mat(k,2144) = 0._r8 - mat(k,2149) = 0._r8 - mat(k,2151) = 0._r8 - mat(k,2152) = 0._r8 - mat(k,2153) = 0._r8 - mat(k,2154) = 0._r8 - mat(k,2155) = 0._r8 - mat(k,2156) = 0._r8 - mat(k,2157) = 0._r8 - mat(k,2160) = 0._r8 - mat(k,2162) = 0._r8 - mat(k,2163) = 0._r8 - mat(k,2165) = 0._r8 - mat(k,2166) = 0._r8 - mat(k,2167) = 0._r8 - mat(k,2168) = 0._r8 + mat(k,2135) = 0._r8 + mat(k,2161) = 0._r8 mat(k,2169) = 0._r8 + mat(k,2170) = 0._r8 + mat(k,2172) = 0._r8 + mat(k,2175) = 0._r8 + mat(k,2177) = 0._r8 + mat(k,2181) = 0._r8 + mat(k,2186) = 0._r8 + mat(k,2196) = 0._r8 + mat(k,2201) = 0._r8 + mat(k,2206) = 0._r8 + mat(k,2218) = 0._r8 + mat(k,2246) = 0._r8 + mat(k,2248) = 0._r8 + mat(k,2249) = 0._r8 + mat(k,2251) = 0._r8 + mat(k,2253) = 0._r8 + mat(k,2255) = 0._r8 + mat(k,2258) = 0._r8 + mat(k,2259) = 0._r8 + mat(k,2261) = 0._r8 + mat(k,2262) = 0._r8 + mat(k,2269) = 0._r8 + mat(k,2270) = 0._r8 + mat(k,2271) = 0._r8 + mat(k,2272) = 0._r8 + mat(k,2275) = 0._r8 + mat(k,2276) = 0._r8 + mat(k,2278) = 0._r8 + mat(k,2279) = 0._r8 + mat(k,2286) = 0._r8 + mat(k,2296) = 0._r8 + mat(k,2302) = 0._r8 + mat(k,2304) = 0._r8 + mat(k,2308) = 0._r8 + mat(k,2316) = 0._r8 + mat(k,2321) = 0._r8 + mat(k,2325) = 0._r8 + mat(k,2326) = 0._r8 + mat(k,2330) = 0._r8 + mat(k,2333) = 0._r8 + mat(k,2335) = 0._r8 + mat(k,2339) = 0._r8 + mat(k,2340) = 0._r8 + mat(k,2341) = 0._r8 + mat(k,2342) = 0._r8 + mat(k,2344) = 0._r8 + mat(k,2348) = 0._r8 + mat(k,2351) = 0._r8 + mat(k,2352) = 0._r8 + mat(k,2355) = 0._r8 + mat(k,2371) = 0._r8 + mat(k,2377) = 0._r8 + mat(k,2378) = 0._r8 + mat(k,2379) = 0._r8 + mat(k,2382) = 0._r8 + mat(k,2387) = 0._r8 + mat(k,2388) = 0._r8 + mat(k,2389) = 0._r8 + mat(k,2391) = 0._r8 + mat(k,2394) = 0._r8 + mat(k,2395) = 0._r8 + mat(k,2396) = 0._r8 + mat(k,2398) = 0._r8 + mat(k,2411) = 0._r8 + mat(k,2420) = 0._r8 + mat(k,2425) = 0._r8 + mat(k,2427) = 0._r8 + mat(k,2428) = 0._r8 + mat(k,2429) = 0._r8 + mat(k,2430) = 0._r8 + mat(k,2431) = 0._r8 + mat(k,2432) = 0._r8 + mat(k,2435) = 0._r8 + mat(k,2436) = 0._r8 + mat(k,2437) = 0._r8 + mat(k,2438) = 0._r8 + mat(k,2439) = 0._r8 + mat(k,2441) = 0._r8 + mat(k,2442) = 0._r8 + mat(k,2443) = 0._r8 + mat(k,2445) = 0._r8 + mat(k,2446) = 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) @@ -3314,174 +3725,210 @@ subroutine nlnmat_finit( avec_len, mat, lmat, dti ) mat(k, 31) = mat(k, 31) - dti(k) mat(k, 32) = mat(k, 32) - dti(k) mat(k, 33) = mat(k, 33) - 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, 37) = mat(k, 37) - dti(k) + mat(k, 38) = mat(k, 38) - dti(k) mat(k, 39) = mat(k, 39) - dti(k) - mat(k, 45) = mat(k, 45) - dti(k) - mat(k, 46) = mat(k, 46) - dti(k) - mat(k, 49) = mat(k, 49) - dti(k) - mat(k, 52) = mat(k, 52) - dti(k) - mat(k, 55) = mat(k, 55) - dti(k) - mat(k, 59) = mat(k, 59) - dti(k) - mat(k, 62) = mat(k, 62) - dti(k) - mat(k, 65) = mat(k, 65) - dti(k) - mat(k, 68) = mat(k, 68) - dti(k) - mat(k, 71) = mat(k, 71) - dti(k) + mat(k, 40) = mat(k, 40) - dti(k) + mat(k, 41) = mat(k, 41) - dti(k) + mat(k, 42) = mat(k, 42) - dti(k) + mat(k, 48) = mat(k, 48) - dti(k) + mat(k, 54) = mat(k, 54) - dti(k) + mat(k, 60) = mat(k, 60) - dti(k) + mat(k, 66) = mat(k, 66) - dti(k) + mat(k, 72) = mat(k, 72) - dti(k) mat(k, 74) = mat(k, 74) - dti(k) - mat(k, 77) = mat(k, 77) - dti(k) - mat(k, 79) = mat(k, 79) - dti(k) + mat(k, 80) = mat(k, 80) - dti(k) mat(k, 86) = mat(k, 86) - dti(k) mat(k, 92) = mat(k, 92) - dti(k) + mat(k, 93) = mat(k, 93) - dti(k) mat(k, 96) = mat(k, 96) - dti(k) - mat(k, 101) = mat(k, 101) - dti(k) + mat(k, 99) = mat(k, 99) - dti(k) + mat(k, 102) = mat(k, 102) - dti(k) mat(k, 105) = mat(k, 105) - dti(k) - mat(k, 114) = mat(k, 114) - dti(k) + mat(k, 109) = mat(k, 109) - dti(k) + mat(k, 113) = mat(k, 113) - dti(k) + mat(k, 117) = mat(k, 117) - dti(k) mat(k, 121) = mat(k, 121) - dti(k) - mat(k, 126) = mat(k, 126) - dti(k) - mat(k, 130) = mat(k, 130) - dti(k) - mat(k, 139) = mat(k, 139) - dti(k) + mat(k, 125) = mat(k, 125) - dti(k) + mat(k, 128) = mat(k, 128) - dti(k) + mat(k, 131) = mat(k, 131) - dti(k) + mat(k, 134) = mat(k, 134) - dti(k) + mat(k, 137) = mat(k, 137) - 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, 155) = mat(k, 155) - dti(k) - mat(k, 160) = mat(k, 160) - dti(k) - mat(k, 163) = mat(k, 163) - dti(k) - mat(k, 166) = mat(k, 166) - dti(k) - mat(k, 169) = mat(k, 169) - dti(k) + mat(k, 158) = mat(k, 158) - dti(k) + mat(k, 164) = mat(k, 164) - dti(k) + mat(k, 168) = mat(k, 168) - dti(k) mat(k, 173) = mat(k, 173) - dti(k) - mat(k, 177) = mat(k, 177) - dti(k) - mat(k, 181) = mat(k, 181) - dti(k) + mat(k, 175) = mat(k, 175) - dti(k) + mat(k, 178) = mat(k, 178) - dti(k) + mat(k, 180) = mat(k, 180) - dti(k) mat(k, 185) = mat(k, 185) - dti(k) - mat(k, 191) = mat(k, 191) - dti(k) + mat(k, 192) = mat(k, 192) - dti(k) mat(k, 197) = mat(k, 197) - dti(k) - mat(k, 200) = mat(k, 200) - dti(k) + mat(k, 201) = mat(k, 201) - dti(k) mat(k, 206) = mat(k, 206) - dti(k) - mat(k, 212) = mat(k, 212) - dti(k) - mat(k, 215) = mat(k, 215) - dti(k) - mat(k, 220) = mat(k, 220) - dti(k) - mat(k, 225) = mat(k, 225) - dti(k) - mat(k, 230) = mat(k, 230) - dti(k) - mat(k, 235) = mat(k, 235) - dti(k) - mat(k, 241) = mat(k, 241) - dti(k) - mat(k, 246) = mat(k, 246) - dti(k) - mat(k, 251) = mat(k, 251) - dti(k) + mat(k, 214) = mat(k, 214) - dti(k) + mat(k, 219) = mat(k, 219) - dti(k) + mat(k, 224) = mat(k, 224) - dti(k) + mat(k, 228) = mat(k, 228) - dti(k) + mat(k, 233) = mat(k, 233) - dti(k) + mat(k, 236) = mat(k, 236) - dti(k) + mat(k, 239) = mat(k, 239) - dti(k) + mat(k, 242) = mat(k, 242) - dti(k) + mat(k, 245) = mat(k, 245) - dti(k) + mat(k, 249) = mat(k, 249) - dti(k) + mat(k, 254) = mat(k, 254) - dti(k) mat(k, 259) = mat(k, 259) - dti(k) + mat(k, 263) = mat(k, 263) - dti(k) mat(k, 267) = mat(k, 267) - dti(k) - mat(k, 273) = mat(k, 273) - dti(k) - mat(k, 279) = mat(k, 279) - dti(k) - mat(k, 285) = mat(k, 285) - dti(k) - mat(k, 291) = mat(k, 291) - dti(k) - mat(k, 297) = mat(k, 297) - dti(k) - mat(k, 303) = mat(k, 303) - dti(k) - mat(k, 309) = mat(k, 309) - dti(k) - mat(k, 315) = mat(k, 315) - dti(k) - mat(k, 323) = mat(k, 323) - dti(k) - mat(k, 329) = mat(k, 329) - dti(k) - mat(k, 336) = mat(k, 336) - dti(k) - mat(k, 342) = mat(k, 342) - dti(k) - mat(k, 345) = mat(k, 345) - dti(k) - mat(k, 350) = mat(k, 350) - dti(k) - mat(k, 357) = mat(k, 357) - dti(k) + mat(k, 272) = mat(k, 272) - dti(k) + mat(k, 278) = mat(k, 278) - dti(k) + mat(k, 284) = mat(k, 284) - dti(k) + mat(k, 287) = mat(k, 287) - dti(k) + mat(k, 290) = mat(k, 290) - dti(k) + mat(k, 296) = mat(k, 296) - dti(k) + mat(k, 302) = mat(k, 302) - dti(k) + mat(k, 308) = mat(k, 308) - dti(k) + mat(k, 314) = mat(k, 314) - dti(k) + mat(k, 319) = mat(k, 319) - dti(k) + mat(k, 324) = mat(k, 324) - dti(k) + mat(k, 327) = mat(k, 327) - dti(k) + mat(k, 332) = mat(k, 332) - dti(k) + mat(k, 337) = mat(k, 337) - dti(k) + mat(k, 343) = mat(k, 343) - dti(k) + mat(k, 348) = mat(k, 348) - dti(k) + mat(k, 353) = mat(k, 353) - dti(k) mat(k, 361) = mat(k, 361) - dti(k) - mat(k, 368) = mat(k, 368) - dti(k) + mat(k, 369) = mat(k, 369) - dti(k) mat(k, 377) = mat(k, 377) - dti(k) - mat(k, 384) = mat(k, 384) - dti(k) - mat(k, 392) = mat(k, 392) - dti(k) - mat(k, 400) = mat(k, 400) - dti(k) - mat(k, 406) = mat(k, 406) - dti(k) - mat(k, 412) = mat(k, 412) - dti(k) - mat(k, 417) = mat(k, 417) - dti(k) - mat(k, 422) = mat(k, 422) - dti(k) - mat(k, 430) = mat(k, 430) - dti(k) - mat(k, 438) = mat(k, 438) - dti(k) - mat(k, 446) = mat(k, 446) - dti(k) - mat(k, 450) = mat(k, 450) - dti(k) + mat(k, 383) = mat(k, 383) - dti(k) + mat(k, 389) = mat(k, 389) - dti(k) + mat(k, 395) = mat(k, 395) - dti(k) + mat(k, 401) = mat(k, 401) - dti(k) + mat(k, 407) = mat(k, 407) - dti(k) + mat(k, 413) = mat(k, 413) - dti(k) + mat(k, 419) = mat(k, 419) - dti(k) + mat(k, 425) = mat(k, 425) - dti(k) + mat(k, 433) = mat(k, 433) - dti(k) + mat(k, 439) = mat(k, 439) - dti(k) + mat(k, 445) = mat(k, 445) - dti(k) + mat(k, 452) = mat(k, 452) - dti(k) mat(k, 458) = mat(k, 458) - dti(k) + mat(k, 461) = mat(k, 461) - dti(k) mat(k, 466) = mat(k, 466) - dti(k) - mat(k, 474) = mat(k, 474) - dti(k) - mat(k, 481) = mat(k, 481) - dti(k) - mat(k, 492) = mat(k, 492) - dti(k) - mat(k, 501) = mat(k, 501) - dti(k) - mat(k, 505) = mat(k, 505) - dti(k) - mat(k, 514) = mat(k, 514) - dti(k) + mat(k, 470) = mat(k, 470) - dti(k) + mat(k, 477) = mat(k, 477) - dti(k) + mat(k, 486) = mat(k, 486) - dti(k) + mat(k, 493) = mat(k, 493) - dti(k) + mat(k, 500) = mat(k, 500) - dti(k) + mat(k, 508) = mat(k, 508) - dti(k) + mat(k, 515) = mat(k, 515) - dti(k) mat(k, 521) = mat(k, 521) - dti(k) - mat(k, 529) = mat(k, 529) - dti(k) - mat(k, 536) = mat(k, 536) - dti(k) - mat(k, 547) = mat(k, 547) - dti(k) - mat(k, 558) = mat(k, 558) - dti(k) - mat(k, 567) = mat(k, 567) - dti(k) - mat(k, 578) = mat(k, 578) - dti(k) + mat(k, 527) = mat(k, 527) - dti(k) + mat(k, 532) = mat(k, 532) - dti(k) + mat(k, 540) = mat(k, 540) - dti(k) + mat(k, 548) = mat(k, 548) - dti(k) + mat(k, 556) = mat(k, 556) - dti(k) + mat(k, 564) = mat(k, 564) - dti(k) + mat(k, 572) = mat(k, 572) - dti(k) + mat(k, 580) = mat(k, 580) - dti(k) mat(k, 589) = mat(k, 589) - dti(k) - mat(k, 600) = mat(k, 600) - dti(k) - mat(k, 607) = mat(k, 607) - dti(k) + mat(k, 598) = mat(k, 598) - dti(k) + mat(k, 602) = mat(k, 602) - dti(k) + mat(k, 611) = mat(k, 611) - dti(k) mat(k, 618) = mat(k, 618) - dti(k) - mat(k, 634) = mat(k, 634) - dti(k) - mat(k, 645) = mat(k, 645) - dti(k) - mat(k, 654) = mat(k, 654) - dti(k) - mat(k, 664) = mat(k, 664) - dti(k) - mat(k, 673) = mat(k, 673) - dti(k) - mat(k, 681) = mat(k, 681) - dti(k) - mat(k, 690) = mat(k, 690) - dti(k) - mat(k, 701) = mat(k, 701) - dti(k) + mat(k, 625) = mat(k, 625) - dti(k) + mat(k, 633) = mat(k, 633) - dti(k) + mat(k, 640) = mat(k, 640) - dti(k) + mat(k, 650) = mat(k, 650) - dti(k) + mat(k, 663) = mat(k, 663) - dti(k) + mat(k, 674) = mat(k, 674) - dti(k) + mat(k, 685) = mat(k, 685) - dti(k) + mat(k, 696) = mat(k, 696) - dti(k) + mat(k, 703) = mat(k, 703) - dti(k) mat(k, 708) = mat(k, 708) - dti(k) - mat(k, 712) = mat(k, 712) - dti(k) - mat(k, 717) = mat(k, 717) - dti(k) - mat(k, 728) = mat(k, 728) - dti(k) - mat(k, 744) = mat(k, 744) - dti(k) - mat(k, 753) = mat(k, 753) - dti(k) - mat(k, 762) = mat(k, 762) - dti(k) - mat(k, 769) = mat(k, 769) - dti(k) - mat(k, 781) = mat(k, 781) - dti(k) - mat(k, 798) = mat(k, 798) - dti(k) + mat(k, 719) = mat(k, 719) - dti(k) + mat(k, 731) = mat(k, 731) - dti(k) + mat(k, 738) = mat(k, 738) - dti(k) + mat(k, 749) = mat(k, 749) - dti(k) + mat(k, 765) = mat(k, 765) - dti(k) + mat(k, 776) = mat(k, 776) - dti(k) + mat(k, 785) = mat(k, 785) - dti(k) + mat(k, 795) = mat(k, 795) - dti(k) mat(k, 803) = mat(k, 803) - dti(k) - mat(k, 820) = mat(k, 820) - dti(k) - mat(k, 840) = mat(k, 840) - dti(k) - mat(k, 858) = mat(k, 858) - dti(k) + mat(k, 811) = mat(k, 811) - dti(k) + mat(k, 816) = mat(k, 816) - dti(k) + mat(k, 826) = mat(k, 826) - dti(k) + mat(k, 835) = mat(k, 835) - dti(k) + mat(k, 843) = mat(k, 843) - dti(k) + mat(k, 851) = mat(k, 851) - dti(k) + mat(k, 863) = mat(k, 863) - dti(k) + mat(k, 871) = mat(k, 871) - dti(k) mat(k, 880) = mat(k, 880) - dti(k) - mat(k, 892) = mat(k, 892) - dti(k) - mat(k, 898) = mat(k, 898) - dti(k) - mat(k, 906) = mat(k, 906) - dti(k) - mat(k, 916) = mat(k, 916) - dti(k) - mat(k, 928) = mat(k, 928) - dti(k) - mat(k, 943) = mat(k, 943) - dti(k) - mat(k, 960) = mat(k, 960) - dti(k) - mat(k, 968) = mat(k, 968) - dti(k) - mat(k, 982) = mat(k, 982) - dti(k) - mat(k, 991) = mat(k, 991) - dti(k) - mat(k, 997) = mat(k, 997) - dti(k) - mat(k,1008) = mat(k,1008) - dti(k) - mat(k,1030) = mat(k,1030) - dti(k) - mat(k,1049) = mat(k,1049) - dti(k) - mat(k,1065) = mat(k,1065) - dti(k) - mat(k,1076) = mat(k,1076) - dti(k) - mat(k,1091) = mat(k,1091) - dti(k) - mat(k,1104) = mat(k,1104) - dti(k) - mat(k,1124) = mat(k,1124) - dti(k) - mat(k,1140) = mat(k,1140) - dti(k) - mat(k,1152) = mat(k,1152) - dti(k) - mat(k,1172) = mat(k,1172) - dti(k) + mat(k, 899) = mat(k, 899) - dti(k) + mat(k, 908) = mat(k, 908) - dti(k) + mat(k, 913) = mat(k, 913) - dti(k) + mat(k, 923) = mat(k, 923) - dti(k) + mat(k, 933) = mat(k, 933) - dti(k) + mat(k, 945) = mat(k, 945) - dti(k) + mat(k, 953) = mat(k, 953) - dti(k) + mat(k, 969) = mat(k, 969) - dti(k) + mat(k, 988) = mat(k, 988) - dti(k) + mat(k,1016) = mat(k,1016) - dti(k) + mat(k,1040) = mat(k,1040) - dti(k) + mat(k,1052) = mat(k,1052) - dti(k) + mat(k,1060) = mat(k,1060) - dti(k) + mat(k,1070) = mat(k,1070) - dti(k) + mat(k,1078) = mat(k,1078) - dti(k) + mat(k,1088) = mat(k,1088) - dti(k) + mat(k,1101) = mat(k,1101) - dti(k) + mat(k,1115) = mat(k,1115) - dti(k) + mat(k,1131) = mat(k,1131) - dti(k) + mat(k,1149) = mat(k,1149) - dti(k) + mat(k,1158) = mat(k,1158) - dti(k) + mat(k,1164) = mat(k,1164) - dti(k) + mat(k,1176) = mat(k,1176) - dti(k) + mat(k,1193) = mat(k,1193) - dti(k) mat(k,1206) = mat(k,1206) - dti(k) + mat(k,1215) = mat(k,1215) - dti(k) mat(k,1231) = mat(k,1231) - dti(k) mat(k,1251) = mat(k,1251) - dti(k) - mat(k,1271) = mat(k,1271) - dti(k) - mat(k,1302) = mat(k,1302) - dti(k) - mat(k,1318) = mat(k,1318) - dti(k) - mat(k,1337) = mat(k,1337) - dti(k) - mat(k,1352) = mat(k,1352) - dti(k) - mat(k,1396) = mat(k,1396) - dti(k) - mat(k,1427) = mat(k,1427) - dti(k) - mat(k,1507) = mat(k,1507) - dti(k) - mat(k,1543) = mat(k,1543) - dti(k) - mat(k,1570) = mat(k,1570) - dti(k) - mat(k,1719) = mat(k,1719) - dti(k) - mat(k,1782) = mat(k,1782) - dti(k) - mat(k,1824) = mat(k,1824) - dti(k) - mat(k,1849) = mat(k,1849) - dti(k) - mat(k,1907) = mat(k,1907) - dti(k) - mat(k,1928) = mat(k,1928) - dti(k) - mat(k,1951) = mat(k,1951) - dti(k) - mat(k,1994) = mat(k,1994) - dti(k) - mat(k,2019) = mat(k,2019) - dti(k) - mat(k,2115) = mat(k,2115) - dti(k) - mat(k,2143) = mat(k,2143) - dti(k) - mat(k,2170) = mat(k,2170) - dti(k) + mat(k,1267) = mat(k,1267) - dti(k) + mat(k,1279) = mat(k,1279) - dti(k) + mat(k,1297) = mat(k,1297) - dti(k) + mat(k,1330) = mat(k,1330) - dti(k) + mat(k,1354) = mat(k,1354) - dti(k) + mat(k,1374) = mat(k,1374) - dti(k) + mat(k,1395) = mat(k,1395) - dti(k) + mat(k,1426) = mat(k,1426) - dti(k) + mat(k,1448) = mat(k,1448) - dti(k) + mat(k,1459) = mat(k,1459) - dti(k) + mat(k,1474) = mat(k,1474) - dti(k) + mat(k,1493) = mat(k,1493) - dti(k) + mat(k,1509) = mat(k,1509) - dti(k) + mat(k,1540) = mat(k,1540) - dti(k) + mat(k,1563) = mat(k,1563) - dti(k) + mat(k,1590) = mat(k,1590) - dti(k) + mat(k,1633) = mat(k,1633) - dti(k) + mat(k,1799) = mat(k,1799) - dti(k) + mat(k,1845) = mat(k,1845) - dti(k) + mat(k,1906) = mat(k,1906) - dti(k) + mat(k,1953) = mat(k,1953) - dti(k) + mat(k,1977) = mat(k,1977) - dti(k) + mat(k,2073) = mat(k,2073) - dti(k) + mat(k,2095) = mat(k,2095) - dti(k) + mat(k,2204) = mat(k,2204) - dti(k) + mat(k,2257) = mat(k,2257) - dti(k) + mat(k,2283) = mat(k,2283) - dti(k) + mat(k,2327) = mat(k,2327) - dti(k) + mat(k,2354) = mat(k,2354) - dti(k) + mat(k,2419) = mat(k,2419) - dti(k) + mat(k,2447) = mat(k,2447) - dti(k) end do end subroutine nlnmat_finit subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) @@ -3506,6 +3953,7 @@ subroutine nlnmat( avec_len, mat, y, rxt, lmat, dti ) call nlnmat08( avec_len, mat, y, rxt ) call nlnmat09( avec_len, mat, y, rxt ) call nlnmat10( avec_len, mat, y, rxt ) + call nlnmat11( 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_waccm_tsmlt_mam4/mo_prod_loss.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 index 6928f34c6f..9d08dfbbbc 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_prod_loss.F90 @@ -27,79 +27,10 @@ subroutine exp_prod_loss( ofl, ofu, prod, loss, y, & ! ... loss and production for Explicit method !-------------------------------------------------------------------- do k = ofl,ofu - loss(k,1) = ( + het_rates(k,3))* y(k,3) + loss(k,1) = ( + het_rates(k,187))* y(k,187) prod(k,1) = 0._r8 - loss(k,2) = ( + het_rates(k,21))* y(k,21) + loss(k,2) = ( + het_rates(k,188))* y(k,188) prod(k,2) = 0._r8 - loss(k,3) = (rxt(k,239)* y(k,217) + rxt(k,79) + het_rates(k,33))* y(k,33) - prod(k,3) = 0._r8 - loss(k,4) = (rxt(k,240)* y(k,217) + rxt(k,80) + het_rates(k,34))* y(k,34) - prod(k,4) = 0._r8 - loss(k,5) = (rxt(k,266)* y(k,217) + rxt(k,81) + het_rates(k,35))* y(k,35) - prod(k,5) = 0._r8 - loss(k,6) = (rxt(k,241)* y(k,217) + rxt(k,82) + het_rates(k,36))* y(k,36) - prod(k,6) = 0._r8 - loss(k,7) = (rxt(k,242)* y(k,217) + rxt(k,83) + het_rates(k,37))* y(k,37) - prod(k,7) = 0._r8 - loss(k,8) = (rxt(k,243)* y(k,217) + rxt(k,84) + het_rates(k,38))* y(k,38) - prod(k,8) = 0._r8 - loss(k,9) = (rxt(k,244)* y(k,217) + rxt(k,85) + het_rates(k,39))* y(k,39) - prod(k,9) = 0._r8 - loss(k,10) = (rxt(k,245)* y(k,217) + rxt(k,86) + het_rates(k,40))* y(k,40) - prod(k,10) = 0._r8 - loss(k,11) = (rxt(k,277)* y(k,56) +rxt(k,289)* y(k,217) +rxt(k,278)* y(k,221) & - + rxt(k,87) + het_rates(k,41))* y(k,41) - prod(k,11) = 0._r8 - loss(k,12) = (rxt(k,279)* y(k,56) +rxt(k,290)* y(k,217) +rxt(k,280)* y(k,221) & - + rxt(k,88) + het_rates(k,43))* y(k,43) - prod(k,12) = 0._r8 - loss(k,13) = (rxt(k,281)* y(k,221) + rxt(k,89) + het_rates(k,44))* y(k,44) - prod(k,13) = 0._r8 - loss(k,14) = (rxt(k,282)* y(k,56) +rxt(k,283)* y(k,221) + rxt(k,90) & - + het_rates(k,46))* y(k,46) - prod(k,14) = 0._r8 - loss(k,15) = (rxt(k,215)* y(k,56) +rxt(k,271)* y(k,73) + (rxt(k,311) + & - rxt(k,312) +rxt(k,313))* y(k,217) +rxt(k,304)* y(k,221) + rxt(k,40) & - + rxt(k,41) + het_rates(k,54))* y(k,54) - prod(k,15) = 0._r8 - loss(k,16) = (rxt(k,284)* y(k,56) +rxt(k,267)* y(k,217) +rxt(k,285)* y(k,221) & - + rxt(k,91) + het_rates(k,55))* y(k,55) - prod(k,16) = 0._r8 - loss(k,17) = ( + het_rates(k,61))* y(k,61) - prod(k,17) = 0._r8 - loss(k,18) = (rxt(k,577)* y(k,222) + rxt(k,42) + rxt(k,110) & - + het_rates(k,63))* y(k,63) - prod(k,18) =.440_r8*rxt(k,41)*y(k,54) - loss(k,19) = ( + rxt(k,580) + het_rates(k,71))* y(k,71) - prod(k,19) = 0._r8 - loss(k,20) = (rxt(k,268)* y(k,217) + rxt(k,99) + het_rates(k,78))* y(k,78) - prod(k,20) = 0._r8 - loss(k,21) = (rxt(k,291)* y(k,217) +rxt(k,286)* y(k,221) + rxt(k,101) & - + het_rates(k,82))* y(k,82) - prod(k,21) = 0._r8 - loss(k,22) = (rxt(k,292)* y(k,217) +rxt(k,287)* y(k,221) + rxt(k,102) & - + het_rates(k,83))* y(k,83) - prod(k,22) = 0._r8 - loss(k,23) = (rxt(k,293)* y(k,217) +rxt(k,288)* y(k,221) + rxt(k,103) & - + het_rates(k,84))* y(k,84) - prod(k,23) = 0._r8 - loss(k,24) = ((rxt(k,206) +rxt(k,207))* y(k,217) + rxt(k,12) & - + het_rates(k,113))* y(k,113) - prod(k,24) = 0._r8 - loss(k,25) = ( + rxt(k,582) + het_rates(k,122))* y(k,122) - prod(k,25) = 0._r8 - loss(k,26) = ( + rxt(k,581) + het_rates(k,123))* y(k,123) - prod(k,26) = 0._r8 - loss(k,27) = ( + rxt(k,109) + het_rates(k,150))* y(k,150) - prod(k,27) = 0._r8 - loss(k,28) = ( + rxt(k,583) + het_rates(k,172))* y(k,172) - prod(k,28) = 0._r8 - loss(k,29) = ( + het_rates(k,187))* y(k,187) - prod(k,29) = 0._r8 - loss(k,30) = ( + het_rates(k,188))* y(k,188) - prod(k,30) = 0._r8 - loss(k,31) = ( + het_rates(k,136))* y(k,136) - prod(k,31) = 0._r8 end do end subroutine exp_prod_loss subroutine imp_prod_loss( avec_len, prod, loss, y, & @@ -124,1131 +55,1279 @@ subroutine imp_prod_loss( avec_len, prod, loss, y, & ! ... loss and production for Implicit method !-------------------------------------------------------------------- do k = 1,avec_len - loss(k,123) = (rxt(k,396)* y(k,221) + rxt(k,20) + het_rates(k,1))* y(k,1) - prod(k,123) =rxt(k,399)*y(k,190)*y(k,124) - loss(k,124) = (rxt(k,400)* y(k,221) + rxt(k,21) + het_rates(k,2))* y(k,2) - prod(k,124) =rxt(k,397)*y(k,203)*y(k,190) - loss(k,1) = ( + het_rates(k,4))* y(k,4) + loss(k,153) = (rxt(k,396)* y(k,226) + rxt(k,20) + het_rates(k,1))* y(k,1) + prod(k,153) =rxt(k,399)*y(k,190)*y(k,124) + loss(k,157) = (rxt(k,400)* y(k,226) + rxt(k,21) + het_rates(k,2))* y(k,2) + prod(k,157) =rxt(k,397)*y(k,190)*y(k,90) + loss(k,1) = ( + het_rates(k,3))* y(k,3) prod(k,1) = 0._r8 - loss(k,2) = ( + het_rates(k,5))* y(k,5) + loss(k,2) = ( + het_rates(k,4))* y(k,4) prod(k,2) = 0._r8 - loss(k,153) = (rxt(k,479)* y(k,126) +rxt(k,480)* y(k,135) +rxt(k,481) & - * y(k,221) + het_rates(k,6))* y(k,6) - prod(k,153) = 0._r8 - loss(k,48) = (rxt(k,438)* y(k,221) + het_rates(k,7))* y(k,7) - prod(k,48) = 0._r8 - loss(k,84) = (rxt(k,441)* y(k,221) + rxt(k,22) + het_rates(k,8))* y(k,8) - prod(k,84) =rxt(k,439)*y(k,203)*y(k,191) - loss(k,49) = ( + rxt(k,23) + het_rates(k,9))* y(k,9) - prod(k,49) =.120_r8*rxt(k,438)*y(k,221)*y(k,7) - loss(k,85) = ( + rxt(k,24) + het_rates(k,10))* y(k,10) - prod(k,85) = (.100_r8*rxt(k,480)*y(k,6) +.100_r8*rxt(k,483)*y(k,110)) & + loss(k,3) = ( + het_rates(k,5))* y(k,5) + prod(k,3) = 0._r8 + loss(k,187) = (rxt(k,479)* y(k,126) +rxt(k,480)* y(k,135) +rxt(k,481) & + * y(k,226) + het_rates(k,6))* y(k,6) + prod(k,187) = 0._r8 + loss(k,69) = (rxt(k,438)* y(k,226) + het_rates(k,7))* y(k,7) + prod(k,69) = 0._r8 + loss(k,118) = (rxt(k,441)* y(k,226) + rxt(k,22) + het_rates(k,8))* y(k,8) + prod(k,118) =rxt(k,439)*y(k,192)*y(k,90) + loss(k,70) = ( + rxt(k,23) + het_rates(k,9))* y(k,9) + prod(k,70) =.120_r8*rxt(k,438)*y(k,226)*y(k,7) + loss(k,115) = ( + rxt(k,24) + het_rates(k,10))* y(k,10) + prod(k,115) = (.100_r8*rxt(k,480)*y(k,6) +.100_r8*rxt(k,483)*y(k,110)) & *y(k,135) - loss(k,95) = ( + rxt(k,25) + het_rates(k,11))* y(k,11) - prod(k,95) = (.500_r8*rxt(k,440)*y(k,191) +.200_r8*rxt(k,467)*y(k,228) + & - .060_r8*rxt(k,473)*y(k,230))*y(k,124) +.500_r8*rxt(k,22)*y(k,8) & + loss(k,127) = ( + rxt(k,25) + het_rates(k,11))* y(k,11) + prod(k,127) = (.500_r8*rxt(k,440)*y(k,192) +.200_r8*rxt(k,467)*y(k,233) + & + .060_r8*rxt(k,473)*y(k,236))*y(k,124) +.500_r8*rxt(k,22)*y(k,8) & +rxt(k,23)*y(k,9) +.200_r8*rxt(k,71)*y(k,180) +.060_r8*rxt(k,73) & *y(k,184) - loss(k,70) = ( + rxt(k,26) + het_rates(k,12))* y(k,12) - prod(k,70) = (.200_r8*rxt(k,467)*y(k,228) +.200_r8*rxt(k,473)*y(k,230)) & + loss(k,97) = ( + rxt(k,26) + het_rates(k,12))* y(k,12) + prod(k,97) = (.200_r8*rxt(k,467)*y(k,233) +.200_r8*rxt(k,473)*y(k,236)) & *y(k,124) +.200_r8*rxt(k,71)*y(k,180) +.200_r8*rxt(k,73)*y(k,184) - loss(k,118) = ( + rxt(k,27) + het_rates(k,13))* y(k,13) - prod(k,118) = (.200_r8*rxt(k,467)*y(k,228) +.150_r8*rxt(k,473)*y(k,230)) & - *y(k,124) +rxt(k,47)*y(k,94) +rxt(k,57)*y(k,116) +.200_r8*rxt(k,71) & + loss(k,147) = ( + rxt(k,27) + het_rates(k,13))* y(k,13) + prod(k,147) = (.200_r8*rxt(k,467)*y(k,233) +.150_r8*rxt(k,473)*y(k,236)) & + *y(k,124) +rxt(k,47)*y(k,95) +rxt(k,57)*y(k,116) +.200_r8*rxt(k,71) & *y(k,180) +.150_r8*rxt(k,73)*y(k,184) - loss(k,76) = ( + rxt(k,28) + het_rates(k,14))* y(k,14) - prod(k,76) =.210_r8*rxt(k,473)*y(k,230)*y(k,124) +.210_r8*rxt(k,73)*y(k,184) - loss(k,62) = (rxt(k,401)* y(k,221) + het_rates(k,15))* y(k,15) - prod(k,62) = (.050_r8*rxt(k,480)*y(k,6) +.050_r8*rxt(k,483)*y(k,110)) & + loss(k,106) = ( + rxt(k,28) + het_rates(k,14))* y(k,14) + prod(k,106) =.210_r8*rxt(k,473)*y(k,236)*y(k,124) +.210_r8*rxt(k,73)*y(k,184) + loss(k,85) = (rxt(k,401)* y(k,226) + het_rates(k,15))* y(k,15) + prod(k,85) = (.050_r8*rxt(k,480)*y(k,6) +.050_r8*rxt(k,483)*y(k,110)) & *y(k,135) - loss(k,82) = (rxt(k,367)* y(k,126) +rxt(k,368)* y(k,221) + het_rates(k,16)) & + loss(k,111) = (rxt(k,367)* y(k,126) +rxt(k,368)* y(k,226) + het_rates(k,16)) & * y(k,16) - prod(k,82) = 0._r8 - loss(k,184) = (rxt(k,250)* y(k,42) +rxt(k,252)* y(k,135) +rxt(k,251) & - * y(k,203) + het_rates(k,17))* y(k,17) - prod(k,184) = (rxt(k,76) +2.000_r8*rxt(k,253)*y(k,19) +rxt(k,254)*y(k,59) + & + prod(k,111) = 0._r8 + loss(k,219) = (rxt(k,250)* y(k,42) +rxt(k,251)* y(k,90) +rxt(k,252)* y(k,135) & + + het_rates(k,17))* y(k,17) + prod(k,219) = (rxt(k,76) +2.000_r8*rxt(k,253)*y(k,19) +rxt(k,254)*y(k,59) + & rxt(k,255)*y(k,59) +rxt(k,258)*y(k,124) +rxt(k,261)*y(k,133) + & - rxt(k,262)*y(k,221) +rxt(k,508)*y(k,151))*y(k,19) & + rxt(k,262)*y(k,226) +rxt(k,509)*y(k,151))*y(k,19) & + (rxt(k,240)*y(k,34) +rxt(k,266)*y(k,35) + & 3.000_r8*rxt(k,267)*y(k,55) +2.000_r8*rxt(k,268)*y(k,78) + & - 2.000_r8*rxt(k,289)*y(k,41) +rxt(k,290)*y(k,43) +rxt(k,269)*y(k,81)) & - *y(k,217) + (2.000_r8*rxt(k,278)*y(k,41) +rxt(k,280)*y(k,43) + & - 3.000_r8*rxt(k,285)*y(k,55) +rxt(k,264)*y(k,81))*y(k,221) & + rxt(k,269)*y(k,81) +2.000_r8*rxt(k,289)*y(k,41) +rxt(k,290)*y(k,43)) & + *y(k,222) + (rxt(k,264)*y(k,81) +2.000_r8*rxt(k,278)*y(k,41) + & + rxt(k,280)*y(k,43) +3.000_r8*rxt(k,285)*y(k,55))*y(k,226) & + (2.000_r8*rxt(k,277)*y(k,41) +rxt(k,279)*y(k,43) + & 3.000_r8*rxt(k,284)*y(k,55))*y(k,56) + (rxt(k,100) + & rxt(k,263)*y(k,133))*y(k,81) +rxt(k,75)*y(k,18) +rxt(k,78)*y(k,20) & - +rxt(k,106)*y(k,91) - loss(k,63) = ( + rxt(k,75) + het_rates(k,18))* y(k,18) - prod(k,63) = (rxt(k,556)*y(k,91) +rxt(k,561)*y(k,91))*y(k,85) & + +rxt(k,80)*y(k,34) +rxt(k,81)*y(k,35) +2.000_r8*rxt(k,87)*y(k,41) & + +rxt(k,88)*y(k,43) +3.000_r8*rxt(k,91)*y(k,55) +2.000_r8*rxt(k,99) & + *y(k,78) +rxt(k,106)*y(k,92) + loss(k,86) = ( + rxt(k,75) + het_rates(k,18))* y(k,18) + prod(k,86) = (rxt(k,570)*y(k,92) +rxt(k,575)*y(k,92))*y(k,85) & +rxt(k,256)*y(k,59)*y(k,19) - loss(k,198) = (2._r8*rxt(k,253)* y(k,19) + (rxt(k,254) +rxt(k,255) + & - rxt(k,256))* y(k,59) +rxt(k,258)* y(k,124) +rxt(k,259)* y(k,125) & - +rxt(k,261)* y(k,133) +rxt(k,508)* y(k,151) +rxt(k,257)* y(k,203) & - +rxt(k,262)* y(k,221) + rxt(k,76) + het_rates(k,19))* y(k,19) - prod(k,198) = (rxt(k,77) +rxt(k,260)*y(k,133))*y(k,20) +rxt(k,252)*y(k,135) & - *y(k,17) +rxt(k,270)*y(k,217)*y(k,81) +rxt(k,265)*y(k,133)*y(k,91) - loss(k,110) = (rxt(k,260)* y(k,133) + rxt(k,77) + rxt(k,78) + rxt(k,550) & - + rxt(k,553) + rxt(k,558) + het_rates(k,20))* y(k,20) - prod(k,110) =rxt(k,259)*y(k,125)*y(k,19) - loss(k,64) = (rxt(k,442)* y(k,221) + het_rates(k,22))* y(k,22) - prod(k,64) =rxt(k,29)*y(k,23) +rxt(k,445)*y(k,192)*y(k,124) - loss(k,79) = (rxt(k,444)* y(k,221) + rxt(k,29) + het_rates(k,23))* y(k,23) - prod(k,79) =rxt(k,443)*y(k,203)*y(k,192) - loss(k,71) = (rxt(k,316)* y(k,56) +rxt(k,317)* y(k,221) + het_rates(k,24)) & + loss(k,221) = (2._r8*rxt(k,253)* y(k,19) + (rxt(k,254) +rxt(k,255) + & + rxt(k,256))* y(k,59) +rxt(k,257)* y(k,90) +rxt(k,258)* y(k,124) & + +rxt(k,259)* y(k,125) +rxt(k,261)* y(k,133) +rxt(k,509)* y(k,151) & + +rxt(k,262)* y(k,226) + rxt(k,76) + het_rates(k,19))* y(k,19) + prod(k,221) = (rxt(k,77) +rxt(k,260)*y(k,133))*y(k,20) +rxt(k,252)*y(k,135) & + *y(k,17) +rxt(k,270)*y(k,222)*y(k,81) +rxt(k,265)*y(k,133)*y(k,92) + loss(k,143) = (rxt(k,260)* y(k,133) + rxt(k,77) + rxt(k,78) + rxt(k,564) & + + rxt(k,567) + rxt(k,572) + het_rates(k,20))* y(k,20) + prod(k,143) =rxt(k,259)*y(k,125)*y(k,19) + loss(k,4) = ( + het_rates(k,21))* y(k,21) + prod(k,4) = 0._r8 + loss(k,89) = (rxt(k,442)* y(k,226) + het_rates(k,22))* y(k,22) + prod(k,89) =rxt(k,29)*y(k,23) +rxt(k,445)*y(k,194)*y(k,124) + loss(k,109) = (rxt(k,444)* y(k,226) + rxt(k,29) + het_rates(k,23))* y(k,23) + prod(k,109) =rxt(k,443)*y(k,194)*y(k,90) + loss(k,99) = (rxt(k,315)* y(k,56) +rxt(k,316)* y(k,226) + het_rates(k,24)) & * y(k,24) - prod(k,71) = 0._r8 - loss(k,112) = (rxt(k,318)* y(k,56) +rxt(k,319)* y(k,135) +rxt(k,344) & - * y(k,221) + het_rates(k,25))* y(k,25) - prod(k,112) = 0._r8 - loss(k,66) = (rxt(k,324)* y(k,221) + het_rates(k,26))* y(k,26) - prod(k,66) = (.400_r8*rxt(k,320)*y(k,193) +.200_r8*rxt(k,321)*y(k,197)) & - *y(k,193) - loss(k,80) = (rxt(k,325)* y(k,221) + rxt(k,30) + het_rates(k,27))* y(k,27) - prod(k,80) =rxt(k,322)*y(k,203)*y(k,193) - loss(k,72) = (rxt(k,326)* y(k,56) +rxt(k,327)* y(k,221) + het_rates(k,28)) & + prod(k,99) = 0._r8 + loss(k,141) = (rxt(k,317)* y(k,56) +rxt(k,318)* y(k,135) +rxt(k,343) & + * y(k,226) + het_rates(k,25))* y(k,25) + prod(k,141) = 0._r8 + loss(k,93) = (rxt(k,323)* y(k,226) + het_rates(k,26))* y(k,26) + prod(k,93) = (.400_r8*rxt(k,319)*y(k,195) +.200_r8*rxt(k,320)*y(k,199)) & + *y(k,195) + loss(k,110) = (rxt(k,324)* y(k,226) + rxt(k,30) + het_rates(k,27))* y(k,27) + prod(k,110) =rxt(k,321)*y(k,195)*y(k,90) + loss(k,100) = (rxt(k,325)* y(k,56) +rxt(k,326)* y(k,226) + het_rates(k,28)) & * y(k,28) - prod(k,72) = 0._r8 - loss(k,160) = (rxt(k,347)* y(k,126) +rxt(k,348)* y(k,135) +rxt(k,365) & - * y(k,221) + het_rates(k,29))* y(k,29) - prod(k,160) =.130_r8*rxt(k,425)*y(k,135)*y(k,98) +.700_r8*rxt(k,56)*y(k,111) - loss(k,89) = (rxt(k,352)* y(k,221) + rxt(k,31) + het_rates(k,30))* y(k,30) - prod(k,89) =rxt(k,350)*y(k,203)*y(k,194) - loss(k,39) = (rxt(k,353)* y(k,221) + het_rates(k,31))* y(k,31) - prod(k,39) = 0._r8 - loss(k,67) = (rxt(k,448)* y(k,221) + rxt(k,32) + het_rates(k,32))* y(k,32) - prod(k,67) =rxt(k,446)*y(k,203)*y(k,195) - loss(k,193) = (rxt(k,250)* y(k,17) +rxt(k,214)* y(k,56) +rxt(k,295)* y(k,126) & - +rxt(k,296)* y(k,133) +rxt(k,294)* y(k,203) +rxt(k,297)* y(k,221) & + prod(k,100) = 0._r8 + loss(k,197) = (rxt(k,346)* y(k,126) +rxt(k,347)* y(k,135) +rxt(k,365) & + * y(k,226) + het_rates(k,29))* y(k,29) + prod(k,197) =.130_r8*rxt(k,425)*y(k,135)*y(k,99) +.700_r8*rxt(k,56)*y(k,111) + loss(k,120) = (rxt(k,351)* y(k,226) + rxt(k,31) + het_rates(k,30))* y(k,30) + prod(k,120) =rxt(k,349)*y(k,196)*y(k,90) + loss(k,101) = (rxt(k,355)* y(k,56) +rxt(k,352)* y(k,226) + het_rates(k,31)) & + * y(k,31) + prod(k,101) = 0._r8 + loss(k,94) = (rxt(k,448)* y(k,226) + rxt(k,32) + het_rates(k,32))* y(k,32) + prod(k,94) =rxt(k,446)*y(k,197)*y(k,90) + loss(k,54) = (rxt(k,239)* y(k,222) + rxt(k,79) + het_rates(k,33))* y(k,33) + prod(k,54) = 0._r8 + loss(k,65) = (rxt(k,240)* y(k,222) + rxt(k,80) + het_rates(k,34))* y(k,34) + prod(k,65) = 0._r8 + loss(k,66) = (rxt(k,266)* y(k,222) + rxt(k,81) + het_rates(k,35))* y(k,35) + prod(k,66) = 0._r8 + loss(k,57) = (rxt(k,241)* y(k,222) + rxt(k,82) + het_rates(k,36))* y(k,36) + prod(k,57) = 0._r8 + loss(k,67) = (rxt(k,242)* y(k,222) + rxt(k,83) + het_rates(k,37))* y(k,37) + prod(k,67) = 0._r8 + loss(k,58) = (rxt(k,243)* y(k,222) + rxt(k,84) + het_rates(k,38))* y(k,38) + prod(k,58) = 0._r8 + loss(k,68) = (rxt(k,244)* y(k,222) + rxt(k,85) + het_rates(k,39))* y(k,39) + prod(k,68) = 0._r8 + loss(k,59) = (rxt(k,245)* y(k,222) + rxt(k,86) + het_rates(k,40))* y(k,40) + prod(k,59) = 0._r8 + loss(k,130) = (rxt(k,277)* y(k,56) +rxt(k,289)* y(k,222) +rxt(k,278) & + * y(k,226) + rxt(k,87) + het_rates(k,41))* y(k,41) + prod(k,130) = 0._r8 + loss(k,235) = (rxt(k,250)* y(k,17) +rxt(k,214)* y(k,56) +rxt(k,294)* y(k,90) & + +rxt(k,295)* y(k,126) +rxt(k,296)* y(k,133) +rxt(k,297)* y(k,226) & + rxt(k,33) + rxt(k,34) + het_rates(k,42))* y(k,42) - prod(k,193) = (rxt(k,221)*y(k,59) +2.000_r8*rxt(k,298)*y(k,197) + & - rxt(k,299)*y(k,197) +rxt(k,301)*y(k,124) + & - .700_r8*rxt(k,321)*y(k,193) +rxt(k,332)*y(k,196) + & - rxt(k,349)*y(k,194) +.800_r8*rxt(k,361)*y(k,225) + & - .880_r8*rxt(k,373)*y(k,207) +2.000_r8*rxt(k,382)*y(k,209) + & - 1.500_r8*rxt(k,406)*y(k,205) +.750_r8*rxt(k,411)*y(k,206) + & - .800_r8*rxt(k,420)*y(k,101) +.800_r8*rxt(k,431)*y(k,229) + & - .750_r8*rxt(k,485)*y(k,216) +.930_r8*rxt(k,490)*y(k,226) + & - .950_r8*rxt(k,495)*y(k,227))*y(k,197) & - + (.500_r8*rxt(k,338)*y(k,202) +rxt(k,359)*y(k,224) + & - rxt(k,363)*y(k,225) +.500_r8*rxt(k,369)*y(k,200) + & - .250_r8*rxt(k,376)*y(k,207) +rxt(k,385)*y(k,209) + & - .100_r8*rxt(k,398)*y(k,190) +.920_r8*rxt(k,408)*y(k,205) + & - .250_r8*rxt(k,433)*y(k,229) +.340_r8*rxt(k,492)*y(k,226) + & - .320_r8*rxt(k,497)*y(k,227))*y(k,124) + (rxt(k,302)*y(k,52) + & - .300_r8*rxt(k,303)*y(k,53) +.500_r8*rxt(k,336)*y(k,51) + & - .800_r8*rxt(k,341)*y(k,74) +rxt(k,343)*y(k,140) + & + prod(k,235) = (rxt(k,221)*y(k,59) +2.000_r8*rxt(k,298)*y(k,199) + & + rxt(k,299)*y(k,199) +rxt(k,301)*y(k,124) + & + .700_r8*rxt(k,320)*y(k,195) +rxt(k,331)*y(k,198) + & + rxt(k,348)*y(k,196) +.800_r8*rxt(k,361)*y(k,230) + & + .880_r8*rxt(k,373)*y(k,211) +2.000_r8*rxt(k,382)*y(k,213) + & + 1.500_r8*rxt(k,406)*y(k,206) +.750_r8*rxt(k,411)*y(k,207) + & + .800_r8*rxt(k,420)*y(k,208) +.800_r8*rxt(k,431)*y(k,235) + & + .750_r8*rxt(k,485)*y(k,221) +.930_r8*rxt(k,490)*y(k,231) + & + .950_r8*rxt(k,495)*y(k,232))*y(k,199) & + + (.500_r8*rxt(k,337)*y(k,204) +rxt(k,359)*y(k,229) + & + rxt(k,363)*y(k,230) +.500_r8*rxt(k,369)*y(k,202) + & + .250_r8*rxt(k,376)*y(k,211) +rxt(k,385)*y(k,213) + & + .100_r8*rxt(k,398)*y(k,190) +.920_r8*rxt(k,408)*y(k,206) + & + .250_r8*rxt(k,433)*y(k,235) +.340_r8*rxt(k,492)*y(k,231) + & + .320_r8*rxt(k,497)*y(k,232))*y(k,124) + (rxt(k,302)*y(k,52) + & + .300_r8*rxt(k,303)*y(k,53) +.500_r8*rxt(k,335)*y(k,51) + & + .800_r8*rxt(k,340)*y(k,74) +rxt(k,342)*y(k,140) + & .500_r8*rxt(k,391)*y(k,109) +.400_r8*rxt(k,396)*y(k,1) + & - .300_r8*rxt(k,416)*y(k,99) +.680_r8*rxt(k,501)*y(k,179))*y(k,221) & - + (rxt(k,319)*y(k,25) +.500_r8*rxt(k,348)*y(k,29) + & + .300_r8*rxt(k,416)*y(k,100) +.680_r8*rxt(k,501)*y(k,179))*y(k,226) & + + (rxt(k,318)*y(k,25) +.500_r8*rxt(k,347)*y(k,29) + & .120_r8*rxt(k,378)*y(k,105) +.600_r8*rxt(k,392)*y(k,111) + & - .910_r8*rxt(k,425)*y(k,98) +.340_r8*rxt(k,480)*y(k,6) + & + .910_r8*rxt(k,425)*y(k,99) +.340_r8*rxt(k,480)*y(k,6) + & .340_r8*rxt(k,483)*y(k,110))*y(k,135) + (.500_r8*rxt(k,367)*y(k,16) + & - .250_r8*rxt(k,375)*y(k,207) +rxt(k,386)*y(k,209) + & - rxt(k,409)*y(k,205))*y(k,126) + (.250_r8*rxt(k,372)*y(k,207) + & - rxt(k,381)*y(k,209) +rxt(k,405)*y(k,205) + & - .250_r8*rxt(k,430)*y(k,229))*y(k,196) + (rxt(k,312)*y(k,217) + & - rxt(k,313)*y(k,217))*y(k,54) + (.150_r8*rxt(k,362)*y(k,225) + & - .450_r8*rxt(k,383)*y(k,209))*y(k,203) +.100_r8*rxt(k,20)*y(k,1) & - +.100_r8*rxt(k,21)*y(k,2) +rxt(k,39)*y(k,53) +rxt(k,44)*y(k,74) & - +.330_r8*rxt(k,46)*y(k,93) +rxt(k,48)*y(k,95) +.690_r8*rxt(k,50) & - *y(k,103) +1.340_r8*rxt(k,51)*y(k,105) +rxt(k,58)*y(k,127) +rxt(k,63) & - *y(k,147) +rxt(k,64)*y(k,148) +.375_r8*rxt(k,66)*y(k,175) & - +.400_r8*rxt(k,68)*y(k,177) +.680_r8*rxt(k,70)*y(k,179) & - +2.000_r8*rxt(k,339)*y(k,201) +rxt(k,309)*y(k,204) & - +2.000_r8*rxt(k,384)*y(k,209)*y(k,209) - loss(k,170) = (rxt(k,328)* y(k,126) +rxt(k,329)* y(k,221) + rxt(k,35) & + .250_r8*rxt(k,375)*y(k,211) +rxt(k,386)*y(k,213) + & + rxt(k,409)*y(k,206))*y(k,126) + (.250_r8*rxt(k,372)*y(k,211) + & + rxt(k,381)*y(k,213) +rxt(k,405)*y(k,206) + & + .250_r8*rxt(k,430)*y(k,235))*y(k,198) + (.180_r8*rxt(k,40) + & + rxt(k,311)*y(k,222) +rxt(k,312)*y(k,222))*y(k,54) & + + (.150_r8*rxt(k,362)*y(k,230) +.450_r8*rxt(k,383)*y(k,213))*y(k,90) & + +.100_r8*rxt(k,20)*y(k,1) +.100_r8*rxt(k,21)*y(k,2) +rxt(k,39) & + *y(k,53) +rxt(k,44)*y(k,74) +.330_r8*rxt(k,46)*y(k,94) +rxt(k,48) & + *y(k,96) +rxt(k,50)*y(k,103) +1.340_r8*rxt(k,51)*y(k,105) +rxt(k,58) & + *y(k,127) +rxt(k,63)*y(k,147) +rxt(k,64)*y(k,148) +.375_r8*rxt(k,66) & + *y(k,175) +.400_r8*rxt(k,68)*y(k,177) +.680_r8*rxt(k,70)*y(k,179) & + +2.000_r8*rxt(k,338)*y(k,203) +rxt(k,308)*y(k,205) & + +2.000_r8*rxt(k,384)*y(k,213)*y(k,213) + loss(k,148) = (rxt(k,279)* y(k,56) +rxt(k,290)* y(k,222) +rxt(k,280) & + * y(k,226) + rxt(k,88) + het_rates(k,43))* y(k,43) + prod(k,148) = 0._r8 + loss(k,60) = (rxt(k,281)* y(k,226) + rxt(k,89) + het_rates(k,44))* y(k,44) + prod(k,60) = 0._r8 + loss(k,198) = (rxt(k,327)* y(k,126) +rxt(k,328)* y(k,226) + rxt(k,35) & + het_rates(k,45))* y(k,45) - prod(k,170) = (rxt(k,323)*y(k,193) +.270_r8*rxt(k,351)*y(k,194) + & - rxt(k,359)*y(k,224) +rxt(k,369)*y(k,200) +rxt(k,388)*y(k,211) + & - .400_r8*rxt(k,398)*y(k,190))*y(k,124) + (rxt(k,324)*y(k,26) + & - .500_r8*rxt(k,325)*y(k,27) +.800_r8*rxt(k,396)*y(k,1))*y(k,221) & - + (.500_r8*rxt(k,348)*y(k,29) +.100_r8*rxt(k,392)*y(k,111))*y(k,135) & - + (1.600_r8*rxt(k,320)*y(k,193) +.800_r8*rxt(k,321)*y(k,197)) & - *y(k,193) +.400_r8*rxt(k,20)*y(k,1) +.400_r8*rxt(k,21)*y(k,2) & - +rxt(k,367)*y(k,126)*y(k,16) +rxt(k,30)*y(k,27) +.330_r8*rxt(k,46) & - *y(k,93) +rxt(k,54)*y(k,108) +rxt(k,63)*y(k,147) & - +.200_r8*rxt(k,387)*y(k,211)*y(k,203) - loss(k,38) = (rxt(k,330)* y(k,221) + het_rates(k,47))* y(k,47) - prod(k,38) = 0._r8 - loss(k,156) = (rxt(k,366)* y(k,221) + rxt(k,36) + het_rates(k,48))* y(k,48) - prod(k,156) = (.820_r8*rxt(k,351)*y(k,194) +.500_r8*rxt(k,369)*y(k,200) + & - .250_r8*rxt(k,398)*y(k,190) +.270_r8*rxt(k,492)*y(k,226) + & - .040_r8*rxt(k,497)*y(k,227))*y(k,124) & - + (.820_r8*rxt(k,349)*y(k,194) +.150_r8*rxt(k,490)*y(k,226) + & - .025_r8*rxt(k,495)*y(k,227))*y(k,197) + (.250_r8*rxt(k,20) + & - .800_r8*rxt(k,396)*y(k,221))*y(k,1) + (.520_r8*rxt(k,480)*y(k,6) + & + prod(k,198) = (rxt(k,322)*y(k,195) +.270_r8*rxt(k,350)*y(k,196) + & + rxt(k,359)*y(k,229) +rxt(k,369)*y(k,202) +rxt(k,388)*y(k,215) + & + .400_r8*rxt(k,398)*y(k,190))*y(k,124) + (rxt(k,323)*y(k,26) + & + .500_r8*rxt(k,324)*y(k,27) +.800_r8*rxt(k,396)*y(k,1))*y(k,226) & + + (.500_r8*rxt(k,347)*y(k,29) +.100_r8*rxt(k,392)*y(k,111))*y(k,135) & + + (1.600_r8*rxt(k,319)*y(k,195) +.800_r8*rxt(k,320)*y(k,199)) & + *y(k,195) +.400_r8*rxt(k,20)*y(k,1) +.400_r8*rxt(k,21)*y(k,2) & + +rxt(k,367)*y(k,126)*y(k,16) +rxt(k,30)*y(k,27) & + +.200_r8*rxt(k,387)*y(k,215)*y(k,90) +.330_r8*rxt(k,46)*y(k,94) & + +rxt(k,54)*y(k,108) +rxt(k,63)*y(k,147) + loss(k,113) = (rxt(k,282)* y(k,56) +rxt(k,283)* y(k,226) + rxt(k,90) & + + het_rates(k,46))* y(k,46) + prod(k,113) = 0._r8 + loss(k,55) = (rxt(k,329)* y(k,226) + het_rates(k,47))* y(k,47) + prod(k,55) = 0._r8 + loss(k,193) = (rxt(k,366)* y(k,226) + rxt(k,36) + het_rates(k,48))* y(k,48) + prod(k,193) = (.820_r8*rxt(k,350)*y(k,196) +.500_r8*rxt(k,369)*y(k,202) + & + .250_r8*rxt(k,398)*y(k,190) +.270_r8*rxt(k,492)*y(k,231) + & + .040_r8*rxt(k,497)*y(k,232))*y(k,124) & + + (.820_r8*rxt(k,348)*y(k,196) +.150_r8*rxt(k,490)*y(k,231) + & + .025_r8*rxt(k,495)*y(k,232))*y(k,199) + (.250_r8*rxt(k,20) + & + .800_r8*rxt(k,396)*y(k,226))*y(k,1) + (.520_r8*rxt(k,480)*y(k,6) + & .520_r8*rxt(k,483)*y(k,110))*y(k,135) + (.500_r8*rxt(k,70) + & - .500_r8*rxt(k,501)*y(k,221))*y(k,179) +.250_r8*rxt(k,21)*y(k,2) & + .500_r8*rxt(k,501)*y(k,226))*y(k,179) +.250_r8*rxt(k,21)*y(k,2) & +.500_r8*rxt(k,367)*y(k,126)*y(k,16) +.820_r8*rxt(k,31)*y(k,30) & - +.170_r8*rxt(k,46)*y(k,93) +.300_r8*rxt(k,66)*y(k,175) & + +.170_r8*rxt(k,46)*y(k,94) +.300_r8*rxt(k,66)*y(k,175) & +.050_r8*rxt(k,68)*y(k,177) - loss(k,175) = (rxt(k,354)* y(k,126) +rxt(k,355)* y(k,221) + rxt(k,37) & + loss(k,208) = (rxt(k,353)* y(k,126) +rxt(k,354)* y(k,226) + rxt(k,37) & + het_rates(k,49))* y(k,49) - prod(k,175) = (.250_r8*rxt(k,376)*y(k,207) +.050_r8*rxt(k,414)*y(k,206) + & - .250_r8*rxt(k,433)*y(k,229) +.170_r8*rxt(k,451)*y(k,198) + & - .170_r8*rxt(k,457)*y(k,210) +.400_r8*rxt(k,467)*y(k,228) + & - .540_r8*rxt(k,473)*y(k,230) +.510_r8*rxt(k,476)*y(k,231))*y(k,124) & - + (.250_r8*rxt(k,375)*y(k,207) +.050_r8*rxt(k,415)*y(k,206) + & - .250_r8*rxt(k,434)*y(k,229))*y(k,126) & - + (.500_r8*rxt(k,361)*y(k,225) +.240_r8*rxt(k,373)*y(k,207) + & - .100_r8*rxt(k,431)*y(k,229))*y(k,197) & + prod(k,208) = (.250_r8*rxt(k,376)*y(k,211) +.050_r8*rxt(k,414)*y(k,207) + & + .250_r8*rxt(k,433)*y(k,235) +.170_r8*rxt(k,451)*y(k,200) + & + .170_r8*rxt(k,457)*y(k,214) +.400_r8*rxt(k,467)*y(k,233) + & + .540_r8*rxt(k,473)*y(k,236) +.510_r8*rxt(k,476)*y(k,238))*y(k,124) & + + (.250_r8*rxt(k,375)*y(k,211) +.050_r8*rxt(k,415)*y(k,207) + & + .250_r8*rxt(k,434)*y(k,235))*y(k,126) & + + (.500_r8*rxt(k,361)*y(k,230) +.240_r8*rxt(k,373)*y(k,211) + & + .100_r8*rxt(k,431)*y(k,235))*y(k,199) & + + (.070_r8*rxt(k,450)*y(k,200) +.070_r8*rxt(k,456)*y(k,214))*y(k,90) & + (.880_r8*rxt(k,378)*y(k,105) +.500_r8*rxt(k,392)*y(k,111)) & - *y(k,135) + (.250_r8*rxt(k,372)*y(k,207) + & - .250_r8*rxt(k,430)*y(k,229))*y(k,196) & - + (.070_r8*rxt(k,450)*y(k,198) +.070_r8*rxt(k,456)*y(k,210)) & - *y(k,203) + (rxt(k,356)*y(k,95) +rxt(k,357)*y(k,127))*y(k,221) & - +.180_r8*rxt(k,24)*y(k,10) +rxt(k,28)*y(k,14) +.400_r8*rxt(k,71) & - *y(k,180) +.540_r8*rxt(k,73)*y(k,184) +.510_r8*rxt(k,74)*y(k,186) - loss(k,111) = (rxt(k,335)* y(k,221) + het_rates(k,50))* y(k,50) - prod(k,111) = (.100_r8*rxt(k,332)*y(k,197) +.150_r8*rxt(k,333)*y(k,203)) & - *y(k,196) +.120_r8*rxt(k,348)*y(k,135)*y(k,29) & - +.150_r8*rxt(k,383)*y(k,209)*y(k,203) - loss(k,105) = (rxt(k,336)* y(k,221) + rxt(k,38) + het_rates(k,51))* y(k,51) - prod(k,105) = (.400_r8*rxt(k,333)*y(k,196) +.400_r8*rxt(k,383)*y(k,209)) & - *y(k,203) - loss(k,140) = (rxt(k,302)* y(k,221) + het_rates(k,52))* y(k,52) - prod(k,140) = (rxt(k,299)*y(k,197) +.300_r8*rxt(k,321)*y(k,193) + & - .500_r8*rxt(k,361)*y(k,225) +.250_r8*rxt(k,373)*y(k,207) + & - .250_r8*rxt(k,406)*y(k,205) +.250_r8*rxt(k,411)*y(k,206) + & - .200_r8*rxt(k,420)*y(k,101) +.300_r8*rxt(k,431)*y(k,229) + & - .250_r8*rxt(k,485)*y(k,216) +.250_r8*rxt(k,490)*y(k,226) + & - .250_r8*rxt(k,495)*y(k,227))*y(k,197) - loss(k,90) = (rxt(k,303)* y(k,221) + rxt(k,39) + het_rates(k,53))* y(k,53) - prod(k,90) =rxt(k,300)*y(k,203)*y(k,197) - loss(k,188) = (rxt(k,326)* y(k,28) +rxt(k,277)* y(k,41) +rxt(k,214)* y(k,42) & - +rxt(k,279)* y(k,43) +rxt(k,282)* y(k,46) +rxt(k,215)* y(k,54) & - +rxt(k,284)* y(k,55) +rxt(k,227)* y(k,60) +rxt(k,216)* y(k,77) & - +rxt(k,217)* y(k,79) +rxt(k,236)* y(k,92) +rxt(k,220)* y(k,135) & - + (rxt(k,218) +rxt(k,219))* y(k,203) + het_rates(k,56))* y(k,56) - prod(k,188) = (4.000_r8*rxt(k,239)*y(k,33) +rxt(k,240)*y(k,34) + & + *y(k,135) + (.250_r8*rxt(k,372)*y(k,211) + & + .250_r8*rxt(k,430)*y(k,235))*y(k,198) + (rxt(k,356)*y(k,96) + & + rxt(k,357)*y(k,127))*y(k,226) +.180_r8*rxt(k,24)*y(k,10) +rxt(k,28) & + *y(k,14) +.400_r8*rxt(k,71)*y(k,180) +.540_r8*rxt(k,73)*y(k,184) & + +.510_r8*rxt(k,74)*y(k,186) + loss(k,159) = (rxt(k,334)* y(k,226) + het_rates(k,50))* y(k,50) + prod(k,159) = (.150_r8*rxt(k,332)*y(k,198) +.150_r8*rxt(k,383)*y(k,213)) & + *y(k,90) +.120_r8*rxt(k,347)*y(k,135)*y(k,29) & + +.100_r8*rxt(k,331)*y(k,199)*y(k,198) + loss(k,150) = (rxt(k,335)* y(k,226) + rxt(k,38) + het_rates(k,51))* y(k,51) + prod(k,150) = (.400_r8*rxt(k,332)*y(k,198) +.400_r8*rxt(k,383)*y(k,213)) & + *y(k,90) + loss(k,170) = (rxt(k,302)* y(k,226) + het_rates(k,52))* y(k,52) + prod(k,170) = (rxt(k,299)*y(k,199) +.300_r8*rxt(k,320)*y(k,195) + & + .500_r8*rxt(k,361)*y(k,230) +.250_r8*rxt(k,373)*y(k,211) + & + .250_r8*rxt(k,406)*y(k,206) +.250_r8*rxt(k,411)*y(k,207) + & + .200_r8*rxt(k,420)*y(k,208) +.300_r8*rxt(k,431)*y(k,235) + & + .250_r8*rxt(k,485)*y(k,221) +.250_r8*rxt(k,490)*y(k,231) + & + .250_r8*rxt(k,495)*y(k,232))*y(k,199) + loss(k,116) = (rxt(k,303)* y(k,226) + rxt(k,39) + het_rates(k,53))* y(k,53) + prod(k,116) =rxt(k,300)*y(k,199)*y(k,90) + loss(k,233) = (rxt(k,215)* y(k,56) +rxt(k,271)* y(k,73) + (rxt(k,310) + & + rxt(k,311) +rxt(k,312))* y(k,222) +rxt(k,304)* y(k,226) + rxt(k,40) & + + rxt(k,41) + het_rates(k,54))* y(k,54) + prod(k,233) =.100_r8*rxt(k,347)*y(k,135)*y(k,29) + loss(k,125) = (rxt(k,284)* y(k,56) +rxt(k,267)* y(k,222) +rxt(k,285) & + * y(k,226) + rxt(k,91) + het_rates(k,55))* y(k,55) + prod(k,125) = 0._r8 + loss(k,227) = (rxt(k,325)* y(k,28) +rxt(k,355)* y(k,31) +rxt(k,277)* y(k,41) & + +rxt(k,214)* y(k,42) +rxt(k,279)* y(k,43) +rxt(k,282)* y(k,46) & + +rxt(k,215)* y(k,54) +rxt(k,284)* y(k,55) +rxt(k,227)* y(k,60) & + +rxt(k,216)* y(k,77) +rxt(k,217)* y(k,79) + (rxt(k,218) +rxt(k,219)) & + * y(k,90) +rxt(k,236)* y(k,93) +rxt(k,220)* y(k,135) & + + het_rates(k,56))* y(k,56) + prod(k,227) = (4.000_r8*rxt(k,239)*y(k,33) +rxt(k,240)*y(k,34) + & 2.000_r8*rxt(k,241)*y(k,36) +2.000_r8*rxt(k,242)*y(k,37) + & 2.000_r8*rxt(k,243)*y(k,38) +rxt(k,244)*y(k,39) + & - 2.000_r8*rxt(k,245)*y(k,40) +rxt(k,291)*y(k,82) +rxt(k,292)*y(k,83) + & - rxt(k,293)*y(k,84) +rxt(k,246)*y(k,85) +rxt(k,276)*y(k,65))*y(k,217) & - + (rxt(k,94) +rxt(k,221)*y(k,197) +2.000_r8*rxt(k,222)*y(k,59) + & + 2.000_r8*rxt(k,245)*y(k,40) +rxt(k,246)*y(k,85) +rxt(k,276)*y(k,65) + & + rxt(k,291)*y(k,82) +rxt(k,292)*y(k,83) +rxt(k,293)*y(k,84))*y(k,222) & + + (rxt(k,94) +rxt(k,221)*y(k,199) +2.000_r8*rxt(k,222)*y(k,59) + & rxt(k,224)*y(k,59) +rxt(k,226)*y(k,124) +rxt(k,231)*y(k,133) + & - rxt(k,232)*y(k,221) +rxt(k,255)*y(k,19) +rxt(k,509)*y(k,151))*y(k,59) & - + (3.000_r8*rxt(k,281)*y(k,44) +rxt(k,283)*y(k,46) + & - rxt(k,286)*y(k,82) +rxt(k,287)*y(k,83) +rxt(k,288)*y(k,84) + & - rxt(k,235)*y(k,85))*y(k,221) + (rxt(k,104) +rxt(k,234)*y(k,133)) & - *y(k,85) +rxt(k,75)*y(k,18) +2.000_r8*rxt(k,92)*y(k,57) & - +2.000_r8*rxt(k,93)*y(k,58) +rxt(k,95)*y(k,60) +rxt(k,98)*y(k,65) & - +rxt(k,107)*y(k,92) - loss(k,47) = ( + rxt(k,92) + het_rates(k,57))* y(k,57) - prod(k,47) = (rxt(k,549)*y(k,92) +rxt(k,554)*y(k,60) +rxt(k,555)*y(k,92) + & - rxt(k,559)*y(k,60) +rxt(k,560)*y(k,92) +rxt(k,564)*y(k,60))*y(k,85) & + rxt(k,232)*y(k,226) +rxt(k,255)*y(k,19) +rxt(k,510)*y(k,151))*y(k,59) & + + (rxt(k,235)*y(k,85) +3.000_r8*rxt(k,281)*y(k,44) + & + rxt(k,283)*y(k,46) +rxt(k,286)*y(k,82) +rxt(k,287)*y(k,83) + & + rxt(k,288)*y(k,84))*y(k,226) + (rxt(k,104) +rxt(k,234)*y(k,133)) & + *y(k,85) +rxt(k,75)*y(k,18) +4.000_r8*rxt(k,79)*y(k,33) +rxt(k,80) & + *y(k,34) +2.000_r8*rxt(k,82)*y(k,36) +2.000_r8*rxt(k,83)*y(k,37) & + +2.000_r8*rxt(k,84)*y(k,38) +rxt(k,85)*y(k,39) +2.000_r8*rxt(k,86) & + *y(k,40) +3.000_r8*rxt(k,89)*y(k,44) +rxt(k,90)*y(k,46) & + +2.000_r8*rxt(k,92)*y(k,57) +2.000_r8*rxt(k,93)*y(k,58) +rxt(k,95) & + *y(k,60) +rxt(k,98)*y(k,65) +rxt(k,101)*y(k,82) +rxt(k,102)*y(k,83) & + +rxt(k,103)*y(k,84) +rxt(k,107)*y(k,93) + loss(k,72) = ( + rxt(k,92) + het_rates(k,57))* y(k,57) + prod(k,72) = (rxt(k,563)*y(k,93) +rxt(k,568)*y(k,60) +rxt(k,569)*y(k,93) + & + rxt(k,573)*y(k,60) +rxt(k,574)*y(k,93) +rxt(k,578)*y(k,60))*y(k,85) & +rxt(k,227)*y(k,60)*y(k,56) +rxt(k,223)*y(k,59)*y(k,59) - loss(k,36) = ( + rxt(k,93) + rxt(k,249) + het_rates(k,58))* y(k,58) - prod(k,36) =rxt(k,248)*y(k,59)*y(k,59) - loss(k,200) = ((rxt(k,254) +rxt(k,255) +rxt(k,256))* y(k,19) & + loss(k,52) = ( + rxt(k,93) + rxt(k,249) + het_rates(k,58))* y(k,58) + prod(k,52) =rxt(k,248)*y(k,59)*y(k,59) + loss(k,222) = ((rxt(k,254) +rxt(k,255) +rxt(k,256))* y(k,19) & + 2._r8*(rxt(k,222) +rxt(k,223) +rxt(k,224) +rxt(k,248))* y(k,59) & - +rxt(k,226)* y(k,124) +rxt(k,228)* y(k,125) +rxt(k,231)* y(k,133) & - +rxt(k,509)* y(k,151) +rxt(k,221)* y(k,197) +rxt(k,225)* y(k,203) & - + (rxt(k,232) +rxt(k,233))* y(k,221) + rxt(k,94) + het_rates(k,59)) & + +rxt(k,225)* y(k,90) +rxt(k,226)* y(k,124) +rxt(k,228)* y(k,125) & + +rxt(k,231)* y(k,133) +rxt(k,510)* y(k,151) +rxt(k,221)* y(k,199) & + + (rxt(k,232) +rxt(k,233))* y(k,226) + rxt(k,94) + het_rates(k,59)) & * y(k,59) - prod(k,200) = (rxt(k,219)*y(k,203) +rxt(k,220)*y(k,135) +rxt(k,236)*y(k,92)) & + prod(k,222) = (rxt(k,219)*y(k,90) +rxt(k,220)*y(k,135) +rxt(k,236)*y(k,93)) & *y(k,56) + (rxt(k,96) +rxt(k,229)*y(k,133))*y(k,60) & - + (rxt(k,237)*y(k,133) +rxt(k,238)*y(k,221))*y(k,92) + (rxt(k,108) + & - rxt(k,514)*y(k,151))*y(k,137) +2.000_r8*rxt(k,249)*y(k,58) & - +rxt(k,247)*y(k,217)*y(k,85) - loss(k,157) = (rxt(k,227)* y(k,56) + (rxt(k,554) +rxt(k,559) +rxt(k,564)) & - * y(k,85) +rxt(k,229)* y(k,133) +rxt(k,230)* y(k,221) + rxt(k,95) & - + rxt(k,96) + rxt(k,552) + rxt(k,557) + rxt(k,563) & + + (rxt(k,237)*y(k,133) +rxt(k,238)*y(k,226))*y(k,93) + (rxt(k,108) + & + rxt(k,515)*y(k,151))*y(k,137) +2.000_r8*rxt(k,249)*y(k,58) & + +rxt(k,247)*y(k,222)*y(k,85) + loss(k,185) = (rxt(k,227)* y(k,56) + (rxt(k,568) +rxt(k,573) +rxt(k,578)) & + * y(k,85) +rxt(k,229)* y(k,133) +rxt(k,230)* y(k,226) + rxt(k,95) & + + rxt(k,96) + rxt(k,566) + rxt(k,571) + rxt(k,577) & + het_rates(k,60))* y(k,60) - prod(k,157) =rxt(k,228)*y(k,125)*y(k,59) - loss(k,165) = ((rxt(k,305) +rxt(k,315))* y(k,221) + het_rates(k,62))* y(k,62) - prod(k,165) = (rxt(k,33) +rxt(k,34) +rxt(k,214)*y(k,56) +rxt(k,250)*y(k,17) + & - rxt(k,295)*y(k,126) +rxt(k,296)*y(k,133) +rxt(k,297)*y(k,221)) & - *y(k,42) + (.630_r8*rxt(k,319)*y(k,25) +.560_r8*rxt(k,348)*y(k,29) + & + prod(k,185) =rxt(k,228)*y(k,125)*y(k,59) + loss(k,5) = ( + het_rates(k,61))* y(k,61) + prod(k,5) = 0._r8 + loss(k,199) = (rxt(k,314)* y(k,226) + het_rates(k,62))* y(k,62) + prod(k,199) = (rxt(k,33) +rxt(k,34) +rxt(k,214)*y(k,56) +rxt(k,250)*y(k,17) + & + rxt(k,295)*y(k,126) +rxt(k,296)*y(k,133) +rxt(k,297)*y(k,226)) & + *y(k,42) + (.630_r8*rxt(k,318)*y(k,25) +.560_r8*rxt(k,347)*y(k,29) + & .650_r8*rxt(k,378)*y(k,105) +.560_r8*rxt(k,392)*y(k,111) + & - .620_r8*rxt(k,425)*y(k,98) +.230_r8*rxt(k,480)*y(k,6) + & + .620_r8*rxt(k,425)*y(k,99) +.230_r8*rxt(k,480)*y(k,6) + & .230_r8*rxt(k,483)*y(k,110))*y(k,135) & - + (.220_r8*rxt(k,376)*y(k,207) +.250_r8*rxt(k,433)*y(k,229) + & - .170_r8*rxt(k,451)*y(k,198) +.400_r8*rxt(k,454)*y(k,208) + & - .350_r8*rxt(k,457)*y(k,210) +.225_r8*rxt(k,492)*y(k,226))*y(k,124) & - + (.350_r8*rxt(k,317)*y(k,24) +rxt(k,342)*y(k,75) + & - rxt(k,355)*y(k,49) +.700_r8*rxt(k,501)*y(k,179) +rxt(k,505)*y(k,138)) & - *y(k,221) + (rxt(k,354)*y(k,49) +.220_r8*rxt(k,375)*y(k,207) + & - .500_r8*rxt(k,434)*y(k,229))*y(k,126) & - + (.110_r8*rxt(k,373)*y(k,207) +.200_r8*rxt(k,431)*y(k,229) + & - .125_r8*rxt(k,490)*y(k,226))*y(k,197) & - + (.070_r8*rxt(k,450)*y(k,198) +.160_r8*rxt(k,453)*y(k,208) + & - .140_r8*rxt(k,456)*y(k,210))*y(k,203) + (rxt(k,137) + & - rxt(k,504)*y(k,133))*y(k,138) + (.220_r8*rxt(k,372)*y(k,207) + & - .250_r8*rxt(k,430)*y(k,229))*y(k,196) +1.500_r8*rxt(k,23)*y(k,9) & + + (.220_r8*rxt(k,376)*y(k,211) +.250_r8*rxt(k,433)*y(k,235) + & + .170_r8*rxt(k,451)*y(k,200) +.400_r8*rxt(k,454)*y(k,212) + & + .350_r8*rxt(k,457)*y(k,214) +.225_r8*rxt(k,492)*y(k,231))*y(k,124) & + + (.350_r8*rxt(k,316)*y(k,24) +rxt(k,341)*y(k,75) + & + rxt(k,354)*y(k,49) +.700_r8*rxt(k,501)*y(k,179) +rxt(k,505)*y(k,138)) & + *y(k,226) + (rxt(k,42) +rxt(k,110) +rxt(k,591)*y(k,227))*y(k,63) & + + (.070_r8*rxt(k,450)*y(k,200) +.160_r8*rxt(k,453)*y(k,212) + & + .140_r8*rxt(k,456)*y(k,214))*y(k,90) + (rxt(k,353)*y(k,49) + & + .220_r8*rxt(k,375)*y(k,211) +.500_r8*rxt(k,434)*y(k,235))*y(k,126) & + + (.110_r8*rxt(k,373)*y(k,211) +.200_r8*rxt(k,431)*y(k,235) + & + .125_r8*rxt(k,490)*y(k,231))*y(k,199) + (rxt(k,137) + & + rxt(k,504)*y(k,133))*y(k,138) + (.220_r8*rxt(k,372)*y(k,211) + & + .250_r8*rxt(k,430)*y(k,235))*y(k,198) +1.500_r8*rxt(k,23)*y(k,9) & +.450_r8*rxt(k,24)*y(k,10) +.600_r8*rxt(k,27)*y(k,13) +rxt(k,28) & *y(k,14) +rxt(k,35)*y(k,45) +rxt(k,282)*y(k,56)*y(k,46) +rxt(k,37) & - *y(k,49) +rxt(k,577)*y(k,222)*y(k,63) +rxt(k,44)*y(k,74) & - +2.000_r8*rxt(k,45)*y(k,75) +.330_r8*rxt(k,46)*y(k,93) & + *y(k,49) +.380_r8*rxt(k,40)*y(k,54) +rxt(k,44)*y(k,74) & + +2.000_r8*rxt(k,45)*y(k,75) +.330_r8*rxt(k,46)*y(k,94) & +1.340_r8*rxt(k,52)*y(k,105) +.700_r8*rxt(k,56)*y(k,111) & +1.500_r8*rxt(k,65)*y(k,174) +.250_r8*rxt(k,66)*y(k,175) +rxt(k,69) & *y(k,178) +1.700_r8*rxt(k,70)*y(k,179) - loss(k,40) = (rxt(k,275)* y(k,217) + rxt(k,97) + het_rates(k,64))* y(k,64) - prod(k,40) = (rxt(k,240)*y(k,34) +rxt(k,242)*y(k,37) + & + loss(k,215) = (rxt(k,591)* y(k,227) + rxt(k,42) + rxt(k,110) & + + het_rates(k,63))* y(k,63) + prod(k,215) = (rxt(k,306)*y(k,87) +rxt(k,314)*y(k,62) +rxt(k,334)*y(k,50) + & + .500_r8*rxt(k,335)*y(k,51) +.800_r8*rxt(k,340)*y(k,74) + & + rxt(k,341)*y(k,75) +.500_r8*rxt(k,391)*y(k,109) + & + 1.800_r8*rxt(k,501)*y(k,179))*y(k,226) & + + (2.000_r8*rxt(k,330)*y(k,198) +.900_r8*rxt(k,331)*y(k,199) + & + rxt(k,333)*y(k,124) +2.000_r8*rxt(k,381)*y(k,213) + & + rxt(k,405)*y(k,206) +rxt(k,430)*y(k,235))*y(k,198) & + + (.200_r8*rxt(k,347)*y(k,29) +.100_r8*rxt(k,392)*y(k,111) + & + .270_r8*rxt(k,480)*y(k,6) +.270_r8*rxt(k,483)*y(k,110))*y(k,135) & + + (rxt(k,382)*y(k,199) +.450_r8*rxt(k,383)*y(k,90) + & + 2.000_r8*rxt(k,384)*y(k,213))*y(k,213) & + + (.500_r8*rxt(k,490)*y(k,199) +.900_r8*rxt(k,492)*y(k,124)) & + *y(k,231) +rxt(k,38)*y(k,51) +.440_r8*rxt(k,40)*y(k,54) & + +.400_r8*rxt(k,61)*y(k,140) +rxt(k,66)*y(k,175) +.800_r8*rxt(k,70) & + *y(k,179) + loss(k,88) = (rxt(k,275)* y(k,222) + rxt(k,97) + het_rates(k,64))* y(k,64) + prod(k,88) = (rxt(k,240)*y(k,34) +rxt(k,242)*y(k,37) + & 2.000_r8*rxt(k,243)*y(k,38) +2.000_r8*rxt(k,244)*y(k,39) + & rxt(k,245)*y(k,40) +rxt(k,266)*y(k,35) +2.000_r8*rxt(k,268)*y(k,78) + & - rxt(k,292)*y(k,83) +rxt(k,293)*y(k,84))*y(k,217) & - + (rxt(k,287)*y(k,83) +rxt(k,288)*y(k,84))*y(k,221) - loss(k,51) = (rxt(k,276)* y(k,217) + rxt(k,98) + het_rates(k,65))* y(k,65) - prod(k,51) = (rxt(k,241)*y(k,36) +rxt(k,242)*y(k,37) +rxt(k,291)*y(k,82)) & - *y(k,217) +rxt(k,286)*y(k,221)*y(k,82) - loss(k,54) = (rxt(k,449)* y(k,221) + het_rates(k,66))* y(k,66) - prod(k,54) =.180_r8*rxt(k,469)*y(k,221)*y(k,181) - loss(k,69) = (rxt(k,502)* y(k,126) + (rxt(k,503) +rxt(k,516))* y(k,221) & + rxt(k,292)*y(k,83) +rxt(k,293)*y(k,84))*y(k,222) + (rxt(k,102) + & + rxt(k,287)*y(k,226))*y(k,83) + (rxt(k,103) +rxt(k,288)*y(k,226)) & + *y(k,84) +rxt(k,80)*y(k,34) +rxt(k,81)*y(k,35) +rxt(k,83)*y(k,37) & + +2.000_r8*rxt(k,84)*y(k,38) +2.000_r8*rxt(k,85)*y(k,39) +rxt(k,86) & + *y(k,40) +2.000_r8*rxt(k,99)*y(k,78) + loss(k,83) = (rxt(k,276)* y(k,222) + rxt(k,98) + het_rates(k,65))* y(k,65) + prod(k,83) = (rxt(k,101) +rxt(k,286)*y(k,226) +rxt(k,291)*y(k,222))*y(k,82) & + + (rxt(k,82) +rxt(k,241)*y(k,222))*y(k,36) + (rxt(k,83) + & + rxt(k,242)*y(k,222))*y(k,37) + loss(k,77) = (rxt(k,449)* y(k,226) + het_rates(k,66))* y(k,66) + prod(k,77) =.180_r8*rxt(k,469)*y(k,226)*y(k,181) + loss(k,102) = (rxt(k,502)* y(k,126) + (rxt(k,503) +rxt(k,517))* y(k,226) & + het_rates(k,67))* y(k,67) - prod(k,69) = 0._r8 - loss(k,3) = ( + het_rates(k,68))* y(k,68) - prod(k,3) = 0._r8 - loss(k,4) = ( + het_rates(k,69))* y(k,69) - prod(k,4) = 0._r8 - loss(k,5) = ( + het_rates(k,70))* y(k,70) - prod(k,5) = 0._r8 - loss(k,41) = ( + rxt(k,43) + het_rates(k,72))* y(k,72) - prod(k,41) =rxt(k,337)*y(k,203)*y(k,202) - loss(k,136) = (rxt(k,271)* y(k,54) +rxt(k,272)* y(k,77) +rxt(k,274)* y(k,89) & - +rxt(k,273)* y(k,232) + het_rates(k,73))* y(k,73) - prod(k,136) = (rxt(k,244)*y(k,39) +rxt(k,266)*y(k,35) + & - 2.000_r8*rxt(k,275)*y(k,64) +rxt(k,276)*y(k,65))*y(k,217) & - +2.000_r8*rxt(k,97)*y(k,64) +rxt(k,98)*y(k,65) +rxt(k,105)*y(k,88) - loss(k,161) = (rxt(k,341)* y(k,221) + rxt(k,44) + het_rates(k,74))* y(k,74) - prod(k,161) = (.530_r8*rxt(k,376)*y(k,207) +.050_r8*rxt(k,414)*y(k,206) + & - .250_r8*rxt(k,433)*y(k,229) +.225_r8*rxt(k,492)*y(k,226))*y(k,124) & - + (.530_r8*rxt(k,375)*y(k,207) +.050_r8*rxt(k,415)*y(k,206) + & - .250_r8*rxt(k,434)*y(k,229))*y(k,126) & - + (.260_r8*rxt(k,373)*y(k,207) +.100_r8*rxt(k,431)*y(k,229) + & - .125_r8*rxt(k,490)*y(k,226))*y(k,197) + (.700_r8*rxt(k,416)*y(k,99) + & - .500_r8*rxt(k,417)*y(k,100) +rxt(k,428)*y(k,115))*y(k,221) & - + (.530_r8*rxt(k,372)*y(k,207) +.250_r8*rxt(k,430)*y(k,229)) & - *y(k,196) +.330_r8*rxt(k,46)*y(k,93) +rxt(k,340)*y(k,201)*y(k,134) & - +.250_r8*rxt(k,66)*y(k,175) - loss(k,149) = (rxt(k,342)* y(k,221) + rxt(k,45) + rxt(k,520) & + prod(k,102) = 0._r8 + loss(k,6) = ( + het_rates(k,68))* y(k,68) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,69))* y(k,69) + prod(k,7) = 0._r8 + loss(k,8) = ( + het_rates(k,70))* y(k,70) + prod(k,8) = 0._r8 + loss(k,9) = ( + rxt(k,594) + het_rates(k,71))* y(k,71) + prod(k,9) = 0._r8 + loss(k,61) = ( + rxt(k,43) + het_rates(k,72))* y(k,72) + prod(k,61) =rxt(k,336)*y(k,204)*y(k,90) + loss(k,182) = (rxt(k,271)* y(k,54) +rxt(k,272)* y(k,77) +rxt(k,274)* y(k,89) & + +rxt(k,273)* y(k,239) + het_rates(k,73))* y(k,73) + prod(k,182) = (rxt(k,244)*y(k,39) +rxt(k,266)*y(k,35) + & + 2.000_r8*rxt(k,275)*y(k,64) +rxt(k,276)*y(k,65))*y(k,222) +rxt(k,81) & + *y(k,35) +rxt(k,85)*y(k,39) +2.000_r8*rxt(k,97)*y(k,64) +rxt(k,98) & + *y(k,65) +rxt(k,105)*y(k,88) + loss(k,200) = (rxt(k,340)* y(k,226) + rxt(k,44) + het_rates(k,74))* y(k,74) + prod(k,200) = (.530_r8*rxt(k,376)*y(k,211) +.050_r8*rxt(k,414)*y(k,207) + & + .250_r8*rxt(k,433)*y(k,235) +.225_r8*rxt(k,492)*y(k,231))*y(k,124) & + + (.530_r8*rxt(k,375)*y(k,211) +.050_r8*rxt(k,415)*y(k,207) + & + .250_r8*rxt(k,434)*y(k,235))*y(k,126) & + + (.260_r8*rxt(k,373)*y(k,211) +.100_r8*rxt(k,431)*y(k,235) + & + .125_r8*rxt(k,490)*y(k,231))*y(k,199) & + + (.700_r8*rxt(k,416)*y(k,100) +.500_r8*rxt(k,417)*y(k,101) + & + rxt(k,428)*y(k,115))*y(k,226) + (.530_r8*rxt(k,372)*y(k,211) + & + .250_r8*rxt(k,430)*y(k,235))*y(k,198) +.330_r8*rxt(k,46)*y(k,94) & + +rxt(k,339)*y(k,203)*y(k,134) +.250_r8*rxt(k,66)*y(k,175) + loss(k,190) = (rxt(k,341)* y(k,226) + rxt(k,45) + rxt(k,520) & + het_rates(k,75))* y(k,75) - prod(k,149) = (.050_r8*rxt(k,414)*y(k,206) +.250_r8*rxt(k,433)*y(k,229) + & - rxt(k,440)*y(k,191) +.400_r8*rxt(k,454)*y(k,208) + & - .170_r8*rxt(k,457)*y(k,210) +.700_r8*rxt(k,460)*y(k,223) + & - .600_r8*rxt(k,467)*y(k,228) +.340_r8*rxt(k,473)*y(k,230) + & - .170_r8*rxt(k,476)*y(k,231))*y(k,124) + (.650_r8*rxt(k,317)*y(k,24) + & - .200_r8*rxt(k,341)*y(k,74) +rxt(k,429)*y(k,116))*y(k,221) & - + (.250_r8*rxt(k,430)*y(k,196) +.100_r8*rxt(k,431)*y(k,197) + & - .250_r8*rxt(k,434)*y(k,126))*y(k,229) & - + (.160_r8*rxt(k,453)*y(k,208) +.070_r8*rxt(k,456)*y(k,210)) & - *y(k,203) +rxt(k,22)*y(k,8) +.130_r8*rxt(k,24)*y(k,10) & - +.050_r8*rxt(k,415)*y(k,206)*y(k,126) +.700_r8*rxt(k,62)*y(k,144) & + prod(k,190) = (.050_r8*rxt(k,414)*y(k,207) +.250_r8*rxt(k,433)*y(k,235) + & + rxt(k,440)*y(k,192) +.400_r8*rxt(k,454)*y(k,212) + & + .170_r8*rxt(k,457)*y(k,214) +.700_r8*rxt(k,460)*y(k,228) + & + .600_r8*rxt(k,467)*y(k,233) +.340_r8*rxt(k,473)*y(k,236) + & + .170_r8*rxt(k,476)*y(k,238))*y(k,124) + (.650_r8*rxt(k,316)*y(k,24) + & + .200_r8*rxt(k,340)*y(k,74) +rxt(k,429)*y(k,116))*y(k,226) & + + (.250_r8*rxt(k,430)*y(k,198) +.100_r8*rxt(k,431)*y(k,199) + & + .250_r8*rxt(k,434)*y(k,126))*y(k,235) & + + (.160_r8*rxt(k,453)*y(k,212) +.070_r8*rxt(k,456)*y(k,214))*y(k,90) & + +rxt(k,22)*y(k,8) +.130_r8*rxt(k,24)*y(k,10) & + +.050_r8*rxt(k,415)*y(k,207)*y(k,126) +.700_r8*rxt(k,62)*y(k,144) & +.600_r8*rxt(k,71)*y(k,180) +.340_r8*rxt(k,73)*y(k,184) & +.170_r8*rxt(k,74)*y(k,186) - loss(k,195) = (rxt(k,175)* y(k,134) +rxt(k,178)* y(k,135) + (rxt(k,172) + & - rxt(k,173) +rxt(k,174))* y(k,203) + het_rates(k,76))* y(k,76) - prod(k,195) = (rxt(k,179)*y(k,77) +rxt(k,182)*y(k,133) +rxt(k,202)*y(k,112) + & - rxt(k,297)*y(k,42) +rxt(k,315)*y(k,62) +rxt(k,505)*y(k,138) + & - rxt(k,510)*y(k,149) +rxt(k,515)*y(k,151))*y(k,221) & - + (rxt(k,153)*y(k,217) +rxt(k,170)*y(k,133) +rxt(k,216)*y(k,56) + & - rxt(k,272)*y(k,73))*y(k,77) + (rxt(k,312)*y(k,54) + & - rxt(k,247)*y(k,85) +rxt(k,270)*y(k,81))*y(k,217) & - + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,232) +2.000_r8*rxt(k,33)*y(k,42) & - +rxt(k,39)*y(k,53) +rxt(k,100)*y(k,81) +rxt(k,104)*y(k,85) & - +rxt(k,105)*y(k,88) - loss(k,172) = (rxt(k,216)* y(k,56) +rxt(k,272)* y(k,73) +rxt(k,170)* y(k,133) & - +rxt(k,153)* y(k,217) +rxt(k,179)* y(k,221) + het_rates(k,77)) & + loss(k,230) = ((rxt(k,172) +rxt(k,173) +rxt(k,174))* y(k,90) +rxt(k,175) & + * y(k,134) +rxt(k,178)* y(k,135) + het_rates(k,76))* y(k,76) + prod(k,230) = (rxt(k,179)*y(k,77) +rxt(k,182)*y(k,133) +rxt(k,202)*y(k,112) + & + rxt(k,297)*y(k,42) +rxt(k,505)*y(k,138) +rxt(k,511)*y(k,149) + & + rxt(k,516)*y(k,151))*y(k,226) + (rxt(k,153)*y(k,222) + & + rxt(k,170)*y(k,133) +rxt(k,216)*y(k,56) +rxt(k,272)*y(k,73))*y(k,77) & + + (.330_r8*rxt(k,40) +rxt(k,41) +rxt(k,311)*y(k,222))*y(k,54) & + + (rxt(k,100) +rxt(k,270)*y(k,222))*y(k,81) + (rxt(k,104) + & + rxt(k,247)*y(k,222))*y(k,85) + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,239) & + +2.000_r8*rxt(k,34)*y(k,42) +rxt(k,39)*y(k,53) +rxt(k,105)*y(k,88) + loss(k,216) = (rxt(k,216)* y(k,56) +rxt(k,272)* y(k,73) +rxt(k,170)* y(k,133) & + +rxt(k,153)* y(k,222) +rxt(k,179)* y(k,226) + het_rates(k,77)) & * y(k,77) - prod(k,172) =rxt(k,34)*y(k,42) +rxt(k,313)*y(k,217)*y(k,54) & - +rxt(k,172)*y(k,203)*y(k,76) +rxt(k,1)*y(k,232) - loss(k,115) = (rxt(k,217)* y(k,56) +rxt(k,171)* y(k,133) +rxt(k,180) & - * y(k,221) + rxt(k,4) + het_rates(k,79))* y(k,79) - prod(k,115) = (.500_r8*rxt(k,521) +rxt(k,186)*y(k,203))*y(k,203) & - +rxt(k,185)*y(k,221)*y(k,221) - loss(k,42) = ( + rxt(k,136) + het_rates(k,80))* y(k,80) - prod(k,42) =rxt(k,518)*y(k,232)*y(k,153) - loss(k,145) = (rxt(k,263)* y(k,133) + (rxt(k,269) +rxt(k,270))* y(k,217) & - +rxt(k,264)* y(k,221) + rxt(k,100) + het_rates(k,81))* y(k,81) - prod(k,145) = (rxt(k,250)*y(k,42) +rxt(k,251)*y(k,203))*y(k,17) - loss(k,183) = ((rxt(k,554) +rxt(k,559) +rxt(k,564))* y(k,60) + (rxt(k,556) + & - rxt(k,561))* y(k,91) + (rxt(k,549) +rxt(k,555) +rxt(k,560))* y(k,92) & - +rxt(k,234)* y(k,133) + (rxt(k,246) +rxt(k,247))* y(k,217) & - +rxt(k,235)* y(k,221) + rxt(k,104) + het_rates(k,85))* y(k,85) - prod(k,183) = (rxt(k,215)*y(k,54) +rxt(k,277)*y(k,41) +rxt(k,279)*y(k,43) + & - 2.000_r8*rxt(k,282)*y(k,46) +rxt(k,284)*y(k,55) +rxt(k,214)*y(k,42) + & - rxt(k,216)*y(k,77) +rxt(k,217)*y(k,79) +rxt(k,218)*y(k,203) + & - rxt(k,236)*y(k,92) +rxt(k,326)*y(k,28))*y(k,56) +rxt(k,233)*y(k,221) & - *y(k,59) - loss(k,52) = (rxt(k,314)* y(k,217) +rxt(k,306)* y(k,221) + het_rates(k,86)) & + prod(k,216) = (1.440_r8*rxt(k,40) +rxt(k,312)*y(k,222))*y(k,54) +rxt(k,33) & + *y(k,42) +rxt(k,172)*y(k,90)*y(k,76) +rxt(k,1)*y(k,239) + loss(k,56) = (rxt(k,268)* y(k,222) + rxt(k,99) + het_rates(k,78))* y(k,78) + prod(k,56) = 0._r8 + loss(k,149) = (rxt(k,217)* y(k,56) +rxt(k,171)* y(k,133) +rxt(k,180) & + * y(k,226) + rxt(k,4) + het_rates(k,79))* y(k,79) + prod(k,149) =rxt(k,186)*y(k,90)*y(k,90) +rxt(k,185)*y(k,226)*y(k,226) + loss(k,62) = ( + rxt(k,136) + het_rates(k,80))* y(k,80) + prod(k,62) =rxt(k,518)*y(k,239)*y(k,153) + loss(k,172) = (rxt(k,263)* y(k,133) + (rxt(k,269) +rxt(k,270))* y(k,222) & + +rxt(k,264)* y(k,226) + rxt(k,100) + het_rates(k,81))* y(k,81) + prod(k,172) = (rxt(k,250)*y(k,42) +rxt(k,251)*y(k,90))*y(k,17) + loss(k,82) = (rxt(k,291)* y(k,222) +rxt(k,286)* y(k,226) + rxt(k,101) & + + het_rates(k,82))* y(k,82) + prod(k,82) = 0._r8 + loss(k,90) = (rxt(k,292)* y(k,222) +rxt(k,287)* y(k,226) + rxt(k,102) & + + het_rates(k,83))* y(k,83) + prod(k,90) = 0._r8 + loss(k,95) = (rxt(k,293)* y(k,222) +rxt(k,288)* y(k,226) + rxt(k,103) & + + het_rates(k,84))* y(k,84) + prod(k,95) = 0._r8 + loss(k,218) = ((rxt(k,568) +rxt(k,573) +rxt(k,578))* y(k,60) + (rxt(k,570) + & + rxt(k,575))* y(k,92) + (rxt(k,563) +rxt(k,569) +rxt(k,574))* y(k,93) & + +rxt(k,234)* y(k,133) + (rxt(k,246) +rxt(k,247))* y(k,222) & + +rxt(k,235)* y(k,226) + rxt(k,104) + het_rates(k,85))* y(k,85) + prod(k,218) = (rxt(k,214)*y(k,42) +rxt(k,215)*y(k,54) +rxt(k,216)*y(k,77) + & + rxt(k,217)*y(k,79) +rxt(k,218)*y(k,90) +rxt(k,236)*y(k,93) + & + rxt(k,277)*y(k,41) +rxt(k,279)*y(k,43) +2.000_r8*rxt(k,282)*y(k,46) + & + rxt(k,284)*y(k,55) +rxt(k,325)*y(k,28) +rxt(k,355)*y(k,31))*y(k,56) & + +rxt(k,233)*y(k,226)*y(k,59) + loss(k,75) = (rxt(k,313)* y(k,222) +rxt(k,305)* y(k,226) + het_rates(k,86)) & * y(k,86) - prod(k,52) = 0._r8 - loss(k,141) = (rxt(k,307)* y(k,221) + het_rates(k,87))* y(k,87) - prod(k,141) = (.370_r8*rxt(k,319)*y(k,25) +.120_r8*rxt(k,348)*y(k,29) + & + prod(k,75) = 0._r8 + loss(k,180) = (rxt(k,306)* y(k,226) + het_rates(k,87))* y(k,87) + prod(k,180) = (.370_r8*rxt(k,318)*y(k,25) +.120_r8*rxt(k,347)*y(k,29) + & .330_r8*rxt(k,378)*y(k,105) +.120_r8*rxt(k,392)*y(k,111) + & - .110_r8*rxt(k,425)*y(k,98) +.050_r8*rxt(k,480)*y(k,6) + & - .050_r8*rxt(k,483)*y(k,110))*y(k,135) + (rxt(k,308)*y(k,203) + & - rxt(k,310)*y(k,124))*y(k,204) +.350_r8*rxt(k,317)*y(k,221)*y(k,24) - loss(k,59) = ( + rxt(k,105) + het_rates(k,88))* y(k,88) - prod(k,59) = (rxt(k,271)*y(k,54) +rxt(k,272)*y(k,77) +rxt(k,273)*y(k,232) + & + .110_r8*rxt(k,425)*y(k,99) +.050_r8*rxt(k,480)*y(k,6) + & + .050_r8*rxt(k,483)*y(k,110))*y(k,135) + (rxt(k,307)*y(k,90) + & + rxt(k,309)*y(k,124))*y(k,205) +.350_r8*rxt(k,316)*y(k,226)*y(k,24) + loss(k,98) = ( + rxt(k,105) + het_rates(k,88))* y(k,88) + prod(k,98) = (rxt(k,271)*y(k,54) +rxt(k,272)*y(k,77) +rxt(k,273)*y(k,239) + & rxt(k,274)*y(k,89))*y(k,73) - loss(k,196) = (rxt(k,274)* y(k,73) +rxt(k,211)* y(k,221) + rxt(k,9) & + loss(k,228) = (rxt(k,274)* y(k,73) +rxt(k,211)* y(k,226) + rxt(k,9) & + het_rates(k,89))* y(k,89) - prod(k,196) = (rxt(k,552) +rxt(k,557) +rxt(k,563) +rxt(k,554)*y(k,85) + & - rxt(k,559)*y(k,85) +rxt(k,564)*y(k,85))*y(k,60) + (rxt(k,530) + & - rxt(k,295)*y(k,42) +rxt(k,328)*y(k,45) +rxt(k,354)*y(k,49) + & + prod(k,228) = (rxt(k,566) +rxt(k,571) +rxt(k,577) +rxt(k,568)*y(k,85) + & + rxt(k,573)*y(k,85) +rxt(k,578)*y(k,85))*y(k,60) + (rxt(k,530) + & + rxt(k,295)*y(k,42) +rxt(k,327)*y(k,45) +rxt(k,353)*y(k,49) + & rxt(k,502)*y(k,67))*y(k,126) + (2.000_r8*rxt(k,525) + & - 2.000_r8*rxt(k,548) +2.000_r8*rxt(k,551) +2.000_r8*rxt(k,562)) & - *y(k,114) + (rxt(k,550) +rxt(k,553) +rxt(k,558))*y(k,20) & - + (.500_r8*rxt(k,529) +rxt(k,210)*y(k,221))*y(k,125) +rxt(k,522) & - *y(k,93) +rxt(k,523)*y(k,99) +rxt(k,524)*y(k,100) +rxt(k,526) & + 2.000_r8*rxt(k,562) +2.000_r8*rxt(k,565) +2.000_r8*rxt(k,576)) & + *y(k,114) + (rxt(k,564) +rxt(k,567) +rxt(k,572))*y(k,20) & + + (.500_r8*rxt(k,529) +rxt(k,210)*y(k,226))*y(k,125) +rxt(k,522) & + *y(k,94) +rxt(k,523)*y(k,100) +rxt(k,524)*y(k,101) +rxt(k,526) & *y(k,115) +rxt(k,527)*y(k,116) +rxt(k,531)*y(k,128) +rxt(k,532) & *y(k,139) +rxt(k,533)*y(k,176) - loss(k,99) = (rxt(k,187)* y(k,221) + rxt(k,10) + rxt(k,11) + rxt(k,212) & - + het_rates(k,90))* y(k,90) - prod(k,99) =rxt(k,208)*y(k,203)*y(k,125) - loss(k,134) = ((rxt(k,556) +rxt(k,561))* y(k,85) +rxt(k,265)* y(k,133) & - + rxt(k,106) + het_rates(k,91))* y(k,91) - prod(k,134) = (rxt(k,550) +rxt(k,553) +rxt(k,558))*y(k,20) & - +rxt(k,257)*y(k,203)*y(k,19) - loss(k,146) = (rxt(k,236)* y(k,56) + (rxt(k,549) +rxt(k,555) +rxt(k,560)) & - * y(k,85) +rxt(k,237)* y(k,133) +rxt(k,238)* y(k,221) + rxt(k,107) & - + het_rates(k,92))* y(k,92) - prod(k,146) = (rxt(k,552) +rxt(k,557) +rxt(k,563) +rxt(k,230)*y(k,221)) & - *y(k,60) +rxt(k,225)*y(k,203)*y(k,59) - loss(k,162) = (rxt(k,371)* y(k,221) + rxt(k,46) + rxt(k,522) & + loss(k,231) = (rxt(k,251)* y(k,17) +rxt(k,257)* y(k,19) +rxt(k,294)* y(k,42) & + + (rxt(k,218) +rxt(k,219))* y(k,56) +rxt(k,225)* y(k,59) & + + (rxt(k,172) +rxt(k,173) +rxt(k,174))* y(k,76) + 2._r8*rxt(k,186) & + * y(k,90) +rxt(k,203)* y(k,124) +rxt(k,208)* y(k,125) +rxt(k,198) & + * y(k,126) +rxt(k,176)* y(k,133) +rxt(k,177)* y(k,135) +rxt(k,436) & + * y(k,189) +rxt(k,397)* y(k,190) +rxt(k,439)* y(k,192) +rxt(k,443) & + * y(k,194) +rxt(k,321)* y(k,195) +rxt(k,349)* y(k,196) +rxt(k,446) & + * y(k,197) +rxt(k,332)* y(k,198) +rxt(k,300)* y(k,199) +rxt(k,450) & + * y(k,200) +rxt(k,336)* y(k,204) +rxt(k,307)* y(k,205) +rxt(k,407) & + * y(k,206) +rxt(k,412)* y(k,207) +rxt(k,421)* y(k,208) +rxt(k,374) & + * y(k,211) +rxt(k,453)* y(k,212) +rxt(k,383)* y(k,213) +rxt(k,456) & + * y(k,214) +rxt(k,387)* y(k,215) +rxt(k,486)* y(k,221) +rxt(k,181) & + * y(k,226) +rxt(k,459)* y(k,228) +rxt(k,358)* y(k,229) +rxt(k,362) & + * y(k,230) +rxt(k,491)* y(k,231) +rxt(k,496)* y(k,232) +rxt(k,466) & + * y(k,233) +rxt(k,432)* y(k,235) +rxt(k,472)* y(k,236) +rxt(k,475) & + * y(k,238) + rxt(k,521) + het_rates(k,90))* y(k,90) + prod(k,231) = (rxt(k,180)*y(k,79) +rxt(k,183)*y(k,135) +rxt(k,201)*y(k,126) + & + rxt(k,232)*y(k,59) +rxt(k,262)*y(k,19) +rxt(k,280)*y(k,43) + & + rxt(k,283)*y(k,46) +rxt(k,302)*y(k,52) +rxt(k,305)*y(k,86) + & + rxt(k,306)*y(k,87) +rxt(k,314)*y(k,62) +.350_r8*rxt(k,316)*y(k,24) + & + rxt(k,323)*y(k,26) +rxt(k,329)*y(k,47) +rxt(k,340)*y(k,74) + & + rxt(k,341)*y(k,75) +rxt(k,356)*y(k,96) +rxt(k,371)*y(k,94) + & + .200_r8*rxt(k,380)*y(k,106) +.500_r8*rxt(k,391)*y(k,109) + & + .300_r8*rxt(k,416)*y(k,100) +rxt(k,417)*y(k,101) + & + rxt(k,424)*y(k,102) +rxt(k,428)*y(k,115) +rxt(k,429)*y(k,116) + & + .650_r8*rxt(k,438)*y(k,7) +.730_r8*rxt(k,449)*y(k,66) + & + .800_r8*rxt(k,461)*y(k,143) +.280_r8*rxt(k,469)*y(k,181) + & + .380_r8*rxt(k,471)*y(k,183) +.630_r8*rxt(k,477)*y(k,185) + & + .200_r8*rxt(k,501)*y(k,179) +rxt(k,507)*y(k,152) + & + .500_r8*rxt(k,517)*y(k,67))*y(k,226) + (rxt(k,301)*y(k,199) + & + rxt(k,309)*y(k,205) +rxt(k,322)*y(k,195) + & + .250_r8*rxt(k,337)*y(k,204) +rxt(k,350)*y(k,196) + & + rxt(k,359)*y(k,229) +rxt(k,369)*y(k,202) + & + .470_r8*rxt(k,376)*y(k,211) +rxt(k,398)*y(k,190) + & + .920_r8*rxt(k,408)*y(k,206) +.920_r8*rxt(k,414)*y(k,207) + & + rxt(k,422)*y(k,208) +rxt(k,433)*y(k,235) +rxt(k,440)*y(k,192) + & + rxt(k,445)*y(k,194) +.170_r8*rxt(k,451)*y(k,200) + & + .400_r8*rxt(k,454)*y(k,212) +.830_r8*rxt(k,457)*y(k,214) + & + rxt(k,460)*y(k,228) +rxt(k,467)*y(k,233) +rxt(k,473)*y(k,236) + & + rxt(k,476)*y(k,238) +.900_r8*rxt(k,492)*y(k,231) + & + .800_r8*rxt(k,497)*y(k,232))*y(k,124) + (rxt(k,221)*y(k,59) + & + 2.000_r8*rxt(k,298)*y(k,199) +rxt(k,320)*y(k,195) + & + .900_r8*rxt(k,331)*y(k,198) +rxt(k,348)*y(k,196) + & + .300_r8*rxt(k,361)*y(k,230) +.730_r8*rxt(k,373)*y(k,211) + & + rxt(k,382)*y(k,213) +rxt(k,406)*y(k,206) +rxt(k,411)*y(k,207) + & + 1.200_r8*rxt(k,420)*y(k,208) +.800_r8*rxt(k,431)*y(k,235) + & + .500_r8*rxt(k,485)*y(k,221) +rxt(k,490)*y(k,231) + & + rxt(k,495)*y(k,232))*y(k,199) + (.130_r8*rxt(k,318)*y(k,25) + & + .280_r8*rxt(k,347)*y(k,29) +.140_r8*rxt(k,378)*y(k,105) + & + .280_r8*rxt(k,392)*y(k,111) +.370_r8*rxt(k,425)*y(k,99) + & + .570_r8*rxt(k,480)*y(k,6) +.570_r8*rxt(k,483)*y(k,110))*y(k,135) & + + (rxt(k,295)*y(k,42) +.470_r8*rxt(k,375)*y(k,211) + & + rxt(k,409)*y(k,206) +rxt(k,415)*y(k,207) +rxt(k,423)*y(k,208) + & + rxt(k,434)*y(k,235))*y(k,126) + (.470_r8*rxt(k,372)*y(k,211) + & + rxt(k,405)*y(k,206) +rxt(k,410)*y(k,207) +rxt(k,419)*y(k,208) + & + rxt(k,430)*y(k,235))*y(k,198) + (rxt(k,214)*y(k,42) + & + rxt(k,217)*y(k,79) +rxt(k,279)*y(k,43) +rxt(k,282)*y(k,46))*y(k,56) & + + (.070_r8*rxt(k,450)*y(k,200) +.160_r8*rxt(k,453)*y(k,212) + & + .330_r8*rxt(k,456)*y(k,214))*y(k,90) + (rxt(k,250)*y(k,17) + & + rxt(k,296)*y(k,133))*y(k,42) + (rxt(k,11) +rxt(k,212))*y(k,91) & + + (1.340_r8*rxt(k,51) +.660_r8*rxt(k,52))*y(k,105) & + + (rxt(k,175)*y(k,76) +rxt(k,339)*y(k,203))*y(k,134) +rxt(k,20) & + *y(k,1) +.900_r8*rxt(k,21)*y(k,2) +rxt(k,22)*y(k,8) & + +1.500_r8*rxt(k,23)*y(k,9) +.560_r8*rxt(k,24)*y(k,10) +rxt(k,25) & + *y(k,11) +.600_r8*rxt(k,26)*y(k,12) +.600_r8*rxt(k,27)*y(k,13) & + +rxt(k,28)*y(k,14) +rxt(k,29)*y(k,23) +rxt(k,30)*y(k,27) +rxt(k,31) & + *y(k,30) +rxt(k,35)*y(k,45) +rxt(k,37)*y(k,49) +rxt(k,311)*y(k,222) & + *y(k,54) +2.000_r8*rxt(k,44)*y(k,74) +2.000_r8*rxt(k,45)*y(k,75) & + +rxt(k,171)*y(k,133)*y(k,79) +.670_r8*rxt(k,46)*y(k,94) +rxt(k,47) & + *y(k,95) +rxt(k,48)*y(k,96) +rxt(k,49)*y(k,102) +rxt(k,50)*y(k,103) & + +rxt(k,57)*y(k,116) +rxt(k,62)*y(k,144) +rxt(k,63)*y(k,147) & + +rxt(k,65)*y(k,174) +rxt(k,66)*y(k,175) +rxt(k,67)*y(k,176) & + +rxt(k,68)*y(k,177) +rxt(k,69)*y(k,178) +1.200_r8*rxt(k,70)*y(k,179) & + +rxt(k,71)*y(k,180) +rxt(k,73)*y(k,184) +rxt(k,74)*y(k,186) & + +1.200_r8*rxt(k,319)*y(k,195)*y(k,195) +rxt(k,338)*y(k,203) & + +rxt(k,308)*y(k,205) +rxt(k,413)*y(k,207) + loss(k,133) = (rxt(k,187)* y(k,226) + rxt(k,10) + rxt(k,11) + rxt(k,212) & + + het_rates(k,91))* y(k,91) + prod(k,133) =rxt(k,208)*y(k,125)*y(k,90) + loss(k,167) = ((rxt(k,570) +rxt(k,575))* y(k,85) +rxt(k,265)* y(k,133) & + + rxt(k,106) + het_rates(k,92))* y(k,92) + prod(k,167) = (rxt(k,564) +rxt(k,567) +rxt(k,572))*y(k,20) & + +rxt(k,257)*y(k,90)*y(k,19) + loss(k,173) = (rxt(k,236)* y(k,56) + (rxt(k,563) +rxt(k,569) +rxt(k,574)) & + * y(k,85) +rxt(k,237)* y(k,133) +rxt(k,238)* y(k,226) + rxt(k,107) & + het_rates(k,93))* y(k,93) - prod(k,162) = (rxt(k,370)*y(k,200) +rxt(k,377)*y(k,207))*y(k,124) & - + (.300_r8*rxt(k,416)*y(k,99) +.500_r8*rxt(k,417)*y(k,100))*y(k,221) - loss(k,60) = (rxt(k,402)* y(k,221) + rxt(k,47) + het_rates(k,94))* y(k,94) - prod(k,60) =rxt(k,413)*y(k,206) - loss(k,164) = (rxt(k,356)* y(k,221) + rxt(k,48) + het_rates(k,95))* y(k,95) - prod(k,164) = (.220_r8*rxt(k,372)*y(k,196) +.230_r8*rxt(k,373)*y(k,197) + & - .220_r8*rxt(k,375)*y(k,126) +.220_r8*rxt(k,376)*y(k,124))*y(k,207) & + prod(k,173) = (rxt(k,566) +rxt(k,571) +rxt(k,577) +rxt(k,230)*y(k,226)) & + *y(k,60) +rxt(k,225)*y(k,90)*y(k,59) + loss(k,202) = (rxt(k,371)* y(k,226) + rxt(k,46) + rxt(k,522) & + + het_rates(k,94))* y(k,94) + prod(k,202) = (rxt(k,370)*y(k,202) +rxt(k,377)*y(k,211))*y(k,124) & + + (.300_r8*rxt(k,416)*y(k,100) +.500_r8*rxt(k,417)*y(k,101)) & + *y(k,226) + loss(k,84) = (rxt(k,402)* y(k,226) + rxt(k,47) + het_rates(k,95))* y(k,95) + prod(k,84) =rxt(k,413)*y(k,207) + loss(k,203) = (rxt(k,356)* y(k,226) + rxt(k,48) + het_rates(k,96))* y(k,96) + prod(k,203) = (.220_r8*rxt(k,372)*y(k,198) +.230_r8*rxt(k,373)*y(k,199) + & + .220_r8*rxt(k,375)*y(k,126) +.220_r8*rxt(k,376)*y(k,124))*y(k,211) & + (.500_r8*rxt(k,360)*y(k,147) +.500_r8*rxt(k,391)*y(k,109) + & - .700_r8*rxt(k,416)*y(k,99) +.500_r8*rxt(k,417)*y(k,100))*y(k,221) & - + (.250_r8*rxt(k,430)*y(k,196) +.100_r8*rxt(k,431)*y(k,197) + & - .250_r8*rxt(k,433)*y(k,124) +.250_r8*rxt(k,434)*y(k,126))*y(k,229) & + .700_r8*rxt(k,416)*y(k,100) +.500_r8*rxt(k,417)*y(k,101))*y(k,226) & + + (.250_r8*rxt(k,430)*y(k,198) +.100_r8*rxt(k,431)*y(k,199) + & + .250_r8*rxt(k,433)*y(k,124) +.250_r8*rxt(k,434)*y(k,126))*y(k,235) & + (.050_r8*rxt(k,414)*y(k,124) +.050_r8*rxt(k,415)*y(k,126)) & - *y(k,206) +.170_r8*rxt(k,46)*y(k,93) +.200_r8*rxt(k,361)*y(k,225) & - *y(k,197) - loss(k,73) = (rxt(k,403)* y(k,221) + het_rates(k,96))* y(k,96) - prod(k,73) = (rxt(k,410)*y(k,196) +.750_r8*rxt(k,411)*y(k,197) + & - .870_r8*rxt(k,414)*y(k,124) +.950_r8*rxt(k,415)*y(k,126))*y(k,206) - loss(k,43) = (rxt(k,404)* y(k,221) + het_rates(k,97))* y(k,97) - prod(k,43) =.600_r8*rxt(k,427)*y(k,221)*y(k,103) - loss(k,148) = (rxt(k,418)* y(k,126) +rxt(k,425)* y(k,135) +rxt(k,426) & - * y(k,221) + het_rates(k,98))* y(k,98) - prod(k,148) = 0._r8 - loss(k,119) = (rxt(k,416)* y(k,221) + rxt(k,523) + het_rates(k,99))* y(k,99) - prod(k,119) =.080_r8*rxt(k,408)*y(k,205)*y(k,124) - loss(k,108) = (rxt(k,417)* y(k,221) + rxt(k,524) + het_rates(k,100)) & + *y(k,207) +.170_r8*rxt(k,46)*y(k,94) +.200_r8*rxt(k,361)*y(k,230) & + *y(k,199) + loss(k,105) = (rxt(k,403)* y(k,226) + het_rates(k,97))* y(k,97) + prod(k,105) = (rxt(k,410)*y(k,198) +.750_r8*rxt(k,411)*y(k,199) + & + .870_r8*rxt(k,414)*y(k,124) +.950_r8*rxt(k,415)*y(k,126))*y(k,207) + loss(k,63) = (rxt(k,404)* y(k,226) + het_rates(k,98))* y(k,98) + prod(k,63) =.600_r8*rxt(k,427)*y(k,226)*y(k,103) + loss(k,178) = (rxt(k,418)* y(k,126) +rxt(k,425)* y(k,135) +rxt(k,426) & + * y(k,226) + het_rates(k,99))* y(k,99) + prod(k,178) = 0._r8 + loss(k,146) = (rxt(k,416)* y(k,226) + rxt(k,523) + het_rates(k,100)) & * y(k,100) - prod(k,108) =.080_r8*rxt(k,414)*y(k,206)*y(k,124) - loss(k,173) = (rxt(k,422)* y(k,124) +rxt(k,423)* y(k,126) +rxt(k,419) & - * y(k,196) +rxt(k,420)* y(k,197) +rxt(k,421)* y(k,203) & - + het_rates(k,101))* y(k,101) - prod(k,173) =rxt(k,418)*y(k,126)*y(k,98) - loss(k,88) = (rxt(k,424)* y(k,221) + rxt(k,49) + het_rates(k,102))* y(k,102) - prod(k,88) =rxt(k,421)*y(k,203)*y(k,101) - loss(k,127) = (rxt(k,427)* y(k,221) + rxt(k,50) + het_rates(k,103))* y(k,103) - prod(k,127) = (rxt(k,407)*y(k,205) +rxt(k,412)*y(k,206))*y(k,203) +rxt(k,49) & + prod(k,146) =.080_r8*rxt(k,408)*y(k,206)*y(k,124) + loss(k,142) = (rxt(k,417)* y(k,226) + rxt(k,524) + het_rates(k,101)) & + * y(k,101) + prod(k,142) =.080_r8*rxt(k,414)*y(k,207)*y(k,124) + loss(k,121) = (rxt(k,424)* y(k,226) + rxt(k,49) + het_rates(k,102))* y(k,102) + prod(k,121) =rxt(k,421)*y(k,208)*y(k,90) + loss(k,162) = (rxt(k,427)* y(k,226) + rxt(k,50) + het_rates(k,103))* y(k,103) + prod(k,162) = (rxt(k,407)*y(k,206) +rxt(k,412)*y(k,207))*y(k,90) +rxt(k,49) & *y(k,102) - loss(k,34) = (rxt(k,541)* y(k,221) + het_rates(k,104))* y(k,104) - prod(k,34) = 0._r8 - loss(k,174) = (rxt(k,378)* y(k,135) +rxt(k,379)* y(k,221) + rxt(k,51) & + loss(k,48) = (rxt(k,549)* y(k,226) + het_rates(k,104))* y(k,104) + prod(k,48) = 0._r8 + loss(k,207) = (rxt(k,378)* y(k,135) +rxt(k,379)* y(k,226) + rxt(k,51) & + rxt(k,52) + het_rates(k,105))* y(k,105) - prod(k,174) = (.390_r8*rxt(k,405)*y(k,196) +.310_r8*rxt(k,406)*y(k,197) + & - .360_r8*rxt(k,408)*y(k,124) +.400_r8*rxt(k,409)*y(k,126))*y(k,205) & - +.300_r8*rxt(k,425)*y(k,135)*y(k,98) +.288_r8*rxt(k,50)*y(k,103) - loss(k,74) = (rxt(k,380)* y(k,221) + het_rates(k,106))* y(k,106) - prod(k,74) =rxt(k,374)*y(k,207)*y(k,203) - loss(k,107) = (rxt(k,389)* y(k,221) + rxt(k,53) + het_rates(k,107))* y(k,107) - prod(k,107) =.800_r8*rxt(k,20)*y(k,1) +.800_r8*rxt(k,21)*y(k,2) & + prod(k,207) = (.390_r8*rxt(k,405)*y(k,198) +.310_r8*rxt(k,406)*y(k,199) + & + .360_r8*rxt(k,408)*y(k,124) +.400_r8*rxt(k,409)*y(k,126))*y(k,206) & + +.300_r8*rxt(k,425)*y(k,135)*y(k,99) +.300_r8*rxt(k,50)*y(k,103) + loss(k,103) = (rxt(k,380)* y(k,226) + het_rates(k,106))* y(k,106) + prod(k,103) =rxt(k,374)*y(k,211)*y(k,90) + loss(k,136) = (rxt(k,389)* y(k,226) + rxt(k,53) + het_rates(k,107))* y(k,107) + prod(k,136) =.800_r8*rxt(k,20)*y(k,1) +.800_r8*rxt(k,21)*y(k,2) & +.800_r8*rxt(k,398)*y(k,190)*y(k,124) - loss(k,75) = (rxt(k,390)* y(k,221) + rxt(k,54) + het_rates(k,108))* y(k,108) - prod(k,75) =.800_r8*rxt(k,387)*y(k,211)*y(k,203) - loss(k,114) = (rxt(k,391)* y(k,221) + rxt(k,55) + rxt(k,395) & + loss(k,104) = (rxt(k,390)* y(k,226) + rxt(k,54) + het_rates(k,108))* y(k,108) + prod(k,104) =.800_r8*rxt(k,387)*y(k,215)*y(k,90) + loss(k,145) = (rxt(k,391)* y(k,226) + rxt(k,55) + rxt(k,395) & + het_rates(k,109))* y(k,109) - prod(k,114) =rxt(k,394)*y(k,209)*y(k,125) - loss(k,151) = (rxt(k,482)* y(k,126) +rxt(k,483)* y(k,135) +rxt(k,484) & - * y(k,221) + het_rates(k,110))* y(k,110) - prod(k,151) = 0._r8 - loss(k,179) = (rxt(k,392)* y(k,135) +rxt(k,393)* y(k,221) + rxt(k,56) & + prod(k,145) =rxt(k,394)*y(k,213)*y(k,125) + loss(k,188) = (rxt(k,482)* y(k,126) +rxt(k,483)* y(k,135) +rxt(k,484) & + * y(k,226) + het_rates(k,110))* y(k,110) + prod(k,188) = 0._r8 + loss(k,212) = (rxt(k,392)* y(k,135) +rxt(k,393)* y(k,226) + rxt(k,56) & + het_rates(k,111))* y(k,111) - prod(k,179) = (.610_r8*rxt(k,405)*y(k,196) +.440_r8*rxt(k,406)*y(k,197) + & - .560_r8*rxt(k,408)*y(k,124) +.600_r8*rxt(k,409)*y(k,126))*y(k,205) & - +.200_r8*rxt(k,425)*y(k,135)*y(k,98) +.402_r8*rxt(k,50)*y(k,103) - loss(k,144) = (rxt(k,190)* y(k,124) + (rxt(k,191) +rxt(k,192) +rxt(k,193)) & - * y(k,125) +rxt(k,194)* y(k,134) +rxt(k,574)* y(k,220) +rxt(k,202) & - * y(k,221) + rxt(k,111) + het_rates(k,112))* y(k,112) - prod(k,144) = (rxt(k,188)*y(k,212) +rxt(k,571)*y(k,215))*y(k,133) & - + (.200_r8*rxt(k,565)*y(k,214) +1.100_r8*rxt(k,567)*y(k,213)) & - *y(k,199) +rxt(k,15)*y(k,124) +rxt(k,572)*y(k,215)*y(k,134) & - +rxt(k,578)*y(k,222) - loss(k,68) = ( + rxt(k,13) + rxt(k,14) + rxt(k,213) + rxt(k,525) + rxt(k,548) & - + rxt(k,551) + rxt(k,562) + het_rates(k,114))* y(k,114) - prod(k,68) =rxt(k,209)*y(k,126)*y(k,125) - loss(k,83) = (rxt(k,428)* y(k,221) + rxt(k,526) + het_rates(k,115))* y(k,115) - prod(k,83) =.200_r8*rxt(k,420)*y(k,197)*y(k,101) - loss(k,159) = (rxt(k,429)* y(k,221) + rxt(k,57) + rxt(k,527) & + prod(k,212) = (.610_r8*rxt(k,405)*y(k,198) +.440_r8*rxt(k,406)*y(k,199) + & + .560_r8*rxt(k,408)*y(k,124) +.600_r8*rxt(k,409)*y(k,126))*y(k,206) & + +.200_r8*rxt(k,425)*y(k,135)*y(k,99) +.700_r8*rxt(k,50)*y(k,103) + loss(k,186) = (rxt(k,190)* y(k,124) + (rxt(k,191) +rxt(k,192) +rxt(k,193)) & + * y(k,125) +rxt(k,194)* y(k,134) +rxt(k,588)* y(k,225) +rxt(k,202) & + * y(k,226) + rxt(k,111) + het_rates(k,112))* y(k,112) + prod(k,186) = (rxt(k,188)*y(k,217) +rxt(k,585)*y(k,220))*y(k,133) & + + (.200_r8*rxt(k,579)*y(k,219) +1.100_r8*rxt(k,581)*y(k,218)) & + *y(k,201) +rxt(k,15)*y(k,124) +rxt(k,586)*y(k,220)*y(k,134) & + +rxt(k,592)*y(k,227) + loss(k,91) = ((rxt(k,206) +rxt(k,207))* y(k,222) + rxt(k,12) & + + het_rates(k,113))* y(k,113) + prod(k,91) =rxt(k,191)*y(k,125)*y(k,112) + loss(k,96) = ( + rxt(k,13) + rxt(k,14) + rxt(k,213) + rxt(k,525) + rxt(k,562) & + + rxt(k,565) + rxt(k,576) + het_rates(k,114))* y(k,114) + prod(k,96) =rxt(k,209)*y(k,126)*y(k,125) + loss(k,114) = (rxt(k,428)* y(k,226) + rxt(k,526) + het_rates(k,115)) & + * y(k,115) + prod(k,114) =.200_r8*rxt(k,420)*y(k,208)*y(k,199) + loss(k,196) = (rxt(k,429)* y(k,226) + rxt(k,57) + rxt(k,527) & + het_rates(k,116))* y(k,116) - prod(k,159) = (rxt(k,419)*y(k,196) +.800_r8*rxt(k,420)*y(k,197) + & - rxt(k,422)*y(k,124) +rxt(k,423)*y(k,126))*y(k,101) - loss(k,6) = ( + het_rates(k,117))* y(k,117) - prod(k,6) = 0._r8 - loss(k,7) = ( + het_rates(k,118))* y(k,118) - prod(k,7) = 0._r8 - loss(k,8) = ( + het_rates(k,119))* y(k,119) - prod(k,8) = 0._r8 - loss(k,37) = (rxt(k,519)* y(k,221) + het_rates(k,120))* y(k,120) - prod(k,37) = 0._r8 - loss(k,9) = ( + rxt(k,528) + het_rates(k,121))* y(k,121) - prod(k,9) = 0._r8 - loss(k,187) = (rxt(k,258)* y(k,19) +rxt(k,226)* y(k,59) +rxt(k,422)* y(k,101) & + prod(k,196) = (rxt(k,419)*y(k,198) +.800_r8*rxt(k,420)*y(k,199) + & + rxt(k,422)*y(k,124) +rxt(k,423)*y(k,126))*y(k,208) + loss(k,10) = ( + het_rates(k,117))* y(k,117) + prod(k,10) = 0._r8 + loss(k,11) = ( + het_rates(k,118))* y(k,118) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,119))* y(k,119) + prod(k,12) = 0._r8 + loss(k,53) = (rxt(k,519)* y(k,226) + het_rates(k,120))* y(k,120) + prod(k,53) = 0._r8 + loss(k,13) = ( + rxt(k,528) + het_rates(k,121))* y(k,121) + prod(k,13) = 0._r8 + loss(k,14) = ( + rxt(k,596) + het_rates(k,122))* y(k,122) + prod(k,14) = 0._r8 + loss(k,15) = ( + rxt(k,595) + het_rates(k,123))* y(k,123) + prod(k,15) = 0._r8 + loss(k,229) = (rxt(k,258)* y(k,19) +rxt(k,226)* y(k,59) +rxt(k,203)* y(k,90) & +rxt(k,190)* y(k,112) +rxt(k,199)* y(k,126) +rxt(k,205)* y(k,133) & +rxt(k,204)* y(k,135) +rxt(k,437)* y(k,189) + (rxt(k,398) + & - rxt(k,399))* y(k,190) +rxt(k,440)* y(k,191) +rxt(k,445)* y(k,192) & - +rxt(k,323)* y(k,193) +rxt(k,351)* y(k,194) +rxt(k,447)* y(k,195) & - +rxt(k,334)* y(k,196) +rxt(k,301)* y(k,197) +rxt(k,451)* y(k,198) & - + (rxt(k,369) +rxt(k,370))* y(k,200) +rxt(k,338)* y(k,202) & - +rxt(k,203)* y(k,203) +rxt(k,310)* y(k,204) +rxt(k,408)* y(k,205) & - +rxt(k,414)* y(k,206) + (rxt(k,376) +rxt(k,377))* y(k,207) & - +rxt(k,454)* y(k,208) +rxt(k,385)* y(k,209) +rxt(k,457)* y(k,210) & - +rxt(k,388)* y(k,211) +rxt(k,487)* y(k,216) +rxt(k,576)* y(k,220) & - +rxt(k,460)* y(k,223) +rxt(k,359)* y(k,224) +rxt(k,363)* y(k,225) & - +rxt(k,492)* y(k,226) +rxt(k,497)* y(k,227) +rxt(k,467)* y(k,228) & - +rxt(k,433)* y(k,229) +rxt(k,473)* y(k,230) +rxt(k,476)* y(k,231) & + rxt(k,399))* y(k,190) +rxt(k,440)* y(k,192) +rxt(k,445)* y(k,194) & + +rxt(k,322)* y(k,195) +rxt(k,350)* y(k,196) +rxt(k,447)* y(k,197) & + +rxt(k,333)* y(k,198) +rxt(k,301)* y(k,199) +rxt(k,451)* y(k,200) & + + (rxt(k,369) +rxt(k,370))* y(k,202) +rxt(k,337)* y(k,204) & + +rxt(k,309)* y(k,205) +rxt(k,408)* y(k,206) +rxt(k,414)* y(k,207) & + +rxt(k,422)* y(k,208) + (rxt(k,376) +rxt(k,377))* y(k,211) & + +rxt(k,454)* y(k,212) +rxt(k,385)* y(k,213) +rxt(k,457)* y(k,214) & + +rxt(k,388)* y(k,215) +rxt(k,487)* y(k,221) +rxt(k,590)* y(k,225) & + +rxt(k,460)* y(k,228) +rxt(k,359)* y(k,229) +rxt(k,363)* y(k,230) & + +rxt(k,492)* y(k,231) +rxt(k,497)* y(k,232) +rxt(k,467)* y(k,233) & + +rxt(k,433)* y(k,235) +rxt(k,473)* y(k,236) +rxt(k,476)* y(k,238) & + rxt(k,15) + rxt(k,16) + het_rates(k,124))* y(k,124) - prod(k,187) = (rxt(k,17) +.500_r8*rxt(k,529) +2.000_r8*rxt(k,192)*y(k,112) + & - rxt(k,195)*y(k,133) +rxt(k,511)*y(k,151))*y(k,125) & - + (rxt(k,194)*y(k,134) +rxt(k,202)*y(k,221))*y(k,112) & - +2.000_r8*rxt(k,206)*y(k,217)*y(k,113) +rxt(k,14)*y(k,114) & - +rxt(k,19)*y(k,126) +rxt(k,189)*y(k,212)*y(k,134) +rxt(k,575) & - *y(k,220) - loss(k,197) = (rxt(k,259)* y(k,19) +rxt(k,228)* y(k,59) + (rxt(k,191) + & - rxt(k,192) +rxt(k,193))* y(k,112) +rxt(k,209)* y(k,126) & - + (rxt(k,195) +rxt(k,197))* y(k,133) +rxt(k,196)* y(k,135) & - +rxt(k,462)* y(k,142) +rxt(k,511)* y(k,151) +rxt(k,465)* y(k,189) & - +rxt(k,345)* y(k,196) +rxt(k,452)* y(k,198) +rxt(k,208)* y(k,203) & - +rxt(k,455)* y(k,208) +rxt(k,394)* y(k,209) +rxt(k,458)* y(k,210) & - +rxt(k,210)* y(k,221) + rxt(k,17) + rxt(k,529) + het_rates(k,125)) & - * y(k,125) - prod(k,197) = (2.000_r8*rxt(k,199)*y(k,126) +rxt(k,203)*y(k,203) + & + prod(k,229) = (rxt(k,17) +.500_r8*rxt(k,529) +2.000_r8*rxt(k,192)*y(k,112) + & + rxt(k,195)*y(k,133) +rxt(k,512)*y(k,151))*y(k,125) & + + (rxt(k,194)*y(k,134) +rxt(k,202)*y(k,226))*y(k,112) & + +2.000_r8*rxt(k,206)*y(k,222)*y(k,113) +rxt(k,14)*y(k,114) & + +rxt(k,19)*y(k,126) +rxt(k,189)*y(k,217)*y(k,134) +rxt(k,589) & + *y(k,225) + loss(k,225) = (rxt(k,259)* y(k,19) +rxt(k,228)* y(k,59) +rxt(k,208)* y(k,90) & + + (rxt(k,191) +rxt(k,192) +rxt(k,193))* y(k,112) +rxt(k,209) & + * y(k,126) + (rxt(k,195) +rxt(k,197))* y(k,133) +rxt(k,196)* y(k,135) & + +rxt(k,462)* y(k,142) +rxt(k,512)* y(k,151) +rxt(k,465)* y(k,189) & + +rxt(k,344)* y(k,198) +rxt(k,452)* y(k,200) +rxt(k,455)* y(k,212) & + +rxt(k,394)* y(k,213) +rxt(k,458)* y(k,214) +rxt(k,210)* y(k,226) & + + rxt(k,17) + rxt(k,529) + het_rates(k,125))* y(k,125) + prod(k,225) = (2.000_r8*rxt(k,199)*y(k,126) +rxt(k,203)*y(k,90) + & rxt(k,204)*y(k,135) +rxt(k,205)*y(k,133) +rxt(k,226)*y(k,59) + & - rxt(k,258)*y(k,19) +rxt(k,301)*y(k,197) +rxt(k,310)*y(k,204) + & - rxt(k,323)*y(k,193) +rxt(k,334)*y(k,196) +rxt(k,338)*y(k,202) + & - rxt(k,351)*y(k,194) +rxt(k,359)*y(k,224) +rxt(k,363)*y(k,225) + & - rxt(k,369)*y(k,200) +rxt(k,376)*y(k,207) +rxt(k,385)*y(k,209) + & - rxt(k,388)*y(k,211) +rxt(k,398)*y(k,190) + & - .920_r8*rxt(k,408)*y(k,205) +.920_r8*rxt(k,414)*y(k,206) + & - rxt(k,422)*y(k,101) +rxt(k,433)*y(k,229) +rxt(k,437)*y(k,189) + & - rxt(k,440)*y(k,191) +rxt(k,445)*y(k,192) +rxt(k,447)*y(k,195) + & - rxt(k,451)*y(k,198) +rxt(k,454)*y(k,208) +rxt(k,457)*y(k,210) + & - rxt(k,460)*y(k,223) +rxt(k,467)*y(k,228) +rxt(k,473)*y(k,230) + & - rxt(k,476)*y(k,231) +1.600_r8*rxt(k,487)*y(k,216) + & - .900_r8*rxt(k,492)*y(k,226) +.800_r8*rxt(k,497)*y(k,227))*y(k,124) & - + (rxt(k,18) +rxt(k,198)*y(k,203) +rxt(k,200)*y(k,133) + & - rxt(k,201)*y(k,221) +rxt(k,367)*y(k,16) +rxt(k,375)*y(k,207) + & - rxt(k,386)*y(k,209) +rxt(k,409)*y(k,205) +rxt(k,415)*y(k,206) + & - rxt(k,423)*y(k,101) +rxt(k,434)*y(k,229) + & - 2.000_r8*rxt(k,488)*y(k,216))*y(k,126) + (rxt(k,187)*y(k,90) + & - rxt(k,357)*y(k,127) +rxt(k,396)*y(k,1) +.700_r8*rxt(k,416)*y(k,99) + & - rxt(k,494)*y(k,176))*y(k,221) + (rxt(k,11) +rxt(k,212))*y(k,90) & + rxt(k,258)*y(k,19) +rxt(k,301)*y(k,199) +rxt(k,309)*y(k,205) + & + rxt(k,322)*y(k,195) +rxt(k,333)*y(k,198) +rxt(k,337)*y(k,204) + & + rxt(k,350)*y(k,196) +rxt(k,359)*y(k,229) +rxt(k,363)*y(k,230) + & + rxt(k,369)*y(k,202) +rxt(k,376)*y(k,211) +rxt(k,385)*y(k,213) + & + rxt(k,388)*y(k,215) +rxt(k,398)*y(k,190) + & + .920_r8*rxt(k,408)*y(k,206) +.920_r8*rxt(k,414)*y(k,207) + & + rxt(k,422)*y(k,208) +rxt(k,433)*y(k,235) +rxt(k,437)*y(k,189) + & + rxt(k,440)*y(k,192) +rxt(k,445)*y(k,194) +rxt(k,447)*y(k,197) + & + rxt(k,451)*y(k,200) +rxt(k,454)*y(k,212) +rxt(k,457)*y(k,214) + & + rxt(k,460)*y(k,228) +rxt(k,467)*y(k,233) +rxt(k,473)*y(k,236) + & + rxt(k,476)*y(k,238) +1.600_r8*rxt(k,487)*y(k,221) + & + .900_r8*rxt(k,492)*y(k,231) +.800_r8*rxt(k,497)*y(k,232))*y(k,124) & + + (rxt(k,18) +rxt(k,198)*y(k,90) +rxt(k,200)*y(k,133) + & + rxt(k,201)*y(k,226) +rxt(k,367)*y(k,16) +rxt(k,375)*y(k,211) + & + rxt(k,386)*y(k,213) +rxt(k,409)*y(k,206) +rxt(k,415)*y(k,207) + & + rxt(k,423)*y(k,208) +rxt(k,434)*y(k,235) + & + 2.000_r8*rxt(k,488)*y(k,221))*y(k,126) + (rxt(k,187)*y(k,91) + & + rxt(k,357)*y(k,127) +rxt(k,396)*y(k,1) +.700_r8*rxt(k,416)*y(k,100) + & + rxt(k,494)*y(k,176))*y(k,226) + (rxt(k,11) +rxt(k,212))*y(k,91) & + (rxt(k,55) +rxt(k,395))*y(k,109) + (rxt(k,13) +rxt(k,213)) & - *y(k,114) + (.600_r8*rxt(k,61) +rxt(k,346))*y(k,140) +rxt(k,20) & + *y(k,114) + (.600_r8*rxt(k,61) +rxt(k,345))*y(k,140) +rxt(k,20) & *y(k,1) +rxt(k,77)*y(k,20) +rxt(k,96)*y(k,60) +rxt(k,9)*y(k,89) & - +rxt(k,46)*y(k,93) +rxt(k,49)*y(k,102) +rxt(k,57)*y(k,116) & + +rxt(k,46)*y(k,94) +rxt(k,49)*y(k,102) +rxt(k,57)*y(k,116) & +rxt(k,58)*y(k,127) +rxt(k,59)*y(k,128) +rxt(k,60)*y(k,139) & +rxt(k,470)*y(k,141) +rxt(k,67)*y(k,176) & - +.500_r8*rxt(k,485)*y(k,216)*y(k,197) - loss(k,194) = (rxt(k,479)* y(k,6) +rxt(k,367)* y(k,16) +rxt(k,347)* y(k,29) & - +rxt(k,295)* y(k,42) +rxt(k,328)* y(k,45) +rxt(k,354)* y(k,49) & - +rxt(k,502)* y(k,67) +rxt(k,418)* y(k,98) +rxt(k,423)* y(k,101) & + +.500_r8*rxt(k,485)*y(k,221)*y(k,199) + loss(k,226) = (rxt(k,479)* y(k,6) +rxt(k,367)* y(k,16) +rxt(k,346)* y(k,29) & + +rxt(k,295)* y(k,42) +rxt(k,327)* y(k,45) +rxt(k,353)* y(k,49) & + +rxt(k,502)* y(k,67) +rxt(k,198)* y(k,90) +rxt(k,418)* y(k,99) & +rxt(k,482)* y(k,110) +rxt(k,199)* y(k,124) +rxt(k,209)* y(k,125) & - +rxt(k,200)* y(k,133) +rxt(k,499)* y(k,178) +rxt(k,198)* y(k,203) & - +rxt(k,409)* y(k,205) +rxt(k,415)* y(k,206) +rxt(k,375)* y(k,207) & - +rxt(k,386)* y(k,209) +rxt(k,488)* y(k,216) +rxt(k,201)* y(k,221) & - +rxt(k,434)* y(k,229) + rxt(k,18) + rxt(k,19) + rxt(k,530) & + +rxt(k,200)* y(k,133) +rxt(k,499)* y(k,178) +rxt(k,409)* y(k,206) & + +rxt(k,415)* y(k,207) +rxt(k,423)* y(k,208) +rxt(k,375)* y(k,211) & + +rxt(k,386)* y(k,213) +rxt(k,488)* y(k,221) +rxt(k,201)* y(k,226) & + +rxt(k,434)* y(k,235) + rxt(k,18) + rxt(k,19) + rxt(k,530) & + het_rates(k,126))* y(k,126) - prod(k,194) = (rxt(k,95) +rxt(k,227)*y(k,56) +rxt(k,229)*y(k,133) + & - rxt(k,230)*y(k,221))*y(k,60) + (rxt(k,13) +rxt(k,14) +rxt(k,213)) & - *y(k,114) + (rxt(k,211)*y(k,89) +rxt(k,343)*y(k,140) + & - .500_r8*rxt(k,391)*y(k,109))*y(k,221) + (rxt(k,78) + & + prod(k,226) = (rxt(k,95) +rxt(k,227)*y(k,56) +rxt(k,229)*y(k,133) + & + rxt(k,230)*y(k,226))*y(k,60) + (rxt(k,13) +rxt(k,14) +rxt(k,213)) & + *y(k,114) + (rxt(k,211)*y(k,89) +rxt(k,342)*y(k,140) + & + .500_r8*rxt(k,391)*y(k,109))*y(k,226) + (rxt(k,78) + & rxt(k,260)*y(k,133))*y(k,20) + (rxt(k,196)*y(k,135) + & rxt(k,197)*y(k,133))*y(k,125) +rxt(k,274)*y(k,89)*y(k,73) +rxt(k,10) & - *y(k,90) +.400_r8*rxt(k,61)*y(k,140) - loss(k,147) = (rxt(k,357)* y(k,221) + rxt(k,58) + het_rates(k,127))* y(k,127) - prod(k,147) = (.500_r8*rxt(k,417)*y(k,100) +rxt(k,424)*y(k,102) + & - rxt(k,428)*y(k,115) +rxt(k,429)*y(k,116))*y(k,221) & - +rxt(k,347)*y(k,126)*y(k,29) - loss(k,86) = (rxt(k,489)* y(k,221) + rxt(k,59) + rxt(k,531) & + *y(k,91) +.400_r8*rxt(k,61)*y(k,140) + loss(k,177) = (rxt(k,357)* y(k,226) + rxt(k,58) + het_rates(k,127))* y(k,127) + prod(k,177) = (.500_r8*rxt(k,417)*y(k,101) +rxt(k,424)*y(k,102) + & + rxt(k,428)*y(k,115) +rxt(k,429)*y(k,116))*y(k,226) & + +rxt(k,346)*y(k,126)*y(k,29) + loss(k,117) = (rxt(k,489)* y(k,226) + rxt(k,59) + rxt(k,531) & + het_rates(k,128))* y(k,128) - prod(k,86) =rxt(k,486)*y(k,216)*y(k,203) - loss(k,10) = ( + het_rates(k,129))* y(k,129) - prod(k,10) = 0._r8 - loss(k,11) = ( + het_rates(k,130))* y(k,130) - prod(k,11) = 0._r8 - loss(k,12) = ( + het_rates(k,131))* y(k,131) - prod(k,12) = 0._r8 - loss(k,13) = ( + het_rates(k,132))* y(k,132) - prod(k,13) = 0._r8 - loss(k,192) = (rxt(k,261)* y(k,19) +rxt(k,260)* y(k,20) +rxt(k,296)* y(k,42) & + prod(k,117) =rxt(k,486)*y(k,221)*y(k,90) + loss(k,16) = ( + het_rates(k,129))* y(k,129) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,130))* y(k,130) + prod(k,17) = 0._r8 + loss(k,18) = ( + het_rates(k,131))* y(k,131) + prod(k,18) = 0._r8 + loss(k,19) = ( + het_rates(k,132))* y(k,132) + prod(k,19) = 0._r8 + loss(k,234) = (rxt(k,261)* y(k,19) +rxt(k,260)* y(k,20) +rxt(k,296)* y(k,42) & +rxt(k,231)* y(k,59) +rxt(k,229)* y(k,60) +rxt(k,170)* y(k,77) & +rxt(k,171)* y(k,79) +rxt(k,263)* y(k,81) +rxt(k,234)* y(k,85) & - +rxt(k,265)* y(k,91) +rxt(k,237)* y(k,92) +rxt(k,205)* y(k,124) & - + (rxt(k,195) +rxt(k,197))* y(k,125) +rxt(k,200)* y(k,126) & - + 2._r8*rxt(k,168)* y(k,133) +rxt(k,169)* y(k,134) +rxt(k,167) & - * y(k,135) +rxt(k,504)* y(k,138) +rxt(k,176)* y(k,203) & - + (rxt(k,569) +rxt(k,570))* y(k,213) +rxt(k,571)* y(k,215) & - +rxt(k,182)* y(k,221) + rxt(k,120) + rxt(k,121) + rxt(k,122) & + +rxt(k,176)* y(k,90) +rxt(k,265)* y(k,92) +rxt(k,237)* y(k,93) & + +rxt(k,205)* y(k,124) + (rxt(k,195) +rxt(k,197))* y(k,125) & + +rxt(k,200)* y(k,126) + 2._r8*rxt(k,168)* y(k,133) +rxt(k,169) & + * y(k,134) +rxt(k,167)* y(k,135) +rxt(k,504)* y(k,138) & + + (rxt(k,583) +rxt(k,584))* y(k,218) +rxt(k,585)* y(k,220) & + +rxt(k,182)* y(k,226) + rxt(k,120) + rxt(k,121) + rxt(k,122) & + rxt(k,123) + rxt(k,124) + rxt(k,125) + het_rates(k,133))* y(k,133) - prod(k,192) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,127) +rxt(k,128) + & + prod(k,234) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,127) +rxt(k,128) + & rxt(k,129) +rxt(k,131) +rxt(k,132) +rxt(k,133) +2.000_r8*rxt(k,134) + & - 2.000_r8*rxt(k,135) +rxt(k,156)*y(k,217) +rxt(k,157)*y(k,217) + & - rxt(k,194)*y(k,112) +rxt(k,506)*y(k,149) +rxt(k,512)*y(k,151) + & - rxt(k,573)*y(k,215) +rxt(k,579)*y(k,222))*y(k,134) & - + (rxt(k,190)*y(k,124) +rxt(k,191)*y(k,125) +rxt(k,574)*y(k,220)) & - *y(k,112) + (rxt(k,565)*y(k,214) +1.150_r8*rxt(k,566)*y(k,220)) & - *y(k,199) +rxt(k,76)*y(k,19) +rxt(k,94)*y(k,59) +rxt(k,174)*y(k,203) & + 2.000_r8*rxt(k,135) +rxt(k,156)*y(k,222) +rxt(k,157)*y(k,222) + & + rxt(k,194)*y(k,112) +rxt(k,506)*y(k,149) +rxt(k,513)*y(k,151) + & + rxt(k,587)*y(k,220) +rxt(k,593)*y(k,227))*y(k,134) & + + (rxt(k,190)*y(k,124) +rxt(k,191)*y(k,125) +rxt(k,588)*y(k,225)) & + *y(k,112) + (rxt(k,42) +rxt(k,110))*y(k,63) + (rxt(k,579)*y(k,219) + & + 1.150_r8*rxt(k,580)*y(k,225))*y(k,201) +rxt(k,76)*y(k,19) & + +.180_r8*rxt(k,40)*y(k,54) +rxt(k,94)*y(k,59) +rxt(k,174)*y(k,90) & *y(k,76) +rxt(k,14)*y(k,114) +rxt(k,15)*y(k,124) +rxt(k,17)*y(k,125) & +rxt(k,18)*y(k,126) +rxt(k,8)*y(k,135) +rxt(k,108)*y(k,137) & +rxt(k,138)*y(k,151) +rxt(k,139)*y(k,152) +rxt(k,140)*y(k,153) & - +rxt(k,155)*y(k,217) +rxt(k,184)*y(k,221)*y(k,221) +rxt(k,2) & - *y(k,232) - loss(k,186) = (rxt(k,175)* y(k,76) +rxt(k,194)* y(k,112) +rxt(k,169) & - * y(k,133) +rxt(k,506)* y(k,149) +rxt(k,512)* y(k,151) +rxt(k,340) & - * y(k,201) +rxt(k,189)* y(k,212) +rxt(k,568)* y(k,213) & - + (rxt(k,572) +rxt(k,573))* y(k,215) +rxt(k,156)* y(k,217) & - +rxt(k,161)* y(k,218) +rxt(k,579)* y(k,222) + rxt(k,5) + rxt(k,6) & + +rxt(k,155)*y(k,222) +rxt(k,184)*y(k,226)*y(k,226) +rxt(k,2) & + *y(k,239) + loss(k,220) = (rxt(k,175)* y(k,76) +rxt(k,194)* y(k,112) +rxt(k,169) & + * y(k,133) +rxt(k,506)* y(k,149) +rxt(k,513)* y(k,151) +rxt(k,339) & + * y(k,203) +rxt(k,189)* y(k,217) +rxt(k,582)* y(k,218) & + + (rxt(k,586) +rxt(k,587))* y(k,220) +rxt(k,156)* y(k,222) & + +rxt(k,161)* y(k,223) +rxt(k,593)* y(k,227) + rxt(k,5) + rxt(k,6) & + rxt(k,126) + rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,130) & + rxt(k,131) + rxt(k,132) + rxt(k,133) + rxt(k,134) + rxt(k,135) & + het_rates(k,134))* y(k,134) - prod(k,186) = (rxt(k,172)*y(k,76) +rxt(k,176)*y(k,133) + & - 2.000_r8*rxt(k,177)*y(k,135) +rxt(k,181)*y(k,221) + & - rxt(k,186)*y(k,203) +rxt(k,198)*y(k,126) +rxt(k,218)*y(k,56) + & + prod(k,220) = (rxt(k,172)*y(k,76) +rxt(k,176)*y(k,133) + & + 2.000_r8*rxt(k,177)*y(k,135) +rxt(k,181)*y(k,226) + & + rxt(k,186)*y(k,90) +rxt(k,198)*y(k,126) +rxt(k,218)*y(k,56) + & rxt(k,225)*y(k,59) +rxt(k,251)*y(k,17) +rxt(k,257)*y(k,19) + & - rxt(k,300)*y(k,197) +rxt(k,322)*y(k,193) +rxt(k,350)*y(k,194) + & - rxt(k,358)*y(k,224))*y(k,203) + (rxt(k,8) + & - 2.000_r8*rxt(k,158)*y(k,217) +2.000_r8*rxt(k,167)*y(k,133) + & - rxt(k,178)*y(k,76) +rxt(k,183)*y(k,221) +rxt(k,196)*y(k,125) + & + rxt(k,300)*y(k,199) +rxt(k,321)*y(k,195) +rxt(k,349)*y(k,196) + & + rxt(k,358)*y(k,229))*y(k,90) + (rxt(k,8) + & + 2.000_r8*rxt(k,158)*y(k,222) +2.000_r8*rxt(k,167)*y(k,133) + & + rxt(k,178)*y(k,76) +rxt(k,183)*y(k,226) +rxt(k,196)*y(k,125) + & rxt(k,204)*y(k,124) +rxt(k,220)*y(k,56) +rxt(k,252)*y(k,17) + & - rxt(k,507)*y(k,149) +rxt(k,513)*y(k,151))*y(k,135) & - + (rxt(k,160)*y(k,218) +rxt(k,168)*y(k,133) +rxt(k,182)*y(k,221) + & + rxt(k,508)*y(k,149) +rxt(k,514)*y(k,151))*y(k,135) & + + (rxt(k,160)*y(k,223) +rxt(k,168)*y(k,133) +rxt(k,182)*y(k,226) + & rxt(k,195)*y(k,125) +rxt(k,200)*y(k,126) +rxt(k,231)*y(k,59) + & rxt(k,261)*y(k,19))*y(k,133) + (rxt(k,222)*y(k,59) + & - rxt(k,223)*y(k,59) +rxt(k,233)*y(k,221) +rxt(k,255)*y(k,19) + & + rxt(k,223)*y(k,59) +rxt(k,233)*y(k,226) +rxt(k,255)*y(k,19) + & rxt(k,256)*y(k,19))*y(k,59) + (rxt(k,151) +rxt(k,159) + & - 2.000_r8*rxt(k,161)*y(k,134))*y(k,218) +rxt(k,253)*y(k,19)*y(k,19) & - +rxt(k,187)*y(k,221)*y(k,90) +rxt(k,193)*y(k,125)*y(k,112) & - +rxt(k,207)*y(k,217)*y(k,113) +rxt(k,576)*y(k,220)*y(k,124) & - +rxt(k,19)*y(k,126) +rxt(k,152)*y(k,219) - loss(k,191) = (rxt(k,480)* y(k,6) +rxt(k,252)* y(k,17) +rxt(k,319)* y(k,25) & - +rxt(k,348)* y(k,29) +rxt(k,220)* y(k,56) +rxt(k,178)* y(k,76) & - +rxt(k,425)* y(k,98) +rxt(k,378)* y(k,105) +rxt(k,483)* y(k,110) & - +rxt(k,392)* y(k,111) +rxt(k,204)* y(k,124) +rxt(k,196)* y(k,125) & - +rxt(k,167)* y(k,133) +rxt(k,463)* y(k,142) +rxt(k,507)* y(k,149) & - +rxt(k,513)* y(k,151) +rxt(k,177)* y(k,203) +rxt(k,158)* y(k,217) & - +rxt(k,183)* y(k,221) + rxt(k,7) + rxt(k,8) + het_rates(k,135)) & + 2.000_r8*rxt(k,161)*y(k,134))*y(k,223) +rxt(k,253)*y(k,19)*y(k,19) & + +rxt(k,187)*y(k,226)*y(k,91) +rxt(k,193)*y(k,125)*y(k,112) & + +rxt(k,207)*y(k,222)*y(k,113) +rxt(k,590)*y(k,225)*y(k,124) & + +rxt(k,19)*y(k,126) +rxt(k,152)*y(k,224) + loss(k,236) = (rxt(k,480)* y(k,6) +rxt(k,252)* y(k,17) +rxt(k,318)* y(k,25) & + +rxt(k,347)* y(k,29) +rxt(k,220)* y(k,56) +rxt(k,178)* y(k,76) & + +rxt(k,177)* y(k,90) +rxt(k,425)* y(k,99) +rxt(k,378)* y(k,105) & + +rxt(k,483)* y(k,110) +rxt(k,392)* y(k,111) +rxt(k,204)* y(k,124) & + +rxt(k,196)* y(k,125) +rxt(k,167)* y(k,133) +rxt(k,463)* y(k,142) & + +rxt(k,508)* y(k,149) +rxt(k,514)* y(k,151) +rxt(k,158)* y(k,222) & + +rxt(k,183)* y(k,226) + rxt(k,7) + rxt(k,8) + het_rates(k,135)) & * y(k,135) - prod(k,191) = (.150_r8*rxt(k,333)*y(k,196) +.150_r8*rxt(k,383)*y(k,209)) & - *y(k,203) +rxt(k,169)*y(k,134)*y(k,133) - loss(k,77) = (rxt(k,514)* y(k,151) + rxt(k,108) + het_rates(k,137))* y(k,137) - prod(k,77) = (rxt(k,224)*y(k,59) +rxt(k,254)*y(k,19))*y(k,59) - loss(k,81) = (rxt(k,504)* y(k,133) +rxt(k,505)* y(k,221) + rxt(k,137) & + prod(k,236) = (.150_r8*rxt(k,332)*y(k,198) +.150_r8*rxt(k,383)*y(k,213)) & + *y(k,90) +rxt(k,169)*y(k,134)*y(k,133) + loss(k,20) = ( + het_rates(k,136))* y(k,136) + prod(k,20) = 0._r8 + loss(k,107) = (rxt(k,515)* y(k,151) + rxt(k,108) + het_rates(k,137)) & + * y(k,137) + prod(k,107) = (rxt(k,224)*y(k,59) +rxt(k,254)*y(k,19))*y(k,59) + loss(k,112) = (rxt(k,504)* y(k,133) +rxt(k,505)* y(k,226) + rxt(k,137) & + het_rates(k,138))* y(k,138) - prod(k,81) = 0._r8 - loss(k,61) = ( + rxt(k,60) + rxt(k,532) + het_rates(k,139))* y(k,139) - prod(k,61) =rxt(k,371)*y(k,221)*y(k,93) +.100_r8*rxt(k,492)*y(k,226)*y(k,124) - loss(k,97) = (rxt(k,343)* y(k,221) + rxt(k,61) + rxt(k,346) & + prod(k,112) = 0._r8 + loss(k,87) = ( + rxt(k,60) + rxt(k,532) + het_rates(k,139))* y(k,139) + prod(k,87) =rxt(k,371)*y(k,226)*y(k,94) +.100_r8*rxt(k,492)*y(k,231)*y(k,124) + loss(k,139) = (rxt(k,342)* y(k,226) + rxt(k,61) + rxt(k,345) & + het_rates(k,140))* y(k,140) - prod(k,97) =rxt(k,345)*y(k,196)*y(k,125) - loss(k,44) = ( + rxt(k,470) + het_rates(k,141))* y(k,141) - prod(k,44) =rxt(k,465)*y(k,189)*y(k,125) - loss(k,98) = (rxt(k,462)* y(k,125) +rxt(k,463)* y(k,135) + het_rates(k,142)) & + prod(k,139) =rxt(k,344)*y(k,198)*y(k,125) + loss(k,64) = ( + rxt(k,470) + het_rates(k,141))* y(k,141) + prod(k,64) =rxt(k,465)*y(k,189)*y(k,125) + loss(k,129) = (rxt(k,462)* y(k,125) +rxt(k,463)* y(k,135) + het_rates(k,142)) & * y(k,142) - prod(k,98) = (.070_r8*rxt(k,449)*y(k,66) +.060_r8*rxt(k,461)*y(k,143) + & - .070_r8*rxt(k,477)*y(k,185))*y(k,221) +rxt(k,32)*y(k,32) & - +rxt(k,447)*y(k,195)*y(k,124) - loss(k,50) = (rxt(k,461)* y(k,221) + het_rates(k,143))* y(k,143) - prod(k,50) =.530_r8*rxt(k,438)*y(k,221)*y(k,7) - loss(k,78) = (rxt(k,464)* y(k,221) + rxt(k,62) + het_rates(k,144))* y(k,144) - prod(k,78) =rxt(k,459)*y(k,223)*y(k,203) - loss(k,14) = ( + het_rates(k,145))* y(k,145) - prod(k,14) = 0._r8 - loss(k,15) = ( + het_rates(k,146))* y(k,146) - prod(k,15) = 0._r8 - loss(k,109) = (rxt(k,360)* y(k,221) + rxt(k,63) + het_rates(k,147))* y(k,147) - prod(k,109) =rxt(k,358)*y(k,224)*y(k,203) - loss(k,87) = (rxt(k,364)* y(k,221) + rxt(k,64) + het_rates(k,148))* y(k,148) - prod(k,87) =.850_r8*rxt(k,362)*y(k,225)*y(k,203) - loss(k,129) = (rxt(k,506)* y(k,134) +rxt(k,507)* y(k,135) +rxt(k,510) & - * y(k,221) + het_rates(k,149))* y(k,149) - prod(k,129) =rxt(k,137)*y(k,138) +rxt(k,138)*y(k,151) - loss(k,182) = (rxt(k,508)* y(k,19) +rxt(k,509)* y(k,59) +rxt(k,511)* y(k,125) & - +rxt(k,512)* y(k,134) +rxt(k,513)* y(k,135) +rxt(k,514)* y(k,137) & - +rxt(k,515)* y(k,221) + rxt(k,138) + het_rates(k,151))* y(k,151) - prod(k,182) = (rxt(k,506)*y(k,134) +rxt(k,507)*y(k,135) +rxt(k,510)*y(k,221)) & - *y(k,149) +rxt(k,504)*y(k,138)*y(k,133) +rxt(k,139)*y(k,152) - loss(k,155) = (rxt(k,517)* y(k,221) + rxt(k,139) + het_rates(k,152)) & - * y(k,152) - prod(k,155) = (rxt(k,508)*y(k,19) +rxt(k,509)*y(k,59) +rxt(k,511)*y(k,125) + & - rxt(k,512)*y(k,134) +rxt(k,513)*y(k,135) +rxt(k,514)*y(k,137) + & - rxt(k,515)*y(k,221))*y(k,151) + (rxt(k,502)*y(k,126) + & - rxt(k,503)*y(k,221) +.500_r8*rxt(k,516)*y(k,221))*y(k,67) & - +rxt(k,505)*y(k,221)*y(k,138) +rxt(k,140)*y(k,153) - loss(k,65) = (rxt(k,518)* y(k,232) + rxt(k,140) + het_rates(k,153))* y(k,153) - prod(k,65) =rxt(k,136)*y(k,80) +rxt(k,517)*y(k,221)*y(k,152) - loss(k,16) = ( + het_rates(k,154))* y(k,154) - prod(k,16) = 0._r8 - loss(k,17) = ( + het_rates(k,155))* y(k,155) - prod(k,17) = 0._r8 - loss(k,18) = ( + het_rates(k,156))* y(k,156) - prod(k,18) = 0._r8 - loss(k,19) = ( + rxt(k,141) + het_rates(k,157))* y(k,157) - prod(k,19) = 0._r8 - loss(k,20) = ( + rxt(k,142) + het_rates(k,158))* y(k,158) - prod(k,20) = 0._r8 - loss(k,21) = ( + rxt(k,143) + het_rates(k,159))* y(k,159) + prod(k,129) = (.070_r8*rxt(k,449)*y(k,66) +.060_r8*rxt(k,461)*y(k,143) + & + .070_r8*rxt(k,477)*y(k,185))*y(k,226) +rxt(k,32)*y(k,32) & + +rxt(k,447)*y(k,197)*y(k,124) + loss(k,71) = (rxt(k,461)* y(k,226) + het_rates(k,143))* y(k,143) + prod(k,71) =.530_r8*rxt(k,438)*y(k,226)*y(k,7) + loss(k,108) = (rxt(k,464)* y(k,226) + rxt(k,62) + het_rates(k,144))* y(k,144) + prod(k,108) =rxt(k,459)*y(k,228)*y(k,90) + loss(k,21) = ( + het_rates(k,145))* y(k,145) prod(k,21) = 0._r8 - loss(k,22) = ( + rxt(k,144) + het_rates(k,160))* y(k,160) + loss(k,22) = ( + het_rates(k,146))* y(k,146) prod(k,22) = 0._r8 - loss(k,23) = ( + rxt(k,145) + het_rates(k,161))* y(k,161) + loss(k,140) = (rxt(k,360)* y(k,226) + rxt(k,63) + het_rates(k,147))* y(k,147) + prod(k,140) =rxt(k,358)*y(k,229)*y(k,90) + loss(k,119) = (rxt(k,364)* y(k,226) + rxt(k,64) + het_rates(k,148))* y(k,148) + prod(k,119) =.850_r8*rxt(k,362)*y(k,230)*y(k,90) + loss(k,160) = (rxt(k,506)* y(k,134) +rxt(k,508)* y(k,135) +rxt(k,511) & + * y(k,226) + het_rates(k,149))* y(k,149) + prod(k,160) =rxt(k,137)*y(k,138) +rxt(k,138)*y(k,151) + loss(k,23) = ( + rxt(k,109) + het_rates(k,150))* y(k,150) prod(k,23) = 0._r8 - loss(k,24) = ( + rxt(k,146) + het_rates(k,162))* y(k,162) + loss(k,217) = (rxt(k,509)* y(k,19) +rxt(k,510)* y(k,59) +rxt(k,512)* y(k,125) & + +rxt(k,513)* y(k,134) +rxt(k,514)* y(k,135) +rxt(k,515)* y(k,137) & + +rxt(k,516)* y(k,226) + rxt(k,138) + het_rates(k,151))* y(k,151) + prod(k,217) = (rxt(k,506)*y(k,134) +rxt(k,508)*y(k,135) +rxt(k,511)*y(k,226)) & + *y(k,149) +rxt(k,504)*y(k,138)*y(k,133) +rxt(k,139)*y(k,152) + loss(k,184) = (rxt(k,507)* y(k,226) + rxt(k,139) + het_rates(k,152)) & + * y(k,152) + prod(k,184) = (rxt(k,509)*y(k,19) +rxt(k,510)*y(k,59) +rxt(k,512)*y(k,125) + & + rxt(k,513)*y(k,134) +rxt(k,514)*y(k,135) +rxt(k,515)*y(k,137) + & + rxt(k,516)*y(k,226))*y(k,151) + (rxt(k,502)*y(k,126) + & + rxt(k,503)*y(k,226) +.500_r8*rxt(k,517)*y(k,226))*y(k,67) & + +rxt(k,505)*y(k,226)*y(k,138) +rxt(k,140)*y(k,153) + loss(k,92) = (rxt(k,518)* y(k,239) + rxt(k,140) + het_rates(k,153))* y(k,153) + prod(k,92) =rxt(k,136)*y(k,80) +rxt(k,507)*y(k,226)*y(k,152) + loss(k,24) = ( + het_rates(k,154))* y(k,154) prod(k,24) = 0._r8 - loss(k,25) = ( + rxt(k,147) + het_rates(k,163))* y(k,163) + loss(k,25) = ( + het_rates(k,155))* y(k,155) prod(k,25) = 0._r8 - loss(k,26) = ( + rxt(k,148) + het_rates(k,164))* y(k,164) + loss(k,26) = ( + het_rates(k,156))* y(k,156) prod(k,26) = 0._r8 - loss(k,27) = ( + rxt(k,149) + het_rates(k,165))* y(k,165) + loss(k,27) = ( + rxt(k,141) + het_rates(k,157))* y(k,157) prod(k,27) = 0._r8 - loss(k,28) = ( + rxt(k,150) + het_rates(k,166))* y(k,166) + loss(k,28) = ( + rxt(k,142) + het_rates(k,158))* y(k,158) prod(k,28) = 0._r8 - loss(k,29) = ( + het_rates(k,167))* y(k,167) - prod(k,29) = (.2202005_r8*rxt(k,536)*y(k,6) +.0023005_r8*rxt(k,537)*y(k,7) + & - .0031005_r8*rxt(k,540)*y(k,98) +.2381005_r8*rxt(k,541)*y(k,104) + & - .0508005_r8*rxt(k,544)*y(k,110) +.5931005_r8*rxt(k,545)*y(k,173) + & - .1364005_r8*rxt(k,546)*y(k,181) +.1677005_r8*rxt(k,547)*y(k,183)) & - *y(k,221) + (.2202005_r8*rxt(k,535)*y(k,6) + & - .0508005_r8*rxt(k,543)*y(k,110))*y(k,135) +rxt(k,520)*y(k,75) - loss(k,30) = ( + het_rates(k,168))* y(k,168) - prod(k,30) = (.2067005_r8*rxt(k,536)*y(k,6) +.0008005_r8*rxt(k,537)*y(k,7) + & - .0035005_r8*rxt(k,540)*y(k,98) +.1308005_r8*rxt(k,541)*y(k,104) + & - .1149005_r8*rxt(k,544)*y(k,110) +.1534005_r8*rxt(k,545)*y(k,173) + & - .0101005_r8*rxt(k,546)*y(k,181) +.0174005_r8*rxt(k,547)*y(k,183)) & - *y(k,221) + (.2067005_r8*rxt(k,535)*y(k,6) + & - .1149005_r8*rxt(k,543)*y(k,110))*y(k,135) - loss(k,31) = ( + het_rates(k,169))* y(k,169) - prod(k,31) = (.0653005_r8*rxt(k,536)*y(k,6) +.0843005_r8*rxt(k,537)*y(k,7) + & - .0003005_r8*rxt(k,540)*y(k,98) +.0348005_r8*rxt(k,541)*y(k,104) + & - .0348005_r8*rxt(k,544)*y(k,110) +.0459005_r8*rxt(k,545)*y(k,173) + & - .0763005_r8*rxt(k,546)*y(k,181) +.086_r8*rxt(k,547)*y(k,183)) & - *y(k,221) + (.0653005_r8*rxt(k,535)*y(k,6) + & - .0348005_r8*rxt(k,543)*y(k,110))*y(k,135) - loss(k,32) = ( + het_rates(k,170))* y(k,170) - prod(k,32) = (.1284005_r8*rxt(k,536)*y(k,6) +.0443005_r8*rxt(k,537)*y(k,7) + & - .0271005_r8*rxt(k,540)*y(k,98) +.0076005_r8*rxt(k,541)*y(k,104) + & - .0554005_r8*rxt(k,544)*y(k,110) +.0085005_r8*rxt(k,545)*y(k,173) + & - .2157005_r8*rxt(k,546)*y(k,181) +.0512005_r8*rxt(k,547)*y(k,183)) & - *y(k,221) + (.1749305_r8*rxt(k,534)*y(k,6) + & - .0590245_r8*rxt(k,538)*y(k,98) +.1749305_r8*rxt(k,542)*y(k,110)) & - *y(k,126) + (.1284005_r8*rxt(k,535)*y(k,6) + & - .0033005_r8*rxt(k,539)*y(k,98) +.0554005_r8*rxt(k,543)*y(k,110)) & - *y(k,135) - loss(k,33) = ( + het_rates(k,171))* y(k,171) - prod(k,33) = (.114_r8*rxt(k,536)*y(k,6) +.1621005_r8*rxt(k,537)*y(k,7) + & - .0474005_r8*rxt(k,540)*y(k,98) +.0113005_r8*rxt(k,541)*y(k,104) + & - .1278005_r8*rxt(k,544)*y(k,110) +.0128005_r8*rxt(k,545)*y(k,173) + & - .0738005_r8*rxt(k,546)*y(k,181) +.1598005_r8*rxt(k,547)*y(k,183)) & - *y(k,221) + (.5901905_r8*rxt(k,534)*y(k,6) + & - .0250245_r8*rxt(k,538)*y(k,98) +.5901905_r8*rxt(k,542)*y(k,110)) & - *y(k,126) + (.114_r8*rxt(k,535)*y(k,6) + & - .1278005_r8*rxt(k,543)*y(k,110))*y(k,135) - loss(k,35) = (rxt(k,545)* y(k,221) + het_rates(k,173))* y(k,173) + loss(k,29) = ( + rxt(k,143) + het_rates(k,159))* y(k,159) + prod(k,29) = 0._r8 + loss(k,30) = ( + rxt(k,144) + het_rates(k,160))* y(k,160) + prod(k,30) = 0._r8 + loss(k,31) = ( + rxt(k,145) + het_rates(k,161))* y(k,161) + prod(k,31) = 0._r8 + loss(k,32) = ( + rxt(k,146) + het_rates(k,162))* y(k,162) + prod(k,32) = 0._r8 + loss(k,33) = ( + rxt(k,147) + het_rates(k,163))* y(k,163) + prod(k,33) = 0._r8 + loss(k,34) = ( + rxt(k,148) + het_rates(k,164))* y(k,164) + prod(k,34) = 0._r8 + loss(k,35) = ( + rxt(k,149) + het_rates(k,165))* y(k,165) prod(k,35) = 0._r8 - loss(k,55) = ( + rxt(k,65) + het_rates(k,174))* y(k,174) - prod(k,55) = (.100_r8*rxt(k,469)*y(k,181) +.230_r8*rxt(k,471)*y(k,183)) & - *y(k,221) - loss(k,116) = (rxt(k,493)* y(k,221) + rxt(k,66) + het_rates(k,175))* y(k,175) - prod(k,116) =rxt(k,491)*y(k,226)*y(k,203) - loss(k,121) = (rxt(k,494)* y(k,221) + rxt(k,67) + rxt(k,533) & + loss(k,36) = ( + rxt(k,150) + het_rates(k,166))* y(k,166) + prod(k,36) = 0._r8 + loss(k,37) = ( + het_rates(k,167))* y(k,167) + prod(k,37) = (.2202005_r8*rxt(k,535)*y(k,191) + & + .0023005_r8*rxt(k,540)*y(k,193) +.0031005_r8*rxt(k,543)*y(k,209) + & + .2381005_r8*rxt(k,547)*y(k,210) +.0508005_r8*rxt(k,551)*y(k,216) + & + .1364005_r8*rxt(k,557)*y(k,234) +.1677005_r8*rxt(k,560)*y(k,237)) & + *y(k,90) + (.1279005_r8*rxt(k,536)*y(k,191) + & + .0097005_r8*rxt(k,541)*y(k,193) +.0003005_r8*rxt(k,544)*y(k,209) + & + .1056005_r8*rxt(k,548)*y(k,210) +.0245005_r8*rxt(k,552)*y(k,216) + & + .0154005_r8*rxt(k,558)*y(k,234) +.0063005_r8*rxt(k,561)*y(k,237)) & + *y(k,124) + (.2202005_r8*rxt(k,537)*y(k,6) + & + .0508005_r8*rxt(k,553)*y(k,110))*y(k,135) +rxt(k,520)*y(k,75) & + +.5931005_r8*rxt(k,555)*y(k,226)*y(k,173) + loss(k,38) = ( + het_rates(k,168))* y(k,168) + prod(k,38) = (.2067005_r8*rxt(k,535)*y(k,191) + & + .0008005_r8*rxt(k,540)*y(k,193) +.0035005_r8*rxt(k,543)*y(k,209) + & + .1308005_r8*rxt(k,547)*y(k,210) +.1149005_r8*rxt(k,551)*y(k,216) + & + .0101005_r8*rxt(k,557)*y(k,234) +.0174005_r8*rxt(k,560)*y(k,237)) & + *y(k,90) + (.1792005_r8*rxt(k,536)*y(k,191) + & + .0034005_r8*rxt(k,541)*y(k,193) +.0003005_r8*rxt(k,544)*y(k,209) + & + .1026005_r8*rxt(k,548)*y(k,210) +.0082005_r8*rxt(k,552)*y(k,216) + & + .0452005_r8*rxt(k,558)*y(k,234) +.0237005_r8*rxt(k,561)*y(k,237)) & + *y(k,124) + (.2067005_r8*rxt(k,537)*y(k,6) + & + .1149005_r8*rxt(k,553)*y(k,110))*y(k,135) & + +.1534005_r8*rxt(k,555)*y(k,226)*y(k,173) + loss(k,39) = ( + het_rates(k,169))* y(k,169) + prod(k,39) = (.0653005_r8*rxt(k,535)*y(k,191) + & + .0843005_r8*rxt(k,540)*y(k,193) +.0003005_r8*rxt(k,543)*y(k,209) + & + .0348005_r8*rxt(k,547)*y(k,210) +.0348005_r8*rxt(k,551)*y(k,216) + & + .0763005_r8*rxt(k,557)*y(k,234) +.086_r8*rxt(k,560)*y(k,237))*y(k,90) & + + (.0676005_r8*rxt(k,536)*y(k,191) + & + .1579005_r8*rxt(k,541)*y(k,193) +.0073005_r8*rxt(k,544)*y(k,209) + & + .0521005_r8*rxt(k,548)*y(k,210) +.0772005_r8*rxt(k,552)*y(k,216) + & + .0966005_r8*rxt(k,558)*y(k,234) +.0025005_r8*rxt(k,561)*y(k,237)) & + *y(k,124) + (.0653005_r8*rxt(k,537)*y(k,6) + & + .0348005_r8*rxt(k,553)*y(k,110))*y(k,135) & + +.0459005_r8*rxt(k,555)*y(k,226)*y(k,173) + loss(k,40) = ( + het_rates(k,170))* y(k,170) + prod(k,40) = (.1284005_r8*rxt(k,535)*y(k,191) + & + .0443005_r8*rxt(k,540)*y(k,193) +.0271005_r8*rxt(k,543)*y(k,209) + & + .0076005_r8*rxt(k,547)*y(k,210) +.0554005_r8*rxt(k,551)*y(k,216) + & + .2157005_r8*rxt(k,557)*y(k,234) +.0512005_r8*rxt(k,560)*y(k,237)) & + *y(k,90) + (.079_r8*rxt(k,536)*y(k,191) + & + .0059005_r8*rxt(k,541)*y(k,193) +.0057005_r8*rxt(k,544)*y(k,209) + & + .0143005_r8*rxt(k,548)*y(k,210) +.0332005_r8*rxt(k,552)*y(k,216) + & + .0073005_r8*rxt(k,558)*y(k,234) +.011_r8*rxt(k,561)*y(k,237)) & + *y(k,124) + (.1749305_r8*rxt(k,534)*y(k,6) + & + .0590245_r8*rxt(k,542)*y(k,99) +.1749305_r8*rxt(k,550)*y(k,110)) & + *y(k,126) + (.1284005_r8*rxt(k,537)*y(k,6) + & + .0033005_r8*rxt(k,545)*y(k,99) +.0554005_r8*rxt(k,553)*y(k,110)) & + *y(k,135) +.0085005_r8*rxt(k,555)*y(k,226)*y(k,173) + loss(k,41) = ( + het_rates(k,171))* y(k,171) + prod(k,41) = (.114_r8*rxt(k,535)*y(k,191) +.1621005_r8*rxt(k,540)*y(k,193) + & + .0474005_r8*rxt(k,543)*y(k,209) +.0113005_r8*rxt(k,547)*y(k,210) + & + .1278005_r8*rxt(k,551)*y(k,216) +.0738005_r8*rxt(k,557)*y(k,234) + & + .1598005_r8*rxt(k,560)*y(k,237))*y(k,90) & + + (.1254005_r8*rxt(k,536)*y(k,191) + & + .0536005_r8*rxt(k,541)*y(k,193) +.0623005_r8*rxt(k,544)*y(k,209) + & + .0166005_r8*rxt(k,548)*y(k,210) +.130_r8*rxt(k,552)*y(k,216) + & + .238_r8*rxt(k,558)*y(k,234) +.1185005_r8*rxt(k,561)*y(k,237)) & + *y(k,124) + (.5901905_r8*rxt(k,534)*y(k,6) + & + .0250245_r8*rxt(k,542)*y(k,99) +.5901905_r8*rxt(k,550)*y(k,110)) & + *y(k,126) + (.114_r8*rxt(k,537)*y(k,6) + & + .1278005_r8*rxt(k,553)*y(k,110))*y(k,135) & + +.0128005_r8*rxt(k,555)*y(k,226)*y(k,173) + loss(k,42) = ( + rxt(k,597) + het_rates(k,172))* y(k,172) + prod(k,42) = 0._r8 + loss(k,43) = (rxt(k,555)* y(k,226) + het_rates(k,173))* y(k,173) + prod(k,43) = 0._r8 + loss(k,78) = ( + rxt(k,65) + het_rates(k,174))* y(k,174) + prod(k,78) = (.100_r8*rxt(k,469)*y(k,181) +.230_r8*rxt(k,471)*y(k,183)) & + *y(k,226) + loss(k,154) = (rxt(k,493)* y(k,226) + rxt(k,66) + het_rates(k,175))* y(k,175) + prod(k,154) =rxt(k,491)*y(k,231)*y(k,90) + loss(k,151) = (rxt(k,494)* y(k,226) + rxt(k,67) + rxt(k,533) & + het_rates(k,176))* y(k,176) - prod(k,121) = (.200_r8*rxt(k,487)*y(k,216) +.200_r8*rxt(k,497)*y(k,227)) & - *y(k,124) +.500_r8*rxt(k,485)*y(k,216)*y(k,197) - loss(k,100) = (rxt(k,498)* y(k,221) + rxt(k,68) + het_rates(k,177))* y(k,177) - prod(k,100) =rxt(k,496)*y(k,227)*y(k,203) - loss(k,158) = (rxt(k,499)* y(k,126) +rxt(k,500)* y(k,221) + rxt(k,69) & + prod(k,151) = (.200_r8*rxt(k,487)*y(k,221) +.200_r8*rxt(k,497)*y(k,232)) & + *y(k,124) +.500_r8*rxt(k,485)*y(k,221)*y(k,199) + loss(k,131) = (rxt(k,498)* y(k,226) + rxt(k,68) + het_rates(k,177))* y(k,177) + prod(k,131) =rxt(k,496)*y(k,232)*y(k,90) + loss(k,192) = (rxt(k,499)* y(k,126) +rxt(k,500)* y(k,226) + rxt(k,69) & + het_rates(k,178))* y(k,178) - prod(k,158) = (.500_r8*rxt(k,485)*y(k,197) +.800_r8*rxt(k,487)*y(k,124) + & - rxt(k,488)*y(k,126))*y(k,216) + (.330_r8*rxt(k,480)*y(k,6) + & + prod(k,192) = (.500_r8*rxt(k,485)*y(k,199) +.800_r8*rxt(k,487)*y(k,124) + & + rxt(k,488)*y(k,126))*y(k,221) + (.330_r8*rxt(k,480)*y(k,6) + & .330_r8*rxt(k,483)*y(k,110))*y(k,135) + (rxt(k,67) + & - rxt(k,494)*y(k,221))*y(k,176) + (rxt(k,495)*y(k,197) + & - .800_r8*rxt(k,497)*y(k,124))*y(k,227) +rxt(k,59)*y(k,128) +rxt(k,68) & + rxt(k,494)*y(k,226))*y(k,176) + (rxt(k,495)*y(k,199) + & + .800_r8*rxt(k,497)*y(k,124))*y(k,232) +rxt(k,59)*y(k,128) +rxt(k,68) & *y(k,177) - loss(k,163) = (rxt(k,501)* y(k,221) + rxt(k,70) + het_rates(k,179))* y(k,179) - prod(k,163) = (.300_r8*rxt(k,480)*y(k,6) +.300_r8*rxt(k,483)*y(k,110)) & - *y(k,135) + (rxt(k,490)*y(k,197) +.900_r8*rxt(k,492)*y(k,124)) & - *y(k,226) +rxt(k,66)*y(k,175) +rxt(k,69)*y(k,178) - loss(k,117) = (rxt(k,468)* y(k,221) + rxt(k,71) + het_rates(k,180))* y(k,180) - prod(k,117) =rxt(k,466)*y(k,228)*y(k,203) - loss(k,53) = (rxt(k,469)* y(k,221) + het_rates(k,181))* y(k,181) - prod(k,53) = 0._r8 - loss(k,56) = (rxt(k,435)* y(k,221) + rxt(k,72) + het_rates(k,182))* y(k,182) - prod(k,56) =rxt(k,432)*y(k,229)*y(k,203) - loss(k,57) = (rxt(k,471)* y(k,221) + het_rates(k,183))* y(k,183) - prod(k,57) = 0._r8 - loss(k,128) = (rxt(k,474)* y(k,221) + rxt(k,73) + het_rates(k,184))* y(k,184) - prod(k,128) =rxt(k,472)*y(k,230)*y(k,203) - loss(k,58) = (rxt(k,477)* y(k,221) + het_rates(k,185))* y(k,185) - prod(k,58) =.150_r8*rxt(k,471)*y(k,221)*y(k,183) - loss(k,91) = (rxt(k,478)* y(k,221) + rxt(k,74) + het_rates(k,186))* y(k,186) - prod(k,91) =rxt(k,475)*y(k,231)*y(k,203) - loss(k,104) = (rxt(k,437)* y(k,124) +rxt(k,465)* y(k,125) +rxt(k,436) & - * y(k,203) + het_rates(k,189))* y(k,189) - prod(k,104) =rxt(k,442)*y(k,221)*y(k,22) +rxt(k,470)*y(k,141) - loss(k,154) = ((rxt(k,398) +rxt(k,399))* y(k,124) +rxt(k,397)* y(k,203) & + loss(k,195) = (rxt(k,501)* y(k,226) + rxt(k,70) + het_rates(k,179))* y(k,179) + prod(k,195) = (.300_r8*rxt(k,480)*y(k,6) +.300_r8*rxt(k,483)*y(k,110)) & + *y(k,135) + (rxt(k,490)*y(k,199) +.900_r8*rxt(k,492)*y(k,124)) & + *y(k,231) +rxt(k,66)*y(k,175) +rxt(k,69)*y(k,178) + loss(k,155) = (rxt(k,468)* y(k,226) + rxt(k,71) + het_rates(k,180))* y(k,180) + prod(k,155) =rxt(k,466)*y(k,233)*y(k,90) + loss(k,76) = (rxt(k,469)* y(k,226) + het_rates(k,181))* y(k,181) + prod(k,76) = 0._r8 + loss(k,79) = (rxt(k,435)* y(k,226) + rxt(k,72) + het_rates(k,182))* y(k,182) + prod(k,79) =rxt(k,432)*y(k,235)*y(k,90) + loss(k,80) = (rxt(k,471)* y(k,226) + het_rates(k,183))* y(k,183) + prod(k,80) = 0._r8 + loss(k,161) = (rxt(k,474)* y(k,226) + rxt(k,73) + het_rates(k,184))* y(k,184) + prod(k,161) =rxt(k,472)*y(k,236)*y(k,90) + loss(k,81) = (rxt(k,477)* y(k,226) + het_rates(k,185))* y(k,185) + prod(k,81) =.150_r8*rxt(k,471)*y(k,226)*y(k,183) + loss(k,122) = (rxt(k,478)* y(k,226) + rxt(k,74) + het_rates(k,186))* y(k,186) + prod(k,122) =rxt(k,475)*y(k,238)*y(k,90) + loss(k,137) = (rxt(k,436)* y(k,90) +rxt(k,437)* y(k,124) +rxt(k,465) & + * y(k,125) + het_rates(k,189))* y(k,189) + prod(k,137) =rxt(k,442)*y(k,226)*y(k,22) +rxt(k,470)*y(k,141) + loss(k,189) = (rxt(k,397)* y(k,90) + (rxt(k,398) +rxt(k,399))* y(k,124) & + het_rates(k,190))* y(k,190) - prod(k,154) = (rxt(k,400)*y(k,2) +rxt(k,401)*y(k,15))*y(k,221) - loss(k,101) = (rxt(k,440)* y(k,124) +rxt(k,439)* y(k,203) + het_rates(k,191)) & + prod(k,189) = (rxt(k,400)*y(k,2) +rxt(k,401)*y(k,15))*y(k,226) + loss(k,44) = (rxt(k,535)* y(k,90) +rxt(k,536)* y(k,124) + het_rates(k,191)) & * y(k,191) - prod(k,101) = (.350_r8*rxt(k,438)*y(k,7) +rxt(k,441)*y(k,8))*y(k,221) - loss(k,92) = (rxt(k,445)* y(k,124) +rxt(k,443)* y(k,203) + het_rates(k,192)) & + prod(k,44) =rxt(k,538)*y(k,226)*y(k,6) + loss(k,132) = (rxt(k,439)* y(k,90) +rxt(k,440)* y(k,124) + het_rates(k,192)) & * y(k,192) - prod(k,92) = (rxt(k,444)*y(k,23) +.070_r8*rxt(k,469)*y(k,181) + & - .060_r8*rxt(k,471)*y(k,183))*y(k,221) - loss(k,152) = (rxt(k,323)* y(k,124) + 2._r8*rxt(k,320)* y(k,193) +rxt(k,321) & - * y(k,197) +rxt(k,322)* y(k,203) + het_rates(k,193))* y(k,193) - prod(k,152) = (rxt(k,326)*y(k,56) +rxt(k,327)*y(k,221))*y(k,28) & - +.500_r8*rxt(k,325)*y(k,221)*y(k,27) +rxt(k,53)*y(k,107) - loss(k,143) = (rxt(k,351)* y(k,124) +rxt(k,349)* y(k,197) +rxt(k,350) & - * y(k,203) + het_rates(k,194))* y(k,194) - prod(k,143) = (rxt(k,352)*y(k,30) +rxt(k,353)*y(k,31))*y(k,221) - loss(k,122) = (rxt(k,447)* y(k,124) +rxt(k,446)* y(k,203) + het_rates(k,195)) & - * y(k,195) - prod(k,122) = (.400_r8*rxt(k,436)*y(k,203) +rxt(k,437)*y(k,124))*y(k,189) & - +rxt(k,448)*y(k,221)*y(k,32) +rxt(k,463)*y(k,142)*y(k,135) - loss(k,181) = (rxt(k,419)* y(k,101) +rxt(k,334)* y(k,124) +rxt(k,345) & - * y(k,125) + 2._r8*rxt(k,331)* y(k,196) +rxt(k,332)* y(k,197) & - +rxt(k,333)* y(k,203) +rxt(k,405)* y(k,205) +rxt(k,410)* y(k,206) & - +rxt(k,372)* y(k,207) +rxt(k,430)* y(k,229) + het_rates(k,196)) & - * y(k,196) - prod(k,181) = (.100_r8*rxt(k,378)*y(k,105) +.280_r8*rxt(k,392)*y(k,111) + & - .080_r8*rxt(k,425)*y(k,98) +.060_r8*rxt(k,480)*y(k,6) + & - .060_r8*rxt(k,483)*y(k,110))*y(k,135) + (rxt(k,382)*y(k,197) + & - .450_r8*rxt(k,383)*y(k,203) +2.000_r8*rxt(k,384)*y(k,209) + & - rxt(k,385)*y(k,124) +rxt(k,386)*y(k,126))*y(k,209) & - + (.530_r8*rxt(k,372)*y(k,196) +.260_r8*rxt(k,373)*y(k,197) + & - .530_r8*rxt(k,375)*y(k,126) +.530_r8*rxt(k,376)*y(k,124))*y(k,207) & - + (rxt(k,329)*y(k,45) +.500_r8*rxt(k,336)*y(k,51) + & - rxt(k,355)*y(k,49) +.650_r8*rxt(k,501)*y(k,179))*y(k,221) & - + (.300_r8*rxt(k,361)*y(k,197) +.150_r8*rxt(k,362)*y(k,203) + & - rxt(k,363)*y(k,124))*y(k,225) + (rxt(k,37) +rxt(k,354)*y(k,126)) & - *y(k,49) + (.600_r8*rxt(k,61) +rxt(k,346))*y(k,140) & - + (.200_r8*rxt(k,387)*y(k,203) +rxt(k,388)*y(k,124))*y(k,211) & - +.130_r8*rxt(k,24)*y(k,10) +rxt(k,28)*y(k,14) +rxt(k,328)*y(k,126) & - *y(k,45) +rxt(k,36)*y(k,48) +.330_r8*rxt(k,46)*y(k,93) +rxt(k,48) & - *y(k,95) +1.340_r8*rxt(k,51)*y(k,105) +rxt(k,53)*y(k,107) +rxt(k,54) & + prod(k,132) = (.350_r8*rxt(k,438)*y(k,7) +rxt(k,441)*y(k,8))*y(k,226) + loss(k,45) = (rxt(k,540)* y(k,90) +rxt(k,541)* y(k,124) + het_rates(k,193)) & + * y(k,193) + prod(k,45) =rxt(k,539)*y(k,226)*y(k,7) + loss(k,123) = (rxt(k,443)* y(k,90) +rxt(k,445)* y(k,124) + het_rates(k,194)) & + * y(k,194) + prod(k,123) = (rxt(k,444)*y(k,23) +.070_r8*rxt(k,469)*y(k,181) + & + .060_r8*rxt(k,471)*y(k,183))*y(k,226) + loss(k,179) = (rxt(k,321)* y(k,90) +rxt(k,322)* y(k,124) + 2._r8*rxt(k,319) & + * y(k,195) +rxt(k,320)* y(k,199) + het_rates(k,195))* y(k,195) + prod(k,179) = (rxt(k,325)*y(k,56) +rxt(k,326)*y(k,226))*y(k,28) & + +.500_r8*rxt(k,324)*y(k,226)*y(k,27) +rxt(k,53)*y(k,107) + loss(k,183) = (rxt(k,349)* y(k,90) +rxt(k,350)* y(k,124) +rxt(k,348) & + * y(k,199) + het_rates(k,196))* y(k,196) + prod(k,183) = (rxt(k,352)*y(k,226) +rxt(k,355)*y(k,56))*y(k,31) & + +rxt(k,351)*y(k,226)*y(k,30) + loss(k,152) = (rxt(k,446)* y(k,90) +rxt(k,447)* y(k,124) + het_rates(k,197)) & + * y(k,197) + prod(k,152) = (.400_r8*rxt(k,436)*y(k,90) +rxt(k,437)*y(k,124))*y(k,189) & + +rxt(k,448)*y(k,226)*y(k,32) +rxt(k,463)*y(k,142)*y(k,135) + loss(k,214) = (rxt(k,332)* y(k,90) +rxt(k,333)* y(k,124) +rxt(k,344) & + * y(k,125) + 2._r8*rxt(k,330)* y(k,198) +rxt(k,331)* y(k,199) & + +rxt(k,405)* y(k,206) +rxt(k,410)* y(k,207) +rxt(k,419)* y(k,208) & + +rxt(k,372)* y(k,211) +rxt(k,430)* y(k,235) + het_rates(k,198)) & + * y(k,198) + prod(k,214) = (.100_r8*rxt(k,378)*y(k,105) +.280_r8*rxt(k,392)*y(k,111) + & + .080_r8*rxt(k,425)*y(k,99) +.060_r8*rxt(k,480)*y(k,6) + & + .060_r8*rxt(k,483)*y(k,110))*y(k,135) + (rxt(k,382)*y(k,199) + & + .450_r8*rxt(k,383)*y(k,90) +2.000_r8*rxt(k,384)*y(k,213) + & + rxt(k,385)*y(k,124) +rxt(k,386)*y(k,126))*y(k,213) & + + (.530_r8*rxt(k,372)*y(k,198) +.260_r8*rxt(k,373)*y(k,199) + & + .530_r8*rxt(k,375)*y(k,126) +.530_r8*rxt(k,376)*y(k,124))*y(k,211) & + + (rxt(k,328)*y(k,45) +.500_r8*rxt(k,335)*y(k,51) + & + rxt(k,354)*y(k,49) +.650_r8*rxt(k,501)*y(k,179))*y(k,226) & + + (.300_r8*rxt(k,361)*y(k,199) +.150_r8*rxt(k,362)*y(k,90) + & + rxt(k,363)*y(k,124))*y(k,230) + (rxt(k,37) +rxt(k,353)*y(k,126)) & + *y(k,49) + (.600_r8*rxt(k,61) +rxt(k,345))*y(k,140) & + + (.200_r8*rxt(k,387)*y(k,90) +rxt(k,388)*y(k,124))*y(k,215) & + +.130_r8*rxt(k,24)*y(k,10) +rxt(k,28)*y(k,14) +rxt(k,327)*y(k,126) & + *y(k,45) +rxt(k,36)*y(k,48) +.330_r8*rxt(k,46)*y(k,94) +rxt(k,48) & + *y(k,96) +1.340_r8*rxt(k,51)*y(k,105) +rxt(k,53)*y(k,107) +rxt(k,54) & *y(k,108) +.300_r8*rxt(k,56)*y(k,111) +rxt(k,58)*y(k,127) +rxt(k,64) & *y(k,148) +.500_r8*rxt(k,65)*y(k,174) +.650_r8*rxt(k,70)*y(k,179) - loss(k,185) = (rxt(k,221)* y(k,59) +rxt(k,420)* y(k,101) +rxt(k,301) & - * y(k,124) +rxt(k,321)* y(k,193) +rxt(k,349)* y(k,194) +rxt(k,332) & - * y(k,196) + 2._r8*(rxt(k,298) +rxt(k,299))* y(k,197) +rxt(k,300) & - * y(k,203) +rxt(k,406)* y(k,205) +rxt(k,411)* y(k,206) +rxt(k,373) & - * y(k,207) +rxt(k,382)* y(k,209) +rxt(k,485)* y(k,216) +rxt(k,361) & - * y(k,225) +rxt(k,490)* y(k,226) +rxt(k,495)* y(k,227) +rxt(k,431) & - * y(k,229) + het_rates(k,197))* y(k,197) - prod(k,185) = (2.000_r8*rxt(k,331)*y(k,196) +.900_r8*rxt(k,332)*y(k,197) + & - .450_r8*rxt(k,333)*y(k,203) +rxt(k,334)*y(k,124) + & - rxt(k,372)*y(k,207) +rxt(k,381)*y(k,209) +rxt(k,405)*y(k,205) + & - rxt(k,410)*y(k,206) +rxt(k,419)*y(k,101) +rxt(k,430)*y(k,229)) & - *y(k,196) + (rxt(k,215)*y(k,56) +rxt(k,271)*y(k,73) + & - rxt(k,304)*y(k,221) +rxt(k,311)*y(k,217))*y(k,54) & - + (.830_r8*rxt(k,451)*y(k,198) +.170_r8*rxt(k,457)*y(k,210)) & - *y(k,124) + (.280_r8*rxt(k,348)*y(k,29) +.050_r8*rxt(k,425)*y(k,98)) & - *y(k,135) + (.330_r8*rxt(k,450)*y(k,198) + & - .070_r8*rxt(k,456)*y(k,210))*y(k,203) + (.700_r8*rxt(k,303)*y(k,53) + & - rxt(k,335)*y(k,50))*y(k,221) +rxt(k,35)*y(k,45) +rxt(k,36)*y(k,48) & - +rxt(k,38)*y(k,51) +.300_r8*rxt(k,56)*y(k,111) +.400_r8*rxt(k,61) & - *y(k,140) - loss(k,133) = (rxt(k,451)* y(k,124) +rxt(k,452)* y(k,125) +rxt(k,450) & - * y(k,203) + het_rates(k,198))* y(k,198) - prod(k,133) =.600_r8*rxt(k,26)*y(k,12) - loss(k,139) = (rxt(k,567)* y(k,213) +rxt(k,565)* y(k,214) +rxt(k,566) & - * y(k,220) + het_rates(k,199))* y(k,199) - prod(k,139) = (rxt(k,126) +rxt(k,127) +rxt(k,128) +rxt(k,129) +rxt(k,130) + & + loss(k,232) = (rxt(k,221)* y(k,59) +rxt(k,300)* y(k,90) +rxt(k,301)* y(k,124) & + +rxt(k,320)* y(k,195) +rxt(k,348)* y(k,196) +rxt(k,331)* y(k,198) & + + 2._r8*(rxt(k,298) +rxt(k,299))* y(k,199) +rxt(k,406)* y(k,206) & + +rxt(k,411)* y(k,207) +rxt(k,420)* y(k,208) +rxt(k,373)* y(k,211) & + +rxt(k,382)* y(k,213) +rxt(k,485)* y(k,221) +rxt(k,361)* y(k,230) & + +rxt(k,490)* y(k,231) +rxt(k,495)* y(k,232) +rxt(k,431)* y(k,235) & + + het_rates(k,199))* y(k,199) + prod(k,232) = (2.000_r8*rxt(k,330)*y(k,198) +.900_r8*rxt(k,331)*y(k,199) + & + .450_r8*rxt(k,332)*y(k,90) +rxt(k,333)*y(k,124) + & + rxt(k,372)*y(k,211) +rxt(k,381)*y(k,213) +rxt(k,405)*y(k,206) + & + rxt(k,410)*y(k,207) +rxt(k,419)*y(k,208) +rxt(k,430)*y(k,235)) & + *y(k,198) + (rxt(k,41) +rxt(k,215)*y(k,56) +rxt(k,271)*y(k,73) + & + rxt(k,304)*y(k,226) +rxt(k,310)*y(k,222))*y(k,54) & + + (.330_r8*rxt(k,450)*y(k,200) +.070_r8*rxt(k,456)*y(k,214))*y(k,90) & + + (.830_r8*rxt(k,451)*y(k,200) +.170_r8*rxt(k,457)*y(k,214)) & + *y(k,124) + (.280_r8*rxt(k,347)*y(k,29) +.050_r8*rxt(k,425)*y(k,99)) & + *y(k,135) + (.700_r8*rxt(k,303)*y(k,53) +rxt(k,334)*y(k,50))*y(k,226) & + +rxt(k,88)*y(k,43) +rxt(k,35)*y(k,45) +rxt(k,90)*y(k,46) +rxt(k,36) & + *y(k,48) +rxt(k,38)*y(k,51) +.300_r8*rxt(k,56)*y(k,111) & + +.400_r8*rxt(k,61)*y(k,140) + loss(k,166) = (rxt(k,450)* y(k,90) +rxt(k,451)* y(k,124) +rxt(k,452) & + * y(k,125) + het_rates(k,200))* y(k,200) + prod(k,166) =.600_r8*rxt(k,26)*y(k,12) + loss(k,176) = (rxt(k,581)* y(k,218) +rxt(k,579)* y(k,219) +rxt(k,580) & + * y(k,225) + het_rates(k,201))* y(k,201) + prod(k,176) = (rxt(k,126) +rxt(k,127) +rxt(k,128) +rxt(k,129) +rxt(k,130) + & rxt(k,131) +rxt(k,132) +rxt(k,133))*y(k,134) + (rxt(k,120) + & rxt(k,121) +rxt(k,122) +rxt(k,123) +rxt(k,124) +rxt(k,125))*y(k,133) & +rxt(k,111)*y(k,112) +rxt(k,16)*y(k,124) - loss(k,113) = ((rxt(k,369) +rxt(k,370))* y(k,124) + het_rates(k,200)) & - * y(k,200) - prod(k,113) =rxt(k,368)*y(k,221)*y(k,16) - loss(k,96) = (rxt(k,340)* y(k,134) + rxt(k,339) + het_rates(k,201))* y(k,201) - prod(k,96) =rxt(k,43)*y(k,72) +.750_r8*rxt(k,338)*y(k,202)*y(k,124) - loss(k,135) = (rxt(k,338)* y(k,124) +rxt(k,337)* y(k,203) + het_rates(k,202)) & + loss(k,144) = ((rxt(k,369) +rxt(k,370))* y(k,124) + het_rates(k,202)) & * y(k,202) - prod(k,135) =rxt(k,344)*y(k,221)*y(k,25) - loss(k,199) = (rxt(k,251)* y(k,17) +rxt(k,257)* y(k,19) +rxt(k,294)* y(k,42) & - + (rxt(k,218) +rxt(k,219))* y(k,56) +rxt(k,225)* y(k,59) & - + (rxt(k,172) +rxt(k,173) +rxt(k,174))* y(k,76) +rxt(k,421) & - * y(k,101) +rxt(k,203)* y(k,124) +rxt(k,208)* y(k,125) +rxt(k,198) & - * y(k,126) +rxt(k,176)* y(k,133) +rxt(k,177)* y(k,135) +rxt(k,436) & - * y(k,189) +rxt(k,397)* y(k,190) +rxt(k,439)* y(k,191) +rxt(k,443) & - * y(k,192) +rxt(k,322)* y(k,193) +rxt(k,350)* y(k,194) +rxt(k,446) & - * y(k,195) +rxt(k,333)* y(k,196) +rxt(k,300)* y(k,197) +rxt(k,450) & - * y(k,198) +rxt(k,337)* y(k,202) + 2._r8*rxt(k,186)* y(k,203) & - +rxt(k,308)* y(k,204) +rxt(k,407)* y(k,205) +rxt(k,412)* y(k,206) & - +rxt(k,374)* y(k,207) +rxt(k,453)* y(k,208) +rxt(k,383)* y(k,209) & - +rxt(k,456)* y(k,210) +rxt(k,387)* y(k,211) +rxt(k,486)* y(k,216) & - +rxt(k,181)* y(k,221) +rxt(k,459)* y(k,223) +rxt(k,358)* y(k,224) & - +rxt(k,362)* y(k,225) +rxt(k,491)* y(k,226) +rxt(k,496)* y(k,227) & - +rxt(k,466)* y(k,228) +rxt(k,432)* y(k,229) +rxt(k,472)* y(k,230) & - +rxt(k,475)* y(k,231) + rxt(k,521) + het_rates(k,203))* y(k,203) - prod(k,199) = (rxt(k,280)*y(k,43) +rxt(k,283)*y(k,46) +rxt(k,180)*y(k,79) + & - rxt(k,183)*y(k,135) +rxt(k,201)*y(k,126) +rxt(k,232)*y(k,59) + & - rxt(k,262)*y(k,19) +rxt(k,302)*y(k,52) +rxt(k,305)*y(k,62) + & - rxt(k,306)*y(k,86) +rxt(k,307)*y(k,87) +.350_r8*rxt(k,317)*y(k,24) + & - rxt(k,324)*y(k,26) +rxt(k,330)*y(k,47) +rxt(k,341)*y(k,74) + & - rxt(k,342)*y(k,75) +rxt(k,356)*y(k,95) +rxt(k,371)*y(k,93) + & - .200_r8*rxt(k,380)*y(k,106) +.500_r8*rxt(k,391)*y(k,109) + & - .300_r8*rxt(k,416)*y(k,99) +rxt(k,417)*y(k,100) + & - rxt(k,424)*y(k,102) +rxt(k,428)*y(k,115) +rxt(k,429)*y(k,116) + & - .650_r8*rxt(k,438)*y(k,7) +.730_r8*rxt(k,449)*y(k,66) + & - .800_r8*rxt(k,461)*y(k,143) +.280_r8*rxt(k,469)*y(k,181) + & - .380_r8*rxt(k,471)*y(k,183) +.630_r8*rxt(k,477)*y(k,185) + & - .200_r8*rxt(k,501)*y(k,179) +.500_r8*rxt(k,516)*y(k,67) + & - rxt(k,517)*y(k,152))*y(k,221) + (rxt(k,301)*y(k,197) + & - rxt(k,310)*y(k,204) +rxt(k,323)*y(k,193) + & - .250_r8*rxt(k,338)*y(k,202) +rxt(k,351)*y(k,194) + & - rxt(k,359)*y(k,224) +rxt(k,369)*y(k,200) + & - .470_r8*rxt(k,376)*y(k,207) +rxt(k,398)*y(k,190) + & - .920_r8*rxt(k,408)*y(k,205) +.920_r8*rxt(k,414)*y(k,206) + & - rxt(k,422)*y(k,101) +rxt(k,433)*y(k,229) +rxt(k,440)*y(k,191) + & - rxt(k,445)*y(k,192) +.170_r8*rxt(k,451)*y(k,198) + & - .400_r8*rxt(k,454)*y(k,208) +.830_r8*rxt(k,457)*y(k,210) + & - rxt(k,460)*y(k,223) +rxt(k,467)*y(k,228) +rxt(k,473)*y(k,230) + & - rxt(k,476)*y(k,231) +.900_r8*rxt(k,492)*y(k,226) + & - .800_r8*rxt(k,497)*y(k,227))*y(k,124) + (rxt(k,221)*y(k,59) + & - 2.000_r8*rxt(k,298)*y(k,197) +rxt(k,321)*y(k,193) + & - .900_r8*rxt(k,332)*y(k,196) +rxt(k,349)*y(k,194) + & - .300_r8*rxt(k,361)*y(k,225) +.730_r8*rxt(k,373)*y(k,207) + & - rxt(k,382)*y(k,209) +rxt(k,406)*y(k,205) +rxt(k,411)*y(k,206) + & - 1.200_r8*rxt(k,420)*y(k,101) +.800_r8*rxt(k,431)*y(k,229) + & - .500_r8*rxt(k,485)*y(k,216) +rxt(k,490)*y(k,226) + & - rxt(k,495)*y(k,227))*y(k,197) + (.130_r8*rxt(k,319)*y(k,25) + & - .280_r8*rxt(k,348)*y(k,29) +.140_r8*rxt(k,378)*y(k,105) + & - .280_r8*rxt(k,392)*y(k,111) +.370_r8*rxt(k,425)*y(k,98) + & - .570_r8*rxt(k,480)*y(k,6) +.570_r8*rxt(k,483)*y(k,110))*y(k,135) & - + (rxt(k,295)*y(k,42) +.470_r8*rxt(k,375)*y(k,207) + & - rxt(k,409)*y(k,205) +rxt(k,415)*y(k,206) +rxt(k,423)*y(k,101) + & - rxt(k,434)*y(k,229))*y(k,126) + (.470_r8*rxt(k,372)*y(k,207) + & - rxt(k,405)*y(k,205) +rxt(k,410)*y(k,206) +rxt(k,419)*y(k,101) + & - rxt(k,430)*y(k,229))*y(k,196) + (rxt(k,279)*y(k,43) + & - rxt(k,282)*y(k,46) +rxt(k,214)*y(k,42) +rxt(k,217)*y(k,79))*y(k,56) & - + (.070_r8*rxt(k,450)*y(k,198) +.160_r8*rxt(k,453)*y(k,208) + & - .330_r8*rxt(k,456)*y(k,210))*y(k,203) + (rxt(k,250)*y(k,17) + & - rxt(k,296)*y(k,133))*y(k,42) + (rxt(k,11) +rxt(k,212))*y(k,90) & - + (1.340_r8*rxt(k,51) +.660_r8*rxt(k,52))*y(k,105) & - + (rxt(k,175)*y(k,76) +rxt(k,340)*y(k,201))*y(k,134) +rxt(k,20) & - *y(k,1) +.900_r8*rxt(k,21)*y(k,2) +rxt(k,22)*y(k,8) & - +1.500_r8*rxt(k,23)*y(k,9) +.560_r8*rxt(k,24)*y(k,10) +rxt(k,25) & - *y(k,11) +.600_r8*rxt(k,26)*y(k,12) +.600_r8*rxt(k,27)*y(k,13) & - +rxt(k,28)*y(k,14) +rxt(k,29)*y(k,23) +rxt(k,30)*y(k,27) +rxt(k,31) & - *y(k,30) +rxt(k,35)*y(k,45) +rxt(k,37)*y(k,49) +rxt(k,312)*y(k,217) & - *y(k,54) +2.000_r8*rxt(k,44)*y(k,74) +2.000_r8*rxt(k,45)*y(k,75) & - +rxt(k,171)*y(k,133)*y(k,79) +.670_r8*rxt(k,46)*y(k,93) +rxt(k,47) & - *y(k,94) +rxt(k,48)*y(k,95) +rxt(k,49)*y(k,102) +rxt(k,50)*y(k,103) & - +rxt(k,57)*y(k,116) +rxt(k,62)*y(k,144) +rxt(k,63)*y(k,147) & - +rxt(k,65)*y(k,174) +rxt(k,66)*y(k,175) +rxt(k,67)*y(k,176) & - +rxt(k,68)*y(k,177) +rxt(k,69)*y(k,178) +1.200_r8*rxt(k,70)*y(k,179) & - +rxt(k,71)*y(k,180) +rxt(k,73)*y(k,184) +rxt(k,74)*y(k,186) & - +1.200_r8*rxt(k,320)*y(k,193)*y(k,193) +rxt(k,339)*y(k,201) & - +rxt(k,309)*y(k,204) +rxt(k,413)*y(k,206) - loss(k,93) = (rxt(k,310)* y(k,124) +rxt(k,308)* y(k,203) + rxt(k,309) & - + het_rates(k,204))* y(k,204) - prod(k,93) =rxt(k,294)*y(k,203)*y(k,42) - loss(k,176) = (rxt(k,408)* y(k,124) +rxt(k,409)* y(k,126) +rxt(k,405) & - * y(k,196) +rxt(k,406)* y(k,197) +rxt(k,407)* y(k,203) & + prod(k,144) =rxt(k,368)*y(k,226)*y(k,16) + loss(k,128) = (rxt(k,339)* y(k,134) + rxt(k,338) + het_rates(k,203)) & + * y(k,203) + prod(k,128) =rxt(k,43)*y(k,72) +.750_r8*rxt(k,337)*y(k,204)*y(k,124) + loss(k,168) = (rxt(k,336)* y(k,90) +rxt(k,337)* y(k,124) + het_rates(k,204)) & + * y(k,204) + prod(k,168) =rxt(k,343)*y(k,226)*y(k,25) + loss(k,124) = (rxt(k,307)* y(k,90) +rxt(k,309)* y(k,124) + rxt(k,308) & + het_rates(k,205))* y(k,205) - prod(k,176) =.600_r8*rxt(k,426)*y(k,221)*y(k,98) - loss(k,177) = (rxt(k,414)* y(k,124) +rxt(k,415)* y(k,126) +rxt(k,410) & - * y(k,196) +rxt(k,411)* y(k,197) +rxt(k,412)* y(k,203) + rxt(k,413) & + prod(k,124) =rxt(k,294)*y(k,90)*y(k,42) + loss(k,209) = (rxt(k,407)* y(k,90) +rxt(k,408)* y(k,124) +rxt(k,409) & + * y(k,126) +rxt(k,405)* y(k,198) +rxt(k,406)* y(k,199) & + het_rates(k,206))* y(k,206) - prod(k,177) =.400_r8*rxt(k,426)*y(k,221)*y(k,98) - loss(k,178) = ((rxt(k,376) +rxt(k,377))* y(k,124) +rxt(k,375)* y(k,126) & - +rxt(k,372)* y(k,196) +rxt(k,373)* y(k,197) +rxt(k,374)* y(k,203) & + prod(k,209) =.600_r8*rxt(k,426)*y(k,226)*y(k,99) + loss(k,210) = (rxt(k,412)* y(k,90) +rxt(k,414)* y(k,124) +rxt(k,415) & + * y(k,126) +rxt(k,410)* y(k,198) +rxt(k,411)* y(k,199) + rxt(k,413) & + het_rates(k,207))* y(k,207) - prod(k,178) = (.500_r8*rxt(k,379)*y(k,105) +.200_r8*rxt(k,380)*y(k,106) + & - rxt(k,393)*y(k,111))*y(k,221) - loss(k,130) = (rxt(k,454)* y(k,124) +rxt(k,455)* y(k,125) +rxt(k,453) & - * y(k,203) + het_rates(k,208))* y(k,208) - prod(k,130) =.600_r8*rxt(k,25)*y(k,11) - loss(k,180) = (rxt(k,385)* y(k,124) +rxt(k,394)* y(k,125) +rxt(k,386) & - * y(k,126) +rxt(k,381)* y(k,196) +rxt(k,382)* y(k,197) +rxt(k,383) & - * y(k,203) + 2._r8*rxt(k,384)* y(k,209) + het_rates(k,209))* y(k,209) - prod(k,180) = (.660_r8*rxt(k,51) +.500_r8*rxt(k,379)*y(k,221))*y(k,105) & - + (rxt(k,55) +rxt(k,395))*y(k,109) +.500_r8*rxt(k,380)*y(k,221) & + prod(k,210) =.400_r8*rxt(k,426)*y(k,226)*y(k,99) + loss(k,206) = (rxt(k,421)* y(k,90) +rxt(k,422)* y(k,124) +rxt(k,423) & + * y(k,126) +rxt(k,419)* y(k,198) +rxt(k,420)* y(k,199) & + + het_rates(k,208))* y(k,208) + prod(k,206) =rxt(k,418)*y(k,126)*y(k,99) + loss(k,46) = (rxt(k,543)* y(k,90) +rxt(k,544)* y(k,124) + het_rates(k,209)) & + * y(k,209) + prod(k,46) =rxt(k,546)*y(k,226)*y(k,99) + loss(k,47) = (rxt(k,547)* y(k,90) +rxt(k,548)* y(k,124) + het_rates(k,210)) & + * y(k,210) + prod(k,47) =rxt(k,549)*y(k,226)*y(k,104) + loss(k,211) = (rxt(k,374)* y(k,90) + (rxt(k,376) +rxt(k,377))* y(k,124) & + +rxt(k,375)* y(k,126) +rxt(k,372)* y(k,198) +rxt(k,373)* y(k,199) & + + het_rates(k,211))* y(k,211) + prod(k,211) = (.500_r8*rxt(k,379)*y(k,105) +.200_r8*rxt(k,380)*y(k,106) + & + rxt(k,393)*y(k,111))*y(k,226) + loss(k,163) = (rxt(k,453)* y(k,90) +rxt(k,454)* y(k,124) +rxt(k,455) & + * y(k,125) + het_rates(k,212))* y(k,212) + prod(k,163) =.600_r8*rxt(k,25)*y(k,11) + loss(k,213) = (rxt(k,383)* y(k,90) +rxt(k,385)* y(k,124) +rxt(k,394) & + * y(k,125) +rxt(k,386)* y(k,126) +rxt(k,381)* y(k,198) +rxt(k,382) & + * y(k,199) + 2._r8*rxt(k,384)* y(k,213) + het_rates(k,213))* y(k,213) + prod(k,213) = (.660_r8*rxt(k,51) +.500_r8*rxt(k,379)*y(k,226))*y(k,105) & + + (rxt(k,55) +rxt(k,395))*y(k,109) +.500_r8*rxt(k,380)*y(k,226) & *y(k,106) - loss(k,150) = (rxt(k,457)* y(k,124) +rxt(k,458)* y(k,125) +rxt(k,456) & - * y(k,203) + het_rates(k,210))* y(k,210) - prod(k,150) =.600_r8*rxt(k,27)*y(k,13) - loss(k,125) = (rxt(k,388)* y(k,124) +rxt(k,387)* y(k,203) + het_rates(k,211)) & - * y(k,211) - prod(k,125) = (rxt(k,389)*y(k,107) +rxt(k,390)*y(k,108))*y(k,221) - loss(k,106) = (rxt(k,188)* y(k,133) +rxt(k,189)* y(k,134) + het_rates(k,212)) & - * y(k,212) - prod(k,106) = (.800_r8*rxt(k,565)*y(k,214) +.900_r8*rxt(k,567)*y(k,213)) & - *y(k,199) +rxt(k,569)*y(k,213)*y(k,133) - loss(k,126) = ((rxt(k,569) +rxt(k,570))* y(k,133) +rxt(k,568)* y(k,134) & - +rxt(k,567)* y(k,199) + het_rates(k,213))* y(k,213) - prod(k,126) = 0._r8 - loss(k,138) = (rxt(k,565)* y(k,199) + het_rates(k,214))* y(k,214) - prod(k,138) = (rxt(k,575) +rxt(k,574)*y(k,112) +rxt(k,576)*y(k,124))*y(k,220) & - +rxt(k,16)*y(k,124) +rxt(k,569)*y(k,213)*y(k,133) & - +rxt(k,573)*y(k,215)*y(k,134) +rxt(k,578)*y(k,222) - loss(k,102) = (rxt(k,571)* y(k,133) + (rxt(k,572) +rxt(k,573))* y(k,134) & - + het_rates(k,215))* y(k,215) - prod(k,102) =rxt(k,111)*y(k,112) - loss(k,168) = (rxt(k,487)* y(k,124) +rxt(k,488)* y(k,126) +rxt(k,485) & - * y(k,197) +rxt(k,486)* y(k,203) + het_rates(k,216))* y(k,216) - prod(k,168) = (rxt(k,479)*y(k,6) +rxt(k,482)*y(k,110) + & - .500_r8*rxt(k,499)*y(k,178))*y(k,126) +rxt(k,489)*y(k,221)*y(k,128) - loss(k,189) = (rxt(k,239)* y(k,33) +rxt(k,240)* y(k,34) +rxt(k,266)* y(k,35) & + loss(k,181) = (rxt(k,456)* y(k,90) +rxt(k,457)* y(k,124) +rxt(k,458) & + * y(k,125) + het_rates(k,214))* y(k,214) + prod(k,181) =.600_r8*rxt(k,27)*y(k,13) + loss(k,158) = (rxt(k,387)* y(k,90) +rxt(k,388)* y(k,124) + het_rates(k,215)) & + * y(k,215) + prod(k,158) = (rxt(k,389)*y(k,107) +rxt(k,390)*y(k,108))*y(k,226) + loss(k,49) = (rxt(k,551)* y(k,90) +rxt(k,552)* y(k,124) + het_rates(k,216)) & + * y(k,216) + prod(k,49) =rxt(k,554)*y(k,226)*y(k,110) + loss(k,138) = (rxt(k,188)* y(k,133) +rxt(k,189)* y(k,134) + het_rates(k,217)) & + * y(k,217) + prod(k,138) = (.800_r8*rxt(k,579)*y(k,219) +.900_r8*rxt(k,581)*y(k,218)) & + *y(k,201) +rxt(k,583)*y(k,218)*y(k,133) + loss(k,156) = ((rxt(k,583) +rxt(k,584))* y(k,133) +rxt(k,582)* y(k,134) & + +rxt(k,581)* y(k,201) + het_rates(k,218))* y(k,218) + prod(k,156) = 0._r8 + loss(k,174) = (rxt(k,579)* y(k,201) + het_rates(k,219))* y(k,219) + prod(k,174) = (rxt(k,589) +rxt(k,588)*y(k,112) +rxt(k,590)*y(k,124))*y(k,225) & + +rxt(k,16)*y(k,124) +rxt(k,583)*y(k,218)*y(k,133) & + +rxt(k,587)*y(k,220)*y(k,134) +rxt(k,592)*y(k,227) + loss(k,134) = (rxt(k,585)* y(k,133) + (rxt(k,586) +rxt(k,587))* y(k,134) & + + het_rates(k,220))* y(k,220) + prod(k,134) =rxt(k,111)*y(k,112) + loss(k,194) = (rxt(k,486)* y(k,90) +rxt(k,487)* y(k,124) +rxt(k,488) & + * y(k,126) +rxt(k,485)* y(k,199) + het_rates(k,221))* y(k,221) + prod(k,194) = (rxt(k,479)*y(k,6) +rxt(k,482)*y(k,110) + & + .500_r8*rxt(k,499)*y(k,178))*y(k,126) +rxt(k,489)*y(k,226)*y(k,128) + loss(k,223) = (rxt(k,239)* y(k,33) +rxt(k,240)* y(k,34) +rxt(k,266)* y(k,35) & +rxt(k,241)* y(k,36) +rxt(k,242)* y(k,37) +rxt(k,243)* y(k,38) & +rxt(k,244)* y(k,39) +rxt(k,245)* y(k,40) +rxt(k,289)* y(k,41) & - +rxt(k,290)* y(k,43) + (rxt(k,311) +rxt(k,312) +rxt(k,313))* y(k,54) & + +rxt(k,290)* y(k,43) + (rxt(k,310) +rxt(k,311) +rxt(k,312))* y(k,54) & +rxt(k,267)* y(k,55) +rxt(k,275)* y(k,64) +rxt(k,276)* y(k,65) & +rxt(k,153)* y(k,77) +rxt(k,268)* y(k,78) + (rxt(k,269) +rxt(k,270)) & * y(k,81) +rxt(k,291)* y(k,82) +rxt(k,292)* y(k,83) +rxt(k,293) & - * y(k,84) + (rxt(k,246) +rxt(k,247))* y(k,85) +rxt(k,314)* y(k,86) & + * y(k,84) + (rxt(k,246) +rxt(k,247))* y(k,85) +rxt(k,313)* y(k,86) & + (rxt(k,206) +rxt(k,207))* y(k,113) + (rxt(k,156) +rxt(k,157)) & - * y(k,134) +rxt(k,158)* y(k,135) +rxt(k,154)* y(k,232) + rxt(k,155) & - + het_rates(k,217))* y(k,217) - prod(k,189) = (rxt(k,6) +rxt(k,189)*y(k,212))*y(k,134) +rxt(k,7)*y(k,135) & - +.850_r8*rxt(k,566)*y(k,220)*y(k,199) +rxt(k,1)*y(k,232) - loss(k,45) = (rxt(k,160)* y(k,133) +rxt(k,161)* y(k,134) + rxt(k,151) & - + rxt(k,159) + het_rates(k,218))* y(k,218) - prod(k,45) = (rxt(k,163) +rxt(k,162)*y(k,63) +rxt(k,164)*y(k,133) + & - rxt(k,165)*y(k,134) +rxt(k,166)*y(k,135))*y(k,219) +rxt(k,7)*y(k,135) - loss(k,46) = (rxt(k,162)* y(k,63) +rxt(k,164)* y(k,133) +rxt(k,165)* y(k,134) & - +rxt(k,166)* y(k,135) + rxt(k,152) + rxt(k,163) + het_rates(k,219)) & - * y(k,219) - prod(k,46) =rxt(k,156)*y(k,217)*y(k,134) - loss(k,137) = (rxt(k,574)* y(k,112) +rxt(k,576)* y(k,124) +rxt(k,566) & - * y(k,199) + rxt(k,575) + het_rates(k,220))* y(k,220) - prod(k,137) = (rxt(k,126) +rxt(k,130) +rxt(k,568)*y(k,213) + & - rxt(k,572)*y(k,215) +rxt(k,579)*y(k,222))*y(k,134) & - +rxt(k,577)*y(k,222)*y(k,63) - loss(k,190) = (rxt(k,396)* y(k,1) +rxt(k,400)* y(k,2) +rxt(k,481)* y(k,6) & + * y(k,134) +rxt(k,158)* y(k,135) +rxt(k,154)* y(k,239) + rxt(k,155) & + + het_rates(k,222))* y(k,222) + prod(k,223) = (rxt(k,6) +rxt(k,189)*y(k,217))*y(k,134) +rxt(k,12)*y(k,113) & + +rxt(k,7)*y(k,135) +.850_r8*rxt(k,580)*y(k,225)*y(k,201) +rxt(k,1) & + *y(k,239) + loss(k,73) = (rxt(k,160)* y(k,133) +rxt(k,161)* y(k,134) + rxt(k,151) & + + rxt(k,159) + het_rates(k,223))* y(k,223) + prod(k,73) = (rxt(k,163) +rxt(k,162)*y(k,63) +rxt(k,164)*y(k,133) + & + rxt(k,165)*y(k,134) +rxt(k,166)*y(k,135))*y(k,224) +rxt(k,7)*y(k,135) + loss(k,74) = (rxt(k,162)* y(k,63) +rxt(k,164)* y(k,133) +rxt(k,165)* y(k,134) & + +rxt(k,166)* y(k,135) + rxt(k,152) + rxt(k,163) + het_rates(k,224)) & + * y(k,224) + prod(k,74) =rxt(k,156)*y(k,222)*y(k,134) + loss(k,175) = (rxt(k,588)* y(k,112) +rxt(k,590)* y(k,124) +rxt(k,580) & + * y(k,201) + rxt(k,589) + het_rates(k,225))* y(k,225) + prod(k,175) = (rxt(k,126) +rxt(k,130) +rxt(k,582)*y(k,218) + & + rxt(k,586)*y(k,220) +rxt(k,593)*y(k,227))*y(k,134) & + +rxt(k,591)*y(k,227)*y(k,63) + loss(k,224) = (rxt(k,396)* y(k,1) +rxt(k,400)* y(k,2) +rxt(k,481)* y(k,6) & +rxt(k,438)* y(k,7) +rxt(k,441)* y(k,8) +rxt(k,401)* y(k,15) & +rxt(k,368)* y(k,16) +rxt(k,262)* y(k,19) +rxt(k,442)* y(k,22) & - +rxt(k,444)* y(k,23) +rxt(k,317)* y(k,24) +rxt(k,344)* y(k,25) & - +rxt(k,324)* y(k,26) +rxt(k,325)* y(k,27) +rxt(k,327)* y(k,28) & - +rxt(k,365)* y(k,29) +rxt(k,352)* y(k,30) +rxt(k,353)* y(k,31) & + +rxt(k,444)* y(k,23) +rxt(k,316)* y(k,24) +rxt(k,343)* y(k,25) & + +rxt(k,323)* y(k,26) +rxt(k,324)* y(k,27) +rxt(k,326)* y(k,28) & + +rxt(k,365)* y(k,29) +rxt(k,351)* y(k,30) +rxt(k,352)* y(k,31) & +rxt(k,448)* y(k,32) +rxt(k,278)* y(k,41) +rxt(k,297)* y(k,42) & - +rxt(k,280)* y(k,43) +rxt(k,281)* y(k,44) +rxt(k,329)* y(k,45) & - +rxt(k,283)* y(k,46) +rxt(k,330)* y(k,47) +rxt(k,366)* y(k,48) & - +rxt(k,355)* y(k,49) +rxt(k,335)* y(k,50) +rxt(k,336)* y(k,51) & + +rxt(k,280)* y(k,43) +rxt(k,281)* y(k,44) +rxt(k,328)* y(k,45) & + +rxt(k,283)* y(k,46) +rxt(k,329)* y(k,47) +rxt(k,366)* y(k,48) & + +rxt(k,354)* y(k,49) +rxt(k,334)* y(k,50) +rxt(k,335)* y(k,51) & +rxt(k,302)* y(k,52) +rxt(k,303)* y(k,53) +rxt(k,304)* y(k,54) & +rxt(k,285)* y(k,55) + (rxt(k,232) +rxt(k,233))* y(k,59) +rxt(k,230) & - * y(k,60) + (rxt(k,305) +rxt(k,315))* y(k,62) +rxt(k,449)* y(k,66) & - + (rxt(k,503) +rxt(k,516))* y(k,67) +rxt(k,341)* y(k,74) +rxt(k,342) & - * y(k,75) +rxt(k,179)* y(k,77) +rxt(k,180)* y(k,79) +rxt(k,264) & - * y(k,81) +rxt(k,286)* y(k,82) +rxt(k,287)* y(k,83) +rxt(k,288) & - * y(k,84) +rxt(k,235)* y(k,85) +rxt(k,306)* y(k,86) +rxt(k,307) & - * y(k,87) +rxt(k,211)* y(k,89) +rxt(k,187)* y(k,90) +rxt(k,238) & - * y(k,92) +rxt(k,371)* y(k,93) +rxt(k,402)* y(k,94) +rxt(k,356) & - * y(k,95) +rxt(k,403)* y(k,96) +rxt(k,404)* y(k,97) +rxt(k,426) & - * y(k,98) +rxt(k,416)* y(k,99) +rxt(k,417)* y(k,100) +rxt(k,424) & - * y(k,102) +rxt(k,427)* y(k,103) +rxt(k,379)* y(k,105) +rxt(k,380) & - * y(k,106) +rxt(k,389)* y(k,107) +rxt(k,390)* y(k,108) +rxt(k,391) & - * y(k,109) +rxt(k,484)* y(k,110) +rxt(k,393)* y(k,111) +rxt(k,202) & - * y(k,112) +rxt(k,428)* y(k,115) +rxt(k,429)* y(k,116) +rxt(k,519) & - * y(k,120) +rxt(k,210)* y(k,125) +rxt(k,201)* y(k,126) +rxt(k,357) & - * y(k,127) +rxt(k,489)* y(k,128) +rxt(k,182)* y(k,133) +rxt(k,183) & - * y(k,135) +rxt(k,505)* y(k,138) +rxt(k,343)* y(k,140) +rxt(k,461) & - * y(k,143) +rxt(k,464)* y(k,144) +rxt(k,360)* y(k,147) +rxt(k,364) & - * y(k,148) +rxt(k,510)* y(k,149) +rxt(k,515)* y(k,151) +rxt(k,517) & - * y(k,152) +rxt(k,493)* y(k,175) +rxt(k,494)* y(k,176) +rxt(k,498) & - * y(k,177) +rxt(k,500)* y(k,178) +rxt(k,501)* y(k,179) +rxt(k,468) & - * y(k,180) +rxt(k,469)* y(k,181) +rxt(k,435)* y(k,182) +rxt(k,471) & - * y(k,183) +rxt(k,474)* y(k,184) +rxt(k,477)* y(k,185) +rxt(k,478) & - * y(k,186) +rxt(k,181)* y(k,203) + 2._r8*(rxt(k,184) +rxt(k,185)) & - * y(k,221) + het_rates(k,221))* y(k,221) - prod(k,190) = (2.000_r8*rxt(k,173)*y(k,76) +rxt(k,176)*y(k,133) + & + * y(k,60) +rxt(k,314)* y(k,62) +rxt(k,449)* y(k,66) + (rxt(k,503) + & + rxt(k,517))* y(k,67) +rxt(k,340)* y(k,74) +rxt(k,341)* y(k,75) & + +rxt(k,179)* y(k,77) +rxt(k,180)* y(k,79) +rxt(k,264)* y(k,81) & + +rxt(k,286)* y(k,82) +rxt(k,287)* y(k,83) +rxt(k,288)* y(k,84) & + +rxt(k,235)* y(k,85) +rxt(k,305)* y(k,86) +rxt(k,306)* y(k,87) & + +rxt(k,211)* y(k,89) +rxt(k,181)* y(k,90) +rxt(k,187)* y(k,91) & + +rxt(k,238)* y(k,93) +rxt(k,371)* y(k,94) +rxt(k,402)* y(k,95) & + +rxt(k,356)* y(k,96) +rxt(k,403)* y(k,97) +rxt(k,404)* y(k,98) & + +rxt(k,426)* y(k,99) +rxt(k,416)* y(k,100) +rxt(k,417)* y(k,101) & + +rxt(k,424)* y(k,102) +rxt(k,427)* y(k,103) +rxt(k,379)* y(k,105) & + +rxt(k,380)* y(k,106) +rxt(k,389)* y(k,107) +rxt(k,390)* y(k,108) & + +rxt(k,391)* y(k,109) +rxt(k,484)* y(k,110) +rxt(k,393)* y(k,111) & + +rxt(k,202)* y(k,112) +rxt(k,428)* y(k,115) +rxt(k,429)* y(k,116) & + +rxt(k,519)* y(k,120) +rxt(k,210)* y(k,125) +rxt(k,201)* y(k,126) & + +rxt(k,357)* y(k,127) +rxt(k,489)* y(k,128) +rxt(k,182)* y(k,133) & + +rxt(k,183)* y(k,135) +rxt(k,505)* y(k,138) +rxt(k,342)* y(k,140) & + +rxt(k,461)* y(k,143) +rxt(k,464)* y(k,144) +rxt(k,360)* y(k,147) & + +rxt(k,364)* y(k,148) +rxt(k,511)* y(k,149) +rxt(k,516)* y(k,151) & + +rxt(k,507)* y(k,152) +rxt(k,493)* y(k,175) +rxt(k,494)* y(k,176) & + +rxt(k,498)* y(k,177) +rxt(k,500)* y(k,178) +rxt(k,501)* y(k,179) & + +rxt(k,468)* y(k,180) +rxt(k,469)* y(k,181) +rxt(k,435)* y(k,182) & + +rxt(k,471)* y(k,183) +rxt(k,474)* y(k,184) +rxt(k,477)* y(k,185) & + +rxt(k,478)* y(k,186) + 2._r8*(rxt(k,184) +rxt(k,185))* y(k,226) & + + het_rates(k,226))* y(k,226) + prod(k,224) = (2.000_r8*rxt(k,173)*y(k,76) +rxt(k,176)*y(k,133) + & rxt(k,177)*y(k,135) +rxt(k,198)*y(k,126) +rxt(k,203)*y(k,124) + & - rxt(k,219)*y(k,56) +.450_r8*rxt(k,333)*y(k,196) + & - .150_r8*rxt(k,362)*y(k,225) +.450_r8*rxt(k,383)*y(k,209) + & - .200_r8*rxt(k,387)*y(k,211) +.400_r8*rxt(k,436)*y(k,189) + & - .400_r8*rxt(k,450)*y(k,198) +.400_r8*rxt(k,456)*y(k,210))*y(k,203) & - + (rxt(k,178)*y(k,76) +.130_r8*rxt(k,319)*y(k,25) + & - .360_r8*rxt(k,348)*y(k,29) +.240_r8*rxt(k,378)*y(k,105) + & - .360_r8*rxt(k,392)*y(k,111) +.320_r8*rxt(k,425)*y(k,98) + & + rxt(k,219)*y(k,56) +.450_r8*rxt(k,332)*y(k,198) + & + .150_r8*rxt(k,362)*y(k,230) +.450_r8*rxt(k,383)*y(k,213) + & + .200_r8*rxt(k,387)*y(k,215) +.400_r8*rxt(k,436)*y(k,189) + & + .400_r8*rxt(k,450)*y(k,200) +.400_r8*rxt(k,456)*y(k,214))*y(k,90) & + + (rxt(k,178)*y(k,76) +.130_r8*rxt(k,318)*y(k,25) + & + .360_r8*rxt(k,347)*y(k,29) +.240_r8*rxt(k,378)*y(k,105) + & + .360_r8*rxt(k,392)*y(k,111) +.320_r8*rxt(k,425)*y(k,99) + & .630_r8*rxt(k,480)*y(k,6) +.630_r8*rxt(k,483)*y(k,110))*y(k,135) & + (rxt(k,170)*y(k,77) +rxt(k,171)*y(k,79) +rxt(k,234)*y(k,85) + & - rxt(k,237)*y(k,92) +rxt(k,263)*y(k,81) +rxt(k,265)*y(k,91) + & + rxt(k,237)*y(k,93) +rxt(k,263)*y(k,81) +rxt(k,265)*y(k,92) + & rxt(k,296)*y(k,42))*y(k,133) + (.300_r8*rxt(k,303)*y(k,53) + & - .650_r8*rxt(k,317)*y(k,24) +.500_r8*rxt(k,325)*y(k,27) + & + .650_r8*rxt(k,316)*y(k,24) +.500_r8*rxt(k,324)*y(k,27) + & .500_r8*rxt(k,360)*y(k,147) +.100_r8*rxt(k,380)*y(k,106) + & - .600_r8*rxt(k,427)*y(k,103) +.500_r8*rxt(k,435)*y(k,182))*y(k,221) & - + (rxt(k,311)*y(k,54) +rxt(k,153)*y(k,77) + & - 2.000_r8*rxt(k,154)*y(k,232) +rxt(k,246)*y(k,85) + & - rxt(k,269)*y(k,81) +rxt(k,314)*y(k,86))*y(k,217) + (rxt(k,3) + & - rxt(k,273)*y(k,73))*y(k,232) +rxt(k,21)*y(k,2) +rxt(k,22)*y(k,8) & - +rxt(k,29)*y(k,23) +rxt(k,30)*y(k,27) +rxt(k,31)*y(k,30) +rxt(k,32) & - *y(k,32) +rxt(k,38)*y(k,51) +rxt(k,39)*y(k,53) +rxt(k,43)*y(k,72) & - +2.000_r8*rxt(k,4)*y(k,79) +rxt(k,9)*y(k,89) +rxt(k,10)*y(k,90) & - +rxt(k,106)*y(k,91) +rxt(k,107)*y(k,92) +rxt(k,47)*y(k,94) & - +rxt(k,54)*y(k,108) +.500_r8*rxt(k,529)*y(k,125) +rxt(k,59)*y(k,128) & - +rxt(k,62)*y(k,144) +rxt(k,63)*y(k,147) +rxt(k,64)*y(k,148) & - +rxt(k,66)*y(k,175) +rxt(k,68)*y(k,177) +rxt(k,71)*y(k,180) & - +rxt(k,72)*y(k,182) +rxt(k,73)*y(k,184) +rxt(k,74)*y(k,186) - loss(k,120) = (rxt(k,577)* y(k,63) +rxt(k,579)* y(k,134) + rxt(k,578) & - + het_rates(k,222))* y(k,222) - prod(k,120) = (rxt(k,120) +rxt(k,121) +rxt(k,122) +rxt(k,123) +rxt(k,124) + & - rxt(k,125) +rxt(k,570)*y(k,213) +rxt(k,571)*y(k,215))*y(k,133) & + .600_r8*rxt(k,427)*y(k,103) +.500_r8*rxt(k,435)*y(k,182))*y(k,226) & + + (rxt(k,153)*y(k,77) +2.000_r8*rxt(k,154)*y(k,239) + & + rxt(k,246)*y(k,85) +rxt(k,269)*y(k,81) +rxt(k,310)*y(k,54) + & + rxt(k,313)*y(k,86))*y(k,222) + (rxt(k,3) +rxt(k,273)*y(k,73)) & + *y(k,239) +rxt(k,21)*y(k,2) +rxt(k,22)*y(k,8) +rxt(k,29)*y(k,23) & + +rxt(k,30)*y(k,27) +rxt(k,31)*y(k,30) +rxt(k,32)*y(k,32) +rxt(k,38) & + *y(k,51) +rxt(k,39)*y(k,53) +.330_r8*rxt(k,40)*y(k,54) +rxt(k,43) & + *y(k,72) +2.000_r8*rxt(k,4)*y(k,79) +rxt(k,9)*y(k,89) +rxt(k,10) & + *y(k,91) +rxt(k,106)*y(k,92) +rxt(k,107)*y(k,93) +rxt(k,47)*y(k,95) & + +rxt(k,50)*y(k,103) +rxt(k,54)*y(k,108) +.500_r8*rxt(k,529)*y(k,125) & + +rxt(k,59)*y(k,128) +rxt(k,62)*y(k,144) +rxt(k,63)*y(k,147) & + +rxt(k,64)*y(k,148) +rxt(k,66)*y(k,175) +rxt(k,68)*y(k,177) & + +rxt(k,71)*y(k,180) +rxt(k,72)*y(k,182) +rxt(k,73)*y(k,184) & + +rxt(k,74)*y(k,186) + loss(k,169) = (rxt(k,591)* y(k,63) +rxt(k,593)* y(k,134) + rxt(k,592) & + + het_rates(k,227))* y(k,227) + prod(k,169) = (rxt(k,120) +rxt(k,121) +rxt(k,122) +rxt(k,123) +rxt(k,124) + & + rxt(k,125) +rxt(k,584)*y(k,218) +rxt(k,585)*y(k,220))*y(k,133) & + (rxt(k,127) +rxt(k,128) +rxt(k,129) +rxt(k,131) +rxt(k,132) + & rxt(k,133))*y(k,134) - loss(k,94) = (rxt(k,460)* y(k,124) +rxt(k,459)* y(k,203) + het_rates(k,223)) & - * y(k,223) - prod(k,94) = (.200_r8*rxt(k,449)*y(k,66) +.140_r8*rxt(k,461)*y(k,143) + & - rxt(k,464)*y(k,144))*y(k,221) - loss(k,142) = (rxt(k,359)* y(k,124) +rxt(k,358)* y(k,203) + het_rates(k,224)) & - * y(k,224) - prod(k,142) = (.500_r8*rxt(k,360)*y(k,147) +rxt(k,365)*y(k,29))*y(k,221) - loss(k,169) = (rxt(k,363)* y(k,124) +rxt(k,361)* y(k,197) +rxt(k,362) & - * y(k,203) + het_rates(k,225))* y(k,225) - prod(k,169) = (rxt(k,364)*y(k,148) +rxt(k,366)*y(k,48) + & - .150_r8*rxt(k,501)*y(k,179))*y(k,221) + (.060_r8*rxt(k,480)*y(k,6) + & - .060_r8*rxt(k,483)*y(k,110))*y(k,135) +.150_r8*rxt(k,70)*y(k,179) - loss(k,167) = (rxt(k,492)* y(k,124) +rxt(k,490)* y(k,197) +rxt(k,491) & - * y(k,203) + het_rates(k,226))* y(k,226) - prod(k,167) = (.500_r8*rxt(k,499)*y(k,126) +rxt(k,500)*y(k,221))*y(k,178) & - +rxt(k,493)*y(k,221)*y(k,175) - loss(k,166) = (rxt(k,497)* y(k,124) +rxt(k,495)* y(k,197) +rxt(k,496) & - * y(k,203) + het_rates(k,227))* y(k,227) - prod(k,166) = (rxt(k,481)*y(k,6) +rxt(k,484)*y(k,110) +rxt(k,498)*y(k,177)) & - *y(k,221) - loss(k,131) = (rxt(k,467)* y(k,124) +rxt(k,466)* y(k,203) + het_rates(k,228)) & + loss(k,126) = (rxt(k,459)* y(k,90) +rxt(k,460)* y(k,124) + het_rates(k,228)) & * y(k,228) - prod(k,131) = (rxt(k,468)*y(k,180) +.650_r8*rxt(k,469)*y(k,181))*y(k,221) - loss(k,171) = (rxt(k,433)* y(k,124) +rxt(k,434)* y(k,126) +rxt(k,430) & - * y(k,196) +rxt(k,431)* y(k,197) +rxt(k,432)* y(k,203) & - + het_rates(k,229))* y(k,229) - prod(k,171) = (rxt(k,402)*y(k,94) +rxt(k,403)*y(k,96) +rxt(k,404)*y(k,97) + & - .400_r8*rxt(k,427)*y(k,103) +.500_r8*rxt(k,435)*y(k,182))*y(k,221) - loss(k,132) = (rxt(k,473)* y(k,124) +rxt(k,472)* y(k,203) + het_rates(k,230)) & - * y(k,230) - prod(k,132) = (.560_r8*rxt(k,471)*y(k,183) +rxt(k,474)*y(k,184))*y(k,221) - loss(k,103) = (rxt(k,476)* y(k,124) +rxt(k,475)* y(k,203) + het_rates(k,231)) & - * y(k,231) - prod(k,103) = (.300_r8*rxt(k,477)*y(k,185) +rxt(k,478)*y(k,186))*y(k,221) - loss(k,201) = (rxt(k,273)* y(k,73) +rxt(k,518)* y(k,153) +rxt(k,154) & - * y(k,217) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,232)) & - * y(k,232) - prod(k,201) = (rxt(k,278)*y(k,41) +rxt(k,280)*y(k,43) +rxt(k,281)*y(k,44) + & - rxt(k,283)*y(k,46) +rxt(k,288)*y(k,84) +rxt(k,304)*y(k,54) + & - rxt(k,179)*y(k,77) +rxt(k,180)*y(k,79) +rxt(k,181)*y(k,203) + & - rxt(k,184)*y(k,221) +rxt(k,187)*y(k,90) +rxt(k,211)*y(k,89) + & - rxt(k,235)*y(k,85) +rxt(k,238)*y(k,92) +rxt(k,264)*y(k,81) + & - rxt(k,297)*y(k,42) +rxt(k,303)*y(k,53) +rxt(k,307)*y(k,87) + & - rxt(k,327)*y(k,28) +rxt(k,329)*y(k,45) +rxt(k,335)*y(k,50) + & - rxt(k,336)*y(k,51) +rxt(k,352)*y(k,30) +rxt(k,353)*y(k,31) + & - rxt(k,355)*y(k,49) +rxt(k,360)*y(k,147) +rxt(k,364)*y(k,148) + & + prod(k,126) = (.200_r8*rxt(k,449)*y(k,66) +.140_r8*rxt(k,461)*y(k,143) + & + rxt(k,464)*y(k,144))*y(k,226) + loss(k,171) = (rxt(k,358)* y(k,90) +rxt(k,359)* y(k,124) + het_rates(k,229)) & + * y(k,229) + prod(k,171) = (.500_r8*rxt(k,360)*y(k,147) +rxt(k,365)*y(k,29))*y(k,226) + loss(k,204) = (rxt(k,362)* y(k,90) +rxt(k,363)* y(k,124) +rxt(k,361) & + * y(k,199) + het_rates(k,230))* y(k,230) + prod(k,204) = (rxt(k,364)*y(k,148) +rxt(k,366)*y(k,48) + & + .150_r8*rxt(k,501)*y(k,179))*y(k,226) + (.060_r8*rxt(k,480)*y(k,6) + & + .060_r8*rxt(k,483)*y(k,110))*y(k,135) +.150_r8*rxt(k,70)*y(k,179) + loss(k,201) = (rxt(k,491)* y(k,90) +rxt(k,492)* y(k,124) +rxt(k,490) & + * y(k,199) + het_rates(k,231))* y(k,231) + prod(k,201) = (.500_r8*rxt(k,499)*y(k,126) +rxt(k,500)*y(k,226))*y(k,178) & + +rxt(k,493)*y(k,226)*y(k,175) + loss(k,191) = (rxt(k,496)* y(k,90) +rxt(k,497)* y(k,124) +rxt(k,495) & + * y(k,199) + het_rates(k,232))* y(k,232) + prod(k,191) = (rxt(k,481)*y(k,6) +rxt(k,484)*y(k,110) +rxt(k,498)*y(k,177)) & + *y(k,226) + loss(k,164) = (rxt(k,466)* y(k,90) +rxt(k,467)* y(k,124) + het_rates(k,233)) & + * y(k,233) + prod(k,164) = (rxt(k,468)*y(k,180) +.650_r8*rxt(k,469)*y(k,181))*y(k,226) + loss(k,50) = (rxt(k,557)* y(k,90) +rxt(k,558)* y(k,124) + het_rates(k,234)) & + * y(k,234) + prod(k,50) =rxt(k,556)*y(k,226)*y(k,181) + loss(k,205) = (rxt(k,432)* y(k,90) +rxt(k,433)* y(k,124) +rxt(k,434) & + * y(k,126) +rxt(k,430)* y(k,198) +rxt(k,431)* y(k,199) & + + het_rates(k,235))* y(k,235) + prod(k,205) = (rxt(k,402)*y(k,95) +rxt(k,403)*y(k,97) +rxt(k,404)*y(k,98) + & + .400_r8*rxt(k,427)*y(k,103) +.500_r8*rxt(k,435)*y(k,182))*y(k,226) + loss(k,165) = (rxt(k,472)* y(k,90) +rxt(k,473)* y(k,124) + het_rates(k,236)) & + * y(k,236) + prod(k,165) = (.560_r8*rxt(k,471)*y(k,183) +rxt(k,474)*y(k,184))*y(k,226) + loss(k,51) = (rxt(k,560)* y(k,90) +rxt(k,561)* y(k,124) + het_rates(k,237)) & + * y(k,237) + prod(k,51) =rxt(k,559)*y(k,226)*y(k,183) + loss(k,135) = (rxt(k,475)* y(k,90) +rxt(k,476)* y(k,124) + het_rates(k,238)) & + * y(k,238) + prod(k,135) = (.300_r8*rxt(k,477)*y(k,185) +rxt(k,478)*y(k,186))*y(k,226) + loss(k,237) = (rxt(k,273)* y(k,73) +rxt(k,518)* y(k,153) +rxt(k,154) & + * y(k,222) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,239)) & + * y(k,239) + prod(k,237) = (rxt(k,179)*y(k,77) +rxt(k,180)*y(k,79) +rxt(k,181)*y(k,90) + & + rxt(k,184)*y(k,226) +rxt(k,187)*y(k,91) +rxt(k,211)*y(k,89) + & + rxt(k,235)*y(k,85) +rxt(k,238)*y(k,93) +rxt(k,264)*y(k,81) + & + rxt(k,278)*y(k,41) +rxt(k,280)*y(k,43) +rxt(k,281)*y(k,44) + & + rxt(k,283)*y(k,46) +rxt(k,288)*y(k,84) +rxt(k,297)*y(k,42) + & + rxt(k,303)*y(k,53) +rxt(k,304)*y(k,54) +rxt(k,306)*y(k,87) + & + rxt(k,326)*y(k,28) +rxt(k,328)*y(k,45) +rxt(k,334)*y(k,50) + & + rxt(k,335)*y(k,51) +rxt(k,351)*y(k,30) +rxt(k,352)*y(k,31) + & + rxt(k,354)*y(k,49) +rxt(k,360)*y(k,147) +rxt(k,364)*y(k,148) + & rxt(k,366)*y(k,48) +.500_r8*rxt(k,379)*y(k,105) +rxt(k,519)*y(k,120)) & - *y(k,221) + (rxt(k,549)*y(k,92) +rxt(k,555)*y(k,92) + & - rxt(k,556)*y(k,91) +rxt(k,560)*y(k,92) +rxt(k,561)*y(k,91))*y(k,85) & - +rxt(k,174)*y(k,203)*y(k,76) +rxt(k,136)*y(k,80) + *y(k,226) + (rxt(k,563)*y(k,93) +rxt(k,569)*y(k,93) + & + rxt(k,570)*y(k,92) +rxt(k,574)*y(k,93) +rxt(k,575)*y(k,92))*y(k,85) & + + (rxt(k,521) +rxt(k,174)*y(k,76))*y(k,90) +.050_r8*rxt(k,40) & + *y(k,54) +rxt(k,136)*y(k,80) end do end subroutine imp_prod_loss end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 index b1b52bb4f5..8c406449b0 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_rxt_rates_conv.F90 @@ -8,17 +8,17 @@ 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,:, 232) ! rate_const*H2O - rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 232) ! rate_const*H2O - rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 232) ! rate_const*H2O + rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 239) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 239) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 239) ! rate_const*H2O rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 79) ! rate_const*H2O2 rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 134) ! rate_const*O2 rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 134) ! rate_const*O2 rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 135) ! rate_const*O3 rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 135) ! rate_const*O3 rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 89) ! rate_const*HNO3 - rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 90) ! rate_const*HO2NO2 - rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 90) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 91) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 91) ! rate_const*HO2NO2 rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 113) ! rate_const*N2O rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 114) ! rate_const*N2O5 rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 114) ! rate_const*N2O5 @@ -53,9 +53,9 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 72) ! rate_const*EOOH rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 74) ! rate_const*GLYALD rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 75) ! rate_const*GLYOXAL - rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 93) ! rate_const*HONITR - rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 94) ! rate_const*HPALD - rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 95) ! rate_const*HYAC + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 94) ! rate_const*HONITR + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 95) ! rate_const*HPALD + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 96) ! rate_const*HYAC rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 102) ! rate_const*ISOPNOOH rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 103) ! rate_const*ISOPOOH rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 105) ! rate_const*MACR @@ -113,8 +113,8 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 84) ! rate_const*HCFC22 rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 85) ! rate_const*HCL rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 88) ! rate_const*HF - rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 91) ! rate_const*HOBR - rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 92) ! rate_const*HOCL + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 92) ! rate_const*HOBR + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 93) ! rate_const*HOCL rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 137) ! rate_const*OCLO rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 150) ! rate_const*SF6 rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 63) ! rate_const*CO2 @@ -158,45 +158,45 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 164) ! rate_const*soa4_a2 rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 165) ! rate_const*soa5_a1 rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 166) ! rate_const*soa5_a2 - rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 218) ! rate_const*O2_1D - rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 219) ! rate_const*O2_1S - rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 217)*sol(:ncol,:, 77) ! rate_const*O1D*H2 - rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 217)*sol(:ncol,:, 232) ! rate_const*O1D*H2O - rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 217) ! rate_const*N2*O1D - rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 217)*sol(:ncol,:, 134) ! rate_const*O1D*O2 - rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 217)*sol(:ncol,:, 134) ! rate_const*O1D*O2 - rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 217)*sol(:ncol,:, 135) ! rate_const*O1D*O3 - rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 218) ! rate_const*N2*O2_1D - rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 218)*sol(:ncol,:, 133) ! rate_const*O2_1D*O - rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 218)*sol(:ncol,:, 134) ! rate_const*O2_1D*O2 - rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 219)*sol(:ncol,:, 63) ! rate_const*O2_1S*CO2 - rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 219) ! rate_const*N2*O2_1S - rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 219)*sol(:ncol,:, 133) ! rate_const*O2_1S*O - rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 219)*sol(:ncol,:, 134) ! rate_const*O2_1S*O2 - rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 219)*sol(:ncol,:, 135) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 223) ! rate_const*O2_1D + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 224) ! rate_const*O2_1S + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 222)*sol(:ncol,:, 77) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 222)*sol(:ncol,:, 239) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 222) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 222)*sol(:ncol,:, 134) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 222)*sol(:ncol,:, 134) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 222)*sol(:ncol,:, 135) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 223) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 223)*sol(:ncol,:, 133) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 223)*sol(:ncol,:, 134) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 224)*sol(:ncol,:, 63) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 224) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 224)*sol(:ncol,:, 133) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 224)*sol(:ncol,:, 134) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 224)*sol(:ncol,:, 135) ! rate_const*O2_1S*O3 rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 133)*sol(:ncol,:, 135) ! rate_const*O*O3 rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 133)*sol(:ncol,:, 133) ! rate_const*M*O*O rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 133)*sol(:ncol,:, 134) ! rate_const*M*O*O2 rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 77)*sol(:ncol,:, 133) ! rate_const*H2*O rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 79)*sol(:ncol,:, 133) ! rate_const*H2O2*O - rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 76)*sol(:ncol,:, 203) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 76)*sol(:ncol,:, 203) ! rate_const*H*HO2 - rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 76)*sol(:ncol,:, 203) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 76)*sol(:ncol,:, 90) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 76)*sol(:ncol,:, 90) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 76)*sol(:ncol,:, 90) ! rate_const*H*HO2 rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 76)*sol(:ncol,:, 134) ! rate_const*M*H*O2 - rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 203)*sol(:ncol,:, 133) ! rate_const*HO2*O - rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 203)*sol(:ncol,:, 135) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 90)*sol(:ncol,:, 133) ! rate_const*HO2*O + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 90)*sol(:ncol,:, 135) ! rate_const*HO2*O3 rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 76)*sol(:ncol,:, 135) ! rate_const*H*O3 - rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 221)*sol(:ncol,:, 77) ! rate_const*OH*H2 - rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 221)*sol(:ncol,:, 79) ! rate_const*OH*H2O2 - rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 221)*sol(:ncol,:, 203) ! rate_const*OH*HO2 - rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 221)*sol(:ncol,:, 133) ! rate_const*OH*O - rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 221)*sol(:ncol,:, 135) ! rate_const*OH*O3 - rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 221)*sol(:ncol,:, 221) ! rate_const*OH*OH - rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 221)*sol(:ncol,:, 221) ! rate_const*M*OH*OH - rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 203)*sol(:ncol,:, 203) ! rate_const*HO2*HO2 - rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 90)*sol(:ncol,:, 221) ! rate_const*HO2NO2*OH - rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 212)*sol(:ncol,:, 133) ! rate_const*N2D*O - rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 212)*sol(:ncol,:, 134) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 226)*sol(:ncol,:, 77) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 226)*sol(:ncol,:, 79) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 226)*sol(:ncol,:, 90) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 226)*sol(:ncol,:, 133) ! rate_const*OH*O + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 226)*sol(:ncol,:, 135) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 226)*sol(:ncol,:, 226) ! rate_const*OH*OH + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 226)*sol(:ncol,:, 226) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 90)*sol(:ncol,:, 90) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 91)*sol(:ncol,:, 226) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 217)*sol(:ncol,:, 133) ! rate_const*N2D*O + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 217)*sol(:ncol,:, 134) ! rate_const*N2D*O2 rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 112)*sol(:ncol,:, 124) ! rate_const*N*NO rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 @@ -205,333 +205,333 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 125)*sol(:ncol,:, 133) ! rate_const*NO2*O rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 125)*sol(:ncol,:, 135) ! rate_const*NO2*O3 rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 125)*sol(:ncol,:, 133) ! rate_const*M*NO2*O - rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 126)*sol(:ncol,:, 203) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 126)*sol(:ncol,:, 90) ! rate_const*NO3*HO2 rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 126)*sol(:ncol,:, 124) ! rate_const*NO3*NO rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 126)*sol(:ncol,:, 133) ! rate_const*NO3*O - rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 126)*sol(:ncol,:, 221) ! rate_const*NO3*OH - rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 112)*sol(:ncol,:, 221) ! rate_const*N*OH - rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 124)*sol(:ncol,:, 203) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 126)*sol(:ncol,:, 226) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 112)*sol(:ncol,:, 226) ! rate_const*N*OH + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 124)*sol(:ncol,:, 90) ! rate_const*NO*HO2 rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 124)*sol(:ncol,:, 135) ! rate_const*NO*O3 rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 124)*sol(:ncol,:, 133) ! rate_const*M*NO*O - rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 217)*sol(:ncol,:, 113) ! rate_const*O1D*N2O - rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 217)*sol(:ncol,:, 113) ! rate_const*O1D*N2O - rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 125)*sol(:ncol,:, 203) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 222)*sol(:ncol,:, 113) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 222)*sol(:ncol,:, 113) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 125)*sol(:ncol,:, 90) ! rate_const*M*NO2*HO2 rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 125)*sol(:ncol,:, 126) ! rate_const*M*NO2*NO3 - rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 125)*sol(:ncol,:, 221) ! rate_const*M*NO2*OH - rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 89)*sol(:ncol,:, 221) ! rate_const*HNO3*OH - rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 90) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 125)*sol(:ncol,:, 226) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 89)*sol(:ncol,:, 226) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 91) ! rate_const*M*HO2NO2 rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 114) ! rate_const*M*N2O5 rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 56)*sol(:ncol,:, 42) ! rate_const*CL*CH2O rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 56)*sol(:ncol,:, 54) ! rate_const*CL*CH4 rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 56)*sol(:ncol,:, 77) ! rate_const*CL*H2 rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 56)*sol(:ncol,:, 79) ! rate_const*CL*H2O2 - rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 56)*sol(:ncol,:, 203) ! rate_const*CL*HO2 - rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 56)*sol(:ncol,:, 203) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 56)*sol(:ncol,:, 90) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 56)*sol(:ncol,:, 90) ! rate_const*CL*HO2 rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 56)*sol(:ncol,:, 135) ! rate_const*CL*O3 - rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 59)*sol(:ncol,:, 197) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 59)*sol(:ncol,:, 199) ! rate_const*CLO*CH3O2 rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO - rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 59)*sol(:ncol,:, 203) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 59)*sol(:ncol,:, 90) ! rate_const*CLO*HO2 rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 59)*sol(:ncol,:, 124) ! rate_const*CLO*NO rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 60)*sol(:ncol,:, 56) ! rate_const*CLONO2*CL rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 59)*sol(:ncol,:, 125) ! rate_const*M*CLO*NO2 rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 60)*sol(:ncol,:, 133) ! rate_const*CLONO2*O - rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 60)*sol(:ncol,:, 221) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 60)*sol(:ncol,:, 226) ! rate_const*CLONO2*OH rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 59)*sol(:ncol,:, 133) ! rate_const*CLO*O - rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 59)*sol(:ncol,:, 221) ! rate_const*CLO*OH - rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 59)*sol(:ncol,:, 221) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 59)*sol(:ncol,:, 226) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 59)*sol(:ncol,:, 226) ! rate_const*CLO*OH rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 85)*sol(:ncol,:, 133) ! rate_const*HCL*O - rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 85)*sol(:ncol,:, 221) ! rate_const*HCL*OH - rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 92)*sol(:ncol,:, 56) ! rate_const*HOCL*CL - rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 92)*sol(:ncol,:, 133) ! rate_const*HOCL*O - rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 92)*sol(:ncol,:, 221) ! rate_const*HOCL*OH - rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 217)*sol(:ncol,:, 33) ! rate_const*O1D*CCL4 - rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 217)*sol(:ncol,:, 34) ! rate_const*O1D*CF2CLBR - rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 217)*sol(:ncol,:, 36) ! rate_const*O1D*CFC11 - rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 217)*sol(:ncol,:, 37) ! rate_const*O1D*CFC113 - rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 217)*sol(:ncol,:, 38) ! rate_const*O1D*CFC114 - rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 217)*sol(:ncol,:, 39) ! rate_const*O1D*CFC115 - rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 217)*sol(:ncol,:, 40) ! rate_const*O1D*CFC12 - rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 217)*sol(:ncol,:, 85) ! rate_const*O1D*HCL - rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 217)*sol(:ncol,:, 85) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 85)*sol(:ncol,:, 226) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 93)*sol(:ncol,:, 56) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 93)*sol(:ncol,:, 133) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 93)*sol(:ncol,:, 226) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 222)*sol(:ncol,:, 33) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 222)*sol(:ncol,:, 34) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 222)*sol(:ncol,:, 36) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 222)*sol(:ncol,:, 37) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 222)*sol(:ncol,:, 38) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 222)*sol(:ncol,:, 39) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 222)*sol(:ncol,:, 40) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 222)*sol(:ncol,:, 85) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 222)*sol(:ncol,:, 85) ! rate_const*O1D*HCL rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*M*CLO*CLO rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 58) ! rate_const*M*CL2O2 rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 17)*sol(:ncol,:, 42) ! rate_const*BR*CH2O - rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 17)*sol(:ncol,:, 203) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 17)*sol(:ncol,:, 90) ! rate_const*BR*HO2 rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 17)*sol(:ncol,:, 135) ! rate_const*BR*O3 rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 19)*sol(:ncol,:, 19) ! rate_const*BRO*BRO rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO - rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 19)*sol(:ncol,:, 203) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 19)*sol(:ncol,:, 90) ! rate_const*BRO*HO2 rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 19)*sol(:ncol,:, 124) ! rate_const*BRO*NO rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 19)*sol(:ncol,:, 125) ! rate_const*M*BRO*NO2 rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 20)*sol(:ncol,:, 133) ! rate_const*BRONO2*O rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 19)*sol(:ncol,:, 133) ! rate_const*BRO*O - rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 19)*sol(:ncol,:, 221) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 19)*sol(:ncol,:, 226) ! rate_const*BRO*OH rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 81)*sol(:ncol,:, 133) ! rate_const*HBR*O - rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 81)*sol(:ncol,:, 221) ! rate_const*HBR*OH - rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 91)*sol(:ncol,:, 133) ! rate_const*HOBR*O - rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 217)*sol(:ncol,:, 35) ! rate_const*O1D*CF3BR - rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 217)*sol(:ncol,:, 55) ! rate_const*O1D*CHBR3 - rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 217)*sol(:ncol,:, 78) ! rate_const*O1D*H2402 - rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 217)*sol(:ncol,:, 81) ! rate_const*O1D*HBR - rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 217)*sol(:ncol,:, 81) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 81)*sol(:ncol,:, 226) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 92)*sol(:ncol,:, 133) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 222)*sol(:ncol,:, 35) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 222)*sol(:ncol,:, 55) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 222)*sol(:ncol,:, 78) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 222)*sol(:ncol,:, 81) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 222)*sol(:ncol,:, 81) ! rate_const*O1D*HBR rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 73)*sol(:ncol,:, 54) ! rate_const*F*CH4 rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 73)*sol(:ncol,:, 77) ! rate_const*F*H2 - rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 73)*sol(:ncol,:, 232) ! rate_const*F*H2O + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 73)*sol(:ncol,:, 239) ! rate_const*F*H2O rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 73)*sol(:ncol,:, 89) ! rate_const*F*HNO3 - rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 217)*sol(:ncol,:, 64) ! rate_const*O1D*COF2 - rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 217)*sol(:ncol,:, 65) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 222)*sol(:ncol,:, 64) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 222)*sol(:ncol,:, 65) ! rate_const*O1D*COFCL rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 41)*sol(:ncol,:, 56) ! rate_const*CH2BR2*CL - rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 41)*sol(:ncol,:, 221) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 41)*sol(:ncol,:, 226) ! rate_const*CH2BR2*OH rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 43)*sol(:ncol,:, 56) ! rate_const*CH3BR*CL - rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 43)*sol(:ncol,:, 221) ! rate_const*CH3BR*OH - rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 44)*sol(:ncol,:, 221) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 43)*sol(:ncol,:, 226) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 44)*sol(:ncol,:, 226) ! rate_const*CH3CCL3*OH rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 46)*sol(:ncol,:, 56) ! rate_const*CH3CL*CL - rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 46)*sol(:ncol,:, 221) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 46)*sol(:ncol,:, 226) ! rate_const*CH3CL*OH rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 55)*sol(:ncol,:, 56) ! rate_const*CHBR3*CL - rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 55)*sol(:ncol,:, 221) ! rate_const*CHBR3*OH - rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 82)*sol(:ncol,:, 221) ! rate_const*HCFC141B*OH - rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 83)*sol(:ncol,:, 221) ! rate_const*HCFC142B*OH - rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 84)*sol(:ncol,:, 221) ! rate_const*HCFC22*OH - rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 217)*sol(:ncol,:, 41) ! rate_const*O1D*CH2BR2 - rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 217)*sol(:ncol,:, 43) ! rate_const*O1D*CH3BR - rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 217)*sol(:ncol,:, 82) ! rate_const*O1D*HCFC141B - rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 217)*sol(:ncol,:, 83) ! rate_const*O1D*HCFC142B - rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 217)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC22 - rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 42)*sol(:ncol,:, 203) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 55)*sol(:ncol,:, 226) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 82)*sol(:ncol,:, 226) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 83)*sol(:ncol,:, 226) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 84)*sol(:ncol,:, 226) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 222)*sol(:ncol,:, 41) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 222)*sol(:ncol,:, 43) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 222)*sol(:ncol,:, 82) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 222)*sol(:ncol,:, 83) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 222)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 42)*sol(:ncol,:, 90) ! rate_const*CH2O*HO2 rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 42)*sol(:ncol,:, 126) ! rate_const*CH2O*NO3 rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 42)*sol(:ncol,:, 133) ! rate_const*CH2O*O - rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 42)*sol(:ncol,:, 221) ! rate_const*CH2O*OH - rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 197)*sol(:ncol,:, 197) ! rate_const*CH3O2*CH3O2 - rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 197)*sol(:ncol,:, 197) ! rate_const*CH3O2*CH3O2 - rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 197)*sol(:ncol,:, 203) ! rate_const*CH3O2*HO2 - rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 197)*sol(:ncol,:, 124) ! rate_const*CH3O2*NO - rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 52)*sol(:ncol,:, 221) ! rate_const*CH3OH*OH - rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 53)*sol(:ncol,:, 221) ! rate_const*CH3OOH*OH - rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 54)*sol(:ncol,:, 221) ! rate_const*CH4*OH - rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 62)*sol(:ncol,:, 221) ! rate_const*M*CO*OH - rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 86)*sol(:ncol,:, 221) ! rate_const*M*HCN*OH - rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 87)*sol(:ncol,:, 221) ! rate_const*HCOOH*OH - rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 204)*sol(:ncol,:, 203) ! rate_const*HOCH2OO*HO2 - rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 204) ! rate_const*HOCH2OO - rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 204)*sol(:ncol,:, 124) ! rate_const*HOCH2OO*NO - rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 217)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 217)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 217)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 - rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 217)*sol(:ncol,:, 86) ! rate_const*O1D*HCN - rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 62)*sol(:ncol,:, 221) ! rate_const*CO*OH - rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 24)*sol(:ncol,:, 56) ! rate_const*M*C2H2*CL - rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 24)*sol(:ncol,:, 221) ! rate_const*M*C2H2*OH - rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 25)*sol(:ncol,:, 56) ! rate_const*M*C2H4*CL - rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 25)*sol(:ncol,:, 135) ! rate_const*C2H4*O3 - rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 193)*sol(:ncol,:, 193) ! rate_const*C2H5O2*C2H5O2 - rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 193)*sol(:ncol,:, 197) ! rate_const*C2H5O2*CH3O2 - rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 193)*sol(:ncol,:, 203) ! rate_const*C2H5O2*HO2 - rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 193)*sol(:ncol,:, 124) ! rate_const*C2H5O2*NO - rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 26)*sol(:ncol,:, 221) ! rate_const*C2H5OH*OH - rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 27)*sol(:ncol,:, 221) ! rate_const*C2H5OOH*OH - rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 28)*sol(:ncol,:, 56) ! rate_const*C2H6*CL - rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 28)*sol(:ncol,:, 221) ! rate_const*C2H6*OH - rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 45)*sol(:ncol,:, 126) ! rate_const*CH3CHO*NO3 - rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 45)*sol(:ncol,:, 221) ! rate_const*CH3CHO*OH - rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 47)*sol(:ncol,:, 221) ! rate_const*CH3CN*OH - rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 196)*sol(:ncol,:, 196) ! rate_const*CH3CO3*CH3CO3 - rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 196)*sol(:ncol,:, 197) ! rate_const*CH3CO3*CH3O2 - rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 196)*sol(:ncol,:, 203) ! rate_const*CH3CO3*HO2 - rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 196)*sol(:ncol,:, 124) ! rate_const*CH3CO3*NO - rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 50)*sol(:ncol,:, 221) ! rate_const*CH3COOH*OH - rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 51)*sol(:ncol,:, 221) ! rate_const*CH3COOOH*OH - rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 202)*sol(:ncol,:, 203) ! rate_const*EO2*HO2 - rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 202)*sol(:ncol,:, 124) ! rate_const*EO2*NO - rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 201) ! rate_const*EO - rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 201)*sol(:ncol,:, 134) ! rate_const*EO*O2 - rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 74)*sol(:ncol,:, 221) ! rate_const*GLYALD*OH - rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 75)*sol(:ncol,:, 221) ! rate_const*GLYOXAL*OH - rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 140)*sol(:ncol,:, 221) ! rate_const*PAN*OH - rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 25)*sol(:ncol,:, 221) ! rate_const*M*C2H4*OH - rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 196)*sol(:ncol,:, 125) ! rate_const*M*CH3CO3*NO2 - rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 140) ! rate_const*M*PAN - rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 29)*sol(:ncol,:, 126) ! rate_const*C3H6*NO3 - rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 29)*sol(:ncol,:, 135) ! rate_const*C3H6*O3 - rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 194)*sol(:ncol,:, 197) ! rate_const*C3H7O2*CH3O2 - rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 194)*sol(:ncol,:, 203) ! rate_const*C3H7O2*HO2 - rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 194)*sol(:ncol,:, 124) ! rate_const*C3H7O2*NO - rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 30)*sol(:ncol,:, 221) ! rate_const*C3H7OOH*OH - rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 31)*sol(:ncol,:, 221) ! rate_const*C3H8*OH - rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 49)*sol(:ncol,:, 126) ! rate_const*CH3COCHO*NO3 - rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 49)*sol(:ncol,:, 221) ! rate_const*CH3COCHO*OH - rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 95)*sol(:ncol,:, 221) ! rate_const*HYAC*OH - rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 127)*sol(:ncol,:, 221) ! rate_const*NOA*OH - rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 224)*sol(:ncol,:, 203) ! rate_const*PO2*HO2 - rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 224)*sol(:ncol,:, 124) ! rate_const*PO2*NO - rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 147)*sol(:ncol,:, 221) ! rate_const*POOH*OH - rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 225)*sol(:ncol,:, 197) ! rate_const*RO2*CH3O2 - rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 225)*sol(:ncol,:, 203) ! rate_const*RO2*HO2 - rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 225)*sol(:ncol,:, 124) ! rate_const*RO2*NO - rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 148)*sol(:ncol,:, 221) ! rate_const*ROOH*OH - rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 29)*sol(:ncol,:, 221) ! rate_const*M*C3H6*OH - rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 48)*sol(:ncol,:, 221) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 42)*sol(:ncol,:, 226) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 199)*sol(:ncol,:, 199) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 199)*sol(:ncol,:, 199) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 199)*sol(:ncol,:, 90) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 199)*sol(:ncol,:, 124) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 52)*sol(:ncol,:, 226) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 53)*sol(:ncol,:, 226) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 54)*sol(:ncol,:, 226) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 86)*sol(:ncol,:, 226) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 87)*sol(:ncol,:, 226) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 205)*sol(:ncol,:, 90) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 205) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 205)*sol(:ncol,:, 124) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 222)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 222)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 222)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 222)*sol(:ncol,:, 86) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 62)*sol(:ncol,:, 226) ! rate_const*CO*OH + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 24)*sol(:ncol,:, 56) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 24)*sol(:ncol,:, 226) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 25)*sol(:ncol,:, 56) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 25)*sol(:ncol,:, 135) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 195)*sol(:ncol,:, 195) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 195)*sol(:ncol,:, 199) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 195)*sol(:ncol,:, 90) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 195)*sol(:ncol,:, 124) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 26)*sol(:ncol,:, 226) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 27)*sol(:ncol,:, 226) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 28)*sol(:ncol,:, 56) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 28)*sol(:ncol,:, 226) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 45)*sol(:ncol,:, 126) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 45)*sol(:ncol,:, 226) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 47)*sol(:ncol,:, 226) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 198)*sol(:ncol,:, 198) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 198)*sol(:ncol,:, 199) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 198)*sol(:ncol,:, 90) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 198)*sol(:ncol,:, 124) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 50)*sol(:ncol,:, 226) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 51)*sol(:ncol,:, 226) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 204)*sol(:ncol,:, 90) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 204)*sol(:ncol,:, 124) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 203) ! rate_const*EO + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 203)*sol(:ncol,:, 134) ! rate_const*EO*O2 + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 74)*sol(:ncol,:, 226) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 75)*sol(:ncol,:, 226) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 140)*sol(:ncol,:, 226) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 25)*sol(:ncol,:, 226) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 198)*sol(:ncol,:, 125) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 140) ! rate_const*M*PAN + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 29)*sol(:ncol,:, 126) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 29)*sol(:ncol,:, 135) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 196)*sol(:ncol,:, 199) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 196)*sol(:ncol,:, 90) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 196)*sol(:ncol,:, 124) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 30)*sol(:ncol,:, 226) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 31)*sol(:ncol,:, 226) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 49)*sol(:ncol,:, 126) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 49)*sol(:ncol,:, 226) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 56)*sol(:ncol,:, 31) ! rate_const*CL*C3H8 + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 96)*sol(:ncol,:, 226) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 127)*sol(:ncol,:, 226) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 229)*sol(:ncol,:, 90) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 229)*sol(:ncol,:, 124) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 147)*sol(:ncol,:, 226) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 230)*sol(:ncol,:, 199) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 230)*sol(:ncol,:, 90) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 230)*sol(:ncol,:, 124) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 148)*sol(:ncol,:, 226) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 29)*sol(:ncol,:, 226) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 48)*sol(:ncol,:, 226) ! rate_const*CH3COCH3*OH rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 16)*sol(:ncol,:, 126) ! rate_const*BIGENE*NO3 - rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 16)*sol(:ncol,:, 221) ! rate_const*BIGENE*OH - rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 200)*sol(:ncol,:, 124) ! rate_const*ENEO2*NO - rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 200)*sol(:ncol,:, 124) ! rate_const*ENEO2*NO - rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 93)*sol(:ncol,:, 221) ! rate_const*HONITR*OH - rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 207)*sol(:ncol,:, 196) ! rate_const*MACRO2*CH3CO3 - rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 207)*sol(:ncol,:, 197) ! rate_const*MACRO2*CH3O2 - rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 207)*sol(:ncol,:, 203) ! rate_const*MACRO2*HO2 - rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 207)*sol(:ncol,:, 126) ! rate_const*MACRO2*NO3 - rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 207)*sol(:ncol,:, 124) ! rate_const*MACRO2*NO - rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 207)*sol(:ncol,:, 124) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 16)*sol(:ncol,:, 226) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 202)*sol(:ncol,:, 124) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 202)*sol(:ncol,:, 124) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 94)*sol(:ncol,:, 226) ! rate_const*HONITR*OH + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 211)*sol(:ncol,:, 198) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 211)*sol(:ncol,:, 199) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 211)*sol(:ncol,:, 90) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 211)*sol(:ncol,:, 126) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 211)*sol(:ncol,:, 124) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 211)*sol(:ncol,:, 124) ! rate_const*MACRO2*NO rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 105)*sol(:ncol,:, 135) ! rate_const*MACR*O3 - rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 105)*sol(:ncol,:, 221) ! rate_const*MACR*OH - rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 106)*sol(:ncol,:, 221) ! rate_const*MACROOH*OH - rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 209)*sol(:ncol,:, 196) ! rate_const*MCO3*CH3CO3 - rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 209)*sol(:ncol,:, 197) ! rate_const*MCO3*CH3O2 - rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 209)*sol(:ncol,:, 203) ! rate_const*MCO3*HO2 - rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 209)*sol(:ncol,:, 209) ! rate_const*MCO3*MCO3 - rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 209)*sol(:ncol,:, 124) ! rate_const*MCO3*NO - rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 209)*sol(:ncol,:, 126) ! rate_const*MCO3*NO3 - rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 211)*sol(:ncol,:, 203) ! rate_const*MEKO2*HO2 - rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 211)*sol(:ncol,:, 124) ! rate_const*MEKO2*NO - rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 107)*sol(:ncol,:, 221) ! rate_const*MEK*OH - rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 108)*sol(:ncol,:, 221) ! rate_const*MEKOOH*OH - rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 109)*sol(:ncol,:, 221) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 105)*sol(:ncol,:, 226) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 106)*sol(:ncol,:, 226) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 213)*sol(:ncol,:, 198) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 213)*sol(:ncol,:, 199) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 213)*sol(:ncol,:, 90) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 213)*sol(:ncol,:, 213) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 213)*sol(:ncol,:, 124) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 213)*sol(:ncol,:, 126) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 215)*sol(:ncol,:, 90) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 215)*sol(:ncol,:, 124) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 107)*sol(:ncol,:, 226) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 108)*sol(:ncol,:, 226) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 109)*sol(:ncol,:, 226) ! rate_const*M*MPAN*OH rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 111)*sol(:ncol,:, 135) ! rate_const*MVK*O3 - rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 111)*sol(:ncol,:, 221) ! rate_const*MVK*OH - rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 209)*sol(:ncol,:, 125) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 111)*sol(:ncol,:, 226) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 213)*sol(:ncol,:, 125) ! rate_const*M*MCO3*NO2 rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 109) ! rate_const*M*MPAN - rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 1)*sol(:ncol,:, 221) ! rate_const*ALKNIT*OH - rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 190)*sol(:ncol,:, 203) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 1)*sol(:ncol,:, 226) ! rate_const*ALKNIT*OH + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 190)*sol(:ncol,:, 90) ! rate_const*ALKO2*HO2 rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 190)*sol(:ncol,:, 124) ! rate_const*ALKO2*NO rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 190)*sol(:ncol,:, 124) ! rate_const*ALKO2*NO - rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 2)*sol(:ncol,:, 221) ! rate_const*ALKOOH*OH - rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 15)*sol(:ncol,:, 221) ! rate_const*BIGALK*OH - rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 94)*sol(:ncol,:, 221) ! rate_const*HPALD*OH - rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 96)*sol(:ncol,:, 221) ! rate_const*HYDRALD*OH - rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 97)*sol(:ncol,:, 221) ! rate_const*IEPOX*OH - rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 205)*sol(:ncol,:, 196) ! rate_const*ISOPAO2*CH3CO3 - rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 205)*sol(:ncol,:, 197) ! rate_const*ISOPAO2*CH3O2 - rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 205)*sol(:ncol,:, 203) ! rate_const*ISOPAO2*HO2 - rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 205)*sol(:ncol,:, 124) ! rate_const*ISOPAO2*NO - rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 205)*sol(:ncol,:, 126) ! rate_const*ISOPAO2*NO3 - rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 206)*sol(:ncol,:, 196) ! rate_const*ISOPBO2*CH3CO3 - rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 206)*sol(:ncol,:, 197) ! rate_const*ISOPBO2*CH3O2 - rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 206)*sol(:ncol,:, 203) ! rate_const*ISOPBO2*HO2 - rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 206) ! rate_const*ISOPBO2 - rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 206)*sol(:ncol,:, 124) ! rate_const*ISOPBO2*NO - rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 206)*sol(:ncol,:, 126) ! rate_const*ISOPBO2*NO3 - rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 99)*sol(:ncol,:, 221) ! rate_const*ISOPNITA*OH - rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 100)*sol(:ncol,:, 221) ! rate_const*ISOPNITB*OH - rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 98)*sol(:ncol,:, 126) ! rate_const*ISOP*NO3 - rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 101)*sol(:ncol,:, 196) ! rate_const*ISOPNO3*CH3CO3 - rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 101)*sol(:ncol,:, 197) ! rate_const*ISOPNO3*CH3O2 - rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 101)*sol(:ncol,:, 203) ! rate_const*ISOPNO3*HO2 - rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 101)*sol(:ncol,:, 124) ! rate_const*ISOPNO3*NO - rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 101)*sol(:ncol,:, 126) ! rate_const*ISOPNO3*NO3 - rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 102)*sol(:ncol,:, 221) ! rate_const*ISOPNOOH*OH - rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 98)*sol(:ncol,:, 135) ! rate_const*ISOP*O3 - rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 98)*sol(:ncol,:, 221) ! rate_const*ISOP*OH - rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 103)*sol(:ncol,:, 221) ! rate_const*ISOPOOH*OH - rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 115)*sol(:ncol,:, 221) ! rate_const*NC4CH2OH*OH - rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 116)*sol(:ncol,:, 221) ! rate_const*NC4CHO*OH - rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 229)*sol(:ncol,:, 196) ! rate_const*XO2*CH3CO3 - rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 229)*sol(:ncol,:, 197) ! rate_const*XO2*CH3O2 - rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 229)*sol(:ncol,:, 203) ! rate_const*XO2*HO2 - rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 229)*sol(:ncol,:, 124) ! rate_const*XO2*NO - rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 229)*sol(:ncol,:, 126) ! rate_const*XO2*NO3 - rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 182)*sol(:ncol,:, 221) ! rate_const*XOOH*OH - rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 189)*sol(:ncol,:, 203) ! rate_const*ACBZO2*HO2 + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 2)*sol(:ncol,:, 226) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 15)*sol(:ncol,:, 226) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 95)*sol(:ncol,:, 226) ! rate_const*HPALD*OH + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 97)*sol(:ncol,:, 226) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 98)*sol(:ncol,:, 226) ! rate_const*IEPOX*OH + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 206)*sol(:ncol,:, 198) ! rate_const*ISOPAO2*CH3CO3 + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 206)*sol(:ncol,:, 199) ! rate_const*ISOPAO2*CH3O2 + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 206)*sol(:ncol,:, 90) ! rate_const*ISOPAO2*HO2 + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 206)*sol(:ncol,:, 124) ! rate_const*ISOPAO2*NO + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 206)*sol(:ncol,:, 126) ! rate_const*ISOPAO2*NO3 + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 207)*sol(:ncol,:, 198) ! rate_const*ISOPBO2*CH3CO3 + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 207)*sol(:ncol,:, 199) ! rate_const*ISOPBO2*CH3O2 + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 207)*sol(:ncol,:, 90) ! rate_const*ISOPBO2*HO2 + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 207) ! rate_const*ISOPBO2 + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 207)*sol(:ncol,:, 124) ! rate_const*ISOPBO2*NO + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 207)*sol(:ncol,:, 126) ! rate_const*ISOPBO2*NO3 + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 100)*sol(:ncol,:, 226) ! rate_const*ISOPNITA*OH + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 101)*sol(:ncol,:, 226) ! rate_const*ISOPNITB*OH + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 99)*sol(:ncol,:, 126) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 208)*sol(:ncol,:, 198) ! rate_const*ISOPNO3*CH3CO3 + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 208)*sol(:ncol,:, 199) ! rate_const*ISOPNO3*CH3O2 + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 208)*sol(:ncol,:, 90) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 208)*sol(:ncol,:, 124) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 208)*sol(:ncol,:, 126) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 102)*sol(:ncol,:, 226) ! rate_const*ISOPNOOH*OH + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 99)*sol(:ncol,:, 135) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 99)*sol(:ncol,:, 226) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 103)*sol(:ncol,:, 226) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 115)*sol(:ncol,:, 226) ! rate_const*NC4CH2OH*OH + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 116)*sol(:ncol,:, 226) ! rate_const*NC4CHO*OH + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 235)*sol(:ncol,:, 198) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 235)*sol(:ncol,:, 199) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 235)*sol(:ncol,:, 90) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 235)*sol(:ncol,:, 124) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 235)*sol(:ncol,:, 126) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 182)*sol(:ncol,:, 226) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 189)*sol(:ncol,:, 90) ! rate_const*ACBZO2*HO2 rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 189)*sol(:ncol,:, 124) ! rate_const*ACBZO2*NO - rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 7)*sol(:ncol,:, 221) ! rate_const*BENZENE*OH - rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 191)*sol(:ncol,:, 203) ! rate_const*BENZO2*HO2 - rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 191)*sol(:ncol,:, 124) ! rate_const*BENZO2*NO - rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 8)*sol(:ncol,:, 221) ! rate_const*BENZOOH*OH - rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 22)*sol(:ncol,:, 221) ! rate_const*BZALD*OH - rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 192)*sol(:ncol,:, 203) ! rate_const*BZOO*HO2 - rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 23)*sol(:ncol,:, 221) ! rate_const*BZOOH*OH - rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 192)*sol(:ncol,:, 124) ! rate_const*BZOO*NO - rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 195)*sol(:ncol,:, 203) ! rate_const*C6H5O2*HO2 - rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 195)*sol(:ncol,:, 124) ! rate_const*C6H5O2*NO - rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 32)*sol(:ncol,:, 221) ! rate_const*C6H5OOH*OH - rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 66)*sol(:ncol,:, 221) ! rate_const*CRESOL*OH - rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 198)*sol(:ncol,:, 203) ! rate_const*DICARBO2*HO2 - rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 198)*sol(:ncol,:, 124) ! rate_const*DICARBO2*NO - rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 198)*sol(:ncol,:, 125) ! rate_const*M*DICARBO2*NO2 - rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 208)*sol(:ncol,:, 203) ! rate_const*MALO2*HO2 - rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 208)*sol(:ncol,:, 124) ! rate_const*MALO2*NO - rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 208)*sol(:ncol,:, 125) ! rate_const*M*MALO2*NO2 - rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 210)*sol(:ncol,:, 203) ! rate_const*MDIALO2*HO2 - rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 210)*sol(:ncol,:, 124) ! rate_const*MDIALO2*NO - rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 210)*sol(:ncol,:, 125) ! rate_const*M*MDIALO2*NO2 - rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 223)*sol(:ncol,:, 203) ! rate_const*PHENO2*HO2 - rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 223)*sol(:ncol,:, 124) ! rate_const*PHENO2*NO - rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 143)*sol(:ncol,:, 221) ! rate_const*PHENOL*OH + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 7)*sol(:ncol,:, 226) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 192)*sol(:ncol,:, 90) ! rate_const*BENZO2*HO2 + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 192)*sol(:ncol,:, 124) ! rate_const*BENZO2*NO + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 8)*sol(:ncol,:, 226) ! rate_const*BENZOOH*OH + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 22)*sol(:ncol,:, 226) ! rate_const*BZALD*OH + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 194)*sol(:ncol,:, 90) ! rate_const*BZOO*HO2 + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 23)*sol(:ncol,:, 226) ! rate_const*BZOOH*OH + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 194)*sol(:ncol,:, 124) ! rate_const*BZOO*NO + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 197)*sol(:ncol,:, 90) ! rate_const*C6H5O2*HO2 + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 197)*sol(:ncol,:, 124) ! rate_const*C6H5O2*NO + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 32)*sol(:ncol,:, 226) ! rate_const*C6H5OOH*OH + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 66)*sol(:ncol,:, 226) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 200)*sol(:ncol,:, 90) ! rate_const*DICARBO2*HO2 + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 200)*sol(:ncol,:, 124) ! rate_const*DICARBO2*NO + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 200)*sol(:ncol,:, 125) ! rate_const*M*DICARBO2*NO2 + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 212)*sol(:ncol,:, 90) ! rate_const*MALO2*HO2 + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 212)*sol(:ncol,:, 124) ! rate_const*MALO2*NO + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 212)*sol(:ncol,:, 125) ! rate_const*M*MALO2*NO2 + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 214)*sol(:ncol,:, 90) ! rate_const*MDIALO2*HO2 + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 214)*sol(:ncol,:, 124) ! rate_const*MDIALO2*NO + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 214)*sol(:ncol,:, 125) ! rate_const*M*MDIALO2*NO2 + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 228)*sol(:ncol,:, 90) ! rate_const*PHENO2*HO2 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 228)*sol(:ncol,:, 124) ! rate_const*PHENO2*NO + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 143)*sol(:ncol,:, 226) ! rate_const*PHENOL*OH rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 142)*sol(:ncol,:, 125) ! rate_const*PHENO*NO2 rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 142)*sol(:ncol,:, 135) ! rate_const*PHENO*O3 - rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 144)*sol(:ncol,:, 221) ! rate_const*PHENOOH*OH + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 144)*sol(:ncol,:, 226) ! rate_const*PHENOOH*OH rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 189)*sol(:ncol,:, 125) ! rate_const*M*ACBZO2*NO2 - rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 228)*sol(:ncol,:, 203) ! rate_const*TOLO2*HO2 - rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 228)*sol(:ncol,:, 124) ! rate_const*TOLO2*NO - rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 180)*sol(:ncol,:, 221) ! rate_const*TOLOOH*OH - rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 181)*sol(:ncol,:, 221) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 233)*sol(:ncol,:, 90) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 233)*sol(:ncol,:, 124) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 180)*sol(:ncol,:, 226) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 181)*sol(:ncol,:, 226) ! rate_const*TOLUENE*OH rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 141) ! rate_const*M*PBZNIT - rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 183)*sol(:ncol,:, 221) ! rate_const*XYLENES*OH - rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 230)*sol(:ncol,:, 203) ! rate_const*XYLENO2*HO2 - rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 230)*sol(:ncol,:, 124) ! rate_const*XYLENO2*NO - rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 184)*sol(:ncol,:, 221) ! rate_const*XYLENOOH*OH - rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 231)*sol(:ncol,:, 203) ! rate_const*XYLOLO2*HO2 - rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 231)*sol(:ncol,:, 124) ! rate_const*XYLOLO2*NO - rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 185)*sol(:ncol,:, 221) ! rate_const*XYLOL*OH - rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 186)*sol(:ncol,:, 221) ! rate_const*XYLOLOOH*OH + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 183)*sol(:ncol,:, 226) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 236)*sol(:ncol,:, 90) ! rate_const*XYLENO2*HO2 + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 236)*sol(:ncol,:, 124) ! rate_const*XYLENO2*NO + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 184)*sol(:ncol,:, 226) ! rate_const*XYLENOOH*OH + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 238)*sol(:ncol,:, 90) ! rate_const*XYLOLO2*HO2 + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 238)*sol(:ncol,:, 124) ! rate_const*XYLOLO2*NO + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 185)*sol(:ncol,:, 226) ! rate_const*XYLOL*OH + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 186)*sol(:ncol,:, 226) ! rate_const*XYLOLOOH*OH rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 6)*sol(:ncol,:, 126) ! rate_const*BCARY*NO3 rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 6)*sol(:ncol,:, 135) ! rate_const*BCARY*O3 - rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 6)*sol(:ncol,:, 221) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 6)*sol(:ncol,:, 226) ! rate_const*BCARY*OH rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 110)*sol(:ncol,:, 126) ! rate_const*MTERP*NO3 rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 110)*sol(:ncol,:, 135) ! rate_const*MTERP*O3 - rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 110)*sol(:ncol,:, 221) ! rate_const*MTERP*OH - rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 216)*sol(:ncol,:, 197) ! rate_const*NTERPO2*CH3O2 - rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 216)*sol(:ncol,:, 203) ! rate_const*NTERPO2*HO2 - rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 216)*sol(:ncol,:, 124) ! rate_const*NTERPO2*NO - rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 216)*sol(:ncol,:, 126) ! rate_const*NTERPO2*NO3 - rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 128)*sol(:ncol,:, 221) ! rate_const*NTERPOOH*OH - rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 226)*sol(:ncol,:, 197) ! rate_const*TERP2O2*CH3O2 - rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 226)*sol(:ncol,:, 203) ! rate_const*TERP2O2*HO2 - rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 226)*sol(:ncol,:, 124) ! rate_const*TERP2O2*NO - rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 175)*sol(:ncol,:, 221) ! rate_const*TERP2OOH*OH - rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 176)*sol(:ncol,:, 221) ! rate_const*TERPNIT*OH - rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 227)*sol(:ncol,:, 197) ! rate_const*TERPO2*CH3O2 - rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 227)*sol(:ncol,:, 203) ! rate_const*TERPO2*HO2 - rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 227)*sol(:ncol,:, 124) ! rate_const*TERPO2*NO - rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 177)*sol(:ncol,:, 221) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 110)*sol(:ncol,:, 226) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 221)*sol(:ncol,:, 199) ! rate_const*NTERPO2*CH3O2 + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 221)*sol(:ncol,:, 90) ! rate_const*NTERPO2*HO2 + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 221)*sol(:ncol,:, 124) ! rate_const*NTERPO2*NO + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 221)*sol(:ncol,:, 126) ! rate_const*NTERPO2*NO3 + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 128)*sol(:ncol,:, 226) ! rate_const*NTERPOOH*OH + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 231)*sol(:ncol,:, 199) ! rate_const*TERP2O2*CH3O2 + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 231)*sol(:ncol,:, 90) ! rate_const*TERP2O2*HO2 + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 231)*sol(:ncol,:, 124) ! rate_const*TERP2O2*NO + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 175)*sol(:ncol,:, 226) ! rate_const*TERP2OOH*OH + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 176)*sol(:ncol,:, 226) ! rate_const*TERPNIT*OH + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 232)*sol(:ncol,:, 199) ! rate_const*TERPO2*CH3O2 + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 232)*sol(:ncol,:, 90) ! rate_const*TERPO2*HO2 + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 232)*sol(:ncol,:, 124) ! rate_const*TERPO2*NO + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 177)*sol(:ncol,:, 226) ! rate_const*TERPOOH*OH rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 178)*sol(:ncol,:, 126) ! rate_const*TERPROD1*NO3 - rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 178)*sol(:ncol,:, 221) ! rate_const*TERPROD1*OH - rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 179)*sol(:ncol,:, 221) ! rate_const*TERPROD2*OH + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 178)*sol(:ncol,:, 226) ! rate_const*TERPROD1*OH + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 179)*sol(:ncol,:, 226) ! rate_const*TERPROD2*OH rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 67)*sol(:ncol,:, 126) ! rate_const*DMS*NO3 - rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 67)*sol(:ncol,:, 221) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 67)*sol(:ncol,:, 226) ! rate_const*DMS*OH rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 138)*sol(:ncol,:, 133) ! rate_const*OCS*O - rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 138)*sol(:ncol,:, 221) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 138)*sol(:ncol,:, 226) ! rate_const*OCS*OH rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 149)*sol(:ncol,:, 134) ! rate_const*S*O2 - rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 149)*sol(:ncol,:, 135) ! rate_const*S*O3 - rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 151)*sol(:ncol,:, 19) ! rate_const*SO*BRO - rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 151)*sol(:ncol,:, 59) ! rate_const*SO*CLO - rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 149)*sol(:ncol,:, 221) ! rate_const*S*OH - rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 151)*sol(:ncol,:, 125) ! rate_const*SO*NO2 - rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 151)*sol(:ncol,:, 134) ! rate_const*SO*O2 - rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 151)*sol(:ncol,:, 135) ! rate_const*SO*O3 - rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 151)*sol(:ncol,:, 137) ! rate_const*SO*OCLO - rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 151)*sol(:ncol,:, 221) ! rate_const*SO*OH - rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 67)*sol(:ncol,:, 221) ! rate_const*DMS*OH - rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 152)*sol(:ncol,:, 221) ! rate_const*SO2*OH - rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 153)*sol(:ncol,:, 232) ! rate_const*SO3*H2O - rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 120)*sol(:ncol,:, 221) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 152)*sol(:ncol,:, 226) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 149)*sol(:ncol,:, 135) ! rate_const*S*O3 + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 151)*sol(:ncol,:, 19) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 151)*sol(:ncol,:, 59) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 149)*sol(:ncol,:, 226) ! rate_const*S*OH + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 151)*sol(:ncol,:, 125) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 151)*sol(:ncol,:, 134) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 151)*sol(:ncol,:, 135) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 151)*sol(:ncol,:, 137) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 151)*sol(:ncol,:, 226) ! rate_const*SO*OH + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 67)*sol(:ncol,:, 226) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 153)*sol(:ncol,:, 239) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 120)*sol(:ncol,:, 226) ! rate_const*NH3*OH rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 75) ! rate_const*GLYOXAL - rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 203) ! rate_const*HO2 - rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 93) ! rate_const*HONITR - rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 99) ! rate_const*ISOPNITA - rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 100) ! rate_const*ISOPNITB + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 90) ! rate_const*HO2 + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 94) ! rate_const*HONITR + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 100) ! rate_const*ISOPNITA + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 101) ! rate_const*ISOPNITB rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 114) ! rate_const*N2O5 rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 115) ! rate_const*NC4CH2OH rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 116) ! rate_const*NC4CHO @@ -542,54 +542,68 @@ subroutine set_rates( rxt_rates, sol, ncol ) rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 139) ! rate_const*ONITR rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 176) ! rate_const*TERPNIT rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 6)*sol(:ncol,:, 126) ! rate_const*BCARY*NO3 - rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 6)*sol(:ncol,:, 135) ! rate_const*BCARY*O3 - rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 6)*sol(:ncol,:, 221) ! rate_const*BCARY*OH - rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 7)*sol(:ncol,:, 221) ! rate_const*BENZENE*OH - rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 98)*sol(:ncol,:, 126) ! rate_const*ISOP*NO3 - rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 98)*sol(:ncol,:, 135) ! rate_const*ISOP*O3 - rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 98)*sol(:ncol,:, 221) ! rate_const*ISOP*OH - rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 104)*sol(:ncol,:, 221) ! rate_const*IVOC*OH - rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 110)*sol(:ncol,:, 126) ! rate_const*MTERP*NO3 - rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 110)*sol(:ncol,:, 135) ! rate_const*MTERP*O3 - rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 110)*sol(:ncol,:, 221) ! rate_const*MTERP*OH - rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 173)*sol(:ncol,:, 221) ! rate_const*SVOC*OH - rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 181)*sol(:ncol,:, 221) ! rate_const*TOLUENE*OH - rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 183)*sol(:ncol,:, 221) ! rate_const*XYLENES*OH - rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 114) ! rate_const*N2O5 - rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 20) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 114) ! rate_const*N2O5 - rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 60) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 20) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 91)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL - rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 60) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 20) ! rate_const*BRONO2 - rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL - rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 91)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 191)*sol(:ncol,:, 90) ! rate_const*BCARYO2VBS*HO2 + rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 191)*sol(:ncol,:, 124) ! rate_const*BCARYO2VBS*NO + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 6)*sol(:ncol,:, 135) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 6)*sol(:ncol,:, 226) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 7)*sol(:ncol,:, 226) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 193)*sol(:ncol,:, 90) ! rate_const*BENZO2VBS*HO2 + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 193)*sol(:ncol,:, 124) ! rate_const*BENZO2VBS*NO + rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 99)*sol(:ncol,:, 126) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 209)*sol(:ncol,:, 90) ! rate_const*ISOPO2VBS*HO2 + rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 209)*sol(:ncol,:, 124) ! rate_const*ISOPO2VBS*NO + rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 99)*sol(:ncol,:, 135) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 99)*sol(:ncol,:, 226) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 210)*sol(:ncol,:, 90) ! rate_const*IVOCO2VBS*HO2 + rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 210)*sol(:ncol,:, 124) ! rate_const*IVOCO2VBS*NO + rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 104)*sol(:ncol,:, 226) ! rate_const*IVOC*OH + rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 110)*sol(:ncol,:, 126) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 216)*sol(:ncol,:, 90) ! rate_const*MTERPO2VBS*HO2 + rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 216)*sol(:ncol,:, 124) ! rate_const*MTERPO2VBS*NO + rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 110)*sol(:ncol,:, 135) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 110)*sol(:ncol,:, 226) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 173)*sol(:ncol,:, 226) ! rate_const*SVOC*OH + rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 181)*sol(:ncol,:, 226) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 234)*sol(:ncol,:, 90) ! rate_const*TOLUO2VBS*HO2 + rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 234)*sol(:ncol,:, 124) ! rate_const*TOLUO2VBS*NO + rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 183)*sol(:ncol,:, 226) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 237)*sol(:ncol,:, 90) ! rate_const*XYLEO2VBS*HO2 + rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 237)*sol(:ncol,:, 124) ! rate_const*XYLEO2VBS*NO rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 114) ! rate_const*N2O5 - rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 60) ! rate_const*CLONO2 - rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL - rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 214)*sol(:ncol,:, 199) ! rate_const*NOp*e - rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 220)*sol(:ncol,:, 199) ! rate_const*O2p*e - rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 213)*sol(:ncol,:, 199) ! rate_const*N2p*e - rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 213)*sol(:ncol,:, 134) ! rate_const*N2p*O2 - rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 213)*sol(:ncol,:, 133) ! rate_const*N2p*O - rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 213)*sol(:ncol,:, 133) ! rate_const*N2p*O - rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 215)*sol(:ncol,:, 133) ! rate_const*Np*O - rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 215)*sol(:ncol,:, 134) ! rate_const*Np*O2 - rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 215)*sol(:ncol,:, 134) ! rate_const*Np*O2 - rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 220)*sol(:ncol,:, 112) ! rate_const*O2p*N - rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 220) ! rate_const*N2*O2p - rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 220)*sol(:ncol,:, 124) ! rate_const*O2p*NO - rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 222)*sol(:ncol,:, 63) ! rate_const*Op*CO2 - rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 222) ! rate_const*N2*Op - rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 222)*sol(:ncol,:, 134) ! rate_const*Op*O2 - rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 71) ! rate_const*E90 - rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 123) ! rate_const*NH_50 - rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 122) ! rate_const*NH_5 - rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 172) ! rate_const*ST80_25 + rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 93)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 93)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 93)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 219)*sol(:ncol,:, 201) ! rate_const*NOp*e + rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 225)*sol(:ncol,:, 201) ! rate_const*O2p*e + rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 218)*sol(:ncol,:, 201) ! rate_const*N2p*e + rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 218)*sol(:ncol,:, 134) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 218)*sol(:ncol,:, 133) ! rate_const*N2p*O + rxt_rates(:ncol,:, 584) = rxt_rates(:ncol,:, 584)*sol(:ncol,:, 218)*sol(:ncol,:, 133) ! rate_const*N2p*O + rxt_rates(:ncol,:, 585) = rxt_rates(:ncol,:, 585)*sol(:ncol,:, 220)*sol(:ncol,:, 133) ! rate_const*Np*O + rxt_rates(:ncol,:, 586) = rxt_rates(:ncol,:, 586)*sol(:ncol,:, 220)*sol(:ncol,:, 134) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 587) = rxt_rates(:ncol,:, 587)*sol(:ncol,:, 220)*sol(:ncol,:, 134) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 588) = rxt_rates(:ncol,:, 588)*sol(:ncol,:, 225)*sol(:ncol,:, 112) ! rate_const*O2p*N + rxt_rates(:ncol,:, 589) = rxt_rates(:ncol,:, 589)*sol(:ncol,:, 225) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 590) = rxt_rates(:ncol,:, 590)*sol(:ncol,:, 225)*sol(:ncol,:, 124) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 591) = rxt_rates(:ncol,:, 591)*sol(:ncol,:, 227)*sol(:ncol,:, 63) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 592) = rxt_rates(:ncol,:, 592)*sol(:ncol,:, 227) ! rate_const*N2*Op + rxt_rates(:ncol,:, 593) = rxt_rates(:ncol,:, 593)*sol(:ncol,:, 227)*sol(:ncol,:, 134) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 594) = rxt_rates(:ncol,:, 594)*sol(:ncol,:, 71) ! rate_const*E90 + rxt_rates(:ncol,:, 595) = rxt_rates(:ncol,:, 595)*sol(:ncol,:, 123) ! rate_const*NH_50 + rxt_rates(:ncol,:, 596) = rxt_rates(:ncol,:, 596)*sol(:ncol,:, 122) ! rate_const*NH_5 + rxt_rates(:ncol,:, 597) = rxt_rates(:ncol,:, 597)*sol(:ncol,:, 172) ! rate_const*ST80_25 end subroutine set_rates end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 index c1e6cafe6a..fea4569c75 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_setrxt.F90 @@ -54,7 +54,7 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,188) = 7e-13_r8 rate(:,189) = 5e-12_r8 rate(:,198) = 3.5e-12_r8 - rate(:,200) = 1e-11_r8 + rate(:,200) = 1.3e-11_r8 rate(:,201) = 2.2e-11_r8 rate(:,202) = 5e-11_r8 rate(:,237) = 1.7e-13_r8 @@ -79,18 +79,18 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,291) = 1.794e-10_r8 rate(:,292) = 1.3e-10_r8 rate(:,293) = 7.65e-11_r8 - rate(:,307) = 4e-13_r8 - rate(:,311) = 1.31e-10_r8 - rate(:,312) = 3.5e-11_r8 - rate(:,313) = 9e-12_r8 - rate(:,320) = 6.8e-14_r8 - rate(:,321) = 2e-13_r8 - rate(:,335) = 7e-13_r8 - rate(:,336) = 1e-12_r8 - rate(:,340) = 1e-14_r8 - rate(:,341) = 1e-11_r8 - rate(:,342) = 1.15e-11_r8 - rate(:,343) = 4e-14_r8 + rate(:,306) = 4e-13_r8 + rate(:,310) = 1.31e-10_r8 + rate(:,311) = 3.5e-11_r8 + rate(:,312) = 9e-12_r8 + rate(:,319) = 6.8e-14_r8 + rate(:,320) = 2e-13_r8 + rate(:,335) = 1e-12_r8 + rate(:,339) = 1e-14_r8 + rate(:,340) = 1e-11_r8 + rate(:,341) = 1.15e-11_r8 + rate(:,342) = 4e-14_r8 + rate(:,355) = 1.45e-10_r8 rate(:,356) = 3e-12_r8 rate(:,357) = 6.7e-13_r8 rate(:,367) = 3.5e-13_r8 @@ -132,31 +132,31 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,500) = 5.7e-11_r8 rate(:,501) = 3.4e-11_r8 rate(:,506) = 2.3e-12_r8 - rate(:,507) = 1.2e-11_r8 - rate(:,508) = 5.7e-11_r8 - rate(:,509) = 2.8e-11_r8 - rate(:,510) = 6.6e-11_r8 - rate(:,511) = 1.4e-11_r8 - rate(:,514) = 1.9e-12_r8 + rate(:,508) = 1.2e-11_r8 + rate(:,509) = 5.7e-11_r8 + rate(:,510) = 2.8e-11_r8 + rate(:,511) = 6.6e-11_r8 + rate(:,512) = 1.4e-11_r8 + rate(:,515) = 1.9e-12_r8 rate(:,528) = 6.34e-08_r8 rate(:,534) = 1.9e-11_r8 - rate(:,535) = 1.2e-14_r8 - rate(:,536) = 2e-10_r8 - rate(:,541) = 1.34e-11_r8 - rate(:,545) = 1.34e-11_r8 - rate(:,547) = 1.7e-11_r8 - rate(:,568) = 6e-11_r8 - rate(:,571) = 1e-12_r8 - rate(:,572) = 4e-10_r8 - rate(:,573) = 2e-10_r8 - rate(:,574) = 1e-10_r8 - rate(:,575) = 5e-16_r8 - rate(:,576) = 4.4e-10_r8 - rate(:,577) = 9e-10_r8 - rate(:,580) = 1.29e-07_r8 - rate(:,581) = 2.31e-07_r8 - rate(:,582) = 2.31e-06_r8 - rate(:,583) = 4.63e-07_r8 + rate(:,537) = 1.2e-14_r8 + rate(:,538) = 2e-10_r8 + rate(:,549) = 1.34e-11_r8 + rate(:,555) = 1.34e-11_r8 + rate(:,559) = 1.7e-11_r8 + rate(:,582) = 6e-11_r8 + rate(:,585) = 1e-12_r8 + rate(:,586) = 4e-10_r8 + rate(:,587) = 2e-10_r8 + rate(:,588) = 1e-10_r8 + rate(:,589) = 5e-16_r8 + rate(:,590) = 4.4e-10_r8 + rate(:,591) = 9e-10_r8 + rate(:,594) = 1.29e-07_r8 + rate(:,595) = 2.31e-07_r8 + rate(:,596) = 2.31e-06_r8 + rate(:,597) = 4.63e-07_r8 do n = 1,pver offset = (n-1)*ncol @@ -176,13 +176,13 @@ subroutine setrxt( rate, temp, m, ncol ) exp_fac(:) = exp( -2000._r8 * itemp(:) ) rate(:,171) = 1.4e-12_r8 * exp_fac(:) rate(:,425) = 1.05e-14_r8 * exp_fac(:) - rate(:,539) = 1.05e-14_r8 * exp_fac(:) + rate(:,545) = 1.05e-14_r8 * exp_fac(:) exp_fac(:) = exp( 200._r8 * itemp(:) ) rate(:,176) = 3e-11_r8 * exp_fac(:) rate(:,264) = 5.5e-12_r8 * exp_fac(:) rate(:,303) = 3.8e-12_r8 * exp_fac(:) - rate(:,325) = 3.8e-12_r8 * exp_fac(:) - rate(:,352) = 3.8e-12_r8 * exp_fac(:) + rate(:,324) = 3.8e-12_r8 * exp_fac(:) + rate(:,351) = 3.8e-12_r8 * exp_fac(:) rate(:,360) = 3.8e-12_r8 * exp_fac(:) rate(:,364) = 3.8e-12_r8 * exp_fac(:) rate(:,380) = 2.3e-11_r8 * exp_fac(:) @@ -205,8 +205,8 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,262) = 1.7e-11_r8 * exp_fac(:) exp_fac(:) = exp( 180._r8 * itemp(:) ) rate(:,182) = 1.8e-11_r8 * exp_fac(:) - rate(:,338) = 4.2e-12_r8 * exp_fac(:) - rate(:,351) = 4.2e-12_r8 * exp_fac(:) + rate(:,337) = 4.2e-12_r8 * exp_fac(:) + rate(:,350) = 4.2e-12_r8 * exp_fac(:) rate(:,359) = 4.2e-12_r8 * exp_fac(:) rate(:,388) = 4.2e-12_r8 * exp_fac(:) rate(:,408) = 4.4e-12_r8 * exp_fac(:) @@ -215,23 +215,24 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,492) = 4.2e-12_r8 * exp_fac(:) rate(:,497) = 4.2e-12_r8 * exp_fac(:) rate(:,183) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) - rate(:,187) = 1.3e-12_r8 * exp( 380._r8 * itemp(:) ) + rate(:,187) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) rate(:,190) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) exp_fac(:) = exp( 220._r8 * itemp(:) ) rate(:,191) = 2.9e-12_r8 * exp_fac(:) rate(:,192) = 1.45e-12_r8 * exp_fac(:) rate(:,193) = 1.45e-12_r8 * exp_fac(:) - rate(:,194) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:,194) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) rate(:,195) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) exp_fac(:) = exp( -2450._r8 * itemp(:) ) rate(:,196) = 1.2e-13_r8 * exp_fac(:) rate(:,222) = 3e-11_r8 * exp_fac(:) - rate(:,199) = 1.5e-11_r8 * exp( 170._r8 * itemp(:) ) - exp_fac(:) = exp( 270._r8 * itemp(:) ) - rate(:,203) = 3.3e-12_r8 * exp_fac(:) - rate(:,218) = 1.4e-11_r8 * exp_fac(:) - rate(:,232) = 7.4e-12_r8 * exp_fac(:) - rate(:,334) = 8.1e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,199) = 1.7e-11_r8 * exp_fac(:) + rate(:,297) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,203) = 3.44e-12_r8 * exp_fac(:) + rate(:,255) = 2.3e-12_r8 * exp_fac(:) + rate(:,258) = 8.8e-12_r8 * exp_fac(:) exp_fac(:) = exp( -1500._r8 * itemp(:) ) rate(:,204) = 3e-12_r8 * exp_fac(:) rate(:,263) = 5.8e-12_r8 * exp_fac(:) @@ -242,6 +243,10 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,215) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) rate(:,216) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) rate(:,217) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,218) = 1.4e-11_r8 * exp_fac(:) + rate(:,232) = 7.4e-12_r8 * exp_fac(:) + rate(:,333) = 8.1e-12_r8 * exp_fac(:) rate(:,219) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) rate(:,220) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) rate(:,221) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) @@ -277,9 +282,6 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,251) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) rate(:,252) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) rate(:,254) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) - exp_fac(:) = exp( 260._r8 * itemp(:) ) - rate(:,255) = 2.3e-12_r8 * exp_fac(:) - rate(:,258) = 8.8e-12_r8 * exp_fac(:) rate(:,257) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) rate(:,260) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) rate(:,265) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) @@ -293,18 +295,18 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,291) = 1.794e-10_r8 * exp_fac(:) rate(:,292) = 1.3e-10_r8 * exp_fac(:) rate(:,293) = 7.65e-11_r8 * exp_fac(:) - rate(:,307) = 4e-13_r8 * exp_fac(:) - rate(:,311) = 1.31e-10_r8 * exp_fac(:) - rate(:,312) = 3.5e-11_r8 * exp_fac(:) - rate(:,313) = 9e-12_r8 * exp_fac(:) - rate(:,320) = 6.8e-14_r8 * exp_fac(:) - rate(:,321) = 2e-13_r8 * exp_fac(:) - rate(:,335) = 7e-13_r8 * exp_fac(:) - rate(:,336) = 1e-12_r8 * exp_fac(:) - rate(:,340) = 1e-14_r8 * exp_fac(:) - rate(:,341) = 1e-11_r8 * exp_fac(:) - rate(:,342) = 1.15e-11_r8 * exp_fac(:) - rate(:,343) = 4e-14_r8 * exp_fac(:) + rate(:,306) = 4e-13_r8 * exp_fac(:) + rate(:,310) = 1.31e-10_r8 * exp_fac(:) + rate(:,311) = 3.5e-11_r8 * exp_fac(:) + rate(:,312) = 9e-12_r8 * exp_fac(:) + rate(:,319) = 6.8e-14_r8 * exp_fac(:) + rate(:,320) = 2e-13_r8 * exp_fac(:) + rate(:,335) = 1e-12_r8 * exp_fac(:) + rate(:,339) = 1e-14_r8 * exp_fac(:) + rate(:,340) = 1e-11_r8 * exp_fac(:) + rate(:,341) = 1.15e-11_r8 * exp_fac(:) + rate(:,342) = 4e-14_r8 * exp_fac(:) + rate(:,355) = 1.45e-10_r8 * exp_fac(:) rate(:,356) = 3e-12_r8 * exp_fac(:) rate(:,357) = 6.7e-13_r8 * exp_fac(:) rate(:,367) = 3.5e-13_r8 * exp_fac(:) @@ -346,31 +348,31 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,500) = 5.7e-11_r8 * exp_fac(:) rate(:,501) = 3.4e-11_r8 * exp_fac(:) rate(:,506) = 2.3e-12_r8 * exp_fac(:) - rate(:,507) = 1.2e-11_r8 * exp_fac(:) - rate(:,508) = 5.7e-11_r8 * exp_fac(:) - rate(:,509) = 2.8e-11_r8 * exp_fac(:) - rate(:,510) = 6.6e-11_r8 * exp_fac(:) - rate(:,511) = 1.4e-11_r8 * exp_fac(:) - rate(:,514) = 1.9e-12_r8 * exp_fac(:) + rate(:,508) = 1.2e-11_r8 * exp_fac(:) + rate(:,509) = 5.7e-11_r8 * exp_fac(:) + rate(:,510) = 2.8e-11_r8 * exp_fac(:) + rate(:,511) = 6.6e-11_r8 * exp_fac(:) + rate(:,512) = 1.4e-11_r8 * exp_fac(:) + rate(:,515) = 1.9e-12_r8 * exp_fac(:) rate(:,528) = 6.34e-08_r8 * exp_fac(:) rate(:,534) = 1.9e-11_r8 * exp_fac(:) - rate(:,535) = 1.2e-14_r8 * exp_fac(:) - rate(:,536) = 2e-10_r8 * exp_fac(:) - rate(:,541) = 1.34e-11_r8 * exp_fac(:) - rate(:,545) = 1.34e-11_r8 * exp_fac(:) - rate(:,547) = 1.7e-11_r8 * exp_fac(:) - rate(:,568) = 6e-11_r8 * exp_fac(:) - rate(:,571) = 1e-12_r8 * exp_fac(:) - rate(:,572) = 4e-10_r8 * exp_fac(:) - rate(:,573) = 2e-10_r8 * exp_fac(:) - rate(:,574) = 1e-10_r8 * exp_fac(:) - rate(:,575) = 5e-16_r8 * exp_fac(:) - rate(:,576) = 4.4e-10_r8 * exp_fac(:) - rate(:,577) = 9e-10_r8 * exp_fac(:) - rate(:,580) = 1.29e-07_r8 * exp_fac(:) - rate(:,581) = 2.31e-07_r8 * exp_fac(:) - rate(:,582) = 2.31e-06_r8 * exp_fac(:) - rate(:,583) = 4.63e-07_r8 * exp_fac(:) + rate(:,537) = 1.2e-14_r8 * exp_fac(:) + rate(:,538) = 2e-10_r8 * exp_fac(:) + rate(:,549) = 1.34e-11_r8 * exp_fac(:) + rate(:,555) = 1.34e-11_r8 * exp_fac(:) + rate(:,559) = 1.7e-11_r8 * exp_fac(:) + rate(:,582) = 6e-11_r8 * exp_fac(:) + rate(:,585) = 1e-12_r8 * exp_fac(:) + rate(:,586) = 4e-10_r8 * exp_fac(:) + rate(:,587) = 2e-10_r8 * exp_fac(:) + rate(:,588) = 1e-10_r8 * exp_fac(:) + rate(:,589) = 5e-16_r8 * exp_fac(:) + rate(:,590) = 4.4e-10_r8 * exp_fac(:) + rate(:,591) = 9e-10_r8 * exp_fac(:) + rate(:,594) = 1.29e-07_r8 * exp_fac(:) + rate(:,595) = 2.31e-07_r8 * exp_fac(:) + rate(:,596) = 2.31e-06_r8 * exp_fac(:) + rate(:,597) = 4.63e-07_r8 * exp_fac(:) exp_fac(:) = exp( 400._r8 * itemp(:) ) rate(:,274) = 6e-12_r8 * exp_fac(:) rate(:,373) = 5e-13_r8 * exp_fac(:) @@ -385,7 +387,7 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,392) = 8.5e-16_r8 * exp_fac(:) exp_fac(:) = exp( -1100._r8 * itemp(:) ) rate(:,282) = 2.03e-11_r8 * exp_fac(:) - rate(:,513) = 3.4e-12_r8 * exp_fac(:) + rate(:,514) = 3.4e-12_r8 * exp_fac(:) rate(:,283) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) rate(:,284) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) rate(:,285) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) @@ -396,7 +398,6 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,288) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) rate(:,294) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) rate(:,295) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) - rate(:,297) = 5.5e-12_r8 * exp( 125._r8 * itemp(:) ) rate(:,298) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) rate(:,299) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) rate(:,300) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) @@ -406,10 +407,10 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,302) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) rate(:,304) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) exp_fac(:) = exp( 700._r8 * itemp(:) ) - rate(:,308) = 7.5e-13_r8 * exp_fac(:) - rate(:,322) = 7.5e-13_r8 * exp_fac(:) - rate(:,337) = 7.5e-13_r8 * exp_fac(:) - rate(:,350) = 7.5e-13_r8 * exp_fac(:) + rate(:,307) = 7.5e-13_r8 * exp_fac(:) + rate(:,321) = 7.5e-13_r8 * exp_fac(:) + rate(:,336) = 7.5e-13_r8 * exp_fac(:) + rate(:,349) = 7.5e-13_r8 * exp_fac(:) rate(:,358) = 7.5e-13_r8 * exp_fac(:) rate(:,362) = 8.6e-13_r8 * exp_fac(:) rate(:,374) = 8e-13_r8 * exp_fac(:) @@ -429,12 +430,16 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,486) = 7.5e-13_r8 * exp_fac(:) rate(:,491) = 7.5e-13_r8 * exp_fac(:) rate(:,496) = 7.5e-13_r8 * exp_fac(:) - rate(:,309) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) - rate(:,310) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) - rate(:,314) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) - rate(:,319) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + rate(:,540) = 7.5e-13_r8 * exp_fac(:) + rate(:,547) = 7.5e-13_r8 * exp_fac(:) + rate(:,557) = 7.5e-13_r8 * exp_fac(:) + rate(:,560) = 7.5e-13_r8 * exp_fac(:) + rate(:,308) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) + rate(:,309) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) + rate(:,313) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) + rate(:,318) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) exp_fac(:) = exp( 365._r8 * itemp(:) ) - rate(:,323) = 2.6e-12_r8 * exp_fac(:) + rate(:,322) = 2.6e-12_r8 * exp_fac(:) rate(:,440) = 2.6e-12_r8 * exp_fac(:) rate(:,445) = 2.6e-12_r8 * exp_fac(:) rate(:,447) = 2.6e-12_r8 * exp_fac(:) @@ -442,35 +447,42 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,467) = 2.6e-12_r8 * exp_fac(:) rate(:,473) = 2.6e-12_r8 * exp_fac(:) rate(:,476) = 2.6e-12_r8 * exp_fac(:) - rate(:,324) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) - rate(:,326) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) - rate(:,327) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + rate(:,541) = 2.6e-12_r8 * exp_fac(:) + rate(:,548) = 2.6e-12_r8 * exp_fac(:) + rate(:,558) = 2.6e-12_r8 * exp_fac(:) + rate(:,561) = 2.6e-12_r8 * exp_fac(:) + rate(:,323) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,325) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,326) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) exp_fac(:) = exp( -1900._r8 * itemp(:) ) - rate(:,328) = 1.4e-12_r8 * exp_fac(:) - rate(:,348) = 6.5e-15_r8 * exp_fac(:) - rate(:,329) = 4.63e-12_r8 * exp( 350._r8 * itemp(:) ) - rate(:,330) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) + rate(:,327) = 1.4e-12_r8 * exp_fac(:) + rate(:,347) = 6.5e-15_r8 * exp_fac(:) + exp_fac(:) = exp( 350._r8 * itemp(:) ) + rate(:,328) = 4.63e-12_r8 * exp_fac(:) + rate(:,544) = 2.7e-12_r8 * exp_fac(:) + rate(:,329) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) exp_fac(:) = exp( 500._r8 * itemp(:) ) - rate(:,331) = 2.9e-12_r8 * exp_fac(:) - rate(:,332) = 2e-12_r8 * exp_fac(:) + rate(:,330) = 2.9e-12_r8 * exp_fac(:) + rate(:,331) = 2e-12_r8 * exp_fac(:) rate(:,361) = 7.1e-13_r8 * exp_fac(:) rate(:,382) = 2e-12_r8 * exp_fac(:) rate(:,485) = 2e-12_r8 * exp_fac(:) rate(:,490) = 2e-12_r8 * exp_fac(:) rate(:,495) = 2e-12_r8 * exp_fac(:) exp_fac(:) = exp( 1040._r8 * itemp(:) ) - rate(:,333) = 4.3e-13_r8 * exp_fac(:) + rate(:,332) = 4.3e-13_r8 * exp_fac(:) rate(:,383) = 4.3e-13_r8 * exp_fac(:) rate(:,436) = 4.3e-13_r8 * exp_fac(:) rate(:,450) = 4.3e-13_r8 * exp_fac(:) rate(:,453) = 4.3e-13_r8 * exp_fac(:) rate(:,456) = 4.3e-13_r8 * exp_fac(:) - rate(:,339) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) - rate(:,347) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) - rate(:,349) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) - rate(:,353) = 8.7e-12_r8 * exp( -615._r8 * itemp(:) ) - rate(:,354) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) - rate(:,355) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + rate(:,334) = 3.15e-14_r8 * exp( 920._r8 * itemp(:) ) + rate(:,338) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,346) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,348) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,352) = 9.19e-12_r8 * exp( -630._r8 * itemp(:) ) + rate(:,353) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) + rate(:,354) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) rate(:,369) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) rate(:,370) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) exp_fac(:) = exp( 360._r8 * itemp(:) ) @@ -480,6 +492,8 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,385) = 5.3e-12_r8 * exp_fac(:) rate(:,422) = 2.7e-12_r8 * exp_fac(:) rate(:,433) = 2.7e-12_r8 * exp_fac(:) + rate(:,536) = 2.7e-12_r8 * exp_fac(:) + rate(:,552) = 2.7e-12_r8 * exp_fac(:) rate(:,378) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) exp_fac(:) = exp( 530._r8 * itemp(:) ) rate(:,381) = 4.6e-12_r8 * exp_fac(:) @@ -493,42 +507,46 @@ subroutine setrxt( rate, temp, m, ncol ) rate(:,413) = 1.6e+09_r8 * exp( -8300._r8 * itemp(:) ) exp_fac(:) = exp( -446._r8 * itemp(:) ) rate(:,418) = 3.03e-12_r8 * exp_fac(:) - rate(:,538) = 3.03e-12_r8 * exp_fac(:) + rate(:,542) = 3.03e-12_r8 * exp_fac(:) exp_fac(:) = exp( 410._r8 * itemp(:) ) rate(:,426) = 2.54e-11_r8 * exp_fac(:) - rate(:,540) = 2.54e-11_r8 * exp_fac(:) + rate(:,546) = 2.54e-11_r8 * exp_fac(:) rate(:,430) = 1.3e-12_r8 * exp( 640._r8 * itemp(:) ) exp_fac(:) = exp( -193._r8 * itemp(:) ) rate(:,438) = 2.3e-12_r8 * exp_fac(:) - rate(:,537) = 2.3e-12_r8 * exp_fac(:) + rate(:,539) = 2.3e-12_r8 * exp_fac(:) rate(:,442) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) rate(:,461) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) exp_fac(:) = exp( 352._r8 * itemp(:) ) rate(:,469) = 1.7e-12_r8 * exp_fac(:) - rate(:,546) = 1.7e-12_r8 * exp_fac(:) + rate(:,556) = 1.7e-12_r8 * exp_fac(:) exp_fac(:) = exp( 490._r8 * itemp(:) ) rate(:,482) = 1.2e-12_r8 * exp_fac(:) - rate(:,542) = 1.2e-12_r8 * exp_fac(:) + rate(:,550) = 1.2e-12_r8 * exp_fac(:) exp_fac(:) = exp( -580._r8 * itemp(:) ) rate(:,483) = 6.3e-16_r8 * exp_fac(:) - rate(:,543) = 6.3e-16_r8 * exp_fac(:) + rate(:,553) = 6.3e-16_r8 * exp_fac(:) exp_fac(:) = exp( 440._r8 * itemp(:) ) rate(:,484) = 1.2e-11_r8 * exp_fac(:) - rate(:,544) = 1.2e-11_r8 * exp_fac(:) + rate(:,554) = 1.2e-11_r8 * exp_fac(:) rate(:,502) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) - rate(:,503) = 9.6e-12_r8 * exp( -234._r8 * itemp(:) ) + rate(:,503) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) rate(:,504) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) rate(:,505) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) - rate(:,512) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) - rate(:,515) = 2.7e-11_r8 * exp( 335._r8 * itemp(:) ) + rate(:,513) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,516) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) rate(:,519) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + exp_fac(:) = exp( 1300._r8 * itemp(:) ) + rate(:,535) = 2.75e-13_r8 * exp_fac(:) + rate(:,543) = 2.12e-13_r8 * exp_fac(:) + rate(:,551) = 2.6e-13_r8 * exp_fac(:) itemp(:) = 300._r8 * itemp(:) n = ncol*pver - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + ko(:) = 5.3e-32_r8 * itemp(:)**1.8_r8 + kinf(:) = 9.5e-11_r8 * itemp(:)**(-0.4_r8) call jpl( rate(:,175), m, 0.6_r8, ko, kinf, n ) ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 @@ -567,33 +585,29 @@ subroutine setrxt( rate, temp, m, ncol ) kinf(:) = 6.9e-12_r8 * itemp(:)**2.9_r8 call jpl( rate(:,259), m, 0.6_r8, ko, kinf, n ) - ko(:) = 5.9e-33_r8 * itemp(:)**1._r8 - kinf(:) = 1.1e-12_r8 * itemp(:)**(-1.3_r8) - call jpl( rate(:,305), m, 0.6_r8, ko, kinf, n ) - - ko(:) = 4.28e-33_r8 - kinf(:) = 9.3e-15_r8 * itemp(:)**(-4.42_r8) - call jpl( rate(:,306), m, 0.8_r8, ko, kinf, n ) + ko(:) = 6.1e-33_r8 * itemp(:)**1.5_r8 + kinf(:) = 9.8e-15_r8 * itemp(:)**(-4.6_r8) + call jpl( rate(:,305), m, 0.8_r8, ko, kinf, n ) ko(:) = 5.2e-30_r8 * itemp(:)**2.4_r8 kinf(:) = 2.2e-10_r8 * itemp(:)**0.7_r8 - call jpl( rate(:,316), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,315), m, 0.6_r8, ko, kinf, n ) ko(:) = 5.5e-30_r8 kinf(:) = 8.3e-13_r8 * itemp(:)**(-2._r8) - call jpl( rate(:,317), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,316), 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(:,318), m, 0.6_r8, ko, kinf, n ) + call jpl( rate(:,317), 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(:,344), m, 0.48_r8, ko, kinf, n ) + call jpl( rate(:,343), m, 0.48_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(:,345), m, 0.6_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(:,344), m, 0.6_r8, ko, kinf, n ) ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 kinf(:) = 3e-11_r8 @@ -603,6 +617,10 @@ subroutine setrxt( rate, temp, m, ncol ) kinf(:) = 3e-11_r8 call jpl( rate(:,391), 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(:,394), m, 0.6_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(:,452), m, 0.6_r8, ko, kinf, n ) @@ -619,6 +637,10 @@ subroutine setrxt( rate, temp, m, ncol ) kinf(:) = 9.3e-12_r8 * itemp(:)**1.5_r8 call jpl( rate(:,465), 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(:,507), m, 0.6_r8, ko, kinf, n ) + end subroutine setrxt @@ -662,12 +684,12 @@ subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) rate(:n,172) = 6.9e-12_r8 rate(:n,188) = 7e-13_r8 rate(:n,189) = 5e-12_r8 - rate(:n,568) = 6e-11_r8 - rate(:n,571) = 1e-12_r8 - rate(:n,572) = 4e-10_r8 - rate(:n,573) = 2e-10_r8 - rate(:n,574) = 1e-10_r8 - rate(:n,576) = 4.4e-10_r8 + rate(:n,582) = 6e-11_r8 + rate(:n,585) = 1e-12_r8 + rate(:n,586) = 4e-10_r8 + rate(:n,587) = 2e-10_r8 + rate(:n,588) = 1e-10_r8 + rate(:n,590) = 4.4e-10_r8 do k = 1,kbot offset = (k-1)*ncol @@ -689,15 +711,15 @@ subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) rate(:n,182) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) rate(:n,183) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) rate(:n,190) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) - rate(:n,194) = 1.5e-11_r8 * exp( -3600._r8 * itemp(:) ) + rate(:n,194) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) rate(:n,195) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) - rate(:n,203) = 3.3e-12_r8 * exp( 270._r8 * itemp(:) ) + rate(:n,203) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) rate(:n,204) = 3e-12_r8 * exp( -1500._r8 * itemp(:) ) itemp(:) = 300._r8 * itemp(:) - ko(:) = 4.4e-32_r8 * itemp(:)**1.3_r8 - kinf(:) = 7.5e-11_r8 * itemp(:)**(-0.2_r8) + 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,175) = wrk(:) @@ -721,6 +743,7 @@ subroutine setrxt_hrates( rate, temp, m, ncol, kbot ) + end subroutine setrxt_hrates diff --git a/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 b/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 index 1fbe2077d1..e505988ab3 100644 --- a/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 +++ b/src/chemistry/pp_waccm_tsmlt_mam4/mo_sim_dat.F90 @@ -31,12 +31,12 @@ subroutine set_sim_dat is_scalar = .false. is_vector = .true. - clscnt(:) = (/ 31, 0, 0, 201, 0 /) + clscnt(:) = (/ 2, 0, 0, 237, 0 /) - cls_rxt_cnt(:,1) = (/ 37, 63, 0, 31 /) - cls_rxt_cnt(:,4) = (/ 30, 195, 353, 201 /) + cls_rxt_cnt(:,1) = (/ 9, 0, 0, 2 /) + cls_rxt_cnt(:,4) = (/ 8, 185, 404, 237 /) - solsym(:232) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','bc_a1 ','bc_a4 ', & + solsym(:239) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','bc_a1 ','bc_a4 ', & 'BCARY ','BENZENE ','BENZOOH ','BEPOMUC ','BIGALD ', & 'BIGALD1 ','BIGALD2 ','BIGALD3 ','BIGALD4 ','BIGALK ', & 'BIGENE ','BR ','BRCL ','BRO ','BRONO2 ', & @@ -53,10 +53,10 @@ subroutine set_sim_dat 'E90 ','EOOH ','F ','GLYALD ','GLYOXAL ', & 'H ','H2 ','H2402 ','H2O2 ','H2SO4 ', & 'HBR ','HCFC141B ','HCFC142B ','HCFC22 ','HCL ', & - 'HCN ','HCOOH ','HF ','HNO3 ','HO2NO2 ', & - 'HOBR ','HOCL ','HONITR ','HPALD ','HYAC ', & - 'HYDRALD ','IEPOX ','ISOP ','ISOPNITA ','ISOPNITB ', & - 'ISOPNO3 ','ISOPNOOH ','ISOPOOH ','IVOC ','MACR ', & + 'HCN ','HCOOH ','HF ','HNO3 ','HO2 ', & + 'HO2NO2 ','HOBR ','HOCL ','HONITR ','HPALD ', & + 'HYAC ','HYDRALD ','IEPOX ','ISOP ','ISOPNITA ', & + 'ISOPNITB ','ISOPNOOH ','ISOPOOH ','IVOC ','MACR ', & 'MACROOH ','MEK ','MEKOOH ','MPAN ','MTERP ', & 'MVK ','N ','N2O ','N2O5 ','NC4CH2OH ', & 'NC4CHO ','ncl_a1 ','ncl_a2 ','ncl_a3 ','NH3 ', & @@ -74,17 +74,18 @@ subroutine set_sim_dat 'TERPNIT ','TERPOOH ','TERPROD1 ','TERPROD2 ','TOLOOH ', & 'TOLUENE ','XOOH ','XYLENES ','XYLENOOH ','XYLOL ', & 'XYLOLOOH ','NHDEP ','NDEP ','ACBZO2 ','ALKO2 ', & - 'BENZO2 ','BZOO ','C2H5O2 ','C3H7O2 ','C6H5O2 ', & - 'CH3CO3 ','CH3O2 ','DICARBO2 ','e ','ENEO2 ', & - 'EO ','EO2 ','HO2 ','HOCH2OO ','ISOPAO2 ', & - 'ISOPBO2 ','MACRO2 ','MALO2 ','MCO3 ','MDIALO2 ', & - 'MEKO2 ','N2D ','N2p ','NOp ','Np ', & + 'BCARYO2VBS ','BENZO2 ','BENZO2VBS ','BZOO ','C2H5O2 ', & + 'C3H7O2 ','C6H5O2 ','CH3CO3 ','CH3O2 ','DICARBO2 ', & + 'e ','ENEO2 ','EO ','EO2 ','HOCH2OO ', & + 'ISOPAO2 ','ISOPBO2 ','ISOPNO3 ','ISOPO2VBS ','IVOCO2VBS ', & + 'MACRO2 ','MALO2 ','MCO3 ','MDIALO2 ','MEKO2 ', & + 'MTERPO2VBS ','N2D ','N2p ','NOp ','Np ', & 'NTERPO2 ','O1D ','O2_1D ','O2_1S ','O2p ', & 'OH ','Op ','PHENO2 ','PO2 ','RO2 ', & - 'TERP2O2 ','TERPO2 ','TOLO2 ','XO2 ','XYLENO2 ', & - 'XYLOLO2 ','H2O ' /) + 'TERP2O2 ','TERPO2 ','TOLO2 ','TOLUO2VBS ','XO2 ', & + 'XYLENO2 ','XYLEO2VBS ','XYLOLO2 ','H2O ' /) - adv_mass(:232) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 12.011000_r8, 12.011000_r8, & + adv_mass(:239) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 12.011000_r8, 12.011000_r8, & 204.342600_r8, 78.110400_r8, 160.122200_r8, 126.108600_r8, 98.098200_r8, & 84.072400_r8, 98.098200_r8, 98.098200_r8, 112.124000_r8, 72.143800_r8, & 56.103200_r8, 79.904000_r8, 115.356700_r8, 95.903400_r8, 141.908940_r8, & @@ -101,10 +102,10 @@ subroutine set_sim_dat 28.010400_r8, 78.064600_r8, 18.998403_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, & - 27.025140_r8, 46.024600_r8, 20.005803_r8, 63.012340_r8, 79.011740_r8, & - 96.910800_r8, 52.459500_r8, 135.114940_r8, 116.112400_r8, 74.076200_r8, & - 100.113000_r8, 118.127200_r8, 68.114200_r8, 147.125940_r8, 147.125940_r8, & - 162.117940_r8, 163.125340_r8, 118.127200_r8, 184.350200_r8, 70.087800_r8, & + 27.025140_r8, 46.024600_r8, 20.005803_r8, 63.012340_r8, 33.006200_r8, & + 79.011740_r8, 96.910800_r8, 52.459500_r8, 135.114940_r8, 116.112400_r8, & + 74.076200_r8, 100.113000_r8, 118.127200_r8, 68.114200_r8, 147.125940_r8, & + 147.125940_r8, 163.125340_r8, 118.127200_r8, 184.350200_r8, 70.087800_r8, & 120.100800_r8, 72.102600_r8, 104.101400_r8, 147.084740_r8, 136.228400_r8, & 70.087800_r8, 14.006740_r8, 44.012880_r8, 108.010480_r8, 147.125940_r8, & 145.111140_r8, 58.442468_r8, 58.442468_r8, 58.442468_r8, 17.028940_r8, & @@ -122,17 +123,18 @@ subroutine set_sim_dat 215.240140_r8, 186.241400_r8, 168.227200_r8, 154.201400_r8, 174.148000_r8, & 92.136200_r8, 150.126000_r8, 106.162000_r8, 188.173800_r8, 122.161400_r8, & 204.173200_r8, 14.006740_r8, 14.006740_r8, 137.112200_r8, 103.135200_r8, & - 159.114800_r8, 123.127600_r8, 61.057800_r8, 75.083600_r8, 109.101800_r8, & - 75.042400_r8, 47.032000_r8, 129.089600_r8, 0.548567E-03_r8, 105.108800_r8, & - 61.057800_r8, 77.057200_r8, 33.006200_r8, 63.031400_r8, 117.119800_r8, & - 117.119800_r8, 119.093400_r8, 115.063800_r8, 101.079200_r8, 117.078600_r8, & - 103.094000_r8, 14.006740_r8, 28.013480_r8, 30.006140_r8, 14.006740_r8, & + 253.348200_r8, 159.114800_r8, 159.114800_r8, 123.127600_r8, 61.057800_r8, & + 75.083600_r8, 109.101800_r8, 75.042400_r8, 47.032000_r8, 129.089600_r8, & + 0.548567E-03_r8, 105.108800_r8, 61.057800_r8, 77.057200_r8, 63.031400_r8, & + 117.119800_r8, 117.119800_r8, 162.117940_r8, 117.119800_r8, 233.355800_r8, & + 119.093400_r8, 115.063800_r8, 101.079200_r8, 117.078600_r8, 103.094000_r8, & + 185.234000_r8, 14.006740_r8, 28.013480_r8, 30.006140_r8, 14.006740_r8, & 230.232140_r8, 15.999400_r8, 31.998800_r8, 31.998800_r8, 31.998800_r8, & 17.006800_r8, 15.999400_r8, 175.114200_r8, 91.083000_r8, 89.068200_r8, & - 199.218600_r8, 185.234000_r8, 173.140600_r8, 149.118600_r8, 187.166400_r8, & - 203.165800_r8, 18.014200_r8 /) + 199.218600_r8, 185.234000_r8, 173.140600_r8, 173.140600_r8, 149.118600_r8, & + 187.166400_r8, 187.166400_r8, 203.165800_r8, 18.014200_r8 /) - crb_mass(:232) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + crb_mass(:239) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, 60.055000_r8, & 48.044000_r8, 60.055000_r8, 60.055000_r8, 72.066000_r8, 60.055000_r8, & 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & @@ -150,8 +152,8 @@ subroutine set_sim_dat 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, & 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & - 0.000000_r8, 0.000000_r8, 48.044000_r8, 60.055000_r8, 36.033000_r8, & - 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 48.044000_r8, 60.055000_r8, & + 36.033000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & 60.055000_r8, 60.055000_r8, 60.055000_r8, 156.143000_r8, 48.044000_r8, & 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 120.110000_r8, & 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 60.055000_r8, & @@ -170,111 +172,117 @@ subroutine set_sim_dat 120.110000_r8, 120.110000_r8, 120.110000_r8, 108.099000_r8, 84.077000_r8, & 84.077000_r8, 60.055000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, & 96.088000_r8, 0.000000_r8, 0.000000_r8, 84.077000_r8, 60.055000_r8, & - 72.066000_r8, 84.077000_r8, 24.022000_r8, 36.033000_r8, 72.066000_r8, & - 24.022000_r8, 12.011000_r8, 60.055000_r8, 0.000000_r8, 48.044000_r8, & - 24.022000_r8, 24.022000_r8, 0.000000_r8, 12.011000_r8, 60.055000_r8, & - 60.055000_r8, 48.044000_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, & + 180.165000_r8, 72.066000_r8, 72.066000_r8, 84.077000_r8, 24.022000_r8, & + 36.033000_r8, 72.066000_r8, 24.022000_r8, 12.011000_r8, 60.055000_r8, & + 0.000000_r8, 48.044000_r8, 24.022000_r8, 24.022000_r8, 12.011000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 156.143000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 120.110000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & 120.110000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & 0.000000_r8, 0.000000_r8, 72.066000_r8, 36.033000_r8, 36.033000_r8, & - 120.110000_r8, 120.110000_r8, 84.077000_r8, 60.055000_r8, 96.088000_r8, & - 96.088000_r8, 0.000000_r8 /) + 120.110000_r8, 120.110000_r8, 84.077000_r8, 84.077000_r8, 60.055000_r8, & + 96.088000_r8, 96.088000_r8, 96.088000_r8, 0.000000_r8 /) fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) - clsmap(: 31,1) = (/ 3, 21, 33, 34, 35, 36, 37, 38, 39, 40, & - 41, 43, 44, 46, 54, 55, 61, 63, 71, 78, & - 82, 83, 84, 113, 122, 123, 150, 172, 187, 188, & - 136 /) - clsmap(:201,4) = (/ 1, 2, 4, 5, 6, 7, 8, 9, 10, 11, & - 12, 13, 14, 15, 16, 17, 18, 19, 20, 22, & - 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, & - 42, 45, 47, 48, 49, 50, 51, 52, 53, 56, & - 57, 58, 59, 60, 62, 64, 65, 66, 67, 68, & - 69, 70, 72, 73, 74, 75, 76, 77, 79, 80, & - 81, 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, 114, & - 115, 116, 117, 118, 119, 120, 121, 124, 125, 126, & - 127, 128, 129, 130, 131, 132, 133, 134, 135, 137, & - 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, & - 148, 149, 151, 152, 153, 154, 155, 156, 157, 158, & - 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, & - 169, 170, 171, 173, 174, 175, 176, 177, 178, 179, & - 180, 181, 182, 183, 184, 185, 186, 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 /) + clsmap(: 2,1) = (/ 187, 188 /) + clsmap(:237,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, 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, 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 /) - permute(:201,4) = (/ 123, 124, 1, 2, 153, 48, 84, 49, 85, 95, & - 70, 118, 76, 62, 82, 184, 63, 198, 110, 64, & - 79, 71, 112, 66, 80, 72, 160, 89, 39, 67, & - 193, 170, 38, 156, 175, 111, 105, 140, 90, 188, & - 47, 36, 200, 157, 165, 40, 51, 54, 69, 3, & - 4, 5, 41, 136, 161, 149, 195, 172, 115, 42, & - 145, 183, 52, 141, 59, 196, 99, 134, 146, 162, & - 60, 164, 73, 43, 148, 119, 108, 173, 88, 127, & - 34, 174, 74, 107, 75, 114, 151, 179, 144, 68, & - 83, 159, 6, 7, 8, 37, 9, 187, 197, 194, & - 147, 86, 10, 11, 12, 13, 192, 186, 191, 77, & - 81, 61, 97, 44, 98, 50, 78, 14, 15, 109, & - 87, 129, 182, 155, 65, 16, 17, 18, 19, 20, & - 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & - 31, 32, 33, 35, 55, 116, 121, 100, 158, 163, & - 117, 53, 56, 57, 128, 58, 91, 104, 154, 101, & - 92, 152, 143, 122, 181, 185, 133, 139, 113, 96, & - 135, 199, 93, 176, 177, 178, 130, 180, 150, 125, & - 106, 126, 138, 102, 168, 189, 45, 46, 137, 190, & - 120, 94, 142, 169, 167, 166, 131, 171, 132, 103, & - 201 /) + permute(:237,4) = (/ 153, 157, 1, 2, 3, 187, 69, 118, 70, 115, & + 127, 97, 147, 106, 85, 111, 219, 86, 221, 143, & + 4, 89, 109, 99, 141, 93, 110, 100, 197, 120, & + 101, 94, 54, 65, 66, 57, 67, 58, 68, 59, & + 130, 235, 148, 60, 198, 113, 55, 193, 208, 159, & + 150, 170, 116, 233, 125, 227, 72, 52, 222, 185, & + 5, 199, 215, 88, 83, 77, 102, 6, 7, 8, & + 9, 61, 182, 200, 190, 230, 216, 56, 149, 62, & + 172, 82, 90, 95, 218, 75, 180, 98, 228, 231, & + 133, 167, 173, 202, 84, 203, 105, 63, 178, 146, & + 142, 121, 162, 48, 207, 103, 136, 104, 145, 188, & + 212, 186, 91, 96, 114, 196, 10, 11, 12, 53, & + 13, 14, 15, 229, 225, 226, 177, 117, 16, 17, & + 18, 19, 234, 220, 236, 20, 107, 112, 87, 139, & + 64, 129, 71, 108, 21, 22, 140, 119, 160, 23, & + 217, 184, 92, 24, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 78, 154, 151, 131, 192, 195, 155, & + 76, 79, 80, 161, 81, 122, 137, 189, 44, 132, & + 45, 123, 179, 183, 152, 214, 232, 166, 176, 144, & + 128, 168, 124, 209, 210, 206, 46, 47, 211, 163, & + 213, 181, 158, 49, 138, 156, 174, 134, 194, 223, & + 73, 74, 175, 224, 169, 126, 171, 204, 201, 191, & + 164, 50, 205, 165, 51, 135, 237 /) - diag_map(:201) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + diag_map(:237) = (/ 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, 39, 45, 46, 49, 52, 55, 59, & - 62, 65, 68, 71, 74, 77, 79, 86, 92, 96, & - 101, 105, 114, 121, 126, 130, 139, 147, 152, 155, & - 160, 163, 166, 169, 173, 177, 181, 185, 191, 197, & - 200, 206, 212, 215, 220, 225, 230, 235, 241, 246, & - 251, 259, 267, 273, 279, 285, 291, 297, 303, 309, & - 315, 323, 329, 336, 342, 345, 350, 357, 361, 368, & - 377, 384, 392, 400, 406, 412, 417, 422, 430, 438, & - 446, 450, 458, 466, 474, 481, 492, 501, 505, 514, & - 521, 529, 536, 547, 558, 567, 578, 589, 600, 607, & - 618, 634, 645, 654, 664, 673, 681, 690, 701, 708, & - 712, 717, 728, 744, 753, 762, 769, 781, 798, 803, & - 820, 840, 858, 880, 892, 898, 906, 916, 928, 943, & - 960, 968, 982, 991, 997,1008,1030,1049,1065,1076, & - 1091,1104,1124,1140,1152,1172,1206,1231,1251,1271, & - 1302,1318,1337,1352,1396,1427,1507,1543,1570,1719, & - 1782,1824,1849,1907,1928,1951,1994,2019,2115,2143, & - 2170 /) + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 48, 54, 60, 66, 72, 74, 80, 86, & + 92, 93, 96, 99, 102, 105, 109, 113, 117, 121, & + 125, 128, 131, 134, 137, 142, 147, 152, 158, 164, & + 168, 173, 175, 178, 180, 185, 192, 197, 201, 206, & + 214, 219, 224, 228, 233, 236, 239, 242, 245, 249, & + 254, 259, 263, 267, 272, 278, 284, 287, 290, 296, & + 302, 308, 314, 319, 324, 327, 332, 337, 343, 348, & + 353, 361, 369, 377, 383, 389, 395, 401, 407, 413, & + 419, 425, 433, 439, 445, 452, 458, 461, 466, 470, & + 477, 486, 493, 500, 508, 515, 521, 527, 532, 540, & + 548, 556, 564, 572, 580, 589, 598, 602, 611, 618, & + 625, 633, 640, 650, 663, 674, 685, 696, 703, 708, & + 719, 731, 738, 749, 765, 776, 785, 795, 803, 811, & + 816, 826, 835, 843, 851, 863, 871, 880, 899, 908, & + 913, 923, 933, 945, 953, 969, 988,1016,1040,1052, & + 1060,1070,1078,1088,1101,1115,1131,1149,1158,1164, & + 1176,1193,1206,1215,1231,1251,1267,1279,1297,1330, & + 1354,1374,1395,1426,1448,1459,1474,1493,1509,1540, & + 1563,1590,1633,1799,1845,1906,1953,1977,2073,2095, & + 2204,2257,2283,2327,2354,2419,2447 /) - extfrc_lst(: 23) = (/ 'NO2 ','NO ','CO ','SO2 ','SVOC ', & - 'so4_a1 ','so4_a2 ','pom_a1 ','pom_a4 ','num_a1 ', & - 'num_a2 ','num_a4 ','bc_a1 ','bc_a4 ','AOA_NH ', & - 'O2p ','Np ','N2p ','N2D ','e ', & - 'N ','OH ','Op ' /) + extfrc_lst(: 20) = (/ 'CO ','SVOC ','SO2 ','NO2 ','NO ', & + 'num_a1 ','num_a2 ','so4_a1 ','so4_a2 ','num_a4 ', & + 'pom_a4 ','bc_a4 ','O2p ','N2p ','N2D ', & + 'AOA_NH ','N ','OH ','Op ','e ' /) - frc_from_dataset(: 23) = (/ .true., .true., .true., .true., .true., & + frc_from_dataset(: 20) = (/ .true., .true., .true., .true., .true., & .true., .true., .true., .true., .true., & - .true., .true., .true., .true., .false., & - .false., .false., .false., .false., .false., & - .false., .false., .false. /) + .true., .true., .false., .false., .false., & + .false., .false., .false., .false., .false. /) inv_lst(: 2) = (/ 'M ', 'N2 ' /) - slvd_lst(: 43) = (/ 'ACBZO2 ', 'ALKO2 ', 'BENZO2 ', 'BZOO ', 'C2H5O2 ', & - 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', 'CH3O2 ', 'DICARBO2 ', & - 'e ', 'ENEO2 ', 'EO ', 'EO2 ', 'HO2 ', & - 'HOCH2OO ', 'ISOPAO2 ', 'ISOPBO2 ', 'MACRO2 ', 'MALO2 ', & - 'MCO3 ', 'MDIALO2 ', 'MEKO2 ', 'N2D ', 'N2p ', & + slvd_lst(: 50) = (/ 'ACBZO2 ', 'ALKO2 ', 'BCARYO2VBS ', 'BENZO2 ', 'BENZO2VBS ', & + 'BZOO ', 'C2H5O2 ', 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', & + 'CH3O2 ', 'DICARBO2 ', 'e ', 'ENEO2 ', 'EO ', & + 'EO2 ', 'HOCH2OO ', 'ISOPAO2 ', 'ISOPBO2 ', 'ISOPNO3 ', & + 'ISOPO2VBS ', 'IVOCO2VBS ', 'MACRO2 ', 'MALO2 ', 'MCO3 ', & + 'MDIALO2 ', 'MEKO2 ', 'MTERPO2VBS ', 'N2D ', 'N2p ', & 'NOp ', 'Np ', 'NTERPO2 ', 'O1D ', 'O2_1D ', & 'O2_1S ', 'O2p ', 'OH ', 'Op ', 'PHENO2 ', & 'PO2 ', 'RO2 ', 'TERP2O2 ', 'TERPO2 ', 'TOLO2 ', & - 'XO2 ', 'XYLENO2 ', 'XYLOLO2 ' /) + 'TOLUO2VBS ', 'XO2 ', 'XYLENO2 ', 'XYLEO2VBS ', 'XYLOLO2 ' /) if( allocated( rxt_tag_lst ) ) then deallocate( rxt_tag_lst ) @@ -308,11 +316,11 @@ subroutine set_sim_dat 'jbigald3 ', 'jbigald4 ', & 'jbzooh ', 'jc2h5ooh ', & 'jc3h7ooh ', 'jc6h5ooh ', & - 'jch2o_a ', 'jch2o_b ', & + 'jch2o_b ', 'jch2o_a ', & 'jch3cho ', 'jacet ', & 'jmgly ', 'jch3co3h ', & - 'jch3ooh ', 'jch4_a ', & - 'jch4_b ', 'jco2 ', & + 'jch3ooh ', 'jch4_b ', & + 'jch4_a ', 'jco2 ', & 'jeooh ', 'jglyald ', & 'jglyoxal ', 'jhonitr ', & 'jhpald ', 'jhyac ', & @@ -444,32 +452,32 @@ subroutine set_sim_dat 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & 'CH3O2_NO ', 'CH3OH_OH ', & 'CH3OOH_OH ', 'CH4_OH ', & - 'CO_OH_M ', 'HCN_OH ', & - 'HCOOH_OH ', 'HOCH2OO_HO2 ', & - 'HOCH2OO_M ', 'HOCH2OO_NO ', & - 'O1D_CH4a ', 'O1D_CH4b ', & - 'O1D_CH4c ', 'O1D_HCN ', & - 'usr_CO_OH_b ', 'C2H2_CL_M ', & - 'C2H2_OH_M ', '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 ', 'CH3CN_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 ', & + 'HCN_OH ', 'HCOOH_OH ', & + 'HOCH2OO_HO2 ', 'HOCH2OO_M ', & + 'HOCH2OO_NO ', 'O1D_CH4a ', & + 'O1D_CH4b ', 'O1D_CH4c ', & + 'O1D_HCN ', 'usr_CO_OH ', & + 'C2H2_CL_M ', 'C2H2_OH_M ', & + '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 ', & + 'CH3CN_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 ', & + 'CL_C3H8 ', 'HYAC_OH ', & 'NOA_OH ', 'PO2_HO2 ', & 'PO2_NO ', 'POOH_OH ', & 'RO2_CH3O2 ', 'RO2_HO2 ', & @@ -488,11 +496,11 @@ subroutine set_sim_dat 'MEKO2_HO2 ', 'MEKO2_NO ', & 'MEK_OH ', 'MEKOOH_OH ', & 'MPAN_OH_M ', 'MVK_O3 ', & - 'MVK_OH ', 'usr_MCO3_NO2 ', & + 'MVK_OH ', 'tag_MCO3_NO2 ', & 'usr_MPAN_M ', 'ALKNIT_OH ', & 'ALKO2_HO2 ', 'ALKO2_NO ', & 'ALKO2_NOb ', 'ALKOOH_OH ' /) - rxt_tag_lst( 401: 583) = (/ 'BIGALK_OH ', 'HPALD_OH ', & + rxt_tag_lst( 401: 597) = (/ 'BIGALK_OH ', 'HPALD_OH ', & 'HYDRALD_OH ', 'IEPOX_OH ', & 'ISOPAO2_CH3CO3 ', 'ISOPAO2_CH3O2 ', & 'ISOPAO2_HO2 ', 'ISOPAO2_NO ', & @@ -545,12 +553,12 @@ subroutine set_sim_dat 'TERPROD2_OH ', 'DMS_NO3 ', & 'DMS_OHa ', 'OCS_O ', & 'OCS_OH ', 'S_O2 ', & - 'S_O3 ', 'SO_BRO ', & - 'SO_CLO ', 'S_OH ', & - 'SO_NO2 ', 'SO_O2 ', & - 'SO_O3 ', 'SO_OCLO ', & - 'SO_OH ', 'usr_DMS_OH ', & - 'usr_SO2_OH ', 'usr_SO3_H2O ', & + '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_GLYOXAL_aer ', & 'usr_HO2_aer ', 'usr_HONITR_aer ', & 'usr_ISOPNITA_aer ', 'usr_ISOPNITB_aer ', & @@ -559,13 +567,20 @@ subroutine set_sim_dat 'usr_NO2_aer ', 'usr_NO3_aer ', & 'usr_NTERPOOH_aer ', 'usr_ONITR_aer ', & 'usr_TERPNIT_aer ', 'BCARY_NO3_vbs ', & + 'BCARYO2_HO2_vbs ', 'BCARYO2_NO_vbs ', & 'BCARY_O3_vbs ', 'BCARY_OH_vbs ', & - 'BENZENE_OH_vbs ', 'ISOP_NO3_vbs ', & + 'BENZENE_OH_vbs ', 'BENZO2_HO2_vbs ', & + 'BENZO2_NO_vbs ', 'ISOP_NO3_vbs ', & + 'ISOPO2_HO2_vbs ', 'ISOPO2_NO_vbs ', & 'ISOP_O3_vbs ', 'ISOP_OH_vbs ', & - 'IVOC_OH ', 'MTERP_NO3_vbs ', & + 'IVOCO2_HO2_vbs ', 'IVOCO2_NO_vbs ', & + 'IVOC_OH_vbs ', 'MTERP_NO3_vbs ', & + 'MTERPO2_HO2_vbs ', 'MTERPO2_NO_vbs ', & 'MTERP_O3_vbs ', 'MTERP_OH_vbs ', & 'SVOC_OH ', 'TOLUENE_OH_vbs ', & - 'XYLENES_OH_vbs ', 'het1 ', & + 'TOLUO2_HO2_vbs ', 'TOLUO2_NO_vbs ', & + 'XYLENES_OH_vbs ', 'XYLEO2_HO2_vbs ', & + 'XYLEO2_NO_vbs ', 'het1 ', & 'het10 ', 'het11 ', & 'het12 ', 'het13 ', & 'het14 ', 'het15 ', & @@ -642,7 +657,8 @@ subroutine set_sim_dat 551, 552, 553, 554, 555, 556, 557, 558, 559, 560, & 561, 562, 563, 564, 565, 566, 567, 568, 569, 570, & 571, 572, 573, 574, 575, 576, 577, 578, 579, 580, & - 581, 582, 583 /) + 581, 582, 583, 584, 585, 586, 587, 588, 589, 590, & + 591, 592, 593, 594, 595, 596, 597 /) if( allocated( pht_alias_lst ) ) then deallocate( pht_alias_lst ) end if @@ -810,10 +826,10 @@ subroutine set_sim_dat 167, 168, 169, 172, 175, & 176, 177, 178, 181, 182, & 183, 186, 188, 189, 190, & - 194, 195, 203, 204, 565, & - 566, 567, 568, 569, 571, & - 572, 573, 574, 576, 578, & - 579 /) + 194, 195, 203, 204, 579, & + 580, 581, 582, 583, 585, & + 586, 587, 588, 590, 592, & + 593 /) cph_enthalpy(:) = (/ 189.810000_r8, 32.910000_r8, 189.810000_r8, 94.300000_r8, 94.300000_r8, & 94.300000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, & 392.190000_r8, 493.580000_r8, 101.390000_r8, 232.590000_r8, 203.400000_r8, & @@ -843,11 +859,11 @@ subroutine set_sim_dat 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, 3, 2, 2, 1, 2, & - 2, 2, 2, 2, 2, 3, 3, 3, 2, 2, & + 2, 2, 2, 2, 3, 2, 2, 1, 2, 2, & + 2, 2, 2, 2, 3, 3, 3, 2, 2, 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, 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, 2, 3, 2, 2, 2, 2, 2, & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & @@ -863,15 +879,16 @@ subroutine set_sim_dat 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, 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, 1, 1, 1, & 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, & - 2, 2, 2, 2, 2, 2, 2, 1, 2, 1, & - 1, 1, 1, 2, 2, 2, 1, 1, 2, 2, & - 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, & - 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & - 1, 1, 1 /) + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 1, 2, 1, 1, 1, 1, 2, 2, 2, & + 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 1, 1, 1, 1 /) end subroutine set_sim_dat diff --git a/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/chem_mech.doc b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/chem_mech.doc new file mode 100644 index 0000000000..775a4390bb --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/chem_mech.doc @@ -0,0 +1,2088 @@ + + + Solution species + ( 1) ALKNIT (C5H11ONO2) + ( 2) ALKOOH (C5H12O2) + ( 3) AOA_NH (CO) + ( 4) bc_a1 (C) + ( 5) bc_a4 (C) + ( 6) BCARY (C15H24) + ( 7) BCARYO2VBS (C15H25O3) + ( 8) BENZENE (C6H6) + ( 9) BENZO2VBS (C6H7O5) + ( 10) BENZOOH (C6H8O5) + ( 11) BEPOMUC (C6H6O3) + ( 12) BIGALD (C5H6O2) + ( 13) BIGALD1 (C4H4O2) + ( 14) BIGALD2 (C5H6O2) + ( 15) BIGALD3 (C5H6O2) + ( 16) BIGALD4 (C6H8O2) + ( 17) BIGALK (C5H12) + ( 18) BIGENE (C4H8) + ( 19) BR (Br) + ( 20) BRCL (BrCl) + ( 21) BRO (BrO) + ( 22) BRONO2 (BrONO2) + ( 23) BRY + ( 24) BZALD (C7H6O) + ( 25) BZOOH (C7H8O2) + ( 26) C2H2 + ( 27) C2H4 + ( 28) C2H5OH + ( 29) C2H5OOH + ( 30) C2H6 + ( 31) C3H6 + ( 32) C3H7OOH + ( 33) C3H8 + ( 34) C6H5OOH (C6H5OOH) + ( 35) CCL4 (CCl4) + ( 36) CF2CLBR (CF2ClBr) + ( 37) CF3BR (CF3Br) + ( 38) CFC11 (CFCl3) + ( 39) CFC113 (CCl2FCClF2) + ( 40) CFC114 (CClF2CClF2) + ( 41) CFC115 (CClF2CF3) + ( 42) CFC12 (CF2Cl2) + ( 43) CH2BR2 (CH2Br2) + ( 44) CH2O + ( 45) CH3BR (CH3Br) + ( 46) CH3CCL3 (CH3CCl3) + ( 47) CH3CHO + ( 48) CH3CL (CH3Cl) + ( 49) CH3CN + ( 50) CH3COCH3 + ( 51) CH3COCHO + ( 52) CH3COOH + ( 53) CH3COOOH + ( 54) CH3OH + ( 55) CH3OOH + ( 56) CH4 + ( 57) CHBR3 (CHBr3) + ( 58) CL (Cl) + ( 59) CL2 (Cl2) + ( 60) CL2O2 (Cl2O2) + ( 61) CLO (ClO) + ( 62) CLONO2 (ClONO2) + ( 63) CLY + ( 64) CO + ( 65) CO2 + ( 66) COF2 + ( 67) COFCL (COFCl) + ( 68) CRESOL (C7H8O) + ( 69) DMS (CH3SCH3) + ( 70) dst_a1 (AlSiO5) + ( 71) dst_a2 (AlSiO5) + ( 72) dst_a3 (AlSiO5) + ( 73) E90 (CO) + ( 74) EOOH (HOCH2CH2OOH) + ( 75) F + ( 76) GLYALD (HOCH2CHO) + ( 77) GLYOXAL (C2H2O2) + ( 78) H + ( 79) H2 + ( 80) H2402 (CBrF2CBrF2) + ( 81) H2O2 + ( 82) H2SO4 (H2SO4) + ( 83) HBR (HBr) + ( 84) HCFC141B (CH3CCl2F) + ( 85) HCFC142B (CH3CClF2) + ( 86) HCFC22 (CHF2Cl) + ( 87) HCL (HCl) + ( 88) HCN + ( 89) HCOOH + ( 90) HF + ( 91) HNO3 + ( 92) HO2NO2 + ( 93) HOBR (HOBr) + ( 94) HOCL (HOCl) + ( 95) HONITR (C4H9NO4) + ( 96) HPALD (HOOCH2CCH3CHCHO) + ( 97) HYAC (CH3COCH2OH) + ( 98) HYDRALD (HOCH2CCH3CHCHO) + ( 99) IEPOX (C5H10O3) + (100) ISOP (C5H8) + (101) ISOPNITA (C5H9NO4) + (102) ISOPNITB (C5H9NO4) + (103) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + (104) ISOPNOOH (C5H9NO5) + (105) ISOPO2VBS (C5H9O3) + (106) ISOPOOH (HOCH2COOHCH3CHCH2) + (107) IVOCbb (C13H28) + (108) IVOCbbO2VBS (C13H29O3) + (109) IVOCff (C13H28) + (110) IVOCffO2VBS (C13H29O3) + (111) MACR (CH2CCH3CHO) + (112) MACROOH (CH3COCHOOHCH2OH) + (113) MEK (C4H8O) + (114) MEKOOH (C4H8O3) + (115) MPAN (CH2CCH3CO3NO2) + (116) MTERP (C10H16) + (117) MTERPO2VBS (C10H17O3) + (118) MVK (CH2CHCOCH3) + (119) N + (120) N2O + (121) N2O5 + (122) NC4CH2OH (C5H9NO4) + (123) NC4CHO (C5H7NO4) + (124) ncl_a1 (NaCl) + (125) ncl_a2 (NaCl) + (126) ncl_a3 (NaCl) + (127) NH3 + (128) NH4 + (129) NH_5 (CO) + (130) NH_50 (CO) + (131) NO + (132) NO2 + (133) NO3 + (134) NOA (CH3COCH2ONO2) + (135) NTERPOOH (C10H17NO5) + (136) num_a1 (H) + (137) num_a2 (H) + (138) num_a3 (H) + (139) num_a4 (H) + (140) O + (141) O2 + (142) O3 + (143) O3S (O3) + (144) OCLO (OClO) + (145) OCS (OCS) + (146) ONITR (C4H7NO4) + (147) PAN (CH3CO3NO2) + (148) PBZNIT (C7H5O3NO2) + (149) PHENO (C6H5O) + (150) PHENOL (C6H5OH) + (151) PHENOOH (C6H8O6) + (152) pombb1_a1 (C) + (153) pombb1_a4 (C) + (154) pomff1_a1 (C) + (155) pomff1_a4 (C) + (156) POOH (C3H6OHOOH) + (157) ROOH (CH3COCH2OOH) + (158) S (S) + (159) SF6 + (160) SO (SO) + (161) SO2 + (162) SO3 (SO3) + (163) so4_a1 (NH4HSO4) + (164) so4_a2 (NH4HSO4) + (165) so4_a3 (NH4HSO4) + (166) soabb1_a1 (C15H38O2) + (167) soabb1_a2 (C15H38O2) + (168) soabb2_a1 (C15H38O2) + (169) soabb2_a2 (C15H38O2) + (170) soabb3_a1 (C15H38O2) + (171) soabb3_a2 (C15H38O2) + (172) soabb4_a1 (C15H38O2) + (173) soabb4_a2 (C15H38O2) + (174) soabb5_a1 (C15H38O2) + (175) soabb5_a2 (C15H38O2) + (176) soabg1_a1 (C15H38O2) + (177) soabg1_a2 (C15H38O2) + (178) soabg2_a1 (C15H38O2) + (179) soabg2_a2 (C15H38O2) + (180) soabg3_a1 (C15H38O2) + (181) soabg3_a2 (C15H38O2) + (182) soabg4_a1 (C15H38O2) + (183) soabg4_a2 (C15H38O2) + (184) soabg5_a1 (C15H38O2) + (185) soabg5_a2 (C15H38O2) + (186) soaff1_a1 (C15H38O2) + (187) soaff1_a2 (C15H38O2) + (188) soaff2_a1 (C15H38O2) + (189) soaff2_a2 (C15H38O2) + (190) soaff3_a1 (C15H38O2) + (191) soaff3_a2 (C15H38O2) + (192) soaff4_a1 (C15H38O2) + (193) soaff4_a2 (C15H38O2) + (194) soaff5_a1 (C15H38O2) + (195) soaff5_a2 (C15H38O2) + (196) SOAGbb0 (C15H38O2) + (197) SOAGbb1 (C15H38O2) + (198) SOAGbb2 (C15H38O2) + (199) SOAGbb3 (C15H38O2) + (200) SOAGbb4 (C15H38O2) + (201) SOAGbg0 (C15H38O2) + (202) SOAGbg1 (C15H38O2) + (203) SOAGbg2 (C15H38O2) + (204) SOAGbg3 (C15H38O2) + (205) SOAGbg4 (C15H38O2) + (206) SOAGff0 (C15H38O2) + (207) SOAGff1 (C15H38O2) + (208) SOAGff2 (C15H38O2) + (209) SOAGff3 (C15H38O2) + (210) SOAGff4 (C15H38O2) + (211) ST80_25 (CO) + (212) SVOCbb (C22H46) + (213) SVOCff (C22H46) + (214) TEPOMUC (C7H8O3) + (215) TERP2OOH (C10H16O4) + (216) TERPNIT (C10H17NO4) + (217) TERPOOH (C10H18O3) + (218) TERPROD1 (C10H16O2) + (219) TERPROD2 (C9H14O2) + (220) TOLOOH (C7H10O5) + (221) TOLUENE (C7H8) + (222) TOLUO2VBS (C7H9O5) + (223) XOOH (HOCH2COOHCH3CHOHCHO) + (224) XYLENES (C8H10) + (225) XYLENOOH (C8H12O5) + (226) XYLEO2VBS (C8H11O5) + (227) XYLOL (C8H10O) + (228) XYLOLOOH (C8H12O6) + (229) NHDEP (N) + (230) NDEP (N) + (231) ACBZO2 (C7H5O3) + (232) ALKO2 (C5H11O2) + (233) BENZO2 (C6H7O5) + (234) BZOO (C7H7O2) + (235) C2H5O2 + (236) C3H7O2 + (237) C6H5O2 + (238) CH3CO3 + (239) CH3O2 + (240) DICARBO2 (C5H5O4) + (241) e (E) + (242) ENEO2 (C4H9O3) + (243) EO (HOCH2CH2O) + (244) EO2 (HOCH2CH2O2) + (245) HO2 + (246) HOCH2OO + (247) ISOPAO2 (HOC5H8O2) + (248) ISOPBO2 (HOC5H8O2) + (249) MACRO2 (CH3COCHO2CH2OH) + (250) MALO2 (C4H3O4) + (251) MCO3 (CH2CCH3CO3) + (252) MDIALO2 (C4H5O4) + (253) MEKO2 (C4H7O3) + (254) N2D (N) + (255) N2p (N2) + (256) NOp (NO) + (257) Np (N) + (258) NTERPO2 (C10H16NO5) + (259) O1D (O) + (260) O2_1D (O2) + (261) O2_1S (O2) + (262) O2p (O2) + (263) OH + (264) Op (O) + (265) PHENO2 (C6H7O6) + (266) PO2 (C3H6OHO2) + (267) RO2 (CH3COCH2O2) + (268) TERP2O2 (C10H15O4) + (269) TERPO2 (C10H17O3) + (270) TOLO2 (C7H9O5) + (271) XO2 (HOCH2COOCH3CHOHCHO) + (272) XYLENO2 (C8H11O5) + (273) XYLOLO2 (C8H11O6) + (274) H2O + + + Invariant species + ( 1) M + ( 2) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) NHDEP + ( 2) NDEP + + Implicit + -------- + ( 1) ALKNIT + ( 2) ALKOOH + ( 3) AOA_NH + ( 4) bc_a1 + ( 5) bc_a4 + ( 6) BCARY + ( 7) BCARYO2VBS + ( 8) BENZENE + ( 9) BENZO2VBS + ( 10) BENZOOH + ( 11) BEPOMUC + ( 12) BIGALD + ( 13) BIGALD1 + ( 14) BIGALD2 + ( 15) BIGALD3 + ( 16) BIGALD4 + ( 17) BIGALK + ( 18) BIGENE + ( 19) BR + ( 20) BRCL + ( 21) BRO + ( 22) BRONO2 + ( 23) BRY + ( 24) BZALD + ( 25) BZOOH + ( 26) C2H2 + ( 27) C2H4 + ( 28) C2H5OH + ( 29) C2H5OOH + ( 30) C2H6 + ( 31) C3H6 + ( 32) C3H7OOH + ( 33) C3H8 + ( 34) C6H5OOH + ( 35) CCL4 + ( 36) CF2CLBR + ( 37) CF3BR + ( 38) CFC11 + ( 39) CFC113 + ( 40) CFC114 + ( 41) CFC115 + ( 42) CFC12 + ( 43) CH2BR2 + ( 44) CH2O + ( 45) CH3BR + ( 46) CH3CCL3 + ( 47) CH3CHO + ( 48) CH3CL + ( 49) CH3CN + ( 50) CH3COCH3 + ( 51) CH3COCHO + ( 52) CH3COOH + ( 53) CH3COOOH + ( 54) CH3OH + ( 55) CH3OOH + ( 56) CH4 + ( 57) CHBR3 + ( 58) CL + ( 59) CL2 + ( 60) CL2O2 + ( 61) CLO + ( 62) CLONO2 + ( 63) CLY + ( 64) CO + ( 65) CO2 + ( 66) COF2 + ( 67) COFCL + ( 68) CRESOL + ( 69) DMS + ( 70) dst_a1 + ( 71) dst_a2 + ( 72) dst_a3 + ( 73) E90 + ( 74) EOOH + ( 75) F + ( 76) GLYALD + ( 77) GLYOXAL + ( 78) H + ( 79) H2 + ( 80) H2402 + ( 81) H2O2 + ( 82) H2SO4 + ( 83) HBR + ( 84) HCFC141B + ( 85) HCFC142B + ( 86) HCFC22 + ( 87) HCL + ( 88) HCN + ( 89) HCOOH + ( 90) HF + ( 91) HNO3 + ( 92) HO2NO2 + ( 93) HOBR + ( 94) HOCL + ( 95) HONITR + ( 96) HPALD + ( 97) HYAC + ( 98) HYDRALD + ( 99) IEPOX + (100) ISOP + (101) ISOPNITA + (102) ISOPNITB + (103) ISOPNO3 + (104) ISOPNOOH + (105) ISOPO2VBS + (106) ISOPOOH + (107) IVOCbb + (108) IVOCbbO2VBS + (109) IVOCff + (110) IVOCffO2VBS + (111) MACR + (112) MACROOH + (113) MEK + (114) MEKOOH + (115) MPAN + (116) MTERP + (117) MTERPO2VBS + (118) MVK + (119) N + (120) N2O + (121) N2O5 + (122) NC4CH2OH + (123) NC4CHO + (124) ncl_a1 + (125) ncl_a2 + (126) ncl_a3 + (127) NH3 + (128) NH4 + (129) NH_5 + (130) NH_50 + (131) NO + (132) NO2 + (133) NO3 + (134) NOA + (135) NTERPOOH + (136) num_a1 + (137) num_a2 + (138) num_a3 + (139) num_a4 + (140) O + (141) O2 + (142) O3 + (143) O3S + (144) OCLO + (145) OCS + (146) ONITR + (147) PAN + (148) PBZNIT + (149) PHENO + (150) PHENOL + (151) PHENOOH + (152) pombb1_a1 + (153) pombb1_a4 + (154) pomff1_a1 + (155) pomff1_a4 + (156) POOH + (157) ROOH + (158) S + (159) SF6 + (160) SO + (161) SO2 + (162) SO3 + (163) so4_a1 + (164) so4_a2 + (165) so4_a3 + (166) soabb1_a1 + (167) soabb1_a2 + (168) soabb2_a1 + (169) soabb2_a2 + (170) soabb3_a1 + (171) soabb3_a2 + (172) soabb4_a1 + (173) soabb4_a2 + (174) soabb5_a1 + (175) soabb5_a2 + (176) soabg1_a1 + (177) soabg1_a2 + (178) soabg2_a1 + (179) soabg2_a2 + (180) soabg3_a1 + (181) soabg3_a2 + (182) soabg4_a1 + (183) soabg4_a2 + (184) soabg5_a1 + (185) soabg5_a2 + (186) soaff1_a1 + (187) soaff1_a2 + (188) soaff2_a1 + (189) soaff2_a2 + (190) soaff3_a1 + (191) soaff3_a2 + (192) soaff4_a1 + (193) soaff4_a2 + (194) soaff5_a1 + (195) soaff5_a2 + (196) SOAGbb0 + (197) SOAGbb1 + (198) SOAGbb2 + (199) SOAGbb3 + (200) SOAGbb4 + (201) SOAGbg0 + (202) SOAGbg1 + (203) SOAGbg2 + (204) SOAGbg3 + (205) SOAGbg4 + (206) SOAGff0 + (207) SOAGff1 + (208) SOAGff2 + (209) SOAGff3 + (210) SOAGff4 + (211) ST80_25 + (212) SVOCbb + (213) SVOCff + (214) TEPOMUC + (215) TERP2OOH + (216) TERPNIT + (217) TERPOOH + (218) TERPROD1 + (219) TERPROD2 + (220) TOLOOH + (221) TOLUENE + (222) TOLUO2VBS + (223) XOOH + (224) XYLENES + (225) XYLENOOH + (226) XYLEO2VBS + (227) XYLOL + (228) XYLOLOOH + (229) ACBZO2 + (230) ALKO2 + (231) BENZO2 + (232) BZOO + (233) C2H5O2 + (234) C3H7O2 + (235) C6H5O2 + (236) CH3CO3 + (237) CH3O2 + (238) DICARBO2 + (239) e + (240) ENEO2 + (241) EO + (242) EO2 + (243) HO2 + (244) HOCH2OO + (245) ISOPAO2 + (246) ISOPBO2 + (247) MACRO2 + (248) MALO2 + (249) MCO3 + (250) MDIALO2 + (251) MEKO2 + (252) N2D + (253) N2p + (254) NOp + (255) Np + (256) NTERPO2 + (257) O1D + (258) O2_1D + (259) O2_1S + (260) O2p + (261) OH + (262) Op + (263) PHENO2 + (264) PO2 + (265) RO2 + (266) TERP2O2 + (267) TERPO2 + (268) TOLO2 + (269) XO2 + (270) XYLENO2 + (271) XYLOLO2 + (272) H2O + + Photolysis + jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) + jh2o_c ( 2) H2O + hv -> 2*H + O rate = ** User defined ** ( 2) + jh2o_a ( 3) H2O + hv -> OH + H rate = ** User defined ** ( 3) + jh2o2 ( 4) H2O2 + hv -> 2*OH rate = ** User defined ** ( 4) + jo2_b ( 5) O2 + hv -> 2*O rate = ** User defined ** ( 5) + jo2_a ( 6) O2 + hv -> O + O1D rate = ** User defined ** ( 6) + jo3_a ( 7) O3 + hv -> O1D + O2_1D 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) + jno_i ( 16) NO + hv -> NOp + e rate = ** User defined ** ( 16) + jno2 ( 17) NO2 + hv -> NO + O rate = ** User defined ** ( 17) + jno3_a ( 18) NO3 + hv -> NO2 + O rate = ** User defined ** ( 18) + jno3_b ( 19) NO3 + hv -> NO + O2 rate = ** User defined ** ( 19) + jalknit ( 20) ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 rate = ** User defined ** ( 20) + + 0.8*MEK + jalkooh ( 21) ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 rate = ** User defined ** ( 21) + + 0.8*MEK + OH + jbenzooh ( 22) BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 rate = ** User defined ** ( 22) + jbepomuc ( 23) BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO rate = ** User defined ** ( 23) + jbigald ( 24) BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 rate = ** User defined ** ( 24) + + 0.18*CH3COCHO + jbigald1 ( 25) BIGALD1 + hv -> 0.6*MALO2 + HO2 rate = ** User defined ** ( 25) + jbigald2 ( 26) BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 rate = ** User defined ** ( 26) + jbigald3 ( 27) BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 rate = ** User defined ** ( 27) + jbigald4 ( 28) BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 rate = ** User defined ** ( 28) + jbzooh ( 29) BZOOH + hv -> BZALD + OH + HO2 rate = ** User defined ** ( 29) + jc2h5ooh ( 30) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 30) + jc3h7ooh ( 31) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 31) + jc6h5ooh ( 32) C6H5OOH + hv -> PHENO + OH rate = ** User defined ** ( 32) + jch2o_b ( 33) CH2O + hv -> CO + H2 rate = ** User defined ** ( 33) + jch2o_a ( 34) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 34) + jch3cho ( 35) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 35) + jacet ( 36) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 36) + jmgly ( 37) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 37) + jch3co3h ( 38) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 38) + jch3ooh ( 39) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 39) + jch4_b ( 40) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 40) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jch4_a ( 41) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 41) + jco2 ( 42) CO2 + hv -> CO + O rate = ** User defined ** ( 42) + jeooh ( 43) EOOH + hv -> EO + OH rate = ** User defined ** ( 43) + jglyald ( 44) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 44) + jglyoxal ( 45) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 45) + jhonitr ( 46) HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO rate = ** User defined ** ( 46) + + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + + 0.17*CH3COCH3 + jhpald ( 47) HPALD + hv -> BIGALD3 + OH + HO2 rate = ** User defined ** ( 47) + jhyac ( 48) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 48) + jisopnooh ( 49) ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH rate = ** User defined ** ( 49) + jisopooh ( 50) ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + CH2O + HO2 rate = ** User defined ** ( 50) + jmacr_a ( 51) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 51) + jmacr_b ( 52) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 52) + jmek ( 53) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 53) + jmekooh ( 54) MEKOOH + hv -> OH + CH3CO3 + CH3CHO rate = ** User defined ** ( 54) + jmpan ( 55) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 55) + jmvk ( 56) MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 rate = ** User defined ** ( 56) + jnc4cho ( 57) NC4CHO + hv -> BIGALD3 + NO2 + HO2 rate = ** User defined ** ( 57) + jnoa ( 58) NOA + hv -> NO2 + CH2O + CH3CO3 rate = ** User defined ** ( 58) + jnterpooh ( 59) NTERPOOH + hv -> TERPROD1 + NO2 + OH rate = ** User defined ** ( 59) + jonitr ( 60) ONITR + hv -> NO2 rate = ** User defined ** ( 60) + jpan ( 61) PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 rate = ** User defined ** ( 61) + jphenooh ( 62) PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL rate = ** User defined ** ( 62) + jpooh ( 63) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 63) + jrooh ( 64) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 64) + jtepomuc ( 65) TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO rate = ** User defined ** ( 65) + jterp2ooh ( 66) TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 rate = ** User defined ** ( 66) + + TERPROD2 + HO2 + 0.25*GLYALD + jterpnit ( 67) TERPNIT + hv -> TERPROD1 + NO2 + HO2 rate = ** User defined ** ( 67) + jterpooh ( 68) TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH rate = ** User defined ** ( 68) + jterprd1 ( 69) TERPROD1 + hv -> HO2 + CO + TERPROD2 rate = ** User defined ** ( 69) + jterprd2 ( 70) TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 rate = ** User defined ** ( 70) + + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO + jtolooh ( 71) TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = ** User defined ** ( 71) + + 0.2*BIGALD2 + 0.2*BIGALD3 + jxooh ( 72) XOOH + hv -> OH rate = ** User defined ** ( 72) + jxylenooh ( 73) XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = ** User defined ** ( 73) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + jxylolooh ( 74) XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 rate = ** User defined ** ( 74) + jbrcl ( 75) BRCL + hv -> BR + CL rate = ** User defined ** ( 75) + jbro ( 76) BRO + hv -> BR + O rate = ** User defined ** ( 76) + jbrono2_b ( 77) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 77) + jbrono2_a ( 78) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 78) + jccl4 ( 79) CCL4 + hv -> 4*CL rate = ** User defined ** ( 79) + jcf2clbr ( 80) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 80) + jcf3br ( 81) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 81) + jcfcl3 ( 82) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 82) + jcfc113 ( 83) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 83) + jcfc114 ( 84) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 84) + jcfc115 ( 85) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 85) + jcf2cl2 ( 86) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 86) + jch2br2 ( 87) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 87) + jch3br ( 88) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 88) + jch3ccl3 ( 89) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 89) + jch3cl ( 90) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 90) + jchbr3 ( 91) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 91) + jcl2 ( 92) CL2 + hv -> 2*CL rate = ** User defined ** ( 92) + jcl2o2 ( 93) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 93) + jclo ( 94) CLO + hv -> CL + O rate = ** User defined ** ( 94) + jclono2_a ( 95) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 95) + jclono2_b ( 96) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 96) + jcof2 ( 97) COF2 + hv -> 2*F rate = ** User defined ** ( 97) + jcofcl ( 98) COFCL + hv -> F + CL rate = ** User defined ** ( 98) + jh2402 ( 99) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 99) + jhbr (100) HBR + hv -> BR + H rate = ** User defined ** (100) + jhcfc141b (101) HCFC141B + hv -> CL + COFCL rate = ** User defined ** (101) + jhcfc142b (102) HCFC142B + hv -> CL + COF2 rate = ** User defined ** (102) + jhcfc22 (103) HCFC22 + hv -> CL + COF2 rate = ** User defined ** (103) + jhcl (104) HCL + hv -> H + CL rate = ** User defined ** (104) + jhf (105) HF + hv -> H + F rate = ** User defined ** (105) + jhobr (106) HOBR + hv -> BR + OH rate = ** User defined ** (106) + jhocl (107) HOCL + hv -> OH + CL rate = ** User defined ** (107) + joclo (108) OCLO + hv -> O + CLO rate = ** User defined ** (108) + jsf6 (109) SF6 + hv -> {sink} rate = ** User defined ** (109) + jeuv_26 (110) CO2 + hv -> CO + O rate = ** User defined ** (110) + jeuv_4 (111) N + hv -> Np + e rate = ** User defined ** (111) + jeuv_13 (112) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** (112) + jeuv_11 (113) N2 + hv -> N2D + Np + e rate = ** User defined ** (113) + jeuv_6 (114) N2 + hv -> N2p + e rate = ** User defined ** (114) + jeuv_10 (115) N2 + hv -> N + Np + e rate = ** User defined ** (115) + jeuv_22 (116) N2 + hv -> N + Np + e rate = ** User defined ** (116) + jeuv_23 (117) N2 + hv -> N2D + Np + e rate = ** User defined ** (117) + jeuv_25 (118) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** (118) + jeuv_18 (119) N2 + hv -> N2p + e rate = ** User defined ** (119) + jeuv_2 (120) O + hv -> Op + e rate = ** User defined ** (120) + jeuv_1 (121) O + hv -> Op + e rate = ** User defined ** (121) + jeuv_16 (122) O + hv -> Op + e rate = ** User defined ** (122) + jeuv_15 (123) O + hv -> Op + e rate = ** User defined ** (123) + jeuv_14 (124) O + hv -> Op + e rate = ** User defined ** (124) + jeuv_3 (125) O + hv -> Op + e rate = ** User defined ** (125) + jeuv_17 (126) O2 + hv -> O2p + e rate = ** User defined ** (126) + jeuv_9 (127) O2 + hv -> O + Op + e rate = ** User defined ** (127) + jeuv_8 (128) O2 + hv -> O + Op + e rate = ** User defined ** (128) + jeuv_7 (129) O2 + hv -> O + Op + e rate = ** User defined ** (129) + jeuv_5 (130) O2 + hv -> O2p + e rate = ** User defined ** (130) + jeuv_19 (131) O2 + hv -> O + Op + e rate = ** User defined ** (131) + jeuv_20 (132) O2 + hv -> O + Op + e rate = ** User defined ** (132) + jeuv_21 (133) O2 + hv -> O + Op + e rate = ** User defined ** (133) + jeuv_24 (134) O2 + hv -> 2*O rate = ** User defined ** (134) + jeuv_12 (135) O2 + hv -> 2*O rate = ** User defined ** (135) + jh2so4 (136) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** (136) + jocs (137) OCS + hv -> S + CO rate = ** User defined ** (137) + jso (138) SO + hv -> S + O rate = ** User defined ** (138) + jso2 (139) SO2 + hv -> SO + O rate = ** User defined ** (139) + jso3 (140) SO3 + hv -> SO2 + O rate = ** User defined ** (140) + jsoabb1_a1 (141) soabb1_a1 + hv -> (No products) rate = ** User defined ** (141) + jsoabb1_a2 (142) soabb1_a2 + hv -> (No products) rate = ** User defined ** (142) + jsoabb2_a1 (143) soabb2_a1 + hv -> (No products) rate = ** User defined ** (143) + jsoabb2_a2 (144) soabb2_a2 + hv -> (No products) rate = ** User defined ** (144) + jsoabb3_a1 (145) soabb3_a1 + hv -> (No products) rate = ** User defined ** (145) + jsoabb3_a2 (146) soabb3_a2 + hv -> (No products) rate = ** User defined ** (146) + jsoabb4_a1 (147) soabb4_a1 + hv -> (No products) rate = ** User defined ** (147) + jsoabb4_a2 (148) soabb4_a2 + hv -> (No products) rate = ** User defined ** (148) + jsoabb5_a1 (149) soabb5_a1 + hv -> (No products) rate = ** User defined ** (149) + jsoabb5_a2 (150) soabb5_a2 + hv -> (No products) rate = ** User defined ** (150) + jsoabg1_a1 (151) soabg1_a1 + hv -> (No products) rate = ** User defined ** (151) + jsoabg1_a2 (152) soabg1_a2 + hv -> (No products) rate = ** User defined ** (152) + jsoabg2_a1 (153) soabg2_a1 + hv -> (No products) rate = ** User defined ** (153) + jsoabg2_a2 (154) soabg2_a2 + hv -> (No products) rate = ** User defined ** (154) + jsoabg3_a1 (155) soabg3_a1 + hv -> (No products) rate = ** User defined ** (155) + jsoabg3_a2 (156) soabg3_a2 + hv -> (No products) rate = ** User defined ** (156) + jsoabg4_a1 (157) soabg4_a1 + hv -> (No products) rate = ** User defined ** (157) + jsoabg4_a2 (158) soabg4_a2 + hv -> (No products) rate = ** User defined ** (158) + jsoabg5_a1 (159) soabg5_a1 + hv -> (No products) rate = ** User defined ** (159) + jsoabg5_a2 (160) soabg5_a2 + hv -> (No products) rate = ** User defined ** (160) + jsoaff1_a1 (161) soaff1_a1 + hv -> (No products) rate = ** User defined ** (161) + jsoaff1_a2 (162) soaff1_a2 + hv -> (No products) rate = ** User defined ** (162) + jsoaff2_a1 (163) soaff2_a1 + hv -> (No products) rate = ** User defined ** (163) + jsoaff2_a2 (164) soaff2_a2 + hv -> (No products) rate = ** User defined ** (164) + jsoaff3_a1 (165) soaff3_a1 + hv -> (No products) rate = ** User defined ** (165) + jsoaff3_a2 (166) soaff3_a2 + hv -> (No products) rate = ** User defined ** (166) + jsoaff4_a1 (167) soaff4_a1 + hv -> (No products) rate = ** User defined ** (167) + jsoaff4_a2 (168) soaff4_a2 + hv -> (No products) rate = ** User defined ** (168) + jsoaff5_a1 (169) soaff5_a1 + hv -> (No products) rate = ** User defined ** (169) + jsoaff5_a2 (170) soaff5_a2 + hv -> (No products) rate = ** User defined ** (170) + + Reactions + ag1 ( 1) O2_1D -> O2 rate = 2.58E-04 (171) + ag2 ( 2) O2_1S -> O2 rate = 8.50E-02 (172) + O1D_H2 ( 3) O1D + H2 -> H + OH rate = 1.20E-10 (173) + O1D_H2O ( 4) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (174) + O1D_N2 ( 5) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (175) + O1D_O2 ( 6) O1D + O2 -> O + O2_1S rate = 2.64E-11*exp( 55./t) (176) + O1D_O2b ( 7) O1D + O2 -> O + O2 rate = 6.60E-12*exp( 55./t) (177) + O1D_O3 ( 8) O1D + O3 -> O2 + O2 rate = 1.20E-10 (178) + O2_1D_N2 ( 9) O2_1D + N2 -> O2 + N2 rate = 1.00E-20 (179) + O2_1D_O ( 10) O2_1D + O -> O2 + O rate = 1.30E-16 (180) + O2_1D_O2 ( 11) O2_1D + O2 -> 2*O2 rate = 3.60E-18*exp( -220./t) (181) + O2_1S_CO2 ( 12) O2_1S + CO2 -> O2_1D + CO2 rate = 4.20E-13 (182) + O2_1S_N2 ( 13) O2_1S + N2 -> O2_1D + N2 rate = 1.80E-15*exp( 45./t) (183) + O2_1S_O ( 14) O2_1S + O -> O2_1D + O rate = 8.00E-14 (184) + O2_1S_O2 ( 15) O2_1S + O2 -> O2_1D + O2 rate = 3.90E-17 (185) + O2_1S_O3 ( 16) O2_1S + O3 -> O2_1D + O3 rate = 3.50E-11*exp( -135./t) (186) + O_O3 ( 17) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (187) + usr_O_O ( 18) O + O + M -> O2 + M rate = ** User defined ** (188) + usr_O_O2 ( 19) O + O2 + M -> O3 + M rate = ** User defined ** (189) + H2_O ( 20) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (190) + H2O2_O ( 21) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (191) + H_HO2 ( 22) H + HO2 -> H2 + O2 rate = 6.90E-12 (192) + H_HO2a ( 23) H + HO2 -> 2*OH rate = 7.20E-11 (193) + H_HO2b ( 24) H + HO2 -> H2O + O rate = 1.60E-12 (194) + H_O2 ( 25) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (195) + ki=9.50E-11*(300/t)**-0.40 + f=0.60 + HO2_O ( 26) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (196) + HO2_O3 ( 27) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (197) + H_O3 ( 28) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (198) + OH_H2 ( 29) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (199) + OH_H2O2 ( 30) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (200) + OH_HO2 ( 31) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (201) + OH_O ( 32) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (202) + OH_O3 ( 33) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (203) + OH_OH ( 34) OH + OH -> H2O + O rate = 1.80E-12 (204) + OH_OH_M ( 35) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (205) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 ( 36) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (206) + HO2NO2_OH ( 37) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (207) + N2D_O ( 38) N2D + O -> N + O rate = 7.00E-13 (208) + N2D_O2 ( 39) N2D + O2 -> NO + O1D rate = 5.00E-12 (209) + N_NO ( 40) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (210) + N_NO2a ( 41) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (211) + N_NO2b ( 42) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (212) + N_NO2c ( 43) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (213) + N_O2 ( 44) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (214) + NO2_O ( 45) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (215) + NO2_O3 ( 46) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (216) + NO2_O_M ( 47) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (217) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 ( 48) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (218) + NO3_NO ( 49) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (219) + NO3_O ( 50) NO3 + O -> NO2 + O2 rate = 1.30E-11 (220) + NO3_OH ( 51) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (221) + N_OH ( 52) N + OH -> NO + H rate = 5.00E-11 (222) + NO_HO2 ( 53) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (223) + NO_O3 ( 54) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (224) + NO_O_M ( 55) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (225) + ki=3.00E-11 + f=0.60 + O1D_N2Oa ( 56) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (226) + O1D_N2Ob ( 57) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (227) + tag_NO2_HO2 ( 58) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (228) + ki=4.00E-12*(300/t)**0.30 + f=0.60 + tag_NO2_NO3 ( 59) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (229) + ki=1.60E-12*(300/t)**-0.10 + f=0.60 + tag_NO2_OH ( 60) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (230) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 61) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (231) + usr_HO2NO2_M ( 62) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (232) + usr_N2O5_M ( 63) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (233) + CL_CH2O ( 64) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (234) + CL_CH4 ( 65) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (235) + CL_H2 ( 66) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (236) + CL_H2O2 ( 67) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (237) + CL_HO2a ( 68) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (238) + CL_HO2b ( 69) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (239) + CL_O3 ( 70) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (240) + CLO_CH3O2 ( 71) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (241) + CLO_CLOa ( 72) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (242) + CLO_CLOb ( 73) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (243) + CLO_CLOc ( 74) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (244) + CLO_HO2 ( 75) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (245) + CLO_NO ( 76) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (246) + CLONO2_CL ( 77) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (247) + CLO_NO2_M ( 78) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (248) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLONO2_O ( 79) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (249) + CLONO2_OH ( 80) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (250) + CLO_O ( 81) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (251) + CLO_OHa ( 82) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (252) + CLO_OHb ( 83) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (253) + HCL_O ( 84) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (254) + HCL_OH ( 85) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (255) + HOCL_CL ( 86) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (256) + HOCL_O ( 87) HOCL + O -> CLO + OH rate = 1.70E-13 (257) + HOCL_OH ( 88) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (258) + O1D_CCL4 ( 89) O1D + CCL4 -> 4*CL rate = 2.61E-10 (259) + O1D_CF2CLBR ( 90) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (260) + O1D_CFC11 ( 91) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (261) + O1D_CFC113 ( 92) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (262) + O1D_CFC114 ( 93) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (263) + O1D_CFC115 ( 94) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (264) + O1D_CFC12 ( 95) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (265) + O1D_HCLa ( 96) O1D + HCL -> CL + OH rate = 9.90E-11 (266) + O1D_HCLb ( 97) O1D + HCL -> CLO + H rate = 3.30E-12 (267) + tag_CLO_CLO_M ( 98) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (268) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M ( 99) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (269) + BR_CH2O (100) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (270) + BR_HO2 (101) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (271) + BR_O3 (102) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (272) + BRO_BRO (103) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (273) + BRO_CLOa (104) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (274) + BRO_CLOb (105) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (275) + BRO_CLOc (106) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (276) + BRO_HO2 (107) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (277) + BRO_NO (108) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (278) + BRO_NO2_M (109) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (279) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRONO2_O (110) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (280) + BRO_O (111) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (281) + BRO_OH (112) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (282) + HBR_O (113) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (283) + HBR_OH (114) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (284) + HOBR_O (115) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (285) + O1D_CF3BR (116) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (286) + O1D_CHBR3 (117) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (287) + O1D_H2402 (118) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (288) + O1D_HBRa (119) O1D + HBR -> BR + OH rate = 9.00E-11 (289) + O1D_HBRb (120) O1D + HBR -> BRO + H rate = 3.00E-11 (290) + F_CH4 (121) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (291) + F_H2 (122) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (292) + F_H2O (123) F + H2O -> HF + OH rate = 1.40E-11 (293) + F_HNO3 (124) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (294) + O1D_COF2 (125) O1D + COF2 -> 2*F rate = 2.14E-11 (295) + O1D_COFCL (126) O1D + COFCL -> F + CL rate = 1.90E-10 (296) + CH2BR2_CL (127) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (297) + CH2BR2_OH (128) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (298) + CH3BR_CL (129) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (299) + CH3BR_OH (130) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (300) + CH3CCL3_OH (131) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (301) + CH3CL_CL (132) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (302) + CH3CL_OH (133) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (303) + CHBR3_CL (134) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (304) + CHBR3_OH (135) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (305) + HCFC141B_OH (136) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (306) + HCFC142B_OH (137) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (307) + HCFC22_OH (138) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (308) + O1D_CH2BR2 (139) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (309) + O1D_CH3BR (140) O1D + CH3BR -> BR rate = 1.80E-10 (310) + O1D_HCFC141B (141) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (311) + O1D_HCFC142B (142) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (312) + O1D_HCFC22 (143) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (313) + CH2O_HO2 (144) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) (314) + CH2O_NO3 (145) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (315) + CH2O_O (146) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (316) + CH2O_OH (147) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (317) + CH3O2_CH3O2a (148) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (318) + CH3O2_CH3O2b (149) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (319) + CH3O2_HO2 (150) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (320) + CH3O2_NO (151) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (321) + CH3OH_OH (152) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (322) + CH3OOH_OH (153) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (323) + CH4_OH (154) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (324) + HCN_OH (155) HCN + OH + M -> HO2 + M troe : ko=6.10E-33*(300/t)**1.50 (325) + ki=9.80E-15*(300/t)**-4.60 + f=0.80 + HCOOH_OH (156) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (326) + HOCH2OO_HO2 (157) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (327) + HOCH2OO_M (158) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (328) + HOCH2OO_NO (159) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (329) + O1D_CH4a (160) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (330) + O1D_CH4b (161) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (331) + O1D_CH4c (162) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (332) + O1D_HCN (163) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (333) + usr_CO_OH (164) CO + OH -> CO2 + HO2 rate = ** User defined ** (334) + C2H2_CL_M (165) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (335) + ki=2.20E-10*(300/t)**0.70 + f=0.60 + C2H2_OH_M (166) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (336) + + 0.35*CO + M ki=8.30E-13*(300/t)**-2.00 + f=0.60 + C2H4_CL_M (167) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (337) + ki=3.10E-10*(300/t) + f=0.60 + C2H4_O3 (168) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (338) + C2H5O2_C2H5O2 (169) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (339) + C2H5O2_CH3O2 (170) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (340) + + 0.2*C2H5OH + C2H5O2_HO2 (171) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (341) + C2H5O2_NO (172) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (342) + C2H5OH_OH (173) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (343) + C2H5OOH_OH (174) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (344) + C2H6_CL (175) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (345) + C2H6_OH (176) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (346) + CH3CHO_NO3 (177) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (347) + CH3CHO_OH (178) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (348) + CH3CN_OH (179) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (349) + CH3CO3_CH3CO3 (180) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (350) + CH3CO3_CH3O2 (181) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (351) + + 0.1*CH3COOH + CH3CO3_HO2 (182) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (352) + + 0.45*CH3O2 + CH3CO3_NO (183) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (353) + CH3COOH_OH (184) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 3.15E-14*exp( 920./t) (354) + CH3COOOH_OH (185) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (355) + EO2_HO2 (186) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (356) + EO2_NO (187) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (357) + EO_M (188) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (358) + EO_O2 (189) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (359) + GLYALD_OH (190) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (360) + GLYOXAL_OH (191) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (361) + PAN_OH (192) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (362) + tag_C2H4_OH (193) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (363) + ki=9.00E-12*(300/t)**0.85 + f=0.48 + tag_CH3CO3_NO2 (194) CH3CO3 + NO2 + M -> PAN + M troe : ko=7.30E-29*(300/t)**4.10 (364) + ki=9.50E-12*(300/t)**1.60 + f=0.60 + usr_PAN_M (195) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (365) + C3H6_NO3 (196) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (366) + C3H6_O3 (197) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (367) + + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + + 0.36*OH + C3H7O2_CH3O2 (198) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (368) + C3H7O2_HO2 (199) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (369) + C3H7O2_NO (200) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (370) + C3H7OOH_OH (201) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (371) + C3H8_OH (202) C3H8 + OH -> C3H7O2 + H2O rate = 9.19E-12*exp( -630./t) (372) + CH3COCHO_NO3 (203) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (373) + CH3COCHO_OH (204) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (374) + CL_C3H8 (205) CL + C3H8 -> C3H7O2 + HCL rate = 1.45E-10 (375) + HYAC_OH (206) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (376) + NOA_OH (207) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (377) + PO2_HO2 (208) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (378) + PO2_NO (209) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (379) + POOH_OH (210) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (380) + RO2_CH3O2 (211) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (381) + + 0.5*CH3COCHO + 0.5*CH3OH + RO2_HO2 (212) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (382) + RO2_NO (213) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (383) + ROOH_OH (214) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (384) + tag_C3H6_OH (215) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (385) + ki=3.00E-11 + f=0.50 + usr_CH3COCH3_OH (216) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (386) + BIGENE_NO3 (217) BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 rate = 3.50E-13 (387) + BIGENE_OH (218) BIGENE + OH -> ENEO2 rate = 5.40E-11 (388) + ENEO2_NO (219) ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 rate = 4.80E-12*exp( 120./t) (389) + ENEO2_NOb (220) ENEO2 + NO -> HONITR rate = 5.10E-14*exp( 693./t) (390) + HONITR_OH (221) HONITR + OH -> ONITR + HO2 rate = 2.00E-12 (391) + MACRO2_CH3CO3 (222) MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 rate = 1.40E-11 (392) + + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + + 0.53*CH3CO3 + MACRO2_CH3O2 (223) MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO rate = 5.00E-13*exp( 400./t) (393) + + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + + 0.23*HYAC + MACRO2_HO2 (224) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (394) + MACRO2_NO3 (225) MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO rate = 2.40E-12 (395) + + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 + MACRO2_NOa (226) MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD rate = 2.70E-12*exp( 360./t) (396) + + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO + MACRO2_NOb (227) MACRO2 + NO -> HONITR rate = 1.30E-13*exp( 360./t) (397) + MACR_O3 (228) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (398) + + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 + MACR_OH (229) MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 rate = 9.60E-12*exp( 360./t) (399) + MACROOH_OH (230) MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 rate = 2.30E-11*exp( 200./t) (400) + MCO3_CH3CO3 (231) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (401) + MCO3_CH3O2 (232) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (402) + MCO3_HO2 (233) MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH rate = 4.30E-13*exp( 1040./t) (403) + + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 + MCO3_MCO3 (234) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (404) + MCO3_NO (235) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (405) + MCO3_NO3 (236) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (406) + MEKO2_HO2 (237) MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 rate = 7.50E-13*exp( 700./t) (407) + MEKO2_NO (238) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (408) + MEK_OH (239) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (409) + MEKOOH_OH (240) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (410) + MPAN_OH_M (241) 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 (411) + + M + 0.5*NDEP ki=3.00E-11 + f=0.50 + MVK_O3 (242) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (412) + + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH + MVK_OH (243) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (413) + tag_MCO3_NO2 (244) MCO3 + NO2 + M -> MPAN + M troe : ko=9.70E-29*(300/t)**5.60 (414) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + usr_MPAN_M (245) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (415) + ALKNIT_OH (246) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (416) + ALKO2_HO2 (247) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (417) + ALKO2_NO (248) ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK rate = 6.70E-12 (418) + + NO2 + ALKO2_NOb (249) ALKO2 + NO -> ALKNIT rate = 5.40E-14*exp( 870./t) (419) + ALKOOH_OH (250) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (420) + BIGALK_OH (251) BIGALK + OH -> ALKO2 rate = 3.50E-12 (421) + HPALD_OH (252) HPALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (422) + HYDRALD_OH (253) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (423) + IEPOX_OH (254) IEPOX + OH -> XO2 rate = 1.30E-11 (424) + ISOPAO2_CH3CO3 (255) ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 rate = 1.40E-11 (425) + ISOPAO2_CH3O2 (256) ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR rate = 5.00E-13*exp( 400./t) (426) + + 0.44*MVK + ISOPAO2_HO2 (257) ISOPAO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (427) + ISOPAO2_NO (258) ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK rate = 4.40E-12*exp( 180./t) (428) + + 0.92*CH2O + 0.92*HO2 + ISOPAO2_NO3 (259) ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 rate = 2.40E-12 (429) + ISOPBO2_CH3CO3 (260) ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 rate = 1.40E-11 (430) + ISOPBO2_CH3O2 (261) ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD rate = 5.00E-13*exp( 400./t) (431) + ISOPBO2_HO2 (262) ISOPBO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (432) + ISOPBO2_M (263) ISOPBO2 -> HPALD + HO2 rate = 1.60E+09*exp( -8300./t) (433) + ISOPBO2_NO (264) ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 rate = 4.40E-12*exp( 180./t) (434) + + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + + 0.05*HYAC + ISOPBO2_NO3 (265) ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL rate = 2.40E-12 (435) + + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC + ISOPNITA_OH (266) ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O rate = 4.00E-11 (436) + + 0.3*HONITR + 0.3*HO2 + ISOPNITB_OH (267) ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR rate = 4.00E-11 (437) + ISOP_NO3 (268) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (438) + ISOPNO3_CH3CO3 (269) ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 rate = 1.40E-11 (439) + ISOPNO3_CH3O2 (270) ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH rate = 5.00E-13*exp( 400./t) (440) + + 0.2*NC4CH2OH + ISOPNO3_HO2 (271) ISOPNO3 + HO2 -> ISOPNOOH rate = 8.00E-13*exp( 700./t) (441) + ISOPNO3_NO (272) ISOPNO3 + NO -> NC4CHO + NO2 + HO2 rate = 2.70E-12*exp( 360./t) (442) + ISOPNO3_NO3 (273) ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 rate = 2.40E-12 (443) + ISOPNOOH_OH (274) ISOPNOOH + OH -> NOA + HO2 rate = 4.00E-11 (444) + ISOP_O3 (275) ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH rate = 1.05E-14*exp( -2000./t) (445) + + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + + 0.05*CH3O2 + ISOP_OH (276) ISOP + OH -> 0.6*ISOPAO2 + 0.4*ISOPBO2 rate = 2.54E-11*exp( 410./t) (446) + ISOPOOH_OH (277) ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH rate = 1.52E-11*exp( 200./t) (447) + NC4CH2OH_OH (278) NC4CH2OH + OH -> GLYALD + NOA + HO2 rate = 7.00E-11 (448) + NC4CHO_OH (279) NC4CHO + OH -> GLYOXAL + NOA + HO2 rate = 1.00E-10 (449) + XO2_CH3CO3 (280) XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (450) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 + XO2_CH3O2 (281) XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO rate = 5.00E-13*exp( 400./t) (451) + + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD + XO2_HO2 (282) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (452) + XO2_NO (283) XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL rate = 2.70E-12*exp( 360./t) (453) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + XO2_NO3 (284) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (454) + + 0.25*CH3COCHO + 0.25*GLYALD + XOOH_OH (285) XOOH + OH -> 0.5*XO2 + 0.5*OH rate = 1.52E-12*exp( 200./t) (455) + ACBZO2_HO2 (286) ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH rate = 4.30E-13*exp( 1040./t) (456) + ACBZO2_NO (287) ACBZO2 + NO -> C6H5O2 + NO2 rate = 7.50E-12*exp( 290./t) (457) + BENZENE_OH (288) BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 rate = 2.30E-12*exp( -193./t) (458) + BENZO2_HO2 (289) BENZO2 + HO2 -> BENZOOH rate = 7.50E-13*exp( 700./t) (459) + BENZO2_NO (290) BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 rate = 2.60E-12*exp( 365./t) (460) + BENZOOH_OH (291) BENZOOH + OH -> BENZO2 rate = 3.80E-12*exp( 200./t) (461) + BZALD_OH (292) BZALD + OH -> ACBZO2 rate = 5.90E-12*exp( 225./t) (462) + BZOO_HO2 (293) BZOO + HO2 -> BZOOH rate = 7.50E-13*exp( 700./t) (463) + BZOOH_OH (294) BZOOH + OH -> BZOO rate = 3.80E-12*exp( 200./t) (464) + BZOO_NO (295) BZOO + NO -> BZALD + NO2 + HO2 rate = 2.60E-12*exp( 365./t) (465) + C6H5O2_HO2 (296) C6H5O2 + HO2 -> C6H5OOH rate = 7.50E-13*exp( 700./t) (466) + C6H5O2_NO (297) C6H5O2 + NO -> PHENO + NO2 rate = 2.60E-12*exp( 365./t) (467) + C6H5OOH_OH (298) C6H5OOH + OH -> C6H5O2 rate = 3.80E-12*exp( 200./t) (468) + CRESOL_OH (299) CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO rate = 4.70E-11 (469) + DICARBO2_HO2 (300) DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO rate = 4.30E-13*exp( 1040./t) (470) + + 0.33*CH3O2 + DICARBO2_NO (301) DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO rate = 7.50E-12*exp( 290./t) (471) + + 0.83*CH3O2 + DICARBO2_NO2 (302) DICARBO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (472) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MALO2_HO2 (303) MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO rate = 4.30E-13*exp( 1040./t) (473) + MALO2_NO (304) MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 rate = 7.50E-12*exp( 290./t) (474) + MALO2_NO2 (305) MALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (475) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MDIALO2_HO2 (306) MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO rate = 4.30E-13*exp( 1040./t) (476) + + 0.07*CH3O2 + 0.07*GLYOXAL + MDIALO2_NO (307) MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO rate = 7.50E-12*exp( 290./t) (477) + + 0.17*CH3O2 + 0.17*GLYOXAL + MDIALO2_NO2 (308) MDIALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (478) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + PHENO2_HO2 (309) PHENO2 + HO2 -> PHENOOH rate = 7.50E-13*exp( 700./t) (479) + PHENO2_NO (310) PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 rate = 2.60E-12*exp( 365./t) (480) + PHENOL_OH (311) PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO rate = 4.70E-13*exp( 1220./t) (481) + PHENO_NO2 (312) PHENO + NO2 -> NDEP rate = 2.10E-12 (482) + PHENO_O3 (313) PHENO + O3 -> C6H5O2 rate = 2.80E-13 (483) + PHENOOH_OH (314) PHENOOH + OH -> PHENO2 rate = 3.80E-12*exp( 200./t) (484) + tag_ACBZO2_NO2 (315) ACBZO2 + NO2 + M -> PBZNIT + M troe : ko=9.70E-29*(300/t)**5.60 (485) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + TOLO2_HO2 (316) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (486) + TOLO2_NO (317) TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = 2.60E-12*exp( 365./t) (487) + + 0.2*BIGALD2 + 0.2*BIGALD3 + TOLOOH_OH (318) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (488) + TOLUENE_OH (319) TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 rate = 1.70E-12*exp( 352./t) (489) + + 0.28*HO2 + usr_PBZNIT_M (320) PBZNIT + M -> ACBZO2 + NO2 + M rate = ** User defined ** (490) + XYLENES_OH (321) XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO rate = 1.70E-11 (491) + + 0.56*XYLENO2 + 0.38*HO2 + XYLENO2_HO2 (322) XYLENO2 + HO2 -> XYLENOOH rate = 7.50E-13*exp( 700./t) (492) + XYLENO2_NO (323) XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = 2.60E-12*exp( 365./t) (493) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + XYLENOOH_OH (324) XYLENOOH + OH -> XYLENO2 rate = 3.80E-12*exp( 200./t) (494) + XYLOLO2_HO2 (325) XYLOLO2 + HO2 -> XYLOLOOH rate = 7.50E-13*exp( 700./t) (495) + XYLOLO2_NO (326) XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO rate = 2.60E-12*exp( 365./t) (496) + XYLOL_OH (327) XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO rate = 8.40E-11 (497) + XYLOLOOH_OH (328) XYLOLOOH + OH -> XYLOLO2 rate = 3.80E-12*exp( 200./t) (498) + BCARY_NO3 (329) BCARY + NO3 -> NTERPO2 rate = 1.90E-11 (499) + BCARY_O3 (330) BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 1.20E-14 (500) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + BCARY_OH (331) BCARY + OH -> TERPO2 rate = 2.00E-10 (501) + MTERP_NO3 (332) MTERP + NO3 -> NTERPO2 rate = 1.20E-12*exp( 490./t) (502) + MTERP_O3 (333) MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 6.30E-16*exp( -580./t) (503) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + MTERP_OH (334) MTERP + OH -> TERPO2 rate = 1.20E-11*exp( 440./t) (504) + NTERPO2_CH3O2 (335) NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 rate = 2.00E-12*exp( 500./t) (505) + + 0.5*TERPROD1 + 0.5*NO2 + NTERPO2_HO2 (336) NTERPO2 + HO2 -> NTERPOOH rate = 7.50E-13*exp( 700./t) (506) + NTERPO2_NO (337) NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP rate = 4.20E-12*exp( 180./t) (507) + NTERPO2_NO3 (338) NTERPO2 + NO3 -> 2*NO2 + TERPROD1 rate = 2.40E-12 (508) + NTERPOOH_OH (339) NTERPOOH + OH -> NTERPO2 rate = 2.00E-11 (509) + TERP2O2_CH3O2 (340) TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (510) + + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + + 0.15*CH3COCH3 + TERP2O2_HO2 (341) TERP2O2 + HO2 -> TERP2OOH rate = 7.50E-13*exp( 700./t) (511) + TERP2O2_NO (342) TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 rate = 4.20E-12*exp( 180./t) (512) + + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + + 0.225*GLYALD + TERP2OOH_OH (343) TERP2OOH + OH -> TERP2O2 rate = 2.30E-11 (513) + TERPNIT_OH (344) TERPNIT + OH -> NO2 + TERPROD1 rate = 2.00E-11 (514) + TERPO2_CH3O2 (345) TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (515) + + 0.025*CH3COCH3 + TERPO2_HO2 (346) TERPO2 + HO2 -> TERPOOH rate = 7.50E-13*exp( 700./t) (516) + TERPO2_NO (347) TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 rate = 4.20E-12*exp( 180./t) (517) + + 0.8*TERPROD1 + 0.8*HO2 + TERPOOH_OH (348) TERPOOH + OH -> TERPO2 rate = 3.30E-11 (518) + TERPROD1_NO3 (349) TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP rate = 1.00E-12 (519) + TERPROD1_OH (350) TERPROD1 + OH -> TERP2O2 rate = 5.70E-11 (520) + TERPROD2_OH (351) TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 rate = 3.40E-11 (521) + + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO + DMS_NO3 (352) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (522) + DMS_OHa (353) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (523) + OCS_O (354) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (524) + OCS_OH (355) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (525) + S_O2 (356) S + O2 -> SO + O rate = 2.30E-12 (526) + SO2_OH_M (357) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (527) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + S_O3 (358) S + O3 -> SO + O2 rate = 1.20E-11 (528) + SO_BRO (359) SO + BRO -> SO2 + BR rate = 5.70E-11 (529) + SO_CLO (360) SO + CLO -> SO2 + CL rate = 2.80E-11 (530) + S_OH (361) S + OH -> SO + H rate = 6.60E-11 (531) + SO_NO2 (362) SO + NO2 -> SO2 + NO rate = 1.40E-11 (532) + SO_O2 (363) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (533) + SO_O3 (364) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (534) + SO_OCLO (365) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (535) + SO_OH (366) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (536) + usr_DMS_OH (367) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (537) + usr_SO3_H2O (368) SO3 + H2O -> H2SO4 rate = ** User defined ** (538) + NH3_OH (369) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (539) + usr_HO2_aer (370) HO2 -> H2O rate = ** User defined ** (540) + usr_HONITR_aer (371) HONITR -> HNO3 rate = ** User defined ** (541) + usr_ISOPNITA_aer (372) ISOPNITA -> HNO3 rate = ** User defined ** (542) + usr_ISOPNITB_aer (373) ISOPNITB -> HNO3 rate = ** User defined ** (543) + usr_N2O5_aer (374) N2O5 -> 2*HNO3 rate = ** User defined ** (544) + usr_NC4CH2OH_aer (375) NC4CH2OH -> HNO3 rate = ** User defined ** (545) + usr_NC4CHO_aer (376) NC4CHO -> HNO3 rate = ** User defined ** (546) + usr_NH4_strat_ta (377) NH4 -> NHDEP rate = 6.34E-08 (547) + usr_NO2_aer (378) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (548) + usr_NO3_aer (379) NO3 -> HNO3 rate = ** User defined ** (549) + usr_NTERPOOH_aer (380) NTERPOOH -> HNO3 rate = ** User defined ** (550) + usr_ONITR_aer (381) ONITR -> HNO3 rate = ** User defined ** (551) + usr_TERPNIT_aer (382) TERPNIT -> HNO3 rate = ** User defined ** (552) + BCARY_NO3_vbs (383) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 rate = 1.90E-11 (553) + BCARYO2_HO2_vbs (384) BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 rate = 2.75E-13*exp( 1300./t) (554) + + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + + 0.114*SOAGbg4 + BCARYO2_NO_vbs (385) BCARYO2VBS + NO -> NO + 0.1279*SOAGbg0 + 0.1792*SOAGbg1 rate = 2.70E-12*exp( 360./t) (555) + + 0.0676*SOAGbg2 + 0.079*SOAGbg3 + + 0.1254*SOAGbg4 + BCARY_O3_vbs (386) BCARY + O3 -> BCARY + O3 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 rate = 1.20E-14 (556) + + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 + BCARY_OH_vbs (387) BCARY + OH -> BCARY + OH + BCARYO2VBS rate = 2.00E-10 (557) + BENZENE_OH_vbs (388) BENZENE + OH -> BENZENE + OH + BENZO2VBS rate = 2.30E-12*exp( -193./t) (558) + BENZO2_HO2_vbs (389) BENZO2VBS + HO2 -> HO2 + 0.0023*SOAGff0 + 0.0008*SOAGff1 rate = 7.50E-13*exp( 700./t) (559) + + 0.0843*SOAGff2 + 0.0443*SOAGff3 + + 0.1621*SOAGff4 + BENZO2_NO_vbs (390) BENZO2VBS + NO -> NO + 0.0097*SOAGff0 + 0.0034*SOAGff1 rate = 2.60E-12*exp( 365./t) (560) + + 0.1579*SOAGff2 + 0.0059*SOAGff3 + + 0.0536*SOAGff4 + ISOP_NO3_vbs (391) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAGbg3 + 0.025024*SOAGbg4 rate = 3.03E-12*exp( -446./t) (561) + ISOPO2_HO2_vbs (392) ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAGbg0 + 0.0035*SOAGbg1 rate = 2.12E-13*exp( 1300./t) (562) + + 0.0003*SOAGbg2 + 0.0271*SOAGbg3 + + 0.0474*SOAGbg4 + ISOPO2_NO_vbs (393) ISOPO2VBS + NO -> NO + 0.0003*SOAGbg0 + 0.0003*SOAGbg1 rate = 2.70E-12*exp( 350./t) (563) + + 0.0073*SOAGbg2 + 0.0057*SOAGbg3 + + 0.0623*SOAGbg4 + ISOP_O3_vbs (394) ISOP + O3 -> ISOP + O3 + 0.0033*SOAGbg3 rate = 1.05E-14*exp( -2000./t) (564) + ISOP_OH_vbs (395) ISOP + OH -> ISOP + OH + ISOPO2VBS rate = 2.54E-11*exp( 410./t) (565) + IVOCbbO2_HO2_vbs (396) IVOCbbO2VBS + HO2 -> HO2 + 0.2381*SOAGbb0 + 0.1308*SOAGbb1 rate = 7.50E-13*exp( 700./t) (566) + + 0.0348*SOAGbb2 + 0.0076*SOAGbb3 + + 0.0113*SOAGbb4 + IVOCbbO2_NO_vbs (397) IVOCbbO2VBS + NO -> NO + 0.1056*SOAGbb0 + 0.1026*SOAGbb1 rate = 2.60E-12*exp( 365./t) (567) + + 0.0521*SOAGbb2 + 0.0143*SOAGbb3 + + 0.0166*SOAGbb4 + IVOCbb_OH_vbs (398) IVOCbb + OH -> OH + IVOCbbO2VBS rate = 1.34E-11 (568) + IVOCffO2_HO2_vbs (399) IVOCffO2VBS + HO2 -> HO2 + 0.2381*SOAGff0 + 0.1308*SOAGff1 rate = 7.50E-13*exp( 700./t) (569) + + 0.0348*SOAGff2 + 0.0076*SOAGff3 + + 0.0113*SOAGff4 + IVOCffO2_NO_vbs (400) IVOCffO2VBS + NO -> NO + 0.1056*SOAGff0 + 0.1026*SOAGff1 rate = 2.60E-12*exp( 365./t) (570) + + 0.0521*SOAGff2 + 0.0143*SOAGff3 + + 0.0166*SOAGff4 + IVOCff_OH_vbs (401) IVOCff + OH -> OH + IVOCffO2VBS rate = 1.34E-11 (571) + MTERP_NO3_vbs (402) MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 rate = 1.20E-12*exp( 490./t) (572) + MTERPO2_HO2_vbs (403) MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 rate = 2.60E-13*exp( 1300./t) (573) + + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + + 0.1278*SOAGbg4 + MTERPO2_NO_vbs (404) MTERPO2VBS + NO -> NO + 0.0245*SOAGbg0 + 0.0082*SOAGbg1 rate = 2.70E-12*exp( 360./t) (574) + + 0.0772*SOAGbg2 + 0.0332*SOAGbg3 + 0.13*SOAGbg4 + MTERP_O3_vbs (405) MTERP + O3 -> MTERP + O3 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 rate = 6.30E-16*exp( -580./t) (575) + + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 + MTERP_OH_vbs (406) MTERP + OH -> MTERP + OH + MTERPO2VBS rate = 1.20E-11*exp( 440./t) (576) + SVOCbb_OH (407) SVOCbb + OH -> OH + 0.5931*SOAGbb0 + 0.1534*SOAGbb1 rate = 1.34E-11 (577) + + 0.0459*SOAGbb2 + 0.0085*SOAGbb3 + 0.0128*SOAGbb4 + SVOCff_OH (408) SVOCff + OH -> OH + 0.5931*SOAGff0 + 0.1534*SOAGff1 rate = 1.34E-11 (578) + + 0.0459*SOAGff2 + 0.0085*SOAGff3 + 0.0128*SOAGff4 + TOLUENE_OH_vbs (409) TOLUENE + OH -> TOLO2 + TOLUO2VBS rate = 1.70E-12*exp( 352./t) (579) + TOLUO2_HO2_vbs (410) TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAGff0 + 0.0101*SOAGff1 rate = 7.50E-13*exp( 700./t) (580) + + 0.0763*SOAGff2 + 0.2157*SOAGff3 + + 0.0738*SOAGff4 + TOLUO2_NO_vbs (411) TOLUO2VBS + NO -> NO + 0.0154*SOAGff0 + 0.0452*SOAGff1 rate = 2.60E-12*exp( 365./t) (581) + + 0.0966*SOAGff2 + 0.0073*SOAGff3 + 0.238*SOAGff4 + usr_GLYOXAL_aer (412) GLYOXAL -> SOAGbg0 rate = ** User defined ** (582) + XYLENES_OH_vbs (413) XYLENES + OH -> XYLENES + OH + XYLEO2VBS rate = 1.70E-11 (583) + XYLEO2_HO2_vbs (414) XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAGff0 + 0.0174*SOAGff1 rate = 7.50E-13*exp( 700./t) (584) + + 0.086*SOAGff2 + 0.0512*SOAGff3 + + 0.1598*SOAGff4 + XYLEO2_NO_vbs (415) XYLEO2VBS + NO -> NO + 0.0063*SOAGff0 + 0.0237*SOAGff1 rate = 2.60E-12*exp( 365./t) (585) + + 0.0025*SOAGff2 + 0.011*SOAGff3 + 0.1185*SOAGff4 + het1 (416) N2O5 -> 2*HNO3 rate = ** User defined ** (586) + het10 (417) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (587) + het11 (418) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (588) + het12 (419) N2O5 -> 2*HNO3 rate = ** User defined ** (589) + het13 (420) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (590) + het14 (421) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (591) + het15 (422) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (592) + het16 (423) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (593) + het17 (424) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (594) + het2 (425) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (595) + het3 (426) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (596) + het4 (427) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (597) + het5 (428) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (598) + het6 (429) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (599) + het7 (430) N2O5 -> 2*HNO3 rate = ** User defined ** (600) + het8 (431) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (601) + het9 (432) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (602) + elec1 (433) NOp + e -> 0.2*N + 0.8*N2D + O rate = ** User defined ** (603) + elec2 (434) O2p + e -> 1.15*O + 0.85*O1D rate = ** User defined ** (604) + elec3 (435) N2p + e -> 1.1*N + 0.9*N2D rate = ** User defined ** (605) + ion_N2p_O2 (436) N2p + O2 -> O2p + N2 rate = 6.00E-11 (606) + ion_N2p_Oa (437) N2p + O -> NOp + N2D rate = ** User defined ** (607) + ion_N2p_Ob (438) N2p + O -> Op + N2 rate = ** User defined ** (608) + ion_Np_O (439) Np + O -> Op + N rate = 1.00E-12 (609) + ion_Np_O2a (440) Np + O2 -> O2p + N rate = 4.00E-10 (610) + ion_Np_O2b (441) Np + O2 -> NOp + O rate = 2.00E-10 (611) + ion_O2p_N (442) O2p + N -> NOp + O rate = 1.00E-10 (612) + ion_O2p_N2 (443) O2p + N2 -> NOp + NO rate = 5.00E-16 (613) + ion_O2p_NO (444) O2p + NO -> NOp + O2 rate = 4.40E-10 (614) + ion_Op_CO2 (445) Op + CO2 -> O2p + CO rate = 9.00E-10 (615) + ion_Op_N2 (446) Op + N2 -> NOp + N rate = ** User defined ** (616) + ion_Op_O2 (447) Op + O2 -> O2p + O rate = ** User defined ** (617) + E90_tau (448) E90 -> {sink} rate = 1.29E-07 (618) + NH_50_tau (449) NH_50 -> (No products) rate = 2.31E-07 (619) + NH_5_tau (450) NH_5 -> (No products) rate = 2.31E-06 (620) + ST80_25_tau (451) ST80_25 -> (No products) rate = 4.63E-07 (621) + +Extraneous prod/loss species + ( 1) CO (dataset) + ( 2) bc_a4 (dataset) + ( 3) num_a1 (dataset) + ( 4) num_a2 (dataset) + ( 5) num_a4 (dataset) + ( 6) pombb1_a1 (dataset) + ( 7) pombb1_a4 (dataset) + ( 8) pomff1_a1 (dataset) + ( 9) pomff1_a4 (dataset) + (10) NO (dataset) + (11) NO2 (dataset) + (12) SO2 (dataset) + (13) SVOCbb (dataset) + (14) SVOCff (dataset) + (15) so4_a1 (dataset) + (16) so4_a2 (dataset) + (17) bc_a1 (dataset) + (18) e + (19) N + (20) N2D + (21) OH + (22) Op + (23) AOA_NH + (24) N2p + (25) Np + + + Equation Report + + d(ALKNIT)/dt = r249*ALKO2*NO + - j20*ALKNIT - r246*OH*ALKNIT + d(ALKOOH)/dt = r247*ALKO2*HO2 + - j21*ALKOOH - r250*OH*ALKOOH + d(AOA_NH)/dt = 0 + d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(BCARY)/dt = - r329*NO3*BCARY - r330*O3*BCARY - r331*OH*BCARY + d(BCARYO2VBS)/dt = r387*BCARY*OH + - r384*HO2*BCARYO2VBS - r385*NO*BCARYO2VBS + d(BENZENE)/dt = - r288*OH*BENZENE + d(BENZO2VBS)/dt = r388*BENZENE*OH + - r389*HO2*BENZO2VBS - r390*NO*BENZO2VBS + d(BENZOOH)/dt = r289*BENZO2*HO2 + - j22*BENZOOH - r291*OH*BENZOOH + d(BEPOMUC)/dt = .12*r288*BENZENE*OH + - j23*BEPOMUC + d(BIGALD)/dt = .1*r330*BCARY*O3 + .1*r333*MTERP*O3 + - j24*BIGALD + d(BIGALD1)/dt = .5*j22*BENZOOH + j23*BEPOMUC + .2*j71*TOLOOH + .06*j73*XYLENOOH + .5*r290*BENZO2*NO + + .2*r317*TOLO2*NO + .06*r323*XYLENO2*NO + - j25*BIGALD1 + d(BIGALD2)/dt = .2*j71*TOLOOH + .2*j73*XYLENOOH + .2*r317*TOLO2*NO + .2*r323*XYLENO2*NO + - j26*BIGALD2 + d(BIGALD3)/dt = j47*HPALD + j57*NC4CHO + .2*j71*TOLOOH + .15*j73*XYLENOOH + .2*r317*TOLO2*NO + + .15*r323*XYLENO2*NO + - j27*BIGALD3 + d(BIGALD4)/dt = .21*j73*XYLENOOH + .21*r323*XYLENO2*NO + - j28*BIGALD4 + d(BIGALK)/dt = .05*r330*BCARY*O3 + .05*r333*MTERP*O3 + - r251*OH*BIGALK + d(BIGENE)/dt = - r217*NO3*BIGENE - r218*OH*BIGENE + d(BR)/dt = j75*BRCL + j76*BRO + j78*BRONO2 + j80*CF2CLBR + j81*CF3BR + 2*j87*CH2BR2 + j88*CH3BR + + 3*j91*CHBR3 + 2*j99*H2402 + j100*HBR + j106*HOBR + r90*O1D*CF2CLBR + 2*r103*BRO*BRO + + r104*BRO*CLO + r105*BRO*CLO + r108*BRO*NO + r111*BRO*O + r112*BRO*OH + r113*HBR*O + + r114*HBR*OH + r116*O1D*CF3BR + 3*r117*O1D*CHBR3 + 2*r118*O1D*H2402 + r119*O1D*HBR + + 2*r127*CH2BR2*CL + 2*r128*CH2BR2*OH + r129*CH3BR*CL + r130*CH3BR*OH + 3*r134*CHBR3*CL + + 3*r135*CHBR3*OH + 2*r139*O1D*CH2BR2 + r140*O1D*CH3BR + r359*SO*BRO + - r100*CH2O*BR - r101*HO2*BR - r102*O3*BR + d(BRCL)/dt = r106*BRO*CLO + r424*HOBR*HCL + r429*HOBR*HCL + - j75*BRCL + d(BRO)/dt = j77*BRONO2 + r102*BR*O3 + r110*BRONO2*O + r115*HOBR*O + r120*O1D*HBR + - j76*BRO - 2*r103*BRO*BRO - r104*CLO*BRO - r105*CLO*BRO - r106*CLO*BRO - r107*HO2*BRO + - r108*NO*BRO - r109*M*NO2*BRO - r111*O*BRO - r112*OH*BRO - r359*SO*BRO + d(BRONO2)/dt = r109*M*BRO*NO2 + - j77*BRONO2 - j78*BRONO2 - r418*BRONO2 - r421*BRONO2 - r426*BRONO2 - r110*O*BRONO2 + d(BRY)/dt = 0 + d(BZALD)/dt = j29*BZOOH + r295*BZOO*NO + - r292*OH*BZALD + d(BZOOH)/dt = r293*BZOO*HO2 + - j29*BZOOH - r294*OH*BZOOH + d(C2H2)/dt = - r165*M*CL*C2H2 - r166*M*OH*C2H2 + d(C2H4)/dt = - r167*M*CL*C2H4 - r168*O3*C2H4 - r193*M*OH*C2H4 + d(C2H5OH)/dt = .4*r169*C2H5O2*C2H5O2 + .2*r170*C2H5O2*CH3O2 + - r173*OH*C2H5OH + d(C2H5OOH)/dt = r171*C2H5O2*HO2 + - j30*C2H5OOH - r174*OH*C2H5OOH + d(C2H6)/dt = - r175*CL*C2H6 - r176*OH*C2H6 + d(C3H6)/dt = .7*j56*MVK + .13*r275*ISOP*O3 + - r196*NO3*C3H6 - r197*O3*C3H6 - r215*M*OH*C3H6 + d(C3H7OOH)/dt = r199*C3H7O2*HO2 + - j31*C3H7OOH - r201*OH*C3H7OOH + d(C3H8)/dt = - r202*OH*C3H8 - r205*CL*C3H8 + d(C6H5OOH)/dt = r296*C6H5O2*HO2 + - j32*C6H5OOH - r298*OH*C6H5OOH + d(CCL4)/dt = - j79*CCL4 - r89*O1D*CCL4 + d(CF2CLBR)/dt = - j80*CF2CLBR - r90*O1D*CF2CLBR + d(CF3BR)/dt = - j81*CF3BR - r116*O1D*CF3BR + d(CFC11)/dt = - j82*CFC11 - r91*O1D*CFC11 + d(CFC113)/dt = - j83*CFC113 - r92*O1D*CFC113 + d(CFC114)/dt = - j84*CFC114 - r93*O1D*CFC114 + d(CFC115)/dt = - j85*CFC115 - r94*O1D*CFC115 + d(CFC12)/dt = - j86*CFC12 - r95*O1D*CFC12 + d(CH2BR2)/dt = - j87*CH2BR2 - r127*CL*CH2BR2 - r128*OH*CH2BR2 - r139*O1D*CH2BR2 + d(CH2O)/dt = .1*j20*ALKNIT + .1*j21*ALKOOH + j39*CH3OOH + .18*j40*CH4 + j44*GLYALD + .33*j46*HONITR + + j48*HYAC + j50*ISOPOOH + 1.34*j51*MACR + j58*NOA + j63*POOH + j64*ROOH + .375*j66*TERP2OOH + + .4*j68*TERPOOH + .68*j70*TERPROD2 + r158*HOCH2OO + 2*r188*EO + r71*CLO*CH3O2 + + 2*r148*CH3O2*CH3O2 + r149*CH3O2*CH3O2 + r151*CH3O2*NO + r152*CH3OH*OH + .3*r153*CH3OOH*OH + + r161*O1D*CH4 + r162*O1D*CH4 + r168*C2H4*O3 + .7*r170*C2H5O2*CH3O2 + r181*CH3CO3*CH3O2 + + .5*r185*CH3COOOH*OH + .5*r187*EO2*NO + .8*r190*GLYALD*OH + r192*PAN*OH + .5*r197*C3H6*O3 + + r198*C3H7O2*CH3O2 + r209*PO2*NO + .8*r211*RO2*CH3O2 + .15*r212*RO2*HO2 + r213*RO2*NO + + .5*r217*BIGENE*NO3 + .5*r219*ENEO2*NO + .25*r222*MACRO2*CH3CO3 + .88*r223*MACRO2*CH3O2 + + .25*r225*MACRO2*NO3 + .25*r226*MACRO2*NO + .12*r228*MACR*O3 + r231*MCO3*CH3CO3 + + 2*r232*MCO3*CH3O2 + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + r235*MCO3*NO + r236*MCO3*NO3 + + .5*r241*M*MPAN*OH + .6*r242*MVK*O3 + .4*r246*ALKNIT*OH + .1*r248*ALKO2*NO + + r255*ISOPAO2*CH3CO3 + 1.5*r256*ISOPAO2*CH3O2 + .92*r258*ISOPAO2*NO + r259*ISOPAO2*NO3 + + .75*r261*ISOPBO2*CH3O2 + .3*r266*ISOPNITA*OH + .8*r270*ISOPNO3*CH3O2 + .91*r275*ISOP*O3 + + .25*r280*XO2*CH3CO3 + .8*r281*XO2*CH3O2 + .25*r283*XO2*NO + .34*r330*BCARY*O3 + + .34*r333*MTERP*O3 + .75*r335*NTERPO2*CH3O2 + .93*r340*TERP2O2*CH3O2 + .34*r342*TERP2O2*NO + + .95*r345*TERPO2*CH3O2 + .32*r347*TERPO2*NO + .68*r351*TERPROD2*OH + - j33*CH2O - j34*CH2O - r64*CL*CH2O - r100*BR*CH2O - r144*HO2*CH2O - r145*NO3*CH2O + - r146*O*CH2O - r147*OH*CH2O + d(CH3BR)/dt = - j88*CH3BR - r129*CL*CH3BR - r130*OH*CH3BR - r140*O1D*CH3BR + d(CH3CCL3)/dt = - j89*CH3CCL3 - r131*OH*CH3CCL3 + d(CH3CHO)/dt = .4*j20*ALKNIT + .4*j21*ALKOOH + j30*C2H5OOH + .33*j46*HONITR + j54*MEKOOH + j63*POOH + + 1.6*r169*C2H5O2*C2H5O2 + .8*r170*C2H5O2*CH3O2 + r172*C2H5O2*NO + r173*C2H5OH*OH + + .5*r174*C2H5OOH*OH + .5*r197*C3H6*O3 + .27*r200*C3H7O2*NO + r209*PO2*NO + r217*BIGENE*NO3 + + r219*ENEO2*NO + .2*r237*MEKO2*HO2 + r238*MEKO2*NO + .1*r242*MVK*O3 + .8*r246*ALKNIT*OH + + .4*r248*ALKO2*NO + - j35*CH3CHO - r177*NO3*CH3CHO - r178*OH*CH3CHO + d(CH3CL)/dt = - j90*CH3CL - r132*CL*CH3CL - r133*OH*CH3CL + d(CH3CN)/dt = - r179*OH*CH3CN + d(CH3COCH3)/dt = .25*j20*ALKNIT + .25*j21*ALKOOH + .82*j31*C3H7OOH + .17*j46*HONITR + .3*j66*TERP2OOH + + .05*j68*TERPOOH + .5*j70*TERPROD2 + .82*r198*C3H7O2*CH3O2 + .82*r200*C3H7O2*NO + + .5*r217*BIGENE*NO3 + .5*r219*ENEO2*NO + .8*r246*ALKNIT*OH + .25*r248*ALKO2*NO + + .52*r330*BCARY*O3 + .52*r333*MTERP*O3 + .15*r340*TERP2O2*CH3O2 + .27*r342*TERP2O2*NO + + .025*r345*TERPO2*CH3O2 + .04*r347*TERPO2*NO + .5*r351*TERPROD2*OH + - j36*CH3COCH3 - r216*OH*CH3COCH3 + d(CH3COCHO)/dt = .18*j24*BIGALD + j28*BIGALD4 + .4*j71*TOLOOH + .54*j73*XYLENOOH + .51*j74*XYLOLOOH + + r206*HYAC*OH + r207*NOA*OH + .5*r211*RO2*CH3O2 + .25*r222*MACRO2*CH3CO3 + + .24*r223*MACRO2*CH3O2 + .25*r225*MACRO2*NO3 + .25*r226*MACRO2*NO + .88*r228*MACR*O3 + + .5*r242*MVK*O3 + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + .25*r280*XO2*CH3CO3 + + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + .07*r300*DICARBO2*HO2 + + .17*r301*DICARBO2*NO + .07*r306*MDIALO2*HO2 + .17*r307*MDIALO2*NO + .4*r317*TOLO2*NO + + .54*r323*XYLENO2*NO + .51*r326*XYLOLO2*NO + - j37*CH3COCHO - r203*NO3*CH3COCHO - r204*OH*CH3COCHO + d(CH3COOH)/dt = .1*r181*CH3CO3*CH3O2 + .15*r182*CH3CO3*HO2 + .12*r197*C3H6*O3 + .15*r233*MCO3*HO2 + - r184*OH*CH3COOH + d(CH3COOOH)/dt = .4*r182*CH3CO3*HO2 + .4*r233*MCO3*HO2 + - j38*CH3COOOH - r185*OH*CH3COOOH + d(CH3OH)/dt = r149*CH3O2*CH3O2 + .3*r170*C2H5O2*CH3O2 + .5*r211*RO2*CH3O2 + .25*r223*MACRO2*CH3O2 + + .25*r256*ISOPAO2*CH3O2 + .25*r261*ISOPBO2*CH3O2 + .2*r270*ISOPNO3*CH3O2 + .3*r281*XO2*CH3O2 + + .25*r335*NTERPO2*CH3O2 + .25*r340*TERP2O2*CH3O2 + .25*r345*TERPO2*CH3O2 + - r152*OH*CH3OH + d(CH3OOH)/dt = r150*CH3O2*HO2 + - j39*CH3OOH - r153*OH*CH3OOH + d(CH4)/dt = .1*r197*C3H6*O3 + - j40*CH4 - j41*CH4 - r65*CL*CH4 - r121*F*CH4 - r154*OH*CH4 - r160*O1D*CH4 - r161*O1D*CH4 + - r162*O1D*CH4 + d(CHBR3)/dt = - j91*CHBR3 - r117*O1D*CHBR3 - r134*CL*CHBR3 - r135*OH*CHBR3 + d(CL)/dt = j75*BRCL + 4*j79*CCL4 + j80*CF2CLBR + 2*j82*CFC11 + 2*j83*CFC113 + 2*j84*CFC114 + j85*CFC115 + + 2*j86*CFC12 + 3*j89*CH3CCL3 + j90*CH3CL + 2*j92*CL2 + 2*j93*CL2O2 + j94*CLO + j95*CLONO2 + + j98*COFCL + j101*HCFC141B + j102*HCFC142B + j103*HCFC22 + j104*HCL + j107*HOCL + r71*CLO*CH3O2 + + 2*r72*CLO*CLO + r74*CLO*CLO + r76*CLO*NO + r81*CLO*O + r82*CLO*OH + r84*HCL*O + r85*HCL*OH + + 4*r89*O1D*CCL4 + r90*O1D*CF2CLBR + 2*r91*O1D*CFC11 + 2*r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + r94*O1D*CFC115 + 2*r95*O1D*CFC12 + r96*O1D*HCL + r105*BRO*CLO + r126*O1D*COFCL + + 3*r131*CH3CCL3*OH + r133*CH3CL*OH + r136*HCFC141B*OH + r137*HCFC142B*OH + r138*HCFC22*OH + + r141*O1D*HCFC141B + r142*O1D*HCFC142B + r143*O1D*HCFC22 + r360*SO*CLO + - r64*CH2O*CL - r65*CH4*CL - r66*H2*CL - r67*H2O2*CL - r68*HO2*CL - r69*HO2*CL - r70*O3*CL + - r77*CLONO2*CL - r86*HOCL*CL - r127*CH2BR2*CL - r129*CH3BR*CL - r132*CH3CL*CL - r134*CHBR3*CL + - r175*C2H6*CL - r205*C3H8*CL + d(CL2)/dt = r73*CLO*CLO + r77*CLONO2*CL + r417*HOCL*HCL + r422*CLONO2*HCL + r423*HOCL*HCL + r427*CLONO2*HCL + + r428*HOCL*HCL + r432*CLONO2*HCL + - j92*CL2 + d(CL2O2)/dt = r98*M*CLO*CLO + - j93*CL2O2 - r99*M*CL2O2 + d(CLO)/dt = j96*CLONO2 + j108*OCLO + r99*M*CL2O2 + r99*M*CL2O2 + r69*CL*HO2 + r70*CL*O3 + r79*CLONO2*O + + r86*HOCL*CL + r87*HOCL*O + r88*HOCL*OH + r97*O1D*HCL + r365*SO*OCLO + - j94*CLO - r71*CH3O2*CLO - 2*r72*CLO*CLO - 2*r73*CLO*CLO - 2*r74*CLO*CLO - r75*HO2*CLO + - r76*NO*CLO - r78*M*NO2*CLO - r81*O*CLO - r82*OH*CLO - r83*OH*CLO - 2*r98*M*CLO*CLO + - r104*BRO*CLO - r105*BRO*CLO - r106*BRO*CLO - r360*SO*CLO + d(CLONO2)/dt = r78*M*CLO*NO2 + - j95*CLONO2 - j96*CLONO2 - r420*CLONO2 - r425*CLONO2 - r431*CLONO2 - r77*CL*CLONO2 + - r79*O*CLONO2 - r80*OH*CLONO2 - r422*HCL*CLONO2 - r427*HCL*CLONO2 - r432*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = 1.5*j23*BEPOMUC + .45*j24*BIGALD + .6*j27*BIGALD3 + j28*BIGALD4 + j33*CH2O + j34*CH2O + + j35*CH3CHO + j37*CH3COCHO + .38*j40*CH4 + j42*CO2 + j44*GLYALD + 2*j45*GLYOXAL + + .33*j46*HONITR + 1.34*j52*MACR + .7*j56*MVK + 1.5*j65*TEPOMUC + .25*j66*TERP2OOH + j69*TERPROD1 + + 1.7*j70*TERPROD2 + j110*CO2 + j137*OCS + r64*CL*CH2O + r100*BR*CH2O + r132*CH3CL*CL + + r145*CH2O*NO3 + r146*CH2O*O + r147*CH2O*OH + .35*r166*M*C2H2*OH + .63*r168*C2H4*O3 + + r191*GLYOXAL*OH + .56*r197*C3H6*O3 + r203*CH3COCHO*NO3 + r204*CH3COCHO*OH + + .22*r222*MACRO2*CH3CO3 + .11*r223*MACRO2*CH3O2 + .22*r225*MACRO2*NO3 + .22*r226*MACRO2*NO + + .65*r228*MACR*O3 + .56*r242*MVK*O3 + .62*r275*ISOP*O3 + .25*r280*XO2*CH3CO3 + .2*r281*XO2*CH3O2 + + .25*r283*XO2*NO + .5*r284*XO2*NO3 + .07*r300*DICARBO2*HO2 + .17*r301*DICARBO2*NO + + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + .14*r306*MDIALO2*HO2 + .35*r307*MDIALO2*NO + + .23*r330*BCARY*O3 + .23*r333*MTERP*O3 + .125*r340*TERP2O2*CH3O2 + .225*r342*TERP2O2*NO + + .7*r351*TERPROD2*OH + r354*OCS*O + r355*OCS*OH + r445*Op*CO2 + - r164*OH*CO + d(CO2)/dt = j38*CH3COOOH + .44*j40*CH4 + .4*j61*PAN + j66*TERP2OOH + .8*j70*TERPROD2 + r156*HCOOH*OH + + r164*CO*OH + 2*r180*CH3CO3*CH3CO3 + .9*r181*CH3CO3*CH3O2 + r183*CH3CO3*NO + r184*CH3COOH*OH + + .5*r185*CH3COOOH*OH + .8*r190*GLYALD*OH + r191*GLYOXAL*OH + .2*r197*C3H6*O3 + + 2*r231*MCO3*CH3CO3 + r232*MCO3*CH3O2 + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + .5*r241*M*MPAN*OH + + .1*r242*MVK*O3 + r255*ISOPAO2*CH3CO3 + r280*XO2*CH3CO3 + .27*r330*BCARY*O3 + .27*r333*MTERP*O3 + + .5*r340*TERP2O2*CH3O2 + .9*r342*TERP2O2*NO + 1.8*r351*TERPROD2*OH + - j42*CO2 - j110*CO2 - r445*Op*CO2 + d(COF2)/dt = j80*CF2CLBR + j81*CF3BR + j83*CFC113 + 2*j84*CFC114 + 2*j85*CFC115 + j86*CFC12 + 2*j99*H2402 + + j102*HCFC142B + j103*HCFC22 + r90*O1D*CF2CLBR + r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + 2*r94*O1D*CFC115 + r95*O1D*CFC12 + r116*O1D*CF3BR + 2*r118*O1D*H2402 + r137*HCFC142B*OH + + r138*HCFC22*OH + r142*O1D*HCFC142B + r143*O1D*HCFC22 + - j97*COF2 - r125*O1D*COF2 + d(COFCL)/dt = j82*CFC11 + j83*CFC113 + j101*HCFC141B + r91*O1D*CFC11 + r92*O1D*CFC113 + r136*HCFC141B*OH + + r141*O1D*HCFC141B + - j98*COFCL - r126*O1D*COFCL + d(CRESOL)/dt = .18*r319*TOLUENE*OH + - r299*OH*CRESOL + d(DMS)/dt = - r352*NO3*DMS - r353*OH*DMS - r367*OH*DMS + d(dst_a1)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(E90)/dt = - r448*E90 + d(EOOH)/dt = r186*EO2*HO2 + - j43*EOOH + d(F)/dt = j81*CF3BR + j85*CFC115 + 2*j97*COF2 + j98*COFCL + j105*HF + r94*O1D*CFC115 + r116*O1D*CF3BR + + 2*r125*O1D*COF2 + r126*O1D*COFCL + - r121*CH4*F - r122*H2*F - r123*H2O*F - r124*HNO3*F + d(GLYALD)/dt = .33*j46*HONITR + .25*j66*TERP2OOH + r189*EO*O2 + .53*r222*MACRO2*CH3CO3 + .26*r223*MACRO2*CH3O2 + + .53*r225*MACRO2*NO3 + .53*r226*MACRO2*NO + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + + .7*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH + r278*NC4CH2OH*OH + .25*r280*XO2*CH3CO3 + + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + .125*r340*TERP2O2*CH3O2 + + .225*r342*TERP2O2*NO + - j44*GLYALD - r190*OH*GLYALD + d(GLYOXAL)/dt = j22*BENZOOH + .13*j24*BIGALD + .7*j62*PHENOOH + .6*j71*TOLOOH + .34*j73*XYLENOOH + + .17*j74*XYLOLOOH + .65*r166*M*C2H2*OH + .2*r190*GLYALD*OH + .05*r264*ISOPBO2*NO + + .05*r265*ISOPBO2*NO3 + r279*NC4CHO*OH + .25*r280*XO2*CH3CO3 + .1*r281*XO2*CH3O2 + + .25*r283*XO2*NO + .25*r284*XO2*NO3 + r290*BENZO2*NO + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + + .07*r306*MDIALO2*HO2 + .17*r307*MDIALO2*NO + .7*r310*PHENO2*NO + .6*r317*TOLO2*NO + + .34*r323*XYLENO2*NO + .17*r326*XYLOLO2*NO + - j45*GLYOXAL - r412*GLYOXAL - r191*OH*GLYOXAL + d(H)/dt = 2*j2*H2O + j3*H2O + 2*j34*CH2O + j39*CH3OOH + .33*j40*CH4 + j41*CH4 + j100*HBR + j104*HCL + + j105*HF + r3*O1D*H2 + r20*H2*O + r29*OH*H2 + r32*OH*O + r52*N*OH + r66*CL*H2 + r97*O1D*HCL + + r120*O1D*HBR + r122*F*H2 + r147*CH2O*OH + r161*O1D*CH4 + r355*OCS*OH + r361*S*OH + r366*SO*OH + - r22*HO2*H - r23*HO2*H - r24*HO2*H - r25*M*O2*H - r28*O3*H + d(H2)/dt = j1*H2O + j33*CH2O + 1.4400001*j40*CH4 + r22*H*HO2 + r162*O1D*CH4 + - r3*O1D*H2 - r20*O*H2 - r29*OH*H2 - r66*CL*H2 - r122*F*H2 + d(H2402)/dt = - j99*H2402 - r118*O1D*H2402 + d(H2O2)/dt = r35*M*OH*OH + r36*HO2*HO2 + - j4*H2O2 - r21*O*H2O2 - r30*OH*H2O2 - r67*CL*H2O2 + d(H2SO4)/dt = r368*SO3*H2O + - j136*H2SO4 + d(HBR)/dt = r100*BR*CH2O + r101*BR*HO2 + - j100*HBR - r113*O*HBR - r114*OH*HBR - r119*O1D*HBR - r120*O1D*HBR + d(HCFC141B)/dt = - j101*HCFC141B - r136*OH*HCFC141B - r141*O1D*HCFC141B + d(HCFC142B)/dt = - j102*HCFC142B - r137*OH*HCFC142B - r142*O1D*HCFC142B + d(HCFC22)/dt = - j103*HCFC22 - r138*OH*HCFC22 - r143*O1D*HCFC22 + d(HCL)/dt = r64*CL*CH2O + r65*CL*CH4 + r66*CL*H2 + r67*CL*H2O2 + r68*CL*HO2 + r83*CLO*OH + r86*HOCL*CL + + r127*CH2BR2*CL + r129*CH3BR*CL + 2*r132*CH3CL*CL + r134*CHBR3*CL + r175*C2H6*CL + r205*CL*C3H8 + - j104*HCL - r84*O*HCL - r85*OH*HCL - r96*O1D*HCL - r97*O1D*HCL - r417*HOCL*HCL + - r422*CLONO2*HCL - r423*HOCL*HCL - r424*HOBR*HCL - r427*CLONO2*HCL - r428*HOCL*HCL + - r429*HOBR*HCL - r432*CLONO2*HCL + d(HCN)/dt = - r155*M*OH*HCN - r163*O1D*HCN + d(HCOOH)/dt = r157*HOCH2OO*HO2 + r159*HOCH2OO*NO + .35*r166*M*C2H2*OH + .37*r168*C2H4*O3 + .12*r197*C3H6*O3 + + .33*r228*MACR*O3 + .12*r242*MVK*O3 + .11*r275*ISOP*O3 + .05*r330*BCARY*O3 + .05*r333*MTERP*O3 + - r156*OH*HCOOH + d(HF)/dt = r121*F*CH4 + r122*F*H2 + r123*F*H2O + r124*F*HNO3 + - j105*HF + d(HNO3)/dt = r371*HONITR + r372*ISOPNITA + r373*ISOPNITB + 2*r374*N2O5 + r375*NC4CH2OH + r376*NC4CHO + + .5*r378*NO2 + r379*NO3 + r380*NTERPOOH + r381*ONITR + r382*TERPNIT + 2*r416*N2O5 + + r418*BRONO2 + 2*r419*N2O5 + r420*CLONO2 + r421*BRONO2 + r425*CLONO2 + r426*BRONO2 + + 2*r430*N2O5 + r431*CLONO2 + r60*M*NO2*OH + r145*CH2O*NO3 + r177*CH3CHO*NO3 + + r203*CH3COCHO*NO3 + r352*DMS*NO3 + r422*CLONO2*HCL + r427*CLONO2*HCL + r432*CLONO2*HCL + - j9*HNO3 - r61*OH*HNO3 - r124*F*HNO3 + d(HO2NO2)/dt = r58*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r62*M*HO2NO2 - r37*OH*HO2NO2 + d(HOBR)/dt = r418*BRONO2 + r421*BRONO2 + r426*BRONO2 + r107*BRO*HO2 + - j106*HOBR - r115*O*HOBR - r424*HCL*HOBR - r429*HCL*HOBR + d(HOCL)/dt = r420*CLONO2 + r425*CLONO2 + r431*CLONO2 + r75*CLO*HO2 + r80*CLONO2*OH + - j107*HOCL - r86*CL*HOCL - r87*O*HOCL - r88*OH*HOCL - r417*HCL*HOCL - r423*HCL*HOCL + - r428*HCL*HOCL + d(HONITR)/dt = r220*ENEO2*NO + r227*MACRO2*NO + .3*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH + - j46*HONITR - r371*HONITR - r221*OH*HONITR + d(HPALD)/dt = r263*ISOPBO2 + - j47*HPALD - r252*OH*HPALD + d(HYAC)/dt = .17*j46*HONITR + .5*r210*POOH*OH + .2*r211*RO2*CH3O2 + .22*r222*MACRO2*CH3CO3 + + .23*r223*MACRO2*CH3O2 + .22*r225*MACRO2*NO3 + .22*r226*MACRO2*NO + .5*r241*M*MPAN*OH + + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + .7*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH + + .25*r280*XO2*CH3CO3 + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + - j48*HYAC - r206*OH*HYAC + d(HYDRALD)/dt = r260*ISOPBO2*CH3CO3 + .75*r261*ISOPBO2*CH3O2 + .87*r264*ISOPBO2*NO + .95*r265*ISOPBO2*NO3 + - r253*OH*HYDRALD + d(IEPOX)/dt = .6*r277*ISOPOOH*OH + - r254*OH*IEPOX + d(ISOP)/dt = - r268*NO3*ISOP - r275*O3*ISOP - r276*OH*ISOP + d(ISOPNITA)/dt = .08*r258*ISOPAO2*NO + - r372*ISOPNITA - r266*OH*ISOPNITA + d(ISOPNITB)/dt = .08*r264*ISOPBO2*NO + - r373*ISOPNITB - r267*OH*ISOPNITB + d(ISOPNO3)/dt = r268*ISOP*NO3 + - r269*CH3CO3*ISOPNO3 - r270*CH3O2*ISOPNO3 - r271*HO2*ISOPNO3 - r272*NO*ISOPNO3 + - r273*NO3*ISOPNO3 + d(ISOPNOOH)/dt = r271*ISOPNO3*HO2 + - j49*ISOPNOOH - r274*OH*ISOPNOOH + d(ISOPO2VBS)/dt = r395*ISOP*OH + - r392*HO2*ISOPO2VBS - r393*NO*ISOPO2VBS + d(ISOPOOH)/dt = j49*ISOPNOOH + r257*ISOPAO2*HO2 + r262*ISOPBO2*HO2 + - j50*ISOPOOH - r277*OH*ISOPOOH + d(IVOCbb)/dt = - r398*OH*IVOCbb + d(IVOCbbO2VBS)/dt = r398*IVOCbb*OH + - r396*HO2*IVOCbbO2VBS - r397*NO*IVOCbbO2VBS + d(IVOCff)/dt = - r401*OH*IVOCff + d(IVOCffO2VBS)/dt = r401*IVOCff*OH + - r399*HO2*IVOCffO2VBS - r400*NO*IVOCffO2VBS + d(MACR)/dt = .3*j50*ISOPOOH + .39*r255*ISOPAO2*CH3CO3 + .31*r256*ISOPAO2*CH3O2 + .36*r258*ISOPAO2*NO + + .4*r259*ISOPAO2*NO3 + .3*r275*ISOP*O3 + - j51*MACR - j52*MACR - r228*O3*MACR - r229*OH*MACR + d(MACROOH)/dt = r224*MACRO2*HO2 + - r230*OH*MACROOH + d(MEK)/dt = .8*j20*ALKNIT + .8*j21*ALKOOH + .8*r248*ALKO2*NO + - j53*MEK - r239*OH*MEK + d(MEKOOH)/dt = .8*r237*MEKO2*HO2 + - j54*MEKOOH - r240*OH*MEKOOH + d(MPAN)/dt = r244*M*MCO3*NO2 + - j55*MPAN - r245*M*MPAN - r241*M*OH*MPAN + d(MTERP)/dt = - r332*NO3*MTERP - r333*O3*MTERP - r334*OH*MTERP + d(MTERPO2VBS)/dt = r406*MTERP*OH + - r403*HO2*MTERPO2VBS - r404*NO*MTERPO2VBS + d(MVK)/dt = .7*j50*ISOPOOH + .61*r255*ISOPAO2*CH3CO3 + .44*r256*ISOPAO2*CH3O2 + .56*r258*ISOPAO2*NO + + .6*r259*ISOPAO2*NO3 + .2*r275*ISOP*O3 + - j56*MVK - r242*O3*MVK - r243*OH*MVK + d(N)/dt = .8*j112*N2 + j115*N2 + j116*N2 + .8*j118*N2 + j15*NO + r446*N2*Op + r38*N2D*O + .2*r433*NOp*e + + 1.1*r435*N2p*e + r439*Np*O + r440*Np*O2 + - j111*N - r40*NO*N - r41*NO2*N - r42*NO2*N - r43*NO2*N - r44*O2*N - r52*OH*N - r442*O2p*N + d(N2O)/dt = r41*N*NO2 + - j12*N2O - r56*O1D*N2O - r57*O1D*N2O + d(N2O5)/dt = r59*M*NO2*NO3 + - j13*N2O5 - j14*N2O5 - r63*M*N2O5 - r374*N2O5 - r416*N2O5 - r419*N2O5 - r430*N2O5 + d(NC4CH2OH)/dt = .2*r270*ISOPNO3*CH3O2 + - r375*NC4CH2OH - r278*OH*NC4CH2OH + d(NC4CHO)/dt = r269*ISOPNO3*CH3CO3 + .8*r270*ISOPNO3*CH3O2 + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + - j57*NC4CHO - r376*NC4CHO - r279*OH*NC4CHO + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 + d(ncl_a3)/dt = 0 + d(NH3)/dt = - r369*OH*NH3 + d(NH4)/dt = - r377*NH4 + d(NH_5)/dt = - r450*NH_5 + d(NH_50)/dt = - r449*NH_50 + d(NO)/dt = j14*N2O5 + j17*NO2 + j19*NO3 + .5*r378*NO2 + r443*N2*O2p + r39*N2D*O2 + 2*r42*N*NO2 + r44*N*O2 + + r45*NO2*O + r52*N*OH + 2*r56*O1D*N2O + r362*SO*NO2 + - j15*NO - j16*NO - r40*N*NO - r49*NO3*NO - r53*HO2*NO - r54*O3*NO - r55*M*O*NO - r76*CLO*NO + - r108*BRO*NO - r151*CH3O2*NO - r159*HOCH2OO*NO - r172*C2H5O2*NO - r183*CH3CO3*NO - r187*EO2*NO + - r200*C3H7O2*NO - r209*PO2*NO - r213*RO2*NO - r219*ENEO2*NO - r220*ENEO2*NO - r226*MACRO2*NO + - r227*MACRO2*NO - r235*MCO3*NO - r238*MEKO2*NO - r248*ALKO2*NO - r249*ALKO2*NO - r258*ISOPAO2*NO + - r264*ISOPBO2*NO - r272*ISOPNO3*NO - r283*XO2*NO - r287*ACBZO2*NO - r290*BENZO2*NO + - r295*BZOO*NO - r297*C6H5O2*NO - r301*DICARBO2*NO - r304*MALO2*NO - r307*MDIALO2*NO + - r310*PHENO2*NO - r317*TOLO2*NO - r323*XYLENO2*NO - r326*XYLOLO2*NO - r337*NTERPO2*NO + - r342*TERP2O2*NO - r347*TERPO2*NO - r444*O2p*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j20*ALKNIT + j46*HONITR + j49*ISOPNOOH + j55*MPAN + + j57*NC4CHO + j58*NOA + j59*NTERPOOH + j60*ONITR + .6*j61*PAN + j67*TERPNIT + j77*BRONO2 + + j96*CLONO2 + r62*M*HO2NO2 + r63*M*N2O5 + r195*M*PAN + r245*M*MPAN + r320*M*PBZNIT + + r37*HO2NO2*OH + r48*NO3*HO2 + 2*r49*NO3*NO + r50*NO3*O + r51*NO3*OH + r53*NO*HO2 + r54*NO*O3 + + r55*M*NO*O + r76*CLO*NO + r108*BRO*NO + r151*CH3O2*NO + r159*HOCH2OO*NO + r172*C2H5O2*NO + + r183*CH3CO3*NO + r187*EO2*NO + r200*C3H7O2*NO + r207*NOA*OH + r209*PO2*NO + r213*RO2*NO + + r217*BIGENE*NO3 + r219*ENEO2*NO + r225*MACRO2*NO3 + r226*MACRO2*NO + r235*MCO3*NO + + r236*MCO3*NO3 + r238*MEKO2*NO + r246*ALKNIT*OH + r248*ALKO2*NO + .92*r258*ISOPAO2*NO + + r259*ISOPAO2*NO3 + .92*r264*ISOPBO2*NO + r265*ISOPBO2*NO3 + .7*r266*ISOPNITA*OH + + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + r283*XO2*NO + r284*XO2*NO3 + r287*ACBZO2*NO + + r290*BENZO2*NO + r295*BZOO*NO + r297*C6H5O2*NO + r301*DICARBO2*NO + r304*MALO2*NO + + r307*MDIALO2*NO + r310*PHENO2*NO + r317*TOLO2*NO + r323*XYLENO2*NO + r326*XYLOLO2*NO + + .5*r335*NTERPO2*CH3O2 + 1.6*r337*NTERPO2*NO + 2*r338*NTERPO2*NO3 + .9*r342*TERP2O2*NO + + r344*TERPNIT*OH + .8*r347*TERPO2*NO + - j17*NO2 - r378*NO2 - r41*N*NO2 - r42*N*NO2 - r43*N*NO2 - r45*O*NO2 - r46*O3*NO2 + - r47*M*O*NO2 - r58*M*HO2*NO2 - r59*M*NO3*NO2 - r60*M*OH*NO2 - r78*M*CLO*NO2 - r109*M*BRO*NO2 + - r194*M*CH3CO3*NO2 - r244*M*MCO3*NO2 - r302*M*DICARBO2*NO2 - r305*M*MALO2*NO2 + - r308*M*MDIALO2*NO2 - r312*PHENO*NO2 - r315*M*ACBZO2*NO2 - r362*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j61*PAN + j78*BRONO2 + j95*CLONO2 + r63*M*N2O5 + + r46*NO2*O3 + r47*M*NO2*O + r61*HNO3*OH + r77*CLONO2*CL + r79*CLONO2*O + r80*CLONO2*OH + + r110*BRONO2*O + r124*F*HNO3 + r192*PAN*OH + .5*r241*M*MPAN*OH + - j18*NO3 - j19*NO3 - r379*NO3 - r48*HO2*NO3 - r49*NO*NO3 - r50*O*NO3 - r51*OH*NO3 + - r59*M*NO2*NO3 - r145*CH2O*NO3 - r177*CH3CHO*NO3 - r196*C3H6*NO3 - r203*CH3COCHO*NO3 + - r217*BIGENE*NO3 - r225*MACRO2*NO3 - r236*MCO3*NO3 - r259*ISOPAO2*NO3 - r265*ISOPBO2*NO3 + - r268*ISOP*NO3 - r273*ISOPNO3*NO3 - r284*XO2*NO3 - r329*BCARY*NO3 - r332*MTERP*NO3 + - r338*NTERPO2*NO3 - r349*TERPROD1*NO3 - r352*DMS*NO3 + d(NOA)/dt = r196*C3H6*NO3 + .5*r267*ISOPNITB*OH + r274*ISOPNOOH*OH + r278*NC4CH2OH*OH + r279*NC4CHO*OH + - j58*NOA - r207*OH*NOA + d(NTERPOOH)/dt = r336*NTERPO2*HO2 + - j59*NTERPOOH - r380*NTERPOOH - r339*OH*NTERPOOH + d(num_a1)/dt = 0 + d(num_a2)/dt = 0 + d(num_a3)/dt = 0 + d(num_a4)/dt = 0 + d(O)/dt = j2*H2O + 2*j5*O2 + j6*O2 + j8*O3 + j14*N2O5 + j15*NO + j17*NO2 + j18*NO3 + .18*j40*CH4 + + j42*CO2 + j76*BRO + j94*CLO + j108*OCLO + j110*CO2 + j127*O2 + j128*O2 + j129*O2 + j131*O2 + + j132*O2 + j133*O2 + 2*j134*O2 + 2*j135*O2 + j138*SO + j139*SO2 + j140*SO3 + r5*N2*O1D + + r6*O1D*O2 + r7*O1D*O2 + r24*H*HO2 + r34*OH*OH + r40*N*NO + r41*N*NO2 + r44*N*O2 + r356*S*O2 + + r363*SO*O2 + r433*NOp*e + 1.15*r434*O2p*e + r441*Np*O2 + r442*O2p*N + r447*Op*O2 + - j120*O - j121*O - j122*O - j123*O - j124*O - j125*O - r17*O3*O - 2*r18*M*O*O - r19*M*O2*O + - r20*H2*O - r21*H2O2*O - r26*HO2*O - r32*OH*O - r45*NO2*O - r47*M*NO2*O - r50*NO3*O + - r55*M*NO*O - r79*CLONO2*O - r81*CLO*O - r84*HCL*O - r87*HOCL*O - r110*BRONO2*O - r111*BRO*O + - r113*HBR*O - r115*HOBR*O - r146*CH2O*O - r354*OCS*O - r437*N2p*O - r438*N2p*O - r439*Np*O + d(O2)/dt = j8*O3 + j19*NO3 + r1*O2_1D + r2*O2_1S + r9*N2*O2_1D + r8*O1D*O3 + r8*O1D*O3 + r10*O2_1D*O + + 2*r11*O2_1D*O2 + 2*r17*O*O3 + r18*M*O*O + r22*H*HO2 + r26*HO2*O + 2*r27*HO2*O3 + r28*H*O3 + + r31*OH*HO2 + r32*OH*O + r33*OH*O3 + r36*HO2*HO2 + r37*HO2NO2*OH + r43*N*NO2 + r45*NO2*O + + r46*NO2*O3 + r48*NO3*HO2 + r50*NO3*O + r54*NO*O3 + r57*O1D*N2O + r68*CL*HO2 + r70*CL*O3 + + r72*CLO*CLO + r73*CLO*CLO + r75*CLO*HO2 + r81*CLO*O + r83*CLO*OH + r101*BR*HO2 + r102*BR*O3 + + r103*BRO*BRO + r105*BRO*CLO + r106*BRO*CLO + r107*BRO*HO2 + r111*BRO*O + r150*CH3O2*HO2 + + r171*C2H5O2*HO2 + r199*C3H7O2*HO2 + r208*PO2*HO2 + r358*S*O3 + r364*SO*O3 + r444*O2p*NO + - j5*O2 - j6*O2 - j126*O2 - j127*O2 - j128*O2 - j129*O2 - j130*O2 - j131*O2 - j132*O2 + - j133*O2 - j134*O2 - j135*O2 - r6*O1D*O2 - r11*O2_1D*O2 - r19*M*O*O2 - r25*M*H*O2 - r39*N2D*O2 + - r44*N*O2 - r189*EO*O2 - r356*S*O2 - r363*SO*O2 - r436*N2p*O2 - r440*Np*O2 - r441*Np*O2 + - r447*Op*O2 + d(O3)/dt = r19*M*O*O2 + .15*r182*CH3CO3*HO2 + .15*r233*MCO3*HO2 + - j7*O3 - j8*O3 - r8*O1D*O3 - r17*O*O3 - r27*HO2*O3 - r28*H*O3 - r33*OH*O3 - r46*NO2*O3 + - r54*NO*O3 - r70*CL*O3 - r102*BR*O3 - r168*C2H4*O3 - r197*C3H6*O3 - r228*MACR*O3 - r242*MVK*O3 + - r275*ISOP*O3 - r313*PHENO*O3 - r330*BCARY*O3 - r333*MTERP*O3 - r358*S*O3 - r364*SO*O3 + d(O3S)/dt = 0 + d(OCLO)/dt = r74*CLO*CLO + r104*BRO*CLO + - j108*OCLO - r365*SO*OCLO + d(OCS)/dt = - j137*OCS - r354*O*OCS - r355*OH*OCS + d(ONITR)/dt = r221*HONITR*OH + .1*r342*TERP2O2*NO + - j60*ONITR - r381*ONITR + d(PAN)/dt = r194*M*CH3CO3*NO2 + - j61*PAN - r195*M*PAN - r192*OH*PAN + d(PBZNIT)/dt = r315*M*ACBZO2*NO2 + - r320*M*PBZNIT + d(PHENO)/dt = j32*C6H5OOH + r297*C6H5O2*NO + .07*r299*CRESOL*OH + .06*r311*PHENOL*OH + .07*r327*XYLOL*OH + - r312*NO2*PHENO - r313*O3*PHENO + d(PHENOL)/dt = .53*r288*BENZENE*OH + - r311*OH*PHENOL + d(PHENOOH)/dt = r309*PHENO2*HO2 + - j62*PHENOOH - r314*OH*PHENOOH + d(pombb1_a1)/dt = 0 + d(pombb1_a4)/dt = 0 + d(pomff1_a1)/dt = 0 + d(pomff1_a4)/dt = 0 + d(POOH)/dt = r208*PO2*HO2 + - j63*POOH - r210*OH*POOH + d(ROOH)/dt = .85*r212*RO2*HO2 + - j64*ROOH - r214*OH*ROOH + d(S)/dt = j137*OCS + j138*SO + - r356*O2*S - r358*O3*S - r361*OH*S + d(SF6)/dt = - j109*SF6 + d(SO)/dt = j139*SO2 + r354*OCS*O + r356*S*O2 + r358*S*O3 + r361*S*OH + - j138*SO - r359*BRO*SO - r360*CLO*SO - r362*NO2*SO - r363*O2*SO - r364*O3*SO - r365*OCLO*SO + - r366*OH*SO + d(SO2)/dt = j140*SO3 + r352*DMS*NO3 + r353*DMS*OH + r355*OCS*OH + r359*SO*BRO + r360*SO*CLO + r362*SO*NO2 + + r363*SO*O2 + r364*SO*O3 + r365*SO*OCLO + r366*SO*OH + .5*r367*DMS*OH + - j139*SO2 - r357*M*OH*SO2 + d(SO3)/dt = j136*H2SO4 + r357*M*SO2*OH + - j140*SO3 - r368*H2O*SO3 + d(so4_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(so4_a3)/dt = 0 + d(soabb1_a1)/dt = - j141*soabb1_a1 + d(soabb1_a2)/dt = - j142*soabb1_a2 + d(soabb2_a1)/dt = - j143*soabb2_a1 + d(soabb2_a2)/dt = - j144*soabb2_a2 + d(soabb3_a1)/dt = - j145*soabb3_a1 + d(soabb3_a2)/dt = - j146*soabb3_a2 + d(soabb4_a1)/dt = - j147*soabb4_a1 + d(soabb4_a2)/dt = - j148*soabb4_a2 + d(soabb5_a1)/dt = - j149*soabb5_a1 + d(soabb5_a2)/dt = - j150*soabb5_a2 + d(soabg1_a1)/dt = - j151*soabg1_a1 + d(soabg1_a2)/dt = - j152*soabg1_a2 + d(soabg2_a1)/dt = - j153*soabg2_a1 + d(soabg2_a2)/dt = - j154*soabg2_a2 + d(soabg3_a1)/dt = - j155*soabg3_a1 + d(soabg3_a2)/dt = - j156*soabg3_a2 + d(soabg4_a1)/dt = - j157*soabg4_a1 + d(soabg4_a2)/dt = - j158*soabg4_a2 + d(soabg5_a1)/dt = - j159*soabg5_a1 + d(soabg5_a2)/dt = - j160*soabg5_a2 + d(soaff1_a1)/dt = - j161*soaff1_a1 + d(soaff1_a2)/dt = - j162*soaff1_a2 + d(soaff2_a1)/dt = - j163*soaff2_a1 + d(soaff2_a2)/dt = - j164*soaff2_a2 + d(soaff3_a1)/dt = - j165*soaff3_a1 + d(soaff3_a2)/dt = - j166*soaff3_a2 + d(soaff4_a1)/dt = - j167*soaff4_a1 + d(soaff4_a2)/dt = - j168*soaff4_a2 + d(soaff5_a1)/dt = - j169*soaff5_a1 + d(soaff5_a2)/dt = - j170*soaff5_a2 + d(SOAGbb0)/dt = .2381*r396*IVOCbbO2VBS*HO2 + .1056*r397*IVOCbbO2VBS*NO + .5931*r407*SVOCbb*OH + d(SOAGbb1)/dt = .1308*r396*IVOCbbO2VBS*HO2 + .1026*r397*IVOCbbO2VBS*NO + .1534*r407*SVOCbb*OH + d(SOAGbb2)/dt = .0348*r396*IVOCbbO2VBS*HO2 + .0521*r397*IVOCbbO2VBS*NO + .0459*r407*SVOCbb*OH + d(SOAGbb3)/dt = .0076*r396*IVOCbbO2VBS*HO2 + .0143*r397*IVOCbbO2VBS*NO + .0085*r407*SVOCbb*OH + d(SOAGbb4)/dt = .0113*r396*IVOCbbO2VBS*HO2 + .0166*r397*IVOCbbO2VBS*NO + .0128*r407*SVOCbb*OH + d(SOAGbg0)/dt = r412*GLYOXAL + .2202*r384*BCARYO2VBS*HO2 + .1279*r385*BCARYO2VBS*NO + .2202*r386*BCARY*O3 + + .0031*r392*ISOPO2VBS*HO2 + .0003*r393*ISOPO2VBS*NO + .0508*r403*MTERPO2VBS*HO2 + + .0245*r404*MTERPO2VBS*NO + .0508*r405*MTERP*O3 + d(SOAGbg1)/dt = .2067*r384*BCARYO2VBS*HO2 + .1792*r385*BCARYO2VBS*NO + .2067*r386*BCARY*O3 + + .0035*r392*ISOPO2VBS*HO2 + .0003*r393*ISOPO2VBS*NO + .1149*r403*MTERPO2VBS*HO2 + + .0082*r404*MTERPO2VBS*NO + .1149*r405*MTERP*O3 + d(SOAGbg2)/dt = .0653*r384*BCARYO2VBS*HO2 + .0676*r385*BCARYO2VBS*NO + .0653*r386*BCARY*O3 + + .0003*r392*ISOPO2VBS*HO2 + .0073*r393*ISOPO2VBS*NO + .0348*r403*MTERPO2VBS*HO2 + + .0772*r404*MTERPO2VBS*NO + .0348*r405*MTERP*O3 + d(SOAGbg3)/dt = .17493*r383*BCARY*NO3 + .1284*r384*BCARYO2VBS*HO2 + .079*r385*BCARYO2VBS*NO + + .1284*r386*BCARY*O3 + .059024*r391*ISOP*NO3 + .0271*r392*ISOPO2VBS*HO2 + + .0057*r393*ISOPO2VBS*NO + .0033*r394*ISOP*O3 + .17493*r402*MTERP*NO3 + + .0554*r403*MTERPO2VBS*HO2 + .0332*r404*MTERPO2VBS*NO + .0554*r405*MTERP*O3 + d(SOAGbg4)/dt = .59019*r383*BCARY*NO3 + .114*r384*BCARYO2VBS*HO2 + .1254*r385*BCARYO2VBS*NO + + .114*r386*BCARY*O3 + .025024*r391*ISOP*NO3 + .0474*r392*ISOPO2VBS*HO2 + + .0623*r393*ISOPO2VBS*NO + .59019*r402*MTERP*NO3 + .1278*r403*MTERPO2VBS*HO2 + + .13*r404*MTERPO2VBS*NO + .1278*r405*MTERP*O3 + d(SOAGff0)/dt = .0023*r389*BENZO2VBS*HO2 + .0097*r390*BENZO2VBS*NO + .2381*r399*IVOCffO2VBS*HO2 + + .1056*r400*IVOCffO2VBS*NO + .5931*r408*SVOCff*OH + .1364*r410*TOLUO2VBS*HO2 + + .0154*r411*TOLUO2VBS*NO + .1677*r414*XYLEO2VBS*HO2 + .0063*r415*XYLEO2VBS*NO + d(SOAGff1)/dt = .0008*r389*BENZO2VBS*HO2 + .0034*r390*BENZO2VBS*NO + .1308*r399*IVOCffO2VBS*HO2 + + .1026*r400*IVOCffO2VBS*NO + .1534*r408*SVOCff*OH + .0101*r410*TOLUO2VBS*HO2 + + .0452*r411*TOLUO2VBS*NO + .0174*r414*XYLEO2VBS*HO2 + .0237*r415*XYLEO2VBS*NO + d(SOAGff2)/dt = .0843*r389*BENZO2VBS*HO2 + .1579*r390*BENZO2VBS*NO + .0348*r399*IVOCffO2VBS*HO2 + + .0521*r400*IVOCffO2VBS*NO + .0459*r408*SVOCff*OH + .0763*r410*TOLUO2VBS*HO2 + + .0966*r411*TOLUO2VBS*NO + .086*r414*XYLEO2VBS*HO2 + .0025*r415*XYLEO2VBS*NO + d(SOAGff3)/dt = .0443*r389*BENZO2VBS*HO2 + .0059*r390*BENZO2VBS*NO + .0076*r399*IVOCffO2VBS*HO2 + + .0143*r400*IVOCffO2VBS*NO + .0085*r408*SVOCff*OH + .2157*r410*TOLUO2VBS*HO2 + + .0073*r411*TOLUO2VBS*NO + .0512*r414*XYLEO2VBS*HO2 + .011*r415*XYLEO2VBS*NO + d(SOAGff4)/dt = .1621*r389*BENZO2VBS*HO2 + .0536*r390*BENZO2VBS*NO + .0113*r399*IVOCffO2VBS*HO2 + + .0166*r400*IVOCffO2VBS*NO + .0128*r408*SVOCff*OH + .0738*r410*TOLUO2VBS*HO2 + + .238*r411*TOLUO2VBS*NO + .1598*r414*XYLEO2VBS*HO2 + .1185*r415*XYLEO2VBS*NO + d(ST80_25)/dt = - r451*ST80_25 + d(SVOCbb)/dt = - r407*OH*SVOCbb + d(SVOCff)/dt = - r408*OH*SVOCff + d(TEPOMUC)/dt = .1*r319*TOLUENE*OH + .23*r321*XYLENES*OH + - j65*TEPOMUC + d(TERP2OOH)/dt = r341*TERP2O2*HO2 + - j66*TERP2OOH - r343*OH*TERP2OOH + d(TERPNIT)/dt = .5*r335*NTERPO2*CH3O2 + .2*r337*NTERPO2*NO + .2*r347*TERPO2*NO + - j67*TERPNIT - r382*TERPNIT - r344*OH*TERPNIT + d(TERPOOH)/dt = r346*TERPO2*HO2 + - j68*TERPOOH - r348*OH*TERPOOH + d(TERPROD1)/dt = j59*NTERPOOH + j67*TERPNIT + j68*TERPOOH + .33*r330*BCARY*O3 + .33*r333*MTERP*O3 + + .5*r335*NTERPO2*CH3O2 + .8*r337*NTERPO2*NO + r338*NTERPO2*NO3 + r344*TERPNIT*OH + + r345*TERPO2*CH3O2 + .8*r347*TERPO2*NO + - j69*TERPROD1 - r349*NO3*TERPROD1 - r350*OH*TERPROD1 + d(TERPROD2)/dt = j66*TERP2OOH + j69*TERPROD1 + .3*r330*BCARY*O3 + .3*r333*MTERP*O3 + r340*TERP2O2*CH3O2 + + .9*r342*TERP2O2*NO + - j70*TERPROD2 - r351*OH*TERPROD2 + d(TOLOOH)/dt = r316*TOLO2*HO2 + - j71*TOLOOH - r318*OH*TOLOOH + d(TOLUENE)/dt = - r319*OH*TOLUENE - r409*OH*TOLUENE + d(TOLUO2VBS)/dt = r409*TOLUENE*OH + - r410*HO2*TOLUO2VBS - r411*NO*TOLUO2VBS + d(XOOH)/dt = r282*XO2*HO2 + - j72*XOOH - r285*OH*XOOH + d(XYLENES)/dt = - r321*OH*XYLENES + d(XYLENOOH)/dt = r322*XYLENO2*HO2 + - j73*XYLENOOH - r324*OH*XYLENOOH + d(XYLEO2VBS)/dt = r413*XYLENES*OH + - r414*HO2*XYLEO2VBS - r415*NO*XYLEO2VBS + d(XYLOL)/dt = .15*r321*XYLENES*OH + - r327*OH*XYLOL + d(XYLOLOOH)/dt = r325*XYLOLO2*HO2 + - j74*XYLOLOOH - r328*OH*XYLOLOOH + d(NHDEP)/dt = r377*NH4 + r369*NH3*OH + d(NDEP)/dt = .5*r241*M*MPAN*OH + r302*M*DICARBO2*NO2 + r305*M*MALO2*NO2 + r308*M*MDIALO2*NO2 + r312*PHENO*NO2 + + .2*r337*NTERPO2*NO + .5*r349*TERPROD1*NO3 + d(ACBZO2)/dt = r320*M*PBZNIT + r292*BZALD*OH + - r286*HO2*ACBZO2 - r287*NO*ACBZO2 - r315*M*NO2*ACBZO2 + d(ALKO2)/dt = r250*ALKOOH*OH + r251*BIGALK*OH + - r247*HO2*ALKO2 - r248*NO*ALKO2 - r249*NO*ALKO2 + d(BENZO2)/dt = .35*r288*BENZENE*OH + r291*BENZOOH*OH + - r289*HO2*BENZO2 - r290*NO*BENZO2 + d(BZOO)/dt = r294*BZOOH*OH + .07*r319*TOLUENE*OH + .06*r321*XYLENES*OH + - r293*HO2*BZOO - r295*NO*BZOO + d(C2H5O2)/dt = j53*MEK + .5*r174*C2H5OOH*OH + r175*C2H6*CL + r176*C2H6*OH + - 2*r169*C2H5O2*C2H5O2 - r170*CH3O2*C2H5O2 - r171*HO2*C2H5O2 - r172*NO*C2H5O2 + d(C3H7O2)/dt = r201*C3H7OOH*OH + r202*C3H8*OH + r205*CL*C3H8 + - r198*CH3O2*C3H7O2 - r199*HO2*C3H7O2 - r200*NO*C3H7O2 + d(C6H5O2)/dt = .4*r286*ACBZO2*HO2 + r287*ACBZO2*NO + r298*C6H5OOH*OH + r313*PHENO*O3 + - r296*HO2*C6H5O2 - r297*NO*C6H5O2 + d(CH3CO3)/dt = .13*j24*BIGALD + j28*BIGALD4 + j36*CH3COCH3 + j37*CH3COCHO + .33*j46*HONITR + j48*HYAC + + 1.34*j51*MACR + j53*MEK + j54*MEKOOH + .3*j56*MVK + j58*NOA + .6*j61*PAN + j64*ROOH + + .5*j65*TEPOMUC + .65*j70*TERPROD2 + r195*M*PAN + r177*CH3CHO*NO3 + r178*CH3CHO*OH + + .5*r185*CH3COOOH*OH + r203*CH3COCHO*NO3 + r204*CH3COCHO*OH + .3*r211*RO2*CH3O2 + + .15*r212*RO2*HO2 + r213*RO2*NO + .53*r222*MACRO2*CH3CO3 + .26*r223*MACRO2*CH3O2 + + .53*r225*MACRO2*NO3 + .53*r226*MACRO2*NO + .1*r228*MACR*O3 + r232*MCO3*CH3O2 + + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + r235*MCO3*NO + r236*MCO3*NO3 + .2*r237*MEKO2*HO2 + + r238*MEKO2*NO + .28*r242*MVK*O3 + .08*r275*ISOP*O3 + .06*r330*BCARY*O3 + .06*r333*MTERP*O3 + + .65*r351*TERPROD2*OH + - 2*r180*CH3CO3*CH3CO3 - r181*CH3O2*CH3CO3 - r182*HO2*CH3CO3 - r183*NO*CH3CO3 + - r194*M*NO2*CH3CO3 - r222*MACRO2*CH3CO3 - r255*ISOPAO2*CH3CO3 - r260*ISOPBO2*CH3CO3 + - r269*ISOPNO3*CH3CO3 - r280*XO2*CH3CO3 + d(CH3O2)/dt = j35*CH3CHO + j36*CH3COCH3 + j38*CH3COOOH + j41*CH4 + .3*j56*MVK + .4*j61*PAN + j88*CH3BR + + j90*CH3CL + r65*CL*CH4 + r121*F*CH4 + .7*r153*CH3OOH*OH + r154*CH4*OH + r160*O1D*CH4 + + 2*r180*CH3CO3*CH3CO3 + .9*r181*CH3CO3*CH3O2 + .45*r182*CH3CO3*HO2 + r183*CH3CO3*NO + + r184*CH3COOH*OH + .28*r197*C3H6*O3 + r222*MACRO2*CH3CO3 + r231*MCO3*CH3CO3 + + r255*ISOPAO2*CH3CO3 + r260*ISOPBO2*CH3CO3 + r269*ISOPNO3*CH3CO3 + .05*r275*ISOP*O3 + + r280*XO2*CH3CO3 + .33*r300*DICARBO2*HO2 + .83*r301*DICARBO2*NO + .07*r306*MDIALO2*HO2 + + .17*r307*MDIALO2*NO + - r71*CLO*CH3O2 - 2*r148*CH3O2*CH3O2 - 2*r149*CH3O2*CH3O2 - r150*HO2*CH3O2 - r151*NO*CH3O2 + - r170*C2H5O2*CH3O2 - r181*CH3CO3*CH3O2 - r198*C3H7O2*CH3O2 - r211*RO2*CH3O2 + - r223*MACRO2*CH3O2 - r232*MCO3*CH3O2 - r256*ISOPAO2*CH3O2 - r261*ISOPBO2*CH3O2 + - r270*ISOPNO3*CH3O2 - r281*XO2*CH3O2 - r335*NTERPO2*CH3O2 - r340*TERP2O2*CH3O2 + - r345*TERPO2*CH3O2 + d(DICARBO2)/dt = .6*j26*BIGALD2 + - r300*HO2*DICARBO2 - r301*NO*DICARBO2 - r302*M*NO2*DICARBO2 + d(e)/dt = j113*N2 + j114*N2 + j115*N2 + j116*N2 + j117*N2 + j119*N2 + j16*NO + j111*N + j120*O + j121*O + + j122*O + j123*O + j124*O + j125*O + j126*O2 + j127*O2 + j128*O2 + j129*O2 + j130*O2 + + j131*O2 + j132*O2 + j133*O2 + - r433*NOp*e - r434*O2p*e - r435*N2p*e + d(ENEO2)/dt = r218*BIGENE*OH + - r219*NO*ENEO2 - r220*NO*ENEO2 + d(EO)/dt = j43*EOOH + .75*r187*EO2*NO + - r188*EO - r189*O2*EO + d(EO2)/dt = r193*M*C2H4*OH + - r186*HO2*EO2 - r187*NO*EO2 + d(HO2)/dt = j11*HO2NO2 + j20*ALKNIT + .9*j21*ALKOOH + j22*BENZOOH + 1.5*j23*BEPOMUC + .56*j24*BIGALD + + j25*BIGALD1 + .6*j26*BIGALD2 + .6*j27*BIGALD3 + j28*BIGALD4 + j29*BZOOH + j30*C2H5OOH + + j31*C3H7OOH + j35*CH3CHO + j37*CH3COCHO + 2*j44*GLYALD + 2*j45*GLYOXAL + .67*j46*HONITR + + j47*HPALD + j48*HYAC + j49*ISOPNOOH + j50*ISOPOOH + 1.34*j51*MACR + .66*j52*MACR + j57*NC4CHO + + j62*PHENOOH + j63*POOH + j65*TEPOMUC + j66*TERP2OOH + j67*TERPNIT + j68*TERPOOH + + j69*TERPROD1 + 1.2*j70*TERPROD2 + j71*TOLOOH + j73*XYLENOOH + j74*XYLOLOOH + r62*M*HO2NO2 + + r158*HOCH2OO + r188*EO + r263*ISOPBO2 + r21*H2O2*O + r25*M*H*O2 + r30*OH*H2O2 + r33*OH*O3 + + r51*NO3*OH + r64*CL*CH2O + r67*CL*H2O2 + r71*CLO*CH3O2 + r82*CLO*OH + r100*BR*CH2O + + r112*BRO*OH + r129*CH3BR*CL + r130*CH3BR*OH + r132*CH3CL*CL + r133*CH3CL*OH + r145*CH2O*NO3 + + r146*CH2O*O + 2*r148*CH3O2*CH3O2 + r151*CH3O2*NO + r152*CH3OH*OH + r155*M*HCN*OH + + r156*HCOOH*OH + r159*HOCH2OO*NO + r161*O1D*CH4 + r164*CO*OH + .35*r166*M*C2H2*OH + + .13*r168*C2H4*O3 + 1.2*r169*C2H5O2*C2H5O2 + r170*C2H5O2*CH3O2 + r172*C2H5O2*NO + r173*C2H5OH*OH + + r179*CH3CN*OH + .9*r181*CH3CO3*CH3O2 + .25*r187*EO2*NO + r189*EO*O2 + r190*GLYALD*OH + + r191*GLYOXAL*OH + .28*r197*C3H6*O3 + r198*C3H7O2*CH3O2 + r200*C3H7O2*NO + r206*HYAC*OH + + r209*PO2*NO + .3*r211*RO2*CH3O2 + r219*ENEO2*NO + r221*HONITR*OH + .47*r222*MACRO2*CH3CO3 + + .73*r223*MACRO2*CH3O2 + .47*r225*MACRO2*NO3 + .47*r226*MACRO2*NO + .14*r228*MACR*O3 + + .2*r230*MACROOH*OH + r232*MCO3*CH3O2 + .5*r241*M*MPAN*OH + .28*r242*MVK*O3 + r248*ALKO2*NO + + r255*ISOPAO2*CH3CO3 + r256*ISOPAO2*CH3O2 + .92*r258*ISOPAO2*NO + r259*ISOPAO2*NO3 + + r260*ISOPBO2*CH3CO3 + r261*ISOPBO2*CH3O2 + .92*r264*ISOPBO2*NO + r265*ISOPBO2*NO3 + + .3*r266*ISOPNITA*OH + r267*ISOPNITB*OH + r269*ISOPNO3*CH3CO3 + 1.2*r270*ISOPNO3*CH3O2 + + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + r274*ISOPNOOH*OH + .37*r275*ISOP*O3 + r278*NC4CH2OH*OH + + r279*NC4CHO*OH + r280*XO2*CH3CO3 + .8*r281*XO2*CH3O2 + r283*XO2*NO + r284*XO2*NO3 + + .65*r288*BENZENE*OH + r290*BENZO2*NO + r295*BZOO*NO + .73*r299*CRESOL*OH + + .07*r300*DICARBO2*HO2 + .17*r301*DICARBO2*NO + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + + .33*r306*MDIALO2*HO2 + .83*r307*MDIALO2*NO + r310*PHENO2*NO + .8*r311*PHENOL*OH + r317*TOLO2*NO + + .28*r319*TOLUENE*OH + .38*r321*XYLENES*OH + r323*XYLENO2*NO + r326*XYLOLO2*NO + + .63*r327*XYLOL*OH + .57*r330*BCARY*O3 + .57*r333*MTERP*O3 + .5*r335*NTERPO2*CH3O2 + + r340*TERP2O2*CH3O2 + .9*r342*TERP2O2*NO + r345*TERPO2*CH3O2 + .8*r347*TERPO2*NO + + .2*r351*TERPROD2*OH + r357*M*SO2*OH + .5*r367*DMS*OH + - r370*HO2 - r22*H*HO2 - r23*H*HO2 - r24*H*HO2 - r26*O*HO2 - r27*O3*HO2 - r31*OH*HO2 + - 2*r36*HO2*HO2 - r48*NO3*HO2 - r53*NO*HO2 - r58*M*NO2*HO2 - r68*CL*HO2 - r69*CL*HO2 + - r75*CLO*HO2 - r101*BR*HO2 - r107*BRO*HO2 - r144*CH2O*HO2 - r150*CH3O2*HO2 - r157*HOCH2OO*HO2 + - r171*C2H5O2*HO2 - r182*CH3CO3*HO2 - r186*EO2*HO2 - r199*C3H7O2*HO2 - r208*PO2*HO2 + - r212*RO2*HO2 - r224*MACRO2*HO2 - r233*MCO3*HO2 - r237*MEKO2*HO2 - r247*ALKO2*HO2 + - r257*ISOPAO2*HO2 - r262*ISOPBO2*HO2 - r271*ISOPNO3*HO2 - r282*XO2*HO2 - r286*ACBZO2*HO2 + - r289*BENZO2*HO2 - r293*BZOO*HO2 - r296*C6H5O2*HO2 - r300*DICARBO2*HO2 - r303*MALO2*HO2 + - r306*MDIALO2*HO2 - r309*PHENO2*HO2 - r316*TOLO2*HO2 - r322*XYLENO2*HO2 - r325*XYLOLO2*HO2 + - r336*NTERPO2*HO2 - r341*TERP2O2*HO2 - r346*TERPO2*HO2 + d(HOCH2OO)/dt = r144*CH2O*HO2 + - r158*HOCH2OO - r157*HO2*HOCH2OO - r159*NO*HOCH2OO + d(ISOPAO2)/dt = .6*r276*ISOP*OH + - r255*CH3CO3*ISOPAO2 - r256*CH3O2*ISOPAO2 - r257*HO2*ISOPAO2 - r258*NO*ISOPAO2 + - r259*NO3*ISOPAO2 + d(ISOPBO2)/dt = .4*r276*ISOP*OH + - r263*ISOPBO2 - r260*CH3CO3*ISOPBO2 - r261*CH3O2*ISOPBO2 - r262*HO2*ISOPBO2 + - r264*NO*ISOPBO2 - r265*NO3*ISOPBO2 + d(MACRO2)/dt = .5*r229*MACR*OH + .2*r230*MACROOH*OH + r243*MVK*OH + - r222*CH3CO3*MACRO2 - r223*CH3O2*MACRO2 - r224*HO2*MACRO2 - r225*NO3*MACRO2 - r226*NO*MACRO2 + - r227*NO*MACRO2 + d(MALO2)/dt = .6*j25*BIGALD1 + - r303*HO2*MALO2 - r304*NO*MALO2 - r305*M*NO2*MALO2 + d(MCO3)/dt = .66*j51*MACR + j55*MPAN + r245*M*MPAN + .5*r229*MACR*OH + .5*r230*MACROOH*OH + - r231*CH3CO3*MCO3 - r232*CH3O2*MCO3 - r233*HO2*MCO3 - 2*r234*MCO3*MCO3 - r235*NO*MCO3 + - r236*NO3*MCO3 - r244*M*NO2*MCO3 + d(MDIALO2)/dt = .6*j27*BIGALD3 + - r306*HO2*MDIALO2 - r307*NO*MDIALO2 - r308*M*NO2*MDIALO2 + d(MEKO2)/dt = r239*MEK*OH + r240*MEKOOH*OH + - r237*HO2*MEKO2 - r238*NO*MEKO2 + d(N2D)/dt = 1.2*j112*N2 + j113*N2 + j117*N2 + 1.2*j118*N2 + .8*r433*NOp*e + .9*r435*N2p*e + r437*N2p*O + - r38*O*N2D - r39*O2*N2D + d(N2p)/dt = j114*N2 + j119*N2 + - r435*e*N2p - r436*O2*N2p - r437*O*N2p - r438*O*N2p + d(NOp)/dt = j16*NO + r443*N2*O2p + r446*N2*Op + r437*N2p*O + r441*Np*O2 + r442*O2p*N + r444*O2p*NO + - r433*e*NOp + d(Np)/dt = j113*N2 + j115*N2 + j116*N2 + j117*N2 + j111*N + - r439*O*Np - r440*O2*Np - r441*O2*Np + d(NTERPO2)/dt = r329*BCARY*NO3 + r332*MTERP*NO3 + r339*NTERPOOH*OH + .5*r349*TERPROD1*NO3 + - r335*CH3O2*NTERPO2 - r336*HO2*NTERPO2 - r337*NO*NTERPO2 - r338*NO3*NTERPO2 + d(O1D)/dt = j1*H2O + j6*O2 + j7*O3 + j12*N2O + r39*N2D*O2 + .85*r434*O2p*e + - r5*N2*O1D - r3*H2*O1D - r4*H2O*O1D - r6*O2*O1D - r7*O2*O1D - r8*O3*O1D - r56*N2O*O1D + - r57*N2O*O1D - r89*CCL4*O1D - r90*CF2CLBR*O1D - r91*CFC11*O1D - r92*CFC113*O1D - r93*CFC114*O1D + - r94*CFC115*O1D - r95*CFC12*O1D - r96*HCL*O1D - r97*HCL*O1D - r116*CF3BR*O1D - r117*CHBR3*O1D + - r118*H2402*O1D - r119*HBR*O1D - r120*HBR*O1D - r125*COF2*O1D - r126*COFCL*O1D + - r139*CH2BR2*O1D - r140*CH3BR*O1D - r141*HCFC141B*O1D - r142*HCFC142B*O1D - r143*HCFC22*O1D + - r160*CH4*O1D - r161*CH4*O1D - r162*CH4*O1D - r163*HCN*O1D + d(O2_1D)/dt = j7*O3 + r13*N2*O2_1S + r12*O2_1S*CO2 + r14*O2_1S*O + r15*O2_1S*O2 + r16*O2_1S*O3 + - r1*O2_1D - r9*N2*O2_1D - r10*O*O2_1D - r11*O2*O2_1D + d(O2_1S)/dt = r6*O1D*O2 + - r2*O2_1S - r13*N2*O2_1S - r12*CO2*O2_1S - r14*O*O2_1S - r15*O2*O2_1S - r16*O3*O2_1S + d(O2p)/dt = j126*O2 + j130*O2 + r436*N2p*O2 + r440*Np*O2 + r445*Op*CO2 + r447*Op*O2 + - r443*N2*O2p - r434*e*O2p - r442*N*O2p - r444*NO*O2p + d(OH)/dt = j3*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j21*ALKOOH + j22*BENZOOH + j29*BZOOH + j30*C2H5OOH + + j31*C3H7OOH + j32*C6H5OOH + j38*CH3COOOH + j39*CH3OOH + .33*j40*CH4 + j43*EOOH + j47*HPALD + + j50*ISOPOOH + j54*MEKOOH + j59*NTERPOOH + j62*PHENOOH + j63*POOH + j64*ROOH + j66*TERP2OOH + + j68*TERPOOH + j71*TOLOOH + j72*XOOH + j73*XYLENOOH + j74*XYLOLOOH + j106*HOBR + j107*HOCL + + .5*r378*NO2 + r3*O1D*H2 + 2*r4*O1D*H2O + r20*H2*O + r21*H2O2*O + 2*r23*H*HO2 + r26*HO2*O + + r27*HO2*O3 + r28*H*O3 + r48*NO3*HO2 + r53*NO*HO2 + r69*CL*HO2 + r84*HCL*O + r87*HOCL*O + + r96*O1D*HCL + r113*HBR*O + r115*HOBR*O + r119*O1D*HBR + r123*F*H2O + r146*CH2O*O + + .3*r153*CH3OOH*OH + r160*O1D*CH4 + r163*O1D*HCN + .65*r166*M*C2H2*OH + .13*r168*C2H4*O3 + + .5*r174*C2H5OOH*OH + .45*r182*CH3CO3*HO2 + .36*r197*C3H6*O3 + .5*r210*POOH*OH + .15*r212*RO2*HO2 + + .24*r228*MACR*O3 + .1*r230*MACROOH*OH + .45*r233*MCO3*HO2 + .2*r237*MEKO2*HO2 + .36*r242*MVK*O3 + + .32*r275*ISOP*O3 + .6*r277*ISOPOOH*OH + .5*r285*XOOH*OH + .4*r286*ACBZO2*HO2 + + .4*r300*DICARBO2*HO2 + .4*r306*MDIALO2*HO2 + .63*r330*BCARY*O3 + .63*r333*MTERP*O3 + - r29*H2*OH - r30*H2O2*OH - r31*HO2*OH - r32*O*OH - r33*O3*OH - 2*r34*OH*OH - 2*r35*M*OH*OH + - r37*HO2NO2*OH - r51*NO3*OH - r52*N*OH - r60*M*NO2*OH - r61*HNO3*OH - r80*CLONO2*OH + - r82*CLO*OH - r83*CLO*OH - r85*HCL*OH - r88*HOCL*OH - r112*BRO*OH - r114*HBR*OH + - r128*CH2BR2*OH - r130*CH3BR*OH - r131*CH3CCL3*OH - r133*CH3CL*OH - r135*CHBR3*OH + - r136*HCFC141B*OH - r137*HCFC142B*OH - r138*HCFC22*OH - r147*CH2O*OH - r152*CH3OH*OH + - r153*CH3OOH*OH - r154*CH4*OH - r155*M*HCN*OH - r156*HCOOH*OH - r164*CO*OH - r166*M*C2H2*OH + - r173*C2H5OH*OH - r174*C2H5OOH*OH - r176*C2H6*OH - r178*CH3CHO*OH - r179*CH3CN*OH + - r184*CH3COOH*OH - r185*CH3COOOH*OH - r190*GLYALD*OH - r191*GLYOXAL*OH - r192*PAN*OH + - r193*M*C2H4*OH - r201*C3H7OOH*OH - r202*C3H8*OH - r204*CH3COCHO*OH - r206*HYAC*OH - r207*NOA*OH + - r210*POOH*OH - r214*ROOH*OH - r215*M*C3H6*OH - r216*CH3COCH3*OH - r218*BIGENE*OH + - r221*HONITR*OH - r229*MACR*OH - r230*MACROOH*OH - r239*MEK*OH - r240*MEKOOH*OH - r241*M*MPAN*OH + - r243*MVK*OH - r246*ALKNIT*OH - r250*ALKOOH*OH - r251*BIGALK*OH - r252*HPALD*OH + - r253*HYDRALD*OH - r254*IEPOX*OH - r266*ISOPNITA*OH - r267*ISOPNITB*OH - r274*ISOPNOOH*OH + - r276*ISOP*OH - r277*ISOPOOH*OH - r278*NC4CH2OH*OH - r279*NC4CHO*OH - r285*XOOH*OH + - r288*BENZENE*OH - r291*BENZOOH*OH - r292*BZALD*OH - r294*BZOOH*OH - r298*C6H5OOH*OH + - r299*CRESOL*OH - r311*PHENOL*OH - r314*PHENOOH*OH - r318*TOLOOH*OH - r319*TOLUENE*OH + - r321*XYLENES*OH - r324*XYLENOOH*OH - r327*XYLOL*OH - r328*XYLOLOOH*OH - r331*BCARY*OH + - r334*MTERP*OH - r339*NTERPOOH*OH - r343*TERP2OOH*OH - r344*TERPNIT*OH - r348*TERPOOH*OH + - r350*TERPROD1*OH - r351*TERPROD2*OH - r353*DMS*OH - r355*OCS*OH - r357*M*SO2*OH - r361*S*OH + - r366*SO*OH - r367*DMS*OH - r369*NH3*OH - r409*TOLUENE*OH + d(Op)/dt = j120*O + j121*O + j122*O + j123*O + j124*O + j125*O + j127*O2 + j128*O2 + j129*O2 + j131*O2 + + j132*O2 + j133*O2 + r438*N2p*O + r439*Np*O + - r446*N2*Op - r445*CO2*Op - r447*O2*Op + d(PHENO2)/dt = .2*r299*CRESOL*OH + .14*r311*PHENOL*OH + r314*PHENOOH*OH + - r309*HO2*PHENO2 - r310*NO*PHENO2 + d(PO2)/dt = .5*r210*POOH*OH + r215*M*C3H6*OH + - r208*HO2*PO2 - r209*NO*PO2 + d(RO2)/dt = .15*j70*TERPROD2 + r214*ROOH*OH + r216*CH3COCH3*OH + .06*r330*BCARY*O3 + .06*r333*MTERP*O3 + + .15*r351*TERPROD2*OH + - r211*CH3O2*RO2 - r212*HO2*RO2 - r213*NO*RO2 + d(TERP2O2)/dt = r343*TERP2OOH*OH + .5*r349*TERPROD1*NO3 + r350*TERPROD1*OH + - r340*CH3O2*TERP2O2 - r341*HO2*TERP2O2 - r342*NO*TERP2O2 + d(TERPO2)/dt = r331*BCARY*OH + r334*MTERP*OH + r348*TERPOOH*OH + - r345*CH3O2*TERPO2 - r346*HO2*TERPO2 - r347*NO*TERPO2 + d(TOLO2)/dt = r318*TOLOOH*OH + .65*r319*TOLUENE*OH + r409*TOLUENE*OH + - r316*HO2*TOLO2 - r317*NO*TOLO2 + d(XO2)/dt = r252*HPALD*OH + r253*HYDRALD*OH + r254*IEPOX*OH + .4*r277*ISOPOOH*OH + .5*r285*XOOH*OH + - r280*CH3CO3*XO2 - r281*CH3O2*XO2 - r282*HO2*XO2 - r283*NO*XO2 - r284*NO3*XO2 + d(XYLENO2)/dt = .56*r321*XYLENES*OH + r324*XYLENOOH*OH + - r322*HO2*XYLENO2 - r323*NO*XYLENO2 + d(XYLOLO2)/dt = .3*r327*XYLOL*OH + r328*XYLOLOOH*OH + - r325*HO2*XYLOLO2 - r326*NO*XYLOLO2 + d(H2O)/dt = .05*j40*CH4 + j136*H2SO4 + r370*HO2 + r24*H*HO2 + r29*OH*H2 + r30*OH*H2O2 + r31*OH*HO2 + + r34*OH*OH + r37*HO2NO2*OH + r61*HNO3*OH + r85*HCL*OH + r88*HOCL*OH + r114*HBR*OH + + r128*CH2BR2*OH + r130*CH3BR*OH + r131*CH3CCL3*OH + r133*CH3CL*OH + r138*HCFC22*OH + + r147*CH2O*OH + r153*CH3OOH*OH + r154*CH4*OH + r156*HCOOH*OH + r176*C2H6*OH + r178*CH3CHO*OH + + r184*CH3COOH*OH + r185*CH3COOOH*OH + r201*C3H7OOH*OH + r202*C3H8*OH + r204*CH3COCHO*OH + + r210*POOH*OH + r214*ROOH*OH + r216*CH3COCH3*OH + .5*r229*MACR*OH + r369*NH3*OH + r417*HOCL*HCL + + r423*HOCL*HCL + r424*HOBR*HCL + r428*HOCL*HCL + r429*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r4*O1D*H2O - r123*F*H2O - r368*SO3*H2O diff --git a/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/chem_mech.in b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/chem_mech.in new file mode 100644 index 0000000000..f1a89a1376 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/chem_mech.in @@ -0,0 +1,1384 @@ +* Comments +* User-given Tag Description: TSMLT1.2-MAM4-extendedVBS +* Tag database identifier : MZ325_TSMLT1_fullVBS_20221223 +* Tag created by : lke +* Tag created from branch : TSMLT1-fullVBS +* Tag created on : 2022-12-22 17:04:17.603803-07 +* Comments for this tag follow: +* lke : 2022-12-22 : TSMLT1.2, updated to JPL19; MAM4; VBS-SOA for sectors + + SPECIES + + Solution + ALKNIT -> C5H11ONO2, + ALKOOH -> C5H12O2, + AOA_NH -> CO, + bc_a1 -> C, + bc_a4 -> C, + BCARY -> C15H24, + BCARYO2VBS -> C15H25O3, + BENZENE -> C6H6, + BENZO2VBS -> C6H7O5, + BENZOOH -> C6H8O5, + BEPOMUC -> C6H6O3, + BIGALD -> C5H6O2, + BIGALD1 -> C4H4O2, + BIGALD2 -> C5H6O2, + BIGALD3 -> C5H6O2, + BIGALD4 -> C6H8O2, + BIGALK -> C5H12, + BIGENE -> C4H8, + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + BZALD -> C7H6O, + BZOOH -> C7H8O2, + C2H2, + C2H4, + C2H5OH, + C2H5OOH, + C2H6, + C3H6, + C3H7OOH, + C3H8, + C6H5OOH -> C6H5OOH, + 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, + CH3CN, + CH3COCH3, + CH3COCHO, + CH3COOH, + CH3COOOH, + CH3OH, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + COF2, + COFCL -> COFCl, + CRESOL -> C7H8O, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + E90 -> CO, + EOOH -> HOCH2CH2OOH, + F, + GLYALD -> HOCH2CHO, + GLYOXAL -> C2H2O2, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HCN, + HCOOH, + HF, + HNO3, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + HONITR -> C4H9NO4, + HPALD -> HOOCH2CCH3CHCHO, + HYAC -> CH3COCH2OH, + HYDRALD -> HOCH2CCH3CHCHO, + IEPOX -> C5H10O3, + ISOP -> C5H8, + ISOPNITA -> C5H9NO4, + ISOPNITB -> C5H9NO4, + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, + ISOPNOOH -> C5H9NO5, + ISOPO2VBS -> C5H9O3, + ISOPOOH -> HOCH2COOHCH3CHCH2, + IVOCbb -> C13H28, + IVOCbbO2VBS -> C13H29O3, + IVOCff -> C13H28, + IVOCffO2VBS -> C13H29O3, + MACR -> CH2CCH3CHO, + MACROOH -> CH3COCHOOHCH2OH, + MEK -> C4H8O, + MEKOOH -> C4H8O3, + MPAN -> CH2CCH3CO3NO2, + MTERP -> C10H16, + MTERPO2VBS -> C10H17O3, + MVK -> CH2CHCOCH3, + N, + N2O, + N2O5, + NC4CH2OH -> C5H9NO4, + NC4CHO -> C5H7NO4, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + NH3, + NH4, + NH_5 -> CO, + NH_50 -> CO, + NO, + NO2, + NO3, + NOA -> CH3COCH2ONO2, + NTERPOOH -> C10H17NO5, + num_a1 -> H, + num_a2 -> H, + num_a3 -> H, + num_a4 -> H, + O, + O2, + O3, + O3S -> O3, + OCLO -> OClO, + OCS -> OCS, + ONITR -> C4H7NO4, + PAN -> CH3CO3NO2, + PBZNIT -> C7H5O3NO2, + PHENO -> C6H5O, + PHENOL -> C6H5OH, + PHENOOH -> C6H8O6, + pombb1_a1 -> C, + pombb1_a4 -> C, + pomff1_a1 -> C, + pomff1_a4 -> C, + POOH -> C3H6OHOOH, + ROOH -> CH3COCH2OOH, + S -> S, + SF6, + SO -> SO, + SO2, + SO3 -> SO3, + so4_a1 -> NH4HSO4, + so4_a2 -> NH4HSO4, + so4_a3 -> NH4HSO4, + soabb1_a1 -> C15H38O2, + soabb1_a2 -> C15H38O2, + soabb2_a1 -> C15H38O2, + soabb2_a2 -> C15H38O2, + soabb3_a1 -> C15H38O2, + soabb3_a2 -> C15H38O2, + soabb4_a1 -> C15H38O2, + soabb4_a2 -> C15H38O2, + soabb5_a1 -> C15H38O2, + soabb5_a2 -> C15H38O2, + soabg1_a1 -> C15H38O2, + soabg1_a2 -> C15H38O2, + soabg2_a1 -> C15H38O2, + soabg2_a2 -> C15H38O2, + soabg3_a1 -> C15H38O2, + soabg3_a2 -> C15H38O2, + soabg4_a1 -> C15H38O2, + soabg4_a2 -> C15H38O2, + soabg5_a1 -> C15H38O2, + soabg5_a2 -> C15H38O2, + soaff1_a1 -> C15H38O2, + soaff1_a2 -> C15H38O2, + soaff2_a1 -> C15H38O2, + soaff2_a2 -> C15H38O2, + soaff3_a1 -> C15H38O2, + soaff3_a2 -> C15H38O2, + soaff4_a1 -> C15H38O2, + soaff4_a2 -> C15H38O2, + soaff5_a1 -> C15H38O2, + soaff5_a2 -> C15H38O2, + SOAGbb0 -> C15H38O2, + SOAGbb1 -> C15H38O2, + SOAGbb2 -> C15H38O2, + SOAGbb3 -> C15H38O2, + SOAGbb4 -> C15H38O2, + SOAGbg0 -> C15H38O2, + SOAGbg1 -> C15H38O2, + SOAGbg2 -> C15H38O2, + SOAGbg3 -> C15H38O2, + SOAGbg4 -> C15H38O2, + SOAGff0 -> C15H38O2, + SOAGff1 -> C15H38O2, + SOAGff2 -> C15H38O2, + SOAGff3 -> C15H38O2, + SOAGff4 -> C15H38O2, + ST80_25 -> CO, + SVOCbb -> C22H46, + SVOCff -> C22H46, + TEPOMUC -> C7H8O3, + TERP2OOH -> C10H16O4, + TERPNIT -> C10H17NO4, + TERPOOH -> C10H18O3, + TERPROD1 -> C10H16O2, + TERPROD2 -> C9H14O2, + TOLOOH -> C7H10O5, + TOLUENE -> C7H8, + TOLUO2VBS -> C7H9O5, + XOOH -> HOCH2COOHCH3CHOHCHO, + XYLENES -> C8H10, + XYLENOOH -> C8H12O5, + XYLEO2VBS -> C8H11O5, + XYLOL -> C8H10O, + XYLOLOOH -> C8H12O6, + NHDEP -> N, + NDEP -> N, + ACBZO2 -> C7H5O3, + ALKO2 -> C5H11O2, + BENZO2 -> C6H7O5, + BZOO -> C7H7O2, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2 -> C5H5O4, + e -> E, + ENEO2 -> C4H9O3, + EO -> HOCH2CH2O, + EO2 -> HOCH2CH2O2, + HO2, + HOCH2OO, + ISOPAO2 -> HOC5H8O2, + ISOPBO2 -> HOC5H8O2, + MACRO2 -> CH3COCHO2CH2OH, + MALO2 -> C4H3O4, + MCO3 -> CH2CCH3CO3, + MDIALO2 -> C4H5O4, + MEKO2 -> C4H7O3, + N2D -> N, + N2p -> N2, + NOp -> NO, + Np -> N, + NTERPO2 -> C10H16NO5, + O1D -> O, + O2_1D -> O2, + O2_1S -> O2, + O2p -> O2, + OH, + Op -> O, + PHENO2 -> C6H7O6, + PO2 -> C3H6OHO2, + RO2 -> CH3COCH2O2, + TERP2O2 -> C10H15O4, + TERPO2 -> C10H17O3, + TOLO2 -> C7H9O5, + XO2 -> HOCH2COOCH3CHOHCHO, + XYLENO2 -> C8H11O5, + XYLOLO2 -> C8H11O6, + H2O + + End Solution + + + Fixed + M, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + ACBZO2, + ALKO2, + BENZO2, + BZOO, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2, + e, + ENEO2, + EO, + EO2, + HO2, + HOCH2OO, + ISOPAO2, + ISOPBO2, + MACRO2, + MALO2, + MCO3, + MDIALO2, + MEKO2, + N2D, + N2p, + NOp, + Np, + NTERPO2, + O1D, + O2_1D, + O2_1S, + O2p, + OH, + Op, + PHENO2, + PO2, + RO2, + TERP2O2, + TERPO2, + TOLO2, + XO2, + XYLENO2, + XYLOLO2 + End Not-Transported + + END Species + + + Solution classes + Explicit + NHDEP + NDEP + End Explicit + + Implicit + ALKNIT + ALKOOH + AOA_NH + bc_a1 + bc_a4 + BCARY + BCARYO2VBS + BENZENE + BENZO2VBS + BENZOOH + BEPOMUC + BIGALD + BIGALD1 + BIGALD2 + BIGALD3 + BIGALD4 + BIGALK + BIGENE + BR + BRCL + BRO + BRONO2 + BRY + BZALD + BZOOH + C2H2 + C2H4 + C2H5OH + C2H5OOH + C2H6 + C3H6 + C3H7OOH + C3H8 + C6H5OOH + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH2O + CH3BR + CH3CCL3 + CH3CHO + CH3CL + CH3CN + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CH4 + CHBR3 + CL + CL2 + CL2O2 + CLO + CLONO2 + CLY + CO + CO2 + COF2 + COFCL + CRESOL + DMS + dst_a1 + dst_a2 + dst_a3 + E90 + EOOH + F + GLYALD + GLYOXAL + H + H2 + H2402 + H2O2 + H2SO4 + HBR + HCFC141B + HCFC142B + HCFC22 + HCL + HCN + HCOOH + HF + HNO3 + HO2NO2 + HOBR + HOCL + HONITR + HPALD + HYAC + HYDRALD + IEPOX + ISOP + ISOPNITA + ISOPNITB + ISOPNO3 + ISOPNOOH + ISOPO2VBS + ISOPOOH + IVOCbb + IVOCbbO2VBS + IVOCff + IVOCffO2VBS + MACR + MACROOH + MEK + MEKOOH + MPAN + MTERP + MTERPO2VBS + MVK + N + N2O + N2O5 + NC4CH2OH + NC4CHO + ncl_a1 + ncl_a2 + ncl_a3 + NH3 + NH4 + NH_5 + NH_50 + NO + NO2 + NO3 + NOA + NTERPOOH + num_a1 + num_a2 + num_a3 + num_a4 + O + O2 + O3 + O3S + OCLO + OCS + ONITR + PAN + PBZNIT + PHENO + PHENOL + PHENOOH + pombb1_a1 + pombb1_a4 + pomff1_a1 + pomff1_a4 + POOH + ROOH + S + SF6 + SO + SO2 + SO3 + so4_a1 + so4_a2 + so4_a3 + soabb1_a1 + soabb1_a2 + soabb2_a1 + soabb2_a2 + soabb3_a1 + soabb3_a2 + soabb4_a1 + soabb4_a2 + soabb5_a1 + soabb5_a2 + soabg1_a1 + soabg1_a2 + soabg2_a1 + soabg2_a2 + soabg3_a1 + soabg3_a2 + soabg4_a1 + soabg4_a2 + soabg5_a1 + soabg5_a2 + soaff1_a1 + soaff1_a2 + soaff2_a1 + soaff2_a2 + soaff3_a1 + soaff3_a2 + soaff4_a1 + soaff4_a2 + soaff5_a1 + soaff5_a2 + SOAGbb0 + SOAGbb1 + SOAGbb2 + SOAGbb3 + SOAGbb4 + SOAGbg0 + SOAGbg1 + SOAGbg2 + SOAGbg3 + SOAGbg4 + SOAGff0 + SOAGff1 + SOAGff2 + SOAGff3 + SOAGff4 + ST80_25 + SVOCbb + SVOCff + TEPOMUC + TERP2OOH + TERPNIT + TERPOOH + TERPROD1 + TERPROD2 + TOLOOH + TOLUENE + TOLUO2VBS + XOOH + XYLENES + XYLENOOH + XYLEO2VBS + XYLOL + XYLOLOOH + ACBZO2 + ALKO2 + BENZO2 + BZOO + C2H5O2 + C3H7O2 + C6H5O2 + CH3CO3 + CH3O2 + DICARBO2 + e + ENEO2 + EO + EO2 + HO2 + HOCH2OO + ISOPAO2 + ISOPBO2 + MACRO2 + MALO2 + MCO3 + MDIALO2 + MEKO2 + N2D + N2p + NOp + Np + NTERPO2 + O1D + O2_1D + O2_1S + O2p + OH + Op + PHENO2 + PO2 + RO2 + TERP2O2 + TERPO2 + TOLO2 + XO2 + XYLENO2 + XYLOLO2 + H2O + End Implicit + + End Solution classes + + + CHEMISTRY + Photolysis +********************************* +*** odd-oxygen +********************************* +[jh2o_b] H2O + hv -> H2 + O1D +[jh2o_c] H2O + hv -> 2*H + O +[jh2o_a] H2O + hv -> OH + H +[jh2o2] H2O2 + hv -> 2*OH +[jo2_b=userdefined,] O2 + hv -> 2*O +[jo2_a=userdefined,] O2 + hv -> O + O1D +[jo3_a] O3 + hv -> O1D + O2_1D +[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 +[jno_i] NO + hv -> NOp + e +[jno2] NO2 + hv -> NO + O +[jno3_a] NO3 + hv -> NO2 + O +[jno3_b] NO3 + hv -> NO + O2 +********************************* +*** organics +********************************* +[jalknit->,jch3ooh] ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK +[jalkooh->,jch3ooh] ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 + 0.8*MEK + OH +[jbenzooh->,jch3ooh] BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 +[jbepomuc->,.10*jno2] BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO +[jbigald->,0.2*jno2] BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 + 0.18*CH3COCHO +[jbigald1->,.14*jno2] BIGALD1 + hv -> 0.6*MALO2 + HO2 +[jbigald2->,.20*jno2] BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 +[jbigald3->,.20*jno2] BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 +[jbigald4->,.006*jno2] BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 +[jbzooh->,jch3ooh] BZOOH + hv -> BZALD + OH + HO2 +[jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH +[jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 +[jc6h5ooh->,jch3ooh] C6H5OOH + hv -> PHENO + OH +[jch2o_b] CH2O + hv -> CO + H2 +[jch2o_a] CH2O + hv -> CO + 2*H +[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 +[jhonitr->,jch2o_a] HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + 0.17*CH3COCH3 +[jhpald->,.006*jno2] HPALD + hv -> BIGALD3 + OH + HO2 +[jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O +[jisopnooh->,jch3ooh] ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + 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 +[jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 +[jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO +[jmpan->,jpan] MPAN + hv -> MCO3 + NO2 +[jmvk] MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 +[jnc4cho->,jch2o_a] NC4CHO + hv -> BIGALD3 + NO2 + HO2 +[jnoa->,jch2o_a] NOA + hv -> NO2 + CH2O + CH3CO3 +[jnterpooh->,jch3ooh] NTERPOOH + hv -> TERPROD1 + NO2 + OH +[jonitr->,jch3cho] ONITR + hv -> NO2 +[jpan] PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 +[jphenooh->,jch3ooh] PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL +[jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH +[jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH +[jtepomuc->,.10*jno2] TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO +[jterp2ooh->,jch3ooh] TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 + TERPROD2 + HO2 + 0.25*GLYALD +[jterpnit->,jch3ooh] TERPNIT + hv -> TERPROD1 + NO2 + HO2 +[jterpooh->,jch3ooh] TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH +[jterprd1->,jch3cho] TERPROD1 + hv -> HO2 + CO + TERPROD2 +[jterprd2->,jch3cho] TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO +[jtolooh->,jch3ooh] TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 +[jxooh->,jch3ooh] XOOH + hv -> OH +[jxylenooh->,jch3ooh] XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 +[jxylolooh->,jch3ooh] XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 +********************************* +*** 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 -> 2*CL + COFCL +[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 +[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_a] CLONO2 + hv -> CL + NO3 +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jcof2] COF2 + hv -> 2*F +[jcofcl] COFCL + hv -> F + CL +[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 +********************************* +*** ions +********************************* +[jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O +[jeuv_4=userdefined,userdefined] N + hv -> Np + e +[jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_2=userdefined,userdefined] O + hv -> Op + e +[jeuv_1=userdefined,userdefined] O + hv -> Op + e +[jeuv_16=userdefined,userdefined] O + hv -> Op + e +[jeuv_15=userdefined,userdefined] O + hv -> Op + e +[jeuv_14=userdefined,userdefined] O + hv -> Op + e +[jeuv_3=userdefined,userdefined] O + hv -> Op + e +[jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_24=userdefined,userdefined] O2 + hv -> 2*O +[jeuv_12=userdefined,userdefined] O2 + hv -> 2*O +********************************* +*** 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 +********************************* +[jsoabb1_a1->,.0004*jno2] soabb1_a1 + hv -> +[jsoabb1_a2->,.0004*jno2] soabb1_a2 + hv -> +[jsoabb2_a1->,.0004*jno2] soabb2_a1 + hv -> +[jsoabb2_a2->,.0004*jno2] soabb2_a2 + hv -> +[jsoabb3_a1->,.0004*jno2] soabb3_a1 + hv -> +[jsoabb3_a2->,.0004*jno2] soabb3_a2 + hv -> +[jsoabb4_a1->,.0004*jno2] soabb4_a1 + hv -> +[jsoabb4_a2->,.0004*jno2] soabb4_a2 + hv -> +[jsoabb5_a1->,.0004*jno2] soabb5_a1 + hv -> +[jsoabb5_a2->,.0004*jno2] soabb5_a2 + hv -> +[jsoabg1_a1->,.0004*jno2] soabg1_a1 + hv -> +[jsoabg1_a2->,.0004*jno2] soabg1_a2 + hv -> +[jsoabg2_a1->,.0004*jno2] soabg2_a1 + hv -> +[jsoabg2_a2->,.0004*jno2] soabg2_a2 + hv -> +[jsoabg3_a1->,.0004*jno2] soabg3_a1 + hv -> +[jsoabg3_a2->,.0004*jno2] soabg3_a2 + hv -> +[jsoabg4_a1->,.0004*jno2] soabg4_a1 + hv -> +[jsoabg4_a2->,.0004*jno2] soabg4_a2 + hv -> +[jsoabg5_a1->,.0004*jno2] soabg5_a1 + hv -> +[jsoabg5_a2->,.0004*jno2] soabg5_a2 + hv -> +[jsoaff1_a1->,.0004*jno2] soaff1_a1 + hv -> +[jsoaff1_a2->,.0004*jno2] soaff1_a2 + hv -> +[jsoaff2_a1->,.0004*jno2] soaff2_a1 + hv -> +[jsoaff2_a2->,.0004*jno2] soaff2_a2 + hv -> +[jsoaff3_a1->,.0004*jno2] soaff3_a1 + hv -> +[jsoaff3_a2->,.0004*jno2] soaff3_a2 + hv -> +[jsoaff4_a1->,.0004*jno2] soaff4_a1 + hv -> +[jsoaff4_a2->,.0004*jno2] soaff4_a2 + hv -> +[jsoaff5_a1->,.0004*jno2] soaff5_a1 + hv -> +[jsoaff5_a2->,.0004*jno2] soaff5_a2 + hv -> + End Photolysis + + Reactions +********************************* +*** odd-oxygen +********************************* +[ag1] O2_1D -> O2 ; 0.000258 +[ag2] O2_1S -> O2 ; 0.085 +[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_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 2.64e-11, 55 +[O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 6.6e-12, 55 +[O1D_O3] O1D + O3 -> O2 + O2 ; 1.2e-10 +[O2_1D_N2,cph=94.3] O2_1D + N2 -> O2 + N2 ; 1e-20 +[O2_1D_O,cph=94.3] O2_1D + O -> O2 + O ; 1.3e-16 +[O2_1D_O2,cph=94.3] O2_1D + O2 -> 2*O2 ; 3.6e-18, -220 +[O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13 +[O2_1S_N2,cph=62.6] O2_1S + N2 -> O2_1D + N2 ; 1.8e-15, 45 +[O2_1S_O,cph=62.6] O2_1S + O -> O2_1D + O ; 8e-14 +[O2_1S_O2,cph=62.6] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17 +[O2_1S_O3,cph=62.6] O2_1S + O3 -> O2_1D + O3 ; 3.5e-11, -135 +[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 +[N2D_O,cph=229.61] N2D + O -> N + O ; 7e-13 +[N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5e-12 +[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 -> 2*CL + COFCL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 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 +********************************* +*** odd-fluorine +********************************* +[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 +[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 +[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 +[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 +[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 +[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 +********************************* +*** 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 + COFCL ; 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 + COFCL ; 1.794e-10 +[O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.3e-10 +[O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.65e-11 +********************************* +*** C1 +********************************* +[CH2O_HO2] CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625 +[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 +[HCN_OH] HCN + OH + M -> HO2 + M ; 6.1e-33, 1.5, 9.8e-15, -4.6, 0.8 +[HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4e-13 +[HOCH2OO_HO2] HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 +[HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.4e+12, -7000 +[HOCH2OO_NO] HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265 +[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 +[O1D_HCN] O1D + HCN -> OH ; 1.08e-10, 105 +[usr_CO_OH] CO + OH -> CO2 + HO2 +********************************* +*** C2 +********************************* +[C2H2_CL_M] C2H2 + CL + M -> CL + M ; 5.2e-30, 2.4, 2.2e-10, 0.7, 0.6 +[C2H2_OH_M] C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 + 0.35*CO + M ; 5.5e-30, 0, 8.3e-13, -2, 0.6 +[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 +[CH3CN_OH] CH3CN + OH -> HO2 ; 7.8e-13, -1050 +[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 +[CL_C3H8] CL + C3H8 -> C3H7O2 + HCL ; 1.45e-10 +[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 +********************************* +[BIGENE_NO3] BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 ; 3.5e-13 +[BIGENE_OH] BIGENE + OH -> ENEO2 ; 5.4e-11 +[ENEO2_NO] ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 ; 4.8e-12, 120 +[ENEO2_NOb] ENEO2 + NO -> HONITR ; 5.1e-14, 693 +[HONITR_OH] HONITR + OH -> ONITR + HO2 ; 2e-12 +[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 -> HONITR ; 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 +[MEKO2_HO2] MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 ; 7.5e-13, 700 +[MEKO2_NO] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180 +[MEK_OH] MEK + OH -> MEKO2 ; 2.3e-12, -170 +[MEKOOH_OH] MEKOOH + OH -> MEKO2 ; 3.8e-12, 200 +[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 +********************************* +[ALKNIT_OH] ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 ; 1.6e-12 +[ALKO2_HO2] ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700 +[ALKO2_NO] ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK + NO2 ; 6.7e-12 +[ALKO2_NOb] ALKO2 + NO -> ALKNIT ; 5.4e-14, 870 +[ALKOOH_OH] ALKOOH + OH -> ALKO2 ; 3.8e-12, 200 +[BIGALK_OH] BIGALK + OH -> ALKO2 ; 3.5e-12 +[HPALD_OH] HPALD + OH -> XO2 ; 1.86e-11, 175 +[HYDRALD_OH] HYDRALD + OH -> XO2 ; 1.86e-11, 175 +[IEPOX_OH] IEPOX + OH -> XO2 ; 1.3e-11 +[ISOPAO2_CH3CO3] ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 ; 1.4e-11 +[ISOPAO2_CH3O2] ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR + 0.44*MVK ; 5e-13, 400 +[ISOPAO2_HO2] ISOPAO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPAO2_NO] ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK + 0.92*CH2O + 0.92*HO2 ; 4.4e-12, 180 +[ISOPAO2_NO3] ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 ; 2.4e-12 +[ISOPBO2_CH3CO3] ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 ; 1.4e-11 +[ISOPBO2_CH3O2] ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD ; 5e-13, 400 +[ISOPBO2_HO2] ISOPBO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPBO2_M] ISOPBO2 -> HPALD + HO2 ; 1.6e+09, -8300 +[ISOPBO2_NO] ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 4.4e-12, 180 +[ISOPBO2_NO3] ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 2.4e-12 +[ISOPNITA_OH] ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O + 0.3*HONITR + 0.3*HO2 ; 4e-11 +[ISOPNITB_OH] ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR ; 4e-11 +[ISOP_NO3] ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446 +[ISOPNO3_CH3CO3] ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 ; 1.4e-11 +[ISOPNO3_CH3O2] ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH + 0.2*NC4CH2OH ; 5e-13, 400 +[ISOPNO3_HO2] ISOPNO3 + HO2 -> ISOPNOOH ; 8e-13, 700 +[ISOPNO3_NO] ISOPNO3 + NO -> NC4CHO + NO2 + HO2 ; 2.7e-12, 360 +[ISOPNO3_NO3] ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 ; 2.4e-12 +[ISOPNOOH_OH] ISOPNOOH + OH -> NOA + HO2 ; 4e-11 +[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 -> 0.6*ISOPAO2 + 0.4*ISOPBO2 ; 2.54e-11, 410 +[ISOPOOH_OH] ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH ; 1.52e-11, 200 +[NC4CH2OH_OH] NC4CH2OH + OH -> GLYALD + NOA + HO2 ; 7e-11 +[NC4CHO_OH] NC4CHO + OH -> GLYOXAL + NOA + HO2 ; 1e-10 +[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 +********************************* +*** C7 +********************************* +[ACBZO2_HO2] ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH ; 4.3e-13, 1040 +[ACBZO2_NO] ACBZO2 + NO -> C6H5O2 + NO2 ; 7.5e-12, 290 +[BENZENE_OH] BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 ; 2.3e-12, -193 +[BENZO2_HO2] BENZO2 + HO2 -> BENZOOH ; 7.5e-13, 700 +[BENZO2_NO] BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 ; 2.6e-12, 365 +[BENZOOH_OH] BENZOOH + OH -> BENZO2 ; 3.8e-12, 200 +[BZALD_OH] BZALD + OH -> ACBZO2 ; 5.9e-12, 225 +[BZOO_HO2] BZOO + HO2 -> BZOOH ; 7.5e-13, 700 +[BZOOH_OH] BZOOH + OH -> BZOO ; 3.8e-12, 200 +[BZOO_NO] BZOO + NO -> BZALD + NO2 + HO2 ; 2.6e-12, 365 +[C6H5O2_HO2] C6H5O2 + HO2 -> C6H5OOH ; 7.5e-13, 700 +[C6H5O2_NO] C6H5O2 + NO -> PHENO + NO2 ; 2.6e-12, 365 +[C6H5OOH_OH] C6H5OOH + OH -> C6H5O2 ; 3.8e-12, 200 +[CRESOL_OH] CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO ; 4.7e-11 +[DICARBO2_HO2] DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO + 0.33*CH3O2 ; 4.3e-13, 1040 +[DICARBO2_NO] DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO + 0.83*CH3O2 ; 7.5e-12, 290 +[DICARBO2_NO2] DICARBO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MALO2_HO2] MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO ; 4.3e-13, 1040 +[MALO2_NO] MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 ; 7.5e-12, 290 +[MALO2_NO2] MALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MDIALO2_HO2] MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO + 0.07*CH3O2 + 0.07*GLYOXAL ; 4.3e-13, 1040 +[MDIALO2_NO] MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO + 0.17*CH3O2 + 0.17*GLYOXAL ; 7.5e-12, 290 +[MDIALO2_NO2] MDIALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[PHENO2_HO2] PHENO2 + HO2 -> PHENOOH ; 7.5e-13, 700 +[PHENO2_NO] PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 ; 2.6e-12, 365 +[PHENOL_OH] PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO ; 4.7e-13, 1220 +[PHENO_NO2] PHENO + NO2 -> 1*NDEP ; 2.1e-12 +[PHENO_O3] PHENO + O3 -> C6H5O2 ; 2.8e-13 +[PHENOOH_OH] PHENOOH + OH -> PHENO2 ; 3.8e-12, 200 +[tag_ACBZO2_NO2] ACBZO2 + NO2 + M -> PBZNIT + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[TOLO2_HO2] TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700 +[TOLO2_NO] TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 ; 2.6e-12, 365 +[TOLOOH_OH] TOLOOH + OH -> TOLO2 ; 3.8e-12, 200 +[TOLUENE_OH] TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 + 0.28*HO2 ; 1.7e-12, 352 +[usr_PBZNIT_M] PBZNIT + M -> ACBZO2 + NO2 + M +[XYLENES_OH] XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO + 0.56*XYLENO2 + 0.38*HO2 ; 1.7e-11 +[XYLENO2_HO2] XYLENO2 + HO2 -> XYLENOOH ; 7.5e-13, 700 +[XYLENO2_NO] XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 ; 2.6e-12, 365 +[XYLENOOH_OH] XYLENOOH + OH -> XYLENO2 ; 3.8e-12, 200 +[XYLOLO2_HO2] XYLOLO2 + HO2 -> XYLOLOOH ; 7.5e-13, 700 +[XYLOLO2_NO] XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO ; 2.6e-12, 365 +[XYLOL_OH] XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO ; 8.4e-11 +[XYLOLOOH_OH] XYLOLOOH + OH -> XYLOLO2 ; 3.8e-12, 200 +********************************* +*** C10 +********************************* +[BCARY_NO3] BCARY + NO3 -> NTERPO2 ; 1.9e-11 +[BCARY_O3] BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 1.2e-14 +[BCARY_OH] BCARY + OH -> TERPO2 ; 2e-10 +[MTERP_NO3] MTERP + NO3 -> NTERPO2 ; 1.2e-12, 490 +[MTERP_O3] MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 6.3e-16, -580 +[MTERP_OH] MTERP + OH -> TERPO2 ; 1.2e-11, 440 +[NTERPO2_CH3O2] NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 + 0.5*TERPROD1 + 0.5*NO2 ; 2e-12, 500 +[NTERPO2_HO2] NTERPO2 + HO2 -> NTERPOOH ; 7.5e-13, 700 +[NTERPO2_NO] NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP ; 4.2e-12, 180 +[NTERPO2_NO3] NTERPO2 + NO3 -> 2*NO2 + TERPROD1 ; 2.4e-12 +[NTERPOOH_OH] NTERPOOH + OH -> NTERPO2 ; 2e-11 +[TERP2O2_CH3O2] TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + 0.15*CH3COCH3 ; 2e-12, 500 +[TERP2O2_HO2] TERP2O2 + HO2 -> TERP2OOH ; 7.5e-13, 700 +[TERP2O2_NO] TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + 0.225*GLYALD ; 4.2e-12, 180 +[TERP2OOH_OH] TERP2OOH + OH -> TERP2O2 ; 2.3e-11 +[TERPNIT_OH] TERPNIT + OH -> NO2 + TERPROD1 ; 2e-11 +[TERPO2_CH3O2] TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 + 0.025*CH3COCH3 ; 2e-12, 500 +[TERPO2_HO2] TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700 +[TERPO2_NO] TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 + 0.8*TERPROD1 + 0.8*HO2 ; 4.2e-12, 180 +[TERPOOH_OH] TERPOOH + OH -> TERPO2 ; 3.3e-11 +[TERPROD1_NO3] TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP ; 1e-12 +[TERPROD1_OH] TERPROD1 + OH -> TERP2O2 ; 5.7e-11 +[TERPROD2_OH] TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO ; 3.4e-11 +********************************* +*** 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_HONITR_aer] HONITR -> HNO3 +[usr_ISOPNITA_aer] ISOPNITA -> HNO3 +[usr_ISOPNITB_aer] ISOPNITB -> HNO3 +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NC4CH2OH_aer] NC4CH2OH -> HNO3 +[usr_NC4CHO_aer] NC4CHO -> 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_NTERPOOH_aer] NTERPOOH -> HNO3 +[usr_ONITR_aer] ONITR -> HNO3 +[usr_TERPNIT_aer] TERPNIT -> HNO3 +********************************* +*** SOA +********************************* +[BCARY_NO3_vbs] BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 ; 1.9e-11 +[BCARYO2_HO2_vbs] BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 ; 2.75e-13, 1300 +[BCARYO2_NO_vbs] BCARYO2VBS + NO -> NO + 0.1279*SOAGbg0 + 0.1792*SOAGbg1 + 0.0676*SOAGbg2 + 0.079*SOAGbg3 + 0.1254*SOAGbg4 ; 2.7e-12, 360 +[BCARY_O3_vbs] BCARY + O3 -> BCARY + O3 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 ; 1.2e-14 +[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + BCARYO2VBS ; 2e-10 +[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + BENZO2VBS ; 2.3e-12, -193 +[BENZO2_HO2_vbs] BENZO2VBS + HO2 -> HO2 + 0.0023*SOAGff0 + 0.0008*SOAGff1 + 0.0843*SOAGff2 + 0.0443*SOAGff3 + 0.1621*SOAGff4 ; 7.5e-13, 700 +[BENZO2_NO_vbs] BENZO2VBS + NO -> NO + 0.0097*SOAGff0 + 0.0034*SOAGff1 + 0.1579*SOAGff2 + 0.0059*SOAGff3 + 0.0536*SOAGff4 ; 2.6e-12, 365 +[ISOP_NO3_vbs] ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAGbg3 + 0.025024*SOAGbg4 ; 3.03e-12, -446 +[ISOPO2_HO2_vbs] ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAGbg0 + 0.0035*SOAGbg1 + 0.0003*SOAGbg2 + 0.0271*SOAGbg3 + 0.0474*SOAGbg4 ; 2.12e-13, 1300 +[ISOPO2_NO_vbs] ISOPO2VBS + NO -> NO + 0.0003*SOAGbg0 + 0.0003*SOAGbg1 + 0.0073*SOAGbg2 + 0.0057*SOAGbg3 + 0.0623*SOAGbg4 ; 2.7e-12, 350 +[ISOP_O3_vbs] ISOP + O3 -> ISOP + O3 + 0.0033*SOAGbg3 ; 1.05e-14, -2000 +[ISOP_OH_vbs] ISOP + OH -> ISOP + OH + ISOPO2VBS ; 2.54e-11, 410 +[IVOCbbO2_HO2_vbs] IVOCbbO2VBS + HO2 -> HO2 + 0.2381*SOAGbb0 + 0.1308*SOAGbb1 + 0.0348*SOAGbb2 + 0.0076*SOAGbb3 + 0.0113*SOAGbb4 ; 7.5e-13, 700 +[IVOCbbO2_NO_vbs] IVOCbbO2VBS + NO -> NO + 0.1056*SOAGbb0 + 0.1026*SOAGbb1 + 0.0521*SOAGbb2 + 0.0143*SOAGbb3 + 0.0166*SOAGbb4 ; 2.6e-12, 365 +[IVOCbb_OH_vbs] IVOCbb + OH -> OH + IVOCbbO2VBS ; 1.34e-11 +[IVOCffO2_HO2_vbs] IVOCffO2VBS + HO2 -> HO2 + 0.2381*SOAGff0 + 0.1308*SOAGff1 + 0.0348*SOAGff2 + 0.0076*SOAGff3 + 0.0113*SOAGff4 ; 7.5e-13, 700 +[IVOCffO2_NO_vbs] IVOCffO2VBS + NO -> NO + 0.1056*SOAGff0 + 0.1026*SOAGff1 + 0.0521*SOAGff2 + 0.0143*SOAGff3 + 0.0166*SOAGff4 ; 2.6e-12, 365 +[IVOCff_OH_vbs] IVOCff + OH -> OH + IVOCffO2VBS ; 1.34e-11 +[MTERP_NO3_vbs] MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 ; 1.2e-12, 490 +[MTERPO2_HO2_vbs] MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 ; 2.6e-13, 1300 +[MTERPO2_NO_vbs] MTERPO2VBS + NO -> NO + 0.0245*SOAGbg0 + 0.0082*SOAGbg1 + 0.0772*SOAGbg2 + 0.0332*SOAGbg3 + 0.13*SOAGbg4 ; 2.7e-12, 360 +[MTERP_O3_vbs] MTERP + O3 -> MTERP + O3 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 ; 6.3e-16, -580 +[MTERP_OH_vbs] MTERP + OH -> MTERP + OH + MTERPO2VBS ; 1.2e-11, 440 +[SVOCbb_OH] SVOCbb + OH -> OH + 0.5931*SOAGbb0 + 0.1534*SOAGbb1 + 0.0459*SOAGbb2 + 0.0085*SOAGbb3 + 0.0128*SOAGbb4 ; 1.34e-11 +[SVOCff_OH] SVOCff + OH -> OH + 0.5931*SOAGff0 + 0.1534*SOAGff1 + 0.0459*SOAGff2 + 0.0085*SOAGff3 + 0.0128*SOAGff4 ; 1.34e-11 +[TOLUENE_OH_vbs] TOLUENE + OH -> TOLO2 + TOLUO2VBS ; 1.7e-12, 352 +[TOLUO2_HO2_vbs] TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAGff0 + 0.0101*SOAGff1 + 0.0763*SOAGff2 + 0.2157*SOAGff3 + 0.0738*SOAGff4 ; 7.5e-13, 700 +[TOLUO2_NO_vbs] TOLUO2VBS + NO -> NO + 0.0154*SOAGff0 + 0.0452*SOAGff1 + 0.0966*SOAGff2 + 0.0073*SOAGff3 + 0.238*SOAGff4 ; 2.6e-12, 365 +[usr_GLYOXAL_aer] GLYOXAL -> SOAGbg0 +[XYLENES_OH_vbs] XYLENES + OH -> XYLENES + OH + XYLEO2VBS ; 1.7e-11 +[XYLEO2_HO2_vbs] XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAGff0 + 0.0174*SOAGff1 + 0.086*SOAGff2 + 0.0512*SOAGff3 + 0.1598*SOAGff4 ; 7.5e-13, 700 +[XYLEO2_NO_vbs] XYLEO2VBS + NO -> NO + 0.0063*SOAGff0 + 0.0237*SOAGff1 + 0.0025*SOAGff2 + 0.011*SOAGff3 + 0.1185*SOAGff4 ; 2.6e-12, 365 +********************************* +*** 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 +********************************* +*** Ions +********************************* +[elec1,cph=82.389] NOp + e -> 0.2*N + 0.8*N2D + O +[elec2,cph=508.95] O2p + e -> 1.15*O + 0.85*O1D +[elec3,cph=354.83] N2p + e -> 1.1*N + 0.9*N2D +[ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6e-11 +[ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D +[ion_N2p_Ob] N2p + O -> Op + N2 +[ion_Np_O,cph=95.55] Np + O -> Op + N ; 1e-12 +[ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4e-10 +[ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2e-10 +[ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1e-10 +[ion_O2p_N2] O2p + N2 -> NOp + NO ; 5e-16 +[ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 +[ion_Op_CO2] Op + CO2 -> O2p + CO ; 9e-10 +[ion_Op_N2,cph=105.04] Op + N2 -> NOp + N +[ion_Op_O2,cph=150.11] Op + O2 -> O2p + O +********************************* +*** 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 + CO <- dataset + bc_a4 <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset + pombb1_a1 <- dataset + pombb1_a4 <- dataset + pomff1_a1 <- dataset + pomff1_a4 <- dataset + NO <- dataset + NO2 <- dataset + SO2 <- dataset + SVOCbb <- dataset + SVOCff <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + bc_a1 <- dataset + e + N + N2D + OH + Op + AOA_NH + N2p + Np + 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_waccm_tsmlt_mam4_vbsext/chem_mods.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/chem_mods.F90 new file mode 100644 index 0000000000..23e472879b --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/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 = 170, & ! number of photolysis reactions + rxntot = 621, & ! number of total reactions + gascnt = 451, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 274, & ! number of "gas phase" species + nfs = 2, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 2522, & ! number of non-zero matrix entries + extcnt = 25, & ! 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 = 272, & ! 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 = 621, & + enthalpy_cnt = 41, & + nslvd = 43 + 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_waccm_tsmlt_mam4_vbsext/m_rxt_id.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/m_rxt_id.F90 new file mode 100644 index 0000000000..d049a0ce13 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/m_rxt_id.F90 @@ -0,0 +1,624 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o_b = 1 + integer, parameter :: rid_jh2o_c = 2 + integer, parameter :: rid_jh2o_a = 3 + integer, parameter :: rid_jh2o2 = 4 + integer, parameter :: rid_jo2_b = 5 + integer, parameter :: rid_jo2_a = 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_jno_i = 16 + integer, parameter :: rid_jno2 = 17 + integer, parameter :: rid_jno3_a = 18 + integer, parameter :: rid_jno3_b = 19 + integer, parameter :: rid_jalknit = 20 + integer, parameter :: rid_jalkooh = 21 + integer, parameter :: rid_jbenzooh = 22 + integer, parameter :: rid_jbepomuc = 23 + integer, parameter :: rid_jbigald = 24 + integer, parameter :: rid_jbigald1 = 25 + integer, parameter :: rid_jbigald2 = 26 + integer, parameter :: rid_jbigald3 = 27 + integer, parameter :: rid_jbigald4 = 28 + integer, parameter :: rid_jbzooh = 29 + integer, parameter :: rid_jc2h5ooh = 30 + integer, parameter :: rid_jc3h7ooh = 31 + integer, parameter :: rid_jc6h5ooh = 32 + integer, parameter :: rid_jch2o_b = 33 + integer, parameter :: rid_jch2o_a = 34 + integer, parameter :: rid_jch3cho = 35 + integer, parameter :: rid_jacet = 36 + integer, parameter :: rid_jmgly = 37 + integer, parameter :: rid_jch3co3h = 38 + integer, parameter :: rid_jch3ooh = 39 + integer, parameter :: rid_jch4_b = 40 + integer, parameter :: rid_jch4_a = 41 + integer, parameter :: rid_jco2 = 42 + integer, parameter :: rid_jeooh = 43 + integer, parameter :: rid_jglyald = 44 + integer, parameter :: rid_jglyoxal = 45 + integer, parameter :: rid_jhonitr = 46 + integer, parameter :: rid_jhpald = 47 + integer, parameter :: rid_jhyac = 48 + integer, parameter :: rid_jisopnooh = 49 + integer, parameter :: rid_jisopooh = 50 + integer, parameter :: rid_jmacr_a = 51 + integer, parameter :: rid_jmacr_b = 52 + integer, parameter :: rid_jmek = 53 + integer, parameter :: rid_jmekooh = 54 + integer, parameter :: rid_jmpan = 55 + integer, parameter :: rid_jmvk = 56 + integer, parameter :: rid_jnc4cho = 57 + integer, parameter :: rid_jnoa = 58 + integer, parameter :: rid_jnterpooh = 59 + integer, parameter :: rid_jonitr = 60 + integer, parameter :: rid_jpan = 61 + integer, parameter :: rid_jphenooh = 62 + integer, parameter :: rid_jpooh = 63 + integer, parameter :: rid_jrooh = 64 + integer, parameter :: rid_jtepomuc = 65 + integer, parameter :: rid_jterp2ooh = 66 + integer, parameter :: rid_jterpnit = 67 + integer, parameter :: rid_jterpooh = 68 + integer, parameter :: rid_jterprd1 = 69 + integer, parameter :: rid_jterprd2 = 70 + integer, parameter :: rid_jtolooh = 71 + integer, parameter :: rid_jxooh = 72 + integer, parameter :: rid_jxylenooh = 73 + integer, parameter :: rid_jxylolooh = 74 + integer, parameter :: rid_jbrcl = 75 + integer, parameter :: rid_jbro = 76 + integer, parameter :: rid_jbrono2_b = 77 + integer, parameter :: rid_jbrono2_a = 78 + integer, parameter :: rid_jccl4 = 79 + integer, parameter :: rid_jcf2clbr = 80 + integer, parameter :: rid_jcf3br = 81 + integer, parameter :: rid_jcfcl3 = 82 + integer, parameter :: rid_jcfc113 = 83 + integer, parameter :: rid_jcfc114 = 84 + integer, parameter :: rid_jcfc115 = 85 + integer, parameter :: rid_jcf2cl2 = 86 + integer, parameter :: rid_jch2br2 = 87 + integer, parameter :: rid_jch3br = 88 + integer, parameter :: rid_jch3ccl3 = 89 + integer, parameter :: rid_jch3cl = 90 + integer, parameter :: rid_jchbr3 = 91 + integer, parameter :: rid_jcl2 = 92 + integer, parameter :: rid_jcl2o2 = 93 + integer, parameter :: rid_jclo = 94 + integer, parameter :: rid_jclono2_a = 95 + integer, parameter :: rid_jclono2_b = 96 + integer, parameter :: rid_jcof2 = 97 + integer, parameter :: rid_jcofcl = 98 + integer, parameter :: rid_jh2402 = 99 + integer, parameter :: rid_jhbr = 100 + integer, parameter :: rid_jhcfc141b = 101 + integer, parameter :: rid_jhcfc142b = 102 + integer, parameter :: rid_jhcfc22 = 103 + integer, parameter :: rid_jhcl = 104 + integer, parameter :: rid_jhf = 105 + integer, parameter :: rid_jhobr = 106 + integer, parameter :: rid_jhocl = 107 + integer, parameter :: rid_joclo = 108 + integer, parameter :: rid_jsf6 = 109 + integer, parameter :: rid_jeuv_26 = 110 + integer, parameter :: rid_jeuv_4 = 111 + integer, parameter :: rid_jeuv_13 = 112 + integer, parameter :: rid_jeuv_11 = 113 + integer, parameter :: rid_jeuv_6 = 114 + integer, parameter :: rid_jeuv_10 = 115 + integer, parameter :: rid_jeuv_22 = 116 + integer, parameter :: rid_jeuv_23 = 117 + integer, parameter :: rid_jeuv_25 = 118 + integer, parameter :: rid_jeuv_18 = 119 + integer, parameter :: rid_jeuv_2 = 120 + integer, parameter :: rid_jeuv_1 = 121 + integer, parameter :: rid_jeuv_16 = 122 + integer, parameter :: rid_jeuv_15 = 123 + integer, parameter :: rid_jeuv_14 = 124 + integer, parameter :: rid_jeuv_3 = 125 + integer, parameter :: rid_jeuv_17 = 126 + integer, parameter :: rid_jeuv_9 = 127 + integer, parameter :: rid_jeuv_8 = 128 + integer, parameter :: rid_jeuv_7 = 129 + integer, parameter :: rid_jeuv_5 = 130 + integer, parameter :: rid_jeuv_19 = 131 + integer, parameter :: rid_jeuv_20 = 132 + integer, parameter :: rid_jeuv_21 = 133 + integer, parameter :: rid_jeuv_24 = 134 + integer, parameter :: rid_jeuv_12 = 135 + integer, parameter :: rid_jh2so4 = 136 + integer, parameter :: rid_jocs = 137 + integer, parameter :: rid_jso = 138 + integer, parameter :: rid_jso2 = 139 + integer, parameter :: rid_jso3 = 140 + integer, parameter :: rid_jsoabb1_a1 = 141 + integer, parameter :: rid_jsoabb1_a2 = 142 + integer, parameter :: rid_jsoabb2_a1 = 143 + integer, parameter :: rid_jsoabb2_a2 = 144 + integer, parameter :: rid_jsoabb3_a1 = 145 + integer, parameter :: rid_jsoabb3_a2 = 146 + integer, parameter :: rid_jsoabb4_a1 = 147 + integer, parameter :: rid_jsoabb4_a2 = 148 + integer, parameter :: rid_jsoabb5_a1 = 149 + integer, parameter :: rid_jsoabb5_a2 = 150 + integer, parameter :: rid_jsoabg1_a1 = 151 + integer, parameter :: rid_jsoabg1_a2 = 152 + integer, parameter :: rid_jsoabg2_a1 = 153 + integer, parameter :: rid_jsoabg2_a2 = 154 + integer, parameter :: rid_jsoabg3_a1 = 155 + integer, parameter :: rid_jsoabg3_a2 = 156 + integer, parameter :: rid_jsoabg4_a1 = 157 + integer, parameter :: rid_jsoabg4_a2 = 158 + integer, parameter :: rid_jsoabg5_a1 = 159 + integer, parameter :: rid_jsoabg5_a2 = 160 + integer, parameter :: rid_jsoaff1_a1 = 161 + integer, parameter :: rid_jsoaff1_a2 = 162 + integer, parameter :: rid_jsoaff2_a1 = 163 + integer, parameter :: rid_jsoaff2_a2 = 164 + integer, parameter :: rid_jsoaff3_a1 = 165 + integer, parameter :: rid_jsoaff3_a2 = 166 + integer, parameter :: rid_jsoaff4_a1 = 167 + integer, parameter :: rid_jsoaff4_a2 = 168 + integer, parameter :: rid_jsoaff5_a1 = 169 + integer, parameter :: rid_jsoaff5_a2 = 170 + integer, parameter :: rid_ag1 = 171 + integer, parameter :: rid_ag2 = 172 + integer, parameter :: rid_O1D_H2 = 173 + integer, parameter :: rid_O1D_H2O = 174 + integer, parameter :: rid_O1D_N2 = 175 + integer, parameter :: rid_O1D_O2 = 176 + integer, parameter :: rid_O1D_O2b = 177 + integer, parameter :: rid_O1D_O3 = 178 + integer, parameter :: rid_O2_1D_N2 = 179 + integer, parameter :: rid_O2_1D_O = 180 + integer, parameter :: rid_O2_1D_O2 = 181 + integer, parameter :: rid_O2_1S_CO2 = 182 + integer, parameter :: rid_O2_1S_N2 = 183 + integer, parameter :: rid_O2_1S_O = 184 + integer, parameter :: rid_O2_1S_O2 = 185 + integer, parameter :: rid_O2_1S_O3 = 186 + integer, parameter :: rid_O_O3 = 187 + integer, parameter :: rid_usr_O_O = 188 + integer, parameter :: rid_usr_O_O2 = 189 + integer, parameter :: rid_H2_O = 190 + integer, parameter :: rid_H2O2_O = 191 + integer, parameter :: rid_H_HO2 = 192 + integer, parameter :: rid_H_HO2a = 193 + integer, parameter :: rid_H_HO2b = 194 + integer, parameter :: rid_H_O2 = 195 + integer, parameter :: rid_HO2_O = 196 + integer, parameter :: rid_HO2_O3 = 197 + integer, parameter :: rid_H_O3 = 198 + integer, parameter :: rid_OH_H2 = 199 + integer, parameter :: rid_OH_H2O2 = 200 + integer, parameter :: rid_OH_HO2 = 201 + integer, parameter :: rid_OH_O = 202 + integer, parameter :: rid_OH_O3 = 203 + integer, parameter :: rid_OH_OH = 204 + integer, parameter :: rid_OH_OH_M = 205 + integer, parameter :: rid_usr_HO2_HO2 = 206 + integer, parameter :: rid_HO2NO2_OH = 207 + integer, parameter :: rid_N2D_O = 208 + integer, parameter :: rid_N2D_O2 = 209 + integer, parameter :: rid_N_NO = 210 + integer, parameter :: rid_N_NO2a = 211 + integer, parameter :: rid_N_NO2b = 212 + integer, parameter :: rid_N_NO2c = 213 + integer, parameter :: rid_N_O2 = 214 + integer, parameter :: rid_NO2_O = 215 + integer, parameter :: rid_NO2_O3 = 216 + integer, parameter :: rid_NO2_O_M = 217 + integer, parameter :: rid_NO3_HO2 = 218 + integer, parameter :: rid_NO3_NO = 219 + integer, parameter :: rid_NO3_O = 220 + integer, parameter :: rid_NO3_OH = 221 + integer, parameter :: rid_N_OH = 222 + integer, parameter :: rid_NO_HO2 = 223 + integer, parameter :: rid_NO_O3 = 224 + integer, parameter :: rid_NO_O_M = 225 + integer, parameter :: rid_O1D_N2Oa = 226 + integer, parameter :: rid_O1D_N2Ob = 227 + integer, parameter :: rid_tag_NO2_HO2 = 228 + integer, parameter :: rid_tag_NO2_NO3 = 229 + integer, parameter :: rid_tag_NO2_OH = 230 + integer, parameter :: rid_usr_HNO3_OH = 231 + integer, parameter :: rid_usr_HO2NO2_M = 232 + integer, parameter :: rid_usr_N2O5_M = 233 + integer, parameter :: rid_CL_CH2O = 234 + integer, parameter :: rid_CL_CH4 = 235 + integer, parameter :: rid_CL_H2 = 236 + integer, parameter :: rid_CL_H2O2 = 237 + integer, parameter :: rid_CL_HO2a = 238 + integer, parameter :: rid_CL_HO2b = 239 + integer, parameter :: rid_CL_O3 = 240 + integer, parameter :: rid_CLO_CH3O2 = 241 + integer, parameter :: rid_CLO_CLOa = 242 + integer, parameter :: rid_CLO_CLOb = 243 + integer, parameter :: rid_CLO_CLOc = 244 + integer, parameter :: rid_CLO_HO2 = 245 + integer, parameter :: rid_CLO_NO = 246 + integer, parameter :: rid_CLONO2_CL = 247 + integer, parameter :: rid_CLO_NO2_M = 248 + integer, parameter :: rid_CLONO2_O = 249 + integer, parameter :: rid_CLONO2_OH = 250 + integer, parameter :: rid_CLO_O = 251 + integer, parameter :: rid_CLO_OHa = 252 + integer, parameter :: rid_CLO_OHb = 253 + integer, parameter :: rid_HCL_O = 254 + integer, parameter :: rid_HCL_OH = 255 + integer, parameter :: rid_HOCL_CL = 256 + integer, parameter :: rid_HOCL_O = 257 + integer, parameter :: rid_HOCL_OH = 258 + integer, parameter :: rid_O1D_CCL4 = 259 + integer, parameter :: rid_O1D_CF2CLBR = 260 + integer, parameter :: rid_O1D_CFC11 = 261 + integer, parameter :: rid_O1D_CFC113 = 262 + integer, parameter :: rid_O1D_CFC114 = 263 + integer, parameter :: rid_O1D_CFC115 = 264 + integer, parameter :: rid_O1D_CFC12 = 265 + integer, parameter :: rid_O1D_HCLa = 266 + integer, parameter :: rid_O1D_HCLb = 267 + integer, parameter :: rid_tag_CLO_CLO_M = 268 + integer, parameter :: rid_usr_CL2O2_M = 269 + integer, parameter :: rid_BR_CH2O = 270 + integer, parameter :: rid_BR_HO2 = 271 + integer, parameter :: rid_BR_O3 = 272 + integer, parameter :: rid_BRO_BRO = 273 + integer, parameter :: rid_BRO_CLOa = 274 + integer, parameter :: rid_BRO_CLOb = 275 + integer, parameter :: rid_BRO_CLOc = 276 + integer, parameter :: rid_BRO_HO2 = 277 + integer, parameter :: rid_BRO_NO = 278 + integer, parameter :: rid_BRO_NO2_M = 279 + integer, parameter :: rid_BRONO2_O = 280 + integer, parameter :: rid_BRO_O = 281 + integer, parameter :: rid_BRO_OH = 282 + integer, parameter :: rid_HBR_O = 283 + integer, parameter :: rid_HBR_OH = 284 + integer, parameter :: rid_HOBR_O = 285 + integer, parameter :: rid_O1D_CF3BR = 286 + integer, parameter :: rid_O1D_CHBR3 = 287 + integer, parameter :: rid_O1D_H2402 = 288 + integer, parameter :: rid_O1D_HBRa = 289 + integer, parameter :: rid_O1D_HBRb = 290 + integer, parameter :: rid_F_CH4 = 291 + integer, parameter :: rid_F_H2 = 292 + integer, parameter :: rid_F_H2O = 293 + integer, parameter :: rid_F_HNO3 = 294 + integer, parameter :: rid_O1D_COF2 = 295 + integer, parameter :: rid_O1D_COFCL = 296 + integer, parameter :: rid_CH2BR2_CL = 297 + integer, parameter :: rid_CH2BR2_OH = 298 + integer, parameter :: rid_CH3BR_CL = 299 + integer, parameter :: rid_CH3BR_OH = 300 + integer, parameter :: rid_CH3CCL3_OH = 301 + integer, parameter :: rid_CH3CL_CL = 302 + integer, parameter :: rid_CH3CL_OH = 303 + integer, parameter :: rid_CHBR3_CL = 304 + integer, parameter :: rid_CHBR3_OH = 305 + integer, parameter :: rid_HCFC141B_OH = 306 + integer, parameter :: rid_HCFC142B_OH = 307 + integer, parameter :: rid_HCFC22_OH = 308 + integer, parameter :: rid_O1D_CH2BR2 = 309 + integer, parameter :: rid_O1D_CH3BR = 310 + integer, parameter :: rid_O1D_HCFC141B = 311 + integer, parameter :: rid_O1D_HCFC142B = 312 + integer, parameter :: rid_O1D_HCFC22 = 313 + integer, parameter :: rid_CH2O_HO2 = 314 + integer, parameter :: rid_CH2O_NO3 = 315 + integer, parameter :: rid_CH2O_O = 316 + integer, parameter :: rid_CH2O_OH = 317 + integer, parameter :: rid_CH3O2_CH3O2a = 318 + integer, parameter :: rid_CH3O2_CH3O2b = 319 + integer, parameter :: rid_CH3O2_HO2 = 320 + integer, parameter :: rid_CH3O2_NO = 321 + integer, parameter :: rid_CH3OH_OH = 322 + integer, parameter :: rid_CH3OOH_OH = 323 + integer, parameter :: rid_CH4_OH = 324 + integer, parameter :: rid_HCN_OH = 325 + integer, parameter :: rid_HCOOH_OH = 326 + integer, parameter :: rid_HOCH2OO_HO2 = 327 + integer, parameter :: rid_HOCH2OO_M = 328 + integer, parameter :: rid_HOCH2OO_NO = 329 + integer, parameter :: rid_O1D_CH4a = 330 + integer, parameter :: rid_O1D_CH4b = 331 + integer, parameter :: rid_O1D_CH4c = 332 + integer, parameter :: rid_O1D_HCN = 333 + integer, parameter :: rid_usr_CO_OH = 334 + integer, parameter :: rid_C2H2_CL_M = 335 + integer, parameter :: rid_C2H2_OH_M = 336 + integer, parameter :: rid_C2H4_CL_M = 337 + integer, parameter :: rid_C2H4_O3 = 338 + integer, parameter :: rid_C2H5O2_C2H5O2 = 339 + integer, parameter :: rid_C2H5O2_CH3O2 = 340 + integer, parameter :: rid_C2H5O2_HO2 = 341 + integer, parameter :: rid_C2H5O2_NO = 342 + integer, parameter :: rid_C2H5OH_OH = 343 + integer, parameter :: rid_C2H5OOH_OH = 344 + integer, parameter :: rid_C2H6_CL = 345 + integer, parameter :: rid_C2H6_OH = 346 + integer, parameter :: rid_CH3CHO_NO3 = 347 + integer, parameter :: rid_CH3CHO_OH = 348 + integer, parameter :: rid_CH3CN_OH = 349 + integer, parameter :: rid_CH3CO3_CH3CO3 = 350 + integer, parameter :: rid_CH3CO3_CH3O2 = 351 + integer, parameter :: rid_CH3CO3_HO2 = 352 + integer, parameter :: rid_CH3CO3_NO = 353 + integer, parameter :: rid_CH3COOH_OH = 354 + integer, parameter :: rid_CH3COOOH_OH = 355 + integer, parameter :: rid_EO2_HO2 = 356 + integer, parameter :: rid_EO2_NO = 357 + integer, parameter :: rid_EO_M = 358 + integer, parameter :: rid_EO_O2 = 359 + integer, parameter :: rid_GLYALD_OH = 360 + integer, parameter :: rid_GLYOXAL_OH = 361 + integer, parameter :: rid_PAN_OH = 362 + integer, parameter :: rid_tag_C2H4_OH = 363 + integer, parameter :: rid_tag_CH3CO3_NO2 = 364 + integer, parameter :: rid_usr_PAN_M = 365 + integer, parameter :: rid_C3H6_NO3 = 366 + integer, parameter :: rid_C3H6_O3 = 367 + integer, parameter :: rid_C3H7O2_CH3O2 = 368 + integer, parameter :: rid_C3H7O2_HO2 = 369 + integer, parameter :: rid_C3H7O2_NO = 370 + integer, parameter :: rid_C3H7OOH_OH = 371 + integer, parameter :: rid_C3H8_OH = 372 + integer, parameter :: rid_CH3COCHO_NO3 = 373 + integer, parameter :: rid_CH3COCHO_OH = 374 + integer, parameter :: rid_CL_C3H8 = 375 + integer, parameter :: rid_HYAC_OH = 376 + integer, parameter :: rid_NOA_OH = 377 + integer, parameter :: rid_PO2_HO2 = 378 + integer, parameter :: rid_PO2_NO = 379 + integer, parameter :: rid_POOH_OH = 380 + integer, parameter :: rid_RO2_CH3O2 = 381 + integer, parameter :: rid_RO2_HO2 = 382 + integer, parameter :: rid_RO2_NO = 383 + integer, parameter :: rid_ROOH_OH = 384 + integer, parameter :: rid_tag_C3H6_OH = 385 + integer, parameter :: rid_usr_CH3COCH3_OH = 386 + integer, parameter :: rid_BIGENE_NO3 = 387 + integer, parameter :: rid_BIGENE_OH = 388 + integer, parameter :: rid_ENEO2_NO = 389 + integer, parameter :: rid_ENEO2_NOb = 390 + integer, parameter :: rid_HONITR_OH = 391 + integer, parameter :: rid_MACRO2_CH3CO3 = 392 + integer, parameter :: rid_MACRO2_CH3O2 = 393 + integer, parameter :: rid_MACRO2_HO2 = 394 + integer, parameter :: rid_MACRO2_NO3 = 395 + integer, parameter :: rid_MACRO2_NOa = 396 + integer, parameter :: rid_MACRO2_NOb = 397 + integer, parameter :: rid_MACR_O3 = 398 + integer, parameter :: rid_MACR_OH = 399 + integer, parameter :: rid_MACROOH_OH = 400 + integer, parameter :: rid_MCO3_CH3CO3 = 401 + integer, parameter :: rid_MCO3_CH3O2 = 402 + integer, parameter :: rid_MCO3_HO2 = 403 + integer, parameter :: rid_MCO3_MCO3 = 404 + integer, parameter :: rid_MCO3_NO = 405 + integer, parameter :: rid_MCO3_NO3 = 406 + integer, parameter :: rid_MEKO2_HO2 = 407 + integer, parameter :: rid_MEKO2_NO = 408 + integer, parameter :: rid_MEK_OH = 409 + integer, parameter :: rid_MEKOOH_OH = 410 + integer, parameter :: rid_MPAN_OH_M = 411 + integer, parameter :: rid_MVK_O3 = 412 + integer, parameter :: rid_MVK_OH = 413 + integer, parameter :: rid_tag_MCO3_NO2 = 414 + integer, parameter :: rid_usr_MPAN_M = 415 + integer, parameter :: rid_ALKNIT_OH = 416 + integer, parameter :: rid_ALKO2_HO2 = 417 + integer, parameter :: rid_ALKO2_NO = 418 + integer, parameter :: rid_ALKO2_NOb = 419 + integer, parameter :: rid_ALKOOH_OH = 420 + integer, parameter :: rid_BIGALK_OH = 421 + integer, parameter :: rid_HPALD_OH = 422 + integer, parameter :: rid_HYDRALD_OH = 423 + integer, parameter :: rid_IEPOX_OH = 424 + integer, parameter :: rid_ISOPAO2_CH3CO3 = 425 + integer, parameter :: rid_ISOPAO2_CH3O2 = 426 + integer, parameter :: rid_ISOPAO2_HO2 = 427 + integer, parameter :: rid_ISOPAO2_NO = 428 + integer, parameter :: rid_ISOPAO2_NO3 = 429 + integer, parameter :: rid_ISOPBO2_CH3CO3 = 430 + integer, parameter :: rid_ISOPBO2_CH3O2 = 431 + integer, parameter :: rid_ISOPBO2_HO2 = 432 + integer, parameter :: rid_ISOPBO2_M = 433 + integer, parameter :: rid_ISOPBO2_NO = 434 + integer, parameter :: rid_ISOPBO2_NO3 = 435 + integer, parameter :: rid_ISOPNITA_OH = 436 + integer, parameter :: rid_ISOPNITB_OH = 437 + integer, parameter :: rid_ISOP_NO3 = 438 + integer, parameter :: rid_ISOPNO3_CH3CO3 = 439 + integer, parameter :: rid_ISOPNO3_CH3O2 = 440 + integer, parameter :: rid_ISOPNO3_HO2 = 441 + integer, parameter :: rid_ISOPNO3_NO = 442 + integer, parameter :: rid_ISOPNO3_NO3 = 443 + integer, parameter :: rid_ISOPNOOH_OH = 444 + integer, parameter :: rid_ISOP_O3 = 445 + integer, parameter :: rid_ISOP_OH = 446 + integer, parameter :: rid_ISOPOOH_OH = 447 + integer, parameter :: rid_NC4CH2OH_OH = 448 + integer, parameter :: rid_NC4CHO_OH = 449 + integer, parameter :: rid_XO2_CH3CO3 = 450 + integer, parameter :: rid_XO2_CH3O2 = 451 + integer, parameter :: rid_XO2_HO2 = 452 + integer, parameter :: rid_XO2_NO = 453 + integer, parameter :: rid_XO2_NO3 = 454 + integer, parameter :: rid_XOOH_OH = 455 + integer, parameter :: rid_ACBZO2_HO2 = 456 + integer, parameter :: rid_ACBZO2_NO = 457 + integer, parameter :: rid_BENZENE_OH = 458 + integer, parameter :: rid_BENZO2_HO2 = 459 + integer, parameter :: rid_BENZO2_NO = 460 + integer, parameter :: rid_BENZOOH_OH = 461 + integer, parameter :: rid_BZALD_OH = 462 + integer, parameter :: rid_BZOO_HO2 = 463 + integer, parameter :: rid_BZOOH_OH = 464 + integer, parameter :: rid_BZOO_NO = 465 + integer, parameter :: rid_C6H5O2_HO2 = 466 + integer, parameter :: rid_C6H5O2_NO = 467 + integer, parameter :: rid_C6H5OOH_OH = 468 + integer, parameter :: rid_CRESOL_OH = 469 + integer, parameter :: rid_DICARBO2_HO2 = 470 + integer, parameter :: rid_DICARBO2_NO = 471 + integer, parameter :: rid_DICARBO2_NO2 = 472 + integer, parameter :: rid_MALO2_HO2 = 473 + integer, parameter :: rid_MALO2_NO = 474 + integer, parameter :: rid_MALO2_NO2 = 475 + integer, parameter :: rid_MDIALO2_HO2 = 476 + integer, parameter :: rid_MDIALO2_NO = 477 + integer, parameter :: rid_MDIALO2_NO2 = 478 + integer, parameter :: rid_PHENO2_HO2 = 479 + integer, parameter :: rid_PHENO2_NO = 480 + integer, parameter :: rid_PHENOL_OH = 481 + integer, parameter :: rid_PHENO_NO2 = 482 + integer, parameter :: rid_PHENO_O3 = 483 + integer, parameter :: rid_PHENOOH_OH = 484 + integer, parameter :: rid_tag_ACBZO2_NO2 = 485 + integer, parameter :: rid_TOLO2_HO2 = 486 + integer, parameter :: rid_TOLO2_NO = 487 + integer, parameter :: rid_TOLOOH_OH = 488 + integer, parameter :: rid_TOLUENE_OH = 489 + integer, parameter :: rid_usr_PBZNIT_M = 490 + integer, parameter :: rid_XYLENES_OH = 491 + integer, parameter :: rid_XYLENO2_HO2 = 492 + integer, parameter :: rid_XYLENO2_NO = 493 + integer, parameter :: rid_XYLENOOH_OH = 494 + integer, parameter :: rid_XYLOLO2_HO2 = 495 + integer, parameter :: rid_XYLOLO2_NO = 496 + integer, parameter :: rid_XYLOL_OH = 497 + integer, parameter :: rid_XYLOLOOH_OH = 498 + integer, parameter :: rid_BCARY_NO3 = 499 + integer, parameter :: rid_BCARY_O3 = 500 + integer, parameter :: rid_BCARY_OH = 501 + integer, parameter :: rid_MTERP_NO3 = 502 + integer, parameter :: rid_MTERP_O3 = 503 + integer, parameter :: rid_MTERP_OH = 504 + integer, parameter :: rid_NTERPO2_CH3O2 = 505 + integer, parameter :: rid_NTERPO2_HO2 = 506 + integer, parameter :: rid_NTERPO2_NO = 507 + integer, parameter :: rid_NTERPO2_NO3 = 508 + integer, parameter :: rid_NTERPOOH_OH = 509 + integer, parameter :: rid_TERP2O2_CH3O2 = 510 + integer, parameter :: rid_TERP2O2_HO2 = 511 + integer, parameter :: rid_TERP2O2_NO = 512 + integer, parameter :: rid_TERP2OOH_OH = 513 + integer, parameter :: rid_TERPNIT_OH = 514 + integer, parameter :: rid_TERPO2_CH3O2 = 515 + integer, parameter :: rid_TERPO2_HO2 = 516 + integer, parameter :: rid_TERPO2_NO = 517 + integer, parameter :: rid_TERPOOH_OH = 518 + integer, parameter :: rid_TERPROD1_NO3 = 519 + integer, parameter :: rid_TERPROD1_OH = 520 + integer, parameter :: rid_TERPROD2_OH = 521 + integer, parameter :: rid_DMS_NO3 = 522 + integer, parameter :: rid_DMS_OHa = 523 + integer, parameter :: rid_OCS_O = 524 + integer, parameter :: rid_OCS_OH = 525 + integer, parameter :: rid_S_O2 = 526 + integer, parameter :: rid_SO2_OH_M = 527 + integer, parameter :: rid_S_O3 = 528 + integer, parameter :: rid_SO_BRO = 529 + integer, parameter :: rid_SO_CLO = 530 + integer, parameter :: rid_S_OH = 531 + integer, parameter :: rid_SO_NO2 = 532 + integer, parameter :: rid_SO_O2 = 533 + integer, parameter :: rid_SO_O3 = 534 + integer, parameter :: rid_SO_OCLO = 535 + integer, parameter :: rid_SO_OH = 536 + integer, parameter :: rid_usr_DMS_OH = 537 + integer, parameter :: rid_usr_SO3_H2O = 538 + integer, parameter :: rid_NH3_OH = 539 + integer, parameter :: rid_usr_HO2_aer = 540 + integer, parameter :: rid_usr_HONITR_aer = 541 + integer, parameter :: rid_usr_ISOPNITA_aer = 542 + integer, parameter :: rid_usr_ISOPNITB_aer = 543 + integer, parameter :: rid_usr_N2O5_aer = 544 + integer, parameter :: rid_usr_NC4CH2OH_aer = 545 + integer, parameter :: rid_usr_NC4CHO_aer = 546 + integer, parameter :: rid_usr_NH4_strat_tau = 547 + integer, parameter :: rid_usr_NO2_aer = 548 + integer, parameter :: rid_usr_NO3_aer = 549 + integer, parameter :: rid_usr_NTERPOOH_aer = 550 + integer, parameter :: rid_usr_ONITR_aer = 551 + integer, parameter :: rid_usr_TERPNIT_aer = 552 + integer, parameter :: rid_BCARY_NO3_vbs = 553 + integer, parameter :: rid_BCARYO2_HO2_vbs = 554 + integer, parameter :: rid_BCARYO2_NO_vbs = 555 + integer, parameter :: rid_BCARY_O3_vbs = 556 + integer, parameter :: rid_BCARY_OH_vbs = 557 + integer, parameter :: rid_BENZENE_OH_vbs = 558 + integer, parameter :: rid_BENZO2_HO2_vbs = 559 + integer, parameter :: rid_BENZO2_NO_vbs = 560 + integer, parameter :: rid_ISOP_NO3_vbs = 561 + integer, parameter :: rid_ISOPO2_HO2_vbs = 562 + integer, parameter :: rid_ISOPO2_NO_vbs = 563 + integer, parameter :: rid_ISOP_O3_vbs = 564 + integer, parameter :: rid_ISOP_OH_vbs = 565 + integer, parameter :: rid_IVOCbbO2_HO2_vbs = 566 + integer, parameter :: rid_IVOCbbO2_NO_vbs = 567 + integer, parameter :: rid_IVOCbb_OH_vbs = 568 + integer, parameter :: rid_IVOCffO2_HO2_vbs = 569 + integer, parameter :: rid_IVOCffO2_NO_vbs = 570 + integer, parameter :: rid_IVOCff_OH_vbs = 571 + integer, parameter :: rid_MTERP_NO3_vbs = 572 + integer, parameter :: rid_MTERPO2_HO2_vbs = 573 + integer, parameter :: rid_MTERPO2_NO_vbs = 574 + integer, parameter :: rid_MTERP_O3_vbs = 575 + integer, parameter :: rid_MTERP_OH_vbs = 576 + integer, parameter :: rid_SVOCbb_OH = 577 + integer, parameter :: rid_SVOCff_OH = 578 + integer, parameter :: rid_TOLUENE_OH_vbs = 579 + integer, parameter :: rid_TOLUO2_HO2_vbs = 580 + integer, parameter :: rid_TOLUO2_NO_vbs = 581 + integer, parameter :: rid_usr_GLYOXAL_aer = 582 + integer, parameter :: rid_XYLENES_OH_vbs = 583 + integer, parameter :: rid_XYLEO2_HO2_vbs = 584 + integer, parameter :: rid_XYLEO2_NO_vbs = 585 + integer, parameter :: rid_het1 = 586 + integer, parameter :: rid_het10 = 587 + integer, parameter :: rid_het11 = 588 + integer, parameter :: rid_het12 = 589 + integer, parameter :: rid_het13 = 590 + integer, parameter :: rid_het14 = 591 + integer, parameter :: rid_het15 = 592 + integer, parameter :: rid_het16 = 593 + integer, parameter :: rid_het17 = 594 + integer, parameter :: rid_het2 = 595 + integer, parameter :: rid_het3 = 596 + integer, parameter :: rid_het4 = 597 + integer, parameter :: rid_het5 = 598 + integer, parameter :: rid_het6 = 599 + integer, parameter :: rid_het7 = 600 + integer, parameter :: rid_het8 = 601 + integer, parameter :: rid_het9 = 602 + integer, parameter :: rid_elec1 = 603 + integer, parameter :: rid_elec2 = 604 + integer, parameter :: rid_elec3 = 605 + integer, parameter :: rid_ion_N2p_O2 = 606 + integer, parameter :: rid_ion_N2p_Oa = 607 + integer, parameter :: rid_ion_N2p_Ob = 608 + integer, parameter :: rid_ion_Np_O = 609 + integer, parameter :: rid_ion_Np_O2a = 610 + integer, parameter :: rid_ion_Np_O2b = 611 + integer, parameter :: rid_ion_O2p_N = 612 + integer, parameter :: rid_ion_O2p_N2 = 613 + integer, parameter :: rid_ion_O2p_NO = 614 + integer, parameter :: rid_ion_Op_CO2 = 615 + integer, parameter :: rid_ion_Op_N2 = 616 + integer, parameter :: rid_ion_Op_O2 = 617 + integer, parameter :: rid_E90_tau = 618 + integer, parameter :: rid_NH_50_tau = 619 + integer, parameter :: rid_NH_5_tau = 620 + integer, parameter :: rid_ST80_25_tau = 621 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/m_spc_id.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/m_spc_id.F90 new file mode 100644 index 0000000000..3f8aefe458 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/m_spc_id.F90 @@ -0,0 +1,277 @@ + module m_spc_id + implicit none + integer, parameter :: id_ALKNIT = 1 + integer, parameter :: id_ALKOOH = 2 + integer, parameter :: id_AOA_NH = 3 + integer, parameter :: id_bc_a1 = 4 + integer, parameter :: id_bc_a4 = 5 + integer, parameter :: id_BCARY = 6 + integer, parameter :: id_BCARYO2VBS = 7 + integer, parameter :: id_BENZENE = 8 + integer, parameter :: id_BENZO2VBS = 9 + integer, parameter :: id_BENZOOH = 10 + integer, parameter :: id_BEPOMUC = 11 + integer, parameter :: id_BIGALD = 12 + integer, parameter :: id_BIGALD1 = 13 + integer, parameter :: id_BIGALD2 = 14 + integer, parameter :: id_BIGALD3 = 15 + integer, parameter :: id_BIGALD4 = 16 + integer, parameter :: id_BIGALK = 17 + integer, parameter :: id_BIGENE = 18 + integer, parameter :: id_BR = 19 + integer, parameter :: id_BRCL = 20 + integer, parameter :: id_BRO = 21 + integer, parameter :: id_BRONO2 = 22 + integer, parameter :: id_BRY = 23 + integer, parameter :: id_BZALD = 24 + integer, parameter :: id_BZOOH = 25 + integer, parameter :: id_C2H2 = 26 + integer, parameter :: id_C2H4 = 27 + integer, parameter :: id_C2H5OH = 28 + integer, parameter :: id_C2H5OOH = 29 + integer, parameter :: id_C2H6 = 30 + integer, parameter :: id_C3H6 = 31 + integer, parameter :: id_C3H7OOH = 32 + integer, parameter :: id_C3H8 = 33 + integer, parameter :: id_C6H5OOH = 34 + integer, parameter :: id_CCL4 = 35 + integer, parameter :: id_CF2CLBR = 36 + integer, parameter :: id_CF3BR = 37 + integer, parameter :: id_CFC11 = 38 + integer, parameter :: id_CFC113 = 39 + integer, parameter :: id_CFC114 = 40 + integer, parameter :: id_CFC115 = 41 + integer, parameter :: id_CFC12 = 42 + integer, parameter :: id_CH2BR2 = 43 + integer, parameter :: id_CH2O = 44 + integer, parameter :: id_CH3BR = 45 + integer, parameter :: id_CH3CCL3 = 46 + integer, parameter :: id_CH3CHO = 47 + integer, parameter :: id_CH3CL = 48 + integer, parameter :: id_CH3CN = 49 + integer, parameter :: id_CH3COCH3 = 50 + integer, parameter :: id_CH3COCHO = 51 + integer, parameter :: id_CH3COOH = 52 + integer, parameter :: id_CH3COOOH = 53 + integer, parameter :: id_CH3OH = 54 + integer, parameter :: id_CH3OOH = 55 + integer, parameter :: id_CH4 = 56 + integer, parameter :: id_CHBR3 = 57 + integer, parameter :: id_CL = 58 + integer, parameter :: id_CL2 = 59 + integer, parameter :: id_CL2O2 = 60 + integer, parameter :: id_CLO = 61 + integer, parameter :: id_CLONO2 = 62 + integer, parameter :: id_CLY = 63 + integer, parameter :: id_CO = 64 + integer, parameter :: id_CO2 = 65 + integer, parameter :: id_COF2 = 66 + integer, parameter :: id_COFCL = 67 + integer, parameter :: id_CRESOL = 68 + integer, parameter :: id_DMS = 69 + integer, parameter :: id_dst_a1 = 70 + integer, parameter :: id_dst_a2 = 71 + integer, parameter :: id_dst_a3 = 72 + integer, parameter :: id_E90 = 73 + integer, parameter :: id_EOOH = 74 + integer, parameter :: id_F = 75 + integer, parameter :: id_GLYALD = 76 + integer, parameter :: id_GLYOXAL = 77 + integer, parameter :: id_H = 78 + integer, parameter :: id_H2 = 79 + integer, parameter :: id_H2402 = 80 + integer, parameter :: id_H2O2 = 81 + integer, parameter :: id_H2SO4 = 82 + integer, parameter :: id_HBR = 83 + integer, parameter :: id_HCFC141B = 84 + integer, parameter :: id_HCFC142B = 85 + integer, parameter :: id_HCFC22 = 86 + integer, parameter :: id_HCL = 87 + integer, parameter :: id_HCN = 88 + integer, parameter :: id_HCOOH = 89 + integer, parameter :: id_HF = 90 + integer, parameter :: id_HNO3 = 91 + integer, parameter :: id_HO2NO2 = 92 + integer, parameter :: id_HOBR = 93 + integer, parameter :: id_HOCL = 94 + integer, parameter :: id_HONITR = 95 + integer, parameter :: id_HPALD = 96 + integer, parameter :: id_HYAC = 97 + integer, parameter :: id_HYDRALD = 98 + integer, parameter :: id_IEPOX = 99 + integer, parameter :: id_ISOP = 100 + integer, parameter :: id_ISOPNITA = 101 + integer, parameter :: id_ISOPNITB = 102 + integer, parameter :: id_ISOPNO3 = 103 + integer, parameter :: id_ISOPNOOH = 104 + integer, parameter :: id_ISOPO2VBS = 105 + integer, parameter :: id_ISOPOOH = 106 + integer, parameter :: id_IVOCbb = 107 + integer, parameter :: id_IVOCbbO2VBS = 108 + integer, parameter :: id_IVOCff = 109 + integer, parameter :: id_IVOCffO2VBS = 110 + integer, parameter :: id_MACR = 111 + integer, parameter :: id_MACROOH = 112 + integer, parameter :: id_MEK = 113 + integer, parameter :: id_MEKOOH = 114 + integer, parameter :: id_MPAN = 115 + integer, parameter :: id_MTERP = 116 + integer, parameter :: id_MTERPO2VBS = 117 + integer, parameter :: id_MVK = 118 + integer, parameter :: id_N = 119 + integer, parameter :: id_N2O = 120 + integer, parameter :: id_N2O5 = 121 + integer, parameter :: id_NC4CH2OH = 122 + integer, parameter :: id_NC4CHO = 123 + integer, parameter :: id_ncl_a1 = 124 + integer, parameter :: id_ncl_a2 = 125 + integer, parameter :: id_ncl_a3 = 126 + integer, parameter :: id_NH3 = 127 + integer, parameter :: id_NH4 = 128 + integer, parameter :: id_NH_5 = 129 + integer, parameter :: id_NH_50 = 130 + integer, parameter :: id_NO = 131 + integer, parameter :: id_NO2 = 132 + integer, parameter :: id_NO3 = 133 + integer, parameter :: id_NOA = 134 + integer, parameter :: id_NTERPOOH = 135 + integer, parameter :: id_num_a1 = 136 + integer, parameter :: id_num_a2 = 137 + integer, parameter :: id_num_a3 = 138 + integer, parameter :: id_num_a4 = 139 + integer, parameter :: id_O = 140 + integer, parameter :: id_O2 = 141 + integer, parameter :: id_O3 = 142 + integer, parameter :: id_O3S = 143 + integer, parameter :: id_OCLO = 144 + integer, parameter :: id_OCS = 145 + integer, parameter :: id_ONITR = 146 + integer, parameter :: id_PAN = 147 + integer, parameter :: id_PBZNIT = 148 + integer, parameter :: id_PHENO = 149 + integer, parameter :: id_PHENOL = 150 + integer, parameter :: id_PHENOOH = 151 + integer, parameter :: id_pombb1_a1 = 152 + integer, parameter :: id_pombb1_a4 = 153 + integer, parameter :: id_pomff1_a1 = 154 + integer, parameter :: id_pomff1_a4 = 155 + integer, parameter :: id_POOH = 156 + integer, parameter :: id_ROOH = 157 + integer, parameter :: id_S = 158 + integer, parameter :: id_SF6 = 159 + integer, parameter :: id_SO = 160 + integer, parameter :: id_SO2 = 161 + integer, parameter :: id_SO3 = 162 + integer, parameter :: id_so4_a1 = 163 + integer, parameter :: id_so4_a2 = 164 + integer, parameter :: id_so4_a3 = 165 + integer, parameter :: id_soabb1_a1 = 166 + integer, parameter :: id_soabb1_a2 = 167 + integer, parameter :: id_soabb2_a1 = 168 + integer, parameter :: id_soabb2_a2 = 169 + integer, parameter :: id_soabb3_a1 = 170 + integer, parameter :: id_soabb3_a2 = 171 + integer, parameter :: id_soabb4_a1 = 172 + integer, parameter :: id_soabb4_a2 = 173 + integer, parameter :: id_soabb5_a1 = 174 + integer, parameter :: id_soabb5_a2 = 175 + integer, parameter :: id_soabg1_a1 = 176 + integer, parameter :: id_soabg1_a2 = 177 + integer, parameter :: id_soabg2_a1 = 178 + integer, parameter :: id_soabg2_a2 = 179 + integer, parameter :: id_soabg3_a1 = 180 + integer, parameter :: id_soabg3_a2 = 181 + integer, parameter :: id_soabg4_a1 = 182 + integer, parameter :: id_soabg4_a2 = 183 + integer, parameter :: id_soabg5_a1 = 184 + integer, parameter :: id_soabg5_a2 = 185 + integer, parameter :: id_soaff1_a1 = 186 + integer, parameter :: id_soaff1_a2 = 187 + integer, parameter :: id_soaff2_a1 = 188 + integer, parameter :: id_soaff2_a2 = 189 + integer, parameter :: id_soaff3_a1 = 190 + integer, parameter :: id_soaff3_a2 = 191 + integer, parameter :: id_soaff4_a1 = 192 + integer, parameter :: id_soaff4_a2 = 193 + integer, parameter :: id_soaff5_a1 = 194 + integer, parameter :: id_soaff5_a2 = 195 + integer, parameter :: id_SOAGbb0 = 196 + integer, parameter :: id_SOAGbb1 = 197 + integer, parameter :: id_SOAGbb2 = 198 + integer, parameter :: id_SOAGbb3 = 199 + integer, parameter :: id_SOAGbb4 = 200 + integer, parameter :: id_SOAGbg0 = 201 + integer, parameter :: id_SOAGbg1 = 202 + integer, parameter :: id_SOAGbg2 = 203 + integer, parameter :: id_SOAGbg3 = 204 + integer, parameter :: id_SOAGbg4 = 205 + integer, parameter :: id_SOAGff0 = 206 + integer, parameter :: id_SOAGff1 = 207 + integer, parameter :: id_SOAGff2 = 208 + integer, parameter :: id_SOAGff3 = 209 + integer, parameter :: id_SOAGff4 = 210 + integer, parameter :: id_ST80_25 = 211 + integer, parameter :: id_SVOCbb = 212 + integer, parameter :: id_SVOCff = 213 + integer, parameter :: id_TEPOMUC = 214 + integer, parameter :: id_TERP2OOH = 215 + integer, parameter :: id_TERPNIT = 216 + integer, parameter :: id_TERPOOH = 217 + integer, parameter :: id_TERPROD1 = 218 + integer, parameter :: id_TERPROD2 = 219 + integer, parameter :: id_TOLOOH = 220 + integer, parameter :: id_TOLUENE = 221 + integer, parameter :: id_TOLUO2VBS = 222 + integer, parameter :: id_XOOH = 223 + integer, parameter :: id_XYLENES = 224 + integer, parameter :: id_XYLENOOH = 225 + integer, parameter :: id_XYLEO2VBS = 226 + integer, parameter :: id_XYLOL = 227 + integer, parameter :: id_XYLOLOOH = 228 + integer, parameter :: id_NHDEP = 229 + integer, parameter :: id_NDEP = 230 + integer, parameter :: id_ACBZO2 = 231 + integer, parameter :: id_ALKO2 = 232 + integer, parameter :: id_BENZO2 = 233 + integer, parameter :: id_BZOO = 234 + integer, parameter :: id_C2H5O2 = 235 + integer, parameter :: id_C3H7O2 = 236 + integer, parameter :: id_C6H5O2 = 237 + integer, parameter :: id_CH3CO3 = 238 + integer, parameter :: id_CH3O2 = 239 + integer, parameter :: id_DICARBO2 = 240 + integer, parameter :: id_e = 241 + integer, parameter :: id_ENEO2 = 242 + integer, parameter :: id_EO = 243 + integer, parameter :: id_EO2 = 244 + integer, parameter :: id_HO2 = 245 + integer, parameter :: id_HOCH2OO = 246 + integer, parameter :: id_ISOPAO2 = 247 + integer, parameter :: id_ISOPBO2 = 248 + integer, parameter :: id_MACRO2 = 249 + integer, parameter :: id_MALO2 = 250 + integer, parameter :: id_MCO3 = 251 + integer, parameter :: id_MDIALO2 = 252 + integer, parameter :: id_MEKO2 = 253 + integer, parameter :: id_N2D = 254 + integer, parameter :: id_N2p = 255 + integer, parameter :: id_NOp = 256 + integer, parameter :: id_Np = 257 + integer, parameter :: id_NTERPO2 = 258 + integer, parameter :: id_O1D = 259 + integer, parameter :: id_O2_1D = 260 + integer, parameter :: id_O2_1S = 261 + integer, parameter :: id_O2p = 262 + integer, parameter :: id_OH = 263 + integer, parameter :: id_Op = 264 + integer, parameter :: id_PHENO2 = 265 + integer, parameter :: id_PO2 = 266 + integer, parameter :: id_RO2 = 267 + integer, parameter :: id_TERP2O2 = 268 + integer, parameter :: id_TERPO2 = 269 + integer, parameter :: id_TOLO2 = 270 + integer, parameter :: id_XO2 = 271 + integer, parameter :: id_XYLENO2 = 272 + integer, parameter :: id_XYLOLO2 = 273 + integer, parameter :: id_H2O = 274 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_adjrxt.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_adjrxt.F90 new file mode 100644 index 0000000000..505efdcecb --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_adjrxt.F90 @@ -0,0 +1,462 @@ + 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(:,:, 175) = rate(:,:, 175) * inv(:,:, 2) + rate(:,:, 179) = rate(:,:, 179) * inv(:,:, 2) + rate(:,:, 183) = rate(:,:, 183) * inv(:,:, 2) + rate(:,:, 188) = rate(:,:, 188) * inv(:,:, 1) + rate(:,:, 189) = rate(:,:, 189) * inv(:,:, 1) + rate(:,:, 195) = rate(:,:, 195) * inv(:,:, 1) + rate(:,:, 205) = rate(:,:, 205) * inv(:,:, 1) + rate(:,:, 217) = rate(:,:, 217) * inv(:,:, 1) + rate(:,:, 225) = rate(:,:, 225) * inv(:,:, 1) + rate(:,:, 228) = rate(:,:, 228) * inv(:,:, 1) + rate(:,:, 229) = rate(:,:, 229) * inv(:,:, 1) + rate(:,:, 230) = rate(:,:, 230) * inv(:,:, 1) + rate(:,:, 232) = rate(:,:, 232) * inv(:,:, 1) + rate(:,:, 233) = rate(:,:, 233) * inv(:,:, 1) + rate(:,:, 248) = rate(:,:, 248) * inv(:,:, 1) + rate(:,:, 268) = rate(:,:, 268) * inv(:,:, 1) + rate(:,:, 269) = rate(:,:, 269) * inv(:,:, 1) + rate(:,:, 279) = rate(:,:, 279) * inv(:,:, 1) + rate(:,:, 325) = rate(:,:, 325) * inv(:,:, 1) + rate(:,:, 335) = rate(:,:, 335) * inv(:,:, 1) + rate(:,:, 336) = rate(:,:, 336) * inv(:,:, 1) + rate(:,:, 337) = rate(:,:, 337) * inv(:,:, 1) + rate(:,:, 363) = rate(:,:, 363) * inv(:,:, 1) + rate(:,:, 364) = rate(:,:, 364) * inv(:,:, 1) + rate(:,:, 365) = rate(:,:, 365) * inv(:,:, 1) + rate(:,:, 385) = rate(:,:, 385) * inv(:,:, 1) + rate(:,:, 411) = rate(:,:, 411) * inv(:,:, 1) + rate(:,:, 414) = rate(:,:, 414) * inv(:,:, 1) + rate(:,:, 415) = rate(:,:, 415) * inv(:,:, 1) + rate(:,:, 472) = rate(:,:, 472) * inv(:,:, 1) + rate(:,:, 475) = rate(:,:, 475) * inv(:,:, 1) + rate(:,:, 478) = rate(:,:, 478) * inv(:,:, 1) + rate(:,:, 485) = rate(:,:, 485) * inv(:,:, 1) + rate(:,:, 490) = rate(:,:, 490) * inv(:,:, 1) + rate(:,:, 527) = rate(:,:, 527) * inv(:,:, 1) + rate(:,:, 613) = rate(:,:, 613) * inv(:,:, 2) + rate(:,:, 616) = rate(:,:, 616) * inv(:,:, 2) + rate(:,:, 173) = rate(:,:, 173) * m(:,:) + rate(:,:, 174) = rate(:,:, 174) * m(:,:) + rate(:,:, 176) = rate(:,:, 176) * m(:,:) + rate(:,:, 177) = rate(:,:, 177) * m(:,:) + rate(:,:, 178) = rate(:,:, 178) * m(:,:) + rate(:,:, 180) = rate(:,:, 180) * m(:,:) + rate(:,:, 181) = rate(:,:, 181) * m(:,:) + rate(:,:, 182) = rate(:,:, 182) * 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(:,:, 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * 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(:,:, 252) = rate(:,:, 252) * 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(:,:, 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(:,:, 292) = rate(:,:, 292) * 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(:,:, 322) = rate(:,:, 322) * 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(:,:, 329) = rate(:,:, 329) * 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(:,:, 336) = rate(:,:, 336) * m(:,:) + rate(:,:, 337) = rate(:,:, 337) * m(:,:) + rate(:,:, 338) = rate(:,:, 338) * m(:,:) + rate(:,:, 339) = rate(:,:, 339) * m(:,:) + rate(:,:, 340) = rate(:,:, 340) * m(:,:) + rate(:,:, 341) = rate(:,:, 341) * m(:,:) + rate(:,:, 342) = rate(:,:, 342) * m(:,:) + rate(:,:, 343) = rate(:,:, 343) * m(:,:) + rate(:,:, 344) = rate(:,:, 344) * m(:,:) + rate(:,:, 345) = rate(:,:, 345) * m(:,:) + rate(:,:, 346) = rate(:,:, 346) * m(:,:) + rate(:,:, 347) = rate(:,:, 347) * m(:,:) + rate(:,:, 348) = rate(:,:, 348) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 352) = rate(:,:, 352) * m(:,:) + rate(:,:, 353) = rate(:,:, 353) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 357) = rate(:,:, 357) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + rate(:,:, 360) = rate(:,:, 360) * m(:,:) + rate(:,:, 361) = rate(:,:, 361) * m(:,:) + rate(:,:, 362) = rate(:,:, 362) * m(:,:) + rate(:,:, 363) = rate(:,:, 363) * m(:,:) + rate(:,:, 364) = rate(:,:, 364) * m(:,:) + rate(:,:, 366) = rate(:,:, 366) * m(:,:) + rate(:,:, 367) = rate(:,:, 367) * m(:,:) + rate(:,:, 368) = rate(:,:, 368) * m(:,:) + rate(:,:, 369) = rate(:,:, 369) * m(:,:) + rate(:,:, 370) = rate(:,:, 370) * m(:,:) + rate(:,:, 371) = rate(:,:, 371) * m(:,:) + rate(:,:, 372) = rate(:,:, 372) * m(:,:) + rate(:,:, 373) = rate(:,:, 373) * m(:,:) + rate(:,:, 374) = rate(:,:, 374) * m(:,:) + rate(:,:, 375) = rate(:,:, 375) * m(:,:) + rate(:,:, 376) = rate(:,:, 376) * m(:,:) + rate(:,:, 377) = rate(:,:, 377) * m(:,:) + rate(:,:, 378) = rate(:,:, 378) * m(:,:) + rate(:,:, 379) = rate(:,:, 379) * m(:,:) + rate(:,:, 380) = rate(:,:, 380) * m(:,:) + rate(:,:, 381) = rate(:,:, 381) * m(:,:) + rate(:,:, 382) = rate(:,:, 382) * m(:,:) + rate(:,:, 383) = rate(:,:, 383) * m(:,:) + rate(:,:, 384) = rate(:,:, 384) * m(:,:) + rate(:,:, 385) = rate(:,:, 385) * m(:,:) + rate(:,:, 386) = rate(:,:, 386) * m(:,:) + rate(:,:, 387) = rate(:,:, 387) * m(:,:) + rate(:,:, 388) = rate(:,:, 388) * m(:,:) + rate(:,:, 389) = rate(:,:, 389) * m(:,:) + rate(:,:, 390) = rate(:,:, 390) * m(:,:) + rate(:,:, 391) = rate(:,:, 391) * m(:,:) + rate(:,:, 392) = rate(:,:, 392) * m(:,:) + rate(:,:, 393) = rate(:,:, 393) * m(:,:) + rate(:,:, 394) = rate(:,:, 394) * m(:,:) + rate(:,:, 395) = rate(:,:, 395) * m(:,:) + rate(:,:, 396) = rate(:,:, 396) * m(:,:) + rate(:,:, 397) = rate(:,:, 397) * m(:,:) + rate(:,:, 398) = rate(:,:, 398) * m(:,:) + rate(:,:, 399) = rate(:,:, 399) * m(:,:) + rate(:,:, 400) = rate(:,:, 400) * m(:,:) + rate(:,:, 401) = rate(:,:, 401) * m(:,:) + rate(:,:, 402) = rate(:,:, 402) * m(:,:) + rate(:,:, 403) = rate(:,:, 403) * m(:,:) + rate(:,:, 404) = rate(:,:, 404) * m(:,:) + rate(:,:, 405) = rate(:,:, 405) * m(:,:) + rate(:,:, 406) = rate(:,:, 406) * m(:,:) + rate(:,:, 407) = rate(:,:, 407) * m(:,:) + rate(:,:, 408) = rate(:,:, 408) * m(:,:) + rate(:,:, 409) = rate(:,:, 409) * m(:,:) + rate(:,:, 410) = rate(:,:, 410) * m(:,:) + rate(:,:, 411) = rate(:,:, 411) * m(:,:) + rate(:,:, 412) = rate(:,:, 412) * m(:,:) + rate(:,:, 413) = rate(:,:, 413) * m(:,:) + rate(:,:, 414) = rate(:,:, 414) * m(:,:) + rate(:,:, 416) = rate(:,:, 416) * m(:,:) + rate(:,:, 417) = rate(:,:, 417) * m(:,:) + rate(:,:, 418) = rate(:,:, 418) * m(:,:) + rate(:,:, 419) = rate(:,:, 419) * m(:,:) + rate(:,:, 420) = rate(:,:, 420) * m(:,:) + rate(:,:, 421) = rate(:,:, 421) * m(:,:) + rate(:,:, 422) = rate(:,:, 422) * m(:,:) + rate(:,:, 423) = rate(:,:, 423) * m(:,:) + rate(:,:, 424) = rate(:,:, 424) * m(:,:) + rate(:,:, 425) = rate(:,:, 425) * m(:,:) + rate(:,:, 426) = rate(:,:, 426) * m(:,:) + rate(:,:, 427) = rate(:,:, 427) * m(:,:) + rate(:,:, 428) = rate(:,:, 428) * m(:,:) + rate(:,:, 429) = rate(:,:, 429) * m(:,:) + rate(:,:, 430) = rate(:,:, 430) * m(:,:) + rate(:,:, 431) = rate(:,:, 431) * m(:,:) + rate(:,:, 432) = rate(:,:, 432) * m(:,:) + rate(:,:, 434) = rate(:,:, 434) * m(:,:) + rate(:,:, 435) = rate(:,:, 435) * m(:,:) + rate(:,:, 436) = rate(:,:, 436) * m(:,:) + rate(:,:, 437) = rate(:,:, 437) * m(:,:) + rate(:,:, 438) = rate(:,:, 438) * m(:,:) + rate(:,:, 439) = rate(:,:, 439) * m(:,:) + rate(:,:, 440) = rate(:,:, 440) * m(:,:) + rate(:,:, 441) = rate(:,:, 441) * m(:,:) + rate(:,:, 442) = rate(:,:, 442) * m(:,:) + rate(:,:, 443) = rate(:,:, 443) * m(:,:) + rate(:,:, 444) = rate(:,:, 444) * m(:,:) + rate(:,:, 445) = rate(:,:, 445) * m(:,:) + rate(:,:, 446) = rate(:,:, 446) * m(:,:) + rate(:,:, 447) = rate(:,:, 447) * m(:,:) + rate(:,:, 448) = rate(:,:, 448) * m(:,:) + rate(:,:, 449) = rate(:,:, 449) * m(:,:) + rate(:,:, 450) = rate(:,:, 450) * m(:,:) + rate(:,:, 451) = rate(:,:, 451) * m(:,:) + rate(:,:, 452) = rate(:,:, 452) * m(:,:) + rate(:,:, 453) = rate(:,:, 453) * m(:,:) + rate(:,:, 454) = rate(:,:, 454) * m(:,:) + rate(:,:, 455) = rate(:,:, 455) * m(:,:) + rate(:,:, 456) = rate(:,:, 456) * m(:,:) + rate(:,:, 457) = rate(:,:, 457) * m(:,:) + rate(:,:, 458) = rate(:,:, 458) * m(:,:) + rate(:,:, 459) = rate(:,:, 459) * m(:,:) + rate(:,:, 460) = rate(:,:, 460) * m(:,:) + rate(:,:, 461) = rate(:,:, 461) * m(:,:) + rate(:,:, 462) = rate(:,:, 462) * m(:,:) + rate(:,:, 463) = rate(:,:, 463) * m(:,:) + rate(:,:, 464) = rate(:,:, 464) * m(:,:) + rate(:,:, 465) = rate(:,:, 465) * m(:,:) + rate(:,:, 466) = rate(:,:, 466) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * m(:,:) + rate(:,:, 468) = rate(:,:, 468) * m(:,:) + rate(:,:, 469) = rate(:,:, 469) * m(:,:) + rate(:,:, 470) = rate(:,:, 470) * m(:,:) + rate(:,:, 471) = rate(:,:, 471) * m(:,:) + rate(:,:, 472) = rate(:,:, 472) * m(:,:) + rate(:,:, 473) = rate(:,:, 473) * m(:,:) + rate(:,:, 474) = rate(:,:, 474) * m(:,:) + rate(:,:, 475) = rate(:,:, 475) * m(:,:) + rate(:,:, 476) = rate(:,:, 476) * m(:,:) + rate(:,:, 477) = rate(:,:, 477) * m(:,:) + rate(:,:, 478) = rate(:,:, 478) * m(:,:) + rate(:,:, 479) = rate(:,:, 479) * m(:,:) + rate(:,:, 480) = rate(:,:, 480) * m(:,:) + rate(:,:, 481) = rate(:,:, 481) * m(:,:) + rate(:,:, 482) = rate(:,:, 482) * m(:,:) + rate(:,:, 483) = rate(:,:, 483) * m(:,:) + rate(:,:, 484) = rate(:,:, 484) * m(:,:) + rate(:,:, 485) = rate(:,:, 485) * m(:,:) + rate(:,:, 486) = rate(:,:, 486) * m(:,:) + rate(:,:, 487) = rate(:,:, 487) * m(:,:) + rate(:,:, 488) = rate(:,:, 488) * m(:,:) + rate(:,:, 489) = rate(:,:, 489) * m(:,:) + rate(:,:, 491) = rate(:,:, 491) * m(:,:) + rate(:,:, 492) = rate(:,:, 492) * m(:,:) + rate(:,:, 493) = rate(:,:, 493) * m(:,:) + rate(:,:, 494) = rate(:,:, 494) * m(:,:) + rate(:,:, 495) = rate(:,:, 495) * m(:,:) + rate(:,:, 496) = rate(:,:, 496) * m(:,:) + rate(:,:, 497) = rate(:,:, 497) * m(:,:) + rate(:,:, 498) = rate(:,:, 498) * m(:,:) + rate(:,:, 499) = rate(:,:, 499) * m(:,:) + rate(:,:, 500) = rate(:,:, 500) * m(:,:) + rate(:,:, 501) = rate(:,:, 501) * m(:,:) + rate(:,:, 502) = rate(:,:, 502) * m(:,:) + rate(:,:, 503) = rate(:,:, 503) * m(:,:) + rate(:,:, 504) = rate(:,:, 504) * m(:,:) + rate(:,:, 505) = rate(:,:, 505) * m(:,:) + rate(:,:, 506) = rate(:,:, 506) * m(:,:) + rate(:,:, 507) = rate(:,:, 507) * m(:,:) + rate(:,:, 508) = rate(:,:, 508) * m(:,:) + rate(:,:, 509) = rate(:,:, 509) * m(:,:) + rate(:,:, 510) = rate(:,:, 510) * m(:,:) + rate(:,:, 511) = rate(:,:, 511) * m(:,:) + rate(:,:, 512) = rate(:,:, 512) * m(:,:) + rate(:,:, 513) = rate(:,:, 513) * m(:,:) + rate(:,:, 514) = rate(:,:, 514) * m(:,:) + rate(:,:, 515) = rate(:,:, 515) * m(:,:) + rate(:,:, 516) = rate(:,:, 516) * m(:,:) + rate(:,:, 517) = rate(:,:, 517) * m(:,:) + rate(:,:, 518) = rate(:,:, 518) * m(:,:) + rate(:,:, 519) = rate(:,:, 519) * m(:,:) + rate(:,:, 520) = rate(:,:, 520) * m(:,:) + rate(:,:, 521) = rate(:,:, 521) * m(:,:) + rate(:,:, 522) = rate(:,:, 522) * m(:,:) + rate(:,:, 523) = rate(:,:, 523) * m(:,:) + rate(:,:, 524) = rate(:,:, 524) * m(:,:) + rate(:,:, 525) = rate(:,:, 525) * m(:,:) + rate(:,:, 526) = rate(:,:, 526) * m(:,:) + rate(:,:, 527) = rate(:,:, 527) * m(:,:) + rate(:,:, 528) = rate(:,:, 528) * m(:,:) + rate(:,:, 529) = rate(:,:, 529) * m(:,:) + rate(:,:, 530) = rate(:,:, 530) * m(:,:) + rate(:,:, 531) = rate(:,:, 531) * m(:,:) + rate(:,:, 532) = rate(:,:, 532) * m(:,:) + rate(:,:, 533) = rate(:,:, 533) * m(:,:) + rate(:,:, 534) = rate(:,:, 534) * m(:,:) + rate(:,:, 535) = rate(:,:, 535) * m(:,:) + rate(:,:, 536) = rate(:,:, 536) * m(:,:) + rate(:,:, 537) = rate(:,:, 537) * m(:,:) + rate(:,:, 538) = rate(:,:, 538) * m(:,:) + rate(:,:, 539) = rate(:,:, 539) * m(:,:) + rate(:,:, 553) = rate(:,:, 553) * m(:,:) + rate(:,:, 554) = rate(:,:, 554) * m(:,:) + rate(:,:, 555) = rate(:,:, 555) * m(:,:) + rate(:,:, 556) = rate(:,:, 556) * m(:,:) + rate(:,:, 557) = rate(:,:, 557) * m(:,:) + rate(:,:, 558) = rate(:,:, 558) * m(:,:) + rate(:,:, 559) = rate(:,:, 559) * m(:,:) + rate(:,:, 560) = rate(:,:, 560) * m(:,:) + rate(:,:, 561) = rate(:,:, 561) * m(:,:) + rate(:,:, 562) = rate(:,:, 562) * m(:,:) + rate(:,:, 563) = rate(:,:, 563) * m(:,:) + rate(:,:, 564) = rate(:,:, 564) * m(:,:) + rate(:,:, 565) = rate(:,:, 565) * m(:,:) + rate(:,:, 566) = rate(:,:, 566) * m(:,:) + rate(:,:, 567) = rate(:,:, 567) * m(:,:) + rate(:,:, 568) = rate(:,:, 568) * m(:,:) + rate(:,:, 569) = rate(:,:, 569) * m(:,:) + rate(:,:, 570) = rate(:,:, 570) * m(:,:) + rate(:,:, 571) = rate(:,:, 571) * m(:,:) + rate(:,:, 572) = rate(:,:, 572) * m(:,:) + rate(:,:, 573) = rate(:,:, 573) * m(:,:) + rate(:,:, 574) = rate(:,:, 574) * m(:,:) + rate(:,:, 575) = rate(:,:, 575) * m(:,:) + rate(:,:, 576) = rate(:,:, 576) * m(:,:) + rate(:,:, 577) = rate(:,:, 577) * m(:,:) + rate(:,:, 578) = rate(:,:, 578) * m(:,:) + rate(:,:, 579) = rate(:,:, 579) * m(:,:) + rate(:,:, 580) = rate(:,:, 580) * m(:,:) + rate(:,:, 581) = rate(:,:, 581) * m(:,:) + rate(:,:, 583) = rate(:,:, 583) * m(:,:) + rate(:,:, 584) = rate(:,:, 584) * m(:,:) + rate(:,:, 585) = rate(:,:, 585) * m(:,:) + rate(:,:, 587) = rate(:,:, 587) * m(:,:) + rate(:,:, 592) = rate(:,:, 592) * m(:,:) + rate(:,:, 593) = rate(:,:, 593) * m(:,:) + rate(:,:, 594) = rate(:,:, 594) * m(:,:) + rate(:,:, 597) = rate(:,:, 597) * m(:,:) + rate(:,:, 598) = rate(:,:, 598) * m(:,:) + rate(:,:, 599) = rate(:,:, 599) * m(:,:) + rate(:,:, 602) = rate(:,:, 602) * m(:,:) + rate(:,:, 603) = rate(:,:, 603) * m(:,:) + rate(:,:, 604) = rate(:,:, 604) * m(:,:) + rate(:,:, 605) = rate(:,:, 605) * m(:,:) + rate(:,:, 606) = rate(:,:, 606) * m(:,:) + rate(:,:, 607) = rate(:,:, 607) * m(:,:) + rate(:,:, 608) = rate(:,:, 608) * m(:,:) + rate(:,:, 609) = rate(:,:, 609) * m(:,:) + rate(:,:, 610) = rate(:,:, 610) * m(:,:) + rate(:,:, 611) = rate(:,:, 611) * m(:,:) + rate(:,:, 612) = rate(:,:, 612) * m(:,:) + rate(:,:, 614) = rate(:,:, 614) * m(:,:) + rate(:,:, 615) = rate(:,:, 615) * m(:,:) + rate(:,:, 617) = rate(:,:, 617) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_exp_sol.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/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_waccm_tsmlt_mam4_vbsext/mo_imp_sol.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/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_waccm_tsmlt_mam4_vbsext/mo_indprd.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_indprd.F90 new file mode 100644 index 0000000000..adb74605f1 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_indprd.F90 @@ -0,0 +1,309 @@ + 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(:,539)*y(:,263)*y(:,127) +rxt(:,547)*y(:,128) + prod(:,2) = (rxt(:,472)*y(:,240) +rxt(:,475)*y(:,250) +rxt(:,478)*y(:,252) + & + rxt(:,482)*y(:,149))*y(:,132) +.500_r8*rxt(:,411)*y(:,263)*y(:,115) & + +.200_r8*rxt(:,507)*y(:,258)*y(:,131) +.500_r8*rxt(:,519)*y(:,218) & + *y(:,133) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,190) = 0._r8 + prod(:,189) = 0._r8 + prod(:,1) = + extfrc(:,23) + prod(:,2) = + extfrc(:,17) + prod(:,3) = + extfrc(:,2) + prod(:,222) = 0._r8 + prod(:,71) = 0._r8 + prod(:,104) = 0._r8 + prod(:,81) = 0._r8 + prod(:,156) = 0._r8 + prod(:,105) = 0._r8 + prod(:,149) = 0._r8 + prod(:,162) = 0._r8 + prod(:,133) = 0._r8 + prod(:,186) = 0._r8 + prod(:,144) = 0._r8 + prod(:,117) = 0._r8 + prod(:,147) = 0._r8 + prod(:,254) = 0._r8 + prod(:,118) = 0._r8 + prod(:,256) = 0._r8 + prod(:,175) = 0._r8 + prod(:,4) = 0._r8 + prod(:,120) = 0._r8 + prod(:,140) = 0._r8 + prod(:,130) = 0._r8 + prod(:,174) = 0._r8 + prod(:,128) = 0._r8 + prod(:,141) = 0._r8 + prod(:,131) = 0._r8 + prod(:,232) = 0._r8 + prod(:,151) = 0._r8 + prod(:,132) = 0._r8 + prod(:,129) = 0._r8 + prod(:,88) = 0._r8 + prod(:,98) = 0._r8 + prod(:,99) = 0._r8 + prod(:,92) = 0._r8 + prod(:,100) = 0._r8 + prod(:,93) = 0._r8 + prod(:,101) = 0._r8 + prod(:,94) = 0._r8 + prod(:,165) = 0._r8 + prod(:,270) = 0._r8 + prod(:,180) = 0._r8 + prod(:,95) = 0._r8 + prod(:,233) = 0._r8 + prod(:,146) = 0._r8 + prod(:,89) = 0._r8 + prod(:,227) = 0._r8 + prod(:,243) = 0._r8 + prod(:,194) = 0._r8 + prod(:,181) = 0._r8 + prod(:,205) = 0._r8 + prod(:,152) = 0._r8 + prod(:,257) = 0._r8 + prod(:,153) = 0._r8 + prod(:,263) = 0._r8 + prod(:,107) = 0._r8 + prod(:,90) = 0._r8 + prod(:,266) = 0._r8 + prod(:,228) = 0._r8 + prod(:,5) = 0._r8 + prod(:,234) = + extfrc(:,1) + prod(:,250) = 0._r8 + prod(:,122) = 0._r8 + prod(:,124) = 0._r8 + prod(:,112) = 0._r8 + prod(:,136) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,9) = 0._r8 + prod(:,102) = 0._r8 + prod(:,214) = 0._r8 + prod(:,235) = 0._r8 + prod(:,224) = 0._r8 + prod(:,260) = 0._r8 + prod(:,251) = 0._r8 + prod(:,91) = 0._r8 + prod(:,185) = 0._r8 + prod(:,103) = 0._r8 + prod(:,207) = 0._r8 + prod(:,123) = 0._r8 + prod(:,125) = 0._r8 + prod(:,137) = 0._r8 + prod(:,253) = 0._r8 + prod(:,110) = 0._r8 + prod(:,216) = 0._r8 + prod(:,135) = 0._r8 + prod(:,259) = 0._r8 + prod(:,164) = 0._r8 + prod(:,202) = 0._r8 + prod(:,208) = 0._r8 + prod(:,237) = 0._r8 + prod(:,121) = 0._r8 + prod(:,238) = 0._r8 + prod(:,142) = 0._r8 + prod(:,96) = 0._r8 + prod(:,213) = 0._r8 + prod(:,182) = 0._r8 + prod(:,178) = 0._r8 + prod(:,241) = 0._r8 + prod(:,157) = 0._r8 + prod(:,72) = 0._r8 + prod(:,195) = 0._r8 + prod(:,65) = 0._r8 + prod(:,64) = 0._r8 + prod(:,80) = 0._r8 + prod(:,79) = 0._r8 + prod(:,242) = 0._r8 + prod(:,143) = 0._r8 + prod(:,171) = 0._r8 + prod(:,145) = 0._r8 + prod(:,184) = 0._r8 + prod(:,221) = 0._r8 + prod(:,73) = 0._r8 + prod(:,247) = 0._r8 + prod(:,220) = (.800_r8*rxt(:,112) +rxt(:,115) +rxt(:,116) + & + .800_r8*rxt(:,118)) + extfrc(:,19) + prod(:,126) = 0._r8 + prod(:,134) = 0._r8 + prod(:,155) = 0._r8 + prod(:,231) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,87) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) = 0._r8 + prod(:,267) = + extfrc(:,10) + prod(:,271) = + extfrc(:,11) + prod(:,268) = 0._r8 + prod(:,212) = 0._r8 + prod(:,154) = 0._r8 + prod(:,16) = + extfrc(:,3) + prod(:,17) = + extfrc(:,4) + prod(:,18) = 0._r8 + prod(:,19) = + extfrc(:,5) + prod(:,262) = 0._r8 + prod(:,255) = 0._r8 + prod(:,265) = 0._r8 + prod(:,20) = 0._r8 + prod(:,138) = 0._r8 + prod(:,148) = 0._r8 + prod(:,119) = 0._r8 + prod(:,177) = 0._r8 + prod(:,97) = 0._r8 + prod(:,166) = 0._r8 + prod(:,106) = 0._r8 + prod(:,139) = 0._r8 + prod(:,21) = + extfrc(:,6) + prod(:,22) = + extfrc(:,7) + prod(:,23) = + extfrc(:,8) + prod(:,24) = + extfrc(:,9) + prod(:,176) = 0._r8 + prod(:,150) = 0._r8 + prod(:,197) = 0._r8 + prod(:,25) = 0._r8 + prod(:,252) = 0._r8 + prod(:,219) = + extfrc(:,12) + prod(:,127) = 0._r8 + prod(:,26) = + extfrc(:,15) + prod(:,27) = + extfrc(:,16) + 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(:,34) = 0._r8 + prod(:,35) = 0._r8 + prod(:,36) = 0._r8 + prod(:,37) = 0._r8 + prod(:,38) = 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(:,45) = 0._r8 + prod(:,46) = 0._r8 + prod(:,47) = 0._r8 + prod(:,48) = 0._r8 + prod(:,49) = 0._r8 + prod(:,50) = 0._r8 + prod(:,51) = 0._r8 + prod(:,52) = 0._r8 + prod(:,53) = 0._r8 + prod(:,54) = 0._r8 + prod(:,55) = 0._r8 + prod(:,56) = 0._r8 + prod(:,57) = 0._r8 + prod(:,58) = 0._r8 + prod(:,59) = 0._r8 + prod(:,60) = 0._r8 + prod(:,61) = 0._r8 + prod(:,62) = 0._r8 + prod(:,63) = 0._r8 + prod(:,66) = 0._r8 + prod(:,67) = 0._r8 + prod(:,68) = 0._r8 + prod(:,69) = 0._r8 + prod(:,70) = 0._r8 + prod(:,74) = 0._r8 + prod(:,75) = 0._r8 + prod(:,76) = 0._r8 + prod(:,77) = 0._r8 + prod(:,78) = 0._r8 + prod(:,82) = 0._r8 + prod(:,83) = + extfrc(:,13) + prod(:,84) = + extfrc(:,14) + prod(:,113) = 0._r8 + prod(:,192) = 0._r8 + prod(:,187) = 0._r8 + prod(:,167) = 0._r8 + prod(:,226) = 0._r8 + prod(:,230) = 0._r8 + prod(:,183) = 0._r8 + prod(:,111) = 0._r8 + prod(:,85) = 0._r8 + prod(:,114) = 0._r8 + prod(:,115) = 0._r8 + prod(:,196) = 0._r8 + prod(:,86) = 0._r8 + prod(:,116) = 0._r8 + prod(:,158) = 0._r8 + prod(:,172) = 0._r8 + prod(:,223) = 0._r8 + prod(:,168) = 0._r8 + prod(:,159) = 0._r8 + prod(:,215) = 0._r8 + prod(:,218) = 0._r8 + prod(:,188) = 0._r8 + prod(:,249) = 0._r8 + prod(:,258) = 0._r8 + prod(:,201) = 0._r8 + prod(:,211) = (rxt(:,113) +rxt(:,114) +rxt(:,115) +rxt(:,116) +rxt(:,117) + & + rxt(:,119)) + extfrc(:,18) + prod(:,179) = 0._r8 + prod(:,163) = 0._r8 + prod(:,203) = 0._r8 + prod(:,269) = 0._r8 + prod(:,160) = 0._r8 + prod(:,244) = 0._r8 + prod(:,245) = 0._r8 + prod(:,246) = 0._r8 + prod(:,198) = 0._r8 + prod(:,248) = 0._r8 + prod(:,217) = 0._r8 + prod(:,191) = 0._r8 + prod(:,173) = (1.200_r8*rxt(:,112) +rxt(:,113) +rxt(:,117) + & + 1.200_r8*rxt(:,118)) + extfrc(:,20) + prod(:,193) = (rxt(:,114) +rxt(:,119)) + extfrc(:,24) + prod(:,209) = 0._r8 + prod(:,169) = (rxt(:,113) +rxt(:,115) +rxt(:,116) +rxt(:,117)) + extfrc(:,25) + prod(:,229) = 0._r8 + prod(:,264) = 0._r8 + prod(:,108) = 0._r8 + prod(:,109) = 0._r8 + prod(:,210) = 0._r8 + prod(:,261) = + extfrc(:,21) + prod(:,204) = + extfrc(:,22) + prod(:,161) = 0._r8 + prod(:,206) = 0._r8 + prod(:,239) = 0._r8 + prod(:,236) = 0._r8 + prod(:,225) = 0._r8 + prod(:,199) = 0._r8 + prod(:,240) = 0._r8 + prod(:,200) = 0._r8 + prod(:,170) = 0._r8 + prod(:,272) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_lin_matrix.F90 new file mode 100644 index 0000000000..9b7c4ba738 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_lin_matrix.F90 @@ -0,0 +1,743 @@ + 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,708) = -( rxt(k,20) + het_rates(k,1) ) + mat(k,697) = -( rxt(k,21) + het_rates(k,2) ) + mat(k,1) = -( het_rates(k,3) ) + mat(k,2) = -( het_rates(k,4) ) + mat(k,3) = -( het_rates(k,5) ) + mat(k,1048) = -( het_rates(k,6) ) + mat(k,82) = -( het_rates(k,7) ) + mat(k,204) = -( het_rates(k,8) ) + mat(k,113) = -( het_rates(k,9) ) + mat(k,465) = -( rxt(k,22) + het_rates(k,10) ) + mat(k,210) = -( rxt(k,23) + het_rates(k,11) ) + mat(k,423) = -( rxt(k,24) + het_rates(k,12) ) + mat(k,504) = -( rxt(k,25) + het_rates(k,13) ) + mat(k,466) = .500_r8*rxt(k,22) + mat(k,211) = rxt(k,23) + mat(k,652) = .200_r8*rxt(k,71) + mat(k,762) = .060_r8*rxt(k,73) + mat(k,335) = -( rxt(k,26) + het_rates(k,14) ) + mat(k,651) = .200_r8*rxt(k,71) + mat(k,760) = .200_r8*rxt(k,73) + mat(k,678) = -( rxt(k,27) + het_rates(k,15) ) + mat(k,278) = rxt(k,47) + mat(k,1155) = rxt(k,57) + mat(k,654) = .200_r8*rxt(k,71) + mat(k,763) = .150_r8*rxt(k,73) + mat(k,389) = -( rxt(k,28) + het_rates(k,16) ) + mat(k,761) = .210_r8*rxt(k,73) + mat(k,265) = -( het_rates(k,17) ) + mat(k,407) = -( het_rates(k,18) ) + mat(k,1553) = -( het_rates(k,19) ) + mat(k,269) = rxt(k,75) + mat(k,1605) = rxt(k,76) + mat(k,588) = rxt(k,78) + mat(k,179) = rxt(k,80) + mat(k,185) = rxt(k,81) + mat(k,521) = 2.000_r8*rxt(k,87) + mat(k,628) = rxt(k,88) + mat(k,449) = 3.000_r8*rxt(k,91) + mat(k,153) = 2.000_r8*rxt(k,99) + mat(k,871) = rxt(k,100) + mat(k,831) = rxt(k,106) + mat(k,268) = -( rxt(k,75) + het_rates(k,20) ) + mat(k,1607) = -( rxt(k,76) + het_rates(k,21) ) + mat(k,589) = rxt(k,77) + mat(k,586) = -( rxt(k,77) + rxt(k,78) + rxt(k,588) + rxt(k,591) + rxt(k,596) & + + het_rates(k,22) ) + mat(k,4) = -( het_rates(k,23) ) + mat(k,274) = -( het_rates(k,24) ) + mat(k,370) = rxt(k,29) + mat(k,371) = -( rxt(k,29) + het_rates(k,25) ) + mat(k,317) = -( het_rates(k,26) ) + mat(k,578) = -( het_rates(k,27) ) + mat(k,309) = -( het_rates(k,28) ) + mat(k,376) = -( rxt(k,30) + het_rates(k,29) ) + mat(k,323) = -( het_rates(k,30) ) + mat(k,1175) = -( het_rates(k,31) ) + mat(k,1412) = .700_r8*rxt(k,56) + mat(k,435) = -( rxt(k,31) + het_rates(k,32) ) + mat(k,329) = -( het_rates(k,33) ) + mat(k,313) = -( rxt(k,32) + het_rates(k,34) ) + mat(k,142) = -( rxt(k,79) + het_rates(k,35) ) + mat(k,177) = -( rxt(k,80) + het_rates(k,36) ) + mat(k,182) = -( rxt(k,81) + het_rates(k,37) ) + mat(k,155) = -( rxt(k,82) + het_rates(k,38) ) + mat(k,187) = -( rxt(k,83) + het_rates(k,39) ) + mat(k,159) = -( rxt(k,84) + het_rates(k,40) ) + mat(k,192) = -( rxt(k,85) + het_rates(k,41) ) + mat(k,163) = -( rxt(k,86) + het_rates(k,42) ) + mat(k,519) = -( rxt(k,87) + het_rates(k,43) ) + mat(k,2448) = -( rxt(k,33) + rxt(k,34) + het_rates(k,44) ) + mat(k,716) = .100_r8*rxt(k,20) + mat(k,706) = .100_r8*rxt(k,21) + mat(k,445) = rxt(k,39) + mat(k,1644) = .180_r8*rxt(k,40) + mat(k,1212) = rxt(k,44) + mat(k,1247) = .330_r8*rxt(k,46) + mat(k,1255) = rxt(k,48) + mat(k,759) = rxt(k,50) + mat(k,1320) = 1.340_r8*rxt(k,51) + mat(k,919) = rxt(k,58) + mat(k,600) = rxt(k,63) + mat(k,433) = rxt(k,64) + mat(k,735) = .375_r8*rxt(k,66) + mat(k,536) = .400_r8*rxt(k,68) + mat(k,1153) = .680_r8*rxt(k,70) + mat(k,495) = rxt(k,328) + mat(k,511) = 2.000_r8*rxt(k,358) + mat(k,626) = -( rxt(k,88) + het_rates(k,45) ) + mat(k,167) = -( rxt(k,89) + het_rates(k,46) ) + mat(k,1193) = -( rxt(k,35) + het_rates(k,47) ) + mat(k,712) = .400_r8*rxt(k,20) + mat(k,702) = .400_r8*rxt(k,21) + mat(k,378) = rxt(k,30) + mat(k,1234) = .330_r8*rxt(k,46) + mat(k,396) = rxt(k,54) + mat(k,596) = rxt(k,63) + mat(k,399) = -( rxt(k,90) + het_rates(k,48) ) + mat(k,145) = -( het_rates(k,49) ) + mat(k,1110) = -( rxt(k,36) + het_rates(k,50) ) + mat(k,711) = .250_r8*rxt(k,20) + mat(k,701) = .250_r8*rxt(k,21) + mat(k,437) = .820_r8*rxt(k,31) + mat(k,1233) = .170_r8*rxt(k,46) + mat(k,727) = .300_r8*rxt(k,66) + mat(k,533) = .050_r8*rxt(k,68) + mat(k,1144) = .500_r8*rxt(k,70) + mat(k,1323) = -( rxt(k,37) + het_rates(k,51) ) + mat(k,426) = .180_r8*rxt(k,24) + mat(k,391) = rxt(k,28) + mat(k,659) = .400_r8*rxt(k,71) + mat(k,771) = .540_r8*rxt(k,73) + mat(k,480) = .510_r8*rxt(k,74) + mat(k,747) = -( het_rates(k,52) ) + mat(k,635) = -( rxt(k,38) + het_rates(k,53) ) + mat(k,855) = -( het_rates(k,54) ) + mat(k,441) = -( rxt(k,39) + het_rates(k,55) ) + mat(k,1631) = -( rxt(k,40) + rxt(k,41) + het_rates(k,56) ) + mat(k,447) = -( rxt(k,91) + het_rates(k,57) ) + mat(k,1995) = -( het_rates(k,58) ) + mat(k,270) = rxt(k,75) + mat(k,143) = 4.000_r8*rxt(k,79) + mat(k,180) = rxt(k,80) + mat(k,157) = 2.000_r8*rxt(k,82) + mat(k,190) = 2.000_r8*rxt(k,83) + mat(k,161) = 2.000_r8*rxt(k,84) + mat(k,195) = rxt(k,85) + mat(k,165) = 2.000_r8*rxt(k,86) + mat(k,169) = 3.000_r8*rxt(k,89) + mat(k,404) = rxt(k,90) + mat(k,220) = 2.000_r8*rxt(k,92) + mat(k,149) = 2.000_r8*rxt(k,93) + mat(k,2129) = rxt(k,94) + mat(k,1123) = rxt(k,95) + mat(k,292) = rxt(k,98) + mat(k,288) = rxt(k,101) + mat(k,298) = rxt(k,102) + mat(k,357) = rxt(k,103) + mat(k,1544) = rxt(k,104) + mat(k,883) = rxt(k,107) + mat(k,219) = -( rxt(k,92) + het_rates(k,59) ) + mat(k,148) = -( rxt(k,93) + rxt(k,269) + het_rates(k,60) ) + mat(k,2132) = -( rxt(k,94) + het_rates(k,61) ) + mat(k,1124) = rxt(k,96) + mat(k,364) = rxt(k,108) + mat(k,150) = 2.000_r8*rxt(k,269) + mat(k,1118) = -( rxt(k,95) + rxt(k,96) + rxt(k,590) + rxt(k,595) + rxt(k,601) & + + het_rates(k,62) ) + mat(k,5) = -( het_rates(k,63) ) + mat(k,1202) = -( het_rates(k,64) ) + mat(k,212) = 1.500_r8*rxt(k,23) + mat(k,425) = .450_r8*rxt(k,24) + mat(k,680) = .600_r8*rxt(k,27) + mat(k,390) = rxt(k,28) + mat(k,2428) = rxt(k,33) + rxt(k,34) + mat(k,1194) = rxt(k,35) + mat(k,1322) = rxt(k,37) + mat(k,1624) = .380_r8*rxt(k,40) + mat(k,1491) = rxt(k,42) + rxt(k,110) + mat(k,1207) = rxt(k,44) + mat(k,1085) = 2.000_r8*rxt(k,45) + mat(k,1235) = .330_r8*rxt(k,46) + mat(k,1310) = 1.340_r8*rxt(k,52) + mat(k,1414) = .700_r8*rxt(k,56) + mat(k,244) = 1.500_r8*rxt(k,65) + mat(k,729) = .250_r8*rxt(k,66) + mat(k,1105) = rxt(k,69) + mat(k,1146) = 1.700_r8*rxt(k,70) + mat(k,418) = rxt(k,137) + mat(k,1492) = -( rxt(k,42) + rxt(k,110) + het_rates(k,65) ) + mat(k,637) = rxt(k,38) + mat(k,1625) = .440_r8*rxt(k,40) + mat(k,604) = .400_r8*rxt(k,61) + mat(k,732) = rxt(k,66) + mat(k,1149) = .800_r8*rxt(k,70) + mat(k,282) = -( rxt(k,97) + het_rates(k,66) ) + mat(k,178) = rxt(k,80) + mat(k,183) = rxt(k,81) + mat(k,188) = rxt(k,83) + mat(k,160) = 2.000_r8*rxt(k,84) + mat(k,193) = 2.000_r8*rxt(k,85) + mat(k,164) = rxt(k,86) + mat(k,152) = 2.000_r8*rxt(k,99) + mat(k,294) = rxt(k,102) + mat(k,353) = rxt(k,103) + mat(k,290) = -( rxt(k,98) + het_rates(k,67) ) + mat(k,156) = rxt(k,82) + mat(k,189) = rxt(k,83) + mat(k,286) = rxt(k,101) + mat(k,238) = -( het_rates(k,68) ) + mat(k,347) = -( het_rates(k,69) ) + mat(k,6) = -( het_rates(k,70) ) + mat(k,7) = -( het_rates(k,71) ) + mat(k,8) = -( het_rates(k,72) ) + mat(k,9) = -( rxt(k,618) + het_rates(k,73) ) + mat(k,197) = -( rxt(k,43) + het_rates(k,74) ) + mat(k,941) = -( het_rates(k,75) ) + mat(k,184) = rxt(k,81) + mat(k,194) = rxt(k,85) + mat(k,283) = 2.000_r8*rxt(k,97) + mat(k,291) = rxt(k,98) + mat(k,345) = rxt(k,105) + 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,1208) = -( rxt(k,44) + het_rates(k,76) ) + mat(k,1236) = .330_r8*rxt(k,46) + mat(k,730) = .250_r8*rxt(k,66) + mat(k,1084) = -( rxt(k,45) + rxt(k,582) + het_rates(k,77) ) + mat(k,468) = rxt(k,22) + mat(k,424) = .130_r8*rxt(k,24) + mat(k,367) = .700_r8*rxt(k,62) + mat(k,658) = .600_r8*rxt(k,71) + mat(k,769) = .340_r8*rxt(k,73) + mat(k,479) = .170_r8*rxt(k,74) + mat(k,1730) = -( het_rates(k,78) ) + mat(k,2510) = 2.000_r8*rxt(k,2) + rxt(k,3) + mat(k,2438) = 2.000_r8*rxt(k,34) + mat(k,443) = rxt(k,39) + mat(k,1634) = .330_r8*rxt(k,40) + rxt(k,41) + mat(k,873) = rxt(k,100) + mat(k,1541) = rxt(k,104) + mat(k,346) = rxt(k,105) + mat(k,1503) = -( het_rates(k,79) ) + mat(k,2501) = rxt(k,1) + mat(k,2430) = rxt(k,33) + mat(k,1626) = 1.440_r8*rxt(k,40) + mat(k,151) = -( rxt(k,99) + het_rates(k,80) ) + mat(k,671) = -( rxt(k,4) + het_rates(k,81) ) + mat(k,200) = -( rxt(k,136) + het_rates(k,82) ) + mat(k,870) = -( rxt(k,100) + het_rates(k,83) ) + mat(k,285) = -( rxt(k,101) + het_rates(k,84) ) + mat(k,295) = -( rxt(k,102) + het_rates(k,85) ) + mat(k,354) = -( rxt(k,103) + het_rates(k,86) ) + mat(k,1537) = -( rxt(k,104) + het_rates(k,87) ) + mat(k,226) = -( het_rates(k,88) ) + mat(k,962) = -( het_rates(k,89) ) + mat(k,344) = -( rxt(k,105) + het_rates(k,90) ) + mat(k,1708) = -( rxt(k,9) + het_rates(k,91) ) + mat(k,1243) = rxt(k,541) + mat(k,646) = rxt(k,542) + mat(k,615) = rxt(k,543) + mat(k,339) = 2.000_r8*rxt(k,544) + 2.000_r8*rxt(k,586) + 2.000_r8*rxt(k,589) & + + 2.000_r8*rxt(k,600) + mat(k,462) = rxt(k,545) + mat(k,1165) = rxt(k,546) + mat(k,2482) = .500_r8*rxt(k,548) + mat(k,2291) = rxt(k,549) + mat(k,456) = rxt(k,550) + mat(k,272) = rxt(k,551) + mat(k,684) = rxt(k,552) + mat(k,590) = rxt(k,588) + rxt(k,591) + rxt(k,596) + mat(k,1120) = rxt(k,590) + rxt(k,595) + rxt(k,601) + mat(k,512) = -( rxt(k,10) + rxt(k,11) + rxt(k,232) + het_rates(k,92) ) + mat(k,829) = -( rxt(k,106) + het_rates(k,93) ) + mat(k,587) = rxt(k,588) + rxt(k,591) + rxt(k,596) + mat(k,879) = -( rxt(k,107) + het_rates(k,94) ) + mat(k,1117) = rxt(k,590) + rxt(k,595) + rxt(k,601) + mat(k,1237) = -( rxt(k,46) + rxt(k,541) + het_rates(k,95) ) + mat(k,277) = -( rxt(k,47) + het_rates(k,96) ) + mat(k,1357) = rxt(k,433) + mat(k,1250) = -( rxt(k,48) + het_rates(k,97) ) + mat(k,1238) = .170_r8*rxt(k,46) + mat(k,381) = -( het_rates(k,98) ) + mat(k,171) = -( het_rates(k,99) ) + mat(k,924) = -( het_rates(k,100) ) + mat(k,642) = -( rxt(k,542) + het_rates(k,101) ) + mat(k,610) = -( rxt(k,543) + het_rates(k,102) ) + mat(k,1295) = -( het_rates(k,103) ) + mat(k,471) = -( rxt(k,49) + het_rates(k,104) ) + mat(k,88) = -( het_rates(k,105) ) + mat(k,753) = -( rxt(k,50) + het_rates(k,106) ) + mat(k,472) = rxt(k,49) + mat(k,71) = -( het_rates(k,107) ) + mat(k,69) = -( het_rates(k,108) ) + mat(k,107) = -( het_rates(k,109) ) + mat(k,105) = -( het_rates(k,110) ) + mat(k,1311) = -( rxt(k,51) + rxt(k,52) + het_rates(k,111) ) + mat(k,755) = .300_r8*rxt(k,50) + mat(k,384) = -( het_rates(k,112) ) + mat(k,561) = -( rxt(k,53) + het_rates(k,113) ) + mat(k,707) = .800_r8*rxt(k,20) + mat(k,696) = .800_r8*rxt(k,21) + mat(k,394) = -( rxt(k,54) + het_rates(k,114) ) + mat(k,662) = -( rxt(k,55) + rxt(k,415) + het_rates(k,115) ) + mat(k,1020) = -( het_rates(k,116) ) + mat(k,94) = -( het_rates(k,117) ) + mat(k,1418) = -( rxt(k,56) + het_rates(k,118) ) + mat(k,756) = .700_r8*rxt(k,50) + mat(k,1001) = -( rxt(k,111) + het_rates(k,119) ) + mat(k,2199) = rxt(k,15) + mat(k,850) = rxt(k,616) + mat(k,300) = -( rxt(k,12) + het_rates(k,120) ) + mat(k,338) = -( rxt(k,13) + rxt(k,14) + rxt(k,233) + rxt(k,544) + rxt(k,586) & + + rxt(k,589) + rxt(k,600) + het_rates(k,121) ) + mat(k,459) = -( rxt(k,545) + het_rates(k,122) ) + mat(k,1159) = -( rxt(k,57) + rxt(k,546) + het_rates(k,123) ) + mat(k,10) = -( het_rates(k,124) ) + mat(k,11) = -( het_rates(k,125) ) + mat(k,12) = -( het_rates(k,126) ) + mat(k,139) = -( het_rates(k,127) ) + mat(k,13) = -( rxt(k,547) + het_rates(k,128) ) + mat(k,14) = -( rxt(k,620) + het_rates(k,129) ) + mat(k,15) = -( rxt(k,619) + het_rates(k,130) ) + mat(k,2239) = -( rxt(k,15) + rxt(k,16) + het_rates(k,131) ) + mat(k,341) = rxt(k,14) + mat(k,2490) = rxt(k,17) + .500_r8*rxt(k,548) + mat(k,2299) = rxt(k,19) + mat(k,901) = rxt(k,613) + mat(k,2494) = -( rxt(k,17) + rxt(k,548) + het_rates(k,132) ) + mat(k,1720) = rxt(k,9) + mat(k,517) = rxt(k,11) + rxt(k,232) + mat(k,343) = rxt(k,13) + rxt(k,233) + mat(k,2303) = rxt(k,18) + mat(k,717) = rxt(k,20) + mat(k,1248) = rxt(k,46) + mat(k,476) = rxt(k,49) + mat(k,670) = rxt(k,55) + rxt(k,415) + mat(k,1170) = rxt(k,57) + mat(k,920) = rxt(k,58) + mat(k,458) = rxt(k,59) + mat(k,273) = rxt(k,60) + mat(k,609) = .600_r8*rxt(k,61) + rxt(k,365) + mat(k,687) = rxt(k,67) + mat(k,593) = rxt(k,77) + mat(k,1126) = rxt(k,96) + mat(k,176) = rxt(k,490) + mat(k,2300) = -( rxt(k,18) + rxt(k,19) + rxt(k,549) + het_rates(k,133) ) + mat(k,515) = rxt(k,10) + mat(k,342) = rxt(k,13) + rxt(k,14) + rxt(k,233) + mat(k,607) = .400_r8*rxt(k,61) + mat(k,592) = rxt(k,78) + mat(k,1125) = rxt(k,95) + mat(k,915) = -( rxt(k,58) + het_rates(k,134) ) + mat(k,453) = -( rxt(k,59) + rxt(k,550) + het_rates(k,135) ) + mat(k,16) = -( het_rates(k,136) ) + mat(k,17) = -( het_rates(k,137) ) + mat(k,18) = -( het_rates(k,138) ) + mat(k,19) = -( het_rates(k,139) ) + mat(k,1948) = -( rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + + rxt(k,125) + het_rates(k,140) ) + mat(k,2512) = rxt(k,2) + mat(k,1588) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,127) + rxt(k,128) + rxt(k,129) & + + rxt(k,131) + rxt(k,132) + rxt(k,133) + 2.000_r8*rxt(k,134) & + + 2.000_r8*rxt(k,135) + mat(k,2101) = rxt(k,8) + mat(k,340) = rxt(k,14) + mat(k,2234) = rxt(k,15) + mat(k,2485) = rxt(k,17) + mat(k,2294) = rxt(k,18) + mat(k,1636) = .180_r8*rxt(k,40) + mat(k,1496) = rxt(k,42) + rxt(k,110) + mat(k,1611) = rxt(k,76) + mat(k,2128) = rxt(k,94) + mat(k,363) = rxt(k,108) + mat(k,1524) = rxt(k,138) + mat(k,992) = rxt(k,139) + mat(k,307) = rxt(k,140) + mat(k,2037) = rxt(k,175) + mat(k,1584) = -( rxt(k,5) + rxt(k,6) + rxt(k,126) + rxt(k,127) + rxt(k,128) & + + rxt(k,129) + rxt(k,130) + rxt(k,131) + rxt(k,132) + rxt(k,133) & + + rxt(k,134) + rxt(k,135) + het_rates(k,141) ) + mat(k,2094) = rxt(k,8) + mat(k,2287) = rxt(k,19) + mat(k,222) = rxt(k,171) + rxt(k,179) + mat(k,225) = rxt(k,172) + mat(k,2104) = -( rxt(k,7) + rxt(k,8) + het_rates(k,142) ) + mat(k,20) = -( het_rates(k,143) ) + mat(k,360) = -( rxt(k,108) + het_rates(k,144) ) + mat(k,415) = -( rxt(k,137) + het_rates(k,145) ) + mat(k,271) = -( rxt(k,60) + rxt(k,551) + het_rates(k,146) ) + mat(k,602) = -( rxt(k,61) + rxt(k,365) + het_rates(k,147) ) + mat(k,174) = -( rxt(k,490) + het_rates(k,148) ) + mat(k,526) = -( het_rates(k,149) ) + mat(k,314) = rxt(k,32) + mat(k,214) = -( het_rates(k,150) ) + mat(k,365) = -( rxt(k,62) + het_rates(k,151) ) + mat(k,21) = -( het_rates(k,152) ) + mat(k,22) = -( het_rates(k,153) ) + mat(k,23) = -( het_rates(k,154) ) + mat(k,24) = -( het_rates(k,155) ) + mat(k,594) = -( rxt(k,63) + het_rates(k,156) ) + mat(k,429) = -( rxt(k,64) + het_rates(k,157) ) + mat(k,775) = -( het_rates(k,158) ) + mat(k,416) = rxt(k,137) + mat(k,1516) = rxt(k,138) + mat(k,25) = -( rxt(k,109) + het_rates(k,159) ) + mat(k,1518) = -( rxt(k,138) + het_rates(k,160) ) + mat(k,990) = rxt(k,139) + mat(k,989) = -( rxt(k,139) + het_rates(k,161) ) + mat(k,306) = rxt(k,140) + mat(k,305) = -( rxt(k,140) + het_rates(k,162) ) + mat(k,201) = rxt(k,136) + mat(k,26) = -( het_rates(k,163) ) + mat(k,27) = -( het_rates(k,164) ) + mat(k,28) = -( het_rates(k,165) ) + mat(k,29) = -( rxt(k,141) + het_rates(k,166) ) + mat(k,30) = -( rxt(k,142) + het_rates(k,167) ) + mat(k,31) = -( rxt(k,143) + het_rates(k,168) ) + mat(k,32) = -( rxt(k,144) + het_rates(k,169) ) + mat(k,33) = -( rxt(k,145) + het_rates(k,170) ) + mat(k,34) = -( rxt(k,146) + het_rates(k,171) ) + mat(k,35) = -( rxt(k,147) + het_rates(k,172) ) + mat(k,36) = -( rxt(k,148) + het_rates(k,173) ) + mat(k,37) = -( rxt(k,149) + het_rates(k,174) ) + mat(k,38) = -( rxt(k,150) + het_rates(k,175) ) + end do + end subroutine linmat02 + subroutine linmat03( 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,39) = -( rxt(k,151) + het_rates(k,176) ) + mat(k,40) = -( rxt(k,152) + het_rates(k,177) ) + mat(k,41) = -( rxt(k,153) + het_rates(k,178) ) + mat(k,42) = -( rxt(k,154) + het_rates(k,179) ) + mat(k,43) = -( rxt(k,155) + het_rates(k,180) ) + mat(k,44) = -( rxt(k,156) + het_rates(k,181) ) + mat(k,45) = -( rxt(k,157) + het_rates(k,182) ) + mat(k,46) = -( rxt(k,158) + het_rates(k,183) ) + mat(k,47) = -( rxt(k,159) + het_rates(k,184) ) + mat(k,48) = -( rxt(k,160) + het_rates(k,185) ) + mat(k,49) = -( rxt(k,161) + het_rates(k,186) ) + mat(k,50) = -( rxt(k,162) + het_rates(k,187) ) + mat(k,51) = -( rxt(k,163) + het_rates(k,188) ) + mat(k,52) = -( rxt(k,164) + het_rates(k,189) ) + mat(k,53) = -( rxt(k,165) + het_rates(k,190) ) + mat(k,54) = -( rxt(k,166) + het_rates(k,191) ) + mat(k,55) = -( rxt(k,167) + het_rates(k,192) ) + mat(k,56) = -( rxt(k,168) + het_rates(k,193) ) + mat(k,57) = -( rxt(k,169) + het_rates(k,194) ) + mat(k,58) = -( rxt(k,170) + het_rates(k,195) ) + mat(k,59) = -( het_rates(k,196) ) + mat(k,60) = -( het_rates(k,197) ) + mat(k,61) = -( het_rates(k,198) ) + mat(k,62) = -( het_rates(k,199) ) + mat(k,63) = -( het_rates(k,200) ) + mat(k,72) = -( het_rates(k,201) ) + mat(k,1083) = rxt(k,582) + mat(k,73) = -( het_rates(k,202) ) + mat(k,74) = -( het_rates(k,203) ) + mat(k,75) = -( het_rates(k,204) ) + mat(k,76) = -( het_rates(k,205) ) + mat(k,95) = -( het_rates(k,206) ) + mat(k,96) = -( het_rates(k,207) ) + mat(k,97) = -( het_rates(k,208) ) + mat(k,98) = -( het_rates(k,209) ) + mat(k,99) = -( het_rates(k,210) ) + mat(k,114) = -( rxt(k,621) + het_rates(k,211) ) + mat(k,120) = -( het_rates(k,212) ) + mat(k,126) = -( het_rates(k,213) ) + mat(k,243) = -( rxt(k,65) + het_rates(k,214) ) + mat(k,726) = -( rxt(k,66) + het_rates(k,215) ) + mat(k,682) = -( rxt(k,67) + rxt(k,552) + het_rates(k,216) ) + mat(k,530) = -( rxt(k,68) + het_rates(k,217) ) + mat(k,1102) = -( rxt(k,69) + het_rates(k,218) ) + mat(k,454) = rxt(k,59) + mat(k,683) = rxt(k,67) + mat(k,532) = rxt(k,68) + mat(k,1145) = -( rxt(k,70) + het_rates(k,219) ) + mat(k,728) = rxt(k,66) + mat(k,1104) = rxt(k,69) + mat(k,653) = -( rxt(k,71) + het_rates(k,220) ) + mat(k,231) = -( het_rates(k,221) ) + mat(k,132) = -( het_rates(k,222) ) + mat(k,247) = -( rxt(k,72) + het_rates(k,223) ) + mat(k,252) = -( het_rates(k,224) ) + mat(k,764) = -( rxt(k,73) + het_rates(k,225) ) + mat(k,138) = -( het_rates(k,226) ) + mat(k,260) = -( het_rates(k,227) ) + mat(k,477) = -( rxt(k,74) + het_rates(k,228) ) + mat(k,567) = -( het_rates(k,231) ) + mat(k,175) = rxt(k,490) + mat(k,1072) = -( het_rates(k,232) ) + mat(k,539) = -( het_rates(k,233) ) + mat(k,485) = -( het_rates(k,234) ) + mat(k,953) = -( het_rates(k,235) ) + mat(k,563) = rxt(k,53) + mat(k,977) = -( het_rates(k,236) ) + mat(k,690) = -( het_rates(k,237) ) + mat(k,1470) = -( het_rates(k,238) ) + mat(k,427) = .130_r8*rxt(k,24) + mat(k,392) = rxt(k,28) + mat(k,1112) = rxt(k,36) + mat(k,1324) = rxt(k,37) + mat(k,1240) = .330_r8*rxt(k,46) + mat(k,1252) = rxt(k,48) + mat(k,1315) = 1.340_r8*rxt(k,51) + mat(k,564) = rxt(k,53) + mat(k,397) = rxt(k,54) + mat(k,1420) = .300_r8*rxt(k,56) + mat(k,917) = rxt(k,58) + mat(k,603) = .600_r8*rxt(k,61) + rxt(k,365) + mat(k,431) = rxt(k,64) + mat(k,245) = .500_r8*rxt(k,65) + mat(k,1148) = .650_r8*rxt(k,70) + mat(k,1684) = -( het_rates(k,239) ) + mat(k,1196) = rxt(k,35) + mat(k,1113) = rxt(k,36) + mat(k,638) = rxt(k,38) + mat(k,1632) = rxt(k,41) + mat(k,1424) = .300_r8*rxt(k,56) + mat(k,605) = .400_r8*rxt(k,61) + mat(k,629) = rxt(k,88) + mat(k,402) = rxt(k,90) + mat(k,820) = -( het_rates(k,240) ) + mat(k,336) = .600_r8*rxt(k,26) + mat(k,907) = -( het_rates(k,241) ) + mat(k,2193) = rxt(k,16) + mat(k,1000) = rxt(k,111) + mat(k,1931) = rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + + rxt(k,125) + mat(k,1576) = rxt(k,126) + rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,130) & + + rxt(k,131) + rxt(k,132) + rxt(k,133) + mat(k,618) = -( het_rates(k,242) ) + mat(k,507) = -( rxt(k,358) + het_rates(k,243) ) + mat(k,198) = rxt(k,43) + mat(k,839) = -( het_rates(k,244) ) + mat(k,2421) = -( rxt(k,540) + het_rates(k,245) ) + mat(k,516) = rxt(k,11) + rxt(k,232) + mat(k,715) = rxt(k,20) + mat(k,705) = .900_r8*rxt(k,21) + mat(k,470) = rxt(k,22) + mat(k,213) = 1.500_r8*rxt(k,23) + mat(k,428) = .560_r8*rxt(k,24) + mat(k,506) = rxt(k,25) + mat(k,337) = .600_r8*rxt(k,26) + mat(k,681) = .600_r8*rxt(k,27) + mat(k,393) = rxt(k,28) + mat(k,375) = rxt(k,29) + mat(k,380) = rxt(k,30) + mat(k,439) = rxt(k,31) + mat(k,1200) = rxt(k,35) + mat(k,1329) = rxt(k,37) + mat(k,1211) = 2.000_r8*rxt(k,44) + mat(k,1088) = 2.000_r8*rxt(k,45) + mat(k,1246) = .670_r8*rxt(k,46) + mat(k,281) = rxt(k,47) + mat(k,1254) = rxt(k,48) + mat(k,475) = rxt(k,49) + mat(k,758) = rxt(k,50) + mat(k,1319) = 1.340_r8*rxt(k,51) + .660_r8*rxt(k,52) + mat(k,1168) = rxt(k,57) + mat(k,369) = rxt(k,62) + mat(k,599) = rxt(k,63) + mat(k,246) = rxt(k,65) + mat(k,734) = rxt(k,66) + mat(k,686) = rxt(k,67) + mat(k,535) = rxt(k,68) + mat(k,1109) = rxt(k,69) + mat(k,1152) = 1.200_r8*rxt(k,70) + mat(k,661) = rxt(k,71) + mat(k,774) = rxt(k,73) + mat(k,482) = rxt(k,74) + mat(k,494) = rxt(k,328) + mat(k,510) = rxt(k,358) + mat(k,1386) = rxt(k,433) + mat(k,491) = -( rxt(k,328) + het_rates(k,246) ) + mat(k,1341) = -( het_rates(k,247) ) + mat(k,1374) = -( rxt(k,433) + het_rates(k,248) ) + mat(k,1398) = -( het_rates(k,249) ) + mat(k,782) = -( het_rates(k,250) ) + mat(k,505) = .600_r8*rxt(k,25) + mat(k,1439) = -( het_rates(k,251) ) + mat(k,1314) = .660_r8*rxt(k,51) + mat(k,664) = rxt(k,55) + rxt(k,415) + mat(k,967) = -( het_rates(k,252) ) + mat(k,679) = .600_r8*rxt(k,27) + mat(k,719) = -( het_rates(k,253) ) + mat(k,573) = -( het_rates(k,254) ) + mat(k,737) = -( het_rates(k,255) ) + mat(k,887) = -( het_rates(k,256) ) + mat(k,2191) = rxt(k,16) + mat(k,894) = rxt(k,613) + mat(k,848) = rxt(k,616) + mat(k,546) = -( het_rates(k,257) ) + mat(k,996) = rxt(k,111) + mat(k,1132) = -( het_rates(k,258) ) + mat(k,2039) = -( rxt(k,175) + het_rates(k,259) ) + mat(k,2514) = rxt(k,1) + mat(k,1590) = rxt(k,6) + mat(k,2103) = rxt(k,7) + mat(k,302) = rxt(k,12) + mat(k,221) = -( rxt(k,171) + rxt(k,179) + het_rates(k,260) ) + mat(k,2053) = rxt(k,7) + mat(k,223) = rxt(k,183) + mat(k,224) = -( rxt(k,172) + rxt(k,183) + het_rates(k,261) ) + mat(k,895) = -( rxt(k,613) + het_rates(k,262) ) + mat(k,1575) = rxt(k,126) + rxt(k,130) + mat(k,1904) = -( het_rates(k,263) ) + mat(k,2511) = rxt(k,3) + mat(k,673) = 2.000_r8*rxt(k,4) + mat(k,1710) = rxt(k,9) + mat(k,514) = rxt(k,10) + mat(k,704) = rxt(k,21) + mat(k,469) = rxt(k,22) + mat(k,374) = rxt(k,29) + mat(k,379) = rxt(k,30) + mat(k,438) = rxt(k,31) + mat(k,316) = rxt(k,32) + mat(k,639) = rxt(k,38) + mat(k,444) = rxt(k,39) + mat(k,1635) = .330_r8*rxt(k,40) + mat(k,199) = rxt(k,43) + mat(k,280) = rxt(k,47) + mat(k,757) = rxt(k,50) + mat(k,398) = rxt(k,54) + mat(k,457) = rxt(k,59) + mat(k,368) = rxt(k,62) + mat(k,598) = rxt(k,63) + mat(k,432) = rxt(k,64) + mat(k,733) = rxt(k,66) + mat(k,534) = rxt(k,68) + mat(k,660) = rxt(k,71) + mat(k,249) = rxt(k,72) + mat(k,773) = rxt(k,73) + mat(k,481) = rxt(k,74) + mat(k,833) = rxt(k,106) + mat(k,881) = rxt(k,107) + mat(k,2484) = .500_r8*rxt(k,548) + end do + end subroutine linmat03 + subroutine linmat04( 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,847) = -( rxt(k,616) + het_rates(k,264) ) + mat(k,1926) = rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + + rxt(k,125) + mat(k,1573) = rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,131) + rxt(k,132) & + + rxt(k,133) + mat(k,498) = -( het_rates(k,265) ) + mat(k,860) = -( het_rates(k,266) ) + mat(k,1259) = -( het_rates(k,267) ) + mat(k,1147) = .150_r8*rxt(k,70) + mat(k,1220) = -( het_rates(k,268) ) + mat(k,1092) = -( het_rates(k,269) ) + mat(k,793) = -( het_rates(k,270) ) + mat(k,1275) = -( het_rates(k,271) ) + mat(k,809) = -( het_rates(k,272) ) + mat(k,554) = -( het_rates(k,273) ) + mat(k,2522) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,274) ) + mat(k,1646) = .050_r8*rxt(k,40) + mat(k,202) = rxt(k,136) + mat(k,2424) = rxt(k,540) + end do + end subroutine linmat04 + 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 ) + call linmat03( avec_len, mat, y, rxt, het_rates ) + call linmat04( avec_len, mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_lu_factor.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_lu_factor.F90 new file mode 100644 index 0000000000..496b4d1d46 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_lu_factor.F90 @@ -0,0 +1,8954 @@ + 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) = 1._r8 / lu(k,10) + 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) = 1._r8 / lu(k,33) + 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) = 1._r8 / lu(k,37) + lu(k,38) = 1._r8 / lu(k,38) + lu(k,39) = 1._r8 / lu(k,39) + lu(k,40) = 1._r8 / lu(k,40) + lu(k,41) = 1._r8 / lu(k,41) + lu(k,42) = 1._r8 / lu(k,42) + lu(k,43) = 1._r8 / lu(k,43) + lu(k,44) = 1._r8 / lu(k,44) + lu(k,45) = 1._r8 / lu(k,45) + lu(k,46) = 1._r8 / lu(k,46) + lu(k,47) = 1._r8 / lu(k,47) + lu(k,48) = 1._r8 / lu(k,48) + lu(k,49) = 1._r8 / lu(k,49) + lu(k,50) = 1._r8 / lu(k,50) + lu(k,51) = 1._r8 / lu(k,51) + 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,52) = 1._r8 / lu(k,52) + lu(k,53) = 1._r8 / lu(k,53) + lu(k,54) = 1._r8 / lu(k,54) + lu(k,55) = 1._r8 / lu(k,55) + lu(k,56) = 1._r8 / lu(k,56) + lu(k,57) = 1._r8 / lu(k,57) + lu(k,58) = 1._r8 / lu(k,58) + lu(k,59) = 1._r8 / lu(k,59) + lu(k,60) = 1._r8 / lu(k,60) + lu(k,61) = 1._r8 / lu(k,61) + lu(k,62) = 1._r8 / lu(k,62) + lu(k,63) = 1._r8 / lu(k,63) + lu(k,69) = 1._r8 / lu(k,69) + lu(k,71) = 1._r8 / lu(k,71) + lu(k,72) = 1._r8 / lu(k,72) + lu(k,73) = 1._r8 / lu(k,73) + lu(k,74) = 1._r8 / lu(k,74) + lu(k,75) = 1._r8 / lu(k,75) + lu(k,76) = 1._r8 / lu(k,76) + lu(k,82) = 1._r8 / lu(k,82) + lu(k,88) = 1._r8 / lu(k,88) + lu(k,94) = 1._r8 / lu(k,94) + lu(k,95) = 1._r8 / lu(k,95) + lu(k,96) = 1._r8 / lu(k,96) + lu(k,97) = 1._r8 / lu(k,97) + lu(k,98) = 1._r8 / lu(k,98) + lu(k,99) = 1._r8 / lu(k,99) + lu(k,105) = 1._r8 / lu(k,105) + lu(k,107) = 1._r8 / lu(k,107) + lu(k,113) = 1._r8 / lu(k,113) + lu(k,114) = 1._r8 / lu(k,114) + lu(k,120) = 1._r8 / lu(k,120) + lu(k,126) = 1._r8 / lu(k,126) + lu(k,132) = 1._r8 / lu(k,132) + lu(k,138) = 1._r8 / lu(k,138) + lu(k,139) = 1._r8 / lu(k,139) + lu(k,140) = lu(k,140) * lu(k,139) + lu(k,141) = lu(k,141) * lu(k,139) + lu(k,1904) = lu(k,1904) - lu(k,140) * lu(k,1765) + lu(k,1915) = lu(k,1915) - lu(k,141) * lu(k,1765) + 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,2038) = lu(k,2038) - lu(k,143) * lu(k,2005) + lu(k,2039) = lu(k,2039) - lu(k,144) * lu(k,2005) + lu(k,145) = 1._r8 / lu(k,145) + lu(k,146) = lu(k,146) * lu(k,145) + lu(k,147) = lu(k,147) * lu(k,145) + lu(k,1904) = lu(k,1904) - lu(k,146) * lu(k,1766) + lu(k,1912) = lu(k,1912) - lu(k,147) * lu(k,1766) + lu(k,148) = 1._r8 / lu(k,148) + lu(k,149) = lu(k,149) * lu(k,148) + lu(k,150) = lu(k,150) * lu(k,148) + lu(k,2129) = lu(k,2129) - lu(k,149) * lu(k,2112) + lu(k,2132) = lu(k,2132) - lu(k,150) * lu(k,2112) + lu(k,151) = 1._r8 / lu(k,151) + lu(k,152) = lu(k,152) * lu(k,151) + lu(k,153) = lu(k,153) * lu(k,151) + lu(k,154) = lu(k,154) * lu(k,151) + lu(k,2016) = lu(k,2016) - lu(k,152) * lu(k,2006) + lu(k,2029) = lu(k,2029) - lu(k,153) * lu(k,2006) + lu(k,2039) = lu(k,2039) - lu(k,154) * lu(k,2006) + 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,155) = 1._r8 / lu(k,155) + lu(k,156) = lu(k,156) * lu(k,155) + lu(k,157) = lu(k,157) * lu(k,155) + lu(k,158) = lu(k,158) * lu(k,155) + lu(k,2018) = lu(k,2018) - lu(k,156) * lu(k,2007) + lu(k,2038) = lu(k,2038) - lu(k,157) * lu(k,2007) + lu(k,2039) = lu(k,2039) - lu(k,158) * lu(k,2007) + lu(k,159) = 1._r8 / lu(k,159) + lu(k,160) = lu(k,160) * lu(k,159) + lu(k,161) = lu(k,161) * lu(k,159) + lu(k,162) = lu(k,162) * lu(k,159) + lu(k,2016) = lu(k,2016) - lu(k,160) * lu(k,2008) + lu(k,2038) = lu(k,2038) - lu(k,161) * lu(k,2008) + lu(k,2039) = lu(k,2039) - lu(k,162) * lu(k,2008) + lu(k,163) = 1._r8 / lu(k,163) + lu(k,164) = lu(k,164) * lu(k,163) + lu(k,165) = lu(k,165) * lu(k,163) + lu(k,166) = lu(k,166) * lu(k,163) + lu(k,2016) = lu(k,2016) - lu(k,164) * lu(k,2009) + lu(k,2038) = lu(k,2038) - lu(k,165) * lu(k,2009) + lu(k,2039) = lu(k,2039) - lu(k,166) * lu(k,2009) + lu(k,167) = 1._r8 / lu(k,167) + lu(k,168) = lu(k,168) * lu(k,167) + lu(k,169) = lu(k,169) * lu(k,167) + lu(k,170) = lu(k,170) * lu(k,167) + lu(k,1904) = lu(k,1904) - lu(k,168) * lu(k,1767) + lu(k,1906) = lu(k,1906) - lu(k,169) * lu(k,1767) + lu(k,1915) = lu(k,1915) - lu(k,170) * lu(k,1767) + lu(k,171) = 1._r8 / lu(k,171) + lu(k,172) = lu(k,172) * lu(k,171) + lu(k,173) = lu(k,173) * lu(k,171) + lu(k,754) = lu(k,754) - lu(k,172) * lu(k,752) + lu(k,757) = lu(k,757) - lu(k,173) * lu(k,752) + lu(k,1883) = lu(k,1883) - lu(k,172) * lu(k,1768) + lu(k,1904) = lu(k,1904) - lu(k,173) * lu(k,1768) + lu(k,174) = 1._r8 / lu(k,174) + lu(k,175) = lu(k,175) * lu(k,174) + lu(k,176) = lu(k,176) * lu(k,174) + lu(k,567) = lu(k,567) - lu(k,175) * lu(k,566) + lu(k,572) = lu(k,572) - lu(k,176) * lu(k,566) + lu(k,2456) = lu(k,2456) - lu(k,175) * lu(k,2451) + lu(k,2494) = lu(k,2494) - lu(k,176) * lu(k,2451) + lu(k,177) = 1._r8 / lu(k,177) + lu(k,178) = lu(k,178) * lu(k,177) + lu(k,179) = lu(k,179) * lu(k,177) + lu(k,180) = lu(k,180) * lu(k,177) + lu(k,181) = lu(k,181) * lu(k,177) + lu(k,2016) = lu(k,2016) - lu(k,178) * lu(k,2010) + lu(k,2029) = lu(k,2029) - lu(k,179) * lu(k,2010) + lu(k,2038) = lu(k,2038) - lu(k,180) * lu(k,2010) + lu(k,2039) = lu(k,2039) - lu(k,181) * lu(k,2010) + 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,2016) = lu(k,2016) - lu(k,183) * lu(k,2011) + lu(k,2026) = lu(k,2026) - lu(k,184) * lu(k,2011) + lu(k,2029) = lu(k,2029) - lu(k,185) * lu(k,2011) + lu(k,2039) = lu(k,2039) - lu(k,186) * lu(k,2011) + lu(k,187) = 1._r8 / lu(k,187) + lu(k,188) = lu(k,188) * lu(k,187) + lu(k,189) = lu(k,189) * lu(k,187) + lu(k,190) = lu(k,190) * lu(k,187) + lu(k,191) = lu(k,191) * lu(k,187) + lu(k,2016) = lu(k,2016) - lu(k,188) * lu(k,2012) + lu(k,2018) = lu(k,2018) - lu(k,189) * lu(k,2012) + lu(k,2038) = lu(k,2038) - lu(k,190) * lu(k,2012) + lu(k,2039) = lu(k,2039) - lu(k,191) * lu(k,2012) + lu(k,192) = 1._r8 / lu(k,192) + lu(k,193) = lu(k,193) * lu(k,192) + lu(k,194) = lu(k,194) * lu(k,192) + lu(k,195) = lu(k,195) * lu(k,192) + lu(k,196) = lu(k,196) * lu(k,192) + lu(k,2016) = lu(k,2016) - lu(k,193) * lu(k,2013) + lu(k,2026) = lu(k,2026) - lu(k,194) * lu(k,2013) + lu(k,2038) = lu(k,2038) - lu(k,195) * lu(k,2013) + lu(k,2039) = lu(k,2039) - lu(k,196) * lu(k,2013) + lu(k,197) = 1._r8 / lu(k,197) + lu(k,198) = lu(k,198) * lu(k,197) + lu(k,199) = lu(k,199) * lu(k,197) + lu(k,838) = lu(k,838) - lu(k,198) * lu(k,837) + lu(k,842) = - lu(k,199) * lu(k,837) + lu(k,2347) = - lu(k,198) * lu(k,2328) + lu(k,2413) = lu(k,2413) - lu(k,199) * lu(k,2328) + 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,305) = lu(k,305) - lu(k,201) * lu(k,304) + lu(k,308) = lu(k,308) - lu(k,202) * lu(k,304) + lu(k,2497) = lu(k,2497) - lu(k,201) * lu(k,2496) + lu(k,2522) = lu(k,2522) - lu(k,202) * lu(k,2496) + lu(k,204) = 1._r8 / lu(k,204) + lu(k,205) = lu(k,205) * lu(k,204) + lu(k,206) = lu(k,206) * lu(k,204) + lu(k,207) = lu(k,207) * lu(k,204) + lu(k,208) = lu(k,208) * lu(k,204) + lu(k,209) = lu(k,209) * lu(k,204) + lu(k,1770) = lu(k,1770) - lu(k,205) * lu(k,1769) + lu(k,1771) = lu(k,1771) - lu(k,206) * lu(k,1769) + lu(k,1820) = lu(k,1820) - lu(k,207) * lu(k,1769) + lu(k,1904) = lu(k,1904) - lu(k,208) * lu(k,1769) + lu(k,1912) = lu(k,1912) - lu(k,209) * lu(k,1769) + 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,210) = 1._r8 / lu(k,210) + lu(k,211) = lu(k,211) * lu(k,210) + lu(k,212) = lu(k,212) * lu(k,210) + lu(k,213) = lu(k,213) * lu(k,210) + lu(k,1815) = - lu(k,211) * lu(k,1770) + lu(k,1877) = lu(k,1877) - lu(k,212) * lu(k,1770) + lu(k,1912) = lu(k,1912) - lu(k,213) * lu(k,1770) + lu(k,214) = 1._r8 / lu(k,214) + lu(k,215) = lu(k,215) * lu(k,214) + lu(k,216) = lu(k,216) * lu(k,214) + lu(k,217) = lu(k,217) * lu(k,214) + lu(k,218) = lu(k,218) * lu(k,214) + lu(k,1814) = lu(k,1814) - lu(k,215) * lu(k,1771) + lu(k,1818) = lu(k,1818) - lu(k,216) * lu(k,1771) + lu(k,1904) = lu(k,1904) - lu(k,217) * lu(k,1771) + lu(k,1912) = lu(k,1912) - lu(k,218) * lu(k,1771) + lu(k,219) = 1._r8 / lu(k,219) + lu(k,220) = lu(k,220) * lu(k,219) + lu(k,883) = lu(k,883) - lu(k,220) * lu(k,878) + lu(k,1123) = lu(k,1123) - lu(k,220) * lu(k,1116) + lu(k,1544) = lu(k,1544) - lu(k,220) * lu(k,1532) + lu(k,1995) = lu(k,1995) - lu(k,220) * lu(k,1959) + lu(k,2129) = lu(k,2129) - lu(k,220) * lu(k,2113) + lu(k,221) = 1._r8 / lu(k,221) + lu(k,222) = lu(k,222) * lu(k,221) + lu(k,225) = lu(k,225) - lu(k,222) * lu(k,223) + lu(k,1493) = - lu(k,222) * lu(k,1484) + lu(k,1584) = lu(k,1584) - lu(k,222) * lu(k,1566) + lu(k,1941) = lu(k,1941) - lu(k,222) * lu(k,1916) + lu(k,2094) = lu(k,2094) - lu(k,222) * lu(k,2053) + lu(k,224) = 1._r8 / lu(k,224) + lu(k,225) = lu(k,225) * lu(k,224) + lu(k,1493) = lu(k,1493) - lu(k,225) * lu(k,1485) + lu(k,1584) = lu(k,1584) - lu(k,225) * lu(k,1567) + lu(k,1941) = lu(k,1941) - lu(k,225) * lu(k,1917) + lu(k,2030) = lu(k,2030) - lu(k,225) * lu(k,2014) + lu(k,2094) = lu(k,2094) - lu(k,225) * lu(k,2054) + lu(k,226) = 1._r8 / lu(k,226) + lu(k,227) = lu(k,227) * lu(k,226) + lu(k,228) = lu(k,228) * lu(k,226) + lu(k,229) = lu(k,229) * lu(k,226) + lu(k,1904) = lu(k,1904) - lu(k,227) * lu(k,1772) + lu(k,1907) = - lu(k,228) * lu(k,1772) + lu(k,1912) = lu(k,1912) - lu(k,229) * lu(k,1772) + lu(k,2036) = lu(k,2036) - lu(k,227) * lu(k,2015) + lu(k,2039) = lu(k,2039) - lu(k,228) * lu(k,2015) + lu(k,2044) = lu(k,2044) - lu(k,229) * lu(k,2015) + lu(k,231) = 1._r8 / lu(k,231) + lu(k,232) = lu(k,232) * lu(k,231) + lu(k,233) = lu(k,233) * lu(k,231) + lu(k,234) = lu(k,234) * lu(k,231) + lu(k,235) = lu(k,235) * lu(k,231) + lu(k,236) = lu(k,236) * lu(k,231) + lu(k,237) = lu(k,237) * lu(k,231) + lu(k,1774) = lu(k,1774) - lu(k,232) * lu(k,1773) + lu(k,1775) = lu(k,1775) - lu(k,233) * lu(k,1773) + lu(k,1813) = lu(k,1813) - lu(k,234) * lu(k,1773) + lu(k,1847) = lu(k,1847) - lu(k,235) * lu(k,1773) + lu(k,1904) = lu(k,1904) - lu(k,236) * lu(k,1773) + lu(k,1912) = lu(k,1912) - lu(k,237) * lu(k,1773) + lu(k,238) = 1._r8 / lu(k,238) + lu(k,239) = lu(k,239) * lu(k,238) + lu(k,240) = lu(k,240) * lu(k,238) + lu(k,241) = lu(k,241) * lu(k,238) + lu(k,242) = lu(k,242) * lu(k,238) + lu(k,1814) = lu(k,1814) - lu(k,239) * lu(k,1774) + lu(k,1818) = lu(k,1818) - lu(k,240) * lu(k,1774) + lu(k,1904) = lu(k,1904) - lu(k,241) * lu(k,1774) + lu(k,1912) = lu(k,1912) - lu(k,242) * lu(k,1774) + lu(k,243) = 1._r8 / lu(k,243) + lu(k,244) = lu(k,244) * lu(k,243) + lu(k,245) = lu(k,245) * lu(k,243) + lu(k,246) = lu(k,246) * lu(k,243) + lu(k,256) = - lu(k,244) * lu(k,251) + lu(k,257) = - lu(k,245) * lu(k,251) + lu(k,259) = lu(k,259) - lu(k,246) * lu(k,251) + lu(k,1877) = lu(k,1877) - lu(k,244) * lu(k,1775) + lu(k,1892) = lu(k,1892) - lu(k,245) * lu(k,1775) + lu(k,1912) = lu(k,1912) - lu(k,246) * lu(k,1775) + lu(k,247) = 1._r8 / lu(k,247) + lu(k,248) = lu(k,248) * lu(k,247) + lu(k,249) = lu(k,249) * lu(k,247) + lu(k,1275) = lu(k,1275) - lu(k,248) * lu(k,1269) + lu(k,1280) = - lu(k,249) * lu(k,1269) + lu(k,1883) = lu(k,1883) - lu(k,248) * lu(k,1776) + lu(k,1904) = lu(k,1904) - lu(k,249) * lu(k,1776) + lu(k,2393) = lu(k,2393) - lu(k,248) * lu(k,2329) + lu(k,2413) = lu(k,2413) - lu(k,249) * lu(k,2329) + 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,1778) = lu(k,1778) - lu(k,253) * lu(k,1777) + lu(k,1813) = lu(k,1813) - lu(k,254) * lu(k,1777) + lu(k,1848) = lu(k,1848) - lu(k,255) * lu(k,1777) + lu(k,1877) = lu(k,1877) - lu(k,256) * lu(k,1777) + lu(k,1892) = lu(k,1892) - lu(k,257) * lu(k,1777) + lu(k,1904) = lu(k,1904) - lu(k,258) * lu(k,1777) + lu(k,1912) = lu(k,1912) - lu(k,259) * lu(k,1777) + 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,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,1818) = lu(k,1818) - lu(k,261) * lu(k,1778) + lu(k,1821) = lu(k,1821) - lu(k,262) * lu(k,1778) + lu(k,1904) = lu(k,1904) - lu(k,263) * lu(k,1778) + lu(k,1912) = lu(k,1912) - lu(k,264) * lu(k,1778) + lu(k,265) = 1._r8 / lu(k,265) + lu(k,266) = lu(k,266) * lu(k,265) + lu(k,267) = lu(k,267) * lu(k,265) + lu(k,1021) = - lu(k,266) * lu(k,1017) + lu(k,1033) = lu(k,1033) - lu(k,267) * lu(k,1017) + lu(k,1049) = - lu(k,266) * lu(k,1045) + lu(k,1061) = lu(k,1061) - lu(k,267) * lu(k,1045) + lu(k,1866) = lu(k,1866) - lu(k,266) * lu(k,1779) + lu(k,1904) = lu(k,1904) - lu(k,267) * lu(k,1779) + lu(k,2068) = - lu(k,266) * lu(k,2055) + lu(k,2100) = lu(k,2100) - lu(k,267) * lu(k,2055) + 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,831) = lu(k,831) - lu(k,269) * lu(k,828) + lu(k,835) = - lu(k,270) * lu(k,828) + lu(k,1538) = - lu(k,269) * lu(k,1533) + lu(k,1544) = lu(k,1544) - lu(k,270) * lu(k,1533) + lu(k,1605) = lu(k,1605) - lu(k,269) * lu(k,1598) + lu(k,1612) = lu(k,1612) - lu(k,270) * lu(k,1598) + lu(k,2121) = lu(k,2121) - lu(k,269) * lu(k,2114) + lu(k,2129) = lu(k,2129) - lu(k,270) * lu(k,2114) + lu(k,271) = 1._r8 / lu(k,271) + lu(k,272) = lu(k,272) * lu(k,271) + lu(k,273) = lu(k,273) * lu(k,271) + lu(k,1225) = - lu(k,272) * lu(k,1213) + lu(k,1230) = lu(k,1230) - lu(k,273) * lu(k,1213) + lu(k,1243) = lu(k,1243) - lu(k,272) * lu(k,1232) + lu(k,1248) = lu(k,1248) - lu(k,273) * lu(k,1232) + lu(k,1902) = lu(k,1902) - lu(k,272) * lu(k,1780) + lu(k,1914) = lu(k,1914) - lu(k,273) * lu(k,1780) + lu(k,2231) = - lu(k,272) * lu(k,2162) + lu(k,2243) = lu(k,2243) - lu(k,273) * lu(k,2162) + lu(k,274) = 1._r8 / lu(k,274) + lu(k,275) = lu(k,275) * lu(k,274) + lu(k,276) = lu(k,276) * lu(k,274) + lu(k,373) = - lu(k,275) * lu(k,370) + lu(k,374) = lu(k,374) - lu(k,276) * lu(k,370) + lu(k,486) = - lu(k,275) * lu(k,483) + lu(k,487) = - lu(k,276) * lu(k,483) + lu(k,1823) = lu(k,1823) - lu(k,275) * lu(k,1781) + lu(k,1904) = lu(k,1904) - lu(k,276) * lu(k,1781) + lu(k,2176) = lu(k,2176) - lu(k,275) * lu(k,2163) + lu(k,2233) = lu(k,2233) - lu(k,276) * lu(k,2163) + lu(k,277) = 1._r8 / lu(k,277) + lu(k,278) = lu(k,278) * lu(k,277) + lu(k,279) = lu(k,279) * lu(k,277) + lu(k,280) = lu(k,280) * lu(k,277) + lu(k,281) = lu(k,281) * lu(k,277) + lu(k,1360) = - lu(k,278) * lu(k,1357) + lu(k,1371) = - lu(k,279) * lu(k,1357) + lu(k,1382) = - lu(k,280) * lu(k,1357) + lu(k,1386) = lu(k,1386) - lu(k,281) * lu(k,1357) + lu(k,1835) = - lu(k,278) * lu(k,1782) + lu(k,1883) = lu(k,1883) - lu(k,279) * lu(k,1782) + lu(k,1904) = lu(k,1904) - lu(k,280) * lu(k,1782) + lu(k,1912) = lu(k,1912) - lu(k,281) * lu(k,1782) + lu(k,282) = 1._r8 / lu(k,282) + lu(k,283) = lu(k,283) * lu(k,282) + lu(k,284) = lu(k,284) * lu(k,282) + lu(k,296) = - lu(k,283) * lu(k,294) + lu(k,299) = lu(k,299) - lu(k,284) * lu(k,294) + lu(k,355) = - lu(k,283) * lu(k,353) + lu(k,358) = lu(k,358) - lu(k,284) * lu(k,353) + lu(k,1857) = - lu(k,283) * lu(k,1783) + lu(k,1907) = lu(k,1907) - lu(k,284) * lu(k,1783) + lu(k,2026) = lu(k,2026) - lu(k,283) * lu(k,2016) + lu(k,2039) = lu(k,2039) - lu(k,284) * lu(k,2016) + lu(k,285) = 1._r8 / lu(k,285) + lu(k,286) = lu(k,286) * lu(k,285) + lu(k,287) = lu(k,287) * lu(k,285) + lu(k,288) = lu(k,288) * lu(k,285) + lu(k,289) = lu(k,289) * lu(k,285) + lu(k,1785) = lu(k,1785) - lu(k,286) * lu(k,1784) + lu(k,1904) = lu(k,1904) - lu(k,287) * lu(k,1784) + lu(k,1906) = lu(k,1906) - lu(k,288) * lu(k,1784) + lu(k,1907) = lu(k,1907) - lu(k,289) * lu(k,1784) + lu(k,2018) = lu(k,2018) - lu(k,286) * lu(k,2017) + lu(k,2036) = lu(k,2036) - lu(k,287) * lu(k,2017) + lu(k,2038) = lu(k,2038) - lu(k,288) * lu(k,2017) + lu(k,2039) = lu(k,2039) - lu(k,289) * lu(k,2017) + lu(k,290) = 1._r8 / lu(k,290) + lu(k,291) = lu(k,291) * lu(k,290) + lu(k,292) = lu(k,292) * lu(k,290) + lu(k,293) = lu(k,293) * lu(k,290) + lu(k,1857) = lu(k,1857) - lu(k,291) * lu(k,1785) + lu(k,1906) = lu(k,1906) - lu(k,292) * lu(k,1785) + lu(k,1907) = lu(k,1907) - lu(k,293) * lu(k,1785) + lu(k,2026) = lu(k,2026) - lu(k,291) * lu(k,2018) + lu(k,2038) = lu(k,2038) - lu(k,292) * lu(k,2018) + lu(k,2039) = lu(k,2039) - lu(k,293) * lu(k,2018) + 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,295) = 1._r8 / lu(k,295) + lu(k,296) = lu(k,296) * lu(k,295) + lu(k,297) = lu(k,297) * lu(k,295) + lu(k,298) = lu(k,298) * lu(k,295) + lu(k,299) = lu(k,299) * lu(k,295) + lu(k,1857) = lu(k,1857) - lu(k,296) * lu(k,1786) + lu(k,1904) = lu(k,1904) - lu(k,297) * lu(k,1786) + lu(k,1906) = lu(k,1906) - lu(k,298) * lu(k,1786) + lu(k,1907) = lu(k,1907) - lu(k,299) * lu(k,1786) + lu(k,2026) = lu(k,2026) - lu(k,296) * lu(k,2019) + lu(k,2036) = lu(k,2036) - lu(k,297) * lu(k,2019) + lu(k,2038) = lu(k,2038) - lu(k,298) * lu(k,2019) + lu(k,2039) = lu(k,2039) - lu(k,299) * lu(k,2019) + lu(k,300) = 1._r8 / lu(k,300) + lu(k,301) = lu(k,301) * lu(k,300) + lu(k,302) = lu(k,302) * lu(k,300) + lu(k,303) = lu(k,303) * lu(k,300) + lu(k,1004) = lu(k,1004) - lu(k,301) * lu(k,995) + lu(k,1008) = - lu(k,302) * lu(k,995) + lu(k,1009) = lu(k,1009) - lu(k,303) * lu(k,995) + lu(k,2030) = lu(k,2030) - lu(k,301) * lu(k,2020) + lu(k,2039) = lu(k,2039) - lu(k,302) * lu(k,2020) + lu(k,2042) = lu(k,2042) - lu(k,303) * lu(k,2020) + lu(k,2478) = lu(k,2478) - lu(k,301) * lu(k,2452) + lu(k,2487) = - lu(k,302) * lu(k,2452) + lu(k,2490) = lu(k,2490) - lu(k,303) * lu(k,2452) + lu(k,305) = 1._r8 / lu(k,305) + lu(k,306) = lu(k,306) * lu(k,305) + lu(k,307) = lu(k,307) * lu(k,305) + lu(k,308) = lu(k,308) * lu(k,305) + lu(k,989) = lu(k,989) - lu(k,306) * lu(k,988) + lu(k,992) = lu(k,992) - lu(k,307) * lu(k,988) + lu(k,994) = - lu(k,308) * lu(k,988) + lu(k,1862) = lu(k,1862) - lu(k,306) * lu(k,1787) + lu(k,1905) = lu(k,1905) - lu(k,307) * lu(k,1787) + lu(k,1915) = lu(k,1915) - lu(k,308) * lu(k,1787) + lu(k,2500) = - lu(k,306) * lu(k,2497) + lu(k,2512) = lu(k,2512) - lu(k,307) * lu(k,2497) + lu(k,2522) = lu(k,2522) - lu(k,308) * lu(k,2497) + lu(k,309) = 1._r8 / lu(k,309) + lu(k,310) = lu(k,310) * lu(k,309) + lu(k,311) = lu(k,311) * lu(k,309) + lu(k,312) = lu(k,312) * lu(k,309) + lu(k,954) = lu(k,954) - lu(k,310) * lu(k,950) + lu(k,957) = - lu(k,311) * lu(k,950) + lu(k,959) = lu(k,959) - lu(k,312) * lu(k,950) + lu(k,1664) = lu(k,1664) - lu(k,310) * lu(k,1647) + lu(k,1687) = - lu(k,311) * lu(k,1647) + lu(k,1695) = lu(k,1695) - lu(k,312) * lu(k,1647) + lu(k,1876) = lu(k,1876) - lu(k,310) * lu(k,1788) + lu(k,1904) = lu(k,1904) - lu(k,311) * lu(k,1788) + lu(k,1912) = lu(k,1912) - lu(k,312) * lu(k,1788) + lu(k,313) = 1._r8 / lu(k,313) + lu(k,314) = lu(k,314) * lu(k,313) + lu(k,315) = lu(k,315) * lu(k,313) + lu(k,316) = lu(k,316) * lu(k,313) + lu(k,689) = lu(k,689) - lu(k,314) * lu(k,688) + lu(k,690) = lu(k,690) - lu(k,315) * lu(k,688) + lu(k,691) = - lu(k,316) * lu(k,688) + lu(k,1818) = lu(k,1818) - lu(k,314) * lu(k,1789) + lu(k,1837) = lu(k,1837) - lu(k,315) * lu(k,1789) + lu(k,1904) = lu(k,1904) - lu(k,316) * lu(k,1789) + lu(k,2349) = - lu(k,314) * lu(k,2330) + lu(k,2359) = lu(k,2359) - lu(k,315) * lu(k,2330) + lu(k,2413) = lu(k,2413) - lu(k,316) * lu(k,2330) + lu(k,317) = 1._r8 / lu(k,317) + lu(k,318) = lu(k,318) * lu(k,317) + lu(k,319) = lu(k,319) * lu(k,317) + lu(k,320) = lu(k,320) * lu(k,317) + lu(k,321) = lu(k,321) * lu(k,317) + lu(k,322) = lu(k,322) * lu(k,317) + lu(k,1859) = lu(k,1859) - lu(k,318) * lu(k,1790) + lu(k,1867) = lu(k,1867) - lu(k,319) * lu(k,1790) + lu(k,1877) = lu(k,1877) - lu(k,320) * lu(k,1790) + lu(k,1904) = lu(k,1904) - lu(k,321) * lu(k,1790) + lu(k,1912) = lu(k,1912) - lu(k,322) * lu(k,1790) + lu(k,1972) = - lu(k,318) * lu(k,1960) + lu(k,1974) = - lu(k,319) * lu(k,1960) + lu(k,1978) = lu(k,1978) - lu(k,320) * lu(k,1960) + lu(k,1993) = lu(k,1993) - lu(k,321) * lu(k,1960) + lu(k,2001) = lu(k,2001) - lu(k,322) * lu(k,1960) + 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,326) = lu(k,326) * lu(k,323) + lu(k,327) = lu(k,327) * lu(k,323) + lu(k,328) = lu(k,328) * lu(k,323) + lu(k,1858) = lu(k,1858) - lu(k,324) * lu(k,1791) + lu(k,1896) = lu(k,1896) - lu(k,325) * lu(k,1791) + lu(k,1904) = lu(k,1904) - lu(k,326) * lu(k,1791) + lu(k,1906) = lu(k,1906) - lu(k,327) * lu(k,1791) + lu(k,1915) = lu(k,1915) - lu(k,328) * lu(k,1791) + lu(k,1971) = lu(k,1971) - lu(k,324) * lu(k,1961) + lu(k,1985) = lu(k,1985) - lu(k,325) * lu(k,1961) + lu(k,1993) = lu(k,1993) - lu(k,326) * lu(k,1961) + lu(k,1995) = lu(k,1995) - lu(k,327) * lu(k,1961) + lu(k,2004) = - lu(k,328) * lu(k,1961) + lu(k,329) = 1._r8 / lu(k,329) + lu(k,330) = lu(k,330) * lu(k,329) + lu(k,331) = lu(k,331) * lu(k,329) + lu(k,332) = lu(k,332) * lu(k,329) + lu(k,333) = lu(k,333) * lu(k,329) + lu(k,334) = lu(k,334) * lu(k,329) + lu(k,1861) = lu(k,1861) - lu(k,330) * lu(k,1792) + lu(k,1896) = lu(k,1896) - lu(k,331) * lu(k,1792) + lu(k,1904) = lu(k,1904) - lu(k,332) * lu(k,1792) + lu(k,1906) = lu(k,1906) - lu(k,333) * lu(k,1792) + lu(k,1915) = lu(k,1915) - lu(k,334) * lu(k,1792) + lu(k,1973) = lu(k,1973) - lu(k,330) * lu(k,1962) + lu(k,1985) = lu(k,1985) - lu(k,331) * lu(k,1962) + lu(k,1993) = lu(k,1993) - lu(k,332) * lu(k,1962) + lu(k,1995) = lu(k,1995) - lu(k,333) * lu(k,1962) + lu(k,2004) = lu(k,2004) - lu(k,334) * lu(k,1962) + lu(k,335) = 1._r8 / lu(k,335) + lu(k,336) = lu(k,336) * lu(k,335) + lu(k,337) = lu(k,337) * lu(k,335) + lu(k,657) = - lu(k,336) * lu(k,651) + lu(k,661) = lu(k,661) - lu(k,337) * lu(k,651) + lu(k,767) = - lu(k,336) * lu(k,760) + lu(k,774) = lu(k,774) - lu(k,337) * lu(k,760) + lu(k,794) = - lu(k,336) * lu(k,788) + lu(k,801) = lu(k,801) - lu(k,337) * lu(k,788) + lu(k,810) = - lu(k,336) * lu(k,803) + lu(k,818) = lu(k,818) - lu(k,337) * lu(k,803) + lu(k,2188) = lu(k,2188) - lu(k,336) * lu(k,2164) + lu(k,2241) = lu(k,2241) - lu(k,337) * lu(k,2164) + 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,338) = 1._r8 / lu(k,338) + lu(k,339) = lu(k,339) * lu(k,338) + lu(k,340) = lu(k,340) * lu(k,338) + lu(k,341) = lu(k,341) * lu(k,338) + lu(k,342) = lu(k,342) * lu(k,338) + lu(k,343) = lu(k,343) * lu(k,338) + lu(k,2291) = lu(k,2291) - lu(k,339) * lu(k,2247) + lu(k,2294) = lu(k,2294) - lu(k,340) * lu(k,2247) + lu(k,2299) = lu(k,2299) - lu(k,341) * lu(k,2247) + lu(k,2300) = lu(k,2300) - lu(k,342) * lu(k,2247) + lu(k,2303) = lu(k,2303) - lu(k,343) * lu(k,2247) + lu(k,2482) = lu(k,2482) - lu(k,339) * lu(k,2453) + lu(k,2485) = lu(k,2485) - lu(k,340) * lu(k,2453) + lu(k,2490) = lu(k,2490) - lu(k,341) * lu(k,2453) + lu(k,2491) = lu(k,2491) - lu(k,342) * lu(k,2453) + lu(k,2494) = lu(k,2494) - lu(k,343) * lu(k,2453) + lu(k,344) = 1._r8 / lu(k,344) + lu(k,345) = lu(k,345) * lu(k,344) + lu(k,346) = lu(k,346) * lu(k,344) + lu(k,941) = lu(k,941) - lu(k,345) * lu(k,940) + lu(k,946) = lu(k,946) - lu(k,346) * lu(k,940) + lu(k,1502) = lu(k,1502) - lu(k,345) * lu(k,1501) + lu(k,1508) = lu(k,1508) - lu(k,346) * lu(k,1501) + lu(k,1623) = lu(k,1623) - lu(k,345) * lu(k,1622) + lu(k,1634) = lu(k,1634) - lu(k,346) * lu(k,1622) + lu(k,1700) = lu(k,1700) - lu(k,345) * lu(k,1699) + lu(k,1709) = - lu(k,346) * lu(k,1699) + lu(k,2499) = lu(k,2499) - lu(k,345) * lu(k,2498) + lu(k,2510) = lu(k,2510) - lu(k,346) * lu(k,2498) + lu(k,347) = 1._r8 / lu(k,347) + lu(k,348) = lu(k,348) * lu(k,347) + lu(k,349) = lu(k,349) * lu(k,347) + lu(k,350) = lu(k,350) * lu(k,347) + lu(k,351) = lu(k,351) * lu(k,347) + lu(k,352) = lu(k,352) * lu(k,347) + lu(k,1862) = lu(k,1862) - lu(k,348) * lu(k,1793) + lu(k,1902) = lu(k,1902) - lu(k,349) * lu(k,1793) + lu(k,1904) = lu(k,1904) - lu(k,350) * lu(k,1793) + lu(k,1911) = lu(k,1911) - lu(k,351) * lu(k,1793) + lu(k,1912) = lu(k,1912) - lu(k,352) * lu(k,1793) + lu(k,2255) = lu(k,2255) - lu(k,348) * lu(k,2248) + lu(k,2291) = lu(k,2291) - lu(k,349) * lu(k,2248) + lu(k,2293) = lu(k,2293) - lu(k,350) * lu(k,2248) + lu(k,2300) = lu(k,2300) - lu(k,351) * lu(k,2248) + lu(k,2301) = lu(k,2301) - lu(k,352) * lu(k,2248) + lu(k,354) = 1._r8 / lu(k,354) + lu(k,355) = lu(k,355) * lu(k,354) + lu(k,356) = lu(k,356) * lu(k,354) + lu(k,357) = lu(k,357) * lu(k,354) + lu(k,358) = lu(k,358) * lu(k,354) + lu(k,359) = lu(k,359) * lu(k,354) + lu(k,1857) = lu(k,1857) - lu(k,355) * lu(k,1794) + lu(k,1904) = lu(k,1904) - lu(k,356) * lu(k,1794) + lu(k,1906) = lu(k,1906) - lu(k,357) * lu(k,1794) + lu(k,1907) = lu(k,1907) - lu(k,358) * lu(k,1794) + lu(k,1915) = lu(k,1915) - lu(k,359) * lu(k,1794) + lu(k,2026) = lu(k,2026) - lu(k,355) * lu(k,2021) + lu(k,2036) = lu(k,2036) - lu(k,356) * lu(k,2021) + lu(k,2038) = lu(k,2038) - lu(k,357) * lu(k,2021) + lu(k,2039) = lu(k,2039) - lu(k,358) * lu(k,2021) + lu(k,2047) = lu(k,2047) - lu(k,359) * lu(k,2021) + 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,1517) = lu(k,1517) - lu(k,361) * lu(k,1515) + lu(k,1518) = lu(k,1518) - lu(k,362) * lu(k,1515) + lu(k,1524) = lu(k,1524) - lu(k,363) * lu(k,1515) + lu(k,1527) = lu(k,1527) - lu(k,364) * lu(k,1515) + lu(k,1602) = lu(k,1602) - lu(k,361) * lu(k,1599) + lu(k,1603) = lu(k,1603) - lu(k,362) * lu(k,1599) + lu(k,1611) = lu(k,1611) - lu(k,363) * lu(k,1599) + lu(k,1615) = lu(k,1615) - lu(k,364) * lu(k,1599) + lu(k,2117) = lu(k,2117) - lu(k,361) * lu(k,2115) + lu(k,2119) = lu(k,2119) - lu(k,362) * lu(k,2115) + lu(k,2128) = lu(k,2128) - lu(k,363) * lu(k,2115) + lu(k,2132) = lu(k,2132) - lu(k,364) * lu(k,2115) + lu(k,365) = 1._r8 / lu(k,365) + lu(k,366) = lu(k,366) * lu(k,365) + lu(k,367) = lu(k,367) * lu(k,365) + lu(k,368) = lu(k,368) * lu(k,365) + lu(k,369) = lu(k,369) * lu(k,365) + lu(k,498) = lu(k,498) - lu(k,366) * lu(k,497) + lu(k,499) = lu(k,499) - lu(k,367) * lu(k,497) + lu(k,500) = - lu(k,368) * lu(k,497) + lu(k,502) = lu(k,502) - lu(k,369) * lu(k,497) + lu(k,1814) = lu(k,1814) - lu(k,366) * lu(k,1795) + lu(k,1867) = lu(k,1867) - lu(k,367) * lu(k,1795) + lu(k,1904) = lu(k,1904) - lu(k,368) * lu(k,1795) + lu(k,1912) = lu(k,1912) - lu(k,369) * lu(k,1795) + lu(k,2345) = lu(k,2345) - lu(k,366) * lu(k,2331) + lu(k,2381) = lu(k,2381) - lu(k,367) * lu(k,2331) + lu(k,2413) = lu(k,2413) - lu(k,368) * lu(k,2331) + lu(k,2421) = lu(k,2421) - lu(k,369) * lu(k,2331) + lu(k,371) = 1._r8 / lu(k,371) + lu(k,372) = lu(k,372) * lu(k,371) + lu(k,373) = lu(k,373) * lu(k,371) + lu(k,374) = lu(k,374) * lu(k,371) + lu(k,375) = lu(k,375) * lu(k,371) + lu(k,485) = lu(k,485) - lu(k,372) * lu(k,484) + lu(k,486) = lu(k,486) - lu(k,373) * lu(k,484) + lu(k,487) = lu(k,487) - lu(k,374) * lu(k,484) + lu(k,489) = lu(k,489) - lu(k,375) * lu(k,484) + lu(k,1813) = lu(k,1813) - lu(k,372) * lu(k,1796) + lu(k,1823) = lu(k,1823) - lu(k,373) * lu(k,1796) + lu(k,1904) = lu(k,1904) - lu(k,374) * lu(k,1796) + lu(k,1912) = lu(k,1912) - lu(k,375) * lu(k,1796) + lu(k,2343) = lu(k,2343) - lu(k,372) * lu(k,2332) + lu(k,2353) = lu(k,2353) - lu(k,373) * lu(k,2332) + lu(k,2413) = lu(k,2413) - lu(k,374) * lu(k,2332) + lu(k,2421) = lu(k,2421) - lu(k,375) * lu(k,2332) + lu(k,376) = 1._r8 / lu(k,376) + lu(k,377) = lu(k,377) * lu(k,376) + lu(k,378) = lu(k,378) * lu(k,376) + lu(k,379) = lu(k,379) * lu(k,376) + lu(k,380) = lu(k,380) * lu(k,376) + lu(k,953) = lu(k,953) - lu(k,377) * lu(k,951) + lu(k,954) = lu(k,954) - lu(k,378) * lu(k,951) + lu(k,957) = lu(k,957) - lu(k,379) * lu(k,951) + lu(k,959) = lu(k,959) - lu(k,380) * lu(k,951) + lu(k,1858) = lu(k,1858) - lu(k,377) * lu(k,1797) + lu(k,1876) = lu(k,1876) - lu(k,378) * lu(k,1797) + lu(k,1904) = lu(k,1904) - lu(k,379) * lu(k,1797) + lu(k,1912) = lu(k,1912) - lu(k,380) * lu(k,1797) + lu(k,2376) = lu(k,2376) - lu(k,377) * lu(k,2333) + lu(k,2387) = lu(k,2387) - lu(k,378) * lu(k,2333) + lu(k,2413) = lu(k,2413) - lu(k,379) * lu(k,2333) + lu(k,2421) = lu(k,2421) - lu(k,380) * lu(k,2333) + lu(k,381) = 1._r8 / lu(k,381) + lu(k,382) = lu(k,382) * lu(k,381) + lu(k,383) = lu(k,383) * lu(k,381) + lu(k,1371) = lu(k,1371) - lu(k,382) * lu(k,1358) + lu(k,1382) = lu(k,1382) - lu(k,383) * lu(k,1358) + lu(k,1461) = lu(k,1461) - lu(k,382) * lu(k,1452) + lu(k,1476) = lu(k,1476) - lu(k,383) * lu(k,1452) + lu(k,1670) = lu(k,1670) - lu(k,382) * lu(k,1648) + lu(k,1687) = lu(k,1687) - lu(k,383) * lu(k,1648) + lu(k,1883) = lu(k,1883) - lu(k,382) * lu(k,1798) + lu(k,1904) = lu(k,1904) - lu(k,383) * lu(k,1798) + lu(k,2215) = lu(k,2215) - lu(k,382) * lu(k,2165) + lu(k,2233) = lu(k,2233) - lu(k,383) * lu(k,2165) + lu(k,2274) = lu(k,2274) - lu(k,382) * lu(k,2249) + lu(k,2293) = lu(k,2293) - lu(k,383) * lu(k,2249) + lu(k,384) = 1._r8 / lu(k,384) + lu(k,385) = lu(k,385) * lu(k,384) + lu(k,386) = lu(k,386) * lu(k,384) + lu(k,387) = lu(k,387) * lu(k,384) + lu(k,388) = lu(k,388) * lu(k,384) + lu(k,1398) = lu(k,1398) - lu(k,385) * lu(k,1390) + lu(k,1399) = - lu(k,386) * lu(k,1390) + lu(k,1404) = - lu(k,387) * lu(k,1390) + lu(k,1407) = lu(k,1407) - lu(k,388) * lu(k,1390) + lu(k,1889) = lu(k,1889) - lu(k,385) * lu(k,1799) + lu(k,1891) = lu(k,1891) - lu(k,386) * lu(k,1799) + lu(k,1904) = lu(k,1904) - lu(k,387) * lu(k,1799) + lu(k,1912) = lu(k,1912) - lu(k,388) * lu(k,1799) + lu(k,2399) = lu(k,2399) - lu(k,385) * lu(k,2334) + lu(k,2401) = lu(k,2401) - lu(k,386) * lu(k,2334) + lu(k,2413) = lu(k,2413) - lu(k,387) * lu(k,2334) + lu(k,2421) = lu(k,2421) - lu(k,388) * lu(k,2334) + 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,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,770) = - lu(k,390) * lu(k,761) + lu(k,771) = lu(k,771) - lu(k,391) * lu(k,761) + lu(k,772) = - lu(k,392) * lu(k,761) + lu(k,774) = lu(k,774) - lu(k,393) * lu(k,761) + lu(k,813) = - lu(k,390) * lu(k,804) + lu(k,814) = lu(k,814) - lu(k,391) * lu(k,804) + lu(k,815) = - lu(k,392) * lu(k,804) + lu(k,818) = lu(k,818) - lu(k,393) * lu(k,804) + lu(k,2209) = lu(k,2209) - lu(k,390) * lu(k,2166) + lu(k,2218) = lu(k,2218) - lu(k,391) * lu(k,2166) + lu(k,2224) = lu(k,2224) - lu(k,392) * lu(k,2166) + lu(k,2241) = lu(k,2241) - lu(k,393) * lu(k,2166) + lu(k,394) = 1._r8 / lu(k,394) + lu(k,395) = lu(k,395) * lu(k,394) + lu(k,396) = lu(k,396) * lu(k,394) + lu(k,397) = lu(k,397) * lu(k,394) + lu(k,398) = lu(k,398) * lu(k,394) + lu(k,719) = lu(k,719) - lu(k,395) * lu(k,718) + lu(k,720) = lu(k,720) - lu(k,396) * lu(k,718) + lu(k,721) = lu(k,721) - lu(k,397) * lu(k,718) + lu(k,722) = lu(k,722) - lu(k,398) * lu(k,718) + lu(k,1840) = lu(k,1840) - lu(k,395) * lu(k,1800) + lu(k,1876) = lu(k,1876) - lu(k,396) * lu(k,1800) + lu(k,1892) = lu(k,1892) - lu(k,397) * lu(k,1800) + lu(k,1904) = lu(k,1904) - lu(k,398) * lu(k,1800) + lu(k,2361) = lu(k,2361) - lu(k,395) * lu(k,2335) + lu(k,2387) = lu(k,2387) - lu(k,396) * lu(k,2335) + lu(k,2402) = lu(k,2402) - lu(k,397) * lu(k,2335) + lu(k,2413) = lu(k,2413) - lu(k,398) * lu(k,2335) + lu(k,399) = 1._r8 / lu(k,399) + lu(k,400) = lu(k,400) * lu(k,399) + lu(k,401) = lu(k,401) * lu(k,399) + lu(k,402) = lu(k,402) * lu(k,399) + lu(k,403) = lu(k,403) * lu(k,399) + lu(k,404) = lu(k,404) * lu(k,399) + lu(k,405) = lu(k,405) * lu(k,399) + lu(k,406) = lu(k,406) * lu(k,399) + lu(k,1877) = lu(k,1877) - lu(k,400) * lu(k,1801) + lu(k,1896) = lu(k,1896) - lu(k,401) * lu(k,1801) + lu(k,1901) = lu(k,1901) - lu(k,402) * lu(k,1801) + lu(k,1904) = lu(k,1904) - lu(k,403) * lu(k,1801) + lu(k,1906) = lu(k,1906) - lu(k,404) * lu(k,1801) + lu(k,1912) = lu(k,1912) - lu(k,405) * lu(k,1801) + lu(k,1915) = lu(k,1915) - lu(k,406) * lu(k,1801) + lu(k,1978) = lu(k,1978) - lu(k,400) * lu(k,1963) + lu(k,1985) = lu(k,1985) - lu(k,401) * lu(k,1963) + lu(k,1990) = lu(k,1990) - lu(k,402) * lu(k,1963) + lu(k,1993) = lu(k,1993) - lu(k,403) * lu(k,1963) + lu(k,1995) = lu(k,1995) - lu(k,404) * lu(k,1963) + lu(k,2001) = lu(k,2001) - lu(k,405) * lu(k,1963) + lu(k,2004) = lu(k,2004) - lu(k,406) * lu(k,1963) + lu(k,407) = 1._r8 / lu(k,407) + lu(k,408) = lu(k,408) * lu(k,407) + lu(k,409) = lu(k,409) * lu(k,407) + lu(k,410) = lu(k,410) * lu(k,407) + lu(k,411) = lu(k,411) * lu(k,407) + lu(k,412) = lu(k,412) * lu(k,407) + lu(k,413) = lu(k,413) * lu(k,407) + lu(k,414) = lu(k,414) * lu(k,407) + lu(k,1828) = lu(k,1828) - lu(k,408) * lu(k,1802) + lu(k,1870) = lu(k,1870) - lu(k,409) * lu(k,1802) + lu(k,1876) = lu(k,1876) - lu(k,410) * lu(k,1802) + lu(k,1904) = lu(k,1904) - lu(k,411) * lu(k,1802) + lu(k,1911) = lu(k,1911) - lu(k,412) * lu(k,1802) + lu(k,1913) = lu(k,1913) - lu(k,413) * lu(k,1802) + lu(k,1914) = lu(k,1914) - lu(k,414) * lu(k,1802) + lu(k,2251) = - lu(k,408) * lu(k,2250) + lu(k,2262) = lu(k,2262) - lu(k,409) * lu(k,2250) + lu(k,2267) = lu(k,2267) - lu(k,410) * lu(k,2250) + lu(k,2293) = lu(k,2293) - lu(k,411) * lu(k,2250) + lu(k,2300) = lu(k,2300) - lu(k,412) * lu(k,2250) + lu(k,2302) = lu(k,2302) - lu(k,413) * lu(k,2250) + lu(k,2303) = lu(k,2303) - lu(k,414) * lu(k,2250) + lu(k,415) = 1._r8 / lu(k,415) + lu(k,416) = lu(k,416) * lu(k,415) + lu(k,417) = lu(k,417) * lu(k,415) + lu(k,418) = lu(k,418) * lu(k,415) + lu(k,419) = lu(k,419) * lu(k,415) + lu(k,420) = lu(k,420) * lu(k,415) + lu(k,421) = lu(k,421) * lu(k,415) + lu(k,422) = lu(k,422) * lu(k,415) + lu(k,1845) = lu(k,1845) - lu(k,416) * lu(k,1803) + lu(k,1862) = lu(k,1862) - lu(k,417) * lu(k,1803) + lu(k,1877) = lu(k,1877) - lu(k,418) * lu(k,1803) + lu(k,1895) = lu(k,1895) - lu(k,419) * lu(k,1803) + lu(k,1903) = lu(k,1903) - lu(k,420) * lu(k,1803) + lu(k,1904) = lu(k,1904) - lu(k,421) * lu(k,1803) + lu(k,1905) = lu(k,1905) - lu(k,422) * lu(k,1803) + lu(k,1924) = - lu(k,416) * lu(k,1918) + lu(k,1932) = - lu(k,417) * lu(k,1918) + lu(k,1935) = lu(k,1935) - lu(k,418) * lu(k,1918) + lu(k,1938) = lu(k,1938) - lu(k,419) * lu(k,1918) + lu(k,1946) = lu(k,1946) - lu(k,420) * lu(k,1918) + lu(k,1947) = lu(k,1947) - lu(k,421) * lu(k,1918) + lu(k,1948) = lu(k,1948) - lu(k,422) * lu(k,1918) + lu(k,423) = 1._r8 / lu(k,423) + lu(k,424) = lu(k,424) * lu(k,423) + lu(k,425) = lu(k,425) * lu(k,423) + lu(k,426) = lu(k,426) * lu(k,423) + lu(k,427) = lu(k,427) * lu(k,423) + lu(k,428) = lu(k,428) * lu(k,423) + lu(k,1022) = - lu(k,424) * lu(k,1018) + lu(k,1028) = lu(k,1028) - lu(k,425) * lu(k,1018) + lu(k,1030) = - lu(k,426) * lu(k,1018) + lu(k,1031) = lu(k,1031) - lu(k,427) * lu(k,1018) + lu(k,1036) = lu(k,1036) - lu(k,428) * lu(k,1018) + lu(k,1050) = - lu(k,424) * lu(k,1046) + lu(k,1056) = lu(k,1056) - lu(k,425) * lu(k,1046) + lu(k,1058) = - lu(k,426) * lu(k,1046) + lu(k,1059) = lu(k,1059) - lu(k,427) * lu(k,1046) + lu(k,1064) = lu(k,1064) - lu(k,428) * lu(k,1046) + lu(k,2069) = - lu(k,424) * lu(k,2056) + lu(k,2077) = lu(k,2077) - lu(k,425) * lu(k,2056) + lu(k,2084) = lu(k,2084) - lu(k,426) * lu(k,2056) + lu(k,2090) = lu(k,2090) - lu(k,427) * lu(k,2056) + lu(k,2108) = lu(k,2108) - lu(k,428) * lu(k,2056) + 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,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,1259) = lu(k,1259) - lu(k,430) * lu(k,1256) + lu(k,1261) = lu(k,1261) - lu(k,431) * lu(k,1256) + lu(k,1263) = lu(k,1263) - lu(k,432) * lu(k,1256) + lu(k,1266) = lu(k,1266) - lu(k,433) * lu(k,1256) + lu(k,1268) = - lu(k,434) * lu(k,1256) + lu(k,1882) = lu(k,1882) - lu(k,430) * lu(k,1804) + lu(k,1892) = lu(k,1892) - lu(k,431) * lu(k,1804) + lu(k,1904) = lu(k,1904) - lu(k,432) * lu(k,1804) + lu(k,1913) = lu(k,1913) - lu(k,433) * lu(k,1804) + lu(k,1915) = lu(k,1915) - lu(k,434) * lu(k,1804) + lu(k,2392) = lu(k,2392) - lu(k,430) * lu(k,2336) + lu(k,2402) = lu(k,2402) - lu(k,431) * lu(k,2336) + lu(k,2413) = lu(k,2413) - lu(k,432) * lu(k,2336) + lu(k,2422) = lu(k,2422) - lu(k,433) * lu(k,2336) + lu(k,2424) = lu(k,2424) - lu(k,434) * lu(k,2336) + lu(k,435) = 1._r8 / lu(k,435) + lu(k,436) = lu(k,436) * lu(k,435) + lu(k,437) = lu(k,437) * lu(k,435) + lu(k,438) = lu(k,438) * lu(k,435) + lu(k,439) = lu(k,439) * lu(k,435) + lu(k,440) = lu(k,440) * lu(k,435) + lu(k,977) = lu(k,977) - lu(k,436) * lu(k,976) + lu(k,978) = lu(k,978) - lu(k,437) * lu(k,976) + lu(k,982) = - lu(k,438) * lu(k,976) + lu(k,984) = lu(k,984) - lu(k,439) * lu(k,976) + lu(k,987) = - lu(k,440) * lu(k,976) + lu(k,1861) = lu(k,1861) - lu(k,436) * lu(k,1805) + lu(k,1870) = lu(k,1870) - lu(k,437) * lu(k,1805) + lu(k,1904) = lu(k,1904) - lu(k,438) * lu(k,1805) + lu(k,1912) = lu(k,1912) - lu(k,439) * lu(k,1805) + lu(k,1915) = lu(k,1915) - lu(k,440) * lu(k,1805) + lu(k,2379) = lu(k,2379) - lu(k,436) * lu(k,2337) + lu(k,2384) = - lu(k,437) * lu(k,2337) + lu(k,2413) = lu(k,2413) - lu(k,438) * lu(k,2337) + lu(k,2421) = lu(k,2421) - lu(k,439) * lu(k,2337) + lu(k,2424) = lu(k,2424) - lu(k,440) * lu(k,2337) + lu(k,441) = 1._r8 / lu(k,441) + lu(k,442) = lu(k,442) * lu(k,441) + lu(k,443) = lu(k,443) * lu(k,441) + lu(k,444) = lu(k,444) * lu(k,441) + lu(k,445) = lu(k,445) * lu(k,441) + lu(k,446) = lu(k,446) * lu(k,441) + lu(k,1684) = lu(k,1684) - lu(k,442) * lu(k,1649) + lu(k,1686) = - lu(k,443) * lu(k,1649) + lu(k,1687) = lu(k,1687) - lu(k,444) * lu(k,1649) + lu(k,1696) = lu(k,1696) - lu(k,445) * lu(k,1649) + lu(k,1698) = - lu(k,446) * lu(k,1649) + lu(k,1901) = lu(k,1901) - lu(k,442) * lu(k,1806) + lu(k,1903) = lu(k,1903) - lu(k,443) * lu(k,1806) + lu(k,1904) = lu(k,1904) - lu(k,444) * lu(k,1806) + lu(k,1913) = lu(k,1913) - lu(k,445) * lu(k,1806) + lu(k,1915) = lu(k,1915) - lu(k,446) * lu(k,1806) + lu(k,2410) = lu(k,2410) - lu(k,442) * lu(k,2338) + lu(k,2412) = lu(k,2412) - lu(k,443) * lu(k,2338) + lu(k,2413) = lu(k,2413) - lu(k,444) * lu(k,2338) + lu(k,2422) = lu(k,2422) - lu(k,445) * lu(k,2338) + lu(k,2424) = lu(k,2424) - lu(k,446) * lu(k,2338) + lu(k,447) = 1._r8 / lu(k,447) + lu(k,448) = lu(k,448) * lu(k,447) + lu(k,449) = lu(k,449) * lu(k,447) + lu(k,450) = lu(k,450) * lu(k,447) + lu(k,451) = lu(k,451) * lu(k,447) + lu(k,452) = lu(k,452) * lu(k,447) + lu(k,1896) = lu(k,1896) - lu(k,448) * lu(k,1807) + lu(k,1897) = lu(k,1897) - lu(k,449) * lu(k,1807) + lu(k,1904) = lu(k,1904) - lu(k,450) * lu(k,1807) + lu(k,1906) = lu(k,1906) - lu(k,451) * lu(k,1807) + lu(k,1907) = lu(k,1907) - lu(k,452) * lu(k,1807) + lu(k,1985) = lu(k,1985) - lu(k,448) * lu(k,1964) + lu(k,1986) = lu(k,1986) - lu(k,449) * lu(k,1964) + lu(k,1993) = lu(k,1993) - lu(k,450) * lu(k,1964) + lu(k,1995) = lu(k,1995) - lu(k,451) * lu(k,1964) + lu(k,1996) = - lu(k,452) * lu(k,1964) + lu(k,2028) = lu(k,2028) - lu(k,448) * lu(k,2022) + lu(k,2029) = lu(k,2029) - lu(k,449) * lu(k,2022) + lu(k,2036) = lu(k,2036) - lu(k,450) * lu(k,2022) + lu(k,2038) = lu(k,2038) - lu(k,451) * lu(k,2022) + lu(k,2039) = lu(k,2039) - lu(k,452) * lu(k,2022) + lu(k,453) = 1._r8 / lu(k,453) + lu(k,454) = lu(k,454) * lu(k,453) + lu(k,455) = lu(k,455) * lu(k,453) + lu(k,456) = lu(k,456) * lu(k,453) + lu(k,457) = lu(k,457) * lu(k,453) + lu(k,458) = lu(k,458) * lu(k,453) + lu(k,1131) = lu(k,1131) - lu(k,454) * lu(k,1128) + lu(k,1132) = lu(k,1132) - lu(k,455) * lu(k,1128) + lu(k,1137) = - lu(k,456) * lu(k,1128) + lu(k,1138) = - lu(k,457) * lu(k,1128) + lu(k,1143) = lu(k,1143) - lu(k,458) * lu(k,1128) + lu(k,1869) = lu(k,1869) - lu(k,454) * lu(k,1808) + lu(k,1872) = lu(k,1872) - lu(k,455) * lu(k,1808) + lu(k,1902) = lu(k,1902) - lu(k,456) * lu(k,1808) + lu(k,1904) = lu(k,1904) - lu(k,457) * lu(k,1808) + lu(k,1914) = lu(k,1914) - lu(k,458) * lu(k,1808) + lu(k,2383) = - lu(k,454) * lu(k,2339) + lu(k,2385) = lu(k,2385) - lu(k,455) * lu(k,2339) + lu(k,2411) = - lu(k,456) * lu(k,2339) + lu(k,2413) = lu(k,2413) - lu(k,457) * lu(k,2339) + lu(k,2423) = lu(k,2423) - lu(k,458) * lu(k,2339) + 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,1290) = - lu(k,460) * lu(k,1286) + lu(k,1293) = - lu(k,461) * lu(k,1286) + lu(k,1302) = - lu(k,462) * lu(k,1286) + lu(k,1303) = - lu(k,463) * lu(k,1286) + lu(k,1306) = lu(k,1306) - lu(k,464) * lu(k,1286) + lu(k,1654) = - lu(k,460) * lu(k,1650) + lu(k,1666) = lu(k,1666) - lu(k,461) * lu(k,1650) + lu(k,1685) = - lu(k,462) * lu(k,1650) + lu(k,1687) = lu(k,1687) - lu(k,463) * lu(k,1650) + lu(k,1695) = lu(k,1695) - lu(k,464) * lu(k,1650) + lu(k,1855) = lu(k,1855) - lu(k,460) * lu(k,1809) + lu(k,1878) = lu(k,1878) - lu(k,461) * lu(k,1809) + lu(k,1902) = lu(k,1902) - lu(k,462) * lu(k,1809) + lu(k,1904) = lu(k,1904) - lu(k,463) * lu(k,1809) + lu(k,1912) = lu(k,1912) - lu(k,464) * lu(k,1809) + 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,465) = 1._r8 / lu(k,465) + lu(k,466) = lu(k,466) * lu(k,465) + lu(k,467) = lu(k,467) * lu(k,465) + lu(k,468) = lu(k,468) * lu(k,465) + lu(k,469) = lu(k,469) * lu(k,465) + lu(k,470) = lu(k,470) * lu(k,465) + lu(k,538) = lu(k,538) - lu(k,466) * lu(k,537) + lu(k,539) = lu(k,539) - lu(k,467) * lu(k,537) + lu(k,541) = lu(k,541) - lu(k,468) * lu(k,537) + lu(k,542) = - lu(k,469) * lu(k,537) + lu(k,544) = lu(k,544) - lu(k,470) * lu(k,537) + lu(k,1815) = lu(k,1815) - lu(k,466) * lu(k,1810) + lu(k,1820) = lu(k,1820) - lu(k,467) * lu(k,1810) + lu(k,1867) = lu(k,1867) - lu(k,468) * lu(k,1810) + lu(k,1904) = lu(k,1904) - lu(k,469) * lu(k,1810) + lu(k,1912) = lu(k,1912) - lu(k,470) * lu(k,1810) + lu(k,2346) = - lu(k,466) * lu(k,2340) + lu(k,2351) = lu(k,2351) - lu(k,467) * lu(k,2340) + lu(k,2381) = lu(k,2381) - lu(k,468) * lu(k,2340) + lu(k,2413) = lu(k,2413) - lu(k,469) * lu(k,2340) + lu(k,2421) = lu(k,2421) - lu(k,470) * lu(k,2340) + lu(k,471) = 1._r8 / lu(k,471) + lu(k,472) = lu(k,472) * lu(k,471) + lu(k,473) = lu(k,473) * lu(k,471) + lu(k,474) = lu(k,474) * lu(k,471) + lu(k,475) = lu(k,475) * lu(k,471) + lu(k,476) = lu(k,476) * lu(k,471) + lu(k,1288) = - lu(k,472) * lu(k,1287) + lu(k,1290) = lu(k,1290) - lu(k,473) * lu(k,1287) + lu(k,1303) = lu(k,1303) - lu(k,474) * lu(k,1287) + lu(k,1306) = lu(k,1306) - lu(k,475) * lu(k,1287) + lu(k,1308) = lu(k,1308) - lu(k,476) * lu(k,1287) + lu(k,1843) = lu(k,1843) - lu(k,472) * lu(k,1811) + lu(k,1855) = lu(k,1855) - lu(k,473) * lu(k,1811) + lu(k,1904) = lu(k,1904) - lu(k,474) * lu(k,1811) + lu(k,1912) = lu(k,1912) - lu(k,475) * lu(k,1811) + lu(k,1914) = lu(k,1914) - lu(k,476) * lu(k,1811) + lu(k,2364) = lu(k,2364) - lu(k,472) * lu(k,2341) + lu(k,2375) = - lu(k,473) * lu(k,2341) + lu(k,2413) = lu(k,2413) - lu(k,474) * lu(k,2341) + lu(k,2421) = lu(k,2421) - lu(k,475) * lu(k,2341) + lu(k,2423) = lu(k,2423) - lu(k,476) * lu(k,2341) + 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,554) = lu(k,554) - lu(k,478) * lu(k,553) + lu(k,555) = lu(k,555) - lu(k,479) * lu(k,553) + lu(k,556) = lu(k,556) - lu(k,480) * lu(k,553) + lu(k,557) = - lu(k,481) * lu(k,553) + lu(k,559) = lu(k,559) - lu(k,482) * lu(k,553) + lu(k,1821) = lu(k,1821) - lu(k,478) * lu(k,1812) + lu(k,1867) = lu(k,1867) - lu(k,479) * lu(k,1812) + lu(k,1886) = lu(k,1886) - lu(k,480) * lu(k,1812) + lu(k,1904) = lu(k,1904) - lu(k,481) * lu(k,1812) + lu(k,1912) = lu(k,1912) - lu(k,482) * lu(k,1812) + lu(k,2352) = lu(k,2352) - lu(k,478) * lu(k,2342) + lu(k,2381) = lu(k,2381) - lu(k,479) * lu(k,2342) + lu(k,2396) = lu(k,2396) - lu(k,480) * lu(k,2342) + lu(k,2413) = lu(k,2413) - lu(k,481) * lu(k,2342) + lu(k,2421) = lu(k,2421) - lu(k,482) * lu(k,2342) + lu(k,485) = 1._r8 / lu(k,485) + lu(k,486) = lu(k,486) * lu(k,485) + lu(k,487) = lu(k,487) * lu(k,485) + lu(k,488) = lu(k,488) * lu(k,485) + lu(k,489) = lu(k,489) * lu(k,485) + lu(k,490) = lu(k,490) * lu(k,485) + lu(k,1823) = lu(k,1823) - lu(k,486) * lu(k,1813) + lu(k,1904) = lu(k,1904) - lu(k,487) * lu(k,1813) + lu(k,1910) = lu(k,1910) - lu(k,488) * lu(k,1813) + lu(k,1912) = lu(k,1912) - lu(k,489) * lu(k,1813) + lu(k,1914) = lu(k,1914) - lu(k,490) * lu(k,1813) + lu(k,2176) = lu(k,2176) - lu(k,486) * lu(k,2167) + lu(k,2233) = lu(k,2233) - lu(k,487) * lu(k,2167) + lu(k,2239) = lu(k,2239) - lu(k,488) * lu(k,2167) + lu(k,2241) = lu(k,2241) - lu(k,489) * lu(k,2167) + lu(k,2243) = lu(k,2243) - lu(k,490) * lu(k,2167) + lu(k,2353) = lu(k,2353) - lu(k,486) * lu(k,2343) + lu(k,2413) = lu(k,2413) - lu(k,487) * lu(k,2343) + lu(k,2419) = lu(k,2419) - lu(k,488) * lu(k,2343) + lu(k,2421) = lu(k,2421) - lu(k,489) * lu(k,2343) + lu(k,2423) = lu(k,2423) - lu(k,490) * lu(k,2343) + lu(k,491) = 1._r8 / lu(k,491) + lu(k,492) = lu(k,492) * lu(k,491) + lu(k,493) = lu(k,493) * lu(k,491) + lu(k,494) = lu(k,494) * lu(k,491) + lu(k,495) = lu(k,495) * lu(k,491) + lu(k,496) = lu(k,496) * lu(k,491) + lu(k,2196) = lu(k,2196) - lu(k,492) * lu(k,2168) + lu(k,2239) = lu(k,2239) - lu(k,493) * lu(k,2168) + lu(k,2241) = lu(k,2241) - lu(k,494) * lu(k,2168) + lu(k,2242) = lu(k,2242) - lu(k,495) * lu(k,2168) + lu(k,2243) = lu(k,2243) - lu(k,496) * lu(k,2168) + lu(k,2377) = lu(k,2377) - lu(k,492) * lu(k,2344) + lu(k,2419) = lu(k,2419) - lu(k,493) * lu(k,2344) + lu(k,2421) = lu(k,2421) - lu(k,494) * lu(k,2344) + lu(k,2422) = lu(k,2422) - lu(k,495) * lu(k,2344) + lu(k,2423) = lu(k,2423) - lu(k,496) * lu(k,2344) + lu(k,2427) = - lu(k,492) * lu(k,2425) + lu(k,2445) = - lu(k,493) * lu(k,2425) + lu(k,2447) = lu(k,2447) - lu(k,494) * lu(k,2425) + lu(k,2448) = lu(k,2448) - lu(k,495) * lu(k,2425) + lu(k,2449) = - lu(k,496) * lu(k,2425) + lu(k,498) = 1._r8 / lu(k,498) + lu(k,499) = lu(k,499) * lu(k,498) + lu(k,500) = lu(k,500) * lu(k,498) + lu(k,501) = lu(k,501) * lu(k,498) + lu(k,502) = lu(k,502) * lu(k,498) + lu(k,503) = lu(k,503) * lu(k,498) + lu(k,1867) = lu(k,1867) - lu(k,499) * lu(k,1814) + lu(k,1904) = lu(k,1904) - lu(k,500) * lu(k,1814) + lu(k,1910) = lu(k,1910) - lu(k,501) * lu(k,1814) + lu(k,1912) = lu(k,1912) - lu(k,502) * lu(k,1814) + lu(k,1914) = lu(k,1914) - lu(k,503) * lu(k,1814) + lu(k,2201) = lu(k,2201) - lu(k,499) * lu(k,2169) + lu(k,2233) = lu(k,2233) - lu(k,500) * lu(k,2169) + lu(k,2239) = lu(k,2239) - lu(k,501) * lu(k,2169) + lu(k,2241) = lu(k,2241) - lu(k,502) * lu(k,2169) + lu(k,2243) = lu(k,2243) - lu(k,503) * lu(k,2169) + lu(k,2381) = lu(k,2381) - lu(k,499) * lu(k,2345) + lu(k,2413) = lu(k,2413) - lu(k,500) * lu(k,2345) + lu(k,2419) = lu(k,2419) - lu(k,501) * lu(k,2345) + lu(k,2421) = lu(k,2421) - lu(k,502) * lu(k,2345) + lu(k,2423) = lu(k,2423) - lu(k,503) * lu(k,2345) + lu(k,504) = 1._r8 / lu(k,504) + lu(k,505) = lu(k,505) * lu(k,504) + lu(k,506) = lu(k,506) * lu(k,504) + lu(k,540) = - lu(k,505) * lu(k,538) + lu(k,544) = lu(k,544) - lu(k,506) * lu(k,538) + lu(k,655) = - lu(k,505) * lu(k,652) + lu(k,661) = lu(k,661) - lu(k,506) * lu(k,652) + lu(k,765) = - lu(k,505) * lu(k,762) + lu(k,774) = lu(k,774) - lu(k,506) * lu(k,762) + lu(k,792) = - lu(k,505) * lu(k,789) + lu(k,801) = lu(k,801) - lu(k,506) * lu(k,789) + lu(k,808) = - lu(k,505) * lu(k,805) + lu(k,818) = lu(k,818) - lu(k,506) * lu(k,805) + lu(k,1846) = - lu(k,505) * lu(k,1815) + lu(k,1912) = lu(k,1912) - lu(k,506) * lu(k,1815) + lu(k,2185) = lu(k,2185) - lu(k,505) * lu(k,2170) + lu(k,2241) = lu(k,2241) - lu(k,506) * lu(k,2170) + lu(k,2366) = lu(k,2366) - lu(k,505) * lu(k,2346) + lu(k,2421) = lu(k,2421) - lu(k,506) * lu(k,2346) + 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,507) = 1._r8 / lu(k,507) + lu(k,508) = lu(k,508) * lu(k,507) + lu(k,509) = lu(k,509) * lu(k,507) + lu(k,510) = lu(k,510) * lu(k,507) + lu(k,511) = lu(k,511) * lu(k,507) + lu(k,840) = - lu(k,508) * lu(k,838) + lu(k,841) = - lu(k,509) * lu(k,838) + lu(k,844) = lu(k,844) - lu(k,510) * lu(k,838) + lu(k,845) = lu(k,845) - lu(k,511) * lu(k,838) + lu(k,1580) = lu(k,1580) - lu(k,508) * lu(k,1568) + lu(k,1584) = lu(k,1584) - lu(k,509) * lu(k,1568) + lu(k,1594) = lu(k,1594) - lu(k,510) * lu(k,1568) + lu(k,1595) = - lu(k,511) * lu(k,1568) + lu(k,2210) = lu(k,2210) - lu(k,508) * lu(k,2171) + lu(k,2227) = lu(k,2227) - lu(k,509) * lu(k,2171) + lu(k,2241) = lu(k,2241) - lu(k,510) * lu(k,2171) + lu(k,2242) = lu(k,2242) - lu(k,511) * lu(k,2171) + lu(k,2389) = - lu(k,508) * lu(k,2347) + lu(k,2407) = lu(k,2407) - lu(k,509) * lu(k,2347) + lu(k,2421) = lu(k,2421) - lu(k,510) * lu(k,2347) + lu(k,2422) = lu(k,2422) - lu(k,511) * lu(k,2347) + lu(k,512) = 1._r8 / lu(k,512) + lu(k,513) = lu(k,513) * lu(k,512) + lu(k,514) = lu(k,514) * lu(k,512) + lu(k,515) = lu(k,515) * lu(k,512) + lu(k,516) = lu(k,516) * lu(k,512) + lu(k,517) = lu(k,517) * lu(k,512) + lu(k,518) = lu(k,518) * lu(k,512) + lu(k,1898) = lu(k,1898) - lu(k,513) * lu(k,1816) + lu(k,1904) = lu(k,1904) - lu(k,514) * lu(k,1816) + lu(k,1911) = lu(k,1911) - lu(k,515) * lu(k,1816) + lu(k,1912) = lu(k,1912) - lu(k,516) * lu(k,1816) + lu(k,1914) = lu(k,1914) - lu(k,517) * lu(k,1816) + lu(k,1915) = lu(k,1915) - lu(k,518) * lu(k,1816) + lu(k,2407) = lu(k,2407) - lu(k,513) * lu(k,2348) + lu(k,2413) = lu(k,2413) - lu(k,514) * lu(k,2348) + lu(k,2420) = lu(k,2420) - lu(k,515) * lu(k,2348) + lu(k,2421) = lu(k,2421) - lu(k,516) * lu(k,2348) + lu(k,2423) = lu(k,2423) - lu(k,517) * lu(k,2348) + lu(k,2424) = lu(k,2424) - lu(k,518) * lu(k,2348) + lu(k,2478) = lu(k,2478) - lu(k,513) * lu(k,2454) + lu(k,2484) = lu(k,2484) - lu(k,514) * lu(k,2454) + lu(k,2491) = lu(k,2491) - lu(k,515) * lu(k,2454) + lu(k,2492) = lu(k,2492) - lu(k,516) * lu(k,2454) + lu(k,2494) = lu(k,2494) - lu(k,517) * lu(k,2454) + lu(k,2495) = - lu(k,518) * lu(k,2454) + lu(k,519) = 1._r8 / lu(k,519) + lu(k,520) = lu(k,520) * lu(k,519) + lu(k,521) = lu(k,521) * lu(k,519) + lu(k,522) = lu(k,522) * lu(k,519) + lu(k,523) = lu(k,523) * lu(k,519) + lu(k,524) = lu(k,524) * lu(k,519) + lu(k,525) = lu(k,525) * lu(k,519) + lu(k,1896) = lu(k,1896) - lu(k,520) * lu(k,1817) + lu(k,1897) = lu(k,1897) - lu(k,521) * lu(k,1817) + lu(k,1904) = lu(k,1904) - lu(k,522) * lu(k,1817) + lu(k,1906) = lu(k,1906) - lu(k,523) * lu(k,1817) + lu(k,1907) = lu(k,1907) - lu(k,524) * lu(k,1817) + lu(k,1915) = lu(k,1915) - lu(k,525) * lu(k,1817) + lu(k,1985) = lu(k,1985) - lu(k,520) * lu(k,1965) + lu(k,1986) = lu(k,1986) - lu(k,521) * lu(k,1965) + lu(k,1993) = lu(k,1993) - lu(k,522) * lu(k,1965) + lu(k,1995) = lu(k,1995) - lu(k,523) * lu(k,1965) + lu(k,1996) = lu(k,1996) - lu(k,524) * lu(k,1965) + lu(k,2004) = lu(k,2004) - lu(k,525) * lu(k,1965) + lu(k,2028) = lu(k,2028) - lu(k,520) * lu(k,2023) + lu(k,2029) = lu(k,2029) - lu(k,521) * lu(k,2023) + lu(k,2036) = lu(k,2036) - lu(k,522) * lu(k,2023) + lu(k,2038) = lu(k,2038) - lu(k,523) * lu(k,2023) + lu(k,2039) = lu(k,2039) - lu(k,524) * lu(k,2023) + lu(k,2047) = lu(k,2047) - lu(k,525) * lu(k,2023) + lu(k,526) = 1._r8 / lu(k,526) + lu(k,527) = lu(k,527) * lu(k,526) + lu(k,528) = lu(k,528) * lu(k,526) + lu(k,529) = lu(k,529) * lu(k,526) + lu(k,690) = lu(k,690) - lu(k,527) * lu(k,689) + lu(k,692) = - lu(k,528) * lu(k,689) + lu(k,695) = lu(k,695) - lu(k,529) * lu(k,689) + lu(k,1837) = lu(k,1837) - lu(k,527) * lu(k,1818) + lu(k,1908) = lu(k,1908) - lu(k,528) * lu(k,1818) + lu(k,1914) = lu(k,1914) - lu(k,529) * lu(k,1818) + lu(k,2059) = lu(k,2059) - lu(k,527) * lu(k,2057) + lu(k,2104) = lu(k,2104) - lu(k,528) * lu(k,2057) + lu(k,2110) = lu(k,2110) - lu(k,529) * lu(k,2057) + lu(k,2182) = lu(k,2182) - lu(k,527) * lu(k,2172) + lu(k,2237) = lu(k,2237) - lu(k,528) * lu(k,2172) + lu(k,2243) = lu(k,2243) - lu(k,529) * lu(k,2172) + lu(k,2359) = lu(k,2359) - lu(k,527) * lu(k,2349) + lu(k,2417) = lu(k,2417) - lu(k,528) * lu(k,2349) + lu(k,2423) = lu(k,2423) - lu(k,529) * lu(k,2349) + lu(k,2460) = - lu(k,527) * lu(k,2455) + lu(k,2488) = lu(k,2488) - lu(k,528) * lu(k,2455) + lu(k,2494) = lu(k,2494) - lu(k,529) * lu(k,2455) + 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,1092) = lu(k,1092) - lu(k,531) * lu(k,1089) + lu(k,1093) = lu(k,1093) - lu(k,532) * lu(k,1089) + lu(k,1094) = lu(k,1094) - lu(k,533) * lu(k,1089) + lu(k,1097) = - lu(k,534) * lu(k,1089) + lu(k,1099) = lu(k,1099) - lu(k,535) * lu(k,1089) + lu(k,1100) = lu(k,1100) - lu(k,536) * lu(k,1089) + lu(k,1868) = lu(k,1868) - lu(k,531) * lu(k,1819) + lu(k,1869) = lu(k,1869) - lu(k,532) * lu(k,1819) + lu(k,1870) = lu(k,1870) - lu(k,533) * lu(k,1819) + lu(k,1904) = lu(k,1904) - lu(k,534) * lu(k,1819) + lu(k,1912) = lu(k,1912) - lu(k,535) * lu(k,1819) + lu(k,1913) = lu(k,1913) - lu(k,536) * lu(k,1819) + lu(k,2382) = lu(k,2382) - lu(k,531) * lu(k,2350) + lu(k,2383) = lu(k,2383) - lu(k,532) * lu(k,2350) + lu(k,2384) = lu(k,2384) - lu(k,533) * lu(k,2350) + lu(k,2413) = lu(k,2413) - lu(k,534) * lu(k,2350) + lu(k,2421) = lu(k,2421) - lu(k,535) * lu(k,2350) + lu(k,2422) = lu(k,2422) - lu(k,536) * lu(k,2350) + lu(k,539) = 1._r8 / lu(k,539) + lu(k,540) = lu(k,540) * lu(k,539) + lu(k,541) = lu(k,541) * lu(k,539) + lu(k,542) = lu(k,542) * lu(k,539) + lu(k,543) = lu(k,543) * lu(k,539) + lu(k,544) = lu(k,544) * lu(k,539) + lu(k,545) = lu(k,545) * lu(k,539) + lu(k,1846) = lu(k,1846) - lu(k,540) * lu(k,1820) + lu(k,1867) = lu(k,1867) - lu(k,541) * lu(k,1820) + lu(k,1904) = lu(k,1904) - lu(k,542) * lu(k,1820) + lu(k,1910) = lu(k,1910) - lu(k,543) * lu(k,1820) + lu(k,1912) = lu(k,1912) - lu(k,544) * lu(k,1820) + lu(k,1914) = lu(k,1914) - lu(k,545) * lu(k,1820) + lu(k,2185) = lu(k,2185) - lu(k,540) * lu(k,2173) + lu(k,2201) = lu(k,2201) - lu(k,541) * lu(k,2173) + lu(k,2233) = lu(k,2233) - lu(k,542) * lu(k,2173) + lu(k,2239) = lu(k,2239) - lu(k,543) * lu(k,2173) + lu(k,2241) = lu(k,2241) - lu(k,544) * lu(k,2173) + lu(k,2243) = lu(k,2243) - lu(k,545) * lu(k,2173) + lu(k,2366) = lu(k,2366) - lu(k,540) * lu(k,2351) + lu(k,2381) = lu(k,2381) - lu(k,541) * lu(k,2351) + lu(k,2413) = lu(k,2413) - lu(k,542) * lu(k,2351) + lu(k,2419) = lu(k,2419) - lu(k,543) * lu(k,2351) + lu(k,2421) = lu(k,2421) - lu(k,544) * lu(k,2351) + lu(k,2423) = lu(k,2423) - lu(k,545) * lu(k,2351) + lu(k,546) = 1._r8 / lu(k,546) + lu(k,547) = lu(k,547) * lu(k,546) + lu(k,548) = lu(k,548) * lu(k,546) + lu(k,549) = lu(k,549) * lu(k,546) + lu(k,550) = lu(k,550) * lu(k,546) + lu(k,551) = lu(k,551) * lu(k,546) + lu(k,552) = lu(k,552) * lu(k,546) + lu(k,997) = - lu(k,547) * lu(k,996) + lu(k,998) = lu(k,998) - lu(k,548) * lu(k,996) + lu(k,999) = lu(k,999) - lu(k,549) * lu(k,996) + lu(k,1001) = lu(k,1001) - lu(k,550) * lu(k,996) + lu(k,1004) = lu(k,1004) - lu(k,551) * lu(k,996) + lu(k,1007) = lu(k,1007) - lu(k,552) * lu(k,996) + lu(k,1573) = lu(k,1573) - lu(k,547) * lu(k,1569) + lu(k,1574) = lu(k,1574) - lu(k,548) * lu(k,1569) + lu(k,1575) = lu(k,1575) - lu(k,549) * lu(k,1569) + lu(k,1578) = lu(k,1578) - lu(k,550) * lu(k,1569) + lu(k,1584) = lu(k,1584) - lu(k,551) * lu(k,1569) + lu(k,1588) = lu(k,1588) - lu(k,552) * lu(k,1569) + lu(k,1926) = lu(k,1926) - lu(k,547) * lu(k,1919) + lu(k,1929) = lu(k,1929) - lu(k,548) * lu(k,1919) + lu(k,1930) = - lu(k,549) * lu(k,1919) + lu(k,1933) = lu(k,1933) - lu(k,550) * lu(k,1919) + lu(k,1941) = lu(k,1941) - lu(k,551) * lu(k,1919) + lu(k,1948) = lu(k,1948) - lu(k,552) * lu(k,1919) + 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,554) = 1._r8 / lu(k,554) + lu(k,555) = lu(k,555) * lu(k,554) + lu(k,556) = lu(k,556) * lu(k,554) + lu(k,557) = lu(k,557) * lu(k,554) + lu(k,558) = lu(k,558) * lu(k,554) + lu(k,559) = lu(k,559) * lu(k,554) + lu(k,560) = lu(k,560) * lu(k,554) + lu(k,1867) = lu(k,1867) - lu(k,555) * lu(k,1821) + lu(k,1886) = lu(k,1886) - lu(k,556) * lu(k,1821) + lu(k,1904) = lu(k,1904) - lu(k,557) * lu(k,1821) + lu(k,1910) = lu(k,1910) - lu(k,558) * lu(k,1821) + lu(k,1912) = lu(k,1912) - lu(k,559) * lu(k,1821) + lu(k,1914) = lu(k,1914) - lu(k,560) * lu(k,1821) + lu(k,2201) = lu(k,2201) - lu(k,555) * lu(k,2174) + lu(k,2218) = lu(k,2218) - lu(k,556) * lu(k,2174) + lu(k,2233) = lu(k,2233) - lu(k,557) * lu(k,2174) + lu(k,2239) = lu(k,2239) - lu(k,558) * lu(k,2174) + lu(k,2241) = lu(k,2241) - lu(k,559) * lu(k,2174) + lu(k,2243) = lu(k,2243) - lu(k,560) * lu(k,2174) + lu(k,2381) = lu(k,2381) - lu(k,555) * lu(k,2352) + lu(k,2396) = lu(k,2396) - lu(k,556) * lu(k,2352) + lu(k,2413) = lu(k,2413) - lu(k,557) * lu(k,2352) + lu(k,2419) = lu(k,2419) - lu(k,558) * lu(k,2352) + lu(k,2421) = lu(k,2421) - lu(k,559) * lu(k,2352) + lu(k,2423) = lu(k,2423) - lu(k,560) * lu(k,2352) + lu(k,561) = 1._r8 / lu(k,561) + lu(k,562) = lu(k,562) * lu(k,561) + lu(k,563) = lu(k,563) * lu(k,561) + lu(k,564) = lu(k,564) * lu(k,561) + lu(k,565) = lu(k,565) * lu(k,561) + lu(k,698) = - lu(k,562) * lu(k,696) + lu(k,699) = - lu(k,563) * lu(k,696) + lu(k,703) = - lu(k,564) * lu(k,696) + lu(k,704) = lu(k,704) - lu(k,565) * lu(k,696) + lu(k,709) = - lu(k,562) * lu(k,707) + lu(k,710) = - lu(k,563) * lu(k,707) + lu(k,713) = - lu(k,564) * lu(k,707) + lu(k,714) = lu(k,714) - lu(k,565) * lu(k,707) + lu(k,1070) = - lu(k,562) * lu(k,1067) + lu(k,1071) = - lu(k,563) * lu(k,1067) + lu(k,1075) = - lu(k,564) * lu(k,1067) + lu(k,1078) = - lu(k,565) * lu(k,1067) + lu(k,1840) = lu(k,1840) - lu(k,562) * lu(k,1822) + lu(k,1858) = lu(k,1858) - lu(k,563) * lu(k,1822) + lu(k,1892) = lu(k,1892) - lu(k,564) * lu(k,1822) + lu(k,1904) = lu(k,1904) - lu(k,565) * lu(k,1822) + lu(k,2184) = lu(k,2184) - lu(k,562) * lu(k,2175) + lu(k,2195) = lu(k,2195) - lu(k,563) * lu(k,2175) + lu(k,2224) = lu(k,2224) - lu(k,564) * lu(k,2175) + lu(k,2233) = lu(k,2233) - lu(k,565) * lu(k,2175) + lu(k,567) = 1._r8 / lu(k,567) + lu(k,568) = lu(k,568) * lu(k,567) + lu(k,569) = lu(k,569) * lu(k,567) + lu(k,570) = lu(k,570) * lu(k,567) + lu(k,571) = lu(k,571) * lu(k,567) + lu(k,572) = lu(k,572) * lu(k,567) + lu(k,1837) = lu(k,1837) - lu(k,568) * lu(k,1823) + lu(k,1904) = lu(k,1904) - lu(k,569) * lu(k,1823) + lu(k,1910) = lu(k,1910) - lu(k,570) * lu(k,1823) + lu(k,1912) = lu(k,1912) - lu(k,571) * lu(k,1823) + lu(k,1914) = lu(k,1914) - lu(k,572) * lu(k,1823) + lu(k,2182) = lu(k,2182) - lu(k,568) * lu(k,2176) + lu(k,2233) = lu(k,2233) - lu(k,569) * lu(k,2176) + lu(k,2239) = lu(k,2239) - lu(k,570) * lu(k,2176) + lu(k,2241) = lu(k,2241) - lu(k,571) * lu(k,2176) + lu(k,2243) = lu(k,2243) - lu(k,572) * lu(k,2176) + lu(k,2359) = lu(k,2359) - lu(k,568) * lu(k,2353) + lu(k,2413) = lu(k,2413) - lu(k,569) * lu(k,2353) + lu(k,2419) = lu(k,2419) - lu(k,570) * lu(k,2353) + lu(k,2421) = lu(k,2421) - lu(k,571) * lu(k,2353) + lu(k,2423) = lu(k,2423) - lu(k,572) * lu(k,2353) + lu(k,2460) = lu(k,2460) - lu(k,568) * lu(k,2456) + lu(k,2484) = lu(k,2484) - lu(k,569) * lu(k,2456) + lu(k,2490) = lu(k,2490) - lu(k,570) * lu(k,2456) + lu(k,2492) = lu(k,2492) - lu(k,571) * lu(k,2456) + lu(k,2494) = lu(k,2494) - lu(k,572) * lu(k,2456) + lu(k,573) = 1._r8 / lu(k,573) + lu(k,574) = lu(k,574) * lu(k,573) + lu(k,575) = lu(k,575) * lu(k,573) + lu(k,576) = lu(k,576) * lu(k,573) + lu(k,577) = lu(k,577) * lu(k,573) + lu(k,742) = lu(k,742) - lu(k,574) * lu(k,736) + lu(k,743) = lu(k,743) - lu(k,575) * lu(k,736) + lu(k,745) = - lu(k,576) * lu(k,736) + lu(k,746) = - lu(k,577) * lu(k,736) + lu(k,889) = lu(k,889) - lu(k,574) * lu(k,886) + lu(k,890) = - lu(k,575) * lu(k,886) + lu(k,892) = - lu(k,576) * lu(k,886) + lu(k,893) = - lu(k,577) * lu(k,886) + lu(k,908) = lu(k,908) - lu(k,574) * lu(k,902) + lu(k,911) = - lu(k,575) * lu(k,902) + lu(k,913) = lu(k,913) - lu(k,576) * lu(k,902) + lu(k,914) = - lu(k,577) * lu(k,902) + lu(k,1578) = lu(k,1578) - lu(k,574) * lu(k,1570) + lu(k,1584) = lu(k,1584) - lu(k,575) * lu(k,1570) + lu(k,1590) = lu(k,1590) - lu(k,576) * lu(k,1570) + lu(k,1593) = lu(k,1593) - lu(k,577) * lu(k,1570) + lu(k,1933) = lu(k,1933) - lu(k,574) * lu(k,1920) + lu(k,1941) = lu(k,1941) - lu(k,575) * lu(k,1920) + lu(k,1950) = - lu(k,576) * lu(k,1920) + lu(k,1953) = lu(k,1953) - lu(k,577) * lu(k,1920) + 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,1850) = lu(k,1850) - lu(k,579) * lu(k,1824) + lu(k,1859) = lu(k,1859) - lu(k,580) * lu(k,1824) + lu(k,1877) = lu(k,1877) - lu(k,581) * lu(k,1824) + lu(k,1904) = lu(k,1904) - lu(k,582) * lu(k,1824) + lu(k,1908) = lu(k,1908) - lu(k,583) * lu(k,1824) + lu(k,1912) = lu(k,1912) - lu(k,584) * lu(k,1824) + lu(k,1913) = lu(k,1913) - lu(k,585) * lu(k,1824) + lu(k,1969) = - lu(k,579) * lu(k,1966) + lu(k,1972) = lu(k,1972) - lu(k,580) * lu(k,1966) + lu(k,1978) = lu(k,1978) - lu(k,581) * lu(k,1966) + lu(k,1993) = lu(k,1993) - lu(k,582) * lu(k,1966) + lu(k,1997) = lu(k,1997) - lu(k,583) * lu(k,1966) + lu(k,2001) = lu(k,2001) - lu(k,584) * lu(k,1966) + lu(k,2002) = lu(k,2002) - lu(k,585) * lu(k,1966) + lu(k,2062) = - lu(k,579) * lu(k,2058) + lu(k,2064) = lu(k,2064) - lu(k,580) * lu(k,2058) + lu(k,2077) = lu(k,2077) - lu(k,581) * lu(k,2058) + lu(k,2100) = lu(k,2100) - lu(k,582) * lu(k,2058) + lu(k,2104) = lu(k,2104) - lu(k,583) * lu(k,2058) + lu(k,2108) = lu(k,2108) - lu(k,584) * lu(k,2058) + lu(k,2109) = lu(k,2109) - lu(k,585) * lu(k,2058) + 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,586) = 1._r8 / lu(k,586) + lu(k,587) = lu(k,587) * lu(k,586) + lu(k,588) = lu(k,588) * lu(k,586) + lu(k,589) = lu(k,589) * lu(k,586) + lu(k,590) = lu(k,590) * lu(k,586) + lu(k,591) = lu(k,591) * lu(k,586) + lu(k,592) = lu(k,592) * lu(k,586) + lu(k,593) = lu(k,593) * lu(k,586) + lu(k,1601) = lu(k,1601) - lu(k,587) * lu(k,1600) + lu(k,1605) = lu(k,1605) - lu(k,588) * lu(k,1600) + lu(k,1607) = lu(k,1607) - lu(k,589) * lu(k,1600) + lu(k,1608) = - lu(k,590) * lu(k,1600) + lu(k,1611) = lu(k,1611) - lu(k,591) * lu(k,1600) + lu(k,1617) = - lu(k,592) * lu(k,1600) + lu(k,1620) = lu(k,1620) - lu(k,593) * lu(k,1600) + lu(k,1925) = lu(k,1925) - lu(k,587) * lu(k,1921) + lu(k,1940) = lu(k,1940) - lu(k,588) * lu(k,1921) + lu(k,1942) = lu(k,1942) - lu(k,589) * lu(k,1921) + lu(k,1945) = - lu(k,590) * lu(k,1921) + lu(k,1948) = lu(k,1948) - lu(k,591) * lu(k,1921) + lu(k,1954) = lu(k,1954) - lu(k,592) * lu(k,1921) + lu(k,1957) = lu(k,1957) - lu(k,593) * lu(k,1921) + lu(k,2463) = - lu(k,587) * lu(k,2457) + lu(k,2477) = - lu(k,588) * lu(k,2457) + lu(k,2479) = lu(k,2479) - lu(k,589) * lu(k,2457) + lu(k,2482) = lu(k,2482) - lu(k,590) * lu(k,2457) + lu(k,2485) = lu(k,2485) - lu(k,591) * lu(k,2457) + lu(k,2491) = lu(k,2491) - lu(k,592) * lu(k,2457) + lu(k,2494) = lu(k,2494) - lu(k,593) * lu(k,2457) + lu(k,594) = 1._r8 / lu(k,594) + lu(k,595) = lu(k,595) * lu(k,594) + lu(k,596) = lu(k,596) * lu(k,594) + lu(k,597) = lu(k,597) * lu(k,594) + lu(k,598) = lu(k,598) * lu(k,594) + lu(k,599) = lu(k,599) * lu(k,594) + lu(k,600) = lu(k,600) * lu(k,594) + lu(k,601) = lu(k,601) * lu(k,594) + lu(k,860) = lu(k,860) - lu(k,595) * lu(k,859) + lu(k,861) = lu(k,861) - lu(k,596) * lu(k,859) + lu(k,862) = - lu(k,597) * lu(k,859) + lu(k,864) = - lu(k,598) * lu(k,859) + lu(k,866) = lu(k,866) - lu(k,599) * lu(k,859) + lu(k,867) = lu(k,867) - lu(k,600) * lu(k,859) + lu(k,869) = - lu(k,601) * lu(k,859) + lu(k,1852) = lu(k,1852) - lu(k,595) * lu(k,1825) + lu(k,1876) = lu(k,1876) - lu(k,596) * lu(k,1825) + lu(k,1881) = lu(k,1881) - lu(k,597) * lu(k,1825) + lu(k,1904) = lu(k,1904) - lu(k,598) * lu(k,1825) + lu(k,1912) = lu(k,1912) - lu(k,599) * lu(k,1825) + lu(k,1913) = lu(k,1913) - lu(k,600) * lu(k,1825) + lu(k,1915) = lu(k,1915) - lu(k,601) * lu(k,1825) + lu(k,2372) = lu(k,2372) - lu(k,595) * lu(k,2354) + lu(k,2387) = lu(k,2387) - lu(k,596) * lu(k,2354) + lu(k,2391) = - lu(k,597) * lu(k,2354) + lu(k,2413) = lu(k,2413) - lu(k,598) * lu(k,2354) + lu(k,2421) = lu(k,2421) - lu(k,599) * lu(k,2354) + lu(k,2422) = lu(k,2422) - lu(k,600) * lu(k,2354) + lu(k,2424) = lu(k,2424) - lu(k,601) * lu(k,2354) + 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,1470) = lu(k,1470) - lu(k,603) * lu(k,1453) + lu(k,1471) = lu(k,1471) - lu(k,604) * lu(k,1453) + lu(k,1474) = lu(k,1474) - lu(k,605) * lu(k,1453) + lu(k,1476) = lu(k,1476) - lu(k,606) * lu(k,1453) + lu(k,1479) = - lu(k,607) * lu(k,1453) + lu(k,1481) = lu(k,1481) - lu(k,608) * lu(k,1453) + lu(k,1482) = lu(k,1482) - lu(k,609) * lu(k,1453) + lu(k,1892) = lu(k,1892) - lu(k,603) * lu(k,1826) + lu(k,1893) = lu(k,1893) - lu(k,604) * lu(k,1826) + lu(k,1901) = lu(k,1901) - lu(k,605) * lu(k,1826) + lu(k,1904) = lu(k,1904) - lu(k,606) * lu(k,1826) + lu(k,1911) = lu(k,1911) - lu(k,607) * lu(k,1826) + lu(k,1913) = lu(k,1913) - lu(k,608) * lu(k,1826) + lu(k,1914) = lu(k,1914) - lu(k,609) * lu(k,1826) + lu(k,2473) = lu(k,2473) - lu(k,603) * lu(k,2458) + lu(k,2474) = - lu(k,604) * lu(k,2458) + lu(k,2481) = - lu(k,605) * lu(k,2458) + lu(k,2484) = lu(k,2484) - lu(k,606) * lu(k,2458) + lu(k,2491) = lu(k,2491) - lu(k,607) * lu(k,2458) + lu(k,2493) = - lu(k,608) * lu(k,2458) + lu(k,2494) = lu(k,2494) - lu(k,609) * lu(k,2458) + lu(k,610) = 1._r8 / lu(k,610) + lu(k,611) = lu(k,611) * lu(k,610) + lu(k,612) = lu(k,612) * lu(k,610) + lu(k,613) = lu(k,613) * lu(k,610) + lu(k,614) = lu(k,614) * lu(k,610) + lu(k,615) = lu(k,615) * lu(k,610) + lu(k,616) = lu(k,616) * lu(k,610) + lu(k,617) = lu(k,617) * lu(k,610) + lu(k,1363) = - lu(k,611) * lu(k,1359) + lu(k,1367) = lu(k,1367) - lu(k,612) * lu(k,1359) + lu(k,1368) = - lu(k,613) * lu(k,1359) + lu(k,1369) = lu(k,1369) - lu(k,614) * lu(k,1359) + lu(k,1381) = - lu(k,615) * lu(k,1359) + lu(k,1382) = lu(k,1382) - lu(k,616) * lu(k,1359) + lu(k,1386) = lu(k,1386) - lu(k,617) * lu(k,1359) + lu(k,1855) = lu(k,1855) - lu(k,611) * lu(k,1827) + lu(k,1878) = lu(k,1878) - lu(k,612) * lu(k,1827) + lu(k,1880) = lu(k,1880) - lu(k,613) * lu(k,1827) + lu(k,1881) = lu(k,1881) - lu(k,614) * lu(k,1827) + lu(k,1902) = lu(k,1902) - lu(k,615) * lu(k,1827) + lu(k,1904) = lu(k,1904) - lu(k,616) * lu(k,1827) + lu(k,1912) = lu(k,1912) - lu(k,617) * lu(k,1827) + lu(k,2194) = - lu(k,611) * lu(k,2177) + lu(k,2210) = lu(k,2210) - lu(k,612) * lu(k,2177) + lu(k,2212) = lu(k,2212) - lu(k,613) * lu(k,2177) + lu(k,2213) = lu(k,2213) - lu(k,614) * lu(k,2177) + lu(k,2231) = lu(k,2231) - lu(k,615) * lu(k,2177) + lu(k,2233) = lu(k,2233) - lu(k,616) * lu(k,2177) + lu(k,2241) = lu(k,2241) - lu(k,617) * lu(k,2177) + lu(k,618) = 1._r8 / lu(k,618) + lu(k,619) = lu(k,619) * lu(k,618) + lu(k,620) = lu(k,620) * lu(k,618) + lu(k,621) = lu(k,621) * lu(k,618) + lu(k,622) = lu(k,622) * lu(k,618) + lu(k,623) = lu(k,623) * lu(k,618) + lu(k,624) = lu(k,624) * lu(k,618) + lu(k,625) = lu(k,625) * lu(k,618) + lu(k,1870) = lu(k,1870) - lu(k,619) * lu(k,1828) + lu(k,1876) = lu(k,1876) - lu(k,620) * lu(k,1828) + lu(k,1880) = lu(k,1880) - lu(k,621) * lu(k,1828) + lu(k,1910) = lu(k,1910) - lu(k,622) * lu(k,1828) + lu(k,1912) = lu(k,1912) - lu(k,623) * lu(k,1828) + lu(k,1913) = lu(k,1913) - lu(k,624) * lu(k,1828) + lu(k,1914) = lu(k,1914) - lu(k,625) * lu(k,1828) + lu(k,2204) = lu(k,2204) - lu(k,619) * lu(k,2178) + lu(k,2208) = lu(k,2208) - lu(k,620) * lu(k,2178) + lu(k,2212) = lu(k,2212) - lu(k,621) * lu(k,2178) + lu(k,2239) = lu(k,2239) - lu(k,622) * lu(k,2178) + lu(k,2241) = lu(k,2241) - lu(k,623) * lu(k,2178) + lu(k,2242) = lu(k,2242) - lu(k,624) * lu(k,2178) + lu(k,2243) = lu(k,2243) - lu(k,625) * lu(k,2178) + lu(k,2262) = lu(k,2262) - lu(k,619) * lu(k,2251) + lu(k,2267) = lu(k,2267) - lu(k,620) * lu(k,2251) + lu(k,2271) = - lu(k,621) * lu(k,2251) + lu(k,2299) = lu(k,2299) - lu(k,622) * lu(k,2251) + lu(k,2301) = lu(k,2301) - lu(k,623) * lu(k,2251) + lu(k,2302) = lu(k,2302) - lu(k,624) * lu(k,2251) + lu(k,2303) = lu(k,2303) - lu(k,625) * lu(k,2251) + 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,1896) = lu(k,1896) - lu(k,627) * lu(k,1829) + lu(k,1897) = lu(k,1897) - lu(k,628) * lu(k,1829) + lu(k,1901) = lu(k,1901) - lu(k,629) * lu(k,1829) + lu(k,1904) = lu(k,1904) - lu(k,630) * lu(k,1829) + lu(k,1906) = lu(k,1906) - lu(k,631) * lu(k,1829) + lu(k,1907) = lu(k,1907) - lu(k,632) * lu(k,1829) + lu(k,1912) = lu(k,1912) - lu(k,633) * lu(k,1829) + lu(k,1915) = lu(k,1915) - lu(k,634) * lu(k,1829) + lu(k,1985) = lu(k,1985) - lu(k,627) * lu(k,1967) + lu(k,1986) = lu(k,1986) - lu(k,628) * lu(k,1967) + lu(k,1990) = lu(k,1990) - lu(k,629) * lu(k,1967) + lu(k,1993) = lu(k,1993) - lu(k,630) * lu(k,1967) + lu(k,1995) = lu(k,1995) - lu(k,631) * lu(k,1967) + lu(k,1996) = lu(k,1996) - lu(k,632) * lu(k,1967) + lu(k,2001) = lu(k,2001) - lu(k,633) * lu(k,1967) + lu(k,2004) = lu(k,2004) - lu(k,634) * lu(k,1967) + lu(k,2028) = lu(k,2028) - lu(k,627) * lu(k,2024) + lu(k,2029) = lu(k,2029) - lu(k,628) * lu(k,2024) + lu(k,2033) = lu(k,2033) - lu(k,629) * lu(k,2024) + lu(k,2036) = lu(k,2036) - lu(k,630) * lu(k,2024) + lu(k,2038) = lu(k,2038) - lu(k,631) * lu(k,2024) + lu(k,2039) = lu(k,2039) - lu(k,632) * lu(k,2024) + lu(k,2044) = lu(k,2044) - lu(k,633) * lu(k,2024) + lu(k,2047) = lu(k,2047) - lu(k,634) * lu(k,2024) + lu(k,635) = 1._r8 / lu(k,635) + lu(k,636) = lu(k,636) * lu(k,635) + lu(k,637) = lu(k,637) * lu(k,635) + lu(k,638) = lu(k,638) * lu(k,635) + lu(k,639) = lu(k,639) * lu(k,635) + lu(k,640) = lu(k,640) * lu(k,635) + lu(k,641) = lu(k,641) * lu(k,635) + lu(k,1440) = lu(k,1440) - lu(k,636) * lu(k,1434) + lu(k,1441) = lu(k,1441) - lu(k,637) * lu(k,1434) + lu(k,1442) = lu(k,1442) - lu(k,638) * lu(k,1434) + lu(k,1444) = lu(k,1444) - lu(k,639) * lu(k,1434) + lu(k,1449) = lu(k,1449) - lu(k,640) * lu(k,1434) + lu(k,1451) = - lu(k,641) * lu(k,1434) + lu(k,1470) = lu(k,1470) - lu(k,636) * lu(k,1454) + lu(k,1471) = lu(k,1471) - lu(k,637) * lu(k,1454) + lu(k,1474) = lu(k,1474) - lu(k,638) * lu(k,1454) + lu(k,1476) = lu(k,1476) - lu(k,639) * lu(k,1454) + lu(k,1481) = lu(k,1481) - lu(k,640) * lu(k,1454) + lu(k,1483) = - lu(k,641) * lu(k,1454) + lu(k,1892) = lu(k,1892) - lu(k,636) * lu(k,1830) + lu(k,1893) = lu(k,1893) - lu(k,637) * lu(k,1830) + lu(k,1901) = lu(k,1901) - lu(k,638) * lu(k,1830) + lu(k,1904) = lu(k,1904) - lu(k,639) * lu(k,1830) + lu(k,1913) = lu(k,1913) - lu(k,640) * lu(k,1830) + lu(k,1915) = lu(k,1915) - lu(k,641) * lu(k,1830) + lu(k,2402) = lu(k,2402) - lu(k,636) * lu(k,2355) + lu(k,2403) = lu(k,2403) - lu(k,637) * lu(k,2355) + lu(k,2410) = lu(k,2410) - lu(k,638) * lu(k,2355) + lu(k,2413) = lu(k,2413) - lu(k,639) * lu(k,2355) + lu(k,2422) = lu(k,2422) - lu(k,640) * lu(k,2355) + lu(k,2424) = lu(k,2424) - lu(k,641) * lu(k,2355) + lu(k,642) = 1._r8 / lu(k,642) + lu(k,643) = lu(k,643) * lu(k,642) + lu(k,644) = lu(k,644) * lu(k,642) + lu(k,645) = lu(k,645) * lu(k,642) + lu(k,646) = lu(k,646) * lu(k,642) + lu(k,647) = lu(k,647) * lu(k,642) + lu(k,648) = lu(k,648) * lu(k,642) + lu(k,649) = lu(k,649) * lu(k,642) + lu(k,650) = lu(k,650) * lu(k,642) + lu(k,1334) = - lu(k,643) * lu(k,1331) + lu(k,1335) = - lu(k,644) * lu(k,1331) + lu(k,1336) = - lu(k,645) * lu(k,1331) + lu(k,1348) = - lu(k,646) * lu(k,1331) + lu(k,1349) = - lu(k,647) * lu(k,1331) + lu(k,1353) = lu(k,1353) - lu(k,648) * lu(k,1331) + lu(k,1354) = lu(k,1354) - lu(k,649) * lu(k,1331) + lu(k,1355) = lu(k,1355) - lu(k,650) * lu(k,1331) + lu(k,1878) = lu(k,1878) - lu(k,643) * lu(k,1831) + lu(k,1880) = lu(k,1880) - lu(k,644) * lu(k,1831) + lu(k,1881) = lu(k,1881) - lu(k,645) * lu(k,1831) + lu(k,1902) = lu(k,1902) - lu(k,646) * lu(k,1831) + lu(k,1904) = lu(k,1904) - lu(k,647) * lu(k,1831) + lu(k,1912) = lu(k,1912) - lu(k,648) * lu(k,1831) + lu(k,1913) = lu(k,1913) - lu(k,649) * lu(k,1831) + lu(k,1914) = lu(k,1914) - lu(k,650) * lu(k,1831) + lu(k,2210) = lu(k,2210) - lu(k,643) * lu(k,2179) + lu(k,2212) = lu(k,2212) - lu(k,644) * lu(k,2179) + lu(k,2213) = lu(k,2213) - lu(k,645) * lu(k,2179) + lu(k,2231) = lu(k,2231) - lu(k,646) * lu(k,2179) + lu(k,2233) = lu(k,2233) - lu(k,647) * lu(k,2179) + lu(k,2241) = lu(k,2241) - lu(k,648) * lu(k,2179) + lu(k,2242) = lu(k,2242) - lu(k,649) * lu(k,2179) + lu(k,2243) = lu(k,2243) - lu(k,650) * lu(k,2179) + lu(k,653) = 1._r8 / lu(k,653) + lu(k,654) = lu(k,654) * lu(k,653) + lu(k,655) = lu(k,655) * lu(k,653) + lu(k,656) = lu(k,656) * lu(k,653) + lu(k,657) = lu(k,657) * lu(k,653) + lu(k,658) = lu(k,658) * lu(k,653) + lu(k,659) = lu(k,659) * lu(k,653) + lu(k,660) = lu(k,660) * lu(k,653) + lu(k,661) = lu(k,661) * lu(k,653) + lu(k,791) = lu(k,791) - lu(k,654) * lu(k,790) + lu(k,792) = lu(k,792) - lu(k,655) * lu(k,790) + lu(k,793) = lu(k,793) - lu(k,656) * lu(k,790) + lu(k,794) = lu(k,794) - lu(k,657) * lu(k,790) + lu(k,796) = lu(k,796) - lu(k,658) * lu(k,790) + lu(k,798) = lu(k,798) - lu(k,659) * lu(k,790) + lu(k,799) = - lu(k,660) * lu(k,790) + lu(k,801) = lu(k,801) - lu(k,661) * lu(k,790) + lu(k,1835) = lu(k,1835) - lu(k,654) * lu(k,1832) + lu(k,1846) = lu(k,1846) - lu(k,655) * lu(k,1832) + lu(k,1847) = lu(k,1847) - lu(k,656) * lu(k,1832) + lu(k,1849) = - lu(k,657) * lu(k,1832) + lu(k,1867) = lu(k,1867) - lu(k,658) * lu(k,1832) + lu(k,1886) = lu(k,1886) - lu(k,659) * lu(k,1832) + lu(k,1904) = lu(k,1904) - lu(k,660) * lu(k,1832) + lu(k,1912) = lu(k,1912) - lu(k,661) * lu(k,1832) + lu(k,2358) = - lu(k,654) * lu(k,2356) + lu(k,2366) = lu(k,2366) - lu(k,655) * lu(k,2356) + lu(k,2367) = lu(k,2367) - lu(k,656) * lu(k,2356) + lu(k,2369) = lu(k,2369) - lu(k,657) * lu(k,2356) + lu(k,2381) = lu(k,2381) - lu(k,658) * lu(k,2356) + lu(k,2396) = lu(k,2396) - lu(k,659) * lu(k,2356) + lu(k,2413) = lu(k,2413) - lu(k,660) * lu(k,2356) + lu(k,2421) = lu(k,2421) - lu(k,661) * lu(k,2356) + lu(k,662) = 1._r8 / lu(k,662) + lu(k,663) = lu(k,663) * lu(k,662) + lu(k,664) = lu(k,664) * lu(k,662) + lu(k,665) = lu(k,665) * lu(k,662) + lu(k,666) = lu(k,666) * lu(k,662) + lu(k,667) = lu(k,667) * lu(k,662) + lu(k,668) = lu(k,668) * lu(k,662) + lu(k,669) = lu(k,669) * lu(k,662) + lu(k,670) = lu(k,670) * lu(k,662) + lu(k,1437) = - lu(k,663) * lu(k,1435) + lu(k,1439) = lu(k,1439) - lu(k,664) * lu(k,1435) + lu(k,1441) = lu(k,1441) - lu(k,665) * lu(k,1435) + lu(k,1444) = lu(k,1444) - lu(k,666) * lu(k,1435) + lu(k,1447) = lu(k,1447) - lu(k,667) * lu(k,1435) + lu(k,1448) = lu(k,1448) - lu(k,668) * lu(k,1435) + lu(k,1449) = lu(k,1449) - lu(k,669) * lu(k,1435) + lu(k,1450) = lu(k,1450) - lu(k,670) * lu(k,1435) + lu(k,1881) = lu(k,1881) - lu(k,663) * lu(k,1833) + lu(k,1891) = lu(k,1891) - lu(k,664) * lu(k,1833) + lu(k,1893) = lu(k,1893) - lu(k,665) * lu(k,1833) + lu(k,1904) = lu(k,1904) - lu(k,666) * lu(k,1833) + lu(k,1911) = lu(k,1911) - lu(k,667) * lu(k,1833) + lu(k,1912) = lu(k,1912) - lu(k,668) * lu(k,1833) + lu(k,1913) = lu(k,1913) - lu(k,669) * lu(k,1833) + lu(k,1914) = lu(k,1914) - lu(k,670) * lu(k,1833) + lu(k,2470) = - lu(k,663) * lu(k,2459) + lu(k,2472) = lu(k,2472) - lu(k,664) * lu(k,2459) + lu(k,2474) = lu(k,2474) - lu(k,665) * lu(k,2459) + lu(k,2484) = lu(k,2484) - lu(k,666) * lu(k,2459) + lu(k,2491) = lu(k,2491) - lu(k,667) * lu(k,2459) + lu(k,2492) = lu(k,2492) - lu(k,668) * lu(k,2459) + lu(k,2493) = lu(k,2493) - lu(k,669) * lu(k,2459) + lu(k,2494) = lu(k,2494) - lu(k,670) * lu(k,2459) + 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,671) = 1._r8 / lu(k,671) + lu(k,672) = lu(k,672) * lu(k,671) + lu(k,673) = lu(k,673) * lu(k,671) + lu(k,674) = lu(k,674) * lu(k,671) + lu(k,675) = lu(k,675) * lu(k,671) + lu(k,676) = lu(k,676) * lu(k,671) + lu(k,677) = lu(k,677) * lu(k,671) + lu(k,1896) = lu(k,1896) - lu(k,672) * lu(k,1834) + lu(k,1904) = lu(k,1904) - lu(k,673) * lu(k,1834) + lu(k,1905) = lu(k,1905) - lu(k,674) * lu(k,1834) + lu(k,1906) = lu(k,1906) - lu(k,675) * lu(k,1834) + lu(k,1912) = lu(k,1912) - lu(k,676) * lu(k,1834) + lu(k,1915) = lu(k,1915) - lu(k,677) * lu(k,1834) + lu(k,1939) = lu(k,1939) - lu(k,672) * lu(k,1922) + lu(k,1947) = lu(k,1947) - lu(k,673) * lu(k,1922) + lu(k,1948) = lu(k,1948) - lu(k,674) * lu(k,1922) + lu(k,1949) = lu(k,1949) - lu(k,675) * lu(k,1922) + lu(k,1955) = lu(k,1955) - lu(k,676) * lu(k,1922) + lu(k,1958) = - lu(k,677) * lu(k,1922) + lu(k,1985) = lu(k,1985) - lu(k,672) * lu(k,1968) + lu(k,1993) = lu(k,1993) - lu(k,673) * lu(k,1968) + lu(k,1994) = - lu(k,674) * lu(k,1968) + lu(k,1995) = lu(k,1995) - lu(k,675) * lu(k,1968) + lu(k,2001) = lu(k,2001) - lu(k,676) * lu(k,1968) + lu(k,2004) = lu(k,2004) - lu(k,677) * lu(k,1968) + lu(k,2405) = lu(k,2405) - lu(k,672) * lu(k,2357) + lu(k,2413) = lu(k,2413) - lu(k,673) * lu(k,2357) + lu(k,2414) = lu(k,2414) - lu(k,674) * lu(k,2357) + lu(k,2415) = lu(k,2415) - lu(k,675) * lu(k,2357) + lu(k,2421) = lu(k,2421) - lu(k,676) * lu(k,2357) + lu(k,2424) = lu(k,2424) - lu(k,677) * lu(k,2357) + lu(k,678) = 1._r8 / lu(k,678) + lu(k,679) = lu(k,679) * lu(k,678) + lu(k,680) = lu(k,680) * lu(k,678) + lu(k,681) = lu(k,681) * lu(k,678) + lu(k,768) = - lu(k,679) * lu(k,763) + lu(k,770) = lu(k,770) - lu(k,680) * lu(k,763) + lu(k,774) = lu(k,774) - lu(k,681) * lu(k,763) + lu(k,795) = - lu(k,679) * lu(k,791) + lu(k,797) = - lu(k,680) * lu(k,791) + lu(k,801) = lu(k,801) - lu(k,681) * lu(k,791) + lu(k,811) = - lu(k,679) * lu(k,806) + lu(k,813) = lu(k,813) - lu(k,680) * lu(k,806) + lu(k,818) = lu(k,818) - lu(k,681) * lu(k,806) + lu(k,1157) = - lu(k,679) * lu(k,1155) + lu(k,1160) = - lu(k,680) * lu(k,1155) + lu(k,1168) = lu(k,1168) - lu(k,681) * lu(k,1155) + lu(k,1364) = - lu(k,679) * lu(k,1360) + lu(k,1366) = - lu(k,680) * lu(k,1360) + lu(k,1386) = lu(k,1386) - lu(k,681) * lu(k,1360) + lu(k,1860) = - lu(k,679) * lu(k,1835) + lu(k,1877) = lu(k,1877) - lu(k,680) * lu(k,1835) + lu(k,1912) = lu(k,1912) - lu(k,681) * lu(k,1835) + lu(k,2197) = lu(k,2197) - lu(k,679) * lu(k,2180) + lu(k,2209) = lu(k,2209) - lu(k,680) * lu(k,2180) + lu(k,2241) = lu(k,2241) - lu(k,681) * lu(k,2180) + lu(k,2378) = lu(k,2378) - lu(k,679) * lu(k,2358) + lu(k,2388) = lu(k,2388) - lu(k,680) * lu(k,2358) + lu(k,2421) = lu(k,2421) - lu(k,681) * lu(k,2358) + lu(k,682) = 1._r8 / lu(k,682) + lu(k,683) = lu(k,683) * lu(k,682) + lu(k,684) = lu(k,684) * lu(k,682) + lu(k,685) = lu(k,685) * lu(k,682) + lu(k,686) = lu(k,686) * lu(k,682) + lu(k,687) = lu(k,687) * lu(k,682) + lu(k,1093) = lu(k,1093) - lu(k,683) * lu(k,1090) + lu(k,1096) = - lu(k,684) * lu(k,1090) + lu(k,1097) = lu(k,1097) - lu(k,685) * lu(k,1090) + lu(k,1099) = lu(k,1099) - lu(k,686) * lu(k,1090) + lu(k,1101) = lu(k,1101) - lu(k,687) * lu(k,1090) + lu(k,1131) = lu(k,1131) - lu(k,683) * lu(k,1129) + lu(k,1137) = lu(k,1137) - lu(k,684) * lu(k,1129) + lu(k,1138) = lu(k,1138) - lu(k,685) * lu(k,1129) + lu(k,1141) = lu(k,1141) - lu(k,686) * lu(k,1129) + lu(k,1143) = lu(k,1143) - lu(k,687) * lu(k,1129) + lu(k,1659) = lu(k,1659) - lu(k,683) * lu(k,1651) + lu(k,1685) = lu(k,1685) - lu(k,684) * lu(k,1651) + lu(k,1687) = lu(k,1687) - lu(k,685) * lu(k,1651) + lu(k,1695) = lu(k,1695) - lu(k,686) * lu(k,1651) + lu(k,1697) = lu(k,1697) - lu(k,687) * lu(k,1651) + lu(k,1869) = lu(k,1869) - lu(k,683) * lu(k,1836) + lu(k,1902) = lu(k,1902) - lu(k,684) * lu(k,1836) + lu(k,1904) = lu(k,1904) - lu(k,685) * lu(k,1836) + lu(k,1912) = lu(k,1912) - lu(k,686) * lu(k,1836) + lu(k,1914) = lu(k,1914) - lu(k,687) * lu(k,1836) + lu(k,2203) = lu(k,2203) - lu(k,683) * lu(k,2181) + lu(k,2231) = lu(k,2231) - lu(k,684) * lu(k,2181) + lu(k,2233) = lu(k,2233) - lu(k,685) * lu(k,2181) + lu(k,2241) = lu(k,2241) - lu(k,686) * lu(k,2181) + lu(k,2243) = lu(k,2243) - lu(k,687) * lu(k,2181) + lu(k,690) = 1._r8 / lu(k,690) + lu(k,691) = lu(k,691) * lu(k,690) + lu(k,692) = lu(k,692) * lu(k,690) + lu(k,693) = lu(k,693) * lu(k,690) + lu(k,694) = lu(k,694) * lu(k,690) + lu(k,695) = lu(k,695) * lu(k,690) + lu(k,1904) = lu(k,1904) - lu(k,691) * lu(k,1837) + lu(k,1908) = lu(k,1908) - lu(k,692) * lu(k,1837) + lu(k,1910) = lu(k,1910) - lu(k,693) * lu(k,1837) + lu(k,1912) = lu(k,1912) - lu(k,694) * lu(k,1837) + lu(k,1914) = lu(k,1914) - lu(k,695) * lu(k,1837) + lu(k,2100) = lu(k,2100) - lu(k,691) * lu(k,2059) + lu(k,2104) = lu(k,2104) - lu(k,692) * lu(k,2059) + lu(k,2106) = lu(k,2106) - lu(k,693) * lu(k,2059) + lu(k,2108) = lu(k,2108) - lu(k,694) * lu(k,2059) + lu(k,2110) = lu(k,2110) - lu(k,695) * lu(k,2059) + lu(k,2233) = lu(k,2233) - lu(k,691) * lu(k,2182) + lu(k,2237) = lu(k,2237) - lu(k,692) * lu(k,2182) + lu(k,2239) = lu(k,2239) - lu(k,693) * lu(k,2182) + lu(k,2241) = lu(k,2241) - lu(k,694) * lu(k,2182) + lu(k,2243) = lu(k,2243) - lu(k,695) * lu(k,2182) + lu(k,2413) = lu(k,2413) - lu(k,691) * lu(k,2359) + lu(k,2417) = lu(k,2417) - lu(k,692) * lu(k,2359) + lu(k,2419) = lu(k,2419) - lu(k,693) * lu(k,2359) + lu(k,2421) = lu(k,2421) - lu(k,694) * lu(k,2359) + lu(k,2423) = lu(k,2423) - lu(k,695) * lu(k,2359) + lu(k,2484) = lu(k,2484) - lu(k,691) * lu(k,2460) + lu(k,2488) = lu(k,2488) - lu(k,692) * lu(k,2460) + lu(k,2490) = lu(k,2490) - lu(k,693) * lu(k,2460) + lu(k,2492) = lu(k,2492) - lu(k,694) * lu(k,2460) + lu(k,2494) = lu(k,2494) - lu(k,695) * lu(k,2460) + lu(k,697) = 1._r8 / lu(k,697) + lu(k,698) = lu(k,698) * lu(k,697) + lu(k,699) = lu(k,699) * lu(k,697) + lu(k,700) = lu(k,700) * lu(k,697) + lu(k,701) = lu(k,701) * lu(k,697) + lu(k,702) = lu(k,702) * lu(k,697) + lu(k,703) = lu(k,703) * lu(k,697) + lu(k,704) = lu(k,704) * lu(k,697) + lu(k,705) = lu(k,705) * lu(k,697) + lu(k,706) = lu(k,706) * lu(k,697) + lu(k,1070) = lu(k,1070) - lu(k,698) * lu(k,1068) + lu(k,1071) = lu(k,1071) - lu(k,699) * lu(k,1068) + lu(k,1072) = lu(k,1072) - lu(k,700) * lu(k,1068) + lu(k,1073) = lu(k,1073) - lu(k,701) * lu(k,1068) + lu(k,1074) = lu(k,1074) - lu(k,702) * lu(k,1068) + lu(k,1075) = lu(k,1075) - lu(k,703) * lu(k,1068) + lu(k,1078) = lu(k,1078) - lu(k,704) * lu(k,1068) + lu(k,1080) = lu(k,1080) - lu(k,705) * lu(k,1068) + lu(k,1081) = lu(k,1081) - lu(k,706) * lu(k,1068) + lu(k,1840) = lu(k,1840) - lu(k,698) * lu(k,1838) + lu(k,1858) = lu(k,1858) - lu(k,699) * lu(k,1838) + lu(k,1866) = lu(k,1866) - lu(k,700) * lu(k,1838) + lu(k,1870) = lu(k,1870) - lu(k,701) * lu(k,1838) + lu(k,1876) = lu(k,1876) - lu(k,702) * lu(k,1838) + lu(k,1892) = lu(k,1892) - lu(k,703) * lu(k,1838) + lu(k,1904) = lu(k,1904) - lu(k,704) * lu(k,1838) + lu(k,1912) = lu(k,1912) - lu(k,705) * lu(k,1838) + lu(k,1913) = lu(k,1913) - lu(k,706) * lu(k,1838) + lu(k,2361) = lu(k,2361) - lu(k,698) * lu(k,2360) + lu(k,2376) = lu(k,2376) - lu(k,699) * lu(k,2360) + lu(k,2380) = lu(k,2380) - lu(k,700) * lu(k,2360) + lu(k,2384) = lu(k,2384) - lu(k,701) * lu(k,2360) + lu(k,2387) = lu(k,2387) - lu(k,702) * lu(k,2360) + lu(k,2402) = lu(k,2402) - lu(k,703) * lu(k,2360) + lu(k,2413) = lu(k,2413) - lu(k,704) * lu(k,2360) + lu(k,2421) = lu(k,2421) - lu(k,705) * lu(k,2360) + lu(k,2422) = lu(k,2422) - lu(k,706) * lu(k,2360) + lu(k,708) = 1._r8 / lu(k,708) + lu(k,709) = lu(k,709) * lu(k,708) + lu(k,710) = lu(k,710) * lu(k,708) + lu(k,711) = lu(k,711) * lu(k,708) + lu(k,712) = lu(k,712) * lu(k,708) + lu(k,713) = lu(k,713) * lu(k,708) + lu(k,714) = lu(k,714) * lu(k,708) + lu(k,715) = lu(k,715) * lu(k,708) + lu(k,716) = lu(k,716) * lu(k,708) + lu(k,717) = lu(k,717) * lu(k,708) + lu(k,1070) = lu(k,1070) - lu(k,709) * lu(k,1069) + lu(k,1071) = lu(k,1071) - lu(k,710) * lu(k,1069) + lu(k,1073) = lu(k,1073) - lu(k,711) * lu(k,1069) + lu(k,1074) = lu(k,1074) - lu(k,712) * lu(k,1069) + lu(k,1075) = lu(k,1075) - lu(k,713) * lu(k,1069) + lu(k,1078) = lu(k,1078) - lu(k,714) * lu(k,1069) + lu(k,1080) = lu(k,1080) - lu(k,715) * lu(k,1069) + lu(k,1081) = lu(k,1081) - lu(k,716) * lu(k,1069) + lu(k,1082) = lu(k,1082) - lu(k,717) * lu(k,1069) + lu(k,1840) = lu(k,1840) - lu(k,709) * lu(k,1839) + lu(k,1858) = lu(k,1858) - lu(k,710) * lu(k,1839) + lu(k,1870) = lu(k,1870) - lu(k,711) * lu(k,1839) + lu(k,1876) = lu(k,1876) - lu(k,712) * lu(k,1839) + lu(k,1892) = lu(k,1892) - lu(k,713) * lu(k,1839) + lu(k,1904) = lu(k,1904) - lu(k,714) * lu(k,1839) + lu(k,1912) = lu(k,1912) - lu(k,715) * lu(k,1839) + lu(k,1913) = lu(k,1913) - lu(k,716) * lu(k,1839) + lu(k,1914) = lu(k,1914) - lu(k,717) * lu(k,1839) + lu(k,2184) = lu(k,2184) - lu(k,709) * lu(k,2183) + lu(k,2195) = lu(k,2195) - lu(k,710) * lu(k,2183) + lu(k,2204) = lu(k,2204) - lu(k,711) * lu(k,2183) + lu(k,2208) = lu(k,2208) - lu(k,712) * lu(k,2183) + lu(k,2224) = lu(k,2224) - lu(k,713) * lu(k,2183) + lu(k,2233) = lu(k,2233) - lu(k,714) * lu(k,2183) + lu(k,2241) = lu(k,2241) - lu(k,715) * lu(k,2183) + lu(k,2242) = lu(k,2242) - lu(k,716) * lu(k,2183) + lu(k,2243) = lu(k,2243) - lu(k,717) * lu(k,2183) + 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,719) = 1._r8 / lu(k,719) + lu(k,720) = lu(k,720) * lu(k,719) + lu(k,721) = lu(k,721) * lu(k,719) + lu(k,722) = lu(k,722) * lu(k,719) + lu(k,723) = lu(k,723) * lu(k,719) + lu(k,724) = lu(k,724) * lu(k,719) + lu(k,725) = lu(k,725) * lu(k,719) + lu(k,1074) = lu(k,1074) - lu(k,720) * lu(k,1070) + lu(k,1075) = lu(k,1075) - lu(k,721) * lu(k,1070) + lu(k,1078) = lu(k,1078) - lu(k,722) * lu(k,1070) + lu(k,1079) = lu(k,1079) - lu(k,723) * lu(k,1070) + lu(k,1080) = lu(k,1080) - lu(k,724) * lu(k,1070) + lu(k,1082) = lu(k,1082) - lu(k,725) * lu(k,1070) + lu(k,1876) = lu(k,1876) - lu(k,720) * lu(k,1840) + lu(k,1892) = lu(k,1892) - lu(k,721) * lu(k,1840) + lu(k,1904) = lu(k,1904) - lu(k,722) * lu(k,1840) + lu(k,1910) = lu(k,1910) - lu(k,723) * lu(k,1840) + lu(k,1912) = lu(k,1912) - lu(k,724) * lu(k,1840) + lu(k,1914) = lu(k,1914) - lu(k,725) * lu(k,1840) + lu(k,2208) = lu(k,2208) - lu(k,720) * lu(k,2184) + lu(k,2224) = lu(k,2224) - lu(k,721) * lu(k,2184) + lu(k,2233) = lu(k,2233) - lu(k,722) * lu(k,2184) + lu(k,2239) = lu(k,2239) - lu(k,723) * lu(k,2184) + lu(k,2241) = lu(k,2241) - lu(k,724) * lu(k,2184) + lu(k,2243) = lu(k,2243) - lu(k,725) * lu(k,2184) + lu(k,2387) = lu(k,2387) - lu(k,720) * lu(k,2361) + lu(k,2402) = lu(k,2402) - lu(k,721) * lu(k,2361) + lu(k,2413) = lu(k,2413) - lu(k,722) * lu(k,2361) + lu(k,2419) = lu(k,2419) - lu(k,723) * lu(k,2361) + lu(k,2421) = lu(k,2421) - lu(k,724) * lu(k,2361) + lu(k,2423) = lu(k,2423) - lu(k,725) * lu(k,2361) + lu(k,726) = 1._r8 / lu(k,726) + lu(k,727) = lu(k,727) * lu(k,726) + lu(k,728) = lu(k,728) * lu(k,726) + lu(k,729) = lu(k,729) * lu(k,726) + lu(k,730) = lu(k,730) * lu(k,726) + lu(k,731) = lu(k,731) * lu(k,726) + lu(k,732) = lu(k,732) * lu(k,726) + lu(k,733) = lu(k,733) * lu(k,726) + lu(k,734) = lu(k,734) * lu(k,726) + lu(k,735) = lu(k,735) * lu(k,726) + lu(k,1216) = lu(k,1216) - lu(k,727) * lu(k,1214) + lu(k,1217) = lu(k,1217) - lu(k,728) * lu(k,1214) + lu(k,1218) = lu(k,1218) - lu(k,729) * lu(k,1214) + lu(k,1219) = lu(k,1219) - lu(k,730) * lu(k,1214) + lu(k,1220) = lu(k,1220) - lu(k,731) * lu(k,1214) + lu(k,1223) = lu(k,1223) - lu(k,732) * lu(k,1214) + lu(k,1226) = - lu(k,733) * lu(k,1214) + lu(k,1228) = lu(k,1228) - lu(k,734) * lu(k,1214) + lu(k,1229) = lu(k,1229) - lu(k,735) * lu(k,1214) + lu(k,1870) = lu(k,1870) - lu(k,727) * lu(k,1841) + lu(k,1873) = lu(k,1873) - lu(k,728) * lu(k,1841) + lu(k,1877) = lu(k,1877) - lu(k,729) * lu(k,1841) + lu(k,1878) = lu(k,1878) - lu(k,730) * lu(k,1841) + lu(k,1879) = lu(k,1879) - lu(k,731) * lu(k,1841) + lu(k,1893) = lu(k,1893) - lu(k,732) * lu(k,1841) + lu(k,1904) = lu(k,1904) - lu(k,733) * lu(k,1841) + lu(k,1912) = lu(k,1912) - lu(k,734) * lu(k,1841) + lu(k,1913) = lu(k,1913) - lu(k,735) * lu(k,1841) + lu(k,2384) = lu(k,2384) - lu(k,727) * lu(k,2362) + lu(k,2386) = - lu(k,728) * lu(k,2362) + lu(k,2388) = lu(k,2388) - lu(k,729) * lu(k,2362) + lu(k,2389) = lu(k,2389) - lu(k,730) * lu(k,2362) + lu(k,2390) = lu(k,2390) - lu(k,731) * lu(k,2362) + lu(k,2403) = lu(k,2403) - lu(k,732) * lu(k,2362) + lu(k,2413) = lu(k,2413) - lu(k,733) * lu(k,2362) + lu(k,2421) = lu(k,2421) - lu(k,734) * lu(k,2362) + lu(k,2422) = lu(k,2422) - lu(k,735) * lu(k,2362) + lu(k,737) = 1._r8 / lu(k,737) + lu(k,738) = lu(k,738) * lu(k,737) + lu(k,739) = lu(k,739) * lu(k,737) + lu(k,740) = lu(k,740) * lu(k,737) + lu(k,741) = lu(k,741) * lu(k,737) + lu(k,742) = lu(k,742) * lu(k,737) + lu(k,743) = lu(k,743) * lu(k,737) + lu(k,744) = lu(k,744) * lu(k,737) + lu(k,745) = lu(k,745) * lu(k,737) + lu(k,746) = lu(k,746) * lu(k,737) + lu(k,904) = - lu(k,738) * lu(k,903) + lu(k,905) = lu(k,905) - lu(k,739) * lu(k,903) + lu(k,906) = lu(k,906) - lu(k,740) * lu(k,903) + lu(k,907) = lu(k,907) - lu(k,741) * lu(k,903) + lu(k,908) = lu(k,908) - lu(k,742) * lu(k,903) + lu(k,911) = lu(k,911) - lu(k,743) * lu(k,903) + lu(k,912) = lu(k,912) - lu(k,744) * lu(k,903) + lu(k,913) = lu(k,913) - lu(k,745) * lu(k,903) + lu(k,914) = lu(k,914) - lu(k,746) * lu(k,903) + lu(k,1573) = lu(k,1573) - lu(k,738) * lu(k,1571) + lu(k,1574) = lu(k,1574) - lu(k,739) * lu(k,1571) + lu(k,1575) = lu(k,1575) - lu(k,740) * lu(k,1571) + lu(k,1576) = lu(k,1576) - lu(k,741) * lu(k,1571) + lu(k,1578) = lu(k,1578) - lu(k,742) * lu(k,1571) + lu(k,1584) = lu(k,1584) - lu(k,743) * lu(k,1571) + lu(k,1588) = lu(k,1588) - lu(k,744) * lu(k,1571) + lu(k,1590) = lu(k,1590) - lu(k,745) * lu(k,1571) + lu(k,1593) = lu(k,1593) - lu(k,746) * lu(k,1571) + lu(k,1926) = lu(k,1926) - lu(k,738) * lu(k,1923) + lu(k,1929) = lu(k,1929) - lu(k,739) * lu(k,1923) + lu(k,1930) = lu(k,1930) - lu(k,740) * lu(k,1923) + lu(k,1931) = lu(k,1931) - lu(k,741) * lu(k,1923) + lu(k,1933) = lu(k,1933) - lu(k,742) * lu(k,1923) + lu(k,1941) = lu(k,1941) - lu(k,743) * lu(k,1923) + lu(k,1948) = lu(k,1948) - lu(k,744) * lu(k,1923) + lu(k,1950) = lu(k,1950) - lu(k,745) * lu(k,1923) + lu(k,1953) = lu(k,1953) - lu(k,746) * lu(k,1923) + lu(k,747) = 1._r8 / lu(k,747) + lu(k,748) = lu(k,748) * lu(k,747) + lu(k,749) = lu(k,749) * lu(k,747) + lu(k,750) = lu(k,750) * lu(k,747) + lu(k,751) = lu(k,751) * lu(k,747) + lu(k,1181) = lu(k,1181) - lu(k,748) * lu(k,1171) + lu(k,1184) = lu(k,1184) - lu(k,749) * lu(k,1171) + lu(k,1185) = lu(k,1185) - lu(k,750) * lu(k,1171) + lu(k,1192) = - lu(k,751) * lu(k,1171) + lu(k,1441) = lu(k,1441) - lu(k,748) * lu(k,1436) + lu(k,1442) = lu(k,1442) - lu(k,749) * lu(k,1436) + lu(k,1444) = lu(k,1444) - lu(k,750) * lu(k,1436) + lu(k,1451) = lu(k,1451) - lu(k,751) * lu(k,1436) + lu(k,1471) = lu(k,1471) - lu(k,748) * lu(k,1455) + lu(k,1474) = lu(k,1474) - lu(k,749) * lu(k,1455) + lu(k,1476) = lu(k,1476) - lu(k,750) * lu(k,1455) + lu(k,1483) = lu(k,1483) - lu(k,751) * lu(k,1455) + lu(k,1680) = lu(k,1680) - lu(k,748) * lu(k,1652) + lu(k,1684) = lu(k,1684) - lu(k,749) * lu(k,1652) + lu(k,1687) = lu(k,1687) - lu(k,750) * lu(k,1652) + lu(k,1698) = lu(k,1698) - lu(k,751) * lu(k,1652) + lu(k,1893) = lu(k,1893) - lu(k,748) * lu(k,1842) + lu(k,1901) = lu(k,1901) - lu(k,749) * lu(k,1842) + lu(k,1904) = lu(k,1904) - lu(k,750) * lu(k,1842) + lu(k,1915) = lu(k,1915) - lu(k,751) * lu(k,1842) + lu(k,2091) = lu(k,2091) - lu(k,748) * lu(k,2060) + lu(k,2097) = lu(k,2097) - lu(k,749) * lu(k,2060) + lu(k,2100) = lu(k,2100) - lu(k,750) * lu(k,2060) + lu(k,2111) = - lu(k,751) * lu(k,2060) + lu(k,2403) = lu(k,2403) - lu(k,748) * lu(k,2363) + lu(k,2410) = lu(k,2410) - lu(k,749) * lu(k,2363) + lu(k,2413) = lu(k,2413) - lu(k,750) * lu(k,2363) + lu(k,2424) = lu(k,2424) - lu(k,751) * lu(k,2363) + 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,1294) = - lu(k,754) * lu(k,1288) + lu(k,1296) = - lu(k,755) * lu(k,1288) + lu(k,1298) = - lu(k,756) * lu(k,1288) + lu(k,1303) = lu(k,1303) - lu(k,757) * lu(k,1288) + lu(k,1306) = lu(k,1306) - lu(k,758) * lu(k,1288) + lu(k,1307) = lu(k,1307) - lu(k,759) * lu(k,1288) + lu(k,1338) = - lu(k,754) * lu(k,1332) + lu(k,1339) = lu(k,1339) - lu(k,755) * lu(k,1332) + lu(k,1343) = lu(k,1343) - lu(k,756) * lu(k,1332) + lu(k,1349) = lu(k,1349) - lu(k,757) * lu(k,1332) + lu(k,1353) = lu(k,1353) - lu(k,758) * lu(k,1332) + lu(k,1354) = lu(k,1354) - lu(k,759) * lu(k,1332) + lu(k,1371) = lu(k,1371) - lu(k,754) * lu(k,1361) + lu(k,1372) = - lu(k,755) * lu(k,1361) + lu(k,1376) = - lu(k,756) * lu(k,1361) + lu(k,1382) = lu(k,1382) - lu(k,757) * lu(k,1361) + lu(k,1386) = lu(k,1386) - lu(k,758) * lu(k,1361) + lu(k,1387) = lu(k,1387) - lu(k,759) * lu(k,1361) + lu(k,1883) = lu(k,1883) - lu(k,754) * lu(k,1843) + lu(k,1885) = lu(k,1885) - lu(k,755) * lu(k,1843) + lu(k,1890) = lu(k,1890) - lu(k,756) * lu(k,1843) + lu(k,1904) = lu(k,1904) - lu(k,757) * lu(k,1843) + lu(k,1912) = lu(k,1912) - lu(k,758) * lu(k,1843) + lu(k,1913) = lu(k,1913) - lu(k,759) * lu(k,1843) + lu(k,2393) = lu(k,2393) - lu(k,754) * lu(k,2364) + lu(k,2395) = - lu(k,755) * lu(k,2364) + lu(k,2400) = - lu(k,756) * lu(k,2364) + lu(k,2413) = lu(k,2413) - lu(k,757) * lu(k,2364) + lu(k,2421) = lu(k,2421) - lu(k,758) * lu(k,2364) + lu(k,2422) = lu(k,2422) - lu(k,759) * lu(k,2364) + 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,764) = 1._r8 / lu(k,764) + lu(k,765) = lu(k,765) * lu(k,764) + lu(k,766) = lu(k,766) * lu(k,764) + lu(k,767) = lu(k,767) * lu(k,764) + lu(k,768) = lu(k,768) * lu(k,764) + lu(k,769) = lu(k,769) * lu(k,764) + lu(k,770) = lu(k,770) * lu(k,764) + lu(k,771) = lu(k,771) * lu(k,764) + lu(k,772) = lu(k,772) * lu(k,764) + lu(k,773) = lu(k,773) * lu(k,764) + lu(k,774) = lu(k,774) * lu(k,764) + lu(k,808) = lu(k,808) - lu(k,765) * lu(k,807) + lu(k,809) = lu(k,809) - lu(k,766) * lu(k,807) + lu(k,810) = lu(k,810) - lu(k,767) * lu(k,807) + lu(k,811) = lu(k,811) - lu(k,768) * lu(k,807) + lu(k,812) = lu(k,812) - lu(k,769) * lu(k,807) + lu(k,813) = lu(k,813) - lu(k,770) * lu(k,807) + lu(k,814) = lu(k,814) - lu(k,771) * lu(k,807) + lu(k,815) = lu(k,815) - lu(k,772) * lu(k,807) + lu(k,816) = - lu(k,773) * lu(k,807) + lu(k,818) = lu(k,818) - lu(k,774) * lu(k,807) + lu(k,1846) = lu(k,1846) - lu(k,765) * lu(k,1844) + lu(k,1848) = lu(k,1848) - lu(k,766) * lu(k,1844) + lu(k,1849) = lu(k,1849) - lu(k,767) * lu(k,1844) + lu(k,1860) = lu(k,1860) - lu(k,768) * lu(k,1844) + lu(k,1867) = lu(k,1867) - lu(k,769) * lu(k,1844) + lu(k,1877) = lu(k,1877) - lu(k,770) * lu(k,1844) + lu(k,1886) = lu(k,1886) - lu(k,771) * lu(k,1844) + lu(k,1892) = lu(k,1892) - lu(k,772) * lu(k,1844) + lu(k,1904) = lu(k,1904) - lu(k,773) * lu(k,1844) + lu(k,1912) = lu(k,1912) - lu(k,774) * lu(k,1844) + lu(k,2366) = lu(k,2366) - lu(k,765) * lu(k,2365) + lu(k,2368) = lu(k,2368) - lu(k,766) * lu(k,2365) + lu(k,2369) = lu(k,2369) - lu(k,767) * lu(k,2365) + lu(k,2378) = lu(k,2378) - lu(k,768) * lu(k,2365) + lu(k,2381) = lu(k,2381) - lu(k,769) * lu(k,2365) + lu(k,2388) = lu(k,2388) - lu(k,770) * lu(k,2365) + lu(k,2396) = lu(k,2396) - lu(k,771) * lu(k,2365) + lu(k,2402) = lu(k,2402) - lu(k,772) * lu(k,2365) + lu(k,2413) = lu(k,2413) - lu(k,773) * lu(k,2365) + lu(k,2421) = lu(k,2421) - lu(k,774) * lu(k,2365) + lu(k,775) = 1._r8 / lu(k,775) + lu(k,776) = lu(k,776) * lu(k,775) + lu(k,777) = lu(k,777) * lu(k,775) + lu(k,778) = lu(k,778) * lu(k,775) + lu(k,779) = lu(k,779) * lu(k,775) + lu(k,780) = lu(k,780) * lu(k,775) + lu(k,781) = lu(k,781) * lu(k,775) + lu(k,1518) = lu(k,1518) - lu(k,776) * lu(k,1516) + lu(k,1520) = lu(k,1520) - lu(k,777) * lu(k,1516) + lu(k,1522) = lu(k,1522) - lu(k,778) * lu(k,1516) + lu(k,1523) = lu(k,1523) - lu(k,779) * lu(k,1516) + lu(k,1524) = lu(k,1524) - lu(k,780) * lu(k,1516) + lu(k,1526) = lu(k,1526) - lu(k,781) * lu(k,1516) + lu(k,1582) = lu(k,1582) - lu(k,776) * lu(k,1572) + lu(k,1584) = lu(k,1584) - lu(k,777) * lu(k,1572) + lu(k,1586) = lu(k,1586) - lu(k,778) * lu(k,1572) + lu(k,1587) = - lu(k,779) * lu(k,1572) + lu(k,1588) = lu(k,1588) - lu(k,780) * lu(k,1572) + lu(k,1591) = lu(k,1591) - lu(k,781) * lu(k,1572) + lu(k,1895) = lu(k,1895) - lu(k,776) * lu(k,1845) + lu(k,1898) = lu(k,1898) - lu(k,777) * lu(k,1845) + lu(k,1903) = lu(k,1903) - lu(k,778) * lu(k,1845) + lu(k,1904) = lu(k,1904) - lu(k,779) * lu(k,1845) + lu(k,1905) = lu(k,1905) - lu(k,780) * lu(k,1845) + lu(k,1908) = lu(k,1908) - lu(k,781) * lu(k,1845) + lu(k,1938) = lu(k,1938) - lu(k,776) * lu(k,1924) + lu(k,1941) = lu(k,1941) - lu(k,777) * lu(k,1924) + lu(k,1946) = lu(k,1946) - lu(k,778) * lu(k,1924) + lu(k,1947) = lu(k,1947) - lu(k,779) * lu(k,1924) + lu(k,1948) = lu(k,1948) - lu(k,780) * lu(k,1924) + lu(k,1951) = lu(k,1951) - lu(k,781) * lu(k,1924) + lu(k,2092) = lu(k,2092) - lu(k,776) * lu(k,2061) + lu(k,2094) = lu(k,2094) - lu(k,777) * lu(k,2061) + lu(k,2099) = lu(k,2099) - lu(k,778) * lu(k,2061) + lu(k,2100) = lu(k,2100) - lu(k,779) * lu(k,2061) + lu(k,2101) = lu(k,2101) - lu(k,780) * lu(k,2061) + lu(k,2104) = lu(k,2104) - lu(k,781) * lu(k,2061) + lu(k,782) = 1._r8 / lu(k,782) + lu(k,783) = lu(k,783) * lu(k,782) + lu(k,784) = lu(k,784) * lu(k,782) + lu(k,785) = lu(k,785) * lu(k,782) + lu(k,786) = lu(k,786) * lu(k,782) + lu(k,787) = lu(k,787) * lu(k,782) + lu(k,796) = lu(k,796) - lu(k,783) * lu(k,792) + lu(k,797) = lu(k,797) - lu(k,784) * lu(k,792) + lu(k,800) = lu(k,800) - lu(k,785) * lu(k,792) + lu(k,801) = lu(k,801) - lu(k,786) * lu(k,792) + lu(k,802) = lu(k,802) - lu(k,787) * lu(k,792) + lu(k,812) = lu(k,812) - lu(k,783) * lu(k,808) + lu(k,813) = lu(k,813) - lu(k,784) * lu(k,808) + lu(k,817) = lu(k,817) - lu(k,785) * lu(k,808) + lu(k,818) = lu(k,818) - lu(k,786) * lu(k,808) + lu(k,819) = lu(k,819) - lu(k,787) * lu(k,808) + lu(k,1867) = lu(k,1867) - lu(k,783) * lu(k,1846) + lu(k,1877) = lu(k,1877) - lu(k,784) * lu(k,1846) + lu(k,1910) = lu(k,1910) - lu(k,785) * lu(k,1846) + lu(k,1912) = lu(k,1912) - lu(k,786) * lu(k,1846) + lu(k,1914) = lu(k,1914) - lu(k,787) * lu(k,1846) + lu(k,2201) = lu(k,2201) - lu(k,783) * lu(k,2185) + lu(k,2209) = lu(k,2209) - lu(k,784) * lu(k,2185) + lu(k,2239) = lu(k,2239) - lu(k,785) * lu(k,2185) + lu(k,2241) = lu(k,2241) - lu(k,786) * lu(k,2185) + lu(k,2243) = lu(k,2243) - lu(k,787) * lu(k,2185) + lu(k,2381) = lu(k,2381) - lu(k,783) * lu(k,2366) + lu(k,2388) = lu(k,2388) - lu(k,784) * lu(k,2366) + lu(k,2419) = lu(k,2419) - lu(k,785) * lu(k,2366) + lu(k,2421) = lu(k,2421) - lu(k,786) * lu(k,2366) + lu(k,2423) = lu(k,2423) - lu(k,787) * lu(k,2366) + lu(k,2467) = - lu(k,783) * lu(k,2461) + lu(k,2469) = - lu(k,784) * lu(k,2461) + lu(k,2490) = lu(k,2490) - lu(k,785) * lu(k,2461) + lu(k,2492) = lu(k,2492) - lu(k,786) * lu(k,2461) + lu(k,2494) = lu(k,2494) - lu(k,787) * lu(k,2461) + lu(k,793) = 1._r8 / lu(k,793) + lu(k,794) = lu(k,794) * lu(k,793) + lu(k,795) = lu(k,795) * lu(k,793) + lu(k,796) = lu(k,796) * lu(k,793) + lu(k,797) = lu(k,797) * lu(k,793) + lu(k,798) = lu(k,798) * lu(k,793) + lu(k,799) = lu(k,799) * lu(k,793) + lu(k,800) = lu(k,800) * lu(k,793) + lu(k,801) = lu(k,801) * lu(k,793) + lu(k,802) = lu(k,802) * lu(k,793) + lu(k,1849) = lu(k,1849) - lu(k,794) * lu(k,1847) + lu(k,1860) = lu(k,1860) - lu(k,795) * lu(k,1847) + lu(k,1867) = lu(k,1867) - lu(k,796) * lu(k,1847) + lu(k,1877) = lu(k,1877) - lu(k,797) * lu(k,1847) + lu(k,1886) = lu(k,1886) - lu(k,798) * lu(k,1847) + lu(k,1904) = lu(k,1904) - lu(k,799) * lu(k,1847) + lu(k,1910) = lu(k,1910) - lu(k,800) * lu(k,1847) + lu(k,1912) = lu(k,1912) - lu(k,801) * lu(k,1847) + lu(k,1914) = lu(k,1914) - lu(k,802) * lu(k,1847) + lu(k,2188) = lu(k,2188) - lu(k,794) * lu(k,2186) + lu(k,2197) = lu(k,2197) - lu(k,795) * lu(k,2186) + lu(k,2201) = lu(k,2201) - lu(k,796) * lu(k,2186) + lu(k,2209) = lu(k,2209) - lu(k,797) * lu(k,2186) + lu(k,2218) = lu(k,2218) - lu(k,798) * lu(k,2186) + lu(k,2233) = lu(k,2233) - lu(k,799) * lu(k,2186) + lu(k,2239) = lu(k,2239) - lu(k,800) * lu(k,2186) + lu(k,2241) = lu(k,2241) - lu(k,801) * lu(k,2186) + lu(k,2243) = lu(k,2243) - lu(k,802) * lu(k,2186) + lu(k,2369) = lu(k,2369) - lu(k,794) * lu(k,2367) + lu(k,2378) = lu(k,2378) - lu(k,795) * lu(k,2367) + lu(k,2381) = lu(k,2381) - lu(k,796) * lu(k,2367) + lu(k,2388) = lu(k,2388) - lu(k,797) * lu(k,2367) + lu(k,2396) = lu(k,2396) - lu(k,798) * lu(k,2367) + lu(k,2413) = lu(k,2413) - lu(k,799) * lu(k,2367) + lu(k,2419) = lu(k,2419) - lu(k,800) * lu(k,2367) + lu(k,2421) = lu(k,2421) - lu(k,801) * lu(k,2367) + lu(k,2423) = lu(k,2423) - lu(k,802) * lu(k,2367) + lu(k,809) = 1._r8 / lu(k,809) + lu(k,810) = lu(k,810) * lu(k,809) + lu(k,811) = lu(k,811) * lu(k,809) + lu(k,812) = lu(k,812) * lu(k,809) + lu(k,813) = lu(k,813) * lu(k,809) + lu(k,814) = lu(k,814) * lu(k,809) + lu(k,815) = lu(k,815) * lu(k,809) + lu(k,816) = lu(k,816) * lu(k,809) + lu(k,817) = lu(k,817) * lu(k,809) + lu(k,818) = lu(k,818) * lu(k,809) + lu(k,819) = lu(k,819) * lu(k,809) + lu(k,1849) = lu(k,1849) - lu(k,810) * lu(k,1848) + lu(k,1860) = lu(k,1860) - lu(k,811) * lu(k,1848) + lu(k,1867) = lu(k,1867) - lu(k,812) * lu(k,1848) + lu(k,1877) = lu(k,1877) - lu(k,813) * lu(k,1848) + lu(k,1886) = lu(k,1886) - lu(k,814) * lu(k,1848) + lu(k,1892) = lu(k,1892) - lu(k,815) * lu(k,1848) + lu(k,1904) = lu(k,1904) - lu(k,816) * lu(k,1848) + lu(k,1910) = lu(k,1910) - lu(k,817) * lu(k,1848) + lu(k,1912) = lu(k,1912) - lu(k,818) * lu(k,1848) + lu(k,1914) = lu(k,1914) - lu(k,819) * lu(k,1848) + lu(k,2188) = lu(k,2188) - lu(k,810) * lu(k,2187) + lu(k,2197) = lu(k,2197) - lu(k,811) * lu(k,2187) + lu(k,2201) = lu(k,2201) - lu(k,812) * lu(k,2187) + lu(k,2209) = lu(k,2209) - lu(k,813) * lu(k,2187) + lu(k,2218) = lu(k,2218) - lu(k,814) * lu(k,2187) + lu(k,2224) = lu(k,2224) - lu(k,815) * lu(k,2187) + lu(k,2233) = lu(k,2233) - lu(k,816) * lu(k,2187) + lu(k,2239) = lu(k,2239) - lu(k,817) * lu(k,2187) + lu(k,2241) = lu(k,2241) - lu(k,818) * lu(k,2187) + lu(k,2243) = lu(k,2243) - lu(k,819) * lu(k,2187) + lu(k,2369) = lu(k,2369) - lu(k,810) * lu(k,2368) + lu(k,2378) = lu(k,2378) - lu(k,811) * lu(k,2368) + lu(k,2381) = lu(k,2381) - lu(k,812) * lu(k,2368) + lu(k,2388) = lu(k,2388) - lu(k,813) * lu(k,2368) + lu(k,2396) = lu(k,2396) - lu(k,814) * lu(k,2368) + lu(k,2402) = lu(k,2402) - lu(k,815) * lu(k,2368) + lu(k,2413) = lu(k,2413) - lu(k,816) * lu(k,2368) + lu(k,2419) = lu(k,2419) - lu(k,817) * lu(k,2368) + lu(k,2421) = lu(k,2421) - lu(k,818) * lu(k,2368) + lu(k,2423) = lu(k,2423) - lu(k,819) * lu(k,2368) + 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,1877) = lu(k,1877) - lu(k,821) * lu(k,1849) + lu(k,1886) = lu(k,1886) - lu(k,822) * lu(k,1849) + lu(k,1901) = lu(k,1901) - lu(k,823) * lu(k,1849) + lu(k,1904) = lu(k,1904) - lu(k,824) * lu(k,1849) + lu(k,1910) = lu(k,1910) - lu(k,825) * lu(k,1849) + lu(k,1912) = lu(k,1912) - lu(k,826) * lu(k,1849) + lu(k,1914) = lu(k,1914) - lu(k,827) * lu(k,1849) + lu(k,2209) = lu(k,2209) - lu(k,821) * lu(k,2188) + lu(k,2218) = lu(k,2218) - lu(k,822) * lu(k,2188) + lu(k,2230) = lu(k,2230) - lu(k,823) * lu(k,2188) + lu(k,2233) = lu(k,2233) - lu(k,824) * lu(k,2188) + lu(k,2239) = lu(k,2239) - lu(k,825) * lu(k,2188) + lu(k,2241) = lu(k,2241) - lu(k,826) * lu(k,2188) + lu(k,2243) = lu(k,2243) - lu(k,827) * lu(k,2188) + lu(k,2388) = lu(k,2388) - lu(k,821) * lu(k,2369) + lu(k,2396) = lu(k,2396) - lu(k,822) * lu(k,2369) + lu(k,2410) = lu(k,2410) - lu(k,823) * lu(k,2369) + lu(k,2413) = lu(k,2413) - lu(k,824) * lu(k,2369) + lu(k,2419) = lu(k,2419) - lu(k,825) * lu(k,2369) + lu(k,2421) = lu(k,2421) - lu(k,826) * lu(k,2369) + lu(k,2423) = lu(k,2423) - lu(k,827) * lu(k,2369) + lu(k,2469) = lu(k,2469) - lu(k,821) * lu(k,2462) + lu(k,2471) = - lu(k,822) * lu(k,2462) + lu(k,2481) = lu(k,2481) - lu(k,823) * lu(k,2462) + lu(k,2484) = lu(k,2484) - lu(k,824) * lu(k,2462) + lu(k,2490) = lu(k,2490) - lu(k,825) * lu(k,2462) + lu(k,2492) = lu(k,2492) - lu(k,826) * lu(k,2462) + lu(k,2494) = lu(k,2494) - lu(k,827) * lu(k,2462) + 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,829) = 1._r8 / lu(k,829) + lu(k,830) = lu(k,830) * lu(k,829) + lu(k,831) = lu(k,831) * lu(k,829) + lu(k,832) = lu(k,832) * lu(k,829) + lu(k,833) = lu(k,833) * lu(k,829) + lu(k,834) = lu(k,834) * lu(k,829) + lu(k,835) = lu(k,835) * lu(k,829) + lu(k,836) = lu(k,836) * lu(k,829) + lu(k,1537) = lu(k,1537) - lu(k,830) * lu(k,1534) + lu(k,1538) = lu(k,1538) - lu(k,831) * lu(k,1534) + lu(k,1539) = - lu(k,832) * lu(k,1534) + lu(k,1542) = lu(k,1542) - lu(k,833) * lu(k,1534) + lu(k,1543) = lu(k,1543) - lu(k,834) * lu(k,1534) + lu(k,1544) = lu(k,1544) - lu(k,835) * lu(k,1534) + lu(k,1549) = lu(k,1549) - lu(k,836) * lu(k,1534) + lu(k,1604) = - lu(k,830) * lu(k,1601) + lu(k,1605) = lu(k,1605) - lu(k,831) * lu(k,1601) + lu(k,1607) = lu(k,1607) - lu(k,832) * lu(k,1601) + lu(k,1610) = lu(k,1610) - lu(k,833) * lu(k,1601) + lu(k,1611) = lu(k,1611) - lu(k,834) * lu(k,1601) + lu(k,1612) = lu(k,1612) - lu(k,835) * lu(k,1601) + lu(k,1621) = - lu(k,836) * lu(k,1601) + lu(k,1939) = lu(k,1939) - lu(k,830) * lu(k,1925) + lu(k,1940) = lu(k,1940) - lu(k,831) * lu(k,1925) + lu(k,1942) = lu(k,1942) - lu(k,832) * lu(k,1925) + lu(k,1947) = lu(k,1947) - lu(k,833) * lu(k,1925) + lu(k,1948) = lu(k,1948) - lu(k,834) * lu(k,1925) + lu(k,1949) = lu(k,1949) - lu(k,835) * lu(k,1925) + lu(k,1958) = lu(k,1958) - lu(k,836) * lu(k,1925) + lu(k,2405) = lu(k,2405) - lu(k,830) * lu(k,2370) + lu(k,2406) = lu(k,2406) - lu(k,831) * lu(k,2370) + lu(k,2408) = lu(k,2408) - lu(k,832) * lu(k,2370) + lu(k,2413) = lu(k,2413) - lu(k,833) * lu(k,2370) + lu(k,2414) = lu(k,2414) - lu(k,834) * lu(k,2370) + lu(k,2415) = lu(k,2415) - lu(k,835) * lu(k,2370) + lu(k,2424) = lu(k,2424) - lu(k,836) * lu(k,2370) + lu(k,2476) = - lu(k,830) * lu(k,2463) + lu(k,2477) = lu(k,2477) - lu(k,831) * lu(k,2463) + lu(k,2479) = lu(k,2479) - lu(k,832) * lu(k,2463) + lu(k,2484) = lu(k,2484) - lu(k,833) * lu(k,2463) + lu(k,2485) = lu(k,2485) - lu(k,834) * lu(k,2463) + lu(k,2486) = - lu(k,835) * lu(k,2463) + lu(k,2495) = lu(k,2495) - lu(k,836) * lu(k,2463) + lu(k,839) = 1._r8 / lu(k,839) + lu(k,840) = lu(k,840) * lu(k,839) + lu(k,841) = lu(k,841) * lu(k,839) + lu(k,842) = lu(k,842) * lu(k,839) + lu(k,843) = lu(k,843) * lu(k,839) + lu(k,844) = lu(k,844) * lu(k,839) + lu(k,845) = lu(k,845) * lu(k,839) + lu(k,846) = lu(k,846) * lu(k,839) + lu(k,1878) = lu(k,1878) - lu(k,840) * lu(k,1850) + lu(k,1898) = lu(k,1898) - lu(k,841) * lu(k,1850) + lu(k,1904) = lu(k,1904) - lu(k,842) * lu(k,1850) + lu(k,1910) = lu(k,1910) - lu(k,843) * lu(k,1850) + lu(k,1912) = lu(k,1912) - lu(k,844) * lu(k,1850) + lu(k,1913) = lu(k,1913) - lu(k,845) * lu(k,1850) + lu(k,1914) = lu(k,1914) - lu(k,846) * lu(k,1850) + lu(k,1979) = - lu(k,840) * lu(k,1969) + lu(k,1987) = lu(k,1987) - lu(k,841) * lu(k,1969) + lu(k,1993) = lu(k,1993) - lu(k,842) * lu(k,1969) + lu(k,1999) = - lu(k,843) * lu(k,1969) + lu(k,2001) = lu(k,2001) - lu(k,844) * lu(k,1969) + lu(k,2002) = lu(k,2002) - lu(k,845) * lu(k,1969) + lu(k,2003) = - lu(k,846) * lu(k,1969) + lu(k,2078) = - lu(k,840) * lu(k,2062) + lu(k,2094) = lu(k,2094) - lu(k,841) * lu(k,2062) + lu(k,2100) = lu(k,2100) - lu(k,842) * lu(k,2062) + lu(k,2106) = lu(k,2106) - lu(k,843) * lu(k,2062) + lu(k,2108) = lu(k,2108) - lu(k,844) * lu(k,2062) + lu(k,2109) = lu(k,2109) - lu(k,845) * lu(k,2062) + lu(k,2110) = lu(k,2110) - lu(k,846) * lu(k,2062) + lu(k,2210) = lu(k,2210) - lu(k,840) * lu(k,2189) + lu(k,2227) = lu(k,2227) - lu(k,841) * lu(k,2189) + lu(k,2233) = lu(k,2233) - lu(k,842) * lu(k,2189) + lu(k,2239) = lu(k,2239) - lu(k,843) * lu(k,2189) + lu(k,2241) = lu(k,2241) - lu(k,844) * lu(k,2189) + lu(k,2242) = lu(k,2242) - lu(k,845) * lu(k,2189) + lu(k,2243) = lu(k,2243) - lu(k,846) * lu(k,2189) + lu(k,2389) = lu(k,2389) - lu(k,840) * lu(k,2371) + lu(k,2407) = lu(k,2407) - lu(k,841) * lu(k,2371) + lu(k,2413) = lu(k,2413) - lu(k,842) * lu(k,2371) + lu(k,2419) = lu(k,2419) - lu(k,843) * lu(k,2371) + lu(k,2421) = lu(k,2421) - lu(k,844) * lu(k,2371) + lu(k,2422) = lu(k,2422) - lu(k,845) * lu(k,2371) + lu(k,2423) = lu(k,2423) - lu(k,846) * lu(k,2371) + lu(k,847) = 1._r8 / lu(k,847) + lu(k,848) = lu(k,848) * lu(k,847) + lu(k,849) = lu(k,849) * lu(k,847) + lu(k,850) = lu(k,850) * lu(k,847) + lu(k,851) = lu(k,851) * lu(k,847) + lu(k,852) = lu(k,852) * lu(k,847) + lu(k,853) = lu(k,853) * lu(k,847) + lu(k,854) = lu(k,854) * lu(k,847) + lu(k,905) = lu(k,905) - lu(k,848) * lu(k,904) + lu(k,906) = lu(k,906) - lu(k,849) * lu(k,904) + lu(k,908) = lu(k,908) - lu(k,850) * lu(k,904) + lu(k,909) = - lu(k,851) * lu(k,904) + lu(k,910) = - lu(k,852) * lu(k,904) + lu(k,911) = lu(k,911) - lu(k,853) * lu(k,904) + lu(k,912) = lu(k,912) - lu(k,854) * lu(k,904) + lu(k,998) = lu(k,998) - lu(k,848) * lu(k,997) + lu(k,999) = lu(k,999) - lu(k,849) * lu(k,997) + lu(k,1001) = lu(k,1001) - lu(k,850) * lu(k,997) + lu(k,1002) = - lu(k,851) * lu(k,997) + lu(k,1003) = - lu(k,852) * lu(k,997) + lu(k,1004) = lu(k,1004) - lu(k,853) * lu(k,997) + lu(k,1007) = lu(k,1007) - lu(k,854) * lu(k,997) + lu(k,1487) = - lu(k,848) * lu(k,1486) + lu(k,1488) = lu(k,1488) - lu(k,849) * lu(k,1486) + lu(k,1490) = - lu(k,850) * lu(k,1486) + lu(k,1491) = lu(k,1491) - lu(k,851) * lu(k,1486) + lu(k,1492) = lu(k,1492) - lu(k,852) * lu(k,1486) + lu(k,1493) = lu(k,1493) - lu(k,853) * lu(k,1486) + lu(k,1496) = lu(k,1496) - lu(k,854) * lu(k,1486) + lu(k,1574) = lu(k,1574) - lu(k,848) * lu(k,1573) + lu(k,1575) = lu(k,1575) - lu(k,849) * lu(k,1573) + lu(k,1578) = lu(k,1578) - lu(k,850) * lu(k,1573) + lu(k,1579) = - lu(k,851) * lu(k,1573) + lu(k,1581) = - lu(k,852) * lu(k,1573) + lu(k,1584) = lu(k,1584) - lu(k,853) * lu(k,1573) + lu(k,1588) = lu(k,1588) - lu(k,854) * lu(k,1573) + lu(k,1929) = lu(k,1929) - lu(k,848) * lu(k,1926) + lu(k,1930) = lu(k,1930) - lu(k,849) * lu(k,1926) + lu(k,1933) = lu(k,1933) - lu(k,850) * lu(k,1926) + lu(k,1935) = lu(k,1935) - lu(k,851) * lu(k,1926) + lu(k,1936) = - lu(k,852) * lu(k,1926) + lu(k,1941) = lu(k,1941) - lu(k,853) * lu(k,1926) + lu(k,1948) = lu(k,1948) - lu(k,854) * lu(k,1926) + lu(k,855) = 1._r8 / lu(k,855) + lu(k,856) = lu(k,856) * lu(k,855) + lu(k,857) = lu(k,857) * lu(k,855) + lu(k,858) = lu(k,858) * lu(k,855) + lu(k,957) = lu(k,957) - lu(k,856) * lu(k,952) + lu(k,959) = lu(k,959) - lu(k,857) * lu(k,952) + lu(k,960) = lu(k,960) - lu(k,858) * lu(k,952) + lu(k,1097) = lu(k,1097) - lu(k,856) * lu(k,1091) + lu(k,1099) = lu(k,1099) - lu(k,857) * lu(k,1091) + lu(k,1100) = lu(k,1100) - lu(k,858) * lu(k,1091) + lu(k,1138) = lu(k,1138) - lu(k,856) * lu(k,1130) + lu(k,1141) = lu(k,1141) - lu(k,857) * lu(k,1130) + lu(k,1142) = lu(k,1142) - lu(k,858) * lu(k,1130) + lu(k,1226) = lu(k,1226) - lu(k,856) * lu(k,1215) + lu(k,1228) = lu(k,1228) - lu(k,857) * lu(k,1215) + lu(k,1229) = lu(k,1229) - lu(k,858) * lu(k,1215) + lu(k,1263) = lu(k,1263) - lu(k,856) * lu(k,1257) + lu(k,1265) = lu(k,1265) - lu(k,857) * lu(k,1257) + lu(k,1266) = lu(k,1266) - lu(k,858) * lu(k,1257) + lu(k,1280) = lu(k,1280) - lu(k,856) * lu(k,1270) + lu(k,1283) = lu(k,1283) - lu(k,857) * lu(k,1270) + lu(k,1284) = lu(k,1284) - lu(k,858) * lu(k,1270) + lu(k,1303) = lu(k,1303) - lu(k,856) * lu(k,1289) + lu(k,1306) = lu(k,1306) - lu(k,857) * lu(k,1289) + lu(k,1307) = lu(k,1307) - lu(k,858) * lu(k,1289) + lu(k,1349) = lu(k,1349) - lu(k,856) * lu(k,1333) + lu(k,1353) = lu(k,1353) - lu(k,857) * lu(k,1333) + lu(k,1354) = lu(k,1354) - lu(k,858) * lu(k,1333) + lu(k,1382) = lu(k,1382) - lu(k,856) * lu(k,1362) + lu(k,1386) = lu(k,1386) - lu(k,857) * lu(k,1362) + lu(k,1387) = lu(k,1387) - lu(k,858) * lu(k,1362) + lu(k,1404) = lu(k,1404) - lu(k,856) * lu(k,1391) + lu(k,1407) = lu(k,1407) - lu(k,857) * lu(k,1391) + lu(k,1408) = lu(k,1408) - lu(k,858) * lu(k,1391) + lu(k,1687) = lu(k,1687) - lu(k,856) * lu(k,1653) + lu(k,1695) = lu(k,1695) - lu(k,857) * lu(k,1653) + lu(k,1696) = lu(k,1696) - lu(k,858) * lu(k,1653) + lu(k,1904) = lu(k,1904) - lu(k,856) * lu(k,1851) + lu(k,1912) = lu(k,1912) - lu(k,857) * lu(k,1851) + lu(k,1913) = lu(k,1913) - lu(k,858) * lu(k,1851) + lu(k,860) = 1._r8 / lu(k,860) + lu(k,861) = lu(k,861) * lu(k,860) + lu(k,862) = lu(k,862) * lu(k,860) + lu(k,863) = lu(k,863) * lu(k,860) + lu(k,864) = lu(k,864) * lu(k,860) + lu(k,865) = lu(k,865) * lu(k,860) + lu(k,866) = lu(k,866) * lu(k,860) + lu(k,867) = lu(k,867) * lu(k,860) + lu(k,868) = lu(k,868) * lu(k,860) + lu(k,869) = lu(k,869) * lu(k,860) + lu(k,1176) = lu(k,1176) - lu(k,861) * lu(k,1172) + lu(k,1178) = - lu(k,862) * lu(k,1172) + lu(k,1182) = - lu(k,863) * lu(k,1172) + lu(k,1185) = lu(k,1185) - lu(k,864) * lu(k,1172) + lu(k,1187) = - lu(k,865) * lu(k,1172) + lu(k,1189) = lu(k,1189) - lu(k,866) * lu(k,1172) + lu(k,1190) = lu(k,1190) - lu(k,867) * lu(k,1172) + lu(k,1191) = - lu(k,868) * lu(k,1172) + lu(k,1192) = lu(k,1192) - lu(k,869) * lu(k,1172) + lu(k,1876) = lu(k,1876) - lu(k,861) * lu(k,1852) + lu(k,1881) = lu(k,1881) - lu(k,862) * lu(k,1852) + lu(k,1898) = lu(k,1898) - lu(k,863) * lu(k,1852) + lu(k,1904) = lu(k,1904) - lu(k,864) * lu(k,1852) + lu(k,1910) = lu(k,1910) - lu(k,865) * lu(k,1852) + lu(k,1912) = lu(k,1912) - lu(k,866) * lu(k,1852) + lu(k,1913) = lu(k,1913) - lu(k,867) * lu(k,1852) + lu(k,1914) = lu(k,1914) - lu(k,868) * lu(k,1852) + lu(k,1915) = lu(k,1915) - lu(k,869) * lu(k,1852) + lu(k,2208) = lu(k,2208) - lu(k,861) * lu(k,2190) + lu(k,2213) = lu(k,2213) - lu(k,862) * lu(k,2190) + lu(k,2227) = lu(k,2227) - lu(k,863) * lu(k,2190) + lu(k,2233) = lu(k,2233) - lu(k,864) * lu(k,2190) + lu(k,2239) = lu(k,2239) - lu(k,865) * lu(k,2190) + lu(k,2241) = lu(k,2241) - lu(k,866) * lu(k,2190) + lu(k,2242) = lu(k,2242) - lu(k,867) * lu(k,2190) + lu(k,2243) = lu(k,2243) - lu(k,868) * lu(k,2190) + lu(k,2244) = - lu(k,869) * lu(k,2190) + lu(k,2387) = lu(k,2387) - lu(k,861) * lu(k,2372) + lu(k,2391) = lu(k,2391) - lu(k,862) * lu(k,2372) + lu(k,2407) = lu(k,2407) - lu(k,863) * lu(k,2372) + lu(k,2413) = lu(k,2413) - lu(k,864) * lu(k,2372) + lu(k,2419) = lu(k,2419) - lu(k,865) * lu(k,2372) + lu(k,2421) = lu(k,2421) - lu(k,866) * lu(k,2372) + lu(k,2422) = lu(k,2422) - lu(k,867) * lu(k,2372) + lu(k,2423) = lu(k,2423) - lu(k,868) * lu(k,2372) + lu(k,2424) = lu(k,2424) - lu(k,869) * lu(k,2372) + end do + end subroutine lu_fac18 + subroutine lu_fac19( 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,870) = 1._r8 / lu(k,870) + lu(k,871) = lu(k,871) * lu(k,870) + lu(k,872) = lu(k,872) * lu(k,870) + lu(k,873) = lu(k,873) * lu(k,870) + lu(k,874) = lu(k,874) * lu(k,870) + lu(k,875) = lu(k,875) * lu(k,870) + lu(k,876) = lu(k,876) * lu(k,870) + lu(k,877) = lu(k,877) * lu(k,870) + lu(k,1553) = lu(k,1553) - lu(k,871) * lu(k,1550) + lu(k,1555) = lu(k,1555) - lu(k,872) * lu(k,1550) + lu(k,1556) = - lu(k,873) * lu(k,1550) + lu(k,1557) = - lu(k,874) * lu(k,1550) + lu(k,1558) = - lu(k,875) * lu(k,1550) + lu(k,1559) = - lu(k,876) * lu(k,1550) + lu(k,1565) = - lu(k,877) * lu(k,1550) + lu(k,1897) = lu(k,1897) - lu(k,871) * lu(k,1853) + lu(k,1899) = lu(k,1899) - lu(k,872) * lu(k,1853) + lu(k,1903) = lu(k,1903) - lu(k,873) * lu(k,1853) + lu(k,1904) = lu(k,1904) - lu(k,874) * lu(k,1853) + lu(k,1905) = lu(k,1905) - lu(k,875) * lu(k,1853) + lu(k,1907) = lu(k,1907) - lu(k,876) * lu(k,1853) + lu(k,1915) = lu(k,1915) - lu(k,877) * lu(k,1853) + lu(k,1940) = lu(k,1940) - lu(k,871) * lu(k,1927) + lu(k,1942) = lu(k,1942) - lu(k,872) * lu(k,1927) + lu(k,1946) = lu(k,1946) - lu(k,873) * lu(k,1927) + lu(k,1947) = lu(k,1947) - lu(k,874) * lu(k,1927) + lu(k,1948) = lu(k,1948) - lu(k,875) * lu(k,1927) + lu(k,1950) = lu(k,1950) - lu(k,876) * lu(k,1927) + lu(k,1958) = lu(k,1958) - lu(k,877) * lu(k,1927) + lu(k,2029) = lu(k,2029) - lu(k,871) * lu(k,2025) + lu(k,2031) = lu(k,2031) - lu(k,872) * lu(k,2025) + lu(k,2035) = lu(k,2035) - lu(k,873) * lu(k,2025) + lu(k,2036) = lu(k,2036) - lu(k,874) * lu(k,2025) + lu(k,2037) = lu(k,2037) - lu(k,875) * lu(k,2025) + lu(k,2039) = lu(k,2039) - lu(k,876) * lu(k,2025) + lu(k,2047) = lu(k,2047) - lu(k,877) * lu(k,2025) + lu(k,2406) = lu(k,2406) - lu(k,871) * lu(k,2373) + lu(k,2408) = lu(k,2408) - lu(k,872) * lu(k,2373) + lu(k,2412) = lu(k,2412) - lu(k,873) * lu(k,2373) + lu(k,2413) = lu(k,2413) - lu(k,874) * lu(k,2373) + lu(k,2414) = lu(k,2414) - lu(k,875) * lu(k,2373) + lu(k,2416) = - lu(k,876) * lu(k,2373) + lu(k,2424) = lu(k,2424) - lu(k,877) * lu(k,2373) + lu(k,2432) = lu(k,2432) - lu(k,871) * lu(k,2426) + lu(k,2434) = - lu(k,872) * lu(k,2426) + lu(k,2438) = lu(k,2438) - lu(k,873) * lu(k,2426) + lu(k,2439) = lu(k,2439) - lu(k,874) * lu(k,2426) + lu(k,2440) = lu(k,2440) - lu(k,875) * lu(k,2426) + lu(k,2442) = - lu(k,876) * lu(k,2426) + lu(k,2450) = lu(k,2450) - lu(k,877) * lu(k,2426) + lu(k,879) = 1._r8 / lu(k,879) + lu(k,880) = lu(k,880) * lu(k,879) + lu(k,881) = lu(k,881) * lu(k,879) + lu(k,882) = lu(k,882) * lu(k,879) + lu(k,883) = lu(k,883) * lu(k,879) + lu(k,884) = lu(k,884) * lu(k,879) + lu(k,885) = lu(k,885) * lu(k,879) + lu(k,1119) = lu(k,1119) - lu(k,880) * lu(k,1117) + lu(k,1121) = lu(k,1121) - lu(k,881) * lu(k,1117) + lu(k,1122) = lu(k,1122) - lu(k,882) * lu(k,1117) + lu(k,1123) = lu(k,1123) - lu(k,883) * lu(k,1117) + lu(k,1124) = lu(k,1124) - lu(k,884) * lu(k,1117) + lu(k,1127) = - lu(k,885) * lu(k,1117) + lu(k,1537) = lu(k,1537) - lu(k,880) * lu(k,1535) + lu(k,1542) = lu(k,1542) - lu(k,881) * lu(k,1535) + lu(k,1543) = lu(k,1543) - lu(k,882) * lu(k,1535) + lu(k,1544) = lu(k,1544) - lu(k,883) * lu(k,1535) + lu(k,1546) = lu(k,1546) - lu(k,884) * lu(k,1535) + lu(k,1549) = lu(k,1549) - lu(k,885) * lu(k,1535) + lu(k,1896) = lu(k,1896) - lu(k,880) * lu(k,1854) + lu(k,1904) = lu(k,1904) - lu(k,881) * lu(k,1854) + lu(k,1905) = lu(k,1905) - lu(k,882) * lu(k,1854) + lu(k,1906) = lu(k,1906) - lu(k,883) * lu(k,1854) + lu(k,1909) = lu(k,1909) - lu(k,884) * lu(k,1854) + lu(k,1915) = lu(k,1915) - lu(k,885) * lu(k,1854) + lu(k,1939) = lu(k,1939) - lu(k,880) * lu(k,1928) + lu(k,1947) = lu(k,1947) - lu(k,881) * lu(k,1928) + lu(k,1948) = lu(k,1948) - lu(k,882) * lu(k,1928) + lu(k,1949) = lu(k,1949) - lu(k,883) * lu(k,1928) + lu(k,1952) = lu(k,1952) - lu(k,884) * lu(k,1928) + lu(k,1958) = lu(k,1958) - lu(k,885) * lu(k,1928) + lu(k,1985) = lu(k,1985) - lu(k,880) * lu(k,1970) + lu(k,1993) = lu(k,1993) - lu(k,881) * lu(k,1970) + lu(k,1994) = lu(k,1994) - lu(k,882) * lu(k,1970) + lu(k,1995) = lu(k,1995) - lu(k,883) * lu(k,1970) + lu(k,1998) = lu(k,1998) - lu(k,884) * lu(k,1970) + lu(k,2004) = lu(k,2004) - lu(k,885) * lu(k,1970) + lu(k,2120) = lu(k,2120) - lu(k,880) * lu(k,2116) + lu(k,2127) = lu(k,2127) - lu(k,881) * lu(k,2116) + lu(k,2128) = lu(k,2128) - lu(k,882) * lu(k,2116) + lu(k,2129) = lu(k,2129) - lu(k,883) * lu(k,2116) + lu(k,2132) = lu(k,2132) - lu(k,884) * lu(k,2116) + lu(k,2138) = - lu(k,885) * lu(k,2116) + lu(k,2405) = lu(k,2405) - lu(k,880) * lu(k,2374) + lu(k,2413) = lu(k,2413) - lu(k,881) * lu(k,2374) + lu(k,2414) = lu(k,2414) - lu(k,882) * lu(k,2374) + lu(k,2415) = lu(k,2415) - lu(k,883) * lu(k,2374) + lu(k,2418) = lu(k,2418) - lu(k,884) * lu(k,2374) + lu(k,2424) = lu(k,2424) - lu(k,885) * lu(k,2374) + lu(k,887) = 1._r8 / lu(k,887) + lu(k,888) = lu(k,888) * lu(k,887) + lu(k,889) = lu(k,889) * lu(k,887) + lu(k,890) = lu(k,890) * lu(k,887) + lu(k,891) = lu(k,891) * lu(k,887) + lu(k,892) = lu(k,892) * lu(k,887) + lu(k,893) = lu(k,893) * lu(k,887) + lu(k,896) = lu(k,896) - lu(k,888) * lu(k,894) + lu(k,897) = lu(k,897) - lu(k,889) * lu(k,894) + lu(k,898) = lu(k,898) - lu(k,890) * lu(k,894) + lu(k,899) = lu(k,899) - lu(k,891) * lu(k,894) + lu(k,900) = lu(k,900) - lu(k,892) * lu(k,894) + lu(k,901) = lu(k,901) - lu(k,893) * lu(k,894) + lu(k,907) = lu(k,907) - lu(k,888) * lu(k,905) + lu(k,908) = lu(k,908) - lu(k,889) * lu(k,905) + lu(k,911) = lu(k,911) - lu(k,890) * lu(k,905) + lu(k,912) = lu(k,912) - lu(k,891) * lu(k,905) + lu(k,913) = lu(k,913) - lu(k,892) * lu(k,905) + lu(k,914) = lu(k,914) - lu(k,893) * lu(k,905) + lu(k,1000) = lu(k,1000) - lu(k,888) * lu(k,998) + lu(k,1001) = lu(k,1001) - lu(k,889) * lu(k,998) + lu(k,1004) = lu(k,1004) - lu(k,890) * lu(k,998) + lu(k,1007) = lu(k,1007) - lu(k,891) * lu(k,998) + lu(k,1008) = lu(k,1008) - lu(k,892) * lu(k,998) + lu(k,1009) = lu(k,1009) - lu(k,893) * lu(k,998) + lu(k,1489) = - lu(k,888) * lu(k,1487) + lu(k,1490) = lu(k,1490) - lu(k,889) * lu(k,1487) + lu(k,1493) = lu(k,1493) - lu(k,890) * lu(k,1487) + lu(k,1496) = lu(k,1496) - lu(k,891) * lu(k,1487) + lu(k,1497) = - lu(k,892) * lu(k,1487) + lu(k,1498) = - lu(k,893) * lu(k,1487) + lu(k,1576) = lu(k,1576) - lu(k,888) * lu(k,1574) + lu(k,1578) = lu(k,1578) - lu(k,889) * lu(k,1574) + lu(k,1584) = lu(k,1584) - lu(k,890) * lu(k,1574) + lu(k,1588) = lu(k,1588) - lu(k,891) * lu(k,1574) + lu(k,1590) = lu(k,1590) - lu(k,892) * lu(k,1574) + lu(k,1593) = lu(k,1593) - lu(k,893) * lu(k,1574) + lu(k,1931) = lu(k,1931) - lu(k,888) * lu(k,1929) + lu(k,1933) = lu(k,1933) - lu(k,889) * lu(k,1929) + lu(k,1941) = lu(k,1941) - lu(k,890) * lu(k,1929) + lu(k,1948) = lu(k,1948) - lu(k,891) * lu(k,1929) + lu(k,1950) = lu(k,1950) - lu(k,892) * lu(k,1929) + lu(k,1953) = lu(k,1953) - lu(k,893) * lu(k,1929) + lu(k,2193) = lu(k,2193) - lu(k,888) * lu(k,2191) + lu(k,2199) = lu(k,2199) - lu(k,889) * lu(k,2191) + lu(k,2227) = lu(k,2227) - lu(k,890) * lu(k,2191) + lu(k,2234) = lu(k,2234) - lu(k,891) * lu(k,2191) + lu(k,2236) = - lu(k,892) * lu(k,2191) + lu(k,2239) = lu(k,2239) - lu(k,893) * lu(k,2191) + lu(k,895) = 1._r8 / lu(k,895) + lu(k,896) = lu(k,896) * lu(k,895) + lu(k,897) = lu(k,897) * lu(k,895) + lu(k,898) = lu(k,898) * lu(k,895) + lu(k,899) = lu(k,899) * lu(k,895) + lu(k,900) = lu(k,900) * lu(k,895) + lu(k,901) = lu(k,901) * lu(k,895) + lu(k,907) = lu(k,907) - lu(k,896) * lu(k,906) + lu(k,908) = lu(k,908) - lu(k,897) * lu(k,906) + lu(k,911) = lu(k,911) - lu(k,898) * lu(k,906) + lu(k,912) = lu(k,912) - lu(k,899) * lu(k,906) + lu(k,913) = lu(k,913) - lu(k,900) * lu(k,906) + lu(k,914) = lu(k,914) - lu(k,901) * lu(k,906) + lu(k,1000) = lu(k,1000) - lu(k,896) * lu(k,999) + lu(k,1001) = lu(k,1001) - lu(k,897) * lu(k,999) + lu(k,1004) = lu(k,1004) - lu(k,898) * lu(k,999) + lu(k,1007) = lu(k,1007) - lu(k,899) * lu(k,999) + lu(k,1008) = lu(k,1008) - lu(k,900) * lu(k,999) + lu(k,1009) = lu(k,1009) - lu(k,901) * lu(k,999) + lu(k,1489) = lu(k,1489) - lu(k,896) * lu(k,1488) + lu(k,1490) = lu(k,1490) - lu(k,897) * lu(k,1488) + lu(k,1493) = lu(k,1493) - lu(k,898) * lu(k,1488) + lu(k,1496) = lu(k,1496) - lu(k,899) * lu(k,1488) + lu(k,1497) = lu(k,1497) - lu(k,900) * lu(k,1488) + lu(k,1498) = lu(k,1498) - lu(k,901) * lu(k,1488) + lu(k,1576) = lu(k,1576) - lu(k,896) * lu(k,1575) + lu(k,1578) = lu(k,1578) - lu(k,897) * lu(k,1575) + lu(k,1584) = lu(k,1584) - lu(k,898) * lu(k,1575) + lu(k,1588) = lu(k,1588) - lu(k,899) * lu(k,1575) + lu(k,1590) = lu(k,1590) - lu(k,900) * lu(k,1575) + lu(k,1593) = lu(k,1593) - lu(k,901) * lu(k,1575) + lu(k,1931) = lu(k,1931) - lu(k,896) * lu(k,1930) + lu(k,1933) = lu(k,1933) - lu(k,897) * lu(k,1930) + lu(k,1941) = lu(k,1941) - lu(k,898) * lu(k,1930) + lu(k,1948) = lu(k,1948) - lu(k,899) * lu(k,1930) + lu(k,1950) = lu(k,1950) - lu(k,900) * lu(k,1930) + lu(k,1953) = lu(k,1953) - lu(k,901) * lu(k,1930) + lu(k,2193) = lu(k,2193) - lu(k,896) * lu(k,2192) + lu(k,2199) = lu(k,2199) - lu(k,897) * lu(k,2192) + lu(k,2227) = lu(k,2227) - lu(k,898) * lu(k,2192) + lu(k,2234) = lu(k,2234) - lu(k,899) * lu(k,2192) + lu(k,2236) = lu(k,2236) - lu(k,900) * lu(k,2192) + lu(k,2239) = lu(k,2239) - lu(k,901) * lu(k,2192) + lu(k,907) = 1._r8 / lu(k,907) + lu(k,908) = lu(k,908) * lu(k,907) + lu(k,909) = lu(k,909) * lu(k,907) + lu(k,910) = lu(k,910) * lu(k,907) + lu(k,911) = lu(k,911) * lu(k,907) + lu(k,912) = lu(k,912) * lu(k,907) + lu(k,913) = lu(k,913) * lu(k,907) + lu(k,914) = lu(k,914) * lu(k,907) + lu(k,1001) = lu(k,1001) - lu(k,908) * lu(k,1000) + lu(k,1002) = lu(k,1002) - lu(k,909) * lu(k,1000) + lu(k,1003) = lu(k,1003) - lu(k,910) * lu(k,1000) + lu(k,1004) = lu(k,1004) - lu(k,911) * lu(k,1000) + lu(k,1007) = lu(k,1007) - lu(k,912) * lu(k,1000) + lu(k,1008) = lu(k,1008) - lu(k,913) * lu(k,1000) + lu(k,1009) = lu(k,1009) - lu(k,914) * lu(k,1000) + lu(k,1490) = lu(k,1490) - lu(k,908) * lu(k,1489) + lu(k,1491) = lu(k,1491) - lu(k,909) * lu(k,1489) + lu(k,1492) = lu(k,1492) - lu(k,910) * lu(k,1489) + lu(k,1493) = lu(k,1493) - lu(k,911) * lu(k,1489) + lu(k,1496) = lu(k,1496) - lu(k,912) * lu(k,1489) + lu(k,1497) = lu(k,1497) - lu(k,913) * lu(k,1489) + lu(k,1498) = lu(k,1498) - lu(k,914) * lu(k,1489) + lu(k,1578) = lu(k,1578) - lu(k,908) * lu(k,1576) + lu(k,1579) = lu(k,1579) - lu(k,909) * lu(k,1576) + lu(k,1581) = lu(k,1581) - lu(k,910) * lu(k,1576) + lu(k,1584) = lu(k,1584) - lu(k,911) * lu(k,1576) + lu(k,1588) = lu(k,1588) - lu(k,912) * lu(k,1576) + lu(k,1590) = lu(k,1590) - lu(k,913) * lu(k,1576) + lu(k,1593) = lu(k,1593) - lu(k,914) * lu(k,1576) + lu(k,1933) = lu(k,1933) - lu(k,908) * lu(k,1931) + lu(k,1935) = lu(k,1935) - lu(k,909) * lu(k,1931) + lu(k,1936) = lu(k,1936) - lu(k,910) * lu(k,1931) + lu(k,1941) = lu(k,1941) - lu(k,911) * lu(k,1931) + lu(k,1948) = lu(k,1948) - lu(k,912) * lu(k,1931) + lu(k,1950) = lu(k,1950) - lu(k,913) * lu(k,1931) + lu(k,1953) = lu(k,1953) - lu(k,914) * lu(k,1931) + lu(k,2199) = lu(k,2199) - lu(k,908) * lu(k,2193) + lu(k,2209) = lu(k,2209) - lu(k,909) * lu(k,2193) + lu(k,2225) = lu(k,2225) - lu(k,910) * lu(k,2193) + lu(k,2227) = lu(k,2227) - lu(k,911) * lu(k,2193) + lu(k,2234) = lu(k,2234) - lu(k,912) * lu(k,2193) + lu(k,2236) = lu(k,2236) - lu(k,913) * lu(k,2193) + lu(k,2239) = lu(k,2239) - lu(k,914) * lu(k,2193) + end do + end subroutine lu_fac19 + subroutine lu_fac20( 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,915) = 1._r8 / lu(k,915) + lu(k,916) = lu(k,916) * lu(k,915) + lu(k,917) = lu(k,917) * lu(k,915) + lu(k,918) = lu(k,918) * lu(k,915) + lu(k,919) = lu(k,919) * lu(k,915) + lu(k,920) = lu(k,920) * lu(k,915) + lu(k,1161) = - lu(k,916) * lu(k,1156) + lu(k,1162) = - lu(k,917) * lu(k,1156) + lu(k,1166) = lu(k,1166) - lu(k,918) * lu(k,1156) + lu(k,1169) = - lu(k,919) * lu(k,1156) + lu(k,1170) = lu(k,1170) - lu(k,920) * lu(k,1156) + lu(k,1179) = - lu(k,916) * lu(k,1173) + lu(k,1180) = - lu(k,917) * lu(k,1173) + lu(k,1185) = lu(k,1185) - lu(k,918) * lu(k,1173) + lu(k,1190) = lu(k,1190) - lu(k,919) * lu(k,1173) + lu(k,1191) = lu(k,1191) - lu(k,920) * lu(k,1173) + lu(k,1297) = - lu(k,916) * lu(k,1290) + lu(k,1299) = lu(k,1299) - lu(k,917) * lu(k,1290) + lu(k,1303) = lu(k,1303) - lu(k,918) * lu(k,1290) + lu(k,1307) = lu(k,1307) - lu(k,919) * lu(k,1290) + lu(k,1308) = lu(k,1308) - lu(k,920) * lu(k,1290) + lu(k,1373) = lu(k,1373) - lu(k,916) * lu(k,1363) + lu(k,1378) = lu(k,1378) - lu(k,917) * lu(k,1363) + lu(k,1382) = lu(k,1382) - lu(k,918) * lu(k,1363) + lu(k,1387) = lu(k,1387) - lu(k,919) * lu(k,1363) + lu(k,1388) = lu(k,1388) - lu(k,920) * lu(k,1363) + lu(k,1673) = lu(k,1673) - lu(k,916) * lu(k,1654) + lu(k,1679) = lu(k,1679) - lu(k,917) * lu(k,1654) + lu(k,1687) = lu(k,1687) - lu(k,918) * lu(k,1654) + lu(k,1696) = lu(k,1696) - lu(k,919) * lu(k,1654) + lu(k,1697) = lu(k,1697) - lu(k,920) * lu(k,1654) + lu(k,1886) = lu(k,1886) - lu(k,916) * lu(k,1855) + lu(k,1892) = lu(k,1892) - lu(k,917) * lu(k,1855) + lu(k,1904) = lu(k,1904) - lu(k,918) * lu(k,1855) + lu(k,1913) = lu(k,1913) - lu(k,919) * lu(k,1855) + lu(k,1914) = lu(k,1914) - lu(k,920) * lu(k,1855) + lu(k,2218) = lu(k,2218) - lu(k,916) * lu(k,2194) + lu(k,2224) = lu(k,2224) - lu(k,917) * lu(k,2194) + lu(k,2233) = lu(k,2233) - lu(k,918) * lu(k,2194) + lu(k,2242) = lu(k,2242) - lu(k,919) * lu(k,2194) + lu(k,2243) = lu(k,2243) - lu(k,920) * lu(k,2194) + lu(k,2277) = lu(k,2277) - lu(k,916) * lu(k,2252) + lu(k,2283) = lu(k,2283) - lu(k,917) * lu(k,2252) + lu(k,2293) = lu(k,2293) - lu(k,918) * lu(k,2252) + lu(k,2302) = lu(k,2302) - lu(k,919) * lu(k,2252) + lu(k,2303) = lu(k,2303) - lu(k,920) * lu(k,2252) + lu(k,2396) = lu(k,2396) - lu(k,916) * lu(k,2375) + lu(k,2402) = lu(k,2402) - lu(k,917) * lu(k,2375) + lu(k,2413) = lu(k,2413) - lu(k,918) * lu(k,2375) + lu(k,2422) = lu(k,2422) - lu(k,919) * lu(k,2375) + lu(k,2423) = lu(k,2423) - lu(k,920) * lu(k,2375) + lu(k,924) = 1._r8 / lu(k,924) + lu(k,925) = lu(k,925) * lu(k,924) + lu(k,926) = lu(k,926) * lu(k,924) + lu(k,927) = lu(k,927) * lu(k,924) + lu(k,928) = lu(k,928) * lu(k,924) + lu(k,929) = lu(k,929) * lu(k,924) + lu(k,930) = lu(k,930) * lu(k,924) + lu(k,931) = lu(k,931) * lu(k,924) + lu(k,932) = lu(k,932) * lu(k,924) + lu(k,933) = lu(k,933) * lu(k,924) + lu(k,934) = lu(k,934) * lu(k,924) + lu(k,935) = lu(k,935) * lu(k,924) + lu(k,936) = lu(k,936) * lu(k,924) + lu(k,937) = lu(k,937) * lu(k,924) + lu(k,938) = lu(k,938) * lu(k,924) + lu(k,939) = lu(k,939) * lu(k,924) + lu(k,1859) = lu(k,1859) - lu(k,925) * lu(k,1856) + lu(k,1875) = lu(k,1875) - lu(k,926) * lu(k,1856) + lu(k,1877) = lu(k,1877) - lu(k,927) * lu(k,1856) + lu(k,1884) = - lu(k,928) * lu(k,1856) + lu(k,1885) = lu(k,1885) - lu(k,929) * lu(k,1856) + lu(k,1887) = lu(k,1887) - lu(k,930) * lu(k,1856) + lu(k,1888) = lu(k,1888) - lu(k,931) * lu(k,1856) + lu(k,1890) = lu(k,1890) - lu(k,932) * lu(k,1856) + lu(k,1892) = lu(k,1892) - lu(k,933) * lu(k,1856) + lu(k,1901) = lu(k,1901) - lu(k,934) * lu(k,1856) + lu(k,1904) = lu(k,1904) - lu(k,935) * lu(k,1856) + lu(k,1908) = lu(k,1908) - lu(k,936) * lu(k,1856) + lu(k,1911) = lu(k,1911) - lu(k,937) * lu(k,1856) + lu(k,1912) = lu(k,1912) - lu(k,938) * lu(k,1856) + lu(k,1913) = lu(k,1913) - lu(k,939) * lu(k,1856) + lu(k,2064) = lu(k,2064) - lu(k,925) * lu(k,2063) + lu(k,2075) = lu(k,2075) - lu(k,926) * lu(k,2063) + lu(k,2077) = lu(k,2077) - lu(k,927) * lu(k,2063) + lu(k,2082) = - lu(k,928) * lu(k,2063) + lu(k,2083) = lu(k,2083) - lu(k,929) * lu(k,2063) + lu(k,2085) = - lu(k,930) * lu(k,2063) + lu(k,2086) = - lu(k,931) * lu(k,2063) + lu(k,2088) = lu(k,2088) - lu(k,932) * lu(k,2063) + lu(k,2090) = lu(k,2090) - lu(k,933) * lu(k,2063) + lu(k,2097) = lu(k,2097) - lu(k,934) * lu(k,2063) + lu(k,2100) = lu(k,2100) - lu(k,935) * lu(k,2063) + lu(k,2104) = lu(k,2104) - lu(k,936) * lu(k,2063) + lu(k,2107) = lu(k,2107) - lu(k,937) * lu(k,2063) + lu(k,2108) = lu(k,2108) - lu(k,938) * lu(k,2063) + lu(k,2109) = lu(k,2109) - lu(k,939) * lu(k,2063) + lu(k,2254) = - lu(k,925) * lu(k,2253) + lu(k,2266) = lu(k,2266) - lu(k,926) * lu(k,2253) + lu(k,2268) = lu(k,2268) - lu(k,927) * lu(k,2253) + lu(k,2275) = lu(k,2275) - lu(k,928) * lu(k,2253) + lu(k,2276) = lu(k,2276) - lu(k,929) * lu(k,2253) + lu(k,2278) = lu(k,2278) - lu(k,930) * lu(k,2253) + lu(k,2279) = lu(k,2279) - lu(k,931) * lu(k,2253) + lu(k,2281) = lu(k,2281) - lu(k,932) * lu(k,2253) + lu(k,2283) = lu(k,2283) - lu(k,933) * lu(k,2253) + lu(k,2290) = - lu(k,934) * lu(k,2253) + lu(k,2293) = lu(k,2293) - lu(k,935) * lu(k,2253) + lu(k,2297) = - lu(k,936) * lu(k,2253) + lu(k,2300) = lu(k,2300) - lu(k,937) * lu(k,2253) + lu(k,2301) = lu(k,2301) - lu(k,938) * lu(k,2253) + lu(k,2302) = lu(k,2302) - lu(k,939) * lu(k,2253) + lu(k,941) = 1._r8 / lu(k,941) + lu(k,942) = lu(k,942) * lu(k,941) + lu(k,943) = lu(k,943) * lu(k,941) + lu(k,944) = lu(k,944) * lu(k,941) + lu(k,945) = lu(k,945) * lu(k,941) + lu(k,946) = lu(k,946) * lu(k,941) + lu(k,947) = lu(k,947) * lu(k,941) + lu(k,948) = lu(k,948) * lu(k,941) + lu(k,949) = lu(k,949) * lu(k,941) + lu(k,1503) = lu(k,1503) - lu(k,942) * lu(k,1502) + lu(k,1505) = - lu(k,943) * lu(k,1502) + lu(k,1506) = - lu(k,944) * lu(k,1502) + lu(k,1507) = - lu(k,945) * lu(k,1502) + lu(k,1508) = lu(k,1508) - lu(k,946) * lu(k,1502) + lu(k,1509) = lu(k,1509) - lu(k,947) * lu(k,1502) + lu(k,1513) = - lu(k,948) * lu(k,1502) + lu(k,1514) = lu(k,1514) - lu(k,949) * lu(k,1502) + lu(k,1626) = lu(k,1626) - lu(k,942) * lu(k,1623) + lu(k,1631) = lu(k,1631) - lu(k,943) * lu(k,1623) + lu(k,1632) = lu(k,1632) - lu(k,944) * lu(k,1623) + lu(k,1633) = - lu(k,945) * lu(k,1623) + lu(k,1634) = lu(k,1634) - lu(k,946) * lu(k,1623) + lu(k,1635) = lu(k,1635) - lu(k,947) * lu(k,1623) + lu(k,1642) = - lu(k,948) * lu(k,1623) + lu(k,1646) = lu(k,1646) - lu(k,949) * lu(k,1623) + lu(k,1701) = - lu(k,942) * lu(k,1700) + lu(k,1706) = - lu(k,943) * lu(k,1700) + lu(k,1707) = - lu(k,944) * lu(k,1700) + lu(k,1708) = lu(k,1708) - lu(k,945) * lu(k,1700) + lu(k,1709) = lu(k,1709) - lu(k,946) * lu(k,1700) + lu(k,1710) = lu(k,1710) - lu(k,947) * lu(k,1700) + lu(k,1717) = lu(k,1717) - lu(k,948) * lu(k,1700) + lu(k,1721) = lu(k,1721) - lu(k,949) * lu(k,1700) + lu(k,1894) = lu(k,1894) - lu(k,942) * lu(k,1857) + lu(k,1900) = lu(k,1900) - lu(k,943) * lu(k,1857) + lu(k,1901) = lu(k,1901) - lu(k,944) * lu(k,1857) + lu(k,1902) = lu(k,1902) - lu(k,945) * lu(k,1857) + lu(k,1903) = lu(k,1903) - lu(k,946) * lu(k,1857) + lu(k,1904) = lu(k,1904) - lu(k,947) * lu(k,1857) + lu(k,1911) = lu(k,1911) - lu(k,948) * lu(k,1857) + lu(k,1915) = lu(k,1915) - lu(k,949) * lu(k,1857) + lu(k,2027) = lu(k,2027) - lu(k,942) * lu(k,2026) + lu(k,2032) = lu(k,2032) - lu(k,943) * lu(k,2026) + lu(k,2033) = lu(k,2033) - lu(k,944) * lu(k,2026) + lu(k,2034) = - lu(k,945) * lu(k,2026) + lu(k,2035) = lu(k,2035) - lu(k,946) * lu(k,2026) + lu(k,2036) = lu(k,2036) - lu(k,947) * lu(k,2026) + lu(k,2043) = - lu(k,948) * lu(k,2026) + lu(k,2047) = lu(k,2047) - lu(k,949) * lu(k,2026) + lu(k,2501) = lu(k,2501) - lu(k,942) * lu(k,2499) + lu(k,2507) = - lu(k,943) * lu(k,2499) + lu(k,2508) = - lu(k,944) * lu(k,2499) + lu(k,2509) = - lu(k,945) * lu(k,2499) + lu(k,2510) = lu(k,2510) - lu(k,946) * lu(k,2499) + lu(k,2511) = lu(k,2511) - lu(k,947) * lu(k,2499) + lu(k,2518) = - lu(k,948) * lu(k,2499) + lu(k,2522) = lu(k,2522) - lu(k,949) * lu(k,2499) + end do + end subroutine lu_fac20 + subroutine lu_fac21( 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,953) = 1._r8 / lu(k,953) + lu(k,954) = lu(k,954) * lu(k,953) + lu(k,955) = lu(k,955) * lu(k,953) + lu(k,956) = lu(k,956) * lu(k,953) + lu(k,957) = lu(k,957) * lu(k,953) + lu(k,958) = lu(k,958) * lu(k,953) + lu(k,959) = lu(k,959) * lu(k,953) + lu(k,960) = lu(k,960) * lu(k,953) + lu(k,961) = lu(k,961) * lu(k,953) + lu(k,1074) = lu(k,1074) - lu(k,954) * lu(k,1071) + lu(k,1076) = - lu(k,955) * lu(k,1071) + lu(k,1077) = - lu(k,956) * lu(k,1071) + lu(k,1078) = lu(k,1078) - lu(k,957) * lu(k,1071) + lu(k,1079) = lu(k,1079) - lu(k,958) * lu(k,1071) + lu(k,1080) = lu(k,1080) - lu(k,959) * lu(k,1071) + lu(k,1081) = lu(k,1081) - lu(k,960) * lu(k,1071) + lu(k,1082) = lu(k,1082) - lu(k,961) * lu(k,1071) + lu(k,1664) = lu(k,1664) - lu(k,954) * lu(k,1655) + lu(k,1681) = lu(k,1681) - lu(k,955) * lu(k,1655) + lu(k,1684) = lu(k,1684) - lu(k,956) * lu(k,1655) + lu(k,1687) = lu(k,1687) - lu(k,957) * lu(k,1655) + lu(k,1693) = lu(k,1693) - lu(k,958) * lu(k,1655) + lu(k,1695) = lu(k,1695) - lu(k,959) * lu(k,1655) + lu(k,1696) = lu(k,1696) - lu(k,960) * lu(k,1655) + lu(k,1697) = lu(k,1697) - lu(k,961) * lu(k,1655) + lu(k,1876) = lu(k,1876) - lu(k,954) * lu(k,1858) + lu(k,1898) = lu(k,1898) - lu(k,955) * lu(k,1858) + lu(k,1901) = lu(k,1901) - lu(k,956) * lu(k,1858) + lu(k,1904) = lu(k,1904) - lu(k,957) * lu(k,1858) + lu(k,1910) = lu(k,1910) - lu(k,958) * lu(k,1858) + lu(k,1912) = lu(k,1912) - lu(k,959) * lu(k,1858) + lu(k,1913) = lu(k,1913) - lu(k,960) * lu(k,1858) + lu(k,1914) = lu(k,1914) - lu(k,961) * lu(k,1858) + lu(k,1977) = - lu(k,954) * lu(k,1971) + lu(k,1987) = lu(k,1987) - lu(k,955) * lu(k,1971) + lu(k,1990) = lu(k,1990) - lu(k,956) * lu(k,1971) + lu(k,1993) = lu(k,1993) - lu(k,957) * lu(k,1971) + lu(k,1999) = lu(k,1999) - lu(k,958) * lu(k,1971) + lu(k,2001) = lu(k,2001) - lu(k,959) * lu(k,1971) + lu(k,2002) = lu(k,2002) - lu(k,960) * lu(k,1971) + lu(k,2003) = lu(k,2003) - lu(k,961) * lu(k,1971) + lu(k,2208) = lu(k,2208) - lu(k,954) * lu(k,2195) + lu(k,2227) = lu(k,2227) - lu(k,955) * lu(k,2195) + lu(k,2230) = lu(k,2230) - lu(k,956) * lu(k,2195) + lu(k,2233) = lu(k,2233) - lu(k,957) * lu(k,2195) + lu(k,2239) = lu(k,2239) - lu(k,958) * lu(k,2195) + lu(k,2241) = lu(k,2241) - lu(k,959) * lu(k,2195) + lu(k,2242) = lu(k,2242) - lu(k,960) * lu(k,2195) + lu(k,2243) = lu(k,2243) - lu(k,961) * lu(k,2195) + lu(k,2387) = lu(k,2387) - lu(k,954) * lu(k,2376) + lu(k,2407) = lu(k,2407) - lu(k,955) * lu(k,2376) + lu(k,2410) = lu(k,2410) - lu(k,956) * lu(k,2376) + lu(k,2413) = lu(k,2413) - lu(k,957) * lu(k,2376) + lu(k,2419) = lu(k,2419) - lu(k,958) * lu(k,2376) + lu(k,2421) = lu(k,2421) - lu(k,959) * lu(k,2376) + lu(k,2422) = lu(k,2422) - lu(k,960) * lu(k,2376) + lu(k,2423) = lu(k,2423) - lu(k,961) * lu(k,2376) + lu(k,962) = 1._r8 / lu(k,962) + lu(k,963) = lu(k,963) * lu(k,962) + lu(k,964) = lu(k,964) * lu(k,962) + lu(k,965) = lu(k,965) * lu(k,962) + lu(k,966) = lu(k,966) * lu(k,962) + lu(k,1032) = lu(k,1032) - lu(k,963) * lu(k,1019) + lu(k,1033) = lu(k,1033) - lu(k,964) * lu(k,1019) + lu(k,1036) = lu(k,1036) - lu(k,965) * lu(k,1019) + lu(k,1038) = - lu(k,966) * lu(k,1019) + lu(k,1060) = lu(k,1060) - lu(k,963) * lu(k,1047) + lu(k,1061) = lu(k,1061) - lu(k,964) * lu(k,1047) + lu(k,1064) = lu(k,1064) - lu(k,965) * lu(k,1047) + lu(k,1066) = - lu(k,966) * lu(k,1047) + lu(k,1181) = lu(k,1181) - lu(k,963) * lu(k,1174) + lu(k,1185) = lu(k,1185) - lu(k,964) * lu(k,1174) + lu(k,1189) = lu(k,1189) - lu(k,965) * lu(k,1174) + lu(k,1192) = lu(k,1192) - lu(k,966) * lu(k,1174) + lu(k,1316) = - lu(k,963) * lu(k,1309) + lu(k,1317) = lu(k,1317) - lu(k,964) * lu(k,1309) + lu(k,1319) = lu(k,1319) - lu(k,965) * lu(k,1309) + lu(k,1321) = lu(k,1321) - lu(k,966) * lu(k,1309) + lu(k,1421) = lu(k,1421) - lu(k,963) * lu(k,1411) + lu(k,1426) = lu(k,1426) - lu(k,964) * lu(k,1411) + lu(k,1430) = lu(k,1430) - lu(k,965) * lu(k,1411) + lu(k,1433) = - lu(k,966) * lu(k,1411) + lu(k,1893) = lu(k,1893) - lu(k,963) * lu(k,1859) + lu(k,1904) = lu(k,1904) - lu(k,964) * lu(k,1859) + lu(k,1912) = lu(k,1912) - lu(k,965) * lu(k,1859) + lu(k,1915) = lu(k,1915) - lu(k,966) * lu(k,1859) + lu(k,1983) = - lu(k,963) * lu(k,1972) + lu(k,1993) = lu(k,1993) - lu(k,964) * lu(k,1972) + lu(k,2001) = lu(k,2001) - lu(k,965) * lu(k,1972) + lu(k,2004) = lu(k,2004) - lu(k,966) * lu(k,1972) + lu(k,2091) = lu(k,2091) - lu(k,963) * lu(k,2064) + lu(k,2100) = lu(k,2100) - lu(k,964) * lu(k,2064) + lu(k,2108) = lu(k,2108) - lu(k,965) * lu(k,2064) + lu(k,2111) = lu(k,2111) - lu(k,966) * lu(k,2064) + lu(k,2225) = lu(k,2225) - lu(k,963) * lu(k,2196) + lu(k,2233) = lu(k,2233) - lu(k,964) * lu(k,2196) + lu(k,2241) = lu(k,2241) - lu(k,965) * lu(k,2196) + lu(k,2244) = lu(k,2244) - lu(k,966) * lu(k,2196) + lu(k,2284) = - lu(k,963) * lu(k,2254) + lu(k,2293) = lu(k,2293) - lu(k,964) * lu(k,2254) + lu(k,2301) = lu(k,2301) - lu(k,965) * lu(k,2254) + lu(k,2304) = - lu(k,966) * lu(k,2254) + lu(k,2403) = lu(k,2403) - lu(k,963) * lu(k,2377) + lu(k,2413) = lu(k,2413) - lu(k,964) * lu(k,2377) + lu(k,2421) = lu(k,2421) - lu(k,965) * lu(k,2377) + lu(k,2424) = lu(k,2424) - lu(k,966) * lu(k,2377) + lu(k,2429) = - lu(k,963) * lu(k,2427) + lu(k,2439) = lu(k,2439) - lu(k,964) * lu(k,2427) + lu(k,2447) = lu(k,2447) - lu(k,965) * lu(k,2427) + lu(k,2450) = lu(k,2450) - lu(k,966) * lu(k,2427) + lu(k,967) = 1._r8 / lu(k,967) + lu(k,968) = lu(k,968) * lu(k,967) + lu(k,969) = lu(k,969) * lu(k,967) + lu(k,970) = lu(k,970) * lu(k,967) + lu(k,971) = lu(k,971) * lu(k,967) + lu(k,972) = lu(k,972) * lu(k,967) + lu(k,973) = lu(k,973) * lu(k,967) + lu(k,974) = lu(k,974) * lu(k,967) + lu(k,975) = lu(k,975) * lu(k,967) + lu(k,1158) = lu(k,1158) - lu(k,968) * lu(k,1157) + lu(k,1160) = lu(k,1160) - lu(k,969) * lu(k,1157) + lu(k,1161) = lu(k,1161) - lu(k,970) * lu(k,1157) + lu(k,1164) = - lu(k,971) * lu(k,1157) + lu(k,1166) = lu(k,1166) - lu(k,972) * lu(k,1157) + lu(k,1167) = - lu(k,973) * lu(k,1157) + lu(k,1168) = lu(k,1168) - lu(k,974) * lu(k,1157) + lu(k,1170) = lu(k,1170) - lu(k,975) * lu(k,1157) + lu(k,1365) = lu(k,1365) - lu(k,968) * lu(k,1364) + lu(k,1366) = lu(k,1366) - lu(k,969) * lu(k,1364) + lu(k,1373) = lu(k,1373) - lu(k,970) * lu(k,1364) + lu(k,1380) = lu(k,1380) - lu(k,971) * lu(k,1364) + lu(k,1382) = lu(k,1382) - lu(k,972) * lu(k,1364) + lu(k,1384) = lu(k,1384) - lu(k,973) * lu(k,1364) + lu(k,1386) = lu(k,1386) - lu(k,974) * lu(k,1364) + lu(k,1388) = lu(k,1388) - lu(k,975) * lu(k,1364) + lu(k,1867) = lu(k,1867) - lu(k,968) * lu(k,1860) + lu(k,1877) = lu(k,1877) - lu(k,969) * lu(k,1860) + lu(k,1886) = lu(k,1886) - lu(k,970) * lu(k,1860) + lu(k,1901) = lu(k,1901) - lu(k,971) * lu(k,1860) + lu(k,1904) = lu(k,1904) - lu(k,972) * lu(k,1860) + lu(k,1910) = lu(k,1910) - lu(k,973) * lu(k,1860) + lu(k,1912) = lu(k,1912) - lu(k,974) * lu(k,1860) + lu(k,1914) = lu(k,1914) - lu(k,975) * lu(k,1860) + lu(k,2201) = lu(k,2201) - lu(k,968) * lu(k,2197) + lu(k,2209) = lu(k,2209) - lu(k,969) * lu(k,2197) + lu(k,2218) = lu(k,2218) - lu(k,970) * lu(k,2197) + lu(k,2230) = lu(k,2230) - lu(k,971) * lu(k,2197) + lu(k,2233) = lu(k,2233) - lu(k,972) * lu(k,2197) + lu(k,2239) = lu(k,2239) - lu(k,973) * lu(k,2197) + lu(k,2241) = lu(k,2241) - lu(k,974) * lu(k,2197) + lu(k,2243) = lu(k,2243) - lu(k,975) * lu(k,2197) + lu(k,2381) = lu(k,2381) - lu(k,968) * lu(k,2378) + lu(k,2388) = lu(k,2388) - lu(k,969) * lu(k,2378) + lu(k,2396) = lu(k,2396) - lu(k,970) * lu(k,2378) + lu(k,2410) = lu(k,2410) - lu(k,971) * lu(k,2378) + lu(k,2413) = lu(k,2413) - lu(k,972) * lu(k,2378) + lu(k,2419) = lu(k,2419) - lu(k,973) * lu(k,2378) + lu(k,2421) = lu(k,2421) - lu(k,974) * lu(k,2378) + lu(k,2423) = lu(k,2423) - lu(k,975) * lu(k,2378) + lu(k,2467) = lu(k,2467) - lu(k,968) * lu(k,2464) + lu(k,2469) = lu(k,2469) - lu(k,969) * lu(k,2464) + lu(k,2471) = lu(k,2471) - lu(k,970) * lu(k,2464) + lu(k,2481) = lu(k,2481) - lu(k,971) * lu(k,2464) + lu(k,2484) = lu(k,2484) - lu(k,972) * lu(k,2464) + lu(k,2490) = lu(k,2490) - lu(k,973) * lu(k,2464) + lu(k,2492) = lu(k,2492) - lu(k,974) * lu(k,2464) + lu(k,2494) = lu(k,2494) - lu(k,975) * lu(k,2464) + lu(k,977) = 1._r8 / lu(k,977) + lu(k,978) = lu(k,978) * lu(k,977) + lu(k,979) = lu(k,979) * lu(k,977) + lu(k,980) = lu(k,980) * lu(k,977) + lu(k,981) = lu(k,981) * lu(k,977) + lu(k,982) = lu(k,982) * lu(k,977) + lu(k,983) = lu(k,983) * lu(k,977) + lu(k,984) = lu(k,984) * lu(k,977) + lu(k,985) = lu(k,985) * lu(k,977) + lu(k,986) = lu(k,986) * lu(k,977) + lu(k,987) = lu(k,987) * lu(k,977) + lu(k,1660) = lu(k,1660) - lu(k,978) * lu(k,1656) + lu(k,1664) = lu(k,1664) - lu(k,979) * lu(k,1656) + lu(k,1681) = lu(k,1681) - lu(k,980) * lu(k,1656) + lu(k,1684) = lu(k,1684) - lu(k,981) * lu(k,1656) + lu(k,1687) = lu(k,1687) - lu(k,982) * lu(k,1656) + lu(k,1693) = lu(k,1693) - lu(k,983) * lu(k,1656) + lu(k,1695) = lu(k,1695) - lu(k,984) * lu(k,1656) + lu(k,1696) = lu(k,1696) - lu(k,985) * lu(k,1656) + lu(k,1697) = lu(k,1697) - lu(k,986) * lu(k,1656) + lu(k,1698) = lu(k,1698) - lu(k,987) * lu(k,1656) + lu(k,1870) = lu(k,1870) - lu(k,978) * lu(k,1861) + lu(k,1876) = lu(k,1876) - lu(k,979) * lu(k,1861) + lu(k,1898) = lu(k,1898) - lu(k,980) * lu(k,1861) + lu(k,1901) = lu(k,1901) - lu(k,981) * lu(k,1861) + lu(k,1904) = lu(k,1904) - lu(k,982) * lu(k,1861) + lu(k,1910) = lu(k,1910) - lu(k,983) * lu(k,1861) + lu(k,1912) = lu(k,1912) - lu(k,984) * lu(k,1861) + lu(k,1913) = lu(k,1913) - lu(k,985) * lu(k,1861) + lu(k,1914) = lu(k,1914) - lu(k,986) * lu(k,1861) + lu(k,1915) = lu(k,1915) - lu(k,987) * lu(k,1861) + lu(k,1975) = - lu(k,978) * lu(k,1973) + lu(k,1977) = lu(k,1977) - lu(k,979) * lu(k,1973) + lu(k,1987) = lu(k,1987) - lu(k,980) * lu(k,1973) + lu(k,1990) = lu(k,1990) - lu(k,981) * lu(k,1973) + lu(k,1993) = lu(k,1993) - lu(k,982) * lu(k,1973) + lu(k,1999) = lu(k,1999) - lu(k,983) * lu(k,1973) + lu(k,2001) = lu(k,2001) - lu(k,984) * lu(k,1973) + lu(k,2002) = lu(k,2002) - lu(k,985) * lu(k,1973) + lu(k,2003) = lu(k,2003) - lu(k,986) * lu(k,1973) + lu(k,2004) = lu(k,2004) - lu(k,987) * lu(k,1973) + lu(k,2204) = lu(k,2204) - lu(k,978) * lu(k,2198) + lu(k,2208) = lu(k,2208) - lu(k,979) * lu(k,2198) + lu(k,2227) = lu(k,2227) - lu(k,980) * lu(k,2198) + lu(k,2230) = lu(k,2230) - lu(k,981) * lu(k,2198) + lu(k,2233) = lu(k,2233) - lu(k,982) * lu(k,2198) + lu(k,2239) = lu(k,2239) - lu(k,983) * lu(k,2198) + lu(k,2241) = lu(k,2241) - lu(k,984) * lu(k,2198) + lu(k,2242) = lu(k,2242) - lu(k,985) * lu(k,2198) + lu(k,2243) = lu(k,2243) - lu(k,986) * lu(k,2198) + lu(k,2244) = lu(k,2244) - lu(k,987) * lu(k,2198) + lu(k,2384) = lu(k,2384) - lu(k,978) * lu(k,2379) + lu(k,2387) = lu(k,2387) - lu(k,979) * lu(k,2379) + lu(k,2407) = lu(k,2407) - lu(k,980) * lu(k,2379) + lu(k,2410) = lu(k,2410) - lu(k,981) * lu(k,2379) + lu(k,2413) = lu(k,2413) - lu(k,982) * lu(k,2379) + lu(k,2419) = lu(k,2419) - lu(k,983) * lu(k,2379) + lu(k,2421) = lu(k,2421) - lu(k,984) * lu(k,2379) + lu(k,2422) = lu(k,2422) - lu(k,985) * lu(k,2379) + lu(k,2423) = lu(k,2423) - lu(k,986) * lu(k,2379) + lu(k,2424) = lu(k,2424) - lu(k,987) * lu(k,2379) + lu(k,989) = 1._r8 / lu(k,989) + lu(k,990) = lu(k,990) * lu(k,989) + lu(k,991) = lu(k,991) * lu(k,989) + lu(k,992) = lu(k,992) * lu(k,989) + lu(k,993) = lu(k,993) * lu(k,989) + lu(k,994) = lu(k,994) * lu(k,989) + lu(k,1518) = lu(k,1518) - lu(k,990) * lu(k,1517) + lu(k,1523) = lu(k,1523) - lu(k,991) * lu(k,1517) + lu(k,1524) = lu(k,1524) - lu(k,992) * lu(k,1517) + lu(k,1529) = - lu(k,993) * lu(k,1517) + lu(k,1531) = - lu(k,994) * lu(k,1517) + lu(k,1582) = lu(k,1582) - lu(k,990) * lu(k,1577) + lu(k,1587) = lu(k,1587) - lu(k,991) * lu(k,1577) + lu(k,1588) = lu(k,1588) - lu(k,992) * lu(k,1577) + lu(k,1594) = lu(k,1594) - lu(k,993) * lu(k,1577) + lu(k,1597) = - lu(k,994) * lu(k,1577) + lu(k,1603) = lu(k,1603) - lu(k,990) * lu(k,1602) + lu(k,1610) = lu(k,1610) - lu(k,991) * lu(k,1602) + lu(k,1611) = lu(k,1611) - lu(k,992) * lu(k,1602) + lu(k,1618) = lu(k,1618) - lu(k,993) * lu(k,1602) + lu(k,1621) = lu(k,1621) - lu(k,994) * lu(k,1602) + lu(k,1895) = lu(k,1895) - lu(k,990) * lu(k,1862) + lu(k,1904) = lu(k,1904) - lu(k,991) * lu(k,1862) + lu(k,1905) = lu(k,1905) - lu(k,992) * lu(k,1862) + lu(k,1912) = lu(k,1912) - lu(k,993) * lu(k,1862) + lu(k,1915) = lu(k,1915) - lu(k,994) * lu(k,1862) + lu(k,1938) = lu(k,1938) - lu(k,990) * lu(k,1932) + lu(k,1947) = lu(k,1947) - lu(k,991) * lu(k,1932) + lu(k,1948) = lu(k,1948) - lu(k,992) * lu(k,1932) + lu(k,1955) = lu(k,1955) - lu(k,993) * lu(k,1932) + lu(k,1958) = lu(k,1958) - lu(k,994) * lu(k,1932) + lu(k,2092) = lu(k,2092) - lu(k,990) * lu(k,2065) + lu(k,2100) = lu(k,2100) - lu(k,991) * lu(k,2065) + lu(k,2101) = lu(k,2101) - lu(k,992) * lu(k,2065) + lu(k,2108) = lu(k,2108) - lu(k,993) * lu(k,2065) + lu(k,2111) = lu(k,2111) - lu(k,994) * lu(k,2065) + lu(k,2119) = lu(k,2119) - lu(k,990) * lu(k,2117) + lu(k,2127) = lu(k,2127) - lu(k,991) * lu(k,2117) + lu(k,2128) = lu(k,2128) - lu(k,992) * lu(k,2117) + lu(k,2135) = lu(k,2135) - lu(k,993) * lu(k,2117) + lu(k,2138) = lu(k,2138) - lu(k,994) * lu(k,2117) + lu(k,2285) = - lu(k,990) * lu(k,2255) + lu(k,2293) = lu(k,2293) - lu(k,991) * lu(k,2255) + lu(k,2294) = lu(k,2294) - lu(k,992) * lu(k,2255) + lu(k,2301) = lu(k,2301) - lu(k,993) * lu(k,2255) + lu(k,2304) = lu(k,2304) - lu(k,994) * lu(k,2255) + lu(k,2475) = lu(k,2475) - lu(k,990) * lu(k,2465) + lu(k,2484) = lu(k,2484) - lu(k,991) * lu(k,2465) + lu(k,2485) = lu(k,2485) - lu(k,992) * lu(k,2465) + lu(k,2492) = lu(k,2492) - lu(k,993) * lu(k,2465) + lu(k,2495) = lu(k,2495) - lu(k,994) * lu(k,2465) + lu(k,2502) = - lu(k,990) * lu(k,2500) + lu(k,2511) = lu(k,2511) - lu(k,991) * lu(k,2500) + lu(k,2512) = lu(k,2512) - lu(k,992) * lu(k,2500) + lu(k,2519) = - lu(k,993) * lu(k,2500) + lu(k,2522) = lu(k,2522) - lu(k,994) * lu(k,2500) + end do + end subroutine lu_fac21 + subroutine lu_fac22( 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,1001) = 1._r8 / lu(k,1001) + lu(k,1002) = lu(k,1002) * lu(k,1001) + lu(k,1003) = lu(k,1003) * lu(k,1001) + lu(k,1004) = lu(k,1004) * lu(k,1001) + lu(k,1005) = lu(k,1005) * lu(k,1001) + lu(k,1006) = lu(k,1006) * lu(k,1001) + lu(k,1007) = lu(k,1007) * lu(k,1001) + lu(k,1008) = lu(k,1008) * lu(k,1001) + lu(k,1009) = lu(k,1009) * lu(k,1001) + lu(k,1010) = lu(k,1010) * lu(k,1001) + lu(k,1491) = lu(k,1491) - lu(k,1002) * lu(k,1490) + lu(k,1492) = lu(k,1492) - lu(k,1003) * lu(k,1490) + lu(k,1493) = lu(k,1493) - lu(k,1004) * lu(k,1490) + lu(k,1494) = - lu(k,1005) * lu(k,1490) + lu(k,1495) = - lu(k,1006) * lu(k,1490) + lu(k,1496) = lu(k,1496) - lu(k,1007) * lu(k,1490) + lu(k,1497) = lu(k,1497) - lu(k,1008) * lu(k,1490) + lu(k,1498) = lu(k,1498) - lu(k,1009) * lu(k,1490) + lu(k,1500) = - lu(k,1010) * lu(k,1490) + lu(k,1579) = lu(k,1579) - lu(k,1002) * lu(k,1578) + lu(k,1581) = lu(k,1581) - lu(k,1003) * lu(k,1578) + lu(k,1584) = lu(k,1584) - lu(k,1004) * lu(k,1578) + lu(k,1586) = lu(k,1586) - lu(k,1005) * lu(k,1578) + lu(k,1587) = lu(k,1587) - lu(k,1006) * lu(k,1578) + lu(k,1588) = lu(k,1588) - lu(k,1007) * lu(k,1578) + lu(k,1590) = lu(k,1590) - lu(k,1008) * lu(k,1578) + lu(k,1593) = lu(k,1593) - lu(k,1009) * lu(k,1578) + lu(k,1596) = - lu(k,1010) * lu(k,1578) + lu(k,1877) = lu(k,1877) - lu(k,1002) * lu(k,1863) + lu(k,1893) = lu(k,1893) - lu(k,1003) * lu(k,1863) + lu(k,1898) = lu(k,1898) - lu(k,1004) * lu(k,1863) + lu(k,1903) = lu(k,1903) - lu(k,1005) * lu(k,1863) + lu(k,1904) = lu(k,1904) - lu(k,1006) * lu(k,1863) + lu(k,1905) = lu(k,1905) - lu(k,1007) * lu(k,1863) + lu(k,1907) = lu(k,1907) - lu(k,1008) * lu(k,1863) + lu(k,1910) = lu(k,1910) - lu(k,1009) * lu(k,1863) + lu(k,1914) = lu(k,1914) - lu(k,1010) * lu(k,1863) + lu(k,1935) = lu(k,1935) - lu(k,1002) * lu(k,1933) + lu(k,1936) = lu(k,1936) - lu(k,1003) * lu(k,1933) + lu(k,1941) = lu(k,1941) - lu(k,1004) * lu(k,1933) + lu(k,1946) = lu(k,1946) - lu(k,1005) * lu(k,1933) + lu(k,1947) = lu(k,1947) - lu(k,1006) * lu(k,1933) + lu(k,1948) = lu(k,1948) - lu(k,1007) * lu(k,1933) + lu(k,1950) = lu(k,1950) - lu(k,1008) * lu(k,1933) + lu(k,1953) = lu(k,1953) - lu(k,1009) * lu(k,1933) + lu(k,1957) = lu(k,1957) - lu(k,1010) * lu(k,1933) + lu(k,2209) = lu(k,2209) - lu(k,1002) * lu(k,2199) + lu(k,2225) = lu(k,2225) - lu(k,1003) * lu(k,2199) + lu(k,2227) = lu(k,2227) - lu(k,1004) * lu(k,2199) + lu(k,2232) = - lu(k,1005) * lu(k,2199) + lu(k,2233) = lu(k,2233) - lu(k,1006) * lu(k,2199) + lu(k,2234) = lu(k,2234) - lu(k,1007) * lu(k,2199) + lu(k,2236) = lu(k,2236) - lu(k,1008) * lu(k,2199) + lu(k,2239) = lu(k,2239) - lu(k,1009) * lu(k,2199) + lu(k,2243) = lu(k,2243) - lu(k,1010) * lu(k,2199) + lu(k,2469) = lu(k,2469) - lu(k,1002) * lu(k,2466) + lu(k,2474) = lu(k,2474) - lu(k,1003) * lu(k,2466) + lu(k,2478) = lu(k,2478) - lu(k,1004) * lu(k,2466) + lu(k,2483) = - lu(k,1005) * lu(k,2466) + lu(k,2484) = lu(k,2484) - lu(k,1006) * lu(k,2466) + lu(k,2485) = lu(k,2485) - lu(k,1007) * lu(k,2466) + lu(k,2487) = lu(k,2487) - lu(k,1008) * lu(k,2466) + lu(k,2490) = lu(k,2490) - lu(k,1009) * lu(k,2466) + lu(k,2494) = lu(k,2494) - lu(k,1010) * lu(k,2466) + lu(k,1020) = 1._r8 / lu(k,1020) + lu(k,1021) = lu(k,1021) * lu(k,1020) + lu(k,1022) = lu(k,1022) * lu(k,1020) + lu(k,1023) = lu(k,1023) * lu(k,1020) + lu(k,1024) = lu(k,1024) * lu(k,1020) + lu(k,1025) = lu(k,1025) * lu(k,1020) + lu(k,1026) = lu(k,1026) * lu(k,1020) + lu(k,1027) = lu(k,1027) * lu(k,1020) + lu(k,1028) = lu(k,1028) * lu(k,1020) + lu(k,1029) = lu(k,1029) * lu(k,1020) + lu(k,1030) = lu(k,1030) * lu(k,1020) + lu(k,1031) = lu(k,1031) * lu(k,1020) + lu(k,1032) = lu(k,1032) * lu(k,1020) + lu(k,1033) = lu(k,1033) * lu(k,1020) + lu(k,1034) = lu(k,1034) * lu(k,1020) + lu(k,1035) = lu(k,1035) * lu(k,1020) + lu(k,1036) = lu(k,1036) * lu(k,1020) + lu(k,1037) = lu(k,1037) * lu(k,1020) + lu(k,1038) = lu(k,1038) * lu(k,1020) + lu(k,1866) = lu(k,1866) - lu(k,1021) * lu(k,1864) + lu(k,1867) = lu(k,1867) - lu(k,1022) * lu(k,1864) + lu(k,1868) = lu(k,1868) - lu(k,1023) * lu(k,1864) + lu(k,1869) = lu(k,1869) - lu(k,1024) * lu(k,1864) + lu(k,1870) = lu(k,1870) - lu(k,1025) * lu(k,1864) + lu(k,1872) = lu(k,1872) - lu(k,1026) * lu(k,1864) + lu(k,1873) = lu(k,1873) - lu(k,1027) * lu(k,1864) + lu(k,1877) = lu(k,1877) - lu(k,1028) * lu(k,1864) + lu(k,1882) = lu(k,1882) - lu(k,1029) * lu(k,1864) + lu(k,1886) = lu(k,1886) - lu(k,1030) * lu(k,1864) + lu(k,1892) = lu(k,1892) - lu(k,1031) * lu(k,1864) + lu(k,1893) = lu(k,1893) - lu(k,1032) * lu(k,1864) + lu(k,1904) = lu(k,1904) - lu(k,1033) * lu(k,1864) + lu(k,1908) = lu(k,1908) - lu(k,1034) * lu(k,1864) + lu(k,1911) = lu(k,1911) - lu(k,1035) * lu(k,1864) + lu(k,1912) = lu(k,1912) - lu(k,1036) * lu(k,1864) + lu(k,1913) = lu(k,1913) - lu(k,1037) * lu(k,1864) + lu(k,1915) = lu(k,1915) - lu(k,1038) * lu(k,1864) + lu(k,2068) = lu(k,2068) - lu(k,1021) * lu(k,2066) + lu(k,2069) = lu(k,2069) - lu(k,1022) * lu(k,2066) + lu(k,2070) = - lu(k,1023) * lu(k,2066) + lu(k,2071) = lu(k,2071) - lu(k,1024) * lu(k,2066) + lu(k,2072) = lu(k,2072) - lu(k,1025) * lu(k,2066) + lu(k,2073) = - lu(k,1026) * lu(k,2066) + lu(k,2074) = lu(k,2074) - lu(k,1027) * lu(k,2066) + lu(k,2077) = lu(k,2077) - lu(k,1028) * lu(k,2066) + lu(k,2081) = lu(k,2081) - lu(k,1029) * lu(k,2066) + lu(k,2084) = lu(k,2084) - lu(k,1030) * lu(k,2066) + lu(k,2090) = lu(k,2090) - lu(k,1031) * lu(k,2066) + lu(k,2091) = lu(k,2091) - lu(k,1032) * lu(k,2066) + lu(k,2100) = lu(k,2100) - lu(k,1033) * lu(k,2066) + lu(k,2104) = lu(k,2104) - lu(k,1034) * lu(k,2066) + lu(k,2107) = lu(k,2107) - lu(k,1035) * lu(k,2066) + lu(k,2108) = lu(k,2108) - lu(k,1036) * lu(k,2066) + lu(k,2109) = lu(k,2109) - lu(k,1037) * lu(k,2066) + lu(k,2111) = lu(k,2111) - lu(k,1038) * lu(k,2066) + lu(k,2258) = - lu(k,1021) * lu(k,2256) + lu(k,2259) = lu(k,2259) - lu(k,1022) * lu(k,2256) + lu(k,2260) = - lu(k,1023) * lu(k,2256) + lu(k,2261) = lu(k,2261) - lu(k,1024) * lu(k,2256) + lu(k,2262) = lu(k,2262) - lu(k,1025) * lu(k,2256) + lu(k,2263) = lu(k,2263) - lu(k,1026) * lu(k,2256) + lu(k,2264) = - lu(k,1027) * lu(k,2256) + lu(k,2268) = lu(k,2268) - lu(k,1028) * lu(k,2256) + lu(k,2273) = - lu(k,1029) * lu(k,2256) + lu(k,2277) = lu(k,2277) - lu(k,1030) * lu(k,2256) + lu(k,2283) = lu(k,2283) - lu(k,1031) * lu(k,2256) + lu(k,2284) = lu(k,2284) - lu(k,1032) * lu(k,2256) + lu(k,2293) = lu(k,2293) - lu(k,1033) * lu(k,2256) + lu(k,2297) = lu(k,2297) - lu(k,1034) * lu(k,2256) + lu(k,2300) = lu(k,2300) - lu(k,1035) * lu(k,2256) + lu(k,2301) = lu(k,2301) - lu(k,1036) * lu(k,2256) + lu(k,2302) = lu(k,2302) - lu(k,1037) * lu(k,2256) + lu(k,2304) = lu(k,2304) - lu(k,1038) * lu(k,2256) + 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,1055) = lu(k,1055) * lu(k,1048) + lu(k,1056) = lu(k,1056) * lu(k,1048) + lu(k,1057) = lu(k,1057) * lu(k,1048) + lu(k,1058) = lu(k,1058) * lu(k,1048) + lu(k,1059) = lu(k,1059) * lu(k,1048) + lu(k,1060) = lu(k,1060) * lu(k,1048) + lu(k,1061) = lu(k,1061) * lu(k,1048) + lu(k,1062) = lu(k,1062) * lu(k,1048) + lu(k,1063) = lu(k,1063) * lu(k,1048) + lu(k,1064) = lu(k,1064) * lu(k,1048) + lu(k,1065) = lu(k,1065) * lu(k,1048) + lu(k,1066) = lu(k,1066) * lu(k,1048) + lu(k,1866) = lu(k,1866) - lu(k,1049) * lu(k,1865) + lu(k,1867) = lu(k,1867) - lu(k,1050) * lu(k,1865) + lu(k,1868) = lu(k,1868) - lu(k,1051) * lu(k,1865) + lu(k,1869) = lu(k,1869) - lu(k,1052) * lu(k,1865) + lu(k,1870) = lu(k,1870) - lu(k,1053) * lu(k,1865) + lu(k,1872) = lu(k,1872) - lu(k,1054) * lu(k,1865) + lu(k,1873) = lu(k,1873) - lu(k,1055) * lu(k,1865) + lu(k,1877) = lu(k,1877) - lu(k,1056) * lu(k,1865) + lu(k,1882) = lu(k,1882) - lu(k,1057) * lu(k,1865) + lu(k,1886) = lu(k,1886) - lu(k,1058) * lu(k,1865) + lu(k,1892) = lu(k,1892) - lu(k,1059) * lu(k,1865) + lu(k,1893) = lu(k,1893) - lu(k,1060) * lu(k,1865) + lu(k,1904) = lu(k,1904) - lu(k,1061) * lu(k,1865) + lu(k,1908) = lu(k,1908) - lu(k,1062) * lu(k,1865) + lu(k,1911) = lu(k,1911) - lu(k,1063) * lu(k,1865) + lu(k,1912) = lu(k,1912) - lu(k,1064) * lu(k,1865) + lu(k,1913) = lu(k,1913) - lu(k,1065) * lu(k,1865) + lu(k,1915) = lu(k,1915) - lu(k,1066) * lu(k,1865) + lu(k,2068) = lu(k,2068) - lu(k,1049) * lu(k,2067) + lu(k,2069) = lu(k,2069) - lu(k,1050) * lu(k,2067) + lu(k,2070) = lu(k,2070) - lu(k,1051) * lu(k,2067) + lu(k,2071) = lu(k,2071) - lu(k,1052) * lu(k,2067) + lu(k,2072) = lu(k,2072) - lu(k,1053) * lu(k,2067) + lu(k,2073) = lu(k,2073) - lu(k,1054) * lu(k,2067) + lu(k,2074) = lu(k,2074) - lu(k,1055) * lu(k,2067) + lu(k,2077) = lu(k,2077) - lu(k,1056) * lu(k,2067) + lu(k,2081) = lu(k,2081) - lu(k,1057) * lu(k,2067) + lu(k,2084) = lu(k,2084) - lu(k,1058) * lu(k,2067) + lu(k,2090) = lu(k,2090) - lu(k,1059) * lu(k,2067) + lu(k,2091) = lu(k,2091) - lu(k,1060) * lu(k,2067) + lu(k,2100) = lu(k,2100) - lu(k,1061) * lu(k,2067) + lu(k,2104) = lu(k,2104) - lu(k,1062) * lu(k,2067) + lu(k,2107) = lu(k,2107) - lu(k,1063) * lu(k,2067) + lu(k,2108) = lu(k,2108) - lu(k,1064) * lu(k,2067) + lu(k,2109) = lu(k,2109) - lu(k,1065) * lu(k,2067) + lu(k,2111) = lu(k,2111) - lu(k,1066) * lu(k,2067) + lu(k,2258) = lu(k,2258) - lu(k,1049) * lu(k,2257) + lu(k,2259) = lu(k,2259) - lu(k,1050) * lu(k,2257) + lu(k,2260) = lu(k,2260) - lu(k,1051) * lu(k,2257) + lu(k,2261) = lu(k,2261) - lu(k,1052) * lu(k,2257) + lu(k,2262) = lu(k,2262) - lu(k,1053) * lu(k,2257) + lu(k,2263) = lu(k,2263) - lu(k,1054) * lu(k,2257) + lu(k,2264) = lu(k,2264) - lu(k,1055) * lu(k,2257) + lu(k,2268) = lu(k,2268) - lu(k,1056) * lu(k,2257) + lu(k,2273) = lu(k,2273) - lu(k,1057) * lu(k,2257) + lu(k,2277) = lu(k,2277) - lu(k,1058) * lu(k,2257) + lu(k,2283) = lu(k,2283) - lu(k,1059) * lu(k,2257) + lu(k,2284) = lu(k,2284) - lu(k,1060) * lu(k,2257) + lu(k,2293) = lu(k,2293) - lu(k,1061) * lu(k,2257) + lu(k,2297) = lu(k,2297) - lu(k,1062) * lu(k,2257) + lu(k,2300) = lu(k,2300) - lu(k,1063) * lu(k,2257) + lu(k,2301) = lu(k,2301) - lu(k,1064) * lu(k,2257) + lu(k,2302) = lu(k,2302) - lu(k,1065) * lu(k,2257) + lu(k,2304) = lu(k,2304) - lu(k,1066) * lu(k,2257) + end do + end subroutine lu_fac22 + subroutine lu_fac23( 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,1072) = 1._r8 / lu(k,1072) + lu(k,1073) = lu(k,1073) * lu(k,1072) + lu(k,1074) = lu(k,1074) * lu(k,1072) + lu(k,1075) = lu(k,1075) * lu(k,1072) + lu(k,1076) = lu(k,1076) * lu(k,1072) + lu(k,1077) = lu(k,1077) * lu(k,1072) + lu(k,1078) = lu(k,1078) * lu(k,1072) + lu(k,1079) = lu(k,1079) * lu(k,1072) + lu(k,1080) = lu(k,1080) * lu(k,1072) + lu(k,1081) = lu(k,1081) * lu(k,1072) + lu(k,1082) = lu(k,1082) * lu(k,1072) + lu(k,1870) = lu(k,1870) - lu(k,1073) * lu(k,1866) + lu(k,1876) = lu(k,1876) - lu(k,1074) * lu(k,1866) + lu(k,1892) = lu(k,1892) - lu(k,1075) * lu(k,1866) + lu(k,1898) = lu(k,1898) - lu(k,1076) * lu(k,1866) + lu(k,1901) = lu(k,1901) - lu(k,1077) * lu(k,1866) + lu(k,1904) = lu(k,1904) - lu(k,1078) * lu(k,1866) + lu(k,1910) = lu(k,1910) - lu(k,1079) * lu(k,1866) + lu(k,1912) = lu(k,1912) - lu(k,1080) * lu(k,1866) + lu(k,1913) = lu(k,1913) - lu(k,1081) * lu(k,1866) + lu(k,1914) = lu(k,1914) - lu(k,1082) * lu(k,1866) + lu(k,2072) = lu(k,2072) - lu(k,1073) * lu(k,2068) + lu(k,2076) = lu(k,2076) - lu(k,1074) * lu(k,2068) + lu(k,2090) = lu(k,2090) - lu(k,1075) * lu(k,2068) + lu(k,2094) = lu(k,2094) - lu(k,1076) * lu(k,2068) + lu(k,2097) = lu(k,2097) - lu(k,1077) * lu(k,2068) + lu(k,2100) = lu(k,2100) - lu(k,1078) * lu(k,2068) + lu(k,2106) = lu(k,2106) - lu(k,1079) * lu(k,2068) + lu(k,2108) = lu(k,2108) - lu(k,1080) * lu(k,2068) + lu(k,2109) = lu(k,2109) - lu(k,1081) * lu(k,2068) + lu(k,2110) = lu(k,2110) - lu(k,1082) * lu(k,2068) + lu(k,2204) = lu(k,2204) - lu(k,1073) * lu(k,2200) + lu(k,2208) = lu(k,2208) - lu(k,1074) * lu(k,2200) + lu(k,2224) = lu(k,2224) - lu(k,1075) * lu(k,2200) + lu(k,2227) = lu(k,2227) - lu(k,1076) * lu(k,2200) + lu(k,2230) = lu(k,2230) - lu(k,1077) * lu(k,2200) + lu(k,2233) = lu(k,2233) - lu(k,1078) * lu(k,2200) + lu(k,2239) = lu(k,2239) - lu(k,1079) * lu(k,2200) + lu(k,2241) = lu(k,2241) - lu(k,1080) * lu(k,2200) + lu(k,2242) = lu(k,2242) - lu(k,1081) * lu(k,2200) + lu(k,2243) = lu(k,2243) - lu(k,1082) * lu(k,2200) + lu(k,2262) = lu(k,2262) - lu(k,1073) * lu(k,2258) + lu(k,2267) = lu(k,2267) - lu(k,1074) * lu(k,2258) + lu(k,2283) = lu(k,2283) - lu(k,1075) * lu(k,2258) + lu(k,2287) = lu(k,2287) - lu(k,1076) * lu(k,2258) + lu(k,2290) = lu(k,2290) - lu(k,1077) * lu(k,2258) + lu(k,2293) = lu(k,2293) - lu(k,1078) * lu(k,2258) + lu(k,2299) = lu(k,2299) - lu(k,1079) * lu(k,2258) + lu(k,2301) = lu(k,2301) - lu(k,1080) * lu(k,2258) + lu(k,2302) = lu(k,2302) - lu(k,1081) * lu(k,2258) + lu(k,2303) = lu(k,2303) - lu(k,1082) * lu(k,2258) + lu(k,2384) = lu(k,2384) - lu(k,1073) * lu(k,2380) + lu(k,2387) = lu(k,2387) - lu(k,1074) * lu(k,2380) + lu(k,2402) = lu(k,2402) - lu(k,1075) * lu(k,2380) + lu(k,2407) = lu(k,2407) - lu(k,1076) * lu(k,2380) + lu(k,2410) = lu(k,2410) - lu(k,1077) * lu(k,2380) + lu(k,2413) = lu(k,2413) - lu(k,1078) * lu(k,2380) + lu(k,2419) = lu(k,2419) - lu(k,1079) * lu(k,2380) + lu(k,2421) = lu(k,2421) - lu(k,1080) * lu(k,2380) + lu(k,2422) = lu(k,2422) - lu(k,1081) * lu(k,2380) + lu(k,2423) = lu(k,2423) - lu(k,1082) * lu(k,2380) + lu(k,1084) = 1._r8 / lu(k,1084) + lu(k,1085) = lu(k,1085) * lu(k,1084) + lu(k,1086) = lu(k,1086) * lu(k,1084) + lu(k,1087) = lu(k,1087) * lu(k,1084) + lu(k,1088) = lu(k,1088) * lu(k,1084) + lu(k,1160) = lu(k,1160) - lu(k,1085) * lu(k,1158) + lu(k,1163) = - lu(k,1086) * lu(k,1158) + lu(k,1166) = lu(k,1166) - lu(k,1087) * lu(k,1158) + lu(k,1168) = lu(k,1168) - lu(k,1088) * lu(k,1158) + lu(k,1207) = lu(k,1207) - lu(k,1085) * lu(k,1206) + lu(k,1209) = lu(k,1209) - lu(k,1086) * lu(k,1206) + lu(k,1210) = lu(k,1210) - lu(k,1087) * lu(k,1206) + lu(k,1211) = lu(k,1211) - lu(k,1088) * lu(k,1206) + lu(k,1272) = lu(k,1272) - lu(k,1085) * lu(k,1271) + lu(k,1278) = lu(k,1278) - lu(k,1086) * lu(k,1271) + lu(k,1280) = lu(k,1280) - lu(k,1087) * lu(k,1271) + lu(k,1283) = lu(k,1283) - lu(k,1088) * lu(k,1271) + lu(k,1366) = lu(k,1366) - lu(k,1085) * lu(k,1365) + lu(k,1379) = - lu(k,1086) * lu(k,1365) + lu(k,1382) = lu(k,1382) - lu(k,1087) * lu(k,1365) + lu(k,1386) = lu(k,1386) - lu(k,1088) * lu(k,1365) + lu(k,1458) = lu(k,1458) - lu(k,1085) * lu(k,1456) + lu(k,1471) = lu(k,1471) - lu(k,1086) * lu(k,1456) + lu(k,1476) = lu(k,1476) - lu(k,1087) * lu(k,1456) + lu(k,1480) = lu(k,1480) - lu(k,1088) * lu(k,1456) + lu(k,1665) = lu(k,1665) - lu(k,1085) * lu(k,1657) + lu(k,1680) = lu(k,1680) - lu(k,1086) * lu(k,1657) + lu(k,1687) = lu(k,1687) - lu(k,1087) * lu(k,1657) + lu(k,1695) = lu(k,1695) - lu(k,1088) * lu(k,1657) + lu(k,1877) = lu(k,1877) - lu(k,1085) * lu(k,1867) + lu(k,1893) = lu(k,1893) - lu(k,1086) * lu(k,1867) + lu(k,1904) = lu(k,1904) - lu(k,1087) * lu(k,1867) + lu(k,1912) = lu(k,1912) - lu(k,1088) * lu(k,1867) + lu(k,1978) = lu(k,1978) - lu(k,1085) * lu(k,1974) + lu(k,1983) = lu(k,1983) - lu(k,1086) * lu(k,1974) + lu(k,1993) = lu(k,1993) - lu(k,1087) * lu(k,1974) + lu(k,2001) = lu(k,2001) - lu(k,1088) * lu(k,1974) + lu(k,2077) = lu(k,2077) - lu(k,1085) * lu(k,2069) + lu(k,2091) = lu(k,2091) - lu(k,1086) * lu(k,2069) + lu(k,2100) = lu(k,2100) - lu(k,1087) * lu(k,2069) + lu(k,2108) = lu(k,2108) - lu(k,1088) * lu(k,2069) + lu(k,2209) = lu(k,2209) - lu(k,1085) * lu(k,2201) + lu(k,2225) = lu(k,2225) - lu(k,1086) * lu(k,2201) + lu(k,2233) = lu(k,2233) - lu(k,1087) * lu(k,2201) + lu(k,2241) = lu(k,2241) - lu(k,1088) * lu(k,2201) + lu(k,2268) = lu(k,2268) - lu(k,1085) * lu(k,2259) + lu(k,2284) = lu(k,2284) - lu(k,1086) * lu(k,2259) + lu(k,2293) = lu(k,2293) - lu(k,1087) * lu(k,2259) + lu(k,2301) = lu(k,2301) - lu(k,1088) * lu(k,2259) + lu(k,2388) = lu(k,2388) - lu(k,1085) * lu(k,2381) + lu(k,2403) = lu(k,2403) - lu(k,1086) * lu(k,2381) + lu(k,2413) = lu(k,2413) - lu(k,1087) * lu(k,2381) + lu(k,2421) = lu(k,2421) - lu(k,1088) * lu(k,2381) + lu(k,2469) = lu(k,2469) - lu(k,1085) * lu(k,2467) + lu(k,2474) = lu(k,2474) - lu(k,1086) * lu(k,2467) + lu(k,2484) = lu(k,2484) - lu(k,1087) * lu(k,2467) + lu(k,2492) = lu(k,2492) - lu(k,1088) * lu(k,2467) + lu(k,1092) = 1._r8 / lu(k,1092) + lu(k,1093) = lu(k,1093) * lu(k,1092) + lu(k,1094) = lu(k,1094) * lu(k,1092) + lu(k,1095) = lu(k,1095) * lu(k,1092) + lu(k,1096) = lu(k,1096) * lu(k,1092) + lu(k,1097) = lu(k,1097) * lu(k,1092) + lu(k,1098) = lu(k,1098) * lu(k,1092) + lu(k,1099) = lu(k,1099) * lu(k,1092) + lu(k,1100) = lu(k,1100) * lu(k,1092) + lu(k,1101) = lu(k,1101) * lu(k,1092) + lu(k,1659) = lu(k,1659) - lu(k,1093) * lu(k,1658) + lu(k,1660) = lu(k,1660) - lu(k,1094) * lu(k,1658) + lu(k,1684) = lu(k,1684) - lu(k,1095) * lu(k,1658) + lu(k,1685) = lu(k,1685) - lu(k,1096) * lu(k,1658) + lu(k,1687) = lu(k,1687) - lu(k,1097) * lu(k,1658) + lu(k,1693) = lu(k,1693) - lu(k,1098) * lu(k,1658) + lu(k,1695) = lu(k,1695) - lu(k,1099) * lu(k,1658) + lu(k,1696) = lu(k,1696) - lu(k,1100) * lu(k,1658) + lu(k,1697) = lu(k,1697) - lu(k,1101) * lu(k,1658) + lu(k,1869) = lu(k,1869) - lu(k,1093) * lu(k,1868) + lu(k,1870) = lu(k,1870) - lu(k,1094) * lu(k,1868) + lu(k,1901) = lu(k,1901) - lu(k,1095) * lu(k,1868) + lu(k,1902) = lu(k,1902) - lu(k,1096) * lu(k,1868) + lu(k,1904) = lu(k,1904) - lu(k,1097) * lu(k,1868) + lu(k,1910) = lu(k,1910) - lu(k,1098) * lu(k,1868) + lu(k,1912) = lu(k,1912) - lu(k,1099) * lu(k,1868) + lu(k,1913) = lu(k,1913) - lu(k,1100) * lu(k,1868) + lu(k,1914) = lu(k,1914) - lu(k,1101) * lu(k,1868) + lu(k,2071) = lu(k,2071) - lu(k,1093) * lu(k,2070) + lu(k,2072) = lu(k,2072) - lu(k,1094) * lu(k,2070) + lu(k,2097) = lu(k,2097) - lu(k,1095) * lu(k,2070) + lu(k,2098) = - lu(k,1096) * lu(k,2070) + lu(k,2100) = lu(k,2100) - lu(k,1097) * lu(k,2070) + lu(k,2106) = lu(k,2106) - lu(k,1098) * lu(k,2070) + lu(k,2108) = lu(k,2108) - lu(k,1099) * lu(k,2070) + lu(k,2109) = lu(k,2109) - lu(k,1100) * lu(k,2070) + lu(k,2110) = lu(k,2110) - lu(k,1101) * lu(k,2070) + lu(k,2203) = lu(k,2203) - lu(k,1093) * lu(k,2202) + lu(k,2204) = lu(k,2204) - lu(k,1094) * lu(k,2202) + lu(k,2230) = lu(k,2230) - lu(k,1095) * lu(k,2202) + lu(k,2231) = lu(k,2231) - lu(k,1096) * lu(k,2202) + lu(k,2233) = lu(k,2233) - lu(k,1097) * lu(k,2202) + lu(k,2239) = lu(k,2239) - lu(k,1098) * lu(k,2202) + lu(k,2241) = lu(k,2241) - lu(k,1099) * lu(k,2202) + lu(k,2242) = lu(k,2242) - lu(k,1100) * lu(k,2202) + lu(k,2243) = lu(k,2243) - lu(k,1101) * lu(k,2202) + lu(k,2261) = lu(k,2261) - lu(k,1093) * lu(k,2260) + lu(k,2262) = lu(k,2262) - lu(k,1094) * lu(k,2260) + lu(k,2290) = lu(k,2290) - lu(k,1095) * lu(k,2260) + lu(k,2291) = lu(k,2291) - lu(k,1096) * lu(k,2260) + lu(k,2293) = lu(k,2293) - lu(k,1097) * lu(k,2260) + lu(k,2299) = lu(k,2299) - lu(k,1098) * lu(k,2260) + lu(k,2301) = lu(k,2301) - lu(k,1099) * lu(k,2260) + lu(k,2302) = lu(k,2302) - lu(k,1100) * lu(k,2260) + lu(k,2303) = lu(k,2303) - lu(k,1101) * lu(k,2260) + lu(k,2383) = lu(k,2383) - lu(k,1093) * lu(k,2382) + lu(k,2384) = lu(k,2384) - lu(k,1094) * lu(k,2382) + lu(k,2410) = lu(k,2410) - lu(k,1095) * lu(k,2382) + lu(k,2411) = lu(k,2411) - lu(k,1096) * lu(k,2382) + lu(k,2413) = lu(k,2413) - lu(k,1097) * lu(k,2382) + lu(k,2419) = lu(k,2419) - lu(k,1098) * lu(k,2382) + lu(k,2421) = lu(k,2421) - lu(k,1099) * lu(k,2382) + lu(k,2422) = lu(k,2422) - lu(k,1100) * lu(k,2382) + lu(k,2423) = lu(k,2423) - lu(k,1101) * lu(k,2382) + lu(k,1102) = 1._r8 / lu(k,1102) + lu(k,1103) = lu(k,1103) * lu(k,1102) + lu(k,1104) = lu(k,1104) * lu(k,1102) + lu(k,1105) = lu(k,1105) * lu(k,1102) + lu(k,1106) = lu(k,1106) * lu(k,1102) + lu(k,1107) = lu(k,1107) * lu(k,1102) + lu(k,1108) = lu(k,1108) * lu(k,1102) + lu(k,1109) = lu(k,1109) * lu(k,1102) + lu(k,1132) = lu(k,1132) - lu(k,1103) * lu(k,1131) + lu(k,1133) = - lu(k,1104) * lu(k,1131) + lu(k,1134) = - lu(k,1105) * lu(k,1131) + lu(k,1135) = - lu(k,1106) * lu(k,1131) + lu(k,1138) = lu(k,1138) - lu(k,1107) * lu(k,1131) + lu(k,1140) = lu(k,1140) - lu(k,1108) * lu(k,1131) + lu(k,1141) = lu(k,1141) - lu(k,1109) * lu(k,1131) + lu(k,1661) = lu(k,1661) - lu(k,1103) * lu(k,1659) + lu(k,1662) = lu(k,1662) - lu(k,1104) * lu(k,1659) + lu(k,1665) = lu(k,1665) - lu(k,1105) * lu(k,1659) + lu(k,1667) = lu(k,1667) - lu(k,1106) * lu(k,1659) + lu(k,1687) = lu(k,1687) - lu(k,1107) * lu(k,1659) + lu(k,1694) = - lu(k,1108) * lu(k,1659) + lu(k,1695) = lu(k,1695) - lu(k,1109) * lu(k,1659) + lu(k,1872) = lu(k,1872) - lu(k,1103) * lu(k,1869) + lu(k,1873) = lu(k,1873) - lu(k,1104) * lu(k,1869) + lu(k,1877) = lu(k,1877) - lu(k,1105) * lu(k,1869) + lu(k,1879) = lu(k,1879) - lu(k,1106) * lu(k,1869) + lu(k,1904) = lu(k,1904) - lu(k,1107) * lu(k,1869) + lu(k,1911) = lu(k,1911) - lu(k,1108) * lu(k,1869) + lu(k,1912) = lu(k,1912) - lu(k,1109) * lu(k,1869) + lu(k,2073) = lu(k,2073) - lu(k,1103) * lu(k,2071) + lu(k,2074) = lu(k,2074) - lu(k,1104) * lu(k,2071) + lu(k,2077) = lu(k,2077) - lu(k,1105) * lu(k,2071) + lu(k,2079) = - lu(k,1106) * lu(k,2071) + lu(k,2100) = lu(k,2100) - lu(k,1107) * lu(k,2071) + lu(k,2107) = lu(k,2107) - lu(k,1108) * lu(k,2071) + lu(k,2108) = lu(k,2108) - lu(k,1109) * lu(k,2071) + lu(k,2205) = lu(k,2205) - lu(k,1103) * lu(k,2203) + lu(k,2206) = lu(k,2206) - lu(k,1104) * lu(k,2203) + lu(k,2209) = lu(k,2209) - lu(k,1105) * lu(k,2203) + lu(k,2211) = lu(k,2211) - lu(k,1106) * lu(k,2203) + lu(k,2233) = lu(k,2233) - lu(k,1107) * lu(k,2203) + lu(k,2240) = lu(k,2240) - lu(k,1108) * lu(k,2203) + lu(k,2241) = lu(k,2241) - lu(k,1109) * lu(k,2203) + lu(k,2263) = lu(k,2263) - lu(k,1103) * lu(k,2261) + lu(k,2264) = lu(k,2264) - lu(k,1104) * lu(k,2261) + lu(k,2268) = lu(k,2268) - lu(k,1105) * lu(k,2261) + lu(k,2270) = lu(k,2270) - lu(k,1106) * lu(k,2261) + lu(k,2293) = lu(k,2293) - lu(k,1107) * lu(k,2261) + lu(k,2300) = lu(k,2300) - lu(k,1108) * lu(k,2261) + lu(k,2301) = lu(k,2301) - lu(k,1109) * lu(k,2261) + lu(k,2385) = lu(k,2385) - lu(k,1103) * lu(k,2383) + lu(k,2386) = lu(k,2386) - lu(k,1104) * lu(k,2383) + lu(k,2388) = lu(k,2388) - lu(k,1105) * lu(k,2383) + lu(k,2390) = lu(k,2390) - lu(k,1106) * lu(k,2383) + lu(k,2413) = lu(k,2413) - lu(k,1107) * lu(k,2383) + lu(k,2420) = lu(k,2420) - lu(k,1108) * lu(k,2383) + lu(k,2421) = lu(k,2421) - lu(k,1109) * lu(k,2383) + lu(k,1110) = 1._r8 / lu(k,1110) + lu(k,1111) = lu(k,1111) * lu(k,1110) + lu(k,1112) = lu(k,1112) * lu(k,1110) + lu(k,1113) = lu(k,1113) * lu(k,1110) + lu(k,1114) = lu(k,1114) * lu(k,1110) + lu(k,1115) = lu(k,1115) * lu(k,1110) + lu(k,1147) = lu(k,1147) - lu(k,1111) * lu(k,1144) + lu(k,1148) = lu(k,1148) - lu(k,1112) * lu(k,1144) + lu(k,1150) = - lu(k,1113) * lu(k,1144) + lu(k,1151) = lu(k,1151) - lu(k,1114) * lu(k,1144) + lu(k,1154) = - lu(k,1115) * lu(k,1144) + lu(k,1221) = - lu(k,1111) * lu(k,1216) + lu(k,1222) = - lu(k,1112) * lu(k,1216) + lu(k,1224) = lu(k,1224) - lu(k,1113) * lu(k,1216) + lu(k,1226) = lu(k,1226) - lu(k,1114) * lu(k,1216) + lu(k,1231) = - lu(k,1115) * lu(k,1216) + lu(k,1239) = - lu(k,1111) * lu(k,1233) + lu(k,1240) = lu(k,1240) - lu(k,1112) * lu(k,1233) + lu(k,1242) = - lu(k,1113) * lu(k,1233) + lu(k,1244) = lu(k,1244) - lu(k,1114) * lu(k,1233) + lu(k,1249) = - lu(k,1115) * lu(k,1233) + lu(k,1669) = lu(k,1669) - lu(k,1111) * lu(k,1660) + lu(k,1679) = lu(k,1679) - lu(k,1112) * lu(k,1660) + lu(k,1684) = lu(k,1684) - lu(k,1113) * lu(k,1660) + lu(k,1687) = lu(k,1687) - lu(k,1114) * lu(k,1660) + lu(k,1698) = lu(k,1698) - lu(k,1115) * lu(k,1660) + lu(k,1882) = lu(k,1882) - lu(k,1111) * lu(k,1870) + lu(k,1892) = lu(k,1892) - lu(k,1112) * lu(k,1870) + lu(k,1901) = lu(k,1901) - lu(k,1113) * lu(k,1870) + lu(k,1904) = lu(k,1904) - lu(k,1114) * lu(k,1870) + lu(k,1915) = lu(k,1915) - lu(k,1115) * lu(k,1870) + lu(k,1980) = - lu(k,1111) * lu(k,1975) + lu(k,1982) = - lu(k,1112) * lu(k,1975) + lu(k,1990) = lu(k,1990) - lu(k,1113) * lu(k,1975) + lu(k,1993) = lu(k,1993) - lu(k,1114) * lu(k,1975) + lu(k,2004) = lu(k,2004) - lu(k,1115) * lu(k,1975) + lu(k,2081) = lu(k,2081) - lu(k,1111) * lu(k,2072) + lu(k,2090) = lu(k,2090) - lu(k,1112) * lu(k,2072) + lu(k,2097) = lu(k,2097) - lu(k,1113) * lu(k,2072) + lu(k,2100) = lu(k,2100) - lu(k,1114) * lu(k,2072) + lu(k,2111) = lu(k,2111) - lu(k,1115) * lu(k,2072) + lu(k,2214) = lu(k,2214) - lu(k,1111) * lu(k,2204) + lu(k,2224) = lu(k,2224) - lu(k,1112) * lu(k,2204) + lu(k,2230) = lu(k,2230) - lu(k,1113) * lu(k,2204) + lu(k,2233) = lu(k,2233) - lu(k,1114) * lu(k,2204) + lu(k,2244) = lu(k,2244) - lu(k,1115) * lu(k,2204) + lu(k,2273) = lu(k,2273) - lu(k,1111) * lu(k,2262) + lu(k,2283) = lu(k,2283) - lu(k,1112) * lu(k,2262) + lu(k,2290) = lu(k,2290) - lu(k,1113) * lu(k,2262) + lu(k,2293) = lu(k,2293) - lu(k,1114) * lu(k,2262) + lu(k,2304) = lu(k,2304) - lu(k,1115) * lu(k,2262) + lu(k,2392) = lu(k,2392) - lu(k,1111) * lu(k,2384) + lu(k,2402) = lu(k,2402) - lu(k,1112) * lu(k,2384) + lu(k,2410) = lu(k,2410) - lu(k,1113) * lu(k,2384) + lu(k,2413) = lu(k,2413) - lu(k,1114) * lu(k,2384) + lu(k,2424) = lu(k,2424) - lu(k,1115) * lu(k,2384) + end do + end subroutine lu_fac23 + subroutine lu_fac24( 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,1118) = 1._r8 / lu(k,1118) + lu(k,1119) = lu(k,1119) * lu(k,1118) + lu(k,1120) = lu(k,1120) * lu(k,1118) + lu(k,1121) = lu(k,1121) * lu(k,1118) + lu(k,1122) = lu(k,1122) * lu(k,1118) + lu(k,1123) = lu(k,1123) * lu(k,1118) + lu(k,1124) = lu(k,1124) * lu(k,1118) + lu(k,1125) = lu(k,1125) * lu(k,1118) + lu(k,1126) = lu(k,1126) * lu(k,1118) + lu(k,1127) = lu(k,1127) * lu(k,1118) + lu(k,1537) = lu(k,1537) - lu(k,1119) * lu(k,1536) + lu(k,1540) = lu(k,1540) - lu(k,1120) * lu(k,1536) + lu(k,1542) = lu(k,1542) - lu(k,1121) * lu(k,1536) + lu(k,1543) = lu(k,1543) - lu(k,1122) * lu(k,1536) + lu(k,1544) = lu(k,1544) - lu(k,1123) * lu(k,1536) + lu(k,1546) = lu(k,1546) - lu(k,1124) * lu(k,1536) + lu(k,1547) = - lu(k,1125) * lu(k,1536) + lu(k,1548) = - lu(k,1126) * lu(k,1536) + lu(k,1549) = lu(k,1549) - lu(k,1127) * lu(k,1536) + lu(k,1896) = lu(k,1896) - lu(k,1119) * lu(k,1871) + lu(k,1902) = lu(k,1902) - lu(k,1120) * lu(k,1871) + lu(k,1904) = lu(k,1904) - lu(k,1121) * lu(k,1871) + lu(k,1905) = lu(k,1905) - lu(k,1122) * lu(k,1871) + lu(k,1906) = lu(k,1906) - lu(k,1123) * lu(k,1871) + lu(k,1909) = lu(k,1909) - lu(k,1124) * lu(k,1871) + lu(k,1911) = lu(k,1911) - lu(k,1125) * lu(k,1871) + lu(k,1914) = lu(k,1914) - lu(k,1126) * lu(k,1871) + lu(k,1915) = lu(k,1915) - lu(k,1127) * lu(k,1871) + lu(k,1939) = lu(k,1939) - lu(k,1119) * lu(k,1934) + lu(k,1945) = lu(k,1945) - lu(k,1120) * lu(k,1934) + lu(k,1947) = lu(k,1947) - lu(k,1121) * lu(k,1934) + lu(k,1948) = lu(k,1948) - lu(k,1122) * lu(k,1934) + lu(k,1949) = lu(k,1949) - lu(k,1123) * lu(k,1934) + lu(k,1952) = lu(k,1952) - lu(k,1124) * lu(k,1934) + lu(k,1954) = lu(k,1954) - lu(k,1125) * lu(k,1934) + lu(k,1957) = lu(k,1957) - lu(k,1126) * lu(k,1934) + lu(k,1958) = lu(k,1958) - lu(k,1127) * lu(k,1934) + lu(k,1985) = lu(k,1985) - lu(k,1119) * lu(k,1976) + lu(k,1991) = - lu(k,1120) * lu(k,1976) + lu(k,1993) = lu(k,1993) - lu(k,1121) * lu(k,1976) + lu(k,1994) = lu(k,1994) - lu(k,1122) * lu(k,1976) + lu(k,1995) = lu(k,1995) - lu(k,1123) * lu(k,1976) + lu(k,1998) = lu(k,1998) - lu(k,1124) * lu(k,1976) + lu(k,2000) = lu(k,2000) - lu(k,1125) * lu(k,1976) + lu(k,2003) = lu(k,2003) - lu(k,1126) * lu(k,1976) + lu(k,2004) = lu(k,2004) - lu(k,1127) * lu(k,1976) + lu(k,2120) = lu(k,2120) - lu(k,1119) * lu(k,2118) + lu(k,2125) = - lu(k,1120) * lu(k,2118) + lu(k,2127) = lu(k,2127) - lu(k,1121) * lu(k,2118) + lu(k,2128) = lu(k,2128) - lu(k,1122) * lu(k,2118) + lu(k,2129) = lu(k,2129) - lu(k,1123) * lu(k,2118) + lu(k,2132) = lu(k,2132) - lu(k,1124) * lu(k,2118) + lu(k,2134) = - lu(k,1125) * lu(k,2118) + lu(k,2137) = lu(k,2137) - lu(k,1126) * lu(k,2118) + lu(k,2138) = lu(k,2138) - lu(k,1127) * lu(k,2118) + lu(k,2476) = lu(k,2476) - lu(k,1119) * lu(k,2468) + lu(k,2482) = lu(k,2482) - lu(k,1120) * lu(k,2468) + lu(k,2484) = lu(k,2484) - lu(k,1121) * lu(k,2468) + lu(k,2485) = lu(k,2485) - lu(k,1122) * lu(k,2468) + lu(k,2486) = lu(k,2486) - lu(k,1123) * lu(k,2468) + lu(k,2489) = lu(k,2489) - lu(k,1124) * lu(k,2468) + lu(k,2491) = lu(k,2491) - lu(k,1125) * lu(k,2468) + lu(k,2494) = lu(k,2494) - lu(k,1126) * lu(k,2468) + lu(k,2495) = lu(k,2495) - lu(k,1127) * lu(k,2468) + lu(k,1132) = 1._r8 / lu(k,1132) + lu(k,1133) = lu(k,1133) * lu(k,1132) + lu(k,1134) = lu(k,1134) * lu(k,1132) + lu(k,1135) = lu(k,1135) * lu(k,1132) + lu(k,1136) = lu(k,1136) * lu(k,1132) + lu(k,1137) = lu(k,1137) * lu(k,1132) + lu(k,1138) = lu(k,1138) * lu(k,1132) + lu(k,1139) = lu(k,1139) * lu(k,1132) + lu(k,1140) = lu(k,1140) * lu(k,1132) + lu(k,1141) = lu(k,1141) * lu(k,1132) + lu(k,1142) = lu(k,1142) * lu(k,1132) + lu(k,1143) = lu(k,1143) * lu(k,1132) + lu(k,1662) = lu(k,1662) - lu(k,1133) * lu(k,1661) + lu(k,1665) = lu(k,1665) - lu(k,1134) * lu(k,1661) + lu(k,1667) = lu(k,1667) - lu(k,1135) * lu(k,1661) + lu(k,1684) = lu(k,1684) - lu(k,1136) * lu(k,1661) + lu(k,1685) = lu(k,1685) - lu(k,1137) * lu(k,1661) + lu(k,1687) = lu(k,1687) - lu(k,1138) * lu(k,1661) + lu(k,1693) = lu(k,1693) - lu(k,1139) * lu(k,1661) + lu(k,1694) = lu(k,1694) - lu(k,1140) * lu(k,1661) + lu(k,1695) = lu(k,1695) - lu(k,1141) * lu(k,1661) + lu(k,1696) = lu(k,1696) - lu(k,1142) * lu(k,1661) + lu(k,1697) = lu(k,1697) - lu(k,1143) * lu(k,1661) + lu(k,1873) = lu(k,1873) - lu(k,1133) * lu(k,1872) + lu(k,1877) = lu(k,1877) - lu(k,1134) * lu(k,1872) + lu(k,1879) = lu(k,1879) - lu(k,1135) * lu(k,1872) + lu(k,1901) = lu(k,1901) - lu(k,1136) * lu(k,1872) + lu(k,1902) = lu(k,1902) - lu(k,1137) * lu(k,1872) + lu(k,1904) = lu(k,1904) - lu(k,1138) * lu(k,1872) + lu(k,1910) = lu(k,1910) - lu(k,1139) * lu(k,1872) + lu(k,1911) = lu(k,1911) - lu(k,1140) * lu(k,1872) + lu(k,1912) = lu(k,1912) - lu(k,1141) * lu(k,1872) + lu(k,1913) = lu(k,1913) - lu(k,1142) * lu(k,1872) + lu(k,1914) = lu(k,1914) - lu(k,1143) * lu(k,1872) + lu(k,2074) = lu(k,2074) - lu(k,1133) * lu(k,2073) + lu(k,2077) = lu(k,2077) - lu(k,1134) * lu(k,2073) + lu(k,2079) = lu(k,2079) - lu(k,1135) * lu(k,2073) + lu(k,2097) = lu(k,2097) - lu(k,1136) * lu(k,2073) + lu(k,2098) = lu(k,2098) - lu(k,1137) * lu(k,2073) + lu(k,2100) = lu(k,2100) - lu(k,1138) * lu(k,2073) + lu(k,2106) = lu(k,2106) - lu(k,1139) * lu(k,2073) + lu(k,2107) = lu(k,2107) - lu(k,1140) * lu(k,2073) + lu(k,2108) = lu(k,2108) - lu(k,1141) * lu(k,2073) + lu(k,2109) = lu(k,2109) - lu(k,1142) * lu(k,2073) + lu(k,2110) = lu(k,2110) - lu(k,1143) * lu(k,2073) + lu(k,2206) = lu(k,2206) - lu(k,1133) * lu(k,2205) + lu(k,2209) = lu(k,2209) - lu(k,1134) * lu(k,2205) + lu(k,2211) = lu(k,2211) - lu(k,1135) * lu(k,2205) + lu(k,2230) = lu(k,2230) - lu(k,1136) * lu(k,2205) + lu(k,2231) = lu(k,2231) - lu(k,1137) * lu(k,2205) + lu(k,2233) = lu(k,2233) - lu(k,1138) * lu(k,2205) + lu(k,2239) = lu(k,2239) - lu(k,1139) * lu(k,2205) + lu(k,2240) = lu(k,2240) - lu(k,1140) * lu(k,2205) + lu(k,2241) = lu(k,2241) - lu(k,1141) * lu(k,2205) + lu(k,2242) = lu(k,2242) - lu(k,1142) * lu(k,2205) + lu(k,2243) = lu(k,2243) - lu(k,1143) * lu(k,2205) + lu(k,2264) = lu(k,2264) - lu(k,1133) * lu(k,2263) + lu(k,2268) = lu(k,2268) - lu(k,1134) * lu(k,2263) + lu(k,2270) = lu(k,2270) - lu(k,1135) * lu(k,2263) + lu(k,2290) = lu(k,2290) - lu(k,1136) * lu(k,2263) + lu(k,2291) = lu(k,2291) - lu(k,1137) * lu(k,2263) + lu(k,2293) = lu(k,2293) - lu(k,1138) * lu(k,2263) + lu(k,2299) = lu(k,2299) - lu(k,1139) * lu(k,2263) + lu(k,2300) = lu(k,2300) - lu(k,1140) * lu(k,2263) + lu(k,2301) = lu(k,2301) - lu(k,1141) * lu(k,2263) + lu(k,2302) = lu(k,2302) - lu(k,1142) * lu(k,2263) + lu(k,2303) = lu(k,2303) - lu(k,1143) * lu(k,2263) + lu(k,2386) = lu(k,2386) - lu(k,1133) * lu(k,2385) + lu(k,2388) = lu(k,2388) - lu(k,1134) * lu(k,2385) + lu(k,2390) = lu(k,2390) - lu(k,1135) * lu(k,2385) + lu(k,2410) = lu(k,2410) - lu(k,1136) * lu(k,2385) + lu(k,2411) = lu(k,2411) - lu(k,1137) * lu(k,2385) + lu(k,2413) = lu(k,2413) - lu(k,1138) * lu(k,2385) + lu(k,2419) = lu(k,2419) - lu(k,1139) * lu(k,2385) + lu(k,2420) = lu(k,2420) - lu(k,1140) * lu(k,2385) + lu(k,2421) = lu(k,2421) - lu(k,1141) * lu(k,2385) + lu(k,2422) = lu(k,2422) - lu(k,1142) * lu(k,2385) + lu(k,2423) = lu(k,2423) - lu(k,1143) * lu(k,2385) + lu(k,1145) = 1._r8 / lu(k,1145) + lu(k,1146) = lu(k,1146) * lu(k,1145) + lu(k,1147) = lu(k,1147) * lu(k,1145) + lu(k,1148) = lu(k,1148) * lu(k,1145) + lu(k,1149) = lu(k,1149) * lu(k,1145) + lu(k,1150) = lu(k,1150) * lu(k,1145) + lu(k,1151) = lu(k,1151) * lu(k,1145) + lu(k,1152) = lu(k,1152) * lu(k,1145) + lu(k,1153) = lu(k,1153) * lu(k,1145) + lu(k,1154) = lu(k,1154) * lu(k,1145) + lu(k,1218) = lu(k,1218) - lu(k,1146) * lu(k,1217) + lu(k,1221) = lu(k,1221) - lu(k,1147) * lu(k,1217) + lu(k,1222) = lu(k,1222) - lu(k,1148) * lu(k,1217) + lu(k,1223) = lu(k,1223) - lu(k,1149) * lu(k,1217) + lu(k,1224) = lu(k,1224) - lu(k,1150) * lu(k,1217) + lu(k,1226) = lu(k,1226) - lu(k,1151) * lu(k,1217) + lu(k,1228) = lu(k,1228) - lu(k,1152) * lu(k,1217) + lu(k,1229) = lu(k,1229) - lu(k,1153) * lu(k,1217) + lu(k,1231) = lu(k,1231) - lu(k,1154) * lu(k,1217) + lu(k,1665) = lu(k,1665) - lu(k,1146) * lu(k,1662) + lu(k,1669) = lu(k,1669) - lu(k,1147) * lu(k,1662) + lu(k,1679) = lu(k,1679) - lu(k,1148) * lu(k,1662) + lu(k,1680) = lu(k,1680) - lu(k,1149) * lu(k,1662) + lu(k,1684) = lu(k,1684) - lu(k,1150) * lu(k,1662) + lu(k,1687) = lu(k,1687) - lu(k,1151) * lu(k,1662) + lu(k,1695) = lu(k,1695) - lu(k,1152) * lu(k,1662) + lu(k,1696) = lu(k,1696) - lu(k,1153) * lu(k,1662) + lu(k,1698) = lu(k,1698) - lu(k,1154) * lu(k,1662) + lu(k,1877) = lu(k,1877) - lu(k,1146) * lu(k,1873) + lu(k,1882) = lu(k,1882) - lu(k,1147) * lu(k,1873) + lu(k,1892) = lu(k,1892) - lu(k,1148) * lu(k,1873) + lu(k,1893) = lu(k,1893) - lu(k,1149) * lu(k,1873) + lu(k,1901) = lu(k,1901) - lu(k,1150) * lu(k,1873) + lu(k,1904) = lu(k,1904) - lu(k,1151) * lu(k,1873) + lu(k,1912) = lu(k,1912) - lu(k,1152) * lu(k,1873) + lu(k,1913) = lu(k,1913) - lu(k,1153) * lu(k,1873) + lu(k,1915) = lu(k,1915) - lu(k,1154) * lu(k,1873) + lu(k,2077) = lu(k,2077) - lu(k,1146) * lu(k,2074) + lu(k,2081) = lu(k,2081) - lu(k,1147) * lu(k,2074) + lu(k,2090) = lu(k,2090) - lu(k,1148) * lu(k,2074) + lu(k,2091) = lu(k,2091) - lu(k,1149) * lu(k,2074) + lu(k,2097) = lu(k,2097) - lu(k,1150) * lu(k,2074) + lu(k,2100) = lu(k,2100) - lu(k,1151) * lu(k,2074) + lu(k,2108) = lu(k,2108) - lu(k,1152) * lu(k,2074) + lu(k,2109) = lu(k,2109) - lu(k,1153) * lu(k,2074) + lu(k,2111) = lu(k,2111) - lu(k,1154) * lu(k,2074) + lu(k,2209) = lu(k,2209) - lu(k,1146) * lu(k,2206) + lu(k,2214) = lu(k,2214) - lu(k,1147) * lu(k,2206) + lu(k,2224) = lu(k,2224) - lu(k,1148) * lu(k,2206) + lu(k,2225) = lu(k,2225) - lu(k,1149) * lu(k,2206) + lu(k,2230) = lu(k,2230) - lu(k,1150) * lu(k,2206) + lu(k,2233) = lu(k,2233) - lu(k,1151) * lu(k,2206) + lu(k,2241) = lu(k,2241) - lu(k,1152) * lu(k,2206) + lu(k,2242) = lu(k,2242) - lu(k,1153) * lu(k,2206) + lu(k,2244) = lu(k,2244) - lu(k,1154) * lu(k,2206) + lu(k,2268) = lu(k,2268) - lu(k,1146) * lu(k,2264) + lu(k,2273) = lu(k,2273) - lu(k,1147) * lu(k,2264) + lu(k,2283) = lu(k,2283) - lu(k,1148) * lu(k,2264) + lu(k,2284) = lu(k,2284) - lu(k,1149) * lu(k,2264) + lu(k,2290) = lu(k,2290) - lu(k,1150) * lu(k,2264) + lu(k,2293) = lu(k,2293) - lu(k,1151) * lu(k,2264) + lu(k,2301) = lu(k,2301) - lu(k,1152) * lu(k,2264) + lu(k,2302) = lu(k,2302) - lu(k,1153) * lu(k,2264) + lu(k,2304) = lu(k,2304) - lu(k,1154) * lu(k,2264) + lu(k,2388) = lu(k,2388) - lu(k,1146) * lu(k,2386) + lu(k,2392) = lu(k,2392) - lu(k,1147) * lu(k,2386) + lu(k,2402) = lu(k,2402) - lu(k,1148) * lu(k,2386) + lu(k,2403) = lu(k,2403) - lu(k,1149) * lu(k,2386) + lu(k,2410) = lu(k,2410) - lu(k,1150) * lu(k,2386) + lu(k,2413) = lu(k,2413) - lu(k,1151) * lu(k,2386) + lu(k,2421) = lu(k,2421) - lu(k,1152) * lu(k,2386) + lu(k,2422) = lu(k,2422) - lu(k,1153) * lu(k,2386) + lu(k,2424) = lu(k,2424) - lu(k,1154) * lu(k,2386) + lu(k,1159) = 1._r8 / lu(k,1159) + lu(k,1160) = lu(k,1160) * lu(k,1159) + lu(k,1161) = lu(k,1161) * lu(k,1159) + lu(k,1162) = lu(k,1162) * lu(k,1159) + lu(k,1163) = lu(k,1163) * lu(k,1159) + lu(k,1164) = lu(k,1164) * lu(k,1159) + lu(k,1165) = lu(k,1165) * lu(k,1159) + lu(k,1166) = lu(k,1166) * lu(k,1159) + lu(k,1167) = lu(k,1167) * lu(k,1159) + lu(k,1168) = lu(k,1168) * lu(k,1159) + lu(k,1169) = lu(k,1169) * lu(k,1159) + lu(k,1170) = lu(k,1170) * lu(k,1159) + lu(k,1292) = - lu(k,1160) * lu(k,1291) + lu(k,1297) = lu(k,1297) - lu(k,1161) * lu(k,1291) + lu(k,1299) = lu(k,1299) - lu(k,1162) * lu(k,1291) + lu(k,1300) = - lu(k,1163) * lu(k,1291) + lu(k,1301) = lu(k,1301) - lu(k,1164) * lu(k,1291) + lu(k,1302) = lu(k,1302) - lu(k,1165) * lu(k,1291) + lu(k,1303) = lu(k,1303) - lu(k,1166) * lu(k,1291) + lu(k,1304) = lu(k,1304) - lu(k,1167) * lu(k,1291) + lu(k,1306) = lu(k,1306) - lu(k,1168) * lu(k,1291) + lu(k,1307) = lu(k,1307) - lu(k,1169) * lu(k,1291) + lu(k,1308) = lu(k,1308) - lu(k,1170) * lu(k,1291) + lu(k,1458) = lu(k,1458) - lu(k,1160) * lu(k,1457) + lu(k,1464) = lu(k,1464) - lu(k,1161) * lu(k,1457) + lu(k,1470) = lu(k,1470) - lu(k,1162) * lu(k,1457) + lu(k,1471) = lu(k,1471) - lu(k,1163) * lu(k,1457) + lu(k,1474) = lu(k,1474) - lu(k,1164) * lu(k,1457) + lu(k,1475) = - lu(k,1165) * lu(k,1457) + lu(k,1476) = lu(k,1476) - lu(k,1166) * lu(k,1457) + lu(k,1478) = lu(k,1478) - lu(k,1167) * lu(k,1457) + lu(k,1480) = lu(k,1480) - lu(k,1168) * lu(k,1457) + lu(k,1481) = lu(k,1481) - lu(k,1169) * lu(k,1457) + lu(k,1482) = lu(k,1482) - lu(k,1170) * lu(k,1457) + lu(k,1665) = lu(k,1665) - lu(k,1160) * lu(k,1663) + lu(k,1673) = lu(k,1673) - lu(k,1161) * lu(k,1663) + lu(k,1679) = lu(k,1679) - lu(k,1162) * lu(k,1663) + lu(k,1680) = lu(k,1680) - lu(k,1163) * lu(k,1663) + lu(k,1684) = lu(k,1684) - lu(k,1164) * lu(k,1663) + lu(k,1685) = lu(k,1685) - lu(k,1165) * lu(k,1663) + lu(k,1687) = lu(k,1687) - lu(k,1166) * lu(k,1663) + lu(k,1693) = lu(k,1693) - lu(k,1167) * lu(k,1663) + lu(k,1695) = lu(k,1695) - lu(k,1168) * lu(k,1663) + lu(k,1696) = lu(k,1696) - lu(k,1169) * lu(k,1663) + lu(k,1697) = lu(k,1697) - lu(k,1170) * lu(k,1663) + lu(k,1877) = lu(k,1877) - lu(k,1160) * lu(k,1874) + lu(k,1886) = lu(k,1886) - lu(k,1161) * lu(k,1874) + lu(k,1892) = lu(k,1892) - lu(k,1162) * lu(k,1874) + lu(k,1893) = lu(k,1893) - lu(k,1163) * lu(k,1874) + lu(k,1901) = lu(k,1901) - lu(k,1164) * lu(k,1874) + lu(k,1902) = lu(k,1902) - lu(k,1165) * lu(k,1874) + lu(k,1904) = lu(k,1904) - lu(k,1166) * lu(k,1874) + lu(k,1910) = lu(k,1910) - lu(k,1167) * lu(k,1874) + lu(k,1912) = lu(k,1912) - lu(k,1168) * lu(k,1874) + lu(k,1913) = lu(k,1913) - lu(k,1169) * lu(k,1874) + lu(k,1914) = lu(k,1914) - lu(k,1170) * lu(k,1874) + lu(k,2209) = lu(k,2209) - lu(k,1160) * lu(k,2207) + lu(k,2218) = lu(k,2218) - lu(k,1161) * lu(k,2207) + lu(k,2224) = lu(k,2224) - lu(k,1162) * lu(k,2207) + lu(k,2225) = lu(k,2225) - lu(k,1163) * lu(k,2207) + lu(k,2230) = lu(k,2230) - lu(k,1164) * lu(k,2207) + lu(k,2231) = lu(k,2231) - lu(k,1165) * lu(k,2207) + lu(k,2233) = lu(k,2233) - lu(k,1166) * lu(k,2207) + lu(k,2239) = lu(k,2239) - lu(k,1167) * lu(k,2207) + lu(k,2241) = lu(k,2241) - lu(k,1168) * lu(k,2207) + lu(k,2242) = lu(k,2242) - lu(k,1169) * lu(k,2207) + lu(k,2243) = lu(k,2243) - lu(k,1170) * lu(k,2207) + lu(k,2268) = lu(k,2268) - lu(k,1160) * lu(k,2265) + lu(k,2277) = lu(k,2277) - lu(k,1161) * lu(k,2265) + lu(k,2283) = lu(k,2283) - lu(k,1162) * lu(k,2265) + lu(k,2284) = lu(k,2284) - lu(k,1163) * lu(k,2265) + lu(k,2290) = lu(k,2290) - lu(k,1164) * lu(k,2265) + lu(k,2291) = lu(k,2291) - lu(k,1165) * lu(k,2265) + lu(k,2293) = lu(k,2293) - lu(k,1166) * lu(k,2265) + lu(k,2299) = lu(k,2299) - lu(k,1167) * lu(k,2265) + lu(k,2301) = lu(k,2301) - lu(k,1168) * lu(k,2265) + lu(k,2302) = lu(k,2302) - lu(k,1169) * lu(k,2265) + lu(k,2303) = lu(k,2303) - lu(k,1170) * lu(k,2265) + end do + end subroutine lu_fac24 + subroutine lu_fac25( 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,1175) = 1._r8 / lu(k,1175) + lu(k,1176) = lu(k,1176) * lu(k,1175) + lu(k,1177) = lu(k,1177) * lu(k,1175) + lu(k,1178) = lu(k,1178) * lu(k,1175) + lu(k,1179) = lu(k,1179) * lu(k,1175) + lu(k,1180) = lu(k,1180) * lu(k,1175) + lu(k,1181) = lu(k,1181) * lu(k,1175) + lu(k,1182) = lu(k,1182) * lu(k,1175) + lu(k,1183) = lu(k,1183) * lu(k,1175) + lu(k,1184) = lu(k,1184) * lu(k,1175) + lu(k,1185) = lu(k,1185) * lu(k,1175) + lu(k,1186) = lu(k,1186) * lu(k,1175) + lu(k,1187) = lu(k,1187) * lu(k,1175) + lu(k,1188) = lu(k,1188) * lu(k,1175) + lu(k,1189) = lu(k,1189) * lu(k,1175) + lu(k,1190) = lu(k,1190) * lu(k,1175) + lu(k,1191) = lu(k,1191) * lu(k,1175) + lu(k,1192) = lu(k,1192) * lu(k,1175) + lu(k,1413) = lu(k,1413) - lu(k,1176) * lu(k,1412) + lu(k,1414) = lu(k,1414) - lu(k,1177) * lu(k,1412) + lu(k,1415) = - lu(k,1178) * lu(k,1412) + lu(k,1416) = lu(k,1416) - lu(k,1179) * lu(k,1412) + lu(k,1420) = lu(k,1420) - lu(k,1180) * lu(k,1412) + lu(k,1421) = lu(k,1421) - lu(k,1181) * lu(k,1412) + lu(k,1422) = - lu(k,1182) * lu(k,1412) + lu(k,1423) = - lu(k,1183) * lu(k,1412) + lu(k,1424) = lu(k,1424) - lu(k,1184) * lu(k,1412) + lu(k,1426) = lu(k,1426) - lu(k,1185) * lu(k,1412) + lu(k,1427) = lu(k,1427) - lu(k,1186) * lu(k,1412) + lu(k,1428) = - lu(k,1187) * lu(k,1412) + lu(k,1429) = - lu(k,1188) * lu(k,1412) + lu(k,1430) = lu(k,1430) - lu(k,1189) * lu(k,1412) + lu(k,1431) = lu(k,1431) - lu(k,1190) * lu(k,1412) + lu(k,1432) = - lu(k,1191) * lu(k,1412) + lu(k,1433) = lu(k,1433) - lu(k,1192) * lu(k,1412) + lu(k,1876) = lu(k,1876) - lu(k,1176) * lu(k,1875) + lu(k,1877) = lu(k,1877) - lu(k,1177) * lu(k,1875) + lu(k,1881) = lu(k,1881) - lu(k,1178) * lu(k,1875) + lu(k,1886) = lu(k,1886) - lu(k,1179) * lu(k,1875) + lu(k,1892) = lu(k,1892) - lu(k,1180) * lu(k,1875) + lu(k,1893) = lu(k,1893) - lu(k,1181) * lu(k,1875) + lu(k,1898) = lu(k,1898) - lu(k,1182) * lu(k,1875) + lu(k,1900) = lu(k,1900) - lu(k,1183) * lu(k,1875) + lu(k,1901) = lu(k,1901) - lu(k,1184) * lu(k,1875) + lu(k,1904) = lu(k,1904) - lu(k,1185) * lu(k,1875) + lu(k,1908) = lu(k,1908) - lu(k,1186) * lu(k,1875) + lu(k,1910) = lu(k,1910) - lu(k,1187) * lu(k,1875) + lu(k,1911) = lu(k,1911) - lu(k,1188) * lu(k,1875) + lu(k,1912) = lu(k,1912) - lu(k,1189) * lu(k,1875) + lu(k,1913) = lu(k,1913) - lu(k,1190) * lu(k,1875) + lu(k,1914) = lu(k,1914) - lu(k,1191) * lu(k,1875) + lu(k,1915) = lu(k,1915) - lu(k,1192) * lu(k,1875) + lu(k,2076) = lu(k,2076) - lu(k,1176) * lu(k,2075) + lu(k,2077) = lu(k,2077) - lu(k,1177) * lu(k,2075) + lu(k,2080) = - lu(k,1178) * lu(k,2075) + lu(k,2084) = lu(k,2084) - lu(k,1179) * lu(k,2075) + lu(k,2090) = lu(k,2090) - lu(k,1180) * lu(k,2075) + lu(k,2091) = lu(k,2091) - lu(k,1181) * lu(k,2075) + lu(k,2094) = lu(k,2094) - lu(k,1182) * lu(k,2075) + lu(k,2096) = lu(k,2096) - lu(k,1183) * lu(k,2075) + lu(k,2097) = lu(k,2097) - lu(k,1184) * lu(k,2075) + lu(k,2100) = lu(k,2100) - lu(k,1185) * lu(k,2075) + lu(k,2104) = lu(k,2104) - lu(k,1186) * lu(k,2075) + lu(k,2106) = lu(k,2106) - lu(k,1187) * lu(k,2075) + lu(k,2107) = lu(k,2107) - lu(k,1188) * lu(k,2075) + lu(k,2108) = lu(k,2108) - lu(k,1189) * lu(k,2075) + lu(k,2109) = lu(k,2109) - lu(k,1190) * lu(k,2075) + lu(k,2110) = lu(k,2110) - lu(k,1191) * lu(k,2075) + lu(k,2111) = lu(k,2111) - lu(k,1192) * lu(k,2075) + lu(k,2267) = lu(k,2267) - lu(k,1176) * lu(k,2266) + lu(k,2268) = lu(k,2268) - lu(k,1177) * lu(k,2266) + lu(k,2272) = lu(k,2272) - lu(k,1178) * lu(k,2266) + lu(k,2277) = lu(k,2277) - lu(k,1179) * lu(k,2266) + lu(k,2283) = lu(k,2283) - lu(k,1180) * lu(k,2266) + lu(k,2284) = lu(k,2284) - lu(k,1181) * lu(k,2266) + lu(k,2287) = lu(k,2287) - lu(k,1182) * lu(k,2266) + lu(k,2289) = - lu(k,1183) * lu(k,2266) + lu(k,2290) = lu(k,2290) - lu(k,1184) * lu(k,2266) + lu(k,2293) = lu(k,2293) - lu(k,1185) * lu(k,2266) + lu(k,2297) = lu(k,2297) - lu(k,1186) * lu(k,2266) + lu(k,2299) = lu(k,2299) - lu(k,1187) * lu(k,2266) + lu(k,2300) = lu(k,2300) - lu(k,1188) * lu(k,2266) + lu(k,2301) = lu(k,2301) - lu(k,1189) * lu(k,2266) + lu(k,2302) = lu(k,2302) - lu(k,1190) * lu(k,2266) + lu(k,2303) = lu(k,2303) - lu(k,1191) * lu(k,2266) + lu(k,2304) = lu(k,2304) - lu(k,1192) * lu(k,2266) + lu(k,1193) = 1._r8 / lu(k,1193) + lu(k,1194) = lu(k,1194) * lu(k,1193) + lu(k,1195) = lu(k,1195) * lu(k,1193) + lu(k,1196) = lu(k,1196) * lu(k,1193) + lu(k,1197) = lu(k,1197) * lu(k,1193) + lu(k,1198) = lu(k,1198) * lu(k,1193) + lu(k,1199) = lu(k,1199) * lu(k,1193) + lu(k,1200) = lu(k,1200) * lu(k,1193) + lu(k,1201) = lu(k,1201) * lu(k,1193) + lu(k,1235) = lu(k,1235) - lu(k,1194) * lu(k,1234) + lu(k,1240) = lu(k,1240) - lu(k,1195) * lu(k,1234) + lu(k,1242) = lu(k,1242) - lu(k,1196) * lu(k,1234) + lu(k,1243) = lu(k,1243) - lu(k,1197) * lu(k,1234) + lu(k,1244) = lu(k,1244) - lu(k,1198) * lu(k,1234) + lu(k,1245) = - lu(k,1199) * lu(k,1234) + lu(k,1246) = lu(k,1246) - lu(k,1200) * lu(k,1234) + lu(k,1249) = lu(k,1249) - lu(k,1201) * lu(k,1234) + lu(k,1414) = lu(k,1414) - lu(k,1194) * lu(k,1413) + lu(k,1420) = lu(k,1420) - lu(k,1195) * lu(k,1413) + lu(k,1424) = lu(k,1424) - lu(k,1196) * lu(k,1413) + lu(k,1425) = - lu(k,1197) * lu(k,1413) + lu(k,1426) = lu(k,1426) - lu(k,1198) * lu(k,1413) + lu(k,1429) = lu(k,1429) - lu(k,1199) * lu(k,1413) + lu(k,1430) = lu(k,1430) - lu(k,1200) * lu(k,1413) + lu(k,1433) = lu(k,1433) - lu(k,1201) * lu(k,1413) + lu(k,1665) = lu(k,1665) - lu(k,1194) * lu(k,1664) + lu(k,1679) = lu(k,1679) - lu(k,1195) * lu(k,1664) + lu(k,1684) = lu(k,1684) - lu(k,1196) * lu(k,1664) + lu(k,1685) = lu(k,1685) - lu(k,1197) * lu(k,1664) + lu(k,1687) = lu(k,1687) - lu(k,1198) * lu(k,1664) + lu(k,1694) = lu(k,1694) - lu(k,1199) * lu(k,1664) + lu(k,1695) = lu(k,1695) - lu(k,1200) * lu(k,1664) + lu(k,1698) = lu(k,1698) - lu(k,1201) * lu(k,1664) + lu(k,1877) = lu(k,1877) - lu(k,1194) * lu(k,1876) + lu(k,1892) = lu(k,1892) - lu(k,1195) * lu(k,1876) + lu(k,1901) = lu(k,1901) - lu(k,1196) * lu(k,1876) + lu(k,1902) = lu(k,1902) - lu(k,1197) * lu(k,1876) + lu(k,1904) = lu(k,1904) - lu(k,1198) * lu(k,1876) + lu(k,1911) = lu(k,1911) - lu(k,1199) * lu(k,1876) + lu(k,1912) = lu(k,1912) - lu(k,1200) * lu(k,1876) + lu(k,1915) = lu(k,1915) - lu(k,1201) * lu(k,1876) + lu(k,1978) = lu(k,1978) - lu(k,1194) * lu(k,1977) + lu(k,1982) = lu(k,1982) - lu(k,1195) * lu(k,1977) + lu(k,1990) = lu(k,1990) - lu(k,1196) * lu(k,1977) + lu(k,1991) = lu(k,1991) - lu(k,1197) * lu(k,1977) + lu(k,1993) = lu(k,1993) - lu(k,1198) * lu(k,1977) + lu(k,2000) = lu(k,2000) - lu(k,1199) * lu(k,1977) + lu(k,2001) = lu(k,2001) - lu(k,1200) * lu(k,1977) + lu(k,2004) = lu(k,2004) - lu(k,1201) * lu(k,1977) + lu(k,2077) = lu(k,2077) - lu(k,1194) * lu(k,2076) + lu(k,2090) = lu(k,2090) - lu(k,1195) * lu(k,2076) + lu(k,2097) = lu(k,2097) - lu(k,1196) * lu(k,2076) + lu(k,2098) = lu(k,2098) - lu(k,1197) * lu(k,2076) + lu(k,2100) = lu(k,2100) - lu(k,1198) * lu(k,2076) + lu(k,2107) = lu(k,2107) - lu(k,1199) * lu(k,2076) + lu(k,2108) = lu(k,2108) - lu(k,1200) * lu(k,2076) + lu(k,2111) = lu(k,2111) - lu(k,1201) * lu(k,2076) + lu(k,2209) = lu(k,2209) - lu(k,1194) * lu(k,2208) + lu(k,2224) = lu(k,2224) - lu(k,1195) * lu(k,2208) + lu(k,2230) = lu(k,2230) - lu(k,1196) * lu(k,2208) + lu(k,2231) = lu(k,2231) - lu(k,1197) * lu(k,2208) + lu(k,2233) = lu(k,2233) - lu(k,1198) * lu(k,2208) + lu(k,2240) = lu(k,2240) - lu(k,1199) * lu(k,2208) + lu(k,2241) = lu(k,2241) - lu(k,1200) * lu(k,2208) + lu(k,2244) = lu(k,2244) - lu(k,1201) * lu(k,2208) + lu(k,2268) = lu(k,2268) - lu(k,1194) * lu(k,2267) + lu(k,2283) = lu(k,2283) - lu(k,1195) * lu(k,2267) + lu(k,2290) = lu(k,2290) - lu(k,1196) * lu(k,2267) + lu(k,2291) = lu(k,2291) - lu(k,1197) * lu(k,2267) + lu(k,2293) = lu(k,2293) - lu(k,1198) * lu(k,2267) + lu(k,2300) = lu(k,2300) - lu(k,1199) * lu(k,2267) + lu(k,2301) = lu(k,2301) - lu(k,1200) * lu(k,2267) + lu(k,2304) = lu(k,2304) - lu(k,1201) * lu(k,2267) + lu(k,2388) = lu(k,2388) - lu(k,1194) * lu(k,2387) + lu(k,2402) = lu(k,2402) - lu(k,1195) * lu(k,2387) + lu(k,2410) = lu(k,2410) - lu(k,1196) * lu(k,2387) + lu(k,2411) = lu(k,2411) - lu(k,1197) * lu(k,2387) + lu(k,2413) = lu(k,2413) - lu(k,1198) * lu(k,2387) + lu(k,2420) = lu(k,2420) - lu(k,1199) * lu(k,2387) + lu(k,2421) = lu(k,2421) - lu(k,1200) * lu(k,2387) + lu(k,2424) = lu(k,2424) - lu(k,1201) * lu(k,2387) + lu(k,1202) = 1._r8 / lu(k,1202) + lu(k,1203) = lu(k,1203) * lu(k,1202) + lu(k,1204) = lu(k,1204) * lu(k,1202) + lu(k,1205) = lu(k,1205) * lu(k,1202) + lu(k,1209) = lu(k,1209) - lu(k,1203) * lu(k,1207) + lu(k,1210) = lu(k,1210) - lu(k,1204) * lu(k,1207) + lu(k,1211) = lu(k,1211) - lu(k,1205) * lu(k,1207) + lu(k,1223) = lu(k,1223) - lu(k,1203) * lu(k,1218) + lu(k,1226) = lu(k,1226) - lu(k,1204) * lu(k,1218) + lu(k,1228) = lu(k,1228) - lu(k,1205) * lu(k,1218) + lu(k,1241) = - lu(k,1203) * lu(k,1235) + lu(k,1244) = lu(k,1244) - lu(k,1204) * lu(k,1235) + lu(k,1246) = lu(k,1246) - lu(k,1205) * lu(k,1235) + lu(k,1278) = lu(k,1278) - lu(k,1203) * lu(k,1272) + lu(k,1280) = lu(k,1280) - lu(k,1204) * lu(k,1272) + lu(k,1283) = lu(k,1283) - lu(k,1205) * lu(k,1272) + lu(k,1300) = lu(k,1300) - lu(k,1203) * lu(k,1292) + lu(k,1303) = lu(k,1303) - lu(k,1204) * lu(k,1292) + lu(k,1306) = lu(k,1306) - lu(k,1205) * lu(k,1292) + lu(k,1316) = lu(k,1316) - lu(k,1203) * lu(k,1310) + lu(k,1317) = lu(k,1317) - lu(k,1204) * lu(k,1310) + lu(k,1319) = lu(k,1319) - lu(k,1205) * lu(k,1310) + lu(k,1325) = - lu(k,1203) * lu(k,1322) + lu(k,1327) = lu(k,1327) - lu(k,1204) * lu(k,1322) + lu(k,1329) = lu(k,1329) - lu(k,1205) * lu(k,1322) + lu(k,1379) = lu(k,1379) - lu(k,1203) * lu(k,1366) + lu(k,1382) = lu(k,1382) - lu(k,1204) * lu(k,1366) + lu(k,1386) = lu(k,1386) - lu(k,1205) * lu(k,1366) + lu(k,1401) = - lu(k,1203) * lu(k,1392) + lu(k,1404) = lu(k,1404) - lu(k,1204) * lu(k,1392) + lu(k,1407) = lu(k,1407) - lu(k,1205) * lu(k,1392) + lu(k,1421) = lu(k,1421) - lu(k,1203) * lu(k,1414) + lu(k,1426) = lu(k,1426) - lu(k,1204) * lu(k,1414) + lu(k,1430) = lu(k,1430) - lu(k,1205) * lu(k,1414) + lu(k,1471) = lu(k,1471) - lu(k,1203) * lu(k,1458) + lu(k,1476) = lu(k,1476) - lu(k,1204) * lu(k,1458) + lu(k,1480) = lu(k,1480) - lu(k,1205) * lu(k,1458) + lu(k,1492) = lu(k,1492) - lu(k,1203) * lu(k,1491) + lu(k,1495) = lu(k,1495) - lu(k,1204) * lu(k,1491) + lu(k,1499) = - lu(k,1205) * lu(k,1491) + lu(k,1552) = - lu(k,1203) * lu(k,1551) + lu(k,1557) = lu(k,1557) - lu(k,1204) * lu(k,1551) + lu(k,1562) = lu(k,1562) - lu(k,1205) * lu(k,1551) + lu(k,1581) = lu(k,1581) - lu(k,1203) * lu(k,1579) + lu(k,1587) = lu(k,1587) - lu(k,1204) * lu(k,1579) + lu(k,1594) = lu(k,1594) - lu(k,1205) * lu(k,1579) + lu(k,1625) = lu(k,1625) - lu(k,1203) * lu(k,1624) + lu(k,1635) = lu(k,1635) - lu(k,1204) * lu(k,1624) + lu(k,1643) = lu(k,1643) - lu(k,1205) * lu(k,1624) + lu(k,1680) = lu(k,1680) - lu(k,1203) * lu(k,1665) + lu(k,1687) = lu(k,1687) - lu(k,1204) * lu(k,1665) + lu(k,1695) = lu(k,1695) - lu(k,1205) * lu(k,1665) + lu(k,1893) = lu(k,1893) - lu(k,1203) * lu(k,1877) + lu(k,1904) = lu(k,1904) - lu(k,1204) * lu(k,1877) + lu(k,1912) = lu(k,1912) - lu(k,1205) * lu(k,1877) + lu(k,1936) = lu(k,1936) - lu(k,1203) * lu(k,1935) + lu(k,1947) = lu(k,1947) - lu(k,1204) * lu(k,1935) + lu(k,1955) = lu(k,1955) - lu(k,1205) * lu(k,1935) + lu(k,1983) = lu(k,1983) - lu(k,1203) * lu(k,1978) + lu(k,1993) = lu(k,1993) - lu(k,1204) * lu(k,1978) + lu(k,2001) = lu(k,2001) - lu(k,1205) * lu(k,1978) + lu(k,2091) = lu(k,2091) - lu(k,1203) * lu(k,2077) + lu(k,2100) = lu(k,2100) - lu(k,1204) * lu(k,2077) + lu(k,2108) = lu(k,2108) - lu(k,1205) * lu(k,2077) + lu(k,2225) = lu(k,2225) - lu(k,1203) * lu(k,2209) + lu(k,2233) = lu(k,2233) - lu(k,1204) * lu(k,2209) + lu(k,2241) = lu(k,2241) - lu(k,1205) * lu(k,2209) + lu(k,2284) = lu(k,2284) - lu(k,1203) * lu(k,2268) + lu(k,2293) = lu(k,2293) - lu(k,1204) * lu(k,2268) + lu(k,2301) = lu(k,2301) - lu(k,1205) * lu(k,2268) + lu(k,2403) = lu(k,2403) - lu(k,1203) * lu(k,2388) + lu(k,2413) = lu(k,2413) - lu(k,1204) * lu(k,2388) + lu(k,2421) = lu(k,2421) - lu(k,1205) * lu(k,2388) + lu(k,2429) = lu(k,2429) - lu(k,1203) * lu(k,2428) + lu(k,2439) = lu(k,2439) - lu(k,1204) * lu(k,2428) + lu(k,2447) = lu(k,2447) - lu(k,1205) * lu(k,2428) + lu(k,2474) = lu(k,2474) - lu(k,1203) * lu(k,2469) + lu(k,2484) = lu(k,2484) - lu(k,1204) * lu(k,2469) + lu(k,2492) = lu(k,2492) - lu(k,1205) * lu(k,2469) + lu(k,1208) = 1._r8 / lu(k,1208) + lu(k,1209) = lu(k,1209) * lu(k,1208) + lu(k,1210) = lu(k,1210) * lu(k,1208) + lu(k,1211) = lu(k,1211) * lu(k,1208) + lu(k,1212) = lu(k,1212) * lu(k,1208) + lu(k,1223) = lu(k,1223) - lu(k,1209) * lu(k,1219) + lu(k,1226) = lu(k,1226) - lu(k,1210) * lu(k,1219) + lu(k,1228) = lu(k,1228) - lu(k,1211) * lu(k,1219) + lu(k,1229) = lu(k,1229) - lu(k,1212) * lu(k,1219) + lu(k,1241) = lu(k,1241) - lu(k,1209) * lu(k,1236) + lu(k,1244) = lu(k,1244) - lu(k,1210) * lu(k,1236) + lu(k,1246) = lu(k,1246) - lu(k,1211) * lu(k,1236) + lu(k,1247) = lu(k,1247) - lu(k,1212) * lu(k,1236) + lu(k,1278) = lu(k,1278) - lu(k,1209) * lu(k,1273) + lu(k,1280) = lu(k,1280) - lu(k,1210) * lu(k,1273) + lu(k,1283) = lu(k,1283) - lu(k,1211) * lu(k,1273) + lu(k,1284) = lu(k,1284) - lu(k,1212) * lu(k,1273) + lu(k,1300) = lu(k,1300) - lu(k,1209) * lu(k,1293) + lu(k,1303) = lu(k,1303) - lu(k,1210) * lu(k,1293) + lu(k,1306) = lu(k,1306) - lu(k,1211) * lu(k,1293) + lu(k,1307) = lu(k,1307) - lu(k,1212) * lu(k,1293) + lu(k,1346) = lu(k,1346) - lu(k,1209) * lu(k,1334) + lu(k,1349) = lu(k,1349) - lu(k,1210) * lu(k,1334) + lu(k,1353) = lu(k,1353) - lu(k,1211) * lu(k,1334) + lu(k,1354) = lu(k,1354) - lu(k,1212) * lu(k,1334) + lu(k,1379) = lu(k,1379) - lu(k,1209) * lu(k,1367) + lu(k,1382) = lu(k,1382) - lu(k,1210) * lu(k,1367) + lu(k,1386) = lu(k,1386) - lu(k,1211) * lu(k,1367) + lu(k,1387) = lu(k,1387) - lu(k,1212) * lu(k,1367) + lu(k,1401) = lu(k,1401) - lu(k,1209) * lu(k,1393) + lu(k,1404) = lu(k,1404) - lu(k,1210) * lu(k,1393) + lu(k,1407) = lu(k,1407) - lu(k,1211) * lu(k,1393) + lu(k,1408) = lu(k,1408) - lu(k,1212) * lu(k,1393) + lu(k,1471) = lu(k,1471) - lu(k,1209) * lu(k,1459) + lu(k,1476) = lu(k,1476) - lu(k,1210) * lu(k,1459) + lu(k,1480) = lu(k,1480) - lu(k,1211) * lu(k,1459) + lu(k,1481) = lu(k,1481) - lu(k,1212) * lu(k,1459) + lu(k,1581) = lu(k,1581) - lu(k,1209) * lu(k,1580) + lu(k,1587) = lu(k,1587) - lu(k,1210) * lu(k,1580) + lu(k,1594) = lu(k,1594) - lu(k,1211) * lu(k,1580) + lu(k,1595) = lu(k,1595) - lu(k,1212) * lu(k,1580) + lu(k,1680) = lu(k,1680) - lu(k,1209) * lu(k,1666) + lu(k,1687) = lu(k,1687) - lu(k,1210) * lu(k,1666) + lu(k,1695) = lu(k,1695) - lu(k,1211) * lu(k,1666) + lu(k,1696) = lu(k,1696) - lu(k,1212) * lu(k,1666) + lu(k,1893) = lu(k,1893) - lu(k,1209) * lu(k,1878) + lu(k,1904) = lu(k,1904) - lu(k,1210) * lu(k,1878) + lu(k,1912) = lu(k,1912) - lu(k,1211) * lu(k,1878) + lu(k,1913) = lu(k,1913) - lu(k,1212) * lu(k,1878) + lu(k,1983) = lu(k,1983) - lu(k,1209) * lu(k,1979) + lu(k,1993) = lu(k,1993) - lu(k,1210) * lu(k,1979) + lu(k,2001) = lu(k,2001) - lu(k,1211) * lu(k,1979) + lu(k,2002) = lu(k,2002) - lu(k,1212) * lu(k,1979) + lu(k,2091) = lu(k,2091) - lu(k,1209) * lu(k,2078) + lu(k,2100) = lu(k,2100) - lu(k,1210) * lu(k,2078) + lu(k,2108) = lu(k,2108) - lu(k,1211) * lu(k,2078) + lu(k,2109) = lu(k,2109) - lu(k,1212) * lu(k,2078) + lu(k,2225) = lu(k,2225) - lu(k,1209) * lu(k,2210) + lu(k,2233) = lu(k,2233) - lu(k,1210) * lu(k,2210) + lu(k,2241) = lu(k,2241) - lu(k,1211) * lu(k,2210) + lu(k,2242) = lu(k,2242) - lu(k,1212) * lu(k,2210) + lu(k,2284) = lu(k,2284) - lu(k,1209) * lu(k,2269) + lu(k,2293) = lu(k,2293) - lu(k,1210) * lu(k,2269) + lu(k,2301) = lu(k,2301) - lu(k,1211) * lu(k,2269) + lu(k,2302) = lu(k,2302) - lu(k,1212) * lu(k,2269) + lu(k,2403) = lu(k,2403) - lu(k,1209) * lu(k,2389) + lu(k,2413) = lu(k,2413) - lu(k,1210) * lu(k,2389) + lu(k,2421) = lu(k,2421) - lu(k,1211) * lu(k,2389) + lu(k,2422) = lu(k,2422) - lu(k,1212) * lu(k,2389) + end do + end subroutine lu_fac25 + subroutine lu_fac26( 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,1220) = 1._r8 / lu(k,1220) + lu(k,1221) = lu(k,1221) * lu(k,1220) + lu(k,1222) = lu(k,1222) * lu(k,1220) + lu(k,1223) = lu(k,1223) * lu(k,1220) + lu(k,1224) = lu(k,1224) * lu(k,1220) + lu(k,1225) = lu(k,1225) * lu(k,1220) + lu(k,1226) = lu(k,1226) * lu(k,1220) + lu(k,1227) = lu(k,1227) * lu(k,1220) + lu(k,1228) = lu(k,1228) * lu(k,1220) + lu(k,1229) = lu(k,1229) * lu(k,1220) + lu(k,1230) = lu(k,1230) * lu(k,1220) + lu(k,1231) = lu(k,1231) * lu(k,1220) + lu(k,1669) = lu(k,1669) - lu(k,1221) * lu(k,1667) + lu(k,1679) = lu(k,1679) - lu(k,1222) * lu(k,1667) + lu(k,1680) = lu(k,1680) - lu(k,1223) * lu(k,1667) + lu(k,1684) = lu(k,1684) - lu(k,1224) * lu(k,1667) + lu(k,1685) = lu(k,1685) - lu(k,1225) * lu(k,1667) + lu(k,1687) = lu(k,1687) - lu(k,1226) * lu(k,1667) + lu(k,1693) = lu(k,1693) - lu(k,1227) * lu(k,1667) + lu(k,1695) = lu(k,1695) - lu(k,1228) * lu(k,1667) + lu(k,1696) = lu(k,1696) - lu(k,1229) * lu(k,1667) + lu(k,1697) = lu(k,1697) - lu(k,1230) * lu(k,1667) + lu(k,1698) = lu(k,1698) - lu(k,1231) * lu(k,1667) + lu(k,1882) = lu(k,1882) - lu(k,1221) * lu(k,1879) + lu(k,1892) = lu(k,1892) - lu(k,1222) * lu(k,1879) + lu(k,1893) = lu(k,1893) - lu(k,1223) * lu(k,1879) + lu(k,1901) = lu(k,1901) - lu(k,1224) * lu(k,1879) + lu(k,1902) = lu(k,1902) - lu(k,1225) * lu(k,1879) + lu(k,1904) = lu(k,1904) - lu(k,1226) * lu(k,1879) + lu(k,1910) = lu(k,1910) - lu(k,1227) * lu(k,1879) + lu(k,1912) = lu(k,1912) - lu(k,1228) * lu(k,1879) + lu(k,1913) = lu(k,1913) - lu(k,1229) * lu(k,1879) + lu(k,1914) = lu(k,1914) - lu(k,1230) * lu(k,1879) + lu(k,1915) = lu(k,1915) - lu(k,1231) * lu(k,1879) + lu(k,2081) = lu(k,2081) - lu(k,1221) * lu(k,2079) + lu(k,2090) = lu(k,2090) - lu(k,1222) * lu(k,2079) + lu(k,2091) = lu(k,2091) - lu(k,1223) * lu(k,2079) + lu(k,2097) = lu(k,2097) - lu(k,1224) * lu(k,2079) + lu(k,2098) = lu(k,2098) - lu(k,1225) * lu(k,2079) + lu(k,2100) = lu(k,2100) - lu(k,1226) * lu(k,2079) + lu(k,2106) = lu(k,2106) - lu(k,1227) * lu(k,2079) + lu(k,2108) = lu(k,2108) - lu(k,1228) * lu(k,2079) + lu(k,2109) = lu(k,2109) - lu(k,1229) * lu(k,2079) + lu(k,2110) = lu(k,2110) - lu(k,1230) * lu(k,2079) + lu(k,2111) = lu(k,2111) - lu(k,1231) * lu(k,2079) + lu(k,2214) = lu(k,2214) - lu(k,1221) * lu(k,2211) + lu(k,2224) = lu(k,2224) - lu(k,1222) * lu(k,2211) + lu(k,2225) = lu(k,2225) - lu(k,1223) * lu(k,2211) + lu(k,2230) = lu(k,2230) - lu(k,1224) * lu(k,2211) + lu(k,2231) = lu(k,2231) - lu(k,1225) * lu(k,2211) + lu(k,2233) = lu(k,2233) - lu(k,1226) * lu(k,2211) + lu(k,2239) = lu(k,2239) - lu(k,1227) * lu(k,2211) + lu(k,2241) = lu(k,2241) - lu(k,1228) * lu(k,2211) + lu(k,2242) = lu(k,2242) - lu(k,1229) * lu(k,2211) + lu(k,2243) = lu(k,2243) - lu(k,1230) * lu(k,2211) + lu(k,2244) = lu(k,2244) - lu(k,1231) * lu(k,2211) + lu(k,2273) = lu(k,2273) - lu(k,1221) * lu(k,2270) + lu(k,2283) = lu(k,2283) - lu(k,1222) * lu(k,2270) + lu(k,2284) = lu(k,2284) - lu(k,1223) * lu(k,2270) + lu(k,2290) = lu(k,2290) - lu(k,1224) * lu(k,2270) + lu(k,2291) = lu(k,2291) - lu(k,1225) * lu(k,2270) + lu(k,2293) = lu(k,2293) - lu(k,1226) * lu(k,2270) + lu(k,2299) = lu(k,2299) - lu(k,1227) * lu(k,2270) + lu(k,2301) = lu(k,2301) - lu(k,1228) * lu(k,2270) + lu(k,2302) = lu(k,2302) - lu(k,1229) * lu(k,2270) + lu(k,2303) = lu(k,2303) - lu(k,1230) * lu(k,2270) + lu(k,2304) = lu(k,2304) - lu(k,1231) * lu(k,2270) + lu(k,2392) = lu(k,2392) - lu(k,1221) * lu(k,2390) + lu(k,2402) = lu(k,2402) - lu(k,1222) * lu(k,2390) + lu(k,2403) = lu(k,2403) - lu(k,1223) * lu(k,2390) + lu(k,2410) = lu(k,2410) - lu(k,1224) * lu(k,2390) + lu(k,2411) = lu(k,2411) - lu(k,1225) * lu(k,2390) + lu(k,2413) = lu(k,2413) - lu(k,1226) * lu(k,2390) + lu(k,2419) = lu(k,2419) - lu(k,1227) * lu(k,2390) + lu(k,2421) = lu(k,2421) - lu(k,1228) * lu(k,2390) + lu(k,2422) = lu(k,2422) - lu(k,1229) * lu(k,2390) + lu(k,2423) = lu(k,2423) - lu(k,1230) * lu(k,2390) + lu(k,2424) = lu(k,2424) - lu(k,1231) * lu(k,2390) + lu(k,1237) = 1._r8 / lu(k,1237) + lu(k,1238) = lu(k,1238) * lu(k,1237) + lu(k,1239) = lu(k,1239) * lu(k,1237) + lu(k,1240) = lu(k,1240) * lu(k,1237) + lu(k,1241) = lu(k,1241) * lu(k,1237) + lu(k,1242) = lu(k,1242) * lu(k,1237) + lu(k,1243) = lu(k,1243) * lu(k,1237) + lu(k,1244) = lu(k,1244) * lu(k,1237) + lu(k,1245) = lu(k,1245) * lu(k,1237) + lu(k,1246) = lu(k,1246) * lu(k,1237) + lu(k,1247) = lu(k,1247) * lu(k,1237) + lu(k,1248) = lu(k,1248) * lu(k,1237) + lu(k,1249) = lu(k,1249) * lu(k,1237) + lu(k,1336) = lu(k,1336) - lu(k,1238) * lu(k,1335) + lu(k,1337) = - lu(k,1239) * lu(k,1335) + lu(k,1345) = lu(k,1345) - lu(k,1240) * lu(k,1335) + lu(k,1346) = lu(k,1346) - lu(k,1241) * lu(k,1335) + lu(k,1347) = lu(k,1347) - lu(k,1242) * lu(k,1335) + lu(k,1348) = lu(k,1348) - lu(k,1243) * lu(k,1335) + lu(k,1349) = lu(k,1349) - lu(k,1244) * lu(k,1335) + lu(k,1352) = lu(k,1352) - lu(k,1245) * lu(k,1335) + lu(k,1353) = lu(k,1353) - lu(k,1246) * lu(k,1335) + lu(k,1354) = lu(k,1354) - lu(k,1247) * lu(k,1335) + lu(k,1355) = lu(k,1355) - lu(k,1248) * lu(k,1335) + lu(k,1356) = - lu(k,1249) * lu(k,1335) + lu(k,1369) = lu(k,1369) - lu(k,1238) * lu(k,1368) + lu(k,1370) = - lu(k,1239) * lu(k,1368) + lu(k,1378) = lu(k,1378) - lu(k,1240) * lu(k,1368) + lu(k,1379) = lu(k,1379) - lu(k,1241) * lu(k,1368) + lu(k,1380) = lu(k,1380) - lu(k,1242) * lu(k,1368) + lu(k,1381) = lu(k,1381) - lu(k,1243) * lu(k,1368) + lu(k,1382) = lu(k,1382) - lu(k,1244) * lu(k,1368) + lu(k,1385) = lu(k,1385) - lu(k,1245) * lu(k,1368) + lu(k,1386) = lu(k,1386) - lu(k,1246) * lu(k,1368) + lu(k,1387) = lu(k,1387) - lu(k,1247) * lu(k,1368) + lu(k,1388) = lu(k,1388) - lu(k,1248) * lu(k,1368) + lu(k,1389) = - lu(k,1249) * lu(k,1368) + lu(k,1395) = lu(k,1395) - lu(k,1238) * lu(k,1394) + lu(k,1396) = - lu(k,1239) * lu(k,1394) + lu(k,1400) = lu(k,1400) - lu(k,1240) * lu(k,1394) + lu(k,1401) = lu(k,1401) - lu(k,1241) * lu(k,1394) + lu(k,1402) = lu(k,1402) - lu(k,1242) * lu(k,1394) + lu(k,1403) = - lu(k,1243) * lu(k,1394) + lu(k,1404) = lu(k,1404) - lu(k,1244) * lu(k,1394) + lu(k,1406) = lu(k,1406) - lu(k,1245) * lu(k,1394) + lu(k,1407) = lu(k,1407) - lu(k,1246) * lu(k,1394) + lu(k,1408) = lu(k,1408) - lu(k,1247) * lu(k,1394) + lu(k,1409) = lu(k,1409) - lu(k,1248) * lu(k,1394) + lu(k,1410) = - lu(k,1249) * lu(k,1394) + lu(k,1881) = lu(k,1881) - lu(k,1238) * lu(k,1880) + lu(k,1882) = lu(k,1882) - lu(k,1239) * lu(k,1880) + lu(k,1892) = lu(k,1892) - lu(k,1240) * lu(k,1880) + lu(k,1893) = lu(k,1893) - lu(k,1241) * lu(k,1880) + lu(k,1901) = lu(k,1901) - lu(k,1242) * lu(k,1880) + lu(k,1902) = lu(k,1902) - lu(k,1243) * lu(k,1880) + lu(k,1904) = lu(k,1904) - lu(k,1244) * lu(k,1880) + lu(k,1911) = lu(k,1911) - lu(k,1245) * lu(k,1880) + lu(k,1912) = lu(k,1912) - lu(k,1246) * lu(k,1880) + lu(k,1913) = lu(k,1913) - lu(k,1247) * lu(k,1880) + lu(k,1914) = lu(k,1914) - lu(k,1248) * lu(k,1880) + lu(k,1915) = lu(k,1915) - lu(k,1249) * lu(k,1880) + lu(k,2213) = lu(k,2213) - lu(k,1238) * lu(k,2212) + lu(k,2214) = lu(k,2214) - lu(k,1239) * lu(k,2212) + lu(k,2224) = lu(k,2224) - lu(k,1240) * lu(k,2212) + lu(k,2225) = lu(k,2225) - lu(k,1241) * lu(k,2212) + lu(k,2230) = lu(k,2230) - lu(k,1242) * lu(k,2212) + lu(k,2231) = lu(k,2231) - lu(k,1243) * lu(k,2212) + lu(k,2233) = lu(k,2233) - lu(k,1244) * lu(k,2212) + lu(k,2240) = lu(k,2240) - lu(k,1245) * lu(k,2212) + lu(k,2241) = lu(k,2241) - lu(k,1246) * lu(k,2212) + lu(k,2242) = lu(k,2242) - lu(k,1247) * lu(k,2212) + lu(k,2243) = lu(k,2243) - lu(k,1248) * lu(k,2212) + lu(k,2244) = lu(k,2244) - lu(k,1249) * lu(k,2212) + lu(k,2272) = lu(k,2272) - lu(k,1238) * lu(k,2271) + lu(k,2273) = lu(k,2273) - lu(k,1239) * lu(k,2271) + lu(k,2283) = lu(k,2283) - lu(k,1240) * lu(k,2271) + lu(k,2284) = lu(k,2284) - lu(k,1241) * lu(k,2271) + lu(k,2290) = lu(k,2290) - lu(k,1242) * lu(k,2271) + lu(k,2291) = lu(k,2291) - lu(k,1243) * lu(k,2271) + lu(k,2293) = lu(k,2293) - lu(k,1244) * lu(k,2271) + lu(k,2300) = lu(k,2300) - lu(k,1245) * lu(k,2271) + lu(k,2301) = lu(k,2301) - lu(k,1246) * lu(k,2271) + lu(k,2302) = lu(k,2302) - lu(k,1247) * lu(k,2271) + lu(k,2303) = lu(k,2303) - lu(k,1248) * lu(k,2271) + lu(k,2304) = lu(k,2304) - lu(k,1249) * lu(k,2271) + lu(k,1250) = 1._r8 / lu(k,1250) + lu(k,1251) = lu(k,1251) * lu(k,1250) + lu(k,1252) = lu(k,1252) * lu(k,1250) + lu(k,1253) = lu(k,1253) * lu(k,1250) + lu(k,1254) = lu(k,1254) * lu(k,1250) + lu(k,1255) = lu(k,1255) * lu(k,1250) + lu(k,1260) = lu(k,1260) - lu(k,1251) * lu(k,1258) + lu(k,1261) = lu(k,1261) - lu(k,1252) * lu(k,1258) + lu(k,1263) = lu(k,1263) - lu(k,1253) * lu(k,1258) + lu(k,1265) = lu(k,1265) - lu(k,1254) * lu(k,1258) + lu(k,1266) = lu(k,1266) - lu(k,1255) * lu(k,1258) + lu(k,1276) = lu(k,1276) - lu(k,1251) * lu(k,1274) + lu(k,1277) = lu(k,1277) - lu(k,1252) * lu(k,1274) + lu(k,1280) = lu(k,1280) - lu(k,1253) * lu(k,1274) + lu(k,1283) = lu(k,1283) - lu(k,1254) * lu(k,1274) + lu(k,1284) = lu(k,1284) - lu(k,1255) * lu(k,1274) + lu(k,1340) = - lu(k,1251) * lu(k,1336) + lu(k,1345) = lu(k,1345) - lu(k,1252) * lu(k,1336) + lu(k,1349) = lu(k,1349) - lu(k,1253) * lu(k,1336) + lu(k,1353) = lu(k,1353) - lu(k,1254) * lu(k,1336) + lu(k,1354) = lu(k,1354) - lu(k,1255) * lu(k,1336) + lu(k,1373) = lu(k,1373) - lu(k,1251) * lu(k,1369) + lu(k,1378) = lu(k,1378) - lu(k,1252) * lu(k,1369) + lu(k,1382) = lu(k,1382) - lu(k,1253) * lu(k,1369) + lu(k,1386) = lu(k,1386) - lu(k,1254) * lu(k,1369) + lu(k,1387) = lu(k,1387) - lu(k,1255) * lu(k,1369) + lu(k,1397) = lu(k,1397) - lu(k,1251) * lu(k,1395) + lu(k,1400) = lu(k,1400) - lu(k,1252) * lu(k,1395) + lu(k,1404) = lu(k,1404) - lu(k,1253) * lu(k,1395) + lu(k,1407) = lu(k,1407) - lu(k,1254) * lu(k,1395) + lu(k,1408) = lu(k,1408) - lu(k,1255) * lu(k,1395) + lu(k,1416) = lu(k,1416) - lu(k,1251) * lu(k,1415) + lu(k,1420) = lu(k,1420) - lu(k,1252) * lu(k,1415) + lu(k,1426) = lu(k,1426) - lu(k,1253) * lu(k,1415) + lu(k,1430) = lu(k,1430) - lu(k,1254) * lu(k,1415) + lu(k,1431) = lu(k,1431) - lu(k,1255) * lu(k,1415) + lu(k,1438) = - lu(k,1251) * lu(k,1437) + lu(k,1440) = lu(k,1440) - lu(k,1252) * lu(k,1437) + lu(k,1444) = lu(k,1444) - lu(k,1253) * lu(k,1437) + lu(k,1448) = lu(k,1448) - lu(k,1254) * lu(k,1437) + lu(k,1449) = lu(k,1449) - lu(k,1255) * lu(k,1437) + lu(k,1464) = lu(k,1464) - lu(k,1251) * lu(k,1460) + lu(k,1470) = lu(k,1470) - lu(k,1252) * lu(k,1460) + lu(k,1476) = lu(k,1476) - lu(k,1253) * lu(k,1460) + lu(k,1480) = lu(k,1480) - lu(k,1254) * lu(k,1460) + lu(k,1481) = lu(k,1481) - lu(k,1255) * lu(k,1460) + lu(k,1673) = lu(k,1673) - lu(k,1251) * lu(k,1668) + lu(k,1679) = lu(k,1679) - lu(k,1252) * lu(k,1668) + lu(k,1687) = lu(k,1687) - lu(k,1253) * lu(k,1668) + lu(k,1695) = lu(k,1695) - lu(k,1254) * lu(k,1668) + lu(k,1696) = lu(k,1696) - lu(k,1255) * lu(k,1668) + lu(k,1886) = lu(k,1886) - lu(k,1251) * lu(k,1881) + lu(k,1892) = lu(k,1892) - lu(k,1252) * lu(k,1881) + lu(k,1904) = lu(k,1904) - lu(k,1253) * lu(k,1881) + lu(k,1912) = lu(k,1912) - lu(k,1254) * lu(k,1881) + lu(k,1913) = lu(k,1913) - lu(k,1255) * lu(k,1881) + lu(k,2084) = lu(k,2084) - lu(k,1251) * lu(k,2080) + lu(k,2090) = lu(k,2090) - lu(k,1252) * lu(k,2080) + lu(k,2100) = lu(k,2100) - lu(k,1253) * lu(k,2080) + lu(k,2108) = lu(k,2108) - lu(k,1254) * lu(k,2080) + lu(k,2109) = lu(k,2109) - lu(k,1255) * lu(k,2080) + lu(k,2218) = lu(k,2218) - lu(k,1251) * lu(k,2213) + lu(k,2224) = lu(k,2224) - lu(k,1252) * lu(k,2213) + lu(k,2233) = lu(k,2233) - lu(k,1253) * lu(k,2213) + lu(k,2241) = lu(k,2241) - lu(k,1254) * lu(k,2213) + lu(k,2242) = lu(k,2242) - lu(k,1255) * lu(k,2213) + lu(k,2277) = lu(k,2277) - lu(k,1251) * lu(k,2272) + lu(k,2283) = lu(k,2283) - lu(k,1252) * lu(k,2272) + lu(k,2293) = lu(k,2293) - lu(k,1253) * lu(k,2272) + lu(k,2301) = lu(k,2301) - lu(k,1254) * lu(k,2272) + lu(k,2302) = lu(k,2302) - lu(k,1255) * lu(k,2272) + lu(k,2396) = lu(k,2396) - lu(k,1251) * lu(k,2391) + lu(k,2402) = lu(k,2402) - lu(k,1252) * lu(k,2391) + lu(k,2413) = lu(k,2413) - lu(k,1253) * lu(k,2391) + lu(k,2421) = lu(k,2421) - lu(k,1254) * lu(k,2391) + lu(k,2422) = lu(k,2422) - lu(k,1255) * lu(k,2391) + lu(k,2471) = lu(k,2471) - lu(k,1251) * lu(k,2470) + lu(k,2473) = lu(k,2473) - lu(k,1252) * lu(k,2470) + lu(k,2484) = lu(k,2484) - lu(k,1253) * lu(k,2470) + lu(k,2492) = lu(k,2492) - lu(k,1254) * lu(k,2470) + lu(k,2493) = lu(k,2493) - lu(k,1255) * lu(k,2470) + lu(k,1259) = 1._r8 / lu(k,1259) + lu(k,1260) = lu(k,1260) * lu(k,1259) + lu(k,1261) = lu(k,1261) * lu(k,1259) + lu(k,1262) = lu(k,1262) * lu(k,1259) + lu(k,1263) = lu(k,1263) * lu(k,1259) + lu(k,1264) = lu(k,1264) * lu(k,1259) + lu(k,1265) = lu(k,1265) * lu(k,1259) + lu(k,1266) = lu(k,1266) * lu(k,1259) + lu(k,1267) = lu(k,1267) * lu(k,1259) + lu(k,1268) = lu(k,1268) * lu(k,1259) + lu(k,1340) = lu(k,1340) - lu(k,1260) * lu(k,1337) + lu(k,1345) = lu(k,1345) - lu(k,1261) * lu(k,1337) + lu(k,1347) = lu(k,1347) - lu(k,1262) * lu(k,1337) + lu(k,1349) = lu(k,1349) - lu(k,1263) * lu(k,1337) + lu(k,1351) = lu(k,1351) - lu(k,1264) * lu(k,1337) + lu(k,1353) = lu(k,1353) - lu(k,1265) * lu(k,1337) + lu(k,1354) = lu(k,1354) - lu(k,1266) * lu(k,1337) + lu(k,1355) = lu(k,1355) - lu(k,1267) * lu(k,1337) + lu(k,1356) = lu(k,1356) - lu(k,1268) * lu(k,1337) + lu(k,1373) = lu(k,1373) - lu(k,1260) * lu(k,1370) + lu(k,1378) = lu(k,1378) - lu(k,1261) * lu(k,1370) + lu(k,1380) = lu(k,1380) - lu(k,1262) * lu(k,1370) + lu(k,1382) = lu(k,1382) - lu(k,1263) * lu(k,1370) + lu(k,1384) = lu(k,1384) - lu(k,1264) * lu(k,1370) + lu(k,1386) = lu(k,1386) - lu(k,1265) * lu(k,1370) + lu(k,1387) = lu(k,1387) - lu(k,1266) * lu(k,1370) + lu(k,1388) = lu(k,1388) - lu(k,1267) * lu(k,1370) + lu(k,1389) = lu(k,1389) - lu(k,1268) * lu(k,1370) + lu(k,1397) = lu(k,1397) - lu(k,1260) * lu(k,1396) + lu(k,1400) = lu(k,1400) - lu(k,1261) * lu(k,1396) + lu(k,1402) = lu(k,1402) - lu(k,1262) * lu(k,1396) + lu(k,1404) = lu(k,1404) - lu(k,1263) * lu(k,1396) + lu(k,1405) = lu(k,1405) - lu(k,1264) * lu(k,1396) + lu(k,1407) = lu(k,1407) - lu(k,1265) * lu(k,1396) + lu(k,1408) = lu(k,1408) - lu(k,1266) * lu(k,1396) + lu(k,1409) = lu(k,1409) - lu(k,1267) * lu(k,1396) + lu(k,1410) = lu(k,1410) - lu(k,1268) * lu(k,1396) + lu(k,1673) = lu(k,1673) - lu(k,1260) * lu(k,1669) + lu(k,1679) = lu(k,1679) - lu(k,1261) * lu(k,1669) + lu(k,1684) = lu(k,1684) - lu(k,1262) * lu(k,1669) + lu(k,1687) = lu(k,1687) - lu(k,1263) * lu(k,1669) + lu(k,1693) = lu(k,1693) - lu(k,1264) * lu(k,1669) + lu(k,1695) = lu(k,1695) - lu(k,1265) * lu(k,1669) + lu(k,1696) = lu(k,1696) - lu(k,1266) * lu(k,1669) + lu(k,1697) = lu(k,1697) - lu(k,1267) * lu(k,1669) + lu(k,1698) = lu(k,1698) - lu(k,1268) * lu(k,1669) + lu(k,1886) = lu(k,1886) - lu(k,1260) * lu(k,1882) + lu(k,1892) = lu(k,1892) - lu(k,1261) * lu(k,1882) + lu(k,1901) = lu(k,1901) - lu(k,1262) * lu(k,1882) + lu(k,1904) = lu(k,1904) - lu(k,1263) * lu(k,1882) + lu(k,1910) = lu(k,1910) - lu(k,1264) * lu(k,1882) + lu(k,1912) = lu(k,1912) - lu(k,1265) * lu(k,1882) + lu(k,1913) = lu(k,1913) - lu(k,1266) * lu(k,1882) + lu(k,1914) = lu(k,1914) - lu(k,1267) * lu(k,1882) + lu(k,1915) = lu(k,1915) - lu(k,1268) * lu(k,1882) + lu(k,1981) = - lu(k,1260) * lu(k,1980) + lu(k,1982) = lu(k,1982) - lu(k,1261) * lu(k,1980) + lu(k,1990) = lu(k,1990) - lu(k,1262) * lu(k,1980) + lu(k,1993) = lu(k,1993) - lu(k,1263) * lu(k,1980) + lu(k,1999) = lu(k,1999) - lu(k,1264) * lu(k,1980) + lu(k,2001) = lu(k,2001) - lu(k,1265) * lu(k,1980) + lu(k,2002) = lu(k,2002) - lu(k,1266) * lu(k,1980) + lu(k,2003) = lu(k,2003) - lu(k,1267) * lu(k,1980) + lu(k,2004) = lu(k,2004) - lu(k,1268) * lu(k,1980) + lu(k,2084) = lu(k,2084) - lu(k,1260) * lu(k,2081) + lu(k,2090) = lu(k,2090) - lu(k,1261) * lu(k,2081) + lu(k,2097) = lu(k,2097) - lu(k,1262) * lu(k,2081) + lu(k,2100) = lu(k,2100) - lu(k,1263) * lu(k,2081) + lu(k,2106) = lu(k,2106) - lu(k,1264) * lu(k,2081) + lu(k,2108) = lu(k,2108) - lu(k,1265) * lu(k,2081) + lu(k,2109) = lu(k,2109) - lu(k,1266) * lu(k,2081) + lu(k,2110) = lu(k,2110) - lu(k,1267) * lu(k,2081) + lu(k,2111) = lu(k,2111) - lu(k,1268) * lu(k,2081) + lu(k,2218) = lu(k,2218) - lu(k,1260) * lu(k,2214) + lu(k,2224) = lu(k,2224) - lu(k,1261) * lu(k,2214) + lu(k,2230) = lu(k,2230) - lu(k,1262) * lu(k,2214) + lu(k,2233) = lu(k,2233) - lu(k,1263) * lu(k,2214) + lu(k,2239) = lu(k,2239) - lu(k,1264) * lu(k,2214) + lu(k,2241) = lu(k,2241) - lu(k,1265) * lu(k,2214) + lu(k,2242) = lu(k,2242) - lu(k,1266) * lu(k,2214) + lu(k,2243) = lu(k,2243) - lu(k,1267) * lu(k,2214) + lu(k,2244) = lu(k,2244) - lu(k,1268) * lu(k,2214) + lu(k,2277) = lu(k,2277) - lu(k,1260) * lu(k,2273) + lu(k,2283) = lu(k,2283) - lu(k,1261) * lu(k,2273) + lu(k,2290) = lu(k,2290) - lu(k,1262) * lu(k,2273) + lu(k,2293) = lu(k,2293) - lu(k,1263) * lu(k,2273) + lu(k,2299) = lu(k,2299) - lu(k,1264) * lu(k,2273) + lu(k,2301) = lu(k,2301) - lu(k,1265) * lu(k,2273) + lu(k,2302) = lu(k,2302) - lu(k,1266) * lu(k,2273) + lu(k,2303) = lu(k,2303) - lu(k,1267) * lu(k,2273) + lu(k,2304) = lu(k,2304) - lu(k,1268) * lu(k,2273) + lu(k,2396) = lu(k,2396) - lu(k,1260) * lu(k,2392) + lu(k,2402) = lu(k,2402) - lu(k,1261) * lu(k,2392) + lu(k,2410) = lu(k,2410) - lu(k,1262) * lu(k,2392) + lu(k,2413) = lu(k,2413) - lu(k,1263) * lu(k,2392) + lu(k,2419) = lu(k,2419) - lu(k,1264) * lu(k,2392) + lu(k,2421) = lu(k,2421) - lu(k,1265) * lu(k,2392) + lu(k,2422) = lu(k,2422) - lu(k,1266) * lu(k,2392) + lu(k,2423) = lu(k,2423) - lu(k,1267) * lu(k,2392) + lu(k,2424) = lu(k,2424) - lu(k,1268) * lu(k,2392) + end do + end subroutine lu_fac26 + subroutine lu_fac27( 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,1275) = 1._r8 / lu(k,1275) + lu(k,1276) = lu(k,1276) * lu(k,1275) + lu(k,1277) = lu(k,1277) * lu(k,1275) + lu(k,1278) = lu(k,1278) * lu(k,1275) + lu(k,1279) = lu(k,1279) * lu(k,1275) + lu(k,1280) = lu(k,1280) * lu(k,1275) + lu(k,1281) = lu(k,1281) * lu(k,1275) + lu(k,1282) = lu(k,1282) * lu(k,1275) + lu(k,1283) = lu(k,1283) * lu(k,1275) + lu(k,1284) = lu(k,1284) * lu(k,1275) + lu(k,1285) = lu(k,1285) * lu(k,1275) + lu(k,1297) = lu(k,1297) - lu(k,1276) * lu(k,1294) + lu(k,1299) = lu(k,1299) - lu(k,1277) * lu(k,1294) + lu(k,1300) = lu(k,1300) - lu(k,1278) * lu(k,1294) + lu(k,1301) = lu(k,1301) - lu(k,1279) * lu(k,1294) + lu(k,1303) = lu(k,1303) - lu(k,1280) * lu(k,1294) + lu(k,1304) = lu(k,1304) - lu(k,1281) * lu(k,1294) + lu(k,1305) = lu(k,1305) - lu(k,1282) * lu(k,1294) + lu(k,1306) = lu(k,1306) - lu(k,1283) * lu(k,1294) + lu(k,1307) = lu(k,1307) - lu(k,1284) * lu(k,1294) + lu(k,1308) = lu(k,1308) - lu(k,1285) * lu(k,1294) + lu(k,1340) = lu(k,1340) - lu(k,1276) * lu(k,1338) + lu(k,1345) = lu(k,1345) - lu(k,1277) * lu(k,1338) + lu(k,1346) = lu(k,1346) - lu(k,1278) * lu(k,1338) + lu(k,1347) = lu(k,1347) - lu(k,1279) * lu(k,1338) + lu(k,1349) = lu(k,1349) - lu(k,1280) * lu(k,1338) + lu(k,1351) = lu(k,1351) - lu(k,1281) * lu(k,1338) + lu(k,1352) = lu(k,1352) - lu(k,1282) * lu(k,1338) + lu(k,1353) = lu(k,1353) - lu(k,1283) * lu(k,1338) + lu(k,1354) = lu(k,1354) - lu(k,1284) * lu(k,1338) + lu(k,1355) = lu(k,1355) - lu(k,1285) * lu(k,1338) + lu(k,1373) = lu(k,1373) - lu(k,1276) * lu(k,1371) + lu(k,1378) = lu(k,1378) - lu(k,1277) * lu(k,1371) + lu(k,1379) = lu(k,1379) - lu(k,1278) * lu(k,1371) + lu(k,1380) = lu(k,1380) - lu(k,1279) * lu(k,1371) + lu(k,1382) = lu(k,1382) - lu(k,1280) * lu(k,1371) + lu(k,1384) = lu(k,1384) - lu(k,1281) * lu(k,1371) + lu(k,1385) = lu(k,1385) - lu(k,1282) * lu(k,1371) + lu(k,1386) = lu(k,1386) - lu(k,1283) * lu(k,1371) + lu(k,1387) = lu(k,1387) - lu(k,1284) * lu(k,1371) + lu(k,1388) = lu(k,1388) - lu(k,1285) * lu(k,1371) + lu(k,1464) = lu(k,1464) - lu(k,1276) * lu(k,1461) + lu(k,1470) = lu(k,1470) - lu(k,1277) * lu(k,1461) + lu(k,1471) = lu(k,1471) - lu(k,1278) * lu(k,1461) + lu(k,1474) = lu(k,1474) - lu(k,1279) * lu(k,1461) + lu(k,1476) = lu(k,1476) - lu(k,1280) * lu(k,1461) + lu(k,1478) = lu(k,1478) - lu(k,1281) * lu(k,1461) + lu(k,1479) = lu(k,1479) - lu(k,1282) * lu(k,1461) + lu(k,1480) = lu(k,1480) - lu(k,1283) * lu(k,1461) + lu(k,1481) = lu(k,1481) - lu(k,1284) * lu(k,1461) + lu(k,1482) = lu(k,1482) - lu(k,1285) * lu(k,1461) + lu(k,1673) = lu(k,1673) - lu(k,1276) * lu(k,1670) + lu(k,1679) = lu(k,1679) - lu(k,1277) * lu(k,1670) + lu(k,1680) = lu(k,1680) - lu(k,1278) * lu(k,1670) + lu(k,1684) = lu(k,1684) - lu(k,1279) * lu(k,1670) + lu(k,1687) = lu(k,1687) - lu(k,1280) * lu(k,1670) + lu(k,1693) = lu(k,1693) - lu(k,1281) * lu(k,1670) + lu(k,1694) = lu(k,1694) - lu(k,1282) * lu(k,1670) + lu(k,1695) = lu(k,1695) - lu(k,1283) * lu(k,1670) + lu(k,1696) = lu(k,1696) - lu(k,1284) * lu(k,1670) + lu(k,1697) = lu(k,1697) - lu(k,1285) * lu(k,1670) + lu(k,1886) = lu(k,1886) - lu(k,1276) * lu(k,1883) + lu(k,1892) = lu(k,1892) - lu(k,1277) * lu(k,1883) + lu(k,1893) = lu(k,1893) - lu(k,1278) * lu(k,1883) + lu(k,1901) = lu(k,1901) - lu(k,1279) * lu(k,1883) + lu(k,1904) = lu(k,1904) - lu(k,1280) * lu(k,1883) + lu(k,1910) = lu(k,1910) - lu(k,1281) * lu(k,1883) + lu(k,1911) = lu(k,1911) - lu(k,1282) * lu(k,1883) + lu(k,1912) = lu(k,1912) - lu(k,1283) * lu(k,1883) + lu(k,1913) = lu(k,1913) - lu(k,1284) * lu(k,1883) + lu(k,1914) = lu(k,1914) - lu(k,1285) * lu(k,1883) + lu(k,2218) = lu(k,2218) - lu(k,1276) * lu(k,2215) + lu(k,2224) = lu(k,2224) - lu(k,1277) * lu(k,2215) + lu(k,2225) = lu(k,2225) - lu(k,1278) * lu(k,2215) + lu(k,2230) = lu(k,2230) - lu(k,1279) * lu(k,2215) + lu(k,2233) = lu(k,2233) - lu(k,1280) * lu(k,2215) + lu(k,2239) = lu(k,2239) - lu(k,1281) * lu(k,2215) + lu(k,2240) = lu(k,2240) - lu(k,1282) * lu(k,2215) + lu(k,2241) = lu(k,2241) - lu(k,1283) * lu(k,2215) + lu(k,2242) = lu(k,2242) - lu(k,1284) * lu(k,2215) + lu(k,2243) = lu(k,2243) - lu(k,1285) * lu(k,2215) + lu(k,2277) = lu(k,2277) - lu(k,1276) * lu(k,2274) + lu(k,2283) = lu(k,2283) - lu(k,1277) * lu(k,2274) + lu(k,2284) = lu(k,2284) - lu(k,1278) * lu(k,2274) + lu(k,2290) = lu(k,2290) - lu(k,1279) * lu(k,2274) + lu(k,2293) = lu(k,2293) - lu(k,1280) * lu(k,2274) + lu(k,2299) = lu(k,2299) - lu(k,1281) * lu(k,2274) + lu(k,2300) = lu(k,2300) - lu(k,1282) * lu(k,2274) + lu(k,2301) = lu(k,2301) - lu(k,1283) * lu(k,2274) + lu(k,2302) = lu(k,2302) - lu(k,1284) * lu(k,2274) + lu(k,2303) = lu(k,2303) - lu(k,1285) * lu(k,2274) + lu(k,2396) = lu(k,2396) - lu(k,1276) * lu(k,2393) + lu(k,2402) = lu(k,2402) - lu(k,1277) * lu(k,2393) + lu(k,2403) = lu(k,2403) - lu(k,1278) * lu(k,2393) + lu(k,2410) = lu(k,2410) - lu(k,1279) * lu(k,2393) + lu(k,2413) = lu(k,2413) - lu(k,1280) * lu(k,2393) + lu(k,2419) = lu(k,2419) - lu(k,1281) * lu(k,2393) + lu(k,2420) = lu(k,2420) - lu(k,1282) * lu(k,2393) + lu(k,2421) = lu(k,2421) - lu(k,1283) * lu(k,2393) + lu(k,2422) = lu(k,2422) - lu(k,1284) * lu(k,2393) + lu(k,2423) = lu(k,2423) - lu(k,1285) * lu(k,2393) + lu(k,1295) = 1._r8 / lu(k,1295) + lu(k,1296) = lu(k,1296) * lu(k,1295) + lu(k,1297) = lu(k,1297) * lu(k,1295) + lu(k,1298) = lu(k,1298) * lu(k,1295) + lu(k,1299) = lu(k,1299) * lu(k,1295) + lu(k,1300) = lu(k,1300) * lu(k,1295) + lu(k,1301) = lu(k,1301) * lu(k,1295) + lu(k,1302) = lu(k,1302) * lu(k,1295) + lu(k,1303) = lu(k,1303) * lu(k,1295) + lu(k,1304) = lu(k,1304) * lu(k,1295) + lu(k,1305) = lu(k,1305) * lu(k,1295) + lu(k,1306) = lu(k,1306) * lu(k,1295) + lu(k,1307) = lu(k,1307) * lu(k,1295) + lu(k,1308) = lu(k,1308) * lu(k,1295) + lu(k,1463) = lu(k,1463) - lu(k,1296) * lu(k,1462) + lu(k,1464) = lu(k,1464) - lu(k,1297) * lu(k,1462) + lu(k,1468) = lu(k,1468) - lu(k,1298) * lu(k,1462) + lu(k,1470) = lu(k,1470) - lu(k,1299) * lu(k,1462) + lu(k,1471) = lu(k,1471) - lu(k,1300) * lu(k,1462) + lu(k,1474) = lu(k,1474) - lu(k,1301) * lu(k,1462) + lu(k,1475) = lu(k,1475) - lu(k,1302) * lu(k,1462) + lu(k,1476) = lu(k,1476) - lu(k,1303) * lu(k,1462) + lu(k,1478) = lu(k,1478) - lu(k,1304) * lu(k,1462) + lu(k,1479) = lu(k,1479) - lu(k,1305) * lu(k,1462) + lu(k,1480) = lu(k,1480) - lu(k,1306) * lu(k,1462) + lu(k,1481) = lu(k,1481) - lu(k,1307) * lu(k,1462) + lu(k,1482) = lu(k,1482) - lu(k,1308) * lu(k,1462) + lu(k,1672) = lu(k,1672) - lu(k,1296) * lu(k,1671) + lu(k,1673) = lu(k,1673) - lu(k,1297) * lu(k,1671) + lu(k,1677) = lu(k,1677) - lu(k,1298) * lu(k,1671) + lu(k,1679) = lu(k,1679) - lu(k,1299) * lu(k,1671) + lu(k,1680) = lu(k,1680) - lu(k,1300) * lu(k,1671) + lu(k,1684) = lu(k,1684) - lu(k,1301) * lu(k,1671) + lu(k,1685) = lu(k,1685) - lu(k,1302) * lu(k,1671) + lu(k,1687) = lu(k,1687) - lu(k,1303) * lu(k,1671) + lu(k,1693) = lu(k,1693) - lu(k,1304) * lu(k,1671) + lu(k,1694) = lu(k,1694) - lu(k,1305) * lu(k,1671) + lu(k,1695) = lu(k,1695) - lu(k,1306) * lu(k,1671) + lu(k,1696) = lu(k,1696) - lu(k,1307) * lu(k,1671) + lu(k,1697) = lu(k,1697) - lu(k,1308) * lu(k,1671) + lu(k,1885) = lu(k,1885) - lu(k,1296) * lu(k,1884) + lu(k,1886) = lu(k,1886) - lu(k,1297) * lu(k,1884) + lu(k,1890) = lu(k,1890) - lu(k,1298) * lu(k,1884) + lu(k,1892) = lu(k,1892) - lu(k,1299) * lu(k,1884) + lu(k,1893) = lu(k,1893) - lu(k,1300) * lu(k,1884) + lu(k,1901) = lu(k,1901) - lu(k,1301) * lu(k,1884) + lu(k,1902) = lu(k,1902) - lu(k,1302) * lu(k,1884) + lu(k,1904) = lu(k,1904) - lu(k,1303) * lu(k,1884) + lu(k,1910) = lu(k,1910) - lu(k,1304) * lu(k,1884) + lu(k,1911) = lu(k,1911) - lu(k,1305) * lu(k,1884) + lu(k,1912) = lu(k,1912) - lu(k,1306) * lu(k,1884) + lu(k,1913) = lu(k,1913) - lu(k,1307) * lu(k,1884) + lu(k,1914) = lu(k,1914) - lu(k,1308) * lu(k,1884) + lu(k,2083) = lu(k,2083) - lu(k,1296) * lu(k,2082) + lu(k,2084) = lu(k,2084) - lu(k,1297) * lu(k,2082) + lu(k,2088) = lu(k,2088) - lu(k,1298) * lu(k,2082) + lu(k,2090) = lu(k,2090) - lu(k,1299) * lu(k,2082) + lu(k,2091) = lu(k,2091) - lu(k,1300) * lu(k,2082) + lu(k,2097) = lu(k,2097) - lu(k,1301) * lu(k,2082) + lu(k,2098) = lu(k,2098) - lu(k,1302) * lu(k,2082) + lu(k,2100) = lu(k,2100) - lu(k,1303) * lu(k,2082) + lu(k,2106) = lu(k,2106) - lu(k,1304) * lu(k,2082) + lu(k,2107) = lu(k,2107) - lu(k,1305) * lu(k,2082) + lu(k,2108) = lu(k,2108) - lu(k,1306) * lu(k,2082) + lu(k,2109) = lu(k,2109) - lu(k,1307) * lu(k,2082) + lu(k,2110) = lu(k,2110) - lu(k,1308) * lu(k,2082) + lu(k,2217) = lu(k,2217) - lu(k,1296) * lu(k,2216) + lu(k,2218) = lu(k,2218) - lu(k,1297) * lu(k,2216) + lu(k,2222) = lu(k,2222) - lu(k,1298) * lu(k,2216) + lu(k,2224) = lu(k,2224) - lu(k,1299) * lu(k,2216) + lu(k,2225) = lu(k,2225) - lu(k,1300) * lu(k,2216) + lu(k,2230) = lu(k,2230) - lu(k,1301) * lu(k,2216) + lu(k,2231) = lu(k,2231) - lu(k,1302) * lu(k,2216) + lu(k,2233) = lu(k,2233) - lu(k,1303) * lu(k,2216) + lu(k,2239) = lu(k,2239) - lu(k,1304) * lu(k,2216) + lu(k,2240) = lu(k,2240) - lu(k,1305) * lu(k,2216) + lu(k,2241) = lu(k,2241) - lu(k,1306) * lu(k,2216) + lu(k,2242) = lu(k,2242) - lu(k,1307) * lu(k,2216) + lu(k,2243) = lu(k,2243) - lu(k,1308) * lu(k,2216) + lu(k,2276) = lu(k,2276) - lu(k,1296) * lu(k,2275) + lu(k,2277) = lu(k,2277) - lu(k,1297) * lu(k,2275) + lu(k,2281) = lu(k,2281) - lu(k,1298) * lu(k,2275) + lu(k,2283) = lu(k,2283) - lu(k,1299) * lu(k,2275) + lu(k,2284) = lu(k,2284) - lu(k,1300) * lu(k,2275) + lu(k,2290) = lu(k,2290) - lu(k,1301) * lu(k,2275) + lu(k,2291) = lu(k,2291) - lu(k,1302) * lu(k,2275) + lu(k,2293) = lu(k,2293) - lu(k,1303) * lu(k,2275) + lu(k,2299) = lu(k,2299) - lu(k,1304) * lu(k,2275) + lu(k,2300) = lu(k,2300) - lu(k,1305) * lu(k,2275) + lu(k,2301) = lu(k,2301) - lu(k,1306) * lu(k,2275) + lu(k,2302) = lu(k,2302) - lu(k,1307) * lu(k,2275) + lu(k,2303) = lu(k,2303) - lu(k,1308) * lu(k,2275) + lu(k,2395) = lu(k,2395) - lu(k,1296) * lu(k,2394) + lu(k,2396) = lu(k,2396) - lu(k,1297) * lu(k,2394) + lu(k,2400) = lu(k,2400) - lu(k,1298) * lu(k,2394) + lu(k,2402) = lu(k,2402) - lu(k,1299) * lu(k,2394) + lu(k,2403) = lu(k,2403) - lu(k,1300) * lu(k,2394) + lu(k,2410) = lu(k,2410) - lu(k,1301) * lu(k,2394) + lu(k,2411) = lu(k,2411) - lu(k,1302) * lu(k,2394) + lu(k,2413) = lu(k,2413) - lu(k,1303) * lu(k,2394) + lu(k,2419) = lu(k,2419) - lu(k,1304) * lu(k,2394) + lu(k,2420) = lu(k,2420) - lu(k,1305) * lu(k,2394) + lu(k,2421) = lu(k,2421) - lu(k,1306) * lu(k,2394) + lu(k,2422) = lu(k,2422) - lu(k,1307) * lu(k,2394) + lu(k,2423) = lu(k,2423) - lu(k,1308) * lu(k,2394) + lu(k,1311) = 1._r8 / lu(k,1311) + lu(k,1312) = lu(k,1312) * lu(k,1311) + lu(k,1313) = lu(k,1313) * lu(k,1311) + lu(k,1314) = lu(k,1314) * lu(k,1311) + lu(k,1315) = lu(k,1315) * lu(k,1311) + lu(k,1316) = lu(k,1316) * lu(k,1311) + lu(k,1317) = lu(k,1317) * lu(k,1311) + lu(k,1318) = lu(k,1318) * lu(k,1311) + lu(k,1319) = lu(k,1319) * lu(k,1311) + lu(k,1320) = lu(k,1320) * lu(k,1311) + lu(k,1321) = lu(k,1321) * lu(k,1311) + lu(k,1340) = lu(k,1340) - lu(k,1312) * lu(k,1339) + lu(k,1342) = - lu(k,1313) * lu(k,1339) + lu(k,1344) = - lu(k,1314) * lu(k,1339) + lu(k,1345) = lu(k,1345) - lu(k,1315) * lu(k,1339) + lu(k,1346) = lu(k,1346) - lu(k,1316) * lu(k,1339) + lu(k,1349) = lu(k,1349) - lu(k,1317) * lu(k,1339) + lu(k,1350) = - lu(k,1318) * lu(k,1339) + lu(k,1353) = lu(k,1353) - lu(k,1319) * lu(k,1339) + lu(k,1354) = lu(k,1354) - lu(k,1320) * lu(k,1339) + lu(k,1356) = lu(k,1356) - lu(k,1321) * lu(k,1339) + lu(k,1373) = lu(k,1373) - lu(k,1312) * lu(k,1372) + lu(k,1375) = - lu(k,1313) * lu(k,1372) + lu(k,1377) = - lu(k,1314) * lu(k,1372) + lu(k,1378) = lu(k,1378) - lu(k,1315) * lu(k,1372) + lu(k,1379) = lu(k,1379) - lu(k,1316) * lu(k,1372) + lu(k,1382) = lu(k,1382) - lu(k,1317) * lu(k,1372) + lu(k,1383) = - lu(k,1318) * lu(k,1372) + lu(k,1386) = lu(k,1386) - lu(k,1319) * lu(k,1372) + lu(k,1387) = lu(k,1387) - lu(k,1320) * lu(k,1372) + lu(k,1389) = lu(k,1389) - lu(k,1321) * lu(k,1372) + lu(k,1464) = lu(k,1464) - lu(k,1312) * lu(k,1463) + lu(k,1467) = lu(k,1467) - lu(k,1313) * lu(k,1463) + lu(k,1469) = lu(k,1469) - lu(k,1314) * lu(k,1463) + lu(k,1470) = lu(k,1470) - lu(k,1315) * lu(k,1463) + lu(k,1471) = lu(k,1471) - lu(k,1316) * lu(k,1463) + lu(k,1476) = lu(k,1476) - lu(k,1317) * lu(k,1463) + lu(k,1477) = lu(k,1477) - lu(k,1318) * lu(k,1463) + lu(k,1480) = lu(k,1480) - lu(k,1319) * lu(k,1463) + lu(k,1481) = lu(k,1481) - lu(k,1320) * lu(k,1463) + lu(k,1483) = lu(k,1483) - lu(k,1321) * lu(k,1463) + lu(k,1673) = lu(k,1673) - lu(k,1312) * lu(k,1672) + lu(k,1676) = lu(k,1676) - lu(k,1313) * lu(k,1672) + lu(k,1678) = lu(k,1678) - lu(k,1314) * lu(k,1672) + lu(k,1679) = lu(k,1679) - lu(k,1315) * lu(k,1672) + lu(k,1680) = lu(k,1680) - lu(k,1316) * lu(k,1672) + lu(k,1687) = lu(k,1687) - lu(k,1317) * lu(k,1672) + lu(k,1691) = - lu(k,1318) * lu(k,1672) + lu(k,1695) = lu(k,1695) - lu(k,1319) * lu(k,1672) + lu(k,1696) = lu(k,1696) - lu(k,1320) * lu(k,1672) + lu(k,1698) = lu(k,1698) - lu(k,1321) * lu(k,1672) + lu(k,1886) = lu(k,1886) - lu(k,1312) * lu(k,1885) + lu(k,1889) = lu(k,1889) - lu(k,1313) * lu(k,1885) + lu(k,1891) = lu(k,1891) - lu(k,1314) * lu(k,1885) + lu(k,1892) = lu(k,1892) - lu(k,1315) * lu(k,1885) + lu(k,1893) = lu(k,1893) - lu(k,1316) * lu(k,1885) + lu(k,1904) = lu(k,1904) - lu(k,1317) * lu(k,1885) + lu(k,1908) = lu(k,1908) - lu(k,1318) * lu(k,1885) + lu(k,1912) = lu(k,1912) - lu(k,1319) * lu(k,1885) + lu(k,1913) = lu(k,1913) - lu(k,1320) * lu(k,1885) + lu(k,1915) = lu(k,1915) - lu(k,1321) * lu(k,1885) + lu(k,2084) = lu(k,2084) - lu(k,1312) * lu(k,2083) + lu(k,2087) = - lu(k,1313) * lu(k,2083) + lu(k,2089) = - lu(k,1314) * lu(k,2083) + lu(k,2090) = lu(k,2090) - lu(k,1315) * lu(k,2083) + lu(k,2091) = lu(k,2091) - lu(k,1316) * lu(k,2083) + lu(k,2100) = lu(k,2100) - lu(k,1317) * lu(k,2083) + lu(k,2104) = lu(k,2104) - lu(k,1318) * lu(k,2083) + lu(k,2108) = lu(k,2108) - lu(k,1319) * lu(k,2083) + lu(k,2109) = lu(k,2109) - lu(k,1320) * lu(k,2083) + lu(k,2111) = lu(k,2111) - lu(k,1321) * lu(k,2083) + lu(k,2218) = lu(k,2218) - lu(k,1312) * lu(k,2217) + lu(k,2221) = lu(k,2221) - lu(k,1313) * lu(k,2217) + lu(k,2223) = lu(k,2223) - lu(k,1314) * lu(k,2217) + lu(k,2224) = lu(k,2224) - lu(k,1315) * lu(k,2217) + lu(k,2225) = lu(k,2225) - lu(k,1316) * lu(k,2217) + lu(k,2233) = lu(k,2233) - lu(k,1317) * lu(k,2217) + lu(k,2237) = lu(k,2237) - lu(k,1318) * lu(k,2217) + lu(k,2241) = lu(k,2241) - lu(k,1319) * lu(k,2217) + lu(k,2242) = lu(k,2242) - lu(k,1320) * lu(k,2217) + lu(k,2244) = lu(k,2244) - lu(k,1321) * lu(k,2217) + lu(k,2277) = lu(k,2277) - lu(k,1312) * lu(k,2276) + lu(k,2280) = lu(k,2280) - lu(k,1313) * lu(k,2276) + lu(k,2282) = lu(k,2282) - lu(k,1314) * lu(k,2276) + lu(k,2283) = lu(k,2283) - lu(k,1315) * lu(k,2276) + lu(k,2284) = lu(k,2284) - lu(k,1316) * lu(k,2276) + lu(k,2293) = lu(k,2293) - lu(k,1317) * lu(k,2276) + lu(k,2297) = lu(k,2297) - lu(k,1318) * lu(k,2276) + lu(k,2301) = lu(k,2301) - lu(k,1319) * lu(k,2276) + lu(k,2302) = lu(k,2302) - lu(k,1320) * lu(k,2276) + lu(k,2304) = lu(k,2304) - lu(k,1321) * lu(k,2276) + lu(k,2396) = lu(k,2396) - lu(k,1312) * lu(k,2395) + lu(k,2399) = lu(k,2399) - lu(k,1313) * lu(k,2395) + lu(k,2401) = lu(k,2401) - lu(k,1314) * lu(k,2395) + lu(k,2402) = lu(k,2402) - lu(k,1315) * lu(k,2395) + lu(k,2403) = lu(k,2403) - lu(k,1316) * lu(k,2395) + lu(k,2413) = lu(k,2413) - lu(k,1317) * lu(k,2395) + lu(k,2417) = lu(k,2417) - lu(k,1318) * lu(k,2395) + lu(k,2421) = lu(k,2421) - lu(k,1319) * lu(k,2395) + lu(k,2422) = lu(k,2422) - lu(k,1320) * lu(k,2395) + lu(k,2424) = lu(k,2424) - lu(k,1321) * lu(k,2395) + lu(k,1323) = 1._r8 / lu(k,1323) + lu(k,1324) = lu(k,1324) * lu(k,1323) + lu(k,1325) = lu(k,1325) * lu(k,1323) + lu(k,1326) = lu(k,1326) * lu(k,1323) + lu(k,1327) = lu(k,1327) * lu(k,1323) + lu(k,1328) = lu(k,1328) * lu(k,1323) + lu(k,1329) = lu(k,1329) * lu(k,1323) + lu(k,1330) = lu(k,1330) * lu(k,1323) + lu(k,1345) = lu(k,1345) - lu(k,1324) * lu(k,1340) + lu(k,1346) = lu(k,1346) - lu(k,1325) * lu(k,1340) + lu(k,1348) = lu(k,1348) - lu(k,1326) * lu(k,1340) + lu(k,1349) = lu(k,1349) - lu(k,1327) * lu(k,1340) + lu(k,1352) = lu(k,1352) - lu(k,1328) * lu(k,1340) + lu(k,1353) = lu(k,1353) - lu(k,1329) * lu(k,1340) + lu(k,1356) = lu(k,1356) - lu(k,1330) * lu(k,1340) + lu(k,1378) = lu(k,1378) - lu(k,1324) * lu(k,1373) + lu(k,1379) = lu(k,1379) - lu(k,1325) * lu(k,1373) + lu(k,1381) = lu(k,1381) - lu(k,1326) * lu(k,1373) + lu(k,1382) = lu(k,1382) - lu(k,1327) * lu(k,1373) + lu(k,1385) = lu(k,1385) - lu(k,1328) * lu(k,1373) + lu(k,1386) = lu(k,1386) - lu(k,1329) * lu(k,1373) + lu(k,1389) = lu(k,1389) - lu(k,1330) * lu(k,1373) + lu(k,1400) = lu(k,1400) - lu(k,1324) * lu(k,1397) + lu(k,1401) = lu(k,1401) - lu(k,1325) * lu(k,1397) + lu(k,1403) = lu(k,1403) - lu(k,1326) * lu(k,1397) + lu(k,1404) = lu(k,1404) - lu(k,1327) * lu(k,1397) + lu(k,1406) = lu(k,1406) - lu(k,1328) * lu(k,1397) + lu(k,1407) = lu(k,1407) - lu(k,1329) * lu(k,1397) + lu(k,1410) = lu(k,1410) - lu(k,1330) * lu(k,1397) + lu(k,1420) = lu(k,1420) - lu(k,1324) * lu(k,1416) + lu(k,1421) = lu(k,1421) - lu(k,1325) * lu(k,1416) + lu(k,1425) = lu(k,1425) - lu(k,1326) * lu(k,1416) + lu(k,1426) = lu(k,1426) - lu(k,1327) * lu(k,1416) + lu(k,1429) = lu(k,1429) - lu(k,1328) * lu(k,1416) + lu(k,1430) = lu(k,1430) - lu(k,1329) * lu(k,1416) + lu(k,1433) = lu(k,1433) - lu(k,1330) * lu(k,1416) + lu(k,1440) = lu(k,1440) - lu(k,1324) * lu(k,1438) + lu(k,1441) = lu(k,1441) - lu(k,1325) * lu(k,1438) + lu(k,1443) = - lu(k,1326) * lu(k,1438) + lu(k,1444) = lu(k,1444) - lu(k,1327) * lu(k,1438) + lu(k,1447) = lu(k,1447) - lu(k,1328) * lu(k,1438) + lu(k,1448) = lu(k,1448) - lu(k,1329) * lu(k,1438) + lu(k,1451) = lu(k,1451) - lu(k,1330) * lu(k,1438) + lu(k,1470) = lu(k,1470) - lu(k,1324) * lu(k,1464) + lu(k,1471) = lu(k,1471) - lu(k,1325) * lu(k,1464) + lu(k,1475) = lu(k,1475) - lu(k,1326) * lu(k,1464) + lu(k,1476) = lu(k,1476) - lu(k,1327) * lu(k,1464) + lu(k,1479) = lu(k,1479) - lu(k,1328) * lu(k,1464) + lu(k,1480) = lu(k,1480) - lu(k,1329) * lu(k,1464) + lu(k,1483) = lu(k,1483) - lu(k,1330) * lu(k,1464) + lu(k,1679) = lu(k,1679) - lu(k,1324) * lu(k,1673) + lu(k,1680) = lu(k,1680) - lu(k,1325) * lu(k,1673) + lu(k,1685) = lu(k,1685) - lu(k,1326) * lu(k,1673) + lu(k,1687) = lu(k,1687) - lu(k,1327) * lu(k,1673) + lu(k,1694) = lu(k,1694) - lu(k,1328) * lu(k,1673) + lu(k,1695) = lu(k,1695) - lu(k,1329) * lu(k,1673) + lu(k,1698) = lu(k,1698) - lu(k,1330) * lu(k,1673) + lu(k,1892) = lu(k,1892) - lu(k,1324) * lu(k,1886) + lu(k,1893) = lu(k,1893) - lu(k,1325) * lu(k,1886) + lu(k,1902) = lu(k,1902) - lu(k,1326) * lu(k,1886) + lu(k,1904) = lu(k,1904) - lu(k,1327) * lu(k,1886) + lu(k,1911) = lu(k,1911) - lu(k,1328) * lu(k,1886) + lu(k,1912) = lu(k,1912) - lu(k,1329) * lu(k,1886) + lu(k,1915) = lu(k,1915) - lu(k,1330) * lu(k,1886) + lu(k,1982) = lu(k,1982) - lu(k,1324) * lu(k,1981) + lu(k,1983) = lu(k,1983) - lu(k,1325) * lu(k,1981) + lu(k,1991) = lu(k,1991) - lu(k,1326) * lu(k,1981) + lu(k,1993) = lu(k,1993) - lu(k,1327) * lu(k,1981) + lu(k,2000) = lu(k,2000) - lu(k,1328) * lu(k,1981) + lu(k,2001) = lu(k,2001) - lu(k,1329) * lu(k,1981) + lu(k,2004) = lu(k,2004) - lu(k,1330) * lu(k,1981) + lu(k,2090) = lu(k,2090) - lu(k,1324) * lu(k,2084) + lu(k,2091) = lu(k,2091) - lu(k,1325) * lu(k,2084) + lu(k,2098) = lu(k,2098) - lu(k,1326) * lu(k,2084) + lu(k,2100) = lu(k,2100) - lu(k,1327) * lu(k,2084) + lu(k,2107) = lu(k,2107) - lu(k,1328) * lu(k,2084) + lu(k,2108) = lu(k,2108) - lu(k,1329) * lu(k,2084) + lu(k,2111) = lu(k,2111) - lu(k,1330) * lu(k,2084) + lu(k,2224) = lu(k,2224) - lu(k,1324) * lu(k,2218) + lu(k,2225) = lu(k,2225) - lu(k,1325) * lu(k,2218) + lu(k,2231) = lu(k,2231) - lu(k,1326) * lu(k,2218) + lu(k,2233) = lu(k,2233) - lu(k,1327) * lu(k,2218) + lu(k,2240) = lu(k,2240) - lu(k,1328) * lu(k,2218) + lu(k,2241) = lu(k,2241) - lu(k,1329) * lu(k,2218) + lu(k,2244) = lu(k,2244) - lu(k,1330) * lu(k,2218) + lu(k,2283) = lu(k,2283) - lu(k,1324) * lu(k,2277) + lu(k,2284) = lu(k,2284) - lu(k,1325) * lu(k,2277) + lu(k,2291) = lu(k,2291) - lu(k,1326) * lu(k,2277) + lu(k,2293) = lu(k,2293) - lu(k,1327) * lu(k,2277) + lu(k,2300) = lu(k,2300) - lu(k,1328) * lu(k,2277) + lu(k,2301) = lu(k,2301) - lu(k,1329) * lu(k,2277) + lu(k,2304) = lu(k,2304) - lu(k,1330) * lu(k,2277) + lu(k,2402) = lu(k,2402) - lu(k,1324) * lu(k,2396) + lu(k,2403) = lu(k,2403) - lu(k,1325) * lu(k,2396) + lu(k,2411) = lu(k,2411) - lu(k,1326) * lu(k,2396) + lu(k,2413) = lu(k,2413) - lu(k,1327) * lu(k,2396) + lu(k,2420) = lu(k,2420) - lu(k,1328) * lu(k,2396) + lu(k,2421) = lu(k,2421) - lu(k,1329) * lu(k,2396) + lu(k,2424) = lu(k,2424) - lu(k,1330) * lu(k,2396) + lu(k,2473) = lu(k,2473) - lu(k,1324) * lu(k,2471) + lu(k,2474) = lu(k,2474) - lu(k,1325) * lu(k,2471) + lu(k,2482) = lu(k,2482) - lu(k,1326) * lu(k,2471) + lu(k,2484) = lu(k,2484) - lu(k,1327) * lu(k,2471) + lu(k,2491) = lu(k,2491) - lu(k,1328) * lu(k,2471) + lu(k,2492) = lu(k,2492) - lu(k,1329) * lu(k,2471) + lu(k,2495) = lu(k,2495) - lu(k,1330) * lu(k,2471) + end do + end subroutine lu_fac27 + subroutine lu_fac28( 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,1341) = 1._r8 / lu(k,1341) + lu(k,1342) = lu(k,1342) * lu(k,1341) + lu(k,1343) = lu(k,1343) * lu(k,1341) + lu(k,1344) = lu(k,1344) * lu(k,1341) + lu(k,1345) = lu(k,1345) * lu(k,1341) + lu(k,1346) = lu(k,1346) * lu(k,1341) + lu(k,1347) = lu(k,1347) * lu(k,1341) + lu(k,1348) = lu(k,1348) * lu(k,1341) + lu(k,1349) = lu(k,1349) * lu(k,1341) + lu(k,1350) = lu(k,1350) * lu(k,1341) + lu(k,1351) = lu(k,1351) * lu(k,1341) + lu(k,1352) = lu(k,1352) * lu(k,1341) + lu(k,1353) = lu(k,1353) * lu(k,1341) + lu(k,1354) = lu(k,1354) * lu(k,1341) + lu(k,1355) = lu(k,1355) * lu(k,1341) + lu(k,1356) = lu(k,1356) * lu(k,1341) + lu(k,1467) = lu(k,1467) - lu(k,1342) * lu(k,1465) + lu(k,1468) = lu(k,1468) - lu(k,1343) * lu(k,1465) + lu(k,1469) = lu(k,1469) - lu(k,1344) * lu(k,1465) + lu(k,1470) = lu(k,1470) - lu(k,1345) * lu(k,1465) + lu(k,1471) = lu(k,1471) - lu(k,1346) * lu(k,1465) + lu(k,1474) = lu(k,1474) - lu(k,1347) * lu(k,1465) + lu(k,1475) = lu(k,1475) - lu(k,1348) * lu(k,1465) + lu(k,1476) = lu(k,1476) - lu(k,1349) * lu(k,1465) + lu(k,1477) = lu(k,1477) - lu(k,1350) * lu(k,1465) + lu(k,1478) = lu(k,1478) - lu(k,1351) * lu(k,1465) + lu(k,1479) = lu(k,1479) - lu(k,1352) * lu(k,1465) + lu(k,1480) = lu(k,1480) - lu(k,1353) * lu(k,1465) + lu(k,1481) = lu(k,1481) - lu(k,1354) * lu(k,1465) + lu(k,1482) = lu(k,1482) - lu(k,1355) * lu(k,1465) + lu(k,1483) = lu(k,1483) - lu(k,1356) * lu(k,1465) + lu(k,1676) = lu(k,1676) - lu(k,1342) * lu(k,1674) + lu(k,1677) = lu(k,1677) - lu(k,1343) * lu(k,1674) + lu(k,1678) = lu(k,1678) - lu(k,1344) * lu(k,1674) + lu(k,1679) = lu(k,1679) - lu(k,1345) * lu(k,1674) + lu(k,1680) = lu(k,1680) - lu(k,1346) * lu(k,1674) + lu(k,1684) = lu(k,1684) - lu(k,1347) * lu(k,1674) + lu(k,1685) = lu(k,1685) - lu(k,1348) * lu(k,1674) + lu(k,1687) = lu(k,1687) - lu(k,1349) * lu(k,1674) + lu(k,1691) = lu(k,1691) - lu(k,1350) * lu(k,1674) + lu(k,1693) = lu(k,1693) - lu(k,1351) * lu(k,1674) + lu(k,1694) = lu(k,1694) - lu(k,1352) * lu(k,1674) + lu(k,1695) = lu(k,1695) - lu(k,1353) * lu(k,1674) + lu(k,1696) = lu(k,1696) - lu(k,1354) * lu(k,1674) + lu(k,1697) = lu(k,1697) - lu(k,1355) * lu(k,1674) + lu(k,1698) = lu(k,1698) - lu(k,1356) * lu(k,1674) + lu(k,1889) = lu(k,1889) - lu(k,1342) * lu(k,1887) + lu(k,1890) = lu(k,1890) - lu(k,1343) * lu(k,1887) + lu(k,1891) = lu(k,1891) - lu(k,1344) * lu(k,1887) + lu(k,1892) = lu(k,1892) - lu(k,1345) * lu(k,1887) + lu(k,1893) = lu(k,1893) - lu(k,1346) * lu(k,1887) + lu(k,1901) = lu(k,1901) - lu(k,1347) * lu(k,1887) + lu(k,1902) = lu(k,1902) - lu(k,1348) * lu(k,1887) + lu(k,1904) = lu(k,1904) - lu(k,1349) * lu(k,1887) + lu(k,1908) = lu(k,1908) - lu(k,1350) * lu(k,1887) + lu(k,1910) = lu(k,1910) - lu(k,1351) * lu(k,1887) + lu(k,1911) = lu(k,1911) - lu(k,1352) * lu(k,1887) + lu(k,1912) = lu(k,1912) - lu(k,1353) * lu(k,1887) + lu(k,1913) = lu(k,1913) - lu(k,1354) * lu(k,1887) + lu(k,1914) = lu(k,1914) - lu(k,1355) * lu(k,1887) + lu(k,1915) = lu(k,1915) - lu(k,1356) * lu(k,1887) + lu(k,2087) = lu(k,2087) - lu(k,1342) * lu(k,2085) + lu(k,2088) = lu(k,2088) - lu(k,1343) * lu(k,2085) + lu(k,2089) = lu(k,2089) - lu(k,1344) * lu(k,2085) + lu(k,2090) = lu(k,2090) - lu(k,1345) * lu(k,2085) + lu(k,2091) = lu(k,2091) - lu(k,1346) * lu(k,2085) + lu(k,2097) = lu(k,2097) - lu(k,1347) * lu(k,2085) + lu(k,2098) = lu(k,2098) - lu(k,1348) * lu(k,2085) + lu(k,2100) = lu(k,2100) - lu(k,1349) * lu(k,2085) + lu(k,2104) = lu(k,2104) - lu(k,1350) * lu(k,2085) + lu(k,2106) = lu(k,2106) - lu(k,1351) * lu(k,2085) + lu(k,2107) = lu(k,2107) - lu(k,1352) * lu(k,2085) + lu(k,2108) = lu(k,2108) - lu(k,1353) * lu(k,2085) + lu(k,2109) = lu(k,2109) - lu(k,1354) * lu(k,2085) + lu(k,2110) = lu(k,2110) - lu(k,1355) * lu(k,2085) + lu(k,2111) = lu(k,2111) - lu(k,1356) * lu(k,2085) + lu(k,2221) = lu(k,2221) - lu(k,1342) * lu(k,2219) + lu(k,2222) = lu(k,2222) - lu(k,1343) * lu(k,2219) + lu(k,2223) = lu(k,2223) - lu(k,1344) * lu(k,2219) + lu(k,2224) = lu(k,2224) - lu(k,1345) * lu(k,2219) + lu(k,2225) = lu(k,2225) - lu(k,1346) * lu(k,2219) + lu(k,2230) = lu(k,2230) - lu(k,1347) * lu(k,2219) + lu(k,2231) = lu(k,2231) - lu(k,1348) * lu(k,2219) + lu(k,2233) = lu(k,2233) - lu(k,1349) * lu(k,2219) + lu(k,2237) = lu(k,2237) - lu(k,1350) * lu(k,2219) + lu(k,2239) = lu(k,2239) - lu(k,1351) * lu(k,2219) + lu(k,2240) = lu(k,2240) - lu(k,1352) * lu(k,2219) + lu(k,2241) = lu(k,2241) - lu(k,1353) * lu(k,2219) + lu(k,2242) = lu(k,2242) - lu(k,1354) * lu(k,2219) + lu(k,2243) = lu(k,2243) - lu(k,1355) * lu(k,2219) + lu(k,2244) = lu(k,2244) - lu(k,1356) * lu(k,2219) + lu(k,2280) = lu(k,2280) - lu(k,1342) * lu(k,2278) + lu(k,2281) = lu(k,2281) - lu(k,1343) * lu(k,2278) + lu(k,2282) = lu(k,2282) - lu(k,1344) * lu(k,2278) + lu(k,2283) = lu(k,2283) - lu(k,1345) * lu(k,2278) + lu(k,2284) = lu(k,2284) - lu(k,1346) * lu(k,2278) + lu(k,2290) = lu(k,2290) - lu(k,1347) * lu(k,2278) + lu(k,2291) = lu(k,2291) - lu(k,1348) * lu(k,2278) + lu(k,2293) = lu(k,2293) - lu(k,1349) * lu(k,2278) + lu(k,2297) = lu(k,2297) - lu(k,1350) * lu(k,2278) + lu(k,2299) = lu(k,2299) - lu(k,1351) * lu(k,2278) + lu(k,2300) = lu(k,2300) - lu(k,1352) * lu(k,2278) + lu(k,2301) = lu(k,2301) - lu(k,1353) * lu(k,2278) + lu(k,2302) = lu(k,2302) - lu(k,1354) * lu(k,2278) + lu(k,2303) = lu(k,2303) - lu(k,1355) * lu(k,2278) + lu(k,2304) = lu(k,2304) - lu(k,1356) * lu(k,2278) + lu(k,2399) = lu(k,2399) - lu(k,1342) * lu(k,2397) + lu(k,2400) = lu(k,2400) - lu(k,1343) * lu(k,2397) + lu(k,2401) = lu(k,2401) - lu(k,1344) * lu(k,2397) + lu(k,2402) = lu(k,2402) - lu(k,1345) * lu(k,2397) + lu(k,2403) = lu(k,2403) - lu(k,1346) * lu(k,2397) + lu(k,2410) = lu(k,2410) - lu(k,1347) * lu(k,2397) + lu(k,2411) = lu(k,2411) - lu(k,1348) * lu(k,2397) + lu(k,2413) = lu(k,2413) - lu(k,1349) * lu(k,2397) + lu(k,2417) = lu(k,2417) - lu(k,1350) * lu(k,2397) + lu(k,2419) = lu(k,2419) - lu(k,1351) * lu(k,2397) + lu(k,2420) = lu(k,2420) - lu(k,1352) * lu(k,2397) + lu(k,2421) = lu(k,2421) - lu(k,1353) * lu(k,2397) + lu(k,2422) = lu(k,2422) - lu(k,1354) * lu(k,2397) + lu(k,2423) = lu(k,2423) - lu(k,1355) * lu(k,2397) + lu(k,2424) = lu(k,2424) - lu(k,1356) * lu(k,2397) + lu(k,1374) = 1._r8 / lu(k,1374) + lu(k,1375) = lu(k,1375) * lu(k,1374) + lu(k,1376) = lu(k,1376) * lu(k,1374) + lu(k,1377) = lu(k,1377) * lu(k,1374) + lu(k,1378) = lu(k,1378) * lu(k,1374) + lu(k,1379) = lu(k,1379) * lu(k,1374) + lu(k,1380) = lu(k,1380) * lu(k,1374) + lu(k,1381) = lu(k,1381) * lu(k,1374) + lu(k,1382) = lu(k,1382) * lu(k,1374) + lu(k,1383) = lu(k,1383) * lu(k,1374) + lu(k,1384) = lu(k,1384) * lu(k,1374) + lu(k,1385) = lu(k,1385) * lu(k,1374) + lu(k,1386) = lu(k,1386) * lu(k,1374) + lu(k,1387) = lu(k,1387) * lu(k,1374) + lu(k,1388) = lu(k,1388) * lu(k,1374) + lu(k,1389) = lu(k,1389) * lu(k,1374) + lu(k,1467) = lu(k,1467) - lu(k,1375) * lu(k,1466) + lu(k,1468) = lu(k,1468) - lu(k,1376) * lu(k,1466) + lu(k,1469) = lu(k,1469) - lu(k,1377) * lu(k,1466) + lu(k,1470) = lu(k,1470) - lu(k,1378) * lu(k,1466) + lu(k,1471) = lu(k,1471) - lu(k,1379) * lu(k,1466) + lu(k,1474) = lu(k,1474) - lu(k,1380) * lu(k,1466) + lu(k,1475) = lu(k,1475) - lu(k,1381) * lu(k,1466) + lu(k,1476) = lu(k,1476) - lu(k,1382) * lu(k,1466) + lu(k,1477) = lu(k,1477) - lu(k,1383) * lu(k,1466) + lu(k,1478) = lu(k,1478) - lu(k,1384) * lu(k,1466) + lu(k,1479) = lu(k,1479) - lu(k,1385) * lu(k,1466) + lu(k,1480) = lu(k,1480) - lu(k,1386) * lu(k,1466) + lu(k,1481) = lu(k,1481) - lu(k,1387) * lu(k,1466) + lu(k,1482) = lu(k,1482) - lu(k,1388) * lu(k,1466) + lu(k,1483) = lu(k,1483) - lu(k,1389) * lu(k,1466) + lu(k,1676) = lu(k,1676) - lu(k,1375) * lu(k,1675) + lu(k,1677) = lu(k,1677) - lu(k,1376) * lu(k,1675) + lu(k,1678) = lu(k,1678) - lu(k,1377) * lu(k,1675) + lu(k,1679) = lu(k,1679) - lu(k,1378) * lu(k,1675) + lu(k,1680) = lu(k,1680) - lu(k,1379) * lu(k,1675) + lu(k,1684) = lu(k,1684) - lu(k,1380) * lu(k,1675) + lu(k,1685) = lu(k,1685) - lu(k,1381) * lu(k,1675) + lu(k,1687) = lu(k,1687) - lu(k,1382) * lu(k,1675) + lu(k,1691) = lu(k,1691) - lu(k,1383) * lu(k,1675) + lu(k,1693) = lu(k,1693) - lu(k,1384) * lu(k,1675) + lu(k,1694) = lu(k,1694) - lu(k,1385) * lu(k,1675) + lu(k,1695) = lu(k,1695) - lu(k,1386) * lu(k,1675) + lu(k,1696) = lu(k,1696) - lu(k,1387) * lu(k,1675) + lu(k,1697) = lu(k,1697) - lu(k,1388) * lu(k,1675) + lu(k,1698) = lu(k,1698) - lu(k,1389) * lu(k,1675) + lu(k,1889) = lu(k,1889) - lu(k,1375) * lu(k,1888) + lu(k,1890) = lu(k,1890) - lu(k,1376) * lu(k,1888) + lu(k,1891) = lu(k,1891) - lu(k,1377) * lu(k,1888) + lu(k,1892) = lu(k,1892) - lu(k,1378) * lu(k,1888) + lu(k,1893) = lu(k,1893) - lu(k,1379) * lu(k,1888) + lu(k,1901) = lu(k,1901) - lu(k,1380) * lu(k,1888) + lu(k,1902) = lu(k,1902) - lu(k,1381) * lu(k,1888) + lu(k,1904) = lu(k,1904) - lu(k,1382) * lu(k,1888) + lu(k,1908) = lu(k,1908) - lu(k,1383) * lu(k,1888) + lu(k,1910) = lu(k,1910) - lu(k,1384) * lu(k,1888) + lu(k,1911) = lu(k,1911) - lu(k,1385) * lu(k,1888) + lu(k,1912) = lu(k,1912) - lu(k,1386) * lu(k,1888) + lu(k,1913) = lu(k,1913) - lu(k,1387) * lu(k,1888) + lu(k,1914) = lu(k,1914) - lu(k,1388) * lu(k,1888) + lu(k,1915) = lu(k,1915) - lu(k,1389) * lu(k,1888) + lu(k,2087) = lu(k,2087) - lu(k,1375) * lu(k,2086) + lu(k,2088) = lu(k,2088) - lu(k,1376) * lu(k,2086) + lu(k,2089) = lu(k,2089) - lu(k,1377) * lu(k,2086) + lu(k,2090) = lu(k,2090) - lu(k,1378) * lu(k,2086) + lu(k,2091) = lu(k,2091) - lu(k,1379) * lu(k,2086) + lu(k,2097) = lu(k,2097) - lu(k,1380) * lu(k,2086) + lu(k,2098) = lu(k,2098) - lu(k,1381) * lu(k,2086) + lu(k,2100) = lu(k,2100) - lu(k,1382) * lu(k,2086) + lu(k,2104) = lu(k,2104) - lu(k,1383) * lu(k,2086) + lu(k,2106) = lu(k,2106) - lu(k,1384) * lu(k,2086) + lu(k,2107) = lu(k,2107) - lu(k,1385) * lu(k,2086) + lu(k,2108) = lu(k,2108) - lu(k,1386) * lu(k,2086) + lu(k,2109) = lu(k,2109) - lu(k,1387) * lu(k,2086) + lu(k,2110) = lu(k,2110) - lu(k,1388) * lu(k,2086) + lu(k,2111) = lu(k,2111) - lu(k,1389) * lu(k,2086) + lu(k,2221) = lu(k,2221) - lu(k,1375) * lu(k,2220) + lu(k,2222) = lu(k,2222) - lu(k,1376) * lu(k,2220) + lu(k,2223) = lu(k,2223) - lu(k,1377) * lu(k,2220) + lu(k,2224) = lu(k,2224) - lu(k,1378) * lu(k,2220) + lu(k,2225) = lu(k,2225) - lu(k,1379) * lu(k,2220) + lu(k,2230) = lu(k,2230) - lu(k,1380) * lu(k,2220) + lu(k,2231) = lu(k,2231) - lu(k,1381) * lu(k,2220) + lu(k,2233) = lu(k,2233) - lu(k,1382) * lu(k,2220) + lu(k,2237) = lu(k,2237) - lu(k,1383) * lu(k,2220) + lu(k,2239) = lu(k,2239) - lu(k,1384) * lu(k,2220) + lu(k,2240) = lu(k,2240) - lu(k,1385) * lu(k,2220) + lu(k,2241) = lu(k,2241) - lu(k,1386) * lu(k,2220) + lu(k,2242) = lu(k,2242) - lu(k,1387) * lu(k,2220) + lu(k,2243) = lu(k,2243) - lu(k,1388) * lu(k,2220) + lu(k,2244) = lu(k,2244) - lu(k,1389) * lu(k,2220) + lu(k,2280) = lu(k,2280) - lu(k,1375) * lu(k,2279) + lu(k,2281) = lu(k,2281) - lu(k,1376) * lu(k,2279) + lu(k,2282) = lu(k,2282) - lu(k,1377) * lu(k,2279) + lu(k,2283) = lu(k,2283) - lu(k,1378) * lu(k,2279) + lu(k,2284) = lu(k,2284) - lu(k,1379) * lu(k,2279) + lu(k,2290) = lu(k,2290) - lu(k,1380) * lu(k,2279) + lu(k,2291) = lu(k,2291) - lu(k,1381) * lu(k,2279) + lu(k,2293) = lu(k,2293) - lu(k,1382) * lu(k,2279) + lu(k,2297) = lu(k,2297) - lu(k,1383) * lu(k,2279) + lu(k,2299) = lu(k,2299) - lu(k,1384) * lu(k,2279) + lu(k,2300) = lu(k,2300) - lu(k,1385) * lu(k,2279) + lu(k,2301) = lu(k,2301) - lu(k,1386) * lu(k,2279) + lu(k,2302) = lu(k,2302) - lu(k,1387) * lu(k,2279) + lu(k,2303) = lu(k,2303) - lu(k,1388) * lu(k,2279) + lu(k,2304) = lu(k,2304) - lu(k,1389) * lu(k,2279) + lu(k,2399) = lu(k,2399) - lu(k,1375) * lu(k,2398) + lu(k,2400) = lu(k,2400) - lu(k,1376) * lu(k,2398) + lu(k,2401) = lu(k,2401) - lu(k,1377) * lu(k,2398) + lu(k,2402) = lu(k,2402) - lu(k,1378) * lu(k,2398) + lu(k,2403) = lu(k,2403) - lu(k,1379) * lu(k,2398) + lu(k,2410) = lu(k,2410) - lu(k,1380) * lu(k,2398) + lu(k,2411) = lu(k,2411) - lu(k,1381) * lu(k,2398) + lu(k,2413) = lu(k,2413) - lu(k,1382) * lu(k,2398) + lu(k,2417) = lu(k,2417) - lu(k,1383) * lu(k,2398) + lu(k,2419) = lu(k,2419) - lu(k,1384) * lu(k,2398) + lu(k,2420) = lu(k,2420) - lu(k,1385) * lu(k,2398) + lu(k,2421) = lu(k,2421) - lu(k,1386) * lu(k,2398) + lu(k,2422) = lu(k,2422) - lu(k,1387) * lu(k,2398) + lu(k,2423) = lu(k,2423) - lu(k,1388) * lu(k,2398) + lu(k,2424) = lu(k,2424) - lu(k,1389) * lu(k,2398) + lu(k,1398) = 1._r8 / lu(k,1398) + lu(k,1399) = lu(k,1399) * lu(k,1398) + lu(k,1400) = lu(k,1400) * lu(k,1398) + lu(k,1401) = lu(k,1401) * lu(k,1398) + lu(k,1402) = lu(k,1402) * lu(k,1398) + lu(k,1403) = lu(k,1403) * lu(k,1398) + lu(k,1404) = lu(k,1404) * lu(k,1398) + lu(k,1405) = lu(k,1405) * lu(k,1398) + lu(k,1406) = lu(k,1406) * lu(k,1398) + lu(k,1407) = lu(k,1407) * lu(k,1398) + lu(k,1408) = lu(k,1408) * lu(k,1398) + lu(k,1409) = lu(k,1409) * lu(k,1398) + lu(k,1410) = lu(k,1410) * lu(k,1398) + lu(k,1419) = - lu(k,1399) * lu(k,1417) + lu(k,1420) = lu(k,1420) - lu(k,1400) * lu(k,1417) + lu(k,1421) = lu(k,1421) - lu(k,1401) * lu(k,1417) + lu(k,1424) = lu(k,1424) - lu(k,1402) * lu(k,1417) + lu(k,1425) = lu(k,1425) - lu(k,1403) * lu(k,1417) + lu(k,1426) = lu(k,1426) - lu(k,1404) * lu(k,1417) + lu(k,1428) = lu(k,1428) - lu(k,1405) * lu(k,1417) + lu(k,1429) = lu(k,1429) - lu(k,1406) * lu(k,1417) + lu(k,1430) = lu(k,1430) - lu(k,1407) * lu(k,1417) + lu(k,1431) = lu(k,1431) - lu(k,1408) * lu(k,1417) + lu(k,1432) = lu(k,1432) - lu(k,1409) * lu(k,1417) + lu(k,1433) = lu(k,1433) - lu(k,1410) * lu(k,1417) + lu(k,1469) = lu(k,1469) - lu(k,1399) * lu(k,1467) + lu(k,1470) = lu(k,1470) - lu(k,1400) * lu(k,1467) + lu(k,1471) = lu(k,1471) - lu(k,1401) * lu(k,1467) + lu(k,1474) = lu(k,1474) - lu(k,1402) * lu(k,1467) + lu(k,1475) = lu(k,1475) - lu(k,1403) * lu(k,1467) + lu(k,1476) = lu(k,1476) - lu(k,1404) * lu(k,1467) + lu(k,1478) = lu(k,1478) - lu(k,1405) * lu(k,1467) + lu(k,1479) = lu(k,1479) - lu(k,1406) * lu(k,1467) + lu(k,1480) = lu(k,1480) - lu(k,1407) * lu(k,1467) + lu(k,1481) = lu(k,1481) - lu(k,1408) * lu(k,1467) + lu(k,1482) = lu(k,1482) - lu(k,1409) * lu(k,1467) + lu(k,1483) = lu(k,1483) - lu(k,1410) * lu(k,1467) + lu(k,1678) = lu(k,1678) - lu(k,1399) * lu(k,1676) + lu(k,1679) = lu(k,1679) - lu(k,1400) * lu(k,1676) + lu(k,1680) = lu(k,1680) - lu(k,1401) * lu(k,1676) + lu(k,1684) = lu(k,1684) - lu(k,1402) * lu(k,1676) + lu(k,1685) = lu(k,1685) - lu(k,1403) * lu(k,1676) + lu(k,1687) = lu(k,1687) - lu(k,1404) * lu(k,1676) + lu(k,1693) = lu(k,1693) - lu(k,1405) * lu(k,1676) + lu(k,1694) = lu(k,1694) - lu(k,1406) * lu(k,1676) + lu(k,1695) = lu(k,1695) - lu(k,1407) * lu(k,1676) + lu(k,1696) = lu(k,1696) - lu(k,1408) * lu(k,1676) + lu(k,1697) = lu(k,1697) - lu(k,1409) * lu(k,1676) + lu(k,1698) = lu(k,1698) - lu(k,1410) * lu(k,1676) + lu(k,1891) = lu(k,1891) - lu(k,1399) * lu(k,1889) + lu(k,1892) = lu(k,1892) - lu(k,1400) * lu(k,1889) + lu(k,1893) = lu(k,1893) - lu(k,1401) * lu(k,1889) + lu(k,1901) = lu(k,1901) - lu(k,1402) * lu(k,1889) + lu(k,1902) = lu(k,1902) - lu(k,1403) * lu(k,1889) + lu(k,1904) = lu(k,1904) - lu(k,1404) * lu(k,1889) + lu(k,1910) = lu(k,1910) - lu(k,1405) * lu(k,1889) + lu(k,1911) = lu(k,1911) - lu(k,1406) * lu(k,1889) + lu(k,1912) = lu(k,1912) - lu(k,1407) * lu(k,1889) + lu(k,1913) = lu(k,1913) - lu(k,1408) * lu(k,1889) + lu(k,1914) = lu(k,1914) - lu(k,1409) * lu(k,1889) + lu(k,1915) = lu(k,1915) - lu(k,1410) * lu(k,1889) + lu(k,2089) = lu(k,2089) - lu(k,1399) * lu(k,2087) + lu(k,2090) = lu(k,2090) - lu(k,1400) * lu(k,2087) + lu(k,2091) = lu(k,2091) - lu(k,1401) * lu(k,2087) + lu(k,2097) = lu(k,2097) - lu(k,1402) * lu(k,2087) + lu(k,2098) = lu(k,2098) - lu(k,1403) * lu(k,2087) + lu(k,2100) = lu(k,2100) - lu(k,1404) * lu(k,2087) + lu(k,2106) = lu(k,2106) - lu(k,1405) * lu(k,2087) + lu(k,2107) = lu(k,2107) - lu(k,1406) * lu(k,2087) + lu(k,2108) = lu(k,2108) - lu(k,1407) * lu(k,2087) + lu(k,2109) = lu(k,2109) - lu(k,1408) * lu(k,2087) + lu(k,2110) = lu(k,2110) - lu(k,1409) * lu(k,2087) + lu(k,2111) = lu(k,2111) - lu(k,1410) * lu(k,2087) + lu(k,2223) = lu(k,2223) - lu(k,1399) * lu(k,2221) + lu(k,2224) = lu(k,2224) - lu(k,1400) * lu(k,2221) + lu(k,2225) = lu(k,2225) - lu(k,1401) * lu(k,2221) + lu(k,2230) = lu(k,2230) - lu(k,1402) * lu(k,2221) + lu(k,2231) = lu(k,2231) - lu(k,1403) * lu(k,2221) + lu(k,2233) = lu(k,2233) - lu(k,1404) * lu(k,2221) + lu(k,2239) = lu(k,2239) - lu(k,1405) * lu(k,2221) + lu(k,2240) = lu(k,2240) - lu(k,1406) * lu(k,2221) + lu(k,2241) = lu(k,2241) - lu(k,1407) * lu(k,2221) + lu(k,2242) = lu(k,2242) - lu(k,1408) * lu(k,2221) + lu(k,2243) = lu(k,2243) - lu(k,1409) * lu(k,2221) + lu(k,2244) = lu(k,2244) - lu(k,1410) * lu(k,2221) + lu(k,2282) = lu(k,2282) - lu(k,1399) * lu(k,2280) + lu(k,2283) = lu(k,2283) - lu(k,1400) * lu(k,2280) + lu(k,2284) = lu(k,2284) - lu(k,1401) * lu(k,2280) + lu(k,2290) = lu(k,2290) - lu(k,1402) * lu(k,2280) + lu(k,2291) = lu(k,2291) - lu(k,1403) * lu(k,2280) + lu(k,2293) = lu(k,2293) - lu(k,1404) * lu(k,2280) + lu(k,2299) = lu(k,2299) - lu(k,1405) * lu(k,2280) + lu(k,2300) = lu(k,2300) - lu(k,1406) * lu(k,2280) + lu(k,2301) = lu(k,2301) - lu(k,1407) * lu(k,2280) + lu(k,2302) = lu(k,2302) - lu(k,1408) * lu(k,2280) + lu(k,2303) = lu(k,2303) - lu(k,1409) * lu(k,2280) + lu(k,2304) = lu(k,2304) - lu(k,1410) * lu(k,2280) + lu(k,2401) = lu(k,2401) - lu(k,1399) * lu(k,2399) + lu(k,2402) = lu(k,2402) - lu(k,1400) * lu(k,2399) + lu(k,2403) = lu(k,2403) - lu(k,1401) * lu(k,2399) + lu(k,2410) = lu(k,2410) - lu(k,1402) * lu(k,2399) + lu(k,2411) = lu(k,2411) - lu(k,1403) * lu(k,2399) + lu(k,2413) = lu(k,2413) - lu(k,1404) * lu(k,2399) + lu(k,2419) = lu(k,2419) - lu(k,1405) * lu(k,2399) + lu(k,2420) = lu(k,2420) - lu(k,1406) * lu(k,2399) + lu(k,2421) = lu(k,2421) - lu(k,1407) * lu(k,2399) + lu(k,2422) = lu(k,2422) - lu(k,1408) * lu(k,2399) + lu(k,2423) = lu(k,2423) - lu(k,1409) * lu(k,2399) + lu(k,2424) = lu(k,2424) - lu(k,1410) * lu(k,2399) + lu(k,1418) = 1._r8 / lu(k,1418) + lu(k,1419) = lu(k,1419) * lu(k,1418) + lu(k,1420) = lu(k,1420) * lu(k,1418) + lu(k,1421) = lu(k,1421) * lu(k,1418) + lu(k,1422) = lu(k,1422) * lu(k,1418) + lu(k,1423) = lu(k,1423) * lu(k,1418) + lu(k,1424) = lu(k,1424) * lu(k,1418) + lu(k,1425) = lu(k,1425) * lu(k,1418) + lu(k,1426) = lu(k,1426) * lu(k,1418) + lu(k,1427) = lu(k,1427) * lu(k,1418) + lu(k,1428) = lu(k,1428) * lu(k,1418) + lu(k,1429) = lu(k,1429) * lu(k,1418) + lu(k,1430) = lu(k,1430) * lu(k,1418) + lu(k,1431) = lu(k,1431) * lu(k,1418) + lu(k,1432) = lu(k,1432) * lu(k,1418) + lu(k,1433) = lu(k,1433) * lu(k,1418) + lu(k,1469) = lu(k,1469) - lu(k,1419) * lu(k,1468) + lu(k,1470) = lu(k,1470) - lu(k,1420) * lu(k,1468) + lu(k,1471) = lu(k,1471) - lu(k,1421) * lu(k,1468) + lu(k,1472) = - lu(k,1422) * lu(k,1468) + lu(k,1473) = - lu(k,1423) * lu(k,1468) + lu(k,1474) = lu(k,1474) - lu(k,1424) * lu(k,1468) + lu(k,1475) = lu(k,1475) - lu(k,1425) * lu(k,1468) + lu(k,1476) = lu(k,1476) - lu(k,1426) * lu(k,1468) + lu(k,1477) = lu(k,1477) - lu(k,1427) * lu(k,1468) + lu(k,1478) = lu(k,1478) - lu(k,1428) * lu(k,1468) + lu(k,1479) = lu(k,1479) - lu(k,1429) * lu(k,1468) + lu(k,1480) = lu(k,1480) - lu(k,1430) * lu(k,1468) + lu(k,1481) = lu(k,1481) - lu(k,1431) * lu(k,1468) + lu(k,1482) = lu(k,1482) - lu(k,1432) * lu(k,1468) + lu(k,1483) = lu(k,1483) - lu(k,1433) * lu(k,1468) + lu(k,1678) = lu(k,1678) - lu(k,1419) * lu(k,1677) + lu(k,1679) = lu(k,1679) - lu(k,1420) * lu(k,1677) + lu(k,1680) = lu(k,1680) - lu(k,1421) * lu(k,1677) + lu(k,1681) = lu(k,1681) - lu(k,1422) * lu(k,1677) + lu(k,1683) = - lu(k,1423) * lu(k,1677) + lu(k,1684) = lu(k,1684) - lu(k,1424) * lu(k,1677) + lu(k,1685) = lu(k,1685) - lu(k,1425) * lu(k,1677) + lu(k,1687) = lu(k,1687) - lu(k,1426) * lu(k,1677) + lu(k,1691) = lu(k,1691) - lu(k,1427) * lu(k,1677) + lu(k,1693) = lu(k,1693) - lu(k,1428) * lu(k,1677) + lu(k,1694) = lu(k,1694) - lu(k,1429) * lu(k,1677) + lu(k,1695) = lu(k,1695) - lu(k,1430) * lu(k,1677) + lu(k,1696) = lu(k,1696) - lu(k,1431) * lu(k,1677) + lu(k,1697) = lu(k,1697) - lu(k,1432) * lu(k,1677) + lu(k,1698) = lu(k,1698) - lu(k,1433) * lu(k,1677) + lu(k,1891) = lu(k,1891) - lu(k,1419) * lu(k,1890) + lu(k,1892) = lu(k,1892) - lu(k,1420) * lu(k,1890) + lu(k,1893) = lu(k,1893) - lu(k,1421) * lu(k,1890) + lu(k,1898) = lu(k,1898) - lu(k,1422) * lu(k,1890) + lu(k,1900) = lu(k,1900) - lu(k,1423) * lu(k,1890) + lu(k,1901) = lu(k,1901) - lu(k,1424) * lu(k,1890) + lu(k,1902) = lu(k,1902) - lu(k,1425) * lu(k,1890) + lu(k,1904) = lu(k,1904) - lu(k,1426) * lu(k,1890) + lu(k,1908) = lu(k,1908) - lu(k,1427) * lu(k,1890) + lu(k,1910) = lu(k,1910) - lu(k,1428) * lu(k,1890) + lu(k,1911) = lu(k,1911) - lu(k,1429) * lu(k,1890) + lu(k,1912) = lu(k,1912) - lu(k,1430) * lu(k,1890) + lu(k,1913) = lu(k,1913) - lu(k,1431) * lu(k,1890) + lu(k,1914) = lu(k,1914) - lu(k,1432) * lu(k,1890) + lu(k,1915) = lu(k,1915) - lu(k,1433) * lu(k,1890) + lu(k,2089) = lu(k,2089) - lu(k,1419) * lu(k,2088) + lu(k,2090) = lu(k,2090) - lu(k,1420) * lu(k,2088) + lu(k,2091) = lu(k,2091) - lu(k,1421) * lu(k,2088) + lu(k,2094) = lu(k,2094) - lu(k,1422) * lu(k,2088) + lu(k,2096) = lu(k,2096) - lu(k,1423) * lu(k,2088) + lu(k,2097) = lu(k,2097) - lu(k,1424) * lu(k,2088) + lu(k,2098) = lu(k,2098) - lu(k,1425) * lu(k,2088) + lu(k,2100) = lu(k,2100) - lu(k,1426) * lu(k,2088) + lu(k,2104) = lu(k,2104) - lu(k,1427) * lu(k,2088) + lu(k,2106) = lu(k,2106) - lu(k,1428) * lu(k,2088) + lu(k,2107) = lu(k,2107) - lu(k,1429) * lu(k,2088) + lu(k,2108) = lu(k,2108) - lu(k,1430) * lu(k,2088) + lu(k,2109) = lu(k,2109) - lu(k,1431) * lu(k,2088) + lu(k,2110) = lu(k,2110) - lu(k,1432) * lu(k,2088) + lu(k,2111) = lu(k,2111) - lu(k,1433) * lu(k,2088) + lu(k,2223) = lu(k,2223) - lu(k,1419) * lu(k,2222) + lu(k,2224) = lu(k,2224) - lu(k,1420) * lu(k,2222) + lu(k,2225) = lu(k,2225) - lu(k,1421) * lu(k,2222) + lu(k,2227) = lu(k,2227) - lu(k,1422) * lu(k,2222) + lu(k,2229) = - lu(k,1423) * lu(k,2222) + lu(k,2230) = lu(k,2230) - lu(k,1424) * lu(k,2222) + lu(k,2231) = lu(k,2231) - lu(k,1425) * lu(k,2222) + lu(k,2233) = lu(k,2233) - lu(k,1426) * lu(k,2222) + lu(k,2237) = lu(k,2237) - lu(k,1427) * lu(k,2222) + lu(k,2239) = lu(k,2239) - lu(k,1428) * lu(k,2222) + lu(k,2240) = lu(k,2240) - lu(k,1429) * lu(k,2222) + lu(k,2241) = lu(k,2241) - lu(k,1430) * lu(k,2222) + lu(k,2242) = lu(k,2242) - lu(k,1431) * lu(k,2222) + lu(k,2243) = lu(k,2243) - lu(k,1432) * lu(k,2222) + lu(k,2244) = lu(k,2244) - lu(k,1433) * lu(k,2222) + lu(k,2282) = lu(k,2282) - lu(k,1419) * lu(k,2281) + lu(k,2283) = lu(k,2283) - lu(k,1420) * lu(k,2281) + lu(k,2284) = lu(k,2284) - lu(k,1421) * lu(k,2281) + lu(k,2287) = lu(k,2287) - lu(k,1422) * lu(k,2281) + lu(k,2289) = lu(k,2289) - lu(k,1423) * lu(k,2281) + lu(k,2290) = lu(k,2290) - lu(k,1424) * lu(k,2281) + lu(k,2291) = lu(k,2291) - lu(k,1425) * lu(k,2281) + lu(k,2293) = lu(k,2293) - lu(k,1426) * lu(k,2281) + lu(k,2297) = lu(k,2297) - lu(k,1427) * lu(k,2281) + lu(k,2299) = lu(k,2299) - lu(k,1428) * lu(k,2281) + lu(k,2300) = lu(k,2300) - lu(k,1429) * lu(k,2281) + lu(k,2301) = lu(k,2301) - lu(k,1430) * lu(k,2281) + lu(k,2302) = lu(k,2302) - lu(k,1431) * lu(k,2281) + lu(k,2303) = lu(k,2303) - lu(k,1432) * lu(k,2281) + lu(k,2304) = lu(k,2304) - lu(k,1433) * lu(k,2281) + lu(k,2401) = lu(k,2401) - lu(k,1419) * lu(k,2400) + lu(k,2402) = lu(k,2402) - lu(k,1420) * lu(k,2400) + lu(k,2403) = lu(k,2403) - lu(k,1421) * lu(k,2400) + lu(k,2407) = lu(k,2407) - lu(k,1422) * lu(k,2400) + lu(k,2409) = - lu(k,1423) * lu(k,2400) + lu(k,2410) = lu(k,2410) - lu(k,1424) * lu(k,2400) + lu(k,2411) = lu(k,2411) - lu(k,1425) * lu(k,2400) + lu(k,2413) = lu(k,2413) - lu(k,1426) * lu(k,2400) + lu(k,2417) = lu(k,2417) - lu(k,1427) * lu(k,2400) + lu(k,2419) = lu(k,2419) - lu(k,1428) * lu(k,2400) + lu(k,2420) = lu(k,2420) - lu(k,1429) * lu(k,2400) + lu(k,2421) = lu(k,2421) - lu(k,1430) * lu(k,2400) + lu(k,2422) = lu(k,2422) - lu(k,1431) * lu(k,2400) + lu(k,2423) = lu(k,2423) - lu(k,1432) * lu(k,2400) + lu(k,2424) = lu(k,2424) - lu(k,1433) * lu(k,2400) + end do + end subroutine lu_fac28 + subroutine lu_fac29( 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,1439) = 1._r8 / lu(k,1439) + lu(k,1440) = lu(k,1440) * lu(k,1439) + lu(k,1441) = lu(k,1441) * lu(k,1439) + lu(k,1442) = lu(k,1442) * lu(k,1439) + lu(k,1443) = lu(k,1443) * lu(k,1439) + lu(k,1444) = lu(k,1444) * lu(k,1439) + lu(k,1445) = lu(k,1445) * lu(k,1439) + lu(k,1446) = lu(k,1446) * lu(k,1439) + lu(k,1447) = lu(k,1447) * lu(k,1439) + lu(k,1448) = lu(k,1448) * lu(k,1439) + lu(k,1449) = lu(k,1449) * lu(k,1439) + lu(k,1450) = lu(k,1450) * lu(k,1439) + lu(k,1451) = lu(k,1451) * lu(k,1439) + lu(k,1470) = lu(k,1470) - lu(k,1440) * lu(k,1469) + lu(k,1471) = lu(k,1471) - lu(k,1441) * lu(k,1469) + lu(k,1474) = lu(k,1474) - lu(k,1442) * lu(k,1469) + lu(k,1475) = lu(k,1475) - lu(k,1443) * lu(k,1469) + lu(k,1476) = lu(k,1476) - lu(k,1444) * lu(k,1469) + lu(k,1477) = lu(k,1477) - lu(k,1445) * lu(k,1469) + lu(k,1478) = lu(k,1478) - lu(k,1446) * lu(k,1469) + lu(k,1479) = lu(k,1479) - lu(k,1447) * lu(k,1469) + lu(k,1480) = lu(k,1480) - lu(k,1448) * lu(k,1469) + lu(k,1481) = lu(k,1481) - lu(k,1449) * lu(k,1469) + lu(k,1482) = lu(k,1482) - lu(k,1450) * lu(k,1469) + lu(k,1483) = lu(k,1483) - lu(k,1451) * lu(k,1469) + lu(k,1679) = lu(k,1679) - lu(k,1440) * lu(k,1678) + lu(k,1680) = lu(k,1680) - lu(k,1441) * lu(k,1678) + lu(k,1684) = lu(k,1684) - lu(k,1442) * lu(k,1678) + lu(k,1685) = lu(k,1685) - lu(k,1443) * lu(k,1678) + lu(k,1687) = lu(k,1687) - lu(k,1444) * lu(k,1678) + lu(k,1691) = lu(k,1691) - lu(k,1445) * lu(k,1678) + lu(k,1693) = lu(k,1693) - lu(k,1446) * lu(k,1678) + lu(k,1694) = lu(k,1694) - lu(k,1447) * lu(k,1678) + lu(k,1695) = lu(k,1695) - lu(k,1448) * lu(k,1678) + lu(k,1696) = lu(k,1696) - lu(k,1449) * lu(k,1678) + lu(k,1697) = lu(k,1697) - lu(k,1450) * lu(k,1678) + lu(k,1698) = lu(k,1698) - lu(k,1451) * lu(k,1678) + lu(k,1892) = lu(k,1892) - lu(k,1440) * lu(k,1891) + lu(k,1893) = lu(k,1893) - lu(k,1441) * lu(k,1891) + lu(k,1901) = lu(k,1901) - lu(k,1442) * lu(k,1891) + lu(k,1902) = lu(k,1902) - lu(k,1443) * lu(k,1891) + lu(k,1904) = lu(k,1904) - lu(k,1444) * lu(k,1891) + lu(k,1908) = lu(k,1908) - lu(k,1445) * lu(k,1891) + lu(k,1910) = lu(k,1910) - lu(k,1446) * lu(k,1891) + lu(k,1911) = lu(k,1911) - lu(k,1447) * lu(k,1891) + lu(k,1912) = lu(k,1912) - lu(k,1448) * lu(k,1891) + lu(k,1913) = lu(k,1913) - lu(k,1449) * lu(k,1891) + lu(k,1914) = lu(k,1914) - lu(k,1450) * lu(k,1891) + lu(k,1915) = lu(k,1915) - lu(k,1451) * lu(k,1891) + lu(k,2090) = lu(k,2090) - lu(k,1440) * lu(k,2089) + lu(k,2091) = lu(k,2091) - lu(k,1441) * lu(k,2089) + lu(k,2097) = lu(k,2097) - lu(k,1442) * lu(k,2089) + lu(k,2098) = lu(k,2098) - lu(k,1443) * lu(k,2089) + lu(k,2100) = lu(k,2100) - lu(k,1444) * lu(k,2089) + lu(k,2104) = lu(k,2104) - lu(k,1445) * lu(k,2089) + lu(k,2106) = lu(k,2106) - lu(k,1446) * lu(k,2089) + lu(k,2107) = lu(k,2107) - lu(k,1447) * lu(k,2089) + lu(k,2108) = lu(k,2108) - lu(k,1448) * lu(k,2089) + lu(k,2109) = lu(k,2109) - lu(k,1449) * lu(k,2089) + lu(k,2110) = lu(k,2110) - lu(k,1450) * lu(k,2089) + lu(k,2111) = lu(k,2111) - lu(k,1451) * lu(k,2089) + lu(k,2224) = lu(k,2224) - lu(k,1440) * lu(k,2223) + lu(k,2225) = lu(k,2225) - lu(k,1441) * lu(k,2223) + lu(k,2230) = lu(k,2230) - lu(k,1442) * lu(k,2223) + lu(k,2231) = lu(k,2231) - lu(k,1443) * lu(k,2223) + lu(k,2233) = lu(k,2233) - lu(k,1444) * lu(k,2223) + lu(k,2237) = lu(k,2237) - lu(k,1445) * lu(k,2223) + lu(k,2239) = lu(k,2239) - lu(k,1446) * lu(k,2223) + lu(k,2240) = lu(k,2240) - lu(k,1447) * lu(k,2223) + lu(k,2241) = lu(k,2241) - lu(k,1448) * lu(k,2223) + lu(k,2242) = lu(k,2242) - lu(k,1449) * lu(k,2223) + lu(k,2243) = lu(k,2243) - lu(k,1450) * lu(k,2223) + lu(k,2244) = lu(k,2244) - lu(k,1451) * lu(k,2223) + lu(k,2283) = lu(k,2283) - lu(k,1440) * lu(k,2282) + lu(k,2284) = lu(k,2284) - lu(k,1441) * lu(k,2282) + lu(k,2290) = lu(k,2290) - lu(k,1442) * lu(k,2282) + lu(k,2291) = lu(k,2291) - lu(k,1443) * lu(k,2282) + lu(k,2293) = lu(k,2293) - lu(k,1444) * lu(k,2282) + lu(k,2297) = lu(k,2297) - lu(k,1445) * lu(k,2282) + lu(k,2299) = lu(k,2299) - lu(k,1446) * lu(k,2282) + lu(k,2300) = lu(k,2300) - lu(k,1447) * lu(k,2282) + lu(k,2301) = lu(k,2301) - lu(k,1448) * lu(k,2282) + lu(k,2302) = lu(k,2302) - lu(k,1449) * lu(k,2282) + lu(k,2303) = lu(k,2303) - lu(k,1450) * lu(k,2282) + lu(k,2304) = lu(k,2304) - lu(k,1451) * lu(k,2282) + lu(k,2402) = lu(k,2402) - lu(k,1440) * lu(k,2401) + lu(k,2403) = lu(k,2403) - lu(k,1441) * lu(k,2401) + lu(k,2410) = lu(k,2410) - lu(k,1442) * lu(k,2401) + lu(k,2411) = lu(k,2411) - lu(k,1443) * lu(k,2401) + lu(k,2413) = lu(k,2413) - lu(k,1444) * lu(k,2401) + lu(k,2417) = lu(k,2417) - lu(k,1445) * lu(k,2401) + lu(k,2419) = lu(k,2419) - lu(k,1446) * lu(k,2401) + lu(k,2420) = lu(k,2420) - lu(k,1447) * lu(k,2401) + lu(k,2421) = lu(k,2421) - lu(k,1448) * lu(k,2401) + lu(k,2422) = lu(k,2422) - lu(k,1449) * lu(k,2401) + lu(k,2423) = lu(k,2423) - lu(k,1450) * lu(k,2401) + lu(k,2424) = lu(k,2424) - lu(k,1451) * lu(k,2401) + lu(k,2473) = lu(k,2473) - lu(k,1440) * lu(k,2472) + lu(k,2474) = lu(k,2474) - lu(k,1441) * lu(k,2472) + lu(k,2481) = lu(k,2481) - lu(k,1442) * lu(k,2472) + lu(k,2482) = lu(k,2482) - lu(k,1443) * lu(k,2472) + lu(k,2484) = lu(k,2484) - lu(k,1444) * lu(k,2472) + lu(k,2488) = lu(k,2488) - lu(k,1445) * lu(k,2472) + lu(k,2490) = lu(k,2490) - lu(k,1446) * lu(k,2472) + lu(k,2491) = lu(k,2491) - lu(k,1447) * lu(k,2472) + lu(k,2492) = lu(k,2492) - lu(k,1448) * lu(k,2472) + lu(k,2493) = lu(k,2493) - lu(k,1449) * lu(k,2472) + lu(k,2494) = lu(k,2494) - lu(k,1450) * lu(k,2472) + lu(k,2495) = lu(k,2495) - lu(k,1451) * lu(k,2472) + lu(k,1470) = 1._r8 / lu(k,1470) + lu(k,1471) = lu(k,1471) * lu(k,1470) + lu(k,1472) = lu(k,1472) * lu(k,1470) + lu(k,1473) = lu(k,1473) * lu(k,1470) + lu(k,1474) = lu(k,1474) * lu(k,1470) + lu(k,1475) = lu(k,1475) * lu(k,1470) + lu(k,1476) = lu(k,1476) * lu(k,1470) + lu(k,1477) = lu(k,1477) * lu(k,1470) + lu(k,1478) = lu(k,1478) * lu(k,1470) + lu(k,1479) = lu(k,1479) * lu(k,1470) + lu(k,1480) = lu(k,1480) * lu(k,1470) + lu(k,1481) = lu(k,1481) * lu(k,1470) + lu(k,1482) = lu(k,1482) * lu(k,1470) + lu(k,1483) = lu(k,1483) * lu(k,1470) + lu(k,1680) = lu(k,1680) - lu(k,1471) * lu(k,1679) + lu(k,1681) = lu(k,1681) - lu(k,1472) * lu(k,1679) + lu(k,1683) = lu(k,1683) - lu(k,1473) * lu(k,1679) + lu(k,1684) = lu(k,1684) - lu(k,1474) * lu(k,1679) + lu(k,1685) = lu(k,1685) - lu(k,1475) * lu(k,1679) + lu(k,1687) = lu(k,1687) - lu(k,1476) * lu(k,1679) + lu(k,1691) = lu(k,1691) - lu(k,1477) * lu(k,1679) + lu(k,1693) = lu(k,1693) - lu(k,1478) * lu(k,1679) + lu(k,1694) = lu(k,1694) - lu(k,1479) * lu(k,1679) + lu(k,1695) = lu(k,1695) - lu(k,1480) * lu(k,1679) + lu(k,1696) = lu(k,1696) - lu(k,1481) * lu(k,1679) + lu(k,1697) = lu(k,1697) - lu(k,1482) * lu(k,1679) + lu(k,1698) = lu(k,1698) - lu(k,1483) * lu(k,1679) + lu(k,1893) = lu(k,1893) - lu(k,1471) * lu(k,1892) + lu(k,1898) = lu(k,1898) - lu(k,1472) * lu(k,1892) + lu(k,1900) = lu(k,1900) - lu(k,1473) * lu(k,1892) + lu(k,1901) = lu(k,1901) - lu(k,1474) * lu(k,1892) + lu(k,1902) = lu(k,1902) - lu(k,1475) * lu(k,1892) + lu(k,1904) = lu(k,1904) - lu(k,1476) * lu(k,1892) + lu(k,1908) = lu(k,1908) - lu(k,1477) * lu(k,1892) + lu(k,1910) = lu(k,1910) - lu(k,1478) * lu(k,1892) + lu(k,1911) = lu(k,1911) - lu(k,1479) * lu(k,1892) + lu(k,1912) = lu(k,1912) - lu(k,1480) * lu(k,1892) + lu(k,1913) = lu(k,1913) - lu(k,1481) * lu(k,1892) + lu(k,1914) = lu(k,1914) - lu(k,1482) * lu(k,1892) + lu(k,1915) = lu(k,1915) - lu(k,1483) * lu(k,1892) + lu(k,1983) = lu(k,1983) - lu(k,1471) * lu(k,1982) + lu(k,1987) = lu(k,1987) - lu(k,1472) * lu(k,1982) + lu(k,1989) = lu(k,1989) - lu(k,1473) * lu(k,1982) + lu(k,1990) = lu(k,1990) - lu(k,1474) * lu(k,1982) + lu(k,1991) = lu(k,1991) - lu(k,1475) * lu(k,1982) + lu(k,1993) = lu(k,1993) - lu(k,1476) * lu(k,1982) + lu(k,1997) = lu(k,1997) - lu(k,1477) * lu(k,1982) + lu(k,1999) = lu(k,1999) - lu(k,1478) * lu(k,1982) + lu(k,2000) = lu(k,2000) - lu(k,1479) * lu(k,1982) + lu(k,2001) = lu(k,2001) - lu(k,1480) * lu(k,1982) + lu(k,2002) = lu(k,2002) - lu(k,1481) * lu(k,1982) + lu(k,2003) = lu(k,2003) - lu(k,1482) * lu(k,1982) + lu(k,2004) = lu(k,2004) - lu(k,1483) * lu(k,1982) + lu(k,2091) = lu(k,2091) - lu(k,1471) * lu(k,2090) + lu(k,2094) = lu(k,2094) - lu(k,1472) * lu(k,2090) + lu(k,2096) = lu(k,2096) - lu(k,1473) * lu(k,2090) + lu(k,2097) = lu(k,2097) - lu(k,1474) * lu(k,2090) + lu(k,2098) = lu(k,2098) - lu(k,1475) * lu(k,2090) + lu(k,2100) = lu(k,2100) - lu(k,1476) * lu(k,2090) + lu(k,2104) = lu(k,2104) - lu(k,1477) * lu(k,2090) + lu(k,2106) = lu(k,2106) - lu(k,1478) * lu(k,2090) + lu(k,2107) = lu(k,2107) - lu(k,1479) * lu(k,2090) + lu(k,2108) = lu(k,2108) - lu(k,1480) * lu(k,2090) + lu(k,2109) = lu(k,2109) - lu(k,1481) * lu(k,2090) + lu(k,2110) = lu(k,2110) - lu(k,1482) * lu(k,2090) + lu(k,2111) = lu(k,2111) - lu(k,1483) * lu(k,2090) + lu(k,2225) = lu(k,2225) - lu(k,1471) * lu(k,2224) + lu(k,2227) = lu(k,2227) - lu(k,1472) * lu(k,2224) + lu(k,2229) = lu(k,2229) - lu(k,1473) * lu(k,2224) + lu(k,2230) = lu(k,2230) - lu(k,1474) * lu(k,2224) + lu(k,2231) = lu(k,2231) - lu(k,1475) * lu(k,2224) + lu(k,2233) = lu(k,2233) - lu(k,1476) * lu(k,2224) + lu(k,2237) = lu(k,2237) - lu(k,1477) * lu(k,2224) + lu(k,2239) = lu(k,2239) - lu(k,1478) * lu(k,2224) + lu(k,2240) = lu(k,2240) - lu(k,1479) * lu(k,2224) + lu(k,2241) = lu(k,2241) - lu(k,1480) * lu(k,2224) + lu(k,2242) = lu(k,2242) - lu(k,1481) * lu(k,2224) + lu(k,2243) = lu(k,2243) - lu(k,1482) * lu(k,2224) + lu(k,2244) = lu(k,2244) - lu(k,1483) * lu(k,2224) + lu(k,2284) = lu(k,2284) - lu(k,1471) * lu(k,2283) + lu(k,2287) = lu(k,2287) - lu(k,1472) * lu(k,2283) + lu(k,2289) = lu(k,2289) - lu(k,1473) * lu(k,2283) + lu(k,2290) = lu(k,2290) - lu(k,1474) * lu(k,2283) + lu(k,2291) = lu(k,2291) - lu(k,1475) * lu(k,2283) + lu(k,2293) = lu(k,2293) - lu(k,1476) * lu(k,2283) + lu(k,2297) = lu(k,2297) - lu(k,1477) * lu(k,2283) + lu(k,2299) = lu(k,2299) - lu(k,1478) * lu(k,2283) + lu(k,2300) = lu(k,2300) - lu(k,1479) * lu(k,2283) + lu(k,2301) = lu(k,2301) - lu(k,1480) * lu(k,2283) + lu(k,2302) = lu(k,2302) - lu(k,1481) * lu(k,2283) + lu(k,2303) = lu(k,2303) - lu(k,1482) * lu(k,2283) + lu(k,2304) = lu(k,2304) - lu(k,1483) * lu(k,2283) + lu(k,2403) = lu(k,2403) - lu(k,1471) * lu(k,2402) + lu(k,2407) = lu(k,2407) - lu(k,1472) * lu(k,2402) + lu(k,2409) = lu(k,2409) - lu(k,1473) * lu(k,2402) + lu(k,2410) = lu(k,2410) - lu(k,1474) * lu(k,2402) + lu(k,2411) = lu(k,2411) - lu(k,1475) * lu(k,2402) + lu(k,2413) = lu(k,2413) - lu(k,1476) * lu(k,2402) + lu(k,2417) = lu(k,2417) - lu(k,1477) * lu(k,2402) + lu(k,2419) = lu(k,2419) - lu(k,1478) * lu(k,2402) + lu(k,2420) = lu(k,2420) - lu(k,1479) * lu(k,2402) + lu(k,2421) = lu(k,2421) - lu(k,1480) * lu(k,2402) + lu(k,2422) = lu(k,2422) - lu(k,1481) * lu(k,2402) + lu(k,2423) = lu(k,2423) - lu(k,1482) * lu(k,2402) + lu(k,2424) = lu(k,2424) - lu(k,1483) * lu(k,2402) + lu(k,2474) = lu(k,2474) - lu(k,1471) * lu(k,2473) + lu(k,2478) = lu(k,2478) - lu(k,1472) * lu(k,2473) + lu(k,2480) = - lu(k,1473) * lu(k,2473) + lu(k,2481) = lu(k,2481) - lu(k,1474) * lu(k,2473) + lu(k,2482) = lu(k,2482) - lu(k,1475) * lu(k,2473) + lu(k,2484) = lu(k,2484) - lu(k,1476) * lu(k,2473) + lu(k,2488) = lu(k,2488) - lu(k,1477) * lu(k,2473) + lu(k,2490) = lu(k,2490) - lu(k,1478) * lu(k,2473) + lu(k,2491) = lu(k,2491) - lu(k,1479) * lu(k,2473) + lu(k,2492) = lu(k,2492) - lu(k,1480) * lu(k,2473) + lu(k,2493) = lu(k,2493) - lu(k,1481) * lu(k,2473) + lu(k,2494) = lu(k,2494) - lu(k,1482) * lu(k,2473) + lu(k,2495) = lu(k,2495) - lu(k,1483) * lu(k,2473) + lu(k,1492) = 1._r8 / lu(k,1492) + lu(k,1493) = lu(k,1493) * lu(k,1492) + lu(k,1494) = lu(k,1494) * lu(k,1492) + lu(k,1495) = lu(k,1495) * lu(k,1492) + lu(k,1496) = lu(k,1496) * lu(k,1492) + lu(k,1497) = lu(k,1497) * lu(k,1492) + lu(k,1498) = lu(k,1498) * lu(k,1492) + lu(k,1499) = lu(k,1499) * lu(k,1492) + lu(k,1500) = lu(k,1500) * lu(k,1492) + lu(k,1554) = lu(k,1554) - lu(k,1493) * lu(k,1552) + lu(k,1556) = lu(k,1556) - lu(k,1494) * lu(k,1552) + lu(k,1557) = lu(k,1557) - lu(k,1495) * lu(k,1552) + lu(k,1558) = lu(k,1558) - lu(k,1496) * lu(k,1552) + lu(k,1559) = lu(k,1559) - lu(k,1497) * lu(k,1552) + lu(k,1561) = - lu(k,1498) * lu(k,1552) + lu(k,1562) = lu(k,1562) - lu(k,1499) * lu(k,1552) + lu(k,1564) = - lu(k,1500) * lu(k,1552) + lu(k,1584) = lu(k,1584) - lu(k,1493) * lu(k,1581) + lu(k,1586) = lu(k,1586) - lu(k,1494) * lu(k,1581) + lu(k,1587) = lu(k,1587) - lu(k,1495) * lu(k,1581) + lu(k,1588) = lu(k,1588) - lu(k,1496) * lu(k,1581) + lu(k,1590) = lu(k,1590) - lu(k,1497) * lu(k,1581) + lu(k,1593) = lu(k,1593) - lu(k,1498) * lu(k,1581) + lu(k,1594) = lu(k,1594) - lu(k,1499) * lu(k,1581) + lu(k,1596) = lu(k,1596) - lu(k,1500) * lu(k,1581) + lu(k,1629) = - lu(k,1493) * lu(k,1625) + lu(k,1634) = lu(k,1634) - lu(k,1494) * lu(k,1625) + lu(k,1635) = lu(k,1635) - lu(k,1495) * lu(k,1625) + lu(k,1636) = lu(k,1636) - lu(k,1496) * lu(k,1625) + lu(k,1638) = lu(k,1638) - lu(k,1497) * lu(k,1625) + lu(k,1641) = - lu(k,1498) * lu(k,1625) + lu(k,1643) = lu(k,1643) - lu(k,1499) * lu(k,1625) + lu(k,1645) = - lu(k,1500) * lu(k,1625) + lu(k,1681) = lu(k,1681) - lu(k,1493) * lu(k,1680) + lu(k,1686) = lu(k,1686) - lu(k,1494) * lu(k,1680) + lu(k,1687) = lu(k,1687) - lu(k,1495) * lu(k,1680) + lu(k,1688) = - lu(k,1496) * lu(k,1680) + lu(k,1690) = - lu(k,1497) * lu(k,1680) + lu(k,1693) = lu(k,1693) - lu(k,1498) * lu(k,1680) + lu(k,1695) = lu(k,1695) - lu(k,1499) * lu(k,1680) + lu(k,1697) = lu(k,1697) - lu(k,1500) * lu(k,1680) + lu(k,1898) = lu(k,1898) - lu(k,1493) * lu(k,1893) + lu(k,1903) = lu(k,1903) - lu(k,1494) * lu(k,1893) + lu(k,1904) = lu(k,1904) - lu(k,1495) * lu(k,1893) + lu(k,1905) = lu(k,1905) - lu(k,1496) * lu(k,1893) + lu(k,1907) = lu(k,1907) - lu(k,1497) * lu(k,1893) + lu(k,1910) = lu(k,1910) - lu(k,1498) * lu(k,1893) + lu(k,1912) = lu(k,1912) - lu(k,1499) * lu(k,1893) + lu(k,1914) = lu(k,1914) - lu(k,1500) * lu(k,1893) + lu(k,1941) = lu(k,1941) - lu(k,1493) * lu(k,1936) + lu(k,1946) = lu(k,1946) - lu(k,1494) * lu(k,1936) + lu(k,1947) = lu(k,1947) - lu(k,1495) * lu(k,1936) + lu(k,1948) = lu(k,1948) - lu(k,1496) * lu(k,1936) + lu(k,1950) = lu(k,1950) - lu(k,1497) * lu(k,1936) + lu(k,1953) = lu(k,1953) - lu(k,1498) * lu(k,1936) + lu(k,1955) = lu(k,1955) - lu(k,1499) * lu(k,1936) + lu(k,1957) = lu(k,1957) - lu(k,1500) * lu(k,1936) + lu(k,1987) = lu(k,1987) - lu(k,1493) * lu(k,1983) + lu(k,1992) = lu(k,1992) - lu(k,1494) * lu(k,1983) + lu(k,1993) = lu(k,1993) - lu(k,1495) * lu(k,1983) + lu(k,1994) = lu(k,1994) - lu(k,1496) * lu(k,1983) + lu(k,1996) = lu(k,1996) - lu(k,1497) * lu(k,1983) + lu(k,1999) = lu(k,1999) - lu(k,1498) * lu(k,1983) + lu(k,2001) = lu(k,2001) - lu(k,1499) * lu(k,1983) + lu(k,2003) = lu(k,2003) - lu(k,1500) * lu(k,1983) + lu(k,2094) = lu(k,2094) - lu(k,1493) * lu(k,2091) + lu(k,2099) = lu(k,2099) - lu(k,1494) * lu(k,2091) + lu(k,2100) = lu(k,2100) - lu(k,1495) * lu(k,2091) + lu(k,2101) = lu(k,2101) - lu(k,1496) * lu(k,2091) + lu(k,2103) = lu(k,2103) - lu(k,1497) * lu(k,2091) + lu(k,2106) = lu(k,2106) - lu(k,1498) * lu(k,2091) + lu(k,2108) = lu(k,2108) - lu(k,1499) * lu(k,2091) + lu(k,2110) = lu(k,2110) - lu(k,1500) * lu(k,2091) + lu(k,2227) = lu(k,2227) - lu(k,1493) * lu(k,2225) + lu(k,2232) = lu(k,2232) - lu(k,1494) * lu(k,2225) + lu(k,2233) = lu(k,2233) - lu(k,1495) * lu(k,2225) + lu(k,2234) = lu(k,2234) - lu(k,1496) * lu(k,2225) + lu(k,2236) = lu(k,2236) - lu(k,1497) * lu(k,2225) + lu(k,2239) = lu(k,2239) - lu(k,1498) * lu(k,2225) + lu(k,2241) = lu(k,2241) - lu(k,1499) * lu(k,2225) + lu(k,2243) = lu(k,2243) - lu(k,1500) * lu(k,2225) + lu(k,2287) = lu(k,2287) - lu(k,1493) * lu(k,2284) + lu(k,2292) = - lu(k,1494) * lu(k,2284) + lu(k,2293) = lu(k,2293) - lu(k,1495) * lu(k,2284) + lu(k,2294) = lu(k,2294) - lu(k,1496) * lu(k,2284) + lu(k,2296) = - lu(k,1497) * lu(k,2284) + lu(k,2299) = lu(k,2299) - lu(k,1498) * lu(k,2284) + lu(k,2301) = lu(k,2301) - lu(k,1499) * lu(k,2284) + lu(k,2303) = lu(k,2303) - lu(k,1500) * lu(k,2284) + lu(k,2407) = lu(k,2407) - lu(k,1493) * lu(k,2403) + lu(k,2412) = lu(k,2412) - lu(k,1494) * lu(k,2403) + lu(k,2413) = lu(k,2413) - lu(k,1495) * lu(k,2403) + lu(k,2414) = lu(k,2414) - lu(k,1496) * lu(k,2403) + lu(k,2416) = lu(k,2416) - lu(k,1497) * lu(k,2403) + lu(k,2419) = lu(k,2419) - lu(k,1498) * lu(k,2403) + lu(k,2421) = lu(k,2421) - lu(k,1499) * lu(k,2403) + lu(k,2423) = lu(k,2423) - lu(k,1500) * lu(k,2403) + lu(k,2433) = - lu(k,1493) * lu(k,2429) + lu(k,2438) = lu(k,2438) - lu(k,1494) * lu(k,2429) + lu(k,2439) = lu(k,2439) - lu(k,1495) * lu(k,2429) + lu(k,2440) = lu(k,2440) - lu(k,1496) * lu(k,2429) + lu(k,2442) = lu(k,2442) - lu(k,1497) * lu(k,2429) + lu(k,2445) = lu(k,2445) - lu(k,1498) * lu(k,2429) + lu(k,2447) = lu(k,2447) - lu(k,1499) * lu(k,2429) + lu(k,2449) = lu(k,2449) - lu(k,1500) * lu(k,2429) + lu(k,2478) = lu(k,2478) - lu(k,1493) * lu(k,2474) + lu(k,2483) = lu(k,2483) - lu(k,1494) * lu(k,2474) + lu(k,2484) = lu(k,2484) - lu(k,1495) * lu(k,2474) + lu(k,2485) = lu(k,2485) - lu(k,1496) * lu(k,2474) + lu(k,2487) = lu(k,2487) - lu(k,1497) * lu(k,2474) + lu(k,2490) = lu(k,2490) - lu(k,1498) * lu(k,2474) + lu(k,2492) = lu(k,2492) - lu(k,1499) * lu(k,2474) + lu(k,2494) = lu(k,2494) - lu(k,1500) * lu(k,2474) + lu(k,1503) = 1._r8 / lu(k,1503) + lu(k,1504) = lu(k,1504) * lu(k,1503) + lu(k,1505) = lu(k,1505) * lu(k,1503) + lu(k,1506) = lu(k,1506) * lu(k,1503) + lu(k,1507) = lu(k,1507) * lu(k,1503) + lu(k,1508) = lu(k,1508) * lu(k,1503) + lu(k,1509) = lu(k,1509) * lu(k,1503) + lu(k,1510) = lu(k,1510) * lu(k,1503) + lu(k,1511) = lu(k,1511) * lu(k,1503) + lu(k,1512) = lu(k,1512) * lu(k,1503) + lu(k,1513) = lu(k,1513) * lu(k,1503) + lu(k,1514) = lu(k,1514) * lu(k,1503) + lu(k,1627) = lu(k,1627) - lu(k,1504) * lu(k,1626) + lu(k,1631) = lu(k,1631) - lu(k,1505) * lu(k,1626) + lu(k,1632) = lu(k,1632) - lu(k,1506) * lu(k,1626) + lu(k,1633) = lu(k,1633) - lu(k,1507) * lu(k,1626) + lu(k,1634) = lu(k,1634) - lu(k,1508) * lu(k,1626) + lu(k,1635) = lu(k,1635) - lu(k,1509) * lu(k,1626) + lu(k,1636) = lu(k,1636) - lu(k,1510) * lu(k,1626) + lu(k,1637) = lu(k,1637) - lu(k,1511) * lu(k,1626) + lu(k,1638) = lu(k,1638) - lu(k,1512) * lu(k,1626) + lu(k,1642) = lu(k,1642) - lu(k,1513) * lu(k,1626) + lu(k,1646) = lu(k,1646) - lu(k,1514) * lu(k,1626) + lu(k,1702) = - lu(k,1504) * lu(k,1701) + lu(k,1706) = lu(k,1706) - lu(k,1505) * lu(k,1701) + lu(k,1707) = lu(k,1707) - lu(k,1506) * lu(k,1701) + lu(k,1708) = lu(k,1708) - lu(k,1507) * lu(k,1701) + lu(k,1709) = lu(k,1709) - lu(k,1508) * lu(k,1701) + lu(k,1710) = lu(k,1710) - lu(k,1509) * lu(k,1701) + lu(k,1711) = - lu(k,1510) * lu(k,1701) + lu(k,1712) = - lu(k,1511) * lu(k,1701) + lu(k,1713) = - lu(k,1512) * lu(k,1701) + lu(k,1717) = lu(k,1717) - lu(k,1513) * lu(k,1701) + lu(k,1721) = lu(k,1721) - lu(k,1514) * lu(k,1701) + lu(k,1723) = - lu(k,1504) * lu(k,1722) + lu(k,1727) = - lu(k,1505) * lu(k,1722) + lu(k,1728) = - lu(k,1506) * lu(k,1722) + lu(k,1729) = - lu(k,1507) * lu(k,1722) + lu(k,1730) = lu(k,1730) - lu(k,1508) * lu(k,1722) + lu(k,1731) = lu(k,1731) - lu(k,1509) * lu(k,1722) + lu(k,1732) = lu(k,1732) - lu(k,1510) * lu(k,1722) + lu(k,1733) = - lu(k,1511) * lu(k,1722) + lu(k,1734) = - lu(k,1512) * lu(k,1722) + lu(k,1738) = - lu(k,1513) * lu(k,1722) + lu(k,1742) = lu(k,1742) - lu(k,1514) * lu(k,1722) + lu(k,1896) = lu(k,1896) - lu(k,1504) * lu(k,1894) + lu(k,1900) = lu(k,1900) - lu(k,1505) * lu(k,1894) + lu(k,1901) = lu(k,1901) - lu(k,1506) * lu(k,1894) + lu(k,1902) = lu(k,1902) - lu(k,1507) * lu(k,1894) + lu(k,1903) = lu(k,1903) - lu(k,1508) * lu(k,1894) + lu(k,1904) = lu(k,1904) - lu(k,1509) * lu(k,1894) + lu(k,1905) = lu(k,1905) - lu(k,1510) * lu(k,1894) + lu(k,1906) = lu(k,1906) - lu(k,1511) * lu(k,1894) + lu(k,1907) = lu(k,1907) - lu(k,1512) * lu(k,1894) + lu(k,1911) = lu(k,1911) - lu(k,1513) * lu(k,1894) + lu(k,1915) = lu(k,1915) - lu(k,1514) * lu(k,1894) + lu(k,1939) = lu(k,1939) - lu(k,1504) * lu(k,1937) + lu(k,1943) = - lu(k,1505) * lu(k,1937) + lu(k,1944) = - lu(k,1506) * lu(k,1937) + lu(k,1945) = lu(k,1945) - lu(k,1507) * lu(k,1937) + lu(k,1946) = lu(k,1946) - lu(k,1508) * lu(k,1937) + lu(k,1947) = lu(k,1947) - lu(k,1509) * lu(k,1937) + lu(k,1948) = lu(k,1948) - lu(k,1510) * lu(k,1937) + lu(k,1949) = lu(k,1949) - lu(k,1511) * lu(k,1937) + lu(k,1950) = lu(k,1950) - lu(k,1512) * lu(k,1937) + lu(k,1954) = lu(k,1954) - lu(k,1513) * lu(k,1937) + lu(k,1958) = lu(k,1958) - lu(k,1514) * lu(k,1937) + lu(k,1985) = lu(k,1985) - lu(k,1504) * lu(k,1984) + lu(k,1989) = lu(k,1989) - lu(k,1505) * lu(k,1984) + lu(k,1990) = lu(k,1990) - lu(k,1506) * lu(k,1984) + lu(k,1991) = lu(k,1991) - lu(k,1507) * lu(k,1984) + lu(k,1992) = lu(k,1992) - lu(k,1508) * lu(k,1984) + lu(k,1993) = lu(k,1993) - lu(k,1509) * lu(k,1984) + lu(k,1994) = lu(k,1994) - lu(k,1510) * lu(k,1984) + lu(k,1995) = lu(k,1995) - lu(k,1511) * lu(k,1984) + lu(k,1996) = lu(k,1996) - lu(k,1512) * lu(k,1984) + lu(k,2000) = lu(k,2000) - lu(k,1513) * lu(k,1984) + lu(k,2004) = lu(k,2004) - lu(k,1514) * lu(k,1984) + lu(k,2028) = lu(k,2028) - lu(k,1504) * lu(k,2027) + lu(k,2032) = lu(k,2032) - lu(k,1505) * lu(k,2027) + lu(k,2033) = lu(k,2033) - lu(k,1506) * lu(k,2027) + lu(k,2034) = lu(k,2034) - lu(k,1507) * lu(k,2027) + lu(k,2035) = lu(k,2035) - lu(k,1508) * lu(k,2027) + lu(k,2036) = lu(k,2036) - lu(k,1509) * lu(k,2027) + lu(k,2037) = lu(k,2037) - lu(k,1510) * lu(k,2027) + lu(k,2038) = lu(k,2038) - lu(k,1511) * lu(k,2027) + lu(k,2039) = lu(k,2039) - lu(k,1512) * lu(k,2027) + lu(k,2043) = lu(k,2043) - lu(k,1513) * lu(k,2027) + lu(k,2047) = lu(k,2047) - lu(k,1514) * lu(k,2027) + lu(k,2405) = lu(k,2405) - lu(k,1504) * lu(k,2404) + lu(k,2409) = lu(k,2409) - lu(k,1505) * lu(k,2404) + lu(k,2410) = lu(k,2410) - lu(k,1506) * lu(k,2404) + lu(k,2411) = lu(k,2411) - lu(k,1507) * lu(k,2404) + lu(k,2412) = lu(k,2412) - lu(k,1508) * lu(k,2404) + lu(k,2413) = lu(k,2413) - lu(k,1509) * lu(k,2404) + lu(k,2414) = lu(k,2414) - lu(k,1510) * lu(k,2404) + lu(k,2415) = lu(k,2415) - lu(k,1511) * lu(k,2404) + lu(k,2416) = lu(k,2416) - lu(k,1512) * lu(k,2404) + lu(k,2420) = lu(k,2420) - lu(k,1513) * lu(k,2404) + lu(k,2424) = lu(k,2424) - lu(k,1514) * lu(k,2404) + lu(k,2431) = lu(k,2431) - lu(k,1504) * lu(k,2430) + lu(k,2435) = - lu(k,1505) * lu(k,2430) + lu(k,2436) = - lu(k,1506) * lu(k,2430) + lu(k,2437) = lu(k,2437) - lu(k,1507) * lu(k,2430) + lu(k,2438) = lu(k,2438) - lu(k,1508) * lu(k,2430) + lu(k,2439) = lu(k,2439) - lu(k,1509) * lu(k,2430) + lu(k,2440) = lu(k,2440) - lu(k,1510) * lu(k,2430) + lu(k,2441) = lu(k,2441) - lu(k,1511) * lu(k,2430) + lu(k,2442) = lu(k,2442) - lu(k,1512) * lu(k,2430) + lu(k,2446) = lu(k,2446) - lu(k,1513) * lu(k,2430) + lu(k,2450) = lu(k,2450) - lu(k,1514) * lu(k,2430) + lu(k,2503) = - lu(k,1504) * lu(k,2501) + lu(k,2507) = lu(k,2507) - lu(k,1505) * lu(k,2501) + lu(k,2508) = lu(k,2508) - lu(k,1506) * lu(k,2501) + lu(k,2509) = lu(k,2509) - lu(k,1507) * lu(k,2501) + lu(k,2510) = lu(k,2510) - lu(k,1508) * lu(k,2501) + lu(k,2511) = lu(k,2511) - lu(k,1509) * lu(k,2501) + lu(k,2512) = lu(k,2512) - lu(k,1510) * lu(k,2501) + lu(k,2513) = - lu(k,1511) * lu(k,2501) + lu(k,2514) = lu(k,2514) - lu(k,1512) * lu(k,2501) + lu(k,2518) = lu(k,2518) - lu(k,1513) * lu(k,2501) + lu(k,2522) = lu(k,2522) - lu(k,1514) * lu(k,2501) + end do + end subroutine lu_fac29 + subroutine lu_fac30( 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,1518) = 1._r8 / lu(k,1518) + lu(k,1519) = lu(k,1519) * lu(k,1518) + lu(k,1520) = lu(k,1520) * lu(k,1518) + lu(k,1521) = lu(k,1521) * lu(k,1518) + lu(k,1522) = lu(k,1522) * lu(k,1518) + lu(k,1523) = lu(k,1523) * lu(k,1518) + lu(k,1524) = lu(k,1524) * lu(k,1518) + lu(k,1525) = lu(k,1525) * lu(k,1518) + lu(k,1526) = lu(k,1526) * lu(k,1518) + lu(k,1527) = lu(k,1527) * lu(k,1518) + lu(k,1528) = lu(k,1528) * lu(k,1518) + lu(k,1529) = lu(k,1529) * lu(k,1518) + lu(k,1530) = lu(k,1530) * lu(k,1518) + lu(k,1531) = lu(k,1531) * lu(k,1518) + lu(k,1583) = - lu(k,1519) * lu(k,1582) + lu(k,1584) = lu(k,1584) - lu(k,1520) * lu(k,1582) + lu(k,1585) = - lu(k,1521) * lu(k,1582) + lu(k,1586) = lu(k,1586) - lu(k,1522) * lu(k,1582) + lu(k,1587) = lu(k,1587) - lu(k,1523) * lu(k,1582) + lu(k,1588) = lu(k,1588) - lu(k,1524) * lu(k,1582) + lu(k,1589) = - lu(k,1525) * lu(k,1582) + lu(k,1591) = lu(k,1591) - lu(k,1526) * lu(k,1582) + lu(k,1592) = - lu(k,1527) * lu(k,1582) + lu(k,1593) = lu(k,1593) - lu(k,1528) * lu(k,1582) + lu(k,1594) = lu(k,1594) - lu(k,1529) * lu(k,1582) + lu(k,1596) = lu(k,1596) - lu(k,1530) * lu(k,1582) + lu(k,1597) = lu(k,1597) - lu(k,1531) * lu(k,1582) + lu(k,1605) = lu(k,1605) - lu(k,1519) * lu(k,1603) + lu(k,1606) = lu(k,1606) - lu(k,1520) * lu(k,1603) + lu(k,1607) = lu(k,1607) - lu(k,1521) * lu(k,1603) + lu(k,1609) = - lu(k,1522) * lu(k,1603) + lu(k,1610) = lu(k,1610) - lu(k,1523) * lu(k,1603) + lu(k,1611) = lu(k,1611) - lu(k,1524) * lu(k,1603) + lu(k,1612) = lu(k,1612) - lu(k,1525) * lu(k,1603) + lu(k,1614) = - lu(k,1526) * lu(k,1603) + lu(k,1615) = lu(k,1615) - lu(k,1527) * lu(k,1603) + lu(k,1616) = lu(k,1616) - lu(k,1528) * lu(k,1603) + lu(k,1618) = lu(k,1618) - lu(k,1529) * lu(k,1603) + lu(k,1620) = lu(k,1620) - lu(k,1530) * lu(k,1603) + lu(k,1621) = lu(k,1621) - lu(k,1531) * lu(k,1603) + lu(k,1897) = lu(k,1897) - lu(k,1519) * lu(k,1895) + lu(k,1898) = lu(k,1898) - lu(k,1520) * lu(k,1895) + lu(k,1899) = lu(k,1899) - lu(k,1521) * lu(k,1895) + lu(k,1903) = lu(k,1903) - lu(k,1522) * lu(k,1895) + lu(k,1904) = lu(k,1904) - lu(k,1523) * lu(k,1895) + lu(k,1905) = lu(k,1905) - lu(k,1524) * lu(k,1895) + lu(k,1906) = lu(k,1906) - lu(k,1525) * lu(k,1895) + lu(k,1908) = lu(k,1908) - lu(k,1526) * lu(k,1895) + lu(k,1909) = lu(k,1909) - lu(k,1527) * lu(k,1895) + lu(k,1910) = lu(k,1910) - lu(k,1528) * lu(k,1895) + lu(k,1912) = lu(k,1912) - lu(k,1529) * lu(k,1895) + lu(k,1914) = lu(k,1914) - lu(k,1530) * lu(k,1895) + lu(k,1915) = lu(k,1915) - lu(k,1531) * lu(k,1895) + lu(k,1940) = lu(k,1940) - lu(k,1519) * lu(k,1938) + lu(k,1941) = lu(k,1941) - lu(k,1520) * lu(k,1938) + lu(k,1942) = lu(k,1942) - lu(k,1521) * lu(k,1938) + lu(k,1946) = lu(k,1946) - lu(k,1522) * lu(k,1938) + lu(k,1947) = lu(k,1947) - lu(k,1523) * lu(k,1938) + lu(k,1948) = lu(k,1948) - lu(k,1524) * lu(k,1938) + lu(k,1949) = lu(k,1949) - lu(k,1525) * lu(k,1938) + lu(k,1951) = lu(k,1951) - lu(k,1526) * lu(k,1938) + lu(k,1952) = lu(k,1952) - lu(k,1527) * lu(k,1938) + lu(k,1953) = lu(k,1953) - lu(k,1528) * lu(k,1938) + lu(k,1955) = lu(k,1955) - lu(k,1529) * lu(k,1938) + lu(k,1957) = lu(k,1957) - lu(k,1530) * lu(k,1938) + lu(k,1958) = lu(k,1958) - lu(k,1531) * lu(k,1938) + lu(k,2093) = lu(k,2093) - lu(k,1519) * lu(k,2092) + lu(k,2094) = lu(k,2094) - lu(k,1520) * lu(k,2092) + lu(k,2095) = lu(k,2095) - lu(k,1521) * lu(k,2092) + lu(k,2099) = lu(k,2099) - lu(k,1522) * lu(k,2092) + lu(k,2100) = lu(k,2100) - lu(k,1523) * lu(k,2092) + lu(k,2101) = lu(k,2101) - lu(k,1524) * lu(k,2092) + lu(k,2102) = lu(k,2102) - lu(k,1525) * lu(k,2092) + lu(k,2104) = lu(k,2104) - lu(k,1526) * lu(k,2092) + lu(k,2105) = lu(k,2105) - lu(k,1527) * lu(k,2092) + lu(k,2106) = lu(k,2106) - lu(k,1528) * lu(k,2092) + lu(k,2108) = lu(k,2108) - lu(k,1529) * lu(k,2092) + lu(k,2110) = lu(k,2110) - lu(k,1530) * lu(k,2092) + lu(k,2111) = lu(k,2111) - lu(k,1531) * lu(k,2092) + lu(k,2121) = lu(k,2121) - lu(k,1519) * lu(k,2119) + lu(k,2122) = lu(k,2122) - lu(k,1520) * lu(k,2119) + lu(k,2123) = lu(k,2123) - lu(k,1521) * lu(k,2119) + lu(k,2126) = - lu(k,1522) * lu(k,2119) + lu(k,2127) = lu(k,2127) - lu(k,1523) * lu(k,2119) + lu(k,2128) = lu(k,2128) - lu(k,1524) * lu(k,2119) + lu(k,2129) = lu(k,2129) - lu(k,1525) * lu(k,2119) + lu(k,2131) = - lu(k,1526) * lu(k,2119) + lu(k,2132) = lu(k,2132) - lu(k,1527) * lu(k,2119) + lu(k,2133) = lu(k,2133) - lu(k,1528) * lu(k,2119) + lu(k,2135) = lu(k,2135) - lu(k,1529) * lu(k,2119) + lu(k,2137) = lu(k,2137) - lu(k,1530) * lu(k,2119) + lu(k,2138) = lu(k,2138) - lu(k,1531) * lu(k,2119) + lu(k,2286) = - lu(k,1519) * lu(k,2285) + lu(k,2287) = lu(k,2287) - lu(k,1520) * lu(k,2285) + lu(k,2288) = - lu(k,1521) * lu(k,2285) + lu(k,2292) = lu(k,2292) - lu(k,1522) * lu(k,2285) + lu(k,2293) = lu(k,2293) - lu(k,1523) * lu(k,2285) + lu(k,2294) = lu(k,2294) - lu(k,1524) * lu(k,2285) + lu(k,2295) = - lu(k,1525) * lu(k,2285) + lu(k,2297) = lu(k,2297) - lu(k,1526) * lu(k,2285) + lu(k,2298) = - lu(k,1527) * lu(k,2285) + lu(k,2299) = lu(k,2299) - lu(k,1528) * lu(k,2285) + lu(k,2301) = lu(k,2301) - lu(k,1529) * lu(k,2285) + lu(k,2303) = lu(k,2303) - lu(k,1530) * lu(k,2285) + lu(k,2304) = lu(k,2304) - lu(k,1531) * lu(k,2285) + lu(k,2477) = lu(k,2477) - lu(k,1519) * lu(k,2475) + lu(k,2478) = lu(k,2478) - lu(k,1520) * lu(k,2475) + lu(k,2479) = lu(k,2479) - lu(k,1521) * lu(k,2475) + lu(k,2483) = lu(k,2483) - lu(k,1522) * lu(k,2475) + lu(k,2484) = lu(k,2484) - lu(k,1523) * lu(k,2475) + lu(k,2485) = lu(k,2485) - lu(k,1524) * lu(k,2475) + lu(k,2486) = lu(k,2486) - lu(k,1525) * lu(k,2475) + lu(k,2488) = lu(k,2488) - lu(k,1526) * lu(k,2475) + lu(k,2489) = lu(k,2489) - lu(k,1527) * lu(k,2475) + lu(k,2490) = lu(k,2490) - lu(k,1528) * lu(k,2475) + lu(k,2492) = lu(k,2492) - lu(k,1529) * lu(k,2475) + lu(k,2494) = lu(k,2494) - lu(k,1530) * lu(k,2475) + lu(k,2495) = lu(k,2495) - lu(k,1531) * lu(k,2475) + lu(k,2504) = - lu(k,1519) * lu(k,2502) + lu(k,2505) = - lu(k,1520) * lu(k,2502) + lu(k,2506) = - lu(k,1521) * lu(k,2502) + lu(k,2510) = lu(k,2510) - lu(k,1522) * lu(k,2502) + lu(k,2511) = lu(k,2511) - lu(k,1523) * lu(k,2502) + lu(k,2512) = lu(k,2512) - lu(k,1524) * lu(k,2502) + lu(k,2513) = lu(k,2513) - lu(k,1525) * lu(k,2502) + lu(k,2515) = - lu(k,1526) * lu(k,2502) + lu(k,2516) = - lu(k,1527) * lu(k,2502) + lu(k,2517) = - lu(k,1528) * lu(k,2502) + lu(k,2519) = lu(k,2519) - lu(k,1529) * lu(k,2502) + lu(k,2521) = - lu(k,1530) * lu(k,2502) + lu(k,2522) = lu(k,2522) - lu(k,1531) * lu(k,2502) + lu(k,1537) = 1._r8 / lu(k,1537) + lu(k,1538) = lu(k,1538) * lu(k,1537) + lu(k,1539) = lu(k,1539) * lu(k,1537) + lu(k,1540) = lu(k,1540) * lu(k,1537) + lu(k,1541) = lu(k,1541) * lu(k,1537) + lu(k,1542) = lu(k,1542) * lu(k,1537) + lu(k,1543) = lu(k,1543) * lu(k,1537) + lu(k,1544) = lu(k,1544) * lu(k,1537) + lu(k,1545) = lu(k,1545) * lu(k,1537) + lu(k,1546) = lu(k,1546) * lu(k,1537) + lu(k,1547) = lu(k,1547) * lu(k,1537) + lu(k,1548) = lu(k,1548) * lu(k,1537) + lu(k,1549) = lu(k,1549) * lu(k,1537) + lu(k,1605) = lu(k,1605) - lu(k,1538) * lu(k,1604) + lu(k,1607) = lu(k,1607) - lu(k,1539) * lu(k,1604) + lu(k,1608) = lu(k,1608) - lu(k,1540) * lu(k,1604) + lu(k,1609) = lu(k,1609) - lu(k,1541) * lu(k,1604) + lu(k,1610) = lu(k,1610) - lu(k,1542) * lu(k,1604) + lu(k,1611) = lu(k,1611) - lu(k,1543) * lu(k,1604) + lu(k,1612) = lu(k,1612) - lu(k,1544) * lu(k,1604) + lu(k,1613) = - lu(k,1545) * lu(k,1604) + lu(k,1615) = lu(k,1615) - lu(k,1546) * lu(k,1604) + lu(k,1617) = lu(k,1617) - lu(k,1547) * lu(k,1604) + lu(k,1620) = lu(k,1620) - lu(k,1548) * lu(k,1604) + lu(k,1621) = lu(k,1621) - lu(k,1549) * lu(k,1604) + lu(k,1628) = - lu(k,1538) * lu(k,1627) + lu(k,1630) = - lu(k,1539) * lu(k,1627) + lu(k,1633) = lu(k,1633) - lu(k,1540) * lu(k,1627) + lu(k,1634) = lu(k,1634) - lu(k,1541) * lu(k,1627) + lu(k,1635) = lu(k,1635) - lu(k,1542) * lu(k,1627) + lu(k,1636) = lu(k,1636) - lu(k,1543) * lu(k,1627) + lu(k,1637) = lu(k,1637) - lu(k,1544) * lu(k,1627) + lu(k,1638) = lu(k,1638) - lu(k,1545) * lu(k,1627) + lu(k,1640) = - lu(k,1546) * lu(k,1627) + lu(k,1642) = lu(k,1642) - lu(k,1547) * lu(k,1627) + lu(k,1645) = lu(k,1645) - lu(k,1548) * lu(k,1627) + lu(k,1646) = lu(k,1646) - lu(k,1549) * lu(k,1627) + lu(k,1703) = - lu(k,1538) * lu(k,1702) + lu(k,1705) = - lu(k,1539) * lu(k,1702) + lu(k,1708) = lu(k,1708) - lu(k,1540) * lu(k,1702) + lu(k,1709) = lu(k,1709) - lu(k,1541) * lu(k,1702) + lu(k,1710) = lu(k,1710) - lu(k,1542) * lu(k,1702) + lu(k,1711) = lu(k,1711) - lu(k,1543) * lu(k,1702) + lu(k,1712) = lu(k,1712) - lu(k,1544) * lu(k,1702) + lu(k,1713) = lu(k,1713) - lu(k,1545) * lu(k,1702) + lu(k,1715) = - lu(k,1546) * lu(k,1702) + lu(k,1717) = lu(k,1717) - lu(k,1547) * lu(k,1702) + lu(k,1720) = lu(k,1720) - lu(k,1548) * lu(k,1702) + lu(k,1721) = lu(k,1721) - lu(k,1549) * lu(k,1702) + lu(k,1724) = - lu(k,1538) * lu(k,1723) + lu(k,1726) = - lu(k,1539) * lu(k,1723) + lu(k,1729) = lu(k,1729) - lu(k,1540) * lu(k,1723) + lu(k,1730) = lu(k,1730) - lu(k,1541) * lu(k,1723) + lu(k,1731) = lu(k,1731) - lu(k,1542) * lu(k,1723) + lu(k,1732) = lu(k,1732) - lu(k,1543) * lu(k,1723) + lu(k,1733) = lu(k,1733) - lu(k,1544) * lu(k,1723) + lu(k,1734) = lu(k,1734) - lu(k,1545) * lu(k,1723) + lu(k,1736) = - lu(k,1546) * lu(k,1723) + lu(k,1738) = lu(k,1738) - lu(k,1547) * lu(k,1723) + lu(k,1741) = - lu(k,1548) * lu(k,1723) + lu(k,1742) = lu(k,1742) - lu(k,1549) * lu(k,1723) + lu(k,1897) = lu(k,1897) - lu(k,1538) * lu(k,1896) + lu(k,1899) = lu(k,1899) - lu(k,1539) * lu(k,1896) + lu(k,1902) = lu(k,1902) - lu(k,1540) * lu(k,1896) + lu(k,1903) = lu(k,1903) - lu(k,1541) * lu(k,1896) + lu(k,1904) = lu(k,1904) - lu(k,1542) * lu(k,1896) + lu(k,1905) = lu(k,1905) - lu(k,1543) * lu(k,1896) + lu(k,1906) = lu(k,1906) - lu(k,1544) * lu(k,1896) + lu(k,1907) = lu(k,1907) - lu(k,1545) * lu(k,1896) + lu(k,1909) = lu(k,1909) - lu(k,1546) * lu(k,1896) + lu(k,1911) = lu(k,1911) - lu(k,1547) * lu(k,1896) + lu(k,1914) = lu(k,1914) - lu(k,1548) * lu(k,1896) + lu(k,1915) = lu(k,1915) - lu(k,1549) * lu(k,1896) + lu(k,1940) = lu(k,1940) - lu(k,1538) * lu(k,1939) + lu(k,1942) = lu(k,1942) - lu(k,1539) * lu(k,1939) + lu(k,1945) = lu(k,1945) - lu(k,1540) * lu(k,1939) + lu(k,1946) = lu(k,1946) - lu(k,1541) * lu(k,1939) + lu(k,1947) = lu(k,1947) - lu(k,1542) * lu(k,1939) + lu(k,1948) = lu(k,1948) - lu(k,1543) * lu(k,1939) + lu(k,1949) = lu(k,1949) - lu(k,1544) * lu(k,1939) + lu(k,1950) = lu(k,1950) - lu(k,1545) * lu(k,1939) + lu(k,1952) = lu(k,1952) - lu(k,1546) * lu(k,1939) + lu(k,1954) = lu(k,1954) - lu(k,1547) * lu(k,1939) + lu(k,1957) = lu(k,1957) - lu(k,1548) * lu(k,1939) + lu(k,1958) = lu(k,1958) - lu(k,1549) * lu(k,1939) + lu(k,1986) = lu(k,1986) - lu(k,1538) * lu(k,1985) + lu(k,1988) = - lu(k,1539) * lu(k,1985) + lu(k,1991) = lu(k,1991) - lu(k,1540) * lu(k,1985) + lu(k,1992) = lu(k,1992) - lu(k,1541) * lu(k,1985) + lu(k,1993) = lu(k,1993) - lu(k,1542) * lu(k,1985) + lu(k,1994) = lu(k,1994) - lu(k,1543) * lu(k,1985) + lu(k,1995) = lu(k,1995) - lu(k,1544) * lu(k,1985) + lu(k,1996) = lu(k,1996) - lu(k,1545) * lu(k,1985) + lu(k,1998) = lu(k,1998) - lu(k,1546) * lu(k,1985) + lu(k,2000) = lu(k,2000) - lu(k,1547) * lu(k,1985) + lu(k,2003) = lu(k,2003) - lu(k,1548) * lu(k,1985) + lu(k,2004) = lu(k,2004) - lu(k,1549) * lu(k,1985) + lu(k,2029) = lu(k,2029) - lu(k,1538) * lu(k,2028) + lu(k,2031) = lu(k,2031) - lu(k,1539) * lu(k,2028) + lu(k,2034) = lu(k,2034) - lu(k,1540) * lu(k,2028) + lu(k,2035) = lu(k,2035) - lu(k,1541) * lu(k,2028) + lu(k,2036) = lu(k,2036) - lu(k,1542) * lu(k,2028) + lu(k,2037) = lu(k,2037) - lu(k,1543) * lu(k,2028) + lu(k,2038) = lu(k,2038) - lu(k,1544) * lu(k,2028) + lu(k,2039) = lu(k,2039) - lu(k,1545) * lu(k,2028) + lu(k,2041) = lu(k,2041) - lu(k,1546) * lu(k,2028) + lu(k,2043) = lu(k,2043) - lu(k,1547) * lu(k,2028) + lu(k,2046) = - lu(k,1548) * lu(k,2028) + lu(k,2047) = lu(k,2047) - lu(k,1549) * lu(k,2028) + lu(k,2121) = lu(k,2121) - lu(k,1538) * lu(k,2120) + lu(k,2123) = lu(k,2123) - lu(k,1539) * lu(k,2120) + lu(k,2125) = lu(k,2125) - lu(k,1540) * lu(k,2120) + lu(k,2126) = lu(k,2126) - lu(k,1541) * lu(k,2120) + lu(k,2127) = lu(k,2127) - lu(k,1542) * lu(k,2120) + lu(k,2128) = lu(k,2128) - lu(k,1543) * lu(k,2120) + lu(k,2129) = lu(k,2129) - lu(k,1544) * lu(k,2120) + lu(k,2130) = - lu(k,1545) * lu(k,2120) + lu(k,2132) = lu(k,2132) - lu(k,1546) * lu(k,2120) + lu(k,2134) = lu(k,2134) - lu(k,1547) * lu(k,2120) + lu(k,2137) = lu(k,2137) - lu(k,1548) * lu(k,2120) + lu(k,2138) = lu(k,2138) - lu(k,1549) * lu(k,2120) + lu(k,2406) = lu(k,2406) - lu(k,1538) * lu(k,2405) + lu(k,2408) = lu(k,2408) - lu(k,1539) * lu(k,2405) + lu(k,2411) = lu(k,2411) - lu(k,1540) * lu(k,2405) + lu(k,2412) = lu(k,2412) - lu(k,1541) * lu(k,2405) + lu(k,2413) = lu(k,2413) - lu(k,1542) * lu(k,2405) + lu(k,2414) = lu(k,2414) - lu(k,1543) * lu(k,2405) + lu(k,2415) = lu(k,2415) - lu(k,1544) * lu(k,2405) + lu(k,2416) = lu(k,2416) - lu(k,1545) * lu(k,2405) + lu(k,2418) = lu(k,2418) - lu(k,1546) * lu(k,2405) + lu(k,2420) = lu(k,2420) - lu(k,1547) * lu(k,2405) + lu(k,2423) = lu(k,2423) - lu(k,1548) * lu(k,2405) + lu(k,2424) = lu(k,2424) - lu(k,1549) * lu(k,2405) + lu(k,2432) = lu(k,2432) - lu(k,1538) * lu(k,2431) + lu(k,2434) = lu(k,2434) - lu(k,1539) * lu(k,2431) + lu(k,2437) = lu(k,2437) - lu(k,1540) * lu(k,2431) + lu(k,2438) = lu(k,2438) - lu(k,1541) * lu(k,2431) + lu(k,2439) = lu(k,2439) - lu(k,1542) * lu(k,2431) + lu(k,2440) = lu(k,2440) - lu(k,1543) * lu(k,2431) + lu(k,2441) = lu(k,2441) - lu(k,1544) * lu(k,2431) + lu(k,2442) = lu(k,2442) - lu(k,1545) * lu(k,2431) + lu(k,2444) = - lu(k,1546) * lu(k,2431) + lu(k,2446) = lu(k,2446) - lu(k,1547) * lu(k,2431) + lu(k,2449) = lu(k,2449) - lu(k,1548) * lu(k,2431) + lu(k,2450) = lu(k,2450) - lu(k,1549) * lu(k,2431) + lu(k,2477) = lu(k,2477) - lu(k,1538) * lu(k,2476) + lu(k,2479) = lu(k,2479) - lu(k,1539) * lu(k,2476) + lu(k,2482) = lu(k,2482) - lu(k,1540) * lu(k,2476) + lu(k,2483) = lu(k,2483) - lu(k,1541) * lu(k,2476) + lu(k,2484) = lu(k,2484) - lu(k,1542) * lu(k,2476) + lu(k,2485) = lu(k,2485) - lu(k,1543) * lu(k,2476) + lu(k,2486) = lu(k,2486) - lu(k,1544) * lu(k,2476) + lu(k,2487) = lu(k,2487) - lu(k,1545) * lu(k,2476) + lu(k,2489) = lu(k,2489) - lu(k,1546) * lu(k,2476) + lu(k,2491) = lu(k,2491) - lu(k,1547) * lu(k,2476) + lu(k,2494) = lu(k,2494) - lu(k,1548) * lu(k,2476) + lu(k,2495) = lu(k,2495) - lu(k,1549) * lu(k,2476) + lu(k,2504) = lu(k,2504) - lu(k,1538) * lu(k,2503) + lu(k,2506) = lu(k,2506) - lu(k,1539) * lu(k,2503) + lu(k,2509) = lu(k,2509) - lu(k,1540) * lu(k,2503) + lu(k,2510) = lu(k,2510) - lu(k,1541) * lu(k,2503) + lu(k,2511) = lu(k,2511) - lu(k,1542) * lu(k,2503) + lu(k,2512) = lu(k,2512) - lu(k,1543) * lu(k,2503) + lu(k,2513) = lu(k,2513) - lu(k,1544) * lu(k,2503) + lu(k,2514) = lu(k,2514) - lu(k,1545) * lu(k,2503) + lu(k,2516) = lu(k,2516) - lu(k,1546) * lu(k,2503) + lu(k,2518) = lu(k,2518) - lu(k,1547) * lu(k,2503) + lu(k,2521) = lu(k,2521) - lu(k,1548) * lu(k,2503) + lu(k,2522) = lu(k,2522) - lu(k,1549) * lu(k,2503) + end do + end subroutine lu_fac30 + subroutine lu_fac31( 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,1553) = 1._r8 / lu(k,1553) + lu(k,1554) = lu(k,1554) * lu(k,1553) + lu(k,1555) = lu(k,1555) * lu(k,1553) + lu(k,1556) = lu(k,1556) * lu(k,1553) + lu(k,1557) = lu(k,1557) * lu(k,1553) + lu(k,1558) = lu(k,1558) * lu(k,1553) + lu(k,1559) = lu(k,1559) * lu(k,1553) + lu(k,1560) = lu(k,1560) * lu(k,1553) + lu(k,1561) = lu(k,1561) * lu(k,1553) + lu(k,1562) = lu(k,1562) * lu(k,1553) + lu(k,1563) = lu(k,1563) * lu(k,1553) + lu(k,1564) = lu(k,1564) * lu(k,1553) + lu(k,1565) = lu(k,1565) * lu(k,1553) + lu(k,1584) = lu(k,1584) - lu(k,1554) * lu(k,1583) + lu(k,1585) = lu(k,1585) - lu(k,1555) * lu(k,1583) + lu(k,1586) = lu(k,1586) - lu(k,1556) * lu(k,1583) + lu(k,1587) = lu(k,1587) - lu(k,1557) * lu(k,1583) + lu(k,1588) = lu(k,1588) - lu(k,1558) * lu(k,1583) + lu(k,1590) = lu(k,1590) - lu(k,1559) * lu(k,1583) + lu(k,1591) = lu(k,1591) - lu(k,1560) * lu(k,1583) + lu(k,1593) = lu(k,1593) - lu(k,1561) * lu(k,1583) + lu(k,1594) = lu(k,1594) - lu(k,1562) * lu(k,1583) + lu(k,1595) = lu(k,1595) - lu(k,1563) * lu(k,1583) + lu(k,1596) = lu(k,1596) - lu(k,1564) * lu(k,1583) + lu(k,1597) = lu(k,1597) - lu(k,1565) * lu(k,1583) + lu(k,1606) = lu(k,1606) - lu(k,1554) * lu(k,1605) + lu(k,1607) = lu(k,1607) - lu(k,1555) * lu(k,1605) + lu(k,1609) = lu(k,1609) - lu(k,1556) * lu(k,1605) + lu(k,1610) = lu(k,1610) - lu(k,1557) * lu(k,1605) + lu(k,1611) = lu(k,1611) - lu(k,1558) * lu(k,1605) + lu(k,1613) = lu(k,1613) - lu(k,1559) * lu(k,1605) + lu(k,1614) = lu(k,1614) - lu(k,1560) * lu(k,1605) + lu(k,1616) = lu(k,1616) - lu(k,1561) * lu(k,1605) + lu(k,1618) = lu(k,1618) - lu(k,1562) * lu(k,1605) + lu(k,1619) = - lu(k,1563) * lu(k,1605) + lu(k,1620) = lu(k,1620) - lu(k,1564) * lu(k,1605) + lu(k,1621) = lu(k,1621) - lu(k,1565) * lu(k,1605) + lu(k,1629) = lu(k,1629) - lu(k,1554) * lu(k,1628) + lu(k,1630) = lu(k,1630) - lu(k,1555) * lu(k,1628) + lu(k,1634) = lu(k,1634) - lu(k,1556) * lu(k,1628) + lu(k,1635) = lu(k,1635) - lu(k,1557) * lu(k,1628) + lu(k,1636) = lu(k,1636) - lu(k,1558) * lu(k,1628) + lu(k,1638) = lu(k,1638) - lu(k,1559) * lu(k,1628) + lu(k,1639) = - lu(k,1560) * lu(k,1628) + lu(k,1641) = lu(k,1641) - lu(k,1561) * lu(k,1628) + lu(k,1643) = lu(k,1643) - lu(k,1562) * lu(k,1628) + lu(k,1644) = lu(k,1644) - lu(k,1563) * lu(k,1628) + lu(k,1645) = lu(k,1645) - lu(k,1564) * lu(k,1628) + lu(k,1646) = lu(k,1646) - lu(k,1565) * lu(k,1628) + lu(k,1704) = - lu(k,1554) * lu(k,1703) + lu(k,1705) = lu(k,1705) - lu(k,1555) * lu(k,1703) + lu(k,1709) = lu(k,1709) - lu(k,1556) * lu(k,1703) + lu(k,1710) = lu(k,1710) - lu(k,1557) * lu(k,1703) + lu(k,1711) = lu(k,1711) - lu(k,1558) * lu(k,1703) + lu(k,1713) = lu(k,1713) - lu(k,1559) * lu(k,1703) + lu(k,1714) = - lu(k,1560) * lu(k,1703) + lu(k,1716) = - lu(k,1561) * lu(k,1703) + lu(k,1718) = - lu(k,1562) * lu(k,1703) + lu(k,1719) = - lu(k,1563) * lu(k,1703) + lu(k,1720) = lu(k,1720) - lu(k,1564) * lu(k,1703) + lu(k,1721) = lu(k,1721) - lu(k,1565) * lu(k,1703) + lu(k,1725) = lu(k,1725) - lu(k,1554) * lu(k,1724) + lu(k,1726) = lu(k,1726) - lu(k,1555) * lu(k,1724) + lu(k,1730) = lu(k,1730) - lu(k,1556) * lu(k,1724) + lu(k,1731) = lu(k,1731) - lu(k,1557) * lu(k,1724) + lu(k,1732) = lu(k,1732) - lu(k,1558) * lu(k,1724) + lu(k,1734) = lu(k,1734) - lu(k,1559) * lu(k,1724) + lu(k,1735) = lu(k,1735) - lu(k,1560) * lu(k,1724) + lu(k,1737) = - lu(k,1561) * lu(k,1724) + lu(k,1739) = lu(k,1739) - lu(k,1562) * lu(k,1724) + lu(k,1740) = - lu(k,1563) * lu(k,1724) + lu(k,1741) = lu(k,1741) - lu(k,1564) * lu(k,1724) + lu(k,1742) = lu(k,1742) - lu(k,1565) * lu(k,1724) + lu(k,1898) = lu(k,1898) - lu(k,1554) * lu(k,1897) + lu(k,1899) = lu(k,1899) - lu(k,1555) * lu(k,1897) + lu(k,1903) = lu(k,1903) - lu(k,1556) * lu(k,1897) + lu(k,1904) = lu(k,1904) - lu(k,1557) * lu(k,1897) + lu(k,1905) = lu(k,1905) - lu(k,1558) * lu(k,1897) + lu(k,1907) = lu(k,1907) - lu(k,1559) * lu(k,1897) + lu(k,1908) = lu(k,1908) - lu(k,1560) * lu(k,1897) + lu(k,1910) = lu(k,1910) - lu(k,1561) * lu(k,1897) + lu(k,1912) = lu(k,1912) - lu(k,1562) * lu(k,1897) + lu(k,1913) = lu(k,1913) - lu(k,1563) * lu(k,1897) + lu(k,1914) = lu(k,1914) - lu(k,1564) * lu(k,1897) + lu(k,1915) = lu(k,1915) - lu(k,1565) * lu(k,1897) + lu(k,1941) = lu(k,1941) - lu(k,1554) * lu(k,1940) + lu(k,1942) = lu(k,1942) - lu(k,1555) * lu(k,1940) + lu(k,1946) = lu(k,1946) - lu(k,1556) * lu(k,1940) + lu(k,1947) = lu(k,1947) - lu(k,1557) * lu(k,1940) + lu(k,1948) = lu(k,1948) - lu(k,1558) * lu(k,1940) + lu(k,1950) = lu(k,1950) - lu(k,1559) * lu(k,1940) + lu(k,1951) = lu(k,1951) - lu(k,1560) * lu(k,1940) + lu(k,1953) = lu(k,1953) - lu(k,1561) * lu(k,1940) + lu(k,1955) = lu(k,1955) - lu(k,1562) * lu(k,1940) + lu(k,1956) = lu(k,1956) - lu(k,1563) * lu(k,1940) + lu(k,1957) = lu(k,1957) - lu(k,1564) * lu(k,1940) + lu(k,1958) = lu(k,1958) - lu(k,1565) * lu(k,1940) + lu(k,1987) = lu(k,1987) - lu(k,1554) * lu(k,1986) + lu(k,1988) = lu(k,1988) - lu(k,1555) * lu(k,1986) + lu(k,1992) = lu(k,1992) - lu(k,1556) * lu(k,1986) + lu(k,1993) = lu(k,1993) - lu(k,1557) * lu(k,1986) + lu(k,1994) = lu(k,1994) - lu(k,1558) * lu(k,1986) + lu(k,1996) = lu(k,1996) - lu(k,1559) * lu(k,1986) + lu(k,1997) = lu(k,1997) - lu(k,1560) * lu(k,1986) + lu(k,1999) = lu(k,1999) - lu(k,1561) * lu(k,1986) + lu(k,2001) = lu(k,2001) - lu(k,1562) * lu(k,1986) + lu(k,2002) = lu(k,2002) - lu(k,1563) * lu(k,1986) + lu(k,2003) = lu(k,2003) - lu(k,1564) * lu(k,1986) + lu(k,2004) = lu(k,2004) - lu(k,1565) * lu(k,1986) + lu(k,2030) = lu(k,2030) - lu(k,1554) * lu(k,2029) + lu(k,2031) = lu(k,2031) - lu(k,1555) * lu(k,2029) + lu(k,2035) = lu(k,2035) - lu(k,1556) * lu(k,2029) + lu(k,2036) = lu(k,2036) - lu(k,1557) * lu(k,2029) + lu(k,2037) = lu(k,2037) - lu(k,1558) * lu(k,2029) + lu(k,2039) = lu(k,2039) - lu(k,1559) * lu(k,2029) + lu(k,2040) = lu(k,2040) - lu(k,1560) * lu(k,2029) + lu(k,2042) = lu(k,2042) - lu(k,1561) * lu(k,2029) + lu(k,2044) = lu(k,2044) - lu(k,1562) * lu(k,2029) + lu(k,2045) = lu(k,2045) - lu(k,1563) * lu(k,2029) + lu(k,2046) = lu(k,2046) - lu(k,1564) * lu(k,2029) + lu(k,2047) = lu(k,2047) - lu(k,1565) * lu(k,2029) + lu(k,2094) = lu(k,2094) - lu(k,1554) * lu(k,2093) + lu(k,2095) = lu(k,2095) - lu(k,1555) * lu(k,2093) + lu(k,2099) = lu(k,2099) - lu(k,1556) * lu(k,2093) + lu(k,2100) = lu(k,2100) - lu(k,1557) * lu(k,2093) + lu(k,2101) = lu(k,2101) - lu(k,1558) * lu(k,2093) + lu(k,2103) = lu(k,2103) - lu(k,1559) * lu(k,2093) + lu(k,2104) = lu(k,2104) - lu(k,1560) * lu(k,2093) + lu(k,2106) = lu(k,2106) - lu(k,1561) * lu(k,2093) + lu(k,2108) = lu(k,2108) - lu(k,1562) * lu(k,2093) + lu(k,2109) = lu(k,2109) - lu(k,1563) * lu(k,2093) + lu(k,2110) = lu(k,2110) - lu(k,1564) * lu(k,2093) + lu(k,2111) = lu(k,2111) - lu(k,1565) * lu(k,2093) + lu(k,2122) = lu(k,2122) - lu(k,1554) * lu(k,2121) + lu(k,2123) = lu(k,2123) - lu(k,1555) * lu(k,2121) + lu(k,2126) = lu(k,2126) - lu(k,1556) * lu(k,2121) + lu(k,2127) = lu(k,2127) - lu(k,1557) * lu(k,2121) + lu(k,2128) = lu(k,2128) - lu(k,1558) * lu(k,2121) + lu(k,2130) = lu(k,2130) - lu(k,1559) * lu(k,2121) + lu(k,2131) = lu(k,2131) - lu(k,1560) * lu(k,2121) + lu(k,2133) = lu(k,2133) - lu(k,1561) * lu(k,2121) + lu(k,2135) = lu(k,2135) - lu(k,1562) * lu(k,2121) + lu(k,2136) = lu(k,2136) - lu(k,1563) * lu(k,2121) + lu(k,2137) = lu(k,2137) - lu(k,1564) * lu(k,2121) + lu(k,2138) = lu(k,2138) - lu(k,1565) * lu(k,2121) + lu(k,2227) = lu(k,2227) - lu(k,1554) * lu(k,2226) + lu(k,2228) = lu(k,2228) - lu(k,1555) * lu(k,2226) + lu(k,2232) = lu(k,2232) - lu(k,1556) * lu(k,2226) + lu(k,2233) = lu(k,2233) - lu(k,1557) * lu(k,2226) + lu(k,2234) = lu(k,2234) - lu(k,1558) * lu(k,2226) + lu(k,2236) = lu(k,2236) - lu(k,1559) * lu(k,2226) + lu(k,2237) = lu(k,2237) - lu(k,1560) * lu(k,2226) + lu(k,2239) = lu(k,2239) - lu(k,1561) * lu(k,2226) + lu(k,2241) = lu(k,2241) - lu(k,1562) * lu(k,2226) + lu(k,2242) = lu(k,2242) - lu(k,1563) * lu(k,2226) + lu(k,2243) = lu(k,2243) - lu(k,1564) * lu(k,2226) + lu(k,2244) = lu(k,2244) - lu(k,1565) * lu(k,2226) + lu(k,2287) = lu(k,2287) - lu(k,1554) * lu(k,2286) + lu(k,2288) = lu(k,2288) - lu(k,1555) * lu(k,2286) + lu(k,2292) = lu(k,2292) - lu(k,1556) * lu(k,2286) + lu(k,2293) = lu(k,2293) - lu(k,1557) * lu(k,2286) + lu(k,2294) = lu(k,2294) - lu(k,1558) * lu(k,2286) + lu(k,2296) = lu(k,2296) - lu(k,1559) * lu(k,2286) + lu(k,2297) = lu(k,2297) - lu(k,1560) * lu(k,2286) + lu(k,2299) = lu(k,2299) - lu(k,1561) * lu(k,2286) + lu(k,2301) = lu(k,2301) - lu(k,1562) * lu(k,2286) + lu(k,2302) = lu(k,2302) - lu(k,1563) * lu(k,2286) + lu(k,2303) = lu(k,2303) - lu(k,1564) * lu(k,2286) + lu(k,2304) = lu(k,2304) - lu(k,1565) * lu(k,2286) + lu(k,2407) = lu(k,2407) - lu(k,1554) * lu(k,2406) + lu(k,2408) = lu(k,2408) - lu(k,1555) * lu(k,2406) + lu(k,2412) = lu(k,2412) - lu(k,1556) * lu(k,2406) + lu(k,2413) = lu(k,2413) - lu(k,1557) * lu(k,2406) + lu(k,2414) = lu(k,2414) - lu(k,1558) * lu(k,2406) + lu(k,2416) = lu(k,2416) - lu(k,1559) * lu(k,2406) + lu(k,2417) = lu(k,2417) - lu(k,1560) * lu(k,2406) + lu(k,2419) = lu(k,2419) - lu(k,1561) * lu(k,2406) + lu(k,2421) = lu(k,2421) - lu(k,1562) * lu(k,2406) + lu(k,2422) = lu(k,2422) - lu(k,1563) * lu(k,2406) + lu(k,2423) = lu(k,2423) - lu(k,1564) * lu(k,2406) + lu(k,2424) = lu(k,2424) - lu(k,1565) * lu(k,2406) + lu(k,2433) = lu(k,2433) - lu(k,1554) * lu(k,2432) + lu(k,2434) = lu(k,2434) - lu(k,1555) * lu(k,2432) + lu(k,2438) = lu(k,2438) - lu(k,1556) * lu(k,2432) + lu(k,2439) = lu(k,2439) - lu(k,1557) * lu(k,2432) + lu(k,2440) = lu(k,2440) - lu(k,1558) * lu(k,2432) + lu(k,2442) = lu(k,2442) - lu(k,1559) * lu(k,2432) + lu(k,2443) = - lu(k,1560) * lu(k,2432) + lu(k,2445) = lu(k,2445) - lu(k,1561) * lu(k,2432) + lu(k,2447) = lu(k,2447) - lu(k,1562) * lu(k,2432) + lu(k,2448) = lu(k,2448) - lu(k,1563) * lu(k,2432) + lu(k,2449) = lu(k,2449) - lu(k,1564) * lu(k,2432) + lu(k,2450) = lu(k,2450) - lu(k,1565) * lu(k,2432) + lu(k,2478) = lu(k,2478) - lu(k,1554) * lu(k,2477) + lu(k,2479) = lu(k,2479) - lu(k,1555) * lu(k,2477) + lu(k,2483) = lu(k,2483) - lu(k,1556) * lu(k,2477) + lu(k,2484) = lu(k,2484) - lu(k,1557) * lu(k,2477) + lu(k,2485) = lu(k,2485) - lu(k,1558) * lu(k,2477) + lu(k,2487) = lu(k,2487) - lu(k,1559) * lu(k,2477) + lu(k,2488) = lu(k,2488) - lu(k,1560) * lu(k,2477) + lu(k,2490) = lu(k,2490) - lu(k,1561) * lu(k,2477) + lu(k,2492) = lu(k,2492) - lu(k,1562) * lu(k,2477) + lu(k,2493) = lu(k,2493) - lu(k,1563) * lu(k,2477) + lu(k,2494) = lu(k,2494) - lu(k,1564) * lu(k,2477) + lu(k,2495) = lu(k,2495) - lu(k,1565) * lu(k,2477) + lu(k,2505) = lu(k,2505) - lu(k,1554) * lu(k,2504) + lu(k,2506) = lu(k,2506) - lu(k,1555) * lu(k,2504) + lu(k,2510) = lu(k,2510) - lu(k,1556) * lu(k,2504) + lu(k,2511) = lu(k,2511) - lu(k,1557) * lu(k,2504) + lu(k,2512) = lu(k,2512) - lu(k,1558) * lu(k,2504) + lu(k,2514) = lu(k,2514) - lu(k,1559) * lu(k,2504) + lu(k,2515) = lu(k,2515) - lu(k,1560) * lu(k,2504) + lu(k,2517) = lu(k,2517) - lu(k,1561) * lu(k,2504) + lu(k,2519) = lu(k,2519) - lu(k,1562) * lu(k,2504) + lu(k,2520) = - lu(k,1563) * lu(k,2504) + lu(k,2521) = lu(k,2521) - lu(k,1564) * lu(k,2504) + lu(k,2522) = lu(k,2522) - lu(k,1565) * lu(k,2504) + lu(k,1584) = 1._r8 / lu(k,1584) + lu(k,1585) = lu(k,1585) * lu(k,1584) + lu(k,1586) = lu(k,1586) * lu(k,1584) + lu(k,1587) = lu(k,1587) * lu(k,1584) + lu(k,1588) = lu(k,1588) * lu(k,1584) + lu(k,1589) = lu(k,1589) * lu(k,1584) + lu(k,1590) = lu(k,1590) * lu(k,1584) + lu(k,1591) = lu(k,1591) * lu(k,1584) + lu(k,1592) = lu(k,1592) * lu(k,1584) + lu(k,1593) = lu(k,1593) * lu(k,1584) + lu(k,1594) = lu(k,1594) * lu(k,1584) + lu(k,1595) = lu(k,1595) * lu(k,1584) + lu(k,1596) = lu(k,1596) * lu(k,1584) + lu(k,1597) = lu(k,1597) * lu(k,1584) + lu(k,1607) = lu(k,1607) - lu(k,1585) * lu(k,1606) + lu(k,1609) = lu(k,1609) - lu(k,1586) * lu(k,1606) + lu(k,1610) = lu(k,1610) - lu(k,1587) * lu(k,1606) + lu(k,1611) = lu(k,1611) - lu(k,1588) * lu(k,1606) + lu(k,1612) = lu(k,1612) - lu(k,1589) * lu(k,1606) + lu(k,1613) = lu(k,1613) - lu(k,1590) * lu(k,1606) + lu(k,1614) = lu(k,1614) - lu(k,1591) * lu(k,1606) + lu(k,1615) = lu(k,1615) - lu(k,1592) * lu(k,1606) + lu(k,1616) = lu(k,1616) - lu(k,1593) * lu(k,1606) + lu(k,1618) = lu(k,1618) - lu(k,1594) * lu(k,1606) + lu(k,1619) = lu(k,1619) - lu(k,1595) * lu(k,1606) + lu(k,1620) = lu(k,1620) - lu(k,1596) * lu(k,1606) + lu(k,1621) = lu(k,1621) - lu(k,1597) * lu(k,1606) + lu(k,1630) = lu(k,1630) - lu(k,1585) * lu(k,1629) + lu(k,1634) = lu(k,1634) - lu(k,1586) * lu(k,1629) + lu(k,1635) = lu(k,1635) - lu(k,1587) * lu(k,1629) + lu(k,1636) = lu(k,1636) - lu(k,1588) * lu(k,1629) + lu(k,1637) = lu(k,1637) - lu(k,1589) * lu(k,1629) + lu(k,1638) = lu(k,1638) - lu(k,1590) * lu(k,1629) + lu(k,1639) = lu(k,1639) - lu(k,1591) * lu(k,1629) + lu(k,1640) = lu(k,1640) - lu(k,1592) * lu(k,1629) + lu(k,1641) = lu(k,1641) - lu(k,1593) * lu(k,1629) + lu(k,1643) = lu(k,1643) - lu(k,1594) * lu(k,1629) + lu(k,1644) = lu(k,1644) - lu(k,1595) * lu(k,1629) + lu(k,1645) = lu(k,1645) - lu(k,1596) * lu(k,1629) + lu(k,1646) = lu(k,1646) - lu(k,1597) * lu(k,1629) + lu(k,1682) = - lu(k,1585) * lu(k,1681) + lu(k,1686) = lu(k,1686) - lu(k,1586) * lu(k,1681) + lu(k,1687) = lu(k,1687) - lu(k,1587) * lu(k,1681) + lu(k,1688) = lu(k,1688) - lu(k,1588) * lu(k,1681) + lu(k,1689) = lu(k,1689) - lu(k,1589) * lu(k,1681) + lu(k,1690) = lu(k,1690) - lu(k,1590) * lu(k,1681) + lu(k,1691) = lu(k,1691) - lu(k,1591) * lu(k,1681) + lu(k,1692) = lu(k,1692) - lu(k,1592) * lu(k,1681) + lu(k,1693) = lu(k,1693) - lu(k,1593) * lu(k,1681) + lu(k,1695) = lu(k,1695) - lu(k,1594) * lu(k,1681) + lu(k,1696) = lu(k,1696) - lu(k,1595) * lu(k,1681) + lu(k,1697) = lu(k,1697) - lu(k,1596) * lu(k,1681) + lu(k,1698) = lu(k,1698) - lu(k,1597) * lu(k,1681) + lu(k,1705) = lu(k,1705) - lu(k,1585) * lu(k,1704) + lu(k,1709) = lu(k,1709) - lu(k,1586) * lu(k,1704) + lu(k,1710) = lu(k,1710) - lu(k,1587) * lu(k,1704) + lu(k,1711) = lu(k,1711) - lu(k,1588) * lu(k,1704) + lu(k,1712) = lu(k,1712) - lu(k,1589) * lu(k,1704) + lu(k,1713) = lu(k,1713) - lu(k,1590) * lu(k,1704) + lu(k,1714) = lu(k,1714) - lu(k,1591) * lu(k,1704) + lu(k,1715) = lu(k,1715) - lu(k,1592) * lu(k,1704) + lu(k,1716) = lu(k,1716) - lu(k,1593) * lu(k,1704) + lu(k,1718) = lu(k,1718) - lu(k,1594) * lu(k,1704) + lu(k,1719) = lu(k,1719) - lu(k,1595) * lu(k,1704) + lu(k,1720) = lu(k,1720) - lu(k,1596) * lu(k,1704) + lu(k,1721) = lu(k,1721) - lu(k,1597) * lu(k,1704) + lu(k,1726) = lu(k,1726) - lu(k,1585) * lu(k,1725) + lu(k,1730) = lu(k,1730) - lu(k,1586) * lu(k,1725) + lu(k,1731) = lu(k,1731) - lu(k,1587) * lu(k,1725) + lu(k,1732) = lu(k,1732) - lu(k,1588) * lu(k,1725) + lu(k,1733) = lu(k,1733) - lu(k,1589) * lu(k,1725) + lu(k,1734) = lu(k,1734) - lu(k,1590) * lu(k,1725) + lu(k,1735) = lu(k,1735) - lu(k,1591) * lu(k,1725) + lu(k,1736) = lu(k,1736) - lu(k,1592) * lu(k,1725) + lu(k,1737) = lu(k,1737) - lu(k,1593) * lu(k,1725) + lu(k,1739) = lu(k,1739) - lu(k,1594) * lu(k,1725) + lu(k,1740) = lu(k,1740) - lu(k,1595) * lu(k,1725) + lu(k,1741) = lu(k,1741) - lu(k,1596) * lu(k,1725) + lu(k,1742) = lu(k,1742) - lu(k,1597) * lu(k,1725) + lu(k,1899) = lu(k,1899) - lu(k,1585) * lu(k,1898) + lu(k,1903) = lu(k,1903) - lu(k,1586) * lu(k,1898) + lu(k,1904) = lu(k,1904) - lu(k,1587) * lu(k,1898) + lu(k,1905) = lu(k,1905) - lu(k,1588) * lu(k,1898) + lu(k,1906) = lu(k,1906) - lu(k,1589) * lu(k,1898) + lu(k,1907) = lu(k,1907) - lu(k,1590) * lu(k,1898) + lu(k,1908) = lu(k,1908) - lu(k,1591) * lu(k,1898) + lu(k,1909) = lu(k,1909) - lu(k,1592) * lu(k,1898) + lu(k,1910) = lu(k,1910) - lu(k,1593) * lu(k,1898) + lu(k,1912) = lu(k,1912) - lu(k,1594) * lu(k,1898) + lu(k,1913) = lu(k,1913) - lu(k,1595) * lu(k,1898) + lu(k,1914) = lu(k,1914) - lu(k,1596) * lu(k,1898) + lu(k,1915) = lu(k,1915) - lu(k,1597) * lu(k,1898) + lu(k,1942) = lu(k,1942) - lu(k,1585) * lu(k,1941) + lu(k,1946) = lu(k,1946) - lu(k,1586) * lu(k,1941) + lu(k,1947) = lu(k,1947) - lu(k,1587) * lu(k,1941) + lu(k,1948) = lu(k,1948) - lu(k,1588) * lu(k,1941) + lu(k,1949) = lu(k,1949) - lu(k,1589) * lu(k,1941) + lu(k,1950) = lu(k,1950) - lu(k,1590) * lu(k,1941) + lu(k,1951) = lu(k,1951) - lu(k,1591) * lu(k,1941) + lu(k,1952) = lu(k,1952) - lu(k,1592) * lu(k,1941) + lu(k,1953) = lu(k,1953) - lu(k,1593) * lu(k,1941) + lu(k,1955) = lu(k,1955) - lu(k,1594) * lu(k,1941) + lu(k,1956) = lu(k,1956) - lu(k,1595) * lu(k,1941) + lu(k,1957) = lu(k,1957) - lu(k,1596) * lu(k,1941) + lu(k,1958) = lu(k,1958) - lu(k,1597) * lu(k,1941) + lu(k,1988) = lu(k,1988) - lu(k,1585) * lu(k,1987) + lu(k,1992) = lu(k,1992) - lu(k,1586) * lu(k,1987) + lu(k,1993) = lu(k,1993) - lu(k,1587) * lu(k,1987) + lu(k,1994) = lu(k,1994) - lu(k,1588) * lu(k,1987) + lu(k,1995) = lu(k,1995) - lu(k,1589) * lu(k,1987) + lu(k,1996) = lu(k,1996) - lu(k,1590) * lu(k,1987) + lu(k,1997) = lu(k,1997) - lu(k,1591) * lu(k,1987) + lu(k,1998) = lu(k,1998) - lu(k,1592) * lu(k,1987) + lu(k,1999) = lu(k,1999) - lu(k,1593) * lu(k,1987) + lu(k,2001) = lu(k,2001) - lu(k,1594) * lu(k,1987) + lu(k,2002) = lu(k,2002) - lu(k,1595) * lu(k,1987) + lu(k,2003) = lu(k,2003) - lu(k,1596) * lu(k,1987) + lu(k,2004) = lu(k,2004) - lu(k,1597) * lu(k,1987) + lu(k,2031) = lu(k,2031) - lu(k,1585) * lu(k,2030) + lu(k,2035) = lu(k,2035) - lu(k,1586) * lu(k,2030) + lu(k,2036) = lu(k,2036) - lu(k,1587) * lu(k,2030) + lu(k,2037) = lu(k,2037) - lu(k,1588) * lu(k,2030) + lu(k,2038) = lu(k,2038) - lu(k,1589) * lu(k,2030) + lu(k,2039) = lu(k,2039) - lu(k,1590) * lu(k,2030) + lu(k,2040) = lu(k,2040) - lu(k,1591) * lu(k,2030) + lu(k,2041) = lu(k,2041) - lu(k,1592) * lu(k,2030) + lu(k,2042) = lu(k,2042) - lu(k,1593) * lu(k,2030) + lu(k,2044) = lu(k,2044) - lu(k,1594) * lu(k,2030) + lu(k,2045) = lu(k,2045) - lu(k,1595) * lu(k,2030) + lu(k,2046) = lu(k,2046) - lu(k,1596) * lu(k,2030) + lu(k,2047) = lu(k,2047) - lu(k,1597) * lu(k,2030) + lu(k,2095) = lu(k,2095) - lu(k,1585) * lu(k,2094) + lu(k,2099) = lu(k,2099) - lu(k,1586) * lu(k,2094) + lu(k,2100) = lu(k,2100) - lu(k,1587) * lu(k,2094) + lu(k,2101) = lu(k,2101) - lu(k,1588) * lu(k,2094) + lu(k,2102) = lu(k,2102) - lu(k,1589) * lu(k,2094) + lu(k,2103) = lu(k,2103) - lu(k,1590) * lu(k,2094) + lu(k,2104) = lu(k,2104) - lu(k,1591) * lu(k,2094) + lu(k,2105) = lu(k,2105) - lu(k,1592) * lu(k,2094) + lu(k,2106) = lu(k,2106) - lu(k,1593) * lu(k,2094) + lu(k,2108) = lu(k,2108) - lu(k,1594) * lu(k,2094) + lu(k,2109) = lu(k,2109) - lu(k,1595) * lu(k,2094) + lu(k,2110) = lu(k,2110) - lu(k,1596) * lu(k,2094) + lu(k,2111) = lu(k,2111) - lu(k,1597) * lu(k,2094) + lu(k,2123) = lu(k,2123) - lu(k,1585) * lu(k,2122) + lu(k,2126) = lu(k,2126) - lu(k,1586) * lu(k,2122) + lu(k,2127) = lu(k,2127) - lu(k,1587) * lu(k,2122) + lu(k,2128) = lu(k,2128) - lu(k,1588) * lu(k,2122) + lu(k,2129) = lu(k,2129) - lu(k,1589) * lu(k,2122) + lu(k,2130) = lu(k,2130) - lu(k,1590) * lu(k,2122) + lu(k,2131) = lu(k,2131) - lu(k,1591) * lu(k,2122) + lu(k,2132) = lu(k,2132) - lu(k,1592) * lu(k,2122) + lu(k,2133) = lu(k,2133) - lu(k,1593) * lu(k,2122) + lu(k,2135) = lu(k,2135) - lu(k,1594) * lu(k,2122) + lu(k,2136) = lu(k,2136) - lu(k,1595) * lu(k,2122) + lu(k,2137) = lu(k,2137) - lu(k,1596) * lu(k,2122) + lu(k,2138) = lu(k,2138) - lu(k,1597) * lu(k,2122) + lu(k,2228) = lu(k,2228) - lu(k,1585) * lu(k,2227) + lu(k,2232) = lu(k,2232) - lu(k,1586) * lu(k,2227) + lu(k,2233) = lu(k,2233) - lu(k,1587) * lu(k,2227) + lu(k,2234) = lu(k,2234) - lu(k,1588) * lu(k,2227) + lu(k,2235) = lu(k,2235) - lu(k,1589) * lu(k,2227) + lu(k,2236) = lu(k,2236) - lu(k,1590) * lu(k,2227) + lu(k,2237) = lu(k,2237) - lu(k,1591) * lu(k,2227) + lu(k,2238) = lu(k,2238) - lu(k,1592) * lu(k,2227) + lu(k,2239) = lu(k,2239) - lu(k,1593) * lu(k,2227) + lu(k,2241) = lu(k,2241) - lu(k,1594) * lu(k,2227) + lu(k,2242) = lu(k,2242) - lu(k,1595) * lu(k,2227) + lu(k,2243) = lu(k,2243) - lu(k,1596) * lu(k,2227) + lu(k,2244) = lu(k,2244) - lu(k,1597) * lu(k,2227) + lu(k,2288) = lu(k,2288) - lu(k,1585) * lu(k,2287) + lu(k,2292) = lu(k,2292) - lu(k,1586) * lu(k,2287) + lu(k,2293) = lu(k,2293) - lu(k,1587) * lu(k,2287) + lu(k,2294) = lu(k,2294) - lu(k,1588) * lu(k,2287) + lu(k,2295) = lu(k,2295) - lu(k,1589) * lu(k,2287) + lu(k,2296) = lu(k,2296) - lu(k,1590) * lu(k,2287) + lu(k,2297) = lu(k,2297) - lu(k,1591) * lu(k,2287) + lu(k,2298) = lu(k,2298) - lu(k,1592) * lu(k,2287) + lu(k,2299) = lu(k,2299) - lu(k,1593) * lu(k,2287) + lu(k,2301) = lu(k,2301) - lu(k,1594) * lu(k,2287) + lu(k,2302) = lu(k,2302) - lu(k,1595) * lu(k,2287) + lu(k,2303) = lu(k,2303) - lu(k,1596) * lu(k,2287) + lu(k,2304) = lu(k,2304) - lu(k,1597) * lu(k,2287) + lu(k,2408) = lu(k,2408) - lu(k,1585) * lu(k,2407) + lu(k,2412) = lu(k,2412) - lu(k,1586) * lu(k,2407) + lu(k,2413) = lu(k,2413) - lu(k,1587) * lu(k,2407) + lu(k,2414) = lu(k,2414) - lu(k,1588) * lu(k,2407) + lu(k,2415) = lu(k,2415) - lu(k,1589) * lu(k,2407) + lu(k,2416) = lu(k,2416) - lu(k,1590) * lu(k,2407) + lu(k,2417) = lu(k,2417) - lu(k,1591) * lu(k,2407) + lu(k,2418) = lu(k,2418) - lu(k,1592) * lu(k,2407) + lu(k,2419) = lu(k,2419) - lu(k,1593) * lu(k,2407) + lu(k,2421) = lu(k,2421) - lu(k,1594) * lu(k,2407) + lu(k,2422) = lu(k,2422) - lu(k,1595) * lu(k,2407) + lu(k,2423) = lu(k,2423) - lu(k,1596) * lu(k,2407) + lu(k,2424) = lu(k,2424) - lu(k,1597) * lu(k,2407) + lu(k,2434) = lu(k,2434) - lu(k,1585) * lu(k,2433) + lu(k,2438) = lu(k,2438) - lu(k,1586) * lu(k,2433) + lu(k,2439) = lu(k,2439) - lu(k,1587) * lu(k,2433) + lu(k,2440) = lu(k,2440) - lu(k,1588) * lu(k,2433) + lu(k,2441) = lu(k,2441) - lu(k,1589) * lu(k,2433) + lu(k,2442) = lu(k,2442) - lu(k,1590) * lu(k,2433) + lu(k,2443) = lu(k,2443) - lu(k,1591) * lu(k,2433) + lu(k,2444) = lu(k,2444) - lu(k,1592) * lu(k,2433) + lu(k,2445) = lu(k,2445) - lu(k,1593) * lu(k,2433) + lu(k,2447) = lu(k,2447) - lu(k,1594) * lu(k,2433) + lu(k,2448) = lu(k,2448) - lu(k,1595) * lu(k,2433) + lu(k,2449) = lu(k,2449) - lu(k,1596) * lu(k,2433) + lu(k,2450) = lu(k,2450) - lu(k,1597) * lu(k,2433) + lu(k,2479) = lu(k,2479) - lu(k,1585) * lu(k,2478) + lu(k,2483) = lu(k,2483) - lu(k,1586) * lu(k,2478) + lu(k,2484) = lu(k,2484) - lu(k,1587) * lu(k,2478) + lu(k,2485) = lu(k,2485) - lu(k,1588) * lu(k,2478) + lu(k,2486) = lu(k,2486) - lu(k,1589) * lu(k,2478) + lu(k,2487) = lu(k,2487) - lu(k,1590) * lu(k,2478) + lu(k,2488) = lu(k,2488) - lu(k,1591) * lu(k,2478) + lu(k,2489) = lu(k,2489) - lu(k,1592) * lu(k,2478) + lu(k,2490) = lu(k,2490) - lu(k,1593) * lu(k,2478) + lu(k,2492) = lu(k,2492) - lu(k,1594) * lu(k,2478) + lu(k,2493) = lu(k,2493) - lu(k,1595) * lu(k,2478) + lu(k,2494) = lu(k,2494) - lu(k,1596) * lu(k,2478) + lu(k,2495) = lu(k,2495) - lu(k,1597) * lu(k,2478) + lu(k,2506) = lu(k,2506) - lu(k,1585) * lu(k,2505) + lu(k,2510) = lu(k,2510) - lu(k,1586) * lu(k,2505) + lu(k,2511) = lu(k,2511) - lu(k,1587) * lu(k,2505) + lu(k,2512) = lu(k,2512) - lu(k,1588) * lu(k,2505) + lu(k,2513) = lu(k,2513) - lu(k,1589) * lu(k,2505) + lu(k,2514) = lu(k,2514) - lu(k,1590) * lu(k,2505) + lu(k,2515) = lu(k,2515) - lu(k,1591) * lu(k,2505) + lu(k,2516) = lu(k,2516) - lu(k,1592) * lu(k,2505) + lu(k,2517) = lu(k,2517) - lu(k,1593) * lu(k,2505) + lu(k,2519) = lu(k,2519) - lu(k,1594) * lu(k,2505) + lu(k,2520) = lu(k,2520) - lu(k,1595) * lu(k,2505) + lu(k,2521) = lu(k,2521) - lu(k,1596) * lu(k,2505) + lu(k,2522) = lu(k,2522) - lu(k,1597) * lu(k,2505) + lu(k,1607) = 1._r8 / lu(k,1607) + lu(k,1608) = lu(k,1608) * lu(k,1607) + lu(k,1609) = lu(k,1609) * lu(k,1607) + lu(k,1610) = lu(k,1610) * lu(k,1607) + lu(k,1611) = lu(k,1611) * lu(k,1607) + lu(k,1612) = lu(k,1612) * lu(k,1607) + lu(k,1613) = lu(k,1613) * lu(k,1607) + lu(k,1614) = lu(k,1614) * lu(k,1607) + lu(k,1615) = lu(k,1615) * lu(k,1607) + lu(k,1616) = lu(k,1616) * lu(k,1607) + lu(k,1617) = lu(k,1617) * lu(k,1607) + lu(k,1618) = lu(k,1618) * lu(k,1607) + lu(k,1619) = lu(k,1619) * lu(k,1607) + lu(k,1620) = lu(k,1620) * lu(k,1607) + lu(k,1621) = lu(k,1621) * lu(k,1607) + lu(k,1633) = lu(k,1633) - lu(k,1608) * lu(k,1630) + lu(k,1634) = lu(k,1634) - lu(k,1609) * lu(k,1630) + lu(k,1635) = lu(k,1635) - lu(k,1610) * lu(k,1630) + lu(k,1636) = lu(k,1636) - lu(k,1611) * lu(k,1630) + lu(k,1637) = lu(k,1637) - lu(k,1612) * lu(k,1630) + lu(k,1638) = lu(k,1638) - lu(k,1613) * lu(k,1630) + lu(k,1639) = lu(k,1639) - lu(k,1614) * lu(k,1630) + lu(k,1640) = lu(k,1640) - lu(k,1615) * lu(k,1630) + lu(k,1641) = lu(k,1641) - lu(k,1616) * lu(k,1630) + lu(k,1642) = lu(k,1642) - lu(k,1617) * lu(k,1630) + lu(k,1643) = lu(k,1643) - lu(k,1618) * lu(k,1630) + lu(k,1644) = lu(k,1644) - lu(k,1619) * lu(k,1630) + lu(k,1645) = lu(k,1645) - lu(k,1620) * lu(k,1630) + lu(k,1646) = lu(k,1646) - lu(k,1621) * lu(k,1630) + lu(k,1685) = lu(k,1685) - lu(k,1608) * lu(k,1682) + lu(k,1686) = lu(k,1686) - lu(k,1609) * lu(k,1682) + lu(k,1687) = lu(k,1687) - lu(k,1610) * lu(k,1682) + lu(k,1688) = lu(k,1688) - lu(k,1611) * lu(k,1682) + lu(k,1689) = lu(k,1689) - lu(k,1612) * lu(k,1682) + lu(k,1690) = lu(k,1690) - lu(k,1613) * lu(k,1682) + lu(k,1691) = lu(k,1691) - lu(k,1614) * lu(k,1682) + lu(k,1692) = lu(k,1692) - lu(k,1615) * lu(k,1682) + lu(k,1693) = lu(k,1693) - lu(k,1616) * lu(k,1682) + lu(k,1694) = lu(k,1694) - lu(k,1617) * lu(k,1682) + lu(k,1695) = lu(k,1695) - lu(k,1618) * lu(k,1682) + lu(k,1696) = lu(k,1696) - lu(k,1619) * lu(k,1682) + lu(k,1697) = lu(k,1697) - lu(k,1620) * lu(k,1682) + lu(k,1698) = lu(k,1698) - lu(k,1621) * lu(k,1682) + lu(k,1708) = lu(k,1708) - lu(k,1608) * lu(k,1705) + lu(k,1709) = lu(k,1709) - lu(k,1609) * lu(k,1705) + lu(k,1710) = lu(k,1710) - lu(k,1610) * lu(k,1705) + lu(k,1711) = lu(k,1711) - lu(k,1611) * lu(k,1705) + lu(k,1712) = lu(k,1712) - lu(k,1612) * lu(k,1705) + lu(k,1713) = lu(k,1713) - lu(k,1613) * lu(k,1705) + lu(k,1714) = lu(k,1714) - lu(k,1614) * lu(k,1705) + lu(k,1715) = lu(k,1715) - lu(k,1615) * lu(k,1705) + lu(k,1716) = lu(k,1716) - lu(k,1616) * lu(k,1705) + lu(k,1717) = lu(k,1717) - lu(k,1617) * lu(k,1705) + lu(k,1718) = lu(k,1718) - lu(k,1618) * lu(k,1705) + lu(k,1719) = lu(k,1719) - lu(k,1619) * lu(k,1705) + lu(k,1720) = lu(k,1720) - lu(k,1620) * lu(k,1705) + lu(k,1721) = lu(k,1721) - lu(k,1621) * lu(k,1705) + lu(k,1729) = lu(k,1729) - lu(k,1608) * lu(k,1726) + lu(k,1730) = lu(k,1730) - lu(k,1609) * lu(k,1726) + lu(k,1731) = lu(k,1731) - lu(k,1610) * lu(k,1726) + lu(k,1732) = lu(k,1732) - lu(k,1611) * lu(k,1726) + lu(k,1733) = lu(k,1733) - lu(k,1612) * lu(k,1726) + lu(k,1734) = lu(k,1734) - lu(k,1613) * lu(k,1726) + lu(k,1735) = lu(k,1735) - lu(k,1614) * lu(k,1726) + lu(k,1736) = lu(k,1736) - lu(k,1615) * lu(k,1726) + lu(k,1737) = lu(k,1737) - lu(k,1616) * lu(k,1726) + lu(k,1738) = lu(k,1738) - lu(k,1617) * lu(k,1726) + lu(k,1739) = lu(k,1739) - lu(k,1618) * lu(k,1726) + lu(k,1740) = lu(k,1740) - lu(k,1619) * lu(k,1726) + lu(k,1741) = lu(k,1741) - lu(k,1620) * lu(k,1726) + lu(k,1742) = lu(k,1742) - lu(k,1621) * lu(k,1726) + lu(k,1902) = lu(k,1902) - lu(k,1608) * lu(k,1899) + lu(k,1903) = lu(k,1903) - lu(k,1609) * lu(k,1899) + lu(k,1904) = lu(k,1904) - lu(k,1610) * lu(k,1899) + lu(k,1905) = lu(k,1905) - lu(k,1611) * lu(k,1899) + lu(k,1906) = lu(k,1906) - lu(k,1612) * lu(k,1899) + lu(k,1907) = lu(k,1907) - lu(k,1613) * lu(k,1899) + lu(k,1908) = lu(k,1908) - lu(k,1614) * lu(k,1899) + lu(k,1909) = lu(k,1909) - lu(k,1615) * lu(k,1899) + lu(k,1910) = lu(k,1910) - lu(k,1616) * lu(k,1899) + lu(k,1911) = lu(k,1911) - lu(k,1617) * lu(k,1899) + lu(k,1912) = lu(k,1912) - lu(k,1618) * lu(k,1899) + lu(k,1913) = lu(k,1913) - lu(k,1619) * lu(k,1899) + lu(k,1914) = lu(k,1914) - lu(k,1620) * lu(k,1899) + lu(k,1915) = lu(k,1915) - lu(k,1621) * lu(k,1899) + lu(k,1945) = lu(k,1945) - lu(k,1608) * lu(k,1942) + lu(k,1946) = lu(k,1946) - lu(k,1609) * lu(k,1942) + lu(k,1947) = lu(k,1947) - lu(k,1610) * lu(k,1942) + lu(k,1948) = lu(k,1948) - lu(k,1611) * lu(k,1942) + lu(k,1949) = lu(k,1949) - lu(k,1612) * lu(k,1942) + lu(k,1950) = lu(k,1950) - lu(k,1613) * lu(k,1942) + lu(k,1951) = lu(k,1951) - lu(k,1614) * lu(k,1942) + lu(k,1952) = lu(k,1952) - lu(k,1615) * lu(k,1942) + lu(k,1953) = lu(k,1953) - lu(k,1616) * lu(k,1942) + lu(k,1954) = lu(k,1954) - lu(k,1617) * lu(k,1942) + lu(k,1955) = lu(k,1955) - lu(k,1618) * lu(k,1942) + lu(k,1956) = lu(k,1956) - lu(k,1619) * lu(k,1942) + lu(k,1957) = lu(k,1957) - lu(k,1620) * lu(k,1942) + lu(k,1958) = lu(k,1958) - lu(k,1621) * lu(k,1942) + lu(k,1991) = lu(k,1991) - lu(k,1608) * lu(k,1988) + lu(k,1992) = lu(k,1992) - lu(k,1609) * lu(k,1988) + lu(k,1993) = lu(k,1993) - lu(k,1610) * lu(k,1988) + lu(k,1994) = lu(k,1994) - lu(k,1611) * lu(k,1988) + lu(k,1995) = lu(k,1995) - lu(k,1612) * lu(k,1988) + lu(k,1996) = lu(k,1996) - lu(k,1613) * lu(k,1988) + lu(k,1997) = lu(k,1997) - lu(k,1614) * lu(k,1988) + lu(k,1998) = lu(k,1998) - lu(k,1615) * lu(k,1988) + lu(k,1999) = lu(k,1999) - lu(k,1616) * lu(k,1988) + lu(k,2000) = lu(k,2000) - lu(k,1617) * lu(k,1988) + lu(k,2001) = lu(k,2001) - lu(k,1618) * lu(k,1988) + lu(k,2002) = lu(k,2002) - lu(k,1619) * lu(k,1988) + lu(k,2003) = lu(k,2003) - lu(k,1620) * lu(k,1988) + lu(k,2004) = lu(k,2004) - lu(k,1621) * lu(k,1988) + lu(k,2034) = lu(k,2034) - lu(k,1608) * lu(k,2031) + lu(k,2035) = lu(k,2035) - lu(k,1609) * lu(k,2031) + lu(k,2036) = lu(k,2036) - lu(k,1610) * lu(k,2031) + lu(k,2037) = lu(k,2037) - lu(k,1611) * lu(k,2031) + lu(k,2038) = lu(k,2038) - lu(k,1612) * lu(k,2031) + lu(k,2039) = lu(k,2039) - lu(k,1613) * lu(k,2031) + lu(k,2040) = lu(k,2040) - lu(k,1614) * lu(k,2031) + lu(k,2041) = lu(k,2041) - lu(k,1615) * lu(k,2031) + lu(k,2042) = lu(k,2042) - lu(k,1616) * lu(k,2031) + lu(k,2043) = lu(k,2043) - lu(k,1617) * lu(k,2031) + lu(k,2044) = lu(k,2044) - lu(k,1618) * lu(k,2031) + lu(k,2045) = lu(k,2045) - lu(k,1619) * lu(k,2031) + lu(k,2046) = lu(k,2046) - lu(k,1620) * lu(k,2031) + lu(k,2047) = lu(k,2047) - lu(k,1621) * lu(k,2031) + lu(k,2098) = lu(k,2098) - lu(k,1608) * lu(k,2095) + lu(k,2099) = lu(k,2099) - lu(k,1609) * lu(k,2095) + lu(k,2100) = lu(k,2100) - lu(k,1610) * lu(k,2095) + lu(k,2101) = lu(k,2101) - lu(k,1611) * lu(k,2095) + lu(k,2102) = lu(k,2102) - lu(k,1612) * lu(k,2095) + lu(k,2103) = lu(k,2103) - lu(k,1613) * lu(k,2095) + lu(k,2104) = lu(k,2104) - lu(k,1614) * lu(k,2095) + lu(k,2105) = lu(k,2105) - lu(k,1615) * lu(k,2095) + lu(k,2106) = lu(k,2106) - lu(k,1616) * lu(k,2095) + lu(k,2107) = lu(k,2107) - lu(k,1617) * lu(k,2095) + lu(k,2108) = lu(k,2108) - lu(k,1618) * lu(k,2095) + lu(k,2109) = lu(k,2109) - lu(k,1619) * lu(k,2095) + lu(k,2110) = lu(k,2110) - lu(k,1620) * lu(k,2095) + lu(k,2111) = lu(k,2111) - lu(k,1621) * lu(k,2095) + lu(k,2125) = lu(k,2125) - lu(k,1608) * lu(k,2123) + lu(k,2126) = lu(k,2126) - lu(k,1609) * lu(k,2123) + lu(k,2127) = lu(k,2127) - lu(k,1610) * lu(k,2123) + lu(k,2128) = lu(k,2128) - lu(k,1611) * lu(k,2123) + lu(k,2129) = lu(k,2129) - lu(k,1612) * lu(k,2123) + lu(k,2130) = lu(k,2130) - lu(k,1613) * lu(k,2123) + lu(k,2131) = lu(k,2131) - lu(k,1614) * lu(k,2123) + lu(k,2132) = lu(k,2132) - lu(k,1615) * lu(k,2123) + lu(k,2133) = lu(k,2133) - lu(k,1616) * lu(k,2123) + lu(k,2134) = lu(k,2134) - lu(k,1617) * lu(k,2123) + lu(k,2135) = lu(k,2135) - lu(k,1618) * lu(k,2123) + lu(k,2136) = lu(k,2136) - lu(k,1619) * lu(k,2123) + lu(k,2137) = lu(k,2137) - lu(k,1620) * lu(k,2123) + lu(k,2138) = lu(k,2138) - lu(k,1621) * lu(k,2123) + lu(k,2231) = lu(k,2231) - lu(k,1608) * lu(k,2228) + lu(k,2232) = lu(k,2232) - lu(k,1609) * lu(k,2228) + lu(k,2233) = lu(k,2233) - lu(k,1610) * lu(k,2228) + lu(k,2234) = lu(k,2234) - lu(k,1611) * lu(k,2228) + lu(k,2235) = lu(k,2235) - lu(k,1612) * lu(k,2228) + lu(k,2236) = lu(k,2236) - lu(k,1613) * lu(k,2228) + lu(k,2237) = lu(k,2237) - lu(k,1614) * lu(k,2228) + lu(k,2238) = lu(k,2238) - lu(k,1615) * lu(k,2228) + lu(k,2239) = lu(k,2239) - lu(k,1616) * lu(k,2228) + lu(k,2240) = lu(k,2240) - lu(k,1617) * lu(k,2228) + lu(k,2241) = lu(k,2241) - lu(k,1618) * lu(k,2228) + lu(k,2242) = lu(k,2242) - lu(k,1619) * lu(k,2228) + lu(k,2243) = lu(k,2243) - lu(k,1620) * lu(k,2228) + lu(k,2244) = lu(k,2244) - lu(k,1621) * lu(k,2228) + lu(k,2291) = lu(k,2291) - lu(k,1608) * lu(k,2288) + lu(k,2292) = lu(k,2292) - lu(k,1609) * lu(k,2288) + lu(k,2293) = lu(k,2293) - lu(k,1610) * lu(k,2288) + lu(k,2294) = lu(k,2294) - lu(k,1611) * lu(k,2288) + lu(k,2295) = lu(k,2295) - lu(k,1612) * lu(k,2288) + lu(k,2296) = lu(k,2296) - lu(k,1613) * lu(k,2288) + lu(k,2297) = lu(k,2297) - lu(k,1614) * lu(k,2288) + lu(k,2298) = lu(k,2298) - lu(k,1615) * lu(k,2288) + lu(k,2299) = lu(k,2299) - lu(k,1616) * lu(k,2288) + lu(k,2300) = lu(k,2300) - lu(k,1617) * lu(k,2288) + lu(k,2301) = lu(k,2301) - lu(k,1618) * lu(k,2288) + lu(k,2302) = lu(k,2302) - lu(k,1619) * lu(k,2288) + lu(k,2303) = lu(k,2303) - lu(k,1620) * lu(k,2288) + lu(k,2304) = lu(k,2304) - lu(k,1621) * lu(k,2288) + lu(k,2411) = lu(k,2411) - lu(k,1608) * lu(k,2408) + lu(k,2412) = lu(k,2412) - lu(k,1609) * lu(k,2408) + lu(k,2413) = lu(k,2413) - lu(k,1610) * lu(k,2408) + lu(k,2414) = lu(k,2414) - lu(k,1611) * lu(k,2408) + lu(k,2415) = lu(k,2415) - lu(k,1612) * lu(k,2408) + lu(k,2416) = lu(k,2416) - lu(k,1613) * lu(k,2408) + lu(k,2417) = lu(k,2417) - lu(k,1614) * lu(k,2408) + lu(k,2418) = lu(k,2418) - lu(k,1615) * lu(k,2408) + lu(k,2419) = lu(k,2419) - lu(k,1616) * lu(k,2408) + lu(k,2420) = lu(k,2420) - lu(k,1617) * lu(k,2408) + lu(k,2421) = lu(k,2421) - lu(k,1618) * lu(k,2408) + lu(k,2422) = lu(k,2422) - lu(k,1619) * lu(k,2408) + lu(k,2423) = lu(k,2423) - lu(k,1620) * lu(k,2408) + lu(k,2424) = lu(k,2424) - lu(k,1621) * lu(k,2408) + lu(k,2437) = lu(k,2437) - lu(k,1608) * lu(k,2434) + lu(k,2438) = lu(k,2438) - lu(k,1609) * lu(k,2434) + lu(k,2439) = lu(k,2439) - lu(k,1610) * lu(k,2434) + lu(k,2440) = lu(k,2440) - lu(k,1611) * lu(k,2434) + lu(k,2441) = lu(k,2441) - lu(k,1612) * lu(k,2434) + lu(k,2442) = lu(k,2442) - lu(k,1613) * lu(k,2434) + lu(k,2443) = lu(k,2443) - lu(k,1614) * lu(k,2434) + lu(k,2444) = lu(k,2444) - lu(k,1615) * lu(k,2434) + lu(k,2445) = lu(k,2445) - lu(k,1616) * lu(k,2434) + lu(k,2446) = lu(k,2446) - lu(k,1617) * lu(k,2434) + lu(k,2447) = lu(k,2447) - lu(k,1618) * lu(k,2434) + lu(k,2448) = lu(k,2448) - lu(k,1619) * lu(k,2434) + lu(k,2449) = lu(k,2449) - lu(k,1620) * lu(k,2434) + lu(k,2450) = lu(k,2450) - lu(k,1621) * lu(k,2434) + lu(k,2482) = lu(k,2482) - lu(k,1608) * lu(k,2479) + lu(k,2483) = lu(k,2483) - lu(k,1609) * lu(k,2479) + lu(k,2484) = lu(k,2484) - lu(k,1610) * lu(k,2479) + lu(k,2485) = lu(k,2485) - lu(k,1611) * lu(k,2479) + lu(k,2486) = lu(k,2486) - lu(k,1612) * lu(k,2479) + lu(k,2487) = lu(k,2487) - lu(k,1613) * lu(k,2479) + lu(k,2488) = lu(k,2488) - lu(k,1614) * lu(k,2479) + lu(k,2489) = lu(k,2489) - lu(k,1615) * lu(k,2479) + lu(k,2490) = lu(k,2490) - lu(k,1616) * lu(k,2479) + lu(k,2491) = lu(k,2491) - lu(k,1617) * lu(k,2479) + lu(k,2492) = lu(k,2492) - lu(k,1618) * lu(k,2479) + lu(k,2493) = lu(k,2493) - lu(k,1619) * lu(k,2479) + lu(k,2494) = lu(k,2494) - lu(k,1620) * lu(k,2479) + lu(k,2495) = lu(k,2495) - lu(k,1621) * lu(k,2479) + lu(k,2509) = lu(k,2509) - lu(k,1608) * lu(k,2506) + lu(k,2510) = lu(k,2510) - lu(k,1609) * lu(k,2506) + lu(k,2511) = lu(k,2511) - lu(k,1610) * lu(k,2506) + lu(k,2512) = lu(k,2512) - lu(k,1611) * lu(k,2506) + lu(k,2513) = lu(k,2513) - lu(k,1612) * lu(k,2506) + lu(k,2514) = lu(k,2514) - lu(k,1613) * lu(k,2506) + lu(k,2515) = lu(k,2515) - lu(k,1614) * lu(k,2506) + lu(k,2516) = lu(k,2516) - lu(k,1615) * lu(k,2506) + lu(k,2517) = lu(k,2517) - lu(k,1616) * lu(k,2506) + lu(k,2518) = lu(k,2518) - lu(k,1617) * lu(k,2506) + lu(k,2519) = lu(k,2519) - lu(k,1618) * lu(k,2506) + lu(k,2520) = lu(k,2520) - lu(k,1619) * lu(k,2506) + lu(k,2521) = lu(k,2521) - lu(k,1620) * lu(k,2506) + lu(k,2522) = lu(k,2522) - lu(k,1621) * lu(k,2506) + end do + end subroutine lu_fac31 + subroutine lu_fac32( 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,1631) = 1._r8 / lu(k,1631) + lu(k,1632) = lu(k,1632) * lu(k,1631) + lu(k,1633) = lu(k,1633) * lu(k,1631) + lu(k,1634) = lu(k,1634) * lu(k,1631) + lu(k,1635) = lu(k,1635) * lu(k,1631) + lu(k,1636) = lu(k,1636) * lu(k,1631) + lu(k,1637) = lu(k,1637) * lu(k,1631) + lu(k,1638) = lu(k,1638) * lu(k,1631) + lu(k,1639) = lu(k,1639) * lu(k,1631) + lu(k,1640) = lu(k,1640) * lu(k,1631) + lu(k,1641) = lu(k,1641) * lu(k,1631) + lu(k,1642) = lu(k,1642) * lu(k,1631) + lu(k,1643) = lu(k,1643) * lu(k,1631) + lu(k,1644) = lu(k,1644) * lu(k,1631) + lu(k,1645) = lu(k,1645) * lu(k,1631) + lu(k,1646) = lu(k,1646) * lu(k,1631) + lu(k,1684) = lu(k,1684) - lu(k,1632) * lu(k,1683) + lu(k,1685) = lu(k,1685) - lu(k,1633) * lu(k,1683) + lu(k,1686) = lu(k,1686) - lu(k,1634) * lu(k,1683) + lu(k,1687) = lu(k,1687) - lu(k,1635) * lu(k,1683) + lu(k,1688) = lu(k,1688) - lu(k,1636) * lu(k,1683) + lu(k,1689) = lu(k,1689) - lu(k,1637) * lu(k,1683) + lu(k,1690) = lu(k,1690) - lu(k,1638) * lu(k,1683) + lu(k,1691) = lu(k,1691) - lu(k,1639) * lu(k,1683) + lu(k,1692) = lu(k,1692) - lu(k,1640) * lu(k,1683) + lu(k,1693) = lu(k,1693) - lu(k,1641) * lu(k,1683) + lu(k,1694) = lu(k,1694) - lu(k,1642) * lu(k,1683) + lu(k,1695) = lu(k,1695) - lu(k,1643) * lu(k,1683) + lu(k,1696) = lu(k,1696) - lu(k,1644) * lu(k,1683) + lu(k,1697) = lu(k,1697) - lu(k,1645) * lu(k,1683) + lu(k,1698) = lu(k,1698) - lu(k,1646) * lu(k,1683) + lu(k,1707) = lu(k,1707) - lu(k,1632) * lu(k,1706) + lu(k,1708) = lu(k,1708) - lu(k,1633) * lu(k,1706) + lu(k,1709) = lu(k,1709) - lu(k,1634) * lu(k,1706) + lu(k,1710) = lu(k,1710) - lu(k,1635) * lu(k,1706) + lu(k,1711) = lu(k,1711) - lu(k,1636) * lu(k,1706) + lu(k,1712) = lu(k,1712) - lu(k,1637) * lu(k,1706) + lu(k,1713) = lu(k,1713) - lu(k,1638) * lu(k,1706) + lu(k,1714) = lu(k,1714) - lu(k,1639) * lu(k,1706) + lu(k,1715) = lu(k,1715) - lu(k,1640) * lu(k,1706) + lu(k,1716) = lu(k,1716) - lu(k,1641) * lu(k,1706) + lu(k,1717) = lu(k,1717) - lu(k,1642) * lu(k,1706) + lu(k,1718) = lu(k,1718) - lu(k,1643) * lu(k,1706) + lu(k,1719) = lu(k,1719) - lu(k,1644) * lu(k,1706) + lu(k,1720) = lu(k,1720) - lu(k,1645) * lu(k,1706) + lu(k,1721) = lu(k,1721) - lu(k,1646) * lu(k,1706) + lu(k,1728) = lu(k,1728) - lu(k,1632) * lu(k,1727) + lu(k,1729) = lu(k,1729) - lu(k,1633) * lu(k,1727) + lu(k,1730) = lu(k,1730) - lu(k,1634) * lu(k,1727) + lu(k,1731) = lu(k,1731) - lu(k,1635) * lu(k,1727) + lu(k,1732) = lu(k,1732) - lu(k,1636) * lu(k,1727) + lu(k,1733) = lu(k,1733) - lu(k,1637) * lu(k,1727) + lu(k,1734) = lu(k,1734) - lu(k,1638) * lu(k,1727) + lu(k,1735) = lu(k,1735) - lu(k,1639) * lu(k,1727) + lu(k,1736) = lu(k,1736) - lu(k,1640) * lu(k,1727) + lu(k,1737) = lu(k,1737) - lu(k,1641) * lu(k,1727) + lu(k,1738) = lu(k,1738) - lu(k,1642) * lu(k,1727) + lu(k,1739) = lu(k,1739) - lu(k,1643) * lu(k,1727) + lu(k,1740) = lu(k,1740) - lu(k,1644) * lu(k,1727) + lu(k,1741) = lu(k,1741) - lu(k,1645) * lu(k,1727) + lu(k,1742) = lu(k,1742) - lu(k,1646) * lu(k,1727) + lu(k,1901) = lu(k,1901) - lu(k,1632) * lu(k,1900) + lu(k,1902) = lu(k,1902) - lu(k,1633) * lu(k,1900) + lu(k,1903) = lu(k,1903) - lu(k,1634) * lu(k,1900) + lu(k,1904) = lu(k,1904) - lu(k,1635) * lu(k,1900) + lu(k,1905) = lu(k,1905) - lu(k,1636) * lu(k,1900) + lu(k,1906) = lu(k,1906) - lu(k,1637) * lu(k,1900) + lu(k,1907) = lu(k,1907) - lu(k,1638) * lu(k,1900) + lu(k,1908) = lu(k,1908) - lu(k,1639) * lu(k,1900) + lu(k,1909) = lu(k,1909) - lu(k,1640) * lu(k,1900) + lu(k,1910) = lu(k,1910) - lu(k,1641) * lu(k,1900) + lu(k,1911) = lu(k,1911) - lu(k,1642) * lu(k,1900) + lu(k,1912) = lu(k,1912) - lu(k,1643) * lu(k,1900) + lu(k,1913) = lu(k,1913) - lu(k,1644) * lu(k,1900) + lu(k,1914) = lu(k,1914) - lu(k,1645) * lu(k,1900) + lu(k,1915) = lu(k,1915) - lu(k,1646) * lu(k,1900) + lu(k,1944) = lu(k,1944) - lu(k,1632) * lu(k,1943) + lu(k,1945) = lu(k,1945) - lu(k,1633) * lu(k,1943) + lu(k,1946) = lu(k,1946) - lu(k,1634) * lu(k,1943) + lu(k,1947) = lu(k,1947) - lu(k,1635) * lu(k,1943) + lu(k,1948) = lu(k,1948) - lu(k,1636) * lu(k,1943) + lu(k,1949) = lu(k,1949) - lu(k,1637) * lu(k,1943) + lu(k,1950) = lu(k,1950) - lu(k,1638) * lu(k,1943) + lu(k,1951) = lu(k,1951) - lu(k,1639) * lu(k,1943) + lu(k,1952) = lu(k,1952) - lu(k,1640) * lu(k,1943) + lu(k,1953) = lu(k,1953) - lu(k,1641) * lu(k,1943) + lu(k,1954) = lu(k,1954) - lu(k,1642) * lu(k,1943) + lu(k,1955) = lu(k,1955) - lu(k,1643) * lu(k,1943) + lu(k,1956) = lu(k,1956) - lu(k,1644) * lu(k,1943) + lu(k,1957) = lu(k,1957) - lu(k,1645) * lu(k,1943) + lu(k,1958) = lu(k,1958) - lu(k,1646) * lu(k,1943) + lu(k,1990) = lu(k,1990) - lu(k,1632) * lu(k,1989) + lu(k,1991) = lu(k,1991) - lu(k,1633) * lu(k,1989) + lu(k,1992) = lu(k,1992) - lu(k,1634) * lu(k,1989) + lu(k,1993) = lu(k,1993) - lu(k,1635) * lu(k,1989) + lu(k,1994) = lu(k,1994) - lu(k,1636) * lu(k,1989) + lu(k,1995) = lu(k,1995) - lu(k,1637) * lu(k,1989) + lu(k,1996) = lu(k,1996) - lu(k,1638) * lu(k,1989) + lu(k,1997) = lu(k,1997) - lu(k,1639) * lu(k,1989) + lu(k,1998) = lu(k,1998) - lu(k,1640) * lu(k,1989) + lu(k,1999) = lu(k,1999) - lu(k,1641) * lu(k,1989) + lu(k,2000) = lu(k,2000) - lu(k,1642) * lu(k,1989) + lu(k,2001) = lu(k,2001) - lu(k,1643) * lu(k,1989) + lu(k,2002) = lu(k,2002) - lu(k,1644) * lu(k,1989) + lu(k,2003) = lu(k,2003) - lu(k,1645) * lu(k,1989) + lu(k,2004) = lu(k,2004) - lu(k,1646) * lu(k,1989) + lu(k,2033) = lu(k,2033) - lu(k,1632) * lu(k,2032) + lu(k,2034) = lu(k,2034) - lu(k,1633) * lu(k,2032) + lu(k,2035) = lu(k,2035) - lu(k,1634) * lu(k,2032) + lu(k,2036) = lu(k,2036) - lu(k,1635) * lu(k,2032) + lu(k,2037) = lu(k,2037) - lu(k,1636) * lu(k,2032) + lu(k,2038) = lu(k,2038) - lu(k,1637) * lu(k,2032) + lu(k,2039) = lu(k,2039) - lu(k,1638) * lu(k,2032) + lu(k,2040) = lu(k,2040) - lu(k,1639) * lu(k,2032) + lu(k,2041) = lu(k,2041) - lu(k,1640) * lu(k,2032) + lu(k,2042) = lu(k,2042) - lu(k,1641) * lu(k,2032) + lu(k,2043) = lu(k,2043) - lu(k,1642) * lu(k,2032) + lu(k,2044) = lu(k,2044) - lu(k,1643) * lu(k,2032) + lu(k,2045) = lu(k,2045) - lu(k,1644) * lu(k,2032) + lu(k,2046) = lu(k,2046) - lu(k,1645) * lu(k,2032) + lu(k,2047) = lu(k,2047) - lu(k,1646) * lu(k,2032) + lu(k,2097) = lu(k,2097) - lu(k,1632) * lu(k,2096) + lu(k,2098) = lu(k,2098) - lu(k,1633) * lu(k,2096) + lu(k,2099) = lu(k,2099) - lu(k,1634) * lu(k,2096) + lu(k,2100) = lu(k,2100) - lu(k,1635) * lu(k,2096) + lu(k,2101) = lu(k,2101) - lu(k,1636) * lu(k,2096) + lu(k,2102) = lu(k,2102) - lu(k,1637) * lu(k,2096) + lu(k,2103) = lu(k,2103) - lu(k,1638) * lu(k,2096) + lu(k,2104) = lu(k,2104) - lu(k,1639) * lu(k,2096) + lu(k,2105) = lu(k,2105) - lu(k,1640) * lu(k,2096) + lu(k,2106) = lu(k,2106) - lu(k,1641) * lu(k,2096) + lu(k,2107) = lu(k,2107) - lu(k,1642) * lu(k,2096) + lu(k,2108) = lu(k,2108) - lu(k,1643) * lu(k,2096) + lu(k,2109) = lu(k,2109) - lu(k,1644) * lu(k,2096) + lu(k,2110) = lu(k,2110) - lu(k,1645) * lu(k,2096) + lu(k,2111) = lu(k,2111) - lu(k,1646) * lu(k,2096) + lu(k,2230) = lu(k,2230) - lu(k,1632) * lu(k,2229) + lu(k,2231) = lu(k,2231) - lu(k,1633) * lu(k,2229) + lu(k,2232) = lu(k,2232) - lu(k,1634) * lu(k,2229) + lu(k,2233) = lu(k,2233) - lu(k,1635) * lu(k,2229) + lu(k,2234) = lu(k,2234) - lu(k,1636) * lu(k,2229) + lu(k,2235) = lu(k,2235) - lu(k,1637) * lu(k,2229) + lu(k,2236) = lu(k,2236) - lu(k,1638) * lu(k,2229) + lu(k,2237) = lu(k,2237) - lu(k,1639) * lu(k,2229) + lu(k,2238) = lu(k,2238) - lu(k,1640) * lu(k,2229) + lu(k,2239) = lu(k,2239) - lu(k,1641) * lu(k,2229) + lu(k,2240) = lu(k,2240) - lu(k,1642) * lu(k,2229) + lu(k,2241) = lu(k,2241) - lu(k,1643) * lu(k,2229) + lu(k,2242) = lu(k,2242) - lu(k,1644) * lu(k,2229) + lu(k,2243) = lu(k,2243) - lu(k,1645) * lu(k,2229) + lu(k,2244) = lu(k,2244) - lu(k,1646) * lu(k,2229) + lu(k,2290) = lu(k,2290) - lu(k,1632) * lu(k,2289) + lu(k,2291) = lu(k,2291) - lu(k,1633) * lu(k,2289) + lu(k,2292) = lu(k,2292) - lu(k,1634) * lu(k,2289) + lu(k,2293) = lu(k,2293) - lu(k,1635) * lu(k,2289) + lu(k,2294) = lu(k,2294) - lu(k,1636) * lu(k,2289) + lu(k,2295) = lu(k,2295) - lu(k,1637) * lu(k,2289) + lu(k,2296) = lu(k,2296) - lu(k,1638) * lu(k,2289) + lu(k,2297) = lu(k,2297) - lu(k,1639) * lu(k,2289) + lu(k,2298) = lu(k,2298) - lu(k,1640) * lu(k,2289) + lu(k,2299) = lu(k,2299) - lu(k,1641) * lu(k,2289) + lu(k,2300) = lu(k,2300) - lu(k,1642) * lu(k,2289) + lu(k,2301) = lu(k,2301) - lu(k,1643) * lu(k,2289) + lu(k,2302) = lu(k,2302) - lu(k,1644) * lu(k,2289) + lu(k,2303) = lu(k,2303) - lu(k,1645) * lu(k,2289) + lu(k,2304) = lu(k,2304) - lu(k,1646) * lu(k,2289) + lu(k,2410) = lu(k,2410) - lu(k,1632) * lu(k,2409) + lu(k,2411) = lu(k,2411) - lu(k,1633) * lu(k,2409) + lu(k,2412) = lu(k,2412) - lu(k,1634) * lu(k,2409) + lu(k,2413) = lu(k,2413) - lu(k,1635) * lu(k,2409) + lu(k,2414) = lu(k,2414) - lu(k,1636) * lu(k,2409) + lu(k,2415) = lu(k,2415) - lu(k,1637) * lu(k,2409) + lu(k,2416) = lu(k,2416) - lu(k,1638) * lu(k,2409) + lu(k,2417) = lu(k,2417) - lu(k,1639) * lu(k,2409) + lu(k,2418) = lu(k,2418) - lu(k,1640) * lu(k,2409) + lu(k,2419) = lu(k,2419) - lu(k,1641) * lu(k,2409) + lu(k,2420) = lu(k,2420) - lu(k,1642) * lu(k,2409) + lu(k,2421) = lu(k,2421) - lu(k,1643) * lu(k,2409) + lu(k,2422) = lu(k,2422) - lu(k,1644) * lu(k,2409) + lu(k,2423) = lu(k,2423) - lu(k,1645) * lu(k,2409) + lu(k,2424) = lu(k,2424) - lu(k,1646) * lu(k,2409) + lu(k,2436) = lu(k,2436) - lu(k,1632) * lu(k,2435) + lu(k,2437) = lu(k,2437) - lu(k,1633) * lu(k,2435) + lu(k,2438) = lu(k,2438) - lu(k,1634) * lu(k,2435) + lu(k,2439) = lu(k,2439) - lu(k,1635) * lu(k,2435) + lu(k,2440) = lu(k,2440) - lu(k,1636) * lu(k,2435) + lu(k,2441) = lu(k,2441) - lu(k,1637) * lu(k,2435) + lu(k,2442) = lu(k,2442) - lu(k,1638) * lu(k,2435) + lu(k,2443) = lu(k,2443) - lu(k,1639) * lu(k,2435) + lu(k,2444) = lu(k,2444) - lu(k,1640) * lu(k,2435) + lu(k,2445) = lu(k,2445) - lu(k,1641) * lu(k,2435) + lu(k,2446) = lu(k,2446) - lu(k,1642) * lu(k,2435) + lu(k,2447) = lu(k,2447) - lu(k,1643) * lu(k,2435) + lu(k,2448) = lu(k,2448) - lu(k,1644) * lu(k,2435) + lu(k,2449) = lu(k,2449) - lu(k,1645) * lu(k,2435) + lu(k,2450) = lu(k,2450) - lu(k,1646) * lu(k,2435) + lu(k,2481) = lu(k,2481) - lu(k,1632) * lu(k,2480) + lu(k,2482) = lu(k,2482) - lu(k,1633) * lu(k,2480) + lu(k,2483) = lu(k,2483) - lu(k,1634) * lu(k,2480) + lu(k,2484) = lu(k,2484) - lu(k,1635) * lu(k,2480) + lu(k,2485) = lu(k,2485) - lu(k,1636) * lu(k,2480) + lu(k,2486) = lu(k,2486) - lu(k,1637) * lu(k,2480) + lu(k,2487) = lu(k,2487) - lu(k,1638) * lu(k,2480) + lu(k,2488) = lu(k,2488) - lu(k,1639) * lu(k,2480) + lu(k,2489) = lu(k,2489) - lu(k,1640) * lu(k,2480) + lu(k,2490) = lu(k,2490) - lu(k,1641) * lu(k,2480) + lu(k,2491) = lu(k,2491) - lu(k,1642) * lu(k,2480) + lu(k,2492) = lu(k,2492) - lu(k,1643) * lu(k,2480) + lu(k,2493) = lu(k,2493) - lu(k,1644) * lu(k,2480) + lu(k,2494) = lu(k,2494) - lu(k,1645) * lu(k,2480) + lu(k,2495) = lu(k,2495) - lu(k,1646) * lu(k,2480) + lu(k,2508) = lu(k,2508) - lu(k,1632) * lu(k,2507) + lu(k,2509) = lu(k,2509) - lu(k,1633) * lu(k,2507) + lu(k,2510) = lu(k,2510) - lu(k,1634) * lu(k,2507) + lu(k,2511) = lu(k,2511) - lu(k,1635) * lu(k,2507) + lu(k,2512) = lu(k,2512) - lu(k,1636) * lu(k,2507) + lu(k,2513) = lu(k,2513) - lu(k,1637) * lu(k,2507) + lu(k,2514) = lu(k,2514) - lu(k,1638) * lu(k,2507) + lu(k,2515) = lu(k,2515) - lu(k,1639) * lu(k,2507) + lu(k,2516) = lu(k,2516) - lu(k,1640) * lu(k,2507) + lu(k,2517) = lu(k,2517) - lu(k,1641) * lu(k,2507) + lu(k,2518) = lu(k,2518) - lu(k,1642) * lu(k,2507) + lu(k,2519) = lu(k,2519) - lu(k,1643) * lu(k,2507) + lu(k,2520) = lu(k,2520) - lu(k,1644) * lu(k,2507) + lu(k,2521) = lu(k,2521) - lu(k,1645) * lu(k,2507) + lu(k,2522) = lu(k,2522) - lu(k,1646) * lu(k,2507) + lu(k,1684) = 1._r8 / lu(k,1684) + lu(k,1685) = lu(k,1685) * lu(k,1684) + lu(k,1686) = lu(k,1686) * lu(k,1684) + lu(k,1687) = lu(k,1687) * lu(k,1684) + lu(k,1688) = lu(k,1688) * lu(k,1684) + lu(k,1689) = lu(k,1689) * lu(k,1684) + lu(k,1690) = lu(k,1690) * lu(k,1684) + lu(k,1691) = lu(k,1691) * lu(k,1684) + lu(k,1692) = lu(k,1692) * lu(k,1684) + lu(k,1693) = lu(k,1693) * lu(k,1684) + lu(k,1694) = lu(k,1694) * lu(k,1684) + lu(k,1695) = lu(k,1695) * lu(k,1684) + lu(k,1696) = lu(k,1696) * lu(k,1684) + lu(k,1697) = lu(k,1697) * lu(k,1684) + lu(k,1698) = lu(k,1698) * lu(k,1684) + lu(k,1708) = lu(k,1708) - lu(k,1685) * lu(k,1707) + lu(k,1709) = lu(k,1709) - lu(k,1686) * lu(k,1707) + lu(k,1710) = lu(k,1710) - lu(k,1687) * lu(k,1707) + lu(k,1711) = lu(k,1711) - lu(k,1688) * lu(k,1707) + lu(k,1712) = lu(k,1712) - lu(k,1689) * lu(k,1707) + lu(k,1713) = lu(k,1713) - lu(k,1690) * lu(k,1707) + lu(k,1714) = lu(k,1714) - lu(k,1691) * lu(k,1707) + lu(k,1715) = lu(k,1715) - lu(k,1692) * lu(k,1707) + lu(k,1716) = lu(k,1716) - lu(k,1693) * lu(k,1707) + lu(k,1717) = lu(k,1717) - lu(k,1694) * lu(k,1707) + lu(k,1718) = lu(k,1718) - lu(k,1695) * lu(k,1707) + lu(k,1719) = lu(k,1719) - lu(k,1696) * lu(k,1707) + lu(k,1720) = lu(k,1720) - lu(k,1697) * lu(k,1707) + lu(k,1721) = lu(k,1721) - lu(k,1698) * lu(k,1707) + lu(k,1729) = lu(k,1729) - lu(k,1685) * lu(k,1728) + lu(k,1730) = lu(k,1730) - lu(k,1686) * lu(k,1728) + lu(k,1731) = lu(k,1731) - lu(k,1687) * lu(k,1728) + lu(k,1732) = lu(k,1732) - lu(k,1688) * lu(k,1728) + lu(k,1733) = lu(k,1733) - lu(k,1689) * lu(k,1728) + lu(k,1734) = lu(k,1734) - lu(k,1690) * lu(k,1728) + lu(k,1735) = lu(k,1735) - lu(k,1691) * lu(k,1728) + lu(k,1736) = lu(k,1736) - lu(k,1692) * lu(k,1728) + lu(k,1737) = lu(k,1737) - lu(k,1693) * lu(k,1728) + lu(k,1738) = lu(k,1738) - lu(k,1694) * lu(k,1728) + lu(k,1739) = lu(k,1739) - lu(k,1695) * lu(k,1728) + lu(k,1740) = lu(k,1740) - lu(k,1696) * lu(k,1728) + lu(k,1741) = lu(k,1741) - lu(k,1697) * lu(k,1728) + lu(k,1742) = lu(k,1742) - lu(k,1698) * lu(k,1728) + lu(k,1902) = lu(k,1902) - lu(k,1685) * lu(k,1901) + lu(k,1903) = lu(k,1903) - lu(k,1686) * lu(k,1901) + lu(k,1904) = lu(k,1904) - lu(k,1687) * lu(k,1901) + lu(k,1905) = lu(k,1905) - lu(k,1688) * lu(k,1901) + lu(k,1906) = lu(k,1906) - lu(k,1689) * lu(k,1901) + lu(k,1907) = lu(k,1907) - lu(k,1690) * lu(k,1901) + lu(k,1908) = lu(k,1908) - lu(k,1691) * lu(k,1901) + lu(k,1909) = lu(k,1909) - lu(k,1692) * lu(k,1901) + lu(k,1910) = lu(k,1910) - lu(k,1693) * lu(k,1901) + lu(k,1911) = lu(k,1911) - lu(k,1694) * lu(k,1901) + lu(k,1912) = lu(k,1912) - lu(k,1695) * lu(k,1901) + lu(k,1913) = lu(k,1913) - lu(k,1696) * lu(k,1901) + lu(k,1914) = lu(k,1914) - lu(k,1697) * lu(k,1901) + lu(k,1915) = lu(k,1915) - lu(k,1698) * lu(k,1901) + lu(k,1945) = lu(k,1945) - lu(k,1685) * lu(k,1944) + lu(k,1946) = lu(k,1946) - lu(k,1686) * lu(k,1944) + lu(k,1947) = lu(k,1947) - lu(k,1687) * lu(k,1944) + lu(k,1948) = lu(k,1948) - lu(k,1688) * lu(k,1944) + lu(k,1949) = lu(k,1949) - lu(k,1689) * lu(k,1944) + lu(k,1950) = lu(k,1950) - lu(k,1690) * lu(k,1944) + lu(k,1951) = lu(k,1951) - lu(k,1691) * lu(k,1944) + lu(k,1952) = lu(k,1952) - lu(k,1692) * lu(k,1944) + lu(k,1953) = lu(k,1953) - lu(k,1693) * lu(k,1944) + lu(k,1954) = lu(k,1954) - lu(k,1694) * lu(k,1944) + lu(k,1955) = lu(k,1955) - lu(k,1695) * lu(k,1944) + lu(k,1956) = lu(k,1956) - lu(k,1696) * lu(k,1944) + lu(k,1957) = lu(k,1957) - lu(k,1697) * lu(k,1944) + lu(k,1958) = lu(k,1958) - lu(k,1698) * lu(k,1944) + lu(k,1991) = lu(k,1991) - lu(k,1685) * lu(k,1990) + lu(k,1992) = lu(k,1992) - lu(k,1686) * lu(k,1990) + lu(k,1993) = lu(k,1993) - lu(k,1687) * lu(k,1990) + lu(k,1994) = lu(k,1994) - lu(k,1688) * lu(k,1990) + lu(k,1995) = lu(k,1995) - lu(k,1689) * lu(k,1990) + lu(k,1996) = lu(k,1996) - lu(k,1690) * lu(k,1990) + lu(k,1997) = lu(k,1997) - lu(k,1691) * lu(k,1990) + lu(k,1998) = lu(k,1998) - lu(k,1692) * lu(k,1990) + lu(k,1999) = lu(k,1999) - lu(k,1693) * lu(k,1990) + lu(k,2000) = lu(k,2000) - lu(k,1694) * lu(k,1990) + lu(k,2001) = lu(k,2001) - lu(k,1695) * lu(k,1990) + lu(k,2002) = lu(k,2002) - lu(k,1696) * lu(k,1990) + lu(k,2003) = lu(k,2003) - lu(k,1697) * lu(k,1990) + lu(k,2004) = lu(k,2004) - lu(k,1698) * lu(k,1990) + lu(k,2034) = lu(k,2034) - lu(k,1685) * lu(k,2033) + lu(k,2035) = lu(k,2035) - lu(k,1686) * lu(k,2033) + lu(k,2036) = lu(k,2036) - lu(k,1687) * lu(k,2033) + lu(k,2037) = lu(k,2037) - lu(k,1688) * lu(k,2033) + lu(k,2038) = lu(k,2038) - lu(k,1689) * lu(k,2033) + lu(k,2039) = lu(k,2039) - lu(k,1690) * lu(k,2033) + lu(k,2040) = lu(k,2040) - lu(k,1691) * lu(k,2033) + lu(k,2041) = lu(k,2041) - lu(k,1692) * lu(k,2033) + lu(k,2042) = lu(k,2042) - lu(k,1693) * lu(k,2033) + lu(k,2043) = lu(k,2043) - lu(k,1694) * lu(k,2033) + lu(k,2044) = lu(k,2044) - lu(k,1695) * lu(k,2033) + lu(k,2045) = lu(k,2045) - lu(k,1696) * lu(k,2033) + lu(k,2046) = lu(k,2046) - lu(k,1697) * lu(k,2033) + lu(k,2047) = lu(k,2047) - lu(k,1698) * lu(k,2033) + lu(k,2098) = lu(k,2098) - lu(k,1685) * lu(k,2097) + lu(k,2099) = lu(k,2099) - lu(k,1686) * lu(k,2097) + lu(k,2100) = lu(k,2100) - lu(k,1687) * lu(k,2097) + lu(k,2101) = lu(k,2101) - lu(k,1688) * lu(k,2097) + lu(k,2102) = lu(k,2102) - lu(k,1689) * lu(k,2097) + lu(k,2103) = lu(k,2103) - lu(k,1690) * lu(k,2097) + lu(k,2104) = lu(k,2104) - lu(k,1691) * lu(k,2097) + lu(k,2105) = lu(k,2105) - lu(k,1692) * lu(k,2097) + lu(k,2106) = lu(k,2106) - lu(k,1693) * lu(k,2097) + lu(k,2107) = lu(k,2107) - lu(k,1694) * lu(k,2097) + lu(k,2108) = lu(k,2108) - lu(k,1695) * lu(k,2097) + lu(k,2109) = lu(k,2109) - lu(k,1696) * lu(k,2097) + lu(k,2110) = lu(k,2110) - lu(k,1697) * lu(k,2097) + lu(k,2111) = lu(k,2111) - lu(k,1698) * lu(k,2097) + lu(k,2125) = lu(k,2125) - lu(k,1685) * lu(k,2124) + lu(k,2126) = lu(k,2126) - lu(k,1686) * lu(k,2124) + lu(k,2127) = lu(k,2127) - lu(k,1687) * lu(k,2124) + lu(k,2128) = lu(k,2128) - lu(k,1688) * lu(k,2124) + lu(k,2129) = lu(k,2129) - lu(k,1689) * lu(k,2124) + lu(k,2130) = lu(k,2130) - lu(k,1690) * lu(k,2124) + lu(k,2131) = lu(k,2131) - lu(k,1691) * lu(k,2124) + lu(k,2132) = lu(k,2132) - lu(k,1692) * lu(k,2124) + lu(k,2133) = lu(k,2133) - lu(k,1693) * lu(k,2124) + lu(k,2134) = lu(k,2134) - lu(k,1694) * lu(k,2124) + lu(k,2135) = lu(k,2135) - lu(k,1695) * lu(k,2124) + lu(k,2136) = lu(k,2136) - lu(k,1696) * lu(k,2124) + lu(k,2137) = lu(k,2137) - lu(k,1697) * lu(k,2124) + lu(k,2138) = lu(k,2138) - lu(k,1698) * lu(k,2124) + lu(k,2231) = lu(k,2231) - lu(k,1685) * lu(k,2230) + lu(k,2232) = lu(k,2232) - lu(k,1686) * lu(k,2230) + lu(k,2233) = lu(k,2233) - lu(k,1687) * lu(k,2230) + lu(k,2234) = lu(k,2234) - lu(k,1688) * lu(k,2230) + lu(k,2235) = lu(k,2235) - lu(k,1689) * lu(k,2230) + lu(k,2236) = lu(k,2236) - lu(k,1690) * lu(k,2230) + lu(k,2237) = lu(k,2237) - lu(k,1691) * lu(k,2230) + lu(k,2238) = lu(k,2238) - lu(k,1692) * lu(k,2230) + lu(k,2239) = lu(k,2239) - lu(k,1693) * lu(k,2230) + lu(k,2240) = lu(k,2240) - lu(k,1694) * lu(k,2230) + lu(k,2241) = lu(k,2241) - lu(k,1695) * lu(k,2230) + lu(k,2242) = lu(k,2242) - lu(k,1696) * lu(k,2230) + lu(k,2243) = lu(k,2243) - lu(k,1697) * lu(k,2230) + lu(k,2244) = lu(k,2244) - lu(k,1698) * lu(k,2230) + lu(k,2291) = lu(k,2291) - lu(k,1685) * lu(k,2290) + lu(k,2292) = lu(k,2292) - lu(k,1686) * lu(k,2290) + lu(k,2293) = lu(k,2293) - lu(k,1687) * lu(k,2290) + lu(k,2294) = lu(k,2294) - lu(k,1688) * lu(k,2290) + lu(k,2295) = lu(k,2295) - lu(k,1689) * lu(k,2290) + lu(k,2296) = lu(k,2296) - lu(k,1690) * lu(k,2290) + lu(k,2297) = lu(k,2297) - lu(k,1691) * lu(k,2290) + lu(k,2298) = lu(k,2298) - lu(k,1692) * lu(k,2290) + lu(k,2299) = lu(k,2299) - lu(k,1693) * lu(k,2290) + lu(k,2300) = lu(k,2300) - lu(k,1694) * lu(k,2290) + lu(k,2301) = lu(k,2301) - lu(k,1695) * lu(k,2290) + lu(k,2302) = lu(k,2302) - lu(k,1696) * lu(k,2290) + lu(k,2303) = lu(k,2303) - lu(k,1697) * lu(k,2290) + lu(k,2304) = lu(k,2304) - lu(k,1698) * lu(k,2290) + lu(k,2411) = lu(k,2411) - lu(k,1685) * lu(k,2410) + lu(k,2412) = lu(k,2412) - lu(k,1686) * lu(k,2410) + lu(k,2413) = lu(k,2413) - lu(k,1687) * lu(k,2410) + lu(k,2414) = lu(k,2414) - lu(k,1688) * lu(k,2410) + lu(k,2415) = lu(k,2415) - lu(k,1689) * lu(k,2410) + lu(k,2416) = lu(k,2416) - lu(k,1690) * lu(k,2410) + lu(k,2417) = lu(k,2417) - lu(k,1691) * lu(k,2410) + lu(k,2418) = lu(k,2418) - lu(k,1692) * lu(k,2410) + lu(k,2419) = lu(k,2419) - lu(k,1693) * lu(k,2410) + lu(k,2420) = lu(k,2420) - lu(k,1694) * lu(k,2410) + lu(k,2421) = lu(k,2421) - lu(k,1695) * lu(k,2410) + lu(k,2422) = lu(k,2422) - lu(k,1696) * lu(k,2410) + lu(k,2423) = lu(k,2423) - lu(k,1697) * lu(k,2410) + lu(k,2424) = lu(k,2424) - lu(k,1698) * lu(k,2410) + lu(k,2437) = lu(k,2437) - lu(k,1685) * lu(k,2436) + lu(k,2438) = lu(k,2438) - lu(k,1686) * lu(k,2436) + lu(k,2439) = lu(k,2439) - lu(k,1687) * lu(k,2436) + lu(k,2440) = lu(k,2440) - lu(k,1688) * lu(k,2436) + lu(k,2441) = lu(k,2441) - lu(k,1689) * lu(k,2436) + lu(k,2442) = lu(k,2442) - lu(k,1690) * lu(k,2436) + lu(k,2443) = lu(k,2443) - lu(k,1691) * lu(k,2436) + lu(k,2444) = lu(k,2444) - lu(k,1692) * lu(k,2436) + lu(k,2445) = lu(k,2445) - lu(k,1693) * lu(k,2436) + lu(k,2446) = lu(k,2446) - lu(k,1694) * lu(k,2436) + lu(k,2447) = lu(k,2447) - lu(k,1695) * lu(k,2436) + lu(k,2448) = lu(k,2448) - lu(k,1696) * lu(k,2436) + lu(k,2449) = lu(k,2449) - lu(k,1697) * lu(k,2436) + lu(k,2450) = lu(k,2450) - lu(k,1698) * lu(k,2436) + lu(k,2482) = lu(k,2482) - lu(k,1685) * lu(k,2481) + lu(k,2483) = lu(k,2483) - lu(k,1686) * lu(k,2481) + lu(k,2484) = lu(k,2484) - lu(k,1687) * lu(k,2481) + lu(k,2485) = lu(k,2485) - lu(k,1688) * lu(k,2481) + lu(k,2486) = lu(k,2486) - lu(k,1689) * lu(k,2481) + lu(k,2487) = lu(k,2487) - lu(k,1690) * lu(k,2481) + lu(k,2488) = lu(k,2488) - lu(k,1691) * lu(k,2481) + lu(k,2489) = lu(k,2489) - lu(k,1692) * lu(k,2481) + lu(k,2490) = lu(k,2490) - lu(k,1693) * lu(k,2481) + lu(k,2491) = lu(k,2491) - lu(k,1694) * lu(k,2481) + lu(k,2492) = lu(k,2492) - lu(k,1695) * lu(k,2481) + lu(k,2493) = lu(k,2493) - lu(k,1696) * lu(k,2481) + lu(k,2494) = lu(k,2494) - lu(k,1697) * lu(k,2481) + lu(k,2495) = lu(k,2495) - lu(k,1698) * lu(k,2481) + lu(k,2509) = lu(k,2509) - lu(k,1685) * lu(k,2508) + lu(k,2510) = lu(k,2510) - lu(k,1686) * lu(k,2508) + lu(k,2511) = lu(k,2511) - lu(k,1687) * lu(k,2508) + lu(k,2512) = lu(k,2512) - lu(k,1688) * lu(k,2508) + lu(k,2513) = lu(k,2513) - lu(k,1689) * lu(k,2508) + lu(k,2514) = lu(k,2514) - lu(k,1690) * lu(k,2508) + lu(k,2515) = lu(k,2515) - lu(k,1691) * lu(k,2508) + lu(k,2516) = lu(k,2516) - lu(k,1692) * lu(k,2508) + lu(k,2517) = lu(k,2517) - lu(k,1693) * lu(k,2508) + lu(k,2518) = lu(k,2518) - lu(k,1694) * lu(k,2508) + lu(k,2519) = lu(k,2519) - lu(k,1695) * lu(k,2508) + lu(k,2520) = lu(k,2520) - lu(k,1696) * lu(k,2508) + lu(k,2521) = lu(k,2521) - lu(k,1697) * lu(k,2508) + lu(k,2522) = lu(k,2522) - lu(k,1698) * lu(k,2508) + lu(k,1708) = 1._r8 / lu(k,1708) + lu(k,1709) = lu(k,1709) * lu(k,1708) + lu(k,1710) = lu(k,1710) * lu(k,1708) + lu(k,1711) = lu(k,1711) * lu(k,1708) + lu(k,1712) = lu(k,1712) * lu(k,1708) + lu(k,1713) = lu(k,1713) * lu(k,1708) + lu(k,1714) = lu(k,1714) * lu(k,1708) + lu(k,1715) = lu(k,1715) * lu(k,1708) + lu(k,1716) = lu(k,1716) * lu(k,1708) + lu(k,1717) = lu(k,1717) * lu(k,1708) + lu(k,1718) = lu(k,1718) * lu(k,1708) + lu(k,1719) = lu(k,1719) * lu(k,1708) + lu(k,1720) = lu(k,1720) * lu(k,1708) + lu(k,1721) = lu(k,1721) * lu(k,1708) + lu(k,1730) = lu(k,1730) - lu(k,1709) * lu(k,1729) + lu(k,1731) = lu(k,1731) - lu(k,1710) * lu(k,1729) + lu(k,1732) = lu(k,1732) - lu(k,1711) * lu(k,1729) + lu(k,1733) = lu(k,1733) - lu(k,1712) * lu(k,1729) + lu(k,1734) = lu(k,1734) - lu(k,1713) * lu(k,1729) + lu(k,1735) = lu(k,1735) - lu(k,1714) * lu(k,1729) + lu(k,1736) = lu(k,1736) - lu(k,1715) * lu(k,1729) + lu(k,1737) = lu(k,1737) - lu(k,1716) * lu(k,1729) + lu(k,1738) = lu(k,1738) - lu(k,1717) * lu(k,1729) + lu(k,1739) = lu(k,1739) - lu(k,1718) * lu(k,1729) + lu(k,1740) = lu(k,1740) - lu(k,1719) * lu(k,1729) + lu(k,1741) = lu(k,1741) - lu(k,1720) * lu(k,1729) + lu(k,1742) = lu(k,1742) - lu(k,1721) * lu(k,1729) + lu(k,1903) = lu(k,1903) - lu(k,1709) * lu(k,1902) + lu(k,1904) = lu(k,1904) - lu(k,1710) * lu(k,1902) + lu(k,1905) = lu(k,1905) - lu(k,1711) * lu(k,1902) + lu(k,1906) = lu(k,1906) - lu(k,1712) * lu(k,1902) + lu(k,1907) = lu(k,1907) - lu(k,1713) * lu(k,1902) + lu(k,1908) = lu(k,1908) - lu(k,1714) * lu(k,1902) + lu(k,1909) = lu(k,1909) - lu(k,1715) * lu(k,1902) + lu(k,1910) = lu(k,1910) - lu(k,1716) * lu(k,1902) + lu(k,1911) = lu(k,1911) - lu(k,1717) * lu(k,1902) + lu(k,1912) = lu(k,1912) - lu(k,1718) * lu(k,1902) + lu(k,1913) = lu(k,1913) - lu(k,1719) * lu(k,1902) + lu(k,1914) = lu(k,1914) - lu(k,1720) * lu(k,1902) + lu(k,1915) = lu(k,1915) - lu(k,1721) * lu(k,1902) + lu(k,1946) = lu(k,1946) - lu(k,1709) * lu(k,1945) + lu(k,1947) = lu(k,1947) - lu(k,1710) * lu(k,1945) + lu(k,1948) = lu(k,1948) - lu(k,1711) * lu(k,1945) + lu(k,1949) = lu(k,1949) - lu(k,1712) * lu(k,1945) + lu(k,1950) = lu(k,1950) - lu(k,1713) * lu(k,1945) + lu(k,1951) = lu(k,1951) - lu(k,1714) * lu(k,1945) + lu(k,1952) = lu(k,1952) - lu(k,1715) * lu(k,1945) + lu(k,1953) = lu(k,1953) - lu(k,1716) * lu(k,1945) + lu(k,1954) = lu(k,1954) - lu(k,1717) * lu(k,1945) + lu(k,1955) = lu(k,1955) - lu(k,1718) * lu(k,1945) + lu(k,1956) = lu(k,1956) - lu(k,1719) * lu(k,1945) + lu(k,1957) = lu(k,1957) - lu(k,1720) * lu(k,1945) + lu(k,1958) = lu(k,1958) - lu(k,1721) * lu(k,1945) + lu(k,1992) = lu(k,1992) - lu(k,1709) * lu(k,1991) + lu(k,1993) = lu(k,1993) - lu(k,1710) * lu(k,1991) + lu(k,1994) = lu(k,1994) - lu(k,1711) * lu(k,1991) + lu(k,1995) = lu(k,1995) - lu(k,1712) * lu(k,1991) + lu(k,1996) = lu(k,1996) - lu(k,1713) * lu(k,1991) + lu(k,1997) = lu(k,1997) - lu(k,1714) * lu(k,1991) + lu(k,1998) = lu(k,1998) - lu(k,1715) * lu(k,1991) + lu(k,1999) = lu(k,1999) - lu(k,1716) * lu(k,1991) + lu(k,2000) = lu(k,2000) - lu(k,1717) * lu(k,1991) + lu(k,2001) = lu(k,2001) - lu(k,1718) * lu(k,1991) + lu(k,2002) = lu(k,2002) - lu(k,1719) * lu(k,1991) + lu(k,2003) = lu(k,2003) - lu(k,1720) * lu(k,1991) + lu(k,2004) = lu(k,2004) - lu(k,1721) * lu(k,1991) + lu(k,2035) = lu(k,2035) - lu(k,1709) * lu(k,2034) + lu(k,2036) = lu(k,2036) - lu(k,1710) * lu(k,2034) + lu(k,2037) = lu(k,2037) - lu(k,1711) * lu(k,2034) + lu(k,2038) = lu(k,2038) - lu(k,1712) * lu(k,2034) + lu(k,2039) = lu(k,2039) - lu(k,1713) * lu(k,2034) + lu(k,2040) = lu(k,2040) - lu(k,1714) * lu(k,2034) + lu(k,2041) = lu(k,2041) - lu(k,1715) * lu(k,2034) + lu(k,2042) = lu(k,2042) - lu(k,1716) * lu(k,2034) + lu(k,2043) = lu(k,2043) - lu(k,1717) * lu(k,2034) + lu(k,2044) = lu(k,2044) - lu(k,1718) * lu(k,2034) + lu(k,2045) = lu(k,2045) - lu(k,1719) * lu(k,2034) + lu(k,2046) = lu(k,2046) - lu(k,1720) * lu(k,2034) + lu(k,2047) = lu(k,2047) - lu(k,1721) * lu(k,2034) + lu(k,2099) = lu(k,2099) - lu(k,1709) * lu(k,2098) + lu(k,2100) = lu(k,2100) - lu(k,1710) * lu(k,2098) + lu(k,2101) = lu(k,2101) - lu(k,1711) * lu(k,2098) + lu(k,2102) = lu(k,2102) - lu(k,1712) * lu(k,2098) + lu(k,2103) = lu(k,2103) - lu(k,1713) * lu(k,2098) + lu(k,2104) = lu(k,2104) - lu(k,1714) * lu(k,2098) + lu(k,2105) = lu(k,2105) - lu(k,1715) * lu(k,2098) + lu(k,2106) = lu(k,2106) - lu(k,1716) * lu(k,2098) + lu(k,2107) = lu(k,2107) - lu(k,1717) * lu(k,2098) + lu(k,2108) = lu(k,2108) - lu(k,1718) * lu(k,2098) + lu(k,2109) = lu(k,2109) - lu(k,1719) * lu(k,2098) + lu(k,2110) = lu(k,2110) - lu(k,1720) * lu(k,2098) + lu(k,2111) = lu(k,2111) - lu(k,1721) * lu(k,2098) + lu(k,2126) = lu(k,2126) - lu(k,1709) * lu(k,2125) + lu(k,2127) = lu(k,2127) - lu(k,1710) * lu(k,2125) + lu(k,2128) = lu(k,2128) - lu(k,1711) * lu(k,2125) + lu(k,2129) = lu(k,2129) - lu(k,1712) * lu(k,2125) + lu(k,2130) = lu(k,2130) - lu(k,1713) * lu(k,2125) + lu(k,2131) = lu(k,2131) - lu(k,1714) * lu(k,2125) + lu(k,2132) = lu(k,2132) - lu(k,1715) * lu(k,2125) + lu(k,2133) = lu(k,2133) - lu(k,1716) * lu(k,2125) + lu(k,2134) = lu(k,2134) - lu(k,1717) * lu(k,2125) + lu(k,2135) = lu(k,2135) - lu(k,1718) * lu(k,2125) + lu(k,2136) = lu(k,2136) - lu(k,1719) * lu(k,2125) + lu(k,2137) = lu(k,2137) - lu(k,1720) * lu(k,2125) + lu(k,2138) = lu(k,2138) - lu(k,1721) * lu(k,2125) + lu(k,2232) = lu(k,2232) - lu(k,1709) * lu(k,2231) + lu(k,2233) = lu(k,2233) - lu(k,1710) * lu(k,2231) + lu(k,2234) = lu(k,2234) - lu(k,1711) * lu(k,2231) + lu(k,2235) = lu(k,2235) - lu(k,1712) * lu(k,2231) + lu(k,2236) = lu(k,2236) - lu(k,1713) * lu(k,2231) + lu(k,2237) = lu(k,2237) - lu(k,1714) * lu(k,2231) + lu(k,2238) = lu(k,2238) - lu(k,1715) * lu(k,2231) + lu(k,2239) = lu(k,2239) - lu(k,1716) * lu(k,2231) + lu(k,2240) = lu(k,2240) - lu(k,1717) * lu(k,2231) + lu(k,2241) = lu(k,2241) - lu(k,1718) * lu(k,2231) + lu(k,2242) = lu(k,2242) - lu(k,1719) * lu(k,2231) + lu(k,2243) = lu(k,2243) - lu(k,1720) * lu(k,2231) + lu(k,2244) = lu(k,2244) - lu(k,1721) * lu(k,2231) + lu(k,2292) = lu(k,2292) - lu(k,1709) * lu(k,2291) + lu(k,2293) = lu(k,2293) - lu(k,1710) * lu(k,2291) + lu(k,2294) = lu(k,2294) - lu(k,1711) * lu(k,2291) + lu(k,2295) = lu(k,2295) - lu(k,1712) * lu(k,2291) + lu(k,2296) = lu(k,2296) - lu(k,1713) * lu(k,2291) + lu(k,2297) = lu(k,2297) - lu(k,1714) * lu(k,2291) + lu(k,2298) = lu(k,2298) - lu(k,1715) * lu(k,2291) + lu(k,2299) = lu(k,2299) - lu(k,1716) * lu(k,2291) + lu(k,2300) = lu(k,2300) - lu(k,1717) * lu(k,2291) + lu(k,2301) = lu(k,2301) - lu(k,1718) * lu(k,2291) + lu(k,2302) = lu(k,2302) - lu(k,1719) * lu(k,2291) + lu(k,2303) = lu(k,2303) - lu(k,1720) * lu(k,2291) + lu(k,2304) = lu(k,2304) - lu(k,1721) * lu(k,2291) + lu(k,2412) = lu(k,2412) - lu(k,1709) * lu(k,2411) + lu(k,2413) = lu(k,2413) - lu(k,1710) * lu(k,2411) + lu(k,2414) = lu(k,2414) - lu(k,1711) * lu(k,2411) + lu(k,2415) = lu(k,2415) - lu(k,1712) * lu(k,2411) + lu(k,2416) = lu(k,2416) - lu(k,1713) * lu(k,2411) + lu(k,2417) = lu(k,2417) - lu(k,1714) * lu(k,2411) + lu(k,2418) = lu(k,2418) - lu(k,1715) * lu(k,2411) + lu(k,2419) = lu(k,2419) - lu(k,1716) * lu(k,2411) + lu(k,2420) = lu(k,2420) - lu(k,1717) * lu(k,2411) + lu(k,2421) = lu(k,2421) - lu(k,1718) * lu(k,2411) + lu(k,2422) = lu(k,2422) - lu(k,1719) * lu(k,2411) + lu(k,2423) = lu(k,2423) - lu(k,1720) * lu(k,2411) + lu(k,2424) = lu(k,2424) - lu(k,1721) * lu(k,2411) + lu(k,2438) = lu(k,2438) - lu(k,1709) * lu(k,2437) + lu(k,2439) = lu(k,2439) - lu(k,1710) * lu(k,2437) + lu(k,2440) = lu(k,2440) - lu(k,1711) * lu(k,2437) + lu(k,2441) = lu(k,2441) - lu(k,1712) * lu(k,2437) + lu(k,2442) = lu(k,2442) - lu(k,1713) * lu(k,2437) + lu(k,2443) = lu(k,2443) - lu(k,1714) * lu(k,2437) + lu(k,2444) = lu(k,2444) - lu(k,1715) * lu(k,2437) + lu(k,2445) = lu(k,2445) - lu(k,1716) * lu(k,2437) + lu(k,2446) = lu(k,2446) - lu(k,1717) * lu(k,2437) + lu(k,2447) = lu(k,2447) - lu(k,1718) * lu(k,2437) + lu(k,2448) = lu(k,2448) - lu(k,1719) * lu(k,2437) + lu(k,2449) = lu(k,2449) - lu(k,1720) * lu(k,2437) + lu(k,2450) = lu(k,2450) - lu(k,1721) * lu(k,2437) + lu(k,2483) = lu(k,2483) - lu(k,1709) * lu(k,2482) + lu(k,2484) = lu(k,2484) - lu(k,1710) * lu(k,2482) + lu(k,2485) = lu(k,2485) - lu(k,1711) * lu(k,2482) + lu(k,2486) = lu(k,2486) - lu(k,1712) * lu(k,2482) + lu(k,2487) = lu(k,2487) - lu(k,1713) * lu(k,2482) + lu(k,2488) = lu(k,2488) - lu(k,1714) * lu(k,2482) + lu(k,2489) = lu(k,2489) - lu(k,1715) * lu(k,2482) + lu(k,2490) = lu(k,2490) - lu(k,1716) * lu(k,2482) + lu(k,2491) = lu(k,2491) - lu(k,1717) * lu(k,2482) + lu(k,2492) = lu(k,2492) - lu(k,1718) * lu(k,2482) + lu(k,2493) = lu(k,2493) - lu(k,1719) * lu(k,2482) + lu(k,2494) = lu(k,2494) - lu(k,1720) * lu(k,2482) + lu(k,2495) = lu(k,2495) - lu(k,1721) * lu(k,2482) + lu(k,2510) = lu(k,2510) - lu(k,1709) * lu(k,2509) + lu(k,2511) = lu(k,2511) - lu(k,1710) * lu(k,2509) + lu(k,2512) = lu(k,2512) - lu(k,1711) * lu(k,2509) + lu(k,2513) = lu(k,2513) - lu(k,1712) * lu(k,2509) + lu(k,2514) = lu(k,2514) - lu(k,1713) * lu(k,2509) + lu(k,2515) = lu(k,2515) - lu(k,1714) * lu(k,2509) + lu(k,2516) = lu(k,2516) - lu(k,1715) * lu(k,2509) + lu(k,2517) = lu(k,2517) - lu(k,1716) * lu(k,2509) + lu(k,2518) = lu(k,2518) - lu(k,1717) * lu(k,2509) + lu(k,2519) = lu(k,2519) - lu(k,1718) * lu(k,2509) + lu(k,2520) = lu(k,2520) - lu(k,1719) * lu(k,2509) + lu(k,2521) = lu(k,2521) - lu(k,1720) * lu(k,2509) + lu(k,2522) = lu(k,2522) - lu(k,1721) * lu(k,2509) + lu(k,1730) = 1._r8 / lu(k,1730) + lu(k,1731) = lu(k,1731) * lu(k,1730) + lu(k,1732) = lu(k,1732) * lu(k,1730) + lu(k,1733) = lu(k,1733) * lu(k,1730) + lu(k,1734) = lu(k,1734) * lu(k,1730) + lu(k,1735) = lu(k,1735) * lu(k,1730) + lu(k,1736) = lu(k,1736) * lu(k,1730) + lu(k,1737) = lu(k,1737) * lu(k,1730) + lu(k,1738) = lu(k,1738) * lu(k,1730) + lu(k,1739) = lu(k,1739) * lu(k,1730) + lu(k,1740) = lu(k,1740) * lu(k,1730) + lu(k,1741) = lu(k,1741) * lu(k,1730) + lu(k,1742) = lu(k,1742) * lu(k,1730) + lu(k,1904) = lu(k,1904) - lu(k,1731) * lu(k,1903) + lu(k,1905) = lu(k,1905) - lu(k,1732) * lu(k,1903) + lu(k,1906) = lu(k,1906) - lu(k,1733) * lu(k,1903) + lu(k,1907) = lu(k,1907) - lu(k,1734) * lu(k,1903) + lu(k,1908) = lu(k,1908) - lu(k,1735) * lu(k,1903) + lu(k,1909) = lu(k,1909) - lu(k,1736) * lu(k,1903) + lu(k,1910) = lu(k,1910) - lu(k,1737) * lu(k,1903) + lu(k,1911) = lu(k,1911) - lu(k,1738) * lu(k,1903) + lu(k,1912) = lu(k,1912) - lu(k,1739) * lu(k,1903) + lu(k,1913) = lu(k,1913) - lu(k,1740) * lu(k,1903) + lu(k,1914) = lu(k,1914) - lu(k,1741) * lu(k,1903) + lu(k,1915) = lu(k,1915) - lu(k,1742) * lu(k,1903) + lu(k,1947) = lu(k,1947) - lu(k,1731) * lu(k,1946) + lu(k,1948) = lu(k,1948) - lu(k,1732) * lu(k,1946) + lu(k,1949) = lu(k,1949) - lu(k,1733) * lu(k,1946) + lu(k,1950) = lu(k,1950) - lu(k,1734) * lu(k,1946) + lu(k,1951) = lu(k,1951) - lu(k,1735) * lu(k,1946) + lu(k,1952) = lu(k,1952) - lu(k,1736) * lu(k,1946) + lu(k,1953) = lu(k,1953) - lu(k,1737) * lu(k,1946) + lu(k,1954) = lu(k,1954) - lu(k,1738) * lu(k,1946) + lu(k,1955) = lu(k,1955) - lu(k,1739) * lu(k,1946) + lu(k,1956) = lu(k,1956) - lu(k,1740) * lu(k,1946) + lu(k,1957) = lu(k,1957) - lu(k,1741) * lu(k,1946) + lu(k,1958) = lu(k,1958) - lu(k,1742) * lu(k,1946) + lu(k,1993) = lu(k,1993) - lu(k,1731) * lu(k,1992) + lu(k,1994) = lu(k,1994) - lu(k,1732) * lu(k,1992) + lu(k,1995) = lu(k,1995) - lu(k,1733) * lu(k,1992) + lu(k,1996) = lu(k,1996) - lu(k,1734) * lu(k,1992) + lu(k,1997) = lu(k,1997) - lu(k,1735) * lu(k,1992) + lu(k,1998) = lu(k,1998) - lu(k,1736) * lu(k,1992) + lu(k,1999) = lu(k,1999) - lu(k,1737) * lu(k,1992) + lu(k,2000) = lu(k,2000) - lu(k,1738) * lu(k,1992) + lu(k,2001) = lu(k,2001) - lu(k,1739) * lu(k,1992) + lu(k,2002) = lu(k,2002) - lu(k,1740) * lu(k,1992) + lu(k,2003) = lu(k,2003) - lu(k,1741) * lu(k,1992) + lu(k,2004) = lu(k,2004) - lu(k,1742) * lu(k,1992) + lu(k,2036) = lu(k,2036) - lu(k,1731) * lu(k,2035) + lu(k,2037) = lu(k,2037) - lu(k,1732) * lu(k,2035) + lu(k,2038) = lu(k,2038) - lu(k,1733) * lu(k,2035) + lu(k,2039) = lu(k,2039) - lu(k,1734) * lu(k,2035) + lu(k,2040) = lu(k,2040) - lu(k,1735) * lu(k,2035) + lu(k,2041) = lu(k,2041) - lu(k,1736) * lu(k,2035) + lu(k,2042) = lu(k,2042) - lu(k,1737) * lu(k,2035) + lu(k,2043) = lu(k,2043) - lu(k,1738) * lu(k,2035) + lu(k,2044) = lu(k,2044) - lu(k,1739) * lu(k,2035) + lu(k,2045) = lu(k,2045) - lu(k,1740) * lu(k,2035) + lu(k,2046) = lu(k,2046) - lu(k,1741) * lu(k,2035) + lu(k,2047) = lu(k,2047) - lu(k,1742) * lu(k,2035) + lu(k,2100) = lu(k,2100) - lu(k,1731) * lu(k,2099) + lu(k,2101) = lu(k,2101) - lu(k,1732) * lu(k,2099) + lu(k,2102) = lu(k,2102) - lu(k,1733) * lu(k,2099) + lu(k,2103) = lu(k,2103) - lu(k,1734) * lu(k,2099) + lu(k,2104) = lu(k,2104) - lu(k,1735) * lu(k,2099) + lu(k,2105) = lu(k,2105) - lu(k,1736) * lu(k,2099) + lu(k,2106) = lu(k,2106) - lu(k,1737) * lu(k,2099) + lu(k,2107) = lu(k,2107) - lu(k,1738) * lu(k,2099) + lu(k,2108) = lu(k,2108) - lu(k,1739) * lu(k,2099) + lu(k,2109) = lu(k,2109) - lu(k,1740) * lu(k,2099) + lu(k,2110) = lu(k,2110) - lu(k,1741) * lu(k,2099) + lu(k,2111) = lu(k,2111) - lu(k,1742) * lu(k,2099) + lu(k,2127) = lu(k,2127) - lu(k,1731) * lu(k,2126) + lu(k,2128) = lu(k,2128) - lu(k,1732) * lu(k,2126) + lu(k,2129) = lu(k,2129) - lu(k,1733) * lu(k,2126) + lu(k,2130) = lu(k,2130) - lu(k,1734) * lu(k,2126) + lu(k,2131) = lu(k,2131) - lu(k,1735) * lu(k,2126) + lu(k,2132) = lu(k,2132) - lu(k,1736) * lu(k,2126) + lu(k,2133) = lu(k,2133) - lu(k,1737) * lu(k,2126) + lu(k,2134) = lu(k,2134) - lu(k,1738) * lu(k,2126) + lu(k,2135) = lu(k,2135) - lu(k,1739) * lu(k,2126) + lu(k,2136) = lu(k,2136) - lu(k,1740) * lu(k,2126) + lu(k,2137) = lu(k,2137) - lu(k,1741) * lu(k,2126) + lu(k,2138) = lu(k,2138) - lu(k,1742) * lu(k,2126) + lu(k,2233) = lu(k,2233) - lu(k,1731) * lu(k,2232) + lu(k,2234) = lu(k,2234) - lu(k,1732) * lu(k,2232) + lu(k,2235) = lu(k,2235) - lu(k,1733) * lu(k,2232) + lu(k,2236) = lu(k,2236) - lu(k,1734) * lu(k,2232) + lu(k,2237) = lu(k,2237) - lu(k,1735) * lu(k,2232) + lu(k,2238) = lu(k,2238) - lu(k,1736) * lu(k,2232) + lu(k,2239) = lu(k,2239) - lu(k,1737) * lu(k,2232) + lu(k,2240) = lu(k,2240) - lu(k,1738) * lu(k,2232) + lu(k,2241) = lu(k,2241) - lu(k,1739) * lu(k,2232) + lu(k,2242) = lu(k,2242) - lu(k,1740) * lu(k,2232) + lu(k,2243) = lu(k,2243) - lu(k,1741) * lu(k,2232) + lu(k,2244) = lu(k,2244) - lu(k,1742) * lu(k,2232) + lu(k,2293) = lu(k,2293) - lu(k,1731) * lu(k,2292) + lu(k,2294) = lu(k,2294) - lu(k,1732) * lu(k,2292) + lu(k,2295) = lu(k,2295) - lu(k,1733) * lu(k,2292) + lu(k,2296) = lu(k,2296) - lu(k,1734) * lu(k,2292) + lu(k,2297) = lu(k,2297) - lu(k,1735) * lu(k,2292) + lu(k,2298) = lu(k,2298) - lu(k,1736) * lu(k,2292) + lu(k,2299) = lu(k,2299) - lu(k,1737) * lu(k,2292) + lu(k,2300) = lu(k,2300) - lu(k,1738) * lu(k,2292) + lu(k,2301) = lu(k,2301) - lu(k,1739) * lu(k,2292) + lu(k,2302) = lu(k,2302) - lu(k,1740) * lu(k,2292) + lu(k,2303) = lu(k,2303) - lu(k,1741) * lu(k,2292) + lu(k,2304) = lu(k,2304) - lu(k,1742) * lu(k,2292) + lu(k,2413) = lu(k,2413) - lu(k,1731) * lu(k,2412) + lu(k,2414) = lu(k,2414) - lu(k,1732) * lu(k,2412) + lu(k,2415) = lu(k,2415) - lu(k,1733) * lu(k,2412) + lu(k,2416) = lu(k,2416) - lu(k,1734) * lu(k,2412) + lu(k,2417) = lu(k,2417) - lu(k,1735) * lu(k,2412) + lu(k,2418) = lu(k,2418) - lu(k,1736) * lu(k,2412) + lu(k,2419) = lu(k,2419) - lu(k,1737) * lu(k,2412) + lu(k,2420) = lu(k,2420) - lu(k,1738) * lu(k,2412) + lu(k,2421) = lu(k,2421) - lu(k,1739) * lu(k,2412) + lu(k,2422) = lu(k,2422) - lu(k,1740) * lu(k,2412) + lu(k,2423) = lu(k,2423) - lu(k,1741) * lu(k,2412) + lu(k,2424) = lu(k,2424) - lu(k,1742) * lu(k,2412) + lu(k,2439) = lu(k,2439) - lu(k,1731) * lu(k,2438) + lu(k,2440) = lu(k,2440) - lu(k,1732) * lu(k,2438) + lu(k,2441) = lu(k,2441) - lu(k,1733) * lu(k,2438) + lu(k,2442) = lu(k,2442) - lu(k,1734) * lu(k,2438) + lu(k,2443) = lu(k,2443) - lu(k,1735) * lu(k,2438) + lu(k,2444) = lu(k,2444) - lu(k,1736) * lu(k,2438) + lu(k,2445) = lu(k,2445) - lu(k,1737) * lu(k,2438) + lu(k,2446) = lu(k,2446) - lu(k,1738) * lu(k,2438) + lu(k,2447) = lu(k,2447) - lu(k,1739) * lu(k,2438) + lu(k,2448) = lu(k,2448) - lu(k,1740) * lu(k,2438) + lu(k,2449) = lu(k,2449) - lu(k,1741) * lu(k,2438) + lu(k,2450) = lu(k,2450) - lu(k,1742) * lu(k,2438) + lu(k,2484) = lu(k,2484) - lu(k,1731) * lu(k,2483) + lu(k,2485) = lu(k,2485) - lu(k,1732) * lu(k,2483) + lu(k,2486) = lu(k,2486) - lu(k,1733) * lu(k,2483) + lu(k,2487) = lu(k,2487) - lu(k,1734) * lu(k,2483) + lu(k,2488) = lu(k,2488) - lu(k,1735) * lu(k,2483) + lu(k,2489) = lu(k,2489) - lu(k,1736) * lu(k,2483) + lu(k,2490) = lu(k,2490) - lu(k,1737) * lu(k,2483) + lu(k,2491) = lu(k,2491) - lu(k,1738) * lu(k,2483) + lu(k,2492) = lu(k,2492) - lu(k,1739) * lu(k,2483) + lu(k,2493) = lu(k,2493) - lu(k,1740) * lu(k,2483) + lu(k,2494) = lu(k,2494) - lu(k,1741) * lu(k,2483) + lu(k,2495) = lu(k,2495) - lu(k,1742) * lu(k,2483) + lu(k,2511) = lu(k,2511) - lu(k,1731) * lu(k,2510) + lu(k,2512) = lu(k,2512) - lu(k,1732) * lu(k,2510) + lu(k,2513) = lu(k,2513) - lu(k,1733) * lu(k,2510) + lu(k,2514) = lu(k,2514) - lu(k,1734) * lu(k,2510) + lu(k,2515) = lu(k,2515) - lu(k,1735) * lu(k,2510) + lu(k,2516) = lu(k,2516) - lu(k,1736) * lu(k,2510) + lu(k,2517) = lu(k,2517) - lu(k,1737) * lu(k,2510) + lu(k,2518) = lu(k,2518) - lu(k,1738) * lu(k,2510) + lu(k,2519) = lu(k,2519) - lu(k,1739) * lu(k,2510) + lu(k,2520) = lu(k,2520) - lu(k,1740) * lu(k,2510) + lu(k,2521) = lu(k,2521) - lu(k,1741) * lu(k,2510) + lu(k,2522) = lu(k,2522) - lu(k,1742) * lu(k,2510) + end do + end subroutine lu_fac32 + subroutine lu_fac33( 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,1904) = 1._r8 / lu(k,1904) + lu(k,1905) = lu(k,1905) * lu(k,1904) + lu(k,1906) = lu(k,1906) * lu(k,1904) + lu(k,1907) = lu(k,1907) * lu(k,1904) + lu(k,1908) = lu(k,1908) * lu(k,1904) + lu(k,1909) = lu(k,1909) * lu(k,1904) + lu(k,1910) = lu(k,1910) * lu(k,1904) + lu(k,1911) = lu(k,1911) * lu(k,1904) + lu(k,1912) = lu(k,1912) * lu(k,1904) + lu(k,1913) = lu(k,1913) * lu(k,1904) + lu(k,1914) = lu(k,1914) * lu(k,1904) + lu(k,1915) = lu(k,1915) * lu(k,1904) + lu(k,1948) = lu(k,1948) - lu(k,1905) * lu(k,1947) + lu(k,1949) = lu(k,1949) - lu(k,1906) * lu(k,1947) + lu(k,1950) = lu(k,1950) - lu(k,1907) * lu(k,1947) + lu(k,1951) = lu(k,1951) - lu(k,1908) * lu(k,1947) + lu(k,1952) = lu(k,1952) - lu(k,1909) * lu(k,1947) + lu(k,1953) = lu(k,1953) - lu(k,1910) * lu(k,1947) + lu(k,1954) = lu(k,1954) - lu(k,1911) * lu(k,1947) + lu(k,1955) = lu(k,1955) - lu(k,1912) * lu(k,1947) + lu(k,1956) = lu(k,1956) - lu(k,1913) * lu(k,1947) + lu(k,1957) = lu(k,1957) - lu(k,1914) * lu(k,1947) + lu(k,1958) = lu(k,1958) - lu(k,1915) * lu(k,1947) + lu(k,1994) = lu(k,1994) - lu(k,1905) * lu(k,1993) + lu(k,1995) = lu(k,1995) - lu(k,1906) * lu(k,1993) + lu(k,1996) = lu(k,1996) - lu(k,1907) * lu(k,1993) + lu(k,1997) = lu(k,1997) - lu(k,1908) * lu(k,1993) + lu(k,1998) = lu(k,1998) - lu(k,1909) * lu(k,1993) + lu(k,1999) = lu(k,1999) - lu(k,1910) * lu(k,1993) + lu(k,2000) = lu(k,2000) - lu(k,1911) * lu(k,1993) + lu(k,2001) = lu(k,2001) - lu(k,1912) * lu(k,1993) + lu(k,2002) = lu(k,2002) - lu(k,1913) * lu(k,1993) + lu(k,2003) = lu(k,2003) - lu(k,1914) * lu(k,1993) + lu(k,2004) = lu(k,2004) - lu(k,1915) * lu(k,1993) + lu(k,2037) = lu(k,2037) - lu(k,1905) * lu(k,2036) + lu(k,2038) = lu(k,2038) - lu(k,1906) * lu(k,2036) + lu(k,2039) = lu(k,2039) - lu(k,1907) * lu(k,2036) + lu(k,2040) = lu(k,2040) - lu(k,1908) * lu(k,2036) + lu(k,2041) = lu(k,2041) - lu(k,1909) * lu(k,2036) + lu(k,2042) = lu(k,2042) - lu(k,1910) * lu(k,2036) + lu(k,2043) = lu(k,2043) - lu(k,1911) * lu(k,2036) + lu(k,2044) = lu(k,2044) - lu(k,1912) * lu(k,2036) + lu(k,2045) = lu(k,2045) - lu(k,1913) * lu(k,2036) + lu(k,2046) = lu(k,2046) - lu(k,1914) * lu(k,2036) + lu(k,2047) = lu(k,2047) - lu(k,1915) * lu(k,2036) + lu(k,2101) = lu(k,2101) - lu(k,1905) * lu(k,2100) + lu(k,2102) = lu(k,2102) - lu(k,1906) * lu(k,2100) + lu(k,2103) = lu(k,2103) - lu(k,1907) * lu(k,2100) + lu(k,2104) = lu(k,2104) - lu(k,1908) * lu(k,2100) + lu(k,2105) = lu(k,2105) - lu(k,1909) * lu(k,2100) + lu(k,2106) = lu(k,2106) - lu(k,1910) * lu(k,2100) + lu(k,2107) = lu(k,2107) - lu(k,1911) * lu(k,2100) + lu(k,2108) = lu(k,2108) - lu(k,1912) * lu(k,2100) + lu(k,2109) = lu(k,2109) - lu(k,1913) * lu(k,2100) + lu(k,2110) = lu(k,2110) - lu(k,1914) * lu(k,2100) + lu(k,2111) = lu(k,2111) - lu(k,1915) * lu(k,2100) + lu(k,2128) = lu(k,2128) - lu(k,1905) * lu(k,2127) + lu(k,2129) = lu(k,2129) - lu(k,1906) * lu(k,2127) + lu(k,2130) = lu(k,2130) - lu(k,1907) * lu(k,2127) + lu(k,2131) = lu(k,2131) - lu(k,1908) * lu(k,2127) + lu(k,2132) = lu(k,2132) - lu(k,1909) * lu(k,2127) + lu(k,2133) = lu(k,2133) - lu(k,1910) * lu(k,2127) + lu(k,2134) = lu(k,2134) - lu(k,1911) * lu(k,2127) + lu(k,2135) = lu(k,2135) - lu(k,1912) * lu(k,2127) + lu(k,2136) = lu(k,2136) - lu(k,1913) * lu(k,2127) + lu(k,2137) = lu(k,2137) - lu(k,1914) * lu(k,2127) + lu(k,2138) = lu(k,2138) - lu(k,1915) * lu(k,2127) + lu(k,2234) = lu(k,2234) - lu(k,1905) * lu(k,2233) + lu(k,2235) = lu(k,2235) - lu(k,1906) * lu(k,2233) + lu(k,2236) = lu(k,2236) - lu(k,1907) * lu(k,2233) + lu(k,2237) = lu(k,2237) - lu(k,1908) * lu(k,2233) + lu(k,2238) = lu(k,2238) - lu(k,1909) * lu(k,2233) + lu(k,2239) = lu(k,2239) - lu(k,1910) * lu(k,2233) + lu(k,2240) = lu(k,2240) - lu(k,1911) * lu(k,2233) + lu(k,2241) = lu(k,2241) - lu(k,1912) * lu(k,2233) + lu(k,2242) = lu(k,2242) - lu(k,1913) * lu(k,2233) + lu(k,2243) = lu(k,2243) - lu(k,1914) * lu(k,2233) + lu(k,2244) = lu(k,2244) - lu(k,1915) * lu(k,2233) + lu(k,2294) = lu(k,2294) - lu(k,1905) * lu(k,2293) + lu(k,2295) = lu(k,2295) - lu(k,1906) * lu(k,2293) + lu(k,2296) = lu(k,2296) - lu(k,1907) * lu(k,2293) + lu(k,2297) = lu(k,2297) - lu(k,1908) * lu(k,2293) + lu(k,2298) = lu(k,2298) - lu(k,1909) * lu(k,2293) + lu(k,2299) = lu(k,2299) - lu(k,1910) * lu(k,2293) + lu(k,2300) = lu(k,2300) - lu(k,1911) * lu(k,2293) + lu(k,2301) = lu(k,2301) - lu(k,1912) * lu(k,2293) + lu(k,2302) = lu(k,2302) - lu(k,1913) * lu(k,2293) + lu(k,2303) = lu(k,2303) - lu(k,1914) * lu(k,2293) + lu(k,2304) = lu(k,2304) - lu(k,1915) * lu(k,2293) + lu(k,2414) = lu(k,2414) - lu(k,1905) * lu(k,2413) + lu(k,2415) = lu(k,2415) - lu(k,1906) * lu(k,2413) + lu(k,2416) = lu(k,2416) - lu(k,1907) * lu(k,2413) + lu(k,2417) = lu(k,2417) - lu(k,1908) * lu(k,2413) + lu(k,2418) = lu(k,2418) - lu(k,1909) * lu(k,2413) + lu(k,2419) = lu(k,2419) - lu(k,1910) * lu(k,2413) + lu(k,2420) = lu(k,2420) - lu(k,1911) * lu(k,2413) + lu(k,2421) = lu(k,2421) - lu(k,1912) * lu(k,2413) + lu(k,2422) = lu(k,2422) - lu(k,1913) * lu(k,2413) + lu(k,2423) = lu(k,2423) - lu(k,1914) * lu(k,2413) + lu(k,2424) = lu(k,2424) - lu(k,1915) * lu(k,2413) + lu(k,2440) = lu(k,2440) - lu(k,1905) * lu(k,2439) + lu(k,2441) = lu(k,2441) - lu(k,1906) * lu(k,2439) + lu(k,2442) = lu(k,2442) - lu(k,1907) * lu(k,2439) + lu(k,2443) = lu(k,2443) - lu(k,1908) * lu(k,2439) + lu(k,2444) = lu(k,2444) - lu(k,1909) * lu(k,2439) + lu(k,2445) = lu(k,2445) - lu(k,1910) * lu(k,2439) + lu(k,2446) = lu(k,2446) - lu(k,1911) * lu(k,2439) + lu(k,2447) = lu(k,2447) - lu(k,1912) * lu(k,2439) + lu(k,2448) = lu(k,2448) - lu(k,1913) * lu(k,2439) + lu(k,2449) = lu(k,2449) - lu(k,1914) * lu(k,2439) + lu(k,2450) = lu(k,2450) - lu(k,1915) * lu(k,2439) + lu(k,2485) = lu(k,2485) - lu(k,1905) * lu(k,2484) + lu(k,2486) = lu(k,2486) - lu(k,1906) * lu(k,2484) + lu(k,2487) = lu(k,2487) - lu(k,1907) * lu(k,2484) + lu(k,2488) = lu(k,2488) - lu(k,1908) * lu(k,2484) + lu(k,2489) = lu(k,2489) - lu(k,1909) * lu(k,2484) + lu(k,2490) = lu(k,2490) - lu(k,1910) * lu(k,2484) + lu(k,2491) = lu(k,2491) - lu(k,1911) * lu(k,2484) + lu(k,2492) = lu(k,2492) - lu(k,1912) * lu(k,2484) + lu(k,2493) = lu(k,2493) - lu(k,1913) * lu(k,2484) + lu(k,2494) = lu(k,2494) - lu(k,1914) * lu(k,2484) + lu(k,2495) = lu(k,2495) - lu(k,1915) * lu(k,2484) + lu(k,2512) = lu(k,2512) - lu(k,1905) * lu(k,2511) + lu(k,2513) = lu(k,2513) - lu(k,1906) * lu(k,2511) + lu(k,2514) = lu(k,2514) - lu(k,1907) * lu(k,2511) + lu(k,2515) = lu(k,2515) - lu(k,1908) * lu(k,2511) + lu(k,2516) = lu(k,2516) - lu(k,1909) * lu(k,2511) + lu(k,2517) = lu(k,2517) - lu(k,1910) * lu(k,2511) + lu(k,2518) = lu(k,2518) - lu(k,1911) * lu(k,2511) + lu(k,2519) = lu(k,2519) - lu(k,1912) * lu(k,2511) + lu(k,2520) = lu(k,2520) - lu(k,1913) * lu(k,2511) + lu(k,2521) = lu(k,2521) - lu(k,1914) * lu(k,2511) + lu(k,2522) = lu(k,2522) - lu(k,1915) * lu(k,2511) + lu(k,1948) = 1._r8 / lu(k,1948) + lu(k,1949) = lu(k,1949) * lu(k,1948) + lu(k,1950) = lu(k,1950) * lu(k,1948) + lu(k,1951) = lu(k,1951) * lu(k,1948) + lu(k,1952) = lu(k,1952) * lu(k,1948) + lu(k,1953) = lu(k,1953) * lu(k,1948) + lu(k,1954) = lu(k,1954) * lu(k,1948) + lu(k,1955) = lu(k,1955) * lu(k,1948) + lu(k,1956) = lu(k,1956) * lu(k,1948) + lu(k,1957) = lu(k,1957) * lu(k,1948) + lu(k,1958) = lu(k,1958) * lu(k,1948) + lu(k,1995) = lu(k,1995) - lu(k,1949) * lu(k,1994) + lu(k,1996) = lu(k,1996) - lu(k,1950) * lu(k,1994) + lu(k,1997) = lu(k,1997) - lu(k,1951) * lu(k,1994) + lu(k,1998) = lu(k,1998) - lu(k,1952) * lu(k,1994) + lu(k,1999) = lu(k,1999) - lu(k,1953) * lu(k,1994) + lu(k,2000) = lu(k,2000) - lu(k,1954) * lu(k,1994) + lu(k,2001) = lu(k,2001) - lu(k,1955) * lu(k,1994) + lu(k,2002) = lu(k,2002) - lu(k,1956) * lu(k,1994) + lu(k,2003) = lu(k,2003) - lu(k,1957) * lu(k,1994) + lu(k,2004) = lu(k,2004) - lu(k,1958) * lu(k,1994) + lu(k,2038) = lu(k,2038) - lu(k,1949) * lu(k,2037) + lu(k,2039) = lu(k,2039) - lu(k,1950) * lu(k,2037) + lu(k,2040) = lu(k,2040) - lu(k,1951) * lu(k,2037) + lu(k,2041) = lu(k,2041) - lu(k,1952) * lu(k,2037) + lu(k,2042) = lu(k,2042) - lu(k,1953) * lu(k,2037) + lu(k,2043) = lu(k,2043) - lu(k,1954) * lu(k,2037) + lu(k,2044) = lu(k,2044) - lu(k,1955) * lu(k,2037) + lu(k,2045) = lu(k,2045) - lu(k,1956) * lu(k,2037) + lu(k,2046) = lu(k,2046) - lu(k,1957) * lu(k,2037) + lu(k,2047) = lu(k,2047) - lu(k,1958) * lu(k,2037) + lu(k,2102) = lu(k,2102) - lu(k,1949) * lu(k,2101) + lu(k,2103) = lu(k,2103) - lu(k,1950) * lu(k,2101) + lu(k,2104) = lu(k,2104) - lu(k,1951) * lu(k,2101) + lu(k,2105) = lu(k,2105) - lu(k,1952) * lu(k,2101) + lu(k,2106) = lu(k,2106) - lu(k,1953) * lu(k,2101) + lu(k,2107) = lu(k,2107) - lu(k,1954) * lu(k,2101) + lu(k,2108) = lu(k,2108) - lu(k,1955) * lu(k,2101) + lu(k,2109) = lu(k,2109) - lu(k,1956) * lu(k,2101) + lu(k,2110) = lu(k,2110) - lu(k,1957) * lu(k,2101) + lu(k,2111) = lu(k,2111) - lu(k,1958) * lu(k,2101) + lu(k,2129) = lu(k,2129) - lu(k,1949) * lu(k,2128) + lu(k,2130) = lu(k,2130) - lu(k,1950) * lu(k,2128) + lu(k,2131) = lu(k,2131) - lu(k,1951) * lu(k,2128) + lu(k,2132) = lu(k,2132) - lu(k,1952) * lu(k,2128) + lu(k,2133) = lu(k,2133) - lu(k,1953) * lu(k,2128) + lu(k,2134) = lu(k,2134) - lu(k,1954) * lu(k,2128) + lu(k,2135) = lu(k,2135) - lu(k,1955) * lu(k,2128) + lu(k,2136) = lu(k,2136) - lu(k,1956) * lu(k,2128) + lu(k,2137) = lu(k,2137) - lu(k,1957) * lu(k,2128) + lu(k,2138) = lu(k,2138) - lu(k,1958) * lu(k,2128) + lu(k,2235) = lu(k,2235) - lu(k,1949) * lu(k,2234) + lu(k,2236) = lu(k,2236) - lu(k,1950) * lu(k,2234) + lu(k,2237) = lu(k,2237) - lu(k,1951) * lu(k,2234) + lu(k,2238) = lu(k,2238) - lu(k,1952) * lu(k,2234) + lu(k,2239) = lu(k,2239) - lu(k,1953) * lu(k,2234) + lu(k,2240) = lu(k,2240) - lu(k,1954) * lu(k,2234) + lu(k,2241) = lu(k,2241) - lu(k,1955) * lu(k,2234) + lu(k,2242) = lu(k,2242) - lu(k,1956) * lu(k,2234) + lu(k,2243) = lu(k,2243) - lu(k,1957) * lu(k,2234) + lu(k,2244) = lu(k,2244) - lu(k,1958) * lu(k,2234) + lu(k,2295) = lu(k,2295) - lu(k,1949) * lu(k,2294) + lu(k,2296) = lu(k,2296) - lu(k,1950) * lu(k,2294) + lu(k,2297) = lu(k,2297) - lu(k,1951) * lu(k,2294) + lu(k,2298) = lu(k,2298) - lu(k,1952) * lu(k,2294) + lu(k,2299) = lu(k,2299) - lu(k,1953) * lu(k,2294) + lu(k,2300) = lu(k,2300) - lu(k,1954) * lu(k,2294) + lu(k,2301) = lu(k,2301) - lu(k,1955) * lu(k,2294) + lu(k,2302) = lu(k,2302) - lu(k,1956) * lu(k,2294) + lu(k,2303) = lu(k,2303) - lu(k,1957) * lu(k,2294) + lu(k,2304) = lu(k,2304) - lu(k,1958) * lu(k,2294) + lu(k,2415) = lu(k,2415) - lu(k,1949) * lu(k,2414) + lu(k,2416) = lu(k,2416) - lu(k,1950) * lu(k,2414) + lu(k,2417) = lu(k,2417) - lu(k,1951) * lu(k,2414) + lu(k,2418) = lu(k,2418) - lu(k,1952) * lu(k,2414) + lu(k,2419) = lu(k,2419) - lu(k,1953) * lu(k,2414) + lu(k,2420) = lu(k,2420) - lu(k,1954) * lu(k,2414) + lu(k,2421) = lu(k,2421) - lu(k,1955) * lu(k,2414) + lu(k,2422) = lu(k,2422) - lu(k,1956) * lu(k,2414) + lu(k,2423) = lu(k,2423) - lu(k,1957) * lu(k,2414) + lu(k,2424) = lu(k,2424) - lu(k,1958) * lu(k,2414) + lu(k,2441) = lu(k,2441) - lu(k,1949) * lu(k,2440) + lu(k,2442) = lu(k,2442) - lu(k,1950) * lu(k,2440) + lu(k,2443) = lu(k,2443) - lu(k,1951) * lu(k,2440) + lu(k,2444) = lu(k,2444) - lu(k,1952) * lu(k,2440) + lu(k,2445) = lu(k,2445) - lu(k,1953) * lu(k,2440) + lu(k,2446) = lu(k,2446) - lu(k,1954) * lu(k,2440) + lu(k,2447) = lu(k,2447) - lu(k,1955) * lu(k,2440) + lu(k,2448) = lu(k,2448) - lu(k,1956) * lu(k,2440) + lu(k,2449) = lu(k,2449) - lu(k,1957) * lu(k,2440) + lu(k,2450) = lu(k,2450) - lu(k,1958) * lu(k,2440) + lu(k,2486) = lu(k,2486) - lu(k,1949) * lu(k,2485) + lu(k,2487) = lu(k,2487) - lu(k,1950) * lu(k,2485) + lu(k,2488) = lu(k,2488) - lu(k,1951) * lu(k,2485) + lu(k,2489) = lu(k,2489) - lu(k,1952) * lu(k,2485) + lu(k,2490) = lu(k,2490) - lu(k,1953) * lu(k,2485) + lu(k,2491) = lu(k,2491) - lu(k,1954) * lu(k,2485) + lu(k,2492) = lu(k,2492) - lu(k,1955) * lu(k,2485) + lu(k,2493) = lu(k,2493) - lu(k,1956) * lu(k,2485) + lu(k,2494) = lu(k,2494) - lu(k,1957) * lu(k,2485) + lu(k,2495) = lu(k,2495) - lu(k,1958) * lu(k,2485) + lu(k,2513) = lu(k,2513) - lu(k,1949) * lu(k,2512) + lu(k,2514) = lu(k,2514) - lu(k,1950) * lu(k,2512) + lu(k,2515) = lu(k,2515) - lu(k,1951) * lu(k,2512) + lu(k,2516) = lu(k,2516) - lu(k,1952) * lu(k,2512) + lu(k,2517) = lu(k,2517) - lu(k,1953) * lu(k,2512) + lu(k,2518) = lu(k,2518) - lu(k,1954) * lu(k,2512) + lu(k,2519) = lu(k,2519) - lu(k,1955) * lu(k,2512) + lu(k,2520) = lu(k,2520) - lu(k,1956) * lu(k,2512) + lu(k,2521) = lu(k,2521) - lu(k,1957) * lu(k,2512) + lu(k,2522) = lu(k,2522) - lu(k,1958) * lu(k,2512) + lu(k,1995) = 1._r8 / lu(k,1995) + lu(k,1996) = lu(k,1996) * lu(k,1995) + lu(k,1997) = lu(k,1997) * lu(k,1995) + lu(k,1998) = lu(k,1998) * lu(k,1995) + lu(k,1999) = lu(k,1999) * lu(k,1995) + lu(k,2000) = lu(k,2000) * lu(k,1995) + lu(k,2001) = lu(k,2001) * lu(k,1995) + lu(k,2002) = lu(k,2002) * lu(k,1995) + lu(k,2003) = lu(k,2003) * lu(k,1995) + lu(k,2004) = lu(k,2004) * lu(k,1995) + lu(k,2039) = lu(k,2039) - lu(k,1996) * lu(k,2038) + lu(k,2040) = lu(k,2040) - lu(k,1997) * lu(k,2038) + lu(k,2041) = lu(k,2041) - lu(k,1998) * lu(k,2038) + lu(k,2042) = lu(k,2042) - lu(k,1999) * lu(k,2038) + lu(k,2043) = lu(k,2043) - lu(k,2000) * lu(k,2038) + lu(k,2044) = lu(k,2044) - lu(k,2001) * lu(k,2038) + lu(k,2045) = lu(k,2045) - lu(k,2002) * lu(k,2038) + lu(k,2046) = lu(k,2046) - lu(k,2003) * lu(k,2038) + lu(k,2047) = lu(k,2047) - lu(k,2004) * lu(k,2038) + lu(k,2103) = lu(k,2103) - lu(k,1996) * lu(k,2102) + lu(k,2104) = lu(k,2104) - lu(k,1997) * lu(k,2102) + lu(k,2105) = lu(k,2105) - lu(k,1998) * lu(k,2102) + lu(k,2106) = lu(k,2106) - lu(k,1999) * lu(k,2102) + lu(k,2107) = lu(k,2107) - lu(k,2000) * lu(k,2102) + lu(k,2108) = lu(k,2108) - lu(k,2001) * lu(k,2102) + lu(k,2109) = lu(k,2109) - lu(k,2002) * lu(k,2102) + lu(k,2110) = lu(k,2110) - lu(k,2003) * lu(k,2102) + lu(k,2111) = lu(k,2111) - lu(k,2004) * lu(k,2102) + lu(k,2130) = lu(k,2130) - lu(k,1996) * lu(k,2129) + lu(k,2131) = lu(k,2131) - lu(k,1997) * lu(k,2129) + lu(k,2132) = lu(k,2132) - lu(k,1998) * lu(k,2129) + lu(k,2133) = lu(k,2133) - lu(k,1999) * lu(k,2129) + lu(k,2134) = lu(k,2134) - lu(k,2000) * lu(k,2129) + lu(k,2135) = lu(k,2135) - lu(k,2001) * lu(k,2129) + lu(k,2136) = lu(k,2136) - lu(k,2002) * lu(k,2129) + lu(k,2137) = lu(k,2137) - lu(k,2003) * lu(k,2129) + lu(k,2138) = lu(k,2138) - lu(k,2004) * lu(k,2129) + lu(k,2236) = lu(k,2236) - lu(k,1996) * lu(k,2235) + lu(k,2237) = lu(k,2237) - lu(k,1997) * lu(k,2235) + lu(k,2238) = lu(k,2238) - lu(k,1998) * lu(k,2235) + lu(k,2239) = lu(k,2239) - lu(k,1999) * lu(k,2235) + lu(k,2240) = lu(k,2240) - lu(k,2000) * lu(k,2235) + lu(k,2241) = lu(k,2241) - lu(k,2001) * lu(k,2235) + lu(k,2242) = lu(k,2242) - lu(k,2002) * lu(k,2235) + lu(k,2243) = lu(k,2243) - lu(k,2003) * lu(k,2235) + lu(k,2244) = lu(k,2244) - lu(k,2004) * lu(k,2235) + lu(k,2296) = lu(k,2296) - lu(k,1996) * lu(k,2295) + lu(k,2297) = lu(k,2297) - lu(k,1997) * lu(k,2295) + lu(k,2298) = lu(k,2298) - lu(k,1998) * lu(k,2295) + lu(k,2299) = lu(k,2299) - lu(k,1999) * lu(k,2295) + lu(k,2300) = lu(k,2300) - lu(k,2000) * lu(k,2295) + lu(k,2301) = lu(k,2301) - lu(k,2001) * lu(k,2295) + lu(k,2302) = lu(k,2302) - lu(k,2002) * lu(k,2295) + lu(k,2303) = lu(k,2303) - lu(k,2003) * lu(k,2295) + lu(k,2304) = lu(k,2304) - lu(k,2004) * lu(k,2295) + lu(k,2416) = lu(k,2416) - lu(k,1996) * lu(k,2415) + lu(k,2417) = lu(k,2417) - lu(k,1997) * lu(k,2415) + lu(k,2418) = lu(k,2418) - lu(k,1998) * lu(k,2415) + lu(k,2419) = lu(k,2419) - lu(k,1999) * lu(k,2415) + lu(k,2420) = lu(k,2420) - lu(k,2000) * lu(k,2415) + lu(k,2421) = lu(k,2421) - lu(k,2001) * lu(k,2415) + lu(k,2422) = lu(k,2422) - lu(k,2002) * lu(k,2415) + lu(k,2423) = lu(k,2423) - lu(k,2003) * lu(k,2415) + lu(k,2424) = lu(k,2424) - lu(k,2004) * lu(k,2415) + lu(k,2442) = lu(k,2442) - lu(k,1996) * lu(k,2441) + lu(k,2443) = lu(k,2443) - lu(k,1997) * lu(k,2441) + lu(k,2444) = lu(k,2444) - lu(k,1998) * lu(k,2441) + lu(k,2445) = lu(k,2445) - lu(k,1999) * lu(k,2441) + lu(k,2446) = lu(k,2446) - lu(k,2000) * lu(k,2441) + lu(k,2447) = lu(k,2447) - lu(k,2001) * lu(k,2441) + lu(k,2448) = lu(k,2448) - lu(k,2002) * lu(k,2441) + lu(k,2449) = lu(k,2449) - lu(k,2003) * lu(k,2441) + lu(k,2450) = lu(k,2450) - lu(k,2004) * lu(k,2441) + lu(k,2487) = lu(k,2487) - lu(k,1996) * lu(k,2486) + lu(k,2488) = lu(k,2488) - lu(k,1997) * lu(k,2486) + lu(k,2489) = lu(k,2489) - lu(k,1998) * lu(k,2486) + lu(k,2490) = lu(k,2490) - lu(k,1999) * lu(k,2486) + lu(k,2491) = lu(k,2491) - lu(k,2000) * lu(k,2486) + lu(k,2492) = lu(k,2492) - lu(k,2001) * lu(k,2486) + lu(k,2493) = lu(k,2493) - lu(k,2002) * lu(k,2486) + lu(k,2494) = lu(k,2494) - lu(k,2003) * lu(k,2486) + lu(k,2495) = lu(k,2495) - lu(k,2004) * lu(k,2486) + lu(k,2514) = lu(k,2514) - lu(k,1996) * lu(k,2513) + lu(k,2515) = lu(k,2515) - lu(k,1997) * lu(k,2513) + lu(k,2516) = lu(k,2516) - lu(k,1998) * lu(k,2513) + lu(k,2517) = lu(k,2517) - lu(k,1999) * lu(k,2513) + lu(k,2518) = lu(k,2518) - lu(k,2000) * lu(k,2513) + lu(k,2519) = lu(k,2519) - lu(k,2001) * lu(k,2513) + lu(k,2520) = lu(k,2520) - lu(k,2002) * lu(k,2513) + lu(k,2521) = lu(k,2521) - lu(k,2003) * lu(k,2513) + lu(k,2522) = lu(k,2522) - lu(k,2004) * lu(k,2513) + lu(k,2039) = 1._r8 / lu(k,2039) + lu(k,2040) = lu(k,2040) * lu(k,2039) + lu(k,2041) = lu(k,2041) * lu(k,2039) + lu(k,2042) = lu(k,2042) * lu(k,2039) + lu(k,2043) = lu(k,2043) * lu(k,2039) + lu(k,2044) = lu(k,2044) * lu(k,2039) + lu(k,2045) = lu(k,2045) * lu(k,2039) + lu(k,2046) = lu(k,2046) * lu(k,2039) + lu(k,2047) = lu(k,2047) * lu(k,2039) + lu(k,2104) = lu(k,2104) - lu(k,2040) * lu(k,2103) + lu(k,2105) = lu(k,2105) - lu(k,2041) * lu(k,2103) + lu(k,2106) = lu(k,2106) - lu(k,2042) * lu(k,2103) + lu(k,2107) = lu(k,2107) - lu(k,2043) * lu(k,2103) + lu(k,2108) = lu(k,2108) - lu(k,2044) * lu(k,2103) + lu(k,2109) = lu(k,2109) - lu(k,2045) * lu(k,2103) + lu(k,2110) = lu(k,2110) - lu(k,2046) * lu(k,2103) + lu(k,2111) = lu(k,2111) - lu(k,2047) * lu(k,2103) + lu(k,2131) = lu(k,2131) - lu(k,2040) * lu(k,2130) + lu(k,2132) = lu(k,2132) - lu(k,2041) * lu(k,2130) + lu(k,2133) = lu(k,2133) - lu(k,2042) * lu(k,2130) + lu(k,2134) = lu(k,2134) - lu(k,2043) * lu(k,2130) + lu(k,2135) = lu(k,2135) - lu(k,2044) * lu(k,2130) + lu(k,2136) = lu(k,2136) - lu(k,2045) * lu(k,2130) + lu(k,2137) = lu(k,2137) - lu(k,2046) * lu(k,2130) + lu(k,2138) = lu(k,2138) - lu(k,2047) * lu(k,2130) + lu(k,2237) = lu(k,2237) - lu(k,2040) * lu(k,2236) + lu(k,2238) = lu(k,2238) - lu(k,2041) * lu(k,2236) + lu(k,2239) = lu(k,2239) - lu(k,2042) * lu(k,2236) + lu(k,2240) = lu(k,2240) - lu(k,2043) * lu(k,2236) + lu(k,2241) = lu(k,2241) - lu(k,2044) * lu(k,2236) + lu(k,2242) = lu(k,2242) - lu(k,2045) * lu(k,2236) + lu(k,2243) = lu(k,2243) - lu(k,2046) * lu(k,2236) + lu(k,2244) = lu(k,2244) - lu(k,2047) * lu(k,2236) + lu(k,2297) = lu(k,2297) - lu(k,2040) * lu(k,2296) + lu(k,2298) = lu(k,2298) - lu(k,2041) * lu(k,2296) + lu(k,2299) = lu(k,2299) - lu(k,2042) * lu(k,2296) + lu(k,2300) = lu(k,2300) - lu(k,2043) * lu(k,2296) + lu(k,2301) = lu(k,2301) - lu(k,2044) * lu(k,2296) + lu(k,2302) = lu(k,2302) - lu(k,2045) * lu(k,2296) + lu(k,2303) = lu(k,2303) - lu(k,2046) * lu(k,2296) + lu(k,2304) = lu(k,2304) - lu(k,2047) * lu(k,2296) + lu(k,2417) = lu(k,2417) - lu(k,2040) * lu(k,2416) + lu(k,2418) = lu(k,2418) - lu(k,2041) * lu(k,2416) + lu(k,2419) = lu(k,2419) - lu(k,2042) * lu(k,2416) + lu(k,2420) = lu(k,2420) - lu(k,2043) * lu(k,2416) + lu(k,2421) = lu(k,2421) - lu(k,2044) * lu(k,2416) + lu(k,2422) = lu(k,2422) - lu(k,2045) * lu(k,2416) + lu(k,2423) = lu(k,2423) - lu(k,2046) * lu(k,2416) + lu(k,2424) = lu(k,2424) - lu(k,2047) * lu(k,2416) + lu(k,2443) = lu(k,2443) - lu(k,2040) * lu(k,2442) + lu(k,2444) = lu(k,2444) - lu(k,2041) * lu(k,2442) + lu(k,2445) = lu(k,2445) - lu(k,2042) * lu(k,2442) + lu(k,2446) = lu(k,2446) - lu(k,2043) * lu(k,2442) + lu(k,2447) = lu(k,2447) - lu(k,2044) * lu(k,2442) + lu(k,2448) = lu(k,2448) - lu(k,2045) * lu(k,2442) + lu(k,2449) = lu(k,2449) - lu(k,2046) * lu(k,2442) + lu(k,2450) = lu(k,2450) - lu(k,2047) * lu(k,2442) + lu(k,2488) = lu(k,2488) - lu(k,2040) * lu(k,2487) + lu(k,2489) = lu(k,2489) - lu(k,2041) * lu(k,2487) + lu(k,2490) = lu(k,2490) - lu(k,2042) * lu(k,2487) + lu(k,2491) = lu(k,2491) - lu(k,2043) * lu(k,2487) + lu(k,2492) = lu(k,2492) - lu(k,2044) * lu(k,2487) + lu(k,2493) = lu(k,2493) - lu(k,2045) * lu(k,2487) + lu(k,2494) = lu(k,2494) - lu(k,2046) * lu(k,2487) + lu(k,2495) = lu(k,2495) - lu(k,2047) * lu(k,2487) + lu(k,2515) = lu(k,2515) - lu(k,2040) * lu(k,2514) + lu(k,2516) = lu(k,2516) - lu(k,2041) * lu(k,2514) + lu(k,2517) = lu(k,2517) - lu(k,2042) * lu(k,2514) + lu(k,2518) = lu(k,2518) - lu(k,2043) * lu(k,2514) + lu(k,2519) = lu(k,2519) - lu(k,2044) * lu(k,2514) + lu(k,2520) = lu(k,2520) - lu(k,2045) * lu(k,2514) + lu(k,2521) = lu(k,2521) - lu(k,2046) * lu(k,2514) + lu(k,2522) = lu(k,2522) - lu(k,2047) * lu(k,2514) + lu(k,2104) = 1._r8 / lu(k,2104) + lu(k,2105) = lu(k,2105) * lu(k,2104) + lu(k,2106) = lu(k,2106) * lu(k,2104) + lu(k,2107) = lu(k,2107) * lu(k,2104) + lu(k,2108) = lu(k,2108) * lu(k,2104) + lu(k,2109) = lu(k,2109) * lu(k,2104) + lu(k,2110) = lu(k,2110) * lu(k,2104) + lu(k,2111) = lu(k,2111) * lu(k,2104) + lu(k,2132) = lu(k,2132) - lu(k,2105) * lu(k,2131) + lu(k,2133) = lu(k,2133) - lu(k,2106) * lu(k,2131) + lu(k,2134) = lu(k,2134) - lu(k,2107) * lu(k,2131) + lu(k,2135) = lu(k,2135) - lu(k,2108) * lu(k,2131) + lu(k,2136) = lu(k,2136) - lu(k,2109) * lu(k,2131) + lu(k,2137) = lu(k,2137) - lu(k,2110) * lu(k,2131) + lu(k,2138) = lu(k,2138) - lu(k,2111) * lu(k,2131) + lu(k,2238) = lu(k,2238) - lu(k,2105) * lu(k,2237) + lu(k,2239) = lu(k,2239) - lu(k,2106) * lu(k,2237) + lu(k,2240) = lu(k,2240) - lu(k,2107) * lu(k,2237) + lu(k,2241) = lu(k,2241) - lu(k,2108) * lu(k,2237) + lu(k,2242) = lu(k,2242) - lu(k,2109) * lu(k,2237) + lu(k,2243) = lu(k,2243) - lu(k,2110) * lu(k,2237) + lu(k,2244) = lu(k,2244) - lu(k,2111) * lu(k,2237) + lu(k,2298) = lu(k,2298) - lu(k,2105) * lu(k,2297) + lu(k,2299) = lu(k,2299) - lu(k,2106) * lu(k,2297) + lu(k,2300) = lu(k,2300) - lu(k,2107) * lu(k,2297) + lu(k,2301) = lu(k,2301) - lu(k,2108) * lu(k,2297) + lu(k,2302) = lu(k,2302) - lu(k,2109) * lu(k,2297) + lu(k,2303) = lu(k,2303) - lu(k,2110) * lu(k,2297) + lu(k,2304) = lu(k,2304) - lu(k,2111) * lu(k,2297) + lu(k,2418) = lu(k,2418) - lu(k,2105) * lu(k,2417) + lu(k,2419) = lu(k,2419) - lu(k,2106) * lu(k,2417) + lu(k,2420) = lu(k,2420) - lu(k,2107) * lu(k,2417) + lu(k,2421) = lu(k,2421) - lu(k,2108) * lu(k,2417) + lu(k,2422) = lu(k,2422) - lu(k,2109) * lu(k,2417) + lu(k,2423) = lu(k,2423) - lu(k,2110) * lu(k,2417) + lu(k,2424) = lu(k,2424) - lu(k,2111) * lu(k,2417) + lu(k,2444) = lu(k,2444) - lu(k,2105) * lu(k,2443) + lu(k,2445) = lu(k,2445) - lu(k,2106) * lu(k,2443) + lu(k,2446) = lu(k,2446) - lu(k,2107) * lu(k,2443) + lu(k,2447) = lu(k,2447) - lu(k,2108) * lu(k,2443) + lu(k,2448) = lu(k,2448) - lu(k,2109) * lu(k,2443) + lu(k,2449) = lu(k,2449) - lu(k,2110) * lu(k,2443) + lu(k,2450) = lu(k,2450) - lu(k,2111) * lu(k,2443) + lu(k,2489) = lu(k,2489) - lu(k,2105) * lu(k,2488) + lu(k,2490) = lu(k,2490) - lu(k,2106) * lu(k,2488) + lu(k,2491) = lu(k,2491) - lu(k,2107) * lu(k,2488) + lu(k,2492) = lu(k,2492) - lu(k,2108) * lu(k,2488) + lu(k,2493) = lu(k,2493) - lu(k,2109) * lu(k,2488) + lu(k,2494) = lu(k,2494) - lu(k,2110) * lu(k,2488) + lu(k,2495) = lu(k,2495) - lu(k,2111) * lu(k,2488) + lu(k,2516) = lu(k,2516) - lu(k,2105) * lu(k,2515) + lu(k,2517) = lu(k,2517) - lu(k,2106) * lu(k,2515) + lu(k,2518) = lu(k,2518) - lu(k,2107) * lu(k,2515) + lu(k,2519) = lu(k,2519) - lu(k,2108) * lu(k,2515) + lu(k,2520) = lu(k,2520) - lu(k,2109) * lu(k,2515) + lu(k,2521) = lu(k,2521) - lu(k,2110) * lu(k,2515) + lu(k,2522) = lu(k,2522) - lu(k,2111) * lu(k,2515) + lu(k,2132) = 1._r8 / lu(k,2132) + lu(k,2133) = lu(k,2133) * lu(k,2132) + lu(k,2134) = lu(k,2134) * lu(k,2132) + lu(k,2135) = lu(k,2135) * lu(k,2132) + lu(k,2136) = lu(k,2136) * lu(k,2132) + lu(k,2137) = lu(k,2137) * lu(k,2132) + lu(k,2138) = lu(k,2138) * lu(k,2132) + lu(k,2239) = lu(k,2239) - lu(k,2133) * lu(k,2238) + lu(k,2240) = lu(k,2240) - lu(k,2134) * lu(k,2238) + lu(k,2241) = lu(k,2241) - lu(k,2135) * lu(k,2238) + lu(k,2242) = lu(k,2242) - lu(k,2136) * lu(k,2238) + lu(k,2243) = lu(k,2243) - lu(k,2137) * lu(k,2238) + lu(k,2244) = lu(k,2244) - lu(k,2138) * lu(k,2238) + lu(k,2299) = lu(k,2299) - lu(k,2133) * lu(k,2298) + lu(k,2300) = lu(k,2300) - lu(k,2134) * lu(k,2298) + lu(k,2301) = lu(k,2301) - lu(k,2135) * lu(k,2298) + lu(k,2302) = lu(k,2302) - lu(k,2136) * lu(k,2298) + lu(k,2303) = lu(k,2303) - lu(k,2137) * lu(k,2298) + lu(k,2304) = lu(k,2304) - lu(k,2138) * lu(k,2298) + lu(k,2419) = lu(k,2419) - lu(k,2133) * lu(k,2418) + lu(k,2420) = lu(k,2420) - lu(k,2134) * lu(k,2418) + lu(k,2421) = lu(k,2421) - lu(k,2135) * lu(k,2418) + lu(k,2422) = lu(k,2422) - lu(k,2136) * lu(k,2418) + lu(k,2423) = lu(k,2423) - lu(k,2137) * lu(k,2418) + lu(k,2424) = lu(k,2424) - lu(k,2138) * lu(k,2418) + lu(k,2445) = lu(k,2445) - lu(k,2133) * lu(k,2444) + lu(k,2446) = lu(k,2446) - lu(k,2134) * lu(k,2444) + lu(k,2447) = lu(k,2447) - lu(k,2135) * lu(k,2444) + lu(k,2448) = lu(k,2448) - lu(k,2136) * lu(k,2444) + lu(k,2449) = lu(k,2449) - lu(k,2137) * lu(k,2444) + lu(k,2450) = lu(k,2450) - lu(k,2138) * lu(k,2444) + lu(k,2490) = lu(k,2490) - lu(k,2133) * lu(k,2489) + lu(k,2491) = lu(k,2491) - lu(k,2134) * lu(k,2489) + lu(k,2492) = lu(k,2492) - lu(k,2135) * lu(k,2489) + lu(k,2493) = lu(k,2493) - lu(k,2136) * lu(k,2489) + lu(k,2494) = lu(k,2494) - lu(k,2137) * lu(k,2489) + lu(k,2495) = lu(k,2495) - lu(k,2138) * lu(k,2489) + lu(k,2517) = lu(k,2517) - lu(k,2133) * lu(k,2516) + lu(k,2518) = lu(k,2518) - lu(k,2134) * lu(k,2516) + lu(k,2519) = lu(k,2519) - lu(k,2135) * lu(k,2516) + lu(k,2520) = lu(k,2520) - lu(k,2136) * lu(k,2516) + lu(k,2521) = lu(k,2521) - lu(k,2137) * lu(k,2516) + lu(k,2522) = lu(k,2522) - lu(k,2138) * lu(k,2516) + end do + end subroutine lu_fac33 + subroutine lu_fac34( 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,2239) = 1._r8 / lu(k,2239) + lu(k,2240) = lu(k,2240) * lu(k,2239) + lu(k,2241) = lu(k,2241) * lu(k,2239) + lu(k,2242) = lu(k,2242) * lu(k,2239) + lu(k,2243) = lu(k,2243) * lu(k,2239) + lu(k,2244) = lu(k,2244) * lu(k,2239) + lu(k,2300) = lu(k,2300) - lu(k,2240) * lu(k,2299) + lu(k,2301) = lu(k,2301) - lu(k,2241) * lu(k,2299) + lu(k,2302) = lu(k,2302) - lu(k,2242) * lu(k,2299) + lu(k,2303) = lu(k,2303) - lu(k,2243) * lu(k,2299) + lu(k,2304) = lu(k,2304) - lu(k,2244) * lu(k,2299) + lu(k,2420) = lu(k,2420) - lu(k,2240) * lu(k,2419) + lu(k,2421) = lu(k,2421) - lu(k,2241) * lu(k,2419) + lu(k,2422) = lu(k,2422) - lu(k,2242) * lu(k,2419) + lu(k,2423) = lu(k,2423) - lu(k,2243) * lu(k,2419) + lu(k,2424) = lu(k,2424) - lu(k,2244) * lu(k,2419) + lu(k,2446) = lu(k,2446) - lu(k,2240) * lu(k,2445) + lu(k,2447) = lu(k,2447) - lu(k,2241) * lu(k,2445) + lu(k,2448) = lu(k,2448) - lu(k,2242) * lu(k,2445) + lu(k,2449) = lu(k,2449) - lu(k,2243) * lu(k,2445) + lu(k,2450) = lu(k,2450) - lu(k,2244) * lu(k,2445) + lu(k,2491) = lu(k,2491) - lu(k,2240) * lu(k,2490) + lu(k,2492) = lu(k,2492) - lu(k,2241) * lu(k,2490) + lu(k,2493) = lu(k,2493) - lu(k,2242) * lu(k,2490) + lu(k,2494) = lu(k,2494) - lu(k,2243) * lu(k,2490) + lu(k,2495) = lu(k,2495) - lu(k,2244) * lu(k,2490) + lu(k,2518) = lu(k,2518) - lu(k,2240) * lu(k,2517) + lu(k,2519) = lu(k,2519) - lu(k,2241) * lu(k,2517) + lu(k,2520) = lu(k,2520) - lu(k,2242) * lu(k,2517) + lu(k,2521) = lu(k,2521) - lu(k,2243) * lu(k,2517) + lu(k,2522) = lu(k,2522) - lu(k,2244) * lu(k,2517) + lu(k,2300) = 1._r8 / lu(k,2300) + lu(k,2301) = lu(k,2301) * lu(k,2300) + lu(k,2302) = lu(k,2302) * lu(k,2300) + lu(k,2303) = lu(k,2303) * lu(k,2300) + lu(k,2304) = lu(k,2304) * lu(k,2300) + lu(k,2421) = lu(k,2421) - lu(k,2301) * lu(k,2420) + lu(k,2422) = lu(k,2422) - lu(k,2302) * lu(k,2420) + lu(k,2423) = lu(k,2423) - lu(k,2303) * lu(k,2420) + lu(k,2424) = lu(k,2424) - lu(k,2304) * lu(k,2420) + lu(k,2447) = lu(k,2447) - lu(k,2301) * lu(k,2446) + lu(k,2448) = lu(k,2448) - lu(k,2302) * lu(k,2446) + lu(k,2449) = lu(k,2449) - lu(k,2303) * lu(k,2446) + lu(k,2450) = lu(k,2450) - lu(k,2304) * lu(k,2446) + lu(k,2492) = lu(k,2492) - lu(k,2301) * lu(k,2491) + lu(k,2493) = lu(k,2493) - lu(k,2302) * lu(k,2491) + lu(k,2494) = lu(k,2494) - lu(k,2303) * lu(k,2491) + lu(k,2495) = lu(k,2495) - lu(k,2304) * lu(k,2491) + lu(k,2519) = lu(k,2519) - lu(k,2301) * lu(k,2518) + lu(k,2520) = lu(k,2520) - lu(k,2302) * lu(k,2518) + lu(k,2521) = lu(k,2521) - lu(k,2303) * lu(k,2518) + lu(k,2522) = lu(k,2522) - lu(k,2304) * lu(k,2518) + lu(k,2421) = 1._r8 / lu(k,2421) + lu(k,2422) = lu(k,2422) * lu(k,2421) + lu(k,2423) = lu(k,2423) * lu(k,2421) + lu(k,2424) = lu(k,2424) * lu(k,2421) + lu(k,2448) = lu(k,2448) - lu(k,2422) * lu(k,2447) + lu(k,2449) = lu(k,2449) - lu(k,2423) * lu(k,2447) + lu(k,2450) = lu(k,2450) - lu(k,2424) * lu(k,2447) + lu(k,2493) = lu(k,2493) - lu(k,2422) * lu(k,2492) + lu(k,2494) = lu(k,2494) - lu(k,2423) * lu(k,2492) + lu(k,2495) = lu(k,2495) - lu(k,2424) * lu(k,2492) + lu(k,2520) = lu(k,2520) - lu(k,2422) * lu(k,2519) + lu(k,2521) = lu(k,2521) - lu(k,2423) * lu(k,2519) + lu(k,2522) = lu(k,2522) - lu(k,2424) * lu(k,2519) + lu(k,2448) = 1._r8 / lu(k,2448) + lu(k,2449) = lu(k,2449) * lu(k,2448) + lu(k,2450) = lu(k,2450) * lu(k,2448) + lu(k,2494) = lu(k,2494) - lu(k,2449) * lu(k,2493) + lu(k,2495) = lu(k,2495) - lu(k,2450) * lu(k,2493) + lu(k,2521) = lu(k,2521) - lu(k,2449) * lu(k,2520) + lu(k,2522) = lu(k,2522) - lu(k,2450) * lu(k,2520) + lu(k,2494) = 1._r8 / lu(k,2494) + lu(k,2495) = lu(k,2495) * lu(k,2494) + lu(k,2522) = lu(k,2522) - lu(k,2495) * lu(k,2521) + lu(k,2522) = 1._r8 / lu(k,2522) + end do + end subroutine lu_fac34 + 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 ) + call lu_fac19( avec_len, lu ) + call lu_fac20( avec_len, lu ) + call lu_fac21( avec_len, lu ) + call lu_fac22( avec_len, lu ) + call lu_fac23( avec_len, lu ) + call lu_fac24( avec_len, lu ) + call lu_fac25( avec_len, lu ) + call lu_fac26( avec_len, lu ) + call lu_fac27( avec_len, lu ) + call lu_fac28( avec_len, lu ) + call lu_fac29( avec_len, lu ) + call lu_fac30( avec_len, lu ) + call lu_fac31( avec_len, lu ) + call lu_fac32( avec_len, lu ) + call lu_fac33( avec_len, lu ) + call lu_fac34( avec_len, lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_lu_solve.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_lu_solve.F90 new file mode 100644 index 0000000000..0a8729a728 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_lu_solve.F90 @@ -0,0 +1,2815 @@ + 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,261) = b(k,261) - lu(k,140) * b(k,87) + b(k,272) = b(k,272) - lu(k,141) * b(k,87) + b(k,263) = b(k,263) - lu(k,143) * b(k,88) + b(k,264) = b(k,264) - lu(k,144) * b(k,88) + b(k,261) = b(k,261) - lu(k,146) * b(k,89) + b(k,269) = b(k,269) - lu(k,147) * b(k,89) + b(k,263) = b(k,263) - lu(k,149) * b(k,90) + b(k,266) = b(k,266) - lu(k,150) * b(k,90) + b(k,122) = b(k,122) - lu(k,152) * b(k,91) + b(k,254) = b(k,254) - lu(k,153) * b(k,91) + b(k,264) = b(k,264) - lu(k,154) * b(k,91) + b(k,124) = b(k,124) - lu(k,156) * b(k,92) + b(k,263) = b(k,263) - lu(k,157) * b(k,92) + b(k,264) = b(k,264) - lu(k,158) * b(k,92) + b(k,122) = b(k,122) - lu(k,160) * b(k,93) + b(k,263) = b(k,263) - lu(k,161) * b(k,93) + b(k,264) = b(k,264) - lu(k,162) * b(k,93) + b(k,122) = b(k,122) - lu(k,164) * b(k,94) + b(k,263) = b(k,263) - lu(k,165) * b(k,94) + b(k,264) = b(k,264) - lu(k,166) * b(k,94) + b(k,261) = b(k,261) - lu(k,168) * b(k,95) + b(k,263) = b(k,263) - lu(k,169) * b(k,95) + b(k,272) = b(k,272) - lu(k,170) * b(k,95) + b(k,240) = b(k,240) - lu(k,172) * b(k,96) + b(k,261) = b(k,261) - lu(k,173) * b(k,96) + b(k,172) = b(k,172) - lu(k,175) * b(k,97) + b(k,271) = b(k,271) - lu(k,176) * b(k,97) + b(k,122) = b(k,122) - lu(k,178) * b(k,98) + b(k,254) = b(k,254) - lu(k,179) * b(k,98) + b(k,263) = b(k,263) - lu(k,180) * b(k,98) + b(k,264) = b(k,264) - lu(k,181) * b(k,98) + b(k,122) = b(k,122) - lu(k,183) * b(k,99) + b(k,214) = b(k,214) - lu(k,184) * b(k,99) + b(k,254) = b(k,254) - lu(k,185) * b(k,99) + b(k,264) = b(k,264) - lu(k,186) * b(k,99) + b(k,122) = b(k,122) - lu(k,188) * b(k,100) + b(k,124) = b(k,124) - lu(k,189) * b(k,100) + b(k,263) = b(k,263) - lu(k,190) * b(k,100) + b(k,264) = b(k,264) - lu(k,191) * b(k,100) + b(k,122) = b(k,122) - lu(k,193) * b(k,101) + b(k,214) = b(k,214) - lu(k,194) * b(k,101) + b(k,263) = b(k,263) - lu(k,195) * b(k,101) + b(k,264) = b(k,264) - lu(k,196) * b(k,101) + b(k,163) = b(k,163) - lu(k,198) * b(k,102) + b(k,261) = b(k,261) - lu(k,199) * b(k,102) + b(k,127) = b(k,127) - lu(k,201) * b(k,103) + b(k,272) = b(k,272) - lu(k,202) * b(k,103) + b(k,105) = b(k,105) - lu(k,205) * b(k,104) + b(k,106) = b(k,106) - lu(k,206) * b(k,104) + b(k,168) = b(k,168) - lu(k,207) * b(k,104) + b(k,261) = b(k,261) - lu(k,208) * b(k,104) + b(k,269) = b(k,269) - lu(k,209) * b(k,104) + b(k,162) = b(k,162) - lu(k,211) * b(k,105) + b(k,234) = b(k,234) - lu(k,212) * b(k,105) + b(k,269) = b(k,269) - lu(k,213) * b(k,105) + b(k,161) = b(k,161) - lu(k,215) * b(k,106) + b(k,166) = b(k,166) - lu(k,216) * b(k,106) + b(k,261) = b(k,261) - lu(k,217) * b(k,106) + b(k,269) = b(k,269) - lu(k,218) * b(k,106) + b(k,263) = b(k,263) - lu(k,220) * b(k,107) + b(k,255) = b(k,255) - lu(k,222) * b(k,108) + b(k,255) = b(k,255) - lu(k,225) * b(k,109) + b(k,261) = b(k,261) - lu(k,227) * b(k,110) + b(k,264) = b(k,264) - lu(k,228) * b(k,110) + b(k,269) = b(k,269) - lu(k,229) * b(k,110) + b(k,112) = b(k,112) - lu(k,232) * b(k,111) + b(k,113) = b(k,113) - lu(k,233) * b(k,111) + b(k,159) = b(k,159) - lu(k,234) * b(k,111) + b(k,199) = b(k,199) - lu(k,235) * b(k,111) + b(k,261) = b(k,261) - lu(k,236) * b(k,111) + b(k,269) = b(k,269) - lu(k,237) * b(k,111) + b(k,161) = b(k,161) - lu(k,239) * b(k,112) + b(k,166) = b(k,166) - lu(k,240) * b(k,112) + b(k,261) = b(k,261) - lu(k,241) * b(k,112) + b(k,269) = b(k,269) - lu(k,242) * b(k,112) + b(k,234) = b(k,234) - lu(k,244) * b(k,113) + b(k,249) = b(k,249) - lu(k,245) * b(k,113) + b(k,269) = b(k,269) - lu(k,246) * b(k,113) + b(k,240) = b(k,240) - lu(k,248) * b(k,114) + b(k,261) = b(k,261) - lu(k,249) * b(k,114) + b(k,116) = b(k,116) - lu(k,253) * b(k,115) + b(k,159) = b(k,159) - lu(k,254) * b(k,115) + b(k,200) = b(k,200) - lu(k,255) * b(k,115) + b(k,234) = b(k,234) - lu(k,256) * b(k,115) + b(k,249) = b(k,249) - lu(k,257) * b(k,115) + b(k,261) = b(k,261) - lu(k,258) * b(k,115) + b(k,269) = b(k,269) - lu(k,259) * b(k,115) + b(k,166) = b(k,166) - lu(k,261) * b(k,116) + b(k,170) = b(k,170) - lu(k,262) * b(k,116) + b(k,261) = b(k,261) - lu(k,263) * b(k,116) + b(k,269) = b(k,269) - lu(k,264) * b(k,116) + b(k,223) = b(k,223) - lu(k,266) * b(k,117) + b(k,261) = b(k,261) - lu(k,267) * b(k,117) + b(k,254) = b(k,254) - lu(k,269) * b(k,118) + b(k,263) = b(k,263) - lu(k,270) * b(k,118) + b(k,259) = b(k,259) - lu(k,272) * b(k,119) + b(k,271) = b(k,271) - lu(k,273) * b(k,119) + b(k,172) = b(k,172) - lu(k,275) * b(k,120) + b(k,261) = b(k,261) - lu(k,276) * b(k,120) + b(k,186) = b(k,186) - lu(k,278) * b(k,121) + b(k,240) = b(k,240) - lu(k,279) * b(k,121) + b(k,261) = b(k,261) - lu(k,280) * b(k,121) + b(k,269) = b(k,269) - lu(k,281) * b(k,121) + b(k,214) = b(k,214) - lu(k,283) * b(k,122) + b(k,264) = b(k,264) - lu(k,284) * b(k,122) + b(k,124) = b(k,124) - lu(k,286) * b(k,123) + b(k,261) = b(k,261) - lu(k,287) * b(k,123) + b(k,263) = b(k,263) - lu(k,288) * b(k,123) + b(k,264) = b(k,264) - lu(k,289) * b(k,123) + b(k,214) = b(k,214) - lu(k,291) * b(k,124) + b(k,263) = b(k,263) - lu(k,292) * b(k,124) + b(k,264) = b(k,264) - lu(k,293) * b(k,124) + b(k,214) = b(k,214) - lu(k,296) * b(k,125) + b(k,261) = b(k,261) - lu(k,297) * b(k,125) + b(k,263) = b(k,263) - lu(k,298) * b(k,125) + b(k,264) = b(k,264) - lu(k,299) * b(k,125) + b(k,255) = b(k,255) - lu(k,301) * b(k,126) + b(k,264) = b(k,264) - lu(k,302) * b(k,126) + b(k,267) = b(k,267) - lu(k,303) * b(k,126) + b(k,219) = b(k,219) - lu(k,306) * b(k,127) + b(k,262) = b(k,262) - lu(k,307) * b(k,127) + b(k,272) = b(k,272) - lu(k,308) * b(k,127) + b(k,233) = b(k,233) - lu(k,310) * b(k,128) + b(k,261) = b(k,261) - lu(k,311) * b(k,128) + b(k,269) = b(k,269) - lu(k,312) * b(k,128) + b(k,166) = b(k,166) - lu(k,314) * b(k,129) + b(k,188) = b(k,188) - lu(k,315) * b(k,129) + b(k,261) = b(k,261) - lu(k,316) * b(k,129) + b(k,216) = b(k,216) - lu(k,318) * b(k,130) + b(k,224) = b(k,224) - lu(k,319) * b(k,130) + b(k,234) = b(k,234) - lu(k,320) * b(k,130) + b(k,261) = b(k,261) - lu(k,321) * b(k,130) + b(k,269) = b(k,269) - lu(k,322) * b(k,130) + b(k,215) = b(k,215) - lu(k,324) * b(k,131) + b(k,253) = b(k,253) - lu(k,325) * b(k,131) + b(k,261) = b(k,261) - lu(k,326) * b(k,131) + b(k,263) = b(k,263) - lu(k,327) * b(k,131) + b(k,272) = b(k,272) - lu(k,328) * b(k,131) + b(k,218) = b(k,218) - lu(k,330) * b(k,132) + b(k,253) = b(k,253) - lu(k,331) * b(k,132) + b(k,261) = b(k,261) - lu(k,332) * b(k,132) + b(k,263) = b(k,263) - lu(k,333) * b(k,132) + b(k,272) = b(k,272) - lu(k,334) * b(k,132) + b(k,201) = b(k,201) - lu(k,336) * b(k,133) + b(k,269) = b(k,269) - lu(k,337) * b(k,133) + b(k,259) = b(k,259) - lu(k,339) * b(k,134) + b(k,262) = b(k,262) - lu(k,340) * b(k,134) + b(k,267) = b(k,267) - lu(k,341) * b(k,134) + b(k,268) = b(k,268) - lu(k,342) * b(k,134) + b(k,271) = b(k,271) - lu(k,343) * b(k,134) + b(k,214) = b(k,214) - lu(k,345) * b(k,135) + b(k,260) = b(k,260) - lu(k,346) * b(k,135) + b(k,219) = b(k,219) - lu(k,348) * b(k,136) + b(k,259) = b(k,259) - lu(k,349) * b(k,136) + b(k,261) = b(k,261) - lu(k,350) * b(k,136) + b(k,268) = b(k,268) - lu(k,351) * b(k,136) + b(k,269) = b(k,269) - lu(k,352) * b(k,136) + b(k,214) = b(k,214) - lu(k,355) * b(k,137) + b(k,261) = b(k,261) - lu(k,356) * b(k,137) + b(k,263) = b(k,263) - lu(k,357) * b(k,137) + b(k,264) = b(k,264) - lu(k,358) * b(k,137) + b(k,272) = b(k,272) - lu(k,359) * b(k,137) + b(k,219) = b(k,219) - lu(k,361) * b(k,138) + b(k,252) = b(k,252) - lu(k,362) * b(k,138) + b(k,262) = b(k,262) - lu(k,363) * b(k,138) + b(k,266) = b(k,266) - lu(k,364) * b(k,138) + b(k,161) = b(k,161) - lu(k,366) * b(k,139) + b(k,224) = b(k,224) - lu(k,367) * b(k,139) + b(k,261) = b(k,261) - lu(k,368) * b(k,139) + b(k,269) = b(k,269) - lu(k,369) * b(k,139) + b(k,159) = b(k,159) - lu(k,372) * b(k,140) + b(k,172) = b(k,172) - lu(k,373) * b(k,140) + b(k,261) = b(k,261) - lu(k,374) * b(k,140) + b(k,269) = b(k,269) - lu(k,375) * b(k,140) + b(k,215) = b(k,215) - lu(k,377) * b(k,141) + b(k,233) = b(k,233) - lu(k,378) * b(k,141) + b(k,261) = b(k,261) - lu(k,379) * b(k,141) + b(k,269) = b(k,269) - lu(k,380) * b(k,141) + b(k,240) = b(k,240) - lu(k,382) * b(k,142) + b(k,261) = b(k,261) - lu(k,383) * b(k,142) + b(k,246) = b(k,246) - lu(k,385) * b(k,143) + b(k,248) = b(k,248) - lu(k,386) * b(k,143) + b(k,261) = b(k,261) - lu(k,387) * b(k,143) + b(k,269) = b(k,269) - lu(k,388) * b(k,143) + b(k,234) = b(k,234) - lu(k,390) * b(k,144) + b(k,243) = b(k,243) - lu(k,391) * b(k,144) + b(k,249) = b(k,249) - lu(k,392) * b(k,144) + b(k,269) = b(k,269) - lu(k,393) * b(k,144) + b(k,191) = b(k,191) - lu(k,395) * b(k,145) + b(k,233) = b(k,233) - lu(k,396) * b(k,145) + b(k,249) = b(k,249) - lu(k,397) * b(k,145) + b(k,261) = b(k,261) - lu(k,398) * b(k,145) + b(k,234) = b(k,234) - lu(k,400) * b(k,146) + b(k,253) = b(k,253) - lu(k,401) * b(k,146) + b(k,258) = b(k,258) - lu(k,402) * b(k,146) + b(k,261) = b(k,261) - lu(k,403) * b(k,146) + b(k,263) = b(k,263) - lu(k,404) * b(k,146) + b(k,269) = b(k,269) - lu(k,405) * b(k,146) + b(k,272) = b(k,272) - lu(k,406) * b(k,146) + b(k,179) = b(k,179) - lu(k,408) * b(k,147) + b(k,227) = b(k,227) - lu(k,409) * b(k,147) + b(k,233) = b(k,233) - lu(k,410) * b(k,147) + b(k,261) = b(k,261) - lu(k,411) * b(k,147) + b(k,268) = b(k,268) - lu(k,412) * b(k,147) + b(k,270) = b(k,270) - lu(k,413) * b(k,147) + b(k,271) = b(k,271) - lu(k,414) * b(k,147) + 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,197) = b(k,197) - lu(k,416) * b(k,148) + b(k,219) = b(k,219) - lu(k,417) * b(k,148) + b(k,234) = b(k,234) - lu(k,418) * b(k,148) + b(k,252) = b(k,252) - lu(k,419) * b(k,148) + b(k,260) = b(k,260) - lu(k,420) * b(k,148) + b(k,261) = b(k,261) - lu(k,421) * b(k,148) + b(k,262) = b(k,262) - lu(k,422) * b(k,148) + b(k,224) = b(k,224) - lu(k,424) * b(k,149) + b(k,234) = b(k,234) - lu(k,425) * b(k,149) + b(k,243) = b(k,243) - lu(k,426) * b(k,149) + b(k,249) = b(k,249) - lu(k,427) * b(k,149) + b(k,269) = b(k,269) - lu(k,428) * b(k,149) + b(k,239) = b(k,239) - lu(k,430) * b(k,150) + b(k,249) = b(k,249) - lu(k,431) * b(k,150) + b(k,261) = b(k,261) - lu(k,432) * b(k,150) + b(k,270) = b(k,270) - lu(k,433) * b(k,150) + b(k,272) = b(k,272) - lu(k,434) * b(k,150) + b(k,218) = b(k,218) - lu(k,436) * b(k,151) + b(k,227) = b(k,227) - lu(k,437) * b(k,151) + b(k,261) = b(k,261) - lu(k,438) * b(k,151) + b(k,269) = b(k,269) - lu(k,439) * b(k,151) + b(k,272) = b(k,272) - lu(k,440) * b(k,151) + b(k,258) = b(k,258) - lu(k,442) * b(k,152) + b(k,260) = b(k,260) - lu(k,443) * b(k,152) + b(k,261) = b(k,261) - lu(k,444) * b(k,152) + b(k,270) = b(k,270) - lu(k,445) * b(k,152) + b(k,272) = b(k,272) - lu(k,446) * b(k,152) + b(k,253) = b(k,253) - lu(k,448) * b(k,153) + b(k,254) = b(k,254) - lu(k,449) * b(k,153) + b(k,261) = b(k,261) - lu(k,450) * b(k,153) + b(k,263) = b(k,263) - lu(k,451) * b(k,153) + b(k,264) = b(k,264) - lu(k,452) * b(k,153) + b(k,226) = b(k,226) - lu(k,454) * b(k,154) + b(k,229) = b(k,229) - lu(k,455) * b(k,154) + b(k,259) = b(k,259) - lu(k,456) * b(k,154) + b(k,261) = b(k,261) - lu(k,457) * b(k,154) + b(k,271) = b(k,271) - lu(k,458) * b(k,154) + b(k,212) = b(k,212) - lu(k,460) * b(k,155) + b(k,235) = b(k,235) - lu(k,461) * b(k,155) + b(k,259) = b(k,259) - lu(k,462) * b(k,155) + b(k,261) = b(k,261) - lu(k,463) * b(k,155) + b(k,269) = b(k,269) - lu(k,464) * b(k,155) + b(k,162) = b(k,162) - lu(k,466) * b(k,156) + b(k,168) = b(k,168) - lu(k,467) * b(k,156) + b(k,224) = b(k,224) - lu(k,468) * b(k,156) + b(k,261) = b(k,261) - lu(k,469) * b(k,156) + b(k,269) = b(k,269) - lu(k,470) * b(k,156) + b(k,195) = b(k,195) - lu(k,472) * b(k,157) + b(k,212) = b(k,212) - lu(k,473) * b(k,157) + b(k,261) = b(k,261) - lu(k,474) * b(k,157) + b(k,269) = b(k,269) - lu(k,475) * b(k,157) + b(k,271) = b(k,271) - lu(k,476) * b(k,157) + b(k,170) = b(k,170) - lu(k,478) * b(k,158) + b(k,224) = b(k,224) - lu(k,479) * b(k,158) + b(k,243) = b(k,243) - lu(k,480) * b(k,158) + b(k,261) = b(k,261) - lu(k,481) * b(k,158) + b(k,269) = b(k,269) - lu(k,482) * b(k,158) + b(k,172) = b(k,172) - lu(k,486) * b(k,159) + b(k,261) = b(k,261) - lu(k,487) * b(k,159) + b(k,267) = b(k,267) - lu(k,488) * b(k,159) + b(k,269) = b(k,269) - lu(k,489) * b(k,159) + b(k,271) = b(k,271) - lu(k,490) * b(k,159) + b(k,216) = b(k,216) - lu(k,492) * b(k,160) + b(k,267) = b(k,267) - lu(k,493) * b(k,160) + b(k,269) = b(k,269) - lu(k,494) * b(k,160) + b(k,270) = b(k,270) - lu(k,495) * b(k,160) + b(k,271) = b(k,271) - lu(k,496) * b(k,160) + b(k,224) = b(k,224) - lu(k,499) * b(k,161) + b(k,261) = b(k,261) - lu(k,500) * b(k,161) + b(k,267) = b(k,267) - lu(k,501) * b(k,161) + b(k,269) = b(k,269) - lu(k,502) * b(k,161) + b(k,271) = b(k,271) - lu(k,503) * b(k,161) + b(k,198) = b(k,198) - lu(k,505) * b(k,162) + b(k,269) = b(k,269) - lu(k,506) * b(k,162) + b(k,235) = b(k,235) - lu(k,508) * b(k,163) + b(k,255) = b(k,255) - lu(k,509) * b(k,163) + b(k,269) = b(k,269) - lu(k,510) * b(k,163) + b(k,270) = b(k,270) - lu(k,511) * b(k,163) + b(k,255) = b(k,255) - lu(k,513) * b(k,164) + b(k,261) = b(k,261) - lu(k,514) * b(k,164) + b(k,268) = b(k,268) - lu(k,515) * b(k,164) + b(k,269) = b(k,269) - lu(k,516) * b(k,164) + b(k,271) = b(k,271) - lu(k,517) * b(k,164) + b(k,272) = b(k,272) - lu(k,518) * b(k,164) + b(k,253) = b(k,253) - lu(k,520) * b(k,165) + b(k,254) = b(k,254) - lu(k,521) * b(k,165) + b(k,261) = b(k,261) - lu(k,522) * b(k,165) + b(k,263) = b(k,263) - lu(k,523) * b(k,165) + b(k,264) = b(k,264) - lu(k,524) * b(k,165) + b(k,272) = b(k,272) - lu(k,525) * b(k,165) + b(k,188) = b(k,188) - lu(k,527) * b(k,166) + b(k,265) = b(k,265) - lu(k,528) * b(k,166) + b(k,271) = b(k,271) - lu(k,529) * b(k,166) + b(k,225) = b(k,225) - lu(k,531) * b(k,167) + b(k,226) = b(k,226) - lu(k,532) * b(k,167) + b(k,227) = b(k,227) - lu(k,533) * b(k,167) + b(k,261) = b(k,261) - lu(k,534) * b(k,167) + b(k,269) = b(k,269) - lu(k,535) * b(k,167) + b(k,270) = b(k,270) - lu(k,536) * b(k,167) + b(k,198) = b(k,198) - lu(k,540) * b(k,168) + b(k,224) = b(k,224) - lu(k,541) * b(k,168) + b(k,261) = b(k,261) - lu(k,542) * b(k,168) + b(k,267) = b(k,267) - lu(k,543) * b(k,168) + b(k,269) = b(k,269) - lu(k,544) * b(k,168) + b(k,271) = b(k,271) - lu(k,545) * b(k,168) + b(k,204) = b(k,204) - lu(k,547) * b(k,169) + b(k,209) = b(k,209) - lu(k,548) * b(k,169) + b(k,210) = b(k,210) - lu(k,549) * b(k,169) + b(k,220) = b(k,220) - lu(k,550) * b(k,169) + b(k,255) = b(k,255) - lu(k,551) * b(k,169) + b(k,262) = b(k,262) - lu(k,552) * b(k,169) + b(k,224) = b(k,224) - lu(k,555) * b(k,170) + b(k,243) = b(k,243) - lu(k,556) * b(k,170) + b(k,261) = b(k,261) - lu(k,557) * b(k,170) + b(k,267) = b(k,267) - lu(k,558) * b(k,170) + b(k,269) = b(k,269) - lu(k,559) * b(k,170) + b(k,271) = b(k,271) - lu(k,560) * b(k,170) + b(k,191) = b(k,191) - lu(k,562) * b(k,171) + b(k,215) = b(k,215) - lu(k,563) * b(k,171) + b(k,249) = b(k,249) - lu(k,564) * b(k,171) + b(k,261) = b(k,261) - lu(k,565) * b(k,171) + b(k,188) = b(k,188) - lu(k,568) * b(k,172) + b(k,261) = b(k,261) - lu(k,569) * b(k,172) + b(k,267) = b(k,267) - lu(k,570) * b(k,172) + b(k,269) = b(k,269) - lu(k,571) * b(k,172) + b(k,271) = b(k,271) - lu(k,572) * b(k,172) + b(k,220) = b(k,220) - lu(k,574) * b(k,173) + b(k,255) = b(k,255) - lu(k,575) * b(k,173) + b(k,264) = b(k,264) - lu(k,576) * b(k,173) + b(k,267) = b(k,267) - lu(k,577) * b(k,173) + b(k,203) = b(k,203) - lu(k,579) * b(k,174) + b(k,216) = b(k,216) - lu(k,580) * b(k,174) + b(k,234) = b(k,234) - lu(k,581) * b(k,174) + b(k,261) = b(k,261) - lu(k,582) * b(k,174) + b(k,265) = b(k,265) - lu(k,583) * b(k,174) + b(k,269) = b(k,269) - lu(k,584) * b(k,174) + b(k,270) = b(k,270) - lu(k,585) * b(k,174) + b(k,202) = b(k,202) - lu(k,587) * b(k,175) + b(k,254) = b(k,254) - lu(k,588) * b(k,175) + b(k,256) = b(k,256) - lu(k,589) * b(k,175) + b(k,259) = b(k,259) - lu(k,590) * b(k,175) + b(k,262) = b(k,262) - lu(k,591) * b(k,175) + b(k,268) = b(k,268) - lu(k,592) * b(k,175) + b(k,271) = b(k,271) - lu(k,593) * b(k,175) + b(k,206) = b(k,206) - lu(k,595) * b(k,176) + b(k,233) = b(k,233) - lu(k,596) * b(k,176) + b(k,238) = b(k,238) - lu(k,597) * b(k,176) + b(k,261) = b(k,261) - lu(k,598) * b(k,176) + b(k,269) = b(k,269) - lu(k,599) * b(k,176) + b(k,270) = b(k,270) - lu(k,600) * b(k,176) + b(k,272) = b(k,272) - lu(k,601) * b(k,176) + b(k,249) = b(k,249) - lu(k,603) * b(k,177) + b(k,250) = b(k,250) - lu(k,604) * b(k,177) + b(k,258) = b(k,258) - lu(k,605) * b(k,177) + b(k,261) = b(k,261) - lu(k,606) * b(k,177) + b(k,268) = b(k,268) - lu(k,607) * b(k,177) + b(k,270) = b(k,270) - lu(k,608) * b(k,177) + b(k,271) = b(k,271) - lu(k,609) * b(k,177) + b(k,212) = b(k,212) - lu(k,611) * b(k,178) + b(k,235) = b(k,235) - lu(k,612) * b(k,178) + b(k,237) = b(k,237) - lu(k,613) * b(k,178) + b(k,238) = b(k,238) - lu(k,614) * b(k,178) + b(k,259) = b(k,259) - lu(k,615) * b(k,178) + b(k,261) = b(k,261) - lu(k,616) * b(k,178) + b(k,269) = b(k,269) - lu(k,617) * b(k,178) + b(k,227) = b(k,227) - lu(k,619) * b(k,179) + b(k,233) = b(k,233) - lu(k,620) * b(k,179) + b(k,237) = b(k,237) - lu(k,621) * b(k,179) + b(k,267) = b(k,267) - lu(k,622) * b(k,179) + b(k,269) = b(k,269) - lu(k,623) * b(k,179) + b(k,270) = b(k,270) - lu(k,624) * b(k,179) + b(k,271) = b(k,271) - lu(k,625) * b(k,179) + b(k,253) = b(k,253) - lu(k,627) * b(k,180) + b(k,254) = b(k,254) - lu(k,628) * b(k,180) + b(k,258) = b(k,258) - lu(k,629) * b(k,180) + b(k,261) = b(k,261) - lu(k,630) * b(k,180) + b(k,263) = b(k,263) - lu(k,631) * b(k,180) + b(k,264) = b(k,264) - lu(k,632) * b(k,180) + b(k,269) = b(k,269) - lu(k,633) * b(k,180) + b(k,272) = b(k,272) - lu(k,634) * b(k,180) + b(k,249) = b(k,249) - lu(k,636) * b(k,181) + b(k,250) = b(k,250) - lu(k,637) * b(k,181) + b(k,258) = b(k,258) - lu(k,638) * b(k,181) + b(k,261) = b(k,261) - lu(k,639) * b(k,181) + b(k,270) = b(k,270) - lu(k,640) * b(k,181) + b(k,272) = b(k,272) - lu(k,641) * b(k,181) + b(k,235) = b(k,235) - lu(k,643) * b(k,182) + b(k,237) = b(k,237) - lu(k,644) * b(k,182) + b(k,238) = b(k,238) - lu(k,645) * b(k,182) + b(k,259) = b(k,259) - lu(k,646) * b(k,182) + b(k,261) = b(k,261) - lu(k,647) * b(k,182) + b(k,269) = b(k,269) - lu(k,648) * b(k,182) + b(k,270) = b(k,270) - lu(k,649) * b(k,182) + b(k,271) = b(k,271) - lu(k,650) * b(k,182) + b(k,186) = b(k,186) - lu(k,654) * b(k,183) + b(k,198) = b(k,198) - lu(k,655) * b(k,183) + b(k,199) = b(k,199) - lu(k,656) * b(k,183) + b(k,201) = b(k,201) - lu(k,657) * b(k,183) + b(k,224) = b(k,224) - lu(k,658) * b(k,183) + b(k,243) = b(k,243) - lu(k,659) * b(k,183) + b(k,261) = b(k,261) - lu(k,660) * b(k,183) + b(k,269) = b(k,269) - lu(k,661) * b(k,183) + 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,238) = b(k,238) - lu(k,663) * b(k,184) + b(k,248) = b(k,248) - lu(k,664) * b(k,184) + b(k,250) = b(k,250) - lu(k,665) * b(k,184) + b(k,261) = b(k,261) - lu(k,666) * b(k,184) + b(k,268) = b(k,268) - lu(k,667) * b(k,184) + b(k,269) = b(k,269) - lu(k,668) * b(k,184) + b(k,270) = b(k,270) - lu(k,669) * b(k,184) + b(k,271) = b(k,271) - lu(k,670) * b(k,184) + b(k,253) = b(k,253) - lu(k,672) * b(k,185) + b(k,261) = b(k,261) - lu(k,673) * b(k,185) + b(k,262) = b(k,262) - lu(k,674) * b(k,185) + b(k,263) = b(k,263) - lu(k,675) * b(k,185) + b(k,269) = b(k,269) - lu(k,676) * b(k,185) + b(k,272) = b(k,272) - lu(k,677) * b(k,185) + b(k,217) = b(k,217) - lu(k,679) * b(k,186) + b(k,234) = b(k,234) - lu(k,680) * b(k,186) + b(k,269) = b(k,269) - lu(k,681) * b(k,186) + b(k,226) = b(k,226) - lu(k,683) * b(k,187) + b(k,259) = b(k,259) - lu(k,684) * b(k,187) + b(k,261) = b(k,261) - lu(k,685) * b(k,187) + b(k,269) = b(k,269) - lu(k,686) * b(k,187) + b(k,271) = b(k,271) - lu(k,687) * b(k,187) + b(k,261) = b(k,261) - lu(k,691) * b(k,188) + b(k,265) = b(k,265) - lu(k,692) * b(k,188) + b(k,267) = b(k,267) - lu(k,693) * b(k,188) + b(k,269) = b(k,269) - lu(k,694) * b(k,188) + b(k,271) = b(k,271) - lu(k,695) * b(k,188) + b(k,191) = b(k,191) - lu(k,698) * b(k,189) + b(k,215) = b(k,215) - lu(k,699) * b(k,189) + b(k,223) = b(k,223) - lu(k,700) * b(k,189) + b(k,227) = b(k,227) - lu(k,701) * b(k,189) + b(k,233) = b(k,233) - lu(k,702) * b(k,189) + b(k,249) = b(k,249) - lu(k,703) * b(k,189) + b(k,261) = b(k,261) - lu(k,704) * b(k,189) + b(k,269) = b(k,269) - lu(k,705) * b(k,189) + b(k,270) = b(k,270) - lu(k,706) * b(k,189) + b(k,191) = b(k,191) - lu(k,709) * b(k,190) + b(k,215) = b(k,215) - lu(k,710) * b(k,190) + b(k,227) = b(k,227) - lu(k,711) * b(k,190) + b(k,233) = b(k,233) - lu(k,712) * b(k,190) + b(k,249) = b(k,249) - lu(k,713) * b(k,190) + b(k,261) = b(k,261) - lu(k,714) * b(k,190) + b(k,269) = b(k,269) - lu(k,715) * b(k,190) + b(k,270) = b(k,270) - lu(k,716) * b(k,190) + b(k,271) = b(k,271) - lu(k,717) * b(k,190) + b(k,233) = b(k,233) - lu(k,720) * b(k,191) + b(k,249) = b(k,249) - lu(k,721) * b(k,191) + b(k,261) = b(k,261) - lu(k,722) * b(k,191) + b(k,267) = b(k,267) - lu(k,723) * b(k,191) + b(k,269) = b(k,269) - lu(k,724) * b(k,191) + b(k,271) = b(k,271) - lu(k,725) * b(k,191) + b(k,227) = b(k,227) - lu(k,727) * b(k,192) + b(k,230) = b(k,230) - lu(k,728) * b(k,192) + b(k,234) = b(k,234) - lu(k,729) * b(k,192) + b(k,235) = b(k,235) - lu(k,730) * b(k,192) + b(k,236) = b(k,236) - lu(k,731) * b(k,192) + b(k,250) = b(k,250) - lu(k,732) * b(k,192) + b(k,261) = b(k,261) - lu(k,733) * b(k,192) + b(k,269) = b(k,269) - lu(k,734) * b(k,192) + b(k,270) = b(k,270) - lu(k,735) * b(k,192) + b(k,204) = b(k,204) - lu(k,738) * b(k,193) + b(k,209) = b(k,209) - lu(k,739) * b(k,193) + b(k,210) = b(k,210) - lu(k,740) * b(k,193) + b(k,211) = b(k,211) - lu(k,741) * b(k,193) + b(k,220) = b(k,220) - lu(k,742) * b(k,193) + b(k,255) = b(k,255) - lu(k,743) * b(k,193) + b(k,262) = b(k,262) - lu(k,744) * b(k,193) + b(k,264) = b(k,264) - lu(k,745) * b(k,193) + b(k,267) = b(k,267) - lu(k,746) * b(k,193) + b(k,250) = b(k,250) - lu(k,748) * b(k,194) + b(k,258) = b(k,258) - lu(k,749) * b(k,194) + b(k,261) = b(k,261) - lu(k,750) * b(k,194) + b(k,272) = b(k,272) - lu(k,751) * b(k,194) + b(k,240) = b(k,240) - lu(k,754) * b(k,195) + b(k,242) = b(k,242) - lu(k,755) * b(k,195) + b(k,247) = b(k,247) - lu(k,756) * b(k,195) + b(k,261) = b(k,261) - lu(k,757) * b(k,195) + b(k,269) = b(k,269) - lu(k,758) * b(k,195) + b(k,270) = b(k,270) - lu(k,759) * b(k,195) + b(k,198) = b(k,198) - lu(k,765) * b(k,196) + b(k,200) = b(k,200) - lu(k,766) * b(k,196) + b(k,201) = b(k,201) - lu(k,767) * b(k,196) + b(k,217) = b(k,217) - lu(k,768) * b(k,196) + b(k,224) = b(k,224) - lu(k,769) * b(k,196) + b(k,234) = b(k,234) - lu(k,770) * b(k,196) + b(k,243) = b(k,243) - lu(k,771) * b(k,196) + b(k,249) = b(k,249) - lu(k,772) * b(k,196) + b(k,261) = b(k,261) - lu(k,773) * b(k,196) + b(k,269) = b(k,269) - lu(k,774) * b(k,196) + b(k,252) = b(k,252) - lu(k,776) * b(k,197) + b(k,255) = b(k,255) - lu(k,777) * b(k,197) + b(k,260) = b(k,260) - lu(k,778) * b(k,197) + b(k,261) = b(k,261) - lu(k,779) * b(k,197) + b(k,262) = b(k,262) - lu(k,780) * b(k,197) + b(k,265) = b(k,265) - lu(k,781) * b(k,197) + b(k,224) = b(k,224) - lu(k,783) * b(k,198) + b(k,234) = b(k,234) - lu(k,784) * b(k,198) + b(k,267) = b(k,267) - lu(k,785) * b(k,198) + b(k,269) = b(k,269) - lu(k,786) * b(k,198) + b(k,271) = b(k,271) - lu(k,787) * b(k,198) + b(k,201) = b(k,201) - lu(k,794) * b(k,199) + b(k,217) = b(k,217) - lu(k,795) * b(k,199) + b(k,224) = b(k,224) - lu(k,796) * b(k,199) + b(k,234) = b(k,234) - lu(k,797) * b(k,199) + b(k,243) = b(k,243) - lu(k,798) * b(k,199) + b(k,261) = b(k,261) - lu(k,799) * b(k,199) + b(k,267) = b(k,267) - lu(k,800) * b(k,199) + b(k,269) = b(k,269) - lu(k,801) * b(k,199) + b(k,271) = b(k,271) - lu(k,802) * b(k,199) + b(k,201) = b(k,201) - lu(k,810) * b(k,200) + b(k,217) = b(k,217) - lu(k,811) * b(k,200) + b(k,224) = b(k,224) - lu(k,812) * b(k,200) + b(k,234) = b(k,234) - lu(k,813) * b(k,200) + b(k,243) = b(k,243) - lu(k,814) * b(k,200) + b(k,249) = b(k,249) - lu(k,815) * b(k,200) + b(k,261) = b(k,261) - lu(k,816) * b(k,200) + b(k,267) = b(k,267) - lu(k,817) * b(k,200) + b(k,269) = b(k,269) - lu(k,818) * b(k,200) + b(k,271) = b(k,271) - lu(k,819) * b(k,200) + b(k,234) = b(k,234) - lu(k,821) * b(k,201) + b(k,243) = b(k,243) - lu(k,822) * b(k,201) + b(k,258) = b(k,258) - lu(k,823) * b(k,201) + b(k,261) = b(k,261) - lu(k,824) * b(k,201) + b(k,267) = b(k,267) - lu(k,825) * b(k,201) + b(k,269) = b(k,269) - lu(k,826) * b(k,201) + b(k,271) = b(k,271) - lu(k,827) * b(k,201) + b(k,253) = b(k,253) - lu(k,830) * b(k,202) + b(k,254) = b(k,254) - lu(k,831) * b(k,202) + b(k,256) = b(k,256) - lu(k,832) * b(k,202) + b(k,261) = b(k,261) - lu(k,833) * b(k,202) + b(k,262) = b(k,262) - lu(k,834) * b(k,202) + b(k,263) = b(k,263) - lu(k,835) * b(k,202) + b(k,272) = b(k,272) - lu(k,836) * b(k,202) + b(k,235) = b(k,235) - lu(k,840) * b(k,203) + b(k,255) = b(k,255) - lu(k,841) * b(k,203) + b(k,261) = b(k,261) - lu(k,842) * b(k,203) + b(k,267) = b(k,267) - lu(k,843) * b(k,203) + b(k,269) = b(k,269) - lu(k,844) * b(k,203) + b(k,270) = b(k,270) - lu(k,845) * b(k,203) + b(k,271) = b(k,271) - lu(k,846) * b(k,203) + b(k,209) = b(k,209) - lu(k,848) * b(k,204) + b(k,210) = b(k,210) - lu(k,849) * b(k,204) + b(k,220) = b(k,220) - lu(k,850) * b(k,204) + b(k,234) = b(k,234) - lu(k,851) * b(k,204) + b(k,250) = b(k,250) - lu(k,852) * b(k,204) + b(k,255) = b(k,255) - lu(k,853) * b(k,204) + b(k,262) = b(k,262) - lu(k,854) * b(k,204) + b(k,261) = b(k,261) - lu(k,856) * b(k,205) + b(k,269) = b(k,269) - lu(k,857) * b(k,205) + b(k,270) = b(k,270) - lu(k,858) * b(k,205) + b(k,233) = b(k,233) - lu(k,861) * b(k,206) + b(k,238) = b(k,238) - lu(k,862) * b(k,206) + b(k,255) = b(k,255) - lu(k,863) * b(k,206) + b(k,261) = b(k,261) - lu(k,864) * b(k,206) + b(k,267) = b(k,267) - lu(k,865) * b(k,206) + b(k,269) = b(k,269) - lu(k,866) * b(k,206) + b(k,270) = b(k,270) - lu(k,867) * b(k,206) + b(k,271) = b(k,271) - lu(k,868) * b(k,206) + b(k,272) = b(k,272) - lu(k,869) * b(k,206) + b(k,254) = b(k,254) - lu(k,871) * b(k,207) + b(k,256) = b(k,256) - lu(k,872) * b(k,207) + b(k,260) = b(k,260) - lu(k,873) * b(k,207) + b(k,261) = b(k,261) - lu(k,874) * b(k,207) + b(k,262) = b(k,262) - lu(k,875) * b(k,207) + b(k,264) = b(k,264) - lu(k,876) * b(k,207) + b(k,272) = b(k,272) - lu(k,877) * b(k,207) + b(k,253) = b(k,253) - lu(k,880) * b(k,208) + b(k,261) = b(k,261) - lu(k,881) * b(k,208) + b(k,262) = b(k,262) - lu(k,882) * b(k,208) + b(k,263) = b(k,263) - lu(k,883) * b(k,208) + b(k,266) = b(k,266) - lu(k,884) * b(k,208) + b(k,272) = b(k,272) - lu(k,885) * b(k,208) + b(k,211) = b(k,211) - lu(k,888) * b(k,209) + b(k,220) = b(k,220) - lu(k,889) * b(k,209) + b(k,255) = b(k,255) - lu(k,890) * b(k,209) + b(k,262) = b(k,262) - lu(k,891) * b(k,209) + b(k,264) = b(k,264) - lu(k,892) * b(k,209) + b(k,267) = b(k,267) - lu(k,893) * b(k,209) + b(k,211) = b(k,211) - lu(k,896) * b(k,210) + b(k,220) = b(k,220) - lu(k,897) * b(k,210) + b(k,255) = b(k,255) - lu(k,898) * b(k,210) + b(k,262) = b(k,262) - lu(k,899) * b(k,210) + b(k,264) = b(k,264) - lu(k,900) * b(k,210) + b(k,267) = b(k,267) - lu(k,901) * b(k,210) + b(k,220) = b(k,220) - lu(k,908) * b(k,211) + b(k,234) = b(k,234) - lu(k,909) * b(k,211) + b(k,250) = b(k,250) - lu(k,910) * b(k,211) + b(k,255) = b(k,255) - lu(k,911) * b(k,211) + b(k,262) = b(k,262) - lu(k,912) * b(k,211) + b(k,264) = b(k,264) - lu(k,913) * b(k,211) + b(k,267) = b(k,267) - lu(k,914) * b(k,211) + b(k,243) = b(k,243) - lu(k,916) * b(k,212) + b(k,249) = b(k,249) - lu(k,917) * b(k,212) + b(k,261) = b(k,261) - lu(k,918) * b(k,212) + b(k,270) = b(k,270) - lu(k,919) * b(k,212) + b(k,271) = b(k,271) - lu(k,920) * b(k,212) + b(k,216) = b(k,216) - lu(k,925) * b(k,213) + b(k,232) = b(k,232) - lu(k,926) * b(k,213) + b(k,234) = b(k,234) - lu(k,927) * b(k,213) + b(k,241) = b(k,241) - lu(k,928) * b(k,213) + b(k,242) = b(k,242) - lu(k,929) * b(k,213) + b(k,244) = b(k,244) - lu(k,930) * b(k,213) + b(k,245) = b(k,245) - lu(k,931) * b(k,213) + b(k,247) = b(k,247) - lu(k,932) * b(k,213) + b(k,249) = b(k,249) - lu(k,933) * b(k,213) + b(k,258) = b(k,258) - lu(k,934) * b(k,213) + b(k,261) = b(k,261) - lu(k,935) * b(k,213) + b(k,265) = b(k,265) - lu(k,936) * b(k,213) + b(k,268) = b(k,268) - lu(k,937) * b(k,213) + b(k,269) = b(k,269) - lu(k,938) * b(k,213) + b(k,270) = b(k,270) - lu(k,939) * b(k,213) + 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,251) = b(k,251) - lu(k,942) * b(k,214) + b(k,257) = b(k,257) - lu(k,943) * b(k,214) + b(k,258) = b(k,258) - lu(k,944) * b(k,214) + b(k,259) = b(k,259) - lu(k,945) * b(k,214) + b(k,260) = b(k,260) - lu(k,946) * b(k,214) + b(k,261) = b(k,261) - lu(k,947) * b(k,214) + b(k,268) = b(k,268) - lu(k,948) * b(k,214) + b(k,272) = b(k,272) - lu(k,949) * b(k,214) + b(k,233) = b(k,233) - lu(k,954) * b(k,215) + b(k,255) = b(k,255) - lu(k,955) * b(k,215) + b(k,258) = b(k,258) - lu(k,956) * b(k,215) + b(k,261) = b(k,261) - lu(k,957) * b(k,215) + b(k,267) = b(k,267) - lu(k,958) * b(k,215) + b(k,269) = b(k,269) - lu(k,959) * b(k,215) + b(k,270) = b(k,270) - lu(k,960) * b(k,215) + b(k,271) = b(k,271) - lu(k,961) * b(k,215) + b(k,250) = b(k,250) - lu(k,963) * b(k,216) + b(k,261) = b(k,261) - lu(k,964) * b(k,216) + b(k,269) = b(k,269) - lu(k,965) * b(k,216) + b(k,272) = b(k,272) - lu(k,966) * b(k,216) + b(k,224) = b(k,224) - lu(k,968) * b(k,217) + b(k,234) = b(k,234) - lu(k,969) * b(k,217) + b(k,243) = b(k,243) - lu(k,970) * b(k,217) + b(k,258) = b(k,258) - lu(k,971) * b(k,217) + b(k,261) = b(k,261) - lu(k,972) * b(k,217) + b(k,267) = b(k,267) - lu(k,973) * b(k,217) + b(k,269) = b(k,269) - lu(k,974) * b(k,217) + b(k,271) = b(k,271) - lu(k,975) * b(k,217) + b(k,227) = b(k,227) - lu(k,978) * b(k,218) + b(k,233) = b(k,233) - lu(k,979) * b(k,218) + b(k,255) = b(k,255) - lu(k,980) * b(k,218) + b(k,258) = b(k,258) - lu(k,981) * b(k,218) + b(k,261) = b(k,261) - lu(k,982) * b(k,218) + b(k,267) = b(k,267) - lu(k,983) * b(k,218) + b(k,269) = b(k,269) - lu(k,984) * b(k,218) + b(k,270) = b(k,270) - lu(k,985) * b(k,218) + b(k,271) = b(k,271) - lu(k,986) * b(k,218) + b(k,272) = b(k,272) - lu(k,987) * b(k,218) + b(k,252) = b(k,252) - lu(k,990) * b(k,219) + b(k,261) = b(k,261) - lu(k,991) * b(k,219) + b(k,262) = b(k,262) - lu(k,992) * b(k,219) + b(k,269) = b(k,269) - lu(k,993) * b(k,219) + b(k,272) = b(k,272) - lu(k,994) * b(k,219) + b(k,234) = b(k,234) - lu(k,1002) * b(k,220) + b(k,250) = b(k,250) - lu(k,1003) * b(k,220) + b(k,255) = b(k,255) - lu(k,1004) * b(k,220) + b(k,260) = b(k,260) - lu(k,1005) * b(k,220) + b(k,261) = b(k,261) - lu(k,1006) * b(k,220) + b(k,262) = b(k,262) - lu(k,1007) * b(k,220) + b(k,264) = b(k,264) - lu(k,1008) * b(k,220) + b(k,267) = b(k,267) - lu(k,1009) * b(k,220) + b(k,271) = b(k,271) - lu(k,1010) * b(k,220) + b(k,223) = b(k,223) - lu(k,1021) * b(k,221) + b(k,224) = b(k,224) - lu(k,1022) * b(k,221) + b(k,225) = b(k,225) - lu(k,1023) * b(k,221) + b(k,226) = b(k,226) - lu(k,1024) * b(k,221) + b(k,227) = b(k,227) - lu(k,1025) * b(k,221) + b(k,229) = b(k,229) - lu(k,1026) * b(k,221) + b(k,230) = b(k,230) - lu(k,1027) * b(k,221) + b(k,234) = b(k,234) - lu(k,1028) * b(k,221) + b(k,239) = b(k,239) - lu(k,1029) * b(k,221) + b(k,243) = b(k,243) - lu(k,1030) * b(k,221) + b(k,249) = b(k,249) - lu(k,1031) * b(k,221) + b(k,250) = b(k,250) - lu(k,1032) * b(k,221) + b(k,261) = b(k,261) - lu(k,1033) * b(k,221) + b(k,265) = b(k,265) - lu(k,1034) * b(k,221) + b(k,268) = b(k,268) - lu(k,1035) * b(k,221) + b(k,269) = b(k,269) - lu(k,1036) * b(k,221) + b(k,270) = b(k,270) - lu(k,1037) * b(k,221) + b(k,272) = b(k,272) - lu(k,1038) * b(k,221) + b(k,223) = b(k,223) - lu(k,1049) * b(k,222) + b(k,224) = b(k,224) - lu(k,1050) * b(k,222) + b(k,225) = b(k,225) - lu(k,1051) * b(k,222) + b(k,226) = b(k,226) - lu(k,1052) * b(k,222) + b(k,227) = b(k,227) - lu(k,1053) * b(k,222) + b(k,229) = b(k,229) - lu(k,1054) * b(k,222) + b(k,230) = b(k,230) - lu(k,1055) * b(k,222) + b(k,234) = b(k,234) - lu(k,1056) * b(k,222) + b(k,239) = b(k,239) - lu(k,1057) * b(k,222) + b(k,243) = b(k,243) - lu(k,1058) * b(k,222) + b(k,249) = b(k,249) - lu(k,1059) * b(k,222) + b(k,250) = b(k,250) - lu(k,1060) * b(k,222) + b(k,261) = b(k,261) - lu(k,1061) * b(k,222) + b(k,265) = b(k,265) - lu(k,1062) * b(k,222) + b(k,268) = b(k,268) - lu(k,1063) * b(k,222) + b(k,269) = b(k,269) - lu(k,1064) * b(k,222) + b(k,270) = b(k,270) - lu(k,1065) * b(k,222) + b(k,272) = b(k,272) - lu(k,1066) * b(k,222) + b(k,227) = b(k,227) - lu(k,1073) * b(k,223) + b(k,233) = b(k,233) - lu(k,1074) * b(k,223) + b(k,249) = b(k,249) - lu(k,1075) * b(k,223) + b(k,255) = b(k,255) - lu(k,1076) * b(k,223) + b(k,258) = b(k,258) - lu(k,1077) * b(k,223) + b(k,261) = b(k,261) - lu(k,1078) * b(k,223) + b(k,267) = b(k,267) - lu(k,1079) * b(k,223) + b(k,269) = b(k,269) - lu(k,1080) * b(k,223) + b(k,270) = b(k,270) - lu(k,1081) * b(k,223) + b(k,271) = b(k,271) - lu(k,1082) * b(k,223) + b(k,234) = b(k,234) - lu(k,1085) * b(k,224) + b(k,250) = b(k,250) - lu(k,1086) * b(k,224) + b(k,261) = b(k,261) - lu(k,1087) * b(k,224) + b(k,269) = b(k,269) - lu(k,1088) * b(k,224) + b(k,226) = b(k,226) - lu(k,1093) * b(k,225) + b(k,227) = b(k,227) - lu(k,1094) * b(k,225) + b(k,258) = b(k,258) - lu(k,1095) * b(k,225) + b(k,259) = b(k,259) - lu(k,1096) * b(k,225) + b(k,261) = b(k,261) - lu(k,1097) * b(k,225) + b(k,267) = b(k,267) - lu(k,1098) * b(k,225) + b(k,269) = b(k,269) - lu(k,1099) * b(k,225) + b(k,270) = b(k,270) - lu(k,1100) * b(k,225) + b(k,271) = b(k,271) - lu(k,1101) * b(k,225) + b(k,229) = b(k,229) - lu(k,1103) * b(k,226) + b(k,230) = b(k,230) - lu(k,1104) * b(k,226) + b(k,234) = b(k,234) - lu(k,1105) * b(k,226) + b(k,236) = b(k,236) - lu(k,1106) * b(k,226) + b(k,261) = b(k,261) - lu(k,1107) * b(k,226) + b(k,268) = b(k,268) - lu(k,1108) * b(k,226) + b(k,269) = b(k,269) - lu(k,1109) * b(k,226) + b(k,239) = b(k,239) - lu(k,1111) * b(k,227) + b(k,249) = b(k,249) - lu(k,1112) * b(k,227) + b(k,258) = b(k,258) - lu(k,1113) * b(k,227) + b(k,261) = b(k,261) - lu(k,1114) * b(k,227) + b(k,272) = b(k,272) - lu(k,1115) * b(k,227) + b(k,253) = b(k,253) - lu(k,1119) * b(k,228) + b(k,259) = b(k,259) - lu(k,1120) * b(k,228) + b(k,261) = b(k,261) - lu(k,1121) * b(k,228) + b(k,262) = b(k,262) - lu(k,1122) * b(k,228) + b(k,263) = b(k,263) - lu(k,1123) * b(k,228) + b(k,266) = b(k,266) - lu(k,1124) * b(k,228) + b(k,268) = b(k,268) - lu(k,1125) * b(k,228) + b(k,271) = b(k,271) - lu(k,1126) * b(k,228) + b(k,272) = b(k,272) - lu(k,1127) * b(k,228) + b(k,230) = b(k,230) - lu(k,1133) * b(k,229) + b(k,234) = b(k,234) - lu(k,1134) * b(k,229) + b(k,236) = b(k,236) - lu(k,1135) * b(k,229) + b(k,258) = b(k,258) - lu(k,1136) * b(k,229) + b(k,259) = b(k,259) - lu(k,1137) * b(k,229) + b(k,261) = b(k,261) - lu(k,1138) * b(k,229) + b(k,267) = b(k,267) - lu(k,1139) * b(k,229) + b(k,268) = b(k,268) - lu(k,1140) * b(k,229) + b(k,269) = b(k,269) - lu(k,1141) * b(k,229) + b(k,270) = b(k,270) - lu(k,1142) * b(k,229) + b(k,271) = b(k,271) - lu(k,1143) * b(k,229) + b(k,234) = b(k,234) - lu(k,1146) * b(k,230) + b(k,239) = b(k,239) - lu(k,1147) * b(k,230) + b(k,249) = b(k,249) - lu(k,1148) * b(k,230) + b(k,250) = b(k,250) - lu(k,1149) * b(k,230) + b(k,258) = b(k,258) - lu(k,1150) * b(k,230) + b(k,261) = b(k,261) - lu(k,1151) * b(k,230) + b(k,269) = b(k,269) - lu(k,1152) * b(k,230) + b(k,270) = b(k,270) - lu(k,1153) * b(k,230) + b(k,272) = b(k,272) - lu(k,1154) * b(k,230) + b(k,234) = b(k,234) - lu(k,1160) * b(k,231) + b(k,243) = b(k,243) - lu(k,1161) * b(k,231) + b(k,249) = b(k,249) - lu(k,1162) * b(k,231) + b(k,250) = b(k,250) - lu(k,1163) * b(k,231) + b(k,258) = b(k,258) - lu(k,1164) * b(k,231) + b(k,259) = b(k,259) - lu(k,1165) * b(k,231) + b(k,261) = b(k,261) - lu(k,1166) * b(k,231) + b(k,267) = b(k,267) - lu(k,1167) * b(k,231) + b(k,269) = b(k,269) - lu(k,1168) * b(k,231) + b(k,270) = b(k,270) - lu(k,1169) * b(k,231) + b(k,271) = b(k,271) - lu(k,1170) * b(k,231) + b(k,233) = b(k,233) - lu(k,1176) * b(k,232) + b(k,234) = b(k,234) - lu(k,1177) * b(k,232) + b(k,238) = b(k,238) - lu(k,1178) * b(k,232) + b(k,243) = b(k,243) - lu(k,1179) * b(k,232) + b(k,249) = b(k,249) - lu(k,1180) * b(k,232) + b(k,250) = b(k,250) - lu(k,1181) * b(k,232) + b(k,255) = b(k,255) - lu(k,1182) * b(k,232) + b(k,257) = b(k,257) - lu(k,1183) * b(k,232) + b(k,258) = b(k,258) - lu(k,1184) * b(k,232) + b(k,261) = b(k,261) - lu(k,1185) * b(k,232) + b(k,265) = b(k,265) - lu(k,1186) * b(k,232) + b(k,267) = b(k,267) - lu(k,1187) * b(k,232) + b(k,268) = b(k,268) - lu(k,1188) * b(k,232) + b(k,269) = b(k,269) - lu(k,1189) * b(k,232) + b(k,270) = b(k,270) - lu(k,1190) * b(k,232) + b(k,271) = b(k,271) - lu(k,1191) * b(k,232) + b(k,272) = b(k,272) - lu(k,1192) * b(k,232) + b(k,234) = b(k,234) - lu(k,1194) * b(k,233) + b(k,249) = b(k,249) - lu(k,1195) * b(k,233) + b(k,258) = b(k,258) - lu(k,1196) * b(k,233) + b(k,259) = b(k,259) - lu(k,1197) * b(k,233) + b(k,261) = b(k,261) - lu(k,1198) * b(k,233) + b(k,268) = b(k,268) - lu(k,1199) * b(k,233) + b(k,269) = b(k,269) - lu(k,1200) * b(k,233) + b(k,272) = b(k,272) - lu(k,1201) * b(k,233) + b(k,250) = b(k,250) - lu(k,1203) * b(k,234) + b(k,261) = b(k,261) - lu(k,1204) * b(k,234) + b(k,269) = b(k,269) - lu(k,1205) * b(k,234) + b(k,250) = b(k,250) - lu(k,1209) * b(k,235) + b(k,261) = b(k,261) - lu(k,1210) * b(k,235) + b(k,269) = b(k,269) - lu(k,1211) * b(k,235) + b(k,270) = b(k,270) - lu(k,1212) * b(k,235) + b(k,239) = b(k,239) - lu(k,1221) * b(k,236) + b(k,249) = b(k,249) - lu(k,1222) * b(k,236) + b(k,250) = b(k,250) - lu(k,1223) * b(k,236) + b(k,258) = b(k,258) - lu(k,1224) * b(k,236) + b(k,259) = b(k,259) - lu(k,1225) * b(k,236) + b(k,261) = b(k,261) - lu(k,1226) * b(k,236) + b(k,267) = b(k,267) - lu(k,1227) * b(k,236) + b(k,269) = b(k,269) - lu(k,1228) * b(k,236) + b(k,270) = b(k,270) - lu(k,1229) * b(k,236) + b(k,271) = b(k,271) - lu(k,1230) * b(k,236) + b(k,272) = b(k,272) - lu(k,1231) * b(k,236) + 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 + b(k,238) = b(k,238) - lu(k,1238) * b(k,237) + b(k,239) = b(k,239) - lu(k,1239) * b(k,237) + b(k,249) = b(k,249) - lu(k,1240) * b(k,237) + b(k,250) = b(k,250) - lu(k,1241) * b(k,237) + b(k,258) = b(k,258) - lu(k,1242) * b(k,237) + b(k,259) = b(k,259) - lu(k,1243) * b(k,237) + b(k,261) = b(k,261) - lu(k,1244) * b(k,237) + b(k,268) = b(k,268) - lu(k,1245) * b(k,237) + b(k,269) = b(k,269) - lu(k,1246) * b(k,237) + b(k,270) = b(k,270) - lu(k,1247) * b(k,237) + b(k,271) = b(k,271) - lu(k,1248) * b(k,237) + b(k,272) = b(k,272) - lu(k,1249) * b(k,237) + b(k,243) = b(k,243) - lu(k,1251) * b(k,238) + b(k,249) = b(k,249) - lu(k,1252) * b(k,238) + b(k,261) = b(k,261) - lu(k,1253) * b(k,238) + b(k,269) = b(k,269) - lu(k,1254) * b(k,238) + b(k,270) = b(k,270) - lu(k,1255) * b(k,238) + b(k,243) = b(k,243) - lu(k,1260) * b(k,239) + b(k,249) = b(k,249) - lu(k,1261) * b(k,239) + b(k,258) = b(k,258) - lu(k,1262) * b(k,239) + b(k,261) = b(k,261) - lu(k,1263) * b(k,239) + b(k,267) = b(k,267) - lu(k,1264) * b(k,239) + b(k,269) = b(k,269) - lu(k,1265) * b(k,239) + b(k,270) = b(k,270) - lu(k,1266) * b(k,239) + b(k,271) = b(k,271) - lu(k,1267) * b(k,239) + b(k,272) = b(k,272) - lu(k,1268) * b(k,239) + b(k,243) = b(k,243) - lu(k,1276) * b(k,240) + b(k,249) = b(k,249) - lu(k,1277) * b(k,240) + b(k,250) = b(k,250) - lu(k,1278) * b(k,240) + b(k,258) = b(k,258) - lu(k,1279) * b(k,240) + b(k,261) = b(k,261) - lu(k,1280) * b(k,240) + b(k,267) = b(k,267) - lu(k,1281) * b(k,240) + b(k,268) = b(k,268) - lu(k,1282) * b(k,240) + b(k,269) = b(k,269) - lu(k,1283) * b(k,240) + b(k,270) = b(k,270) - lu(k,1284) * b(k,240) + b(k,271) = b(k,271) - lu(k,1285) * b(k,240) + b(k,242) = b(k,242) - lu(k,1296) * b(k,241) + b(k,243) = b(k,243) - lu(k,1297) * b(k,241) + b(k,247) = b(k,247) - lu(k,1298) * b(k,241) + b(k,249) = b(k,249) - lu(k,1299) * b(k,241) + b(k,250) = b(k,250) - lu(k,1300) * b(k,241) + b(k,258) = b(k,258) - lu(k,1301) * b(k,241) + b(k,259) = b(k,259) - lu(k,1302) * b(k,241) + b(k,261) = b(k,261) - lu(k,1303) * b(k,241) + b(k,267) = b(k,267) - lu(k,1304) * b(k,241) + b(k,268) = b(k,268) - lu(k,1305) * b(k,241) + b(k,269) = b(k,269) - lu(k,1306) * b(k,241) + b(k,270) = b(k,270) - lu(k,1307) * b(k,241) + b(k,271) = b(k,271) - lu(k,1308) * b(k,241) + b(k,243) = b(k,243) - lu(k,1312) * b(k,242) + b(k,246) = b(k,246) - lu(k,1313) * b(k,242) + b(k,248) = b(k,248) - lu(k,1314) * b(k,242) + b(k,249) = b(k,249) - lu(k,1315) * b(k,242) + b(k,250) = b(k,250) - lu(k,1316) * b(k,242) + b(k,261) = b(k,261) - lu(k,1317) * b(k,242) + b(k,265) = b(k,265) - lu(k,1318) * b(k,242) + b(k,269) = b(k,269) - lu(k,1319) * b(k,242) + b(k,270) = b(k,270) - lu(k,1320) * b(k,242) + b(k,272) = b(k,272) - lu(k,1321) * b(k,242) + b(k,249) = b(k,249) - lu(k,1324) * b(k,243) + b(k,250) = b(k,250) - lu(k,1325) * b(k,243) + b(k,259) = b(k,259) - lu(k,1326) * b(k,243) + b(k,261) = b(k,261) - lu(k,1327) * b(k,243) + b(k,268) = b(k,268) - lu(k,1328) * b(k,243) + b(k,269) = b(k,269) - lu(k,1329) * b(k,243) + b(k,272) = b(k,272) - lu(k,1330) * b(k,243) + b(k,246) = b(k,246) - lu(k,1342) * b(k,244) + b(k,247) = b(k,247) - lu(k,1343) * b(k,244) + b(k,248) = b(k,248) - lu(k,1344) * b(k,244) + b(k,249) = b(k,249) - lu(k,1345) * b(k,244) + b(k,250) = b(k,250) - lu(k,1346) * b(k,244) + b(k,258) = b(k,258) - lu(k,1347) * b(k,244) + b(k,259) = b(k,259) - lu(k,1348) * b(k,244) + b(k,261) = b(k,261) - lu(k,1349) * b(k,244) + b(k,265) = b(k,265) - lu(k,1350) * b(k,244) + b(k,267) = b(k,267) - lu(k,1351) * b(k,244) + b(k,268) = b(k,268) - lu(k,1352) * b(k,244) + b(k,269) = b(k,269) - lu(k,1353) * b(k,244) + b(k,270) = b(k,270) - lu(k,1354) * b(k,244) + b(k,271) = b(k,271) - lu(k,1355) * b(k,244) + b(k,272) = b(k,272) - lu(k,1356) * b(k,244) + b(k,246) = b(k,246) - lu(k,1375) * b(k,245) + b(k,247) = b(k,247) - lu(k,1376) * b(k,245) + b(k,248) = b(k,248) - lu(k,1377) * b(k,245) + b(k,249) = b(k,249) - lu(k,1378) * b(k,245) + b(k,250) = b(k,250) - lu(k,1379) * b(k,245) + b(k,258) = b(k,258) - lu(k,1380) * b(k,245) + b(k,259) = b(k,259) - lu(k,1381) * b(k,245) + b(k,261) = b(k,261) - lu(k,1382) * b(k,245) + b(k,265) = b(k,265) - lu(k,1383) * b(k,245) + b(k,267) = b(k,267) - lu(k,1384) * b(k,245) + b(k,268) = b(k,268) - lu(k,1385) * b(k,245) + b(k,269) = b(k,269) - lu(k,1386) * b(k,245) + b(k,270) = b(k,270) - lu(k,1387) * b(k,245) + b(k,271) = b(k,271) - lu(k,1388) * b(k,245) + b(k,272) = b(k,272) - lu(k,1389) * b(k,245) + b(k,248) = b(k,248) - lu(k,1399) * b(k,246) + b(k,249) = b(k,249) - lu(k,1400) * b(k,246) + b(k,250) = b(k,250) - lu(k,1401) * b(k,246) + b(k,258) = b(k,258) - lu(k,1402) * b(k,246) + b(k,259) = b(k,259) - lu(k,1403) * b(k,246) + b(k,261) = b(k,261) - lu(k,1404) * b(k,246) + b(k,267) = b(k,267) - lu(k,1405) * b(k,246) + b(k,268) = b(k,268) - lu(k,1406) * b(k,246) + b(k,269) = b(k,269) - lu(k,1407) * b(k,246) + b(k,270) = b(k,270) - lu(k,1408) * b(k,246) + b(k,271) = b(k,271) - lu(k,1409) * b(k,246) + b(k,272) = b(k,272) - lu(k,1410) * b(k,246) + b(k,248) = b(k,248) - lu(k,1419) * b(k,247) + b(k,249) = b(k,249) - lu(k,1420) * b(k,247) + b(k,250) = b(k,250) - lu(k,1421) * b(k,247) + b(k,255) = b(k,255) - lu(k,1422) * b(k,247) + b(k,257) = b(k,257) - lu(k,1423) * b(k,247) + b(k,258) = b(k,258) - lu(k,1424) * b(k,247) + b(k,259) = b(k,259) - lu(k,1425) * b(k,247) + b(k,261) = b(k,261) - lu(k,1426) * b(k,247) + b(k,265) = b(k,265) - lu(k,1427) * b(k,247) + b(k,267) = b(k,267) - lu(k,1428) * b(k,247) + b(k,268) = b(k,268) - lu(k,1429) * b(k,247) + b(k,269) = b(k,269) - lu(k,1430) * b(k,247) + b(k,270) = b(k,270) - lu(k,1431) * b(k,247) + b(k,271) = b(k,271) - lu(k,1432) * b(k,247) + b(k,272) = b(k,272) - lu(k,1433) * b(k,247) + b(k,249) = b(k,249) - lu(k,1440) * b(k,248) + b(k,250) = b(k,250) - lu(k,1441) * b(k,248) + b(k,258) = b(k,258) - lu(k,1442) * b(k,248) + b(k,259) = b(k,259) - lu(k,1443) * b(k,248) + b(k,261) = b(k,261) - lu(k,1444) * b(k,248) + b(k,265) = b(k,265) - lu(k,1445) * b(k,248) + b(k,267) = b(k,267) - lu(k,1446) * b(k,248) + b(k,268) = b(k,268) - lu(k,1447) * b(k,248) + b(k,269) = b(k,269) - lu(k,1448) * b(k,248) + b(k,270) = b(k,270) - lu(k,1449) * b(k,248) + b(k,271) = b(k,271) - lu(k,1450) * b(k,248) + b(k,272) = b(k,272) - lu(k,1451) * b(k,248) + b(k,250) = b(k,250) - lu(k,1471) * b(k,249) + b(k,255) = b(k,255) - lu(k,1472) * b(k,249) + b(k,257) = b(k,257) - lu(k,1473) * b(k,249) + b(k,258) = b(k,258) - lu(k,1474) * b(k,249) + b(k,259) = b(k,259) - lu(k,1475) * b(k,249) + b(k,261) = b(k,261) - lu(k,1476) * b(k,249) + b(k,265) = b(k,265) - lu(k,1477) * b(k,249) + b(k,267) = b(k,267) - lu(k,1478) * b(k,249) + b(k,268) = b(k,268) - lu(k,1479) * b(k,249) + b(k,269) = b(k,269) - lu(k,1480) * b(k,249) + b(k,270) = b(k,270) - lu(k,1481) * b(k,249) + b(k,271) = b(k,271) - lu(k,1482) * b(k,249) + b(k,272) = b(k,272) - lu(k,1483) * b(k,249) + b(k,255) = b(k,255) - lu(k,1493) * b(k,250) + b(k,260) = b(k,260) - lu(k,1494) * b(k,250) + b(k,261) = b(k,261) - lu(k,1495) * b(k,250) + b(k,262) = b(k,262) - lu(k,1496) * b(k,250) + b(k,264) = b(k,264) - lu(k,1497) * b(k,250) + b(k,267) = b(k,267) - lu(k,1498) * b(k,250) + b(k,269) = b(k,269) - lu(k,1499) * b(k,250) + b(k,271) = b(k,271) - lu(k,1500) * b(k,250) + b(k,253) = b(k,253) - lu(k,1504) * b(k,251) + b(k,257) = b(k,257) - lu(k,1505) * b(k,251) + b(k,258) = b(k,258) - lu(k,1506) * b(k,251) + b(k,259) = b(k,259) - lu(k,1507) * b(k,251) + b(k,260) = b(k,260) - lu(k,1508) * b(k,251) + b(k,261) = b(k,261) - lu(k,1509) * b(k,251) + b(k,262) = b(k,262) - lu(k,1510) * b(k,251) + b(k,263) = b(k,263) - lu(k,1511) * b(k,251) + b(k,264) = b(k,264) - lu(k,1512) * b(k,251) + b(k,268) = b(k,268) - lu(k,1513) * b(k,251) + b(k,272) = b(k,272) - lu(k,1514) * b(k,251) + b(k,254) = b(k,254) - lu(k,1519) * b(k,252) + b(k,255) = b(k,255) - lu(k,1520) * b(k,252) + b(k,256) = b(k,256) - lu(k,1521) * b(k,252) + b(k,260) = b(k,260) - lu(k,1522) * b(k,252) + b(k,261) = b(k,261) - lu(k,1523) * b(k,252) + b(k,262) = b(k,262) - lu(k,1524) * b(k,252) + b(k,263) = b(k,263) - lu(k,1525) * b(k,252) + b(k,265) = b(k,265) - lu(k,1526) * b(k,252) + b(k,266) = b(k,266) - lu(k,1527) * b(k,252) + b(k,267) = b(k,267) - lu(k,1528) * b(k,252) + b(k,269) = b(k,269) - lu(k,1529) * b(k,252) + b(k,271) = b(k,271) - lu(k,1530) * b(k,252) + b(k,272) = b(k,272) - lu(k,1531) * b(k,252) + b(k,254) = b(k,254) - lu(k,1538) * b(k,253) + b(k,256) = b(k,256) - lu(k,1539) * b(k,253) + b(k,259) = b(k,259) - lu(k,1540) * b(k,253) + b(k,260) = b(k,260) - lu(k,1541) * b(k,253) + b(k,261) = b(k,261) - lu(k,1542) * b(k,253) + b(k,262) = b(k,262) - lu(k,1543) * b(k,253) + b(k,263) = b(k,263) - lu(k,1544) * b(k,253) + b(k,264) = b(k,264) - lu(k,1545) * b(k,253) + b(k,266) = b(k,266) - lu(k,1546) * b(k,253) + b(k,268) = b(k,268) - lu(k,1547) * b(k,253) + b(k,271) = b(k,271) - lu(k,1548) * b(k,253) + b(k,272) = b(k,272) - lu(k,1549) * b(k,253) + b(k,255) = b(k,255) - lu(k,1554) * b(k,254) + b(k,256) = b(k,256) - lu(k,1555) * b(k,254) + b(k,260) = b(k,260) - lu(k,1556) * b(k,254) + b(k,261) = b(k,261) - lu(k,1557) * b(k,254) + b(k,262) = b(k,262) - lu(k,1558) * b(k,254) + b(k,264) = b(k,264) - lu(k,1559) * b(k,254) + b(k,265) = b(k,265) - lu(k,1560) * b(k,254) + b(k,267) = b(k,267) - lu(k,1561) * b(k,254) + b(k,269) = b(k,269) - lu(k,1562) * b(k,254) + b(k,270) = b(k,270) - lu(k,1563) * b(k,254) + b(k,271) = b(k,271) - lu(k,1564) * b(k,254) + b(k,272) = b(k,272) - lu(k,1565) * b(k,254) + 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,256) = b(k,256) - lu(k,1585) * b(k,255) + b(k,260) = b(k,260) - lu(k,1586) * b(k,255) + b(k,261) = b(k,261) - lu(k,1587) * b(k,255) + b(k,262) = b(k,262) - lu(k,1588) * b(k,255) + b(k,263) = b(k,263) - lu(k,1589) * b(k,255) + b(k,264) = b(k,264) - lu(k,1590) * b(k,255) + b(k,265) = b(k,265) - lu(k,1591) * b(k,255) + b(k,266) = b(k,266) - lu(k,1592) * b(k,255) + b(k,267) = b(k,267) - lu(k,1593) * b(k,255) + b(k,269) = b(k,269) - lu(k,1594) * b(k,255) + b(k,270) = b(k,270) - lu(k,1595) * b(k,255) + b(k,271) = b(k,271) - lu(k,1596) * b(k,255) + b(k,272) = b(k,272) - lu(k,1597) * b(k,255) + b(k,259) = b(k,259) - lu(k,1608) * b(k,256) + b(k,260) = b(k,260) - lu(k,1609) * b(k,256) + b(k,261) = b(k,261) - lu(k,1610) * b(k,256) + b(k,262) = b(k,262) - lu(k,1611) * b(k,256) + b(k,263) = b(k,263) - lu(k,1612) * b(k,256) + b(k,264) = b(k,264) - lu(k,1613) * b(k,256) + b(k,265) = b(k,265) - lu(k,1614) * b(k,256) + b(k,266) = b(k,266) - lu(k,1615) * b(k,256) + b(k,267) = b(k,267) - lu(k,1616) * b(k,256) + b(k,268) = b(k,268) - lu(k,1617) * b(k,256) + b(k,269) = b(k,269) - lu(k,1618) * b(k,256) + b(k,270) = b(k,270) - lu(k,1619) * b(k,256) + b(k,271) = b(k,271) - lu(k,1620) * b(k,256) + b(k,272) = b(k,272) - lu(k,1621) * b(k,256) + b(k,258) = b(k,258) - lu(k,1632) * b(k,257) + b(k,259) = b(k,259) - lu(k,1633) * b(k,257) + b(k,260) = b(k,260) - lu(k,1634) * b(k,257) + b(k,261) = b(k,261) - lu(k,1635) * b(k,257) + b(k,262) = b(k,262) - lu(k,1636) * b(k,257) + b(k,263) = b(k,263) - lu(k,1637) * b(k,257) + b(k,264) = b(k,264) - lu(k,1638) * b(k,257) + b(k,265) = b(k,265) - lu(k,1639) * b(k,257) + b(k,266) = b(k,266) - lu(k,1640) * b(k,257) + b(k,267) = b(k,267) - lu(k,1641) * b(k,257) + b(k,268) = b(k,268) - lu(k,1642) * b(k,257) + b(k,269) = b(k,269) - lu(k,1643) * b(k,257) + b(k,270) = b(k,270) - lu(k,1644) * b(k,257) + b(k,271) = b(k,271) - lu(k,1645) * b(k,257) + b(k,272) = b(k,272) - lu(k,1646) * b(k,257) + b(k,259) = b(k,259) - lu(k,1685) * b(k,258) + b(k,260) = b(k,260) - lu(k,1686) * b(k,258) + b(k,261) = b(k,261) - lu(k,1687) * b(k,258) + b(k,262) = b(k,262) - lu(k,1688) * b(k,258) + b(k,263) = b(k,263) - lu(k,1689) * b(k,258) + b(k,264) = b(k,264) - lu(k,1690) * b(k,258) + b(k,265) = b(k,265) - lu(k,1691) * b(k,258) + b(k,266) = b(k,266) - lu(k,1692) * b(k,258) + b(k,267) = b(k,267) - lu(k,1693) * b(k,258) + b(k,268) = b(k,268) - lu(k,1694) * b(k,258) + b(k,269) = b(k,269) - lu(k,1695) * b(k,258) + b(k,270) = b(k,270) - lu(k,1696) * b(k,258) + b(k,271) = b(k,271) - lu(k,1697) * b(k,258) + b(k,272) = b(k,272) - lu(k,1698) * b(k,258) + b(k,260) = b(k,260) - lu(k,1709) * b(k,259) + b(k,261) = b(k,261) - lu(k,1710) * b(k,259) + b(k,262) = b(k,262) - lu(k,1711) * b(k,259) + b(k,263) = b(k,263) - lu(k,1712) * b(k,259) + b(k,264) = b(k,264) - lu(k,1713) * b(k,259) + b(k,265) = b(k,265) - lu(k,1714) * b(k,259) + b(k,266) = b(k,266) - lu(k,1715) * b(k,259) + b(k,267) = b(k,267) - lu(k,1716) * b(k,259) + b(k,268) = b(k,268) - lu(k,1717) * b(k,259) + b(k,269) = b(k,269) - lu(k,1718) * b(k,259) + b(k,270) = b(k,270) - lu(k,1719) * b(k,259) + b(k,271) = b(k,271) - lu(k,1720) * b(k,259) + b(k,272) = b(k,272) - lu(k,1721) * b(k,259) + b(k,261) = b(k,261) - lu(k,1731) * b(k,260) + b(k,262) = b(k,262) - lu(k,1732) * b(k,260) + b(k,263) = b(k,263) - lu(k,1733) * b(k,260) + b(k,264) = b(k,264) - lu(k,1734) * b(k,260) + b(k,265) = b(k,265) - lu(k,1735) * b(k,260) + b(k,266) = b(k,266) - lu(k,1736) * b(k,260) + b(k,267) = b(k,267) - lu(k,1737) * b(k,260) + b(k,268) = b(k,268) - lu(k,1738) * b(k,260) + b(k,269) = b(k,269) - lu(k,1739) * b(k,260) + b(k,270) = b(k,270) - lu(k,1740) * b(k,260) + b(k,271) = b(k,271) - lu(k,1741) * b(k,260) + b(k,272) = b(k,272) - lu(k,1742) * b(k,260) + b(k,262) = b(k,262) - lu(k,1905) * b(k,261) + b(k,263) = b(k,263) - lu(k,1906) * b(k,261) + b(k,264) = b(k,264) - lu(k,1907) * b(k,261) + b(k,265) = b(k,265) - lu(k,1908) * b(k,261) + b(k,266) = b(k,266) - lu(k,1909) * b(k,261) + b(k,267) = b(k,267) - lu(k,1910) * b(k,261) + b(k,268) = b(k,268) - lu(k,1911) * b(k,261) + b(k,269) = b(k,269) - lu(k,1912) * b(k,261) + b(k,270) = b(k,270) - lu(k,1913) * b(k,261) + b(k,271) = b(k,271) - lu(k,1914) * b(k,261) + b(k,272) = b(k,272) - lu(k,1915) * b(k,261) + b(k,263) = b(k,263) - lu(k,1949) * b(k,262) + b(k,264) = b(k,264) - lu(k,1950) * b(k,262) + b(k,265) = b(k,265) - lu(k,1951) * b(k,262) + b(k,266) = b(k,266) - lu(k,1952) * b(k,262) + b(k,267) = b(k,267) - lu(k,1953) * b(k,262) + b(k,268) = b(k,268) - lu(k,1954) * b(k,262) + b(k,269) = b(k,269) - lu(k,1955) * b(k,262) + b(k,270) = b(k,270) - lu(k,1956) * b(k,262) + b(k,271) = b(k,271) - lu(k,1957) * b(k,262) + b(k,272) = b(k,272) - lu(k,1958) * b(k,262) + b(k,264) = b(k,264) - lu(k,1996) * b(k,263) + b(k,265) = b(k,265) - lu(k,1997) * b(k,263) + b(k,266) = b(k,266) - lu(k,1998) * b(k,263) + b(k,267) = b(k,267) - lu(k,1999) * b(k,263) + b(k,268) = b(k,268) - lu(k,2000) * b(k,263) + b(k,269) = b(k,269) - lu(k,2001) * b(k,263) + b(k,270) = b(k,270) - lu(k,2002) * b(k,263) + b(k,271) = b(k,271) - lu(k,2003) * b(k,263) + b(k,272) = b(k,272) - lu(k,2004) * b(k,263) + b(k,265) = b(k,265) - lu(k,2040) * b(k,264) + b(k,266) = b(k,266) - lu(k,2041) * b(k,264) + b(k,267) = b(k,267) - lu(k,2042) * b(k,264) + b(k,268) = b(k,268) - lu(k,2043) * b(k,264) + b(k,269) = b(k,269) - lu(k,2044) * b(k,264) + b(k,270) = b(k,270) - lu(k,2045) * b(k,264) + b(k,271) = b(k,271) - lu(k,2046) * b(k,264) + b(k,272) = b(k,272) - lu(k,2047) * b(k,264) + b(k,266) = b(k,266) - lu(k,2105) * b(k,265) + b(k,267) = b(k,267) - lu(k,2106) * b(k,265) + b(k,268) = b(k,268) - lu(k,2107) * b(k,265) + b(k,269) = b(k,269) - lu(k,2108) * b(k,265) + b(k,270) = b(k,270) - lu(k,2109) * b(k,265) + b(k,271) = b(k,271) - lu(k,2110) * b(k,265) + b(k,272) = b(k,272) - lu(k,2111) * b(k,265) + b(k,267) = b(k,267) - lu(k,2133) * b(k,266) + b(k,268) = b(k,268) - lu(k,2134) * b(k,266) + b(k,269) = b(k,269) - lu(k,2135) * b(k,266) + b(k,270) = b(k,270) - lu(k,2136) * b(k,266) + b(k,271) = b(k,271) - lu(k,2137) * b(k,266) + b(k,272) = b(k,272) - lu(k,2138) * b(k,266) + b(k,268) = b(k,268) - lu(k,2240) * b(k,267) + b(k,269) = b(k,269) - lu(k,2241) * b(k,267) + b(k,270) = b(k,270) - lu(k,2242) * b(k,267) + b(k,271) = b(k,271) - lu(k,2243) * b(k,267) + b(k,272) = b(k,272) - lu(k,2244) * b(k,267) + b(k,269) = b(k,269) - lu(k,2301) * b(k,268) + b(k,270) = b(k,270) - lu(k,2302) * b(k,268) + b(k,271) = b(k,271) - lu(k,2303) * b(k,268) + b(k,272) = b(k,272) - lu(k,2304) * b(k,268) + b(k,270) = b(k,270) - lu(k,2422) * b(k,269) + b(k,271) = b(k,271) - lu(k,2423) * b(k,269) + b(k,272) = b(k,272) - lu(k,2424) * b(k,269) + b(k,271) = b(k,271) - lu(k,2449) * b(k,270) + b(k,272) = b(k,272) - lu(k,2450) * b(k,270) + b(k,272) = b(k,272) - lu(k,2495) * b(k,271) + 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 +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,272) = b(k,272) * lu(k,2522) + b(k,271) = b(k,271) - lu(k,2521) * b(k,272) + b(k,270) = b(k,270) - lu(k,2520) * b(k,272) + b(k,269) = b(k,269) - lu(k,2519) * b(k,272) + b(k,268) = b(k,268) - lu(k,2518) * b(k,272) + b(k,267) = b(k,267) - lu(k,2517) * b(k,272) + b(k,266) = b(k,266) - lu(k,2516) * b(k,272) + b(k,265) = b(k,265) - lu(k,2515) * b(k,272) + b(k,264) = b(k,264) - lu(k,2514) * b(k,272) + b(k,263) = b(k,263) - lu(k,2513) * b(k,272) + b(k,262) = b(k,262) - lu(k,2512) * b(k,272) + b(k,261) = b(k,261) - lu(k,2511) * b(k,272) + b(k,260) = b(k,260) - lu(k,2510) * b(k,272) + b(k,259) = b(k,259) - lu(k,2509) * b(k,272) + b(k,258) = b(k,258) - lu(k,2508) * b(k,272) + b(k,257) = b(k,257) - lu(k,2507) * b(k,272) + b(k,256) = b(k,256) - lu(k,2506) * b(k,272) + b(k,255) = b(k,255) - lu(k,2505) * b(k,272) + b(k,254) = b(k,254) - lu(k,2504) * b(k,272) + b(k,253) = b(k,253) - lu(k,2503) * b(k,272) + b(k,252) = b(k,252) - lu(k,2502) * b(k,272) + b(k,251) = b(k,251) - lu(k,2501) * b(k,272) + b(k,219) = b(k,219) - lu(k,2500) * b(k,272) + b(k,214) = b(k,214) - lu(k,2499) * b(k,272) + b(k,135) = b(k,135) - lu(k,2498) * b(k,272) + b(k,127) = b(k,127) - lu(k,2497) * b(k,272) + b(k,103) = b(k,103) - lu(k,2496) * b(k,272) + b(k,271) = b(k,271) * lu(k,2494) + b(k,270) = b(k,270) - lu(k,2493) * b(k,271) + b(k,269) = b(k,269) - lu(k,2492) * b(k,271) + b(k,268) = b(k,268) - lu(k,2491) * b(k,271) + b(k,267) = b(k,267) - lu(k,2490) * b(k,271) + b(k,266) = b(k,266) - lu(k,2489) * b(k,271) + b(k,265) = b(k,265) - lu(k,2488) * b(k,271) + b(k,264) = b(k,264) - lu(k,2487) * b(k,271) + b(k,263) = b(k,263) - lu(k,2486) * b(k,271) + b(k,262) = b(k,262) - lu(k,2485) * b(k,271) + b(k,261) = b(k,261) - lu(k,2484) * b(k,271) + b(k,260) = b(k,260) - lu(k,2483) * b(k,271) + b(k,259) = b(k,259) - lu(k,2482) * b(k,271) + b(k,258) = b(k,258) - lu(k,2481) * b(k,271) + b(k,257) = b(k,257) - lu(k,2480) * b(k,271) + b(k,256) = b(k,256) - lu(k,2479) * b(k,271) + b(k,255) = b(k,255) - lu(k,2478) * b(k,271) + b(k,254) = b(k,254) - lu(k,2477) * b(k,271) + b(k,253) = b(k,253) - lu(k,2476) * b(k,271) + b(k,252) = b(k,252) - lu(k,2475) * b(k,271) + b(k,250) = b(k,250) - lu(k,2474) * b(k,271) + b(k,249) = b(k,249) - lu(k,2473) * b(k,271) + b(k,248) = b(k,248) - lu(k,2472) * b(k,271) + b(k,243) = b(k,243) - lu(k,2471) * b(k,271) + b(k,238) = b(k,238) - lu(k,2470) * b(k,271) + b(k,234) = b(k,234) - lu(k,2469) * b(k,271) + b(k,228) = b(k,228) - lu(k,2468) * b(k,271) + b(k,224) = b(k,224) - lu(k,2467) * b(k,271) + b(k,220) = b(k,220) - lu(k,2466) * b(k,271) + b(k,219) = b(k,219) - lu(k,2465) * b(k,271) + b(k,217) = b(k,217) - lu(k,2464) * b(k,271) + b(k,202) = b(k,202) - lu(k,2463) * b(k,271) + b(k,201) = b(k,201) - lu(k,2462) * b(k,271) + b(k,198) = b(k,198) - lu(k,2461) * b(k,271) + b(k,188) = b(k,188) - lu(k,2460) * b(k,271) + b(k,184) = b(k,184) - lu(k,2459) * b(k,271) + b(k,177) = b(k,177) - lu(k,2458) * b(k,271) + b(k,175) = b(k,175) - lu(k,2457) * b(k,271) + b(k,172) = b(k,172) - lu(k,2456) * b(k,271) + b(k,166) = b(k,166) - lu(k,2455) * b(k,271) + b(k,164) = b(k,164) - lu(k,2454) * b(k,271) + b(k,134) = b(k,134) - lu(k,2453) * b(k,271) + b(k,126) = b(k,126) - lu(k,2452) * b(k,271) + b(k,97) = b(k,97) - lu(k,2451) * b(k,271) + b(k,270) = b(k,270) * lu(k,2448) + b(k,269) = b(k,269) - lu(k,2447) * b(k,270) + b(k,268) = b(k,268) - lu(k,2446) * b(k,270) + b(k,267) = b(k,267) - lu(k,2445) * b(k,270) + b(k,266) = b(k,266) - lu(k,2444) * b(k,270) + b(k,265) = b(k,265) - lu(k,2443) * b(k,270) + b(k,264) = b(k,264) - lu(k,2442) * b(k,270) + b(k,263) = b(k,263) - lu(k,2441) * b(k,270) + b(k,262) = b(k,262) - lu(k,2440) * b(k,270) + b(k,261) = b(k,261) - lu(k,2439) * b(k,270) + b(k,260) = b(k,260) - lu(k,2438) * b(k,270) + b(k,259) = b(k,259) - lu(k,2437) * b(k,270) + b(k,258) = b(k,258) - lu(k,2436) * b(k,270) + b(k,257) = b(k,257) - lu(k,2435) * b(k,270) + b(k,256) = b(k,256) - lu(k,2434) * b(k,270) + b(k,255) = b(k,255) - lu(k,2433) * b(k,270) + b(k,254) = b(k,254) - lu(k,2432) * b(k,270) + b(k,253) = b(k,253) - lu(k,2431) * b(k,270) + b(k,251) = b(k,251) - lu(k,2430) * b(k,270) + b(k,250) = b(k,250) - lu(k,2429) * b(k,270) + b(k,234) = b(k,234) - lu(k,2428) * b(k,270) + b(k,216) = b(k,216) - lu(k,2427) * b(k,270) + b(k,207) = b(k,207) - lu(k,2426) * b(k,270) + b(k,160) = b(k,160) - lu(k,2425) * b(k,270) + b(k,269) = b(k,269) * lu(k,2421) + b(k,268) = b(k,268) - lu(k,2420) * b(k,269) + b(k,267) = b(k,267) - lu(k,2419) * b(k,269) + b(k,266) = b(k,266) - lu(k,2418) * b(k,269) + b(k,265) = b(k,265) - lu(k,2417) * b(k,269) + b(k,264) = b(k,264) - lu(k,2416) * b(k,269) + b(k,263) = b(k,263) - lu(k,2415) * b(k,269) + b(k,262) = b(k,262) - lu(k,2414) * b(k,269) + b(k,261) = b(k,261) - lu(k,2413) * b(k,269) + b(k,260) = b(k,260) - lu(k,2412) * b(k,269) + b(k,259) = b(k,259) - lu(k,2411) * b(k,269) + b(k,258) = b(k,258) - lu(k,2410) * b(k,269) + b(k,257) = b(k,257) - lu(k,2409) * b(k,269) + b(k,256) = b(k,256) - lu(k,2408) * b(k,269) + b(k,255) = b(k,255) - lu(k,2407) * b(k,269) + b(k,254) = b(k,254) - lu(k,2406) * b(k,269) + b(k,253) = b(k,253) - lu(k,2405) * b(k,269) + b(k,251) = b(k,251) - lu(k,2404) * b(k,269) + b(k,250) = b(k,250) - lu(k,2403) * b(k,269) + b(k,249) = b(k,249) - lu(k,2402) * b(k,269) + b(k,248) = b(k,248) - lu(k,2401) * b(k,269) + b(k,247) = b(k,247) - lu(k,2400) * b(k,269) + b(k,246) = b(k,246) - lu(k,2399) * b(k,269) + b(k,245) = b(k,245) - lu(k,2398) * b(k,269) + b(k,244) = b(k,244) - lu(k,2397) * b(k,269) + b(k,243) = b(k,243) - lu(k,2396) * b(k,269) + b(k,242) = b(k,242) - lu(k,2395) * b(k,269) + b(k,241) = b(k,241) - lu(k,2394) * b(k,269) + b(k,240) = b(k,240) - lu(k,2393) * b(k,269) + b(k,239) = b(k,239) - lu(k,2392) * b(k,269) + b(k,238) = b(k,238) - lu(k,2391) * b(k,269) + b(k,236) = b(k,236) - lu(k,2390) * b(k,269) + b(k,235) = b(k,235) - lu(k,2389) * b(k,269) + b(k,234) = b(k,234) - lu(k,2388) * b(k,269) + b(k,233) = b(k,233) - lu(k,2387) * b(k,269) + b(k,230) = b(k,230) - lu(k,2386) * b(k,269) + b(k,229) = b(k,229) - lu(k,2385) * b(k,269) + b(k,227) = b(k,227) - lu(k,2384) * b(k,269) + b(k,226) = b(k,226) - lu(k,2383) * b(k,269) + b(k,225) = b(k,225) - lu(k,2382) * b(k,269) + b(k,224) = b(k,224) - lu(k,2381) * b(k,269) + b(k,223) = b(k,223) - lu(k,2380) * b(k,269) + b(k,218) = b(k,218) - lu(k,2379) * b(k,269) + b(k,217) = b(k,217) - lu(k,2378) * b(k,269) + b(k,216) = b(k,216) - lu(k,2377) * b(k,269) + b(k,215) = b(k,215) - lu(k,2376) * b(k,269) + b(k,212) = b(k,212) - lu(k,2375) * b(k,269) + b(k,208) = b(k,208) - lu(k,2374) * b(k,269) + b(k,207) = b(k,207) - lu(k,2373) * b(k,269) + b(k,206) = b(k,206) - lu(k,2372) * b(k,269) + b(k,203) = b(k,203) - lu(k,2371) * b(k,269) + b(k,202) = b(k,202) - lu(k,2370) * b(k,269) + b(k,201) = b(k,201) - lu(k,2369) * b(k,269) + b(k,200) = b(k,200) - lu(k,2368) * b(k,269) + b(k,199) = b(k,199) - lu(k,2367) * b(k,269) + b(k,198) = b(k,198) - lu(k,2366) * b(k,269) + b(k,196) = b(k,196) - lu(k,2365) * b(k,269) + b(k,195) = b(k,195) - lu(k,2364) * b(k,269) + b(k,194) = b(k,194) - lu(k,2363) * b(k,269) + b(k,192) = b(k,192) - lu(k,2362) * b(k,269) + b(k,191) = b(k,191) - lu(k,2361) * b(k,269) + b(k,189) = b(k,189) - lu(k,2360) * b(k,269) + b(k,188) = b(k,188) - lu(k,2359) * b(k,269) + b(k,186) = b(k,186) - lu(k,2358) * b(k,269) + b(k,185) = b(k,185) - lu(k,2357) * b(k,269) + b(k,183) = b(k,183) - lu(k,2356) * b(k,269) + b(k,181) = b(k,181) - lu(k,2355) * b(k,269) + b(k,176) = b(k,176) - lu(k,2354) * b(k,269) + b(k,172) = b(k,172) - lu(k,2353) * b(k,269) + b(k,170) = b(k,170) - lu(k,2352) * b(k,269) + b(k,168) = b(k,168) - lu(k,2351) * b(k,269) + b(k,167) = b(k,167) - lu(k,2350) * b(k,269) + b(k,166) = b(k,166) - lu(k,2349) * b(k,269) + b(k,164) = b(k,164) - lu(k,2348) * b(k,269) + b(k,163) = b(k,163) - lu(k,2347) * b(k,269) + b(k,162) = b(k,162) - lu(k,2346) * b(k,269) + b(k,161) = b(k,161) - lu(k,2345) * b(k,269) + b(k,160) = b(k,160) - lu(k,2344) * b(k,269) + b(k,159) = b(k,159) - lu(k,2343) * b(k,269) + b(k,158) = b(k,158) - lu(k,2342) * b(k,269) + b(k,157) = b(k,157) - lu(k,2341) * b(k,269) + b(k,156) = b(k,156) - lu(k,2340) * b(k,269) + b(k,154) = b(k,154) - lu(k,2339) * b(k,269) + b(k,152) = b(k,152) - lu(k,2338) * b(k,269) + b(k,151) = b(k,151) - lu(k,2337) * b(k,269) + b(k,150) = b(k,150) - lu(k,2336) * b(k,269) + b(k,145) = b(k,145) - lu(k,2335) * b(k,269) + b(k,143) = b(k,143) - lu(k,2334) * b(k,269) + b(k,141) = b(k,141) - lu(k,2333) * b(k,269) + b(k,140) = b(k,140) - lu(k,2332) * b(k,269) + b(k,139) = b(k,139) - lu(k,2331) * b(k,269) + b(k,129) = b(k,129) - lu(k,2330) * b(k,269) + b(k,114) = b(k,114) - lu(k,2329) * b(k,269) + b(k,102) = b(k,102) - lu(k,2328) * b(k,269) + b(k,86) = b(k,86) - lu(k,2327) * b(k,269) + b(k,85) = b(k,85) - lu(k,2326) * b(k,269) + b(k,81) = b(k,81) - lu(k,2325) * b(k,269) + b(k,79) = b(k,79) - lu(k,2324) * b(k,269) + b(k,78) = b(k,78) - lu(k,2323) * b(k,269) + b(k,77) = b(k,77) - lu(k,2322) * b(k,269) + b(k,76) = b(k,76) - lu(k,2321) * b(k,269) + b(k,75) = b(k,75) - lu(k,2320) * b(k,269) + b(k,74) = b(k,74) - lu(k,2319) * b(k,269) + b(k,73) = b(k,73) - lu(k,2318) * b(k,269) + b(k,72) = b(k,72) - lu(k,2317) * b(k,269) + b(k,71) = b(k,71) - lu(k,2316) * b(k,269) + b(k,70) = b(k,70) - lu(k,2315) * b(k,269) + b(k,69) = b(k,69) - lu(k,2314) * b(k,269) + b(k,68) = b(k,68) - lu(k,2313) * b(k,269) + b(k,67) = b(k,67) - lu(k,2312) * b(k,269) + b(k,66) = b(k,66) - lu(k,2311) * b(k,269) + b(k,64) = b(k,64) - lu(k,2310) * b(k,269) + b(k,63) = b(k,63) - lu(k,2309) * b(k,269) + b(k,62) = b(k,62) - lu(k,2308) * b(k,269) + b(k,61) = b(k,61) - lu(k,2307) * b(k,269) + b(k,60) = b(k,60) - lu(k,2306) * b(k,269) + b(k,59) = b(k,59) - lu(k,2305) * b(k,269) + 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,268) = b(k,268) * lu(k,2300) + b(k,267) = b(k,267) - lu(k,2299) * b(k,268) + b(k,266) = b(k,266) - lu(k,2298) * b(k,268) + b(k,265) = b(k,265) - lu(k,2297) * b(k,268) + b(k,264) = b(k,264) - lu(k,2296) * b(k,268) + b(k,263) = b(k,263) - lu(k,2295) * b(k,268) + b(k,262) = b(k,262) - lu(k,2294) * b(k,268) + b(k,261) = b(k,261) - lu(k,2293) * b(k,268) + b(k,260) = b(k,260) - lu(k,2292) * b(k,268) + b(k,259) = b(k,259) - lu(k,2291) * b(k,268) + b(k,258) = b(k,258) - lu(k,2290) * b(k,268) + b(k,257) = b(k,257) - lu(k,2289) * b(k,268) + b(k,256) = b(k,256) - lu(k,2288) * b(k,268) + b(k,255) = b(k,255) - lu(k,2287) * b(k,268) + b(k,254) = b(k,254) - lu(k,2286) * b(k,268) + b(k,252) = b(k,252) - lu(k,2285) * b(k,268) + b(k,250) = b(k,250) - lu(k,2284) * b(k,268) + b(k,249) = b(k,249) - lu(k,2283) * b(k,268) + b(k,248) = b(k,248) - lu(k,2282) * b(k,268) + b(k,247) = b(k,247) - lu(k,2281) * b(k,268) + b(k,246) = b(k,246) - lu(k,2280) * b(k,268) + b(k,245) = b(k,245) - lu(k,2279) * b(k,268) + b(k,244) = b(k,244) - lu(k,2278) * b(k,268) + b(k,243) = b(k,243) - lu(k,2277) * b(k,268) + b(k,242) = b(k,242) - lu(k,2276) * b(k,268) + b(k,241) = b(k,241) - lu(k,2275) * b(k,268) + b(k,240) = b(k,240) - lu(k,2274) * b(k,268) + b(k,239) = b(k,239) - lu(k,2273) * b(k,268) + b(k,238) = b(k,238) - lu(k,2272) * b(k,268) + b(k,237) = b(k,237) - lu(k,2271) * b(k,268) + b(k,236) = b(k,236) - lu(k,2270) * b(k,268) + b(k,235) = b(k,235) - lu(k,2269) * b(k,268) + b(k,234) = b(k,234) - lu(k,2268) * b(k,268) + b(k,233) = b(k,233) - lu(k,2267) * b(k,268) + b(k,232) = b(k,232) - lu(k,2266) * b(k,268) + b(k,231) = b(k,231) - lu(k,2265) * b(k,268) + b(k,230) = b(k,230) - lu(k,2264) * b(k,268) + b(k,229) = b(k,229) - lu(k,2263) * b(k,268) + b(k,227) = b(k,227) - lu(k,2262) * b(k,268) + b(k,226) = b(k,226) - lu(k,2261) * b(k,268) + b(k,225) = b(k,225) - lu(k,2260) * b(k,268) + b(k,224) = b(k,224) - lu(k,2259) * b(k,268) + b(k,223) = b(k,223) - lu(k,2258) * b(k,268) + b(k,222) = b(k,222) - lu(k,2257) * b(k,268) + b(k,221) = b(k,221) - lu(k,2256) * b(k,268) + b(k,219) = b(k,219) - lu(k,2255) * b(k,268) + b(k,216) = b(k,216) - lu(k,2254) * b(k,268) + b(k,213) = b(k,213) - lu(k,2253) * b(k,268) + b(k,212) = b(k,212) - lu(k,2252) * b(k,268) + b(k,179) = b(k,179) - lu(k,2251) * b(k,268) + b(k,147) = b(k,147) - lu(k,2250) * b(k,268) + b(k,142) = b(k,142) - lu(k,2249) * b(k,268) + b(k,136) = b(k,136) - lu(k,2248) * b(k,268) + b(k,134) = b(k,134) - lu(k,2247) * b(k,268) + b(k,70) = b(k,70) - lu(k,2246) * b(k,268) + b(k,69) = b(k,69) - lu(k,2245) * b(k,268) + b(k,267) = b(k,267) * lu(k,2239) + b(k,266) = b(k,266) - lu(k,2238) * b(k,267) + b(k,265) = b(k,265) - lu(k,2237) * b(k,267) + b(k,264) = b(k,264) - lu(k,2236) * b(k,267) + b(k,263) = b(k,263) - lu(k,2235) * b(k,267) + b(k,262) = b(k,262) - lu(k,2234) * b(k,267) + b(k,261) = b(k,261) - lu(k,2233) * b(k,267) + b(k,260) = b(k,260) - lu(k,2232) * b(k,267) + b(k,259) = b(k,259) - lu(k,2231) * b(k,267) + b(k,258) = b(k,258) - lu(k,2230) * b(k,267) + b(k,257) = b(k,257) - lu(k,2229) * b(k,267) + b(k,256) = b(k,256) - lu(k,2228) * b(k,267) + b(k,255) = b(k,255) - lu(k,2227) * b(k,267) + b(k,254) = b(k,254) - lu(k,2226) * b(k,267) + b(k,250) = b(k,250) - lu(k,2225) * b(k,267) + b(k,249) = b(k,249) - lu(k,2224) * b(k,267) + b(k,248) = b(k,248) - lu(k,2223) * b(k,267) + b(k,247) = b(k,247) - lu(k,2222) * b(k,267) + b(k,246) = b(k,246) - lu(k,2221) * b(k,267) + b(k,245) = b(k,245) - lu(k,2220) * b(k,267) + b(k,244) = b(k,244) - lu(k,2219) * b(k,267) + b(k,243) = b(k,243) - lu(k,2218) * b(k,267) + b(k,242) = b(k,242) - lu(k,2217) * b(k,267) + b(k,241) = b(k,241) - lu(k,2216) * b(k,267) + b(k,240) = b(k,240) - lu(k,2215) * b(k,267) + b(k,239) = b(k,239) - lu(k,2214) * b(k,267) + b(k,238) = b(k,238) - lu(k,2213) * b(k,267) + b(k,237) = b(k,237) - lu(k,2212) * b(k,267) + b(k,236) = b(k,236) - lu(k,2211) * b(k,267) + b(k,235) = b(k,235) - lu(k,2210) * b(k,267) + b(k,234) = b(k,234) - lu(k,2209) * b(k,267) + b(k,233) = b(k,233) - lu(k,2208) * b(k,267) + b(k,231) = b(k,231) - lu(k,2207) * b(k,267) + b(k,230) = b(k,230) - lu(k,2206) * b(k,267) + b(k,229) = b(k,229) - lu(k,2205) * b(k,267) + b(k,227) = b(k,227) - lu(k,2204) * b(k,267) + b(k,226) = b(k,226) - lu(k,2203) * b(k,267) + b(k,225) = b(k,225) - lu(k,2202) * b(k,267) + b(k,224) = b(k,224) - lu(k,2201) * b(k,267) + b(k,223) = b(k,223) - lu(k,2200) * b(k,267) + b(k,220) = b(k,220) - lu(k,2199) * b(k,267) + b(k,218) = b(k,218) - lu(k,2198) * b(k,267) + b(k,217) = b(k,217) - lu(k,2197) * b(k,267) + b(k,216) = b(k,216) - lu(k,2196) * b(k,267) + b(k,215) = b(k,215) - lu(k,2195) * b(k,267) + b(k,212) = b(k,212) - lu(k,2194) * b(k,267) + b(k,211) = b(k,211) - lu(k,2193) * b(k,267) + b(k,210) = b(k,210) - lu(k,2192) * b(k,267) + b(k,209) = b(k,209) - lu(k,2191) * b(k,267) + b(k,206) = b(k,206) - lu(k,2190) * b(k,267) + b(k,203) = b(k,203) - lu(k,2189) * b(k,267) + b(k,201) = b(k,201) - lu(k,2188) * b(k,267) + b(k,200) = b(k,200) - lu(k,2187) * b(k,267) + b(k,199) = b(k,199) - lu(k,2186) * b(k,267) + b(k,198) = b(k,198) - lu(k,2185) * b(k,267) + b(k,191) = b(k,191) - lu(k,2184) * b(k,267) + b(k,190) = b(k,190) - lu(k,2183) * b(k,267) + b(k,188) = b(k,188) - lu(k,2182) * b(k,267) + b(k,187) = b(k,187) - lu(k,2181) * b(k,267) + b(k,186) = b(k,186) - lu(k,2180) * b(k,267) + b(k,182) = b(k,182) - lu(k,2179) * b(k,267) + b(k,179) = b(k,179) - lu(k,2178) * b(k,267) + b(k,178) = b(k,178) - lu(k,2177) * b(k,267) + b(k,172) = b(k,172) - lu(k,2176) * b(k,267) + b(k,171) = b(k,171) - lu(k,2175) * b(k,267) + b(k,170) = b(k,170) - lu(k,2174) * b(k,267) + b(k,168) = b(k,168) - lu(k,2173) * b(k,267) + b(k,166) = b(k,166) - lu(k,2172) * b(k,267) + b(k,163) = b(k,163) - lu(k,2171) * b(k,267) + b(k,162) = b(k,162) - lu(k,2170) * b(k,267) + b(k,161) = b(k,161) - lu(k,2169) * b(k,267) + b(k,160) = b(k,160) - lu(k,2168) * b(k,267) + b(k,159) = b(k,159) - lu(k,2167) * b(k,267) + b(k,144) = b(k,144) - lu(k,2166) * b(k,267) + b(k,142) = b(k,142) - lu(k,2165) * b(k,267) + b(k,133) = b(k,133) - lu(k,2164) * b(k,267) + b(k,120) = b(k,120) - lu(k,2163) * b(k,267) + b(k,119) = b(k,119) - lu(k,2162) * b(k,267) + b(k,86) = b(k,86) - lu(k,2161) * b(k,267) + b(k,85) = b(k,85) - lu(k,2160) * b(k,267) + b(k,81) = b(k,81) - lu(k,2159) * b(k,267) + b(k,79) = b(k,79) - lu(k,2158) * b(k,267) + b(k,78) = b(k,78) - lu(k,2157) * b(k,267) + b(k,77) = b(k,77) - lu(k,2156) * b(k,267) + b(k,76) = b(k,76) - lu(k,2155) * b(k,267) + b(k,75) = b(k,75) - lu(k,2154) * b(k,267) + b(k,74) = b(k,74) - lu(k,2153) * b(k,267) + b(k,73) = b(k,73) - lu(k,2152) * b(k,267) + b(k,72) = b(k,72) - lu(k,2151) * b(k,267) + b(k,71) = b(k,71) - lu(k,2150) * b(k,267) + b(k,70) = b(k,70) - lu(k,2149) * b(k,267) + b(k,69) = b(k,69) - lu(k,2148) * b(k,267) + b(k,68) = b(k,68) - lu(k,2147) * b(k,267) + b(k,67) = b(k,67) - lu(k,2146) * b(k,267) + b(k,66) = b(k,66) - lu(k,2145) * b(k,267) + b(k,64) = b(k,64) - lu(k,2144) * b(k,267) + b(k,63) = b(k,63) - lu(k,2143) * b(k,267) + b(k,62) = b(k,62) - lu(k,2142) * b(k,267) + b(k,61) = b(k,61) - lu(k,2141) * b(k,267) + b(k,60) = b(k,60) - lu(k,2140) * b(k,267) + b(k,59) = b(k,59) - lu(k,2139) * b(k,267) + b(k,266) = b(k,266) * lu(k,2132) + b(k,265) = b(k,265) - lu(k,2131) * b(k,266) + b(k,264) = b(k,264) - lu(k,2130) * b(k,266) + b(k,263) = b(k,263) - lu(k,2129) * b(k,266) + b(k,262) = b(k,262) - lu(k,2128) * b(k,266) + b(k,261) = b(k,261) - lu(k,2127) * b(k,266) + b(k,260) = b(k,260) - lu(k,2126) * b(k,266) + b(k,259) = b(k,259) - lu(k,2125) * b(k,266) + b(k,258) = b(k,258) - lu(k,2124) * b(k,266) + b(k,256) = b(k,256) - lu(k,2123) * b(k,266) + b(k,255) = b(k,255) - lu(k,2122) * b(k,266) + b(k,254) = b(k,254) - lu(k,2121) * b(k,266) + b(k,253) = b(k,253) - lu(k,2120) * b(k,266) + b(k,252) = b(k,252) - lu(k,2119) * b(k,266) + b(k,228) = b(k,228) - lu(k,2118) * b(k,266) + b(k,219) = b(k,219) - lu(k,2117) * b(k,266) + b(k,208) = b(k,208) - lu(k,2116) * b(k,266) + b(k,138) = b(k,138) - lu(k,2115) * b(k,266) + b(k,118) = b(k,118) - lu(k,2114) * b(k,266) + b(k,107) = b(k,107) - lu(k,2113) * b(k,266) + b(k,90) = b(k,90) - lu(k,2112) * b(k,266) + b(k,265) = b(k,265) * lu(k,2104) + b(k,264) = b(k,264) - lu(k,2103) * b(k,265) + b(k,263) = b(k,263) - lu(k,2102) * b(k,265) + b(k,262) = b(k,262) - lu(k,2101) * b(k,265) + b(k,261) = b(k,261) - lu(k,2100) * b(k,265) + b(k,260) = b(k,260) - lu(k,2099) * b(k,265) + b(k,259) = b(k,259) - lu(k,2098) * b(k,265) + b(k,258) = b(k,258) - lu(k,2097) * b(k,265) + b(k,257) = b(k,257) - lu(k,2096) * b(k,265) + b(k,256) = b(k,256) - lu(k,2095) * b(k,265) + b(k,255) = b(k,255) - lu(k,2094) * b(k,265) + b(k,254) = b(k,254) - lu(k,2093) * b(k,265) + b(k,252) = b(k,252) - lu(k,2092) * b(k,265) + b(k,250) = b(k,250) - lu(k,2091) * b(k,265) + b(k,249) = b(k,249) - lu(k,2090) * b(k,265) + b(k,248) = b(k,248) - lu(k,2089) * b(k,265) + b(k,247) = b(k,247) - lu(k,2088) * b(k,265) + b(k,246) = b(k,246) - lu(k,2087) * b(k,265) + b(k,245) = b(k,245) - lu(k,2086) * b(k,265) + b(k,244) = b(k,244) - lu(k,2085) * b(k,265) + b(k,243) = b(k,243) - lu(k,2084) * b(k,265) + b(k,242) = b(k,242) - lu(k,2083) * b(k,265) + b(k,241) = b(k,241) - lu(k,2082) * b(k,265) + b(k,239) = b(k,239) - lu(k,2081) * b(k,265) + b(k,238) = b(k,238) - lu(k,2080) * b(k,265) + b(k,236) = b(k,236) - lu(k,2079) * b(k,265) + b(k,235) = b(k,235) - lu(k,2078) * b(k,265) + b(k,234) = b(k,234) - lu(k,2077) * b(k,265) + b(k,233) = b(k,233) - lu(k,2076) * b(k,265) + b(k,232) = b(k,232) - lu(k,2075) * b(k,265) + b(k,230) = b(k,230) - lu(k,2074) * b(k,265) + b(k,229) = b(k,229) - lu(k,2073) * b(k,265) + b(k,227) = b(k,227) - lu(k,2072) * b(k,265) + b(k,226) = b(k,226) - lu(k,2071) * b(k,265) + b(k,225) = b(k,225) - lu(k,2070) * b(k,265) + b(k,224) = b(k,224) - lu(k,2069) * b(k,265) + b(k,223) = b(k,223) - lu(k,2068) * b(k,265) + b(k,222) = b(k,222) - lu(k,2067) * b(k,265) + b(k,221) = b(k,221) - lu(k,2066) * b(k,265) + b(k,219) = b(k,219) - lu(k,2065) * b(k,265) + b(k,216) = b(k,216) - lu(k,2064) * b(k,265) + b(k,213) = b(k,213) - lu(k,2063) * b(k,265) + b(k,203) = b(k,203) - lu(k,2062) * b(k,265) + b(k,197) = b(k,197) - lu(k,2061) * b(k,265) + b(k,194) = b(k,194) - lu(k,2060) * b(k,265) + b(k,188) = b(k,188) - lu(k,2059) * b(k,265) + b(k,174) = b(k,174) - lu(k,2058) * b(k,265) + b(k,166) = b(k,166) - lu(k,2057) * b(k,265) + b(k,149) = b(k,149) - lu(k,2056) * b(k,265) + b(k,117) = b(k,117) - lu(k,2055) * b(k,265) + b(k,109) = b(k,109) - lu(k,2054) * b(k,265) + b(k,108) = b(k,108) - lu(k,2053) * b(k,265) + b(k,70) = b(k,70) - lu(k,2052) * b(k,265) + b(k,69) = b(k,69) - lu(k,2051) * b(k,265) + b(k,68) = b(k,68) - lu(k,2050) * b(k,265) + b(k,67) = b(k,67) - lu(k,2049) * b(k,265) + b(k,66) = b(k,66) - lu(k,2048) * b(k,265) + end do + end subroutine lu_slv08 + subroutine lu_slv09( 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,264) = b(k,264) * lu(k,2039) + b(k,263) = b(k,263) - lu(k,2038) * b(k,264) + b(k,262) = b(k,262) - lu(k,2037) * b(k,264) + b(k,261) = b(k,261) - lu(k,2036) * b(k,264) + b(k,260) = b(k,260) - lu(k,2035) * b(k,264) + b(k,259) = b(k,259) - lu(k,2034) * b(k,264) + b(k,258) = b(k,258) - lu(k,2033) * b(k,264) + b(k,257) = b(k,257) - lu(k,2032) * b(k,264) + b(k,256) = b(k,256) - lu(k,2031) * b(k,264) + b(k,255) = b(k,255) - lu(k,2030) * b(k,264) + b(k,254) = b(k,254) - lu(k,2029) * b(k,264) + b(k,253) = b(k,253) - lu(k,2028) * b(k,264) + b(k,251) = b(k,251) - lu(k,2027) * b(k,264) + b(k,214) = b(k,214) - lu(k,2026) * b(k,264) + b(k,207) = b(k,207) - lu(k,2025) * b(k,264) + b(k,180) = b(k,180) - lu(k,2024) * b(k,264) + b(k,165) = b(k,165) - lu(k,2023) * b(k,264) + b(k,153) = b(k,153) - lu(k,2022) * b(k,264) + b(k,137) = b(k,137) - lu(k,2021) * b(k,264) + b(k,126) = b(k,126) - lu(k,2020) * b(k,264) + b(k,125) = b(k,125) - lu(k,2019) * b(k,264) + b(k,124) = b(k,124) - lu(k,2018) * b(k,264) + b(k,123) = b(k,123) - lu(k,2017) * b(k,264) + b(k,122) = b(k,122) - lu(k,2016) * b(k,264) + b(k,110) = b(k,110) - lu(k,2015) * b(k,264) + b(k,109) = b(k,109) - lu(k,2014) * b(k,264) + b(k,101) = b(k,101) - lu(k,2013) * b(k,264) + b(k,100) = b(k,100) - lu(k,2012) * b(k,264) + b(k,99) = b(k,99) - lu(k,2011) * b(k,264) + b(k,98) = b(k,98) - lu(k,2010) * b(k,264) + b(k,94) = b(k,94) - lu(k,2009) * b(k,264) + b(k,93) = b(k,93) - lu(k,2008) * b(k,264) + b(k,92) = b(k,92) - lu(k,2007) * b(k,264) + b(k,91) = b(k,91) - lu(k,2006) * b(k,264) + b(k,88) = b(k,88) - lu(k,2005) * b(k,264) + b(k,263) = b(k,263) * lu(k,1995) + b(k,262) = b(k,262) - lu(k,1994) * b(k,263) + b(k,261) = b(k,261) - lu(k,1993) * b(k,263) + b(k,260) = b(k,260) - lu(k,1992) * b(k,263) + b(k,259) = b(k,259) - lu(k,1991) * b(k,263) + b(k,258) = b(k,258) - lu(k,1990) * b(k,263) + b(k,257) = b(k,257) - lu(k,1989) * b(k,263) + b(k,256) = b(k,256) - lu(k,1988) * b(k,263) + b(k,255) = b(k,255) - lu(k,1987) * b(k,263) + b(k,254) = b(k,254) - lu(k,1986) * b(k,263) + b(k,253) = b(k,253) - lu(k,1985) * b(k,263) + b(k,251) = b(k,251) - lu(k,1984) * b(k,263) + b(k,250) = b(k,250) - lu(k,1983) * b(k,263) + b(k,249) = b(k,249) - lu(k,1982) * b(k,263) + b(k,243) = b(k,243) - lu(k,1981) * b(k,263) + b(k,239) = b(k,239) - lu(k,1980) * b(k,263) + b(k,235) = b(k,235) - lu(k,1979) * b(k,263) + b(k,234) = b(k,234) - lu(k,1978) * b(k,263) + b(k,233) = b(k,233) - lu(k,1977) * b(k,263) + b(k,228) = b(k,228) - lu(k,1976) * b(k,263) + b(k,227) = b(k,227) - lu(k,1975) * b(k,263) + b(k,224) = b(k,224) - lu(k,1974) * b(k,263) + b(k,218) = b(k,218) - lu(k,1973) * b(k,263) + b(k,216) = b(k,216) - lu(k,1972) * b(k,263) + b(k,215) = b(k,215) - lu(k,1971) * b(k,263) + b(k,208) = b(k,208) - lu(k,1970) * b(k,263) + b(k,203) = b(k,203) - lu(k,1969) * b(k,263) + b(k,185) = b(k,185) - lu(k,1968) * b(k,263) + b(k,180) = b(k,180) - lu(k,1967) * b(k,263) + b(k,174) = b(k,174) - lu(k,1966) * b(k,263) + b(k,165) = b(k,165) - lu(k,1965) * b(k,263) + b(k,153) = b(k,153) - lu(k,1964) * b(k,263) + b(k,146) = b(k,146) - lu(k,1963) * b(k,263) + b(k,132) = b(k,132) - lu(k,1962) * b(k,263) + b(k,131) = b(k,131) - lu(k,1961) * b(k,263) + b(k,130) = b(k,130) - lu(k,1960) * b(k,263) + b(k,107) = b(k,107) - lu(k,1959) * b(k,263) + b(k,262) = b(k,262) * lu(k,1948) + b(k,261) = b(k,261) - lu(k,1947) * b(k,262) + b(k,260) = b(k,260) - lu(k,1946) * b(k,262) + b(k,259) = b(k,259) - lu(k,1945) * b(k,262) + b(k,258) = b(k,258) - lu(k,1944) * b(k,262) + b(k,257) = b(k,257) - lu(k,1943) * b(k,262) + b(k,256) = b(k,256) - lu(k,1942) * b(k,262) + b(k,255) = b(k,255) - lu(k,1941) * b(k,262) + b(k,254) = b(k,254) - lu(k,1940) * b(k,262) + b(k,253) = b(k,253) - lu(k,1939) * b(k,262) + b(k,252) = b(k,252) - lu(k,1938) * b(k,262) + b(k,251) = b(k,251) - lu(k,1937) * b(k,262) + b(k,250) = b(k,250) - lu(k,1936) * b(k,262) + b(k,234) = b(k,234) - lu(k,1935) * b(k,262) + b(k,228) = b(k,228) - lu(k,1934) * b(k,262) + b(k,220) = b(k,220) - lu(k,1933) * b(k,262) + b(k,219) = b(k,219) - lu(k,1932) * b(k,262) + b(k,211) = b(k,211) - lu(k,1931) * b(k,262) + b(k,210) = b(k,210) - lu(k,1930) * b(k,262) + b(k,209) = b(k,209) - lu(k,1929) * b(k,262) + b(k,208) = b(k,208) - lu(k,1928) * b(k,262) + b(k,207) = b(k,207) - lu(k,1927) * b(k,262) + b(k,204) = b(k,204) - lu(k,1926) * b(k,262) + b(k,202) = b(k,202) - lu(k,1925) * b(k,262) + b(k,197) = b(k,197) - lu(k,1924) * b(k,262) + b(k,193) = b(k,193) - lu(k,1923) * b(k,262) + b(k,185) = b(k,185) - lu(k,1922) * b(k,262) + b(k,175) = b(k,175) - lu(k,1921) * b(k,262) + b(k,173) = b(k,173) - lu(k,1920) * b(k,262) + b(k,169) = b(k,169) - lu(k,1919) * b(k,262) + b(k,148) = b(k,148) - lu(k,1918) * b(k,262) + b(k,109) = b(k,109) - lu(k,1917) * b(k,262) + b(k,108) = b(k,108) - lu(k,1916) * b(k,262) + b(k,261) = b(k,261) * lu(k,1904) + b(k,260) = b(k,260) - lu(k,1903) * b(k,261) + b(k,259) = b(k,259) - lu(k,1902) * b(k,261) + b(k,258) = b(k,258) - lu(k,1901) * b(k,261) + b(k,257) = b(k,257) - lu(k,1900) * b(k,261) + b(k,256) = b(k,256) - lu(k,1899) * b(k,261) + b(k,255) = b(k,255) - lu(k,1898) * b(k,261) + b(k,254) = b(k,254) - lu(k,1897) * b(k,261) + b(k,253) = b(k,253) - lu(k,1896) * b(k,261) + b(k,252) = b(k,252) - lu(k,1895) * b(k,261) + b(k,251) = b(k,251) - lu(k,1894) * b(k,261) + b(k,250) = b(k,250) - lu(k,1893) * b(k,261) + b(k,249) = b(k,249) - lu(k,1892) * b(k,261) + b(k,248) = b(k,248) - lu(k,1891) * b(k,261) + b(k,247) = b(k,247) - lu(k,1890) * b(k,261) + b(k,246) = b(k,246) - lu(k,1889) * b(k,261) + b(k,245) = b(k,245) - lu(k,1888) * b(k,261) + b(k,244) = b(k,244) - lu(k,1887) * b(k,261) + b(k,243) = b(k,243) - lu(k,1886) * b(k,261) + b(k,242) = b(k,242) - lu(k,1885) * b(k,261) + b(k,241) = b(k,241) - lu(k,1884) * b(k,261) + b(k,240) = b(k,240) - lu(k,1883) * b(k,261) + b(k,239) = b(k,239) - lu(k,1882) * b(k,261) + b(k,238) = b(k,238) - lu(k,1881) * b(k,261) + b(k,237) = b(k,237) - lu(k,1880) * b(k,261) + b(k,236) = b(k,236) - lu(k,1879) * b(k,261) + b(k,235) = b(k,235) - lu(k,1878) * b(k,261) + b(k,234) = b(k,234) - lu(k,1877) * b(k,261) + b(k,233) = b(k,233) - lu(k,1876) * b(k,261) + b(k,232) = b(k,232) - lu(k,1875) * b(k,261) + b(k,231) = b(k,231) - lu(k,1874) * b(k,261) + b(k,230) = b(k,230) - lu(k,1873) * b(k,261) + b(k,229) = b(k,229) - lu(k,1872) * b(k,261) + b(k,228) = b(k,228) - lu(k,1871) * b(k,261) + b(k,227) = b(k,227) - lu(k,1870) * b(k,261) + b(k,226) = b(k,226) - lu(k,1869) * b(k,261) + b(k,225) = b(k,225) - lu(k,1868) * b(k,261) + b(k,224) = b(k,224) - lu(k,1867) * b(k,261) + b(k,223) = b(k,223) - lu(k,1866) * b(k,261) + b(k,222) = b(k,222) - lu(k,1865) * b(k,261) + b(k,221) = b(k,221) - lu(k,1864) * b(k,261) + b(k,220) = b(k,220) - lu(k,1863) * b(k,261) + b(k,219) = b(k,219) - lu(k,1862) * b(k,261) + b(k,218) = b(k,218) - lu(k,1861) * b(k,261) + b(k,217) = b(k,217) - lu(k,1860) * b(k,261) + b(k,216) = b(k,216) - lu(k,1859) * b(k,261) + b(k,215) = b(k,215) - lu(k,1858) * b(k,261) + b(k,214) = b(k,214) - lu(k,1857) * b(k,261) + b(k,213) = b(k,213) - lu(k,1856) * b(k,261) + b(k,212) = b(k,212) - lu(k,1855) * b(k,261) + b(k,208) = b(k,208) - lu(k,1854) * b(k,261) + b(k,207) = b(k,207) - lu(k,1853) * b(k,261) + b(k,206) = b(k,206) - lu(k,1852) * b(k,261) + b(k,205) = b(k,205) - lu(k,1851) * b(k,261) + b(k,203) = b(k,203) - lu(k,1850) * b(k,261) + b(k,201) = b(k,201) - lu(k,1849) * b(k,261) + b(k,200) = b(k,200) - lu(k,1848) * b(k,261) + b(k,199) = b(k,199) - lu(k,1847) * b(k,261) + b(k,198) = b(k,198) - lu(k,1846) * b(k,261) + b(k,197) = b(k,197) - lu(k,1845) * b(k,261) + b(k,196) = b(k,196) - lu(k,1844) * b(k,261) + b(k,195) = b(k,195) - lu(k,1843) * b(k,261) + b(k,194) = b(k,194) - lu(k,1842) * b(k,261) + b(k,192) = b(k,192) - lu(k,1841) * b(k,261) + b(k,191) = b(k,191) - lu(k,1840) * b(k,261) + b(k,190) = b(k,190) - lu(k,1839) * b(k,261) + b(k,189) = b(k,189) - lu(k,1838) * b(k,261) + b(k,188) = b(k,188) - lu(k,1837) * b(k,261) + b(k,187) = b(k,187) - lu(k,1836) * b(k,261) + b(k,186) = b(k,186) - lu(k,1835) * b(k,261) + b(k,185) = b(k,185) - lu(k,1834) * b(k,261) + b(k,184) = b(k,184) - lu(k,1833) * b(k,261) + b(k,183) = b(k,183) - lu(k,1832) * b(k,261) + b(k,182) = b(k,182) - lu(k,1831) * b(k,261) + b(k,181) = b(k,181) - lu(k,1830) * b(k,261) + b(k,180) = b(k,180) - lu(k,1829) * b(k,261) + b(k,179) = b(k,179) - lu(k,1828) * b(k,261) + b(k,178) = b(k,178) - lu(k,1827) * b(k,261) + b(k,177) = b(k,177) - lu(k,1826) * b(k,261) + b(k,176) = b(k,176) - lu(k,1825) * b(k,261) + b(k,174) = b(k,174) - lu(k,1824) * b(k,261) + b(k,172) = b(k,172) - lu(k,1823) * b(k,261) + b(k,171) = b(k,171) - lu(k,1822) * b(k,261) + b(k,170) = b(k,170) - lu(k,1821) * b(k,261) + b(k,168) = b(k,168) - lu(k,1820) * b(k,261) + b(k,167) = b(k,167) - lu(k,1819) * b(k,261) + b(k,166) = b(k,166) - lu(k,1818) * b(k,261) + b(k,165) = b(k,165) - lu(k,1817) * b(k,261) + b(k,164) = b(k,164) - lu(k,1816) * b(k,261) + b(k,162) = b(k,162) - lu(k,1815) * b(k,261) + b(k,161) = b(k,161) - lu(k,1814) * b(k,261) + b(k,159) = b(k,159) - lu(k,1813) * b(k,261) + b(k,158) = b(k,158) - lu(k,1812) * b(k,261) + b(k,157) = b(k,157) - lu(k,1811) * b(k,261) + b(k,156) = b(k,156) - lu(k,1810) * b(k,261) + b(k,155) = b(k,155) - lu(k,1809) * b(k,261) + b(k,154) = b(k,154) - lu(k,1808) * b(k,261) + b(k,153) = b(k,153) - lu(k,1807) * b(k,261) + b(k,152) = b(k,152) - lu(k,1806) * b(k,261) + b(k,151) = b(k,151) - lu(k,1805) * b(k,261) + b(k,150) = b(k,150) - lu(k,1804) * b(k,261) + b(k,148) = b(k,148) - lu(k,1803) * b(k,261) + b(k,147) = b(k,147) - lu(k,1802) * b(k,261) + b(k,146) = b(k,146) - lu(k,1801) * b(k,261) + b(k,145) = b(k,145) - lu(k,1800) * b(k,261) + b(k,143) = b(k,143) - lu(k,1799) * b(k,261) + b(k,142) = b(k,142) - lu(k,1798) * b(k,261) + b(k,141) = b(k,141) - lu(k,1797) * b(k,261) + b(k,140) = b(k,140) - lu(k,1796) * b(k,261) + b(k,139) = b(k,139) - lu(k,1795) * b(k,261) + b(k,137) = b(k,137) - lu(k,1794) * b(k,261) + b(k,136) = b(k,136) - lu(k,1793) * b(k,261) + b(k,132) = b(k,132) - lu(k,1792) * b(k,261) + b(k,131) = b(k,131) - lu(k,1791) * b(k,261) + b(k,130) = b(k,130) - lu(k,1790) * b(k,261) + b(k,129) = b(k,129) - lu(k,1789) * b(k,261) + b(k,128) = b(k,128) - lu(k,1788) * b(k,261) + b(k,127) = b(k,127) - lu(k,1787) * b(k,261) + b(k,125) = b(k,125) - lu(k,1786) * b(k,261) + b(k,124) = b(k,124) - lu(k,1785) * b(k,261) + b(k,123) = b(k,123) - lu(k,1784) * b(k,261) + b(k,122) = b(k,122) - lu(k,1783) * b(k,261) + b(k,121) = b(k,121) - lu(k,1782) * b(k,261) + b(k,120) = b(k,120) - lu(k,1781) * b(k,261) + b(k,119) = b(k,119) - lu(k,1780) * b(k,261) + b(k,117) = b(k,117) - lu(k,1779) * b(k,261) + b(k,116) = b(k,116) - lu(k,1778) * b(k,261) + b(k,115) = b(k,115) - lu(k,1777) * b(k,261) + b(k,114) = b(k,114) - lu(k,1776) * b(k,261) + b(k,113) = b(k,113) - lu(k,1775) * b(k,261) + b(k,112) = b(k,112) - lu(k,1774) * b(k,261) + b(k,111) = b(k,111) - lu(k,1773) * b(k,261) + b(k,110) = b(k,110) - lu(k,1772) * b(k,261) + b(k,106) = b(k,106) - lu(k,1771) * b(k,261) + b(k,105) = b(k,105) - lu(k,1770) * b(k,261) + b(k,104) = b(k,104) - lu(k,1769) * b(k,261) + b(k,96) = b(k,96) - lu(k,1768) * b(k,261) + b(k,95) = b(k,95) - lu(k,1767) * b(k,261) + b(k,89) = b(k,89) - lu(k,1766) * b(k,261) + b(k,87) = b(k,87) - lu(k,1765) * b(k,261) + b(k,86) = b(k,86) - lu(k,1764) * b(k,261) + b(k,85) = b(k,85) - lu(k,1763) * b(k,261) + b(k,84) = b(k,84) - lu(k,1762) * b(k,261) + b(k,83) = b(k,83) - lu(k,1761) * b(k,261) + b(k,81) = b(k,81) - lu(k,1760) * b(k,261) + b(k,80) = b(k,80) - lu(k,1759) * b(k,261) + b(k,79) = b(k,79) - lu(k,1758) * b(k,261) + b(k,78) = b(k,78) - lu(k,1757) * b(k,261) + b(k,77) = b(k,77) - lu(k,1756) * b(k,261) + b(k,76) = b(k,76) - lu(k,1755) * b(k,261) + b(k,75) = b(k,75) - lu(k,1754) * b(k,261) + b(k,74) = b(k,74) - lu(k,1753) * b(k,261) + b(k,73) = b(k,73) - lu(k,1752) * b(k,261) + b(k,72) = b(k,72) - lu(k,1751) * b(k,261) + b(k,71) = b(k,71) - lu(k,1750) * b(k,261) + b(k,65) = b(k,65) - lu(k,1749) * b(k,261) + b(k,64) = b(k,64) - lu(k,1748) * b(k,261) + b(k,63) = b(k,63) - lu(k,1747) * b(k,261) + b(k,62) = b(k,62) - lu(k,1746) * b(k,261) + b(k,61) = b(k,61) - lu(k,1745) * b(k,261) + b(k,60) = b(k,60) - lu(k,1744) * b(k,261) + b(k,59) = b(k,59) - lu(k,1743) * b(k,261) + end do + end subroutine lu_slv09 + subroutine lu_slv10( 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,260) = b(k,260) * lu(k,1730) + b(k,259) = b(k,259) - lu(k,1729) * b(k,260) + b(k,258) = b(k,258) - lu(k,1728) * b(k,260) + b(k,257) = b(k,257) - lu(k,1727) * b(k,260) + b(k,256) = b(k,256) - lu(k,1726) * b(k,260) + b(k,255) = b(k,255) - lu(k,1725) * b(k,260) + b(k,254) = b(k,254) - lu(k,1724) * b(k,260) + b(k,253) = b(k,253) - lu(k,1723) * b(k,260) + b(k,251) = b(k,251) - lu(k,1722) * b(k,260) + b(k,259) = b(k,259) * lu(k,1708) + b(k,258) = b(k,258) - lu(k,1707) * b(k,259) + b(k,257) = b(k,257) - lu(k,1706) * b(k,259) + b(k,256) = b(k,256) - lu(k,1705) * b(k,259) + b(k,255) = b(k,255) - lu(k,1704) * b(k,259) + b(k,254) = b(k,254) - lu(k,1703) * b(k,259) + b(k,253) = b(k,253) - lu(k,1702) * b(k,259) + b(k,251) = b(k,251) - lu(k,1701) * b(k,259) + b(k,214) = b(k,214) - lu(k,1700) * b(k,259) + b(k,135) = b(k,135) - lu(k,1699) * b(k,259) + b(k,258) = b(k,258) * lu(k,1684) + b(k,257) = b(k,257) - lu(k,1683) * b(k,258) + b(k,256) = b(k,256) - lu(k,1682) * b(k,258) + b(k,255) = b(k,255) - lu(k,1681) * b(k,258) + b(k,250) = b(k,250) - lu(k,1680) * b(k,258) + b(k,249) = b(k,249) - lu(k,1679) * b(k,258) + b(k,248) = b(k,248) - lu(k,1678) * b(k,258) + b(k,247) = b(k,247) - lu(k,1677) * b(k,258) + b(k,246) = b(k,246) - lu(k,1676) * b(k,258) + b(k,245) = b(k,245) - lu(k,1675) * b(k,258) + b(k,244) = b(k,244) - lu(k,1674) * b(k,258) + b(k,243) = b(k,243) - lu(k,1673) * b(k,258) + b(k,242) = b(k,242) - lu(k,1672) * b(k,258) + b(k,241) = b(k,241) - lu(k,1671) * b(k,258) + b(k,240) = b(k,240) - lu(k,1670) * b(k,258) + b(k,239) = b(k,239) - lu(k,1669) * b(k,258) + b(k,238) = b(k,238) - lu(k,1668) * b(k,258) + b(k,236) = b(k,236) - lu(k,1667) * b(k,258) + b(k,235) = b(k,235) - lu(k,1666) * b(k,258) + b(k,234) = b(k,234) - lu(k,1665) * b(k,258) + b(k,233) = b(k,233) - lu(k,1664) * b(k,258) + b(k,231) = b(k,231) - lu(k,1663) * b(k,258) + b(k,230) = b(k,230) - lu(k,1662) * b(k,258) + b(k,229) = b(k,229) - lu(k,1661) * b(k,258) + b(k,227) = b(k,227) - lu(k,1660) * b(k,258) + b(k,226) = b(k,226) - lu(k,1659) * b(k,258) + b(k,225) = b(k,225) - lu(k,1658) * b(k,258) + b(k,224) = b(k,224) - lu(k,1657) * b(k,258) + b(k,218) = b(k,218) - lu(k,1656) * b(k,258) + b(k,215) = b(k,215) - lu(k,1655) * b(k,258) + b(k,212) = b(k,212) - lu(k,1654) * b(k,258) + b(k,205) = b(k,205) - lu(k,1653) * b(k,258) + b(k,194) = b(k,194) - lu(k,1652) * b(k,258) + b(k,187) = b(k,187) - lu(k,1651) * b(k,258) + b(k,155) = b(k,155) - lu(k,1650) * b(k,258) + b(k,152) = b(k,152) - lu(k,1649) * b(k,258) + b(k,142) = b(k,142) - lu(k,1648) * b(k,258) + b(k,128) = b(k,128) - lu(k,1647) * b(k,258) + b(k,257) = b(k,257) * lu(k,1631) + b(k,256) = b(k,256) - lu(k,1630) * b(k,257) + b(k,255) = b(k,255) - lu(k,1629) * b(k,257) + b(k,254) = b(k,254) - lu(k,1628) * b(k,257) + b(k,253) = b(k,253) - lu(k,1627) * b(k,257) + b(k,251) = b(k,251) - lu(k,1626) * b(k,257) + b(k,250) = b(k,250) - lu(k,1625) * b(k,257) + b(k,234) = b(k,234) - lu(k,1624) * b(k,257) + b(k,214) = b(k,214) - lu(k,1623) * b(k,257) + b(k,135) = b(k,135) - lu(k,1622) * b(k,257) + b(k,256) = b(k,256) * lu(k,1607) + b(k,255) = b(k,255) - lu(k,1606) * b(k,256) + b(k,254) = b(k,254) - lu(k,1605) * b(k,256) + b(k,253) = b(k,253) - lu(k,1604) * b(k,256) + b(k,252) = b(k,252) - lu(k,1603) * b(k,256) + b(k,219) = b(k,219) - lu(k,1602) * b(k,256) + b(k,202) = b(k,202) - lu(k,1601) * b(k,256) + b(k,175) = b(k,175) - lu(k,1600) * b(k,256) + b(k,138) = b(k,138) - lu(k,1599) * b(k,256) + b(k,118) = b(k,118) - lu(k,1598) * b(k,256) + b(k,255) = b(k,255) * lu(k,1584) + b(k,254) = b(k,254) - lu(k,1583) * b(k,255) + b(k,252) = b(k,252) - lu(k,1582) * b(k,255) + b(k,250) = b(k,250) - lu(k,1581) * b(k,255) + b(k,235) = b(k,235) - lu(k,1580) * b(k,255) + b(k,234) = b(k,234) - lu(k,1579) * b(k,255) + b(k,220) = b(k,220) - lu(k,1578) * b(k,255) + b(k,219) = b(k,219) - lu(k,1577) * b(k,255) + b(k,211) = b(k,211) - lu(k,1576) * b(k,255) + b(k,210) = b(k,210) - lu(k,1575) * b(k,255) + b(k,209) = b(k,209) - lu(k,1574) * b(k,255) + b(k,204) = b(k,204) - lu(k,1573) * b(k,255) + b(k,197) = b(k,197) - lu(k,1572) * b(k,255) + b(k,193) = b(k,193) - lu(k,1571) * b(k,255) + b(k,173) = b(k,173) - lu(k,1570) * b(k,255) + b(k,169) = b(k,169) - lu(k,1569) * b(k,255) + b(k,163) = b(k,163) - lu(k,1568) * b(k,255) + b(k,109) = b(k,109) - lu(k,1567) * b(k,255) + b(k,108) = b(k,108) - lu(k,1566) * b(k,255) + b(k,254) = b(k,254) * lu(k,1553) + b(k,250) = b(k,250) - lu(k,1552) * b(k,254) + b(k,234) = b(k,234) - lu(k,1551) * b(k,254) + b(k,207) = b(k,207) - lu(k,1550) * b(k,254) + b(k,253) = b(k,253) * lu(k,1537) + b(k,228) = b(k,228) - lu(k,1536) * b(k,253) + b(k,208) = b(k,208) - lu(k,1535) * b(k,253) + b(k,202) = b(k,202) - lu(k,1534) * b(k,253) + b(k,118) = b(k,118) - lu(k,1533) * b(k,253) + b(k,107) = b(k,107) - lu(k,1532) * b(k,253) + b(k,252) = b(k,252) * lu(k,1518) + b(k,219) = b(k,219) - lu(k,1517) * b(k,252) + b(k,197) = b(k,197) - lu(k,1516) * b(k,252) + b(k,138) = b(k,138) - lu(k,1515) * b(k,252) + b(k,251) = b(k,251) * lu(k,1503) + b(k,214) = b(k,214) - lu(k,1502) * b(k,251) + b(k,135) = b(k,135) - lu(k,1501) * b(k,251) + b(k,250) = b(k,250) * lu(k,1492) + b(k,234) = b(k,234) - lu(k,1491) * b(k,250) + b(k,220) = b(k,220) - lu(k,1490) * b(k,250) + b(k,211) = b(k,211) - lu(k,1489) * b(k,250) + b(k,210) = b(k,210) - lu(k,1488) * b(k,250) + b(k,209) = b(k,209) - lu(k,1487) * b(k,250) + b(k,204) = b(k,204) - lu(k,1486) * b(k,250) + b(k,109) = b(k,109) - lu(k,1485) * b(k,250) + b(k,108) = b(k,108) - lu(k,1484) * b(k,250) + b(k,249) = b(k,249) * lu(k,1470) + b(k,248) = b(k,248) - lu(k,1469) * b(k,249) + b(k,247) = b(k,247) - lu(k,1468) * b(k,249) + b(k,246) = b(k,246) - lu(k,1467) * b(k,249) + b(k,245) = b(k,245) - lu(k,1466) * b(k,249) + b(k,244) = b(k,244) - lu(k,1465) * b(k,249) + b(k,243) = b(k,243) - lu(k,1464) * b(k,249) + b(k,242) = b(k,242) - lu(k,1463) * b(k,249) + b(k,241) = b(k,241) - lu(k,1462) * b(k,249) + b(k,240) = b(k,240) - lu(k,1461) * b(k,249) + b(k,238) = b(k,238) - lu(k,1460) * b(k,249) + b(k,235) = b(k,235) - lu(k,1459) * b(k,249) + b(k,234) = b(k,234) - lu(k,1458) * b(k,249) + b(k,231) = b(k,231) - lu(k,1457) * b(k,249) + b(k,224) = b(k,224) - lu(k,1456) * b(k,249) + b(k,194) = b(k,194) - lu(k,1455) * b(k,249) + b(k,181) = b(k,181) - lu(k,1454) * b(k,249) + b(k,177) = b(k,177) - lu(k,1453) * b(k,249) + b(k,142) = b(k,142) - lu(k,1452) * b(k,249) + b(k,248) = b(k,248) * lu(k,1439) + b(k,243) = b(k,243) - lu(k,1438) * b(k,248) + b(k,238) = b(k,238) - lu(k,1437) * b(k,248) + b(k,194) = b(k,194) - lu(k,1436) * b(k,248) + b(k,184) = b(k,184) - lu(k,1435) * b(k,248) + b(k,181) = b(k,181) - lu(k,1434) * b(k,248) + b(k,247) = b(k,247) * lu(k,1418) + b(k,246) = b(k,246) - lu(k,1417) * b(k,247) + b(k,243) = b(k,243) - lu(k,1416) * b(k,247) + b(k,238) = b(k,238) - lu(k,1415) * b(k,247) + b(k,234) = b(k,234) - lu(k,1414) * b(k,247) + b(k,233) = b(k,233) - lu(k,1413) * b(k,247) + b(k,232) = b(k,232) - lu(k,1412) * b(k,247) + b(k,216) = b(k,216) - lu(k,1411) * b(k,247) + b(k,246) = b(k,246) * lu(k,1398) + b(k,243) = b(k,243) - lu(k,1397) * b(k,246) + b(k,239) = b(k,239) - lu(k,1396) * b(k,246) + b(k,238) = b(k,238) - lu(k,1395) * b(k,246) + b(k,237) = b(k,237) - lu(k,1394) * b(k,246) + b(k,235) = b(k,235) - lu(k,1393) * b(k,246) + b(k,234) = b(k,234) - lu(k,1392) * b(k,246) + b(k,205) = b(k,205) - lu(k,1391) * b(k,246) + b(k,143) = b(k,143) - lu(k,1390) * b(k,246) + b(k,245) = b(k,245) * lu(k,1374) + b(k,243) = b(k,243) - lu(k,1373) * b(k,245) + b(k,242) = b(k,242) - lu(k,1372) * b(k,245) + b(k,240) = b(k,240) - lu(k,1371) * b(k,245) + b(k,239) = b(k,239) - lu(k,1370) * b(k,245) + b(k,238) = b(k,238) - lu(k,1369) * b(k,245) + b(k,237) = b(k,237) - lu(k,1368) * b(k,245) + b(k,235) = b(k,235) - lu(k,1367) * b(k,245) + b(k,234) = b(k,234) - lu(k,1366) * b(k,245) + b(k,224) = b(k,224) - lu(k,1365) * b(k,245) + b(k,217) = b(k,217) - lu(k,1364) * b(k,245) + b(k,212) = b(k,212) - lu(k,1363) * b(k,245) + b(k,205) = b(k,205) - lu(k,1362) * b(k,245) + b(k,195) = b(k,195) - lu(k,1361) * b(k,245) + b(k,186) = b(k,186) - lu(k,1360) * b(k,245) + b(k,178) = b(k,178) - lu(k,1359) * b(k,245) + b(k,142) = b(k,142) - lu(k,1358) * b(k,245) + b(k,121) = b(k,121) - lu(k,1357) * b(k,245) + b(k,244) = b(k,244) * lu(k,1341) + b(k,243) = b(k,243) - lu(k,1340) * b(k,244) + b(k,242) = b(k,242) - lu(k,1339) * b(k,244) + b(k,240) = b(k,240) - lu(k,1338) * b(k,244) + b(k,239) = b(k,239) - lu(k,1337) * b(k,244) + b(k,238) = b(k,238) - lu(k,1336) * b(k,244) + b(k,237) = b(k,237) - lu(k,1335) * b(k,244) + b(k,235) = b(k,235) - lu(k,1334) * b(k,244) + b(k,205) = b(k,205) - lu(k,1333) * b(k,244) + b(k,195) = b(k,195) - lu(k,1332) * b(k,244) + b(k,182) = b(k,182) - lu(k,1331) * b(k,244) + b(k,243) = b(k,243) * lu(k,1323) + b(k,234) = b(k,234) - lu(k,1322) * b(k,243) + b(k,242) = b(k,242) * lu(k,1311) + b(k,234) = b(k,234) - lu(k,1310) * b(k,242) + b(k,216) = b(k,216) - lu(k,1309) * b(k,242) + b(k,241) = b(k,241) * lu(k,1295) + b(k,240) = b(k,240) - lu(k,1294) * b(k,241) + b(k,235) = b(k,235) - lu(k,1293) * b(k,241) + b(k,234) = b(k,234) - lu(k,1292) * b(k,241) + b(k,231) = b(k,231) - lu(k,1291) * b(k,241) + b(k,212) = b(k,212) - lu(k,1290) * b(k,241) + b(k,205) = b(k,205) - lu(k,1289) * b(k,241) + b(k,195) = b(k,195) - lu(k,1288) * b(k,241) + b(k,157) = b(k,157) - lu(k,1287) * b(k,241) + b(k,155) = b(k,155) - lu(k,1286) * b(k,241) + end do + end subroutine lu_slv10 + subroutine lu_slv11( 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,240) = b(k,240) * lu(k,1275) + b(k,238) = b(k,238) - lu(k,1274) * b(k,240) + b(k,235) = b(k,235) - lu(k,1273) * b(k,240) + b(k,234) = b(k,234) - lu(k,1272) * b(k,240) + b(k,224) = b(k,224) - lu(k,1271) * b(k,240) + b(k,205) = b(k,205) - lu(k,1270) * b(k,240) + b(k,114) = b(k,114) - lu(k,1269) * b(k,240) + b(k,239) = b(k,239) * lu(k,1259) + b(k,238) = b(k,238) - lu(k,1258) * b(k,239) + b(k,205) = b(k,205) - lu(k,1257) * b(k,239) + b(k,150) = b(k,150) - lu(k,1256) * b(k,239) + b(k,238) = b(k,238) * lu(k,1250) + b(k,237) = b(k,237) * lu(k,1237) + b(k,235) = b(k,235) - lu(k,1236) * b(k,237) + b(k,234) = b(k,234) - lu(k,1235) * b(k,237) + b(k,233) = b(k,233) - lu(k,1234) * b(k,237) + b(k,227) = b(k,227) - lu(k,1233) * b(k,237) + b(k,119) = b(k,119) - lu(k,1232) * b(k,237) + b(k,236) = b(k,236) * lu(k,1220) + b(k,235) = b(k,235) - lu(k,1219) * b(k,236) + b(k,234) = b(k,234) - lu(k,1218) * b(k,236) + b(k,230) = b(k,230) - lu(k,1217) * b(k,236) + b(k,227) = b(k,227) - lu(k,1216) * b(k,236) + b(k,205) = b(k,205) - lu(k,1215) * b(k,236) + b(k,192) = b(k,192) - lu(k,1214) * b(k,236) + b(k,119) = b(k,119) - lu(k,1213) * b(k,236) + b(k,235) = b(k,235) * lu(k,1208) + b(k,234) = b(k,234) - lu(k,1207) * b(k,235) + b(k,224) = b(k,224) - lu(k,1206) * b(k,235) + b(k,234) = b(k,234) * lu(k,1202) + b(k,233) = b(k,233) * lu(k,1193) + b(k,232) = b(k,232) * lu(k,1175) + b(k,216) = b(k,216) - lu(k,1174) * b(k,232) + b(k,212) = b(k,212) - lu(k,1173) * b(k,232) + b(k,206) = b(k,206) - lu(k,1172) * b(k,232) + b(k,194) = b(k,194) - lu(k,1171) * b(k,232) + b(k,231) = b(k,231) * lu(k,1159) + b(k,224) = b(k,224) - lu(k,1158) * b(k,231) + b(k,217) = b(k,217) - lu(k,1157) * b(k,231) + b(k,212) = b(k,212) - lu(k,1156) * b(k,231) + b(k,186) = b(k,186) - lu(k,1155) * b(k,231) + b(k,230) = b(k,230) * lu(k,1145) + b(k,227) = b(k,227) - lu(k,1144) * b(k,230) + b(k,229) = b(k,229) * lu(k,1132) + b(k,226) = b(k,226) - lu(k,1131) * b(k,229) + b(k,205) = b(k,205) - lu(k,1130) * b(k,229) + b(k,187) = b(k,187) - lu(k,1129) * b(k,229) + b(k,154) = b(k,154) - lu(k,1128) * b(k,229) + b(k,228) = b(k,228) * lu(k,1118) + b(k,208) = b(k,208) - lu(k,1117) * b(k,228) + b(k,107) = b(k,107) - lu(k,1116) * b(k,228) + b(k,227) = b(k,227) * lu(k,1110) + b(k,226) = b(k,226) * lu(k,1102) + b(k,225) = b(k,225) * lu(k,1092) + b(k,205) = b(k,205) - lu(k,1091) * b(k,225) + b(k,187) = b(k,187) - lu(k,1090) * b(k,225) + b(k,167) = b(k,167) - lu(k,1089) * b(k,225) + b(k,224) = b(k,224) * lu(k,1084) + b(k,66) = b(k,66) - lu(k,1083) * b(k,224) + b(k,223) = b(k,223) * lu(k,1072) + b(k,215) = b(k,215) - lu(k,1071) * b(k,223) + b(k,191) = b(k,191) - lu(k,1070) * b(k,223) + b(k,190) = b(k,190) - lu(k,1069) * b(k,223) + b(k,189) = b(k,189) - lu(k,1068) * b(k,223) + b(k,171) = b(k,171) - lu(k,1067) * b(k,223) + b(k,222) = b(k,222) * lu(k,1048) + b(k,216) = b(k,216) - lu(k,1047) * b(k,222) + b(k,149) = b(k,149) - lu(k,1046) * b(k,222) + b(k,117) = b(k,117) - lu(k,1045) * b(k,222) + b(k,71) = b(k,71) - lu(k,1044) * b(k,222) + b(k,70) = b(k,70) - lu(k,1043) * b(k,222) + b(k,69) = b(k,69) - lu(k,1042) * b(k,222) + b(k,68) = b(k,68) - lu(k,1041) * b(k,222) + b(k,67) = b(k,67) - lu(k,1040) * b(k,222) + b(k,66) = b(k,66) - lu(k,1039) * b(k,222) + b(k,221) = b(k,221) * lu(k,1020) + b(k,216) = b(k,216) - lu(k,1019) * b(k,221) + b(k,149) = b(k,149) - lu(k,1018) * b(k,221) + b(k,117) = b(k,117) - lu(k,1017) * b(k,221) + b(k,73) = b(k,73) - lu(k,1016) * b(k,221) + b(k,70) = b(k,70) - lu(k,1015) * b(k,221) + b(k,69) = b(k,69) - lu(k,1014) * b(k,221) + b(k,68) = b(k,68) - lu(k,1013) * b(k,221) + b(k,67) = b(k,67) - lu(k,1012) * b(k,221) + b(k,66) = b(k,66) - lu(k,1011) * b(k,221) + b(k,220) = b(k,220) * lu(k,1001) + b(k,211) = b(k,211) - lu(k,1000) * b(k,220) + b(k,210) = b(k,210) - lu(k,999) * b(k,220) + b(k,209) = b(k,209) - lu(k,998) * b(k,220) + b(k,204) = b(k,204) - lu(k,997) * b(k,220) + b(k,169) = b(k,169) - lu(k,996) * b(k,220) + b(k,126) = b(k,126) - lu(k,995) * b(k,220) + b(k,219) = b(k,219) * lu(k,989) + b(k,127) = b(k,127) - lu(k,988) * b(k,219) + b(k,218) = b(k,218) * lu(k,977) + b(k,151) = b(k,151) - lu(k,976) * b(k,218) + b(k,217) = b(k,217) * lu(k,967) + b(k,216) = b(k,216) * lu(k,962) + b(k,215) = b(k,215) * lu(k,953) + b(k,205) = b(k,205) - lu(k,952) * b(k,215) + b(k,141) = b(k,141) - lu(k,951) * b(k,215) + b(k,128) = b(k,128) - lu(k,950) * b(k,215) + b(k,214) = b(k,214) * lu(k,941) + b(k,135) = b(k,135) - lu(k,940) * b(k,214) + b(k,213) = b(k,213) * lu(k,924) + b(k,72) = b(k,72) - lu(k,923) * b(k,213) + b(k,70) = b(k,70) - lu(k,922) * b(k,213) + b(k,69) = b(k,69) - lu(k,921) * b(k,213) + b(k,212) = b(k,212) * lu(k,915) + b(k,211) = b(k,211) * lu(k,907) + b(k,210) = b(k,210) - lu(k,906) * b(k,211) + b(k,209) = b(k,209) - lu(k,905) * b(k,211) + b(k,204) = b(k,204) - lu(k,904) * b(k,211) + b(k,193) = b(k,193) - lu(k,903) * b(k,211) + b(k,173) = b(k,173) - lu(k,902) * b(k,211) + b(k,210) = b(k,210) * lu(k,895) + b(k,209) = b(k,209) - lu(k,894) * b(k,210) + b(k,209) = b(k,209) * lu(k,887) + b(k,173) = b(k,173) - lu(k,886) * b(k,209) + b(k,208) = b(k,208) * lu(k,879) + b(k,107) = b(k,107) - lu(k,878) * b(k,208) + b(k,207) = b(k,207) * lu(k,870) + b(k,206) = b(k,206) * lu(k,860) + b(k,176) = b(k,176) - lu(k,859) * b(k,206) + b(k,205) = b(k,205) * lu(k,855) + b(k,204) = b(k,204) * lu(k,847) + b(k,203) = b(k,203) * lu(k,839) + b(k,163) = b(k,163) - lu(k,838) * b(k,203) + b(k,102) = b(k,102) - lu(k,837) * b(k,203) + b(k,202) = b(k,202) * lu(k,829) + b(k,118) = b(k,118) - lu(k,828) * b(k,202) + b(k,201) = b(k,201) * lu(k,820) + b(k,200) = b(k,200) * lu(k,809) + b(k,198) = b(k,198) - lu(k,808) * b(k,200) + b(k,196) = b(k,196) - lu(k,807) * b(k,200) + b(k,186) = b(k,186) - lu(k,806) * b(k,200) + b(k,162) = b(k,162) - lu(k,805) * b(k,200) + b(k,144) = b(k,144) - lu(k,804) * b(k,200) + b(k,133) = b(k,133) - lu(k,803) * b(k,200) + b(k,199) = b(k,199) * lu(k,793) + b(k,198) = b(k,198) - lu(k,792) * b(k,199) + b(k,186) = b(k,186) - lu(k,791) * b(k,199) + b(k,183) = b(k,183) - lu(k,790) * b(k,199) + b(k,162) = b(k,162) - lu(k,789) * b(k,199) + b(k,133) = b(k,133) - lu(k,788) * b(k,199) + b(k,198) = b(k,198) * lu(k,782) + b(k,197) = b(k,197) * lu(k,775) + b(k,196) = b(k,196) * lu(k,764) + b(k,186) = b(k,186) - lu(k,763) * b(k,196) + b(k,162) = b(k,162) - lu(k,762) * b(k,196) + b(k,144) = b(k,144) - lu(k,761) * b(k,196) + b(k,133) = b(k,133) - lu(k,760) * b(k,196) + b(k,195) = b(k,195) * lu(k,753) + b(k,96) = b(k,96) - lu(k,752) * b(k,195) + b(k,194) = b(k,194) * lu(k,747) + b(k,193) = b(k,193) * lu(k,737) + b(k,173) = b(k,173) - lu(k,736) * b(k,193) + b(k,192) = b(k,192) * lu(k,726) + b(k,191) = b(k,191) * lu(k,719) + b(k,145) = b(k,145) - lu(k,718) * b(k,191) + b(k,190) = b(k,190) * lu(k,708) + b(k,171) = b(k,171) - lu(k,707) * b(k,190) + b(k,189) = b(k,189) * lu(k,697) + b(k,171) = b(k,171) - lu(k,696) * b(k,189) + b(k,188) = b(k,188) * lu(k,690) + b(k,166) = b(k,166) - lu(k,689) * b(k,188) + b(k,129) = b(k,129) - lu(k,688) * b(k,188) + b(k,187) = b(k,187) * lu(k,682) + b(k,186) = b(k,186) * lu(k,678) + b(k,185) = b(k,185) * lu(k,671) + b(k,184) = b(k,184) * lu(k,662) + b(k,183) = b(k,183) * lu(k,653) + b(k,162) = b(k,162) - lu(k,652) * b(k,183) + b(k,133) = b(k,133) - lu(k,651) * b(k,183) + b(k,182) = b(k,182) * lu(k,642) + b(k,181) = b(k,181) * lu(k,635) + b(k,180) = b(k,180) * lu(k,626) + b(k,179) = b(k,179) * lu(k,618) + b(k,178) = b(k,178) * lu(k,610) + b(k,177) = b(k,177) * lu(k,602) + b(k,176) = b(k,176) * lu(k,594) + b(k,175) = b(k,175) * lu(k,586) + b(k,174) = b(k,174) * lu(k,578) + b(k,173) = b(k,173) * lu(k,573) + b(k,172) = b(k,172) * lu(k,567) + b(k,97) = b(k,97) - lu(k,566) * b(k,172) + b(k,171) = b(k,171) * lu(k,561) + b(k,170) = b(k,170) * lu(k,554) + b(k,158) = b(k,158) - lu(k,553) * b(k,170) + b(k,169) = b(k,169) * lu(k,546) + b(k,168) = b(k,168) * lu(k,539) + b(k,162) = b(k,162) - lu(k,538) * b(k,168) + b(k,156) = b(k,156) - lu(k,537) * b(k,168) + b(k,167) = b(k,167) * lu(k,530) + b(k,166) = b(k,166) * lu(k,526) + b(k,165) = b(k,165) * lu(k,519) + b(k,164) = b(k,164) * lu(k,512) + b(k,163) = b(k,163) * lu(k,507) + b(k,162) = b(k,162) * lu(k,504) + b(k,161) = b(k,161) * lu(k,498) + b(k,139) = b(k,139) - lu(k,497) * b(k,161) + end do + end subroutine lu_slv11 + subroutine lu_slv12( 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,160) = b(k,160) * lu(k,491) + b(k,159) = b(k,159) * lu(k,485) + b(k,140) = b(k,140) - lu(k,484) * b(k,159) + b(k,120) = b(k,120) - lu(k,483) * b(k,159) + b(k,158) = b(k,158) * lu(k,477) + b(k,157) = b(k,157) * lu(k,471) + b(k,156) = b(k,156) * lu(k,465) + b(k,155) = b(k,155) * lu(k,459) + b(k,154) = b(k,154) * lu(k,453) + b(k,153) = b(k,153) * lu(k,447) + b(k,152) = b(k,152) * lu(k,441) + b(k,151) = b(k,151) * lu(k,435) + b(k,150) = b(k,150) * lu(k,429) + b(k,149) = b(k,149) * lu(k,423) + b(k,148) = b(k,148) * lu(k,415) + b(k,147) = b(k,147) * lu(k,407) + b(k,146) = b(k,146) * lu(k,399) + b(k,145) = b(k,145) * lu(k,394) + b(k,144) = b(k,144) * lu(k,389) + b(k,143) = b(k,143) * lu(k,384) + b(k,142) = b(k,142) * lu(k,381) + b(k,141) = b(k,141) * lu(k,376) + b(k,140) = b(k,140) * lu(k,371) + b(k,120) = b(k,120) - lu(k,370) * b(k,140) + b(k,139) = b(k,139) * lu(k,365) + b(k,138) = b(k,138) * lu(k,360) + b(k,137) = b(k,137) * lu(k,354) + b(k,122) = b(k,122) - lu(k,353) * b(k,137) + b(k,136) = b(k,136) * lu(k,347) + b(k,135) = b(k,135) * lu(k,344) + b(k,134) = b(k,134) * lu(k,338) + b(k,133) = b(k,133) * lu(k,335) + b(k,132) = b(k,132) * lu(k,329) + b(k,131) = b(k,131) * lu(k,323) + b(k,130) = b(k,130) * lu(k,317) + b(k,129) = b(k,129) * lu(k,313) + b(k,128) = b(k,128) * lu(k,309) + b(k,127) = b(k,127) * lu(k,305) + b(k,103) = b(k,103) - lu(k,304) * b(k,127) + b(k,126) = b(k,126) * lu(k,300) + b(k,125) = b(k,125) * lu(k,295) + b(k,122) = b(k,122) - lu(k,294) * b(k,125) + b(k,124) = b(k,124) * lu(k,290) + b(k,123) = b(k,123) * lu(k,285) + b(k,122) = b(k,122) * lu(k,282) + b(k,121) = b(k,121) * lu(k,277) + b(k,120) = b(k,120) * lu(k,274) + b(k,119) = b(k,119) * lu(k,271) + b(k,118) = b(k,118) * lu(k,268) + b(k,117) = b(k,117) * lu(k,265) + b(k,116) = b(k,116) * lu(k,260) + b(k,115) = b(k,115) * lu(k,252) + b(k,113) = b(k,113) - lu(k,251) * b(k,115) + b(k,86) = b(k,86) - lu(k,250) * b(k,115) + b(k,114) = b(k,114) * lu(k,247) + b(k,113) = b(k,113) * lu(k,243) + b(k,112) = b(k,112) * lu(k,238) + b(k,111) = b(k,111) * lu(k,231) + b(k,85) = b(k,85) - lu(k,230) * b(k,111) + b(k,110) = b(k,110) * lu(k,226) + b(k,109) = b(k,109) * lu(k,224) + b(k,108) = b(k,108) - lu(k,223) * b(k,109) + b(k,108) = b(k,108) * lu(k,221) + b(k,107) = b(k,107) * lu(k,219) + b(k,106) = b(k,106) * lu(k,214) + b(k,105) = b(k,105) * lu(k,210) + b(k,104) = b(k,104) * lu(k,204) + b(k,81) = b(k,81) - lu(k,203) * b(k,104) + b(k,103) = b(k,103) * lu(k,200) + b(k,102) = b(k,102) * lu(k,197) + b(k,101) = b(k,101) * lu(k,192) + b(k,100) = b(k,100) * lu(k,187) + b(k,99) = b(k,99) * lu(k,182) + b(k,98) = b(k,98) * lu(k,177) + b(k,97) = b(k,97) * lu(k,174) + b(k,96) = b(k,96) * lu(k,171) + b(k,95) = b(k,95) * lu(k,167) + b(k,94) = b(k,94) * lu(k,163) + b(k,93) = b(k,93) * lu(k,159) + b(k,92) = b(k,92) * lu(k,155) + b(k,91) = b(k,91) * lu(k,151) + b(k,90) = b(k,90) * lu(k,148) + b(k,89) = b(k,89) * lu(k,145) + b(k,88) = b(k,88) * lu(k,142) + b(k,87) = b(k,87) * lu(k,139) + b(k,86) = b(k,86) * lu(k,138) + b(k,78) = b(k,78) - lu(k,137) * b(k,86) + b(k,77) = b(k,77) - lu(k,136) * b(k,86) + b(k,76) = b(k,76) - lu(k,135) * b(k,86) + b(k,75) = b(k,75) - lu(k,134) * b(k,86) + b(k,74) = b(k,74) - lu(k,133) * b(k,86) + b(k,85) = b(k,85) * lu(k,132) + b(k,78) = b(k,78) - lu(k,131) * b(k,85) + b(k,77) = b(k,77) - lu(k,130) * b(k,85) + b(k,76) = b(k,76) - lu(k,129) * b(k,85) + b(k,75) = b(k,75) - lu(k,128) * b(k,85) + b(k,74) = b(k,74) - lu(k,127) * b(k,85) + b(k,84) = b(k,84) * lu(k,126) + b(k,78) = b(k,78) - lu(k,125) * b(k,84) + b(k,77) = b(k,77) - lu(k,124) * b(k,84) + b(k,76) = b(k,76) - lu(k,123) * b(k,84) + b(k,75) = b(k,75) - lu(k,122) * b(k,84) + b(k,74) = b(k,74) - lu(k,121) * b(k,84) + b(k,83) = b(k,83) * lu(k,120) + b(k,63) = b(k,63) - lu(k,119) * b(k,83) + b(k,62) = b(k,62) - lu(k,118) * b(k,83) + b(k,61) = b(k,61) - lu(k,117) * b(k,83) + b(k,60) = b(k,60) - lu(k,116) * b(k,83) + b(k,59) = b(k,59) - lu(k,115) * b(k,83) + b(k,82) = b(k,82) * lu(k,114) + b(k,81) = b(k,81) * lu(k,113) + b(k,78) = b(k,78) - lu(k,112) * b(k,81) + b(k,77) = b(k,77) - lu(k,111) * b(k,81) + b(k,76) = b(k,76) - lu(k,110) * b(k,81) + b(k,75) = b(k,75) - lu(k,109) * b(k,81) + b(k,74) = b(k,74) - lu(k,108) * b(k,81) + b(k,80) = b(k,80) * lu(k,107) + b(k,79) = b(k,79) - lu(k,106) * b(k,80) + b(k,79) = b(k,79) * lu(k,105) + b(k,78) = b(k,78) - lu(k,104) * b(k,79) + b(k,77) = b(k,77) - lu(k,103) * b(k,79) + b(k,76) = b(k,76) - lu(k,102) * b(k,79) + b(k,75) = b(k,75) - lu(k,101) * b(k,79) + b(k,74) = b(k,74) - lu(k,100) * b(k,79) + b(k,78) = b(k,78) * lu(k,99) + b(k,77) = b(k,77) * lu(k,98) + b(k,76) = b(k,76) * lu(k,97) + b(k,75) = b(k,75) * lu(k,96) + b(k,74) = b(k,74) * lu(k,95) + b(k,73) = b(k,73) * lu(k,94) + b(k,70) = b(k,70) - lu(k,93) * b(k,73) + b(k,69) = b(k,69) - lu(k,92) * b(k,73) + b(k,68) = b(k,68) - lu(k,91) * b(k,73) + b(k,67) = b(k,67) - lu(k,90) * b(k,73) + b(k,66) = b(k,66) - lu(k,89) * b(k,73) + b(k,72) = b(k,72) * lu(k,88) + b(k,70) = b(k,70) - lu(k,87) * b(k,72) + b(k,69) = b(k,69) - lu(k,86) * b(k,72) + b(k,68) = b(k,68) - lu(k,85) * b(k,72) + b(k,67) = b(k,67) - lu(k,84) * b(k,72) + b(k,66) = b(k,66) - lu(k,83) * b(k,72) + b(k,71) = b(k,71) * lu(k,82) + b(k,70) = b(k,70) - lu(k,81) * b(k,71) + b(k,69) = b(k,69) - lu(k,80) * b(k,71) + b(k,68) = b(k,68) - lu(k,79) * b(k,71) + b(k,67) = b(k,67) - lu(k,78) * b(k,71) + b(k,66) = b(k,66) - lu(k,77) * b(k,71) + b(k,70) = b(k,70) * lu(k,76) + b(k,69) = b(k,69) * lu(k,75) + b(k,68) = b(k,68) * lu(k,74) + b(k,67) = b(k,67) * lu(k,73) + b(k,66) = b(k,66) * lu(k,72) + b(k,65) = b(k,65) * lu(k,71) + b(k,64) = b(k,64) - lu(k,70) * b(k,65) + b(k,64) = b(k,64) * lu(k,69) + b(k,63) = b(k,63) - lu(k,68) * b(k,64) + b(k,62) = b(k,62) - lu(k,67) * b(k,64) + b(k,61) = b(k,61) - lu(k,66) * b(k,64) + b(k,60) = b(k,60) - lu(k,65) * b(k,64) + b(k,59) = b(k,59) - lu(k,64) * b(k,64) + b(k,63) = b(k,63) * lu(k,63) + b(k,62) = b(k,62) * lu(k,62) + b(k,61) = b(k,61) * lu(k,61) + b(k,60) = b(k,60) * lu(k,60) + b(k,59) = b(k,59) * lu(k,59) + b(k,58) = b(k,58) * lu(k,58) + b(k,57) = b(k,57) * lu(k,57) + b(k,56) = b(k,56) * lu(k,56) + b(k,55) = b(k,55) * lu(k,55) + b(k,54) = b(k,54) * lu(k,54) + b(k,53) = b(k,53) * lu(k,53) + b(k,52) = b(k,52) * lu(k,52) + b(k,51) = b(k,51) * lu(k,51) + b(k,50) = b(k,50) * lu(k,50) + b(k,49) = b(k,49) * lu(k,49) + b(k,48) = b(k,48) * lu(k,48) + b(k,47) = b(k,47) * lu(k,47) + b(k,46) = b(k,46) * lu(k,46) + b(k,45) = b(k,45) * lu(k,45) + b(k,44) = b(k,44) * lu(k,44) + b(k,43) = b(k,43) * lu(k,43) + b(k,42) = b(k,42) * lu(k,42) + b(k,41) = b(k,41) * lu(k,41) + b(k,40) = b(k,40) * lu(k,40) + b(k,39) = b(k,39) * lu(k,39) + b(k,38) = b(k,38) * lu(k,38) + b(k,37) = b(k,37) * lu(k,37) + b(k,36) = b(k,36) * lu(k,36) + b(k,35) = b(k,35) * lu(k,35) + b(k,34) = b(k,34) * lu(k,34) + b(k,33) = b(k,33) * lu(k,33) + b(k,32) = b(k,32) * lu(k,32) + b(k,31) = b(k,31) * lu(k,31) + b(k,30) = b(k,30) * lu(k,30) + b(k,29) = b(k,29) * lu(k,29) + b(k,28) = b(k,28) * lu(k,28) + b(k,27) = b(k,27) * lu(k,27) + b(k,26) = b(k,26) * lu(k,26) + b(k,25) = b(k,25) * lu(k,25) + b(k,24) = b(k,24) * lu(k,24) + b(k,23) = b(k,23) * lu(k,23) + end do + end subroutine lu_slv12 + subroutine lu_slv13( 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,22) = b(k,22) * lu(k,22) + b(k,21) = b(k,21) * lu(k,21) + b(k,20) = b(k,20) * lu(k,20) + b(k,19) = b(k,19) * lu(k,19) + b(k,18) = b(k,18) * lu(k,18) + b(k,17) = b(k,17) * lu(k,17) + b(k,16) = b(k,16) * lu(k,16) + b(k,15) = b(k,15) * lu(k,15) + b(k,14) = b(k,14) * lu(k,14) + b(k,13) = b(k,13) * lu(k,13) + b(k,12) = b(k,12) * lu(k,12) + b(k,11) = b(k,11) * lu(k,11) + b(k,10) = b(k,10) * lu(k,10) + 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_slv13 + 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 ) + call lu_slv09( avec_len, lu, b ) + call lu_slv10( avec_len, lu, b ) + call lu_slv11( avec_len, lu, b ) + call lu_slv12( avec_len, lu, b ) + call lu_slv13( avec_len, lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_nln_matrix.F90 new file mode 100644 index 0000000000..94817613ea --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_nln_matrix.F90 @@ -0,0 +1,4086 @@ + 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,708) = -(rxt(k,416)*y(k,263)) + mat(k,1839) = -rxt(k,416)*y(k,1) + mat(k,2183) = rxt(k,419)*y(k,232) + mat(k,1069) = rxt(k,419)*y(k,131) + mat(k,697) = -(rxt(k,420)*y(k,263)) + mat(k,1838) = -rxt(k,420)*y(k,2) + mat(k,1068) = rxt(k,417)*y(k,245) + mat(k,2360) = rxt(k,417)*y(k,232) + mat(k,1048) = -(rxt(k,499)*y(k,133) + rxt(k,500)*y(k,142) + rxt(k,501) & + *y(k,263)) + mat(k,2257) = -rxt(k,499)*y(k,6) + mat(k,2067) = -rxt(k,500)*y(k,6) + mat(k,1865) = -rxt(k,501)*y(k,6) + mat(k,82) = -(rxt(k,554)*y(k,245) + rxt(k,555)*y(k,131)) + mat(k,2316) = -rxt(k,554)*y(k,7) + mat(k,2150) = -rxt(k,555)*y(k,7) + mat(k,1044) = rxt(k,557)*y(k,263) + mat(k,1750) = rxt(k,557)*y(k,6) + mat(k,204) = -(rxt(k,458)*y(k,263)) + mat(k,1769) = -rxt(k,458)*y(k,8) + mat(k,113) = -(rxt(k,559)*y(k,245) + rxt(k,560)*y(k,131)) + mat(k,2325) = -rxt(k,559)*y(k,9) + mat(k,2159) = -rxt(k,560)*y(k,9) + mat(k,203) = rxt(k,558)*y(k,263) + mat(k,1760) = rxt(k,558)*y(k,8) + mat(k,465) = -(rxt(k,461)*y(k,263)) + mat(k,1810) = -rxt(k,461)*y(k,10) + mat(k,537) = rxt(k,459)*y(k,245) + mat(k,2340) = rxt(k,459)*y(k,233) + mat(k,205) = .120_r8*rxt(k,458)*y(k,263) + mat(k,1770) = .120_r8*rxt(k,458)*y(k,8) + mat(k,1046) = .100_r8*rxt(k,500)*y(k,142) + mat(k,1018) = .100_r8*rxt(k,503)*y(k,142) + mat(k,2056) = .100_r8*rxt(k,500)*y(k,6) + .100_r8*rxt(k,503)*y(k,116) + mat(k,2170) = .500_r8*rxt(k,460)*y(k,233) + .200_r8*rxt(k,487)*y(k,270) & + + .060_r8*rxt(k,493)*y(k,272) + mat(k,538) = .500_r8*rxt(k,460)*y(k,131) + mat(k,789) = .200_r8*rxt(k,487)*y(k,131) + mat(k,805) = .060_r8*rxt(k,493)*y(k,131) + mat(k,2164) = .200_r8*rxt(k,487)*y(k,270) + .200_r8*rxt(k,493)*y(k,272) + mat(k,788) = .200_r8*rxt(k,487)*y(k,131) + mat(k,803) = .200_r8*rxt(k,493)*y(k,131) + mat(k,2180) = .200_r8*rxt(k,487)*y(k,270) + .150_r8*rxt(k,493)*y(k,272) + mat(k,791) = .200_r8*rxt(k,487)*y(k,131) + mat(k,806) = .150_r8*rxt(k,493)*y(k,131) + mat(k,2166) = .210_r8*rxt(k,493)*y(k,272) + mat(k,804) = .210_r8*rxt(k,493)*y(k,131) + mat(k,265) = -(rxt(k,421)*y(k,263)) + mat(k,1779) = -rxt(k,421)*y(k,17) + mat(k,1045) = .050_r8*rxt(k,500)*y(k,142) + mat(k,1017) = .050_r8*rxt(k,503)*y(k,142) + mat(k,2055) = .050_r8*rxt(k,500)*y(k,6) + .050_r8*rxt(k,503)*y(k,116) + mat(k,407) = -(rxt(k,387)*y(k,133) + rxt(k,388)*y(k,263)) + mat(k,2250) = -rxt(k,387)*y(k,18) + mat(k,1802) = -rxt(k,388)*y(k,18) + mat(k,1553) = -(rxt(k,270)*y(k,44) + rxt(k,271)*y(k,245) + rxt(k,272) & + *y(k,142)) + mat(k,2432) = -rxt(k,270)*y(k,19) + mat(k,2406) = -rxt(k,271)*y(k,19) + mat(k,2093) = -rxt(k,272)*y(k,19) + mat(k,1605) = 4.000_r8*rxt(k,273)*y(k,21) + (rxt(k,274)+rxt(k,275))*y(k,61) & + + rxt(k,278)*y(k,131) + rxt(k,281)*y(k,140) + rxt(k,529) & + *y(k,160) + rxt(k,282)*y(k,263) + mat(k,179) = rxt(k,260)*y(k,259) + mat(k,185) = rxt(k,286)*y(k,259) + mat(k,521) = 2.000_r8*rxt(k,297)*y(k,58) + 2.000_r8*rxt(k,309)*y(k,259) & + + 2.000_r8*rxt(k,298)*y(k,263) + mat(k,628) = rxt(k,299)*y(k,58) + rxt(k,310)*y(k,259) + rxt(k,300)*y(k,263) + mat(k,449) = 3.000_r8*rxt(k,304)*y(k,58) + 3.000_r8*rxt(k,287)*y(k,259) & + + 3.000_r8*rxt(k,305)*y(k,263) + mat(k,1986) = 2.000_r8*rxt(k,297)*y(k,43) + rxt(k,299)*y(k,45) & + + 3.000_r8*rxt(k,304)*y(k,57) + mat(k,2121) = (rxt(k,274)+rxt(k,275))*y(k,21) + mat(k,153) = 2.000_r8*rxt(k,288)*y(k,259) + mat(k,871) = rxt(k,283)*y(k,140) + rxt(k,289)*y(k,259) + rxt(k,284)*y(k,263) + mat(k,2226) = rxt(k,278)*y(k,21) + mat(k,1940) = rxt(k,281)*y(k,21) + rxt(k,283)*y(k,83) + mat(k,1519) = rxt(k,529)*y(k,21) + mat(k,2029) = rxt(k,260)*y(k,36) + rxt(k,286)*y(k,37) + 2.000_r8*rxt(k,309) & + *y(k,43) + rxt(k,310)*y(k,45) + 3.000_r8*rxt(k,287)*y(k,57) & + + 2.000_r8*rxt(k,288)*y(k,80) + rxt(k,289)*y(k,83) + mat(k,1897) = rxt(k,282)*y(k,21) + 2.000_r8*rxt(k,298)*y(k,43) + rxt(k,300) & + *y(k,45) + 3.000_r8*rxt(k,305)*y(k,57) + rxt(k,284)*y(k,83) + mat(k,1598) = rxt(k,276)*y(k,61) + mat(k,2114) = rxt(k,276)*y(k,21) + mat(k,1533) = (rxt(k,594)+rxt(k,599))*y(k,93) + mat(k,828) = (rxt(k,594)+rxt(k,599))*y(k,87) + mat(k,1607) = -(4._r8*rxt(k,273)*y(k,21) + (rxt(k,274) + rxt(k,275) + rxt(k,276) & + ) * y(k,61) + rxt(k,277)*y(k,245) + rxt(k,278)*y(k,131) & + + rxt(k,279)*y(k,132) + rxt(k,281)*y(k,140) + rxt(k,282) & + *y(k,263) + rxt(k,529)*y(k,160)) + mat(k,2123) = -(rxt(k,274) + rxt(k,275) + rxt(k,276)) * y(k,21) + mat(k,2408) = -rxt(k,277)*y(k,21) + mat(k,2228) = -rxt(k,278)*y(k,21) + mat(k,2479) = -rxt(k,279)*y(k,21) + mat(k,1942) = -rxt(k,281)*y(k,21) + mat(k,1899) = -rxt(k,282)*y(k,21) + mat(k,1521) = -rxt(k,529)*y(k,21) + mat(k,1555) = rxt(k,272)*y(k,142) + mat(k,589) = rxt(k,280)*y(k,140) + mat(k,872) = rxt(k,290)*y(k,259) + mat(k,832) = rxt(k,285)*y(k,140) + mat(k,1942) = mat(k,1942) + rxt(k,280)*y(k,22) + rxt(k,285)*y(k,93) + mat(k,2095) = rxt(k,272)*y(k,19) + mat(k,2031) = rxt(k,290)*y(k,83) + mat(k,586) = -(rxt(k,280)*y(k,140)) + mat(k,1921) = -rxt(k,280)*y(k,22) + mat(k,1600) = rxt(k,279)*y(k,132) + mat(k,2457) = rxt(k,279)*y(k,21) + mat(k,274) = -(rxt(k,462)*y(k,263)) + mat(k,1781) = -rxt(k,462)*y(k,24) + mat(k,2163) = rxt(k,465)*y(k,234) + mat(k,483) = rxt(k,465)*y(k,131) + mat(k,371) = -(rxt(k,464)*y(k,263)) + mat(k,1796) = -rxt(k,464)*y(k,25) + mat(k,484) = rxt(k,463)*y(k,245) + mat(k,2332) = rxt(k,463)*y(k,234) + mat(k,317) = -(rxt(k,335)*y(k,58) + rxt(k,336)*y(k,263)) + mat(k,1960) = -rxt(k,335)*y(k,26) + mat(k,1790) = -rxt(k,336)*y(k,26) + mat(k,578) = -(rxt(k,337)*y(k,58) + rxt(k,338)*y(k,142) + rxt(k,363)*y(k,263)) + mat(k,1966) = -rxt(k,337)*y(k,27) + mat(k,2058) = -rxt(k,338)*y(k,27) + mat(k,1824) = -rxt(k,363)*y(k,27) + mat(k,309) = -(rxt(k,343)*y(k,263)) + mat(k,1788) = -rxt(k,343)*y(k,28) + mat(k,950) = .800_r8*rxt(k,339)*y(k,235) + .200_r8*rxt(k,340)*y(k,239) + mat(k,1647) = .200_r8*rxt(k,340)*y(k,235) + mat(k,376) = -(rxt(k,344)*y(k,263)) + mat(k,1797) = -rxt(k,344)*y(k,29) + mat(k,951) = rxt(k,341)*y(k,245) + mat(k,2333) = rxt(k,341)*y(k,235) + mat(k,323) = -(rxt(k,345)*y(k,58) + rxt(k,346)*y(k,263)) + mat(k,1961) = -rxt(k,345)*y(k,30) + mat(k,1791) = -rxt(k,346)*y(k,30) + mat(k,1175) = -(rxt(k,366)*y(k,133) + rxt(k,367)*y(k,142) + rxt(k,385) & + *y(k,263)) + mat(k,2266) = -rxt(k,366)*y(k,31) + mat(k,2075) = -rxt(k,367)*y(k,31) + mat(k,1875) = -rxt(k,385)*y(k,31) + mat(k,926) = .130_r8*rxt(k,445)*y(k,142) + mat(k,2075) = mat(k,2075) + .130_r8*rxt(k,445)*y(k,100) + mat(k,435) = -(rxt(k,371)*y(k,263)) + mat(k,1805) = -rxt(k,371)*y(k,32) + mat(k,976) = rxt(k,369)*y(k,245) + mat(k,2337) = rxt(k,369)*y(k,236) + mat(k,329) = -(rxt(k,372)*y(k,263) + rxt(k,375)*y(k,58)) + mat(k,1792) = -rxt(k,372)*y(k,33) + mat(k,1962) = -rxt(k,375)*y(k,33) + mat(k,313) = -(rxt(k,468)*y(k,263)) + mat(k,1789) = -rxt(k,468)*y(k,34) + mat(k,688) = rxt(k,466)*y(k,245) + mat(k,2330) = rxt(k,466)*y(k,237) + mat(k,142) = -(rxt(k,259)*y(k,259)) + mat(k,2005) = -rxt(k,259)*y(k,35) + mat(k,177) = -(rxt(k,260)*y(k,259)) + mat(k,2010) = -rxt(k,260)*y(k,36) + mat(k,182) = -(rxt(k,286)*y(k,259)) + mat(k,2011) = -rxt(k,286)*y(k,37) + mat(k,155) = -(rxt(k,261)*y(k,259)) + mat(k,2007) = -rxt(k,261)*y(k,38) + mat(k,187) = -(rxt(k,262)*y(k,259)) + mat(k,2012) = -rxt(k,262)*y(k,39) + mat(k,159) = -(rxt(k,263)*y(k,259)) + mat(k,2008) = -rxt(k,263)*y(k,40) + mat(k,192) = -(rxt(k,264)*y(k,259)) + mat(k,2013) = -rxt(k,264)*y(k,41) + mat(k,163) = -(rxt(k,265)*y(k,259)) + mat(k,2009) = -rxt(k,265)*y(k,42) + mat(k,519) = -(rxt(k,297)*y(k,58) + rxt(k,298)*y(k,263) + rxt(k,309)*y(k,259)) + mat(k,1965) = -rxt(k,297)*y(k,43) + mat(k,1817) = -rxt(k,298)*y(k,43) + mat(k,2023) = -rxt(k,309)*y(k,43) + mat(k,2448) = -(rxt(k,234)*y(k,58) + rxt(k,270)*y(k,19) + rxt(k,314)*y(k,245) & + + rxt(k,315)*y(k,133) + rxt(k,316)*y(k,140) + rxt(k,317) & + *y(k,263)) + mat(k,2002) = -rxt(k,234)*y(k,44) + mat(k,1563) = -rxt(k,270)*y(k,44) + mat(k,2422) = -rxt(k,314)*y(k,44) + mat(k,2302) = -rxt(k,315)*y(k,44) + mat(k,1956) = -rxt(k,316)*y(k,44) + mat(k,1913) = -rxt(k,317)*y(k,44) + mat(k,716) = .400_r8*rxt(k,416)*y(k,263) + mat(k,1065) = .340_r8*rxt(k,500)*y(k,142) + mat(k,413) = .500_r8*rxt(k,387)*y(k,133) + mat(k,585) = rxt(k,338)*y(k,142) + mat(k,1190) = .500_r8*rxt(k,367)*y(k,142) + mat(k,640) = .500_r8*rxt(k,355)*y(k,263) + mat(k,858) = rxt(k,322)*y(k,263) + mat(k,445) = .300_r8*rxt(k,323)*y(k,263) + mat(k,1644) = (rxt(k,331)+rxt(k,332))*y(k,259) + mat(k,2136) = rxt(k,241)*y(k,239) + mat(k,1212) = .800_r8*rxt(k,360)*y(k,263) + mat(k,939) = .910_r8*rxt(k,445)*y(k,142) + mat(k,649) = .300_r8*rxt(k,436)*y(k,263) + mat(k,1307) = .800_r8*rxt(k,440)*y(k,239) + mat(k,1320) = .120_r8*rxt(k,398)*y(k,142) + mat(k,669) = .500_r8*rxt(k,411)*y(k,263) + mat(k,1037) = .340_r8*rxt(k,503)*y(k,142) + mat(k,1431) = .600_r8*rxt(k,412)*y(k,142) + mat(k,2242) = .100_r8*rxt(k,418)*y(k,232) + rxt(k,321)*y(k,239) & + + .500_r8*rxt(k,389)*y(k,242) + .500_r8*rxt(k,357)*y(k,244) & + + .920_r8*rxt(k,428)*y(k,247) + .250_r8*rxt(k,396)*y(k,249) & + + rxt(k,405)*y(k,251) + rxt(k,379)*y(k,266) + rxt(k,383) & + *y(k,267) + .340_r8*rxt(k,512)*y(k,268) + .320_r8*rxt(k,517) & + *y(k,269) + .250_r8*rxt(k,453)*y(k,271) + mat(k,2302) = mat(k,2302) + .500_r8*rxt(k,387)*y(k,18) + rxt(k,429)*y(k,247) & + + .250_r8*rxt(k,395)*y(k,249) + rxt(k,406)*y(k,251) + mat(k,2109) = .340_r8*rxt(k,500)*y(k,6) + rxt(k,338)*y(k,27) & + + .500_r8*rxt(k,367)*y(k,31) + .910_r8*rxt(k,445)*y(k,100) & + + .120_r8*rxt(k,398)*y(k,111) + .340_r8*rxt(k,503)*y(k,116) & + + .600_r8*rxt(k,412)*y(k,118) + mat(k,608) = rxt(k,362)*y(k,263) + mat(k,1153) = .680_r8*rxt(k,521)*y(k,263) + mat(k,1081) = .100_r8*rxt(k,418)*y(k,131) + mat(k,960) = .700_r8*rxt(k,340)*y(k,239) + mat(k,985) = rxt(k,368)*y(k,239) + mat(k,1481) = rxt(k,351)*y(k,239) + rxt(k,425)*y(k,247) + .250_r8*rxt(k,392) & + *y(k,249) + rxt(k,401)*y(k,251) + .250_r8*rxt(k,450)*y(k,271) + mat(k,1696) = rxt(k,241)*y(k,61) + .800_r8*rxt(k,440)*y(k,103) + rxt(k,321) & + *y(k,131) + .700_r8*rxt(k,340)*y(k,235) + rxt(k,368)*y(k,236) & + + rxt(k,351)*y(k,238) + (4.000_r8*rxt(k,318)+2.000_r8*rxt(k,319)) & + *y(k,239) + 1.500_r8*rxt(k,426)*y(k,247) + .750_r8*rxt(k,431) & + *y(k,248) + .880_r8*rxt(k,393)*y(k,249) + 2.000_r8*rxt(k,402) & + *y(k,251) + .750_r8*rxt(k,505)*y(k,258) + .800_r8*rxt(k,381) & + *y(k,267) + .930_r8*rxt(k,510)*y(k,268) + .950_r8*rxt(k,515) & + *y(k,269) + .800_r8*rxt(k,451)*y(k,271) + mat(k,624) = .500_r8*rxt(k,389)*y(k,131) + mat(k,845) = .500_r8*rxt(k,357)*y(k,131) + mat(k,2422) = mat(k,2422) + .450_r8*rxt(k,403)*y(k,251) + .150_r8*rxt(k,382) & + *y(k,267) + mat(k,1354) = .920_r8*rxt(k,428)*y(k,131) + rxt(k,429)*y(k,133) + rxt(k,425) & + *y(k,238) + 1.500_r8*rxt(k,426)*y(k,239) + mat(k,1387) = .750_r8*rxt(k,431)*y(k,239) + mat(k,1408) = .250_r8*rxt(k,396)*y(k,131) + .250_r8*rxt(k,395)*y(k,133) & + + .250_r8*rxt(k,392)*y(k,238) + .880_r8*rxt(k,393)*y(k,239) + mat(k,1449) = rxt(k,405)*y(k,131) + rxt(k,406)*y(k,133) + rxt(k,401)*y(k,238) & + + 2.000_r8*rxt(k,402)*y(k,239) + .450_r8*rxt(k,403)*y(k,245) & + + 4.000_r8*rxt(k,404)*y(k,251) + mat(k,1142) = .750_r8*rxt(k,505)*y(k,239) + mat(k,2045) = (rxt(k,331)+rxt(k,332))*y(k,56) + mat(k,1913) = mat(k,1913) + .400_r8*rxt(k,416)*y(k,1) + .500_r8*rxt(k,355) & + *y(k,53) + rxt(k,322)*y(k,54) + .300_r8*rxt(k,323)*y(k,55) & + + .800_r8*rxt(k,360)*y(k,76) + .300_r8*rxt(k,436)*y(k,101) & + + .500_r8*rxt(k,411)*y(k,115) + rxt(k,362)*y(k,147) & + + .680_r8*rxt(k,521)*y(k,219) + mat(k,867) = rxt(k,379)*y(k,131) + mat(k,1266) = rxt(k,383)*y(k,131) + .800_r8*rxt(k,381)*y(k,239) & + + .150_r8*rxt(k,382)*y(k,245) + mat(k,1229) = .340_r8*rxt(k,512)*y(k,131) + .930_r8*rxt(k,510)*y(k,239) + mat(k,1100) = .320_r8*rxt(k,517)*y(k,131) + .950_r8*rxt(k,515)*y(k,239) + mat(k,1284) = .250_r8*rxt(k,453)*y(k,131) + .250_r8*rxt(k,450)*y(k,238) & + + .800_r8*rxt(k,451)*y(k,239) + 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,626) = -(rxt(k,299)*y(k,58) + rxt(k,300)*y(k,263) + rxt(k,310)*y(k,259)) + mat(k,1967) = -rxt(k,299)*y(k,45) + mat(k,1829) = -rxt(k,300)*y(k,45) + mat(k,2024) = -rxt(k,310)*y(k,45) + mat(k,167) = -(rxt(k,301)*y(k,263)) + mat(k,1767) = -rxt(k,301)*y(k,46) + mat(k,1193) = -(rxt(k,347)*y(k,133) + rxt(k,348)*y(k,263)) + mat(k,2267) = -rxt(k,347)*y(k,47) + mat(k,1876) = -rxt(k,348)*y(k,47) + mat(k,712) = .800_r8*rxt(k,416)*y(k,263) + mat(k,410) = rxt(k,387)*y(k,133) + mat(k,310) = rxt(k,343)*y(k,263) + mat(k,378) = .500_r8*rxt(k,344)*y(k,263) + mat(k,1176) = .500_r8*rxt(k,367)*y(k,142) + mat(k,1413) = .100_r8*rxt(k,412)*y(k,142) + mat(k,2208) = .400_r8*rxt(k,418)*y(k,232) + rxt(k,342)*y(k,235) & + + .270_r8*rxt(k,370)*y(k,236) + rxt(k,389)*y(k,242) + rxt(k,408) & + *y(k,253) + rxt(k,379)*y(k,266) + mat(k,2267) = mat(k,2267) + rxt(k,387)*y(k,18) + mat(k,2076) = .500_r8*rxt(k,367)*y(k,31) + .100_r8*rxt(k,412)*y(k,118) + mat(k,1074) = .400_r8*rxt(k,418)*y(k,131) + mat(k,954) = rxt(k,342)*y(k,131) + 3.200_r8*rxt(k,339)*y(k,235) & + + .800_r8*rxt(k,340)*y(k,239) + mat(k,979) = .270_r8*rxt(k,370)*y(k,131) + mat(k,1664) = .800_r8*rxt(k,340)*y(k,235) + mat(k,620) = rxt(k,389)*y(k,131) + mat(k,2387) = .200_r8*rxt(k,407)*y(k,253) + mat(k,720) = rxt(k,408)*y(k,131) + .200_r8*rxt(k,407)*y(k,245) + mat(k,1876) = mat(k,1876) + .800_r8*rxt(k,416)*y(k,1) + rxt(k,343)*y(k,28) & + + .500_r8*rxt(k,344)*y(k,29) + mat(k,861) = rxt(k,379)*y(k,131) + mat(k,399) = -(rxt(k,302)*y(k,58) + rxt(k,303)*y(k,263)) + mat(k,1963) = -rxt(k,302)*y(k,48) + mat(k,1801) = -rxt(k,303)*y(k,48) + mat(k,145) = -(rxt(k,349)*y(k,263)) + mat(k,1766) = -rxt(k,349)*y(k,49) + mat(k,1110) = -(rxt(k,386)*y(k,263)) + mat(k,1870) = -rxt(k,386)*y(k,50) + mat(k,711) = .800_r8*rxt(k,416)*y(k,263) + mat(k,1053) = .520_r8*rxt(k,500)*y(k,142) + mat(k,409) = .500_r8*rxt(k,387)*y(k,133) + mat(k,1025) = .520_r8*rxt(k,503)*y(k,142) + mat(k,2204) = .250_r8*rxt(k,418)*y(k,232) + .820_r8*rxt(k,370)*y(k,236) & + + .500_r8*rxt(k,389)*y(k,242) + .270_r8*rxt(k,512)*y(k,268) & + + .040_r8*rxt(k,517)*y(k,269) + mat(k,2262) = .500_r8*rxt(k,387)*y(k,18) + mat(k,2072) = .520_r8*rxt(k,500)*y(k,6) + .520_r8*rxt(k,503)*y(k,116) + mat(k,1144) = .500_r8*rxt(k,521)*y(k,263) + mat(k,1073) = .250_r8*rxt(k,418)*y(k,131) + mat(k,978) = .820_r8*rxt(k,370)*y(k,131) + .820_r8*rxt(k,368)*y(k,239) + mat(k,1660) = .820_r8*rxt(k,368)*y(k,236) + .150_r8*rxt(k,510)*y(k,268) & + + .025_r8*rxt(k,515)*y(k,269) + mat(k,619) = .500_r8*rxt(k,389)*y(k,131) + mat(k,1870) = mat(k,1870) + .800_r8*rxt(k,416)*y(k,1) + .500_r8*rxt(k,521) & + *y(k,219) + mat(k,1216) = .270_r8*rxt(k,512)*y(k,131) + .150_r8*rxt(k,510)*y(k,239) + mat(k,1094) = .040_r8*rxt(k,517)*y(k,131) + .025_r8*rxt(k,515)*y(k,239) + mat(k,1323) = -(rxt(k,373)*y(k,133) + rxt(k,374)*y(k,263)) + mat(k,2277) = -rxt(k,373)*y(k,51) + mat(k,1886) = -rxt(k,374)*y(k,51) + mat(k,1251) = rxt(k,376)*y(k,263) + mat(k,1312) = .880_r8*rxt(k,398)*y(k,142) + mat(k,1416) = .500_r8*rxt(k,412)*y(k,142) + mat(k,2218) = .170_r8*rxt(k,471)*y(k,240) + .050_r8*rxt(k,434)*y(k,248) & + + .250_r8*rxt(k,396)*y(k,249) + .170_r8*rxt(k,477)*y(k,252) & + + .400_r8*rxt(k,487)*y(k,270) + .250_r8*rxt(k,453)*y(k,271) & + + .540_r8*rxt(k,493)*y(k,272) + .510_r8*rxt(k,496)*y(k,273) + mat(k,2277) = mat(k,2277) + .050_r8*rxt(k,435)*y(k,248) + .250_r8*rxt(k,395) & + *y(k,249) + .250_r8*rxt(k,454)*y(k,271) + mat(k,916) = rxt(k,377)*y(k,263) + mat(k,2084) = .880_r8*rxt(k,398)*y(k,111) + .500_r8*rxt(k,412)*y(k,118) + mat(k,1464) = .250_r8*rxt(k,392)*y(k,249) + .250_r8*rxt(k,450)*y(k,271) + mat(k,1673) = .240_r8*rxt(k,393)*y(k,249) + .500_r8*rxt(k,381)*y(k,267) & + + .100_r8*rxt(k,451)*y(k,271) + mat(k,822) = .170_r8*rxt(k,471)*y(k,131) + .070_r8*rxt(k,470)*y(k,245) + mat(k,2396) = .070_r8*rxt(k,470)*y(k,240) + .070_r8*rxt(k,476)*y(k,252) + mat(k,1373) = .050_r8*rxt(k,434)*y(k,131) + .050_r8*rxt(k,435)*y(k,133) + mat(k,1397) = .250_r8*rxt(k,396)*y(k,131) + .250_r8*rxt(k,395)*y(k,133) & + + .250_r8*rxt(k,392)*y(k,238) + .240_r8*rxt(k,393)*y(k,239) + mat(k,970) = .170_r8*rxt(k,477)*y(k,131) + .070_r8*rxt(k,476)*y(k,245) + mat(k,1886) = mat(k,1886) + rxt(k,376)*y(k,97) + rxt(k,377)*y(k,134) + mat(k,1260) = .500_r8*rxt(k,381)*y(k,239) + mat(k,798) = .400_r8*rxt(k,487)*y(k,131) + mat(k,1276) = .250_r8*rxt(k,453)*y(k,131) + .250_r8*rxt(k,454)*y(k,133) & + + .250_r8*rxt(k,450)*y(k,238) + .100_r8*rxt(k,451)*y(k,239) + mat(k,814) = .540_r8*rxt(k,493)*y(k,131) + mat(k,556) = .510_r8*rxt(k,496)*y(k,131) + mat(k,747) = -(rxt(k,354)*y(k,263)) + mat(k,1842) = -rxt(k,354)*y(k,52) + mat(k,1171) = .120_r8*rxt(k,367)*y(k,142) + mat(k,2060) = .120_r8*rxt(k,367)*y(k,31) + mat(k,1455) = .100_r8*rxt(k,351)*y(k,239) + .150_r8*rxt(k,352)*y(k,245) + mat(k,1652) = .100_r8*rxt(k,351)*y(k,238) + mat(k,2363) = .150_r8*rxt(k,352)*y(k,238) + .150_r8*rxt(k,403)*y(k,251) + mat(k,1436) = .150_r8*rxt(k,403)*y(k,245) + mat(k,635) = -(rxt(k,355)*y(k,263)) + mat(k,1830) = -rxt(k,355)*y(k,53) + mat(k,1454) = .400_r8*rxt(k,352)*y(k,245) + mat(k,2355) = .400_r8*rxt(k,352)*y(k,238) + .400_r8*rxt(k,403)*y(k,251) + mat(k,1434) = .400_r8*rxt(k,403)*y(k,245) + mat(k,855) = -(rxt(k,322)*y(k,263)) + mat(k,1851) = -rxt(k,322)*y(k,54) + mat(k,1289) = .200_r8*rxt(k,440)*y(k,239) + mat(k,952) = .300_r8*rxt(k,340)*y(k,239) + mat(k,1653) = .200_r8*rxt(k,440)*y(k,103) + .300_r8*rxt(k,340)*y(k,235) & + + 2.000_r8*rxt(k,319)*y(k,239) + .250_r8*rxt(k,426)*y(k,247) & + + .250_r8*rxt(k,431)*y(k,248) + .250_r8*rxt(k,393)*y(k,249) & + + .250_r8*rxt(k,505)*y(k,258) + .500_r8*rxt(k,381)*y(k,267) & + + .250_r8*rxt(k,510)*y(k,268) + .250_r8*rxt(k,515)*y(k,269) & + + .300_r8*rxt(k,451)*y(k,271) + mat(k,1333) = .250_r8*rxt(k,426)*y(k,239) + mat(k,1362) = .250_r8*rxt(k,431)*y(k,239) + mat(k,1391) = .250_r8*rxt(k,393)*y(k,239) + mat(k,1130) = .250_r8*rxt(k,505)*y(k,239) + mat(k,1257) = .500_r8*rxt(k,381)*y(k,239) + mat(k,1215) = .250_r8*rxt(k,510)*y(k,239) + mat(k,1091) = .250_r8*rxt(k,515)*y(k,239) + mat(k,1270) = .300_r8*rxt(k,451)*y(k,239) + mat(k,441) = -(rxt(k,323)*y(k,263)) + mat(k,1806) = -rxt(k,323)*y(k,55) + mat(k,1649) = rxt(k,320)*y(k,245) + mat(k,2338) = rxt(k,320)*y(k,239) + mat(k,1631) = -(rxt(k,235)*y(k,58) + rxt(k,291)*y(k,75) + rxt(k,324)*y(k,263) & + + (rxt(k,330) + rxt(k,331) + rxt(k,332)) * y(k,259)) + mat(k,1989) = -rxt(k,235)*y(k,56) + mat(k,943) = -rxt(k,291)*y(k,56) + mat(k,1900) = -rxt(k,324)*y(k,56) + mat(k,2032) = -(rxt(k,330) + rxt(k,331) + rxt(k,332)) * y(k,56) + mat(k,1183) = .100_r8*rxt(k,367)*y(k,142) + mat(k,2096) = .100_r8*rxt(k,367)*y(k,31) + mat(k,447) = -(rxt(k,287)*y(k,259) + rxt(k,304)*y(k,58) + rxt(k,305)*y(k,263)) + mat(k,2022) = -rxt(k,287)*y(k,57) + mat(k,1964) = -rxt(k,304)*y(k,57) + mat(k,1807) = -rxt(k,305)*y(k,57) + mat(k,1995) = -(rxt(k,234)*y(k,44) + rxt(k,235)*y(k,56) + rxt(k,236)*y(k,79) & + + rxt(k,237)*y(k,81) + (rxt(k,238) + rxt(k,239)) * y(k,245) & + + rxt(k,240)*y(k,142) + rxt(k,247)*y(k,62) + rxt(k,256)*y(k,94) & + + rxt(k,297)*y(k,43) + rxt(k,299)*y(k,45) + rxt(k,302)*y(k,48) & + + rxt(k,304)*y(k,57) + rxt(k,345)*y(k,30) + rxt(k,375)*y(k,33)) + mat(k,2441) = -rxt(k,234)*y(k,58) + mat(k,1637) = -rxt(k,235)*y(k,58) + mat(k,1511) = -rxt(k,236)*y(k,58) + mat(k,675) = -rxt(k,237)*y(k,58) + mat(k,2415) = -(rxt(k,238) + rxt(k,239)) * y(k,58) + mat(k,2102) = -rxt(k,240)*y(k,58) + mat(k,1123) = -rxt(k,247)*y(k,58) + mat(k,883) = -rxt(k,256)*y(k,58) + mat(k,523) = -rxt(k,297)*y(k,58) + mat(k,631) = -rxt(k,299)*y(k,58) + mat(k,404) = -rxt(k,302)*y(k,58) + mat(k,451) = -rxt(k,304)*y(k,58) + mat(k,327) = -rxt(k,345)*y(k,58) + mat(k,333) = -rxt(k,375)*y(k,58) + mat(k,1612) = rxt(k,275)*y(k,61) + mat(k,143) = 4.000_r8*rxt(k,259)*y(k,259) + mat(k,180) = rxt(k,260)*y(k,259) + mat(k,157) = 2.000_r8*rxt(k,261)*y(k,259) + mat(k,190) = 2.000_r8*rxt(k,262)*y(k,259) + mat(k,161) = 2.000_r8*rxt(k,263)*y(k,259) + mat(k,195) = rxt(k,264)*y(k,259) + mat(k,165) = 2.000_r8*rxt(k,265)*y(k,259) + mat(k,169) = 3.000_r8*rxt(k,301)*y(k,263) + mat(k,404) = mat(k,404) + rxt(k,303)*y(k,263) + mat(k,2129) = rxt(k,275)*y(k,21) + (4.000_r8*rxt(k,242)+2.000_r8*rxt(k,244)) & + *y(k,61) + rxt(k,246)*y(k,131) + rxt(k,251)*y(k,140) & + + rxt(k,530)*y(k,160) + rxt(k,241)*y(k,239) + rxt(k,252) & + *y(k,263) + mat(k,292) = rxt(k,296)*y(k,259) + mat(k,288) = rxt(k,311)*y(k,259) + rxt(k,306)*y(k,263) + mat(k,298) = rxt(k,312)*y(k,259) + rxt(k,307)*y(k,263) + mat(k,357) = rxt(k,313)*y(k,259) + rxt(k,308)*y(k,263) + mat(k,1544) = rxt(k,254)*y(k,140) + rxt(k,266)*y(k,259) + rxt(k,255)*y(k,263) + mat(k,2235) = rxt(k,246)*y(k,61) + mat(k,1949) = rxt(k,251)*y(k,61) + rxt(k,254)*y(k,87) + mat(k,1525) = rxt(k,530)*y(k,61) + mat(k,1689) = rxt(k,241)*y(k,61) + mat(k,2038) = 4.000_r8*rxt(k,259)*y(k,35) + rxt(k,260)*y(k,36) & + + 2.000_r8*rxt(k,261)*y(k,38) + 2.000_r8*rxt(k,262)*y(k,39) & + + 2.000_r8*rxt(k,263)*y(k,40) + rxt(k,264)*y(k,41) & + + 2.000_r8*rxt(k,265)*y(k,42) + rxt(k,296)*y(k,67) + rxt(k,311) & + *y(k,84) + rxt(k,312)*y(k,85) + rxt(k,313)*y(k,86) + rxt(k,266) & + *y(k,87) + mat(k,1906) = 3.000_r8*rxt(k,301)*y(k,46) + rxt(k,303)*y(k,48) + rxt(k,252) & + *y(k,61) + rxt(k,306)*y(k,84) + rxt(k,307)*y(k,85) + rxt(k,308) & + *y(k,86) + rxt(k,255)*y(k,87) + mat(k,1959) = rxt(k,247)*y(k,62) + mat(k,2113) = 2.000_r8*rxt(k,243)*y(k,61) + mat(k,1116) = rxt(k,247)*y(k,58) + (rxt(k,592)+rxt(k,597)+rxt(k,602))*y(k,87) + mat(k,1532) = (rxt(k,592)+rxt(k,597)+rxt(k,602))*y(k,62) + (rxt(k,587) & + +rxt(k,593)+rxt(k,598))*y(k,94) + mat(k,878) = (rxt(k,587)+rxt(k,593)+rxt(k,598))*y(k,87) + mat(k,2112) = 2.000_r8*rxt(k,268)*y(k,61) + mat(k,2132) = -(rxt(k,241)*y(k,239) + (4._r8*rxt(k,242) + 4._r8*rxt(k,243) & + + 4._r8*rxt(k,244) + 4._r8*rxt(k,268)) * y(k,61) + rxt(k,245) & + *y(k,245) + rxt(k,246)*y(k,131) + rxt(k,248)*y(k,132) + rxt(k,251) & + *y(k,140) + (rxt(k,252) + rxt(k,253)) * y(k,263) + (rxt(k,274) & + + rxt(k,275) + rxt(k,276)) * y(k,21) + rxt(k,530)*y(k,160)) + mat(k,1692) = -rxt(k,241)*y(k,61) + mat(k,2418) = -rxt(k,245)*y(k,61) + mat(k,2238) = -rxt(k,246)*y(k,61) + mat(k,2489) = -rxt(k,248)*y(k,61) + mat(k,1952) = -rxt(k,251)*y(k,61) + mat(k,1909) = -(rxt(k,252) + rxt(k,253)) * y(k,61) + mat(k,1615) = -(rxt(k,274) + rxt(k,275) + rxt(k,276)) * y(k,61) + mat(k,1527) = -rxt(k,530)*y(k,61) + mat(k,1998) = rxt(k,256)*y(k,94) + rxt(k,240)*y(k,142) + rxt(k,239)*y(k,245) + mat(k,1124) = rxt(k,249)*y(k,140) + mat(k,1546) = rxt(k,267)*y(k,259) + mat(k,884) = rxt(k,256)*y(k,58) + rxt(k,257)*y(k,140) + rxt(k,258)*y(k,263) + mat(k,1952) = mat(k,1952) + rxt(k,249)*y(k,62) + rxt(k,257)*y(k,94) + mat(k,2105) = rxt(k,240)*y(k,58) + mat(k,364) = rxt(k,535)*y(k,160) + mat(k,1527) = mat(k,1527) + rxt(k,535)*y(k,144) + mat(k,2418) = mat(k,2418) + rxt(k,239)*y(k,58) + mat(k,2041) = rxt(k,267)*y(k,87) + mat(k,1909) = mat(k,1909) + rxt(k,258)*y(k,94) + 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,1118) = -(rxt(k,247)*y(k,58) + rxt(k,249)*y(k,140) + rxt(k,250) & + *y(k,263) + (rxt(k,592) + rxt(k,597) + rxt(k,602)) * y(k,87)) + mat(k,1976) = -rxt(k,247)*y(k,62) + mat(k,1934) = -rxt(k,249)*y(k,62) + mat(k,1871) = -rxt(k,250)*y(k,62) + mat(k,1536) = -(rxt(k,592) + rxt(k,597) + rxt(k,602)) * y(k,62) + mat(k,2118) = rxt(k,248)*y(k,132) + mat(k,2468) = rxt(k,248)*y(k,61) + mat(k,1202) = -(rxt(k,334)*y(k,263)) + mat(k,1877) = -rxt(k,334)*y(k,64) + mat(k,1056) = .230_r8*rxt(k,500)*y(k,142) + mat(k,1551) = rxt(k,270)*y(k,44) + mat(k,320) = .350_r8*rxt(k,336)*y(k,263) + mat(k,581) = .630_r8*rxt(k,338)*y(k,142) + mat(k,1177) = .560_r8*rxt(k,367)*y(k,142) + mat(k,2428) = rxt(k,270)*y(k,19) + rxt(k,234)*y(k,58) + rxt(k,315)*y(k,133) & + + rxt(k,316)*y(k,140) + rxt(k,317)*y(k,263) + mat(k,400) = rxt(k,302)*y(k,58) + mat(k,1322) = rxt(k,373)*y(k,133) + rxt(k,374)*y(k,263) + mat(k,1978) = rxt(k,234)*y(k,44) + rxt(k,302)*y(k,48) + mat(k,1491) = rxt(k,615)*y(k,264) + mat(k,1085) = rxt(k,361)*y(k,263) + mat(k,927) = .620_r8*rxt(k,445)*y(k,142) + mat(k,1310) = .650_r8*rxt(k,398)*y(k,142) + mat(k,1028) = .230_r8*rxt(k,503)*y(k,142) + mat(k,1414) = .560_r8*rxt(k,412)*y(k,142) + mat(k,2209) = .170_r8*rxt(k,471)*y(k,240) + .220_r8*rxt(k,396)*y(k,249) & + + .400_r8*rxt(k,474)*y(k,250) + .350_r8*rxt(k,477)*y(k,252) & + + .225_r8*rxt(k,512)*y(k,268) + .250_r8*rxt(k,453)*y(k,271) + mat(k,2268) = rxt(k,315)*y(k,44) + rxt(k,373)*y(k,51) + .220_r8*rxt(k,395) & + *y(k,249) + .500_r8*rxt(k,454)*y(k,271) + mat(k,1935) = rxt(k,316)*y(k,44) + rxt(k,524)*y(k,145) + mat(k,2077) = .230_r8*rxt(k,500)*y(k,6) + .630_r8*rxt(k,338)*y(k,27) & + + .560_r8*rxt(k,367)*y(k,31) + .620_r8*rxt(k,445)*y(k,100) & + + .650_r8*rxt(k,398)*y(k,111) + .230_r8*rxt(k,503)*y(k,116) & + + .560_r8*rxt(k,412)*y(k,118) + mat(k,418) = rxt(k,524)*y(k,140) + rxt(k,525)*y(k,263) + mat(k,1146) = .700_r8*rxt(k,521)*y(k,263) + mat(k,1458) = .220_r8*rxt(k,392)*y(k,249) + .250_r8*rxt(k,450)*y(k,271) + mat(k,1665) = .110_r8*rxt(k,393)*y(k,249) + .125_r8*rxt(k,510)*y(k,268) & + + .200_r8*rxt(k,451)*y(k,271) + mat(k,821) = .170_r8*rxt(k,471)*y(k,131) + .070_r8*rxt(k,470)*y(k,245) + mat(k,2388) = .070_r8*rxt(k,470)*y(k,240) + .160_r8*rxt(k,473)*y(k,250) & + + .140_r8*rxt(k,476)*y(k,252) + mat(k,1392) = .220_r8*rxt(k,396)*y(k,131) + .220_r8*rxt(k,395)*y(k,133) & + + .220_r8*rxt(k,392)*y(k,238) + .110_r8*rxt(k,393)*y(k,239) + mat(k,784) = .400_r8*rxt(k,474)*y(k,131) + .160_r8*rxt(k,473)*y(k,245) + mat(k,969) = .350_r8*rxt(k,477)*y(k,131) + .140_r8*rxt(k,476)*y(k,245) + mat(k,1877) = mat(k,1877) + .350_r8*rxt(k,336)*y(k,26) + rxt(k,317)*y(k,44) & + + rxt(k,374)*y(k,51) + rxt(k,361)*y(k,77) + rxt(k,525)*y(k,145) & + + .700_r8*rxt(k,521)*y(k,219) + mat(k,851) = rxt(k,615)*y(k,65) + mat(k,1218) = .225_r8*rxt(k,512)*y(k,131) + .125_r8*rxt(k,510)*y(k,239) + mat(k,1272) = .250_r8*rxt(k,453)*y(k,131) + .500_r8*rxt(k,454)*y(k,133) & + + .250_r8*rxt(k,450)*y(k,238) + .200_r8*rxt(k,451)*y(k,239) + mat(k,1492) = -(rxt(k,615)*y(k,264)) + mat(k,852) = -rxt(k,615)*y(k,65) + mat(k,1060) = .270_r8*rxt(k,500)*y(k,142) + mat(k,1181) = .200_r8*rxt(k,367)*y(k,142) + mat(k,748) = rxt(k,354)*y(k,263) + mat(k,637) = .500_r8*rxt(k,355)*y(k,263) + mat(k,1203) = rxt(k,334)*y(k,263) + mat(k,1209) = .800_r8*rxt(k,360)*y(k,263) + mat(k,1086) = rxt(k,361)*y(k,263) + mat(k,963) = rxt(k,326)*y(k,263) + mat(k,665) = .500_r8*rxt(k,411)*y(k,263) + mat(k,1032) = .270_r8*rxt(k,503)*y(k,142) + mat(k,1421) = .100_r8*rxt(k,412)*y(k,142) + mat(k,2225) = rxt(k,353)*y(k,238) + .900_r8*rxt(k,512)*y(k,268) + mat(k,2091) = .270_r8*rxt(k,500)*y(k,6) + .200_r8*rxt(k,367)*y(k,31) & + + .270_r8*rxt(k,503)*y(k,116) + .100_r8*rxt(k,412)*y(k,118) + mat(k,1149) = 1.800_r8*rxt(k,521)*y(k,263) + mat(k,1471) = rxt(k,353)*y(k,131) + 4.000_r8*rxt(k,350)*y(k,238) & + + .900_r8*rxt(k,351)*y(k,239) + rxt(k,425)*y(k,247) & + + 2.000_r8*rxt(k,401)*y(k,251) + rxt(k,450)*y(k,271) + mat(k,1680) = .900_r8*rxt(k,351)*y(k,238) + rxt(k,402)*y(k,251) & + + .500_r8*rxt(k,510)*y(k,268) + mat(k,2403) = .450_r8*rxt(k,403)*y(k,251) + mat(k,1346) = rxt(k,425)*y(k,238) + mat(k,1441) = 2.000_r8*rxt(k,401)*y(k,238) + rxt(k,402)*y(k,239) & + + .450_r8*rxt(k,403)*y(k,245) + 4.000_r8*rxt(k,404)*y(k,251) + mat(k,1893) = rxt(k,354)*y(k,52) + .500_r8*rxt(k,355)*y(k,53) + rxt(k,334) & + *y(k,64) + .800_r8*rxt(k,360)*y(k,76) + rxt(k,361)*y(k,77) & + + rxt(k,326)*y(k,89) + .500_r8*rxt(k,411)*y(k,115) & + + 1.800_r8*rxt(k,521)*y(k,219) + mat(k,1223) = .900_r8*rxt(k,512)*y(k,131) + .500_r8*rxt(k,510)*y(k,239) + mat(k,1278) = rxt(k,450)*y(k,238) + mat(k,282) = -(rxt(k,295)*y(k,259)) + mat(k,2016) = -rxt(k,295)*y(k,66) + mat(k,178) = rxt(k,260)*y(k,259) + mat(k,183) = rxt(k,286)*y(k,259) + mat(k,188) = rxt(k,262)*y(k,259) + mat(k,160) = 2.000_r8*rxt(k,263)*y(k,259) + mat(k,193) = 2.000_r8*rxt(k,264)*y(k,259) + mat(k,164) = rxt(k,265)*y(k,259) + mat(k,152) = 2.000_r8*rxt(k,288)*y(k,259) + mat(k,294) = rxt(k,312)*y(k,259) + rxt(k,307)*y(k,263) + mat(k,353) = rxt(k,313)*y(k,259) + rxt(k,308)*y(k,263) + mat(k,2016) = mat(k,2016) + rxt(k,260)*y(k,36) + rxt(k,286)*y(k,37) & + + rxt(k,262)*y(k,39) + 2.000_r8*rxt(k,263)*y(k,40) & + + 2.000_r8*rxt(k,264)*y(k,41) + rxt(k,265)*y(k,42) & + + 2.000_r8*rxt(k,288)*y(k,80) + rxt(k,312)*y(k,85) + rxt(k,313) & + *y(k,86) + mat(k,1783) = rxt(k,307)*y(k,85) + rxt(k,308)*y(k,86) + mat(k,290) = -(rxt(k,296)*y(k,259)) + mat(k,2018) = -rxt(k,296)*y(k,67) + mat(k,156) = rxt(k,261)*y(k,259) + mat(k,189) = rxt(k,262)*y(k,259) + mat(k,286) = rxt(k,311)*y(k,259) + rxt(k,306)*y(k,263) + mat(k,2018) = mat(k,2018) + rxt(k,261)*y(k,38) + rxt(k,262)*y(k,39) & + + rxt(k,311)*y(k,84) + mat(k,1785) = rxt(k,306)*y(k,84) + mat(k,238) = -(rxt(k,469)*y(k,263)) + mat(k,1774) = -rxt(k,469)*y(k,68) + mat(k,232) = .180_r8*rxt(k,489)*y(k,263) + mat(k,1774) = mat(k,1774) + .180_r8*rxt(k,489)*y(k,221) + mat(k,347) = -(rxt(k,522)*y(k,133) + (rxt(k,523) + rxt(k,537)) * y(k,263)) + mat(k,2248) = -rxt(k,522)*y(k,69) + mat(k,1793) = -(rxt(k,523) + rxt(k,537)) * y(k,69) + mat(k,837) = rxt(k,356)*y(k,245) + mat(k,2328) = rxt(k,356)*y(k,244) + mat(k,941) = -(rxt(k,291)*y(k,56) + rxt(k,292)*y(k,79) + rxt(k,293)*y(k,274) & + + rxt(k,294)*y(k,91)) + mat(k,1623) = -rxt(k,291)*y(k,75) + mat(k,1502) = -rxt(k,292)*y(k,75) + mat(k,2499) = -rxt(k,293)*y(k,75) + mat(k,1700) = -rxt(k,294)*y(k,75) + mat(k,184) = rxt(k,286)*y(k,259) + mat(k,194) = rxt(k,264)*y(k,259) + mat(k,283) = 2.000_r8*rxt(k,295)*y(k,259) + mat(k,291) = rxt(k,296)*y(k,259) + mat(k,2026) = rxt(k,286)*y(k,37) + rxt(k,264)*y(k,41) + 2.000_r8*rxt(k,295) & + *y(k,66) + rxt(k,296)*y(k,67) + mat(k,1208) = -(rxt(k,360)*y(k,263)) + mat(k,1878) = -rxt(k,360)*y(k,76) + mat(k,643) = .700_r8*rxt(k,436)*y(k,263) + mat(k,612) = .500_r8*rxt(k,437)*y(k,263) + mat(k,461) = rxt(k,448)*y(k,263) + mat(k,2210) = .050_r8*rxt(k,434)*y(k,248) + .530_r8*rxt(k,396)*y(k,249) & + + .225_r8*rxt(k,512)*y(k,268) + .250_r8*rxt(k,453)*y(k,271) + mat(k,2269) = .050_r8*rxt(k,435)*y(k,248) + .530_r8*rxt(k,395)*y(k,249) & + + .250_r8*rxt(k,454)*y(k,271) + mat(k,1580) = rxt(k,359)*y(k,243) + mat(k,1459) = .530_r8*rxt(k,392)*y(k,249) + .250_r8*rxt(k,450)*y(k,271) + mat(k,1666) = .260_r8*rxt(k,393)*y(k,249) + .125_r8*rxt(k,510)*y(k,268) & + + .100_r8*rxt(k,451)*y(k,271) + mat(k,508) = rxt(k,359)*y(k,141) + mat(k,1367) = .050_r8*rxt(k,434)*y(k,131) + .050_r8*rxt(k,435)*y(k,133) + mat(k,1393) = .530_r8*rxt(k,396)*y(k,131) + .530_r8*rxt(k,395)*y(k,133) & + + .530_r8*rxt(k,392)*y(k,238) + .260_r8*rxt(k,393)*y(k,239) + mat(k,1878) = mat(k,1878) + .700_r8*rxt(k,436)*y(k,101) + .500_r8*rxt(k,437) & + *y(k,102) + rxt(k,448)*y(k,122) + mat(k,1219) = .225_r8*rxt(k,512)*y(k,131) + .125_r8*rxt(k,510)*y(k,239) + mat(k,1273) = .250_r8*rxt(k,453)*y(k,131) + .250_r8*rxt(k,454)*y(k,133) & + + .250_r8*rxt(k,450)*y(k,238) + .100_r8*rxt(k,451)*y(k,239) + mat(k,1084) = -(rxt(k,361)*y(k,263)) + mat(k,1867) = -rxt(k,361)*y(k,77) + mat(k,319) = .650_r8*rxt(k,336)*y(k,263) + mat(k,1206) = .200_r8*rxt(k,360)*y(k,263) + mat(k,1158) = rxt(k,449)*y(k,263) + mat(k,2201) = rxt(k,460)*y(k,233) + .050_r8*rxt(k,434)*y(k,248) & + + .400_r8*rxt(k,474)*y(k,250) + .170_r8*rxt(k,477)*y(k,252) & + + .700_r8*rxt(k,480)*y(k,265) + .600_r8*rxt(k,487)*y(k,270) & + + .250_r8*rxt(k,453)*y(k,271) + .340_r8*rxt(k,493)*y(k,272) & + + .170_r8*rxt(k,496)*y(k,273) + mat(k,2259) = .050_r8*rxt(k,435)*y(k,248) + .250_r8*rxt(k,454)*y(k,271) + mat(k,541) = rxt(k,460)*y(k,131) + mat(k,1456) = .250_r8*rxt(k,450)*y(k,271) + mat(k,1657) = .100_r8*rxt(k,451)*y(k,271) + mat(k,2381) = .160_r8*rxt(k,473)*y(k,250) + .070_r8*rxt(k,476)*y(k,252) + mat(k,1365) = .050_r8*rxt(k,434)*y(k,131) + .050_r8*rxt(k,435)*y(k,133) + mat(k,783) = .400_r8*rxt(k,474)*y(k,131) + .160_r8*rxt(k,473)*y(k,245) + mat(k,968) = .170_r8*rxt(k,477)*y(k,131) + .070_r8*rxt(k,476)*y(k,245) + mat(k,1867) = mat(k,1867) + .650_r8*rxt(k,336)*y(k,26) + .200_r8*rxt(k,360) & + *y(k,76) + rxt(k,449)*y(k,123) + mat(k,499) = .700_r8*rxt(k,480)*y(k,131) + mat(k,796) = .600_r8*rxt(k,487)*y(k,131) + mat(k,1271) = .250_r8*rxt(k,453)*y(k,131) + .250_r8*rxt(k,454)*y(k,133) & + + .250_r8*rxt(k,450)*y(k,238) + .100_r8*rxt(k,451)*y(k,239) + mat(k,812) = .340_r8*rxt(k,493)*y(k,131) + mat(k,555) = .170_r8*rxt(k,496)*y(k,131) + mat(k,1730) = -((rxt(k,192) + rxt(k,193) + rxt(k,194)) * y(k,245) + rxt(k,195) & + *y(k,141) + rxt(k,198)*y(k,142)) + mat(k,2412) = -(rxt(k,192) + rxt(k,193) + rxt(k,194)) * y(k,78) + mat(k,1586) = -rxt(k,195)*y(k,78) + mat(k,2099) = -rxt(k,198)*y(k,78) + mat(k,2438) = rxt(k,317)*y(k,263) + mat(k,1634) = rxt(k,331)*y(k,259) + mat(k,1992) = rxt(k,236)*y(k,79) + mat(k,946) = rxt(k,292)*y(k,79) + mat(k,1508) = rxt(k,236)*y(k,58) + rxt(k,292)*y(k,75) + rxt(k,190)*y(k,140) & + + rxt(k,173)*y(k,259) + rxt(k,199)*y(k,263) + mat(k,873) = rxt(k,290)*y(k,259) + mat(k,1541) = rxt(k,267)*y(k,259) + mat(k,1005) = rxt(k,222)*y(k,263) + mat(k,1946) = rxt(k,190)*y(k,79) + rxt(k,202)*y(k,263) + mat(k,420) = rxt(k,525)*y(k,263) + mat(k,778) = rxt(k,531)*y(k,263) + mat(k,1522) = rxt(k,536)*y(k,263) + mat(k,2035) = rxt(k,331)*y(k,56) + rxt(k,173)*y(k,79) + rxt(k,290)*y(k,83) & + + rxt(k,267)*y(k,87) + mat(k,1903) = rxt(k,317)*y(k,44) + rxt(k,199)*y(k,79) + rxt(k,222)*y(k,119) & + + rxt(k,202)*y(k,140) + rxt(k,525)*y(k,145) + rxt(k,531) & + *y(k,158) + rxt(k,536)*y(k,160) + 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,1503) = -(rxt(k,173)*y(k,259) + rxt(k,190)*y(k,140) + rxt(k,199) & + *y(k,263) + rxt(k,236)*y(k,58) + rxt(k,292)*y(k,75)) + mat(k,2027) = -rxt(k,173)*y(k,79) + mat(k,1937) = -rxt(k,190)*y(k,79) + mat(k,1894) = -rxt(k,199)*y(k,79) + mat(k,1984) = -rxt(k,236)*y(k,79) + mat(k,942) = -rxt(k,292)*y(k,79) + mat(k,1626) = rxt(k,332)*y(k,259) + mat(k,1722) = rxt(k,192)*y(k,245) + mat(k,2404) = rxt(k,192)*y(k,78) + mat(k,2027) = mat(k,2027) + rxt(k,332)*y(k,56) + mat(k,151) = -(rxt(k,288)*y(k,259)) + mat(k,2006) = -rxt(k,288)*y(k,80) + mat(k,671) = -(rxt(k,191)*y(k,140) + rxt(k,200)*y(k,263) + rxt(k,237)*y(k,58)) + mat(k,1922) = -rxt(k,191)*y(k,81) + mat(k,1834) = -rxt(k,200)*y(k,81) + mat(k,1968) = -rxt(k,237)*y(k,81) + mat(k,2357) = 2.000_r8*rxt(k,206)*y(k,245) + mat(k,1834) = mat(k,1834) + 2.000_r8*rxt(k,205)*y(k,263) + mat(k,304) = rxt(k,538)*y(k,274) + mat(k,2496) = rxt(k,538)*y(k,162) + mat(k,870) = -(rxt(k,283)*y(k,140) + rxt(k,284)*y(k,263) + (rxt(k,289) & + + rxt(k,290)) * y(k,259)) + mat(k,1927) = -rxt(k,283)*y(k,83) + mat(k,1853) = -rxt(k,284)*y(k,83) + mat(k,2025) = -(rxt(k,289) + rxt(k,290)) * y(k,83) + mat(k,1550) = rxt(k,270)*y(k,44) + rxt(k,271)*y(k,245) + mat(k,2426) = rxt(k,270)*y(k,19) + mat(k,2373) = rxt(k,271)*y(k,19) + mat(k,285) = -(rxt(k,306)*y(k,263) + rxt(k,311)*y(k,259)) + mat(k,1784) = -rxt(k,306)*y(k,84) + mat(k,2017) = -rxt(k,311)*y(k,84) + mat(k,295) = -(rxt(k,307)*y(k,263) + rxt(k,312)*y(k,259)) + mat(k,1786) = -rxt(k,307)*y(k,85) + mat(k,2019) = -rxt(k,312)*y(k,85) + mat(k,354) = -(rxt(k,308)*y(k,263) + rxt(k,313)*y(k,259)) + mat(k,1794) = -rxt(k,308)*y(k,86) + mat(k,2021) = -rxt(k,313)*y(k,86) + mat(k,1537) = -(rxt(k,254)*y(k,140) + rxt(k,255)*y(k,263) + (rxt(k,266) & + + rxt(k,267)) * y(k,259) + (rxt(k,587) + rxt(k,593) + rxt(k,598) & + ) * y(k,94) + (rxt(k,592) + rxt(k,597) + rxt(k,602)) * y(k,62) & + + (rxt(k,594) + rxt(k,599)) * y(k,93)) + mat(k,1939) = -rxt(k,254)*y(k,87) + mat(k,1896) = -rxt(k,255)*y(k,87) + mat(k,2028) = -(rxt(k,266) + rxt(k,267)) * y(k,87) + mat(k,880) = -(rxt(k,587) + rxt(k,593) + rxt(k,598)) * y(k,87) + mat(k,1119) = -(rxt(k,592) + rxt(k,597) + rxt(k,602)) * y(k,87) + mat(k,830) = -(rxt(k,594) + rxt(k,599)) * y(k,87) + mat(k,325) = rxt(k,345)*y(k,58) + mat(k,331) = rxt(k,375)*y(k,58) + mat(k,520) = rxt(k,297)*y(k,58) + mat(k,2431) = rxt(k,234)*y(k,58) + mat(k,627) = rxt(k,299)*y(k,58) + mat(k,401) = 2.000_r8*rxt(k,302)*y(k,58) + mat(k,1627) = rxt(k,235)*y(k,58) + mat(k,448) = rxt(k,304)*y(k,58) + mat(k,1985) = rxt(k,345)*y(k,30) + rxt(k,375)*y(k,33) + rxt(k,297)*y(k,43) & + + rxt(k,234)*y(k,44) + rxt(k,299)*y(k,45) + 2.000_r8*rxt(k,302) & + *y(k,48) + rxt(k,235)*y(k,56) + rxt(k,304)*y(k,57) + rxt(k,236) & + *y(k,79) + rxt(k,237)*y(k,81) + rxt(k,256)*y(k,94) + rxt(k,238) & + *y(k,245) + mat(k,2120) = rxt(k,253)*y(k,263) + mat(k,1504) = rxt(k,236)*y(k,58) + mat(k,672) = rxt(k,237)*y(k,58) + mat(k,880) = mat(k,880) + rxt(k,256)*y(k,58) + mat(k,2405) = rxt(k,238)*y(k,58) + mat(k,1896) = mat(k,1896) + rxt(k,253)*y(k,61) + mat(k,226) = -(rxt(k,325)*y(k,263) + rxt(k,333)*y(k,259)) + mat(k,1772) = -rxt(k,325)*y(k,88) + mat(k,2015) = -rxt(k,333)*y(k,88) + mat(k,962) = -(rxt(k,326)*y(k,263)) + mat(k,1859) = -rxt(k,326)*y(k,89) + mat(k,1047) = .050_r8*rxt(k,500)*y(k,142) + mat(k,318) = .350_r8*rxt(k,336)*y(k,263) + mat(k,580) = .370_r8*rxt(k,338)*y(k,142) + mat(k,1174) = .120_r8*rxt(k,367)*y(k,142) + mat(k,925) = .110_r8*rxt(k,445)*y(k,142) + mat(k,1309) = .330_r8*rxt(k,398)*y(k,142) + mat(k,1019) = .050_r8*rxt(k,503)*y(k,142) + mat(k,1411) = .120_r8*rxt(k,412)*y(k,142) + mat(k,2196) = rxt(k,329)*y(k,246) + mat(k,2064) = .050_r8*rxt(k,500)*y(k,6) + .370_r8*rxt(k,338)*y(k,27) & + + .120_r8*rxt(k,367)*y(k,31) + .110_r8*rxt(k,445)*y(k,100) & + + .330_r8*rxt(k,398)*y(k,111) + .050_r8*rxt(k,503)*y(k,116) & + + .120_r8*rxt(k,412)*y(k,118) + mat(k,2377) = rxt(k,327)*y(k,246) + mat(k,492) = rxt(k,329)*y(k,131) + rxt(k,327)*y(k,245) + mat(k,1859) = mat(k,1859) + .350_r8*rxt(k,336)*y(k,26) + mat(k,1622) = rxt(k,291)*y(k,75) + mat(k,940) = rxt(k,291)*y(k,56) + rxt(k,292)*y(k,79) + rxt(k,294)*y(k,91) & + + rxt(k,293)*y(k,274) + mat(k,1501) = rxt(k,292)*y(k,75) + mat(k,1699) = rxt(k,294)*y(k,75) + mat(k,2498) = rxt(k,293)*y(k,75) + mat(k,1708) = -(rxt(k,231)*y(k,263) + rxt(k,294)*y(k,75)) + mat(k,1902) = -rxt(k,231)*y(k,91) + mat(k,945) = -rxt(k,294)*y(k,91) + mat(k,2437) = rxt(k,315)*y(k,133) + mat(k,1197) = rxt(k,347)*y(k,133) + mat(k,1326) = rxt(k,373)*y(k,133) + mat(k,1120) = (rxt(k,592)+rxt(k,597)+rxt(k,602))*y(k,87) + mat(k,349) = rxt(k,522)*y(k,133) + mat(k,1540) = (rxt(k,592)+rxt(k,597)+rxt(k,602))*y(k,62) + mat(k,2482) = rxt(k,230)*y(k,263) + mat(k,2291) = rxt(k,315)*y(k,44) + rxt(k,347)*y(k,47) + rxt(k,373)*y(k,51) & + + rxt(k,522)*y(k,69) + mat(k,1902) = mat(k,1902) + rxt(k,230)*y(k,132) + mat(k,512) = -(rxt(k,207)*y(k,263)) + mat(k,1816) = -rxt(k,207)*y(k,92) + mat(k,2454) = rxt(k,228)*y(k,245) + mat(k,2348) = rxt(k,228)*y(k,132) + mat(k,829) = -(rxt(k,285)*y(k,140) + (rxt(k,594) + rxt(k,599)) * y(k,87)) + mat(k,1925) = -rxt(k,285)*y(k,93) + mat(k,1534) = -(rxt(k,594) + rxt(k,599)) * y(k,93) + mat(k,1601) = rxt(k,277)*y(k,245) + mat(k,2370) = rxt(k,277)*y(k,21) + mat(k,879) = -(rxt(k,256)*y(k,58) + rxt(k,257)*y(k,140) + rxt(k,258)*y(k,263) & + + (rxt(k,587) + rxt(k,593) + rxt(k,598)) * y(k,87)) + mat(k,1970) = -rxt(k,256)*y(k,94) + mat(k,1928) = -rxt(k,257)*y(k,94) + mat(k,1854) = -rxt(k,258)*y(k,94) + mat(k,1535) = -(rxt(k,587) + rxt(k,593) + rxt(k,598)) * y(k,94) + mat(k,2116) = rxt(k,245)*y(k,245) + mat(k,1117) = rxt(k,250)*y(k,263) + mat(k,2374) = rxt(k,245)*y(k,61) + mat(k,1854) = mat(k,1854) + rxt(k,250)*y(k,62) + mat(k,1237) = -(rxt(k,391)*y(k,263)) + mat(k,1880) = -rxt(k,391)*y(k,95) + mat(k,644) = .300_r8*rxt(k,436)*y(k,263) + mat(k,613) = .500_r8*rxt(k,437)*y(k,263) + mat(k,2212) = rxt(k,390)*y(k,242) + rxt(k,397)*y(k,249) + mat(k,621) = rxt(k,390)*y(k,131) + mat(k,1394) = rxt(k,397)*y(k,131) + mat(k,1880) = mat(k,1880) + .300_r8*rxt(k,436)*y(k,101) + .500_r8*rxt(k,437) & + *y(k,102) + mat(k,277) = -(rxt(k,422)*y(k,263)) + mat(k,1782) = -rxt(k,422)*y(k,96) + mat(k,1250) = -(rxt(k,376)*y(k,263)) + mat(k,1881) = -rxt(k,376)*y(k,97) + mat(k,645) = .700_r8*rxt(k,436)*y(k,263) + mat(k,614) = .500_r8*rxt(k,437)*y(k,263) + mat(k,663) = .500_r8*rxt(k,411)*y(k,263) + mat(k,2213) = .050_r8*rxt(k,434)*y(k,248) + .220_r8*rxt(k,396)*y(k,249) & + + .250_r8*rxt(k,453)*y(k,271) + mat(k,2272) = .050_r8*rxt(k,435)*y(k,248) + .220_r8*rxt(k,395)*y(k,249) & + + .250_r8*rxt(k,454)*y(k,271) + mat(k,597) = .500_r8*rxt(k,380)*y(k,263) + mat(k,1460) = .220_r8*rxt(k,392)*y(k,249) + .250_r8*rxt(k,450)*y(k,271) + mat(k,1668) = .230_r8*rxt(k,393)*y(k,249) + .200_r8*rxt(k,381)*y(k,267) & + + .100_r8*rxt(k,451)*y(k,271) + mat(k,1369) = .050_r8*rxt(k,434)*y(k,131) + .050_r8*rxt(k,435)*y(k,133) + mat(k,1395) = .220_r8*rxt(k,396)*y(k,131) + .220_r8*rxt(k,395)*y(k,133) & + + .220_r8*rxt(k,392)*y(k,238) + .230_r8*rxt(k,393)*y(k,239) + mat(k,1881) = mat(k,1881) + .700_r8*rxt(k,436)*y(k,101) + .500_r8*rxt(k,437) & + *y(k,102) + .500_r8*rxt(k,411)*y(k,115) + .500_r8*rxt(k,380) & + *y(k,156) + mat(k,1258) = .200_r8*rxt(k,381)*y(k,239) + mat(k,1274) = .250_r8*rxt(k,453)*y(k,131) + .250_r8*rxt(k,454)*y(k,133) & + + .250_r8*rxt(k,450)*y(k,238) + .100_r8*rxt(k,451)*y(k,239) + mat(k,381) = -(rxt(k,423)*y(k,263)) + mat(k,1798) = -rxt(k,423)*y(k,98) + mat(k,2165) = .870_r8*rxt(k,434)*y(k,248) + mat(k,2249) = .950_r8*rxt(k,435)*y(k,248) + mat(k,1452) = rxt(k,430)*y(k,248) + mat(k,1648) = .750_r8*rxt(k,431)*y(k,248) + mat(k,1358) = .870_r8*rxt(k,434)*y(k,131) + .950_r8*rxt(k,435)*y(k,133) & + + rxt(k,430)*y(k,238) + .750_r8*rxt(k,431)*y(k,239) + mat(k,171) = -(rxt(k,424)*y(k,263)) + mat(k,1768) = -rxt(k,424)*y(k,99) + mat(k,752) = .600_r8*rxt(k,447)*y(k,263) + mat(k,1768) = mat(k,1768) + .600_r8*rxt(k,447)*y(k,106) + mat(k,924) = -(rxt(k,438)*y(k,133) + rxt(k,445)*y(k,142) + rxt(k,446) & + *y(k,263)) + mat(k,2253) = -rxt(k,438)*y(k,100) + mat(k,2063) = -rxt(k,445)*y(k,100) + mat(k,1856) = -rxt(k,446)*y(k,100) + mat(k,642) = -(rxt(k,436)*y(k,263)) + mat(k,1831) = -rxt(k,436)*y(k,101) + mat(k,2179) = .080_r8*rxt(k,428)*y(k,247) + mat(k,1331) = .080_r8*rxt(k,428)*y(k,131) + mat(k,610) = -(rxt(k,437)*y(k,263)) + mat(k,1827) = -rxt(k,437)*y(k,102) + mat(k,2177) = .080_r8*rxt(k,434)*y(k,248) + mat(k,1359) = .080_r8*rxt(k,434)*y(k,131) + mat(k,1295) = -(rxt(k,439)*y(k,238) + rxt(k,440)*y(k,239) + rxt(k,441) & + *y(k,245) + rxt(k,442)*y(k,131) + rxt(k,443)*y(k,133)) + mat(k,1462) = -rxt(k,439)*y(k,103) + mat(k,1671) = -rxt(k,440)*y(k,103) + mat(k,2394) = -rxt(k,441)*y(k,103) + mat(k,2216) = -rxt(k,442)*y(k,103) + mat(k,2275) = -rxt(k,443)*y(k,103) + mat(k,928) = rxt(k,438)*y(k,133) + mat(k,2275) = mat(k,2275) + rxt(k,438)*y(k,100) + mat(k,471) = -(rxt(k,444)*y(k,263)) + mat(k,1811) = -rxt(k,444)*y(k,104) + mat(k,1287) = rxt(k,441)*y(k,245) + mat(k,2341) = rxt(k,441)*y(k,103) + mat(k,88) = -(rxt(k,562)*y(k,245) + rxt(k,563)*y(k,131)) + mat(k,2317) = -rxt(k,562)*y(k,105) + mat(k,2151) = -rxt(k,563)*y(k,105) + mat(k,923) = rxt(k,565)*y(k,263) + mat(k,1751) = rxt(k,565)*y(k,100) + 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,753) = -(rxt(k,447)*y(k,263)) + mat(k,1843) = -rxt(k,447)*y(k,106) + mat(k,2364) = rxt(k,427)*y(k,247) + rxt(k,432)*y(k,248) + mat(k,1332) = rxt(k,427)*y(k,245) + mat(k,1361) = rxt(k,432)*y(k,245) + mat(k,71) = -(rxt(k,568)*y(k,263)) + mat(k,1749) = -rxt(k,568)*y(k,107) + mat(k,69) = -(rxt(k,566)*y(k,245) + rxt(k,567)*y(k,131)) + mat(k,2310) = -rxt(k,566)*y(k,108) + mat(k,2144) = -rxt(k,567)*y(k,108) + mat(k,70) = rxt(k,568)*y(k,263) + mat(k,1748) = rxt(k,568)*y(k,107) + mat(k,107) = -(rxt(k,571)*y(k,263)) + mat(k,1759) = -rxt(k,571)*y(k,109) + mat(k,105) = -(rxt(k,569)*y(k,245) + rxt(k,570)*y(k,131)) + mat(k,2324) = -rxt(k,569)*y(k,110) + mat(k,2158) = -rxt(k,570)*y(k,110) + mat(k,106) = rxt(k,571)*y(k,263) + mat(k,1758) = rxt(k,571)*y(k,109) + mat(k,1311) = -(rxt(k,398)*y(k,142) + rxt(k,399)*y(k,263)) + mat(k,2083) = -rxt(k,398)*y(k,111) + mat(k,1885) = -rxt(k,399)*y(k,111) + mat(k,929) = .300_r8*rxt(k,445)*y(k,142) + mat(k,2217) = .360_r8*rxt(k,428)*y(k,247) + mat(k,2276) = .400_r8*rxt(k,429)*y(k,247) + mat(k,2083) = mat(k,2083) + .300_r8*rxt(k,445)*y(k,100) + mat(k,1463) = .390_r8*rxt(k,425)*y(k,247) + mat(k,1672) = .310_r8*rxt(k,426)*y(k,247) + mat(k,1339) = .360_r8*rxt(k,428)*y(k,131) + .400_r8*rxt(k,429)*y(k,133) & + + .390_r8*rxt(k,425)*y(k,238) + .310_r8*rxt(k,426)*y(k,239) + mat(k,384) = -(rxt(k,400)*y(k,263)) + mat(k,1799) = -rxt(k,400)*y(k,112) + mat(k,2334) = rxt(k,394)*y(k,249) + mat(k,1390) = rxt(k,394)*y(k,245) + mat(k,561) = -(rxt(k,409)*y(k,263)) + mat(k,1822) = -rxt(k,409)*y(k,113) + mat(k,2175) = .800_r8*rxt(k,418)*y(k,232) + mat(k,1067) = .800_r8*rxt(k,418)*y(k,131) + mat(k,394) = -(rxt(k,410)*y(k,263)) + mat(k,1800) = -rxt(k,410)*y(k,114) + mat(k,2335) = .800_r8*rxt(k,407)*y(k,253) + mat(k,718) = .800_r8*rxt(k,407)*y(k,245) + mat(k,662) = -(rxt(k,411)*y(k,263)) + mat(k,1833) = -rxt(k,411)*y(k,115) + mat(k,2459) = rxt(k,414)*y(k,251) + mat(k,1435) = rxt(k,414)*y(k,132) + mat(k,1020) = -(rxt(k,502)*y(k,133) + rxt(k,503)*y(k,142) + rxt(k,504) & + *y(k,263)) + mat(k,2256) = -rxt(k,502)*y(k,116) + mat(k,2066) = -rxt(k,503)*y(k,116) + mat(k,1864) = -rxt(k,504)*y(k,116) + mat(k,94) = -(rxt(k,573)*y(k,245) + rxt(k,574)*y(k,131)) + mat(k,2318) = -rxt(k,573)*y(k,117) + mat(k,2152) = -rxt(k,574)*y(k,117) + mat(k,1016) = rxt(k,576)*y(k,263) + mat(k,1752) = rxt(k,576)*y(k,116) + mat(k,1418) = -(rxt(k,412)*y(k,142) + rxt(k,413)*y(k,263)) + mat(k,2088) = -rxt(k,412)*y(k,118) + mat(k,1890) = -rxt(k,413)*y(k,118) + mat(k,932) = .200_r8*rxt(k,445)*y(k,142) + mat(k,2222) = .560_r8*rxt(k,428)*y(k,247) + mat(k,2281) = .600_r8*rxt(k,429)*y(k,247) + mat(k,2088) = mat(k,2088) + .200_r8*rxt(k,445)*y(k,100) + mat(k,1468) = .610_r8*rxt(k,425)*y(k,247) + mat(k,1677) = .440_r8*rxt(k,426)*y(k,247) + mat(k,1343) = .560_r8*rxt(k,428)*y(k,131) + .600_r8*rxt(k,429)*y(k,133) & + + .610_r8*rxt(k,425)*y(k,238) + .440_r8*rxt(k,426)*y(k,239) + mat(k,1001) = -(rxt(k,210)*y(k,131) + (rxt(k,211) + rxt(k,212) + rxt(k,213) & + ) * y(k,132) + rxt(k,214)*y(k,141) + rxt(k,222)*y(k,263) & + + rxt(k,612)*y(k,262)) + mat(k,2199) = -rxt(k,210)*y(k,119) + mat(k,2466) = -(rxt(k,211) + rxt(k,212) + rxt(k,213)) * y(k,119) + mat(k,1578) = -rxt(k,214)*y(k,119) + mat(k,1863) = -rxt(k,222)*y(k,119) + mat(k,897) = -rxt(k,612)*y(k,119) + mat(k,1933) = rxt(k,208)*y(k,254) + rxt(k,609)*y(k,257) + mat(k,1578) = mat(k,1578) + rxt(k,610)*y(k,257) + mat(k,908) = 1.100_r8*rxt(k,605)*y(k,255) + .200_r8*rxt(k,603)*y(k,256) + mat(k,574) = rxt(k,208)*y(k,140) + mat(k,742) = 1.100_r8*rxt(k,605)*y(k,241) + mat(k,889) = .200_r8*rxt(k,603)*y(k,241) + mat(k,550) = rxt(k,609)*y(k,140) + rxt(k,610)*y(k,141) + mat(k,300) = -((rxt(k,226) + rxt(k,227)) * y(k,259)) + mat(k,2020) = -(rxt(k,226) + rxt(k,227)) * y(k,120) + mat(k,995) = rxt(k,211)*y(k,132) + mat(k,2452) = rxt(k,211)*y(k,119) + mat(k,2453) = rxt(k,229)*y(k,133) + mat(k,2247) = rxt(k,229)*y(k,132) + mat(k,459) = -(rxt(k,448)*y(k,263)) + mat(k,1809) = -rxt(k,448)*y(k,122) + mat(k,1286) = .200_r8*rxt(k,440)*y(k,239) + mat(k,1650) = .200_r8*rxt(k,440)*y(k,103) + mat(k,1159) = -(rxt(k,449)*y(k,263)) + mat(k,1874) = -rxt(k,449)*y(k,123) + mat(k,1291) = rxt(k,442)*y(k,131) + rxt(k,443)*y(k,133) + rxt(k,439)*y(k,238) & + + .800_r8*rxt(k,440)*y(k,239) + mat(k,2207) = rxt(k,442)*y(k,103) + mat(k,2265) = rxt(k,443)*y(k,103) + mat(k,1457) = rxt(k,439)*y(k,103) + mat(k,1663) = .800_r8*rxt(k,440)*y(k,103) + mat(k,139) = -(rxt(k,539)*y(k,263)) + mat(k,1765) = -rxt(k,539)*y(k,127) + mat(k,2239) = -(rxt(k,210)*y(k,119) + rxt(k,219)*y(k,133) + rxt(k,223) & + *y(k,245) + rxt(k,224)*y(k,142) + rxt(k,225)*y(k,140) + rxt(k,246) & + *y(k,61) + rxt(k,278)*y(k,21) + rxt(k,321)*y(k,239) + rxt(k,329) & + *y(k,246) + rxt(k,342)*y(k,235) + rxt(k,353)*y(k,238) + rxt(k,357) & + *y(k,244) + rxt(k,370)*y(k,236) + rxt(k,379)*y(k,266) + rxt(k,383) & + *y(k,267) + (rxt(k,389) + rxt(k,390)) * y(k,242) + (rxt(k,396) & + + rxt(k,397)) * y(k,249) + rxt(k,405)*y(k,251) + rxt(k,408) & + *y(k,253) + (rxt(k,418) + rxt(k,419)) * y(k,232) + rxt(k,428) & + *y(k,247) + rxt(k,434)*y(k,248) + rxt(k,442)*y(k,103) + rxt(k,453) & + *y(k,271) + rxt(k,457)*y(k,231) + rxt(k,460)*y(k,233) + rxt(k,465) & + *y(k,234) + rxt(k,467)*y(k,237) + rxt(k,471)*y(k,240) + rxt(k,474) & + *y(k,250) + rxt(k,477)*y(k,252) + rxt(k,480)*y(k,265) + rxt(k,487) & + *y(k,270) + rxt(k,493)*y(k,272) + rxt(k,496)*y(k,273) + rxt(k,507) & + *y(k,258) + rxt(k,512)*y(k,268) + rxt(k,517)*y(k,269) + rxt(k,614) & + *y(k,262)) + mat(k,1009) = -rxt(k,210)*y(k,131) + mat(k,2299) = -rxt(k,219)*y(k,131) + mat(k,2419) = -rxt(k,223)*y(k,131) + mat(k,2106) = -rxt(k,224)*y(k,131) + mat(k,1953) = -rxt(k,225)*y(k,131) + mat(k,2133) = -rxt(k,246)*y(k,131) + mat(k,1616) = -rxt(k,278)*y(k,131) + mat(k,1693) = -rxt(k,321)*y(k,131) + mat(k,493) = -rxt(k,329)*y(k,131) + mat(k,958) = -rxt(k,342)*y(k,131) + mat(k,1478) = -rxt(k,353)*y(k,131) + mat(k,843) = -rxt(k,357)*y(k,131) + mat(k,983) = -rxt(k,370)*y(k,131) + mat(k,865) = -rxt(k,379)*y(k,131) + mat(k,1264) = -rxt(k,383)*y(k,131) + mat(k,622) = -(rxt(k,389) + rxt(k,390)) * y(k,131) + mat(k,1405) = -(rxt(k,396) + rxt(k,397)) * y(k,131) + mat(k,1446) = -rxt(k,405)*y(k,131) + mat(k,723) = -rxt(k,408)*y(k,131) + mat(k,1079) = -(rxt(k,418) + rxt(k,419)) * y(k,131) + mat(k,1351) = -rxt(k,428)*y(k,131) + mat(k,1384) = -rxt(k,434)*y(k,131) + mat(k,1304) = -rxt(k,442)*y(k,131) + mat(k,1281) = -rxt(k,453)*y(k,131) + mat(k,570) = -rxt(k,457)*y(k,131) + mat(k,543) = -rxt(k,460)*y(k,131) + mat(k,488) = -rxt(k,465)*y(k,131) + mat(k,693) = -rxt(k,467)*y(k,131) + mat(k,825) = -rxt(k,471)*y(k,131) + mat(k,785) = -rxt(k,474)*y(k,131) + mat(k,973) = -rxt(k,477)*y(k,131) + mat(k,501) = -rxt(k,480)*y(k,131) + mat(k,800) = -rxt(k,487)*y(k,131) + mat(k,817) = -rxt(k,493)*y(k,131) + mat(k,558) = -rxt(k,496)*y(k,131) + mat(k,1139) = -rxt(k,507)*y(k,131) + mat(k,1227) = -rxt(k,512)*y(k,131) + mat(k,1098) = -rxt(k,517)*y(k,131) + mat(k,901) = -rxt(k,614)*y(k,131) + mat(k,1009) = mat(k,1009) + 2.000_r8*rxt(k,212)*y(k,132) + rxt(k,214) & + *y(k,141) + rxt(k,222)*y(k,263) + mat(k,303) = 2.000_r8*rxt(k,226)*y(k,259) + mat(k,2490) = 2.000_r8*rxt(k,212)*y(k,119) + rxt(k,215)*y(k,140) + rxt(k,532) & + *y(k,160) + mat(k,1953) = mat(k,1953) + rxt(k,215)*y(k,132) + mat(k,1593) = rxt(k,214)*y(k,119) + rxt(k,209)*y(k,254) + mat(k,1528) = rxt(k,532)*y(k,132) + mat(k,577) = rxt(k,209)*y(k,141) + mat(k,2042) = 2.000_r8*rxt(k,226)*y(k,120) + mat(k,1910) = rxt(k,222)*y(k,119) + mat(k,2494) = -((rxt(k,211) + rxt(k,212) + rxt(k,213)) * y(k,119) + (rxt(k,215) & + + rxt(k,217)) * y(k,140) + rxt(k,216)*y(k,142) + rxt(k,228) & + *y(k,245) + rxt(k,229)*y(k,133) + rxt(k,230)*y(k,263) + rxt(k,248) & + *y(k,61) + rxt(k,279)*y(k,21) + rxt(k,364)*y(k,238) + rxt(k,414) & + *y(k,251) + rxt(k,472)*y(k,240) + rxt(k,475)*y(k,250) + rxt(k,478) & + *y(k,252) + rxt(k,482)*y(k,149) + rxt(k,485)*y(k,231) + rxt(k,532) & + *y(k,160)) + mat(k,1010) = -(rxt(k,211) + rxt(k,212) + rxt(k,213)) * y(k,132) + mat(k,1957) = -(rxt(k,215) + rxt(k,217)) * y(k,132) + mat(k,2110) = -rxt(k,216)*y(k,132) + mat(k,2423) = -rxt(k,228)*y(k,132) + mat(k,2303) = -rxt(k,229)*y(k,132) + mat(k,1914) = -rxt(k,230)*y(k,132) + mat(k,2137) = -rxt(k,248)*y(k,132) + mat(k,1620) = -rxt(k,279)*y(k,132) + mat(k,1482) = -rxt(k,364)*y(k,132) + mat(k,1450) = -rxt(k,414)*y(k,132) + mat(k,827) = -rxt(k,472)*y(k,132) + mat(k,787) = -rxt(k,475)*y(k,132) + mat(k,975) = -rxt(k,478)*y(k,132) + mat(k,529) = -rxt(k,482)*y(k,132) + mat(k,572) = -rxt(k,485)*y(k,132) + mat(k,1530) = -rxt(k,532)*y(k,132) + mat(k,717) = rxt(k,416)*y(k,263) + mat(k,414) = rxt(k,387)*y(k,133) + mat(k,1620) = mat(k,1620) + rxt(k,278)*y(k,131) + mat(k,2137) = mat(k,2137) + rxt(k,246)*y(k,131) + mat(k,517) = rxt(k,207)*y(k,263) + mat(k,650) = .700_r8*rxt(k,436)*y(k,263) + mat(k,1308) = rxt(k,442)*y(k,131) + rxt(k,443)*y(k,133) + mat(k,2243) = rxt(k,278)*y(k,21) + rxt(k,246)*y(k,61) + rxt(k,442)*y(k,103) & + + 2.000_r8*rxt(k,219)*y(k,133) + rxt(k,225)*y(k,140) & + + rxt(k,224)*y(k,142) + rxt(k,457)*y(k,231) + rxt(k,418) & + *y(k,232) + rxt(k,460)*y(k,233) + rxt(k,465)*y(k,234) & + + rxt(k,342)*y(k,235) + rxt(k,370)*y(k,236) + rxt(k,467) & + *y(k,237) + rxt(k,353)*y(k,238) + rxt(k,321)*y(k,239) & + + rxt(k,471)*y(k,240) + rxt(k,389)*y(k,242) + rxt(k,357) & + *y(k,244) + rxt(k,223)*y(k,245) + rxt(k,329)*y(k,246) & + + .920_r8*rxt(k,428)*y(k,247) + .920_r8*rxt(k,434)*y(k,248) & + + rxt(k,396)*y(k,249) + rxt(k,474)*y(k,250) + rxt(k,405) & + *y(k,251) + rxt(k,477)*y(k,252) + rxt(k,408)*y(k,253) & + + 1.600_r8*rxt(k,507)*y(k,258) + rxt(k,480)*y(k,265) & + + rxt(k,379)*y(k,266) + rxt(k,383)*y(k,267) + .900_r8*rxt(k,512) & + *y(k,268) + .800_r8*rxt(k,517)*y(k,269) + rxt(k,487)*y(k,270) & + + rxt(k,453)*y(k,271) + rxt(k,493)*y(k,272) + rxt(k,496) & + *y(k,273) + mat(k,2303) = mat(k,2303) + rxt(k,387)*y(k,18) + rxt(k,443)*y(k,103) & + + 2.000_r8*rxt(k,219)*y(k,131) + rxt(k,220)*y(k,140) & + + rxt(k,218)*y(k,245) + rxt(k,429)*y(k,247) + rxt(k,435) & + *y(k,248) + rxt(k,395)*y(k,249) + rxt(k,406)*y(k,251) & + + 2.000_r8*rxt(k,508)*y(k,258) + rxt(k,221)*y(k,263) & + + rxt(k,454)*y(k,271) + mat(k,920) = rxt(k,377)*y(k,263) + mat(k,1957) = mat(k,1957) + rxt(k,225)*y(k,131) + rxt(k,220)*y(k,133) + mat(k,2110) = mat(k,2110) + rxt(k,224)*y(k,131) + mat(k,687) = rxt(k,514)*y(k,263) + mat(k,572) = mat(k,572) + rxt(k,457)*y(k,131) + mat(k,1082) = rxt(k,418)*y(k,131) + mat(k,545) = rxt(k,460)*y(k,131) + mat(k,490) = rxt(k,465)*y(k,131) + mat(k,961) = rxt(k,342)*y(k,131) + mat(k,986) = rxt(k,370)*y(k,131) + mat(k,695) = rxt(k,467)*y(k,131) + mat(k,1482) = mat(k,1482) + rxt(k,353)*y(k,131) + mat(k,1697) = rxt(k,321)*y(k,131) + .500_r8*rxt(k,505)*y(k,258) + mat(k,827) = mat(k,827) + rxt(k,471)*y(k,131) + mat(k,625) = rxt(k,389)*y(k,131) + mat(k,846) = rxt(k,357)*y(k,131) + mat(k,2423) = mat(k,2423) + rxt(k,223)*y(k,131) + rxt(k,218)*y(k,133) + mat(k,496) = rxt(k,329)*y(k,131) + mat(k,1355) = .920_r8*rxt(k,428)*y(k,131) + rxt(k,429)*y(k,133) + mat(k,1388) = .920_r8*rxt(k,434)*y(k,131) + rxt(k,435)*y(k,133) + mat(k,1409) = rxt(k,396)*y(k,131) + rxt(k,395)*y(k,133) + mat(k,787) = mat(k,787) + rxt(k,474)*y(k,131) + mat(k,1450) = mat(k,1450) + rxt(k,405)*y(k,131) + rxt(k,406)*y(k,133) + mat(k,975) = mat(k,975) + rxt(k,477)*y(k,131) + mat(k,725) = rxt(k,408)*y(k,131) + mat(k,1143) = 1.600_r8*rxt(k,507)*y(k,131) + 2.000_r8*rxt(k,508)*y(k,133) & + + .500_r8*rxt(k,505)*y(k,239) + mat(k,1914) = mat(k,1914) + rxt(k,416)*y(k,1) + rxt(k,207)*y(k,92) & + + .700_r8*rxt(k,436)*y(k,101) + rxt(k,221)*y(k,133) + rxt(k,377) & + *y(k,134) + rxt(k,514)*y(k,216) + mat(k,503) = rxt(k,480)*y(k,131) + mat(k,868) = rxt(k,379)*y(k,131) + mat(k,1267) = rxt(k,383)*y(k,131) + mat(k,1230) = .900_r8*rxt(k,512)*y(k,131) + mat(k,1101) = .800_r8*rxt(k,517)*y(k,131) + mat(k,802) = rxt(k,487)*y(k,131) + mat(k,1285) = rxt(k,453)*y(k,131) + rxt(k,454)*y(k,133) + mat(k,819) = rxt(k,493)*y(k,131) + mat(k,560) = rxt(k,496)*y(k,131) + 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,2300) = -(rxt(k,218)*y(k,245) + rxt(k,219)*y(k,131) + rxt(k,220) & + *y(k,140) + rxt(k,221)*y(k,263) + rxt(k,229)*y(k,132) + rxt(k,315) & + *y(k,44) + rxt(k,347)*y(k,47) + rxt(k,366)*y(k,31) + rxt(k,373) & + *y(k,51) + rxt(k,387)*y(k,18) + rxt(k,395)*y(k,249) + rxt(k,406) & + *y(k,251) + rxt(k,429)*y(k,247) + rxt(k,435)*y(k,248) + rxt(k,438) & + *y(k,100) + rxt(k,443)*y(k,103) + rxt(k,454)*y(k,271) + rxt(k,499) & + *y(k,6) + rxt(k,502)*y(k,116) + rxt(k,508)*y(k,258) + rxt(k,519) & + *y(k,218) + rxt(k,522)*y(k,69)) + mat(k,2420) = -rxt(k,218)*y(k,133) + mat(k,2240) = -rxt(k,219)*y(k,133) + mat(k,1954) = -rxt(k,220)*y(k,133) + mat(k,1911) = -rxt(k,221)*y(k,133) + mat(k,2491) = -rxt(k,229)*y(k,133) + mat(k,2446) = -rxt(k,315)*y(k,133) + mat(k,1199) = -rxt(k,347)*y(k,133) + mat(k,1188) = -rxt(k,366)*y(k,133) + mat(k,1328) = -rxt(k,373)*y(k,133) + mat(k,412) = -rxt(k,387)*y(k,133) + mat(k,1406) = -rxt(k,395)*y(k,133) + mat(k,1447) = -rxt(k,406)*y(k,133) + mat(k,1352) = -rxt(k,429)*y(k,133) + mat(k,1385) = -rxt(k,435)*y(k,133) + mat(k,937) = -rxt(k,438)*y(k,133) + mat(k,1305) = -rxt(k,443)*y(k,133) + mat(k,1282) = -rxt(k,454)*y(k,133) + mat(k,1063) = -rxt(k,499)*y(k,133) + mat(k,1035) = -rxt(k,502)*y(k,133) + mat(k,1140) = -rxt(k,508)*y(k,133) + mat(k,1108) = -rxt(k,519)*y(k,133) + mat(k,351) = -rxt(k,522)*y(k,133) + mat(k,592) = rxt(k,280)*y(k,140) + mat(k,2000) = rxt(k,247)*y(k,62) + mat(k,1125) = rxt(k,247)*y(k,58) + rxt(k,249)*y(k,140) + rxt(k,250)*y(k,263) + mat(k,948) = rxt(k,294)*y(k,91) + mat(k,1717) = rxt(k,294)*y(k,75) + rxt(k,231)*y(k,263) + mat(k,667) = .500_r8*rxt(k,411)*y(k,263) + mat(k,2491) = mat(k,2491) + rxt(k,217)*y(k,140) + rxt(k,216)*y(k,142) + mat(k,1954) = mat(k,1954) + rxt(k,280)*y(k,22) + rxt(k,249)*y(k,62) & + + rxt(k,217)*y(k,132) + mat(k,2107) = rxt(k,216)*y(k,132) + mat(k,607) = rxt(k,362)*y(k,263) + mat(k,1911) = mat(k,1911) + rxt(k,250)*y(k,62) + rxt(k,231)*y(k,91) & + + .500_r8*rxt(k,411)*y(k,115) + rxt(k,362)*y(k,147) + mat(k,915) = -(rxt(k,377)*y(k,263)) + mat(k,1855) = -rxt(k,377)*y(k,134) + mat(k,1173) = rxt(k,366)*y(k,133) + mat(k,611) = .500_r8*rxt(k,437)*y(k,263) + mat(k,473) = rxt(k,444)*y(k,263) + mat(k,460) = rxt(k,448)*y(k,263) + mat(k,1156) = rxt(k,449)*y(k,263) + mat(k,2252) = rxt(k,366)*y(k,31) + mat(k,1855) = mat(k,1855) + .500_r8*rxt(k,437)*y(k,102) + rxt(k,444)*y(k,104) & + + rxt(k,448)*y(k,122) + rxt(k,449)*y(k,123) + mat(k,453) = -(rxt(k,509)*y(k,263)) + mat(k,1808) = -rxt(k,509)*y(k,135) + mat(k,2339) = rxt(k,506)*y(k,258) + mat(k,1128) = rxt(k,506)*y(k,245) + mat(k,1948) = -(rxt(k,187)*y(k,142) + 4._r8*rxt(k,188)*y(k,140) + rxt(k,189) & + *y(k,141) + rxt(k,190)*y(k,79) + rxt(k,191)*y(k,81) + rxt(k,196) & + *y(k,245) + rxt(k,202)*y(k,263) + (rxt(k,215) + rxt(k,217) & + ) * y(k,132) + rxt(k,220)*y(k,133) + rxt(k,225)*y(k,131) & + + rxt(k,249)*y(k,62) + rxt(k,251)*y(k,61) + rxt(k,254)*y(k,87) & + + rxt(k,257)*y(k,94) + rxt(k,280)*y(k,22) + rxt(k,281)*y(k,21) & + + rxt(k,283)*y(k,83) + rxt(k,285)*y(k,93) + rxt(k,316)*y(k,44) & + + rxt(k,524)*y(k,145) + (rxt(k,607) + rxt(k,608)) * y(k,255) & + + rxt(k,609)*y(k,257)) + mat(k,2101) = -rxt(k,187)*y(k,140) + mat(k,1588) = -rxt(k,189)*y(k,140) + mat(k,1510) = -rxt(k,190)*y(k,140) + mat(k,674) = -rxt(k,191)*y(k,140) + mat(k,2414) = -rxt(k,196)*y(k,140) + mat(k,1905) = -rxt(k,202)*y(k,140) + mat(k,2485) = -(rxt(k,215) + rxt(k,217)) * y(k,140) + mat(k,2294) = -rxt(k,220)*y(k,140) + mat(k,2234) = -rxt(k,225)*y(k,140) + mat(k,1122) = -rxt(k,249)*y(k,140) + mat(k,2128) = -rxt(k,251)*y(k,140) + mat(k,1543) = -rxt(k,254)*y(k,140) + mat(k,882) = -rxt(k,257)*y(k,140) + mat(k,591) = -rxt(k,280)*y(k,140) + mat(k,1611) = -rxt(k,281)*y(k,140) + mat(k,875) = -rxt(k,283)*y(k,140) + mat(k,834) = -rxt(k,285)*y(k,140) + mat(k,2440) = -rxt(k,316)*y(k,140) + mat(k,422) = -rxt(k,524)*y(k,140) + mat(k,744) = -(rxt(k,607) + rxt(k,608)) * y(k,140) + mat(k,552) = -rxt(k,609)*y(k,140) + mat(k,1732) = rxt(k,194)*y(k,245) + mat(k,1007) = rxt(k,210)*y(k,131) + rxt(k,211)*y(k,132) + rxt(k,214)*y(k,141) & + + rxt(k,612)*y(k,262) + mat(k,2234) = mat(k,2234) + rxt(k,210)*y(k,119) + mat(k,2485) = mat(k,2485) + rxt(k,211)*y(k,119) + mat(k,1588) = mat(k,1588) + rxt(k,214)*y(k,119) + rxt(k,526)*y(k,158) & + + rxt(k,533)*y(k,160) + rxt(k,611)*y(k,257) + (rxt(k,176) & + +rxt(k,177))*y(k,259) + rxt(k,617)*y(k,264) + mat(k,780) = rxt(k,526)*y(k,141) + mat(k,1524) = rxt(k,533)*y(k,141) + mat(k,912) = rxt(k,603)*y(k,256) + 1.150_r8*rxt(k,604)*y(k,262) + mat(k,2414) = mat(k,2414) + rxt(k,194)*y(k,78) + mat(k,891) = rxt(k,603)*y(k,241) + mat(k,552) = mat(k,552) + rxt(k,611)*y(k,141) + mat(k,2037) = (rxt(k,176)+rxt(k,177))*y(k,141) + mat(k,899) = rxt(k,612)*y(k,119) + 1.150_r8*rxt(k,604)*y(k,241) + mat(k,1905) = mat(k,1905) + 2.000_r8*rxt(k,204)*y(k,263) + mat(k,854) = rxt(k,617)*y(k,141) + mat(k,1584) = -(rxt(k,176)*y(k,259) + rxt(k,181)*y(k,260) + rxt(k,189) & + *y(k,140) + rxt(k,195)*y(k,78) + rxt(k,209)*y(k,254) + rxt(k,214) & + *y(k,119) + rxt(k,359)*y(k,243) + rxt(k,526)*y(k,158) + rxt(k,533) & + *y(k,160) + rxt(k,606)*y(k,255) + (rxt(k,610) + rxt(k,611) & + ) * y(k,257) + rxt(k,617)*y(k,264)) + mat(k,2030) = -rxt(k,176)*y(k,141) + mat(k,222) = -rxt(k,181)*y(k,141) + mat(k,1941) = -rxt(k,189)*y(k,141) + mat(k,1725) = -rxt(k,195)*y(k,141) + mat(k,575) = -rxt(k,209)*y(k,141) + mat(k,1004) = -rxt(k,214)*y(k,141) + mat(k,509) = -rxt(k,359)*y(k,141) + mat(k,777) = -rxt(k,526)*y(k,141) + mat(k,1520) = -rxt(k,533)*y(k,141) + mat(k,743) = -rxt(k,606)*y(k,141) + mat(k,551) = -(rxt(k,610) + rxt(k,611)) * y(k,141) + mat(k,853) = -rxt(k,617)*y(k,141) + mat(k,1554) = rxt(k,272)*y(k,142) + rxt(k,271)*y(k,245) + mat(k,1606) = 2.000_r8*rxt(k,273)*y(k,21) + (rxt(k,275)+rxt(k,276))*y(k,61) & + + rxt(k,281)*y(k,140) + rxt(k,277)*y(k,245) + mat(k,1987) = rxt(k,240)*y(k,142) + rxt(k,238)*y(k,245) + mat(k,2122) = (rxt(k,275)+rxt(k,276))*y(k,21) + (2.000_r8*rxt(k,242) & + +2.000_r8*rxt(k,243))*y(k,61) + rxt(k,251)*y(k,140) & + + rxt(k,245)*y(k,245) + rxt(k,253)*y(k,263) + mat(k,1725) = mat(k,1725) + rxt(k,198)*y(k,142) + rxt(k,192)*y(k,245) + mat(k,513) = rxt(k,207)*y(k,263) + mat(k,1004) = mat(k,1004) + rxt(k,213)*y(k,132) + mat(k,301) = rxt(k,227)*y(k,259) + mat(k,2227) = rxt(k,224)*y(k,142) + rxt(k,614)*y(k,262) + mat(k,2478) = rxt(k,213)*y(k,119) + rxt(k,215)*y(k,140) + rxt(k,216)*y(k,142) + mat(k,2287) = rxt(k,220)*y(k,140) + rxt(k,218)*y(k,245) + mat(k,1941) = mat(k,1941) + rxt(k,281)*y(k,21) + rxt(k,251)*y(k,61) & + + rxt(k,215)*y(k,132) + rxt(k,220)*y(k,133) & + + 2.000_r8*rxt(k,188)*y(k,140) + 2.000_r8*rxt(k,187)*y(k,142) & + + rxt(k,196)*y(k,245) + rxt(k,180)*y(k,260) + rxt(k,202) & + *y(k,263) + mat(k,1584) = mat(k,1584) + 2.000_r8*rxt(k,181)*y(k,260) + mat(k,2094) = rxt(k,272)*y(k,19) + rxt(k,240)*y(k,58) + rxt(k,198)*y(k,78) & + + rxt(k,224)*y(k,131) + rxt(k,216)*y(k,132) & + + 2.000_r8*rxt(k,187)*y(k,140) + rxt(k,528)*y(k,158) & + + rxt(k,534)*y(k,160) + 2.000_r8*rxt(k,197)*y(k,245) & + + 2.000_r8*rxt(k,178)*y(k,259) + rxt(k,203)*y(k,263) + mat(k,777) = mat(k,777) + rxt(k,528)*y(k,142) + mat(k,1520) = mat(k,1520) + rxt(k,534)*y(k,142) + mat(k,955) = rxt(k,341)*y(k,245) + mat(k,980) = rxt(k,369)*y(k,245) + mat(k,1681) = rxt(k,320)*y(k,245) + mat(k,2407) = rxt(k,271)*y(k,19) + rxt(k,277)*y(k,21) + rxt(k,238)*y(k,58) & + + rxt(k,245)*y(k,61) + rxt(k,192)*y(k,78) + rxt(k,218)*y(k,133) & + + rxt(k,196)*y(k,140) + 2.000_r8*rxt(k,197)*y(k,142) & + + rxt(k,341)*y(k,235) + rxt(k,369)*y(k,236) + rxt(k,320) & + *y(k,239) + 2.000_r8*rxt(k,206)*y(k,245) + rxt(k,201)*y(k,263) & + + rxt(k,378)*y(k,266) + mat(k,2030) = mat(k,2030) + rxt(k,227)*y(k,120) + 2.000_r8*rxt(k,178) & + *y(k,142) + mat(k,222) = mat(k,222) + rxt(k,180)*y(k,140) + 2.000_r8*rxt(k,181)*y(k,141) + mat(k,898) = rxt(k,614)*y(k,131) + mat(k,1898) = rxt(k,253)*y(k,61) + rxt(k,207)*y(k,92) + rxt(k,202)*y(k,140) & + + rxt(k,203)*y(k,142) + rxt(k,201)*y(k,245) + mat(k,863) = rxt(k,378)*y(k,245) + mat(k,2104) = -(rxt(k,178)*y(k,259) + rxt(k,187)*y(k,140) + rxt(k,197) & + *y(k,245) + rxt(k,198)*y(k,78) + rxt(k,203)*y(k,263) + rxt(k,216) & + *y(k,132) + rxt(k,224)*y(k,131) + rxt(k,240)*y(k,58) + rxt(k,272) & + *y(k,19) + rxt(k,338)*y(k,27) + rxt(k,367)*y(k,31) + rxt(k,398) & + *y(k,111) + rxt(k,412)*y(k,118) + rxt(k,445)*y(k,100) + rxt(k,483) & + *y(k,149) + rxt(k,500)*y(k,6) + rxt(k,503)*y(k,116) + rxt(k,528) & + *y(k,158) + rxt(k,534)*y(k,160)) + mat(k,2040) = -rxt(k,178)*y(k,142) + mat(k,1951) = -rxt(k,187)*y(k,142) + mat(k,2417) = -rxt(k,197)*y(k,142) + mat(k,1735) = -rxt(k,198)*y(k,142) + mat(k,1908) = -rxt(k,203)*y(k,142) + mat(k,2488) = -rxt(k,216)*y(k,142) + mat(k,2237) = -rxt(k,224)*y(k,142) + mat(k,1997) = -rxt(k,240)*y(k,142) + mat(k,1560) = -rxt(k,272)*y(k,142) + mat(k,583) = -rxt(k,338)*y(k,142) + mat(k,1186) = -rxt(k,367)*y(k,142) + mat(k,1318) = -rxt(k,398)*y(k,142) + mat(k,1427) = -rxt(k,412)*y(k,142) + mat(k,936) = -rxt(k,445)*y(k,142) + mat(k,528) = -rxt(k,483)*y(k,142) + mat(k,1062) = -rxt(k,500)*y(k,142) + mat(k,1034) = -rxt(k,503)*y(k,142) + mat(k,781) = -rxt(k,528)*y(k,142) + mat(k,1526) = -rxt(k,534)*y(k,142) + mat(k,1951) = mat(k,1951) + rxt(k,189)*y(k,141) + mat(k,1591) = rxt(k,189)*y(k,140) + mat(k,1477) = .150_r8*rxt(k,352)*y(k,245) + mat(k,2417) = mat(k,2417) + .150_r8*rxt(k,352)*y(k,238) + .150_r8*rxt(k,403) & + *y(k,251) + mat(k,1445) = .150_r8*rxt(k,403)*y(k,245) + mat(k,360) = -(rxt(k,535)*y(k,160)) + mat(k,1515) = -rxt(k,535)*y(k,144) + mat(k,1599) = rxt(k,274)*y(k,61) + mat(k,2115) = rxt(k,274)*y(k,21) + 2.000_r8*rxt(k,244)*y(k,61) + 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,415) = -(rxt(k,524)*y(k,140) + rxt(k,525)*y(k,263)) + mat(k,1918) = -rxt(k,524)*y(k,145) + mat(k,1803) = -rxt(k,525)*y(k,145) + mat(k,1232) = rxt(k,391)*y(k,263) + mat(k,2162) = .100_r8*rxt(k,512)*y(k,268) + mat(k,1780) = rxt(k,391)*y(k,95) + mat(k,1213) = .100_r8*rxt(k,512)*y(k,131) + mat(k,602) = -(rxt(k,362)*y(k,263)) + mat(k,1826) = -rxt(k,362)*y(k,147) + mat(k,2458) = rxt(k,364)*y(k,238) + mat(k,1453) = rxt(k,364)*y(k,132) + mat(k,2451) = rxt(k,485)*y(k,231) + mat(k,566) = rxt(k,485)*y(k,132) + mat(k,526) = -(rxt(k,482)*y(k,132) + rxt(k,483)*y(k,142)) + mat(k,2455) = -rxt(k,482)*y(k,149) + mat(k,2057) = -rxt(k,483)*y(k,149) + mat(k,240) = .070_r8*rxt(k,469)*y(k,263) + mat(k,2172) = rxt(k,467)*y(k,237) + mat(k,216) = .060_r8*rxt(k,481)*y(k,263) + mat(k,261) = .070_r8*rxt(k,497)*y(k,263) + mat(k,689) = rxt(k,467)*y(k,131) + mat(k,1818) = .070_r8*rxt(k,469)*y(k,68) + .060_r8*rxt(k,481)*y(k,150) & + + .070_r8*rxt(k,497)*y(k,227) + mat(k,214) = -(rxt(k,481)*y(k,263)) + mat(k,1771) = -rxt(k,481)*y(k,150) + mat(k,206) = .530_r8*rxt(k,458)*y(k,263) + mat(k,1771) = mat(k,1771) + .530_r8*rxt(k,458)*y(k,8) + mat(k,365) = -(rxt(k,484)*y(k,263)) + mat(k,1795) = -rxt(k,484)*y(k,151) + mat(k,2331) = rxt(k,479)*y(k,265) + mat(k,497) = rxt(k,479)*y(k,245) + mat(k,594) = -(rxt(k,380)*y(k,263)) + mat(k,1825) = -rxt(k,380)*y(k,156) + mat(k,2354) = rxt(k,378)*y(k,266) + mat(k,859) = rxt(k,378)*y(k,245) + mat(k,429) = -(rxt(k,384)*y(k,263)) + mat(k,1804) = -rxt(k,384)*y(k,157) + mat(k,2336) = .850_r8*rxt(k,382)*y(k,267) + mat(k,1256) = .850_r8*rxt(k,382)*y(k,245) + mat(k,775) = -(rxt(k,526)*y(k,141) + rxt(k,528)*y(k,142) + rxt(k,531) & + *y(k,263)) + mat(k,1572) = -rxt(k,526)*y(k,158) + mat(k,2061) = -rxt(k,528)*y(k,158) + mat(k,1845) = -rxt(k,531)*y(k,158) + mat(k,1518) = -(rxt(k,529)*y(k,21) + rxt(k,530)*y(k,61) + rxt(k,532)*y(k,132) & + + rxt(k,533)*y(k,141) + rxt(k,534)*y(k,142) + rxt(k,535) & + *y(k,144) + rxt(k,536)*y(k,263)) + mat(k,1603) = -rxt(k,529)*y(k,160) + mat(k,2119) = -rxt(k,530)*y(k,160) + mat(k,2475) = -rxt(k,532)*y(k,160) + mat(k,1582) = -rxt(k,533)*y(k,160) + mat(k,2092) = -rxt(k,534)*y(k,160) + mat(k,362) = -rxt(k,535)*y(k,160) + mat(k,1895) = -rxt(k,536)*y(k,160) + mat(k,1938) = rxt(k,524)*y(k,145) + mat(k,1582) = mat(k,1582) + rxt(k,526)*y(k,158) + mat(k,2092) = mat(k,2092) + rxt(k,528)*y(k,158) + mat(k,419) = rxt(k,524)*y(k,140) + mat(k,776) = rxt(k,526)*y(k,141) + rxt(k,528)*y(k,142) + rxt(k,531)*y(k,263) + mat(k,1895) = mat(k,1895) + rxt(k,531)*y(k,158) + mat(k,989) = -(rxt(k,527)*y(k,263)) + mat(k,1862) = -rxt(k,527)*y(k,161) + mat(k,1602) = rxt(k,529)*y(k,160) + mat(k,2117) = rxt(k,530)*y(k,160) + mat(k,348) = rxt(k,522)*y(k,133) + (rxt(k,523)+.500_r8*rxt(k,537))*y(k,263) + mat(k,2465) = rxt(k,532)*y(k,160) + mat(k,2255) = rxt(k,522)*y(k,69) + mat(k,1577) = rxt(k,533)*y(k,160) + mat(k,2065) = rxt(k,534)*y(k,160) + mat(k,361) = rxt(k,535)*y(k,160) + mat(k,417) = rxt(k,525)*y(k,263) + mat(k,1517) = rxt(k,529)*y(k,21) + rxt(k,530)*y(k,61) + rxt(k,532)*y(k,132) & + + rxt(k,533)*y(k,141) + rxt(k,534)*y(k,142) + rxt(k,535) & + *y(k,144) + rxt(k,536)*y(k,263) + mat(k,1862) = mat(k,1862) + (rxt(k,523)+.500_r8*rxt(k,537))*y(k,69) & + + rxt(k,525)*y(k,145) + rxt(k,536)*y(k,160) + mat(k,305) = -(rxt(k,538)*y(k,274)) + mat(k,2497) = -rxt(k,538)*y(k,162) + mat(k,988) = rxt(k,527)*y(k,263) + mat(k,1787) = rxt(k,527)*y(k,161) + mat(k,64) = .1056005_r8*rxt(k,567)*y(k,131) + .2381005_r8*rxt(k,566)*y(k,245) + mat(k,2139) = .1056005_r8*rxt(k,567)*y(k,108) + mat(k,115) = .5931005_r8*rxt(k,577)*y(k,263) + mat(k,2305) = .2381005_r8*rxt(k,566)*y(k,108) + mat(k,1743) = .5931005_r8*rxt(k,577)*y(k,212) + mat(k,65) = .1026005_r8*rxt(k,567)*y(k,131) + .1308005_r8*rxt(k,566)*y(k,245) + mat(k,2140) = .1026005_r8*rxt(k,567)*y(k,108) + mat(k,116) = .1534005_r8*rxt(k,577)*y(k,263) + mat(k,2306) = .1308005_r8*rxt(k,566)*y(k,108) + mat(k,1744) = .1534005_r8*rxt(k,577)*y(k,212) + mat(k,66) = .0521005_r8*rxt(k,567)*y(k,131) + .0348005_r8*rxt(k,566)*y(k,245) + mat(k,2141) = .0521005_r8*rxt(k,567)*y(k,108) + mat(k,117) = .0459005_r8*rxt(k,577)*y(k,263) + mat(k,2307) = .0348005_r8*rxt(k,566)*y(k,108) + mat(k,1745) = .0459005_r8*rxt(k,577)*y(k,212) + mat(k,67) = .0143005_r8*rxt(k,567)*y(k,131) + .0076005_r8*rxt(k,566)*y(k,245) + mat(k,2142) = .0143005_r8*rxt(k,567)*y(k,108) + mat(k,118) = .0085005_r8*rxt(k,577)*y(k,263) + mat(k,2308) = .0076005_r8*rxt(k,566)*y(k,108) + mat(k,1746) = .0085005_r8*rxt(k,577)*y(k,212) + mat(k,68) = .0166005_r8*rxt(k,567)*y(k,131) + .0113005_r8*rxt(k,566)*y(k,245) + mat(k,2143) = .0166005_r8*rxt(k,567)*y(k,108) + mat(k,119) = .0128005_r8*rxt(k,577)*y(k,263) + mat(k,2309) = .0113005_r8*rxt(k,566)*y(k,108) + mat(k,1747) = .0128005_r8*rxt(k,577)*y(k,212) + mat(k,1039) = .2202005_r8*rxt(k,556)*y(k,142) + mat(k,77) = .1279005_r8*rxt(k,555)*y(k,131) + .2202005_r8*rxt(k,554)*y(k,245) + mat(k,83) = .0003005_r8*rxt(k,563)*y(k,131) + .0031005_r8*rxt(k,562)*y(k,245) + mat(k,1011) = .0508005_r8*rxt(k,575)*y(k,142) + mat(k,89) = .0245005_r8*rxt(k,574)*y(k,131) + .0508005_r8*rxt(k,573)*y(k,245) + mat(k,2145) = .1279005_r8*rxt(k,555)*y(k,7) + .0003005_r8*rxt(k,563)*y(k,105) & + + .0245005_r8*rxt(k,574)*y(k,117) + mat(k,2048) = .2202005_r8*rxt(k,556)*y(k,6) + .0508005_r8*rxt(k,575)*y(k,116) + mat(k,2311) = .2202005_r8*rxt(k,554)*y(k,7) + .0031005_r8*rxt(k,562)*y(k,105) & + + .0508005_r8*rxt(k,573)*y(k,117) + mat(k,1040) = .2067005_r8*rxt(k,556)*y(k,142) + mat(k,78) = .1792005_r8*rxt(k,555)*y(k,131) + .2067005_r8*rxt(k,554)*y(k,245) + mat(k,84) = .0003005_r8*rxt(k,563)*y(k,131) + .0035005_r8*rxt(k,562)*y(k,245) + mat(k,1012) = .1149005_r8*rxt(k,575)*y(k,142) + mat(k,90) = .0082005_r8*rxt(k,574)*y(k,131) + .1149005_r8*rxt(k,573)*y(k,245) + mat(k,2146) = .1792005_r8*rxt(k,555)*y(k,7) + .0003005_r8*rxt(k,563)*y(k,105) & + + .0082005_r8*rxt(k,574)*y(k,117) + mat(k,2049) = .2067005_r8*rxt(k,556)*y(k,6) + .1149005_r8*rxt(k,575)*y(k,116) + mat(k,2312) = .2067005_r8*rxt(k,554)*y(k,7) + .0035005_r8*rxt(k,562)*y(k,105) & + + .1149005_r8*rxt(k,573)*y(k,117) + mat(k,1041) = .0653005_r8*rxt(k,556)*y(k,142) + mat(k,79) = .0676005_r8*rxt(k,555)*y(k,131) + .0653005_r8*rxt(k,554)*y(k,245) + mat(k,85) = .0073005_r8*rxt(k,563)*y(k,131) + .0003005_r8*rxt(k,562)*y(k,245) + mat(k,1013) = .0348005_r8*rxt(k,575)*y(k,142) + mat(k,91) = .0772005_r8*rxt(k,574)*y(k,131) + .0348005_r8*rxt(k,573)*y(k,245) + mat(k,2147) = .0676005_r8*rxt(k,555)*y(k,7) + .0073005_r8*rxt(k,563)*y(k,105) & + + .0772005_r8*rxt(k,574)*y(k,117) + mat(k,2050) = .0653005_r8*rxt(k,556)*y(k,6) + .0348005_r8*rxt(k,575)*y(k,116) + mat(k,2313) = .0653005_r8*rxt(k,554)*y(k,7) + .0003005_r8*rxt(k,562)*y(k,105) & + + .0348005_r8*rxt(k,573)*y(k,117) + mat(k,1042) = .1749305_r8*rxt(k,553)*y(k,133) + .1284005_r8*rxt(k,556) & + *y(k,142) + mat(k,80) = .079_r8*rxt(k,555)*y(k,131) + .1284005_r8*rxt(k,554)*y(k,245) + mat(k,921) = .0590245_r8*rxt(k,561)*y(k,133) + .0033005_r8*rxt(k,564) & + *y(k,142) + mat(k,86) = .0057005_r8*rxt(k,563)*y(k,131) + .0271005_r8*rxt(k,562)*y(k,245) + mat(k,1014) = .1749305_r8*rxt(k,572)*y(k,133) + .0554005_r8*rxt(k,575) & + *y(k,142) + mat(k,92) = .0332005_r8*rxt(k,574)*y(k,131) + .0554005_r8*rxt(k,573)*y(k,245) + mat(k,2148) = .079_r8*rxt(k,555)*y(k,7) + .0057005_r8*rxt(k,563)*y(k,105) & + + .0332005_r8*rxt(k,574)*y(k,117) + mat(k,2245) = .1749305_r8*rxt(k,553)*y(k,6) + .0590245_r8*rxt(k,561)*y(k,100) & + + .1749305_r8*rxt(k,572)*y(k,116) + mat(k,2051) = .1284005_r8*rxt(k,556)*y(k,6) + .0033005_r8*rxt(k,564)*y(k,100) & + + .0554005_r8*rxt(k,575)*y(k,116) + mat(k,2314) = .1284005_r8*rxt(k,554)*y(k,7) + .0271005_r8*rxt(k,562)*y(k,105) & + + .0554005_r8*rxt(k,573)*y(k,117) + mat(k,1043) = .5901905_r8*rxt(k,553)*y(k,133) + .114_r8*rxt(k,556)*y(k,142) + mat(k,81) = .1254005_r8*rxt(k,555)*y(k,131) + .114_r8*rxt(k,554)*y(k,245) + mat(k,922) = .0250245_r8*rxt(k,561)*y(k,133) + mat(k,87) = .0623005_r8*rxt(k,563)*y(k,131) + .0474005_r8*rxt(k,562)*y(k,245) + mat(k,1015) = .5901905_r8*rxt(k,572)*y(k,133) + .1278005_r8*rxt(k,575) & + *y(k,142) + mat(k,93) = .130_r8*rxt(k,574)*y(k,131) + .1278005_r8*rxt(k,573)*y(k,245) + mat(k,2149) = .1254005_r8*rxt(k,555)*y(k,7) + .0623005_r8*rxt(k,563)*y(k,105) & + + .130_r8*rxt(k,574)*y(k,117) + mat(k,2246) = .5901905_r8*rxt(k,553)*y(k,6) + .0250245_r8*rxt(k,561)*y(k,100) & + + .5901905_r8*rxt(k,572)*y(k,116) + mat(k,2052) = .114_r8*rxt(k,556)*y(k,6) + .1278005_r8*rxt(k,575)*y(k,116) + mat(k,2315) = .114_r8*rxt(k,554)*y(k,7) + .0474005_r8*rxt(k,562)*y(k,105) & + + .1278005_r8*rxt(k,573)*y(k,117) + mat(k,108) = .0097005_r8*rxt(k,560)*y(k,131) + .0023005_r8*rxt(k,559) & + *y(k,245) + mat(k,100) = .1056005_r8*rxt(k,570)*y(k,131) + .2381005_r8*rxt(k,569) & + *y(k,245) + mat(k,2153) = .0097005_r8*rxt(k,560)*y(k,9) + .1056005_r8*rxt(k,570)*y(k,110) & + + .0154005_r8*rxt(k,581)*y(k,222) + .0063005_r8*rxt(k,585) & + *y(k,226) + mat(k,121) = .5931005_r8*rxt(k,578)*y(k,263) + mat(k,127) = .0154005_r8*rxt(k,581)*y(k,131) + .1364005_r8*rxt(k,580) & + *y(k,245) + mat(k,133) = .0063005_r8*rxt(k,585)*y(k,131) + .1677005_r8*rxt(k,584) & + *y(k,245) + mat(k,2319) = .0023005_r8*rxt(k,559)*y(k,9) + .2381005_r8*rxt(k,569)*y(k,110) & + + .1364005_r8*rxt(k,580)*y(k,222) + .1677005_r8*rxt(k,584) & + *y(k,226) + mat(k,1753) = .5931005_r8*rxt(k,578)*y(k,213) + mat(k,109) = .0034005_r8*rxt(k,560)*y(k,131) + .0008005_r8*rxt(k,559) & + *y(k,245) + mat(k,101) = .1026005_r8*rxt(k,570)*y(k,131) + .1308005_r8*rxt(k,569) & + *y(k,245) + mat(k,2154) = .0034005_r8*rxt(k,560)*y(k,9) + .1026005_r8*rxt(k,570)*y(k,110) & + + .0452005_r8*rxt(k,581)*y(k,222) + .0237005_r8*rxt(k,585) & + *y(k,226) + mat(k,122) = .1534005_r8*rxt(k,578)*y(k,263) + mat(k,128) = .0452005_r8*rxt(k,581)*y(k,131) + .0101005_r8*rxt(k,580) & + *y(k,245) + mat(k,134) = .0237005_r8*rxt(k,585)*y(k,131) + .0174005_r8*rxt(k,584) & + *y(k,245) + mat(k,2320) = .0008005_r8*rxt(k,559)*y(k,9) + .1308005_r8*rxt(k,569)*y(k,110) & + + .0101005_r8*rxt(k,580)*y(k,222) + .0174005_r8*rxt(k,584) & + *y(k,226) + mat(k,1754) = .1534005_r8*rxt(k,578)*y(k,213) + mat(k,110) = .1579005_r8*rxt(k,560)*y(k,131) + .0843005_r8*rxt(k,559) & + *y(k,245) + mat(k,102) = .0521005_r8*rxt(k,570)*y(k,131) + .0348005_r8*rxt(k,569) & + *y(k,245) + mat(k,2155) = .1579005_r8*rxt(k,560)*y(k,9) + .0521005_r8*rxt(k,570)*y(k,110) & + + .0966005_r8*rxt(k,581)*y(k,222) + .0025005_r8*rxt(k,585) & + *y(k,226) + mat(k,123) = .0459005_r8*rxt(k,578)*y(k,263) + mat(k,129) = .0966005_r8*rxt(k,581)*y(k,131) + .0763005_r8*rxt(k,580) & + *y(k,245) + mat(k,135) = .0025005_r8*rxt(k,585)*y(k,131) + .086_r8*rxt(k,584)*y(k,245) + mat(k,2321) = .0843005_r8*rxt(k,559)*y(k,9) + .0348005_r8*rxt(k,569)*y(k,110) & + + .0763005_r8*rxt(k,580)*y(k,222) + .086_r8*rxt(k,584)*y(k,226) + mat(k,1755) = .0459005_r8*rxt(k,578)*y(k,213) + end do + end subroutine nlnmat07 + subroutine nlnmat08( 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,111) = .0059005_r8*rxt(k,560)*y(k,131) + .0443005_r8*rxt(k,559) & + *y(k,245) + mat(k,103) = .0143005_r8*rxt(k,570)*y(k,131) + .0076005_r8*rxt(k,569) & + *y(k,245) + mat(k,2156) = .0059005_r8*rxt(k,560)*y(k,9) + .0143005_r8*rxt(k,570)*y(k,110) & + + .0073005_r8*rxt(k,581)*y(k,222) + .011_r8*rxt(k,585)*y(k,226) + mat(k,124) = .0085005_r8*rxt(k,578)*y(k,263) + mat(k,130) = .0073005_r8*rxt(k,581)*y(k,131) + .2157005_r8*rxt(k,580) & + *y(k,245) + mat(k,136) = .011_r8*rxt(k,585)*y(k,131) + .0512005_r8*rxt(k,584)*y(k,245) + mat(k,2322) = .0443005_r8*rxt(k,559)*y(k,9) + .0076005_r8*rxt(k,569)*y(k,110) & + + .2157005_r8*rxt(k,580)*y(k,222) + .0512005_r8*rxt(k,584) & + *y(k,226) + mat(k,1756) = .0085005_r8*rxt(k,578)*y(k,213) + mat(k,112) = .0536005_r8*rxt(k,560)*y(k,131) + .1621005_r8*rxt(k,559) & + *y(k,245) + mat(k,104) = .0166005_r8*rxt(k,570)*y(k,131) + .0113005_r8*rxt(k,569) & + *y(k,245) + mat(k,2157) = .0536005_r8*rxt(k,560)*y(k,9) + .0166005_r8*rxt(k,570)*y(k,110) & + + .238_r8*rxt(k,581)*y(k,222) + .1185005_r8*rxt(k,585)*y(k,226) + mat(k,125) = .0128005_r8*rxt(k,578)*y(k,263) + mat(k,131) = .238_r8*rxt(k,581)*y(k,131) + .0738005_r8*rxt(k,580)*y(k,245) + mat(k,137) = .1185005_r8*rxt(k,585)*y(k,131) + .1598005_r8*rxt(k,584) & + *y(k,245) + mat(k,2323) = .1621005_r8*rxt(k,559)*y(k,9) + .0113005_r8*rxt(k,569)*y(k,110) & + + .0738005_r8*rxt(k,580)*y(k,222) + .1598005_r8*rxt(k,584) & + *y(k,226) + mat(k,1757) = .0128005_r8*rxt(k,578)*y(k,213) + mat(k,120) = -(rxt(k,577)*y(k,263)) + mat(k,1761) = -rxt(k,577)*y(k,212) + mat(k,126) = -(rxt(k,578)*y(k,263)) + mat(k,1762) = -rxt(k,578)*y(k,213) + mat(k,233) = .100_r8*rxt(k,489)*y(k,263) + mat(k,251) = .230_r8*rxt(k,491)*y(k,263) + mat(k,1775) = .100_r8*rxt(k,489)*y(k,221) + .230_r8*rxt(k,491)*y(k,224) + mat(k,726) = -(rxt(k,513)*y(k,263)) + mat(k,1841) = -rxt(k,513)*y(k,215) + mat(k,2362) = rxt(k,511)*y(k,268) + mat(k,1214) = rxt(k,511)*y(k,245) + mat(k,682) = -(rxt(k,514)*y(k,263)) + mat(k,1836) = -rxt(k,514)*y(k,216) + mat(k,2181) = .200_r8*rxt(k,507)*y(k,258) + .200_r8*rxt(k,517)*y(k,269) + mat(k,1651) = .500_r8*rxt(k,505)*y(k,258) + mat(k,1129) = .200_r8*rxt(k,507)*y(k,131) + .500_r8*rxt(k,505)*y(k,239) + mat(k,1090) = .200_r8*rxt(k,517)*y(k,131) + mat(k,530) = -(rxt(k,518)*y(k,263)) + mat(k,1819) = -rxt(k,518)*y(k,217) + mat(k,2350) = rxt(k,516)*y(k,269) + mat(k,1089) = rxt(k,516)*y(k,245) + mat(k,1102) = -(rxt(k,519)*y(k,133) + rxt(k,520)*y(k,263)) + mat(k,2261) = -rxt(k,519)*y(k,218) + mat(k,1869) = -rxt(k,520)*y(k,218) + mat(k,1052) = .330_r8*rxt(k,500)*y(k,142) + mat(k,1024) = .330_r8*rxt(k,503)*y(k,142) + mat(k,2203) = .800_r8*rxt(k,507)*y(k,258) + .800_r8*rxt(k,517)*y(k,269) + mat(k,2261) = mat(k,2261) + rxt(k,508)*y(k,258) + mat(k,2071) = .330_r8*rxt(k,500)*y(k,6) + .330_r8*rxt(k,503)*y(k,116) + mat(k,683) = rxt(k,514)*y(k,263) + mat(k,1659) = .500_r8*rxt(k,505)*y(k,258) + rxt(k,515)*y(k,269) + mat(k,1131) = .800_r8*rxt(k,507)*y(k,131) + rxt(k,508)*y(k,133) & + + .500_r8*rxt(k,505)*y(k,239) + mat(k,1869) = mat(k,1869) + rxt(k,514)*y(k,216) + mat(k,1093) = .800_r8*rxt(k,517)*y(k,131) + rxt(k,515)*y(k,239) + mat(k,1145) = -(rxt(k,521)*y(k,263)) + mat(k,1873) = -rxt(k,521)*y(k,219) + mat(k,1055) = .300_r8*rxt(k,500)*y(k,142) + mat(k,1027) = .300_r8*rxt(k,503)*y(k,142) + mat(k,2206) = .900_r8*rxt(k,512)*y(k,268) + mat(k,2074) = .300_r8*rxt(k,500)*y(k,6) + .300_r8*rxt(k,503)*y(k,116) + mat(k,1662) = rxt(k,510)*y(k,268) + mat(k,1217) = .900_r8*rxt(k,512)*y(k,131) + rxt(k,510)*y(k,239) + mat(k,653) = -(rxt(k,488)*y(k,263)) + mat(k,1832) = -rxt(k,488)*y(k,220) + mat(k,2356) = rxt(k,486)*y(k,270) + mat(k,790) = rxt(k,486)*y(k,245) + mat(k,231) = -((rxt(k,489) + rxt(k,579)) * y(k,263)) + mat(k,1773) = -(rxt(k,489) + rxt(k,579)) * y(k,221) + mat(k,132) = -(rxt(k,580)*y(k,245) + rxt(k,581)*y(k,131)) + mat(k,2326) = -rxt(k,580)*y(k,222) + mat(k,2160) = -rxt(k,581)*y(k,222) + mat(k,230) = rxt(k,579)*y(k,263) + mat(k,1763) = rxt(k,579)*y(k,221) + mat(k,247) = -(rxt(k,455)*y(k,263)) + mat(k,1776) = -rxt(k,455)*y(k,223) + mat(k,2329) = rxt(k,452)*y(k,271) + mat(k,1269) = rxt(k,452)*y(k,245) + mat(k,252) = -(rxt(k,491)*y(k,263)) + mat(k,1777) = -rxt(k,491)*y(k,224) + mat(k,764) = -(rxt(k,494)*y(k,263)) + mat(k,1844) = -rxt(k,494)*y(k,225) + mat(k,2365) = rxt(k,492)*y(k,272) + mat(k,807) = rxt(k,492)*y(k,245) + mat(k,138) = -(rxt(k,584)*y(k,245) + rxt(k,585)*y(k,131)) + mat(k,2327) = -rxt(k,584)*y(k,226) + mat(k,2161) = -rxt(k,585)*y(k,226) + mat(k,250) = rxt(k,583)*y(k,263) + mat(k,1764) = rxt(k,583)*y(k,224) + mat(k,260) = -(rxt(k,497)*y(k,263)) + mat(k,1778) = -rxt(k,497)*y(k,227) + mat(k,253) = .150_r8*rxt(k,491)*y(k,263) + mat(k,1778) = mat(k,1778) + .150_r8*rxt(k,491)*y(k,224) + mat(k,477) = -(rxt(k,498)*y(k,263)) + mat(k,1812) = -rxt(k,498)*y(k,228) + mat(k,2342) = rxt(k,495)*y(k,273) + mat(k,553) = rxt(k,495)*y(k,245) + mat(k,567) = -(rxt(k,456)*y(k,245) + rxt(k,457)*y(k,131) + rxt(k,485) & + *y(k,132)) + mat(k,2353) = -rxt(k,456)*y(k,231) + mat(k,2176) = -rxt(k,457)*y(k,231) + mat(k,2456) = -rxt(k,485)*y(k,231) + mat(k,275) = rxt(k,462)*y(k,263) + mat(k,1823) = rxt(k,462)*y(k,24) + mat(k,1072) = -(rxt(k,417)*y(k,245) + (rxt(k,418) + rxt(k,419)) * y(k,131)) + mat(k,2380) = -rxt(k,417)*y(k,232) + mat(k,2200) = -(rxt(k,418) + rxt(k,419)) * y(k,232) + mat(k,700) = rxt(k,420)*y(k,263) + mat(k,266) = rxt(k,421)*y(k,263) + mat(k,1866) = rxt(k,420)*y(k,2) + rxt(k,421)*y(k,17) + mat(k,539) = -(rxt(k,459)*y(k,245) + rxt(k,460)*y(k,131)) + mat(k,2351) = -rxt(k,459)*y(k,233) + mat(k,2173) = -rxt(k,460)*y(k,233) + mat(k,207) = .350_r8*rxt(k,458)*y(k,263) + mat(k,467) = rxt(k,461)*y(k,263) + mat(k,1820) = .350_r8*rxt(k,458)*y(k,8) + rxt(k,461)*y(k,10) + mat(k,485) = -(rxt(k,463)*y(k,245) + rxt(k,465)*y(k,131)) + mat(k,2343) = -rxt(k,463)*y(k,234) + mat(k,2167) = -rxt(k,465)*y(k,234) + mat(k,372) = rxt(k,464)*y(k,263) + mat(k,234) = .070_r8*rxt(k,489)*y(k,263) + mat(k,254) = .060_r8*rxt(k,491)*y(k,263) + mat(k,1813) = rxt(k,464)*y(k,25) + .070_r8*rxt(k,489)*y(k,221) & + + .060_r8*rxt(k,491)*y(k,224) + mat(k,953) = -(4._r8*rxt(k,339)*y(k,235) + rxt(k,340)*y(k,239) + rxt(k,341) & + *y(k,245) + rxt(k,342)*y(k,131)) + mat(k,1655) = -rxt(k,340)*y(k,235) + mat(k,2376) = -rxt(k,341)*y(k,235) + mat(k,2195) = -rxt(k,342)*y(k,235) + mat(k,377) = .500_r8*rxt(k,344)*y(k,263) + mat(k,324) = rxt(k,345)*y(k,58) + rxt(k,346)*y(k,263) + mat(k,1971) = rxt(k,345)*y(k,30) + mat(k,1858) = .500_r8*rxt(k,344)*y(k,29) + rxt(k,346)*y(k,30) + mat(k,977) = -(rxt(k,368)*y(k,239) + rxt(k,369)*y(k,245) + rxt(k,370) & + *y(k,131)) + mat(k,1656) = -rxt(k,368)*y(k,236) + mat(k,2379) = -rxt(k,369)*y(k,236) + mat(k,2198) = -rxt(k,370)*y(k,236) + mat(k,436) = rxt(k,371)*y(k,263) + mat(k,330) = rxt(k,375)*y(k,58) + rxt(k,372)*y(k,263) + mat(k,1973) = rxt(k,375)*y(k,33) + mat(k,1861) = rxt(k,371)*y(k,32) + rxt(k,372)*y(k,33) + mat(k,690) = -(rxt(k,466)*y(k,245) + rxt(k,467)*y(k,131)) + mat(k,2359) = -rxt(k,466)*y(k,237) + mat(k,2182) = -rxt(k,467)*y(k,237) + mat(k,315) = rxt(k,468)*y(k,263) + mat(k,2182) = mat(k,2182) + rxt(k,457)*y(k,231) + mat(k,2059) = rxt(k,483)*y(k,149) + mat(k,527) = rxt(k,483)*y(k,142) + mat(k,568) = rxt(k,457)*y(k,131) + .400_r8*rxt(k,456)*y(k,245) + mat(k,2359) = mat(k,2359) + .400_r8*rxt(k,456)*y(k,231) + mat(k,1837) = rxt(k,468)*y(k,34) + mat(k,1470) = -(4._r8*rxt(k,350)*y(k,238) + rxt(k,351)*y(k,239) + rxt(k,352) & + *y(k,245) + rxt(k,353)*y(k,131) + rxt(k,364)*y(k,132) + rxt(k,392) & + *y(k,249) + rxt(k,425)*y(k,247) + rxt(k,430)*y(k,248) + rxt(k,439) & + *y(k,103) + rxt(k,450)*y(k,271)) + mat(k,1679) = -rxt(k,351)*y(k,238) + mat(k,2402) = -rxt(k,352)*y(k,238) + mat(k,2224) = -rxt(k,353)*y(k,238) + mat(k,2473) = -rxt(k,364)*y(k,238) + mat(k,1400) = -rxt(k,392)*y(k,238) + mat(k,1345) = -rxt(k,425)*y(k,238) + mat(k,1378) = -rxt(k,430)*y(k,238) + mat(k,1299) = -rxt(k,439)*y(k,238) + mat(k,1277) = -rxt(k,450)*y(k,238) + mat(k,1059) = .060_r8*rxt(k,500)*y(k,142) + mat(k,1195) = rxt(k,347)*y(k,133) + rxt(k,348)*y(k,263) + mat(k,1324) = rxt(k,373)*y(k,133) + rxt(k,374)*y(k,263) + mat(k,636) = .500_r8*rxt(k,355)*y(k,263) + mat(k,933) = .080_r8*rxt(k,445)*y(k,142) + mat(k,1315) = .100_r8*rxt(k,398)*y(k,142) + mat(k,1031) = .060_r8*rxt(k,503)*y(k,142) + mat(k,1420) = .280_r8*rxt(k,412)*y(k,142) + mat(k,2224) = mat(k,2224) + .530_r8*rxt(k,396)*y(k,249) + rxt(k,405)*y(k,251) & + + rxt(k,408)*y(k,253) + rxt(k,383)*y(k,267) + mat(k,2283) = rxt(k,347)*y(k,47) + rxt(k,373)*y(k,51) + .530_r8*rxt(k,395) & + *y(k,249) + rxt(k,406)*y(k,251) + mat(k,2090) = .060_r8*rxt(k,500)*y(k,6) + .080_r8*rxt(k,445)*y(k,100) & + + .100_r8*rxt(k,398)*y(k,111) + .060_r8*rxt(k,503)*y(k,116) & + + .280_r8*rxt(k,412)*y(k,118) + mat(k,1148) = .650_r8*rxt(k,521)*y(k,263) + mat(k,1470) = mat(k,1470) + .530_r8*rxt(k,392)*y(k,249) + mat(k,1679) = mat(k,1679) + .260_r8*rxt(k,393)*y(k,249) + rxt(k,402)*y(k,251) & + + .300_r8*rxt(k,381)*y(k,267) + mat(k,2402) = mat(k,2402) + .450_r8*rxt(k,403)*y(k,251) + .200_r8*rxt(k,407) & + *y(k,253) + .150_r8*rxt(k,382)*y(k,267) + mat(k,1400) = mat(k,1400) + .530_r8*rxt(k,396)*y(k,131) + .530_r8*rxt(k,395) & + *y(k,133) + .530_r8*rxt(k,392)*y(k,238) + .260_r8*rxt(k,393) & + *y(k,239) + mat(k,1440) = rxt(k,405)*y(k,131) + rxt(k,406)*y(k,133) + rxt(k,402)*y(k,239) & + + .450_r8*rxt(k,403)*y(k,245) + 4.000_r8*rxt(k,404)*y(k,251) + mat(k,721) = rxt(k,408)*y(k,131) + .200_r8*rxt(k,407)*y(k,245) + mat(k,1892) = rxt(k,348)*y(k,47) + rxt(k,374)*y(k,51) + .500_r8*rxt(k,355) & + *y(k,53) + .650_r8*rxt(k,521)*y(k,219) + mat(k,1261) = rxt(k,383)*y(k,131) + .300_r8*rxt(k,381)*y(k,239) & + + .150_r8*rxt(k,382)*y(k,245) + end do + end subroutine nlnmat08 + subroutine nlnmat09( 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,1684) = -(rxt(k,241)*y(k,61) + (4._r8*rxt(k,318) + 4._r8*rxt(k,319) & + ) * y(k,239) + rxt(k,320)*y(k,245) + rxt(k,321)*y(k,131) & + + rxt(k,340)*y(k,235) + rxt(k,351)*y(k,238) + rxt(k,368) & + *y(k,236) + rxt(k,381)*y(k,267) + rxt(k,393)*y(k,249) + rxt(k,402) & + *y(k,251) + rxt(k,426)*y(k,247) + rxt(k,431)*y(k,248) + rxt(k,440) & + *y(k,103) + rxt(k,451)*y(k,271) + rxt(k,505)*y(k,258) + rxt(k,510) & + *y(k,268) + rxt(k,515)*y(k,269)) + mat(k,2124) = -rxt(k,241)*y(k,239) + mat(k,2410) = -rxt(k,320)*y(k,239) + mat(k,2230) = -rxt(k,321)*y(k,239) + mat(k,956) = -rxt(k,340)*y(k,239) + mat(k,1474) = -rxt(k,351)*y(k,239) + mat(k,981) = -rxt(k,368)*y(k,239) + mat(k,1262) = -rxt(k,381)*y(k,239) + mat(k,1402) = -rxt(k,393)*y(k,239) + mat(k,1442) = -rxt(k,402)*y(k,239) + mat(k,1347) = -rxt(k,426)*y(k,239) + mat(k,1380) = -rxt(k,431)*y(k,239) + mat(k,1301) = -rxt(k,440)*y(k,239) + mat(k,1279) = -rxt(k,451)*y(k,239) + mat(k,1136) = -rxt(k,505)*y(k,239) + mat(k,1224) = -rxt(k,510)*y(k,239) + mat(k,1095) = -rxt(k,515)*y(k,239) + mat(k,1184) = .280_r8*rxt(k,367)*y(k,142) + mat(k,749) = rxt(k,354)*y(k,263) + mat(k,442) = .700_r8*rxt(k,323)*y(k,263) + mat(k,1632) = rxt(k,235)*y(k,58) + rxt(k,291)*y(k,75) + rxt(k,330)*y(k,259) & + + rxt(k,324)*y(k,263) + mat(k,1990) = rxt(k,235)*y(k,56) + mat(k,944) = rxt(k,291)*y(k,56) + mat(k,934) = .050_r8*rxt(k,445)*y(k,142) + mat(k,1301) = mat(k,1301) + rxt(k,439)*y(k,238) + mat(k,2230) = mat(k,2230) + rxt(k,353)*y(k,238) + .830_r8*rxt(k,471)*y(k,240) & + + .170_r8*rxt(k,477)*y(k,252) + mat(k,2097) = .280_r8*rxt(k,367)*y(k,31) + .050_r8*rxt(k,445)*y(k,100) + mat(k,1474) = mat(k,1474) + rxt(k,439)*y(k,103) + rxt(k,353)*y(k,131) & + + 4.000_r8*rxt(k,350)*y(k,238) + .900_r8*rxt(k,351)*y(k,239) & + + .450_r8*rxt(k,352)*y(k,245) + rxt(k,425)*y(k,247) + rxt(k,430) & + *y(k,248) + rxt(k,392)*y(k,249) + rxt(k,401)*y(k,251) & + + rxt(k,450)*y(k,271) + mat(k,1684) = mat(k,1684) + .900_r8*rxt(k,351)*y(k,238) + mat(k,823) = .830_r8*rxt(k,471)*y(k,131) + .330_r8*rxt(k,470)*y(k,245) + mat(k,2410) = mat(k,2410) + .450_r8*rxt(k,352)*y(k,238) + .330_r8*rxt(k,470) & + *y(k,240) + .070_r8*rxt(k,476)*y(k,252) + mat(k,1347) = mat(k,1347) + rxt(k,425)*y(k,238) + mat(k,1380) = mat(k,1380) + rxt(k,430)*y(k,238) + mat(k,1402) = mat(k,1402) + rxt(k,392)*y(k,238) + mat(k,1442) = mat(k,1442) + rxt(k,401)*y(k,238) + mat(k,971) = .170_r8*rxt(k,477)*y(k,131) + .070_r8*rxt(k,476)*y(k,245) + mat(k,2033) = rxt(k,330)*y(k,56) + mat(k,1901) = rxt(k,354)*y(k,52) + .700_r8*rxt(k,323)*y(k,55) + rxt(k,324) & + *y(k,56) + mat(k,1279) = mat(k,1279) + rxt(k,450)*y(k,238) + mat(k,820) = -(rxt(k,470)*y(k,245) + rxt(k,471)*y(k,131) + rxt(k,472) & + *y(k,132)) + mat(k,2369) = -rxt(k,470)*y(k,240) + mat(k,2188) = -rxt(k,471)*y(k,240) + mat(k,2462) = -rxt(k,472)*y(k,240) + mat(k,907) = -(rxt(k,603)*y(k,256) + rxt(k,604)*y(k,262) + rxt(k,605) & + *y(k,255)) + mat(k,888) = -rxt(k,603)*y(k,241) + mat(k,896) = -rxt(k,604)*y(k,241) + mat(k,741) = -rxt(k,605)*y(k,241) + mat(k,618) = -((rxt(k,389) + rxt(k,390)) * y(k,131)) + mat(k,2178) = -(rxt(k,389) + rxt(k,390)) * y(k,242) + mat(k,408) = rxt(k,388)*y(k,263) + mat(k,1828) = rxt(k,388)*y(k,18) + mat(k,507) = -(rxt(k,359)*y(k,141)) + mat(k,1568) = -rxt(k,359)*y(k,243) + mat(k,2171) = .750_r8*rxt(k,357)*y(k,244) + mat(k,838) = .750_r8*rxt(k,357)*y(k,131) + mat(k,839) = -(rxt(k,356)*y(k,245) + rxt(k,357)*y(k,131)) + mat(k,2371) = -rxt(k,356)*y(k,244) + mat(k,2189) = -rxt(k,357)*y(k,244) + mat(k,579) = rxt(k,363)*y(k,263) + mat(k,1850) = rxt(k,363)*y(k,27) + mat(k,2421) = -((rxt(k,192) + rxt(k,193) + rxt(k,194)) * y(k,78) + rxt(k,196) & + *y(k,140) + rxt(k,197)*y(k,142) + rxt(k,201)*y(k,263) & + + 4._r8*rxt(k,206)*y(k,245) + rxt(k,218)*y(k,133) + rxt(k,223) & + *y(k,131) + rxt(k,228)*y(k,132) + (rxt(k,238) + rxt(k,239) & + ) * y(k,58) + rxt(k,245)*y(k,61) + rxt(k,271)*y(k,19) + rxt(k,277) & + *y(k,21) + rxt(k,314)*y(k,44) + rxt(k,320)*y(k,239) + rxt(k,327) & + *y(k,246) + rxt(k,341)*y(k,235) + rxt(k,352)*y(k,238) + rxt(k,356) & + *y(k,244) + rxt(k,369)*y(k,236) + rxt(k,378)*y(k,266) + rxt(k,382) & + *y(k,267) + rxt(k,394)*y(k,249) + rxt(k,403)*y(k,251) + rxt(k,407) & + *y(k,253) + rxt(k,417)*y(k,232) + rxt(k,427)*y(k,247) + rxt(k,432) & + *y(k,248) + rxt(k,441)*y(k,103) + rxt(k,452)*y(k,271) + rxt(k,456) & + *y(k,231) + rxt(k,459)*y(k,233) + rxt(k,463)*y(k,234) + rxt(k,466) & + *y(k,237) + rxt(k,470)*y(k,240) + rxt(k,473)*y(k,250) + rxt(k,476) & + *y(k,252) + rxt(k,479)*y(k,265) + rxt(k,486)*y(k,270) + rxt(k,492) & + *y(k,272) + rxt(k,495)*y(k,273) + rxt(k,506)*y(k,258) + rxt(k,511) & + *y(k,268) + rxt(k,516)*y(k,269)) + mat(k,1739) = -(rxt(k,192) + rxt(k,193) + rxt(k,194)) * y(k,245) + mat(k,1955) = -rxt(k,196)*y(k,245) + mat(k,2108) = -rxt(k,197)*y(k,245) + mat(k,1912) = -rxt(k,201)*y(k,245) + mat(k,2301) = -rxt(k,218)*y(k,245) + mat(k,2241) = -rxt(k,223)*y(k,245) + mat(k,2492) = -rxt(k,228)*y(k,245) + mat(k,2001) = -(rxt(k,238) + rxt(k,239)) * y(k,245) + mat(k,2135) = -rxt(k,245)*y(k,245) + mat(k,1562) = -rxt(k,271)*y(k,245) + mat(k,1618) = -rxt(k,277)*y(k,245) + mat(k,2447) = -rxt(k,314)*y(k,245) + mat(k,1695) = -rxt(k,320)*y(k,245) + mat(k,494) = -rxt(k,327)*y(k,245) + mat(k,959) = -rxt(k,341)*y(k,245) + mat(k,1480) = -rxt(k,352)*y(k,245) + mat(k,844) = -rxt(k,356)*y(k,245) + mat(k,984) = -rxt(k,369)*y(k,245) + mat(k,866) = -rxt(k,378)*y(k,245) + mat(k,1265) = -rxt(k,382)*y(k,245) + mat(k,1407) = -rxt(k,394)*y(k,245) + mat(k,1448) = -rxt(k,403)*y(k,245) + mat(k,724) = -rxt(k,407)*y(k,245) + mat(k,1080) = -rxt(k,417)*y(k,245) + mat(k,1353) = -rxt(k,427)*y(k,245) + mat(k,1386) = -rxt(k,432)*y(k,245) + mat(k,1306) = -rxt(k,441)*y(k,245) + mat(k,1283) = -rxt(k,452)*y(k,245) + mat(k,571) = -rxt(k,456)*y(k,245) + mat(k,544) = -rxt(k,459)*y(k,245) + mat(k,489) = -rxt(k,463)*y(k,245) + mat(k,694) = -rxt(k,466)*y(k,245) + mat(k,826) = -rxt(k,470)*y(k,245) + mat(k,786) = -rxt(k,473)*y(k,245) + mat(k,974) = -rxt(k,476)*y(k,245) + mat(k,502) = -rxt(k,479)*y(k,245) + mat(k,801) = -rxt(k,486)*y(k,245) + mat(k,818) = -rxt(k,492)*y(k,245) + mat(k,559) = -rxt(k,495)*y(k,245) + mat(k,1141) = -rxt(k,506)*y(k,245) + mat(k,1228) = -rxt(k,511)*y(k,245) + mat(k,1099) = -rxt(k,516)*y(k,245) + mat(k,1064) = .570_r8*rxt(k,500)*y(k,142) + mat(k,209) = .650_r8*rxt(k,458)*y(k,263) + mat(k,1562) = mat(k,1562) + rxt(k,270)*y(k,44) + mat(k,1618) = mat(k,1618) + rxt(k,282)*y(k,263) + mat(k,322) = .350_r8*rxt(k,336)*y(k,263) + mat(k,584) = .130_r8*rxt(k,338)*y(k,142) + mat(k,312) = rxt(k,343)*y(k,263) + mat(k,1189) = .280_r8*rxt(k,367)*y(k,142) + mat(k,2447) = mat(k,2447) + rxt(k,270)*y(k,19) + rxt(k,234)*y(k,58) & + + rxt(k,315)*y(k,133) + rxt(k,316)*y(k,140) + mat(k,633) = rxt(k,299)*y(k,58) + rxt(k,300)*y(k,263) + mat(k,405) = rxt(k,302)*y(k,58) + rxt(k,303)*y(k,263) + mat(k,147) = rxt(k,349)*y(k,263) + mat(k,857) = rxt(k,322)*y(k,263) + mat(k,1643) = rxt(k,331)*y(k,259) + mat(k,2001) = mat(k,2001) + rxt(k,234)*y(k,44) + rxt(k,299)*y(k,45) & + + rxt(k,302)*y(k,48) + rxt(k,237)*y(k,81) + mat(k,2135) = mat(k,2135) + rxt(k,241)*y(k,239) + rxt(k,252)*y(k,263) + mat(k,1205) = rxt(k,334)*y(k,263) + mat(k,242) = .730_r8*rxt(k,469)*y(k,263) + mat(k,352) = .500_r8*rxt(k,537)*y(k,263) + mat(k,1211) = rxt(k,360)*y(k,263) + mat(k,1088) = rxt(k,361)*y(k,263) + mat(k,1739) = mat(k,1739) + rxt(k,195)*y(k,141) + mat(k,676) = rxt(k,237)*y(k,58) + rxt(k,191)*y(k,140) + rxt(k,200)*y(k,263) + mat(k,229) = rxt(k,325)*y(k,263) + mat(k,965) = rxt(k,326)*y(k,263) + mat(k,1246) = rxt(k,391)*y(k,263) + mat(k,1254) = rxt(k,376)*y(k,263) + mat(k,938) = .370_r8*rxt(k,445)*y(k,142) + mat(k,648) = .300_r8*rxt(k,436)*y(k,263) + mat(k,617) = rxt(k,437)*y(k,263) + mat(k,1306) = mat(k,1306) + rxt(k,442)*y(k,131) + rxt(k,443)*y(k,133) & + + rxt(k,439)*y(k,238) + 1.200_r8*rxt(k,440)*y(k,239) + mat(k,475) = rxt(k,444)*y(k,263) + mat(k,1319) = .140_r8*rxt(k,398)*y(k,142) + mat(k,388) = .200_r8*rxt(k,400)*y(k,263) + mat(k,668) = .500_r8*rxt(k,411)*y(k,263) + mat(k,1036) = .570_r8*rxt(k,503)*y(k,142) + mat(k,1430) = .280_r8*rxt(k,412)*y(k,142) + mat(k,464) = rxt(k,448)*y(k,263) + mat(k,1168) = rxt(k,449)*y(k,263) + mat(k,2241) = mat(k,2241) + rxt(k,442)*y(k,103) + rxt(k,418)*y(k,232) & + + rxt(k,460)*y(k,233) + rxt(k,465)*y(k,234) + rxt(k,342) & + *y(k,235) + rxt(k,370)*y(k,236) + rxt(k,321)*y(k,239) & + + .170_r8*rxt(k,471)*y(k,240) + rxt(k,389)*y(k,242) & + + .250_r8*rxt(k,357)*y(k,244) + rxt(k,329)*y(k,246) & + + .920_r8*rxt(k,428)*y(k,247) + .920_r8*rxt(k,434)*y(k,248) & + + .470_r8*rxt(k,396)*y(k,249) + .400_r8*rxt(k,474)*y(k,250) & + + .830_r8*rxt(k,477)*y(k,252) + rxt(k,480)*y(k,265) + rxt(k,379) & + *y(k,266) + .900_r8*rxt(k,512)*y(k,268) + .800_r8*rxt(k,517) & + *y(k,269) + rxt(k,487)*y(k,270) + rxt(k,453)*y(k,271) & + + rxt(k,493)*y(k,272) + rxt(k,496)*y(k,273) + mat(k,2301) = mat(k,2301) + rxt(k,315)*y(k,44) + rxt(k,443)*y(k,103) & + + rxt(k,429)*y(k,247) + rxt(k,435)*y(k,248) + .470_r8*rxt(k,395) & + *y(k,249) + rxt(k,221)*y(k,263) + rxt(k,454)*y(k,271) + mat(k,1955) = mat(k,1955) + rxt(k,316)*y(k,44) + rxt(k,191)*y(k,81) + mat(k,1594) = rxt(k,195)*y(k,78) + rxt(k,359)*y(k,243) + mat(k,2108) = mat(k,2108) + .570_r8*rxt(k,500)*y(k,6) + .130_r8*rxt(k,338) & + *y(k,27) + .280_r8*rxt(k,367)*y(k,31) + .370_r8*rxt(k,445) & + *y(k,100) + .140_r8*rxt(k,398)*y(k,111) + .570_r8*rxt(k,503) & + *y(k,116) + .280_r8*rxt(k,412)*y(k,118) + rxt(k,203)*y(k,263) + mat(k,218) = .800_r8*rxt(k,481)*y(k,263) + mat(k,993) = rxt(k,527)*y(k,263) + mat(k,1152) = .200_r8*rxt(k,521)*y(k,263) + mat(k,237) = .280_r8*rxt(k,489)*y(k,263) + mat(k,259) = .380_r8*rxt(k,491)*y(k,263) + mat(k,264) = .630_r8*rxt(k,497)*y(k,263) + mat(k,1080) = mat(k,1080) + rxt(k,418)*y(k,131) + mat(k,544) = mat(k,544) + rxt(k,460)*y(k,131) + mat(k,489) = mat(k,489) + rxt(k,465)*y(k,131) + mat(k,959) = mat(k,959) + rxt(k,342)*y(k,131) + 2.400_r8*rxt(k,339)*y(k,235) & + + rxt(k,340)*y(k,239) + mat(k,984) = mat(k,984) + rxt(k,370)*y(k,131) + rxt(k,368)*y(k,239) + mat(k,1480) = mat(k,1480) + rxt(k,439)*y(k,103) + .900_r8*rxt(k,351)*y(k,239) & + + rxt(k,425)*y(k,247) + rxt(k,430)*y(k,248) + .470_r8*rxt(k,392) & + *y(k,249) + rxt(k,450)*y(k,271) + mat(k,1695) = mat(k,1695) + rxt(k,241)*y(k,61) + 1.200_r8*rxt(k,440)*y(k,103) & + + rxt(k,321)*y(k,131) + rxt(k,340)*y(k,235) + rxt(k,368) & + *y(k,236) + .900_r8*rxt(k,351)*y(k,238) + 4.000_r8*rxt(k,318) & + *y(k,239) + rxt(k,426)*y(k,247) + rxt(k,431)*y(k,248) & + + .730_r8*rxt(k,393)*y(k,249) + rxt(k,402)*y(k,251) & + + .500_r8*rxt(k,505)*y(k,258) + .300_r8*rxt(k,381)*y(k,267) & + + rxt(k,510)*y(k,268) + rxt(k,515)*y(k,269) + .800_r8*rxt(k,451) & + *y(k,271) + mat(k,826) = mat(k,826) + .170_r8*rxt(k,471)*y(k,131) + .070_r8*rxt(k,470) & + *y(k,245) + mat(k,623) = rxt(k,389)*y(k,131) + mat(k,510) = rxt(k,359)*y(k,141) + mat(k,844) = mat(k,844) + .250_r8*rxt(k,357)*y(k,131) + mat(k,2421) = mat(k,2421) + .070_r8*rxt(k,470)*y(k,240) + .160_r8*rxt(k,473) & + *y(k,250) + .330_r8*rxt(k,476)*y(k,252) + mat(k,494) = mat(k,494) + rxt(k,329)*y(k,131) + mat(k,1353) = mat(k,1353) + .920_r8*rxt(k,428)*y(k,131) + rxt(k,429)*y(k,133) & + + rxt(k,425)*y(k,238) + rxt(k,426)*y(k,239) + mat(k,1386) = mat(k,1386) + .920_r8*rxt(k,434)*y(k,131) + rxt(k,435)*y(k,133) & + + rxt(k,430)*y(k,238) + rxt(k,431)*y(k,239) + mat(k,1407) = mat(k,1407) + .470_r8*rxt(k,396)*y(k,131) + .470_r8*rxt(k,395) & + *y(k,133) + .470_r8*rxt(k,392)*y(k,238) + .730_r8*rxt(k,393) & + *y(k,239) + mat(k,786) = mat(k,786) + .400_r8*rxt(k,474)*y(k,131) + .160_r8*rxt(k,473) & + *y(k,245) + mat(k,1448) = mat(k,1448) + rxt(k,402)*y(k,239) + mat(k,974) = mat(k,974) + .830_r8*rxt(k,477)*y(k,131) + .330_r8*rxt(k,476) & + *y(k,245) + mat(k,1141) = mat(k,1141) + .500_r8*rxt(k,505)*y(k,239) + mat(k,2044) = rxt(k,331)*y(k,56) + mat(k,1912) = mat(k,1912) + .650_r8*rxt(k,458)*y(k,8) + rxt(k,282)*y(k,21) & + + .350_r8*rxt(k,336)*y(k,26) + rxt(k,343)*y(k,28) + rxt(k,300) & + *y(k,45) + rxt(k,303)*y(k,48) + rxt(k,349)*y(k,49) + rxt(k,322) & + *y(k,54) + rxt(k,252)*y(k,61) + rxt(k,334)*y(k,64) & + + .730_r8*rxt(k,469)*y(k,68) + .500_r8*rxt(k,537)*y(k,69) & + + rxt(k,360)*y(k,76) + rxt(k,361)*y(k,77) + rxt(k,200)*y(k,81) & + + rxt(k,325)*y(k,88) + rxt(k,326)*y(k,89) + rxt(k,391)*y(k,95) & + + rxt(k,376)*y(k,97) + .300_r8*rxt(k,436)*y(k,101) + rxt(k,437) & + *y(k,102) + rxt(k,444)*y(k,104) + .200_r8*rxt(k,400)*y(k,112) & + + .500_r8*rxt(k,411)*y(k,115) + rxt(k,448)*y(k,122) + rxt(k,449) & + *y(k,123) + rxt(k,221)*y(k,133) + rxt(k,203)*y(k,142) & + + .800_r8*rxt(k,481)*y(k,150) + rxt(k,527)*y(k,161) & + + .200_r8*rxt(k,521)*y(k,219) + .280_r8*rxt(k,489)*y(k,221) & + + .380_r8*rxt(k,491)*y(k,224) + .630_r8*rxt(k,497)*y(k,227) + mat(k,502) = mat(k,502) + rxt(k,480)*y(k,131) + mat(k,866) = mat(k,866) + rxt(k,379)*y(k,131) + mat(k,1265) = mat(k,1265) + .300_r8*rxt(k,381)*y(k,239) + mat(k,1228) = mat(k,1228) + .900_r8*rxt(k,512)*y(k,131) + rxt(k,510)*y(k,239) + mat(k,1099) = mat(k,1099) + .800_r8*rxt(k,517)*y(k,131) + rxt(k,515)*y(k,239) + mat(k,801) = mat(k,801) + rxt(k,487)*y(k,131) + mat(k,1283) = mat(k,1283) + rxt(k,453)*y(k,131) + rxt(k,454)*y(k,133) & + + rxt(k,450)*y(k,238) + .800_r8*rxt(k,451)*y(k,239) + mat(k,818) = mat(k,818) + rxt(k,493)*y(k,131) + mat(k,559) = mat(k,559) + rxt(k,496)*y(k,131) + end do + end subroutine nlnmat09 + subroutine nlnmat10( 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,491) = -(rxt(k,327)*y(k,245) + rxt(k,329)*y(k,131)) + mat(k,2344) = -rxt(k,327)*y(k,246) + mat(k,2168) = -rxt(k,329)*y(k,246) + mat(k,2425) = rxt(k,314)*y(k,245) + mat(k,2344) = mat(k,2344) + rxt(k,314)*y(k,44) + mat(k,1341) = -(rxt(k,425)*y(k,238) + rxt(k,426)*y(k,239) + rxt(k,427) & + *y(k,245) + rxt(k,428)*y(k,131) + rxt(k,429)*y(k,133)) + mat(k,1465) = -rxt(k,425)*y(k,247) + mat(k,1674) = -rxt(k,426)*y(k,247) + mat(k,2397) = -rxt(k,427)*y(k,247) + mat(k,2219) = -rxt(k,428)*y(k,247) + mat(k,2278) = -rxt(k,429)*y(k,247) + mat(k,930) = .600_r8*rxt(k,446)*y(k,263) + mat(k,1887) = .600_r8*rxt(k,446)*y(k,100) + mat(k,1374) = -(rxt(k,430)*y(k,238) + rxt(k,431)*y(k,239) + rxt(k,432) & + *y(k,245) + rxt(k,434)*y(k,131) + rxt(k,435)*y(k,133)) + mat(k,1466) = -rxt(k,430)*y(k,248) + mat(k,1675) = -rxt(k,431)*y(k,248) + mat(k,2398) = -rxt(k,432)*y(k,248) + mat(k,2220) = -rxt(k,434)*y(k,248) + mat(k,2279) = -rxt(k,435)*y(k,248) + mat(k,931) = .400_r8*rxt(k,446)*y(k,263) + mat(k,1888) = .400_r8*rxt(k,446)*y(k,100) + mat(k,1398) = -(rxt(k,392)*y(k,238) + rxt(k,393)*y(k,239) + rxt(k,394) & + *y(k,245) + rxt(k,395)*y(k,133) + (rxt(k,396) + rxt(k,397) & + ) * y(k,131)) + mat(k,1467) = -rxt(k,392)*y(k,249) + mat(k,1676) = -rxt(k,393)*y(k,249) + mat(k,2399) = -rxt(k,394)*y(k,249) + mat(k,2280) = -rxt(k,395)*y(k,249) + mat(k,2221) = -(rxt(k,396) + rxt(k,397)) * y(k,249) + mat(k,1313) = .500_r8*rxt(k,399)*y(k,263) + mat(k,385) = .200_r8*rxt(k,400)*y(k,263) + mat(k,1417) = rxt(k,413)*y(k,263) + mat(k,1889) = .500_r8*rxt(k,399)*y(k,111) + .200_r8*rxt(k,400)*y(k,112) & + + rxt(k,413)*y(k,118) + mat(k,782) = -(rxt(k,473)*y(k,245) + rxt(k,474)*y(k,131) + rxt(k,475) & + *y(k,132)) + mat(k,2366) = -rxt(k,473)*y(k,250) + mat(k,2185) = -rxt(k,474)*y(k,250) + mat(k,2461) = -rxt(k,475)*y(k,250) + mat(k,1439) = -(rxt(k,401)*y(k,238) + rxt(k,402)*y(k,239) + rxt(k,403) & + *y(k,245) + 4._r8*rxt(k,404)*y(k,251) + rxt(k,405)*y(k,131) & + + rxt(k,406)*y(k,133) + rxt(k,414)*y(k,132)) + mat(k,1469) = -rxt(k,401)*y(k,251) + mat(k,1678) = -rxt(k,402)*y(k,251) + mat(k,2401) = -rxt(k,403)*y(k,251) + mat(k,2223) = -rxt(k,405)*y(k,251) + mat(k,2282) = -rxt(k,406)*y(k,251) + mat(k,2472) = -rxt(k,414)*y(k,251) + mat(k,1314) = .500_r8*rxt(k,399)*y(k,263) + mat(k,386) = .500_r8*rxt(k,400)*y(k,263) + mat(k,1891) = .500_r8*rxt(k,399)*y(k,111) + .500_r8*rxt(k,400)*y(k,112) + mat(k,967) = -(rxt(k,476)*y(k,245) + rxt(k,477)*y(k,131) + rxt(k,478) & + *y(k,132)) + mat(k,2378) = -rxt(k,476)*y(k,252) + mat(k,2197) = -rxt(k,477)*y(k,252) + mat(k,2464) = -rxt(k,478)*y(k,252) + mat(k,719) = -(rxt(k,407)*y(k,245) + rxt(k,408)*y(k,131)) + mat(k,2361) = -rxt(k,407)*y(k,253) + mat(k,2184) = -rxt(k,408)*y(k,253) + mat(k,562) = rxt(k,409)*y(k,263) + mat(k,395) = rxt(k,410)*y(k,263) + mat(k,1840) = rxt(k,409)*y(k,113) + rxt(k,410)*y(k,114) + mat(k,573) = -(rxt(k,208)*y(k,140) + rxt(k,209)*y(k,141)) + mat(k,1920) = -rxt(k,208)*y(k,254) + mat(k,1570) = -rxt(k,209)*y(k,254) + mat(k,1920) = mat(k,1920) + rxt(k,607)*y(k,255) + mat(k,902) = .900_r8*rxt(k,605)*y(k,255) + .800_r8*rxt(k,603)*y(k,256) + mat(k,736) = rxt(k,607)*y(k,140) + .900_r8*rxt(k,605)*y(k,241) + mat(k,886) = .800_r8*rxt(k,603)*y(k,241) + mat(k,737) = -(rxt(k,605)*y(k,241) + rxt(k,606)*y(k,141) + (rxt(k,607) & + + rxt(k,608)) * y(k,140)) + mat(k,903) = -rxt(k,605)*y(k,255) + mat(k,1571) = -rxt(k,606)*y(k,255) + mat(k,1923) = -(rxt(k,607) + rxt(k,608)) * y(k,255) + mat(k,887) = -(rxt(k,603)*y(k,241)) + mat(k,905) = -rxt(k,603)*y(k,256) + mat(k,998) = rxt(k,612)*y(k,262) + mat(k,2191) = rxt(k,614)*y(k,262) + mat(k,1929) = rxt(k,607)*y(k,255) + mat(k,1574) = rxt(k,611)*y(k,257) + mat(k,739) = rxt(k,607)*y(k,140) + mat(k,548) = rxt(k,611)*y(k,141) + mat(k,894) = rxt(k,612)*y(k,119) + rxt(k,614)*y(k,131) + mat(k,546) = -(rxt(k,609)*y(k,140) + (rxt(k,610) + rxt(k,611)) * y(k,141)) + mat(k,1919) = -rxt(k,609)*y(k,257) + mat(k,1569) = -(rxt(k,610) + rxt(k,611)) * y(k,257) + mat(k,1132) = -(rxt(k,505)*y(k,239) + rxt(k,506)*y(k,245) + rxt(k,507) & + *y(k,131) + rxt(k,508)*y(k,133)) + mat(k,1661) = -rxt(k,505)*y(k,258) + mat(k,2385) = -rxt(k,506)*y(k,258) + mat(k,2205) = -rxt(k,507)*y(k,258) + mat(k,2263) = -rxt(k,508)*y(k,258) + mat(k,1054) = rxt(k,499)*y(k,133) + mat(k,1026) = rxt(k,502)*y(k,133) + mat(k,2263) = mat(k,2263) + rxt(k,499)*y(k,6) + rxt(k,502)*y(k,116) & + + .500_r8*rxt(k,519)*y(k,218) + mat(k,455) = rxt(k,509)*y(k,263) + mat(k,1103) = .500_r8*rxt(k,519)*y(k,133) + mat(k,1872) = rxt(k,509)*y(k,135) + mat(k,2039) = -(rxt(k,173)*y(k,79) + rxt(k,174)*y(k,274) + (rxt(k,176) & + + rxt(k,177)) * y(k,141) + rxt(k,178)*y(k,142) + (rxt(k,226) & + + rxt(k,227)) * y(k,120) + rxt(k,259)*y(k,35) + rxt(k,260) & + *y(k,36) + rxt(k,261)*y(k,38) + rxt(k,262)*y(k,39) + rxt(k,263) & + *y(k,40) + rxt(k,264)*y(k,41) + rxt(k,265)*y(k,42) + (rxt(k,266) & + + rxt(k,267)) * y(k,87) + rxt(k,286)*y(k,37) + rxt(k,287) & + *y(k,57) + rxt(k,288)*y(k,80) + (rxt(k,289) + rxt(k,290) & + ) * y(k,83) + rxt(k,295)*y(k,66) + rxt(k,296)*y(k,67) + rxt(k,309) & + *y(k,43) + rxt(k,310)*y(k,45) + rxt(k,311)*y(k,84) + rxt(k,312) & + *y(k,85) + rxt(k,313)*y(k,86) + (rxt(k,330) + rxt(k,331) & + + rxt(k,332)) * y(k,56) + rxt(k,333)*y(k,88)) + mat(k,1512) = -rxt(k,173)*y(k,259) + mat(k,2514) = -rxt(k,174)*y(k,259) + mat(k,1590) = -(rxt(k,176) + rxt(k,177)) * y(k,259) + mat(k,2103) = -rxt(k,178)*y(k,259) + mat(k,302) = -(rxt(k,226) + rxt(k,227)) * y(k,259) + mat(k,144) = -rxt(k,259)*y(k,259) + mat(k,181) = -rxt(k,260)*y(k,259) + mat(k,158) = -rxt(k,261)*y(k,259) + mat(k,191) = -rxt(k,262)*y(k,259) + mat(k,162) = -rxt(k,263)*y(k,259) + mat(k,196) = -rxt(k,264)*y(k,259) + mat(k,166) = -rxt(k,265)*y(k,259) + mat(k,1545) = -(rxt(k,266) + rxt(k,267)) * y(k,259) + mat(k,186) = -rxt(k,286)*y(k,259) + mat(k,452) = -rxt(k,287)*y(k,259) + mat(k,154) = -rxt(k,288)*y(k,259) + mat(k,876) = -(rxt(k,289) + rxt(k,290)) * y(k,259) + mat(k,284) = -rxt(k,295)*y(k,259) + mat(k,293) = -rxt(k,296)*y(k,259) + mat(k,524) = -rxt(k,309)*y(k,259) + mat(k,632) = -rxt(k,310)*y(k,259) + mat(k,289) = -rxt(k,311)*y(k,259) + mat(k,299) = -rxt(k,312)*y(k,259) + mat(k,358) = -rxt(k,313)*y(k,259) + mat(k,1638) = -(rxt(k,330) + rxt(k,331) + rxt(k,332)) * y(k,259) + mat(k,228) = -rxt(k,333)*y(k,259) + mat(k,1590) = mat(k,1590) + rxt(k,209)*y(k,254) + mat(k,913) = .850_r8*rxt(k,604)*y(k,262) + mat(k,576) = rxt(k,209)*y(k,141) + mat(k,900) = .850_r8*rxt(k,604)*y(k,241) + mat(k,221) = -(rxt(k,180)*y(k,140) + rxt(k,181)*y(k,141)) + mat(k,1916) = -rxt(k,180)*y(k,260) + mat(k,1566) = -rxt(k,181)*y(k,260) + mat(k,1484) = rxt(k,182)*y(k,261) + mat(k,1916) = mat(k,1916) + rxt(k,184)*y(k,261) + mat(k,1566) = mat(k,1566) + rxt(k,185)*y(k,261) + mat(k,2053) = rxt(k,186)*y(k,261) + mat(k,223) = rxt(k,182)*y(k,65) + rxt(k,184)*y(k,140) + rxt(k,185)*y(k,141) & + + rxt(k,186)*y(k,142) + mat(k,224) = -(rxt(k,182)*y(k,65) + rxt(k,184)*y(k,140) + rxt(k,185)*y(k,141) & + + rxt(k,186)*y(k,142)) + mat(k,1485) = -rxt(k,182)*y(k,261) + mat(k,1917) = -rxt(k,184)*y(k,261) + mat(k,1567) = -rxt(k,185)*y(k,261) + mat(k,2054) = -rxt(k,186)*y(k,261) + mat(k,1567) = mat(k,1567) + rxt(k,176)*y(k,259) + mat(k,2014) = rxt(k,176)*y(k,141) + mat(k,895) = -(rxt(k,604)*y(k,241) + rxt(k,612)*y(k,119) + rxt(k,614) & + *y(k,131)) + mat(k,906) = -rxt(k,604)*y(k,262) + mat(k,999) = -rxt(k,612)*y(k,262) + mat(k,2192) = -rxt(k,614)*y(k,262) + mat(k,1488) = rxt(k,615)*y(k,264) + mat(k,1575) = rxt(k,606)*y(k,255) + rxt(k,610)*y(k,257) + rxt(k,617)*y(k,264) + mat(k,740) = rxt(k,606)*y(k,141) + mat(k,549) = rxt(k,610)*y(k,141) + mat(k,849) = rxt(k,615)*y(k,65) + rxt(k,617)*y(k,141) + mat(k,1904) = -(rxt(k,199)*y(k,79) + rxt(k,200)*y(k,81) + rxt(k,201)*y(k,245) & + + rxt(k,202)*y(k,140) + rxt(k,203)*y(k,142) + (4._r8*rxt(k,204) & + + 4._r8*rxt(k,205)) * y(k,263) + rxt(k,207)*y(k,92) + rxt(k,221) & + *y(k,133) + rxt(k,222)*y(k,119) + rxt(k,230)*y(k,132) + rxt(k,231) & + *y(k,91) + rxt(k,250)*y(k,62) + (rxt(k,252) + rxt(k,253) & + ) * y(k,61) + rxt(k,255)*y(k,87) + rxt(k,258)*y(k,94) + rxt(k,282) & + *y(k,21) + rxt(k,284)*y(k,83) + rxt(k,298)*y(k,43) + rxt(k,300) & + *y(k,45) + rxt(k,301)*y(k,46) + rxt(k,303)*y(k,48) + rxt(k,305) & + *y(k,57) + rxt(k,306)*y(k,84) + rxt(k,307)*y(k,85) + rxt(k,308) & + *y(k,86) + rxt(k,317)*y(k,44) + rxt(k,322)*y(k,54) + rxt(k,323) & + *y(k,55) + rxt(k,324)*y(k,56) + rxt(k,325)*y(k,88) + rxt(k,326) & + *y(k,89) + rxt(k,334)*y(k,64) + rxt(k,336)*y(k,26) + rxt(k,343) & + *y(k,28) + rxt(k,344)*y(k,29) + rxt(k,346)*y(k,30) + rxt(k,348) & + *y(k,47) + rxt(k,349)*y(k,49) + rxt(k,354)*y(k,52) + rxt(k,355) & + *y(k,53) + rxt(k,360)*y(k,76) + rxt(k,361)*y(k,77) + rxt(k,362) & + *y(k,147) + rxt(k,363)*y(k,27) + rxt(k,371)*y(k,32) + rxt(k,372) & + *y(k,33) + rxt(k,374)*y(k,51) + rxt(k,376)*y(k,97) + rxt(k,377) & + *y(k,134) + rxt(k,380)*y(k,156) + rxt(k,384)*y(k,157) + rxt(k,385) & + *y(k,31) + rxt(k,386)*y(k,50) + rxt(k,388)*y(k,18) + rxt(k,391) & + *y(k,95) + rxt(k,399)*y(k,111) + rxt(k,400)*y(k,112) + rxt(k,409) & + *y(k,113) + rxt(k,410)*y(k,114) + rxt(k,411)*y(k,115) + rxt(k,413) & + *y(k,118) + rxt(k,416)*y(k,1) + rxt(k,420)*y(k,2) + rxt(k,421) & + *y(k,17) + rxt(k,422)*y(k,96) + rxt(k,423)*y(k,98) + rxt(k,424) & + *y(k,99) + rxt(k,436)*y(k,101) + rxt(k,437)*y(k,102) + rxt(k,444) & + *y(k,104) + rxt(k,446)*y(k,100) + rxt(k,447)*y(k,106) + rxt(k,448) & + *y(k,122) + rxt(k,449)*y(k,123) + rxt(k,455)*y(k,223) + rxt(k,458) & + *y(k,8) + rxt(k,461)*y(k,10) + rxt(k,462)*y(k,24) + rxt(k,464) & + *y(k,25) + rxt(k,468)*y(k,34) + rxt(k,469)*y(k,68) + rxt(k,481) & + *y(k,150) + rxt(k,484)*y(k,151) + rxt(k,488)*y(k,220) + (rxt(k,489) & + + rxt(k,579)) * y(k,221) + rxt(k,491)*y(k,224) + rxt(k,494) & + *y(k,225) + rxt(k,497)*y(k,227) + rxt(k,498)*y(k,228) + rxt(k,501) & + *y(k,6) + rxt(k,504)*y(k,116) + rxt(k,509)*y(k,135) + rxt(k,513) & + *y(k,215) + rxt(k,514)*y(k,216) + rxt(k,518)*y(k,217) + rxt(k,520) & + *y(k,218) + rxt(k,521)*y(k,219) + (rxt(k,523) + rxt(k,537) & + ) * y(k,69) + rxt(k,525)*y(k,145) + rxt(k,527)*y(k,161) & + + rxt(k,531)*y(k,158) + rxt(k,536)*y(k,160) + rxt(k,539) & + *y(k,127)) + mat(k,1509) = -rxt(k,199)*y(k,263) + mat(k,673) = -rxt(k,200)*y(k,263) + mat(k,2413) = -rxt(k,201)*y(k,263) + mat(k,1947) = -rxt(k,202)*y(k,263) + mat(k,2100) = -rxt(k,203)*y(k,263) + mat(k,514) = -rxt(k,207)*y(k,263) + mat(k,2293) = -rxt(k,221)*y(k,263) + mat(k,1006) = -rxt(k,222)*y(k,263) + mat(k,2484) = -rxt(k,230)*y(k,263) + mat(k,1710) = -rxt(k,231)*y(k,263) + mat(k,1121) = -rxt(k,250)*y(k,263) + mat(k,2127) = -(rxt(k,252) + rxt(k,253)) * y(k,263) + mat(k,1542) = -rxt(k,255)*y(k,263) + mat(k,881) = -rxt(k,258)*y(k,263) + mat(k,1610) = -rxt(k,282)*y(k,263) + mat(k,874) = -rxt(k,284)*y(k,263) + mat(k,522) = -rxt(k,298)*y(k,263) + mat(k,630) = -rxt(k,300)*y(k,263) + mat(k,168) = -rxt(k,301)*y(k,263) + mat(k,403) = -rxt(k,303)*y(k,263) + mat(k,450) = -rxt(k,305)*y(k,263) + mat(k,287) = -rxt(k,306)*y(k,263) + mat(k,297) = -rxt(k,307)*y(k,263) + mat(k,356) = -rxt(k,308)*y(k,263) + mat(k,2439) = -rxt(k,317)*y(k,263) + mat(k,856) = -rxt(k,322)*y(k,263) + mat(k,444) = -rxt(k,323)*y(k,263) + mat(k,1635) = -rxt(k,324)*y(k,263) + mat(k,227) = -rxt(k,325)*y(k,263) + mat(k,964) = -rxt(k,326)*y(k,263) + mat(k,1204) = -rxt(k,334)*y(k,263) + mat(k,321) = -rxt(k,336)*y(k,263) + mat(k,311) = -rxt(k,343)*y(k,263) + mat(k,379) = -rxt(k,344)*y(k,263) + mat(k,326) = -rxt(k,346)*y(k,263) + mat(k,1198) = -rxt(k,348)*y(k,263) + mat(k,146) = -rxt(k,349)*y(k,263) + mat(k,750) = -rxt(k,354)*y(k,263) + mat(k,639) = -rxt(k,355)*y(k,263) + mat(k,1210) = -rxt(k,360)*y(k,263) + mat(k,1087) = -rxt(k,361)*y(k,263) + mat(k,606) = -rxt(k,362)*y(k,263) + mat(k,582) = -rxt(k,363)*y(k,263) + mat(k,438) = -rxt(k,371)*y(k,263) + mat(k,332) = -rxt(k,372)*y(k,263) + mat(k,1327) = -rxt(k,374)*y(k,263) + mat(k,1253) = -rxt(k,376)*y(k,263) + mat(k,918) = -rxt(k,377)*y(k,263) + mat(k,598) = -rxt(k,380)*y(k,263) + mat(k,432) = -rxt(k,384)*y(k,263) + mat(k,1185) = -rxt(k,385)*y(k,263) + mat(k,1114) = -rxt(k,386)*y(k,263) + mat(k,411) = -rxt(k,388)*y(k,263) + mat(k,1244) = -rxt(k,391)*y(k,263) + mat(k,1317) = -rxt(k,399)*y(k,263) + mat(k,387) = -rxt(k,400)*y(k,263) + mat(k,565) = -rxt(k,409)*y(k,263) + mat(k,398) = -rxt(k,410)*y(k,263) + mat(k,666) = -rxt(k,411)*y(k,263) + mat(k,1426) = -rxt(k,413)*y(k,263) + mat(k,714) = -rxt(k,416)*y(k,263) + mat(k,704) = -rxt(k,420)*y(k,263) + mat(k,267) = -rxt(k,421)*y(k,263) + mat(k,280) = -rxt(k,422)*y(k,263) + mat(k,383) = -rxt(k,423)*y(k,263) + mat(k,173) = -rxt(k,424)*y(k,263) + mat(k,647) = -rxt(k,436)*y(k,263) + mat(k,616) = -rxt(k,437)*y(k,263) + mat(k,474) = -rxt(k,444)*y(k,263) + mat(k,935) = -rxt(k,446)*y(k,263) + mat(k,757) = -rxt(k,447)*y(k,263) + mat(k,463) = -rxt(k,448)*y(k,263) + mat(k,1166) = -rxt(k,449)*y(k,263) + mat(k,249) = -rxt(k,455)*y(k,263) + mat(k,208) = -rxt(k,458)*y(k,263) + mat(k,469) = -rxt(k,461)*y(k,263) + mat(k,276) = -rxt(k,462)*y(k,263) + mat(k,374) = -rxt(k,464)*y(k,263) + mat(k,316) = -rxt(k,468)*y(k,263) + mat(k,241) = -rxt(k,469)*y(k,263) + mat(k,217) = -rxt(k,481)*y(k,263) + mat(k,368) = -rxt(k,484)*y(k,263) + mat(k,660) = -rxt(k,488)*y(k,263) + mat(k,236) = -(rxt(k,489) + rxt(k,579)) * y(k,263) + mat(k,258) = -rxt(k,491)*y(k,263) + mat(k,773) = -rxt(k,494)*y(k,263) + mat(k,263) = -rxt(k,497)*y(k,263) + mat(k,481) = -rxt(k,498)*y(k,263) + mat(k,1061) = -rxt(k,501)*y(k,263) + mat(k,1033) = -rxt(k,504)*y(k,263) + mat(k,457) = -rxt(k,509)*y(k,263) + mat(k,733) = -rxt(k,513)*y(k,263) + mat(k,685) = -rxt(k,514)*y(k,263) + mat(k,534) = -rxt(k,518)*y(k,263) + mat(k,1107) = -rxt(k,520)*y(k,263) + mat(k,1151) = -rxt(k,521)*y(k,263) + mat(k,350) = -(rxt(k,523) + rxt(k,537)) * y(k,263) + mat(k,421) = -rxt(k,525)*y(k,263) + mat(k,991) = -rxt(k,527)*y(k,263) + mat(k,779) = -rxt(k,531)*y(k,263) + mat(k,1523) = -rxt(k,536)*y(k,263) + mat(k,140) = -rxt(k,539)*y(k,263) + mat(k,1061) = mat(k,1061) + .630_r8*rxt(k,500)*y(k,142) + mat(k,321) = mat(k,321) + .650_r8*rxt(k,336)*y(k,263) + mat(k,582) = mat(k,582) + .130_r8*rxt(k,338)*y(k,142) + mat(k,379) = mat(k,379) + .500_r8*rxt(k,344)*y(k,263) + mat(k,1185) = mat(k,1185) + .360_r8*rxt(k,367)*y(k,142) + mat(k,2439) = mat(k,2439) + rxt(k,316)*y(k,140) + mat(k,444) = mat(k,444) + .300_r8*rxt(k,323)*y(k,263) + mat(k,1635) = mat(k,1635) + rxt(k,330)*y(k,259) + mat(k,1993) = rxt(k,239)*y(k,245) + mat(k,947) = rxt(k,293)*y(k,274) + mat(k,1731) = rxt(k,198)*y(k,142) + 2.000_r8*rxt(k,193)*y(k,245) + mat(k,1509) = mat(k,1509) + rxt(k,190)*y(k,140) + rxt(k,173)*y(k,259) + mat(k,673) = mat(k,673) + rxt(k,191)*y(k,140) + mat(k,874) = mat(k,874) + rxt(k,283)*y(k,140) + rxt(k,289)*y(k,259) + mat(k,1542) = mat(k,1542) + rxt(k,254)*y(k,140) + rxt(k,266)*y(k,259) + mat(k,227) = mat(k,227) + rxt(k,333)*y(k,259) + mat(k,833) = rxt(k,285)*y(k,140) + mat(k,881) = mat(k,881) + rxt(k,257)*y(k,140) + mat(k,935) = mat(k,935) + .320_r8*rxt(k,445)*y(k,142) + mat(k,757) = mat(k,757) + .600_r8*rxt(k,447)*y(k,263) + mat(k,1317) = mat(k,1317) + .240_r8*rxt(k,398)*y(k,142) + mat(k,387) = mat(k,387) + .100_r8*rxt(k,400)*y(k,263) + mat(k,1033) = mat(k,1033) + .630_r8*rxt(k,503)*y(k,142) + mat(k,1426) = mat(k,1426) + .360_r8*rxt(k,412)*y(k,142) + mat(k,2233) = rxt(k,223)*y(k,245) + mat(k,2293) = mat(k,2293) + rxt(k,218)*y(k,245) + mat(k,1947) = mat(k,1947) + rxt(k,316)*y(k,44) + rxt(k,190)*y(k,79) & + + rxt(k,191)*y(k,81) + rxt(k,283)*y(k,83) + rxt(k,254)*y(k,87) & + + rxt(k,285)*y(k,93) + rxt(k,257)*y(k,94) + rxt(k,196)*y(k,245) + mat(k,2100) = mat(k,2100) + .630_r8*rxt(k,500)*y(k,6) + .130_r8*rxt(k,338) & + *y(k,27) + .360_r8*rxt(k,367)*y(k,31) + rxt(k,198)*y(k,78) & + + .320_r8*rxt(k,445)*y(k,100) + .240_r8*rxt(k,398)*y(k,111) & + + .630_r8*rxt(k,503)*y(k,116) + .360_r8*rxt(k,412)*y(k,118) & + + rxt(k,197)*y(k,245) + mat(k,598) = mat(k,598) + .500_r8*rxt(k,380)*y(k,263) + mat(k,249) = mat(k,249) + .500_r8*rxt(k,455)*y(k,263) + mat(k,569) = .400_r8*rxt(k,456)*y(k,245) + mat(k,1476) = .450_r8*rxt(k,352)*y(k,245) + mat(k,824) = .400_r8*rxt(k,470)*y(k,245) + mat(k,2413) = mat(k,2413) + rxt(k,239)*y(k,58) + 2.000_r8*rxt(k,193)*y(k,78) & + + rxt(k,223)*y(k,131) + rxt(k,218)*y(k,133) + rxt(k,196) & + *y(k,140) + rxt(k,197)*y(k,142) + .400_r8*rxt(k,456)*y(k,231) & + + .450_r8*rxt(k,352)*y(k,238) + .400_r8*rxt(k,470)*y(k,240) & + + .450_r8*rxt(k,403)*y(k,251) + .400_r8*rxt(k,476)*y(k,252) & + + .200_r8*rxt(k,407)*y(k,253) + .150_r8*rxt(k,382)*y(k,267) + mat(k,1444) = .450_r8*rxt(k,403)*y(k,245) + mat(k,972) = .400_r8*rxt(k,476)*y(k,245) + mat(k,722) = .200_r8*rxt(k,407)*y(k,245) + mat(k,2036) = rxt(k,330)*y(k,56) + rxt(k,173)*y(k,79) + rxt(k,289)*y(k,83) & + + rxt(k,266)*y(k,87) + rxt(k,333)*y(k,88) + 2.000_r8*rxt(k,174) & + *y(k,274) + mat(k,1904) = mat(k,1904) + .650_r8*rxt(k,336)*y(k,26) + .500_r8*rxt(k,344) & + *y(k,29) + .300_r8*rxt(k,323)*y(k,55) + .600_r8*rxt(k,447) & + *y(k,106) + .100_r8*rxt(k,400)*y(k,112) + .500_r8*rxt(k,380) & + *y(k,156) + .500_r8*rxt(k,455)*y(k,223) + mat(k,1263) = .150_r8*rxt(k,382)*y(k,245) + mat(k,2511) = rxt(k,293)*y(k,75) + 2.000_r8*rxt(k,174)*y(k,259) + end do + end subroutine nlnmat10 + subroutine nlnmat11( 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,847) = -(rxt(k,615)*y(k,65) + rxt(k,617)*y(k,141)) + mat(k,1486) = -rxt(k,615)*y(k,264) + mat(k,1573) = -rxt(k,617)*y(k,264) + mat(k,1926) = rxt(k,608)*y(k,255) + rxt(k,609)*y(k,257) + mat(k,738) = rxt(k,608)*y(k,140) + mat(k,547) = rxt(k,609)*y(k,140) + mat(k,498) = -(rxt(k,479)*y(k,245) + rxt(k,480)*y(k,131)) + mat(k,2345) = -rxt(k,479)*y(k,265) + mat(k,2169) = -rxt(k,480)*y(k,265) + mat(k,239) = .200_r8*rxt(k,469)*y(k,263) + mat(k,215) = .140_r8*rxt(k,481)*y(k,263) + mat(k,366) = rxt(k,484)*y(k,263) + mat(k,1814) = .200_r8*rxt(k,469)*y(k,68) + .140_r8*rxt(k,481)*y(k,150) & + + rxt(k,484)*y(k,151) + mat(k,860) = -(rxt(k,378)*y(k,245) + rxt(k,379)*y(k,131)) + mat(k,2372) = -rxt(k,378)*y(k,266) + mat(k,2190) = -rxt(k,379)*y(k,266) + mat(k,1172) = rxt(k,385)*y(k,263) + mat(k,595) = .500_r8*rxt(k,380)*y(k,263) + mat(k,1852) = rxt(k,385)*y(k,31) + .500_r8*rxt(k,380)*y(k,156) + mat(k,1259) = -(rxt(k,381)*y(k,239) + rxt(k,382)*y(k,245) + rxt(k,383) & + *y(k,131)) + mat(k,1669) = -rxt(k,381)*y(k,267) + mat(k,2392) = -rxt(k,382)*y(k,267) + mat(k,2214) = -rxt(k,383)*y(k,267) + mat(k,1057) = .060_r8*rxt(k,500)*y(k,142) + mat(k,1111) = rxt(k,386)*y(k,263) + mat(k,1029) = .060_r8*rxt(k,503)*y(k,142) + mat(k,2081) = .060_r8*rxt(k,500)*y(k,6) + .060_r8*rxt(k,503)*y(k,116) + mat(k,430) = rxt(k,384)*y(k,263) + mat(k,1147) = .150_r8*rxt(k,521)*y(k,263) + mat(k,1882) = rxt(k,386)*y(k,50) + rxt(k,384)*y(k,157) + .150_r8*rxt(k,521) & + *y(k,219) + mat(k,1220) = -(rxt(k,510)*y(k,239) + rxt(k,511)*y(k,245) + rxt(k,512) & + *y(k,131)) + mat(k,1667) = -rxt(k,510)*y(k,268) + mat(k,2390) = -rxt(k,511)*y(k,268) + mat(k,2211) = -rxt(k,512)*y(k,268) + mat(k,2270) = .500_r8*rxt(k,519)*y(k,218) + mat(k,731) = rxt(k,513)*y(k,263) + mat(k,1106) = .500_r8*rxt(k,519)*y(k,133) + rxt(k,520)*y(k,263) + mat(k,1879) = rxt(k,513)*y(k,215) + rxt(k,520)*y(k,218) + mat(k,1092) = -(rxt(k,515)*y(k,239) + rxt(k,516)*y(k,245) + rxt(k,517) & + *y(k,131)) + mat(k,1658) = -rxt(k,515)*y(k,269) + mat(k,2382) = -rxt(k,516)*y(k,269) + mat(k,2202) = -rxt(k,517)*y(k,269) + mat(k,1051) = rxt(k,501)*y(k,263) + mat(k,1023) = rxt(k,504)*y(k,263) + mat(k,531) = rxt(k,518)*y(k,263) + mat(k,1868) = rxt(k,501)*y(k,6) + rxt(k,504)*y(k,116) + rxt(k,518)*y(k,217) + mat(k,793) = -(rxt(k,486)*y(k,245) + rxt(k,487)*y(k,131)) + mat(k,2367) = -rxt(k,486)*y(k,270) + mat(k,2186) = -rxt(k,487)*y(k,270) + mat(k,656) = rxt(k,488)*y(k,263) + mat(k,235) = (.650_r8*rxt(k,489)+rxt(k,579))*y(k,263) + mat(k,1847) = rxt(k,488)*y(k,220) + (.650_r8*rxt(k,489)+rxt(k,579))*y(k,221) + mat(k,1275) = -(rxt(k,450)*y(k,238) + rxt(k,451)*y(k,239) + rxt(k,452) & + *y(k,245) + rxt(k,453)*y(k,131) + rxt(k,454)*y(k,133)) + mat(k,1461) = -rxt(k,450)*y(k,271) + mat(k,1670) = -rxt(k,451)*y(k,271) + mat(k,2393) = -rxt(k,452)*y(k,271) + mat(k,2215) = -rxt(k,453)*y(k,271) + mat(k,2274) = -rxt(k,454)*y(k,271) + mat(k,279) = rxt(k,422)*y(k,263) + mat(k,382) = rxt(k,423)*y(k,263) + mat(k,172) = rxt(k,424)*y(k,263) + mat(k,754) = .400_r8*rxt(k,447)*y(k,263) + mat(k,248) = .500_r8*rxt(k,455)*y(k,263) + mat(k,1883) = rxt(k,422)*y(k,96) + rxt(k,423)*y(k,98) + rxt(k,424)*y(k,99) & + + .400_r8*rxt(k,447)*y(k,106) + .500_r8*rxt(k,455)*y(k,223) + mat(k,809) = -(rxt(k,492)*y(k,245) + rxt(k,493)*y(k,131)) + mat(k,2368) = -rxt(k,492)*y(k,272) + mat(k,2187) = -rxt(k,493)*y(k,272) + mat(k,255) = .560_r8*rxt(k,491)*y(k,263) + mat(k,766) = rxt(k,494)*y(k,263) + mat(k,1848) = .560_r8*rxt(k,491)*y(k,224) + rxt(k,494)*y(k,225) + mat(k,554) = -(rxt(k,495)*y(k,245) + rxt(k,496)*y(k,131)) + mat(k,2352) = -rxt(k,495)*y(k,273) + mat(k,2174) = -rxt(k,496)*y(k,273) + mat(k,262) = .300_r8*rxt(k,497)*y(k,263) + mat(k,478) = rxt(k,498)*y(k,263) + mat(k,1821) = .300_r8*rxt(k,497)*y(k,227) + rxt(k,498)*y(k,228) + mat(k,2522) = -(rxt(k,174)*y(k,259) + rxt(k,293)*y(k,75) + rxt(k,538) & + *y(k,162)) + mat(k,2047) = -rxt(k,174)*y(k,274) + mat(k,949) = -rxt(k,293)*y(k,274) + mat(k,308) = -rxt(k,538)*y(k,274) + mat(k,328) = rxt(k,346)*y(k,263) + mat(k,440) = rxt(k,371)*y(k,263) + mat(k,334) = rxt(k,372)*y(k,263) + mat(k,525) = rxt(k,298)*y(k,263) + mat(k,2450) = rxt(k,317)*y(k,263) + mat(k,634) = rxt(k,300)*y(k,263) + mat(k,170) = rxt(k,301)*y(k,263) + mat(k,1201) = rxt(k,348)*y(k,263) + mat(k,406) = rxt(k,303)*y(k,263) + mat(k,1115) = rxt(k,386)*y(k,263) + mat(k,1330) = rxt(k,374)*y(k,263) + mat(k,751) = rxt(k,354)*y(k,263) + mat(k,641) = rxt(k,355)*y(k,263) + mat(k,446) = rxt(k,323)*y(k,263) + mat(k,1646) = rxt(k,324)*y(k,263) + mat(k,1742) = rxt(k,194)*y(k,245) + mat(k,1514) = rxt(k,199)*y(k,263) + mat(k,677) = rxt(k,200)*y(k,263) + mat(k,877) = rxt(k,284)*y(k,263) + mat(k,359) = rxt(k,308)*y(k,263) + mat(k,1549) = (rxt(k,594)+rxt(k,599))*y(k,93) + (rxt(k,587)+rxt(k,593) & + +rxt(k,598))*y(k,94) + rxt(k,255)*y(k,263) + mat(k,966) = rxt(k,326)*y(k,263) + mat(k,1721) = rxt(k,231)*y(k,263) + mat(k,518) = rxt(k,207)*y(k,263) + mat(k,836) = (rxt(k,594)+rxt(k,599))*y(k,87) + mat(k,885) = (rxt(k,587)+rxt(k,593)+rxt(k,598))*y(k,87) + rxt(k,258)*y(k,263) + mat(k,1321) = .500_r8*rxt(k,399)*y(k,263) + mat(k,141) = rxt(k,539)*y(k,263) + mat(k,601) = rxt(k,380)*y(k,263) + mat(k,434) = rxt(k,384)*y(k,263) + mat(k,2424) = rxt(k,194)*y(k,78) + rxt(k,201)*y(k,263) + mat(k,1915) = rxt(k,346)*y(k,30) + rxt(k,371)*y(k,32) + rxt(k,372)*y(k,33) & + + rxt(k,298)*y(k,43) + rxt(k,317)*y(k,44) + rxt(k,300)*y(k,45) & + + rxt(k,301)*y(k,46) + rxt(k,348)*y(k,47) + rxt(k,303)*y(k,48) & + + rxt(k,386)*y(k,50) + rxt(k,374)*y(k,51) + rxt(k,354)*y(k,52) & + + rxt(k,355)*y(k,53) + rxt(k,323)*y(k,55) + rxt(k,324)*y(k,56) & + + rxt(k,199)*y(k,79) + rxt(k,200)*y(k,81) + rxt(k,284)*y(k,83) & + + rxt(k,308)*y(k,86) + rxt(k,255)*y(k,87) + rxt(k,326)*y(k,89) & + + rxt(k,231)*y(k,91) + rxt(k,207)*y(k,92) + rxt(k,258)*y(k,94) & + + .500_r8*rxt(k,399)*y(k,111) + rxt(k,539)*y(k,127) + rxt(k,380) & + *y(k,156) + rxt(k,384)*y(k,157) + rxt(k,201)*y(k,245) & + + 2.000_r8*rxt(k,204)*y(k,263) + end do + end subroutine nlnmat11 + 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) = lmat(k, 39) + mat(k, 40) = lmat(k, 40) + mat(k, 41) = lmat(k, 41) + mat(k, 42) = lmat(k, 42) + mat(k, 43) = lmat(k, 43) + mat(k, 44) = lmat(k, 44) + mat(k, 45) = lmat(k, 45) + mat(k, 46) = lmat(k, 46) + mat(k, 47) = lmat(k, 47) + mat(k, 48) = lmat(k, 48) + mat(k, 49) = lmat(k, 49) + mat(k, 50) = lmat(k, 50) + mat(k, 51) = lmat(k, 51) + mat(k, 52) = lmat(k, 52) + mat(k, 53) = lmat(k, 53) + mat(k, 54) = lmat(k, 54) + mat(k, 55) = lmat(k, 55) + mat(k, 56) = lmat(k, 56) + mat(k, 57) = lmat(k, 57) + mat(k, 58) = lmat(k, 58) + mat(k, 59) = lmat(k, 59) + mat(k, 60) = lmat(k, 60) + mat(k, 61) = lmat(k, 61) + mat(k, 62) = lmat(k, 62) + mat(k, 63) = lmat(k, 63) + mat(k, 69) = mat(k, 69) + lmat(k, 69) + mat(k, 71) = mat(k, 71) + lmat(k, 71) + mat(k, 72) = lmat(k, 72) + mat(k, 73) = lmat(k, 73) + mat(k, 74) = lmat(k, 74) + mat(k, 75) = lmat(k, 75) + mat(k, 76) = lmat(k, 76) + mat(k, 82) = mat(k, 82) + lmat(k, 82) + mat(k, 88) = mat(k, 88) + lmat(k, 88) + mat(k, 94) = mat(k, 94) + lmat(k, 94) + mat(k, 95) = lmat(k, 95) + mat(k, 96) = lmat(k, 96) + mat(k, 97) = lmat(k, 97) + mat(k, 98) = lmat(k, 98) + mat(k, 99) = lmat(k, 99) + mat(k, 105) = mat(k, 105) + lmat(k, 105) + mat(k, 107) = mat(k, 107) + lmat(k, 107) + mat(k, 113) = mat(k, 113) + lmat(k, 113) + mat(k, 114) = lmat(k, 114) + mat(k, 120) = mat(k, 120) + lmat(k, 120) + mat(k, 126) = mat(k, 126) + lmat(k, 126) + mat(k, 132) = mat(k, 132) + lmat(k, 132) + mat(k, 138) = mat(k, 138) + lmat(k, 138) + mat(k, 139) = mat(k, 139) + lmat(k, 139) + mat(k, 142) = mat(k, 142) + lmat(k, 142) + mat(k, 143) = mat(k, 143) + lmat(k, 143) + mat(k, 145) = mat(k, 145) + lmat(k, 145) + mat(k, 148) = lmat(k, 148) + 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, 153) = mat(k, 153) + lmat(k, 153) + mat(k, 155) = 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, 159) = mat(k, 159) + lmat(k, 159) + mat(k, 160) = mat(k, 160) + lmat(k, 160) + mat(k, 161) = mat(k, 161) + lmat(k, 161) + mat(k, 163) = mat(k, 163) + lmat(k, 163) + mat(k, 164) = mat(k, 164) + lmat(k, 164) + mat(k, 165) = mat(k, 165) + lmat(k, 165) + mat(k, 167) = mat(k, 167) + lmat(k, 167) + mat(k, 169) = mat(k, 169) + lmat(k, 169) + mat(k, 171) = mat(k, 171) + lmat(k, 171) + mat(k, 174) = lmat(k, 174) + mat(k, 175) = lmat(k, 175) + mat(k, 176) = lmat(k, 176) + mat(k, 177) = 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) = 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, 184) = mat(k, 184) + lmat(k, 184) + mat(k, 185) = mat(k, 185) + lmat(k, 185) + mat(k, 187) = mat(k, 187) + lmat(k, 187) + mat(k, 188) = mat(k, 188) + lmat(k, 188) + mat(k, 189) = mat(k, 189) + lmat(k, 189) + mat(k, 190) = mat(k, 190) + lmat(k, 190) + mat(k, 192) = mat(k, 192) + lmat(k, 192) + mat(k, 193) = mat(k, 193) + lmat(k, 193) + mat(k, 194) = mat(k, 194) + lmat(k, 194) + mat(k, 195) = mat(k, 195) + lmat(k, 195) + mat(k, 197) = lmat(k, 197) + mat(k, 198) = lmat(k, 198) + mat(k, 199) = lmat(k, 199) + mat(k, 200) = lmat(k, 200) + mat(k, 201) = lmat(k, 201) + mat(k, 202) = lmat(k, 202) + mat(k, 204) = mat(k, 204) + lmat(k, 204) + mat(k, 210) = lmat(k, 210) + mat(k, 211) = lmat(k, 211) + mat(k, 212) = lmat(k, 212) + mat(k, 213) = lmat(k, 213) + mat(k, 214) = mat(k, 214) + lmat(k, 214) + mat(k, 219) = lmat(k, 219) + mat(k, 220) = lmat(k, 220) + mat(k, 221) = mat(k, 221) + lmat(k, 221) + mat(k, 222) = mat(k, 222) + lmat(k, 222) + mat(k, 223) = mat(k, 223) + lmat(k, 223) + mat(k, 224) = mat(k, 224) + lmat(k, 224) + mat(k, 225) = lmat(k, 225) + mat(k, 226) = mat(k, 226) + lmat(k, 226) + mat(k, 231) = mat(k, 231) + lmat(k, 231) + mat(k, 238) = mat(k, 238) + lmat(k, 238) + mat(k, 243) = lmat(k, 243) + mat(k, 244) = lmat(k, 244) + mat(k, 245) = lmat(k, 245) + mat(k, 246) = lmat(k, 246) + mat(k, 247) = mat(k, 247) + lmat(k, 247) + mat(k, 249) = mat(k, 249) + lmat(k, 249) + mat(k, 252) = mat(k, 252) + lmat(k, 252) + mat(k, 260) = mat(k, 260) + lmat(k, 260) + mat(k, 265) = mat(k, 265) + lmat(k, 265) + 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, 272) = lmat(k, 272) + mat(k, 273) = lmat(k, 273) + mat(k, 274) = mat(k, 274) + lmat(k, 274) + mat(k, 277) = mat(k, 277) + lmat(k, 277) + mat(k, 278) = lmat(k, 278) + mat(k, 280) = mat(k, 280) + lmat(k, 280) + mat(k, 281) = lmat(k, 281) + mat(k, 282) = mat(k, 282) + lmat(k, 282) + mat(k, 283) = mat(k, 283) + lmat(k, 283) + mat(k, 285) = mat(k, 285) + lmat(k, 285) + mat(k, 286) = mat(k, 286) + lmat(k, 286) + mat(k, 288) = mat(k, 288) + lmat(k, 288) + mat(k, 290) = mat(k, 290) + lmat(k, 290) + mat(k, 291) = mat(k, 291) + lmat(k, 291) + mat(k, 292) = mat(k, 292) + lmat(k, 292) + mat(k, 294) = mat(k, 294) + lmat(k, 294) + mat(k, 295) = mat(k, 295) + lmat(k, 295) + mat(k, 298) = mat(k, 298) + lmat(k, 298) + mat(k, 300) = mat(k, 300) + lmat(k, 300) + mat(k, 302) = mat(k, 302) + lmat(k, 302) + mat(k, 305) = mat(k, 305) + lmat(k, 305) + mat(k, 306) = lmat(k, 306) + mat(k, 307) = lmat(k, 307) + mat(k, 309) = mat(k, 309) + lmat(k, 309) + mat(k, 313) = mat(k, 313) + lmat(k, 313) + mat(k, 314) = lmat(k, 314) + mat(k, 316) = mat(k, 316) + lmat(k, 316) + mat(k, 317) = mat(k, 317) + lmat(k, 317) + mat(k, 323) = mat(k, 323) + lmat(k, 323) + mat(k, 329) = mat(k, 329) + lmat(k, 329) + mat(k, 335) = lmat(k, 335) + mat(k, 336) = lmat(k, 336) + mat(k, 337) = lmat(k, 337) + mat(k, 338) = lmat(k, 338) + mat(k, 339) = lmat(k, 339) + mat(k, 340) = lmat(k, 340) + mat(k, 341) = lmat(k, 341) + mat(k, 342) = lmat(k, 342) + mat(k, 343) = lmat(k, 343) + mat(k, 344) = lmat(k, 344) + mat(k, 345) = lmat(k, 345) + mat(k, 346) = lmat(k, 346) + mat(k, 347) = mat(k, 347) + lmat(k, 347) + mat(k, 353) = mat(k, 353) + lmat(k, 353) + mat(k, 354) = mat(k, 354) + lmat(k, 354) + mat(k, 357) = mat(k, 357) + lmat(k, 357) + mat(k, 360) = mat(k, 360) + lmat(k, 360) + mat(k, 363) = lmat(k, 363) + mat(k, 364) = mat(k, 364) + lmat(k, 364) + mat(k, 365) = mat(k, 365) + lmat(k, 365) + mat(k, 367) = lmat(k, 367) + mat(k, 368) = mat(k, 368) + lmat(k, 368) + mat(k, 369) = lmat(k, 369) + mat(k, 370) = lmat(k, 370) + mat(k, 371) = mat(k, 371) + lmat(k, 371) + mat(k, 374) = mat(k, 374) + lmat(k, 374) + mat(k, 375) = lmat(k, 375) + mat(k, 376) = mat(k, 376) + lmat(k, 376) + mat(k, 378) = mat(k, 378) + lmat(k, 378) + mat(k, 379) = mat(k, 379) + lmat(k, 379) + mat(k, 380) = lmat(k, 380) + mat(k, 381) = mat(k, 381) + lmat(k, 381) + mat(k, 384) = mat(k, 384) + lmat(k, 384) + mat(k, 389) = lmat(k, 389) + mat(k, 390) = lmat(k, 390) + mat(k, 391) = lmat(k, 391) + mat(k, 392) = lmat(k, 392) + mat(k, 393) = lmat(k, 393) + mat(k, 394) = mat(k, 394) + lmat(k, 394) + mat(k, 396) = lmat(k, 396) + mat(k, 397) = lmat(k, 397) + mat(k, 398) = mat(k, 398) + lmat(k, 398) + mat(k, 399) = mat(k, 399) + lmat(k, 399) + mat(k, 402) = lmat(k, 402) + mat(k, 404) = mat(k, 404) + lmat(k, 404) + mat(k, 407) = mat(k, 407) + lmat(k, 407) + mat(k, 415) = mat(k, 415) + lmat(k, 415) + mat(k, 416) = lmat(k, 416) + mat(k, 418) = mat(k, 418) + lmat(k, 418) + mat(k, 423) = lmat(k, 423) + mat(k, 424) = lmat(k, 424) + mat(k, 425) = lmat(k, 425) + mat(k, 426) = lmat(k, 426) + mat(k, 427) = lmat(k, 427) + mat(k, 428) = lmat(k, 428) + mat(k, 429) = mat(k, 429) + lmat(k, 429) + mat(k, 431) = lmat(k, 431) + mat(k, 432) = mat(k, 432) + lmat(k, 432) + mat(k, 433) = lmat(k, 433) + mat(k, 435) = mat(k, 435) + lmat(k, 435) + mat(k, 437) = lmat(k, 437) + mat(k, 438) = mat(k, 438) + lmat(k, 438) + mat(k, 439) = lmat(k, 439) + mat(k, 441) = mat(k, 441) + lmat(k, 441) + mat(k, 443) = lmat(k, 443) + mat(k, 444) = mat(k, 444) + lmat(k, 444) + mat(k, 445) = mat(k, 445) + lmat(k, 445) + mat(k, 447) = mat(k, 447) + lmat(k, 447) + mat(k, 449) = mat(k, 449) + lmat(k, 449) + mat(k, 453) = mat(k, 453) + lmat(k, 453) + mat(k, 454) = lmat(k, 454) + mat(k, 456) = lmat(k, 456) + mat(k, 457) = mat(k, 457) + lmat(k, 457) + mat(k, 458) = lmat(k, 458) + mat(k, 459) = mat(k, 459) + lmat(k, 459) + mat(k, 462) = lmat(k, 462) + mat(k, 465) = mat(k, 465) + lmat(k, 465) + mat(k, 466) = lmat(k, 466) + mat(k, 468) = lmat(k, 468) + mat(k, 469) = mat(k, 469) + lmat(k, 469) + mat(k, 470) = lmat(k, 470) + mat(k, 471) = mat(k, 471) + lmat(k, 471) + mat(k, 472) = lmat(k, 472) + mat(k, 475) = mat(k, 475) + lmat(k, 475) + mat(k, 476) = lmat(k, 476) + mat(k, 477) = mat(k, 477) + lmat(k, 477) + mat(k, 479) = lmat(k, 479) + mat(k, 480) = lmat(k, 480) + mat(k, 481) = mat(k, 481) + lmat(k, 481) + mat(k, 482) = lmat(k, 482) + mat(k, 485) = mat(k, 485) + lmat(k, 485) + mat(k, 491) = mat(k, 491) + lmat(k, 491) + mat(k, 494) = mat(k, 494) + lmat(k, 494) + mat(k, 495) = lmat(k, 495) + mat(k, 498) = mat(k, 498) + lmat(k, 498) + mat(k, 504) = lmat(k, 504) + 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, 511) = lmat(k, 511) + mat(k, 512) = mat(k, 512) + lmat(k, 512) + mat(k, 514) = mat(k, 514) + lmat(k, 514) + mat(k, 515) = lmat(k, 515) + mat(k, 516) = lmat(k, 516) + mat(k, 517) = mat(k, 517) + lmat(k, 517) + mat(k, 519) = mat(k, 519) + lmat(k, 519) + mat(k, 521) = mat(k, 521) + lmat(k, 521) + mat(k, 526) = mat(k, 526) + lmat(k, 526) + mat(k, 530) = mat(k, 530) + lmat(k, 530) + mat(k, 532) = lmat(k, 532) + mat(k, 533) = lmat(k, 533) + mat(k, 534) = mat(k, 534) + lmat(k, 534) + mat(k, 535) = lmat(k, 535) + mat(k, 536) = lmat(k, 536) + mat(k, 539) = mat(k, 539) + lmat(k, 539) + mat(k, 546) = mat(k, 546) + lmat(k, 546) + mat(k, 554) = mat(k, 554) + lmat(k, 554) + mat(k, 561) = mat(k, 561) + lmat(k, 561) + mat(k, 563) = lmat(k, 563) + mat(k, 564) = lmat(k, 564) + mat(k, 567) = mat(k, 567) + lmat(k, 567) + mat(k, 573) = mat(k, 573) + lmat(k, 573) + mat(k, 578) = mat(k, 578) + lmat(k, 578) + mat(k, 586) = mat(k, 586) + lmat(k, 586) + mat(k, 587) = lmat(k, 587) + mat(k, 588) = lmat(k, 588) + mat(k, 589) = mat(k, 589) + lmat(k, 589) + mat(k, 590) = lmat(k, 590) + mat(k, 592) = mat(k, 592) + lmat(k, 592) + mat(k, 593) = lmat(k, 593) + mat(k, 594) = mat(k, 594) + lmat(k, 594) + mat(k, 596) = lmat(k, 596) + mat(k, 598) = mat(k, 598) + lmat(k, 598) + mat(k, 599) = lmat(k, 599) + mat(k, 600) = lmat(k, 600) + mat(k, 602) = mat(k, 602) + lmat(k, 602) + mat(k, 603) = lmat(k, 603) + mat(k, 604) = lmat(k, 604) + mat(k, 605) = lmat(k, 605) + mat(k, 607) = mat(k, 607) + lmat(k, 607) + mat(k, 609) = lmat(k, 609) + mat(k, 610) = mat(k, 610) + lmat(k, 610) + mat(k, 615) = lmat(k, 615) + mat(k, 618) = mat(k, 618) + lmat(k, 618) + mat(k, 626) = mat(k, 626) + lmat(k, 626) + mat(k, 628) = mat(k, 628) + lmat(k, 628) + mat(k, 629) = lmat(k, 629) + mat(k, 635) = mat(k, 635) + lmat(k, 635) + mat(k, 637) = mat(k, 637) + lmat(k, 637) + mat(k, 638) = lmat(k, 638) + mat(k, 639) = mat(k, 639) + lmat(k, 639) + mat(k, 642) = mat(k, 642) + lmat(k, 642) + mat(k, 646) = lmat(k, 646) + mat(k, 651) = lmat(k, 651) + mat(k, 652) = lmat(k, 652) + mat(k, 653) = mat(k, 653) + lmat(k, 653) + mat(k, 654) = lmat(k, 654) + mat(k, 658) = lmat(k, 658) + mat(k, 659) = lmat(k, 659) + mat(k, 660) = mat(k, 660) + lmat(k, 660) + mat(k, 661) = lmat(k, 661) + mat(k, 662) = mat(k, 662) + lmat(k, 662) + mat(k, 664) = lmat(k, 664) + mat(k, 670) = lmat(k, 670) + mat(k, 671) = mat(k, 671) + lmat(k, 671) + mat(k, 673) = mat(k, 673) + lmat(k, 673) + mat(k, 678) = lmat(k, 678) + mat(k, 679) = lmat(k, 679) + mat(k, 680) = lmat(k, 680) + mat(k, 681) = lmat(k, 681) + mat(k, 682) = mat(k, 682) + lmat(k, 682) + mat(k, 683) = mat(k, 683) + lmat(k, 683) + mat(k, 684) = lmat(k, 684) + mat(k, 686) = lmat(k, 686) + mat(k, 687) = mat(k, 687) + lmat(k, 687) + mat(k, 690) = mat(k, 690) + lmat(k, 690) + mat(k, 696) = lmat(k, 696) + mat(k, 697) = mat(k, 697) + lmat(k, 697) + mat(k, 701) = lmat(k, 701) + mat(k, 702) = lmat(k, 702) + mat(k, 704) = mat(k, 704) + lmat(k, 704) + mat(k, 705) = lmat(k, 705) + mat(k, 706) = lmat(k, 706) + mat(k, 707) = lmat(k, 707) + mat(k, 708) = mat(k, 708) + lmat(k, 708) + mat(k, 711) = mat(k, 711) + lmat(k, 711) + mat(k, 712) = mat(k, 712) + lmat(k, 712) + mat(k, 715) = lmat(k, 715) + mat(k, 716) = mat(k, 716) + lmat(k, 716) + mat(k, 717) = mat(k, 717) + lmat(k, 717) + mat(k, 719) = mat(k, 719) + lmat(k, 719) + mat(k, 726) = mat(k, 726) + lmat(k, 726) + mat(k, 727) = lmat(k, 727) + mat(k, 728) = lmat(k, 728) + mat(k, 729) = lmat(k, 729) + mat(k, 730) = lmat(k, 730) + mat(k, 732) = lmat(k, 732) + mat(k, 733) = mat(k, 733) + lmat(k, 733) + mat(k, 734) = lmat(k, 734) + mat(k, 735) = lmat(k, 735) + mat(k, 737) = mat(k, 737) + lmat(k, 737) + mat(k, 747) = mat(k, 747) + lmat(k, 747) + mat(k, 753) = mat(k, 753) + lmat(k, 753) + mat(k, 755) = lmat(k, 755) + mat(k, 756) = lmat(k, 756) + mat(k, 757) = mat(k, 757) + lmat(k, 757) + mat(k, 758) = lmat(k, 758) + mat(k, 759) = lmat(k, 759) + mat(k, 760) = lmat(k, 760) + mat(k, 761) = lmat(k, 761) + mat(k, 762) = lmat(k, 762) + mat(k, 763) = lmat(k, 763) + mat(k, 764) = mat(k, 764) + lmat(k, 764) + mat(k, 769) = lmat(k, 769) + mat(k, 771) = lmat(k, 771) + mat(k, 773) = mat(k, 773) + lmat(k, 773) + mat(k, 774) = lmat(k, 774) + mat(k, 775) = mat(k, 775) + lmat(k, 775) + mat(k, 782) = mat(k, 782) + lmat(k, 782) + mat(k, 793) = mat(k, 793) + lmat(k, 793) + mat(k, 809) = mat(k, 809) + lmat(k, 809) + mat(k, 820) = mat(k, 820) + lmat(k, 820) + mat(k, 829) = mat(k, 829) + lmat(k, 829) + mat(k, 831) = lmat(k, 831) + mat(k, 833) = mat(k, 833) + lmat(k, 833) + mat(k, 839) = mat(k, 839) + lmat(k, 839) + mat(k, 847) = mat(k, 847) + lmat(k, 847) + mat(k, 848) = lmat(k, 848) + mat(k, 850) = lmat(k, 850) + mat(k, 855) = mat(k, 855) + lmat(k, 855) + mat(k, 860) = mat(k, 860) + lmat(k, 860) + mat(k, 870) = mat(k, 870) + lmat(k, 870) + mat(k, 871) = mat(k, 871) + lmat(k, 871) + mat(k, 873) = mat(k, 873) + lmat(k, 873) + mat(k, 879) = mat(k, 879) + lmat(k, 879) + mat(k, 881) = mat(k, 881) + lmat(k, 881) + mat(k, 883) = mat(k, 883) + lmat(k, 883) + mat(k, 887) = mat(k, 887) + lmat(k, 887) + mat(k, 894) = mat(k, 894) + lmat(k, 894) + mat(k, 895) = mat(k, 895) + lmat(k, 895) + mat(k, 901) = mat(k, 901) + lmat(k, 901) + mat(k, 907) = mat(k, 907) + lmat(k, 907) + mat(k, 915) = mat(k, 915) + lmat(k, 915) + mat(k, 917) = lmat(k, 917) + mat(k, 919) = lmat(k, 919) + mat(k, 920) = mat(k, 920) + lmat(k, 920) + mat(k, 924) = mat(k, 924) + lmat(k, 924) + mat(k, 941) = mat(k, 941) + lmat(k, 941) + mat(k, 953) = mat(k, 953) + lmat(k, 953) + mat(k, 962) = mat(k, 962) + lmat(k, 962) + mat(k, 967) = mat(k, 967) + lmat(k, 967) + mat(k, 977) = mat(k, 977) + lmat(k, 977) + mat(k, 989) = mat(k, 989) + lmat(k, 989) + mat(k, 990) = lmat(k, 990) + mat(k, 992) = lmat(k, 992) + mat(k, 996) = lmat(k, 996) + mat(k,1000) = lmat(k,1000) + mat(k,1001) = mat(k,1001) + lmat(k,1001) + mat(k,1020) = mat(k,1020) + lmat(k,1020) + mat(k,1048) = mat(k,1048) + lmat(k,1048) + mat(k,1072) = mat(k,1072) + lmat(k,1072) + mat(k,1083) = lmat(k,1083) + mat(k,1084) = mat(k,1084) + lmat(k,1084) + mat(k,1085) = mat(k,1085) + lmat(k,1085) + mat(k,1088) = mat(k,1088) + lmat(k,1088) + mat(k,1092) = mat(k,1092) + lmat(k,1092) + mat(k,1102) = mat(k,1102) + lmat(k,1102) + mat(k,1104) = lmat(k,1104) + mat(k,1105) = lmat(k,1105) + mat(k,1109) = lmat(k,1109) + mat(k,1110) = mat(k,1110) + lmat(k,1110) + mat(k,1112) = lmat(k,1112) + mat(k,1113) = lmat(k,1113) + mat(k,1117) = mat(k,1117) + lmat(k,1117) + mat(k,1118) = mat(k,1118) + lmat(k,1118) + mat(k,1120) = mat(k,1120) + lmat(k,1120) + mat(k,1123) = mat(k,1123) + lmat(k,1123) + mat(k,1124) = mat(k,1124) + lmat(k,1124) + mat(k,1125) = mat(k,1125) + lmat(k,1125) + mat(k,1126) = lmat(k,1126) + mat(k,1132) = mat(k,1132) + lmat(k,1132) + mat(k,1144) = mat(k,1144) + lmat(k,1144) + mat(k,1145) = mat(k,1145) + lmat(k,1145) + mat(k,1146) = mat(k,1146) + lmat(k,1146) + mat(k,1147) = mat(k,1147) + lmat(k,1147) + mat(k,1148) = mat(k,1148) + lmat(k,1148) + mat(k,1149) = mat(k,1149) + lmat(k,1149) + mat(k,1152) = mat(k,1152) + lmat(k,1152) + mat(k,1153) = mat(k,1153) + lmat(k,1153) + mat(k,1155) = lmat(k,1155) + mat(k,1159) = mat(k,1159) + lmat(k,1159) + mat(k,1165) = lmat(k,1165) + mat(k,1168) = mat(k,1168) + lmat(k,1168) + mat(k,1170) = lmat(k,1170) + mat(k,1175) = mat(k,1175) + lmat(k,1175) + mat(k,1193) = mat(k,1193) + lmat(k,1193) + mat(k,1194) = lmat(k,1194) + mat(k,1196) = lmat(k,1196) + mat(k,1200) = lmat(k,1200) + mat(k,1202) = mat(k,1202) + lmat(k,1202) + mat(k,1207) = lmat(k,1207) + mat(k,1208) = mat(k,1208) + lmat(k,1208) + mat(k,1211) = mat(k,1211) + lmat(k,1211) + mat(k,1212) = mat(k,1212) + lmat(k,1212) + mat(k,1220) = mat(k,1220) + lmat(k,1220) + mat(k,1233) = lmat(k,1233) + mat(k,1234) = lmat(k,1234) + mat(k,1235) = lmat(k,1235) + mat(k,1236) = lmat(k,1236) + mat(k,1237) = mat(k,1237) + lmat(k,1237) + mat(k,1238) = lmat(k,1238) + mat(k,1240) = lmat(k,1240) + mat(k,1243) = lmat(k,1243) + mat(k,1246) = mat(k,1246) + lmat(k,1246) + mat(k,1247) = lmat(k,1247) + mat(k,1248) = lmat(k,1248) + mat(k,1250) = mat(k,1250) + lmat(k,1250) + mat(k,1252) = lmat(k,1252) + mat(k,1254) = mat(k,1254) + lmat(k,1254) + mat(k,1255) = lmat(k,1255) + mat(k,1259) = mat(k,1259) + lmat(k,1259) + mat(k,1275) = mat(k,1275) + lmat(k,1275) + mat(k,1295) = mat(k,1295) + lmat(k,1295) + mat(k,1310) = mat(k,1310) + lmat(k,1310) + mat(k,1311) = mat(k,1311) + lmat(k,1311) + mat(k,1314) = mat(k,1314) + lmat(k,1314) + mat(k,1315) = mat(k,1315) + lmat(k,1315) + mat(k,1319) = mat(k,1319) + lmat(k,1319) + mat(k,1320) = mat(k,1320) + lmat(k,1320) + mat(k,1322) = mat(k,1322) + lmat(k,1322) + mat(k,1323) = mat(k,1323) + lmat(k,1323) + mat(k,1324) = mat(k,1324) + lmat(k,1324) + mat(k,1329) = lmat(k,1329) + mat(k,1341) = mat(k,1341) + lmat(k,1341) + mat(k,1357) = lmat(k,1357) + mat(k,1374) = mat(k,1374) + lmat(k,1374) + mat(k,1386) = mat(k,1386) + lmat(k,1386) + mat(k,1398) = mat(k,1398) + lmat(k,1398) + mat(k,1412) = lmat(k,1412) + mat(k,1414) = mat(k,1414) + lmat(k,1414) + mat(k,1418) = mat(k,1418) + lmat(k,1418) + mat(k,1420) = mat(k,1420) + lmat(k,1420) + mat(k,1424) = lmat(k,1424) + mat(k,1439) = mat(k,1439) + lmat(k,1439) + mat(k,1470) = mat(k,1470) + lmat(k,1470) + mat(k,1491) = mat(k,1491) + lmat(k,1491) + mat(k,1492) = mat(k,1492) + lmat(k,1492) + mat(k,1496) = lmat(k,1496) + mat(k,1503) = mat(k,1503) + lmat(k,1503) + mat(k,1516) = lmat(k,1516) + mat(k,1518) = mat(k,1518) + lmat(k,1518) + mat(k,1524) = mat(k,1524) + lmat(k,1524) + mat(k,1537) = mat(k,1537) + lmat(k,1537) + mat(k,1541) = mat(k,1541) + lmat(k,1541) + mat(k,1544) = mat(k,1544) + lmat(k,1544) + mat(k,1553) = mat(k,1553) + lmat(k,1553) + mat(k,1573) = mat(k,1573) + lmat(k,1573) + mat(k,1575) = mat(k,1575) + lmat(k,1575) + mat(k,1576) = lmat(k,1576) + mat(k,1584) = mat(k,1584) + lmat(k,1584) + mat(k,1588) = mat(k,1588) + lmat(k,1588) + mat(k,1590) = mat(k,1590) + lmat(k,1590) + mat(k,1605) = mat(k,1605) + lmat(k,1605) + mat(k,1607) = mat(k,1607) + lmat(k,1607) + mat(k,1611) = mat(k,1611) + lmat(k,1611) + mat(k,1624) = lmat(k,1624) + mat(k,1625) = lmat(k,1625) + mat(k,1626) = mat(k,1626) + lmat(k,1626) + mat(k,1631) = mat(k,1631) + lmat(k,1631) + mat(k,1632) = mat(k,1632) + lmat(k,1632) + mat(k,1634) = mat(k,1634) + lmat(k,1634) + mat(k,1635) = mat(k,1635) + lmat(k,1635) + mat(k,1636) = lmat(k,1636) + mat(k,1644) = mat(k,1644) + lmat(k,1644) + mat(k,1646) = mat(k,1646) + lmat(k,1646) + mat(k,1684) = mat(k,1684) + lmat(k,1684) + mat(k,1708) = mat(k,1708) + lmat(k,1708) + mat(k,1710) = mat(k,1710) + lmat(k,1710) + mat(k,1720) = lmat(k,1720) + mat(k,1730) = mat(k,1730) + lmat(k,1730) + mat(k,1904) = mat(k,1904) + lmat(k,1904) + mat(k,1926) = mat(k,1926) + lmat(k,1926) + mat(k,1931) = lmat(k,1931) + mat(k,1948) = mat(k,1948) + lmat(k,1948) + mat(k,1995) = mat(k,1995) + lmat(k,1995) + mat(k,2037) = mat(k,2037) + lmat(k,2037) + mat(k,2039) = mat(k,2039) + lmat(k,2039) + mat(k,2053) = mat(k,2053) + lmat(k,2053) + mat(k,2094) = mat(k,2094) + lmat(k,2094) + mat(k,2101) = mat(k,2101) + lmat(k,2101) + mat(k,2103) = mat(k,2103) + lmat(k,2103) + mat(k,2104) = mat(k,2104) + lmat(k,2104) + mat(k,2128) = mat(k,2128) + lmat(k,2128) + mat(k,2129) = mat(k,2129) + lmat(k,2129) + mat(k,2132) = mat(k,2132) + lmat(k,2132) + mat(k,2191) = mat(k,2191) + lmat(k,2191) + mat(k,2193) = lmat(k,2193) + mat(k,2199) = mat(k,2199) + lmat(k,2199) + mat(k,2234) = mat(k,2234) + lmat(k,2234) + mat(k,2239) = mat(k,2239) + lmat(k,2239) + mat(k,2287) = mat(k,2287) + lmat(k,2287) + mat(k,2291) = mat(k,2291) + lmat(k,2291) + mat(k,2294) = mat(k,2294) + lmat(k,2294) + mat(k,2299) = mat(k,2299) + lmat(k,2299) + mat(k,2300) = mat(k,2300) + lmat(k,2300) + mat(k,2303) = mat(k,2303) + lmat(k,2303) + mat(k,2421) = mat(k,2421) + lmat(k,2421) + mat(k,2424) = mat(k,2424) + lmat(k,2424) + mat(k,2428) = mat(k,2428) + lmat(k,2428) + mat(k,2430) = lmat(k,2430) + mat(k,2438) = mat(k,2438) + lmat(k,2438) + mat(k,2448) = mat(k,2448) + lmat(k,2448) + mat(k,2482) = mat(k,2482) + lmat(k,2482) + mat(k,2484) = mat(k,2484) + lmat(k,2484) + mat(k,2485) = mat(k,2485) + lmat(k,2485) + mat(k,2490) = mat(k,2490) + lmat(k,2490) + mat(k,2494) = mat(k,2494) + lmat(k,2494) + mat(k,2501) = lmat(k,2501) + mat(k,2510) = lmat(k,2510) + mat(k,2511) = mat(k,2511) + lmat(k,2511) + mat(k,2512) = lmat(k,2512) + mat(k,2514) = mat(k,2514) + lmat(k,2514) + mat(k,2522) = mat(k,2522) + lmat(k,2522) + mat(k, 256) = 0._r8 + mat(k, 257) = 0._r8 + mat(k, 296) = 0._r8 + mat(k, 355) = 0._r8 + mat(k, 373) = 0._r8 + mat(k, 486) = 0._r8 + mat(k, 487) = 0._r8 + mat(k, 500) = 0._r8 + mat(k, 540) = 0._r8 + mat(k, 542) = 0._r8 + mat(k, 557) = 0._r8 + mat(k, 655) = 0._r8 + mat(k, 657) = 0._r8 + mat(k, 691) = 0._r8 + mat(k, 692) = 0._r8 + mat(k, 698) = 0._r8 + mat(k, 699) = 0._r8 + mat(k, 703) = 0._r8 + mat(k, 709) = 0._r8 + mat(k, 710) = 0._r8 + mat(k, 713) = 0._r8 + mat(k, 745) = 0._r8 + mat(k, 746) = 0._r8 + mat(k, 765) = 0._r8 + mat(k, 767) = 0._r8 + mat(k, 768) = 0._r8 + mat(k, 770) = 0._r8 + mat(k, 772) = 0._r8 + mat(k, 792) = 0._r8 + mat(k, 794) = 0._r8 + mat(k, 795) = 0._r8 + mat(k, 797) = 0._r8 + mat(k, 799) = 0._r8 + mat(k, 808) = 0._r8 + mat(k, 810) = 0._r8 + mat(k, 811) = 0._r8 + mat(k, 813) = 0._r8 + mat(k, 815) = 0._r8 + mat(k, 816) = 0._r8 + mat(k, 835) = 0._r8 + mat(k, 840) = 0._r8 + mat(k, 841) = 0._r8 + mat(k, 842) = 0._r8 + mat(k, 862) = 0._r8 + mat(k, 864) = 0._r8 + mat(k, 869) = 0._r8 + mat(k, 890) = 0._r8 + mat(k, 892) = 0._r8 + mat(k, 893) = 0._r8 + mat(k, 904) = 0._r8 + mat(k, 909) = 0._r8 + mat(k, 910) = 0._r8 + mat(k, 911) = 0._r8 + mat(k, 914) = 0._r8 + mat(k, 957) = 0._r8 + mat(k, 982) = 0._r8 + mat(k, 987) = 0._r8 + mat(k, 994) = 0._r8 + mat(k, 997) = 0._r8 + mat(k,1002) = 0._r8 + mat(k,1003) = 0._r8 + mat(k,1008) = 0._r8 + mat(k,1021) = 0._r8 + mat(k,1022) = 0._r8 + mat(k,1030) = 0._r8 + mat(k,1038) = 0._r8 + mat(k,1049) = 0._r8 + mat(k,1050) = 0._r8 + mat(k,1058) = 0._r8 + mat(k,1066) = 0._r8 + mat(k,1070) = 0._r8 + mat(k,1071) = 0._r8 + mat(k,1075) = 0._r8 + mat(k,1076) = 0._r8 + mat(k,1077) = 0._r8 + mat(k,1078) = 0._r8 + mat(k,1096) = 0._r8 + mat(k,1097) = 0._r8 + mat(k,1127) = 0._r8 + mat(k,1133) = 0._r8 + mat(k,1134) = 0._r8 + mat(k,1135) = 0._r8 + mat(k,1137) = 0._r8 + mat(k,1138) = 0._r8 + mat(k,1150) = 0._r8 + mat(k,1154) = 0._r8 + mat(k,1157) = 0._r8 + mat(k,1160) = 0._r8 + mat(k,1161) = 0._r8 + mat(k,1162) = 0._r8 + mat(k,1163) = 0._r8 + mat(k,1164) = 0._r8 + mat(k,1167) = 0._r8 + mat(k,1169) = 0._r8 + mat(k,1178) = 0._r8 + mat(k,1179) = 0._r8 + mat(k,1180) = 0._r8 + mat(k,1182) = 0._r8 + mat(k,1187) = 0._r8 + mat(k,1191) = 0._r8 + mat(k,1192) = 0._r8 + mat(k,1221) = 0._r8 + mat(k,1222) = 0._r8 + mat(k,1225) = 0._r8 + mat(k,1226) = 0._r8 + mat(k,1231) = 0._r8 + mat(k,1239) = 0._r8 + mat(k,1241) = 0._r8 + mat(k,1242) = 0._r8 + mat(k,1245) = 0._r8 + mat(k,1249) = 0._r8 + mat(k,1268) = 0._r8 + mat(k,1280) = 0._r8 + mat(k,1288) = 0._r8 + mat(k,1290) = 0._r8 + mat(k,1292) = 0._r8 + mat(k,1293) = 0._r8 + mat(k,1294) = 0._r8 + mat(k,1296) = 0._r8 + mat(k,1297) = 0._r8 + mat(k,1298) = 0._r8 + mat(k,1300) = 0._r8 + mat(k,1302) = 0._r8 + mat(k,1303) = 0._r8 + mat(k,1316) = 0._r8 + mat(k,1325) = 0._r8 + mat(k,1334) = 0._r8 + mat(k,1335) = 0._r8 + mat(k,1336) = 0._r8 + mat(k,1337) = 0._r8 + mat(k,1338) = 0._r8 + mat(k,1340) = 0._r8 + mat(k,1342) = 0._r8 + mat(k,1344) = 0._r8 + mat(k,1348) = 0._r8 + mat(k,1349) = 0._r8 + mat(k,1350) = 0._r8 + mat(k,1356) = 0._r8 + mat(k,1360) = 0._r8 + mat(k,1363) = 0._r8 + mat(k,1364) = 0._r8 + mat(k,1366) = 0._r8 + mat(k,1368) = 0._r8 + mat(k,1370) = 0._r8 + mat(k,1371) = 0._r8 + mat(k,1372) = 0._r8 + mat(k,1375) = 0._r8 + mat(k,1376) = 0._r8 + mat(k,1377) = 0._r8 + mat(k,1379) = 0._r8 + mat(k,1381) = 0._r8 + mat(k,1382) = 0._r8 + mat(k,1383) = 0._r8 + mat(k,1389) = 0._r8 + mat(k,1396) = 0._r8 + mat(k,1399) = 0._r8 + mat(k,1401) = 0._r8 + mat(k,1403) = 0._r8 + mat(k,1404) = 0._r8 + mat(k,1410) = 0._r8 + mat(k,1415) = 0._r8 + mat(k,1419) = 0._r8 + mat(k,1422) = 0._r8 + mat(k,1423) = 0._r8 + mat(k,1425) = 0._r8 + mat(k,1428) = 0._r8 + mat(k,1429) = 0._r8 + mat(k,1432) = 0._r8 + mat(k,1433) = 0._r8 + mat(k,1437) = 0._r8 + mat(k,1438) = 0._r8 + mat(k,1443) = 0._r8 + mat(k,1451) = 0._r8 + mat(k,1472) = 0._r8 + mat(k,1473) = 0._r8 + mat(k,1475) = 0._r8 + mat(k,1479) = 0._r8 + mat(k,1483) = 0._r8 + mat(k,1487) = 0._r8 + mat(k,1489) = 0._r8 + mat(k,1490) = 0._r8 + mat(k,1493) = 0._r8 + mat(k,1494) = 0._r8 + mat(k,1495) = 0._r8 + mat(k,1497) = 0._r8 + mat(k,1498) = 0._r8 + mat(k,1499) = 0._r8 + mat(k,1500) = 0._r8 + mat(k,1505) = 0._r8 + mat(k,1506) = 0._r8 + mat(k,1507) = 0._r8 + mat(k,1513) = 0._r8 + mat(k,1529) = 0._r8 + mat(k,1531) = 0._r8 + mat(k,1538) = 0._r8 + mat(k,1539) = 0._r8 + mat(k,1547) = 0._r8 + mat(k,1548) = 0._r8 + mat(k,1552) = 0._r8 + mat(k,1556) = 0._r8 + mat(k,1557) = 0._r8 + mat(k,1558) = 0._r8 + mat(k,1559) = 0._r8 + mat(k,1561) = 0._r8 + mat(k,1564) = 0._r8 + mat(k,1565) = 0._r8 + mat(k,1579) = 0._r8 + mat(k,1581) = 0._r8 + mat(k,1583) = 0._r8 + mat(k,1585) = 0._r8 + mat(k,1587) = 0._r8 + mat(k,1589) = 0._r8 + mat(k,1592) = 0._r8 + mat(k,1595) = 0._r8 + mat(k,1596) = 0._r8 + mat(k,1597) = 0._r8 + mat(k,1604) = 0._r8 + mat(k,1608) = 0._r8 + mat(k,1609) = 0._r8 + mat(k,1613) = 0._r8 + mat(k,1614) = 0._r8 + mat(k,1617) = 0._r8 + mat(k,1619) = 0._r8 + mat(k,1621) = 0._r8 + mat(k,1628) = 0._r8 + mat(k,1629) = 0._r8 + mat(k,1630) = 0._r8 + mat(k,1633) = 0._r8 + mat(k,1639) = 0._r8 + mat(k,1640) = 0._r8 + mat(k,1641) = 0._r8 + mat(k,1642) = 0._r8 + mat(k,1645) = 0._r8 + mat(k,1654) = 0._r8 + mat(k,1682) = 0._r8 + mat(k,1683) = 0._r8 + mat(k,1685) = 0._r8 + mat(k,1686) = 0._r8 + mat(k,1687) = 0._r8 + mat(k,1688) = 0._r8 + mat(k,1690) = 0._r8 + mat(k,1691) = 0._r8 + mat(k,1694) = 0._r8 + mat(k,1698) = 0._r8 + mat(k,1701) = 0._r8 + mat(k,1702) = 0._r8 + mat(k,1703) = 0._r8 + mat(k,1704) = 0._r8 + mat(k,1705) = 0._r8 + mat(k,1706) = 0._r8 + mat(k,1707) = 0._r8 + mat(k,1709) = 0._r8 + mat(k,1711) = 0._r8 + mat(k,1712) = 0._r8 + mat(k,1713) = 0._r8 + mat(k,1714) = 0._r8 + mat(k,1715) = 0._r8 + mat(k,1716) = 0._r8 + mat(k,1718) = 0._r8 + mat(k,1719) = 0._r8 + mat(k,1723) = 0._r8 + mat(k,1724) = 0._r8 + mat(k,1726) = 0._r8 + mat(k,1727) = 0._r8 + mat(k,1728) = 0._r8 + mat(k,1729) = 0._r8 + mat(k,1733) = 0._r8 + mat(k,1734) = 0._r8 + mat(k,1736) = 0._r8 + mat(k,1737) = 0._r8 + mat(k,1738) = 0._r8 + mat(k,1740) = 0._r8 + mat(k,1741) = 0._r8 + mat(k,1815) = 0._r8 + mat(k,1835) = 0._r8 + mat(k,1846) = 0._r8 + mat(k,1849) = 0._r8 + mat(k,1857) = 0._r8 + mat(k,1860) = 0._r8 + mat(k,1884) = 0._r8 + mat(k,1907) = 0._r8 + mat(k,1924) = 0._r8 + mat(k,1930) = 0._r8 + mat(k,1932) = 0._r8 + mat(k,1936) = 0._r8 + mat(k,1943) = 0._r8 + mat(k,1944) = 0._r8 + mat(k,1945) = 0._r8 + mat(k,1950) = 0._r8 + mat(k,1958) = 0._r8 + mat(k,1969) = 0._r8 + mat(k,1972) = 0._r8 + mat(k,1974) = 0._r8 + mat(k,1975) = 0._r8 + mat(k,1977) = 0._r8 + mat(k,1979) = 0._r8 + mat(k,1980) = 0._r8 + mat(k,1981) = 0._r8 + mat(k,1982) = 0._r8 + mat(k,1983) = 0._r8 + mat(k,1988) = 0._r8 + mat(k,1991) = 0._r8 + mat(k,1994) = 0._r8 + mat(k,1996) = 0._r8 + mat(k,1999) = 0._r8 + mat(k,2003) = 0._r8 + mat(k,2004) = 0._r8 + mat(k,2034) = 0._r8 + mat(k,2043) = 0._r8 + mat(k,2046) = 0._r8 + mat(k,2062) = 0._r8 + mat(k,2068) = 0._r8 + mat(k,2069) = 0._r8 + mat(k,2070) = 0._r8 + mat(k,2073) = 0._r8 + mat(k,2078) = 0._r8 + mat(k,2079) = 0._r8 + mat(k,2080) = 0._r8 + mat(k,2082) = 0._r8 + mat(k,2085) = 0._r8 + mat(k,2086) = 0._r8 + mat(k,2087) = 0._r8 + mat(k,2089) = 0._r8 + mat(k,2098) = 0._r8 + mat(k,2111) = 0._r8 + mat(k,2125) = 0._r8 + mat(k,2126) = 0._r8 + mat(k,2130) = 0._r8 + mat(k,2131) = 0._r8 + mat(k,2134) = 0._r8 + mat(k,2138) = 0._r8 + mat(k,2194) = 0._r8 + mat(k,2229) = 0._r8 + mat(k,2231) = 0._r8 + mat(k,2232) = 0._r8 + mat(k,2236) = 0._r8 + mat(k,2244) = 0._r8 + mat(k,2251) = 0._r8 + mat(k,2254) = 0._r8 + mat(k,2258) = 0._r8 + mat(k,2260) = 0._r8 + mat(k,2264) = 0._r8 + mat(k,2271) = 0._r8 + mat(k,2273) = 0._r8 + mat(k,2284) = 0._r8 + mat(k,2285) = 0._r8 + mat(k,2286) = 0._r8 + mat(k,2288) = 0._r8 + mat(k,2289) = 0._r8 + mat(k,2290) = 0._r8 + mat(k,2292) = 0._r8 + mat(k,2295) = 0._r8 + mat(k,2296) = 0._r8 + mat(k,2297) = 0._r8 + mat(k,2298) = 0._r8 + mat(k,2304) = 0._r8 + mat(k,2346) = 0._r8 + mat(k,2347) = 0._r8 + mat(k,2349) = 0._r8 + mat(k,2358) = 0._r8 + mat(k,2375) = 0._r8 + mat(k,2383) = 0._r8 + mat(k,2384) = 0._r8 + mat(k,2386) = 0._r8 + mat(k,2389) = 0._r8 + mat(k,2391) = 0._r8 + mat(k,2395) = 0._r8 + mat(k,2400) = 0._r8 + mat(k,2409) = 0._r8 + mat(k,2411) = 0._r8 + mat(k,2416) = 0._r8 + mat(k,2427) = 0._r8 + mat(k,2429) = 0._r8 + mat(k,2433) = 0._r8 + mat(k,2434) = 0._r8 + mat(k,2435) = 0._r8 + mat(k,2436) = 0._r8 + mat(k,2442) = 0._r8 + mat(k,2443) = 0._r8 + mat(k,2444) = 0._r8 + mat(k,2445) = 0._r8 + mat(k,2449) = 0._r8 + mat(k,2460) = 0._r8 + mat(k,2463) = 0._r8 + mat(k,2467) = 0._r8 + mat(k,2469) = 0._r8 + mat(k,2470) = 0._r8 + mat(k,2471) = 0._r8 + mat(k,2474) = 0._r8 + mat(k,2476) = 0._r8 + mat(k,2477) = 0._r8 + mat(k,2480) = 0._r8 + mat(k,2481) = 0._r8 + mat(k,2483) = 0._r8 + mat(k,2486) = 0._r8 + mat(k,2487) = 0._r8 + mat(k,2493) = 0._r8 + mat(k,2495) = 0._r8 + mat(k,2500) = 0._r8 + mat(k,2502) = 0._r8 + mat(k,2503) = 0._r8 + mat(k,2504) = 0._r8 + mat(k,2505) = 0._r8 + mat(k,2506) = 0._r8 + mat(k,2507) = 0._r8 + mat(k,2508) = 0._r8 + mat(k,2509) = 0._r8 + mat(k,2513) = 0._r8 + mat(k,2515) = 0._r8 + mat(k,2516) = 0._r8 + mat(k,2517) = 0._r8 + mat(k,2518) = 0._r8 + mat(k,2519) = 0._r8 + mat(k,2520) = 0._r8 + mat(k,2521) = 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, 10) = mat(k, 10) - 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, 33) = mat(k, 33) - 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, 37) = mat(k, 37) - dti(k) + mat(k, 38) = mat(k, 38) - dti(k) + mat(k, 39) = mat(k, 39) - dti(k) + mat(k, 40) = mat(k, 40) - dti(k) + mat(k, 41) = mat(k, 41) - dti(k) + mat(k, 42) = mat(k, 42) - dti(k) + mat(k, 43) = mat(k, 43) - dti(k) + mat(k, 44) = mat(k, 44) - dti(k) + mat(k, 45) = mat(k, 45) - dti(k) + mat(k, 46) = mat(k, 46) - dti(k) + mat(k, 47) = mat(k, 47) - dti(k) + mat(k, 48) = mat(k, 48) - dti(k) + mat(k, 49) = mat(k, 49) - dti(k) + mat(k, 50) = mat(k, 50) - dti(k) + mat(k, 51) = mat(k, 51) - dti(k) + mat(k, 52) = mat(k, 52) - dti(k) + mat(k, 53) = mat(k, 53) - dti(k) + mat(k, 54) = mat(k, 54) - dti(k) + mat(k, 55) = mat(k, 55) - dti(k) + mat(k, 56) = mat(k, 56) - dti(k) + mat(k, 57) = mat(k, 57) - dti(k) + mat(k, 58) = mat(k, 58) - dti(k) + mat(k, 59) = mat(k, 59) - dti(k) + mat(k, 60) = mat(k, 60) - dti(k) + mat(k, 61) = mat(k, 61) - dti(k) + mat(k, 62) = mat(k, 62) - dti(k) + mat(k, 63) = mat(k, 63) - dti(k) + mat(k, 69) = mat(k, 69) - dti(k) + mat(k, 71) = mat(k, 71) - dti(k) + mat(k, 72) = mat(k, 72) - dti(k) + mat(k, 73) = mat(k, 73) - dti(k) + mat(k, 74) = mat(k, 74) - dti(k) + mat(k, 75) = mat(k, 75) - dti(k) + mat(k, 76) = mat(k, 76) - dti(k) + mat(k, 82) = mat(k, 82) - dti(k) + mat(k, 88) = mat(k, 88) - dti(k) + mat(k, 94) = mat(k, 94) - dti(k) + mat(k, 95) = mat(k, 95) - dti(k) + mat(k, 96) = mat(k, 96) - dti(k) + mat(k, 97) = mat(k, 97) - dti(k) + mat(k, 98) = mat(k, 98) - dti(k) + mat(k, 99) = mat(k, 99) - dti(k) + mat(k, 105) = mat(k, 105) - dti(k) + mat(k, 107) = mat(k, 107) - dti(k) + mat(k, 113) = mat(k, 113) - dti(k) + mat(k, 114) = mat(k, 114) - dti(k) + mat(k, 120) = mat(k, 120) - dti(k) + mat(k, 126) = mat(k, 126) - dti(k) + mat(k, 132) = mat(k, 132) - dti(k) + mat(k, 138) = mat(k, 138) - dti(k) + mat(k, 139) = mat(k, 139) - dti(k) + mat(k, 142) = mat(k, 142) - dti(k) + mat(k, 145) = mat(k, 145) - dti(k) + mat(k, 148) = mat(k, 148) - dti(k) + mat(k, 151) = mat(k, 151) - dti(k) + mat(k, 155) = mat(k, 155) - dti(k) + mat(k, 159) = mat(k, 159) - dti(k) + mat(k, 163) = mat(k, 163) - dti(k) + mat(k, 167) = mat(k, 167) - dti(k) + mat(k, 171) = mat(k, 171) - dti(k) + mat(k, 174) = mat(k, 174) - dti(k) + mat(k, 177) = mat(k, 177) - dti(k) + mat(k, 182) = mat(k, 182) - dti(k) + mat(k, 187) = mat(k, 187) - dti(k) + mat(k, 192) = mat(k, 192) - dti(k) + mat(k, 197) = mat(k, 197) - dti(k) + mat(k, 200) = mat(k, 200) - dti(k) + mat(k, 204) = mat(k, 204) - dti(k) + mat(k, 210) = mat(k, 210) - dti(k) + mat(k, 214) = mat(k, 214) - dti(k) + mat(k, 219) = mat(k, 219) - dti(k) + mat(k, 221) = mat(k, 221) - dti(k) + mat(k, 224) = mat(k, 224) - dti(k) + mat(k, 226) = mat(k, 226) - dti(k) + mat(k, 231) = mat(k, 231) - dti(k) + mat(k, 238) = mat(k, 238) - dti(k) + mat(k, 243) = mat(k, 243) - dti(k) + mat(k, 247) = mat(k, 247) - dti(k) + mat(k, 252) = mat(k, 252) - dti(k) + mat(k, 260) = mat(k, 260) - dti(k) + mat(k, 265) = mat(k, 265) - dti(k) + mat(k, 268) = mat(k, 268) - dti(k) + mat(k, 271) = mat(k, 271) - dti(k) + mat(k, 274) = mat(k, 274) - dti(k) + mat(k, 277) = mat(k, 277) - dti(k) + mat(k, 282) = mat(k, 282) - dti(k) + mat(k, 285) = mat(k, 285) - dti(k) + mat(k, 290) = mat(k, 290) - dti(k) + mat(k, 295) = mat(k, 295) - dti(k) + mat(k, 300) = mat(k, 300) - dti(k) + mat(k, 305) = mat(k, 305) - dti(k) + mat(k, 309) = mat(k, 309) - dti(k) + mat(k, 313) = mat(k, 313) - dti(k) + mat(k, 317) = mat(k, 317) - dti(k) + mat(k, 323) = mat(k, 323) - dti(k) + mat(k, 329) = mat(k, 329) - dti(k) + mat(k, 335) = mat(k, 335) - dti(k) + mat(k, 338) = mat(k, 338) - dti(k) + mat(k, 344) = mat(k, 344) - dti(k) + mat(k, 347) = mat(k, 347) - dti(k) + mat(k, 354) = mat(k, 354) - dti(k) + mat(k, 360) = mat(k, 360) - dti(k) + mat(k, 365) = mat(k, 365) - dti(k) + mat(k, 371) = mat(k, 371) - dti(k) + mat(k, 376) = mat(k, 376) - dti(k) + mat(k, 381) = mat(k, 381) - dti(k) + mat(k, 384) = mat(k, 384) - dti(k) + mat(k, 389) = mat(k, 389) - dti(k) + mat(k, 394) = mat(k, 394) - dti(k) + mat(k, 399) = mat(k, 399) - dti(k) + mat(k, 407) = mat(k, 407) - dti(k) + mat(k, 415) = mat(k, 415) - dti(k) + mat(k, 423) = mat(k, 423) - dti(k) + mat(k, 429) = mat(k, 429) - dti(k) + mat(k, 435) = mat(k, 435) - dti(k) + mat(k, 441) = mat(k, 441) - dti(k) + mat(k, 447) = mat(k, 447) - dti(k) + mat(k, 453) = mat(k, 453) - dti(k) + mat(k, 459) = mat(k, 459) - dti(k) + mat(k, 465) = mat(k, 465) - dti(k) + mat(k, 471) = mat(k, 471) - dti(k) + mat(k, 477) = mat(k, 477) - dti(k) + mat(k, 485) = mat(k, 485) - dti(k) + mat(k, 491) = mat(k, 491) - dti(k) + mat(k, 498) = mat(k, 498) - dti(k) + mat(k, 504) = mat(k, 504) - dti(k) + mat(k, 507) = mat(k, 507) - dti(k) + mat(k, 512) = mat(k, 512) - dti(k) + mat(k, 519) = mat(k, 519) - dti(k) + mat(k, 526) = mat(k, 526) - dti(k) + mat(k, 530) = mat(k, 530) - dti(k) + mat(k, 539) = mat(k, 539) - dti(k) + mat(k, 546) = mat(k, 546) - dti(k) + mat(k, 554) = mat(k, 554) - dti(k) + mat(k, 561) = mat(k, 561) - dti(k) + mat(k, 567) = mat(k, 567) - dti(k) + mat(k, 573) = mat(k, 573) - dti(k) + mat(k, 578) = mat(k, 578) - dti(k) + mat(k, 586) = mat(k, 586) - dti(k) + mat(k, 594) = mat(k, 594) - dti(k) + mat(k, 602) = mat(k, 602) - dti(k) + mat(k, 610) = mat(k, 610) - dti(k) + mat(k, 618) = mat(k, 618) - dti(k) + mat(k, 626) = mat(k, 626) - dti(k) + mat(k, 635) = mat(k, 635) - dti(k) + mat(k, 642) = mat(k, 642) - dti(k) + mat(k, 653) = mat(k, 653) - dti(k) + mat(k, 662) = mat(k, 662) - dti(k) + mat(k, 671) = mat(k, 671) - dti(k) + mat(k, 678) = mat(k, 678) - dti(k) + mat(k, 682) = mat(k, 682) - dti(k) + mat(k, 690) = mat(k, 690) - dti(k) + mat(k, 697) = mat(k, 697) - dti(k) + mat(k, 708) = mat(k, 708) - dti(k) + mat(k, 719) = mat(k, 719) - dti(k) + mat(k, 726) = mat(k, 726) - dti(k) + mat(k, 737) = mat(k, 737) - dti(k) + mat(k, 747) = mat(k, 747) - dti(k) + mat(k, 753) = mat(k, 753) - dti(k) + mat(k, 764) = mat(k, 764) - dti(k) + mat(k, 775) = mat(k, 775) - dti(k) + mat(k, 782) = mat(k, 782) - dti(k) + mat(k, 793) = mat(k, 793) - dti(k) + mat(k, 809) = mat(k, 809) - dti(k) + mat(k, 820) = mat(k, 820) - dti(k) + mat(k, 829) = mat(k, 829) - dti(k) + mat(k, 839) = mat(k, 839) - dti(k) + mat(k, 847) = mat(k, 847) - dti(k) + mat(k, 855) = mat(k, 855) - dti(k) + mat(k, 860) = mat(k, 860) - dti(k) + mat(k, 870) = mat(k, 870) - dti(k) + mat(k, 879) = mat(k, 879) - dti(k) + mat(k, 887) = mat(k, 887) - dti(k) + mat(k, 895) = mat(k, 895) - dti(k) + mat(k, 907) = mat(k, 907) - dti(k) + mat(k, 915) = mat(k, 915) - dti(k) + mat(k, 924) = mat(k, 924) - dti(k) + mat(k, 941) = mat(k, 941) - dti(k) + mat(k, 953) = mat(k, 953) - dti(k) + mat(k, 962) = mat(k, 962) - dti(k) + mat(k, 967) = mat(k, 967) - dti(k) + mat(k, 977) = mat(k, 977) - dti(k) + mat(k, 989) = mat(k, 989) - dti(k) + mat(k,1001) = mat(k,1001) - dti(k) + mat(k,1020) = mat(k,1020) - dti(k) + mat(k,1048) = mat(k,1048) - dti(k) + mat(k,1072) = mat(k,1072) - dti(k) + mat(k,1084) = mat(k,1084) - dti(k) + mat(k,1092) = mat(k,1092) - dti(k) + mat(k,1102) = mat(k,1102) - dti(k) + mat(k,1110) = mat(k,1110) - dti(k) + mat(k,1118) = mat(k,1118) - dti(k) + mat(k,1132) = mat(k,1132) - dti(k) + mat(k,1145) = mat(k,1145) - dti(k) + mat(k,1159) = mat(k,1159) - dti(k) + mat(k,1175) = mat(k,1175) - dti(k) + mat(k,1193) = mat(k,1193) - dti(k) + mat(k,1202) = mat(k,1202) - dti(k) + mat(k,1208) = mat(k,1208) - dti(k) + mat(k,1220) = mat(k,1220) - dti(k) + mat(k,1237) = mat(k,1237) - dti(k) + mat(k,1250) = mat(k,1250) - dti(k) + mat(k,1259) = mat(k,1259) - dti(k) + mat(k,1275) = mat(k,1275) - dti(k) + mat(k,1295) = mat(k,1295) - dti(k) + mat(k,1311) = mat(k,1311) - dti(k) + mat(k,1323) = mat(k,1323) - dti(k) + mat(k,1341) = mat(k,1341) - dti(k) + mat(k,1374) = mat(k,1374) - dti(k) + mat(k,1398) = mat(k,1398) - dti(k) + mat(k,1418) = mat(k,1418) - dti(k) + mat(k,1439) = mat(k,1439) - dti(k) + mat(k,1470) = mat(k,1470) - dti(k) + mat(k,1492) = mat(k,1492) - dti(k) + mat(k,1503) = mat(k,1503) - dti(k) + mat(k,1518) = mat(k,1518) - dti(k) + mat(k,1537) = mat(k,1537) - dti(k) + mat(k,1553) = mat(k,1553) - dti(k) + mat(k,1584) = mat(k,1584) - dti(k) + mat(k,1607) = mat(k,1607) - dti(k) + mat(k,1631) = mat(k,1631) - dti(k) + mat(k,1684) = mat(k,1684) - dti(k) + mat(k,1708) = mat(k,1708) - dti(k) + mat(k,1730) = mat(k,1730) - dti(k) + mat(k,1904) = mat(k,1904) - dti(k) + mat(k,1948) = mat(k,1948) - dti(k) + mat(k,1995) = mat(k,1995) - dti(k) + mat(k,2039) = mat(k,2039) - dti(k) + mat(k,2104) = mat(k,2104) - dti(k) + mat(k,2132) = mat(k,2132) - dti(k) + mat(k,2239) = mat(k,2239) - dti(k) + mat(k,2300) = mat(k,2300) - dti(k) + mat(k,2421) = mat(k,2421) - dti(k) + mat(k,2448) = mat(k,2448) - dti(k) + mat(k,2494) = mat(k,2494) - dti(k) + mat(k,2522) = mat(k,2522) - 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 nlnmat08( avec_len, mat, y, rxt ) + call nlnmat09( avec_len, mat, y, rxt ) + call nlnmat10( avec_len, mat, y, rxt ) + call nlnmat11( 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_waccm_tsmlt_mam4_vbsext/mo_phtadj.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_phtadj.F90 new file mode 100644 index 0000000000..6a03fe4d4b --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_phtadj.F90 @@ -0,0 +1,33 @@ + 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,112) = p_rate(:,k,112) * inv(:,k, 2) * im(:,k) + p_rate(:,k,113) = p_rate(:,k,113) * inv(:,k, 2) * im(:,k) + p_rate(:,k,114) = p_rate(:,k,114) * inv(:,k, 2) * im(:,k) + p_rate(:,k,115) = p_rate(:,k,115) * inv(:,k, 2) * im(:,k) + p_rate(:,k,116) = p_rate(:,k,116) * inv(:,k, 2) * im(:,k) + p_rate(:,k,117) = p_rate(:,k,117) * inv(:,k, 2) * im(:,k) + p_rate(:,k,118) = p_rate(:,k,118) * inv(:,k, 2) * im(:,k) + p_rate(:,k,119) = p_rate(:,k,119) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_prod_loss.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_prod_loss.F90 new file mode 100644 index 0000000000..4c4e8ca908 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_prod_loss.F90 @@ -0,0 +1,1420 @@ + 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,229))* y(k,229) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,230))* y(k,230) + 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,190) = (rxt(k,416)* y(k,263) + rxt(k,20) + het_rates(k,1))* y(k,1) + prod(k,190) =rxt(k,419)*y(k,232)*y(k,131) + loss(k,189) = (rxt(k,420)* y(k,263) + rxt(k,21) + het_rates(k,2))* y(k,2) + prod(k,189) =rxt(k,417)*y(k,245)*y(k,232) + loss(k,1) = ( + het_rates(k,3))* y(k,3) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,4))* y(k,4) + prod(k,2) = 0._r8 + loss(k,3) = ( + het_rates(k,5))* y(k,5) + prod(k,3) = 0._r8 + loss(k,222) = (rxt(k,499)* y(k,133) +rxt(k,500)* y(k,142) +rxt(k,501) & + * y(k,263) + het_rates(k,6))* y(k,6) + prod(k,222) = 0._r8 + loss(k,71) = (rxt(k,555)* y(k,131) +rxt(k,554)* y(k,245) + het_rates(k,7)) & + * y(k,7) + prod(k,71) =rxt(k,557)*y(k,263)*y(k,6) + loss(k,104) = (rxt(k,458)* y(k,263) + het_rates(k,8))* y(k,8) + prod(k,104) = 0._r8 + loss(k,81) = (rxt(k,560)* y(k,131) +rxt(k,559)* y(k,245) + het_rates(k,9)) & + * y(k,9) + prod(k,81) =rxt(k,558)*y(k,263)*y(k,8) + loss(k,156) = (rxt(k,461)* y(k,263) + rxt(k,22) + het_rates(k,10))* y(k,10) + prod(k,156) =rxt(k,459)*y(k,245)*y(k,233) + loss(k,105) = ( + rxt(k,23) + het_rates(k,11))* y(k,11) + prod(k,105) =.120_r8*rxt(k,458)*y(k,263)*y(k,8) + loss(k,149) = ( + rxt(k,24) + het_rates(k,12))* y(k,12) + prod(k,149) = (.100_r8*rxt(k,500)*y(k,6) +.100_r8*rxt(k,503)*y(k,116)) & + *y(k,142) + loss(k,162) = ( + rxt(k,25) + het_rates(k,13))* y(k,13) + prod(k,162) = (.500_r8*rxt(k,460)*y(k,233) +.200_r8*rxt(k,487)*y(k,270) + & + .060_r8*rxt(k,493)*y(k,272))*y(k,131) +.500_r8*rxt(k,22)*y(k,10) & + +rxt(k,23)*y(k,11) +.200_r8*rxt(k,71)*y(k,220) +.060_r8*rxt(k,73) & + *y(k,225) + loss(k,133) = ( + rxt(k,26) + het_rates(k,14))* y(k,14) + prod(k,133) = (.200_r8*rxt(k,487)*y(k,270) +.200_r8*rxt(k,493)*y(k,272)) & + *y(k,131) +.200_r8*rxt(k,71)*y(k,220) +.200_r8*rxt(k,73)*y(k,225) + loss(k,186) = ( + rxt(k,27) + het_rates(k,15))* y(k,15) + prod(k,186) = (.200_r8*rxt(k,487)*y(k,270) +.150_r8*rxt(k,493)*y(k,272)) & + *y(k,131) +rxt(k,47)*y(k,96) +rxt(k,57)*y(k,123) +.200_r8*rxt(k,71) & + *y(k,220) +.150_r8*rxt(k,73)*y(k,225) + loss(k,144) = ( + rxt(k,28) + het_rates(k,16))* y(k,16) + prod(k,144) =.210_r8*rxt(k,493)*y(k,272)*y(k,131) +.210_r8*rxt(k,73)*y(k,225) + loss(k,117) = (rxt(k,421)* y(k,263) + het_rates(k,17))* y(k,17) + prod(k,117) = (.050_r8*rxt(k,500)*y(k,6) +.050_r8*rxt(k,503)*y(k,116)) & + *y(k,142) + loss(k,147) = (rxt(k,387)* y(k,133) +rxt(k,388)* y(k,263) + het_rates(k,18)) & + * y(k,18) + prod(k,147) = 0._r8 + loss(k,254) = (rxt(k,270)* y(k,44) +rxt(k,272)* y(k,142) +rxt(k,271) & + * y(k,245) + het_rates(k,19))* y(k,19) + prod(k,254) = (rxt(k,76) +2.000_r8*rxt(k,273)*y(k,21) +rxt(k,274)*y(k,61) + & + rxt(k,275)*y(k,61) +rxt(k,278)*y(k,131) +rxt(k,281)*y(k,140) + & + rxt(k,282)*y(k,263) +rxt(k,529)*y(k,160))*y(k,21) & + + (rxt(k,260)*y(k,36) +rxt(k,286)*y(k,37) + & + 3.000_r8*rxt(k,287)*y(k,57) +2.000_r8*rxt(k,288)*y(k,80) + & + rxt(k,289)*y(k,83) +2.000_r8*rxt(k,309)*y(k,43) +rxt(k,310)*y(k,45)) & + *y(k,259) + (rxt(k,284)*y(k,83) +2.000_r8*rxt(k,298)*y(k,43) + & + rxt(k,300)*y(k,45) +3.000_r8*rxt(k,305)*y(k,57))*y(k,263) & + + (2.000_r8*rxt(k,297)*y(k,43) +rxt(k,299)*y(k,45) + & + 3.000_r8*rxt(k,304)*y(k,57))*y(k,58) + (rxt(k,100) + & + rxt(k,283)*y(k,140))*y(k,83) +rxt(k,75)*y(k,20) +rxt(k,78)*y(k,22) & + +rxt(k,80)*y(k,36) +rxt(k,81)*y(k,37) +2.000_r8*rxt(k,87)*y(k,43) & + +rxt(k,88)*y(k,45) +3.000_r8*rxt(k,91)*y(k,57) +2.000_r8*rxt(k,99) & + *y(k,80) +rxt(k,106)*y(k,93) + loss(k,118) = ( + rxt(k,75) + het_rates(k,20))* y(k,20) + prod(k,118) = (rxt(k,594)*y(k,93) +rxt(k,599)*y(k,93))*y(k,87) & + +rxt(k,276)*y(k,61)*y(k,21) + loss(k,256) = (2._r8*rxt(k,273)* y(k,21) + (rxt(k,274) +rxt(k,275) + & + rxt(k,276))* y(k,61) +rxt(k,278)* y(k,131) +rxt(k,279)* y(k,132) & + +rxt(k,281)* y(k,140) +rxt(k,529)* y(k,160) +rxt(k,277)* y(k,245) & + +rxt(k,282)* y(k,263) + rxt(k,76) + het_rates(k,21))* y(k,21) + prod(k,256) = (rxt(k,77) +rxt(k,280)*y(k,140))*y(k,22) +rxt(k,272)*y(k,142) & + *y(k,19) +rxt(k,290)*y(k,259)*y(k,83) +rxt(k,285)*y(k,140)*y(k,93) + loss(k,175) = (rxt(k,280)* y(k,140) + rxt(k,77) + rxt(k,78) + rxt(k,588) & + + rxt(k,591) + rxt(k,596) + het_rates(k,22))* y(k,22) + prod(k,175) =rxt(k,279)*y(k,132)*y(k,21) + loss(k,4) = ( + het_rates(k,23))* y(k,23) + prod(k,4) = 0._r8 + loss(k,120) = (rxt(k,462)* y(k,263) + het_rates(k,24))* y(k,24) + prod(k,120) =rxt(k,29)*y(k,25) +rxt(k,465)*y(k,234)*y(k,131) + loss(k,140) = (rxt(k,464)* y(k,263) + rxt(k,29) + het_rates(k,25))* y(k,25) + prod(k,140) =rxt(k,463)*y(k,245)*y(k,234) + loss(k,130) = (rxt(k,335)* y(k,58) +rxt(k,336)* y(k,263) + het_rates(k,26)) & + * y(k,26) + prod(k,130) = 0._r8 + loss(k,174) = (rxt(k,337)* y(k,58) +rxt(k,338)* y(k,142) +rxt(k,363) & + * y(k,263) + het_rates(k,27))* y(k,27) + prod(k,174) = 0._r8 + loss(k,128) = (rxt(k,343)* y(k,263) + het_rates(k,28))* y(k,28) + prod(k,128) = (.400_r8*rxt(k,339)*y(k,235) +.200_r8*rxt(k,340)*y(k,239)) & + *y(k,235) + loss(k,141) = (rxt(k,344)* y(k,263) + rxt(k,30) + het_rates(k,29))* y(k,29) + prod(k,141) =rxt(k,341)*y(k,245)*y(k,235) + loss(k,131) = (rxt(k,345)* y(k,58) +rxt(k,346)* y(k,263) + het_rates(k,30)) & + * y(k,30) + prod(k,131) = 0._r8 + loss(k,232) = (rxt(k,366)* y(k,133) +rxt(k,367)* y(k,142) +rxt(k,385) & + * y(k,263) + het_rates(k,31))* y(k,31) + prod(k,232) =.130_r8*rxt(k,445)*y(k,142)*y(k,100) +.700_r8*rxt(k,56)*y(k,118) + loss(k,151) = (rxt(k,371)* y(k,263) + rxt(k,31) + het_rates(k,32))* y(k,32) + prod(k,151) =rxt(k,369)*y(k,245)*y(k,236) + loss(k,132) = (rxt(k,375)* y(k,58) +rxt(k,372)* y(k,263) + het_rates(k,33)) & + * y(k,33) + prod(k,132) = 0._r8 + loss(k,129) = (rxt(k,468)* y(k,263) + rxt(k,32) + het_rates(k,34))* y(k,34) + prod(k,129) =rxt(k,466)*y(k,245)*y(k,237) + loss(k,88) = (rxt(k,259)* y(k,259) + rxt(k,79) + het_rates(k,35))* y(k,35) + prod(k,88) = 0._r8 + loss(k,98) = (rxt(k,260)* y(k,259) + rxt(k,80) + het_rates(k,36))* y(k,36) + prod(k,98) = 0._r8 + loss(k,99) = (rxt(k,286)* y(k,259) + rxt(k,81) + het_rates(k,37))* y(k,37) + prod(k,99) = 0._r8 + loss(k,92) = (rxt(k,261)* y(k,259) + rxt(k,82) + het_rates(k,38))* y(k,38) + prod(k,92) = 0._r8 + loss(k,100) = (rxt(k,262)* y(k,259) + rxt(k,83) + het_rates(k,39))* y(k,39) + prod(k,100) = 0._r8 + loss(k,93) = (rxt(k,263)* y(k,259) + rxt(k,84) + het_rates(k,40))* y(k,40) + prod(k,93) = 0._r8 + loss(k,101) = (rxt(k,264)* y(k,259) + rxt(k,85) + het_rates(k,41))* y(k,41) + prod(k,101) = 0._r8 + loss(k,94) = (rxt(k,265)* y(k,259) + rxt(k,86) + het_rates(k,42))* y(k,42) + prod(k,94) = 0._r8 + loss(k,165) = (rxt(k,297)* y(k,58) +rxt(k,309)* y(k,259) +rxt(k,298) & + * y(k,263) + rxt(k,87) + het_rates(k,43))* y(k,43) + prod(k,165) = 0._r8 + loss(k,270) = (rxt(k,270)* y(k,19) +rxt(k,234)* y(k,58) +rxt(k,315)* y(k,133) & + +rxt(k,316)* y(k,140) +rxt(k,314)* y(k,245) +rxt(k,317)* y(k,263) & + + rxt(k,33) + rxt(k,34) + het_rates(k,44))* y(k,44) + prod(k,270) = (rxt(k,241)*y(k,61) +2.000_r8*rxt(k,318)*y(k,239) + & + rxt(k,319)*y(k,239) +rxt(k,321)*y(k,131) + & + .700_r8*rxt(k,340)*y(k,235) +rxt(k,351)*y(k,238) + & + rxt(k,368)*y(k,236) +.800_r8*rxt(k,381)*y(k,267) + & + .880_r8*rxt(k,393)*y(k,249) +2.000_r8*rxt(k,402)*y(k,251) + & + 1.500_r8*rxt(k,426)*y(k,247) +.750_r8*rxt(k,431)*y(k,248) + & + .800_r8*rxt(k,440)*y(k,103) +.800_r8*rxt(k,451)*y(k,271) + & + .750_r8*rxt(k,505)*y(k,258) +.930_r8*rxt(k,510)*y(k,268) + & + .950_r8*rxt(k,515)*y(k,269))*y(k,239) & + + (.500_r8*rxt(k,357)*y(k,244) +rxt(k,379)*y(k,266) + & + rxt(k,383)*y(k,267) +.500_r8*rxt(k,389)*y(k,242) + & + .250_r8*rxt(k,396)*y(k,249) +rxt(k,405)*y(k,251) + & + .100_r8*rxt(k,418)*y(k,232) +.920_r8*rxt(k,428)*y(k,247) + & + .250_r8*rxt(k,453)*y(k,271) +.340_r8*rxt(k,512)*y(k,268) + & + .320_r8*rxt(k,517)*y(k,269))*y(k,131) + (rxt(k,322)*y(k,54) + & + .300_r8*rxt(k,323)*y(k,55) +.500_r8*rxt(k,355)*y(k,53) + & + .800_r8*rxt(k,360)*y(k,76) +rxt(k,362)*y(k,147) + & + .500_r8*rxt(k,411)*y(k,115) +.400_r8*rxt(k,416)*y(k,1) + & + .300_r8*rxt(k,436)*y(k,101) +.680_r8*rxt(k,521)*y(k,219))*y(k,263) & + + (rxt(k,338)*y(k,27) +.500_r8*rxt(k,367)*y(k,31) + & + .120_r8*rxt(k,398)*y(k,111) +.600_r8*rxt(k,412)*y(k,118) + & + .910_r8*rxt(k,445)*y(k,100) +.340_r8*rxt(k,500)*y(k,6) + & + .340_r8*rxt(k,503)*y(k,116))*y(k,142) + (.500_r8*rxt(k,387)*y(k,18) + & + .250_r8*rxt(k,395)*y(k,249) +rxt(k,406)*y(k,251) + & + rxt(k,429)*y(k,247))*y(k,133) + (.250_r8*rxt(k,392)*y(k,249) + & + rxt(k,401)*y(k,251) +rxt(k,425)*y(k,247) + & + .250_r8*rxt(k,450)*y(k,271))*y(k,238) + (.180_r8*rxt(k,40) + & + rxt(k,331)*y(k,259) +rxt(k,332)*y(k,259))*y(k,56) & + + (.150_r8*rxt(k,382)*y(k,267) +.450_r8*rxt(k,403)*y(k,251)) & + *y(k,245) +.100_r8*rxt(k,20)*y(k,1) +.100_r8*rxt(k,21)*y(k,2) & + +rxt(k,39)*y(k,55) +rxt(k,44)*y(k,76) +.330_r8*rxt(k,46)*y(k,95) & + +rxt(k,48)*y(k,97) +rxt(k,50)*y(k,106) +1.340_r8*rxt(k,51)*y(k,111) & + +rxt(k,58)*y(k,134) +rxt(k,63)*y(k,156) +rxt(k,64)*y(k,157) & + +.375_r8*rxt(k,66)*y(k,215) +.400_r8*rxt(k,68)*y(k,217) & + +.680_r8*rxt(k,70)*y(k,219) +2.000_r8*rxt(k,358)*y(k,243) & + +rxt(k,328)*y(k,246) +2.000_r8*rxt(k,404)*y(k,251)*y(k,251) + loss(k,180) = (rxt(k,299)* y(k,58) +rxt(k,310)* y(k,259) +rxt(k,300) & + * y(k,263) + rxt(k,88) + het_rates(k,45))* y(k,45) + prod(k,180) = 0._r8 + loss(k,95) = (rxt(k,301)* y(k,263) + rxt(k,89) + het_rates(k,46))* y(k,46) + prod(k,95) = 0._r8 + loss(k,233) = (rxt(k,347)* y(k,133) +rxt(k,348)* y(k,263) + rxt(k,35) & + + het_rates(k,47))* y(k,47) + prod(k,233) = (rxt(k,342)*y(k,235) +.270_r8*rxt(k,370)*y(k,236) + & + rxt(k,379)*y(k,266) +rxt(k,389)*y(k,242) +rxt(k,408)*y(k,253) + & + .400_r8*rxt(k,418)*y(k,232))*y(k,131) + (rxt(k,343)*y(k,28) + & + .500_r8*rxt(k,344)*y(k,29) +.800_r8*rxt(k,416)*y(k,1))*y(k,263) & + + (.500_r8*rxt(k,367)*y(k,31) +.100_r8*rxt(k,412)*y(k,118))*y(k,142) & + + (1.600_r8*rxt(k,339)*y(k,235) +.800_r8*rxt(k,340)*y(k,239)) & + *y(k,235) +.400_r8*rxt(k,20)*y(k,1) +.400_r8*rxt(k,21)*y(k,2) & + +rxt(k,387)*y(k,133)*y(k,18) +rxt(k,30)*y(k,29) +.330_r8*rxt(k,46) & + *y(k,95) +rxt(k,54)*y(k,114) +rxt(k,63)*y(k,156) & + +.200_r8*rxt(k,407)*y(k,253)*y(k,245) + loss(k,146) = (rxt(k,302)* y(k,58) +rxt(k,303)* y(k,263) + rxt(k,90) & + + het_rates(k,48))* y(k,48) + prod(k,146) = 0._r8 + loss(k,89) = (rxt(k,349)* y(k,263) + het_rates(k,49))* y(k,49) + prod(k,89) = 0._r8 + loss(k,227) = (rxt(k,386)* y(k,263) + rxt(k,36) + het_rates(k,50))* y(k,50) + prod(k,227) = (.820_r8*rxt(k,370)*y(k,236) +.500_r8*rxt(k,389)*y(k,242) + & + .250_r8*rxt(k,418)*y(k,232) +.270_r8*rxt(k,512)*y(k,268) + & + .040_r8*rxt(k,517)*y(k,269))*y(k,131) & + + (.820_r8*rxt(k,368)*y(k,236) +.150_r8*rxt(k,510)*y(k,268) + & + .025_r8*rxt(k,515)*y(k,269))*y(k,239) + (.250_r8*rxt(k,20) + & + .800_r8*rxt(k,416)*y(k,263))*y(k,1) + (.520_r8*rxt(k,500)*y(k,6) + & + .520_r8*rxt(k,503)*y(k,116))*y(k,142) + (.500_r8*rxt(k,70) + & + .500_r8*rxt(k,521)*y(k,263))*y(k,219) +.250_r8*rxt(k,21)*y(k,2) & + +.500_r8*rxt(k,387)*y(k,133)*y(k,18) +.820_r8*rxt(k,31)*y(k,32) & + +.170_r8*rxt(k,46)*y(k,95) +.300_r8*rxt(k,66)*y(k,215) & + +.050_r8*rxt(k,68)*y(k,217) + loss(k,243) = (rxt(k,373)* y(k,133) +rxt(k,374)* y(k,263) + rxt(k,37) & + + het_rates(k,51))* y(k,51) + prod(k,243) = (.250_r8*rxt(k,396)*y(k,249) +.050_r8*rxt(k,434)*y(k,248) + & + .250_r8*rxt(k,453)*y(k,271) +.170_r8*rxt(k,471)*y(k,240) + & + .170_r8*rxt(k,477)*y(k,252) +.400_r8*rxt(k,487)*y(k,270) + & + .540_r8*rxt(k,493)*y(k,272) +.510_r8*rxt(k,496)*y(k,273))*y(k,131) & + + (.250_r8*rxt(k,395)*y(k,249) +.050_r8*rxt(k,435)*y(k,248) + & + .250_r8*rxt(k,454)*y(k,271))*y(k,133) & + + (.500_r8*rxt(k,381)*y(k,267) +.240_r8*rxt(k,393)*y(k,249) + & + .100_r8*rxt(k,451)*y(k,271))*y(k,239) & + + (.880_r8*rxt(k,398)*y(k,111) +.500_r8*rxt(k,412)*y(k,118)) & + *y(k,142) + (.250_r8*rxt(k,392)*y(k,249) + & + .250_r8*rxt(k,450)*y(k,271))*y(k,238) & + + (.070_r8*rxt(k,470)*y(k,240) +.070_r8*rxt(k,476)*y(k,252)) & + *y(k,245) + (rxt(k,376)*y(k,97) +rxt(k,377)*y(k,134))*y(k,263) & + +.180_r8*rxt(k,24)*y(k,12) +rxt(k,28)*y(k,16) +.400_r8*rxt(k,71) & + *y(k,220) +.540_r8*rxt(k,73)*y(k,225) +.510_r8*rxt(k,74)*y(k,228) + loss(k,194) = (rxt(k,354)* y(k,263) + het_rates(k,52))* y(k,52) + prod(k,194) = (.100_r8*rxt(k,351)*y(k,239) +.150_r8*rxt(k,352)*y(k,245)) & + *y(k,238) +.120_r8*rxt(k,367)*y(k,142)*y(k,31) & + +.150_r8*rxt(k,403)*y(k,251)*y(k,245) + loss(k,181) = (rxt(k,355)* y(k,263) + rxt(k,38) + het_rates(k,53))* y(k,53) + prod(k,181) = (.400_r8*rxt(k,352)*y(k,238) +.400_r8*rxt(k,403)*y(k,251)) & + *y(k,245) + loss(k,205) = (rxt(k,322)* y(k,263) + het_rates(k,54))* y(k,54) + prod(k,205) = (rxt(k,319)*y(k,239) +.300_r8*rxt(k,340)*y(k,235) + & + .500_r8*rxt(k,381)*y(k,267) +.250_r8*rxt(k,393)*y(k,249) + & + .250_r8*rxt(k,426)*y(k,247) +.250_r8*rxt(k,431)*y(k,248) + & + .200_r8*rxt(k,440)*y(k,103) +.300_r8*rxt(k,451)*y(k,271) + & + .250_r8*rxt(k,505)*y(k,258) +.250_r8*rxt(k,510)*y(k,268) + & + .250_r8*rxt(k,515)*y(k,269))*y(k,239) + loss(k,152) = (rxt(k,323)* y(k,263) + rxt(k,39) + het_rates(k,55))* y(k,55) + prod(k,152) =rxt(k,320)*y(k,245)*y(k,239) + loss(k,257) = (rxt(k,235)* y(k,58) +rxt(k,291)* y(k,75) + (rxt(k,330) + & + rxt(k,331) +rxt(k,332))* y(k,259) +rxt(k,324)* y(k,263) + rxt(k,40) & + + rxt(k,41) + het_rates(k,56))* y(k,56) + prod(k,257) =.100_r8*rxt(k,367)*y(k,142)*y(k,31) + loss(k,153) = (rxt(k,304)* y(k,58) +rxt(k,287)* y(k,259) +rxt(k,305) & + * y(k,263) + rxt(k,91) + het_rates(k,57))* y(k,57) + prod(k,153) = 0._r8 + loss(k,263) = (rxt(k,345)* y(k,30) +rxt(k,375)* y(k,33) +rxt(k,297)* y(k,43) & + +rxt(k,234)* y(k,44) +rxt(k,299)* y(k,45) +rxt(k,302)* y(k,48) & + +rxt(k,235)* y(k,56) +rxt(k,304)* y(k,57) +rxt(k,247)* y(k,62) & + +rxt(k,236)* y(k,79) +rxt(k,237)* y(k,81) +rxt(k,256)* y(k,94) & + +rxt(k,240)* y(k,142) + (rxt(k,238) +rxt(k,239))* y(k,245) & + + het_rates(k,58))* y(k,58) + prod(k,263) = (4.000_r8*rxt(k,259)*y(k,35) +rxt(k,260)*y(k,36) + & + 2.000_r8*rxt(k,261)*y(k,38) +2.000_r8*rxt(k,262)*y(k,39) + & + 2.000_r8*rxt(k,263)*y(k,40) +rxt(k,264)*y(k,41) + & + 2.000_r8*rxt(k,265)*y(k,42) +rxt(k,266)*y(k,87) +rxt(k,296)*y(k,67) + & + rxt(k,311)*y(k,84) +rxt(k,312)*y(k,85) +rxt(k,313)*y(k,86))*y(k,259) & + + (rxt(k,94) +rxt(k,241)*y(k,239) +2.000_r8*rxt(k,242)*y(k,61) + & + rxt(k,244)*y(k,61) +rxt(k,246)*y(k,131) +rxt(k,251)*y(k,140) + & + rxt(k,252)*y(k,263) +rxt(k,275)*y(k,21) +rxt(k,530)*y(k,160))*y(k,61) & + + (rxt(k,255)*y(k,87) +3.000_r8*rxt(k,301)*y(k,46) + & + rxt(k,303)*y(k,48) +rxt(k,306)*y(k,84) +rxt(k,307)*y(k,85) + & + rxt(k,308)*y(k,86))*y(k,263) + (rxt(k,104) +rxt(k,254)*y(k,140)) & + *y(k,87) +rxt(k,75)*y(k,20) +4.000_r8*rxt(k,79)*y(k,35) +rxt(k,80) & + *y(k,36) +2.000_r8*rxt(k,82)*y(k,38) +2.000_r8*rxt(k,83)*y(k,39) & + +2.000_r8*rxt(k,84)*y(k,40) +rxt(k,85)*y(k,41) +2.000_r8*rxt(k,86) & + *y(k,42) +3.000_r8*rxt(k,89)*y(k,46) +rxt(k,90)*y(k,48) & + +2.000_r8*rxt(k,92)*y(k,59) +2.000_r8*rxt(k,93)*y(k,60) +rxt(k,95) & + *y(k,62) +rxt(k,98)*y(k,67) +rxt(k,101)*y(k,84) +rxt(k,102)*y(k,85) & + +rxt(k,103)*y(k,86) +rxt(k,107)*y(k,94) + loss(k,107) = ( + rxt(k,92) + het_rates(k,59))* y(k,59) + prod(k,107) = (rxt(k,587)*y(k,94) +rxt(k,592)*y(k,62) +rxt(k,593)*y(k,94) + & + rxt(k,597)*y(k,62) +rxt(k,598)*y(k,94) +rxt(k,602)*y(k,62))*y(k,87) & + +rxt(k,247)*y(k,62)*y(k,58) +rxt(k,243)*y(k,61)*y(k,61) + loss(k,90) = ( + rxt(k,93) + rxt(k,269) + het_rates(k,60))* y(k,60) + prod(k,90) =rxt(k,268)*y(k,61)*y(k,61) + loss(k,266) = ((rxt(k,274) +rxt(k,275) +rxt(k,276))* y(k,21) & + + 2._r8*(rxt(k,242) +rxt(k,243) +rxt(k,244) +rxt(k,268))* y(k,61) & + +rxt(k,246)* y(k,131) +rxt(k,248)* y(k,132) +rxt(k,251)* y(k,140) & + +rxt(k,530)* y(k,160) +rxt(k,241)* y(k,239) +rxt(k,245)* y(k,245) & + + (rxt(k,252) +rxt(k,253))* y(k,263) + rxt(k,94) + het_rates(k,61)) & + * y(k,61) + prod(k,266) = (rxt(k,239)*y(k,245) +rxt(k,240)*y(k,142) +rxt(k,256)*y(k,94)) & + *y(k,58) + (rxt(k,96) +rxt(k,249)*y(k,140))*y(k,62) & + + (rxt(k,257)*y(k,140) +rxt(k,258)*y(k,263))*y(k,94) + (rxt(k,108) + & + rxt(k,535)*y(k,160))*y(k,144) +2.000_r8*rxt(k,269)*y(k,60) & + +rxt(k,267)*y(k,259)*y(k,87) + loss(k,228) = (rxt(k,247)* y(k,58) + (rxt(k,592) +rxt(k,597) +rxt(k,602)) & + * y(k,87) +rxt(k,249)* y(k,140) +rxt(k,250)* y(k,263) + rxt(k,95) & + + rxt(k,96) + rxt(k,590) + rxt(k,595) + rxt(k,601) & + + het_rates(k,62))* y(k,62) + prod(k,228) =rxt(k,248)*y(k,132)*y(k,61) + loss(k,5) = ( + het_rates(k,63))* y(k,63) + prod(k,5) = 0._r8 + loss(k,234) = (rxt(k,334)* y(k,263) + het_rates(k,64))* y(k,64) + prod(k,234) = (rxt(k,33) +rxt(k,34) +rxt(k,234)*y(k,58) +rxt(k,270)*y(k,19) + & + rxt(k,315)*y(k,133) +rxt(k,316)*y(k,140) +rxt(k,317)*y(k,263)) & + *y(k,44) + (.630_r8*rxt(k,338)*y(k,27) +.560_r8*rxt(k,367)*y(k,31) + & + .650_r8*rxt(k,398)*y(k,111) +.560_r8*rxt(k,412)*y(k,118) + & + .620_r8*rxt(k,445)*y(k,100) +.230_r8*rxt(k,500)*y(k,6) + & + .230_r8*rxt(k,503)*y(k,116))*y(k,142) & + + (.220_r8*rxt(k,396)*y(k,249) +.250_r8*rxt(k,453)*y(k,271) + & + .170_r8*rxt(k,471)*y(k,240) +.400_r8*rxt(k,474)*y(k,250) + & + .350_r8*rxt(k,477)*y(k,252) +.225_r8*rxt(k,512)*y(k,268))*y(k,131) & + + (.350_r8*rxt(k,336)*y(k,26) +rxt(k,361)*y(k,77) + & + rxt(k,374)*y(k,51) +.700_r8*rxt(k,521)*y(k,219) +rxt(k,525)*y(k,145)) & + *y(k,263) + (rxt(k,42) +rxt(k,110) +rxt(k,615)*y(k,264))*y(k,65) & + + (rxt(k,373)*y(k,51) +.220_r8*rxt(k,395)*y(k,249) + & + .500_r8*rxt(k,454)*y(k,271))*y(k,133) & + + (.110_r8*rxt(k,393)*y(k,249) +.200_r8*rxt(k,451)*y(k,271) + & + .125_r8*rxt(k,510)*y(k,268))*y(k,239) & + + (.070_r8*rxt(k,470)*y(k,240) +.160_r8*rxt(k,473)*y(k,250) + & + .140_r8*rxt(k,476)*y(k,252))*y(k,245) + (rxt(k,137) + & + rxt(k,524)*y(k,140))*y(k,145) + (.220_r8*rxt(k,392)*y(k,249) + & + .250_r8*rxt(k,450)*y(k,271))*y(k,238) +1.500_r8*rxt(k,23)*y(k,11) & + +.450_r8*rxt(k,24)*y(k,12) +.600_r8*rxt(k,27)*y(k,15) +rxt(k,28) & + *y(k,16) +rxt(k,35)*y(k,47) +rxt(k,302)*y(k,58)*y(k,48) +rxt(k,37) & + *y(k,51) +.380_r8*rxt(k,40)*y(k,56) +rxt(k,44)*y(k,76) & + +2.000_r8*rxt(k,45)*y(k,77) +.330_r8*rxt(k,46)*y(k,95) & + +1.340_r8*rxt(k,52)*y(k,111) +.700_r8*rxt(k,56)*y(k,118) & + +1.500_r8*rxt(k,65)*y(k,214) +.250_r8*rxt(k,66)*y(k,215) +rxt(k,69) & + *y(k,218) +1.700_r8*rxt(k,70)*y(k,219) + loss(k,250) = (rxt(k,615)* y(k,264) + rxt(k,42) + rxt(k,110) & + + het_rates(k,65))* y(k,65) + prod(k,250) = (rxt(k,326)*y(k,89) +rxt(k,334)*y(k,64) +rxt(k,354)*y(k,52) + & + .500_r8*rxt(k,355)*y(k,53) +.800_r8*rxt(k,360)*y(k,76) + & + rxt(k,361)*y(k,77) +.500_r8*rxt(k,411)*y(k,115) + & + 1.800_r8*rxt(k,521)*y(k,219))*y(k,263) & + + (2.000_r8*rxt(k,350)*y(k,238) +.900_r8*rxt(k,351)*y(k,239) + & + rxt(k,353)*y(k,131) +2.000_r8*rxt(k,401)*y(k,251) + & + rxt(k,425)*y(k,247) +rxt(k,450)*y(k,271))*y(k,238) & + + (.200_r8*rxt(k,367)*y(k,31) +.100_r8*rxt(k,412)*y(k,118) + & + .270_r8*rxt(k,500)*y(k,6) +.270_r8*rxt(k,503)*y(k,116))*y(k,142) & + + (rxt(k,402)*y(k,239) +.450_r8*rxt(k,403)*y(k,245) + & + 2.000_r8*rxt(k,404)*y(k,251))*y(k,251) & + + (.500_r8*rxt(k,510)*y(k,239) +.900_r8*rxt(k,512)*y(k,131)) & + *y(k,268) +rxt(k,38)*y(k,53) +.440_r8*rxt(k,40)*y(k,56) & + +.400_r8*rxt(k,61)*y(k,147) +rxt(k,66)*y(k,215) +.800_r8*rxt(k,70) & + *y(k,219) + loss(k,122) = (rxt(k,295)* y(k,259) + rxt(k,97) + het_rates(k,66))* y(k,66) + prod(k,122) = (rxt(k,260)*y(k,36) +rxt(k,262)*y(k,39) + & + 2.000_r8*rxt(k,263)*y(k,40) +2.000_r8*rxt(k,264)*y(k,41) + & + rxt(k,265)*y(k,42) +rxt(k,286)*y(k,37) +2.000_r8*rxt(k,288)*y(k,80) + & + rxt(k,312)*y(k,85) +rxt(k,313)*y(k,86))*y(k,259) + (rxt(k,102) + & + rxt(k,307)*y(k,263))*y(k,85) + (rxt(k,103) +rxt(k,308)*y(k,263)) & + *y(k,86) +rxt(k,80)*y(k,36) +rxt(k,81)*y(k,37) +rxt(k,83)*y(k,39) & + +2.000_r8*rxt(k,84)*y(k,40) +2.000_r8*rxt(k,85)*y(k,41) +rxt(k,86) & + *y(k,42) +2.000_r8*rxt(k,99)*y(k,80) + loss(k,124) = (rxt(k,296)* y(k,259) + rxt(k,98) + het_rates(k,67))* y(k,67) + prod(k,124) = (rxt(k,101) +rxt(k,306)*y(k,263) +rxt(k,311)*y(k,259))*y(k,84) & + + (rxt(k,82) +rxt(k,261)*y(k,259))*y(k,38) + (rxt(k,83) + & + rxt(k,262)*y(k,259))*y(k,39) + loss(k,112) = (rxt(k,469)* y(k,263) + het_rates(k,68))* y(k,68) + prod(k,112) =.180_r8*rxt(k,489)*y(k,263)*y(k,221) + loss(k,136) = (rxt(k,522)* y(k,133) + (rxt(k,523) +rxt(k,537))* y(k,263) & + + het_rates(k,69))* y(k,69) + prod(k,136) = 0._r8 + loss(k,6) = ( + het_rates(k,70))* y(k,70) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,71))* y(k,71) + prod(k,7) = 0._r8 + loss(k,8) = ( + het_rates(k,72))* y(k,72) + prod(k,8) = 0._r8 + loss(k,9) = ( + rxt(k,618) + het_rates(k,73))* y(k,73) + prod(k,9) = 0._r8 + loss(k,102) = ( + rxt(k,43) + het_rates(k,74))* y(k,74) + prod(k,102) =rxt(k,356)*y(k,245)*y(k,244) + loss(k,214) = (rxt(k,291)* y(k,56) +rxt(k,292)* y(k,79) +rxt(k,294)* y(k,91) & + +rxt(k,293)* y(k,274) + het_rates(k,75))* y(k,75) + prod(k,214) = (rxt(k,264)*y(k,41) +rxt(k,286)*y(k,37) + & + 2.000_r8*rxt(k,295)*y(k,66) +rxt(k,296)*y(k,67))*y(k,259) +rxt(k,81) & + *y(k,37) +rxt(k,85)*y(k,41) +2.000_r8*rxt(k,97)*y(k,66) +rxt(k,98) & + *y(k,67) +rxt(k,105)*y(k,90) + loss(k,235) = (rxt(k,360)* y(k,263) + rxt(k,44) + het_rates(k,76))* y(k,76) + prod(k,235) = (.530_r8*rxt(k,396)*y(k,249) +.050_r8*rxt(k,434)*y(k,248) + & + .250_r8*rxt(k,453)*y(k,271) +.225_r8*rxt(k,512)*y(k,268))*y(k,131) & + + (.530_r8*rxt(k,395)*y(k,249) +.050_r8*rxt(k,435)*y(k,248) + & + .250_r8*rxt(k,454)*y(k,271))*y(k,133) & + + (.260_r8*rxt(k,393)*y(k,249) +.100_r8*rxt(k,451)*y(k,271) + & + .125_r8*rxt(k,510)*y(k,268))*y(k,239) & + + (.700_r8*rxt(k,436)*y(k,101) +.500_r8*rxt(k,437)*y(k,102) + & + rxt(k,448)*y(k,122))*y(k,263) + (.530_r8*rxt(k,392)*y(k,249) + & + .250_r8*rxt(k,450)*y(k,271))*y(k,238) +.330_r8*rxt(k,46)*y(k,95) & + +rxt(k,359)*y(k,243)*y(k,141) +.250_r8*rxt(k,66)*y(k,215) + loss(k,224) = (rxt(k,361)* y(k,263) + rxt(k,45) + rxt(k,582) & + + het_rates(k,77))* y(k,77) + prod(k,224) = (.050_r8*rxt(k,434)*y(k,248) +.250_r8*rxt(k,453)*y(k,271) + & + rxt(k,460)*y(k,233) +.400_r8*rxt(k,474)*y(k,250) + & + .170_r8*rxt(k,477)*y(k,252) +.700_r8*rxt(k,480)*y(k,265) + & + .600_r8*rxt(k,487)*y(k,270) +.340_r8*rxt(k,493)*y(k,272) + & + .170_r8*rxt(k,496)*y(k,273))*y(k,131) + (.650_r8*rxt(k,336)*y(k,26) + & + .200_r8*rxt(k,360)*y(k,76) +rxt(k,449)*y(k,123))*y(k,263) & + + (.250_r8*rxt(k,450)*y(k,238) +.100_r8*rxt(k,451)*y(k,239) + & + .250_r8*rxt(k,454)*y(k,133))*y(k,271) & + + (.160_r8*rxt(k,473)*y(k,250) +.070_r8*rxt(k,476)*y(k,252)) & + *y(k,245) +rxt(k,22)*y(k,10) +.130_r8*rxt(k,24)*y(k,12) & + +.050_r8*rxt(k,435)*y(k,248)*y(k,133) +.700_r8*rxt(k,62)*y(k,151) & + +.600_r8*rxt(k,71)*y(k,220) +.340_r8*rxt(k,73)*y(k,225) & + +.170_r8*rxt(k,74)*y(k,228) + loss(k,260) = (rxt(k,195)* y(k,141) +rxt(k,198)* y(k,142) + (rxt(k,192) + & + rxt(k,193) +rxt(k,194))* y(k,245) + het_rates(k,78))* y(k,78) + prod(k,260) = (rxt(k,199)*y(k,79) +rxt(k,202)*y(k,140) +rxt(k,222)*y(k,119) + & + rxt(k,317)*y(k,44) +rxt(k,525)*y(k,145) +rxt(k,531)*y(k,158) + & + rxt(k,536)*y(k,160))*y(k,263) + (rxt(k,173)*y(k,259) + & + rxt(k,190)*y(k,140) +rxt(k,236)*y(k,58) +rxt(k,292)*y(k,75))*y(k,79) & + + (.330_r8*rxt(k,40) +rxt(k,41) +rxt(k,331)*y(k,259))*y(k,56) & + + (rxt(k,100) +rxt(k,290)*y(k,259))*y(k,83) + (rxt(k,104) + & + rxt(k,267)*y(k,259))*y(k,87) + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,274) & + +2.000_r8*rxt(k,34)*y(k,44) +rxt(k,39)*y(k,55) +rxt(k,105)*y(k,90) + loss(k,251) = (rxt(k,236)* y(k,58) +rxt(k,292)* y(k,75) +rxt(k,190)* y(k,140) & + +rxt(k,173)* y(k,259) +rxt(k,199)* y(k,263) + het_rates(k,79)) & + * y(k,79) + prod(k,251) = (1.440_r8*rxt(k,40) +rxt(k,332)*y(k,259))*y(k,56) +rxt(k,33) & + *y(k,44) +rxt(k,192)*y(k,245)*y(k,78) +rxt(k,1)*y(k,274) + loss(k,91) = (rxt(k,288)* y(k,259) + rxt(k,99) + het_rates(k,80))* y(k,80) + prod(k,91) = 0._r8 + loss(k,185) = (rxt(k,237)* y(k,58) +rxt(k,191)* y(k,140) +rxt(k,200) & + * y(k,263) + rxt(k,4) + het_rates(k,81))* y(k,81) + prod(k,185) =rxt(k,206)*y(k,245)*y(k,245) +rxt(k,205)*y(k,263)*y(k,263) + loss(k,103) = ( + rxt(k,136) + het_rates(k,82))* y(k,82) + prod(k,103) =rxt(k,538)*y(k,274)*y(k,162) + loss(k,207) = (rxt(k,283)* y(k,140) + (rxt(k,289) +rxt(k,290))* y(k,259) & + +rxt(k,284)* y(k,263) + rxt(k,100) + het_rates(k,83))* y(k,83) + prod(k,207) = (rxt(k,270)*y(k,44) +rxt(k,271)*y(k,245))*y(k,19) + loss(k,123) = (rxt(k,311)* y(k,259) +rxt(k,306)* y(k,263) + rxt(k,101) & + + het_rates(k,84))* y(k,84) + prod(k,123) = 0._r8 + loss(k,125) = (rxt(k,312)* y(k,259) +rxt(k,307)* y(k,263) + rxt(k,102) & + + het_rates(k,85))* y(k,85) + prod(k,125) = 0._r8 + loss(k,137) = (rxt(k,313)* y(k,259) +rxt(k,308)* y(k,263) + rxt(k,103) & + + het_rates(k,86))* y(k,86) + prod(k,137) = 0._r8 + loss(k,253) = ((rxt(k,592) +rxt(k,597) +rxt(k,602))* y(k,62) + (rxt(k,594) + & + rxt(k,599))* y(k,93) + (rxt(k,587) +rxt(k,593) +rxt(k,598))* y(k,94) & + +rxt(k,254)* y(k,140) + (rxt(k,266) +rxt(k,267))* y(k,259) & + +rxt(k,255)* y(k,263) + rxt(k,104) + het_rates(k,87))* y(k,87) + prod(k,253) = (rxt(k,234)*y(k,44) +rxt(k,235)*y(k,56) +rxt(k,236)*y(k,79) + & + rxt(k,237)*y(k,81) +rxt(k,238)*y(k,245) +rxt(k,256)*y(k,94) + & + rxt(k,297)*y(k,43) +rxt(k,299)*y(k,45) +2.000_r8*rxt(k,302)*y(k,48) + & + rxt(k,304)*y(k,57) +rxt(k,345)*y(k,30) +rxt(k,375)*y(k,33))*y(k,58) & + +rxt(k,253)*y(k,263)*y(k,61) + loss(k,110) = (rxt(k,333)* y(k,259) +rxt(k,325)* y(k,263) + het_rates(k,88)) & + * y(k,88) + prod(k,110) = 0._r8 + loss(k,216) = (rxt(k,326)* y(k,263) + het_rates(k,89))* y(k,89) + prod(k,216) = (.370_r8*rxt(k,338)*y(k,27) +.120_r8*rxt(k,367)*y(k,31) + & + .330_r8*rxt(k,398)*y(k,111) +.120_r8*rxt(k,412)*y(k,118) + & + .110_r8*rxt(k,445)*y(k,100) +.050_r8*rxt(k,500)*y(k,6) + & + .050_r8*rxt(k,503)*y(k,116))*y(k,142) + (rxt(k,327)*y(k,245) + & + rxt(k,329)*y(k,131))*y(k,246) +.350_r8*rxt(k,336)*y(k,263)*y(k,26) + loss(k,135) = ( + rxt(k,105) + het_rates(k,90))* y(k,90) + prod(k,135) = (rxt(k,291)*y(k,56) +rxt(k,292)*y(k,79) +rxt(k,293)*y(k,274) + & + rxt(k,294)*y(k,91))*y(k,75) + loss(k,259) = (rxt(k,294)* y(k,75) +rxt(k,231)* y(k,263) + rxt(k,9) & + + het_rates(k,91))* y(k,91) + prod(k,259) = (rxt(k,590) +rxt(k,595) +rxt(k,601) +rxt(k,592)*y(k,87) + & + rxt(k,597)*y(k,87) +rxt(k,602)*y(k,87))*y(k,62) + (rxt(k,549) + & + rxt(k,315)*y(k,44) +rxt(k,347)*y(k,47) +rxt(k,373)*y(k,51) + & + rxt(k,522)*y(k,69))*y(k,133) + (2.000_r8*rxt(k,544) + & + 2.000_r8*rxt(k,586) +2.000_r8*rxt(k,589) +2.000_r8*rxt(k,600)) & + *y(k,121) + (rxt(k,588) +rxt(k,591) +rxt(k,596))*y(k,22) & + + (.500_r8*rxt(k,548) +rxt(k,230)*y(k,263))*y(k,132) +rxt(k,541) & + *y(k,95) +rxt(k,542)*y(k,101) +rxt(k,543)*y(k,102) +rxt(k,545) & + *y(k,122) +rxt(k,546)*y(k,123) +rxt(k,550)*y(k,135) +rxt(k,551) & + *y(k,146) +rxt(k,552)*y(k,216) + loss(k,164) = (rxt(k,207)* y(k,263) + rxt(k,10) + rxt(k,11) + rxt(k,232) & + + het_rates(k,92))* y(k,92) + prod(k,164) =rxt(k,228)*y(k,245)*y(k,132) + loss(k,202) = ((rxt(k,594) +rxt(k,599))* y(k,87) +rxt(k,285)* y(k,140) & + + rxt(k,106) + het_rates(k,93))* y(k,93) + prod(k,202) = (rxt(k,588) +rxt(k,591) +rxt(k,596))*y(k,22) & + +rxt(k,277)*y(k,245)*y(k,21) + loss(k,208) = (rxt(k,256)* y(k,58) + (rxt(k,587) +rxt(k,593) +rxt(k,598)) & + * y(k,87) +rxt(k,257)* y(k,140) +rxt(k,258)* y(k,263) + rxt(k,107) & + + het_rates(k,94))* y(k,94) + prod(k,208) = (rxt(k,590) +rxt(k,595) +rxt(k,601) +rxt(k,250)*y(k,263)) & + *y(k,62) +rxt(k,245)*y(k,245)*y(k,61) + loss(k,237) = (rxt(k,391)* y(k,263) + rxt(k,46) + rxt(k,541) & + + het_rates(k,95))* y(k,95) + prod(k,237) = (rxt(k,390)*y(k,242) +rxt(k,397)*y(k,249))*y(k,131) & + + (.300_r8*rxt(k,436)*y(k,101) +.500_r8*rxt(k,437)*y(k,102)) & + *y(k,263) + loss(k,121) = (rxt(k,422)* y(k,263) + rxt(k,47) + het_rates(k,96))* y(k,96) + prod(k,121) =rxt(k,433)*y(k,248) + loss(k,238) = (rxt(k,376)* y(k,263) + rxt(k,48) + het_rates(k,97))* y(k,97) + prod(k,238) = (.220_r8*rxt(k,392)*y(k,238) +.230_r8*rxt(k,393)*y(k,239) + & + .220_r8*rxt(k,395)*y(k,133) +.220_r8*rxt(k,396)*y(k,131))*y(k,249) & + + (.500_r8*rxt(k,380)*y(k,156) +.500_r8*rxt(k,411)*y(k,115) + & + .700_r8*rxt(k,436)*y(k,101) +.500_r8*rxt(k,437)*y(k,102))*y(k,263) & + + (.250_r8*rxt(k,450)*y(k,238) +.100_r8*rxt(k,451)*y(k,239) + & + .250_r8*rxt(k,453)*y(k,131) +.250_r8*rxt(k,454)*y(k,133))*y(k,271) & + + (.050_r8*rxt(k,434)*y(k,131) +.050_r8*rxt(k,435)*y(k,133)) & + *y(k,248) +.170_r8*rxt(k,46)*y(k,95) +.200_r8*rxt(k,381)*y(k,267) & + *y(k,239) + loss(k,142) = (rxt(k,423)* y(k,263) + het_rates(k,98))* y(k,98) + prod(k,142) = (rxt(k,430)*y(k,238) +.750_r8*rxt(k,431)*y(k,239) + & + .870_r8*rxt(k,434)*y(k,131) +.950_r8*rxt(k,435)*y(k,133))*y(k,248) + loss(k,96) = (rxt(k,424)* y(k,263) + het_rates(k,99))* y(k,99) + prod(k,96) =.600_r8*rxt(k,447)*y(k,263)*y(k,106) + loss(k,213) = (rxt(k,438)* y(k,133) +rxt(k,445)* y(k,142) +rxt(k,446) & + * y(k,263) + het_rates(k,100))* y(k,100) + prod(k,213) = 0._r8 + loss(k,182) = (rxt(k,436)* y(k,263) + rxt(k,542) + het_rates(k,101)) & + * y(k,101) + prod(k,182) =.080_r8*rxt(k,428)*y(k,247)*y(k,131) + loss(k,178) = (rxt(k,437)* y(k,263) + rxt(k,543) + het_rates(k,102)) & + * y(k,102) + prod(k,178) =.080_r8*rxt(k,434)*y(k,248)*y(k,131) + loss(k,241) = (rxt(k,442)* y(k,131) +rxt(k,443)* y(k,133) +rxt(k,439) & + * y(k,238) +rxt(k,440)* y(k,239) +rxt(k,441)* y(k,245) & + + het_rates(k,103))* y(k,103) + prod(k,241) =rxt(k,438)*y(k,133)*y(k,100) + loss(k,157) = (rxt(k,444)* y(k,263) + rxt(k,49) + het_rates(k,104))* y(k,104) + prod(k,157) =rxt(k,441)*y(k,245)*y(k,103) + loss(k,72) = (rxt(k,563)* y(k,131) +rxt(k,562)* y(k,245) + het_rates(k,105)) & + * y(k,105) + prod(k,72) =rxt(k,565)*y(k,263)*y(k,100) + loss(k,195) = (rxt(k,447)* y(k,263) + rxt(k,50) + het_rates(k,106))* y(k,106) + prod(k,195) = (rxt(k,427)*y(k,247) +rxt(k,432)*y(k,248))*y(k,245) +rxt(k,49) & + *y(k,104) + loss(k,65) = (rxt(k,568)* y(k,263) + het_rates(k,107))* y(k,107) + prod(k,65) = 0._r8 + loss(k,64) = (rxt(k,567)* y(k,131) +rxt(k,566)* y(k,245) + het_rates(k,108)) & + * y(k,108) + prod(k,64) =rxt(k,568)*y(k,263)*y(k,107) + loss(k,80) = (rxt(k,571)* y(k,263) + het_rates(k,109))* y(k,109) + prod(k,80) = 0._r8 + loss(k,79) = (rxt(k,570)* y(k,131) +rxt(k,569)* y(k,245) + het_rates(k,110)) & + * y(k,110) + prod(k,79) =rxt(k,571)*y(k,263)*y(k,109) + loss(k,242) = (rxt(k,398)* y(k,142) +rxt(k,399)* y(k,263) + rxt(k,51) & + + rxt(k,52) + het_rates(k,111))* y(k,111) + prod(k,242) = (.390_r8*rxt(k,425)*y(k,238) +.310_r8*rxt(k,426)*y(k,239) + & + .360_r8*rxt(k,428)*y(k,131) +.400_r8*rxt(k,429)*y(k,133))*y(k,247) & + +.300_r8*rxt(k,445)*y(k,142)*y(k,100) +.300_r8*rxt(k,50)*y(k,106) + loss(k,143) = (rxt(k,400)* y(k,263) + het_rates(k,112))* y(k,112) + prod(k,143) =rxt(k,394)*y(k,249)*y(k,245) + loss(k,171) = (rxt(k,409)* y(k,263) + rxt(k,53) + het_rates(k,113))* y(k,113) + prod(k,171) =.800_r8*rxt(k,20)*y(k,1) +.800_r8*rxt(k,21)*y(k,2) & + +.800_r8*rxt(k,418)*y(k,232)*y(k,131) + loss(k,145) = (rxt(k,410)* y(k,263) + rxt(k,54) + het_rates(k,114))* y(k,114) + prod(k,145) =.800_r8*rxt(k,407)*y(k,253)*y(k,245) + loss(k,184) = (rxt(k,411)* y(k,263) + rxt(k,55) + rxt(k,415) & + + het_rates(k,115))* y(k,115) + prod(k,184) =rxt(k,414)*y(k,251)*y(k,132) + loss(k,221) = (rxt(k,502)* y(k,133) +rxt(k,503)* y(k,142) +rxt(k,504) & + * y(k,263) + het_rates(k,116))* y(k,116) + prod(k,221) = 0._r8 + loss(k,73) = (rxt(k,574)* y(k,131) +rxt(k,573)* y(k,245) + het_rates(k,117)) & + * y(k,117) + prod(k,73) =rxt(k,576)*y(k,263)*y(k,116) + loss(k,247) = (rxt(k,412)* y(k,142) +rxt(k,413)* y(k,263) + rxt(k,56) & + + het_rates(k,118))* y(k,118) + prod(k,247) = (.610_r8*rxt(k,425)*y(k,238) +.440_r8*rxt(k,426)*y(k,239) + & + .560_r8*rxt(k,428)*y(k,131) +.600_r8*rxt(k,429)*y(k,133))*y(k,247) & + +.200_r8*rxt(k,445)*y(k,142)*y(k,100) +.700_r8*rxt(k,50)*y(k,106) + loss(k,220) = (rxt(k,210)* y(k,131) + (rxt(k,211) +rxt(k,212) +rxt(k,213)) & + * y(k,132) +rxt(k,214)* y(k,141) +rxt(k,612)* y(k,262) +rxt(k,222) & + * y(k,263) + rxt(k,111) + het_rates(k,119))* y(k,119) + prod(k,220) = (rxt(k,208)*y(k,254) +rxt(k,609)*y(k,257))*y(k,140) & + + (.200_r8*rxt(k,603)*y(k,256) +1.100_r8*rxt(k,605)*y(k,255)) & + *y(k,241) +rxt(k,15)*y(k,131) +rxt(k,610)*y(k,257)*y(k,141) & + +rxt(k,616)*y(k,264) + loss(k,126) = ((rxt(k,226) +rxt(k,227))* y(k,259) + rxt(k,12) & + + het_rates(k,120))* y(k,120) + prod(k,126) =rxt(k,211)*y(k,132)*y(k,119) + loss(k,134) = ( + rxt(k,13) + rxt(k,14) + rxt(k,233) + rxt(k,544) & + + rxt(k,586) + rxt(k,589) + rxt(k,600) + het_rates(k,121))* y(k,121) + prod(k,134) =rxt(k,229)*y(k,133)*y(k,132) + loss(k,155) = (rxt(k,448)* y(k,263) + rxt(k,545) + het_rates(k,122)) & + * y(k,122) + prod(k,155) =.200_r8*rxt(k,440)*y(k,239)*y(k,103) + loss(k,231) = (rxt(k,449)* y(k,263) + rxt(k,57) + rxt(k,546) & + + het_rates(k,123))* y(k,123) + prod(k,231) = (rxt(k,439)*y(k,238) +.800_r8*rxt(k,440)*y(k,239) + & + rxt(k,442)*y(k,131) +rxt(k,443)*y(k,133))*y(k,103) + loss(k,10) = ( + het_rates(k,124))* y(k,124) + prod(k,10) = 0._r8 + loss(k,11) = ( + het_rates(k,125))* y(k,125) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,126))* y(k,126) + prod(k,12) = 0._r8 + loss(k,87) = (rxt(k,539)* y(k,263) + het_rates(k,127))* y(k,127) + prod(k,87) = 0._r8 + loss(k,13) = ( + rxt(k,547) + het_rates(k,128))* y(k,128) + prod(k,13) = 0._r8 + loss(k,14) = ( + rxt(k,620) + het_rates(k,129))* y(k,129) + prod(k,14) = 0._r8 + loss(k,15) = ( + rxt(k,619) + het_rates(k,130))* y(k,130) + prod(k,15) = 0._r8 + loss(k,267) = (rxt(k,278)* y(k,21) +rxt(k,246)* y(k,61) +rxt(k,442)* y(k,103) & + +rxt(k,210)* y(k,119) +rxt(k,219)* y(k,133) +rxt(k,225)* y(k,140) & + +rxt(k,224)* y(k,142) +rxt(k,457)* y(k,231) + (rxt(k,418) + & + rxt(k,419))* y(k,232) +rxt(k,460)* y(k,233) +rxt(k,465)* y(k,234) & + +rxt(k,342)* y(k,235) +rxt(k,370)* y(k,236) +rxt(k,467)* y(k,237) & + +rxt(k,353)* y(k,238) +rxt(k,321)* y(k,239) +rxt(k,471)* y(k,240) & + + (rxt(k,389) +rxt(k,390))* y(k,242) +rxt(k,357)* y(k,244) & + +rxt(k,223)* y(k,245) +rxt(k,329)* y(k,246) +rxt(k,428)* y(k,247) & + +rxt(k,434)* y(k,248) + (rxt(k,396) +rxt(k,397))* y(k,249) & + +rxt(k,474)* y(k,250) +rxt(k,405)* y(k,251) +rxt(k,477)* y(k,252) & + +rxt(k,408)* y(k,253) +rxt(k,507)* y(k,258) +rxt(k,614)* y(k,262) & + +rxt(k,480)* y(k,265) +rxt(k,379)* y(k,266) +rxt(k,383)* y(k,267) & + +rxt(k,512)* y(k,268) +rxt(k,517)* y(k,269) +rxt(k,487)* y(k,270) & + +rxt(k,453)* y(k,271) +rxt(k,493)* y(k,272) +rxt(k,496)* y(k,273) & + + rxt(k,15) + rxt(k,16) + het_rates(k,131))* y(k,131) + prod(k,267) = (rxt(k,17) +.500_r8*rxt(k,548) +2.000_r8*rxt(k,212)*y(k,119) + & + rxt(k,215)*y(k,140) +rxt(k,532)*y(k,160))*y(k,132) & + + (rxt(k,214)*y(k,141) +rxt(k,222)*y(k,263))*y(k,119) & + +2.000_r8*rxt(k,226)*y(k,259)*y(k,120) +rxt(k,14)*y(k,121) & + +rxt(k,19)*y(k,133) +rxt(k,209)*y(k,254)*y(k,141) +rxt(k,613) & + *y(k,262) + loss(k,271) = (rxt(k,279)* y(k,21) +rxt(k,248)* y(k,61) + (rxt(k,211) + & + rxt(k,212) +rxt(k,213))* y(k,119) +rxt(k,229)* y(k,133) & + + (rxt(k,215) +rxt(k,217))* y(k,140) +rxt(k,216)* y(k,142) & + +rxt(k,482)* y(k,149) +rxt(k,532)* y(k,160) +rxt(k,485)* y(k,231) & + +rxt(k,364)* y(k,238) +rxt(k,472)* y(k,240) +rxt(k,228)* y(k,245) & + +rxt(k,475)* y(k,250) +rxt(k,414)* y(k,251) +rxt(k,478)* y(k,252) & + +rxt(k,230)* y(k,263) + rxt(k,17) + rxt(k,548) + het_rates(k,132)) & + * y(k,132) + prod(k,271) = (2.000_r8*rxt(k,219)*y(k,133) +rxt(k,223)*y(k,245) + & + rxt(k,224)*y(k,142) +rxt(k,225)*y(k,140) +rxt(k,246)*y(k,61) + & + rxt(k,278)*y(k,21) +rxt(k,321)*y(k,239) +rxt(k,329)*y(k,246) + & + rxt(k,342)*y(k,235) +rxt(k,353)*y(k,238) +rxt(k,357)*y(k,244) + & + rxt(k,370)*y(k,236) +rxt(k,379)*y(k,266) +rxt(k,383)*y(k,267) + & + rxt(k,389)*y(k,242) +rxt(k,396)*y(k,249) +rxt(k,405)*y(k,251) + & + rxt(k,408)*y(k,253) +rxt(k,418)*y(k,232) + & + .920_r8*rxt(k,428)*y(k,247) +.920_r8*rxt(k,434)*y(k,248) + & + rxt(k,442)*y(k,103) +rxt(k,453)*y(k,271) +rxt(k,457)*y(k,231) + & + rxt(k,460)*y(k,233) +rxt(k,465)*y(k,234) +rxt(k,467)*y(k,237) + & + rxt(k,471)*y(k,240) +rxt(k,474)*y(k,250) +rxt(k,477)*y(k,252) + & + rxt(k,480)*y(k,265) +rxt(k,487)*y(k,270) +rxt(k,493)*y(k,272) + & + rxt(k,496)*y(k,273) +1.600_r8*rxt(k,507)*y(k,258) + & + .900_r8*rxt(k,512)*y(k,268) +.800_r8*rxt(k,517)*y(k,269))*y(k,131) & + + (rxt(k,18) +rxt(k,218)*y(k,245) +rxt(k,220)*y(k,140) + & + rxt(k,221)*y(k,263) +rxt(k,387)*y(k,18) +rxt(k,395)*y(k,249) + & + rxt(k,406)*y(k,251) +rxt(k,429)*y(k,247) +rxt(k,435)*y(k,248) + & + rxt(k,443)*y(k,103) +rxt(k,454)*y(k,271) + & + 2.000_r8*rxt(k,508)*y(k,258))*y(k,133) + (rxt(k,207)*y(k,92) + & + rxt(k,377)*y(k,134) +rxt(k,416)*y(k,1) +.700_r8*rxt(k,436)*y(k,101) + & + rxt(k,514)*y(k,216))*y(k,263) + (rxt(k,11) +rxt(k,232))*y(k,92) & + + (rxt(k,55) +rxt(k,415))*y(k,115) + (rxt(k,13) +rxt(k,233)) & + *y(k,121) + (.600_r8*rxt(k,61) +rxt(k,365))*y(k,147) +rxt(k,20) & + *y(k,1) +rxt(k,77)*y(k,22) +rxt(k,96)*y(k,62) +rxt(k,9)*y(k,91) & + +rxt(k,46)*y(k,95) +rxt(k,49)*y(k,104) +rxt(k,57)*y(k,123) & + +rxt(k,58)*y(k,134) +rxt(k,59)*y(k,135) +rxt(k,60)*y(k,146) & + +rxt(k,490)*y(k,148) +rxt(k,67)*y(k,216) & + +.500_r8*rxt(k,505)*y(k,258)*y(k,239) + loss(k,268) = (rxt(k,499)* y(k,6) +rxt(k,387)* y(k,18) +rxt(k,366)* y(k,31) & + +rxt(k,315)* y(k,44) +rxt(k,347)* y(k,47) +rxt(k,373)* y(k,51) & + +rxt(k,522)* y(k,69) +rxt(k,438)* y(k,100) +rxt(k,443)* y(k,103) & + +rxt(k,502)* y(k,116) +rxt(k,219)* y(k,131) +rxt(k,229)* y(k,132) & + +rxt(k,220)* y(k,140) +rxt(k,519)* y(k,218) +rxt(k,218)* y(k,245) & + +rxt(k,429)* y(k,247) +rxt(k,435)* y(k,248) +rxt(k,395)* y(k,249) & + +rxt(k,406)* y(k,251) +rxt(k,508)* y(k,258) +rxt(k,221)* y(k,263) & + +rxt(k,454)* y(k,271) + rxt(k,18) + rxt(k,19) + rxt(k,549) & + + het_rates(k,133))* y(k,133) + prod(k,268) = (rxt(k,95) +rxt(k,247)*y(k,58) +rxt(k,249)*y(k,140) + & + rxt(k,250)*y(k,263))*y(k,62) + (rxt(k,13) +rxt(k,14) +rxt(k,233)) & + *y(k,121) + (rxt(k,231)*y(k,91) +rxt(k,362)*y(k,147) + & + .500_r8*rxt(k,411)*y(k,115))*y(k,263) + (rxt(k,78) + & + rxt(k,280)*y(k,140))*y(k,22) + (rxt(k,216)*y(k,142) + & + rxt(k,217)*y(k,140))*y(k,132) +rxt(k,294)*y(k,91)*y(k,75) +rxt(k,10) & + *y(k,92) +.400_r8*rxt(k,61)*y(k,147) + loss(k,212) = (rxt(k,377)* y(k,263) + rxt(k,58) + het_rates(k,134))* y(k,134) + prod(k,212) = (.500_r8*rxt(k,437)*y(k,102) +rxt(k,444)*y(k,104) + & + rxt(k,448)*y(k,122) +rxt(k,449)*y(k,123))*y(k,263) & + +rxt(k,366)*y(k,133)*y(k,31) + loss(k,154) = (rxt(k,509)* y(k,263) + rxt(k,59) + rxt(k,550) & + + het_rates(k,135))* y(k,135) + prod(k,154) =rxt(k,506)*y(k,258)*y(k,245) + loss(k,16) = ( + het_rates(k,136))* y(k,136) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,137))* y(k,137) + prod(k,17) = 0._r8 + loss(k,18) = ( + het_rates(k,138))* y(k,138) + prod(k,18) = 0._r8 + loss(k,19) = ( + het_rates(k,139))* y(k,139) + prod(k,19) = 0._r8 + loss(k,262) = (rxt(k,281)* y(k,21) +rxt(k,280)* y(k,22) +rxt(k,316)* y(k,44) & + +rxt(k,251)* y(k,61) +rxt(k,249)* y(k,62) +rxt(k,190)* y(k,79) & + +rxt(k,191)* y(k,81) +rxt(k,283)* y(k,83) +rxt(k,254)* y(k,87) & + +rxt(k,285)* y(k,93) +rxt(k,257)* y(k,94) +rxt(k,225)* y(k,131) & + + (rxt(k,215) +rxt(k,217))* y(k,132) +rxt(k,220)* y(k,133) & + + 2._r8*rxt(k,188)* y(k,140) +rxt(k,189)* y(k,141) +rxt(k,187) & + * y(k,142) +rxt(k,524)* y(k,145) +rxt(k,196)* y(k,245) & + + (rxt(k,607) +rxt(k,608))* y(k,255) +rxt(k,609)* y(k,257) & + +rxt(k,202)* y(k,263) + rxt(k,120) + rxt(k,121) + rxt(k,122) & + + rxt(k,123) + rxt(k,124) + rxt(k,125) + het_rates(k,140))* y(k,140) + prod(k,262) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,127) +rxt(k,128) + & + rxt(k,129) +rxt(k,131) +rxt(k,132) +rxt(k,133) +2.000_r8*rxt(k,134) + & + 2.000_r8*rxt(k,135) +rxt(k,176)*y(k,259) +rxt(k,177)*y(k,259) + & + rxt(k,214)*y(k,119) +rxt(k,526)*y(k,158) +rxt(k,533)*y(k,160) + & + rxt(k,611)*y(k,257) +rxt(k,617)*y(k,264))*y(k,141) & + + (rxt(k,210)*y(k,131) +rxt(k,211)*y(k,132) +rxt(k,612)*y(k,262)) & + *y(k,119) + (rxt(k,42) +rxt(k,110))*y(k,65) + (rxt(k,603)*y(k,256) + & + 1.150_r8*rxt(k,604)*y(k,262))*y(k,241) +rxt(k,76)*y(k,21) & + +.180_r8*rxt(k,40)*y(k,56) +rxt(k,94)*y(k,61) +rxt(k,194)*y(k,245) & + *y(k,78) +rxt(k,14)*y(k,121) +rxt(k,15)*y(k,131) +rxt(k,17)*y(k,132) & + +rxt(k,18)*y(k,133) +rxt(k,8)*y(k,142) +rxt(k,108)*y(k,144) & + +rxt(k,138)*y(k,160) +rxt(k,139)*y(k,161) +rxt(k,140)*y(k,162) & + +rxt(k,175)*y(k,259) +rxt(k,204)*y(k,263)*y(k,263) +rxt(k,2) & + *y(k,274) + loss(k,255) = (rxt(k,195)* y(k,78) +rxt(k,214)* y(k,119) +rxt(k,189) & + * y(k,140) +rxt(k,526)* y(k,158) +rxt(k,533)* y(k,160) +rxt(k,359) & + * y(k,243) +rxt(k,209)* y(k,254) +rxt(k,606)* y(k,255) & + + (rxt(k,610) +rxt(k,611))* y(k,257) +rxt(k,176)* y(k,259) & + +rxt(k,181)* y(k,260) +rxt(k,617)* y(k,264) + rxt(k,5) + rxt(k,6) & + + rxt(k,126) + rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,130) & + + rxt(k,131) + rxt(k,132) + rxt(k,133) + rxt(k,134) + rxt(k,135) & + + het_rates(k,141))* y(k,141) + prod(k,255) = (rxt(k,192)*y(k,78) +rxt(k,196)*y(k,140) + & + 2.000_r8*rxt(k,197)*y(k,142) +rxt(k,201)*y(k,263) + & + rxt(k,206)*y(k,245) +rxt(k,218)*y(k,133) +rxt(k,238)*y(k,58) + & + rxt(k,245)*y(k,61) +rxt(k,271)*y(k,19) +rxt(k,277)*y(k,21) + & + rxt(k,320)*y(k,239) +rxt(k,341)*y(k,235) +rxt(k,369)*y(k,236) + & + rxt(k,378)*y(k,266))*y(k,245) + (rxt(k,8) + & + 2.000_r8*rxt(k,178)*y(k,259) +2.000_r8*rxt(k,187)*y(k,140) + & + rxt(k,198)*y(k,78) +rxt(k,203)*y(k,263) +rxt(k,216)*y(k,132) + & + rxt(k,224)*y(k,131) +rxt(k,240)*y(k,58) +rxt(k,272)*y(k,19) + & + rxt(k,528)*y(k,158) +rxt(k,534)*y(k,160))*y(k,142) & + + (rxt(k,180)*y(k,260) +rxt(k,188)*y(k,140) +rxt(k,202)*y(k,263) + & + rxt(k,215)*y(k,132) +rxt(k,220)*y(k,133) +rxt(k,251)*y(k,61) + & + rxt(k,281)*y(k,21))*y(k,140) + (rxt(k,242)*y(k,61) + & + rxt(k,243)*y(k,61) +rxt(k,253)*y(k,263) +rxt(k,275)*y(k,21) + & + rxt(k,276)*y(k,21))*y(k,61) + (rxt(k,171) +rxt(k,179) + & + 2.000_r8*rxt(k,181)*y(k,141))*y(k,260) +rxt(k,273)*y(k,21)*y(k,21) & + +rxt(k,207)*y(k,263)*y(k,92) +rxt(k,213)*y(k,132)*y(k,119) & + +rxt(k,227)*y(k,259)*y(k,120) +rxt(k,614)*y(k,262)*y(k,131) & + +rxt(k,19)*y(k,133) +rxt(k,172)*y(k,261) + loss(k,265) = (rxt(k,500)* y(k,6) +rxt(k,272)* y(k,19) +rxt(k,338)* y(k,27) & + +rxt(k,367)* y(k,31) +rxt(k,240)* y(k,58) +rxt(k,198)* y(k,78) & + +rxt(k,445)* y(k,100) +rxt(k,398)* y(k,111) +rxt(k,503)* y(k,116) & + +rxt(k,412)* y(k,118) +rxt(k,224)* y(k,131) +rxt(k,216)* y(k,132) & + +rxt(k,187)* y(k,140) +rxt(k,483)* y(k,149) +rxt(k,528)* y(k,158) & + +rxt(k,534)* y(k,160) +rxt(k,197)* y(k,245) +rxt(k,178)* y(k,259) & + +rxt(k,203)* y(k,263) + rxt(k,7) + rxt(k,8) + het_rates(k,142)) & + * y(k,142) + prod(k,265) = (.150_r8*rxt(k,352)*y(k,238) +.150_r8*rxt(k,403)*y(k,251)) & + *y(k,245) +rxt(k,189)*y(k,141)*y(k,140) + loss(k,20) = ( + het_rates(k,143))* y(k,143) + prod(k,20) = 0._r8 + loss(k,138) = (rxt(k,535)* y(k,160) + rxt(k,108) + het_rates(k,144)) & + * y(k,144) + prod(k,138) = (rxt(k,244)*y(k,61) +rxt(k,274)*y(k,21))*y(k,61) + loss(k,148) = (rxt(k,524)* y(k,140) +rxt(k,525)* y(k,263) + rxt(k,137) & + + het_rates(k,145))* y(k,145) + prod(k,148) = 0._r8 + loss(k,119) = ( + rxt(k,60) + rxt(k,551) + het_rates(k,146))* y(k,146) + prod(k,119) =rxt(k,391)*y(k,263)*y(k,95) +.100_r8*rxt(k,512)*y(k,268) & + *y(k,131) + loss(k,177) = (rxt(k,362)* y(k,263) + rxt(k,61) + rxt(k,365) & + + het_rates(k,147))* y(k,147) + prod(k,177) =rxt(k,364)*y(k,238)*y(k,132) + loss(k,97) = ( + rxt(k,490) + het_rates(k,148))* y(k,148) + prod(k,97) =rxt(k,485)*y(k,231)*y(k,132) + loss(k,166) = (rxt(k,482)* y(k,132) +rxt(k,483)* y(k,142) + het_rates(k,149)) & + * y(k,149) + prod(k,166) = (.070_r8*rxt(k,469)*y(k,68) +.060_r8*rxt(k,481)*y(k,150) + & + .070_r8*rxt(k,497)*y(k,227))*y(k,263) +rxt(k,32)*y(k,34) & + +rxt(k,467)*y(k,237)*y(k,131) + loss(k,106) = (rxt(k,481)* y(k,263) + het_rates(k,150))* y(k,150) + prod(k,106) =.530_r8*rxt(k,458)*y(k,263)*y(k,8) + loss(k,139) = (rxt(k,484)* y(k,263) + rxt(k,62) + het_rates(k,151))* y(k,151) + prod(k,139) =rxt(k,479)*y(k,265)*y(k,245) + loss(k,21) = ( + het_rates(k,152))* y(k,152) + prod(k,21) = 0._r8 + loss(k,22) = ( + het_rates(k,153))* y(k,153) + prod(k,22) = 0._r8 + loss(k,23) = ( + het_rates(k,154))* y(k,154) + prod(k,23) = 0._r8 + loss(k,24) = ( + het_rates(k,155))* y(k,155) + prod(k,24) = 0._r8 + loss(k,176) = (rxt(k,380)* y(k,263) + rxt(k,63) + het_rates(k,156))* y(k,156) + prod(k,176) =rxt(k,378)*y(k,266)*y(k,245) + loss(k,150) = (rxt(k,384)* y(k,263) + rxt(k,64) + het_rates(k,157))* y(k,157) + prod(k,150) =.850_r8*rxt(k,382)*y(k,267)*y(k,245) + loss(k,197) = (rxt(k,526)* y(k,141) +rxt(k,528)* y(k,142) +rxt(k,531) & + * y(k,263) + het_rates(k,158))* y(k,158) + prod(k,197) =rxt(k,137)*y(k,145) +rxt(k,138)*y(k,160) + loss(k,25) = ( + rxt(k,109) + het_rates(k,159))* y(k,159) + prod(k,25) = 0._r8 + loss(k,252) = (rxt(k,529)* y(k,21) +rxt(k,530)* y(k,61) +rxt(k,532)* y(k,132) & + +rxt(k,533)* y(k,141) +rxt(k,534)* y(k,142) +rxt(k,535)* y(k,144) & + +rxt(k,536)* y(k,263) + rxt(k,138) + het_rates(k,160))* y(k,160) + prod(k,252) = (rxt(k,526)*y(k,141) +rxt(k,528)*y(k,142) +rxt(k,531)*y(k,263)) & + *y(k,158) +rxt(k,524)*y(k,145)*y(k,140) +rxt(k,139)*y(k,161) + loss(k,219) = (rxt(k,527)* y(k,263) + rxt(k,139) + het_rates(k,161)) & + * y(k,161) + prod(k,219) = (rxt(k,529)*y(k,21) +rxt(k,530)*y(k,61) +rxt(k,532)*y(k,132) + & + rxt(k,533)*y(k,141) +rxt(k,534)*y(k,142) +rxt(k,535)*y(k,144) + & + rxt(k,536)*y(k,263))*y(k,160) + (rxt(k,522)*y(k,133) + & + rxt(k,523)*y(k,263) +.500_r8*rxt(k,537)*y(k,263))*y(k,69) & + +rxt(k,525)*y(k,263)*y(k,145) +rxt(k,140)*y(k,162) + loss(k,127) = (rxt(k,538)* y(k,274) + rxt(k,140) + het_rates(k,162)) & + * y(k,162) + prod(k,127) =rxt(k,136)*y(k,82) +rxt(k,527)*y(k,263)*y(k,161) + loss(k,26) = ( + het_rates(k,163))* y(k,163) + prod(k,26) = 0._r8 + loss(k,27) = ( + het_rates(k,164))* y(k,164) + prod(k,27) = 0._r8 + loss(k,28) = ( + het_rates(k,165))* y(k,165) + prod(k,28) = 0._r8 + loss(k,29) = ( + rxt(k,141) + het_rates(k,166))* y(k,166) + prod(k,29) = 0._r8 + loss(k,30) = ( + rxt(k,142) + het_rates(k,167))* y(k,167) + prod(k,30) = 0._r8 + loss(k,31) = ( + rxt(k,143) + het_rates(k,168))* y(k,168) + prod(k,31) = 0._r8 + loss(k,32) = ( + rxt(k,144) + het_rates(k,169))* y(k,169) + prod(k,32) = 0._r8 + loss(k,33) = ( + rxt(k,145) + het_rates(k,170))* y(k,170) + prod(k,33) = 0._r8 + loss(k,34) = ( + rxt(k,146) + het_rates(k,171))* y(k,171) + prod(k,34) = 0._r8 + loss(k,35) = ( + rxt(k,147) + het_rates(k,172))* y(k,172) + prod(k,35) = 0._r8 + loss(k,36) = ( + rxt(k,148) + het_rates(k,173))* y(k,173) + prod(k,36) = 0._r8 + loss(k,37) = ( + rxt(k,149) + het_rates(k,174))* y(k,174) + prod(k,37) = 0._r8 + loss(k,38) = ( + rxt(k,150) + het_rates(k,175))* y(k,175) + prod(k,38) = 0._r8 + loss(k,39) = ( + rxt(k,151) + het_rates(k,176))* y(k,176) + prod(k,39) = 0._r8 + loss(k,40) = ( + rxt(k,152) + het_rates(k,177))* y(k,177) + prod(k,40) = 0._r8 + loss(k,41) = ( + rxt(k,153) + het_rates(k,178))* y(k,178) + prod(k,41) = 0._r8 + loss(k,42) = ( + rxt(k,154) + het_rates(k,179))* y(k,179) + prod(k,42) = 0._r8 + loss(k,43) = ( + rxt(k,155) + het_rates(k,180))* y(k,180) + prod(k,43) = 0._r8 + loss(k,44) = ( + rxt(k,156) + het_rates(k,181))* y(k,181) + prod(k,44) = 0._r8 + loss(k,45) = ( + rxt(k,157) + het_rates(k,182))* y(k,182) + prod(k,45) = 0._r8 + loss(k,46) = ( + rxt(k,158) + het_rates(k,183))* y(k,183) + prod(k,46) = 0._r8 + loss(k,47) = ( + rxt(k,159) + het_rates(k,184))* y(k,184) + prod(k,47) = 0._r8 + loss(k,48) = ( + rxt(k,160) + het_rates(k,185))* y(k,185) + prod(k,48) = 0._r8 + loss(k,49) = ( + rxt(k,161) + het_rates(k,186))* y(k,186) + prod(k,49) = 0._r8 + loss(k,50) = ( + rxt(k,162) + het_rates(k,187))* y(k,187) + prod(k,50) = 0._r8 + loss(k,51) = ( + rxt(k,163) + het_rates(k,188))* y(k,188) + prod(k,51) = 0._r8 + loss(k,52) = ( + rxt(k,164) + het_rates(k,189))* y(k,189) + prod(k,52) = 0._r8 + loss(k,53) = ( + rxt(k,165) + het_rates(k,190))* y(k,190) + prod(k,53) = 0._r8 + loss(k,54) = ( + rxt(k,166) + het_rates(k,191))* y(k,191) + prod(k,54) = 0._r8 + loss(k,55) = ( + rxt(k,167) + het_rates(k,192))* y(k,192) + prod(k,55) = 0._r8 + loss(k,56) = ( + rxt(k,168) + het_rates(k,193))* y(k,193) + prod(k,56) = 0._r8 + loss(k,57) = ( + rxt(k,169) + het_rates(k,194))* y(k,194) + prod(k,57) = 0._r8 + loss(k,58) = ( + rxt(k,170) + het_rates(k,195))* y(k,195) + prod(k,58) = 0._r8 + loss(k,59) = ( + het_rates(k,196))* y(k,196) + prod(k,59) = (.2381005_r8*rxt(k,566)*y(k,245) + & + .1056005_r8*rxt(k,567)*y(k,131))*y(k,108) & + +.5931005_r8*rxt(k,577)*y(k,263)*y(k,212) + loss(k,60) = ( + het_rates(k,197))* y(k,197) + prod(k,60) = (.1308005_r8*rxt(k,566)*y(k,245) + & + .1026005_r8*rxt(k,567)*y(k,131))*y(k,108) & + +.1534005_r8*rxt(k,577)*y(k,263)*y(k,212) + loss(k,61) = ( + het_rates(k,198))* y(k,198) + prod(k,61) = (.0348005_r8*rxt(k,566)*y(k,245) + & + .0521005_r8*rxt(k,567)*y(k,131))*y(k,108) & + +.0459005_r8*rxt(k,577)*y(k,263)*y(k,212) + loss(k,62) = ( + het_rates(k,199))* y(k,199) + prod(k,62) = (.0076005_r8*rxt(k,566)*y(k,245) + & + .0143005_r8*rxt(k,567)*y(k,131))*y(k,108) & + +.0085005_r8*rxt(k,577)*y(k,263)*y(k,212) + loss(k,63) = ( + het_rates(k,200))* y(k,200) + prod(k,63) = (.0113005_r8*rxt(k,566)*y(k,245) + & + .0166005_r8*rxt(k,567)*y(k,131))*y(k,108) & + +.0128005_r8*rxt(k,577)*y(k,263)*y(k,212) + loss(k,66) = ( + het_rates(k,201))* y(k,201) + prod(k,66) = (.1279005_r8*rxt(k,555)*y(k,7) + & + .0003005_r8*rxt(k,563)*y(k,105) +.0245005_r8*rxt(k,574)*y(k,117)) & + *y(k,131) + (.2202005_r8*rxt(k,554)*y(k,7) + & + .0031005_r8*rxt(k,562)*y(k,105) +.0508005_r8*rxt(k,573)*y(k,117)) & + *y(k,245) + (.2202005_r8*rxt(k,556)*y(k,6) + & + .0508005_r8*rxt(k,575)*y(k,116))*y(k,142) +rxt(k,582)*y(k,77) + loss(k,67) = ( + het_rates(k,202))* y(k,202) + prod(k,67) = (.1792005_r8*rxt(k,555)*y(k,7) + & + .0003005_r8*rxt(k,563)*y(k,105) +.0082005_r8*rxt(k,574)*y(k,117)) & + *y(k,131) + (.2067005_r8*rxt(k,554)*y(k,7) + & + .0035005_r8*rxt(k,562)*y(k,105) +.1149005_r8*rxt(k,573)*y(k,117)) & + *y(k,245) + (.2067005_r8*rxt(k,556)*y(k,6) + & + .1149005_r8*rxt(k,575)*y(k,116))*y(k,142) + loss(k,68) = ( + het_rates(k,203))* y(k,203) + prod(k,68) = (.0676005_r8*rxt(k,555)*y(k,7) + & + .0073005_r8*rxt(k,563)*y(k,105) +.0772005_r8*rxt(k,574)*y(k,117)) & + *y(k,131) + (.0653005_r8*rxt(k,554)*y(k,7) + & + .0003005_r8*rxt(k,562)*y(k,105) +.0348005_r8*rxt(k,573)*y(k,117)) & + *y(k,245) + (.0653005_r8*rxt(k,556)*y(k,6) + & + .0348005_r8*rxt(k,575)*y(k,116))*y(k,142) + loss(k,69) = ( + het_rates(k,204))* y(k,204) + prod(k,69) = (.079_r8*rxt(k,555)*y(k,7) +.0057005_r8*rxt(k,563)*y(k,105) + & + .0332005_r8*rxt(k,574)*y(k,117))*y(k,131) & + + (.1749305_r8*rxt(k,553)*y(k,6) +.0590245_r8*rxt(k,561)*y(k,100) + & + .1749305_r8*rxt(k,572)*y(k,116))*y(k,133) & + + (.1284005_r8*rxt(k,556)*y(k,6) +.0033005_r8*rxt(k,564)*y(k,100) + & + .0554005_r8*rxt(k,575)*y(k,116))*y(k,142) & + + (.1284005_r8*rxt(k,554)*y(k,7) +.0271005_r8*rxt(k,562)*y(k,105) + & + .0554005_r8*rxt(k,573)*y(k,117))*y(k,245) + loss(k,70) = ( + het_rates(k,205))* y(k,205) + prod(k,70) = (.1254005_r8*rxt(k,555)*y(k,7) + & + .0623005_r8*rxt(k,563)*y(k,105) +.130_r8*rxt(k,574)*y(k,117)) & + *y(k,131) + (.5901905_r8*rxt(k,553)*y(k,6) + & + .0250245_r8*rxt(k,561)*y(k,100) +.5901905_r8*rxt(k,572)*y(k,116)) & + *y(k,133) + (.114_r8*rxt(k,554)*y(k,7) + & + .0474005_r8*rxt(k,562)*y(k,105) +.1278005_r8*rxt(k,573)*y(k,117)) & + *y(k,245) + (.114_r8*rxt(k,556)*y(k,6) + & + .1278005_r8*rxt(k,575)*y(k,116))*y(k,142) + loss(k,74) = ( + het_rates(k,206))* y(k,206) + prod(k,74) = (.0097005_r8*rxt(k,560)*y(k,9) + & + .1056005_r8*rxt(k,570)*y(k,110) +.0154005_r8*rxt(k,581)*y(k,222) + & + .0063005_r8*rxt(k,585)*y(k,226))*y(k,131) & + + (.0023005_r8*rxt(k,559)*y(k,9) +.2381005_r8*rxt(k,569)*y(k,110) + & + .1364005_r8*rxt(k,580)*y(k,222) +.1677005_r8*rxt(k,584)*y(k,226)) & + *y(k,245) +.5931005_r8*rxt(k,578)*y(k,263)*y(k,213) + loss(k,75) = ( + het_rates(k,207))* y(k,207) + prod(k,75) = (.0034005_r8*rxt(k,560)*y(k,9) + & + .1026005_r8*rxt(k,570)*y(k,110) +.0452005_r8*rxt(k,581)*y(k,222) + & + .0237005_r8*rxt(k,585)*y(k,226))*y(k,131) & + + (.0008005_r8*rxt(k,559)*y(k,9) +.1308005_r8*rxt(k,569)*y(k,110) + & + .0101005_r8*rxt(k,580)*y(k,222) +.0174005_r8*rxt(k,584)*y(k,226)) & + *y(k,245) +.1534005_r8*rxt(k,578)*y(k,263)*y(k,213) + loss(k,76) = ( + het_rates(k,208))* y(k,208) + prod(k,76) = (.1579005_r8*rxt(k,560)*y(k,9) + & + .0521005_r8*rxt(k,570)*y(k,110) +.0966005_r8*rxt(k,581)*y(k,222) + & + .0025005_r8*rxt(k,585)*y(k,226))*y(k,131) & + + (.0843005_r8*rxt(k,559)*y(k,9) +.0348005_r8*rxt(k,569)*y(k,110) + & + .0763005_r8*rxt(k,580)*y(k,222) +.086_r8*rxt(k,584)*y(k,226)) & + *y(k,245) +.0459005_r8*rxt(k,578)*y(k,263)*y(k,213) + loss(k,77) = ( + het_rates(k,209))* y(k,209) + prod(k,77) = (.0059005_r8*rxt(k,560)*y(k,9) + & + .0143005_r8*rxt(k,570)*y(k,110) +.0073005_r8*rxt(k,581)*y(k,222) + & + .011_r8*rxt(k,585)*y(k,226))*y(k,131) & + + (.0443005_r8*rxt(k,559)*y(k,9) +.0076005_r8*rxt(k,569)*y(k,110) + & + .2157005_r8*rxt(k,580)*y(k,222) +.0512005_r8*rxt(k,584)*y(k,226)) & + *y(k,245) +.0085005_r8*rxt(k,578)*y(k,263)*y(k,213) + loss(k,78) = ( + het_rates(k,210))* y(k,210) + prod(k,78) = (.0536005_r8*rxt(k,560)*y(k,9) + & + .0166005_r8*rxt(k,570)*y(k,110) +.238_r8*rxt(k,581)*y(k,222) + & + .1185005_r8*rxt(k,585)*y(k,226))*y(k,131) & + + (.1621005_r8*rxt(k,559)*y(k,9) +.0113005_r8*rxt(k,569)*y(k,110) + & + .0738005_r8*rxt(k,580)*y(k,222) +.1598005_r8*rxt(k,584)*y(k,226)) & + *y(k,245) +.0128005_r8*rxt(k,578)*y(k,263)*y(k,213) + loss(k,82) = ( + rxt(k,621) + het_rates(k,211))* y(k,211) + prod(k,82) = 0._r8 + loss(k,83) = (rxt(k,577)* y(k,263) + het_rates(k,212))* y(k,212) + prod(k,83) = 0._r8 + loss(k,84) = (rxt(k,578)* y(k,263) + het_rates(k,213))* y(k,213) + prod(k,84) = 0._r8 + loss(k,113) = ( + rxt(k,65) + het_rates(k,214))* y(k,214) + prod(k,113) = (.100_r8*rxt(k,489)*y(k,221) +.230_r8*rxt(k,491)*y(k,224)) & + *y(k,263) + loss(k,192) = (rxt(k,513)* y(k,263) + rxt(k,66) + het_rates(k,215))* y(k,215) + prod(k,192) =rxt(k,511)*y(k,268)*y(k,245) + loss(k,187) = (rxt(k,514)* y(k,263) + rxt(k,67) + rxt(k,552) & + + het_rates(k,216))* y(k,216) + prod(k,187) = (.200_r8*rxt(k,507)*y(k,258) +.200_r8*rxt(k,517)*y(k,269)) & + *y(k,131) +.500_r8*rxt(k,505)*y(k,258)*y(k,239) + loss(k,167) = (rxt(k,518)* y(k,263) + rxt(k,68) + het_rates(k,217))* y(k,217) + prod(k,167) =rxt(k,516)*y(k,269)*y(k,245) + loss(k,226) = (rxt(k,519)* y(k,133) +rxt(k,520)* y(k,263) + rxt(k,69) & + + het_rates(k,218))* y(k,218) + prod(k,226) = (.500_r8*rxt(k,505)*y(k,239) +.800_r8*rxt(k,507)*y(k,131) + & + rxt(k,508)*y(k,133))*y(k,258) + (.330_r8*rxt(k,500)*y(k,6) + & + .330_r8*rxt(k,503)*y(k,116))*y(k,142) + (rxt(k,67) + & + rxt(k,514)*y(k,263))*y(k,216) + (rxt(k,515)*y(k,239) + & + .800_r8*rxt(k,517)*y(k,131))*y(k,269) +rxt(k,59)*y(k,135) +rxt(k,68) & + *y(k,217) + loss(k,230) = (rxt(k,521)* y(k,263) + rxt(k,70) + het_rates(k,219))* y(k,219) + prod(k,230) = (.300_r8*rxt(k,500)*y(k,6) +.300_r8*rxt(k,503)*y(k,116)) & + *y(k,142) + (rxt(k,510)*y(k,239) +.900_r8*rxt(k,512)*y(k,131)) & + *y(k,268) +rxt(k,66)*y(k,215) +rxt(k,69)*y(k,218) + loss(k,183) = (rxt(k,488)* y(k,263) + rxt(k,71) + het_rates(k,220))* y(k,220) + prod(k,183) =rxt(k,486)*y(k,270)*y(k,245) + loss(k,111) = ((rxt(k,489) +rxt(k,579))* y(k,263) + het_rates(k,221)) & + * y(k,221) + prod(k,111) = 0._r8 + loss(k,85) = (rxt(k,581)* y(k,131) +rxt(k,580)* y(k,245) + het_rates(k,222)) & + * y(k,222) + prod(k,85) =rxt(k,579)*y(k,263)*y(k,221) + loss(k,114) = (rxt(k,455)* y(k,263) + rxt(k,72) + het_rates(k,223))* y(k,223) + prod(k,114) =rxt(k,452)*y(k,271)*y(k,245) + loss(k,115) = (rxt(k,491)* y(k,263) + het_rates(k,224))* y(k,224) + prod(k,115) = 0._r8 + loss(k,196) = (rxt(k,494)* y(k,263) + rxt(k,73) + het_rates(k,225))* y(k,225) + prod(k,196) =rxt(k,492)*y(k,272)*y(k,245) + loss(k,86) = (rxt(k,585)* y(k,131) +rxt(k,584)* y(k,245) + het_rates(k,226)) & + * y(k,226) + prod(k,86) =rxt(k,583)*y(k,263)*y(k,224) + loss(k,116) = (rxt(k,497)* y(k,263) + het_rates(k,227))* y(k,227) + prod(k,116) =.150_r8*rxt(k,491)*y(k,263)*y(k,224) + loss(k,158) = (rxt(k,498)* y(k,263) + rxt(k,74) + het_rates(k,228))* y(k,228) + prod(k,158) =rxt(k,495)*y(k,273)*y(k,245) + loss(k,172) = (rxt(k,457)* y(k,131) +rxt(k,485)* y(k,132) +rxt(k,456) & + * y(k,245) + het_rates(k,231))* y(k,231) + prod(k,172) =rxt(k,462)*y(k,263)*y(k,24) +rxt(k,490)*y(k,148) + loss(k,223) = ((rxt(k,418) +rxt(k,419))* y(k,131) +rxt(k,417)* y(k,245) & + + het_rates(k,232))* y(k,232) + prod(k,223) = (rxt(k,420)*y(k,2) +rxt(k,421)*y(k,17))*y(k,263) + loss(k,168) = (rxt(k,460)* y(k,131) +rxt(k,459)* y(k,245) + het_rates(k,233)) & + * y(k,233) + prod(k,168) = (.350_r8*rxt(k,458)*y(k,8) +rxt(k,461)*y(k,10))*y(k,263) + loss(k,159) = (rxt(k,465)* y(k,131) +rxt(k,463)* y(k,245) + het_rates(k,234)) & + * y(k,234) + prod(k,159) = (rxt(k,464)*y(k,25) +.070_r8*rxt(k,489)*y(k,221) + & + .060_r8*rxt(k,491)*y(k,224))*y(k,263) + loss(k,215) = (rxt(k,342)* y(k,131) + 2._r8*rxt(k,339)* y(k,235) +rxt(k,340) & + * y(k,239) +rxt(k,341)* y(k,245) + het_rates(k,235))* y(k,235) + prod(k,215) = (rxt(k,345)*y(k,58) +rxt(k,346)*y(k,263))*y(k,30) & + +.500_r8*rxt(k,344)*y(k,263)*y(k,29) +rxt(k,53)*y(k,113) + loss(k,218) = (rxt(k,370)* y(k,131) +rxt(k,368)* y(k,239) +rxt(k,369) & + * y(k,245) + het_rates(k,236))* y(k,236) + prod(k,218) = (rxt(k,372)*y(k,263) +rxt(k,375)*y(k,58))*y(k,33) & + +rxt(k,371)*y(k,263)*y(k,32) + loss(k,188) = (rxt(k,467)* y(k,131) +rxt(k,466)* y(k,245) + het_rates(k,237)) & + * y(k,237) + prod(k,188) = (.400_r8*rxt(k,456)*y(k,245) +rxt(k,457)*y(k,131))*y(k,231) & + +rxt(k,468)*y(k,263)*y(k,34) +rxt(k,483)*y(k,149)*y(k,142) + loss(k,249) = (rxt(k,439)* y(k,103) +rxt(k,353)* y(k,131) +rxt(k,364) & + * y(k,132) + 2._r8*rxt(k,350)* y(k,238) +rxt(k,351)* y(k,239) & + +rxt(k,352)* y(k,245) +rxt(k,425)* y(k,247) +rxt(k,430)* y(k,248) & + +rxt(k,392)* y(k,249) +rxt(k,450)* y(k,271) + het_rates(k,238)) & + * y(k,238) + prod(k,249) = (.100_r8*rxt(k,398)*y(k,111) +.280_r8*rxt(k,412)*y(k,118) + & + .080_r8*rxt(k,445)*y(k,100) +.060_r8*rxt(k,500)*y(k,6) + & + .060_r8*rxt(k,503)*y(k,116))*y(k,142) + (rxt(k,402)*y(k,239) + & + .450_r8*rxt(k,403)*y(k,245) +2.000_r8*rxt(k,404)*y(k,251) + & + rxt(k,405)*y(k,131) +rxt(k,406)*y(k,133))*y(k,251) & + + (.530_r8*rxt(k,392)*y(k,238) +.260_r8*rxt(k,393)*y(k,239) + & + .530_r8*rxt(k,395)*y(k,133) +.530_r8*rxt(k,396)*y(k,131))*y(k,249) & + + (rxt(k,348)*y(k,47) +.500_r8*rxt(k,355)*y(k,53) + & + rxt(k,374)*y(k,51) +.650_r8*rxt(k,521)*y(k,219))*y(k,263) & + + (.300_r8*rxt(k,381)*y(k,239) +.150_r8*rxt(k,382)*y(k,245) + & + rxt(k,383)*y(k,131))*y(k,267) + (rxt(k,37) +rxt(k,373)*y(k,133)) & + *y(k,51) + (.600_r8*rxt(k,61) +rxt(k,365))*y(k,147) & + + (.200_r8*rxt(k,407)*y(k,245) +rxt(k,408)*y(k,131))*y(k,253) & + +.130_r8*rxt(k,24)*y(k,12) +rxt(k,28)*y(k,16) +rxt(k,347)*y(k,133) & + *y(k,47) +rxt(k,36)*y(k,50) +.330_r8*rxt(k,46)*y(k,95) +rxt(k,48) & + *y(k,97) +1.340_r8*rxt(k,51)*y(k,111) +rxt(k,53)*y(k,113) +rxt(k,54) & + *y(k,114) +.300_r8*rxt(k,56)*y(k,118) +rxt(k,58)*y(k,134) +rxt(k,64) & + *y(k,157) +.500_r8*rxt(k,65)*y(k,214) +.650_r8*rxt(k,70)*y(k,219) + loss(k,258) = (rxt(k,241)* y(k,61) +rxt(k,440)* y(k,103) +rxt(k,321) & + * y(k,131) +rxt(k,340)* y(k,235) +rxt(k,368)* y(k,236) +rxt(k,351) & + * y(k,238) + 2._r8*(rxt(k,318) +rxt(k,319))* y(k,239) +rxt(k,320) & + * y(k,245) +rxt(k,426)* y(k,247) +rxt(k,431)* y(k,248) +rxt(k,393) & + * y(k,249) +rxt(k,402)* y(k,251) +rxt(k,505)* y(k,258) +rxt(k,381) & + * y(k,267) +rxt(k,510)* y(k,268) +rxt(k,515)* y(k,269) +rxt(k,451) & + * y(k,271) + het_rates(k,239))* y(k,239) + prod(k,258) = (2.000_r8*rxt(k,350)*y(k,238) +.900_r8*rxt(k,351)*y(k,239) + & + .450_r8*rxt(k,352)*y(k,245) +rxt(k,353)*y(k,131) + & + rxt(k,392)*y(k,249) +rxt(k,401)*y(k,251) +rxt(k,425)*y(k,247) + & + rxt(k,430)*y(k,248) +rxt(k,439)*y(k,103) +rxt(k,450)*y(k,271)) & + *y(k,238) + (rxt(k,41) +rxt(k,235)*y(k,58) +rxt(k,291)*y(k,75) + & + rxt(k,324)*y(k,263) +rxt(k,330)*y(k,259))*y(k,56) & + + (.830_r8*rxt(k,471)*y(k,240) +.170_r8*rxt(k,477)*y(k,252)) & + *y(k,131) + (.280_r8*rxt(k,367)*y(k,31) +.050_r8*rxt(k,445)*y(k,100)) & + *y(k,142) + (.330_r8*rxt(k,470)*y(k,240) + & + .070_r8*rxt(k,476)*y(k,252))*y(k,245) + (.700_r8*rxt(k,323)*y(k,55) + & + rxt(k,354)*y(k,52))*y(k,263) +rxt(k,88)*y(k,45) +rxt(k,35)*y(k,47) & + +rxt(k,90)*y(k,48) +rxt(k,36)*y(k,50) +rxt(k,38)*y(k,53) & + +.300_r8*rxt(k,56)*y(k,118) +.400_r8*rxt(k,61)*y(k,147) + loss(k,201) = (rxt(k,471)* y(k,131) +rxt(k,472)* y(k,132) +rxt(k,470) & + * y(k,245) + het_rates(k,240))* y(k,240) + prod(k,201) =.600_r8*rxt(k,26)*y(k,14) + loss(k,211) = (rxt(k,605)* y(k,255) +rxt(k,603)* y(k,256) +rxt(k,604) & + * y(k,262) + het_rates(k,241))* y(k,241) + prod(k,211) = (rxt(k,126) +rxt(k,127) +rxt(k,128) +rxt(k,129) +rxt(k,130) + & + rxt(k,131) +rxt(k,132) +rxt(k,133))*y(k,141) + (rxt(k,120) + & + rxt(k,121) +rxt(k,122) +rxt(k,123) +rxt(k,124) +rxt(k,125))*y(k,140) & + +rxt(k,111)*y(k,119) +rxt(k,16)*y(k,131) + loss(k,179) = ((rxt(k,389) +rxt(k,390))* y(k,131) + het_rates(k,242)) & + * y(k,242) + prod(k,179) =rxt(k,388)*y(k,263)*y(k,18) + loss(k,163) = (rxt(k,359)* y(k,141) + rxt(k,358) + het_rates(k,243)) & + * y(k,243) + prod(k,163) =rxt(k,43)*y(k,74) +.750_r8*rxt(k,357)*y(k,244)*y(k,131) + loss(k,203) = (rxt(k,357)* y(k,131) +rxt(k,356)* y(k,245) + het_rates(k,244)) & + * y(k,244) + prod(k,203) =rxt(k,363)*y(k,263)*y(k,27) + loss(k,269) = (rxt(k,271)* y(k,19) +rxt(k,277)* y(k,21) +rxt(k,314)* y(k,44) & + + (rxt(k,238) +rxt(k,239))* y(k,58) +rxt(k,245)* y(k,61) & + + (rxt(k,192) +rxt(k,193) +rxt(k,194))* y(k,78) +rxt(k,441) & + * y(k,103) +rxt(k,223)* y(k,131) +rxt(k,228)* y(k,132) +rxt(k,218) & + * y(k,133) +rxt(k,196)* y(k,140) +rxt(k,197)* y(k,142) +rxt(k,456) & + * y(k,231) +rxt(k,417)* y(k,232) +rxt(k,459)* y(k,233) +rxt(k,463) & + * y(k,234) +rxt(k,341)* y(k,235) +rxt(k,369)* y(k,236) +rxt(k,466) & + * y(k,237) +rxt(k,352)* y(k,238) +rxt(k,320)* y(k,239) +rxt(k,470) & + * y(k,240) +rxt(k,356)* y(k,244) + 2._r8*rxt(k,206)* y(k,245) & + +rxt(k,327)* y(k,246) +rxt(k,427)* y(k,247) +rxt(k,432)* y(k,248) & + +rxt(k,394)* y(k,249) +rxt(k,473)* y(k,250) +rxt(k,403)* y(k,251) & + +rxt(k,476)* y(k,252) +rxt(k,407)* y(k,253) +rxt(k,506)* y(k,258) & + +rxt(k,201)* y(k,263) +rxt(k,479)* y(k,265) +rxt(k,378)* y(k,266) & + +rxt(k,382)* y(k,267) +rxt(k,511)* y(k,268) +rxt(k,516)* y(k,269) & + +rxt(k,486)* y(k,270) +rxt(k,452)* y(k,271) +rxt(k,492)* y(k,272) & + +rxt(k,495)* y(k,273) + rxt(k,540) + het_rates(k,245))* y(k,245) + prod(k,269) = (rxt(k,200)*y(k,81) +rxt(k,203)*y(k,142) +rxt(k,221)*y(k,133) + & + rxt(k,252)*y(k,61) +rxt(k,282)*y(k,21) +rxt(k,300)*y(k,45) + & + rxt(k,303)*y(k,48) +rxt(k,322)*y(k,54) +rxt(k,325)*y(k,88) + & + rxt(k,326)*y(k,89) +rxt(k,334)*y(k,64) +.350_r8*rxt(k,336)*y(k,26) + & + rxt(k,343)*y(k,28) +rxt(k,349)*y(k,49) +rxt(k,360)*y(k,76) + & + rxt(k,361)*y(k,77) +rxt(k,376)*y(k,97) +rxt(k,391)*y(k,95) + & + .200_r8*rxt(k,400)*y(k,112) +.500_r8*rxt(k,411)*y(k,115) + & + .300_r8*rxt(k,436)*y(k,101) +rxt(k,437)*y(k,102) + & + rxt(k,444)*y(k,104) +rxt(k,448)*y(k,122) +rxt(k,449)*y(k,123) + & + .650_r8*rxt(k,458)*y(k,8) +.730_r8*rxt(k,469)*y(k,68) + & + .800_r8*rxt(k,481)*y(k,150) +.280_r8*rxt(k,489)*y(k,221) + & + .380_r8*rxt(k,491)*y(k,224) +.630_r8*rxt(k,497)*y(k,227) + & + .200_r8*rxt(k,521)*y(k,219) +rxt(k,527)*y(k,161) + & + .500_r8*rxt(k,537)*y(k,69))*y(k,263) + (rxt(k,321)*y(k,239) + & + rxt(k,329)*y(k,246) +rxt(k,342)*y(k,235) + & + .250_r8*rxt(k,357)*y(k,244) +rxt(k,370)*y(k,236) + & + rxt(k,379)*y(k,266) +rxt(k,389)*y(k,242) + & + .470_r8*rxt(k,396)*y(k,249) +rxt(k,418)*y(k,232) + & + .920_r8*rxt(k,428)*y(k,247) +.920_r8*rxt(k,434)*y(k,248) + & + rxt(k,442)*y(k,103) +rxt(k,453)*y(k,271) +rxt(k,460)*y(k,233) + & + rxt(k,465)*y(k,234) +.170_r8*rxt(k,471)*y(k,240) + & + .400_r8*rxt(k,474)*y(k,250) +.830_r8*rxt(k,477)*y(k,252) + & + rxt(k,480)*y(k,265) +rxt(k,487)*y(k,270) +rxt(k,493)*y(k,272) + & + rxt(k,496)*y(k,273) +.900_r8*rxt(k,512)*y(k,268) + & + .800_r8*rxt(k,517)*y(k,269))*y(k,131) + (rxt(k,241)*y(k,61) + & + 2.000_r8*rxt(k,318)*y(k,239) +rxt(k,340)*y(k,235) + & + .900_r8*rxt(k,351)*y(k,238) +rxt(k,368)*y(k,236) + & + .300_r8*rxt(k,381)*y(k,267) +.730_r8*rxt(k,393)*y(k,249) + & + rxt(k,402)*y(k,251) +rxt(k,426)*y(k,247) +rxt(k,431)*y(k,248) + & + 1.200_r8*rxt(k,440)*y(k,103) +.800_r8*rxt(k,451)*y(k,271) + & + .500_r8*rxt(k,505)*y(k,258) +rxt(k,510)*y(k,268) + & + rxt(k,515)*y(k,269))*y(k,239) + (.130_r8*rxt(k,338)*y(k,27) + & + .280_r8*rxt(k,367)*y(k,31) +.140_r8*rxt(k,398)*y(k,111) + & + .280_r8*rxt(k,412)*y(k,118) +.370_r8*rxt(k,445)*y(k,100) + & + .570_r8*rxt(k,500)*y(k,6) +.570_r8*rxt(k,503)*y(k,116))*y(k,142) & + + (rxt(k,315)*y(k,44) +.470_r8*rxt(k,395)*y(k,249) + & + rxt(k,429)*y(k,247) +rxt(k,435)*y(k,248) +rxt(k,443)*y(k,103) + & + rxt(k,454)*y(k,271))*y(k,133) + (.470_r8*rxt(k,392)*y(k,249) + & + rxt(k,425)*y(k,247) +rxt(k,430)*y(k,248) +rxt(k,439)*y(k,103) + & + rxt(k,450)*y(k,271))*y(k,238) + (rxt(k,234)*y(k,44) + & + rxt(k,237)*y(k,81) +rxt(k,299)*y(k,45) +rxt(k,302)*y(k,48))*y(k,58) & + + (.070_r8*rxt(k,470)*y(k,240) +.160_r8*rxt(k,473)*y(k,250) + & + .330_r8*rxt(k,476)*y(k,252))*y(k,245) + (rxt(k,270)*y(k,19) + & + rxt(k,316)*y(k,140))*y(k,44) + (rxt(k,11) +rxt(k,232))*y(k,92) & + + (1.340_r8*rxt(k,51) +.660_r8*rxt(k,52))*y(k,111) & + + (rxt(k,195)*y(k,78) +rxt(k,359)*y(k,243))*y(k,141) +rxt(k,20) & + *y(k,1) +.900_r8*rxt(k,21)*y(k,2) +rxt(k,22)*y(k,10) & + +1.500_r8*rxt(k,23)*y(k,11) +.560_r8*rxt(k,24)*y(k,12) +rxt(k,25) & + *y(k,13) +.600_r8*rxt(k,26)*y(k,14) +.600_r8*rxt(k,27)*y(k,15) & + +rxt(k,28)*y(k,16) +rxt(k,29)*y(k,25) +rxt(k,30)*y(k,29) +rxt(k,31) & + *y(k,32) +rxt(k,35)*y(k,47) +rxt(k,37)*y(k,51) +rxt(k,331)*y(k,259) & + *y(k,56) +2.000_r8*rxt(k,44)*y(k,76) +2.000_r8*rxt(k,45)*y(k,77) & + +rxt(k,191)*y(k,140)*y(k,81) +.670_r8*rxt(k,46)*y(k,95) +rxt(k,47) & + *y(k,96) +rxt(k,48)*y(k,97) +rxt(k,49)*y(k,104) +rxt(k,50)*y(k,106) & + +rxt(k,57)*y(k,123) +rxt(k,62)*y(k,151) +rxt(k,63)*y(k,156) & + +rxt(k,65)*y(k,214) +rxt(k,66)*y(k,215) +rxt(k,67)*y(k,216) & + +rxt(k,68)*y(k,217) +rxt(k,69)*y(k,218) +1.200_r8*rxt(k,70)*y(k,219) & + +rxt(k,71)*y(k,220) +rxt(k,73)*y(k,225) +rxt(k,74)*y(k,228) & + +1.200_r8*rxt(k,339)*y(k,235)*y(k,235) +rxt(k,358)*y(k,243) & + +rxt(k,328)*y(k,246) +rxt(k,433)*y(k,248) + loss(k,160) = (rxt(k,329)* y(k,131) +rxt(k,327)* y(k,245) + rxt(k,328) & + + het_rates(k,246))* y(k,246) + prod(k,160) =rxt(k,314)*y(k,245)*y(k,44) + loss(k,244) = (rxt(k,428)* y(k,131) +rxt(k,429)* y(k,133) +rxt(k,425) & + * y(k,238) +rxt(k,426)* y(k,239) +rxt(k,427)* y(k,245) & + + het_rates(k,247))* y(k,247) + prod(k,244) =.600_r8*rxt(k,446)*y(k,263)*y(k,100) + loss(k,245) = (rxt(k,434)* y(k,131) +rxt(k,435)* y(k,133) +rxt(k,430) & + * y(k,238) +rxt(k,431)* y(k,239) +rxt(k,432)* y(k,245) + rxt(k,433) & + + het_rates(k,248))* y(k,248) + prod(k,245) =.400_r8*rxt(k,446)*y(k,263)*y(k,100) + loss(k,246) = ((rxt(k,396) +rxt(k,397))* y(k,131) +rxt(k,395)* y(k,133) & + +rxt(k,392)* y(k,238) +rxt(k,393)* y(k,239) +rxt(k,394)* y(k,245) & + + het_rates(k,249))* y(k,249) + prod(k,246) = (.500_r8*rxt(k,399)*y(k,111) +.200_r8*rxt(k,400)*y(k,112) + & + rxt(k,413)*y(k,118))*y(k,263) + loss(k,198) = (rxt(k,474)* y(k,131) +rxt(k,475)* y(k,132) +rxt(k,473) & + * y(k,245) + het_rates(k,250))* y(k,250) + prod(k,198) =.600_r8*rxt(k,25)*y(k,13) + loss(k,248) = (rxt(k,405)* y(k,131) +rxt(k,414)* y(k,132) +rxt(k,406) & + * y(k,133) +rxt(k,401)* y(k,238) +rxt(k,402)* y(k,239) +rxt(k,403) & + * y(k,245) + 2._r8*rxt(k,404)* y(k,251) + het_rates(k,251))* y(k,251) + prod(k,248) = (.660_r8*rxt(k,51) +.500_r8*rxt(k,399)*y(k,263))*y(k,111) & + + (rxt(k,55) +rxt(k,415))*y(k,115) +.500_r8*rxt(k,400)*y(k,263) & + *y(k,112) + loss(k,217) = (rxt(k,477)* y(k,131) +rxt(k,478)* y(k,132) +rxt(k,476) & + * y(k,245) + het_rates(k,252))* y(k,252) + prod(k,217) =.600_r8*rxt(k,27)*y(k,15) + loss(k,191) = (rxt(k,408)* y(k,131) +rxt(k,407)* y(k,245) + het_rates(k,253)) & + * y(k,253) + prod(k,191) = (rxt(k,409)*y(k,113) +rxt(k,410)*y(k,114))*y(k,263) + loss(k,173) = (rxt(k,208)* y(k,140) +rxt(k,209)* y(k,141) + het_rates(k,254)) & + * y(k,254) + prod(k,173) = (.800_r8*rxt(k,603)*y(k,256) +.900_r8*rxt(k,605)*y(k,255)) & + *y(k,241) +rxt(k,607)*y(k,255)*y(k,140) + loss(k,193) = ((rxt(k,607) +rxt(k,608))* y(k,140) +rxt(k,606)* y(k,141) & + +rxt(k,605)* y(k,241) + het_rates(k,255))* y(k,255) + prod(k,193) = 0._r8 + loss(k,209) = (rxt(k,603)* y(k,241) + het_rates(k,256))* y(k,256) + prod(k,209) = (rxt(k,613) +rxt(k,612)*y(k,119) +rxt(k,614)*y(k,131))*y(k,262) & + +rxt(k,16)*y(k,131) +rxt(k,607)*y(k,255)*y(k,140) & + +rxt(k,611)*y(k,257)*y(k,141) +rxt(k,616)*y(k,264) + loss(k,169) = (rxt(k,609)* y(k,140) + (rxt(k,610) +rxt(k,611))* y(k,141) & + + het_rates(k,257))* y(k,257) + prod(k,169) =rxt(k,111)*y(k,119) + loss(k,229) = (rxt(k,507)* y(k,131) +rxt(k,508)* y(k,133) +rxt(k,505) & + * y(k,239) +rxt(k,506)* y(k,245) + het_rates(k,258))* y(k,258) + prod(k,229) = (rxt(k,499)*y(k,6) +rxt(k,502)*y(k,116) + & + .500_r8*rxt(k,519)*y(k,218))*y(k,133) +rxt(k,509)*y(k,263)*y(k,135) + loss(k,264) = (rxt(k,259)* y(k,35) +rxt(k,260)* y(k,36) +rxt(k,286)* y(k,37) & + +rxt(k,261)* y(k,38) +rxt(k,262)* y(k,39) +rxt(k,263)* y(k,40) & + +rxt(k,264)* y(k,41) +rxt(k,265)* y(k,42) +rxt(k,309)* y(k,43) & + +rxt(k,310)* y(k,45) + (rxt(k,330) +rxt(k,331) +rxt(k,332))* y(k,56) & + +rxt(k,287)* y(k,57) +rxt(k,295)* y(k,66) +rxt(k,296)* y(k,67) & + +rxt(k,173)* y(k,79) +rxt(k,288)* y(k,80) + (rxt(k,289) +rxt(k,290)) & + * y(k,83) +rxt(k,311)* y(k,84) +rxt(k,312)* y(k,85) +rxt(k,313) & + * y(k,86) + (rxt(k,266) +rxt(k,267))* y(k,87) +rxt(k,333)* y(k,88) & + + (rxt(k,226) +rxt(k,227))* y(k,120) + (rxt(k,176) +rxt(k,177)) & + * y(k,141) +rxt(k,178)* y(k,142) +rxt(k,174)* y(k,274) + rxt(k,175) & + + het_rates(k,259))* y(k,259) + prod(k,264) = (rxt(k,6) +rxt(k,209)*y(k,254))*y(k,141) +rxt(k,12)*y(k,120) & + +rxt(k,7)*y(k,142) +.850_r8*rxt(k,604)*y(k,262)*y(k,241) +rxt(k,1) & + *y(k,274) + loss(k,108) = (rxt(k,180)* y(k,140) +rxt(k,181)* y(k,141) + rxt(k,171) & + + rxt(k,179) + het_rates(k,260))* y(k,260) + prod(k,108) = (rxt(k,183) +rxt(k,182)*y(k,65) +rxt(k,184)*y(k,140) + & + rxt(k,185)*y(k,141) +rxt(k,186)*y(k,142))*y(k,261) +rxt(k,7)*y(k,142) + loss(k,109) = (rxt(k,182)* y(k,65) +rxt(k,184)* y(k,140) +rxt(k,185) & + * y(k,141) +rxt(k,186)* y(k,142) + rxt(k,172) + rxt(k,183) & + + het_rates(k,261))* y(k,261) + prod(k,109) =rxt(k,176)*y(k,259)*y(k,141) + loss(k,210) = (rxt(k,612)* y(k,119) +rxt(k,614)* y(k,131) +rxt(k,604) & + * y(k,241) + rxt(k,613) + het_rates(k,262))* y(k,262) + prod(k,210) = (rxt(k,126) +rxt(k,130) +rxt(k,606)*y(k,255) + & + rxt(k,610)*y(k,257) +rxt(k,617)*y(k,264))*y(k,141) & + +rxt(k,615)*y(k,264)*y(k,65) + loss(k,261) = (rxt(k,416)* y(k,1) +rxt(k,420)* y(k,2) +rxt(k,501)* y(k,6) & + +rxt(k,458)* y(k,8) +rxt(k,461)* y(k,10) +rxt(k,421)* y(k,17) & + +rxt(k,388)* y(k,18) +rxt(k,282)* y(k,21) +rxt(k,462)* y(k,24) & + +rxt(k,464)* y(k,25) +rxt(k,336)* y(k,26) +rxt(k,363)* y(k,27) & + +rxt(k,343)* y(k,28) +rxt(k,344)* y(k,29) +rxt(k,346)* y(k,30) & + +rxt(k,385)* y(k,31) +rxt(k,371)* y(k,32) +rxt(k,372)* y(k,33) & + +rxt(k,468)* y(k,34) +rxt(k,298)* y(k,43) +rxt(k,317)* y(k,44) & + +rxt(k,300)* y(k,45) +rxt(k,301)* y(k,46) +rxt(k,348)* y(k,47) & + +rxt(k,303)* y(k,48) +rxt(k,349)* y(k,49) +rxt(k,386)* y(k,50) & + +rxt(k,374)* y(k,51) +rxt(k,354)* y(k,52) +rxt(k,355)* y(k,53) & + +rxt(k,322)* y(k,54) +rxt(k,323)* y(k,55) +rxt(k,324)* y(k,56) & + +rxt(k,305)* y(k,57) + (rxt(k,252) +rxt(k,253))* y(k,61) +rxt(k,250) & + * y(k,62) +rxt(k,334)* y(k,64) +rxt(k,469)* y(k,68) + (rxt(k,523) + & + rxt(k,537))* y(k,69) +rxt(k,360)* y(k,76) +rxt(k,361)* y(k,77) & + +rxt(k,199)* y(k,79) +rxt(k,200)* y(k,81) +rxt(k,284)* y(k,83) & + +rxt(k,306)* y(k,84) +rxt(k,307)* y(k,85) +rxt(k,308)* y(k,86) & + +rxt(k,255)* y(k,87) +rxt(k,325)* y(k,88) +rxt(k,326)* y(k,89) & + +rxt(k,231)* y(k,91) +rxt(k,207)* y(k,92) +rxt(k,258)* y(k,94) & + +rxt(k,391)* y(k,95) +rxt(k,422)* y(k,96) +rxt(k,376)* y(k,97) & + +rxt(k,423)* y(k,98) +rxt(k,424)* y(k,99) +rxt(k,446)* y(k,100) & + +rxt(k,436)* y(k,101) +rxt(k,437)* y(k,102) +rxt(k,444)* y(k,104) & + +rxt(k,447)* y(k,106) +rxt(k,399)* y(k,111) +rxt(k,400)* y(k,112) & + +rxt(k,409)* y(k,113) +rxt(k,410)* y(k,114) +rxt(k,411)* y(k,115) & + +rxt(k,504)* y(k,116) +rxt(k,413)* y(k,118) +rxt(k,222)* y(k,119) & + +rxt(k,448)* y(k,122) +rxt(k,449)* y(k,123) +rxt(k,539)* y(k,127) & + +rxt(k,230)* y(k,132) +rxt(k,221)* y(k,133) +rxt(k,377)* y(k,134) & + +rxt(k,509)* y(k,135) +rxt(k,202)* y(k,140) +rxt(k,203)* y(k,142) & + +rxt(k,525)* y(k,145) +rxt(k,362)* y(k,147) +rxt(k,481)* y(k,150) & + +rxt(k,484)* y(k,151) +rxt(k,380)* y(k,156) +rxt(k,384)* y(k,157) & + +rxt(k,531)* y(k,158) +rxt(k,536)* y(k,160) +rxt(k,527)* y(k,161) & + +rxt(k,513)* y(k,215) +rxt(k,514)* y(k,216) +rxt(k,518)* y(k,217) & + +rxt(k,520)* y(k,218) +rxt(k,521)* y(k,219) +rxt(k,488)* y(k,220) & + + (rxt(k,489) +rxt(k,579))* y(k,221) +rxt(k,455)* y(k,223) & + +rxt(k,491)* y(k,224) +rxt(k,494)* y(k,225) +rxt(k,497)* y(k,227) & + +rxt(k,498)* y(k,228) +rxt(k,201)* y(k,245) + 2._r8*(rxt(k,204) + & + rxt(k,205))* y(k,263) + het_rates(k,263))* y(k,263) + prod(k,261) = (2.000_r8*rxt(k,193)*y(k,78) +rxt(k,196)*y(k,140) + & + rxt(k,197)*y(k,142) +rxt(k,218)*y(k,133) +rxt(k,223)*y(k,131) + & + rxt(k,239)*y(k,58) +.450_r8*rxt(k,352)*y(k,238) + & + .150_r8*rxt(k,382)*y(k,267) +.450_r8*rxt(k,403)*y(k,251) + & + .200_r8*rxt(k,407)*y(k,253) +.400_r8*rxt(k,456)*y(k,231) + & + .400_r8*rxt(k,470)*y(k,240) +.400_r8*rxt(k,476)*y(k,252))*y(k,245) & + + (rxt(k,198)*y(k,78) +.130_r8*rxt(k,338)*y(k,27) + & + .360_r8*rxt(k,367)*y(k,31) +.240_r8*rxt(k,398)*y(k,111) + & + .360_r8*rxt(k,412)*y(k,118) +.320_r8*rxt(k,445)*y(k,100) + & + .630_r8*rxt(k,500)*y(k,6) +.630_r8*rxt(k,503)*y(k,116))*y(k,142) & + + (rxt(k,190)*y(k,79) +rxt(k,191)*y(k,81) +rxt(k,254)*y(k,87) + & + rxt(k,257)*y(k,94) +rxt(k,283)*y(k,83) +rxt(k,285)*y(k,93) + & + rxt(k,316)*y(k,44))*y(k,140) + (.300_r8*rxt(k,323)*y(k,55) + & + .650_r8*rxt(k,336)*y(k,26) +.500_r8*rxt(k,344)*y(k,29) + & + .500_r8*rxt(k,380)*y(k,156) +.100_r8*rxt(k,400)*y(k,112) + & + .600_r8*rxt(k,447)*y(k,106) +.500_r8*rxt(k,455)*y(k,223))*y(k,263) & + + (rxt(k,173)*y(k,79) +2.000_r8*rxt(k,174)*y(k,274) + & + rxt(k,266)*y(k,87) +rxt(k,289)*y(k,83) +rxt(k,330)*y(k,56) + & + rxt(k,333)*y(k,88))*y(k,259) + (rxt(k,3) +rxt(k,293)*y(k,75)) & + *y(k,274) +rxt(k,21)*y(k,2) +rxt(k,22)*y(k,10) +rxt(k,29)*y(k,25) & + +rxt(k,30)*y(k,29) +rxt(k,31)*y(k,32) +rxt(k,32)*y(k,34) +rxt(k,38) & + *y(k,53) +rxt(k,39)*y(k,55) +.330_r8*rxt(k,40)*y(k,56) +rxt(k,43) & + *y(k,74) +2.000_r8*rxt(k,4)*y(k,81) +rxt(k,9)*y(k,91) +rxt(k,10) & + *y(k,92) +rxt(k,106)*y(k,93) +rxt(k,107)*y(k,94) +rxt(k,47)*y(k,96) & + +rxt(k,50)*y(k,106) +rxt(k,54)*y(k,114) +.500_r8*rxt(k,548)*y(k,132) & + +rxt(k,59)*y(k,135) +rxt(k,62)*y(k,151) +rxt(k,63)*y(k,156) & + +rxt(k,64)*y(k,157) +rxt(k,66)*y(k,215) +rxt(k,68)*y(k,217) & + +rxt(k,71)*y(k,220) +rxt(k,72)*y(k,223) +rxt(k,73)*y(k,225) & + +rxt(k,74)*y(k,228) + loss(k,204) = (rxt(k,615)* y(k,65) +rxt(k,617)* y(k,141) + rxt(k,616) & + + het_rates(k,264))* y(k,264) + prod(k,204) = (rxt(k,120) +rxt(k,121) +rxt(k,122) +rxt(k,123) +rxt(k,124) + & + rxt(k,125) +rxt(k,608)*y(k,255) +rxt(k,609)*y(k,257))*y(k,140) & + + (rxt(k,127) +rxt(k,128) +rxt(k,129) +rxt(k,131) +rxt(k,132) + & + rxt(k,133))*y(k,141) + loss(k,161) = (rxt(k,480)* y(k,131) +rxt(k,479)* y(k,245) + het_rates(k,265)) & + * y(k,265) + prod(k,161) = (.200_r8*rxt(k,469)*y(k,68) +.140_r8*rxt(k,481)*y(k,150) + & + rxt(k,484)*y(k,151))*y(k,263) + loss(k,206) = (rxt(k,379)* y(k,131) +rxt(k,378)* y(k,245) + het_rates(k,266)) & + * y(k,266) + prod(k,206) = (.500_r8*rxt(k,380)*y(k,156) +rxt(k,385)*y(k,31))*y(k,263) + loss(k,239) = (rxt(k,383)* y(k,131) +rxt(k,381)* y(k,239) +rxt(k,382) & + * y(k,245) + het_rates(k,267))* y(k,267) + prod(k,239) = (rxt(k,384)*y(k,157) +rxt(k,386)*y(k,50) + & + .150_r8*rxt(k,521)*y(k,219))*y(k,263) + (.060_r8*rxt(k,500)*y(k,6) + & + .060_r8*rxt(k,503)*y(k,116))*y(k,142) +.150_r8*rxt(k,70)*y(k,219) + loss(k,236) = (rxt(k,512)* y(k,131) +rxt(k,510)* y(k,239) +rxt(k,511) & + * y(k,245) + het_rates(k,268))* y(k,268) + prod(k,236) = (.500_r8*rxt(k,519)*y(k,133) +rxt(k,520)*y(k,263))*y(k,218) & + +rxt(k,513)*y(k,263)*y(k,215) + loss(k,225) = (rxt(k,517)* y(k,131) +rxt(k,515)* y(k,239) +rxt(k,516) & + * y(k,245) + het_rates(k,269))* y(k,269) + prod(k,225) = (rxt(k,501)*y(k,6) +rxt(k,504)*y(k,116) +rxt(k,518)*y(k,217)) & + *y(k,263) + loss(k,199) = (rxt(k,487)* y(k,131) +rxt(k,486)* y(k,245) + het_rates(k,270)) & + * y(k,270) + prod(k,199) = (rxt(k,488)*y(k,220) +.650_r8*rxt(k,489)*y(k,221) + & + rxt(k,579)*y(k,221))*y(k,263) + loss(k,240) = (rxt(k,453)* y(k,131) +rxt(k,454)* y(k,133) +rxt(k,450) & + * y(k,238) +rxt(k,451)* y(k,239) +rxt(k,452)* y(k,245) & + + het_rates(k,271))* y(k,271) + prod(k,240) = (rxt(k,422)*y(k,96) +rxt(k,423)*y(k,98) +rxt(k,424)*y(k,99) + & + .400_r8*rxt(k,447)*y(k,106) +.500_r8*rxt(k,455)*y(k,223))*y(k,263) + loss(k,200) = (rxt(k,493)* y(k,131) +rxt(k,492)* y(k,245) + het_rates(k,272)) & + * y(k,272) + prod(k,200) = (.560_r8*rxt(k,491)*y(k,224) +rxt(k,494)*y(k,225))*y(k,263) + loss(k,170) = (rxt(k,496)* y(k,131) +rxt(k,495)* y(k,245) + het_rates(k,273)) & + * y(k,273) + prod(k,170) = (.300_r8*rxt(k,497)*y(k,227) +rxt(k,498)*y(k,228))*y(k,263) + loss(k,272) = (rxt(k,293)* y(k,75) +rxt(k,538)* y(k,162) +rxt(k,174) & + * y(k,259) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,274)) & + * y(k,274) + prod(k,272) = (rxt(k,199)*y(k,79) +rxt(k,200)*y(k,81) +rxt(k,201)*y(k,245) + & + rxt(k,204)*y(k,263) +rxt(k,207)*y(k,92) +rxt(k,231)*y(k,91) + & + rxt(k,255)*y(k,87) +rxt(k,258)*y(k,94) +rxt(k,284)*y(k,83) + & + rxt(k,298)*y(k,43) +rxt(k,300)*y(k,45) +rxt(k,301)*y(k,46) + & + rxt(k,303)*y(k,48) +rxt(k,308)*y(k,86) +rxt(k,317)*y(k,44) + & + rxt(k,323)*y(k,55) +rxt(k,324)*y(k,56) +rxt(k,326)*y(k,89) + & + rxt(k,346)*y(k,30) +rxt(k,348)*y(k,47) +rxt(k,354)*y(k,52) + & + rxt(k,355)*y(k,53) +rxt(k,371)*y(k,32) +rxt(k,372)*y(k,33) + & + rxt(k,374)*y(k,51) +rxt(k,380)*y(k,156) +rxt(k,384)*y(k,157) + & + rxt(k,386)*y(k,50) +.500_r8*rxt(k,399)*y(k,111) +rxt(k,539)*y(k,127)) & + *y(k,263) + (rxt(k,587)*y(k,94) +rxt(k,593)*y(k,94) + & + rxt(k,594)*y(k,93) +rxt(k,598)*y(k,94) +rxt(k,599)*y(k,93))*y(k,87) & + + (rxt(k,540) +rxt(k,194)*y(k,78))*y(k,245) +.050_r8*rxt(k,40) & + *y(k,56) +rxt(k,136)*y(k,82) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..4156315f12 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_rxt_rates_conv.F90 @@ -0,0 +1,633 @@ +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,:, 274) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 274) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 274) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 81) ! rate_const*H2O2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 141) ! rate_const*O2 + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 141) ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 142) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 142) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 91) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 92) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 92) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 120) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 131) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 131) ! rate_const*NO + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 132) ! rate_const*NO2 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 133) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 133) ! rate_const*NO3 + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 1) ! rate_const*ALKNIT + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 2) ! rate_const*ALKOOH + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 10) ! rate_const*BENZOOH + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 11) ! rate_const*BEPOMUC + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 12) ! rate_const*BIGALD + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 13) ! rate_const*BIGALD1 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 14) ! rate_const*BIGALD2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 15) ! rate_const*BIGALD3 + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 16) ! rate_const*BIGALD4 + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 25) ! rate_const*BZOOH + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 29) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 32) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 34) ! rate_const*C6H5OOH + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 44) ! rate_const*CH2O + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 44) ! rate_const*CH2O + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 47) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 50) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 51) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 53) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 55) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 56) ! rate_const*CH4 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 56) ! rate_const*CH4 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 65) ! rate_const*CO2 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 74) ! rate_const*EOOH + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 76) ! rate_const*GLYALD + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 77) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 95) ! rate_const*HONITR + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 96) ! rate_const*HPALD + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 97) ! rate_const*HYAC + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 104) ! rate_const*ISOPNOOH + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 106) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 111) ! rate_const*MACR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 111) ! rate_const*MACR + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 113) ! rate_const*MEK + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 114) ! rate_const*MEKOOH + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 115) ! rate_const*MPAN + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 118) ! rate_const*MVK + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 123) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 134) ! rate_const*NOA + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 135) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 146) ! rate_const*ONITR + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 147) ! rate_const*PAN + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 151) ! rate_const*PHENOOH + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 156) ! rate_const*POOH + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 157) ! rate_const*ROOH + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 214) ! rate_const*TEPOMUC + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 215) ! rate_const*TERP2OOH + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 216) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 217) ! rate_const*TERPOOH + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 218) ! rate_const*TERPROD1 + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 219) ! rate_const*TERPROD2 + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 220) ! rate_const*TOLOOH + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 223) ! rate_const*XOOH + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 225) ! rate_const*XYLENOOH + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 228) ! rate_const*XYLOLOOH + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 20) ! rate_const*BRCL + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 21) ! rate_const*BRO + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 35) ! rate_const*CCL4 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 36) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 37) ! rate_const*CF3BR + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 38) ! rate_const*CFC11 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 39) ! rate_const*CFC113 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 40) ! rate_const*CFC114 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 41) ! rate_const*CFC115 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 42) ! rate_const*CFC12 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 43) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 45) ! rate_const*CH3BR + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 46) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 48) ! rate_const*CH3CL + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 57) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 59) ! rate_const*CL2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 60) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 61) ! rate_const*CLO + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 66) ! rate_const*COF2 + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 67) ! rate_const*COFCL + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 80) ! rate_const*H2402 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 83) ! rate_const*HBR + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 84) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 85) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 86) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 87) ! rate_const*HCL + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 90) ! rate_const*HF + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 93) ! rate_const*HOBR + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 94) ! rate_const*HOCL + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 144) ! rate_const*OCLO + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 159) ! rate_const*SF6 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 65) ! rate_const*CO2 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 119) ! rate_const*N + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 140) ! rate_const*O + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 140) ! rate_const*O + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 140) ! rate_const*O + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 140) ! rate_const*O + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 140) ! rate_const*O + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 140) ! rate_const*O + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 141) ! rate_const*O2 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 141) ! rate_const*O2 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 141) ! rate_const*O2 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 141) ! rate_const*O2 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 141) ! rate_const*O2 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 141) ! rate_const*O2 + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 141) ! rate_const*O2 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 141) ! rate_const*O2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 141) ! rate_const*O2 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 141) ! rate_const*O2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 82) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 145) ! rate_const*OCS + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 160) ! rate_const*SO + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 161) ! rate_const*SO2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 162) ! rate_const*SO3 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 166) ! rate_const*soabb1_a1 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 167) ! rate_const*soabb1_a2 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 168) ! rate_const*soabb2_a1 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 169) ! rate_const*soabb2_a2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 170) ! rate_const*soabb3_a1 + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 171) ! rate_const*soabb3_a2 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 172) ! rate_const*soabb4_a1 + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 173) ! rate_const*soabb4_a2 + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 174) ! rate_const*soabb5_a1 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 175) ! rate_const*soabb5_a2 + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 176) ! rate_const*soabg1_a1 + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 177) ! rate_const*soabg1_a2 + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 178) ! rate_const*soabg2_a1 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 179) ! rate_const*soabg2_a2 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 180) ! rate_const*soabg3_a1 + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 181) ! rate_const*soabg3_a2 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 182) ! rate_const*soabg4_a1 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 183) ! rate_const*soabg4_a2 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 184) ! rate_const*soabg5_a1 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 185) ! rate_const*soabg5_a2 + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 186) ! rate_const*soaff1_a1 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 187) ! rate_const*soaff1_a2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 188) ! rate_const*soaff2_a1 + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 189) ! rate_const*soaff2_a2 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 190) ! rate_const*soaff3_a1 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 191) ! rate_const*soaff3_a2 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 192) ! rate_const*soaff4_a1 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 193) ! rate_const*soaff4_a2 + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 194) ! rate_const*soaff5_a1 + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 195) ! rate_const*soaff5_a2 + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 260) ! rate_const*O2_1D + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 261) ! rate_const*O2_1S + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 259)*sol(:ncol,:, 79) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 259)*sol(:ncol,:, 274) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 259) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 259)*sol(:ncol,:, 141) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 259)*sol(:ncol,:, 141) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 259)*sol(:ncol,:, 142) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 260) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 260)*sol(:ncol,:, 140) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 260)*sol(:ncol,:, 141) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 261)*sol(:ncol,:, 65) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 261) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 261)*sol(:ncol,:, 140) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 261)*sol(:ncol,:, 141) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 261)*sol(:ncol,:, 142) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 140)*sol(:ncol,:, 142) ! rate_const*O*O3 + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 140)*sol(:ncol,:, 140) ! rate_const*M*O*O + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 140)*sol(:ncol,:, 141) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 79)*sol(:ncol,:, 140) ! rate_const*H2*O + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 81)*sol(:ncol,:, 140) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 78)*sol(:ncol,:, 245) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 78)*sol(:ncol,:, 245) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 78)*sol(:ncol,:, 245) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 78)*sol(:ncol,:, 141) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 245)*sol(:ncol,:, 140) ! rate_const*HO2*O + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 245)*sol(:ncol,:, 142) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 78)*sol(:ncol,:, 142) ! rate_const*H*O3 + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 263)*sol(:ncol,:, 79) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 263)*sol(:ncol,:, 81) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 263)*sol(:ncol,:, 245) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 263)*sol(:ncol,:, 140) ! rate_const*OH*O + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 263)*sol(:ncol,:, 142) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 263)*sol(:ncol,:, 263) ! rate_const*OH*OH + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 263)*sol(:ncol,:, 263) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 245)*sol(:ncol,:, 245) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 92)*sol(:ncol,:, 263) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 254)*sol(:ncol,:, 140) ! rate_const*N2D*O + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 254)*sol(:ncol,:, 141) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 119)*sol(:ncol,:, 131) ! rate_const*N*NO + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 119)*sol(:ncol,:, 132) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 119)*sol(:ncol,:, 132) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 119)*sol(:ncol,:, 132) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 119)*sol(:ncol,:, 141) ! rate_const*N*O2 + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 132)*sol(:ncol,:, 140) ! rate_const*NO2*O + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 132)*sol(:ncol,:, 142) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 132)*sol(:ncol,:, 140) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 133)*sol(:ncol,:, 245) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 133)*sol(:ncol,:, 131) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 133)*sol(:ncol,:, 140) ! rate_const*NO3*O + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 133)*sol(:ncol,:, 263) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 119)*sol(:ncol,:, 263) ! rate_const*N*OH + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 131)*sol(:ncol,:, 245) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 131)*sol(:ncol,:, 142) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 131)*sol(:ncol,:, 140) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 259)*sol(:ncol,:, 120) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 259)*sol(:ncol,:, 120) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 132)*sol(:ncol,:, 245) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 132)*sol(:ncol,:, 133) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 132)*sol(:ncol,:, 263) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 91)*sol(:ncol,:, 263) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 92) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 121) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 58)*sol(:ncol,:, 44) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 58)*sol(:ncol,:, 56) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 58)*sol(:ncol,:, 79) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 58)*sol(:ncol,:, 81) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 58)*sol(:ncol,:, 245) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 58)*sol(:ncol,:, 245) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 58)*sol(:ncol,:, 142) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 61)*sol(:ncol,:, 239) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 61)*sol(:ncol,:, 245) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 61)*sol(:ncol,:, 131) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 62)*sol(:ncol,:, 58) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 61)*sol(:ncol,:, 132) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 62)*sol(:ncol,:, 140) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 62)*sol(:ncol,:, 263) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 61)*sol(:ncol,:, 140) ! rate_const*CLO*O + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 61)*sol(:ncol,:, 263) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 61)*sol(:ncol,:, 263) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 87)*sol(:ncol,:, 140) ! rate_const*HCL*O + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 87)*sol(:ncol,:, 263) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 94)*sol(:ncol,:, 58) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 94)*sol(:ncol,:, 140) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 94)*sol(:ncol,:, 263) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 259)*sol(:ncol,:, 35) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 259)*sol(:ncol,:, 36) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 259)*sol(:ncol,:, 38) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 259)*sol(:ncol,:, 39) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 259)*sol(:ncol,:, 40) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 259)*sol(:ncol,:, 41) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 259)*sol(:ncol,:, 42) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 259)*sol(:ncol,:, 87) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 259)*sol(:ncol,:, 87) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 60) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 19)*sol(:ncol,:, 44) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 19)*sol(:ncol,:, 245) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 19)*sol(:ncol,:, 142) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 21)*sol(:ncol,:, 21) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 21)*sol(:ncol,:, 245) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 21)*sol(:ncol,:, 131) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 21)*sol(:ncol,:, 132) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 22)*sol(:ncol,:, 140) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 21)*sol(:ncol,:, 140) ! rate_const*BRO*O + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 21)*sol(:ncol,:, 263) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 83)*sol(:ncol,:, 140) ! rate_const*HBR*O + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 83)*sol(:ncol,:, 263) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 93)*sol(:ncol,:, 140) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 259)*sol(:ncol,:, 37) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 259)*sol(:ncol,:, 57) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 259)*sol(:ncol,:, 80) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 259)*sol(:ncol,:, 83) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 259)*sol(:ncol,:, 83) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 75)*sol(:ncol,:, 56) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 75)*sol(:ncol,:, 79) ! rate_const*F*H2 + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 75)*sol(:ncol,:, 274) ! rate_const*F*H2O + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 75)*sol(:ncol,:, 91) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 259)*sol(:ncol,:, 66) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 259)*sol(:ncol,:, 67) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 43)*sol(:ncol,:, 58) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 43)*sol(:ncol,:, 263) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 45)*sol(:ncol,:, 58) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 45)*sol(:ncol,:, 263) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 46)*sol(:ncol,:, 263) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 48)*sol(:ncol,:, 58) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 48)*sol(:ncol,:, 263) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 57)*sol(:ncol,:, 58) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 57)*sol(:ncol,:, 263) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 84)*sol(:ncol,:, 263) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 85)*sol(:ncol,:, 263) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 86)*sol(:ncol,:, 263) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 259)*sol(:ncol,:, 43) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 259)*sol(:ncol,:, 45) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 259)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 259)*sol(:ncol,:, 85) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 259)*sol(:ncol,:, 86) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 44)*sol(:ncol,:, 245) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 44)*sol(:ncol,:, 133) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 44)*sol(:ncol,:, 140) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 44)*sol(:ncol,:, 263) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 239)*sol(:ncol,:, 239) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 239)*sol(:ncol,:, 239) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 239)*sol(:ncol,:, 245) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 239)*sol(:ncol,:, 131) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 54)*sol(:ncol,:, 263) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 55)*sol(:ncol,:, 263) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 56)*sol(:ncol,:, 263) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 88)*sol(:ncol,:, 263) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 89)*sol(:ncol,:, 263) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 246)*sol(:ncol,:, 245) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 246) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 246)*sol(:ncol,:, 131) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 259)*sol(:ncol,:, 56) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 259)*sol(:ncol,:, 56) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 259)*sol(:ncol,:, 56) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 259)*sol(:ncol,:, 88) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 64)*sol(:ncol,:, 263) ! rate_const*CO*OH + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 26)*sol(:ncol,:, 58) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 26)*sol(:ncol,:, 263) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 27)*sol(:ncol,:, 58) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 27)*sol(:ncol,:, 142) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 235)*sol(:ncol,:, 235) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 235)*sol(:ncol,:, 239) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 235)*sol(:ncol,:, 245) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 235)*sol(:ncol,:, 131) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 28)*sol(:ncol,:, 263) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 29)*sol(:ncol,:, 263) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 30)*sol(:ncol,:, 58) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 30)*sol(:ncol,:, 263) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 47)*sol(:ncol,:, 133) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 47)*sol(:ncol,:, 263) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 49)*sol(:ncol,:, 263) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 238)*sol(:ncol,:, 238) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 238)*sol(:ncol,:, 239) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 238)*sol(:ncol,:, 245) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 238)*sol(:ncol,:, 131) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 52)*sol(:ncol,:, 263) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 53)*sol(:ncol,:, 263) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 244)*sol(:ncol,:, 245) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 244)*sol(:ncol,:, 131) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 243) ! rate_const*EO + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 243)*sol(:ncol,:, 141) ! rate_const*EO*O2 + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 76)*sol(:ncol,:, 263) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 77)*sol(:ncol,:, 263) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 147)*sol(:ncol,:, 263) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 27)*sol(:ncol,:, 263) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 238)*sol(:ncol,:, 132) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 147) ! rate_const*M*PAN + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 31)*sol(:ncol,:, 133) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 31)*sol(:ncol,:, 142) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 236)*sol(:ncol,:, 239) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 236)*sol(:ncol,:, 245) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 236)*sol(:ncol,:, 131) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 32)*sol(:ncol,:, 263) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 33)*sol(:ncol,:, 263) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 51)*sol(:ncol,:, 133) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 51)*sol(:ncol,:, 263) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 58)*sol(:ncol,:, 33) ! rate_const*CL*C3H8 + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 97)*sol(:ncol,:, 263) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 134)*sol(:ncol,:, 263) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 266)*sol(:ncol,:, 245) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 266)*sol(:ncol,:, 131) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 156)*sol(:ncol,:, 263) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 267)*sol(:ncol,:, 239) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 267)*sol(:ncol,:, 245) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 267)*sol(:ncol,:, 131) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 157)*sol(:ncol,:, 263) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 31)*sol(:ncol,:, 263) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 50)*sol(:ncol,:, 263) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 18)*sol(:ncol,:, 133) ! rate_const*BIGENE*NO3 + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 18)*sol(:ncol,:, 263) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 242)*sol(:ncol,:, 131) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 242)*sol(:ncol,:, 131) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 95)*sol(:ncol,:, 263) ! rate_const*HONITR*OH + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 249)*sol(:ncol,:, 238) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 249)*sol(:ncol,:, 239) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 249)*sol(:ncol,:, 245) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 249)*sol(:ncol,:, 133) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 249)*sol(:ncol,:, 131) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 249)*sol(:ncol,:, 131) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 111)*sol(:ncol,:, 142) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 111)*sol(:ncol,:, 263) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 112)*sol(:ncol,:, 263) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 251)*sol(:ncol,:, 238) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 251)*sol(:ncol,:, 239) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 251)*sol(:ncol,:, 245) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 251)*sol(:ncol,:, 251) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 251)*sol(:ncol,:, 131) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 251)*sol(:ncol,:, 133) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 253)*sol(:ncol,:, 245) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 253)*sol(:ncol,:, 131) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 113)*sol(:ncol,:, 263) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 114)*sol(:ncol,:, 263) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 115)*sol(:ncol,:, 263) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 118)*sol(:ncol,:, 142) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 118)*sol(:ncol,:, 263) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 251)*sol(:ncol,:, 132) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 115) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 1)*sol(:ncol,:, 263) ! rate_const*ALKNIT*OH + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 232)*sol(:ncol,:, 245) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 232)*sol(:ncol,:, 131) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 232)*sol(:ncol,:, 131) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 2)*sol(:ncol,:, 263) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 17)*sol(:ncol,:, 263) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 96)*sol(:ncol,:, 263) ! rate_const*HPALD*OH + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 98)*sol(:ncol,:, 263) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 99)*sol(:ncol,:, 263) ! rate_const*IEPOX*OH + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 247)*sol(:ncol,:, 238) ! rate_const*ISOPAO2*CH3CO3 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 247)*sol(:ncol,:, 239) ! rate_const*ISOPAO2*CH3O2 + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 247)*sol(:ncol,:, 245) ! rate_const*ISOPAO2*HO2 + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 247)*sol(:ncol,:, 131) ! rate_const*ISOPAO2*NO + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 247)*sol(:ncol,:, 133) ! rate_const*ISOPAO2*NO3 + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 248)*sol(:ncol,:, 238) ! rate_const*ISOPBO2*CH3CO3 + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 248)*sol(:ncol,:, 239) ! rate_const*ISOPBO2*CH3O2 + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 248)*sol(:ncol,:, 245) ! rate_const*ISOPBO2*HO2 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 248) ! rate_const*ISOPBO2 + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 248)*sol(:ncol,:, 131) ! rate_const*ISOPBO2*NO + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 248)*sol(:ncol,:, 133) ! rate_const*ISOPBO2*NO3 + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 101)*sol(:ncol,:, 263) ! rate_const*ISOPNITA*OH + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 102)*sol(:ncol,:, 263) ! rate_const*ISOPNITB*OH + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 100)*sol(:ncol,:, 133) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 103)*sol(:ncol,:, 238) ! rate_const*ISOPNO3*CH3CO3 + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 103)*sol(:ncol,:, 239) ! rate_const*ISOPNO3*CH3O2 + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 103)*sol(:ncol,:, 245) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 103)*sol(:ncol,:, 131) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 103)*sol(:ncol,:, 133) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 104)*sol(:ncol,:, 263) ! rate_const*ISOPNOOH*OH + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 100)*sol(:ncol,:, 142) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 100)*sol(:ncol,:, 263) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 106)*sol(:ncol,:, 263) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 122)*sol(:ncol,:, 263) ! rate_const*NC4CH2OH*OH + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 123)*sol(:ncol,:, 263) ! rate_const*NC4CHO*OH + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 271)*sol(:ncol,:, 238) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 271)*sol(:ncol,:, 239) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 271)*sol(:ncol,:, 245) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 271)*sol(:ncol,:, 131) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 271)*sol(:ncol,:, 133) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 223)*sol(:ncol,:, 263) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 231)*sol(:ncol,:, 245) ! rate_const*ACBZO2*HO2 + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 231)*sol(:ncol,:, 131) ! rate_const*ACBZO2*NO + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 8)*sol(:ncol,:, 263) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 233)*sol(:ncol,:, 245) ! rate_const*BENZO2*HO2 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 233)*sol(:ncol,:, 131) ! rate_const*BENZO2*NO + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 10)*sol(:ncol,:, 263) ! rate_const*BENZOOH*OH + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 24)*sol(:ncol,:, 263) ! rate_const*BZALD*OH + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 234)*sol(:ncol,:, 245) ! rate_const*BZOO*HO2 + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 25)*sol(:ncol,:, 263) ! rate_const*BZOOH*OH + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 234)*sol(:ncol,:, 131) ! rate_const*BZOO*NO + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 237)*sol(:ncol,:, 245) ! rate_const*C6H5O2*HO2 + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 237)*sol(:ncol,:, 131) ! rate_const*C6H5O2*NO + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 34)*sol(:ncol,:, 263) ! rate_const*C6H5OOH*OH + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 68)*sol(:ncol,:, 263) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 240)*sol(:ncol,:, 245) ! rate_const*DICARBO2*HO2 + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 240)*sol(:ncol,:, 131) ! rate_const*DICARBO2*NO + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 240)*sol(:ncol,:, 132) ! rate_const*M*DICARBO2*NO2 + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 250)*sol(:ncol,:, 245) ! rate_const*MALO2*HO2 + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 250)*sol(:ncol,:, 131) ! rate_const*MALO2*NO + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 250)*sol(:ncol,:, 132) ! rate_const*M*MALO2*NO2 + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 252)*sol(:ncol,:, 245) ! rate_const*MDIALO2*HO2 + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 252)*sol(:ncol,:, 131) ! rate_const*MDIALO2*NO + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 252)*sol(:ncol,:, 132) ! rate_const*M*MDIALO2*NO2 + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 265)*sol(:ncol,:, 245) ! rate_const*PHENO2*HO2 + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 265)*sol(:ncol,:, 131) ! rate_const*PHENO2*NO + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 150)*sol(:ncol,:, 263) ! rate_const*PHENOL*OH + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 149)*sol(:ncol,:, 132) ! rate_const*PHENO*NO2 + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 149)*sol(:ncol,:, 142) ! rate_const*PHENO*O3 + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 151)*sol(:ncol,:, 263) ! rate_const*PHENOOH*OH + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 231)*sol(:ncol,:, 132) ! rate_const*M*ACBZO2*NO2 + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 270)*sol(:ncol,:, 245) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 270)*sol(:ncol,:, 131) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 220)*sol(:ncol,:, 263) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 221)*sol(:ncol,:, 263) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 148) ! rate_const*M*PBZNIT + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 224)*sol(:ncol,:, 263) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 272)*sol(:ncol,:, 245) ! rate_const*XYLENO2*HO2 + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 272)*sol(:ncol,:, 131) ! rate_const*XYLENO2*NO + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 225)*sol(:ncol,:, 263) ! rate_const*XYLENOOH*OH + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 273)*sol(:ncol,:, 245) ! rate_const*XYLOLO2*HO2 + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 273)*sol(:ncol,:, 131) ! rate_const*XYLOLO2*NO + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 227)*sol(:ncol,:, 263) ! rate_const*XYLOL*OH + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 228)*sol(:ncol,:, 263) ! rate_const*XYLOLOOH*OH + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 6)*sol(:ncol,:, 133) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 6)*sol(:ncol,:, 142) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 6)*sol(:ncol,:, 263) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 116)*sol(:ncol,:, 133) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 116)*sol(:ncol,:, 142) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 116)*sol(:ncol,:, 263) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 258)*sol(:ncol,:, 239) ! rate_const*NTERPO2*CH3O2 + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 258)*sol(:ncol,:, 245) ! rate_const*NTERPO2*HO2 + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 258)*sol(:ncol,:, 131) ! rate_const*NTERPO2*NO + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 258)*sol(:ncol,:, 133) ! rate_const*NTERPO2*NO3 + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 135)*sol(:ncol,:, 263) ! rate_const*NTERPOOH*OH + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 268)*sol(:ncol,:, 239) ! rate_const*TERP2O2*CH3O2 + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 268)*sol(:ncol,:, 245) ! rate_const*TERP2O2*HO2 + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 268)*sol(:ncol,:, 131) ! rate_const*TERP2O2*NO + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 215)*sol(:ncol,:, 263) ! rate_const*TERP2OOH*OH + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 216)*sol(:ncol,:, 263) ! rate_const*TERPNIT*OH + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 269)*sol(:ncol,:, 239) ! rate_const*TERPO2*CH3O2 + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 269)*sol(:ncol,:, 245) ! rate_const*TERPO2*HO2 + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 269)*sol(:ncol,:, 131) ! rate_const*TERPO2*NO + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 217)*sol(:ncol,:, 263) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 218)*sol(:ncol,:, 133) ! rate_const*TERPROD1*NO3 + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 218)*sol(:ncol,:, 263) ! rate_const*TERPROD1*OH + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 219)*sol(:ncol,:, 263) ! rate_const*TERPROD2*OH + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 69)*sol(:ncol,:, 133) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 69)*sol(:ncol,:, 263) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 145)*sol(:ncol,:, 140) ! rate_const*OCS*O + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 145)*sol(:ncol,:, 263) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 158)*sol(:ncol,:, 141) ! rate_const*S*O2 + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 161)*sol(:ncol,:, 263) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 158)*sol(:ncol,:, 142) ! rate_const*S*O3 + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 160)*sol(:ncol,:, 21) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 160)*sol(:ncol,:, 61) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 158)*sol(:ncol,:, 263) ! rate_const*S*OH + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 160)*sol(:ncol,:, 132) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 160)*sol(:ncol,:, 141) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 160)*sol(:ncol,:, 142) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 160)*sol(:ncol,:, 144) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 160)*sol(:ncol,:, 263) ! rate_const*SO*OH + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 69)*sol(:ncol,:, 263) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 162)*sol(:ncol,:, 274) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 127)*sol(:ncol,:, 263) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 245) ! rate_const*HO2 + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 95) ! rate_const*HONITR + rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 101) ! rate_const*ISOPNITA + rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 102) ! rate_const*ISOPNITB + rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 122) ! rate_const*NC4CH2OH + rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 123) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 128) ! rate_const*NH4 + rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 132) ! rate_const*NO2 + rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 133) ! rate_const*NO3 + rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 135) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 146) ! rate_const*ONITR + rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 216) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 6)*sol(:ncol,:, 133) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 7)*sol(:ncol,:, 245) ! rate_const*BCARYO2VBS*HO2 + rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 7)*sol(:ncol,:, 131) ! rate_const*BCARYO2VBS*NO + rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 6)*sol(:ncol,:, 142) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 6)*sol(:ncol,:, 263) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 8)*sol(:ncol,:, 263) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 9)*sol(:ncol,:, 245) ! rate_const*BENZO2VBS*HO2 + rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 9)*sol(:ncol,:, 131) ! rate_const*BENZO2VBS*NO + rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 100)*sol(:ncol,:, 133) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 105)*sol(:ncol,:, 245) ! rate_const*ISOPO2VBS*HO2 + rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 105)*sol(:ncol,:, 131) ! rate_const*ISOPO2VBS*NO + rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 100)*sol(:ncol,:, 142) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 100)*sol(:ncol,:, 263) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 108)*sol(:ncol,:, 245) ! rate_const*IVOCbbO2VBS*HO2 + rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 108)*sol(:ncol,:, 131) ! rate_const*IVOCbbO2VBS*NO + rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 107)*sol(:ncol,:, 263) ! rate_const*IVOCbb*OH + rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 110)*sol(:ncol,:, 245) ! rate_const*IVOCffO2VBS*HO2 + rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 110)*sol(:ncol,:, 131) ! rate_const*IVOCffO2VBS*NO + rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 109)*sol(:ncol,:, 263) ! rate_const*IVOCff*OH + rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 116)*sol(:ncol,:, 133) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 117)*sol(:ncol,:, 245) ! rate_const*MTERPO2VBS*HO2 + rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 117)*sol(:ncol,:, 131) ! rate_const*MTERPO2VBS*NO + rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 116)*sol(:ncol,:, 142) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 116)*sol(:ncol,:, 263) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 212)*sol(:ncol,:, 263) ! rate_const*SVOCbb*OH + rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 213)*sol(:ncol,:, 263) ! rate_const*SVOCff*OH + rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 221)*sol(:ncol,:, 263) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 222)*sol(:ncol,:, 245) ! rate_const*TOLUO2VBS*HO2 + rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 222)*sol(:ncol,:, 131) ! rate_const*TOLUO2VBS*NO + rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 77) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 224)*sol(:ncol,:, 263) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 584) = rxt_rates(:ncol,:, 584)*sol(:ncol,:, 226)*sol(:ncol,:, 245) ! rate_const*XYLEO2VBS*HO2 + rxt_rates(:ncol,:, 585) = rxt_rates(:ncol,:, 585)*sol(:ncol,:, 226)*sol(:ncol,:, 131) ! rate_const*XYLEO2VBS*NO + rxt_rates(:ncol,:, 586) = rxt_rates(:ncol,:, 586)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 587) = rxt_rates(:ncol,:, 587)*sol(:ncol,:, 94)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 588) = rxt_rates(:ncol,:, 588)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 589) = rxt_rates(:ncol,:, 589)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 590) = rxt_rates(:ncol,:, 590)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 591) = rxt_rates(:ncol,:, 591)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 592) = rxt_rates(:ncol,:, 592)*sol(:ncol,:, 62)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 593) = rxt_rates(:ncol,:, 593)*sol(:ncol,:, 94)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 594) = rxt_rates(:ncol,:, 594)*sol(:ncol,:, 93)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 595) = rxt_rates(:ncol,:, 595)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 596) = rxt_rates(:ncol,:, 596)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 597) = rxt_rates(:ncol,:, 597)*sol(:ncol,:, 62)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 598) = rxt_rates(:ncol,:, 598)*sol(:ncol,:, 94)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 599) = rxt_rates(:ncol,:, 599)*sol(:ncol,:, 93)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 600) = rxt_rates(:ncol,:, 600)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 601) = rxt_rates(:ncol,:, 601)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 602) = rxt_rates(:ncol,:, 602)*sol(:ncol,:, 62)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 603) = rxt_rates(:ncol,:, 603)*sol(:ncol,:, 256)*sol(:ncol,:, 241) ! rate_const*NOp*e + rxt_rates(:ncol,:, 604) = rxt_rates(:ncol,:, 604)*sol(:ncol,:, 262)*sol(:ncol,:, 241) ! rate_const*O2p*e + rxt_rates(:ncol,:, 605) = rxt_rates(:ncol,:, 605)*sol(:ncol,:, 255)*sol(:ncol,:, 241) ! rate_const*N2p*e + rxt_rates(:ncol,:, 606) = rxt_rates(:ncol,:, 606)*sol(:ncol,:, 255)*sol(:ncol,:, 141) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 607) = rxt_rates(:ncol,:, 607)*sol(:ncol,:, 255)*sol(:ncol,:, 140) ! rate_const*N2p*O + rxt_rates(:ncol,:, 608) = rxt_rates(:ncol,:, 608)*sol(:ncol,:, 255)*sol(:ncol,:, 140) ! rate_const*N2p*O + rxt_rates(:ncol,:, 609) = rxt_rates(:ncol,:, 609)*sol(:ncol,:, 257)*sol(:ncol,:, 140) ! rate_const*Np*O + rxt_rates(:ncol,:, 610) = rxt_rates(:ncol,:, 610)*sol(:ncol,:, 257)*sol(:ncol,:, 141) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 611) = rxt_rates(:ncol,:, 611)*sol(:ncol,:, 257)*sol(:ncol,:, 141) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 612) = rxt_rates(:ncol,:, 612)*sol(:ncol,:, 262)*sol(:ncol,:, 119) ! rate_const*O2p*N + rxt_rates(:ncol,:, 613) = rxt_rates(:ncol,:, 613)*sol(:ncol,:, 262) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 614) = rxt_rates(:ncol,:, 614)*sol(:ncol,:, 262)*sol(:ncol,:, 131) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 615) = rxt_rates(:ncol,:, 615)*sol(:ncol,:, 264)*sol(:ncol,:, 65) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 616) = rxt_rates(:ncol,:, 616)*sol(:ncol,:, 264) ! rate_const*N2*Op + rxt_rates(:ncol,:, 617) = rxt_rates(:ncol,:, 617)*sol(:ncol,:, 264)*sol(:ncol,:, 141) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 618) = rxt_rates(:ncol,:, 618)*sol(:ncol,:, 73) ! rate_const*E90 + rxt_rates(:ncol,:, 619) = rxt_rates(:ncol,:, 619)*sol(:ncol,:, 130) ! rate_const*NH_50 + rxt_rates(:ncol,:, 620) = rxt_rates(:ncol,:, 620)*sol(:ncol,:, 129) ! rate_const*NH_5 + rxt_rates(:ncol,:, 621) = rxt_rates(:ncol,:, 621)*sol(:ncol,:, 211) ! rate_const*ST80_25 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_setrxt.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_setrxt.F90 new file mode 100644 index 0000000000..eefe84491d --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_setrxt.F90 @@ -0,0 +1,757 @@ + + 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(:,171) = 0.000258_r8 + rate(:,172) = 0.085_r8 + rate(:,173) = 1.2e-10_r8 + rate(:,178) = 1.2e-10_r8 + rate(:,179) = 1e-20_r8 + rate(:,180) = 1.3e-16_r8 + rate(:,182) = 4.2e-13_r8 + rate(:,184) = 8e-14_r8 + rate(:,185) = 3.9e-17_r8 + rate(:,192) = 6.9e-12_r8 + rate(:,193) = 7.2e-11_r8 + rate(:,194) = 1.6e-12_r8 + rate(:,200) = 1.8e-12_r8 + rate(:,204) = 1.8e-12_r8 + rate(:,208) = 7e-13_r8 + rate(:,209) = 5e-12_r8 + rate(:,218) = 3.5e-12_r8 + rate(:,220) = 1.3e-11_r8 + rate(:,221) = 2.2e-11_r8 + rate(:,222) = 5e-11_r8 + rate(:,257) = 1.7e-13_r8 + rate(:,259) = 2.607e-10_r8 + rate(:,260) = 9.75e-11_r8 + rate(:,261) = 2.07e-10_r8 + rate(:,262) = 2.088e-10_r8 + rate(:,263) = 1.17e-10_r8 + rate(:,264) = 4.644e-11_r8 + rate(:,265) = 1.204e-10_r8 + rate(:,266) = 9.9e-11_r8 + rate(:,267) = 3.3e-12_r8 + rate(:,286) = 4.5e-11_r8 + rate(:,287) = 4.62e-10_r8 + rate(:,288) = 1.2e-10_r8 + rate(:,289) = 9e-11_r8 + rate(:,290) = 3e-11_r8 + rate(:,295) = 2.14e-11_r8 + rate(:,296) = 1.9e-10_r8 + rate(:,309) = 2.57e-10_r8 + rate(:,310) = 1.8e-10_r8 + rate(:,311) = 1.794e-10_r8 + rate(:,312) = 1.3e-10_r8 + rate(:,313) = 7.65e-11_r8 + rate(:,326) = 4e-13_r8 + rate(:,330) = 1.31e-10_r8 + rate(:,331) = 3.5e-11_r8 + rate(:,332) = 9e-12_r8 + rate(:,339) = 6.8e-14_r8 + rate(:,340) = 2e-13_r8 + rate(:,355) = 1e-12_r8 + rate(:,359) = 1e-14_r8 + rate(:,360) = 1e-11_r8 + rate(:,361) = 1.15e-11_r8 + rate(:,362) = 4e-14_r8 + rate(:,375) = 1.45e-10_r8 + rate(:,376) = 3e-12_r8 + rate(:,377) = 6.7e-13_r8 + rate(:,387) = 3.5e-13_r8 + rate(:,388) = 5.4e-11_r8 + rate(:,391) = 2e-12_r8 + rate(:,392) = 1.4e-11_r8 + rate(:,395) = 2.4e-12_r8 + rate(:,406) = 5e-12_r8 + rate(:,416) = 1.6e-12_r8 + rate(:,418) = 6.7e-12_r8 + rate(:,421) = 3.5e-12_r8 + rate(:,424) = 1.3e-11_r8 + rate(:,425) = 1.4e-11_r8 + rate(:,429) = 2.4e-12_r8 + rate(:,430) = 1.4e-11_r8 + rate(:,435) = 2.4e-12_r8 + rate(:,436) = 4e-11_r8 + rate(:,437) = 4e-11_r8 + rate(:,439) = 1.4e-11_r8 + rate(:,443) = 2.4e-12_r8 + rate(:,444) = 4e-11_r8 + rate(:,448) = 7e-11_r8 + rate(:,449) = 1e-10_r8 + rate(:,454) = 2.4e-12_r8 + rate(:,469) = 4.7e-11_r8 + rate(:,482) = 2.1e-12_r8 + rate(:,483) = 2.8e-13_r8 + rate(:,491) = 1.7e-11_r8 + rate(:,497) = 8.4e-11_r8 + rate(:,499) = 1.9e-11_r8 + rate(:,500) = 1.2e-14_r8 + rate(:,501) = 2e-10_r8 + rate(:,508) = 2.4e-12_r8 + rate(:,509) = 2e-11_r8 + rate(:,513) = 2.3e-11_r8 + rate(:,514) = 2e-11_r8 + rate(:,518) = 3.3e-11_r8 + rate(:,519) = 1e-12_r8 + rate(:,520) = 5.7e-11_r8 + rate(:,521) = 3.4e-11_r8 + rate(:,526) = 2.3e-12_r8 + rate(:,528) = 1.2e-11_r8 + rate(:,529) = 5.7e-11_r8 + rate(:,530) = 2.8e-11_r8 + rate(:,531) = 6.6e-11_r8 + rate(:,532) = 1.4e-11_r8 + rate(:,535) = 1.9e-12_r8 + rate(:,547) = 6.34e-08_r8 + rate(:,553) = 1.9e-11_r8 + rate(:,556) = 1.2e-14_r8 + rate(:,557) = 2e-10_r8 + rate(:,568) = 1.34e-11_r8 + rate(:,571) = 1.34e-11_r8 + rate(:,577) = 1.34e-11_r8 + rate(:,578) = 1.34e-11_r8 + rate(:,583) = 1.7e-11_r8 + rate(:,606) = 6e-11_r8 + rate(:,609) = 1e-12_r8 + rate(:,610) = 4e-10_r8 + rate(:,611) = 2e-10_r8 + rate(:,612) = 1e-10_r8 + rate(:,613) = 5e-16_r8 + rate(:,614) = 4.4e-10_r8 + rate(:,615) = 9e-10_r8 + rate(:,618) = 1.29e-07_r8 + rate(:,619) = 2.31e-07_r8 + rate(:,620) = 2.31e-06_r8 + rate(:,621) = 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(:,174) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,175) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:,176) = 2.64e-11_r8 * exp_fac(:) + rate(:,177) = 6.6e-12_r8 * exp_fac(:) + rate(:,181) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:,183) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:,186) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:,187) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,190) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + exp_fac(:) = exp( -2000._r8 * itemp(:) ) + rate(:,191) = 1.4e-12_r8 * exp_fac(:) + rate(:,445) = 1.05e-14_r8 * exp_fac(:) + rate(:,564) = 1.05e-14_r8 * exp_fac(:) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,196) = 3e-11_r8 * exp_fac(:) + rate(:,284) = 5.5e-12_r8 * exp_fac(:) + rate(:,323) = 3.8e-12_r8 * exp_fac(:) + rate(:,344) = 3.8e-12_r8 * exp_fac(:) + rate(:,371) = 3.8e-12_r8 * exp_fac(:) + rate(:,380) = 3.8e-12_r8 * exp_fac(:) + rate(:,384) = 3.8e-12_r8 * exp_fac(:) + rate(:,400) = 2.3e-11_r8 * exp_fac(:) + rate(:,410) = 3.8e-12_r8 * exp_fac(:) + rate(:,420) = 3.8e-12_r8 * exp_fac(:) + rate(:,447) = 1.52e-11_r8 * exp_fac(:) + rate(:,455) = 1.52e-12_r8 * exp_fac(:) + rate(:,461) = 3.8e-12_r8 * exp_fac(:) + rate(:,464) = 3.8e-12_r8 * exp_fac(:) + rate(:,468) = 3.8e-12_r8 * exp_fac(:) + rate(:,484) = 3.8e-12_r8 * exp_fac(:) + rate(:,488) = 3.8e-12_r8 * exp_fac(:) + rate(:,494) = 3.8e-12_r8 * exp_fac(:) + rate(:,498) = 3.8e-12_r8 * exp_fac(:) + rate(:,197) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,198) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,199) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,201) = 4.8e-11_r8 * exp_fac(:) + rate(:,282) = 1.7e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 180._r8 * itemp(:) ) + rate(:,202) = 1.8e-11_r8 * exp_fac(:) + rate(:,357) = 4.2e-12_r8 * exp_fac(:) + rate(:,370) = 4.2e-12_r8 * exp_fac(:) + rate(:,379) = 4.2e-12_r8 * exp_fac(:) + rate(:,408) = 4.2e-12_r8 * exp_fac(:) + rate(:,428) = 4.4e-12_r8 * exp_fac(:) + rate(:,434) = 4.4e-12_r8 * exp_fac(:) + rate(:,507) = 4.2e-12_r8 * exp_fac(:) + rate(:,512) = 4.2e-12_r8 * exp_fac(:) + rate(:,517) = 4.2e-12_r8 * exp_fac(:) + rate(:,203) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,207) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) + rate(:,210) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,211) = 2.9e-12_r8 * exp_fac(:) + rate(:,212) = 1.45e-12_r8 * exp_fac(:) + rate(:,213) = 1.45e-12_r8 * exp_fac(:) + rate(:,214) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:,215) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,216) = 1.2e-13_r8 * exp_fac(:) + rate(:,242) = 3e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,219) = 1.7e-11_r8 * exp_fac(:) + rate(:,317) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,223) = 3.44e-12_r8 * exp_fac(:) + rate(:,275) = 2.3e-12_r8 * exp_fac(:) + rate(:,278) = 8.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,224) = 3e-12_r8 * exp_fac(:) + rate(:,283) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,226) = 7.26e-11_r8 * exp_fac(:) + rate(:,227) = 4.64e-11_r8 * exp_fac(:) + rate(:,234) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,235) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,236) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,237) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,238) = 1.4e-11_r8 * exp_fac(:) + rate(:,252) = 7.4e-12_r8 * exp_fac(:) + rate(:,353) = 8.1e-12_r8 * exp_fac(:) + rate(:,239) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,240) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,241) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,243) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,244) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,245) = 2.6e-12_r8 * exp_fac(:) + rate(:,246) = 6.4e-12_r8 * exp_fac(:) + rate(:,276) = 4.1e-13_r8 * exp_fac(:) + rate(:,457) = 7.5e-12_r8 * exp_fac(:) + rate(:,471) = 7.5e-12_r8 * exp_fac(:) + rate(:,474) = 7.5e-12_r8 * exp_fac(:) + rate(:,477) = 7.5e-12_r8 * exp_fac(:) + rate(:,247) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,249) = 3.6e-12_r8 * exp_fac(:) + rate(:,298) = 2e-12_r8 * exp_fac(:) + rate(:,250) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,251) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,253) = 6e-13_r8 * exp_fac(:) + rate(:,273) = 1.5e-12_r8 * exp_fac(:) + rate(:,281) = 1.9e-11_r8 * exp_fac(:) + rate(:,254) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,255) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,256) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + exp_fac(:) = exp( -500._r8 * itemp(:) ) + rate(:,258) = 3e-12_r8 * exp_fac(:) + rate(:,292) = 1.4e-10_r8 * exp_fac(:) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,270) = 1.7e-11_r8 * exp_fac(:) + rate(:,297) = 6.3e-12_r8 * exp_fac(:) + rate(:,271) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,272) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,274) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + rate(:,277) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,280) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,285) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,291) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) + exp_fac(:) = exp( 0._r8 * itemp(:) ) + rate(:,293) = 1.4e-11_r8 * exp_fac(:) + rate(:,295) = 2.14e-11_r8 * exp_fac(:) + rate(:,296) = 1.9e-10_r8 * exp_fac(:) + rate(:,309) = 2.57e-10_r8 * exp_fac(:) + rate(:,310) = 1.8e-10_r8 * exp_fac(:) + rate(:,311) = 1.794e-10_r8 * exp_fac(:) + rate(:,312) = 1.3e-10_r8 * exp_fac(:) + rate(:,313) = 7.65e-11_r8 * exp_fac(:) + rate(:,326) = 4e-13_r8 * exp_fac(:) + rate(:,330) = 1.31e-10_r8 * exp_fac(:) + rate(:,331) = 3.5e-11_r8 * exp_fac(:) + rate(:,332) = 9e-12_r8 * exp_fac(:) + rate(:,339) = 6.8e-14_r8 * exp_fac(:) + rate(:,340) = 2e-13_r8 * exp_fac(:) + rate(:,355) = 1e-12_r8 * exp_fac(:) + rate(:,359) = 1e-14_r8 * exp_fac(:) + rate(:,360) = 1e-11_r8 * exp_fac(:) + rate(:,361) = 1.15e-11_r8 * exp_fac(:) + rate(:,362) = 4e-14_r8 * exp_fac(:) + rate(:,375) = 1.45e-10_r8 * exp_fac(:) + rate(:,376) = 3e-12_r8 * exp_fac(:) + rate(:,377) = 6.7e-13_r8 * exp_fac(:) + rate(:,387) = 3.5e-13_r8 * exp_fac(:) + rate(:,388) = 5.4e-11_r8 * exp_fac(:) + rate(:,391) = 2e-12_r8 * exp_fac(:) + rate(:,392) = 1.4e-11_r8 * exp_fac(:) + rate(:,395) = 2.4e-12_r8 * exp_fac(:) + rate(:,406) = 5e-12_r8 * exp_fac(:) + rate(:,416) = 1.6e-12_r8 * exp_fac(:) + rate(:,418) = 6.7e-12_r8 * exp_fac(:) + rate(:,421) = 3.5e-12_r8 * exp_fac(:) + rate(:,424) = 1.3e-11_r8 * exp_fac(:) + rate(:,425) = 1.4e-11_r8 * exp_fac(:) + rate(:,429) = 2.4e-12_r8 * exp_fac(:) + rate(:,430) = 1.4e-11_r8 * exp_fac(:) + rate(:,435) = 2.4e-12_r8 * exp_fac(:) + rate(:,436) = 4e-11_r8 * exp_fac(:) + rate(:,437) = 4e-11_r8 * exp_fac(:) + rate(:,439) = 1.4e-11_r8 * exp_fac(:) + rate(:,443) = 2.4e-12_r8 * exp_fac(:) + rate(:,444) = 4e-11_r8 * exp_fac(:) + rate(:,448) = 7e-11_r8 * exp_fac(:) + rate(:,449) = 1e-10_r8 * exp_fac(:) + rate(:,454) = 2.4e-12_r8 * exp_fac(:) + rate(:,469) = 4.7e-11_r8 * exp_fac(:) + rate(:,482) = 2.1e-12_r8 * exp_fac(:) + rate(:,483) = 2.8e-13_r8 * exp_fac(:) + rate(:,491) = 1.7e-11_r8 * exp_fac(:) + rate(:,497) = 8.4e-11_r8 * exp_fac(:) + rate(:,499) = 1.9e-11_r8 * exp_fac(:) + rate(:,500) = 1.2e-14_r8 * exp_fac(:) + rate(:,501) = 2e-10_r8 * exp_fac(:) + rate(:,508) = 2.4e-12_r8 * exp_fac(:) + rate(:,509) = 2e-11_r8 * exp_fac(:) + rate(:,513) = 2.3e-11_r8 * exp_fac(:) + rate(:,514) = 2e-11_r8 * exp_fac(:) + rate(:,518) = 3.3e-11_r8 * exp_fac(:) + rate(:,519) = 1e-12_r8 * exp_fac(:) + rate(:,520) = 5.7e-11_r8 * exp_fac(:) + rate(:,521) = 3.4e-11_r8 * exp_fac(:) + rate(:,526) = 2.3e-12_r8 * exp_fac(:) + rate(:,528) = 1.2e-11_r8 * exp_fac(:) + rate(:,529) = 5.7e-11_r8 * exp_fac(:) + rate(:,530) = 2.8e-11_r8 * exp_fac(:) + rate(:,531) = 6.6e-11_r8 * exp_fac(:) + rate(:,532) = 1.4e-11_r8 * exp_fac(:) + rate(:,535) = 1.9e-12_r8 * exp_fac(:) + rate(:,547) = 6.34e-08_r8 * exp_fac(:) + rate(:,553) = 1.9e-11_r8 * exp_fac(:) + rate(:,556) = 1.2e-14_r8 * exp_fac(:) + rate(:,557) = 2e-10_r8 * exp_fac(:) + rate(:,568) = 1.34e-11_r8 * exp_fac(:) + rate(:,571) = 1.34e-11_r8 * exp_fac(:) + rate(:,577) = 1.34e-11_r8 * exp_fac(:) + rate(:,578) = 1.34e-11_r8 * exp_fac(:) + rate(:,583) = 1.7e-11_r8 * exp_fac(:) + rate(:,606) = 6e-11_r8 * exp_fac(:) + rate(:,609) = 1e-12_r8 * exp_fac(:) + rate(:,610) = 4e-10_r8 * exp_fac(:) + rate(:,611) = 2e-10_r8 * exp_fac(:) + rate(:,612) = 1e-10_r8 * exp_fac(:) + rate(:,613) = 5e-16_r8 * exp_fac(:) + rate(:,614) = 4.4e-10_r8 * exp_fac(:) + rate(:,615) = 9e-10_r8 * exp_fac(:) + rate(:,618) = 1.29e-07_r8 * exp_fac(:) + rate(:,619) = 2.31e-07_r8 * exp_fac(:) + rate(:,620) = 2.31e-06_r8 * exp_fac(:) + rate(:,621) = 4.63e-07_r8 * exp_fac(:) + exp_fac(:) = exp( 400._r8 * itemp(:) ) + rate(:,294) = 6e-12_r8 * exp_fac(:) + rate(:,393) = 5e-13_r8 * exp_fac(:) + rate(:,426) = 5e-13_r8 * exp_fac(:) + rate(:,431) = 5e-13_r8 * exp_fac(:) + rate(:,440) = 5e-13_r8 * exp_fac(:) + rate(:,451) = 5e-13_r8 * exp_fac(:) + rate(:,299) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,300) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + exp_fac(:) = exp( -1520._r8 * itemp(:) ) + rate(:,301) = 1.64e-12_r8 * exp_fac(:) + rate(:,412) = 8.5e-16_r8 * exp_fac(:) + exp_fac(:) = exp( -1100._r8 * itemp(:) ) + rate(:,302) = 2.03e-11_r8 * exp_fac(:) + rate(:,534) = 3.4e-12_r8 * exp_fac(:) + rate(:,303) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,304) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,305) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,306) = 1.25e-12_r8 * exp_fac(:) + rate(:,316) = 3.4e-11_r8 * exp_fac(:) + rate(:,307) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,308) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,314) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) + rate(:,315) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,318) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) + rate(:,319) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) + rate(:,320) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + exp_fac(:) = exp( 300._r8 * itemp(:) ) + rate(:,321) = 2.8e-12_r8 * exp_fac(:) + rate(:,383) = 2.9e-12_r8 * exp_fac(:) + rate(:,322) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) + rate(:,324) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + exp_fac(:) = exp( 700._r8 * itemp(:) ) + rate(:,327) = 7.5e-13_r8 * exp_fac(:) + rate(:,341) = 7.5e-13_r8 * exp_fac(:) + rate(:,356) = 7.5e-13_r8 * exp_fac(:) + rate(:,369) = 7.5e-13_r8 * exp_fac(:) + rate(:,378) = 7.5e-13_r8 * exp_fac(:) + rate(:,382) = 8.6e-13_r8 * exp_fac(:) + rate(:,394) = 8e-13_r8 * exp_fac(:) + rate(:,407) = 7.5e-13_r8 * exp_fac(:) + rate(:,417) = 7.5e-13_r8 * exp_fac(:) + rate(:,427) = 8e-13_r8 * exp_fac(:) + rate(:,432) = 8e-13_r8 * exp_fac(:) + rate(:,441) = 8e-13_r8 * exp_fac(:) + rate(:,452) = 8e-13_r8 * exp_fac(:) + rate(:,459) = 7.5e-13_r8 * exp_fac(:) + rate(:,463) = 7.5e-13_r8 * exp_fac(:) + rate(:,466) = 7.5e-13_r8 * exp_fac(:) + rate(:,479) = 7.5e-13_r8 * exp_fac(:) + rate(:,486) = 7.5e-13_r8 * exp_fac(:) + rate(:,492) = 7.5e-13_r8 * exp_fac(:) + rate(:,495) = 7.5e-13_r8 * exp_fac(:) + rate(:,506) = 7.5e-13_r8 * exp_fac(:) + rate(:,511) = 7.5e-13_r8 * exp_fac(:) + rate(:,516) = 7.5e-13_r8 * exp_fac(:) + rate(:,559) = 7.5e-13_r8 * exp_fac(:) + rate(:,566) = 7.5e-13_r8 * exp_fac(:) + rate(:,569) = 7.5e-13_r8 * exp_fac(:) + rate(:,580) = 7.5e-13_r8 * exp_fac(:) + rate(:,584) = 7.5e-13_r8 * exp_fac(:) + rate(:,328) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) + rate(:,329) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) + rate(:,333) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) + rate(:,338) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + exp_fac(:) = exp( 365._r8 * itemp(:) ) + rate(:,342) = 2.6e-12_r8 * exp_fac(:) + rate(:,460) = 2.6e-12_r8 * exp_fac(:) + rate(:,465) = 2.6e-12_r8 * exp_fac(:) + rate(:,467) = 2.6e-12_r8 * exp_fac(:) + rate(:,480) = 2.6e-12_r8 * exp_fac(:) + rate(:,487) = 2.6e-12_r8 * exp_fac(:) + rate(:,493) = 2.6e-12_r8 * exp_fac(:) + rate(:,496) = 2.6e-12_r8 * exp_fac(:) + rate(:,560) = 2.6e-12_r8 * exp_fac(:) + rate(:,567) = 2.6e-12_r8 * exp_fac(:) + rate(:,570) = 2.6e-12_r8 * exp_fac(:) + rate(:,581) = 2.6e-12_r8 * exp_fac(:) + rate(:,585) = 2.6e-12_r8 * exp_fac(:) + rate(:,343) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,345) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,346) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + exp_fac(:) = exp( -1900._r8 * itemp(:) ) + rate(:,347) = 1.4e-12_r8 * exp_fac(:) + rate(:,367) = 6.5e-15_r8 * exp_fac(:) + exp_fac(:) = exp( 350._r8 * itemp(:) ) + rate(:,348) = 4.63e-12_r8 * exp_fac(:) + rate(:,563) = 2.7e-12_r8 * exp_fac(:) + rate(:,349) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) + exp_fac(:) = exp( 500._r8 * itemp(:) ) + rate(:,350) = 2.9e-12_r8 * exp_fac(:) + rate(:,351) = 2e-12_r8 * exp_fac(:) + rate(:,381) = 7.1e-13_r8 * exp_fac(:) + rate(:,402) = 2e-12_r8 * exp_fac(:) + rate(:,505) = 2e-12_r8 * exp_fac(:) + rate(:,510) = 2e-12_r8 * exp_fac(:) + rate(:,515) = 2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 1040._r8 * itemp(:) ) + rate(:,352) = 4.3e-13_r8 * exp_fac(:) + rate(:,403) = 4.3e-13_r8 * exp_fac(:) + rate(:,456) = 4.3e-13_r8 * exp_fac(:) + rate(:,470) = 4.3e-13_r8 * exp_fac(:) + rate(:,473) = 4.3e-13_r8 * exp_fac(:) + rate(:,476) = 4.3e-13_r8 * exp_fac(:) + rate(:,354) = 3.15e-14_r8 * exp( 920._r8 * itemp(:) ) + rate(:,358) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,366) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,368) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,372) = 9.19e-12_r8 * exp( -630._r8 * itemp(:) ) + rate(:,373) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) + rate(:,374) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + rate(:,389) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) + rate(:,390) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) + exp_fac(:) = exp( 360._r8 * itemp(:) ) + rate(:,396) = 2.7e-12_r8 * exp_fac(:) + rate(:,397) = 1.3e-13_r8 * exp_fac(:) + rate(:,399) = 9.6e-12_r8 * exp_fac(:) + rate(:,405) = 5.3e-12_r8 * exp_fac(:) + rate(:,442) = 2.7e-12_r8 * exp_fac(:) + rate(:,453) = 2.7e-12_r8 * exp_fac(:) + rate(:,555) = 2.7e-12_r8 * exp_fac(:) + rate(:,574) = 2.7e-12_r8 * exp_fac(:) + rate(:,398) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) + exp_fac(:) = exp( 530._r8 * itemp(:) ) + rate(:,401) = 4.6e-12_r8 * exp_fac(:) + rate(:,404) = 2.3e-12_r8 * exp_fac(:) + rate(:,409) = 2.3e-12_r8 * exp( -170._r8 * itemp(:) ) + rate(:,413) = 4.13e-12_r8 * exp( 452._r8 * itemp(:) ) + rate(:,419) = 5.4e-14_r8 * exp( 870._r8 * itemp(:) ) + exp_fac(:) = exp( 175._r8 * itemp(:) ) + rate(:,422) = 1.86e-11_r8 * exp_fac(:) + rate(:,423) = 1.86e-11_r8 * exp_fac(:) + rate(:,433) = 1.6e+09_r8 * exp( -8300._r8 * itemp(:) ) + exp_fac(:) = exp( -446._r8 * itemp(:) ) + rate(:,438) = 3.03e-12_r8 * exp_fac(:) + rate(:,561) = 3.03e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 410._r8 * itemp(:) ) + rate(:,446) = 2.54e-11_r8 * exp_fac(:) + rate(:,565) = 2.54e-11_r8 * exp_fac(:) + rate(:,450) = 1.3e-12_r8 * exp( 640._r8 * itemp(:) ) + exp_fac(:) = exp( -193._r8 * itemp(:) ) + rate(:,458) = 2.3e-12_r8 * exp_fac(:) + rate(:,558) = 2.3e-12_r8 * exp_fac(:) + rate(:,462) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) + rate(:,481) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) + exp_fac(:) = exp( 352._r8 * itemp(:) ) + rate(:,489) = 1.7e-12_r8 * exp_fac(:) + rate(:,579) = 1.7e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 490._r8 * itemp(:) ) + rate(:,502) = 1.2e-12_r8 * exp_fac(:) + rate(:,572) = 1.2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -580._r8 * itemp(:) ) + rate(:,503) = 6.3e-16_r8 * exp_fac(:) + rate(:,575) = 6.3e-16_r8 * exp_fac(:) + exp_fac(:) = exp( 440._r8 * itemp(:) ) + rate(:,504) = 1.2e-11_r8 * exp_fac(:) + rate(:,576) = 1.2e-11_r8 * exp_fac(:) + rate(:,522) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,523) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,524) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,525) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,533) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,536) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) + rate(:,539) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + exp_fac(:) = exp( 1300._r8 * itemp(:) ) + rate(:,554) = 2.75e-13_r8 * exp_fac(:) + rate(:,562) = 2.12e-13_r8 * exp_fac(:) + rate(:,573) = 2.6e-13_r8 * exp_fac(:) + + 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(:,195), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,205), 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(:,217), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,225), 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(:,228), 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(:,229), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,230), 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(:,248), 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(:,268), 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(:,279), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.1e-33_r8 * itemp(:)**1.5_r8 + kinf(:) = 9.8e-15_r8 * itemp(:)**(-4.6_r8) + call jpl( rate(:,325), m, 0.8_r8, ko, kinf, n ) + + ko(:) = 5.2e-30_r8 * itemp(:)**2.4_r8 + kinf(:) = 2.2e-10_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,335), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.5e-30_r8 + kinf(:) = 8.3e-13_r8 * itemp(:)**(-2._r8) + call jpl( rate(:,336), 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(:,337), 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(:,363), 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(:,364), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,385), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,411), 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(:,414), m, 0.6_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(:,472), m, 0.6_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(:,475), m, 0.6_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(:,478), m, 0.6_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(:,485), 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(:,527), 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,179) = 1e-20_r8 + rate(:n,180) = 1.3e-16_r8 + rate(:n,184) = 8e-14_r8 + rate(:n,185) = 3.9e-17_r8 + rate(:n,192) = 6.9e-12_r8 + rate(:n,208) = 7e-13_r8 + rate(:n,209) = 5e-12_r8 + rate(:n,606) = 6e-11_r8 + rate(:n,609) = 1e-12_r8 + rate(:n,610) = 4e-10_r8 + rate(:n,611) = 2e-10_r8 + rate(:n,612) = 1e-10_r8 + rate(:n,614) = 4.4e-10_r8 + + do k = 1,kbot + offset = (k-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,k) + end do + + rate(:n,175) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:n,176) = 2.64e-11_r8 * exp_fac(:) + rate(:n,177) = 6.6e-12_r8 * exp_fac(:) + rate(:n,181) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:n,183) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:n,186) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:n,187) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,196) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,197) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,198) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,201) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,202) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,203) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,210) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,214) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:n,215) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,223) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) + rate(:n,224) = 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,195) = wrk(:) + + + + + + + + + + + + + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_sim_dat.F90 b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_sim_dat.F90 new file mode 100644 index 0000000000..f9c4153577 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam4_vbsext/mo_sim_dat.F90 @@ -0,0 +1,963 @@ + + 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, 272, 0 /) + + cls_rxt_cnt(:,1) = (/ 9, 0, 0, 2 /) + cls_rxt_cnt(:,4) = (/ 8, 205, 408, 272 /) + + solsym(:274) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','bc_a1 ','bc_a4 ', & + 'BCARY ','BCARYO2VBS ','BENZENE ','BENZO2VBS ','BENZOOH ', & + 'BEPOMUC ','BIGALD ','BIGALD1 ','BIGALD2 ','BIGALD3 ', & + 'BIGALD4 ','BIGALK ','BIGENE ','BR ','BRCL ', & + 'BRO ','BRONO2 ','BRY ','BZALD ','BZOOH ', & + 'C2H2 ','C2H4 ','C2H5OH ','C2H5OOH ','C2H6 ', & + 'C3H6 ','C3H7OOH ','C3H8 ','C6H5OOH ','CCL4 ', & + 'CF2CLBR ','CF3BR ','CFC11 ','CFC113 ','CFC114 ', & + 'CFC115 ','CFC12 ','CH2BR2 ','CH2O ','CH3BR ', & + 'CH3CCL3 ','CH3CHO ','CH3CL ','CH3CN ','CH3COCH3 ', & + 'CH3COCHO ','CH3COOH ','CH3COOOH ','CH3OH ','CH3OOH ', & + 'CH4 ','CHBR3 ','CL ','CL2 ','CL2O2 ', & + 'CLO ','CLONO2 ','CLY ','CO ','CO2 ', & + 'COF2 ','COFCL ','CRESOL ','DMS ','dst_a1 ', & + 'dst_a2 ','dst_a3 ','E90 ','EOOH ','F ', & + 'GLYALD ','GLYOXAL ','H ','H2 ','H2402 ', & + 'H2O2 ','H2SO4 ','HBR ','HCFC141B ','HCFC142B ', & + 'HCFC22 ','HCL ','HCN ','HCOOH ','HF ', & + 'HNO3 ','HO2NO2 ','HOBR ','HOCL ','HONITR ', & + 'HPALD ','HYAC ','HYDRALD ','IEPOX ','ISOP ', & + 'ISOPNITA ','ISOPNITB ','ISOPNO3 ','ISOPNOOH ','ISOPO2VBS ', & + 'ISOPOOH ','IVOCbb ','IVOCbbO2VBS ','IVOCff ','IVOCffO2VBS ', & + 'MACR ','MACROOH ','MEK ','MEKOOH ','MPAN ', & + 'MTERP ','MTERPO2VBS ','MVK ','N ','N2O ', & + 'N2O5 ','NC4CH2OH ','NC4CHO ','ncl_a1 ','ncl_a2 ', & + 'ncl_a3 ','NH3 ','NH4 ','NH_5 ','NH_50 ', & + 'NO ','NO2 ','NO3 ','NOA ','NTERPOOH ', & + 'num_a1 ','num_a2 ','num_a3 ','num_a4 ','O ', & + 'O2 ','O3 ','O3S ','OCLO ','OCS ', & + 'ONITR ','PAN ','PBZNIT ','PHENO ','PHENOL ', & + 'PHENOOH ','pombb1_a1 ','pombb1_a4 ','pomff1_a1 ','pomff1_a4 ', & + 'POOH ','ROOH ','S ','SF6 ','SO ', & + 'SO2 ','SO3 ','so4_a1 ','so4_a2 ','so4_a3 ', & + 'soabb1_a1 ','soabb1_a2 ','soabb2_a1 ','soabb2_a2 ','soabb3_a1 ', & + 'soabb3_a2 ','soabb4_a1 ','soabb4_a2 ','soabb5_a1 ','soabb5_a2 ', & + 'soabg1_a1 ','soabg1_a2 ','soabg2_a1 ','soabg2_a2 ','soabg3_a1 ', & + 'soabg3_a2 ','soabg4_a1 ','soabg4_a2 ','soabg5_a1 ','soabg5_a2 ', & + 'soaff1_a1 ','soaff1_a2 ','soaff2_a1 ','soaff2_a2 ','soaff3_a1 ', & + 'soaff3_a2 ','soaff4_a1 ','soaff4_a2 ','soaff5_a1 ','soaff5_a2 ', & + 'SOAGbb0 ','SOAGbb1 ','SOAGbb2 ','SOAGbb3 ','SOAGbb4 ', & + 'SOAGbg0 ','SOAGbg1 ','SOAGbg2 ','SOAGbg3 ','SOAGbg4 ', & + 'SOAGff0 ','SOAGff1 ','SOAGff2 ','SOAGff3 ','SOAGff4 ', & + 'ST80_25 ','SVOCbb ','SVOCff ','TEPOMUC ','TERP2OOH ', & + 'TERPNIT ','TERPOOH ','TERPROD1 ','TERPROD2 ','TOLOOH ', & + 'TOLUENE ','TOLUO2VBS ','XOOH ','XYLENES ','XYLENOOH ', & + 'XYLEO2VBS ','XYLOL ','XYLOLOOH ','NHDEP ','NDEP ', & + 'ACBZO2 ','ALKO2 ','BENZO2 ','BZOO ','C2H5O2 ', & + 'C3H7O2 ','C6H5O2 ','CH3CO3 ','CH3O2 ','DICARBO2 ', & + 'e ','ENEO2 ','EO ','EO2 ','HO2 ', & + 'HOCH2OO ','ISOPAO2 ','ISOPBO2 ','MACRO2 ','MALO2 ', & + 'MCO3 ','MDIALO2 ','MEKO2 ','N2D ','N2p ', & + 'NOp ','Np ','NTERPO2 ','O1D ','O2_1D ', & + 'O2_1S ','O2p ','OH ','Op ','PHENO2 ', & + 'PO2 ','RO2 ','TERP2O2 ','TERPO2 ','TOLO2 ', & + 'XO2 ','XYLENO2 ','XYLOLO2 ','H2O ' /) + + adv_mass(:274) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 12.011000_r8, 12.011000_r8, & + 204.342600_r8, 253.348200_r8, 78.110400_r8, 159.114800_r8, 160.122200_r8, & + 126.108600_r8, 98.098200_r8, 84.072400_r8, 98.098200_r8, 98.098200_r8, & + 112.124000_r8, 72.143800_r8, 56.103200_r8, 79.904000_r8, 115.356700_r8, & + 95.903400_r8, 141.908940_r8, 99.716850_r8, 106.120800_r8, 124.135000_r8, & + 26.036800_r8, 28.051600_r8, 46.065800_r8, 62.065200_r8, 30.066400_r8, & + 42.077400_r8, 76.091000_r8, 44.092200_r8, 110.109200_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, 41.050940_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, & + 66.007206_r8, 82.461503_r8, 108.135600_r8, 62.132400_r8, 135.064039_r8, & + 135.064039_r8, 135.064039_r8, 28.010400_r8, 78.064600_r8, 18.998403_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, 27.025140_r8, 46.024600_r8, 20.005803_r8, & + 63.012340_r8, 79.011740_r8, 96.910800_r8, 52.459500_r8, 135.114940_r8, & + 116.112400_r8, 74.076200_r8, 100.113000_r8, 118.127200_r8, 68.114200_r8, & + 147.125940_r8, 147.125940_r8, 162.117940_r8, 163.125340_r8, 117.119800_r8, & + 118.127200_r8, 184.350200_r8, 233.355800_r8, 184.350200_r8, 233.355800_r8, & + 70.087800_r8, 120.100800_r8, 72.102600_r8, 104.101400_r8, 147.084740_r8, & + 136.228400_r8, 185.234000_r8, 70.087800_r8, 14.006740_r8, 44.012880_r8, & + 108.010480_r8, 147.125940_r8, 145.111140_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, 231.239540_r8, & + 1.007400_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, 15.999400_r8, & + 31.998800_r8, 47.998200_r8, 47.998200_r8, 67.451500_r8, 60.076400_r8, & + 133.100140_r8, 121.047940_r8, 183.117740_r8, 93.102400_r8, 94.109800_r8, & + 176.121600_r8, 12.011000_r8, 12.011000_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, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 28.010400_r8, 310.582400_r8, 310.582400_r8, 140.134400_r8, 200.226000_r8, & + 215.240140_r8, 186.241400_r8, 168.227200_r8, 154.201400_r8, 174.148000_r8, & + 92.136200_r8, 173.140600_r8, 150.126000_r8, 106.162000_r8, 188.173800_r8, & + 187.166400_r8, 122.161400_r8, 204.173200_r8, 14.006740_r8, 14.006740_r8, & + 137.112200_r8, 103.135200_r8, 159.114800_r8, 123.127600_r8, 61.057800_r8, & + 75.083600_r8, 109.101800_r8, 75.042400_r8, 47.032000_r8, 129.089600_r8, & + 0.548567E-03_r8, 105.108800_r8, 61.057800_r8, 77.057200_r8, 33.006200_r8, & + 63.031400_r8, 117.119800_r8, 117.119800_r8, 119.093400_r8, 115.063800_r8, & + 101.079200_r8, 117.078600_r8, 103.094000_r8, 14.006740_r8, 28.013480_r8, & + 30.006140_r8, 14.006740_r8, 230.232140_r8, 15.999400_r8, 31.998800_r8, & + 31.998800_r8, 31.998800_r8, 17.006800_r8, 15.999400_r8, 175.114200_r8, & + 91.083000_r8, 89.068200_r8, 199.218600_r8, 185.234000_r8, 173.140600_r8, & + 149.118600_r8, 187.166400_r8, 203.165800_r8, 18.014200_r8 /) + + crb_mass(:274) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 180.165000_r8, 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, & + 72.066000_r8, 60.055000_r8, 48.044000_r8, 60.055000_r8, 60.055000_r8, & + 72.066000_r8, 60.055000_r8, 48.044000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 84.077000_r8, 84.077000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 36.033000_r8, 36.033000_r8, 36.033000_r8, 72.066000_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, 24.022000_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, & + 12.011000_r8, 12.011000_r8, 84.077000_r8, 24.022000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_r8, 24.022000_r8, 0.000000_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, 12.011000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 48.044000_r8, & + 60.055000_r8, 36.033000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 156.143000_r8, 156.143000_r8, 156.143000_r8, 156.143000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 120.110000_r8, 120.110000_r8, 48.044000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 60.055000_r8, 60.055000_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, 120.110000_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, 84.077000_r8, 72.066000_r8, 72.066000_r8, & + 72.066000_r8, 12.011000_r8, 12.011000_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, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 12.011000_r8, 264.242000_r8, 264.242000_r8, 84.077000_r8, 120.110000_r8, & + 120.110000_r8, 120.110000_r8, 120.110000_r8, 108.099000_r8, 84.077000_r8, & + 84.077000_r8, 84.077000_r8, 60.055000_r8, 96.088000_r8, 96.088000_r8, & + 96.088000_r8, 96.088000_r8, 96.088000_r8, 0.000000_r8, 0.000000_r8, & + 84.077000_r8, 60.055000_r8, 72.066000_r8, 84.077000_r8, 24.022000_r8, & + 36.033000_r8, 72.066000_r8, 24.022000_r8, 12.011000_r8, 60.055000_r8, & + 0.000000_r8, 48.044000_r8, 24.022000_r8, 24.022000_r8, 0.000000_r8, & + 12.011000_r8, 60.055000_r8, 60.055000_r8, 48.044000_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, 120.110000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 72.066000_r8, & + 36.033000_r8, 36.033000_r8, 120.110000_r8, 120.110000_r8, 84.077000_r8, & + 60.055000_r8, 96.088000_r8, 96.088000_r8, 0.000000_r8 /) + + fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) + + clsmap(: 2,1) = (/ 229, 230 /) + clsmap(:272,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, 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, 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 /) + + permute(:272,4) = (/ 190, 189, 1, 2, 3, 222, 71, 104, 81, 156, & + 105, 149, 162, 133, 186, 144, 117, 147, 254, 118, & + 256, 175, 4, 120, 140, 130, 174, 128, 141, 131, & + 232, 151, 132, 129, 88, 98, 99, 92, 100, 93, & + 101, 94, 165, 270, 180, 95, 233, 146, 89, 227, & + 243, 194, 181, 205, 152, 257, 153, 263, 107, 90, & + 266, 228, 5, 234, 250, 122, 124, 112, 136, 6, & + 7, 8, 9, 102, 214, 235, 224, 260, 251, 91, & + 185, 103, 207, 123, 125, 137, 253, 110, 216, 135, & + 259, 164, 202, 208, 237, 121, 238, 142, 96, 213, & + 182, 178, 241, 157, 72, 195, 65, 64, 80, 79, & + 242, 143, 171, 145, 184, 221, 73, 247, 220, 126, & + 134, 155, 231, 10, 11, 12, 87, 13, 14, 15, & + 267, 271, 268, 212, 154, 16, 17, 18, 19, 262, & + 255, 265, 20, 138, 148, 119, 177, 97, 166, 106, & + 139, 21, 22, 23, 24, 176, 150, 197, 25, 252, & + 219, 127, 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, & + 66, 67, 68, 69, 70, 74, 75, 76, 77, 78, & + 82, 83, 84, 113, 192, 187, 167, 226, 230, 183, & + 111, 85, 114, 115, 196, 86, 116, 158, 172, 223, & + 168, 159, 215, 218, 188, 249, 258, 201, 211, 179, & + 163, 203, 269, 160, 244, 245, 246, 198, 248, 217, & + 191, 173, 193, 209, 169, 229, 264, 108, 109, 210, & + 261, 204, 161, 206, 239, 236, 225, 199, 240, 200, & + 170, 272 /) + + diag_map(:272) = (/ 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, 69, 71, 72, 73, 74, 75, 76, & + 82, 88, 94, 95, 96, 97, 98, 99, 105, 107, & + 113, 114, 120, 126, 132, 138, 139, 142, 145, 148, & + 151, 155, 159, 163, 167, 171, 174, 177, 182, 187, & + 192, 197, 200, 204, 210, 214, 219, 221, 224, 226, & + 231, 238, 243, 247, 252, 260, 265, 268, 271, 274, & + 277, 282, 285, 290, 295, 300, 305, 309, 313, 317, & + 323, 329, 335, 338, 344, 347, 354, 360, 365, 371, & + 376, 381, 384, 389, 394, 399, 407, 415, 423, 429, & + 435, 441, 447, 453, 459, 465, 471, 477, 485, 491, & + 498, 504, 507, 512, 519, 526, 530, 539, 546, 554, & + 561, 567, 573, 578, 586, 594, 602, 610, 618, 626, & + 635, 642, 653, 662, 671, 678, 682, 690, 697, 708, & + 719, 726, 737, 747, 753, 764, 775, 782, 793, 809, & + 820, 829, 839, 847, 855, 860, 870, 879, 887, 895, & + 907, 915, 924, 941, 953, 962, 967, 977, 989,1001, & + 1020,1048,1072,1084,1092,1102,1110,1118,1132,1145, & + 1159,1175,1193,1202,1208,1220,1237,1250,1259,1275, & + 1295,1311,1323,1341,1374,1398,1418,1439,1470,1492, & + 1503,1518,1537,1553,1584,1607,1631,1684,1708,1730, & + 1904,1948,1995,2039,2104,2132,2239,2300,2421,2448, & + 2494,2522 /) + + extfrc_lst(: 25) = (/ 'CO ','bc_a4 ','num_a1 ','num_a2 ','num_a4 ', & + 'pombb1_a1 ','pombb1_a4 ','pomff1_a1 ','pomff1_a4 ','NO ', & + 'NO2 ','SO2 ','SVOCbb ','SVOCff ','so4_a1 ', & + 'so4_a2 ','bc_a1 ','e ','N ','N2D ', & + 'OH ','Op ','AOA_NH ','N2p ','Np ' /) + + frc_from_dataset(: 25) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .false., .false., .false., & + .false., .false., .false., .false., .false. /) + + inv_lst(: 2) = (/ 'M ', 'N2 ' /) + + slvd_lst(: 43) = (/ 'ACBZO2 ', 'ALKO2 ', 'BENZO2 ', 'BZOO ', 'C2H5O2 ', & + 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', 'CH3O2 ', 'DICARBO2 ', & + 'e ', 'ENEO2 ', 'EO ', 'EO2 ', 'HO2 ', & + 'HOCH2OO ', 'ISOPAO2 ', 'ISOPBO2 ', 'MACRO2 ', 'MALO2 ', & + 'MCO3 ', 'MDIALO2 ', 'MEKO2 ', 'N2D ', 'N2p ', & + 'NOp ', 'Np ', 'NTERPO2 ', 'O1D ', 'O2_1D ', & + 'O2_1S ', 'O2p ', 'OH ', 'Op ', 'PHENO2 ', & + 'PO2 ', 'RO2 ', 'TERP2O2 ', 'TERPO2 ', 'TOLO2 ', & + 'XO2 ', 'XYLENO2 ', 'XYLOLO2 ' /) + + 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_c ', & + 'jh2o_a ', 'jh2o2 ', & + 'jo2_b ', 'jo2_a ', & + 'jo3_a ', 'jo3_b ', & + 'jhno3 ', 'jho2no2_a ', & + 'jho2no2_b ', 'jn2o ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jno ', 'jno_i ', & + 'jno2 ', 'jno3_a ', & + 'jno3_b ', 'jalknit ', & + 'jalkooh ', 'jbenzooh ', & + 'jbepomuc ', 'jbigald ', & + 'jbigald1 ', 'jbigald2 ', & + 'jbigald3 ', 'jbigald4 ', & + 'jbzooh ', 'jc2h5ooh ', & + 'jc3h7ooh ', 'jc6h5ooh ', & + 'jch2o_b ', 'jch2o_a ', & + 'jch3cho ', 'jacet ', & + 'jmgly ', 'jch3co3h ', & + 'jch3ooh ', 'jch4_b ', & + 'jch4_a ', 'jco2 ', & + 'jeooh ', 'jglyald ', & + 'jglyoxal ', 'jhonitr ', & + 'jhpald ', 'jhyac ', & + 'jisopnooh ', 'jisopooh ', & + 'jmacr_a ', 'jmacr_b ', & + 'jmek ', 'jmekooh ', & + 'jmpan ', 'jmvk ', & + 'jnc4cho ', 'jnoa ', & + 'jnterpooh ', 'jonitr ', & + 'jpan ', 'jphenooh ', & + 'jpooh ', 'jrooh ', & + 'jtepomuc ', 'jterp2ooh ', & + 'jterpnit ', 'jterpooh ', & + 'jterprd1 ', 'jterprd2 ', & + 'jtolooh ', 'jxooh ', & + 'jxylenooh ', 'jxylolooh ', & + 'jbrcl ', 'jbro ', & + 'jbrono2_b ', 'jbrono2_a ', & + 'jccl4 ', 'jcf2clbr ', & + 'jcf3br ', 'jcfcl3 ', & + 'jcfc113 ', 'jcfc114 ', & + 'jcfc115 ', 'jcf2cl2 ', & + 'jch2br2 ', 'jch3br ', & + 'jch3ccl3 ', 'jch3cl ', & + 'jchbr3 ', 'jcl2 ', & + 'jcl2o2 ', 'jclo ', & + 'jclono2_a ', 'jclono2_b ', & + 'jcof2 ', 'jcofcl ', & + 'jh2402 ', 'jhbr ', & + 'jhcfc141b ', 'jhcfc142b ', & + 'jhcfc22 ', 'jhcl ', & + 'jhf ', 'jhobr ', & + 'jhocl ', 'joclo ', & + 'jsf6 ', 'jeuv_26 ', & + 'jeuv_4 ', 'jeuv_13 ', & + 'jeuv_11 ', 'jeuv_6 ', & + 'jeuv_10 ', 'jeuv_22 ', & + 'jeuv_23 ', 'jeuv_25 ', & + 'jeuv_18 ', 'jeuv_2 ', & + 'jeuv_1 ', 'jeuv_16 ', & + 'jeuv_15 ', 'jeuv_14 ', & + 'jeuv_3 ', 'jeuv_17 ', & + 'jeuv_9 ', 'jeuv_8 ', & + 'jeuv_7 ', 'jeuv_5 ', & + 'jeuv_19 ', 'jeuv_20 ', & + 'jeuv_21 ', 'jeuv_24 ', & + 'jeuv_12 ', 'jh2so4 ', & + 'jocs ', 'jso ', & + 'jso2 ', 'jso3 ', & + 'jsoabb1_a1 ', 'jsoabb1_a2 ', & + 'jsoabb2_a1 ', 'jsoabb2_a2 ', & + 'jsoabb3_a1 ', 'jsoabb3_a2 ', & + 'jsoabb4_a1 ', 'jsoabb4_a2 ', & + 'jsoabb5_a1 ', 'jsoabb5_a2 ', & + 'jsoabg1_a1 ', 'jsoabg1_a2 ', & + 'jsoabg2_a1 ', 'jsoabg2_a2 ', & + 'jsoabg3_a1 ', 'jsoabg3_a2 ', & + 'jsoabg4_a1 ', 'jsoabg4_a2 ', & + 'jsoabg5_a1 ', 'jsoabg5_a2 ', & + 'jsoaff1_a1 ', 'jsoaff1_a2 ', & + 'jsoaff2_a1 ', 'jsoaff2_a2 ', & + 'jsoaff3_a1 ', 'jsoaff3_a2 ', & + 'jsoaff4_a1 ', 'jsoaff4_a2 ', & + 'jsoaff5_a1 ', 'jsoaff5_a2 ', & + 'ag1 ', 'ag2 ', & + 'O1D_H2 ', 'O1D_H2O ', & + 'O1D_N2 ', 'O1D_O2 ', & + 'O1D_O2b ', 'O1D_O3 ', & + 'O2_1D_N2 ', 'O2_1D_O ', & + 'O2_1D_O2 ', 'O2_1S_CO2 ', & + 'O2_1S_N2 ', 'O2_1S_O ', & + 'O2_1S_O2 ', 'O2_1S_O3 ', & + '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 ' /) + rxt_tag_lst( 201: 400) = (/ 'OH_HO2 ', 'OH_O ', & + 'OH_O3 ', 'OH_OH ', & + 'OH_OH_M ', 'usr_HO2_HO2 ', & + 'HO2NO2_OH ', 'N2D_O ', & + 'N2D_O2 ', '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 ', & + 'F_CH4 ', 'F_H2 ', & + 'F_H2O ', 'F_HNO3 ', & + 'O1D_COF2 ', 'O1D_COFCL ', & + 'CH2BR2_CL ', 'CH2BR2_OH ', & + 'CH3BR_CL ', 'CH3BR_OH ', & + 'CH3CCL3_OH ', 'CH3CL_CL ', & + 'CH3CL_OH ', 'CHBR3_CL ', & + 'CHBR3_OH ', 'HCFC141B_OH ', & + 'HCFC142B_OH ', 'HCFC22_OH ', & + 'O1D_CH2BR2 ', 'O1D_CH3BR ', & + 'O1D_HCFC141B ', 'O1D_HCFC142B ', & + 'O1D_HCFC22 ', 'CH2O_HO2 ', & + 'CH2O_NO3 ', 'CH2O_O ', & + 'CH2O_OH ', 'CH3O2_CH3O2a ', & + 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & + 'CH3O2_NO ', 'CH3OH_OH ', & + 'CH3OOH_OH ', 'CH4_OH ', & + 'HCN_OH ', 'HCOOH_OH ', & + 'HOCH2OO_HO2 ', 'HOCH2OO_M ', & + 'HOCH2OO_NO ', 'O1D_CH4a ', & + 'O1D_CH4b ', 'O1D_CH4c ', & + 'O1D_HCN ', 'usr_CO_OH ', & + 'C2H2_CL_M ', 'C2H2_OH_M ', & + '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 ', & + 'CH3CN_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 ', & + 'CL_C3H8 ', 'HYAC_OH ', & + 'NOA_OH ', 'PO2_HO2 ', & + 'PO2_NO ', 'POOH_OH ', & + 'RO2_CH3O2 ', 'RO2_HO2 ', & + 'RO2_NO ', 'ROOH_OH ', & + 'tag_C3H6_OH ', 'usr_CH3COCH3_OH ', & + 'BIGENE_NO3 ', 'BIGENE_OH ', & + 'ENEO2_NO ', 'ENEO2_NOb ', & + 'HONITR_OH ', 'MACRO2_CH3CO3 ', & + 'MACRO2_CH3O2 ', 'MACRO2_HO2 ', & + 'MACRO2_NO3 ', 'MACRO2_NOa ', & + 'MACRO2_NOb ', 'MACR_O3 ', & + 'MACR_OH ', 'MACROOH_OH ' /) + rxt_tag_lst( 401: 600) = (/ 'MCO3_CH3CO3 ', 'MCO3_CH3O2 ', & + 'MCO3_HO2 ', 'MCO3_MCO3 ', & + 'MCO3_NO ', 'MCO3_NO3 ', & + 'MEKO2_HO2 ', 'MEKO2_NO ', & + 'MEK_OH ', 'MEKOOH_OH ', & + 'MPAN_OH_M ', 'MVK_O3 ', & + 'MVK_OH ', 'tag_MCO3_NO2 ', & + 'usr_MPAN_M ', 'ALKNIT_OH ', & + 'ALKO2_HO2 ', 'ALKO2_NO ', & + 'ALKO2_NOb ', 'ALKOOH_OH ', & + 'BIGALK_OH ', 'HPALD_OH ', & + 'HYDRALD_OH ', 'IEPOX_OH ', & + 'ISOPAO2_CH3CO3 ', 'ISOPAO2_CH3O2 ', & + 'ISOPAO2_HO2 ', 'ISOPAO2_NO ', & + 'ISOPAO2_NO3 ', 'ISOPBO2_CH3CO3 ', & + 'ISOPBO2_CH3O2 ', 'ISOPBO2_HO2 ', & + 'ISOPBO2_M ', 'ISOPBO2_NO ', & + 'ISOPBO2_NO3 ', 'ISOPNITA_OH ', & + 'ISOPNITB_OH ', 'ISOP_NO3 ', & + 'ISOPNO3_CH3CO3 ', 'ISOPNO3_CH3O2 ', & + 'ISOPNO3_HO2 ', 'ISOPNO3_NO ', & + 'ISOPNO3_NO3 ', 'ISOPNOOH_OH ', & + 'ISOP_O3 ', 'ISOP_OH ', & + 'ISOPOOH_OH ', 'NC4CH2OH_OH ', & + 'NC4CHO_OH ', 'XO2_CH3CO3 ', & + 'XO2_CH3O2 ', 'XO2_HO2 ', & + 'XO2_NO ', 'XO2_NO3 ', & + 'XOOH_OH ', 'ACBZO2_HO2 ', & + 'ACBZO2_NO ', 'BENZENE_OH ', & + 'BENZO2_HO2 ', 'BENZO2_NO ', & + 'BENZOOH_OH ', 'BZALD_OH ', & + 'BZOO_HO2 ', 'BZOOH_OH ', & + 'BZOO_NO ', 'C6H5O2_HO2 ', & + 'C6H5O2_NO ', 'C6H5OOH_OH ', & + 'CRESOL_OH ', 'DICARBO2_HO2 ', & + 'DICARBO2_NO ', 'DICARBO2_NO2 ', & + 'MALO2_HO2 ', 'MALO2_NO ', & + 'MALO2_NO2 ', 'MDIALO2_HO2 ', & + 'MDIALO2_NO ', 'MDIALO2_NO2 ', & + 'PHENO2_HO2 ', 'PHENO2_NO ', & + 'PHENOL_OH ', 'PHENO_NO2 ', & + 'PHENO_O3 ', 'PHENOOH_OH ', & + 'tag_ACBZO2_NO2 ', 'TOLO2_HO2 ', & + 'TOLO2_NO ', 'TOLOOH_OH ', & + 'TOLUENE_OH ', 'usr_PBZNIT_M ', & + 'XYLENES_OH ', 'XYLENO2_HO2 ', & + 'XYLENO2_NO ', 'XYLENOOH_OH ', & + 'XYLOLO2_HO2 ', 'XYLOLO2_NO ', & + 'XYLOL_OH ', 'XYLOLOOH_OH ', & + 'BCARY_NO3 ', 'BCARY_O3 ', & + 'BCARY_OH ', 'MTERP_NO3 ', & + 'MTERP_O3 ', 'MTERP_OH ', & + 'NTERPO2_CH3O2 ', 'NTERPO2_HO2 ', & + 'NTERPO2_NO ', 'NTERPO2_NO3 ', & + 'NTERPOOH_OH ', 'TERP2O2_CH3O2 ', & + 'TERP2O2_HO2 ', 'TERP2O2_NO ', & + 'TERP2OOH_OH ', 'TERPNIT_OH ', & + 'TERPO2_CH3O2 ', 'TERPO2_HO2 ', & + 'TERPO2_NO ', 'TERPOOH_OH ', & + 'TERPROD1_NO3 ', 'TERPROD1_OH ', & + 'TERPROD2_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_HONITR_aer ', 'usr_ISOPNITA_aer ', & + 'usr_ISOPNITB_aer ', 'usr_N2O5_aer ', & + 'usr_NC4CH2OH_aer ', 'usr_NC4CHO_aer ', & + 'usr_NH4_strat_tau ', 'usr_NO2_aer ', & + 'usr_NO3_aer ', 'usr_NTERPOOH_aer ', & + 'usr_ONITR_aer ', 'usr_TERPNIT_aer ', & + 'BCARY_NO3_vbs ', 'BCARYO2_HO2_vbs ', & + 'BCARYO2_NO_vbs ', 'BCARY_O3_vbs ', & + 'BCARY_OH_vbs ', 'BENZENE_OH_vbs ', & + 'BENZO2_HO2_vbs ', 'BENZO2_NO_vbs ', & + 'ISOP_NO3_vbs ', 'ISOPO2_HO2_vbs ', & + 'ISOPO2_NO_vbs ', 'ISOP_O3_vbs ', & + 'ISOP_OH_vbs ', 'IVOCbbO2_HO2_vbs ', & + 'IVOCbbO2_NO_vbs ', 'IVOCbb_OH_vbs ', & + 'IVOCffO2_HO2_vbs ', 'IVOCffO2_NO_vbs ', & + 'IVOCff_OH_vbs ', 'MTERP_NO3_vbs ', & + 'MTERPO2_HO2_vbs ', 'MTERPO2_NO_vbs ', & + 'MTERP_O3_vbs ', 'MTERP_OH_vbs ', & + 'SVOCbb_OH ', 'SVOCff_OH ', & + 'TOLUENE_OH_vbs ', 'TOLUO2_HO2_vbs ', & + 'TOLUO2_NO_vbs ', 'usr_GLYOXAL_aer ', & + 'XYLENES_OH_vbs ', 'XYLEO2_HO2_vbs ', & + 'XYLEO2_NO_vbs ', 'het1 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ' /) + rxt_tag_lst( 601: 621) = (/ 'het8 ', 'het9 ', & + 'elec1 ', 'elec2 ', & + 'elec3 ', 'ion_N2p_O2 ', & + 'ion_N2p_Oa ', 'ion_N2p_Ob ', & + 'ion_Np_O ', 'ion_Np_O2a ', & + 'ion_Np_O2b ', 'ion_O2p_N ', & + 'ion_O2p_N2 ', 'ion_O2p_NO ', & + 'ion_Op_CO2 ', 'ion_Op_N2 ', & + 'ion_Op_O2 ', '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, 364, 365, 366, 367, 368, 369, 370, & + 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, & + 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, & + 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, & + 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, & + 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, & + 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, & + 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, & + 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, & + 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, & + 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, & + 471, 472, 473, 474, 475, 476, 477, 478, 479, 480, & + 481, 482, 483, 484, 485, 486, 487, 488, 489, 490, & + 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, & + 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, & + 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, & + 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, & + 531, 532, 533, 534, 535, 536, 537, 538, 539, 540, & + 541, 542, 543, 544, 545, 546, 547, 548, 549, 550, & + 551, 552, 553, 554, 555, 556, 557, 558, 559, 560, & + 561, 562, 563, 564, 565, 566, 567, 568, 569, 570, & + 571, 572, 573, 574, 575, 576, 577, 578, 579, 580, & + 581, 582, 583, 584, 585, 586, 587, 588, 589, 590, & + 591, 592, 593, 594, 595, 596, 597, 598, 599, 600, & + 601, 602, 603, 604, 605, 606, 607, 608, 609, 610, & + 611, 612, 613, 614, 615, 616, 617, 618, 619, 620, & + 621 /) + 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 ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + ' ', ' ', ' ', ' ', & + ' ', 'jh2o2 ', ' ', ' ', & + ' ', ' ', 'jch3ooh ', ' ', & + 'jmgly ', 'jch2o_a ', 'jno2 ', ' ', & + 'jch3ooh ', 'jch3ooh ', ' ', ' ', & + 'jacet ', 'jch3ooh ', 'jpan ', ' ', & + 'jch2o_a ', 'jch2o_a ', 'jch3ooh ', 'jch3cho ', & + ' ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jno2 ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3cho ', 'jch3cho ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + '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, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 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, .10_r8, 0.2_r8, .14_r8, & + .20_r8, .20_r8, .006_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, .006_r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, .10_r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 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, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_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(:) = (/ 175, 176, 177, 179, 180, & + 181, 183, 184, 185, 186, & + 187, 188, 189, 192, 195, & + 196, 197, 198, 201, 202, & + 203, 206, 208, 209, 210, & + 214, 215, 223, 224, 603, & + 604, 605, 606, 607, 609, & + 610, 611, 612, 614, 616, & + 617 /) + cph_enthalpy(:) = (/ 189.810000_r8, 32.910000_r8, 189.810000_r8, 94.300000_r8, 94.300000_r8, & + 94.300000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, 62.600000_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, 229.610000_r8, 177.510000_r8, 313.750000_r8, & + 133.750000_r8, 193.020000_r8, 34.470000_r8, 199.170000_r8, 82.389000_r8, & + 508.950000_r8, 354.830000_r8, 339.590000_r8, 67.530000_r8, 95.550000_r8, & + 239.840000_r8, 646.280000_r8, 406.160000_r8, 271.380000_r8, 105.040000_r8, & + 150.110000_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(:) = (/ 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, & + 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, 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, 2, 2, 2, 3, 2, 2, 1, 2, 2, & + 2, 2, 2, 2, 3, 3, 3, 2, 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, 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, & + 3, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 1, 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, 3, 2, 2, 3, 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, 3, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 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, 1, 2, 2, 2, 1, 2, 1, 1, 1, & + 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, & + 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, & + 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/chem_mech.doc b/src/chemistry/pp_waccm_tsmlt_mam5/chem_mech.doc new file mode 100644 index 0000000000..7bbe88ba1b --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/chem_mech.doc @@ -0,0 +1,1949 @@ + + + Solution species + ( 1) ALKNIT (C5H11ONO2) + ( 2) ALKOOH (C5H12O2) + ( 3) AOA_NH (CO) + ( 4) bc_a1 (C) + ( 5) bc_a4 (C) + ( 6) BCARY (C15H24) + ( 7) BENZENE (C6H6) + ( 8) BENZOOH (C6H8O5) + ( 9) BEPOMUC (C6H6O3) + ( 10) BIGALD (C5H6O2) + ( 11) BIGALD1 (C4H4O2) + ( 12) BIGALD2 (C5H6O2) + ( 13) BIGALD3 (C5H6O2) + ( 14) BIGALD4 (C6H8O2) + ( 15) BIGALK (C5H12) + ( 16) BIGENE (C4H8) + ( 17) BR (Br) + ( 18) BRCL (BrCl) + ( 19) BRO (BrO) + ( 20) BRONO2 (BrONO2) + ( 21) BRY + ( 22) BZALD (C7H6O) + ( 23) BZOOH (C7H8O2) + ( 24) C2H2 + ( 25) C2H4 + ( 26) C2H5OH + ( 27) C2H5OOH + ( 28) C2H6 + ( 29) C3H6 + ( 30) C3H7OOH + ( 31) C3H8 + ( 32) C6H5OOH (C6H5OOH) + ( 33) CCL4 (CCl4) + ( 34) CF2CLBR (CF2ClBr) + ( 35) CF3BR (CF3Br) + ( 36) CFC11 (CFCl3) + ( 37) CFC113 (CCl2FCClF2) + ( 38) CFC114 (CClF2CClF2) + ( 39) CFC115 (CClF2CF3) + ( 40) CFC12 (CF2Cl2) + ( 41) CH2BR2 (CH2Br2) + ( 42) CH2O + ( 43) CH3BR (CH3Br) + ( 44) CH3CCL3 (CH3CCl3) + ( 45) CH3CHO + ( 46) CH3CL (CH3Cl) + ( 47) CH3CN + ( 48) CH3COCH3 + ( 49) CH3COCHO + ( 50) CH3COOH + ( 51) CH3COOOH + ( 52) CH3OH + ( 53) CH3OOH + ( 54) CH4 + ( 55) CHBR3 (CHBr3) + ( 56) CL (Cl) + ( 57) CL2 (Cl2) + ( 58) CL2O2 (Cl2O2) + ( 59) CLO (ClO) + ( 60) CLONO2 (ClONO2) + ( 61) CLY + ( 62) CO + ( 63) CO2 + ( 64) COF2 + ( 65) COFCL (COFCl) + ( 66) CRESOL (C7H8O) + ( 67) DMS (CH3SCH3) + ( 68) dst_a1 (AlSiO5) + ( 69) dst_a2 (AlSiO5) + ( 70) dst_a3 (AlSiO5) + ( 71) E90 (CO) + ( 72) EOOH (HOCH2CH2OOH) + ( 73) F + ( 74) GLYALD (HOCH2CHO) + ( 75) GLYOXAL (C2H2O2) + ( 76) H + ( 77) H2 + ( 78) H2402 (CBrF2CBrF2) + ( 79) H2O2 + ( 80) H2SO4 (H2SO4) + ( 81) HBR (HBr) + ( 82) HCFC141B (CH3CCl2F) + ( 83) HCFC142B (CH3CClF2) + ( 84) HCFC22 (CHF2Cl) + ( 85) HCL (HCl) + ( 86) HCN + ( 87) HCOOH + ( 88) HF + ( 89) HNO3 + ( 90) HO2 + ( 91) HO2NO2 + ( 92) HOBR (HOBr) + ( 93) HOCL (HOCl) + ( 94) HONITR (C4H9NO4) + ( 95) HPALD (HOOCH2CCH3CHCHO) + ( 96) HYAC (CH3COCH2OH) + ( 97) HYDRALD (HOCH2CCH3CHCHO) + ( 98) IEPOX (C5H10O3) + ( 99) ISOP (C5H8) + (100) ISOPNITA (C5H9NO4) + (101) ISOPNITB (C5H9NO4) + (102) ISOPNOOH (C5H9NO5) + (103) ISOPOOH (HOCH2COOHCH3CHCH2) + (104) IVOC (C13H28) + (105) MACR (CH2CCH3CHO) + (106) MACROOH (CH3COCHOOHCH2OH) + (107) MEK (C4H8O) + (108) MEKOOH (C4H8O3) + (109) MPAN (CH2CCH3CO3NO2) + (110) MTERP (C10H16) + (111) MVK (CH2CHCOCH3) + (112) N + (113) N2O + (114) N2O5 + (115) NC4CH2OH (C5H9NO4) + (116) NC4CHO (C5H7NO4) + (117) ncl_a1 (NaCl) + (118) ncl_a2 (NaCl) + (119) ncl_a3 (NaCl) + (120) NH3 + (121) NH4 + (122) NH_5 (CO) + (123) NH_50 (CO) + (124) NO + (125) NO2 + (126) NO3 + (127) NOA (CH3COCH2ONO2) + (128) NTERPOOH (C10H17NO5) + (129) num_a1 (H) + (130) num_a2 (H) + (131) num_a3 (H) + (132) num_a4 (H) + (133) num_a5 (H) + (134) O + (135) O2 + (136) O3 + (137) O3S (O3) + (138) OCLO (OClO) + (139) OCS (OCS) + (140) ONITR (C4H7NO4) + (141) PAN (CH3CO3NO2) + (142) PBZNIT (C7H5O3NO2) + (143) PHENO (C6H5O) + (144) PHENOL (C6H5OH) + (145) PHENOOH (C6H8O6) + (146) pom_a1 (C) + (147) pom_a4 (C) + (148) POOH (C3H6OHOOH) + (149) ROOH (CH3COCH2OOH) + (150) S (S) + (151) SF6 + (152) SO (SO) + (153) SO2 + (154) SO3 (SO3) + (155) so4_a1 (NH4HSO4) + (156) so4_a2 (NH4HSO4) + (157) so4_a3 (NH4HSO4) + (158) so4_a5 (NH4HSO4) + (159) soa1_a1 (C15H38O2) + (160) soa1_a2 (C15H38O2) + (161) soa2_a1 (C15H38O2) + (162) soa2_a2 (C15H38O2) + (163) soa3_a1 (C15H38O2) + (164) soa3_a2 (C15H38O2) + (165) soa4_a1 (C15H38O2) + (166) soa4_a2 (C15H38O2) + (167) soa5_a1 (C15H38O2) + (168) soa5_a2 (C15H38O2) + (169) SOAG0 (C15H38O2) + (170) SOAG1 (C15H38O2) + (171) SOAG2 (C15H38O2) + (172) SOAG3 (C15H38O2) + (173) SOAG4 (C15H38O2) + (174) ST80_25 (CO) + (175) SVOC (C22H46) + (176) TEPOMUC (C7H8O3) + (177) TERP2OOH (C10H16O4) + (178) TERPNIT (C10H17NO4) + (179) TERPOOH (C10H18O3) + (180) TERPROD1 (C10H16O2) + (181) TERPROD2 (C9H14O2) + (182) TOLOOH (C7H10O5) + (183) TOLUENE (C7H8) + (184) XOOH (HOCH2COOHCH3CHOHCHO) + (185) XYLENES (C8H10) + (186) XYLENOOH (C8H12O5) + (187) XYLOL (C8H10O) + (188) XYLOLOOH (C8H12O6) + (189) NHDEP (N) + (190) NDEP (N) + (191) ACBZO2 (C7H5O3) + (192) ALKO2 (C5H11O2) + (193) BCARYO2VBS (C15H25O3) + (194) BENZO2 (C6H7O5) + (195) BENZO2VBS (C6H7O5) + (196) BZOO (C7H7O2) + (197) C2H5O2 + (198) C3H7O2 + (199) C6H5O2 + (200) CH3CO3 + (201) CH3O2 + (202) DICARBO2 (C5H5O4) + (203) e (E) + (204) ENEO2 (C4H9O3) + (205) EO (HOCH2CH2O) + (206) EO2 (HOCH2CH2O2) + (207) HOCH2OO + (208) ISOPAO2 (HOC5H8O2) + (209) ISOPBO2 (HOC5H8O2) + (210) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + (211) ISOPO2VBS (C5H9O3) + (212) IVOCO2VBS (C13H29O3) + (213) MACRO2 (CH3COCHO2CH2OH) + (214) MALO2 (C4H3O4) + (215) MCO3 (CH2CCH3CO3) + (216) MDIALO2 (C4H5O4) + (217) MEKO2 (C4H7O3) + (218) MTERPO2VBS (C10H17O3) + (219) N2D (N) + (220) N2p (N2) + (221) NOp (NO) + (222) Np (N) + (223) NTERPO2 (C10H16NO5) + (224) O1D (O) + (225) O2_1D (O2) + (226) O2_1S (O2) + (227) O2p (O2) + (228) OH + (229) Op (O) + (230) PHENO2 (C6H7O6) + (231) PO2 (C3H6OHO2) + (232) RO2 (CH3COCH2O2) + (233) TERP2O2 (C10H15O4) + (234) TERPO2 (C10H17O3) + (235) TOLO2 (C7H9O5) + (236) TOLUO2VBS (C7H9O5) + (237) XO2 (HOCH2COOCH3CHOHCHO) + (238) XYLENO2 (C8H11O5) + (239) XYLEO2VBS (C8H11O5) + (240) XYLOLO2 (C8H11O6) + (241) H2O + + + Invariant species + ( 1) M + ( 2) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) NHDEP + ( 2) NDEP + + Implicit + -------- + ( 1) ALKNIT + ( 2) ALKOOH + ( 3) AOA_NH + ( 4) bc_a1 + ( 5) bc_a4 + ( 6) BCARY + ( 7) BENZENE + ( 8) BENZOOH + ( 9) BEPOMUC + ( 10) BIGALD + ( 11) BIGALD1 + ( 12) BIGALD2 + ( 13) BIGALD3 + ( 14) BIGALD4 + ( 15) BIGALK + ( 16) BIGENE + ( 17) BR + ( 18) BRCL + ( 19) BRO + ( 20) BRONO2 + ( 21) BRY + ( 22) BZALD + ( 23) BZOOH + ( 24) C2H2 + ( 25) C2H4 + ( 26) C2H5OH + ( 27) C2H5OOH + ( 28) C2H6 + ( 29) C3H6 + ( 30) C3H7OOH + ( 31) C3H8 + ( 32) C6H5OOH + ( 33) CCL4 + ( 34) CF2CLBR + ( 35) CF3BR + ( 36) CFC11 + ( 37) CFC113 + ( 38) CFC114 + ( 39) CFC115 + ( 40) CFC12 + ( 41) CH2BR2 + ( 42) CH2O + ( 43) CH3BR + ( 44) CH3CCL3 + ( 45) CH3CHO + ( 46) CH3CL + ( 47) CH3CN + ( 48) CH3COCH3 + ( 49) CH3COCHO + ( 50) CH3COOH + ( 51) CH3COOOH + ( 52) CH3OH + ( 53) CH3OOH + ( 54) CH4 + ( 55) CHBR3 + ( 56) CL + ( 57) CL2 + ( 58) CL2O2 + ( 59) CLO + ( 60) CLONO2 + ( 61) CLY + ( 62) CO + ( 63) CO2 + ( 64) COF2 + ( 65) COFCL + ( 66) CRESOL + ( 67) DMS + ( 68) dst_a1 + ( 69) dst_a2 + ( 70) dst_a3 + ( 71) E90 + ( 72) EOOH + ( 73) F + ( 74) GLYALD + ( 75) GLYOXAL + ( 76) H + ( 77) H2 + ( 78) H2402 + ( 79) H2O2 + ( 80) H2SO4 + ( 81) HBR + ( 82) HCFC141B + ( 83) HCFC142B + ( 84) HCFC22 + ( 85) HCL + ( 86) HCN + ( 87) HCOOH + ( 88) HF + ( 89) HNO3 + ( 90) HO2 + ( 91) HO2NO2 + ( 92) HOBR + ( 93) HOCL + ( 94) HONITR + ( 95) HPALD + ( 96) HYAC + ( 97) HYDRALD + ( 98) IEPOX + ( 99) ISOP + (100) ISOPNITA + (101) ISOPNITB + (102) ISOPNOOH + (103) ISOPOOH + (104) IVOC + (105) MACR + (106) MACROOH + (107) MEK + (108) MEKOOH + (109) MPAN + (110) MTERP + (111) MVK + (112) N + (113) N2O + (114) N2O5 + (115) NC4CH2OH + (116) NC4CHO + (117) ncl_a1 + (118) ncl_a2 + (119) ncl_a3 + (120) NH3 + (121) NH4 + (122) NH_5 + (123) NH_50 + (124) NO + (125) NO2 + (126) NO3 + (127) NOA + (128) NTERPOOH + (129) num_a1 + (130) num_a2 + (131) num_a3 + (132) num_a4 + (133) num_a5 + (134) O + (135) O2 + (136) O3 + (137) O3S + (138) OCLO + (139) OCS + (140) ONITR + (141) PAN + (142) PBZNIT + (143) PHENO + (144) PHENOL + (145) PHENOOH + (146) pom_a1 + (147) pom_a4 + (148) POOH + (149) ROOH + (150) S + (151) SF6 + (152) SO + (153) SO2 + (154) SO3 + (155) so4_a1 + (156) so4_a2 + (157) so4_a3 + (158) so4_a5 + (159) soa1_a1 + (160) soa1_a2 + (161) soa2_a1 + (162) soa2_a2 + (163) soa3_a1 + (164) soa3_a2 + (165) soa4_a1 + (166) soa4_a2 + (167) soa5_a1 + (168) soa5_a2 + (169) SOAG0 + (170) SOAG1 + (171) SOAG2 + (172) SOAG3 + (173) SOAG4 + (174) ST80_25 + (175) SVOC + (176) TEPOMUC + (177) TERP2OOH + (178) TERPNIT + (179) TERPOOH + (180) TERPROD1 + (181) TERPROD2 + (182) TOLOOH + (183) TOLUENE + (184) XOOH + (185) XYLENES + (186) XYLENOOH + (187) XYLOL + (188) XYLOLOOH + (189) ACBZO2 + (190) ALKO2 + (191) BCARYO2VBS + (192) BENZO2 + (193) BENZO2VBS + (194) BZOO + (195) C2H5O2 + (196) C3H7O2 + (197) C6H5O2 + (198) CH3CO3 + (199) CH3O2 + (200) DICARBO2 + (201) e + (202) ENEO2 + (203) EO + (204) EO2 + (205) HOCH2OO + (206) ISOPAO2 + (207) ISOPBO2 + (208) ISOPNO3 + (209) ISOPO2VBS + (210) IVOCO2VBS + (211) MACRO2 + (212) MALO2 + (213) MCO3 + (214) MDIALO2 + (215) MEKO2 + (216) MTERPO2VBS + (217) N2D + (218) N2p + (219) NOp + (220) Np + (221) NTERPO2 + (222) O1D + (223) O2_1D + (224) O2_1S + (225) O2p + (226) OH + (227) Op + (228) PHENO2 + (229) PO2 + (230) RO2 + (231) TERP2O2 + (232) TERPO2 + (233) TOLO2 + (234) TOLUO2VBS + (235) XO2 + (236) XYLENO2 + (237) XYLEO2VBS + (238) XYLOLO2 + (239) H2O + + Photolysis + jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) + jh2o_c ( 2) H2O + hv -> 2*H + O rate = ** User defined ** ( 2) + jh2o_a ( 3) H2O + hv -> OH + H rate = ** User defined ** ( 3) + jh2o2 ( 4) H2O2 + hv -> 2*OH rate = ** User defined ** ( 4) + jo2_b ( 5) O2 + hv -> 2*O rate = ** User defined ** ( 5) + jo2_a ( 6) O2 + hv -> O + O1D rate = ** User defined ** ( 6) + jo3_a ( 7) O3 + hv -> O1D + O2_1D 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) + jno_i ( 16) NO + hv -> NOp + e rate = ** User defined ** ( 16) + jno2 ( 17) NO2 + hv -> NO + O rate = ** User defined ** ( 17) + jno3_a ( 18) NO3 + hv -> NO2 + O rate = ** User defined ** ( 18) + jno3_b ( 19) NO3 + hv -> NO + O2 rate = ** User defined ** ( 19) + jalknit ( 20) ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 rate = ** User defined ** ( 20) + + 0.8*MEK + jalkooh ( 21) ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 rate = ** User defined ** ( 21) + + 0.8*MEK + OH + jbenzooh ( 22) BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 rate = ** User defined ** ( 22) + jbepomuc ( 23) BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO rate = ** User defined ** ( 23) + jbigald ( 24) BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 rate = ** User defined ** ( 24) + + 0.18*CH3COCHO + jbigald1 ( 25) BIGALD1 + hv -> 0.6*MALO2 + HO2 rate = ** User defined ** ( 25) + jbigald2 ( 26) BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 rate = ** User defined ** ( 26) + jbigald3 ( 27) BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 rate = ** User defined ** ( 27) + jbigald4 ( 28) BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 rate = ** User defined ** ( 28) + jbzooh ( 29) BZOOH + hv -> BZALD + OH + HO2 rate = ** User defined ** ( 29) + jc2h5ooh ( 30) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 30) + jc3h7ooh ( 31) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 31) + jc6h5ooh ( 32) C6H5OOH + hv -> PHENO + OH rate = ** User defined ** ( 32) + jch2o_b ( 33) CH2O + hv -> CO + H2 rate = ** User defined ** ( 33) + jch2o_a ( 34) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 34) + jch3cho ( 35) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 35) + jacet ( 36) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 36) + jmgly ( 37) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 37) + jch3co3h ( 38) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 38) + jch3ooh ( 39) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 39) + jch4_b ( 40) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 40) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jch4_a ( 41) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 41) + jco2 ( 42) CO2 + hv -> CO + O rate = ** User defined ** ( 42) + jeooh ( 43) EOOH + hv -> EO + OH rate = ** User defined ** ( 43) + jglyald ( 44) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 44) + jglyoxal ( 45) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 45) + jhonitr ( 46) HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO rate = ** User defined ** ( 46) + + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + + 0.17*CH3COCH3 + jhpald ( 47) HPALD + hv -> BIGALD3 + OH + HO2 rate = ** User defined ** ( 47) + jhyac ( 48) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 48) + jisopnooh ( 49) ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH rate = ** User defined ** ( 49) + jisopooh ( 50) ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + CH2O + HO2 rate = ** User defined ** ( 50) + jmacr_a ( 51) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 51) + jmacr_b ( 52) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 52) + jmek ( 53) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 53) + jmekooh ( 54) MEKOOH + hv -> OH + CH3CO3 + CH3CHO rate = ** User defined ** ( 54) + jmpan ( 55) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 55) + jmvk ( 56) MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 rate = ** User defined ** ( 56) + jnc4cho ( 57) NC4CHO + hv -> BIGALD3 + NO2 + HO2 rate = ** User defined ** ( 57) + jnoa ( 58) NOA + hv -> NO2 + CH2O + CH3CO3 rate = ** User defined ** ( 58) + jnterpooh ( 59) NTERPOOH + hv -> TERPROD1 + NO2 + OH rate = ** User defined ** ( 59) + jonitr ( 60) ONITR + hv -> NO2 rate = ** User defined ** ( 60) + jpan ( 61) PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 rate = ** User defined ** ( 61) + jphenooh ( 62) PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL rate = ** User defined ** ( 62) + jpooh ( 63) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 63) + jrooh ( 64) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 64) + jtepomuc ( 65) TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO rate = ** User defined ** ( 65) + jterp2ooh ( 66) TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 rate = ** User defined ** ( 66) + + TERPROD2 + HO2 + 0.25*GLYALD + jterpnit ( 67) TERPNIT + hv -> TERPROD1 + NO2 + HO2 rate = ** User defined ** ( 67) + jterpooh ( 68) TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH rate = ** User defined ** ( 68) + jterprd1 ( 69) TERPROD1 + hv -> HO2 + CO + TERPROD2 rate = ** User defined ** ( 69) + jterprd2 ( 70) TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 rate = ** User defined ** ( 70) + + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO + jtolooh ( 71) TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = ** User defined ** ( 71) + + 0.2*BIGALD2 + 0.2*BIGALD3 + jxooh ( 72) XOOH + hv -> OH rate = ** User defined ** ( 72) + jxylenooh ( 73) XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = ** User defined ** ( 73) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + jxylolooh ( 74) XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 rate = ** User defined ** ( 74) + jbrcl ( 75) BRCL + hv -> BR + CL rate = ** User defined ** ( 75) + jbro ( 76) BRO + hv -> BR + O rate = ** User defined ** ( 76) + jbrono2_b ( 77) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 77) + jbrono2_a ( 78) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 78) + jccl4 ( 79) CCL4 + hv -> 4*CL rate = ** User defined ** ( 79) + jcf2clbr ( 80) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 80) + jcf3br ( 81) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 81) + jcfcl3 ( 82) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 82) + jcfc113 ( 83) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 83) + jcfc114 ( 84) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 84) + jcfc115 ( 85) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 85) + jcf2cl2 ( 86) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 86) + jch2br2 ( 87) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 87) + jch3br ( 88) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 88) + jch3ccl3 ( 89) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 89) + jch3cl ( 90) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 90) + jchbr3 ( 91) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 91) + jcl2 ( 92) CL2 + hv -> 2*CL rate = ** User defined ** ( 92) + jcl2o2 ( 93) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 93) + jclo ( 94) CLO + hv -> CL + O rate = ** User defined ** ( 94) + jclono2_a ( 95) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 95) + jclono2_b ( 96) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 96) + jcof2 ( 97) COF2 + hv -> 2*F rate = ** User defined ** ( 97) + jcofcl ( 98) COFCL + hv -> F + CL rate = ** User defined ** ( 98) + jh2402 ( 99) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 99) + jhbr (100) HBR + hv -> BR + H rate = ** User defined ** (100) + jhcfc141b (101) HCFC141B + hv -> CL + COFCL rate = ** User defined ** (101) + jhcfc142b (102) HCFC142B + hv -> CL + COF2 rate = ** User defined ** (102) + jhcfc22 (103) HCFC22 + hv -> CL + COF2 rate = ** User defined ** (103) + jhcl (104) HCL + hv -> H + CL rate = ** User defined ** (104) + jhf (105) HF + hv -> H + F rate = ** User defined ** (105) + jhobr (106) HOBR + hv -> BR + OH rate = ** User defined ** (106) + jhocl (107) HOCL + hv -> OH + CL rate = ** User defined ** (107) + joclo (108) OCLO + hv -> O + CLO rate = ** User defined ** (108) + jsf6 (109) SF6 + hv -> {sink} rate = ** User defined ** (109) + jeuv_26 (110) CO2 + hv -> CO + O rate = ** User defined ** (110) + jeuv_4 (111) N + hv -> Np + e rate = ** User defined ** (111) + jeuv_13 (112) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** (112) + jeuv_11 (113) N2 + hv -> N2D + Np + e rate = ** User defined ** (113) + jeuv_6 (114) N2 + hv -> N2p + e rate = ** User defined ** (114) + jeuv_10 (115) N2 + hv -> N + Np + e rate = ** User defined ** (115) + jeuv_22 (116) N2 + hv -> N + Np + e rate = ** User defined ** (116) + jeuv_23 (117) N2 + hv -> N2D + Np + e rate = ** User defined ** (117) + jeuv_25 (118) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** (118) + jeuv_18 (119) N2 + hv -> N2p + e rate = ** User defined ** (119) + jeuv_2 (120) O + hv -> Op + e rate = ** User defined ** (120) + jeuv_1 (121) O + hv -> Op + e rate = ** User defined ** (121) + jeuv_16 (122) O + hv -> Op + e rate = ** User defined ** (122) + jeuv_15 (123) O + hv -> Op + e rate = ** User defined ** (123) + jeuv_14 (124) O + hv -> Op + e rate = ** User defined ** (124) + jeuv_3 (125) O + hv -> Op + e rate = ** User defined ** (125) + jeuv_17 (126) O2 + hv -> O2p + e rate = ** User defined ** (126) + jeuv_9 (127) O2 + hv -> O + Op + e rate = ** User defined ** (127) + jeuv_8 (128) O2 + hv -> O + Op + e rate = ** User defined ** (128) + jeuv_7 (129) O2 + hv -> O + Op + e rate = ** User defined ** (129) + jeuv_5 (130) O2 + hv -> O2p + e rate = ** User defined ** (130) + jeuv_19 (131) O2 + hv -> O + Op + e rate = ** User defined ** (131) + jeuv_20 (132) O2 + hv -> O + Op + e rate = ** User defined ** (132) + jeuv_21 (133) O2 + hv -> O + Op + e rate = ** User defined ** (133) + jeuv_24 (134) O2 + hv -> 2*O rate = ** User defined ** (134) + jeuv_12 (135) O2 + hv -> 2*O rate = ** User defined ** (135) + jh2so4 (136) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** (136) + jocs (137) OCS + hv -> S + CO rate = ** User defined ** (137) + jso (138) SO + hv -> S + O rate = ** User defined ** (138) + jso2 (139) SO2 + hv -> SO + O rate = ** User defined ** (139) + jso3 (140) SO3 + hv -> SO2 + O rate = ** User defined ** (140) + jsoa1_a1 (141) soa1_a1 + hv -> (No products) rate = ** User defined ** (141) + jsoa1_a2 (142) soa1_a2 + hv -> (No products) rate = ** User defined ** (142) + jsoa2_a1 (143) soa2_a1 + hv -> (No products) rate = ** User defined ** (143) + jsoa2_a2 (144) soa2_a2 + hv -> (No products) rate = ** User defined ** (144) + jsoa3_a1 (145) soa3_a1 + hv -> (No products) rate = ** User defined ** (145) + jsoa3_a2 (146) soa3_a2 + hv -> (No products) rate = ** User defined ** (146) + jsoa4_a1 (147) soa4_a1 + hv -> (No products) rate = ** User defined ** (147) + jsoa4_a2 (148) soa4_a2 + hv -> (No products) rate = ** User defined ** (148) + jsoa5_a1 (149) soa5_a1 + hv -> (No products) rate = ** User defined ** (149) + jsoa5_a2 (150) soa5_a2 + hv -> (No products) rate = ** User defined ** (150) + + Reactions + ag1 ( 1) O2_1D -> O2 rate = 2.58E-04 (151) + ag2 ( 2) O2_1S -> O2 rate = 8.50E-02 (152) + O1D_H2 ( 3) O1D + H2 -> H + OH rate = 1.20E-10 (153) + O1D_H2O ( 4) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (154) + O1D_N2 ( 5) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (155) + O1D_O2 ( 6) O1D + O2 -> O + O2_1S rate = 2.64E-11*exp( 55./t) (156) + O1D_O2b ( 7) O1D + O2 -> O + O2 rate = 6.60E-12*exp( 55./t) (157) + O1D_O3 ( 8) O1D + O3 -> O2 + O2 rate = 1.20E-10 (158) + O2_1D_N2 ( 9) O2_1D + N2 -> O2 + N2 rate = 1.00E-20 (159) + O2_1D_O ( 10) O2_1D + O -> O2 + O rate = 1.30E-16 (160) + O2_1D_O2 ( 11) O2_1D + O2 -> 2*O2 rate = 3.60E-18*exp( -220./t) (161) + O2_1S_CO2 ( 12) O2_1S + CO2 -> O2_1D + CO2 rate = 4.20E-13 (162) + O2_1S_N2 ( 13) O2_1S + N2 -> O2_1D + N2 rate = 1.80E-15*exp( 45./t) (163) + O2_1S_O ( 14) O2_1S + O -> O2_1D + O rate = 8.00E-14 (164) + O2_1S_O2 ( 15) O2_1S + O2 -> O2_1D + O2 rate = 3.90E-17 (165) + O2_1S_O3 ( 16) O2_1S + O3 -> O2_1D + O3 rate = 3.50E-11*exp( -135./t) (166) + O_O3 ( 17) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (167) + usr_O_O ( 18) O + O + M -> O2 + M rate = ** User defined ** (168) + usr_O_O2 ( 19) O + O2 + M -> O3 + M rate = ** User defined ** (169) + H2_O ( 20) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (170) + H2O2_O ( 21) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (171) + H_HO2 ( 22) H + HO2 -> H2 + O2 rate = 6.90E-12 (172) + H_HO2a ( 23) H + HO2 -> 2*OH rate = 7.20E-11 (173) + H_HO2b ( 24) H + HO2 -> H2O + O rate = 1.60E-12 (174) + H_O2 ( 25) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (175) + ki=9.50E-11*(300/t)**-0.40 + f=0.60 + HO2_O ( 26) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (176) + HO2_O3 ( 27) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (177) + H_O3 ( 28) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (178) + OH_H2 ( 29) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (179) + OH_H2O2 ( 30) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (180) + OH_HO2 ( 31) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (181) + OH_O ( 32) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (182) + OH_O3 ( 33) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (183) + OH_OH ( 34) OH + OH -> H2O + O rate = 1.80E-12 (184) + OH_OH_M ( 35) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (185) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 ( 36) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (186) + HO2NO2_OH ( 37) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (187) + N2D_O ( 38) N2D + O -> N + O rate = 7.00E-13 (188) + N2D_O2 ( 39) N2D + O2 -> NO + O1D rate = 5.00E-12 (189) + N_NO ( 40) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (190) + N_NO2a ( 41) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (191) + N_NO2b ( 42) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (192) + N_NO2c ( 43) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (193) + N_O2 ( 44) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (194) + NO2_O ( 45) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (195) + NO2_O3 ( 46) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (196) + NO2_O_M ( 47) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (197) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 ( 48) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (198) + NO3_NO ( 49) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (199) + NO3_O ( 50) NO3 + O -> NO2 + O2 rate = 1.30E-11 (200) + NO3_OH ( 51) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (201) + N_OH ( 52) N + OH -> NO + H rate = 5.00E-11 (202) + NO_HO2 ( 53) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (203) + NO_O3 ( 54) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (204) + NO_O_M ( 55) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (205) + ki=3.00E-11 + f=0.60 + O1D_N2Oa ( 56) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (206) + O1D_N2Ob ( 57) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (207) + tag_NO2_HO2 ( 58) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (208) + ki=4.00E-12*(300/t)**0.30 + f=0.60 + tag_NO2_NO3 ( 59) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (209) + ki=1.60E-12*(300/t)**-0.10 + f=0.60 + tag_NO2_OH ( 60) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (210) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 61) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (211) + usr_HO2NO2_M ( 62) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (212) + usr_N2O5_M ( 63) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (213) + CL_CH2O ( 64) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (214) + CL_CH4 ( 65) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (215) + CL_H2 ( 66) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (216) + CL_H2O2 ( 67) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (217) + CL_HO2a ( 68) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (218) + CL_HO2b ( 69) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (219) + CL_O3 ( 70) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (220) + CLO_CH3O2 ( 71) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (221) + CLO_CLOa ( 72) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (222) + CLO_CLOb ( 73) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (223) + CLO_CLOc ( 74) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (224) + CLO_HO2 ( 75) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (225) + CLO_NO ( 76) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (226) + CLONO2_CL ( 77) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (227) + CLO_NO2_M ( 78) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (228) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLONO2_O ( 79) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (229) + CLONO2_OH ( 80) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (230) + CLO_O ( 81) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (231) + CLO_OHa ( 82) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (232) + CLO_OHb ( 83) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (233) + HCL_O ( 84) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (234) + HCL_OH ( 85) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (235) + HOCL_CL ( 86) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (236) + HOCL_O ( 87) HOCL + O -> CLO + OH rate = 1.70E-13 (237) + HOCL_OH ( 88) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (238) + O1D_CCL4 ( 89) O1D + CCL4 -> 4*CL rate = 2.61E-10 (239) + O1D_CF2CLBR ( 90) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (240) + O1D_CFC11 ( 91) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (241) + O1D_CFC113 ( 92) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (242) + O1D_CFC114 ( 93) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (243) + O1D_CFC115 ( 94) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (244) + O1D_CFC12 ( 95) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (245) + O1D_HCLa ( 96) O1D + HCL -> CL + OH rate = 9.90E-11 (246) + O1D_HCLb ( 97) O1D + HCL -> CLO + H rate = 3.30E-12 (247) + tag_CLO_CLO_M ( 98) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (248) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M ( 99) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (249) + BR_CH2O (100) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (250) + BR_HO2 (101) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (251) + BR_O3 (102) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (252) + BRO_BRO (103) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (253) + BRO_CLOa (104) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (254) + BRO_CLOb (105) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (255) + BRO_CLOc (106) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (256) + BRO_HO2 (107) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (257) + BRO_NO (108) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (258) + BRO_NO2_M (109) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (259) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRONO2_O (110) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (260) + BRO_O (111) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (261) + BRO_OH (112) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (262) + HBR_O (113) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (263) + HBR_OH (114) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (264) + HOBR_O (115) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (265) + O1D_CF3BR (116) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (266) + O1D_CHBR3 (117) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (267) + O1D_H2402 (118) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (268) + O1D_HBRa (119) O1D + HBR -> BR + OH rate = 9.00E-11 (269) + O1D_HBRb (120) O1D + HBR -> BRO + H rate = 3.00E-11 (270) + F_CH4 (121) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (271) + F_H2 (122) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (272) + F_H2O (123) F + H2O -> HF + OH rate = 1.40E-11 (273) + F_HNO3 (124) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (274) + O1D_COF2 (125) O1D + COF2 -> 2*F rate = 2.14E-11 (275) + O1D_COFCL (126) O1D + COFCL -> F + CL rate = 1.90E-10 (276) + CH2BR2_CL (127) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (277) + CH2BR2_OH (128) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (278) + CH3BR_CL (129) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (279) + CH3BR_OH (130) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (280) + CH3CCL3_OH (131) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (281) + CH3CL_CL (132) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (282) + CH3CL_OH (133) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (283) + CHBR3_CL (134) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (284) + CHBR3_OH (135) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (285) + HCFC141B_OH (136) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (286) + HCFC142B_OH (137) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (287) + HCFC22_OH (138) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (288) + O1D_CH2BR2 (139) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (289) + O1D_CH3BR (140) O1D + CH3BR -> BR rate = 1.80E-10 (290) + O1D_HCFC141B (141) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (291) + O1D_HCFC142B (142) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (292) + O1D_HCFC22 (143) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (293) + CH2O_HO2 (144) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) (294) + CH2O_NO3 (145) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (295) + CH2O_O (146) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (296) + CH2O_OH (147) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (297) + CH3O2_CH3O2a (148) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (298) + CH3O2_CH3O2b (149) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (299) + CH3O2_HO2 (150) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (300) + CH3O2_NO (151) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (301) + CH3OH_OH (152) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (302) + CH3OOH_OH (153) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (303) + CH4_OH (154) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (304) + HCN_OH (155) HCN + OH + M -> HO2 + M troe : ko=6.10E-33*(300/t)**1.50 (305) + ki=9.80E-15*(300/t)**-4.60 + f=0.80 + HCOOH_OH (156) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (306) + HOCH2OO_HO2 (157) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (307) + HOCH2OO_M (158) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (308) + HOCH2OO_NO (159) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (309) + O1D_CH4a (160) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (310) + O1D_CH4b (161) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (311) + O1D_CH4c (162) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (312) + O1D_HCN (163) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (313) + usr_CO_OH (164) CO + OH -> CO2 + HO2 rate = ** User defined ** (314) + C2H2_CL_M (165) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (315) + ki=2.20E-10*(300/t)**0.70 + f=0.60 + C2H2_OH_M (166) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (316) + + 0.35*CO + M ki=8.30E-13*(300/t)**-2.00 + f=0.60 + C2H4_CL_M (167) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (317) + ki=3.10E-10*(300/t) + f=0.60 + C2H4_O3 (168) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (318) + C2H5O2_C2H5O2 (169) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (319) + C2H5O2_CH3O2 (170) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (320) + + 0.2*C2H5OH + C2H5O2_HO2 (171) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (321) + C2H5O2_NO (172) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (322) + C2H5OH_OH (173) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (323) + C2H5OOH_OH (174) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (324) + C2H6_CL (175) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (325) + C2H6_OH (176) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (326) + CH3CHO_NO3 (177) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (327) + CH3CHO_OH (178) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (328) + CH3CN_OH (179) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (329) + CH3CO3_CH3CO3 (180) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (330) + CH3CO3_CH3O2 (181) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (331) + + 0.1*CH3COOH + CH3CO3_HO2 (182) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (332) + + 0.45*CH3O2 + CH3CO3_NO (183) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (333) + CH3COOH_OH (184) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 3.15E-14*exp( 920./t) (334) + CH3COOOH_OH (185) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (335) + EO2_HO2 (186) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (336) + EO2_NO (187) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (337) + EO_M (188) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (338) + EO_O2 (189) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (339) + GLYALD_OH (190) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (340) + GLYOXAL_OH (191) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (341) + PAN_OH (192) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (342) + tag_C2H4_OH (193) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (343) + ki=9.00E-12*(300/t)**0.85 + f=0.48 + tag_CH3CO3_NO2 (194) CH3CO3 + NO2 + M -> PAN + M troe : ko=7.30E-29*(300/t)**4.10 (344) + ki=9.50E-12*(300/t)**1.60 + f=0.60 + usr_PAN_M (195) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (345) + C3H6_NO3 (196) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (346) + C3H6_O3 (197) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (347) + + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + + 0.36*OH + C3H7O2_CH3O2 (198) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (348) + C3H7O2_HO2 (199) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (349) + C3H7O2_NO (200) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (350) + C3H7OOH_OH (201) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (351) + C3H8_OH (202) C3H8 + OH -> C3H7O2 + H2O rate = 9.19E-12*exp( -630./t) (352) + CH3COCHO_NO3 (203) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (353) + CH3COCHO_OH (204) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (354) + CL_C3H8 (205) CL + C3H8 -> C3H7O2 + HCL rate = 1.45E-10 (355) + HYAC_OH (206) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (356) + NOA_OH (207) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (357) + PO2_HO2 (208) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (358) + PO2_NO (209) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (359) + POOH_OH (210) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (360) + RO2_CH3O2 (211) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (361) + + 0.5*CH3COCHO + 0.5*CH3OH + RO2_HO2 (212) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (362) + RO2_NO (213) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (363) + ROOH_OH (214) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (364) + tag_C3H6_OH (215) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (365) + ki=3.00E-11 + f=0.50 + usr_CH3COCH3_OH (216) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (366) + BIGENE_NO3 (217) BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 rate = 3.50E-13 (367) + BIGENE_OH (218) BIGENE + OH -> ENEO2 rate = 5.40E-11 (368) + ENEO2_NO (219) ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 rate = 4.80E-12*exp( 120./t) (369) + ENEO2_NOb (220) ENEO2 + NO -> HONITR rate = 5.10E-14*exp( 693./t) (370) + HONITR_OH (221) HONITR + OH -> ONITR + HO2 rate = 2.00E-12 (371) + MACRO2_CH3CO3 (222) MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 rate = 1.40E-11 (372) + + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + + 0.53*CH3CO3 + MACRO2_CH3O2 (223) MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO rate = 5.00E-13*exp( 400./t) (373) + + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + + 0.23*HYAC + MACRO2_HO2 (224) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (374) + MACRO2_NO3 (225) MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO rate = 2.40E-12 (375) + + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 + MACRO2_NOa (226) MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD rate = 2.70E-12*exp( 360./t) (376) + + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO + MACRO2_NOb (227) MACRO2 + NO -> HONITR rate = 1.30E-13*exp( 360./t) (377) + MACR_O3 (228) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (378) + + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 + MACR_OH (229) MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 rate = 9.60E-12*exp( 360./t) (379) + MACROOH_OH (230) MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 rate = 2.30E-11*exp( 200./t) (380) + MCO3_CH3CO3 (231) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (381) + MCO3_CH3O2 (232) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (382) + MCO3_HO2 (233) MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH rate = 4.30E-13*exp( 1040./t) (383) + + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 + MCO3_MCO3 (234) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (384) + MCO3_NO (235) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (385) + MCO3_NO3 (236) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (386) + MEKO2_HO2 (237) MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 rate = 7.50E-13*exp( 700./t) (387) + MEKO2_NO (238) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (388) + MEK_OH (239) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (389) + MEKOOH_OH (240) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (390) + MPAN_OH_M (241) 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 (391) + + M + 0.5*NDEP ki=3.00E-11 + f=0.50 + MVK_O3 (242) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (392) + + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH + MVK_OH (243) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (393) + tag_MCO3_NO2 (244) MCO3 + NO2 + M -> MPAN + M troe : ko=9.70E-29*(300/t)**5.60 (394) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + usr_MPAN_M (245) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (395) + ALKNIT_OH (246) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (396) + ALKO2_HO2 (247) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (397) + ALKO2_NO (248) ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK rate = 6.70E-12 (398) + + NO2 + ALKO2_NOb (249) ALKO2 + NO -> ALKNIT rate = 5.40E-14*exp( 870./t) (399) + ALKOOH_OH (250) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (400) + BIGALK_OH (251) BIGALK + OH -> ALKO2 rate = 3.50E-12 (401) + HPALD_OH (252) HPALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (402) + HYDRALD_OH (253) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (403) + IEPOX_OH (254) IEPOX + OH -> XO2 rate = 1.30E-11 (404) + ISOPAO2_CH3CO3 (255) ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 rate = 1.40E-11 (405) + ISOPAO2_CH3O2 (256) ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR rate = 5.00E-13*exp( 400./t) (406) + + 0.44*MVK + ISOPAO2_HO2 (257) ISOPAO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (407) + ISOPAO2_NO (258) ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK rate = 4.40E-12*exp( 180./t) (408) + + 0.92*CH2O + 0.92*HO2 + ISOPAO2_NO3 (259) ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 rate = 2.40E-12 (409) + ISOPBO2_CH3CO3 (260) ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 rate = 1.40E-11 (410) + ISOPBO2_CH3O2 (261) ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD rate = 5.00E-13*exp( 400./t) (411) + ISOPBO2_HO2 (262) ISOPBO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (412) + ISOPBO2_M (263) ISOPBO2 -> HPALD + HO2 rate = 1.60E+09*exp( -8300./t) (413) + ISOPBO2_NO (264) ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 rate = 4.40E-12*exp( 180./t) (414) + + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + + 0.05*HYAC + ISOPBO2_NO3 (265) ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL rate = 2.40E-12 (415) + + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC + ISOPNITA_OH (266) ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O rate = 4.00E-11 (416) + + 0.3*HONITR + 0.3*HO2 + ISOPNITB_OH (267) ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR rate = 4.00E-11 (417) + ISOP_NO3 (268) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (418) + ISOPNO3_CH3CO3 (269) ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 rate = 1.40E-11 (419) + ISOPNO3_CH3O2 (270) ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH rate = 5.00E-13*exp( 400./t) (420) + + 0.2*NC4CH2OH + ISOPNO3_HO2 (271) ISOPNO3 + HO2 -> ISOPNOOH rate = 8.00E-13*exp( 700./t) (421) + ISOPNO3_NO (272) ISOPNO3 + NO -> NC4CHO + NO2 + HO2 rate = 2.70E-12*exp( 360./t) (422) + ISOPNO3_NO3 (273) ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 rate = 2.40E-12 (423) + ISOPNOOH_OH (274) ISOPNOOH + OH -> NOA + HO2 rate = 4.00E-11 (424) + ISOP_O3 (275) ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH rate = 1.05E-14*exp( -2000./t) (425) + + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + + 0.05*CH3O2 + ISOP_OH (276) ISOP + OH -> 0.6*ISOPAO2 + 0.4*ISOPBO2 rate = 2.54E-11*exp( 410./t) (426) + ISOPOOH_OH (277) ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH rate = 1.52E-11*exp( 200./t) (427) + NC4CH2OH_OH (278) NC4CH2OH + OH -> GLYALD + NOA + HO2 rate = 7.00E-11 (428) + NC4CHO_OH (279) NC4CHO + OH -> GLYOXAL + NOA + HO2 rate = 1.00E-10 (429) + XO2_CH3CO3 (280) XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (430) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 + XO2_CH3O2 (281) XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO rate = 5.00E-13*exp( 400./t) (431) + + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD + XO2_HO2 (282) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (432) + XO2_NO (283) XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL rate = 2.70E-12*exp( 360./t) (433) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + XO2_NO3 (284) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (434) + + 0.25*CH3COCHO + 0.25*GLYALD + XOOH_OH (285) XOOH + OH -> 0.5*XO2 + 0.5*OH rate = 1.52E-12*exp( 200./t) (435) + ACBZO2_HO2 (286) ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH rate = 4.30E-13*exp( 1040./t) (436) + ACBZO2_NO (287) ACBZO2 + NO -> C6H5O2 + NO2 rate = 7.50E-12*exp( 290./t) (437) + BENZENE_OH (288) BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 rate = 2.30E-12*exp( -193./t) (438) + BENZO2_HO2 (289) BENZO2 + HO2 -> BENZOOH rate = 7.50E-13*exp( 700./t) (439) + BENZO2_NO (290) BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 rate = 2.60E-12*exp( 365./t) (440) + BENZOOH_OH (291) BENZOOH + OH -> BENZO2 rate = 3.80E-12*exp( 200./t) (441) + BZALD_OH (292) BZALD + OH -> ACBZO2 rate = 5.90E-12*exp( 225./t) (442) + BZOO_HO2 (293) BZOO + HO2 -> BZOOH rate = 7.50E-13*exp( 700./t) (443) + BZOOH_OH (294) BZOOH + OH -> BZOO rate = 3.80E-12*exp( 200./t) (444) + BZOO_NO (295) BZOO + NO -> BZALD + NO2 + HO2 rate = 2.60E-12*exp( 365./t) (445) + C6H5O2_HO2 (296) C6H5O2 + HO2 -> C6H5OOH rate = 7.50E-13*exp( 700./t) (446) + C6H5O2_NO (297) C6H5O2 + NO -> PHENO + NO2 rate = 2.60E-12*exp( 365./t) (447) + C6H5OOH_OH (298) C6H5OOH + OH -> C6H5O2 rate = 3.80E-12*exp( 200./t) (448) + CRESOL_OH (299) CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO rate = 4.70E-11 (449) + DICARBO2_HO2 (300) DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO rate = 4.30E-13*exp( 1040./t) (450) + + 0.33*CH3O2 + DICARBO2_NO (301) DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO rate = 7.50E-12*exp( 290./t) (451) + + 0.83*CH3O2 + DICARBO2_NO2 (302) DICARBO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (452) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MALO2_HO2 (303) MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO rate = 4.30E-13*exp( 1040./t) (453) + MALO2_NO (304) MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 rate = 7.50E-12*exp( 290./t) (454) + MALO2_NO2 (305) MALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (455) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MDIALO2_HO2 (306) MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO rate = 4.30E-13*exp( 1040./t) (456) + + 0.07*CH3O2 + 0.07*GLYOXAL + MDIALO2_NO (307) MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO rate = 7.50E-12*exp( 290./t) (457) + + 0.17*CH3O2 + 0.17*GLYOXAL + MDIALO2_NO2 (308) MDIALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (458) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + PHENO2_HO2 (309) PHENO2 + HO2 -> PHENOOH rate = 7.50E-13*exp( 700./t) (459) + PHENO2_NO (310) PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 rate = 2.60E-12*exp( 365./t) (460) + PHENOL_OH (311) PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO rate = 4.70E-13*exp( 1220./t) (461) + PHENO_NO2 (312) PHENO + NO2 -> NDEP rate = 2.10E-12 (462) + PHENO_O3 (313) PHENO + O3 -> C6H5O2 rate = 2.80E-13 (463) + PHENOOH_OH (314) PHENOOH + OH -> PHENO2 rate = 3.80E-12*exp( 200./t) (464) + tag_ACBZO2_NO2 (315) ACBZO2 + NO2 + M -> PBZNIT + M troe : ko=9.70E-29*(300/t)**5.60 (465) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + TOLO2_HO2 (316) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (466) + TOLO2_NO (317) TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = 2.60E-12*exp( 365./t) (467) + + 0.2*BIGALD2 + 0.2*BIGALD3 + TOLOOH_OH (318) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (468) + TOLUENE_OH (319) TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 rate = 1.70E-12*exp( 352./t) (469) + + 0.28*HO2 + usr_PBZNIT_M (320) PBZNIT + M -> ACBZO2 + NO2 + M rate = ** User defined ** (470) + XYLENES_OH (321) XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO rate = 1.70E-11 (471) + + 0.56*XYLENO2 + 0.38*HO2 + XYLENO2_HO2 (322) XYLENO2 + HO2 -> XYLENOOH rate = 7.50E-13*exp( 700./t) (472) + XYLENO2_NO (323) XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = 2.60E-12*exp( 365./t) (473) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + XYLENOOH_OH (324) XYLENOOH + OH -> XYLENO2 rate = 3.80E-12*exp( 200./t) (474) + XYLOLO2_HO2 (325) XYLOLO2 + HO2 -> XYLOLOOH rate = 7.50E-13*exp( 700./t) (475) + XYLOLO2_NO (326) XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO rate = 2.60E-12*exp( 365./t) (476) + XYLOL_OH (327) XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO rate = 8.40E-11 (477) + XYLOLOOH_OH (328) XYLOLOOH + OH -> XYLOLO2 rate = 3.80E-12*exp( 200./t) (478) + BCARY_NO3 (329) BCARY + NO3 -> NTERPO2 rate = 1.90E-11 (479) + BCARY_O3 (330) BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 1.20E-14 (480) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + BCARY_OH (331) BCARY + OH -> TERPO2 rate = 2.00E-10 (481) + MTERP_NO3 (332) MTERP + NO3 -> NTERPO2 rate = 1.20E-12*exp( 490./t) (482) + MTERP_O3 (333) MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 6.30E-16*exp( -580./t) (483) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + MTERP_OH (334) MTERP + OH -> TERPO2 rate = 1.20E-11*exp( 440./t) (484) + NTERPO2_CH3O2 (335) NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 rate = 2.00E-12*exp( 500./t) (485) + + 0.5*TERPROD1 + 0.5*NO2 + NTERPO2_HO2 (336) NTERPO2 + HO2 -> NTERPOOH rate = 7.50E-13*exp( 700./t) (486) + NTERPO2_NO (337) NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP rate = 4.20E-12*exp( 180./t) (487) + NTERPO2_NO3 (338) NTERPO2 + NO3 -> 2*NO2 + TERPROD1 rate = 2.40E-12 (488) + NTERPOOH_OH (339) NTERPOOH + OH -> NTERPO2 rate = 2.00E-11 (489) + TERP2O2_CH3O2 (340) TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (490) + + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + + 0.15*CH3COCH3 + TERP2O2_HO2 (341) TERP2O2 + HO2 -> TERP2OOH rate = 7.50E-13*exp( 700./t) (491) + TERP2O2_NO (342) TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 rate = 4.20E-12*exp( 180./t) (492) + + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + + 0.225*GLYALD + TERP2OOH_OH (343) TERP2OOH + OH -> TERP2O2 rate = 2.30E-11 (493) + TERPNIT_OH (344) TERPNIT + OH -> NO2 + TERPROD1 rate = 2.00E-11 (494) + TERPO2_CH3O2 (345) TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (495) + + 0.025*CH3COCH3 + TERPO2_HO2 (346) TERPO2 + HO2 -> TERPOOH rate = 7.50E-13*exp( 700./t) (496) + TERPO2_NO (347) TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 rate = 4.20E-12*exp( 180./t) (497) + + 0.8*TERPROD1 + 0.8*HO2 + TERPOOH_OH (348) TERPOOH + OH -> TERPO2 rate = 3.30E-11 (498) + TERPROD1_NO3 (349) TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP rate = 1.00E-12 (499) + TERPROD1_OH (350) TERPROD1 + OH -> TERP2O2 rate = 5.70E-11 (500) + TERPROD2_OH (351) TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 rate = 3.40E-11 (501) + + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO + DMS_NO3 (352) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (502) + DMS_OHa (353) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (503) + OCS_O (354) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (504) + OCS_OH (355) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (505) + S_O2 (356) S + O2 -> SO + O rate = 2.30E-12 (506) + SO2_OH_M (357) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (507) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + S_O3 (358) S + O3 -> SO + O2 rate = 1.20E-11 (508) + SO_BRO (359) SO + BRO -> SO2 + BR rate = 5.70E-11 (509) + SO_CLO (360) SO + CLO -> SO2 + CL rate = 2.80E-11 (510) + S_OH (361) S + OH -> SO + H rate = 6.60E-11 (511) + SO_NO2 (362) SO + NO2 -> SO2 + NO rate = 1.40E-11 (512) + SO_O2 (363) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (513) + SO_O3 (364) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (514) + SO_OCLO (365) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (515) + SO_OH (366) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (516) + usr_DMS_OH (367) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (517) + usr_SO3_H2O (368) SO3 + H2O -> H2SO4 rate = ** User defined ** (518) + NH3_OH (369) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (519) + usr_GLYOXAL_aer (370) GLYOXAL -> SOAG0 rate = ** User defined ** (520) + usr_HO2_aer (371) HO2 -> H2O rate = ** User defined ** (521) + usr_HONITR_aer (372) HONITR -> HNO3 rate = ** User defined ** (522) + usr_ISOPNITA_aer (373) ISOPNITA -> HNO3 rate = ** User defined ** (523) + usr_ISOPNITB_aer (374) ISOPNITB -> HNO3 rate = ** User defined ** (524) + usr_N2O5_aer (375) N2O5 -> 2*HNO3 rate = ** User defined ** (525) + usr_NC4CH2OH_aer (376) NC4CH2OH -> HNO3 rate = ** User defined ** (526) + usr_NC4CHO_aer (377) NC4CHO -> HNO3 rate = ** User defined ** (527) + usr_NH4_strat_ta (378) NH4 -> NHDEP rate = 6.34E-08 (528) + usr_NO2_aer (379) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (529) + usr_NO3_aer (380) NO3 -> HNO3 rate = ** User defined ** (530) + usr_NTERPOOH_aer (381) NTERPOOH -> HNO3 rate = ** User defined ** (531) + usr_ONITR_aer (382) ONITR -> HNO3 rate = ** User defined ** (532) + usr_TERPNIT_aer (383) TERPNIT -> HNO3 rate = ** User defined ** (533) + BCARY_NO3_vbs (384) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.90E-11 (534) + BCARYO2_HO2_vbs (385) BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 2.75E-13*exp( 1300./t) (535) + + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 + BCARYO2_NO_vbs (386) BCARYO2VBS + NO -> NO + 0.1279*SOAG0 + 0.1792*SOAG1 + 0.0676*SOAG2 rate = 2.70E-12*exp( 360./t) (536) + + 0.079*SOAG3 + 0.1254*SOAG4 + BCARY_O3_vbs (387) BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 rate = 1.20E-14 (537) + + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 + BCARY_OH_vbs (388) BCARY + OH -> BCARY + OH + BCARYO2VBS rate = 2.00E-10 (538) + BENZENE_OH_vbs (389) BENZENE + OH -> BENZENE + OH + BENZO2VBS rate = 2.30E-12*exp( -193./t) (539) + BENZO2_HO2_vbs (390) BENZO2VBS + HO2 -> HO2 + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 rate = 7.50E-13*exp( 700./t) (540) + + 0.0443*SOAG3 + 0.1621*SOAG4 + BENZO2_NO_vbs (391) BENZO2VBS + NO -> NO + 0.0097*SOAG0 + 0.0034*SOAG1 + 0.1579*SOAG2 rate = 2.60E-12*exp( 365./t) (541) + + 0.0059*SOAG3 + 0.0536*SOAG4 + ISOP_NO3_vbs (392) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 rate = 3.03E-12*exp( -446./t) (542) + ISOPO2_HO2_vbs (393) ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 rate = 2.12E-13*exp( 1300./t) (543) + + 0.0271*SOAG3 + 0.0474*SOAG4 + ISOPO2_NO_vbs (394) ISOPO2VBS + NO -> NO + 0.0003*SOAG0 + 0.0003*SOAG1 + 0.0073*SOAG2 rate = 2.70E-12*exp( 350./t) (544) + + 0.0057*SOAG3 + 0.0623*SOAG4 + ISOP_O3_vbs (395) ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 rate = 1.05E-14*exp( -2000./t) (545) + ISOP_OH_vbs (396) ISOP + OH -> ISOP + OH + ISOPO2VBS rate = 2.54E-11*exp( 410./t) (546) + IVOCO2_HO2_vbs (397) IVOCO2VBS + HO2 -> HO2 + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 rate = 7.50E-13*exp( 700./t) (547) + + 0.0076*SOAG3 + 0.0113*SOAG4 + IVOCO2_NO_vbs (398) IVOCO2VBS + NO -> NO + 0.1056*SOAG0 + 0.1026*SOAG1 + 0.0521*SOAG2 rate = 2.60E-12*exp( 365./t) (548) + + 0.0143*SOAG3 + 0.0166*SOAG4 + IVOC_OH_vbs (399) IVOC + OH -> OH + IVOCO2VBS rate = 1.34E-11 (549) + MTERP_NO3_vbs (400) MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 rate = 1.20E-12*exp( 490./t) (550) + MTERPO2_HO2_vbs (401) MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 2.60E-13*exp( 1300./t) (551) + + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 + MTERPO2_NO_vbs (402) MTERPO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 rate = 2.70E-12*exp( 360./t) (552) + + 0.0332*SOAG3 + 0.13*SOAG4 + MTERP_O3_vbs (403) MTERP + O3 -> MTERP + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 rate = 6.30E-16*exp( -580./t) (553) + + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 + MTERP_OH_vbs (404) MTERP + OH -> MTERP + OH + MTERPO2VBS rate = 1.20E-11*exp( 440./t) (554) + SVOC_OH (405) SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 rate = 1.34E-11 (555) + + 0.0085*SOAG3 + 0.0128*SOAG4 + TOLUENE_OH_vbs (406) TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS rate = 1.70E-12*exp( 352./t) (556) + TOLUO2_HO2_vbs (407) TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 rate = 7.50E-13*exp( 700./t) (557) + + 0.2157*SOAG3 + 0.0738*SOAG4 + TOLUO2_NO_vbs (408) TOLUO2VBS + NO -> NO + 0.0154*SOAG0 + 0.0452*SOAG1 + 0.0966*SOAG2 rate = 2.60E-12*exp( 365./t) (558) + + 0.0073*SOAG3 + 0.238*SOAG4 + XYLENES_OH_vbs (409) XYLENES + OH -> XYLENES + OH + XYLEO2VBS rate = 1.70E-11 (559) + XYLEO2_HO2_vbs (410) XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 rate = 7.50E-13*exp( 700./t) (560) + + 0.0512*SOAG3 + 0.1598*SOAG4 + XYLEO2_NO_vbs (411) XYLEO2VBS + NO -> NO + 0.0063*SOAG0 + 0.0237*SOAG1 + 0.0025*SOAG2 rate = 2.60E-12*exp( 365./t) (561) + + 0.011*SOAG3 + 0.1185*SOAG4 + het1 (412) N2O5 -> 2*HNO3 rate = ** User defined ** (562) + het10 (413) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (563) + het11 (414) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (564) + het12 (415) N2O5 -> 2*HNO3 rate = ** User defined ** (565) + het13 (416) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (566) + het14 (417) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (567) + het15 (418) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (568) + het16 (419) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (569) + het17 (420) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (570) + het2 (421) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (571) + het3 (422) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (572) + het4 (423) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (573) + het5 (424) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (574) + het6 (425) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (575) + het7 (426) N2O5 -> 2*HNO3 rate = ** User defined ** (576) + het8 (427) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (577) + het9 (428) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (578) + elec1 (429) NOp + e -> 0.2*N + 0.8*N2D + O rate = ** User defined ** (579) + elec2 (430) O2p + e -> 1.15*O + 0.85*O1D rate = ** User defined ** (580) + elec3 (431) N2p + e -> 1.1*N + 0.9*N2D rate = ** User defined ** (581) + ion_N2p_O2 (432) N2p + O2 -> O2p + N2 rate = 6.00E-11 (582) + ion_N2p_Oa (433) N2p + O -> NOp + N2D rate = ** User defined ** (583) + ion_N2p_Ob (434) N2p + O -> Op + N2 rate = ** User defined ** (584) + ion_Np_O (435) Np + O -> Op + N rate = 1.00E-12 (585) + ion_Np_O2a (436) Np + O2 -> O2p + N rate = 4.00E-10 (586) + ion_Np_O2b (437) Np + O2 -> NOp + O rate = 2.00E-10 (587) + ion_O2p_N (438) O2p + N -> NOp + O rate = 1.00E-10 (588) + ion_O2p_N2 (439) O2p + N2 -> NOp + NO rate = 5.00E-16 (589) + ion_O2p_NO (440) O2p + NO -> NOp + O2 rate = 4.40E-10 (590) + ion_Op_CO2 (441) Op + CO2 -> O2p + CO rate = 9.00E-10 (591) + ion_Op_N2 (442) Op + N2 -> NOp + N rate = ** User defined ** (592) + ion_Op_O2 (443) Op + O2 -> O2p + O rate = ** User defined ** (593) + E90_tau (444) E90 -> {sink} rate = 1.29E-07 (594) + NH_50_tau (445) NH_50 -> (No products) rate = 2.31E-07 (595) + NH_5_tau (446) NH_5 -> (No products) rate = 2.31E-06 (596) + ST80_25_tau (447) ST80_25 -> (No products) rate = 4.63E-07 (597) + +Extraneous prod/loss species + ( 1) CO (dataset) + ( 2) SVOC (dataset) + ( 3) SO2 (dataset) + ( 4) NO2 (dataset) + ( 5) NO (dataset) + ( 6) num_a1 (dataset) + ( 7) num_a2 (dataset) + ( 8) so4_a1 (dataset) + ( 9) so4_a2 (dataset) + (10) num_a5 (dataset) + (11) so4_a5 (dataset) + (12) num_a4 (dataset) + (13) pom_a4 (dataset) + (14) bc_a4 (dataset) + (15) O2p + (16) N2p + (17) N2D + (18) AOA_NH + (19) N + (20) OH + (21) Op + (22) e + + + Equation Report + + d(ALKNIT)/dt = r249*ALKO2*NO + - j20*ALKNIT - r246*OH*ALKNIT + d(ALKOOH)/dt = r247*ALKO2*HO2 + - j21*ALKOOH - r250*OH*ALKOOH + d(AOA_NH)/dt = 0 + d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(BCARY)/dt = - r329*NO3*BCARY - r330*O3*BCARY - r331*OH*BCARY + d(BENZENE)/dt = - r288*OH*BENZENE + d(BENZOOH)/dt = r289*BENZO2*HO2 + - j22*BENZOOH - r291*OH*BENZOOH + d(BEPOMUC)/dt = .12*r288*BENZENE*OH + - j23*BEPOMUC + d(BIGALD)/dt = .1*r330*BCARY*O3 + .1*r333*MTERP*O3 + - j24*BIGALD + d(BIGALD1)/dt = .5*j22*BENZOOH + j23*BEPOMUC + .2*j71*TOLOOH + .06*j73*XYLENOOH + .5*r290*BENZO2*NO + + .2*r317*TOLO2*NO + .06*r323*XYLENO2*NO + - j25*BIGALD1 + d(BIGALD2)/dt = .2*j71*TOLOOH + .2*j73*XYLENOOH + .2*r317*TOLO2*NO + .2*r323*XYLENO2*NO + - j26*BIGALD2 + d(BIGALD3)/dt = j47*HPALD + j57*NC4CHO + .2*j71*TOLOOH + .15*j73*XYLENOOH + .2*r317*TOLO2*NO + + .15*r323*XYLENO2*NO + - j27*BIGALD3 + d(BIGALD4)/dt = .21*j73*XYLENOOH + .21*r323*XYLENO2*NO + - j28*BIGALD4 + d(BIGALK)/dt = .05*r330*BCARY*O3 + .05*r333*MTERP*O3 + - r251*OH*BIGALK + d(BIGENE)/dt = - r217*NO3*BIGENE - r218*OH*BIGENE + d(BR)/dt = j75*BRCL + j76*BRO + j78*BRONO2 + j80*CF2CLBR + j81*CF3BR + 2*j87*CH2BR2 + j88*CH3BR + + 3*j91*CHBR3 + 2*j99*H2402 + j100*HBR + j106*HOBR + r90*O1D*CF2CLBR + 2*r103*BRO*BRO + + r104*BRO*CLO + r105*BRO*CLO + r108*BRO*NO + r111*BRO*O + r112*BRO*OH + r113*HBR*O + + r114*HBR*OH + r116*O1D*CF3BR + 3*r117*O1D*CHBR3 + 2*r118*O1D*H2402 + r119*O1D*HBR + + 2*r127*CH2BR2*CL + 2*r128*CH2BR2*OH + r129*CH3BR*CL + r130*CH3BR*OH + 3*r134*CHBR3*CL + + 3*r135*CHBR3*OH + 2*r139*O1D*CH2BR2 + r140*O1D*CH3BR + r359*SO*BRO + - r100*CH2O*BR - r101*HO2*BR - r102*O3*BR + d(BRCL)/dt = r106*BRO*CLO + r420*HOBR*HCL + r425*HOBR*HCL + - j75*BRCL + d(BRO)/dt = j77*BRONO2 + r102*BR*O3 + r110*BRONO2*O + r115*HOBR*O + r120*O1D*HBR + - j76*BRO - 2*r103*BRO*BRO - r104*CLO*BRO - r105*CLO*BRO - r106*CLO*BRO - r107*HO2*BRO + - r108*NO*BRO - r109*M*NO2*BRO - r111*O*BRO - r112*OH*BRO - r359*SO*BRO + d(BRONO2)/dt = r109*M*BRO*NO2 + - j77*BRONO2 - j78*BRONO2 - r414*BRONO2 - r417*BRONO2 - r422*BRONO2 - r110*O*BRONO2 + d(BRY)/dt = 0 + d(BZALD)/dt = j29*BZOOH + r295*BZOO*NO + - r292*OH*BZALD + d(BZOOH)/dt = r293*BZOO*HO2 + - j29*BZOOH - r294*OH*BZOOH + d(C2H2)/dt = - r165*M*CL*C2H2 - r166*M*OH*C2H2 + d(C2H4)/dt = - r167*M*CL*C2H4 - r168*O3*C2H4 - r193*M*OH*C2H4 + d(C2H5OH)/dt = .4*r169*C2H5O2*C2H5O2 + .2*r170*C2H5O2*CH3O2 + - r173*OH*C2H5OH + d(C2H5OOH)/dt = r171*C2H5O2*HO2 + - j30*C2H5OOH - r174*OH*C2H5OOH + d(C2H6)/dt = - r175*CL*C2H6 - r176*OH*C2H6 + d(C3H6)/dt = .7*j56*MVK + .13*r275*ISOP*O3 + - r196*NO3*C3H6 - r197*O3*C3H6 - r215*M*OH*C3H6 + d(C3H7OOH)/dt = r199*C3H7O2*HO2 + - j31*C3H7OOH - r201*OH*C3H7OOH + d(C3H8)/dt = - r202*OH*C3H8 - r205*CL*C3H8 + d(C6H5OOH)/dt = r296*C6H5O2*HO2 + - j32*C6H5OOH - r298*OH*C6H5OOH + d(CCL4)/dt = - j79*CCL4 - r89*O1D*CCL4 + d(CF2CLBR)/dt = - j80*CF2CLBR - r90*O1D*CF2CLBR + d(CF3BR)/dt = - j81*CF3BR - r116*O1D*CF3BR + d(CFC11)/dt = - j82*CFC11 - r91*O1D*CFC11 + d(CFC113)/dt = - j83*CFC113 - r92*O1D*CFC113 + d(CFC114)/dt = - j84*CFC114 - r93*O1D*CFC114 + d(CFC115)/dt = - j85*CFC115 - r94*O1D*CFC115 + d(CFC12)/dt = - j86*CFC12 - r95*O1D*CFC12 + d(CH2BR2)/dt = - j87*CH2BR2 - r127*CL*CH2BR2 - r128*OH*CH2BR2 - r139*O1D*CH2BR2 + d(CH2O)/dt = .1*j20*ALKNIT + .1*j21*ALKOOH + j39*CH3OOH + .18*j40*CH4 + j44*GLYALD + .33*j46*HONITR + + j48*HYAC + j50*ISOPOOH + 1.34*j51*MACR + j58*NOA + j63*POOH + j64*ROOH + .375*j66*TERP2OOH + + .4*j68*TERPOOH + .68*j70*TERPROD2 + r158*HOCH2OO + 2*r188*EO + r71*CLO*CH3O2 + + 2*r148*CH3O2*CH3O2 + r149*CH3O2*CH3O2 + r151*CH3O2*NO + r152*CH3OH*OH + .3*r153*CH3OOH*OH + + r161*O1D*CH4 + r162*O1D*CH4 + r168*C2H4*O3 + .7*r170*C2H5O2*CH3O2 + r181*CH3CO3*CH3O2 + + .5*r185*CH3COOOH*OH + .5*r187*EO2*NO + .8*r190*GLYALD*OH + r192*PAN*OH + .5*r197*C3H6*O3 + + r198*C3H7O2*CH3O2 + r209*PO2*NO + .8*r211*RO2*CH3O2 + .15*r212*RO2*HO2 + r213*RO2*NO + + .5*r217*BIGENE*NO3 + .5*r219*ENEO2*NO + .25*r222*MACRO2*CH3CO3 + .88*r223*MACRO2*CH3O2 + + .25*r225*MACRO2*NO3 + .25*r226*MACRO2*NO + .12*r228*MACR*O3 + r231*MCO3*CH3CO3 + + 2*r232*MCO3*CH3O2 + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + r235*MCO3*NO + r236*MCO3*NO3 + + .5*r241*M*MPAN*OH + .6*r242*MVK*O3 + .4*r246*ALKNIT*OH + .1*r248*ALKO2*NO + + r255*ISOPAO2*CH3CO3 + 1.5*r256*ISOPAO2*CH3O2 + .92*r258*ISOPAO2*NO + r259*ISOPAO2*NO3 + + .75*r261*ISOPBO2*CH3O2 + .3*r266*ISOPNITA*OH + .8*r270*ISOPNO3*CH3O2 + .91*r275*ISOP*O3 + + .25*r280*XO2*CH3CO3 + .8*r281*XO2*CH3O2 + .25*r283*XO2*NO + .34*r330*BCARY*O3 + + .34*r333*MTERP*O3 + .75*r335*NTERPO2*CH3O2 + .93*r340*TERP2O2*CH3O2 + .34*r342*TERP2O2*NO + + .95*r345*TERPO2*CH3O2 + .32*r347*TERPO2*NO + .68*r351*TERPROD2*OH + - j33*CH2O - j34*CH2O - r64*CL*CH2O - r100*BR*CH2O - r144*HO2*CH2O - r145*NO3*CH2O + - r146*O*CH2O - r147*OH*CH2O + d(CH3BR)/dt = - j88*CH3BR - r129*CL*CH3BR - r130*OH*CH3BR - r140*O1D*CH3BR + d(CH3CCL3)/dt = - j89*CH3CCL3 - r131*OH*CH3CCL3 + d(CH3CHO)/dt = .4*j20*ALKNIT + .4*j21*ALKOOH + j30*C2H5OOH + .33*j46*HONITR + j54*MEKOOH + j63*POOH + + 1.6*r169*C2H5O2*C2H5O2 + .8*r170*C2H5O2*CH3O2 + r172*C2H5O2*NO + r173*C2H5OH*OH + + .5*r174*C2H5OOH*OH + .5*r197*C3H6*O3 + .27*r200*C3H7O2*NO + r209*PO2*NO + r217*BIGENE*NO3 + + r219*ENEO2*NO + .2*r237*MEKO2*HO2 + r238*MEKO2*NO + .1*r242*MVK*O3 + .8*r246*ALKNIT*OH + + .4*r248*ALKO2*NO + - j35*CH3CHO - r177*NO3*CH3CHO - r178*OH*CH3CHO + d(CH3CL)/dt = - j90*CH3CL - r132*CL*CH3CL - r133*OH*CH3CL + d(CH3CN)/dt = - r179*OH*CH3CN + d(CH3COCH3)/dt = .25*j20*ALKNIT + .25*j21*ALKOOH + .82*j31*C3H7OOH + .17*j46*HONITR + .3*j66*TERP2OOH + + .05*j68*TERPOOH + .5*j70*TERPROD2 + .82*r198*C3H7O2*CH3O2 + .82*r200*C3H7O2*NO + + .5*r217*BIGENE*NO3 + .5*r219*ENEO2*NO + .8*r246*ALKNIT*OH + .25*r248*ALKO2*NO + + .52*r330*BCARY*O3 + .52*r333*MTERP*O3 + .15*r340*TERP2O2*CH3O2 + .27*r342*TERP2O2*NO + + .025*r345*TERPO2*CH3O2 + .04*r347*TERPO2*NO + .5*r351*TERPROD2*OH + - j36*CH3COCH3 - r216*OH*CH3COCH3 + d(CH3COCHO)/dt = .18*j24*BIGALD + j28*BIGALD4 + .4*j71*TOLOOH + .54*j73*XYLENOOH + .51*j74*XYLOLOOH + + r206*HYAC*OH + r207*NOA*OH + .5*r211*RO2*CH3O2 + .25*r222*MACRO2*CH3CO3 + + .24*r223*MACRO2*CH3O2 + .25*r225*MACRO2*NO3 + .25*r226*MACRO2*NO + .88*r228*MACR*O3 + + .5*r242*MVK*O3 + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + .25*r280*XO2*CH3CO3 + + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + .07*r300*DICARBO2*HO2 + + .17*r301*DICARBO2*NO + .07*r306*MDIALO2*HO2 + .17*r307*MDIALO2*NO + .4*r317*TOLO2*NO + + .54*r323*XYLENO2*NO + .51*r326*XYLOLO2*NO + - j37*CH3COCHO - r203*NO3*CH3COCHO - r204*OH*CH3COCHO + d(CH3COOH)/dt = .1*r181*CH3CO3*CH3O2 + .15*r182*CH3CO3*HO2 + .12*r197*C3H6*O3 + .15*r233*MCO3*HO2 + - r184*OH*CH3COOH + d(CH3COOOH)/dt = .4*r182*CH3CO3*HO2 + .4*r233*MCO3*HO2 + - j38*CH3COOOH - r185*OH*CH3COOOH + d(CH3OH)/dt = r149*CH3O2*CH3O2 + .3*r170*C2H5O2*CH3O2 + .5*r211*RO2*CH3O2 + .25*r223*MACRO2*CH3O2 + + .25*r256*ISOPAO2*CH3O2 + .25*r261*ISOPBO2*CH3O2 + .2*r270*ISOPNO3*CH3O2 + .3*r281*XO2*CH3O2 + + .25*r335*NTERPO2*CH3O2 + .25*r340*TERP2O2*CH3O2 + .25*r345*TERPO2*CH3O2 + - r152*OH*CH3OH + d(CH3OOH)/dt = r150*CH3O2*HO2 + - j39*CH3OOH - r153*OH*CH3OOH + d(CH4)/dt = .1*r197*C3H6*O3 + - j40*CH4 - j41*CH4 - r65*CL*CH4 - r121*F*CH4 - r154*OH*CH4 - r160*O1D*CH4 - r161*O1D*CH4 + - r162*O1D*CH4 + d(CHBR3)/dt = - j91*CHBR3 - r117*O1D*CHBR3 - r134*CL*CHBR3 - r135*OH*CHBR3 + d(CL)/dt = j75*BRCL + 4*j79*CCL4 + j80*CF2CLBR + 2*j82*CFC11 + 2*j83*CFC113 + 2*j84*CFC114 + j85*CFC115 + + 2*j86*CFC12 + 3*j89*CH3CCL3 + j90*CH3CL + 2*j92*CL2 + 2*j93*CL2O2 + j94*CLO + j95*CLONO2 + + j98*COFCL + j101*HCFC141B + j102*HCFC142B + j103*HCFC22 + j104*HCL + j107*HOCL + r71*CLO*CH3O2 + + 2*r72*CLO*CLO + r74*CLO*CLO + r76*CLO*NO + r81*CLO*O + r82*CLO*OH + r84*HCL*O + r85*HCL*OH + + 4*r89*O1D*CCL4 + r90*O1D*CF2CLBR + 2*r91*O1D*CFC11 + 2*r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + r94*O1D*CFC115 + 2*r95*O1D*CFC12 + r96*O1D*HCL + r105*BRO*CLO + r126*O1D*COFCL + + 3*r131*CH3CCL3*OH + r133*CH3CL*OH + r136*HCFC141B*OH + r137*HCFC142B*OH + r138*HCFC22*OH + + r141*O1D*HCFC141B + r142*O1D*HCFC142B + r143*O1D*HCFC22 + r360*SO*CLO + - r64*CH2O*CL - r65*CH4*CL - r66*H2*CL - r67*H2O2*CL - r68*HO2*CL - r69*HO2*CL - r70*O3*CL + - r77*CLONO2*CL - r86*HOCL*CL - r127*CH2BR2*CL - r129*CH3BR*CL - r132*CH3CL*CL - r134*CHBR3*CL + - r175*C2H6*CL - r205*C3H8*CL + d(CL2)/dt = r73*CLO*CLO + r77*CLONO2*CL + r413*HOCL*HCL + r418*CLONO2*HCL + r419*HOCL*HCL + r423*CLONO2*HCL + + r424*HOCL*HCL + r428*CLONO2*HCL + - j92*CL2 + d(CL2O2)/dt = r98*M*CLO*CLO + - j93*CL2O2 - r99*M*CL2O2 + d(CLO)/dt = j96*CLONO2 + j108*OCLO + r99*M*CL2O2 + r99*M*CL2O2 + r69*CL*HO2 + r70*CL*O3 + r79*CLONO2*O + + r86*HOCL*CL + r87*HOCL*O + r88*HOCL*OH + r97*O1D*HCL + r365*SO*OCLO + - j94*CLO - r71*CH3O2*CLO - 2*r72*CLO*CLO - 2*r73*CLO*CLO - 2*r74*CLO*CLO - r75*HO2*CLO + - r76*NO*CLO - r78*M*NO2*CLO - r81*O*CLO - r82*OH*CLO - r83*OH*CLO - 2*r98*M*CLO*CLO + - r104*BRO*CLO - r105*BRO*CLO - r106*BRO*CLO - r360*SO*CLO + d(CLONO2)/dt = r78*M*CLO*NO2 + - j95*CLONO2 - j96*CLONO2 - r416*CLONO2 - r421*CLONO2 - r427*CLONO2 - r77*CL*CLONO2 + - r79*O*CLONO2 - r80*OH*CLONO2 - r418*HCL*CLONO2 - r423*HCL*CLONO2 - r428*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = 1.5*j23*BEPOMUC + .45*j24*BIGALD + .6*j27*BIGALD3 + j28*BIGALD4 + j33*CH2O + j34*CH2O + + j35*CH3CHO + j37*CH3COCHO + .38*j40*CH4 + j42*CO2 + j44*GLYALD + 2*j45*GLYOXAL + + .33*j46*HONITR + 1.34*j52*MACR + .7*j56*MVK + 1.5*j65*TEPOMUC + .25*j66*TERP2OOH + j69*TERPROD1 + + 1.7*j70*TERPROD2 + j110*CO2 + j137*OCS + r64*CL*CH2O + r100*BR*CH2O + r132*CH3CL*CL + + r145*CH2O*NO3 + r146*CH2O*O + r147*CH2O*OH + .35*r166*M*C2H2*OH + .63*r168*C2H4*O3 + + r191*GLYOXAL*OH + .56*r197*C3H6*O3 + r203*CH3COCHO*NO3 + r204*CH3COCHO*OH + + .22*r222*MACRO2*CH3CO3 + .11*r223*MACRO2*CH3O2 + .22*r225*MACRO2*NO3 + .22*r226*MACRO2*NO + + .65*r228*MACR*O3 + .56*r242*MVK*O3 + .62*r275*ISOP*O3 + .25*r280*XO2*CH3CO3 + .2*r281*XO2*CH3O2 + + .25*r283*XO2*NO + .5*r284*XO2*NO3 + .07*r300*DICARBO2*HO2 + .17*r301*DICARBO2*NO + + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + .14*r306*MDIALO2*HO2 + .35*r307*MDIALO2*NO + + .23*r330*BCARY*O3 + .23*r333*MTERP*O3 + .125*r340*TERP2O2*CH3O2 + .225*r342*TERP2O2*NO + + .7*r351*TERPROD2*OH + r354*OCS*O + r355*OCS*OH + r441*Op*CO2 + - r164*OH*CO + d(CO2)/dt = j38*CH3COOOH + .44*j40*CH4 + .4*j61*PAN + j66*TERP2OOH + .8*j70*TERPROD2 + r156*HCOOH*OH + + r164*CO*OH + 2*r180*CH3CO3*CH3CO3 + .9*r181*CH3CO3*CH3O2 + r183*CH3CO3*NO + r184*CH3COOH*OH + + .5*r185*CH3COOOH*OH + .8*r190*GLYALD*OH + r191*GLYOXAL*OH + .2*r197*C3H6*O3 + + 2*r231*MCO3*CH3CO3 + r232*MCO3*CH3O2 + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + .5*r241*M*MPAN*OH + + .1*r242*MVK*O3 + r255*ISOPAO2*CH3CO3 + r280*XO2*CH3CO3 + .27*r330*BCARY*O3 + .27*r333*MTERP*O3 + + .5*r340*TERP2O2*CH3O2 + .9*r342*TERP2O2*NO + 1.8*r351*TERPROD2*OH + - j42*CO2 - j110*CO2 - r441*Op*CO2 + d(COF2)/dt = j80*CF2CLBR + j81*CF3BR + j83*CFC113 + 2*j84*CFC114 + 2*j85*CFC115 + j86*CFC12 + 2*j99*H2402 + + j102*HCFC142B + j103*HCFC22 + r90*O1D*CF2CLBR + r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + 2*r94*O1D*CFC115 + r95*O1D*CFC12 + r116*O1D*CF3BR + 2*r118*O1D*H2402 + r137*HCFC142B*OH + + r138*HCFC22*OH + r142*O1D*HCFC142B + r143*O1D*HCFC22 + - j97*COF2 - r125*O1D*COF2 + d(COFCL)/dt = j82*CFC11 + j83*CFC113 + j101*HCFC141B + r91*O1D*CFC11 + r92*O1D*CFC113 + r136*HCFC141B*OH + + r141*O1D*HCFC141B + - j98*COFCL - r126*O1D*COFCL + d(CRESOL)/dt = .18*r319*TOLUENE*OH + - r299*OH*CRESOL + d(DMS)/dt = - r352*NO3*DMS - r353*OH*DMS - r367*OH*DMS + d(dst_a1)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(E90)/dt = - r444*E90 + d(EOOH)/dt = r186*EO2*HO2 + - j43*EOOH + d(F)/dt = j81*CF3BR + j85*CFC115 + 2*j97*COF2 + j98*COFCL + j105*HF + r94*O1D*CFC115 + r116*O1D*CF3BR + + 2*r125*O1D*COF2 + r126*O1D*COFCL + - r121*CH4*F - r122*H2*F - r123*H2O*F - r124*HNO3*F + d(GLYALD)/dt = .33*j46*HONITR + .25*j66*TERP2OOH + r189*EO*O2 + .53*r222*MACRO2*CH3CO3 + .26*r223*MACRO2*CH3O2 + + .53*r225*MACRO2*NO3 + .53*r226*MACRO2*NO + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + + .7*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH + r278*NC4CH2OH*OH + .25*r280*XO2*CH3CO3 + + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + .125*r340*TERP2O2*CH3O2 + + .225*r342*TERP2O2*NO + - j44*GLYALD - r190*OH*GLYALD + d(GLYOXAL)/dt = j22*BENZOOH + .13*j24*BIGALD + .7*j62*PHENOOH + .6*j71*TOLOOH + .34*j73*XYLENOOH + + .17*j74*XYLOLOOH + .65*r166*M*C2H2*OH + .2*r190*GLYALD*OH + .05*r264*ISOPBO2*NO + + .05*r265*ISOPBO2*NO3 + r279*NC4CHO*OH + .25*r280*XO2*CH3CO3 + .1*r281*XO2*CH3O2 + + .25*r283*XO2*NO + .25*r284*XO2*NO3 + r290*BENZO2*NO + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + + .07*r306*MDIALO2*HO2 + .17*r307*MDIALO2*NO + .7*r310*PHENO2*NO + .6*r317*TOLO2*NO + + .34*r323*XYLENO2*NO + .17*r326*XYLOLO2*NO + - j45*GLYOXAL - r370*GLYOXAL - r191*OH*GLYOXAL + d(H)/dt = 2*j2*H2O + j3*H2O + 2*j34*CH2O + j39*CH3OOH + .33*j40*CH4 + j41*CH4 + j100*HBR + j104*HCL + + j105*HF + r3*O1D*H2 + r20*H2*O + r29*OH*H2 + r32*OH*O + r52*N*OH + r66*CL*H2 + r97*O1D*HCL + + r120*O1D*HBR + r122*F*H2 + r147*CH2O*OH + r161*O1D*CH4 + r355*OCS*OH + r361*S*OH + r366*SO*OH + - r22*HO2*H - r23*HO2*H - r24*HO2*H - r25*M*O2*H - r28*O3*H + d(H2)/dt = j1*H2O + j33*CH2O + 1.4400001*j40*CH4 + r22*H*HO2 + r162*O1D*CH4 + - r3*O1D*H2 - r20*O*H2 - r29*OH*H2 - r66*CL*H2 - r122*F*H2 + d(H2402)/dt = - j99*H2402 - r118*O1D*H2402 + d(H2O2)/dt = r35*M*OH*OH + r36*HO2*HO2 + - j4*H2O2 - r21*O*H2O2 - r30*OH*H2O2 - r67*CL*H2O2 + d(H2SO4)/dt = r368*SO3*H2O + - j136*H2SO4 + d(HBR)/dt = r100*BR*CH2O + r101*BR*HO2 + - j100*HBR - r113*O*HBR - r114*OH*HBR - r119*O1D*HBR - r120*O1D*HBR + d(HCFC141B)/dt = - j101*HCFC141B - r136*OH*HCFC141B - r141*O1D*HCFC141B + d(HCFC142B)/dt = - j102*HCFC142B - r137*OH*HCFC142B - r142*O1D*HCFC142B + d(HCFC22)/dt = - j103*HCFC22 - r138*OH*HCFC22 - r143*O1D*HCFC22 + d(HCL)/dt = r64*CL*CH2O + r65*CL*CH4 + r66*CL*H2 + r67*CL*H2O2 + r68*CL*HO2 + r83*CLO*OH + r86*HOCL*CL + + r127*CH2BR2*CL + r129*CH3BR*CL + 2*r132*CH3CL*CL + r134*CHBR3*CL + r175*C2H6*CL + r205*CL*C3H8 + - j104*HCL - r84*O*HCL - r85*OH*HCL - r96*O1D*HCL - r97*O1D*HCL - r413*HOCL*HCL + - r418*CLONO2*HCL - r419*HOCL*HCL - r420*HOBR*HCL - r423*CLONO2*HCL - r424*HOCL*HCL + - r425*HOBR*HCL - r428*CLONO2*HCL + d(HCN)/dt = - r155*M*OH*HCN - r163*O1D*HCN + d(HCOOH)/dt = r157*HOCH2OO*HO2 + r159*HOCH2OO*NO + .35*r166*M*C2H2*OH + .37*r168*C2H4*O3 + .12*r197*C3H6*O3 + + .33*r228*MACR*O3 + .12*r242*MVK*O3 + .11*r275*ISOP*O3 + .05*r330*BCARY*O3 + .05*r333*MTERP*O3 + - r156*OH*HCOOH + d(HF)/dt = r121*F*CH4 + r122*F*H2 + r123*F*H2O + r124*F*HNO3 + - j105*HF + d(HNO3)/dt = r372*HONITR + r373*ISOPNITA + r374*ISOPNITB + 2*r375*N2O5 + r376*NC4CH2OH + r377*NC4CHO + + .5*r379*NO2 + r380*NO3 + r381*NTERPOOH + r382*ONITR + r383*TERPNIT + 2*r412*N2O5 + + r414*BRONO2 + 2*r415*N2O5 + r416*CLONO2 + r417*BRONO2 + r421*CLONO2 + r422*BRONO2 + + 2*r426*N2O5 + r427*CLONO2 + r60*M*NO2*OH + r145*CH2O*NO3 + r177*CH3CHO*NO3 + + r203*CH3COCHO*NO3 + r352*DMS*NO3 + r418*CLONO2*HCL + r423*CLONO2*HCL + r428*CLONO2*HCL + - j9*HNO3 - r61*OH*HNO3 - r124*F*HNO3 + d(HO2)/dt = j11*HO2NO2 + j20*ALKNIT + .9*j21*ALKOOH + j22*BENZOOH + 1.5*j23*BEPOMUC + .56*j24*BIGALD + + j25*BIGALD1 + .6*j26*BIGALD2 + .6*j27*BIGALD3 + j28*BIGALD4 + j29*BZOOH + j30*C2H5OOH + + j31*C3H7OOH + j35*CH3CHO + j37*CH3COCHO + 2*j44*GLYALD + 2*j45*GLYOXAL + .67*j46*HONITR + + j47*HPALD + j48*HYAC + j49*ISOPNOOH + j50*ISOPOOH + 1.34*j51*MACR + .66*j52*MACR + j57*NC4CHO + + j62*PHENOOH + j63*POOH + j65*TEPOMUC + j66*TERP2OOH + j67*TERPNIT + j68*TERPOOH + + j69*TERPROD1 + 1.2*j70*TERPROD2 + j71*TOLOOH + j73*XYLENOOH + j74*XYLOLOOH + r62*M*HO2NO2 + + r158*HOCH2OO + r188*EO + r263*ISOPBO2 + r21*H2O2*O + r25*M*H*O2 + r30*OH*H2O2 + r33*OH*O3 + + r51*NO3*OH + r64*CL*CH2O + r67*CL*H2O2 + r71*CLO*CH3O2 + r82*CLO*OH + r100*BR*CH2O + + r112*BRO*OH + r129*CH3BR*CL + r130*CH3BR*OH + r132*CH3CL*CL + r133*CH3CL*OH + r145*CH2O*NO3 + + r146*CH2O*O + 2*r148*CH3O2*CH3O2 + r151*CH3O2*NO + r152*CH3OH*OH + r155*M*HCN*OH + + r156*HCOOH*OH + r159*HOCH2OO*NO + r161*O1D*CH4 + r164*CO*OH + .35*r166*M*C2H2*OH + + .13*r168*C2H4*O3 + 1.2*r169*C2H5O2*C2H5O2 + r170*C2H5O2*CH3O2 + r172*C2H5O2*NO + r173*C2H5OH*OH + + r179*CH3CN*OH + .9*r181*CH3CO3*CH3O2 + .25*r187*EO2*NO + r189*EO*O2 + r190*GLYALD*OH + + r191*GLYOXAL*OH + .28*r197*C3H6*O3 + r198*C3H7O2*CH3O2 + r200*C3H7O2*NO + r206*HYAC*OH + + r209*PO2*NO + .3*r211*RO2*CH3O2 + r219*ENEO2*NO + r221*HONITR*OH + .47*r222*MACRO2*CH3CO3 + + .73*r223*MACRO2*CH3O2 + .47*r225*MACRO2*NO3 + .47*r226*MACRO2*NO + .14*r228*MACR*O3 + + .2*r230*MACROOH*OH + r232*MCO3*CH3O2 + .5*r241*M*MPAN*OH + .28*r242*MVK*O3 + r248*ALKO2*NO + + r255*ISOPAO2*CH3CO3 + r256*ISOPAO2*CH3O2 + .92*r258*ISOPAO2*NO + r259*ISOPAO2*NO3 + + r260*ISOPBO2*CH3CO3 + r261*ISOPBO2*CH3O2 + .92*r264*ISOPBO2*NO + r265*ISOPBO2*NO3 + + .3*r266*ISOPNITA*OH + r267*ISOPNITB*OH + r269*ISOPNO3*CH3CO3 + 1.2*r270*ISOPNO3*CH3O2 + + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + r274*ISOPNOOH*OH + .37*r275*ISOP*O3 + r278*NC4CH2OH*OH + + r279*NC4CHO*OH + r280*XO2*CH3CO3 + .8*r281*XO2*CH3O2 + r283*XO2*NO + r284*XO2*NO3 + + .65*r288*BENZENE*OH + r290*BENZO2*NO + r295*BZOO*NO + .73*r299*CRESOL*OH + + .07*r300*DICARBO2*HO2 + .17*r301*DICARBO2*NO + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + + .33*r306*MDIALO2*HO2 + .83*r307*MDIALO2*NO + r310*PHENO2*NO + .8*r311*PHENOL*OH + r317*TOLO2*NO + + .28*r319*TOLUENE*OH + .38*r321*XYLENES*OH + r323*XYLENO2*NO + r326*XYLOLO2*NO + + .63*r327*XYLOL*OH + .57*r330*BCARY*O3 + .57*r333*MTERP*O3 + .5*r335*NTERPO2*CH3O2 + + r340*TERP2O2*CH3O2 + .9*r342*TERP2O2*NO + r345*TERPO2*CH3O2 + .8*r347*TERPO2*NO + + .2*r351*TERPROD2*OH + r357*M*SO2*OH + .5*r367*DMS*OH + - r371*HO2 - r22*H*HO2 - r23*H*HO2 - r24*H*HO2 - r26*O*HO2 - r27*O3*HO2 - r31*OH*HO2 + - 2*r36*HO2*HO2 - r48*NO3*HO2 - r53*NO*HO2 - r58*M*NO2*HO2 - r68*CL*HO2 - r69*CL*HO2 + - r75*CLO*HO2 - r101*BR*HO2 - r107*BRO*HO2 - r144*CH2O*HO2 - r150*CH3O2*HO2 - r157*HOCH2OO*HO2 + - r171*C2H5O2*HO2 - r182*CH3CO3*HO2 - r186*EO2*HO2 - r199*C3H7O2*HO2 - r208*PO2*HO2 + - r212*RO2*HO2 - r224*MACRO2*HO2 - r233*MCO3*HO2 - r237*MEKO2*HO2 - r247*ALKO2*HO2 + - r257*ISOPAO2*HO2 - r262*ISOPBO2*HO2 - r271*ISOPNO3*HO2 - r282*XO2*HO2 - r286*ACBZO2*HO2 + - r289*BENZO2*HO2 - r293*BZOO*HO2 - r296*C6H5O2*HO2 - r300*DICARBO2*HO2 - r303*MALO2*HO2 + - r306*MDIALO2*HO2 - r309*PHENO2*HO2 - r316*TOLO2*HO2 - r322*XYLENO2*HO2 - r325*XYLOLO2*HO2 + - r336*NTERPO2*HO2 - r341*TERP2O2*HO2 - r346*TERPO2*HO2 + d(HO2NO2)/dt = r58*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r62*M*HO2NO2 - r37*OH*HO2NO2 + d(HOBR)/dt = r414*BRONO2 + r417*BRONO2 + r422*BRONO2 + r107*BRO*HO2 + - j106*HOBR - r115*O*HOBR - r420*HCL*HOBR - r425*HCL*HOBR + d(HOCL)/dt = r416*CLONO2 + r421*CLONO2 + r427*CLONO2 + r75*CLO*HO2 + r80*CLONO2*OH + - j107*HOCL - r86*CL*HOCL - r87*O*HOCL - r88*OH*HOCL - r413*HCL*HOCL - r419*HCL*HOCL + - r424*HCL*HOCL + d(HONITR)/dt = r220*ENEO2*NO + r227*MACRO2*NO + .3*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH + - j46*HONITR - r372*HONITR - r221*OH*HONITR + d(HPALD)/dt = r263*ISOPBO2 + - j47*HPALD - r252*OH*HPALD + d(HYAC)/dt = .17*j46*HONITR + .5*r210*POOH*OH + .2*r211*RO2*CH3O2 + .22*r222*MACRO2*CH3CO3 + + .23*r223*MACRO2*CH3O2 + .22*r225*MACRO2*NO3 + .22*r226*MACRO2*NO + .5*r241*M*MPAN*OH + + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + .7*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH + + .25*r280*XO2*CH3CO3 + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + - j48*HYAC - r206*OH*HYAC + d(HYDRALD)/dt = r260*ISOPBO2*CH3CO3 + .75*r261*ISOPBO2*CH3O2 + .87*r264*ISOPBO2*NO + .95*r265*ISOPBO2*NO3 + - r253*OH*HYDRALD + d(IEPOX)/dt = .6*r277*ISOPOOH*OH + - r254*OH*IEPOX + d(ISOP)/dt = - r268*NO3*ISOP - r275*O3*ISOP - r276*OH*ISOP + d(ISOPNITA)/dt = .08*r258*ISOPAO2*NO + - r373*ISOPNITA - r266*OH*ISOPNITA + d(ISOPNITB)/dt = .08*r264*ISOPBO2*NO + - r374*ISOPNITB - r267*OH*ISOPNITB + d(ISOPNOOH)/dt = r271*ISOPNO3*HO2 + - j49*ISOPNOOH - r274*OH*ISOPNOOH + d(ISOPOOH)/dt = j49*ISOPNOOH + r257*ISOPAO2*HO2 + r262*ISOPBO2*HO2 + - j50*ISOPOOH - r277*OH*ISOPOOH + d(IVOC)/dt = - r399*OH*IVOC + d(MACR)/dt = .3*j50*ISOPOOH + .39*r255*ISOPAO2*CH3CO3 + .31*r256*ISOPAO2*CH3O2 + .36*r258*ISOPAO2*NO + + .4*r259*ISOPAO2*NO3 + .3*r275*ISOP*O3 + - j51*MACR - j52*MACR - r228*O3*MACR - r229*OH*MACR + d(MACROOH)/dt = r224*MACRO2*HO2 + - r230*OH*MACROOH + d(MEK)/dt = .8*j20*ALKNIT + .8*j21*ALKOOH + .8*r248*ALKO2*NO + - j53*MEK - r239*OH*MEK + d(MEKOOH)/dt = .8*r237*MEKO2*HO2 + - j54*MEKOOH - r240*OH*MEKOOH + d(MPAN)/dt = r244*M*MCO3*NO2 + - j55*MPAN - r245*M*MPAN - r241*M*OH*MPAN + d(MTERP)/dt = - r332*NO3*MTERP - r333*O3*MTERP - r334*OH*MTERP + d(MVK)/dt = .7*j50*ISOPOOH + .61*r255*ISOPAO2*CH3CO3 + .44*r256*ISOPAO2*CH3O2 + .56*r258*ISOPAO2*NO + + .6*r259*ISOPAO2*NO3 + .2*r275*ISOP*O3 + - j56*MVK - r242*O3*MVK - r243*OH*MVK + d(N)/dt = .8*j112*N2 + j115*N2 + j116*N2 + .8*j118*N2 + j15*NO + r442*N2*Op + r38*N2D*O + .2*r429*NOp*e + + 1.1*r431*N2p*e + r435*Np*O + r436*Np*O2 + - j111*N - r40*NO*N - r41*NO2*N - r42*NO2*N - r43*NO2*N - r44*O2*N - r52*OH*N - r438*O2p*N + d(N2O)/dt = r41*N*NO2 + - j12*N2O - r56*O1D*N2O - r57*O1D*N2O + d(N2O5)/dt = r59*M*NO2*NO3 + - j13*N2O5 - j14*N2O5 - r63*M*N2O5 - r375*N2O5 - r412*N2O5 - r415*N2O5 - r426*N2O5 + d(NC4CH2OH)/dt = .2*r270*ISOPNO3*CH3O2 + - r376*NC4CH2OH - r278*OH*NC4CH2OH + d(NC4CHO)/dt = r269*ISOPNO3*CH3CO3 + .8*r270*ISOPNO3*CH3O2 + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + - j57*NC4CHO - r377*NC4CHO - r279*OH*NC4CHO + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 + d(ncl_a3)/dt = 0 + d(NH3)/dt = - r369*OH*NH3 + d(NH4)/dt = - r378*NH4 + d(NH_5)/dt = - r446*NH_5 + d(NH_50)/dt = - r445*NH_50 + d(NO)/dt = j14*N2O5 + j17*NO2 + j19*NO3 + .5*r379*NO2 + r439*N2*O2p + r39*N2D*O2 + 2*r42*N*NO2 + r44*N*O2 + + r45*NO2*O + r52*N*OH + 2*r56*O1D*N2O + r362*SO*NO2 + - j15*NO - j16*NO - r40*N*NO - r49*NO3*NO - r53*HO2*NO - r54*O3*NO - r55*M*O*NO - r76*CLO*NO + - r108*BRO*NO - r151*CH3O2*NO - r159*HOCH2OO*NO - r172*C2H5O2*NO - r183*CH3CO3*NO - r187*EO2*NO + - r200*C3H7O2*NO - r209*PO2*NO - r213*RO2*NO - r219*ENEO2*NO - r220*ENEO2*NO - r226*MACRO2*NO + - r227*MACRO2*NO - r235*MCO3*NO - r238*MEKO2*NO - r248*ALKO2*NO - r249*ALKO2*NO - r258*ISOPAO2*NO + - r264*ISOPBO2*NO - r272*ISOPNO3*NO - r283*XO2*NO - r287*ACBZO2*NO - r290*BENZO2*NO + - r295*BZOO*NO - r297*C6H5O2*NO - r301*DICARBO2*NO - r304*MALO2*NO - r307*MDIALO2*NO + - r310*PHENO2*NO - r317*TOLO2*NO - r323*XYLENO2*NO - r326*XYLOLO2*NO - r337*NTERPO2*NO + - r342*TERP2O2*NO - r347*TERPO2*NO - r440*O2p*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j20*ALKNIT + j46*HONITR + j49*ISOPNOOH + j55*MPAN + + j57*NC4CHO + j58*NOA + j59*NTERPOOH + j60*ONITR + .6*j61*PAN + j67*TERPNIT + j77*BRONO2 + + j96*CLONO2 + r62*M*HO2NO2 + r63*M*N2O5 + r195*M*PAN + r245*M*MPAN + r320*M*PBZNIT + + r37*HO2NO2*OH + r48*NO3*HO2 + 2*r49*NO3*NO + r50*NO3*O + r51*NO3*OH + r53*NO*HO2 + r54*NO*O3 + + r55*M*NO*O + r76*CLO*NO + r108*BRO*NO + r151*CH3O2*NO + r159*HOCH2OO*NO + r172*C2H5O2*NO + + r183*CH3CO3*NO + r187*EO2*NO + r200*C3H7O2*NO + r207*NOA*OH + r209*PO2*NO + r213*RO2*NO + + r217*BIGENE*NO3 + r219*ENEO2*NO + r225*MACRO2*NO3 + r226*MACRO2*NO + r235*MCO3*NO + + r236*MCO3*NO3 + r238*MEKO2*NO + r246*ALKNIT*OH + r248*ALKO2*NO + .92*r258*ISOPAO2*NO + + r259*ISOPAO2*NO3 + .92*r264*ISOPBO2*NO + r265*ISOPBO2*NO3 + .7*r266*ISOPNITA*OH + + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + r283*XO2*NO + r284*XO2*NO3 + r287*ACBZO2*NO + + r290*BENZO2*NO + r295*BZOO*NO + r297*C6H5O2*NO + r301*DICARBO2*NO + r304*MALO2*NO + + r307*MDIALO2*NO + r310*PHENO2*NO + r317*TOLO2*NO + r323*XYLENO2*NO + r326*XYLOLO2*NO + + .5*r335*NTERPO2*CH3O2 + 1.6*r337*NTERPO2*NO + 2*r338*NTERPO2*NO3 + .9*r342*TERP2O2*NO + + r344*TERPNIT*OH + .8*r347*TERPO2*NO + - j17*NO2 - r379*NO2 - r41*N*NO2 - r42*N*NO2 - r43*N*NO2 - r45*O*NO2 - r46*O3*NO2 + - r47*M*O*NO2 - r58*M*HO2*NO2 - r59*M*NO3*NO2 - r60*M*OH*NO2 - r78*M*CLO*NO2 - r109*M*BRO*NO2 + - r194*M*CH3CO3*NO2 - r244*M*MCO3*NO2 - r302*M*DICARBO2*NO2 - r305*M*MALO2*NO2 + - r308*M*MDIALO2*NO2 - r312*PHENO*NO2 - r315*M*ACBZO2*NO2 - r362*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j61*PAN + j78*BRONO2 + j95*CLONO2 + r63*M*N2O5 + + r46*NO2*O3 + r47*M*NO2*O + r61*HNO3*OH + r77*CLONO2*CL + r79*CLONO2*O + r80*CLONO2*OH + + r110*BRONO2*O + r124*F*HNO3 + r192*PAN*OH + .5*r241*M*MPAN*OH + - j18*NO3 - j19*NO3 - r380*NO3 - r48*HO2*NO3 - r49*NO*NO3 - r50*O*NO3 - r51*OH*NO3 + - r59*M*NO2*NO3 - r145*CH2O*NO3 - r177*CH3CHO*NO3 - r196*C3H6*NO3 - r203*CH3COCHO*NO3 + - r217*BIGENE*NO3 - r225*MACRO2*NO3 - r236*MCO3*NO3 - r259*ISOPAO2*NO3 - r265*ISOPBO2*NO3 + - r268*ISOP*NO3 - r273*ISOPNO3*NO3 - r284*XO2*NO3 - r329*BCARY*NO3 - r332*MTERP*NO3 + - r338*NTERPO2*NO3 - r349*TERPROD1*NO3 - r352*DMS*NO3 + d(NOA)/dt = r196*C3H6*NO3 + .5*r267*ISOPNITB*OH + r274*ISOPNOOH*OH + r278*NC4CH2OH*OH + r279*NC4CHO*OH + - j58*NOA - r207*OH*NOA + d(NTERPOOH)/dt = r336*NTERPO2*HO2 + - j59*NTERPOOH - r381*NTERPOOH - r339*OH*NTERPOOH + 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 = j2*H2O + 2*j5*O2 + j6*O2 + j8*O3 + j14*N2O5 + j15*NO + j17*NO2 + j18*NO3 + .18*j40*CH4 + + j42*CO2 + j76*BRO + j94*CLO + j108*OCLO + j110*CO2 + j127*O2 + j128*O2 + j129*O2 + j131*O2 + + j132*O2 + j133*O2 + 2*j134*O2 + 2*j135*O2 + j138*SO + j139*SO2 + j140*SO3 + r5*N2*O1D + + r6*O1D*O2 + r7*O1D*O2 + r24*H*HO2 + r34*OH*OH + r40*N*NO + r41*N*NO2 + r44*N*O2 + r356*S*O2 + + r363*SO*O2 + r429*NOp*e + 1.15*r430*O2p*e + r437*Np*O2 + r438*O2p*N + r443*Op*O2 + - j120*O - j121*O - j122*O - j123*O - j124*O - j125*O - r17*O3*O - 2*r18*M*O*O - r19*M*O2*O + - r20*H2*O - r21*H2O2*O - r26*HO2*O - r32*OH*O - r45*NO2*O - r47*M*NO2*O - r50*NO3*O + - r55*M*NO*O - r79*CLONO2*O - r81*CLO*O - r84*HCL*O - r87*HOCL*O - r110*BRONO2*O - r111*BRO*O + - r113*HBR*O - r115*HOBR*O - r146*CH2O*O - r354*OCS*O - r433*N2p*O - r434*N2p*O - r435*Np*O + d(O2)/dt = j8*O3 + j19*NO3 + r1*O2_1D + r2*O2_1S + r9*N2*O2_1D + r8*O1D*O3 + r8*O1D*O3 + r10*O2_1D*O + + 2*r11*O2_1D*O2 + 2*r17*O*O3 + r18*M*O*O + r22*H*HO2 + r26*HO2*O + 2*r27*HO2*O3 + r28*H*O3 + + r31*OH*HO2 + r32*OH*O + r33*OH*O3 + r36*HO2*HO2 + r37*HO2NO2*OH + r43*N*NO2 + r45*NO2*O + + r46*NO2*O3 + r48*NO3*HO2 + r50*NO3*O + r54*NO*O3 + r57*O1D*N2O + r68*CL*HO2 + r70*CL*O3 + + r72*CLO*CLO + r73*CLO*CLO + r75*CLO*HO2 + r81*CLO*O + r83*CLO*OH + r101*BR*HO2 + r102*BR*O3 + + r103*BRO*BRO + r105*BRO*CLO + r106*BRO*CLO + r107*BRO*HO2 + r111*BRO*O + r150*CH3O2*HO2 + + r171*C2H5O2*HO2 + r199*C3H7O2*HO2 + r208*PO2*HO2 + r358*S*O3 + r364*SO*O3 + r440*O2p*NO + - j5*O2 - j6*O2 - j126*O2 - j127*O2 - j128*O2 - j129*O2 - j130*O2 - j131*O2 - j132*O2 + - j133*O2 - j134*O2 - j135*O2 - r6*O1D*O2 - r11*O2_1D*O2 - r19*M*O*O2 - r25*M*H*O2 - r39*N2D*O2 + - r44*N*O2 - r189*EO*O2 - r356*S*O2 - r363*SO*O2 - r432*N2p*O2 - r436*Np*O2 - r437*Np*O2 + - r443*Op*O2 + d(O3)/dt = r19*M*O*O2 + .15*r182*CH3CO3*HO2 + .15*r233*MCO3*HO2 + - j7*O3 - j8*O3 - r8*O1D*O3 - r17*O*O3 - r27*HO2*O3 - r28*H*O3 - r33*OH*O3 - r46*NO2*O3 + - r54*NO*O3 - r70*CL*O3 - r102*BR*O3 - r168*C2H4*O3 - r197*C3H6*O3 - r228*MACR*O3 - r242*MVK*O3 + - r275*ISOP*O3 - r313*PHENO*O3 - r330*BCARY*O3 - r333*MTERP*O3 - r358*S*O3 - r364*SO*O3 + d(O3S)/dt = 0 + d(OCLO)/dt = r74*CLO*CLO + r104*BRO*CLO + - j108*OCLO - r365*SO*OCLO + d(OCS)/dt = - j137*OCS - r354*O*OCS - r355*OH*OCS + d(ONITR)/dt = r221*HONITR*OH + .1*r342*TERP2O2*NO + - j60*ONITR - r382*ONITR + d(PAN)/dt = r194*M*CH3CO3*NO2 + - j61*PAN - r195*M*PAN - r192*OH*PAN + d(PBZNIT)/dt = r315*M*ACBZO2*NO2 + - r320*M*PBZNIT + d(PHENO)/dt = j32*C6H5OOH + r297*C6H5O2*NO + .07*r299*CRESOL*OH + .06*r311*PHENOL*OH + .07*r327*XYLOL*OH + - r312*NO2*PHENO - r313*O3*PHENO + d(PHENOL)/dt = .53*r288*BENZENE*OH + - r311*OH*PHENOL + d(PHENOOH)/dt = r309*PHENO2*HO2 + - j62*PHENOOH - r314*OH*PHENOOH + d(pom_a1)/dt = 0 + d(pom_a4)/dt = 0 + d(POOH)/dt = r208*PO2*HO2 + - j63*POOH - r210*OH*POOH + d(ROOH)/dt = .85*r212*RO2*HO2 + - j64*ROOH - r214*OH*ROOH + d(S)/dt = j137*OCS + j138*SO + - r356*O2*S - r358*O3*S - r361*OH*S + d(SF6)/dt = - j109*SF6 + d(SO)/dt = j139*SO2 + r354*OCS*O + r356*S*O2 + r358*S*O3 + r361*S*OH + - j138*SO - r359*BRO*SO - r360*CLO*SO - r362*NO2*SO - r363*O2*SO - r364*O3*SO - r365*OCLO*SO + - r366*OH*SO + d(SO2)/dt = j140*SO3 + r352*DMS*NO3 + r353*DMS*OH + r355*OCS*OH + r359*SO*BRO + r360*SO*CLO + r362*SO*NO2 + + r363*SO*O2 + r364*SO*O3 + r365*SO*OCLO + r366*SO*OH + .5*r367*DMS*OH + - j139*SO2 - r357*M*OH*SO2 + d(SO3)/dt = j136*H2SO4 + r357*M*SO2*OH + - j140*SO3 - r368*H2O*SO3 + d(so4_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(so4_a3)/dt = 0 + d(so4_a5)/dt = 0 + d(soa1_a1)/dt = - j141*soa1_a1 + d(soa1_a2)/dt = - j142*soa1_a2 + d(soa2_a1)/dt = - j143*soa2_a1 + d(soa2_a2)/dt = - j144*soa2_a2 + d(soa3_a1)/dt = - j145*soa3_a1 + d(soa3_a2)/dt = - j146*soa3_a2 + d(soa4_a1)/dt = - j147*soa4_a1 + d(soa4_a2)/dt = - j148*soa4_a2 + d(soa5_a1)/dt = - j149*soa5_a1 + d(soa5_a2)/dt = - j150*soa5_a2 + d(SOAG0)/dt = r370*GLYOXAL + .2202*r385*BCARYO2VBS*HO2 + .1279*r386*BCARYO2VBS*NO + .2202*r387*BCARY*O3 + + .0023*r390*BENZO2VBS*HO2 + .0097*r391*BENZO2VBS*NO + .0031*r393*ISOPO2VBS*HO2 + + .0003*r394*ISOPO2VBS*NO + .2381*r397*IVOCO2VBS*HO2 + .1056*r398*IVOCO2VBS*NO + + .0508*r401*MTERPO2VBS*HO2 + .0245*r402*MTERPO2VBS*NO + .0508*r403*MTERP*O3 + + .5931*r405*SVOC*OH + .1364*r407*TOLUO2VBS*HO2 + .0154*r408*TOLUO2VBS*NO + + .1677*r410*XYLEO2VBS*HO2 + .0063*r411*XYLEO2VBS*NO + d(SOAG1)/dt = .2067*r385*BCARYO2VBS*HO2 + .1792*r386*BCARYO2VBS*NO + .2067*r387*BCARY*O3 + + .0008*r390*BENZO2VBS*HO2 + .0034*r391*BENZO2VBS*NO + .0035*r393*ISOPO2VBS*HO2 + + .0003*r394*ISOPO2VBS*NO + .1308*r397*IVOCO2VBS*HO2 + .1026*r398*IVOCO2VBS*NO + + .1149*r401*MTERPO2VBS*HO2 + .0082*r402*MTERPO2VBS*NO + .1149*r403*MTERP*O3 + + .1534*r405*SVOC*OH + .0101*r407*TOLUO2VBS*HO2 + .0452*r408*TOLUO2VBS*NO + + .0174*r410*XYLEO2VBS*HO2 + .0237*r411*XYLEO2VBS*NO + d(SOAG2)/dt = .0653*r385*BCARYO2VBS*HO2 + .0676*r386*BCARYO2VBS*NO + .0653*r387*BCARY*O3 + + .0843*r390*BENZO2VBS*HO2 + .1579*r391*BENZO2VBS*NO + .0003*r393*ISOPO2VBS*HO2 + + .0073*r394*ISOPO2VBS*NO + .0348*r397*IVOCO2VBS*HO2 + .0521*r398*IVOCO2VBS*NO + + .0348*r401*MTERPO2VBS*HO2 + .0772*r402*MTERPO2VBS*NO + .0348*r403*MTERP*O3 + + .0459*r405*SVOC*OH + .0763*r407*TOLUO2VBS*HO2 + .0966*r408*TOLUO2VBS*NO + + .086*r410*XYLEO2VBS*HO2 + .0025*r411*XYLEO2VBS*NO + d(SOAG3)/dt = .17493*r384*BCARY*NO3 + .1284*r385*BCARYO2VBS*HO2 + .079*r386*BCARYO2VBS*NO + .1284*r387*BCARY*O3 + + .0443*r390*BENZO2VBS*HO2 + .0059*r391*BENZO2VBS*NO + .059024*r392*ISOP*NO3 + + .0271*r393*ISOPO2VBS*HO2 + .0057*r394*ISOPO2VBS*NO + .0033*r395*ISOP*O3 + + .0076*r397*IVOCO2VBS*HO2 + .0143*r398*IVOCO2VBS*NO + .17493*r400*MTERP*NO3 + + .0554*r401*MTERPO2VBS*HO2 + .0332*r402*MTERPO2VBS*NO + .0554*r403*MTERP*O3 + + .0085*r405*SVOC*OH + .2157*r407*TOLUO2VBS*HO2 + .0073*r408*TOLUO2VBS*NO + + .0512*r410*XYLEO2VBS*HO2 + .011*r411*XYLEO2VBS*NO + d(SOAG4)/dt = .59019*r384*BCARY*NO3 + .114*r385*BCARYO2VBS*HO2 + .1254*r386*BCARYO2VBS*NO + .114*r387*BCARY*O3 + + .1621*r390*BENZO2VBS*HO2 + .0536*r391*BENZO2VBS*NO + .025024*r392*ISOP*NO3 + + .0474*r393*ISOPO2VBS*HO2 + .0623*r394*ISOPO2VBS*NO + .0113*r397*IVOCO2VBS*HO2 + + .0166*r398*IVOCO2VBS*NO + .59019*r400*MTERP*NO3 + .1278*r401*MTERPO2VBS*HO2 + + .13*r402*MTERPO2VBS*NO + .1278*r403*MTERP*O3 + .0128*r405*SVOC*OH + .0738*r407*TOLUO2VBS*HO2 + + .238*r408*TOLUO2VBS*NO + .1598*r410*XYLEO2VBS*HO2 + .1185*r411*XYLEO2VBS*NO + d(ST80_25)/dt = - r447*ST80_25 + d(SVOC)/dt = - r405*OH*SVOC + d(TEPOMUC)/dt = .1*r319*TOLUENE*OH + .23*r321*XYLENES*OH + - j65*TEPOMUC + d(TERP2OOH)/dt = r341*TERP2O2*HO2 + - j66*TERP2OOH - r343*OH*TERP2OOH + d(TERPNIT)/dt = .5*r335*NTERPO2*CH3O2 + .2*r337*NTERPO2*NO + .2*r347*TERPO2*NO + - j67*TERPNIT - r383*TERPNIT - r344*OH*TERPNIT + d(TERPOOH)/dt = r346*TERPO2*HO2 + - j68*TERPOOH - r348*OH*TERPOOH + d(TERPROD1)/dt = j59*NTERPOOH + j67*TERPNIT + j68*TERPOOH + .33*r330*BCARY*O3 + .33*r333*MTERP*O3 + + .5*r335*NTERPO2*CH3O2 + .8*r337*NTERPO2*NO + r338*NTERPO2*NO3 + r344*TERPNIT*OH + + r345*TERPO2*CH3O2 + .8*r347*TERPO2*NO + - j69*TERPROD1 - r349*NO3*TERPROD1 - r350*OH*TERPROD1 + d(TERPROD2)/dt = j66*TERP2OOH + j69*TERPROD1 + .3*r330*BCARY*O3 + .3*r333*MTERP*O3 + r340*TERP2O2*CH3O2 + + .9*r342*TERP2O2*NO + - j70*TERPROD2 - r351*OH*TERPROD2 + d(TOLOOH)/dt = r316*TOLO2*HO2 + - j71*TOLOOH - r318*OH*TOLOOH + d(TOLUENE)/dt = - r319*OH*TOLUENE + d(XOOH)/dt = r282*XO2*HO2 + - j72*XOOH - r285*OH*XOOH + d(XYLENES)/dt = - r321*OH*XYLENES + d(XYLENOOH)/dt = r322*XYLENO2*HO2 + - j73*XYLENOOH - r324*OH*XYLENOOH + d(XYLOL)/dt = .15*r321*XYLENES*OH + - r327*OH*XYLOL + d(XYLOLOOH)/dt = r325*XYLOLO2*HO2 + - j74*XYLOLOOH - r328*OH*XYLOLOOH + d(NHDEP)/dt = r378*NH4 + r369*NH3*OH + d(NDEP)/dt = .5*r241*M*MPAN*OH + r302*M*DICARBO2*NO2 + r305*M*MALO2*NO2 + r308*M*MDIALO2*NO2 + r312*PHENO*NO2 + + .2*r337*NTERPO2*NO + .5*r349*TERPROD1*NO3 + d(ACBZO2)/dt = r320*M*PBZNIT + r292*BZALD*OH + - r286*HO2*ACBZO2 - r287*NO*ACBZO2 - r315*M*NO2*ACBZO2 + d(ALKO2)/dt = r250*ALKOOH*OH + r251*BIGALK*OH + - r247*HO2*ALKO2 - r248*NO*ALKO2 - r249*NO*ALKO2 + d(BCARYO2VBS)/dt = r388*BCARY*OH + - r385*HO2*BCARYO2VBS - r386*NO*BCARYO2VBS + d(BENZO2)/dt = .35*r288*BENZENE*OH + r291*BENZOOH*OH + - r289*HO2*BENZO2 - r290*NO*BENZO2 + d(BENZO2VBS)/dt = r389*BENZENE*OH + - r390*HO2*BENZO2VBS - r391*NO*BENZO2VBS + d(BZOO)/dt = r294*BZOOH*OH + .07*r319*TOLUENE*OH + .06*r321*XYLENES*OH + - r293*HO2*BZOO - r295*NO*BZOO + d(C2H5O2)/dt = j53*MEK + .5*r174*C2H5OOH*OH + r175*C2H6*CL + r176*C2H6*OH + - 2*r169*C2H5O2*C2H5O2 - r170*CH3O2*C2H5O2 - r171*HO2*C2H5O2 - r172*NO*C2H5O2 + d(C3H7O2)/dt = r201*C3H7OOH*OH + r202*C3H8*OH + r205*CL*C3H8 + - r198*CH3O2*C3H7O2 - r199*HO2*C3H7O2 - r200*NO*C3H7O2 + d(C6H5O2)/dt = .4*r286*ACBZO2*HO2 + r287*ACBZO2*NO + r298*C6H5OOH*OH + r313*PHENO*O3 + - r296*HO2*C6H5O2 - r297*NO*C6H5O2 + d(CH3CO3)/dt = .13*j24*BIGALD + j28*BIGALD4 + j36*CH3COCH3 + j37*CH3COCHO + .33*j46*HONITR + j48*HYAC + + 1.34*j51*MACR + j53*MEK + j54*MEKOOH + .3*j56*MVK + j58*NOA + .6*j61*PAN + j64*ROOH + + .5*j65*TEPOMUC + .65*j70*TERPROD2 + r195*M*PAN + r177*CH3CHO*NO3 + r178*CH3CHO*OH + + .5*r185*CH3COOOH*OH + r203*CH3COCHO*NO3 + r204*CH3COCHO*OH + .3*r211*RO2*CH3O2 + + .15*r212*RO2*HO2 + r213*RO2*NO + .53*r222*MACRO2*CH3CO3 + .26*r223*MACRO2*CH3O2 + + .53*r225*MACRO2*NO3 + .53*r226*MACRO2*NO + .1*r228*MACR*O3 + r232*MCO3*CH3O2 + + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + r235*MCO3*NO + r236*MCO3*NO3 + .2*r237*MEKO2*HO2 + + r238*MEKO2*NO + .28*r242*MVK*O3 + .08*r275*ISOP*O3 + .06*r330*BCARY*O3 + .06*r333*MTERP*O3 + + .65*r351*TERPROD2*OH + - 2*r180*CH3CO3*CH3CO3 - r181*CH3O2*CH3CO3 - r182*HO2*CH3CO3 - r183*NO*CH3CO3 + - r194*M*NO2*CH3CO3 - r222*MACRO2*CH3CO3 - r255*ISOPAO2*CH3CO3 - r260*ISOPBO2*CH3CO3 + - r269*ISOPNO3*CH3CO3 - r280*XO2*CH3CO3 + d(CH3O2)/dt = j35*CH3CHO + j36*CH3COCH3 + j38*CH3COOOH + j41*CH4 + .3*j56*MVK + .4*j61*PAN + j88*CH3BR + + j90*CH3CL + r65*CL*CH4 + r121*F*CH4 + .7*r153*CH3OOH*OH + r154*CH4*OH + r160*O1D*CH4 + + 2*r180*CH3CO3*CH3CO3 + .9*r181*CH3CO3*CH3O2 + .45*r182*CH3CO3*HO2 + r183*CH3CO3*NO + + r184*CH3COOH*OH + .28*r197*C3H6*O3 + r222*MACRO2*CH3CO3 + r231*MCO3*CH3CO3 + + r255*ISOPAO2*CH3CO3 + r260*ISOPBO2*CH3CO3 + r269*ISOPNO3*CH3CO3 + .05*r275*ISOP*O3 + + r280*XO2*CH3CO3 + .33*r300*DICARBO2*HO2 + .83*r301*DICARBO2*NO + .07*r306*MDIALO2*HO2 + + .17*r307*MDIALO2*NO + - r71*CLO*CH3O2 - 2*r148*CH3O2*CH3O2 - 2*r149*CH3O2*CH3O2 - r150*HO2*CH3O2 - r151*NO*CH3O2 + - r170*C2H5O2*CH3O2 - r181*CH3CO3*CH3O2 - r198*C3H7O2*CH3O2 - r211*RO2*CH3O2 + - r223*MACRO2*CH3O2 - r232*MCO3*CH3O2 - r256*ISOPAO2*CH3O2 - r261*ISOPBO2*CH3O2 + - r270*ISOPNO3*CH3O2 - r281*XO2*CH3O2 - r335*NTERPO2*CH3O2 - r340*TERP2O2*CH3O2 + - r345*TERPO2*CH3O2 + d(DICARBO2)/dt = .6*j26*BIGALD2 + - r300*HO2*DICARBO2 - r301*NO*DICARBO2 - r302*M*NO2*DICARBO2 + d(e)/dt = j113*N2 + j114*N2 + j115*N2 + j116*N2 + j117*N2 + j119*N2 + j16*NO + j111*N + j120*O + j121*O + + j122*O + j123*O + j124*O + j125*O + j126*O2 + j127*O2 + j128*O2 + j129*O2 + j130*O2 + + j131*O2 + j132*O2 + j133*O2 + - r429*NOp*e - r430*O2p*e - r431*N2p*e + d(ENEO2)/dt = r218*BIGENE*OH + - r219*NO*ENEO2 - r220*NO*ENEO2 + d(EO)/dt = j43*EOOH + .75*r187*EO2*NO + - r188*EO - r189*O2*EO + d(EO2)/dt = r193*M*C2H4*OH + - r186*HO2*EO2 - r187*NO*EO2 + d(HOCH2OO)/dt = r144*CH2O*HO2 + - r158*HOCH2OO - r157*HO2*HOCH2OO - r159*NO*HOCH2OO + d(ISOPAO2)/dt = .6*r276*ISOP*OH + - r255*CH3CO3*ISOPAO2 - r256*CH3O2*ISOPAO2 - r257*HO2*ISOPAO2 - r258*NO*ISOPAO2 + - r259*NO3*ISOPAO2 + d(ISOPBO2)/dt = .4*r276*ISOP*OH + - r263*ISOPBO2 - r260*CH3CO3*ISOPBO2 - r261*CH3O2*ISOPBO2 - r262*HO2*ISOPBO2 + - r264*NO*ISOPBO2 - r265*NO3*ISOPBO2 + d(ISOPNO3)/dt = r268*ISOP*NO3 + - r269*CH3CO3*ISOPNO3 - r270*CH3O2*ISOPNO3 - r271*HO2*ISOPNO3 - r272*NO*ISOPNO3 + - r273*NO3*ISOPNO3 + d(ISOPO2VBS)/dt = r396*ISOP*OH + - r393*HO2*ISOPO2VBS - r394*NO*ISOPO2VBS + d(IVOCO2VBS)/dt = r399*IVOC*OH + - r397*HO2*IVOCO2VBS - r398*NO*IVOCO2VBS + d(MACRO2)/dt = .5*r229*MACR*OH + .2*r230*MACROOH*OH + r243*MVK*OH + - r222*CH3CO3*MACRO2 - r223*CH3O2*MACRO2 - r224*HO2*MACRO2 - r225*NO3*MACRO2 - r226*NO*MACRO2 + - r227*NO*MACRO2 + d(MALO2)/dt = .6*j25*BIGALD1 + - r303*HO2*MALO2 - r304*NO*MALO2 - r305*M*NO2*MALO2 + d(MCO3)/dt = .66*j51*MACR + j55*MPAN + r245*M*MPAN + .5*r229*MACR*OH + .5*r230*MACROOH*OH + - r231*CH3CO3*MCO3 - r232*CH3O2*MCO3 - r233*HO2*MCO3 - 2*r234*MCO3*MCO3 - r235*NO*MCO3 + - r236*NO3*MCO3 - r244*M*NO2*MCO3 + d(MDIALO2)/dt = .6*j27*BIGALD3 + - r306*HO2*MDIALO2 - r307*NO*MDIALO2 - r308*M*NO2*MDIALO2 + d(MEKO2)/dt = r239*MEK*OH + r240*MEKOOH*OH + - r237*HO2*MEKO2 - r238*NO*MEKO2 + d(MTERPO2VBS)/dt = r404*MTERP*OH + - r401*HO2*MTERPO2VBS - r402*NO*MTERPO2VBS + d(N2D)/dt = 1.2*j112*N2 + j113*N2 + j117*N2 + 1.2*j118*N2 + .8*r429*NOp*e + .9*r431*N2p*e + r433*N2p*O + - r38*O*N2D - r39*O2*N2D + d(N2p)/dt = j114*N2 + j119*N2 + - r431*e*N2p - r432*O2*N2p - r433*O*N2p - r434*O*N2p + d(NOp)/dt = j16*NO + r439*N2*O2p + r442*N2*Op + r433*N2p*O + r437*Np*O2 + r438*O2p*N + r440*O2p*NO + - r429*e*NOp + d(Np)/dt = j113*N2 + j115*N2 + j116*N2 + j117*N2 + j111*N + - r435*O*Np - r436*O2*Np - r437*O2*Np + d(NTERPO2)/dt = r329*BCARY*NO3 + r332*MTERP*NO3 + r339*NTERPOOH*OH + .5*r349*TERPROD1*NO3 + - r335*CH3O2*NTERPO2 - r336*HO2*NTERPO2 - r337*NO*NTERPO2 - r338*NO3*NTERPO2 + d(O1D)/dt = j1*H2O + j6*O2 + j7*O3 + j12*N2O + r39*N2D*O2 + .85*r430*O2p*e + - r5*N2*O1D - r3*H2*O1D - r4*H2O*O1D - r6*O2*O1D - r7*O2*O1D - r8*O3*O1D - r56*N2O*O1D + - r57*N2O*O1D - r89*CCL4*O1D - r90*CF2CLBR*O1D - r91*CFC11*O1D - r92*CFC113*O1D - r93*CFC114*O1D + - r94*CFC115*O1D - r95*CFC12*O1D - r96*HCL*O1D - r97*HCL*O1D - r116*CF3BR*O1D - r117*CHBR3*O1D + - r118*H2402*O1D - r119*HBR*O1D - r120*HBR*O1D - r125*COF2*O1D - r126*COFCL*O1D + - r139*CH2BR2*O1D - r140*CH3BR*O1D - r141*HCFC141B*O1D - r142*HCFC142B*O1D - r143*HCFC22*O1D + - r160*CH4*O1D - r161*CH4*O1D - r162*CH4*O1D - r163*HCN*O1D + d(O2_1D)/dt = j7*O3 + r13*N2*O2_1S + r12*O2_1S*CO2 + r14*O2_1S*O + r15*O2_1S*O2 + r16*O2_1S*O3 + - r1*O2_1D - r9*N2*O2_1D - r10*O*O2_1D - r11*O2*O2_1D + d(O2_1S)/dt = r6*O1D*O2 + - r2*O2_1S - r13*N2*O2_1S - r12*CO2*O2_1S - r14*O*O2_1S - r15*O2*O2_1S - r16*O3*O2_1S + d(O2p)/dt = j126*O2 + j130*O2 + r432*N2p*O2 + r436*Np*O2 + r441*Op*CO2 + r443*Op*O2 + - r439*N2*O2p - r430*e*O2p - r438*N*O2p - r440*NO*O2p + d(OH)/dt = j3*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j21*ALKOOH + j22*BENZOOH + j29*BZOOH + j30*C2H5OOH + + j31*C3H7OOH + j32*C6H5OOH + j38*CH3COOOH + j39*CH3OOH + .33*j40*CH4 + j43*EOOH + j47*HPALD + + j50*ISOPOOH + j54*MEKOOH + j59*NTERPOOH + j62*PHENOOH + j63*POOH + j64*ROOH + j66*TERP2OOH + + j68*TERPOOH + j71*TOLOOH + j72*XOOH + j73*XYLENOOH + j74*XYLOLOOH + j106*HOBR + j107*HOCL + + .5*r379*NO2 + r3*O1D*H2 + 2*r4*O1D*H2O + r20*H2*O + r21*H2O2*O + 2*r23*H*HO2 + r26*HO2*O + + r27*HO2*O3 + r28*H*O3 + r48*NO3*HO2 + r53*NO*HO2 + r69*CL*HO2 + r84*HCL*O + r87*HOCL*O + + r96*O1D*HCL + r113*HBR*O + r115*HOBR*O + r119*O1D*HBR + r123*F*H2O + r146*CH2O*O + + .3*r153*CH3OOH*OH + r160*O1D*CH4 + r163*O1D*HCN + .65*r166*M*C2H2*OH + .13*r168*C2H4*O3 + + .5*r174*C2H5OOH*OH + .45*r182*CH3CO3*HO2 + .36*r197*C3H6*O3 + .5*r210*POOH*OH + .15*r212*RO2*HO2 + + .24*r228*MACR*O3 + .1*r230*MACROOH*OH + .45*r233*MCO3*HO2 + .2*r237*MEKO2*HO2 + .36*r242*MVK*O3 + + .32*r275*ISOP*O3 + .6*r277*ISOPOOH*OH + .5*r285*XOOH*OH + .4*r286*ACBZO2*HO2 + + .4*r300*DICARBO2*HO2 + .4*r306*MDIALO2*HO2 + .63*r330*BCARY*O3 + .63*r333*MTERP*O3 + - r29*H2*OH - r30*H2O2*OH - r31*HO2*OH - r32*O*OH - r33*O3*OH - 2*r34*OH*OH - 2*r35*M*OH*OH + - r37*HO2NO2*OH - r51*NO3*OH - r52*N*OH - r60*M*NO2*OH - r61*HNO3*OH - r80*CLONO2*OH + - r82*CLO*OH - r83*CLO*OH - r85*HCL*OH - r88*HOCL*OH - r112*BRO*OH - r114*HBR*OH + - r128*CH2BR2*OH - r130*CH3BR*OH - r131*CH3CCL3*OH - r133*CH3CL*OH - r135*CHBR3*OH + - r136*HCFC141B*OH - r137*HCFC142B*OH - r138*HCFC22*OH - r147*CH2O*OH - r152*CH3OH*OH + - r153*CH3OOH*OH - r154*CH4*OH - r155*M*HCN*OH - r156*HCOOH*OH - r164*CO*OH - r166*M*C2H2*OH + - r173*C2H5OH*OH - r174*C2H5OOH*OH - r176*C2H6*OH - r178*CH3CHO*OH - r179*CH3CN*OH + - r184*CH3COOH*OH - r185*CH3COOOH*OH - r190*GLYALD*OH - r191*GLYOXAL*OH - r192*PAN*OH + - r193*M*C2H4*OH - r201*C3H7OOH*OH - r202*C3H8*OH - r204*CH3COCHO*OH - r206*HYAC*OH - r207*NOA*OH + - r210*POOH*OH - r214*ROOH*OH - r215*M*C3H6*OH - r216*CH3COCH3*OH - r218*BIGENE*OH + - r221*HONITR*OH - r229*MACR*OH - r230*MACROOH*OH - r239*MEK*OH - r240*MEKOOH*OH - r241*M*MPAN*OH + - r243*MVK*OH - r246*ALKNIT*OH - r250*ALKOOH*OH - r251*BIGALK*OH - r252*HPALD*OH + - r253*HYDRALD*OH - r254*IEPOX*OH - r266*ISOPNITA*OH - r267*ISOPNITB*OH - r274*ISOPNOOH*OH + - r276*ISOP*OH - r277*ISOPOOH*OH - r278*NC4CH2OH*OH - r279*NC4CHO*OH - r285*XOOH*OH + - r288*BENZENE*OH - r291*BENZOOH*OH - r292*BZALD*OH - r294*BZOOH*OH - r298*C6H5OOH*OH + - r299*CRESOL*OH - r311*PHENOL*OH - r314*PHENOOH*OH - r318*TOLOOH*OH - r319*TOLUENE*OH + - r321*XYLENES*OH - r324*XYLENOOH*OH - r327*XYLOL*OH - r328*XYLOLOOH*OH - r331*BCARY*OH + - r334*MTERP*OH - r339*NTERPOOH*OH - r343*TERP2OOH*OH - r344*TERPNIT*OH - r348*TERPOOH*OH + - r350*TERPROD1*OH - r351*TERPROD2*OH - r353*DMS*OH - r355*OCS*OH - r357*M*SO2*OH - r361*S*OH + - r366*SO*OH - r367*DMS*OH - r369*NH3*OH + d(Op)/dt = j120*O + j121*O + j122*O + j123*O + j124*O + j125*O + j127*O2 + j128*O2 + j129*O2 + j131*O2 + + j132*O2 + j133*O2 + r434*N2p*O + r435*Np*O + - r442*N2*Op - r441*CO2*Op - r443*O2*Op + d(PHENO2)/dt = .2*r299*CRESOL*OH + .14*r311*PHENOL*OH + r314*PHENOOH*OH + - r309*HO2*PHENO2 - r310*NO*PHENO2 + d(PO2)/dt = .5*r210*POOH*OH + r215*M*C3H6*OH + - r208*HO2*PO2 - r209*NO*PO2 + d(RO2)/dt = .15*j70*TERPROD2 + r214*ROOH*OH + r216*CH3COCH3*OH + .06*r330*BCARY*O3 + .06*r333*MTERP*O3 + + .15*r351*TERPROD2*OH + - r211*CH3O2*RO2 - r212*HO2*RO2 - r213*NO*RO2 + d(TERP2O2)/dt = r343*TERP2OOH*OH + .5*r349*TERPROD1*NO3 + r350*TERPROD1*OH + - r340*CH3O2*TERP2O2 - r341*HO2*TERP2O2 - r342*NO*TERP2O2 + d(TERPO2)/dt = r331*BCARY*OH + r334*MTERP*OH + r348*TERPOOH*OH + - r345*CH3O2*TERPO2 - r346*HO2*TERPO2 - r347*NO*TERPO2 + d(TOLO2)/dt = r318*TOLOOH*OH + .65*r319*TOLUENE*OH + - r316*HO2*TOLO2 - r317*NO*TOLO2 + d(TOLUO2VBS)/dt = r406*TOLUENE*OH + - r407*HO2*TOLUO2VBS - r408*NO*TOLUO2VBS + d(XO2)/dt = r252*HPALD*OH + r253*HYDRALD*OH + r254*IEPOX*OH + .4*r277*ISOPOOH*OH + .5*r285*XOOH*OH + - r280*CH3CO3*XO2 - r281*CH3O2*XO2 - r282*HO2*XO2 - r283*NO*XO2 - r284*NO3*XO2 + d(XYLENO2)/dt = .56*r321*XYLENES*OH + r324*XYLENOOH*OH + - r322*HO2*XYLENO2 - r323*NO*XYLENO2 + d(XYLEO2VBS)/dt = r409*XYLENES*OH + - r410*HO2*XYLEO2VBS - r411*NO*XYLEO2VBS + d(XYLOLO2)/dt = .3*r327*XYLOL*OH + r328*XYLOLOOH*OH + - r325*HO2*XYLOLO2 - r326*NO*XYLOLO2 + d(H2O)/dt = .05*j40*CH4 + j136*H2SO4 + r371*HO2 + r24*H*HO2 + r29*OH*H2 + r30*OH*H2O2 + r31*OH*HO2 + + r34*OH*OH + r37*HO2NO2*OH + r61*HNO3*OH + r85*HCL*OH + r88*HOCL*OH + r114*HBR*OH + + r128*CH2BR2*OH + r130*CH3BR*OH + r131*CH3CCL3*OH + r133*CH3CL*OH + r138*HCFC22*OH + + r147*CH2O*OH + r153*CH3OOH*OH + r154*CH4*OH + r156*HCOOH*OH + r176*C2H6*OH + r178*CH3CHO*OH + + r184*CH3COOH*OH + r185*CH3COOOH*OH + r201*C3H7OOH*OH + r202*C3H8*OH + r204*CH3COCHO*OH + + r210*POOH*OH + r214*ROOH*OH + r216*CH3COCH3*OH + .5*r229*MACR*OH + r369*NH3*OH + r413*HOCL*HCL + + r419*HOCL*HCL + r420*HOBR*HCL + r424*HOCL*HCL + r425*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r4*O1D*H2O - r123*F*H2O - r368*SO3*H2O diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/chem_mech.in b/src/chemistry/pp_waccm_tsmlt_mam5/chem_mech.in new file mode 100644 index 0000000000..600a54cbf2 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/chem_mech.in @@ -0,0 +1,1298 @@ +* Comments +* User-given Tag Description: TSMLT1.2-simpleVBS +* Tag database identifier : MZ317_TSMLT1.2_simpleVBS_20221220 +* Tag created by : lke +* Tag created from branch : TSMLT1.2-simpleVBS +* Tag created on : 2022-12-20 13:51:46.133926-07 +* Comments for this tag follow: +* lke : 2022-12-20 : TSMLT1 with JPL19 updates, NOx-dependent VBS-SOA + + SPECIES + + Solution + ALKNIT -> C5H11ONO2, + ALKOOH -> C5H12O2, + AOA_NH -> CO, + bc_a1 -> C, + bc_a4 -> C, + BCARY -> C15H24, + BENZENE -> C6H6, + BENZOOH -> C6H8O5, + BEPOMUC -> C6H6O3, + BIGALD -> C5H6O2, + BIGALD1 -> C4H4O2, + BIGALD2 -> C5H6O2, + BIGALD3 -> C5H6O2, + BIGALD4 -> C6H8O2, + BIGALK -> C5H12, + BIGENE -> C4H8, + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + BZALD -> C7H6O, + BZOOH -> C7H8O2, + C2H2, + C2H4, + C2H5OH, + C2H5OOH, + C2H6, + C3H6, + C3H7OOH, + C3H8, + C6H5OOH -> C6H5OOH, + 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, + CH3CN, + CH3COCH3, + CH3COCHO, + CH3COOH, + CH3COOOH, + CH3OH, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + COF2, + COFCL -> COFCl, + CRESOL -> C7H8O, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + E90 -> CO, + EOOH -> HOCH2CH2OOH, + F, + GLYALD -> HOCH2CHO, + GLYOXAL -> C2H2O2, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HCN, + HCOOH, + HF, + HNO3, + HO2, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + HONITR -> C4H9NO4, + HPALD -> HOOCH2CCH3CHCHO, + HYAC -> CH3COCH2OH, + HYDRALD -> HOCH2CCH3CHCHO, + IEPOX -> C5H10O3, + ISOP -> C5H8, + ISOPNITA -> C5H9NO4, + ISOPNITB -> C5H9NO4, + ISOPNOOH -> C5H9NO5, + ISOPOOH -> HOCH2COOHCH3CHCH2, + IVOC -> C13H28, + MACR -> CH2CCH3CHO, + MACROOH -> CH3COCHOOHCH2OH, + MEK -> C4H8O, + MEKOOH -> C4H8O3, + MPAN -> CH2CCH3CO3NO2, + MTERP -> C10H16, + MVK -> CH2CHCOCH3, + N, + N2O, + N2O5, + NC4CH2OH -> C5H9NO4, + NC4CHO -> C5H7NO4, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + NH3, + NH4, + NH_5 -> CO, + NH_50 -> CO, + NO, + NO2, + NO3, + NOA -> CH3COCH2ONO2, + NTERPOOH -> C10H17NO5, + num_a1 -> H, + num_a2 -> H, + num_a3 -> H, + num_a4 -> H, + num_a5 -> H, + O, + O2, + O3, + O3S -> O3, + OCLO -> OClO, + OCS -> OCS, + ONITR -> C4H7NO4, + PAN -> CH3CO3NO2, + PBZNIT -> C7H5O3NO2, + PHENO -> C6H5O, + PHENOL -> C6H5OH, + PHENOOH -> C6H8O6, + 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, + soa1_a1 -> C15H38O2, + soa1_a2 -> C15H38O2, + soa2_a1 -> C15H38O2, + soa2_a2 -> C15H38O2, + soa3_a1 -> C15H38O2, + soa3_a2 -> C15H38O2, + soa4_a1 -> C15H38O2, + soa4_a2 -> C15H38O2, + soa5_a1 -> C15H38O2, + soa5_a2 -> C15H38O2, + SOAG0 -> C15H38O2, + SOAG1 -> C15H38O2, + SOAG2 -> C15H38O2, + SOAG3 -> C15H38O2, + SOAG4 -> C15H38O2, + ST80_25 -> CO, + SVOC -> C22H46, + TEPOMUC -> C7H8O3, + TERP2OOH -> C10H16O4, + TERPNIT -> C10H17NO4, + TERPOOH -> C10H18O3, + TERPROD1 -> C10H16O2, + TERPROD2 -> C9H14O2, + TOLOOH -> C7H10O5, + TOLUENE -> C7H8, + XOOH -> HOCH2COOHCH3CHOHCHO, + XYLENES -> C8H10, + XYLENOOH -> C8H12O5, + XYLOL -> C8H10O, + XYLOLOOH -> C8H12O6, + NHDEP -> N, + NDEP -> N, + ACBZO2 -> C7H5O3, + ALKO2 -> C5H11O2, + BCARYO2VBS -> C15H25O3, + BENZO2 -> C6H7O5, + BENZO2VBS -> C6H7O5, + BZOO -> C7H7O2, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2 -> C5H5O4, + e -> E, + ENEO2 -> C4H9O3, + EO -> HOCH2CH2O, + EO2 -> HOCH2CH2O2, + HOCH2OO, + ISOPAO2 -> HOC5H8O2, + ISOPBO2 -> HOC5H8O2, + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, + ISOPO2VBS -> C5H9O3, + IVOCO2VBS -> C13H29O3, + MACRO2 -> CH3COCHO2CH2OH, + MALO2 -> C4H3O4, + MCO3 -> CH2CCH3CO3, + MDIALO2 -> C4H5O4, + MEKO2 -> C4H7O3, + MTERPO2VBS -> C10H17O3, + N2D -> N, + N2p -> N2, + NOp -> NO, + Np -> N, + NTERPO2 -> C10H16NO5, + O1D -> O, + O2_1D -> O2, + O2_1S -> O2, + O2p -> O2, + OH, + Op -> O, + PHENO2 -> C6H7O6, + PO2 -> C3H6OHO2, + RO2 -> CH3COCH2O2, + TERP2O2 -> C10H15O4, + TERPO2 -> C10H17O3, + TOLO2 -> C7H9O5, + TOLUO2VBS -> C7H9O5, + XO2 -> HOCH2COOCH3CHOHCHO, + XYLENO2 -> C8H11O5, + XYLEO2VBS -> C8H11O5, + XYLOLO2 -> C8H11O6, + H2O + + End Solution + + + Fixed + M, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + ACBZO2, + ALKO2, + BCARYO2VBS, + BENZO2, + BENZO2VBS, + BZOO, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2, + e, + ENEO2, + EO, + EO2, + HOCH2OO, + ISOPAO2, + ISOPBO2, + ISOPNO3, + ISOPO2VBS, + IVOCO2VBS, + MACRO2, + MALO2, + MCO3, + MDIALO2, + MEKO2, + MTERPO2VBS, + N2D, + N2p, + NOp, + Np, + NTERPO2, + O1D, + O2_1D, + O2_1S, + O2p, + OH, + Op, + PHENO2, + PO2, + RO2, + TERP2O2, + TERPO2, + TOLO2, + TOLUO2VBS, + XO2, + XYLENO2, + XYLEO2VBS, + XYLOLO2 + End Not-Transported + + END Species + + + Solution classes + Explicit + NHDEP + NDEP + End Explicit + + Implicit + ALKNIT + ALKOOH + AOA_NH + bc_a1 + bc_a4 + BCARY + BENZENE + BENZOOH + BEPOMUC + BIGALD + BIGALD1 + BIGALD2 + BIGALD3 + BIGALD4 + BIGALK + BIGENE + BR + BRCL + BRO + BRONO2 + BRY + BZALD + BZOOH + C2H2 + C2H4 + C2H5OH + C2H5OOH + C2H6 + C3H6 + C3H7OOH + C3H8 + C6H5OOH + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH2O + CH3BR + CH3CCL3 + CH3CHO + CH3CL + CH3CN + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CH4 + CHBR3 + CL + CL2 + CL2O2 + CLO + CLONO2 + CLY + CO + CO2 + COF2 + COFCL + CRESOL + DMS + dst_a1 + dst_a2 + dst_a3 + E90 + EOOH + F + GLYALD + GLYOXAL + H + H2 + H2402 + H2O2 + H2SO4 + HBR + HCFC141B + HCFC142B + HCFC22 + HCL + HCN + HCOOH + HF + HNO3 + HO2 + HO2NO2 + HOBR + HOCL + HONITR + HPALD + HYAC + HYDRALD + IEPOX + ISOP + ISOPNITA + ISOPNITB + ISOPNOOH + ISOPOOH + IVOC + MACR + MACROOH + MEK + MEKOOH + MPAN + MTERP + MVK + N + N2O + N2O5 + NC4CH2OH + NC4CHO + ncl_a1 + ncl_a2 + ncl_a3 + NH3 + NH4 + NH_5 + NH_50 + NO + NO2 + NO3 + NOA + NTERPOOH + num_a1 + num_a2 + num_a3 + num_a4 + num_a5 + O + O2 + O3 + O3S + OCLO + OCS + ONITR + PAN + PBZNIT + PHENO + PHENOL + PHENOOH + pom_a1 + pom_a4 + POOH + ROOH + S + SF6 + SO + SO2 + SO3 + so4_a1 + so4_a2 + so4_a3 + so4_a5 + soa1_a1 + soa1_a2 + soa2_a1 + soa2_a2 + soa3_a1 + soa3_a2 + soa4_a1 + soa4_a2 + soa5_a1 + soa5_a2 + SOAG0 + SOAG1 + SOAG2 + SOAG3 + SOAG4 + ST80_25 + SVOC + TEPOMUC + TERP2OOH + TERPNIT + TERPOOH + TERPROD1 + TERPROD2 + TOLOOH + TOLUENE + XOOH + XYLENES + XYLENOOH + XYLOL + XYLOLOOH + ACBZO2 + ALKO2 + BCARYO2VBS + BENZO2 + BENZO2VBS + BZOO + C2H5O2 + C3H7O2 + C6H5O2 + CH3CO3 + CH3O2 + DICARBO2 + e + ENEO2 + EO + EO2 + HOCH2OO + ISOPAO2 + ISOPBO2 + ISOPNO3 + ISOPO2VBS + IVOCO2VBS + MACRO2 + MALO2 + MCO3 + MDIALO2 + MEKO2 + MTERPO2VBS + N2D + N2p + NOp + Np + NTERPO2 + O1D + O2_1D + O2_1S + O2p + OH + Op + PHENO2 + PO2 + RO2 + TERP2O2 + TERPO2 + TOLO2 + TOLUO2VBS + XO2 + XYLENO2 + XYLEO2VBS + XYLOLO2 + H2O + End Implicit + + End Solution classes + + + CHEMISTRY + Photolysis +********************************* +*** odd-oxygen +********************************* +[jh2o_b] H2O + hv -> H2 + O1D +[jh2o_c] H2O + hv -> 2*H + O +[jh2o_a] H2O + hv -> OH + H +[jh2o2] H2O2 + hv -> 2*OH +[jo2_b=userdefined,] O2 + hv -> 2*O +[jo2_a=userdefined,] O2 + hv -> O + O1D +[jo3_a] O3 + hv -> O1D + O2_1D +[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 +[jno_i] NO + hv -> NOp + e +[jno2] NO2 + hv -> NO + O +[jno3_a] NO3 + hv -> NO2 + O +[jno3_b] NO3 + hv -> NO + O2 +********************************* +*** organics +********************************* +[jalknit->,jch3ooh] ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK +[jalkooh->,jch3ooh] ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 + 0.8*MEK + OH +[jbenzooh->,jch3ooh] BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 +[jbepomuc->,.10*jno2] BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO +[jbigald->,0.2*jno2] BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 + 0.18*CH3COCHO +[jbigald1->,.14*jno2] BIGALD1 + hv -> 0.6*MALO2 + HO2 +[jbigald2->,.20*jno2] BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 +[jbigald3->,.20*jno2] BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 +[jbigald4->,.006*jno2] BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 +[jbzooh->,jch3ooh] BZOOH + hv -> BZALD + OH + HO2 +[jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH +[jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 +[jc6h5ooh->,jch3ooh] C6H5OOH + hv -> PHENO + OH +[jch2o_b] CH2O + hv -> CO + H2 +[jch2o_a] CH2O + hv -> CO + 2*H +[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 +[jhonitr->,jch2o_a] HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + 0.17*CH3COCH3 +[jhpald->,.006*jno2] HPALD + hv -> BIGALD3 + OH + HO2 +[jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O +[jisopnooh->,jch3ooh] ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + 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 +[jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 +[jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO +[jmpan->,jpan] MPAN + hv -> MCO3 + NO2 +[jmvk] MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 +[jnc4cho->,jch2o_a] NC4CHO + hv -> BIGALD3 + NO2 + HO2 +[jnoa->,jch2o_a] NOA + hv -> NO2 + CH2O + CH3CO3 +[jnterpooh->,jch3ooh] NTERPOOH + hv -> TERPROD1 + NO2 + OH +[jonitr->,jch3cho] ONITR + hv -> NO2 +[jpan] PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 +[jphenooh->,jch3ooh] PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL +[jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH +[jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH +[jtepomuc->,.10*jno2] TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO +[jterp2ooh->,jch3ooh] TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 + TERPROD2 + HO2 + 0.25*GLYALD +[jterpnit->,jch3ooh] TERPNIT + hv -> TERPROD1 + NO2 + HO2 +[jterpooh->,jch3ooh] TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH +[jterprd1->,jch3cho] TERPROD1 + hv -> HO2 + CO + TERPROD2 +[jterprd2->,jch3cho] TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO +[jtolooh->,jch3ooh] TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 +[jxooh->,jch3ooh] XOOH + hv -> OH +[jxylenooh->,jch3ooh] XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 +[jxylolooh->,jch3ooh] XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 +********************************* +*** 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 -> 2*CL + COFCL +[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 +[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_a] CLONO2 + hv -> CL + NO3 +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jcof2] COF2 + hv -> 2*F +[jcofcl] COFCL + hv -> F + CL +[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 +********************************* +*** ions +********************************* +[jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O +[jeuv_4=userdefined,userdefined] N + hv -> Np + e +[jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_2=userdefined,userdefined] O + hv -> Op + e +[jeuv_1=userdefined,userdefined] O + hv -> Op + e +[jeuv_16=userdefined,userdefined] O + hv -> Op + e +[jeuv_15=userdefined,userdefined] O + hv -> Op + e +[jeuv_14=userdefined,userdefined] O + hv -> Op + e +[jeuv_3=userdefined,userdefined] O + hv -> Op + e +[jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_24=userdefined,userdefined] O2 + hv -> 2*O +[jeuv_12=userdefined,userdefined] O2 + hv -> 2*O +********************************* +*** 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 +********************************* +[jsoa1_a1->,.0004*jno2] soa1_a1 + hv -> +[jsoa1_a2->,.0004*jno2] soa1_a2 + hv -> +[jsoa2_a1->,.0004*jno2] soa2_a1 + hv -> +[jsoa2_a2->,.0004*jno2] soa2_a2 + hv -> +[jsoa3_a1->,.0004*jno2] soa3_a1 + hv -> +[jsoa3_a2->,.0004*jno2] soa3_a2 + hv -> +[jsoa4_a1->,.0004*jno2] soa4_a1 + hv -> +[jsoa4_a2->,.0004*jno2] soa4_a2 + hv -> +[jsoa5_a1->,.0004*jno2] soa5_a1 + hv -> +[jsoa5_a2->,.0004*jno2] soa5_a2 + hv -> + End Photolysis + + Reactions +********************************* +*** odd-oxygen +********************************* +[ag1] O2_1D -> O2 ; 0.000258 +[ag2] O2_1S -> O2 ; 0.085 +[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_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 2.64e-11, 55 +[O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 6.6e-12, 55 +[O1D_O3] O1D + O3 -> O2 + O2 ; 1.2e-10 +[O2_1D_N2,cph=94.3] O2_1D + N2 -> O2 + N2 ; 1e-20 +[O2_1D_O,cph=94.3] O2_1D + O -> O2 + O ; 1.3e-16 +[O2_1D_O2,cph=94.3] O2_1D + O2 -> 2*O2 ; 3.6e-18, -220 +[O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13 +[O2_1S_N2,cph=62.6] O2_1S + N2 -> O2_1D + N2 ; 1.8e-15, 45 +[O2_1S_O,cph=62.6] O2_1S + O -> O2_1D + O ; 8e-14 +[O2_1S_O2,cph=62.6] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17 +[O2_1S_O3,cph=62.6] O2_1S + O3 -> O2_1D + O3 ; 3.5e-11, -135 +[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 +[N2D_O,cph=229.61] N2D + O -> N + O ; 7e-13 +[N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5e-12 +[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 -> 2*CL + COFCL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 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 +********************************* +*** odd-fluorine +********************************* +[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 +[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 +[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 +[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 +[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 +[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 +********************************* +*** 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 + COFCL ; 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 + COFCL ; 1.794e-10 +[O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.3e-10 +[O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.65e-11 +********************************* +*** C1 +********************************* +[CH2O_HO2] CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625 +[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 +[HCN_OH] HCN + OH + M -> HO2 + M ; 6.1e-33, 1.5, 9.8e-15, -4.6, 0.8 +[HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4e-13 +[HOCH2OO_HO2] HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 +[HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.4e+12, -7000 +[HOCH2OO_NO] HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265 +[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 +[O1D_HCN] O1D + HCN -> OH ; 1.08e-10, 105 +[usr_CO_OH] CO + OH -> CO2 + HO2 +********************************* +*** C2 +********************************* +[C2H2_CL_M] C2H2 + CL + M -> CL + M ; 5.2e-30, 2.4, 2.2e-10, 0.7, 0.6 +[C2H2_OH_M] C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 + 0.35*CO + M ; 5.5e-30, 0, 8.3e-13, -2, 0.6 +[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 +[CH3CN_OH] CH3CN + OH -> HO2 ; 7.8e-13, -1050 +[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 +[CL_C3H8] CL + C3H8 -> C3H7O2 + HCL ; 1.45e-10 +[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 +********************************* +[BIGENE_NO3] BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 ; 3.5e-13 +[BIGENE_OH] BIGENE + OH -> ENEO2 ; 5.4e-11 +[ENEO2_NO] ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 ; 4.8e-12, 120 +[ENEO2_NOb] ENEO2 + NO -> HONITR ; 5.1e-14, 693 +[HONITR_OH] HONITR + OH -> ONITR + HO2 ; 2e-12 +[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 -> HONITR ; 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 +[MEKO2_HO2] MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 ; 7.5e-13, 700 +[MEKO2_NO] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180 +[MEK_OH] MEK + OH -> MEKO2 ; 2.3e-12, -170 +[MEKOOH_OH] MEKOOH + OH -> MEKO2 ; 3.8e-12, 200 +[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 +********************************* +[ALKNIT_OH] ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 ; 1.6e-12 +[ALKO2_HO2] ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700 +[ALKO2_NO] ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK + NO2 ; 6.7e-12 +[ALKO2_NOb] ALKO2 + NO -> ALKNIT ; 5.4e-14, 870 +[ALKOOH_OH] ALKOOH + OH -> ALKO2 ; 3.8e-12, 200 +[BIGALK_OH] BIGALK + OH -> ALKO2 ; 3.5e-12 +[HPALD_OH] HPALD + OH -> XO2 ; 1.86e-11, 175 +[HYDRALD_OH] HYDRALD + OH -> XO2 ; 1.86e-11, 175 +[IEPOX_OH] IEPOX + OH -> XO2 ; 1.3e-11 +[ISOPAO2_CH3CO3] ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 ; 1.4e-11 +[ISOPAO2_CH3O2] ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR + 0.44*MVK ; 5e-13, 400 +[ISOPAO2_HO2] ISOPAO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPAO2_NO] ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK + 0.92*CH2O + 0.92*HO2 ; 4.4e-12, 180 +[ISOPAO2_NO3] ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 ; 2.4e-12 +[ISOPBO2_CH3CO3] ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 ; 1.4e-11 +[ISOPBO2_CH3O2] ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD ; 5e-13, 400 +[ISOPBO2_HO2] ISOPBO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPBO2_M] ISOPBO2 -> HPALD + HO2 ; 1.6e+09, -8300 +[ISOPBO2_NO] ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 4.4e-12, 180 +[ISOPBO2_NO3] ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 2.4e-12 +[ISOPNITA_OH] ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O + 0.3*HONITR + 0.3*HO2 ; 4e-11 +[ISOPNITB_OH] ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR ; 4e-11 +[ISOP_NO3] ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446 +[ISOPNO3_CH3CO3] ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 ; 1.4e-11 +[ISOPNO3_CH3O2] ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH + 0.2*NC4CH2OH ; 5e-13, 400 +[ISOPNO3_HO2] ISOPNO3 + HO2 -> ISOPNOOH ; 8e-13, 700 +[ISOPNO3_NO] ISOPNO3 + NO -> NC4CHO + NO2 + HO2 ; 2.7e-12, 360 +[ISOPNO3_NO3] ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 ; 2.4e-12 +[ISOPNOOH_OH] ISOPNOOH + OH -> NOA + HO2 ; 4e-11 +[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 -> 0.6*ISOPAO2 + 0.4*ISOPBO2 ; 2.54e-11, 410 +[ISOPOOH_OH] ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH ; 1.52e-11, 200 +[NC4CH2OH_OH] NC4CH2OH + OH -> GLYALD + NOA + HO2 ; 7e-11 +[NC4CHO_OH] NC4CHO + OH -> GLYOXAL + NOA + HO2 ; 1e-10 +[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 +********************************* +*** C7 +********************************* +[ACBZO2_HO2] ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH ; 4.3e-13, 1040 +[ACBZO2_NO] ACBZO2 + NO -> C6H5O2 + NO2 ; 7.5e-12, 290 +[BENZENE_OH] BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 ; 2.3e-12, -193 +[BENZO2_HO2] BENZO2 + HO2 -> BENZOOH ; 7.5e-13, 700 +[BENZO2_NO] BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 ; 2.6e-12, 365 +[BENZOOH_OH] BENZOOH + OH -> BENZO2 ; 3.8e-12, 200 +[BZALD_OH] BZALD + OH -> ACBZO2 ; 5.9e-12, 225 +[BZOO_HO2] BZOO + HO2 -> BZOOH ; 7.5e-13, 700 +[BZOOH_OH] BZOOH + OH -> BZOO ; 3.8e-12, 200 +[BZOO_NO] BZOO + NO -> BZALD + NO2 + HO2 ; 2.6e-12, 365 +[C6H5O2_HO2] C6H5O2 + HO2 -> C6H5OOH ; 7.5e-13, 700 +[C6H5O2_NO] C6H5O2 + NO -> PHENO + NO2 ; 2.6e-12, 365 +[C6H5OOH_OH] C6H5OOH + OH -> C6H5O2 ; 3.8e-12, 200 +[CRESOL_OH] CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO ; 4.7e-11 +[DICARBO2_HO2] DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO + 0.33*CH3O2 ; 4.3e-13, 1040 +[DICARBO2_NO] DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO + 0.83*CH3O2 ; 7.5e-12, 290 +[DICARBO2_NO2] DICARBO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MALO2_HO2] MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO ; 4.3e-13, 1040 +[MALO2_NO] MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 ; 7.5e-12, 290 +[MALO2_NO2] MALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MDIALO2_HO2] MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO + 0.07*CH3O2 + 0.07*GLYOXAL ; 4.3e-13, 1040 +[MDIALO2_NO] MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO + 0.17*CH3O2 + 0.17*GLYOXAL ; 7.5e-12, 290 +[MDIALO2_NO2] MDIALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[PHENO2_HO2] PHENO2 + HO2 -> PHENOOH ; 7.5e-13, 700 +[PHENO2_NO] PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 ; 2.6e-12, 365 +[PHENOL_OH] PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO ; 4.7e-13, 1220 +[PHENO_NO2] PHENO + NO2 -> 1*NDEP ; 2.1e-12 +[PHENO_O3] PHENO + O3 -> C6H5O2 ; 2.8e-13 +[PHENOOH_OH] PHENOOH + OH -> PHENO2 ; 3.8e-12, 200 +[tag_ACBZO2_NO2] ACBZO2 + NO2 + M -> PBZNIT + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[TOLO2_HO2] TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700 +[TOLO2_NO] TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 ; 2.6e-12, 365 +[TOLOOH_OH] TOLOOH + OH -> TOLO2 ; 3.8e-12, 200 +[TOLUENE_OH] TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 + 0.28*HO2 ; 1.7e-12, 352 +[usr_PBZNIT_M] PBZNIT + M -> ACBZO2 + NO2 + M +[XYLENES_OH] XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO + 0.56*XYLENO2 + 0.38*HO2 ; 1.7e-11 +[XYLENO2_HO2] XYLENO2 + HO2 -> XYLENOOH ; 7.5e-13, 700 +[XYLENO2_NO] XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 ; 2.6e-12, 365 +[XYLENOOH_OH] XYLENOOH + OH -> XYLENO2 ; 3.8e-12, 200 +[XYLOLO2_HO2] XYLOLO2 + HO2 -> XYLOLOOH ; 7.5e-13, 700 +[XYLOLO2_NO] XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO ; 2.6e-12, 365 +[XYLOL_OH] XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO ; 8.4e-11 +[XYLOLOOH_OH] XYLOLOOH + OH -> XYLOLO2 ; 3.8e-12, 200 +********************************* +*** C10 +********************************* +[BCARY_NO3] BCARY + NO3 -> NTERPO2 ; 1.9e-11 +[BCARY_O3] BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 1.2e-14 +[BCARY_OH] BCARY + OH -> TERPO2 ; 2e-10 +[MTERP_NO3] MTERP + NO3 -> NTERPO2 ; 1.2e-12, 490 +[MTERP_O3] MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 6.3e-16, -580 +[MTERP_OH] MTERP + OH -> TERPO2 ; 1.2e-11, 440 +[NTERPO2_CH3O2] NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 + 0.5*TERPROD1 + 0.5*NO2 ; 2e-12, 500 +[NTERPO2_HO2] NTERPO2 + HO2 -> NTERPOOH ; 7.5e-13, 700 +[NTERPO2_NO] NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP ; 4.2e-12, 180 +[NTERPO2_NO3] NTERPO2 + NO3 -> 2*NO2 + TERPROD1 ; 2.4e-12 +[NTERPOOH_OH] NTERPOOH + OH -> NTERPO2 ; 2e-11 +[TERP2O2_CH3O2] TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + 0.15*CH3COCH3 ; 2e-12, 500 +[TERP2O2_HO2] TERP2O2 + HO2 -> TERP2OOH ; 7.5e-13, 700 +[TERP2O2_NO] TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + 0.225*GLYALD ; 4.2e-12, 180 +[TERP2OOH_OH] TERP2OOH + OH -> TERP2O2 ; 2.3e-11 +[TERPNIT_OH] TERPNIT + OH -> NO2 + TERPROD1 ; 2e-11 +[TERPO2_CH3O2] TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 + 0.025*CH3COCH3 ; 2e-12, 500 +[TERPO2_HO2] TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700 +[TERPO2_NO] TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 + 0.8*TERPROD1 + 0.8*HO2 ; 4.2e-12, 180 +[TERPOOH_OH] TERPOOH + OH -> TERPO2 ; 3.3e-11 +[TERPROD1_NO3] TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP ; 1e-12 +[TERPROD1_OH] TERPROD1 + OH -> TERP2O2 ; 5.7e-11 +[TERPROD2_OH] TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO ; 3.4e-11 +********************************* +*** 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_GLYOXAL_aer] GLYOXAL -> SOAG0 +[usr_HO2_aer] HO2 -> H2O +[usr_HONITR_aer] HONITR -> HNO3 +[usr_ISOPNITA_aer] ISOPNITA -> HNO3 +[usr_ISOPNITB_aer] ISOPNITB -> HNO3 +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NC4CH2OH_aer] NC4CH2OH -> HNO3 +[usr_NC4CHO_aer] NC4CHO -> 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_NTERPOOH_aer] NTERPOOH -> HNO3 +[usr_ONITR_aer] ONITR -> HNO3 +[usr_TERPNIT_aer] TERPNIT -> HNO3 +********************************* +*** SOA +********************************* +[BCARY_NO3_vbs] BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.9e-11 +[BCARYO2_HO2_vbs] BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 2.75e-13, 1300 +[BCARYO2_NO_vbs] BCARYO2VBS + NO -> NO + 0.1279*SOAG0 + 0.1792*SOAG1 + 0.0676*SOAG2 + 0.079*SOAG3 + 0.1254*SOAG4 ; 2.7e-12, 360 +[BCARY_O3_vbs] BCARY + O3 -> BCARY + O3 + 0.2202*SOAG0 + 0.2067*SOAG1 + 0.0653*SOAG2 + 0.1284*SOAG3 + 0.114*SOAG4 ; 1.2e-14 +[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + BCARYO2VBS ; 2e-10 +[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + BENZO2VBS ; 2.3e-12, -193 +[BENZO2_HO2_vbs] BENZO2VBS + HO2 -> HO2 + 0.0023*SOAG0 + 0.0008*SOAG1 + 0.0843*SOAG2 + 0.0443*SOAG3 + 0.1621*SOAG4 ; 7.5e-13, 700 +[BENZO2_NO_vbs] BENZO2VBS + NO -> NO + 0.0097*SOAG0 + 0.0034*SOAG1 + 0.1579*SOAG2 + 0.0059*SOAG3 + 0.0536*SOAG4 ; 2.6e-12, 365 +[ISOP_NO3_vbs] ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAG3 + 0.025024*SOAG4 ; 3.03e-12, -446 +[ISOPO2_HO2_vbs] ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAG0 + 0.0035*SOAG1 + 0.0003*SOAG2 + 0.0271*SOAG3 + 0.0474*SOAG4 ; 2.12e-13, 1300 +[ISOPO2_NO_vbs] ISOPO2VBS + NO -> NO + 0.0003*SOAG0 + 0.0003*SOAG1 + 0.0073*SOAG2 + 0.0057*SOAG3 + 0.0623*SOAG4 ; 2.7e-12, 350 +[ISOP_O3_vbs] ISOP + O3 -> ISOP + O3 + 0.0033*SOAG3 ; 1.05e-14, -2000 +[ISOP_OH_vbs] ISOP + OH -> ISOP + OH + ISOPO2VBS ; 2.54e-11, 410 +[IVOCO2_HO2_vbs] IVOCO2VBS + HO2 -> HO2 + 0.2381*SOAG0 + 0.1308*SOAG1 + 0.0348*SOAG2 + 0.0076*SOAG3 + 0.0113*SOAG4 ; 7.5e-13, 700 +[IVOCO2_NO_vbs] IVOCO2VBS + NO -> NO + 0.1056*SOAG0 + 0.1026*SOAG1 + 0.0521*SOAG2 + 0.0143*SOAG3 + 0.0166*SOAG4 ; 2.6e-12, 365 +[IVOC_OH_vbs] IVOC + OH -> OH + IVOCO2VBS ; 1.34e-11 +[MTERP_NO3_vbs] MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAG3 + 0.59019*SOAG4 ; 1.2e-12, 490 +[MTERPO2_HO2_vbs] MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 2.6e-13, 1300 +[MTERPO2_NO_vbs] MTERPO2VBS + NO -> NO + 0.0245*SOAG0 + 0.0082*SOAG1 + 0.0772*SOAG2 + 0.0332*SOAG3 + 0.13*SOAG4 ; 2.7e-12, 360 +[MTERP_O3_vbs] MTERP + O3 -> MTERP + O3 + 0.0508*SOAG0 + 0.1149*SOAG1 + 0.0348*SOAG2 + 0.0554*SOAG3 + 0.1278*SOAG4 ; 6.3e-16, -580 +[MTERP_OH_vbs] MTERP + OH -> MTERP + OH + MTERPO2VBS ; 1.2e-11, 440 +[SVOC_OH] SVOC + OH -> OH + 0.5931*SOAG0 + 0.1534*SOAG1 + 0.0459*SOAG2 + 0.0085*SOAG3 + 0.0128*SOAG4 ; 1.34e-11 +[TOLUENE_OH_vbs] TOLUENE + OH -> TOLUENE + OH + TOLUO2VBS ; 1.7e-12, 352 +[TOLUO2_HO2_vbs] TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAG0 + 0.0101*SOAG1 + 0.0763*SOAG2 + 0.2157*SOAG3 + 0.0738*SOAG4 ; 7.5e-13, 700 +[TOLUO2_NO_vbs] TOLUO2VBS + NO -> NO + 0.0154*SOAG0 + 0.0452*SOAG1 + 0.0966*SOAG2 + 0.0073*SOAG3 + 0.238*SOAG4 ; 2.6e-12, 365 +[XYLENES_OH_vbs] XYLENES + OH -> XYLENES + OH + XYLEO2VBS ; 1.7e-11 +[XYLEO2_HO2_vbs] XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAG0 + 0.0174*SOAG1 + 0.086*SOAG2 + 0.0512*SOAG3 + 0.1598*SOAG4 ; 7.5e-13, 700 +[XYLEO2_NO_vbs] XYLEO2VBS + NO -> NO + 0.0063*SOAG0 + 0.0237*SOAG1 + 0.0025*SOAG2 + 0.011*SOAG3 + 0.1185*SOAG4 ; 2.6e-12, 365 +********************************* +*** 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 +********************************* +*** Ions +********************************* +[elec1,cph=82.389] NOp + e -> 0.2*N + 0.8*N2D + O +[elec2,cph=508.95] O2p + e -> 1.15*O + 0.85*O1D +[elec3,cph=354.83] N2p + e -> 1.1*N + 0.9*N2D +[ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6e-11 +[ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D +[ion_N2p_Ob] N2p + O -> Op + N2 +[ion_Np_O,cph=95.55] Np + O -> Op + N ; 1e-12 +[ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4e-10 +[ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2e-10 +[ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1e-10 +[ion_O2p_N2] O2p + N2 -> NOp + NO ; 5e-16 +[ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 +[ion_Op_CO2] Op + CO2 -> O2p + CO ; 9e-10 +[ion_Op_N2,cph=105.04] Op + N2 -> NOp + N +[ion_Op_O2,cph=150.11] Op + O2 -> O2p + O +********************************* +*** 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 + CO <- dataset + SVOC <- dataset + SO2 <- dataset + NO2 <- dataset + NO <- dataset + num_a1 <- dataset + num_a2 <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + num_a5 <- dataset + so4_a5 <- dataset + num_a4 <- dataset + pom_a4 <- dataset + bc_a4 <- dataset + O2p + N2p + N2D + AOA_NH + N + OH + Op + e + 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_waccm_tsmlt_mam5/chem_mods.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/chem_mods.F90 new file mode 100644 index 0000000000..9c772d9d67 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/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 = 150, & ! number of photolysis reactions + rxntot = 597, & ! number of total reactions + gascnt = 447, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 241, & ! number of "gas phase" species + nfs = 2, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 2449, & ! number of non-zero matrix entries + extcnt = 22, & ! 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 = 239, & ! 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 = 597, & + enthalpy_cnt = 41, & + nslvd = 50 + 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_waccm_tsmlt_mam5/m_rxt_id.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/m_rxt_id.F90 new file mode 100644 index 0000000000..4b7f2809d8 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/m_rxt_id.F90 @@ -0,0 +1,600 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o_b = 1 + integer, parameter :: rid_jh2o_c = 2 + integer, parameter :: rid_jh2o_a = 3 + integer, parameter :: rid_jh2o2 = 4 + integer, parameter :: rid_jo2_b = 5 + integer, parameter :: rid_jo2_a = 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_jno_i = 16 + integer, parameter :: rid_jno2 = 17 + integer, parameter :: rid_jno3_a = 18 + integer, parameter :: rid_jno3_b = 19 + integer, parameter :: rid_jalknit = 20 + integer, parameter :: rid_jalkooh = 21 + integer, parameter :: rid_jbenzooh = 22 + integer, parameter :: rid_jbepomuc = 23 + integer, parameter :: rid_jbigald = 24 + integer, parameter :: rid_jbigald1 = 25 + integer, parameter :: rid_jbigald2 = 26 + integer, parameter :: rid_jbigald3 = 27 + integer, parameter :: rid_jbigald4 = 28 + integer, parameter :: rid_jbzooh = 29 + integer, parameter :: rid_jc2h5ooh = 30 + integer, parameter :: rid_jc3h7ooh = 31 + integer, parameter :: rid_jc6h5ooh = 32 + integer, parameter :: rid_jch2o_b = 33 + integer, parameter :: rid_jch2o_a = 34 + integer, parameter :: rid_jch3cho = 35 + integer, parameter :: rid_jacet = 36 + integer, parameter :: rid_jmgly = 37 + integer, parameter :: rid_jch3co3h = 38 + integer, parameter :: rid_jch3ooh = 39 + integer, parameter :: rid_jch4_b = 40 + integer, parameter :: rid_jch4_a = 41 + integer, parameter :: rid_jco2 = 42 + integer, parameter :: rid_jeooh = 43 + integer, parameter :: rid_jglyald = 44 + integer, parameter :: rid_jglyoxal = 45 + integer, parameter :: rid_jhonitr = 46 + integer, parameter :: rid_jhpald = 47 + integer, parameter :: rid_jhyac = 48 + integer, parameter :: rid_jisopnooh = 49 + integer, parameter :: rid_jisopooh = 50 + integer, parameter :: rid_jmacr_a = 51 + integer, parameter :: rid_jmacr_b = 52 + integer, parameter :: rid_jmek = 53 + integer, parameter :: rid_jmekooh = 54 + integer, parameter :: rid_jmpan = 55 + integer, parameter :: rid_jmvk = 56 + integer, parameter :: rid_jnc4cho = 57 + integer, parameter :: rid_jnoa = 58 + integer, parameter :: rid_jnterpooh = 59 + integer, parameter :: rid_jonitr = 60 + integer, parameter :: rid_jpan = 61 + integer, parameter :: rid_jphenooh = 62 + integer, parameter :: rid_jpooh = 63 + integer, parameter :: rid_jrooh = 64 + integer, parameter :: rid_jtepomuc = 65 + integer, parameter :: rid_jterp2ooh = 66 + integer, parameter :: rid_jterpnit = 67 + integer, parameter :: rid_jterpooh = 68 + integer, parameter :: rid_jterprd1 = 69 + integer, parameter :: rid_jterprd2 = 70 + integer, parameter :: rid_jtolooh = 71 + integer, parameter :: rid_jxooh = 72 + integer, parameter :: rid_jxylenooh = 73 + integer, parameter :: rid_jxylolooh = 74 + integer, parameter :: rid_jbrcl = 75 + integer, parameter :: rid_jbro = 76 + integer, parameter :: rid_jbrono2_b = 77 + integer, parameter :: rid_jbrono2_a = 78 + integer, parameter :: rid_jccl4 = 79 + integer, parameter :: rid_jcf2clbr = 80 + integer, parameter :: rid_jcf3br = 81 + integer, parameter :: rid_jcfcl3 = 82 + integer, parameter :: rid_jcfc113 = 83 + integer, parameter :: rid_jcfc114 = 84 + integer, parameter :: rid_jcfc115 = 85 + integer, parameter :: rid_jcf2cl2 = 86 + integer, parameter :: rid_jch2br2 = 87 + integer, parameter :: rid_jch3br = 88 + integer, parameter :: rid_jch3ccl3 = 89 + integer, parameter :: rid_jch3cl = 90 + integer, parameter :: rid_jchbr3 = 91 + integer, parameter :: rid_jcl2 = 92 + integer, parameter :: rid_jcl2o2 = 93 + integer, parameter :: rid_jclo = 94 + integer, parameter :: rid_jclono2_a = 95 + integer, parameter :: rid_jclono2_b = 96 + integer, parameter :: rid_jcof2 = 97 + integer, parameter :: rid_jcofcl = 98 + integer, parameter :: rid_jh2402 = 99 + integer, parameter :: rid_jhbr = 100 + integer, parameter :: rid_jhcfc141b = 101 + integer, parameter :: rid_jhcfc142b = 102 + integer, parameter :: rid_jhcfc22 = 103 + integer, parameter :: rid_jhcl = 104 + integer, parameter :: rid_jhf = 105 + integer, parameter :: rid_jhobr = 106 + integer, parameter :: rid_jhocl = 107 + integer, parameter :: rid_joclo = 108 + integer, parameter :: rid_jsf6 = 109 + integer, parameter :: rid_jeuv_26 = 110 + integer, parameter :: rid_jeuv_4 = 111 + integer, parameter :: rid_jeuv_13 = 112 + integer, parameter :: rid_jeuv_11 = 113 + integer, parameter :: rid_jeuv_6 = 114 + integer, parameter :: rid_jeuv_10 = 115 + integer, parameter :: rid_jeuv_22 = 116 + integer, parameter :: rid_jeuv_23 = 117 + integer, parameter :: rid_jeuv_25 = 118 + integer, parameter :: rid_jeuv_18 = 119 + integer, parameter :: rid_jeuv_2 = 120 + integer, parameter :: rid_jeuv_1 = 121 + integer, parameter :: rid_jeuv_16 = 122 + integer, parameter :: rid_jeuv_15 = 123 + integer, parameter :: rid_jeuv_14 = 124 + integer, parameter :: rid_jeuv_3 = 125 + integer, parameter :: rid_jeuv_17 = 126 + integer, parameter :: rid_jeuv_9 = 127 + integer, parameter :: rid_jeuv_8 = 128 + integer, parameter :: rid_jeuv_7 = 129 + integer, parameter :: rid_jeuv_5 = 130 + integer, parameter :: rid_jeuv_19 = 131 + integer, parameter :: rid_jeuv_20 = 132 + integer, parameter :: rid_jeuv_21 = 133 + integer, parameter :: rid_jeuv_24 = 134 + integer, parameter :: rid_jeuv_12 = 135 + integer, parameter :: rid_jh2so4 = 136 + integer, parameter :: rid_jocs = 137 + integer, parameter :: rid_jso = 138 + integer, parameter :: rid_jso2 = 139 + integer, parameter :: rid_jso3 = 140 + integer, parameter :: rid_jsoa1_a1 = 141 + integer, parameter :: rid_jsoa1_a2 = 142 + integer, parameter :: rid_jsoa2_a1 = 143 + integer, parameter :: rid_jsoa2_a2 = 144 + integer, parameter :: rid_jsoa3_a1 = 145 + integer, parameter :: rid_jsoa3_a2 = 146 + integer, parameter :: rid_jsoa4_a1 = 147 + integer, parameter :: rid_jsoa4_a2 = 148 + integer, parameter :: rid_jsoa5_a1 = 149 + integer, parameter :: rid_jsoa5_a2 = 150 + integer, parameter :: rid_ag1 = 151 + integer, parameter :: rid_ag2 = 152 + integer, parameter :: rid_O1D_H2 = 153 + integer, parameter :: rid_O1D_H2O = 154 + integer, parameter :: rid_O1D_N2 = 155 + integer, parameter :: rid_O1D_O2 = 156 + integer, parameter :: rid_O1D_O2b = 157 + integer, parameter :: rid_O1D_O3 = 158 + integer, parameter :: rid_O2_1D_N2 = 159 + integer, parameter :: rid_O2_1D_O = 160 + integer, parameter :: rid_O2_1D_O2 = 161 + integer, parameter :: rid_O2_1S_CO2 = 162 + integer, parameter :: rid_O2_1S_N2 = 163 + integer, parameter :: rid_O2_1S_O = 164 + integer, parameter :: rid_O2_1S_O2 = 165 + integer, parameter :: rid_O2_1S_O3 = 166 + integer, parameter :: rid_O_O3 = 167 + integer, parameter :: rid_usr_O_O = 168 + integer, parameter :: rid_usr_O_O2 = 169 + integer, parameter :: rid_H2_O = 170 + integer, parameter :: rid_H2O2_O = 171 + integer, parameter :: rid_H_HO2 = 172 + integer, parameter :: rid_H_HO2a = 173 + integer, parameter :: rid_H_HO2b = 174 + integer, parameter :: rid_H_O2 = 175 + integer, parameter :: rid_HO2_O = 176 + integer, parameter :: rid_HO2_O3 = 177 + integer, parameter :: rid_H_O3 = 178 + integer, parameter :: rid_OH_H2 = 179 + integer, parameter :: rid_OH_H2O2 = 180 + integer, parameter :: rid_OH_HO2 = 181 + integer, parameter :: rid_OH_O = 182 + integer, parameter :: rid_OH_O3 = 183 + integer, parameter :: rid_OH_OH = 184 + integer, parameter :: rid_OH_OH_M = 185 + integer, parameter :: rid_usr_HO2_HO2 = 186 + integer, parameter :: rid_HO2NO2_OH = 187 + integer, parameter :: rid_N2D_O = 188 + integer, parameter :: rid_N2D_O2 = 189 + integer, parameter :: rid_N_NO = 190 + integer, parameter :: rid_N_NO2a = 191 + integer, parameter :: rid_N_NO2b = 192 + integer, parameter :: rid_N_NO2c = 193 + integer, parameter :: rid_N_O2 = 194 + integer, parameter :: rid_NO2_O = 195 + integer, parameter :: rid_NO2_O3 = 196 + integer, parameter :: rid_NO2_O_M = 197 + integer, parameter :: rid_NO3_HO2 = 198 + integer, parameter :: rid_NO3_NO = 199 + integer, parameter :: rid_NO3_O = 200 + integer, parameter :: rid_NO3_OH = 201 + integer, parameter :: rid_N_OH = 202 + integer, parameter :: rid_NO_HO2 = 203 + integer, parameter :: rid_NO_O3 = 204 + integer, parameter :: rid_NO_O_M = 205 + integer, parameter :: rid_O1D_N2Oa = 206 + integer, parameter :: rid_O1D_N2Ob = 207 + integer, parameter :: rid_tag_NO2_HO2 = 208 + integer, parameter :: rid_tag_NO2_NO3 = 209 + integer, parameter :: rid_tag_NO2_OH = 210 + integer, parameter :: rid_usr_HNO3_OH = 211 + integer, parameter :: rid_usr_HO2NO2_M = 212 + integer, parameter :: rid_usr_N2O5_M = 213 + integer, parameter :: rid_CL_CH2O = 214 + integer, parameter :: rid_CL_CH4 = 215 + integer, parameter :: rid_CL_H2 = 216 + integer, parameter :: rid_CL_H2O2 = 217 + integer, parameter :: rid_CL_HO2a = 218 + integer, parameter :: rid_CL_HO2b = 219 + integer, parameter :: rid_CL_O3 = 220 + integer, parameter :: rid_CLO_CH3O2 = 221 + integer, parameter :: rid_CLO_CLOa = 222 + integer, parameter :: rid_CLO_CLOb = 223 + integer, parameter :: rid_CLO_CLOc = 224 + integer, parameter :: rid_CLO_HO2 = 225 + integer, parameter :: rid_CLO_NO = 226 + integer, parameter :: rid_CLONO2_CL = 227 + integer, parameter :: rid_CLO_NO2_M = 228 + integer, parameter :: rid_CLONO2_O = 229 + integer, parameter :: rid_CLONO2_OH = 230 + integer, parameter :: rid_CLO_O = 231 + integer, parameter :: rid_CLO_OHa = 232 + integer, parameter :: rid_CLO_OHb = 233 + integer, parameter :: rid_HCL_O = 234 + integer, parameter :: rid_HCL_OH = 235 + integer, parameter :: rid_HOCL_CL = 236 + integer, parameter :: rid_HOCL_O = 237 + integer, parameter :: rid_HOCL_OH = 238 + integer, parameter :: rid_O1D_CCL4 = 239 + integer, parameter :: rid_O1D_CF2CLBR = 240 + integer, parameter :: rid_O1D_CFC11 = 241 + integer, parameter :: rid_O1D_CFC113 = 242 + integer, parameter :: rid_O1D_CFC114 = 243 + integer, parameter :: rid_O1D_CFC115 = 244 + integer, parameter :: rid_O1D_CFC12 = 245 + integer, parameter :: rid_O1D_HCLa = 246 + integer, parameter :: rid_O1D_HCLb = 247 + integer, parameter :: rid_tag_CLO_CLO_M = 248 + integer, parameter :: rid_usr_CL2O2_M = 249 + integer, parameter :: rid_BR_CH2O = 250 + integer, parameter :: rid_BR_HO2 = 251 + integer, parameter :: rid_BR_O3 = 252 + integer, parameter :: rid_BRO_BRO = 253 + integer, parameter :: rid_BRO_CLOa = 254 + integer, parameter :: rid_BRO_CLOb = 255 + integer, parameter :: rid_BRO_CLOc = 256 + integer, parameter :: rid_BRO_HO2 = 257 + integer, parameter :: rid_BRO_NO = 258 + integer, parameter :: rid_BRO_NO2_M = 259 + integer, parameter :: rid_BRONO2_O = 260 + integer, parameter :: rid_BRO_O = 261 + integer, parameter :: rid_BRO_OH = 262 + integer, parameter :: rid_HBR_O = 263 + integer, parameter :: rid_HBR_OH = 264 + integer, parameter :: rid_HOBR_O = 265 + integer, parameter :: rid_O1D_CF3BR = 266 + integer, parameter :: rid_O1D_CHBR3 = 267 + integer, parameter :: rid_O1D_H2402 = 268 + integer, parameter :: rid_O1D_HBRa = 269 + integer, parameter :: rid_O1D_HBRb = 270 + integer, parameter :: rid_F_CH4 = 271 + integer, parameter :: rid_F_H2 = 272 + integer, parameter :: rid_F_H2O = 273 + integer, parameter :: rid_F_HNO3 = 274 + integer, parameter :: rid_O1D_COF2 = 275 + integer, parameter :: rid_O1D_COFCL = 276 + integer, parameter :: rid_CH2BR2_CL = 277 + integer, parameter :: rid_CH2BR2_OH = 278 + integer, parameter :: rid_CH3BR_CL = 279 + integer, parameter :: rid_CH3BR_OH = 280 + integer, parameter :: rid_CH3CCL3_OH = 281 + integer, parameter :: rid_CH3CL_CL = 282 + integer, parameter :: rid_CH3CL_OH = 283 + integer, parameter :: rid_CHBR3_CL = 284 + integer, parameter :: rid_CHBR3_OH = 285 + integer, parameter :: rid_HCFC141B_OH = 286 + integer, parameter :: rid_HCFC142B_OH = 287 + integer, parameter :: rid_HCFC22_OH = 288 + integer, parameter :: rid_O1D_CH2BR2 = 289 + integer, parameter :: rid_O1D_CH3BR = 290 + integer, parameter :: rid_O1D_HCFC141B = 291 + integer, parameter :: rid_O1D_HCFC142B = 292 + integer, parameter :: rid_O1D_HCFC22 = 293 + integer, parameter :: rid_CH2O_HO2 = 294 + integer, parameter :: rid_CH2O_NO3 = 295 + integer, parameter :: rid_CH2O_O = 296 + integer, parameter :: rid_CH2O_OH = 297 + integer, parameter :: rid_CH3O2_CH3O2a = 298 + integer, parameter :: rid_CH3O2_CH3O2b = 299 + integer, parameter :: rid_CH3O2_HO2 = 300 + integer, parameter :: rid_CH3O2_NO = 301 + integer, parameter :: rid_CH3OH_OH = 302 + integer, parameter :: rid_CH3OOH_OH = 303 + integer, parameter :: rid_CH4_OH = 304 + integer, parameter :: rid_HCN_OH = 305 + integer, parameter :: rid_HCOOH_OH = 306 + integer, parameter :: rid_HOCH2OO_HO2 = 307 + integer, parameter :: rid_HOCH2OO_M = 308 + integer, parameter :: rid_HOCH2OO_NO = 309 + integer, parameter :: rid_O1D_CH4a = 310 + integer, parameter :: rid_O1D_CH4b = 311 + integer, parameter :: rid_O1D_CH4c = 312 + integer, parameter :: rid_O1D_HCN = 313 + integer, parameter :: rid_usr_CO_OH = 314 + integer, parameter :: rid_C2H2_CL_M = 315 + integer, parameter :: rid_C2H2_OH_M = 316 + integer, parameter :: rid_C2H4_CL_M = 317 + integer, parameter :: rid_C2H4_O3 = 318 + integer, parameter :: rid_C2H5O2_C2H5O2 = 319 + integer, parameter :: rid_C2H5O2_CH3O2 = 320 + integer, parameter :: rid_C2H5O2_HO2 = 321 + integer, parameter :: rid_C2H5O2_NO = 322 + integer, parameter :: rid_C2H5OH_OH = 323 + integer, parameter :: rid_C2H5OOH_OH = 324 + integer, parameter :: rid_C2H6_CL = 325 + integer, parameter :: rid_C2H6_OH = 326 + integer, parameter :: rid_CH3CHO_NO3 = 327 + integer, parameter :: rid_CH3CHO_OH = 328 + integer, parameter :: rid_CH3CN_OH = 329 + integer, parameter :: rid_CH3CO3_CH3CO3 = 330 + integer, parameter :: rid_CH3CO3_CH3O2 = 331 + integer, parameter :: rid_CH3CO3_HO2 = 332 + integer, parameter :: rid_CH3CO3_NO = 333 + integer, parameter :: rid_CH3COOH_OH = 334 + integer, parameter :: rid_CH3COOOH_OH = 335 + integer, parameter :: rid_EO2_HO2 = 336 + integer, parameter :: rid_EO2_NO = 337 + integer, parameter :: rid_EO_M = 338 + integer, parameter :: rid_EO_O2 = 339 + integer, parameter :: rid_GLYALD_OH = 340 + integer, parameter :: rid_GLYOXAL_OH = 341 + integer, parameter :: rid_PAN_OH = 342 + integer, parameter :: rid_tag_C2H4_OH = 343 + integer, parameter :: rid_tag_CH3CO3_NO2 = 344 + integer, parameter :: rid_usr_PAN_M = 345 + integer, parameter :: rid_C3H6_NO3 = 346 + integer, parameter :: rid_C3H6_O3 = 347 + integer, parameter :: rid_C3H7O2_CH3O2 = 348 + integer, parameter :: rid_C3H7O2_HO2 = 349 + integer, parameter :: rid_C3H7O2_NO = 350 + integer, parameter :: rid_C3H7OOH_OH = 351 + integer, parameter :: rid_C3H8_OH = 352 + integer, parameter :: rid_CH3COCHO_NO3 = 353 + integer, parameter :: rid_CH3COCHO_OH = 354 + integer, parameter :: rid_CL_C3H8 = 355 + integer, parameter :: rid_HYAC_OH = 356 + integer, parameter :: rid_NOA_OH = 357 + integer, parameter :: rid_PO2_HO2 = 358 + integer, parameter :: rid_PO2_NO = 359 + integer, parameter :: rid_POOH_OH = 360 + integer, parameter :: rid_RO2_CH3O2 = 361 + integer, parameter :: rid_RO2_HO2 = 362 + integer, parameter :: rid_RO2_NO = 363 + integer, parameter :: rid_ROOH_OH = 364 + integer, parameter :: rid_tag_C3H6_OH = 365 + integer, parameter :: rid_usr_CH3COCH3_OH = 366 + integer, parameter :: rid_BIGENE_NO3 = 367 + integer, parameter :: rid_BIGENE_OH = 368 + integer, parameter :: rid_ENEO2_NO = 369 + integer, parameter :: rid_ENEO2_NOb = 370 + integer, parameter :: rid_HONITR_OH = 371 + integer, parameter :: rid_MACRO2_CH3CO3 = 372 + integer, parameter :: rid_MACRO2_CH3O2 = 373 + integer, parameter :: rid_MACRO2_HO2 = 374 + integer, parameter :: rid_MACRO2_NO3 = 375 + integer, parameter :: rid_MACRO2_NOa = 376 + integer, parameter :: rid_MACRO2_NOb = 377 + integer, parameter :: rid_MACR_O3 = 378 + integer, parameter :: rid_MACR_OH = 379 + integer, parameter :: rid_MACROOH_OH = 380 + integer, parameter :: rid_MCO3_CH3CO3 = 381 + integer, parameter :: rid_MCO3_CH3O2 = 382 + integer, parameter :: rid_MCO3_HO2 = 383 + integer, parameter :: rid_MCO3_MCO3 = 384 + integer, parameter :: rid_MCO3_NO = 385 + integer, parameter :: rid_MCO3_NO3 = 386 + integer, parameter :: rid_MEKO2_HO2 = 387 + integer, parameter :: rid_MEKO2_NO = 388 + integer, parameter :: rid_MEK_OH = 389 + integer, parameter :: rid_MEKOOH_OH = 390 + integer, parameter :: rid_MPAN_OH_M = 391 + integer, parameter :: rid_MVK_O3 = 392 + integer, parameter :: rid_MVK_OH = 393 + integer, parameter :: rid_tag_MCO3_NO2 = 394 + integer, parameter :: rid_usr_MPAN_M = 395 + integer, parameter :: rid_ALKNIT_OH = 396 + integer, parameter :: rid_ALKO2_HO2 = 397 + integer, parameter :: rid_ALKO2_NO = 398 + integer, parameter :: rid_ALKO2_NOb = 399 + integer, parameter :: rid_ALKOOH_OH = 400 + integer, parameter :: rid_BIGALK_OH = 401 + integer, parameter :: rid_HPALD_OH = 402 + integer, parameter :: rid_HYDRALD_OH = 403 + integer, parameter :: rid_IEPOX_OH = 404 + integer, parameter :: rid_ISOPAO2_CH3CO3 = 405 + integer, parameter :: rid_ISOPAO2_CH3O2 = 406 + integer, parameter :: rid_ISOPAO2_HO2 = 407 + integer, parameter :: rid_ISOPAO2_NO = 408 + integer, parameter :: rid_ISOPAO2_NO3 = 409 + integer, parameter :: rid_ISOPBO2_CH3CO3 = 410 + integer, parameter :: rid_ISOPBO2_CH3O2 = 411 + integer, parameter :: rid_ISOPBO2_HO2 = 412 + integer, parameter :: rid_ISOPBO2_M = 413 + integer, parameter :: rid_ISOPBO2_NO = 414 + integer, parameter :: rid_ISOPBO2_NO3 = 415 + integer, parameter :: rid_ISOPNITA_OH = 416 + integer, parameter :: rid_ISOPNITB_OH = 417 + integer, parameter :: rid_ISOP_NO3 = 418 + integer, parameter :: rid_ISOPNO3_CH3CO3 = 419 + integer, parameter :: rid_ISOPNO3_CH3O2 = 420 + integer, parameter :: rid_ISOPNO3_HO2 = 421 + integer, parameter :: rid_ISOPNO3_NO = 422 + integer, parameter :: rid_ISOPNO3_NO3 = 423 + integer, parameter :: rid_ISOPNOOH_OH = 424 + integer, parameter :: rid_ISOP_O3 = 425 + integer, parameter :: rid_ISOP_OH = 426 + integer, parameter :: rid_ISOPOOH_OH = 427 + integer, parameter :: rid_NC4CH2OH_OH = 428 + integer, parameter :: rid_NC4CHO_OH = 429 + integer, parameter :: rid_XO2_CH3CO3 = 430 + integer, parameter :: rid_XO2_CH3O2 = 431 + integer, parameter :: rid_XO2_HO2 = 432 + integer, parameter :: rid_XO2_NO = 433 + integer, parameter :: rid_XO2_NO3 = 434 + integer, parameter :: rid_XOOH_OH = 435 + integer, parameter :: rid_ACBZO2_HO2 = 436 + integer, parameter :: rid_ACBZO2_NO = 437 + integer, parameter :: rid_BENZENE_OH = 438 + integer, parameter :: rid_BENZO2_HO2 = 439 + integer, parameter :: rid_BENZO2_NO = 440 + integer, parameter :: rid_BENZOOH_OH = 441 + integer, parameter :: rid_BZALD_OH = 442 + integer, parameter :: rid_BZOO_HO2 = 443 + integer, parameter :: rid_BZOOH_OH = 444 + integer, parameter :: rid_BZOO_NO = 445 + integer, parameter :: rid_C6H5O2_HO2 = 446 + integer, parameter :: rid_C6H5O2_NO = 447 + integer, parameter :: rid_C6H5OOH_OH = 448 + integer, parameter :: rid_CRESOL_OH = 449 + integer, parameter :: rid_DICARBO2_HO2 = 450 + integer, parameter :: rid_DICARBO2_NO = 451 + integer, parameter :: rid_DICARBO2_NO2 = 452 + integer, parameter :: rid_MALO2_HO2 = 453 + integer, parameter :: rid_MALO2_NO = 454 + integer, parameter :: rid_MALO2_NO2 = 455 + integer, parameter :: rid_MDIALO2_HO2 = 456 + integer, parameter :: rid_MDIALO2_NO = 457 + integer, parameter :: rid_MDIALO2_NO2 = 458 + integer, parameter :: rid_PHENO2_HO2 = 459 + integer, parameter :: rid_PHENO2_NO = 460 + integer, parameter :: rid_PHENOL_OH = 461 + integer, parameter :: rid_PHENO_NO2 = 462 + integer, parameter :: rid_PHENO_O3 = 463 + integer, parameter :: rid_PHENOOH_OH = 464 + integer, parameter :: rid_tag_ACBZO2_NO2 = 465 + integer, parameter :: rid_TOLO2_HO2 = 466 + integer, parameter :: rid_TOLO2_NO = 467 + integer, parameter :: rid_TOLOOH_OH = 468 + integer, parameter :: rid_TOLUENE_OH = 469 + integer, parameter :: rid_usr_PBZNIT_M = 470 + integer, parameter :: rid_XYLENES_OH = 471 + integer, parameter :: rid_XYLENO2_HO2 = 472 + integer, parameter :: rid_XYLENO2_NO = 473 + integer, parameter :: rid_XYLENOOH_OH = 474 + integer, parameter :: rid_XYLOLO2_HO2 = 475 + integer, parameter :: rid_XYLOLO2_NO = 476 + integer, parameter :: rid_XYLOL_OH = 477 + integer, parameter :: rid_XYLOLOOH_OH = 478 + integer, parameter :: rid_BCARY_NO3 = 479 + integer, parameter :: rid_BCARY_O3 = 480 + integer, parameter :: rid_BCARY_OH = 481 + integer, parameter :: rid_MTERP_NO3 = 482 + integer, parameter :: rid_MTERP_O3 = 483 + integer, parameter :: rid_MTERP_OH = 484 + integer, parameter :: rid_NTERPO2_CH3O2 = 485 + integer, parameter :: rid_NTERPO2_HO2 = 486 + integer, parameter :: rid_NTERPO2_NO = 487 + integer, parameter :: rid_NTERPO2_NO3 = 488 + integer, parameter :: rid_NTERPOOH_OH = 489 + integer, parameter :: rid_TERP2O2_CH3O2 = 490 + integer, parameter :: rid_TERP2O2_HO2 = 491 + integer, parameter :: rid_TERP2O2_NO = 492 + integer, parameter :: rid_TERP2OOH_OH = 493 + integer, parameter :: rid_TERPNIT_OH = 494 + integer, parameter :: rid_TERPO2_CH3O2 = 495 + integer, parameter :: rid_TERPO2_HO2 = 496 + integer, parameter :: rid_TERPO2_NO = 497 + integer, parameter :: rid_TERPOOH_OH = 498 + integer, parameter :: rid_TERPROD1_NO3 = 499 + integer, parameter :: rid_TERPROD1_OH = 500 + integer, parameter :: rid_TERPROD2_OH = 501 + integer, parameter :: rid_DMS_NO3 = 502 + integer, parameter :: rid_DMS_OHa = 503 + integer, parameter :: rid_OCS_O = 504 + integer, parameter :: rid_OCS_OH = 505 + integer, parameter :: rid_S_O2 = 506 + integer, parameter :: rid_SO2_OH_M = 507 + integer, parameter :: rid_S_O3 = 508 + integer, parameter :: rid_SO_BRO = 509 + integer, parameter :: rid_SO_CLO = 510 + integer, parameter :: rid_S_OH = 511 + integer, parameter :: rid_SO_NO2 = 512 + integer, parameter :: rid_SO_O2 = 513 + integer, parameter :: rid_SO_O3 = 514 + integer, parameter :: rid_SO_OCLO = 515 + integer, parameter :: rid_SO_OH = 516 + integer, parameter :: rid_usr_DMS_OH = 517 + integer, parameter :: rid_usr_SO3_H2O = 518 + integer, parameter :: rid_NH3_OH = 519 + integer, parameter :: rid_usr_GLYOXAL_aer = 520 + integer, parameter :: rid_usr_HO2_aer = 521 + integer, parameter :: rid_usr_HONITR_aer = 522 + integer, parameter :: rid_usr_ISOPNITA_aer = 523 + integer, parameter :: rid_usr_ISOPNITB_aer = 524 + integer, parameter :: rid_usr_N2O5_aer = 525 + integer, parameter :: rid_usr_NC4CH2OH_aer = 526 + integer, parameter :: rid_usr_NC4CHO_aer = 527 + integer, parameter :: rid_usr_NH4_strat_tau = 528 + integer, parameter :: rid_usr_NO2_aer = 529 + integer, parameter :: rid_usr_NO3_aer = 530 + integer, parameter :: rid_usr_NTERPOOH_aer = 531 + integer, parameter :: rid_usr_ONITR_aer = 532 + integer, parameter :: rid_usr_TERPNIT_aer = 533 + integer, parameter :: rid_BCARY_NO3_vbs = 534 + integer, parameter :: rid_BCARYO2_HO2_vbs = 535 + integer, parameter :: rid_BCARYO2_NO_vbs = 536 + integer, parameter :: rid_BCARY_O3_vbs = 537 + integer, parameter :: rid_BCARY_OH_vbs = 538 + integer, parameter :: rid_BENZENE_OH_vbs = 539 + integer, parameter :: rid_BENZO2_HO2_vbs = 540 + integer, parameter :: rid_BENZO2_NO_vbs = 541 + integer, parameter :: rid_ISOP_NO3_vbs = 542 + integer, parameter :: rid_ISOPO2_HO2_vbs = 543 + integer, parameter :: rid_ISOPO2_NO_vbs = 544 + integer, parameter :: rid_ISOP_O3_vbs = 545 + integer, parameter :: rid_ISOP_OH_vbs = 546 + integer, parameter :: rid_IVOCO2_HO2_vbs = 547 + integer, parameter :: rid_IVOCO2_NO_vbs = 548 + integer, parameter :: rid_IVOC_OH_vbs = 549 + integer, parameter :: rid_MTERP_NO3_vbs = 550 + integer, parameter :: rid_MTERPO2_HO2_vbs = 551 + integer, parameter :: rid_MTERPO2_NO_vbs = 552 + integer, parameter :: rid_MTERP_O3_vbs = 553 + integer, parameter :: rid_MTERP_OH_vbs = 554 + integer, parameter :: rid_SVOC_OH = 555 + integer, parameter :: rid_TOLUENE_OH_vbs = 556 + integer, parameter :: rid_TOLUO2_HO2_vbs = 557 + integer, parameter :: rid_TOLUO2_NO_vbs = 558 + integer, parameter :: rid_XYLENES_OH_vbs = 559 + integer, parameter :: rid_XYLEO2_HO2_vbs = 560 + integer, parameter :: rid_XYLEO2_NO_vbs = 561 + integer, parameter :: rid_het1 = 562 + integer, parameter :: rid_het10 = 563 + integer, parameter :: rid_het11 = 564 + integer, parameter :: rid_het12 = 565 + integer, parameter :: rid_het13 = 566 + integer, parameter :: rid_het14 = 567 + integer, parameter :: rid_het15 = 568 + integer, parameter :: rid_het16 = 569 + integer, parameter :: rid_het17 = 570 + integer, parameter :: rid_het2 = 571 + integer, parameter :: rid_het3 = 572 + integer, parameter :: rid_het4 = 573 + integer, parameter :: rid_het5 = 574 + integer, parameter :: rid_het6 = 575 + integer, parameter :: rid_het7 = 576 + integer, parameter :: rid_het8 = 577 + integer, parameter :: rid_het9 = 578 + integer, parameter :: rid_elec1 = 579 + integer, parameter :: rid_elec2 = 580 + integer, parameter :: rid_elec3 = 581 + integer, parameter :: rid_ion_N2p_O2 = 582 + integer, parameter :: rid_ion_N2p_Oa = 583 + integer, parameter :: rid_ion_N2p_Ob = 584 + integer, parameter :: rid_ion_Np_O = 585 + integer, parameter :: rid_ion_Np_O2a = 586 + integer, parameter :: rid_ion_Np_O2b = 587 + integer, parameter :: rid_ion_O2p_N = 588 + integer, parameter :: rid_ion_O2p_N2 = 589 + integer, parameter :: rid_ion_O2p_NO = 590 + integer, parameter :: rid_ion_Op_CO2 = 591 + integer, parameter :: rid_ion_Op_N2 = 592 + integer, parameter :: rid_ion_Op_O2 = 593 + integer, parameter :: rid_E90_tau = 594 + integer, parameter :: rid_NH_50_tau = 595 + integer, parameter :: rid_NH_5_tau = 596 + integer, parameter :: rid_ST80_25_tau = 597 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/m_spc_id.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/m_spc_id.F90 new file mode 100644 index 0000000000..8bfdfac324 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/m_spc_id.F90 @@ -0,0 +1,244 @@ + module m_spc_id + implicit none + integer, parameter :: id_ALKNIT = 1 + integer, parameter :: id_ALKOOH = 2 + integer, parameter :: id_AOA_NH = 3 + integer, parameter :: id_bc_a1 = 4 + integer, parameter :: id_bc_a4 = 5 + integer, parameter :: id_BCARY = 6 + integer, parameter :: id_BENZENE = 7 + integer, parameter :: id_BENZOOH = 8 + integer, parameter :: id_BEPOMUC = 9 + integer, parameter :: id_BIGALD = 10 + integer, parameter :: id_BIGALD1 = 11 + integer, parameter :: id_BIGALD2 = 12 + integer, parameter :: id_BIGALD3 = 13 + integer, parameter :: id_BIGALD4 = 14 + integer, parameter :: id_BIGALK = 15 + integer, parameter :: id_BIGENE = 16 + integer, parameter :: id_BR = 17 + integer, parameter :: id_BRCL = 18 + integer, parameter :: id_BRO = 19 + integer, parameter :: id_BRONO2 = 20 + integer, parameter :: id_BRY = 21 + integer, parameter :: id_BZALD = 22 + integer, parameter :: id_BZOOH = 23 + integer, parameter :: id_C2H2 = 24 + integer, parameter :: id_C2H4 = 25 + integer, parameter :: id_C2H5OH = 26 + integer, parameter :: id_C2H5OOH = 27 + integer, parameter :: id_C2H6 = 28 + integer, parameter :: id_C3H6 = 29 + integer, parameter :: id_C3H7OOH = 30 + integer, parameter :: id_C3H8 = 31 + integer, parameter :: id_C6H5OOH = 32 + integer, parameter :: id_CCL4 = 33 + integer, parameter :: id_CF2CLBR = 34 + integer, parameter :: id_CF3BR = 35 + integer, parameter :: id_CFC11 = 36 + integer, parameter :: id_CFC113 = 37 + integer, parameter :: id_CFC114 = 38 + integer, parameter :: id_CFC115 = 39 + integer, parameter :: id_CFC12 = 40 + integer, parameter :: id_CH2BR2 = 41 + integer, parameter :: id_CH2O = 42 + integer, parameter :: id_CH3BR = 43 + integer, parameter :: id_CH3CCL3 = 44 + integer, parameter :: id_CH3CHO = 45 + integer, parameter :: id_CH3CL = 46 + integer, parameter :: id_CH3CN = 47 + integer, parameter :: id_CH3COCH3 = 48 + integer, parameter :: id_CH3COCHO = 49 + integer, parameter :: id_CH3COOH = 50 + integer, parameter :: id_CH3COOOH = 51 + integer, parameter :: id_CH3OH = 52 + integer, parameter :: id_CH3OOH = 53 + integer, parameter :: id_CH4 = 54 + integer, parameter :: id_CHBR3 = 55 + integer, parameter :: id_CL = 56 + integer, parameter :: id_CL2 = 57 + integer, parameter :: id_CL2O2 = 58 + integer, parameter :: id_CLO = 59 + integer, parameter :: id_CLONO2 = 60 + integer, parameter :: id_CLY = 61 + integer, parameter :: id_CO = 62 + integer, parameter :: id_CO2 = 63 + integer, parameter :: id_COF2 = 64 + integer, parameter :: id_COFCL = 65 + integer, parameter :: id_CRESOL = 66 + integer, parameter :: id_DMS = 67 + integer, parameter :: id_dst_a1 = 68 + integer, parameter :: id_dst_a2 = 69 + integer, parameter :: id_dst_a3 = 70 + integer, parameter :: id_E90 = 71 + integer, parameter :: id_EOOH = 72 + integer, parameter :: id_F = 73 + integer, parameter :: id_GLYALD = 74 + integer, parameter :: id_GLYOXAL = 75 + integer, parameter :: id_H = 76 + integer, parameter :: id_H2 = 77 + integer, parameter :: id_H2402 = 78 + integer, parameter :: id_H2O2 = 79 + integer, parameter :: id_H2SO4 = 80 + integer, parameter :: id_HBR = 81 + integer, parameter :: id_HCFC141B = 82 + integer, parameter :: id_HCFC142B = 83 + integer, parameter :: id_HCFC22 = 84 + integer, parameter :: id_HCL = 85 + integer, parameter :: id_HCN = 86 + integer, parameter :: id_HCOOH = 87 + integer, parameter :: id_HF = 88 + integer, parameter :: id_HNO3 = 89 + integer, parameter :: id_HO2 = 90 + integer, parameter :: id_HO2NO2 = 91 + integer, parameter :: id_HOBR = 92 + integer, parameter :: id_HOCL = 93 + integer, parameter :: id_HONITR = 94 + integer, parameter :: id_HPALD = 95 + integer, parameter :: id_HYAC = 96 + integer, parameter :: id_HYDRALD = 97 + integer, parameter :: id_IEPOX = 98 + integer, parameter :: id_ISOP = 99 + integer, parameter :: id_ISOPNITA = 100 + integer, parameter :: id_ISOPNITB = 101 + integer, parameter :: id_ISOPNOOH = 102 + integer, parameter :: id_ISOPOOH = 103 + integer, parameter :: id_IVOC = 104 + integer, parameter :: id_MACR = 105 + integer, parameter :: id_MACROOH = 106 + integer, parameter :: id_MEK = 107 + integer, parameter :: id_MEKOOH = 108 + integer, parameter :: id_MPAN = 109 + integer, parameter :: id_MTERP = 110 + integer, parameter :: id_MVK = 111 + integer, parameter :: id_N = 112 + integer, parameter :: id_N2O = 113 + integer, parameter :: id_N2O5 = 114 + integer, parameter :: id_NC4CH2OH = 115 + integer, parameter :: id_NC4CHO = 116 + integer, parameter :: id_ncl_a1 = 117 + integer, parameter :: id_ncl_a2 = 118 + integer, parameter :: id_ncl_a3 = 119 + integer, parameter :: id_NH3 = 120 + integer, parameter :: id_NH4 = 121 + integer, parameter :: id_NH_5 = 122 + integer, parameter :: id_NH_50 = 123 + integer, parameter :: id_NO = 124 + integer, parameter :: id_NO2 = 125 + integer, parameter :: id_NO3 = 126 + integer, parameter :: id_NOA = 127 + integer, parameter :: id_NTERPOOH = 128 + integer, parameter :: id_num_a1 = 129 + integer, parameter :: id_num_a2 = 130 + integer, parameter :: id_num_a3 = 131 + integer, parameter :: id_num_a4 = 132 + integer, parameter :: id_num_a5 = 133 + integer, parameter :: id_O = 134 + integer, parameter :: id_O2 = 135 + integer, parameter :: id_O3 = 136 + integer, parameter :: id_O3S = 137 + integer, parameter :: id_OCLO = 138 + integer, parameter :: id_OCS = 139 + integer, parameter :: id_ONITR = 140 + integer, parameter :: id_PAN = 141 + integer, parameter :: id_PBZNIT = 142 + integer, parameter :: id_PHENO = 143 + integer, parameter :: id_PHENOL = 144 + integer, parameter :: id_PHENOOH = 145 + integer, parameter :: id_pom_a1 = 146 + integer, parameter :: id_pom_a4 = 147 + integer, parameter :: id_POOH = 148 + integer, parameter :: id_ROOH = 149 + integer, parameter :: id_S = 150 + integer, parameter :: id_SF6 = 151 + integer, parameter :: id_SO = 152 + integer, parameter :: id_SO2 = 153 + integer, parameter :: id_SO3 = 154 + integer, parameter :: id_so4_a1 = 155 + integer, parameter :: id_so4_a2 = 156 + integer, parameter :: id_so4_a3 = 157 + integer, parameter :: id_so4_a5 = 158 + integer, parameter :: id_soa1_a1 = 159 + integer, parameter :: id_soa1_a2 = 160 + integer, parameter :: id_soa2_a1 = 161 + integer, parameter :: id_soa2_a2 = 162 + integer, parameter :: id_soa3_a1 = 163 + integer, parameter :: id_soa3_a2 = 164 + integer, parameter :: id_soa4_a1 = 165 + integer, parameter :: id_soa4_a2 = 166 + integer, parameter :: id_soa5_a1 = 167 + integer, parameter :: id_soa5_a2 = 168 + integer, parameter :: id_SOAG0 = 169 + integer, parameter :: id_SOAG1 = 170 + integer, parameter :: id_SOAG2 = 171 + integer, parameter :: id_SOAG3 = 172 + integer, parameter :: id_SOAG4 = 173 + integer, parameter :: id_ST80_25 = 174 + integer, parameter :: id_SVOC = 175 + integer, parameter :: id_TEPOMUC = 176 + integer, parameter :: id_TERP2OOH = 177 + integer, parameter :: id_TERPNIT = 178 + integer, parameter :: id_TERPOOH = 179 + integer, parameter :: id_TERPROD1 = 180 + integer, parameter :: id_TERPROD2 = 181 + integer, parameter :: id_TOLOOH = 182 + integer, parameter :: id_TOLUENE = 183 + integer, parameter :: id_XOOH = 184 + integer, parameter :: id_XYLENES = 185 + integer, parameter :: id_XYLENOOH = 186 + integer, parameter :: id_XYLOL = 187 + integer, parameter :: id_XYLOLOOH = 188 + integer, parameter :: id_NHDEP = 189 + integer, parameter :: id_NDEP = 190 + integer, parameter :: id_ACBZO2 = 191 + integer, parameter :: id_ALKO2 = 192 + integer, parameter :: id_BCARYO2VBS = 193 + integer, parameter :: id_BENZO2 = 194 + integer, parameter :: id_BENZO2VBS = 195 + integer, parameter :: id_BZOO = 196 + integer, parameter :: id_C2H5O2 = 197 + integer, parameter :: id_C3H7O2 = 198 + integer, parameter :: id_C6H5O2 = 199 + integer, parameter :: id_CH3CO3 = 200 + integer, parameter :: id_CH3O2 = 201 + integer, parameter :: id_DICARBO2 = 202 + integer, parameter :: id_e = 203 + integer, parameter :: id_ENEO2 = 204 + integer, parameter :: id_EO = 205 + integer, parameter :: id_EO2 = 206 + integer, parameter :: id_HOCH2OO = 207 + integer, parameter :: id_ISOPAO2 = 208 + integer, parameter :: id_ISOPBO2 = 209 + integer, parameter :: id_ISOPNO3 = 210 + integer, parameter :: id_ISOPO2VBS = 211 + integer, parameter :: id_IVOCO2VBS = 212 + integer, parameter :: id_MACRO2 = 213 + integer, parameter :: id_MALO2 = 214 + integer, parameter :: id_MCO3 = 215 + integer, parameter :: id_MDIALO2 = 216 + integer, parameter :: id_MEKO2 = 217 + integer, parameter :: id_MTERPO2VBS = 218 + integer, parameter :: id_N2D = 219 + integer, parameter :: id_N2p = 220 + integer, parameter :: id_NOp = 221 + integer, parameter :: id_Np = 222 + integer, parameter :: id_NTERPO2 = 223 + integer, parameter :: id_O1D = 224 + integer, parameter :: id_O2_1D = 225 + integer, parameter :: id_O2_1S = 226 + integer, parameter :: id_O2p = 227 + integer, parameter :: id_OH = 228 + integer, parameter :: id_Op = 229 + integer, parameter :: id_PHENO2 = 230 + integer, parameter :: id_PO2 = 231 + integer, parameter :: id_RO2 = 232 + integer, parameter :: id_TERP2O2 = 233 + integer, parameter :: id_TERPO2 = 234 + integer, parameter :: id_TOLO2 = 235 + integer, parameter :: id_TOLUO2VBS = 236 + integer, parameter :: id_XO2 = 237 + integer, parameter :: id_XYLENO2 = 238 + integer, parameter :: id_XYLEO2VBS = 239 + integer, parameter :: id_XYLOLO2 = 240 + integer, parameter :: id_H2O = 241 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/mo_adjrxt.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/mo_adjrxt.F90 new file mode 100644 index 0000000000..a4ce68a0cf --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/mo_adjrxt.F90 @@ -0,0 +1,458 @@ + 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(:,:, 155) = rate(:,:, 155) * inv(:,:, 2) + rate(:,:, 159) = rate(:,:, 159) * inv(:,:, 2) + rate(:,:, 163) = rate(:,:, 163) * inv(:,:, 2) + rate(:,:, 168) = rate(:,:, 168) * inv(:,:, 1) + rate(:,:, 169) = rate(:,:, 169) * inv(:,:, 1) + rate(:,:, 175) = rate(:,:, 175) * inv(:,:, 1) + rate(:,:, 185) = rate(:,:, 185) * inv(:,:, 1) + rate(:,:, 197) = rate(:,:, 197) * inv(:,:, 1) + rate(:,:, 205) = rate(:,:, 205) * inv(:,:, 1) + rate(:,:, 208) = rate(:,:, 208) * inv(:,:, 1) + rate(:,:, 209) = rate(:,:, 209) * inv(:,:, 1) + rate(:,:, 210) = rate(:,:, 210) * inv(:,:, 1) + rate(:,:, 212) = rate(:,:, 212) * inv(:,:, 1) + rate(:,:, 213) = rate(:,:, 213) * inv(:,:, 1) + rate(:,:, 228) = rate(:,:, 228) * inv(:,:, 1) + rate(:,:, 248) = rate(:,:, 248) * inv(:,:, 1) + rate(:,:, 249) = rate(:,:, 249) * inv(:,:, 1) + rate(:,:, 259) = rate(:,:, 259) * inv(:,:, 1) + rate(:,:, 305) = rate(:,:, 305) * inv(:,:, 1) + rate(:,:, 315) = rate(:,:, 315) * inv(:,:, 1) + rate(:,:, 316) = rate(:,:, 316) * inv(:,:, 1) + rate(:,:, 317) = rate(:,:, 317) * inv(:,:, 1) + rate(:,:, 343) = rate(:,:, 343) * inv(:,:, 1) + rate(:,:, 344) = rate(:,:, 344) * inv(:,:, 1) + rate(:,:, 345) = rate(:,:, 345) * inv(:,:, 1) + rate(:,:, 365) = rate(:,:, 365) * inv(:,:, 1) + rate(:,:, 391) = rate(:,:, 391) * inv(:,:, 1) + rate(:,:, 394) = rate(:,:, 394) * inv(:,:, 1) + rate(:,:, 395) = rate(:,:, 395) * inv(:,:, 1) + rate(:,:, 452) = rate(:,:, 452) * inv(:,:, 1) + rate(:,:, 455) = rate(:,:, 455) * inv(:,:, 1) + rate(:,:, 458) = rate(:,:, 458) * inv(:,:, 1) + rate(:,:, 465) = rate(:,:, 465) * inv(:,:, 1) + rate(:,:, 470) = rate(:,:, 470) * inv(:,:, 1) + rate(:,:, 507) = rate(:,:, 507) * inv(:,:, 1) + rate(:,:, 589) = rate(:,:, 589) * inv(:,:, 2) + rate(:,:, 592) = rate(:,:, 592) * inv(:,:, 2) + rate(:,:, 153) = rate(:,:, 153) * m(:,:) + rate(:,:, 154) = rate(:,:, 154) * m(:,:) + rate(:,:, 156) = rate(:,:, 156) * m(:,:) + rate(:,:, 157) = rate(:,:, 157) * m(:,:) + rate(:,:, 158) = rate(:,:, 158) * m(:,:) + rate(:,:, 160) = rate(:,:, 160) * m(:,:) + rate(:,:, 161) = rate(:,:, 161) * m(:,:) + rate(:,:, 162) = rate(:,:, 162) * 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(:,:, 172) = rate(:,:, 172) * 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(:,:, 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * m(:,:) + rate(:,:, 247) = rate(:,:, 247) * m(:,:) + rate(:,:, 248) = rate(:,:, 248) * m(:,:) + rate(:,:, 250) = rate(:,:, 250) * m(:,:) + rate(:,:, 251) = rate(:,:, 251) * m(:,:) + rate(:,:, 252) = rate(:,:, 252) * 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(:,:, 292) = rate(:,:, 292) * 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(:,:, 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(:,:, 322) = rate(:,:, 322) * 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(:,:, 329) = rate(:,:, 329) * 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(:,:, 336) = rate(:,:, 336) * m(:,:) + rate(:,:, 337) = rate(:,:, 337) * m(:,:) + rate(:,:, 339) = rate(:,:, 339) * m(:,:) + rate(:,:, 340) = rate(:,:, 340) * m(:,:) + rate(:,:, 341) = rate(:,:, 341) * m(:,:) + rate(:,:, 342) = rate(:,:, 342) * m(:,:) + rate(:,:, 343) = rate(:,:, 343) * m(:,:) + rate(:,:, 344) = rate(:,:, 344) * m(:,:) + rate(:,:, 346) = rate(:,:, 346) * m(:,:) + rate(:,:, 347) = rate(:,:, 347) * m(:,:) + rate(:,:, 348) = rate(:,:, 348) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 352) = rate(:,:, 352) * m(:,:) + rate(:,:, 353) = rate(:,:, 353) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 357) = rate(:,:, 357) * m(:,:) + rate(:,:, 358) = rate(:,:, 358) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + rate(:,:, 360) = rate(:,:, 360) * m(:,:) + rate(:,:, 361) = rate(:,:, 361) * m(:,:) + rate(:,:, 362) = rate(:,:, 362) * m(:,:) + rate(:,:, 363) = rate(:,:, 363) * m(:,:) + rate(:,:, 364) = rate(:,:, 364) * m(:,:) + rate(:,:, 365) = rate(:,:, 365) * m(:,:) + rate(:,:, 366) = rate(:,:, 366) * m(:,:) + rate(:,:, 367) = rate(:,:, 367) * m(:,:) + rate(:,:, 368) = rate(:,:, 368) * m(:,:) + rate(:,:, 369) = rate(:,:, 369) * m(:,:) + rate(:,:, 370) = rate(:,:, 370) * m(:,:) + rate(:,:, 371) = rate(:,:, 371) * m(:,:) + rate(:,:, 372) = rate(:,:, 372) * m(:,:) + rate(:,:, 373) = rate(:,:, 373) * m(:,:) + rate(:,:, 374) = rate(:,:, 374) * m(:,:) + rate(:,:, 375) = rate(:,:, 375) * m(:,:) + rate(:,:, 376) = rate(:,:, 376) * m(:,:) + rate(:,:, 377) = rate(:,:, 377) * m(:,:) + rate(:,:, 378) = rate(:,:, 378) * m(:,:) + rate(:,:, 379) = rate(:,:, 379) * m(:,:) + rate(:,:, 380) = rate(:,:, 380) * m(:,:) + rate(:,:, 381) = rate(:,:, 381) * m(:,:) + rate(:,:, 382) = rate(:,:, 382) * m(:,:) + rate(:,:, 383) = rate(:,:, 383) * m(:,:) + rate(:,:, 384) = rate(:,:, 384) * m(:,:) + rate(:,:, 385) = rate(:,:, 385) * m(:,:) + rate(:,:, 386) = rate(:,:, 386) * m(:,:) + rate(:,:, 387) = rate(:,:, 387) * m(:,:) + rate(:,:, 388) = rate(:,:, 388) * m(:,:) + rate(:,:, 389) = rate(:,:, 389) * m(:,:) + rate(:,:, 390) = rate(:,:, 390) * m(:,:) + rate(:,:, 391) = rate(:,:, 391) * m(:,:) + rate(:,:, 392) = rate(:,:, 392) * m(:,:) + rate(:,:, 393) = rate(:,:, 393) * m(:,:) + rate(:,:, 394) = rate(:,:, 394) * m(:,:) + rate(:,:, 396) = rate(:,:, 396) * m(:,:) + rate(:,:, 397) = rate(:,:, 397) * m(:,:) + rate(:,:, 398) = rate(:,:, 398) * m(:,:) + rate(:,:, 399) = rate(:,:, 399) * m(:,:) + rate(:,:, 400) = rate(:,:, 400) * m(:,:) + rate(:,:, 401) = rate(:,:, 401) * m(:,:) + rate(:,:, 402) = rate(:,:, 402) * m(:,:) + rate(:,:, 403) = rate(:,:, 403) * m(:,:) + rate(:,:, 404) = rate(:,:, 404) * m(:,:) + rate(:,:, 405) = rate(:,:, 405) * m(:,:) + rate(:,:, 406) = rate(:,:, 406) * m(:,:) + rate(:,:, 407) = rate(:,:, 407) * m(:,:) + rate(:,:, 408) = rate(:,:, 408) * m(:,:) + rate(:,:, 409) = rate(:,:, 409) * m(:,:) + rate(:,:, 410) = rate(:,:, 410) * m(:,:) + rate(:,:, 411) = rate(:,:, 411) * m(:,:) + rate(:,:, 412) = rate(:,:, 412) * m(:,:) + rate(:,:, 414) = rate(:,:, 414) * m(:,:) + rate(:,:, 415) = rate(:,:, 415) * m(:,:) + rate(:,:, 416) = rate(:,:, 416) * m(:,:) + rate(:,:, 417) = rate(:,:, 417) * m(:,:) + rate(:,:, 418) = rate(:,:, 418) * m(:,:) + rate(:,:, 419) = rate(:,:, 419) * m(:,:) + rate(:,:, 420) = rate(:,:, 420) * m(:,:) + rate(:,:, 421) = rate(:,:, 421) * m(:,:) + rate(:,:, 422) = rate(:,:, 422) * m(:,:) + rate(:,:, 423) = rate(:,:, 423) * m(:,:) + rate(:,:, 424) = rate(:,:, 424) * m(:,:) + rate(:,:, 425) = rate(:,:, 425) * m(:,:) + rate(:,:, 426) = rate(:,:, 426) * m(:,:) + rate(:,:, 427) = rate(:,:, 427) * m(:,:) + rate(:,:, 428) = rate(:,:, 428) * m(:,:) + rate(:,:, 429) = rate(:,:, 429) * m(:,:) + rate(:,:, 430) = rate(:,:, 430) * m(:,:) + rate(:,:, 431) = rate(:,:, 431) * m(:,:) + rate(:,:, 432) = rate(:,:, 432) * m(:,:) + rate(:,:, 433) = rate(:,:, 433) * m(:,:) + rate(:,:, 434) = rate(:,:, 434) * m(:,:) + rate(:,:, 435) = rate(:,:, 435) * m(:,:) + rate(:,:, 436) = rate(:,:, 436) * m(:,:) + rate(:,:, 437) = rate(:,:, 437) * m(:,:) + rate(:,:, 438) = rate(:,:, 438) * m(:,:) + rate(:,:, 439) = rate(:,:, 439) * m(:,:) + rate(:,:, 440) = rate(:,:, 440) * m(:,:) + rate(:,:, 441) = rate(:,:, 441) * m(:,:) + rate(:,:, 442) = rate(:,:, 442) * m(:,:) + rate(:,:, 443) = rate(:,:, 443) * m(:,:) + rate(:,:, 444) = rate(:,:, 444) * m(:,:) + rate(:,:, 445) = rate(:,:, 445) * m(:,:) + rate(:,:, 446) = rate(:,:, 446) * m(:,:) + rate(:,:, 447) = rate(:,:, 447) * m(:,:) + rate(:,:, 448) = rate(:,:, 448) * m(:,:) + rate(:,:, 449) = rate(:,:, 449) * m(:,:) + rate(:,:, 450) = rate(:,:, 450) * m(:,:) + rate(:,:, 451) = rate(:,:, 451) * m(:,:) + rate(:,:, 452) = rate(:,:, 452) * m(:,:) + rate(:,:, 453) = rate(:,:, 453) * m(:,:) + rate(:,:, 454) = rate(:,:, 454) * m(:,:) + rate(:,:, 455) = rate(:,:, 455) * m(:,:) + rate(:,:, 456) = rate(:,:, 456) * m(:,:) + rate(:,:, 457) = rate(:,:, 457) * m(:,:) + rate(:,:, 458) = rate(:,:, 458) * m(:,:) + rate(:,:, 459) = rate(:,:, 459) * m(:,:) + rate(:,:, 460) = rate(:,:, 460) * m(:,:) + rate(:,:, 461) = rate(:,:, 461) * m(:,:) + rate(:,:, 462) = rate(:,:, 462) * m(:,:) + rate(:,:, 463) = rate(:,:, 463) * m(:,:) + rate(:,:, 464) = rate(:,:, 464) * m(:,:) + rate(:,:, 465) = rate(:,:, 465) * m(:,:) + rate(:,:, 466) = rate(:,:, 466) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * m(:,:) + rate(:,:, 468) = rate(:,:, 468) * m(:,:) + rate(:,:, 469) = rate(:,:, 469) * m(:,:) + rate(:,:, 471) = rate(:,:, 471) * m(:,:) + rate(:,:, 472) = rate(:,:, 472) * m(:,:) + rate(:,:, 473) = rate(:,:, 473) * m(:,:) + rate(:,:, 474) = rate(:,:, 474) * m(:,:) + rate(:,:, 475) = rate(:,:, 475) * m(:,:) + rate(:,:, 476) = rate(:,:, 476) * m(:,:) + rate(:,:, 477) = rate(:,:, 477) * m(:,:) + rate(:,:, 478) = rate(:,:, 478) * m(:,:) + rate(:,:, 479) = rate(:,:, 479) * m(:,:) + rate(:,:, 480) = rate(:,:, 480) * m(:,:) + rate(:,:, 481) = rate(:,:, 481) * m(:,:) + rate(:,:, 482) = rate(:,:, 482) * m(:,:) + rate(:,:, 483) = rate(:,:, 483) * m(:,:) + rate(:,:, 484) = rate(:,:, 484) * m(:,:) + rate(:,:, 485) = rate(:,:, 485) * m(:,:) + rate(:,:, 486) = rate(:,:, 486) * m(:,:) + rate(:,:, 487) = rate(:,:, 487) * m(:,:) + rate(:,:, 488) = rate(:,:, 488) * m(:,:) + rate(:,:, 489) = rate(:,:, 489) * m(:,:) + rate(:,:, 490) = rate(:,:, 490) * m(:,:) + rate(:,:, 491) = rate(:,:, 491) * m(:,:) + rate(:,:, 492) = rate(:,:, 492) * m(:,:) + rate(:,:, 493) = rate(:,:, 493) * m(:,:) + rate(:,:, 494) = rate(:,:, 494) * m(:,:) + rate(:,:, 495) = rate(:,:, 495) * m(:,:) + rate(:,:, 496) = rate(:,:, 496) * m(:,:) + rate(:,:, 497) = rate(:,:, 497) * m(:,:) + rate(:,:, 498) = rate(:,:, 498) * m(:,:) + rate(:,:, 499) = rate(:,:, 499) * m(:,:) + rate(:,:, 500) = rate(:,:, 500) * m(:,:) + rate(:,:, 501) = rate(:,:, 501) * m(:,:) + rate(:,:, 502) = rate(:,:, 502) * m(:,:) + rate(:,:, 503) = rate(:,:, 503) * m(:,:) + rate(:,:, 504) = rate(:,:, 504) * m(:,:) + rate(:,:, 505) = rate(:,:, 505) * m(:,:) + rate(:,:, 506) = rate(:,:, 506) * m(:,:) + rate(:,:, 507) = rate(:,:, 507) * m(:,:) + rate(:,:, 508) = rate(:,:, 508) * m(:,:) + rate(:,:, 509) = rate(:,:, 509) * m(:,:) + rate(:,:, 510) = rate(:,:, 510) * m(:,:) + rate(:,:, 511) = rate(:,:, 511) * m(:,:) + rate(:,:, 512) = rate(:,:, 512) * m(:,:) + rate(:,:, 513) = rate(:,:, 513) * m(:,:) + rate(:,:, 514) = rate(:,:, 514) * m(:,:) + rate(:,:, 515) = rate(:,:, 515) * m(:,:) + rate(:,:, 516) = rate(:,:, 516) * m(:,:) + rate(:,:, 517) = rate(:,:, 517) * m(:,:) + rate(:,:, 518) = rate(:,:, 518) * m(:,:) + rate(:,:, 519) = rate(:,:, 519) * m(:,:) + rate(:,:, 534) = rate(:,:, 534) * m(:,:) + rate(:,:, 535) = rate(:,:, 535) * m(:,:) + rate(:,:, 536) = rate(:,:, 536) * m(:,:) + rate(:,:, 537) = rate(:,:, 537) * m(:,:) + rate(:,:, 538) = rate(:,:, 538) * m(:,:) + rate(:,:, 539) = rate(:,:, 539) * m(:,:) + rate(:,:, 540) = rate(:,:, 540) * m(:,:) + rate(:,:, 541) = rate(:,:, 541) * m(:,:) + rate(:,:, 542) = rate(:,:, 542) * m(:,:) + rate(:,:, 543) = rate(:,:, 543) * m(:,:) + rate(:,:, 544) = rate(:,:, 544) * m(:,:) + rate(:,:, 545) = rate(:,:, 545) * m(:,:) + rate(:,:, 546) = rate(:,:, 546) * m(:,:) + rate(:,:, 547) = rate(:,:, 547) * m(:,:) + rate(:,:, 548) = rate(:,:, 548) * m(:,:) + rate(:,:, 549) = rate(:,:, 549) * m(:,:) + rate(:,:, 550) = rate(:,:, 550) * m(:,:) + rate(:,:, 551) = rate(:,:, 551) * m(:,:) + rate(:,:, 552) = rate(:,:, 552) * m(:,:) + rate(:,:, 553) = rate(:,:, 553) * m(:,:) + rate(:,:, 554) = rate(:,:, 554) * m(:,:) + rate(:,:, 555) = rate(:,:, 555) * m(:,:) + rate(:,:, 556) = rate(:,:, 556) * m(:,:) + rate(:,:, 557) = rate(:,:, 557) * m(:,:) + rate(:,:, 558) = rate(:,:, 558) * m(:,:) + rate(:,:, 559) = rate(:,:, 559) * m(:,:) + rate(:,:, 560) = rate(:,:, 560) * m(:,:) + rate(:,:, 561) = rate(:,:, 561) * m(:,:) + rate(:,:, 563) = rate(:,:, 563) * m(:,:) + rate(:,:, 568) = rate(:,:, 568) * m(:,:) + rate(:,:, 569) = rate(:,:, 569) * m(:,:) + rate(:,:, 570) = rate(:,:, 570) * m(:,:) + rate(:,:, 573) = rate(:,:, 573) * m(:,:) + rate(:,:, 574) = rate(:,:, 574) * m(:,:) + rate(:,:, 575) = rate(:,:, 575) * m(:,:) + rate(:,:, 578) = rate(:,:, 578) * m(:,:) + rate(:,:, 579) = rate(:,:, 579) * m(:,:) + rate(:,:, 580) = rate(:,:, 580) * m(:,:) + rate(:,:, 581) = rate(:,:, 581) * m(:,:) + rate(:,:, 582) = rate(:,:, 582) * m(:,:) + rate(:,:, 583) = rate(:,:, 583) * m(:,:) + rate(:,:, 584) = rate(:,:, 584) * m(:,:) + rate(:,:, 585) = rate(:,:, 585) * m(:,:) + rate(:,:, 586) = rate(:,:, 586) * m(:,:) + rate(:,:, 587) = rate(:,:, 587) * m(:,:) + rate(:,:, 588) = rate(:,:, 588) * m(:,:) + rate(:,:, 590) = rate(:,:, 590) * m(:,:) + rate(:,:, 591) = rate(:,:, 591) * m(:,:) + rate(:,:, 593) = rate(:,:, 593) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/mo_exp_sol.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/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_waccm_tsmlt_mam5/mo_imp_sol.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/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_waccm_tsmlt_mam5/mo_indprd.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/mo_indprd.F90 new file mode 100644 index 0000000000..8478ca4bad --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/mo_indprd.F90 @@ -0,0 +1,276 @@ + 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(:,519)*y(:,228)*y(:,120) +rxt(:,528)*y(:,121) + prod(:,2) = (rxt(:,452)*y(:,202) +rxt(:,455)*y(:,214) +rxt(:,458)*y(:,216) + & + rxt(:,462)*y(:,143))*y(:,125) +.500_r8*rxt(:,391)*y(:,228)*y(:,109) & + +.200_r8*rxt(:,487)*y(:,223)*y(:,124) +.500_r8*rxt(:,499)*y(:,180) & + *y(:,126) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,155) = 0._r8 + prod(:,159) = 0._r8 + prod(:,1) = + extfrc(:,18) + prod(:,2) = 0._r8 + prod(:,3) = + extfrc(:,14) + prod(:,188) = 0._r8 + prod(:,71) = 0._r8 + prod(:,122) = 0._r8 + prod(:,72) = 0._r8 + prod(:,116) = 0._r8 + prod(:,130) = 0._r8 + prod(:,98) = 0._r8 + prod(:,149) = 0._r8 + prod(:,108) = 0._r8 + prod(:,85) = 0._r8 + prod(:,113) = 0._r8 + prod(:,221) = 0._r8 + prod(:,86) = 0._r8 + prod(:,223) = 0._r8 + prod(:,145) = 0._r8 + prod(:,4) = 0._r8 + prod(:,88) = 0._r8 + prod(:,111) = 0._r8 + prod(:,100) = 0._r8 + prod(:,143) = 0._r8 + prod(:,95) = 0._r8 + prod(:,112) = 0._r8 + prod(:,102) = 0._r8 + prod(:,199) = 0._r8 + prod(:,121) = 0._r8 + prod(:,103) = 0._r8 + prod(:,96) = 0._r8 + prod(:,56) = 0._r8 + prod(:,67) = 0._r8 + prod(:,68) = 0._r8 + prod(:,59) = 0._r8 + prod(:,69) = 0._r8 + prod(:,60) = 0._r8 + prod(:,70) = 0._r8 + prod(:,61) = 0._r8 + prod(:,133) = 0._r8 + prod(:,229) = 0._r8 + prod(:,150) = 0._r8 + prod(:,62) = 0._r8 + prod(:,200) = 0._r8 + prod(:,115) = 0._r8 + prod(:,57) = 0._r8 + prod(:,195) = 0._r8 + prod(:,210) = 0._r8 + prod(:,161) = 0._r8 + prod(:,152) = 0._r8 + prod(:,173) = 0._r8 + prod(:,128) = 0._r8 + prod(:,236) = 0._r8 + prod(:,117) = 0._r8 + prod(:,234) = 0._r8 + prod(:,74) = 0._r8 + prod(:,54) = 0._r8 + prod(:,224) = 0._r8 + prod(:,187) = 0._r8 + prod(:,5) = 0._r8 + prod(:,201) = + extfrc(:,1) + prod(:,217) = 0._r8 + prod(:,89) = 0._r8 + prod(:,91) = 0._r8 + prod(:,79) = 0._r8 + prod(:,104) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,9) = 0._r8 + prod(:,63) = 0._r8 + prod(:,184) = 0._r8 + prod(:,202) = 0._r8 + prod(:,192) = 0._r8 + prod(:,233) = 0._r8 + prod(:,218) = 0._r8 + prod(:,58) = 0._r8 + prod(:,147) = 0._r8 + prod(:,64) = 0._r8 + prod(:,174) = 0._r8 + prod(:,90) = 0._r8 + prod(:,92) = 0._r8 + prod(:,101) = 0._r8 + prod(:,220) = 0._r8 + prod(:,77) = 0._r8 + prod(:,183) = 0._r8 + prod(:,99) = 0._r8 + prod(:,231) = 0._r8 + prod(:,237) = 0._r8 + prod(:,132) = 0._r8 + prod(:,169) = 0._r8 + prod(:,175) = 0._r8 + prod(:,204) = 0._r8 + prod(:,84) = 0._r8 + prod(:,205) = 0._r8 + prod(:,107) = 0._r8 + prod(:,65) = 0._r8 + prod(:,179) = 0._r8 + prod(:,148) = 0._r8 + prod(:,144) = 0._r8 + prod(:,120) = 0._r8 + prod(:,162) = 0._r8 + prod(:,50) = 0._r8 + prod(:,209) = 0._r8 + prod(:,105) = 0._r8 + prod(:,138) = 0._r8 + prod(:,106) = 0._r8 + prod(:,151) = 0._r8 + prod(:,190) = 0._r8 + prod(:,214) = 0._r8 + prod(:,189) = (.800_r8*rxt(:,112) +rxt(:,115) +rxt(:,116) + & + .800_r8*rxt(:,118)) + extfrc(:,19) + prod(:,93) = 0._r8 + prod(:,97) = 0._r8 + prod(:,124) = 0._r8 + prod(:,196) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,55) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) = 0._r8 + prod(:,227) = + extfrc(:,5) + prod(:,228) = + extfrc(:,4) + prod(:,225) = 0._r8 + prod(:,180) = 0._r8 + prod(:,118) = 0._r8 + prod(:,16) = + extfrc(:,6) + prod(:,17) = + extfrc(:,7) + prod(:,18) = 0._r8 + prod(:,19) = + extfrc(:,12) + prod(:,20) = + extfrc(:,10) + prod(:,232) = 0._r8 + prod(:,222) = 0._r8 + prod(:,235) = 0._r8 + prod(:,21) = 0._r8 + prod(:,109) = 0._r8 + prod(:,114) = 0._r8 + prod(:,87) = 0._r8 + prod(:,141) = 0._r8 + prod(:,66) = 0._r8 + prod(:,131) = 0._r8 + prod(:,73) = 0._r8 + prod(:,110) = 0._r8 + prod(:,22) = 0._r8 + prod(:,23) = + extfrc(:,13) + prod(:,142) = 0._r8 + prod(:,119) = 0._r8 + prod(:,163) = 0._r8 + prod(:,24) = 0._r8 + prod(:,219) = 0._r8 + prod(:,186) = + extfrc(:,3) + prod(:,94) = 0._r8 + prod(:,25) = + extfrc(:,8) + prod(:,26) = + extfrc(:,9) + prod(:,27) = 0._r8 + prod(:,28) = + extfrc(:,11) + prod(:,29) = 0._r8 + prod(:,30) = 0._r8 + prod(:,31) = 0._r8 + prod(:,32) = 0._r8 + prod(:,33) = 0._r8 + prod(:,34) = 0._r8 + prod(:,35) = 0._r8 + prod(:,36) = 0._r8 + prod(:,37) = 0._r8 + prod(:,38) = 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(:,45) = + extfrc(:,2) + prod(:,80) = 0._r8 + prod(:,156) = 0._r8 + prod(:,153) = 0._r8 + prod(:,134) = 0._r8 + prod(:,194) = 0._r8 + prod(:,198) = 0._r8 + prod(:,157) = 0._r8 + prod(:,78) = 0._r8 + prod(:,81) = 0._r8 + prod(:,82) = 0._r8 + prod(:,164) = 0._r8 + prod(:,83) = 0._r8 + prod(:,123) = 0._r8 + prod(:,139) = 0._r8 + prod(:,191) = 0._r8 + prod(:,46) = 0._r8 + prod(:,135) = 0._r8 + prod(:,47) = 0._r8 + prod(:,125) = 0._r8 + prod(:,181) = 0._r8 + prod(:,185) = 0._r8 + prod(:,154) = 0._r8 + prod(:,216) = 0._r8 + prod(:,238) = 0._r8 + prod(:,168) = 0._r8 + prod(:,178) = (rxt(:,113) +rxt(:,114) +rxt(:,115) +rxt(:,116) +rxt(:,117) + & + rxt(:,119)) + extfrc(:,22) + prod(:,146) = 0._r8 + prod(:,129) = 0._r8 + prod(:,170) = 0._r8 + prod(:,126) = 0._r8 + prod(:,211) = 0._r8 + prod(:,212) = 0._r8 + prod(:,208) = 0._r8 + prod(:,48) = 0._r8 + prod(:,49) = 0._r8 + prod(:,213) = 0._r8 + prod(:,165) = 0._r8 + prod(:,215) = 0._r8 + prod(:,182) = 0._r8 + prod(:,160) = 0._r8 + prod(:,51) = 0._r8 + prod(:,140) = (1.200_r8*rxt(:,112) +rxt(:,113) +rxt(:,117) + & + 1.200_r8*rxt(:,118)) + extfrc(:,17) + prod(:,158) = (rxt(:,114) +rxt(:,119)) + extfrc(:,16) + prod(:,176) = 0._r8 + prod(:,136) = (rxt(:,113) +rxt(:,115) +rxt(:,116) +rxt(:,117)) + prod(:,197) = 0._r8 + prod(:,230) = 0._r8 + prod(:,75) = 0._r8 + prod(:,76) = 0._r8 + prod(:,177) = + extfrc(:,15) + prod(:,226) = + extfrc(:,20) + prod(:,171) = + extfrc(:,21) + prod(:,127) = 0._r8 + prod(:,172) = 0._r8 + prod(:,206) = 0._r8 + prod(:,203) = 0._r8 + prod(:,193) = 0._r8 + prod(:,166) = 0._r8 + prod(:,52) = 0._r8 + prod(:,207) = 0._r8 + prod(:,167) = 0._r8 + prod(:,53) = 0._r8 + prod(:,137) = 0._r8 + prod(:,239) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/mo_lin_matrix.F90 new file mode 100644 index 0000000000..8741e8c3e9 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/mo_lin_matrix.F90 @@ -0,0 +1,687 @@ + 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,642) = -( rxt(k,20) + het_rates(k,1) ) + mat(k,687) = -( rxt(k,21) + het_rates(k,2) ) + mat(k,1) = -( het_rates(k,3) ) + mat(k,2) = -( het_rates(k,4) ) + mat(k,3) = -( het_rates(k,5) ) + mat(k,974) = -( het_rates(k,6) ) + mat(k,160) = -( het_rates(k,7) ) + mat(k,415) = -( rxt(k,22) + het_rates(k,8) ) + mat(k,166) = -( rxt(k,23) + het_rates(k,9) ) + mat(k,379) = -( rxt(k,24) + het_rates(k,10) ) + mat(k,465) = -( rxt(k,25) + het_rates(k,11) ) + mat(k,416) = .500_r8*rxt(k,22) + mat(k,167) = rxt(k,23) + mat(k,663) = .200_r8*rxt(k,71) + mat(k,727) = .060_r8*rxt(k,73) + mat(k,279) = -( rxt(k,26) + het_rates(k,12) ) + mat(k,662) = .200_r8*rxt(k,71) + mat(k,725) = .200_r8*rxt(k,73) + mat(k,598) = -( rxt(k,27) + het_rates(k,13) ) + mat(k,222) = rxt(k,47) + mat(k,1086) = rxt(k,57) + mat(k,664) = .200_r8*rxt(k,71) + mat(k,728) = .150_r8*rxt(k,73) + mat(k,329) = -( rxt(k,28) + het_rates(k,14) ) + mat(k,726) = .210_r8*rxt(k,73) + mat(k,226) = -( het_rates(k,15) ) + mat(k,355) = -( het_rates(k,16) ) + mat(k,1511) = -( het_rates(k,17) ) + mat(k,230) = rxt(k,75) + mat(k,1563) = rxt(k,76) + mat(k,568) = rxt(k,78) + mat(k,141) = rxt(k,80) + mat(k,147) = rxt(k,81) + mat(k,481) = 2.000_r8*rxt(k,87) + mat(k,604) = rxt(k,88) + mat(k,387) = 3.000_r8*rxt(k,91) + mat(k,109) = 2.000_r8*rxt(k,99) + mat(k,829) = rxt(k,100) + mat(k,789) = rxt(k,106) + mat(k,229) = -( rxt(k,75) + het_rates(k,18) ) + mat(k,1565) = -( rxt(k,76) + het_rates(k,19) ) + mat(k,569) = rxt(k,77) + mat(k,566) = -( rxt(k,77) + rxt(k,78) + rxt(k,564) + rxt(k,567) + rxt(k,572) & + + het_rates(k,20) ) + mat(k,4) = -( het_rates(k,21) ) + mat(k,235) = -( het_rates(k,22) ) + mat(k,344) = rxt(k,29) + mat(k,345) = -( rxt(k,29) + het_rates(k,23) ) + mat(k,285) = -( het_rates(k,24) ) + mat(k,550) = -( het_rates(k,25) ) + mat(k,265) = -( het_rates(k,26) ) + mat(k,350) = -( rxt(k,30) + het_rates(k,27) ) + mat(k,298) = -( het_rates(k,28) ) + mat(k,1133) = -( het_rates(k,29) ) + mat(k,1370) = .700_r8*rxt(k,56) + mat(k,409) = -( rxt(k,31) + het_rates(k,30) ) + mat(k,304) = -( het_rates(k,31) ) + mat(k,269) = -( rxt(k,32) + het_rates(k,32) ) + mat(k,101) = -( rxt(k,79) + het_rates(k,33) ) + mat(k,139) = -( rxt(k,80) + het_rates(k,34) ) + mat(k,144) = -( rxt(k,81) + het_rates(k,35) ) + mat(k,111) = -( rxt(k,82) + het_rates(k,36) ) + mat(k,149) = -( rxt(k,83) + het_rates(k,37) ) + mat(k,115) = -( rxt(k,84) + het_rates(k,38) ) + mat(k,154) = -( rxt(k,85) + het_rates(k,39) ) + mat(k,119) = -( rxt(k,86) + het_rates(k,40) ) + mat(k,479) = -( rxt(k,87) + het_rates(k,41) ) + mat(k,1987) = -( rxt(k,33) + rxt(k,34) + het_rates(k,42) ) + mat(k,650) = .100_r8*rxt(k,20) + mat(k,695) = .100_r8*rxt(k,21) + mat(k,456) = rxt(k,39) + mat(k,2252) = .180_r8*rxt(k,40) + mat(k,1169) = rxt(k,44) + mat(k,1203) = .330_r8*rxt(k,46) + mat(k,1212) = rxt(k,48) + mat(k,716) = rxt(k,50) + mat(k,1276) = 1.340_r8*rxt(k,51) + mat(k,897) = rxt(k,58) + mat(k,547) = rxt(k,63) + mat(k,401) = rxt(k,64) + mat(k,660) = .375_r8*rxt(k,66) + mat(k,491) = .400_r8*rxt(k,68) + mat(k,1125) = .680_r8*rxt(k,70) + mat(k,445) = rxt(k,308) + mat(k,463) = 2.000_r8*rxt(k,338) + mat(k,602) = -( rxt(k,88) + het_rates(k,43) ) + mat(k,123) = -( rxt(k,89) + het_rates(k,44) ) + mat(k,1151) = -( rxt(k,35) + het_rates(k,45) ) + mat(k,646) = .400_r8*rxt(k,20) + mat(k,692) = .400_r8*rxt(k,21) + mat(k,352) = rxt(k,30) + mat(k,1192) = .330_r8*rxt(k,46) + mat(k,323) = rxt(k,54) + mat(k,544) = rxt(k,63) + mat(k,371) = -( rxt(k,90) + het_rates(k,46) ) + mat(k,104) = -( het_rates(k,47) ) + mat(k,1080) = -( rxt(k,36) + het_rates(k,48) ) + mat(k,645) = .250_r8*rxt(k,20) + mat(k,691) = .250_r8*rxt(k,21) + mat(k,411) = .820_r8*rxt(k,31) + mat(k,1191) = .170_r8*rxt(k,46) + mat(k,653) = .300_r8*rxt(k,66) + mat(k,489) = .050_r8*rxt(k,68) + mat(k,1118) = .500_r8*rxt(k,70) + mat(k,1281) = -( rxt(k,37) + het_rates(k,49) ) + mat(k,382) = .180_r8*rxt(k,24) + mat(k,331) = rxt(k,28) + mat(k,672) = .400_r8*rxt(k,71) + mat(k,736) = .540_r8*rxt(k,73) + mat(k,424) = .510_r8*rxt(k,74) + mat(k,705) = -( het_rates(k,50) ) + mat(k,620) = -( rxt(k,38) + het_rates(k,51) ) + mat(k,824) = -( het_rates(k,52) ) + mat(k,454) = -( rxt(k,39) + het_rates(k,53) ) + mat(k,2259) = -( rxt(k,40) + rxt(k,41) + het_rates(k,54) ) + mat(k,385) = -( rxt(k,91) + het_rates(k,55) ) + mat(k,2168) = -( het_rates(k,56) ) + mat(k,231) = rxt(k,75) + mat(k,103) = 4.000_r8*rxt(k,79) + mat(k,143) = rxt(k,80) + mat(k,114) = 2.000_r8*rxt(k,82) + mat(k,153) = 2.000_r8*rxt(k,83) + mat(k,118) = 2.000_r8*rxt(k,84) + mat(k,158) = rxt(k,85) + mat(k,122) = 2.000_r8*rxt(k,86) + mat(k,125) = 3.000_r8*rxt(k,89) + mat(k,375) = rxt(k,90) + mat(k,176) = 2.000_r8*rxt(k,92) + mat(k,97) = 2.000_r8*rxt(k,93) + mat(k,1602) = rxt(k,94) + mat(k,963) = rxt(k,95) + mat(k,249) = rxt(k,98) + mat(k,245) = rxt(k,101) + mat(k,255) = rxt(k,102) + mat(k,296) = rxt(k,103) + mat(k,1506) = rxt(k,104) + mat(k,842) = rxt(k,107) + mat(k,175) = -( rxt(k,92) + het_rates(k,57) ) + mat(k,95) = -( rxt(k,93) + rxt(k,249) + het_rates(k,58) ) + mat(k,1592) = -( rxt(k,94) + het_rates(k,59) ) + mat(k,957) = rxt(k,96) + mat(k,337) = rxt(k,108) + mat(k,96) = 2.000_r8*rxt(k,249) + mat(k,955) = -( rxt(k,95) + rxt(k,96) + rxt(k,566) + rxt(k,571) + rxt(k,577) & + + het_rates(k,60) ) + mat(k,5) = -( het_rates(k,61) ) + mat(k,1160) = -( het_rates(k,62) ) + mat(k,168) = 1.500_r8*rxt(k,23) + mat(k,381) = .450_r8*rxt(k,24) + mat(k,600) = .600_r8*rxt(k,27) + mat(k,330) = rxt(k,28) + mat(k,1975) = rxt(k,33) + rxt(k,34) + mat(k,1152) = rxt(k,35) + mat(k,1280) = rxt(k,37) + mat(k,2240) = .380_r8*rxt(k,40) + mat(k,1449) = rxt(k,42) + rxt(k,110) + mat(k,1165) = rxt(k,44) + mat(k,1055) = 2.000_r8*rxt(k,45) + mat(k,1193) = .330_r8*rxt(k,46) + mat(k,1268) = 1.340_r8*rxt(k,52) + mat(k,1372) = .700_r8*rxt(k,56) + mat(k,200) = 1.500_r8*rxt(k,65) + mat(k,655) = .250_r8*rxt(k,66) + mat(k,1075) = rxt(k,69) + mat(k,1120) = 1.700_r8*rxt(k,70) + mat(k,366) = rxt(k,137) + mat(k,1450) = -( rxt(k,42) + rxt(k,110) + het_rates(k,63) ) + mat(k,622) = rxt(k,38) + mat(k,2241) = .440_r8*rxt(k,40) + mat(k,536) = .400_r8*rxt(k,61) + mat(k,658) = rxt(k,66) + mat(k,1123) = .800_r8*rxt(k,70) + mat(k,238) = -( rxt(k,97) + het_rates(k,64) ) + mat(k,140) = rxt(k,80) + mat(k,145) = rxt(k,81) + mat(k,150) = rxt(k,83) + mat(k,116) = 2.000_r8*rxt(k,84) + mat(k,155) = 2.000_r8*rxt(k,85) + mat(k,120) = rxt(k,86) + mat(k,108) = 2.000_r8*rxt(k,99) + mat(k,250) = rxt(k,102) + mat(k,291) = rxt(k,103) + mat(k,246) = -( rxt(k,98) + het_rates(k,65) ) + mat(k,112) = rxt(k,82) + mat(k,151) = rxt(k,83) + mat(k,242) = rxt(k,101) + mat(k,194) = -( het_rates(k,66) ) + mat(k,310) = -( het_rates(k,67) ) + mat(k,6) = -( het_rates(k,68) ) + mat(k,7) = -( het_rates(k,69) ) + mat(k,8) = -( het_rates(k,70) ) + mat(k,9) = -( rxt(k,594) + het_rates(k,71) ) + mat(k,127) = -( rxt(k,43) + het_rates(k,72) ) + mat(k,925) = -( het_rates(k,73) ) + mat(k,146) = rxt(k,81) + mat(k,156) = rxt(k,85) + mat(k,239) = 2.000_r8*rxt(k,97) + mat(k,247) = rxt(k,98) + mat(k,283) = rxt(k,105) + mat(k,1166) = -( rxt(k,44) + het_rates(k,74) ) + mat(k,1194) = .330_r8*rxt(k,46) + mat(k,656) = .250_r8*rxt(k,66) + 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,1054) = -( rxt(k,45) + rxt(k,520) + het_rates(k,75) ) + mat(k,418) = rxt(k,22) + mat(k,380) = .130_r8*rxt(k,24) + mat(k,341) = .700_r8*rxt(k,62) + mat(k,670) = .600_r8*rxt(k,71) + mat(k,734) = .340_r8*rxt(k,73) + mat(k,423) = .170_r8*rxt(k,74) + mat(k,2121) = -( het_rates(k,76) ) + mat(k,2443) = 2.000_r8*rxt(k,2) + rxt(k,3) + mat(k,1991) = 2.000_r8*rxt(k,34) + mat(k,457) = rxt(k,39) + mat(k,2256) = .330_r8*rxt(k,40) + rxt(k,41) + mat(k,834) = rxt(k,100) + mat(k,1505) = rxt(k,104) + mat(k,284) = rxt(k,105) + mat(k,1461) = -( het_rates(k,77) ) + mat(k,2428) = rxt(k,1) + mat(k,1977) = rxt(k,33) + mat(k,2242) = 1.440_r8*rxt(k,40) + mat(k,107) = -( rxt(k,99) + het_rates(k,78) ) + mat(k,582) = -( rxt(k,4) + het_rates(k,79) ) + mat(k,130) = -( rxt(k,136) + het_rates(k,80) ) + mat(k,828) = -( rxt(k,100) + het_rates(k,81) ) + mat(k,241) = -( rxt(k,101) + het_rates(k,82) ) + mat(k,251) = -( rxt(k,102) + het_rates(k,83) ) + mat(k,292) = -( rxt(k,103) + het_rates(k,84) ) + mat(k,1495) = -( rxt(k,104) + het_rates(k,85) ) + mat(k,182) = -( het_rates(k,86) ) + mat(k,919) = -( het_rates(k,87) ) + mat(k,282) = -( rxt(k,105) + het_rates(k,88) ) + mat(k,2055) = -( rxt(k,9) + het_rates(k,89) ) + mat(k,1204) = rxt(k,522) + mat(k,596) = rxt(k,523) + mat(k,564) = rxt(k,524) + mat(k,277) = 2.000_r8*rxt(k,525) + 2.000_r8*rxt(k,562) + 2.000_r8*rxt(k,565) & + + 2.000_r8*rxt(k,576) + mat(k,431) = rxt(k,526) + mat(k,1099) = rxt(k,527) + mat(k,1963) = .500_r8*rxt(k,529) + mat(k,1658) = rxt(k,530) + mat(k,396) = rxt(k,531) + mat(k,234) = rxt(k,532) + mat(k,631) = rxt(k,533) + mat(k,572) = rxt(k,564) + rxt(k,567) + rxt(k,572) + mat(k,961) = rxt(k,566) + rxt(k,571) + rxt(k,577) + mat(k,2368) = -( rxt(k,521) + het_rates(k,90) ) + mat(k,477) = rxt(k,11) + rxt(k,212) + mat(k,651) = rxt(k,20) + mat(k,696) = .900_r8*rxt(k,21) + mat(k,420) = rxt(k,22) + mat(k,169) = 1.500_r8*rxt(k,23) + mat(k,384) = .560_r8*rxt(k,24) + mat(k,467) = rxt(k,25) + mat(k,281) = .600_r8*rxt(k,26) + mat(k,601) = .600_r8*rxt(k,27) + mat(k,333) = rxt(k,28) + mat(k,349) = rxt(k,29) + mat(k,354) = rxt(k,30) + mat(k,413) = rxt(k,31) + mat(k,1157) = rxt(k,35) + mat(k,1287) = rxt(k,37) + mat(k,1170) = 2.000_r8*rxt(k,44) + mat(k,1058) = 2.000_r8*rxt(k,45) + mat(k,1205) = .670_r8*rxt(k,46) + mat(k,225) = rxt(k,47) + mat(k,1213) = rxt(k,48) + mat(k,408) = rxt(k,49) + mat(k,717) = rxt(k,50) + mat(k,1278) = 1.340_r8*rxt(k,51) + .660_r8*rxt(k,52) + mat(k,1100) = rxt(k,57) + mat(k,343) = rxt(k,62) + mat(k,548) = rxt(k,63) + mat(k,202) = rxt(k,65) + mat(k,661) = rxt(k,66) + mat(k,632) = rxt(k,67) + mat(k,492) = rxt(k,68) + mat(k,1079) = rxt(k,69) + mat(k,1126) = 1.200_r8*rxt(k,70) + mat(k,674) = rxt(k,71) + mat(k,739) = rxt(k,73) + mat(k,426) = rxt(k,74) + mat(k,446) = rxt(k,308) + mat(k,464) = rxt(k,338) + mat(k,1345) = rxt(k,413) + mat(k,472) = -( rxt(k,10) + rxt(k,11) + rxt(k,212) + het_rates(k,91) ) + mat(k,787) = -( rxt(k,106) + het_rates(k,92) ) + mat(k,567) = rxt(k,564) + rxt(k,567) + rxt(k,572) + mat(k,837) = -( rxt(k,107) + het_rates(k,93) ) + mat(k,954) = rxt(k,566) + rxt(k,571) + rxt(k,577) + mat(k,1195) = -( rxt(k,46) + rxt(k,522) + het_rates(k,94) ) + mat(k,221) = -( rxt(k,47) + het_rates(k,95) ) + mat(k,1315) = rxt(k,413) + mat(k,1208) = -( rxt(k,48) + het_rates(k,96) ) + mat(k,1196) = .170_r8*rxt(k,46) + mat(k,326) = -( het_rates(k,97) ) + mat(k,133) = -( het_rates(k,98) ) + mat(k,876) = -( het_rates(k,99) ) + mat(k,589) = -( rxt(k,523) + het_rates(k,100) ) + mat(k,558) = -( rxt(k,524) + het_rates(k,101) ) + mat(k,403) = -( rxt(k,49) + het_rates(k,102) ) + mat(k,711) = -( rxt(k,50) + het_rates(k,103) ) + mat(k,404) = rxt(k,49) + mat(k,76) = -( het_rates(k,104) ) + mat(k,1269) = -( rxt(k,51) + rxt(k,52) + het_rates(k,105) ) + mat(k,713) = .300_r8*rxt(k,50) + mat(k,316) = -( het_rates(k,106) ) + mat(k,517) = -( rxt(k,53) + het_rates(k,107) ) + mat(k,641) = .800_r8*rxt(k,20) + mat(k,686) = .800_r8*rxt(k,21) + mat(k,321) = -( rxt(k,54) + het_rates(k,108) ) + mat(k,611) = -( rxt(k,55) + rxt(k,395) + het_rates(k,109) ) + mat(k,1018) = -( het_rates(k,110) ) + mat(k,1376) = -( rxt(k,56) + het_rates(k,111) ) + mat(k,714) = .700_r8*rxt(k,50) + mat(k,999) = -( rxt(k,111) + het_rates(k,112) ) + mat(k,1881) = rxt(k,15) + mat(k,808) = rxt(k,592) + mat(k,256) = -( rxt(k,12) + het_rates(k,113) ) + mat(k,273) = -( rxt(k,13) + rxt(k,14) + rxt(k,213) + rxt(k,525) + rxt(k,562) & + + rxt(k,565) + rxt(k,576) + het_rates(k,114) ) + mat(k,427) = -( rxt(k,526) + het_rates(k,115) ) + mat(k,1090) = -( rxt(k,57) + rxt(k,527) + het_rates(k,116) ) + mat(k,10) = -( het_rates(k,117) ) + mat(k,11) = -( het_rates(k,118) ) + mat(k,12) = -( het_rates(k,119) ) + mat(k,98) = -( het_rates(k,120) ) + mat(k,13) = -( rxt(k,528) + het_rates(k,121) ) + mat(k,14) = -( rxt(k,596) + het_rates(k,122) ) + mat(k,15) = -( rxt(k,595) + het_rates(k,123) ) + mat(k,1914) = -( rxt(k,15) + rxt(k,16) + het_rates(k,124) ) + mat(k,275) = rxt(k,14) + mat(k,1959) = rxt(k,17) + .500_r8*rxt(k,529) + mat(k,1654) = rxt(k,19) + mat(k,857) = rxt(k,589) + mat(k,1960) = -( rxt(k,17) + rxt(k,529) + het_rates(k,125) ) + mat(k,2052) = rxt(k,9) + mat(k,476) = rxt(k,11) + rxt(k,212) + mat(k,276) = rxt(k,13) + rxt(k,213) + mat(k,1655) = rxt(k,18) + mat(k,649) = rxt(k,20) + mat(k,1202) = rxt(k,46) + mat(k,407) = rxt(k,49) + mat(k,617) = rxt(k,55) + rxt(k,395) + mat(k,1097) = rxt(k,57) + mat(k,896) = rxt(k,58) + mat(k,395) = rxt(k,59) + mat(k,233) = rxt(k,60) + mat(k,539) = .600_r8*rxt(k,61) + rxt(k,345) + mat(k,630) = rxt(k,67) + mat(k,571) = rxt(k,77) + mat(k,960) = rxt(k,96) + mat(k,138) = rxt(k,470) + mat(k,1652) = -( rxt(k,18) + rxt(k,19) + rxt(k,530) + het_rates(k,126) ) + mat(k,474) = rxt(k,10) + mat(k,274) = rxt(k,13) + rxt(k,14) + rxt(k,213) + mat(k,537) = .400_r8*rxt(k,61) + mat(k,570) = rxt(k,78) + mat(k,958) = rxt(k,95) + mat(k,892) = -( rxt(k,58) + het_rates(k,127) ) + mat(k,391) = -( rxt(k,59) + rxt(k,531) + het_rates(k,128) ) + mat(k,16) = -( het_rates(k,129) ) + mat(k,17) = -( het_rates(k,130) ) + mat(k,18) = -( het_rates(k,131) ) + mat(k,19) = -( het_rates(k,132) ) + mat(k,20) = -( het_rates(k,133) ) + mat(k,2099) = -( rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + + rxt(k,125) + het_rates(k,134) ) + mat(k,2442) = rxt(k,2) + mat(k,1550) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,127) + rxt(k,128) + rxt(k,129) & + + rxt(k,131) + rxt(k,132) + rxt(k,133) + 2.000_r8*rxt(k,134) & + + 2.000_r8*rxt(k,135) + mat(k,2230) = rxt(k,8) + mat(k,278) = rxt(k,14) + mat(k,1919) = rxt(k,15) + mat(k,1964) = rxt(k,17) + mat(k,1659) = rxt(k,18) + mat(k,2255) = .180_r8*rxt(k,40) + mat(k,1456) = rxt(k,42) + rxt(k,110) + mat(k,1574) = rxt(k,76) + mat(k,1600) = rxt(k,94) + mat(k,338) = rxt(k,108) + mat(k,1484) = rxt(k,138) + mat(k,950) = rxt(k,139) + mat(k,263) = rxt(k,140) + mat(k,2033) = rxt(k,155) + mat(k,1542) = -( rxt(k,5) + rxt(k,6) + rxt(k,126) + rxt(k,127) + rxt(k,128) & + + rxt(k,129) + rxt(k,130) + rxt(k,131) + rxt(k,132) + rxt(k,133) & + + rxt(k,134) + rxt(k,135) + het_rates(k,135) ) + mat(k,2220) = rxt(k,8) + mat(k,1649) = rxt(k,19) + mat(k,178) = rxt(k,151) + rxt(k,159) + mat(k,181) = rxt(k,152) + mat(k,2233) = -( rxt(k,7) + rxt(k,8) + het_rates(k,136) ) + mat(k,21) = -( het_rates(k,137) ) + mat(k,334) = -( rxt(k,108) + het_rates(k,138) ) + mat(k,363) = -( rxt(k,137) + het_rates(k,139) ) + mat(k,232) = -( rxt(k,60) + rxt(k,532) + het_rates(k,140) ) + mat(k,534) = -( rxt(k,61) + rxt(k,345) + het_rates(k,141) ) + mat(k,136) = -( rxt(k,470) + het_rates(k,142) ) + mat(k,468) = -( het_rates(k,143) ) + mat(k,270) = rxt(k,32) + end do + end subroutine linmat02 + subroutine linmat03( 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,170) = -( het_rates(k,144) ) + mat(k,339) = -( rxt(k,62) + het_rates(k,145) ) + mat(k,22) = -( het_rates(k,146) ) + mat(k,23) = -( het_rates(k,147) ) + mat(k,542) = -( rxt(k,63) + het_rates(k,148) ) + mat(k,397) = -( rxt(k,64) + het_rates(k,149) ) + mat(k,718) = -( het_rates(k,150) ) + mat(k,364) = rxt(k,137) + mat(k,1474) = rxt(k,138) + mat(k,24) = -( rxt(k,109) + het_rates(k,151) ) + mat(k,1476) = -( rxt(k,138) + het_rates(k,152) ) + mat(k,948) = rxt(k,139) + mat(k,947) = -( rxt(k,139) + het_rates(k,153) ) + mat(k,262) = rxt(k,140) + mat(k,261) = -( rxt(k,140) + het_rates(k,154) ) + mat(k,131) = rxt(k,136) + mat(k,25) = -( het_rates(k,155) ) + mat(k,26) = -( het_rates(k,156) ) + mat(k,27) = -( het_rates(k,157) ) + mat(k,28) = -( het_rates(k,158) ) + mat(k,29) = -( rxt(k,141) + het_rates(k,159) ) + mat(k,30) = -( rxt(k,142) + het_rates(k,160) ) + mat(k,31) = -( rxt(k,143) + het_rates(k,161) ) + mat(k,32) = -( rxt(k,144) + het_rates(k,162) ) + mat(k,33) = -( rxt(k,145) + het_rates(k,163) ) + mat(k,34) = -( rxt(k,146) + het_rates(k,164) ) + mat(k,35) = -( rxt(k,147) + het_rates(k,165) ) + mat(k,36) = -( rxt(k,148) + het_rates(k,166) ) + mat(k,37) = -( rxt(k,149) + het_rates(k,167) ) + mat(k,38) = -( rxt(k,150) + het_rates(k,168) ) + mat(k,39) = -( het_rates(k,169) ) + mat(k,1053) = rxt(k,520) + mat(k,40) = -( het_rates(k,170) ) + mat(k,41) = -( het_rates(k,171) ) + mat(k,42) = -( het_rates(k,172) ) + mat(k,43) = -( het_rates(k,173) ) + mat(k,44) = -( rxt(k,597) + het_rates(k,174) ) + mat(k,50) = -( het_rates(k,175) ) + mat(k,199) = -( rxt(k,65) + het_rates(k,176) ) + mat(k,652) = -( rxt(k,66) + het_rates(k,177) ) + mat(k,627) = -( rxt(k,67) + rxt(k,533) + het_rates(k,178) ) + mat(k,486) = -( rxt(k,68) + het_rates(k,179) ) + mat(k,1072) = -( rxt(k,69) + het_rates(k,180) ) + mat(k,392) = rxt(k,59) + mat(k,628) = rxt(k,67) + mat(k,488) = rxt(k,68) + mat(k,1119) = -( rxt(k,70) + het_rates(k,181) ) + mat(k,654) = rxt(k,66) + mat(k,1074) = rxt(k,69) + mat(k,665) = -( rxt(k,71) + het_rates(k,182) ) + mat(k,187) = -( het_rates(k,183) ) + mat(k,203) = -( rxt(k,72) + het_rates(k,184) ) + mat(k,208) = -( het_rates(k,185) ) + mat(k,729) = -( rxt(k,73) + het_rates(k,186) ) + mat(k,216) = -( het_rates(k,187) ) + mat(k,421) = -( rxt(k,74) + het_rates(k,188) ) + mat(k,523) = -( het_rates(k,191) ) + mat(k,137) = rxt(k,470) + mat(k,1042) = -( het_rates(k,192) ) + mat(k,56) = -( het_rates(k,193) ) + mat(k,495) = -( het_rates(k,194) ) + mat(k,62) = -( het_rates(k,195) ) + mat(k,435) = -( het_rates(k,196) ) + mat(k,901) = -( het_rates(k,197) ) + mat(k,519) = rxt(k,53) + mat(k,935) = -( het_rates(k,198) ) + mat(k,635) = -( het_rates(k,199) ) + mat(k,1428) = -( het_rates(k,200) ) + mat(k,383) = .130_r8*rxt(k,24) + mat(k,332) = rxt(k,28) + mat(k,1082) = rxt(k,36) + mat(k,1282) = rxt(k,37) + mat(k,1198) = .330_r8*rxt(k,46) + mat(k,1210) = rxt(k,48) + mat(k,1273) = 1.340_r8*rxt(k,51) + mat(k,520) = rxt(k,53) + mat(k,324) = rxt(k,54) + mat(k,1378) = .300_r8*rxt(k,56) + mat(k,894) = rxt(k,58) + mat(k,535) = .600_r8*rxt(k,61) + rxt(k,345) + mat(k,399) = rxt(k,64) + mat(k,201) = .500_r8*rxt(k,65) + mat(k,1122) = .650_r8*rxt(k,70) + mat(k,2421) = -( het_rates(k,201) ) + mat(k,1158) = rxt(k,35) + mat(k,1084) = rxt(k,36) + mat(k,625) = rxt(k,38) + mat(k,2261) = rxt(k,41) + mat(k,1390) = .300_r8*rxt(k,56) + mat(k,541) = .400_r8*rxt(k,61) + mat(k,609) = rxt(k,88) + mat(k,377) = rxt(k,90) + mat(k,778) = -( het_rates(k,202) ) + mat(k,280) = .600_r8*rxt(k,26) + mat(k,865) = -( het_rates(k,203) ) + mat(k,1875) = rxt(k,16) + mat(k,998) = rxt(k,111) + mat(k,2079) = rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + + rxt(k,125) + mat(k,1534) = rxt(k,126) + rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,130) & + + rxt(k,131) + rxt(k,132) + rxt(k,133) + mat(k,574) = -( het_rates(k,204) ) + mat(k,460) = -( rxt(k,338) + het_rates(k,205) ) + mat(k,128) = rxt(k,43) + mat(k,797) = -( het_rates(k,206) ) + mat(k,441) = -( rxt(k,308) + het_rates(k,207) ) + mat(k,1299) = -( het_rates(k,208) ) + mat(k,1332) = -( rxt(k,413) + het_rates(k,209) ) + mat(k,1253) = -( het_rates(k,210) ) + mat(k,68) = -( het_rates(k,211) ) + mat(k,74) = -( het_rates(k,212) ) + mat(k,1356) = -( het_rates(k,213) ) + mat(k,740) = -( het_rates(k,214) ) + mat(k,466) = .600_r8*rxt(k,25) + mat(k,1397) = -( het_rates(k,215) ) + mat(k,1272) = .660_r8*rxt(k,51) + mat(k,613) = rxt(k,55) + rxt(k,395) + mat(k,910) = -( het_rates(k,216) ) + mat(k,599) = .600_r8*rxt(k,27) + mat(k,698) = -( het_rates(k,217) ) + mat(k,82) = -( het_rates(k,218) ) + mat(k,529) = -( het_rates(k,219) ) + mat(k,676) = -( het_rates(k,220) ) + mat(k,845) = -( het_rates(k,221) ) + mat(k,1873) = rxt(k,16) + mat(k,852) = rxt(k,589) + mat(k,806) = rxt(k,592) + mat(k,502) = -( het_rates(k,222) ) + mat(k,994) = rxt(k,111) + mat(k,1106) = -( het_rates(k,223) ) + mat(k,2031) = -( rxt(k,155) + het_rates(k,224) ) + mat(k,2440) = rxt(k,1) + mat(k,1549) = rxt(k,6) + mat(k,2228) = rxt(k,7) + mat(k,259) = rxt(k,12) + mat(k,177) = -( rxt(k,151) + rxt(k,159) + het_rates(k,225) ) + mat(k,2179) = rxt(k,7) + mat(k,179) = rxt(k,163) + mat(k,180) = -( rxt(k,152) + rxt(k,163) + het_rates(k,226) ) + mat(k,853) = -( rxt(k,589) + het_rates(k,227) ) + mat(k,1533) = rxt(k,126) + rxt(k,130) + mat(k,1818) = -( het_rates(k,228) ) + mat(k,2436) = rxt(k,3) + mat(k,584) = 2.000_r8*rxt(k,4) + mat(k,2050) = rxt(k,9) + mat(k,475) = rxt(k,10) + mat(k,694) = rxt(k,21) + mat(k,419) = rxt(k,22) + mat(k,348) = rxt(k,29) + mat(k,353) = rxt(k,30) + mat(k,412) = rxt(k,31) + mat(k,272) = rxt(k,32) + mat(k,623) = rxt(k,38) + mat(k,455) = rxt(k,39) + mat(k,2249) = .330_r8*rxt(k,40) + mat(k,129) = rxt(k,43) + mat(k,224) = rxt(k,47) + mat(k,715) = rxt(k,50) + mat(k,325) = rxt(k,54) + mat(k,394) = rxt(k,59) + mat(k,342) = rxt(k,62) + mat(k,546) = rxt(k,63) + mat(k,400) = rxt(k,64) + mat(k,659) = rxt(k,66) + mat(k,490) = rxt(k,68) + mat(k,673) = rxt(k,71) + mat(k,205) = rxt(k,72) + mat(k,738) = rxt(k,73) + mat(k,425) = rxt(k,74) + mat(k,791) = rxt(k,106) + mat(k,840) = rxt(k,107) + mat(k,1958) = .500_r8*rxt(k,529) + mat(k,805) = -( rxt(k,592) + het_rates(k,229) ) + mat(k,2074) = rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + + rxt(k,125) + mat(k,1531) = rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,131) + rxt(k,132) & + + rxt(k,133) + mat(k,448) = -( het_rates(k,230) ) + mat(k,814) = -( het_rates(k,231) ) + mat(k,1217) = -( het_rates(k,232) ) + mat(k,1121) = .150_r8*rxt(k,70) + mat(k,1178) = -( het_rates(k,233) ) + mat(k,1062) = -( het_rates(k,234) ) + mat(k,751) = -( het_rates(k,235) ) + mat(k,88) = -( het_rates(k,236) ) + mat(k,1233) = -( het_rates(k,237) ) + mat(k,767) = -( het_rates(k,238) ) + mat(k,94) = -( het_rates(k,239) ) + mat(k,510) = -( het_rates(k,240) ) + mat(k,2449) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,241) ) + mat(k,2262) = .050_r8*rxt(k,40) + mat(k,132) = rxt(k,136) + mat(k,2370) = rxt(k,521) + end do + end subroutine linmat03 + 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 ) + call linmat03( avec_len, mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/mo_lu_factor.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/mo_lu_factor.F90 new file mode 100644 index 0000000000..25fbdd405b --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/mo_lu_factor.F90 @@ -0,0 +1,8890 @@ + 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) = 1._r8 / lu(k,10) + 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) = 1._r8 / lu(k,33) + 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) = 1._r8 / lu(k,37) + lu(k,38) = 1._r8 / lu(k,38) + lu(k,39) = 1._r8 / lu(k,39) + lu(k,40) = 1._r8 / lu(k,40) + lu(k,41) = 1._r8 / lu(k,41) + lu(k,42) = 1._r8 / lu(k,42) + lu(k,43) = 1._r8 / lu(k,43) + lu(k,44) = 1._r8 / lu(k,44) + lu(k,50) = 1._r8 / lu(k,50) + lu(k,56) = 1._r8 / lu(k,56) + lu(k,62) = 1._r8 / lu(k,62) + lu(k,68) = 1._r8 / lu(k,68) + lu(k,74) = 1._r8 / lu(k,74) + lu(k,76) = 1._r8 / lu(k,76) + lu(k,82) = 1._r8 / lu(k,82) + 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,88) = 1._r8 / lu(k,88) + lu(k,94) = 1._r8 / lu(k,94) + lu(k,95) = 1._r8 / lu(k,95) + lu(k,96) = lu(k,96) * lu(k,95) + lu(k,97) = lu(k,97) * lu(k,95) + lu(k,1592) = lu(k,1592) - lu(k,96) * lu(k,1580) + lu(k,1602) = lu(k,1602) - lu(k,97) * lu(k,1580) + lu(k,98) = 1._r8 / lu(k,98) + lu(k,99) = lu(k,99) * lu(k,98) + lu(k,100) = lu(k,100) * lu(k,98) + lu(k,1818) = lu(k,1818) - lu(k,99) * lu(k,1681) + lu(k,1831) = lu(k,1831) - lu(k,100) * lu(k,1681) + lu(k,101) = 1._r8 / lu(k,101) + lu(k,102) = lu(k,102) * lu(k,101) + lu(k,103) = lu(k,103) * lu(k,101) + lu(k,2031) = lu(k,2031) - lu(k,102) * lu(k,1998) + lu(k,2035) = lu(k,2035) - lu(k,103) * lu(k,1998) + lu(k,104) = 1._r8 / lu(k,104) + lu(k,105) = lu(k,105) * lu(k,104) + lu(k,106) = lu(k,106) * lu(k,104) + lu(k,1818) = lu(k,1818) - lu(k,105) * lu(k,1682) + lu(k,1829) = lu(k,1829) - lu(k,106) * lu(k,1682) + lu(k,107) = 1._r8 / lu(k,107) + lu(k,108) = lu(k,108) * lu(k,107) + lu(k,109) = lu(k,109) * lu(k,107) + lu(k,110) = lu(k,110) * lu(k,107) + lu(k,2009) = lu(k,2009) - lu(k,108) * lu(k,1999) + lu(k,2022) = lu(k,2022) - lu(k,109) * lu(k,1999) + lu(k,2031) = lu(k,2031) - lu(k,110) * lu(k,1999) + 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,2011) = lu(k,2011) - lu(k,112) * lu(k,2000) + lu(k,2031) = lu(k,2031) - lu(k,113) * lu(k,2000) + lu(k,2035) = lu(k,2035) - lu(k,114) * lu(k,2000) + lu(k,115) = 1._r8 / lu(k,115) + lu(k,116) = lu(k,116) * lu(k,115) + lu(k,117) = lu(k,117) * lu(k,115) + lu(k,118) = lu(k,118) * lu(k,115) + lu(k,2009) = lu(k,2009) - lu(k,116) * lu(k,2001) + lu(k,2031) = lu(k,2031) - lu(k,117) * lu(k,2001) + lu(k,2035) = lu(k,2035) - lu(k,118) * lu(k,2001) + lu(k,119) = 1._r8 / lu(k,119) + lu(k,120) = lu(k,120) * lu(k,119) + lu(k,121) = lu(k,121) * lu(k,119) + lu(k,122) = lu(k,122) * lu(k,119) + lu(k,2009) = lu(k,2009) - lu(k,120) * lu(k,2002) + lu(k,2031) = lu(k,2031) - lu(k,121) * lu(k,2002) + lu(k,2035) = lu(k,2035) - lu(k,122) * lu(k,2002) + lu(k,123) = 1._r8 / lu(k,123) + lu(k,124) = lu(k,124) * lu(k,123) + lu(k,125) = lu(k,125) * lu(k,123) + lu(k,126) = lu(k,126) * lu(k,123) + lu(k,1818) = lu(k,1818) - lu(k,124) * lu(k,1683) + lu(k,1826) = lu(k,1826) - lu(k,125) * lu(k,1683) + lu(k,1831) = lu(k,1831) - lu(k,126) * lu(k,1683) + lu(k,127) = 1._r8 / lu(k,127) + lu(k,128) = lu(k,128) * lu(k,127) + lu(k,129) = lu(k,129) * lu(k,127) + lu(k,796) = lu(k,796) - lu(k,128) * lu(k,795) + lu(k,800) = - lu(k,129) * lu(k,795) + lu(k,2293) = - lu(k,128) * lu(k,2275) + lu(k,2357) = lu(k,2357) - lu(k,129) * lu(k,2275) + 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,261) = lu(k,261) - lu(k,131) * lu(k,260) + lu(k,264) = lu(k,264) - lu(k,132) * lu(k,260) + lu(k,2424) = lu(k,2424) - lu(k,131) * lu(k,2423) + lu(k,2449) = lu(k,2449) - lu(k,132) * lu(k,2423) + lu(k,133) = 1._r8 / lu(k,133) + lu(k,134) = lu(k,134) * lu(k,133) + lu(k,135) = lu(k,135) * lu(k,133) + lu(k,712) = lu(k,712) - lu(k,134) * lu(k,710) + lu(k,715) = lu(k,715) - lu(k,135) * lu(k,710) + lu(k,1799) = lu(k,1799) - lu(k,134) * lu(k,1684) + lu(k,1818) = lu(k,1818) - lu(k,135) * lu(k,1684) + 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,523) = lu(k,523) - lu(k,137) * lu(k,522) + lu(k,527) = lu(k,527) - lu(k,138) * lu(k,522) + lu(k,1932) = lu(k,1932) - lu(k,137) * lu(k,1927) + lu(k,1960) = lu(k,1960) - lu(k,138) * lu(k,1927) + lu(k,139) = 1._r8 / lu(k,139) + lu(k,140) = lu(k,140) * lu(k,139) + lu(k,141) = lu(k,141) * lu(k,139) + lu(k,142) = lu(k,142) * lu(k,139) + lu(k,143) = lu(k,143) * lu(k,139) + lu(k,2009) = lu(k,2009) - lu(k,140) * lu(k,2003) + lu(k,2022) = lu(k,2022) - lu(k,141) * lu(k,2003) + lu(k,2031) = lu(k,2031) - lu(k,142) * lu(k,2003) + lu(k,2035) = lu(k,2035) - lu(k,143) * lu(k,2003) + 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,144) = 1._r8 / lu(k,144) + lu(k,145) = lu(k,145) * lu(k,144) + lu(k,146) = lu(k,146) * lu(k,144) + lu(k,147) = lu(k,147) * lu(k,144) + lu(k,148) = lu(k,148) * lu(k,144) + lu(k,2009) = lu(k,2009) - lu(k,145) * lu(k,2004) + lu(k,2019) = lu(k,2019) - lu(k,146) * lu(k,2004) + lu(k,2022) = lu(k,2022) - lu(k,147) * lu(k,2004) + lu(k,2031) = lu(k,2031) - lu(k,148) * lu(k,2004) + lu(k,149) = 1._r8 / lu(k,149) + lu(k,150) = lu(k,150) * lu(k,149) + lu(k,151) = lu(k,151) * lu(k,149) + lu(k,152) = lu(k,152) * lu(k,149) + lu(k,153) = lu(k,153) * lu(k,149) + lu(k,2009) = lu(k,2009) - lu(k,150) * lu(k,2005) + lu(k,2011) = lu(k,2011) - lu(k,151) * lu(k,2005) + lu(k,2031) = lu(k,2031) - lu(k,152) * lu(k,2005) + lu(k,2035) = lu(k,2035) - lu(k,153) * lu(k,2005) + lu(k,154) = 1._r8 / lu(k,154) + lu(k,155) = lu(k,155) * lu(k,154) + lu(k,156) = lu(k,156) * lu(k,154) + lu(k,157) = lu(k,157) * lu(k,154) + lu(k,158) = lu(k,158) * lu(k,154) + lu(k,2009) = lu(k,2009) - lu(k,155) * lu(k,2006) + lu(k,2019) = lu(k,2019) - lu(k,156) * lu(k,2006) + lu(k,2031) = lu(k,2031) - lu(k,157) * lu(k,2006) + lu(k,2035) = lu(k,2035) - lu(k,158) * lu(k,2006) + 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,1686) = lu(k,1686) - lu(k,161) * lu(k,1685) + lu(k,1687) = lu(k,1687) - lu(k,162) * lu(k,1685) + lu(k,1736) = lu(k,1736) - lu(k,163) * lu(k,1685) + lu(k,1818) = lu(k,1818) - lu(k,164) * lu(k,1685) + lu(k,1829) = lu(k,1829) - lu(k,165) * lu(k,1685) + lu(k,166) = 1._r8 / lu(k,166) + lu(k,167) = lu(k,167) * lu(k,166) + lu(k,168) = lu(k,168) * lu(k,166) + lu(k,169) = lu(k,169) * lu(k,166) + lu(k,1731) = - lu(k,167) * lu(k,1686) + lu(k,1793) = lu(k,1793) - lu(k,168) * lu(k,1686) + lu(k,1829) = lu(k,1829) - lu(k,169) * lu(k,1686) + lu(k,170) = 1._r8 / lu(k,170) + lu(k,171) = lu(k,171) * lu(k,170) + lu(k,172) = lu(k,172) * lu(k,170) + lu(k,173) = lu(k,173) * lu(k,170) + lu(k,174) = lu(k,174) * lu(k,170) + lu(k,1729) = lu(k,1729) - lu(k,171) * lu(k,1687) + lu(k,1732) = lu(k,1732) - lu(k,172) * lu(k,1687) + lu(k,1818) = lu(k,1818) - lu(k,173) * lu(k,1687) + lu(k,1829) = lu(k,1829) - lu(k,174) * lu(k,1687) + lu(k,175) = 1._r8 / lu(k,175) + lu(k,176) = lu(k,176) * lu(k,175) + lu(k,842) = lu(k,842) - lu(k,176) * lu(k,836) + lu(k,963) = lu(k,963) - lu(k,176) * lu(k,953) + lu(k,1506) = lu(k,1506) - lu(k,176) * lu(k,1490) + lu(k,1602) = lu(k,1602) - lu(k,176) * lu(k,1581) + lu(k,2168) = lu(k,2168) - lu(k,176) * lu(k,2128) + lu(k,177) = 1._r8 / lu(k,177) + lu(k,178) = lu(k,178) * lu(k,177) + lu(k,181) = lu(k,181) - lu(k,178) * lu(k,179) + lu(k,1451) = - lu(k,178) * lu(k,1442) + lu(k,1542) = lu(k,1542) - lu(k,178) * lu(k,1524) + lu(k,2089) = lu(k,2089) - lu(k,178) * lu(k,2064) + lu(k,2220) = lu(k,2220) - lu(k,178) * lu(k,2179) + lu(k,180) = 1._r8 / lu(k,180) + lu(k,181) = lu(k,181) * lu(k,180) + lu(k,1451) = lu(k,1451) - lu(k,181) * lu(k,1443) + lu(k,1542) = lu(k,1542) - lu(k,181) * lu(k,1525) + lu(k,2023) = lu(k,2023) - lu(k,181) * lu(k,2007) + lu(k,2089) = lu(k,2089) - lu(k,181) * lu(k,2065) + lu(k,2220) = lu(k,2220) - lu(k,181) * lu(k,2180) + 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,1818) = lu(k,1818) - lu(k,183) * lu(k,1688) + lu(k,1822) = - lu(k,184) * lu(k,1688) + lu(k,1829) = lu(k,1829) - lu(k,185) * lu(k,1688) + lu(k,2027) = lu(k,2027) - lu(k,183) * lu(k,2008) + lu(k,2031) = lu(k,2031) - lu(k,184) * lu(k,2008) + lu(k,2038) = lu(k,2038) - lu(k,185) * lu(k,2008) + lu(k,187) = 1._r8 / lu(k,187) + lu(k,188) = lu(k,188) * lu(k,187) + lu(k,189) = lu(k,189) * lu(k,187) + lu(k,190) = lu(k,190) * lu(k,187) + lu(k,191) = lu(k,191) * lu(k,187) + lu(k,192) = lu(k,192) * lu(k,187) + lu(k,193) = lu(k,193) * lu(k,187) + lu(k,1690) = lu(k,1690) - lu(k,188) * lu(k,1689) + lu(k,1691) = lu(k,1691) - lu(k,189) * lu(k,1689) + lu(k,1728) = lu(k,1728) - lu(k,190) * lu(k,1689) + lu(k,1763) = lu(k,1763) - lu(k,191) * lu(k,1689) + lu(k,1818) = lu(k,1818) - lu(k,192) * lu(k,1689) + lu(k,1829) = lu(k,1829) - lu(k,193) * lu(k,1689) + 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,1729) = lu(k,1729) - lu(k,195) * lu(k,1690) + lu(k,1732) = lu(k,1732) - lu(k,196) * lu(k,1690) + lu(k,1818) = lu(k,1818) - lu(k,197) * lu(k,1690) + lu(k,1829) = lu(k,1829) - lu(k,198) * lu(k,1690) + 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,199) = 1._r8 / lu(k,199) + lu(k,200) = lu(k,200) * lu(k,199) + lu(k,201) = lu(k,201) * lu(k,199) + lu(k,202) = lu(k,202) * lu(k,199) + lu(k,212) = - lu(k,200) * lu(k,207) + lu(k,213) = - lu(k,201) * lu(k,207) + lu(k,215) = lu(k,215) - lu(k,202) * lu(k,207) + lu(k,1793) = lu(k,1793) - lu(k,200) * lu(k,1691) + lu(k,1808) = lu(k,1808) - lu(k,201) * lu(k,1691) + lu(k,1829) = lu(k,1829) - lu(k,202) * lu(k,1691) + lu(k,203) = 1._r8 / lu(k,203) + lu(k,204) = lu(k,204) * lu(k,203) + lu(k,205) = lu(k,205) * lu(k,203) + lu(k,1233) = lu(k,1233) - lu(k,204) * lu(k,1227) + lu(k,1238) = - lu(k,205) * lu(k,1227) + lu(k,1799) = lu(k,1799) - lu(k,204) * lu(k,1692) + lu(k,1818) = lu(k,1818) - lu(k,205) * lu(k,1692) + lu(k,2339) = lu(k,2339) - lu(k,204) * lu(k,2276) + lu(k,2357) = lu(k,2357) - lu(k,205) * lu(k,2276) + lu(k,208) = 1._r8 / lu(k,208) + lu(k,209) = lu(k,209) * lu(k,208) + lu(k,210) = lu(k,210) * lu(k,208) + lu(k,211) = lu(k,211) * lu(k,208) + lu(k,212) = lu(k,212) * lu(k,208) + lu(k,213) = lu(k,213) * lu(k,208) + lu(k,214) = lu(k,214) * lu(k,208) + lu(k,215) = lu(k,215) * lu(k,208) + lu(k,1694) = lu(k,1694) - lu(k,209) * lu(k,1693) + lu(k,1728) = lu(k,1728) - lu(k,210) * lu(k,1693) + lu(k,1764) = lu(k,1764) - lu(k,211) * lu(k,1693) + lu(k,1793) = lu(k,1793) - lu(k,212) * lu(k,1693) + lu(k,1808) = lu(k,1808) - lu(k,213) * lu(k,1693) + lu(k,1818) = lu(k,1818) - lu(k,214) * lu(k,1693) + lu(k,1829) = lu(k,1829) - lu(k,215) * lu(k,1693) + lu(k,216) = 1._r8 / lu(k,216) + lu(k,217) = lu(k,217) * lu(k,216) + lu(k,218) = lu(k,218) * lu(k,216) + lu(k,219) = lu(k,219) * lu(k,216) + lu(k,220) = lu(k,220) * lu(k,216) + lu(k,1732) = lu(k,1732) - lu(k,217) * lu(k,1694) + lu(k,1737) = lu(k,1737) - lu(k,218) * lu(k,1694) + lu(k,1818) = lu(k,1818) - lu(k,219) * lu(k,1694) + lu(k,1829) = lu(k,1829) - lu(k,220) * lu(k,1694) + lu(k,221) = 1._r8 / lu(k,221) + lu(k,222) = lu(k,222) * lu(k,221) + lu(k,223) = lu(k,223) * lu(k,221) + lu(k,224) = lu(k,224) * lu(k,221) + lu(k,225) = lu(k,225) * lu(k,221) + lu(k,1318) = - lu(k,222) * lu(k,1315) + lu(k,1329) = - lu(k,223) * lu(k,1315) + lu(k,1339) = - lu(k,224) * lu(k,1315) + lu(k,1345) = lu(k,1345) - lu(k,225) * lu(k,1315) + lu(k,1747) = - lu(k,222) * lu(k,1695) + lu(k,1799) = lu(k,1799) - lu(k,223) * lu(k,1695) + lu(k,1818) = lu(k,1818) - lu(k,224) * lu(k,1695) + lu(k,1829) = lu(k,1829) - lu(k,225) * lu(k,1695) + lu(k,226) = 1._r8 / lu(k,226) + lu(k,227) = lu(k,227) * lu(k,226) + lu(k,228) = lu(k,228) * lu(k,226) + lu(k,975) = - lu(k,227) * lu(k,971) + lu(k,988) = lu(k,988) - lu(k,228) * lu(k,971) + lu(k,1019) = - lu(k,227) * lu(k,1015) + lu(k,1032) = lu(k,1032) - lu(k,228) * lu(k,1015) + lu(k,1783) = lu(k,1783) - lu(k,227) * lu(k,1696) + lu(k,1818) = lu(k,1818) - lu(k,228) * lu(k,1696) + lu(k,2194) = - lu(k,227) * lu(k,2181) + lu(k,2224) = lu(k,2224) - lu(k,228) * lu(k,2181) + lu(k,229) = 1._r8 / lu(k,229) + lu(k,230) = lu(k,230) * lu(k,229) + lu(k,231) = lu(k,231) * lu(k,229) + lu(k,789) = lu(k,789) - lu(k,230) * lu(k,786) + lu(k,793) = - lu(k,231) * lu(k,786) + lu(k,1496) = - lu(k,230) * lu(k,1491) + lu(k,1506) = lu(k,1506) - lu(k,231) * lu(k,1491) + lu(k,1563) = lu(k,1563) - lu(k,230) * lu(k,1556) + lu(k,1576) = lu(k,1576) - lu(k,231) * lu(k,1556) + lu(k,1589) = lu(k,1589) - lu(k,230) * lu(k,1582) + lu(k,1602) = lu(k,1602) - lu(k,231) * lu(k,1582) + lu(k,232) = 1._r8 / lu(k,232) + lu(k,233) = lu(k,233) * lu(k,232) + lu(k,234) = lu(k,234) * lu(k,232) + lu(k,1184) = lu(k,1184) - lu(k,233) * lu(k,1171) + lu(k,1186) = - lu(k,234) * lu(k,1171) + lu(k,1202) = lu(k,1202) - lu(k,233) * lu(k,1190) + lu(k,1204) = lu(k,1204) - lu(k,234) * lu(k,1190) + lu(k,1820) = lu(k,1820) - lu(k,233) * lu(k,1697) + lu(k,1823) = lu(k,1823) - lu(k,234) * lu(k,1697) + lu(k,1915) = lu(k,1915) - lu(k,233) * lu(k,1844) + lu(k,1918) = - lu(k,234) * lu(k,1844) + lu(k,235) = 1._r8 / lu(k,235) + lu(k,236) = lu(k,236) * lu(k,235) + lu(k,237) = lu(k,237) * lu(k,235) + lu(k,347) = - lu(k,236) * lu(k,344) + lu(k,348) = lu(k,348) - lu(k,237) * lu(k,344) + lu(k,436) = - lu(k,236) * lu(k,433) + lu(k,437) = - lu(k,237) * lu(k,433) + lu(k,1739) = lu(k,1739) - lu(k,236) * lu(k,1698) + lu(k,1818) = lu(k,1818) - lu(k,237) * lu(k,1698) + lu(k,1858) = lu(k,1858) - lu(k,236) * lu(k,1845) + lu(k,1913) = lu(k,1913) - lu(k,237) * lu(k,1845) + 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,238) = 1._r8 / lu(k,238) + lu(k,239) = lu(k,239) * lu(k,238) + lu(k,240) = lu(k,240) * lu(k,238) + lu(k,252) = - lu(k,239) * lu(k,250) + lu(k,254) = lu(k,254) - lu(k,240) * lu(k,250) + lu(k,293) = - lu(k,239) * lu(k,291) + lu(k,295) = lu(k,295) - lu(k,240) * lu(k,291) + lu(k,1776) = - lu(k,239) * lu(k,1699) + lu(k,1822) = lu(k,1822) - lu(k,240) * lu(k,1699) + lu(k,2019) = lu(k,2019) - lu(k,239) * lu(k,2009) + lu(k,2031) = lu(k,2031) - lu(k,240) * lu(k,2009) + lu(k,241) = 1._r8 / lu(k,241) + lu(k,242) = lu(k,242) * lu(k,241) + lu(k,243) = lu(k,243) * lu(k,241) + lu(k,244) = lu(k,244) * lu(k,241) + lu(k,245) = lu(k,245) * lu(k,241) + lu(k,1701) = lu(k,1701) - lu(k,242) * lu(k,1700) + lu(k,1818) = lu(k,1818) - lu(k,243) * lu(k,1700) + lu(k,1822) = lu(k,1822) - lu(k,244) * lu(k,1700) + lu(k,1826) = lu(k,1826) - lu(k,245) * lu(k,1700) + lu(k,2011) = lu(k,2011) - lu(k,242) * lu(k,2010) + lu(k,2027) = lu(k,2027) - lu(k,243) * lu(k,2010) + lu(k,2031) = lu(k,2031) - lu(k,244) * lu(k,2010) + lu(k,2035) = lu(k,2035) - lu(k,245) * lu(k,2010) + lu(k,246) = 1._r8 / lu(k,246) + lu(k,247) = lu(k,247) * lu(k,246) + lu(k,248) = lu(k,248) * lu(k,246) + lu(k,249) = lu(k,249) * lu(k,246) + lu(k,1776) = lu(k,1776) - lu(k,247) * lu(k,1701) + lu(k,1822) = lu(k,1822) - lu(k,248) * lu(k,1701) + lu(k,1826) = lu(k,1826) - lu(k,249) * lu(k,1701) + lu(k,2019) = lu(k,2019) - lu(k,247) * lu(k,2011) + lu(k,2031) = lu(k,2031) - lu(k,248) * lu(k,2011) + lu(k,2035) = lu(k,2035) - lu(k,249) * lu(k,2011) + lu(k,251) = 1._r8 / lu(k,251) + lu(k,252) = lu(k,252) * lu(k,251) + lu(k,253) = lu(k,253) * lu(k,251) + lu(k,254) = lu(k,254) * lu(k,251) + lu(k,255) = lu(k,255) * lu(k,251) + lu(k,1776) = lu(k,1776) - lu(k,252) * lu(k,1702) + lu(k,1818) = lu(k,1818) - lu(k,253) * lu(k,1702) + lu(k,1822) = lu(k,1822) - lu(k,254) * lu(k,1702) + lu(k,1826) = lu(k,1826) - lu(k,255) * lu(k,1702) + lu(k,2019) = lu(k,2019) - lu(k,252) * lu(k,2012) + lu(k,2027) = lu(k,2027) - lu(k,253) * lu(k,2012) + lu(k,2031) = lu(k,2031) - lu(k,254) * lu(k,2012) + lu(k,2035) = lu(k,2035) - lu(k,255) * lu(k,2012) + lu(k,256) = 1._r8 / lu(k,256) + lu(k,257) = lu(k,257) * lu(k,256) + lu(k,258) = lu(k,258) * lu(k,256) + lu(k,259) = lu(k,259) * lu(k,256) + lu(k,1002) = lu(k,1002) - lu(k,257) * lu(k,993) + lu(k,1004) = lu(k,1004) - lu(k,258) * lu(k,993) + lu(k,1006) = - lu(k,259) * lu(k,993) + lu(k,1954) = lu(k,1954) - lu(k,257) * lu(k,1928) + lu(k,1959) = lu(k,1959) - lu(k,258) * lu(k,1928) + lu(k,1962) = - lu(k,259) * lu(k,1928) + lu(k,2023) = lu(k,2023) - lu(k,257) * lu(k,2013) + lu(k,2028) = lu(k,2028) - lu(k,258) * lu(k,2013) + lu(k,2031) = lu(k,2031) - lu(k,259) * lu(k,2013) + lu(k,261) = 1._r8 / lu(k,261) + lu(k,262) = lu(k,262) * lu(k,261) + lu(k,263) = lu(k,263) * lu(k,261) + lu(k,264) = lu(k,264) * lu(k,261) + lu(k,947) = lu(k,947) - lu(k,262) * lu(k,946) + lu(k,950) = lu(k,950) - lu(k,263) * lu(k,946) + lu(k,952) = - lu(k,264) * lu(k,946) + lu(k,1778) = lu(k,1778) - lu(k,262) * lu(k,1703) + lu(k,1824) = lu(k,1824) - lu(k,263) * lu(k,1703) + lu(k,1831) = lu(k,1831) - lu(k,264) * lu(k,1703) + lu(k,2427) = - lu(k,262) * lu(k,2424) + lu(k,2442) = lu(k,2442) - lu(k,263) * lu(k,2424) + lu(k,2449) = lu(k,2449) - lu(k,264) * lu(k,2424) + lu(k,265) = 1._r8 / lu(k,265) + lu(k,266) = lu(k,266) * lu(k,265) + lu(k,267) = lu(k,267) * lu(k,265) + lu(k,268) = lu(k,268) * lu(k,265) + lu(k,902) = lu(k,902) - lu(k,266) * lu(k,898) + lu(k,904) = - lu(k,267) * lu(k,898) + lu(k,908) = lu(k,908) - lu(k,268) * lu(k,898) + lu(k,1792) = lu(k,1792) - lu(k,266) * lu(k,1704) + lu(k,1818) = lu(k,1818) - lu(k,267) * lu(k,1704) + lu(k,1829) = lu(k,1829) - lu(k,268) * lu(k,1704) + lu(k,2388) = lu(k,2388) - lu(k,266) * lu(k,2371) + lu(k,2409) = - lu(k,267) * lu(k,2371) + lu(k,2420) = lu(k,2420) - lu(k,268) * lu(k,2371) + lu(k,269) = 1._r8 / lu(k,269) + lu(k,270) = lu(k,270) * lu(k,269) + lu(k,271) = lu(k,271) * lu(k,269) + lu(k,272) = lu(k,272) * lu(k,269) + lu(k,634) = lu(k,634) - lu(k,270) * lu(k,633) + lu(k,635) = lu(k,635) - lu(k,271) * lu(k,633) + lu(k,636) = - lu(k,272) * lu(k,633) + lu(k,1732) = lu(k,1732) - lu(k,270) * lu(k,1705) + lu(k,1752) = lu(k,1752) - lu(k,271) * lu(k,1705) + lu(k,1818) = lu(k,1818) - lu(k,272) * lu(k,1705) + lu(k,2295) = - lu(k,270) * lu(k,2277) + lu(k,2304) = lu(k,2304) - lu(k,271) * lu(k,2277) + lu(k,2357) = lu(k,2357) - lu(k,272) * lu(k,2277) + lu(k,273) = 1._r8 / lu(k,273) + lu(k,274) = lu(k,274) * lu(k,273) + lu(k,275) = lu(k,275) * lu(k,273) + lu(k,276) = lu(k,276) * lu(k,273) + lu(k,277) = lu(k,277) * lu(k,273) + lu(k,278) = lu(k,278) * lu(k,273) + lu(k,1652) = lu(k,1652) - lu(k,274) * lu(k,1609) + lu(k,1654) = lu(k,1654) - lu(k,275) * lu(k,1609) + lu(k,1655) = lu(k,1655) - lu(k,276) * lu(k,1609) + lu(k,1658) = lu(k,1658) - lu(k,277) * lu(k,1609) + lu(k,1659) = lu(k,1659) - lu(k,278) * lu(k,1609) + lu(k,1957) = lu(k,1957) - lu(k,274) * lu(k,1929) + lu(k,1959) = lu(k,1959) - lu(k,275) * lu(k,1929) + lu(k,1960) = lu(k,1960) - lu(k,276) * lu(k,1929) + lu(k,1963) = lu(k,1963) - lu(k,277) * lu(k,1929) + lu(k,1964) = lu(k,1964) - lu(k,278) * lu(k,1929) + lu(k,279) = 1._r8 / lu(k,279) + lu(k,280) = lu(k,280) * lu(k,279) + lu(k,281) = lu(k,281) * lu(k,279) + lu(k,668) = - lu(k,280) * lu(k,662) + lu(k,674) = lu(k,674) - lu(k,281) * lu(k,662) + lu(k,732) = - lu(k,280) * lu(k,725) + lu(k,739) = lu(k,739) - lu(k,281) * lu(k,725) + lu(k,752) = - lu(k,280) * lu(k,746) + lu(k,760) = lu(k,760) - lu(k,281) * lu(k,746) + lu(k,768) = - lu(k,280) * lu(k,761) + lu(k,777) = lu(k,777) - lu(k,281) * lu(k,761) + lu(k,1870) = lu(k,1870) - lu(k,280) * lu(k,1846) + lu(k,1924) = lu(k,1924) - lu(k,281) * lu(k,1846) + 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,282) = 1._r8 / lu(k,282) + lu(k,283) = lu(k,283) * lu(k,282) + lu(k,284) = lu(k,284) * lu(k,282) + lu(k,925) = lu(k,925) - lu(k,283) * lu(k,924) + lu(k,930) = lu(k,930) - lu(k,284) * lu(k,924) + lu(k,1460) = lu(k,1460) - lu(k,283) * lu(k,1459) + lu(k,1468) = lu(k,1468) - lu(k,284) * lu(k,1459) + lu(k,2042) = lu(k,2042) - lu(k,283) * lu(k,2041) + lu(k,2057) = - lu(k,284) * lu(k,2041) + lu(k,2239) = lu(k,2239) - lu(k,283) * lu(k,2238) + lu(k,2256) = lu(k,2256) - lu(k,284) * lu(k,2238) + lu(k,2426) = lu(k,2426) - lu(k,283) * lu(k,2425) + lu(k,2443) = lu(k,2443) - lu(k,284) * lu(k,2425) + lu(k,285) = 1._r8 / lu(k,285) + lu(k,286) = lu(k,286) * lu(k,285) + lu(k,287) = lu(k,287) * lu(k,285) + lu(k,288) = lu(k,288) * lu(k,285) + lu(k,289) = lu(k,289) * lu(k,285) + lu(k,290) = lu(k,290) * lu(k,285) + lu(k,1775) = lu(k,1775) - lu(k,286) * lu(k,1706) + lu(k,1784) = lu(k,1784) - lu(k,287) * lu(k,1706) + lu(k,1793) = lu(k,1793) - lu(k,288) * lu(k,1706) + lu(k,1818) = lu(k,1818) - lu(k,289) * lu(k,1706) + lu(k,1829) = lu(k,1829) - lu(k,290) * lu(k,1706) + lu(k,2141) = - lu(k,286) * lu(k,2129) + lu(k,2144) = - lu(k,287) * lu(k,2129) + lu(k,2147) = lu(k,2147) - lu(k,288) * lu(k,2129) + lu(k,2160) = lu(k,2160) - lu(k,289) * lu(k,2129) + lu(k,2171) = lu(k,2171) - lu(k,290) * lu(k,2129) + 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,1776) = lu(k,1776) - lu(k,293) * lu(k,1707) + lu(k,1818) = lu(k,1818) - lu(k,294) * lu(k,1707) + lu(k,1822) = lu(k,1822) - lu(k,295) * lu(k,1707) + lu(k,1826) = lu(k,1826) - lu(k,296) * lu(k,1707) + lu(k,1831) = lu(k,1831) - lu(k,297) * lu(k,1707) + lu(k,2019) = lu(k,2019) - lu(k,293) * lu(k,2014) + lu(k,2027) = lu(k,2027) - lu(k,294) * lu(k,2014) + lu(k,2031) = lu(k,2031) - lu(k,295) * lu(k,2014) + lu(k,2035) = lu(k,2035) - lu(k,296) * lu(k,2014) + lu(k,2040) = lu(k,2040) - lu(k,297) * lu(k,2014) + lu(k,298) = 1._r8 / lu(k,298) + lu(k,299) = lu(k,299) * lu(k,298) + lu(k,300) = lu(k,300) * lu(k,298) + lu(k,301) = lu(k,301) * lu(k,298) + lu(k,302) = lu(k,302) * lu(k,298) + lu(k,303) = lu(k,303) * lu(k,298) + lu(k,1773) = lu(k,1773) - lu(k,299) * lu(k,1708) + lu(k,1812) = lu(k,1812) - lu(k,300) * lu(k,1708) + lu(k,1818) = lu(k,1818) - lu(k,301) * lu(k,1708) + lu(k,1826) = lu(k,1826) - lu(k,302) * lu(k,1708) + lu(k,1831) = lu(k,1831) - lu(k,303) * lu(k,1708) + lu(k,2140) = lu(k,2140) - lu(k,299) * lu(k,2130) + lu(k,2154) = lu(k,2154) - lu(k,300) * lu(k,2130) + lu(k,2160) = lu(k,2160) - lu(k,301) * lu(k,2130) + lu(k,2168) = lu(k,2168) - lu(k,302) * lu(k,2130) + lu(k,2173) = - lu(k,303) * lu(k,2130) + lu(k,304) = 1._r8 / lu(k,304) + lu(k,305) = lu(k,305) * lu(k,304) + lu(k,306) = lu(k,306) * lu(k,304) + lu(k,307) = lu(k,307) * lu(k,304) + lu(k,308) = lu(k,308) * lu(k,304) + lu(k,309) = lu(k,309) * lu(k,304) + lu(k,1777) = lu(k,1777) - lu(k,305) * lu(k,1709) + lu(k,1812) = lu(k,1812) - lu(k,306) * lu(k,1709) + lu(k,1818) = lu(k,1818) - lu(k,307) * lu(k,1709) + lu(k,1826) = lu(k,1826) - lu(k,308) * lu(k,1709) + lu(k,1831) = lu(k,1831) - lu(k,309) * lu(k,1709) + lu(k,2142) = lu(k,2142) - lu(k,305) * lu(k,2131) + lu(k,2154) = lu(k,2154) - lu(k,306) * lu(k,2131) + lu(k,2160) = lu(k,2160) - lu(k,307) * lu(k,2131) + lu(k,2168) = lu(k,2168) - lu(k,308) * lu(k,2131) + lu(k,2173) = lu(k,2173) - lu(k,309) * lu(k,2131) + lu(k,310) = 1._r8 / lu(k,310) + lu(k,311) = lu(k,311) * lu(k,310) + lu(k,312) = lu(k,312) * lu(k,310) + lu(k,313) = lu(k,313) * lu(k,310) + lu(k,314) = lu(k,314) * lu(k,310) + lu(k,315) = lu(k,315) * lu(k,310) + lu(k,1617) = lu(k,1617) - lu(k,311) * lu(k,1610) + lu(k,1652) = lu(k,1652) - lu(k,312) * lu(k,1610) + lu(k,1653) = lu(k,1653) - lu(k,313) * lu(k,1610) + lu(k,1658) = lu(k,1658) - lu(k,314) * lu(k,1610) + lu(k,1664) = lu(k,1664) - lu(k,315) * lu(k,1610) + lu(k,1778) = lu(k,1778) - lu(k,311) * lu(k,1710) + lu(k,1817) = lu(k,1817) - lu(k,312) * lu(k,1710) + lu(k,1818) = lu(k,1818) - lu(k,313) * lu(k,1710) + lu(k,1823) = lu(k,1823) - lu(k,314) * lu(k,1710) + lu(k,1829) = lu(k,1829) - lu(k,315) * lu(k,1710) + lu(k,316) = 1._r8 / lu(k,316) + lu(k,317) = lu(k,317) * lu(k,316) + lu(k,318) = lu(k,318) * lu(k,316) + lu(k,319) = lu(k,319) * lu(k,316) + lu(k,320) = lu(k,320) * lu(k,316) + lu(k,1356) = lu(k,1356) - lu(k,317) * lu(k,1348) + lu(k,1357) = - lu(k,318) * lu(k,1348) + lu(k,1361) = - lu(k,319) * lu(k,1348) + lu(k,1366) = lu(k,1366) - lu(k,320) * lu(k,1348) + lu(k,1805) = lu(k,1805) - lu(k,317) * lu(k,1711) + lu(k,1807) = lu(k,1807) - lu(k,318) * lu(k,1711) + lu(k,1818) = lu(k,1818) - lu(k,319) * lu(k,1711) + lu(k,1829) = lu(k,1829) - lu(k,320) * lu(k,1711) + lu(k,2345) = lu(k,2345) - lu(k,317) * lu(k,2278) + lu(k,2347) = lu(k,2347) - lu(k,318) * lu(k,2278) + lu(k,2357) = lu(k,2357) - lu(k,319) * lu(k,2278) + lu(k,2368) = lu(k,2368) - lu(k,320) * lu(k,2278) + lu(k,321) = 1._r8 / lu(k,321) + lu(k,322) = lu(k,322) * lu(k,321) + lu(k,323) = lu(k,323) * lu(k,321) + lu(k,324) = lu(k,324) * lu(k,321) + lu(k,325) = lu(k,325) * lu(k,321) + lu(k,698) = lu(k,698) - lu(k,322) * lu(k,697) + lu(k,699) = lu(k,699) - lu(k,323) * lu(k,697) + lu(k,700) = lu(k,700) - lu(k,324) * lu(k,697) + lu(k,701) = lu(k,701) - lu(k,325) * lu(k,697) + lu(k,1757) = lu(k,1757) - lu(k,322) * lu(k,1712) + lu(k,1792) = lu(k,1792) - lu(k,323) * lu(k,1712) + lu(k,1808) = lu(k,1808) - lu(k,324) * lu(k,1712) + lu(k,1818) = lu(k,1818) - lu(k,325) * lu(k,1712) + lu(k,2308) = lu(k,2308) - lu(k,322) * lu(k,2279) + lu(k,2333) = lu(k,2333) - lu(k,323) * lu(k,2279) + lu(k,2348) = lu(k,2348) - lu(k,324) * lu(k,2279) + lu(k,2357) = lu(k,2357) - lu(k,325) * lu(k,2279) + lu(k,326) = 1._r8 / lu(k,326) + lu(k,327) = lu(k,327) * lu(k,326) + lu(k,328) = lu(k,328) * lu(k,326) + lu(k,1329) = lu(k,1329) - lu(k,327) * lu(k,1316) + lu(k,1339) = lu(k,1339) - lu(k,328) * lu(k,1316) + lu(k,1419) = lu(k,1419) - lu(k,327) * lu(k,1410) + lu(k,1432) = lu(k,1432) - lu(k,328) * lu(k,1410) + lu(k,1636) = lu(k,1636) - lu(k,327) * lu(k,1611) + lu(k,1653) = lu(k,1653) - lu(k,328) * lu(k,1611) + lu(k,1799) = lu(k,1799) - lu(k,327) * lu(k,1713) + lu(k,1818) = lu(k,1818) - lu(k,328) * lu(k,1713) + lu(k,1897) = lu(k,1897) - lu(k,327) * lu(k,1847) + lu(k,1913) = lu(k,1913) - lu(k,328) * lu(k,1847) + lu(k,2394) = lu(k,2394) - lu(k,327) * lu(k,2372) + lu(k,2409) = lu(k,2409) - lu(k,328) * lu(k,2372) + 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,329) = 1._r8 / lu(k,329) + lu(k,330) = lu(k,330) * lu(k,329) + lu(k,331) = lu(k,331) * lu(k,329) + lu(k,332) = lu(k,332) * lu(k,329) + lu(k,333) = lu(k,333) * lu(k,329) + lu(k,735) = - lu(k,330) * lu(k,726) + lu(k,736) = lu(k,736) - lu(k,331) * lu(k,726) + lu(k,737) = - lu(k,332) * lu(k,726) + lu(k,739) = lu(k,739) - lu(k,333) * lu(k,726) + lu(k,771) = - lu(k,330) * lu(k,762) + lu(k,772) = lu(k,772) - lu(k,331) * lu(k,762) + lu(k,773) = - lu(k,332) * lu(k,762) + lu(k,777) = lu(k,777) - lu(k,333) * lu(k,762) + lu(k,1891) = lu(k,1891) - lu(k,330) * lu(k,1848) + lu(k,1900) = lu(k,1900) - lu(k,331) * lu(k,1848) + lu(k,1906) = lu(k,1906) - lu(k,332) * lu(k,1848) + lu(k,1924) = lu(k,1924) - lu(k,333) * lu(k,1848) + lu(k,334) = 1._r8 / lu(k,334) + lu(k,335) = lu(k,335) * lu(k,334) + lu(k,336) = lu(k,336) * lu(k,334) + lu(k,337) = lu(k,337) * lu(k,334) + lu(k,338) = lu(k,338) * lu(k,334) + lu(k,1475) = lu(k,1475) - lu(k,335) * lu(k,1473) + lu(k,1476) = lu(k,1476) - lu(k,336) * lu(k,1473) + lu(k,1480) = lu(k,1480) - lu(k,337) * lu(k,1473) + lu(k,1484) = lu(k,1484) - lu(k,338) * lu(k,1473) + lu(k,1560) = lu(k,1560) - lu(k,335) * lu(k,1557) + lu(k,1561) = lu(k,1561) - lu(k,336) * lu(k,1557) + lu(k,1566) = lu(k,1566) - lu(k,337) * lu(k,1557) + lu(k,1574) = lu(k,1574) - lu(k,338) * lu(k,1557) + lu(k,1585) = lu(k,1585) - lu(k,335) * lu(k,1583) + lu(k,1587) = lu(k,1587) - lu(k,336) * lu(k,1583) + lu(k,1592) = lu(k,1592) - lu(k,337) * lu(k,1583) + lu(k,1600) = lu(k,1600) - lu(k,338) * lu(k,1583) + lu(k,339) = 1._r8 / lu(k,339) + lu(k,340) = lu(k,340) * lu(k,339) + lu(k,341) = lu(k,341) * lu(k,339) + lu(k,342) = lu(k,342) * lu(k,339) + lu(k,343) = lu(k,343) * lu(k,339) + lu(k,448) = lu(k,448) - lu(k,340) * lu(k,447) + lu(k,449) = lu(k,449) - lu(k,341) * lu(k,447) + lu(k,450) = - lu(k,342) * lu(k,447) + lu(k,453) = lu(k,453) - lu(k,343) * lu(k,447) + lu(k,1729) = lu(k,1729) - lu(k,340) * lu(k,1714) + lu(k,1784) = lu(k,1784) - lu(k,341) * lu(k,1714) + lu(k,1818) = lu(k,1818) - lu(k,342) * lu(k,1714) + lu(k,1829) = lu(k,1829) - lu(k,343) * lu(k,1714) + lu(k,2291) = lu(k,2291) - lu(k,340) * lu(k,2280) + lu(k,2327) = lu(k,2327) - lu(k,341) * lu(k,2280) + lu(k,2357) = lu(k,2357) - lu(k,342) * lu(k,2280) + lu(k,2368) = lu(k,2368) - lu(k,343) * lu(k,2280) + lu(k,345) = 1._r8 / lu(k,345) + lu(k,346) = lu(k,346) * lu(k,345) + lu(k,347) = lu(k,347) * lu(k,345) + lu(k,348) = lu(k,348) * lu(k,345) + lu(k,349) = lu(k,349) * lu(k,345) + lu(k,435) = lu(k,435) - lu(k,346) * lu(k,434) + lu(k,436) = lu(k,436) - lu(k,347) * lu(k,434) + lu(k,437) = lu(k,437) - lu(k,348) * lu(k,434) + lu(k,440) = lu(k,440) - lu(k,349) * lu(k,434) + lu(k,1728) = lu(k,1728) - lu(k,346) * lu(k,1715) + lu(k,1739) = lu(k,1739) - lu(k,347) * lu(k,1715) + lu(k,1818) = lu(k,1818) - lu(k,348) * lu(k,1715) + lu(k,1829) = lu(k,1829) - lu(k,349) * lu(k,1715) + lu(k,2289) = lu(k,2289) - lu(k,346) * lu(k,2281) + lu(k,2300) = lu(k,2300) - lu(k,347) * lu(k,2281) + lu(k,2357) = lu(k,2357) - lu(k,348) * lu(k,2281) + lu(k,2368) = lu(k,2368) - lu(k,349) * lu(k,2281) + lu(k,350) = 1._r8 / lu(k,350) + lu(k,351) = lu(k,351) * lu(k,350) + lu(k,352) = lu(k,352) * lu(k,350) + lu(k,353) = lu(k,353) * lu(k,350) + lu(k,354) = lu(k,354) * lu(k,350) + lu(k,901) = lu(k,901) - lu(k,351) * lu(k,899) + lu(k,902) = lu(k,902) - lu(k,352) * lu(k,899) + lu(k,904) = lu(k,904) - lu(k,353) * lu(k,899) + lu(k,908) = lu(k,908) - lu(k,354) * lu(k,899) + lu(k,1773) = lu(k,1773) - lu(k,351) * lu(k,1716) + lu(k,1792) = lu(k,1792) - lu(k,352) * lu(k,1716) + lu(k,1818) = lu(k,1818) - lu(k,353) * lu(k,1716) + lu(k,1829) = lu(k,1829) - lu(k,354) * lu(k,1716) + lu(k,2322) = lu(k,2322) - lu(k,351) * lu(k,2282) + lu(k,2333) = lu(k,2333) - lu(k,352) * lu(k,2282) + lu(k,2357) = lu(k,2357) - lu(k,353) * lu(k,2282) + lu(k,2368) = lu(k,2368) - lu(k,354) * lu(k,2282) + lu(k,355) = 1._r8 / lu(k,355) + lu(k,356) = lu(k,356) * lu(k,355) + lu(k,357) = lu(k,357) * lu(k,355) + lu(k,358) = lu(k,358) * lu(k,355) + lu(k,359) = lu(k,359) * lu(k,355) + lu(k,360) = lu(k,360) * lu(k,355) + lu(k,361) = lu(k,361) * lu(k,355) + lu(k,362) = lu(k,362) * lu(k,355) + lu(k,1613) = - lu(k,356) * lu(k,1612) + lu(k,1624) = lu(k,1624) - lu(k,357) * lu(k,1612) + lu(k,1629) = lu(k,1629) - lu(k,358) * lu(k,1612) + lu(k,1652) = lu(k,1652) - lu(k,359) * lu(k,1612) + lu(k,1653) = lu(k,1653) - lu(k,360) * lu(k,1612) + lu(k,1655) = lu(k,1655) - lu(k,361) * lu(k,1612) + lu(k,1656) = lu(k,1656) - lu(k,362) * lu(k,1612) + lu(k,1744) = lu(k,1744) - lu(k,356) * lu(k,1717) + lu(k,1787) = lu(k,1787) - lu(k,357) * lu(k,1717) + lu(k,1792) = lu(k,1792) - lu(k,358) * lu(k,1717) + lu(k,1817) = lu(k,1817) - lu(k,359) * lu(k,1717) + lu(k,1818) = lu(k,1818) - lu(k,360) * lu(k,1717) + lu(k,1820) = lu(k,1820) - lu(k,361) * lu(k,1717) + lu(k,1821) = lu(k,1821) - lu(k,362) * lu(k,1717) + lu(k,363) = 1._r8 / lu(k,363) + lu(k,364) = lu(k,364) * lu(k,363) + lu(k,365) = lu(k,365) * lu(k,363) + lu(k,366) = lu(k,366) * lu(k,363) + lu(k,367) = lu(k,367) * lu(k,363) + lu(k,368) = lu(k,368) * lu(k,363) + lu(k,369) = lu(k,369) * lu(k,363) + lu(k,370) = lu(k,370) * lu(k,363) + lu(k,1760) = lu(k,1760) - lu(k,364) * lu(k,1718) + lu(k,1778) = lu(k,1778) - lu(k,365) * lu(k,1718) + lu(k,1793) = lu(k,1793) - lu(k,366) * lu(k,1718) + lu(k,1811) = lu(k,1811) - lu(k,367) * lu(k,1718) + lu(k,1818) = lu(k,1818) - lu(k,368) * lu(k,1718) + lu(k,1824) = lu(k,1824) - lu(k,369) * lu(k,1718) + lu(k,1825) = lu(k,1825) - lu(k,370) * lu(k,1718) + lu(k,2072) = - lu(k,364) * lu(k,2066) + lu(k,2080) = - lu(k,365) * lu(k,2066) + lu(k,2083) = lu(k,2083) - lu(k,366) * lu(k,2066) + lu(k,2086) = lu(k,2086) - lu(k,367) * lu(k,2066) + lu(k,2093) = lu(k,2093) - lu(k,368) * lu(k,2066) + lu(k,2099) = lu(k,2099) - lu(k,369) * lu(k,2066) + lu(k,2100) = lu(k,2100) - lu(k,370) * lu(k,2066) + lu(k,371) = 1._r8 / lu(k,371) + lu(k,372) = lu(k,372) * lu(k,371) + lu(k,373) = lu(k,373) * lu(k,371) + lu(k,374) = lu(k,374) * lu(k,371) + lu(k,375) = lu(k,375) * lu(k,371) + lu(k,376) = lu(k,376) * lu(k,371) + lu(k,377) = lu(k,377) * lu(k,371) + lu(k,378) = lu(k,378) * lu(k,371) + lu(k,1793) = lu(k,1793) - lu(k,372) * lu(k,1719) + lu(k,1812) = lu(k,1812) - lu(k,373) * lu(k,1719) + lu(k,1818) = lu(k,1818) - lu(k,374) * lu(k,1719) + lu(k,1826) = lu(k,1826) - lu(k,375) * lu(k,1719) + lu(k,1829) = lu(k,1829) - lu(k,376) * lu(k,1719) + lu(k,1830) = lu(k,1830) - lu(k,377) * lu(k,1719) + lu(k,1831) = lu(k,1831) - lu(k,378) * lu(k,1719) + lu(k,2147) = lu(k,2147) - lu(k,372) * lu(k,2132) + lu(k,2154) = lu(k,2154) - lu(k,373) * lu(k,2132) + lu(k,2160) = lu(k,2160) - lu(k,374) * lu(k,2132) + lu(k,2168) = lu(k,2168) - lu(k,375) * lu(k,2132) + lu(k,2171) = lu(k,2171) - lu(k,376) * lu(k,2132) + lu(k,2172) = lu(k,2172) - lu(k,377) * lu(k,2132) + lu(k,2173) = lu(k,2173) - lu(k,378) * lu(k,2132) + 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,379) = 1._r8 / lu(k,379) + lu(k,380) = lu(k,380) * lu(k,379) + lu(k,381) = lu(k,381) * lu(k,379) + lu(k,382) = lu(k,382) * lu(k,379) + lu(k,383) = lu(k,383) * lu(k,379) + lu(k,384) = lu(k,384) * lu(k,379) + lu(k,976) = - lu(k,380) * lu(k,972) + lu(k,982) = lu(k,982) - lu(k,381) * lu(k,972) + lu(k,984) = - lu(k,382) * lu(k,972) + lu(k,985) = lu(k,985) - lu(k,383) * lu(k,972) + lu(k,991) = lu(k,991) - lu(k,384) * lu(k,972) + lu(k,1020) = - lu(k,380) * lu(k,1016) + lu(k,1026) = lu(k,1026) - lu(k,381) * lu(k,1016) + lu(k,1028) = - lu(k,382) * lu(k,1016) + lu(k,1029) = lu(k,1029) - lu(k,383) * lu(k,1016) + lu(k,1035) = lu(k,1035) - lu(k,384) * lu(k,1016) + lu(k,2195) = - lu(k,380) * lu(k,2182) + lu(k,2203) = lu(k,2203) - lu(k,381) * lu(k,2182) + lu(k,2210) = lu(k,2210) - lu(k,382) * lu(k,2182) + lu(k,2216) = lu(k,2216) - lu(k,383) * lu(k,2182) + lu(k,2235) = lu(k,2235) - lu(k,384) * lu(k,2182) + lu(k,385) = 1._r8 / lu(k,385) + lu(k,386) = lu(k,386) * lu(k,385) + lu(k,387) = lu(k,387) * lu(k,385) + lu(k,388) = lu(k,388) * lu(k,385) + lu(k,389) = lu(k,389) * lu(k,385) + lu(k,390) = lu(k,390) * lu(k,385) + lu(k,1812) = lu(k,1812) - lu(k,386) * lu(k,1720) + lu(k,1813) = lu(k,1813) - lu(k,387) * lu(k,1720) + lu(k,1818) = lu(k,1818) - lu(k,388) * lu(k,1720) + lu(k,1822) = lu(k,1822) - lu(k,389) * lu(k,1720) + lu(k,1826) = lu(k,1826) - lu(k,390) * lu(k,1720) + lu(k,2021) = lu(k,2021) - lu(k,386) * lu(k,2015) + lu(k,2022) = lu(k,2022) - lu(k,387) * lu(k,2015) + lu(k,2027) = lu(k,2027) - lu(k,388) * lu(k,2015) + lu(k,2031) = lu(k,2031) - lu(k,389) * lu(k,2015) + lu(k,2035) = lu(k,2035) - lu(k,390) * lu(k,2015) + lu(k,2154) = lu(k,2154) - lu(k,386) * lu(k,2133) + lu(k,2155) = lu(k,2155) - lu(k,387) * lu(k,2133) + lu(k,2160) = lu(k,2160) - lu(k,388) * lu(k,2133) + lu(k,2164) = - lu(k,389) * lu(k,2133) + lu(k,2168) = lu(k,2168) - lu(k,390) * lu(k,2133) + lu(k,391) = 1._r8 / lu(k,391) + lu(k,392) = lu(k,392) * lu(k,391) + lu(k,393) = lu(k,393) * lu(k,391) + lu(k,394) = lu(k,394) * lu(k,391) + lu(k,395) = lu(k,395) * lu(k,391) + lu(k,396) = lu(k,396) * lu(k,391) + lu(k,1105) = lu(k,1105) - lu(k,392) * lu(k,1102) + lu(k,1106) = lu(k,1106) - lu(k,393) * lu(k,1102) + lu(k,1111) = - lu(k,394) * lu(k,1102) + lu(k,1113) = lu(k,1113) - lu(k,395) * lu(k,1102) + lu(k,1115) = - lu(k,396) * lu(k,1102) + lu(k,1786) = lu(k,1786) - lu(k,392) * lu(k,1721) + lu(k,1789) = lu(k,1789) - lu(k,393) * lu(k,1721) + lu(k,1818) = lu(k,1818) - lu(k,394) * lu(k,1721) + lu(k,1820) = lu(k,1820) - lu(k,395) * lu(k,1721) + lu(k,1823) = lu(k,1823) - lu(k,396) * lu(k,1721) + lu(k,2329) = - lu(k,392) * lu(k,2283) + lu(k,2331) = lu(k,2331) - lu(k,393) * lu(k,2283) + lu(k,2357) = lu(k,2357) - lu(k,394) * lu(k,2283) + lu(k,2359) = lu(k,2359) - lu(k,395) * lu(k,2283) + lu(k,2362) = - lu(k,396) * lu(k,2283) + lu(k,397) = 1._r8 / lu(k,397) + lu(k,398) = lu(k,398) * lu(k,397) + lu(k,399) = lu(k,399) * lu(k,397) + lu(k,400) = lu(k,400) * lu(k,397) + lu(k,401) = lu(k,401) * lu(k,397) + lu(k,402) = lu(k,402) * lu(k,397) + lu(k,1217) = lu(k,1217) - lu(k,398) * lu(k,1214) + lu(k,1219) = lu(k,1219) - lu(k,399) * lu(k,1214) + lu(k,1220) = lu(k,1220) - lu(k,400) * lu(k,1214) + lu(k,1223) = lu(k,1223) - lu(k,401) * lu(k,1214) + lu(k,1226) = - lu(k,402) * lu(k,1214) + lu(k,1798) = lu(k,1798) - lu(k,398) * lu(k,1722) + lu(k,1808) = lu(k,1808) - lu(k,399) * lu(k,1722) + lu(k,1818) = lu(k,1818) - lu(k,400) * lu(k,1722) + lu(k,1821) = lu(k,1821) - lu(k,401) * lu(k,1722) + lu(k,1831) = lu(k,1831) - lu(k,402) * lu(k,1722) + lu(k,2338) = lu(k,2338) - lu(k,398) * lu(k,2284) + lu(k,2348) = lu(k,2348) - lu(k,399) * lu(k,2284) + lu(k,2357) = lu(k,2357) - lu(k,400) * lu(k,2284) + lu(k,2360) = lu(k,2360) - lu(k,401) * lu(k,2284) + lu(k,2370) = lu(k,2370) - lu(k,402) * lu(k,2284) + lu(k,403) = 1._r8 / lu(k,403) + lu(k,404) = lu(k,404) * lu(k,403) + lu(k,405) = lu(k,405) * lu(k,403) + lu(k,406) = lu(k,406) * lu(k,403) + lu(k,407) = lu(k,407) * lu(k,403) + lu(k,408) = lu(k,408) * lu(k,403) + lu(k,1246) = - lu(k,404) * lu(k,1244) + lu(k,1248) = - lu(k,405) * lu(k,1244) + lu(k,1260) = - lu(k,406) * lu(k,1244) + lu(k,1262) = lu(k,1262) - lu(k,407) * lu(k,1244) + lu(k,1265) = lu(k,1265) - lu(k,408) * lu(k,1244) + lu(k,1759) = lu(k,1759) - lu(k,404) * lu(k,1723) + lu(k,1772) = lu(k,1772) - lu(k,405) * lu(k,1723) + lu(k,1818) = lu(k,1818) - lu(k,406) * lu(k,1723) + lu(k,1820) = lu(k,1820) - lu(k,407) * lu(k,1723) + lu(k,1829) = lu(k,1829) - lu(k,408) * lu(k,1723) + lu(k,2310) = lu(k,2310) - lu(k,404) * lu(k,2285) + lu(k,2321) = - lu(k,405) * lu(k,2285) + lu(k,2357) = lu(k,2357) - lu(k,406) * lu(k,2285) + lu(k,2359) = lu(k,2359) - lu(k,407) * lu(k,2285) + lu(k,2368) = lu(k,2368) - lu(k,408) * lu(k,2285) + lu(k,409) = 1._r8 / lu(k,409) + lu(k,410) = lu(k,410) * lu(k,409) + lu(k,411) = lu(k,411) * lu(k,409) + lu(k,412) = lu(k,412) * lu(k,409) + lu(k,413) = lu(k,413) * lu(k,409) + lu(k,414) = lu(k,414) * lu(k,409) + lu(k,935) = lu(k,935) - lu(k,410) * lu(k,934) + lu(k,936) = lu(k,936) - lu(k,411) * lu(k,934) + lu(k,939) = - lu(k,412) * lu(k,934) + lu(k,943) = lu(k,943) - lu(k,413) * lu(k,934) + lu(k,945) = - lu(k,414) * lu(k,934) + lu(k,1777) = lu(k,1777) - lu(k,410) * lu(k,1724) + lu(k,1787) = lu(k,1787) - lu(k,411) * lu(k,1724) + lu(k,1818) = lu(k,1818) - lu(k,412) * lu(k,1724) + lu(k,1829) = lu(k,1829) - lu(k,413) * lu(k,1724) + lu(k,1831) = lu(k,1831) - lu(k,414) * lu(k,1724) + lu(k,2325) = lu(k,2325) - lu(k,410) * lu(k,2286) + lu(k,2330) = - lu(k,411) * lu(k,2286) + lu(k,2357) = lu(k,2357) - lu(k,412) * lu(k,2286) + lu(k,2368) = lu(k,2368) - lu(k,413) * lu(k,2286) + lu(k,2370) = lu(k,2370) - lu(k,414) * lu(k,2286) + 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,415) = 1._r8 / lu(k,415) + lu(k,416) = lu(k,416) * lu(k,415) + lu(k,417) = lu(k,417) * lu(k,415) + lu(k,418) = lu(k,418) * lu(k,415) + lu(k,419) = lu(k,419) * lu(k,415) + lu(k,420) = lu(k,420) * lu(k,415) + lu(k,494) = lu(k,494) - lu(k,416) * lu(k,493) + lu(k,495) = lu(k,495) - lu(k,417) * lu(k,493) + lu(k,497) = lu(k,497) - lu(k,418) * lu(k,493) + lu(k,498) = - lu(k,419) * lu(k,493) + lu(k,501) = lu(k,501) - lu(k,420) * lu(k,493) + lu(k,1731) = lu(k,1731) - lu(k,416) * lu(k,1725) + lu(k,1736) = lu(k,1736) - lu(k,417) * lu(k,1725) + lu(k,1784) = lu(k,1784) - lu(k,418) * lu(k,1725) + lu(k,1818) = lu(k,1818) - lu(k,419) * lu(k,1725) + lu(k,1829) = lu(k,1829) - lu(k,420) * lu(k,1725) + lu(k,2294) = - lu(k,416) * lu(k,2287) + lu(k,2298) = lu(k,2298) - lu(k,417) * lu(k,2287) + lu(k,2327) = lu(k,2327) - lu(k,418) * lu(k,2287) + lu(k,2357) = lu(k,2357) - lu(k,419) * lu(k,2287) + lu(k,2368) = lu(k,2368) - lu(k,420) * lu(k,2287) + lu(k,421) = 1._r8 / lu(k,421) + lu(k,422) = lu(k,422) * lu(k,421) + lu(k,423) = lu(k,423) * lu(k,421) + lu(k,424) = lu(k,424) * lu(k,421) + lu(k,425) = lu(k,425) * lu(k,421) + lu(k,426) = lu(k,426) * lu(k,421) + lu(k,510) = lu(k,510) - lu(k,422) * lu(k,509) + lu(k,511) = lu(k,511) - lu(k,423) * lu(k,509) + lu(k,512) = lu(k,512) - lu(k,424) * lu(k,509) + lu(k,513) = - lu(k,425) * lu(k,509) + lu(k,516) = lu(k,516) - lu(k,426) * lu(k,509) + lu(k,1737) = lu(k,1737) - lu(k,422) * lu(k,1726) + lu(k,1784) = lu(k,1784) - lu(k,423) * lu(k,1726) + lu(k,1802) = lu(k,1802) - lu(k,424) * lu(k,1726) + lu(k,1818) = lu(k,1818) - lu(k,425) * lu(k,1726) + lu(k,1829) = lu(k,1829) - lu(k,426) * lu(k,1726) + lu(k,2299) = lu(k,2299) - lu(k,422) * lu(k,2288) + lu(k,2327) = lu(k,2327) - lu(k,423) * lu(k,2288) + lu(k,2342) = lu(k,2342) - lu(k,424) * lu(k,2288) + lu(k,2357) = lu(k,2357) - lu(k,425) * lu(k,2288) + lu(k,2368) = lu(k,2368) - lu(k,426) * lu(k,2288) + lu(k,427) = 1._r8 / lu(k,427) + lu(k,428) = lu(k,428) * lu(k,427) + lu(k,429) = lu(k,429) * lu(k,427) + lu(k,430) = lu(k,430) * lu(k,427) + lu(k,431) = lu(k,431) * lu(k,427) + lu(k,432) = lu(k,432) * lu(k,427) + lu(k,1248) = lu(k,1248) - lu(k,428) * lu(k,1245) + lu(k,1251) = - lu(k,429) * lu(k,1245) + lu(k,1260) = lu(k,1260) - lu(k,430) * lu(k,1245) + lu(k,1264) = - lu(k,431) * lu(k,1245) + lu(k,1265) = lu(k,1265) - lu(k,432) * lu(k,1245) + lu(k,1772) = lu(k,1772) - lu(k,428) * lu(k,1727) + lu(k,1794) = lu(k,1794) - lu(k,429) * lu(k,1727) + lu(k,1818) = lu(k,1818) - lu(k,430) * lu(k,1727) + lu(k,1823) = lu(k,1823) - lu(k,431) * lu(k,1727) + lu(k,1829) = lu(k,1829) - lu(k,432) * lu(k,1727) + lu(k,2378) = - lu(k,428) * lu(k,2373) + lu(k,2390) = lu(k,2390) - lu(k,429) * lu(k,2373) + lu(k,2409) = lu(k,2409) - lu(k,430) * lu(k,2373) + lu(k,2414) = - lu(k,431) * lu(k,2373) + lu(k,2420) = lu(k,2420) - lu(k,432) * lu(k,2373) + lu(k,435) = 1._r8 / lu(k,435) + lu(k,436) = lu(k,436) * lu(k,435) + lu(k,437) = lu(k,437) * lu(k,435) + lu(k,438) = lu(k,438) * lu(k,435) + lu(k,439) = lu(k,439) * lu(k,435) + lu(k,440) = lu(k,440) * lu(k,435) + lu(k,1739) = lu(k,1739) - lu(k,436) * lu(k,1728) + lu(k,1818) = lu(k,1818) - lu(k,437) * lu(k,1728) + lu(k,1819) = lu(k,1819) - lu(k,438) * lu(k,1728) + lu(k,1820) = lu(k,1820) - lu(k,439) * lu(k,1728) + lu(k,1829) = lu(k,1829) - lu(k,440) * lu(k,1728) + lu(k,1858) = lu(k,1858) - lu(k,436) * lu(k,1849) + lu(k,1913) = lu(k,1913) - lu(k,437) * lu(k,1849) + lu(k,1914) = lu(k,1914) - lu(k,438) * lu(k,1849) + lu(k,1915) = lu(k,1915) - lu(k,439) * lu(k,1849) + lu(k,1924) = lu(k,1924) - lu(k,440) * lu(k,1849) + lu(k,2300) = lu(k,2300) - lu(k,436) * lu(k,2289) + lu(k,2357) = lu(k,2357) - lu(k,437) * lu(k,2289) + lu(k,2358) = lu(k,2358) - lu(k,438) * lu(k,2289) + lu(k,2359) = lu(k,2359) - lu(k,439) * lu(k,2289) + lu(k,2368) = lu(k,2368) - lu(k,440) * lu(k,2289) + lu(k,441) = 1._r8 / lu(k,441) + lu(k,442) = lu(k,442) * lu(k,441) + lu(k,443) = lu(k,443) * lu(k,441) + lu(k,444) = lu(k,444) * lu(k,441) + lu(k,445) = lu(k,445) * lu(k,441) + lu(k,446) = lu(k,446) * lu(k,441) + lu(k,1879) = lu(k,1879) - lu(k,442) * lu(k,1850) + lu(k,1914) = lu(k,1914) - lu(k,443) * lu(k,1850) + lu(k,1915) = lu(k,1915) - lu(k,444) * lu(k,1850) + lu(k,1916) = lu(k,1916) - lu(k,445) * lu(k,1850) + lu(k,1924) = lu(k,1924) - lu(k,446) * lu(k,1850) + lu(k,1974) = - lu(k,442) * lu(k,1972) + lu(k,1985) = - lu(k,443) * lu(k,1972) + lu(k,1986) = - lu(k,444) * lu(k,1972) + lu(k,1987) = lu(k,1987) - lu(k,445) * lu(k,1972) + lu(k,1995) = lu(k,1995) - lu(k,446) * lu(k,1972) + lu(k,2324) = lu(k,2324) - lu(k,442) * lu(k,2290) + lu(k,2358) = lu(k,2358) - lu(k,443) * lu(k,2290) + lu(k,2359) = lu(k,2359) - lu(k,444) * lu(k,2290) + lu(k,2360) = lu(k,2360) - lu(k,445) * lu(k,2290) + lu(k,2368) = lu(k,2368) - lu(k,446) * lu(k,2290) + 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,1784) = lu(k,1784) - lu(k,449) * lu(k,1729) + lu(k,1818) = lu(k,1818) - lu(k,450) * lu(k,1729) + lu(k,1819) = lu(k,1819) - lu(k,451) * lu(k,1729) + lu(k,1820) = lu(k,1820) - lu(k,452) * lu(k,1729) + lu(k,1829) = lu(k,1829) - lu(k,453) * lu(k,1729) + lu(k,1883) = lu(k,1883) - lu(k,449) * lu(k,1851) + lu(k,1913) = lu(k,1913) - lu(k,450) * lu(k,1851) + lu(k,1914) = lu(k,1914) - lu(k,451) * lu(k,1851) + lu(k,1915) = lu(k,1915) - lu(k,452) * lu(k,1851) + lu(k,1924) = lu(k,1924) - lu(k,453) * lu(k,1851) + lu(k,2327) = lu(k,2327) - lu(k,449) * lu(k,2291) + lu(k,2357) = lu(k,2357) - lu(k,450) * lu(k,2291) + lu(k,2358) = lu(k,2358) - lu(k,451) * lu(k,2291) + lu(k,2359) = lu(k,2359) - lu(k,452) * lu(k,2291) + lu(k,2368) = lu(k,2368) - lu(k,453) * lu(k,2291) + lu(k,454) = 1._r8 / lu(k,454) + lu(k,455) = lu(k,455) * lu(k,454) + lu(k,456) = lu(k,456) * lu(k,454) + lu(k,457) = lu(k,457) * lu(k,454) + lu(k,458) = lu(k,458) * lu(k,454) + lu(k,459) = lu(k,459) * lu(k,454) + lu(k,1818) = lu(k,1818) - lu(k,455) * lu(k,1730) + lu(k,1821) = lu(k,1821) - lu(k,456) * lu(k,1730) + lu(k,1825) = lu(k,1825) - lu(k,457) * lu(k,1730) + lu(k,1830) = lu(k,1830) - lu(k,458) * lu(k,1730) + lu(k,1831) = lu(k,1831) - lu(k,459) * lu(k,1730) + lu(k,2357) = lu(k,2357) - lu(k,455) * lu(k,2292) + lu(k,2360) = lu(k,2360) - lu(k,456) * lu(k,2292) + lu(k,2364) = lu(k,2364) - lu(k,457) * lu(k,2292) + lu(k,2369) = lu(k,2369) - lu(k,458) * lu(k,2292) + lu(k,2370) = lu(k,2370) - lu(k,459) * lu(k,2292) + lu(k,2409) = lu(k,2409) - lu(k,455) * lu(k,2374) + lu(k,2412) = lu(k,2412) - lu(k,456) * lu(k,2374) + lu(k,2416) = - lu(k,457) * lu(k,2374) + lu(k,2421) = lu(k,2421) - lu(k,458) * lu(k,2374) + lu(k,2422) = - lu(k,459) * lu(k,2374) + 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,460) = 1._r8 / lu(k,460) + lu(k,461) = lu(k,461) * lu(k,460) + lu(k,462) = lu(k,462) * lu(k,460) + lu(k,463) = lu(k,463) * lu(k,460) + lu(k,464) = lu(k,464) * lu(k,460) + lu(k,798) = - lu(k,461) * lu(k,796) + lu(k,799) = - lu(k,462) * lu(k,796) + lu(k,803) = lu(k,803) - lu(k,463) * lu(k,796) + lu(k,804) = lu(k,804) - lu(k,464) * lu(k,796) + lu(k,1538) = lu(k,1538) - lu(k,461) * lu(k,1526) + lu(k,1542) = lu(k,1542) - lu(k,462) * lu(k,1526) + lu(k,1548) = - lu(k,463) * lu(k,1526) + lu(k,1554) = lu(k,1554) - lu(k,464) * lu(k,1526) + lu(k,1892) = lu(k,1892) - lu(k,461) * lu(k,1852) + lu(k,1909) = lu(k,1909) - lu(k,462) * lu(k,1852) + lu(k,1916) = lu(k,1916) - lu(k,463) * lu(k,1852) + lu(k,1924) = lu(k,1924) - lu(k,464) * lu(k,1852) + lu(k,2335) = - lu(k,461) * lu(k,2293) + lu(k,2353) = lu(k,2353) - lu(k,462) * lu(k,2293) + lu(k,2360) = lu(k,2360) - lu(k,463) * lu(k,2293) + lu(k,2368) = lu(k,2368) - lu(k,464) * lu(k,2293) + lu(k,465) = 1._r8 / lu(k,465) + lu(k,466) = lu(k,466) * lu(k,465) + lu(k,467) = lu(k,467) * lu(k,465) + lu(k,496) = - lu(k,466) * lu(k,494) + lu(k,501) = lu(k,501) - lu(k,467) * lu(k,494) + lu(k,666) = - lu(k,466) * lu(k,663) + lu(k,674) = lu(k,674) - lu(k,467) * lu(k,663) + lu(k,730) = - lu(k,466) * lu(k,727) + lu(k,739) = lu(k,739) - lu(k,467) * lu(k,727) + lu(k,750) = - lu(k,466) * lu(k,747) + lu(k,760) = lu(k,760) - lu(k,467) * lu(k,747) + lu(k,766) = - lu(k,466) * lu(k,763) + lu(k,777) = lu(k,777) - lu(k,467) * lu(k,763) + lu(k,1762) = - lu(k,466) * lu(k,1731) + lu(k,1829) = lu(k,1829) - lu(k,467) * lu(k,1731) + lu(k,1867) = lu(k,1867) - lu(k,466) * lu(k,1853) + lu(k,1924) = lu(k,1924) - lu(k,467) * lu(k,1853) + lu(k,2312) = lu(k,2312) - lu(k,466) * lu(k,2294) + lu(k,2368) = lu(k,2368) - lu(k,467) * lu(k,2294) + lu(k,468) = 1._r8 / lu(k,468) + lu(k,469) = lu(k,469) * lu(k,468) + lu(k,470) = lu(k,470) * lu(k,468) + lu(k,471) = lu(k,471) * lu(k,468) + lu(k,635) = lu(k,635) - lu(k,469) * lu(k,634) + lu(k,638) = lu(k,638) - lu(k,470) * lu(k,634) + lu(k,639) = - lu(k,471) * lu(k,634) + lu(k,1752) = lu(k,1752) - lu(k,469) * lu(k,1732) + lu(k,1820) = lu(k,1820) - lu(k,470) * lu(k,1732) + lu(k,1827) = lu(k,1827) - lu(k,471) * lu(k,1732) + lu(k,1864) = lu(k,1864) - lu(k,469) * lu(k,1854) + lu(k,1915) = lu(k,1915) - lu(k,470) * lu(k,1854) + lu(k,1922) = lu(k,1922) - lu(k,471) * lu(k,1854) + lu(k,1936) = - lu(k,469) * lu(k,1930) + lu(k,1960) = lu(k,1960) - lu(k,470) * lu(k,1930) + lu(k,1967) = lu(k,1967) - lu(k,471) * lu(k,1930) + lu(k,2185) = lu(k,2185) - lu(k,469) * lu(k,2183) + lu(k,2226) = lu(k,2226) - lu(k,470) * lu(k,2183) + lu(k,2233) = lu(k,2233) - lu(k,471) * lu(k,2183) + lu(k,2304) = lu(k,2304) - lu(k,469) * lu(k,2295) + lu(k,2359) = lu(k,2359) - lu(k,470) * lu(k,2295) + lu(k,2366) = lu(k,2366) - lu(k,471) * lu(k,2295) + lu(k,472) = 1._r8 / lu(k,472) + lu(k,473) = lu(k,473) * lu(k,472) + lu(k,474) = lu(k,474) * lu(k,472) + lu(k,475) = lu(k,475) * lu(k,472) + lu(k,476) = lu(k,476) * lu(k,472) + lu(k,477) = lu(k,477) * lu(k,472) + lu(k,478) = lu(k,478) * lu(k,472) + lu(k,1814) = lu(k,1814) - lu(k,473) * lu(k,1733) + lu(k,1817) = lu(k,1817) - lu(k,474) * lu(k,1733) + lu(k,1818) = lu(k,1818) - lu(k,475) * lu(k,1733) + lu(k,1820) = lu(k,1820) - lu(k,476) * lu(k,1733) + lu(k,1829) = lu(k,1829) - lu(k,477) * lu(k,1733) + lu(k,1831) = lu(k,1831) - lu(k,478) * lu(k,1733) + lu(k,1954) = lu(k,1954) - lu(k,473) * lu(k,1931) + lu(k,1957) = lu(k,1957) - lu(k,474) * lu(k,1931) + lu(k,1958) = lu(k,1958) - lu(k,475) * lu(k,1931) + lu(k,1960) = lu(k,1960) - lu(k,476) * lu(k,1931) + lu(k,1969) = lu(k,1969) - lu(k,477) * lu(k,1931) + lu(k,1971) = - lu(k,478) * lu(k,1931) + lu(k,2353) = lu(k,2353) - lu(k,473) * lu(k,2296) + lu(k,2356) = lu(k,2356) - lu(k,474) * lu(k,2296) + lu(k,2357) = lu(k,2357) - lu(k,475) * lu(k,2296) + lu(k,2359) = lu(k,2359) - lu(k,476) * lu(k,2296) + lu(k,2368) = lu(k,2368) - lu(k,477) * lu(k,2296) + lu(k,2370) = lu(k,2370) - lu(k,478) * lu(k,2296) + lu(k,479) = 1._r8 / lu(k,479) + lu(k,480) = lu(k,480) * lu(k,479) + lu(k,481) = lu(k,481) * lu(k,479) + lu(k,482) = lu(k,482) * lu(k,479) + lu(k,483) = lu(k,483) * lu(k,479) + lu(k,484) = lu(k,484) * lu(k,479) + lu(k,485) = lu(k,485) * lu(k,479) + lu(k,1812) = lu(k,1812) - lu(k,480) * lu(k,1734) + lu(k,1813) = lu(k,1813) - lu(k,481) * lu(k,1734) + lu(k,1818) = lu(k,1818) - lu(k,482) * lu(k,1734) + lu(k,1822) = lu(k,1822) - lu(k,483) * lu(k,1734) + lu(k,1826) = lu(k,1826) - lu(k,484) * lu(k,1734) + lu(k,1831) = lu(k,1831) - lu(k,485) * lu(k,1734) + lu(k,2021) = lu(k,2021) - lu(k,480) * lu(k,2016) + lu(k,2022) = lu(k,2022) - lu(k,481) * lu(k,2016) + lu(k,2027) = lu(k,2027) - lu(k,482) * lu(k,2016) + lu(k,2031) = lu(k,2031) - lu(k,483) * lu(k,2016) + lu(k,2035) = lu(k,2035) - lu(k,484) * lu(k,2016) + lu(k,2040) = lu(k,2040) - lu(k,485) * lu(k,2016) + lu(k,2154) = lu(k,2154) - lu(k,480) * lu(k,2134) + lu(k,2155) = lu(k,2155) - lu(k,481) * lu(k,2134) + lu(k,2160) = lu(k,2160) - lu(k,482) * lu(k,2134) + lu(k,2164) = lu(k,2164) - lu(k,483) * lu(k,2134) + lu(k,2168) = lu(k,2168) - lu(k,484) * lu(k,2134) + lu(k,2173) = lu(k,2173) - lu(k,485) * lu(k,2134) + lu(k,486) = 1._r8 / lu(k,486) + lu(k,487) = lu(k,487) * lu(k,486) + lu(k,488) = lu(k,488) * lu(k,486) + lu(k,489) = lu(k,489) * lu(k,486) + lu(k,490) = lu(k,490) * lu(k,486) + lu(k,491) = lu(k,491) * lu(k,486) + lu(k,492) = lu(k,492) * lu(k,486) + lu(k,1062) = lu(k,1062) - lu(k,487) * lu(k,1059) + lu(k,1063) = lu(k,1063) - lu(k,488) * lu(k,1059) + lu(k,1064) = lu(k,1064) - lu(k,489) * lu(k,1059) + lu(k,1065) = - lu(k,490) * lu(k,1059) + lu(k,1068) = lu(k,1068) - lu(k,491) * lu(k,1059) + lu(k,1070) = lu(k,1070) - lu(k,492) * lu(k,1059) + lu(k,1785) = lu(k,1785) - lu(k,487) * lu(k,1735) + lu(k,1786) = lu(k,1786) - lu(k,488) * lu(k,1735) + lu(k,1787) = lu(k,1787) - lu(k,489) * lu(k,1735) + lu(k,1818) = lu(k,1818) - lu(k,490) * lu(k,1735) + lu(k,1821) = lu(k,1821) - lu(k,491) * lu(k,1735) + lu(k,1829) = lu(k,1829) - lu(k,492) * lu(k,1735) + lu(k,2328) = lu(k,2328) - lu(k,487) * lu(k,2297) + lu(k,2329) = lu(k,2329) - lu(k,488) * lu(k,2297) + lu(k,2330) = lu(k,2330) - lu(k,489) * lu(k,2297) + lu(k,2357) = lu(k,2357) - lu(k,490) * lu(k,2297) + lu(k,2360) = lu(k,2360) - lu(k,491) * lu(k,2297) + lu(k,2368) = lu(k,2368) - lu(k,492) * lu(k,2297) + lu(k,495) = 1._r8 / lu(k,495) + lu(k,496) = lu(k,496) * lu(k,495) + lu(k,497) = lu(k,497) * lu(k,495) + lu(k,498) = lu(k,498) * lu(k,495) + lu(k,499) = lu(k,499) * lu(k,495) + lu(k,500) = lu(k,500) * lu(k,495) + lu(k,501) = lu(k,501) * lu(k,495) + lu(k,1762) = lu(k,1762) - lu(k,496) * lu(k,1736) + lu(k,1784) = lu(k,1784) - lu(k,497) * lu(k,1736) + lu(k,1818) = lu(k,1818) - lu(k,498) * lu(k,1736) + lu(k,1819) = lu(k,1819) - lu(k,499) * lu(k,1736) + lu(k,1820) = lu(k,1820) - lu(k,500) * lu(k,1736) + lu(k,1829) = lu(k,1829) - lu(k,501) * lu(k,1736) + lu(k,1867) = lu(k,1867) - lu(k,496) * lu(k,1855) + lu(k,1883) = lu(k,1883) - lu(k,497) * lu(k,1855) + lu(k,1913) = lu(k,1913) - lu(k,498) * lu(k,1855) + lu(k,1914) = lu(k,1914) - lu(k,499) * lu(k,1855) + lu(k,1915) = lu(k,1915) - lu(k,500) * lu(k,1855) + lu(k,1924) = lu(k,1924) - lu(k,501) * lu(k,1855) + lu(k,2312) = lu(k,2312) - lu(k,496) * lu(k,2298) + lu(k,2327) = lu(k,2327) - lu(k,497) * lu(k,2298) + lu(k,2357) = lu(k,2357) - lu(k,498) * lu(k,2298) + lu(k,2358) = lu(k,2358) - lu(k,499) * lu(k,2298) + lu(k,2359) = lu(k,2359) - lu(k,500) * lu(k,2298) + lu(k,2368) = lu(k,2368) - lu(k,501) * lu(k,2298) + 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,502) = 1._r8 / lu(k,502) + lu(k,503) = lu(k,503) * lu(k,502) + lu(k,504) = lu(k,504) * lu(k,502) + lu(k,505) = lu(k,505) * lu(k,502) + lu(k,506) = lu(k,506) * lu(k,502) + lu(k,507) = lu(k,507) * lu(k,502) + lu(k,508) = lu(k,508) * lu(k,502) + lu(k,995) = - lu(k,503) * lu(k,994) + lu(k,996) = lu(k,996) - lu(k,504) * lu(k,994) + lu(k,997) = lu(k,997) - lu(k,505) * lu(k,994) + lu(k,999) = lu(k,999) - lu(k,506) * lu(k,994) + lu(k,1002) = lu(k,1002) - lu(k,507) * lu(k,994) + lu(k,1007) = lu(k,1007) - lu(k,508) * lu(k,994) + lu(k,1531) = lu(k,1531) - lu(k,503) * lu(k,1527) + lu(k,1532) = lu(k,1532) - lu(k,504) * lu(k,1527) + lu(k,1533) = lu(k,1533) - lu(k,505) * lu(k,1527) + lu(k,1536) = lu(k,1536) - lu(k,506) * lu(k,1527) + lu(k,1542) = lu(k,1542) - lu(k,507) * lu(k,1527) + lu(k,1550) = lu(k,1550) - lu(k,508) * lu(k,1527) + lu(k,2074) = lu(k,2074) - lu(k,503) * lu(k,2067) + lu(k,2077) = lu(k,2077) - lu(k,504) * lu(k,2067) + lu(k,2078) = - lu(k,505) * lu(k,2067) + lu(k,2082) = lu(k,2082) - lu(k,506) * lu(k,2067) + lu(k,2089) = lu(k,2089) - lu(k,507) * lu(k,2067) + lu(k,2099) = lu(k,2099) - lu(k,508) * lu(k,2067) + 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,514) = lu(k,514) * lu(k,510) + lu(k,515) = lu(k,515) * lu(k,510) + lu(k,516) = lu(k,516) * lu(k,510) + lu(k,1784) = lu(k,1784) - lu(k,511) * lu(k,1737) + lu(k,1802) = lu(k,1802) - lu(k,512) * lu(k,1737) + lu(k,1818) = lu(k,1818) - lu(k,513) * lu(k,1737) + lu(k,1819) = lu(k,1819) - lu(k,514) * lu(k,1737) + lu(k,1820) = lu(k,1820) - lu(k,515) * lu(k,1737) + lu(k,1829) = lu(k,1829) - lu(k,516) * lu(k,1737) + lu(k,1883) = lu(k,1883) - lu(k,511) * lu(k,1856) + lu(k,1900) = lu(k,1900) - lu(k,512) * lu(k,1856) + lu(k,1913) = lu(k,1913) - lu(k,513) * lu(k,1856) + lu(k,1914) = lu(k,1914) - lu(k,514) * lu(k,1856) + lu(k,1915) = lu(k,1915) - lu(k,515) * lu(k,1856) + lu(k,1924) = lu(k,1924) - lu(k,516) * lu(k,1856) + lu(k,2327) = lu(k,2327) - lu(k,511) * lu(k,2299) + lu(k,2342) = lu(k,2342) - lu(k,512) * lu(k,2299) + lu(k,2357) = lu(k,2357) - lu(k,513) * lu(k,2299) + lu(k,2358) = lu(k,2358) - lu(k,514) * lu(k,2299) + lu(k,2359) = lu(k,2359) - lu(k,515) * lu(k,2299) + lu(k,2368) = lu(k,2368) - lu(k,516) * lu(k,2299) + lu(k,517) = 1._r8 / lu(k,517) + lu(k,518) = lu(k,518) * lu(k,517) + lu(k,519) = lu(k,519) * lu(k,517) + lu(k,520) = lu(k,520) * lu(k,517) + lu(k,521) = lu(k,521) * lu(k,517) + lu(k,643) = - lu(k,518) * lu(k,641) + lu(k,644) = - lu(k,519) * lu(k,641) + lu(k,647) = - lu(k,520) * lu(k,641) + lu(k,648) = lu(k,648) - lu(k,521) * lu(k,641) + lu(k,688) = - lu(k,518) * lu(k,686) + lu(k,689) = - lu(k,519) * lu(k,686) + lu(k,693) = - lu(k,520) * lu(k,686) + lu(k,694) = lu(k,694) - lu(k,521) * lu(k,686) + lu(k,1040) = - lu(k,518) * lu(k,1037) + lu(k,1041) = - lu(k,519) * lu(k,1037) + lu(k,1045) = - lu(k,520) * lu(k,1037) + lu(k,1047) = - lu(k,521) * lu(k,1037) + lu(k,1757) = lu(k,1757) - lu(k,518) * lu(k,1738) + lu(k,1773) = lu(k,1773) - lu(k,519) * lu(k,1738) + lu(k,1808) = lu(k,1808) - lu(k,520) * lu(k,1738) + lu(k,1818) = lu(k,1818) - lu(k,521) * lu(k,1738) + lu(k,1866) = lu(k,1866) - lu(k,518) * lu(k,1857) + lu(k,1877) = lu(k,1877) - lu(k,519) * lu(k,1857) + lu(k,1906) = lu(k,1906) - lu(k,520) * lu(k,1857) + lu(k,1913) = lu(k,1913) - lu(k,521) * lu(k,1857) + lu(k,523) = 1._r8 / lu(k,523) + lu(k,524) = lu(k,524) * lu(k,523) + lu(k,525) = lu(k,525) * lu(k,523) + lu(k,526) = lu(k,526) * lu(k,523) + lu(k,527) = lu(k,527) * lu(k,523) + lu(k,528) = lu(k,528) * lu(k,523) + lu(k,1752) = lu(k,1752) - lu(k,524) * lu(k,1739) + lu(k,1818) = lu(k,1818) - lu(k,525) * lu(k,1739) + lu(k,1819) = lu(k,1819) - lu(k,526) * lu(k,1739) + lu(k,1820) = lu(k,1820) - lu(k,527) * lu(k,1739) + lu(k,1829) = lu(k,1829) - lu(k,528) * lu(k,1739) + lu(k,1864) = lu(k,1864) - lu(k,524) * lu(k,1858) + lu(k,1913) = lu(k,1913) - lu(k,525) * lu(k,1858) + lu(k,1914) = lu(k,1914) - lu(k,526) * lu(k,1858) + lu(k,1915) = lu(k,1915) - lu(k,527) * lu(k,1858) + lu(k,1924) = lu(k,1924) - lu(k,528) * lu(k,1858) + lu(k,1936) = lu(k,1936) - lu(k,524) * lu(k,1932) + lu(k,1958) = lu(k,1958) - lu(k,525) * lu(k,1932) + lu(k,1959) = lu(k,1959) - lu(k,526) * lu(k,1932) + lu(k,1960) = lu(k,1960) - lu(k,527) * lu(k,1932) + lu(k,1969) = lu(k,1969) - lu(k,528) * lu(k,1932) + lu(k,2304) = lu(k,2304) - lu(k,524) * lu(k,2300) + lu(k,2357) = lu(k,2357) - lu(k,525) * lu(k,2300) + lu(k,2358) = lu(k,2358) - lu(k,526) * lu(k,2300) + lu(k,2359) = lu(k,2359) - lu(k,527) * lu(k,2300) + lu(k,2368) = lu(k,2368) - lu(k,528) * lu(k,2300) + lu(k,529) = 1._r8 / lu(k,529) + lu(k,530) = lu(k,530) * lu(k,529) + lu(k,531) = lu(k,531) * lu(k,529) + lu(k,532) = lu(k,532) * lu(k,529) + lu(k,533) = lu(k,533) * lu(k,529) + lu(k,681) = lu(k,681) - lu(k,530) * lu(k,675) + lu(k,682) = lu(k,682) - lu(k,531) * lu(k,675) + lu(k,683) = - lu(k,532) * lu(k,675) + lu(k,684) = - lu(k,533) * lu(k,675) + lu(k,847) = lu(k,847) - lu(k,530) * lu(k,844) + lu(k,848) = - lu(k,531) * lu(k,844) + lu(k,849) = - lu(k,532) * lu(k,844) + lu(k,850) = - lu(k,533) * lu(k,844) + lu(k,866) = lu(k,866) - lu(k,530) * lu(k,860) + lu(k,869) = - lu(k,531) * lu(k,860) + lu(k,870) = - lu(k,532) * lu(k,860) + lu(k,871) = lu(k,871) - lu(k,533) * lu(k,860) + lu(k,1536) = lu(k,1536) - lu(k,530) * lu(k,1528) + lu(k,1542) = lu(k,1542) - lu(k,531) * lu(k,1528) + lu(k,1546) = lu(k,1546) - lu(k,532) * lu(k,1528) + lu(k,1549) = lu(k,1549) - lu(k,533) * lu(k,1528) + lu(k,2082) = lu(k,2082) - lu(k,530) * lu(k,2068) + lu(k,2089) = lu(k,2089) - lu(k,531) * lu(k,2068) + lu(k,2094) = lu(k,2094) - lu(k,532) * lu(k,2068) + lu(k,2097) = - lu(k,533) * lu(k,2068) + lu(k,534) = 1._r8 / lu(k,534) + lu(k,535) = lu(k,535) * lu(k,534) + lu(k,536) = lu(k,536) * lu(k,534) + lu(k,537) = lu(k,537) * lu(k,534) + lu(k,538) = lu(k,538) * lu(k,534) + lu(k,539) = lu(k,539) * lu(k,534) + lu(k,540) = lu(k,540) * lu(k,534) + lu(k,541) = lu(k,541) * lu(k,534) + lu(k,1428) = lu(k,1428) - lu(k,535) * lu(k,1411) + lu(k,1429) = lu(k,1429) - lu(k,536) * lu(k,1411) + lu(k,1431) = - lu(k,537) * lu(k,1411) + lu(k,1432) = lu(k,1432) - lu(k,538) * lu(k,1411) + lu(k,1434) = lu(k,1434) - lu(k,539) * lu(k,1411) + lu(k,1435) = lu(k,1435) - lu(k,540) * lu(k,1411) + lu(k,1440) = lu(k,1440) - lu(k,541) * lu(k,1411) + lu(k,1808) = lu(k,1808) - lu(k,535) * lu(k,1740) + lu(k,1809) = lu(k,1809) - lu(k,536) * lu(k,1740) + lu(k,1817) = lu(k,1817) - lu(k,537) * lu(k,1740) + lu(k,1818) = lu(k,1818) - lu(k,538) * lu(k,1740) + lu(k,1820) = lu(k,1820) - lu(k,539) * lu(k,1740) + lu(k,1821) = lu(k,1821) - lu(k,540) * lu(k,1740) + lu(k,1830) = lu(k,1830) - lu(k,541) * lu(k,1740) + lu(k,1949) = lu(k,1949) - lu(k,535) * lu(k,1933) + lu(k,1950) = - lu(k,536) * lu(k,1933) + lu(k,1957) = lu(k,1957) - lu(k,537) * lu(k,1933) + lu(k,1958) = lu(k,1958) - lu(k,538) * lu(k,1933) + lu(k,1960) = lu(k,1960) - lu(k,539) * lu(k,1933) + lu(k,1961) = - lu(k,540) * lu(k,1933) + lu(k,1970) = - lu(k,541) * lu(k,1933) + 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,542) = 1._r8 / lu(k,542) + lu(k,543) = lu(k,543) * lu(k,542) + lu(k,544) = lu(k,544) * lu(k,542) + lu(k,545) = lu(k,545) * lu(k,542) + lu(k,546) = lu(k,546) * lu(k,542) + lu(k,547) = lu(k,547) * lu(k,542) + lu(k,548) = lu(k,548) * lu(k,542) + lu(k,549) = lu(k,549) * lu(k,542) + lu(k,814) = lu(k,814) - lu(k,543) * lu(k,813) + lu(k,815) = lu(k,815) - lu(k,544) * lu(k,813) + lu(k,816) = - lu(k,545) * lu(k,813) + lu(k,818) = - lu(k,546) * lu(k,813) + lu(k,821) = lu(k,821) - lu(k,547) * lu(k,813) + lu(k,822) = lu(k,822) - lu(k,548) * lu(k,813) + lu(k,823) = - lu(k,549) * lu(k,813) + lu(k,1767) = lu(k,1767) - lu(k,543) * lu(k,1741) + lu(k,1792) = lu(k,1792) - lu(k,544) * lu(k,1741) + lu(k,1797) = lu(k,1797) - lu(k,545) * lu(k,1741) + lu(k,1818) = lu(k,1818) - lu(k,546) * lu(k,1741) + lu(k,1821) = lu(k,1821) - lu(k,547) * lu(k,1741) + lu(k,1829) = lu(k,1829) - lu(k,548) * lu(k,1741) + lu(k,1831) = lu(k,1831) - lu(k,549) * lu(k,1741) + lu(k,2318) = lu(k,2318) - lu(k,543) * lu(k,2301) + lu(k,2333) = lu(k,2333) - lu(k,544) * lu(k,2301) + lu(k,2337) = - lu(k,545) * lu(k,2301) + lu(k,2357) = lu(k,2357) - lu(k,546) * lu(k,2301) + lu(k,2360) = lu(k,2360) - lu(k,547) * lu(k,2301) + lu(k,2368) = lu(k,2368) - lu(k,548) * lu(k,2301) + lu(k,2370) = lu(k,2370) - lu(k,549) * lu(k,2301) + 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,1766) = lu(k,1766) - lu(k,551) * lu(k,1742) + lu(k,1775) = lu(k,1775) - lu(k,552) * lu(k,1742) + lu(k,1793) = lu(k,1793) - lu(k,553) * lu(k,1742) + lu(k,1818) = lu(k,1818) - lu(k,554) * lu(k,1742) + lu(k,1821) = lu(k,1821) - lu(k,555) * lu(k,1742) + lu(k,1827) = lu(k,1827) - lu(k,556) * lu(k,1742) + lu(k,1829) = lu(k,1829) - lu(k,557) * lu(k,1742) + lu(k,2138) = - lu(k,551) * lu(k,2135) + lu(k,2141) = lu(k,2141) - lu(k,552) * lu(k,2135) + lu(k,2147) = lu(k,2147) - lu(k,553) * lu(k,2135) + lu(k,2160) = lu(k,2160) - lu(k,554) * lu(k,2135) + lu(k,2163) = lu(k,2163) - lu(k,555) * lu(k,2135) + lu(k,2169) = lu(k,2169) - lu(k,556) * lu(k,2135) + lu(k,2171) = lu(k,2171) - lu(k,557) * lu(k,2135) + lu(k,2188) = - lu(k,551) * lu(k,2184) + lu(k,2190) = lu(k,2190) - lu(k,552) * lu(k,2184) + lu(k,2203) = lu(k,2203) - lu(k,553) * lu(k,2184) + lu(k,2224) = lu(k,2224) - lu(k,554) * lu(k,2184) + lu(k,2227) = lu(k,2227) - lu(k,555) * lu(k,2184) + lu(k,2233) = lu(k,2233) - lu(k,556) * lu(k,2184) + lu(k,2235) = lu(k,2235) - lu(k,557) * lu(k,2184) + lu(k,558) = 1._r8 / lu(k,558) + lu(k,559) = lu(k,559) * lu(k,558) + lu(k,560) = lu(k,560) * lu(k,558) + lu(k,561) = lu(k,561) * lu(k,558) + lu(k,562) = lu(k,562) * lu(k,558) + lu(k,563) = lu(k,563) * lu(k,558) + lu(k,564) = lu(k,564) * lu(k,558) + lu(k,565) = lu(k,565) * lu(k,558) + lu(k,1321) = - lu(k,559) * lu(k,1317) + lu(k,1325) = lu(k,1325) - lu(k,560) * lu(k,1317) + lu(k,1326) = - lu(k,561) * lu(k,1317) + lu(k,1327) = lu(k,1327) - lu(k,562) * lu(k,1317) + lu(k,1339) = lu(k,1339) - lu(k,563) * lu(k,1317) + lu(k,1343) = - lu(k,564) * lu(k,1317) + lu(k,1345) = lu(k,1345) - lu(k,565) * lu(k,1317) + lu(k,1772) = lu(k,1772) - lu(k,559) * lu(k,1743) + lu(k,1794) = lu(k,1794) - lu(k,560) * lu(k,1743) + lu(k,1796) = lu(k,1796) - lu(k,561) * lu(k,1743) + lu(k,1797) = lu(k,1797) - lu(k,562) * lu(k,1743) + lu(k,1818) = lu(k,1818) - lu(k,563) * lu(k,1743) + lu(k,1823) = lu(k,1823) - lu(k,564) * lu(k,1743) + lu(k,1829) = lu(k,1829) - lu(k,565) * lu(k,1743) + lu(k,1876) = - lu(k,559) * lu(k,1859) + lu(k,1892) = lu(k,1892) - lu(k,560) * lu(k,1859) + lu(k,1894) = lu(k,1894) - lu(k,561) * lu(k,1859) + lu(k,1895) = lu(k,1895) - lu(k,562) * lu(k,1859) + lu(k,1913) = lu(k,1913) - lu(k,563) * lu(k,1859) + lu(k,1918) = lu(k,1918) - lu(k,564) * lu(k,1859) + lu(k,1924) = lu(k,1924) - lu(k,565) * lu(k,1859) + lu(k,566) = 1._r8 / lu(k,566) + lu(k,567) = lu(k,567) * lu(k,566) + lu(k,568) = lu(k,568) * lu(k,566) + lu(k,569) = lu(k,569) * lu(k,566) + lu(k,570) = lu(k,570) * lu(k,566) + lu(k,571) = lu(k,571) * lu(k,566) + lu(k,572) = lu(k,572) * lu(k,566) + lu(k,573) = lu(k,573) * lu(k,566) + lu(k,1559) = lu(k,1559) - lu(k,567) * lu(k,1558) + lu(k,1563) = lu(k,1563) - lu(k,568) * lu(k,1558) + lu(k,1565) = lu(k,1565) - lu(k,569) * lu(k,1558) + lu(k,1567) = - lu(k,570) * lu(k,1558) + lu(k,1570) = lu(k,1570) - lu(k,571) * lu(k,1558) + lu(k,1573) = - lu(k,572) * lu(k,1558) + lu(k,1574) = lu(k,1574) - lu(k,573) * lu(k,1558) + lu(k,1939) = - lu(k,567) * lu(k,1934) + lu(k,1953) = - lu(k,568) * lu(k,1934) + lu(k,1955) = lu(k,1955) - lu(k,569) * lu(k,1934) + lu(k,1957) = lu(k,1957) - lu(k,570) * lu(k,1934) + lu(k,1960) = lu(k,1960) - lu(k,571) * lu(k,1934) + lu(k,1963) = lu(k,1963) - lu(k,572) * lu(k,1934) + lu(k,1964) = lu(k,1964) - lu(k,573) * lu(k,1934) + lu(k,2073) = lu(k,2073) - lu(k,567) * lu(k,2069) + lu(k,2088) = lu(k,2088) - lu(k,568) * lu(k,2069) + lu(k,2090) = lu(k,2090) - lu(k,569) * lu(k,2069) + lu(k,2092) = lu(k,2092) - lu(k,570) * lu(k,2069) + lu(k,2095) = lu(k,2095) - lu(k,571) * lu(k,2069) + lu(k,2098) = - lu(k,572) * lu(k,2069) + lu(k,2099) = lu(k,2099) - lu(k,573) * lu(k,2069) + lu(k,574) = 1._r8 / lu(k,574) + lu(k,575) = lu(k,575) * lu(k,574) + lu(k,576) = lu(k,576) * lu(k,574) + lu(k,577) = lu(k,577) * lu(k,574) + lu(k,578) = lu(k,578) * lu(k,574) + lu(k,579) = lu(k,579) * lu(k,574) + lu(k,580) = lu(k,580) * lu(k,574) + lu(k,581) = lu(k,581) * lu(k,574) + lu(k,1624) = lu(k,1624) - lu(k,575) * lu(k,1613) + lu(k,1629) = lu(k,1629) - lu(k,576) * lu(k,1613) + lu(k,1633) = - lu(k,577) * lu(k,1613) + lu(k,1654) = lu(k,1654) - lu(k,578) * lu(k,1613) + lu(k,1655) = lu(k,1655) - lu(k,579) * lu(k,1613) + lu(k,1656) = lu(k,1656) - lu(k,580) * lu(k,1613) + lu(k,1664) = lu(k,1664) - lu(k,581) * lu(k,1613) + lu(k,1787) = lu(k,1787) - lu(k,575) * lu(k,1744) + lu(k,1792) = lu(k,1792) - lu(k,576) * lu(k,1744) + lu(k,1796) = lu(k,1796) - lu(k,577) * lu(k,1744) + lu(k,1819) = lu(k,1819) - lu(k,578) * lu(k,1744) + lu(k,1820) = lu(k,1820) - lu(k,579) * lu(k,1744) + lu(k,1821) = lu(k,1821) - lu(k,580) * lu(k,1744) + lu(k,1829) = lu(k,1829) - lu(k,581) * lu(k,1744) + lu(k,1886) = lu(k,1886) - lu(k,575) * lu(k,1860) + lu(k,1890) = lu(k,1890) - lu(k,576) * lu(k,1860) + lu(k,1894) = lu(k,1894) - lu(k,577) * lu(k,1860) + lu(k,1914) = lu(k,1914) - lu(k,578) * lu(k,1860) + lu(k,1915) = lu(k,1915) - lu(k,579) * lu(k,1860) + lu(k,1916) = lu(k,1916) - lu(k,580) * lu(k,1860) + lu(k,1924) = lu(k,1924) - lu(k,581) * lu(k,1860) + 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,582) = 1._r8 / lu(k,582) + lu(k,583) = lu(k,583) * lu(k,582) + lu(k,584) = lu(k,584) * lu(k,582) + lu(k,585) = lu(k,585) * lu(k,582) + lu(k,586) = lu(k,586) * lu(k,582) + lu(k,587) = lu(k,587) * lu(k,582) + lu(k,588) = lu(k,588) * lu(k,582) + lu(k,1812) = lu(k,1812) - lu(k,583) * lu(k,1745) + lu(k,1818) = lu(k,1818) - lu(k,584) * lu(k,1745) + lu(k,1824) = lu(k,1824) - lu(k,585) * lu(k,1745) + lu(k,1826) = lu(k,1826) - lu(k,586) * lu(k,1745) + lu(k,1829) = lu(k,1829) - lu(k,587) * lu(k,1745) + lu(k,1831) = lu(k,1831) - lu(k,588) * lu(k,1745) + lu(k,2087) = lu(k,2087) - lu(k,583) * lu(k,2070) + lu(k,2093) = lu(k,2093) - lu(k,584) * lu(k,2070) + lu(k,2099) = lu(k,2099) - lu(k,585) * lu(k,2070) + lu(k,2101) = lu(k,2101) - lu(k,586) * lu(k,2070) + lu(k,2104) = lu(k,2104) - lu(k,587) * lu(k,2070) + lu(k,2106) = - lu(k,588) * lu(k,2070) + lu(k,2154) = lu(k,2154) - lu(k,583) * lu(k,2136) + lu(k,2160) = lu(k,2160) - lu(k,584) * lu(k,2136) + lu(k,2166) = - lu(k,585) * lu(k,2136) + lu(k,2168) = lu(k,2168) - lu(k,586) * lu(k,2136) + lu(k,2171) = lu(k,2171) - lu(k,587) * lu(k,2136) + lu(k,2173) = lu(k,2173) - lu(k,588) * lu(k,2136) + lu(k,2351) = lu(k,2351) - lu(k,583) * lu(k,2302) + lu(k,2357) = lu(k,2357) - lu(k,584) * lu(k,2302) + lu(k,2363) = lu(k,2363) - lu(k,585) * lu(k,2302) + lu(k,2365) = lu(k,2365) - lu(k,586) * lu(k,2302) + lu(k,2368) = lu(k,2368) - lu(k,587) * lu(k,2302) + lu(k,2370) = lu(k,2370) - lu(k,588) * lu(k,2302) + lu(k,589) = 1._r8 / lu(k,589) + lu(k,590) = lu(k,590) * lu(k,589) + lu(k,591) = lu(k,591) * lu(k,589) + lu(k,592) = lu(k,592) * lu(k,589) + lu(k,593) = lu(k,593) * lu(k,589) + lu(k,594) = lu(k,594) * lu(k,589) + lu(k,595) = lu(k,595) * lu(k,589) + lu(k,596) = lu(k,596) * lu(k,589) + lu(k,597) = lu(k,597) * lu(k,589) + lu(k,1292) = - lu(k,590) * lu(k,1289) + lu(k,1293) = - lu(k,591) * lu(k,1289) + lu(k,1294) = - lu(k,592) * lu(k,1289) + lu(k,1306) = - lu(k,593) * lu(k,1289) + lu(k,1308) = lu(k,1308) - lu(k,594) * lu(k,1289) + lu(k,1309) = lu(k,1309) - lu(k,595) * lu(k,1289) + lu(k,1310) = - lu(k,596) * lu(k,1289) + lu(k,1312) = lu(k,1312) - lu(k,597) * lu(k,1289) + lu(k,1794) = lu(k,1794) - lu(k,590) * lu(k,1746) + lu(k,1796) = lu(k,1796) - lu(k,591) * lu(k,1746) + lu(k,1797) = lu(k,1797) - lu(k,592) * lu(k,1746) + lu(k,1818) = lu(k,1818) - lu(k,593) * lu(k,1746) + lu(k,1820) = lu(k,1820) - lu(k,594) * lu(k,1746) + lu(k,1821) = lu(k,1821) - lu(k,595) * lu(k,1746) + lu(k,1823) = lu(k,1823) - lu(k,596) * lu(k,1746) + lu(k,1829) = lu(k,1829) - lu(k,597) * lu(k,1746) + lu(k,1892) = lu(k,1892) - lu(k,590) * lu(k,1861) + lu(k,1894) = lu(k,1894) - lu(k,591) * lu(k,1861) + lu(k,1895) = lu(k,1895) - lu(k,592) * lu(k,1861) + lu(k,1913) = lu(k,1913) - lu(k,593) * lu(k,1861) + lu(k,1915) = lu(k,1915) - lu(k,594) * lu(k,1861) + lu(k,1916) = lu(k,1916) - lu(k,595) * lu(k,1861) + lu(k,1918) = lu(k,1918) - lu(k,596) * lu(k,1861) + lu(k,1924) = lu(k,1924) - lu(k,597) * lu(k,1861) + lu(k,598) = 1._r8 / lu(k,598) + lu(k,599) = lu(k,599) * lu(k,598) + lu(k,600) = lu(k,600) * lu(k,598) + lu(k,601) = lu(k,601) * lu(k,598) + lu(k,669) = - lu(k,599) * lu(k,664) + lu(k,671) = - lu(k,600) * lu(k,664) + lu(k,674) = lu(k,674) - lu(k,601) * lu(k,664) + lu(k,733) = - lu(k,599) * lu(k,728) + lu(k,735) = lu(k,735) - lu(k,600) * lu(k,728) + lu(k,739) = lu(k,739) - lu(k,601) * lu(k,728) + lu(k,753) = - lu(k,599) * lu(k,748) + lu(k,755) = - lu(k,600) * lu(k,748) + lu(k,760) = lu(k,760) - lu(k,601) * lu(k,748) + lu(k,769) = - lu(k,599) * lu(k,764) + lu(k,771) = lu(k,771) - lu(k,600) * lu(k,764) + lu(k,777) = lu(k,777) - lu(k,601) * lu(k,764) + lu(k,1088) = - lu(k,599) * lu(k,1086) + lu(k,1091) = - lu(k,600) * lu(k,1086) + lu(k,1100) = lu(k,1100) - lu(k,601) * lu(k,1086) + lu(k,1322) = - lu(k,599) * lu(k,1318) + lu(k,1324) = - lu(k,600) * lu(k,1318) + lu(k,1345) = lu(k,1345) - lu(k,601) * lu(k,1318) + lu(k,1774) = - lu(k,599) * lu(k,1747) + lu(k,1793) = lu(k,1793) - lu(k,600) * lu(k,1747) + lu(k,1829) = lu(k,1829) - lu(k,601) * lu(k,1747) + lu(k,1878) = lu(k,1878) - lu(k,599) * lu(k,1862) + lu(k,1891) = lu(k,1891) - lu(k,600) * lu(k,1862) + lu(k,1924) = lu(k,1924) - lu(k,601) * lu(k,1862) + 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,1812) = lu(k,1812) - lu(k,603) * lu(k,1748) + lu(k,1813) = lu(k,1813) - lu(k,604) * lu(k,1748) + lu(k,1818) = lu(k,1818) - lu(k,605) * lu(k,1748) + lu(k,1822) = lu(k,1822) - lu(k,606) * lu(k,1748) + lu(k,1826) = lu(k,1826) - lu(k,607) * lu(k,1748) + lu(k,1829) = lu(k,1829) - lu(k,608) * lu(k,1748) + lu(k,1830) = lu(k,1830) - lu(k,609) * lu(k,1748) + lu(k,1831) = lu(k,1831) - lu(k,610) * lu(k,1748) + lu(k,2021) = lu(k,2021) - lu(k,603) * lu(k,2017) + lu(k,2022) = lu(k,2022) - lu(k,604) * lu(k,2017) + lu(k,2027) = lu(k,2027) - lu(k,605) * lu(k,2017) + lu(k,2031) = lu(k,2031) - lu(k,606) * lu(k,2017) + lu(k,2035) = lu(k,2035) - lu(k,607) * lu(k,2017) + lu(k,2038) = lu(k,2038) - lu(k,608) * lu(k,2017) + lu(k,2039) = lu(k,2039) - lu(k,609) * lu(k,2017) + lu(k,2040) = lu(k,2040) - lu(k,610) * lu(k,2017) + lu(k,2154) = lu(k,2154) - lu(k,603) * lu(k,2137) + lu(k,2155) = lu(k,2155) - lu(k,604) * lu(k,2137) + lu(k,2160) = lu(k,2160) - lu(k,605) * lu(k,2137) + lu(k,2164) = lu(k,2164) - lu(k,606) * lu(k,2137) + lu(k,2168) = lu(k,2168) - lu(k,607) * lu(k,2137) + lu(k,2171) = lu(k,2171) - lu(k,608) * lu(k,2137) + lu(k,2172) = lu(k,2172) - lu(k,609) * lu(k,2137) + lu(k,2173) = lu(k,2173) - lu(k,610) * lu(k,2137) + lu(k,611) = 1._r8 / lu(k,611) + lu(k,612) = lu(k,612) * lu(k,611) + lu(k,613) = lu(k,613) * lu(k,611) + lu(k,614) = lu(k,614) * lu(k,611) + lu(k,615) = lu(k,615) * lu(k,611) + lu(k,616) = lu(k,616) * lu(k,611) + lu(k,617) = lu(k,617) * lu(k,611) + lu(k,618) = lu(k,618) * lu(k,611) + lu(k,619) = lu(k,619) * lu(k,611) + lu(k,1395) = - lu(k,612) * lu(k,1392) + lu(k,1397) = lu(k,1397) - lu(k,613) * lu(k,1392) + lu(k,1399) = lu(k,1399) - lu(k,614) * lu(k,1392) + lu(k,1400) = lu(k,1400) - lu(k,615) * lu(k,1392) + lu(k,1401) = lu(k,1401) - lu(k,616) * lu(k,1392) + lu(k,1403) = lu(k,1403) - lu(k,617) * lu(k,1392) + lu(k,1404) = lu(k,1404) - lu(k,618) * lu(k,1392) + lu(k,1407) = lu(k,1407) - lu(k,619) * lu(k,1392) + lu(k,1797) = lu(k,1797) - lu(k,612) * lu(k,1749) + lu(k,1807) = lu(k,1807) - lu(k,613) * lu(k,1749) + lu(k,1809) = lu(k,1809) - lu(k,614) * lu(k,1749) + lu(k,1817) = lu(k,1817) - lu(k,615) * lu(k,1749) + lu(k,1818) = lu(k,1818) - lu(k,616) * lu(k,1749) + lu(k,1820) = lu(k,1820) - lu(k,617) * lu(k,1749) + lu(k,1821) = lu(k,1821) - lu(k,618) * lu(k,1749) + lu(k,1829) = lu(k,1829) - lu(k,619) * lu(k,1749) + lu(k,1946) = - lu(k,612) * lu(k,1935) + lu(k,1948) = lu(k,1948) - lu(k,613) * lu(k,1935) + lu(k,1950) = lu(k,1950) - lu(k,614) * lu(k,1935) + lu(k,1957) = lu(k,1957) - lu(k,615) * lu(k,1935) + lu(k,1958) = lu(k,1958) - lu(k,616) * lu(k,1935) + lu(k,1960) = lu(k,1960) - lu(k,617) * lu(k,1935) + lu(k,1961) = lu(k,1961) - lu(k,618) * lu(k,1935) + lu(k,1969) = lu(k,1969) - lu(k,619) * lu(k,1935) + 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,620) = 1._r8 / lu(k,620) + lu(k,621) = lu(k,621) * lu(k,620) + lu(k,622) = lu(k,622) * lu(k,620) + lu(k,623) = lu(k,623) * lu(k,620) + lu(k,624) = lu(k,624) * lu(k,620) + lu(k,625) = lu(k,625) * lu(k,620) + lu(k,626) = lu(k,626) * lu(k,620) + lu(k,1398) = lu(k,1398) - lu(k,621) * lu(k,1393) + lu(k,1399) = lu(k,1399) - lu(k,622) * lu(k,1393) + lu(k,1401) = lu(k,1401) - lu(k,623) * lu(k,1393) + lu(k,1404) = lu(k,1404) - lu(k,624) * lu(k,1393) + lu(k,1408) = lu(k,1408) - lu(k,625) * lu(k,1393) + lu(k,1409) = - lu(k,626) * lu(k,1393) + lu(k,1428) = lu(k,1428) - lu(k,621) * lu(k,1412) + lu(k,1429) = lu(k,1429) - lu(k,622) * lu(k,1412) + lu(k,1432) = lu(k,1432) - lu(k,623) * lu(k,1412) + lu(k,1435) = lu(k,1435) - lu(k,624) * lu(k,1412) + lu(k,1440) = lu(k,1440) - lu(k,625) * lu(k,1412) + lu(k,1441) = - lu(k,626) * lu(k,1412) + lu(k,1808) = lu(k,1808) - lu(k,621) * lu(k,1750) + lu(k,1809) = lu(k,1809) - lu(k,622) * lu(k,1750) + lu(k,1818) = lu(k,1818) - lu(k,623) * lu(k,1750) + lu(k,1821) = lu(k,1821) - lu(k,624) * lu(k,1750) + lu(k,1830) = lu(k,1830) - lu(k,625) * lu(k,1750) + lu(k,1831) = lu(k,1831) - lu(k,626) * lu(k,1750) + lu(k,2348) = lu(k,2348) - lu(k,621) * lu(k,2303) + lu(k,2349) = lu(k,2349) - lu(k,622) * lu(k,2303) + lu(k,2357) = lu(k,2357) - lu(k,623) * lu(k,2303) + lu(k,2360) = lu(k,2360) - lu(k,624) * lu(k,2303) + lu(k,2369) = lu(k,2369) - lu(k,625) * lu(k,2303) + lu(k,2370) = lu(k,2370) - lu(k,626) * lu(k,2303) + lu(k,627) = 1._r8 / lu(k,627) + lu(k,628) = lu(k,628) * lu(k,627) + lu(k,629) = lu(k,629) * lu(k,627) + lu(k,630) = lu(k,630) * lu(k,627) + lu(k,631) = lu(k,631) * lu(k,627) + lu(k,632) = lu(k,632) * lu(k,627) + lu(k,1063) = lu(k,1063) - lu(k,628) * lu(k,1060) + lu(k,1065) = lu(k,1065) - lu(k,629) * lu(k,1060) + lu(k,1067) = lu(k,1067) - lu(k,630) * lu(k,1060) + lu(k,1069) = - lu(k,631) * lu(k,1060) + lu(k,1070) = lu(k,1070) - lu(k,632) * lu(k,1060) + lu(k,1105) = lu(k,1105) - lu(k,628) * lu(k,1103) + lu(k,1111) = lu(k,1111) - lu(k,629) * lu(k,1103) + lu(k,1113) = lu(k,1113) - lu(k,630) * lu(k,1103) + lu(k,1115) = lu(k,1115) - lu(k,631) * lu(k,1103) + lu(k,1116) = lu(k,1116) - lu(k,632) * lu(k,1103) + lu(k,1786) = lu(k,1786) - lu(k,628) * lu(k,1751) + lu(k,1818) = lu(k,1818) - lu(k,629) * lu(k,1751) + lu(k,1820) = lu(k,1820) - lu(k,630) * lu(k,1751) + lu(k,1823) = lu(k,1823) - lu(k,631) * lu(k,1751) + lu(k,1829) = lu(k,1829) - lu(k,632) * lu(k,1751) + lu(k,1885) = lu(k,1885) - lu(k,628) * lu(k,1863) + lu(k,1913) = lu(k,1913) - lu(k,629) * lu(k,1863) + lu(k,1915) = lu(k,1915) - lu(k,630) * lu(k,1863) + lu(k,1918) = lu(k,1918) - lu(k,631) * lu(k,1863) + lu(k,1924) = lu(k,1924) - lu(k,632) * lu(k,1863) + lu(k,2383) = lu(k,2383) - lu(k,628) * lu(k,2375) + lu(k,2409) = lu(k,2409) - lu(k,629) * lu(k,2375) + lu(k,2411) = lu(k,2411) - lu(k,630) * lu(k,2375) + lu(k,2414) = lu(k,2414) - lu(k,631) * lu(k,2375) + lu(k,2420) = lu(k,2420) - lu(k,632) * lu(k,2375) + lu(k,635) = 1._r8 / lu(k,635) + lu(k,636) = lu(k,636) * lu(k,635) + lu(k,637) = lu(k,637) * lu(k,635) + lu(k,638) = lu(k,638) * lu(k,635) + lu(k,639) = lu(k,639) * lu(k,635) + lu(k,640) = lu(k,640) * lu(k,635) + lu(k,1818) = lu(k,1818) - lu(k,636) * lu(k,1752) + lu(k,1819) = lu(k,1819) - lu(k,637) * lu(k,1752) + lu(k,1820) = lu(k,1820) - lu(k,638) * lu(k,1752) + lu(k,1827) = lu(k,1827) - lu(k,639) * lu(k,1752) + lu(k,1829) = lu(k,1829) - lu(k,640) * lu(k,1752) + lu(k,1913) = lu(k,1913) - lu(k,636) * lu(k,1864) + lu(k,1914) = lu(k,1914) - lu(k,637) * lu(k,1864) + lu(k,1915) = lu(k,1915) - lu(k,638) * lu(k,1864) + lu(k,1922) = lu(k,1922) - lu(k,639) * lu(k,1864) + lu(k,1924) = lu(k,1924) - lu(k,640) * lu(k,1864) + lu(k,1958) = lu(k,1958) - lu(k,636) * lu(k,1936) + lu(k,1959) = lu(k,1959) - lu(k,637) * lu(k,1936) + lu(k,1960) = lu(k,1960) - lu(k,638) * lu(k,1936) + lu(k,1967) = lu(k,1967) - lu(k,639) * lu(k,1936) + lu(k,1969) = lu(k,1969) - lu(k,640) * lu(k,1936) + lu(k,2224) = lu(k,2224) - lu(k,636) * lu(k,2185) + lu(k,2225) = lu(k,2225) - lu(k,637) * lu(k,2185) + lu(k,2226) = lu(k,2226) - lu(k,638) * lu(k,2185) + lu(k,2233) = lu(k,2233) - lu(k,639) * lu(k,2185) + lu(k,2235) = lu(k,2235) - lu(k,640) * lu(k,2185) + lu(k,2357) = lu(k,2357) - lu(k,636) * lu(k,2304) + lu(k,2358) = lu(k,2358) - lu(k,637) * lu(k,2304) + lu(k,2359) = lu(k,2359) - lu(k,638) * lu(k,2304) + lu(k,2366) = lu(k,2366) - lu(k,639) * lu(k,2304) + lu(k,2368) = lu(k,2368) - lu(k,640) * lu(k,2304) + lu(k,642) = 1._r8 / lu(k,642) + lu(k,643) = lu(k,643) * lu(k,642) + lu(k,644) = lu(k,644) * lu(k,642) + lu(k,645) = lu(k,645) * lu(k,642) + lu(k,646) = lu(k,646) * lu(k,642) + lu(k,647) = lu(k,647) * lu(k,642) + lu(k,648) = lu(k,648) * lu(k,642) + lu(k,649) = lu(k,649) * lu(k,642) + lu(k,650) = lu(k,650) * lu(k,642) + lu(k,651) = lu(k,651) * lu(k,642) + lu(k,1040) = lu(k,1040) - lu(k,643) * lu(k,1038) + lu(k,1041) = lu(k,1041) - lu(k,644) * lu(k,1038) + lu(k,1043) = lu(k,1043) - lu(k,645) * lu(k,1038) + lu(k,1044) = lu(k,1044) - lu(k,646) * lu(k,1038) + lu(k,1045) = lu(k,1045) - lu(k,647) * lu(k,1038) + lu(k,1047) = lu(k,1047) - lu(k,648) * lu(k,1038) + lu(k,1049) = lu(k,1049) - lu(k,649) * lu(k,1038) + lu(k,1050) = lu(k,1050) - lu(k,650) * lu(k,1038) + lu(k,1051) = lu(k,1051) - lu(k,651) * lu(k,1038) + lu(k,1757) = lu(k,1757) - lu(k,643) * lu(k,1753) + lu(k,1773) = lu(k,1773) - lu(k,644) * lu(k,1753) + lu(k,1787) = lu(k,1787) - lu(k,645) * lu(k,1753) + lu(k,1792) = lu(k,1792) - lu(k,646) * lu(k,1753) + lu(k,1808) = lu(k,1808) - lu(k,647) * lu(k,1753) + lu(k,1818) = lu(k,1818) - lu(k,648) * lu(k,1753) + lu(k,1820) = lu(k,1820) - lu(k,649) * lu(k,1753) + lu(k,1821) = lu(k,1821) - lu(k,650) * lu(k,1753) + lu(k,1829) = lu(k,1829) - lu(k,651) * lu(k,1753) + lu(k,1866) = lu(k,1866) - lu(k,643) * lu(k,1865) + lu(k,1877) = lu(k,1877) - lu(k,644) * lu(k,1865) + lu(k,1886) = lu(k,1886) - lu(k,645) * lu(k,1865) + lu(k,1890) = lu(k,1890) - lu(k,646) * lu(k,1865) + lu(k,1906) = lu(k,1906) - lu(k,647) * lu(k,1865) + lu(k,1913) = lu(k,1913) - lu(k,648) * lu(k,1865) + lu(k,1915) = lu(k,1915) - lu(k,649) * lu(k,1865) + lu(k,1916) = lu(k,1916) - lu(k,650) * lu(k,1865) + lu(k,1924) = lu(k,1924) - lu(k,651) * lu(k,1865) + lu(k,652) = 1._r8 / lu(k,652) + lu(k,653) = lu(k,653) * lu(k,652) + lu(k,654) = lu(k,654) * lu(k,652) + lu(k,655) = lu(k,655) * lu(k,652) + lu(k,656) = lu(k,656) * lu(k,652) + lu(k,657) = lu(k,657) * lu(k,652) + lu(k,658) = lu(k,658) * lu(k,652) + lu(k,659) = lu(k,659) * lu(k,652) + lu(k,660) = lu(k,660) * lu(k,652) + lu(k,661) = lu(k,661) * lu(k,652) + lu(k,1174) = lu(k,1174) - lu(k,653) * lu(k,1172) + lu(k,1175) = lu(k,1175) - lu(k,654) * lu(k,1172) + lu(k,1176) = lu(k,1176) - lu(k,655) * lu(k,1172) + lu(k,1177) = lu(k,1177) - lu(k,656) * lu(k,1172) + lu(k,1178) = lu(k,1178) - lu(k,657) * lu(k,1172) + lu(k,1181) = lu(k,1181) - lu(k,658) * lu(k,1172) + lu(k,1182) = - lu(k,659) * lu(k,1172) + lu(k,1185) = lu(k,1185) - lu(k,660) * lu(k,1172) + lu(k,1187) = lu(k,1187) - lu(k,661) * lu(k,1172) + lu(k,1787) = lu(k,1787) - lu(k,653) * lu(k,1754) + lu(k,1790) = lu(k,1790) - lu(k,654) * lu(k,1754) + lu(k,1793) = lu(k,1793) - lu(k,655) * lu(k,1754) + lu(k,1794) = lu(k,1794) - lu(k,656) * lu(k,1754) + lu(k,1795) = lu(k,1795) - lu(k,657) * lu(k,1754) + lu(k,1809) = lu(k,1809) - lu(k,658) * lu(k,1754) + lu(k,1818) = lu(k,1818) - lu(k,659) * lu(k,1754) + lu(k,1821) = lu(k,1821) - lu(k,660) * lu(k,1754) + lu(k,1829) = lu(k,1829) - lu(k,661) * lu(k,1754) + lu(k,2330) = lu(k,2330) - lu(k,653) * lu(k,2305) + lu(k,2332) = - lu(k,654) * lu(k,2305) + lu(k,2334) = lu(k,2334) - lu(k,655) * lu(k,2305) + lu(k,2335) = lu(k,2335) - lu(k,656) * lu(k,2305) + lu(k,2336) = lu(k,2336) - lu(k,657) * lu(k,2305) + lu(k,2349) = lu(k,2349) - lu(k,658) * lu(k,2305) + lu(k,2357) = lu(k,2357) - lu(k,659) * lu(k,2305) + lu(k,2360) = lu(k,2360) - lu(k,660) * lu(k,2305) + lu(k,2368) = lu(k,2368) - lu(k,661) * lu(k,2305) + lu(k,665) = 1._r8 / lu(k,665) + lu(k,666) = lu(k,666) * lu(k,665) + lu(k,667) = lu(k,667) * lu(k,665) + lu(k,668) = lu(k,668) * lu(k,665) + lu(k,669) = lu(k,669) * lu(k,665) + lu(k,670) = lu(k,670) * lu(k,665) + lu(k,671) = lu(k,671) * lu(k,665) + lu(k,672) = lu(k,672) * lu(k,665) + lu(k,673) = lu(k,673) * lu(k,665) + lu(k,674) = lu(k,674) * lu(k,665) + lu(k,750) = lu(k,750) - lu(k,666) * lu(k,749) + lu(k,751) = lu(k,751) - lu(k,667) * lu(k,749) + lu(k,752) = lu(k,752) - lu(k,668) * lu(k,749) + lu(k,753) = lu(k,753) - lu(k,669) * lu(k,749) + lu(k,754) = lu(k,754) - lu(k,670) * lu(k,749) + lu(k,755) = lu(k,755) - lu(k,671) * lu(k,749) + lu(k,756) = lu(k,756) - lu(k,672) * lu(k,749) + lu(k,757) = - lu(k,673) * lu(k,749) + lu(k,760) = lu(k,760) - lu(k,674) * lu(k,749) + lu(k,1762) = lu(k,1762) - lu(k,666) * lu(k,1755) + lu(k,1763) = lu(k,1763) - lu(k,667) * lu(k,1755) + lu(k,1765) = - lu(k,668) * lu(k,1755) + lu(k,1774) = lu(k,1774) - lu(k,669) * lu(k,1755) + lu(k,1784) = lu(k,1784) - lu(k,670) * lu(k,1755) + lu(k,1793) = lu(k,1793) - lu(k,671) * lu(k,1755) + lu(k,1802) = lu(k,1802) - lu(k,672) * lu(k,1755) + lu(k,1818) = lu(k,1818) - lu(k,673) * lu(k,1755) + lu(k,1829) = lu(k,1829) - lu(k,674) * lu(k,1755) + lu(k,2312) = lu(k,2312) - lu(k,666) * lu(k,2306) + lu(k,2313) = lu(k,2313) - lu(k,667) * lu(k,2306) + lu(k,2315) = lu(k,2315) - lu(k,668) * lu(k,2306) + lu(k,2323) = lu(k,2323) - lu(k,669) * lu(k,2306) + lu(k,2327) = lu(k,2327) - lu(k,670) * lu(k,2306) + lu(k,2334) = lu(k,2334) - lu(k,671) * lu(k,2306) + lu(k,2342) = lu(k,2342) - lu(k,672) * lu(k,2306) + lu(k,2357) = lu(k,2357) - lu(k,673) * lu(k,2306) + lu(k,2368) = lu(k,2368) - lu(k,674) * lu(k,2306) + 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,676) = 1._r8 / lu(k,676) + lu(k,677) = lu(k,677) * lu(k,676) + lu(k,678) = lu(k,678) * lu(k,676) + lu(k,679) = lu(k,679) * lu(k,676) + lu(k,680) = lu(k,680) * lu(k,676) + lu(k,681) = lu(k,681) * lu(k,676) + lu(k,682) = lu(k,682) * lu(k,676) + lu(k,683) = lu(k,683) * lu(k,676) + lu(k,684) = lu(k,684) * lu(k,676) + lu(k,685) = lu(k,685) * lu(k,676) + lu(k,862) = - lu(k,677) * lu(k,861) + lu(k,863) = lu(k,863) - lu(k,678) * lu(k,861) + lu(k,864) = lu(k,864) - lu(k,679) * lu(k,861) + lu(k,865) = lu(k,865) - lu(k,680) * lu(k,861) + lu(k,866) = lu(k,866) - lu(k,681) * lu(k,861) + lu(k,869) = lu(k,869) - lu(k,682) * lu(k,861) + lu(k,870) = lu(k,870) - lu(k,683) * lu(k,861) + lu(k,871) = lu(k,871) - lu(k,684) * lu(k,861) + lu(k,872) = lu(k,872) - lu(k,685) * lu(k,861) + lu(k,1531) = lu(k,1531) - lu(k,677) * lu(k,1529) + lu(k,1532) = lu(k,1532) - lu(k,678) * lu(k,1529) + lu(k,1533) = lu(k,1533) - lu(k,679) * lu(k,1529) + lu(k,1534) = lu(k,1534) - lu(k,680) * lu(k,1529) + lu(k,1536) = lu(k,1536) - lu(k,681) * lu(k,1529) + lu(k,1542) = lu(k,1542) - lu(k,682) * lu(k,1529) + lu(k,1546) = lu(k,1546) - lu(k,683) * lu(k,1529) + lu(k,1549) = lu(k,1549) - lu(k,684) * lu(k,1529) + lu(k,1550) = lu(k,1550) - lu(k,685) * lu(k,1529) + lu(k,2074) = lu(k,2074) - lu(k,677) * lu(k,2071) + lu(k,2077) = lu(k,2077) - lu(k,678) * lu(k,2071) + lu(k,2078) = lu(k,2078) - lu(k,679) * lu(k,2071) + lu(k,2079) = lu(k,2079) - lu(k,680) * lu(k,2071) + lu(k,2082) = lu(k,2082) - lu(k,681) * lu(k,2071) + lu(k,2089) = lu(k,2089) - lu(k,682) * lu(k,2071) + lu(k,2094) = lu(k,2094) - lu(k,683) * lu(k,2071) + lu(k,2097) = lu(k,2097) - lu(k,684) * lu(k,2071) + lu(k,2099) = lu(k,2099) - lu(k,685) * lu(k,2071) + lu(k,687) = 1._r8 / lu(k,687) + lu(k,688) = lu(k,688) * lu(k,687) + lu(k,689) = lu(k,689) * lu(k,687) + lu(k,690) = lu(k,690) * lu(k,687) + lu(k,691) = lu(k,691) * lu(k,687) + lu(k,692) = lu(k,692) * lu(k,687) + lu(k,693) = lu(k,693) * lu(k,687) + lu(k,694) = lu(k,694) * lu(k,687) + lu(k,695) = lu(k,695) * lu(k,687) + lu(k,696) = lu(k,696) * lu(k,687) + lu(k,1040) = lu(k,1040) - lu(k,688) * lu(k,1039) + lu(k,1041) = lu(k,1041) - lu(k,689) * lu(k,1039) + lu(k,1042) = lu(k,1042) - lu(k,690) * lu(k,1039) + lu(k,1043) = lu(k,1043) - lu(k,691) * lu(k,1039) + lu(k,1044) = lu(k,1044) - lu(k,692) * lu(k,1039) + lu(k,1045) = lu(k,1045) - lu(k,693) * lu(k,1039) + lu(k,1047) = lu(k,1047) - lu(k,694) * lu(k,1039) + lu(k,1050) = lu(k,1050) - lu(k,695) * lu(k,1039) + lu(k,1051) = lu(k,1051) - lu(k,696) * lu(k,1039) + lu(k,1757) = lu(k,1757) - lu(k,688) * lu(k,1756) + lu(k,1773) = lu(k,1773) - lu(k,689) * lu(k,1756) + lu(k,1783) = lu(k,1783) - lu(k,690) * lu(k,1756) + lu(k,1787) = lu(k,1787) - lu(k,691) * lu(k,1756) + lu(k,1792) = lu(k,1792) - lu(k,692) * lu(k,1756) + lu(k,1808) = lu(k,1808) - lu(k,693) * lu(k,1756) + lu(k,1818) = lu(k,1818) - lu(k,694) * lu(k,1756) + lu(k,1821) = lu(k,1821) - lu(k,695) * lu(k,1756) + lu(k,1829) = lu(k,1829) - lu(k,696) * lu(k,1756) + lu(k,2308) = lu(k,2308) - lu(k,688) * lu(k,2307) + lu(k,2322) = lu(k,2322) - lu(k,689) * lu(k,2307) + lu(k,2326) = lu(k,2326) - lu(k,690) * lu(k,2307) + lu(k,2330) = lu(k,2330) - lu(k,691) * lu(k,2307) + lu(k,2333) = lu(k,2333) - lu(k,692) * lu(k,2307) + lu(k,2348) = lu(k,2348) - lu(k,693) * lu(k,2307) + lu(k,2357) = lu(k,2357) - lu(k,694) * lu(k,2307) + lu(k,2360) = lu(k,2360) - lu(k,695) * lu(k,2307) + lu(k,2368) = lu(k,2368) - lu(k,696) * lu(k,2307) + lu(k,698) = 1._r8 / lu(k,698) + lu(k,699) = lu(k,699) * lu(k,698) + lu(k,700) = lu(k,700) * lu(k,698) + lu(k,701) = lu(k,701) * lu(k,698) + lu(k,702) = lu(k,702) * lu(k,698) + lu(k,703) = lu(k,703) * lu(k,698) + lu(k,704) = lu(k,704) * lu(k,698) + lu(k,1044) = lu(k,1044) - lu(k,699) * lu(k,1040) + lu(k,1045) = lu(k,1045) - lu(k,700) * lu(k,1040) + lu(k,1047) = lu(k,1047) - lu(k,701) * lu(k,1040) + lu(k,1048) = lu(k,1048) - lu(k,702) * lu(k,1040) + lu(k,1049) = lu(k,1049) - lu(k,703) * lu(k,1040) + lu(k,1051) = lu(k,1051) - lu(k,704) * lu(k,1040) + lu(k,1792) = lu(k,1792) - lu(k,699) * lu(k,1757) + lu(k,1808) = lu(k,1808) - lu(k,700) * lu(k,1757) + lu(k,1818) = lu(k,1818) - lu(k,701) * lu(k,1757) + lu(k,1819) = lu(k,1819) - lu(k,702) * lu(k,1757) + lu(k,1820) = lu(k,1820) - lu(k,703) * lu(k,1757) + lu(k,1829) = lu(k,1829) - lu(k,704) * lu(k,1757) + lu(k,1890) = lu(k,1890) - lu(k,699) * lu(k,1866) + lu(k,1906) = lu(k,1906) - lu(k,700) * lu(k,1866) + lu(k,1913) = lu(k,1913) - lu(k,701) * lu(k,1866) + lu(k,1914) = lu(k,1914) - lu(k,702) * lu(k,1866) + lu(k,1915) = lu(k,1915) - lu(k,703) * lu(k,1866) + lu(k,1924) = lu(k,1924) - lu(k,704) * lu(k,1866) + lu(k,2333) = lu(k,2333) - lu(k,699) * lu(k,2308) + lu(k,2348) = lu(k,2348) - lu(k,700) * lu(k,2308) + lu(k,2357) = lu(k,2357) - lu(k,701) * lu(k,2308) + lu(k,2358) = lu(k,2358) - lu(k,702) * lu(k,2308) + lu(k,2359) = lu(k,2359) - lu(k,703) * lu(k,2308) + lu(k,2368) = lu(k,2368) - lu(k,704) * lu(k,2308) + lu(k,705) = 1._r8 / lu(k,705) + lu(k,706) = lu(k,706) * lu(k,705) + lu(k,707) = lu(k,707) * lu(k,705) + lu(k,708) = lu(k,708) * lu(k,705) + lu(k,709) = lu(k,709) * lu(k,705) + lu(k,1139) = lu(k,1139) - lu(k,706) * lu(k,1129) + lu(k,1142) = lu(k,1142) - lu(k,707) * lu(k,1129) + lu(k,1149) = lu(k,1149) - lu(k,708) * lu(k,1129) + lu(k,1150) = - lu(k,709) * lu(k,1129) + lu(k,1399) = lu(k,1399) - lu(k,706) * lu(k,1394) + lu(k,1401) = lu(k,1401) - lu(k,707) * lu(k,1394) + lu(k,1408) = lu(k,1408) - lu(k,708) * lu(k,1394) + lu(k,1409) = lu(k,1409) - lu(k,709) * lu(k,1394) + lu(k,1429) = lu(k,1429) - lu(k,706) * lu(k,1413) + lu(k,1432) = lu(k,1432) - lu(k,707) * lu(k,1413) + lu(k,1440) = lu(k,1440) - lu(k,708) * lu(k,1413) + lu(k,1441) = lu(k,1441) - lu(k,709) * lu(k,1413) + lu(k,1809) = lu(k,1809) - lu(k,706) * lu(k,1758) + lu(k,1818) = lu(k,1818) - lu(k,707) * lu(k,1758) + lu(k,1830) = lu(k,1830) - lu(k,708) * lu(k,1758) + lu(k,1831) = lu(k,1831) - lu(k,709) * lu(k,1758) + lu(k,2217) = lu(k,2217) - lu(k,706) * lu(k,2186) + lu(k,2224) = lu(k,2224) - lu(k,707) * lu(k,2186) + lu(k,2236) = lu(k,2236) - lu(k,708) * lu(k,2186) + lu(k,2237) = - lu(k,709) * lu(k,2186) + lu(k,2349) = lu(k,2349) - lu(k,706) * lu(k,2309) + lu(k,2357) = lu(k,2357) - lu(k,707) * lu(k,2309) + lu(k,2369) = lu(k,2369) - lu(k,708) * lu(k,2309) + lu(k,2370) = lu(k,2370) - lu(k,709) * lu(k,2309) + lu(k,2404) = lu(k,2404) - lu(k,706) * lu(k,2376) + lu(k,2409) = lu(k,2409) - lu(k,707) * lu(k,2376) + lu(k,2421) = lu(k,2421) - lu(k,708) * lu(k,2376) + lu(k,2422) = lu(k,2422) - lu(k,709) * lu(k,2376) + lu(k,711) = 1._r8 / lu(k,711) + lu(k,712) = lu(k,712) * lu(k,711) + lu(k,713) = lu(k,713) * lu(k,711) + lu(k,714) = lu(k,714) * lu(k,711) + lu(k,715) = lu(k,715) * lu(k,711) + lu(k,716) = lu(k,716) * lu(k,711) + lu(k,717) = lu(k,717) * lu(k,711) + lu(k,1252) = - lu(k,712) * lu(k,1246) + lu(k,1254) = - lu(k,713) * lu(k,1246) + lu(k,1256) = - lu(k,714) * lu(k,1246) + lu(k,1260) = lu(k,1260) - lu(k,715) * lu(k,1246) + lu(k,1263) = lu(k,1263) - lu(k,716) * lu(k,1246) + lu(k,1265) = lu(k,1265) - lu(k,717) * lu(k,1246) + lu(k,1296) = - lu(k,712) * lu(k,1290) + lu(k,1297) = lu(k,1297) - lu(k,713) * lu(k,1290) + lu(k,1301) = lu(k,1301) - lu(k,714) * lu(k,1290) + lu(k,1306) = lu(k,1306) - lu(k,715) * lu(k,1290) + lu(k,1309) = lu(k,1309) - lu(k,716) * lu(k,1290) + lu(k,1312) = lu(k,1312) - lu(k,717) * lu(k,1290) + lu(k,1329) = lu(k,1329) - lu(k,712) * lu(k,1319) + lu(k,1330) = - lu(k,713) * lu(k,1319) + lu(k,1334) = - lu(k,714) * lu(k,1319) + lu(k,1339) = lu(k,1339) - lu(k,715) * lu(k,1319) + lu(k,1342) = lu(k,1342) - lu(k,716) * lu(k,1319) + lu(k,1345) = lu(k,1345) - lu(k,717) * lu(k,1319) + lu(k,1799) = lu(k,1799) - lu(k,712) * lu(k,1759) + lu(k,1801) = lu(k,1801) - lu(k,713) * lu(k,1759) + lu(k,1806) = lu(k,1806) - lu(k,714) * lu(k,1759) + lu(k,1818) = lu(k,1818) - lu(k,715) * lu(k,1759) + lu(k,1821) = lu(k,1821) - lu(k,716) * lu(k,1759) + lu(k,1829) = lu(k,1829) - lu(k,717) * lu(k,1759) + lu(k,2339) = lu(k,2339) - lu(k,712) * lu(k,2310) + lu(k,2341) = - lu(k,713) * lu(k,2310) + lu(k,2346) = - lu(k,714) * lu(k,2310) + lu(k,2357) = lu(k,2357) - lu(k,715) * lu(k,2310) + lu(k,2360) = lu(k,2360) - lu(k,716) * lu(k,2310) + lu(k,2368) = lu(k,2368) - lu(k,717) * lu(k,2310) + lu(k,718) = 1._r8 / lu(k,718) + lu(k,719) = lu(k,719) * lu(k,718) + lu(k,720) = lu(k,720) * lu(k,718) + lu(k,721) = lu(k,721) * lu(k,718) + lu(k,722) = lu(k,722) * lu(k,718) + lu(k,723) = lu(k,723) * lu(k,718) + lu(k,724) = lu(k,724) * lu(k,718) + lu(k,1476) = lu(k,1476) - lu(k,719) * lu(k,1474) + lu(k,1478) = lu(k,1478) - lu(k,720) * lu(k,1474) + lu(k,1481) = lu(k,1481) - lu(k,721) * lu(k,1474) + lu(k,1484) = lu(k,1484) - lu(k,722) * lu(k,1474) + lu(k,1485) = lu(k,1485) - lu(k,723) * lu(k,1474) + lu(k,1487) = lu(k,1487) - lu(k,724) * lu(k,1474) + lu(k,1540) = lu(k,1540) - lu(k,719) * lu(k,1530) + lu(k,1542) = lu(k,1542) - lu(k,720) * lu(k,1530) + lu(k,1545) = - lu(k,721) * lu(k,1530) + lu(k,1550) = lu(k,1550) - lu(k,722) * lu(k,1530) + lu(k,1551) = lu(k,1551) - lu(k,723) * lu(k,1530) + lu(k,1553) = lu(k,1553) - lu(k,724) * lu(k,1530) + lu(k,1811) = lu(k,1811) - lu(k,719) * lu(k,1760) + lu(k,1814) = lu(k,1814) - lu(k,720) * lu(k,1760) + lu(k,1818) = lu(k,1818) - lu(k,721) * lu(k,1760) + lu(k,1824) = lu(k,1824) - lu(k,722) * lu(k,1760) + lu(k,1825) = lu(k,1825) - lu(k,723) * lu(k,1760) + lu(k,1827) = lu(k,1827) - lu(k,724) * lu(k,1760) + lu(k,2086) = lu(k,2086) - lu(k,719) * lu(k,2072) + lu(k,2089) = lu(k,2089) - lu(k,720) * lu(k,2072) + lu(k,2093) = lu(k,2093) - lu(k,721) * lu(k,2072) + lu(k,2099) = lu(k,2099) - lu(k,722) * lu(k,2072) + lu(k,2100) = lu(k,2100) - lu(k,723) * lu(k,2072) + lu(k,2102) = lu(k,2102) - lu(k,724) * lu(k,2072) + lu(k,2218) = lu(k,2218) - lu(k,719) * lu(k,2187) + lu(k,2220) = lu(k,2220) - lu(k,720) * lu(k,2187) + lu(k,2224) = lu(k,2224) - lu(k,721) * lu(k,2187) + lu(k,2230) = lu(k,2230) - lu(k,722) * lu(k,2187) + lu(k,2231) = lu(k,2231) - lu(k,723) * lu(k,2187) + lu(k,2233) = lu(k,2233) - lu(k,724) * lu(k,2187) + 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,729) = 1._r8 / lu(k,729) + lu(k,730) = lu(k,730) * lu(k,729) + lu(k,731) = lu(k,731) * lu(k,729) + lu(k,732) = lu(k,732) * lu(k,729) + lu(k,733) = lu(k,733) * lu(k,729) + lu(k,734) = lu(k,734) * lu(k,729) + lu(k,735) = lu(k,735) * lu(k,729) + lu(k,736) = lu(k,736) * lu(k,729) + lu(k,737) = lu(k,737) * lu(k,729) + lu(k,738) = lu(k,738) * lu(k,729) + lu(k,739) = lu(k,739) * lu(k,729) + lu(k,766) = lu(k,766) - lu(k,730) * lu(k,765) + lu(k,767) = lu(k,767) - lu(k,731) * lu(k,765) + lu(k,768) = lu(k,768) - lu(k,732) * lu(k,765) + lu(k,769) = lu(k,769) - lu(k,733) * lu(k,765) + lu(k,770) = lu(k,770) - lu(k,734) * lu(k,765) + lu(k,771) = lu(k,771) - lu(k,735) * lu(k,765) + lu(k,772) = lu(k,772) - lu(k,736) * lu(k,765) + lu(k,773) = lu(k,773) - lu(k,737) * lu(k,765) + lu(k,774) = - lu(k,738) * lu(k,765) + lu(k,777) = lu(k,777) - lu(k,739) * lu(k,765) + lu(k,1762) = lu(k,1762) - lu(k,730) * lu(k,1761) + lu(k,1764) = lu(k,1764) - lu(k,731) * lu(k,1761) + lu(k,1765) = lu(k,1765) - lu(k,732) * lu(k,1761) + lu(k,1774) = lu(k,1774) - lu(k,733) * lu(k,1761) + lu(k,1784) = lu(k,1784) - lu(k,734) * lu(k,1761) + lu(k,1793) = lu(k,1793) - lu(k,735) * lu(k,1761) + lu(k,1802) = lu(k,1802) - lu(k,736) * lu(k,1761) + lu(k,1808) = lu(k,1808) - lu(k,737) * lu(k,1761) + lu(k,1818) = lu(k,1818) - lu(k,738) * lu(k,1761) + lu(k,1829) = lu(k,1829) - lu(k,739) * lu(k,1761) + lu(k,2312) = lu(k,2312) - lu(k,730) * lu(k,2311) + lu(k,2314) = lu(k,2314) - lu(k,731) * lu(k,2311) + lu(k,2315) = lu(k,2315) - lu(k,732) * lu(k,2311) + lu(k,2323) = lu(k,2323) - lu(k,733) * lu(k,2311) + lu(k,2327) = lu(k,2327) - lu(k,734) * lu(k,2311) + lu(k,2334) = lu(k,2334) - lu(k,735) * lu(k,2311) + lu(k,2342) = lu(k,2342) - lu(k,736) * lu(k,2311) + lu(k,2348) = lu(k,2348) - lu(k,737) * lu(k,2311) + lu(k,2357) = lu(k,2357) - lu(k,738) * lu(k,2311) + lu(k,2368) = lu(k,2368) - lu(k,739) * lu(k,2311) + lu(k,740) = 1._r8 / lu(k,740) + lu(k,741) = lu(k,741) * lu(k,740) + lu(k,742) = lu(k,742) * lu(k,740) + lu(k,743) = lu(k,743) * lu(k,740) + lu(k,744) = lu(k,744) * lu(k,740) + lu(k,745) = lu(k,745) * lu(k,740) + lu(k,754) = lu(k,754) - lu(k,741) * lu(k,750) + lu(k,755) = lu(k,755) - lu(k,742) * lu(k,750) + lu(k,758) = lu(k,758) - lu(k,743) * lu(k,750) + lu(k,759) = lu(k,759) - lu(k,744) * lu(k,750) + lu(k,760) = lu(k,760) - lu(k,745) * lu(k,750) + lu(k,770) = lu(k,770) - lu(k,741) * lu(k,766) + lu(k,771) = lu(k,771) - lu(k,742) * lu(k,766) + lu(k,775) = lu(k,775) - lu(k,743) * lu(k,766) + lu(k,776) = lu(k,776) - lu(k,744) * lu(k,766) + lu(k,777) = lu(k,777) - lu(k,745) * lu(k,766) + lu(k,1784) = lu(k,1784) - lu(k,741) * lu(k,1762) + lu(k,1793) = lu(k,1793) - lu(k,742) * lu(k,1762) + lu(k,1819) = lu(k,1819) - lu(k,743) * lu(k,1762) + lu(k,1820) = lu(k,1820) - lu(k,744) * lu(k,1762) + lu(k,1829) = lu(k,1829) - lu(k,745) * lu(k,1762) + lu(k,1883) = lu(k,1883) - lu(k,741) * lu(k,1867) + lu(k,1891) = lu(k,1891) - lu(k,742) * lu(k,1867) + lu(k,1914) = lu(k,1914) - lu(k,743) * lu(k,1867) + lu(k,1915) = lu(k,1915) - lu(k,744) * lu(k,1867) + lu(k,1924) = lu(k,1924) - lu(k,745) * lu(k,1867) + lu(k,1944) = - lu(k,741) * lu(k,1937) + lu(k,1945) = - lu(k,742) * lu(k,1937) + lu(k,1959) = lu(k,1959) - lu(k,743) * lu(k,1937) + lu(k,1960) = lu(k,1960) - lu(k,744) * lu(k,1937) + lu(k,1969) = lu(k,1969) - lu(k,745) * lu(k,1937) + lu(k,2327) = lu(k,2327) - lu(k,741) * lu(k,2312) + lu(k,2334) = lu(k,2334) - lu(k,742) * lu(k,2312) + lu(k,2358) = lu(k,2358) - lu(k,743) * lu(k,2312) + lu(k,2359) = lu(k,2359) - lu(k,744) * lu(k,2312) + lu(k,2368) = lu(k,2368) - lu(k,745) * lu(k,2312) + lu(k,751) = 1._r8 / lu(k,751) + lu(k,752) = lu(k,752) * lu(k,751) + lu(k,753) = lu(k,753) * lu(k,751) + lu(k,754) = lu(k,754) * lu(k,751) + lu(k,755) = lu(k,755) * lu(k,751) + lu(k,756) = lu(k,756) * lu(k,751) + lu(k,757) = lu(k,757) * lu(k,751) + lu(k,758) = lu(k,758) * lu(k,751) + lu(k,759) = lu(k,759) * lu(k,751) + lu(k,760) = lu(k,760) * lu(k,751) + lu(k,1765) = lu(k,1765) - lu(k,752) * lu(k,1763) + lu(k,1774) = lu(k,1774) - lu(k,753) * lu(k,1763) + lu(k,1784) = lu(k,1784) - lu(k,754) * lu(k,1763) + lu(k,1793) = lu(k,1793) - lu(k,755) * lu(k,1763) + lu(k,1802) = lu(k,1802) - lu(k,756) * lu(k,1763) + lu(k,1818) = lu(k,1818) - lu(k,757) * lu(k,1763) + lu(k,1819) = lu(k,1819) - lu(k,758) * lu(k,1763) + lu(k,1820) = lu(k,1820) - lu(k,759) * lu(k,1763) + lu(k,1829) = lu(k,1829) - lu(k,760) * lu(k,1763) + lu(k,1870) = lu(k,1870) - lu(k,752) * lu(k,1868) + lu(k,1878) = lu(k,1878) - lu(k,753) * lu(k,1868) + lu(k,1883) = lu(k,1883) - lu(k,754) * lu(k,1868) + lu(k,1891) = lu(k,1891) - lu(k,755) * lu(k,1868) + lu(k,1900) = lu(k,1900) - lu(k,756) * lu(k,1868) + lu(k,1913) = lu(k,1913) - lu(k,757) * lu(k,1868) + lu(k,1914) = lu(k,1914) - lu(k,758) * lu(k,1868) + lu(k,1915) = lu(k,1915) - lu(k,759) * lu(k,1868) + lu(k,1924) = lu(k,1924) - lu(k,760) * lu(k,1868) + lu(k,2315) = lu(k,2315) - lu(k,752) * lu(k,2313) + lu(k,2323) = lu(k,2323) - lu(k,753) * lu(k,2313) + lu(k,2327) = lu(k,2327) - lu(k,754) * lu(k,2313) + lu(k,2334) = lu(k,2334) - lu(k,755) * lu(k,2313) + lu(k,2342) = lu(k,2342) - lu(k,756) * lu(k,2313) + lu(k,2357) = lu(k,2357) - lu(k,757) * lu(k,2313) + lu(k,2358) = lu(k,2358) - lu(k,758) * lu(k,2313) + lu(k,2359) = lu(k,2359) - lu(k,759) * lu(k,2313) + lu(k,2368) = lu(k,2368) - lu(k,760) * lu(k,2313) + lu(k,767) = 1._r8 / lu(k,767) + lu(k,768) = lu(k,768) * lu(k,767) + lu(k,769) = lu(k,769) * lu(k,767) + lu(k,770) = lu(k,770) * lu(k,767) + lu(k,771) = lu(k,771) * lu(k,767) + lu(k,772) = lu(k,772) * lu(k,767) + lu(k,773) = lu(k,773) * lu(k,767) + lu(k,774) = lu(k,774) * lu(k,767) + lu(k,775) = lu(k,775) * lu(k,767) + lu(k,776) = lu(k,776) * lu(k,767) + lu(k,777) = lu(k,777) * lu(k,767) + lu(k,1765) = lu(k,1765) - lu(k,768) * lu(k,1764) + lu(k,1774) = lu(k,1774) - lu(k,769) * lu(k,1764) + lu(k,1784) = lu(k,1784) - lu(k,770) * lu(k,1764) + lu(k,1793) = lu(k,1793) - lu(k,771) * lu(k,1764) + lu(k,1802) = lu(k,1802) - lu(k,772) * lu(k,1764) + lu(k,1808) = lu(k,1808) - lu(k,773) * lu(k,1764) + lu(k,1818) = lu(k,1818) - lu(k,774) * lu(k,1764) + lu(k,1819) = lu(k,1819) - lu(k,775) * lu(k,1764) + lu(k,1820) = lu(k,1820) - lu(k,776) * lu(k,1764) + lu(k,1829) = lu(k,1829) - lu(k,777) * lu(k,1764) + lu(k,1870) = lu(k,1870) - lu(k,768) * lu(k,1869) + lu(k,1878) = lu(k,1878) - lu(k,769) * lu(k,1869) + lu(k,1883) = lu(k,1883) - lu(k,770) * lu(k,1869) + lu(k,1891) = lu(k,1891) - lu(k,771) * lu(k,1869) + lu(k,1900) = lu(k,1900) - lu(k,772) * lu(k,1869) + lu(k,1906) = lu(k,1906) - lu(k,773) * lu(k,1869) + lu(k,1913) = lu(k,1913) - lu(k,774) * lu(k,1869) + lu(k,1914) = lu(k,1914) - lu(k,775) * lu(k,1869) + lu(k,1915) = lu(k,1915) - lu(k,776) * lu(k,1869) + lu(k,1924) = lu(k,1924) - lu(k,777) * lu(k,1869) + lu(k,2315) = lu(k,2315) - lu(k,768) * lu(k,2314) + lu(k,2323) = lu(k,2323) - lu(k,769) * lu(k,2314) + lu(k,2327) = lu(k,2327) - lu(k,770) * lu(k,2314) + lu(k,2334) = lu(k,2334) - lu(k,771) * lu(k,2314) + lu(k,2342) = lu(k,2342) - lu(k,772) * lu(k,2314) + lu(k,2348) = lu(k,2348) - lu(k,773) * lu(k,2314) + lu(k,2357) = lu(k,2357) - lu(k,774) * lu(k,2314) + lu(k,2358) = lu(k,2358) - lu(k,775) * lu(k,2314) + lu(k,2359) = lu(k,2359) - lu(k,776) * lu(k,2314) + lu(k,2368) = lu(k,2368) - lu(k,777) * lu(k,2314) + lu(k,778) = 1._r8 / lu(k,778) + lu(k,779) = lu(k,779) * lu(k,778) + lu(k,780) = lu(k,780) * lu(k,778) + lu(k,781) = lu(k,781) * lu(k,778) + lu(k,782) = lu(k,782) * lu(k,778) + lu(k,783) = lu(k,783) * lu(k,778) + lu(k,784) = lu(k,784) * lu(k,778) + lu(k,785) = lu(k,785) * lu(k,778) + lu(k,1793) = lu(k,1793) - lu(k,779) * lu(k,1765) + lu(k,1802) = lu(k,1802) - lu(k,780) * lu(k,1765) + lu(k,1818) = lu(k,1818) - lu(k,781) * lu(k,1765) + lu(k,1819) = lu(k,1819) - lu(k,782) * lu(k,1765) + lu(k,1820) = lu(k,1820) - lu(k,783) * lu(k,1765) + lu(k,1829) = lu(k,1829) - lu(k,784) * lu(k,1765) + lu(k,1830) = lu(k,1830) - lu(k,785) * lu(k,1765) + lu(k,1891) = lu(k,1891) - lu(k,779) * lu(k,1870) + lu(k,1900) = lu(k,1900) - lu(k,780) * lu(k,1870) + lu(k,1913) = lu(k,1913) - lu(k,781) * lu(k,1870) + lu(k,1914) = lu(k,1914) - lu(k,782) * lu(k,1870) + lu(k,1915) = lu(k,1915) - lu(k,783) * lu(k,1870) + lu(k,1924) = lu(k,1924) - lu(k,784) * lu(k,1870) + lu(k,1925) = lu(k,1925) - lu(k,785) * lu(k,1870) + lu(k,1945) = lu(k,1945) - lu(k,779) * lu(k,1938) + lu(k,1947) = - lu(k,780) * lu(k,1938) + lu(k,1958) = lu(k,1958) - lu(k,781) * lu(k,1938) + lu(k,1959) = lu(k,1959) - lu(k,782) * lu(k,1938) + lu(k,1960) = lu(k,1960) - lu(k,783) * lu(k,1938) + lu(k,1969) = lu(k,1969) - lu(k,784) * lu(k,1938) + lu(k,1970) = lu(k,1970) - lu(k,785) * lu(k,1938) + lu(k,2334) = lu(k,2334) - lu(k,779) * lu(k,2315) + lu(k,2342) = lu(k,2342) - lu(k,780) * lu(k,2315) + lu(k,2357) = lu(k,2357) - lu(k,781) * lu(k,2315) + lu(k,2358) = lu(k,2358) - lu(k,782) * lu(k,2315) + lu(k,2359) = lu(k,2359) - lu(k,783) * lu(k,2315) + lu(k,2368) = lu(k,2368) - lu(k,784) * lu(k,2315) + lu(k,2369) = lu(k,2369) - lu(k,785) * lu(k,2315) + lu(k,787) = 1._r8 / lu(k,787) + lu(k,788) = lu(k,788) * lu(k,787) + lu(k,789) = lu(k,789) * lu(k,787) + lu(k,790) = lu(k,790) * lu(k,787) + lu(k,791) = lu(k,791) * lu(k,787) + lu(k,792) = lu(k,792) * lu(k,787) + lu(k,793) = lu(k,793) * lu(k,787) + lu(k,794) = lu(k,794) * lu(k,787) + lu(k,1495) = lu(k,1495) - lu(k,788) * lu(k,1492) + lu(k,1496) = lu(k,1496) - lu(k,789) * lu(k,1492) + lu(k,1497) = - lu(k,790) * lu(k,1492) + lu(k,1500) = lu(k,1500) - lu(k,791) * lu(k,1492) + lu(k,1504) = lu(k,1504) - lu(k,792) * lu(k,1492) + lu(k,1506) = lu(k,1506) - lu(k,793) * lu(k,1492) + lu(k,1507) = lu(k,1507) - lu(k,794) * lu(k,1492) + lu(k,1562) = - lu(k,788) * lu(k,1559) + lu(k,1563) = lu(k,1563) - lu(k,789) * lu(k,1559) + lu(k,1565) = lu(k,1565) - lu(k,790) * lu(k,1559) + lu(k,1568) = lu(k,1568) - lu(k,791) * lu(k,1559) + lu(k,1574) = lu(k,1574) - lu(k,792) * lu(k,1559) + lu(k,1576) = lu(k,1576) - lu(k,793) * lu(k,1559) + lu(k,1579) = - lu(k,794) * lu(k,1559) + lu(k,1952) = - lu(k,788) * lu(k,1939) + lu(k,1953) = lu(k,1953) - lu(k,789) * lu(k,1939) + lu(k,1955) = lu(k,1955) - lu(k,790) * lu(k,1939) + lu(k,1958) = lu(k,1958) - lu(k,791) * lu(k,1939) + lu(k,1964) = lu(k,1964) - lu(k,792) * lu(k,1939) + lu(k,1966) = - lu(k,793) * lu(k,1939) + lu(k,1971) = lu(k,1971) - lu(k,794) * lu(k,1939) + lu(k,2087) = lu(k,2087) - lu(k,788) * lu(k,2073) + lu(k,2088) = lu(k,2088) - lu(k,789) * lu(k,2073) + lu(k,2090) = lu(k,2090) - lu(k,790) * lu(k,2073) + lu(k,2093) = lu(k,2093) - lu(k,791) * lu(k,2073) + lu(k,2099) = lu(k,2099) - lu(k,792) * lu(k,2073) + lu(k,2101) = lu(k,2101) - lu(k,793) * lu(k,2073) + lu(k,2106) = lu(k,2106) - lu(k,794) * lu(k,2073) + lu(k,2351) = lu(k,2351) - lu(k,788) * lu(k,2316) + lu(k,2352) = lu(k,2352) - lu(k,789) * lu(k,2316) + lu(k,2354) = lu(k,2354) - lu(k,790) * lu(k,2316) + lu(k,2357) = lu(k,2357) - lu(k,791) * lu(k,2316) + lu(k,2363) = lu(k,2363) - lu(k,792) * lu(k,2316) + lu(k,2365) = lu(k,2365) - lu(k,793) * lu(k,2316) + lu(k,2370) = lu(k,2370) - lu(k,794) * lu(k,2316) + 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,797) = 1._r8 / lu(k,797) + lu(k,798) = lu(k,798) * lu(k,797) + lu(k,799) = lu(k,799) * lu(k,797) + lu(k,800) = lu(k,800) * lu(k,797) + lu(k,801) = lu(k,801) * lu(k,797) + lu(k,802) = lu(k,802) * lu(k,797) + lu(k,803) = lu(k,803) * lu(k,797) + lu(k,804) = lu(k,804) * lu(k,797) + lu(k,1794) = lu(k,1794) - lu(k,798) * lu(k,1766) + lu(k,1814) = lu(k,1814) - lu(k,799) * lu(k,1766) + lu(k,1818) = lu(k,1818) - lu(k,800) * lu(k,1766) + lu(k,1819) = lu(k,1819) - lu(k,801) * lu(k,1766) + lu(k,1820) = lu(k,1820) - lu(k,802) * lu(k,1766) + lu(k,1821) = lu(k,1821) - lu(k,803) * lu(k,1766) + lu(k,1829) = lu(k,1829) - lu(k,804) * lu(k,1766) + lu(k,1892) = lu(k,1892) - lu(k,798) * lu(k,1871) + lu(k,1909) = lu(k,1909) - lu(k,799) * lu(k,1871) + lu(k,1913) = lu(k,1913) - lu(k,800) * lu(k,1871) + lu(k,1914) = lu(k,1914) - lu(k,801) * lu(k,1871) + lu(k,1915) = lu(k,1915) - lu(k,802) * lu(k,1871) + lu(k,1916) = lu(k,1916) - lu(k,803) * lu(k,1871) + lu(k,1924) = lu(k,1924) - lu(k,804) * lu(k,1871) + lu(k,2148) = - lu(k,798) * lu(k,2138) + lu(k,2156) = lu(k,2156) - lu(k,799) * lu(k,2138) + lu(k,2160) = lu(k,2160) - lu(k,800) * lu(k,2138) + lu(k,2161) = - lu(k,801) * lu(k,2138) + lu(k,2162) = - lu(k,802) * lu(k,2138) + lu(k,2163) = lu(k,2163) - lu(k,803) * lu(k,2138) + lu(k,2171) = lu(k,2171) - lu(k,804) * lu(k,2138) + lu(k,2204) = - lu(k,798) * lu(k,2188) + lu(k,2220) = lu(k,2220) - lu(k,799) * lu(k,2188) + lu(k,2224) = lu(k,2224) - lu(k,800) * lu(k,2188) + lu(k,2225) = lu(k,2225) - lu(k,801) * lu(k,2188) + lu(k,2226) = lu(k,2226) - lu(k,802) * lu(k,2188) + lu(k,2227) = lu(k,2227) - lu(k,803) * lu(k,2188) + lu(k,2235) = lu(k,2235) - lu(k,804) * lu(k,2188) + lu(k,2335) = lu(k,2335) - lu(k,798) * lu(k,2317) + lu(k,2353) = lu(k,2353) - lu(k,799) * lu(k,2317) + lu(k,2357) = lu(k,2357) - lu(k,800) * lu(k,2317) + lu(k,2358) = lu(k,2358) - lu(k,801) * lu(k,2317) + lu(k,2359) = lu(k,2359) - lu(k,802) * lu(k,2317) + lu(k,2360) = lu(k,2360) - lu(k,803) * lu(k,2317) + lu(k,2368) = lu(k,2368) - lu(k,804) * lu(k,2317) + lu(k,805) = 1._r8 / lu(k,805) + lu(k,806) = lu(k,806) * lu(k,805) + lu(k,807) = lu(k,807) * lu(k,805) + lu(k,808) = lu(k,808) * lu(k,805) + lu(k,809) = lu(k,809) * lu(k,805) + lu(k,810) = lu(k,810) * lu(k,805) + lu(k,811) = lu(k,811) * lu(k,805) + lu(k,812) = lu(k,812) * lu(k,805) + lu(k,863) = lu(k,863) - lu(k,806) * lu(k,862) + lu(k,864) = lu(k,864) - lu(k,807) * lu(k,862) + lu(k,866) = lu(k,866) - lu(k,808) * lu(k,862) + lu(k,867) = - lu(k,809) * lu(k,862) + lu(k,868) = - lu(k,810) * lu(k,862) + lu(k,869) = lu(k,869) - lu(k,811) * lu(k,862) + lu(k,872) = lu(k,872) - lu(k,812) * lu(k,862) + lu(k,996) = lu(k,996) - lu(k,806) * lu(k,995) + lu(k,997) = lu(k,997) - lu(k,807) * lu(k,995) + lu(k,999) = lu(k,999) - lu(k,808) * lu(k,995) + lu(k,1000) = - lu(k,809) * lu(k,995) + lu(k,1001) = - lu(k,810) * lu(k,995) + lu(k,1002) = lu(k,1002) - lu(k,811) * lu(k,995) + lu(k,1007) = lu(k,1007) - lu(k,812) * lu(k,995) + lu(k,1445) = - lu(k,806) * lu(k,1444) + lu(k,1446) = lu(k,1446) - lu(k,807) * lu(k,1444) + lu(k,1448) = - lu(k,808) * lu(k,1444) + lu(k,1449) = lu(k,1449) - lu(k,809) * lu(k,1444) + lu(k,1450) = lu(k,1450) - lu(k,810) * lu(k,1444) + lu(k,1451) = lu(k,1451) - lu(k,811) * lu(k,1444) + lu(k,1456) = lu(k,1456) - lu(k,812) * lu(k,1444) + lu(k,1532) = lu(k,1532) - lu(k,806) * lu(k,1531) + lu(k,1533) = lu(k,1533) - lu(k,807) * lu(k,1531) + lu(k,1536) = lu(k,1536) - lu(k,808) * lu(k,1531) + lu(k,1537) = - lu(k,809) * lu(k,1531) + lu(k,1539) = - lu(k,810) * lu(k,1531) + lu(k,1542) = lu(k,1542) - lu(k,811) * lu(k,1531) + lu(k,1550) = lu(k,1550) - lu(k,812) * lu(k,1531) + lu(k,2077) = lu(k,2077) - lu(k,806) * lu(k,2074) + lu(k,2078) = lu(k,2078) - lu(k,807) * lu(k,2074) + lu(k,2082) = lu(k,2082) - lu(k,808) * lu(k,2074) + lu(k,2083) = lu(k,2083) - lu(k,809) * lu(k,2074) + lu(k,2084) = - lu(k,810) * lu(k,2074) + lu(k,2089) = lu(k,2089) - lu(k,811) * lu(k,2074) + lu(k,2099) = lu(k,2099) - lu(k,812) * lu(k,2074) + lu(k,814) = 1._r8 / lu(k,814) + lu(k,815) = lu(k,815) * lu(k,814) + lu(k,816) = lu(k,816) * lu(k,814) + lu(k,817) = lu(k,817) * lu(k,814) + lu(k,818) = lu(k,818) * lu(k,814) + lu(k,819) = lu(k,819) * lu(k,814) + lu(k,820) = lu(k,820) * lu(k,814) + lu(k,821) = lu(k,821) * lu(k,814) + lu(k,822) = lu(k,822) * lu(k,814) + lu(k,823) = lu(k,823) * lu(k,814) + lu(k,1134) = lu(k,1134) - lu(k,815) * lu(k,1130) + lu(k,1136) = - lu(k,816) * lu(k,1130) + lu(k,1140) = - lu(k,817) * lu(k,1130) + lu(k,1142) = lu(k,1142) - lu(k,818) * lu(k,1130) + lu(k,1143) = - lu(k,819) * lu(k,1130) + lu(k,1144) = - lu(k,820) * lu(k,1130) + lu(k,1145) = lu(k,1145) - lu(k,821) * lu(k,1130) + lu(k,1148) = lu(k,1148) - lu(k,822) * lu(k,1130) + lu(k,1150) = lu(k,1150) - lu(k,823) * lu(k,1130) + lu(k,1792) = lu(k,1792) - lu(k,815) * lu(k,1767) + lu(k,1797) = lu(k,1797) - lu(k,816) * lu(k,1767) + lu(k,1814) = lu(k,1814) - lu(k,817) * lu(k,1767) + lu(k,1818) = lu(k,1818) - lu(k,818) * lu(k,1767) + lu(k,1819) = lu(k,1819) - lu(k,819) * lu(k,1767) + lu(k,1820) = lu(k,1820) - lu(k,820) * lu(k,1767) + lu(k,1821) = lu(k,1821) - lu(k,821) * lu(k,1767) + lu(k,1829) = lu(k,1829) - lu(k,822) * lu(k,1767) + lu(k,1831) = lu(k,1831) - lu(k,823) * lu(k,1767) + lu(k,1890) = lu(k,1890) - lu(k,815) * lu(k,1872) + lu(k,1895) = lu(k,1895) - lu(k,816) * lu(k,1872) + lu(k,1909) = lu(k,1909) - lu(k,817) * lu(k,1872) + lu(k,1913) = lu(k,1913) - lu(k,818) * lu(k,1872) + lu(k,1914) = lu(k,1914) - lu(k,819) * lu(k,1872) + lu(k,1915) = lu(k,1915) - lu(k,820) * lu(k,1872) + lu(k,1916) = lu(k,1916) - lu(k,821) * lu(k,1872) + lu(k,1924) = lu(k,1924) - lu(k,822) * lu(k,1872) + lu(k,1926) = - lu(k,823) * lu(k,1872) + lu(k,2333) = lu(k,2333) - lu(k,815) * lu(k,2318) + lu(k,2337) = lu(k,2337) - lu(k,816) * lu(k,2318) + lu(k,2353) = lu(k,2353) - lu(k,817) * lu(k,2318) + lu(k,2357) = lu(k,2357) - lu(k,818) * lu(k,2318) + lu(k,2358) = lu(k,2358) - lu(k,819) * lu(k,2318) + lu(k,2359) = lu(k,2359) - lu(k,820) * lu(k,2318) + lu(k,2360) = lu(k,2360) - lu(k,821) * lu(k,2318) + lu(k,2368) = lu(k,2368) - lu(k,822) * lu(k,2318) + lu(k,2370) = lu(k,2370) - lu(k,823) * lu(k,2318) + lu(k,824) = 1._r8 / lu(k,824) + lu(k,825) = lu(k,825) * lu(k,824) + lu(k,826) = lu(k,826) * lu(k,824) + lu(k,827) = lu(k,827) * lu(k,824) + lu(k,904) = lu(k,904) - lu(k,825) * lu(k,900) + lu(k,907) = lu(k,907) - lu(k,826) * lu(k,900) + lu(k,908) = lu(k,908) - lu(k,827) * lu(k,900) + lu(k,1065) = lu(k,1065) - lu(k,825) * lu(k,1061) + lu(k,1068) = lu(k,1068) - lu(k,826) * lu(k,1061) + lu(k,1070) = lu(k,1070) - lu(k,827) * lu(k,1061) + lu(k,1111) = lu(k,1111) - lu(k,825) * lu(k,1104) + lu(k,1114) = lu(k,1114) - lu(k,826) * lu(k,1104) + lu(k,1116) = lu(k,1116) - lu(k,827) * lu(k,1104) + lu(k,1182) = lu(k,1182) - lu(k,825) * lu(k,1173) + lu(k,1185) = lu(k,1185) - lu(k,826) * lu(k,1173) + lu(k,1187) = lu(k,1187) - lu(k,827) * lu(k,1173) + lu(k,1220) = lu(k,1220) - lu(k,825) * lu(k,1215) + lu(k,1223) = lu(k,1223) - lu(k,826) * lu(k,1215) + lu(k,1224) = lu(k,1224) - lu(k,827) * lu(k,1215) + lu(k,1238) = lu(k,1238) - lu(k,825) * lu(k,1228) + lu(k,1241) = lu(k,1241) - lu(k,826) * lu(k,1228) + lu(k,1242) = lu(k,1242) - lu(k,827) * lu(k,1228) + lu(k,1260) = lu(k,1260) - lu(k,825) * lu(k,1247) + lu(k,1263) = lu(k,1263) - lu(k,826) * lu(k,1247) + lu(k,1265) = lu(k,1265) - lu(k,827) * lu(k,1247) + lu(k,1306) = lu(k,1306) - lu(k,825) * lu(k,1291) + lu(k,1309) = lu(k,1309) - lu(k,826) * lu(k,1291) + lu(k,1312) = lu(k,1312) - lu(k,827) * lu(k,1291) + lu(k,1339) = lu(k,1339) - lu(k,825) * lu(k,1320) + lu(k,1342) = lu(k,1342) - lu(k,826) * lu(k,1320) + lu(k,1345) = lu(k,1345) - lu(k,827) * lu(k,1320) + lu(k,1361) = lu(k,1361) - lu(k,825) * lu(k,1349) + lu(k,1364) = lu(k,1364) - lu(k,826) * lu(k,1349) + lu(k,1366) = lu(k,1366) - lu(k,827) * lu(k,1349) + lu(k,1818) = lu(k,1818) - lu(k,825) * lu(k,1768) + lu(k,1821) = lu(k,1821) - lu(k,826) * lu(k,1768) + lu(k,1829) = lu(k,1829) - lu(k,827) * lu(k,1768) + lu(k,2409) = lu(k,2409) - lu(k,825) * lu(k,2377) + lu(k,2412) = lu(k,2412) - lu(k,826) * lu(k,2377) + lu(k,2420) = lu(k,2420) - lu(k,827) * lu(k,2377) + lu(k,828) = 1._r8 / lu(k,828) + lu(k,829) = lu(k,829) * lu(k,828) + lu(k,830) = lu(k,830) * lu(k,828) + lu(k,831) = lu(k,831) * lu(k,828) + lu(k,832) = lu(k,832) * lu(k,828) + lu(k,833) = lu(k,833) * lu(k,828) + lu(k,834) = lu(k,834) * lu(k,828) + lu(k,835) = lu(k,835) * lu(k,828) + lu(k,1511) = lu(k,1511) - lu(k,829) * lu(k,1508) + lu(k,1513) = lu(k,1513) - lu(k,830) * lu(k,1508) + lu(k,1514) = - lu(k,831) * lu(k,1508) + lu(k,1518) = - lu(k,832) * lu(k,1508) + lu(k,1519) = - lu(k,833) * lu(k,1508) + lu(k,1520) = - lu(k,834) * lu(k,1508) + lu(k,1523) = - lu(k,835) * lu(k,1508) + lu(k,1813) = lu(k,1813) - lu(k,829) * lu(k,1769) + lu(k,1815) = lu(k,1815) - lu(k,830) * lu(k,1769) + lu(k,1818) = lu(k,1818) - lu(k,831) * lu(k,1769) + lu(k,1822) = lu(k,1822) - lu(k,832) * lu(k,1769) + lu(k,1824) = lu(k,1824) - lu(k,833) * lu(k,1769) + lu(k,1825) = lu(k,1825) - lu(k,834) * lu(k,1769) + lu(k,1831) = lu(k,1831) - lu(k,835) * lu(k,1769) + lu(k,1979) = lu(k,1979) - lu(k,829) * lu(k,1973) + lu(k,1981) = - lu(k,830) * lu(k,1973) + lu(k,1984) = lu(k,1984) - lu(k,831) * lu(k,1973) + lu(k,1988) = - lu(k,832) * lu(k,1973) + lu(k,1990) = lu(k,1990) - lu(k,833) * lu(k,1973) + lu(k,1991) = lu(k,1991) - lu(k,834) * lu(k,1973) + lu(k,1997) = lu(k,1997) - lu(k,835) * lu(k,1973) + lu(k,2022) = lu(k,2022) - lu(k,829) * lu(k,2018) + lu(k,2024) = lu(k,2024) - lu(k,830) * lu(k,2018) + lu(k,2027) = lu(k,2027) - lu(k,831) * lu(k,2018) + lu(k,2031) = lu(k,2031) - lu(k,832) * lu(k,2018) + lu(k,2033) = lu(k,2033) - lu(k,833) * lu(k,2018) + lu(k,2034) = lu(k,2034) - lu(k,834) * lu(k,2018) + lu(k,2040) = lu(k,2040) - lu(k,835) * lu(k,2018) + lu(k,2088) = lu(k,2088) - lu(k,829) * lu(k,2075) + lu(k,2090) = lu(k,2090) - lu(k,830) * lu(k,2075) + lu(k,2093) = lu(k,2093) - lu(k,831) * lu(k,2075) + lu(k,2097) = lu(k,2097) - lu(k,832) * lu(k,2075) + lu(k,2099) = lu(k,2099) - lu(k,833) * lu(k,2075) + lu(k,2100) = lu(k,2100) - lu(k,834) * lu(k,2075) + lu(k,2106) = lu(k,2106) - lu(k,835) * lu(k,2075) + lu(k,2352) = lu(k,2352) - lu(k,829) * lu(k,2319) + lu(k,2354) = lu(k,2354) - lu(k,830) * lu(k,2319) + lu(k,2357) = lu(k,2357) - lu(k,831) * lu(k,2319) + lu(k,2361) = - lu(k,832) * lu(k,2319) + lu(k,2363) = lu(k,2363) - lu(k,833) * lu(k,2319) + lu(k,2364) = lu(k,2364) - lu(k,834) * lu(k,2319) + lu(k,2370) = lu(k,2370) - lu(k,835) * lu(k,2319) + 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,837) = 1._r8 / lu(k,837) + lu(k,838) = lu(k,838) * lu(k,837) + lu(k,839) = lu(k,839) * lu(k,837) + lu(k,840) = lu(k,840) * lu(k,837) + lu(k,841) = lu(k,841) * lu(k,837) + lu(k,842) = lu(k,842) * lu(k,837) + lu(k,843) = lu(k,843) * lu(k,837) + lu(k,956) = lu(k,956) - lu(k,838) * lu(k,954) + lu(k,957) = lu(k,957) - lu(k,839) * lu(k,954) + lu(k,959) = lu(k,959) - lu(k,840) * lu(k,954) + lu(k,962) = lu(k,962) - lu(k,841) * lu(k,954) + lu(k,963) = lu(k,963) - lu(k,842) * lu(k,954) + lu(k,964) = - lu(k,843) * lu(k,954) + lu(k,1495) = lu(k,1495) - lu(k,838) * lu(k,1493) + lu(k,1498) = lu(k,1498) - lu(k,839) * lu(k,1493) + lu(k,1500) = lu(k,1500) - lu(k,840) * lu(k,1493) + lu(k,1504) = lu(k,1504) - lu(k,841) * lu(k,1493) + lu(k,1506) = lu(k,1506) - lu(k,842) * lu(k,1493) + lu(k,1507) = lu(k,1507) - lu(k,843) * lu(k,1493) + lu(k,1588) = lu(k,1588) - lu(k,838) * lu(k,1584) + lu(k,1592) = lu(k,1592) - lu(k,839) * lu(k,1584) + lu(k,1594) = lu(k,1594) - lu(k,840) * lu(k,1584) + lu(k,1600) = lu(k,1600) - lu(k,841) * lu(k,1584) + lu(k,1602) = lu(k,1602) - lu(k,842) * lu(k,1584) + lu(k,1606) = - lu(k,843) * lu(k,1584) + lu(k,1812) = lu(k,1812) - lu(k,838) * lu(k,1770) + lu(k,1816) = lu(k,1816) - lu(k,839) * lu(k,1770) + lu(k,1818) = lu(k,1818) - lu(k,840) * lu(k,1770) + lu(k,1824) = lu(k,1824) - lu(k,841) * lu(k,1770) + lu(k,1826) = lu(k,1826) - lu(k,842) * lu(k,1770) + lu(k,1831) = lu(k,1831) - lu(k,843) * lu(k,1770) + lu(k,2087) = lu(k,2087) - lu(k,838) * lu(k,2076) + lu(k,2091) = lu(k,2091) - lu(k,839) * lu(k,2076) + lu(k,2093) = lu(k,2093) - lu(k,840) * lu(k,2076) + lu(k,2099) = lu(k,2099) - lu(k,841) * lu(k,2076) + lu(k,2101) = lu(k,2101) - lu(k,842) * lu(k,2076) + lu(k,2106) = lu(k,2106) - lu(k,843) * lu(k,2076) + lu(k,2154) = lu(k,2154) - lu(k,838) * lu(k,2139) + lu(k,2158) = lu(k,2158) - lu(k,839) * lu(k,2139) + lu(k,2160) = lu(k,2160) - lu(k,840) * lu(k,2139) + lu(k,2166) = lu(k,2166) - lu(k,841) * lu(k,2139) + lu(k,2168) = lu(k,2168) - lu(k,842) * lu(k,2139) + lu(k,2173) = lu(k,2173) - lu(k,843) * lu(k,2139) + lu(k,2351) = lu(k,2351) - lu(k,838) * lu(k,2320) + lu(k,2355) = lu(k,2355) - lu(k,839) * lu(k,2320) + lu(k,2357) = lu(k,2357) - lu(k,840) * lu(k,2320) + lu(k,2363) = lu(k,2363) - lu(k,841) * lu(k,2320) + lu(k,2365) = lu(k,2365) - lu(k,842) * lu(k,2320) + lu(k,2370) = lu(k,2370) - lu(k,843) * lu(k,2320) + lu(k,845) = 1._r8 / lu(k,845) + lu(k,846) = lu(k,846) * lu(k,845) + lu(k,847) = lu(k,847) * lu(k,845) + lu(k,848) = lu(k,848) * lu(k,845) + lu(k,849) = lu(k,849) * lu(k,845) + lu(k,850) = lu(k,850) * lu(k,845) + lu(k,851) = lu(k,851) * lu(k,845) + lu(k,854) = lu(k,854) - lu(k,846) * lu(k,852) + lu(k,855) = lu(k,855) - lu(k,847) * lu(k,852) + lu(k,856) = lu(k,856) - lu(k,848) * lu(k,852) + lu(k,857) = lu(k,857) - lu(k,849) * lu(k,852) + lu(k,858) = lu(k,858) - lu(k,850) * lu(k,852) + lu(k,859) = lu(k,859) - lu(k,851) * lu(k,852) + lu(k,865) = lu(k,865) - lu(k,846) * lu(k,863) + lu(k,866) = lu(k,866) - lu(k,847) * lu(k,863) + lu(k,869) = lu(k,869) - lu(k,848) * lu(k,863) + lu(k,870) = lu(k,870) - lu(k,849) * lu(k,863) + lu(k,871) = lu(k,871) - lu(k,850) * lu(k,863) + lu(k,872) = lu(k,872) - lu(k,851) * lu(k,863) + lu(k,998) = lu(k,998) - lu(k,846) * lu(k,996) + lu(k,999) = lu(k,999) - lu(k,847) * lu(k,996) + lu(k,1002) = lu(k,1002) - lu(k,848) * lu(k,996) + lu(k,1004) = lu(k,1004) - lu(k,849) * lu(k,996) + lu(k,1006) = lu(k,1006) - lu(k,850) * lu(k,996) + lu(k,1007) = lu(k,1007) - lu(k,851) * lu(k,996) + lu(k,1447) = - lu(k,846) * lu(k,1445) + lu(k,1448) = lu(k,1448) - lu(k,847) * lu(k,1445) + lu(k,1451) = lu(k,1451) - lu(k,848) * lu(k,1445) + lu(k,1453) = - lu(k,849) * lu(k,1445) + lu(k,1455) = - lu(k,850) * lu(k,1445) + lu(k,1456) = lu(k,1456) - lu(k,851) * lu(k,1445) + lu(k,1534) = lu(k,1534) - lu(k,846) * lu(k,1532) + lu(k,1536) = lu(k,1536) - lu(k,847) * lu(k,1532) + lu(k,1542) = lu(k,1542) - lu(k,848) * lu(k,1532) + lu(k,1546) = lu(k,1546) - lu(k,849) * lu(k,1532) + lu(k,1549) = lu(k,1549) - lu(k,850) * lu(k,1532) + lu(k,1550) = lu(k,1550) - lu(k,851) * lu(k,1532) + lu(k,1875) = lu(k,1875) - lu(k,846) * lu(k,1873) + lu(k,1881) = lu(k,1881) - lu(k,847) * lu(k,1873) + lu(k,1909) = lu(k,1909) - lu(k,848) * lu(k,1873) + lu(k,1914) = lu(k,1914) - lu(k,849) * lu(k,1873) + lu(k,1917) = - lu(k,850) * lu(k,1873) + lu(k,1919) = lu(k,1919) - lu(k,851) * lu(k,1873) + lu(k,2079) = lu(k,2079) - lu(k,846) * lu(k,2077) + lu(k,2082) = lu(k,2082) - lu(k,847) * lu(k,2077) + lu(k,2089) = lu(k,2089) - lu(k,848) * lu(k,2077) + lu(k,2094) = lu(k,2094) - lu(k,849) * lu(k,2077) + lu(k,2097) = lu(k,2097) - lu(k,850) * lu(k,2077) + lu(k,2099) = lu(k,2099) - lu(k,851) * lu(k,2077) + lu(k,853) = 1._r8 / lu(k,853) + lu(k,854) = lu(k,854) * lu(k,853) + lu(k,855) = lu(k,855) * lu(k,853) + lu(k,856) = lu(k,856) * lu(k,853) + lu(k,857) = lu(k,857) * lu(k,853) + lu(k,858) = lu(k,858) * lu(k,853) + lu(k,859) = lu(k,859) * lu(k,853) + lu(k,865) = lu(k,865) - lu(k,854) * lu(k,864) + lu(k,866) = lu(k,866) - lu(k,855) * lu(k,864) + lu(k,869) = lu(k,869) - lu(k,856) * lu(k,864) + lu(k,870) = lu(k,870) - lu(k,857) * lu(k,864) + lu(k,871) = lu(k,871) - lu(k,858) * lu(k,864) + lu(k,872) = lu(k,872) - lu(k,859) * lu(k,864) + lu(k,998) = lu(k,998) - lu(k,854) * lu(k,997) + lu(k,999) = lu(k,999) - lu(k,855) * lu(k,997) + lu(k,1002) = lu(k,1002) - lu(k,856) * lu(k,997) + lu(k,1004) = lu(k,1004) - lu(k,857) * lu(k,997) + lu(k,1006) = lu(k,1006) - lu(k,858) * lu(k,997) + lu(k,1007) = lu(k,1007) - lu(k,859) * lu(k,997) + lu(k,1447) = lu(k,1447) - lu(k,854) * lu(k,1446) + lu(k,1448) = lu(k,1448) - lu(k,855) * lu(k,1446) + lu(k,1451) = lu(k,1451) - lu(k,856) * lu(k,1446) + lu(k,1453) = lu(k,1453) - lu(k,857) * lu(k,1446) + lu(k,1455) = lu(k,1455) - lu(k,858) * lu(k,1446) + lu(k,1456) = lu(k,1456) - lu(k,859) * lu(k,1446) + lu(k,1534) = lu(k,1534) - lu(k,854) * lu(k,1533) + lu(k,1536) = lu(k,1536) - lu(k,855) * lu(k,1533) + lu(k,1542) = lu(k,1542) - lu(k,856) * lu(k,1533) + lu(k,1546) = lu(k,1546) - lu(k,857) * lu(k,1533) + lu(k,1549) = lu(k,1549) - lu(k,858) * lu(k,1533) + lu(k,1550) = lu(k,1550) - lu(k,859) * lu(k,1533) + lu(k,1875) = lu(k,1875) - lu(k,854) * lu(k,1874) + lu(k,1881) = lu(k,1881) - lu(k,855) * lu(k,1874) + lu(k,1909) = lu(k,1909) - lu(k,856) * lu(k,1874) + lu(k,1914) = lu(k,1914) - lu(k,857) * lu(k,1874) + lu(k,1917) = lu(k,1917) - lu(k,858) * lu(k,1874) + lu(k,1919) = lu(k,1919) - lu(k,859) * lu(k,1874) + lu(k,2079) = lu(k,2079) - lu(k,854) * lu(k,2078) + lu(k,2082) = lu(k,2082) - lu(k,855) * lu(k,2078) + lu(k,2089) = lu(k,2089) - lu(k,856) * lu(k,2078) + lu(k,2094) = lu(k,2094) - lu(k,857) * lu(k,2078) + lu(k,2097) = lu(k,2097) - lu(k,858) * lu(k,2078) + lu(k,2099) = lu(k,2099) - lu(k,859) * lu(k,2078) + lu(k,865) = 1._r8 / lu(k,865) + lu(k,866) = lu(k,866) * lu(k,865) + lu(k,867) = lu(k,867) * lu(k,865) + lu(k,868) = lu(k,868) * lu(k,865) + lu(k,869) = lu(k,869) * lu(k,865) + lu(k,870) = lu(k,870) * lu(k,865) + lu(k,871) = lu(k,871) * lu(k,865) + lu(k,872) = lu(k,872) * lu(k,865) + lu(k,999) = lu(k,999) - lu(k,866) * lu(k,998) + lu(k,1000) = lu(k,1000) - lu(k,867) * lu(k,998) + lu(k,1001) = lu(k,1001) - lu(k,868) * lu(k,998) + lu(k,1002) = lu(k,1002) - lu(k,869) * lu(k,998) + lu(k,1004) = lu(k,1004) - lu(k,870) * lu(k,998) + lu(k,1006) = lu(k,1006) - lu(k,871) * lu(k,998) + lu(k,1007) = lu(k,1007) - lu(k,872) * lu(k,998) + lu(k,1448) = lu(k,1448) - lu(k,866) * lu(k,1447) + lu(k,1449) = lu(k,1449) - lu(k,867) * lu(k,1447) + lu(k,1450) = lu(k,1450) - lu(k,868) * lu(k,1447) + lu(k,1451) = lu(k,1451) - lu(k,869) * lu(k,1447) + lu(k,1453) = lu(k,1453) - lu(k,870) * lu(k,1447) + lu(k,1455) = lu(k,1455) - lu(k,871) * lu(k,1447) + lu(k,1456) = lu(k,1456) - lu(k,872) * lu(k,1447) + lu(k,1536) = lu(k,1536) - lu(k,866) * lu(k,1534) + lu(k,1537) = lu(k,1537) - lu(k,867) * lu(k,1534) + lu(k,1539) = lu(k,1539) - lu(k,868) * lu(k,1534) + lu(k,1542) = lu(k,1542) - lu(k,869) * lu(k,1534) + lu(k,1546) = lu(k,1546) - lu(k,870) * lu(k,1534) + lu(k,1549) = lu(k,1549) - lu(k,871) * lu(k,1534) + lu(k,1550) = lu(k,1550) - lu(k,872) * lu(k,1534) + lu(k,1881) = lu(k,1881) - lu(k,866) * lu(k,1875) + lu(k,1891) = lu(k,1891) - lu(k,867) * lu(k,1875) + lu(k,1907) = lu(k,1907) - lu(k,868) * lu(k,1875) + lu(k,1909) = lu(k,1909) - lu(k,869) * lu(k,1875) + lu(k,1914) = lu(k,1914) - lu(k,870) * lu(k,1875) + lu(k,1917) = lu(k,1917) - lu(k,871) * lu(k,1875) + lu(k,1919) = lu(k,1919) - lu(k,872) * lu(k,1875) + lu(k,2082) = lu(k,2082) - lu(k,866) * lu(k,2079) + lu(k,2083) = lu(k,2083) - lu(k,867) * lu(k,2079) + lu(k,2084) = lu(k,2084) - lu(k,868) * lu(k,2079) + lu(k,2089) = lu(k,2089) - lu(k,869) * lu(k,2079) + lu(k,2094) = lu(k,2094) - lu(k,870) * lu(k,2079) + lu(k,2097) = lu(k,2097) - lu(k,871) * lu(k,2079) + lu(k,2099) = lu(k,2099) - lu(k,872) * lu(k,2079) + lu(k,876) = 1._r8 / lu(k,876) + lu(k,877) = lu(k,877) * lu(k,876) + lu(k,878) = lu(k,878) * lu(k,876) + lu(k,879) = lu(k,879) * lu(k,876) + lu(k,880) = lu(k,880) * lu(k,876) + lu(k,881) = lu(k,881) * lu(k,876) + lu(k,882) = lu(k,882) * lu(k,876) + lu(k,883) = lu(k,883) * lu(k,876) + lu(k,884) = lu(k,884) * lu(k,876) + lu(k,885) = lu(k,885) * lu(k,876) + lu(k,886) = lu(k,886) * lu(k,876) + lu(k,887) = lu(k,887) * lu(k,876) + lu(k,888) = lu(k,888) * lu(k,876) + lu(k,889) = lu(k,889) * lu(k,876) + lu(k,890) = lu(k,890) * lu(k,876) + lu(k,891) = lu(k,891) * lu(k,876) + lu(k,1616) = - lu(k,877) * lu(k,1614) + lu(k,1628) = lu(k,1628) - lu(k,878) * lu(k,1614) + lu(k,1630) = lu(k,1630) - lu(k,879) * lu(k,1614) + lu(k,1637) = lu(k,1637) - lu(k,880) * lu(k,1614) + lu(k,1638) = lu(k,1638) - lu(k,881) * lu(k,1614) + lu(k,1640) = lu(k,1640) - lu(k,882) * lu(k,1614) + lu(k,1641) = lu(k,1641) - lu(k,883) * lu(k,1614) + lu(k,1643) = lu(k,1643) - lu(k,884) * lu(k,1614) + lu(k,1645) = lu(k,1645) - lu(k,885) * lu(k,1614) + lu(k,1652) = lu(k,1652) - lu(k,886) * lu(k,1614) + lu(k,1653) = lu(k,1653) - lu(k,887) * lu(k,1614) + lu(k,1656) = lu(k,1656) - lu(k,888) * lu(k,1614) + lu(k,1662) = - lu(k,889) * lu(k,1614) + lu(k,1664) = lu(k,1664) - lu(k,890) * lu(k,1614) + lu(k,1665) = - lu(k,891) * lu(k,1614) + lu(k,1775) = lu(k,1775) - lu(k,877) * lu(k,1771) + lu(k,1791) = lu(k,1791) - lu(k,878) * lu(k,1771) + lu(k,1793) = lu(k,1793) - lu(k,879) * lu(k,1771) + lu(k,1800) = - lu(k,880) * lu(k,1771) + lu(k,1801) = lu(k,1801) - lu(k,881) * lu(k,1771) + lu(k,1803) = lu(k,1803) - lu(k,882) * lu(k,1771) + lu(k,1804) = lu(k,1804) - lu(k,883) * lu(k,1771) + lu(k,1806) = lu(k,1806) - lu(k,884) * lu(k,1771) + lu(k,1808) = lu(k,1808) - lu(k,885) * lu(k,1771) + lu(k,1817) = lu(k,1817) - lu(k,886) * lu(k,1771) + lu(k,1818) = lu(k,1818) - lu(k,887) * lu(k,1771) + lu(k,1821) = lu(k,1821) - lu(k,888) * lu(k,1771) + lu(k,1827) = lu(k,1827) - lu(k,889) * lu(k,1771) + lu(k,1829) = lu(k,1829) - lu(k,890) * lu(k,1771) + lu(k,1830) = lu(k,1830) - lu(k,891) * lu(k,1771) + lu(k,2190) = lu(k,2190) - lu(k,877) * lu(k,2189) + lu(k,2201) = lu(k,2201) - lu(k,878) * lu(k,2189) + lu(k,2203) = lu(k,2203) - lu(k,879) * lu(k,2189) + lu(k,2208) = - lu(k,880) * lu(k,2189) + lu(k,2209) = lu(k,2209) - lu(k,881) * lu(k,2189) + lu(k,2211) = - lu(k,882) * lu(k,2189) + lu(k,2212) = - lu(k,883) * lu(k,2189) + lu(k,2214) = lu(k,2214) - lu(k,884) * lu(k,2189) + lu(k,2216) = lu(k,2216) - lu(k,885) * lu(k,2189) + lu(k,2223) = lu(k,2223) - lu(k,886) * lu(k,2189) + lu(k,2224) = lu(k,2224) - lu(k,887) * lu(k,2189) + lu(k,2227) = lu(k,2227) - lu(k,888) * lu(k,2189) + lu(k,2233) = lu(k,2233) - lu(k,889) * lu(k,2189) + lu(k,2235) = lu(k,2235) - lu(k,890) * lu(k,2189) + lu(k,2236) = lu(k,2236) - lu(k,891) * lu(k,2189) + end do + end subroutine lu_fac18 + subroutine lu_fac19( 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,892) = 1._r8 / lu(k,892) + lu(k,893) = lu(k,893) * lu(k,892) + lu(k,894) = lu(k,894) * lu(k,892) + lu(k,895) = lu(k,895) * lu(k,892) + lu(k,896) = lu(k,896) * lu(k,892) + lu(k,897) = lu(k,897) * lu(k,892) + lu(k,1092) = - lu(k,893) * lu(k,1087) + lu(k,1093) = - lu(k,894) * lu(k,1087) + lu(k,1095) = lu(k,1095) - lu(k,895) * lu(k,1087) + lu(k,1097) = lu(k,1097) - lu(k,896) * lu(k,1087) + lu(k,1098) = - lu(k,897) * lu(k,1087) + lu(k,1137) = - lu(k,893) * lu(k,1131) + lu(k,1138) = - lu(k,894) * lu(k,1131) + lu(k,1142) = lu(k,1142) - lu(k,895) * lu(k,1131) + lu(k,1144) = lu(k,1144) - lu(k,896) * lu(k,1131) + lu(k,1145) = lu(k,1145) - lu(k,897) * lu(k,1131) + lu(k,1255) = - lu(k,893) * lu(k,1248) + lu(k,1257) = lu(k,1257) - lu(k,894) * lu(k,1248) + lu(k,1260) = lu(k,1260) - lu(k,895) * lu(k,1248) + lu(k,1262) = lu(k,1262) - lu(k,896) * lu(k,1248) + lu(k,1263) = lu(k,1263) - lu(k,897) * lu(k,1248) + lu(k,1331) = lu(k,1331) - lu(k,893) * lu(k,1321) + lu(k,1336) = lu(k,1336) - lu(k,894) * lu(k,1321) + lu(k,1339) = lu(k,1339) - lu(k,895) * lu(k,1321) + lu(k,1341) = lu(k,1341) - lu(k,896) * lu(k,1321) + lu(k,1342) = lu(k,1342) - lu(k,897) * lu(k,1321) + lu(k,1639) = lu(k,1639) - lu(k,893) * lu(k,1615) + lu(k,1645) = lu(k,1645) - lu(k,894) * lu(k,1615) + lu(k,1653) = lu(k,1653) - lu(k,895) * lu(k,1615) + lu(k,1655) = lu(k,1655) - lu(k,896) * lu(k,1615) + lu(k,1656) = lu(k,1656) - lu(k,897) * lu(k,1615) + lu(k,1802) = lu(k,1802) - lu(k,893) * lu(k,1772) + lu(k,1808) = lu(k,1808) - lu(k,894) * lu(k,1772) + lu(k,1818) = lu(k,1818) - lu(k,895) * lu(k,1772) + lu(k,1820) = lu(k,1820) - lu(k,896) * lu(k,1772) + lu(k,1821) = lu(k,1821) - lu(k,897) * lu(k,1772) + lu(k,1900) = lu(k,1900) - lu(k,893) * lu(k,1876) + lu(k,1906) = lu(k,1906) - lu(k,894) * lu(k,1876) + lu(k,1913) = lu(k,1913) - lu(k,895) * lu(k,1876) + lu(k,1915) = lu(k,1915) - lu(k,896) * lu(k,1876) + lu(k,1916) = lu(k,1916) - lu(k,897) * lu(k,1876) + lu(k,2342) = lu(k,2342) - lu(k,893) * lu(k,2321) + lu(k,2348) = lu(k,2348) - lu(k,894) * lu(k,2321) + lu(k,2357) = lu(k,2357) - lu(k,895) * lu(k,2321) + lu(k,2359) = lu(k,2359) - lu(k,896) * lu(k,2321) + lu(k,2360) = lu(k,2360) - lu(k,897) * lu(k,2321) + lu(k,2397) = lu(k,2397) - lu(k,893) * lu(k,2378) + lu(k,2403) = lu(k,2403) - lu(k,894) * lu(k,2378) + lu(k,2409) = lu(k,2409) - lu(k,895) * lu(k,2378) + lu(k,2411) = lu(k,2411) - lu(k,896) * lu(k,2378) + lu(k,2412) = lu(k,2412) - lu(k,897) * lu(k,2378) + lu(k,901) = 1._r8 / lu(k,901) + lu(k,902) = lu(k,902) * lu(k,901) + lu(k,903) = lu(k,903) * lu(k,901) + lu(k,904) = lu(k,904) * lu(k,901) + lu(k,905) = lu(k,905) * lu(k,901) + lu(k,906) = lu(k,906) * lu(k,901) + lu(k,907) = lu(k,907) * lu(k,901) + lu(k,908) = lu(k,908) * lu(k,901) + lu(k,909) = lu(k,909) * lu(k,901) + lu(k,1044) = lu(k,1044) - lu(k,902) * lu(k,1041) + lu(k,1046) = - lu(k,903) * lu(k,1041) + lu(k,1047) = lu(k,1047) - lu(k,904) * lu(k,1041) + lu(k,1048) = lu(k,1048) - lu(k,905) * lu(k,1041) + lu(k,1049) = lu(k,1049) - lu(k,906) * lu(k,1041) + lu(k,1050) = lu(k,1050) - lu(k,907) * lu(k,1041) + lu(k,1051) = lu(k,1051) - lu(k,908) * lu(k,1041) + lu(k,1052) = - lu(k,909) * lu(k,1041) + lu(k,1792) = lu(k,1792) - lu(k,902) * lu(k,1773) + lu(k,1814) = lu(k,1814) - lu(k,903) * lu(k,1773) + lu(k,1818) = lu(k,1818) - lu(k,904) * lu(k,1773) + lu(k,1819) = lu(k,1819) - lu(k,905) * lu(k,1773) + lu(k,1820) = lu(k,1820) - lu(k,906) * lu(k,1773) + lu(k,1821) = lu(k,1821) - lu(k,907) * lu(k,1773) + lu(k,1829) = lu(k,1829) - lu(k,908) * lu(k,1773) + lu(k,1830) = lu(k,1830) - lu(k,909) * lu(k,1773) + lu(k,1890) = lu(k,1890) - lu(k,902) * lu(k,1877) + lu(k,1909) = lu(k,1909) - lu(k,903) * lu(k,1877) + lu(k,1913) = lu(k,1913) - lu(k,904) * lu(k,1877) + lu(k,1914) = lu(k,1914) - lu(k,905) * lu(k,1877) + lu(k,1915) = lu(k,1915) - lu(k,906) * lu(k,1877) + lu(k,1916) = lu(k,1916) - lu(k,907) * lu(k,1877) + lu(k,1924) = lu(k,1924) - lu(k,908) * lu(k,1877) + lu(k,1925) = lu(k,1925) - lu(k,909) * lu(k,1877) + lu(k,2146) = - lu(k,902) * lu(k,2140) + lu(k,2156) = lu(k,2156) - lu(k,903) * lu(k,2140) + lu(k,2160) = lu(k,2160) - lu(k,904) * lu(k,2140) + lu(k,2161) = lu(k,2161) - lu(k,905) * lu(k,2140) + lu(k,2162) = lu(k,2162) - lu(k,906) * lu(k,2140) + lu(k,2163) = lu(k,2163) - lu(k,907) * lu(k,2140) + lu(k,2171) = lu(k,2171) - lu(k,908) * lu(k,2140) + lu(k,2172) = lu(k,2172) - lu(k,909) * lu(k,2140) + lu(k,2333) = lu(k,2333) - lu(k,902) * lu(k,2322) + lu(k,2353) = lu(k,2353) - lu(k,903) * lu(k,2322) + lu(k,2357) = lu(k,2357) - lu(k,904) * lu(k,2322) + lu(k,2358) = lu(k,2358) - lu(k,905) * lu(k,2322) + lu(k,2359) = lu(k,2359) - lu(k,906) * lu(k,2322) + lu(k,2360) = lu(k,2360) - lu(k,907) * lu(k,2322) + lu(k,2368) = lu(k,2368) - lu(k,908) * lu(k,2322) + lu(k,2369) = lu(k,2369) - lu(k,909) * lu(k,2322) + lu(k,2388) = lu(k,2388) - lu(k,902) * lu(k,2379) + lu(k,2405) = lu(k,2405) - lu(k,903) * lu(k,2379) + lu(k,2409) = lu(k,2409) - lu(k,904) * lu(k,2379) + lu(k,2410) = lu(k,2410) - lu(k,905) * lu(k,2379) + lu(k,2411) = lu(k,2411) - lu(k,906) * lu(k,2379) + lu(k,2412) = lu(k,2412) - lu(k,907) * lu(k,2379) + lu(k,2420) = lu(k,2420) - lu(k,908) * lu(k,2379) + lu(k,2421) = lu(k,2421) - lu(k,909) * lu(k,2379) + lu(k,910) = 1._r8 / lu(k,910) + lu(k,911) = lu(k,911) * lu(k,910) + lu(k,912) = lu(k,912) * lu(k,910) + lu(k,913) = lu(k,913) * lu(k,910) + lu(k,914) = lu(k,914) * lu(k,910) + lu(k,915) = lu(k,915) * lu(k,910) + lu(k,916) = lu(k,916) * lu(k,910) + lu(k,917) = lu(k,917) * lu(k,910) + lu(k,918) = lu(k,918) * lu(k,910) + lu(k,1089) = lu(k,1089) - lu(k,911) * lu(k,1088) + lu(k,1091) = lu(k,1091) - lu(k,912) * lu(k,1088) + lu(k,1092) = lu(k,1092) - lu(k,913) * lu(k,1088) + lu(k,1095) = lu(k,1095) - lu(k,914) * lu(k,1088) + lu(k,1096) = - lu(k,915) * lu(k,1088) + lu(k,1097) = lu(k,1097) - lu(k,916) * lu(k,1088) + lu(k,1100) = lu(k,1100) - lu(k,917) * lu(k,1088) + lu(k,1101) = - lu(k,918) * lu(k,1088) + lu(k,1323) = lu(k,1323) - lu(k,911) * lu(k,1322) + lu(k,1324) = lu(k,1324) - lu(k,912) * lu(k,1322) + lu(k,1331) = lu(k,1331) - lu(k,913) * lu(k,1322) + lu(k,1339) = lu(k,1339) - lu(k,914) * lu(k,1322) + lu(k,1340) = lu(k,1340) - lu(k,915) * lu(k,1322) + lu(k,1341) = lu(k,1341) - lu(k,916) * lu(k,1322) + lu(k,1345) = lu(k,1345) - lu(k,917) * lu(k,1322) + lu(k,1346) = lu(k,1346) - lu(k,918) * lu(k,1322) + lu(k,1784) = lu(k,1784) - lu(k,911) * lu(k,1774) + lu(k,1793) = lu(k,1793) - lu(k,912) * lu(k,1774) + lu(k,1802) = lu(k,1802) - lu(k,913) * lu(k,1774) + lu(k,1818) = lu(k,1818) - lu(k,914) * lu(k,1774) + lu(k,1819) = lu(k,1819) - lu(k,915) * lu(k,1774) + lu(k,1820) = lu(k,1820) - lu(k,916) * lu(k,1774) + lu(k,1829) = lu(k,1829) - lu(k,917) * lu(k,1774) + lu(k,1830) = lu(k,1830) - lu(k,918) * lu(k,1774) + lu(k,1883) = lu(k,1883) - lu(k,911) * lu(k,1878) + lu(k,1891) = lu(k,1891) - lu(k,912) * lu(k,1878) + lu(k,1900) = lu(k,1900) - lu(k,913) * lu(k,1878) + lu(k,1913) = lu(k,1913) - lu(k,914) * lu(k,1878) + lu(k,1914) = lu(k,1914) - lu(k,915) * lu(k,1878) + lu(k,1915) = lu(k,1915) - lu(k,916) * lu(k,1878) + lu(k,1924) = lu(k,1924) - lu(k,917) * lu(k,1878) + lu(k,1925) = lu(k,1925) - lu(k,918) * lu(k,1878) + lu(k,1944) = lu(k,1944) - lu(k,911) * lu(k,1940) + lu(k,1945) = lu(k,1945) - lu(k,912) * lu(k,1940) + lu(k,1947) = lu(k,1947) - lu(k,913) * lu(k,1940) + lu(k,1958) = lu(k,1958) - lu(k,914) * lu(k,1940) + lu(k,1959) = lu(k,1959) - lu(k,915) * lu(k,1940) + lu(k,1960) = lu(k,1960) - lu(k,916) * lu(k,1940) + lu(k,1969) = lu(k,1969) - lu(k,917) * lu(k,1940) + lu(k,1970) = lu(k,1970) - lu(k,918) * lu(k,1940) + lu(k,2327) = lu(k,2327) - lu(k,911) * lu(k,2323) + lu(k,2334) = lu(k,2334) - lu(k,912) * lu(k,2323) + lu(k,2342) = lu(k,2342) - lu(k,913) * lu(k,2323) + lu(k,2357) = lu(k,2357) - lu(k,914) * lu(k,2323) + lu(k,2358) = lu(k,2358) - lu(k,915) * lu(k,2323) + lu(k,2359) = lu(k,2359) - lu(k,916) * lu(k,2323) + lu(k,2368) = lu(k,2368) - lu(k,917) * lu(k,2323) + lu(k,2369) = lu(k,2369) - lu(k,918) * lu(k,2323) + lu(k,919) = 1._r8 / lu(k,919) + lu(k,920) = lu(k,920) * lu(k,919) + lu(k,921) = lu(k,921) * lu(k,919) + lu(k,922) = lu(k,922) * lu(k,919) + lu(k,923) = lu(k,923) * lu(k,919) + lu(k,986) = lu(k,986) - lu(k,920) * lu(k,973) + lu(k,988) = lu(k,988) - lu(k,921) * lu(k,973) + lu(k,991) = lu(k,991) - lu(k,922) * lu(k,973) + lu(k,992) = - lu(k,923) * lu(k,973) + lu(k,1030) = lu(k,1030) - lu(k,920) * lu(k,1017) + lu(k,1032) = lu(k,1032) - lu(k,921) * lu(k,1017) + lu(k,1035) = lu(k,1035) - lu(k,922) * lu(k,1017) + lu(k,1036) = - lu(k,923) * lu(k,1017) + lu(k,1139) = lu(k,1139) - lu(k,920) * lu(k,1132) + lu(k,1142) = lu(k,1142) - lu(k,921) * lu(k,1132) + lu(k,1148) = lu(k,1148) - lu(k,922) * lu(k,1132) + lu(k,1150) = lu(k,1150) - lu(k,923) * lu(k,1132) + lu(k,1274) = - lu(k,920) * lu(k,1267) + lu(k,1275) = lu(k,1275) - lu(k,921) * lu(k,1267) + lu(k,1278) = lu(k,1278) - lu(k,922) * lu(k,1267) + lu(k,1279) = lu(k,1279) - lu(k,923) * lu(k,1267) + lu(k,1379) = lu(k,1379) - lu(k,920) * lu(k,1369) + lu(k,1382) = lu(k,1382) - lu(k,921) * lu(k,1369) + lu(k,1389) = lu(k,1389) - lu(k,922) * lu(k,1369) + lu(k,1391) = - lu(k,923) * lu(k,1369) + lu(k,1646) = - lu(k,920) * lu(k,1616) + lu(k,1653) = lu(k,1653) - lu(k,921) * lu(k,1616) + lu(k,1664) = lu(k,1664) - lu(k,922) * lu(k,1616) + lu(k,1666) = - lu(k,923) * lu(k,1616) + lu(k,1809) = lu(k,1809) - lu(k,920) * lu(k,1775) + lu(k,1818) = lu(k,1818) - lu(k,921) * lu(k,1775) + lu(k,1829) = lu(k,1829) - lu(k,922) * lu(k,1775) + lu(k,1831) = lu(k,1831) - lu(k,923) * lu(k,1775) + lu(k,1907) = lu(k,1907) - lu(k,920) * lu(k,1879) + lu(k,1913) = lu(k,1913) - lu(k,921) * lu(k,1879) + lu(k,1924) = lu(k,1924) - lu(k,922) * lu(k,1879) + lu(k,1926) = lu(k,1926) - lu(k,923) * lu(k,1879) + lu(k,1976) = - lu(k,920) * lu(k,1974) + lu(k,1984) = lu(k,1984) - lu(k,921) * lu(k,1974) + lu(k,1995) = lu(k,1995) - lu(k,922) * lu(k,1974) + lu(k,1997) = lu(k,1997) - lu(k,923) * lu(k,1974) + lu(k,2152) = - lu(k,920) * lu(k,2141) + lu(k,2160) = lu(k,2160) - lu(k,921) * lu(k,2141) + lu(k,2171) = lu(k,2171) - lu(k,922) * lu(k,2141) + lu(k,2173) = lu(k,2173) - lu(k,923) * lu(k,2141) + lu(k,2217) = lu(k,2217) - lu(k,920) * lu(k,2190) + lu(k,2224) = lu(k,2224) - lu(k,921) * lu(k,2190) + lu(k,2235) = lu(k,2235) - lu(k,922) * lu(k,2190) + lu(k,2237) = lu(k,2237) - lu(k,923) * lu(k,2190) + lu(k,2349) = lu(k,2349) - lu(k,920) * lu(k,2324) + lu(k,2357) = lu(k,2357) - lu(k,921) * lu(k,2324) + lu(k,2368) = lu(k,2368) - lu(k,922) * lu(k,2324) + lu(k,2370) = lu(k,2370) - lu(k,923) * lu(k,2324) + lu(k,925) = 1._r8 / lu(k,925) + lu(k,926) = lu(k,926) * lu(k,925) + lu(k,927) = lu(k,927) * lu(k,925) + lu(k,928) = lu(k,928) * lu(k,925) + lu(k,929) = lu(k,929) * lu(k,925) + lu(k,930) = lu(k,930) * lu(k,925) + lu(k,931) = lu(k,931) * lu(k,925) + lu(k,932) = lu(k,932) * lu(k,925) + lu(k,933) = lu(k,933) * lu(k,925) + lu(k,1461) = lu(k,1461) - lu(k,926) * lu(k,1460) + lu(k,1463) = - lu(k,927) * lu(k,1460) + lu(k,1464) = lu(k,1464) - lu(k,928) * lu(k,1460) + lu(k,1466) = - lu(k,929) * lu(k,1460) + lu(k,1468) = lu(k,1468) - lu(k,930) * lu(k,1460) + lu(k,1470) = - lu(k,931) * lu(k,1460) + lu(k,1471) = - lu(k,932) * lu(k,1460) + lu(k,1472) = lu(k,1472) - lu(k,933) * lu(k,1460) + lu(k,1810) = lu(k,1810) - lu(k,926) * lu(k,1776) + lu(k,1817) = lu(k,1817) - lu(k,927) * lu(k,1776) + lu(k,1818) = lu(k,1818) - lu(k,928) * lu(k,1776) + lu(k,1823) = lu(k,1823) - lu(k,929) * lu(k,1776) + lu(k,1825) = lu(k,1825) - lu(k,930) * lu(k,1776) + lu(k,1828) = lu(k,1828) - lu(k,931) * lu(k,1776) + lu(k,1830) = lu(k,1830) - lu(k,932) * lu(k,1776) + lu(k,1831) = lu(k,1831) - lu(k,933) * lu(k,1776) + lu(k,2020) = lu(k,2020) - lu(k,926) * lu(k,2019) + lu(k,2026) = - lu(k,927) * lu(k,2019) + lu(k,2027) = lu(k,2027) - lu(k,928) * lu(k,2019) + lu(k,2032) = - lu(k,929) * lu(k,2019) + lu(k,2034) = lu(k,2034) - lu(k,930) * lu(k,2019) + lu(k,2037) = lu(k,2037) - lu(k,931) * lu(k,2019) + lu(k,2039) = lu(k,2039) - lu(k,932) * lu(k,2019) + lu(k,2040) = lu(k,2040) - lu(k,933) * lu(k,2019) + lu(k,2043) = - lu(k,926) * lu(k,2042) + lu(k,2049) = lu(k,2049) - lu(k,927) * lu(k,2042) + lu(k,2050) = lu(k,2050) - lu(k,928) * lu(k,2042) + lu(k,2055) = lu(k,2055) - lu(k,929) * lu(k,2042) + lu(k,2057) = lu(k,2057) - lu(k,930) * lu(k,2042) + lu(k,2060) = - lu(k,931) * lu(k,2042) + lu(k,2062) = - lu(k,932) * lu(k,2042) + lu(k,2063) = lu(k,2063) - lu(k,933) * lu(k,2042) + lu(k,2242) = lu(k,2242) - lu(k,926) * lu(k,2239) + lu(k,2248) = - lu(k,927) * lu(k,2239) + lu(k,2249) = lu(k,2249) - lu(k,928) * lu(k,2239) + lu(k,2254) = - lu(k,929) * lu(k,2239) + lu(k,2256) = lu(k,2256) - lu(k,930) * lu(k,2239) + lu(k,2259) = lu(k,2259) - lu(k,931) * lu(k,2239) + lu(k,2261) = lu(k,2261) - lu(k,932) * lu(k,2239) + lu(k,2262) = lu(k,2262) - lu(k,933) * lu(k,2239) + lu(k,2428) = lu(k,2428) - lu(k,926) * lu(k,2426) + lu(k,2435) = - lu(k,927) * lu(k,2426) + lu(k,2436) = lu(k,2436) - lu(k,928) * lu(k,2426) + lu(k,2441) = - lu(k,929) * lu(k,2426) + lu(k,2443) = lu(k,2443) - lu(k,930) * lu(k,2426) + lu(k,2446) = - lu(k,931) * lu(k,2426) + lu(k,2448) = - lu(k,932) * lu(k,2426) + lu(k,2449) = lu(k,2449) - lu(k,933) * lu(k,2426) + end do + end subroutine lu_fac19 + subroutine lu_fac20( 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,935) = 1._r8 / lu(k,935) + lu(k,936) = lu(k,936) * lu(k,935) + lu(k,937) = lu(k,937) * lu(k,935) + lu(k,938) = lu(k,938) * lu(k,935) + lu(k,939) = lu(k,939) * lu(k,935) + lu(k,940) = lu(k,940) * lu(k,935) + lu(k,941) = lu(k,941) * lu(k,935) + lu(k,942) = lu(k,942) * lu(k,935) + lu(k,943) = lu(k,943) * lu(k,935) + lu(k,944) = lu(k,944) * lu(k,935) + lu(k,945) = lu(k,945) * lu(k,935) + lu(k,1787) = lu(k,1787) - lu(k,936) * lu(k,1777) + lu(k,1792) = lu(k,1792) - lu(k,937) * lu(k,1777) + lu(k,1814) = lu(k,1814) - lu(k,938) * lu(k,1777) + lu(k,1818) = lu(k,1818) - lu(k,939) * lu(k,1777) + lu(k,1819) = lu(k,1819) - lu(k,940) * lu(k,1777) + lu(k,1820) = lu(k,1820) - lu(k,941) * lu(k,1777) + lu(k,1821) = lu(k,1821) - lu(k,942) * lu(k,1777) + lu(k,1829) = lu(k,1829) - lu(k,943) * lu(k,1777) + lu(k,1830) = lu(k,1830) - lu(k,944) * lu(k,1777) + lu(k,1831) = lu(k,1831) - lu(k,945) * lu(k,1777) + lu(k,1886) = lu(k,1886) - lu(k,936) * lu(k,1880) + lu(k,1890) = lu(k,1890) - lu(k,937) * lu(k,1880) + lu(k,1909) = lu(k,1909) - lu(k,938) * lu(k,1880) + lu(k,1913) = lu(k,1913) - lu(k,939) * lu(k,1880) + lu(k,1914) = lu(k,1914) - lu(k,940) * lu(k,1880) + lu(k,1915) = lu(k,1915) - lu(k,941) * lu(k,1880) + lu(k,1916) = lu(k,1916) - lu(k,942) * lu(k,1880) + lu(k,1924) = lu(k,1924) - lu(k,943) * lu(k,1880) + lu(k,1925) = lu(k,1925) - lu(k,944) * lu(k,1880) + lu(k,1926) = lu(k,1926) - lu(k,945) * lu(k,1880) + lu(k,2145) = - lu(k,936) * lu(k,2142) + lu(k,2146) = lu(k,2146) - lu(k,937) * lu(k,2142) + lu(k,2156) = lu(k,2156) - lu(k,938) * lu(k,2142) + lu(k,2160) = lu(k,2160) - lu(k,939) * lu(k,2142) + lu(k,2161) = lu(k,2161) - lu(k,940) * lu(k,2142) + lu(k,2162) = lu(k,2162) - lu(k,941) * lu(k,2142) + lu(k,2163) = lu(k,2163) - lu(k,942) * lu(k,2142) + lu(k,2171) = lu(k,2171) - lu(k,943) * lu(k,2142) + lu(k,2172) = lu(k,2172) - lu(k,944) * lu(k,2142) + lu(k,2173) = lu(k,2173) - lu(k,945) * lu(k,2142) + lu(k,2330) = lu(k,2330) - lu(k,936) * lu(k,2325) + lu(k,2333) = lu(k,2333) - lu(k,937) * lu(k,2325) + lu(k,2353) = lu(k,2353) - lu(k,938) * lu(k,2325) + lu(k,2357) = lu(k,2357) - lu(k,939) * lu(k,2325) + lu(k,2358) = lu(k,2358) - lu(k,940) * lu(k,2325) + lu(k,2359) = lu(k,2359) - lu(k,941) * lu(k,2325) + lu(k,2360) = lu(k,2360) - lu(k,942) * lu(k,2325) + lu(k,2368) = lu(k,2368) - lu(k,943) * lu(k,2325) + lu(k,2369) = lu(k,2369) - lu(k,944) * lu(k,2325) + lu(k,2370) = lu(k,2370) - lu(k,945) * lu(k,2325) + lu(k,2384) = lu(k,2384) - lu(k,936) * lu(k,2380) + lu(k,2388) = lu(k,2388) - lu(k,937) * lu(k,2380) + lu(k,2405) = lu(k,2405) - lu(k,938) * lu(k,2380) + lu(k,2409) = lu(k,2409) - lu(k,939) * lu(k,2380) + lu(k,2410) = lu(k,2410) - lu(k,940) * lu(k,2380) + lu(k,2411) = lu(k,2411) - lu(k,941) * lu(k,2380) + lu(k,2412) = lu(k,2412) - lu(k,942) * lu(k,2380) + lu(k,2420) = lu(k,2420) - lu(k,943) * lu(k,2380) + lu(k,2421) = lu(k,2421) - lu(k,944) * lu(k,2380) + lu(k,2422) = lu(k,2422) - lu(k,945) * lu(k,2380) + lu(k,947) = 1._r8 / lu(k,947) + lu(k,948) = lu(k,948) * lu(k,947) + lu(k,949) = lu(k,949) * lu(k,947) + lu(k,950) = lu(k,950) * lu(k,947) + lu(k,951) = lu(k,951) * lu(k,947) + lu(k,952) = lu(k,952) * lu(k,947) + lu(k,1476) = lu(k,1476) - lu(k,948) * lu(k,1475) + lu(k,1481) = lu(k,1481) - lu(k,949) * lu(k,1475) + lu(k,1484) = lu(k,1484) - lu(k,950) * lu(k,1475) + lu(k,1488) = - lu(k,951) * lu(k,1475) + lu(k,1489) = - lu(k,952) * lu(k,1475) + lu(k,1540) = lu(k,1540) - lu(k,948) * lu(k,1535) + lu(k,1545) = lu(k,1545) - lu(k,949) * lu(k,1535) + lu(k,1550) = lu(k,1550) - lu(k,950) * lu(k,1535) + lu(k,1554) = lu(k,1554) - lu(k,951) * lu(k,1535) + lu(k,1555) = - lu(k,952) * lu(k,1535) + lu(k,1561) = lu(k,1561) - lu(k,948) * lu(k,1560) + lu(k,1568) = lu(k,1568) - lu(k,949) * lu(k,1560) + lu(k,1574) = lu(k,1574) - lu(k,950) * lu(k,1560) + lu(k,1578) = lu(k,1578) - lu(k,951) * lu(k,1560) + lu(k,1579) = lu(k,1579) - lu(k,952) * lu(k,1560) + lu(k,1587) = lu(k,1587) - lu(k,948) * lu(k,1585) + lu(k,1594) = lu(k,1594) - lu(k,949) * lu(k,1585) + lu(k,1600) = lu(k,1600) - lu(k,950) * lu(k,1585) + lu(k,1604) = lu(k,1604) - lu(k,951) * lu(k,1585) + lu(k,1606) = lu(k,1606) - lu(k,952) * lu(k,1585) + lu(k,1647) = - lu(k,948) * lu(k,1617) + lu(k,1653) = lu(k,1653) - lu(k,949) * lu(k,1617) + lu(k,1659) = lu(k,1659) - lu(k,950) * lu(k,1617) + lu(k,1664) = lu(k,1664) - lu(k,951) * lu(k,1617) + lu(k,1666) = lu(k,1666) - lu(k,952) * lu(k,1617) + lu(k,1811) = lu(k,1811) - lu(k,948) * lu(k,1778) + lu(k,1818) = lu(k,1818) - lu(k,949) * lu(k,1778) + lu(k,1824) = lu(k,1824) - lu(k,950) * lu(k,1778) + lu(k,1829) = lu(k,1829) - lu(k,951) * lu(k,1778) + lu(k,1831) = lu(k,1831) - lu(k,952) * lu(k,1778) + lu(k,1951) = lu(k,1951) - lu(k,948) * lu(k,1941) + lu(k,1958) = lu(k,1958) - lu(k,949) * lu(k,1941) + lu(k,1964) = lu(k,1964) - lu(k,950) * lu(k,1941) + lu(k,1969) = lu(k,1969) - lu(k,951) * lu(k,1941) + lu(k,1971) = lu(k,1971) - lu(k,952) * lu(k,1941) + lu(k,2086) = lu(k,2086) - lu(k,948) * lu(k,2080) + lu(k,2093) = lu(k,2093) - lu(k,949) * lu(k,2080) + lu(k,2099) = lu(k,2099) - lu(k,950) * lu(k,2080) + lu(k,2104) = lu(k,2104) - lu(k,951) * lu(k,2080) + lu(k,2106) = lu(k,2106) - lu(k,952) * lu(k,2080) + lu(k,2218) = lu(k,2218) - lu(k,948) * lu(k,2191) + lu(k,2224) = lu(k,2224) - lu(k,949) * lu(k,2191) + lu(k,2230) = lu(k,2230) - lu(k,950) * lu(k,2191) + lu(k,2235) = lu(k,2235) - lu(k,951) * lu(k,2191) + lu(k,2237) = lu(k,2237) - lu(k,952) * lu(k,2191) + lu(k,2429) = - lu(k,948) * lu(k,2427) + lu(k,2436) = lu(k,2436) - lu(k,949) * lu(k,2427) + lu(k,2442) = lu(k,2442) - lu(k,950) * lu(k,2427) + lu(k,2447) = - lu(k,951) * lu(k,2427) + lu(k,2449) = lu(k,2449) - lu(k,952) * lu(k,2427) + lu(k,955) = 1._r8 / lu(k,955) + lu(k,956) = lu(k,956) * lu(k,955) + lu(k,957) = lu(k,957) * lu(k,955) + lu(k,958) = lu(k,958) * lu(k,955) + lu(k,959) = lu(k,959) * lu(k,955) + lu(k,960) = lu(k,960) * lu(k,955) + lu(k,961) = lu(k,961) * lu(k,955) + lu(k,962) = lu(k,962) * lu(k,955) + lu(k,963) = lu(k,963) * lu(k,955) + lu(k,964) = lu(k,964) * lu(k,955) + lu(k,1495) = lu(k,1495) - lu(k,956) * lu(k,1494) + lu(k,1498) = lu(k,1498) - lu(k,957) * lu(k,1494) + lu(k,1499) = - lu(k,958) * lu(k,1494) + lu(k,1500) = lu(k,1500) - lu(k,959) * lu(k,1494) + lu(k,1501) = - lu(k,960) * lu(k,1494) + lu(k,1503) = lu(k,1503) - lu(k,961) * lu(k,1494) + lu(k,1504) = lu(k,1504) - lu(k,962) * lu(k,1494) + lu(k,1506) = lu(k,1506) - lu(k,963) * lu(k,1494) + lu(k,1507) = lu(k,1507) - lu(k,964) * lu(k,1494) + lu(k,1588) = lu(k,1588) - lu(k,956) * lu(k,1586) + lu(k,1592) = lu(k,1592) - lu(k,957) * lu(k,1586) + lu(k,1593) = - lu(k,958) * lu(k,1586) + lu(k,1594) = lu(k,1594) - lu(k,959) * lu(k,1586) + lu(k,1596) = lu(k,1596) - lu(k,960) * lu(k,1586) + lu(k,1599) = - lu(k,961) * lu(k,1586) + lu(k,1600) = lu(k,1600) - lu(k,962) * lu(k,1586) + lu(k,1602) = lu(k,1602) - lu(k,963) * lu(k,1586) + lu(k,1606) = lu(k,1606) - lu(k,964) * lu(k,1586) + lu(k,1812) = lu(k,1812) - lu(k,956) * lu(k,1779) + lu(k,1816) = lu(k,1816) - lu(k,957) * lu(k,1779) + lu(k,1817) = lu(k,1817) - lu(k,958) * lu(k,1779) + lu(k,1818) = lu(k,1818) - lu(k,959) * lu(k,1779) + lu(k,1820) = lu(k,1820) - lu(k,960) * lu(k,1779) + lu(k,1823) = lu(k,1823) - lu(k,961) * lu(k,1779) + lu(k,1824) = lu(k,1824) - lu(k,962) * lu(k,1779) + lu(k,1826) = lu(k,1826) - lu(k,963) * lu(k,1779) + lu(k,1831) = lu(k,1831) - lu(k,964) * lu(k,1779) + lu(k,1952) = lu(k,1952) - lu(k,956) * lu(k,1942) + lu(k,1956) = lu(k,1956) - lu(k,957) * lu(k,1942) + lu(k,1957) = lu(k,1957) - lu(k,958) * lu(k,1942) + lu(k,1958) = lu(k,1958) - lu(k,959) * lu(k,1942) + lu(k,1960) = lu(k,1960) - lu(k,960) * lu(k,1942) + lu(k,1963) = lu(k,1963) - lu(k,961) * lu(k,1942) + lu(k,1964) = lu(k,1964) - lu(k,962) * lu(k,1942) + lu(k,1966) = lu(k,1966) - lu(k,963) * lu(k,1942) + lu(k,1971) = lu(k,1971) - lu(k,964) * lu(k,1942) + lu(k,2087) = lu(k,2087) - lu(k,956) * lu(k,2081) + lu(k,2091) = lu(k,2091) - lu(k,957) * lu(k,2081) + lu(k,2092) = lu(k,2092) - lu(k,958) * lu(k,2081) + lu(k,2093) = lu(k,2093) - lu(k,959) * lu(k,2081) + lu(k,2095) = lu(k,2095) - lu(k,960) * lu(k,2081) + lu(k,2098) = lu(k,2098) - lu(k,961) * lu(k,2081) + lu(k,2099) = lu(k,2099) - lu(k,962) * lu(k,2081) + lu(k,2101) = lu(k,2101) - lu(k,963) * lu(k,2081) + lu(k,2106) = lu(k,2106) - lu(k,964) * lu(k,2081) + lu(k,2154) = lu(k,2154) - lu(k,956) * lu(k,2143) + lu(k,2158) = lu(k,2158) - lu(k,957) * lu(k,2143) + lu(k,2159) = lu(k,2159) - lu(k,958) * lu(k,2143) + lu(k,2160) = lu(k,2160) - lu(k,959) * lu(k,2143) + lu(k,2162) = lu(k,2162) - lu(k,960) * lu(k,2143) + lu(k,2165) = - lu(k,961) * lu(k,2143) + lu(k,2166) = lu(k,2166) - lu(k,962) * lu(k,2143) + lu(k,2168) = lu(k,2168) - lu(k,963) * lu(k,2143) + lu(k,2173) = lu(k,2173) - lu(k,964) * lu(k,2143) + lu(k,974) = 1._r8 / lu(k,974) + lu(k,975) = lu(k,975) * lu(k,974) + lu(k,976) = lu(k,976) * lu(k,974) + lu(k,977) = lu(k,977) * lu(k,974) + lu(k,978) = lu(k,978) * lu(k,974) + lu(k,979) = lu(k,979) * lu(k,974) + lu(k,980) = lu(k,980) * lu(k,974) + lu(k,981) = lu(k,981) * lu(k,974) + lu(k,982) = lu(k,982) * lu(k,974) + lu(k,983) = lu(k,983) * lu(k,974) + lu(k,984) = lu(k,984) * lu(k,974) + lu(k,985) = lu(k,985) * lu(k,974) + lu(k,986) = lu(k,986) * lu(k,974) + lu(k,987) = lu(k,987) * lu(k,974) + lu(k,988) = lu(k,988) * lu(k,974) + lu(k,989) = lu(k,989) * lu(k,974) + lu(k,990) = lu(k,990) * lu(k,974) + lu(k,991) = lu(k,991) * lu(k,974) + lu(k,992) = lu(k,992) * lu(k,974) + lu(k,1620) = - lu(k,975) * lu(k,1618) + lu(k,1621) = lu(k,1621) - lu(k,976) * lu(k,1618) + lu(k,1622) = - lu(k,977) * lu(k,1618) + lu(k,1623) = lu(k,1623) - lu(k,978) * lu(k,1618) + lu(k,1624) = lu(k,1624) - lu(k,979) * lu(k,1618) + lu(k,1626) = lu(k,1626) - lu(k,980) * lu(k,1618) + lu(k,1627) = - lu(k,981) * lu(k,1618) + lu(k,1630) = lu(k,1630) - lu(k,982) * lu(k,1618) + lu(k,1635) = - lu(k,983) * lu(k,1618) + lu(k,1639) = lu(k,1639) - lu(k,984) * lu(k,1618) + lu(k,1645) = lu(k,1645) - lu(k,985) * lu(k,1618) + lu(k,1646) = lu(k,1646) - lu(k,986) * lu(k,1618) + lu(k,1652) = lu(k,1652) - lu(k,987) * lu(k,1618) + lu(k,1653) = lu(k,1653) - lu(k,988) * lu(k,1618) + lu(k,1656) = lu(k,1656) - lu(k,989) * lu(k,1618) + lu(k,1662) = lu(k,1662) - lu(k,990) * lu(k,1618) + lu(k,1664) = lu(k,1664) - lu(k,991) * lu(k,1618) + lu(k,1666) = lu(k,1666) - lu(k,992) * lu(k,1618) + lu(k,1783) = lu(k,1783) - lu(k,975) * lu(k,1780) + lu(k,1784) = lu(k,1784) - lu(k,976) * lu(k,1780) + lu(k,1785) = lu(k,1785) - lu(k,977) * lu(k,1780) + lu(k,1786) = lu(k,1786) - lu(k,978) * lu(k,1780) + lu(k,1787) = lu(k,1787) - lu(k,979) * lu(k,1780) + lu(k,1789) = lu(k,1789) - lu(k,980) * lu(k,1780) + lu(k,1790) = lu(k,1790) - lu(k,981) * lu(k,1780) + lu(k,1793) = lu(k,1793) - lu(k,982) * lu(k,1780) + lu(k,1798) = lu(k,1798) - lu(k,983) * lu(k,1780) + lu(k,1802) = lu(k,1802) - lu(k,984) * lu(k,1780) + lu(k,1808) = lu(k,1808) - lu(k,985) * lu(k,1780) + lu(k,1809) = lu(k,1809) - lu(k,986) * lu(k,1780) + lu(k,1817) = lu(k,1817) - lu(k,987) * lu(k,1780) + lu(k,1818) = lu(k,1818) - lu(k,988) * lu(k,1780) + lu(k,1821) = lu(k,1821) - lu(k,989) * lu(k,1780) + lu(k,1827) = lu(k,1827) - lu(k,990) * lu(k,1780) + lu(k,1829) = lu(k,1829) - lu(k,991) * lu(k,1780) + lu(k,1831) = lu(k,1831) - lu(k,992) * lu(k,1780) + lu(k,2194) = lu(k,2194) - lu(k,975) * lu(k,2192) + lu(k,2195) = lu(k,2195) - lu(k,976) * lu(k,2192) + lu(k,2196) = - lu(k,977) * lu(k,2192) + lu(k,2197) = lu(k,2197) - lu(k,978) * lu(k,2192) + lu(k,2198) = lu(k,2198) - lu(k,979) * lu(k,2192) + lu(k,2199) = - lu(k,980) * lu(k,2192) + lu(k,2200) = lu(k,2200) - lu(k,981) * lu(k,2192) + lu(k,2203) = lu(k,2203) - lu(k,982) * lu(k,2192) + lu(k,2207) = lu(k,2207) - lu(k,983) * lu(k,2192) + lu(k,2210) = lu(k,2210) - lu(k,984) * lu(k,2192) + lu(k,2216) = lu(k,2216) - lu(k,985) * lu(k,2192) + lu(k,2217) = lu(k,2217) - lu(k,986) * lu(k,2192) + lu(k,2223) = lu(k,2223) - lu(k,987) * lu(k,2192) + lu(k,2224) = lu(k,2224) - lu(k,988) * lu(k,2192) + lu(k,2227) = lu(k,2227) - lu(k,989) * lu(k,2192) + lu(k,2233) = lu(k,2233) - lu(k,990) * lu(k,2192) + lu(k,2235) = lu(k,2235) - lu(k,991) * lu(k,2192) + lu(k,2237) = lu(k,2237) - lu(k,992) * lu(k,2192) + end do + end subroutine lu_fac20 + subroutine lu_fac21( 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,999) = 1._r8 / lu(k,999) + lu(k,1000) = lu(k,1000) * lu(k,999) + lu(k,1001) = lu(k,1001) * lu(k,999) + lu(k,1002) = lu(k,1002) * lu(k,999) + lu(k,1003) = lu(k,1003) * lu(k,999) + lu(k,1004) = lu(k,1004) * lu(k,999) + lu(k,1005) = lu(k,1005) * lu(k,999) + lu(k,1006) = lu(k,1006) * lu(k,999) + lu(k,1007) = lu(k,1007) * lu(k,999) + lu(k,1008) = lu(k,1008) * lu(k,999) + lu(k,1449) = lu(k,1449) - lu(k,1000) * lu(k,1448) + lu(k,1450) = lu(k,1450) - lu(k,1001) * lu(k,1448) + lu(k,1451) = lu(k,1451) - lu(k,1002) * lu(k,1448) + lu(k,1452) = - lu(k,1003) * lu(k,1448) + lu(k,1453) = lu(k,1453) - lu(k,1004) * lu(k,1448) + lu(k,1454) = - lu(k,1005) * lu(k,1448) + lu(k,1455) = lu(k,1455) - lu(k,1006) * lu(k,1448) + lu(k,1456) = lu(k,1456) - lu(k,1007) * lu(k,1448) + lu(k,1457) = - lu(k,1008) * lu(k,1448) + lu(k,1537) = lu(k,1537) - lu(k,1000) * lu(k,1536) + lu(k,1539) = lu(k,1539) - lu(k,1001) * lu(k,1536) + lu(k,1542) = lu(k,1542) - lu(k,1002) * lu(k,1536) + lu(k,1545) = lu(k,1545) - lu(k,1003) * lu(k,1536) + lu(k,1546) = lu(k,1546) - lu(k,1004) * lu(k,1536) + lu(k,1547) = - lu(k,1005) * lu(k,1536) + lu(k,1549) = lu(k,1549) - lu(k,1006) * lu(k,1536) + lu(k,1550) = lu(k,1550) - lu(k,1007) * lu(k,1536) + lu(k,1551) = lu(k,1551) - lu(k,1008) * lu(k,1536) + lu(k,1793) = lu(k,1793) - lu(k,1000) * lu(k,1781) + lu(k,1809) = lu(k,1809) - lu(k,1001) * lu(k,1781) + lu(k,1814) = lu(k,1814) - lu(k,1002) * lu(k,1781) + lu(k,1818) = lu(k,1818) - lu(k,1003) * lu(k,1781) + lu(k,1819) = lu(k,1819) - lu(k,1004) * lu(k,1781) + lu(k,1820) = lu(k,1820) - lu(k,1005) * lu(k,1781) + lu(k,1822) = lu(k,1822) - lu(k,1006) * lu(k,1781) + lu(k,1824) = lu(k,1824) - lu(k,1007) * lu(k,1781) + lu(k,1825) = lu(k,1825) - lu(k,1008) * lu(k,1781) + lu(k,1891) = lu(k,1891) - lu(k,1000) * lu(k,1881) + lu(k,1907) = lu(k,1907) - lu(k,1001) * lu(k,1881) + lu(k,1909) = lu(k,1909) - lu(k,1002) * lu(k,1881) + lu(k,1913) = lu(k,1913) - lu(k,1003) * lu(k,1881) + lu(k,1914) = lu(k,1914) - lu(k,1004) * lu(k,1881) + lu(k,1915) = lu(k,1915) - lu(k,1005) * lu(k,1881) + lu(k,1917) = lu(k,1917) - lu(k,1006) * lu(k,1881) + lu(k,1919) = lu(k,1919) - lu(k,1007) * lu(k,1881) + lu(k,1920) = - lu(k,1008) * lu(k,1881) + lu(k,1945) = lu(k,1945) - lu(k,1000) * lu(k,1943) + lu(k,1950) = lu(k,1950) - lu(k,1001) * lu(k,1943) + lu(k,1954) = lu(k,1954) - lu(k,1002) * lu(k,1943) + lu(k,1958) = lu(k,1958) - lu(k,1003) * lu(k,1943) + lu(k,1959) = lu(k,1959) - lu(k,1004) * lu(k,1943) + lu(k,1960) = lu(k,1960) - lu(k,1005) * lu(k,1943) + lu(k,1962) = lu(k,1962) - lu(k,1006) * lu(k,1943) + lu(k,1964) = lu(k,1964) - lu(k,1007) * lu(k,1943) + lu(k,1965) = - lu(k,1008) * lu(k,1943) + lu(k,2083) = lu(k,2083) - lu(k,1000) * lu(k,2082) + lu(k,2084) = lu(k,2084) - lu(k,1001) * lu(k,2082) + lu(k,2089) = lu(k,2089) - lu(k,1002) * lu(k,2082) + lu(k,2093) = lu(k,2093) - lu(k,1003) * lu(k,2082) + lu(k,2094) = lu(k,2094) - lu(k,1004) * lu(k,2082) + lu(k,2095) = lu(k,2095) - lu(k,1005) * lu(k,2082) + lu(k,2097) = lu(k,2097) - lu(k,1006) * lu(k,2082) + lu(k,2099) = lu(k,2099) - lu(k,1007) * lu(k,2082) + lu(k,2100) = lu(k,2100) - lu(k,1008) * lu(k,2082) + lu(k,1018) = 1._r8 / lu(k,1018) + lu(k,1019) = lu(k,1019) * lu(k,1018) + lu(k,1020) = lu(k,1020) * lu(k,1018) + lu(k,1021) = lu(k,1021) * lu(k,1018) + lu(k,1022) = lu(k,1022) * lu(k,1018) + lu(k,1023) = lu(k,1023) * lu(k,1018) + lu(k,1024) = lu(k,1024) * lu(k,1018) + lu(k,1025) = lu(k,1025) * lu(k,1018) + lu(k,1026) = lu(k,1026) * lu(k,1018) + lu(k,1027) = lu(k,1027) * lu(k,1018) + lu(k,1028) = lu(k,1028) * lu(k,1018) + lu(k,1029) = lu(k,1029) * lu(k,1018) + lu(k,1030) = lu(k,1030) * lu(k,1018) + lu(k,1031) = lu(k,1031) * lu(k,1018) + lu(k,1032) = lu(k,1032) * lu(k,1018) + lu(k,1033) = lu(k,1033) * lu(k,1018) + lu(k,1034) = lu(k,1034) * lu(k,1018) + lu(k,1035) = lu(k,1035) * lu(k,1018) + lu(k,1036) = lu(k,1036) * lu(k,1018) + lu(k,1620) = lu(k,1620) - lu(k,1019) * lu(k,1619) + lu(k,1621) = lu(k,1621) - lu(k,1020) * lu(k,1619) + lu(k,1622) = lu(k,1622) - lu(k,1021) * lu(k,1619) + lu(k,1623) = lu(k,1623) - lu(k,1022) * lu(k,1619) + lu(k,1624) = lu(k,1624) - lu(k,1023) * lu(k,1619) + lu(k,1626) = lu(k,1626) - lu(k,1024) * lu(k,1619) + lu(k,1627) = lu(k,1627) - lu(k,1025) * lu(k,1619) + lu(k,1630) = lu(k,1630) - lu(k,1026) * lu(k,1619) + lu(k,1635) = lu(k,1635) - lu(k,1027) * lu(k,1619) + lu(k,1639) = lu(k,1639) - lu(k,1028) * lu(k,1619) + lu(k,1645) = lu(k,1645) - lu(k,1029) * lu(k,1619) + lu(k,1646) = lu(k,1646) - lu(k,1030) * lu(k,1619) + lu(k,1652) = lu(k,1652) - lu(k,1031) * lu(k,1619) + lu(k,1653) = lu(k,1653) - lu(k,1032) * lu(k,1619) + lu(k,1656) = lu(k,1656) - lu(k,1033) * lu(k,1619) + lu(k,1662) = lu(k,1662) - lu(k,1034) * lu(k,1619) + lu(k,1664) = lu(k,1664) - lu(k,1035) * lu(k,1619) + lu(k,1666) = lu(k,1666) - lu(k,1036) * lu(k,1619) + lu(k,1783) = lu(k,1783) - lu(k,1019) * lu(k,1782) + lu(k,1784) = lu(k,1784) - lu(k,1020) * lu(k,1782) + lu(k,1785) = lu(k,1785) - lu(k,1021) * lu(k,1782) + lu(k,1786) = lu(k,1786) - lu(k,1022) * lu(k,1782) + lu(k,1787) = lu(k,1787) - lu(k,1023) * lu(k,1782) + lu(k,1789) = lu(k,1789) - lu(k,1024) * lu(k,1782) + lu(k,1790) = lu(k,1790) - lu(k,1025) * lu(k,1782) + lu(k,1793) = lu(k,1793) - lu(k,1026) * lu(k,1782) + lu(k,1798) = lu(k,1798) - lu(k,1027) * lu(k,1782) + lu(k,1802) = lu(k,1802) - lu(k,1028) * lu(k,1782) + lu(k,1808) = lu(k,1808) - lu(k,1029) * lu(k,1782) + lu(k,1809) = lu(k,1809) - lu(k,1030) * lu(k,1782) + lu(k,1817) = lu(k,1817) - lu(k,1031) * lu(k,1782) + lu(k,1818) = lu(k,1818) - lu(k,1032) * lu(k,1782) + lu(k,1821) = lu(k,1821) - lu(k,1033) * lu(k,1782) + lu(k,1827) = lu(k,1827) - lu(k,1034) * lu(k,1782) + lu(k,1829) = lu(k,1829) - lu(k,1035) * lu(k,1782) + lu(k,1831) = lu(k,1831) - lu(k,1036) * lu(k,1782) + lu(k,2194) = lu(k,2194) - lu(k,1019) * lu(k,2193) + lu(k,2195) = lu(k,2195) - lu(k,1020) * lu(k,2193) + lu(k,2196) = lu(k,2196) - lu(k,1021) * lu(k,2193) + lu(k,2197) = lu(k,2197) - lu(k,1022) * lu(k,2193) + lu(k,2198) = lu(k,2198) - lu(k,1023) * lu(k,2193) + lu(k,2199) = lu(k,2199) - lu(k,1024) * lu(k,2193) + lu(k,2200) = lu(k,2200) - lu(k,1025) * lu(k,2193) + lu(k,2203) = lu(k,2203) - lu(k,1026) * lu(k,2193) + lu(k,2207) = lu(k,2207) - lu(k,1027) * lu(k,2193) + lu(k,2210) = lu(k,2210) - lu(k,1028) * lu(k,2193) + lu(k,2216) = lu(k,2216) - lu(k,1029) * lu(k,2193) + lu(k,2217) = lu(k,2217) - lu(k,1030) * lu(k,2193) + lu(k,2223) = lu(k,2223) - lu(k,1031) * lu(k,2193) + lu(k,2224) = lu(k,2224) - lu(k,1032) * lu(k,2193) + lu(k,2227) = lu(k,2227) - lu(k,1033) * lu(k,2193) + lu(k,2233) = lu(k,2233) - lu(k,1034) * lu(k,2193) + lu(k,2235) = lu(k,2235) - lu(k,1035) * lu(k,2193) + lu(k,2237) = lu(k,2237) - lu(k,1036) * lu(k,2193) + lu(k,1042) = 1._r8 / lu(k,1042) + lu(k,1043) = lu(k,1043) * lu(k,1042) + lu(k,1044) = lu(k,1044) * lu(k,1042) + lu(k,1045) = lu(k,1045) * lu(k,1042) + lu(k,1046) = lu(k,1046) * lu(k,1042) + lu(k,1047) = lu(k,1047) * lu(k,1042) + lu(k,1048) = lu(k,1048) * lu(k,1042) + lu(k,1049) = lu(k,1049) * lu(k,1042) + lu(k,1050) = lu(k,1050) * lu(k,1042) + lu(k,1051) = lu(k,1051) * lu(k,1042) + lu(k,1052) = lu(k,1052) * lu(k,1042) + lu(k,1624) = lu(k,1624) - lu(k,1043) * lu(k,1620) + lu(k,1629) = lu(k,1629) - lu(k,1044) * lu(k,1620) + lu(k,1645) = lu(k,1645) - lu(k,1045) * lu(k,1620) + lu(k,1649) = lu(k,1649) - lu(k,1046) * lu(k,1620) + lu(k,1653) = lu(k,1653) - lu(k,1047) * lu(k,1620) + lu(k,1654) = lu(k,1654) - lu(k,1048) * lu(k,1620) + lu(k,1655) = lu(k,1655) - lu(k,1049) * lu(k,1620) + lu(k,1656) = lu(k,1656) - lu(k,1050) * lu(k,1620) + lu(k,1664) = lu(k,1664) - lu(k,1051) * lu(k,1620) + lu(k,1665) = lu(k,1665) - lu(k,1052) * lu(k,1620) + lu(k,1787) = lu(k,1787) - lu(k,1043) * lu(k,1783) + lu(k,1792) = lu(k,1792) - lu(k,1044) * lu(k,1783) + lu(k,1808) = lu(k,1808) - lu(k,1045) * lu(k,1783) + lu(k,1814) = lu(k,1814) - lu(k,1046) * lu(k,1783) + lu(k,1818) = lu(k,1818) - lu(k,1047) * lu(k,1783) + lu(k,1819) = lu(k,1819) - lu(k,1048) * lu(k,1783) + lu(k,1820) = lu(k,1820) - lu(k,1049) * lu(k,1783) + lu(k,1821) = lu(k,1821) - lu(k,1050) * lu(k,1783) + lu(k,1829) = lu(k,1829) - lu(k,1051) * lu(k,1783) + lu(k,1830) = lu(k,1830) - lu(k,1052) * lu(k,1783) + lu(k,1886) = lu(k,1886) - lu(k,1043) * lu(k,1882) + lu(k,1890) = lu(k,1890) - lu(k,1044) * lu(k,1882) + lu(k,1906) = lu(k,1906) - lu(k,1045) * lu(k,1882) + lu(k,1909) = lu(k,1909) - lu(k,1046) * lu(k,1882) + lu(k,1913) = lu(k,1913) - lu(k,1047) * lu(k,1882) + lu(k,1914) = lu(k,1914) - lu(k,1048) * lu(k,1882) + lu(k,1915) = lu(k,1915) - lu(k,1049) * lu(k,1882) + lu(k,1916) = lu(k,1916) - lu(k,1050) * lu(k,1882) + lu(k,1924) = lu(k,1924) - lu(k,1051) * lu(k,1882) + lu(k,1925) = lu(k,1925) - lu(k,1052) * lu(k,1882) + lu(k,2198) = lu(k,2198) - lu(k,1043) * lu(k,2194) + lu(k,2202) = lu(k,2202) - lu(k,1044) * lu(k,2194) + lu(k,2216) = lu(k,2216) - lu(k,1045) * lu(k,2194) + lu(k,2220) = lu(k,2220) - lu(k,1046) * lu(k,2194) + lu(k,2224) = lu(k,2224) - lu(k,1047) * lu(k,2194) + lu(k,2225) = lu(k,2225) - lu(k,1048) * lu(k,2194) + lu(k,2226) = lu(k,2226) - lu(k,1049) * lu(k,2194) + lu(k,2227) = lu(k,2227) - lu(k,1050) * lu(k,2194) + lu(k,2235) = lu(k,2235) - lu(k,1051) * lu(k,2194) + lu(k,2236) = lu(k,2236) - lu(k,1052) * lu(k,2194) + lu(k,2330) = lu(k,2330) - lu(k,1043) * lu(k,2326) + lu(k,2333) = lu(k,2333) - lu(k,1044) * lu(k,2326) + lu(k,2348) = lu(k,2348) - lu(k,1045) * lu(k,2326) + lu(k,2353) = lu(k,2353) - lu(k,1046) * lu(k,2326) + lu(k,2357) = lu(k,2357) - lu(k,1047) * lu(k,2326) + lu(k,2358) = lu(k,2358) - lu(k,1048) * lu(k,2326) + lu(k,2359) = lu(k,2359) - lu(k,1049) * lu(k,2326) + lu(k,2360) = lu(k,2360) - lu(k,1050) * lu(k,2326) + lu(k,2368) = lu(k,2368) - lu(k,1051) * lu(k,2326) + lu(k,2369) = lu(k,2369) - lu(k,1052) * lu(k,2326) + lu(k,1054) = 1._r8 / lu(k,1054) + lu(k,1055) = lu(k,1055) * lu(k,1054) + lu(k,1056) = lu(k,1056) * lu(k,1054) + lu(k,1057) = lu(k,1057) * lu(k,1054) + lu(k,1058) = lu(k,1058) * lu(k,1054) + lu(k,1091) = lu(k,1091) - lu(k,1055) * lu(k,1089) + lu(k,1094) = - lu(k,1056) * lu(k,1089) + lu(k,1095) = lu(k,1095) - lu(k,1057) * lu(k,1089) + lu(k,1100) = lu(k,1100) - lu(k,1058) * lu(k,1089) + lu(k,1165) = lu(k,1165) - lu(k,1055) * lu(k,1164) + lu(k,1167) = lu(k,1167) - lu(k,1056) * lu(k,1164) + lu(k,1168) = lu(k,1168) - lu(k,1057) * lu(k,1164) + lu(k,1170) = lu(k,1170) - lu(k,1058) * lu(k,1164) + lu(k,1230) = lu(k,1230) - lu(k,1055) * lu(k,1229) + lu(k,1236) = lu(k,1236) - lu(k,1056) * lu(k,1229) + lu(k,1238) = lu(k,1238) - lu(k,1057) * lu(k,1229) + lu(k,1242) = lu(k,1242) - lu(k,1058) * lu(k,1229) + lu(k,1324) = lu(k,1324) - lu(k,1055) * lu(k,1323) + lu(k,1337) = - lu(k,1056) * lu(k,1323) + lu(k,1339) = lu(k,1339) - lu(k,1057) * lu(k,1323) + lu(k,1345) = lu(k,1345) - lu(k,1058) * lu(k,1323) + lu(k,1416) = lu(k,1416) - lu(k,1055) * lu(k,1414) + lu(k,1429) = lu(k,1429) - lu(k,1056) * lu(k,1414) + lu(k,1432) = lu(k,1432) - lu(k,1057) * lu(k,1414) + lu(k,1439) = lu(k,1439) - lu(k,1058) * lu(k,1414) + lu(k,1630) = lu(k,1630) - lu(k,1055) * lu(k,1621) + lu(k,1646) = lu(k,1646) - lu(k,1056) * lu(k,1621) + lu(k,1653) = lu(k,1653) - lu(k,1057) * lu(k,1621) + lu(k,1664) = lu(k,1664) - lu(k,1058) * lu(k,1621) + lu(k,1793) = lu(k,1793) - lu(k,1055) * lu(k,1784) + lu(k,1809) = lu(k,1809) - lu(k,1056) * lu(k,1784) + lu(k,1818) = lu(k,1818) - lu(k,1057) * lu(k,1784) + lu(k,1829) = lu(k,1829) - lu(k,1058) * lu(k,1784) + lu(k,1891) = lu(k,1891) - lu(k,1055) * lu(k,1883) + lu(k,1907) = lu(k,1907) - lu(k,1056) * lu(k,1883) + lu(k,1913) = lu(k,1913) - lu(k,1057) * lu(k,1883) + lu(k,1924) = lu(k,1924) - lu(k,1058) * lu(k,1883) + lu(k,1945) = lu(k,1945) - lu(k,1055) * lu(k,1944) + lu(k,1950) = lu(k,1950) - lu(k,1056) * lu(k,1944) + lu(k,1958) = lu(k,1958) - lu(k,1057) * lu(k,1944) + lu(k,1969) = lu(k,1969) - lu(k,1058) * lu(k,1944) + lu(k,2147) = lu(k,2147) - lu(k,1055) * lu(k,2144) + lu(k,2152) = lu(k,2152) - lu(k,1056) * lu(k,2144) + lu(k,2160) = lu(k,2160) - lu(k,1057) * lu(k,2144) + lu(k,2171) = lu(k,2171) - lu(k,1058) * lu(k,2144) + lu(k,2203) = lu(k,2203) - lu(k,1055) * lu(k,2195) + lu(k,2217) = lu(k,2217) - lu(k,1056) * lu(k,2195) + lu(k,2224) = lu(k,2224) - lu(k,1057) * lu(k,2195) + lu(k,2235) = lu(k,2235) - lu(k,1058) * lu(k,2195) + lu(k,2334) = lu(k,2334) - lu(k,1055) * lu(k,2327) + lu(k,2349) = lu(k,2349) - lu(k,1056) * lu(k,2327) + lu(k,2357) = lu(k,2357) - lu(k,1057) * lu(k,2327) + lu(k,2368) = lu(k,2368) - lu(k,1058) * lu(k,2327) + lu(k,2389) = lu(k,2389) - lu(k,1055) * lu(k,2381) + lu(k,2404) = lu(k,2404) - lu(k,1056) * lu(k,2381) + lu(k,2409) = lu(k,2409) - lu(k,1057) * lu(k,2381) + lu(k,2420) = lu(k,2420) - lu(k,1058) * lu(k,2381) + end do + end subroutine lu_fac21 + subroutine lu_fac22( 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,1062) = 1._r8 / lu(k,1062) + lu(k,1063) = lu(k,1063) * lu(k,1062) + lu(k,1064) = lu(k,1064) * lu(k,1062) + lu(k,1065) = lu(k,1065) * lu(k,1062) + lu(k,1066) = lu(k,1066) * lu(k,1062) + lu(k,1067) = lu(k,1067) * lu(k,1062) + lu(k,1068) = lu(k,1068) * lu(k,1062) + lu(k,1069) = lu(k,1069) * lu(k,1062) + lu(k,1070) = lu(k,1070) * lu(k,1062) + lu(k,1071) = lu(k,1071) * lu(k,1062) + lu(k,1623) = lu(k,1623) - lu(k,1063) * lu(k,1622) + lu(k,1624) = lu(k,1624) - lu(k,1064) * lu(k,1622) + lu(k,1653) = lu(k,1653) - lu(k,1065) * lu(k,1622) + lu(k,1654) = lu(k,1654) - lu(k,1066) * lu(k,1622) + lu(k,1655) = lu(k,1655) - lu(k,1067) * lu(k,1622) + lu(k,1656) = lu(k,1656) - lu(k,1068) * lu(k,1622) + lu(k,1658) = lu(k,1658) - lu(k,1069) * lu(k,1622) + lu(k,1664) = lu(k,1664) - lu(k,1070) * lu(k,1622) + lu(k,1665) = lu(k,1665) - lu(k,1071) * lu(k,1622) + lu(k,1786) = lu(k,1786) - lu(k,1063) * lu(k,1785) + lu(k,1787) = lu(k,1787) - lu(k,1064) * lu(k,1785) + lu(k,1818) = lu(k,1818) - lu(k,1065) * lu(k,1785) + lu(k,1819) = lu(k,1819) - lu(k,1066) * lu(k,1785) + lu(k,1820) = lu(k,1820) - lu(k,1067) * lu(k,1785) + lu(k,1821) = lu(k,1821) - lu(k,1068) * lu(k,1785) + lu(k,1823) = lu(k,1823) - lu(k,1069) * lu(k,1785) + lu(k,1829) = lu(k,1829) - lu(k,1070) * lu(k,1785) + lu(k,1830) = lu(k,1830) - lu(k,1071) * lu(k,1785) + lu(k,1885) = lu(k,1885) - lu(k,1063) * lu(k,1884) + lu(k,1886) = lu(k,1886) - lu(k,1064) * lu(k,1884) + lu(k,1913) = lu(k,1913) - lu(k,1065) * lu(k,1884) + lu(k,1914) = lu(k,1914) - lu(k,1066) * lu(k,1884) + lu(k,1915) = lu(k,1915) - lu(k,1067) * lu(k,1884) + lu(k,1916) = lu(k,1916) - lu(k,1068) * lu(k,1884) + lu(k,1918) = lu(k,1918) - lu(k,1069) * lu(k,1884) + lu(k,1924) = lu(k,1924) - lu(k,1070) * lu(k,1884) + lu(k,1925) = lu(k,1925) - lu(k,1071) * lu(k,1884) + lu(k,2197) = lu(k,2197) - lu(k,1063) * lu(k,2196) + lu(k,2198) = lu(k,2198) - lu(k,1064) * lu(k,2196) + lu(k,2224) = lu(k,2224) - lu(k,1065) * lu(k,2196) + lu(k,2225) = lu(k,2225) - lu(k,1066) * lu(k,2196) + lu(k,2226) = lu(k,2226) - lu(k,1067) * lu(k,2196) + lu(k,2227) = lu(k,2227) - lu(k,1068) * lu(k,2196) + lu(k,2229) = - lu(k,1069) * lu(k,2196) + lu(k,2235) = lu(k,2235) - lu(k,1070) * lu(k,2196) + lu(k,2236) = lu(k,2236) - lu(k,1071) * lu(k,2196) + lu(k,2329) = lu(k,2329) - lu(k,1063) * lu(k,2328) + lu(k,2330) = lu(k,2330) - lu(k,1064) * lu(k,2328) + lu(k,2357) = lu(k,2357) - lu(k,1065) * lu(k,2328) + lu(k,2358) = lu(k,2358) - lu(k,1066) * lu(k,2328) + lu(k,2359) = lu(k,2359) - lu(k,1067) * lu(k,2328) + lu(k,2360) = lu(k,2360) - lu(k,1068) * lu(k,2328) + lu(k,2362) = lu(k,2362) - lu(k,1069) * lu(k,2328) + lu(k,2368) = lu(k,2368) - lu(k,1070) * lu(k,2328) + lu(k,2369) = lu(k,2369) - lu(k,1071) * lu(k,2328) + lu(k,2383) = lu(k,2383) - lu(k,1063) * lu(k,2382) + lu(k,2384) = lu(k,2384) - lu(k,1064) * lu(k,2382) + lu(k,2409) = lu(k,2409) - lu(k,1065) * lu(k,2382) + lu(k,2410) = lu(k,2410) - lu(k,1066) * lu(k,2382) + lu(k,2411) = lu(k,2411) - lu(k,1067) * lu(k,2382) + lu(k,2412) = lu(k,2412) - lu(k,1068) * lu(k,2382) + lu(k,2414) = lu(k,2414) - lu(k,1069) * lu(k,2382) + lu(k,2420) = lu(k,2420) - lu(k,1070) * lu(k,2382) + lu(k,2421) = lu(k,2421) - lu(k,1071) * lu(k,2382) + lu(k,1072) = 1._r8 / lu(k,1072) + lu(k,1073) = lu(k,1073) * lu(k,1072) + lu(k,1074) = lu(k,1074) * lu(k,1072) + lu(k,1075) = lu(k,1075) * lu(k,1072) + lu(k,1076) = lu(k,1076) * lu(k,1072) + lu(k,1077) = lu(k,1077) * lu(k,1072) + lu(k,1078) = lu(k,1078) * lu(k,1072) + lu(k,1079) = lu(k,1079) * lu(k,1072) + lu(k,1106) = lu(k,1106) - lu(k,1073) * lu(k,1105) + lu(k,1107) = - lu(k,1074) * lu(k,1105) + lu(k,1108) = - lu(k,1075) * lu(k,1105) + lu(k,1109) = - lu(k,1076) * lu(k,1105) + lu(k,1110) = lu(k,1110) - lu(k,1077) * lu(k,1105) + lu(k,1111) = lu(k,1111) - lu(k,1078) * lu(k,1105) + lu(k,1116) = lu(k,1116) - lu(k,1079) * lu(k,1105) + lu(k,1626) = lu(k,1626) - lu(k,1073) * lu(k,1623) + lu(k,1627) = lu(k,1627) - lu(k,1074) * lu(k,1623) + lu(k,1630) = lu(k,1630) - lu(k,1075) * lu(k,1623) + lu(k,1632) = lu(k,1632) - lu(k,1076) * lu(k,1623) + lu(k,1652) = lu(k,1652) - lu(k,1077) * lu(k,1623) + lu(k,1653) = lu(k,1653) - lu(k,1078) * lu(k,1623) + lu(k,1664) = lu(k,1664) - lu(k,1079) * lu(k,1623) + lu(k,1789) = lu(k,1789) - lu(k,1073) * lu(k,1786) + lu(k,1790) = lu(k,1790) - lu(k,1074) * lu(k,1786) + lu(k,1793) = lu(k,1793) - lu(k,1075) * lu(k,1786) + lu(k,1795) = lu(k,1795) - lu(k,1076) * lu(k,1786) + lu(k,1817) = lu(k,1817) - lu(k,1077) * lu(k,1786) + lu(k,1818) = lu(k,1818) - lu(k,1078) * lu(k,1786) + lu(k,1829) = lu(k,1829) - lu(k,1079) * lu(k,1786) + lu(k,1888) = lu(k,1888) - lu(k,1073) * lu(k,1885) + lu(k,1889) = lu(k,1889) - lu(k,1074) * lu(k,1885) + lu(k,1891) = lu(k,1891) - lu(k,1075) * lu(k,1885) + lu(k,1893) = lu(k,1893) - lu(k,1076) * lu(k,1885) + lu(k,1912) = lu(k,1912) - lu(k,1077) * lu(k,1885) + lu(k,1913) = lu(k,1913) - lu(k,1078) * lu(k,1885) + lu(k,1924) = lu(k,1924) - lu(k,1079) * lu(k,1885) + lu(k,2199) = lu(k,2199) - lu(k,1073) * lu(k,2197) + lu(k,2200) = lu(k,2200) - lu(k,1074) * lu(k,2197) + lu(k,2203) = lu(k,2203) - lu(k,1075) * lu(k,2197) + lu(k,2205) = - lu(k,1076) * lu(k,2197) + lu(k,2223) = lu(k,2223) - lu(k,1077) * lu(k,2197) + lu(k,2224) = lu(k,2224) - lu(k,1078) * lu(k,2197) + lu(k,2235) = lu(k,2235) - lu(k,1079) * lu(k,2197) + lu(k,2331) = lu(k,2331) - lu(k,1073) * lu(k,2329) + lu(k,2332) = lu(k,2332) - lu(k,1074) * lu(k,2329) + lu(k,2334) = lu(k,2334) - lu(k,1075) * lu(k,2329) + lu(k,2336) = lu(k,2336) - lu(k,1076) * lu(k,2329) + lu(k,2356) = lu(k,2356) - lu(k,1077) * lu(k,2329) + lu(k,2357) = lu(k,2357) - lu(k,1078) * lu(k,2329) + lu(k,2368) = lu(k,2368) - lu(k,1079) * lu(k,2329) + lu(k,2386) = lu(k,2386) - lu(k,1073) * lu(k,2383) + lu(k,2387) = lu(k,2387) - lu(k,1074) * lu(k,2383) + lu(k,2389) = lu(k,2389) - lu(k,1075) * lu(k,2383) + lu(k,2391) = lu(k,2391) - lu(k,1076) * lu(k,2383) + lu(k,2408) = - lu(k,1077) * lu(k,2383) + lu(k,2409) = lu(k,2409) - lu(k,1078) * lu(k,2383) + lu(k,2420) = lu(k,2420) - lu(k,1079) * lu(k,2383) + lu(k,1080) = 1._r8 / lu(k,1080) + lu(k,1081) = lu(k,1081) * lu(k,1080) + lu(k,1082) = lu(k,1082) * lu(k,1080) + lu(k,1083) = lu(k,1083) * lu(k,1080) + lu(k,1084) = lu(k,1084) * lu(k,1080) + lu(k,1085) = lu(k,1085) * lu(k,1080) + lu(k,1121) = lu(k,1121) - lu(k,1081) * lu(k,1118) + lu(k,1122) = lu(k,1122) - lu(k,1082) * lu(k,1118) + lu(k,1124) = lu(k,1124) - lu(k,1083) * lu(k,1118) + lu(k,1127) = - lu(k,1084) * lu(k,1118) + lu(k,1128) = - lu(k,1085) * lu(k,1118) + lu(k,1179) = - lu(k,1081) * lu(k,1174) + lu(k,1180) = - lu(k,1082) * lu(k,1174) + lu(k,1182) = lu(k,1182) - lu(k,1083) * lu(k,1174) + lu(k,1188) = lu(k,1188) - lu(k,1084) * lu(k,1174) + lu(k,1189) = - lu(k,1085) * lu(k,1174) + lu(k,1197) = - lu(k,1081) * lu(k,1191) + lu(k,1198) = lu(k,1198) - lu(k,1082) * lu(k,1191) + lu(k,1201) = lu(k,1201) - lu(k,1083) * lu(k,1191) + lu(k,1206) = - lu(k,1084) * lu(k,1191) + lu(k,1207) = - lu(k,1085) * lu(k,1191) + lu(k,1635) = lu(k,1635) - lu(k,1081) * lu(k,1624) + lu(k,1645) = lu(k,1645) - lu(k,1082) * lu(k,1624) + lu(k,1653) = lu(k,1653) - lu(k,1083) * lu(k,1624) + lu(k,1665) = lu(k,1665) - lu(k,1084) * lu(k,1624) + lu(k,1666) = lu(k,1666) - lu(k,1085) * lu(k,1624) + lu(k,1798) = lu(k,1798) - lu(k,1081) * lu(k,1787) + lu(k,1808) = lu(k,1808) - lu(k,1082) * lu(k,1787) + lu(k,1818) = lu(k,1818) - lu(k,1083) * lu(k,1787) + lu(k,1830) = lu(k,1830) - lu(k,1084) * lu(k,1787) + lu(k,1831) = lu(k,1831) - lu(k,1085) * lu(k,1787) + lu(k,1896) = lu(k,1896) - lu(k,1081) * lu(k,1886) + lu(k,1906) = lu(k,1906) - lu(k,1082) * lu(k,1886) + lu(k,1913) = lu(k,1913) - lu(k,1083) * lu(k,1886) + lu(k,1925) = lu(k,1925) - lu(k,1084) * lu(k,1886) + lu(k,1926) = lu(k,1926) - lu(k,1085) * lu(k,1886) + lu(k,2149) = - lu(k,1081) * lu(k,2145) + lu(k,2151) = - lu(k,1082) * lu(k,2145) + lu(k,2160) = lu(k,2160) - lu(k,1083) * lu(k,2145) + lu(k,2172) = lu(k,2172) - lu(k,1084) * lu(k,2145) + lu(k,2173) = lu(k,2173) - lu(k,1085) * lu(k,2145) + lu(k,2207) = lu(k,2207) - lu(k,1081) * lu(k,2198) + lu(k,2216) = lu(k,2216) - lu(k,1082) * lu(k,2198) + lu(k,2224) = lu(k,2224) - lu(k,1083) * lu(k,2198) + lu(k,2236) = lu(k,2236) - lu(k,1084) * lu(k,2198) + lu(k,2237) = lu(k,2237) - lu(k,1085) * lu(k,2198) + lu(k,2338) = lu(k,2338) - lu(k,1081) * lu(k,2330) + lu(k,2348) = lu(k,2348) - lu(k,1082) * lu(k,2330) + lu(k,2357) = lu(k,2357) - lu(k,1083) * lu(k,2330) + lu(k,2369) = lu(k,2369) - lu(k,1084) * lu(k,2330) + lu(k,2370) = lu(k,2370) - lu(k,1085) * lu(k,2330) + lu(k,2393) = lu(k,2393) - lu(k,1081) * lu(k,2384) + lu(k,2403) = lu(k,2403) - lu(k,1082) * lu(k,2384) + lu(k,2409) = lu(k,2409) - lu(k,1083) * lu(k,2384) + lu(k,2421) = lu(k,2421) - lu(k,1084) * lu(k,2384) + lu(k,2422) = lu(k,2422) - lu(k,1085) * lu(k,2384) + lu(k,1090) = 1._r8 / lu(k,1090) + lu(k,1091) = lu(k,1091) * lu(k,1090) + lu(k,1092) = lu(k,1092) * lu(k,1090) + lu(k,1093) = lu(k,1093) * lu(k,1090) + lu(k,1094) = lu(k,1094) * lu(k,1090) + lu(k,1095) = lu(k,1095) * lu(k,1090) + lu(k,1096) = lu(k,1096) * lu(k,1090) + lu(k,1097) = lu(k,1097) * lu(k,1090) + lu(k,1098) = lu(k,1098) * lu(k,1090) + lu(k,1099) = lu(k,1099) * lu(k,1090) + lu(k,1100) = lu(k,1100) * lu(k,1090) + lu(k,1101) = lu(k,1101) * lu(k,1090) + lu(k,1250) = - lu(k,1091) * lu(k,1249) + lu(k,1255) = lu(k,1255) - lu(k,1092) * lu(k,1249) + lu(k,1257) = lu(k,1257) - lu(k,1093) * lu(k,1249) + lu(k,1258) = - lu(k,1094) * lu(k,1249) + lu(k,1260) = lu(k,1260) - lu(k,1095) * lu(k,1249) + lu(k,1261) = lu(k,1261) - lu(k,1096) * lu(k,1249) + lu(k,1262) = lu(k,1262) - lu(k,1097) * lu(k,1249) + lu(k,1263) = lu(k,1263) - lu(k,1098) * lu(k,1249) + lu(k,1264) = lu(k,1264) - lu(k,1099) * lu(k,1249) + lu(k,1265) = lu(k,1265) - lu(k,1100) * lu(k,1249) + lu(k,1266) = lu(k,1266) - lu(k,1101) * lu(k,1249) + lu(k,1416) = lu(k,1416) - lu(k,1091) * lu(k,1415) + lu(k,1422) = lu(k,1422) - lu(k,1092) * lu(k,1415) + lu(k,1428) = lu(k,1428) - lu(k,1093) * lu(k,1415) + lu(k,1429) = lu(k,1429) - lu(k,1094) * lu(k,1415) + lu(k,1432) = lu(k,1432) - lu(k,1095) * lu(k,1415) + lu(k,1433) = lu(k,1433) - lu(k,1096) * lu(k,1415) + lu(k,1434) = lu(k,1434) - lu(k,1097) * lu(k,1415) + lu(k,1435) = lu(k,1435) - lu(k,1098) * lu(k,1415) + lu(k,1436) = - lu(k,1099) * lu(k,1415) + lu(k,1439) = lu(k,1439) - lu(k,1100) * lu(k,1415) + lu(k,1440) = lu(k,1440) - lu(k,1101) * lu(k,1415) + lu(k,1630) = lu(k,1630) - lu(k,1091) * lu(k,1625) + lu(k,1639) = lu(k,1639) - lu(k,1092) * lu(k,1625) + lu(k,1645) = lu(k,1645) - lu(k,1093) * lu(k,1625) + lu(k,1646) = lu(k,1646) - lu(k,1094) * lu(k,1625) + lu(k,1653) = lu(k,1653) - lu(k,1095) * lu(k,1625) + lu(k,1654) = lu(k,1654) - lu(k,1096) * lu(k,1625) + lu(k,1655) = lu(k,1655) - lu(k,1097) * lu(k,1625) + lu(k,1656) = lu(k,1656) - lu(k,1098) * lu(k,1625) + lu(k,1658) = lu(k,1658) - lu(k,1099) * lu(k,1625) + lu(k,1664) = lu(k,1664) - lu(k,1100) * lu(k,1625) + lu(k,1665) = lu(k,1665) - lu(k,1101) * lu(k,1625) + lu(k,1793) = lu(k,1793) - lu(k,1091) * lu(k,1788) + lu(k,1802) = lu(k,1802) - lu(k,1092) * lu(k,1788) + lu(k,1808) = lu(k,1808) - lu(k,1093) * lu(k,1788) + lu(k,1809) = lu(k,1809) - lu(k,1094) * lu(k,1788) + lu(k,1818) = lu(k,1818) - lu(k,1095) * lu(k,1788) + lu(k,1819) = lu(k,1819) - lu(k,1096) * lu(k,1788) + lu(k,1820) = lu(k,1820) - lu(k,1097) * lu(k,1788) + lu(k,1821) = lu(k,1821) - lu(k,1098) * lu(k,1788) + lu(k,1823) = lu(k,1823) - lu(k,1099) * lu(k,1788) + lu(k,1829) = lu(k,1829) - lu(k,1100) * lu(k,1788) + lu(k,1830) = lu(k,1830) - lu(k,1101) * lu(k,1788) + lu(k,1891) = lu(k,1891) - lu(k,1091) * lu(k,1887) + lu(k,1900) = lu(k,1900) - lu(k,1092) * lu(k,1887) + lu(k,1906) = lu(k,1906) - lu(k,1093) * lu(k,1887) + lu(k,1907) = lu(k,1907) - lu(k,1094) * lu(k,1887) + lu(k,1913) = lu(k,1913) - lu(k,1095) * lu(k,1887) + lu(k,1914) = lu(k,1914) - lu(k,1096) * lu(k,1887) + lu(k,1915) = lu(k,1915) - lu(k,1097) * lu(k,1887) + lu(k,1916) = lu(k,1916) - lu(k,1098) * lu(k,1887) + lu(k,1918) = lu(k,1918) - lu(k,1099) * lu(k,1887) + lu(k,1924) = lu(k,1924) - lu(k,1100) * lu(k,1887) + lu(k,1925) = lu(k,1925) - lu(k,1101) * lu(k,1887) + lu(k,2389) = lu(k,2389) - lu(k,1091) * lu(k,2385) + lu(k,2397) = lu(k,2397) - lu(k,1092) * lu(k,2385) + lu(k,2403) = lu(k,2403) - lu(k,1093) * lu(k,2385) + lu(k,2404) = lu(k,2404) - lu(k,1094) * lu(k,2385) + lu(k,2409) = lu(k,2409) - lu(k,1095) * lu(k,2385) + lu(k,2410) = lu(k,2410) - lu(k,1096) * lu(k,2385) + lu(k,2411) = lu(k,2411) - lu(k,1097) * lu(k,2385) + lu(k,2412) = lu(k,2412) - lu(k,1098) * lu(k,2385) + lu(k,2414) = lu(k,2414) - lu(k,1099) * lu(k,2385) + lu(k,2420) = lu(k,2420) - lu(k,1100) * lu(k,2385) + lu(k,2421) = lu(k,2421) - lu(k,1101) * lu(k,2385) + end do + end subroutine lu_fac22 + subroutine lu_fac23( 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,1106) = 1._r8 / lu(k,1106) + lu(k,1107) = lu(k,1107) * lu(k,1106) + lu(k,1108) = lu(k,1108) * lu(k,1106) + lu(k,1109) = lu(k,1109) * lu(k,1106) + lu(k,1110) = lu(k,1110) * lu(k,1106) + lu(k,1111) = lu(k,1111) * lu(k,1106) + lu(k,1112) = lu(k,1112) * lu(k,1106) + lu(k,1113) = lu(k,1113) * lu(k,1106) + lu(k,1114) = lu(k,1114) * lu(k,1106) + lu(k,1115) = lu(k,1115) * lu(k,1106) + lu(k,1116) = lu(k,1116) * lu(k,1106) + lu(k,1117) = lu(k,1117) * lu(k,1106) + lu(k,1627) = lu(k,1627) - lu(k,1107) * lu(k,1626) + lu(k,1630) = lu(k,1630) - lu(k,1108) * lu(k,1626) + lu(k,1632) = lu(k,1632) - lu(k,1109) * lu(k,1626) + lu(k,1652) = lu(k,1652) - lu(k,1110) * lu(k,1626) + lu(k,1653) = lu(k,1653) - lu(k,1111) * lu(k,1626) + lu(k,1654) = lu(k,1654) - lu(k,1112) * lu(k,1626) + lu(k,1655) = lu(k,1655) - lu(k,1113) * lu(k,1626) + lu(k,1656) = lu(k,1656) - lu(k,1114) * lu(k,1626) + lu(k,1658) = lu(k,1658) - lu(k,1115) * lu(k,1626) + lu(k,1664) = lu(k,1664) - lu(k,1116) * lu(k,1626) + lu(k,1665) = lu(k,1665) - lu(k,1117) * lu(k,1626) + lu(k,1790) = lu(k,1790) - lu(k,1107) * lu(k,1789) + lu(k,1793) = lu(k,1793) - lu(k,1108) * lu(k,1789) + lu(k,1795) = lu(k,1795) - lu(k,1109) * lu(k,1789) + lu(k,1817) = lu(k,1817) - lu(k,1110) * lu(k,1789) + lu(k,1818) = lu(k,1818) - lu(k,1111) * lu(k,1789) + lu(k,1819) = lu(k,1819) - lu(k,1112) * lu(k,1789) + lu(k,1820) = lu(k,1820) - lu(k,1113) * lu(k,1789) + lu(k,1821) = lu(k,1821) - lu(k,1114) * lu(k,1789) + lu(k,1823) = lu(k,1823) - lu(k,1115) * lu(k,1789) + lu(k,1829) = lu(k,1829) - lu(k,1116) * lu(k,1789) + lu(k,1830) = lu(k,1830) - lu(k,1117) * lu(k,1789) + lu(k,1889) = lu(k,1889) - lu(k,1107) * lu(k,1888) + lu(k,1891) = lu(k,1891) - lu(k,1108) * lu(k,1888) + lu(k,1893) = lu(k,1893) - lu(k,1109) * lu(k,1888) + lu(k,1912) = lu(k,1912) - lu(k,1110) * lu(k,1888) + lu(k,1913) = lu(k,1913) - lu(k,1111) * lu(k,1888) + lu(k,1914) = lu(k,1914) - lu(k,1112) * lu(k,1888) + lu(k,1915) = lu(k,1915) - lu(k,1113) * lu(k,1888) + lu(k,1916) = lu(k,1916) - lu(k,1114) * lu(k,1888) + lu(k,1918) = lu(k,1918) - lu(k,1115) * lu(k,1888) + lu(k,1924) = lu(k,1924) - lu(k,1116) * lu(k,1888) + lu(k,1925) = lu(k,1925) - lu(k,1117) * lu(k,1888) + lu(k,2200) = lu(k,2200) - lu(k,1107) * lu(k,2199) + lu(k,2203) = lu(k,2203) - lu(k,1108) * lu(k,2199) + lu(k,2205) = lu(k,2205) - lu(k,1109) * lu(k,2199) + lu(k,2223) = lu(k,2223) - lu(k,1110) * lu(k,2199) + lu(k,2224) = lu(k,2224) - lu(k,1111) * lu(k,2199) + lu(k,2225) = lu(k,2225) - lu(k,1112) * lu(k,2199) + lu(k,2226) = lu(k,2226) - lu(k,1113) * lu(k,2199) + lu(k,2227) = lu(k,2227) - lu(k,1114) * lu(k,2199) + lu(k,2229) = lu(k,2229) - lu(k,1115) * lu(k,2199) + lu(k,2235) = lu(k,2235) - lu(k,1116) * lu(k,2199) + lu(k,2236) = lu(k,2236) - lu(k,1117) * lu(k,2199) + lu(k,2332) = lu(k,2332) - lu(k,1107) * lu(k,2331) + lu(k,2334) = lu(k,2334) - lu(k,1108) * lu(k,2331) + lu(k,2336) = lu(k,2336) - lu(k,1109) * lu(k,2331) + lu(k,2356) = lu(k,2356) - lu(k,1110) * lu(k,2331) + lu(k,2357) = lu(k,2357) - lu(k,1111) * lu(k,2331) + lu(k,2358) = lu(k,2358) - lu(k,1112) * lu(k,2331) + lu(k,2359) = lu(k,2359) - lu(k,1113) * lu(k,2331) + lu(k,2360) = lu(k,2360) - lu(k,1114) * lu(k,2331) + lu(k,2362) = lu(k,2362) - lu(k,1115) * lu(k,2331) + lu(k,2368) = lu(k,2368) - lu(k,1116) * lu(k,2331) + lu(k,2369) = lu(k,2369) - lu(k,1117) * lu(k,2331) + lu(k,2387) = lu(k,2387) - lu(k,1107) * lu(k,2386) + lu(k,2389) = lu(k,2389) - lu(k,1108) * lu(k,2386) + lu(k,2391) = lu(k,2391) - lu(k,1109) * lu(k,2386) + lu(k,2408) = lu(k,2408) - lu(k,1110) * lu(k,2386) + lu(k,2409) = lu(k,2409) - lu(k,1111) * lu(k,2386) + lu(k,2410) = lu(k,2410) - lu(k,1112) * lu(k,2386) + lu(k,2411) = lu(k,2411) - lu(k,1113) * lu(k,2386) + lu(k,2412) = lu(k,2412) - lu(k,1114) * lu(k,2386) + lu(k,2414) = lu(k,2414) - lu(k,1115) * lu(k,2386) + lu(k,2420) = lu(k,2420) - lu(k,1116) * lu(k,2386) + lu(k,2421) = lu(k,2421) - lu(k,1117) * lu(k,2386) + lu(k,1119) = 1._r8 / lu(k,1119) + lu(k,1120) = lu(k,1120) * lu(k,1119) + lu(k,1121) = lu(k,1121) * lu(k,1119) + lu(k,1122) = lu(k,1122) * lu(k,1119) + lu(k,1123) = lu(k,1123) * lu(k,1119) + lu(k,1124) = lu(k,1124) * lu(k,1119) + lu(k,1125) = lu(k,1125) * lu(k,1119) + lu(k,1126) = lu(k,1126) * lu(k,1119) + lu(k,1127) = lu(k,1127) * lu(k,1119) + lu(k,1128) = lu(k,1128) * lu(k,1119) + lu(k,1176) = lu(k,1176) - lu(k,1120) * lu(k,1175) + lu(k,1179) = lu(k,1179) - lu(k,1121) * lu(k,1175) + lu(k,1180) = lu(k,1180) - lu(k,1122) * lu(k,1175) + lu(k,1181) = lu(k,1181) - lu(k,1123) * lu(k,1175) + lu(k,1182) = lu(k,1182) - lu(k,1124) * lu(k,1175) + lu(k,1185) = lu(k,1185) - lu(k,1125) * lu(k,1175) + lu(k,1187) = lu(k,1187) - lu(k,1126) * lu(k,1175) + lu(k,1188) = lu(k,1188) - lu(k,1127) * lu(k,1175) + lu(k,1189) = lu(k,1189) - lu(k,1128) * lu(k,1175) + lu(k,1630) = lu(k,1630) - lu(k,1120) * lu(k,1627) + lu(k,1635) = lu(k,1635) - lu(k,1121) * lu(k,1627) + lu(k,1645) = lu(k,1645) - lu(k,1122) * lu(k,1627) + lu(k,1646) = lu(k,1646) - lu(k,1123) * lu(k,1627) + lu(k,1653) = lu(k,1653) - lu(k,1124) * lu(k,1627) + lu(k,1656) = lu(k,1656) - lu(k,1125) * lu(k,1627) + lu(k,1664) = lu(k,1664) - lu(k,1126) * lu(k,1627) + lu(k,1665) = lu(k,1665) - lu(k,1127) * lu(k,1627) + lu(k,1666) = lu(k,1666) - lu(k,1128) * lu(k,1627) + lu(k,1793) = lu(k,1793) - lu(k,1120) * lu(k,1790) + lu(k,1798) = lu(k,1798) - lu(k,1121) * lu(k,1790) + lu(k,1808) = lu(k,1808) - lu(k,1122) * lu(k,1790) + lu(k,1809) = lu(k,1809) - lu(k,1123) * lu(k,1790) + lu(k,1818) = lu(k,1818) - lu(k,1124) * lu(k,1790) + lu(k,1821) = lu(k,1821) - lu(k,1125) * lu(k,1790) + lu(k,1829) = lu(k,1829) - lu(k,1126) * lu(k,1790) + lu(k,1830) = lu(k,1830) - lu(k,1127) * lu(k,1790) + lu(k,1831) = lu(k,1831) - lu(k,1128) * lu(k,1790) + lu(k,1891) = lu(k,1891) - lu(k,1120) * lu(k,1889) + lu(k,1896) = lu(k,1896) - lu(k,1121) * lu(k,1889) + lu(k,1906) = lu(k,1906) - lu(k,1122) * lu(k,1889) + lu(k,1907) = lu(k,1907) - lu(k,1123) * lu(k,1889) + lu(k,1913) = lu(k,1913) - lu(k,1124) * lu(k,1889) + lu(k,1916) = lu(k,1916) - lu(k,1125) * lu(k,1889) + lu(k,1924) = lu(k,1924) - lu(k,1126) * lu(k,1889) + lu(k,1925) = lu(k,1925) - lu(k,1127) * lu(k,1889) + lu(k,1926) = lu(k,1926) - lu(k,1128) * lu(k,1889) + lu(k,2203) = lu(k,2203) - lu(k,1120) * lu(k,2200) + lu(k,2207) = lu(k,2207) - lu(k,1121) * lu(k,2200) + lu(k,2216) = lu(k,2216) - lu(k,1122) * lu(k,2200) + lu(k,2217) = lu(k,2217) - lu(k,1123) * lu(k,2200) + lu(k,2224) = lu(k,2224) - lu(k,1124) * lu(k,2200) + lu(k,2227) = lu(k,2227) - lu(k,1125) * lu(k,2200) + lu(k,2235) = lu(k,2235) - lu(k,1126) * lu(k,2200) + lu(k,2236) = lu(k,2236) - lu(k,1127) * lu(k,2200) + lu(k,2237) = lu(k,2237) - lu(k,1128) * lu(k,2200) + lu(k,2334) = lu(k,2334) - lu(k,1120) * lu(k,2332) + lu(k,2338) = lu(k,2338) - lu(k,1121) * lu(k,2332) + lu(k,2348) = lu(k,2348) - lu(k,1122) * lu(k,2332) + lu(k,2349) = lu(k,2349) - lu(k,1123) * lu(k,2332) + lu(k,2357) = lu(k,2357) - lu(k,1124) * lu(k,2332) + lu(k,2360) = lu(k,2360) - lu(k,1125) * lu(k,2332) + lu(k,2368) = lu(k,2368) - lu(k,1126) * lu(k,2332) + lu(k,2369) = lu(k,2369) - lu(k,1127) * lu(k,2332) + lu(k,2370) = lu(k,2370) - lu(k,1128) * lu(k,2332) + lu(k,2389) = lu(k,2389) - lu(k,1120) * lu(k,2387) + lu(k,2393) = lu(k,2393) - lu(k,1121) * lu(k,2387) + lu(k,2403) = lu(k,2403) - lu(k,1122) * lu(k,2387) + lu(k,2404) = lu(k,2404) - lu(k,1123) * lu(k,2387) + lu(k,2409) = lu(k,2409) - lu(k,1124) * lu(k,2387) + lu(k,2412) = lu(k,2412) - lu(k,1125) * lu(k,2387) + lu(k,2420) = lu(k,2420) - lu(k,1126) * lu(k,2387) + lu(k,2421) = lu(k,2421) - lu(k,1127) * lu(k,2387) + lu(k,2422) = lu(k,2422) - lu(k,1128) * lu(k,2387) + lu(k,1133) = 1._r8 / lu(k,1133) + lu(k,1134) = lu(k,1134) * lu(k,1133) + lu(k,1135) = lu(k,1135) * lu(k,1133) + lu(k,1136) = lu(k,1136) * lu(k,1133) + lu(k,1137) = lu(k,1137) * lu(k,1133) + lu(k,1138) = lu(k,1138) * lu(k,1133) + lu(k,1139) = lu(k,1139) * lu(k,1133) + lu(k,1140) = lu(k,1140) * lu(k,1133) + lu(k,1141) = lu(k,1141) * lu(k,1133) + lu(k,1142) = lu(k,1142) * lu(k,1133) + lu(k,1143) = lu(k,1143) * lu(k,1133) + lu(k,1144) = lu(k,1144) * lu(k,1133) + lu(k,1145) = lu(k,1145) * lu(k,1133) + lu(k,1146) = lu(k,1146) * lu(k,1133) + lu(k,1147) = lu(k,1147) * lu(k,1133) + lu(k,1148) = lu(k,1148) * lu(k,1133) + lu(k,1149) = lu(k,1149) * lu(k,1133) + lu(k,1150) = lu(k,1150) * lu(k,1133) + lu(k,1371) = lu(k,1371) - lu(k,1134) * lu(k,1370) + lu(k,1372) = lu(k,1372) - lu(k,1135) * lu(k,1370) + lu(k,1373) = - lu(k,1136) * lu(k,1370) + lu(k,1374) = lu(k,1374) - lu(k,1137) * lu(k,1370) + lu(k,1378) = lu(k,1378) - lu(k,1138) * lu(k,1370) + lu(k,1379) = lu(k,1379) - lu(k,1139) * lu(k,1370) + lu(k,1380) = - lu(k,1140) * lu(k,1370) + lu(k,1381) = - lu(k,1141) * lu(k,1370) + lu(k,1382) = lu(k,1382) - lu(k,1142) * lu(k,1370) + lu(k,1383) = - lu(k,1143) * lu(k,1370) + lu(k,1384) = - lu(k,1144) * lu(k,1370) + lu(k,1385) = lu(k,1385) - lu(k,1145) * lu(k,1370) + lu(k,1387) = lu(k,1387) - lu(k,1146) * lu(k,1370) + lu(k,1388) = - lu(k,1147) * lu(k,1370) + lu(k,1389) = lu(k,1389) - lu(k,1148) * lu(k,1370) + lu(k,1390) = lu(k,1390) - lu(k,1149) * lu(k,1370) + lu(k,1391) = lu(k,1391) - lu(k,1150) * lu(k,1370) + lu(k,1629) = lu(k,1629) - lu(k,1134) * lu(k,1628) + lu(k,1630) = lu(k,1630) - lu(k,1135) * lu(k,1628) + lu(k,1634) = lu(k,1634) - lu(k,1136) * lu(k,1628) + lu(k,1639) = lu(k,1639) - lu(k,1137) * lu(k,1628) + lu(k,1645) = lu(k,1645) - lu(k,1138) * lu(k,1628) + lu(k,1646) = lu(k,1646) - lu(k,1139) * lu(k,1628) + lu(k,1649) = lu(k,1649) - lu(k,1140) * lu(k,1628) + lu(k,1652) = lu(k,1652) - lu(k,1141) * lu(k,1628) + lu(k,1653) = lu(k,1653) - lu(k,1142) * lu(k,1628) + lu(k,1654) = lu(k,1654) - lu(k,1143) * lu(k,1628) + lu(k,1655) = lu(k,1655) - lu(k,1144) * lu(k,1628) + lu(k,1656) = lu(k,1656) - lu(k,1145) * lu(k,1628) + lu(k,1662) = lu(k,1662) - lu(k,1146) * lu(k,1628) + lu(k,1663) = - lu(k,1147) * lu(k,1628) + lu(k,1664) = lu(k,1664) - lu(k,1148) * lu(k,1628) + lu(k,1665) = lu(k,1665) - lu(k,1149) * lu(k,1628) + lu(k,1666) = lu(k,1666) - lu(k,1150) * lu(k,1628) + lu(k,1792) = lu(k,1792) - lu(k,1134) * lu(k,1791) + lu(k,1793) = lu(k,1793) - lu(k,1135) * lu(k,1791) + lu(k,1797) = lu(k,1797) - lu(k,1136) * lu(k,1791) + lu(k,1802) = lu(k,1802) - lu(k,1137) * lu(k,1791) + lu(k,1808) = lu(k,1808) - lu(k,1138) * lu(k,1791) + lu(k,1809) = lu(k,1809) - lu(k,1139) * lu(k,1791) + lu(k,1814) = lu(k,1814) - lu(k,1140) * lu(k,1791) + lu(k,1817) = lu(k,1817) - lu(k,1141) * lu(k,1791) + lu(k,1818) = lu(k,1818) - lu(k,1142) * lu(k,1791) + lu(k,1819) = lu(k,1819) - lu(k,1143) * lu(k,1791) + lu(k,1820) = lu(k,1820) - lu(k,1144) * lu(k,1791) + lu(k,1821) = lu(k,1821) - lu(k,1145) * lu(k,1791) + lu(k,1827) = lu(k,1827) - lu(k,1146) * lu(k,1791) + lu(k,1828) = lu(k,1828) - lu(k,1147) * lu(k,1791) + lu(k,1829) = lu(k,1829) - lu(k,1148) * lu(k,1791) + lu(k,1830) = lu(k,1830) - lu(k,1149) * lu(k,1791) + lu(k,1831) = lu(k,1831) - lu(k,1150) * lu(k,1791) + lu(k,2202) = lu(k,2202) - lu(k,1134) * lu(k,2201) + lu(k,2203) = lu(k,2203) - lu(k,1135) * lu(k,2201) + lu(k,2206) = - lu(k,1136) * lu(k,2201) + lu(k,2210) = lu(k,2210) - lu(k,1137) * lu(k,2201) + lu(k,2216) = lu(k,2216) - lu(k,1138) * lu(k,2201) + lu(k,2217) = lu(k,2217) - lu(k,1139) * lu(k,2201) + lu(k,2220) = lu(k,2220) - lu(k,1140) * lu(k,2201) + lu(k,2223) = lu(k,2223) - lu(k,1141) * lu(k,2201) + lu(k,2224) = lu(k,2224) - lu(k,1142) * lu(k,2201) + lu(k,2225) = lu(k,2225) - lu(k,1143) * lu(k,2201) + lu(k,2226) = lu(k,2226) - lu(k,1144) * lu(k,2201) + lu(k,2227) = lu(k,2227) - lu(k,1145) * lu(k,2201) + lu(k,2233) = lu(k,2233) - lu(k,1146) * lu(k,2201) + lu(k,2234) = lu(k,2234) - lu(k,1147) * lu(k,2201) + lu(k,2235) = lu(k,2235) - lu(k,1148) * lu(k,2201) + lu(k,2236) = lu(k,2236) - lu(k,1149) * lu(k,2201) + lu(k,2237) = lu(k,2237) - lu(k,1150) * lu(k,2201) + lu(k,1151) = 1._r8 / lu(k,1151) + lu(k,1152) = lu(k,1152) * lu(k,1151) + lu(k,1153) = lu(k,1153) * lu(k,1151) + lu(k,1154) = lu(k,1154) * lu(k,1151) + lu(k,1155) = lu(k,1155) * lu(k,1151) + lu(k,1156) = lu(k,1156) * lu(k,1151) + lu(k,1157) = lu(k,1157) * lu(k,1151) + lu(k,1158) = lu(k,1158) * lu(k,1151) + lu(k,1159) = lu(k,1159) * lu(k,1151) + lu(k,1193) = lu(k,1193) - lu(k,1152) * lu(k,1192) + lu(k,1198) = lu(k,1198) - lu(k,1153) * lu(k,1192) + lu(k,1200) = - lu(k,1154) * lu(k,1192) + lu(k,1201) = lu(k,1201) - lu(k,1155) * lu(k,1192) + lu(k,1204) = lu(k,1204) - lu(k,1156) * lu(k,1192) + lu(k,1205) = lu(k,1205) - lu(k,1157) * lu(k,1192) + lu(k,1206) = lu(k,1206) - lu(k,1158) * lu(k,1192) + lu(k,1207) = lu(k,1207) - lu(k,1159) * lu(k,1192) + lu(k,1372) = lu(k,1372) - lu(k,1152) * lu(k,1371) + lu(k,1378) = lu(k,1378) - lu(k,1153) * lu(k,1371) + lu(k,1381) = lu(k,1381) - lu(k,1154) * lu(k,1371) + lu(k,1382) = lu(k,1382) - lu(k,1155) * lu(k,1371) + lu(k,1386) = - lu(k,1156) * lu(k,1371) + lu(k,1389) = lu(k,1389) - lu(k,1157) * lu(k,1371) + lu(k,1390) = lu(k,1390) - lu(k,1158) * lu(k,1371) + lu(k,1391) = lu(k,1391) - lu(k,1159) * lu(k,1371) + lu(k,1630) = lu(k,1630) - lu(k,1152) * lu(k,1629) + lu(k,1645) = lu(k,1645) - lu(k,1153) * lu(k,1629) + lu(k,1652) = lu(k,1652) - lu(k,1154) * lu(k,1629) + lu(k,1653) = lu(k,1653) - lu(k,1155) * lu(k,1629) + lu(k,1658) = lu(k,1658) - lu(k,1156) * lu(k,1629) + lu(k,1664) = lu(k,1664) - lu(k,1157) * lu(k,1629) + lu(k,1665) = lu(k,1665) - lu(k,1158) * lu(k,1629) + lu(k,1666) = lu(k,1666) - lu(k,1159) * lu(k,1629) + lu(k,1793) = lu(k,1793) - lu(k,1152) * lu(k,1792) + lu(k,1808) = lu(k,1808) - lu(k,1153) * lu(k,1792) + lu(k,1817) = lu(k,1817) - lu(k,1154) * lu(k,1792) + lu(k,1818) = lu(k,1818) - lu(k,1155) * lu(k,1792) + lu(k,1823) = lu(k,1823) - lu(k,1156) * lu(k,1792) + lu(k,1829) = lu(k,1829) - lu(k,1157) * lu(k,1792) + lu(k,1830) = lu(k,1830) - lu(k,1158) * lu(k,1792) + lu(k,1831) = lu(k,1831) - lu(k,1159) * lu(k,1792) + lu(k,1891) = lu(k,1891) - lu(k,1152) * lu(k,1890) + lu(k,1906) = lu(k,1906) - lu(k,1153) * lu(k,1890) + lu(k,1912) = lu(k,1912) - lu(k,1154) * lu(k,1890) + lu(k,1913) = lu(k,1913) - lu(k,1155) * lu(k,1890) + lu(k,1918) = lu(k,1918) - lu(k,1156) * lu(k,1890) + lu(k,1924) = lu(k,1924) - lu(k,1157) * lu(k,1890) + lu(k,1925) = lu(k,1925) - lu(k,1158) * lu(k,1890) + lu(k,1926) = lu(k,1926) - lu(k,1159) * lu(k,1890) + lu(k,2147) = lu(k,2147) - lu(k,1152) * lu(k,2146) + lu(k,2151) = lu(k,2151) - lu(k,1153) * lu(k,2146) + lu(k,2159) = lu(k,2159) - lu(k,1154) * lu(k,2146) + lu(k,2160) = lu(k,2160) - lu(k,1155) * lu(k,2146) + lu(k,2165) = lu(k,2165) - lu(k,1156) * lu(k,2146) + lu(k,2171) = lu(k,2171) - lu(k,1157) * lu(k,2146) + lu(k,2172) = lu(k,2172) - lu(k,1158) * lu(k,2146) + lu(k,2173) = lu(k,2173) - lu(k,1159) * lu(k,2146) + lu(k,2203) = lu(k,2203) - lu(k,1152) * lu(k,2202) + lu(k,2216) = lu(k,2216) - lu(k,1153) * lu(k,2202) + lu(k,2223) = lu(k,2223) - lu(k,1154) * lu(k,2202) + lu(k,2224) = lu(k,2224) - lu(k,1155) * lu(k,2202) + lu(k,2229) = lu(k,2229) - lu(k,1156) * lu(k,2202) + lu(k,2235) = lu(k,2235) - lu(k,1157) * lu(k,2202) + lu(k,2236) = lu(k,2236) - lu(k,1158) * lu(k,2202) + lu(k,2237) = lu(k,2237) - lu(k,1159) * lu(k,2202) + lu(k,2334) = lu(k,2334) - lu(k,1152) * lu(k,2333) + lu(k,2348) = lu(k,2348) - lu(k,1153) * lu(k,2333) + lu(k,2356) = lu(k,2356) - lu(k,1154) * lu(k,2333) + lu(k,2357) = lu(k,2357) - lu(k,1155) * lu(k,2333) + lu(k,2362) = lu(k,2362) - lu(k,1156) * lu(k,2333) + lu(k,2368) = lu(k,2368) - lu(k,1157) * lu(k,2333) + lu(k,2369) = lu(k,2369) - lu(k,1158) * lu(k,2333) + lu(k,2370) = lu(k,2370) - lu(k,1159) * lu(k,2333) + lu(k,2389) = lu(k,2389) - lu(k,1152) * lu(k,2388) + lu(k,2403) = lu(k,2403) - lu(k,1153) * lu(k,2388) + lu(k,2408) = lu(k,2408) - lu(k,1154) * lu(k,2388) + lu(k,2409) = lu(k,2409) - lu(k,1155) * lu(k,2388) + lu(k,2414) = lu(k,2414) - lu(k,1156) * lu(k,2388) + lu(k,2420) = lu(k,2420) - lu(k,1157) * lu(k,2388) + lu(k,2421) = lu(k,2421) - lu(k,1158) * lu(k,2388) + lu(k,2422) = lu(k,2422) - lu(k,1159) * lu(k,2388) + end do + end subroutine lu_fac23 + subroutine lu_fac24( 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,1160) = 1._r8 / lu(k,1160) + lu(k,1161) = lu(k,1161) * lu(k,1160) + lu(k,1162) = lu(k,1162) * lu(k,1160) + lu(k,1163) = lu(k,1163) * lu(k,1160) + lu(k,1167) = lu(k,1167) - lu(k,1161) * lu(k,1165) + lu(k,1168) = lu(k,1168) - lu(k,1162) * lu(k,1165) + lu(k,1170) = lu(k,1170) - lu(k,1163) * lu(k,1165) + lu(k,1181) = lu(k,1181) - lu(k,1161) * lu(k,1176) + lu(k,1182) = lu(k,1182) - lu(k,1162) * lu(k,1176) + lu(k,1187) = lu(k,1187) - lu(k,1163) * lu(k,1176) + lu(k,1199) = - lu(k,1161) * lu(k,1193) + lu(k,1201) = lu(k,1201) - lu(k,1162) * lu(k,1193) + lu(k,1205) = lu(k,1205) - lu(k,1163) * lu(k,1193) + lu(k,1236) = lu(k,1236) - lu(k,1161) * lu(k,1230) + lu(k,1238) = lu(k,1238) - lu(k,1162) * lu(k,1230) + lu(k,1242) = lu(k,1242) - lu(k,1163) * lu(k,1230) + lu(k,1258) = lu(k,1258) - lu(k,1161) * lu(k,1250) + lu(k,1260) = lu(k,1260) - lu(k,1162) * lu(k,1250) + lu(k,1265) = lu(k,1265) - lu(k,1163) * lu(k,1250) + lu(k,1274) = lu(k,1274) - lu(k,1161) * lu(k,1268) + lu(k,1275) = lu(k,1275) - lu(k,1162) * lu(k,1268) + lu(k,1278) = lu(k,1278) - lu(k,1163) * lu(k,1268) + lu(k,1283) = - lu(k,1161) * lu(k,1280) + lu(k,1285) = lu(k,1285) - lu(k,1162) * lu(k,1280) + lu(k,1287) = lu(k,1287) - lu(k,1163) * lu(k,1280) + lu(k,1337) = lu(k,1337) - lu(k,1161) * lu(k,1324) + lu(k,1339) = lu(k,1339) - lu(k,1162) * lu(k,1324) + lu(k,1345) = lu(k,1345) - lu(k,1163) * lu(k,1324) + lu(k,1359) = - lu(k,1161) * lu(k,1350) + lu(k,1361) = lu(k,1361) - lu(k,1162) * lu(k,1350) + lu(k,1366) = lu(k,1366) - lu(k,1163) * lu(k,1350) + lu(k,1379) = lu(k,1379) - lu(k,1161) * lu(k,1372) + lu(k,1382) = lu(k,1382) - lu(k,1162) * lu(k,1372) + lu(k,1389) = lu(k,1389) - lu(k,1163) * lu(k,1372) + lu(k,1429) = lu(k,1429) - lu(k,1161) * lu(k,1416) + lu(k,1432) = lu(k,1432) - lu(k,1162) * lu(k,1416) + lu(k,1439) = lu(k,1439) - lu(k,1163) * lu(k,1416) + lu(k,1450) = lu(k,1450) - lu(k,1161) * lu(k,1449) + lu(k,1452) = lu(k,1452) - lu(k,1162) * lu(k,1449) + lu(k,1458) = - lu(k,1163) * lu(k,1449) + lu(k,1510) = - lu(k,1161) * lu(k,1509) + lu(k,1514) = lu(k,1514) - lu(k,1162) * lu(k,1509) + lu(k,1522) = lu(k,1522) - lu(k,1163) * lu(k,1509) + lu(k,1539) = lu(k,1539) - lu(k,1161) * lu(k,1537) + lu(k,1545) = lu(k,1545) - lu(k,1162) * lu(k,1537) + lu(k,1554) = lu(k,1554) - lu(k,1163) * lu(k,1537) + lu(k,1646) = lu(k,1646) - lu(k,1161) * lu(k,1630) + lu(k,1653) = lu(k,1653) - lu(k,1162) * lu(k,1630) + lu(k,1664) = lu(k,1664) - lu(k,1163) * lu(k,1630) + lu(k,1809) = lu(k,1809) - lu(k,1161) * lu(k,1793) + lu(k,1818) = lu(k,1818) - lu(k,1162) * lu(k,1793) + lu(k,1829) = lu(k,1829) - lu(k,1163) * lu(k,1793) + lu(k,1907) = lu(k,1907) - lu(k,1161) * lu(k,1891) + lu(k,1913) = lu(k,1913) - lu(k,1162) * lu(k,1891) + lu(k,1924) = lu(k,1924) - lu(k,1163) * lu(k,1891) + lu(k,1950) = lu(k,1950) - lu(k,1161) * lu(k,1945) + lu(k,1958) = lu(k,1958) - lu(k,1162) * lu(k,1945) + lu(k,1969) = lu(k,1969) - lu(k,1163) * lu(k,1945) + lu(k,1976) = lu(k,1976) - lu(k,1161) * lu(k,1975) + lu(k,1984) = lu(k,1984) - lu(k,1162) * lu(k,1975) + lu(k,1995) = lu(k,1995) - lu(k,1163) * lu(k,1975) + lu(k,2084) = lu(k,2084) - lu(k,1161) * lu(k,2083) + lu(k,2093) = lu(k,2093) - lu(k,1162) * lu(k,2083) + lu(k,2104) = lu(k,2104) - lu(k,1163) * lu(k,2083) + lu(k,2152) = lu(k,2152) - lu(k,1161) * lu(k,2147) + lu(k,2160) = lu(k,2160) - lu(k,1162) * lu(k,2147) + lu(k,2171) = lu(k,2171) - lu(k,1163) * lu(k,2147) + lu(k,2217) = lu(k,2217) - lu(k,1161) * lu(k,2203) + lu(k,2224) = lu(k,2224) - lu(k,1162) * lu(k,2203) + lu(k,2235) = lu(k,2235) - lu(k,1163) * lu(k,2203) + lu(k,2241) = lu(k,2241) - lu(k,1161) * lu(k,2240) + lu(k,2249) = lu(k,2249) - lu(k,1162) * lu(k,2240) + lu(k,2260) = lu(k,2260) - lu(k,1163) * lu(k,2240) + lu(k,2349) = lu(k,2349) - lu(k,1161) * lu(k,2334) + lu(k,2357) = lu(k,2357) - lu(k,1162) * lu(k,2334) + lu(k,2368) = lu(k,2368) - lu(k,1163) * lu(k,2334) + lu(k,2404) = lu(k,2404) - lu(k,1161) * lu(k,2389) + lu(k,2409) = lu(k,2409) - lu(k,1162) * lu(k,2389) + lu(k,2420) = lu(k,2420) - lu(k,1163) * lu(k,2389) + lu(k,1166) = 1._r8 / lu(k,1166) + lu(k,1167) = lu(k,1167) * lu(k,1166) + lu(k,1168) = lu(k,1168) * lu(k,1166) + lu(k,1169) = lu(k,1169) * lu(k,1166) + lu(k,1170) = lu(k,1170) * lu(k,1166) + lu(k,1181) = lu(k,1181) - lu(k,1167) * lu(k,1177) + lu(k,1182) = lu(k,1182) - lu(k,1168) * lu(k,1177) + lu(k,1185) = lu(k,1185) - lu(k,1169) * lu(k,1177) + lu(k,1187) = lu(k,1187) - lu(k,1170) * lu(k,1177) + lu(k,1199) = lu(k,1199) - lu(k,1167) * lu(k,1194) + lu(k,1201) = lu(k,1201) - lu(k,1168) * lu(k,1194) + lu(k,1203) = lu(k,1203) - lu(k,1169) * lu(k,1194) + lu(k,1205) = lu(k,1205) - lu(k,1170) * lu(k,1194) + lu(k,1236) = lu(k,1236) - lu(k,1167) * lu(k,1231) + lu(k,1238) = lu(k,1238) - lu(k,1168) * lu(k,1231) + lu(k,1241) = lu(k,1241) - lu(k,1169) * lu(k,1231) + lu(k,1242) = lu(k,1242) - lu(k,1170) * lu(k,1231) + lu(k,1258) = lu(k,1258) - lu(k,1167) * lu(k,1251) + lu(k,1260) = lu(k,1260) - lu(k,1168) * lu(k,1251) + lu(k,1263) = lu(k,1263) - lu(k,1169) * lu(k,1251) + lu(k,1265) = lu(k,1265) - lu(k,1170) * lu(k,1251) + lu(k,1304) = lu(k,1304) - lu(k,1167) * lu(k,1292) + lu(k,1306) = lu(k,1306) - lu(k,1168) * lu(k,1292) + lu(k,1309) = lu(k,1309) - lu(k,1169) * lu(k,1292) + lu(k,1312) = lu(k,1312) - lu(k,1170) * lu(k,1292) + lu(k,1337) = lu(k,1337) - lu(k,1167) * lu(k,1325) + lu(k,1339) = lu(k,1339) - lu(k,1168) * lu(k,1325) + lu(k,1342) = lu(k,1342) - lu(k,1169) * lu(k,1325) + lu(k,1345) = lu(k,1345) - lu(k,1170) * lu(k,1325) + lu(k,1359) = lu(k,1359) - lu(k,1167) * lu(k,1351) + lu(k,1361) = lu(k,1361) - lu(k,1168) * lu(k,1351) + lu(k,1364) = lu(k,1364) - lu(k,1169) * lu(k,1351) + lu(k,1366) = lu(k,1366) - lu(k,1170) * lu(k,1351) + lu(k,1429) = lu(k,1429) - lu(k,1167) * lu(k,1417) + lu(k,1432) = lu(k,1432) - lu(k,1168) * lu(k,1417) + lu(k,1435) = lu(k,1435) - lu(k,1169) * lu(k,1417) + lu(k,1439) = lu(k,1439) - lu(k,1170) * lu(k,1417) + lu(k,1539) = lu(k,1539) - lu(k,1167) * lu(k,1538) + lu(k,1545) = lu(k,1545) - lu(k,1168) * lu(k,1538) + lu(k,1548) = lu(k,1548) - lu(k,1169) * lu(k,1538) + lu(k,1554) = lu(k,1554) - lu(k,1170) * lu(k,1538) + lu(k,1646) = lu(k,1646) - lu(k,1167) * lu(k,1631) + lu(k,1653) = lu(k,1653) - lu(k,1168) * lu(k,1631) + lu(k,1656) = lu(k,1656) - lu(k,1169) * lu(k,1631) + lu(k,1664) = lu(k,1664) - lu(k,1170) * lu(k,1631) + lu(k,1809) = lu(k,1809) - lu(k,1167) * lu(k,1794) + lu(k,1818) = lu(k,1818) - lu(k,1168) * lu(k,1794) + lu(k,1821) = lu(k,1821) - lu(k,1169) * lu(k,1794) + lu(k,1829) = lu(k,1829) - lu(k,1170) * lu(k,1794) + lu(k,1907) = lu(k,1907) - lu(k,1167) * lu(k,1892) + lu(k,1913) = lu(k,1913) - lu(k,1168) * lu(k,1892) + lu(k,1916) = lu(k,1916) - lu(k,1169) * lu(k,1892) + lu(k,1924) = lu(k,1924) - lu(k,1170) * lu(k,1892) + lu(k,2152) = lu(k,2152) - lu(k,1167) * lu(k,2148) + lu(k,2160) = lu(k,2160) - lu(k,1168) * lu(k,2148) + lu(k,2163) = lu(k,2163) - lu(k,1169) * lu(k,2148) + lu(k,2171) = lu(k,2171) - lu(k,1170) * lu(k,2148) + lu(k,2217) = lu(k,2217) - lu(k,1167) * lu(k,2204) + lu(k,2224) = lu(k,2224) - lu(k,1168) * lu(k,2204) + lu(k,2227) = lu(k,2227) - lu(k,1169) * lu(k,2204) + lu(k,2235) = lu(k,2235) - lu(k,1170) * lu(k,2204) + lu(k,2349) = lu(k,2349) - lu(k,1167) * lu(k,2335) + lu(k,2357) = lu(k,2357) - lu(k,1168) * lu(k,2335) + lu(k,2360) = lu(k,2360) - lu(k,1169) * lu(k,2335) + lu(k,2368) = lu(k,2368) - lu(k,1170) * lu(k,2335) + lu(k,2404) = lu(k,2404) - lu(k,1167) * lu(k,2390) + lu(k,2409) = lu(k,2409) - lu(k,1168) * lu(k,2390) + lu(k,2412) = lu(k,2412) - lu(k,1169) * lu(k,2390) + lu(k,2420) = lu(k,2420) - lu(k,1170) * lu(k,2390) + lu(k,1178) = 1._r8 / lu(k,1178) + lu(k,1179) = lu(k,1179) * lu(k,1178) + lu(k,1180) = lu(k,1180) * lu(k,1178) + lu(k,1181) = lu(k,1181) * lu(k,1178) + lu(k,1182) = lu(k,1182) * lu(k,1178) + lu(k,1183) = lu(k,1183) * lu(k,1178) + lu(k,1184) = lu(k,1184) * lu(k,1178) + lu(k,1185) = lu(k,1185) * lu(k,1178) + lu(k,1186) = lu(k,1186) * lu(k,1178) + lu(k,1187) = lu(k,1187) * lu(k,1178) + lu(k,1188) = lu(k,1188) * lu(k,1178) + lu(k,1189) = lu(k,1189) * lu(k,1178) + lu(k,1635) = lu(k,1635) - lu(k,1179) * lu(k,1632) + lu(k,1645) = lu(k,1645) - lu(k,1180) * lu(k,1632) + lu(k,1646) = lu(k,1646) - lu(k,1181) * lu(k,1632) + lu(k,1653) = lu(k,1653) - lu(k,1182) * lu(k,1632) + lu(k,1654) = lu(k,1654) - lu(k,1183) * lu(k,1632) + lu(k,1655) = lu(k,1655) - lu(k,1184) * lu(k,1632) + lu(k,1656) = lu(k,1656) - lu(k,1185) * lu(k,1632) + lu(k,1658) = lu(k,1658) - lu(k,1186) * lu(k,1632) + lu(k,1664) = lu(k,1664) - lu(k,1187) * lu(k,1632) + lu(k,1665) = lu(k,1665) - lu(k,1188) * lu(k,1632) + lu(k,1666) = lu(k,1666) - lu(k,1189) * lu(k,1632) + lu(k,1798) = lu(k,1798) - lu(k,1179) * lu(k,1795) + lu(k,1808) = lu(k,1808) - lu(k,1180) * lu(k,1795) + lu(k,1809) = lu(k,1809) - lu(k,1181) * lu(k,1795) + lu(k,1818) = lu(k,1818) - lu(k,1182) * lu(k,1795) + lu(k,1819) = lu(k,1819) - lu(k,1183) * lu(k,1795) + lu(k,1820) = lu(k,1820) - lu(k,1184) * lu(k,1795) + lu(k,1821) = lu(k,1821) - lu(k,1185) * lu(k,1795) + lu(k,1823) = lu(k,1823) - lu(k,1186) * lu(k,1795) + lu(k,1829) = lu(k,1829) - lu(k,1187) * lu(k,1795) + lu(k,1830) = lu(k,1830) - lu(k,1188) * lu(k,1795) + lu(k,1831) = lu(k,1831) - lu(k,1189) * lu(k,1795) + lu(k,1896) = lu(k,1896) - lu(k,1179) * lu(k,1893) + lu(k,1906) = lu(k,1906) - lu(k,1180) * lu(k,1893) + lu(k,1907) = lu(k,1907) - lu(k,1181) * lu(k,1893) + lu(k,1913) = lu(k,1913) - lu(k,1182) * lu(k,1893) + lu(k,1914) = lu(k,1914) - lu(k,1183) * lu(k,1893) + lu(k,1915) = lu(k,1915) - lu(k,1184) * lu(k,1893) + lu(k,1916) = lu(k,1916) - lu(k,1185) * lu(k,1893) + lu(k,1918) = lu(k,1918) - lu(k,1186) * lu(k,1893) + lu(k,1924) = lu(k,1924) - lu(k,1187) * lu(k,1893) + lu(k,1925) = lu(k,1925) - lu(k,1188) * lu(k,1893) + lu(k,1926) = lu(k,1926) - lu(k,1189) * lu(k,1893) + lu(k,2207) = lu(k,2207) - lu(k,1179) * lu(k,2205) + lu(k,2216) = lu(k,2216) - lu(k,1180) * lu(k,2205) + lu(k,2217) = lu(k,2217) - lu(k,1181) * lu(k,2205) + lu(k,2224) = lu(k,2224) - lu(k,1182) * lu(k,2205) + lu(k,2225) = lu(k,2225) - lu(k,1183) * lu(k,2205) + lu(k,2226) = lu(k,2226) - lu(k,1184) * lu(k,2205) + lu(k,2227) = lu(k,2227) - lu(k,1185) * lu(k,2205) + lu(k,2229) = lu(k,2229) - lu(k,1186) * lu(k,2205) + lu(k,2235) = lu(k,2235) - lu(k,1187) * lu(k,2205) + lu(k,2236) = lu(k,2236) - lu(k,1188) * lu(k,2205) + lu(k,2237) = lu(k,2237) - lu(k,1189) * lu(k,2205) + lu(k,2338) = lu(k,2338) - lu(k,1179) * lu(k,2336) + lu(k,2348) = lu(k,2348) - lu(k,1180) * lu(k,2336) + lu(k,2349) = lu(k,2349) - lu(k,1181) * lu(k,2336) + lu(k,2357) = lu(k,2357) - lu(k,1182) * lu(k,2336) + lu(k,2358) = lu(k,2358) - lu(k,1183) * lu(k,2336) + lu(k,2359) = lu(k,2359) - lu(k,1184) * lu(k,2336) + lu(k,2360) = lu(k,2360) - lu(k,1185) * lu(k,2336) + lu(k,2362) = lu(k,2362) - lu(k,1186) * lu(k,2336) + lu(k,2368) = lu(k,2368) - lu(k,1187) * lu(k,2336) + lu(k,2369) = lu(k,2369) - lu(k,1188) * lu(k,2336) + lu(k,2370) = lu(k,2370) - lu(k,1189) * lu(k,2336) + lu(k,2393) = lu(k,2393) - lu(k,1179) * lu(k,2391) + lu(k,2403) = lu(k,2403) - lu(k,1180) * lu(k,2391) + lu(k,2404) = lu(k,2404) - lu(k,1181) * lu(k,2391) + lu(k,2409) = lu(k,2409) - lu(k,1182) * lu(k,2391) + lu(k,2410) = lu(k,2410) - lu(k,1183) * lu(k,2391) + lu(k,2411) = lu(k,2411) - lu(k,1184) * lu(k,2391) + lu(k,2412) = lu(k,2412) - lu(k,1185) * lu(k,2391) + lu(k,2414) = lu(k,2414) - lu(k,1186) * lu(k,2391) + lu(k,2420) = lu(k,2420) - lu(k,1187) * lu(k,2391) + lu(k,2421) = lu(k,2421) - lu(k,1188) * lu(k,2391) + lu(k,2422) = lu(k,2422) - lu(k,1189) * lu(k,2391) + lu(k,1195) = 1._r8 / lu(k,1195) + lu(k,1196) = lu(k,1196) * lu(k,1195) + lu(k,1197) = lu(k,1197) * lu(k,1195) + lu(k,1198) = lu(k,1198) * lu(k,1195) + lu(k,1199) = lu(k,1199) * lu(k,1195) + lu(k,1200) = lu(k,1200) * lu(k,1195) + lu(k,1201) = lu(k,1201) * lu(k,1195) + lu(k,1202) = lu(k,1202) * lu(k,1195) + lu(k,1203) = lu(k,1203) * lu(k,1195) + lu(k,1204) = lu(k,1204) * lu(k,1195) + lu(k,1205) = lu(k,1205) * lu(k,1195) + lu(k,1206) = lu(k,1206) * lu(k,1195) + lu(k,1207) = lu(k,1207) * lu(k,1195) + lu(k,1294) = lu(k,1294) - lu(k,1196) * lu(k,1293) + lu(k,1295) = - lu(k,1197) * lu(k,1293) + lu(k,1303) = lu(k,1303) - lu(k,1198) * lu(k,1293) + lu(k,1304) = lu(k,1304) - lu(k,1199) * lu(k,1293) + lu(k,1305) = lu(k,1305) - lu(k,1200) * lu(k,1293) + lu(k,1306) = lu(k,1306) - lu(k,1201) * lu(k,1293) + lu(k,1308) = lu(k,1308) - lu(k,1202) * lu(k,1293) + lu(k,1309) = lu(k,1309) - lu(k,1203) * lu(k,1293) + lu(k,1310) = lu(k,1310) - lu(k,1204) * lu(k,1293) + lu(k,1312) = lu(k,1312) - lu(k,1205) * lu(k,1293) + lu(k,1313) = lu(k,1313) - lu(k,1206) * lu(k,1293) + lu(k,1314) = - lu(k,1207) * lu(k,1293) + lu(k,1327) = lu(k,1327) - lu(k,1196) * lu(k,1326) + lu(k,1328) = - lu(k,1197) * lu(k,1326) + lu(k,1336) = lu(k,1336) - lu(k,1198) * lu(k,1326) + lu(k,1337) = lu(k,1337) - lu(k,1199) * lu(k,1326) + lu(k,1338) = lu(k,1338) - lu(k,1200) * lu(k,1326) + lu(k,1339) = lu(k,1339) - lu(k,1201) * lu(k,1326) + lu(k,1341) = lu(k,1341) - lu(k,1202) * lu(k,1326) + lu(k,1342) = lu(k,1342) - lu(k,1203) * lu(k,1326) + lu(k,1343) = lu(k,1343) - lu(k,1204) * lu(k,1326) + lu(k,1345) = lu(k,1345) - lu(k,1205) * lu(k,1326) + lu(k,1346) = lu(k,1346) - lu(k,1206) * lu(k,1326) + lu(k,1347) = - lu(k,1207) * lu(k,1326) + lu(k,1353) = lu(k,1353) - lu(k,1196) * lu(k,1352) + lu(k,1354) = - lu(k,1197) * lu(k,1352) + lu(k,1358) = lu(k,1358) - lu(k,1198) * lu(k,1352) + lu(k,1359) = lu(k,1359) - lu(k,1199) * lu(k,1352) + lu(k,1360) = lu(k,1360) - lu(k,1200) * lu(k,1352) + lu(k,1361) = lu(k,1361) - lu(k,1201) * lu(k,1352) + lu(k,1363) = lu(k,1363) - lu(k,1202) * lu(k,1352) + lu(k,1364) = lu(k,1364) - lu(k,1203) * lu(k,1352) + lu(k,1365) = - lu(k,1204) * lu(k,1352) + lu(k,1366) = lu(k,1366) - lu(k,1205) * lu(k,1352) + lu(k,1367) = lu(k,1367) - lu(k,1206) * lu(k,1352) + lu(k,1368) = - lu(k,1207) * lu(k,1352) + lu(k,1634) = lu(k,1634) - lu(k,1196) * lu(k,1633) + lu(k,1635) = lu(k,1635) - lu(k,1197) * lu(k,1633) + lu(k,1645) = lu(k,1645) - lu(k,1198) * lu(k,1633) + lu(k,1646) = lu(k,1646) - lu(k,1199) * lu(k,1633) + lu(k,1652) = lu(k,1652) - lu(k,1200) * lu(k,1633) + lu(k,1653) = lu(k,1653) - lu(k,1201) * lu(k,1633) + lu(k,1655) = lu(k,1655) - lu(k,1202) * lu(k,1633) + lu(k,1656) = lu(k,1656) - lu(k,1203) * lu(k,1633) + lu(k,1658) = lu(k,1658) - lu(k,1204) * lu(k,1633) + lu(k,1664) = lu(k,1664) - lu(k,1205) * lu(k,1633) + lu(k,1665) = lu(k,1665) - lu(k,1206) * lu(k,1633) + lu(k,1666) = lu(k,1666) - lu(k,1207) * lu(k,1633) + lu(k,1797) = lu(k,1797) - lu(k,1196) * lu(k,1796) + lu(k,1798) = lu(k,1798) - lu(k,1197) * lu(k,1796) + lu(k,1808) = lu(k,1808) - lu(k,1198) * lu(k,1796) + lu(k,1809) = lu(k,1809) - lu(k,1199) * lu(k,1796) + lu(k,1817) = lu(k,1817) - lu(k,1200) * lu(k,1796) + lu(k,1818) = lu(k,1818) - lu(k,1201) * lu(k,1796) + lu(k,1820) = lu(k,1820) - lu(k,1202) * lu(k,1796) + lu(k,1821) = lu(k,1821) - lu(k,1203) * lu(k,1796) + lu(k,1823) = lu(k,1823) - lu(k,1204) * lu(k,1796) + lu(k,1829) = lu(k,1829) - lu(k,1205) * lu(k,1796) + lu(k,1830) = lu(k,1830) - lu(k,1206) * lu(k,1796) + lu(k,1831) = lu(k,1831) - lu(k,1207) * lu(k,1796) + lu(k,1895) = lu(k,1895) - lu(k,1196) * lu(k,1894) + lu(k,1896) = lu(k,1896) - lu(k,1197) * lu(k,1894) + lu(k,1906) = lu(k,1906) - lu(k,1198) * lu(k,1894) + lu(k,1907) = lu(k,1907) - lu(k,1199) * lu(k,1894) + lu(k,1912) = lu(k,1912) - lu(k,1200) * lu(k,1894) + lu(k,1913) = lu(k,1913) - lu(k,1201) * lu(k,1894) + lu(k,1915) = lu(k,1915) - lu(k,1202) * lu(k,1894) + lu(k,1916) = lu(k,1916) - lu(k,1203) * lu(k,1894) + lu(k,1918) = lu(k,1918) - lu(k,1204) * lu(k,1894) + lu(k,1924) = lu(k,1924) - lu(k,1205) * lu(k,1894) + lu(k,1925) = lu(k,1925) - lu(k,1206) * lu(k,1894) + lu(k,1926) = lu(k,1926) - lu(k,1207) * lu(k,1894) + lu(k,1208) = 1._r8 / lu(k,1208) + lu(k,1209) = lu(k,1209) * lu(k,1208) + lu(k,1210) = lu(k,1210) * lu(k,1208) + lu(k,1211) = lu(k,1211) * lu(k,1208) + lu(k,1212) = lu(k,1212) * lu(k,1208) + lu(k,1213) = lu(k,1213) * lu(k,1208) + lu(k,1218) = lu(k,1218) - lu(k,1209) * lu(k,1216) + lu(k,1219) = lu(k,1219) - lu(k,1210) * lu(k,1216) + lu(k,1220) = lu(k,1220) - lu(k,1211) * lu(k,1216) + lu(k,1223) = lu(k,1223) - lu(k,1212) * lu(k,1216) + lu(k,1224) = lu(k,1224) - lu(k,1213) * lu(k,1216) + lu(k,1234) = lu(k,1234) - lu(k,1209) * lu(k,1232) + lu(k,1235) = lu(k,1235) - lu(k,1210) * lu(k,1232) + lu(k,1238) = lu(k,1238) - lu(k,1211) * lu(k,1232) + lu(k,1241) = lu(k,1241) - lu(k,1212) * lu(k,1232) + lu(k,1242) = lu(k,1242) - lu(k,1213) * lu(k,1232) + lu(k,1298) = - lu(k,1209) * lu(k,1294) + lu(k,1303) = lu(k,1303) - lu(k,1210) * lu(k,1294) + lu(k,1306) = lu(k,1306) - lu(k,1211) * lu(k,1294) + lu(k,1309) = lu(k,1309) - lu(k,1212) * lu(k,1294) + lu(k,1312) = lu(k,1312) - lu(k,1213) * lu(k,1294) + lu(k,1331) = lu(k,1331) - lu(k,1209) * lu(k,1327) + lu(k,1336) = lu(k,1336) - lu(k,1210) * lu(k,1327) + lu(k,1339) = lu(k,1339) - lu(k,1211) * lu(k,1327) + lu(k,1342) = lu(k,1342) - lu(k,1212) * lu(k,1327) + lu(k,1345) = lu(k,1345) - lu(k,1213) * lu(k,1327) + lu(k,1355) = lu(k,1355) - lu(k,1209) * lu(k,1353) + lu(k,1358) = lu(k,1358) - lu(k,1210) * lu(k,1353) + lu(k,1361) = lu(k,1361) - lu(k,1211) * lu(k,1353) + lu(k,1364) = lu(k,1364) - lu(k,1212) * lu(k,1353) + lu(k,1366) = lu(k,1366) - lu(k,1213) * lu(k,1353) + lu(k,1374) = lu(k,1374) - lu(k,1209) * lu(k,1373) + lu(k,1378) = lu(k,1378) - lu(k,1210) * lu(k,1373) + lu(k,1382) = lu(k,1382) - lu(k,1211) * lu(k,1373) + lu(k,1385) = lu(k,1385) - lu(k,1212) * lu(k,1373) + lu(k,1389) = lu(k,1389) - lu(k,1213) * lu(k,1373) + lu(k,1396) = - lu(k,1209) * lu(k,1395) + lu(k,1398) = lu(k,1398) - lu(k,1210) * lu(k,1395) + lu(k,1401) = lu(k,1401) - lu(k,1211) * lu(k,1395) + lu(k,1404) = lu(k,1404) - lu(k,1212) * lu(k,1395) + lu(k,1407) = lu(k,1407) - lu(k,1213) * lu(k,1395) + lu(k,1422) = lu(k,1422) - lu(k,1209) * lu(k,1418) + lu(k,1428) = lu(k,1428) - lu(k,1210) * lu(k,1418) + lu(k,1432) = lu(k,1432) - lu(k,1211) * lu(k,1418) + lu(k,1435) = lu(k,1435) - lu(k,1212) * lu(k,1418) + lu(k,1439) = lu(k,1439) - lu(k,1213) * lu(k,1418) + lu(k,1639) = lu(k,1639) - lu(k,1209) * lu(k,1634) + lu(k,1645) = lu(k,1645) - lu(k,1210) * lu(k,1634) + lu(k,1653) = lu(k,1653) - lu(k,1211) * lu(k,1634) + lu(k,1656) = lu(k,1656) - lu(k,1212) * lu(k,1634) + lu(k,1664) = lu(k,1664) - lu(k,1213) * lu(k,1634) + lu(k,1802) = lu(k,1802) - lu(k,1209) * lu(k,1797) + lu(k,1808) = lu(k,1808) - lu(k,1210) * lu(k,1797) + lu(k,1818) = lu(k,1818) - lu(k,1211) * lu(k,1797) + lu(k,1821) = lu(k,1821) - lu(k,1212) * lu(k,1797) + lu(k,1829) = lu(k,1829) - lu(k,1213) * lu(k,1797) + lu(k,1900) = lu(k,1900) - lu(k,1209) * lu(k,1895) + lu(k,1906) = lu(k,1906) - lu(k,1210) * lu(k,1895) + lu(k,1913) = lu(k,1913) - lu(k,1211) * lu(k,1895) + lu(k,1916) = lu(k,1916) - lu(k,1212) * lu(k,1895) + lu(k,1924) = lu(k,1924) - lu(k,1213) * lu(k,1895) + lu(k,1947) = lu(k,1947) - lu(k,1209) * lu(k,1946) + lu(k,1949) = lu(k,1949) - lu(k,1210) * lu(k,1946) + lu(k,1958) = lu(k,1958) - lu(k,1211) * lu(k,1946) + lu(k,1961) = lu(k,1961) - lu(k,1212) * lu(k,1946) + lu(k,1969) = lu(k,1969) - lu(k,1213) * lu(k,1946) + lu(k,2210) = lu(k,2210) - lu(k,1209) * lu(k,2206) + lu(k,2216) = lu(k,2216) - lu(k,1210) * lu(k,2206) + lu(k,2224) = lu(k,2224) - lu(k,1211) * lu(k,2206) + lu(k,2227) = lu(k,2227) - lu(k,1212) * lu(k,2206) + lu(k,2235) = lu(k,2235) - lu(k,1213) * lu(k,2206) + lu(k,2342) = lu(k,2342) - lu(k,1209) * lu(k,2337) + lu(k,2348) = lu(k,2348) - lu(k,1210) * lu(k,2337) + lu(k,2357) = lu(k,2357) - lu(k,1211) * lu(k,2337) + lu(k,2360) = lu(k,2360) - lu(k,1212) * lu(k,2337) + lu(k,2368) = lu(k,2368) - lu(k,1213) * lu(k,2337) + lu(k,2397) = lu(k,2397) - lu(k,1209) * lu(k,2392) + lu(k,2403) = lu(k,2403) - lu(k,1210) * lu(k,2392) + lu(k,2409) = lu(k,2409) - lu(k,1211) * lu(k,2392) + lu(k,2412) = lu(k,2412) - lu(k,1212) * lu(k,2392) + lu(k,2420) = lu(k,2420) - lu(k,1213) * lu(k,2392) + end do + end subroutine lu_fac24 + subroutine lu_fac25( 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,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,1221) = lu(k,1221) * lu(k,1217) + lu(k,1222) = lu(k,1222) * lu(k,1217) + lu(k,1223) = lu(k,1223) * lu(k,1217) + lu(k,1224) = lu(k,1224) * lu(k,1217) + lu(k,1225) = lu(k,1225) * lu(k,1217) + lu(k,1226) = lu(k,1226) * lu(k,1217) + lu(k,1298) = lu(k,1298) - lu(k,1218) * lu(k,1295) + lu(k,1303) = lu(k,1303) - lu(k,1219) * lu(k,1295) + lu(k,1306) = lu(k,1306) - lu(k,1220) * lu(k,1295) + lu(k,1307) = lu(k,1307) - lu(k,1221) * lu(k,1295) + lu(k,1308) = lu(k,1308) - lu(k,1222) * lu(k,1295) + lu(k,1309) = lu(k,1309) - lu(k,1223) * lu(k,1295) + lu(k,1312) = lu(k,1312) - lu(k,1224) * lu(k,1295) + lu(k,1313) = lu(k,1313) - lu(k,1225) * lu(k,1295) + lu(k,1314) = lu(k,1314) - lu(k,1226) * lu(k,1295) + lu(k,1331) = lu(k,1331) - lu(k,1218) * lu(k,1328) + lu(k,1336) = lu(k,1336) - lu(k,1219) * lu(k,1328) + lu(k,1339) = lu(k,1339) - lu(k,1220) * lu(k,1328) + lu(k,1340) = lu(k,1340) - lu(k,1221) * lu(k,1328) + lu(k,1341) = lu(k,1341) - lu(k,1222) * lu(k,1328) + lu(k,1342) = lu(k,1342) - lu(k,1223) * lu(k,1328) + lu(k,1345) = lu(k,1345) - lu(k,1224) * lu(k,1328) + lu(k,1346) = lu(k,1346) - lu(k,1225) * lu(k,1328) + lu(k,1347) = lu(k,1347) - lu(k,1226) * lu(k,1328) + lu(k,1355) = lu(k,1355) - lu(k,1218) * lu(k,1354) + lu(k,1358) = lu(k,1358) - lu(k,1219) * lu(k,1354) + lu(k,1361) = lu(k,1361) - lu(k,1220) * lu(k,1354) + lu(k,1362) = lu(k,1362) - lu(k,1221) * lu(k,1354) + lu(k,1363) = lu(k,1363) - lu(k,1222) * lu(k,1354) + lu(k,1364) = lu(k,1364) - lu(k,1223) * lu(k,1354) + lu(k,1366) = lu(k,1366) - lu(k,1224) * lu(k,1354) + lu(k,1367) = lu(k,1367) - lu(k,1225) * lu(k,1354) + lu(k,1368) = lu(k,1368) - lu(k,1226) * lu(k,1354) + lu(k,1639) = lu(k,1639) - lu(k,1218) * lu(k,1635) + lu(k,1645) = lu(k,1645) - lu(k,1219) * lu(k,1635) + lu(k,1653) = lu(k,1653) - lu(k,1220) * lu(k,1635) + lu(k,1654) = lu(k,1654) - lu(k,1221) * lu(k,1635) + lu(k,1655) = lu(k,1655) - lu(k,1222) * lu(k,1635) + lu(k,1656) = lu(k,1656) - lu(k,1223) * lu(k,1635) + lu(k,1664) = lu(k,1664) - lu(k,1224) * lu(k,1635) + lu(k,1665) = lu(k,1665) - lu(k,1225) * lu(k,1635) + lu(k,1666) = lu(k,1666) - lu(k,1226) * lu(k,1635) + lu(k,1802) = lu(k,1802) - lu(k,1218) * lu(k,1798) + lu(k,1808) = lu(k,1808) - lu(k,1219) * lu(k,1798) + lu(k,1818) = lu(k,1818) - lu(k,1220) * lu(k,1798) + lu(k,1819) = lu(k,1819) - lu(k,1221) * lu(k,1798) + lu(k,1820) = lu(k,1820) - lu(k,1222) * lu(k,1798) + lu(k,1821) = lu(k,1821) - lu(k,1223) * lu(k,1798) + lu(k,1829) = lu(k,1829) - lu(k,1224) * lu(k,1798) + lu(k,1830) = lu(k,1830) - lu(k,1225) * lu(k,1798) + lu(k,1831) = lu(k,1831) - lu(k,1226) * lu(k,1798) + lu(k,1900) = lu(k,1900) - lu(k,1218) * lu(k,1896) + lu(k,1906) = lu(k,1906) - lu(k,1219) * lu(k,1896) + lu(k,1913) = lu(k,1913) - lu(k,1220) * lu(k,1896) + lu(k,1914) = lu(k,1914) - lu(k,1221) * lu(k,1896) + lu(k,1915) = lu(k,1915) - lu(k,1222) * lu(k,1896) + lu(k,1916) = lu(k,1916) - lu(k,1223) * lu(k,1896) + lu(k,1924) = lu(k,1924) - lu(k,1224) * lu(k,1896) + lu(k,1925) = lu(k,1925) - lu(k,1225) * lu(k,1896) + lu(k,1926) = lu(k,1926) - lu(k,1226) * lu(k,1896) + lu(k,2150) = - lu(k,1218) * lu(k,2149) + lu(k,2151) = lu(k,2151) - lu(k,1219) * lu(k,2149) + lu(k,2160) = lu(k,2160) - lu(k,1220) * lu(k,2149) + lu(k,2161) = lu(k,2161) - lu(k,1221) * lu(k,2149) + lu(k,2162) = lu(k,2162) - lu(k,1222) * lu(k,2149) + lu(k,2163) = lu(k,2163) - lu(k,1223) * lu(k,2149) + lu(k,2171) = lu(k,2171) - lu(k,1224) * lu(k,2149) + lu(k,2172) = lu(k,2172) - lu(k,1225) * lu(k,2149) + lu(k,2173) = lu(k,2173) - lu(k,1226) * lu(k,2149) + lu(k,2210) = lu(k,2210) - lu(k,1218) * lu(k,2207) + lu(k,2216) = lu(k,2216) - lu(k,1219) * lu(k,2207) + lu(k,2224) = lu(k,2224) - lu(k,1220) * lu(k,2207) + lu(k,2225) = lu(k,2225) - lu(k,1221) * lu(k,2207) + lu(k,2226) = lu(k,2226) - lu(k,1222) * lu(k,2207) + lu(k,2227) = lu(k,2227) - lu(k,1223) * lu(k,2207) + lu(k,2235) = lu(k,2235) - lu(k,1224) * lu(k,2207) + lu(k,2236) = lu(k,2236) - lu(k,1225) * lu(k,2207) + lu(k,2237) = lu(k,2237) - lu(k,1226) * lu(k,2207) + lu(k,2342) = lu(k,2342) - lu(k,1218) * lu(k,2338) + lu(k,2348) = lu(k,2348) - lu(k,1219) * lu(k,2338) + lu(k,2357) = lu(k,2357) - lu(k,1220) * lu(k,2338) + lu(k,2358) = lu(k,2358) - lu(k,1221) * lu(k,2338) + lu(k,2359) = lu(k,2359) - lu(k,1222) * lu(k,2338) + lu(k,2360) = lu(k,2360) - lu(k,1223) * lu(k,2338) + lu(k,2368) = lu(k,2368) - lu(k,1224) * lu(k,2338) + lu(k,2369) = lu(k,2369) - lu(k,1225) * lu(k,2338) + lu(k,2370) = lu(k,2370) - lu(k,1226) * lu(k,2338) + lu(k,2397) = lu(k,2397) - lu(k,1218) * lu(k,2393) + lu(k,2403) = lu(k,2403) - lu(k,1219) * lu(k,2393) + lu(k,2409) = lu(k,2409) - lu(k,1220) * lu(k,2393) + lu(k,2410) = lu(k,2410) - lu(k,1221) * lu(k,2393) + lu(k,2411) = lu(k,2411) - lu(k,1222) * lu(k,2393) + lu(k,2412) = lu(k,2412) - lu(k,1223) * lu(k,2393) + lu(k,2420) = lu(k,2420) - lu(k,1224) * lu(k,2393) + lu(k,2421) = lu(k,2421) - lu(k,1225) * lu(k,2393) + lu(k,2422) = lu(k,2422) - lu(k,1226) * lu(k,2393) + lu(k,1233) = 1._r8 / lu(k,1233) + lu(k,1234) = lu(k,1234) * lu(k,1233) + lu(k,1235) = lu(k,1235) * lu(k,1233) + lu(k,1236) = lu(k,1236) * lu(k,1233) + lu(k,1237) = lu(k,1237) * lu(k,1233) + lu(k,1238) = lu(k,1238) * lu(k,1233) + lu(k,1239) = lu(k,1239) * lu(k,1233) + lu(k,1240) = lu(k,1240) * lu(k,1233) + lu(k,1241) = lu(k,1241) * lu(k,1233) + lu(k,1242) = lu(k,1242) * lu(k,1233) + lu(k,1243) = lu(k,1243) * lu(k,1233) + lu(k,1255) = lu(k,1255) - lu(k,1234) * lu(k,1252) + lu(k,1257) = lu(k,1257) - lu(k,1235) * lu(k,1252) + lu(k,1258) = lu(k,1258) - lu(k,1236) * lu(k,1252) + lu(k,1259) = lu(k,1259) - lu(k,1237) * lu(k,1252) + lu(k,1260) = lu(k,1260) - lu(k,1238) * lu(k,1252) + lu(k,1261) = lu(k,1261) - lu(k,1239) * lu(k,1252) + lu(k,1262) = lu(k,1262) - lu(k,1240) * lu(k,1252) + lu(k,1263) = lu(k,1263) - lu(k,1241) * lu(k,1252) + lu(k,1265) = lu(k,1265) - lu(k,1242) * lu(k,1252) + lu(k,1266) = lu(k,1266) - lu(k,1243) * lu(k,1252) + lu(k,1298) = lu(k,1298) - lu(k,1234) * lu(k,1296) + lu(k,1303) = lu(k,1303) - lu(k,1235) * lu(k,1296) + lu(k,1304) = lu(k,1304) - lu(k,1236) * lu(k,1296) + lu(k,1305) = lu(k,1305) - lu(k,1237) * lu(k,1296) + lu(k,1306) = lu(k,1306) - lu(k,1238) * lu(k,1296) + lu(k,1307) = lu(k,1307) - lu(k,1239) * lu(k,1296) + lu(k,1308) = lu(k,1308) - lu(k,1240) * lu(k,1296) + lu(k,1309) = lu(k,1309) - lu(k,1241) * lu(k,1296) + lu(k,1312) = lu(k,1312) - lu(k,1242) * lu(k,1296) + lu(k,1313) = lu(k,1313) - lu(k,1243) * lu(k,1296) + lu(k,1331) = lu(k,1331) - lu(k,1234) * lu(k,1329) + lu(k,1336) = lu(k,1336) - lu(k,1235) * lu(k,1329) + lu(k,1337) = lu(k,1337) - lu(k,1236) * lu(k,1329) + lu(k,1338) = lu(k,1338) - lu(k,1237) * lu(k,1329) + lu(k,1339) = lu(k,1339) - lu(k,1238) * lu(k,1329) + lu(k,1340) = lu(k,1340) - lu(k,1239) * lu(k,1329) + lu(k,1341) = lu(k,1341) - lu(k,1240) * lu(k,1329) + lu(k,1342) = lu(k,1342) - lu(k,1241) * lu(k,1329) + lu(k,1345) = lu(k,1345) - lu(k,1242) * lu(k,1329) + lu(k,1346) = lu(k,1346) - lu(k,1243) * lu(k,1329) + lu(k,1422) = lu(k,1422) - lu(k,1234) * lu(k,1419) + lu(k,1428) = lu(k,1428) - lu(k,1235) * lu(k,1419) + lu(k,1429) = lu(k,1429) - lu(k,1236) * lu(k,1419) + lu(k,1431) = lu(k,1431) - lu(k,1237) * lu(k,1419) + lu(k,1432) = lu(k,1432) - lu(k,1238) * lu(k,1419) + lu(k,1433) = lu(k,1433) - lu(k,1239) * lu(k,1419) + lu(k,1434) = lu(k,1434) - lu(k,1240) * lu(k,1419) + lu(k,1435) = lu(k,1435) - lu(k,1241) * lu(k,1419) + lu(k,1439) = lu(k,1439) - lu(k,1242) * lu(k,1419) + lu(k,1440) = lu(k,1440) - lu(k,1243) * lu(k,1419) + lu(k,1639) = lu(k,1639) - lu(k,1234) * lu(k,1636) + lu(k,1645) = lu(k,1645) - lu(k,1235) * lu(k,1636) + lu(k,1646) = lu(k,1646) - lu(k,1236) * lu(k,1636) + lu(k,1652) = lu(k,1652) - lu(k,1237) * lu(k,1636) + lu(k,1653) = lu(k,1653) - lu(k,1238) * lu(k,1636) + lu(k,1654) = lu(k,1654) - lu(k,1239) * lu(k,1636) + lu(k,1655) = lu(k,1655) - lu(k,1240) * lu(k,1636) + lu(k,1656) = lu(k,1656) - lu(k,1241) * lu(k,1636) + lu(k,1664) = lu(k,1664) - lu(k,1242) * lu(k,1636) + lu(k,1665) = lu(k,1665) - lu(k,1243) * lu(k,1636) + lu(k,1802) = lu(k,1802) - lu(k,1234) * lu(k,1799) + lu(k,1808) = lu(k,1808) - lu(k,1235) * lu(k,1799) + lu(k,1809) = lu(k,1809) - lu(k,1236) * lu(k,1799) + lu(k,1817) = lu(k,1817) - lu(k,1237) * lu(k,1799) + lu(k,1818) = lu(k,1818) - lu(k,1238) * lu(k,1799) + lu(k,1819) = lu(k,1819) - lu(k,1239) * lu(k,1799) + lu(k,1820) = lu(k,1820) - lu(k,1240) * lu(k,1799) + lu(k,1821) = lu(k,1821) - lu(k,1241) * lu(k,1799) + lu(k,1829) = lu(k,1829) - lu(k,1242) * lu(k,1799) + lu(k,1830) = lu(k,1830) - lu(k,1243) * lu(k,1799) + lu(k,1900) = lu(k,1900) - lu(k,1234) * lu(k,1897) + lu(k,1906) = lu(k,1906) - lu(k,1235) * lu(k,1897) + lu(k,1907) = lu(k,1907) - lu(k,1236) * lu(k,1897) + lu(k,1912) = lu(k,1912) - lu(k,1237) * lu(k,1897) + lu(k,1913) = lu(k,1913) - lu(k,1238) * lu(k,1897) + lu(k,1914) = lu(k,1914) - lu(k,1239) * lu(k,1897) + lu(k,1915) = lu(k,1915) - lu(k,1240) * lu(k,1897) + lu(k,1916) = lu(k,1916) - lu(k,1241) * lu(k,1897) + lu(k,1924) = lu(k,1924) - lu(k,1242) * lu(k,1897) + lu(k,1925) = lu(k,1925) - lu(k,1243) * lu(k,1897) + lu(k,2342) = lu(k,2342) - lu(k,1234) * lu(k,2339) + lu(k,2348) = lu(k,2348) - lu(k,1235) * lu(k,2339) + lu(k,2349) = lu(k,2349) - lu(k,1236) * lu(k,2339) + lu(k,2356) = lu(k,2356) - lu(k,1237) * lu(k,2339) + lu(k,2357) = lu(k,2357) - lu(k,1238) * lu(k,2339) + lu(k,2358) = lu(k,2358) - lu(k,1239) * lu(k,2339) + lu(k,2359) = lu(k,2359) - lu(k,1240) * lu(k,2339) + lu(k,2360) = lu(k,2360) - lu(k,1241) * lu(k,2339) + lu(k,2368) = lu(k,2368) - lu(k,1242) * lu(k,2339) + lu(k,2369) = lu(k,2369) - lu(k,1243) * lu(k,2339) + lu(k,2397) = lu(k,2397) - lu(k,1234) * lu(k,2394) + lu(k,2403) = lu(k,2403) - lu(k,1235) * lu(k,2394) + lu(k,2404) = lu(k,2404) - lu(k,1236) * lu(k,2394) + lu(k,2408) = lu(k,2408) - lu(k,1237) * lu(k,2394) + lu(k,2409) = lu(k,2409) - lu(k,1238) * lu(k,2394) + lu(k,2410) = lu(k,2410) - lu(k,1239) * lu(k,2394) + lu(k,2411) = lu(k,2411) - lu(k,1240) * lu(k,2394) + lu(k,2412) = lu(k,2412) - lu(k,1241) * lu(k,2394) + lu(k,2420) = lu(k,2420) - lu(k,1242) * lu(k,2394) + lu(k,2421) = lu(k,2421) - lu(k,1243) * lu(k,2394) + lu(k,1253) = 1._r8 / lu(k,1253) + lu(k,1254) = lu(k,1254) * lu(k,1253) + lu(k,1255) = lu(k,1255) * lu(k,1253) + lu(k,1256) = lu(k,1256) * lu(k,1253) + lu(k,1257) = lu(k,1257) * lu(k,1253) + lu(k,1258) = lu(k,1258) * lu(k,1253) + lu(k,1259) = lu(k,1259) * lu(k,1253) + lu(k,1260) = lu(k,1260) * lu(k,1253) + lu(k,1261) = lu(k,1261) * lu(k,1253) + lu(k,1262) = lu(k,1262) * lu(k,1253) + lu(k,1263) = lu(k,1263) * lu(k,1253) + lu(k,1264) = lu(k,1264) * lu(k,1253) + lu(k,1265) = lu(k,1265) * lu(k,1253) + lu(k,1266) = lu(k,1266) * lu(k,1253) + lu(k,1421) = lu(k,1421) - lu(k,1254) * lu(k,1420) + lu(k,1422) = lu(k,1422) - lu(k,1255) * lu(k,1420) + lu(k,1426) = lu(k,1426) - lu(k,1256) * lu(k,1420) + lu(k,1428) = lu(k,1428) - lu(k,1257) * lu(k,1420) + lu(k,1429) = lu(k,1429) - lu(k,1258) * lu(k,1420) + lu(k,1431) = lu(k,1431) - lu(k,1259) * lu(k,1420) + lu(k,1432) = lu(k,1432) - lu(k,1260) * lu(k,1420) + lu(k,1433) = lu(k,1433) - lu(k,1261) * lu(k,1420) + lu(k,1434) = lu(k,1434) - lu(k,1262) * lu(k,1420) + lu(k,1435) = lu(k,1435) - lu(k,1263) * lu(k,1420) + lu(k,1436) = lu(k,1436) - lu(k,1264) * lu(k,1420) + lu(k,1439) = lu(k,1439) - lu(k,1265) * lu(k,1420) + lu(k,1440) = lu(k,1440) - lu(k,1266) * lu(k,1420) + lu(k,1638) = lu(k,1638) - lu(k,1254) * lu(k,1637) + lu(k,1639) = lu(k,1639) - lu(k,1255) * lu(k,1637) + lu(k,1643) = lu(k,1643) - lu(k,1256) * lu(k,1637) + lu(k,1645) = lu(k,1645) - lu(k,1257) * lu(k,1637) + lu(k,1646) = lu(k,1646) - lu(k,1258) * lu(k,1637) + lu(k,1652) = lu(k,1652) - lu(k,1259) * lu(k,1637) + lu(k,1653) = lu(k,1653) - lu(k,1260) * lu(k,1637) + lu(k,1654) = lu(k,1654) - lu(k,1261) * lu(k,1637) + lu(k,1655) = lu(k,1655) - lu(k,1262) * lu(k,1637) + lu(k,1656) = lu(k,1656) - lu(k,1263) * lu(k,1637) + lu(k,1658) = lu(k,1658) - lu(k,1264) * lu(k,1637) + lu(k,1664) = lu(k,1664) - lu(k,1265) * lu(k,1637) + lu(k,1665) = lu(k,1665) - lu(k,1266) * lu(k,1637) + lu(k,1801) = lu(k,1801) - lu(k,1254) * lu(k,1800) + lu(k,1802) = lu(k,1802) - lu(k,1255) * lu(k,1800) + lu(k,1806) = lu(k,1806) - lu(k,1256) * lu(k,1800) + lu(k,1808) = lu(k,1808) - lu(k,1257) * lu(k,1800) + lu(k,1809) = lu(k,1809) - lu(k,1258) * lu(k,1800) + lu(k,1817) = lu(k,1817) - lu(k,1259) * lu(k,1800) + lu(k,1818) = lu(k,1818) - lu(k,1260) * lu(k,1800) + lu(k,1819) = lu(k,1819) - lu(k,1261) * lu(k,1800) + lu(k,1820) = lu(k,1820) - lu(k,1262) * lu(k,1800) + lu(k,1821) = lu(k,1821) - lu(k,1263) * lu(k,1800) + lu(k,1823) = lu(k,1823) - lu(k,1264) * lu(k,1800) + lu(k,1829) = lu(k,1829) - lu(k,1265) * lu(k,1800) + lu(k,1830) = lu(k,1830) - lu(k,1266) * lu(k,1800) + lu(k,1899) = lu(k,1899) - lu(k,1254) * lu(k,1898) + lu(k,1900) = lu(k,1900) - lu(k,1255) * lu(k,1898) + lu(k,1904) = lu(k,1904) - lu(k,1256) * lu(k,1898) + lu(k,1906) = lu(k,1906) - lu(k,1257) * lu(k,1898) + lu(k,1907) = lu(k,1907) - lu(k,1258) * lu(k,1898) + lu(k,1912) = lu(k,1912) - lu(k,1259) * lu(k,1898) + lu(k,1913) = lu(k,1913) - lu(k,1260) * lu(k,1898) + lu(k,1914) = lu(k,1914) - lu(k,1261) * lu(k,1898) + lu(k,1915) = lu(k,1915) - lu(k,1262) * lu(k,1898) + lu(k,1916) = lu(k,1916) - lu(k,1263) * lu(k,1898) + lu(k,1918) = lu(k,1918) - lu(k,1264) * lu(k,1898) + lu(k,1924) = lu(k,1924) - lu(k,1265) * lu(k,1898) + lu(k,1925) = lu(k,1925) - lu(k,1266) * lu(k,1898) + lu(k,2209) = lu(k,2209) - lu(k,1254) * lu(k,2208) + lu(k,2210) = lu(k,2210) - lu(k,1255) * lu(k,2208) + lu(k,2214) = lu(k,2214) - lu(k,1256) * lu(k,2208) + lu(k,2216) = lu(k,2216) - lu(k,1257) * lu(k,2208) + lu(k,2217) = lu(k,2217) - lu(k,1258) * lu(k,2208) + lu(k,2223) = lu(k,2223) - lu(k,1259) * lu(k,2208) + lu(k,2224) = lu(k,2224) - lu(k,1260) * lu(k,2208) + lu(k,2225) = lu(k,2225) - lu(k,1261) * lu(k,2208) + lu(k,2226) = lu(k,2226) - lu(k,1262) * lu(k,2208) + lu(k,2227) = lu(k,2227) - lu(k,1263) * lu(k,2208) + lu(k,2229) = lu(k,2229) - lu(k,1264) * lu(k,2208) + lu(k,2235) = lu(k,2235) - lu(k,1265) * lu(k,2208) + lu(k,2236) = lu(k,2236) - lu(k,1266) * lu(k,2208) + lu(k,2341) = lu(k,2341) - lu(k,1254) * lu(k,2340) + lu(k,2342) = lu(k,2342) - lu(k,1255) * lu(k,2340) + lu(k,2346) = lu(k,2346) - lu(k,1256) * lu(k,2340) + lu(k,2348) = lu(k,2348) - lu(k,1257) * lu(k,2340) + lu(k,2349) = lu(k,2349) - lu(k,1258) * lu(k,2340) + lu(k,2356) = lu(k,2356) - lu(k,1259) * lu(k,2340) + lu(k,2357) = lu(k,2357) - lu(k,1260) * lu(k,2340) + lu(k,2358) = lu(k,2358) - lu(k,1261) * lu(k,2340) + lu(k,2359) = lu(k,2359) - lu(k,1262) * lu(k,2340) + lu(k,2360) = lu(k,2360) - lu(k,1263) * lu(k,2340) + lu(k,2362) = lu(k,2362) - lu(k,1264) * lu(k,2340) + lu(k,2368) = lu(k,2368) - lu(k,1265) * lu(k,2340) + lu(k,2369) = lu(k,2369) - lu(k,1266) * lu(k,2340) + lu(k,2396) = lu(k,2396) - lu(k,1254) * lu(k,2395) + lu(k,2397) = lu(k,2397) - lu(k,1255) * lu(k,2395) + lu(k,2401) = lu(k,2401) - lu(k,1256) * lu(k,2395) + lu(k,2403) = lu(k,2403) - lu(k,1257) * lu(k,2395) + lu(k,2404) = lu(k,2404) - lu(k,1258) * lu(k,2395) + lu(k,2408) = lu(k,2408) - lu(k,1259) * lu(k,2395) + lu(k,2409) = lu(k,2409) - lu(k,1260) * lu(k,2395) + lu(k,2410) = lu(k,2410) - lu(k,1261) * lu(k,2395) + lu(k,2411) = lu(k,2411) - lu(k,1262) * lu(k,2395) + lu(k,2412) = lu(k,2412) - lu(k,1263) * lu(k,2395) + lu(k,2414) = lu(k,2414) - lu(k,1264) * lu(k,2395) + lu(k,2420) = lu(k,2420) - lu(k,1265) * lu(k,2395) + lu(k,2421) = lu(k,2421) - lu(k,1266) * lu(k,2395) + lu(k,1269) = 1._r8 / lu(k,1269) + lu(k,1270) = lu(k,1270) * lu(k,1269) + lu(k,1271) = lu(k,1271) * lu(k,1269) + lu(k,1272) = lu(k,1272) * lu(k,1269) + lu(k,1273) = lu(k,1273) * lu(k,1269) + lu(k,1274) = lu(k,1274) * lu(k,1269) + lu(k,1275) = lu(k,1275) * lu(k,1269) + lu(k,1276) = lu(k,1276) * lu(k,1269) + lu(k,1277) = lu(k,1277) * lu(k,1269) + lu(k,1278) = lu(k,1278) * lu(k,1269) + lu(k,1279) = lu(k,1279) * lu(k,1269) + lu(k,1298) = lu(k,1298) - lu(k,1270) * lu(k,1297) + lu(k,1300) = - lu(k,1271) * lu(k,1297) + lu(k,1302) = - lu(k,1272) * lu(k,1297) + lu(k,1303) = lu(k,1303) - lu(k,1273) * lu(k,1297) + lu(k,1304) = lu(k,1304) - lu(k,1274) * lu(k,1297) + lu(k,1306) = lu(k,1306) - lu(k,1275) * lu(k,1297) + lu(k,1309) = lu(k,1309) - lu(k,1276) * lu(k,1297) + lu(k,1311) = - lu(k,1277) * lu(k,1297) + lu(k,1312) = lu(k,1312) - lu(k,1278) * lu(k,1297) + lu(k,1314) = lu(k,1314) - lu(k,1279) * lu(k,1297) + lu(k,1331) = lu(k,1331) - lu(k,1270) * lu(k,1330) + lu(k,1333) = - lu(k,1271) * lu(k,1330) + lu(k,1335) = - lu(k,1272) * lu(k,1330) + lu(k,1336) = lu(k,1336) - lu(k,1273) * lu(k,1330) + lu(k,1337) = lu(k,1337) - lu(k,1274) * lu(k,1330) + lu(k,1339) = lu(k,1339) - lu(k,1275) * lu(k,1330) + lu(k,1342) = lu(k,1342) - lu(k,1276) * lu(k,1330) + lu(k,1344) = - lu(k,1277) * lu(k,1330) + lu(k,1345) = lu(k,1345) - lu(k,1278) * lu(k,1330) + lu(k,1347) = lu(k,1347) - lu(k,1279) * lu(k,1330) + lu(k,1422) = lu(k,1422) - lu(k,1270) * lu(k,1421) + lu(k,1425) = lu(k,1425) - lu(k,1271) * lu(k,1421) + lu(k,1427) = lu(k,1427) - lu(k,1272) * lu(k,1421) + lu(k,1428) = lu(k,1428) - lu(k,1273) * lu(k,1421) + lu(k,1429) = lu(k,1429) - lu(k,1274) * lu(k,1421) + lu(k,1432) = lu(k,1432) - lu(k,1275) * lu(k,1421) + lu(k,1435) = lu(k,1435) - lu(k,1276) * lu(k,1421) + lu(k,1437) = lu(k,1437) - lu(k,1277) * lu(k,1421) + lu(k,1439) = lu(k,1439) - lu(k,1278) * lu(k,1421) + lu(k,1441) = lu(k,1441) - lu(k,1279) * lu(k,1421) + lu(k,1639) = lu(k,1639) - lu(k,1270) * lu(k,1638) + lu(k,1642) = lu(k,1642) - lu(k,1271) * lu(k,1638) + lu(k,1644) = lu(k,1644) - lu(k,1272) * lu(k,1638) + lu(k,1645) = lu(k,1645) - lu(k,1273) * lu(k,1638) + lu(k,1646) = lu(k,1646) - lu(k,1274) * lu(k,1638) + lu(k,1653) = lu(k,1653) - lu(k,1275) * lu(k,1638) + lu(k,1656) = lu(k,1656) - lu(k,1276) * lu(k,1638) + lu(k,1662) = lu(k,1662) - lu(k,1277) * lu(k,1638) + lu(k,1664) = lu(k,1664) - lu(k,1278) * lu(k,1638) + lu(k,1666) = lu(k,1666) - lu(k,1279) * lu(k,1638) + lu(k,1802) = lu(k,1802) - lu(k,1270) * lu(k,1801) + lu(k,1805) = lu(k,1805) - lu(k,1271) * lu(k,1801) + lu(k,1807) = lu(k,1807) - lu(k,1272) * lu(k,1801) + lu(k,1808) = lu(k,1808) - lu(k,1273) * lu(k,1801) + lu(k,1809) = lu(k,1809) - lu(k,1274) * lu(k,1801) + lu(k,1818) = lu(k,1818) - lu(k,1275) * lu(k,1801) + lu(k,1821) = lu(k,1821) - lu(k,1276) * lu(k,1801) + lu(k,1827) = lu(k,1827) - lu(k,1277) * lu(k,1801) + lu(k,1829) = lu(k,1829) - lu(k,1278) * lu(k,1801) + lu(k,1831) = lu(k,1831) - lu(k,1279) * lu(k,1801) + lu(k,1900) = lu(k,1900) - lu(k,1270) * lu(k,1899) + lu(k,1903) = lu(k,1903) - lu(k,1271) * lu(k,1899) + lu(k,1905) = lu(k,1905) - lu(k,1272) * lu(k,1899) + lu(k,1906) = lu(k,1906) - lu(k,1273) * lu(k,1899) + lu(k,1907) = lu(k,1907) - lu(k,1274) * lu(k,1899) + lu(k,1913) = lu(k,1913) - lu(k,1275) * lu(k,1899) + lu(k,1916) = lu(k,1916) - lu(k,1276) * lu(k,1899) + lu(k,1922) = lu(k,1922) - lu(k,1277) * lu(k,1899) + lu(k,1924) = lu(k,1924) - lu(k,1278) * lu(k,1899) + lu(k,1926) = lu(k,1926) - lu(k,1279) * lu(k,1899) + lu(k,2210) = lu(k,2210) - lu(k,1270) * lu(k,2209) + lu(k,2213) = - lu(k,1271) * lu(k,2209) + lu(k,2215) = - lu(k,1272) * lu(k,2209) + lu(k,2216) = lu(k,2216) - lu(k,1273) * lu(k,2209) + lu(k,2217) = lu(k,2217) - lu(k,1274) * lu(k,2209) + lu(k,2224) = lu(k,2224) - lu(k,1275) * lu(k,2209) + lu(k,2227) = lu(k,2227) - lu(k,1276) * lu(k,2209) + lu(k,2233) = lu(k,2233) - lu(k,1277) * lu(k,2209) + lu(k,2235) = lu(k,2235) - lu(k,1278) * lu(k,2209) + lu(k,2237) = lu(k,2237) - lu(k,1279) * lu(k,2209) + lu(k,2342) = lu(k,2342) - lu(k,1270) * lu(k,2341) + lu(k,2345) = lu(k,2345) - lu(k,1271) * lu(k,2341) + lu(k,2347) = lu(k,2347) - lu(k,1272) * lu(k,2341) + lu(k,2348) = lu(k,2348) - lu(k,1273) * lu(k,2341) + lu(k,2349) = lu(k,2349) - lu(k,1274) * lu(k,2341) + lu(k,2357) = lu(k,2357) - lu(k,1275) * lu(k,2341) + lu(k,2360) = lu(k,2360) - lu(k,1276) * lu(k,2341) + lu(k,2366) = lu(k,2366) - lu(k,1277) * lu(k,2341) + lu(k,2368) = lu(k,2368) - lu(k,1278) * lu(k,2341) + lu(k,2370) = lu(k,2370) - lu(k,1279) * lu(k,2341) + lu(k,2397) = lu(k,2397) - lu(k,1270) * lu(k,2396) + lu(k,2400) = lu(k,2400) - lu(k,1271) * lu(k,2396) + lu(k,2402) = lu(k,2402) - lu(k,1272) * lu(k,2396) + lu(k,2403) = lu(k,2403) - lu(k,1273) * lu(k,2396) + lu(k,2404) = lu(k,2404) - lu(k,1274) * lu(k,2396) + lu(k,2409) = lu(k,2409) - lu(k,1275) * lu(k,2396) + lu(k,2412) = lu(k,2412) - lu(k,1276) * lu(k,2396) + lu(k,2418) = - lu(k,1277) * lu(k,2396) + lu(k,2420) = lu(k,2420) - lu(k,1278) * lu(k,2396) + lu(k,2422) = lu(k,2422) - lu(k,1279) * lu(k,2396) + end do + end subroutine lu_fac25 + subroutine lu_fac26( 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,1281) = 1._r8 / lu(k,1281) + lu(k,1282) = lu(k,1282) * lu(k,1281) + lu(k,1283) = lu(k,1283) * lu(k,1281) + lu(k,1284) = lu(k,1284) * lu(k,1281) + lu(k,1285) = lu(k,1285) * lu(k,1281) + lu(k,1286) = lu(k,1286) * lu(k,1281) + lu(k,1287) = lu(k,1287) * lu(k,1281) + lu(k,1288) = lu(k,1288) * lu(k,1281) + lu(k,1303) = lu(k,1303) - lu(k,1282) * lu(k,1298) + lu(k,1304) = lu(k,1304) - lu(k,1283) * lu(k,1298) + lu(k,1305) = lu(k,1305) - lu(k,1284) * lu(k,1298) + lu(k,1306) = lu(k,1306) - lu(k,1285) * lu(k,1298) + lu(k,1310) = lu(k,1310) - lu(k,1286) * lu(k,1298) + lu(k,1312) = lu(k,1312) - lu(k,1287) * lu(k,1298) + lu(k,1314) = lu(k,1314) - lu(k,1288) * lu(k,1298) + lu(k,1336) = lu(k,1336) - lu(k,1282) * lu(k,1331) + lu(k,1337) = lu(k,1337) - lu(k,1283) * lu(k,1331) + lu(k,1338) = lu(k,1338) - lu(k,1284) * lu(k,1331) + lu(k,1339) = lu(k,1339) - lu(k,1285) * lu(k,1331) + lu(k,1343) = lu(k,1343) - lu(k,1286) * lu(k,1331) + lu(k,1345) = lu(k,1345) - lu(k,1287) * lu(k,1331) + lu(k,1347) = lu(k,1347) - lu(k,1288) * lu(k,1331) + lu(k,1358) = lu(k,1358) - lu(k,1282) * lu(k,1355) + lu(k,1359) = lu(k,1359) - lu(k,1283) * lu(k,1355) + lu(k,1360) = lu(k,1360) - lu(k,1284) * lu(k,1355) + lu(k,1361) = lu(k,1361) - lu(k,1285) * lu(k,1355) + lu(k,1365) = lu(k,1365) - lu(k,1286) * lu(k,1355) + lu(k,1366) = lu(k,1366) - lu(k,1287) * lu(k,1355) + lu(k,1368) = lu(k,1368) - lu(k,1288) * lu(k,1355) + lu(k,1378) = lu(k,1378) - lu(k,1282) * lu(k,1374) + lu(k,1379) = lu(k,1379) - lu(k,1283) * lu(k,1374) + lu(k,1381) = lu(k,1381) - lu(k,1284) * lu(k,1374) + lu(k,1382) = lu(k,1382) - lu(k,1285) * lu(k,1374) + lu(k,1386) = lu(k,1386) - lu(k,1286) * lu(k,1374) + lu(k,1389) = lu(k,1389) - lu(k,1287) * lu(k,1374) + lu(k,1391) = lu(k,1391) - lu(k,1288) * lu(k,1374) + lu(k,1398) = lu(k,1398) - lu(k,1282) * lu(k,1396) + lu(k,1399) = lu(k,1399) - lu(k,1283) * lu(k,1396) + lu(k,1400) = lu(k,1400) - lu(k,1284) * lu(k,1396) + lu(k,1401) = lu(k,1401) - lu(k,1285) * lu(k,1396) + lu(k,1405) = - lu(k,1286) * lu(k,1396) + lu(k,1407) = lu(k,1407) - lu(k,1287) * lu(k,1396) + lu(k,1409) = lu(k,1409) - lu(k,1288) * lu(k,1396) + lu(k,1428) = lu(k,1428) - lu(k,1282) * lu(k,1422) + lu(k,1429) = lu(k,1429) - lu(k,1283) * lu(k,1422) + lu(k,1431) = lu(k,1431) - lu(k,1284) * lu(k,1422) + lu(k,1432) = lu(k,1432) - lu(k,1285) * lu(k,1422) + lu(k,1436) = lu(k,1436) - lu(k,1286) * lu(k,1422) + lu(k,1439) = lu(k,1439) - lu(k,1287) * lu(k,1422) + lu(k,1441) = lu(k,1441) - lu(k,1288) * lu(k,1422) + lu(k,1645) = lu(k,1645) - lu(k,1282) * lu(k,1639) + lu(k,1646) = lu(k,1646) - lu(k,1283) * lu(k,1639) + lu(k,1652) = lu(k,1652) - lu(k,1284) * lu(k,1639) + lu(k,1653) = lu(k,1653) - lu(k,1285) * lu(k,1639) + lu(k,1658) = lu(k,1658) - lu(k,1286) * lu(k,1639) + lu(k,1664) = lu(k,1664) - lu(k,1287) * lu(k,1639) + lu(k,1666) = lu(k,1666) - lu(k,1288) * lu(k,1639) + lu(k,1808) = lu(k,1808) - lu(k,1282) * lu(k,1802) + lu(k,1809) = lu(k,1809) - lu(k,1283) * lu(k,1802) + lu(k,1817) = lu(k,1817) - lu(k,1284) * lu(k,1802) + lu(k,1818) = lu(k,1818) - lu(k,1285) * lu(k,1802) + lu(k,1823) = lu(k,1823) - lu(k,1286) * lu(k,1802) + lu(k,1829) = lu(k,1829) - lu(k,1287) * lu(k,1802) + lu(k,1831) = lu(k,1831) - lu(k,1288) * lu(k,1802) + lu(k,1906) = lu(k,1906) - lu(k,1282) * lu(k,1900) + lu(k,1907) = lu(k,1907) - lu(k,1283) * lu(k,1900) + lu(k,1912) = lu(k,1912) - lu(k,1284) * lu(k,1900) + lu(k,1913) = lu(k,1913) - lu(k,1285) * lu(k,1900) + lu(k,1918) = lu(k,1918) - lu(k,1286) * lu(k,1900) + lu(k,1924) = lu(k,1924) - lu(k,1287) * lu(k,1900) + lu(k,1926) = lu(k,1926) - lu(k,1288) * lu(k,1900) + lu(k,1949) = lu(k,1949) - lu(k,1282) * lu(k,1947) + lu(k,1950) = lu(k,1950) - lu(k,1283) * lu(k,1947) + lu(k,1957) = lu(k,1957) - lu(k,1284) * lu(k,1947) + lu(k,1958) = lu(k,1958) - lu(k,1285) * lu(k,1947) + lu(k,1963) = lu(k,1963) - lu(k,1286) * lu(k,1947) + lu(k,1969) = lu(k,1969) - lu(k,1287) * lu(k,1947) + lu(k,1971) = lu(k,1971) - lu(k,1288) * lu(k,1947) + lu(k,2151) = lu(k,2151) - lu(k,1282) * lu(k,2150) + lu(k,2152) = lu(k,2152) - lu(k,1283) * lu(k,2150) + lu(k,2159) = lu(k,2159) - lu(k,1284) * lu(k,2150) + lu(k,2160) = lu(k,2160) - lu(k,1285) * lu(k,2150) + lu(k,2165) = lu(k,2165) - lu(k,1286) * lu(k,2150) + lu(k,2171) = lu(k,2171) - lu(k,1287) * lu(k,2150) + lu(k,2173) = lu(k,2173) - lu(k,1288) * lu(k,2150) + lu(k,2216) = lu(k,2216) - lu(k,1282) * lu(k,2210) + lu(k,2217) = lu(k,2217) - lu(k,1283) * lu(k,2210) + lu(k,2223) = lu(k,2223) - lu(k,1284) * lu(k,2210) + lu(k,2224) = lu(k,2224) - lu(k,1285) * lu(k,2210) + lu(k,2229) = lu(k,2229) - lu(k,1286) * lu(k,2210) + lu(k,2235) = lu(k,2235) - lu(k,1287) * lu(k,2210) + lu(k,2237) = lu(k,2237) - lu(k,1288) * lu(k,2210) + lu(k,2348) = lu(k,2348) - lu(k,1282) * lu(k,2342) + lu(k,2349) = lu(k,2349) - lu(k,1283) * lu(k,2342) + lu(k,2356) = lu(k,2356) - lu(k,1284) * lu(k,2342) + lu(k,2357) = lu(k,2357) - lu(k,1285) * lu(k,2342) + lu(k,2362) = lu(k,2362) - lu(k,1286) * lu(k,2342) + lu(k,2368) = lu(k,2368) - lu(k,1287) * lu(k,2342) + lu(k,2370) = lu(k,2370) - lu(k,1288) * lu(k,2342) + lu(k,2403) = lu(k,2403) - lu(k,1282) * lu(k,2397) + lu(k,2404) = lu(k,2404) - lu(k,1283) * lu(k,2397) + lu(k,2408) = lu(k,2408) - lu(k,1284) * lu(k,2397) + lu(k,2409) = lu(k,2409) - lu(k,1285) * lu(k,2397) + lu(k,2414) = lu(k,2414) - lu(k,1286) * lu(k,2397) + lu(k,2420) = lu(k,2420) - lu(k,1287) * lu(k,2397) + lu(k,2422) = lu(k,2422) - lu(k,1288) * lu(k,2397) + lu(k,1299) = 1._r8 / lu(k,1299) + lu(k,1300) = lu(k,1300) * lu(k,1299) + lu(k,1301) = lu(k,1301) * lu(k,1299) + lu(k,1302) = lu(k,1302) * lu(k,1299) + lu(k,1303) = lu(k,1303) * lu(k,1299) + lu(k,1304) = lu(k,1304) * lu(k,1299) + lu(k,1305) = lu(k,1305) * lu(k,1299) + lu(k,1306) = lu(k,1306) * lu(k,1299) + lu(k,1307) = lu(k,1307) * lu(k,1299) + lu(k,1308) = lu(k,1308) * lu(k,1299) + lu(k,1309) = lu(k,1309) * lu(k,1299) + lu(k,1310) = lu(k,1310) * lu(k,1299) + lu(k,1311) = lu(k,1311) * lu(k,1299) + lu(k,1312) = lu(k,1312) * lu(k,1299) + lu(k,1313) = lu(k,1313) * lu(k,1299) + lu(k,1314) = lu(k,1314) * lu(k,1299) + lu(k,1425) = lu(k,1425) - lu(k,1300) * lu(k,1423) + lu(k,1426) = lu(k,1426) - lu(k,1301) * lu(k,1423) + lu(k,1427) = lu(k,1427) - lu(k,1302) * lu(k,1423) + lu(k,1428) = lu(k,1428) - lu(k,1303) * lu(k,1423) + lu(k,1429) = lu(k,1429) - lu(k,1304) * lu(k,1423) + lu(k,1431) = lu(k,1431) - lu(k,1305) * lu(k,1423) + lu(k,1432) = lu(k,1432) - lu(k,1306) * lu(k,1423) + lu(k,1433) = lu(k,1433) - lu(k,1307) * lu(k,1423) + lu(k,1434) = lu(k,1434) - lu(k,1308) * lu(k,1423) + lu(k,1435) = lu(k,1435) - lu(k,1309) * lu(k,1423) + lu(k,1436) = lu(k,1436) - lu(k,1310) * lu(k,1423) + lu(k,1437) = lu(k,1437) - lu(k,1311) * lu(k,1423) + lu(k,1439) = lu(k,1439) - lu(k,1312) * lu(k,1423) + lu(k,1440) = lu(k,1440) - lu(k,1313) * lu(k,1423) + lu(k,1441) = lu(k,1441) - lu(k,1314) * lu(k,1423) + lu(k,1642) = lu(k,1642) - lu(k,1300) * lu(k,1640) + lu(k,1643) = lu(k,1643) - lu(k,1301) * lu(k,1640) + lu(k,1644) = lu(k,1644) - lu(k,1302) * lu(k,1640) + lu(k,1645) = lu(k,1645) - lu(k,1303) * lu(k,1640) + lu(k,1646) = lu(k,1646) - lu(k,1304) * lu(k,1640) + lu(k,1652) = lu(k,1652) - lu(k,1305) * lu(k,1640) + lu(k,1653) = lu(k,1653) - lu(k,1306) * lu(k,1640) + lu(k,1654) = lu(k,1654) - lu(k,1307) * lu(k,1640) + lu(k,1655) = lu(k,1655) - lu(k,1308) * lu(k,1640) + lu(k,1656) = lu(k,1656) - lu(k,1309) * lu(k,1640) + lu(k,1658) = lu(k,1658) - lu(k,1310) * lu(k,1640) + lu(k,1662) = lu(k,1662) - lu(k,1311) * lu(k,1640) + lu(k,1664) = lu(k,1664) - lu(k,1312) * lu(k,1640) + lu(k,1665) = lu(k,1665) - lu(k,1313) * lu(k,1640) + lu(k,1666) = lu(k,1666) - lu(k,1314) * lu(k,1640) + lu(k,1805) = lu(k,1805) - lu(k,1300) * lu(k,1803) + lu(k,1806) = lu(k,1806) - lu(k,1301) * lu(k,1803) + lu(k,1807) = lu(k,1807) - lu(k,1302) * lu(k,1803) + lu(k,1808) = lu(k,1808) - lu(k,1303) * lu(k,1803) + lu(k,1809) = lu(k,1809) - lu(k,1304) * lu(k,1803) + lu(k,1817) = lu(k,1817) - lu(k,1305) * lu(k,1803) + lu(k,1818) = lu(k,1818) - lu(k,1306) * lu(k,1803) + lu(k,1819) = lu(k,1819) - lu(k,1307) * lu(k,1803) + lu(k,1820) = lu(k,1820) - lu(k,1308) * lu(k,1803) + lu(k,1821) = lu(k,1821) - lu(k,1309) * lu(k,1803) + lu(k,1823) = lu(k,1823) - lu(k,1310) * lu(k,1803) + lu(k,1827) = lu(k,1827) - lu(k,1311) * lu(k,1803) + lu(k,1829) = lu(k,1829) - lu(k,1312) * lu(k,1803) + lu(k,1830) = lu(k,1830) - lu(k,1313) * lu(k,1803) + lu(k,1831) = lu(k,1831) - lu(k,1314) * lu(k,1803) + lu(k,1903) = lu(k,1903) - lu(k,1300) * lu(k,1901) + lu(k,1904) = lu(k,1904) - lu(k,1301) * lu(k,1901) + lu(k,1905) = lu(k,1905) - lu(k,1302) * lu(k,1901) + lu(k,1906) = lu(k,1906) - lu(k,1303) * lu(k,1901) + lu(k,1907) = lu(k,1907) - lu(k,1304) * lu(k,1901) + lu(k,1912) = lu(k,1912) - lu(k,1305) * lu(k,1901) + lu(k,1913) = lu(k,1913) - lu(k,1306) * lu(k,1901) + lu(k,1914) = lu(k,1914) - lu(k,1307) * lu(k,1901) + lu(k,1915) = lu(k,1915) - lu(k,1308) * lu(k,1901) + lu(k,1916) = lu(k,1916) - lu(k,1309) * lu(k,1901) + lu(k,1918) = lu(k,1918) - lu(k,1310) * lu(k,1901) + lu(k,1922) = lu(k,1922) - lu(k,1311) * lu(k,1901) + lu(k,1924) = lu(k,1924) - lu(k,1312) * lu(k,1901) + lu(k,1925) = lu(k,1925) - lu(k,1313) * lu(k,1901) + lu(k,1926) = lu(k,1926) - lu(k,1314) * lu(k,1901) + lu(k,2213) = lu(k,2213) - lu(k,1300) * lu(k,2211) + lu(k,2214) = lu(k,2214) - lu(k,1301) * lu(k,2211) + lu(k,2215) = lu(k,2215) - lu(k,1302) * lu(k,2211) + lu(k,2216) = lu(k,2216) - lu(k,1303) * lu(k,2211) + lu(k,2217) = lu(k,2217) - lu(k,1304) * lu(k,2211) + lu(k,2223) = lu(k,2223) - lu(k,1305) * lu(k,2211) + lu(k,2224) = lu(k,2224) - lu(k,1306) * lu(k,2211) + lu(k,2225) = lu(k,2225) - lu(k,1307) * lu(k,2211) + lu(k,2226) = lu(k,2226) - lu(k,1308) * lu(k,2211) + lu(k,2227) = lu(k,2227) - lu(k,1309) * lu(k,2211) + lu(k,2229) = lu(k,2229) - lu(k,1310) * lu(k,2211) + lu(k,2233) = lu(k,2233) - lu(k,1311) * lu(k,2211) + lu(k,2235) = lu(k,2235) - lu(k,1312) * lu(k,2211) + lu(k,2236) = lu(k,2236) - lu(k,1313) * lu(k,2211) + lu(k,2237) = lu(k,2237) - lu(k,1314) * lu(k,2211) + lu(k,2345) = lu(k,2345) - lu(k,1300) * lu(k,2343) + lu(k,2346) = lu(k,2346) - lu(k,1301) * lu(k,2343) + lu(k,2347) = lu(k,2347) - lu(k,1302) * lu(k,2343) + lu(k,2348) = lu(k,2348) - lu(k,1303) * lu(k,2343) + lu(k,2349) = lu(k,2349) - lu(k,1304) * lu(k,2343) + lu(k,2356) = lu(k,2356) - lu(k,1305) * lu(k,2343) + lu(k,2357) = lu(k,2357) - lu(k,1306) * lu(k,2343) + lu(k,2358) = lu(k,2358) - lu(k,1307) * lu(k,2343) + lu(k,2359) = lu(k,2359) - lu(k,1308) * lu(k,2343) + lu(k,2360) = lu(k,2360) - lu(k,1309) * lu(k,2343) + lu(k,2362) = lu(k,2362) - lu(k,1310) * lu(k,2343) + lu(k,2366) = lu(k,2366) - lu(k,1311) * lu(k,2343) + lu(k,2368) = lu(k,2368) - lu(k,1312) * lu(k,2343) + lu(k,2369) = lu(k,2369) - lu(k,1313) * lu(k,2343) + lu(k,2370) = lu(k,2370) - lu(k,1314) * lu(k,2343) + lu(k,2400) = lu(k,2400) - lu(k,1300) * lu(k,2398) + lu(k,2401) = lu(k,2401) - lu(k,1301) * lu(k,2398) + lu(k,2402) = lu(k,2402) - lu(k,1302) * lu(k,2398) + lu(k,2403) = lu(k,2403) - lu(k,1303) * lu(k,2398) + lu(k,2404) = lu(k,2404) - lu(k,1304) * lu(k,2398) + lu(k,2408) = lu(k,2408) - lu(k,1305) * lu(k,2398) + lu(k,2409) = lu(k,2409) - lu(k,1306) * lu(k,2398) + lu(k,2410) = lu(k,2410) - lu(k,1307) * lu(k,2398) + lu(k,2411) = lu(k,2411) - lu(k,1308) * lu(k,2398) + lu(k,2412) = lu(k,2412) - lu(k,1309) * lu(k,2398) + lu(k,2414) = lu(k,2414) - lu(k,1310) * lu(k,2398) + lu(k,2418) = lu(k,2418) - lu(k,1311) * lu(k,2398) + lu(k,2420) = lu(k,2420) - lu(k,1312) * lu(k,2398) + lu(k,2421) = lu(k,2421) - lu(k,1313) * lu(k,2398) + lu(k,2422) = lu(k,2422) - lu(k,1314) * lu(k,2398) + lu(k,1332) = 1._r8 / lu(k,1332) + lu(k,1333) = lu(k,1333) * lu(k,1332) + lu(k,1334) = lu(k,1334) * lu(k,1332) + lu(k,1335) = lu(k,1335) * lu(k,1332) + lu(k,1336) = lu(k,1336) * lu(k,1332) + lu(k,1337) = lu(k,1337) * lu(k,1332) + lu(k,1338) = lu(k,1338) * lu(k,1332) + lu(k,1339) = lu(k,1339) * lu(k,1332) + lu(k,1340) = lu(k,1340) * lu(k,1332) + lu(k,1341) = lu(k,1341) * lu(k,1332) + lu(k,1342) = lu(k,1342) * lu(k,1332) + lu(k,1343) = lu(k,1343) * lu(k,1332) + lu(k,1344) = lu(k,1344) * lu(k,1332) + lu(k,1345) = lu(k,1345) * lu(k,1332) + lu(k,1346) = lu(k,1346) * lu(k,1332) + lu(k,1347) = lu(k,1347) * lu(k,1332) + lu(k,1425) = lu(k,1425) - lu(k,1333) * lu(k,1424) + lu(k,1426) = lu(k,1426) - lu(k,1334) * lu(k,1424) + lu(k,1427) = lu(k,1427) - lu(k,1335) * lu(k,1424) + lu(k,1428) = lu(k,1428) - lu(k,1336) * lu(k,1424) + lu(k,1429) = lu(k,1429) - lu(k,1337) * lu(k,1424) + lu(k,1431) = lu(k,1431) - lu(k,1338) * lu(k,1424) + lu(k,1432) = lu(k,1432) - lu(k,1339) * lu(k,1424) + lu(k,1433) = lu(k,1433) - lu(k,1340) * lu(k,1424) + lu(k,1434) = lu(k,1434) - lu(k,1341) * lu(k,1424) + lu(k,1435) = lu(k,1435) - lu(k,1342) * lu(k,1424) + lu(k,1436) = lu(k,1436) - lu(k,1343) * lu(k,1424) + lu(k,1437) = lu(k,1437) - lu(k,1344) * lu(k,1424) + lu(k,1439) = lu(k,1439) - lu(k,1345) * lu(k,1424) + lu(k,1440) = lu(k,1440) - lu(k,1346) * lu(k,1424) + lu(k,1441) = lu(k,1441) - lu(k,1347) * lu(k,1424) + lu(k,1642) = lu(k,1642) - lu(k,1333) * lu(k,1641) + lu(k,1643) = lu(k,1643) - lu(k,1334) * lu(k,1641) + lu(k,1644) = lu(k,1644) - lu(k,1335) * lu(k,1641) + lu(k,1645) = lu(k,1645) - lu(k,1336) * lu(k,1641) + lu(k,1646) = lu(k,1646) - lu(k,1337) * lu(k,1641) + lu(k,1652) = lu(k,1652) - lu(k,1338) * lu(k,1641) + lu(k,1653) = lu(k,1653) - lu(k,1339) * lu(k,1641) + lu(k,1654) = lu(k,1654) - lu(k,1340) * lu(k,1641) + lu(k,1655) = lu(k,1655) - lu(k,1341) * lu(k,1641) + lu(k,1656) = lu(k,1656) - lu(k,1342) * lu(k,1641) + lu(k,1658) = lu(k,1658) - lu(k,1343) * lu(k,1641) + lu(k,1662) = lu(k,1662) - lu(k,1344) * lu(k,1641) + lu(k,1664) = lu(k,1664) - lu(k,1345) * lu(k,1641) + lu(k,1665) = lu(k,1665) - lu(k,1346) * lu(k,1641) + lu(k,1666) = lu(k,1666) - lu(k,1347) * lu(k,1641) + lu(k,1805) = lu(k,1805) - lu(k,1333) * lu(k,1804) + lu(k,1806) = lu(k,1806) - lu(k,1334) * lu(k,1804) + lu(k,1807) = lu(k,1807) - lu(k,1335) * lu(k,1804) + lu(k,1808) = lu(k,1808) - lu(k,1336) * lu(k,1804) + lu(k,1809) = lu(k,1809) - lu(k,1337) * lu(k,1804) + lu(k,1817) = lu(k,1817) - lu(k,1338) * lu(k,1804) + lu(k,1818) = lu(k,1818) - lu(k,1339) * lu(k,1804) + lu(k,1819) = lu(k,1819) - lu(k,1340) * lu(k,1804) + lu(k,1820) = lu(k,1820) - lu(k,1341) * lu(k,1804) + lu(k,1821) = lu(k,1821) - lu(k,1342) * lu(k,1804) + lu(k,1823) = lu(k,1823) - lu(k,1343) * lu(k,1804) + lu(k,1827) = lu(k,1827) - lu(k,1344) * lu(k,1804) + lu(k,1829) = lu(k,1829) - lu(k,1345) * lu(k,1804) + lu(k,1830) = lu(k,1830) - lu(k,1346) * lu(k,1804) + lu(k,1831) = lu(k,1831) - lu(k,1347) * lu(k,1804) + lu(k,1903) = lu(k,1903) - lu(k,1333) * lu(k,1902) + lu(k,1904) = lu(k,1904) - lu(k,1334) * lu(k,1902) + lu(k,1905) = lu(k,1905) - lu(k,1335) * lu(k,1902) + lu(k,1906) = lu(k,1906) - lu(k,1336) * lu(k,1902) + lu(k,1907) = lu(k,1907) - lu(k,1337) * lu(k,1902) + lu(k,1912) = lu(k,1912) - lu(k,1338) * lu(k,1902) + lu(k,1913) = lu(k,1913) - lu(k,1339) * lu(k,1902) + lu(k,1914) = lu(k,1914) - lu(k,1340) * lu(k,1902) + lu(k,1915) = lu(k,1915) - lu(k,1341) * lu(k,1902) + lu(k,1916) = lu(k,1916) - lu(k,1342) * lu(k,1902) + lu(k,1918) = lu(k,1918) - lu(k,1343) * lu(k,1902) + lu(k,1922) = lu(k,1922) - lu(k,1344) * lu(k,1902) + lu(k,1924) = lu(k,1924) - lu(k,1345) * lu(k,1902) + lu(k,1925) = lu(k,1925) - lu(k,1346) * lu(k,1902) + lu(k,1926) = lu(k,1926) - lu(k,1347) * lu(k,1902) + lu(k,2213) = lu(k,2213) - lu(k,1333) * lu(k,2212) + lu(k,2214) = lu(k,2214) - lu(k,1334) * lu(k,2212) + lu(k,2215) = lu(k,2215) - lu(k,1335) * lu(k,2212) + lu(k,2216) = lu(k,2216) - lu(k,1336) * lu(k,2212) + lu(k,2217) = lu(k,2217) - lu(k,1337) * lu(k,2212) + lu(k,2223) = lu(k,2223) - lu(k,1338) * lu(k,2212) + lu(k,2224) = lu(k,2224) - lu(k,1339) * lu(k,2212) + lu(k,2225) = lu(k,2225) - lu(k,1340) * lu(k,2212) + lu(k,2226) = lu(k,2226) - lu(k,1341) * lu(k,2212) + lu(k,2227) = lu(k,2227) - lu(k,1342) * lu(k,2212) + lu(k,2229) = lu(k,2229) - lu(k,1343) * lu(k,2212) + lu(k,2233) = lu(k,2233) - lu(k,1344) * lu(k,2212) + lu(k,2235) = lu(k,2235) - lu(k,1345) * lu(k,2212) + lu(k,2236) = lu(k,2236) - lu(k,1346) * lu(k,2212) + lu(k,2237) = lu(k,2237) - lu(k,1347) * lu(k,2212) + lu(k,2345) = lu(k,2345) - lu(k,1333) * lu(k,2344) + lu(k,2346) = lu(k,2346) - lu(k,1334) * lu(k,2344) + lu(k,2347) = lu(k,2347) - lu(k,1335) * lu(k,2344) + lu(k,2348) = lu(k,2348) - lu(k,1336) * lu(k,2344) + lu(k,2349) = lu(k,2349) - lu(k,1337) * lu(k,2344) + lu(k,2356) = lu(k,2356) - lu(k,1338) * lu(k,2344) + lu(k,2357) = lu(k,2357) - lu(k,1339) * lu(k,2344) + lu(k,2358) = lu(k,2358) - lu(k,1340) * lu(k,2344) + lu(k,2359) = lu(k,2359) - lu(k,1341) * lu(k,2344) + lu(k,2360) = lu(k,2360) - lu(k,1342) * lu(k,2344) + lu(k,2362) = lu(k,2362) - lu(k,1343) * lu(k,2344) + lu(k,2366) = lu(k,2366) - lu(k,1344) * lu(k,2344) + lu(k,2368) = lu(k,2368) - lu(k,1345) * lu(k,2344) + lu(k,2369) = lu(k,2369) - lu(k,1346) * lu(k,2344) + lu(k,2370) = lu(k,2370) - lu(k,1347) * lu(k,2344) + lu(k,2400) = lu(k,2400) - lu(k,1333) * lu(k,2399) + lu(k,2401) = lu(k,2401) - lu(k,1334) * lu(k,2399) + lu(k,2402) = lu(k,2402) - lu(k,1335) * lu(k,2399) + lu(k,2403) = lu(k,2403) - lu(k,1336) * lu(k,2399) + lu(k,2404) = lu(k,2404) - lu(k,1337) * lu(k,2399) + lu(k,2408) = lu(k,2408) - lu(k,1338) * lu(k,2399) + lu(k,2409) = lu(k,2409) - lu(k,1339) * lu(k,2399) + lu(k,2410) = lu(k,2410) - lu(k,1340) * lu(k,2399) + lu(k,2411) = lu(k,2411) - lu(k,1341) * lu(k,2399) + lu(k,2412) = lu(k,2412) - lu(k,1342) * lu(k,2399) + lu(k,2414) = lu(k,2414) - lu(k,1343) * lu(k,2399) + lu(k,2418) = lu(k,2418) - lu(k,1344) * lu(k,2399) + lu(k,2420) = lu(k,2420) - lu(k,1345) * lu(k,2399) + lu(k,2421) = lu(k,2421) - lu(k,1346) * lu(k,2399) + lu(k,2422) = lu(k,2422) - lu(k,1347) * lu(k,2399) + lu(k,1356) = 1._r8 / lu(k,1356) + lu(k,1357) = lu(k,1357) * lu(k,1356) + lu(k,1358) = lu(k,1358) * lu(k,1356) + lu(k,1359) = lu(k,1359) * lu(k,1356) + lu(k,1360) = lu(k,1360) * lu(k,1356) + lu(k,1361) = lu(k,1361) * lu(k,1356) + lu(k,1362) = lu(k,1362) * lu(k,1356) + lu(k,1363) = lu(k,1363) * lu(k,1356) + lu(k,1364) = lu(k,1364) * lu(k,1356) + lu(k,1365) = lu(k,1365) * lu(k,1356) + lu(k,1366) = lu(k,1366) * lu(k,1356) + lu(k,1367) = lu(k,1367) * lu(k,1356) + lu(k,1368) = lu(k,1368) * lu(k,1356) + lu(k,1377) = - lu(k,1357) * lu(k,1375) + lu(k,1378) = lu(k,1378) - lu(k,1358) * lu(k,1375) + lu(k,1379) = lu(k,1379) - lu(k,1359) * lu(k,1375) + lu(k,1381) = lu(k,1381) - lu(k,1360) * lu(k,1375) + lu(k,1382) = lu(k,1382) - lu(k,1361) * lu(k,1375) + lu(k,1383) = lu(k,1383) - lu(k,1362) * lu(k,1375) + lu(k,1384) = lu(k,1384) - lu(k,1363) * lu(k,1375) + lu(k,1385) = lu(k,1385) - lu(k,1364) * lu(k,1375) + lu(k,1386) = lu(k,1386) - lu(k,1365) * lu(k,1375) + lu(k,1389) = lu(k,1389) - lu(k,1366) * lu(k,1375) + lu(k,1390) = lu(k,1390) - lu(k,1367) * lu(k,1375) + lu(k,1391) = lu(k,1391) - lu(k,1368) * lu(k,1375) + lu(k,1427) = lu(k,1427) - lu(k,1357) * lu(k,1425) + lu(k,1428) = lu(k,1428) - lu(k,1358) * lu(k,1425) + lu(k,1429) = lu(k,1429) - lu(k,1359) * lu(k,1425) + lu(k,1431) = lu(k,1431) - lu(k,1360) * lu(k,1425) + lu(k,1432) = lu(k,1432) - lu(k,1361) * lu(k,1425) + lu(k,1433) = lu(k,1433) - lu(k,1362) * lu(k,1425) + lu(k,1434) = lu(k,1434) - lu(k,1363) * lu(k,1425) + lu(k,1435) = lu(k,1435) - lu(k,1364) * lu(k,1425) + lu(k,1436) = lu(k,1436) - lu(k,1365) * lu(k,1425) + lu(k,1439) = lu(k,1439) - lu(k,1366) * lu(k,1425) + lu(k,1440) = lu(k,1440) - lu(k,1367) * lu(k,1425) + lu(k,1441) = lu(k,1441) - lu(k,1368) * lu(k,1425) + lu(k,1644) = lu(k,1644) - lu(k,1357) * lu(k,1642) + lu(k,1645) = lu(k,1645) - lu(k,1358) * lu(k,1642) + lu(k,1646) = lu(k,1646) - lu(k,1359) * lu(k,1642) + lu(k,1652) = lu(k,1652) - lu(k,1360) * lu(k,1642) + lu(k,1653) = lu(k,1653) - lu(k,1361) * lu(k,1642) + lu(k,1654) = lu(k,1654) - lu(k,1362) * lu(k,1642) + lu(k,1655) = lu(k,1655) - lu(k,1363) * lu(k,1642) + lu(k,1656) = lu(k,1656) - lu(k,1364) * lu(k,1642) + lu(k,1658) = lu(k,1658) - lu(k,1365) * lu(k,1642) + lu(k,1664) = lu(k,1664) - lu(k,1366) * lu(k,1642) + lu(k,1665) = lu(k,1665) - lu(k,1367) * lu(k,1642) + lu(k,1666) = lu(k,1666) - lu(k,1368) * lu(k,1642) + lu(k,1807) = lu(k,1807) - lu(k,1357) * lu(k,1805) + lu(k,1808) = lu(k,1808) - lu(k,1358) * lu(k,1805) + lu(k,1809) = lu(k,1809) - lu(k,1359) * lu(k,1805) + lu(k,1817) = lu(k,1817) - lu(k,1360) * lu(k,1805) + lu(k,1818) = lu(k,1818) - lu(k,1361) * lu(k,1805) + lu(k,1819) = lu(k,1819) - lu(k,1362) * lu(k,1805) + lu(k,1820) = lu(k,1820) - lu(k,1363) * lu(k,1805) + lu(k,1821) = lu(k,1821) - lu(k,1364) * lu(k,1805) + lu(k,1823) = lu(k,1823) - lu(k,1365) * lu(k,1805) + lu(k,1829) = lu(k,1829) - lu(k,1366) * lu(k,1805) + lu(k,1830) = lu(k,1830) - lu(k,1367) * lu(k,1805) + lu(k,1831) = lu(k,1831) - lu(k,1368) * lu(k,1805) + lu(k,1905) = lu(k,1905) - lu(k,1357) * lu(k,1903) + lu(k,1906) = lu(k,1906) - lu(k,1358) * lu(k,1903) + lu(k,1907) = lu(k,1907) - lu(k,1359) * lu(k,1903) + lu(k,1912) = lu(k,1912) - lu(k,1360) * lu(k,1903) + lu(k,1913) = lu(k,1913) - lu(k,1361) * lu(k,1903) + lu(k,1914) = lu(k,1914) - lu(k,1362) * lu(k,1903) + lu(k,1915) = lu(k,1915) - lu(k,1363) * lu(k,1903) + lu(k,1916) = lu(k,1916) - lu(k,1364) * lu(k,1903) + lu(k,1918) = lu(k,1918) - lu(k,1365) * lu(k,1903) + lu(k,1924) = lu(k,1924) - lu(k,1366) * lu(k,1903) + lu(k,1925) = lu(k,1925) - lu(k,1367) * lu(k,1903) + lu(k,1926) = lu(k,1926) - lu(k,1368) * lu(k,1903) + lu(k,2215) = lu(k,2215) - lu(k,1357) * lu(k,2213) + lu(k,2216) = lu(k,2216) - lu(k,1358) * lu(k,2213) + lu(k,2217) = lu(k,2217) - lu(k,1359) * lu(k,2213) + lu(k,2223) = lu(k,2223) - lu(k,1360) * lu(k,2213) + lu(k,2224) = lu(k,2224) - lu(k,1361) * lu(k,2213) + lu(k,2225) = lu(k,2225) - lu(k,1362) * lu(k,2213) + lu(k,2226) = lu(k,2226) - lu(k,1363) * lu(k,2213) + lu(k,2227) = lu(k,2227) - lu(k,1364) * lu(k,2213) + lu(k,2229) = lu(k,2229) - lu(k,1365) * lu(k,2213) + lu(k,2235) = lu(k,2235) - lu(k,1366) * lu(k,2213) + lu(k,2236) = lu(k,2236) - lu(k,1367) * lu(k,2213) + lu(k,2237) = lu(k,2237) - lu(k,1368) * lu(k,2213) + lu(k,2347) = lu(k,2347) - lu(k,1357) * lu(k,2345) + lu(k,2348) = lu(k,2348) - lu(k,1358) * lu(k,2345) + lu(k,2349) = lu(k,2349) - lu(k,1359) * lu(k,2345) + lu(k,2356) = lu(k,2356) - lu(k,1360) * lu(k,2345) + lu(k,2357) = lu(k,2357) - lu(k,1361) * lu(k,2345) + lu(k,2358) = lu(k,2358) - lu(k,1362) * lu(k,2345) + lu(k,2359) = lu(k,2359) - lu(k,1363) * lu(k,2345) + lu(k,2360) = lu(k,2360) - lu(k,1364) * lu(k,2345) + lu(k,2362) = lu(k,2362) - lu(k,1365) * lu(k,2345) + lu(k,2368) = lu(k,2368) - lu(k,1366) * lu(k,2345) + lu(k,2369) = lu(k,2369) - lu(k,1367) * lu(k,2345) + lu(k,2370) = lu(k,2370) - lu(k,1368) * lu(k,2345) + lu(k,2402) = lu(k,2402) - lu(k,1357) * lu(k,2400) + lu(k,2403) = lu(k,2403) - lu(k,1358) * lu(k,2400) + lu(k,2404) = lu(k,2404) - lu(k,1359) * lu(k,2400) + lu(k,2408) = lu(k,2408) - lu(k,1360) * lu(k,2400) + lu(k,2409) = lu(k,2409) - lu(k,1361) * lu(k,2400) + lu(k,2410) = lu(k,2410) - lu(k,1362) * lu(k,2400) + lu(k,2411) = lu(k,2411) - lu(k,1363) * lu(k,2400) + lu(k,2412) = lu(k,2412) - lu(k,1364) * lu(k,2400) + lu(k,2414) = lu(k,2414) - lu(k,1365) * lu(k,2400) + lu(k,2420) = lu(k,2420) - lu(k,1366) * lu(k,2400) + lu(k,2421) = lu(k,2421) - lu(k,1367) * lu(k,2400) + lu(k,2422) = lu(k,2422) - lu(k,1368) * lu(k,2400) + end do + end subroutine lu_fac26 + subroutine lu_fac27( 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,1376) = 1._r8 / lu(k,1376) + lu(k,1377) = lu(k,1377) * lu(k,1376) + lu(k,1378) = lu(k,1378) * lu(k,1376) + lu(k,1379) = lu(k,1379) * lu(k,1376) + lu(k,1380) = lu(k,1380) * lu(k,1376) + lu(k,1381) = lu(k,1381) * lu(k,1376) + lu(k,1382) = lu(k,1382) * lu(k,1376) + lu(k,1383) = lu(k,1383) * lu(k,1376) + lu(k,1384) = lu(k,1384) * lu(k,1376) + lu(k,1385) = lu(k,1385) * lu(k,1376) + lu(k,1386) = lu(k,1386) * lu(k,1376) + lu(k,1387) = lu(k,1387) * lu(k,1376) + lu(k,1388) = lu(k,1388) * lu(k,1376) + lu(k,1389) = lu(k,1389) * lu(k,1376) + lu(k,1390) = lu(k,1390) * lu(k,1376) + lu(k,1391) = lu(k,1391) * lu(k,1376) + lu(k,1427) = lu(k,1427) - lu(k,1377) * lu(k,1426) + lu(k,1428) = lu(k,1428) - lu(k,1378) * lu(k,1426) + lu(k,1429) = lu(k,1429) - lu(k,1379) * lu(k,1426) + lu(k,1430) = - lu(k,1380) * lu(k,1426) + lu(k,1431) = lu(k,1431) - lu(k,1381) * lu(k,1426) + lu(k,1432) = lu(k,1432) - lu(k,1382) * lu(k,1426) + lu(k,1433) = lu(k,1433) - lu(k,1383) * lu(k,1426) + lu(k,1434) = lu(k,1434) - lu(k,1384) * lu(k,1426) + lu(k,1435) = lu(k,1435) - lu(k,1385) * lu(k,1426) + lu(k,1436) = lu(k,1436) - lu(k,1386) * lu(k,1426) + lu(k,1437) = lu(k,1437) - lu(k,1387) * lu(k,1426) + lu(k,1438) = - lu(k,1388) * lu(k,1426) + lu(k,1439) = lu(k,1439) - lu(k,1389) * lu(k,1426) + lu(k,1440) = lu(k,1440) - lu(k,1390) * lu(k,1426) + lu(k,1441) = lu(k,1441) - lu(k,1391) * lu(k,1426) + lu(k,1644) = lu(k,1644) - lu(k,1377) * lu(k,1643) + lu(k,1645) = lu(k,1645) - lu(k,1378) * lu(k,1643) + lu(k,1646) = lu(k,1646) - lu(k,1379) * lu(k,1643) + lu(k,1649) = lu(k,1649) - lu(k,1380) * lu(k,1643) + lu(k,1652) = lu(k,1652) - lu(k,1381) * lu(k,1643) + lu(k,1653) = lu(k,1653) - lu(k,1382) * lu(k,1643) + lu(k,1654) = lu(k,1654) - lu(k,1383) * lu(k,1643) + lu(k,1655) = lu(k,1655) - lu(k,1384) * lu(k,1643) + lu(k,1656) = lu(k,1656) - lu(k,1385) * lu(k,1643) + lu(k,1658) = lu(k,1658) - lu(k,1386) * lu(k,1643) + lu(k,1662) = lu(k,1662) - lu(k,1387) * lu(k,1643) + lu(k,1663) = lu(k,1663) - lu(k,1388) * lu(k,1643) + lu(k,1664) = lu(k,1664) - lu(k,1389) * lu(k,1643) + lu(k,1665) = lu(k,1665) - lu(k,1390) * lu(k,1643) + lu(k,1666) = lu(k,1666) - lu(k,1391) * lu(k,1643) + lu(k,1807) = lu(k,1807) - lu(k,1377) * lu(k,1806) + lu(k,1808) = lu(k,1808) - lu(k,1378) * lu(k,1806) + lu(k,1809) = lu(k,1809) - lu(k,1379) * lu(k,1806) + lu(k,1814) = lu(k,1814) - lu(k,1380) * lu(k,1806) + lu(k,1817) = lu(k,1817) - lu(k,1381) * lu(k,1806) + lu(k,1818) = lu(k,1818) - lu(k,1382) * lu(k,1806) + lu(k,1819) = lu(k,1819) - lu(k,1383) * lu(k,1806) + lu(k,1820) = lu(k,1820) - lu(k,1384) * lu(k,1806) + lu(k,1821) = lu(k,1821) - lu(k,1385) * lu(k,1806) + lu(k,1823) = lu(k,1823) - lu(k,1386) * lu(k,1806) + lu(k,1827) = lu(k,1827) - lu(k,1387) * lu(k,1806) + lu(k,1828) = lu(k,1828) - lu(k,1388) * lu(k,1806) + lu(k,1829) = lu(k,1829) - lu(k,1389) * lu(k,1806) + lu(k,1830) = lu(k,1830) - lu(k,1390) * lu(k,1806) + lu(k,1831) = lu(k,1831) - lu(k,1391) * lu(k,1806) + lu(k,1905) = lu(k,1905) - lu(k,1377) * lu(k,1904) + lu(k,1906) = lu(k,1906) - lu(k,1378) * lu(k,1904) + lu(k,1907) = lu(k,1907) - lu(k,1379) * lu(k,1904) + lu(k,1909) = lu(k,1909) - lu(k,1380) * lu(k,1904) + lu(k,1912) = lu(k,1912) - lu(k,1381) * lu(k,1904) + lu(k,1913) = lu(k,1913) - lu(k,1382) * lu(k,1904) + lu(k,1914) = lu(k,1914) - lu(k,1383) * lu(k,1904) + lu(k,1915) = lu(k,1915) - lu(k,1384) * lu(k,1904) + lu(k,1916) = lu(k,1916) - lu(k,1385) * lu(k,1904) + lu(k,1918) = lu(k,1918) - lu(k,1386) * lu(k,1904) + lu(k,1922) = lu(k,1922) - lu(k,1387) * lu(k,1904) + lu(k,1923) = - lu(k,1388) * lu(k,1904) + lu(k,1924) = lu(k,1924) - lu(k,1389) * lu(k,1904) + lu(k,1925) = lu(k,1925) - lu(k,1390) * lu(k,1904) + lu(k,1926) = lu(k,1926) - lu(k,1391) * lu(k,1904) + lu(k,2215) = lu(k,2215) - lu(k,1377) * lu(k,2214) + lu(k,2216) = lu(k,2216) - lu(k,1378) * lu(k,2214) + lu(k,2217) = lu(k,2217) - lu(k,1379) * lu(k,2214) + lu(k,2220) = lu(k,2220) - lu(k,1380) * lu(k,2214) + lu(k,2223) = lu(k,2223) - lu(k,1381) * lu(k,2214) + lu(k,2224) = lu(k,2224) - lu(k,1382) * lu(k,2214) + lu(k,2225) = lu(k,2225) - lu(k,1383) * lu(k,2214) + lu(k,2226) = lu(k,2226) - lu(k,1384) * lu(k,2214) + lu(k,2227) = lu(k,2227) - lu(k,1385) * lu(k,2214) + lu(k,2229) = lu(k,2229) - lu(k,1386) * lu(k,2214) + lu(k,2233) = lu(k,2233) - lu(k,1387) * lu(k,2214) + lu(k,2234) = lu(k,2234) - lu(k,1388) * lu(k,2214) + lu(k,2235) = lu(k,2235) - lu(k,1389) * lu(k,2214) + lu(k,2236) = lu(k,2236) - lu(k,1390) * lu(k,2214) + lu(k,2237) = lu(k,2237) - lu(k,1391) * lu(k,2214) + lu(k,2347) = lu(k,2347) - lu(k,1377) * lu(k,2346) + lu(k,2348) = lu(k,2348) - lu(k,1378) * lu(k,2346) + lu(k,2349) = lu(k,2349) - lu(k,1379) * lu(k,2346) + lu(k,2353) = lu(k,2353) - lu(k,1380) * lu(k,2346) + lu(k,2356) = lu(k,2356) - lu(k,1381) * lu(k,2346) + lu(k,2357) = lu(k,2357) - lu(k,1382) * lu(k,2346) + lu(k,2358) = lu(k,2358) - lu(k,1383) * lu(k,2346) + lu(k,2359) = lu(k,2359) - lu(k,1384) * lu(k,2346) + lu(k,2360) = lu(k,2360) - lu(k,1385) * lu(k,2346) + lu(k,2362) = lu(k,2362) - lu(k,1386) * lu(k,2346) + lu(k,2366) = lu(k,2366) - lu(k,1387) * lu(k,2346) + lu(k,2367) = - lu(k,1388) * lu(k,2346) + lu(k,2368) = lu(k,2368) - lu(k,1389) * lu(k,2346) + lu(k,2369) = lu(k,2369) - lu(k,1390) * lu(k,2346) + lu(k,2370) = lu(k,2370) - lu(k,1391) * lu(k,2346) + lu(k,2402) = lu(k,2402) - lu(k,1377) * lu(k,2401) + lu(k,2403) = lu(k,2403) - lu(k,1378) * lu(k,2401) + lu(k,2404) = lu(k,2404) - lu(k,1379) * lu(k,2401) + lu(k,2405) = lu(k,2405) - lu(k,1380) * lu(k,2401) + lu(k,2408) = lu(k,2408) - lu(k,1381) * lu(k,2401) + lu(k,2409) = lu(k,2409) - lu(k,1382) * lu(k,2401) + lu(k,2410) = lu(k,2410) - lu(k,1383) * lu(k,2401) + lu(k,2411) = lu(k,2411) - lu(k,1384) * lu(k,2401) + lu(k,2412) = lu(k,2412) - lu(k,1385) * lu(k,2401) + lu(k,2414) = lu(k,2414) - lu(k,1386) * lu(k,2401) + lu(k,2418) = lu(k,2418) - lu(k,1387) * lu(k,2401) + lu(k,2419) = - lu(k,1388) * lu(k,2401) + lu(k,2420) = lu(k,2420) - lu(k,1389) * lu(k,2401) + lu(k,2421) = lu(k,2421) - lu(k,1390) * lu(k,2401) + lu(k,2422) = lu(k,2422) - lu(k,1391) * lu(k,2401) + lu(k,1397) = 1._r8 / lu(k,1397) + lu(k,1398) = lu(k,1398) * lu(k,1397) + lu(k,1399) = lu(k,1399) * lu(k,1397) + lu(k,1400) = lu(k,1400) * lu(k,1397) + lu(k,1401) = lu(k,1401) * lu(k,1397) + lu(k,1402) = lu(k,1402) * lu(k,1397) + lu(k,1403) = lu(k,1403) * lu(k,1397) + lu(k,1404) = lu(k,1404) * lu(k,1397) + lu(k,1405) = lu(k,1405) * lu(k,1397) + lu(k,1406) = lu(k,1406) * lu(k,1397) + lu(k,1407) = lu(k,1407) * lu(k,1397) + lu(k,1408) = lu(k,1408) * lu(k,1397) + lu(k,1409) = lu(k,1409) * lu(k,1397) + lu(k,1428) = lu(k,1428) - lu(k,1398) * lu(k,1427) + lu(k,1429) = lu(k,1429) - lu(k,1399) * lu(k,1427) + lu(k,1431) = lu(k,1431) - lu(k,1400) * lu(k,1427) + lu(k,1432) = lu(k,1432) - lu(k,1401) * lu(k,1427) + lu(k,1433) = lu(k,1433) - lu(k,1402) * lu(k,1427) + lu(k,1434) = lu(k,1434) - lu(k,1403) * lu(k,1427) + lu(k,1435) = lu(k,1435) - lu(k,1404) * lu(k,1427) + lu(k,1436) = lu(k,1436) - lu(k,1405) * lu(k,1427) + lu(k,1437) = lu(k,1437) - lu(k,1406) * lu(k,1427) + lu(k,1439) = lu(k,1439) - lu(k,1407) * lu(k,1427) + lu(k,1440) = lu(k,1440) - lu(k,1408) * lu(k,1427) + lu(k,1441) = lu(k,1441) - lu(k,1409) * lu(k,1427) + lu(k,1645) = lu(k,1645) - lu(k,1398) * lu(k,1644) + lu(k,1646) = lu(k,1646) - lu(k,1399) * lu(k,1644) + lu(k,1652) = lu(k,1652) - lu(k,1400) * lu(k,1644) + lu(k,1653) = lu(k,1653) - lu(k,1401) * lu(k,1644) + lu(k,1654) = lu(k,1654) - lu(k,1402) * lu(k,1644) + lu(k,1655) = lu(k,1655) - lu(k,1403) * lu(k,1644) + lu(k,1656) = lu(k,1656) - lu(k,1404) * lu(k,1644) + lu(k,1658) = lu(k,1658) - lu(k,1405) * lu(k,1644) + lu(k,1662) = lu(k,1662) - lu(k,1406) * lu(k,1644) + lu(k,1664) = lu(k,1664) - lu(k,1407) * lu(k,1644) + lu(k,1665) = lu(k,1665) - lu(k,1408) * lu(k,1644) + lu(k,1666) = lu(k,1666) - lu(k,1409) * lu(k,1644) + lu(k,1808) = lu(k,1808) - lu(k,1398) * lu(k,1807) + lu(k,1809) = lu(k,1809) - lu(k,1399) * lu(k,1807) + lu(k,1817) = lu(k,1817) - lu(k,1400) * lu(k,1807) + lu(k,1818) = lu(k,1818) - lu(k,1401) * lu(k,1807) + lu(k,1819) = lu(k,1819) - lu(k,1402) * lu(k,1807) + lu(k,1820) = lu(k,1820) - lu(k,1403) * lu(k,1807) + lu(k,1821) = lu(k,1821) - lu(k,1404) * lu(k,1807) + lu(k,1823) = lu(k,1823) - lu(k,1405) * lu(k,1807) + lu(k,1827) = lu(k,1827) - lu(k,1406) * lu(k,1807) + lu(k,1829) = lu(k,1829) - lu(k,1407) * lu(k,1807) + lu(k,1830) = lu(k,1830) - lu(k,1408) * lu(k,1807) + lu(k,1831) = lu(k,1831) - lu(k,1409) * lu(k,1807) + lu(k,1906) = lu(k,1906) - lu(k,1398) * lu(k,1905) + lu(k,1907) = lu(k,1907) - lu(k,1399) * lu(k,1905) + lu(k,1912) = lu(k,1912) - lu(k,1400) * lu(k,1905) + lu(k,1913) = lu(k,1913) - lu(k,1401) * lu(k,1905) + lu(k,1914) = lu(k,1914) - lu(k,1402) * lu(k,1905) + lu(k,1915) = lu(k,1915) - lu(k,1403) * lu(k,1905) + lu(k,1916) = lu(k,1916) - lu(k,1404) * lu(k,1905) + lu(k,1918) = lu(k,1918) - lu(k,1405) * lu(k,1905) + lu(k,1922) = lu(k,1922) - lu(k,1406) * lu(k,1905) + lu(k,1924) = lu(k,1924) - lu(k,1407) * lu(k,1905) + lu(k,1925) = lu(k,1925) - lu(k,1408) * lu(k,1905) + lu(k,1926) = lu(k,1926) - lu(k,1409) * lu(k,1905) + lu(k,1949) = lu(k,1949) - lu(k,1398) * lu(k,1948) + lu(k,1950) = lu(k,1950) - lu(k,1399) * lu(k,1948) + lu(k,1957) = lu(k,1957) - lu(k,1400) * lu(k,1948) + lu(k,1958) = lu(k,1958) - lu(k,1401) * lu(k,1948) + lu(k,1959) = lu(k,1959) - lu(k,1402) * lu(k,1948) + lu(k,1960) = lu(k,1960) - lu(k,1403) * lu(k,1948) + lu(k,1961) = lu(k,1961) - lu(k,1404) * lu(k,1948) + lu(k,1963) = lu(k,1963) - lu(k,1405) * lu(k,1948) + lu(k,1967) = lu(k,1967) - lu(k,1406) * lu(k,1948) + lu(k,1969) = lu(k,1969) - lu(k,1407) * lu(k,1948) + lu(k,1970) = lu(k,1970) - lu(k,1408) * lu(k,1948) + lu(k,1971) = lu(k,1971) - lu(k,1409) * lu(k,1948) + lu(k,2216) = lu(k,2216) - lu(k,1398) * lu(k,2215) + lu(k,2217) = lu(k,2217) - lu(k,1399) * lu(k,2215) + lu(k,2223) = lu(k,2223) - lu(k,1400) * lu(k,2215) + lu(k,2224) = lu(k,2224) - lu(k,1401) * lu(k,2215) + lu(k,2225) = lu(k,2225) - lu(k,1402) * lu(k,2215) + lu(k,2226) = lu(k,2226) - lu(k,1403) * lu(k,2215) + lu(k,2227) = lu(k,2227) - lu(k,1404) * lu(k,2215) + lu(k,2229) = lu(k,2229) - lu(k,1405) * lu(k,2215) + lu(k,2233) = lu(k,2233) - lu(k,1406) * lu(k,2215) + lu(k,2235) = lu(k,2235) - lu(k,1407) * lu(k,2215) + lu(k,2236) = lu(k,2236) - lu(k,1408) * lu(k,2215) + lu(k,2237) = lu(k,2237) - lu(k,1409) * lu(k,2215) + lu(k,2348) = lu(k,2348) - lu(k,1398) * lu(k,2347) + lu(k,2349) = lu(k,2349) - lu(k,1399) * lu(k,2347) + lu(k,2356) = lu(k,2356) - lu(k,1400) * lu(k,2347) + lu(k,2357) = lu(k,2357) - lu(k,1401) * lu(k,2347) + lu(k,2358) = lu(k,2358) - lu(k,1402) * lu(k,2347) + lu(k,2359) = lu(k,2359) - lu(k,1403) * lu(k,2347) + lu(k,2360) = lu(k,2360) - lu(k,1404) * lu(k,2347) + lu(k,2362) = lu(k,2362) - lu(k,1405) * lu(k,2347) + lu(k,2366) = lu(k,2366) - lu(k,1406) * lu(k,2347) + lu(k,2368) = lu(k,2368) - lu(k,1407) * lu(k,2347) + lu(k,2369) = lu(k,2369) - lu(k,1408) * lu(k,2347) + lu(k,2370) = lu(k,2370) - lu(k,1409) * lu(k,2347) + lu(k,2403) = lu(k,2403) - lu(k,1398) * lu(k,2402) + lu(k,2404) = lu(k,2404) - lu(k,1399) * lu(k,2402) + lu(k,2408) = lu(k,2408) - lu(k,1400) * lu(k,2402) + lu(k,2409) = lu(k,2409) - lu(k,1401) * lu(k,2402) + lu(k,2410) = lu(k,2410) - lu(k,1402) * lu(k,2402) + lu(k,2411) = lu(k,2411) - lu(k,1403) * lu(k,2402) + lu(k,2412) = lu(k,2412) - lu(k,1404) * lu(k,2402) + lu(k,2414) = lu(k,2414) - lu(k,1405) * lu(k,2402) + lu(k,2418) = lu(k,2418) - lu(k,1406) * lu(k,2402) + lu(k,2420) = lu(k,2420) - lu(k,1407) * lu(k,2402) + lu(k,2421) = lu(k,2421) - lu(k,1408) * lu(k,2402) + lu(k,2422) = lu(k,2422) - lu(k,1409) * lu(k,2402) + lu(k,1428) = 1._r8 / lu(k,1428) + lu(k,1429) = lu(k,1429) * lu(k,1428) + lu(k,1430) = lu(k,1430) * lu(k,1428) + lu(k,1431) = lu(k,1431) * lu(k,1428) + lu(k,1432) = lu(k,1432) * lu(k,1428) + lu(k,1433) = lu(k,1433) * lu(k,1428) + lu(k,1434) = lu(k,1434) * lu(k,1428) + lu(k,1435) = lu(k,1435) * lu(k,1428) + lu(k,1436) = lu(k,1436) * lu(k,1428) + lu(k,1437) = lu(k,1437) * lu(k,1428) + lu(k,1438) = lu(k,1438) * lu(k,1428) + lu(k,1439) = lu(k,1439) * lu(k,1428) + lu(k,1440) = lu(k,1440) * lu(k,1428) + lu(k,1441) = lu(k,1441) * lu(k,1428) + lu(k,1646) = lu(k,1646) - lu(k,1429) * lu(k,1645) + lu(k,1649) = lu(k,1649) - lu(k,1430) * lu(k,1645) + lu(k,1652) = lu(k,1652) - lu(k,1431) * lu(k,1645) + lu(k,1653) = lu(k,1653) - lu(k,1432) * lu(k,1645) + lu(k,1654) = lu(k,1654) - lu(k,1433) * lu(k,1645) + lu(k,1655) = lu(k,1655) - lu(k,1434) * lu(k,1645) + lu(k,1656) = lu(k,1656) - lu(k,1435) * lu(k,1645) + lu(k,1658) = lu(k,1658) - lu(k,1436) * lu(k,1645) + lu(k,1662) = lu(k,1662) - lu(k,1437) * lu(k,1645) + lu(k,1663) = lu(k,1663) - lu(k,1438) * lu(k,1645) + lu(k,1664) = lu(k,1664) - lu(k,1439) * lu(k,1645) + lu(k,1665) = lu(k,1665) - lu(k,1440) * lu(k,1645) + lu(k,1666) = lu(k,1666) - lu(k,1441) * lu(k,1645) + lu(k,1809) = lu(k,1809) - lu(k,1429) * lu(k,1808) + lu(k,1814) = lu(k,1814) - lu(k,1430) * lu(k,1808) + lu(k,1817) = lu(k,1817) - lu(k,1431) * lu(k,1808) + lu(k,1818) = lu(k,1818) - lu(k,1432) * lu(k,1808) + lu(k,1819) = lu(k,1819) - lu(k,1433) * lu(k,1808) + lu(k,1820) = lu(k,1820) - lu(k,1434) * lu(k,1808) + lu(k,1821) = lu(k,1821) - lu(k,1435) * lu(k,1808) + lu(k,1823) = lu(k,1823) - lu(k,1436) * lu(k,1808) + lu(k,1827) = lu(k,1827) - lu(k,1437) * lu(k,1808) + lu(k,1828) = lu(k,1828) - lu(k,1438) * lu(k,1808) + lu(k,1829) = lu(k,1829) - lu(k,1439) * lu(k,1808) + lu(k,1830) = lu(k,1830) - lu(k,1440) * lu(k,1808) + lu(k,1831) = lu(k,1831) - lu(k,1441) * lu(k,1808) + lu(k,1907) = lu(k,1907) - lu(k,1429) * lu(k,1906) + lu(k,1909) = lu(k,1909) - lu(k,1430) * lu(k,1906) + lu(k,1912) = lu(k,1912) - lu(k,1431) * lu(k,1906) + lu(k,1913) = lu(k,1913) - lu(k,1432) * lu(k,1906) + lu(k,1914) = lu(k,1914) - lu(k,1433) * lu(k,1906) + lu(k,1915) = lu(k,1915) - lu(k,1434) * lu(k,1906) + lu(k,1916) = lu(k,1916) - lu(k,1435) * lu(k,1906) + lu(k,1918) = lu(k,1918) - lu(k,1436) * lu(k,1906) + lu(k,1922) = lu(k,1922) - lu(k,1437) * lu(k,1906) + lu(k,1923) = lu(k,1923) - lu(k,1438) * lu(k,1906) + lu(k,1924) = lu(k,1924) - lu(k,1439) * lu(k,1906) + lu(k,1925) = lu(k,1925) - lu(k,1440) * lu(k,1906) + lu(k,1926) = lu(k,1926) - lu(k,1441) * lu(k,1906) + lu(k,1950) = lu(k,1950) - lu(k,1429) * lu(k,1949) + lu(k,1954) = lu(k,1954) - lu(k,1430) * lu(k,1949) + lu(k,1957) = lu(k,1957) - lu(k,1431) * lu(k,1949) + lu(k,1958) = lu(k,1958) - lu(k,1432) * lu(k,1949) + lu(k,1959) = lu(k,1959) - lu(k,1433) * lu(k,1949) + lu(k,1960) = lu(k,1960) - lu(k,1434) * lu(k,1949) + lu(k,1961) = lu(k,1961) - lu(k,1435) * lu(k,1949) + lu(k,1963) = lu(k,1963) - lu(k,1436) * lu(k,1949) + lu(k,1967) = lu(k,1967) - lu(k,1437) * lu(k,1949) + lu(k,1968) = - lu(k,1438) * lu(k,1949) + lu(k,1969) = lu(k,1969) - lu(k,1439) * lu(k,1949) + lu(k,1970) = lu(k,1970) - lu(k,1440) * lu(k,1949) + lu(k,1971) = lu(k,1971) - lu(k,1441) * lu(k,1949) + lu(k,2152) = lu(k,2152) - lu(k,1429) * lu(k,2151) + lu(k,2156) = lu(k,2156) - lu(k,1430) * lu(k,2151) + lu(k,2159) = lu(k,2159) - lu(k,1431) * lu(k,2151) + lu(k,2160) = lu(k,2160) - lu(k,1432) * lu(k,2151) + lu(k,2161) = lu(k,2161) - lu(k,1433) * lu(k,2151) + lu(k,2162) = lu(k,2162) - lu(k,1434) * lu(k,2151) + lu(k,2163) = lu(k,2163) - lu(k,1435) * lu(k,2151) + lu(k,2165) = lu(k,2165) - lu(k,1436) * lu(k,2151) + lu(k,2169) = lu(k,2169) - lu(k,1437) * lu(k,2151) + lu(k,2170) = lu(k,2170) - lu(k,1438) * lu(k,2151) + lu(k,2171) = lu(k,2171) - lu(k,1439) * lu(k,2151) + lu(k,2172) = lu(k,2172) - lu(k,1440) * lu(k,2151) + lu(k,2173) = lu(k,2173) - lu(k,1441) * lu(k,2151) + lu(k,2217) = lu(k,2217) - lu(k,1429) * lu(k,2216) + lu(k,2220) = lu(k,2220) - lu(k,1430) * lu(k,2216) + lu(k,2223) = lu(k,2223) - lu(k,1431) * lu(k,2216) + lu(k,2224) = lu(k,2224) - lu(k,1432) * lu(k,2216) + lu(k,2225) = lu(k,2225) - lu(k,1433) * lu(k,2216) + lu(k,2226) = lu(k,2226) - lu(k,1434) * lu(k,2216) + lu(k,2227) = lu(k,2227) - lu(k,1435) * lu(k,2216) + lu(k,2229) = lu(k,2229) - lu(k,1436) * lu(k,2216) + lu(k,2233) = lu(k,2233) - lu(k,1437) * lu(k,2216) + lu(k,2234) = lu(k,2234) - lu(k,1438) * lu(k,2216) + lu(k,2235) = lu(k,2235) - lu(k,1439) * lu(k,2216) + lu(k,2236) = lu(k,2236) - lu(k,1440) * lu(k,2216) + lu(k,2237) = lu(k,2237) - lu(k,1441) * lu(k,2216) + lu(k,2349) = lu(k,2349) - lu(k,1429) * lu(k,2348) + lu(k,2353) = lu(k,2353) - lu(k,1430) * lu(k,2348) + lu(k,2356) = lu(k,2356) - lu(k,1431) * lu(k,2348) + lu(k,2357) = lu(k,2357) - lu(k,1432) * lu(k,2348) + lu(k,2358) = lu(k,2358) - lu(k,1433) * lu(k,2348) + lu(k,2359) = lu(k,2359) - lu(k,1434) * lu(k,2348) + lu(k,2360) = lu(k,2360) - lu(k,1435) * lu(k,2348) + lu(k,2362) = lu(k,2362) - lu(k,1436) * lu(k,2348) + lu(k,2366) = lu(k,2366) - lu(k,1437) * lu(k,2348) + lu(k,2367) = lu(k,2367) - lu(k,1438) * lu(k,2348) + lu(k,2368) = lu(k,2368) - lu(k,1439) * lu(k,2348) + lu(k,2369) = lu(k,2369) - lu(k,1440) * lu(k,2348) + lu(k,2370) = lu(k,2370) - lu(k,1441) * lu(k,2348) + lu(k,2404) = lu(k,2404) - lu(k,1429) * lu(k,2403) + lu(k,2405) = lu(k,2405) - lu(k,1430) * lu(k,2403) + lu(k,2408) = lu(k,2408) - lu(k,1431) * lu(k,2403) + lu(k,2409) = lu(k,2409) - lu(k,1432) * lu(k,2403) + lu(k,2410) = lu(k,2410) - lu(k,1433) * lu(k,2403) + lu(k,2411) = lu(k,2411) - lu(k,1434) * lu(k,2403) + lu(k,2412) = lu(k,2412) - lu(k,1435) * lu(k,2403) + lu(k,2414) = lu(k,2414) - lu(k,1436) * lu(k,2403) + lu(k,2418) = lu(k,2418) - lu(k,1437) * lu(k,2403) + lu(k,2419) = lu(k,2419) - lu(k,1438) * lu(k,2403) + lu(k,2420) = lu(k,2420) - lu(k,1439) * lu(k,2403) + lu(k,2421) = lu(k,2421) - lu(k,1440) * lu(k,2403) + lu(k,2422) = lu(k,2422) - lu(k,1441) * lu(k,2403) + lu(k,1450) = 1._r8 / lu(k,1450) + lu(k,1451) = lu(k,1451) * lu(k,1450) + lu(k,1452) = lu(k,1452) * lu(k,1450) + lu(k,1453) = lu(k,1453) * lu(k,1450) + lu(k,1454) = lu(k,1454) * lu(k,1450) + lu(k,1455) = lu(k,1455) * lu(k,1450) + lu(k,1456) = lu(k,1456) * lu(k,1450) + lu(k,1457) = lu(k,1457) * lu(k,1450) + lu(k,1458) = lu(k,1458) * lu(k,1450) + lu(k,1512) = lu(k,1512) - lu(k,1451) * lu(k,1510) + lu(k,1514) = lu(k,1514) - lu(k,1452) * lu(k,1510) + lu(k,1515) = - lu(k,1453) * lu(k,1510) + lu(k,1516) = - lu(k,1454) * lu(k,1510) + lu(k,1518) = lu(k,1518) - lu(k,1455) * lu(k,1510) + lu(k,1519) = lu(k,1519) - lu(k,1456) * lu(k,1510) + lu(k,1520) = lu(k,1520) - lu(k,1457) * lu(k,1510) + lu(k,1522) = lu(k,1522) - lu(k,1458) * lu(k,1510) + lu(k,1542) = lu(k,1542) - lu(k,1451) * lu(k,1539) + lu(k,1545) = lu(k,1545) - lu(k,1452) * lu(k,1539) + lu(k,1546) = lu(k,1546) - lu(k,1453) * lu(k,1539) + lu(k,1547) = lu(k,1547) - lu(k,1454) * lu(k,1539) + lu(k,1549) = lu(k,1549) - lu(k,1455) * lu(k,1539) + lu(k,1550) = lu(k,1550) - lu(k,1456) * lu(k,1539) + lu(k,1551) = lu(k,1551) - lu(k,1457) * lu(k,1539) + lu(k,1554) = lu(k,1554) - lu(k,1458) * lu(k,1539) + lu(k,1649) = lu(k,1649) - lu(k,1451) * lu(k,1646) + lu(k,1653) = lu(k,1653) - lu(k,1452) * lu(k,1646) + lu(k,1654) = lu(k,1654) - lu(k,1453) * lu(k,1646) + lu(k,1655) = lu(k,1655) - lu(k,1454) * lu(k,1646) + lu(k,1657) = - lu(k,1455) * lu(k,1646) + lu(k,1659) = lu(k,1659) - lu(k,1456) * lu(k,1646) + lu(k,1660) = - lu(k,1457) * lu(k,1646) + lu(k,1664) = lu(k,1664) - lu(k,1458) * lu(k,1646) + lu(k,1814) = lu(k,1814) - lu(k,1451) * lu(k,1809) + lu(k,1818) = lu(k,1818) - lu(k,1452) * lu(k,1809) + lu(k,1819) = lu(k,1819) - lu(k,1453) * lu(k,1809) + lu(k,1820) = lu(k,1820) - lu(k,1454) * lu(k,1809) + lu(k,1822) = lu(k,1822) - lu(k,1455) * lu(k,1809) + lu(k,1824) = lu(k,1824) - lu(k,1456) * lu(k,1809) + lu(k,1825) = lu(k,1825) - lu(k,1457) * lu(k,1809) + lu(k,1829) = lu(k,1829) - lu(k,1458) * lu(k,1809) + lu(k,1909) = lu(k,1909) - lu(k,1451) * lu(k,1907) + lu(k,1913) = lu(k,1913) - lu(k,1452) * lu(k,1907) + lu(k,1914) = lu(k,1914) - lu(k,1453) * lu(k,1907) + lu(k,1915) = lu(k,1915) - lu(k,1454) * lu(k,1907) + lu(k,1917) = lu(k,1917) - lu(k,1455) * lu(k,1907) + lu(k,1919) = lu(k,1919) - lu(k,1456) * lu(k,1907) + lu(k,1920) = lu(k,1920) - lu(k,1457) * lu(k,1907) + lu(k,1924) = lu(k,1924) - lu(k,1458) * lu(k,1907) + lu(k,1954) = lu(k,1954) - lu(k,1451) * lu(k,1950) + lu(k,1958) = lu(k,1958) - lu(k,1452) * lu(k,1950) + lu(k,1959) = lu(k,1959) - lu(k,1453) * lu(k,1950) + lu(k,1960) = lu(k,1960) - lu(k,1454) * lu(k,1950) + lu(k,1962) = lu(k,1962) - lu(k,1455) * lu(k,1950) + lu(k,1964) = lu(k,1964) - lu(k,1456) * lu(k,1950) + lu(k,1965) = lu(k,1965) - lu(k,1457) * lu(k,1950) + lu(k,1969) = lu(k,1969) - lu(k,1458) * lu(k,1950) + lu(k,1980) = - lu(k,1451) * lu(k,1976) + lu(k,1984) = lu(k,1984) - lu(k,1452) * lu(k,1976) + lu(k,1985) = lu(k,1985) - lu(k,1453) * lu(k,1976) + lu(k,1986) = lu(k,1986) - lu(k,1454) * lu(k,1976) + lu(k,1988) = lu(k,1988) - lu(k,1455) * lu(k,1976) + lu(k,1990) = lu(k,1990) - lu(k,1456) * lu(k,1976) + lu(k,1991) = lu(k,1991) - lu(k,1457) * lu(k,1976) + lu(k,1995) = lu(k,1995) - lu(k,1458) * lu(k,1976) + lu(k,2089) = lu(k,2089) - lu(k,1451) * lu(k,2084) + lu(k,2093) = lu(k,2093) - lu(k,1452) * lu(k,2084) + lu(k,2094) = lu(k,2094) - lu(k,1453) * lu(k,2084) + lu(k,2095) = lu(k,2095) - lu(k,1454) * lu(k,2084) + lu(k,2097) = lu(k,2097) - lu(k,1455) * lu(k,2084) + lu(k,2099) = lu(k,2099) - lu(k,1456) * lu(k,2084) + lu(k,2100) = lu(k,2100) - lu(k,1457) * lu(k,2084) + lu(k,2104) = lu(k,2104) - lu(k,1458) * lu(k,2084) + lu(k,2156) = lu(k,2156) - lu(k,1451) * lu(k,2152) + lu(k,2160) = lu(k,2160) - lu(k,1452) * lu(k,2152) + lu(k,2161) = lu(k,2161) - lu(k,1453) * lu(k,2152) + lu(k,2162) = lu(k,2162) - lu(k,1454) * lu(k,2152) + lu(k,2164) = lu(k,2164) - lu(k,1455) * lu(k,2152) + lu(k,2166) = lu(k,2166) - lu(k,1456) * lu(k,2152) + lu(k,2167) = lu(k,2167) - lu(k,1457) * lu(k,2152) + lu(k,2171) = lu(k,2171) - lu(k,1458) * lu(k,2152) + lu(k,2220) = lu(k,2220) - lu(k,1451) * lu(k,2217) + lu(k,2224) = lu(k,2224) - lu(k,1452) * lu(k,2217) + lu(k,2225) = lu(k,2225) - lu(k,1453) * lu(k,2217) + lu(k,2226) = lu(k,2226) - lu(k,1454) * lu(k,2217) + lu(k,2228) = lu(k,2228) - lu(k,1455) * lu(k,2217) + lu(k,2230) = lu(k,2230) - lu(k,1456) * lu(k,2217) + lu(k,2231) = lu(k,2231) - lu(k,1457) * lu(k,2217) + lu(k,2235) = lu(k,2235) - lu(k,1458) * lu(k,2217) + lu(k,2245) = - lu(k,1451) * lu(k,2241) + lu(k,2249) = lu(k,2249) - lu(k,1452) * lu(k,2241) + lu(k,2250) = - lu(k,1453) * lu(k,2241) + lu(k,2251) = - lu(k,1454) * lu(k,2241) + lu(k,2253) = lu(k,2253) - lu(k,1455) * lu(k,2241) + lu(k,2255) = lu(k,2255) - lu(k,1456) * lu(k,2241) + lu(k,2256) = lu(k,2256) - lu(k,1457) * lu(k,2241) + lu(k,2260) = lu(k,2260) - lu(k,1458) * lu(k,2241) + lu(k,2353) = lu(k,2353) - lu(k,1451) * lu(k,2349) + lu(k,2357) = lu(k,2357) - lu(k,1452) * lu(k,2349) + lu(k,2358) = lu(k,2358) - lu(k,1453) * lu(k,2349) + lu(k,2359) = lu(k,2359) - lu(k,1454) * lu(k,2349) + lu(k,2361) = lu(k,2361) - lu(k,1455) * lu(k,2349) + lu(k,2363) = lu(k,2363) - lu(k,1456) * lu(k,2349) + lu(k,2364) = lu(k,2364) - lu(k,1457) * lu(k,2349) + lu(k,2368) = lu(k,2368) - lu(k,1458) * lu(k,2349) + lu(k,2405) = lu(k,2405) - lu(k,1451) * lu(k,2404) + lu(k,2409) = lu(k,2409) - lu(k,1452) * lu(k,2404) + lu(k,2410) = lu(k,2410) - lu(k,1453) * lu(k,2404) + lu(k,2411) = lu(k,2411) - lu(k,1454) * lu(k,2404) + lu(k,2413) = - lu(k,1455) * lu(k,2404) + lu(k,2415) = - lu(k,1456) * lu(k,2404) + lu(k,2416) = lu(k,2416) - lu(k,1457) * lu(k,2404) + lu(k,2420) = lu(k,2420) - lu(k,1458) * lu(k,2404) + end do + end subroutine lu_fac27 + subroutine lu_fac28( 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,1461) = 1._r8 / lu(k,1461) + lu(k,1462) = lu(k,1462) * lu(k,1461) + lu(k,1463) = lu(k,1463) * lu(k,1461) + lu(k,1464) = lu(k,1464) * lu(k,1461) + lu(k,1465) = lu(k,1465) * lu(k,1461) + lu(k,1466) = lu(k,1466) * lu(k,1461) + lu(k,1467) = lu(k,1467) * lu(k,1461) + lu(k,1468) = lu(k,1468) * lu(k,1461) + lu(k,1469) = lu(k,1469) * lu(k,1461) + lu(k,1470) = lu(k,1470) * lu(k,1461) + lu(k,1471) = lu(k,1471) * lu(k,1461) + lu(k,1472) = lu(k,1472) * lu(k,1461) + lu(k,1812) = lu(k,1812) - lu(k,1462) * lu(k,1810) + lu(k,1817) = lu(k,1817) - lu(k,1463) * lu(k,1810) + lu(k,1818) = lu(k,1818) - lu(k,1464) * lu(k,1810) + lu(k,1822) = lu(k,1822) - lu(k,1465) * lu(k,1810) + lu(k,1823) = lu(k,1823) - lu(k,1466) * lu(k,1810) + lu(k,1824) = lu(k,1824) - lu(k,1467) * lu(k,1810) + lu(k,1825) = lu(k,1825) - lu(k,1468) * lu(k,1810) + lu(k,1826) = lu(k,1826) - lu(k,1469) * lu(k,1810) + lu(k,1828) = lu(k,1828) - lu(k,1470) * lu(k,1810) + lu(k,1830) = lu(k,1830) - lu(k,1471) * lu(k,1810) + lu(k,1831) = lu(k,1831) - lu(k,1472) * lu(k,1810) + lu(k,1978) = lu(k,1978) - lu(k,1462) * lu(k,1977) + lu(k,1983) = lu(k,1983) - lu(k,1463) * lu(k,1977) + lu(k,1984) = lu(k,1984) - lu(k,1464) * lu(k,1977) + lu(k,1988) = lu(k,1988) - lu(k,1465) * lu(k,1977) + lu(k,1989) = lu(k,1989) - lu(k,1466) * lu(k,1977) + lu(k,1990) = lu(k,1990) - lu(k,1467) * lu(k,1977) + lu(k,1991) = lu(k,1991) - lu(k,1468) * lu(k,1977) + lu(k,1992) = lu(k,1992) - lu(k,1469) * lu(k,1977) + lu(k,1994) = - lu(k,1470) * lu(k,1977) + lu(k,1996) = - lu(k,1471) * lu(k,1977) + lu(k,1997) = lu(k,1997) - lu(k,1472) * lu(k,1977) + lu(k,2021) = lu(k,2021) - lu(k,1462) * lu(k,2020) + lu(k,2026) = lu(k,2026) - lu(k,1463) * lu(k,2020) + lu(k,2027) = lu(k,2027) - lu(k,1464) * lu(k,2020) + lu(k,2031) = lu(k,2031) - lu(k,1465) * lu(k,2020) + lu(k,2032) = lu(k,2032) - lu(k,1466) * lu(k,2020) + lu(k,2033) = lu(k,2033) - lu(k,1467) * lu(k,2020) + lu(k,2034) = lu(k,2034) - lu(k,1468) * lu(k,2020) + lu(k,2035) = lu(k,2035) - lu(k,1469) * lu(k,2020) + lu(k,2037) = lu(k,2037) - lu(k,1470) * lu(k,2020) + lu(k,2039) = lu(k,2039) - lu(k,1471) * lu(k,2020) + lu(k,2040) = lu(k,2040) - lu(k,1472) * lu(k,2020) + lu(k,2044) = - lu(k,1462) * lu(k,2043) + lu(k,2049) = lu(k,2049) - lu(k,1463) * lu(k,2043) + lu(k,2050) = lu(k,2050) - lu(k,1464) * lu(k,2043) + lu(k,2054) = - lu(k,1465) * lu(k,2043) + lu(k,2055) = lu(k,2055) - lu(k,1466) * lu(k,2043) + lu(k,2056) = - lu(k,1467) * lu(k,2043) + lu(k,2057) = lu(k,2057) - lu(k,1468) * lu(k,2043) + lu(k,2058) = - lu(k,1469) * lu(k,2043) + lu(k,2060) = lu(k,2060) - lu(k,1470) * lu(k,2043) + lu(k,2062) = lu(k,2062) - lu(k,1471) * lu(k,2043) + lu(k,2063) = lu(k,2063) - lu(k,1472) * lu(k,2043) + lu(k,2087) = lu(k,2087) - lu(k,1462) * lu(k,2085) + lu(k,2092) = lu(k,2092) - lu(k,1463) * lu(k,2085) + lu(k,2093) = lu(k,2093) - lu(k,1464) * lu(k,2085) + lu(k,2097) = lu(k,2097) - lu(k,1465) * lu(k,2085) + lu(k,2098) = lu(k,2098) - lu(k,1466) * lu(k,2085) + lu(k,2099) = lu(k,2099) - lu(k,1467) * lu(k,2085) + lu(k,2100) = lu(k,2100) - lu(k,1468) * lu(k,2085) + lu(k,2101) = lu(k,2101) - lu(k,1469) * lu(k,2085) + lu(k,2103) = - lu(k,1470) * lu(k,2085) + lu(k,2105) = - lu(k,1471) * lu(k,2085) + lu(k,2106) = lu(k,2106) - lu(k,1472) * lu(k,2085) + lu(k,2108) = - lu(k,1462) * lu(k,2107) + lu(k,2113) = - lu(k,1463) * lu(k,2107) + lu(k,2114) = lu(k,2114) - lu(k,1464) * lu(k,2107) + lu(k,2118) = - lu(k,1465) * lu(k,2107) + lu(k,2119) = - lu(k,1466) * lu(k,2107) + lu(k,2120) = lu(k,2120) - lu(k,1467) * lu(k,2107) + lu(k,2121) = lu(k,2121) - lu(k,1468) * lu(k,2107) + lu(k,2122) = - lu(k,1469) * lu(k,2107) + lu(k,2124) = - lu(k,1470) * lu(k,2107) + lu(k,2126) = - lu(k,1471) * lu(k,2107) + lu(k,2127) = lu(k,2127) - lu(k,1472) * lu(k,2107) + lu(k,2154) = lu(k,2154) - lu(k,1462) * lu(k,2153) + lu(k,2159) = lu(k,2159) - lu(k,1463) * lu(k,2153) + lu(k,2160) = lu(k,2160) - lu(k,1464) * lu(k,2153) + lu(k,2164) = lu(k,2164) - lu(k,1465) * lu(k,2153) + lu(k,2165) = lu(k,2165) - lu(k,1466) * lu(k,2153) + lu(k,2166) = lu(k,2166) - lu(k,1467) * lu(k,2153) + lu(k,2167) = lu(k,2167) - lu(k,1468) * lu(k,2153) + lu(k,2168) = lu(k,2168) - lu(k,1469) * lu(k,2153) + lu(k,2170) = lu(k,2170) - lu(k,1470) * lu(k,2153) + lu(k,2172) = lu(k,2172) - lu(k,1471) * lu(k,2153) + lu(k,2173) = lu(k,2173) - lu(k,1472) * lu(k,2153) + lu(k,2243) = lu(k,2243) - lu(k,1462) * lu(k,2242) + lu(k,2248) = lu(k,2248) - lu(k,1463) * lu(k,2242) + lu(k,2249) = lu(k,2249) - lu(k,1464) * lu(k,2242) + lu(k,2253) = lu(k,2253) - lu(k,1465) * lu(k,2242) + lu(k,2254) = lu(k,2254) - lu(k,1466) * lu(k,2242) + lu(k,2255) = lu(k,2255) - lu(k,1467) * lu(k,2242) + lu(k,2256) = lu(k,2256) - lu(k,1468) * lu(k,2242) + lu(k,2257) = lu(k,2257) - lu(k,1469) * lu(k,2242) + lu(k,2259) = lu(k,2259) - lu(k,1470) * lu(k,2242) + lu(k,2261) = lu(k,2261) - lu(k,1471) * lu(k,2242) + lu(k,2262) = lu(k,2262) - lu(k,1472) * lu(k,2242) + lu(k,2351) = lu(k,2351) - lu(k,1462) * lu(k,2350) + lu(k,2356) = lu(k,2356) - lu(k,1463) * lu(k,2350) + lu(k,2357) = lu(k,2357) - lu(k,1464) * lu(k,2350) + lu(k,2361) = lu(k,2361) - lu(k,1465) * lu(k,2350) + lu(k,2362) = lu(k,2362) - lu(k,1466) * lu(k,2350) + lu(k,2363) = lu(k,2363) - lu(k,1467) * lu(k,2350) + lu(k,2364) = lu(k,2364) - lu(k,1468) * lu(k,2350) + lu(k,2365) = lu(k,2365) - lu(k,1469) * lu(k,2350) + lu(k,2367) = lu(k,2367) - lu(k,1470) * lu(k,2350) + lu(k,2369) = lu(k,2369) - lu(k,1471) * lu(k,2350) + lu(k,2370) = lu(k,2370) - lu(k,1472) * lu(k,2350) + lu(k,2430) = - lu(k,1462) * lu(k,2428) + lu(k,2435) = lu(k,2435) - lu(k,1463) * lu(k,2428) + lu(k,2436) = lu(k,2436) - lu(k,1464) * lu(k,2428) + lu(k,2440) = lu(k,2440) - lu(k,1465) * lu(k,2428) + lu(k,2441) = lu(k,2441) - lu(k,1466) * lu(k,2428) + lu(k,2442) = lu(k,2442) - lu(k,1467) * lu(k,2428) + lu(k,2443) = lu(k,2443) - lu(k,1468) * lu(k,2428) + lu(k,2444) = - lu(k,1469) * lu(k,2428) + lu(k,2446) = lu(k,2446) - lu(k,1470) * lu(k,2428) + lu(k,2448) = lu(k,2448) - lu(k,1471) * lu(k,2428) + lu(k,2449) = lu(k,2449) - lu(k,1472) * lu(k,2428) + lu(k,1476) = 1._r8 / lu(k,1476) + lu(k,1477) = lu(k,1477) * lu(k,1476) + lu(k,1478) = lu(k,1478) * lu(k,1476) + lu(k,1479) = lu(k,1479) * lu(k,1476) + lu(k,1480) = lu(k,1480) * lu(k,1476) + lu(k,1481) = lu(k,1481) * lu(k,1476) + lu(k,1482) = lu(k,1482) * lu(k,1476) + lu(k,1483) = lu(k,1483) * lu(k,1476) + lu(k,1484) = lu(k,1484) * lu(k,1476) + lu(k,1485) = lu(k,1485) * lu(k,1476) + lu(k,1486) = lu(k,1486) * lu(k,1476) + lu(k,1487) = lu(k,1487) * lu(k,1476) + lu(k,1488) = lu(k,1488) * lu(k,1476) + lu(k,1489) = lu(k,1489) * lu(k,1476) + lu(k,1541) = - lu(k,1477) * lu(k,1540) + lu(k,1542) = lu(k,1542) - lu(k,1478) * lu(k,1540) + lu(k,1543) = - lu(k,1479) * lu(k,1540) + lu(k,1544) = - lu(k,1480) * lu(k,1540) + lu(k,1545) = lu(k,1545) - lu(k,1481) * lu(k,1540) + lu(k,1546) = lu(k,1546) - lu(k,1482) * lu(k,1540) + lu(k,1547) = lu(k,1547) - lu(k,1483) * lu(k,1540) + lu(k,1550) = lu(k,1550) - lu(k,1484) * lu(k,1540) + lu(k,1551) = lu(k,1551) - lu(k,1485) * lu(k,1540) + lu(k,1552) = - lu(k,1486) * lu(k,1540) + lu(k,1553) = lu(k,1553) - lu(k,1487) * lu(k,1540) + lu(k,1554) = lu(k,1554) - lu(k,1488) * lu(k,1540) + lu(k,1555) = lu(k,1555) - lu(k,1489) * lu(k,1540) + lu(k,1563) = lu(k,1563) - lu(k,1477) * lu(k,1561) + lu(k,1564) = lu(k,1564) - lu(k,1478) * lu(k,1561) + lu(k,1565) = lu(k,1565) - lu(k,1479) * lu(k,1561) + lu(k,1566) = lu(k,1566) - lu(k,1480) * lu(k,1561) + lu(k,1568) = lu(k,1568) - lu(k,1481) * lu(k,1561) + lu(k,1569) = lu(k,1569) - lu(k,1482) * lu(k,1561) + lu(k,1570) = lu(k,1570) - lu(k,1483) * lu(k,1561) + lu(k,1574) = lu(k,1574) - lu(k,1484) * lu(k,1561) + lu(k,1575) = - lu(k,1485) * lu(k,1561) + lu(k,1576) = lu(k,1576) - lu(k,1486) * lu(k,1561) + lu(k,1577) = - lu(k,1487) * lu(k,1561) + lu(k,1578) = lu(k,1578) - lu(k,1488) * lu(k,1561) + lu(k,1579) = lu(k,1579) - lu(k,1489) * lu(k,1561) + lu(k,1589) = lu(k,1589) - lu(k,1477) * lu(k,1587) + lu(k,1590) = lu(k,1590) - lu(k,1478) * lu(k,1587) + lu(k,1591) = lu(k,1591) - lu(k,1479) * lu(k,1587) + lu(k,1592) = lu(k,1592) - lu(k,1480) * lu(k,1587) + lu(k,1594) = lu(k,1594) - lu(k,1481) * lu(k,1587) + lu(k,1595) = lu(k,1595) - lu(k,1482) * lu(k,1587) + lu(k,1596) = lu(k,1596) - lu(k,1483) * lu(k,1587) + lu(k,1600) = lu(k,1600) - lu(k,1484) * lu(k,1587) + lu(k,1601) = - lu(k,1485) * lu(k,1587) + lu(k,1602) = lu(k,1602) - lu(k,1486) * lu(k,1587) + lu(k,1603) = - lu(k,1487) * lu(k,1587) + lu(k,1604) = lu(k,1604) - lu(k,1488) * lu(k,1587) + lu(k,1606) = lu(k,1606) - lu(k,1489) * lu(k,1587) + lu(k,1648) = - lu(k,1477) * lu(k,1647) + lu(k,1649) = lu(k,1649) - lu(k,1478) * lu(k,1647) + lu(k,1650) = - lu(k,1479) * lu(k,1647) + lu(k,1651) = - lu(k,1480) * lu(k,1647) + lu(k,1653) = lu(k,1653) - lu(k,1481) * lu(k,1647) + lu(k,1654) = lu(k,1654) - lu(k,1482) * lu(k,1647) + lu(k,1655) = lu(k,1655) - lu(k,1483) * lu(k,1647) + lu(k,1659) = lu(k,1659) - lu(k,1484) * lu(k,1647) + lu(k,1660) = lu(k,1660) - lu(k,1485) * lu(k,1647) + lu(k,1661) = - lu(k,1486) * lu(k,1647) + lu(k,1662) = lu(k,1662) - lu(k,1487) * lu(k,1647) + lu(k,1664) = lu(k,1664) - lu(k,1488) * lu(k,1647) + lu(k,1666) = lu(k,1666) - lu(k,1489) * lu(k,1647) + lu(k,1813) = lu(k,1813) - lu(k,1477) * lu(k,1811) + lu(k,1814) = lu(k,1814) - lu(k,1478) * lu(k,1811) + lu(k,1815) = lu(k,1815) - lu(k,1479) * lu(k,1811) + lu(k,1816) = lu(k,1816) - lu(k,1480) * lu(k,1811) + lu(k,1818) = lu(k,1818) - lu(k,1481) * lu(k,1811) + lu(k,1819) = lu(k,1819) - lu(k,1482) * lu(k,1811) + lu(k,1820) = lu(k,1820) - lu(k,1483) * lu(k,1811) + lu(k,1824) = lu(k,1824) - lu(k,1484) * lu(k,1811) + lu(k,1825) = lu(k,1825) - lu(k,1485) * lu(k,1811) + lu(k,1826) = lu(k,1826) - lu(k,1486) * lu(k,1811) + lu(k,1827) = lu(k,1827) - lu(k,1487) * lu(k,1811) + lu(k,1829) = lu(k,1829) - lu(k,1488) * lu(k,1811) + lu(k,1831) = lu(k,1831) - lu(k,1489) * lu(k,1811) + lu(k,1953) = lu(k,1953) - lu(k,1477) * lu(k,1951) + lu(k,1954) = lu(k,1954) - lu(k,1478) * lu(k,1951) + lu(k,1955) = lu(k,1955) - lu(k,1479) * lu(k,1951) + lu(k,1956) = lu(k,1956) - lu(k,1480) * lu(k,1951) + lu(k,1958) = lu(k,1958) - lu(k,1481) * lu(k,1951) + lu(k,1959) = lu(k,1959) - lu(k,1482) * lu(k,1951) + lu(k,1960) = lu(k,1960) - lu(k,1483) * lu(k,1951) + lu(k,1964) = lu(k,1964) - lu(k,1484) * lu(k,1951) + lu(k,1965) = lu(k,1965) - lu(k,1485) * lu(k,1951) + lu(k,1966) = lu(k,1966) - lu(k,1486) * lu(k,1951) + lu(k,1967) = lu(k,1967) - lu(k,1487) * lu(k,1951) + lu(k,1969) = lu(k,1969) - lu(k,1488) * lu(k,1951) + lu(k,1971) = lu(k,1971) - lu(k,1489) * lu(k,1951) + lu(k,2088) = lu(k,2088) - lu(k,1477) * lu(k,2086) + lu(k,2089) = lu(k,2089) - lu(k,1478) * lu(k,2086) + lu(k,2090) = lu(k,2090) - lu(k,1479) * lu(k,2086) + lu(k,2091) = lu(k,2091) - lu(k,1480) * lu(k,2086) + lu(k,2093) = lu(k,2093) - lu(k,1481) * lu(k,2086) + lu(k,2094) = lu(k,2094) - lu(k,1482) * lu(k,2086) + lu(k,2095) = lu(k,2095) - lu(k,1483) * lu(k,2086) + lu(k,2099) = lu(k,2099) - lu(k,1484) * lu(k,2086) + lu(k,2100) = lu(k,2100) - lu(k,1485) * lu(k,2086) + lu(k,2101) = lu(k,2101) - lu(k,1486) * lu(k,2086) + lu(k,2102) = lu(k,2102) - lu(k,1487) * lu(k,2086) + lu(k,2104) = lu(k,2104) - lu(k,1488) * lu(k,2086) + lu(k,2106) = lu(k,2106) - lu(k,1489) * lu(k,2086) + lu(k,2219) = lu(k,2219) - lu(k,1477) * lu(k,2218) + lu(k,2220) = lu(k,2220) - lu(k,1478) * lu(k,2218) + lu(k,2221) = lu(k,2221) - lu(k,1479) * lu(k,2218) + lu(k,2222) = lu(k,2222) - lu(k,1480) * lu(k,2218) + lu(k,2224) = lu(k,2224) - lu(k,1481) * lu(k,2218) + lu(k,2225) = lu(k,2225) - lu(k,1482) * lu(k,2218) + lu(k,2226) = lu(k,2226) - lu(k,1483) * lu(k,2218) + lu(k,2230) = lu(k,2230) - lu(k,1484) * lu(k,2218) + lu(k,2231) = lu(k,2231) - lu(k,1485) * lu(k,2218) + lu(k,2232) = lu(k,2232) - lu(k,1486) * lu(k,2218) + lu(k,2233) = lu(k,2233) - lu(k,1487) * lu(k,2218) + lu(k,2235) = lu(k,2235) - lu(k,1488) * lu(k,2218) + lu(k,2237) = lu(k,2237) - lu(k,1489) * lu(k,2218) + lu(k,2431) = - lu(k,1477) * lu(k,2429) + lu(k,2432) = - lu(k,1478) * lu(k,2429) + lu(k,2433) = - lu(k,1479) * lu(k,2429) + lu(k,2434) = - lu(k,1480) * lu(k,2429) + lu(k,2436) = lu(k,2436) - lu(k,1481) * lu(k,2429) + lu(k,2437) = - lu(k,1482) * lu(k,2429) + lu(k,2438) = - lu(k,1483) * lu(k,2429) + lu(k,2442) = lu(k,2442) - lu(k,1484) * lu(k,2429) + lu(k,2443) = lu(k,2443) - lu(k,1485) * lu(k,2429) + lu(k,2444) = lu(k,2444) - lu(k,1486) * lu(k,2429) + lu(k,2445) = - lu(k,1487) * lu(k,2429) + lu(k,2447) = lu(k,2447) - lu(k,1488) * lu(k,2429) + lu(k,2449) = lu(k,2449) - lu(k,1489) * lu(k,2429) + end do + end subroutine lu_fac28 + subroutine lu_fac29( 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,1495) = 1._r8 / lu(k,1495) + lu(k,1496) = lu(k,1496) * lu(k,1495) + lu(k,1497) = lu(k,1497) * lu(k,1495) + lu(k,1498) = lu(k,1498) * lu(k,1495) + lu(k,1499) = lu(k,1499) * lu(k,1495) + lu(k,1500) = lu(k,1500) * lu(k,1495) + lu(k,1501) = lu(k,1501) * lu(k,1495) + lu(k,1502) = lu(k,1502) * lu(k,1495) + lu(k,1503) = lu(k,1503) * lu(k,1495) + lu(k,1504) = lu(k,1504) * lu(k,1495) + lu(k,1505) = lu(k,1505) * lu(k,1495) + lu(k,1506) = lu(k,1506) * lu(k,1495) + lu(k,1507) = lu(k,1507) * lu(k,1495) + lu(k,1563) = lu(k,1563) - lu(k,1496) * lu(k,1562) + lu(k,1565) = lu(k,1565) - lu(k,1497) * lu(k,1562) + lu(k,1566) = lu(k,1566) - lu(k,1498) * lu(k,1562) + lu(k,1567) = lu(k,1567) - lu(k,1499) * lu(k,1562) + lu(k,1568) = lu(k,1568) - lu(k,1500) * lu(k,1562) + lu(k,1570) = lu(k,1570) - lu(k,1501) * lu(k,1562) + lu(k,1572) = - lu(k,1502) * lu(k,1562) + lu(k,1573) = lu(k,1573) - lu(k,1503) * lu(k,1562) + lu(k,1574) = lu(k,1574) - lu(k,1504) * lu(k,1562) + lu(k,1575) = lu(k,1575) - lu(k,1505) * lu(k,1562) + lu(k,1576) = lu(k,1576) - lu(k,1506) * lu(k,1562) + lu(k,1579) = lu(k,1579) - lu(k,1507) * lu(k,1562) + lu(k,1589) = lu(k,1589) - lu(k,1496) * lu(k,1588) + lu(k,1591) = lu(k,1591) - lu(k,1497) * lu(k,1588) + lu(k,1592) = lu(k,1592) - lu(k,1498) * lu(k,1588) + lu(k,1593) = lu(k,1593) - lu(k,1499) * lu(k,1588) + lu(k,1594) = lu(k,1594) - lu(k,1500) * lu(k,1588) + lu(k,1596) = lu(k,1596) - lu(k,1501) * lu(k,1588) + lu(k,1598) = - lu(k,1502) * lu(k,1588) + lu(k,1599) = lu(k,1599) - lu(k,1503) * lu(k,1588) + lu(k,1600) = lu(k,1600) - lu(k,1504) * lu(k,1588) + lu(k,1601) = lu(k,1601) - lu(k,1505) * lu(k,1588) + lu(k,1602) = lu(k,1602) - lu(k,1506) * lu(k,1588) + lu(k,1606) = lu(k,1606) - lu(k,1507) * lu(k,1588) + lu(k,1813) = lu(k,1813) - lu(k,1496) * lu(k,1812) + lu(k,1815) = lu(k,1815) - lu(k,1497) * lu(k,1812) + lu(k,1816) = lu(k,1816) - lu(k,1498) * lu(k,1812) + lu(k,1817) = lu(k,1817) - lu(k,1499) * lu(k,1812) + lu(k,1818) = lu(k,1818) - lu(k,1500) * lu(k,1812) + lu(k,1820) = lu(k,1820) - lu(k,1501) * lu(k,1812) + lu(k,1822) = lu(k,1822) - lu(k,1502) * lu(k,1812) + lu(k,1823) = lu(k,1823) - lu(k,1503) * lu(k,1812) + lu(k,1824) = lu(k,1824) - lu(k,1504) * lu(k,1812) + lu(k,1825) = lu(k,1825) - lu(k,1505) * lu(k,1812) + lu(k,1826) = lu(k,1826) - lu(k,1506) * lu(k,1812) + lu(k,1831) = lu(k,1831) - lu(k,1507) * lu(k,1812) + lu(k,1953) = lu(k,1953) - lu(k,1496) * lu(k,1952) + lu(k,1955) = lu(k,1955) - lu(k,1497) * lu(k,1952) + lu(k,1956) = lu(k,1956) - lu(k,1498) * lu(k,1952) + lu(k,1957) = lu(k,1957) - lu(k,1499) * lu(k,1952) + lu(k,1958) = lu(k,1958) - lu(k,1500) * lu(k,1952) + lu(k,1960) = lu(k,1960) - lu(k,1501) * lu(k,1952) + lu(k,1962) = lu(k,1962) - lu(k,1502) * lu(k,1952) + lu(k,1963) = lu(k,1963) - lu(k,1503) * lu(k,1952) + lu(k,1964) = lu(k,1964) - lu(k,1504) * lu(k,1952) + lu(k,1965) = lu(k,1965) - lu(k,1505) * lu(k,1952) + lu(k,1966) = lu(k,1966) - lu(k,1506) * lu(k,1952) + lu(k,1971) = lu(k,1971) - lu(k,1507) * lu(k,1952) + lu(k,1979) = lu(k,1979) - lu(k,1496) * lu(k,1978) + lu(k,1981) = lu(k,1981) - lu(k,1497) * lu(k,1978) + lu(k,1982) = - lu(k,1498) * lu(k,1978) + lu(k,1983) = lu(k,1983) - lu(k,1499) * lu(k,1978) + lu(k,1984) = lu(k,1984) - lu(k,1500) * lu(k,1978) + lu(k,1986) = lu(k,1986) - lu(k,1501) * lu(k,1978) + lu(k,1988) = lu(k,1988) - lu(k,1502) * lu(k,1978) + lu(k,1989) = lu(k,1989) - lu(k,1503) * lu(k,1978) + lu(k,1990) = lu(k,1990) - lu(k,1504) * lu(k,1978) + lu(k,1991) = lu(k,1991) - lu(k,1505) * lu(k,1978) + lu(k,1992) = lu(k,1992) - lu(k,1506) * lu(k,1978) + lu(k,1997) = lu(k,1997) - lu(k,1507) * lu(k,1978) + lu(k,2022) = lu(k,2022) - lu(k,1496) * lu(k,2021) + lu(k,2024) = lu(k,2024) - lu(k,1497) * lu(k,2021) + lu(k,2025) = lu(k,2025) - lu(k,1498) * lu(k,2021) + lu(k,2026) = lu(k,2026) - lu(k,1499) * lu(k,2021) + lu(k,2027) = lu(k,2027) - lu(k,1500) * lu(k,2021) + lu(k,2029) = - lu(k,1501) * lu(k,2021) + lu(k,2031) = lu(k,2031) - lu(k,1502) * lu(k,2021) + lu(k,2032) = lu(k,2032) - lu(k,1503) * lu(k,2021) + lu(k,2033) = lu(k,2033) - lu(k,1504) * lu(k,2021) + lu(k,2034) = lu(k,2034) - lu(k,1505) * lu(k,2021) + lu(k,2035) = lu(k,2035) - lu(k,1506) * lu(k,2021) + lu(k,2040) = lu(k,2040) - lu(k,1507) * lu(k,2021) + lu(k,2045) = - lu(k,1496) * lu(k,2044) + lu(k,2047) = - lu(k,1497) * lu(k,2044) + lu(k,2048) = - lu(k,1498) * lu(k,2044) + lu(k,2049) = lu(k,2049) - lu(k,1499) * lu(k,2044) + lu(k,2050) = lu(k,2050) - lu(k,1500) * lu(k,2044) + lu(k,2052) = lu(k,2052) - lu(k,1501) * lu(k,2044) + lu(k,2054) = lu(k,2054) - lu(k,1502) * lu(k,2044) + lu(k,2055) = lu(k,2055) - lu(k,1503) * lu(k,2044) + lu(k,2056) = lu(k,2056) - lu(k,1504) * lu(k,2044) + lu(k,2057) = lu(k,2057) - lu(k,1505) * lu(k,2044) + lu(k,2058) = lu(k,2058) - lu(k,1506) * lu(k,2044) + lu(k,2063) = lu(k,2063) - lu(k,1507) * lu(k,2044) + lu(k,2088) = lu(k,2088) - lu(k,1496) * lu(k,2087) + lu(k,2090) = lu(k,2090) - lu(k,1497) * lu(k,2087) + lu(k,2091) = lu(k,2091) - lu(k,1498) * lu(k,2087) + lu(k,2092) = lu(k,2092) - lu(k,1499) * lu(k,2087) + lu(k,2093) = lu(k,2093) - lu(k,1500) * lu(k,2087) + lu(k,2095) = lu(k,2095) - lu(k,1501) * lu(k,2087) + lu(k,2097) = lu(k,2097) - lu(k,1502) * lu(k,2087) + lu(k,2098) = lu(k,2098) - lu(k,1503) * lu(k,2087) + lu(k,2099) = lu(k,2099) - lu(k,1504) * lu(k,2087) + lu(k,2100) = lu(k,2100) - lu(k,1505) * lu(k,2087) + lu(k,2101) = lu(k,2101) - lu(k,1506) * lu(k,2087) + lu(k,2106) = lu(k,2106) - lu(k,1507) * lu(k,2087) + lu(k,2109) = - lu(k,1496) * lu(k,2108) + lu(k,2111) = - lu(k,1497) * lu(k,2108) + lu(k,2112) = - lu(k,1498) * lu(k,2108) + lu(k,2113) = lu(k,2113) - lu(k,1499) * lu(k,2108) + lu(k,2114) = lu(k,2114) - lu(k,1500) * lu(k,2108) + lu(k,2116) = - lu(k,1501) * lu(k,2108) + lu(k,2118) = lu(k,2118) - lu(k,1502) * lu(k,2108) + lu(k,2119) = lu(k,2119) - lu(k,1503) * lu(k,2108) + lu(k,2120) = lu(k,2120) - lu(k,1504) * lu(k,2108) + lu(k,2121) = lu(k,2121) - lu(k,1505) * lu(k,2108) + lu(k,2122) = lu(k,2122) - lu(k,1506) * lu(k,2108) + lu(k,2127) = lu(k,2127) - lu(k,1507) * lu(k,2108) + lu(k,2155) = lu(k,2155) - lu(k,1496) * lu(k,2154) + lu(k,2157) = - lu(k,1497) * lu(k,2154) + lu(k,2158) = lu(k,2158) - lu(k,1498) * lu(k,2154) + lu(k,2159) = lu(k,2159) - lu(k,1499) * lu(k,2154) + lu(k,2160) = lu(k,2160) - lu(k,1500) * lu(k,2154) + lu(k,2162) = lu(k,2162) - lu(k,1501) * lu(k,2154) + lu(k,2164) = lu(k,2164) - lu(k,1502) * lu(k,2154) + lu(k,2165) = lu(k,2165) - lu(k,1503) * lu(k,2154) + lu(k,2166) = lu(k,2166) - lu(k,1504) * lu(k,2154) + lu(k,2167) = lu(k,2167) - lu(k,1505) * lu(k,2154) + lu(k,2168) = lu(k,2168) - lu(k,1506) * lu(k,2154) + lu(k,2173) = lu(k,2173) - lu(k,1507) * lu(k,2154) + lu(k,2244) = - lu(k,1496) * lu(k,2243) + lu(k,2246) = - lu(k,1497) * lu(k,2243) + lu(k,2247) = - lu(k,1498) * lu(k,2243) + lu(k,2248) = lu(k,2248) - lu(k,1499) * lu(k,2243) + lu(k,2249) = lu(k,2249) - lu(k,1500) * lu(k,2243) + lu(k,2251) = lu(k,2251) - lu(k,1501) * lu(k,2243) + lu(k,2253) = lu(k,2253) - lu(k,1502) * lu(k,2243) + lu(k,2254) = lu(k,2254) - lu(k,1503) * lu(k,2243) + lu(k,2255) = lu(k,2255) - lu(k,1504) * lu(k,2243) + lu(k,2256) = lu(k,2256) - lu(k,1505) * lu(k,2243) + lu(k,2257) = lu(k,2257) - lu(k,1506) * lu(k,2243) + lu(k,2262) = lu(k,2262) - lu(k,1507) * lu(k,2243) + lu(k,2352) = lu(k,2352) - lu(k,1496) * lu(k,2351) + lu(k,2354) = lu(k,2354) - lu(k,1497) * lu(k,2351) + lu(k,2355) = lu(k,2355) - lu(k,1498) * lu(k,2351) + lu(k,2356) = lu(k,2356) - lu(k,1499) * lu(k,2351) + lu(k,2357) = lu(k,2357) - lu(k,1500) * lu(k,2351) + lu(k,2359) = lu(k,2359) - lu(k,1501) * lu(k,2351) + lu(k,2361) = lu(k,2361) - lu(k,1502) * lu(k,2351) + lu(k,2362) = lu(k,2362) - lu(k,1503) * lu(k,2351) + lu(k,2363) = lu(k,2363) - lu(k,1504) * lu(k,2351) + lu(k,2364) = lu(k,2364) - lu(k,1505) * lu(k,2351) + lu(k,2365) = lu(k,2365) - lu(k,1506) * lu(k,2351) + lu(k,2370) = lu(k,2370) - lu(k,1507) * lu(k,2351) + lu(k,2431) = lu(k,2431) - lu(k,1496) * lu(k,2430) + lu(k,2433) = lu(k,2433) - lu(k,1497) * lu(k,2430) + lu(k,2434) = lu(k,2434) - lu(k,1498) * lu(k,2430) + lu(k,2435) = lu(k,2435) - lu(k,1499) * lu(k,2430) + lu(k,2436) = lu(k,2436) - lu(k,1500) * lu(k,2430) + lu(k,2438) = lu(k,2438) - lu(k,1501) * lu(k,2430) + lu(k,2440) = lu(k,2440) - lu(k,1502) * lu(k,2430) + lu(k,2441) = lu(k,2441) - lu(k,1503) * lu(k,2430) + lu(k,2442) = lu(k,2442) - lu(k,1504) * lu(k,2430) + lu(k,2443) = lu(k,2443) - lu(k,1505) * lu(k,2430) + lu(k,2444) = lu(k,2444) - lu(k,1506) * lu(k,2430) + lu(k,2449) = lu(k,2449) - lu(k,1507) * lu(k,2430) + lu(k,1511) = 1._r8 / lu(k,1511) + lu(k,1512) = lu(k,1512) * lu(k,1511) + lu(k,1513) = lu(k,1513) * lu(k,1511) + lu(k,1514) = lu(k,1514) * lu(k,1511) + lu(k,1515) = lu(k,1515) * lu(k,1511) + lu(k,1516) = lu(k,1516) * lu(k,1511) + lu(k,1517) = lu(k,1517) * lu(k,1511) + lu(k,1518) = lu(k,1518) * lu(k,1511) + lu(k,1519) = lu(k,1519) * lu(k,1511) + lu(k,1520) = lu(k,1520) * lu(k,1511) + lu(k,1521) = lu(k,1521) * lu(k,1511) + lu(k,1522) = lu(k,1522) * lu(k,1511) + lu(k,1523) = lu(k,1523) * lu(k,1511) + lu(k,1542) = lu(k,1542) - lu(k,1512) * lu(k,1541) + lu(k,1543) = lu(k,1543) - lu(k,1513) * lu(k,1541) + lu(k,1545) = lu(k,1545) - lu(k,1514) * lu(k,1541) + lu(k,1546) = lu(k,1546) - lu(k,1515) * lu(k,1541) + lu(k,1547) = lu(k,1547) - lu(k,1516) * lu(k,1541) + lu(k,1548) = lu(k,1548) - lu(k,1517) * lu(k,1541) + lu(k,1549) = lu(k,1549) - lu(k,1518) * lu(k,1541) + lu(k,1550) = lu(k,1550) - lu(k,1519) * lu(k,1541) + lu(k,1551) = lu(k,1551) - lu(k,1520) * lu(k,1541) + lu(k,1553) = lu(k,1553) - lu(k,1521) * lu(k,1541) + lu(k,1554) = lu(k,1554) - lu(k,1522) * lu(k,1541) + lu(k,1555) = lu(k,1555) - lu(k,1523) * lu(k,1541) + lu(k,1564) = lu(k,1564) - lu(k,1512) * lu(k,1563) + lu(k,1565) = lu(k,1565) - lu(k,1513) * lu(k,1563) + lu(k,1568) = lu(k,1568) - lu(k,1514) * lu(k,1563) + lu(k,1569) = lu(k,1569) - lu(k,1515) * lu(k,1563) + lu(k,1570) = lu(k,1570) - lu(k,1516) * lu(k,1563) + lu(k,1571) = - lu(k,1517) * lu(k,1563) + lu(k,1572) = lu(k,1572) - lu(k,1518) * lu(k,1563) + lu(k,1574) = lu(k,1574) - lu(k,1519) * lu(k,1563) + lu(k,1575) = lu(k,1575) - lu(k,1520) * lu(k,1563) + lu(k,1577) = lu(k,1577) - lu(k,1521) * lu(k,1563) + lu(k,1578) = lu(k,1578) - lu(k,1522) * lu(k,1563) + lu(k,1579) = lu(k,1579) - lu(k,1523) * lu(k,1563) + lu(k,1590) = lu(k,1590) - lu(k,1512) * lu(k,1589) + lu(k,1591) = lu(k,1591) - lu(k,1513) * lu(k,1589) + lu(k,1594) = lu(k,1594) - lu(k,1514) * lu(k,1589) + lu(k,1595) = lu(k,1595) - lu(k,1515) * lu(k,1589) + lu(k,1596) = lu(k,1596) - lu(k,1516) * lu(k,1589) + lu(k,1597) = lu(k,1597) - lu(k,1517) * lu(k,1589) + lu(k,1598) = lu(k,1598) - lu(k,1518) * lu(k,1589) + lu(k,1600) = lu(k,1600) - lu(k,1519) * lu(k,1589) + lu(k,1601) = lu(k,1601) - lu(k,1520) * lu(k,1589) + lu(k,1603) = lu(k,1603) - lu(k,1521) * lu(k,1589) + lu(k,1604) = lu(k,1604) - lu(k,1522) * lu(k,1589) + lu(k,1606) = lu(k,1606) - lu(k,1523) * lu(k,1589) + lu(k,1649) = lu(k,1649) - lu(k,1512) * lu(k,1648) + lu(k,1650) = lu(k,1650) - lu(k,1513) * lu(k,1648) + lu(k,1653) = lu(k,1653) - lu(k,1514) * lu(k,1648) + lu(k,1654) = lu(k,1654) - lu(k,1515) * lu(k,1648) + lu(k,1655) = lu(k,1655) - lu(k,1516) * lu(k,1648) + lu(k,1656) = lu(k,1656) - lu(k,1517) * lu(k,1648) + lu(k,1657) = lu(k,1657) - lu(k,1518) * lu(k,1648) + lu(k,1659) = lu(k,1659) - lu(k,1519) * lu(k,1648) + lu(k,1660) = lu(k,1660) - lu(k,1520) * lu(k,1648) + lu(k,1662) = lu(k,1662) - lu(k,1521) * lu(k,1648) + lu(k,1664) = lu(k,1664) - lu(k,1522) * lu(k,1648) + lu(k,1666) = lu(k,1666) - lu(k,1523) * lu(k,1648) + lu(k,1814) = lu(k,1814) - lu(k,1512) * lu(k,1813) + lu(k,1815) = lu(k,1815) - lu(k,1513) * lu(k,1813) + lu(k,1818) = lu(k,1818) - lu(k,1514) * lu(k,1813) + lu(k,1819) = lu(k,1819) - lu(k,1515) * lu(k,1813) + lu(k,1820) = lu(k,1820) - lu(k,1516) * lu(k,1813) + lu(k,1821) = lu(k,1821) - lu(k,1517) * lu(k,1813) + lu(k,1822) = lu(k,1822) - lu(k,1518) * lu(k,1813) + lu(k,1824) = lu(k,1824) - lu(k,1519) * lu(k,1813) + lu(k,1825) = lu(k,1825) - lu(k,1520) * lu(k,1813) + lu(k,1827) = lu(k,1827) - lu(k,1521) * lu(k,1813) + lu(k,1829) = lu(k,1829) - lu(k,1522) * lu(k,1813) + lu(k,1831) = lu(k,1831) - lu(k,1523) * lu(k,1813) + lu(k,1909) = lu(k,1909) - lu(k,1512) * lu(k,1908) + lu(k,1910) = lu(k,1910) - lu(k,1513) * lu(k,1908) + lu(k,1913) = lu(k,1913) - lu(k,1514) * lu(k,1908) + lu(k,1914) = lu(k,1914) - lu(k,1515) * lu(k,1908) + lu(k,1915) = lu(k,1915) - lu(k,1516) * lu(k,1908) + lu(k,1916) = lu(k,1916) - lu(k,1517) * lu(k,1908) + lu(k,1917) = lu(k,1917) - lu(k,1518) * lu(k,1908) + lu(k,1919) = lu(k,1919) - lu(k,1519) * lu(k,1908) + lu(k,1920) = lu(k,1920) - lu(k,1520) * lu(k,1908) + lu(k,1922) = lu(k,1922) - lu(k,1521) * lu(k,1908) + lu(k,1924) = lu(k,1924) - lu(k,1522) * lu(k,1908) + lu(k,1926) = lu(k,1926) - lu(k,1523) * lu(k,1908) + lu(k,1954) = lu(k,1954) - lu(k,1512) * lu(k,1953) + lu(k,1955) = lu(k,1955) - lu(k,1513) * lu(k,1953) + lu(k,1958) = lu(k,1958) - lu(k,1514) * lu(k,1953) + lu(k,1959) = lu(k,1959) - lu(k,1515) * lu(k,1953) + lu(k,1960) = lu(k,1960) - lu(k,1516) * lu(k,1953) + lu(k,1961) = lu(k,1961) - lu(k,1517) * lu(k,1953) + lu(k,1962) = lu(k,1962) - lu(k,1518) * lu(k,1953) + lu(k,1964) = lu(k,1964) - lu(k,1519) * lu(k,1953) + lu(k,1965) = lu(k,1965) - lu(k,1520) * lu(k,1953) + lu(k,1967) = lu(k,1967) - lu(k,1521) * lu(k,1953) + lu(k,1969) = lu(k,1969) - lu(k,1522) * lu(k,1953) + lu(k,1971) = lu(k,1971) - lu(k,1523) * lu(k,1953) + lu(k,1980) = lu(k,1980) - lu(k,1512) * lu(k,1979) + lu(k,1981) = lu(k,1981) - lu(k,1513) * lu(k,1979) + lu(k,1984) = lu(k,1984) - lu(k,1514) * lu(k,1979) + lu(k,1985) = lu(k,1985) - lu(k,1515) * lu(k,1979) + lu(k,1986) = lu(k,1986) - lu(k,1516) * lu(k,1979) + lu(k,1987) = lu(k,1987) - lu(k,1517) * lu(k,1979) + lu(k,1988) = lu(k,1988) - lu(k,1518) * lu(k,1979) + lu(k,1990) = lu(k,1990) - lu(k,1519) * lu(k,1979) + lu(k,1991) = lu(k,1991) - lu(k,1520) * lu(k,1979) + lu(k,1993) = - lu(k,1521) * lu(k,1979) + lu(k,1995) = lu(k,1995) - lu(k,1522) * lu(k,1979) + lu(k,1997) = lu(k,1997) - lu(k,1523) * lu(k,1979) + lu(k,2023) = lu(k,2023) - lu(k,1512) * lu(k,2022) + lu(k,2024) = lu(k,2024) - lu(k,1513) * lu(k,2022) + lu(k,2027) = lu(k,2027) - lu(k,1514) * lu(k,2022) + lu(k,2028) = lu(k,2028) - lu(k,1515) * lu(k,2022) + lu(k,2029) = lu(k,2029) - lu(k,1516) * lu(k,2022) + lu(k,2030) = lu(k,2030) - lu(k,1517) * lu(k,2022) + lu(k,2031) = lu(k,2031) - lu(k,1518) * lu(k,2022) + lu(k,2033) = lu(k,2033) - lu(k,1519) * lu(k,2022) + lu(k,2034) = lu(k,2034) - lu(k,1520) * lu(k,2022) + lu(k,2036) = lu(k,2036) - lu(k,1521) * lu(k,2022) + lu(k,2038) = lu(k,2038) - lu(k,1522) * lu(k,2022) + lu(k,2040) = lu(k,2040) - lu(k,1523) * lu(k,2022) + lu(k,2046) = - lu(k,1512) * lu(k,2045) + lu(k,2047) = lu(k,2047) - lu(k,1513) * lu(k,2045) + lu(k,2050) = lu(k,2050) - lu(k,1514) * lu(k,2045) + lu(k,2051) = - lu(k,1515) * lu(k,2045) + lu(k,2052) = lu(k,2052) - lu(k,1516) * lu(k,2045) + lu(k,2053) = - lu(k,1517) * lu(k,2045) + lu(k,2054) = lu(k,2054) - lu(k,1518) * lu(k,2045) + lu(k,2056) = lu(k,2056) - lu(k,1519) * lu(k,2045) + lu(k,2057) = lu(k,2057) - lu(k,1520) * lu(k,2045) + lu(k,2059) = - lu(k,1521) * lu(k,2045) + lu(k,2061) = - lu(k,1522) * lu(k,2045) + lu(k,2063) = lu(k,2063) - lu(k,1523) * lu(k,2045) + lu(k,2089) = lu(k,2089) - lu(k,1512) * lu(k,2088) + lu(k,2090) = lu(k,2090) - lu(k,1513) * lu(k,2088) + lu(k,2093) = lu(k,2093) - lu(k,1514) * lu(k,2088) + lu(k,2094) = lu(k,2094) - lu(k,1515) * lu(k,2088) + lu(k,2095) = lu(k,2095) - lu(k,1516) * lu(k,2088) + lu(k,2096) = lu(k,2096) - lu(k,1517) * lu(k,2088) + lu(k,2097) = lu(k,2097) - lu(k,1518) * lu(k,2088) + lu(k,2099) = lu(k,2099) - lu(k,1519) * lu(k,2088) + lu(k,2100) = lu(k,2100) - lu(k,1520) * lu(k,2088) + lu(k,2102) = lu(k,2102) - lu(k,1521) * lu(k,2088) + lu(k,2104) = lu(k,2104) - lu(k,1522) * lu(k,2088) + lu(k,2106) = lu(k,2106) - lu(k,1523) * lu(k,2088) + lu(k,2110) = lu(k,2110) - lu(k,1512) * lu(k,2109) + lu(k,2111) = lu(k,2111) - lu(k,1513) * lu(k,2109) + lu(k,2114) = lu(k,2114) - lu(k,1514) * lu(k,2109) + lu(k,2115) = - lu(k,1515) * lu(k,2109) + lu(k,2116) = lu(k,2116) - lu(k,1516) * lu(k,2109) + lu(k,2117) = - lu(k,1517) * lu(k,2109) + lu(k,2118) = lu(k,2118) - lu(k,1518) * lu(k,2109) + lu(k,2120) = lu(k,2120) - lu(k,1519) * lu(k,2109) + lu(k,2121) = lu(k,2121) - lu(k,1520) * lu(k,2109) + lu(k,2123) = lu(k,2123) - lu(k,1521) * lu(k,2109) + lu(k,2125) = lu(k,2125) - lu(k,1522) * lu(k,2109) + lu(k,2127) = lu(k,2127) - lu(k,1523) * lu(k,2109) + lu(k,2156) = lu(k,2156) - lu(k,1512) * lu(k,2155) + lu(k,2157) = lu(k,2157) - lu(k,1513) * lu(k,2155) + lu(k,2160) = lu(k,2160) - lu(k,1514) * lu(k,2155) + lu(k,2161) = lu(k,2161) - lu(k,1515) * lu(k,2155) + lu(k,2162) = lu(k,2162) - lu(k,1516) * lu(k,2155) + lu(k,2163) = lu(k,2163) - lu(k,1517) * lu(k,2155) + lu(k,2164) = lu(k,2164) - lu(k,1518) * lu(k,2155) + lu(k,2166) = lu(k,2166) - lu(k,1519) * lu(k,2155) + lu(k,2167) = lu(k,2167) - lu(k,1520) * lu(k,2155) + lu(k,2169) = lu(k,2169) - lu(k,1521) * lu(k,2155) + lu(k,2171) = lu(k,2171) - lu(k,1522) * lu(k,2155) + lu(k,2173) = lu(k,2173) - lu(k,1523) * lu(k,2155) + lu(k,2220) = lu(k,2220) - lu(k,1512) * lu(k,2219) + lu(k,2221) = lu(k,2221) - lu(k,1513) * lu(k,2219) + lu(k,2224) = lu(k,2224) - lu(k,1514) * lu(k,2219) + lu(k,2225) = lu(k,2225) - lu(k,1515) * lu(k,2219) + lu(k,2226) = lu(k,2226) - lu(k,1516) * lu(k,2219) + lu(k,2227) = lu(k,2227) - lu(k,1517) * lu(k,2219) + lu(k,2228) = lu(k,2228) - lu(k,1518) * lu(k,2219) + lu(k,2230) = lu(k,2230) - lu(k,1519) * lu(k,2219) + lu(k,2231) = lu(k,2231) - lu(k,1520) * lu(k,2219) + lu(k,2233) = lu(k,2233) - lu(k,1521) * lu(k,2219) + lu(k,2235) = lu(k,2235) - lu(k,1522) * lu(k,2219) + lu(k,2237) = lu(k,2237) - lu(k,1523) * lu(k,2219) + lu(k,2245) = lu(k,2245) - lu(k,1512) * lu(k,2244) + lu(k,2246) = lu(k,2246) - lu(k,1513) * lu(k,2244) + lu(k,2249) = lu(k,2249) - lu(k,1514) * lu(k,2244) + lu(k,2250) = lu(k,2250) - lu(k,1515) * lu(k,2244) + lu(k,2251) = lu(k,2251) - lu(k,1516) * lu(k,2244) + lu(k,2252) = lu(k,2252) - lu(k,1517) * lu(k,2244) + lu(k,2253) = lu(k,2253) - lu(k,1518) * lu(k,2244) + lu(k,2255) = lu(k,2255) - lu(k,1519) * lu(k,2244) + lu(k,2256) = lu(k,2256) - lu(k,1520) * lu(k,2244) + lu(k,2258) = - lu(k,1521) * lu(k,2244) + lu(k,2260) = lu(k,2260) - lu(k,1522) * lu(k,2244) + lu(k,2262) = lu(k,2262) - lu(k,1523) * lu(k,2244) + lu(k,2353) = lu(k,2353) - lu(k,1512) * lu(k,2352) + lu(k,2354) = lu(k,2354) - lu(k,1513) * lu(k,2352) + lu(k,2357) = lu(k,2357) - lu(k,1514) * lu(k,2352) + lu(k,2358) = lu(k,2358) - lu(k,1515) * lu(k,2352) + lu(k,2359) = lu(k,2359) - lu(k,1516) * lu(k,2352) + lu(k,2360) = lu(k,2360) - lu(k,1517) * lu(k,2352) + lu(k,2361) = lu(k,2361) - lu(k,1518) * lu(k,2352) + lu(k,2363) = lu(k,2363) - lu(k,1519) * lu(k,2352) + lu(k,2364) = lu(k,2364) - lu(k,1520) * lu(k,2352) + lu(k,2366) = lu(k,2366) - lu(k,1521) * lu(k,2352) + lu(k,2368) = lu(k,2368) - lu(k,1522) * lu(k,2352) + lu(k,2370) = lu(k,2370) - lu(k,1523) * lu(k,2352) + lu(k,2432) = lu(k,2432) - lu(k,1512) * lu(k,2431) + lu(k,2433) = lu(k,2433) - lu(k,1513) * lu(k,2431) + lu(k,2436) = lu(k,2436) - lu(k,1514) * lu(k,2431) + lu(k,2437) = lu(k,2437) - lu(k,1515) * lu(k,2431) + lu(k,2438) = lu(k,2438) - lu(k,1516) * lu(k,2431) + lu(k,2439) = - lu(k,1517) * lu(k,2431) + lu(k,2440) = lu(k,2440) - lu(k,1518) * lu(k,2431) + lu(k,2442) = lu(k,2442) - lu(k,1519) * lu(k,2431) + lu(k,2443) = lu(k,2443) - lu(k,1520) * lu(k,2431) + lu(k,2445) = lu(k,2445) - lu(k,1521) * lu(k,2431) + lu(k,2447) = lu(k,2447) - lu(k,1522) * lu(k,2431) + lu(k,2449) = lu(k,2449) - lu(k,1523) * lu(k,2431) + end do + end subroutine lu_fac29 + subroutine lu_fac30( 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,1542) = 1._r8 / lu(k,1542) + lu(k,1543) = lu(k,1543) * lu(k,1542) + lu(k,1544) = lu(k,1544) * lu(k,1542) + lu(k,1545) = lu(k,1545) * lu(k,1542) + lu(k,1546) = lu(k,1546) * lu(k,1542) + lu(k,1547) = lu(k,1547) * lu(k,1542) + lu(k,1548) = lu(k,1548) * lu(k,1542) + lu(k,1549) = lu(k,1549) * lu(k,1542) + lu(k,1550) = lu(k,1550) * lu(k,1542) + lu(k,1551) = lu(k,1551) * lu(k,1542) + lu(k,1552) = lu(k,1552) * lu(k,1542) + lu(k,1553) = lu(k,1553) * lu(k,1542) + lu(k,1554) = lu(k,1554) * lu(k,1542) + lu(k,1555) = lu(k,1555) * lu(k,1542) + lu(k,1565) = lu(k,1565) - lu(k,1543) * lu(k,1564) + lu(k,1566) = lu(k,1566) - lu(k,1544) * lu(k,1564) + lu(k,1568) = lu(k,1568) - lu(k,1545) * lu(k,1564) + lu(k,1569) = lu(k,1569) - lu(k,1546) * lu(k,1564) + lu(k,1570) = lu(k,1570) - lu(k,1547) * lu(k,1564) + lu(k,1571) = lu(k,1571) - lu(k,1548) * lu(k,1564) + lu(k,1572) = lu(k,1572) - lu(k,1549) * lu(k,1564) + lu(k,1574) = lu(k,1574) - lu(k,1550) * lu(k,1564) + lu(k,1575) = lu(k,1575) - lu(k,1551) * lu(k,1564) + lu(k,1576) = lu(k,1576) - lu(k,1552) * lu(k,1564) + lu(k,1577) = lu(k,1577) - lu(k,1553) * lu(k,1564) + lu(k,1578) = lu(k,1578) - lu(k,1554) * lu(k,1564) + lu(k,1579) = lu(k,1579) - lu(k,1555) * lu(k,1564) + lu(k,1591) = lu(k,1591) - lu(k,1543) * lu(k,1590) + lu(k,1592) = lu(k,1592) - lu(k,1544) * lu(k,1590) + lu(k,1594) = lu(k,1594) - lu(k,1545) * lu(k,1590) + lu(k,1595) = lu(k,1595) - lu(k,1546) * lu(k,1590) + lu(k,1596) = lu(k,1596) - lu(k,1547) * lu(k,1590) + lu(k,1597) = lu(k,1597) - lu(k,1548) * lu(k,1590) + lu(k,1598) = lu(k,1598) - lu(k,1549) * lu(k,1590) + lu(k,1600) = lu(k,1600) - lu(k,1550) * lu(k,1590) + lu(k,1601) = lu(k,1601) - lu(k,1551) * lu(k,1590) + lu(k,1602) = lu(k,1602) - lu(k,1552) * lu(k,1590) + lu(k,1603) = lu(k,1603) - lu(k,1553) * lu(k,1590) + lu(k,1604) = lu(k,1604) - lu(k,1554) * lu(k,1590) + lu(k,1606) = lu(k,1606) - lu(k,1555) * lu(k,1590) + lu(k,1650) = lu(k,1650) - lu(k,1543) * lu(k,1649) + lu(k,1651) = lu(k,1651) - lu(k,1544) * lu(k,1649) + lu(k,1653) = lu(k,1653) - lu(k,1545) * lu(k,1649) + lu(k,1654) = lu(k,1654) - lu(k,1546) * lu(k,1649) + lu(k,1655) = lu(k,1655) - lu(k,1547) * lu(k,1649) + lu(k,1656) = lu(k,1656) - lu(k,1548) * lu(k,1649) + lu(k,1657) = lu(k,1657) - lu(k,1549) * lu(k,1649) + lu(k,1659) = lu(k,1659) - lu(k,1550) * lu(k,1649) + lu(k,1660) = lu(k,1660) - lu(k,1551) * lu(k,1649) + lu(k,1661) = lu(k,1661) - lu(k,1552) * lu(k,1649) + lu(k,1662) = lu(k,1662) - lu(k,1553) * lu(k,1649) + lu(k,1664) = lu(k,1664) - lu(k,1554) * lu(k,1649) + lu(k,1666) = lu(k,1666) - lu(k,1555) * lu(k,1649) + lu(k,1815) = lu(k,1815) - lu(k,1543) * lu(k,1814) + lu(k,1816) = lu(k,1816) - lu(k,1544) * lu(k,1814) + lu(k,1818) = lu(k,1818) - lu(k,1545) * lu(k,1814) + lu(k,1819) = lu(k,1819) - lu(k,1546) * lu(k,1814) + lu(k,1820) = lu(k,1820) - lu(k,1547) * lu(k,1814) + lu(k,1821) = lu(k,1821) - lu(k,1548) * lu(k,1814) + lu(k,1822) = lu(k,1822) - lu(k,1549) * lu(k,1814) + lu(k,1824) = lu(k,1824) - lu(k,1550) * lu(k,1814) + lu(k,1825) = lu(k,1825) - lu(k,1551) * lu(k,1814) + lu(k,1826) = lu(k,1826) - lu(k,1552) * lu(k,1814) + lu(k,1827) = lu(k,1827) - lu(k,1553) * lu(k,1814) + lu(k,1829) = lu(k,1829) - lu(k,1554) * lu(k,1814) + lu(k,1831) = lu(k,1831) - lu(k,1555) * lu(k,1814) + lu(k,1910) = lu(k,1910) - lu(k,1543) * lu(k,1909) + lu(k,1911) = lu(k,1911) - lu(k,1544) * lu(k,1909) + lu(k,1913) = lu(k,1913) - lu(k,1545) * lu(k,1909) + lu(k,1914) = lu(k,1914) - lu(k,1546) * lu(k,1909) + lu(k,1915) = lu(k,1915) - lu(k,1547) * lu(k,1909) + lu(k,1916) = lu(k,1916) - lu(k,1548) * lu(k,1909) + lu(k,1917) = lu(k,1917) - lu(k,1549) * lu(k,1909) + lu(k,1919) = lu(k,1919) - lu(k,1550) * lu(k,1909) + lu(k,1920) = lu(k,1920) - lu(k,1551) * lu(k,1909) + lu(k,1921) = lu(k,1921) - lu(k,1552) * lu(k,1909) + lu(k,1922) = lu(k,1922) - lu(k,1553) * lu(k,1909) + lu(k,1924) = lu(k,1924) - lu(k,1554) * lu(k,1909) + lu(k,1926) = lu(k,1926) - lu(k,1555) * lu(k,1909) + lu(k,1955) = lu(k,1955) - lu(k,1543) * lu(k,1954) + lu(k,1956) = lu(k,1956) - lu(k,1544) * lu(k,1954) + lu(k,1958) = lu(k,1958) - lu(k,1545) * lu(k,1954) + lu(k,1959) = lu(k,1959) - lu(k,1546) * lu(k,1954) + lu(k,1960) = lu(k,1960) - lu(k,1547) * lu(k,1954) + lu(k,1961) = lu(k,1961) - lu(k,1548) * lu(k,1954) + lu(k,1962) = lu(k,1962) - lu(k,1549) * lu(k,1954) + lu(k,1964) = lu(k,1964) - lu(k,1550) * lu(k,1954) + lu(k,1965) = lu(k,1965) - lu(k,1551) * lu(k,1954) + lu(k,1966) = lu(k,1966) - lu(k,1552) * lu(k,1954) + lu(k,1967) = lu(k,1967) - lu(k,1553) * lu(k,1954) + lu(k,1969) = lu(k,1969) - lu(k,1554) * lu(k,1954) + lu(k,1971) = lu(k,1971) - lu(k,1555) * lu(k,1954) + lu(k,1981) = lu(k,1981) - lu(k,1543) * lu(k,1980) + lu(k,1982) = lu(k,1982) - lu(k,1544) * lu(k,1980) + lu(k,1984) = lu(k,1984) - lu(k,1545) * lu(k,1980) + lu(k,1985) = lu(k,1985) - lu(k,1546) * lu(k,1980) + lu(k,1986) = lu(k,1986) - lu(k,1547) * lu(k,1980) + lu(k,1987) = lu(k,1987) - lu(k,1548) * lu(k,1980) + lu(k,1988) = lu(k,1988) - lu(k,1549) * lu(k,1980) + lu(k,1990) = lu(k,1990) - lu(k,1550) * lu(k,1980) + lu(k,1991) = lu(k,1991) - lu(k,1551) * lu(k,1980) + lu(k,1992) = lu(k,1992) - lu(k,1552) * lu(k,1980) + lu(k,1993) = lu(k,1993) - lu(k,1553) * lu(k,1980) + lu(k,1995) = lu(k,1995) - lu(k,1554) * lu(k,1980) + lu(k,1997) = lu(k,1997) - lu(k,1555) * lu(k,1980) + lu(k,2024) = lu(k,2024) - lu(k,1543) * lu(k,2023) + lu(k,2025) = lu(k,2025) - lu(k,1544) * lu(k,2023) + lu(k,2027) = lu(k,2027) - lu(k,1545) * lu(k,2023) + lu(k,2028) = lu(k,2028) - lu(k,1546) * lu(k,2023) + lu(k,2029) = lu(k,2029) - lu(k,1547) * lu(k,2023) + lu(k,2030) = lu(k,2030) - lu(k,1548) * lu(k,2023) + lu(k,2031) = lu(k,2031) - lu(k,1549) * lu(k,2023) + lu(k,2033) = lu(k,2033) - lu(k,1550) * lu(k,2023) + lu(k,2034) = lu(k,2034) - lu(k,1551) * lu(k,2023) + lu(k,2035) = lu(k,2035) - lu(k,1552) * lu(k,2023) + lu(k,2036) = lu(k,2036) - lu(k,1553) * lu(k,2023) + lu(k,2038) = lu(k,2038) - lu(k,1554) * lu(k,2023) + lu(k,2040) = lu(k,2040) - lu(k,1555) * lu(k,2023) + lu(k,2047) = lu(k,2047) - lu(k,1543) * lu(k,2046) + lu(k,2048) = lu(k,2048) - lu(k,1544) * lu(k,2046) + lu(k,2050) = lu(k,2050) - lu(k,1545) * lu(k,2046) + lu(k,2051) = lu(k,2051) - lu(k,1546) * lu(k,2046) + lu(k,2052) = lu(k,2052) - lu(k,1547) * lu(k,2046) + lu(k,2053) = lu(k,2053) - lu(k,1548) * lu(k,2046) + lu(k,2054) = lu(k,2054) - lu(k,1549) * lu(k,2046) + lu(k,2056) = lu(k,2056) - lu(k,1550) * lu(k,2046) + lu(k,2057) = lu(k,2057) - lu(k,1551) * lu(k,2046) + lu(k,2058) = lu(k,2058) - lu(k,1552) * lu(k,2046) + lu(k,2059) = lu(k,2059) - lu(k,1553) * lu(k,2046) + lu(k,2061) = lu(k,2061) - lu(k,1554) * lu(k,2046) + lu(k,2063) = lu(k,2063) - lu(k,1555) * lu(k,2046) + lu(k,2090) = lu(k,2090) - lu(k,1543) * lu(k,2089) + lu(k,2091) = lu(k,2091) - lu(k,1544) * lu(k,2089) + lu(k,2093) = lu(k,2093) - lu(k,1545) * lu(k,2089) + lu(k,2094) = lu(k,2094) - lu(k,1546) * lu(k,2089) + lu(k,2095) = lu(k,2095) - lu(k,1547) * lu(k,2089) + lu(k,2096) = lu(k,2096) - lu(k,1548) * lu(k,2089) + lu(k,2097) = lu(k,2097) - lu(k,1549) * lu(k,2089) + lu(k,2099) = lu(k,2099) - lu(k,1550) * lu(k,2089) + lu(k,2100) = lu(k,2100) - lu(k,1551) * lu(k,2089) + lu(k,2101) = lu(k,2101) - lu(k,1552) * lu(k,2089) + lu(k,2102) = lu(k,2102) - lu(k,1553) * lu(k,2089) + lu(k,2104) = lu(k,2104) - lu(k,1554) * lu(k,2089) + lu(k,2106) = lu(k,2106) - lu(k,1555) * lu(k,2089) + lu(k,2111) = lu(k,2111) - lu(k,1543) * lu(k,2110) + lu(k,2112) = lu(k,2112) - lu(k,1544) * lu(k,2110) + lu(k,2114) = lu(k,2114) - lu(k,1545) * lu(k,2110) + lu(k,2115) = lu(k,2115) - lu(k,1546) * lu(k,2110) + lu(k,2116) = lu(k,2116) - lu(k,1547) * lu(k,2110) + lu(k,2117) = lu(k,2117) - lu(k,1548) * lu(k,2110) + lu(k,2118) = lu(k,2118) - lu(k,1549) * lu(k,2110) + lu(k,2120) = lu(k,2120) - lu(k,1550) * lu(k,2110) + lu(k,2121) = lu(k,2121) - lu(k,1551) * lu(k,2110) + lu(k,2122) = lu(k,2122) - lu(k,1552) * lu(k,2110) + lu(k,2123) = lu(k,2123) - lu(k,1553) * lu(k,2110) + lu(k,2125) = lu(k,2125) - lu(k,1554) * lu(k,2110) + lu(k,2127) = lu(k,2127) - lu(k,1555) * lu(k,2110) + lu(k,2157) = lu(k,2157) - lu(k,1543) * lu(k,2156) + lu(k,2158) = lu(k,2158) - lu(k,1544) * lu(k,2156) + lu(k,2160) = lu(k,2160) - lu(k,1545) * lu(k,2156) + lu(k,2161) = lu(k,2161) - lu(k,1546) * lu(k,2156) + lu(k,2162) = lu(k,2162) - lu(k,1547) * lu(k,2156) + lu(k,2163) = lu(k,2163) - lu(k,1548) * lu(k,2156) + lu(k,2164) = lu(k,2164) - lu(k,1549) * lu(k,2156) + lu(k,2166) = lu(k,2166) - lu(k,1550) * lu(k,2156) + lu(k,2167) = lu(k,2167) - lu(k,1551) * lu(k,2156) + lu(k,2168) = lu(k,2168) - lu(k,1552) * lu(k,2156) + lu(k,2169) = lu(k,2169) - lu(k,1553) * lu(k,2156) + lu(k,2171) = lu(k,2171) - lu(k,1554) * lu(k,2156) + lu(k,2173) = lu(k,2173) - lu(k,1555) * lu(k,2156) + lu(k,2221) = lu(k,2221) - lu(k,1543) * lu(k,2220) + lu(k,2222) = lu(k,2222) - lu(k,1544) * lu(k,2220) + lu(k,2224) = lu(k,2224) - lu(k,1545) * lu(k,2220) + lu(k,2225) = lu(k,2225) - lu(k,1546) * lu(k,2220) + lu(k,2226) = lu(k,2226) - lu(k,1547) * lu(k,2220) + lu(k,2227) = lu(k,2227) - lu(k,1548) * lu(k,2220) + lu(k,2228) = lu(k,2228) - lu(k,1549) * lu(k,2220) + lu(k,2230) = lu(k,2230) - lu(k,1550) * lu(k,2220) + lu(k,2231) = lu(k,2231) - lu(k,1551) * lu(k,2220) + lu(k,2232) = lu(k,2232) - lu(k,1552) * lu(k,2220) + lu(k,2233) = lu(k,2233) - lu(k,1553) * lu(k,2220) + lu(k,2235) = lu(k,2235) - lu(k,1554) * lu(k,2220) + lu(k,2237) = lu(k,2237) - lu(k,1555) * lu(k,2220) + lu(k,2246) = lu(k,2246) - lu(k,1543) * lu(k,2245) + lu(k,2247) = lu(k,2247) - lu(k,1544) * lu(k,2245) + lu(k,2249) = lu(k,2249) - lu(k,1545) * lu(k,2245) + lu(k,2250) = lu(k,2250) - lu(k,1546) * lu(k,2245) + lu(k,2251) = lu(k,2251) - lu(k,1547) * lu(k,2245) + lu(k,2252) = lu(k,2252) - lu(k,1548) * lu(k,2245) + lu(k,2253) = lu(k,2253) - lu(k,1549) * lu(k,2245) + lu(k,2255) = lu(k,2255) - lu(k,1550) * lu(k,2245) + lu(k,2256) = lu(k,2256) - lu(k,1551) * lu(k,2245) + lu(k,2257) = lu(k,2257) - lu(k,1552) * lu(k,2245) + lu(k,2258) = lu(k,2258) - lu(k,1553) * lu(k,2245) + lu(k,2260) = lu(k,2260) - lu(k,1554) * lu(k,2245) + lu(k,2262) = lu(k,2262) - lu(k,1555) * lu(k,2245) + lu(k,2354) = lu(k,2354) - lu(k,1543) * lu(k,2353) + lu(k,2355) = lu(k,2355) - lu(k,1544) * lu(k,2353) + lu(k,2357) = lu(k,2357) - lu(k,1545) * lu(k,2353) + lu(k,2358) = lu(k,2358) - lu(k,1546) * lu(k,2353) + lu(k,2359) = lu(k,2359) - lu(k,1547) * lu(k,2353) + lu(k,2360) = lu(k,2360) - lu(k,1548) * lu(k,2353) + lu(k,2361) = lu(k,2361) - lu(k,1549) * lu(k,2353) + lu(k,2363) = lu(k,2363) - lu(k,1550) * lu(k,2353) + lu(k,2364) = lu(k,2364) - lu(k,1551) * lu(k,2353) + lu(k,2365) = lu(k,2365) - lu(k,1552) * lu(k,2353) + lu(k,2366) = lu(k,2366) - lu(k,1553) * lu(k,2353) + lu(k,2368) = lu(k,2368) - lu(k,1554) * lu(k,2353) + lu(k,2370) = lu(k,2370) - lu(k,1555) * lu(k,2353) + lu(k,2406) = - lu(k,1543) * lu(k,2405) + lu(k,2407) = lu(k,2407) - lu(k,1544) * lu(k,2405) + lu(k,2409) = lu(k,2409) - lu(k,1545) * lu(k,2405) + lu(k,2410) = lu(k,2410) - lu(k,1546) * lu(k,2405) + lu(k,2411) = lu(k,2411) - lu(k,1547) * lu(k,2405) + lu(k,2412) = lu(k,2412) - lu(k,1548) * lu(k,2405) + lu(k,2413) = lu(k,2413) - lu(k,1549) * lu(k,2405) + lu(k,2415) = lu(k,2415) - lu(k,1550) * lu(k,2405) + lu(k,2416) = lu(k,2416) - lu(k,1551) * lu(k,2405) + lu(k,2417) = lu(k,2417) - lu(k,1552) * lu(k,2405) + lu(k,2418) = lu(k,2418) - lu(k,1553) * lu(k,2405) + lu(k,2420) = lu(k,2420) - lu(k,1554) * lu(k,2405) + lu(k,2422) = lu(k,2422) - lu(k,1555) * lu(k,2405) + lu(k,2433) = lu(k,2433) - lu(k,1543) * lu(k,2432) + lu(k,2434) = lu(k,2434) - lu(k,1544) * lu(k,2432) + lu(k,2436) = lu(k,2436) - lu(k,1545) * lu(k,2432) + lu(k,2437) = lu(k,2437) - lu(k,1546) * lu(k,2432) + lu(k,2438) = lu(k,2438) - lu(k,1547) * lu(k,2432) + lu(k,2439) = lu(k,2439) - lu(k,1548) * lu(k,2432) + lu(k,2440) = lu(k,2440) - lu(k,1549) * lu(k,2432) + lu(k,2442) = lu(k,2442) - lu(k,1550) * lu(k,2432) + lu(k,2443) = lu(k,2443) - lu(k,1551) * lu(k,2432) + lu(k,2444) = lu(k,2444) - lu(k,1552) * lu(k,2432) + lu(k,2445) = lu(k,2445) - lu(k,1553) * lu(k,2432) + lu(k,2447) = lu(k,2447) - lu(k,1554) * lu(k,2432) + lu(k,2449) = lu(k,2449) - lu(k,1555) * lu(k,2432) + lu(k,1565) = 1._r8 / lu(k,1565) + lu(k,1566) = lu(k,1566) * lu(k,1565) + lu(k,1567) = lu(k,1567) * lu(k,1565) + lu(k,1568) = lu(k,1568) * lu(k,1565) + lu(k,1569) = lu(k,1569) * lu(k,1565) + lu(k,1570) = lu(k,1570) * lu(k,1565) + lu(k,1571) = lu(k,1571) * lu(k,1565) + lu(k,1572) = lu(k,1572) * lu(k,1565) + lu(k,1573) = lu(k,1573) * lu(k,1565) + lu(k,1574) = lu(k,1574) * lu(k,1565) + lu(k,1575) = lu(k,1575) * lu(k,1565) + lu(k,1576) = lu(k,1576) * lu(k,1565) + lu(k,1577) = lu(k,1577) * lu(k,1565) + lu(k,1578) = lu(k,1578) * lu(k,1565) + lu(k,1579) = lu(k,1579) * lu(k,1565) + lu(k,1592) = lu(k,1592) - lu(k,1566) * lu(k,1591) + lu(k,1593) = lu(k,1593) - lu(k,1567) * lu(k,1591) + lu(k,1594) = lu(k,1594) - lu(k,1568) * lu(k,1591) + lu(k,1595) = lu(k,1595) - lu(k,1569) * lu(k,1591) + lu(k,1596) = lu(k,1596) - lu(k,1570) * lu(k,1591) + lu(k,1597) = lu(k,1597) - lu(k,1571) * lu(k,1591) + lu(k,1598) = lu(k,1598) - lu(k,1572) * lu(k,1591) + lu(k,1599) = lu(k,1599) - lu(k,1573) * lu(k,1591) + lu(k,1600) = lu(k,1600) - lu(k,1574) * lu(k,1591) + lu(k,1601) = lu(k,1601) - lu(k,1575) * lu(k,1591) + lu(k,1602) = lu(k,1602) - lu(k,1576) * lu(k,1591) + lu(k,1603) = lu(k,1603) - lu(k,1577) * lu(k,1591) + lu(k,1604) = lu(k,1604) - lu(k,1578) * lu(k,1591) + lu(k,1606) = lu(k,1606) - lu(k,1579) * lu(k,1591) + lu(k,1651) = lu(k,1651) - lu(k,1566) * lu(k,1650) + lu(k,1652) = lu(k,1652) - lu(k,1567) * lu(k,1650) + lu(k,1653) = lu(k,1653) - lu(k,1568) * lu(k,1650) + lu(k,1654) = lu(k,1654) - lu(k,1569) * lu(k,1650) + lu(k,1655) = lu(k,1655) - lu(k,1570) * lu(k,1650) + lu(k,1656) = lu(k,1656) - lu(k,1571) * lu(k,1650) + lu(k,1657) = lu(k,1657) - lu(k,1572) * lu(k,1650) + lu(k,1658) = lu(k,1658) - lu(k,1573) * lu(k,1650) + lu(k,1659) = lu(k,1659) - lu(k,1574) * lu(k,1650) + lu(k,1660) = lu(k,1660) - lu(k,1575) * lu(k,1650) + lu(k,1661) = lu(k,1661) - lu(k,1576) * lu(k,1650) + lu(k,1662) = lu(k,1662) - lu(k,1577) * lu(k,1650) + lu(k,1664) = lu(k,1664) - lu(k,1578) * lu(k,1650) + lu(k,1666) = lu(k,1666) - lu(k,1579) * lu(k,1650) + lu(k,1816) = lu(k,1816) - lu(k,1566) * lu(k,1815) + lu(k,1817) = lu(k,1817) - lu(k,1567) * lu(k,1815) + lu(k,1818) = lu(k,1818) - lu(k,1568) * lu(k,1815) + lu(k,1819) = lu(k,1819) - lu(k,1569) * lu(k,1815) + lu(k,1820) = lu(k,1820) - lu(k,1570) * lu(k,1815) + lu(k,1821) = lu(k,1821) - lu(k,1571) * lu(k,1815) + lu(k,1822) = lu(k,1822) - lu(k,1572) * lu(k,1815) + lu(k,1823) = lu(k,1823) - lu(k,1573) * lu(k,1815) + lu(k,1824) = lu(k,1824) - lu(k,1574) * lu(k,1815) + lu(k,1825) = lu(k,1825) - lu(k,1575) * lu(k,1815) + lu(k,1826) = lu(k,1826) - lu(k,1576) * lu(k,1815) + lu(k,1827) = lu(k,1827) - lu(k,1577) * lu(k,1815) + lu(k,1829) = lu(k,1829) - lu(k,1578) * lu(k,1815) + lu(k,1831) = lu(k,1831) - lu(k,1579) * lu(k,1815) + lu(k,1911) = lu(k,1911) - lu(k,1566) * lu(k,1910) + lu(k,1912) = lu(k,1912) - lu(k,1567) * lu(k,1910) + lu(k,1913) = lu(k,1913) - lu(k,1568) * lu(k,1910) + lu(k,1914) = lu(k,1914) - lu(k,1569) * lu(k,1910) + lu(k,1915) = lu(k,1915) - lu(k,1570) * lu(k,1910) + lu(k,1916) = lu(k,1916) - lu(k,1571) * lu(k,1910) + lu(k,1917) = lu(k,1917) - lu(k,1572) * lu(k,1910) + lu(k,1918) = lu(k,1918) - lu(k,1573) * lu(k,1910) + lu(k,1919) = lu(k,1919) - lu(k,1574) * lu(k,1910) + lu(k,1920) = lu(k,1920) - lu(k,1575) * lu(k,1910) + lu(k,1921) = lu(k,1921) - lu(k,1576) * lu(k,1910) + lu(k,1922) = lu(k,1922) - lu(k,1577) * lu(k,1910) + lu(k,1924) = lu(k,1924) - lu(k,1578) * lu(k,1910) + lu(k,1926) = lu(k,1926) - lu(k,1579) * lu(k,1910) + lu(k,1956) = lu(k,1956) - lu(k,1566) * lu(k,1955) + lu(k,1957) = lu(k,1957) - lu(k,1567) * lu(k,1955) + lu(k,1958) = lu(k,1958) - lu(k,1568) * lu(k,1955) + lu(k,1959) = lu(k,1959) - lu(k,1569) * lu(k,1955) + lu(k,1960) = lu(k,1960) - lu(k,1570) * lu(k,1955) + lu(k,1961) = lu(k,1961) - lu(k,1571) * lu(k,1955) + lu(k,1962) = lu(k,1962) - lu(k,1572) * lu(k,1955) + lu(k,1963) = lu(k,1963) - lu(k,1573) * lu(k,1955) + lu(k,1964) = lu(k,1964) - lu(k,1574) * lu(k,1955) + lu(k,1965) = lu(k,1965) - lu(k,1575) * lu(k,1955) + lu(k,1966) = lu(k,1966) - lu(k,1576) * lu(k,1955) + lu(k,1967) = lu(k,1967) - lu(k,1577) * lu(k,1955) + lu(k,1969) = lu(k,1969) - lu(k,1578) * lu(k,1955) + lu(k,1971) = lu(k,1971) - lu(k,1579) * lu(k,1955) + lu(k,1982) = lu(k,1982) - lu(k,1566) * lu(k,1981) + lu(k,1983) = lu(k,1983) - lu(k,1567) * lu(k,1981) + lu(k,1984) = lu(k,1984) - lu(k,1568) * lu(k,1981) + lu(k,1985) = lu(k,1985) - lu(k,1569) * lu(k,1981) + lu(k,1986) = lu(k,1986) - lu(k,1570) * lu(k,1981) + lu(k,1987) = lu(k,1987) - lu(k,1571) * lu(k,1981) + lu(k,1988) = lu(k,1988) - lu(k,1572) * lu(k,1981) + lu(k,1989) = lu(k,1989) - lu(k,1573) * lu(k,1981) + lu(k,1990) = lu(k,1990) - lu(k,1574) * lu(k,1981) + lu(k,1991) = lu(k,1991) - lu(k,1575) * lu(k,1981) + lu(k,1992) = lu(k,1992) - lu(k,1576) * lu(k,1981) + lu(k,1993) = lu(k,1993) - lu(k,1577) * lu(k,1981) + lu(k,1995) = lu(k,1995) - lu(k,1578) * lu(k,1981) + lu(k,1997) = lu(k,1997) - lu(k,1579) * lu(k,1981) + lu(k,2025) = lu(k,2025) - lu(k,1566) * lu(k,2024) + lu(k,2026) = lu(k,2026) - lu(k,1567) * lu(k,2024) + lu(k,2027) = lu(k,2027) - lu(k,1568) * lu(k,2024) + lu(k,2028) = lu(k,2028) - lu(k,1569) * lu(k,2024) + lu(k,2029) = lu(k,2029) - lu(k,1570) * lu(k,2024) + lu(k,2030) = lu(k,2030) - lu(k,1571) * lu(k,2024) + lu(k,2031) = lu(k,2031) - lu(k,1572) * lu(k,2024) + lu(k,2032) = lu(k,2032) - lu(k,1573) * lu(k,2024) + lu(k,2033) = lu(k,2033) - lu(k,1574) * lu(k,2024) + lu(k,2034) = lu(k,2034) - lu(k,1575) * lu(k,2024) + lu(k,2035) = lu(k,2035) - lu(k,1576) * lu(k,2024) + lu(k,2036) = lu(k,2036) - lu(k,1577) * lu(k,2024) + lu(k,2038) = lu(k,2038) - lu(k,1578) * lu(k,2024) + lu(k,2040) = lu(k,2040) - lu(k,1579) * lu(k,2024) + lu(k,2048) = lu(k,2048) - lu(k,1566) * lu(k,2047) + lu(k,2049) = lu(k,2049) - lu(k,1567) * lu(k,2047) + lu(k,2050) = lu(k,2050) - lu(k,1568) * lu(k,2047) + lu(k,2051) = lu(k,2051) - lu(k,1569) * lu(k,2047) + lu(k,2052) = lu(k,2052) - lu(k,1570) * lu(k,2047) + lu(k,2053) = lu(k,2053) - lu(k,1571) * lu(k,2047) + lu(k,2054) = lu(k,2054) - lu(k,1572) * lu(k,2047) + lu(k,2055) = lu(k,2055) - lu(k,1573) * lu(k,2047) + lu(k,2056) = lu(k,2056) - lu(k,1574) * lu(k,2047) + lu(k,2057) = lu(k,2057) - lu(k,1575) * lu(k,2047) + lu(k,2058) = lu(k,2058) - lu(k,1576) * lu(k,2047) + lu(k,2059) = lu(k,2059) - lu(k,1577) * lu(k,2047) + lu(k,2061) = lu(k,2061) - lu(k,1578) * lu(k,2047) + lu(k,2063) = lu(k,2063) - lu(k,1579) * lu(k,2047) + lu(k,2091) = lu(k,2091) - lu(k,1566) * lu(k,2090) + lu(k,2092) = lu(k,2092) - lu(k,1567) * lu(k,2090) + lu(k,2093) = lu(k,2093) - lu(k,1568) * lu(k,2090) + lu(k,2094) = lu(k,2094) - lu(k,1569) * lu(k,2090) + lu(k,2095) = lu(k,2095) - lu(k,1570) * lu(k,2090) + lu(k,2096) = lu(k,2096) - lu(k,1571) * lu(k,2090) + lu(k,2097) = lu(k,2097) - lu(k,1572) * lu(k,2090) + lu(k,2098) = lu(k,2098) - lu(k,1573) * lu(k,2090) + lu(k,2099) = lu(k,2099) - lu(k,1574) * lu(k,2090) + lu(k,2100) = lu(k,2100) - lu(k,1575) * lu(k,2090) + lu(k,2101) = lu(k,2101) - lu(k,1576) * lu(k,2090) + lu(k,2102) = lu(k,2102) - lu(k,1577) * lu(k,2090) + lu(k,2104) = lu(k,2104) - lu(k,1578) * lu(k,2090) + lu(k,2106) = lu(k,2106) - lu(k,1579) * lu(k,2090) + lu(k,2112) = lu(k,2112) - lu(k,1566) * lu(k,2111) + lu(k,2113) = lu(k,2113) - lu(k,1567) * lu(k,2111) + lu(k,2114) = lu(k,2114) - lu(k,1568) * lu(k,2111) + lu(k,2115) = lu(k,2115) - lu(k,1569) * lu(k,2111) + lu(k,2116) = lu(k,2116) - lu(k,1570) * lu(k,2111) + lu(k,2117) = lu(k,2117) - lu(k,1571) * lu(k,2111) + lu(k,2118) = lu(k,2118) - lu(k,1572) * lu(k,2111) + lu(k,2119) = lu(k,2119) - lu(k,1573) * lu(k,2111) + lu(k,2120) = lu(k,2120) - lu(k,1574) * lu(k,2111) + lu(k,2121) = lu(k,2121) - lu(k,1575) * lu(k,2111) + lu(k,2122) = lu(k,2122) - lu(k,1576) * lu(k,2111) + lu(k,2123) = lu(k,2123) - lu(k,1577) * lu(k,2111) + lu(k,2125) = lu(k,2125) - lu(k,1578) * lu(k,2111) + lu(k,2127) = lu(k,2127) - lu(k,1579) * lu(k,2111) + lu(k,2158) = lu(k,2158) - lu(k,1566) * lu(k,2157) + lu(k,2159) = lu(k,2159) - lu(k,1567) * lu(k,2157) + lu(k,2160) = lu(k,2160) - lu(k,1568) * lu(k,2157) + lu(k,2161) = lu(k,2161) - lu(k,1569) * lu(k,2157) + lu(k,2162) = lu(k,2162) - lu(k,1570) * lu(k,2157) + lu(k,2163) = lu(k,2163) - lu(k,1571) * lu(k,2157) + lu(k,2164) = lu(k,2164) - lu(k,1572) * lu(k,2157) + lu(k,2165) = lu(k,2165) - lu(k,1573) * lu(k,2157) + lu(k,2166) = lu(k,2166) - lu(k,1574) * lu(k,2157) + lu(k,2167) = lu(k,2167) - lu(k,1575) * lu(k,2157) + lu(k,2168) = lu(k,2168) - lu(k,1576) * lu(k,2157) + lu(k,2169) = lu(k,2169) - lu(k,1577) * lu(k,2157) + lu(k,2171) = lu(k,2171) - lu(k,1578) * lu(k,2157) + lu(k,2173) = lu(k,2173) - lu(k,1579) * lu(k,2157) + lu(k,2222) = lu(k,2222) - lu(k,1566) * lu(k,2221) + lu(k,2223) = lu(k,2223) - lu(k,1567) * lu(k,2221) + lu(k,2224) = lu(k,2224) - lu(k,1568) * lu(k,2221) + lu(k,2225) = lu(k,2225) - lu(k,1569) * lu(k,2221) + lu(k,2226) = lu(k,2226) - lu(k,1570) * lu(k,2221) + lu(k,2227) = lu(k,2227) - lu(k,1571) * lu(k,2221) + lu(k,2228) = lu(k,2228) - lu(k,1572) * lu(k,2221) + lu(k,2229) = lu(k,2229) - lu(k,1573) * lu(k,2221) + lu(k,2230) = lu(k,2230) - lu(k,1574) * lu(k,2221) + lu(k,2231) = lu(k,2231) - lu(k,1575) * lu(k,2221) + lu(k,2232) = lu(k,2232) - lu(k,1576) * lu(k,2221) + lu(k,2233) = lu(k,2233) - lu(k,1577) * lu(k,2221) + lu(k,2235) = lu(k,2235) - lu(k,1578) * lu(k,2221) + lu(k,2237) = lu(k,2237) - lu(k,1579) * lu(k,2221) + lu(k,2247) = lu(k,2247) - lu(k,1566) * lu(k,2246) + lu(k,2248) = lu(k,2248) - lu(k,1567) * lu(k,2246) + lu(k,2249) = lu(k,2249) - lu(k,1568) * lu(k,2246) + lu(k,2250) = lu(k,2250) - lu(k,1569) * lu(k,2246) + lu(k,2251) = lu(k,2251) - lu(k,1570) * lu(k,2246) + lu(k,2252) = lu(k,2252) - lu(k,1571) * lu(k,2246) + lu(k,2253) = lu(k,2253) - lu(k,1572) * lu(k,2246) + lu(k,2254) = lu(k,2254) - lu(k,1573) * lu(k,2246) + lu(k,2255) = lu(k,2255) - lu(k,1574) * lu(k,2246) + lu(k,2256) = lu(k,2256) - lu(k,1575) * lu(k,2246) + lu(k,2257) = lu(k,2257) - lu(k,1576) * lu(k,2246) + lu(k,2258) = lu(k,2258) - lu(k,1577) * lu(k,2246) + lu(k,2260) = lu(k,2260) - lu(k,1578) * lu(k,2246) + lu(k,2262) = lu(k,2262) - lu(k,1579) * lu(k,2246) + lu(k,2355) = lu(k,2355) - lu(k,1566) * lu(k,2354) + lu(k,2356) = lu(k,2356) - lu(k,1567) * lu(k,2354) + lu(k,2357) = lu(k,2357) - lu(k,1568) * lu(k,2354) + lu(k,2358) = lu(k,2358) - lu(k,1569) * lu(k,2354) + lu(k,2359) = lu(k,2359) - lu(k,1570) * lu(k,2354) + lu(k,2360) = lu(k,2360) - lu(k,1571) * lu(k,2354) + lu(k,2361) = lu(k,2361) - lu(k,1572) * lu(k,2354) + lu(k,2362) = lu(k,2362) - lu(k,1573) * lu(k,2354) + lu(k,2363) = lu(k,2363) - lu(k,1574) * lu(k,2354) + lu(k,2364) = lu(k,2364) - lu(k,1575) * lu(k,2354) + lu(k,2365) = lu(k,2365) - lu(k,1576) * lu(k,2354) + lu(k,2366) = lu(k,2366) - lu(k,1577) * lu(k,2354) + lu(k,2368) = lu(k,2368) - lu(k,1578) * lu(k,2354) + lu(k,2370) = lu(k,2370) - lu(k,1579) * lu(k,2354) + lu(k,2407) = lu(k,2407) - lu(k,1566) * lu(k,2406) + lu(k,2408) = lu(k,2408) - lu(k,1567) * lu(k,2406) + lu(k,2409) = lu(k,2409) - lu(k,1568) * lu(k,2406) + lu(k,2410) = lu(k,2410) - lu(k,1569) * lu(k,2406) + lu(k,2411) = lu(k,2411) - lu(k,1570) * lu(k,2406) + lu(k,2412) = lu(k,2412) - lu(k,1571) * lu(k,2406) + lu(k,2413) = lu(k,2413) - lu(k,1572) * lu(k,2406) + lu(k,2414) = lu(k,2414) - lu(k,1573) * lu(k,2406) + lu(k,2415) = lu(k,2415) - lu(k,1574) * lu(k,2406) + lu(k,2416) = lu(k,2416) - lu(k,1575) * lu(k,2406) + lu(k,2417) = lu(k,2417) - lu(k,1576) * lu(k,2406) + lu(k,2418) = lu(k,2418) - lu(k,1577) * lu(k,2406) + lu(k,2420) = lu(k,2420) - lu(k,1578) * lu(k,2406) + lu(k,2422) = lu(k,2422) - lu(k,1579) * lu(k,2406) + lu(k,2434) = lu(k,2434) - lu(k,1566) * lu(k,2433) + lu(k,2435) = lu(k,2435) - lu(k,1567) * lu(k,2433) + lu(k,2436) = lu(k,2436) - lu(k,1568) * lu(k,2433) + lu(k,2437) = lu(k,2437) - lu(k,1569) * lu(k,2433) + lu(k,2438) = lu(k,2438) - lu(k,1570) * lu(k,2433) + lu(k,2439) = lu(k,2439) - lu(k,1571) * lu(k,2433) + lu(k,2440) = lu(k,2440) - lu(k,1572) * lu(k,2433) + lu(k,2441) = lu(k,2441) - lu(k,1573) * lu(k,2433) + lu(k,2442) = lu(k,2442) - lu(k,1574) * lu(k,2433) + lu(k,2443) = lu(k,2443) - lu(k,1575) * lu(k,2433) + lu(k,2444) = lu(k,2444) - lu(k,1576) * lu(k,2433) + lu(k,2445) = lu(k,2445) - lu(k,1577) * lu(k,2433) + lu(k,2447) = lu(k,2447) - lu(k,1578) * lu(k,2433) + lu(k,2449) = lu(k,2449) - lu(k,1579) * lu(k,2433) + lu(k,1592) = 1._r8 / lu(k,1592) + lu(k,1593) = lu(k,1593) * lu(k,1592) + lu(k,1594) = lu(k,1594) * lu(k,1592) + lu(k,1595) = lu(k,1595) * lu(k,1592) + lu(k,1596) = lu(k,1596) * lu(k,1592) + lu(k,1597) = lu(k,1597) * lu(k,1592) + lu(k,1598) = lu(k,1598) * lu(k,1592) + lu(k,1599) = lu(k,1599) * lu(k,1592) + lu(k,1600) = lu(k,1600) * lu(k,1592) + lu(k,1601) = lu(k,1601) * lu(k,1592) + lu(k,1602) = lu(k,1602) * lu(k,1592) + lu(k,1603) = lu(k,1603) * lu(k,1592) + lu(k,1604) = lu(k,1604) * lu(k,1592) + lu(k,1605) = lu(k,1605) * lu(k,1592) + lu(k,1606) = lu(k,1606) * lu(k,1592) + lu(k,1652) = lu(k,1652) - lu(k,1593) * lu(k,1651) + lu(k,1653) = lu(k,1653) - lu(k,1594) * lu(k,1651) + lu(k,1654) = lu(k,1654) - lu(k,1595) * lu(k,1651) + lu(k,1655) = lu(k,1655) - lu(k,1596) * lu(k,1651) + lu(k,1656) = lu(k,1656) - lu(k,1597) * lu(k,1651) + lu(k,1657) = lu(k,1657) - lu(k,1598) * lu(k,1651) + lu(k,1658) = lu(k,1658) - lu(k,1599) * lu(k,1651) + lu(k,1659) = lu(k,1659) - lu(k,1600) * lu(k,1651) + lu(k,1660) = lu(k,1660) - lu(k,1601) * lu(k,1651) + lu(k,1661) = lu(k,1661) - lu(k,1602) * lu(k,1651) + lu(k,1662) = lu(k,1662) - lu(k,1603) * lu(k,1651) + lu(k,1664) = lu(k,1664) - lu(k,1604) * lu(k,1651) + lu(k,1665) = lu(k,1665) - lu(k,1605) * lu(k,1651) + lu(k,1666) = lu(k,1666) - lu(k,1606) * lu(k,1651) + lu(k,1817) = lu(k,1817) - lu(k,1593) * lu(k,1816) + lu(k,1818) = lu(k,1818) - lu(k,1594) * lu(k,1816) + lu(k,1819) = lu(k,1819) - lu(k,1595) * lu(k,1816) + lu(k,1820) = lu(k,1820) - lu(k,1596) * lu(k,1816) + lu(k,1821) = lu(k,1821) - lu(k,1597) * lu(k,1816) + lu(k,1822) = lu(k,1822) - lu(k,1598) * lu(k,1816) + lu(k,1823) = lu(k,1823) - lu(k,1599) * lu(k,1816) + lu(k,1824) = lu(k,1824) - lu(k,1600) * lu(k,1816) + lu(k,1825) = lu(k,1825) - lu(k,1601) * lu(k,1816) + lu(k,1826) = lu(k,1826) - lu(k,1602) * lu(k,1816) + lu(k,1827) = lu(k,1827) - lu(k,1603) * lu(k,1816) + lu(k,1829) = lu(k,1829) - lu(k,1604) * lu(k,1816) + lu(k,1830) = lu(k,1830) - lu(k,1605) * lu(k,1816) + lu(k,1831) = lu(k,1831) - lu(k,1606) * lu(k,1816) + lu(k,1912) = lu(k,1912) - lu(k,1593) * lu(k,1911) + lu(k,1913) = lu(k,1913) - lu(k,1594) * lu(k,1911) + lu(k,1914) = lu(k,1914) - lu(k,1595) * lu(k,1911) + lu(k,1915) = lu(k,1915) - lu(k,1596) * lu(k,1911) + lu(k,1916) = lu(k,1916) - lu(k,1597) * lu(k,1911) + lu(k,1917) = lu(k,1917) - lu(k,1598) * lu(k,1911) + lu(k,1918) = lu(k,1918) - lu(k,1599) * lu(k,1911) + lu(k,1919) = lu(k,1919) - lu(k,1600) * lu(k,1911) + lu(k,1920) = lu(k,1920) - lu(k,1601) * lu(k,1911) + lu(k,1921) = lu(k,1921) - lu(k,1602) * lu(k,1911) + lu(k,1922) = lu(k,1922) - lu(k,1603) * lu(k,1911) + lu(k,1924) = lu(k,1924) - lu(k,1604) * lu(k,1911) + lu(k,1925) = lu(k,1925) - lu(k,1605) * lu(k,1911) + lu(k,1926) = lu(k,1926) - lu(k,1606) * lu(k,1911) + lu(k,1957) = lu(k,1957) - lu(k,1593) * lu(k,1956) + lu(k,1958) = lu(k,1958) - lu(k,1594) * lu(k,1956) + lu(k,1959) = lu(k,1959) - lu(k,1595) * lu(k,1956) + lu(k,1960) = lu(k,1960) - lu(k,1596) * lu(k,1956) + lu(k,1961) = lu(k,1961) - lu(k,1597) * lu(k,1956) + lu(k,1962) = lu(k,1962) - lu(k,1598) * lu(k,1956) + lu(k,1963) = lu(k,1963) - lu(k,1599) * lu(k,1956) + lu(k,1964) = lu(k,1964) - lu(k,1600) * lu(k,1956) + lu(k,1965) = lu(k,1965) - lu(k,1601) * lu(k,1956) + lu(k,1966) = lu(k,1966) - lu(k,1602) * lu(k,1956) + lu(k,1967) = lu(k,1967) - lu(k,1603) * lu(k,1956) + lu(k,1969) = lu(k,1969) - lu(k,1604) * lu(k,1956) + lu(k,1970) = lu(k,1970) - lu(k,1605) * lu(k,1956) + lu(k,1971) = lu(k,1971) - lu(k,1606) * lu(k,1956) + lu(k,1983) = lu(k,1983) - lu(k,1593) * lu(k,1982) + lu(k,1984) = lu(k,1984) - lu(k,1594) * lu(k,1982) + lu(k,1985) = lu(k,1985) - lu(k,1595) * lu(k,1982) + lu(k,1986) = lu(k,1986) - lu(k,1596) * lu(k,1982) + lu(k,1987) = lu(k,1987) - lu(k,1597) * lu(k,1982) + lu(k,1988) = lu(k,1988) - lu(k,1598) * lu(k,1982) + lu(k,1989) = lu(k,1989) - lu(k,1599) * lu(k,1982) + lu(k,1990) = lu(k,1990) - lu(k,1600) * lu(k,1982) + lu(k,1991) = lu(k,1991) - lu(k,1601) * lu(k,1982) + lu(k,1992) = lu(k,1992) - lu(k,1602) * lu(k,1982) + lu(k,1993) = lu(k,1993) - lu(k,1603) * lu(k,1982) + lu(k,1995) = lu(k,1995) - lu(k,1604) * lu(k,1982) + lu(k,1996) = lu(k,1996) - lu(k,1605) * lu(k,1982) + lu(k,1997) = lu(k,1997) - lu(k,1606) * lu(k,1982) + lu(k,2026) = lu(k,2026) - lu(k,1593) * lu(k,2025) + lu(k,2027) = lu(k,2027) - lu(k,1594) * lu(k,2025) + lu(k,2028) = lu(k,2028) - lu(k,1595) * lu(k,2025) + lu(k,2029) = lu(k,2029) - lu(k,1596) * lu(k,2025) + lu(k,2030) = lu(k,2030) - lu(k,1597) * lu(k,2025) + lu(k,2031) = lu(k,2031) - lu(k,1598) * lu(k,2025) + lu(k,2032) = lu(k,2032) - lu(k,1599) * lu(k,2025) + lu(k,2033) = lu(k,2033) - lu(k,1600) * lu(k,2025) + lu(k,2034) = lu(k,2034) - lu(k,1601) * lu(k,2025) + lu(k,2035) = lu(k,2035) - lu(k,1602) * lu(k,2025) + lu(k,2036) = lu(k,2036) - lu(k,1603) * lu(k,2025) + lu(k,2038) = lu(k,2038) - lu(k,1604) * lu(k,2025) + lu(k,2039) = lu(k,2039) - lu(k,1605) * lu(k,2025) + lu(k,2040) = lu(k,2040) - lu(k,1606) * lu(k,2025) + lu(k,2049) = lu(k,2049) - lu(k,1593) * lu(k,2048) + lu(k,2050) = lu(k,2050) - lu(k,1594) * lu(k,2048) + lu(k,2051) = lu(k,2051) - lu(k,1595) * lu(k,2048) + lu(k,2052) = lu(k,2052) - lu(k,1596) * lu(k,2048) + lu(k,2053) = lu(k,2053) - lu(k,1597) * lu(k,2048) + lu(k,2054) = lu(k,2054) - lu(k,1598) * lu(k,2048) + lu(k,2055) = lu(k,2055) - lu(k,1599) * lu(k,2048) + lu(k,2056) = lu(k,2056) - lu(k,1600) * lu(k,2048) + lu(k,2057) = lu(k,2057) - lu(k,1601) * lu(k,2048) + lu(k,2058) = lu(k,2058) - lu(k,1602) * lu(k,2048) + lu(k,2059) = lu(k,2059) - lu(k,1603) * lu(k,2048) + lu(k,2061) = lu(k,2061) - lu(k,1604) * lu(k,2048) + lu(k,2062) = lu(k,2062) - lu(k,1605) * lu(k,2048) + lu(k,2063) = lu(k,2063) - lu(k,1606) * lu(k,2048) + lu(k,2092) = lu(k,2092) - lu(k,1593) * lu(k,2091) + lu(k,2093) = lu(k,2093) - lu(k,1594) * lu(k,2091) + lu(k,2094) = lu(k,2094) - lu(k,1595) * lu(k,2091) + lu(k,2095) = lu(k,2095) - lu(k,1596) * lu(k,2091) + lu(k,2096) = lu(k,2096) - lu(k,1597) * lu(k,2091) + lu(k,2097) = lu(k,2097) - lu(k,1598) * lu(k,2091) + lu(k,2098) = lu(k,2098) - lu(k,1599) * lu(k,2091) + lu(k,2099) = lu(k,2099) - lu(k,1600) * lu(k,2091) + lu(k,2100) = lu(k,2100) - lu(k,1601) * lu(k,2091) + lu(k,2101) = lu(k,2101) - lu(k,1602) * lu(k,2091) + lu(k,2102) = lu(k,2102) - lu(k,1603) * lu(k,2091) + lu(k,2104) = lu(k,2104) - lu(k,1604) * lu(k,2091) + lu(k,2105) = lu(k,2105) - lu(k,1605) * lu(k,2091) + lu(k,2106) = lu(k,2106) - lu(k,1606) * lu(k,2091) + lu(k,2113) = lu(k,2113) - lu(k,1593) * lu(k,2112) + lu(k,2114) = lu(k,2114) - lu(k,1594) * lu(k,2112) + lu(k,2115) = lu(k,2115) - lu(k,1595) * lu(k,2112) + lu(k,2116) = lu(k,2116) - lu(k,1596) * lu(k,2112) + lu(k,2117) = lu(k,2117) - lu(k,1597) * lu(k,2112) + lu(k,2118) = lu(k,2118) - lu(k,1598) * lu(k,2112) + lu(k,2119) = lu(k,2119) - lu(k,1599) * lu(k,2112) + lu(k,2120) = lu(k,2120) - lu(k,1600) * lu(k,2112) + lu(k,2121) = lu(k,2121) - lu(k,1601) * lu(k,2112) + lu(k,2122) = lu(k,2122) - lu(k,1602) * lu(k,2112) + lu(k,2123) = lu(k,2123) - lu(k,1603) * lu(k,2112) + lu(k,2125) = lu(k,2125) - lu(k,1604) * lu(k,2112) + lu(k,2126) = lu(k,2126) - lu(k,1605) * lu(k,2112) + lu(k,2127) = lu(k,2127) - lu(k,1606) * lu(k,2112) + lu(k,2159) = lu(k,2159) - lu(k,1593) * lu(k,2158) + lu(k,2160) = lu(k,2160) - lu(k,1594) * lu(k,2158) + lu(k,2161) = lu(k,2161) - lu(k,1595) * lu(k,2158) + lu(k,2162) = lu(k,2162) - lu(k,1596) * lu(k,2158) + lu(k,2163) = lu(k,2163) - lu(k,1597) * lu(k,2158) + lu(k,2164) = lu(k,2164) - lu(k,1598) * lu(k,2158) + lu(k,2165) = lu(k,2165) - lu(k,1599) * lu(k,2158) + lu(k,2166) = lu(k,2166) - lu(k,1600) * lu(k,2158) + lu(k,2167) = lu(k,2167) - lu(k,1601) * lu(k,2158) + lu(k,2168) = lu(k,2168) - lu(k,1602) * lu(k,2158) + lu(k,2169) = lu(k,2169) - lu(k,1603) * lu(k,2158) + lu(k,2171) = lu(k,2171) - lu(k,1604) * lu(k,2158) + lu(k,2172) = lu(k,2172) - lu(k,1605) * lu(k,2158) + lu(k,2173) = lu(k,2173) - lu(k,1606) * lu(k,2158) + lu(k,2223) = lu(k,2223) - lu(k,1593) * lu(k,2222) + lu(k,2224) = lu(k,2224) - lu(k,1594) * lu(k,2222) + lu(k,2225) = lu(k,2225) - lu(k,1595) * lu(k,2222) + lu(k,2226) = lu(k,2226) - lu(k,1596) * lu(k,2222) + lu(k,2227) = lu(k,2227) - lu(k,1597) * lu(k,2222) + lu(k,2228) = lu(k,2228) - lu(k,1598) * lu(k,2222) + lu(k,2229) = lu(k,2229) - lu(k,1599) * lu(k,2222) + lu(k,2230) = lu(k,2230) - lu(k,1600) * lu(k,2222) + lu(k,2231) = lu(k,2231) - lu(k,1601) * lu(k,2222) + lu(k,2232) = lu(k,2232) - lu(k,1602) * lu(k,2222) + lu(k,2233) = lu(k,2233) - lu(k,1603) * lu(k,2222) + lu(k,2235) = lu(k,2235) - lu(k,1604) * lu(k,2222) + lu(k,2236) = lu(k,2236) - lu(k,1605) * lu(k,2222) + lu(k,2237) = lu(k,2237) - lu(k,1606) * lu(k,2222) + lu(k,2248) = lu(k,2248) - lu(k,1593) * lu(k,2247) + lu(k,2249) = lu(k,2249) - lu(k,1594) * lu(k,2247) + lu(k,2250) = lu(k,2250) - lu(k,1595) * lu(k,2247) + lu(k,2251) = lu(k,2251) - lu(k,1596) * lu(k,2247) + lu(k,2252) = lu(k,2252) - lu(k,1597) * lu(k,2247) + lu(k,2253) = lu(k,2253) - lu(k,1598) * lu(k,2247) + lu(k,2254) = lu(k,2254) - lu(k,1599) * lu(k,2247) + lu(k,2255) = lu(k,2255) - lu(k,1600) * lu(k,2247) + lu(k,2256) = lu(k,2256) - lu(k,1601) * lu(k,2247) + lu(k,2257) = lu(k,2257) - lu(k,1602) * lu(k,2247) + lu(k,2258) = lu(k,2258) - lu(k,1603) * lu(k,2247) + lu(k,2260) = lu(k,2260) - lu(k,1604) * lu(k,2247) + lu(k,2261) = lu(k,2261) - lu(k,1605) * lu(k,2247) + lu(k,2262) = lu(k,2262) - lu(k,1606) * lu(k,2247) + lu(k,2356) = lu(k,2356) - lu(k,1593) * lu(k,2355) + lu(k,2357) = lu(k,2357) - lu(k,1594) * lu(k,2355) + lu(k,2358) = lu(k,2358) - lu(k,1595) * lu(k,2355) + lu(k,2359) = lu(k,2359) - lu(k,1596) * lu(k,2355) + lu(k,2360) = lu(k,2360) - lu(k,1597) * lu(k,2355) + lu(k,2361) = lu(k,2361) - lu(k,1598) * lu(k,2355) + lu(k,2362) = lu(k,2362) - lu(k,1599) * lu(k,2355) + lu(k,2363) = lu(k,2363) - lu(k,1600) * lu(k,2355) + lu(k,2364) = lu(k,2364) - lu(k,1601) * lu(k,2355) + lu(k,2365) = lu(k,2365) - lu(k,1602) * lu(k,2355) + lu(k,2366) = lu(k,2366) - lu(k,1603) * lu(k,2355) + lu(k,2368) = lu(k,2368) - lu(k,1604) * lu(k,2355) + lu(k,2369) = lu(k,2369) - lu(k,1605) * lu(k,2355) + lu(k,2370) = lu(k,2370) - lu(k,1606) * lu(k,2355) + lu(k,2408) = lu(k,2408) - lu(k,1593) * lu(k,2407) + lu(k,2409) = lu(k,2409) - lu(k,1594) * lu(k,2407) + lu(k,2410) = lu(k,2410) - lu(k,1595) * lu(k,2407) + lu(k,2411) = lu(k,2411) - lu(k,1596) * lu(k,2407) + lu(k,2412) = lu(k,2412) - lu(k,1597) * lu(k,2407) + lu(k,2413) = lu(k,2413) - lu(k,1598) * lu(k,2407) + lu(k,2414) = lu(k,2414) - lu(k,1599) * lu(k,2407) + lu(k,2415) = lu(k,2415) - lu(k,1600) * lu(k,2407) + lu(k,2416) = lu(k,2416) - lu(k,1601) * lu(k,2407) + lu(k,2417) = lu(k,2417) - lu(k,1602) * lu(k,2407) + lu(k,2418) = lu(k,2418) - lu(k,1603) * lu(k,2407) + lu(k,2420) = lu(k,2420) - lu(k,1604) * lu(k,2407) + lu(k,2421) = lu(k,2421) - lu(k,1605) * lu(k,2407) + lu(k,2422) = lu(k,2422) - lu(k,1606) * lu(k,2407) + lu(k,2435) = lu(k,2435) - lu(k,1593) * lu(k,2434) + lu(k,2436) = lu(k,2436) - lu(k,1594) * lu(k,2434) + lu(k,2437) = lu(k,2437) - lu(k,1595) * lu(k,2434) + lu(k,2438) = lu(k,2438) - lu(k,1596) * lu(k,2434) + lu(k,2439) = lu(k,2439) - lu(k,1597) * lu(k,2434) + lu(k,2440) = lu(k,2440) - lu(k,1598) * lu(k,2434) + lu(k,2441) = lu(k,2441) - lu(k,1599) * lu(k,2434) + lu(k,2442) = lu(k,2442) - lu(k,1600) * lu(k,2434) + lu(k,2443) = lu(k,2443) - lu(k,1601) * lu(k,2434) + lu(k,2444) = lu(k,2444) - lu(k,1602) * lu(k,2434) + lu(k,2445) = lu(k,2445) - lu(k,1603) * lu(k,2434) + lu(k,2447) = lu(k,2447) - lu(k,1604) * lu(k,2434) + lu(k,2448) = lu(k,2448) - lu(k,1605) * lu(k,2434) + lu(k,2449) = lu(k,2449) - lu(k,1606) * lu(k,2434) + lu(k,1652) = 1._r8 / lu(k,1652) + lu(k,1653) = lu(k,1653) * lu(k,1652) + lu(k,1654) = lu(k,1654) * lu(k,1652) + lu(k,1655) = lu(k,1655) * lu(k,1652) + lu(k,1656) = lu(k,1656) * lu(k,1652) + lu(k,1657) = lu(k,1657) * lu(k,1652) + lu(k,1658) = lu(k,1658) * lu(k,1652) + lu(k,1659) = lu(k,1659) * lu(k,1652) + lu(k,1660) = lu(k,1660) * lu(k,1652) + lu(k,1661) = lu(k,1661) * lu(k,1652) + lu(k,1662) = lu(k,1662) * lu(k,1652) + lu(k,1663) = lu(k,1663) * lu(k,1652) + lu(k,1664) = lu(k,1664) * lu(k,1652) + lu(k,1665) = lu(k,1665) * lu(k,1652) + lu(k,1666) = lu(k,1666) * lu(k,1652) + lu(k,1818) = lu(k,1818) - lu(k,1653) * lu(k,1817) + lu(k,1819) = lu(k,1819) - lu(k,1654) * lu(k,1817) + lu(k,1820) = lu(k,1820) - lu(k,1655) * lu(k,1817) + lu(k,1821) = lu(k,1821) - lu(k,1656) * lu(k,1817) + lu(k,1822) = lu(k,1822) - lu(k,1657) * lu(k,1817) + lu(k,1823) = lu(k,1823) - lu(k,1658) * lu(k,1817) + lu(k,1824) = lu(k,1824) - lu(k,1659) * lu(k,1817) + lu(k,1825) = lu(k,1825) - lu(k,1660) * lu(k,1817) + lu(k,1826) = lu(k,1826) - lu(k,1661) * lu(k,1817) + lu(k,1827) = lu(k,1827) - lu(k,1662) * lu(k,1817) + lu(k,1828) = lu(k,1828) - lu(k,1663) * lu(k,1817) + lu(k,1829) = lu(k,1829) - lu(k,1664) * lu(k,1817) + lu(k,1830) = lu(k,1830) - lu(k,1665) * lu(k,1817) + lu(k,1831) = lu(k,1831) - lu(k,1666) * lu(k,1817) + lu(k,1913) = lu(k,1913) - lu(k,1653) * lu(k,1912) + lu(k,1914) = lu(k,1914) - lu(k,1654) * lu(k,1912) + lu(k,1915) = lu(k,1915) - lu(k,1655) * lu(k,1912) + lu(k,1916) = lu(k,1916) - lu(k,1656) * lu(k,1912) + lu(k,1917) = lu(k,1917) - lu(k,1657) * lu(k,1912) + lu(k,1918) = lu(k,1918) - lu(k,1658) * lu(k,1912) + lu(k,1919) = lu(k,1919) - lu(k,1659) * lu(k,1912) + lu(k,1920) = lu(k,1920) - lu(k,1660) * lu(k,1912) + lu(k,1921) = lu(k,1921) - lu(k,1661) * lu(k,1912) + lu(k,1922) = lu(k,1922) - lu(k,1662) * lu(k,1912) + lu(k,1923) = lu(k,1923) - lu(k,1663) * lu(k,1912) + lu(k,1924) = lu(k,1924) - lu(k,1664) * lu(k,1912) + lu(k,1925) = lu(k,1925) - lu(k,1665) * lu(k,1912) + lu(k,1926) = lu(k,1926) - lu(k,1666) * lu(k,1912) + lu(k,1958) = lu(k,1958) - lu(k,1653) * lu(k,1957) + lu(k,1959) = lu(k,1959) - lu(k,1654) * lu(k,1957) + lu(k,1960) = lu(k,1960) - lu(k,1655) * lu(k,1957) + lu(k,1961) = lu(k,1961) - lu(k,1656) * lu(k,1957) + lu(k,1962) = lu(k,1962) - lu(k,1657) * lu(k,1957) + lu(k,1963) = lu(k,1963) - lu(k,1658) * lu(k,1957) + lu(k,1964) = lu(k,1964) - lu(k,1659) * lu(k,1957) + lu(k,1965) = lu(k,1965) - lu(k,1660) * lu(k,1957) + lu(k,1966) = lu(k,1966) - lu(k,1661) * lu(k,1957) + lu(k,1967) = lu(k,1967) - lu(k,1662) * lu(k,1957) + lu(k,1968) = lu(k,1968) - lu(k,1663) * lu(k,1957) + lu(k,1969) = lu(k,1969) - lu(k,1664) * lu(k,1957) + lu(k,1970) = lu(k,1970) - lu(k,1665) * lu(k,1957) + lu(k,1971) = lu(k,1971) - lu(k,1666) * lu(k,1957) + lu(k,1984) = lu(k,1984) - lu(k,1653) * lu(k,1983) + lu(k,1985) = lu(k,1985) - lu(k,1654) * lu(k,1983) + lu(k,1986) = lu(k,1986) - lu(k,1655) * lu(k,1983) + lu(k,1987) = lu(k,1987) - lu(k,1656) * lu(k,1983) + lu(k,1988) = lu(k,1988) - lu(k,1657) * lu(k,1983) + lu(k,1989) = lu(k,1989) - lu(k,1658) * lu(k,1983) + lu(k,1990) = lu(k,1990) - lu(k,1659) * lu(k,1983) + lu(k,1991) = lu(k,1991) - lu(k,1660) * lu(k,1983) + lu(k,1992) = lu(k,1992) - lu(k,1661) * lu(k,1983) + lu(k,1993) = lu(k,1993) - lu(k,1662) * lu(k,1983) + lu(k,1994) = lu(k,1994) - lu(k,1663) * lu(k,1983) + lu(k,1995) = lu(k,1995) - lu(k,1664) * lu(k,1983) + lu(k,1996) = lu(k,1996) - lu(k,1665) * lu(k,1983) + lu(k,1997) = lu(k,1997) - lu(k,1666) * lu(k,1983) + lu(k,2027) = lu(k,2027) - lu(k,1653) * lu(k,2026) + lu(k,2028) = lu(k,2028) - lu(k,1654) * lu(k,2026) + lu(k,2029) = lu(k,2029) - lu(k,1655) * lu(k,2026) + lu(k,2030) = lu(k,2030) - lu(k,1656) * lu(k,2026) + lu(k,2031) = lu(k,2031) - lu(k,1657) * lu(k,2026) + lu(k,2032) = lu(k,2032) - lu(k,1658) * lu(k,2026) + lu(k,2033) = lu(k,2033) - lu(k,1659) * lu(k,2026) + lu(k,2034) = lu(k,2034) - lu(k,1660) * lu(k,2026) + lu(k,2035) = lu(k,2035) - lu(k,1661) * lu(k,2026) + lu(k,2036) = lu(k,2036) - lu(k,1662) * lu(k,2026) + lu(k,2037) = lu(k,2037) - lu(k,1663) * lu(k,2026) + lu(k,2038) = lu(k,2038) - lu(k,1664) * lu(k,2026) + lu(k,2039) = lu(k,2039) - lu(k,1665) * lu(k,2026) + lu(k,2040) = lu(k,2040) - lu(k,1666) * lu(k,2026) + lu(k,2050) = lu(k,2050) - lu(k,1653) * lu(k,2049) + lu(k,2051) = lu(k,2051) - lu(k,1654) * lu(k,2049) + lu(k,2052) = lu(k,2052) - lu(k,1655) * lu(k,2049) + lu(k,2053) = lu(k,2053) - lu(k,1656) * lu(k,2049) + lu(k,2054) = lu(k,2054) - lu(k,1657) * lu(k,2049) + lu(k,2055) = lu(k,2055) - lu(k,1658) * lu(k,2049) + lu(k,2056) = lu(k,2056) - lu(k,1659) * lu(k,2049) + lu(k,2057) = lu(k,2057) - lu(k,1660) * lu(k,2049) + lu(k,2058) = lu(k,2058) - lu(k,1661) * lu(k,2049) + lu(k,2059) = lu(k,2059) - lu(k,1662) * lu(k,2049) + lu(k,2060) = lu(k,2060) - lu(k,1663) * lu(k,2049) + lu(k,2061) = lu(k,2061) - lu(k,1664) * lu(k,2049) + lu(k,2062) = lu(k,2062) - lu(k,1665) * lu(k,2049) + lu(k,2063) = lu(k,2063) - lu(k,1666) * lu(k,2049) + lu(k,2093) = lu(k,2093) - lu(k,1653) * lu(k,2092) + lu(k,2094) = lu(k,2094) - lu(k,1654) * lu(k,2092) + lu(k,2095) = lu(k,2095) - lu(k,1655) * lu(k,2092) + lu(k,2096) = lu(k,2096) - lu(k,1656) * lu(k,2092) + lu(k,2097) = lu(k,2097) - lu(k,1657) * lu(k,2092) + lu(k,2098) = lu(k,2098) - lu(k,1658) * lu(k,2092) + lu(k,2099) = lu(k,2099) - lu(k,1659) * lu(k,2092) + lu(k,2100) = lu(k,2100) - lu(k,1660) * lu(k,2092) + lu(k,2101) = lu(k,2101) - lu(k,1661) * lu(k,2092) + lu(k,2102) = lu(k,2102) - lu(k,1662) * lu(k,2092) + lu(k,2103) = lu(k,2103) - lu(k,1663) * lu(k,2092) + lu(k,2104) = lu(k,2104) - lu(k,1664) * lu(k,2092) + lu(k,2105) = lu(k,2105) - lu(k,1665) * lu(k,2092) + lu(k,2106) = lu(k,2106) - lu(k,1666) * lu(k,2092) + lu(k,2114) = lu(k,2114) - lu(k,1653) * lu(k,2113) + lu(k,2115) = lu(k,2115) - lu(k,1654) * lu(k,2113) + lu(k,2116) = lu(k,2116) - lu(k,1655) * lu(k,2113) + lu(k,2117) = lu(k,2117) - lu(k,1656) * lu(k,2113) + lu(k,2118) = lu(k,2118) - lu(k,1657) * lu(k,2113) + lu(k,2119) = lu(k,2119) - lu(k,1658) * lu(k,2113) + lu(k,2120) = lu(k,2120) - lu(k,1659) * lu(k,2113) + lu(k,2121) = lu(k,2121) - lu(k,1660) * lu(k,2113) + lu(k,2122) = lu(k,2122) - lu(k,1661) * lu(k,2113) + lu(k,2123) = lu(k,2123) - lu(k,1662) * lu(k,2113) + lu(k,2124) = lu(k,2124) - lu(k,1663) * lu(k,2113) + lu(k,2125) = lu(k,2125) - lu(k,1664) * lu(k,2113) + lu(k,2126) = lu(k,2126) - lu(k,1665) * lu(k,2113) + lu(k,2127) = lu(k,2127) - lu(k,1666) * lu(k,2113) + lu(k,2160) = lu(k,2160) - lu(k,1653) * lu(k,2159) + lu(k,2161) = lu(k,2161) - lu(k,1654) * lu(k,2159) + lu(k,2162) = lu(k,2162) - lu(k,1655) * lu(k,2159) + lu(k,2163) = lu(k,2163) - lu(k,1656) * lu(k,2159) + lu(k,2164) = lu(k,2164) - lu(k,1657) * lu(k,2159) + lu(k,2165) = lu(k,2165) - lu(k,1658) * lu(k,2159) + lu(k,2166) = lu(k,2166) - lu(k,1659) * lu(k,2159) + lu(k,2167) = lu(k,2167) - lu(k,1660) * lu(k,2159) + lu(k,2168) = lu(k,2168) - lu(k,1661) * lu(k,2159) + lu(k,2169) = lu(k,2169) - lu(k,1662) * lu(k,2159) + lu(k,2170) = lu(k,2170) - lu(k,1663) * lu(k,2159) + lu(k,2171) = lu(k,2171) - lu(k,1664) * lu(k,2159) + lu(k,2172) = lu(k,2172) - lu(k,1665) * lu(k,2159) + lu(k,2173) = lu(k,2173) - lu(k,1666) * lu(k,2159) + lu(k,2224) = lu(k,2224) - lu(k,1653) * lu(k,2223) + lu(k,2225) = lu(k,2225) - lu(k,1654) * lu(k,2223) + lu(k,2226) = lu(k,2226) - lu(k,1655) * lu(k,2223) + lu(k,2227) = lu(k,2227) - lu(k,1656) * lu(k,2223) + lu(k,2228) = lu(k,2228) - lu(k,1657) * lu(k,2223) + lu(k,2229) = lu(k,2229) - lu(k,1658) * lu(k,2223) + lu(k,2230) = lu(k,2230) - lu(k,1659) * lu(k,2223) + lu(k,2231) = lu(k,2231) - lu(k,1660) * lu(k,2223) + lu(k,2232) = lu(k,2232) - lu(k,1661) * lu(k,2223) + lu(k,2233) = lu(k,2233) - lu(k,1662) * lu(k,2223) + lu(k,2234) = lu(k,2234) - lu(k,1663) * lu(k,2223) + lu(k,2235) = lu(k,2235) - lu(k,1664) * lu(k,2223) + lu(k,2236) = lu(k,2236) - lu(k,1665) * lu(k,2223) + lu(k,2237) = lu(k,2237) - lu(k,1666) * lu(k,2223) + lu(k,2249) = lu(k,2249) - lu(k,1653) * lu(k,2248) + lu(k,2250) = lu(k,2250) - lu(k,1654) * lu(k,2248) + lu(k,2251) = lu(k,2251) - lu(k,1655) * lu(k,2248) + lu(k,2252) = lu(k,2252) - lu(k,1656) * lu(k,2248) + lu(k,2253) = lu(k,2253) - lu(k,1657) * lu(k,2248) + lu(k,2254) = lu(k,2254) - lu(k,1658) * lu(k,2248) + lu(k,2255) = lu(k,2255) - lu(k,1659) * lu(k,2248) + lu(k,2256) = lu(k,2256) - lu(k,1660) * lu(k,2248) + lu(k,2257) = lu(k,2257) - lu(k,1661) * lu(k,2248) + lu(k,2258) = lu(k,2258) - lu(k,1662) * lu(k,2248) + lu(k,2259) = lu(k,2259) - lu(k,1663) * lu(k,2248) + lu(k,2260) = lu(k,2260) - lu(k,1664) * lu(k,2248) + lu(k,2261) = lu(k,2261) - lu(k,1665) * lu(k,2248) + lu(k,2262) = lu(k,2262) - lu(k,1666) * lu(k,2248) + lu(k,2357) = lu(k,2357) - lu(k,1653) * lu(k,2356) + lu(k,2358) = lu(k,2358) - lu(k,1654) * lu(k,2356) + lu(k,2359) = lu(k,2359) - lu(k,1655) * lu(k,2356) + lu(k,2360) = lu(k,2360) - lu(k,1656) * lu(k,2356) + lu(k,2361) = lu(k,2361) - lu(k,1657) * lu(k,2356) + lu(k,2362) = lu(k,2362) - lu(k,1658) * lu(k,2356) + lu(k,2363) = lu(k,2363) - lu(k,1659) * lu(k,2356) + lu(k,2364) = lu(k,2364) - lu(k,1660) * lu(k,2356) + lu(k,2365) = lu(k,2365) - lu(k,1661) * lu(k,2356) + lu(k,2366) = lu(k,2366) - lu(k,1662) * lu(k,2356) + lu(k,2367) = lu(k,2367) - lu(k,1663) * lu(k,2356) + lu(k,2368) = lu(k,2368) - lu(k,1664) * lu(k,2356) + lu(k,2369) = lu(k,2369) - lu(k,1665) * lu(k,2356) + lu(k,2370) = lu(k,2370) - lu(k,1666) * lu(k,2356) + lu(k,2409) = lu(k,2409) - lu(k,1653) * lu(k,2408) + lu(k,2410) = lu(k,2410) - lu(k,1654) * lu(k,2408) + lu(k,2411) = lu(k,2411) - lu(k,1655) * lu(k,2408) + lu(k,2412) = lu(k,2412) - lu(k,1656) * lu(k,2408) + lu(k,2413) = lu(k,2413) - lu(k,1657) * lu(k,2408) + lu(k,2414) = lu(k,2414) - lu(k,1658) * lu(k,2408) + lu(k,2415) = lu(k,2415) - lu(k,1659) * lu(k,2408) + lu(k,2416) = lu(k,2416) - lu(k,1660) * lu(k,2408) + lu(k,2417) = lu(k,2417) - lu(k,1661) * lu(k,2408) + lu(k,2418) = lu(k,2418) - lu(k,1662) * lu(k,2408) + lu(k,2419) = lu(k,2419) - lu(k,1663) * lu(k,2408) + lu(k,2420) = lu(k,2420) - lu(k,1664) * lu(k,2408) + lu(k,2421) = lu(k,2421) - lu(k,1665) * lu(k,2408) + lu(k,2422) = lu(k,2422) - lu(k,1666) * lu(k,2408) + lu(k,2436) = lu(k,2436) - lu(k,1653) * lu(k,2435) + lu(k,2437) = lu(k,2437) - lu(k,1654) * lu(k,2435) + lu(k,2438) = lu(k,2438) - lu(k,1655) * lu(k,2435) + lu(k,2439) = lu(k,2439) - lu(k,1656) * lu(k,2435) + lu(k,2440) = lu(k,2440) - lu(k,1657) * lu(k,2435) + lu(k,2441) = lu(k,2441) - lu(k,1658) * lu(k,2435) + lu(k,2442) = lu(k,2442) - lu(k,1659) * lu(k,2435) + lu(k,2443) = lu(k,2443) - lu(k,1660) * lu(k,2435) + lu(k,2444) = lu(k,2444) - lu(k,1661) * lu(k,2435) + lu(k,2445) = lu(k,2445) - lu(k,1662) * lu(k,2435) + lu(k,2446) = lu(k,2446) - lu(k,1663) * lu(k,2435) + lu(k,2447) = lu(k,2447) - lu(k,1664) * lu(k,2435) + lu(k,2448) = lu(k,2448) - lu(k,1665) * lu(k,2435) + lu(k,2449) = lu(k,2449) - lu(k,1666) * lu(k,2435) + end do + end subroutine lu_fac30 + subroutine lu_fac31( 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,1818) = 1._r8 / lu(k,1818) + lu(k,1819) = lu(k,1819) * lu(k,1818) + lu(k,1820) = lu(k,1820) * lu(k,1818) + lu(k,1821) = lu(k,1821) * lu(k,1818) + lu(k,1822) = lu(k,1822) * lu(k,1818) + lu(k,1823) = lu(k,1823) * lu(k,1818) + lu(k,1824) = lu(k,1824) * lu(k,1818) + lu(k,1825) = lu(k,1825) * lu(k,1818) + lu(k,1826) = lu(k,1826) * lu(k,1818) + lu(k,1827) = lu(k,1827) * lu(k,1818) + lu(k,1828) = lu(k,1828) * lu(k,1818) + lu(k,1829) = lu(k,1829) * lu(k,1818) + lu(k,1830) = lu(k,1830) * lu(k,1818) + lu(k,1831) = lu(k,1831) * lu(k,1818) + lu(k,1914) = lu(k,1914) - lu(k,1819) * lu(k,1913) + lu(k,1915) = lu(k,1915) - lu(k,1820) * lu(k,1913) + lu(k,1916) = lu(k,1916) - lu(k,1821) * lu(k,1913) + lu(k,1917) = lu(k,1917) - lu(k,1822) * lu(k,1913) + lu(k,1918) = lu(k,1918) - lu(k,1823) * lu(k,1913) + lu(k,1919) = lu(k,1919) - lu(k,1824) * lu(k,1913) + lu(k,1920) = lu(k,1920) - lu(k,1825) * lu(k,1913) + lu(k,1921) = lu(k,1921) - lu(k,1826) * lu(k,1913) + lu(k,1922) = lu(k,1922) - lu(k,1827) * lu(k,1913) + lu(k,1923) = lu(k,1923) - lu(k,1828) * lu(k,1913) + lu(k,1924) = lu(k,1924) - lu(k,1829) * lu(k,1913) + lu(k,1925) = lu(k,1925) - lu(k,1830) * lu(k,1913) + lu(k,1926) = lu(k,1926) - lu(k,1831) * lu(k,1913) + lu(k,1959) = lu(k,1959) - lu(k,1819) * lu(k,1958) + lu(k,1960) = lu(k,1960) - lu(k,1820) * lu(k,1958) + lu(k,1961) = lu(k,1961) - lu(k,1821) * lu(k,1958) + lu(k,1962) = lu(k,1962) - lu(k,1822) * lu(k,1958) + lu(k,1963) = lu(k,1963) - lu(k,1823) * lu(k,1958) + lu(k,1964) = lu(k,1964) - lu(k,1824) * lu(k,1958) + lu(k,1965) = lu(k,1965) - lu(k,1825) * lu(k,1958) + lu(k,1966) = lu(k,1966) - lu(k,1826) * lu(k,1958) + lu(k,1967) = lu(k,1967) - lu(k,1827) * lu(k,1958) + lu(k,1968) = lu(k,1968) - lu(k,1828) * lu(k,1958) + lu(k,1969) = lu(k,1969) - lu(k,1829) * lu(k,1958) + lu(k,1970) = lu(k,1970) - lu(k,1830) * lu(k,1958) + lu(k,1971) = lu(k,1971) - lu(k,1831) * lu(k,1958) + lu(k,1985) = lu(k,1985) - lu(k,1819) * lu(k,1984) + lu(k,1986) = lu(k,1986) - lu(k,1820) * lu(k,1984) + lu(k,1987) = lu(k,1987) - lu(k,1821) * lu(k,1984) + lu(k,1988) = lu(k,1988) - lu(k,1822) * lu(k,1984) + lu(k,1989) = lu(k,1989) - lu(k,1823) * lu(k,1984) + lu(k,1990) = lu(k,1990) - lu(k,1824) * lu(k,1984) + lu(k,1991) = lu(k,1991) - lu(k,1825) * lu(k,1984) + lu(k,1992) = lu(k,1992) - lu(k,1826) * lu(k,1984) + lu(k,1993) = lu(k,1993) - lu(k,1827) * lu(k,1984) + lu(k,1994) = lu(k,1994) - lu(k,1828) * lu(k,1984) + lu(k,1995) = lu(k,1995) - lu(k,1829) * lu(k,1984) + lu(k,1996) = lu(k,1996) - lu(k,1830) * lu(k,1984) + lu(k,1997) = lu(k,1997) - lu(k,1831) * lu(k,1984) + lu(k,2028) = lu(k,2028) - lu(k,1819) * lu(k,2027) + lu(k,2029) = lu(k,2029) - lu(k,1820) * lu(k,2027) + lu(k,2030) = lu(k,2030) - lu(k,1821) * lu(k,2027) + lu(k,2031) = lu(k,2031) - lu(k,1822) * lu(k,2027) + lu(k,2032) = lu(k,2032) - lu(k,1823) * lu(k,2027) + lu(k,2033) = lu(k,2033) - lu(k,1824) * lu(k,2027) + lu(k,2034) = lu(k,2034) - lu(k,1825) * lu(k,2027) + lu(k,2035) = lu(k,2035) - lu(k,1826) * lu(k,2027) + lu(k,2036) = lu(k,2036) - lu(k,1827) * lu(k,2027) + lu(k,2037) = lu(k,2037) - lu(k,1828) * lu(k,2027) + lu(k,2038) = lu(k,2038) - lu(k,1829) * lu(k,2027) + lu(k,2039) = lu(k,2039) - lu(k,1830) * lu(k,2027) + lu(k,2040) = lu(k,2040) - lu(k,1831) * lu(k,2027) + lu(k,2051) = lu(k,2051) - lu(k,1819) * lu(k,2050) + lu(k,2052) = lu(k,2052) - lu(k,1820) * lu(k,2050) + lu(k,2053) = lu(k,2053) - lu(k,1821) * lu(k,2050) + lu(k,2054) = lu(k,2054) - lu(k,1822) * lu(k,2050) + lu(k,2055) = lu(k,2055) - lu(k,1823) * lu(k,2050) + lu(k,2056) = lu(k,2056) - lu(k,1824) * lu(k,2050) + lu(k,2057) = lu(k,2057) - lu(k,1825) * lu(k,2050) + lu(k,2058) = lu(k,2058) - lu(k,1826) * lu(k,2050) + lu(k,2059) = lu(k,2059) - lu(k,1827) * lu(k,2050) + lu(k,2060) = lu(k,2060) - lu(k,1828) * lu(k,2050) + lu(k,2061) = lu(k,2061) - lu(k,1829) * lu(k,2050) + lu(k,2062) = lu(k,2062) - lu(k,1830) * lu(k,2050) + lu(k,2063) = lu(k,2063) - lu(k,1831) * lu(k,2050) + lu(k,2094) = lu(k,2094) - lu(k,1819) * lu(k,2093) + lu(k,2095) = lu(k,2095) - lu(k,1820) * lu(k,2093) + lu(k,2096) = lu(k,2096) - lu(k,1821) * lu(k,2093) + lu(k,2097) = lu(k,2097) - lu(k,1822) * lu(k,2093) + lu(k,2098) = lu(k,2098) - lu(k,1823) * lu(k,2093) + lu(k,2099) = lu(k,2099) - lu(k,1824) * lu(k,2093) + lu(k,2100) = lu(k,2100) - lu(k,1825) * lu(k,2093) + lu(k,2101) = lu(k,2101) - lu(k,1826) * lu(k,2093) + lu(k,2102) = lu(k,2102) - lu(k,1827) * lu(k,2093) + lu(k,2103) = lu(k,2103) - lu(k,1828) * lu(k,2093) + lu(k,2104) = lu(k,2104) - lu(k,1829) * lu(k,2093) + lu(k,2105) = lu(k,2105) - lu(k,1830) * lu(k,2093) + lu(k,2106) = lu(k,2106) - lu(k,1831) * lu(k,2093) + lu(k,2115) = lu(k,2115) - lu(k,1819) * lu(k,2114) + lu(k,2116) = lu(k,2116) - lu(k,1820) * lu(k,2114) + lu(k,2117) = lu(k,2117) - lu(k,1821) * lu(k,2114) + lu(k,2118) = lu(k,2118) - lu(k,1822) * lu(k,2114) + lu(k,2119) = lu(k,2119) - lu(k,1823) * lu(k,2114) + lu(k,2120) = lu(k,2120) - lu(k,1824) * lu(k,2114) + lu(k,2121) = lu(k,2121) - lu(k,1825) * lu(k,2114) + lu(k,2122) = lu(k,2122) - lu(k,1826) * lu(k,2114) + lu(k,2123) = lu(k,2123) - lu(k,1827) * lu(k,2114) + lu(k,2124) = lu(k,2124) - lu(k,1828) * lu(k,2114) + lu(k,2125) = lu(k,2125) - lu(k,1829) * lu(k,2114) + lu(k,2126) = lu(k,2126) - lu(k,1830) * lu(k,2114) + lu(k,2127) = lu(k,2127) - lu(k,1831) * lu(k,2114) + lu(k,2161) = lu(k,2161) - lu(k,1819) * lu(k,2160) + lu(k,2162) = lu(k,2162) - lu(k,1820) * lu(k,2160) + lu(k,2163) = lu(k,2163) - lu(k,1821) * lu(k,2160) + lu(k,2164) = lu(k,2164) - lu(k,1822) * lu(k,2160) + lu(k,2165) = lu(k,2165) - lu(k,1823) * lu(k,2160) + lu(k,2166) = lu(k,2166) - lu(k,1824) * lu(k,2160) + lu(k,2167) = lu(k,2167) - lu(k,1825) * lu(k,2160) + lu(k,2168) = lu(k,2168) - lu(k,1826) * lu(k,2160) + lu(k,2169) = lu(k,2169) - lu(k,1827) * lu(k,2160) + lu(k,2170) = lu(k,2170) - lu(k,1828) * lu(k,2160) + lu(k,2171) = lu(k,2171) - lu(k,1829) * lu(k,2160) + lu(k,2172) = lu(k,2172) - lu(k,1830) * lu(k,2160) + lu(k,2173) = lu(k,2173) - lu(k,1831) * lu(k,2160) + lu(k,2225) = lu(k,2225) - lu(k,1819) * lu(k,2224) + lu(k,2226) = lu(k,2226) - lu(k,1820) * lu(k,2224) + lu(k,2227) = lu(k,2227) - lu(k,1821) * lu(k,2224) + lu(k,2228) = lu(k,2228) - lu(k,1822) * lu(k,2224) + lu(k,2229) = lu(k,2229) - lu(k,1823) * lu(k,2224) + lu(k,2230) = lu(k,2230) - lu(k,1824) * lu(k,2224) + lu(k,2231) = lu(k,2231) - lu(k,1825) * lu(k,2224) + lu(k,2232) = lu(k,2232) - lu(k,1826) * lu(k,2224) + lu(k,2233) = lu(k,2233) - lu(k,1827) * lu(k,2224) + lu(k,2234) = lu(k,2234) - lu(k,1828) * lu(k,2224) + lu(k,2235) = lu(k,2235) - lu(k,1829) * lu(k,2224) + lu(k,2236) = lu(k,2236) - lu(k,1830) * lu(k,2224) + lu(k,2237) = lu(k,2237) - lu(k,1831) * lu(k,2224) + lu(k,2250) = lu(k,2250) - lu(k,1819) * lu(k,2249) + lu(k,2251) = lu(k,2251) - lu(k,1820) * lu(k,2249) + lu(k,2252) = lu(k,2252) - lu(k,1821) * lu(k,2249) + lu(k,2253) = lu(k,2253) - lu(k,1822) * lu(k,2249) + lu(k,2254) = lu(k,2254) - lu(k,1823) * lu(k,2249) + lu(k,2255) = lu(k,2255) - lu(k,1824) * lu(k,2249) + lu(k,2256) = lu(k,2256) - lu(k,1825) * lu(k,2249) + lu(k,2257) = lu(k,2257) - lu(k,1826) * lu(k,2249) + lu(k,2258) = lu(k,2258) - lu(k,1827) * lu(k,2249) + lu(k,2259) = lu(k,2259) - lu(k,1828) * lu(k,2249) + lu(k,2260) = lu(k,2260) - lu(k,1829) * lu(k,2249) + lu(k,2261) = lu(k,2261) - lu(k,1830) * lu(k,2249) + lu(k,2262) = lu(k,2262) - lu(k,1831) * lu(k,2249) + lu(k,2358) = lu(k,2358) - lu(k,1819) * lu(k,2357) + lu(k,2359) = lu(k,2359) - lu(k,1820) * lu(k,2357) + lu(k,2360) = lu(k,2360) - lu(k,1821) * lu(k,2357) + lu(k,2361) = lu(k,2361) - lu(k,1822) * lu(k,2357) + lu(k,2362) = lu(k,2362) - lu(k,1823) * lu(k,2357) + lu(k,2363) = lu(k,2363) - lu(k,1824) * lu(k,2357) + lu(k,2364) = lu(k,2364) - lu(k,1825) * lu(k,2357) + lu(k,2365) = lu(k,2365) - lu(k,1826) * lu(k,2357) + lu(k,2366) = lu(k,2366) - lu(k,1827) * lu(k,2357) + lu(k,2367) = lu(k,2367) - lu(k,1828) * lu(k,2357) + lu(k,2368) = lu(k,2368) - lu(k,1829) * lu(k,2357) + lu(k,2369) = lu(k,2369) - lu(k,1830) * lu(k,2357) + lu(k,2370) = lu(k,2370) - lu(k,1831) * lu(k,2357) + lu(k,2410) = lu(k,2410) - lu(k,1819) * lu(k,2409) + lu(k,2411) = lu(k,2411) - lu(k,1820) * lu(k,2409) + lu(k,2412) = lu(k,2412) - lu(k,1821) * lu(k,2409) + lu(k,2413) = lu(k,2413) - lu(k,1822) * lu(k,2409) + lu(k,2414) = lu(k,2414) - lu(k,1823) * lu(k,2409) + lu(k,2415) = lu(k,2415) - lu(k,1824) * lu(k,2409) + lu(k,2416) = lu(k,2416) - lu(k,1825) * lu(k,2409) + lu(k,2417) = lu(k,2417) - lu(k,1826) * lu(k,2409) + lu(k,2418) = lu(k,2418) - lu(k,1827) * lu(k,2409) + lu(k,2419) = lu(k,2419) - lu(k,1828) * lu(k,2409) + lu(k,2420) = lu(k,2420) - lu(k,1829) * lu(k,2409) + lu(k,2421) = lu(k,2421) - lu(k,1830) * lu(k,2409) + lu(k,2422) = lu(k,2422) - lu(k,1831) * lu(k,2409) + lu(k,2437) = lu(k,2437) - lu(k,1819) * lu(k,2436) + lu(k,2438) = lu(k,2438) - lu(k,1820) * lu(k,2436) + lu(k,2439) = lu(k,2439) - lu(k,1821) * lu(k,2436) + lu(k,2440) = lu(k,2440) - lu(k,1822) * lu(k,2436) + lu(k,2441) = lu(k,2441) - lu(k,1823) * lu(k,2436) + lu(k,2442) = lu(k,2442) - lu(k,1824) * lu(k,2436) + lu(k,2443) = lu(k,2443) - lu(k,1825) * lu(k,2436) + lu(k,2444) = lu(k,2444) - lu(k,1826) * lu(k,2436) + lu(k,2445) = lu(k,2445) - lu(k,1827) * lu(k,2436) + lu(k,2446) = lu(k,2446) - lu(k,1828) * lu(k,2436) + lu(k,2447) = lu(k,2447) - lu(k,1829) * lu(k,2436) + lu(k,2448) = lu(k,2448) - lu(k,1830) * lu(k,2436) + lu(k,2449) = lu(k,2449) - lu(k,1831) * lu(k,2436) + lu(k,1914) = 1._r8 / lu(k,1914) + lu(k,1915) = lu(k,1915) * lu(k,1914) + lu(k,1916) = lu(k,1916) * lu(k,1914) + lu(k,1917) = lu(k,1917) * lu(k,1914) + lu(k,1918) = lu(k,1918) * lu(k,1914) + lu(k,1919) = lu(k,1919) * lu(k,1914) + lu(k,1920) = lu(k,1920) * lu(k,1914) + lu(k,1921) = lu(k,1921) * lu(k,1914) + lu(k,1922) = lu(k,1922) * lu(k,1914) + lu(k,1923) = lu(k,1923) * lu(k,1914) + lu(k,1924) = lu(k,1924) * lu(k,1914) + lu(k,1925) = lu(k,1925) * lu(k,1914) + lu(k,1926) = lu(k,1926) * lu(k,1914) + lu(k,1960) = lu(k,1960) - lu(k,1915) * lu(k,1959) + lu(k,1961) = lu(k,1961) - lu(k,1916) * lu(k,1959) + lu(k,1962) = lu(k,1962) - lu(k,1917) * lu(k,1959) + lu(k,1963) = lu(k,1963) - lu(k,1918) * lu(k,1959) + lu(k,1964) = lu(k,1964) - lu(k,1919) * lu(k,1959) + lu(k,1965) = lu(k,1965) - lu(k,1920) * lu(k,1959) + lu(k,1966) = lu(k,1966) - lu(k,1921) * lu(k,1959) + lu(k,1967) = lu(k,1967) - lu(k,1922) * lu(k,1959) + lu(k,1968) = lu(k,1968) - lu(k,1923) * lu(k,1959) + lu(k,1969) = lu(k,1969) - lu(k,1924) * lu(k,1959) + lu(k,1970) = lu(k,1970) - lu(k,1925) * lu(k,1959) + lu(k,1971) = lu(k,1971) - lu(k,1926) * lu(k,1959) + lu(k,1986) = lu(k,1986) - lu(k,1915) * lu(k,1985) + lu(k,1987) = lu(k,1987) - lu(k,1916) * lu(k,1985) + lu(k,1988) = lu(k,1988) - lu(k,1917) * lu(k,1985) + lu(k,1989) = lu(k,1989) - lu(k,1918) * lu(k,1985) + lu(k,1990) = lu(k,1990) - lu(k,1919) * lu(k,1985) + lu(k,1991) = lu(k,1991) - lu(k,1920) * lu(k,1985) + lu(k,1992) = lu(k,1992) - lu(k,1921) * lu(k,1985) + lu(k,1993) = lu(k,1993) - lu(k,1922) * lu(k,1985) + lu(k,1994) = lu(k,1994) - lu(k,1923) * lu(k,1985) + lu(k,1995) = lu(k,1995) - lu(k,1924) * lu(k,1985) + lu(k,1996) = lu(k,1996) - lu(k,1925) * lu(k,1985) + lu(k,1997) = lu(k,1997) - lu(k,1926) * lu(k,1985) + lu(k,2029) = lu(k,2029) - lu(k,1915) * lu(k,2028) + lu(k,2030) = lu(k,2030) - lu(k,1916) * lu(k,2028) + lu(k,2031) = lu(k,2031) - lu(k,1917) * lu(k,2028) + lu(k,2032) = lu(k,2032) - lu(k,1918) * lu(k,2028) + lu(k,2033) = lu(k,2033) - lu(k,1919) * lu(k,2028) + lu(k,2034) = lu(k,2034) - lu(k,1920) * lu(k,2028) + lu(k,2035) = lu(k,2035) - lu(k,1921) * lu(k,2028) + lu(k,2036) = lu(k,2036) - lu(k,1922) * lu(k,2028) + lu(k,2037) = lu(k,2037) - lu(k,1923) * lu(k,2028) + lu(k,2038) = lu(k,2038) - lu(k,1924) * lu(k,2028) + lu(k,2039) = lu(k,2039) - lu(k,1925) * lu(k,2028) + lu(k,2040) = lu(k,2040) - lu(k,1926) * lu(k,2028) + lu(k,2052) = lu(k,2052) - lu(k,1915) * lu(k,2051) + lu(k,2053) = lu(k,2053) - lu(k,1916) * lu(k,2051) + lu(k,2054) = lu(k,2054) - lu(k,1917) * lu(k,2051) + lu(k,2055) = lu(k,2055) - lu(k,1918) * lu(k,2051) + lu(k,2056) = lu(k,2056) - lu(k,1919) * lu(k,2051) + lu(k,2057) = lu(k,2057) - lu(k,1920) * lu(k,2051) + lu(k,2058) = lu(k,2058) - lu(k,1921) * lu(k,2051) + lu(k,2059) = lu(k,2059) - lu(k,1922) * lu(k,2051) + lu(k,2060) = lu(k,2060) - lu(k,1923) * lu(k,2051) + lu(k,2061) = lu(k,2061) - lu(k,1924) * lu(k,2051) + lu(k,2062) = lu(k,2062) - lu(k,1925) * lu(k,2051) + lu(k,2063) = lu(k,2063) - lu(k,1926) * lu(k,2051) + lu(k,2095) = lu(k,2095) - lu(k,1915) * lu(k,2094) + lu(k,2096) = lu(k,2096) - lu(k,1916) * lu(k,2094) + lu(k,2097) = lu(k,2097) - lu(k,1917) * lu(k,2094) + lu(k,2098) = lu(k,2098) - lu(k,1918) * lu(k,2094) + lu(k,2099) = lu(k,2099) - lu(k,1919) * lu(k,2094) + lu(k,2100) = lu(k,2100) - lu(k,1920) * lu(k,2094) + lu(k,2101) = lu(k,2101) - lu(k,1921) * lu(k,2094) + lu(k,2102) = lu(k,2102) - lu(k,1922) * lu(k,2094) + lu(k,2103) = lu(k,2103) - lu(k,1923) * lu(k,2094) + lu(k,2104) = lu(k,2104) - lu(k,1924) * lu(k,2094) + lu(k,2105) = lu(k,2105) - lu(k,1925) * lu(k,2094) + lu(k,2106) = lu(k,2106) - lu(k,1926) * lu(k,2094) + lu(k,2116) = lu(k,2116) - lu(k,1915) * lu(k,2115) + lu(k,2117) = lu(k,2117) - lu(k,1916) * lu(k,2115) + lu(k,2118) = lu(k,2118) - lu(k,1917) * lu(k,2115) + lu(k,2119) = lu(k,2119) - lu(k,1918) * lu(k,2115) + lu(k,2120) = lu(k,2120) - lu(k,1919) * lu(k,2115) + lu(k,2121) = lu(k,2121) - lu(k,1920) * lu(k,2115) + lu(k,2122) = lu(k,2122) - lu(k,1921) * lu(k,2115) + lu(k,2123) = lu(k,2123) - lu(k,1922) * lu(k,2115) + lu(k,2124) = lu(k,2124) - lu(k,1923) * lu(k,2115) + lu(k,2125) = lu(k,2125) - lu(k,1924) * lu(k,2115) + lu(k,2126) = lu(k,2126) - lu(k,1925) * lu(k,2115) + lu(k,2127) = lu(k,2127) - lu(k,1926) * lu(k,2115) + lu(k,2162) = lu(k,2162) - lu(k,1915) * lu(k,2161) + lu(k,2163) = lu(k,2163) - lu(k,1916) * lu(k,2161) + lu(k,2164) = lu(k,2164) - lu(k,1917) * lu(k,2161) + lu(k,2165) = lu(k,2165) - lu(k,1918) * lu(k,2161) + lu(k,2166) = lu(k,2166) - lu(k,1919) * lu(k,2161) + lu(k,2167) = lu(k,2167) - lu(k,1920) * lu(k,2161) + lu(k,2168) = lu(k,2168) - lu(k,1921) * lu(k,2161) + lu(k,2169) = lu(k,2169) - lu(k,1922) * lu(k,2161) + lu(k,2170) = lu(k,2170) - lu(k,1923) * lu(k,2161) + lu(k,2171) = lu(k,2171) - lu(k,1924) * lu(k,2161) + lu(k,2172) = lu(k,2172) - lu(k,1925) * lu(k,2161) + lu(k,2173) = lu(k,2173) - lu(k,1926) * lu(k,2161) + lu(k,2226) = lu(k,2226) - lu(k,1915) * lu(k,2225) + lu(k,2227) = lu(k,2227) - lu(k,1916) * lu(k,2225) + lu(k,2228) = lu(k,2228) - lu(k,1917) * lu(k,2225) + lu(k,2229) = lu(k,2229) - lu(k,1918) * lu(k,2225) + lu(k,2230) = lu(k,2230) - lu(k,1919) * lu(k,2225) + lu(k,2231) = lu(k,2231) - lu(k,1920) * lu(k,2225) + lu(k,2232) = lu(k,2232) - lu(k,1921) * lu(k,2225) + lu(k,2233) = lu(k,2233) - lu(k,1922) * lu(k,2225) + lu(k,2234) = lu(k,2234) - lu(k,1923) * lu(k,2225) + lu(k,2235) = lu(k,2235) - lu(k,1924) * lu(k,2225) + lu(k,2236) = lu(k,2236) - lu(k,1925) * lu(k,2225) + lu(k,2237) = lu(k,2237) - lu(k,1926) * lu(k,2225) + lu(k,2251) = lu(k,2251) - lu(k,1915) * lu(k,2250) + lu(k,2252) = lu(k,2252) - lu(k,1916) * lu(k,2250) + lu(k,2253) = lu(k,2253) - lu(k,1917) * lu(k,2250) + lu(k,2254) = lu(k,2254) - lu(k,1918) * lu(k,2250) + lu(k,2255) = lu(k,2255) - lu(k,1919) * lu(k,2250) + lu(k,2256) = lu(k,2256) - lu(k,1920) * lu(k,2250) + lu(k,2257) = lu(k,2257) - lu(k,1921) * lu(k,2250) + lu(k,2258) = lu(k,2258) - lu(k,1922) * lu(k,2250) + lu(k,2259) = lu(k,2259) - lu(k,1923) * lu(k,2250) + lu(k,2260) = lu(k,2260) - lu(k,1924) * lu(k,2250) + lu(k,2261) = lu(k,2261) - lu(k,1925) * lu(k,2250) + lu(k,2262) = lu(k,2262) - lu(k,1926) * lu(k,2250) + lu(k,2359) = lu(k,2359) - lu(k,1915) * lu(k,2358) + lu(k,2360) = lu(k,2360) - lu(k,1916) * lu(k,2358) + lu(k,2361) = lu(k,2361) - lu(k,1917) * lu(k,2358) + lu(k,2362) = lu(k,2362) - lu(k,1918) * lu(k,2358) + lu(k,2363) = lu(k,2363) - lu(k,1919) * lu(k,2358) + lu(k,2364) = lu(k,2364) - lu(k,1920) * lu(k,2358) + lu(k,2365) = lu(k,2365) - lu(k,1921) * lu(k,2358) + lu(k,2366) = lu(k,2366) - lu(k,1922) * lu(k,2358) + lu(k,2367) = lu(k,2367) - lu(k,1923) * lu(k,2358) + lu(k,2368) = lu(k,2368) - lu(k,1924) * lu(k,2358) + lu(k,2369) = lu(k,2369) - lu(k,1925) * lu(k,2358) + lu(k,2370) = lu(k,2370) - lu(k,1926) * lu(k,2358) + lu(k,2411) = lu(k,2411) - lu(k,1915) * lu(k,2410) + lu(k,2412) = lu(k,2412) - lu(k,1916) * lu(k,2410) + lu(k,2413) = lu(k,2413) - lu(k,1917) * lu(k,2410) + lu(k,2414) = lu(k,2414) - lu(k,1918) * lu(k,2410) + lu(k,2415) = lu(k,2415) - lu(k,1919) * lu(k,2410) + lu(k,2416) = lu(k,2416) - lu(k,1920) * lu(k,2410) + lu(k,2417) = lu(k,2417) - lu(k,1921) * lu(k,2410) + lu(k,2418) = lu(k,2418) - lu(k,1922) * lu(k,2410) + lu(k,2419) = lu(k,2419) - lu(k,1923) * lu(k,2410) + lu(k,2420) = lu(k,2420) - lu(k,1924) * lu(k,2410) + lu(k,2421) = lu(k,2421) - lu(k,1925) * lu(k,2410) + lu(k,2422) = lu(k,2422) - lu(k,1926) * lu(k,2410) + lu(k,2438) = lu(k,2438) - lu(k,1915) * lu(k,2437) + lu(k,2439) = lu(k,2439) - lu(k,1916) * lu(k,2437) + lu(k,2440) = lu(k,2440) - lu(k,1917) * lu(k,2437) + lu(k,2441) = lu(k,2441) - lu(k,1918) * lu(k,2437) + lu(k,2442) = lu(k,2442) - lu(k,1919) * lu(k,2437) + lu(k,2443) = lu(k,2443) - lu(k,1920) * lu(k,2437) + lu(k,2444) = lu(k,2444) - lu(k,1921) * lu(k,2437) + lu(k,2445) = lu(k,2445) - lu(k,1922) * lu(k,2437) + lu(k,2446) = lu(k,2446) - lu(k,1923) * lu(k,2437) + lu(k,2447) = lu(k,2447) - lu(k,1924) * lu(k,2437) + lu(k,2448) = lu(k,2448) - lu(k,1925) * lu(k,2437) + lu(k,2449) = lu(k,2449) - lu(k,1926) * lu(k,2437) + lu(k,1960) = 1._r8 / lu(k,1960) + lu(k,1961) = lu(k,1961) * lu(k,1960) + lu(k,1962) = lu(k,1962) * lu(k,1960) + lu(k,1963) = lu(k,1963) * lu(k,1960) + lu(k,1964) = lu(k,1964) * lu(k,1960) + lu(k,1965) = lu(k,1965) * lu(k,1960) + lu(k,1966) = lu(k,1966) * lu(k,1960) + lu(k,1967) = lu(k,1967) * lu(k,1960) + lu(k,1968) = lu(k,1968) * lu(k,1960) + lu(k,1969) = lu(k,1969) * lu(k,1960) + lu(k,1970) = lu(k,1970) * lu(k,1960) + lu(k,1971) = lu(k,1971) * lu(k,1960) + lu(k,1987) = lu(k,1987) - lu(k,1961) * lu(k,1986) + lu(k,1988) = lu(k,1988) - lu(k,1962) * lu(k,1986) + lu(k,1989) = lu(k,1989) - lu(k,1963) * lu(k,1986) + lu(k,1990) = lu(k,1990) - lu(k,1964) * lu(k,1986) + lu(k,1991) = lu(k,1991) - lu(k,1965) * lu(k,1986) + lu(k,1992) = lu(k,1992) - lu(k,1966) * lu(k,1986) + lu(k,1993) = lu(k,1993) - lu(k,1967) * lu(k,1986) + lu(k,1994) = lu(k,1994) - lu(k,1968) * lu(k,1986) + lu(k,1995) = lu(k,1995) - lu(k,1969) * lu(k,1986) + lu(k,1996) = lu(k,1996) - lu(k,1970) * lu(k,1986) + lu(k,1997) = lu(k,1997) - lu(k,1971) * lu(k,1986) + lu(k,2030) = lu(k,2030) - lu(k,1961) * lu(k,2029) + lu(k,2031) = lu(k,2031) - lu(k,1962) * lu(k,2029) + lu(k,2032) = lu(k,2032) - lu(k,1963) * lu(k,2029) + lu(k,2033) = lu(k,2033) - lu(k,1964) * lu(k,2029) + lu(k,2034) = lu(k,2034) - lu(k,1965) * lu(k,2029) + lu(k,2035) = lu(k,2035) - lu(k,1966) * lu(k,2029) + lu(k,2036) = lu(k,2036) - lu(k,1967) * lu(k,2029) + lu(k,2037) = lu(k,2037) - lu(k,1968) * lu(k,2029) + lu(k,2038) = lu(k,2038) - lu(k,1969) * lu(k,2029) + lu(k,2039) = lu(k,2039) - lu(k,1970) * lu(k,2029) + lu(k,2040) = lu(k,2040) - lu(k,1971) * lu(k,2029) + lu(k,2053) = lu(k,2053) - lu(k,1961) * lu(k,2052) + lu(k,2054) = lu(k,2054) - lu(k,1962) * lu(k,2052) + lu(k,2055) = lu(k,2055) - lu(k,1963) * lu(k,2052) + lu(k,2056) = lu(k,2056) - lu(k,1964) * lu(k,2052) + lu(k,2057) = lu(k,2057) - lu(k,1965) * lu(k,2052) + lu(k,2058) = lu(k,2058) - lu(k,1966) * lu(k,2052) + lu(k,2059) = lu(k,2059) - lu(k,1967) * lu(k,2052) + lu(k,2060) = lu(k,2060) - lu(k,1968) * lu(k,2052) + lu(k,2061) = lu(k,2061) - lu(k,1969) * lu(k,2052) + lu(k,2062) = lu(k,2062) - lu(k,1970) * lu(k,2052) + lu(k,2063) = lu(k,2063) - lu(k,1971) * lu(k,2052) + lu(k,2096) = lu(k,2096) - lu(k,1961) * lu(k,2095) + lu(k,2097) = lu(k,2097) - lu(k,1962) * lu(k,2095) + lu(k,2098) = lu(k,2098) - lu(k,1963) * lu(k,2095) + lu(k,2099) = lu(k,2099) - lu(k,1964) * lu(k,2095) + lu(k,2100) = lu(k,2100) - lu(k,1965) * lu(k,2095) + lu(k,2101) = lu(k,2101) - lu(k,1966) * lu(k,2095) + lu(k,2102) = lu(k,2102) - lu(k,1967) * lu(k,2095) + lu(k,2103) = lu(k,2103) - lu(k,1968) * lu(k,2095) + lu(k,2104) = lu(k,2104) - lu(k,1969) * lu(k,2095) + lu(k,2105) = lu(k,2105) - lu(k,1970) * lu(k,2095) + lu(k,2106) = lu(k,2106) - lu(k,1971) * lu(k,2095) + lu(k,2117) = lu(k,2117) - lu(k,1961) * lu(k,2116) + lu(k,2118) = lu(k,2118) - lu(k,1962) * lu(k,2116) + lu(k,2119) = lu(k,2119) - lu(k,1963) * lu(k,2116) + lu(k,2120) = lu(k,2120) - lu(k,1964) * lu(k,2116) + lu(k,2121) = lu(k,2121) - lu(k,1965) * lu(k,2116) + lu(k,2122) = lu(k,2122) - lu(k,1966) * lu(k,2116) + lu(k,2123) = lu(k,2123) - lu(k,1967) * lu(k,2116) + lu(k,2124) = lu(k,2124) - lu(k,1968) * lu(k,2116) + lu(k,2125) = lu(k,2125) - lu(k,1969) * lu(k,2116) + lu(k,2126) = lu(k,2126) - lu(k,1970) * lu(k,2116) + lu(k,2127) = lu(k,2127) - lu(k,1971) * lu(k,2116) + lu(k,2163) = lu(k,2163) - lu(k,1961) * lu(k,2162) + lu(k,2164) = lu(k,2164) - lu(k,1962) * lu(k,2162) + lu(k,2165) = lu(k,2165) - lu(k,1963) * lu(k,2162) + lu(k,2166) = lu(k,2166) - lu(k,1964) * lu(k,2162) + lu(k,2167) = lu(k,2167) - lu(k,1965) * lu(k,2162) + lu(k,2168) = lu(k,2168) - lu(k,1966) * lu(k,2162) + lu(k,2169) = lu(k,2169) - lu(k,1967) * lu(k,2162) + lu(k,2170) = lu(k,2170) - lu(k,1968) * lu(k,2162) + lu(k,2171) = lu(k,2171) - lu(k,1969) * lu(k,2162) + lu(k,2172) = lu(k,2172) - lu(k,1970) * lu(k,2162) + lu(k,2173) = lu(k,2173) - lu(k,1971) * lu(k,2162) + lu(k,2227) = lu(k,2227) - lu(k,1961) * lu(k,2226) + lu(k,2228) = lu(k,2228) - lu(k,1962) * lu(k,2226) + lu(k,2229) = lu(k,2229) - lu(k,1963) * lu(k,2226) + lu(k,2230) = lu(k,2230) - lu(k,1964) * lu(k,2226) + lu(k,2231) = lu(k,2231) - lu(k,1965) * lu(k,2226) + lu(k,2232) = lu(k,2232) - lu(k,1966) * lu(k,2226) + lu(k,2233) = lu(k,2233) - lu(k,1967) * lu(k,2226) + lu(k,2234) = lu(k,2234) - lu(k,1968) * lu(k,2226) + lu(k,2235) = lu(k,2235) - lu(k,1969) * lu(k,2226) + lu(k,2236) = lu(k,2236) - lu(k,1970) * lu(k,2226) + lu(k,2237) = lu(k,2237) - lu(k,1971) * lu(k,2226) + lu(k,2252) = lu(k,2252) - lu(k,1961) * lu(k,2251) + lu(k,2253) = lu(k,2253) - lu(k,1962) * lu(k,2251) + lu(k,2254) = lu(k,2254) - lu(k,1963) * lu(k,2251) + lu(k,2255) = lu(k,2255) - lu(k,1964) * lu(k,2251) + lu(k,2256) = lu(k,2256) - lu(k,1965) * lu(k,2251) + lu(k,2257) = lu(k,2257) - lu(k,1966) * lu(k,2251) + lu(k,2258) = lu(k,2258) - lu(k,1967) * lu(k,2251) + lu(k,2259) = lu(k,2259) - lu(k,1968) * lu(k,2251) + lu(k,2260) = lu(k,2260) - lu(k,1969) * lu(k,2251) + lu(k,2261) = lu(k,2261) - lu(k,1970) * lu(k,2251) + lu(k,2262) = lu(k,2262) - lu(k,1971) * lu(k,2251) + lu(k,2360) = lu(k,2360) - lu(k,1961) * lu(k,2359) + lu(k,2361) = lu(k,2361) - lu(k,1962) * lu(k,2359) + lu(k,2362) = lu(k,2362) - lu(k,1963) * lu(k,2359) + lu(k,2363) = lu(k,2363) - lu(k,1964) * lu(k,2359) + lu(k,2364) = lu(k,2364) - lu(k,1965) * lu(k,2359) + lu(k,2365) = lu(k,2365) - lu(k,1966) * lu(k,2359) + lu(k,2366) = lu(k,2366) - lu(k,1967) * lu(k,2359) + lu(k,2367) = lu(k,2367) - lu(k,1968) * lu(k,2359) + lu(k,2368) = lu(k,2368) - lu(k,1969) * lu(k,2359) + lu(k,2369) = lu(k,2369) - lu(k,1970) * lu(k,2359) + lu(k,2370) = lu(k,2370) - lu(k,1971) * lu(k,2359) + lu(k,2412) = lu(k,2412) - lu(k,1961) * lu(k,2411) + lu(k,2413) = lu(k,2413) - lu(k,1962) * lu(k,2411) + lu(k,2414) = lu(k,2414) - lu(k,1963) * lu(k,2411) + lu(k,2415) = lu(k,2415) - lu(k,1964) * lu(k,2411) + lu(k,2416) = lu(k,2416) - lu(k,1965) * lu(k,2411) + lu(k,2417) = lu(k,2417) - lu(k,1966) * lu(k,2411) + lu(k,2418) = lu(k,2418) - lu(k,1967) * lu(k,2411) + lu(k,2419) = lu(k,2419) - lu(k,1968) * lu(k,2411) + lu(k,2420) = lu(k,2420) - lu(k,1969) * lu(k,2411) + lu(k,2421) = lu(k,2421) - lu(k,1970) * lu(k,2411) + lu(k,2422) = lu(k,2422) - lu(k,1971) * lu(k,2411) + lu(k,2439) = lu(k,2439) - lu(k,1961) * lu(k,2438) + lu(k,2440) = lu(k,2440) - lu(k,1962) * lu(k,2438) + lu(k,2441) = lu(k,2441) - lu(k,1963) * lu(k,2438) + lu(k,2442) = lu(k,2442) - lu(k,1964) * lu(k,2438) + lu(k,2443) = lu(k,2443) - lu(k,1965) * lu(k,2438) + lu(k,2444) = lu(k,2444) - lu(k,1966) * lu(k,2438) + lu(k,2445) = lu(k,2445) - lu(k,1967) * lu(k,2438) + lu(k,2446) = lu(k,2446) - lu(k,1968) * lu(k,2438) + lu(k,2447) = lu(k,2447) - lu(k,1969) * lu(k,2438) + lu(k,2448) = lu(k,2448) - lu(k,1970) * lu(k,2438) + lu(k,2449) = lu(k,2449) - lu(k,1971) * lu(k,2438) + lu(k,1987) = 1._r8 / lu(k,1987) + lu(k,1988) = lu(k,1988) * lu(k,1987) + lu(k,1989) = lu(k,1989) * lu(k,1987) + lu(k,1990) = lu(k,1990) * lu(k,1987) + lu(k,1991) = lu(k,1991) * lu(k,1987) + lu(k,1992) = lu(k,1992) * lu(k,1987) + lu(k,1993) = lu(k,1993) * lu(k,1987) + lu(k,1994) = lu(k,1994) * lu(k,1987) + lu(k,1995) = lu(k,1995) * lu(k,1987) + lu(k,1996) = lu(k,1996) * lu(k,1987) + lu(k,1997) = lu(k,1997) * lu(k,1987) + lu(k,2031) = lu(k,2031) - lu(k,1988) * lu(k,2030) + lu(k,2032) = lu(k,2032) - lu(k,1989) * lu(k,2030) + lu(k,2033) = lu(k,2033) - lu(k,1990) * lu(k,2030) + lu(k,2034) = lu(k,2034) - lu(k,1991) * lu(k,2030) + lu(k,2035) = lu(k,2035) - lu(k,1992) * lu(k,2030) + lu(k,2036) = lu(k,2036) - lu(k,1993) * lu(k,2030) + lu(k,2037) = lu(k,2037) - lu(k,1994) * lu(k,2030) + lu(k,2038) = lu(k,2038) - lu(k,1995) * lu(k,2030) + lu(k,2039) = lu(k,2039) - lu(k,1996) * lu(k,2030) + lu(k,2040) = lu(k,2040) - lu(k,1997) * lu(k,2030) + lu(k,2054) = lu(k,2054) - lu(k,1988) * lu(k,2053) + lu(k,2055) = lu(k,2055) - lu(k,1989) * lu(k,2053) + lu(k,2056) = lu(k,2056) - lu(k,1990) * lu(k,2053) + lu(k,2057) = lu(k,2057) - lu(k,1991) * lu(k,2053) + lu(k,2058) = lu(k,2058) - lu(k,1992) * lu(k,2053) + lu(k,2059) = lu(k,2059) - lu(k,1993) * lu(k,2053) + lu(k,2060) = lu(k,2060) - lu(k,1994) * lu(k,2053) + lu(k,2061) = lu(k,2061) - lu(k,1995) * lu(k,2053) + lu(k,2062) = lu(k,2062) - lu(k,1996) * lu(k,2053) + lu(k,2063) = lu(k,2063) - lu(k,1997) * lu(k,2053) + lu(k,2097) = lu(k,2097) - lu(k,1988) * lu(k,2096) + lu(k,2098) = lu(k,2098) - lu(k,1989) * lu(k,2096) + lu(k,2099) = lu(k,2099) - lu(k,1990) * lu(k,2096) + lu(k,2100) = lu(k,2100) - lu(k,1991) * lu(k,2096) + lu(k,2101) = lu(k,2101) - lu(k,1992) * lu(k,2096) + lu(k,2102) = lu(k,2102) - lu(k,1993) * lu(k,2096) + lu(k,2103) = lu(k,2103) - lu(k,1994) * lu(k,2096) + lu(k,2104) = lu(k,2104) - lu(k,1995) * lu(k,2096) + lu(k,2105) = lu(k,2105) - lu(k,1996) * lu(k,2096) + lu(k,2106) = lu(k,2106) - lu(k,1997) * lu(k,2096) + lu(k,2118) = lu(k,2118) - lu(k,1988) * lu(k,2117) + lu(k,2119) = lu(k,2119) - lu(k,1989) * lu(k,2117) + lu(k,2120) = lu(k,2120) - lu(k,1990) * lu(k,2117) + lu(k,2121) = lu(k,2121) - lu(k,1991) * lu(k,2117) + lu(k,2122) = lu(k,2122) - lu(k,1992) * lu(k,2117) + lu(k,2123) = lu(k,2123) - lu(k,1993) * lu(k,2117) + lu(k,2124) = lu(k,2124) - lu(k,1994) * lu(k,2117) + lu(k,2125) = lu(k,2125) - lu(k,1995) * lu(k,2117) + lu(k,2126) = lu(k,2126) - lu(k,1996) * lu(k,2117) + lu(k,2127) = lu(k,2127) - lu(k,1997) * lu(k,2117) + lu(k,2164) = lu(k,2164) - lu(k,1988) * lu(k,2163) + lu(k,2165) = lu(k,2165) - lu(k,1989) * lu(k,2163) + lu(k,2166) = lu(k,2166) - lu(k,1990) * lu(k,2163) + lu(k,2167) = lu(k,2167) - lu(k,1991) * lu(k,2163) + lu(k,2168) = lu(k,2168) - lu(k,1992) * lu(k,2163) + lu(k,2169) = lu(k,2169) - lu(k,1993) * lu(k,2163) + lu(k,2170) = lu(k,2170) - lu(k,1994) * lu(k,2163) + lu(k,2171) = lu(k,2171) - lu(k,1995) * lu(k,2163) + lu(k,2172) = lu(k,2172) - lu(k,1996) * lu(k,2163) + lu(k,2173) = lu(k,2173) - lu(k,1997) * lu(k,2163) + lu(k,2228) = lu(k,2228) - lu(k,1988) * lu(k,2227) + lu(k,2229) = lu(k,2229) - lu(k,1989) * lu(k,2227) + lu(k,2230) = lu(k,2230) - lu(k,1990) * lu(k,2227) + lu(k,2231) = lu(k,2231) - lu(k,1991) * lu(k,2227) + lu(k,2232) = lu(k,2232) - lu(k,1992) * lu(k,2227) + lu(k,2233) = lu(k,2233) - lu(k,1993) * lu(k,2227) + lu(k,2234) = lu(k,2234) - lu(k,1994) * lu(k,2227) + lu(k,2235) = lu(k,2235) - lu(k,1995) * lu(k,2227) + lu(k,2236) = lu(k,2236) - lu(k,1996) * lu(k,2227) + lu(k,2237) = lu(k,2237) - lu(k,1997) * lu(k,2227) + lu(k,2253) = lu(k,2253) - lu(k,1988) * lu(k,2252) + lu(k,2254) = lu(k,2254) - lu(k,1989) * lu(k,2252) + lu(k,2255) = lu(k,2255) - lu(k,1990) * lu(k,2252) + lu(k,2256) = lu(k,2256) - lu(k,1991) * lu(k,2252) + lu(k,2257) = lu(k,2257) - lu(k,1992) * lu(k,2252) + lu(k,2258) = lu(k,2258) - lu(k,1993) * lu(k,2252) + lu(k,2259) = lu(k,2259) - lu(k,1994) * lu(k,2252) + lu(k,2260) = lu(k,2260) - lu(k,1995) * lu(k,2252) + lu(k,2261) = lu(k,2261) - lu(k,1996) * lu(k,2252) + lu(k,2262) = lu(k,2262) - lu(k,1997) * lu(k,2252) + lu(k,2361) = lu(k,2361) - lu(k,1988) * lu(k,2360) + lu(k,2362) = lu(k,2362) - lu(k,1989) * lu(k,2360) + lu(k,2363) = lu(k,2363) - lu(k,1990) * lu(k,2360) + lu(k,2364) = lu(k,2364) - lu(k,1991) * lu(k,2360) + lu(k,2365) = lu(k,2365) - lu(k,1992) * lu(k,2360) + lu(k,2366) = lu(k,2366) - lu(k,1993) * lu(k,2360) + lu(k,2367) = lu(k,2367) - lu(k,1994) * lu(k,2360) + lu(k,2368) = lu(k,2368) - lu(k,1995) * lu(k,2360) + lu(k,2369) = lu(k,2369) - lu(k,1996) * lu(k,2360) + lu(k,2370) = lu(k,2370) - lu(k,1997) * lu(k,2360) + lu(k,2413) = lu(k,2413) - lu(k,1988) * lu(k,2412) + lu(k,2414) = lu(k,2414) - lu(k,1989) * lu(k,2412) + lu(k,2415) = lu(k,2415) - lu(k,1990) * lu(k,2412) + lu(k,2416) = lu(k,2416) - lu(k,1991) * lu(k,2412) + lu(k,2417) = lu(k,2417) - lu(k,1992) * lu(k,2412) + lu(k,2418) = lu(k,2418) - lu(k,1993) * lu(k,2412) + lu(k,2419) = lu(k,2419) - lu(k,1994) * lu(k,2412) + lu(k,2420) = lu(k,2420) - lu(k,1995) * lu(k,2412) + lu(k,2421) = lu(k,2421) - lu(k,1996) * lu(k,2412) + lu(k,2422) = lu(k,2422) - lu(k,1997) * lu(k,2412) + lu(k,2440) = lu(k,2440) - lu(k,1988) * lu(k,2439) + lu(k,2441) = lu(k,2441) - lu(k,1989) * lu(k,2439) + lu(k,2442) = lu(k,2442) - lu(k,1990) * lu(k,2439) + lu(k,2443) = lu(k,2443) - lu(k,1991) * lu(k,2439) + lu(k,2444) = lu(k,2444) - lu(k,1992) * lu(k,2439) + lu(k,2445) = lu(k,2445) - lu(k,1993) * lu(k,2439) + lu(k,2446) = lu(k,2446) - lu(k,1994) * lu(k,2439) + lu(k,2447) = lu(k,2447) - lu(k,1995) * lu(k,2439) + lu(k,2448) = lu(k,2448) - lu(k,1996) * lu(k,2439) + lu(k,2449) = lu(k,2449) - lu(k,1997) * lu(k,2439) + lu(k,2031) = 1._r8 / lu(k,2031) + lu(k,2032) = lu(k,2032) * lu(k,2031) + lu(k,2033) = lu(k,2033) * lu(k,2031) + lu(k,2034) = lu(k,2034) * lu(k,2031) + lu(k,2035) = lu(k,2035) * lu(k,2031) + lu(k,2036) = lu(k,2036) * lu(k,2031) + lu(k,2037) = lu(k,2037) * lu(k,2031) + lu(k,2038) = lu(k,2038) * lu(k,2031) + lu(k,2039) = lu(k,2039) * lu(k,2031) + lu(k,2040) = lu(k,2040) * lu(k,2031) + lu(k,2055) = lu(k,2055) - lu(k,2032) * lu(k,2054) + lu(k,2056) = lu(k,2056) - lu(k,2033) * lu(k,2054) + lu(k,2057) = lu(k,2057) - lu(k,2034) * lu(k,2054) + lu(k,2058) = lu(k,2058) - lu(k,2035) * lu(k,2054) + lu(k,2059) = lu(k,2059) - lu(k,2036) * lu(k,2054) + lu(k,2060) = lu(k,2060) - lu(k,2037) * lu(k,2054) + lu(k,2061) = lu(k,2061) - lu(k,2038) * lu(k,2054) + lu(k,2062) = lu(k,2062) - lu(k,2039) * lu(k,2054) + lu(k,2063) = lu(k,2063) - lu(k,2040) * lu(k,2054) + lu(k,2098) = lu(k,2098) - lu(k,2032) * lu(k,2097) + lu(k,2099) = lu(k,2099) - lu(k,2033) * lu(k,2097) + lu(k,2100) = lu(k,2100) - lu(k,2034) * lu(k,2097) + lu(k,2101) = lu(k,2101) - lu(k,2035) * lu(k,2097) + lu(k,2102) = lu(k,2102) - lu(k,2036) * lu(k,2097) + lu(k,2103) = lu(k,2103) - lu(k,2037) * lu(k,2097) + lu(k,2104) = lu(k,2104) - lu(k,2038) * lu(k,2097) + lu(k,2105) = lu(k,2105) - lu(k,2039) * lu(k,2097) + lu(k,2106) = lu(k,2106) - lu(k,2040) * lu(k,2097) + lu(k,2119) = lu(k,2119) - lu(k,2032) * lu(k,2118) + lu(k,2120) = lu(k,2120) - lu(k,2033) * lu(k,2118) + lu(k,2121) = lu(k,2121) - lu(k,2034) * lu(k,2118) + lu(k,2122) = lu(k,2122) - lu(k,2035) * lu(k,2118) + lu(k,2123) = lu(k,2123) - lu(k,2036) * lu(k,2118) + lu(k,2124) = lu(k,2124) - lu(k,2037) * lu(k,2118) + lu(k,2125) = lu(k,2125) - lu(k,2038) * lu(k,2118) + lu(k,2126) = lu(k,2126) - lu(k,2039) * lu(k,2118) + lu(k,2127) = lu(k,2127) - lu(k,2040) * lu(k,2118) + lu(k,2165) = lu(k,2165) - lu(k,2032) * lu(k,2164) + lu(k,2166) = lu(k,2166) - lu(k,2033) * lu(k,2164) + lu(k,2167) = lu(k,2167) - lu(k,2034) * lu(k,2164) + lu(k,2168) = lu(k,2168) - lu(k,2035) * lu(k,2164) + lu(k,2169) = lu(k,2169) - lu(k,2036) * lu(k,2164) + lu(k,2170) = lu(k,2170) - lu(k,2037) * lu(k,2164) + lu(k,2171) = lu(k,2171) - lu(k,2038) * lu(k,2164) + lu(k,2172) = lu(k,2172) - lu(k,2039) * lu(k,2164) + lu(k,2173) = lu(k,2173) - lu(k,2040) * lu(k,2164) + lu(k,2229) = lu(k,2229) - lu(k,2032) * lu(k,2228) + lu(k,2230) = lu(k,2230) - lu(k,2033) * lu(k,2228) + lu(k,2231) = lu(k,2231) - lu(k,2034) * lu(k,2228) + lu(k,2232) = lu(k,2232) - lu(k,2035) * lu(k,2228) + lu(k,2233) = lu(k,2233) - lu(k,2036) * lu(k,2228) + lu(k,2234) = lu(k,2234) - lu(k,2037) * lu(k,2228) + lu(k,2235) = lu(k,2235) - lu(k,2038) * lu(k,2228) + lu(k,2236) = lu(k,2236) - lu(k,2039) * lu(k,2228) + lu(k,2237) = lu(k,2237) - lu(k,2040) * lu(k,2228) + lu(k,2254) = lu(k,2254) - lu(k,2032) * lu(k,2253) + lu(k,2255) = lu(k,2255) - lu(k,2033) * lu(k,2253) + lu(k,2256) = lu(k,2256) - lu(k,2034) * lu(k,2253) + lu(k,2257) = lu(k,2257) - lu(k,2035) * lu(k,2253) + lu(k,2258) = lu(k,2258) - lu(k,2036) * lu(k,2253) + lu(k,2259) = lu(k,2259) - lu(k,2037) * lu(k,2253) + lu(k,2260) = lu(k,2260) - lu(k,2038) * lu(k,2253) + lu(k,2261) = lu(k,2261) - lu(k,2039) * lu(k,2253) + lu(k,2262) = lu(k,2262) - lu(k,2040) * lu(k,2253) + lu(k,2362) = lu(k,2362) - lu(k,2032) * lu(k,2361) + lu(k,2363) = lu(k,2363) - lu(k,2033) * lu(k,2361) + lu(k,2364) = lu(k,2364) - lu(k,2034) * lu(k,2361) + lu(k,2365) = lu(k,2365) - lu(k,2035) * lu(k,2361) + lu(k,2366) = lu(k,2366) - lu(k,2036) * lu(k,2361) + lu(k,2367) = lu(k,2367) - lu(k,2037) * lu(k,2361) + lu(k,2368) = lu(k,2368) - lu(k,2038) * lu(k,2361) + lu(k,2369) = lu(k,2369) - lu(k,2039) * lu(k,2361) + lu(k,2370) = lu(k,2370) - lu(k,2040) * lu(k,2361) + lu(k,2414) = lu(k,2414) - lu(k,2032) * lu(k,2413) + lu(k,2415) = lu(k,2415) - lu(k,2033) * lu(k,2413) + lu(k,2416) = lu(k,2416) - lu(k,2034) * lu(k,2413) + lu(k,2417) = lu(k,2417) - lu(k,2035) * lu(k,2413) + lu(k,2418) = lu(k,2418) - lu(k,2036) * lu(k,2413) + lu(k,2419) = lu(k,2419) - lu(k,2037) * lu(k,2413) + lu(k,2420) = lu(k,2420) - lu(k,2038) * lu(k,2413) + lu(k,2421) = lu(k,2421) - lu(k,2039) * lu(k,2413) + lu(k,2422) = lu(k,2422) - lu(k,2040) * lu(k,2413) + lu(k,2441) = lu(k,2441) - lu(k,2032) * lu(k,2440) + lu(k,2442) = lu(k,2442) - lu(k,2033) * lu(k,2440) + lu(k,2443) = lu(k,2443) - lu(k,2034) * lu(k,2440) + lu(k,2444) = lu(k,2444) - lu(k,2035) * lu(k,2440) + lu(k,2445) = lu(k,2445) - lu(k,2036) * lu(k,2440) + lu(k,2446) = lu(k,2446) - lu(k,2037) * lu(k,2440) + lu(k,2447) = lu(k,2447) - lu(k,2038) * lu(k,2440) + lu(k,2448) = lu(k,2448) - lu(k,2039) * lu(k,2440) + lu(k,2449) = lu(k,2449) - lu(k,2040) * lu(k,2440) + end do + end subroutine lu_fac31 + subroutine lu_fac32( 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,2055) = 1._r8 / lu(k,2055) + lu(k,2056) = lu(k,2056) * lu(k,2055) + lu(k,2057) = lu(k,2057) * lu(k,2055) + lu(k,2058) = lu(k,2058) * lu(k,2055) + lu(k,2059) = lu(k,2059) * lu(k,2055) + lu(k,2060) = lu(k,2060) * lu(k,2055) + lu(k,2061) = lu(k,2061) * lu(k,2055) + lu(k,2062) = lu(k,2062) * lu(k,2055) + lu(k,2063) = lu(k,2063) * lu(k,2055) + lu(k,2099) = lu(k,2099) - lu(k,2056) * lu(k,2098) + lu(k,2100) = lu(k,2100) - lu(k,2057) * lu(k,2098) + lu(k,2101) = lu(k,2101) - lu(k,2058) * lu(k,2098) + lu(k,2102) = lu(k,2102) - lu(k,2059) * lu(k,2098) + lu(k,2103) = lu(k,2103) - lu(k,2060) * lu(k,2098) + lu(k,2104) = lu(k,2104) - lu(k,2061) * lu(k,2098) + lu(k,2105) = lu(k,2105) - lu(k,2062) * lu(k,2098) + lu(k,2106) = lu(k,2106) - lu(k,2063) * lu(k,2098) + lu(k,2120) = lu(k,2120) - lu(k,2056) * lu(k,2119) + lu(k,2121) = lu(k,2121) - lu(k,2057) * lu(k,2119) + lu(k,2122) = lu(k,2122) - lu(k,2058) * lu(k,2119) + lu(k,2123) = lu(k,2123) - lu(k,2059) * lu(k,2119) + lu(k,2124) = lu(k,2124) - lu(k,2060) * lu(k,2119) + lu(k,2125) = lu(k,2125) - lu(k,2061) * lu(k,2119) + lu(k,2126) = lu(k,2126) - lu(k,2062) * lu(k,2119) + lu(k,2127) = lu(k,2127) - lu(k,2063) * lu(k,2119) + lu(k,2166) = lu(k,2166) - lu(k,2056) * lu(k,2165) + lu(k,2167) = lu(k,2167) - lu(k,2057) * lu(k,2165) + lu(k,2168) = lu(k,2168) - lu(k,2058) * lu(k,2165) + lu(k,2169) = lu(k,2169) - lu(k,2059) * lu(k,2165) + lu(k,2170) = lu(k,2170) - lu(k,2060) * lu(k,2165) + lu(k,2171) = lu(k,2171) - lu(k,2061) * lu(k,2165) + lu(k,2172) = lu(k,2172) - lu(k,2062) * lu(k,2165) + lu(k,2173) = lu(k,2173) - lu(k,2063) * lu(k,2165) + lu(k,2230) = lu(k,2230) - lu(k,2056) * lu(k,2229) + lu(k,2231) = lu(k,2231) - lu(k,2057) * lu(k,2229) + lu(k,2232) = lu(k,2232) - lu(k,2058) * lu(k,2229) + lu(k,2233) = lu(k,2233) - lu(k,2059) * lu(k,2229) + lu(k,2234) = lu(k,2234) - lu(k,2060) * lu(k,2229) + lu(k,2235) = lu(k,2235) - lu(k,2061) * lu(k,2229) + lu(k,2236) = lu(k,2236) - lu(k,2062) * lu(k,2229) + lu(k,2237) = lu(k,2237) - lu(k,2063) * lu(k,2229) + lu(k,2255) = lu(k,2255) - lu(k,2056) * lu(k,2254) + lu(k,2256) = lu(k,2256) - lu(k,2057) * lu(k,2254) + lu(k,2257) = lu(k,2257) - lu(k,2058) * lu(k,2254) + lu(k,2258) = lu(k,2258) - lu(k,2059) * lu(k,2254) + lu(k,2259) = lu(k,2259) - lu(k,2060) * lu(k,2254) + lu(k,2260) = lu(k,2260) - lu(k,2061) * lu(k,2254) + lu(k,2261) = lu(k,2261) - lu(k,2062) * lu(k,2254) + lu(k,2262) = lu(k,2262) - lu(k,2063) * lu(k,2254) + lu(k,2363) = lu(k,2363) - lu(k,2056) * lu(k,2362) + lu(k,2364) = lu(k,2364) - lu(k,2057) * lu(k,2362) + lu(k,2365) = lu(k,2365) - lu(k,2058) * lu(k,2362) + lu(k,2366) = lu(k,2366) - lu(k,2059) * lu(k,2362) + lu(k,2367) = lu(k,2367) - lu(k,2060) * lu(k,2362) + lu(k,2368) = lu(k,2368) - lu(k,2061) * lu(k,2362) + lu(k,2369) = lu(k,2369) - lu(k,2062) * lu(k,2362) + lu(k,2370) = lu(k,2370) - lu(k,2063) * lu(k,2362) + lu(k,2415) = lu(k,2415) - lu(k,2056) * lu(k,2414) + lu(k,2416) = lu(k,2416) - lu(k,2057) * lu(k,2414) + lu(k,2417) = lu(k,2417) - lu(k,2058) * lu(k,2414) + lu(k,2418) = lu(k,2418) - lu(k,2059) * lu(k,2414) + lu(k,2419) = lu(k,2419) - lu(k,2060) * lu(k,2414) + lu(k,2420) = lu(k,2420) - lu(k,2061) * lu(k,2414) + lu(k,2421) = lu(k,2421) - lu(k,2062) * lu(k,2414) + lu(k,2422) = lu(k,2422) - lu(k,2063) * lu(k,2414) + lu(k,2442) = lu(k,2442) - lu(k,2056) * lu(k,2441) + lu(k,2443) = lu(k,2443) - lu(k,2057) * lu(k,2441) + lu(k,2444) = lu(k,2444) - lu(k,2058) * lu(k,2441) + lu(k,2445) = lu(k,2445) - lu(k,2059) * lu(k,2441) + lu(k,2446) = lu(k,2446) - lu(k,2060) * lu(k,2441) + lu(k,2447) = lu(k,2447) - lu(k,2061) * lu(k,2441) + lu(k,2448) = lu(k,2448) - lu(k,2062) * lu(k,2441) + lu(k,2449) = lu(k,2449) - lu(k,2063) * lu(k,2441) + lu(k,2099) = 1._r8 / lu(k,2099) + lu(k,2100) = lu(k,2100) * lu(k,2099) + lu(k,2101) = lu(k,2101) * lu(k,2099) + lu(k,2102) = lu(k,2102) * lu(k,2099) + lu(k,2103) = lu(k,2103) * lu(k,2099) + lu(k,2104) = lu(k,2104) * lu(k,2099) + lu(k,2105) = lu(k,2105) * lu(k,2099) + lu(k,2106) = lu(k,2106) * lu(k,2099) + lu(k,2121) = lu(k,2121) - lu(k,2100) * lu(k,2120) + lu(k,2122) = lu(k,2122) - lu(k,2101) * lu(k,2120) + lu(k,2123) = lu(k,2123) - lu(k,2102) * lu(k,2120) + lu(k,2124) = lu(k,2124) - lu(k,2103) * lu(k,2120) + lu(k,2125) = lu(k,2125) - lu(k,2104) * lu(k,2120) + lu(k,2126) = lu(k,2126) - lu(k,2105) * lu(k,2120) + lu(k,2127) = lu(k,2127) - lu(k,2106) * lu(k,2120) + lu(k,2167) = lu(k,2167) - lu(k,2100) * lu(k,2166) + lu(k,2168) = lu(k,2168) - lu(k,2101) * lu(k,2166) + lu(k,2169) = lu(k,2169) - lu(k,2102) * lu(k,2166) + lu(k,2170) = lu(k,2170) - lu(k,2103) * lu(k,2166) + lu(k,2171) = lu(k,2171) - lu(k,2104) * lu(k,2166) + lu(k,2172) = lu(k,2172) - lu(k,2105) * lu(k,2166) + lu(k,2173) = lu(k,2173) - lu(k,2106) * lu(k,2166) + lu(k,2231) = lu(k,2231) - lu(k,2100) * lu(k,2230) + lu(k,2232) = lu(k,2232) - lu(k,2101) * lu(k,2230) + lu(k,2233) = lu(k,2233) - lu(k,2102) * lu(k,2230) + lu(k,2234) = lu(k,2234) - lu(k,2103) * lu(k,2230) + lu(k,2235) = lu(k,2235) - lu(k,2104) * lu(k,2230) + lu(k,2236) = lu(k,2236) - lu(k,2105) * lu(k,2230) + lu(k,2237) = lu(k,2237) - lu(k,2106) * lu(k,2230) + lu(k,2256) = lu(k,2256) - lu(k,2100) * lu(k,2255) + lu(k,2257) = lu(k,2257) - lu(k,2101) * lu(k,2255) + lu(k,2258) = lu(k,2258) - lu(k,2102) * lu(k,2255) + lu(k,2259) = lu(k,2259) - lu(k,2103) * lu(k,2255) + lu(k,2260) = lu(k,2260) - lu(k,2104) * lu(k,2255) + lu(k,2261) = lu(k,2261) - lu(k,2105) * lu(k,2255) + lu(k,2262) = lu(k,2262) - lu(k,2106) * lu(k,2255) + lu(k,2364) = lu(k,2364) - lu(k,2100) * lu(k,2363) + lu(k,2365) = lu(k,2365) - lu(k,2101) * lu(k,2363) + lu(k,2366) = lu(k,2366) - lu(k,2102) * lu(k,2363) + lu(k,2367) = lu(k,2367) - lu(k,2103) * lu(k,2363) + lu(k,2368) = lu(k,2368) - lu(k,2104) * lu(k,2363) + lu(k,2369) = lu(k,2369) - lu(k,2105) * lu(k,2363) + lu(k,2370) = lu(k,2370) - lu(k,2106) * lu(k,2363) + lu(k,2416) = lu(k,2416) - lu(k,2100) * lu(k,2415) + lu(k,2417) = lu(k,2417) - lu(k,2101) * lu(k,2415) + lu(k,2418) = lu(k,2418) - lu(k,2102) * lu(k,2415) + lu(k,2419) = lu(k,2419) - lu(k,2103) * lu(k,2415) + lu(k,2420) = lu(k,2420) - lu(k,2104) * lu(k,2415) + lu(k,2421) = lu(k,2421) - lu(k,2105) * lu(k,2415) + lu(k,2422) = lu(k,2422) - lu(k,2106) * lu(k,2415) + lu(k,2443) = lu(k,2443) - lu(k,2100) * lu(k,2442) + lu(k,2444) = lu(k,2444) - lu(k,2101) * lu(k,2442) + lu(k,2445) = lu(k,2445) - lu(k,2102) * lu(k,2442) + lu(k,2446) = lu(k,2446) - lu(k,2103) * lu(k,2442) + lu(k,2447) = lu(k,2447) - lu(k,2104) * lu(k,2442) + lu(k,2448) = lu(k,2448) - lu(k,2105) * lu(k,2442) + lu(k,2449) = lu(k,2449) - lu(k,2106) * lu(k,2442) + lu(k,2121) = 1._r8 / lu(k,2121) + lu(k,2122) = lu(k,2122) * lu(k,2121) + lu(k,2123) = lu(k,2123) * lu(k,2121) + lu(k,2124) = lu(k,2124) * lu(k,2121) + lu(k,2125) = lu(k,2125) * lu(k,2121) + lu(k,2126) = lu(k,2126) * lu(k,2121) + lu(k,2127) = lu(k,2127) * lu(k,2121) + lu(k,2168) = lu(k,2168) - lu(k,2122) * lu(k,2167) + lu(k,2169) = lu(k,2169) - lu(k,2123) * lu(k,2167) + lu(k,2170) = lu(k,2170) - lu(k,2124) * lu(k,2167) + lu(k,2171) = lu(k,2171) - lu(k,2125) * lu(k,2167) + lu(k,2172) = lu(k,2172) - lu(k,2126) * lu(k,2167) + lu(k,2173) = lu(k,2173) - lu(k,2127) * lu(k,2167) + lu(k,2232) = lu(k,2232) - lu(k,2122) * lu(k,2231) + lu(k,2233) = lu(k,2233) - lu(k,2123) * lu(k,2231) + lu(k,2234) = lu(k,2234) - lu(k,2124) * lu(k,2231) + lu(k,2235) = lu(k,2235) - lu(k,2125) * lu(k,2231) + lu(k,2236) = lu(k,2236) - lu(k,2126) * lu(k,2231) + lu(k,2237) = lu(k,2237) - lu(k,2127) * lu(k,2231) + lu(k,2257) = lu(k,2257) - lu(k,2122) * lu(k,2256) + lu(k,2258) = lu(k,2258) - lu(k,2123) * lu(k,2256) + lu(k,2259) = lu(k,2259) - lu(k,2124) * lu(k,2256) + lu(k,2260) = lu(k,2260) - lu(k,2125) * lu(k,2256) + lu(k,2261) = lu(k,2261) - lu(k,2126) * lu(k,2256) + lu(k,2262) = lu(k,2262) - lu(k,2127) * lu(k,2256) + lu(k,2365) = lu(k,2365) - lu(k,2122) * lu(k,2364) + lu(k,2366) = lu(k,2366) - lu(k,2123) * lu(k,2364) + lu(k,2367) = lu(k,2367) - lu(k,2124) * lu(k,2364) + lu(k,2368) = lu(k,2368) - lu(k,2125) * lu(k,2364) + lu(k,2369) = lu(k,2369) - lu(k,2126) * lu(k,2364) + lu(k,2370) = lu(k,2370) - lu(k,2127) * lu(k,2364) + lu(k,2417) = lu(k,2417) - lu(k,2122) * lu(k,2416) + lu(k,2418) = lu(k,2418) - lu(k,2123) * lu(k,2416) + lu(k,2419) = lu(k,2419) - lu(k,2124) * lu(k,2416) + lu(k,2420) = lu(k,2420) - lu(k,2125) * lu(k,2416) + lu(k,2421) = lu(k,2421) - lu(k,2126) * lu(k,2416) + lu(k,2422) = lu(k,2422) - lu(k,2127) * lu(k,2416) + lu(k,2444) = lu(k,2444) - lu(k,2122) * lu(k,2443) + lu(k,2445) = lu(k,2445) - lu(k,2123) * lu(k,2443) + lu(k,2446) = lu(k,2446) - lu(k,2124) * lu(k,2443) + lu(k,2447) = lu(k,2447) - lu(k,2125) * lu(k,2443) + lu(k,2448) = lu(k,2448) - lu(k,2126) * lu(k,2443) + lu(k,2449) = lu(k,2449) - lu(k,2127) * lu(k,2443) + lu(k,2168) = 1._r8 / lu(k,2168) + lu(k,2169) = lu(k,2169) * lu(k,2168) + lu(k,2170) = lu(k,2170) * lu(k,2168) + lu(k,2171) = lu(k,2171) * lu(k,2168) + lu(k,2172) = lu(k,2172) * lu(k,2168) + lu(k,2173) = lu(k,2173) * lu(k,2168) + lu(k,2233) = lu(k,2233) - lu(k,2169) * lu(k,2232) + lu(k,2234) = lu(k,2234) - lu(k,2170) * lu(k,2232) + lu(k,2235) = lu(k,2235) - lu(k,2171) * lu(k,2232) + lu(k,2236) = lu(k,2236) - lu(k,2172) * lu(k,2232) + lu(k,2237) = lu(k,2237) - lu(k,2173) * lu(k,2232) + lu(k,2258) = lu(k,2258) - lu(k,2169) * lu(k,2257) + lu(k,2259) = lu(k,2259) - lu(k,2170) * lu(k,2257) + lu(k,2260) = lu(k,2260) - lu(k,2171) * lu(k,2257) + lu(k,2261) = lu(k,2261) - lu(k,2172) * lu(k,2257) + lu(k,2262) = lu(k,2262) - lu(k,2173) * lu(k,2257) + lu(k,2366) = lu(k,2366) - lu(k,2169) * lu(k,2365) + lu(k,2367) = lu(k,2367) - lu(k,2170) * lu(k,2365) + lu(k,2368) = lu(k,2368) - lu(k,2171) * lu(k,2365) + lu(k,2369) = lu(k,2369) - lu(k,2172) * lu(k,2365) + lu(k,2370) = lu(k,2370) - lu(k,2173) * lu(k,2365) + lu(k,2418) = lu(k,2418) - lu(k,2169) * lu(k,2417) + lu(k,2419) = lu(k,2419) - lu(k,2170) * lu(k,2417) + lu(k,2420) = lu(k,2420) - lu(k,2171) * lu(k,2417) + lu(k,2421) = lu(k,2421) - lu(k,2172) * lu(k,2417) + lu(k,2422) = lu(k,2422) - lu(k,2173) * lu(k,2417) + lu(k,2445) = lu(k,2445) - lu(k,2169) * lu(k,2444) + lu(k,2446) = lu(k,2446) - lu(k,2170) * lu(k,2444) + lu(k,2447) = lu(k,2447) - lu(k,2171) * lu(k,2444) + lu(k,2448) = lu(k,2448) - lu(k,2172) * lu(k,2444) + lu(k,2449) = lu(k,2449) - lu(k,2173) * lu(k,2444) + lu(k,2233) = 1._r8 / lu(k,2233) + lu(k,2234) = lu(k,2234) * lu(k,2233) + lu(k,2235) = lu(k,2235) * lu(k,2233) + lu(k,2236) = lu(k,2236) * lu(k,2233) + lu(k,2237) = lu(k,2237) * lu(k,2233) + lu(k,2259) = lu(k,2259) - lu(k,2234) * lu(k,2258) + lu(k,2260) = lu(k,2260) - lu(k,2235) * lu(k,2258) + lu(k,2261) = lu(k,2261) - lu(k,2236) * lu(k,2258) + lu(k,2262) = lu(k,2262) - lu(k,2237) * lu(k,2258) + lu(k,2367) = lu(k,2367) - lu(k,2234) * lu(k,2366) + lu(k,2368) = lu(k,2368) - lu(k,2235) * lu(k,2366) + lu(k,2369) = lu(k,2369) - lu(k,2236) * lu(k,2366) + lu(k,2370) = lu(k,2370) - lu(k,2237) * lu(k,2366) + lu(k,2419) = lu(k,2419) - lu(k,2234) * lu(k,2418) + lu(k,2420) = lu(k,2420) - lu(k,2235) * lu(k,2418) + lu(k,2421) = lu(k,2421) - lu(k,2236) * lu(k,2418) + lu(k,2422) = lu(k,2422) - lu(k,2237) * lu(k,2418) + lu(k,2446) = lu(k,2446) - lu(k,2234) * lu(k,2445) + lu(k,2447) = lu(k,2447) - lu(k,2235) * lu(k,2445) + lu(k,2448) = lu(k,2448) - lu(k,2236) * lu(k,2445) + lu(k,2449) = lu(k,2449) - lu(k,2237) * lu(k,2445) + lu(k,2259) = 1._r8 / lu(k,2259) + lu(k,2260) = lu(k,2260) * lu(k,2259) + lu(k,2261) = lu(k,2261) * lu(k,2259) + lu(k,2262) = lu(k,2262) * lu(k,2259) + lu(k,2368) = lu(k,2368) - lu(k,2260) * lu(k,2367) + lu(k,2369) = lu(k,2369) - lu(k,2261) * lu(k,2367) + lu(k,2370) = lu(k,2370) - lu(k,2262) * lu(k,2367) + lu(k,2420) = lu(k,2420) - lu(k,2260) * lu(k,2419) + lu(k,2421) = lu(k,2421) - lu(k,2261) * lu(k,2419) + lu(k,2422) = lu(k,2422) - lu(k,2262) * lu(k,2419) + lu(k,2447) = lu(k,2447) - lu(k,2260) * lu(k,2446) + lu(k,2448) = lu(k,2448) - lu(k,2261) * lu(k,2446) + lu(k,2449) = lu(k,2449) - lu(k,2262) * lu(k,2446) + lu(k,2368) = 1._r8 / lu(k,2368) + lu(k,2369) = lu(k,2369) * lu(k,2368) + lu(k,2370) = lu(k,2370) * lu(k,2368) + lu(k,2421) = lu(k,2421) - lu(k,2369) * lu(k,2420) + lu(k,2422) = lu(k,2422) - lu(k,2370) * lu(k,2420) + lu(k,2448) = lu(k,2448) - lu(k,2369) * lu(k,2447) + lu(k,2449) = lu(k,2449) - lu(k,2370) * lu(k,2447) + lu(k,2421) = 1._r8 / lu(k,2421) + lu(k,2422) = lu(k,2422) * lu(k,2421) + lu(k,2449) = lu(k,2449) - lu(k,2422) * lu(k,2448) + lu(k,2449) = 1._r8 / lu(k,2449) + end do + end subroutine lu_fac32 + 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 ) + call lu_fac19( avec_len, lu ) + call lu_fac20( avec_len, lu ) + call lu_fac21( avec_len, lu ) + call lu_fac22( avec_len, lu ) + call lu_fac23( avec_len, lu ) + call lu_fac24( avec_len, lu ) + call lu_fac25( avec_len, lu ) + call lu_fac26( avec_len, lu ) + call lu_fac27( avec_len, lu ) + call lu_fac28( avec_len, lu ) + call lu_fac29( avec_len, lu ) + call lu_fac30( avec_len, lu ) + call lu_fac31( avec_len, lu ) + call lu_fac32( avec_len, lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/mo_lu_solve.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/mo_lu_solve.F90 new file mode 100644 index 0000000000..64bbb136a5 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/mo_lu_solve.F90 @@ -0,0 +1,2721 @@ + 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,224) = b(k,224) - lu(k,96) * b(k,54) + b(k,234) = b(k,234) - lu(k,97) * b(k,54) + b(k,226) = b(k,226) - lu(k,99) * b(k,55) + b(k,239) = b(k,239) - lu(k,100) * b(k,55) + b(k,230) = b(k,230) - lu(k,102) * b(k,56) + b(k,234) = b(k,234) - lu(k,103) * b(k,56) + b(k,226) = b(k,226) - lu(k,105) * b(k,57) + b(k,237) = b(k,237) - lu(k,106) * b(k,57) + b(k,89) = b(k,89) - lu(k,108) * b(k,58) + b(k,221) = b(k,221) - lu(k,109) * b(k,58) + b(k,230) = b(k,230) - lu(k,110) * b(k,58) + b(k,91) = b(k,91) - lu(k,112) * b(k,59) + b(k,230) = b(k,230) - lu(k,113) * b(k,59) + b(k,234) = b(k,234) - lu(k,114) * b(k,59) + b(k,89) = b(k,89) - lu(k,116) * b(k,60) + b(k,230) = b(k,230) - lu(k,117) * b(k,60) + b(k,234) = b(k,234) - lu(k,118) * b(k,60) + b(k,89) = b(k,89) - lu(k,120) * b(k,61) + b(k,230) = b(k,230) - lu(k,121) * b(k,61) + b(k,234) = b(k,234) - lu(k,122) * b(k,61) + b(k,226) = b(k,226) - lu(k,124) * b(k,62) + b(k,234) = b(k,234) - lu(k,125) * b(k,62) + b(k,239) = b(k,239) - lu(k,126) * b(k,62) + b(k,129) = b(k,129) - lu(k,128) * b(k,63) + b(k,226) = b(k,226) - lu(k,129) * b(k,63) + b(k,94) = b(k,94) - lu(k,131) * b(k,64) + b(k,239) = b(k,239) - lu(k,132) * b(k,64) + b(k,207) = b(k,207) - lu(k,134) * b(k,65) + b(k,226) = b(k,226) - lu(k,135) * b(k,65) + b(k,139) = b(k,139) - lu(k,137) * b(k,66) + b(k,228) = b(k,228) - lu(k,138) * b(k,66) + b(k,89) = b(k,89) - lu(k,140) * b(k,67) + b(k,221) = b(k,221) - lu(k,141) * b(k,67) + b(k,230) = b(k,230) - lu(k,142) * b(k,67) + b(k,234) = b(k,234) - lu(k,143) * b(k,67) + b(k,89) = b(k,89) - lu(k,145) * b(k,68) + b(k,184) = b(k,184) - lu(k,146) * b(k,68) + b(k,221) = b(k,221) - lu(k,147) * b(k,68) + b(k,230) = b(k,230) - lu(k,148) * b(k,68) + b(k,89) = b(k,89) - lu(k,150) * b(k,69) + b(k,91) = b(k,91) - lu(k,151) * b(k,69) + b(k,230) = b(k,230) - lu(k,152) * b(k,69) + b(k,234) = b(k,234) - lu(k,153) * b(k,69) + b(k,89) = b(k,89) - lu(k,155) * b(k,70) + b(k,184) = b(k,184) - lu(k,156) * b(k,70) + b(k,230) = b(k,230) - lu(k,157) * b(k,70) + b(k,234) = b(k,234) - lu(k,158) * b(k,70) + b(k,72) = b(k,72) - lu(k,161) * b(k,71) + b(k,73) = b(k,73) - lu(k,162) * b(k,71) + b(k,135) = b(k,135) - lu(k,163) * b(k,71) + b(k,226) = b(k,226) - lu(k,164) * b(k,71) + b(k,237) = b(k,237) - lu(k,165) * b(k,71) + b(k,130) = b(k,130) - lu(k,167) * b(k,72) + b(k,201) = b(k,201) - lu(k,168) * b(k,72) + b(k,237) = b(k,237) - lu(k,169) * b(k,72) + b(k,127) = b(k,127) - lu(k,171) * b(k,73) + b(k,131) = b(k,131) - lu(k,172) * b(k,73) + b(k,226) = b(k,226) - lu(k,173) * b(k,73) + b(k,237) = b(k,237) - lu(k,174) * b(k,73) + b(k,234) = b(k,234) - lu(k,176) * b(k,74) + b(k,222) = b(k,222) - lu(k,178) * b(k,75) + b(k,222) = b(k,222) - lu(k,181) * b(k,76) + b(k,226) = b(k,226) - lu(k,183) * b(k,77) + b(k,230) = b(k,230) - lu(k,184) * b(k,77) + b(k,237) = b(k,237) - lu(k,185) * b(k,77) + b(k,79) = b(k,79) - lu(k,188) * b(k,78) + b(k,80) = b(k,80) - lu(k,189) * b(k,78) + b(k,125) = b(k,125) - lu(k,190) * b(k,78) + b(k,166) = b(k,166) - lu(k,191) * b(k,78) + b(k,226) = b(k,226) - lu(k,192) * b(k,78) + b(k,237) = b(k,237) - lu(k,193) * b(k,78) + b(k,127) = b(k,127) - lu(k,195) * b(k,79) + b(k,131) = b(k,131) - lu(k,196) * b(k,79) + b(k,226) = b(k,226) - lu(k,197) * b(k,79) + b(k,237) = b(k,237) - lu(k,198) * b(k,79) + b(k,201) = b(k,201) - lu(k,200) * b(k,80) + b(k,216) = b(k,216) - lu(k,201) * b(k,80) + b(k,237) = b(k,237) - lu(k,202) * b(k,80) + b(k,207) = b(k,207) - lu(k,204) * b(k,81) + b(k,226) = b(k,226) - lu(k,205) * b(k,81) + b(k,83) = b(k,83) - lu(k,209) * b(k,82) + b(k,125) = b(k,125) - lu(k,210) * b(k,82) + b(k,167) = b(k,167) - lu(k,211) * b(k,82) + b(k,201) = b(k,201) - lu(k,212) * b(k,82) + b(k,216) = b(k,216) - lu(k,213) * b(k,82) + b(k,226) = b(k,226) - lu(k,214) * b(k,82) + b(k,237) = b(k,237) - lu(k,215) * b(k,82) + b(k,131) = b(k,131) - lu(k,217) * b(k,83) + b(k,137) = b(k,137) - lu(k,218) * b(k,83) + b(k,226) = b(k,226) - lu(k,219) * b(k,83) + b(k,237) = b(k,237) - lu(k,220) * b(k,83) + b(k,149) = b(k,149) - lu(k,222) * b(k,84) + b(k,207) = b(k,207) - lu(k,223) * b(k,84) + b(k,226) = b(k,226) - lu(k,224) * b(k,84) + b(k,237) = b(k,237) - lu(k,225) * b(k,84) + b(k,191) = b(k,191) - lu(k,227) * b(k,85) + b(k,226) = b(k,226) - lu(k,228) * b(k,85) + b(k,221) = b(k,221) - lu(k,230) * b(k,86) + b(k,234) = b(k,234) - lu(k,231) * b(k,86) + b(k,228) = b(k,228) - lu(k,233) * b(k,87) + b(k,231) = b(k,231) - lu(k,234) * b(k,87) + b(k,139) = b(k,139) - lu(k,236) * b(k,88) + b(k,226) = b(k,226) - lu(k,237) * b(k,88) + b(k,184) = b(k,184) - lu(k,239) * b(k,89) + b(k,230) = b(k,230) - lu(k,240) * b(k,89) + b(k,91) = b(k,91) - lu(k,242) * b(k,90) + b(k,226) = b(k,226) - lu(k,243) * b(k,90) + b(k,230) = b(k,230) - lu(k,244) * b(k,90) + b(k,234) = b(k,234) - lu(k,245) * b(k,90) + b(k,184) = b(k,184) - lu(k,247) * b(k,91) + b(k,230) = b(k,230) - lu(k,248) * b(k,91) + b(k,234) = b(k,234) - lu(k,249) * b(k,91) + b(k,184) = b(k,184) - lu(k,252) * b(k,92) + b(k,226) = b(k,226) - lu(k,253) * b(k,92) + b(k,230) = b(k,230) - lu(k,254) * b(k,92) + b(k,234) = b(k,234) - lu(k,255) * b(k,92) + b(k,222) = b(k,222) - lu(k,257) * b(k,93) + b(k,227) = b(k,227) - lu(k,258) * b(k,93) + b(k,230) = b(k,230) - lu(k,259) * b(k,93) + b(k,186) = b(k,186) - lu(k,262) * b(k,94) + b(k,232) = b(k,232) - lu(k,263) * b(k,94) + b(k,239) = b(k,239) - lu(k,264) * b(k,94) + b(k,200) = b(k,200) - lu(k,266) * b(k,95) + b(k,226) = b(k,226) - lu(k,267) * b(k,95) + b(k,237) = b(k,237) - lu(k,268) * b(k,95) + b(k,131) = b(k,131) - lu(k,270) * b(k,96) + b(k,154) = b(k,154) - lu(k,271) * b(k,96) + b(k,226) = b(k,226) - lu(k,272) * b(k,96) + b(k,225) = b(k,225) - lu(k,274) * b(k,97) + b(k,227) = b(k,227) - lu(k,275) * b(k,97) + b(k,228) = b(k,228) - lu(k,276) * b(k,97) + b(k,231) = b(k,231) - lu(k,277) * b(k,97) + b(k,232) = b(k,232) - lu(k,278) * b(k,97) + b(k,168) = b(k,168) - lu(k,280) * b(k,98) + b(k,237) = b(k,237) - lu(k,281) * b(k,98) + b(k,184) = b(k,184) - lu(k,283) * b(k,99) + b(k,233) = b(k,233) - lu(k,284) * b(k,99) + b(k,183) = b(k,183) - lu(k,286) * b(k,100) + b(k,192) = b(k,192) - lu(k,287) * b(k,100) + b(k,201) = b(k,201) - lu(k,288) * b(k,100) + b(k,226) = b(k,226) - lu(k,289) * b(k,100) + b(k,237) = b(k,237) - lu(k,290) * b(k,100) + b(k,184) = b(k,184) - lu(k,293) * b(k,101) + b(k,226) = b(k,226) - lu(k,294) * b(k,101) + b(k,230) = b(k,230) - lu(k,295) * b(k,101) + b(k,234) = b(k,234) - lu(k,296) * b(k,101) + b(k,239) = b(k,239) - lu(k,297) * b(k,101) + b(k,181) = b(k,181) - lu(k,299) * b(k,102) + b(k,220) = b(k,220) - lu(k,300) * b(k,102) + b(k,226) = b(k,226) - lu(k,301) * b(k,102) + b(k,234) = b(k,234) - lu(k,302) * b(k,102) + b(k,239) = b(k,239) - lu(k,303) * b(k,102) + b(k,185) = b(k,185) - lu(k,305) * b(k,103) + b(k,220) = b(k,220) - lu(k,306) * b(k,103) + b(k,226) = b(k,226) - lu(k,307) * b(k,103) + b(k,234) = b(k,234) - lu(k,308) * b(k,103) + b(k,239) = b(k,239) - lu(k,309) * b(k,103) + b(k,186) = b(k,186) - lu(k,311) * b(k,104) + b(k,225) = b(k,225) - lu(k,312) * b(k,104) + b(k,226) = b(k,226) - lu(k,313) * b(k,104) + b(k,231) = b(k,231) - lu(k,314) * b(k,104) + b(k,237) = b(k,237) - lu(k,315) * b(k,104) + b(k,213) = b(k,213) - lu(k,317) * b(k,105) + b(k,215) = b(k,215) - lu(k,318) * b(k,105) + b(k,226) = b(k,226) - lu(k,319) * b(k,105) + b(k,237) = b(k,237) - lu(k,320) * b(k,105) + b(k,160) = b(k,160) - lu(k,322) * b(k,106) + b(k,200) = b(k,200) - lu(k,323) * b(k,106) + b(k,216) = b(k,216) - lu(k,324) * b(k,106) + b(k,226) = b(k,226) - lu(k,325) * b(k,106) + b(k,207) = b(k,207) - lu(k,327) * b(k,107) + b(k,226) = b(k,226) - lu(k,328) * b(k,107) + b(k,201) = b(k,201) - lu(k,330) * b(k,108) + b(k,210) = b(k,210) - lu(k,331) * b(k,108) + b(k,216) = b(k,216) - lu(k,332) * b(k,108) + b(k,237) = b(k,237) - lu(k,333) * b(k,108) + b(k,186) = b(k,186) - lu(k,335) * b(k,109) + b(k,219) = b(k,219) - lu(k,336) * b(k,109) + b(k,224) = b(k,224) - lu(k,337) * b(k,109) + b(k,232) = b(k,232) - lu(k,338) * b(k,109) + b(k,127) = b(k,127) - lu(k,340) * b(k,110) + b(k,192) = b(k,192) - lu(k,341) * b(k,110) + b(k,226) = b(k,226) - lu(k,342) * b(k,110) + b(k,237) = b(k,237) - lu(k,343) * b(k,110) + b(k,125) = b(k,125) - lu(k,346) * b(k,111) + b(k,139) = b(k,139) - lu(k,347) * b(k,111) + b(k,226) = b(k,226) - lu(k,348) * b(k,111) + b(k,237) = b(k,237) - lu(k,349) * b(k,111) + b(k,181) = b(k,181) - lu(k,351) * b(k,112) + b(k,200) = b(k,200) - lu(k,352) * b(k,112) + b(k,226) = b(k,226) - lu(k,353) * b(k,112) + b(k,237) = b(k,237) - lu(k,354) * b(k,112) + b(k,146) = b(k,146) - lu(k,356) * b(k,113) + b(k,195) = b(k,195) - lu(k,357) * b(k,113) + b(k,200) = b(k,200) - lu(k,358) * b(k,113) + b(k,225) = b(k,225) - lu(k,359) * b(k,113) + b(k,226) = b(k,226) - lu(k,360) * b(k,113) + b(k,228) = b(k,228) - lu(k,361) * b(k,113) + b(k,229) = b(k,229) - lu(k,362) * b(k,113) + b(k,163) = b(k,163) - lu(k,364) * b(k,114) + b(k,186) = b(k,186) - lu(k,365) * b(k,114) + b(k,201) = b(k,201) - lu(k,366) * b(k,114) + b(k,219) = b(k,219) - lu(k,367) * b(k,114) + b(k,226) = b(k,226) - lu(k,368) * b(k,114) + b(k,232) = b(k,232) - lu(k,369) * b(k,114) + b(k,233) = b(k,233) - lu(k,370) * b(k,114) + 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,201) = b(k,201) - lu(k,372) * b(k,115) + b(k,220) = b(k,220) - lu(k,373) * b(k,115) + b(k,226) = b(k,226) - lu(k,374) * b(k,115) + b(k,234) = b(k,234) - lu(k,375) * b(k,115) + b(k,237) = b(k,237) - lu(k,376) * b(k,115) + b(k,238) = b(k,238) - lu(k,377) * b(k,115) + b(k,239) = b(k,239) - lu(k,378) * b(k,115) + b(k,192) = b(k,192) - lu(k,380) * b(k,116) + b(k,201) = b(k,201) - lu(k,381) * b(k,116) + b(k,210) = b(k,210) - lu(k,382) * b(k,116) + b(k,216) = b(k,216) - lu(k,383) * b(k,116) + b(k,237) = b(k,237) - lu(k,384) * b(k,116) + b(k,220) = b(k,220) - lu(k,386) * b(k,117) + b(k,221) = b(k,221) - lu(k,387) * b(k,117) + b(k,226) = b(k,226) - lu(k,388) * b(k,117) + b(k,230) = b(k,230) - lu(k,389) * b(k,117) + b(k,234) = b(k,234) - lu(k,390) * b(k,117) + b(k,194) = b(k,194) - lu(k,392) * b(k,118) + b(k,197) = b(k,197) - lu(k,393) * b(k,118) + b(k,226) = b(k,226) - lu(k,394) * b(k,118) + b(k,228) = b(k,228) - lu(k,395) * b(k,118) + b(k,231) = b(k,231) - lu(k,396) * b(k,118) + b(k,206) = b(k,206) - lu(k,398) * b(k,119) + b(k,216) = b(k,216) - lu(k,399) * b(k,119) + b(k,226) = b(k,226) - lu(k,400) * b(k,119) + b(k,229) = b(k,229) - lu(k,401) * b(k,119) + b(k,239) = b(k,239) - lu(k,402) * b(k,119) + b(k,162) = b(k,162) - lu(k,404) * b(k,120) + b(k,180) = b(k,180) - lu(k,405) * b(k,120) + b(k,226) = b(k,226) - lu(k,406) * b(k,120) + b(k,228) = b(k,228) - lu(k,407) * b(k,120) + b(k,237) = b(k,237) - lu(k,408) * b(k,120) + b(k,185) = b(k,185) - lu(k,410) * b(k,121) + b(k,195) = b(k,195) - lu(k,411) * b(k,121) + b(k,226) = b(k,226) - lu(k,412) * b(k,121) + b(k,237) = b(k,237) - lu(k,413) * b(k,121) + b(k,239) = b(k,239) - lu(k,414) * b(k,121) + b(k,130) = b(k,130) - lu(k,416) * b(k,122) + b(k,135) = b(k,135) - lu(k,417) * b(k,122) + b(k,192) = b(k,192) - lu(k,418) * b(k,122) + b(k,226) = b(k,226) - lu(k,419) * b(k,122) + b(k,237) = b(k,237) - lu(k,420) * b(k,122) + b(k,137) = b(k,137) - lu(k,422) * b(k,123) + b(k,192) = b(k,192) - lu(k,423) * b(k,123) + b(k,210) = b(k,210) - lu(k,424) * b(k,123) + b(k,226) = b(k,226) - lu(k,425) * b(k,123) + b(k,237) = b(k,237) - lu(k,426) * b(k,123) + b(k,180) = b(k,180) - lu(k,428) * b(k,124) + b(k,202) = b(k,202) - lu(k,429) * b(k,124) + b(k,226) = b(k,226) - lu(k,430) * b(k,124) + b(k,231) = b(k,231) - lu(k,431) * b(k,124) + b(k,237) = b(k,237) - lu(k,432) * b(k,124) + b(k,139) = b(k,139) - lu(k,436) * b(k,125) + b(k,226) = b(k,226) - lu(k,437) * b(k,125) + b(k,227) = b(k,227) - lu(k,438) * b(k,125) + b(k,228) = b(k,228) - lu(k,439) * b(k,125) + b(k,237) = b(k,237) - lu(k,440) * b(k,125) + b(k,183) = b(k,183) - lu(k,442) * b(k,126) + b(k,227) = b(k,227) - lu(k,443) * b(k,126) + b(k,228) = b(k,228) - lu(k,444) * b(k,126) + b(k,229) = b(k,229) - lu(k,445) * b(k,126) + b(k,237) = b(k,237) - lu(k,446) * b(k,126) + b(k,192) = b(k,192) - lu(k,449) * b(k,127) + b(k,226) = b(k,226) - lu(k,450) * b(k,127) + b(k,227) = b(k,227) - lu(k,451) * b(k,127) + b(k,228) = b(k,228) - lu(k,452) * b(k,127) + b(k,237) = b(k,237) - lu(k,453) * b(k,127) + b(k,226) = b(k,226) - lu(k,455) * b(k,128) + b(k,229) = b(k,229) - lu(k,456) * b(k,128) + b(k,233) = b(k,233) - lu(k,457) * b(k,128) + b(k,238) = b(k,238) - lu(k,458) * b(k,128) + b(k,239) = b(k,239) - lu(k,459) * b(k,128) + b(k,202) = b(k,202) - lu(k,461) * b(k,129) + b(k,222) = b(k,222) - lu(k,462) * b(k,129) + b(k,229) = b(k,229) - lu(k,463) * b(k,129) + b(k,237) = b(k,237) - lu(k,464) * b(k,129) + b(k,165) = b(k,165) - lu(k,466) * b(k,130) + b(k,237) = b(k,237) - lu(k,467) * b(k,130) + b(k,154) = b(k,154) - lu(k,469) * b(k,131) + b(k,228) = b(k,228) - lu(k,470) * b(k,131) + b(k,235) = b(k,235) - lu(k,471) * b(k,131) + b(k,222) = b(k,222) - lu(k,473) * b(k,132) + b(k,225) = b(k,225) - lu(k,474) * b(k,132) + b(k,226) = b(k,226) - lu(k,475) * b(k,132) + b(k,228) = b(k,228) - lu(k,476) * b(k,132) + b(k,237) = b(k,237) - lu(k,477) * b(k,132) + b(k,239) = b(k,239) - lu(k,478) * b(k,132) + b(k,220) = b(k,220) - lu(k,480) * b(k,133) + b(k,221) = b(k,221) - lu(k,481) * b(k,133) + b(k,226) = b(k,226) - lu(k,482) * b(k,133) + b(k,230) = b(k,230) - lu(k,483) * b(k,133) + b(k,234) = b(k,234) - lu(k,484) * b(k,133) + b(k,239) = b(k,239) - lu(k,485) * b(k,133) + b(k,193) = b(k,193) - lu(k,487) * b(k,134) + b(k,194) = b(k,194) - lu(k,488) * b(k,134) + b(k,195) = b(k,195) - lu(k,489) * b(k,134) + b(k,226) = b(k,226) - lu(k,490) * b(k,134) + b(k,229) = b(k,229) - lu(k,491) * b(k,134) + b(k,237) = b(k,237) - lu(k,492) * b(k,134) + b(k,165) = b(k,165) - lu(k,496) * b(k,135) + b(k,192) = b(k,192) - lu(k,497) * b(k,135) + b(k,226) = b(k,226) - lu(k,498) * b(k,135) + b(k,227) = b(k,227) - lu(k,499) * b(k,135) + b(k,228) = b(k,228) - lu(k,500) * b(k,135) + b(k,237) = b(k,237) - lu(k,501) * b(k,135) + b(k,171) = b(k,171) - lu(k,503) * b(k,136) + b(k,176) = b(k,176) - lu(k,504) * b(k,136) + b(k,177) = b(k,177) - lu(k,505) * b(k,136) + b(k,189) = b(k,189) - lu(k,506) * b(k,136) + b(k,222) = b(k,222) - lu(k,507) * b(k,136) + b(k,232) = b(k,232) - lu(k,508) * b(k,136) + b(k,192) = b(k,192) - lu(k,511) * b(k,137) + b(k,210) = b(k,210) - lu(k,512) * b(k,137) + b(k,226) = b(k,226) - lu(k,513) * b(k,137) + b(k,227) = b(k,227) - lu(k,514) * b(k,137) + b(k,228) = b(k,228) - lu(k,515) * b(k,137) + b(k,237) = b(k,237) - lu(k,516) * b(k,137) + b(k,160) = b(k,160) - lu(k,518) * b(k,138) + b(k,181) = b(k,181) - lu(k,519) * b(k,138) + b(k,216) = b(k,216) - lu(k,520) * b(k,138) + b(k,226) = b(k,226) - lu(k,521) * b(k,138) + b(k,154) = b(k,154) - lu(k,524) * b(k,139) + b(k,226) = b(k,226) - lu(k,525) * b(k,139) + b(k,227) = b(k,227) - lu(k,526) * b(k,139) + b(k,228) = b(k,228) - lu(k,527) * b(k,139) + b(k,237) = b(k,237) - lu(k,528) * b(k,139) + b(k,189) = b(k,189) - lu(k,530) * b(k,140) + b(k,222) = b(k,222) - lu(k,531) * b(k,140) + b(k,227) = b(k,227) - lu(k,532) * b(k,140) + b(k,230) = b(k,230) - lu(k,533) * b(k,140) + b(k,216) = b(k,216) - lu(k,535) * b(k,141) + b(k,217) = b(k,217) - lu(k,536) * b(k,141) + b(k,225) = b(k,225) - lu(k,537) * b(k,141) + b(k,226) = b(k,226) - lu(k,538) * b(k,141) + b(k,228) = b(k,228) - lu(k,539) * b(k,141) + b(k,229) = b(k,229) - lu(k,540) * b(k,141) + b(k,238) = b(k,238) - lu(k,541) * b(k,141) + b(k,172) = b(k,172) - lu(k,543) * b(k,142) + b(k,200) = b(k,200) - lu(k,544) * b(k,142) + b(k,205) = b(k,205) - lu(k,545) * b(k,142) + b(k,226) = b(k,226) - lu(k,546) * b(k,142) + b(k,229) = b(k,229) - lu(k,547) * b(k,142) + b(k,237) = b(k,237) - lu(k,548) * b(k,142) + b(k,239) = b(k,239) - lu(k,549) * b(k,142) + b(k,170) = b(k,170) - lu(k,551) * b(k,143) + b(k,183) = b(k,183) - lu(k,552) * b(k,143) + b(k,201) = b(k,201) - lu(k,553) * b(k,143) + b(k,226) = b(k,226) - lu(k,554) * b(k,143) + b(k,229) = b(k,229) - lu(k,555) * b(k,143) + b(k,235) = b(k,235) - lu(k,556) * b(k,143) + b(k,237) = b(k,237) - lu(k,557) * b(k,143) + b(k,180) = b(k,180) - lu(k,559) * b(k,144) + b(k,202) = b(k,202) - lu(k,560) * b(k,144) + b(k,204) = b(k,204) - lu(k,561) * b(k,144) + b(k,205) = b(k,205) - lu(k,562) * b(k,144) + b(k,226) = b(k,226) - lu(k,563) * b(k,144) + b(k,231) = b(k,231) - lu(k,564) * b(k,144) + b(k,237) = b(k,237) - lu(k,565) * b(k,144) + b(k,169) = b(k,169) - lu(k,567) * b(k,145) + b(k,221) = b(k,221) - lu(k,568) * b(k,145) + b(k,223) = b(k,223) - lu(k,569) * b(k,145) + b(k,225) = b(k,225) - lu(k,570) * b(k,145) + b(k,228) = b(k,228) - lu(k,571) * b(k,145) + b(k,231) = b(k,231) - lu(k,572) * b(k,145) + b(k,232) = b(k,232) - lu(k,573) * b(k,145) + b(k,195) = b(k,195) - lu(k,575) * b(k,146) + b(k,200) = b(k,200) - lu(k,576) * b(k,146) + b(k,204) = b(k,204) - lu(k,577) * b(k,146) + b(k,227) = b(k,227) - lu(k,578) * b(k,146) + b(k,228) = b(k,228) - lu(k,579) * b(k,146) + b(k,229) = b(k,229) - lu(k,580) * b(k,146) + b(k,237) = b(k,237) - lu(k,581) * b(k,146) + b(k,220) = b(k,220) - lu(k,583) * b(k,147) + b(k,226) = b(k,226) - lu(k,584) * b(k,147) + b(k,232) = b(k,232) - lu(k,585) * b(k,147) + b(k,234) = b(k,234) - lu(k,586) * b(k,147) + b(k,237) = b(k,237) - lu(k,587) * b(k,147) + b(k,239) = b(k,239) - lu(k,588) * b(k,147) + b(k,202) = b(k,202) - lu(k,590) * b(k,148) + b(k,204) = b(k,204) - lu(k,591) * b(k,148) + b(k,205) = b(k,205) - lu(k,592) * b(k,148) + b(k,226) = b(k,226) - lu(k,593) * b(k,148) + b(k,228) = b(k,228) - lu(k,594) * b(k,148) + b(k,229) = b(k,229) - lu(k,595) * b(k,148) + b(k,231) = b(k,231) - lu(k,596) * b(k,148) + b(k,237) = b(k,237) - lu(k,597) * b(k,148) + b(k,182) = b(k,182) - lu(k,599) * b(k,149) + b(k,201) = b(k,201) - lu(k,600) * b(k,149) + b(k,237) = b(k,237) - lu(k,601) * b(k,149) + b(k,220) = b(k,220) - lu(k,603) * b(k,150) + b(k,221) = b(k,221) - lu(k,604) * b(k,150) + b(k,226) = b(k,226) - lu(k,605) * b(k,150) + b(k,230) = b(k,230) - lu(k,606) * b(k,150) + b(k,234) = b(k,234) - lu(k,607) * b(k,150) + b(k,237) = b(k,237) - lu(k,608) * b(k,150) + b(k,238) = b(k,238) - lu(k,609) * b(k,150) + b(k,239) = b(k,239) - lu(k,610) * b(k,150) + b(k,205) = b(k,205) - lu(k,612) * b(k,151) + b(k,215) = b(k,215) - lu(k,613) * b(k,151) + b(k,217) = b(k,217) - lu(k,614) * b(k,151) + b(k,225) = b(k,225) - lu(k,615) * b(k,151) + b(k,226) = b(k,226) - lu(k,616) * b(k,151) + b(k,228) = b(k,228) - lu(k,617) * b(k,151) + b(k,229) = b(k,229) - lu(k,618) * b(k,151) + b(k,237) = b(k,237) - lu(k,619) * b(k,151) + 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,216) = b(k,216) - lu(k,621) * b(k,152) + b(k,217) = b(k,217) - lu(k,622) * b(k,152) + b(k,226) = b(k,226) - lu(k,623) * b(k,152) + b(k,229) = b(k,229) - lu(k,624) * b(k,152) + b(k,238) = b(k,238) - lu(k,625) * b(k,152) + b(k,239) = b(k,239) - lu(k,626) * b(k,152) + b(k,194) = b(k,194) - lu(k,628) * b(k,153) + b(k,226) = b(k,226) - lu(k,629) * b(k,153) + b(k,228) = b(k,228) - lu(k,630) * b(k,153) + b(k,231) = b(k,231) - lu(k,631) * b(k,153) + b(k,237) = b(k,237) - lu(k,632) * b(k,153) + b(k,226) = b(k,226) - lu(k,636) * b(k,154) + b(k,227) = b(k,227) - lu(k,637) * b(k,154) + b(k,228) = b(k,228) - lu(k,638) * b(k,154) + b(k,235) = b(k,235) - lu(k,639) * b(k,154) + b(k,237) = b(k,237) - lu(k,640) * b(k,154) + b(k,160) = b(k,160) - lu(k,643) * b(k,155) + b(k,181) = b(k,181) - lu(k,644) * b(k,155) + b(k,195) = b(k,195) - lu(k,645) * b(k,155) + b(k,200) = b(k,200) - lu(k,646) * b(k,155) + b(k,216) = b(k,216) - lu(k,647) * b(k,155) + b(k,226) = b(k,226) - lu(k,648) * b(k,155) + b(k,228) = b(k,228) - lu(k,649) * b(k,155) + b(k,229) = b(k,229) - lu(k,650) * b(k,155) + b(k,237) = b(k,237) - lu(k,651) * b(k,155) + b(k,195) = b(k,195) - lu(k,653) * b(k,156) + b(k,198) = b(k,198) - lu(k,654) * b(k,156) + b(k,201) = b(k,201) - lu(k,655) * b(k,156) + b(k,202) = b(k,202) - lu(k,656) * b(k,156) + b(k,203) = b(k,203) - lu(k,657) * b(k,156) + b(k,217) = b(k,217) - lu(k,658) * b(k,156) + b(k,226) = b(k,226) - lu(k,659) * b(k,156) + b(k,229) = b(k,229) - lu(k,660) * b(k,156) + b(k,237) = b(k,237) - lu(k,661) * b(k,156) + b(k,165) = b(k,165) - lu(k,666) * b(k,157) + b(k,166) = b(k,166) - lu(k,667) * b(k,157) + b(k,168) = b(k,168) - lu(k,668) * b(k,157) + b(k,182) = b(k,182) - lu(k,669) * b(k,157) + b(k,192) = b(k,192) - lu(k,670) * b(k,157) + b(k,201) = b(k,201) - lu(k,671) * b(k,157) + b(k,210) = b(k,210) - lu(k,672) * b(k,157) + b(k,226) = b(k,226) - lu(k,673) * b(k,157) + b(k,237) = b(k,237) - lu(k,674) * b(k,157) + b(k,171) = b(k,171) - lu(k,677) * b(k,158) + b(k,176) = b(k,176) - lu(k,678) * b(k,158) + b(k,177) = b(k,177) - lu(k,679) * b(k,158) + b(k,178) = b(k,178) - lu(k,680) * b(k,158) + b(k,189) = b(k,189) - lu(k,681) * b(k,158) + b(k,222) = b(k,222) - lu(k,682) * b(k,158) + b(k,227) = b(k,227) - lu(k,683) * b(k,158) + b(k,230) = b(k,230) - lu(k,684) * b(k,158) + b(k,232) = b(k,232) - lu(k,685) * b(k,158) + b(k,160) = b(k,160) - lu(k,688) * b(k,159) + b(k,181) = b(k,181) - lu(k,689) * b(k,159) + b(k,191) = b(k,191) - lu(k,690) * b(k,159) + b(k,195) = b(k,195) - lu(k,691) * b(k,159) + b(k,200) = b(k,200) - lu(k,692) * b(k,159) + b(k,216) = b(k,216) - lu(k,693) * b(k,159) + b(k,226) = b(k,226) - lu(k,694) * b(k,159) + b(k,229) = b(k,229) - lu(k,695) * b(k,159) + b(k,237) = b(k,237) - lu(k,696) * b(k,159) + b(k,200) = b(k,200) - lu(k,699) * b(k,160) + b(k,216) = b(k,216) - lu(k,700) * b(k,160) + b(k,226) = b(k,226) - lu(k,701) * b(k,160) + b(k,227) = b(k,227) - lu(k,702) * b(k,160) + b(k,228) = b(k,228) - lu(k,703) * b(k,160) + b(k,237) = b(k,237) - lu(k,704) * b(k,160) + b(k,217) = b(k,217) - lu(k,706) * b(k,161) + b(k,226) = b(k,226) - lu(k,707) * b(k,161) + b(k,238) = b(k,238) - lu(k,708) * b(k,161) + b(k,239) = b(k,239) - lu(k,709) * b(k,161) + b(k,207) = b(k,207) - lu(k,712) * b(k,162) + b(k,209) = b(k,209) - lu(k,713) * b(k,162) + b(k,214) = b(k,214) - lu(k,714) * b(k,162) + b(k,226) = b(k,226) - lu(k,715) * b(k,162) + b(k,229) = b(k,229) - lu(k,716) * b(k,162) + b(k,237) = b(k,237) - lu(k,717) * b(k,162) + b(k,219) = b(k,219) - lu(k,719) * b(k,163) + b(k,222) = b(k,222) - lu(k,720) * b(k,163) + b(k,226) = b(k,226) - lu(k,721) * b(k,163) + b(k,232) = b(k,232) - lu(k,722) * b(k,163) + b(k,233) = b(k,233) - lu(k,723) * b(k,163) + b(k,235) = b(k,235) - lu(k,724) * b(k,163) + b(k,165) = b(k,165) - lu(k,730) * b(k,164) + b(k,167) = b(k,167) - lu(k,731) * b(k,164) + b(k,168) = b(k,168) - lu(k,732) * b(k,164) + b(k,182) = b(k,182) - lu(k,733) * b(k,164) + b(k,192) = b(k,192) - lu(k,734) * b(k,164) + b(k,201) = b(k,201) - lu(k,735) * b(k,164) + b(k,210) = b(k,210) - lu(k,736) * b(k,164) + b(k,216) = b(k,216) - lu(k,737) * b(k,164) + b(k,226) = b(k,226) - lu(k,738) * b(k,164) + b(k,237) = b(k,237) - lu(k,739) * b(k,164) + b(k,192) = b(k,192) - lu(k,741) * b(k,165) + b(k,201) = b(k,201) - lu(k,742) * b(k,165) + b(k,227) = b(k,227) - lu(k,743) * b(k,165) + b(k,228) = b(k,228) - lu(k,744) * b(k,165) + b(k,237) = b(k,237) - lu(k,745) * b(k,165) + b(k,168) = b(k,168) - lu(k,752) * b(k,166) + b(k,182) = b(k,182) - lu(k,753) * b(k,166) + b(k,192) = b(k,192) - lu(k,754) * b(k,166) + b(k,201) = b(k,201) - lu(k,755) * b(k,166) + b(k,210) = b(k,210) - lu(k,756) * b(k,166) + b(k,226) = b(k,226) - lu(k,757) * b(k,166) + b(k,227) = b(k,227) - lu(k,758) * b(k,166) + b(k,228) = b(k,228) - lu(k,759) * b(k,166) + b(k,237) = b(k,237) - lu(k,760) * b(k,166) + b(k,168) = b(k,168) - lu(k,768) * b(k,167) + b(k,182) = b(k,182) - lu(k,769) * b(k,167) + b(k,192) = b(k,192) - lu(k,770) * b(k,167) + b(k,201) = b(k,201) - lu(k,771) * b(k,167) + b(k,210) = b(k,210) - lu(k,772) * b(k,167) + b(k,216) = b(k,216) - lu(k,773) * b(k,167) + b(k,226) = b(k,226) - lu(k,774) * b(k,167) + b(k,227) = b(k,227) - lu(k,775) * b(k,167) + b(k,228) = b(k,228) - lu(k,776) * b(k,167) + b(k,237) = b(k,237) - lu(k,777) * b(k,167) + b(k,201) = b(k,201) - lu(k,779) * b(k,168) + b(k,210) = b(k,210) - lu(k,780) * b(k,168) + b(k,226) = b(k,226) - lu(k,781) * b(k,168) + b(k,227) = b(k,227) - lu(k,782) * b(k,168) + b(k,228) = b(k,228) - lu(k,783) * b(k,168) + b(k,237) = b(k,237) - lu(k,784) * b(k,168) + b(k,238) = b(k,238) - lu(k,785) * b(k,168) + b(k,220) = b(k,220) - lu(k,788) * b(k,169) + b(k,221) = b(k,221) - lu(k,789) * b(k,169) + b(k,223) = b(k,223) - lu(k,790) * b(k,169) + b(k,226) = b(k,226) - lu(k,791) * b(k,169) + b(k,232) = b(k,232) - lu(k,792) * b(k,169) + b(k,234) = b(k,234) - lu(k,793) * b(k,169) + b(k,239) = b(k,239) - lu(k,794) * b(k,169) + b(k,202) = b(k,202) - lu(k,798) * b(k,170) + b(k,222) = b(k,222) - lu(k,799) * b(k,170) + b(k,226) = b(k,226) - lu(k,800) * b(k,170) + b(k,227) = b(k,227) - lu(k,801) * b(k,170) + b(k,228) = b(k,228) - lu(k,802) * b(k,170) + b(k,229) = b(k,229) - lu(k,803) * b(k,170) + b(k,237) = b(k,237) - lu(k,804) * b(k,170) + b(k,176) = b(k,176) - lu(k,806) * b(k,171) + b(k,177) = b(k,177) - lu(k,807) * b(k,171) + b(k,189) = b(k,189) - lu(k,808) * b(k,171) + b(k,201) = b(k,201) - lu(k,809) * b(k,171) + b(k,217) = b(k,217) - lu(k,810) * b(k,171) + b(k,222) = b(k,222) - lu(k,811) * b(k,171) + b(k,232) = b(k,232) - lu(k,812) * b(k,171) + b(k,200) = b(k,200) - lu(k,815) * b(k,172) + b(k,205) = b(k,205) - lu(k,816) * b(k,172) + b(k,222) = b(k,222) - lu(k,817) * b(k,172) + b(k,226) = b(k,226) - lu(k,818) * b(k,172) + b(k,227) = b(k,227) - lu(k,819) * b(k,172) + b(k,228) = b(k,228) - lu(k,820) * b(k,172) + b(k,229) = b(k,229) - lu(k,821) * b(k,172) + b(k,237) = b(k,237) - lu(k,822) * b(k,172) + b(k,239) = b(k,239) - lu(k,823) * b(k,172) + b(k,226) = b(k,226) - lu(k,825) * b(k,173) + b(k,229) = b(k,229) - lu(k,826) * b(k,173) + b(k,237) = b(k,237) - lu(k,827) * b(k,173) + b(k,221) = b(k,221) - lu(k,829) * b(k,174) + b(k,223) = b(k,223) - lu(k,830) * b(k,174) + b(k,226) = b(k,226) - lu(k,831) * b(k,174) + b(k,230) = b(k,230) - lu(k,832) * b(k,174) + b(k,232) = b(k,232) - lu(k,833) * b(k,174) + b(k,233) = b(k,233) - lu(k,834) * b(k,174) + b(k,239) = b(k,239) - lu(k,835) * b(k,174) + b(k,220) = b(k,220) - lu(k,838) * b(k,175) + b(k,224) = b(k,224) - lu(k,839) * b(k,175) + b(k,226) = b(k,226) - lu(k,840) * b(k,175) + b(k,232) = b(k,232) - lu(k,841) * b(k,175) + b(k,234) = b(k,234) - lu(k,842) * b(k,175) + b(k,239) = b(k,239) - lu(k,843) * b(k,175) + b(k,178) = b(k,178) - lu(k,846) * b(k,176) + b(k,189) = b(k,189) - lu(k,847) * b(k,176) + b(k,222) = b(k,222) - lu(k,848) * b(k,176) + b(k,227) = b(k,227) - lu(k,849) * b(k,176) + b(k,230) = b(k,230) - lu(k,850) * b(k,176) + b(k,232) = b(k,232) - lu(k,851) * b(k,176) + b(k,178) = b(k,178) - lu(k,854) * b(k,177) + b(k,189) = b(k,189) - lu(k,855) * b(k,177) + b(k,222) = b(k,222) - lu(k,856) * b(k,177) + b(k,227) = b(k,227) - lu(k,857) * b(k,177) + b(k,230) = b(k,230) - lu(k,858) * b(k,177) + b(k,232) = b(k,232) - lu(k,859) * b(k,177) + b(k,189) = b(k,189) - lu(k,866) * b(k,178) + b(k,201) = b(k,201) - lu(k,867) * b(k,178) + b(k,217) = b(k,217) - lu(k,868) * b(k,178) + b(k,222) = b(k,222) - lu(k,869) * b(k,178) + b(k,227) = b(k,227) - lu(k,870) * b(k,178) + b(k,230) = b(k,230) - lu(k,871) * b(k,178) + b(k,232) = b(k,232) - lu(k,872) * b(k,178) + b(k,183) = b(k,183) - lu(k,877) * b(k,179) + b(k,199) = b(k,199) - lu(k,878) * b(k,179) + b(k,201) = b(k,201) - lu(k,879) * b(k,179) + b(k,208) = b(k,208) - lu(k,880) * b(k,179) + b(k,209) = b(k,209) - lu(k,881) * b(k,179) + b(k,211) = b(k,211) - lu(k,882) * b(k,179) + b(k,212) = b(k,212) - lu(k,883) * b(k,179) + b(k,214) = b(k,214) - lu(k,884) * b(k,179) + b(k,216) = b(k,216) - lu(k,885) * b(k,179) + b(k,225) = b(k,225) - lu(k,886) * b(k,179) + b(k,226) = b(k,226) - lu(k,887) * b(k,179) + b(k,229) = b(k,229) - lu(k,888) * b(k,179) + b(k,235) = b(k,235) - lu(k,889) * b(k,179) + b(k,237) = b(k,237) - lu(k,890) * b(k,179) + b(k,238) = b(k,238) - lu(k,891) * b(k,179) + 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,210) = b(k,210) - lu(k,893) * b(k,180) + b(k,216) = b(k,216) - lu(k,894) * b(k,180) + b(k,226) = b(k,226) - lu(k,895) * b(k,180) + b(k,228) = b(k,228) - lu(k,896) * b(k,180) + b(k,229) = b(k,229) - lu(k,897) * b(k,180) + b(k,200) = b(k,200) - lu(k,902) * b(k,181) + b(k,222) = b(k,222) - lu(k,903) * b(k,181) + b(k,226) = b(k,226) - lu(k,904) * b(k,181) + b(k,227) = b(k,227) - lu(k,905) * b(k,181) + b(k,228) = b(k,228) - lu(k,906) * b(k,181) + b(k,229) = b(k,229) - lu(k,907) * b(k,181) + b(k,237) = b(k,237) - lu(k,908) * b(k,181) + b(k,238) = b(k,238) - lu(k,909) * b(k,181) + b(k,192) = b(k,192) - lu(k,911) * b(k,182) + b(k,201) = b(k,201) - lu(k,912) * b(k,182) + b(k,210) = b(k,210) - lu(k,913) * b(k,182) + b(k,226) = b(k,226) - lu(k,914) * b(k,182) + b(k,227) = b(k,227) - lu(k,915) * b(k,182) + b(k,228) = b(k,228) - lu(k,916) * b(k,182) + b(k,237) = b(k,237) - lu(k,917) * b(k,182) + b(k,238) = b(k,238) - lu(k,918) * b(k,182) + b(k,217) = b(k,217) - lu(k,920) * b(k,183) + b(k,226) = b(k,226) - lu(k,921) * b(k,183) + b(k,237) = b(k,237) - lu(k,922) * b(k,183) + b(k,239) = b(k,239) - lu(k,923) * b(k,183) + b(k,218) = b(k,218) - lu(k,926) * b(k,184) + b(k,225) = b(k,225) - lu(k,927) * b(k,184) + b(k,226) = b(k,226) - lu(k,928) * b(k,184) + b(k,231) = b(k,231) - lu(k,929) * b(k,184) + b(k,233) = b(k,233) - lu(k,930) * b(k,184) + b(k,236) = b(k,236) - lu(k,931) * b(k,184) + b(k,238) = b(k,238) - lu(k,932) * b(k,184) + b(k,239) = b(k,239) - lu(k,933) * b(k,184) + b(k,195) = b(k,195) - lu(k,936) * b(k,185) + b(k,200) = b(k,200) - lu(k,937) * b(k,185) + b(k,222) = b(k,222) - lu(k,938) * b(k,185) + b(k,226) = b(k,226) - lu(k,939) * b(k,185) + b(k,227) = b(k,227) - lu(k,940) * b(k,185) + b(k,228) = b(k,228) - lu(k,941) * b(k,185) + b(k,229) = b(k,229) - lu(k,942) * b(k,185) + b(k,237) = b(k,237) - lu(k,943) * b(k,185) + b(k,238) = b(k,238) - lu(k,944) * b(k,185) + b(k,239) = b(k,239) - lu(k,945) * b(k,185) + b(k,219) = b(k,219) - lu(k,948) * b(k,186) + b(k,226) = b(k,226) - lu(k,949) * b(k,186) + b(k,232) = b(k,232) - lu(k,950) * b(k,186) + b(k,237) = b(k,237) - lu(k,951) * b(k,186) + b(k,239) = b(k,239) - lu(k,952) * b(k,186) + b(k,220) = b(k,220) - lu(k,956) * b(k,187) + b(k,224) = b(k,224) - lu(k,957) * b(k,187) + b(k,225) = b(k,225) - lu(k,958) * b(k,187) + b(k,226) = b(k,226) - lu(k,959) * b(k,187) + b(k,228) = b(k,228) - lu(k,960) * b(k,187) + b(k,231) = b(k,231) - lu(k,961) * b(k,187) + b(k,232) = b(k,232) - lu(k,962) * b(k,187) + b(k,234) = b(k,234) - lu(k,963) * b(k,187) + b(k,239) = b(k,239) - lu(k,964) * b(k,187) + b(k,191) = b(k,191) - lu(k,975) * b(k,188) + b(k,192) = b(k,192) - lu(k,976) * b(k,188) + b(k,193) = b(k,193) - lu(k,977) * b(k,188) + b(k,194) = b(k,194) - lu(k,978) * b(k,188) + b(k,195) = b(k,195) - lu(k,979) * b(k,188) + b(k,197) = b(k,197) - lu(k,980) * b(k,188) + b(k,198) = b(k,198) - lu(k,981) * b(k,188) + b(k,201) = b(k,201) - lu(k,982) * b(k,188) + b(k,206) = b(k,206) - lu(k,983) * b(k,188) + b(k,210) = b(k,210) - lu(k,984) * b(k,188) + b(k,216) = b(k,216) - lu(k,985) * b(k,188) + b(k,217) = b(k,217) - lu(k,986) * b(k,188) + b(k,225) = b(k,225) - lu(k,987) * b(k,188) + b(k,226) = b(k,226) - lu(k,988) * b(k,188) + b(k,229) = b(k,229) - lu(k,989) * b(k,188) + b(k,235) = b(k,235) - lu(k,990) * b(k,188) + b(k,237) = b(k,237) - lu(k,991) * b(k,188) + b(k,239) = b(k,239) - lu(k,992) * b(k,188) + b(k,201) = b(k,201) - lu(k,1000) * b(k,189) + b(k,217) = b(k,217) - lu(k,1001) * b(k,189) + b(k,222) = b(k,222) - lu(k,1002) * b(k,189) + b(k,226) = b(k,226) - lu(k,1003) * b(k,189) + b(k,227) = b(k,227) - lu(k,1004) * b(k,189) + b(k,228) = b(k,228) - lu(k,1005) * b(k,189) + b(k,230) = b(k,230) - lu(k,1006) * b(k,189) + b(k,232) = b(k,232) - lu(k,1007) * b(k,189) + b(k,233) = b(k,233) - lu(k,1008) * b(k,189) + b(k,191) = b(k,191) - lu(k,1019) * b(k,190) + b(k,192) = b(k,192) - lu(k,1020) * b(k,190) + b(k,193) = b(k,193) - lu(k,1021) * b(k,190) + b(k,194) = b(k,194) - lu(k,1022) * b(k,190) + b(k,195) = b(k,195) - lu(k,1023) * b(k,190) + b(k,197) = b(k,197) - lu(k,1024) * b(k,190) + b(k,198) = b(k,198) - lu(k,1025) * b(k,190) + b(k,201) = b(k,201) - lu(k,1026) * b(k,190) + b(k,206) = b(k,206) - lu(k,1027) * b(k,190) + b(k,210) = b(k,210) - lu(k,1028) * b(k,190) + b(k,216) = b(k,216) - lu(k,1029) * b(k,190) + b(k,217) = b(k,217) - lu(k,1030) * b(k,190) + b(k,225) = b(k,225) - lu(k,1031) * b(k,190) + b(k,226) = b(k,226) - lu(k,1032) * b(k,190) + b(k,229) = b(k,229) - lu(k,1033) * b(k,190) + b(k,235) = b(k,235) - lu(k,1034) * b(k,190) + b(k,237) = b(k,237) - lu(k,1035) * b(k,190) + b(k,239) = b(k,239) - lu(k,1036) * b(k,190) + b(k,195) = b(k,195) - lu(k,1043) * b(k,191) + b(k,200) = b(k,200) - lu(k,1044) * b(k,191) + b(k,216) = b(k,216) - lu(k,1045) * b(k,191) + b(k,222) = b(k,222) - lu(k,1046) * b(k,191) + b(k,226) = b(k,226) - lu(k,1047) * b(k,191) + b(k,227) = b(k,227) - lu(k,1048) * b(k,191) + b(k,228) = b(k,228) - lu(k,1049) * b(k,191) + b(k,229) = b(k,229) - lu(k,1050) * b(k,191) + b(k,237) = b(k,237) - lu(k,1051) * b(k,191) + b(k,238) = b(k,238) - lu(k,1052) * b(k,191) + b(k,201) = b(k,201) - lu(k,1055) * b(k,192) + b(k,217) = b(k,217) - lu(k,1056) * b(k,192) + b(k,226) = b(k,226) - lu(k,1057) * b(k,192) + b(k,237) = b(k,237) - lu(k,1058) * b(k,192) + b(k,194) = b(k,194) - lu(k,1063) * b(k,193) + b(k,195) = b(k,195) - lu(k,1064) * b(k,193) + b(k,226) = b(k,226) - lu(k,1065) * b(k,193) + b(k,227) = b(k,227) - lu(k,1066) * b(k,193) + b(k,228) = b(k,228) - lu(k,1067) * b(k,193) + b(k,229) = b(k,229) - lu(k,1068) * b(k,193) + b(k,231) = b(k,231) - lu(k,1069) * b(k,193) + b(k,237) = b(k,237) - lu(k,1070) * b(k,193) + b(k,238) = b(k,238) - lu(k,1071) * b(k,193) + b(k,197) = b(k,197) - lu(k,1073) * b(k,194) + b(k,198) = b(k,198) - lu(k,1074) * b(k,194) + b(k,201) = b(k,201) - lu(k,1075) * b(k,194) + b(k,203) = b(k,203) - lu(k,1076) * b(k,194) + b(k,225) = b(k,225) - lu(k,1077) * b(k,194) + b(k,226) = b(k,226) - lu(k,1078) * b(k,194) + b(k,237) = b(k,237) - lu(k,1079) * b(k,194) + b(k,206) = b(k,206) - lu(k,1081) * b(k,195) + b(k,216) = b(k,216) - lu(k,1082) * b(k,195) + b(k,226) = b(k,226) - lu(k,1083) * b(k,195) + b(k,238) = b(k,238) - lu(k,1084) * b(k,195) + b(k,239) = b(k,239) - lu(k,1085) * b(k,195) + b(k,201) = b(k,201) - lu(k,1091) * b(k,196) + b(k,210) = b(k,210) - lu(k,1092) * b(k,196) + b(k,216) = b(k,216) - lu(k,1093) * b(k,196) + b(k,217) = b(k,217) - lu(k,1094) * b(k,196) + b(k,226) = b(k,226) - lu(k,1095) * b(k,196) + b(k,227) = b(k,227) - lu(k,1096) * b(k,196) + b(k,228) = b(k,228) - lu(k,1097) * b(k,196) + b(k,229) = b(k,229) - lu(k,1098) * b(k,196) + b(k,231) = b(k,231) - lu(k,1099) * b(k,196) + b(k,237) = b(k,237) - lu(k,1100) * b(k,196) + b(k,238) = b(k,238) - lu(k,1101) * b(k,196) + b(k,198) = b(k,198) - lu(k,1107) * b(k,197) + b(k,201) = b(k,201) - lu(k,1108) * b(k,197) + b(k,203) = b(k,203) - lu(k,1109) * b(k,197) + b(k,225) = b(k,225) - lu(k,1110) * b(k,197) + b(k,226) = b(k,226) - lu(k,1111) * b(k,197) + b(k,227) = b(k,227) - lu(k,1112) * b(k,197) + b(k,228) = b(k,228) - lu(k,1113) * b(k,197) + b(k,229) = b(k,229) - lu(k,1114) * b(k,197) + b(k,231) = b(k,231) - lu(k,1115) * b(k,197) + b(k,237) = b(k,237) - lu(k,1116) * b(k,197) + b(k,238) = b(k,238) - lu(k,1117) * b(k,197) + b(k,201) = b(k,201) - lu(k,1120) * b(k,198) + b(k,206) = b(k,206) - lu(k,1121) * b(k,198) + b(k,216) = b(k,216) - lu(k,1122) * b(k,198) + b(k,217) = b(k,217) - lu(k,1123) * b(k,198) + b(k,226) = b(k,226) - lu(k,1124) * b(k,198) + b(k,229) = b(k,229) - lu(k,1125) * b(k,198) + b(k,237) = b(k,237) - lu(k,1126) * b(k,198) + b(k,238) = b(k,238) - lu(k,1127) * b(k,198) + b(k,239) = b(k,239) - lu(k,1128) * b(k,198) + b(k,200) = b(k,200) - lu(k,1134) * b(k,199) + b(k,201) = b(k,201) - lu(k,1135) * b(k,199) + b(k,205) = b(k,205) - lu(k,1136) * b(k,199) + b(k,210) = b(k,210) - lu(k,1137) * b(k,199) + b(k,216) = b(k,216) - lu(k,1138) * b(k,199) + b(k,217) = b(k,217) - lu(k,1139) * b(k,199) + b(k,222) = b(k,222) - lu(k,1140) * b(k,199) + b(k,225) = b(k,225) - lu(k,1141) * b(k,199) + b(k,226) = b(k,226) - lu(k,1142) * b(k,199) + b(k,227) = b(k,227) - lu(k,1143) * b(k,199) + b(k,228) = b(k,228) - lu(k,1144) * b(k,199) + b(k,229) = b(k,229) - lu(k,1145) * b(k,199) + b(k,235) = b(k,235) - lu(k,1146) * b(k,199) + b(k,236) = b(k,236) - lu(k,1147) * b(k,199) + b(k,237) = b(k,237) - lu(k,1148) * b(k,199) + b(k,238) = b(k,238) - lu(k,1149) * b(k,199) + b(k,239) = b(k,239) - lu(k,1150) * b(k,199) + b(k,201) = b(k,201) - lu(k,1152) * b(k,200) + b(k,216) = b(k,216) - lu(k,1153) * b(k,200) + b(k,225) = b(k,225) - lu(k,1154) * b(k,200) + b(k,226) = b(k,226) - lu(k,1155) * b(k,200) + b(k,231) = b(k,231) - lu(k,1156) * b(k,200) + b(k,237) = b(k,237) - lu(k,1157) * b(k,200) + b(k,238) = b(k,238) - lu(k,1158) * b(k,200) + b(k,239) = b(k,239) - lu(k,1159) * b(k,200) + b(k,217) = b(k,217) - lu(k,1161) * b(k,201) + b(k,226) = b(k,226) - lu(k,1162) * b(k,201) + b(k,237) = b(k,237) - lu(k,1163) * b(k,201) + b(k,217) = b(k,217) - lu(k,1167) * b(k,202) + b(k,226) = b(k,226) - lu(k,1168) * b(k,202) + b(k,229) = b(k,229) - lu(k,1169) * b(k,202) + b(k,237) = b(k,237) - lu(k,1170) * b(k,202) + b(k,206) = b(k,206) - lu(k,1179) * b(k,203) + b(k,216) = b(k,216) - lu(k,1180) * b(k,203) + b(k,217) = b(k,217) - lu(k,1181) * b(k,203) + b(k,226) = b(k,226) - lu(k,1182) * b(k,203) + b(k,227) = b(k,227) - lu(k,1183) * b(k,203) + b(k,228) = b(k,228) - lu(k,1184) * b(k,203) + b(k,229) = b(k,229) - lu(k,1185) * b(k,203) + b(k,231) = b(k,231) - lu(k,1186) * b(k,203) + b(k,237) = b(k,237) - lu(k,1187) * b(k,203) + b(k,238) = b(k,238) - lu(k,1188) * b(k,203) + b(k,239) = b(k,239) - lu(k,1189) * b(k,203) + 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 + b(k,205) = b(k,205) - lu(k,1196) * b(k,204) + b(k,206) = b(k,206) - lu(k,1197) * b(k,204) + b(k,216) = b(k,216) - lu(k,1198) * b(k,204) + b(k,217) = b(k,217) - lu(k,1199) * b(k,204) + b(k,225) = b(k,225) - lu(k,1200) * b(k,204) + b(k,226) = b(k,226) - lu(k,1201) * b(k,204) + b(k,228) = b(k,228) - lu(k,1202) * b(k,204) + b(k,229) = b(k,229) - lu(k,1203) * b(k,204) + b(k,231) = b(k,231) - lu(k,1204) * b(k,204) + b(k,237) = b(k,237) - lu(k,1205) * b(k,204) + b(k,238) = b(k,238) - lu(k,1206) * b(k,204) + b(k,239) = b(k,239) - lu(k,1207) * b(k,204) + b(k,210) = b(k,210) - lu(k,1209) * b(k,205) + b(k,216) = b(k,216) - lu(k,1210) * b(k,205) + b(k,226) = b(k,226) - lu(k,1211) * b(k,205) + b(k,229) = b(k,229) - lu(k,1212) * b(k,205) + b(k,237) = b(k,237) - lu(k,1213) * b(k,205) + b(k,210) = b(k,210) - lu(k,1218) * b(k,206) + b(k,216) = b(k,216) - lu(k,1219) * b(k,206) + b(k,226) = b(k,226) - lu(k,1220) * b(k,206) + b(k,227) = b(k,227) - lu(k,1221) * b(k,206) + b(k,228) = b(k,228) - lu(k,1222) * b(k,206) + b(k,229) = b(k,229) - lu(k,1223) * b(k,206) + b(k,237) = b(k,237) - lu(k,1224) * b(k,206) + b(k,238) = b(k,238) - lu(k,1225) * b(k,206) + b(k,239) = b(k,239) - lu(k,1226) * b(k,206) + b(k,210) = b(k,210) - lu(k,1234) * b(k,207) + b(k,216) = b(k,216) - lu(k,1235) * b(k,207) + b(k,217) = b(k,217) - lu(k,1236) * b(k,207) + b(k,225) = b(k,225) - lu(k,1237) * b(k,207) + b(k,226) = b(k,226) - lu(k,1238) * b(k,207) + b(k,227) = b(k,227) - lu(k,1239) * b(k,207) + b(k,228) = b(k,228) - lu(k,1240) * b(k,207) + b(k,229) = b(k,229) - lu(k,1241) * b(k,207) + b(k,237) = b(k,237) - lu(k,1242) * b(k,207) + b(k,238) = b(k,238) - lu(k,1243) * b(k,207) + b(k,209) = b(k,209) - lu(k,1254) * b(k,208) + b(k,210) = b(k,210) - lu(k,1255) * b(k,208) + b(k,214) = b(k,214) - lu(k,1256) * b(k,208) + b(k,216) = b(k,216) - lu(k,1257) * b(k,208) + b(k,217) = b(k,217) - lu(k,1258) * b(k,208) + b(k,225) = b(k,225) - lu(k,1259) * b(k,208) + b(k,226) = b(k,226) - lu(k,1260) * b(k,208) + b(k,227) = b(k,227) - lu(k,1261) * b(k,208) + b(k,228) = b(k,228) - lu(k,1262) * b(k,208) + b(k,229) = b(k,229) - lu(k,1263) * b(k,208) + b(k,231) = b(k,231) - lu(k,1264) * b(k,208) + b(k,237) = b(k,237) - lu(k,1265) * b(k,208) + b(k,238) = b(k,238) - lu(k,1266) * b(k,208) + b(k,210) = b(k,210) - lu(k,1270) * b(k,209) + b(k,213) = b(k,213) - lu(k,1271) * b(k,209) + b(k,215) = b(k,215) - lu(k,1272) * b(k,209) + b(k,216) = b(k,216) - lu(k,1273) * b(k,209) + b(k,217) = b(k,217) - lu(k,1274) * b(k,209) + b(k,226) = b(k,226) - lu(k,1275) * b(k,209) + b(k,229) = b(k,229) - lu(k,1276) * b(k,209) + b(k,235) = b(k,235) - lu(k,1277) * b(k,209) + b(k,237) = b(k,237) - lu(k,1278) * b(k,209) + b(k,239) = b(k,239) - lu(k,1279) * b(k,209) + b(k,216) = b(k,216) - lu(k,1282) * b(k,210) + b(k,217) = b(k,217) - lu(k,1283) * b(k,210) + b(k,225) = b(k,225) - lu(k,1284) * b(k,210) + b(k,226) = b(k,226) - lu(k,1285) * b(k,210) + b(k,231) = b(k,231) - lu(k,1286) * b(k,210) + b(k,237) = b(k,237) - lu(k,1287) * b(k,210) + b(k,239) = b(k,239) - lu(k,1288) * b(k,210) + b(k,213) = b(k,213) - lu(k,1300) * b(k,211) + b(k,214) = b(k,214) - lu(k,1301) * b(k,211) + b(k,215) = b(k,215) - lu(k,1302) * b(k,211) + b(k,216) = b(k,216) - lu(k,1303) * b(k,211) + b(k,217) = b(k,217) - lu(k,1304) * b(k,211) + b(k,225) = b(k,225) - lu(k,1305) * b(k,211) + b(k,226) = b(k,226) - lu(k,1306) * b(k,211) + b(k,227) = b(k,227) - lu(k,1307) * b(k,211) + b(k,228) = b(k,228) - lu(k,1308) * b(k,211) + b(k,229) = b(k,229) - lu(k,1309) * b(k,211) + b(k,231) = b(k,231) - lu(k,1310) * b(k,211) + b(k,235) = b(k,235) - lu(k,1311) * b(k,211) + b(k,237) = b(k,237) - lu(k,1312) * b(k,211) + b(k,238) = b(k,238) - lu(k,1313) * b(k,211) + b(k,239) = b(k,239) - lu(k,1314) * b(k,211) + b(k,213) = b(k,213) - lu(k,1333) * b(k,212) + b(k,214) = b(k,214) - lu(k,1334) * b(k,212) + b(k,215) = b(k,215) - lu(k,1335) * b(k,212) + b(k,216) = b(k,216) - lu(k,1336) * b(k,212) + b(k,217) = b(k,217) - lu(k,1337) * b(k,212) + b(k,225) = b(k,225) - lu(k,1338) * b(k,212) + b(k,226) = b(k,226) - lu(k,1339) * b(k,212) + b(k,227) = b(k,227) - lu(k,1340) * b(k,212) + b(k,228) = b(k,228) - lu(k,1341) * b(k,212) + b(k,229) = b(k,229) - lu(k,1342) * b(k,212) + b(k,231) = b(k,231) - lu(k,1343) * b(k,212) + b(k,235) = b(k,235) - lu(k,1344) * b(k,212) + b(k,237) = b(k,237) - lu(k,1345) * b(k,212) + b(k,238) = b(k,238) - lu(k,1346) * b(k,212) + b(k,239) = b(k,239) - lu(k,1347) * b(k,212) + b(k,215) = b(k,215) - lu(k,1357) * b(k,213) + b(k,216) = b(k,216) - lu(k,1358) * b(k,213) + b(k,217) = b(k,217) - lu(k,1359) * b(k,213) + b(k,225) = b(k,225) - lu(k,1360) * b(k,213) + b(k,226) = b(k,226) - lu(k,1361) * b(k,213) + b(k,227) = b(k,227) - lu(k,1362) * b(k,213) + b(k,228) = b(k,228) - lu(k,1363) * b(k,213) + b(k,229) = b(k,229) - lu(k,1364) * b(k,213) + b(k,231) = b(k,231) - lu(k,1365) * b(k,213) + b(k,237) = b(k,237) - lu(k,1366) * b(k,213) + b(k,238) = b(k,238) - lu(k,1367) * b(k,213) + b(k,239) = b(k,239) - lu(k,1368) * b(k,213) + b(k,215) = b(k,215) - lu(k,1377) * b(k,214) + b(k,216) = b(k,216) - lu(k,1378) * b(k,214) + b(k,217) = b(k,217) - lu(k,1379) * b(k,214) + b(k,222) = b(k,222) - lu(k,1380) * b(k,214) + b(k,225) = b(k,225) - lu(k,1381) * b(k,214) + b(k,226) = b(k,226) - lu(k,1382) * b(k,214) + b(k,227) = b(k,227) - lu(k,1383) * b(k,214) + b(k,228) = b(k,228) - lu(k,1384) * b(k,214) + b(k,229) = b(k,229) - lu(k,1385) * b(k,214) + b(k,231) = b(k,231) - lu(k,1386) * b(k,214) + b(k,235) = b(k,235) - lu(k,1387) * b(k,214) + b(k,236) = b(k,236) - lu(k,1388) * b(k,214) + b(k,237) = b(k,237) - lu(k,1389) * b(k,214) + b(k,238) = b(k,238) - lu(k,1390) * b(k,214) + b(k,239) = b(k,239) - lu(k,1391) * b(k,214) + b(k,216) = b(k,216) - lu(k,1398) * b(k,215) + b(k,217) = b(k,217) - lu(k,1399) * b(k,215) + b(k,225) = b(k,225) - lu(k,1400) * b(k,215) + b(k,226) = b(k,226) - lu(k,1401) * b(k,215) + b(k,227) = b(k,227) - lu(k,1402) * b(k,215) + b(k,228) = b(k,228) - lu(k,1403) * b(k,215) + b(k,229) = b(k,229) - lu(k,1404) * b(k,215) + b(k,231) = b(k,231) - lu(k,1405) * b(k,215) + b(k,235) = b(k,235) - lu(k,1406) * b(k,215) + b(k,237) = b(k,237) - lu(k,1407) * b(k,215) + b(k,238) = b(k,238) - lu(k,1408) * b(k,215) + b(k,239) = b(k,239) - lu(k,1409) * b(k,215) + b(k,217) = b(k,217) - lu(k,1429) * b(k,216) + b(k,222) = b(k,222) - lu(k,1430) * b(k,216) + b(k,225) = b(k,225) - lu(k,1431) * b(k,216) + b(k,226) = b(k,226) - lu(k,1432) * b(k,216) + b(k,227) = b(k,227) - lu(k,1433) * b(k,216) + b(k,228) = b(k,228) - lu(k,1434) * b(k,216) + b(k,229) = b(k,229) - lu(k,1435) * b(k,216) + b(k,231) = b(k,231) - lu(k,1436) * b(k,216) + b(k,235) = b(k,235) - lu(k,1437) * b(k,216) + b(k,236) = b(k,236) - lu(k,1438) * b(k,216) + b(k,237) = b(k,237) - lu(k,1439) * b(k,216) + b(k,238) = b(k,238) - lu(k,1440) * b(k,216) + b(k,239) = b(k,239) - lu(k,1441) * b(k,216) + b(k,222) = b(k,222) - lu(k,1451) * b(k,217) + b(k,226) = b(k,226) - lu(k,1452) * b(k,217) + b(k,227) = b(k,227) - lu(k,1453) * b(k,217) + b(k,228) = b(k,228) - lu(k,1454) * b(k,217) + b(k,230) = b(k,230) - lu(k,1455) * b(k,217) + b(k,232) = b(k,232) - lu(k,1456) * b(k,217) + b(k,233) = b(k,233) - lu(k,1457) * b(k,217) + b(k,237) = b(k,237) - lu(k,1458) * b(k,217) + b(k,220) = b(k,220) - lu(k,1462) * b(k,218) + b(k,225) = b(k,225) - lu(k,1463) * b(k,218) + b(k,226) = b(k,226) - lu(k,1464) * b(k,218) + b(k,230) = b(k,230) - lu(k,1465) * b(k,218) + b(k,231) = b(k,231) - lu(k,1466) * b(k,218) + b(k,232) = b(k,232) - lu(k,1467) * b(k,218) + b(k,233) = b(k,233) - lu(k,1468) * b(k,218) + b(k,234) = b(k,234) - lu(k,1469) * b(k,218) + b(k,236) = b(k,236) - lu(k,1470) * b(k,218) + b(k,238) = b(k,238) - lu(k,1471) * b(k,218) + b(k,239) = b(k,239) - lu(k,1472) * b(k,218) + b(k,221) = b(k,221) - lu(k,1477) * b(k,219) + b(k,222) = b(k,222) - lu(k,1478) * b(k,219) + b(k,223) = b(k,223) - lu(k,1479) * b(k,219) + b(k,224) = b(k,224) - lu(k,1480) * b(k,219) + b(k,226) = b(k,226) - lu(k,1481) * b(k,219) + b(k,227) = b(k,227) - lu(k,1482) * b(k,219) + b(k,228) = b(k,228) - lu(k,1483) * b(k,219) + b(k,232) = b(k,232) - lu(k,1484) * b(k,219) + b(k,233) = b(k,233) - lu(k,1485) * b(k,219) + b(k,234) = b(k,234) - lu(k,1486) * b(k,219) + b(k,235) = b(k,235) - lu(k,1487) * b(k,219) + b(k,237) = b(k,237) - lu(k,1488) * b(k,219) + b(k,239) = b(k,239) - lu(k,1489) * b(k,219) + b(k,221) = b(k,221) - lu(k,1496) * b(k,220) + b(k,223) = b(k,223) - lu(k,1497) * b(k,220) + b(k,224) = b(k,224) - lu(k,1498) * b(k,220) + b(k,225) = b(k,225) - lu(k,1499) * b(k,220) + b(k,226) = b(k,226) - lu(k,1500) * b(k,220) + b(k,228) = b(k,228) - lu(k,1501) * b(k,220) + b(k,230) = b(k,230) - lu(k,1502) * b(k,220) + b(k,231) = b(k,231) - lu(k,1503) * b(k,220) + b(k,232) = b(k,232) - lu(k,1504) * b(k,220) + b(k,233) = b(k,233) - lu(k,1505) * b(k,220) + b(k,234) = b(k,234) - lu(k,1506) * b(k,220) + b(k,239) = b(k,239) - lu(k,1507) * b(k,220) + b(k,222) = b(k,222) - lu(k,1512) * b(k,221) + b(k,223) = b(k,223) - lu(k,1513) * b(k,221) + b(k,226) = b(k,226) - lu(k,1514) * b(k,221) + b(k,227) = b(k,227) - lu(k,1515) * b(k,221) + b(k,228) = b(k,228) - lu(k,1516) * b(k,221) + b(k,229) = b(k,229) - lu(k,1517) * b(k,221) + b(k,230) = b(k,230) - lu(k,1518) * b(k,221) + b(k,232) = b(k,232) - lu(k,1519) * b(k,221) + b(k,233) = b(k,233) - lu(k,1520) * b(k,221) + b(k,235) = b(k,235) - lu(k,1521) * b(k,221) + b(k,237) = b(k,237) - lu(k,1522) * b(k,221) + b(k,239) = b(k,239) - lu(k,1523) * b(k,221) + 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,223) = b(k,223) - lu(k,1543) * b(k,222) + b(k,224) = b(k,224) - lu(k,1544) * b(k,222) + b(k,226) = b(k,226) - lu(k,1545) * b(k,222) + b(k,227) = b(k,227) - lu(k,1546) * b(k,222) + b(k,228) = b(k,228) - lu(k,1547) * b(k,222) + b(k,229) = b(k,229) - lu(k,1548) * b(k,222) + b(k,230) = b(k,230) - lu(k,1549) * b(k,222) + b(k,232) = b(k,232) - lu(k,1550) * b(k,222) + b(k,233) = b(k,233) - lu(k,1551) * b(k,222) + b(k,234) = b(k,234) - lu(k,1552) * b(k,222) + b(k,235) = b(k,235) - lu(k,1553) * b(k,222) + b(k,237) = b(k,237) - lu(k,1554) * b(k,222) + b(k,239) = b(k,239) - lu(k,1555) * b(k,222) + b(k,224) = b(k,224) - lu(k,1566) * b(k,223) + b(k,225) = b(k,225) - lu(k,1567) * b(k,223) + b(k,226) = b(k,226) - lu(k,1568) * b(k,223) + b(k,227) = b(k,227) - lu(k,1569) * b(k,223) + b(k,228) = b(k,228) - lu(k,1570) * b(k,223) + b(k,229) = b(k,229) - lu(k,1571) * b(k,223) + b(k,230) = b(k,230) - lu(k,1572) * b(k,223) + b(k,231) = b(k,231) - lu(k,1573) * b(k,223) + b(k,232) = b(k,232) - lu(k,1574) * b(k,223) + b(k,233) = b(k,233) - lu(k,1575) * b(k,223) + b(k,234) = b(k,234) - lu(k,1576) * b(k,223) + b(k,235) = b(k,235) - lu(k,1577) * b(k,223) + b(k,237) = b(k,237) - lu(k,1578) * b(k,223) + b(k,239) = b(k,239) - lu(k,1579) * b(k,223) + b(k,225) = b(k,225) - lu(k,1593) * b(k,224) + b(k,226) = b(k,226) - lu(k,1594) * b(k,224) + b(k,227) = b(k,227) - lu(k,1595) * b(k,224) + b(k,228) = b(k,228) - lu(k,1596) * b(k,224) + b(k,229) = b(k,229) - lu(k,1597) * b(k,224) + b(k,230) = b(k,230) - lu(k,1598) * b(k,224) + b(k,231) = b(k,231) - lu(k,1599) * b(k,224) + b(k,232) = b(k,232) - lu(k,1600) * b(k,224) + b(k,233) = b(k,233) - lu(k,1601) * b(k,224) + b(k,234) = b(k,234) - lu(k,1602) * b(k,224) + b(k,235) = b(k,235) - lu(k,1603) * b(k,224) + b(k,237) = b(k,237) - lu(k,1604) * b(k,224) + b(k,238) = b(k,238) - lu(k,1605) * b(k,224) + b(k,239) = b(k,239) - lu(k,1606) * b(k,224) + b(k,226) = b(k,226) - lu(k,1653) * b(k,225) + b(k,227) = b(k,227) - lu(k,1654) * b(k,225) + b(k,228) = b(k,228) - lu(k,1655) * b(k,225) + b(k,229) = b(k,229) - lu(k,1656) * b(k,225) + b(k,230) = b(k,230) - lu(k,1657) * b(k,225) + b(k,231) = b(k,231) - lu(k,1658) * b(k,225) + b(k,232) = b(k,232) - lu(k,1659) * b(k,225) + b(k,233) = b(k,233) - lu(k,1660) * b(k,225) + b(k,234) = b(k,234) - lu(k,1661) * b(k,225) + b(k,235) = b(k,235) - lu(k,1662) * b(k,225) + b(k,236) = b(k,236) - lu(k,1663) * b(k,225) + b(k,237) = b(k,237) - lu(k,1664) * b(k,225) + b(k,238) = b(k,238) - lu(k,1665) * b(k,225) + b(k,239) = b(k,239) - lu(k,1666) * b(k,225) + b(k,227) = b(k,227) - lu(k,1819) * b(k,226) + b(k,228) = b(k,228) - lu(k,1820) * b(k,226) + b(k,229) = b(k,229) - lu(k,1821) * b(k,226) + b(k,230) = b(k,230) - lu(k,1822) * b(k,226) + b(k,231) = b(k,231) - lu(k,1823) * b(k,226) + b(k,232) = b(k,232) - lu(k,1824) * b(k,226) + b(k,233) = b(k,233) - lu(k,1825) * b(k,226) + b(k,234) = b(k,234) - lu(k,1826) * b(k,226) + b(k,235) = b(k,235) - lu(k,1827) * b(k,226) + b(k,236) = b(k,236) - lu(k,1828) * b(k,226) + b(k,237) = b(k,237) - lu(k,1829) * b(k,226) + b(k,238) = b(k,238) - lu(k,1830) * b(k,226) + b(k,239) = b(k,239) - lu(k,1831) * b(k,226) + b(k,228) = b(k,228) - lu(k,1915) * b(k,227) + b(k,229) = b(k,229) - lu(k,1916) * b(k,227) + b(k,230) = b(k,230) - lu(k,1917) * b(k,227) + b(k,231) = b(k,231) - lu(k,1918) * b(k,227) + b(k,232) = b(k,232) - lu(k,1919) * b(k,227) + b(k,233) = b(k,233) - lu(k,1920) * b(k,227) + b(k,234) = b(k,234) - lu(k,1921) * b(k,227) + b(k,235) = b(k,235) - lu(k,1922) * b(k,227) + b(k,236) = b(k,236) - lu(k,1923) * b(k,227) + b(k,237) = b(k,237) - lu(k,1924) * b(k,227) + b(k,238) = b(k,238) - lu(k,1925) * b(k,227) + b(k,239) = b(k,239) - lu(k,1926) * b(k,227) + b(k,229) = b(k,229) - lu(k,1961) * b(k,228) + b(k,230) = b(k,230) - lu(k,1962) * b(k,228) + b(k,231) = b(k,231) - lu(k,1963) * b(k,228) + b(k,232) = b(k,232) - lu(k,1964) * b(k,228) + b(k,233) = b(k,233) - lu(k,1965) * b(k,228) + b(k,234) = b(k,234) - lu(k,1966) * b(k,228) + b(k,235) = b(k,235) - lu(k,1967) * b(k,228) + b(k,236) = b(k,236) - lu(k,1968) * b(k,228) + b(k,237) = b(k,237) - lu(k,1969) * b(k,228) + b(k,238) = b(k,238) - lu(k,1970) * b(k,228) + b(k,239) = b(k,239) - lu(k,1971) * b(k,228) + b(k,230) = b(k,230) - lu(k,1988) * b(k,229) + b(k,231) = b(k,231) - lu(k,1989) * b(k,229) + b(k,232) = b(k,232) - lu(k,1990) * b(k,229) + b(k,233) = b(k,233) - lu(k,1991) * b(k,229) + b(k,234) = b(k,234) - lu(k,1992) * b(k,229) + b(k,235) = b(k,235) - lu(k,1993) * b(k,229) + b(k,236) = b(k,236) - lu(k,1994) * b(k,229) + b(k,237) = b(k,237) - lu(k,1995) * b(k,229) + b(k,238) = b(k,238) - lu(k,1996) * b(k,229) + b(k,239) = b(k,239) - lu(k,1997) * b(k,229) + b(k,231) = b(k,231) - lu(k,2032) * b(k,230) + b(k,232) = b(k,232) - lu(k,2033) * b(k,230) + b(k,233) = b(k,233) - lu(k,2034) * b(k,230) + b(k,234) = b(k,234) - lu(k,2035) * b(k,230) + b(k,235) = b(k,235) - lu(k,2036) * b(k,230) + b(k,236) = b(k,236) - lu(k,2037) * b(k,230) + b(k,237) = b(k,237) - lu(k,2038) * b(k,230) + b(k,238) = b(k,238) - lu(k,2039) * b(k,230) + b(k,239) = b(k,239) - lu(k,2040) * b(k,230) + b(k,232) = b(k,232) - lu(k,2056) * b(k,231) + b(k,233) = b(k,233) - lu(k,2057) * b(k,231) + b(k,234) = b(k,234) - lu(k,2058) * b(k,231) + b(k,235) = b(k,235) - lu(k,2059) * b(k,231) + b(k,236) = b(k,236) - lu(k,2060) * b(k,231) + b(k,237) = b(k,237) - lu(k,2061) * b(k,231) + b(k,238) = b(k,238) - lu(k,2062) * b(k,231) + b(k,239) = b(k,239) - lu(k,2063) * b(k,231) + b(k,233) = b(k,233) - lu(k,2100) * b(k,232) + b(k,234) = b(k,234) - lu(k,2101) * b(k,232) + b(k,235) = b(k,235) - lu(k,2102) * b(k,232) + b(k,236) = b(k,236) - lu(k,2103) * b(k,232) + b(k,237) = b(k,237) - lu(k,2104) * b(k,232) + b(k,238) = b(k,238) - lu(k,2105) * b(k,232) + b(k,239) = b(k,239) - lu(k,2106) * b(k,232) + b(k,234) = b(k,234) - lu(k,2122) * b(k,233) + b(k,235) = b(k,235) - lu(k,2123) * b(k,233) + b(k,236) = b(k,236) - lu(k,2124) * b(k,233) + b(k,237) = b(k,237) - lu(k,2125) * b(k,233) + b(k,238) = b(k,238) - lu(k,2126) * b(k,233) + b(k,239) = b(k,239) - lu(k,2127) * b(k,233) + b(k,235) = b(k,235) - lu(k,2169) * b(k,234) + b(k,236) = b(k,236) - lu(k,2170) * b(k,234) + b(k,237) = b(k,237) - lu(k,2171) * b(k,234) + b(k,238) = b(k,238) - lu(k,2172) * b(k,234) + b(k,239) = b(k,239) - lu(k,2173) * b(k,234) + b(k,236) = b(k,236) - lu(k,2234) * b(k,235) + b(k,237) = b(k,237) - lu(k,2235) * b(k,235) + b(k,238) = b(k,238) - lu(k,2236) * b(k,235) + b(k,239) = b(k,239) - lu(k,2237) * b(k,235) + b(k,237) = b(k,237) - lu(k,2260) * b(k,236) + b(k,238) = b(k,238) - lu(k,2261) * b(k,236) + b(k,239) = b(k,239) - lu(k,2262) * b(k,236) + b(k,238) = b(k,238) - lu(k,2369) * b(k,237) + b(k,239) = b(k,239) - lu(k,2370) * b(k,237) + b(k,239) = b(k,239) - lu(k,2422) * b(k,238) + 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 +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,239) = b(k,239) * lu(k,2449) + b(k,238) = b(k,238) - lu(k,2448) * b(k,239) + b(k,237) = b(k,237) - lu(k,2447) * b(k,239) + b(k,236) = b(k,236) - lu(k,2446) * b(k,239) + b(k,235) = b(k,235) - lu(k,2445) * b(k,239) + b(k,234) = b(k,234) - lu(k,2444) * b(k,239) + b(k,233) = b(k,233) - lu(k,2443) * b(k,239) + b(k,232) = b(k,232) - lu(k,2442) * b(k,239) + b(k,231) = b(k,231) - lu(k,2441) * b(k,239) + b(k,230) = b(k,230) - lu(k,2440) * b(k,239) + b(k,229) = b(k,229) - lu(k,2439) * b(k,239) + b(k,228) = b(k,228) - lu(k,2438) * b(k,239) + b(k,227) = b(k,227) - lu(k,2437) * b(k,239) + b(k,226) = b(k,226) - lu(k,2436) * b(k,239) + b(k,225) = b(k,225) - lu(k,2435) * b(k,239) + b(k,224) = b(k,224) - lu(k,2434) * b(k,239) + b(k,223) = b(k,223) - lu(k,2433) * b(k,239) + b(k,222) = b(k,222) - lu(k,2432) * b(k,239) + b(k,221) = b(k,221) - lu(k,2431) * b(k,239) + b(k,220) = b(k,220) - lu(k,2430) * b(k,239) + b(k,219) = b(k,219) - lu(k,2429) * b(k,239) + b(k,218) = b(k,218) - lu(k,2428) * b(k,239) + b(k,186) = b(k,186) - lu(k,2427) * b(k,239) + b(k,184) = b(k,184) - lu(k,2426) * b(k,239) + b(k,99) = b(k,99) - lu(k,2425) * b(k,239) + b(k,94) = b(k,94) - lu(k,2424) * b(k,239) + b(k,64) = b(k,64) - lu(k,2423) * b(k,239) + b(k,238) = b(k,238) * lu(k,2421) + b(k,237) = b(k,237) - lu(k,2420) * b(k,238) + b(k,236) = b(k,236) - lu(k,2419) * b(k,238) + b(k,235) = b(k,235) - lu(k,2418) * b(k,238) + b(k,234) = b(k,234) - lu(k,2417) * b(k,238) + b(k,233) = b(k,233) - lu(k,2416) * b(k,238) + b(k,232) = b(k,232) - lu(k,2415) * b(k,238) + b(k,231) = b(k,231) - lu(k,2414) * b(k,238) + b(k,230) = b(k,230) - lu(k,2413) * b(k,238) + b(k,229) = b(k,229) - lu(k,2412) * b(k,238) + b(k,228) = b(k,228) - lu(k,2411) * b(k,238) + b(k,227) = b(k,227) - lu(k,2410) * b(k,238) + b(k,226) = b(k,226) - lu(k,2409) * b(k,238) + b(k,225) = b(k,225) - lu(k,2408) * b(k,238) + b(k,224) = b(k,224) - lu(k,2407) * b(k,238) + b(k,223) = b(k,223) - lu(k,2406) * b(k,238) + b(k,222) = b(k,222) - lu(k,2405) * b(k,238) + b(k,217) = b(k,217) - lu(k,2404) * b(k,238) + b(k,216) = b(k,216) - lu(k,2403) * b(k,238) + b(k,215) = b(k,215) - lu(k,2402) * b(k,238) + b(k,214) = b(k,214) - lu(k,2401) * b(k,238) + b(k,213) = b(k,213) - lu(k,2400) * b(k,238) + b(k,212) = b(k,212) - lu(k,2399) * b(k,238) + b(k,211) = b(k,211) - lu(k,2398) * b(k,238) + b(k,210) = b(k,210) - lu(k,2397) * b(k,238) + b(k,209) = b(k,209) - lu(k,2396) * b(k,238) + b(k,208) = b(k,208) - lu(k,2395) * b(k,238) + b(k,207) = b(k,207) - lu(k,2394) * b(k,238) + b(k,206) = b(k,206) - lu(k,2393) * b(k,238) + b(k,205) = b(k,205) - lu(k,2392) * b(k,238) + b(k,203) = b(k,203) - lu(k,2391) * b(k,238) + b(k,202) = b(k,202) - lu(k,2390) * b(k,238) + b(k,201) = b(k,201) - lu(k,2389) * b(k,238) + b(k,200) = b(k,200) - lu(k,2388) * b(k,238) + b(k,198) = b(k,198) - lu(k,2387) * b(k,238) + b(k,197) = b(k,197) - lu(k,2386) * b(k,238) + b(k,196) = b(k,196) - lu(k,2385) * b(k,238) + b(k,195) = b(k,195) - lu(k,2384) * b(k,238) + b(k,194) = b(k,194) - lu(k,2383) * b(k,238) + b(k,193) = b(k,193) - lu(k,2382) * b(k,238) + b(k,192) = b(k,192) - lu(k,2381) * b(k,238) + b(k,185) = b(k,185) - lu(k,2380) * b(k,238) + b(k,181) = b(k,181) - lu(k,2379) * b(k,238) + b(k,180) = b(k,180) - lu(k,2378) * b(k,238) + b(k,173) = b(k,173) - lu(k,2377) * b(k,238) + b(k,161) = b(k,161) - lu(k,2376) * b(k,238) + b(k,153) = b(k,153) - lu(k,2375) * b(k,238) + b(k,128) = b(k,128) - lu(k,2374) * b(k,238) + b(k,124) = b(k,124) - lu(k,2373) * b(k,238) + b(k,107) = b(k,107) - lu(k,2372) * b(k,238) + b(k,95) = b(k,95) - lu(k,2371) * b(k,238) + b(k,237) = b(k,237) * lu(k,2368) + b(k,236) = b(k,236) - lu(k,2367) * b(k,237) + b(k,235) = b(k,235) - lu(k,2366) * b(k,237) + b(k,234) = b(k,234) - lu(k,2365) * b(k,237) + b(k,233) = b(k,233) - lu(k,2364) * b(k,237) + b(k,232) = b(k,232) - lu(k,2363) * b(k,237) + b(k,231) = b(k,231) - lu(k,2362) * b(k,237) + b(k,230) = b(k,230) - lu(k,2361) * b(k,237) + b(k,229) = b(k,229) - lu(k,2360) * b(k,237) + b(k,228) = b(k,228) - lu(k,2359) * b(k,237) + b(k,227) = b(k,227) - lu(k,2358) * b(k,237) + b(k,226) = b(k,226) - lu(k,2357) * b(k,237) + b(k,225) = b(k,225) - lu(k,2356) * b(k,237) + b(k,224) = b(k,224) - lu(k,2355) * b(k,237) + b(k,223) = b(k,223) - lu(k,2354) * b(k,237) + b(k,222) = b(k,222) - lu(k,2353) * b(k,237) + b(k,221) = b(k,221) - lu(k,2352) * b(k,237) + b(k,220) = b(k,220) - lu(k,2351) * b(k,237) + b(k,218) = b(k,218) - lu(k,2350) * b(k,237) + b(k,217) = b(k,217) - lu(k,2349) * b(k,237) + b(k,216) = b(k,216) - lu(k,2348) * b(k,237) + b(k,215) = b(k,215) - lu(k,2347) * b(k,237) + b(k,214) = b(k,214) - lu(k,2346) * b(k,237) + b(k,213) = b(k,213) - lu(k,2345) * b(k,237) + b(k,212) = b(k,212) - lu(k,2344) * b(k,237) + b(k,211) = b(k,211) - lu(k,2343) * b(k,237) + b(k,210) = b(k,210) - lu(k,2342) * b(k,237) + b(k,209) = b(k,209) - lu(k,2341) * b(k,237) + b(k,208) = b(k,208) - lu(k,2340) * b(k,237) + b(k,207) = b(k,207) - lu(k,2339) * b(k,237) + b(k,206) = b(k,206) - lu(k,2338) * b(k,237) + b(k,205) = b(k,205) - lu(k,2337) * b(k,237) + b(k,203) = b(k,203) - lu(k,2336) * b(k,237) + b(k,202) = b(k,202) - lu(k,2335) * b(k,237) + b(k,201) = b(k,201) - lu(k,2334) * b(k,237) + b(k,200) = b(k,200) - lu(k,2333) * b(k,237) + b(k,198) = b(k,198) - lu(k,2332) * b(k,237) + b(k,197) = b(k,197) - lu(k,2331) * b(k,237) + b(k,195) = b(k,195) - lu(k,2330) * b(k,237) + b(k,194) = b(k,194) - lu(k,2329) * b(k,237) + b(k,193) = b(k,193) - lu(k,2328) * b(k,237) + b(k,192) = b(k,192) - lu(k,2327) * b(k,237) + b(k,191) = b(k,191) - lu(k,2326) * b(k,237) + b(k,185) = b(k,185) - lu(k,2325) * b(k,237) + b(k,183) = b(k,183) - lu(k,2324) * b(k,237) + b(k,182) = b(k,182) - lu(k,2323) * b(k,237) + b(k,181) = b(k,181) - lu(k,2322) * b(k,237) + b(k,180) = b(k,180) - lu(k,2321) * b(k,237) + b(k,175) = b(k,175) - lu(k,2320) * b(k,237) + b(k,174) = b(k,174) - lu(k,2319) * b(k,237) + b(k,172) = b(k,172) - lu(k,2318) * b(k,237) + b(k,170) = b(k,170) - lu(k,2317) * b(k,237) + b(k,169) = b(k,169) - lu(k,2316) * b(k,237) + b(k,168) = b(k,168) - lu(k,2315) * b(k,237) + b(k,167) = b(k,167) - lu(k,2314) * b(k,237) + b(k,166) = b(k,166) - lu(k,2313) * b(k,237) + b(k,165) = b(k,165) - lu(k,2312) * b(k,237) + b(k,164) = b(k,164) - lu(k,2311) * b(k,237) + b(k,162) = b(k,162) - lu(k,2310) * b(k,237) + b(k,161) = b(k,161) - lu(k,2309) * b(k,237) + b(k,160) = b(k,160) - lu(k,2308) * b(k,237) + b(k,159) = b(k,159) - lu(k,2307) * b(k,237) + b(k,157) = b(k,157) - lu(k,2306) * b(k,237) + b(k,156) = b(k,156) - lu(k,2305) * b(k,237) + b(k,154) = b(k,154) - lu(k,2304) * b(k,237) + b(k,152) = b(k,152) - lu(k,2303) * b(k,237) + b(k,147) = b(k,147) - lu(k,2302) * b(k,237) + b(k,142) = b(k,142) - lu(k,2301) * b(k,237) + b(k,139) = b(k,139) - lu(k,2300) * b(k,237) + b(k,137) = b(k,137) - lu(k,2299) * b(k,237) + b(k,135) = b(k,135) - lu(k,2298) * b(k,237) + b(k,134) = b(k,134) - lu(k,2297) * b(k,237) + b(k,132) = b(k,132) - lu(k,2296) * b(k,237) + b(k,131) = b(k,131) - lu(k,2295) * b(k,237) + b(k,130) = b(k,130) - lu(k,2294) * b(k,237) + b(k,129) = b(k,129) - lu(k,2293) * b(k,237) + b(k,128) = b(k,128) - lu(k,2292) * b(k,237) + b(k,127) = b(k,127) - lu(k,2291) * b(k,237) + b(k,126) = b(k,126) - lu(k,2290) * b(k,237) + b(k,125) = b(k,125) - lu(k,2289) * b(k,237) + b(k,123) = b(k,123) - lu(k,2288) * b(k,237) + b(k,122) = b(k,122) - lu(k,2287) * b(k,237) + b(k,121) = b(k,121) - lu(k,2286) * b(k,237) + b(k,120) = b(k,120) - lu(k,2285) * b(k,237) + b(k,119) = b(k,119) - lu(k,2284) * b(k,237) + b(k,118) = b(k,118) - lu(k,2283) * b(k,237) + b(k,112) = b(k,112) - lu(k,2282) * b(k,237) + b(k,111) = b(k,111) - lu(k,2281) * b(k,237) + b(k,110) = b(k,110) - lu(k,2280) * b(k,237) + b(k,106) = b(k,106) - lu(k,2279) * b(k,237) + b(k,105) = b(k,105) - lu(k,2278) * b(k,237) + b(k,96) = b(k,96) - lu(k,2277) * b(k,237) + b(k,81) = b(k,81) - lu(k,2276) * b(k,237) + b(k,63) = b(k,63) - lu(k,2275) * b(k,237) + b(k,53) = b(k,53) - lu(k,2274) * b(k,237) + b(k,52) = b(k,52) - lu(k,2273) * b(k,237) + b(k,51) = b(k,51) - lu(k,2272) * b(k,237) + b(k,49) = b(k,49) - lu(k,2271) * b(k,237) + b(k,48) = b(k,48) - lu(k,2270) * b(k,237) + b(k,47) = b(k,47) - lu(k,2269) * b(k,237) + b(k,46) = b(k,46) - lu(k,2268) * b(k,237) + b(k,43) = b(k,43) - lu(k,2267) * b(k,237) + b(k,42) = b(k,42) - lu(k,2266) * b(k,237) + b(k,41) = b(k,41) - lu(k,2265) * b(k,237) + b(k,40) = b(k,40) - lu(k,2264) * b(k,237) + b(k,39) = b(k,39) - lu(k,2263) * b(k,237) + b(k,236) = b(k,236) * lu(k,2259) + b(k,235) = b(k,235) - lu(k,2258) * b(k,236) + b(k,234) = b(k,234) - lu(k,2257) * b(k,236) + b(k,233) = b(k,233) - lu(k,2256) * b(k,236) + b(k,232) = b(k,232) - lu(k,2255) * b(k,236) + b(k,231) = b(k,231) - lu(k,2254) * b(k,236) + b(k,230) = b(k,230) - lu(k,2253) * b(k,236) + b(k,229) = b(k,229) - lu(k,2252) * b(k,236) + b(k,228) = b(k,228) - lu(k,2251) * b(k,236) + b(k,227) = b(k,227) - lu(k,2250) * b(k,236) + b(k,226) = b(k,226) - lu(k,2249) * b(k,236) + b(k,225) = b(k,225) - lu(k,2248) * b(k,236) + b(k,224) = b(k,224) - lu(k,2247) * b(k,236) + b(k,223) = b(k,223) - lu(k,2246) * b(k,236) + b(k,222) = b(k,222) - lu(k,2245) * b(k,236) + b(k,221) = b(k,221) - lu(k,2244) * b(k,236) + b(k,220) = b(k,220) - lu(k,2243) * b(k,236) + b(k,218) = b(k,218) - lu(k,2242) * b(k,236) + b(k,217) = b(k,217) - lu(k,2241) * b(k,236) + b(k,201) = b(k,201) - lu(k,2240) * b(k,236) + b(k,184) = b(k,184) - lu(k,2239) * b(k,236) + b(k,99) = b(k,99) - lu(k,2238) * b(k,236) + 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,235) = b(k,235) * lu(k,2233) + b(k,234) = b(k,234) - lu(k,2232) * b(k,235) + b(k,233) = b(k,233) - lu(k,2231) * b(k,235) + b(k,232) = b(k,232) - lu(k,2230) * b(k,235) + b(k,231) = b(k,231) - lu(k,2229) * b(k,235) + b(k,230) = b(k,230) - lu(k,2228) * b(k,235) + b(k,229) = b(k,229) - lu(k,2227) * b(k,235) + b(k,228) = b(k,228) - lu(k,2226) * b(k,235) + b(k,227) = b(k,227) - lu(k,2225) * b(k,235) + b(k,226) = b(k,226) - lu(k,2224) * b(k,235) + b(k,225) = b(k,225) - lu(k,2223) * b(k,235) + b(k,224) = b(k,224) - lu(k,2222) * b(k,235) + b(k,223) = b(k,223) - lu(k,2221) * b(k,235) + b(k,222) = b(k,222) - lu(k,2220) * b(k,235) + b(k,221) = b(k,221) - lu(k,2219) * b(k,235) + b(k,219) = b(k,219) - lu(k,2218) * b(k,235) + b(k,217) = b(k,217) - lu(k,2217) * b(k,235) + b(k,216) = b(k,216) - lu(k,2216) * b(k,235) + b(k,215) = b(k,215) - lu(k,2215) * b(k,235) + b(k,214) = b(k,214) - lu(k,2214) * b(k,235) + b(k,213) = b(k,213) - lu(k,2213) * b(k,235) + b(k,212) = b(k,212) - lu(k,2212) * b(k,235) + b(k,211) = b(k,211) - lu(k,2211) * b(k,235) + b(k,210) = b(k,210) - lu(k,2210) * b(k,235) + b(k,209) = b(k,209) - lu(k,2209) * b(k,235) + b(k,208) = b(k,208) - lu(k,2208) * b(k,235) + b(k,206) = b(k,206) - lu(k,2207) * b(k,235) + b(k,205) = b(k,205) - lu(k,2206) * b(k,235) + b(k,203) = b(k,203) - lu(k,2205) * b(k,235) + b(k,202) = b(k,202) - lu(k,2204) * b(k,235) + b(k,201) = b(k,201) - lu(k,2203) * b(k,235) + b(k,200) = b(k,200) - lu(k,2202) * b(k,235) + b(k,199) = b(k,199) - lu(k,2201) * b(k,235) + b(k,198) = b(k,198) - lu(k,2200) * b(k,235) + b(k,197) = b(k,197) - lu(k,2199) * b(k,235) + b(k,195) = b(k,195) - lu(k,2198) * b(k,235) + b(k,194) = b(k,194) - lu(k,2197) * b(k,235) + b(k,193) = b(k,193) - lu(k,2196) * b(k,235) + b(k,192) = b(k,192) - lu(k,2195) * b(k,235) + b(k,191) = b(k,191) - lu(k,2194) * b(k,235) + b(k,190) = b(k,190) - lu(k,2193) * b(k,235) + b(k,188) = b(k,188) - lu(k,2192) * b(k,235) + b(k,186) = b(k,186) - lu(k,2191) * b(k,235) + b(k,183) = b(k,183) - lu(k,2190) * b(k,235) + b(k,179) = b(k,179) - lu(k,2189) * b(k,235) + b(k,170) = b(k,170) - lu(k,2188) * b(k,235) + b(k,163) = b(k,163) - lu(k,2187) * b(k,235) + b(k,161) = b(k,161) - lu(k,2186) * b(k,235) + b(k,154) = b(k,154) - lu(k,2185) * b(k,235) + b(k,143) = b(k,143) - lu(k,2184) * b(k,235) + b(k,131) = b(k,131) - lu(k,2183) * b(k,235) + b(k,116) = b(k,116) - lu(k,2182) * b(k,235) + b(k,85) = b(k,85) - lu(k,2181) * b(k,235) + b(k,76) = b(k,76) - lu(k,2180) * b(k,235) + b(k,75) = b(k,75) - lu(k,2179) * b(k,235) + b(k,43) = b(k,43) - lu(k,2178) * b(k,235) + b(k,42) = b(k,42) - lu(k,2177) * b(k,235) + b(k,41) = b(k,41) - lu(k,2176) * b(k,235) + b(k,40) = b(k,40) - lu(k,2175) * b(k,235) + b(k,39) = b(k,39) - lu(k,2174) * b(k,235) + b(k,234) = b(k,234) * lu(k,2168) + b(k,233) = b(k,233) - lu(k,2167) * b(k,234) + b(k,232) = b(k,232) - lu(k,2166) * b(k,234) + b(k,231) = b(k,231) - lu(k,2165) * b(k,234) + b(k,230) = b(k,230) - lu(k,2164) * b(k,234) + b(k,229) = b(k,229) - lu(k,2163) * b(k,234) + b(k,228) = b(k,228) - lu(k,2162) * b(k,234) + b(k,227) = b(k,227) - lu(k,2161) * b(k,234) + b(k,226) = b(k,226) - lu(k,2160) * b(k,234) + b(k,225) = b(k,225) - lu(k,2159) * b(k,234) + b(k,224) = b(k,224) - lu(k,2158) * b(k,234) + b(k,223) = b(k,223) - lu(k,2157) * b(k,234) + b(k,222) = b(k,222) - lu(k,2156) * b(k,234) + b(k,221) = b(k,221) - lu(k,2155) * b(k,234) + b(k,220) = b(k,220) - lu(k,2154) * b(k,234) + b(k,218) = b(k,218) - lu(k,2153) * b(k,234) + b(k,217) = b(k,217) - lu(k,2152) * b(k,234) + b(k,216) = b(k,216) - lu(k,2151) * b(k,234) + b(k,210) = b(k,210) - lu(k,2150) * b(k,234) + b(k,206) = b(k,206) - lu(k,2149) * b(k,234) + b(k,202) = b(k,202) - lu(k,2148) * b(k,234) + b(k,201) = b(k,201) - lu(k,2147) * b(k,234) + b(k,200) = b(k,200) - lu(k,2146) * b(k,234) + b(k,195) = b(k,195) - lu(k,2145) * b(k,234) + b(k,192) = b(k,192) - lu(k,2144) * b(k,234) + b(k,187) = b(k,187) - lu(k,2143) * b(k,234) + b(k,185) = b(k,185) - lu(k,2142) * b(k,234) + b(k,183) = b(k,183) - lu(k,2141) * b(k,234) + b(k,181) = b(k,181) - lu(k,2140) * b(k,234) + b(k,175) = b(k,175) - lu(k,2139) * b(k,234) + b(k,170) = b(k,170) - lu(k,2138) * b(k,234) + b(k,150) = b(k,150) - lu(k,2137) * b(k,234) + b(k,147) = b(k,147) - lu(k,2136) * b(k,234) + b(k,143) = b(k,143) - lu(k,2135) * b(k,234) + b(k,133) = b(k,133) - lu(k,2134) * b(k,234) + b(k,117) = b(k,117) - lu(k,2133) * b(k,234) + b(k,115) = b(k,115) - lu(k,2132) * b(k,234) + b(k,103) = b(k,103) - lu(k,2131) * b(k,234) + b(k,102) = b(k,102) - lu(k,2130) * b(k,234) + b(k,100) = b(k,100) - lu(k,2129) * b(k,234) + b(k,74) = b(k,74) - lu(k,2128) * b(k,234) + b(k,233) = b(k,233) * lu(k,2121) + b(k,232) = b(k,232) - lu(k,2120) * b(k,233) + b(k,231) = b(k,231) - lu(k,2119) * b(k,233) + b(k,230) = b(k,230) - lu(k,2118) * b(k,233) + b(k,229) = b(k,229) - lu(k,2117) * b(k,233) + b(k,228) = b(k,228) - lu(k,2116) * b(k,233) + b(k,227) = b(k,227) - lu(k,2115) * b(k,233) + b(k,226) = b(k,226) - lu(k,2114) * b(k,233) + b(k,225) = b(k,225) - lu(k,2113) * b(k,233) + b(k,224) = b(k,224) - lu(k,2112) * b(k,233) + b(k,223) = b(k,223) - lu(k,2111) * b(k,233) + b(k,222) = b(k,222) - lu(k,2110) * b(k,233) + b(k,221) = b(k,221) - lu(k,2109) * b(k,233) + b(k,220) = b(k,220) - lu(k,2108) * b(k,233) + b(k,218) = b(k,218) - lu(k,2107) * b(k,233) + b(k,232) = b(k,232) * lu(k,2099) + b(k,231) = b(k,231) - lu(k,2098) * b(k,232) + b(k,230) = b(k,230) - lu(k,2097) * b(k,232) + b(k,229) = b(k,229) - lu(k,2096) * b(k,232) + b(k,228) = b(k,228) - lu(k,2095) * b(k,232) + b(k,227) = b(k,227) - lu(k,2094) * b(k,232) + b(k,226) = b(k,226) - lu(k,2093) * b(k,232) + b(k,225) = b(k,225) - lu(k,2092) * b(k,232) + b(k,224) = b(k,224) - lu(k,2091) * b(k,232) + b(k,223) = b(k,223) - lu(k,2090) * b(k,232) + b(k,222) = b(k,222) - lu(k,2089) * b(k,232) + b(k,221) = b(k,221) - lu(k,2088) * b(k,232) + b(k,220) = b(k,220) - lu(k,2087) * b(k,232) + b(k,219) = b(k,219) - lu(k,2086) * b(k,232) + b(k,218) = b(k,218) - lu(k,2085) * b(k,232) + b(k,217) = b(k,217) - lu(k,2084) * b(k,232) + b(k,201) = b(k,201) - lu(k,2083) * b(k,232) + b(k,189) = b(k,189) - lu(k,2082) * b(k,232) + b(k,187) = b(k,187) - lu(k,2081) * b(k,232) + b(k,186) = b(k,186) - lu(k,2080) * b(k,232) + b(k,178) = b(k,178) - lu(k,2079) * b(k,232) + b(k,177) = b(k,177) - lu(k,2078) * b(k,232) + b(k,176) = b(k,176) - lu(k,2077) * b(k,232) + b(k,175) = b(k,175) - lu(k,2076) * b(k,232) + b(k,174) = b(k,174) - lu(k,2075) * b(k,232) + b(k,171) = b(k,171) - lu(k,2074) * b(k,232) + b(k,169) = b(k,169) - lu(k,2073) * b(k,232) + b(k,163) = b(k,163) - lu(k,2072) * b(k,232) + b(k,158) = b(k,158) - lu(k,2071) * b(k,232) + b(k,147) = b(k,147) - lu(k,2070) * b(k,232) + b(k,145) = b(k,145) - lu(k,2069) * b(k,232) + b(k,140) = b(k,140) - lu(k,2068) * b(k,232) + b(k,136) = b(k,136) - lu(k,2067) * b(k,232) + b(k,114) = b(k,114) - lu(k,2066) * b(k,232) + b(k,76) = b(k,76) - lu(k,2065) * b(k,232) + b(k,75) = b(k,75) - lu(k,2064) * b(k,232) + b(k,231) = b(k,231) * lu(k,2055) + b(k,230) = b(k,230) - lu(k,2054) * b(k,231) + b(k,229) = b(k,229) - lu(k,2053) * b(k,231) + b(k,228) = b(k,228) - lu(k,2052) * b(k,231) + b(k,227) = b(k,227) - lu(k,2051) * b(k,231) + b(k,226) = b(k,226) - lu(k,2050) * b(k,231) + b(k,225) = b(k,225) - lu(k,2049) * b(k,231) + b(k,224) = b(k,224) - lu(k,2048) * b(k,231) + b(k,223) = b(k,223) - lu(k,2047) * b(k,231) + b(k,222) = b(k,222) - lu(k,2046) * b(k,231) + b(k,221) = b(k,221) - lu(k,2045) * b(k,231) + b(k,220) = b(k,220) - lu(k,2044) * b(k,231) + b(k,218) = b(k,218) - lu(k,2043) * b(k,231) + b(k,184) = b(k,184) - lu(k,2042) * b(k,231) + b(k,99) = b(k,99) - lu(k,2041) * b(k,231) + b(k,230) = b(k,230) * lu(k,2031) + b(k,229) = b(k,229) - lu(k,2030) * b(k,230) + b(k,228) = b(k,228) - lu(k,2029) * b(k,230) + b(k,227) = b(k,227) - lu(k,2028) * b(k,230) + b(k,226) = b(k,226) - lu(k,2027) * b(k,230) + b(k,225) = b(k,225) - lu(k,2026) * b(k,230) + b(k,224) = b(k,224) - lu(k,2025) * b(k,230) + b(k,223) = b(k,223) - lu(k,2024) * b(k,230) + b(k,222) = b(k,222) - lu(k,2023) * b(k,230) + b(k,221) = b(k,221) - lu(k,2022) * b(k,230) + b(k,220) = b(k,220) - lu(k,2021) * b(k,230) + b(k,218) = b(k,218) - lu(k,2020) * b(k,230) + b(k,184) = b(k,184) - lu(k,2019) * b(k,230) + b(k,174) = b(k,174) - lu(k,2018) * b(k,230) + b(k,150) = b(k,150) - lu(k,2017) * b(k,230) + b(k,133) = b(k,133) - lu(k,2016) * b(k,230) + b(k,117) = b(k,117) - lu(k,2015) * b(k,230) + b(k,101) = b(k,101) - lu(k,2014) * b(k,230) + b(k,93) = b(k,93) - lu(k,2013) * b(k,230) + b(k,92) = b(k,92) - lu(k,2012) * b(k,230) + b(k,91) = b(k,91) - lu(k,2011) * b(k,230) + b(k,90) = b(k,90) - lu(k,2010) * b(k,230) + b(k,89) = b(k,89) - lu(k,2009) * b(k,230) + b(k,77) = b(k,77) - lu(k,2008) * b(k,230) + b(k,76) = b(k,76) - lu(k,2007) * b(k,230) + b(k,70) = b(k,70) - lu(k,2006) * b(k,230) + b(k,69) = b(k,69) - lu(k,2005) * b(k,230) + b(k,68) = b(k,68) - lu(k,2004) * b(k,230) + b(k,67) = b(k,67) - lu(k,2003) * b(k,230) + b(k,61) = b(k,61) - lu(k,2002) * b(k,230) + b(k,60) = b(k,60) - lu(k,2001) * b(k,230) + b(k,59) = b(k,59) - lu(k,2000) * b(k,230) + b(k,58) = b(k,58) - lu(k,1999) * b(k,230) + b(k,56) = b(k,56) - lu(k,1998) * b(k,230) + end do + end subroutine lu_slv08 + subroutine lu_slv09( 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,229) = b(k,229) * lu(k,1987) + b(k,228) = b(k,228) - lu(k,1986) * b(k,229) + b(k,227) = b(k,227) - lu(k,1985) * b(k,229) + b(k,226) = b(k,226) - lu(k,1984) * b(k,229) + b(k,225) = b(k,225) - lu(k,1983) * b(k,229) + b(k,224) = b(k,224) - lu(k,1982) * b(k,229) + b(k,223) = b(k,223) - lu(k,1981) * b(k,229) + b(k,222) = b(k,222) - lu(k,1980) * b(k,229) + b(k,221) = b(k,221) - lu(k,1979) * b(k,229) + b(k,220) = b(k,220) - lu(k,1978) * b(k,229) + b(k,218) = b(k,218) - lu(k,1977) * b(k,229) + b(k,217) = b(k,217) - lu(k,1976) * b(k,229) + b(k,201) = b(k,201) - lu(k,1975) * b(k,229) + b(k,183) = b(k,183) - lu(k,1974) * b(k,229) + b(k,174) = b(k,174) - lu(k,1973) * b(k,229) + b(k,126) = b(k,126) - lu(k,1972) * b(k,229) + b(k,228) = b(k,228) * lu(k,1960) + b(k,227) = b(k,227) - lu(k,1959) * b(k,228) + b(k,226) = b(k,226) - lu(k,1958) * b(k,228) + b(k,225) = b(k,225) - lu(k,1957) * b(k,228) + b(k,224) = b(k,224) - lu(k,1956) * b(k,228) + b(k,223) = b(k,223) - lu(k,1955) * b(k,228) + b(k,222) = b(k,222) - lu(k,1954) * b(k,228) + b(k,221) = b(k,221) - lu(k,1953) * b(k,228) + b(k,220) = b(k,220) - lu(k,1952) * b(k,228) + b(k,219) = b(k,219) - lu(k,1951) * b(k,228) + b(k,217) = b(k,217) - lu(k,1950) * b(k,228) + b(k,216) = b(k,216) - lu(k,1949) * b(k,228) + b(k,215) = b(k,215) - lu(k,1948) * b(k,228) + b(k,210) = b(k,210) - lu(k,1947) * b(k,228) + b(k,205) = b(k,205) - lu(k,1946) * b(k,228) + b(k,201) = b(k,201) - lu(k,1945) * b(k,228) + b(k,192) = b(k,192) - lu(k,1944) * b(k,228) + b(k,189) = b(k,189) - lu(k,1943) * b(k,228) + b(k,187) = b(k,187) - lu(k,1942) * b(k,228) + b(k,186) = b(k,186) - lu(k,1941) * b(k,228) + b(k,182) = b(k,182) - lu(k,1940) * b(k,228) + b(k,169) = b(k,169) - lu(k,1939) * b(k,228) + b(k,168) = b(k,168) - lu(k,1938) * b(k,228) + b(k,165) = b(k,165) - lu(k,1937) * b(k,228) + b(k,154) = b(k,154) - lu(k,1936) * b(k,228) + b(k,151) = b(k,151) - lu(k,1935) * b(k,228) + b(k,145) = b(k,145) - lu(k,1934) * b(k,228) + b(k,141) = b(k,141) - lu(k,1933) * b(k,228) + b(k,139) = b(k,139) - lu(k,1932) * b(k,228) + b(k,132) = b(k,132) - lu(k,1931) * b(k,228) + b(k,131) = b(k,131) - lu(k,1930) * b(k,228) + b(k,97) = b(k,97) - lu(k,1929) * b(k,228) + b(k,93) = b(k,93) - lu(k,1928) * b(k,228) + b(k,66) = b(k,66) - lu(k,1927) * b(k,228) + b(k,227) = b(k,227) * lu(k,1914) + b(k,226) = b(k,226) - lu(k,1913) * b(k,227) + b(k,225) = b(k,225) - lu(k,1912) * b(k,227) + b(k,224) = b(k,224) - lu(k,1911) * b(k,227) + b(k,223) = b(k,223) - lu(k,1910) * b(k,227) + b(k,222) = b(k,222) - lu(k,1909) * b(k,227) + b(k,221) = b(k,221) - lu(k,1908) * b(k,227) + b(k,217) = b(k,217) - lu(k,1907) * b(k,227) + b(k,216) = b(k,216) - lu(k,1906) * b(k,227) + b(k,215) = b(k,215) - lu(k,1905) * b(k,227) + b(k,214) = b(k,214) - lu(k,1904) * b(k,227) + b(k,213) = b(k,213) - lu(k,1903) * b(k,227) + b(k,212) = b(k,212) - lu(k,1902) * b(k,227) + b(k,211) = b(k,211) - lu(k,1901) * b(k,227) + b(k,210) = b(k,210) - lu(k,1900) * b(k,227) + b(k,209) = b(k,209) - lu(k,1899) * b(k,227) + b(k,208) = b(k,208) - lu(k,1898) * b(k,227) + b(k,207) = b(k,207) - lu(k,1897) * b(k,227) + b(k,206) = b(k,206) - lu(k,1896) * b(k,227) + b(k,205) = b(k,205) - lu(k,1895) * b(k,227) + b(k,204) = b(k,204) - lu(k,1894) * b(k,227) + b(k,203) = b(k,203) - lu(k,1893) * b(k,227) + b(k,202) = b(k,202) - lu(k,1892) * b(k,227) + b(k,201) = b(k,201) - lu(k,1891) * b(k,227) + b(k,200) = b(k,200) - lu(k,1890) * b(k,227) + b(k,198) = b(k,198) - lu(k,1889) * b(k,227) + b(k,197) = b(k,197) - lu(k,1888) * b(k,227) + b(k,196) = b(k,196) - lu(k,1887) * b(k,227) + b(k,195) = b(k,195) - lu(k,1886) * b(k,227) + b(k,194) = b(k,194) - lu(k,1885) * b(k,227) + b(k,193) = b(k,193) - lu(k,1884) * b(k,227) + b(k,192) = b(k,192) - lu(k,1883) * b(k,227) + b(k,191) = b(k,191) - lu(k,1882) * b(k,227) + b(k,189) = b(k,189) - lu(k,1881) * b(k,227) + b(k,185) = b(k,185) - lu(k,1880) * b(k,227) + b(k,183) = b(k,183) - lu(k,1879) * b(k,227) + b(k,182) = b(k,182) - lu(k,1878) * b(k,227) + b(k,181) = b(k,181) - lu(k,1877) * b(k,227) + b(k,180) = b(k,180) - lu(k,1876) * b(k,227) + b(k,178) = b(k,178) - lu(k,1875) * b(k,227) + b(k,177) = b(k,177) - lu(k,1874) * b(k,227) + b(k,176) = b(k,176) - lu(k,1873) * b(k,227) + b(k,172) = b(k,172) - lu(k,1872) * b(k,227) + b(k,170) = b(k,170) - lu(k,1871) * b(k,227) + b(k,168) = b(k,168) - lu(k,1870) * b(k,227) + b(k,167) = b(k,167) - lu(k,1869) * b(k,227) + b(k,166) = b(k,166) - lu(k,1868) * b(k,227) + b(k,165) = b(k,165) - lu(k,1867) * b(k,227) + b(k,160) = b(k,160) - lu(k,1866) * b(k,227) + b(k,155) = b(k,155) - lu(k,1865) * b(k,227) + b(k,154) = b(k,154) - lu(k,1864) * b(k,227) + b(k,153) = b(k,153) - lu(k,1863) * b(k,227) + b(k,149) = b(k,149) - lu(k,1862) * b(k,227) + b(k,148) = b(k,148) - lu(k,1861) * b(k,227) + b(k,146) = b(k,146) - lu(k,1860) * b(k,227) + b(k,144) = b(k,144) - lu(k,1859) * b(k,227) + b(k,139) = b(k,139) - lu(k,1858) * b(k,227) + b(k,138) = b(k,138) - lu(k,1857) * b(k,227) + b(k,137) = b(k,137) - lu(k,1856) * b(k,227) + b(k,135) = b(k,135) - lu(k,1855) * b(k,227) + b(k,131) = b(k,131) - lu(k,1854) * b(k,227) + b(k,130) = b(k,130) - lu(k,1853) * b(k,227) + b(k,129) = b(k,129) - lu(k,1852) * b(k,227) + b(k,127) = b(k,127) - lu(k,1851) * b(k,227) + b(k,126) = b(k,126) - lu(k,1850) * b(k,227) + b(k,125) = b(k,125) - lu(k,1849) * b(k,227) + b(k,108) = b(k,108) - lu(k,1848) * b(k,227) + b(k,107) = b(k,107) - lu(k,1847) * b(k,227) + b(k,98) = b(k,98) - lu(k,1846) * b(k,227) + b(k,88) = b(k,88) - lu(k,1845) * b(k,227) + b(k,87) = b(k,87) - lu(k,1844) * b(k,227) + b(k,53) = b(k,53) - lu(k,1843) * b(k,227) + b(k,52) = b(k,52) - lu(k,1842) * b(k,227) + b(k,51) = b(k,51) - lu(k,1841) * b(k,227) + b(k,49) = b(k,49) - lu(k,1840) * b(k,227) + b(k,48) = b(k,48) - lu(k,1839) * b(k,227) + b(k,47) = b(k,47) - lu(k,1838) * b(k,227) + b(k,46) = b(k,46) - lu(k,1837) * b(k,227) + b(k,43) = b(k,43) - lu(k,1836) * b(k,227) + b(k,42) = b(k,42) - lu(k,1835) * b(k,227) + b(k,41) = b(k,41) - lu(k,1834) * b(k,227) + b(k,40) = b(k,40) - lu(k,1833) * b(k,227) + b(k,39) = b(k,39) - lu(k,1832) * b(k,227) + b(k,226) = b(k,226) * lu(k,1818) + b(k,225) = b(k,225) - lu(k,1817) * b(k,226) + b(k,224) = b(k,224) - lu(k,1816) * b(k,226) + b(k,223) = b(k,223) - lu(k,1815) * b(k,226) + b(k,222) = b(k,222) - lu(k,1814) * b(k,226) + b(k,221) = b(k,221) - lu(k,1813) * b(k,226) + b(k,220) = b(k,220) - lu(k,1812) * b(k,226) + b(k,219) = b(k,219) - lu(k,1811) * b(k,226) + b(k,218) = b(k,218) - lu(k,1810) * b(k,226) + b(k,217) = b(k,217) - lu(k,1809) * b(k,226) + b(k,216) = b(k,216) - lu(k,1808) * b(k,226) + b(k,215) = b(k,215) - lu(k,1807) * b(k,226) + b(k,214) = b(k,214) - lu(k,1806) * b(k,226) + b(k,213) = b(k,213) - lu(k,1805) * b(k,226) + b(k,212) = b(k,212) - lu(k,1804) * b(k,226) + b(k,211) = b(k,211) - lu(k,1803) * b(k,226) + b(k,210) = b(k,210) - lu(k,1802) * b(k,226) + b(k,209) = b(k,209) - lu(k,1801) * b(k,226) + b(k,208) = b(k,208) - lu(k,1800) * b(k,226) + b(k,207) = b(k,207) - lu(k,1799) * b(k,226) + b(k,206) = b(k,206) - lu(k,1798) * b(k,226) + b(k,205) = b(k,205) - lu(k,1797) * b(k,226) + b(k,204) = b(k,204) - lu(k,1796) * b(k,226) + b(k,203) = b(k,203) - lu(k,1795) * b(k,226) + b(k,202) = b(k,202) - lu(k,1794) * b(k,226) + b(k,201) = b(k,201) - lu(k,1793) * b(k,226) + b(k,200) = b(k,200) - lu(k,1792) * b(k,226) + b(k,199) = b(k,199) - lu(k,1791) * b(k,226) + b(k,198) = b(k,198) - lu(k,1790) * b(k,226) + b(k,197) = b(k,197) - lu(k,1789) * b(k,226) + b(k,196) = b(k,196) - lu(k,1788) * b(k,226) + b(k,195) = b(k,195) - lu(k,1787) * b(k,226) + b(k,194) = b(k,194) - lu(k,1786) * b(k,226) + b(k,193) = b(k,193) - lu(k,1785) * b(k,226) + b(k,192) = b(k,192) - lu(k,1784) * b(k,226) + b(k,191) = b(k,191) - lu(k,1783) * b(k,226) + b(k,190) = b(k,190) - lu(k,1782) * b(k,226) + b(k,189) = b(k,189) - lu(k,1781) * b(k,226) + b(k,188) = b(k,188) - lu(k,1780) * b(k,226) + b(k,187) = b(k,187) - lu(k,1779) * b(k,226) + b(k,186) = b(k,186) - lu(k,1778) * b(k,226) + b(k,185) = b(k,185) - lu(k,1777) * b(k,226) + b(k,184) = b(k,184) - lu(k,1776) * b(k,226) + b(k,183) = b(k,183) - lu(k,1775) * b(k,226) + b(k,182) = b(k,182) - lu(k,1774) * b(k,226) + b(k,181) = b(k,181) - lu(k,1773) * b(k,226) + b(k,180) = b(k,180) - lu(k,1772) * b(k,226) + b(k,179) = b(k,179) - lu(k,1771) * b(k,226) + b(k,175) = b(k,175) - lu(k,1770) * b(k,226) + b(k,174) = b(k,174) - lu(k,1769) * b(k,226) + b(k,173) = b(k,173) - lu(k,1768) * b(k,226) + b(k,172) = b(k,172) - lu(k,1767) * b(k,226) + b(k,170) = b(k,170) - lu(k,1766) * b(k,226) + b(k,168) = b(k,168) - lu(k,1765) * b(k,226) + b(k,167) = b(k,167) - lu(k,1764) * b(k,226) + b(k,166) = b(k,166) - lu(k,1763) * b(k,226) + b(k,165) = b(k,165) - lu(k,1762) * b(k,226) + b(k,164) = b(k,164) - lu(k,1761) * b(k,226) + b(k,163) = b(k,163) - lu(k,1760) * b(k,226) + b(k,162) = b(k,162) - lu(k,1759) * b(k,226) + b(k,161) = b(k,161) - lu(k,1758) * b(k,226) + b(k,160) = b(k,160) - lu(k,1757) * b(k,226) + b(k,159) = b(k,159) - lu(k,1756) * b(k,226) + b(k,157) = b(k,157) - lu(k,1755) * b(k,226) + b(k,156) = b(k,156) - lu(k,1754) * b(k,226) + b(k,155) = b(k,155) - lu(k,1753) * b(k,226) + b(k,154) = b(k,154) - lu(k,1752) * b(k,226) + b(k,153) = b(k,153) - lu(k,1751) * b(k,226) + b(k,152) = b(k,152) - lu(k,1750) * b(k,226) + b(k,151) = b(k,151) - lu(k,1749) * b(k,226) + b(k,150) = b(k,150) - lu(k,1748) * b(k,226) + b(k,149) = b(k,149) - lu(k,1747) * b(k,226) + b(k,148) = b(k,148) - lu(k,1746) * b(k,226) + b(k,147) = b(k,147) - lu(k,1745) * b(k,226) + b(k,146) = b(k,146) - lu(k,1744) * b(k,226) + b(k,144) = b(k,144) - lu(k,1743) * b(k,226) + b(k,143) = b(k,143) - lu(k,1742) * b(k,226) + b(k,142) = b(k,142) - lu(k,1741) * b(k,226) + b(k,141) = b(k,141) - lu(k,1740) * b(k,226) + b(k,139) = b(k,139) - lu(k,1739) * b(k,226) + b(k,138) = b(k,138) - lu(k,1738) * b(k,226) + b(k,137) = b(k,137) - lu(k,1737) * b(k,226) + b(k,135) = b(k,135) - lu(k,1736) * b(k,226) + b(k,134) = b(k,134) - lu(k,1735) * b(k,226) + b(k,133) = b(k,133) - lu(k,1734) * b(k,226) + b(k,132) = b(k,132) - lu(k,1733) * b(k,226) + b(k,131) = b(k,131) - lu(k,1732) * b(k,226) + b(k,130) = b(k,130) - lu(k,1731) * b(k,226) + b(k,128) = b(k,128) - lu(k,1730) * b(k,226) + b(k,127) = b(k,127) - lu(k,1729) * b(k,226) + b(k,125) = b(k,125) - lu(k,1728) * b(k,226) + b(k,124) = b(k,124) - lu(k,1727) * b(k,226) + b(k,123) = b(k,123) - lu(k,1726) * b(k,226) + b(k,122) = b(k,122) - lu(k,1725) * b(k,226) + b(k,121) = b(k,121) - lu(k,1724) * b(k,226) + b(k,120) = b(k,120) - lu(k,1723) * b(k,226) + b(k,119) = b(k,119) - lu(k,1722) * b(k,226) + b(k,118) = b(k,118) - lu(k,1721) * b(k,226) + b(k,117) = b(k,117) - lu(k,1720) * b(k,226) + b(k,115) = b(k,115) - lu(k,1719) * b(k,226) + b(k,114) = b(k,114) - lu(k,1718) * b(k,226) + b(k,113) = b(k,113) - lu(k,1717) * b(k,226) + b(k,112) = b(k,112) - lu(k,1716) * b(k,226) + b(k,111) = b(k,111) - lu(k,1715) * b(k,226) + b(k,110) = b(k,110) - lu(k,1714) * b(k,226) + b(k,107) = b(k,107) - lu(k,1713) * b(k,226) + b(k,106) = b(k,106) - lu(k,1712) * b(k,226) + b(k,105) = b(k,105) - lu(k,1711) * b(k,226) + b(k,104) = b(k,104) - lu(k,1710) * b(k,226) + b(k,103) = b(k,103) - lu(k,1709) * b(k,226) + b(k,102) = b(k,102) - lu(k,1708) * b(k,226) + b(k,101) = b(k,101) - lu(k,1707) * b(k,226) + b(k,100) = b(k,100) - lu(k,1706) * b(k,226) + b(k,96) = b(k,96) - lu(k,1705) * b(k,226) + b(k,95) = b(k,95) - lu(k,1704) * b(k,226) + b(k,94) = b(k,94) - lu(k,1703) * b(k,226) + b(k,92) = b(k,92) - lu(k,1702) * b(k,226) + b(k,91) = b(k,91) - lu(k,1701) * b(k,226) + b(k,90) = b(k,90) - lu(k,1700) * b(k,226) + b(k,89) = b(k,89) - lu(k,1699) * b(k,226) + b(k,88) = b(k,88) - lu(k,1698) * b(k,226) + b(k,87) = b(k,87) - lu(k,1697) * b(k,226) + b(k,85) = b(k,85) - lu(k,1696) * b(k,226) + b(k,84) = b(k,84) - lu(k,1695) * b(k,226) + b(k,83) = b(k,83) - lu(k,1694) * b(k,226) + b(k,82) = b(k,82) - lu(k,1693) * b(k,226) + b(k,81) = b(k,81) - lu(k,1692) * b(k,226) + b(k,80) = b(k,80) - lu(k,1691) * b(k,226) + b(k,79) = b(k,79) - lu(k,1690) * b(k,226) + b(k,78) = b(k,78) - lu(k,1689) * b(k,226) + b(k,77) = b(k,77) - lu(k,1688) * b(k,226) + b(k,73) = b(k,73) - lu(k,1687) * b(k,226) + b(k,72) = b(k,72) - lu(k,1686) * b(k,226) + b(k,71) = b(k,71) - lu(k,1685) * b(k,226) + b(k,65) = b(k,65) - lu(k,1684) * b(k,226) + b(k,62) = b(k,62) - lu(k,1683) * b(k,226) + b(k,57) = b(k,57) - lu(k,1682) * b(k,226) + b(k,55) = b(k,55) - lu(k,1681) * b(k,226) + b(k,53) = b(k,53) - lu(k,1680) * b(k,226) + b(k,52) = b(k,52) - lu(k,1679) * b(k,226) + b(k,51) = b(k,51) - lu(k,1678) * b(k,226) + b(k,50) = b(k,50) - lu(k,1677) * b(k,226) + b(k,49) = b(k,49) - lu(k,1676) * b(k,226) + b(k,48) = b(k,48) - lu(k,1675) * b(k,226) + b(k,47) = b(k,47) - lu(k,1674) * b(k,226) + b(k,46) = b(k,46) - lu(k,1673) * b(k,226) + b(k,45) = b(k,45) - lu(k,1672) * b(k,226) + b(k,43) = b(k,43) - lu(k,1671) * b(k,226) + b(k,42) = b(k,42) - lu(k,1670) * b(k,226) + b(k,41) = b(k,41) - lu(k,1669) * b(k,226) + b(k,40) = b(k,40) - lu(k,1668) * b(k,226) + b(k,39) = b(k,39) - lu(k,1667) * b(k,226) + end do + end subroutine lu_slv09 + subroutine lu_slv10( 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,225) = b(k,225) * lu(k,1652) + b(k,224) = b(k,224) - lu(k,1651) * b(k,225) + b(k,223) = b(k,223) - lu(k,1650) * b(k,225) + b(k,222) = b(k,222) - lu(k,1649) * b(k,225) + b(k,221) = b(k,221) - lu(k,1648) * b(k,225) + b(k,219) = b(k,219) - lu(k,1647) * b(k,225) + b(k,217) = b(k,217) - lu(k,1646) * b(k,225) + b(k,216) = b(k,216) - lu(k,1645) * b(k,225) + b(k,215) = b(k,215) - lu(k,1644) * b(k,225) + b(k,214) = b(k,214) - lu(k,1643) * b(k,225) + b(k,213) = b(k,213) - lu(k,1642) * b(k,225) + b(k,212) = b(k,212) - lu(k,1641) * b(k,225) + b(k,211) = b(k,211) - lu(k,1640) * b(k,225) + b(k,210) = b(k,210) - lu(k,1639) * b(k,225) + b(k,209) = b(k,209) - lu(k,1638) * b(k,225) + b(k,208) = b(k,208) - lu(k,1637) * b(k,225) + b(k,207) = b(k,207) - lu(k,1636) * b(k,225) + b(k,206) = b(k,206) - lu(k,1635) * b(k,225) + b(k,205) = b(k,205) - lu(k,1634) * b(k,225) + b(k,204) = b(k,204) - lu(k,1633) * b(k,225) + b(k,203) = b(k,203) - lu(k,1632) * b(k,225) + b(k,202) = b(k,202) - lu(k,1631) * b(k,225) + b(k,201) = b(k,201) - lu(k,1630) * b(k,225) + b(k,200) = b(k,200) - lu(k,1629) * b(k,225) + b(k,199) = b(k,199) - lu(k,1628) * b(k,225) + b(k,198) = b(k,198) - lu(k,1627) * b(k,225) + b(k,197) = b(k,197) - lu(k,1626) * b(k,225) + b(k,196) = b(k,196) - lu(k,1625) * b(k,225) + b(k,195) = b(k,195) - lu(k,1624) * b(k,225) + b(k,194) = b(k,194) - lu(k,1623) * b(k,225) + b(k,193) = b(k,193) - lu(k,1622) * b(k,225) + b(k,192) = b(k,192) - lu(k,1621) * b(k,225) + b(k,191) = b(k,191) - lu(k,1620) * b(k,225) + b(k,190) = b(k,190) - lu(k,1619) * b(k,225) + b(k,188) = b(k,188) - lu(k,1618) * b(k,225) + b(k,186) = b(k,186) - lu(k,1617) * b(k,225) + b(k,183) = b(k,183) - lu(k,1616) * b(k,225) + b(k,180) = b(k,180) - lu(k,1615) * b(k,225) + b(k,179) = b(k,179) - lu(k,1614) * b(k,225) + b(k,146) = b(k,146) - lu(k,1613) * b(k,225) + b(k,113) = b(k,113) - lu(k,1612) * b(k,225) + b(k,107) = b(k,107) - lu(k,1611) * b(k,225) + b(k,104) = b(k,104) - lu(k,1610) * b(k,225) + b(k,97) = b(k,97) - lu(k,1609) * b(k,225) + b(k,43) = b(k,43) - lu(k,1608) * b(k,225) + b(k,42) = b(k,42) - lu(k,1607) * b(k,225) + b(k,224) = b(k,224) * lu(k,1592) + b(k,223) = b(k,223) - lu(k,1591) * b(k,224) + b(k,222) = b(k,222) - lu(k,1590) * b(k,224) + b(k,221) = b(k,221) - lu(k,1589) * b(k,224) + b(k,220) = b(k,220) - lu(k,1588) * b(k,224) + b(k,219) = b(k,219) - lu(k,1587) * b(k,224) + b(k,187) = b(k,187) - lu(k,1586) * b(k,224) + b(k,186) = b(k,186) - lu(k,1585) * b(k,224) + b(k,175) = b(k,175) - lu(k,1584) * b(k,224) + b(k,109) = b(k,109) - lu(k,1583) * b(k,224) + b(k,86) = b(k,86) - lu(k,1582) * b(k,224) + b(k,74) = b(k,74) - lu(k,1581) * b(k,224) + b(k,54) = b(k,54) - lu(k,1580) * b(k,224) + b(k,223) = b(k,223) * lu(k,1565) + b(k,222) = b(k,222) - lu(k,1564) * b(k,223) + b(k,221) = b(k,221) - lu(k,1563) * b(k,223) + b(k,220) = b(k,220) - lu(k,1562) * b(k,223) + b(k,219) = b(k,219) - lu(k,1561) * b(k,223) + b(k,186) = b(k,186) - lu(k,1560) * b(k,223) + b(k,169) = b(k,169) - lu(k,1559) * b(k,223) + b(k,145) = b(k,145) - lu(k,1558) * b(k,223) + b(k,109) = b(k,109) - lu(k,1557) * b(k,223) + b(k,86) = b(k,86) - lu(k,1556) * b(k,223) + b(k,222) = b(k,222) * lu(k,1542) + b(k,221) = b(k,221) - lu(k,1541) * b(k,222) + b(k,219) = b(k,219) - lu(k,1540) * b(k,222) + b(k,217) = b(k,217) - lu(k,1539) * b(k,222) + b(k,202) = b(k,202) - lu(k,1538) * b(k,222) + b(k,201) = b(k,201) - lu(k,1537) * b(k,222) + b(k,189) = b(k,189) - lu(k,1536) * b(k,222) + b(k,186) = b(k,186) - lu(k,1535) * b(k,222) + b(k,178) = b(k,178) - lu(k,1534) * b(k,222) + b(k,177) = b(k,177) - lu(k,1533) * b(k,222) + b(k,176) = b(k,176) - lu(k,1532) * b(k,222) + b(k,171) = b(k,171) - lu(k,1531) * b(k,222) + b(k,163) = b(k,163) - lu(k,1530) * b(k,222) + b(k,158) = b(k,158) - lu(k,1529) * b(k,222) + b(k,140) = b(k,140) - lu(k,1528) * b(k,222) + b(k,136) = b(k,136) - lu(k,1527) * b(k,222) + b(k,129) = b(k,129) - lu(k,1526) * b(k,222) + b(k,76) = b(k,76) - lu(k,1525) * b(k,222) + b(k,75) = b(k,75) - lu(k,1524) * b(k,222) + b(k,221) = b(k,221) * lu(k,1511) + b(k,217) = b(k,217) - lu(k,1510) * b(k,221) + b(k,201) = b(k,201) - lu(k,1509) * b(k,221) + b(k,174) = b(k,174) - lu(k,1508) * b(k,221) + b(k,220) = b(k,220) * lu(k,1495) + b(k,187) = b(k,187) - lu(k,1494) * b(k,220) + b(k,175) = b(k,175) - lu(k,1493) * b(k,220) + b(k,169) = b(k,169) - lu(k,1492) * b(k,220) + b(k,86) = b(k,86) - lu(k,1491) * b(k,220) + b(k,74) = b(k,74) - lu(k,1490) * b(k,220) + b(k,219) = b(k,219) * lu(k,1476) + b(k,186) = b(k,186) - lu(k,1475) * b(k,219) + b(k,163) = b(k,163) - lu(k,1474) * b(k,219) + b(k,109) = b(k,109) - lu(k,1473) * b(k,219) + b(k,218) = b(k,218) * lu(k,1461) + b(k,184) = b(k,184) - lu(k,1460) * b(k,218) + b(k,99) = b(k,99) - lu(k,1459) * b(k,218) + b(k,217) = b(k,217) * lu(k,1450) + b(k,201) = b(k,201) - lu(k,1449) * b(k,217) + b(k,189) = b(k,189) - lu(k,1448) * b(k,217) + b(k,178) = b(k,178) - lu(k,1447) * b(k,217) + b(k,177) = b(k,177) - lu(k,1446) * b(k,217) + b(k,176) = b(k,176) - lu(k,1445) * b(k,217) + b(k,171) = b(k,171) - lu(k,1444) * b(k,217) + b(k,76) = b(k,76) - lu(k,1443) * b(k,217) + b(k,75) = b(k,75) - lu(k,1442) * b(k,217) + b(k,216) = b(k,216) * lu(k,1428) + b(k,215) = b(k,215) - lu(k,1427) * b(k,216) + b(k,214) = b(k,214) - lu(k,1426) * b(k,216) + b(k,213) = b(k,213) - lu(k,1425) * b(k,216) + b(k,212) = b(k,212) - lu(k,1424) * b(k,216) + b(k,211) = b(k,211) - lu(k,1423) * b(k,216) + b(k,210) = b(k,210) - lu(k,1422) * b(k,216) + b(k,209) = b(k,209) - lu(k,1421) * b(k,216) + b(k,208) = b(k,208) - lu(k,1420) * b(k,216) + b(k,207) = b(k,207) - lu(k,1419) * b(k,216) + b(k,205) = b(k,205) - lu(k,1418) * b(k,216) + b(k,202) = b(k,202) - lu(k,1417) * b(k,216) + b(k,201) = b(k,201) - lu(k,1416) * b(k,216) + b(k,196) = b(k,196) - lu(k,1415) * b(k,216) + b(k,192) = b(k,192) - lu(k,1414) * b(k,216) + b(k,161) = b(k,161) - lu(k,1413) * b(k,216) + b(k,152) = b(k,152) - lu(k,1412) * b(k,216) + b(k,141) = b(k,141) - lu(k,1411) * b(k,216) + b(k,107) = b(k,107) - lu(k,1410) * b(k,216) + b(k,215) = b(k,215) * lu(k,1397) + b(k,210) = b(k,210) - lu(k,1396) * b(k,215) + b(k,205) = b(k,205) - lu(k,1395) * b(k,215) + b(k,161) = b(k,161) - lu(k,1394) * b(k,215) + b(k,152) = b(k,152) - lu(k,1393) * b(k,215) + b(k,151) = b(k,151) - lu(k,1392) * b(k,215) + b(k,214) = b(k,214) * lu(k,1376) + b(k,213) = b(k,213) - lu(k,1375) * b(k,214) + b(k,210) = b(k,210) - lu(k,1374) * b(k,214) + b(k,205) = b(k,205) - lu(k,1373) * b(k,214) + b(k,201) = b(k,201) - lu(k,1372) * b(k,214) + b(k,200) = b(k,200) - lu(k,1371) * b(k,214) + b(k,199) = b(k,199) - lu(k,1370) * b(k,214) + b(k,183) = b(k,183) - lu(k,1369) * b(k,214) + b(k,213) = b(k,213) * lu(k,1356) + b(k,210) = b(k,210) - lu(k,1355) * b(k,213) + b(k,206) = b(k,206) - lu(k,1354) * b(k,213) + b(k,205) = b(k,205) - lu(k,1353) * b(k,213) + b(k,204) = b(k,204) - lu(k,1352) * b(k,213) + b(k,202) = b(k,202) - lu(k,1351) * b(k,213) + b(k,201) = b(k,201) - lu(k,1350) * b(k,213) + b(k,173) = b(k,173) - lu(k,1349) * b(k,213) + b(k,105) = b(k,105) - lu(k,1348) * b(k,213) + b(k,212) = b(k,212) * lu(k,1332) + b(k,210) = b(k,210) - lu(k,1331) * b(k,212) + b(k,209) = b(k,209) - lu(k,1330) * b(k,212) + b(k,207) = b(k,207) - lu(k,1329) * b(k,212) + b(k,206) = b(k,206) - lu(k,1328) * b(k,212) + b(k,205) = b(k,205) - lu(k,1327) * b(k,212) + b(k,204) = b(k,204) - lu(k,1326) * b(k,212) + b(k,202) = b(k,202) - lu(k,1325) * b(k,212) + b(k,201) = b(k,201) - lu(k,1324) * b(k,212) + b(k,192) = b(k,192) - lu(k,1323) * b(k,212) + b(k,182) = b(k,182) - lu(k,1322) * b(k,212) + b(k,180) = b(k,180) - lu(k,1321) * b(k,212) + b(k,173) = b(k,173) - lu(k,1320) * b(k,212) + b(k,162) = b(k,162) - lu(k,1319) * b(k,212) + b(k,149) = b(k,149) - lu(k,1318) * b(k,212) + b(k,144) = b(k,144) - lu(k,1317) * b(k,212) + b(k,107) = b(k,107) - lu(k,1316) * b(k,212) + b(k,84) = b(k,84) - lu(k,1315) * b(k,212) + b(k,211) = b(k,211) * lu(k,1299) + b(k,210) = b(k,210) - lu(k,1298) * b(k,211) + b(k,209) = b(k,209) - lu(k,1297) * b(k,211) + b(k,207) = b(k,207) - lu(k,1296) * b(k,211) + b(k,206) = b(k,206) - lu(k,1295) * b(k,211) + b(k,205) = b(k,205) - lu(k,1294) * b(k,211) + b(k,204) = b(k,204) - lu(k,1293) * b(k,211) + b(k,202) = b(k,202) - lu(k,1292) * b(k,211) + b(k,173) = b(k,173) - lu(k,1291) * b(k,211) + b(k,162) = b(k,162) - lu(k,1290) * b(k,211) + b(k,148) = b(k,148) - lu(k,1289) * b(k,211) + b(k,210) = b(k,210) * lu(k,1281) + b(k,201) = b(k,201) - lu(k,1280) * b(k,210) + b(k,209) = b(k,209) * lu(k,1269) + b(k,201) = b(k,201) - lu(k,1268) * b(k,209) + b(k,183) = b(k,183) - lu(k,1267) * b(k,209) + b(k,208) = b(k,208) * lu(k,1253) + b(k,207) = b(k,207) - lu(k,1252) * b(k,208) + b(k,202) = b(k,202) - lu(k,1251) * b(k,208) + b(k,201) = b(k,201) - lu(k,1250) * b(k,208) + b(k,196) = b(k,196) - lu(k,1249) * b(k,208) + b(k,180) = b(k,180) - lu(k,1248) * b(k,208) + b(k,173) = b(k,173) - lu(k,1247) * b(k,208) + b(k,162) = b(k,162) - lu(k,1246) * b(k,208) + b(k,124) = b(k,124) - lu(k,1245) * b(k,208) + b(k,120) = b(k,120) - lu(k,1244) * b(k,208) + b(k,207) = b(k,207) * lu(k,1233) + b(k,205) = b(k,205) - lu(k,1232) * b(k,207) + b(k,202) = b(k,202) - lu(k,1231) * b(k,207) + b(k,201) = b(k,201) - lu(k,1230) * b(k,207) + b(k,192) = b(k,192) - lu(k,1229) * b(k,207) + b(k,173) = b(k,173) - lu(k,1228) * b(k,207) + b(k,81) = b(k,81) - lu(k,1227) * b(k,207) + end do + end subroutine lu_slv10 + subroutine lu_slv11( 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,206) = b(k,206) * lu(k,1217) + b(k,205) = b(k,205) - lu(k,1216) * b(k,206) + b(k,173) = b(k,173) - lu(k,1215) * b(k,206) + b(k,119) = b(k,119) - lu(k,1214) * b(k,206) + b(k,205) = b(k,205) * lu(k,1208) + b(k,204) = b(k,204) * lu(k,1195) + b(k,202) = b(k,202) - lu(k,1194) * b(k,204) + b(k,201) = b(k,201) - lu(k,1193) * b(k,204) + b(k,200) = b(k,200) - lu(k,1192) * b(k,204) + b(k,195) = b(k,195) - lu(k,1191) * b(k,204) + b(k,87) = b(k,87) - lu(k,1190) * b(k,204) + b(k,203) = b(k,203) * lu(k,1178) + b(k,202) = b(k,202) - lu(k,1177) * b(k,203) + b(k,201) = b(k,201) - lu(k,1176) * b(k,203) + b(k,198) = b(k,198) - lu(k,1175) * b(k,203) + b(k,195) = b(k,195) - lu(k,1174) * b(k,203) + b(k,173) = b(k,173) - lu(k,1173) * b(k,203) + b(k,156) = b(k,156) - lu(k,1172) * b(k,203) + b(k,87) = b(k,87) - lu(k,1171) * b(k,203) + b(k,202) = b(k,202) * lu(k,1166) + b(k,201) = b(k,201) - lu(k,1165) * b(k,202) + b(k,192) = b(k,192) - lu(k,1164) * b(k,202) + b(k,201) = b(k,201) * lu(k,1160) + b(k,200) = b(k,200) * lu(k,1151) + b(k,199) = b(k,199) * lu(k,1133) + b(k,183) = b(k,183) - lu(k,1132) * b(k,199) + b(k,180) = b(k,180) - lu(k,1131) * b(k,199) + b(k,172) = b(k,172) - lu(k,1130) * b(k,199) + b(k,161) = b(k,161) - lu(k,1129) * b(k,199) + b(k,198) = b(k,198) * lu(k,1119) + b(k,195) = b(k,195) - lu(k,1118) * b(k,198) + b(k,197) = b(k,197) * lu(k,1106) + b(k,194) = b(k,194) - lu(k,1105) * b(k,197) + b(k,173) = b(k,173) - lu(k,1104) * b(k,197) + b(k,153) = b(k,153) - lu(k,1103) * b(k,197) + b(k,118) = b(k,118) - lu(k,1102) * b(k,197) + b(k,196) = b(k,196) * lu(k,1090) + b(k,192) = b(k,192) - lu(k,1089) * b(k,196) + b(k,182) = b(k,182) - lu(k,1088) * b(k,196) + b(k,180) = b(k,180) - lu(k,1087) * b(k,196) + b(k,149) = b(k,149) - lu(k,1086) * b(k,196) + b(k,195) = b(k,195) * lu(k,1080) + b(k,194) = b(k,194) * lu(k,1072) + b(k,193) = b(k,193) * lu(k,1062) + b(k,173) = b(k,173) - lu(k,1061) * b(k,193) + b(k,153) = b(k,153) - lu(k,1060) * b(k,193) + b(k,134) = b(k,134) - lu(k,1059) * b(k,193) + b(k,192) = b(k,192) * lu(k,1054) + b(k,39) = b(k,39) - lu(k,1053) * b(k,192) + b(k,191) = b(k,191) * lu(k,1042) + b(k,181) = b(k,181) - lu(k,1041) * b(k,191) + b(k,160) = b(k,160) - lu(k,1040) * b(k,191) + b(k,159) = b(k,159) - lu(k,1039) * b(k,191) + b(k,155) = b(k,155) - lu(k,1038) * b(k,191) + b(k,138) = b(k,138) - lu(k,1037) * b(k,191) + b(k,190) = b(k,190) * lu(k,1018) + b(k,183) = b(k,183) - lu(k,1017) * b(k,190) + b(k,116) = b(k,116) - lu(k,1016) * b(k,190) + b(k,85) = b(k,85) - lu(k,1015) * b(k,190) + b(k,51) = b(k,51) - lu(k,1014) * b(k,190) + b(k,43) = b(k,43) - lu(k,1013) * b(k,190) + b(k,42) = b(k,42) - lu(k,1012) * b(k,190) + b(k,41) = b(k,41) - lu(k,1011) * b(k,190) + b(k,40) = b(k,40) - lu(k,1010) * b(k,190) + b(k,39) = b(k,39) - lu(k,1009) * b(k,190) + b(k,189) = b(k,189) * lu(k,999) + b(k,178) = b(k,178) - lu(k,998) * b(k,189) + b(k,177) = b(k,177) - lu(k,997) * b(k,189) + b(k,176) = b(k,176) - lu(k,996) * b(k,189) + b(k,171) = b(k,171) - lu(k,995) * b(k,189) + b(k,136) = b(k,136) - lu(k,994) * b(k,189) + b(k,93) = b(k,93) - lu(k,993) * b(k,189) + b(k,188) = b(k,188) * lu(k,974) + b(k,183) = b(k,183) - lu(k,973) * b(k,188) + b(k,116) = b(k,116) - lu(k,972) * b(k,188) + b(k,85) = b(k,85) - lu(k,971) * b(k,188) + b(k,46) = b(k,46) - lu(k,970) * b(k,188) + b(k,43) = b(k,43) - lu(k,969) * b(k,188) + b(k,42) = b(k,42) - lu(k,968) * b(k,188) + b(k,41) = b(k,41) - lu(k,967) * b(k,188) + b(k,40) = b(k,40) - lu(k,966) * b(k,188) + b(k,39) = b(k,39) - lu(k,965) * b(k,188) + b(k,187) = b(k,187) * lu(k,955) + b(k,175) = b(k,175) - lu(k,954) * b(k,187) + b(k,74) = b(k,74) - lu(k,953) * b(k,187) + b(k,186) = b(k,186) * lu(k,947) + b(k,94) = b(k,94) - lu(k,946) * b(k,186) + b(k,185) = b(k,185) * lu(k,935) + b(k,121) = b(k,121) - lu(k,934) * b(k,185) + b(k,184) = b(k,184) * lu(k,925) + b(k,99) = b(k,99) - lu(k,924) * b(k,184) + b(k,183) = b(k,183) * lu(k,919) + b(k,182) = b(k,182) * lu(k,910) + b(k,181) = b(k,181) * lu(k,901) + b(k,173) = b(k,173) - lu(k,900) * b(k,181) + b(k,112) = b(k,112) - lu(k,899) * b(k,181) + b(k,95) = b(k,95) - lu(k,898) * b(k,181) + b(k,180) = b(k,180) * lu(k,892) + b(k,179) = b(k,179) * lu(k,876) + b(k,48) = b(k,48) - lu(k,875) * b(k,179) + b(k,43) = b(k,43) - lu(k,874) * b(k,179) + b(k,42) = b(k,42) - lu(k,873) * b(k,179) + b(k,178) = b(k,178) * lu(k,865) + b(k,177) = b(k,177) - lu(k,864) * b(k,178) + b(k,176) = b(k,176) - lu(k,863) * b(k,178) + b(k,171) = b(k,171) - lu(k,862) * b(k,178) + b(k,158) = b(k,158) - lu(k,861) * b(k,178) + b(k,140) = b(k,140) - lu(k,860) * b(k,178) + b(k,177) = b(k,177) * lu(k,853) + b(k,176) = b(k,176) - lu(k,852) * b(k,177) + b(k,176) = b(k,176) * lu(k,845) + b(k,140) = b(k,140) - lu(k,844) * b(k,176) + b(k,175) = b(k,175) * lu(k,837) + b(k,74) = b(k,74) - lu(k,836) * b(k,175) + b(k,174) = b(k,174) * lu(k,828) + b(k,173) = b(k,173) * lu(k,824) + b(k,172) = b(k,172) * lu(k,814) + b(k,142) = b(k,142) - lu(k,813) * b(k,172) + b(k,171) = b(k,171) * lu(k,805) + b(k,170) = b(k,170) * lu(k,797) + b(k,129) = b(k,129) - lu(k,796) * b(k,170) + b(k,63) = b(k,63) - lu(k,795) * b(k,170) + b(k,169) = b(k,169) * lu(k,787) + b(k,86) = b(k,86) - lu(k,786) * b(k,169) + b(k,168) = b(k,168) * lu(k,778) + b(k,167) = b(k,167) * lu(k,767) + b(k,165) = b(k,165) - lu(k,766) * b(k,167) + b(k,164) = b(k,164) - lu(k,765) * b(k,167) + b(k,149) = b(k,149) - lu(k,764) * b(k,167) + b(k,130) = b(k,130) - lu(k,763) * b(k,167) + b(k,108) = b(k,108) - lu(k,762) * b(k,167) + b(k,98) = b(k,98) - lu(k,761) * b(k,167) + b(k,166) = b(k,166) * lu(k,751) + b(k,165) = b(k,165) - lu(k,750) * b(k,166) + b(k,157) = b(k,157) - lu(k,749) * b(k,166) + b(k,149) = b(k,149) - lu(k,748) * b(k,166) + b(k,130) = b(k,130) - lu(k,747) * b(k,166) + b(k,98) = b(k,98) - lu(k,746) * b(k,166) + b(k,165) = b(k,165) * lu(k,740) + b(k,164) = b(k,164) * lu(k,729) + b(k,149) = b(k,149) - lu(k,728) * b(k,164) + b(k,130) = b(k,130) - lu(k,727) * b(k,164) + b(k,108) = b(k,108) - lu(k,726) * b(k,164) + b(k,98) = b(k,98) - lu(k,725) * b(k,164) + b(k,163) = b(k,163) * lu(k,718) + b(k,162) = b(k,162) * lu(k,711) + b(k,65) = b(k,65) - lu(k,710) * b(k,162) + b(k,161) = b(k,161) * lu(k,705) + b(k,160) = b(k,160) * lu(k,698) + b(k,106) = b(k,106) - lu(k,697) * b(k,160) + b(k,159) = b(k,159) * lu(k,687) + b(k,138) = b(k,138) - lu(k,686) * b(k,159) + b(k,158) = b(k,158) * lu(k,676) + b(k,140) = b(k,140) - lu(k,675) * b(k,158) + b(k,157) = b(k,157) * lu(k,665) + b(k,149) = b(k,149) - lu(k,664) * b(k,157) + b(k,130) = b(k,130) - lu(k,663) * b(k,157) + b(k,98) = b(k,98) - lu(k,662) * b(k,157) + b(k,156) = b(k,156) * lu(k,652) + b(k,155) = b(k,155) * lu(k,642) + b(k,138) = b(k,138) - lu(k,641) * b(k,155) + b(k,154) = b(k,154) * lu(k,635) + b(k,131) = b(k,131) - lu(k,634) * b(k,154) + b(k,96) = b(k,96) - lu(k,633) * b(k,154) + b(k,153) = b(k,153) * lu(k,627) + b(k,152) = b(k,152) * lu(k,620) + b(k,151) = b(k,151) * lu(k,611) + b(k,150) = b(k,150) * lu(k,602) + b(k,149) = b(k,149) * lu(k,598) + b(k,148) = b(k,148) * lu(k,589) + b(k,147) = b(k,147) * lu(k,582) + b(k,146) = b(k,146) * lu(k,574) + b(k,145) = b(k,145) * lu(k,566) + b(k,144) = b(k,144) * lu(k,558) + b(k,143) = b(k,143) * lu(k,550) + b(k,142) = b(k,142) * lu(k,542) + b(k,141) = b(k,141) * lu(k,534) + b(k,140) = b(k,140) * lu(k,529) + b(k,139) = b(k,139) * lu(k,523) + b(k,66) = b(k,66) - lu(k,522) * b(k,139) + b(k,138) = b(k,138) * lu(k,517) + b(k,137) = b(k,137) * lu(k,510) + b(k,123) = b(k,123) - lu(k,509) * b(k,137) + b(k,136) = b(k,136) * lu(k,502) + b(k,135) = b(k,135) * lu(k,495) + b(k,130) = b(k,130) - lu(k,494) * b(k,135) + b(k,122) = b(k,122) - lu(k,493) * b(k,135) + b(k,134) = b(k,134) * lu(k,486) + b(k,133) = b(k,133) * lu(k,479) + b(k,132) = b(k,132) * lu(k,472) + b(k,131) = b(k,131) * lu(k,468) + b(k,130) = b(k,130) * lu(k,465) + b(k,129) = b(k,129) * lu(k,460) + b(k,128) = b(k,128) * lu(k,454) + b(k,127) = b(k,127) * lu(k,448) + b(k,110) = b(k,110) - lu(k,447) * b(k,127) + b(k,126) = b(k,126) * lu(k,441) + b(k,125) = b(k,125) * lu(k,435) + b(k,111) = b(k,111) - lu(k,434) * b(k,125) + b(k,88) = b(k,88) - lu(k,433) * b(k,125) + b(k,124) = b(k,124) * lu(k,427) + end do + end subroutine lu_slv11 + subroutine lu_slv12( 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,421) + b(k,122) = b(k,122) * lu(k,415) + b(k,121) = b(k,121) * lu(k,409) + b(k,120) = b(k,120) * lu(k,403) + b(k,119) = b(k,119) * lu(k,397) + b(k,118) = b(k,118) * lu(k,391) + b(k,117) = b(k,117) * lu(k,385) + b(k,116) = b(k,116) * lu(k,379) + b(k,115) = b(k,115) * lu(k,371) + b(k,114) = b(k,114) * lu(k,363) + b(k,113) = b(k,113) * lu(k,355) + b(k,112) = b(k,112) * lu(k,350) + b(k,111) = b(k,111) * lu(k,345) + b(k,88) = b(k,88) - lu(k,344) * b(k,111) + b(k,110) = b(k,110) * lu(k,339) + b(k,109) = b(k,109) * lu(k,334) + b(k,108) = b(k,108) * lu(k,329) + b(k,107) = b(k,107) * lu(k,326) + b(k,106) = b(k,106) * lu(k,321) + b(k,105) = b(k,105) * lu(k,316) + b(k,104) = b(k,104) * lu(k,310) + b(k,103) = b(k,103) * lu(k,304) + b(k,102) = b(k,102) * lu(k,298) + b(k,101) = b(k,101) * lu(k,292) + b(k,89) = b(k,89) - lu(k,291) * b(k,101) + b(k,100) = b(k,100) * lu(k,285) + b(k,99) = b(k,99) * lu(k,282) + b(k,98) = b(k,98) * lu(k,279) + b(k,97) = b(k,97) * lu(k,273) + b(k,96) = b(k,96) * lu(k,269) + b(k,95) = b(k,95) * lu(k,265) + b(k,94) = b(k,94) * lu(k,261) + b(k,64) = b(k,64) - lu(k,260) * b(k,94) + b(k,93) = b(k,93) * lu(k,256) + b(k,92) = b(k,92) * lu(k,251) + b(k,89) = b(k,89) - lu(k,250) * b(k,92) + b(k,91) = b(k,91) * lu(k,246) + b(k,90) = b(k,90) * lu(k,241) + b(k,89) = b(k,89) * lu(k,238) + b(k,88) = b(k,88) * lu(k,235) + b(k,87) = b(k,87) * lu(k,232) + b(k,86) = b(k,86) * lu(k,229) + b(k,85) = b(k,85) * lu(k,226) + b(k,84) = b(k,84) * lu(k,221) + b(k,83) = b(k,83) * lu(k,216) + b(k,82) = b(k,82) * lu(k,208) + b(k,80) = b(k,80) - lu(k,207) * b(k,82) + b(k,53) = b(k,53) - lu(k,206) * b(k,82) + b(k,81) = b(k,81) * lu(k,203) + b(k,80) = b(k,80) * lu(k,199) + b(k,79) = b(k,79) * lu(k,194) + b(k,78) = b(k,78) * lu(k,187) + b(k,52) = b(k,52) - lu(k,186) * b(k,78) + b(k,77) = b(k,77) * lu(k,182) + b(k,76) = b(k,76) * lu(k,180) + b(k,75) = b(k,75) - lu(k,179) * b(k,76) + b(k,75) = b(k,75) * lu(k,177) + b(k,74) = b(k,74) * lu(k,175) + b(k,73) = b(k,73) * lu(k,170) + b(k,72) = b(k,72) * lu(k,166) + b(k,71) = b(k,71) * lu(k,160) + b(k,47) = b(k,47) - lu(k,159) * b(k,71) + b(k,70) = b(k,70) * lu(k,154) + b(k,69) = b(k,69) * lu(k,149) + b(k,68) = b(k,68) * lu(k,144) + b(k,67) = b(k,67) * lu(k,139) + b(k,66) = b(k,66) * lu(k,136) + b(k,65) = b(k,65) * lu(k,133) + b(k,64) = b(k,64) * lu(k,130) + b(k,63) = b(k,63) * lu(k,127) + b(k,62) = b(k,62) * lu(k,123) + b(k,61) = b(k,61) * lu(k,119) + b(k,60) = b(k,60) * lu(k,115) + b(k,59) = b(k,59) * lu(k,111) + b(k,58) = b(k,58) * lu(k,107) + b(k,57) = b(k,57) * lu(k,104) + b(k,56) = b(k,56) * lu(k,101) + b(k,55) = b(k,55) * lu(k,98) + b(k,54) = b(k,54) * lu(k,95) + b(k,53) = b(k,53) * lu(k,94) + b(k,43) = b(k,43) - lu(k,93) * b(k,53) + b(k,42) = b(k,42) - lu(k,92) * b(k,53) + b(k,41) = b(k,41) - lu(k,91) * b(k,53) + b(k,40) = b(k,40) - lu(k,90) * b(k,53) + b(k,39) = b(k,39) - lu(k,89) * b(k,53) + b(k,52) = b(k,52) * lu(k,88) + b(k,43) = b(k,43) - lu(k,87) * b(k,52) + b(k,42) = b(k,42) - lu(k,86) * b(k,52) + b(k,41) = b(k,41) - lu(k,85) * b(k,52) + b(k,40) = b(k,40) - lu(k,84) * b(k,52) + b(k,39) = b(k,39) - lu(k,83) * b(k,52) + b(k,51) = b(k,51) * lu(k,82) + b(k,43) = b(k,43) - lu(k,81) * b(k,51) + b(k,42) = b(k,42) - lu(k,80) * b(k,51) + b(k,41) = b(k,41) - lu(k,79) * b(k,51) + b(k,40) = b(k,40) - lu(k,78) * b(k,51) + b(k,39) = b(k,39) - lu(k,77) * b(k,51) + b(k,50) = b(k,50) * lu(k,76) + b(k,49) = b(k,49) - lu(k,75) * b(k,50) + b(k,49) = b(k,49) * lu(k,74) + b(k,43) = b(k,43) - lu(k,73) * b(k,49) + b(k,42) = b(k,42) - lu(k,72) * b(k,49) + b(k,41) = b(k,41) - lu(k,71) * b(k,49) + b(k,40) = b(k,40) - lu(k,70) * b(k,49) + b(k,39) = b(k,39) - lu(k,69) * b(k,49) + b(k,48) = b(k,48) * lu(k,68) + b(k,43) = b(k,43) - lu(k,67) * b(k,48) + b(k,42) = b(k,42) - lu(k,66) * b(k,48) + b(k,41) = b(k,41) - lu(k,65) * b(k,48) + b(k,40) = b(k,40) - lu(k,64) * b(k,48) + b(k,39) = b(k,39) - lu(k,63) * b(k,48) + b(k,47) = b(k,47) * lu(k,62) + b(k,43) = b(k,43) - lu(k,61) * b(k,47) + b(k,42) = b(k,42) - lu(k,60) * b(k,47) + b(k,41) = b(k,41) - lu(k,59) * b(k,47) + b(k,40) = b(k,40) - lu(k,58) * b(k,47) + b(k,39) = b(k,39) - lu(k,57) * b(k,47) + b(k,46) = b(k,46) * lu(k,56) + b(k,43) = b(k,43) - lu(k,55) * b(k,46) + b(k,42) = b(k,42) - lu(k,54) * b(k,46) + b(k,41) = b(k,41) - lu(k,53) * b(k,46) + b(k,40) = b(k,40) - lu(k,52) * b(k,46) + b(k,39) = b(k,39) - lu(k,51) * b(k,46) + b(k,45) = b(k,45) * lu(k,50) + b(k,43) = b(k,43) - lu(k,49) * b(k,45) + b(k,42) = b(k,42) - lu(k,48) * b(k,45) + b(k,41) = b(k,41) - lu(k,47) * b(k,45) + b(k,40) = b(k,40) - lu(k,46) * b(k,45) + b(k,39) = b(k,39) - lu(k,45) * b(k,45) + b(k,44) = b(k,44) * lu(k,44) + b(k,43) = b(k,43) * lu(k,43) + b(k,42) = b(k,42) * lu(k,42) + b(k,41) = b(k,41) * lu(k,41) + b(k,40) = b(k,40) * lu(k,40) + b(k,39) = b(k,39) * lu(k,39) + b(k,38) = b(k,38) * lu(k,38) + b(k,37) = b(k,37) * lu(k,37) + b(k,36) = b(k,36) * lu(k,36) + b(k,35) = b(k,35) * lu(k,35) + b(k,34) = b(k,34) * lu(k,34) + b(k,33) = b(k,33) * lu(k,33) + b(k,32) = b(k,32) * lu(k,32) + b(k,31) = b(k,31) * lu(k,31) + b(k,30) = b(k,30) * lu(k,30) + b(k,29) = b(k,29) * lu(k,29) + b(k,28) = b(k,28) * lu(k,28) + b(k,27) = b(k,27) * lu(k,27) + b(k,26) = b(k,26) * lu(k,26) + b(k,25) = b(k,25) * lu(k,25) + b(k,24) = b(k,24) * lu(k,24) + b(k,23) = b(k,23) * lu(k,23) + b(k,22) = b(k,22) * lu(k,22) + b(k,21) = b(k,21) * lu(k,21) + b(k,20) = b(k,20) * lu(k,20) + b(k,19) = b(k,19) * lu(k,19) + b(k,18) = b(k,18) * lu(k,18) + b(k,17) = b(k,17) * lu(k,17) + b(k,16) = b(k,16) * lu(k,16) + b(k,15) = b(k,15) * lu(k,15) + b(k,14) = b(k,14) * lu(k,14) + b(k,13) = b(k,13) * lu(k,13) + b(k,12) = b(k,12) * lu(k,12) + b(k,11) = b(k,11) * lu(k,11) + b(k,10) = b(k,10) * lu(k,10) + 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_slv12 + 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 ) + call lu_slv09( avec_len, lu, b ) + call lu_slv10( avec_len, lu, b ) + call lu_slv11( avec_len, lu, b ) + call lu_slv12( avec_len, lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/mo_nln_matrix.F90 new file mode 100644 index 0000000000..607ccaad92 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/mo_nln_matrix.F90 @@ -0,0 +1,3963 @@ + 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,642) = -(rxt(k,396)*y(k,228)) + mat(k,1753) = -rxt(k,396)*y(k,1) + mat(k,1865) = rxt(k,399)*y(k,192) + mat(k,1038) = rxt(k,399)*y(k,124) + mat(k,687) = -(rxt(k,400)*y(k,228)) + mat(k,1756) = -rxt(k,400)*y(k,2) + mat(k,2307) = rxt(k,397)*y(k,192) + mat(k,1039) = rxt(k,397)*y(k,90) + mat(k,974) = -(rxt(k,479)*y(k,126) + rxt(k,480)*y(k,136) + rxt(k,481) & + *y(k,228)) + mat(k,1618) = -rxt(k,479)*y(k,6) + mat(k,2192) = -rxt(k,480)*y(k,6) + mat(k,1780) = -rxt(k,481)*y(k,6) + mat(k,160) = -(rxt(k,438)*y(k,228)) + mat(k,1685) = -rxt(k,438)*y(k,7) + mat(k,415) = -(rxt(k,441)*y(k,228)) + mat(k,1725) = -rxt(k,441)*y(k,8) + mat(k,2287) = rxt(k,439)*y(k,194) + mat(k,493) = rxt(k,439)*y(k,90) + mat(k,161) = .120_r8*rxt(k,438)*y(k,228) + mat(k,1686) = .120_r8*rxt(k,438)*y(k,7) + mat(k,972) = .100_r8*rxt(k,480)*y(k,136) + mat(k,1016) = .100_r8*rxt(k,483)*y(k,136) + mat(k,2182) = .100_r8*rxt(k,480)*y(k,6) + .100_r8*rxt(k,483)*y(k,110) + mat(k,1853) = .500_r8*rxt(k,440)*y(k,194) + .200_r8*rxt(k,467)*y(k,235) & + + .060_r8*rxt(k,473)*y(k,238) + mat(k,494) = .500_r8*rxt(k,440)*y(k,124) + mat(k,747) = .200_r8*rxt(k,467)*y(k,124) + mat(k,763) = .060_r8*rxt(k,473)*y(k,124) + mat(k,1846) = .200_r8*rxt(k,467)*y(k,235) + .200_r8*rxt(k,473)*y(k,238) + mat(k,746) = .200_r8*rxt(k,467)*y(k,124) + mat(k,761) = .200_r8*rxt(k,473)*y(k,124) + mat(k,1862) = .200_r8*rxt(k,467)*y(k,235) + .150_r8*rxt(k,473)*y(k,238) + mat(k,748) = .200_r8*rxt(k,467)*y(k,124) + mat(k,764) = .150_r8*rxt(k,473)*y(k,124) + mat(k,1848) = .210_r8*rxt(k,473)*y(k,238) + mat(k,762) = .210_r8*rxt(k,473)*y(k,124) + mat(k,226) = -(rxt(k,401)*y(k,228)) + mat(k,1696) = -rxt(k,401)*y(k,15) + mat(k,971) = .050_r8*rxt(k,480)*y(k,136) + mat(k,1015) = .050_r8*rxt(k,483)*y(k,136) + mat(k,2181) = .050_r8*rxt(k,480)*y(k,6) + .050_r8*rxt(k,483)*y(k,110) + mat(k,355) = -(rxt(k,367)*y(k,126) + rxt(k,368)*y(k,228)) + mat(k,1612) = -rxt(k,367)*y(k,16) + mat(k,1717) = -rxt(k,368)*y(k,16) + mat(k,1511) = -(rxt(k,250)*y(k,42) + rxt(k,251)*y(k,90) + rxt(k,252)*y(k,136)) + mat(k,1979) = -rxt(k,250)*y(k,17) + mat(k,2352) = -rxt(k,251)*y(k,17) + mat(k,2219) = -rxt(k,252)*y(k,17) + mat(k,1563) = 4.000_r8*rxt(k,253)*y(k,19) + (rxt(k,254)+rxt(k,255))*y(k,59) & + + rxt(k,258)*y(k,124) + rxt(k,261)*y(k,134) + rxt(k,509) & + *y(k,152) + rxt(k,262)*y(k,228) + mat(k,141) = rxt(k,240)*y(k,224) + mat(k,147) = rxt(k,266)*y(k,224) + mat(k,481) = 2.000_r8*rxt(k,277)*y(k,56) + 2.000_r8*rxt(k,289)*y(k,224) & + + 2.000_r8*rxt(k,278)*y(k,228) + mat(k,604) = rxt(k,279)*y(k,56) + rxt(k,290)*y(k,224) + rxt(k,280)*y(k,228) + mat(k,387) = 3.000_r8*rxt(k,284)*y(k,56) + 3.000_r8*rxt(k,267)*y(k,224) & + + 3.000_r8*rxt(k,285)*y(k,228) + mat(k,2155) = 2.000_r8*rxt(k,277)*y(k,41) + rxt(k,279)*y(k,43) & + + 3.000_r8*rxt(k,284)*y(k,55) + mat(k,1589) = (rxt(k,254)+rxt(k,255))*y(k,19) + mat(k,109) = 2.000_r8*rxt(k,268)*y(k,224) + mat(k,829) = rxt(k,263)*y(k,134) + rxt(k,269)*y(k,224) + rxt(k,264)*y(k,228) + mat(k,1908) = rxt(k,258)*y(k,19) + mat(k,2088) = rxt(k,261)*y(k,19) + rxt(k,263)*y(k,81) + mat(k,1477) = rxt(k,509)*y(k,19) + mat(k,2022) = rxt(k,240)*y(k,34) + rxt(k,266)*y(k,35) + 2.000_r8*rxt(k,289) & + *y(k,41) + rxt(k,290)*y(k,43) + 3.000_r8*rxt(k,267)*y(k,55) & + + 2.000_r8*rxt(k,268)*y(k,78) + rxt(k,269)*y(k,81) + mat(k,1813) = rxt(k,262)*y(k,19) + 2.000_r8*rxt(k,278)*y(k,41) + rxt(k,280) & + *y(k,43) + 3.000_r8*rxt(k,285)*y(k,55) + rxt(k,264)*y(k,81) + mat(k,1556) = rxt(k,256)*y(k,59) + mat(k,1582) = rxt(k,256)*y(k,19) + mat(k,1491) = (rxt(k,570)+rxt(k,575))*y(k,92) + mat(k,786) = (rxt(k,570)+rxt(k,575))*y(k,85) + mat(k,1565) = -(4._r8*rxt(k,253)*y(k,19) + (rxt(k,254) + rxt(k,255) + rxt(k,256) & + ) * y(k,59) + rxt(k,257)*y(k,90) + rxt(k,258)*y(k,124) + rxt(k,259) & + *y(k,125) + rxt(k,261)*y(k,134) + rxt(k,262)*y(k,228) + rxt(k,509) & + *y(k,152)) + mat(k,1591) = -(rxt(k,254) + rxt(k,255) + rxt(k,256)) * y(k,19) + mat(k,2354) = -rxt(k,257)*y(k,19) + mat(k,1910) = -rxt(k,258)*y(k,19) + mat(k,1955) = -rxt(k,259)*y(k,19) + mat(k,2090) = -rxt(k,261)*y(k,19) + mat(k,1815) = -rxt(k,262)*y(k,19) + mat(k,1479) = -rxt(k,509)*y(k,19) + mat(k,1513) = rxt(k,252)*y(k,136) + mat(k,569) = rxt(k,260)*y(k,134) + mat(k,830) = rxt(k,270)*y(k,224) + mat(k,790) = rxt(k,265)*y(k,134) + mat(k,2090) = mat(k,2090) + rxt(k,260)*y(k,20) + rxt(k,265)*y(k,92) + mat(k,2221) = rxt(k,252)*y(k,17) + mat(k,2024) = rxt(k,270)*y(k,81) + mat(k,566) = -(rxt(k,260)*y(k,134)) + mat(k,2069) = -rxt(k,260)*y(k,20) + mat(k,1558) = rxt(k,259)*y(k,125) + mat(k,1934) = rxt(k,259)*y(k,19) + mat(k,235) = -(rxt(k,442)*y(k,228)) + mat(k,1698) = -rxt(k,442)*y(k,22) + mat(k,1845) = rxt(k,445)*y(k,196) + mat(k,433) = rxt(k,445)*y(k,124) + mat(k,345) = -(rxt(k,444)*y(k,228)) + mat(k,1715) = -rxt(k,444)*y(k,23) + mat(k,2281) = rxt(k,443)*y(k,196) + mat(k,434) = rxt(k,443)*y(k,90) + mat(k,285) = -(rxt(k,315)*y(k,56) + rxt(k,316)*y(k,228)) + mat(k,2129) = -rxt(k,315)*y(k,24) + mat(k,1706) = -rxt(k,316)*y(k,24) + mat(k,550) = -(rxt(k,317)*y(k,56) + rxt(k,318)*y(k,136) + rxt(k,343)*y(k,228)) + mat(k,2135) = -rxt(k,317)*y(k,25) + mat(k,2184) = -rxt(k,318)*y(k,25) + mat(k,1742) = -rxt(k,343)*y(k,25) + mat(k,265) = -(rxt(k,323)*y(k,228)) + mat(k,1704) = -rxt(k,323)*y(k,26) + mat(k,898) = .800_r8*rxt(k,319)*y(k,197) + .200_r8*rxt(k,320)*y(k,201) + mat(k,2371) = .200_r8*rxt(k,320)*y(k,197) + mat(k,350) = -(rxt(k,324)*y(k,228)) + mat(k,1716) = -rxt(k,324)*y(k,27) + mat(k,2282) = rxt(k,321)*y(k,197) + mat(k,899) = rxt(k,321)*y(k,90) + mat(k,298) = -(rxt(k,325)*y(k,56) + rxt(k,326)*y(k,228)) + mat(k,2130) = -rxt(k,325)*y(k,28) + mat(k,1708) = -rxt(k,326)*y(k,28) + mat(k,1133) = -(rxt(k,346)*y(k,126) + rxt(k,347)*y(k,136) + rxt(k,365) & + *y(k,228)) + mat(k,1628) = -rxt(k,346)*y(k,29) + mat(k,2201) = -rxt(k,347)*y(k,29) + mat(k,1791) = -rxt(k,365)*y(k,29) + mat(k,878) = .130_r8*rxt(k,425)*y(k,136) + mat(k,2201) = mat(k,2201) + .130_r8*rxt(k,425)*y(k,99) + mat(k,409) = -(rxt(k,351)*y(k,228)) + mat(k,1724) = -rxt(k,351)*y(k,30) + mat(k,2286) = rxt(k,349)*y(k,198) + mat(k,934) = rxt(k,349)*y(k,90) + mat(k,304) = -(rxt(k,352)*y(k,228) + rxt(k,355)*y(k,56)) + mat(k,1709) = -rxt(k,352)*y(k,31) + mat(k,2131) = -rxt(k,355)*y(k,31) + mat(k,269) = -(rxt(k,448)*y(k,228)) + mat(k,1705) = -rxt(k,448)*y(k,32) + mat(k,2277) = rxt(k,446)*y(k,199) + mat(k,633) = rxt(k,446)*y(k,90) + mat(k,101) = -(rxt(k,239)*y(k,224)) + mat(k,1998) = -rxt(k,239)*y(k,33) + mat(k,139) = -(rxt(k,240)*y(k,224)) + mat(k,2003) = -rxt(k,240)*y(k,34) + mat(k,144) = -(rxt(k,266)*y(k,224)) + mat(k,2004) = -rxt(k,266)*y(k,35) + mat(k,111) = -(rxt(k,241)*y(k,224)) + mat(k,2000) = -rxt(k,241)*y(k,36) + mat(k,149) = -(rxt(k,242)*y(k,224)) + mat(k,2005) = -rxt(k,242)*y(k,37) + mat(k,115) = -(rxt(k,243)*y(k,224)) + mat(k,2001) = -rxt(k,243)*y(k,38) + mat(k,154) = -(rxt(k,244)*y(k,224)) + mat(k,2006) = -rxt(k,244)*y(k,39) + mat(k,119) = -(rxt(k,245)*y(k,224)) + mat(k,2002) = -rxt(k,245)*y(k,40) + mat(k,479) = -(rxt(k,277)*y(k,56) + rxt(k,278)*y(k,228) + rxt(k,289)*y(k,224)) + mat(k,2134) = -rxt(k,277)*y(k,41) + mat(k,1734) = -rxt(k,278)*y(k,41) + mat(k,2016) = -rxt(k,289)*y(k,41) + mat(k,1987) = -(rxt(k,214)*y(k,56) + rxt(k,250)*y(k,17) + rxt(k,294)*y(k,90) & + + rxt(k,295)*y(k,126) + rxt(k,296)*y(k,134) + rxt(k,297) & + *y(k,228)) + mat(k,2163) = -rxt(k,214)*y(k,42) + mat(k,1517) = -rxt(k,250)*y(k,42) + mat(k,2360) = -rxt(k,294)*y(k,42) + mat(k,1656) = -rxt(k,295)*y(k,42) + mat(k,2096) = -rxt(k,296)*y(k,42) + mat(k,1821) = -rxt(k,297)*y(k,42) + mat(k,650) = .400_r8*rxt(k,396)*y(k,228) + mat(k,989) = .340_r8*rxt(k,480)*y(k,136) + mat(k,362) = .500_r8*rxt(k,367)*y(k,126) + mat(k,555) = rxt(k,318)*y(k,136) + mat(k,1145) = .500_r8*rxt(k,347)*y(k,136) + mat(k,624) = .500_r8*rxt(k,335)*y(k,228) + mat(k,826) = rxt(k,302)*y(k,228) + mat(k,456) = .300_r8*rxt(k,303)*y(k,228) + mat(k,2252) = (rxt(k,311)+rxt(k,312))*y(k,224) + mat(k,1597) = rxt(k,221)*y(k,201) + mat(k,1169) = .800_r8*rxt(k,340)*y(k,228) + mat(k,2360) = mat(k,2360) + .450_r8*rxt(k,383)*y(k,215) + .150_r8*rxt(k,362) & + *y(k,232) + mat(k,888) = .910_r8*rxt(k,425)*y(k,136) + mat(k,595) = .300_r8*rxt(k,416)*y(k,228) + mat(k,1276) = .120_r8*rxt(k,378)*y(k,136) + mat(k,618) = .500_r8*rxt(k,391)*y(k,228) + mat(k,1033) = .340_r8*rxt(k,483)*y(k,136) + mat(k,1385) = .600_r8*rxt(k,392)*y(k,136) + mat(k,1916) = .100_r8*rxt(k,398)*y(k,192) + rxt(k,301)*y(k,201) & + + .500_r8*rxt(k,369)*y(k,204) + .500_r8*rxt(k,337)*y(k,206) & + + .920_r8*rxt(k,408)*y(k,208) + .250_r8*rxt(k,376)*y(k,213) & + + rxt(k,385)*y(k,215) + rxt(k,359)*y(k,231) + rxt(k,363) & + *y(k,232) + .340_r8*rxt(k,492)*y(k,233) + .320_r8*rxt(k,497) & + *y(k,234) + .250_r8*rxt(k,433)*y(k,237) + mat(k,1656) = mat(k,1656) + .500_r8*rxt(k,367)*y(k,16) + rxt(k,409)*y(k,208) & + + .250_r8*rxt(k,375)*y(k,213) + rxt(k,386)*y(k,215) + mat(k,2227) = .340_r8*rxt(k,480)*y(k,6) + rxt(k,318)*y(k,25) & + + .500_r8*rxt(k,347)*y(k,29) + .910_r8*rxt(k,425)*y(k,99) & + + .120_r8*rxt(k,378)*y(k,105) + .340_r8*rxt(k,483)*y(k,110) & + + .600_r8*rxt(k,392)*y(k,111) + mat(k,540) = rxt(k,342)*y(k,228) + mat(k,1125) = .680_r8*rxt(k,501)*y(k,228) + mat(k,1050) = .100_r8*rxt(k,398)*y(k,124) + mat(k,907) = .700_r8*rxt(k,320)*y(k,201) + mat(k,942) = rxt(k,348)*y(k,201) + mat(k,1435) = rxt(k,331)*y(k,201) + rxt(k,405)*y(k,208) + .250_r8*rxt(k,372) & + *y(k,213) + rxt(k,381)*y(k,215) + .250_r8*rxt(k,430)*y(k,237) + mat(k,2412) = rxt(k,221)*y(k,59) + rxt(k,301)*y(k,124) + .700_r8*rxt(k,320) & + *y(k,197) + rxt(k,348)*y(k,198) + rxt(k,331)*y(k,200) + ( & + + 4.000_r8*rxt(k,298)+2.000_r8*rxt(k,299))*y(k,201) & + + 1.500_r8*rxt(k,406)*y(k,208) + .750_r8*rxt(k,411)*y(k,209) & + + .800_r8*rxt(k,420)*y(k,210) + .880_r8*rxt(k,373)*y(k,213) & + + 2.000_r8*rxt(k,382)*y(k,215) + .750_r8*rxt(k,485)*y(k,223) & + + .800_r8*rxt(k,361)*y(k,232) + .930_r8*rxt(k,490)*y(k,233) & + + .950_r8*rxt(k,495)*y(k,234) + .800_r8*rxt(k,431)*y(k,237) + mat(k,580) = .500_r8*rxt(k,369)*y(k,124) + mat(k,803) = .500_r8*rxt(k,337)*y(k,124) + mat(k,1309) = .920_r8*rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126) + rxt(k,405) & + *y(k,200) + 1.500_r8*rxt(k,406)*y(k,201) + mat(k,1342) = .750_r8*rxt(k,411)*y(k,201) + mat(k,1263) = .800_r8*rxt(k,420)*y(k,201) + mat(k,1364) = .250_r8*rxt(k,376)*y(k,124) + .250_r8*rxt(k,375)*y(k,126) & + + .250_r8*rxt(k,372)*y(k,200) + .880_r8*rxt(k,373)*y(k,201) + mat(k,1404) = .450_r8*rxt(k,383)*y(k,90) + rxt(k,385)*y(k,124) + rxt(k,386) & + *y(k,126) + rxt(k,381)*y(k,200) + 2.000_r8*rxt(k,382)*y(k,201) & + + 4.000_r8*rxt(k,384)*y(k,215) + mat(k,1114) = .750_r8*rxt(k,485)*y(k,201) + mat(k,2030) = (rxt(k,311)+rxt(k,312))*y(k,54) + mat(k,1821) = mat(k,1821) + .400_r8*rxt(k,396)*y(k,1) + .500_r8*rxt(k,335) & + *y(k,51) + rxt(k,302)*y(k,52) + .300_r8*rxt(k,303)*y(k,53) & + + .800_r8*rxt(k,340)*y(k,74) + .300_r8*rxt(k,416)*y(k,100) & + + .500_r8*rxt(k,391)*y(k,109) + rxt(k,342)*y(k,141) & + + .680_r8*rxt(k,501)*y(k,181) + mat(k,821) = rxt(k,359)*y(k,124) + mat(k,1223) = .150_r8*rxt(k,362)*y(k,90) + rxt(k,363)*y(k,124) & + + .800_r8*rxt(k,361)*y(k,201) + mat(k,1185) = .340_r8*rxt(k,492)*y(k,124) + .930_r8*rxt(k,490)*y(k,201) + mat(k,1068) = .320_r8*rxt(k,497)*y(k,124) + .950_r8*rxt(k,495)*y(k,201) + mat(k,1241) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,430)*y(k,200) & + + .800_r8*rxt(k,431)*y(k,201) + 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,602) = -(rxt(k,279)*y(k,56) + rxt(k,280)*y(k,228) + rxt(k,290)*y(k,224)) + mat(k,2137) = -rxt(k,279)*y(k,43) + mat(k,1748) = -rxt(k,280)*y(k,43) + mat(k,2017) = -rxt(k,290)*y(k,43) + mat(k,123) = -(rxt(k,281)*y(k,228)) + mat(k,1683) = -rxt(k,281)*y(k,44) + mat(k,1151) = -(rxt(k,327)*y(k,126) + rxt(k,328)*y(k,228)) + mat(k,1629) = -rxt(k,327)*y(k,45) + mat(k,1792) = -rxt(k,328)*y(k,45) + mat(k,646) = .800_r8*rxt(k,396)*y(k,228) + mat(k,358) = rxt(k,367)*y(k,126) + mat(k,266) = rxt(k,323)*y(k,228) + mat(k,352) = .500_r8*rxt(k,324)*y(k,228) + mat(k,1134) = .500_r8*rxt(k,347)*y(k,136) + mat(k,2333) = .200_r8*rxt(k,387)*y(k,217) + mat(k,1371) = .100_r8*rxt(k,392)*y(k,136) + mat(k,1890) = .400_r8*rxt(k,398)*y(k,192) + rxt(k,322)*y(k,197) & + + .270_r8*rxt(k,350)*y(k,198) + rxt(k,369)*y(k,204) + rxt(k,388) & + *y(k,217) + rxt(k,359)*y(k,231) + mat(k,1629) = mat(k,1629) + rxt(k,367)*y(k,16) + mat(k,2202) = .500_r8*rxt(k,347)*y(k,29) + .100_r8*rxt(k,392)*y(k,111) + mat(k,1044) = .400_r8*rxt(k,398)*y(k,124) + mat(k,902) = rxt(k,322)*y(k,124) + 3.200_r8*rxt(k,319)*y(k,197) & + + .800_r8*rxt(k,320)*y(k,201) + mat(k,937) = .270_r8*rxt(k,350)*y(k,124) + mat(k,2388) = .800_r8*rxt(k,320)*y(k,197) + mat(k,576) = rxt(k,369)*y(k,124) + mat(k,699) = .200_r8*rxt(k,387)*y(k,90) + rxt(k,388)*y(k,124) + mat(k,1792) = mat(k,1792) + .800_r8*rxt(k,396)*y(k,1) + rxt(k,323)*y(k,26) & + + .500_r8*rxt(k,324)*y(k,27) + mat(k,815) = rxt(k,359)*y(k,124) + mat(k,371) = -(rxt(k,282)*y(k,56) + rxt(k,283)*y(k,228)) + mat(k,2132) = -rxt(k,282)*y(k,46) + mat(k,1719) = -rxt(k,283)*y(k,46) + mat(k,104) = -(rxt(k,329)*y(k,228)) + mat(k,1682) = -rxt(k,329)*y(k,47) + mat(k,1080) = -(rxt(k,366)*y(k,228)) + mat(k,1787) = -rxt(k,366)*y(k,48) + mat(k,645) = .800_r8*rxt(k,396)*y(k,228) + mat(k,979) = .520_r8*rxt(k,480)*y(k,136) + mat(k,357) = .500_r8*rxt(k,367)*y(k,126) + mat(k,1023) = .520_r8*rxt(k,483)*y(k,136) + mat(k,1886) = .250_r8*rxt(k,398)*y(k,192) + .820_r8*rxt(k,350)*y(k,198) & + + .500_r8*rxt(k,369)*y(k,204) + .270_r8*rxt(k,492)*y(k,233) & + + .040_r8*rxt(k,497)*y(k,234) + mat(k,1624) = .500_r8*rxt(k,367)*y(k,16) + mat(k,2198) = .520_r8*rxt(k,480)*y(k,6) + .520_r8*rxt(k,483)*y(k,110) + mat(k,1118) = .500_r8*rxt(k,501)*y(k,228) + mat(k,1043) = .250_r8*rxt(k,398)*y(k,124) + mat(k,936) = .820_r8*rxt(k,350)*y(k,124) + .820_r8*rxt(k,348)*y(k,201) + mat(k,2384) = .820_r8*rxt(k,348)*y(k,198) + .150_r8*rxt(k,490)*y(k,233) & + + .025_r8*rxt(k,495)*y(k,234) + mat(k,575) = .500_r8*rxt(k,369)*y(k,124) + mat(k,1787) = mat(k,1787) + .800_r8*rxt(k,396)*y(k,1) + .500_r8*rxt(k,501) & + *y(k,181) + mat(k,1174) = .270_r8*rxt(k,492)*y(k,124) + .150_r8*rxt(k,490)*y(k,201) + mat(k,1064) = .040_r8*rxt(k,497)*y(k,124) + .025_r8*rxt(k,495)*y(k,201) + mat(k,1281) = -(rxt(k,353)*y(k,126) + rxt(k,354)*y(k,228)) + mat(k,1639) = -rxt(k,353)*y(k,49) + mat(k,1802) = -rxt(k,354)*y(k,49) + mat(k,2342) = .070_r8*rxt(k,450)*y(k,202) + .070_r8*rxt(k,456)*y(k,216) + mat(k,1209) = rxt(k,356)*y(k,228) + mat(k,1270) = .880_r8*rxt(k,378)*y(k,136) + mat(k,1374) = .500_r8*rxt(k,392)*y(k,136) + mat(k,1900) = .170_r8*rxt(k,451)*y(k,202) + .050_r8*rxt(k,414)*y(k,209) & + + .250_r8*rxt(k,376)*y(k,213) + .170_r8*rxt(k,457)*y(k,216) & + + .400_r8*rxt(k,467)*y(k,235) + .250_r8*rxt(k,433)*y(k,237) & + + .540_r8*rxt(k,473)*y(k,238) + .510_r8*rxt(k,476)*y(k,240) + mat(k,1639) = mat(k,1639) + .050_r8*rxt(k,415)*y(k,209) + .250_r8*rxt(k,375) & + *y(k,213) + .250_r8*rxt(k,434)*y(k,237) + mat(k,893) = rxt(k,357)*y(k,228) + mat(k,2210) = .880_r8*rxt(k,378)*y(k,105) + .500_r8*rxt(k,392)*y(k,111) + mat(k,1422) = .250_r8*rxt(k,372)*y(k,213) + .250_r8*rxt(k,430)*y(k,237) + mat(k,2397) = .240_r8*rxt(k,373)*y(k,213) + .500_r8*rxt(k,361)*y(k,232) & + + .100_r8*rxt(k,431)*y(k,237) + mat(k,780) = .070_r8*rxt(k,450)*y(k,90) + .170_r8*rxt(k,451)*y(k,124) + mat(k,1331) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) + mat(k,1355) = .250_r8*rxt(k,376)*y(k,124) + .250_r8*rxt(k,375)*y(k,126) & + + .250_r8*rxt(k,372)*y(k,200) + .240_r8*rxt(k,373)*y(k,201) + mat(k,913) = .070_r8*rxt(k,456)*y(k,90) + .170_r8*rxt(k,457)*y(k,124) + mat(k,1802) = mat(k,1802) + rxt(k,356)*y(k,96) + rxt(k,357)*y(k,127) + mat(k,1218) = .500_r8*rxt(k,361)*y(k,201) + mat(k,756) = .400_r8*rxt(k,467)*y(k,124) + mat(k,1234) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,200) + .100_r8*rxt(k,431)*y(k,201) + mat(k,772) = .540_r8*rxt(k,473)*y(k,124) + mat(k,512) = .510_r8*rxt(k,476)*y(k,124) + mat(k,705) = -(rxt(k,334)*y(k,228)) + mat(k,1758) = -rxt(k,334)*y(k,50) + mat(k,1129) = .120_r8*rxt(k,347)*y(k,136) + mat(k,2309) = .150_r8*rxt(k,332)*y(k,200) + .150_r8*rxt(k,383)*y(k,215) + mat(k,2186) = .120_r8*rxt(k,347)*y(k,29) + mat(k,1413) = .150_r8*rxt(k,332)*y(k,90) + .100_r8*rxt(k,331)*y(k,201) + mat(k,2376) = .100_r8*rxt(k,331)*y(k,200) + mat(k,1394) = .150_r8*rxt(k,383)*y(k,90) + mat(k,620) = -(rxt(k,335)*y(k,228)) + mat(k,1750) = -rxt(k,335)*y(k,51) + mat(k,2303) = .400_r8*rxt(k,332)*y(k,200) + .400_r8*rxt(k,383)*y(k,215) + mat(k,1412) = .400_r8*rxt(k,332)*y(k,90) + mat(k,1393) = .400_r8*rxt(k,383)*y(k,90) + mat(k,824) = -(rxt(k,302)*y(k,228)) + mat(k,1768) = -rxt(k,302)*y(k,52) + mat(k,900) = .300_r8*rxt(k,320)*y(k,201) + mat(k,2377) = .300_r8*rxt(k,320)*y(k,197) + 2.000_r8*rxt(k,299)*y(k,201) & + + .250_r8*rxt(k,406)*y(k,208) + .250_r8*rxt(k,411)*y(k,209) & + + .200_r8*rxt(k,420)*y(k,210) + .250_r8*rxt(k,373)*y(k,213) & + + .250_r8*rxt(k,485)*y(k,223) + .500_r8*rxt(k,361)*y(k,232) & + + .250_r8*rxt(k,490)*y(k,233) + .250_r8*rxt(k,495)*y(k,234) & + + .300_r8*rxt(k,431)*y(k,237) + mat(k,1291) = .250_r8*rxt(k,406)*y(k,201) + mat(k,1320) = .250_r8*rxt(k,411)*y(k,201) + mat(k,1247) = .200_r8*rxt(k,420)*y(k,201) + mat(k,1349) = .250_r8*rxt(k,373)*y(k,201) + mat(k,1104) = .250_r8*rxt(k,485)*y(k,201) + mat(k,1215) = .500_r8*rxt(k,361)*y(k,201) + mat(k,1173) = .250_r8*rxt(k,490)*y(k,201) + mat(k,1061) = .250_r8*rxt(k,495)*y(k,201) + mat(k,1228) = .300_r8*rxt(k,431)*y(k,201) + mat(k,454) = -(rxt(k,303)*y(k,228)) + mat(k,1730) = -rxt(k,303)*y(k,53) + mat(k,2292) = rxt(k,300)*y(k,201) + mat(k,2374) = rxt(k,300)*y(k,90) + mat(k,2259) = -(rxt(k,215)*y(k,56) + rxt(k,271)*y(k,73) + rxt(k,304)*y(k,228) & + + (rxt(k,310) + rxt(k,311) + rxt(k,312)) * y(k,224)) + mat(k,2170) = -rxt(k,215)*y(k,54) + mat(k,931) = -rxt(k,271)*y(k,54) + mat(k,1828) = -rxt(k,304)*y(k,54) + mat(k,2037) = -(rxt(k,310) + rxt(k,311) + rxt(k,312)) * y(k,54) + mat(k,1147) = .100_r8*rxt(k,347)*y(k,136) + mat(k,2234) = .100_r8*rxt(k,347)*y(k,29) + mat(k,385) = -(rxt(k,267)*y(k,224) + rxt(k,284)*y(k,56) + rxt(k,285)*y(k,228)) + mat(k,2015) = -rxt(k,267)*y(k,55) + mat(k,2133) = -rxt(k,284)*y(k,55) + mat(k,1720) = -rxt(k,285)*y(k,55) + mat(k,2168) = -(rxt(k,214)*y(k,42) + rxt(k,215)*y(k,54) + rxt(k,216)*y(k,77) & + + rxt(k,217)*y(k,79) + (rxt(k,218) + rxt(k,219)) * y(k,90) & + + rxt(k,220)*y(k,136) + rxt(k,227)*y(k,60) + rxt(k,236)*y(k,93) & + + rxt(k,277)*y(k,41) + rxt(k,279)*y(k,43) + rxt(k,282)*y(k,46) & + + rxt(k,284)*y(k,55) + rxt(k,325)*y(k,28) + rxt(k,355)*y(k,31)) + mat(k,1992) = -rxt(k,214)*y(k,56) + mat(k,2257) = -rxt(k,215)*y(k,56) + mat(k,1469) = -rxt(k,216)*y(k,56) + mat(k,586) = -rxt(k,217)*y(k,56) + mat(k,2365) = -(rxt(k,218) + rxt(k,219)) * y(k,56) + mat(k,2232) = -rxt(k,220)*y(k,56) + mat(k,963) = -rxt(k,227)*y(k,56) + mat(k,842) = -rxt(k,236)*y(k,56) + mat(k,484) = -rxt(k,277)*y(k,56) + mat(k,607) = -rxt(k,279)*y(k,56) + mat(k,375) = -rxt(k,282)*y(k,56) + mat(k,390) = -rxt(k,284)*y(k,56) + mat(k,302) = -rxt(k,325)*y(k,56) + mat(k,308) = -rxt(k,355)*y(k,56) + mat(k,1576) = rxt(k,255)*y(k,59) + mat(k,103) = 4.000_r8*rxt(k,239)*y(k,224) + mat(k,143) = rxt(k,240)*y(k,224) + mat(k,114) = 2.000_r8*rxt(k,241)*y(k,224) + mat(k,153) = 2.000_r8*rxt(k,242)*y(k,224) + mat(k,118) = 2.000_r8*rxt(k,243)*y(k,224) + mat(k,158) = rxt(k,244)*y(k,224) + mat(k,122) = 2.000_r8*rxt(k,245)*y(k,224) + mat(k,125) = 3.000_r8*rxt(k,281)*y(k,228) + mat(k,375) = mat(k,375) + rxt(k,283)*y(k,228) + mat(k,1602) = rxt(k,255)*y(k,19) + (4.000_r8*rxt(k,222)+2.000_r8*rxt(k,224)) & + *y(k,59) + rxt(k,226)*y(k,124) + rxt(k,231)*y(k,134) & + + rxt(k,510)*y(k,152) + rxt(k,221)*y(k,201) + rxt(k,232) & + *y(k,228) + mat(k,249) = rxt(k,276)*y(k,224) + mat(k,245) = rxt(k,291)*y(k,224) + rxt(k,286)*y(k,228) + mat(k,255) = rxt(k,292)*y(k,224) + rxt(k,287)*y(k,228) + mat(k,296) = rxt(k,293)*y(k,224) + rxt(k,288)*y(k,228) + mat(k,1506) = rxt(k,234)*y(k,134) + rxt(k,246)*y(k,224) + rxt(k,235)*y(k,228) + mat(k,1921) = rxt(k,226)*y(k,59) + mat(k,2101) = rxt(k,231)*y(k,59) + rxt(k,234)*y(k,85) + mat(k,1486) = rxt(k,510)*y(k,59) + mat(k,2417) = rxt(k,221)*y(k,59) + mat(k,2035) = 4.000_r8*rxt(k,239)*y(k,33) + rxt(k,240)*y(k,34) & + + 2.000_r8*rxt(k,241)*y(k,36) + 2.000_r8*rxt(k,242)*y(k,37) & + + 2.000_r8*rxt(k,243)*y(k,38) + rxt(k,244)*y(k,39) & + + 2.000_r8*rxt(k,245)*y(k,40) + rxt(k,276)*y(k,65) + rxt(k,291) & + *y(k,82) + rxt(k,292)*y(k,83) + rxt(k,293)*y(k,84) + rxt(k,246) & + *y(k,85) + mat(k,1826) = 3.000_r8*rxt(k,281)*y(k,44) + rxt(k,283)*y(k,46) + rxt(k,232) & + *y(k,59) + rxt(k,286)*y(k,82) + rxt(k,287)*y(k,83) + rxt(k,288) & + *y(k,84) + rxt(k,235)*y(k,85) + mat(k,2128) = rxt(k,227)*y(k,60) + mat(k,1581) = 2.000_r8*rxt(k,223)*y(k,59) + mat(k,953) = rxt(k,227)*y(k,56) + (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,85) + mat(k,1490) = (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,60) + (rxt(k,563) & + +rxt(k,569)+rxt(k,574))*y(k,93) + mat(k,836) = (rxt(k,563)+rxt(k,569)+rxt(k,574))*y(k,85) + mat(k,1580) = 2.000_r8*rxt(k,248)*y(k,59) + mat(k,1592) = -(rxt(k,221)*y(k,201) + (4._r8*rxt(k,222) + 4._r8*rxt(k,223) & + + 4._r8*rxt(k,224) + 4._r8*rxt(k,248)) * y(k,59) + rxt(k,225) & + *y(k,90) + rxt(k,226)*y(k,124) + rxt(k,228)*y(k,125) + rxt(k,231) & + *y(k,134) + (rxt(k,232) + rxt(k,233)) * y(k,228) + (rxt(k,254) & + + rxt(k,255) + rxt(k,256)) * y(k,19) + rxt(k,510)*y(k,152)) + mat(k,2407) = -rxt(k,221)*y(k,59) + mat(k,2355) = -rxt(k,225)*y(k,59) + mat(k,1911) = -rxt(k,226)*y(k,59) + mat(k,1956) = -rxt(k,228)*y(k,59) + mat(k,2091) = -rxt(k,231)*y(k,59) + mat(k,1816) = -(rxt(k,232) + rxt(k,233)) * y(k,59) + mat(k,1566) = -(rxt(k,254) + rxt(k,255) + rxt(k,256)) * y(k,59) + mat(k,1480) = -rxt(k,510)*y(k,59) + mat(k,2158) = rxt(k,219)*y(k,90) + rxt(k,236)*y(k,93) + rxt(k,220)*y(k,136) + mat(k,957) = rxt(k,229)*y(k,134) + mat(k,1498) = rxt(k,247)*y(k,224) + mat(k,2355) = mat(k,2355) + rxt(k,219)*y(k,56) + mat(k,839) = rxt(k,236)*y(k,56) + rxt(k,237)*y(k,134) + rxt(k,238)*y(k,228) + mat(k,2091) = mat(k,2091) + rxt(k,229)*y(k,60) + rxt(k,237)*y(k,93) + mat(k,2222) = rxt(k,220)*y(k,56) + mat(k,337) = rxt(k,515)*y(k,152) + mat(k,1480) = mat(k,1480) + rxt(k,515)*y(k,138) + mat(k,2025) = rxt(k,247)*y(k,85) + mat(k,1816) = mat(k,1816) + rxt(k,238)*y(k,93) + 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,955) = -(rxt(k,227)*y(k,56) + rxt(k,229)*y(k,134) + rxt(k,230)*y(k,228) & + + (rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,85)) + mat(k,2143) = -rxt(k,227)*y(k,60) + mat(k,2081) = -rxt(k,229)*y(k,60) + mat(k,1779) = -rxt(k,230)*y(k,60) + mat(k,1494) = -(rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,60) + mat(k,1586) = rxt(k,228)*y(k,125) + mat(k,1942) = rxt(k,228)*y(k,59) + mat(k,1160) = -(rxt(k,314)*y(k,228)) + mat(k,1793) = -rxt(k,314)*y(k,62) + mat(k,982) = .230_r8*rxt(k,480)*y(k,136) + mat(k,1509) = rxt(k,250)*y(k,42) + mat(k,288) = .350_r8*rxt(k,316)*y(k,228) + mat(k,553) = .630_r8*rxt(k,318)*y(k,136) + mat(k,1135) = .560_r8*rxt(k,347)*y(k,136) + mat(k,1975) = rxt(k,250)*y(k,17) + rxt(k,214)*y(k,56) + rxt(k,295)*y(k,126) & + + rxt(k,296)*y(k,134) + rxt(k,297)*y(k,228) + mat(k,372) = rxt(k,282)*y(k,56) + mat(k,1280) = rxt(k,353)*y(k,126) + rxt(k,354)*y(k,228) + mat(k,2147) = rxt(k,214)*y(k,42) + rxt(k,282)*y(k,46) + mat(k,1449) = rxt(k,591)*y(k,229) + mat(k,1055) = rxt(k,341)*y(k,228) + mat(k,2334) = .070_r8*rxt(k,450)*y(k,202) + .160_r8*rxt(k,453)*y(k,214) & + + .140_r8*rxt(k,456)*y(k,216) + mat(k,879) = .620_r8*rxt(k,425)*y(k,136) + mat(k,1268) = .650_r8*rxt(k,378)*y(k,136) + mat(k,1026) = .230_r8*rxt(k,483)*y(k,136) + mat(k,1372) = .560_r8*rxt(k,392)*y(k,136) + mat(k,1891) = .170_r8*rxt(k,451)*y(k,202) + .220_r8*rxt(k,376)*y(k,213) & + + .400_r8*rxt(k,454)*y(k,214) + .350_r8*rxt(k,457)*y(k,216) & + + .225_r8*rxt(k,492)*y(k,233) + .250_r8*rxt(k,433)*y(k,237) + mat(k,1630) = rxt(k,295)*y(k,42) + rxt(k,353)*y(k,49) + .220_r8*rxt(k,375) & + *y(k,213) + .500_r8*rxt(k,434)*y(k,237) + mat(k,2083) = rxt(k,296)*y(k,42) + rxt(k,504)*y(k,139) + mat(k,2203) = .230_r8*rxt(k,480)*y(k,6) + .630_r8*rxt(k,318)*y(k,25) & + + .560_r8*rxt(k,347)*y(k,29) + .620_r8*rxt(k,425)*y(k,99) & + + .650_r8*rxt(k,378)*y(k,105) + .230_r8*rxt(k,483)*y(k,110) & + + .560_r8*rxt(k,392)*y(k,111) + mat(k,366) = rxt(k,504)*y(k,134) + rxt(k,505)*y(k,228) + mat(k,1120) = .700_r8*rxt(k,501)*y(k,228) + mat(k,1416) = .220_r8*rxt(k,372)*y(k,213) + .250_r8*rxt(k,430)*y(k,237) + mat(k,2389) = .110_r8*rxt(k,373)*y(k,213) + .125_r8*rxt(k,490)*y(k,233) & + + .200_r8*rxt(k,431)*y(k,237) + mat(k,779) = .070_r8*rxt(k,450)*y(k,90) + .170_r8*rxt(k,451)*y(k,124) + mat(k,1350) = .220_r8*rxt(k,376)*y(k,124) + .220_r8*rxt(k,375)*y(k,126) & + + .220_r8*rxt(k,372)*y(k,200) + .110_r8*rxt(k,373)*y(k,201) + mat(k,742) = .160_r8*rxt(k,453)*y(k,90) + .400_r8*rxt(k,454)*y(k,124) + mat(k,912) = .140_r8*rxt(k,456)*y(k,90) + .350_r8*rxt(k,457)*y(k,124) + mat(k,1793) = mat(k,1793) + .350_r8*rxt(k,316)*y(k,24) + rxt(k,297)*y(k,42) & + + rxt(k,354)*y(k,49) + rxt(k,341)*y(k,75) + rxt(k,505)*y(k,139) & + + .700_r8*rxt(k,501)*y(k,181) + mat(k,809) = rxt(k,591)*y(k,63) + mat(k,1176) = .225_r8*rxt(k,492)*y(k,124) + .125_r8*rxt(k,490)*y(k,201) + mat(k,1230) = .250_r8*rxt(k,433)*y(k,124) + .500_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,200) + .200_r8*rxt(k,431)*y(k,201) + mat(k,1450) = -(rxt(k,591)*y(k,229)) + mat(k,810) = -rxt(k,591)*y(k,63) + mat(k,986) = .270_r8*rxt(k,480)*y(k,136) + mat(k,1139) = .200_r8*rxt(k,347)*y(k,136) + mat(k,706) = rxt(k,334)*y(k,228) + mat(k,622) = .500_r8*rxt(k,335)*y(k,228) + mat(k,1161) = rxt(k,314)*y(k,228) + mat(k,1167) = .800_r8*rxt(k,340)*y(k,228) + mat(k,1056) = rxt(k,341)*y(k,228) + mat(k,920) = rxt(k,306)*y(k,228) + mat(k,2349) = .450_r8*rxt(k,383)*y(k,215) + mat(k,614) = .500_r8*rxt(k,391)*y(k,228) + mat(k,1030) = .270_r8*rxt(k,483)*y(k,136) + mat(k,1379) = .100_r8*rxt(k,392)*y(k,136) + mat(k,1907) = rxt(k,333)*y(k,200) + .900_r8*rxt(k,492)*y(k,233) + mat(k,2217) = .270_r8*rxt(k,480)*y(k,6) + .200_r8*rxt(k,347)*y(k,29) & + + .270_r8*rxt(k,483)*y(k,110) + .100_r8*rxt(k,392)*y(k,111) + mat(k,1123) = 1.800_r8*rxt(k,501)*y(k,228) + mat(k,1429) = rxt(k,333)*y(k,124) + 4.000_r8*rxt(k,330)*y(k,200) & + + .900_r8*rxt(k,331)*y(k,201) + rxt(k,405)*y(k,208) & + + 2.000_r8*rxt(k,381)*y(k,215) + rxt(k,430)*y(k,237) + mat(k,2404) = .900_r8*rxt(k,331)*y(k,200) + rxt(k,382)*y(k,215) & + + .500_r8*rxt(k,490)*y(k,233) + mat(k,1304) = rxt(k,405)*y(k,200) + mat(k,1399) = .450_r8*rxt(k,383)*y(k,90) + 2.000_r8*rxt(k,381)*y(k,200) & + + rxt(k,382)*y(k,201) + 4.000_r8*rxt(k,384)*y(k,215) + mat(k,1809) = rxt(k,334)*y(k,50) + .500_r8*rxt(k,335)*y(k,51) + rxt(k,314) & + *y(k,62) + .800_r8*rxt(k,340)*y(k,74) + rxt(k,341)*y(k,75) & + + rxt(k,306)*y(k,87) + .500_r8*rxt(k,391)*y(k,109) & + + 1.800_r8*rxt(k,501)*y(k,181) + mat(k,1181) = .900_r8*rxt(k,492)*y(k,124) + .500_r8*rxt(k,490)*y(k,201) + mat(k,1236) = rxt(k,430)*y(k,200) + mat(k,238) = -(rxt(k,275)*y(k,224)) + mat(k,2009) = -rxt(k,275)*y(k,64) + mat(k,140) = rxt(k,240)*y(k,224) + mat(k,145) = rxt(k,266)*y(k,224) + mat(k,150) = rxt(k,242)*y(k,224) + mat(k,116) = 2.000_r8*rxt(k,243)*y(k,224) + mat(k,155) = 2.000_r8*rxt(k,244)*y(k,224) + mat(k,120) = rxt(k,245)*y(k,224) + mat(k,108) = 2.000_r8*rxt(k,268)*y(k,224) + mat(k,250) = rxt(k,292)*y(k,224) + rxt(k,287)*y(k,228) + mat(k,291) = rxt(k,293)*y(k,224) + rxt(k,288)*y(k,228) + mat(k,2009) = mat(k,2009) + rxt(k,240)*y(k,34) + rxt(k,266)*y(k,35) & + + rxt(k,242)*y(k,37) + 2.000_r8*rxt(k,243)*y(k,38) & + + 2.000_r8*rxt(k,244)*y(k,39) + rxt(k,245)*y(k,40) & + + 2.000_r8*rxt(k,268)*y(k,78) + rxt(k,292)*y(k,83) + rxt(k,293) & + *y(k,84) + mat(k,1699) = rxt(k,287)*y(k,83) + rxt(k,288)*y(k,84) + mat(k,246) = -(rxt(k,276)*y(k,224)) + mat(k,2011) = -rxt(k,276)*y(k,65) + mat(k,112) = rxt(k,241)*y(k,224) + mat(k,151) = rxt(k,242)*y(k,224) + mat(k,242) = rxt(k,291)*y(k,224) + rxt(k,286)*y(k,228) + mat(k,2011) = mat(k,2011) + rxt(k,241)*y(k,36) + rxt(k,242)*y(k,37) & + + rxt(k,291)*y(k,82) + mat(k,1701) = rxt(k,286)*y(k,82) + mat(k,194) = -(rxt(k,449)*y(k,228)) + mat(k,1690) = -rxt(k,449)*y(k,66) + mat(k,188) = .180_r8*rxt(k,469)*y(k,228) + mat(k,1690) = mat(k,1690) + .180_r8*rxt(k,469)*y(k,183) + mat(k,310) = -(rxt(k,502)*y(k,126) + (rxt(k,503) + rxt(k,517)) * y(k,228)) + mat(k,1610) = -rxt(k,502)*y(k,67) + mat(k,1710) = -(rxt(k,503) + rxt(k,517)) * y(k,67) + mat(k,2275) = rxt(k,336)*y(k,206) + mat(k,795) = rxt(k,336)*y(k,90) + mat(k,925) = -(rxt(k,271)*y(k,54) + rxt(k,272)*y(k,77) + rxt(k,273)*y(k,241) & + + rxt(k,274)*y(k,89)) + mat(k,2239) = -rxt(k,271)*y(k,73) + mat(k,1460) = -rxt(k,272)*y(k,73) + mat(k,2426) = -rxt(k,273)*y(k,73) + mat(k,2042) = -rxt(k,274)*y(k,73) + mat(k,146) = rxt(k,266)*y(k,224) + mat(k,156) = rxt(k,244)*y(k,224) + mat(k,239) = 2.000_r8*rxt(k,275)*y(k,224) + mat(k,247) = rxt(k,276)*y(k,224) + mat(k,2019) = rxt(k,266)*y(k,35) + rxt(k,244)*y(k,39) + 2.000_r8*rxt(k,275) & + *y(k,64) + rxt(k,276)*y(k,65) + mat(k,1166) = -(rxt(k,340)*y(k,228)) + mat(k,1794) = -rxt(k,340)*y(k,74) + mat(k,590) = .700_r8*rxt(k,416)*y(k,228) + mat(k,560) = .500_r8*rxt(k,417)*y(k,228) + mat(k,429) = rxt(k,428)*y(k,228) + mat(k,1892) = .050_r8*rxt(k,414)*y(k,209) + .530_r8*rxt(k,376)*y(k,213) & + + .225_r8*rxt(k,492)*y(k,233) + .250_r8*rxt(k,433)*y(k,237) + mat(k,1631) = .050_r8*rxt(k,415)*y(k,209) + .530_r8*rxt(k,375)*y(k,213) & + + .250_r8*rxt(k,434)*y(k,237) + mat(k,1538) = rxt(k,339)*y(k,205) + mat(k,1417) = .530_r8*rxt(k,372)*y(k,213) + .250_r8*rxt(k,430)*y(k,237) + mat(k,2390) = .260_r8*rxt(k,373)*y(k,213) + .125_r8*rxt(k,490)*y(k,233) & + + .100_r8*rxt(k,431)*y(k,237) + mat(k,461) = rxt(k,339)*y(k,135) + mat(k,1325) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) + mat(k,1351) = .530_r8*rxt(k,376)*y(k,124) + .530_r8*rxt(k,375)*y(k,126) & + + .530_r8*rxt(k,372)*y(k,200) + .260_r8*rxt(k,373)*y(k,201) + mat(k,1794) = mat(k,1794) + .700_r8*rxt(k,416)*y(k,100) + .500_r8*rxt(k,417) & + *y(k,101) + rxt(k,428)*y(k,115) + mat(k,1177) = .225_r8*rxt(k,492)*y(k,124) + .125_r8*rxt(k,490)*y(k,201) + mat(k,1231) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,200) + .100_r8*rxt(k,431)*y(k,201) + mat(k,1054) = -(rxt(k,341)*y(k,228)) + mat(k,1784) = -rxt(k,341)*y(k,75) + mat(k,287) = .650_r8*rxt(k,316)*y(k,228) + mat(k,1164) = .200_r8*rxt(k,340)*y(k,228) + mat(k,2327) = .160_r8*rxt(k,453)*y(k,214) + .070_r8*rxt(k,456)*y(k,216) + mat(k,1089) = rxt(k,429)*y(k,228) + mat(k,1883) = rxt(k,440)*y(k,194) + .050_r8*rxt(k,414)*y(k,209) & + + .400_r8*rxt(k,454)*y(k,214) + .170_r8*rxt(k,457)*y(k,216) & + + .700_r8*rxt(k,460)*y(k,230) + .600_r8*rxt(k,467)*y(k,235) & + + .250_r8*rxt(k,433)*y(k,237) + .340_r8*rxt(k,473)*y(k,238) & + + .170_r8*rxt(k,476)*y(k,240) + mat(k,1621) = .050_r8*rxt(k,415)*y(k,209) + .250_r8*rxt(k,434)*y(k,237) + mat(k,497) = rxt(k,440)*y(k,124) + mat(k,1414) = .250_r8*rxt(k,430)*y(k,237) + mat(k,2381) = .100_r8*rxt(k,431)*y(k,237) + mat(k,1323) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) + mat(k,741) = .160_r8*rxt(k,453)*y(k,90) + .400_r8*rxt(k,454)*y(k,124) + mat(k,911) = .070_r8*rxt(k,456)*y(k,90) + .170_r8*rxt(k,457)*y(k,124) + mat(k,1784) = mat(k,1784) + .650_r8*rxt(k,316)*y(k,24) + .200_r8*rxt(k,340) & + *y(k,74) + rxt(k,429)*y(k,116) + mat(k,449) = .700_r8*rxt(k,460)*y(k,124) + mat(k,754) = .600_r8*rxt(k,467)*y(k,124) + mat(k,1229) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,200) + .100_r8*rxt(k,431)*y(k,201) + mat(k,770) = .340_r8*rxt(k,473)*y(k,124) + mat(k,511) = .170_r8*rxt(k,476)*y(k,124) + mat(k,2121) = -((rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,90) + rxt(k,175) & + *y(k,135) + rxt(k,178)*y(k,136)) + mat(k,2364) = -(rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,76) + mat(k,1551) = -rxt(k,175)*y(k,76) + mat(k,2231) = -rxt(k,178)*y(k,76) + mat(k,1991) = rxt(k,297)*y(k,228) + mat(k,2256) = rxt(k,311)*y(k,224) + mat(k,2167) = rxt(k,216)*y(k,77) + mat(k,930) = rxt(k,272)*y(k,77) + mat(k,1468) = rxt(k,216)*y(k,56) + rxt(k,272)*y(k,73) + rxt(k,170)*y(k,134) & + + rxt(k,153)*y(k,224) + rxt(k,179)*y(k,228) + mat(k,834) = rxt(k,270)*y(k,224) + mat(k,1505) = rxt(k,247)*y(k,224) + mat(k,1008) = rxt(k,202)*y(k,228) + mat(k,2100) = rxt(k,170)*y(k,77) + rxt(k,182)*y(k,228) + mat(k,370) = rxt(k,505)*y(k,228) + mat(k,723) = rxt(k,511)*y(k,228) + mat(k,1485) = rxt(k,516)*y(k,228) + mat(k,2034) = rxt(k,311)*y(k,54) + rxt(k,153)*y(k,77) + rxt(k,270)*y(k,81) & + + rxt(k,247)*y(k,85) + mat(k,1825) = rxt(k,297)*y(k,42) + rxt(k,179)*y(k,77) + rxt(k,202)*y(k,112) & + + rxt(k,182)*y(k,134) + rxt(k,505)*y(k,139) + rxt(k,511) & + *y(k,150) + rxt(k,516)*y(k,152) + 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,1461) = -(rxt(k,153)*y(k,224) + rxt(k,170)*y(k,134) + rxt(k,179) & + *y(k,228) + rxt(k,216)*y(k,56) + rxt(k,272)*y(k,73)) + mat(k,2020) = -rxt(k,153)*y(k,77) + mat(k,2085) = -rxt(k,170)*y(k,77) + mat(k,1810) = -rxt(k,179)*y(k,77) + mat(k,2153) = -rxt(k,216)*y(k,77) + mat(k,926) = -rxt(k,272)*y(k,77) + mat(k,2242) = rxt(k,312)*y(k,224) + mat(k,2107) = rxt(k,172)*y(k,90) + mat(k,2350) = rxt(k,172)*y(k,76) + mat(k,2020) = mat(k,2020) + rxt(k,312)*y(k,54) + mat(k,107) = -(rxt(k,268)*y(k,224)) + mat(k,1999) = -rxt(k,268)*y(k,78) + mat(k,582) = -(rxt(k,171)*y(k,134) + rxt(k,180)*y(k,228) + rxt(k,217)*y(k,56)) + mat(k,2070) = -rxt(k,171)*y(k,79) + mat(k,1745) = -rxt(k,180)*y(k,79) + mat(k,2136) = -rxt(k,217)*y(k,79) + mat(k,2302) = 2.000_r8*rxt(k,186)*y(k,90) + mat(k,1745) = mat(k,1745) + 2.000_r8*rxt(k,185)*y(k,228) + mat(k,260) = rxt(k,518)*y(k,241) + mat(k,2423) = rxt(k,518)*y(k,154) + mat(k,828) = -(rxt(k,263)*y(k,134) + rxt(k,264)*y(k,228) + (rxt(k,269) & + + rxt(k,270)) * y(k,224)) + mat(k,2075) = -rxt(k,263)*y(k,81) + mat(k,1769) = -rxt(k,264)*y(k,81) + mat(k,2018) = -(rxt(k,269) + rxt(k,270)) * y(k,81) + mat(k,1508) = rxt(k,250)*y(k,42) + rxt(k,251)*y(k,90) + mat(k,1973) = rxt(k,250)*y(k,17) + mat(k,2319) = rxt(k,251)*y(k,17) + mat(k,241) = -(rxt(k,286)*y(k,228) + rxt(k,291)*y(k,224)) + mat(k,1700) = -rxt(k,286)*y(k,82) + mat(k,2010) = -rxt(k,291)*y(k,82) + mat(k,251) = -(rxt(k,287)*y(k,228) + rxt(k,292)*y(k,224)) + mat(k,1702) = -rxt(k,287)*y(k,83) + mat(k,2012) = -rxt(k,292)*y(k,83) + mat(k,292) = -(rxt(k,288)*y(k,228) + rxt(k,293)*y(k,224)) + mat(k,1707) = -rxt(k,288)*y(k,84) + mat(k,2014) = -rxt(k,293)*y(k,84) + mat(k,1495) = -(rxt(k,234)*y(k,134) + rxt(k,235)*y(k,228) + (rxt(k,246) & + + rxt(k,247)) * y(k,224) + (rxt(k,563) + rxt(k,569) + rxt(k,574) & + ) * y(k,93) + (rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,60) & + + (rxt(k,570) + rxt(k,575)) * y(k,92)) + mat(k,2087) = -rxt(k,234)*y(k,85) + mat(k,1812) = -rxt(k,235)*y(k,85) + mat(k,2021) = -(rxt(k,246) + rxt(k,247)) * y(k,85) + mat(k,838) = -(rxt(k,563) + rxt(k,569) + rxt(k,574)) * y(k,85) + mat(k,956) = -(rxt(k,568) + rxt(k,573) + rxt(k,578)) * y(k,85) + mat(k,788) = -(rxt(k,570) + rxt(k,575)) * y(k,85) + mat(k,300) = rxt(k,325)*y(k,56) + mat(k,306) = rxt(k,355)*y(k,56) + mat(k,480) = rxt(k,277)*y(k,56) + mat(k,1978) = rxt(k,214)*y(k,56) + mat(k,603) = rxt(k,279)*y(k,56) + mat(k,373) = 2.000_r8*rxt(k,282)*y(k,56) + mat(k,2243) = rxt(k,215)*y(k,56) + mat(k,386) = rxt(k,284)*y(k,56) + mat(k,2154) = rxt(k,325)*y(k,28) + rxt(k,355)*y(k,31) + rxt(k,277)*y(k,41) & + + rxt(k,214)*y(k,42) + rxt(k,279)*y(k,43) + 2.000_r8*rxt(k,282) & + *y(k,46) + rxt(k,215)*y(k,54) + rxt(k,284)*y(k,55) + rxt(k,216) & + *y(k,77) + rxt(k,217)*y(k,79) + rxt(k,218)*y(k,90) + rxt(k,236) & + *y(k,93) + mat(k,1588) = rxt(k,233)*y(k,228) + mat(k,1462) = rxt(k,216)*y(k,56) + mat(k,583) = rxt(k,217)*y(k,56) + mat(k,2351) = rxt(k,218)*y(k,56) + mat(k,838) = mat(k,838) + rxt(k,236)*y(k,56) + mat(k,1812) = mat(k,1812) + rxt(k,233)*y(k,59) + mat(k,182) = -(rxt(k,305)*y(k,228) + rxt(k,313)*y(k,224)) + mat(k,1688) = -rxt(k,305)*y(k,86) + mat(k,2008) = -rxt(k,313)*y(k,86) + mat(k,919) = -(rxt(k,306)*y(k,228)) + mat(k,1775) = -rxt(k,306)*y(k,87) + mat(k,973) = .050_r8*rxt(k,480)*y(k,136) + mat(k,286) = .350_r8*rxt(k,316)*y(k,228) + mat(k,552) = .370_r8*rxt(k,318)*y(k,136) + mat(k,1132) = .120_r8*rxt(k,347)*y(k,136) + mat(k,2324) = rxt(k,307)*y(k,207) + mat(k,877) = .110_r8*rxt(k,425)*y(k,136) + mat(k,1267) = .330_r8*rxt(k,378)*y(k,136) + mat(k,1017) = .050_r8*rxt(k,483)*y(k,136) + mat(k,1369) = .120_r8*rxt(k,392)*y(k,136) + mat(k,1879) = rxt(k,309)*y(k,207) + mat(k,2190) = .050_r8*rxt(k,480)*y(k,6) + .370_r8*rxt(k,318)*y(k,25) & + + .120_r8*rxt(k,347)*y(k,29) + .110_r8*rxt(k,425)*y(k,99) & + + .330_r8*rxt(k,378)*y(k,105) + .050_r8*rxt(k,483)*y(k,110) & + + .120_r8*rxt(k,392)*y(k,111) + mat(k,442) = rxt(k,307)*y(k,90) + rxt(k,309)*y(k,124) + mat(k,1775) = mat(k,1775) + .350_r8*rxt(k,316)*y(k,24) + mat(k,2238) = rxt(k,271)*y(k,73) + mat(k,924) = rxt(k,271)*y(k,54) + rxt(k,272)*y(k,77) + rxt(k,274)*y(k,89) & + + rxt(k,273)*y(k,241) + mat(k,1459) = rxt(k,272)*y(k,73) + mat(k,2041) = rxt(k,274)*y(k,73) + mat(k,2425) = rxt(k,273)*y(k,73) + mat(k,2055) = -(rxt(k,211)*y(k,228) + rxt(k,274)*y(k,73)) + mat(k,1823) = -rxt(k,211)*y(k,89) + mat(k,929) = -rxt(k,274)*y(k,89) + mat(k,1989) = rxt(k,295)*y(k,126) + mat(k,1156) = rxt(k,327)*y(k,126) + mat(k,1286) = rxt(k,353)*y(k,126) + mat(k,961) = (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,85) + mat(k,314) = rxt(k,502)*y(k,126) + mat(k,1503) = (rxt(k,568)+rxt(k,573)+rxt(k,578))*y(k,60) + mat(k,1963) = rxt(k,210)*y(k,228) + mat(k,1658) = rxt(k,295)*y(k,42) + rxt(k,327)*y(k,45) + rxt(k,353)*y(k,49) & + + rxt(k,502)*y(k,67) + mat(k,1823) = mat(k,1823) + rxt(k,210)*y(k,125) + mat(k,2368) = -((rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,76) + rxt(k,176) & + *y(k,134) + rxt(k,177)*y(k,136) + rxt(k,181)*y(k,228) & + + 4._r8*rxt(k,186)*y(k,90) + rxt(k,198)*y(k,126) + rxt(k,203) & + *y(k,124) + rxt(k,208)*y(k,125) + (rxt(k,218) + rxt(k,219) & + ) * y(k,56) + rxt(k,225)*y(k,59) + rxt(k,251)*y(k,17) + rxt(k,257) & + *y(k,19) + rxt(k,294)*y(k,42) + rxt(k,300)*y(k,201) + rxt(k,307) & + *y(k,207) + rxt(k,321)*y(k,197) + rxt(k,332)*y(k,200) + rxt(k,336) & + *y(k,206) + rxt(k,349)*y(k,198) + rxt(k,358)*y(k,231) + rxt(k,362) & + *y(k,232) + rxt(k,374)*y(k,213) + rxt(k,383)*y(k,215) + rxt(k,387) & + *y(k,217) + rxt(k,397)*y(k,192) + rxt(k,407)*y(k,208) + rxt(k,412) & + *y(k,209) + rxt(k,421)*y(k,210) + rxt(k,432)*y(k,237) + rxt(k,436) & + *y(k,191) + rxt(k,439)*y(k,194) + rxt(k,443)*y(k,196) + rxt(k,446) & + *y(k,199) + rxt(k,450)*y(k,202) + rxt(k,453)*y(k,214) + rxt(k,456) & + *y(k,216) + rxt(k,459)*y(k,230) + rxt(k,466)*y(k,235) + rxt(k,472) & + *y(k,238) + rxt(k,475)*y(k,240) + rxt(k,486)*y(k,223) + rxt(k,491) & + *y(k,233) + rxt(k,496)*y(k,234)) + mat(k,2125) = -(rxt(k,172) + rxt(k,173) + rxt(k,174)) * y(k,90) + mat(k,2104) = -rxt(k,176)*y(k,90) + mat(k,2235) = -rxt(k,177)*y(k,90) + mat(k,1829) = -rxt(k,181)*y(k,90) + mat(k,1664) = -rxt(k,198)*y(k,90) + mat(k,1924) = -rxt(k,203)*y(k,90) + mat(k,1969) = -rxt(k,208)*y(k,90) + mat(k,2171) = -(rxt(k,218) + rxt(k,219)) * y(k,90) + mat(k,1604) = -rxt(k,225)*y(k,90) + mat(k,1522) = -rxt(k,251)*y(k,90) + mat(k,1578) = -rxt(k,257)*y(k,90) + mat(k,1995) = -rxt(k,294)*y(k,90) + mat(k,2420) = -rxt(k,300)*y(k,90) + mat(k,446) = -rxt(k,307)*y(k,90) + mat(k,908) = -rxt(k,321)*y(k,90) + mat(k,1439) = -rxt(k,332)*y(k,90) + mat(k,804) = -rxt(k,336)*y(k,90) + mat(k,943) = -rxt(k,349)*y(k,90) + mat(k,822) = -rxt(k,358)*y(k,90) + mat(k,1224) = -rxt(k,362)*y(k,90) + mat(k,1366) = -rxt(k,374)*y(k,90) + mat(k,1407) = -rxt(k,383)*y(k,90) + mat(k,704) = -rxt(k,387)*y(k,90) + mat(k,1051) = -rxt(k,397)*y(k,90) + mat(k,1312) = -rxt(k,407)*y(k,90) + mat(k,1345) = -rxt(k,412)*y(k,90) + mat(k,1265) = -rxt(k,421)*y(k,90) + mat(k,1242) = -rxt(k,432)*y(k,90) + mat(k,528) = -rxt(k,436)*y(k,90) + mat(k,501) = -rxt(k,439)*y(k,90) + mat(k,440) = -rxt(k,443)*y(k,90) + mat(k,640) = -rxt(k,446)*y(k,90) + mat(k,784) = -rxt(k,450)*y(k,90) + mat(k,745) = -rxt(k,453)*y(k,90) + mat(k,917) = -rxt(k,456)*y(k,90) + mat(k,453) = -rxt(k,459)*y(k,90) + mat(k,760) = -rxt(k,466)*y(k,90) + mat(k,777) = -rxt(k,472)*y(k,90) + mat(k,516) = -rxt(k,475)*y(k,90) + mat(k,1116) = -rxt(k,486)*y(k,90) + mat(k,1187) = -rxt(k,491)*y(k,90) + mat(k,1070) = -rxt(k,496)*y(k,90) + mat(k,991) = .570_r8*rxt(k,480)*y(k,136) + mat(k,165) = .650_r8*rxt(k,438)*y(k,228) + mat(k,1522) = mat(k,1522) + rxt(k,250)*y(k,42) + mat(k,1578) = mat(k,1578) + rxt(k,262)*y(k,228) + mat(k,290) = .350_r8*rxt(k,316)*y(k,228) + mat(k,557) = .130_r8*rxt(k,318)*y(k,136) + mat(k,268) = rxt(k,323)*y(k,228) + mat(k,1148) = .280_r8*rxt(k,347)*y(k,136) + mat(k,1995) = mat(k,1995) + rxt(k,250)*y(k,17) + rxt(k,214)*y(k,56) & + + rxt(k,295)*y(k,126) + rxt(k,296)*y(k,134) + mat(k,608) = rxt(k,279)*y(k,56) + rxt(k,280)*y(k,228) + mat(k,376) = rxt(k,282)*y(k,56) + rxt(k,283)*y(k,228) + mat(k,106) = rxt(k,329)*y(k,228) + mat(k,827) = rxt(k,302)*y(k,228) + mat(k,2260) = rxt(k,311)*y(k,224) + mat(k,2171) = mat(k,2171) + rxt(k,214)*y(k,42) + rxt(k,279)*y(k,43) & + + rxt(k,282)*y(k,46) + rxt(k,217)*y(k,79) + mat(k,1604) = mat(k,1604) + rxt(k,221)*y(k,201) + rxt(k,232)*y(k,228) + mat(k,1163) = rxt(k,314)*y(k,228) + mat(k,198) = .730_r8*rxt(k,449)*y(k,228) + mat(k,315) = .500_r8*rxt(k,517)*y(k,228) + mat(k,1170) = rxt(k,340)*y(k,228) + mat(k,1058) = rxt(k,341)*y(k,228) + mat(k,2125) = mat(k,2125) + rxt(k,175)*y(k,135) + mat(k,587) = rxt(k,217)*y(k,56) + rxt(k,171)*y(k,134) + rxt(k,180)*y(k,228) + mat(k,185) = rxt(k,305)*y(k,228) + mat(k,922) = rxt(k,306)*y(k,228) + mat(k,2368) = mat(k,2368) + .070_r8*rxt(k,450)*y(k,202) + .160_r8*rxt(k,453) & + *y(k,214) + .330_r8*rxt(k,456)*y(k,216) + mat(k,1205) = rxt(k,371)*y(k,228) + mat(k,1213) = rxt(k,356)*y(k,228) + mat(k,890) = .370_r8*rxt(k,425)*y(k,136) + mat(k,597) = .300_r8*rxt(k,416)*y(k,228) + mat(k,565) = rxt(k,417)*y(k,228) + mat(k,408) = rxt(k,424)*y(k,228) + mat(k,1278) = .140_r8*rxt(k,378)*y(k,136) + mat(k,320) = .200_r8*rxt(k,380)*y(k,228) + mat(k,619) = .500_r8*rxt(k,391)*y(k,228) + mat(k,1035) = .570_r8*rxt(k,483)*y(k,136) + mat(k,1389) = .280_r8*rxt(k,392)*y(k,136) + mat(k,432) = rxt(k,428)*y(k,228) + mat(k,1100) = rxt(k,429)*y(k,228) + mat(k,1924) = mat(k,1924) + rxt(k,398)*y(k,192) + rxt(k,440)*y(k,194) & + + rxt(k,445)*y(k,196) + rxt(k,322)*y(k,197) + rxt(k,350) & + *y(k,198) + rxt(k,301)*y(k,201) + .170_r8*rxt(k,451)*y(k,202) & + + rxt(k,369)*y(k,204) + .250_r8*rxt(k,337)*y(k,206) + rxt(k,309) & + *y(k,207) + .920_r8*rxt(k,408)*y(k,208) + .920_r8*rxt(k,414) & + *y(k,209) + rxt(k,422)*y(k,210) + .470_r8*rxt(k,376)*y(k,213) & + + .400_r8*rxt(k,454)*y(k,214) + .830_r8*rxt(k,457)*y(k,216) & + + rxt(k,460)*y(k,230) + rxt(k,359)*y(k,231) + .900_r8*rxt(k,492) & + *y(k,233) + .800_r8*rxt(k,497)*y(k,234) + rxt(k,467)*y(k,235) & + + rxt(k,433)*y(k,237) + rxt(k,473)*y(k,238) + rxt(k,476) & + *y(k,240) + mat(k,1664) = mat(k,1664) + rxt(k,295)*y(k,42) + rxt(k,409)*y(k,208) & + + rxt(k,415)*y(k,209) + rxt(k,423)*y(k,210) + .470_r8*rxt(k,375) & + *y(k,213) + rxt(k,201)*y(k,228) + rxt(k,434)*y(k,237) + mat(k,2104) = mat(k,2104) + rxt(k,296)*y(k,42) + rxt(k,171)*y(k,79) + mat(k,1554) = rxt(k,175)*y(k,76) + rxt(k,339)*y(k,205) + mat(k,2235) = mat(k,2235) + .570_r8*rxt(k,480)*y(k,6) + .130_r8*rxt(k,318) & + *y(k,25) + .280_r8*rxt(k,347)*y(k,29) + .370_r8*rxt(k,425) & + *y(k,99) + .140_r8*rxt(k,378)*y(k,105) + .570_r8*rxt(k,483) & + *y(k,110) + .280_r8*rxt(k,392)*y(k,111) + rxt(k,183)*y(k,228) + mat(k,174) = .800_r8*rxt(k,461)*y(k,228) + mat(k,951) = rxt(k,507)*y(k,228) + mat(k,1126) = .200_r8*rxt(k,501)*y(k,228) + mat(k,193) = .280_r8*rxt(k,469)*y(k,228) + mat(k,215) = .380_r8*rxt(k,471)*y(k,228) + mat(k,220) = .630_r8*rxt(k,477)*y(k,228) + mat(k,1051) = mat(k,1051) + rxt(k,398)*y(k,124) + mat(k,501) = mat(k,501) + rxt(k,440)*y(k,124) + mat(k,440) = mat(k,440) + rxt(k,445)*y(k,124) + mat(k,908) = mat(k,908) + rxt(k,322)*y(k,124) + 2.400_r8*rxt(k,319)*y(k,197) & + + rxt(k,320)*y(k,201) + mat(k,943) = mat(k,943) + rxt(k,350)*y(k,124) + rxt(k,348)*y(k,201) + mat(k,1439) = mat(k,1439) + .900_r8*rxt(k,331)*y(k,201) + rxt(k,405)*y(k,208) & + + rxt(k,410)*y(k,209) + rxt(k,419)*y(k,210) + .470_r8*rxt(k,372) & + *y(k,213) + rxt(k,430)*y(k,237) + mat(k,2420) = mat(k,2420) + rxt(k,221)*y(k,59) + rxt(k,301)*y(k,124) & + + rxt(k,320)*y(k,197) + rxt(k,348)*y(k,198) + .900_r8*rxt(k,331) & + *y(k,200) + 4.000_r8*rxt(k,298)*y(k,201) + rxt(k,406)*y(k,208) & + + rxt(k,411)*y(k,209) + 1.200_r8*rxt(k,420)*y(k,210) & + + .730_r8*rxt(k,373)*y(k,213) + rxt(k,382)*y(k,215) & + + .500_r8*rxt(k,485)*y(k,223) + .300_r8*rxt(k,361)*y(k,232) & + + rxt(k,490)*y(k,233) + rxt(k,495)*y(k,234) + .800_r8*rxt(k,431) & + *y(k,237) + mat(k,784) = mat(k,784) + .070_r8*rxt(k,450)*y(k,90) + .170_r8*rxt(k,451) & + *y(k,124) + mat(k,581) = rxt(k,369)*y(k,124) + mat(k,464) = rxt(k,339)*y(k,135) + mat(k,804) = mat(k,804) + .250_r8*rxt(k,337)*y(k,124) + mat(k,446) = mat(k,446) + rxt(k,309)*y(k,124) + mat(k,1312) = mat(k,1312) + .920_r8*rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126) & + + rxt(k,405)*y(k,200) + rxt(k,406)*y(k,201) + mat(k,1345) = mat(k,1345) + .920_r8*rxt(k,414)*y(k,124) + rxt(k,415)*y(k,126) & + + rxt(k,410)*y(k,200) + rxt(k,411)*y(k,201) + mat(k,1265) = mat(k,1265) + rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126) & + + rxt(k,419)*y(k,200) + 1.200_r8*rxt(k,420)*y(k,201) + mat(k,1366) = mat(k,1366) + .470_r8*rxt(k,376)*y(k,124) + .470_r8*rxt(k,375) & + *y(k,126) + .470_r8*rxt(k,372)*y(k,200) + .730_r8*rxt(k,373) & + *y(k,201) + mat(k,745) = mat(k,745) + .160_r8*rxt(k,453)*y(k,90) + .400_r8*rxt(k,454) & + *y(k,124) + mat(k,1407) = mat(k,1407) + rxt(k,382)*y(k,201) + mat(k,917) = mat(k,917) + .330_r8*rxt(k,456)*y(k,90) + .830_r8*rxt(k,457) & + *y(k,124) + mat(k,1116) = mat(k,1116) + .500_r8*rxt(k,485)*y(k,201) + mat(k,2038) = rxt(k,311)*y(k,54) + mat(k,1829) = mat(k,1829) + .650_r8*rxt(k,438)*y(k,7) + rxt(k,262)*y(k,19) & + + .350_r8*rxt(k,316)*y(k,24) + rxt(k,323)*y(k,26) + rxt(k,280) & + *y(k,43) + rxt(k,283)*y(k,46) + rxt(k,329)*y(k,47) + rxt(k,302) & + *y(k,52) + rxt(k,232)*y(k,59) + rxt(k,314)*y(k,62) & + + .730_r8*rxt(k,449)*y(k,66) + .500_r8*rxt(k,517)*y(k,67) & + + rxt(k,340)*y(k,74) + rxt(k,341)*y(k,75) + rxt(k,180)*y(k,79) & + + rxt(k,305)*y(k,86) + rxt(k,306)*y(k,87) + rxt(k,371)*y(k,94) & + + rxt(k,356)*y(k,96) + .300_r8*rxt(k,416)*y(k,100) + rxt(k,417) & + *y(k,101) + rxt(k,424)*y(k,102) + .200_r8*rxt(k,380)*y(k,106) & + + .500_r8*rxt(k,391)*y(k,109) + rxt(k,428)*y(k,115) + rxt(k,429) & + *y(k,116) + rxt(k,201)*y(k,126) + rxt(k,183)*y(k,136) & + + .800_r8*rxt(k,461)*y(k,144) + rxt(k,507)*y(k,153) & + + .200_r8*rxt(k,501)*y(k,181) + .280_r8*rxt(k,469)*y(k,183) & + + .380_r8*rxt(k,471)*y(k,185) + .630_r8*rxt(k,477)*y(k,187) + mat(k,453) = mat(k,453) + rxt(k,460)*y(k,124) + mat(k,822) = mat(k,822) + rxt(k,359)*y(k,124) + mat(k,1224) = mat(k,1224) + .300_r8*rxt(k,361)*y(k,201) + mat(k,1187) = mat(k,1187) + .900_r8*rxt(k,492)*y(k,124) + rxt(k,490)*y(k,201) + mat(k,1070) = mat(k,1070) + .800_r8*rxt(k,497)*y(k,124) + rxt(k,495)*y(k,201) + mat(k,760) = mat(k,760) + rxt(k,467)*y(k,124) + mat(k,1242) = mat(k,1242) + rxt(k,433)*y(k,124) + rxt(k,434)*y(k,126) & + + rxt(k,430)*y(k,200) + .800_r8*rxt(k,431)*y(k,201) + mat(k,777) = mat(k,777) + rxt(k,473)*y(k,124) + mat(k,516) = mat(k,516) + rxt(k,476)*y(k,124) + 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,472) = -(rxt(k,187)*y(k,228)) + mat(k,1733) = -rxt(k,187)*y(k,91) + mat(k,2296) = rxt(k,208)*y(k,125) + mat(k,1931) = rxt(k,208)*y(k,90) + mat(k,787) = -(rxt(k,265)*y(k,134) + (rxt(k,570) + rxt(k,575)) * y(k,85)) + mat(k,2073) = -rxt(k,265)*y(k,92) + mat(k,1492) = -(rxt(k,570) + rxt(k,575)) * y(k,92) + mat(k,1559) = rxt(k,257)*y(k,90) + mat(k,2316) = rxt(k,257)*y(k,19) + mat(k,837) = -(rxt(k,236)*y(k,56) + rxt(k,237)*y(k,134) + rxt(k,238)*y(k,228) & + + (rxt(k,563) + rxt(k,569) + rxt(k,574)) * y(k,85)) + mat(k,2139) = -rxt(k,236)*y(k,93) + mat(k,2076) = -rxt(k,237)*y(k,93) + mat(k,1770) = -rxt(k,238)*y(k,93) + mat(k,1493) = -(rxt(k,563) + rxt(k,569) + rxt(k,574)) * y(k,93) + mat(k,1584) = rxt(k,225)*y(k,90) + mat(k,954) = rxt(k,230)*y(k,228) + mat(k,2320) = rxt(k,225)*y(k,59) + mat(k,1770) = mat(k,1770) + rxt(k,230)*y(k,60) + mat(k,1195) = -(rxt(k,371)*y(k,228)) + mat(k,1796) = -rxt(k,371)*y(k,94) + mat(k,591) = .300_r8*rxt(k,416)*y(k,228) + mat(k,561) = .500_r8*rxt(k,417)*y(k,228) + mat(k,1894) = rxt(k,370)*y(k,204) + rxt(k,377)*y(k,213) + mat(k,577) = rxt(k,370)*y(k,124) + mat(k,1352) = rxt(k,377)*y(k,124) + mat(k,1796) = mat(k,1796) + .300_r8*rxt(k,416)*y(k,100) + .500_r8*rxt(k,417) & + *y(k,101) + mat(k,221) = -(rxt(k,402)*y(k,228)) + mat(k,1695) = -rxt(k,402)*y(k,95) + mat(k,1208) = -(rxt(k,356)*y(k,228)) + mat(k,1797) = -rxt(k,356)*y(k,96) + mat(k,592) = .700_r8*rxt(k,416)*y(k,228) + mat(k,562) = .500_r8*rxt(k,417)*y(k,228) + mat(k,612) = .500_r8*rxt(k,391)*y(k,228) + mat(k,1895) = .050_r8*rxt(k,414)*y(k,209) + .220_r8*rxt(k,376)*y(k,213) & + + .250_r8*rxt(k,433)*y(k,237) + mat(k,1634) = .050_r8*rxt(k,415)*y(k,209) + .220_r8*rxt(k,375)*y(k,213) & + + .250_r8*rxt(k,434)*y(k,237) + mat(k,545) = .500_r8*rxt(k,360)*y(k,228) + mat(k,1418) = .220_r8*rxt(k,372)*y(k,213) + .250_r8*rxt(k,430)*y(k,237) + mat(k,2392) = .230_r8*rxt(k,373)*y(k,213) + .200_r8*rxt(k,361)*y(k,232) & + + .100_r8*rxt(k,431)*y(k,237) + mat(k,1327) = .050_r8*rxt(k,414)*y(k,124) + .050_r8*rxt(k,415)*y(k,126) + mat(k,1353) = .220_r8*rxt(k,376)*y(k,124) + .220_r8*rxt(k,375)*y(k,126) & + + .220_r8*rxt(k,372)*y(k,200) + .230_r8*rxt(k,373)*y(k,201) + mat(k,1797) = mat(k,1797) + .700_r8*rxt(k,416)*y(k,100) + .500_r8*rxt(k,417) & + *y(k,101) + .500_r8*rxt(k,391)*y(k,109) + .500_r8*rxt(k,360) & + *y(k,148) + mat(k,1216) = .200_r8*rxt(k,361)*y(k,201) + mat(k,1232) = .250_r8*rxt(k,433)*y(k,124) + .250_r8*rxt(k,434)*y(k,126) & + + .250_r8*rxt(k,430)*y(k,200) + .100_r8*rxt(k,431)*y(k,201) + mat(k,326) = -(rxt(k,403)*y(k,228)) + mat(k,1713) = -rxt(k,403)*y(k,97) + mat(k,1847) = .870_r8*rxt(k,414)*y(k,209) + mat(k,1611) = .950_r8*rxt(k,415)*y(k,209) + mat(k,1410) = rxt(k,410)*y(k,209) + mat(k,2372) = .750_r8*rxt(k,411)*y(k,209) + mat(k,1316) = .870_r8*rxt(k,414)*y(k,124) + .950_r8*rxt(k,415)*y(k,126) & + + rxt(k,410)*y(k,200) + .750_r8*rxt(k,411)*y(k,201) + mat(k,133) = -(rxt(k,404)*y(k,228)) + mat(k,1684) = -rxt(k,404)*y(k,98) + mat(k,710) = .600_r8*rxt(k,427)*y(k,228) + mat(k,1684) = mat(k,1684) + .600_r8*rxt(k,427)*y(k,103) + mat(k,876) = -(rxt(k,418)*y(k,126) + rxt(k,425)*y(k,136) + rxt(k,426) & + *y(k,228)) + mat(k,1614) = -rxt(k,418)*y(k,99) + mat(k,2189) = -rxt(k,425)*y(k,99) + mat(k,1771) = -rxt(k,426)*y(k,99) + mat(k,589) = -(rxt(k,416)*y(k,228)) + mat(k,1746) = -rxt(k,416)*y(k,100) + mat(k,1861) = .080_r8*rxt(k,408)*y(k,208) + mat(k,1289) = .080_r8*rxt(k,408)*y(k,124) + mat(k,558) = -(rxt(k,417)*y(k,228)) + mat(k,1743) = -rxt(k,417)*y(k,101) + mat(k,1859) = .080_r8*rxt(k,414)*y(k,209) + mat(k,1317) = .080_r8*rxt(k,414)*y(k,124) + mat(k,403) = -(rxt(k,424)*y(k,228)) + mat(k,1723) = -rxt(k,424)*y(k,102) + mat(k,2285) = rxt(k,421)*y(k,210) + mat(k,1244) = rxt(k,421)*y(k,90) + mat(k,711) = -(rxt(k,427)*y(k,228)) + mat(k,1759) = -rxt(k,427)*y(k,103) + mat(k,2310) = rxt(k,407)*y(k,208) + rxt(k,412)*y(k,209) + mat(k,1290) = rxt(k,407)*y(k,90) + mat(k,1319) = rxt(k,412)*y(k,90) + mat(k,76) = -(rxt(k,549)*y(k,228)) + mat(k,1677) = -rxt(k,549)*y(k,104) + mat(k,1269) = -(rxt(k,378)*y(k,136) + rxt(k,379)*y(k,228)) + mat(k,2209) = -rxt(k,378)*y(k,105) + mat(k,1801) = -rxt(k,379)*y(k,105) + mat(k,881) = .300_r8*rxt(k,425)*y(k,136) + mat(k,1899) = .360_r8*rxt(k,408)*y(k,208) + mat(k,1638) = .400_r8*rxt(k,409)*y(k,208) + mat(k,2209) = mat(k,2209) + .300_r8*rxt(k,425)*y(k,99) + mat(k,1421) = .390_r8*rxt(k,405)*y(k,208) + mat(k,2396) = .310_r8*rxt(k,406)*y(k,208) + mat(k,1297) = .360_r8*rxt(k,408)*y(k,124) + .400_r8*rxt(k,409)*y(k,126) & + + .390_r8*rxt(k,405)*y(k,200) + .310_r8*rxt(k,406)*y(k,201) + mat(k,316) = -(rxt(k,380)*y(k,228)) + mat(k,1711) = -rxt(k,380)*y(k,106) + mat(k,2278) = rxt(k,374)*y(k,213) + mat(k,1348) = rxt(k,374)*y(k,90) + mat(k,517) = -(rxt(k,389)*y(k,228)) + mat(k,1738) = -rxt(k,389)*y(k,107) + mat(k,1857) = .800_r8*rxt(k,398)*y(k,192) + mat(k,1037) = .800_r8*rxt(k,398)*y(k,124) + mat(k,321) = -(rxt(k,390)*y(k,228)) + mat(k,1712) = -rxt(k,390)*y(k,108) + mat(k,2279) = .800_r8*rxt(k,387)*y(k,217) + mat(k,697) = .800_r8*rxt(k,387)*y(k,90) + mat(k,611) = -(rxt(k,391)*y(k,228)) + mat(k,1749) = -rxt(k,391)*y(k,109) + mat(k,1935) = rxt(k,394)*y(k,215) + mat(k,1392) = rxt(k,394)*y(k,125) + mat(k,1018) = -(rxt(k,482)*y(k,126) + rxt(k,483)*y(k,136) + rxt(k,484) & + *y(k,228)) + mat(k,1619) = -rxt(k,482)*y(k,110) + mat(k,2193) = -rxt(k,483)*y(k,110) + mat(k,1782) = -rxt(k,484)*y(k,110) + mat(k,1376) = -(rxt(k,392)*y(k,136) + rxt(k,393)*y(k,228)) + mat(k,2214) = -rxt(k,392)*y(k,111) + mat(k,1806) = -rxt(k,393)*y(k,111) + mat(k,884) = .200_r8*rxt(k,425)*y(k,136) + mat(k,1904) = .560_r8*rxt(k,408)*y(k,208) + mat(k,1643) = .600_r8*rxt(k,409)*y(k,208) + mat(k,2214) = mat(k,2214) + .200_r8*rxt(k,425)*y(k,99) + mat(k,1426) = .610_r8*rxt(k,405)*y(k,208) + mat(k,2401) = .440_r8*rxt(k,406)*y(k,208) + mat(k,1301) = .560_r8*rxt(k,408)*y(k,124) + .600_r8*rxt(k,409)*y(k,126) & + + .610_r8*rxt(k,405)*y(k,200) + .440_r8*rxt(k,406)*y(k,201) + mat(k,999) = -(rxt(k,190)*y(k,124) + (rxt(k,191) + rxt(k,192) + rxt(k,193) & + ) * y(k,125) + rxt(k,194)*y(k,135) + rxt(k,202)*y(k,228) & + + rxt(k,588)*y(k,227)) + mat(k,1881) = -rxt(k,190)*y(k,112) + mat(k,1943) = -(rxt(k,191) + rxt(k,192) + rxt(k,193)) * y(k,112) + mat(k,1536) = -rxt(k,194)*y(k,112) + mat(k,1781) = -rxt(k,202)*y(k,112) + mat(k,855) = -rxt(k,588)*y(k,112) + mat(k,2082) = rxt(k,188)*y(k,219) + rxt(k,585)*y(k,222) + mat(k,1536) = mat(k,1536) + rxt(k,586)*y(k,222) + mat(k,866) = 1.100_r8*rxt(k,581)*y(k,220) + .200_r8*rxt(k,579)*y(k,221) + mat(k,530) = rxt(k,188)*y(k,134) + mat(k,681) = 1.100_r8*rxt(k,581)*y(k,203) + mat(k,847) = .200_r8*rxt(k,579)*y(k,203) + mat(k,506) = rxt(k,585)*y(k,134) + rxt(k,586)*y(k,135) + mat(k,256) = -((rxt(k,206) + rxt(k,207)) * y(k,224)) + mat(k,2013) = -(rxt(k,206) + rxt(k,207)) * y(k,113) + mat(k,993) = rxt(k,191)*y(k,125) + mat(k,1928) = rxt(k,191)*y(k,112) + mat(k,1929) = rxt(k,209)*y(k,126) + mat(k,1609) = rxt(k,209)*y(k,125) + mat(k,427) = -(rxt(k,428)*y(k,228)) + mat(k,1727) = -rxt(k,428)*y(k,115) + mat(k,2373) = .200_r8*rxt(k,420)*y(k,210) + mat(k,1245) = .200_r8*rxt(k,420)*y(k,201) + mat(k,1090) = -(rxt(k,429)*y(k,228)) + mat(k,1788) = -rxt(k,429)*y(k,116) + mat(k,1887) = rxt(k,422)*y(k,210) + mat(k,1625) = rxt(k,423)*y(k,210) + mat(k,1415) = rxt(k,419)*y(k,210) + mat(k,2385) = .800_r8*rxt(k,420)*y(k,210) + mat(k,1249) = rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126) + rxt(k,419)*y(k,200) & + + .800_r8*rxt(k,420)*y(k,201) + mat(k,98) = -(rxt(k,519)*y(k,228)) + mat(k,1681) = -rxt(k,519)*y(k,120) + mat(k,1914) = -(rxt(k,190)*y(k,112) + rxt(k,199)*y(k,126) + rxt(k,203) & + *y(k,90) + rxt(k,204)*y(k,136) + rxt(k,205)*y(k,134) + rxt(k,226) & + *y(k,59) + rxt(k,258)*y(k,19) + rxt(k,301)*y(k,201) + rxt(k,309) & + *y(k,207) + rxt(k,322)*y(k,197) + rxt(k,333)*y(k,200) + rxt(k,337) & + *y(k,206) + rxt(k,350)*y(k,198) + rxt(k,359)*y(k,231) + rxt(k,363) & + *y(k,232) + (rxt(k,369) + rxt(k,370)) * y(k,204) + (rxt(k,376) & + + rxt(k,377)) * y(k,213) + rxt(k,385)*y(k,215) + rxt(k,388) & + *y(k,217) + (rxt(k,398) + rxt(k,399)) * y(k,192) + rxt(k,408) & + *y(k,208) + rxt(k,414)*y(k,209) + rxt(k,422)*y(k,210) + rxt(k,433) & + *y(k,237) + rxt(k,437)*y(k,191) + rxt(k,440)*y(k,194) + rxt(k,445) & + *y(k,196) + rxt(k,447)*y(k,199) + rxt(k,451)*y(k,202) + rxt(k,454) & + *y(k,214) + rxt(k,457)*y(k,216) + rxt(k,460)*y(k,230) + rxt(k,467) & + *y(k,235) + rxt(k,473)*y(k,238) + rxt(k,476)*y(k,240) + rxt(k,487) & + *y(k,223) + rxt(k,492)*y(k,233) + rxt(k,497)*y(k,234) + rxt(k,590) & + *y(k,227)) + mat(k,1004) = -rxt(k,190)*y(k,124) + mat(k,1654) = -rxt(k,199)*y(k,124) + mat(k,2358) = -rxt(k,203)*y(k,124) + mat(k,2225) = -rxt(k,204)*y(k,124) + mat(k,2094) = -rxt(k,205)*y(k,124) + mat(k,1595) = -rxt(k,226)*y(k,124) + mat(k,1569) = -rxt(k,258)*y(k,124) + mat(k,2410) = -rxt(k,301)*y(k,124) + mat(k,443) = -rxt(k,309)*y(k,124) + mat(k,905) = -rxt(k,322)*y(k,124) + mat(k,1433) = -rxt(k,333)*y(k,124) + mat(k,801) = -rxt(k,337)*y(k,124) + mat(k,940) = -rxt(k,350)*y(k,124) + mat(k,819) = -rxt(k,359)*y(k,124) + mat(k,1221) = -rxt(k,363)*y(k,124) + mat(k,578) = -(rxt(k,369) + rxt(k,370)) * y(k,124) + mat(k,1362) = -(rxt(k,376) + rxt(k,377)) * y(k,124) + mat(k,1402) = -rxt(k,385)*y(k,124) + mat(k,702) = -rxt(k,388)*y(k,124) + mat(k,1048) = -(rxt(k,398) + rxt(k,399)) * y(k,124) + mat(k,1307) = -rxt(k,408)*y(k,124) + mat(k,1340) = -rxt(k,414)*y(k,124) + mat(k,1261) = -rxt(k,422)*y(k,124) + mat(k,1239) = -rxt(k,433)*y(k,124) + mat(k,526) = -rxt(k,437)*y(k,124) + mat(k,499) = -rxt(k,440)*y(k,124) + mat(k,438) = -rxt(k,445)*y(k,124) + mat(k,637) = -rxt(k,447)*y(k,124) + mat(k,782) = -rxt(k,451)*y(k,124) + mat(k,743) = -rxt(k,454)*y(k,124) + mat(k,915) = -rxt(k,457)*y(k,124) + mat(k,451) = -rxt(k,460)*y(k,124) + mat(k,758) = -rxt(k,467)*y(k,124) + mat(k,775) = -rxt(k,473)*y(k,124) + mat(k,514) = -rxt(k,476)*y(k,124) + mat(k,1112) = -rxt(k,487)*y(k,124) + mat(k,1183) = -rxt(k,492)*y(k,124) + mat(k,1066) = -rxt(k,497)*y(k,124) + mat(k,857) = -rxt(k,590)*y(k,124) + mat(k,1004) = mat(k,1004) + 2.000_r8*rxt(k,192)*y(k,125) + rxt(k,194) & + *y(k,135) + rxt(k,202)*y(k,228) + mat(k,258) = 2.000_r8*rxt(k,206)*y(k,224) + mat(k,1959) = 2.000_r8*rxt(k,192)*y(k,112) + rxt(k,195)*y(k,134) + rxt(k,512) & + *y(k,152) + mat(k,2094) = mat(k,2094) + rxt(k,195)*y(k,125) + mat(k,1546) = rxt(k,194)*y(k,112) + rxt(k,189)*y(k,219) + mat(k,1482) = rxt(k,512)*y(k,125) + mat(k,532) = rxt(k,189)*y(k,135) + mat(k,2028) = 2.000_r8*rxt(k,206)*y(k,113) + mat(k,1819) = rxt(k,202)*y(k,112) + 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,1960) = -((rxt(k,191) + rxt(k,192) + rxt(k,193)) * y(k,112) + (rxt(k,195) & + + rxt(k,197)) * y(k,134) + rxt(k,196)*y(k,136) + rxt(k,208) & + *y(k,90) + rxt(k,209)*y(k,126) + rxt(k,210)*y(k,228) + rxt(k,228) & + *y(k,59) + rxt(k,259)*y(k,19) + rxt(k,344)*y(k,200) + rxt(k,394) & + *y(k,215) + rxt(k,452)*y(k,202) + rxt(k,455)*y(k,214) + rxt(k,458) & + *y(k,216) + rxt(k,462)*y(k,143) + rxt(k,465)*y(k,191) + rxt(k,512) & + *y(k,152)) + mat(k,1005) = -(rxt(k,191) + rxt(k,192) + rxt(k,193)) * y(k,125) + mat(k,2095) = -(rxt(k,195) + rxt(k,197)) * y(k,125) + mat(k,2226) = -rxt(k,196)*y(k,125) + mat(k,2359) = -rxt(k,208)*y(k,125) + mat(k,1655) = -rxt(k,209)*y(k,125) + mat(k,1820) = -rxt(k,210)*y(k,125) + mat(k,1596) = -rxt(k,228)*y(k,125) + mat(k,1570) = -rxt(k,259)*y(k,125) + mat(k,1434) = -rxt(k,344)*y(k,125) + mat(k,1403) = -rxt(k,394)*y(k,125) + mat(k,783) = -rxt(k,452)*y(k,125) + mat(k,744) = -rxt(k,455)*y(k,125) + mat(k,916) = -rxt(k,458)*y(k,125) + mat(k,470) = -rxt(k,462)*y(k,125) + mat(k,527) = -rxt(k,465)*y(k,125) + mat(k,1483) = -rxt(k,512)*y(k,125) + mat(k,649) = rxt(k,396)*y(k,228) + mat(k,361) = rxt(k,367)*y(k,126) + mat(k,1570) = mat(k,1570) + rxt(k,258)*y(k,124) + mat(k,1596) = mat(k,1596) + rxt(k,226)*y(k,124) + mat(k,2359) = mat(k,2359) + rxt(k,203)*y(k,124) + rxt(k,198)*y(k,126) + mat(k,476) = rxt(k,187)*y(k,228) + mat(k,594) = .700_r8*rxt(k,416)*y(k,228) + mat(k,1915) = rxt(k,258)*y(k,19) + rxt(k,226)*y(k,59) + rxt(k,203)*y(k,90) & + + 2.000_r8*rxt(k,199)*y(k,126) + rxt(k,205)*y(k,134) & + + rxt(k,204)*y(k,136) + rxt(k,437)*y(k,191) + rxt(k,398) & + *y(k,192) + rxt(k,440)*y(k,194) + rxt(k,445)*y(k,196) & + + rxt(k,322)*y(k,197) + rxt(k,350)*y(k,198) + rxt(k,447) & + *y(k,199) + rxt(k,333)*y(k,200) + rxt(k,301)*y(k,201) & + + rxt(k,451)*y(k,202) + rxt(k,369)*y(k,204) + rxt(k,337) & + *y(k,206) + rxt(k,309)*y(k,207) + .920_r8*rxt(k,408)*y(k,208) & + + .920_r8*rxt(k,414)*y(k,209) + rxt(k,422)*y(k,210) + rxt(k,376) & + *y(k,213) + rxt(k,454)*y(k,214) + rxt(k,385)*y(k,215) & + + rxt(k,457)*y(k,216) + rxt(k,388)*y(k,217) & + + 1.600_r8*rxt(k,487)*y(k,223) + rxt(k,460)*y(k,230) & + + rxt(k,359)*y(k,231) + rxt(k,363)*y(k,232) + .900_r8*rxt(k,492) & + *y(k,233) + .800_r8*rxt(k,497)*y(k,234) + rxt(k,467)*y(k,235) & + + rxt(k,433)*y(k,237) + rxt(k,473)*y(k,238) + rxt(k,476) & + *y(k,240) + mat(k,1655) = mat(k,1655) + rxt(k,367)*y(k,16) + rxt(k,198)*y(k,90) & + + 2.000_r8*rxt(k,199)*y(k,124) + rxt(k,200)*y(k,134) & + + rxt(k,409)*y(k,208) + rxt(k,415)*y(k,209) + rxt(k,423) & + *y(k,210) + rxt(k,375)*y(k,213) + rxt(k,386)*y(k,215) & + + 2.000_r8*rxt(k,488)*y(k,223) + rxt(k,201)*y(k,228) & + + rxt(k,434)*y(k,237) + mat(k,896) = rxt(k,357)*y(k,228) + mat(k,2095) = mat(k,2095) + rxt(k,205)*y(k,124) + rxt(k,200)*y(k,126) + mat(k,2226) = mat(k,2226) + rxt(k,204)*y(k,124) + mat(k,630) = rxt(k,494)*y(k,228) + mat(k,527) = mat(k,527) + rxt(k,437)*y(k,124) + mat(k,1049) = rxt(k,398)*y(k,124) + mat(k,500) = rxt(k,440)*y(k,124) + mat(k,439) = rxt(k,445)*y(k,124) + mat(k,906) = rxt(k,322)*y(k,124) + mat(k,941) = rxt(k,350)*y(k,124) + mat(k,638) = rxt(k,447)*y(k,124) + mat(k,1434) = mat(k,1434) + rxt(k,333)*y(k,124) + mat(k,2411) = rxt(k,301)*y(k,124) + .500_r8*rxt(k,485)*y(k,223) + mat(k,783) = mat(k,783) + rxt(k,451)*y(k,124) + mat(k,579) = rxt(k,369)*y(k,124) + mat(k,802) = rxt(k,337)*y(k,124) + mat(k,444) = rxt(k,309)*y(k,124) + mat(k,1308) = .920_r8*rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126) + mat(k,1341) = .920_r8*rxt(k,414)*y(k,124) + rxt(k,415)*y(k,126) + mat(k,1262) = rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126) + mat(k,1363) = rxt(k,376)*y(k,124) + rxt(k,375)*y(k,126) + mat(k,744) = mat(k,744) + rxt(k,454)*y(k,124) + mat(k,1403) = mat(k,1403) + rxt(k,385)*y(k,124) + rxt(k,386)*y(k,126) + mat(k,916) = mat(k,916) + rxt(k,457)*y(k,124) + mat(k,703) = rxt(k,388)*y(k,124) + mat(k,1113) = 1.600_r8*rxt(k,487)*y(k,124) + 2.000_r8*rxt(k,488)*y(k,126) & + + .500_r8*rxt(k,485)*y(k,201) + mat(k,1820) = mat(k,1820) + rxt(k,396)*y(k,1) + rxt(k,187)*y(k,91) & + + .700_r8*rxt(k,416)*y(k,100) + rxt(k,201)*y(k,126) + rxt(k,357) & + *y(k,127) + rxt(k,494)*y(k,178) + mat(k,452) = rxt(k,460)*y(k,124) + mat(k,820) = rxt(k,359)*y(k,124) + mat(k,1222) = rxt(k,363)*y(k,124) + mat(k,1184) = .900_r8*rxt(k,492)*y(k,124) + mat(k,1067) = .800_r8*rxt(k,497)*y(k,124) + mat(k,759) = rxt(k,467)*y(k,124) + mat(k,1240) = rxt(k,433)*y(k,124) + rxt(k,434)*y(k,126) + mat(k,776) = rxt(k,473)*y(k,124) + mat(k,515) = rxt(k,476)*y(k,124) + mat(k,1652) = -(rxt(k,198)*y(k,90) + rxt(k,199)*y(k,124) + rxt(k,200) & + *y(k,134) + rxt(k,201)*y(k,228) + rxt(k,209)*y(k,125) + rxt(k,295) & + *y(k,42) + rxt(k,327)*y(k,45) + rxt(k,346)*y(k,29) + rxt(k,353) & + *y(k,49) + rxt(k,367)*y(k,16) + rxt(k,375)*y(k,213) + rxt(k,386) & + *y(k,215) + rxt(k,409)*y(k,208) + rxt(k,415)*y(k,209) + rxt(k,418) & + *y(k,99) + rxt(k,423)*y(k,210) + rxt(k,434)*y(k,237) + rxt(k,479) & + *y(k,6) + rxt(k,482)*y(k,110) + rxt(k,488)*y(k,223) + rxt(k,499) & + *y(k,180) + rxt(k,502)*y(k,67)) + mat(k,2356) = -rxt(k,198)*y(k,126) + mat(k,1912) = -rxt(k,199)*y(k,126) + mat(k,2092) = -rxt(k,200)*y(k,126) + mat(k,1817) = -rxt(k,201)*y(k,126) + mat(k,1957) = -rxt(k,209)*y(k,126) + mat(k,1983) = -rxt(k,295)*y(k,126) + mat(k,1154) = -rxt(k,327)*y(k,126) + mat(k,1141) = -rxt(k,346)*y(k,126) + mat(k,1284) = -rxt(k,353)*y(k,126) + mat(k,359) = -rxt(k,367)*y(k,126) + mat(k,1360) = -rxt(k,375)*y(k,126) + mat(k,1400) = -rxt(k,386)*y(k,126) + mat(k,1305) = -rxt(k,409)*y(k,126) + mat(k,1338) = -rxt(k,415)*y(k,126) + mat(k,886) = -rxt(k,418)*y(k,126) + mat(k,1259) = -rxt(k,423)*y(k,126) + mat(k,1237) = -rxt(k,434)*y(k,126) + mat(k,987) = -rxt(k,479)*y(k,126) + mat(k,1031) = -rxt(k,482)*y(k,126) + mat(k,1110) = -rxt(k,488)*y(k,126) + mat(k,1077) = -rxt(k,499)*y(k,126) + mat(k,312) = -rxt(k,502)*y(k,126) + mat(k,570) = rxt(k,260)*y(k,134) + mat(k,2159) = rxt(k,227)*y(k,60) + mat(k,958) = rxt(k,227)*y(k,56) + rxt(k,229)*y(k,134) + rxt(k,230)*y(k,228) + mat(k,927) = rxt(k,274)*y(k,89) + mat(k,2049) = rxt(k,274)*y(k,73) + rxt(k,211)*y(k,228) + mat(k,615) = .500_r8*rxt(k,391)*y(k,228) + mat(k,1957) = mat(k,1957) + rxt(k,197)*y(k,134) + rxt(k,196)*y(k,136) + mat(k,2092) = mat(k,2092) + rxt(k,260)*y(k,20) + rxt(k,229)*y(k,60) & + + rxt(k,197)*y(k,125) + mat(k,2223) = rxt(k,196)*y(k,125) + mat(k,537) = rxt(k,342)*y(k,228) + mat(k,1817) = mat(k,1817) + rxt(k,230)*y(k,60) + rxt(k,211)*y(k,89) & + + .500_r8*rxt(k,391)*y(k,109) + rxt(k,342)*y(k,141) + mat(k,892) = -(rxt(k,357)*y(k,228)) + mat(k,1772) = -rxt(k,357)*y(k,127) + mat(k,1131) = rxt(k,346)*y(k,126) + mat(k,559) = .500_r8*rxt(k,417)*y(k,228) + mat(k,405) = rxt(k,424)*y(k,228) + mat(k,428) = rxt(k,428)*y(k,228) + mat(k,1087) = rxt(k,429)*y(k,228) + mat(k,1615) = rxt(k,346)*y(k,29) + mat(k,1772) = mat(k,1772) + .500_r8*rxt(k,417)*y(k,101) + rxt(k,424)*y(k,102) & + + rxt(k,428)*y(k,115) + rxt(k,429)*y(k,116) + mat(k,391) = -(rxt(k,489)*y(k,228)) + mat(k,1721) = -rxt(k,489)*y(k,128) + mat(k,2283) = rxt(k,486)*y(k,223) + mat(k,1102) = rxt(k,486)*y(k,90) + mat(k,2099) = -(rxt(k,167)*y(k,136) + 4._r8*rxt(k,168)*y(k,134) + rxt(k,169) & + *y(k,135) + rxt(k,170)*y(k,77) + rxt(k,171)*y(k,79) + rxt(k,176) & + *y(k,90) + rxt(k,182)*y(k,228) + (rxt(k,195) + rxt(k,197) & + ) * y(k,125) + rxt(k,200)*y(k,126) + rxt(k,205)*y(k,124) & + + rxt(k,229)*y(k,60) + rxt(k,231)*y(k,59) + rxt(k,234)*y(k,85) & + + rxt(k,237)*y(k,93) + rxt(k,260)*y(k,20) + rxt(k,261)*y(k,19) & + + rxt(k,263)*y(k,81) + rxt(k,265)*y(k,92) + rxt(k,296)*y(k,42) & + + rxt(k,504)*y(k,139) + (rxt(k,583) + rxt(k,584)) * y(k,220) & + + rxt(k,585)*y(k,222)) + mat(k,2230) = -rxt(k,167)*y(k,134) + mat(k,1550) = -rxt(k,169)*y(k,134) + mat(k,1467) = -rxt(k,170)*y(k,134) + mat(k,585) = -rxt(k,171)*y(k,134) + mat(k,2363) = -rxt(k,176)*y(k,134) + mat(k,1824) = -rxt(k,182)*y(k,134) + mat(k,1964) = -(rxt(k,195) + rxt(k,197)) * y(k,134) + mat(k,1659) = -rxt(k,200)*y(k,134) + mat(k,1919) = -rxt(k,205)*y(k,134) + mat(k,962) = -rxt(k,229)*y(k,134) + mat(k,1600) = -rxt(k,231)*y(k,134) + mat(k,1504) = -rxt(k,234)*y(k,134) + mat(k,841) = -rxt(k,237)*y(k,134) + mat(k,573) = -rxt(k,260)*y(k,134) + mat(k,1574) = -rxt(k,261)*y(k,134) + mat(k,833) = -rxt(k,263)*y(k,134) + mat(k,792) = -rxt(k,265)*y(k,134) + mat(k,1990) = -rxt(k,296)*y(k,134) + mat(k,369) = -rxt(k,504)*y(k,134) + mat(k,685) = -(rxt(k,583) + rxt(k,584)) * y(k,134) + mat(k,508) = -rxt(k,585)*y(k,134) + mat(k,2120) = rxt(k,174)*y(k,90) + mat(k,2363) = mat(k,2363) + rxt(k,174)*y(k,76) + mat(k,1007) = rxt(k,190)*y(k,124) + rxt(k,191)*y(k,125) + rxt(k,194)*y(k,135) & + + rxt(k,588)*y(k,227) + mat(k,1919) = mat(k,1919) + rxt(k,190)*y(k,112) + mat(k,1964) = mat(k,1964) + rxt(k,191)*y(k,112) + mat(k,1550) = mat(k,1550) + rxt(k,194)*y(k,112) + rxt(k,506)*y(k,150) & + + rxt(k,513)*y(k,152) + rxt(k,587)*y(k,222) + (rxt(k,156) & + +rxt(k,157))*y(k,224) + rxt(k,593)*y(k,229) + mat(k,722) = rxt(k,506)*y(k,135) + mat(k,1484) = rxt(k,513)*y(k,135) + mat(k,872) = rxt(k,579)*y(k,221) + 1.150_r8*rxt(k,580)*y(k,227) + mat(k,851) = rxt(k,579)*y(k,203) + mat(k,508) = mat(k,508) + rxt(k,587)*y(k,135) + mat(k,2033) = (rxt(k,156)+rxt(k,157))*y(k,135) + mat(k,859) = rxt(k,588)*y(k,112) + 1.150_r8*rxt(k,580)*y(k,203) + mat(k,1824) = mat(k,1824) + 2.000_r8*rxt(k,184)*y(k,228) + mat(k,812) = rxt(k,593)*y(k,135) + mat(k,1542) = -(rxt(k,156)*y(k,224) + rxt(k,161)*y(k,225) + rxt(k,169) & + *y(k,134) + rxt(k,175)*y(k,76) + rxt(k,189)*y(k,219) + rxt(k,194) & + *y(k,112) + rxt(k,339)*y(k,205) + rxt(k,506)*y(k,150) + rxt(k,513) & + *y(k,152) + rxt(k,582)*y(k,220) + (rxt(k,586) + rxt(k,587) & + ) * y(k,222) + rxt(k,593)*y(k,229)) + mat(k,2023) = -rxt(k,156)*y(k,135) + mat(k,178) = -rxt(k,161)*y(k,135) + mat(k,2089) = -rxt(k,169)*y(k,135) + mat(k,2110) = -rxt(k,175)*y(k,135) + mat(k,531) = -rxt(k,189)*y(k,135) + mat(k,1002) = -rxt(k,194)*y(k,135) + mat(k,462) = -rxt(k,339)*y(k,135) + mat(k,720) = -rxt(k,506)*y(k,135) + mat(k,1478) = -rxt(k,513)*y(k,135) + mat(k,682) = -rxt(k,582)*y(k,135) + mat(k,507) = -(rxt(k,586) + rxt(k,587)) * y(k,135) + mat(k,811) = -rxt(k,593)*y(k,135) + mat(k,1512) = rxt(k,251)*y(k,90) + rxt(k,252)*y(k,136) + mat(k,1564) = 2.000_r8*rxt(k,253)*y(k,19) + (rxt(k,255)+rxt(k,256))*y(k,59) & + + rxt(k,257)*y(k,90) + rxt(k,261)*y(k,134) + mat(k,2156) = rxt(k,218)*y(k,90) + rxt(k,220)*y(k,136) + mat(k,1590) = (rxt(k,255)+rxt(k,256))*y(k,19) + (2.000_r8*rxt(k,222) & + +2.000_r8*rxt(k,223))*y(k,59) + rxt(k,225)*y(k,90) + rxt(k,231) & + *y(k,134) + rxt(k,233)*y(k,228) + mat(k,2110) = mat(k,2110) + rxt(k,172)*y(k,90) + rxt(k,178)*y(k,136) + mat(k,2353) = rxt(k,251)*y(k,17) + rxt(k,257)*y(k,19) + rxt(k,218)*y(k,56) & + + rxt(k,225)*y(k,59) + rxt(k,172)*y(k,76) + 2.000_r8*rxt(k,186) & + *y(k,90) + rxt(k,198)*y(k,126) + rxt(k,176)*y(k,134) & + + 2.000_r8*rxt(k,177)*y(k,136) + rxt(k,321)*y(k,197) & + + rxt(k,349)*y(k,198) + rxt(k,300)*y(k,201) + rxt(k,181) & + *y(k,228) + rxt(k,358)*y(k,231) + mat(k,473) = rxt(k,187)*y(k,228) + mat(k,1002) = mat(k,1002) + rxt(k,193)*y(k,125) + mat(k,257) = rxt(k,207)*y(k,224) + mat(k,1909) = rxt(k,204)*y(k,136) + rxt(k,590)*y(k,227) + mat(k,1954) = rxt(k,193)*y(k,112) + rxt(k,195)*y(k,134) + rxt(k,196)*y(k,136) + mat(k,1649) = rxt(k,198)*y(k,90) + rxt(k,200)*y(k,134) + mat(k,2089) = mat(k,2089) + rxt(k,261)*y(k,19) + rxt(k,231)*y(k,59) & + + rxt(k,176)*y(k,90) + rxt(k,195)*y(k,125) + rxt(k,200)*y(k,126) & + + 2.000_r8*rxt(k,168)*y(k,134) + 2.000_r8*rxt(k,167)*y(k,136) & + + rxt(k,160)*y(k,225) + rxt(k,182)*y(k,228) + mat(k,1542) = mat(k,1542) + 2.000_r8*rxt(k,161)*y(k,225) + mat(k,2220) = rxt(k,252)*y(k,17) + rxt(k,220)*y(k,56) + rxt(k,178)*y(k,76) & + + 2.000_r8*rxt(k,177)*y(k,90) + rxt(k,204)*y(k,124) + rxt(k,196) & + *y(k,125) + 2.000_r8*rxt(k,167)*y(k,134) + rxt(k,508)*y(k,150) & + + rxt(k,514)*y(k,152) + 2.000_r8*rxt(k,158)*y(k,224) & + + rxt(k,183)*y(k,228) + mat(k,720) = mat(k,720) + rxt(k,508)*y(k,136) + mat(k,1478) = mat(k,1478) + rxt(k,514)*y(k,136) + mat(k,903) = rxt(k,321)*y(k,90) + mat(k,938) = rxt(k,349)*y(k,90) + mat(k,2405) = rxt(k,300)*y(k,90) + mat(k,2023) = mat(k,2023) + rxt(k,207)*y(k,113) + 2.000_r8*rxt(k,158) & + *y(k,136) + mat(k,178) = mat(k,178) + rxt(k,160)*y(k,134) + 2.000_r8*rxt(k,161)*y(k,135) + mat(k,856) = rxt(k,590)*y(k,124) + mat(k,1814) = rxt(k,233)*y(k,59) + rxt(k,181)*y(k,90) + rxt(k,187)*y(k,91) & + + rxt(k,182)*y(k,134) + rxt(k,183)*y(k,136) + mat(k,817) = rxt(k,358)*y(k,90) + 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,2233) = -(rxt(k,158)*y(k,224) + rxt(k,167)*y(k,134) + rxt(k,177) & + *y(k,90) + rxt(k,178)*y(k,76) + rxt(k,183)*y(k,228) + rxt(k,196) & + *y(k,125) + rxt(k,204)*y(k,124) + rxt(k,220)*y(k,56) + rxt(k,252) & + *y(k,17) + rxt(k,318)*y(k,25) + rxt(k,347)*y(k,29) + rxt(k,378) & + *y(k,105) + rxt(k,392)*y(k,111) + rxt(k,425)*y(k,99) + rxt(k,463) & + *y(k,143) + rxt(k,480)*y(k,6) + rxt(k,483)*y(k,110) + rxt(k,508) & + *y(k,150) + rxt(k,514)*y(k,152)) + mat(k,2036) = -rxt(k,158)*y(k,136) + mat(k,2102) = -rxt(k,167)*y(k,136) + mat(k,2366) = -rxt(k,177)*y(k,136) + mat(k,2123) = -rxt(k,178)*y(k,136) + mat(k,1827) = -rxt(k,183)*y(k,136) + mat(k,1967) = -rxt(k,196)*y(k,136) + mat(k,1922) = -rxt(k,204)*y(k,136) + mat(k,2169) = -rxt(k,220)*y(k,136) + mat(k,1521) = -rxt(k,252)*y(k,136) + mat(k,556) = -rxt(k,318)*y(k,136) + mat(k,1146) = -rxt(k,347)*y(k,136) + mat(k,1277) = -rxt(k,378)*y(k,136) + mat(k,1387) = -rxt(k,392)*y(k,136) + mat(k,889) = -rxt(k,425)*y(k,136) + mat(k,471) = -rxt(k,463)*y(k,136) + mat(k,990) = -rxt(k,480)*y(k,136) + mat(k,1034) = -rxt(k,483)*y(k,136) + mat(k,724) = -rxt(k,508)*y(k,136) + mat(k,1487) = -rxt(k,514)*y(k,136) + mat(k,2366) = mat(k,2366) + .150_r8*rxt(k,332)*y(k,200) + .150_r8*rxt(k,383) & + *y(k,215) + mat(k,2102) = mat(k,2102) + rxt(k,169)*y(k,135) + mat(k,1553) = rxt(k,169)*y(k,134) + mat(k,1437) = .150_r8*rxt(k,332)*y(k,90) + mat(k,1406) = .150_r8*rxt(k,383)*y(k,90) + mat(k,334) = -(rxt(k,515)*y(k,152)) + mat(k,1473) = -rxt(k,515)*y(k,138) + mat(k,1557) = rxt(k,254)*y(k,59) + mat(k,1583) = rxt(k,254)*y(k,19) + 2.000_r8*rxt(k,224)*y(k,59) + mat(k,363) = -(rxt(k,504)*y(k,134) + rxt(k,505)*y(k,228)) + mat(k,2066) = -rxt(k,504)*y(k,139) + mat(k,1718) = -rxt(k,505)*y(k,139) + mat(k,1190) = rxt(k,371)*y(k,228) + mat(k,1844) = .100_r8*rxt(k,492)*y(k,233) + mat(k,1697) = rxt(k,371)*y(k,94) + mat(k,1171) = .100_r8*rxt(k,492)*y(k,124) + mat(k,534) = -(rxt(k,342)*y(k,228)) + mat(k,1740) = -rxt(k,342)*y(k,141) + mat(k,1933) = rxt(k,344)*y(k,200) + mat(k,1411) = rxt(k,344)*y(k,125) + mat(k,1927) = rxt(k,465)*y(k,191) + mat(k,522) = rxt(k,465)*y(k,125) + mat(k,468) = -(rxt(k,462)*y(k,125) + rxt(k,463)*y(k,136)) + mat(k,1930) = -rxt(k,462)*y(k,143) + mat(k,2183) = -rxt(k,463)*y(k,143) + mat(k,196) = .070_r8*rxt(k,449)*y(k,228) + mat(k,1854) = rxt(k,447)*y(k,199) + mat(k,172) = .060_r8*rxt(k,461)*y(k,228) + mat(k,217) = .070_r8*rxt(k,477)*y(k,228) + mat(k,634) = rxt(k,447)*y(k,124) + mat(k,1732) = .070_r8*rxt(k,449)*y(k,66) + .060_r8*rxt(k,461)*y(k,144) & + + .070_r8*rxt(k,477)*y(k,187) + mat(k,170) = -(rxt(k,461)*y(k,228)) + mat(k,1687) = -rxt(k,461)*y(k,144) + mat(k,162) = .530_r8*rxt(k,438)*y(k,228) + mat(k,1687) = mat(k,1687) + .530_r8*rxt(k,438)*y(k,7) + mat(k,339) = -(rxt(k,464)*y(k,228)) + mat(k,1714) = -rxt(k,464)*y(k,145) + mat(k,2280) = rxt(k,459)*y(k,230) + mat(k,447) = rxt(k,459)*y(k,90) + mat(k,542) = -(rxt(k,360)*y(k,228)) + mat(k,1741) = -rxt(k,360)*y(k,148) + mat(k,2301) = rxt(k,358)*y(k,231) + mat(k,813) = rxt(k,358)*y(k,90) + mat(k,397) = -(rxt(k,364)*y(k,228)) + mat(k,1722) = -rxt(k,364)*y(k,149) + mat(k,2284) = .850_r8*rxt(k,362)*y(k,232) + mat(k,1214) = .850_r8*rxt(k,362)*y(k,90) + mat(k,718) = -(rxt(k,506)*y(k,135) + rxt(k,508)*y(k,136) + rxt(k,511) & + *y(k,228)) + mat(k,1530) = -rxt(k,506)*y(k,150) + mat(k,2187) = -rxt(k,508)*y(k,150) + mat(k,1760) = -rxt(k,511)*y(k,150) + mat(k,1476) = -(rxt(k,509)*y(k,19) + rxt(k,510)*y(k,59) + rxt(k,512)*y(k,125) & + + rxt(k,513)*y(k,135) + rxt(k,514)*y(k,136) + rxt(k,515) & + *y(k,138) + rxt(k,516)*y(k,228)) + mat(k,1561) = -rxt(k,509)*y(k,152) + mat(k,1587) = -rxt(k,510)*y(k,152) + mat(k,1951) = -rxt(k,512)*y(k,152) + mat(k,1540) = -rxt(k,513)*y(k,152) + mat(k,2218) = -rxt(k,514)*y(k,152) + mat(k,336) = -rxt(k,515)*y(k,152) + mat(k,1811) = -rxt(k,516)*y(k,152) + mat(k,2086) = rxt(k,504)*y(k,139) + mat(k,1540) = mat(k,1540) + rxt(k,506)*y(k,150) + mat(k,2218) = mat(k,2218) + rxt(k,508)*y(k,150) + mat(k,367) = rxt(k,504)*y(k,134) + mat(k,719) = rxt(k,506)*y(k,135) + rxt(k,508)*y(k,136) + rxt(k,511)*y(k,228) + mat(k,1811) = mat(k,1811) + rxt(k,511)*y(k,150) + mat(k,947) = -(rxt(k,507)*y(k,228)) + mat(k,1778) = -rxt(k,507)*y(k,153) + mat(k,1560) = rxt(k,509)*y(k,152) + mat(k,1585) = rxt(k,510)*y(k,152) + mat(k,311) = rxt(k,502)*y(k,126) + (rxt(k,503)+.500_r8*rxt(k,517))*y(k,228) + mat(k,1941) = rxt(k,512)*y(k,152) + mat(k,1617) = rxt(k,502)*y(k,67) + mat(k,1535) = rxt(k,513)*y(k,152) + mat(k,2191) = rxt(k,514)*y(k,152) + mat(k,335) = rxt(k,515)*y(k,152) + mat(k,365) = rxt(k,505)*y(k,228) + mat(k,1475) = rxt(k,509)*y(k,19) + rxt(k,510)*y(k,59) + rxt(k,512)*y(k,125) & + + rxt(k,513)*y(k,135) + rxt(k,514)*y(k,136) + rxt(k,515) & + *y(k,138) + rxt(k,516)*y(k,228) + mat(k,1778) = mat(k,1778) + (rxt(k,503)+.500_r8*rxt(k,517))*y(k,67) & + + rxt(k,505)*y(k,139) + rxt(k,516)*y(k,152) + mat(k,261) = -(rxt(k,518)*y(k,241)) + mat(k,2424) = -rxt(k,518)*y(k,154) + mat(k,946) = rxt(k,507)*y(k,228) + mat(k,1703) = rxt(k,507)*y(k,153) + mat(k,965) = .2202005_r8*rxt(k,537)*y(k,136) + mat(k,2263) = .2202005_r8*rxt(k,535)*y(k,193) + .0023005_r8*rxt(k,540) & + *y(k,195) + .0031005_r8*rxt(k,543)*y(k,211) & + + .2381005_r8*rxt(k,547)*y(k,212) + .0508005_r8*rxt(k,551) & + *y(k,218) + .1364005_r8*rxt(k,557)*y(k,236) & + + .1677005_r8*rxt(k,560)*y(k,239) + mat(k,1009) = .0508005_r8*rxt(k,553)*y(k,136) + mat(k,1832) = .1279005_r8*rxt(k,536)*y(k,193) + .0097005_r8*rxt(k,541) & + *y(k,195) + .0003005_r8*rxt(k,544)*y(k,211) & + + .1056005_r8*rxt(k,548)*y(k,212) + .0245005_r8*rxt(k,552) & + *y(k,218) + .0154005_r8*rxt(k,558)*y(k,236) & + + .0063005_r8*rxt(k,561)*y(k,239) + mat(k,2174) = .2202005_r8*rxt(k,537)*y(k,6) + .0508005_r8*rxt(k,553)*y(k,110) + mat(k,45) = .5931005_r8*rxt(k,555)*y(k,228) + mat(k,51) = .2202005_r8*rxt(k,535)*y(k,90) + .1279005_r8*rxt(k,536)*y(k,124) + mat(k,57) = .0023005_r8*rxt(k,540)*y(k,90) + .0097005_r8*rxt(k,541)*y(k,124) + mat(k,63) = .0031005_r8*rxt(k,543)*y(k,90) + .0003005_r8*rxt(k,544)*y(k,124) + mat(k,69) = .2381005_r8*rxt(k,547)*y(k,90) + .1056005_r8*rxt(k,548)*y(k,124) + mat(k,77) = .0508005_r8*rxt(k,551)*y(k,90) + .0245005_r8*rxt(k,552)*y(k,124) + mat(k,1667) = .5931005_r8*rxt(k,555)*y(k,175) + mat(k,83) = .1364005_r8*rxt(k,557)*y(k,90) + .0154005_r8*rxt(k,558)*y(k,124) + mat(k,89) = .1677005_r8*rxt(k,560)*y(k,90) + .0063005_r8*rxt(k,561)*y(k,124) + mat(k,966) = .2067005_r8*rxt(k,537)*y(k,136) + mat(k,2264) = .2067005_r8*rxt(k,535)*y(k,193) + .0008005_r8*rxt(k,540) & + *y(k,195) + .0035005_r8*rxt(k,543)*y(k,211) & + + .1308005_r8*rxt(k,547)*y(k,212) + .1149005_r8*rxt(k,551) & + *y(k,218) + .0101005_r8*rxt(k,557)*y(k,236) & + + .0174005_r8*rxt(k,560)*y(k,239) + mat(k,1010) = .1149005_r8*rxt(k,553)*y(k,136) + mat(k,1833) = .1792005_r8*rxt(k,536)*y(k,193) + .0034005_r8*rxt(k,541) & + *y(k,195) + .0003005_r8*rxt(k,544)*y(k,211) & + + .1026005_r8*rxt(k,548)*y(k,212) + .0082005_r8*rxt(k,552) & + *y(k,218) + .0452005_r8*rxt(k,558)*y(k,236) & + + .0237005_r8*rxt(k,561)*y(k,239) + mat(k,2175) = .2067005_r8*rxt(k,537)*y(k,6) + .1149005_r8*rxt(k,553)*y(k,110) + mat(k,46) = .1534005_r8*rxt(k,555)*y(k,228) + mat(k,52) = .2067005_r8*rxt(k,535)*y(k,90) + .1792005_r8*rxt(k,536)*y(k,124) + mat(k,58) = .0008005_r8*rxt(k,540)*y(k,90) + .0034005_r8*rxt(k,541)*y(k,124) + mat(k,64) = .0035005_r8*rxt(k,543)*y(k,90) + .0003005_r8*rxt(k,544)*y(k,124) + mat(k,70) = .1308005_r8*rxt(k,547)*y(k,90) + .1026005_r8*rxt(k,548)*y(k,124) + mat(k,78) = .1149005_r8*rxt(k,551)*y(k,90) + .0082005_r8*rxt(k,552)*y(k,124) + mat(k,1668) = .1534005_r8*rxt(k,555)*y(k,175) + mat(k,84) = .0101005_r8*rxt(k,557)*y(k,90) + .0452005_r8*rxt(k,558)*y(k,124) + mat(k,90) = .0174005_r8*rxt(k,560)*y(k,90) + .0237005_r8*rxt(k,561)*y(k,124) + mat(k,967) = .0653005_r8*rxt(k,537)*y(k,136) + mat(k,2265) = .0653005_r8*rxt(k,535)*y(k,193) + .0843005_r8*rxt(k,540) & + *y(k,195) + .0003005_r8*rxt(k,543)*y(k,211) & + + .0348005_r8*rxt(k,547)*y(k,212) + .0348005_r8*rxt(k,551) & + *y(k,218) + .0763005_r8*rxt(k,557)*y(k,236) + .086_r8*rxt(k,560) & + *y(k,239) + mat(k,1011) = .0348005_r8*rxt(k,553)*y(k,136) + mat(k,1834) = .0676005_r8*rxt(k,536)*y(k,193) + .1579005_r8*rxt(k,541) & + *y(k,195) + .0073005_r8*rxt(k,544)*y(k,211) & + + .0521005_r8*rxt(k,548)*y(k,212) + .0772005_r8*rxt(k,552) & + *y(k,218) + .0966005_r8*rxt(k,558)*y(k,236) & + + .0025005_r8*rxt(k,561)*y(k,239) + mat(k,2176) = .0653005_r8*rxt(k,537)*y(k,6) + .0348005_r8*rxt(k,553)*y(k,110) + mat(k,47) = .0459005_r8*rxt(k,555)*y(k,228) + mat(k,53) = .0653005_r8*rxt(k,535)*y(k,90) + .0676005_r8*rxt(k,536)*y(k,124) + mat(k,59) = .0843005_r8*rxt(k,540)*y(k,90) + .1579005_r8*rxt(k,541)*y(k,124) + mat(k,65) = .0003005_r8*rxt(k,543)*y(k,90) + .0073005_r8*rxt(k,544)*y(k,124) + mat(k,71) = .0348005_r8*rxt(k,547)*y(k,90) + .0521005_r8*rxt(k,548)*y(k,124) + mat(k,79) = .0348005_r8*rxt(k,551)*y(k,90) + .0772005_r8*rxt(k,552)*y(k,124) + mat(k,1669) = .0459005_r8*rxt(k,555)*y(k,175) + mat(k,85) = .0763005_r8*rxt(k,557)*y(k,90) + .0966005_r8*rxt(k,558)*y(k,124) + mat(k,91) = .086_r8*rxt(k,560)*y(k,90) + .0025005_r8*rxt(k,561)*y(k,124) + mat(k,968) = .1749305_r8*rxt(k,534)*y(k,126) + .1284005_r8*rxt(k,537) & + *y(k,136) + mat(k,2266) = .1284005_r8*rxt(k,535)*y(k,193) + .0443005_r8*rxt(k,540) & + *y(k,195) + .0271005_r8*rxt(k,543)*y(k,211) & + + .0076005_r8*rxt(k,547)*y(k,212) + .0554005_r8*rxt(k,551) & + *y(k,218) + .2157005_r8*rxt(k,557)*y(k,236) & + + .0512005_r8*rxt(k,560)*y(k,239) + mat(k,873) = .0590245_r8*rxt(k,542)*y(k,126) + .0033005_r8*rxt(k,545) & + *y(k,136) + mat(k,1012) = .1749305_r8*rxt(k,550)*y(k,126) + .0554005_r8*rxt(k,553) & + *y(k,136) + mat(k,1835) = .079_r8*rxt(k,536)*y(k,193) + .0059005_r8*rxt(k,541)*y(k,195) & + + .0057005_r8*rxt(k,544)*y(k,211) + .0143005_r8*rxt(k,548) & + *y(k,212) + .0332005_r8*rxt(k,552)*y(k,218) & + + .0073005_r8*rxt(k,558)*y(k,236) + .011_r8*rxt(k,561)*y(k,239) + mat(k,1607) = .1749305_r8*rxt(k,534)*y(k,6) + .0590245_r8*rxt(k,542)*y(k,99) & + + .1749305_r8*rxt(k,550)*y(k,110) + mat(k,2177) = .1284005_r8*rxt(k,537)*y(k,6) + .0033005_r8*rxt(k,545)*y(k,99) & + + .0554005_r8*rxt(k,553)*y(k,110) + mat(k,48) = .0085005_r8*rxt(k,555)*y(k,228) + mat(k,54) = .1284005_r8*rxt(k,535)*y(k,90) + .079_r8*rxt(k,536)*y(k,124) + mat(k,60) = .0443005_r8*rxt(k,540)*y(k,90) + .0059005_r8*rxt(k,541)*y(k,124) + mat(k,66) = .0271005_r8*rxt(k,543)*y(k,90) + .0057005_r8*rxt(k,544)*y(k,124) + mat(k,72) = .0076005_r8*rxt(k,547)*y(k,90) + .0143005_r8*rxt(k,548)*y(k,124) + mat(k,80) = .0554005_r8*rxt(k,551)*y(k,90) + .0332005_r8*rxt(k,552)*y(k,124) + mat(k,1670) = .0085005_r8*rxt(k,555)*y(k,175) + mat(k,86) = .2157005_r8*rxt(k,557)*y(k,90) + .0073005_r8*rxt(k,558)*y(k,124) + mat(k,92) = .0512005_r8*rxt(k,560)*y(k,90) + .011_r8*rxt(k,561)*y(k,124) + end do + end subroutine nlnmat07 + subroutine nlnmat08( 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,969) = .5901905_r8*rxt(k,534)*y(k,126) + .114_r8*rxt(k,537)*y(k,136) + mat(k,2267) = .114_r8*rxt(k,535)*y(k,193) + .1621005_r8*rxt(k,540)*y(k,195) & + + .0474005_r8*rxt(k,543)*y(k,211) + .0113005_r8*rxt(k,547) & + *y(k,212) + .1278005_r8*rxt(k,551)*y(k,218) & + + .0738005_r8*rxt(k,557)*y(k,236) + .1598005_r8*rxt(k,560) & + *y(k,239) + mat(k,874) = .0250245_r8*rxt(k,542)*y(k,126) + mat(k,1013) = .5901905_r8*rxt(k,550)*y(k,126) + .1278005_r8*rxt(k,553) & + *y(k,136) + mat(k,1836) = .1254005_r8*rxt(k,536)*y(k,193) + .0536005_r8*rxt(k,541) & + *y(k,195) + .0623005_r8*rxt(k,544)*y(k,211) & + + .0166005_r8*rxt(k,548)*y(k,212) + .130_r8*rxt(k,552)*y(k,218) & + + .238_r8*rxt(k,558)*y(k,236) + .1185005_r8*rxt(k,561)*y(k,239) + mat(k,1608) = .5901905_r8*rxt(k,534)*y(k,6) + .0250245_r8*rxt(k,542)*y(k,99) & + + .5901905_r8*rxt(k,550)*y(k,110) + mat(k,2178) = .114_r8*rxt(k,537)*y(k,6) + .1278005_r8*rxt(k,553)*y(k,110) + mat(k,49) = .0128005_r8*rxt(k,555)*y(k,228) + mat(k,55) = .114_r8*rxt(k,535)*y(k,90) + .1254005_r8*rxt(k,536)*y(k,124) + mat(k,61) = .1621005_r8*rxt(k,540)*y(k,90) + .0536005_r8*rxt(k,541)*y(k,124) + mat(k,67) = .0474005_r8*rxt(k,543)*y(k,90) + .0623005_r8*rxt(k,544)*y(k,124) + mat(k,73) = .0113005_r8*rxt(k,547)*y(k,90) + .0166005_r8*rxt(k,548)*y(k,124) + mat(k,81) = .1278005_r8*rxt(k,551)*y(k,90) + .130_r8*rxt(k,552)*y(k,124) + mat(k,1671) = .0128005_r8*rxt(k,555)*y(k,175) + mat(k,87) = .0738005_r8*rxt(k,557)*y(k,90) + .238_r8*rxt(k,558)*y(k,124) + mat(k,93) = .1598005_r8*rxt(k,560)*y(k,90) + .1185005_r8*rxt(k,561)*y(k,124) + mat(k,50) = -(rxt(k,555)*y(k,228)) + mat(k,1672) = -rxt(k,555)*y(k,175) + mat(k,189) = .100_r8*rxt(k,469)*y(k,228) + mat(k,207) = .230_r8*rxt(k,471)*y(k,228) + mat(k,1691) = .100_r8*rxt(k,469)*y(k,183) + .230_r8*rxt(k,471)*y(k,185) + mat(k,652) = -(rxt(k,493)*y(k,228)) + mat(k,1754) = -rxt(k,493)*y(k,177) + mat(k,2305) = rxt(k,491)*y(k,233) + mat(k,1172) = rxt(k,491)*y(k,90) + mat(k,627) = -(rxt(k,494)*y(k,228)) + mat(k,1751) = -rxt(k,494)*y(k,178) + mat(k,1863) = .200_r8*rxt(k,487)*y(k,223) + .200_r8*rxt(k,497)*y(k,234) + mat(k,2375) = .500_r8*rxt(k,485)*y(k,223) + mat(k,1103) = .200_r8*rxt(k,487)*y(k,124) + .500_r8*rxt(k,485)*y(k,201) + mat(k,1060) = .200_r8*rxt(k,497)*y(k,124) + mat(k,486) = -(rxt(k,498)*y(k,228)) + mat(k,1735) = -rxt(k,498)*y(k,179) + mat(k,2297) = rxt(k,496)*y(k,234) + mat(k,1059) = rxt(k,496)*y(k,90) + mat(k,1072) = -(rxt(k,499)*y(k,126) + rxt(k,500)*y(k,228)) + mat(k,1623) = -rxt(k,499)*y(k,180) + mat(k,1786) = -rxt(k,500)*y(k,180) + mat(k,978) = .330_r8*rxt(k,480)*y(k,136) + mat(k,1022) = .330_r8*rxt(k,483)*y(k,136) + mat(k,1885) = .800_r8*rxt(k,487)*y(k,223) + .800_r8*rxt(k,497)*y(k,234) + mat(k,1623) = mat(k,1623) + rxt(k,488)*y(k,223) + mat(k,2197) = .330_r8*rxt(k,480)*y(k,6) + .330_r8*rxt(k,483)*y(k,110) + mat(k,628) = rxt(k,494)*y(k,228) + mat(k,2383) = .500_r8*rxt(k,485)*y(k,223) + rxt(k,495)*y(k,234) + mat(k,1105) = .800_r8*rxt(k,487)*y(k,124) + rxt(k,488)*y(k,126) & + + .500_r8*rxt(k,485)*y(k,201) + mat(k,1786) = mat(k,1786) + rxt(k,494)*y(k,178) + mat(k,1063) = .800_r8*rxt(k,497)*y(k,124) + rxt(k,495)*y(k,201) + mat(k,1119) = -(rxt(k,501)*y(k,228)) + mat(k,1790) = -rxt(k,501)*y(k,181) + mat(k,981) = .300_r8*rxt(k,480)*y(k,136) + mat(k,1025) = .300_r8*rxt(k,483)*y(k,136) + mat(k,1889) = .900_r8*rxt(k,492)*y(k,233) + mat(k,2200) = .300_r8*rxt(k,480)*y(k,6) + .300_r8*rxt(k,483)*y(k,110) + mat(k,2387) = rxt(k,490)*y(k,233) + mat(k,1175) = .900_r8*rxt(k,492)*y(k,124) + rxt(k,490)*y(k,201) + mat(k,665) = -(rxt(k,468)*y(k,228)) + mat(k,1755) = -rxt(k,468)*y(k,182) + mat(k,2306) = rxt(k,466)*y(k,235) + mat(k,749) = rxt(k,466)*y(k,90) + mat(k,187) = -(rxt(k,469)*y(k,228)) + mat(k,1689) = -rxt(k,469)*y(k,183) + mat(k,203) = -(rxt(k,435)*y(k,228)) + mat(k,1692) = -rxt(k,435)*y(k,184) + mat(k,2276) = rxt(k,432)*y(k,237) + mat(k,1227) = rxt(k,432)*y(k,90) + mat(k,208) = -(rxt(k,471)*y(k,228)) + mat(k,1693) = -rxt(k,471)*y(k,185) + mat(k,729) = -(rxt(k,474)*y(k,228)) + mat(k,1761) = -rxt(k,474)*y(k,186) + mat(k,2311) = rxt(k,472)*y(k,238) + mat(k,765) = rxt(k,472)*y(k,90) + mat(k,216) = -(rxt(k,477)*y(k,228)) + mat(k,1694) = -rxt(k,477)*y(k,187) + mat(k,209) = .150_r8*rxt(k,471)*y(k,228) + mat(k,1694) = mat(k,1694) + .150_r8*rxt(k,471)*y(k,185) + mat(k,421) = -(rxt(k,478)*y(k,228)) + mat(k,1726) = -rxt(k,478)*y(k,188) + mat(k,2288) = rxt(k,475)*y(k,240) + mat(k,509) = rxt(k,475)*y(k,90) + mat(k,523) = -(rxt(k,436)*y(k,90) + rxt(k,437)*y(k,124) + rxt(k,465)*y(k,125)) + mat(k,2300) = -rxt(k,436)*y(k,191) + mat(k,1858) = -rxt(k,437)*y(k,191) + mat(k,1932) = -rxt(k,465)*y(k,191) + mat(k,236) = rxt(k,442)*y(k,228) + mat(k,1739) = rxt(k,442)*y(k,22) + mat(k,1042) = -(rxt(k,397)*y(k,90) + (rxt(k,398) + rxt(k,399)) * y(k,124)) + mat(k,2326) = -rxt(k,397)*y(k,192) + mat(k,1882) = -(rxt(k,398) + rxt(k,399)) * y(k,192) + mat(k,690) = rxt(k,400)*y(k,228) + mat(k,227) = rxt(k,401)*y(k,228) + mat(k,1783) = rxt(k,400)*y(k,2) + rxt(k,401)*y(k,15) + mat(k,56) = -(rxt(k,535)*y(k,90) + rxt(k,536)*y(k,124)) + mat(k,2268) = -rxt(k,535)*y(k,193) + mat(k,1837) = -rxt(k,536)*y(k,193) + mat(k,970) = rxt(k,538)*y(k,228) + mat(k,1673) = rxt(k,538)*y(k,6) + mat(k,495) = -(rxt(k,439)*y(k,90) + rxt(k,440)*y(k,124)) + mat(k,2298) = -rxt(k,439)*y(k,194) + mat(k,1855) = -rxt(k,440)*y(k,194) + mat(k,163) = .350_r8*rxt(k,438)*y(k,228) + mat(k,417) = rxt(k,441)*y(k,228) + mat(k,1736) = .350_r8*rxt(k,438)*y(k,7) + rxt(k,441)*y(k,8) + mat(k,62) = -(rxt(k,540)*y(k,90) + rxt(k,541)*y(k,124)) + mat(k,2269) = -rxt(k,540)*y(k,195) + mat(k,1838) = -rxt(k,541)*y(k,195) + mat(k,159) = rxt(k,539)*y(k,228) + mat(k,1674) = rxt(k,539)*y(k,7) + mat(k,435) = -(rxt(k,443)*y(k,90) + rxt(k,445)*y(k,124)) + mat(k,2289) = -rxt(k,443)*y(k,196) + mat(k,1849) = -rxt(k,445)*y(k,196) + mat(k,346) = rxt(k,444)*y(k,228) + mat(k,190) = .070_r8*rxt(k,469)*y(k,228) + mat(k,210) = .060_r8*rxt(k,471)*y(k,228) + mat(k,1728) = rxt(k,444)*y(k,23) + .070_r8*rxt(k,469)*y(k,183) & + + .060_r8*rxt(k,471)*y(k,185) + mat(k,901) = -(4._r8*rxt(k,319)*y(k,197) + rxt(k,320)*y(k,201) + rxt(k,321) & + *y(k,90) + rxt(k,322)*y(k,124)) + mat(k,2379) = -rxt(k,320)*y(k,197) + mat(k,2322) = -rxt(k,321)*y(k,197) + mat(k,1877) = -rxt(k,322)*y(k,197) + mat(k,351) = .500_r8*rxt(k,324)*y(k,228) + mat(k,299) = rxt(k,325)*y(k,56) + rxt(k,326)*y(k,228) + mat(k,2140) = rxt(k,325)*y(k,28) + mat(k,1773) = .500_r8*rxt(k,324)*y(k,27) + rxt(k,326)*y(k,28) + mat(k,935) = -(rxt(k,348)*y(k,201) + rxt(k,349)*y(k,90) + rxt(k,350)*y(k,124)) + mat(k,2380) = -rxt(k,348)*y(k,198) + mat(k,2325) = -rxt(k,349)*y(k,198) + mat(k,1880) = -rxt(k,350)*y(k,198) + mat(k,410) = rxt(k,351)*y(k,228) + mat(k,305) = rxt(k,355)*y(k,56) + rxt(k,352)*y(k,228) + mat(k,2142) = rxt(k,355)*y(k,31) + mat(k,1777) = rxt(k,351)*y(k,30) + rxt(k,352)*y(k,31) + mat(k,635) = -(rxt(k,446)*y(k,90) + rxt(k,447)*y(k,124)) + mat(k,2304) = -rxt(k,446)*y(k,199) + mat(k,1864) = -rxt(k,447)*y(k,199) + mat(k,271) = rxt(k,448)*y(k,228) + mat(k,2304) = mat(k,2304) + .400_r8*rxt(k,436)*y(k,191) + mat(k,1864) = mat(k,1864) + rxt(k,437)*y(k,191) + mat(k,2185) = rxt(k,463)*y(k,143) + mat(k,469) = rxt(k,463)*y(k,136) + mat(k,524) = .400_r8*rxt(k,436)*y(k,90) + rxt(k,437)*y(k,124) + mat(k,1752) = rxt(k,448)*y(k,32) + mat(k,1428) = -(4._r8*rxt(k,330)*y(k,200) + rxt(k,331)*y(k,201) + rxt(k,332) & + *y(k,90) + rxt(k,333)*y(k,124) + rxt(k,344)*y(k,125) + rxt(k,372) & + *y(k,213) + rxt(k,405)*y(k,208) + rxt(k,410)*y(k,209) + rxt(k,419) & + *y(k,210) + rxt(k,430)*y(k,237)) + mat(k,2403) = -rxt(k,331)*y(k,200) + mat(k,2348) = -rxt(k,332)*y(k,200) + mat(k,1906) = -rxt(k,333)*y(k,200) + mat(k,1949) = -rxt(k,344)*y(k,200) + mat(k,1358) = -rxt(k,372)*y(k,200) + mat(k,1303) = -rxt(k,405)*y(k,200) + mat(k,1336) = -rxt(k,410)*y(k,200) + mat(k,1257) = -rxt(k,419)*y(k,200) + mat(k,1235) = -rxt(k,430)*y(k,200) + mat(k,985) = .060_r8*rxt(k,480)*y(k,136) + mat(k,1153) = rxt(k,327)*y(k,126) + rxt(k,328)*y(k,228) + mat(k,1282) = rxt(k,353)*y(k,126) + rxt(k,354)*y(k,228) + mat(k,621) = .500_r8*rxt(k,335)*y(k,228) + mat(k,2348) = mat(k,2348) + .450_r8*rxt(k,383)*y(k,215) + .200_r8*rxt(k,387) & + *y(k,217) + .150_r8*rxt(k,362)*y(k,232) + mat(k,885) = .080_r8*rxt(k,425)*y(k,136) + mat(k,1273) = .100_r8*rxt(k,378)*y(k,136) + mat(k,1029) = .060_r8*rxt(k,483)*y(k,136) + mat(k,1378) = .280_r8*rxt(k,392)*y(k,136) + mat(k,1906) = mat(k,1906) + .530_r8*rxt(k,376)*y(k,213) + rxt(k,385)*y(k,215) & + + rxt(k,388)*y(k,217) + rxt(k,363)*y(k,232) + mat(k,1645) = rxt(k,327)*y(k,45) + rxt(k,353)*y(k,49) + .530_r8*rxt(k,375) & + *y(k,213) + rxt(k,386)*y(k,215) + mat(k,2216) = .060_r8*rxt(k,480)*y(k,6) + .080_r8*rxt(k,425)*y(k,99) & + + .100_r8*rxt(k,378)*y(k,105) + .060_r8*rxt(k,483)*y(k,110) & + + .280_r8*rxt(k,392)*y(k,111) + mat(k,1122) = .650_r8*rxt(k,501)*y(k,228) + mat(k,1428) = mat(k,1428) + .530_r8*rxt(k,372)*y(k,213) + mat(k,2403) = mat(k,2403) + .260_r8*rxt(k,373)*y(k,213) + rxt(k,382)*y(k,215) & + + .300_r8*rxt(k,361)*y(k,232) + mat(k,1358) = mat(k,1358) + .530_r8*rxt(k,376)*y(k,124) + .530_r8*rxt(k,375) & + *y(k,126) + .530_r8*rxt(k,372)*y(k,200) + .260_r8*rxt(k,373) & + *y(k,201) + mat(k,1398) = .450_r8*rxt(k,383)*y(k,90) + rxt(k,385)*y(k,124) + rxt(k,386) & + *y(k,126) + rxt(k,382)*y(k,201) + 4.000_r8*rxt(k,384)*y(k,215) + mat(k,700) = .200_r8*rxt(k,387)*y(k,90) + rxt(k,388)*y(k,124) + mat(k,1808) = rxt(k,328)*y(k,45) + rxt(k,354)*y(k,49) + .500_r8*rxt(k,335) & + *y(k,51) + .650_r8*rxt(k,501)*y(k,181) + mat(k,1219) = .150_r8*rxt(k,362)*y(k,90) + rxt(k,363)*y(k,124) & + + .300_r8*rxt(k,361)*y(k,201) + mat(k,2421) = -(rxt(k,221)*y(k,59) + (4._r8*rxt(k,298) + 4._r8*rxt(k,299) & + ) * y(k,201) + rxt(k,300)*y(k,90) + rxt(k,301)*y(k,124) & + + rxt(k,320)*y(k,197) + rxt(k,331)*y(k,200) + rxt(k,348) & + *y(k,198) + rxt(k,361)*y(k,232) + rxt(k,373)*y(k,213) + rxt(k,382) & + *y(k,215) + rxt(k,406)*y(k,208) + rxt(k,411)*y(k,209) + rxt(k,420) & + *y(k,210) + rxt(k,431)*y(k,237) + rxt(k,485)*y(k,223) + rxt(k,490) & + *y(k,233) + rxt(k,495)*y(k,234)) + mat(k,1605) = -rxt(k,221)*y(k,201) + mat(k,2369) = -rxt(k,300)*y(k,201) + mat(k,1925) = -rxt(k,301)*y(k,201) + mat(k,909) = -rxt(k,320)*y(k,201) + mat(k,1440) = -rxt(k,331)*y(k,201) + mat(k,944) = -rxt(k,348)*y(k,201) + mat(k,1225) = -rxt(k,361)*y(k,201) + mat(k,1367) = -rxt(k,373)*y(k,201) + mat(k,1408) = -rxt(k,382)*y(k,201) + mat(k,1313) = -rxt(k,406)*y(k,201) + mat(k,1346) = -rxt(k,411)*y(k,201) + mat(k,1266) = -rxt(k,420)*y(k,201) + mat(k,1243) = -rxt(k,431)*y(k,201) + mat(k,1117) = -rxt(k,485)*y(k,201) + mat(k,1188) = -rxt(k,490)*y(k,201) + mat(k,1071) = -rxt(k,495)*y(k,201) + mat(k,1149) = .280_r8*rxt(k,347)*y(k,136) + mat(k,708) = rxt(k,334)*y(k,228) + mat(k,458) = .700_r8*rxt(k,303)*y(k,228) + mat(k,2261) = rxt(k,215)*y(k,56) + rxt(k,271)*y(k,73) + rxt(k,310)*y(k,224) & + + rxt(k,304)*y(k,228) + mat(k,2172) = rxt(k,215)*y(k,54) + mat(k,932) = rxt(k,271)*y(k,54) + mat(k,2369) = mat(k,2369) + .450_r8*rxt(k,332)*y(k,200) + .330_r8*rxt(k,450) & + *y(k,202) + .070_r8*rxt(k,456)*y(k,216) + mat(k,891) = .050_r8*rxt(k,425)*y(k,136) + mat(k,1925) = mat(k,1925) + rxt(k,333)*y(k,200) + .830_r8*rxt(k,451)*y(k,202) & + + .170_r8*rxt(k,457)*y(k,216) + mat(k,2236) = .280_r8*rxt(k,347)*y(k,29) + .050_r8*rxt(k,425)*y(k,99) + mat(k,1440) = mat(k,1440) + .450_r8*rxt(k,332)*y(k,90) + rxt(k,333)*y(k,124) & + + 4.000_r8*rxt(k,330)*y(k,200) + .900_r8*rxt(k,331)*y(k,201) & + + rxt(k,405)*y(k,208) + rxt(k,410)*y(k,209) + rxt(k,419) & + *y(k,210) + rxt(k,372)*y(k,213) + rxt(k,381)*y(k,215) & + + rxt(k,430)*y(k,237) + mat(k,2421) = mat(k,2421) + .900_r8*rxt(k,331)*y(k,200) + mat(k,785) = .330_r8*rxt(k,450)*y(k,90) + .830_r8*rxt(k,451)*y(k,124) + mat(k,1313) = mat(k,1313) + rxt(k,405)*y(k,200) + mat(k,1346) = mat(k,1346) + rxt(k,410)*y(k,200) + mat(k,1266) = mat(k,1266) + rxt(k,419)*y(k,200) + mat(k,1367) = mat(k,1367) + rxt(k,372)*y(k,200) + mat(k,1408) = mat(k,1408) + rxt(k,381)*y(k,200) + mat(k,918) = .070_r8*rxt(k,456)*y(k,90) + .170_r8*rxt(k,457)*y(k,124) + mat(k,2039) = rxt(k,310)*y(k,54) + mat(k,1830) = rxt(k,334)*y(k,50) + .700_r8*rxt(k,303)*y(k,53) + rxt(k,304) & + *y(k,54) + mat(k,1243) = mat(k,1243) + rxt(k,430)*y(k,200) + end do + end subroutine nlnmat08 + subroutine nlnmat09( 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,778) = -(rxt(k,450)*y(k,90) + rxt(k,451)*y(k,124) + rxt(k,452)*y(k,125)) + mat(k,2315) = -rxt(k,450)*y(k,202) + mat(k,1870) = -rxt(k,451)*y(k,202) + mat(k,1938) = -rxt(k,452)*y(k,202) + mat(k,865) = -(rxt(k,579)*y(k,221) + rxt(k,580)*y(k,227) + rxt(k,581) & + *y(k,220)) + mat(k,846) = -rxt(k,579)*y(k,203) + mat(k,854) = -rxt(k,580)*y(k,203) + mat(k,680) = -rxt(k,581)*y(k,203) + mat(k,574) = -((rxt(k,369) + rxt(k,370)) * y(k,124)) + mat(k,1860) = -(rxt(k,369) + rxt(k,370)) * y(k,204) + mat(k,356) = rxt(k,368)*y(k,228) + mat(k,1744) = rxt(k,368)*y(k,16) + mat(k,460) = -(rxt(k,339)*y(k,135)) + mat(k,1526) = -rxt(k,339)*y(k,205) + mat(k,1852) = .750_r8*rxt(k,337)*y(k,206) + mat(k,796) = .750_r8*rxt(k,337)*y(k,124) + mat(k,797) = -(rxt(k,336)*y(k,90) + rxt(k,337)*y(k,124)) + mat(k,2317) = -rxt(k,336)*y(k,206) + mat(k,1871) = -rxt(k,337)*y(k,206) + mat(k,551) = rxt(k,343)*y(k,228) + mat(k,1766) = rxt(k,343)*y(k,25) + mat(k,441) = -(rxt(k,307)*y(k,90) + rxt(k,309)*y(k,124)) + mat(k,2290) = -rxt(k,307)*y(k,207) + mat(k,1850) = -rxt(k,309)*y(k,207) + mat(k,1972) = rxt(k,294)*y(k,90) + mat(k,2290) = mat(k,2290) + rxt(k,294)*y(k,42) + mat(k,1299) = -(rxt(k,405)*y(k,200) + rxt(k,406)*y(k,201) + rxt(k,407) & + *y(k,90) + rxt(k,408)*y(k,124) + rxt(k,409)*y(k,126)) + mat(k,1423) = -rxt(k,405)*y(k,208) + mat(k,2398) = -rxt(k,406)*y(k,208) + mat(k,2343) = -rxt(k,407)*y(k,208) + mat(k,1901) = -rxt(k,408)*y(k,208) + mat(k,1640) = -rxt(k,409)*y(k,208) + mat(k,882) = .600_r8*rxt(k,426)*y(k,228) + mat(k,1803) = .600_r8*rxt(k,426)*y(k,99) + mat(k,1332) = -(rxt(k,410)*y(k,200) + rxt(k,411)*y(k,201) + rxt(k,412) & + *y(k,90) + rxt(k,414)*y(k,124) + rxt(k,415)*y(k,126)) + mat(k,1424) = -rxt(k,410)*y(k,209) + mat(k,2399) = -rxt(k,411)*y(k,209) + mat(k,2344) = -rxt(k,412)*y(k,209) + mat(k,1902) = -rxt(k,414)*y(k,209) + mat(k,1641) = -rxt(k,415)*y(k,209) + mat(k,883) = .400_r8*rxt(k,426)*y(k,228) + mat(k,1804) = .400_r8*rxt(k,426)*y(k,99) + mat(k,1253) = -(rxt(k,419)*y(k,200) + rxt(k,420)*y(k,201) + rxt(k,421) & + *y(k,90) + rxt(k,422)*y(k,124) + rxt(k,423)*y(k,126)) + mat(k,1420) = -rxt(k,419)*y(k,210) + mat(k,2395) = -rxt(k,420)*y(k,210) + mat(k,2340) = -rxt(k,421)*y(k,210) + mat(k,1898) = -rxt(k,422)*y(k,210) + mat(k,1637) = -rxt(k,423)*y(k,210) + mat(k,880) = rxt(k,418)*y(k,126) + mat(k,1637) = mat(k,1637) + rxt(k,418)*y(k,99) + mat(k,68) = -(rxt(k,543)*y(k,90) + rxt(k,544)*y(k,124)) + mat(k,2270) = -rxt(k,543)*y(k,211) + mat(k,1839) = -rxt(k,544)*y(k,211) + mat(k,875) = rxt(k,546)*y(k,228) + mat(k,1675) = rxt(k,546)*y(k,99) + mat(k,74) = -(rxt(k,547)*y(k,90) + rxt(k,548)*y(k,124)) + mat(k,2271) = -rxt(k,547)*y(k,212) + mat(k,1840) = -rxt(k,548)*y(k,212) + mat(k,75) = rxt(k,549)*y(k,228) + mat(k,1676) = rxt(k,549)*y(k,104) + mat(k,1356) = -(rxt(k,372)*y(k,200) + rxt(k,373)*y(k,201) + rxt(k,374) & + *y(k,90) + rxt(k,375)*y(k,126) + (rxt(k,376) + rxt(k,377) & + ) * y(k,124)) + mat(k,1425) = -rxt(k,372)*y(k,213) + mat(k,2400) = -rxt(k,373)*y(k,213) + mat(k,2345) = -rxt(k,374)*y(k,213) + mat(k,1642) = -rxt(k,375)*y(k,213) + mat(k,1903) = -(rxt(k,376) + rxt(k,377)) * y(k,213) + mat(k,1271) = .500_r8*rxt(k,379)*y(k,228) + mat(k,317) = .200_r8*rxt(k,380)*y(k,228) + mat(k,1375) = rxt(k,393)*y(k,228) + mat(k,1805) = .500_r8*rxt(k,379)*y(k,105) + .200_r8*rxt(k,380)*y(k,106) & + + rxt(k,393)*y(k,111) + mat(k,740) = -(rxt(k,453)*y(k,90) + rxt(k,454)*y(k,124) + rxt(k,455)*y(k,125)) + mat(k,2312) = -rxt(k,453)*y(k,214) + mat(k,1867) = -rxt(k,454)*y(k,214) + mat(k,1937) = -rxt(k,455)*y(k,214) + mat(k,1397) = -(rxt(k,381)*y(k,200) + rxt(k,382)*y(k,201) + rxt(k,383) & + *y(k,90) + 4._r8*rxt(k,384)*y(k,215) + rxt(k,385)*y(k,124) & + + rxt(k,386)*y(k,126) + rxt(k,394)*y(k,125)) + mat(k,1427) = -rxt(k,381)*y(k,215) + mat(k,2402) = -rxt(k,382)*y(k,215) + mat(k,2347) = -rxt(k,383)*y(k,215) + mat(k,1905) = -rxt(k,385)*y(k,215) + mat(k,1644) = -rxt(k,386)*y(k,215) + mat(k,1948) = -rxt(k,394)*y(k,215) + mat(k,1272) = .500_r8*rxt(k,379)*y(k,228) + mat(k,318) = .500_r8*rxt(k,380)*y(k,228) + mat(k,1807) = .500_r8*rxt(k,379)*y(k,105) + .500_r8*rxt(k,380)*y(k,106) + mat(k,910) = -(rxt(k,456)*y(k,90) + rxt(k,457)*y(k,124) + rxt(k,458)*y(k,125)) + mat(k,2323) = -rxt(k,456)*y(k,216) + mat(k,1878) = -rxt(k,457)*y(k,216) + mat(k,1940) = -rxt(k,458)*y(k,216) + mat(k,698) = -(rxt(k,387)*y(k,90) + rxt(k,388)*y(k,124)) + mat(k,2308) = -rxt(k,387)*y(k,217) + mat(k,1866) = -rxt(k,388)*y(k,217) + mat(k,518) = rxt(k,389)*y(k,228) + mat(k,322) = rxt(k,390)*y(k,228) + mat(k,1757) = rxt(k,389)*y(k,107) + rxt(k,390)*y(k,108) + mat(k,82) = -(rxt(k,551)*y(k,90) + rxt(k,552)*y(k,124)) + mat(k,2272) = -rxt(k,551)*y(k,218) + mat(k,1841) = -rxt(k,552)*y(k,218) + mat(k,1014) = rxt(k,554)*y(k,228) + mat(k,1678) = rxt(k,554)*y(k,110) + mat(k,529) = -(rxt(k,188)*y(k,134) + rxt(k,189)*y(k,135)) + mat(k,2068) = -rxt(k,188)*y(k,219) + mat(k,1528) = -rxt(k,189)*y(k,219) + mat(k,2068) = mat(k,2068) + rxt(k,583)*y(k,220) + mat(k,860) = .900_r8*rxt(k,581)*y(k,220) + .800_r8*rxt(k,579)*y(k,221) + mat(k,675) = rxt(k,583)*y(k,134) + .900_r8*rxt(k,581)*y(k,203) + mat(k,844) = .800_r8*rxt(k,579)*y(k,203) + mat(k,676) = -(rxt(k,581)*y(k,203) + rxt(k,582)*y(k,135) + (rxt(k,583) & + + rxt(k,584)) * y(k,134)) + mat(k,861) = -rxt(k,581)*y(k,220) + mat(k,1529) = -rxt(k,582)*y(k,220) + mat(k,2071) = -(rxt(k,583) + rxt(k,584)) * y(k,220) + mat(k,845) = -(rxt(k,579)*y(k,203)) + mat(k,863) = -rxt(k,579)*y(k,221) + mat(k,996) = rxt(k,588)*y(k,227) + mat(k,1873) = rxt(k,590)*y(k,227) + mat(k,2077) = rxt(k,583)*y(k,220) + mat(k,1532) = rxt(k,587)*y(k,222) + mat(k,678) = rxt(k,583)*y(k,134) + mat(k,504) = rxt(k,587)*y(k,135) + mat(k,852) = rxt(k,588)*y(k,112) + rxt(k,590)*y(k,124) + mat(k,502) = -(rxt(k,585)*y(k,134) + (rxt(k,586) + rxt(k,587)) * y(k,135)) + mat(k,2067) = -rxt(k,585)*y(k,222) + mat(k,1527) = -(rxt(k,586) + rxt(k,587)) * y(k,222) + mat(k,1106) = -(rxt(k,485)*y(k,201) + rxt(k,486)*y(k,90) + rxt(k,487) & + *y(k,124) + rxt(k,488)*y(k,126)) + mat(k,2386) = -rxt(k,485)*y(k,223) + mat(k,2331) = -rxt(k,486)*y(k,223) + mat(k,1888) = -rxt(k,487)*y(k,223) + mat(k,1626) = -rxt(k,488)*y(k,223) + mat(k,980) = rxt(k,479)*y(k,126) + mat(k,1024) = rxt(k,482)*y(k,126) + mat(k,1626) = mat(k,1626) + rxt(k,479)*y(k,6) + rxt(k,482)*y(k,110) & + + .500_r8*rxt(k,499)*y(k,180) + mat(k,393) = rxt(k,489)*y(k,228) + mat(k,1073) = .500_r8*rxt(k,499)*y(k,126) + mat(k,1789) = rxt(k,489)*y(k,128) + mat(k,2031) = -(rxt(k,153)*y(k,77) + rxt(k,154)*y(k,241) + (rxt(k,156) & + + rxt(k,157)) * y(k,135) + rxt(k,158)*y(k,136) + (rxt(k,206) & + + rxt(k,207)) * y(k,113) + rxt(k,239)*y(k,33) + rxt(k,240) & + *y(k,34) + rxt(k,241)*y(k,36) + rxt(k,242)*y(k,37) + rxt(k,243) & + *y(k,38) + rxt(k,244)*y(k,39) + rxt(k,245)*y(k,40) + (rxt(k,246) & + + rxt(k,247)) * y(k,85) + rxt(k,266)*y(k,35) + rxt(k,267) & + *y(k,55) + rxt(k,268)*y(k,78) + (rxt(k,269) + rxt(k,270) & + ) * y(k,81) + rxt(k,275)*y(k,64) + rxt(k,276)*y(k,65) + rxt(k,289) & + *y(k,41) + rxt(k,290)*y(k,43) + rxt(k,291)*y(k,82) + rxt(k,292) & + *y(k,83) + rxt(k,293)*y(k,84) + (rxt(k,310) + rxt(k,311) & + + rxt(k,312)) * y(k,54) + rxt(k,313)*y(k,86)) + mat(k,1465) = -rxt(k,153)*y(k,224) + mat(k,2440) = -rxt(k,154)*y(k,224) + mat(k,1549) = -(rxt(k,156) + rxt(k,157)) * y(k,224) + mat(k,2228) = -rxt(k,158)*y(k,224) + mat(k,259) = -(rxt(k,206) + rxt(k,207)) * y(k,224) + mat(k,102) = -rxt(k,239)*y(k,224) + mat(k,142) = -rxt(k,240)*y(k,224) + mat(k,113) = -rxt(k,241)*y(k,224) + mat(k,152) = -rxt(k,242)*y(k,224) + mat(k,117) = -rxt(k,243)*y(k,224) + mat(k,157) = -rxt(k,244)*y(k,224) + mat(k,121) = -rxt(k,245)*y(k,224) + mat(k,1502) = -(rxt(k,246) + rxt(k,247)) * y(k,224) + mat(k,148) = -rxt(k,266)*y(k,224) + mat(k,389) = -rxt(k,267)*y(k,224) + mat(k,110) = -rxt(k,268)*y(k,224) + mat(k,832) = -(rxt(k,269) + rxt(k,270)) * y(k,224) + mat(k,240) = -rxt(k,275)*y(k,224) + mat(k,248) = -rxt(k,276)*y(k,224) + mat(k,483) = -rxt(k,289)*y(k,224) + mat(k,606) = -rxt(k,290)*y(k,224) + mat(k,244) = -rxt(k,291)*y(k,224) + mat(k,254) = -rxt(k,292)*y(k,224) + mat(k,295) = -rxt(k,293)*y(k,224) + mat(k,2253) = -(rxt(k,310) + rxt(k,311) + rxt(k,312)) * y(k,224) + mat(k,184) = -rxt(k,313)*y(k,224) + mat(k,1549) = mat(k,1549) + rxt(k,189)*y(k,219) + mat(k,871) = .850_r8*rxt(k,580)*y(k,227) + mat(k,533) = rxt(k,189)*y(k,135) + mat(k,858) = .850_r8*rxt(k,580)*y(k,203) + mat(k,177) = -(rxt(k,160)*y(k,134) + rxt(k,161)*y(k,135)) + mat(k,2064) = -rxt(k,160)*y(k,225) + mat(k,1524) = -rxt(k,161)*y(k,225) + mat(k,1442) = rxt(k,162)*y(k,226) + mat(k,2064) = mat(k,2064) + rxt(k,164)*y(k,226) + mat(k,1524) = mat(k,1524) + rxt(k,165)*y(k,226) + mat(k,2179) = rxt(k,166)*y(k,226) + mat(k,179) = rxt(k,162)*y(k,63) + rxt(k,164)*y(k,134) + rxt(k,165)*y(k,135) & + + rxt(k,166)*y(k,136) + mat(k,180) = -(rxt(k,162)*y(k,63) + rxt(k,164)*y(k,134) + rxt(k,165)*y(k,135) & + + rxt(k,166)*y(k,136)) + mat(k,1443) = -rxt(k,162)*y(k,226) + mat(k,2065) = -rxt(k,164)*y(k,226) + mat(k,1525) = -rxt(k,165)*y(k,226) + mat(k,2180) = -rxt(k,166)*y(k,226) + mat(k,1525) = mat(k,1525) + rxt(k,156)*y(k,224) + mat(k,2007) = rxt(k,156)*y(k,135) + end do + end subroutine nlnmat09 + subroutine nlnmat10( 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,853) = -(rxt(k,580)*y(k,203) + rxt(k,588)*y(k,112) + rxt(k,590) & + *y(k,124)) + mat(k,864) = -rxt(k,580)*y(k,227) + mat(k,997) = -rxt(k,588)*y(k,227) + mat(k,1874) = -rxt(k,590)*y(k,227) + mat(k,1446) = rxt(k,591)*y(k,229) + mat(k,1533) = rxt(k,582)*y(k,220) + rxt(k,586)*y(k,222) + rxt(k,593)*y(k,229) + mat(k,679) = rxt(k,582)*y(k,135) + mat(k,505) = rxt(k,586)*y(k,135) + mat(k,807) = rxt(k,591)*y(k,63) + rxt(k,593)*y(k,135) + mat(k,1818) = -(rxt(k,179)*y(k,77) + rxt(k,180)*y(k,79) + rxt(k,181)*y(k,90) & + + rxt(k,182)*y(k,134) + rxt(k,183)*y(k,136) + (4._r8*rxt(k,184) & + + 4._r8*rxt(k,185)) * y(k,228) + rxt(k,187)*y(k,91) + rxt(k,201) & + *y(k,126) + rxt(k,202)*y(k,112) + rxt(k,210)*y(k,125) + rxt(k,211) & + *y(k,89) + rxt(k,230)*y(k,60) + (rxt(k,232) + rxt(k,233) & + ) * y(k,59) + rxt(k,235)*y(k,85) + rxt(k,238)*y(k,93) + rxt(k,262) & + *y(k,19) + rxt(k,264)*y(k,81) + rxt(k,278)*y(k,41) + rxt(k,280) & + *y(k,43) + rxt(k,281)*y(k,44) + rxt(k,283)*y(k,46) + rxt(k,285) & + *y(k,55) + rxt(k,286)*y(k,82) + rxt(k,287)*y(k,83) + rxt(k,288) & + *y(k,84) + rxt(k,297)*y(k,42) + rxt(k,302)*y(k,52) + rxt(k,303) & + *y(k,53) + rxt(k,304)*y(k,54) + rxt(k,305)*y(k,86) + rxt(k,306) & + *y(k,87) + rxt(k,314)*y(k,62) + rxt(k,316)*y(k,24) + rxt(k,323) & + *y(k,26) + rxt(k,324)*y(k,27) + rxt(k,326)*y(k,28) + rxt(k,328) & + *y(k,45) + rxt(k,329)*y(k,47) + rxt(k,334)*y(k,50) + rxt(k,335) & + *y(k,51) + rxt(k,340)*y(k,74) + rxt(k,341)*y(k,75) + rxt(k,342) & + *y(k,141) + rxt(k,343)*y(k,25) + rxt(k,351)*y(k,30) + rxt(k,352) & + *y(k,31) + rxt(k,354)*y(k,49) + rxt(k,356)*y(k,96) + rxt(k,357) & + *y(k,127) + rxt(k,360)*y(k,148) + rxt(k,364)*y(k,149) + rxt(k,365) & + *y(k,29) + rxt(k,366)*y(k,48) + rxt(k,368)*y(k,16) + rxt(k,371) & + *y(k,94) + rxt(k,379)*y(k,105) + rxt(k,380)*y(k,106) + rxt(k,389) & + *y(k,107) + rxt(k,390)*y(k,108) + rxt(k,391)*y(k,109) + rxt(k,393) & + *y(k,111) + rxt(k,396)*y(k,1) + rxt(k,400)*y(k,2) + rxt(k,401) & + *y(k,15) + rxt(k,402)*y(k,95) + rxt(k,403)*y(k,97) + rxt(k,404) & + *y(k,98) + rxt(k,416)*y(k,100) + rxt(k,417)*y(k,101) + rxt(k,424) & + *y(k,102) + rxt(k,426)*y(k,99) + rxt(k,427)*y(k,103) + rxt(k,428) & + *y(k,115) + rxt(k,429)*y(k,116) + rxt(k,435)*y(k,184) + rxt(k,438) & + *y(k,7) + rxt(k,441)*y(k,8) + rxt(k,442)*y(k,22) + rxt(k,444) & + *y(k,23) + rxt(k,448)*y(k,32) + rxt(k,449)*y(k,66) + rxt(k,461) & + *y(k,144) + rxt(k,464)*y(k,145) + rxt(k,468)*y(k,182) + rxt(k,469) & + *y(k,183) + rxt(k,471)*y(k,185) + rxt(k,474)*y(k,186) + rxt(k,477) & + *y(k,187) + rxt(k,478)*y(k,188) + rxt(k,481)*y(k,6) + rxt(k,484) & + *y(k,110) + rxt(k,489)*y(k,128) + rxt(k,493)*y(k,177) + rxt(k,494) & + *y(k,178) + rxt(k,498)*y(k,179) + rxt(k,500)*y(k,180) + rxt(k,501) & + *y(k,181) + (rxt(k,503) + rxt(k,517)) * y(k,67) + rxt(k,505) & + *y(k,139) + rxt(k,507)*y(k,153) + rxt(k,511)*y(k,150) + rxt(k,516) & + *y(k,152) + rxt(k,519)*y(k,120)) + mat(k,1464) = -rxt(k,179)*y(k,228) + mat(k,584) = -rxt(k,180)*y(k,228) + mat(k,2357) = -rxt(k,181)*y(k,228) + mat(k,2093) = -rxt(k,182)*y(k,228) + mat(k,2224) = -rxt(k,183)*y(k,228) + mat(k,475) = -rxt(k,187)*y(k,228) + mat(k,1653) = -rxt(k,201)*y(k,228) + mat(k,1003) = -rxt(k,202)*y(k,228) + mat(k,1958) = -rxt(k,210)*y(k,228) + mat(k,2050) = -rxt(k,211)*y(k,228) + mat(k,959) = -rxt(k,230)*y(k,228) + mat(k,1594) = -(rxt(k,232) + rxt(k,233)) * y(k,228) + mat(k,1500) = -rxt(k,235)*y(k,228) + mat(k,840) = -rxt(k,238)*y(k,228) + mat(k,1568) = -rxt(k,262)*y(k,228) + mat(k,831) = -rxt(k,264)*y(k,228) + mat(k,482) = -rxt(k,278)*y(k,228) + mat(k,605) = -rxt(k,280)*y(k,228) + mat(k,124) = -rxt(k,281)*y(k,228) + mat(k,374) = -rxt(k,283)*y(k,228) + mat(k,388) = -rxt(k,285)*y(k,228) + mat(k,243) = -rxt(k,286)*y(k,228) + mat(k,253) = -rxt(k,287)*y(k,228) + mat(k,294) = -rxt(k,288)*y(k,228) + mat(k,1984) = -rxt(k,297)*y(k,228) + mat(k,825) = -rxt(k,302)*y(k,228) + mat(k,455) = -rxt(k,303)*y(k,228) + mat(k,2249) = -rxt(k,304)*y(k,228) + mat(k,183) = -rxt(k,305)*y(k,228) + mat(k,921) = -rxt(k,306)*y(k,228) + mat(k,1162) = -rxt(k,314)*y(k,228) + mat(k,289) = -rxt(k,316)*y(k,228) + mat(k,267) = -rxt(k,323)*y(k,228) + mat(k,353) = -rxt(k,324)*y(k,228) + mat(k,301) = -rxt(k,326)*y(k,228) + mat(k,1155) = -rxt(k,328)*y(k,228) + mat(k,105) = -rxt(k,329)*y(k,228) + mat(k,707) = -rxt(k,334)*y(k,228) + mat(k,623) = -rxt(k,335)*y(k,228) + mat(k,1168) = -rxt(k,340)*y(k,228) + mat(k,1057) = -rxt(k,341)*y(k,228) + mat(k,538) = -rxt(k,342)*y(k,228) + mat(k,554) = -rxt(k,343)*y(k,228) + mat(k,412) = -rxt(k,351)*y(k,228) + mat(k,307) = -rxt(k,352)*y(k,228) + mat(k,1285) = -rxt(k,354)*y(k,228) + mat(k,1211) = -rxt(k,356)*y(k,228) + mat(k,895) = -rxt(k,357)*y(k,228) + mat(k,546) = -rxt(k,360)*y(k,228) + mat(k,400) = -rxt(k,364)*y(k,228) + mat(k,1142) = -rxt(k,365)*y(k,228) + mat(k,1083) = -rxt(k,366)*y(k,228) + mat(k,360) = -rxt(k,368)*y(k,228) + mat(k,1201) = -rxt(k,371)*y(k,228) + mat(k,1275) = -rxt(k,379)*y(k,228) + mat(k,319) = -rxt(k,380)*y(k,228) + mat(k,521) = -rxt(k,389)*y(k,228) + mat(k,325) = -rxt(k,390)*y(k,228) + mat(k,616) = -rxt(k,391)*y(k,228) + mat(k,1382) = -rxt(k,393)*y(k,228) + mat(k,648) = -rxt(k,396)*y(k,228) + mat(k,694) = -rxt(k,400)*y(k,228) + mat(k,228) = -rxt(k,401)*y(k,228) + mat(k,224) = -rxt(k,402)*y(k,228) + mat(k,328) = -rxt(k,403)*y(k,228) + mat(k,135) = -rxt(k,404)*y(k,228) + mat(k,593) = -rxt(k,416)*y(k,228) + mat(k,563) = -rxt(k,417)*y(k,228) + mat(k,406) = -rxt(k,424)*y(k,228) + mat(k,887) = -rxt(k,426)*y(k,228) + mat(k,715) = -rxt(k,427)*y(k,228) + mat(k,430) = -rxt(k,428)*y(k,228) + mat(k,1095) = -rxt(k,429)*y(k,228) + mat(k,205) = -rxt(k,435)*y(k,228) + mat(k,164) = -rxt(k,438)*y(k,228) + mat(k,419) = -rxt(k,441)*y(k,228) + mat(k,237) = -rxt(k,442)*y(k,228) + mat(k,348) = -rxt(k,444)*y(k,228) + mat(k,272) = -rxt(k,448)*y(k,228) + mat(k,197) = -rxt(k,449)*y(k,228) + mat(k,173) = -rxt(k,461)*y(k,228) + mat(k,342) = -rxt(k,464)*y(k,228) + mat(k,673) = -rxt(k,468)*y(k,228) + mat(k,192) = -rxt(k,469)*y(k,228) + mat(k,214) = -rxt(k,471)*y(k,228) + mat(k,738) = -rxt(k,474)*y(k,228) + mat(k,219) = -rxt(k,477)*y(k,228) + mat(k,425) = -rxt(k,478)*y(k,228) + mat(k,988) = -rxt(k,481)*y(k,228) + mat(k,1032) = -rxt(k,484)*y(k,228) + mat(k,394) = -rxt(k,489)*y(k,228) + mat(k,659) = -rxt(k,493)*y(k,228) + mat(k,629) = -rxt(k,494)*y(k,228) + mat(k,490) = -rxt(k,498)*y(k,228) + mat(k,1078) = -rxt(k,500)*y(k,228) + mat(k,1124) = -rxt(k,501)*y(k,228) + mat(k,313) = -(rxt(k,503) + rxt(k,517)) * y(k,228) + mat(k,368) = -rxt(k,505)*y(k,228) + mat(k,949) = -rxt(k,507)*y(k,228) + mat(k,721) = -rxt(k,511)*y(k,228) + mat(k,1481) = -rxt(k,516)*y(k,228) + mat(k,99) = -rxt(k,519)*y(k,228) + mat(k,988) = mat(k,988) + .630_r8*rxt(k,480)*y(k,136) + mat(k,289) = mat(k,289) + .650_r8*rxt(k,316)*y(k,228) + mat(k,554) = mat(k,554) + .130_r8*rxt(k,318)*y(k,136) + mat(k,353) = mat(k,353) + .500_r8*rxt(k,324)*y(k,228) + mat(k,1142) = mat(k,1142) + .360_r8*rxt(k,347)*y(k,136) + mat(k,1984) = mat(k,1984) + rxt(k,296)*y(k,134) + mat(k,455) = mat(k,455) + .300_r8*rxt(k,303)*y(k,228) + mat(k,2249) = mat(k,2249) + rxt(k,310)*y(k,224) + mat(k,2160) = rxt(k,219)*y(k,90) + mat(k,928) = rxt(k,273)*y(k,241) + mat(k,2114) = 2.000_r8*rxt(k,173)*y(k,90) + rxt(k,178)*y(k,136) + mat(k,1464) = mat(k,1464) + rxt(k,170)*y(k,134) + rxt(k,153)*y(k,224) + mat(k,584) = mat(k,584) + rxt(k,171)*y(k,134) + mat(k,831) = mat(k,831) + rxt(k,263)*y(k,134) + rxt(k,269)*y(k,224) + mat(k,1500) = mat(k,1500) + rxt(k,234)*y(k,134) + rxt(k,246)*y(k,224) + mat(k,183) = mat(k,183) + rxt(k,313)*y(k,224) + mat(k,2357) = mat(k,2357) + rxt(k,219)*y(k,56) + 2.000_r8*rxt(k,173)*y(k,76) & + + rxt(k,203)*y(k,124) + rxt(k,198)*y(k,126) + rxt(k,176) & + *y(k,134) + rxt(k,177)*y(k,136) + .400_r8*rxt(k,436)*y(k,191) & + + .450_r8*rxt(k,332)*y(k,200) + .400_r8*rxt(k,450)*y(k,202) & + + .450_r8*rxt(k,383)*y(k,215) + .400_r8*rxt(k,456)*y(k,216) & + + .200_r8*rxt(k,387)*y(k,217) + .150_r8*rxt(k,362)*y(k,232) + mat(k,791) = rxt(k,265)*y(k,134) + mat(k,840) = mat(k,840) + rxt(k,237)*y(k,134) + mat(k,887) = mat(k,887) + .320_r8*rxt(k,425)*y(k,136) + mat(k,715) = mat(k,715) + .600_r8*rxt(k,427)*y(k,228) + mat(k,1275) = mat(k,1275) + .240_r8*rxt(k,378)*y(k,136) + mat(k,319) = mat(k,319) + .100_r8*rxt(k,380)*y(k,228) + mat(k,1032) = mat(k,1032) + .630_r8*rxt(k,483)*y(k,136) + mat(k,1382) = mat(k,1382) + .360_r8*rxt(k,392)*y(k,136) + mat(k,1913) = rxt(k,203)*y(k,90) + mat(k,1653) = mat(k,1653) + rxt(k,198)*y(k,90) + mat(k,2093) = mat(k,2093) + rxt(k,296)*y(k,42) + rxt(k,170)*y(k,77) & + + rxt(k,171)*y(k,79) + rxt(k,263)*y(k,81) + rxt(k,234)*y(k,85) & + + rxt(k,176)*y(k,90) + rxt(k,265)*y(k,92) + rxt(k,237)*y(k,93) + mat(k,2224) = mat(k,2224) + .630_r8*rxt(k,480)*y(k,6) + .130_r8*rxt(k,318) & + *y(k,25) + .360_r8*rxt(k,347)*y(k,29) + rxt(k,178)*y(k,76) & + + rxt(k,177)*y(k,90) + .320_r8*rxt(k,425)*y(k,99) & + + .240_r8*rxt(k,378)*y(k,105) + .630_r8*rxt(k,483)*y(k,110) & + + .360_r8*rxt(k,392)*y(k,111) + mat(k,546) = mat(k,546) + .500_r8*rxt(k,360)*y(k,228) + mat(k,205) = mat(k,205) + .500_r8*rxt(k,435)*y(k,228) + mat(k,525) = .400_r8*rxt(k,436)*y(k,90) + mat(k,1432) = .450_r8*rxt(k,332)*y(k,90) + mat(k,781) = .400_r8*rxt(k,450)*y(k,90) + mat(k,1401) = .450_r8*rxt(k,383)*y(k,90) + mat(k,914) = .400_r8*rxt(k,456)*y(k,90) + mat(k,701) = .200_r8*rxt(k,387)*y(k,90) + mat(k,2027) = rxt(k,310)*y(k,54) + rxt(k,153)*y(k,77) + rxt(k,269)*y(k,81) & + + rxt(k,246)*y(k,85) + rxt(k,313)*y(k,86) + 2.000_r8*rxt(k,154) & + *y(k,241) + mat(k,1818) = mat(k,1818) + .650_r8*rxt(k,316)*y(k,24) + .500_r8*rxt(k,324) & + *y(k,27) + .300_r8*rxt(k,303)*y(k,53) + .600_r8*rxt(k,427) & + *y(k,103) + .100_r8*rxt(k,380)*y(k,106) + .500_r8*rxt(k,360) & + *y(k,148) + .500_r8*rxt(k,435)*y(k,184) + mat(k,1220) = .150_r8*rxt(k,362)*y(k,90) + mat(k,2436) = rxt(k,273)*y(k,73) + 2.000_r8*rxt(k,154)*y(k,224) + end do + end subroutine nlnmat10 + subroutine nlnmat11( 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,805) = -(rxt(k,591)*y(k,63) + rxt(k,593)*y(k,135)) + mat(k,1444) = -rxt(k,591)*y(k,229) + mat(k,1531) = -rxt(k,593)*y(k,229) + mat(k,2074) = rxt(k,584)*y(k,220) + rxt(k,585)*y(k,222) + mat(k,677) = rxt(k,584)*y(k,134) + mat(k,503) = rxt(k,585)*y(k,134) + mat(k,448) = -(rxt(k,459)*y(k,90) + rxt(k,460)*y(k,124)) + mat(k,2291) = -rxt(k,459)*y(k,230) + mat(k,1851) = -rxt(k,460)*y(k,230) + mat(k,195) = .200_r8*rxt(k,449)*y(k,228) + mat(k,171) = .140_r8*rxt(k,461)*y(k,228) + mat(k,340) = rxt(k,464)*y(k,228) + mat(k,1729) = .200_r8*rxt(k,449)*y(k,66) + .140_r8*rxt(k,461)*y(k,144) & + + rxt(k,464)*y(k,145) + mat(k,814) = -(rxt(k,358)*y(k,90) + rxt(k,359)*y(k,124)) + mat(k,2318) = -rxt(k,358)*y(k,231) + mat(k,1872) = -rxt(k,359)*y(k,231) + mat(k,1130) = rxt(k,365)*y(k,228) + mat(k,543) = .500_r8*rxt(k,360)*y(k,228) + mat(k,1767) = rxt(k,365)*y(k,29) + .500_r8*rxt(k,360)*y(k,148) + mat(k,1217) = -(rxt(k,361)*y(k,201) + rxt(k,362)*y(k,90) + rxt(k,363) & + *y(k,124)) + mat(k,2393) = -rxt(k,361)*y(k,232) + mat(k,2338) = -rxt(k,362)*y(k,232) + mat(k,1896) = -rxt(k,363)*y(k,232) + mat(k,983) = .060_r8*rxt(k,480)*y(k,136) + mat(k,1081) = rxt(k,366)*y(k,228) + mat(k,1027) = .060_r8*rxt(k,483)*y(k,136) + mat(k,2207) = .060_r8*rxt(k,480)*y(k,6) + .060_r8*rxt(k,483)*y(k,110) + mat(k,398) = rxt(k,364)*y(k,228) + mat(k,1121) = .150_r8*rxt(k,501)*y(k,228) + mat(k,1798) = rxt(k,366)*y(k,48) + rxt(k,364)*y(k,149) + .150_r8*rxt(k,501) & + *y(k,181) + mat(k,1178) = -(rxt(k,490)*y(k,201) + rxt(k,491)*y(k,90) + rxt(k,492) & + *y(k,124)) + mat(k,2391) = -rxt(k,490)*y(k,233) + mat(k,2336) = -rxt(k,491)*y(k,233) + mat(k,1893) = -rxt(k,492)*y(k,233) + mat(k,1632) = .500_r8*rxt(k,499)*y(k,180) + mat(k,657) = rxt(k,493)*y(k,228) + mat(k,1076) = .500_r8*rxt(k,499)*y(k,126) + rxt(k,500)*y(k,228) + mat(k,1795) = rxt(k,493)*y(k,177) + rxt(k,500)*y(k,180) + mat(k,1062) = -(rxt(k,495)*y(k,201) + rxt(k,496)*y(k,90) + rxt(k,497) & + *y(k,124)) + mat(k,2382) = -rxt(k,495)*y(k,234) + mat(k,2328) = -rxt(k,496)*y(k,234) + mat(k,1884) = -rxt(k,497)*y(k,234) + mat(k,977) = rxt(k,481)*y(k,228) + mat(k,1021) = rxt(k,484)*y(k,228) + mat(k,487) = rxt(k,498)*y(k,228) + mat(k,1785) = rxt(k,481)*y(k,6) + rxt(k,484)*y(k,110) + rxt(k,498)*y(k,179) + mat(k,751) = -(rxt(k,466)*y(k,90) + rxt(k,467)*y(k,124)) + mat(k,2313) = -rxt(k,466)*y(k,235) + mat(k,1868) = -rxt(k,467)*y(k,235) + mat(k,667) = rxt(k,468)*y(k,228) + mat(k,191) = .650_r8*rxt(k,469)*y(k,228) + mat(k,1763) = rxt(k,468)*y(k,182) + .650_r8*rxt(k,469)*y(k,183) + mat(k,88) = -(rxt(k,557)*y(k,90) + rxt(k,558)*y(k,124)) + mat(k,2273) = -rxt(k,557)*y(k,236) + mat(k,1842) = -rxt(k,558)*y(k,236) + mat(k,186) = rxt(k,556)*y(k,228) + mat(k,1679) = rxt(k,556)*y(k,183) + mat(k,1233) = -(rxt(k,430)*y(k,200) + rxt(k,431)*y(k,201) + rxt(k,432) & + *y(k,90) + rxt(k,433)*y(k,124) + rxt(k,434)*y(k,126)) + mat(k,1419) = -rxt(k,430)*y(k,237) + mat(k,2394) = -rxt(k,431)*y(k,237) + mat(k,2339) = -rxt(k,432)*y(k,237) + mat(k,1897) = -rxt(k,433)*y(k,237) + mat(k,1636) = -rxt(k,434)*y(k,237) + mat(k,223) = rxt(k,402)*y(k,228) + mat(k,327) = rxt(k,403)*y(k,228) + mat(k,134) = rxt(k,404)*y(k,228) + mat(k,712) = .400_r8*rxt(k,427)*y(k,228) + mat(k,204) = .500_r8*rxt(k,435)*y(k,228) + mat(k,1799) = rxt(k,402)*y(k,95) + rxt(k,403)*y(k,97) + rxt(k,404)*y(k,98) & + + .400_r8*rxt(k,427)*y(k,103) + .500_r8*rxt(k,435)*y(k,184) + mat(k,767) = -(rxt(k,472)*y(k,90) + rxt(k,473)*y(k,124)) + mat(k,2314) = -rxt(k,472)*y(k,238) + mat(k,1869) = -rxt(k,473)*y(k,238) + mat(k,211) = .560_r8*rxt(k,471)*y(k,228) + mat(k,731) = rxt(k,474)*y(k,228) + mat(k,1764) = .560_r8*rxt(k,471)*y(k,185) + rxt(k,474)*y(k,186) + mat(k,94) = -(rxt(k,560)*y(k,90) + rxt(k,561)*y(k,124)) + mat(k,2274) = -rxt(k,560)*y(k,239) + mat(k,1843) = -rxt(k,561)*y(k,239) + mat(k,206) = rxt(k,559)*y(k,228) + mat(k,1680) = rxt(k,559)*y(k,185) + mat(k,510) = -(rxt(k,475)*y(k,90) + rxt(k,476)*y(k,124)) + mat(k,2299) = -rxt(k,475)*y(k,240) + mat(k,1856) = -rxt(k,476)*y(k,240) + mat(k,218) = .300_r8*rxt(k,477)*y(k,228) + mat(k,422) = rxt(k,478)*y(k,228) + mat(k,1737) = .300_r8*rxt(k,477)*y(k,187) + rxt(k,478)*y(k,188) + mat(k,2449) = -(rxt(k,154)*y(k,224) + rxt(k,273)*y(k,73) + rxt(k,518) & + *y(k,154)) + mat(k,2040) = -rxt(k,154)*y(k,241) + mat(k,933) = -rxt(k,273)*y(k,241) + mat(k,264) = -rxt(k,518)*y(k,241) + mat(k,303) = rxt(k,326)*y(k,228) + mat(k,414) = rxt(k,351)*y(k,228) + mat(k,309) = rxt(k,352)*y(k,228) + mat(k,485) = rxt(k,278)*y(k,228) + mat(k,1997) = rxt(k,297)*y(k,228) + mat(k,610) = rxt(k,280)*y(k,228) + mat(k,126) = rxt(k,281)*y(k,228) + mat(k,1159) = rxt(k,328)*y(k,228) + mat(k,378) = rxt(k,283)*y(k,228) + mat(k,1085) = rxt(k,366)*y(k,228) + mat(k,1288) = rxt(k,354)*y(k,228) + mat(k,709) = rxt(k,334)*y(k,228) + mat(k,626) = rxt(k,335)*y(k,228) + mat(k,459) = rxt(k,303)*y(k,228) + mat(k,2262) = rxt(k,304)*y(k,228) + mat(k,2127) = rxt(k,174)*y(k,90) + mat(k,1472) = rxt(k,179)*y(k,228) + mat(k,588) = rxt(k,180)*y(k,228) + mat(k,835) = rxt(k,264)*y(k,228) + mat(k,297) = rxt(k,288)*y(k,228) + mat(k,1507) = (rxt(k,570)+rxt(k,575))*y(k,92) + (rxt(k,563)+rxt(k,569) & + +rxt(k,574))*y(k,93) + rxt(k,235)*y(k,228) + mat(k,923) = rxt(k,306)*y(k,228) + mat(k,2063) = rxt(k,211)*y(k,228) + mat(k,2370) = rxt(k,174)*y(k,76) + rxt(k,181)*y(k,228) + mat(k,478) = rxt(k,187)*y(k,228) + mat(k,794) = (rxt(k,570)+rxt(k,575))*y(k,85) + mat(k,843) = (rxt(k,563)+rxt(k,569)+rxt(k,574))*y(k,85) + rxt(k,238)*y(k,228) + mat(k,1279) = .500_r8*rxt(k,379)*y(k,228) + mat(k,100) = rxt(k,519)*y(k,228) + mat(k,549) = rxt(k,360)*y(k,228) + mat(k,402) = rxt(k,364)*y(k,228) + mat(k,1831) = rxt(k,326)*y(k,28) + rxt(k,351)*y(k,30) + rxt(k,352)*y(k,31) & + + rxt(k,278)*y(k,41) + rxt(k,297)*y(k,42) + rxt(k,280)*y(k,43) & + + rxt(k,281)*y(k,44) + rxt(k,328)*y(k,45) + rxt(k,283)*y(k,46) & + + rxt(k,366)*y(k,48) + rxt(k,354)*y(k,49) + rxt(k,334)*y(k,50) & + + rxt(k,335)*y(k,51) + rxt(k,303)*y(k,53) + rxt(k,304)*y(k,54) & + + rxt(k,179)*y(k,77) + rxt(k,180)*y(k,79) + rxt(k,264)*y(k,81) & + + rxt(k,288)*y(k,84) + rxt(k,235)*y(k,85) + rxt(k,306)*y(k,87) & + + rxt(k,211)*y(k,89) + rxt(k,181)*y(k,90) + rxt(k,187)*y(k,91) & + + rxt(k,238)*y(k,93) + .500_r8*rxt(k,379)*y(k,105) + rxt(k,519) & + *y(k,120) + rxt(k,360)*y(k,148) + rxt(k,364)*y(k,149) & + + 2.000_r8*rxt(k,184)*y(k,228) + end do + end subroutine nlnmat11 + 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) = lmat(k, 39) + mat(k, 40) = lmat(k, 40) + mat(k, 41) = lmat(k, 41) + mat(k, 42) = lmat(k, 42) + mat(k, 43) = lmat(k, 43) + mat(k, 44) = lmat(k, 44) + mat(k, 50) = mat(k, 50) + lmat(k, 50) + mat(k, 56) = mat(k, 56) + lmat(k, 56) + mat(k, 62) = mat(k, 62) + lmat(k, 62) + mat(k, 68) = mat(k, 68) + lmat(k, 68) + mat(k, 74) = mat(k, 74) + lmat(k, 74) + mat(k, 76) = mat(k, 76) + lmat(k, 76) + mat(k, 82) = mat(k, 82) + lmat(k, 82) + mat(k, 88) = mat(k, 88) + lmat(k, 88) + mat(k, 94) = mat(k, 94) + lmat(k, 94) + mat(k, 95) = lmat(k, 95) + mat(k, 96) = lmat(k, 96) + mat(k, 97) = lmat(k, 97) + mat(k, 98) = mat(k, 98) + lmat(k, 98) + mat(k, 101) = mat(k, 101) + lmat(k, 101) + mat(k, 103) = mat(k, 103) + lmat(k, 103) + mat(k, 104) = mat(k, 104) + lmat(k, 104) + mat(k, 107) = mat(k, 107) + lmat(k, 107) + mat(k, 108) = mat(k, 108) + lmat(k, 108) + mat(k, 109) = mat(k, 109) + lmat(k, 109) + mat(k, 111) = mat(k, 111) + lmat(k, 111) + mat(k, 112) = mat(k, 112) + lmat(k, 112) + mat(k, 114) = mat(k, 114) + lmat(k, 114) + mat(k, 115) = mat(k, 115) + lmat(k, 115) + mat(k, 116) = mat(k, 116) + lmat(k, 116) + mat(k, 118) = mat(k, 118) + lmat(k, 118) + mat(k, 119) = mat(k, 119) + lmat(k, 119) + mat(k, 120) = mat(k, 120) + lmat(k, 120) + mat(k, 122) = mat(k, 122) + lmat(k, 122) + mat(k, 123) = mat(k, 123) + lmat(k, 123) + mat(k, 125) = mat(k, 125) + lmat(k, 125) + mat(k, 127) = lmat(k, 127) + mat(k, 128) = lmat(k, 128) + mat(k, 129) = lmat(k, 129) + mat(k, 130) = lmat(k, 130) + mat(k, 131) = lmat(k, 131) + mat(k, 132) = lmat(k, 132) + mat(k, 133) = mat(k, 133) + lmat(k, 133) + mat(k, 136) = lmat(k, 136) + mat(k, 137) = lmat(k, 137) + mat(k, 138) = lmat(k, 138) + mat(k, 139) = mat(k, 139) + lmat(k, 139) + mat(k, 140) = mat(k, 140) + lmat(k, 140) + mat(k, 141) = mat(k, 141) + lmat(k, 141) + mat(k, 143) = mat(k, 143) + lmat(k, 143) + mat(k, 144) = mat(k, 144) + lmat(k, 144) + mat(k, 145) = mat(k, 145) + lmat(k, 145) + mat(k, 146) = mat(k, 146) + lmat(k, 146) + mat(k, 147) = mat(k, 147) + lmat(k, 147) + mat(k, 149) = mat(k, 149) + lmat(k, 149) + mat(k, 150) = mat(k, 150) + lmat(k, 150) + mat(k, 151) = mat(k, 151) + lmat(k, 151) + mat(k, 153) = mat(k, 153) + lmat(k, 153) + mat(k, 154) = mat(k, 154) + lmat(k, 154) + mat(k, 155) = mat(k, 155) + lmat(k, 155) + mat(k, 156) = mat(k, 156) + lmat(k, 156) + mat(k, 158) = mat(k, 158) + lmat(k, 158) + mat(k, 160) = mat(k, 160) + lmat(k, 160) + mat(k, 166) = lmat(k, 166) + mat(k, 167) = lmat(k, 167) + mat(k, 168) = lmat(k, 168) + mat(k, 169) = lmat(k, 169) + mat(k, 170) = mat(k, 170) + lmat(k, 170) + mat(k, 175) = lmat(k, 175) + mat(k, 176) = lmat(k, 176) + mat(k, 177) = 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) = mat(k, 180) + lmat(k, 180) + mat(k, 181) = lmat(k, 181) + mat(k, 182) = mat(k, 182) + lmat(k, 182) + mat(k, 187) = mat(k, 187) + lmat(k, 187) + mat(k, 194) = mat(k, 194) + lmat(k, 194) + mat(k, 199) = lmat(k, 199) + mat(k, 200) = lmat(k, 200) + mat(k, 201) = lmat(k, 201) + mat(k, 202) = lmat(k, 202) + mat(k, 203) = mat(k, 203) + lmat(k, 203) + mat(k, 205) = mat(k, 205) + lmat(k, 205) + mat(k, 208) = mat(k, 208) + lmat(k, 208) + mat(k, 216) = mat(k, 216) + lmat(k, 216) + mat(k, 221) = mat(k, 221) + lmat(k, 221) + mat(k, 222) = lmat(k, 222) + mat(k, 224) = mat(k, 224) + lmat(k, 224) + mat(k, 225) = lmat(k, 225) + mat(k, 226) = mat(k, 226) + lmat(k, 226) + mat(k, 229) = lmat(k, 229) + mat(k, 230) = lmat(k, 230) + mat(k, 231) = lmat(k, 231) + mat(k, 232) = lmat(k, 232) + mat(k, 233) = lmat(k, 233) + mat(k, 234) = lmat(k, 234) + mat(k, 235) = mat(k, 235) + lmat(k, 235) + mat(k, 238) = mat(k, 238) + lmat(k, 238) + mat(k, 239) = mat(k, 239) + lmat(k, 239) + mat(k, 241) = mat(k, 241) + lmat(k, 241) + mat(k, 242) = mat(k, 242) + lmat(k, 242) + mat(k, 245) = mat(k, 245) + lmat(k, 245) + mat(k, 246) = mat(k, 246) + lmat(k, 246) + mat(k, 247) = mat(k, 247) + lmat(k, 247) + mat(k, 249) = mat(k, 249) + lmat(k, 249) + mat(k, 250) = mat(k, 250) + lmat(k, 250) + mat(k, 251) = mat(k, 251) + lmat(k, 251) + mat(k, 255) = mat(k, 255) + lmat(k, 255) + mat(k, 256) = mat(k, 256) + lmat(k, 256) + mat(k, 259) = mat(k, 259) + lmat(k, 259) + mat(k, 261) = mat(k, 261) + lmat(k, 261) + mat(k, 262) = lmat(k, 262) + mat(k, 263) = lmat(k, 263) + mat(k, 265) = mat(k, 265) + lmat(k, 265) + mat(k, 269) = mat(k, 269) + lmat(k, 269) + mat(k, 270) = lmat(k, 270) + mat(k, 272) = mat(k, 272) + lmat(k, 272) + mat(k, 273) = lmat(k, 273) + mat(k, 274) = lmat(k, 274) + mat(k, 275) = lmat(k, 275) + mat(k, 276) = lmat(k, 276) + mat(k, 277) = lmat(k, 277) + mat(k, 278) = lmat(k, 278) + mat(k, 279) = lmat(k, 279) + mat(k, 280) = lmat(k, 280) + mat(k, 281) = lmat(k, 281) + mat(k, 282) = lmat(k, 282) + mat(k, 283) = lmat(k, 283) + mat(k, 284) = lmat(k, 284) + mat(k, 285) = mat(k, 285) + lmat(k, 285) + mat(k, 291) = mat(k, 291) + lmat(k, 291) + mat(k, 292) = mat(k, 292) + lmat(k, 292) + mat(k, 296) = mat(k, 296) + lmat(k, 296) + mat(k, 298) = mat(k, 298) + lmat(k, 298) + mat(k, 304) = mat(k, 304) + lmat(k, 304) + mat(k, 310) = mat(k, 310) + lmat(k, 310) + mat(k, 316) = mat(k, 316) + lmat(k, 316) + mat(k, 321) = mat(k, 321) + lmat(k, 321) + mat(k, 323) = lmat(k, 323) + mat(k, 324) = lmat(k, 324) + mat(k, 325) = mat(k, 325) + lmat(k, 325) + mat(k, 326) = mat(k, 326) + lmat(k, 326) + mat(k, 329) = lmat(k, 329) + mat(k, 330) = lmat(k, 330) + mat(k, 331) = lmat(k, 331) + mat(k, 332) = lmat(k, 332) + mat(k, 333) = lmat(k, 333) + mat(k, 334) = mat(k, 334) + lmat(k, 334) + mat(k, 337) = mat(k, 337) + lmat(k, 337) + mat(k, 338) = lmat(k, 338) + mat(k, 339) = mat(k, 339) + lmat(k, 339) + mat(k, 341) = lmat(k, 341) + mat(k, 342) = mat(k, 342) + lmat(k, 342) + mat(k, 343) = lmat(k, 343) + mat(k, 344) = lmat(k, 344) + mat(k, 345) = mat(k, 345) + lmat(k, 345) + mat(k, 348) = mat(k, 348) + lmat(k, 348) + mat(k, 349) = lmat(k, 349) + mat(k, 350) = mat(k, 350) + lmat(k, 350) + mat(k, 352) = mat(k, 352) + lmat(k, 352) + mat(k, 353) = mat(k, 353) + lmat(k, 353) + mat(k, 354) = lmat(k, 354) + mat(k, 355) = mat(k, 355) + lmat(k, 355) + mat(k, 363) = mat(k, 363) + lmat(k, 363) + mat(k, 364) = lmat(k, 364) + mat(k, 366) = mat(k, 366) + lmat(k, 366) + mat(k, 371) = mat(k, 371) + lmat(k, 371) + mat(k, 375) = mat(k, 375) + lmat(k, 375) + mat(k, 377) = lmat(k, 377) + mat(k, 379) = lmat(k, 379) + mat(k, 380) = lmat(k, 380) + mat(k, 381) = lmat(k, 381) + mat(k, 382) = lmat(k, 382) + mat(k, 383) = lmat(k, 383) + mat(k, 384) = lmat(k, 384) + mat(k, 385) = mat(k, 385) + lmat(k, 385) + mat(k, 387) = mat(k, 387) + lmat(k, 387) + mat(k, 391) = mat(k, 391) + lmat(k, 391) + mat(k, 392) = lmat(k, 392) + mat(k, 394) = mat(k, 394) + lmat(k, 394) + mat(k, 395) = lmat(k, 395) + mat(k, 396) = lmat(k, 396) + mat(k, 397) = mat(k, 397) + lmat(k, 397) + mat(k, 399) = lmat(k, 399) + mat(k, 400) = mat(k, 400) + lmat(k, 400) + mat(k, 401) = lmat(k, 401) + mat(k, 403) = mat(k, 403) + lmat(k, 403) + mat(k, 404) = lmat(k, 404) + mat(k, 407) = lmat(k, 407) + mat(k, 408) = mat(k, 408) + lmat(k, 408) + mat(k, 409) = mat(k, 409) + lmat(k, 409) + mat(k, 411) = lmat(k, 411) + mat(k, 412) = mat(k, 412) + lmat(k, 412) + mat(k, 413) = lmat(k, 413) + mat(k, 415) = mat(k, 415) + lmat(k, 415) + mat(k, 416) = lmat(k, 416) + mat(k, 418) = lmat(k, 418) + mat(k, 419) = mat(k, 419) + lmat(k, 419) + mat(k, 420) = lmat(k, 420) + mat(k, 421) = mat(k, 421) + lmat(k, 421) + mat(k, 423) = lmat(k, 423) + mat(k, 424) = lmat(k, 424) + mat(k, 425) = mat(k, 425) + lmat(k, 425) + mat(k, 426) = lmat(k, 426) + mat(k, 427) = mat(k, 427) + lmat(k, 427) + mat(k, 431) = lmat(k, 431) + mat(k, 435) = mat(k, 435) + lmat(k, 435) + mat(k, 441) = mat(k, 441) + lmat(k, 441) + mat(k, 445) = lmat(k, 445) + mat(k, 446) = mat(k, 446) + lmat(k, 446) + mat(k, 448) = mat(k, 448) + lmat(k, 448) + mat(k, 454) = mat(k, 454) + lmat(k, 454) + mat(k, 455) = mat(k, 455) + lmat(k, 455) + mat(k, 456) = mat(k, 456) + lmat(k, 456) + mat(k, 457) = lmat(k, 457) + mat(k, 460) = mat(k, 460) + lmat(k, 460) + mat(k, 463) = lmat(k, 463) + mat(k, 464) = mat(k, 464) + lmat(k, 464) + mat(k, 465) = lmat(k, 465) + mat(k, 466) = lmat(k, 466) + mat(k, 467) = lmat(k, 467) + mat(k, 468) = mat(k, 468) + lmat(k, 468) + mat(k, 472) = mat(k, 472) + lmat(k, 472) + mat(k, 474) = lmat(k, 474) + mat(k, 475) = mat(k, 475) + lmat(k, 475) + mat(k, 476) = mat(k, 476) + lmat(k, 476) + mat(k, 477) = lmat(k, 477) + mat(k, 479) = mat(k, 479) + lmat(k, 479) + mat(k, 481) = mat(k, 481) + lmat(k, 481) + mat(k, 486) = mat(k, 486) + lmat(k, 486) + mat(k, 488) = lmat(k, 488) + mat(k, 489) = lmat(k, 489) + mat(k, 490) = mat(k, 490) + lmat(k, 490) + mat(k, 491) = lmat(k, 491) + mat(k, 492) = lmat(k, 492) + mat(k, 495) = mat(k, 495) + lmat(k, 495) + mat(k, 502) = mat(k, 502) + lmat(k, 502) + mat(k, 510) = mat(k, 510) + lmat(k, 510) + mat(k, 517) = mat(k, 517) + lmat(k, 517) + mat(k, 519) = lmat(k, 519) + mat(k, 520) = lmat(k, 520) + mat(k, 523) = mat(k, 523) + lmat(k, 523) + mat(k, 529) = mat(k, 529) + lmat(k, 529) + mat(k, 534) = mat(k, 534) + lmat(k, 534) + mat(k, 535) = lmat(k, 535) + mat(k, 536) = lmat(k, 536) + mat(k, 537) = mat(k, 537) + lmat(k, 537) + mat(k, 539) = lmat(k, 539) + mat(k, 541) = lmat(k, 541) + mat(k, 542) = mat(k, 542) + lmat(k, 542) + mat(k, 544) = lmat(k, 544) + mat(k, 546) = mat(k, 546) + lmat(k, 546) + mat(k, 547) = lmat(k, 547) + mat(k, 548) = lmat(k, 548) + mat(k, 550) = mat(k, 550) + lmat(k, 550) + mat(k, 558) = mat(k, 558) + lmat(k, 558) + mat(k, 564) = lmat(k, 564) + mat(k, 566) = mat(k, 566) + lmat(k, 566) + mat(k, 567) = lmat(k, 567) + mat(k, 568) = lmat(k, 568) + mat(k, 569) = mat(k, 569) + lmat(k, 569) + mat(k, 570) = mat(k, 570) + lmat(k, 570) + mat(k, 571) = lmat(k, 571) + mat(k, 572) = lmat(k, 572) + mat(k, 574) = mat(k, 574) + lmat(k, 574) + mat(k, 582) = mat(k, 582) + lmat(k, 582) + mat(k, 584) = mat(k, 584) + lmat(k, 584) + mat(k, 589) = mat(k, 589) + lmat(k, 589) + mat(k, 596) = lmat(k, 596) + mat(k, 598) = lmat(k, 598) + mat(k, 599) = lmat(k, 599) + mat(k, 600) = lmat(k, 600) + mat(k, 601) = lmat(k, 601) + mat(k, 602) = mat(k, 602) + lmat(k, 602) + mat(k, 604) = mat(k, 604) + lmat(k, 604) + mat(k, 609) = lmat(k, 609) + mat(k, 611) = mat(k, 611) + lmat(k, 611) + mat(k, 613) = lmat(k, 613) + mat(k, 617) = lmat(k, 617) + mat(k, 620) = mat(k, 620) + lmat(k, 620) + mat(k, 622) = mat(k, 622) + lmat(k, 622) + mat(k, 623) = mat(k, 623) + lmat(k, 623) + mat(k, 625) = lmat(k, 625) + mat(k, 627) = mat(k, 627) + lmat(k, 627) + mat(k, 628) = mat(k, 628) + lmat(k, 628) + mat(k, 630) = mat(k, 630) + lmat(k, 630) + mat(k, 631) = lmat(k, 631) + mat(k, 632) = lmat(k, 632) + mat(k, 635) = mat(k, 635) + lmat(k, 635) + mat(k, 641) = lmat(k, 641) + mat(k, 642) = mat(k, 642) + lmat(k, 642) + mat(k, 645) = mat(k, 645) + lmat(k, 645) + mat(k, 646) = mat(k, 646) + lmat(k, 646) + mat(k, 649) = mat(k, 649) + lmat(k, 649) + mat(k, 650) = mat(k, 650) + lmat(k, 650) + mat(k, 651) = lmat(k, 651) + mat(k, 652) = mat(k, 652) + lmat(k, 652) + mat(k, 653) = lmat(k, 653) + mat(k, 654) = lmat(k, 654) + mat(k, 655) = lmat(k, 655) + mat(k, 656) = lmat(k, 656) + mat(k, 658) = lmat(k, 658) + mat(k, 659) = mat(k, 659) + lmat(k, 659) + mat(k, 660) = lmat(k, 660) + mat(k, 661) = lmat(k, 661) + mat(k, 662) = lmat(k, 662) + mat(k, 663) = lmat(k, 663) + mat(k, 664) = lmat(k, 664) + mat(k, 665) = mat(k, 665) + lmat(k, 665) + mat(k, 670) = lmat(k, 670) + mat(k, 672) = lmat(k, 672) + mat(k, 673) = mat(k, 673) + lmat(k, 673) + mat(k, 674) = lmat(k, 674) + mat(k, 676) = mat(k, 676) + lmat(k, 676) + mat(k, 686) = lmat(k, 686) + mat(k, 687) = mat(k, 687) + lmat(k, 687) + mat(k, 691) = lmat(k, 691) + mat(k, 692) = lmat(k, 692) + mat(k, 694) = mat(k, 694) + lmat(k, 694) + mat(k, 695) = lmat(k, 695) + mat(k, 696) = lmat(k, 696) + mat(k, 698) = mat(k, 698) + lmat(k, 698) + mat(k, 705) = mat(k, 705) + lmat(k, 705) + mat(k, 711) = mat(k, 711) + lmat(k, 711) + mat(k, 713) = lmat(k, 713) + mat(k, 714) = lmat(k, 714) + mat(k, 715) = mat(k, 715) + lmat(k, 715) + mat(k, 716) = lmat(k, 716) + mat(k, 717) = lmat(k, 717) + mat(k, 718) = mat(k, 718) + lmat(k, 718) + mat(k, 725) = lmat(k, 725) + mat(k, 726) = lmat(k, 726) + mat(k, 727) = lmat(k, 727) + mat(k, 728) = lmat(k, 728) + mat(k, 729) = mat(k, 729) + lmat(k, 729) + mat(k, 734) = lmat(k, 734) + mat(k, 736) = lmat(k, 736) + mat(k, 738) = mat(k, 738) + lmat(k, 738) + mat(k, 739) = lmat(k, 739) + mat(k, 740) = mat(k, 740) + lmat(k, 740) + mat(k, 751) = mat(k, 751) + lmat(k, 751) + mat(k, 767) = mat(k, 767) + lmat(k, 767) + mat(k, 778) = mat(k, 778) + lmat(k, 778) + mat(k, 787) = mat(k, 787) + lmat(k, 787) + mat(k, 789) = lmat(k, 789) + mat(k, 791) = mat(k, 791) + lmat(k, 791) + mat(k, 797) = mat(k, 797) + lmat(k, 797) + mat(k, 805) = mat(k, 805) + lmat(k, 805) + mat(k, 806) = lmat(k, 806) + mat(k, 808) = lmat(k, 808) + mat(k, 814) = mat(k, 814) + lmat(k, 814) + mat(k, 824) = mat(k, 824) + lmat(k, 824) + mat(k, 828) = mat(k, 828) + lmat(k, 828) + mat(k, 829) = mat(k, 829) + lmat(k, 829) + mat(k, 834) = mat(k, 834) + lmat(k, 834) + mat(k, 837) = mat(k, 837) + lmat(k, 837) + mat(k, 840) = mat(k, 840) + lmat(k, 840) + mat(k, 842) = mat(k, 842) + lmat(k, 842) + mat(k, 845) = mat(k, 845) + lmat(k, 845) + mat(k, 852) = mat(k, 852) + lmat(k, 852) + mat(k, 853) = mat(k, 853) + lmat(k, 853) + mat(k, 857) = mat(k, 857) + lmat(k, 857) + mat(k, 865) = mat(k, 865) + lmat(k, 865) + mat(k, 876) = mat(k, 876) + lmat(k, 876) + mat(k, 892) = mat(k, 892) + lmat(k, 892) + mat(k, 894) = lmat(k, 894) + mat(k, 896) = mat(k, 896) + lmat(k, 896) + mat(k, 897) = lmat(k, 897) + mat(k, 901) = mat(k, 901) + lmat(k, 901) + mat(k, 910) = mat(k, 910) + lmat(k, 910) + mat(k, 919) = mat(k, 919) + lmat(k, 919) + mat(k, 925) = mat(k, 925) + lmat(k, 925) + mat(k, 935) = mat(k, 935) + lmat(k, 935) + mat(k, 947) = mat(k, 947) + lmat(k, 947) + mat(k, 948) = lmat(k, 948) + mat(k, 950) = lmat(k, 950) + mat(k, 954) = mat(k, 954) + lmat(k, 954) + mat(k, 955) = mat(k, 955) + lmat(k, 955) + mat(k, 957) = mat(k, 957) + lmat(k, 957) + mat(k, 958) = mat(k, 958) + lmat(k, 958) + mat(k, 960) = lmat(k, 960) + mat(k, 961) = mat(k, 961) + lmat(k, 961) + mat(k, 963) = mat(k, 963) + lmat(k, 963) + mat(k, 974) = mat(k, 974) + lmat(k, 974) + mat(k, 994) = lmat(k, 994) + mat(k, 998) = lmat(k, 998) + mat(k, 999) = mat(k, 999) + lmat(k, 999) + mat(k,1018) = mat(k,1018) + lmat(k,1018) + mat(k,1042) = mat(k,1042) + lmat(k,1042) + mat(k,1053) = lmat(k,1053) + mat(k,1054) = mat(k,1054) + lmat(k,1054) + mat(k,1055) = mat(k,1055) + lmat(k,1055) + mat(k,1058) = mat(k,1058) + lmat(k,1058) + mat(k,1062) = mat(k,1062) + lmat(k,1062) + mat(k,1072) = mat(k,1072) + lmat(k,1072) + mat(k,1074) = lmat(k,1074) + mat(k,1075) = lmat(k,1075) + mat(k,1079) = lmat(k,1079) + mat(k,1080) = mat(k,1080) + lmat(k,1080) + mat(k,1082) = lmat(k,1082) + mat(k,1084) = lmat(k,1084) + mat(k,1086) = lmat(k,1086) + mat(k,1090) = mat(k,1090) + lmat(k,1090) + mat(k,1097) = lmat(k,1097) + mat(k,1099) = lmat(k,1099) + mat(k,1100) = mat(k,1100) + lmat(k,1100) + mat(k,1106) = mat(k,1106) + lmat(k,1106) + mat(k,1118) = mat(k,1118) + lmat(k,1118) + mat(k,1119) = mat(k,1119) + lmat(k,1119) + mat(k,1120) = mat(k,1120) + lmat(k,1120) + mat(k,1121) = mat(k,1121) + lmat(k,1121) + mat(k,1122) = mat(k,1122) + lmat(k,1122) + mat(k,1123) = mat(k,1123) + lmat(k,1123) + mat(k,1125) = mat(k,1125) + lmat(k,1125) + mat(k,1126) = mat(k,1126) + lmat(k,1126) + mat(k,1133) = mat(k,1133) + lmat(k,1133) + mat(k,1151) = mat(k,1151) + lmat(k,1151) + mat(k,1152) = lmat(k,1152) + mat(k,1157) = lmat(k,1157) + mat(k,1158) = lmat(k,1158) + mat(k,1160) = mat(k,1160) + lmat(k,1160) + mat(k,1165) = lmat(k,1165) + mat(k,1166) = mat(k,1166) + lmat(k,1166) + mat(k,1169) = mat(k,1169) + lmat(k,1169) + mat(k,1170) = mat(k,1170) + lmat(k,1170) + mat(k,1178) = mat(k,1178) + lmat(k,1178) + mat(k,1191) = lmat(k,1191) + mat(k,1192) = lmat(k,1192) + mat(k,1193) = lmat(k,1193) + mat(k,1194) = lmat(k,1194) + mat(k,1195) = mat(k,1195) + lmat(k,1195) + mat(k,1196) = lmat(k,1196) + mat(k,1198) = lmat(k,1198) + mat(k,1202) = lmat(k,1202) + mat(k,1203) = lmat(k,1203) + mat(k,1204) = lmat(k,1204) + mat(k,1205) = mat(k,1205) + lmat(k,1205) + mat(k,1208) = mat(k,1208) + lmat(k,1208) + mat(k,1210) = lmat(k,1210) + mat(k,1212) = lmat(k,1212) + mat(k,1213) = mat(k,1213) + lmat(k,1213) + mat(k,1217) = mat(k,1217) + lmat(k,1217) + mat(k,1233) = mat(k,1233) + lmat(k,1233) + mat(k,1253) = mat(k,1253) + lmat(k,1253) + mat(k,1268) = mat(k,1268) + lmat(k,1268) + mat(k,1269) = mat(k,1269) + lmat(k,1269) + mat(k,1272) = mat(k,1272) + lmat(k,1272) + mat(k,1273) = mat(k,1273) + lmat(k,1273) + mat(k,1276) = mat(k,1276) + lmat(k,1276) + mat(k,1278) = mat(k,1278) + lmat(k,1278) + mat(k,1280) = mat(k,1280) + lmat(k,1280) + mat(k,1281) = mat(k,1281) + lmat(k,1281) + mat(k,1282) = mat(k,1282) + lmat(k,1282) + mat(k,1287) = lmat(k,1287) + mat(k,1299) = mat(k,1299) + lmat(k,1299) + mat(k,1315) = lmat(k,1315) + mat(k,1332) = mat(k,1332) + lmat(k,1332) + mat(k,1345) = mat(k,1345) + lmat(k,1345) + mat(k,1356) = mat(k,1356) + lmat(k,1356) + mat(k,1370) = lmat(k,1370) + mat(k,1372) = mat(k,1372) + lmat(k,1372) + mat(k,1376) = mat(k,1376) + lmat(k,1376) + mat(k,1378) = mat(k,1378) + lmat(k,1378) + mat(k,1390) = lmat(k,1390) + mat(k,1397) = mat(k,1397) + lmat(k,1397) + mat(k,1428) = mat(k,1428) + lmat(k,1428) + mat(k,1449) = mat(k,1449) + lmat(k,1449) + mat(k,1450) = mat(k,1450) + lmat(k,1450) + mat(k,1456) = lmat(k,1456) + mat(k,1461) = mat(k,1461) + lmat(k,1461) + mat(k,1474) = lmat(k,1474) + mat(k,1476) = mat(k,1476) + lmat(k,1476) + mat(k,1484) = mat(k,1484) + lmat(k,1484) + mat(k,1495) = mat(k,1495) + lmat(k,1495) + mat(k,1505) = mat(k,1505) + lmat(k,1505) + mat(k,1506) = mat(k,1506) + lmat(k,1506) + mat(k,1511) = mat(k,1511) + lmat(k,1511) + mat(k,1531) = mat(k,1531) + lmat(k,1531) + mat(k,1533) = mat(k,1533) + lmat(k,1533) + mat(k,1534) = lmat(k,1534) + mat(k,1542) = mat(k,1542) + lmat(k,1542) + mat(k,1549) = mat(k,1549) + lmat(k,1549) + mat(k,1550) = mat(k,1550) + lmat(k,1550) + mat(k,1563) = mat(k,1563) + lmat(k,1563) + mat(k,1565) = mat(k,1565) + lmat(k,1565) + mat(k,1574) = mat(k,1574) + lmat(k,1574) + mat(k,1592) = mat(k,1592) + lmat(k,1592) + mat(k,1600) = mat(k,1600) + lmat(k,1600) + mat(k,1602) = mat(k,1602) + lmat(k,1602) + mat(k,1649) = mat(k,1649) + lmat(k,1649) + mat(k,1652) = mat(k,1652) + lmat(k,1652) + mat(k,1654) = mat(k,1654) + lmat(k,1654) + mat(k,1655) = mat(k,1655) + lmat(k,1655) + mat(k,1658) = mat(k,1658) + lmat(k,1658) + mat(k,1659) = mat(k,1659) + lmat(k,1659) + mat(k,1818) = mat(k,1818) + lmat(k,1818) + mat(k,1873) = mat(k,1873) + lmat(k,1873) + mat(k,1875) = lmat(k,1875) + mat(k,1881) = mat(k,1881) + lmat(k,1881) + mat(k,1914) = mat(k,1914) + lmat(k,1914) + mat(k,1919) = mat(k,1919) + lmat(k,1919) + mat(k,1958) = mat(k,1958) + lmat(k,1958) + mat(k,1959) = mat(k,1959) + lmat(k,1959) + mat(k,1960) = mat(k,1960) + lmat(k,1960) + mat(k,1963) = mat(k,1963) + lmat(k,1963) + mat(k,1964) = mat(k,1964) + lmat(k,1964) + mat(k,1975) = mat(k,1975) + lmat(k,1975) + mat(k,1977) = lmat(k,1977) + mat(k,1987) = mat(k,1987) + lmat(k,1987) + mat(k,1991) = mat(k,1991) + lmat(k,1991) + mat(k,2031) = mat(k,2031) + lmat(k,2031) + mat(k,2033) = mat(k,2033) + lmat(k,2033) + mat(k,2050) = mat(k,2050) + lmat(k,2050) + mat(k,2052) = lmat(k,2052) + mat(k,2055) = mat(k,2055) + lmat(k,2055) + mat(k,2074) = mat(k,2074) + lmat(k,2074) + mat(k,2079) = lmat(k,2079) + mat(k,2099) = mat(k,2099) + lmat(k,2099) + mat(k,2121) = mat(k,2121) + lmat(k,2121) + mat(k,2168) = mat(k,2168) + lmat(k,2168) + mat(k,2179) = mat(k,2179) + lmat(k,2179) + mat(k,2220) = mat(k,2220) + lmat(k,2220) + mat(k,2228) = mat(k,2228) + lmat(k,2228) + mat(k,2230) = mat(k,2230) + lmat(k,2230) + mat(k,2233) = mat(k,2233) + lmat(k,2233) + mat(k,2240) = lmat(k,2240) + mat(k,2241) = lmat(k,2241) + mat(k,2242) = mat(k,2242) + lmat(k,2242) + mat(k,2249) = mat(k,2249) + lmat(k,2249) + mat(k,2252) = mat(k,2252) + lmat(k,2252) + mat(k,2255) = lmat(k,2255) + mat(k,2256) = mat(k,2256) + lmat(k,2256) + mat(k,2259) = mat(k,2259) + lmat(k,2259) + mat(k,2261) = mat(k,2261) + lmat(k,2261) + mat(k,2262) = mat(k,2262) + lmat(k,2262) + mat(k,2368) = mat(k,2368) + lmat(k,2368) + mat(k,2370) = mat(k,2370) + lmat(k,2370) + mat(k,2421) = mat(k,2421) + lmat(k,2421) + mat(k,2428) = lmat(k,2428) + mat(k,2436) = mat(k,2436) + lmat(k,2436) + mat(k,2440) = mat(k,2440) + lmat(k,2440) + mat(k,2442) = lmat(k,2442) + mat(k,2443) = lmat(k,2443) + mat(k,2449) = mat(k,2449) + lmat(k,2449) + mat(k, 212) = 0._r8 + mat(k, 213) = 0._r8 + mat(k, 252) = 0._r8 + mat(k, 293) = 0._r8 + mat(k, 347) = 0._r8 + mat(k, 436) = 0._r8 + mat(k, 437) = 0._r8 + mat(k, 450) = 0._r8 + mat(k, 496) = 0._r8 + mat(k, 498) = 0._r8 + mat(k, 513) = 0._r8 + mat(k, 636) = 0._r8 + mat(k, 639) = 0._r8 + mat(k, 643) = 0._r8 + mat(k, 644) = 0._r8 + mat(k, 647) = 0._r8 + mat(k, 666) = 0._r8 + mat(k, 668) = 0._r8 + mat(k, 669) = 0._r8 + mat(k, 671) = 0._r8 + mat(k, 683) = 0._r8 + mat(k, 684) = 0._r8 + mat(k, 688) = 0._r8 + mat(k, 689) = 0._r8 + mat(k, 693) = 0._r8 + mat(k, 730) = 0._r8 + mat(k, 732) = 0._r8 + mat(k, 733) = 0._r8 + mat(k, 735) = 0._r8 + mat(k, 737) = 0._r8 + mat(k, 750) = 0._r8 + mat(k, 752) = 0._r8 + mat(k, 753) = 0._r8 + mat(k, 755) = 0._r8 + mat(k, 757) = 0._r8 + mat(k, 766) = 0._r8 + mat(k, 768) = 0._r8 + mat(k, 769) = 0._r8 + mat(k, 771) = 0._r8 + mat(k, 773) = 0._r8 + mat(k, 774) = 0._r8 + mat(k, 793) = 0._r8 + mat(k, 798) = 0._r8 + mat(k, 799) = 0._r8 + mat(k, 800) = 0._r8 + mat(k, 816) = 0._r8 + mat(k, 818) = 0._r8 + mat(k, 823) = 0._r8 + mat(k, 848) = 0._r8 + mat(k, 849) = 0._r8 + mat(k, 850) = 0._r8 + mat(k, 862) = 0._r8 + mat(k, 867) = 0._r8 + mat(k, 868) = 0._r8 + mat(k, 869) = 0._r8 + mat(k, 870) = 0._r8 + mat(k, 904) = 0._r8 + mat(k, 939) = 0._r8 + mat(k, 945) = 0._r8 + mat(k, 952) = 0._r8 + mat(k, 964) = 0._r8 + mat(k, 975) = 0._r8 + mat(k, 976) = 0._r8 + mat(k, 984) = 0._r8 + mat(k, 992) = 0._r8 + mat(k, 995) = 0._r8 + mat(k,1000) = 0._r8 + mat(k,1001) = 0._r8 + mat(k,1006) = 0._r8 + mat(k,1019) = 0._r8 + mat(k,1020) = 0._r8 + mat(k,1028) = 0._r8 + mat(k,1036) = 0._r8 + mat(k,1040) = 0._r8 + mat(k,1041) = 0._r8 + mat(k,1045) = 0._r8 + mat(k,1046) = 0._r8 + mat(k,1047) = 0._r8 + mat(k,1052) = 0._r8 + mat(k,1065) = 0._r8 + mat(k,1069) = 0._r8 + mat(k,1088) = 0._r8 + mat(k,1091) = 0._r8 + mat(k,1092) = 0._r8 + mat(k,1093) = 0._r8 + mat(k,1094) = 0._r8 + mat(k,1096) = 0._r8 + mat(k,1098) = 0._r8 + mat(k,1101) = 0._r8 + mat(k,1107) = 0._r8 + mat(k,1108) = 0._r8 + mat(k,1109) = 0._r8 + mat(k,1111) = 0._r8 + mat(k,1115) = 0._r8 + mat(k,1127) = 0._r8 + mat(k,1128) = 0._r8 + mat(k,1136) = 0._r8 + mat(k,1137) = 0._r8 + mat(k,1138) = 0._r8 + mat(k,1140) = 0._r8 + mat(k,1143) = 0._r8 + mat(k,1144) = 0._r8 + mat(k,1150) = 0._r8 + mat(k,1179) = 0._r8 + mat(k,1180) = 0._r8 + mat(k,1182) = 0._r8 + mat(k,1186) = 0._r8 + mat(k,1189) = 0._r8 + mat(k,1197) = 0._r8 + mat(k,1199) = 0._r8 + mat(k,1200) = 0._r8 + mat(k,1206) = 0._r8 + mat(k,1207) = 0._r8 + mat(k,1226) = 0._r8 + mat(k,1238) = 0._r8 + mat(k,1246) = 0._r8 + mat(k,1248) = 0._r8 + mat(k,1250) = 0._r8 + mat(k,1251) = 0._r8 + mat(k,1252) = 0._r8 + mat(k,1254) = 0._r8 + mat(k,1255) = 0._r8 + mat(k,1256) = 0._r8 + mat(k,1258) = 0._r8 + mat(k,1260) = 0._r8 + mat(k,1264) = 0._r8 + mat(k,1274) = 0._r8 + mat(k,1283) = 0._r8 + mat(k,1292) = 0._r8 + mat(k,1293) = 0._r8 + mat(k,1294) = 0._r8 + mat(k,1295) = 0._r8 + mat(k,1296) = 0._r8 + mat(k,1298) = 0._r8 + mat(k,1300) = 0._r8 + mat(k,1302) = 0._r8 + mat(k,1306) = 0._r8 + mat(k,1310) = 0._r8 + mat(k,1311) = 0._r8 + mat(k,1314) = 0._r8 + mat(k,1318) = 0._r8 + mat(k,1321) = 0._r8 + mat(k,1322) = 0._r8 + mat(k,1324) = 0._r8 + mat(k,1326) = 0._r8 + mat(k,1328) = 0._r8 + mat(k,1329) = 0._r8 + mat(k,1330) = 0._r8 + mat(k,1333) = 0._r8 + mat(k,1334) = 0._r8 + mat(k,1335) = 0._r8 + mat(k,1337) = 0._r8 + mat(k,1339) = 0._r8 + mat(k,1343) = 0._r8 + mat(k,1344) = 0._r8 + mat(k,1347) = 0._r8 + mat(k,1354) = 0._r8 + mat(k,1357) = 0._r8 + mat(k,1359) = 0._r8 + mat(k,1361) = 0._r8 + mat(k,1365) = 0._r8 + mat(k,1368) = 0._r8 + mat(k,1373) = 0._r8 + mat(k,1377) = 0._r8 + mat(k,1380) = 0._r8 + mat(k,1381) = 0._r8 + mat(k,1383) = 0._r8 + mat(k,1384) = 0._r8 + mat(k,1386) = 0._r8 + mat(k,1388) = 0._r8 + mat(k,1391) = 0._r8 + mat(k,1395) = 0._r8 + mat(k,1396) = 0._r8 + mat(k,1405) = 0._r8 + mat(k,1409) = 0._r8 + mat(k,1430) = 0._r8 + mat(k,1431) = 0._r8 + mat(k,1436) = 0._r8 + mat(k,1438) = 0._r8 + mat(k,1441) = 0._r8 + mat(k,1445) = 0._r8 + mat(k,1447) = 0._r8 + mat(k,1448) = 0._r8 + mat(k,1451) = 0._r8 + mat(k,1452) = 0._r8 + mat(k,1453) = 0._r8 + mat(k,1454) = 0._r8 + mat(k,1455) = 0._r8 + mat(k,1457) = 0._r8 + mat(k,1458) = 0._r8 + mat(k,1463) = 0._r8 + mat(k,1466) = 0._r8 + mat(k,1470) = 0._r8 + mat(k,1471) = 0._r8 + mat(k,1488) = 0._r8 + mat(k,1489) = 0._r8 + mat(k,1496) = 0._r8 + mat(k,1497) = 0._r8 + mat(k,1499) = 0._r8 + mat(k,1501) = 0._r8 + mat(k,1510) = 0._r8 + mat(k,1514) = 0._r8 + mat(k,1515) = 0._r8 + mat(k,1516) = 0._r8 + mat(k,1518) = 0._r8 + mat(k,1519) = 0._r8 + mat(k,1520) = 0._r8 + mat(k,1523) = 0._r8 + mat(k,1537) = 0._r8 + mat(k,1539) = 0._r8 + mat(k,1541) = 0._r8 + mat(k,1543) = 0._r8 + mat(k,1544) = 0._r8 + mat(k,1545) = 0._r8 + mat(k,1547) = 0._r8 + mat(k,1548) = 0._r8 + mat(k,1552) = 0._r8 + mat(k,1555) = 0._r8 + mat(k,1562) = 0._r8 + mat(k,1567) = 0._r8 + mat(k,1571) = 0._r8 + mat(k,1572) = 0._r8 + mat(k,1573) = 0._r8 + mat(k,1575) = 0._r8 + mat(k,1577) = 0._r8 + mat(k,1579) = 0._r8 + mat(k,1593) = 0._r8 + mat(k,1598) = 0._r8 + mat(k,1599) = 0._r8 + mat(k,1601) = 0._r8 + mat(k,1603) = 0._r8 + mat(k,1606) = 0._r8 + mat(k,1613) = 0._r8 + mat(k,1616) = 0._r8 + mat(k,1620) = 0._r8 + mat(k,1622) = 0._r8 + mat(k,1627) = 0._r8 + mat(k,1633) = 0._r8 + mat(k,1635) = 0._r8 + mat(k,1646) = 0._r8 + mat(k,1647) = 0._r8 + mat(k,1648) = 0._r8 + mat(k,1650) = 0._r8 + mat(k,1651) = 0._r8 + mat(k,1657) = 0._r8 + mat(k,1660) = 0._r8 + mat(k,1661) = 0._r8 + mat(k,1662) = 0._r8 + mat(k,1663) = 0._r8 + mat(k,1665) = 0._r8 + mat(k,1666) = 0._r8 + mat(k,1731) = 0._r8 + mat(k,1747) = 0._r8 + mat(k,1762) = 0._r8 + mat(k,1765) = 0._r8 + mat(k,1774) = 0._r8 + mat(k,1776) = 0._r8 + mat(k,1800) = 0._r8 + mat(k,1822) = 0._r8 + mat(k,1876) = 0._r8 + mat(k,1917) = 0._r8 + mat(k,1918) = 0._r8 + mat(k,1920) = 0._r8 + mat(k,1923) = 0._r8 + mat(k,1926) = 0._r8 + mat(k,1936) = 0._r8 + mat(k,1939) = 0._r8 + mat(k,1944) = 0._r8 + mat(k,1945) = 0._r8 + mat(k,1946) = 0._r8 + mat(k,1947) = 0._r8 + mat(k,1950) = 0._r8 + mat(k,1952) = 0._r8 + mat(k,1953) = 0._r8 + mat(k,1961) = 0._r8 + mat(k,1962) = 0._r8 + mat(k,1965) = 0._r8 + mat(k,1966) = 0._r8 + mat(k,1968) = 0._r8 + mat(k,1970) = 0._r8 + mat(k,1971) = 0._r8 + mat(k,1974) = 0._r8 + mat(k,1976) = 0._r8 + mat(k,1980) = 0._r8 + mat(k,1981) = 0._r8 + mat(k,1982) = 0._r8 + mat(k,1985) = 0._r8 + mat(k,1986) = 0._r8 + mat(k,1988) = 0._r8 + mat(k,1993) = 0._r8 + mat(k,1994) = 0._r8 + mat(k,1996) = 0._r8 + mat(k,2026) = 0._r8 + mat(k,2029) = 0._r8 + mat(k,2032) = 0._r8 + mat(k,2043) = 0._r8 + mat(k,2044) = 0._r8 + mat(k,2045) = 0._r8 + mat(k,2046) = 0._r8 + mat(k,2047) = 0._r8 + mat(k,2048) = 0._r8 + mat(k,2051) = 0._r8 + mat(k,2053) = 0._r8 + mat(k,2054) = 0._r8 + mat(k,2056) = 0._r8 + mat(k,2057) = 0._r8 + mat(k,2058) = 0._r8 + mat(k,2059) = 0._r8 + mat(k,2060) = 0._r8 + mat(k,2061) = 0._r8 + mat(k,2062) = 0._r8 + mat(k,2072) = 0._r8 + mat(k,2078) = 0._r8 + mat(k,2080) = 0._r8 + mat(k,2084) = 0._r8 + mat(k,2097) = 0._r8 + mat(k,2098) = 0._r8 + mat(k,2103) = 0._r8 + mat(k,2105) = 0._r8 + mat(k,2106) = 0._r8 + mat(k,2108) = 0._r8 + mat(k,2109) = 0._r8 + mat(k,2111) = 0._r8 + mat(k,2112) = 0._r8 + mat(k,2113) = 0._r8 + mat(k,2115) = 0._r8 + mat(k,2116) = 0._r8 + mat(k,2117) = 0._r8 + mat(k,2118) = 0._r8 + mat(k,2119) = 0._r8 + mat(k,2122) = 0._r8 + mat(k,2124) = 0._r8 + mat(k,2126) = 0._r8 + mat(k,2138) = 0._r8 + mat(k,2141) = 0._r8 + mat(k,2144) = 0._r8 + mat(k,2145) = 0._r8 + mat(k,2146) = 0._r8 + mat(k,2148) = 0._r8 + mat(k,2149) = 0._r8 + mat(k,2150) = 0._r8 + mat(k,2151) = 0._r8 + mat(k,2152) = 0._r8 + mat(k,2157) = 0._r8 + mat(k,2161) = 0._r8 + mat(k,2162) = 0._r8 + mat(k,2164) = 0._r8 + mat(k,2165) = 0._r8 + mat(k,2166) = 0._r8 + mat(k,2173) = 0._r8 + mat(k,2188) = 0._r8 + mat(k,2194) = 0._r8 + mat(k,2195) = 0._r8 + mat(k,2196) = 0._r8 + mat(k,2199) = 0._r8 + mat(k,2204) = 0._r8 + mat(k,2205) = 0._r8 + mat(k,2206) = 0._r8 + mat(k,2208) = 0._r8 + mat(k,2211) = 0._r8 + mat(k,2212) = 0._r8 + mat(k,2213) = 0._r8 + mat(k,2215) = 0._r8 + mat(k,2229) = 0._r8 + mat(k,2237) = 0._r8 + mat(k,2244) = 0._r8 + mat(k,2245) = 0._r8 + mat(k,2246) = 0._r8 + mat(k,2247) = 0._r8 + mat(k,2248) = 0._r8 + mat(k,2250) = 0._r8 + mat(k,2251) = 0._r8 + mat(k,2254) = 0._r8 + mat(k,2258) = 0._r8 + mat(k,2293) = 0._r8 + mat(k,2294) = 0._r8 + mat(k,2295) = 0._r8 + mat(k,2321) = 0._r8 + mat(k,2329) = 0._r8 + mat(k,2330) = 0._r8 + mat(k,2332) = 0._r8 + mat(k,2335) = 0._r8 + mat(k,2337) = 0._r8 + mat(k,2341) = 0._r8 + mat(k,2346) = 0._r8 + mat(k,2361) = 0._r8 + mat(k,2362) = 0._r8 + mat(k,2367) = 0._r8 + mat(k,2378) = 0._r8 + mat(k,2406) = 0._r8 + mat(k,2408) = 0._r8 + mat(k,2409) = 0._r8 + mat(k,2413) = 0._r8 + mat(k,2414) = 0._r8 + mat(k,2415) = 0._r8 + mat(k,2416) = 0._r8 + mat(k,2418) = 0._r8 + mat(k,2419) = 0._r8 + mat(k,2422) = 0._r8 + mat(k,2427) = 0._r8 + mat(k,2429) = 0._r8 + mat(k,2430) = 0._r8 + mat(k,2431) = 0._r8 + mat(k,2432) = 0._r8 + mat(k,2433) = 0._r8 + mat(k,2434) = 0._r8 + mat(k,2435) = 0._r8 + mat(k,2437) = 0._r8 + mat(k,2438) = 0._r8 + mat(k,2439) = 0._r8 + mat(k,2441) = 0._r8 + mat(k,2444) = 0._r8 + mat(k,2445) = 0._r8 + mat(k,2446) = 0._r8 + mat(k,2447) = 0._r8 + mat(k,2448) = 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, 10) = mat(k, 10) - 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, 33) = mat(k, 33) - 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, 37) = mat(k, 37) - dti(k) + mat(k, 38) = mat(k, 38) - dti(k) + mat(k, 39) = mat(k, 39) - dti(k) + mat(k, 40) = mat(k, 40) - dti(k) + mat(k, 41) = mat(k, 41) - dti(k) + mat(k, 42) = mat(k, 42) - dti(k) + mat(k, 43) = mat(k, 43) - dti(k) + mat(k, 44) = mat(k, 44) - dti(k) + mat(k, 50) = mat(k, 50) - dti(k) + mat(k, 56) = mat(k, 56) - dti(k) + mat(k, 62) = mat(k, 62) - dti(k) + mat(k, 68) = mat(k, 68) - dti(k) + mat(k, 74) = mat(k, 74) - dti(k) + mat(k, 76) = mat(k, 76) - dti(k) + mat(k, 82) = mat(k, 82) - dti(k) + mat(k, 88) = mat(k, 88) - dti(k) + mat(k, 94) = mat(k, 94) - dti(k) + mat(k, 95) = mat(k, 95) - dti(k) + mat(k, 98) = mat(k, 98) - dti(k) + mat(k, 101) = mat(k, 101) - dti(k) + mat(k, 104) = mat(k, 104) - dti(k) + mat(k, 107) = mat(k, 107) - dti(k) + mat(k, 111) = mat(k, 111) - dti(k) + mat(k, 115) = mat(k, 115) - dti(k) + mat(k, 119) = mat(k, 119) - dti(k) + mat(k, 123) = mat(k, 123) - dti(k) + mat(k, 127) = mat(k, 127) - dti(k) + mat(k, 130) = mat(k, 130) - dti(k) + mat(k, 133) = mat(k, 133) - dti(k) + mat(k, 136) = mat(k, 136) - dti(k) + mat(k, 139) = mat(k, 139) - dti(k) + mat(k, 144) = mat(k, 144) - dti(k) + mat(k, 149) = mat(k, 149) - dti(k) + mat(k, 154) = mat(k, 154) - dti(k) + mat(k, 160) = mat(k, 160) - dti(k) + mat(k, 166) = mat(k, 166) - dti(k) + mat(k, 170) = mat(k, 170) - dti(k) + mat(k, 175) = mat(k, 175) - dti(k) + mat(k, 177) = mat(k, 177) - dti(k) + mat(k, 180) = mat(k, 180) - dti(k) + mat(k, 182) = mat(k, 182) - dti(k) + mat(k, 187) = mat(k, 187) - dti(k) + mat(k, 194) = mat(k, 194) - dti(k) + mat(k, 199) = mat(k, 199) - dti(k) + mat(k, 203) = mat(k, 203) - dti(k) + mat(k, 208) = mat(k, 208) - dti(k) + mat(k, 216) = mat(k, 216) - dti(k) + mat(k, 221) = mat(k, 221) - dti(k) + mat(k, 226) = mat(k, 226) - dti(k) + mat(k, 229) = mat(k, 229) - dti(k) + mat(k, 232) = mat(k, 232) - dti(k) + mat(k, 235) = mat(k, 235) - dti(k) + mat(k, 238) = mat(k, 238) - dti(k) + mat(k, 241) = mat(k, 241) - dti(k) + mat(k, 246) = mat(k, 246) - dti(k) + mat(k, 251) = mat(k, 251) - dti(k) + mat(k, 256) = mat(k, 256) - dti(k) + mat(k, 261) = mat(k, 261) - dti(k) + mat(k, 265) = mat(k, 265) - dti(k) + mat(k, 269) = mat(k, 269) - dti(k) + mat(k, 273) = mat(k, 273) - dti(k) + mat(k, 279) = mat(k, 279) - dti(k) + mat(k, 282) = mat(k, 282) - dti(k) + mat(k, 285) = mat(k, 285) - dti(k) + mat(k, 292) = mat(k, 292) - dti(k) + mat(k, 298) = mat(k, 298) - dti(k) + mat(k, 304) = mat(k, 304) - dti(k) + mat(k, 310) = mat(k, 310) - dti(k) + mat(k, 316) = mat(k, 316) - dti(k) + mat(k, 321) = mat(k, 321) - dti(k) + mat(k, 326) = mat(k, 326) - dti(k) + mat(k, 329) = mat(k, 329) - dti(k) + mat(k, 334) = mat(k, 334) - dti(k) + mat(k, 339) = mat(k, 339) - dti(k) + mat(k, 345) = mat(k, 345) - dti(k) + mat(k, 350) = mat(k, 350) - dti(k) + mat(k, 355) = mat(k, 355) - dti(k) + mat(k, 363) = mat(k, 363) - dti(k) + mat(k, 371) = mat(k, 371) - dti(k) + mat(k, 379) = mat(k, 379) - dti(k) + mat(k, 385) = mat(k, 385) - dti(k) + mat(k, 391) = mat(k, 391) - dti(k) + mat(k, 397) = mat(k, 397) - dti(k) + mat(k, 403) = mat(k, 403) - dti(k) + mat(k, 409) = mat(k, 409) - dti(k) + mat(k, 415) = mat(k, 415) - dti(k) + mat(k, 421) = mat(k, 421) - dti(k) + mat(k, 427) = mat(k, 427) - dti(k) + mat(k, 435) = mat(k, 435) - dti(k) + mat(k, 441) = mat(k, 441) - dti(k) + mat(k, 448) = mat(k, 448) - dti(k) + mat(k, 454) = mat(k, 454) - dti(k) + mat(k, 460) = mat(k, 460) - dti(k) + mat(k, 465) = mat(k, 465) - dti(k) + mat(k, 468) = mat(k, 468) - dti(k) + mat(k, 472) = mat(k, 472) - dti(k) + mat(k, 479) = mat(k, 479) - dti(k) + mat(k, 486) = mat(k, 486) - dti(k) + mat(k, 495) = mat(k, 495) - dti(k) + mat(k, 502) = mat(k, 502) - dti(k) + mat(k, 510) = mat(k, 510) - dti(k) + mat(k, 517) = mat(k, 517) - dti(k) + mat(k, 523) = mat(k, 523) - dti(k) + mat(k, 529) = mat(k, 529) - dti(k) + mat(k, 534) = mat(k, 534) - dti(k) + mat(k, 542) = mat(k, 542) - dti(k) + mat(k, 550) = mat(k, 550) - dti(k) + mat(k, 558) = mat(k, 558) - dti(k) + mat(k, 566) = mat(k, 566) - dti(k) + mat(k, 574) = mat(k, 574) - dti(k) + mat(k, 582) = mat(k, 582) - dti(k) + mat(k, 589) = mat(k, 589) - dti(k) + mat(k, 598) = mat(k, 598) - dti(k) + mat(k, 602) = mat(k, 602) - dti(k) + mat(k, 611) = mat(k, 611) - dti(k) + mat(k, 620) = mat(k, 620) - dti(k) + mat(k, 627) = mat(k, 627) - dti(k) + mat(k, 635) = mat(k, 635) - dti(k) + mat(k, 642) = mat(k, 642) - dti(k) + mat(k, 652) = mat(k, 652) - dti(k) + mat(k, 665) = mat(k, 665) - dti(k) + mat(k, 676) = mat(k, 676) - dti(k) + mat(k, 687) = mat(k, 687) - dti(k) + mat(k, 698) = mat(k, 698) - dti(k) + mat(k, 705) = mat(k, 705) - dti(k) + mat(k, 711) = mat(k, 711) - dti(k) + mat(k, 718) = mat(k, 718) - dti(k) + mat(k, 729) = mat(k, 729) - dti(k) + mat(k, 740) = mat(k, 740) - dti(k) + mat(k, 751) = mat(k, 751) - dti(k) + mat(k, 767) = mat(k, 767) - dti(k) + mat(k, 778) = mat(k, 778) - dti(k) + mat(k, 787) = mat(k, 787) - dti(k) + mat(k, 797) = mat(k, 797) - dti(k) + mat(k, 805) = mat(k, 805) - dti(k) + mat(k, 814) = mat(k, 814) - dti(k) + mat(k, 824) = mat(k, 824) - dti(k) + mat(k, 828) = mat(k, 828) - dti(k) + mat(k, 837) = mat(k, 837) - dti(k) + mat(k, 845) = mat(k, 845) - dti(k) + mat(k, 853) = mat(k, 853) - dti(k) + mat(k, 865) = mat(k, 865) - dti(k) + mat(k, 876) = mat(k, 876) - dti(k) + mat(k, 892) = mat(k, 892) - dti(k) + mat(k, 901) = mat(k, 901) - dti(k) + mat(k, 910) = mat(k, 910) - dti(k) + mat(k, 919) = mat(k, 919) - dti(k) + mat(k, 925) = mat(k, 925) - dti(k) + mat(k, 935) = mat(k, 935) - dti(k) + mat(k, 947) = mat(k, 947) - dti(k) + mat(k, 955) = mat(k, 955) - dti(k) + mat(k, 974) = mat(k, 974) - dti(k) + mat(k, 999) = mat(k, 999) - dti(k) + mat(k,1018) = mat(k,1018) - dti(k) + mat(k,1042) = mat(k,1042) - dti(k) + mat(k,1054) = mat(k,1054) - dti(k) + mat(k,1062) = mat(k,1062) - dti(k) + mat(k,1072) = mat(k,1072) - dti(k) + mat(k,1080) = mat(k,1080) - dti(k) + mat(k,1090) = mat(k,1090) - dti(k) + mat(k,1106) = mat(k,1106) - dti(k) + mat(k,1119) = mat(k,1119) - dti(k) + mat(k,1133) = mat(k,1133) - dti(k) + mat(k,1151) = mat(k,1151) - dti(k) + mat(k,1160) = mat(k,1160) - dti(k) + mat(k,1166) = mat(k,1166) - dti(k) + mat(k,1178) = mat(k,1178) - dti(k) + mat(k,1195) = mat(k,1195) - dti(k) + mat(k,1208) = mat(k,1208) - dti(k) + mat(k,1217) = mat(k,1217) - dti(k) + mat(k,1233) = mat(k,1233) - dti(k) + mat(k,1253) = mat(k,1253) - dti(k) + mat(k,1269) = mat(k,1269) - dti(k) + mat(k,1281) = mat(k,1281) - dti(k) + mat(k,1299) = mat(k,1299) - dti(k) + mat(k,1332) = mat(k,1332) - dti(k) + mat(k,1356) = mat(k,1356) - dti(k) + mat(k,1376) = mat(k,1376) - dti(k) + mat(k,1397) = mat(k,1397) - dti(k) + mat(k,1428) = mat(k,1428) - dti(k) + mat(k,1450) = mat(k,1450) - dti(k) + mat(k,1461) = mat(k,1461) - dti(k) + mat(k,1476) = mat(k,1476) - dti(k) + mat(k,1495) = mat(k,1495) - dti(k) + mat(k,1511) = mat(k,1511) - dti(k) + mat(k,1542) = mat(k,1542) - dti(k) + mat(k,1565) = mat(k,1565) - dti(k) + mat(k,1592) = mat(k,1592) - dti(k) + mat(k,1652) = mat(k,1652) - dti(k) + mat(k,1818) = mat(k,1818) - dti(k) + mat(k,1914) = mat(k,1914) - dti(k) + mat(k,1960) = mat(k,1960) - dti(k) + mat(k,1987) = mat(k,1987) - dti(k) + mat(k,2031) = mat(k,2031) - dti(k) + mat(k,2055) = mat(k,2055) - dti(k) + mat(k,2099) = mat(k,2099) - dti(k) + mat(k,2121) = mat(k,2121) - dti(k) + mat(k,2168) = mat(k,2168) - dti(k) + mat(k,2233) = mat(k,2233) - dti(k) + mat(k,2259) = mat(k,2259) - dti(k) + mat(k,2368) = mat(k,2368) - dti(k) + mat(k,2421) = mat(k,2421) - dti(k) + mat(k,2449) = mat(k,2449) - 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 nlnmat08( avec_len, mat, y, rxt ) + call nlnmat09( avec_len, mat, y, rxt ) + call nlnmat10( avec_len, mat, y, rxt ) + call nlnmat11( 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_waccm_tsmlt_mam5/mo_phtadj.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/mo_phtadj.F90 new file mode 100644 index 0000000000..6a03fe4d4b --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/mo_phtadj.F90 @@ -0,0 +1,33 @@ + 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,112) = p_rate(:,k,112) * inv(:,k, 2) * im(:,k) + p_rate(:,k,113) = p_rate(:,k,113) * inv(:,k, 2) * im(:,k) + p_rate(:,k,114) = p_rate(:,k,114) * inv(:,k, 2) * im(:,k) + p_rate(:,k,115) = p_rate(:,k,115) * inv(:,k, 2) * im(:,k) + p_rate(:,k,116) = p_rate(:,k,116) * inv(:,k, 2) * im(:,k) + p_rate(:,k,117) = p_rate(:,k,117) * inv(:,k, 2) * im(:,k) + p_rate(:,k,118) = p_rate(:,k,118) * inv(:,k, 2) * im(:,k) + p_rate(:,k,119) = p_rate(:,k,119) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/mo_prod_loss.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/mo_prod_loss.F90 new file mode 100644 index 0000000000..fb0e928091 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/mo_prod_loss.F90 @@ -0,0 +1,1337 @@ + 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,189))* y(k,189) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,190))* y(k,190) + 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,155) = (rxt(k,396)* y(k,228) + rxt(k,20) + het_rates(k,1))* y(k,1) + prod(k,155) =rxt(k,399)*y(k,192)*y(k,124) + loss(k,159) = (rxt(k,400)* y(k,228) + rxt(k,21) + het_rates(k,2))* y(k,2) + prod(k,159) =rxt(k,397)*y(k,192)*y(k,90) + loss(k,1) = ( + het_rates(k,3))* y(k,3) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,4))* y(k,4) + prod(k,2) = 0._r8 + loss(k,3) = ( + het_rates(k,5))* y(k,5) + prod(k,3) = 0._r8 + loss(k,188) = (rxt(k,479)* y(k,126) +rxt(k,480)* y(k,136) +rxt(k,481) & + * y(k,228) + het_rates(k,6))* y(k,6) + prod(k,188) = 0._r8 + loss(k,71) = (rxt(k,438)* y(k,228) + het_rates(k,7))* y(k,7) + prod(k,71) = 0._r8 + loss(k,122) = (rxt(k,441)* y(k,228) + rxt(k,22) + het_rates(k,8))* y(k,8) + prod(k,122) =rxt(k,439)*y(k,194)*y(k,90) + loss(k,72) = ( + rxt(k,23) + het_rates(k,9))* y(k,9) + prod(k,72) =.120_r8*rxt(k,438)*y(k,228)*y(k,7) + loss(k,116) = ( + rxt(k,24) + het_rates(k,10))* y(k,10) + prod(k,116) = (.100_r8*rxt(k,480)*y(k,6) +.100_r8*rxt(k,483)*y(k,110)) & + *y(k,136) + loss(k,130) = ( + rxt(k,25) + het_rates(k,11))* y(k,11) + prod(k,130) = (.500_r8*rxt(k,440)*y(k,194) +.200_r8*rxt(k,467)*y(k,235) + & + .060_r8*rxt(k,473)*y(k,238))*y(k,124) +.500_r8*rxt(k,22)*y(k,8) & + +rxt(k,23)*y(k,9) +.200_r8*rxt(k,71)*y(k,182) +.060_r8*rxt(k,73) & + *y(k,186) + loss(k,98) = ( + rxt(k,26) + het_rates(k,12))* y(k,12) + prod(k,98) = (.200_r8*rxt(k,467)*y(k,235) +.200_r8*rxt(k,473)*y(k,238)) & + *y(k,124) +.200_r8*rxt(k,71)*y(k,182) +.200_r8*rxt(k,73)*y(k,186) + loss(k,149) = ( + rxt(k,27) + het_rates(k,13))* y(k,13) + prod(k,149) = (.200_r8*rxt(k,467)*y(k,235) +.150_r8*rxt(k,473)*y(k,238)) & + *y(k,124) +rxt(k,47)*y(k,95) +rxt(k,57)*y(k,116) +.200_r8*rxt(k,71) & + *y(k,182) +.150_r8*rxt(k,73)*y(k,186) + loss(k,108) = ( + rxt(k,28) + het_rates(k,14))* y(k,14) + prod(k,108) =.210_r8*rxt(k,473)*y(k,238)*y(k,124) +.210_r8*rxt(k,73)*y(k,186) + loss(k,85) = (rxt(k,401)* y(k,228) + het_rates(k,15))* y(k,15) + prod(k,85) = (.050_r8*rxt(k,480)*y(k,6) +.050_r8*rxt(k,483)*y(k,110)) & + *y(k,136) + loss(k,113) = (rxt(k,367)* y(k,126) +rxt(k,368)* y(k,228) + het_rates(k,16)) & + * y(k,16) + prod(k,113) = 0._r8 + loss(k,221) = (rxt(k,250)* y(k,42) +rxt(k,251)* y(k,90) +rxt(k,252)* y(k,136) & + + het_rates(k,17))* y(k,17) + prod(k,221) = (rxt(k,76) +2.000_r8*rxt(k,253)*y(k,19) +rxt(k,254)*y(k,59) + & + rxt(k,255)*y(k,59) +rxt(k,258)*y(k,124) +rxt(k,261)*y(k,134) + & + rxt(k,262)*y(k,228) +rxt(k,509)*y(k,152))*y(k,19) & + + (rxt(k,240)*y(k,34) +rxt(k,266)*y(k,35) + & + 3.000_r8*rxt(k,267)*y(k,55) +2.000_r8*rxt(k,268)*y(k,78) + & + rxt(k,269)*y(k,81) +2.000_r8*rxt(k,289)*y(k,41) +rxt(k,290)*y(k,43)) & + *y(k,224) + (rxt(k,264)*y(k,81) +2.000_r8*rxt(k,278)*y(k,41) + & + rxt(k,280)*y(k,43) +3.000_r8*rxt(k,285)*y(k,55))*y(k,228) & + + (2.000_r8*rxt(k,277)*y(k,41) +rxt(k,279)*y(k,43) + & + 3.000_r8*rxt(k,284)*y(k,55))*y(k,56) + (rxt(k,100) + & + rxt(k,263)*y(k,134))*y(k,81) +rxt(k,75)*y(k,18) +rxt(k,78)*y(k,20) & + +rxt(k,80)*y(k,34) +rxt(k,81)*y(k,35) +2.000_r8*rxt(k,87)*y(k,41) & + +rxt(k,88)*y(k,43) +3.000_r8*rxt(k,91)*y(k,55) +2.000_r8*rxt(k,99) & + *y(k,78) +rxt(k,106)*y(k,92) + loss(k,86) = ( + rxt(k,75) + het_rates(k,18))* y(k,18) + prod(k,86) = (rxt(k,570)*y(k,92) +rxt(k,575)*y(k,92))*y(k,85) & + +rxt(k,256)*y(k,59)*y(k,19) + loss(k,223) = (2._r8*rxt(k,253)* y(k,19) + (rxt(k,254) +rxt(k,255) + & + rxt(k,256))* y(k,59) +rxt(k,257)* y(k,90) +rxt(k,258)* y(k,124) & + +rxt(k,259)* y(k,125) +rxt(k,261)* y(k,134) +rxt(k,509)* y(k,152) & + +rxt(k,262)* y(k,228) + rxt(k,76) + het_rates(k,19))* y(k,19) + prod(k,223) = (rxt(k,77) +rxt(k,260)*y(k,134))*y(k,20) +rxt(k,252)*y(k,136) & + *y(k,17) +rxt(k,270)*y(k,224)*y(k,81) +rxt(k,265)*y(k,134)*y(k,92) + loss(k,145) = (rxt(k,260)* y(k,134) + rxt(k,77) + rxt(k,78) + rxt(k,564) & + + rxt(k,567) + rxt(k,572) + het_rates(k,20))* y(k,20) + prod(k,145) =rxt(k,259)*y(k,125)*y(k,19) + loss(k,4) = ( + het_rates(k,21))* y(k,21) + prod(k,4) = 0._r8 + loss(k,88) = (rxt(k,442)* y(k,228) + het_rates(k,22))* y(k,22) + prod(k,88) =rxt(k,29)*y(k,23) +rxt(k,445)*y(k,196)*y(k,124) + loss(k,111) = (rxt(k,444)* y(k,228) + rxt(k,29) + het_rates(k,23))* y(k,23) + prod(k,111) =rxt(k,443)*y(k,196)*y(k,90) + loss(k,100) = (rxt(k,315)* y(k,56) +rxt(k,316)* y(k,228) + het_rates(k,24)) & + * y(k,24) + prod(k,100) = 0._r8 + loss(k,143) = (rxt(k,317)* y(k,56) +rxt(k,318)* y(k,136) +rxt(k,343) & + * y(k,228) + het_rates(k,25))* y(k,25) + prod(k,143) = 0._r8 + loss(k,95) = (rxt(k,323)* y(k,228) + het_rates(k,26))* y(k,26) + prod(k,95) = (.400_r8*rxt(k,319)*y(k,197) +.200_r8*rxt(k,320)*y(k,201)) & + *y(k,197) + loss(k,112) = (rxt(k,324)* y(k,228) + rxt(k,30) + het_rates(k,27))* y(k,27) + prod(k,112) =rxt(k,321)*y(k,197)*y(k,90) + loss(k,102) = (rxt(k,325)* y(k,56) +rxt(k,326)* y(k,228) + het_rates(k,28)) & + * y(k,28) + prod(k,102) = 0._r8 + loss(k,199) = (rxt(k,346)* y(k,126) +rxt(k,347)* y(k,136) +rxt(k,365) & + * y(k,228) + het_rates(k,29))* y(k,29) + prod(k,199) =.130_r8*rxt(k,425)*y(k,136)*y(k,99) +.700_r8*rxt(k,56)*y(k,111) + loss(k,121) = (rxt(k,351)* y(k,228) + rxt(k,31) + het_rates(k,30))* y(k,30) + prod(k,121) =rxt(k,349)*y(k,198)*y(k,90) + loss(k,103) = (rxt(k,355)* y(k,56) +rxt(k,352)* y(k,228) + het_rates(k,31)) & + * y(k,31) + prod(k,103) = 0._r8 + loss(k,96) = (rxt(k,448)* y(k,228) + rxt(k,32) + het_rates(k,32))* y(k,32) + prod(k,96) =rxt(k,446)*y(k,199)*y(k,90) + loss(k,56) = (rxt(k,239)* y(k,224) + rxt(k,79) + het_rates(k,33))* y(k,33) + prod(k,56) = 0._r8 + loss(k,67) = (rxt(k,240)* y(k,224) + rxt(k,80) + het_rates(k,34))* y(k,34) + prod(k,67) = 0._r8 + loss(k,68) = (rxt(k,266)* y(k,224) + rxt(k,81) + het_rates(k,35))* y(k,35) + prod(k,68) = 0._r8 + loss(k,59) = (rxt(k,241)* y(k,224) + rxt(k,82) + het_rates(k,36))* y(k,36) + prod(k,59) = 0._r8 + loss(k,69) = (rxt(k,242)* y(k,224) + rxt(k,83) + het_rates(k,37))* y(k,37) + prod(k,69) = 0._r8 + loss(k,60) = (rxt(k,243)* y(k,224) + rxt(k,84) + het_rates(k,38))* y(k,38) + prod(k,60) = 0._r8 + loss(k,70) = (rxt(k,244)* y(k,224) + rxt(k,85) + het_rates(k,39))* y(k,39) + prod(k,70) = 0._r8 + loss(k,61) = (rxt(k,245)* y(k,224) + rxt(k,86) + het_rates(k,40))* y(k,40) + prod(k,61) = 0._r8 + loss(k,133) = (rxt(k,277)* y(k,56) +rxt(k,289)* y(k,224) +rxt(k,278) & + * y(k,228) + rxt(k,87) + het_rates(k,41))* y(k,41) + prod(k,133) = 0._r8 + loss(k,229) = (rxt(k,250)* y(k,17) +rxt(k,214)* y(k,56) +rxt(k,294)* y(k,90) & + +rxt(k,295)* y(k,126) +rxt(k,296)* y(k,134) +rxt(k,297)* y(k,228) & + + rxt(k,33) + rxt(k,34) + het_rates(k,42))* y(k,42) + prod(k,229) = (rxt(k,221)*y(k,59) +2.000_r8*rxt(k,298)*y(k,201) + & + rxt(k,299)*y(k,201) +rxt(k,301)*y(k,124) + & + .700_r8*rxt(k,320)*y(k,197) +rxt(k,331)*y(k,200) + & + rxt(k,348)*y(k,198) +.800_r8*rxt(k,361)*y(k,232) + & + .880_r8*rxt(k,373)*y(k,213) +2.000_r8*rxt(k,382)*y(k,215) + & + 1.500_r8*rxt(k,406)*y(k,208) +.750_r8*rxt(k,411)*y(k,209) + & + .800_r8*rxt(k,420)*y(k,210) +.800_r8*rxt(k,431)*y(k,237) + & + .750_r8*rxt(k,485)*y(k,223) +.930_r8*rxt(k,490)*y(k,233) + & + .950_r8*rxt(k,495)*y(k,234))*y(k,201) & + + (.500_r8*rxt(k,337)*y(k,206) +rxt(k,359)*y(k,231) + & + rxt(k,363)*y(k,232) +.500_r8*rxt(k,369)*y(k,204) + & + .250_r8*rxt(k,376)*y(k,213) +rxt(k,385)*y(k,215) + & + .100_r8*rxt(k,398)*y(k,192) +.920_r8*rxt(k,408)*y(k,208) + & + .250_r8*rxt(k,433)*y(k,237) +.340_r8*rxt(k,492)*y(k,233) + & + .320_r8*rxt(k,497)*y(k,234))*y(k,124) + (rxt(k,302)*y(k,52) + & + .300_r8*rxt(k,303)*y(k,53) +.500_r8*rxt(k,335)*y(k,51) + & + .800_r8*rxt(k,340)*y(k,74) +rxt(k,342)*y(k,141) + & + .500_r8*rxt(k,391)*y(k,109) +.400_r8*rxt(k,396)*y(k,1) + & + .300_r8*rxt(k,416)*y(k,100) +.680_r8*rxt(k,501)*y(k,181))*y(k,228) & + + (rxt(k,318)*y(k,25) +.500_r8*rxt(k,347)*y(k,29) + & + .120_r8*rxt(k,378)*y(k,105) +.600_r8*rxt(k,392)*y(k,111) + & + .910_r8*rxt(k,425)*y(k,99) +.340_r8*rxt(k,480)*y(k,6) + & + .340_r8*rxt(k,483)*y(k,110))*y(k,136) + (.500_r8*rxt(k,367)*y(k,16) + & + .250_r8*rxt(k,375)*y(k,213) +rxt(k,386)*y(k,215) + & + rxt(k,409)*y(k,208))*y(k,126) + (.250_r8*rxt(k,372)*y(k,213) + & + rxt(k,381)*y(k,215) +rxt(k,405)*y(k,208) + & + .250_r8*rxt(k,430)*y(k,237))*y(k,200) + (.180_r8*rxt(k,40) + & + rxt(k,311)*y(k,224) +rxt(k,312)*y(k,224))*y(k,54) & + + (.150_r8*rxt(k,362)*y(k,232) +.450_r8*rxt(k,383)*y(k,215))*y(k,90) & + +.100_r8*rxt(k,20)*y(k,1) +.100_r8*rxt(k,21)*y(k,2) +rxt(k,39) & + *y(k,53) +rxt(k,44)*y(k,74) +.330_r8*rxt(k,46)*y(k,94) +rxt(k,48) & + *y(k,96) +rxt(k,50)*y(k,103) +1.340_r8*rxt(k,51)*y(k,105) +rxt(k,58) & + *y(k,127) +rxt(k,63)*y(k,148) +rxt(k,64)*y(k,149) +.375_r8*rxt(k,66) & + *y(k,177) +.400_r8*rxt(k,68)*y(k,179) +.680_r8*rxt(k,70)*y(k,181) & + +2.000_r8*rxt(k,338)*y(k,205) +rxt(k,308)*y(k,207) & + +2.000_r8*rxt(k,384)*y(k,215)*y(k,215) + loss(k,150) = (rxt(k,279)* y(k,56) +rxt(k,290)* y(k,224) +rxt(k,280) & + * y(k,228) + rxt(k,88) + het_rates(k,43))* y(k,43) + prod(k,150) = 0._r8 + loss(k,62) = (rxt(k,281)* y(k,228) + rxt(k,89) + het_rates(k,44))* y(k,44) + prod(k,62) = 0._r8 + loss(k,200) = (rxt(k,327)* y(k,126) +rxt(k,328)* y(k,228) + rxt(k,35) & + + het_rates(k,45))* y(k,45) + prod(k,200) = (rxt(k,322)*y(k,197) +.270_r8*rxt(k,350)*y(k,198) + & + rxt(k,359)*y(k,231) +rxt(k,369)*y(k,204) +rxt(k,388)*y(k,217) + & + .400_r8*rxt(k,398)*y(k,192))*y(k,124) + (rxt(k,323)*y(k,26) + & + .500_r8*rxt(k,324)*y(k,27) +.800_r8*rxt(k,396)*y(k,1))*y(k,228) & + + (.500_r8*rxt(k,347)*y(k,29) +.100_r8*rxt(k,392)*y(k,111))*y(k,136) & + + (1.600_r8*rxt(k,319)*y(k,197) +.800_r8*rxt(k,320)*y(k,201)) & + *y(k,197) +.400_r8*rxt(k,20)*y(k,1) +.400_r8*rxt(k,21)*y(k,2) & + +rxt(k,367)*y(k,126)*y(k,16) +rxt(k,30)*y(k,27) & + +.200_r8*rxt(k,387)*y(k,217)*y(k,90) +.330_r8*rxt(k,46)*y(k,94) & + +rxt(k,54)*y(k,108) +rxt(k,63)*y(k,148) + loss(k,115) = (rxt(k,282)* y(k,56) +rxt(k,283)* y(k,228) + rxt(k,90) & + + het_rates(k,46))* y(k,46) + prod(k,115) = 0._r8 + loss(k,57) = (rxt(k,329)* y(k,228) + het_rates(k,47))* y(k,47) + prod(k,57) = 0._r8 + loss(k,195) = (rxt(k,366)* y(k,228) + rxt(k,36) + het_rates(k,48))* y(k,48) + prod(k,195) = (.820_r8*rxt(k,350)*y(k,198) +.500_r8*rxt(k,369)*y(k,204) + & + .250_r8*rxt(k,398)*y(k,192) +.270_r8*rxt(k,492)*y(k,233) + & + .040_r8*rxt(k,497)*y(k,234))*y(k,124) & + + (.820_r8*rxt(k,348)*y(k,198) +.150_r8*rxt(k,490)*y(k,233) + & + .025_r8*rxt(k,495)*y(k,234))*y(k,201) + (.250_r8*rxt(k,20) + & + .800_r8*rxt(k,396)*y(k,228))*y(k,1) + (.520_r8*rxt(k,480)*y(k,6) + & + .520_r8*rxt(k,483)*y(k,110))*y(k,136) + (.500_r8*rxt(k,70) + & + .500_r8*rxt(k,501)*y(k,228))*y(k,181) +.250_r8*rxt(k,21)*y(k,2) & + +.500_r8*rxt(k,367)*y(k,126)*y(k,16) +.820_r8*rxt(k,31)*y(k,30) & + +.170_r8*rxt(k,46)*y(k,94) +.300_r8*rxt(k,66)*y(k,177) & + +.050_r8*rxt(k,68)*y(k,179) + loss(k,210) = (rxt(k,353)* y(k,126) +rxt(k,354)* y(k,228) + rxt(k,37) & + + het_rates(k,49))* y(k,49) + prod(k,210) = (.250_r8*rxt(k,376)*y(k,213) +.050_r8*rxt(k,414)*y(k,209) + & + .250_r8*rxt(k,433)*y(k,237) +.170_r8*rxt(k,451)*y(k,202) + & + .170_r8*rxt(k,457)*y(k,216) +.400_r8*rxt(k,467)*y(k,235) + & + .540_r8*rxt(k,473)*y(k,238) +.510_r8*rxt(k,476)*y(k,240))*y(k,124) & + + (.250_r8*rxt(k,375)*y(k,213) +.050_r8*rxt(k,415)*y(k,209) + & + .250_r8*rxt(k,434)*y(k,237))*y(k,126) & + + (.500_r8*rxt(k,361)*y(k,232) +.240_r8*rxt(k,373)*y(k,213) + & + .100_r8*rxt(k,431)*y(k,237))*y(k,201) & + + (.070_r8*rxt(k,450)*y(k,202) +.070_r8*rxt(k,456)*y(k,216))*y(k,90) & + + (.880_r8*rxt(k,378)*y(k,105) +.500_r8*rxt(k,392)*y(k,111)) & + *y(k,136) + (.250_r8*rxt(k,372)*y(k,213) + & + .250_r8*rxt(k,430)*y(k,237))*y(k,200) + (rxt(k,356)*y(k,96) + & + rxt(k,357)*y(k,127))*y(k,228) +.180_r8*rxt(k,24)*y(k,10) +rxt(k,28) & + *y(k,14) +.400_r8*rxt(k,71)*y(k,182) +.540_r8*rxt(k,73)*y(k,186) & + +.510_r8*rxt(k,74)*y(k,188) + loss(k,161) = (rxt(k,334)* y(k,228) + het_rates(k,50))* y(k,50) + prod(k,161) = (.150_r8*rxt(k,332)*y(k,200) +.150_r8*rxt(k,383)*y(k,215)) & + *y(k,90) +.120_r8*rxt(k,347)*y(k,136)*y(k,29) & + +.100_r8*rxt(k,331)*y(k,201)*y(k,200) + loss(k,152) = (rxt(k,335)* y(k,228) + rxt(k,38) + het_rates(k,51))* y(k,51) + prod(k,152) = (.400_r8*rxt(k,332)*y(k,200) +.400_r8*rxt(k,383)*y(k,215)) & + *y(k,90) + loss(k,173) = (rxt(k,302)* y(k,228) + het_rates(k,52))* y(k,52) + prod(k,173) = (rxt(k,299)*y(k,201) +.300_r8*rxt(k,320)*y(k,197) + & + .500_r8*rxt(k,361)*y(k,232) +.250_r8*rxt(k,373)*y(k,213) + & + .250_r8*rxt(k,406)*y(k,208) +.250_r8*rxt(k,411)*y(k,209) + & + .200_r8*rxt(k,420)*y(k,210) +.300_r8*rxt(k,431)*y(k,237) + & + .250_r8*rxt(k,485)*y(k,223) +.250_r8*rxt(k,490)*y(k,233) + & + .250_r8*rxt(k,495)*y(k,234))*y(k,201) + loss(k,128) = (rxt(k,303)* y(k,228) + rxt(k,39) + het_rates(k,53))* y(k,53) + prod(k,128) =rxt(k,300)*y(k,201)*y(k,90) + loss(k,236) = (rxt(k,215)* y(k,56) +rxt(k,271)* y(k,73) + (rxt(k,310) + & + rxt(k,311) +rxt(k,312))* y(k,224) +rxt(k,304)* y(k,228) + rxt(k,40) & + + rxt(k,41) + het_rates(k,54))* y(k,54) + prod(k,236) =.100_r8*rxt(k,347)*y(k,136)*y(k,29) + loss(k,117) = (rxt(k,284)* y(k,56) +rxt(k,267)* y(k,224) +rxt(k,285) & + * y(k,228) + rxt(k,91) + het_rates(k,55))* y(k,55) + prod(k,117) = 0._r8 + loss(k,234) = (rxt(k,325)* y(k,28) +rxt(k,355)* y(k,31) +rxt(k,277)* y(k,41) & + +rxt(k,214)* y(k,42) +rxt(k,279)* y(k,43) +rxt(k,282)* y(k,46) & + +rxt(k,215)* y(k,54) +rxt(k,284)* y(k,55) +rxt(k,227)* y(k,60) & + +rxt(k,216)* y(k,77) +rxt(k,217)* y(k,79) + (rxt(k,218) +rxt(k,219)) & + * y(k,90) +rxt(k,236)* y(k,93) +rxt(k,220)* y(k,136) & + + het_rates(k,56))* y(k,56) + prod(k,234) = (4.000_r8*rxt(k,239)*y(k,33) +rxt(k,240)*y(k,34) + & + 2.000_r8*rxt(k,241)*y(k,36) +2.000_r8*rxt(k,242)*y(k,37) + & + 2.000_r8*rxt(k,243)*y(k,38) +rxt(k,244)*y(k,39) + & + 2.000_r8*rxt(k,245)*y(k,40) +rxt(k,246)*y(k,85) +rxt(k,276)*y(k,65) + & + rxt(k,291)*y(k,82) +rxt(k,292)*y(k,83) +rxt(k,293)*y(k,84))*y(k,224) & + + (rxt(k,94) +rxt(k,221)*y(k,201) +2.000_r8*rxt(k,222)*y(k,59) + & + rxt(k,224)*y(k,59) +rxt(k,226)*y(k,124) +rxt(k,231)*y(k,134) + & + rxt(k,232)*y(k,228) +rxt(k,255)*y(k,19) +rxt(k,510)*y(k,152))*y(k,59) & + + (rxt(k,235)*y(k,85) +3.000_r8*rxt(k,281)*y(k,44) + & + rxt(k,283)*y(k,46) +rxt(k,286)*y(k,82) +rxt(k,287)*y(k,83) + & + rxt(k,288)*y(k,84))*y(k,228) + (rxt(k,104) +rxt(k,234)*y(k,134)) & + *y(k,85) +rxt(k,75)*y(k,18) +4.000_r8*rxt(k,79)*y(k,33) +rxt(k,80) & + *y(k,34) +2.000_r8*rxt(k,82)*y(k,36) +2.000_r8*rxt(k,83)*y(k,37) & + +2.000_r8*rxt(k,84)*y(k,38) +rxt(k,85)*y(k,39) +2.000_r8*rxt(k,86) & + *y(k,40) +3.000_r8*rxt(k,89)*y(k,44) +rxt(k,90)*y(k,46) & + +2.000_r8*rxt(k,92)*y(k,57) +2.000_r8*rxt(k,93)*y(k,58) +rxt(k,95) & + *y(k,60) +rxt(k,98)*y(k,65) +rxt(k,101)*y(k,82) +rxt(k,102)*y(k,83) & + +rxt(k,103)*y(k,84) +rxt(k,107)*y(k,93) + loss(k,74) = ( + rxt(k,92) + het_rates(k,57))* y(k,57) + prod(k,74) = (rxt(k,563)*y(k,93) +rxt(k,568)*y(k,60) +rxt(k,569)*y(k,93) + & + rxt(k,573)*y(k,60) +rxt(k,574)*y(k,93) +rxt(k,578)*y(k,60))*y(k,85) & + +rxt(k,227)*y(k,60)*y(k,56) +rxt(k,223)*y(k,59)*y(k,59) + loss(k,54) = ( + rxt(k,93) + rxt(k,249) + het_rates(k,58))* y(k,58) + prod(k,54) =rxt(k,248)*y(k,59)*y(k,59) + loss(k,224) = ((rxt(k,254) +rxt(k,255) +rxt(k,256))* y(k,19) & + + 2._r8*(rxt(k,222) +rxt(k,223) +rxt(k,224) +rxt(k,248))* y(k,59) & + +rxt(k,225)* y(k,90) +rxt(k,226)* y(k,124) +rxt(k,228)* y(k,125) & + +rxt(k,231)* y(k,134) +rxt(k,510)* y(k,152) +rxt(k,221)* y(k,201) & + + (rxt(k,232) +rxt(k,233))* y(k,228) + rxt(k,94) + het_rates(k,59)) & + * y(k,59) + prod(k,224) = (rxt(k,219)*y(k,90) +rxt(k,220)*y(k,136) +rxt(k,236)*y(k,93)) & + *y(k,56) + (rxt(k,96) +rxt(k,229)*y(k,134))*y(k,60) & + + (rxt(k,237)*y(k,134) +rxt(k,238)*y(k,228))*y(k,93) + (rxt(k,108) + & + rxt(k,515)*y(k,152))*y(k,138) +2.000_r8*rxt(k,249)*y(k,58) & + +rxt(k,247)*y(k,224)*y(k,85) + loss(k,187) = (rxt(k,227)* y(k,56) + (rxt(k,568) +rxt(k,573) +rxt(k,578)) & + * y(k,85) +rxt(k,229)* y(k,134) +rxt(k,230)* y(k,228) + rxt(k,95) & + + rxt(k,96) + rxt(k,566) + rxt(k,571) + rxt(k,577) & + + het_rates(k,60))* y(k,60) + prod(k,187) =rxt(k,228)*y(k,125)*y(k,59) + loss(k,5) = ( + het_rates(k,61))* y(k,61) + prod(k,5) = 0._r8 + loss(k,201) = (rxt(k,314)* y(k,228) + het_rates(k,62))* y(k,62) + prod(k,201) = (rxt(k,33) +rxt(k,34) +rxt(k,214)*y(k,56) +rxt(k,250)*y(k,17) + & + rxt(k,295)*y(k,126) +rxt(k,296)*y(k,134) +rxt(k,297)*y(k,228)) & + *y(k,42) + (.630_r8*rxt(k,318)*y(k,25) +.560_r8*rxt(k,347)*y(k,29) + & + .650_r8*rxt(k,378)*y(k,105) +.560_r8*rxt(k,392)*y(k,111) + & + .620_r8*rxt(k,425)*y(k,99) +.230_r8*rxt(k,480)*y(k,6) + & + .230_r8*rxt(k,483)*y(k,110))*y(k,136) & + + (.220_r8*rxt(k,376)*y(k,213) +.250_r8*rxt(k,433)*y(k,237) + & + .170_r8*rxt(k,451)*y(k,202) +.400_r8*rxt(k,454)*y(k,214) + & + .350_r8*rxt(k,457)*y(k,216) +.225_r8*rxt(k,492)*y(k,233))*y(k,124) & + + (.350_r8*rxt(k,316)*y(k,24) +rxt(k,341)*y(k,75) + & + rxt(k,354)*y(k,49) +.700_r8*rxt(k,501)*y(k,181) +rxt(k,505)*y(k,139)) & + *y(k,228) + (rxt(k,42) +rxt(k,110) +rxt(k,591)*y(k,229))*y(k,63) & + + (.070_r8*rxt(k,450)*y(k,202) +.160_r8*rxt(k,453)*y(k,214) + & + .140_r8*rxt(k,456)*y(k,216))*y(k,90) + (rxt(k,353)*y(k,49) + & + .220_r8*rxt(k,375)*y(k,213) +.500_r8*rxt(k,434)*y(k,237))*y(k,126) & + + (.110_r8*rxt(k,373)*y(k,213) +.200_r8*rxt(k,431)*y(k,237) + & + .125_r8*rxt(k,490)*y(k,233))*y(k,201) + (rxt(k,137) + & + rxt(k,504)*y(k,134))*y(k,139) + (.220_r8*rxt(k,372)*y(k,213) + & + .250_r8*rxt(k,430)*y(k,237))*y(k,200) +1.500_r8*rxt(k,23)*y(k,9) & + +.450_r8*rxt(k,24)*y(k,10) +.600_r8*rxt(k,27)*y(k,13) +rxt(k,28) & + *y(k,14) +rxt(k,35)*y(k,45) +rxt(k,282)*y(k,56)*y(k,46) +rxt(k,37) & + *y(k,49) +.380_r8*rxt(k,40)*y(k,54) +rxt(k,44)*y(k,74) & + +2.000_r8*rxt(k,45)*y(k,75) +.330_r8*rxt(k,46)*y(k,94) & + +1.340_r8*rxt(k,52)*y(k,105) +.700_r8*rxt(k,56)*y(k,111) & + +1.500_r8*rxt(k,65)*y(k,176) +.250_r8*rxt(k,66)*y(k,177) +rxt(k,69) & + *y(k,180) +1.700_r8*rxt(k,70)*y(k,181) + loss(k,217) = (rxt(k,591)* y(k,229) + rxt(k,42) + rxt(k,110) & + + het_rates(k,63))* y(k,63) + prod(k,217) = (rxt(k,306)*y(k,87) +rxt(k,314)*y(k,62) +rxt(k,334)*y(k,50) + & + .500_r8*rxt(k,335)*y(k,51) +.800_r8*rxt(k,340)*y(k,74) + & + rxt(k,341)*y(k,75) +.500_r8*rxt(k,391)*y(k,109) + & + 1.800_r8*rxt(k,501)*y(k,181))*y(k,228) & + + (2.000_r8*rxt(k,330)*y(k,200) +.900_r8*rxt(k,331)*y(k,201) + & + rxt(k,333)*y(k,124) +2.000_r8*rxt(k,381)*y(k,215) + & + rxt(k,405)*y(k,208) +rxt(k,430)*y(k,237))*y(k,200) & + + (.200_r8*rxt(k,347)*y(k,29) +.100_r8*rxt(k,392)*y(k,111) + & + .270_r8*rxt(k,480)*y(k,6) +.270_r8*rxt(k,483)*y(k,110))*y(k,136) & + + (rxt(k,382)*y(k,201) +.450_r8*rxt(k,383)*y(k,90) + & + 2.000_r8*rxt(k,384)*y(k,215))*y(k,215) & + + (.500_r8*rxt(k,490)*y(k,201) +.900_r8*rxt(k,492)*y(k,124)) & + *y(k,233) +rxt(k,38)*y(k,51) +.440_r8*rxt(k,40)*y(k,54) & + +.400_r8*rxt(k,61)*y(k,141) +rxt(k,66)*y(k,177) +.800_r8*rxt(k,70) & + *y(k,181) + loss(k,89) = (rxt(k,275)* y(k,224) + rxt(k,97) + het_rates(k,64))* y(k,64) + prod(k,89) = (rxt(k,240)*y(k,34) +rxt(k,242)*y(k,37) + & + 2.000_r8*rxt(k,243)*y(k,38) +2.000_r8*rxt(k,244)*y(k,39) + & + rxt(k,245)*y(k,40) +rxt(k,266)*y(k,35) +2.000_r8*rxt(k,268)*y(k,78) + & + rxt(k,292)*y(k,83) +rxt(k,293)*y(k,84))*y(k,224) + (rxt(k,102) + & + rxt(k,287)*y(k,228))*y(k,83) + (rxt(k,103) +rxt(k,288)*y(k,228)) & + *y(k,84) +rxt(k,80)*y(k,34) +rxt(k,81)*y(k,35) +rxt(k,83)*y(k,37) & + +2.000_r8*rxt(k,84)*y(k,38) +2.000_r8*rxt(k,85)*y(k,39) +rxt(k,86) & + *y(k,40) +2.000_r8*rxt(k,99)*y(k,78) + loss(k,91) = (rxt(k,276)* y(k,224) + rxt(k,98) + het_rates(k,65))* y(k,65) + prod(k,91) = (rxt(k,101) +rxt(k,286)*y(k,228) +rxt(k,291)*y(k,224))*y(k,82) & + + (rxt(k,82) +rxt(k,241)*y(k,224))*y(k,36) + (rxt(k,83) + & + rxt(k,242)*y(k,224))*y(k,37) + loss(k,79) = (rxt(k,449)* y(k,228) + het_rates(k,66))* y(k,66) + prod(k,79) =.180_r8*rxt(k,469)*y(k,228)*y(k,183) + loss(k,104) = (rxt(k,502)* y(k,126) + (rxt(k,503) +rxt(k,517))* y(k,228) & + + het_rates(k,67))* y(k,67) + prod(k,104) = 0._r8 + loss(k,6) = ( + het_rates(k,68))* y(k,68) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,69))* y(k,69) + prod(k,7) = 0._r8 + loss(k,8) = ( + het_rates(k,70))* y(k,70) + prod(k,8) = 0._r8 + loss(k,9) = ( + rxt(k,594) + het_rates(k,71))* y(k,71) + prod(k,9) = 0._r8 + loss(k,63) = ( + rxt(k,43) + het_rates(k,72))* y(k,72) + prod(k,63) =rxt(k,336)*y(k,206)*y(k,90) + loss(k,184) = (rxt(k,271)* y(k,54) +rxt(k,272)* y(k,77) +rxt(k,274)* y(k,89) & + +rxt(k,273)* y(k,241) + het_rates(k,73))* y(k,73) + prod(k,184) = (rxt(k,244)*y(k,39) +rxt(k,266)*y(k,35) + & + 2.000_r8*rxt(k,275)*y(k,64) +rxt(k,276)*y(k,65))*y(k,224) +rxt(k,81) & + *y(k,35) +rxt(k,85)*y(k,39) +2.000_r8*rxt(k,97)*y(k,64) +rxt(k,98) & + *y(k,65) +rxt(k,105)*y(k,88) + loss(k,202) = (rxt(k,340)* y(k,228) + rxt(k,44) + het_rates(k,74))* y(k,74) + prod(k,202) = (.530_r8*rxt(k,376)*y(k,213) +.050_r8*rxt(k,414)*y(k,209) + & + .250_r8*rxt(k,433)*y(k,237) +.225_r8*rxt(k,492)*y(k,233))*y(k,124) & + + (.530_r8*rxt(k,375)*y(k,213) +.050_r8*rxt(k,415)*y(k,209) + & + .250_r8*rxt(k,434)*y(k,237))*y(k,126) & + + (.260_r8*rxt(k,373)*y(k,213) +.100_r8*rxt(k,431)*y(k,237) + & + .125_r8*rxt(k,490)*y(k,233))*y(k,201) & + + (.700_r8*rxt(k,416)*y(k,100) +.500_r8*rxt(k,417)*y(k,101) + & + rxt(k,428)*y(k,115))*y(k,228) + (.530_r8*rxt(k,372)*y(k,213) + & + .250_r8*rxt(k,430)*y(k,237))*y(k,200) +.330_r8*rxt(k,46)*y(k,94) & + +rxt(k,339)*y(k,205)*y(k,135) +.250_r8*rxt(k,66)*y(k,177) + loss(k,192) = (rxt(k,341)* y(k,228) + rxt(k,45) + rxt(k,520) & + + het_rates(k,75))* y(k,75) + prod(k,192) = (.050_r8*rxt(k,414)*y(k,209) +.250_r8*rxt(k,433)*y(k,237) + & + rxt(k,440)*y(k,194) +.400_r8*rxt(k,454)*y(k,214) + & + .170_r8*rxt(k,457)*y(k,216) +.700_r8*rxt(k,460)*y(k,230) + & + .600_r8*rxt(k,467)*y(k,235) +.340_r8*rxt(k,473)*y(k,238) + & + .170_r8*rxt(k,476)*y(k,240))*y(k,124) + (.650_r8*rxt(k,316)*y(k,24) + & + .200_r8*rxt(k,340)*y(k,74) +rxt(k,429)*y(k,116))*y(k,228) & + + (.250_r8*rxt(k,430)*y(k,200) +.100_r8*rxt(k,431)*y(k,201) + & + .250_r8*rxt(k,434)*y(k,126))*y(k,237) & + + (.160_r8*rxt(k,453)*y(k,214) +.070_r8*rxt(k,456)*y(k,216))*y(k,90) & + +rxt(k,22)*y(k,8) +.130_r8*rxt(k,24)*y(k,10) & + +.050_r8*rxt(k,415)*y(k,209)*y(k,126) +.700_r8*rxt(k,62)*y(k,145) & + +.600_r8*rxt(k,71)*y(k,182) +.340_r8*rxt(k,73)*y(k,186) & + +.170_r8*rxt(k,74)*y(k,188) + loss(k,233) = ((rxt(k,172) +rxt(k,173) +rxt(k,174))* y(k,90) +rxt(k,175) & + * y(k,135) +rxt(k,178)* y(k,136) + het_rates(k,76))* y(k,76) + prod(k,233) = (rxt(k,179)*y(k,77) +rxt(k,182)*y(k,134) +rxt(k,202)*y(k,112) + & + rxt(k,297)*y(k,42) +rxt(k,505)*y(k,139) +rxt(k,511)*y(k,150) + & + rxt(k,516)*y(k,152))*y(k,228) + (rxt(k,153)*y(k,224) + & + rxt(k,170)*y(k,134) +rxt(k,216)*y(k,56) +rxt(k,272)*y(k,73))*y(k,77) & + + (.330_r8*rxt(k,40) +rxt(k,41) +rxt(k,311)*y(k,224))*y(k,54) & + + (rxt(k,100) +rxt(k,270)*y(k,224))*y(k,81) + (rxt(k,104) + & + rxt(k,247)*y(k,224))*y(k,85) + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,241) & + +2.000_r8*rxt(k,34)*y(k,42) +rxt(k,39)*y(k,53) +rxt(k,105)*y(k,88) + loss(k,218) = (rxt(k,216)* y(k,56) +rxt(k,272)* y(k,73) +rxt(k,170)* y(k,134) & + +rxt(k,153)* y(k,224) +rxt(k,179)* y(k,228) + het_rates(k,77)) & + * y(k,77) + prod(k,218) = (1.440_r8*rxt(k,40) +rxt(k,312)*y(k,224))*y(k,54) +rxt(k,33) & + *y(k,42) +rxt(k,172)*y(k,90)*y(k,76) +rxt(k,1)*y(k,241) + loss(k,58) = (rxt(k,268)* y(k,224) + rxt(k,99) + het_rates(k,78))* y(k,78) + prod(k,58) = 0._r8 + loss(k,147) = (rxt(k,217)* y(k,56) +rxt(k,171)* y(k,134) +rxt(k,180) & + * y(k,228) + rxt(k,4) + het_rates(k,79))* y(k,79) + prod(k,147) =rxt(k,186)*y(k,90)*y(k,90) +rxt(k,185)*y(k,228)*y(k,228) + loss(k,64) = ( + rxt(k,136) + het_rates(k,80))* y(k,80) + prod(k,64) =rxt(k,518)*y(k,241)*y(k,154) + loss(k,174) = (rxt(k,263)* y(k,134) + (rxt(k,269) +rxt(k,270))* y(k,224) & + +rxt(k,264)* y(k,228) + rxt(k,100) + het_rates(k,81))* y(k,81) + prod(k,174) = (rxt(k,250)*y(k,42) +rxt(k,251)*y(k,90))*y(k,17) + loss(k,90) = (rxt(k,291)* y(k,224) +rxt(k,286)* y(k,228) + rxt(k,101) & + + het_rates(k,82))* y(k,82) + prod(k,90) = 0._r8 + loss(k,92) = (rxt(k,292)* y(k,224) +rxt(k,287)* y(k,228) + rxt(k,102) & + + het_rates(k,83))* y(k,83) + prod(k,92) = 0._r8 + loss(k,101) = (rxt(k,293)* y(k,224) +rxt(k,288)* y(k,228) + rxt(k,103) & + + het_rates(k,84))* y(k,84) + prod(k,101) = 0._r8 + loss(k,220) = ((rxt(k,568) +rxt(k,573) +rxt(k,578))* y(k,60) + (rxt(k,570) + & + rxt(k,575))* y(k,92) + (rxt(k,563) +rxt(k,569) +rxt(k,574))* y(k,93) & + +rxt(k,234)* y(k,134) + (rxt(k,246) +rxt(k,247))* y(k,224) & + +rxt(k,235)* y(k,228) + rxt(k,104) + het_rates(k,85))* y(k,85) + prod(k,220) = (rxt(k,214)*y(k,42) +rxt(k,215)*y(k,54) +rxt(k,216)*y(k,77) + & + rxt(k,217)*y(k,79) +rxt(k,218)*y(k,90) +rxt(k,236)*y(k,93) + & + rxt(k,277)*y(k,41) +rxt(k,279)*y(k,43) +2.000_r8*rxt(k,282)*y(k,46) + & + rxt(k,284)*y(k,55) +rxt(k,325)*y(k,28) +rxt(k,355)*y(k,31))*y(k,56) & + +rxt(k,233)*y(k,228)*y(k,59) + loss(k,77) = (rxt(k,313)* y(k,224) +rxt(k,305)* y(k,228) + het_rates(k,86)) & + * y(k,86) + prod(k,77) = 0._r8 + loss(k,183) = (rxt(k,306)* y(k,228) + het_rates(k,87))* y(k,87) + prod(k,183) = (.370_r8*rxt(k,318)*y(k,25) +.120_r8*rxt(k,347)*y(k,29) + & + .330_r8*rxt(k,378)*y(k,105) +.120_r8*rxt(k,392)*y(k,111) + & + .110_r8*rxt(k,425)*y(k,99) +.050_r8*rxt(k,480)*y(k,6) + & + .050_r8*rxt(k,483)*y(k,110))*y(k,136) + (rxt(k,307)*y(k,90) + & + rxt(k,309)*y(k,124))*y(k,207) +.350_r8*rxt(k,316)*y(k,228)*y(k,24) + loss(k,99) = ( + rxt(k,105) + het_rates(k,88))* y(k,88) + prod(k,99) = (rxt(k,271)*y(k,54) +rxt(k,272)*y(k,77) +rxt(k,273)*y(k,241) + & + rxt(k,274)*y(k,89))*y(k,73) + loss(k,231) = (rxt(k,274)* y(k,73) +rxt(k,211)* y(k,228) + rxt(k,9) & + + het_rates(k,89))* y(k,89) + prod(k,231) = (rxt(k,566) +rxt(k,571) +rxt(k,577) +rxt(k,568)*y(k,85) + & + rxt(k,573)*y(k,85) +rxt(k,578)*y(k,85))*y(k,60) + (rxt(k,530) + & + rxt(k,295)*y(k,42) +rxt(k,327)*y(k,45) +rxt(k,353)*y(k,49) + & + rxt(k,502)*y(k,67))*y(k,126) + (2.000_r8*rxt(k,525) + & + 2.000_r8*rxt(k,562) +2.000_r8*rxt(k,565) +2.000_r8*rxt(k,576)) & + *y(k,114) + (rxt(k,564) +rxt(k,567) +rxt(k,572))*y(k,20) & + + (.500_r8*rxt(k,529) +rxt(k,210)*y(k,228))*y(k,125) +rxt(k,522) & + *y(k,94) +rxt(k,523)*y(k,100) +rxt(k,524)*y(k,101) +rxt(k,526) & + *y(k,115) +rxt(k,527)*y(k,116) +rxt(k,531)*y(k,128) +rxt(k,532) & + *y(k,140) +rxt(k,533)*y(k,178) + loss(k,237) = (rxt(k,251)* y(k,17) +rxt(k,257)* y(k,19) +rxt(k,294)* y(k,42) & + + (rxt(k,218) +rxt(k,219))* y(k,56) +rxt(k,225)* y(k,59) & + + (rxt(k,172) +rxt(k,173) +rxt(k,174))* y(k,76) + 2._r8*rxt(k,186) & + * y(k,90) +rxt(k,203)* y(k,124) +rxt(k,208)* y(k,125) +rxt(k,198) & + * y(k,126) +rxt(k,176)* y(k,134) +rxt(k,177)* y(k,136) +rxt(k,436) & + * y(k,191) +rxt(k,397)* y(k,192) +rxt(k,439)* y(k,194) +rxt(k,443) & + * y(k,196) +rxt(k,321)* y(k,197) +rxt(k,349)* y(k,198) +rxt(k,446) & + * y(k,199) +rxt(k,332)* y(k,200) +rxt(k,300)* y(k,201) +rxt(k,450) & + * y(k,202) +rxt(k,336)* y(k,206) +rxt(k,307)* y(k,207) +rxt(k,407) & + * y(k,208) +rxt(k,412)* y(k,209) +rxt(k,421)* y(k,210) +rxt(k,374) & + * y(k,213) +rxt(k,453)* y(k,214) +rxt(k,383)* y(k,215) +rxt(k,456) & + * y(k,216) +rxt(k,387)* y(k,217) +rxt(k,486)* y(k,223) +rxt(k,181) & + * y(k,228) +rxt(k,459)* y(k,230) +rxt(k,358)* y(k,231) +rxt(k,362) & + * y(k,232) +rxt(k,491)* y(k,233) +rxt(k,496)* y(k,234) +rxt(k,466) & + * y(k,235) +rxt(k,432)* y(k,237) +rxt(k,472)* y(k,238) +rxt(k,475) & + * y(k,240) + rxt(k,521) + het_rates(k,90))* y(k,90) + prod(k,237) = (rxt(k,180)*y(k,79) +rxt(k,183)*y(k,136) +rxt(k,201)*y(k,126) + & + rxt(k,232)*y(k,59) +rxt(k,262)*y(k,19) +rxt(k,280)*y(k,43) + & + rxt(k,283)*y(k,46) +rxt(k,302)*y(k,52) +rxt(k,305)*y(k,86) + & + rxt(k,306)*y(k,87) +rxt(k,314)*y(k,62) +.350_r8*rxt(k,316)*y(k,24) + & + rxt(k,323)*y(k,26) +rxt(k,329)*y(k,47) +rxt(k,340)*y(k,74) + & + rxt(k,341)*y(k,75) +rxt(k,356)*y(k,96) +rxt(k,371)*y(k,94) + & + .200_r8*rxt(k,380)*y(k,106) +.500_r8*rxt(k,391)*y(k,109) + & + .300_r8*rxt(k,416)*y(k,100) +rxt(k,417)*y(k,101) + & + rxt(k,424)*y(k,102) +rxt(k,428)*y(k,115) +rxt(k,429)*y(k,116) + & + .650_r8*rxt(k,438)*y(k,7) +.730_r8*rxt(k,449)*y(k,66) + & + .800_r8*rxt(k,461)*y(k,144) +.280_r8*rxt(k,469)*y(k,183) + & + .380_r8*rxt(k,471)*y(k,185) +.630_r8*rxt(k,477)*y(k,187) + & + .200_r8*rxt(k,501)*y(k,181) +rxt(k,507)*y(k,153) + & + .500_r8*rxt(k,517)*y(k,67))*y(k,228) + (rxt(k,301)*y(k,201) + & + rxt(k,309)*y(k,207) +rxt(k,322)*y(k,197) + & + .250_r8*rxt(k,337)*y(k,206) +rxt(k,350)*y(k,198) + & + rxt(k,359)*y(k,231) +rxt(k,369)*y(k,204) + & + .470_r8*rxt(k,376)*y(k,213) +rxt(k,398)*y(k,192) + & + .920_r8*rxt(k,408)*y(k,208) +.920_r8*rxt(k,414)*y(k,209) + & + rxt(k,422)*y(k,210) +rxt(k,433)*y(k,237) +rxt(k,440)*y(k,194) + & + rxt(k,445)*y(k,196) +.170_r8*rxt(k,451)*y(k,202) + & + .400_r8*rxt(k,454)*y(k,214) +.830_r8*rxt(k,457)*y(k,216) + & + rxt(k,460)*y(k,230) +rxt(k,467)*y(k,235) +rxt(k,473)*y(k,238) + & + rxt(k,476)*y(k,240) +.900_r8*rxt(k,492)*y(k,233) + & + .800_r8*rxt(k,497)*y(k,234))*y(k,124) + (rxt(k,221)*y(k,59) + & + 2.000_r8*rxt(k,298)*y(k,201) +rxt(k,320)*y(k,197) + & + .900_r8*rxt(k,331)*y(k,200) +rxt(k,348)*y(k,198) + & + .300_r8*rxt(k,361)*y(k,232) +.730_r8*rxt(k,373)*y(k,213) + & + rxt(k,382)*y(k,215) +rxt(k,406)*y(k,208) +rxt(k,411)*y(k,209) + & + 1.200_r8*rxt(k,420)*y(k,210) +.800_r8*rxt(k,431)*y(k,237) + & + .500_r8*rxt(k,485)*y(k,223) +rxt(k,490)*y(k,233) + & + rxt(k,495)*y(k,234))*y(k,201) + (.130_r8*rxt(k,318)*y(k,25) + & + .280_r8*rxt(k,347)*y(k,29) +.140_r8*rxt(k,378)*y(k,105) + & + .280_r8*rxt(k,392)*y(k,111) +.370_r8*rxt(k,425)*y(k,99) + & + .570_r8*rxt(k,480)*y(k,6) +.570_r8*rxt(k,483)*y(k,110))*y(k,136) & + + (rxt(k,295)*y(k,42) +.470_r8*rxt(k,375)*y(k,213) + & + rxt(k,409)*y(k,208) +rxt(k,415)*y(k,209) +rxt(k,423)*y(k,210) + & + rxt(k,434)*y(k,237))*y(k,126) + (.470_r8*rxt(k,372)*y(k,213) + & + rxt(k,405)*y(k,208) +rxt(k,410)*y(k,209) +rxt(k,419)*y(k,210) + & + rxt(k,430)*y(k,237))*y(k,200) + (rxt(k,214)*y(k,42) + & + rxt(k,217)*y(k,79) +rxt(k,279)*y(k,43) +rxt(k,282)*y(k,46))*y(k,56) & + + (.070_r8*rxt(k,450)*y(k,202) +.160_r8*rxt(k,453)*y(k,214) + & + .330_r8*rxt(k,456)*y(k,216))*y(k,90) + (rxt(k,250)*y(k,17) + & + rxt(k,296)*y(k,134))*y(k,42) + (rxt(k,11) +rxt(k,212))*y(k,91) & + + (1.340_r8*rxt(k,51) +.660_r8*rxt(k,52))*y(k,105) & + + (rxt(k,175)*y(k,76) +rxt(k,339)*y(k,205))*y(k,135) +rxt(k,20) & + *y(k,1) +.900_r8*rxt(k,21)*y(k,2) +rxt(k,22)*y(k,8) & + +1.500_r8*rxt(k,23)*y(k,9) +.560_r8*rxt(k,24)*y(k,10) +rxt(k,25) & + *y(k,11) +.600_r8*rxt(k,26)*y(k,12) +.600_r8*rxt(k,27)*y(k,13) & + +rxt(k,28)*y(k,14) +rxt(k,29)*y(k,23) +rxt(k,30)*y(k,27) +rxt(k,31) & + *y(k,30) +rxt(k,35)*y(k,45) +rxt(k,37)*y(k,49) +rxt(k,311)*y(k,224) & + *y(k,54) +2.000_r8*rxt(k,44)*y(k,74) +2.000_r8*rxt(k,45)*y(k,75) & + +rxt(k,171)*y(k,134)*y(k,79) +.670_r8*rxt(k,46)*y(k,94) +rxt(k,47) & + *y(k,95) +rxt(k,48)*y(k,96) +rxt(k,49)*y(k,102) +rxt(k,50)*y(k,103) & + +rxt(k,57)*y(k,116) +rxt(k,62)*y(k,145) +rxt(k,63)*y(k,148) & + +rxt(k,65)*y(k,176) +rxt(k,66)*y(k,177) +rxt(k,67)*y(k,178) & + +rxt(k,68)*y(k,179) +rxt(k,69)*y(k,180) +1.200_r8*rxt(k,70)*y(k,181) & + +rxt(k,71)*y(k,182) +rxt(k,73)*y(k,186) +rxt(k,74)*y(k,188) & + +1.200_r8*rxt(k,319)*y(k,197)*y(k,197) +rxt(k,338)*y(k,205) & + +rxt(k,308)*y(k,207) +rxt(k,413)*y(k,209) + loss(k,132) = (rxt(k,187)* y(k,228) + rxt(k,10) + rxt(k,11) + rxt(k,212) & + + het_rates(k,91))* y(k,91) + prod(k,132) =rxt(k,208)*y(k,125)*y(k,90) + loss(k,169) = ((rxt(k,570) +rxt(k,575))* y(k,85) +rxt(k,265)* y(k,134) & + + rxt(k,106) + het_rates(k,92))* y(k,92) + prod(k,169) = (rxt(k,564) +rxt(k,567) +rxt(k,572))*y(k,20) & + +rxt(k,257)*y(k,90)*y(k,19) + loss(k,175) = (rxt(k,236)* y(k,56) + (rxt(k,563) +rxt(k,569) +rxt(k,574)) & + * y(k,85) +rxt(k,237)* y(k,134) +rxt(k,238)* y(k,228) + rxt(k,107) & + + het_rates(k,93))* y(k,93) + prod(k,175) = (rxt(k,566) +rxt(k,571) +rxt(k,577) +rxt(k,230)*y(k,228)) & + *y(k,60) +rxt(k,225)*y(k,90)*y(k,59) + loss(k,204) = (rxt(k,371)* y(k,228) + rxt(k,46) + rxt(k,522) & + + het_rates(k,94))* y(k,94) + prod(k,204) = (rxt(k,370)*y(k,204) +rxt(k,377)*y(k,213))*y(k,124) & + + (.300_r8*rxt(k,416)*y(k,100) +.500_r8*rxt(k,417)*y(k,101)) & + *y(k,228) + loss(k,84) = (rxt(k,402)* y(k,228) + rxt(k,47) + het_rates(k,95))* y(k,95) + prod(k,84) =rxt(k,413)*y(k,209) + loss(k,205) = (rxt(k,356)* y(k,228) + rxt(k,48) + het_rates(k,96))* y(k,96) + prod(k,205) = (.220_r8*rxt(k,372)*y(k,200) +.230_r8*rxt(k,373)*y(k,201) + & + .220_r8*rxt(k,375)*y(k,126) +.220_r8*rxt(k,376)*y(k,124))*y(k,213) & + + (.500_r8*rxt(k,360)*y(k,148) +.500_r8*rxt(k,391)*y(k,109) + & + .700_r8*rxt(k,416)*y(k,100) +.500_r8*rxt(k,417)*y(k,101))*y(k,228) & + + (.250_r8*rxt(k,430)*y(k,200) +.100_r8*rxt(k,431)*y(k,201) + & + .250_r8*rxt(k,433)*y(k,124) +.250_r8*rxt(k,434)*y(k,126))*y(k,237) & + + (.050_r8*rxt(k,414)*y(k,124) +.050_r8*rxt(k,415)*y(k,126)) & + *y(k,209) +.170_r8*rxt(k,46)*y(k,94) +.200_r8*rxt(k,361)*y(k,232) & + *y(k,201) + loss(k,107) = (rxt(k,403)* y(k,228) + het_rates(k,97))* y(k,97) + prod(k,107) = (rxt(k,410)*y(k,200) +.750_r8*rxt(k,411)*y(k,201) + & + .870_r8*rxt(k,414)*y(k,124) +.950_r8*rxt(k,415)*y(k,126))*y(k,209) + loss(k,65) = (rxt(k,404)* y(k,228) + het_rates(k,98))* y(k,98) + prod(k,65) =.600_r8*rxt(k,427)*y(k,228)*y(k,103) + loss(k,179) = (rxt(k,418)* y(k,126) +rxt(k,425)* y(k,136) +rxt(k,426) & + * y(k,228) + het_rates(k,99))* y(k,99) + prod(k,179) = 0._r8 + loss(k,148) = (rxt(k,416)* y(k,228) + rxt(k,523) + het_rates(k,100)) & + * y(k,100) + prod(k,148) =.080_r8*rxt(k,408)*y(k,208)*y(k,124) + loss(k,144) = (rxt(k,417)* y(k,228) + rxt(k,524) + het_rates(k,101)) & + * y(k,101) + prod(k,144) =.080_r8*rxt(k,414)*y(k,209)*y(k,124) + loss(k,120) = (rxt(k,424)* y(k,228) + rxt(k,49) + het_rates(k,102))* y(k,102) + prod(k,120) =rxt(k,421)*y(k,210)*y(k,90) + loss(k,162) = (rxt(k,427)* y(k,228) + rxt(k,50) + het_rates(k,103))* y(k,103) + prod(k,162) = (rxt(k,407)*y(k,208) +rxt(k,412)*y(k,209))*y(k,90) +rxt(k,49) & + *y(k,102) + loss(k,50) = (rxt(k,549)* y(k,228) + het_rates(k,104))* y(k,104) + prod(k,50) = 0._r8 + loss(k,209) = (rxt(k,378)* y(k,136) +rxt(k,379)* y(k,228) + rxt(k,51) & + + rxt(k,52) + het_rates(k,105))* y(k,105) + prod(k,209) = (.390_r8*rxt(k,405)*y(k,200) +.310_r8*rxt(k,406)*y(k,201) + & + .360_r8*rxt(k,408)*y(k,124) +.400_r8*rxt(k,409)*y(k,126))*y(k,208) & + +.300_r8*rxt(k,425)*y(k,136)*y(k,99) +.300_r8*rxt(k,50)*y(k,103) + loss(k,105) = (rxt(k,380)* y(k,228) + het_rates(k,106))* y(k,106) + prod(k,105) =rxt(k,374)*y(k,213)*y(k,90) + loss(k,138) = (rxt(k,389)* y(k,228) + rxt(k,53) + het_rates(k,107))* y(k,107) + prod(k,138) =.800_r8*rxt(k,20)*y(k,1) +.800_r8*rxt(k,21)*y(k,2) & + +.800_r8*rxt(k,398)*y(k,192)*y(k,124) + loss(k,106) = (rxt(k,390)* y(k,228) + rxt(k,54) + het_rates(k,108))* y(k,108) + prod(k,106) =.800_r8*rxt(k,387)*y(k,217)*y(k,90) + loss(k,151) = (rxt(k,391)* y(k,228) + rxt(k,55) + rxt(k,395) & + + het_rates(k,109))* y(k,109) + prod(k,151) =rxt(k,394)*y(k,215)*y(k,125) + loss(k,190) = (rxt(k,482)* y(k,126) +rxt(k,483)* y(k,136) +rxt(k,484) & + * y(k,228) + het_rates(k,110))* y(k,110) + prod(k,190) = 0._r8 + loss(k,214) = (rxt(k,392)* y(k,136) +rxt(k,393)* y(k,228) + rxt(k,56) & + + het_rates(k,111))* y(k,111) + prod(k,214) = (.610_r8*rxt(k,405)*y(k,200) +.440_r8*rxt(k,406)*y(k,201) + & + .560_r8*rxt(k,408)*y(k,124) +.600_r8*rxt(k,409)*y(k,126))*y(k,208) & + +.200_r8*rxt(k,425)*y(k,136)*y(k,99) +.700_r8*rxt(k,50)*y(k,103) + loss(k,189) = (rxt(k,190)* y(k,124) + (rxt(k,191) +rxt(k,192) +rxt(k,193)) & + * y(k,125) +rxt(k,194)* y(k,135) +rxt(k,588)* y(k,227) +rxt(k,202) & + * y(k,228) + rxt(k,111) + het_rates(k,112))* y(k,112) + prod(k,189) = (rxt(k,188)*y(k,219) +rxt(k,585)*y(k,222))*y(k,134) & + + (.200_r8*rxt(k,579)*y(k,221) +1.100_r8*rxt(k,581)*y(k,220)) & + *y(k,203) +rxt(k,15)*y(k,124) +rxt(k,586)*y(k,222)*y(k,135) & + +rxt(k,592)*y(k,229) + loss(k,93) = ((rxt(k,206) +rxt(k,207))* y(k,224) + rxt(k,12) & + + het_rates(k,113))* y(k,113) + prod(k,93) =rxt(k,191)*y(k,125)*y(k,112) + loss(k,97) = ( + rxt(k,13) + rxt(k,14) + rxt(k,213) + rxt(k,525) + rxt(k,562) & + + rxt(k,565) + rxt(k,576) + het_rates(k,114))* y(k,114) + prod(k,97) =rxt(k,209)*y(k,126)*y(k,125) + loss(k,124) = (rxt(k,428)* y(k,228) + rxt(k,526) + het_rates(k,115)) & + * y(k,115) + prod(k,124) =.200_r8*rxt(k,420)*y(k,210)*y(k,201) + loss(k,196) = (rxt(k,429)* y(k,228) + rxt(k,57) + rxt(k,527) & + + het_rates(k,116))* y(k,116) + prod(k,196) = (rxt(k,419)*y(k,200) +.800_r8*rxt(k,420)*y(k,201) + & + rxt(k,422)*y(k,124) +rxt(k,423)*y(k,126))*y(k,210) + loss(k,10) = ( + het_rates(k,117))* y(k,117) + prod(k,10) = 0._r8 + loss(k,11) = ( + het_rates(k,118))* y(k,118) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,119))* y(k,119) + prod(k,12) = 0._r8 + loss(k,55) = (rxt(k,519)* y(k,228) + het_rates(k,120))* y(k,120) + prod(k,55) = 0._r8 + loss(k,13) = ( + rxt(k,528) + het_rates(k,121))* y(k,121) + prod(k,13) = 0._r8 + loss(k,14) = ( + rxt(k,596) + het_rates(k,122))* y(k,122) + prod(k,14) = 0._r8 + loss(k,15) = ( + rxt(k,595) + het_rates(k,123))* y(k,123) + prod(k,15) = 0._r8 + loss(k,227) = (rxt(k,258)* y(k,19) +rxt(k,226)* y(k,59) +rxt(k,203)* y(k,90) & + +rxt(k,190)* y(k,112) +rxt(k,199)* y(k,126) +rxt(k,205)* y(k,134) & + +rxt(k,204)* y(k,136) +rxt(k,437)* y(k,191) + (rxt(k,398) + & + rxt(k,399))* y(k,192) +rxt(k,440)* y(k,194) +rxt(k,445)* y(k,196) & + +rxt(k,322)* y(k,197) +rxt(k,350)* y(k,198) +rxt(k,447)* y(k,199) & + +rxt(k,333)* y(k,200) +rxt(k,301)* y(k,201) +rxt(k,451)* y(k,202) & + + (rxt(k,369) +rxt(k,370))* y(k,204) +rxt(k,337)* y(k,206) & + +rxt(k,309)* y(k,207) +rxt(k,408)* y(k,208) +rxt(k,414)* y(k,209) & + +rxt(k,422)* y(k,210) + (rxt(k,376) +rxt(k,377))* y(k,213) & + +rxt(k,454)* y(k,214) +rxt(k,385)* y(k,215) +rxt(k,457)* y(k,216) & + +rxt(k,388)* y(k,217) +rxt(k,487)* y(k,223) +rxt(k,590)* y(k,227) & + +rxt(k,460)* y(k,230) +rxt(k,359)* y(k,231) +rxt(k,363)* y(k,232) & + +rxt(k,492)* y(k,233) +rxt(k,497)* y(k,234) +rxt(k,467)* y(k,235) & + +rxt(k,433)* y(k,237) +rxt(k,473)* y(k,238) +rxt(k,476)* y(k,240) & + + rxt(k,15) + rxt(k,16) + het_rates(k,124))* y(k,124) + prod(k,227) = (rxt(k,17) +.500_r8*rxt(k,529) +2.000_r8*rxt(k,192)*y(k,112) + & + rxt(k,195)*y(k,134) +rxt(k,512)*y(k,152))*y(k,125) & + + (rxt(k,194)*y(k,135) +rxt(k,202)*y(k,228))*y(k,112) & + +2.000_r8*rxt(k,206)*y(k,224)*y(k,113) +rxt(k,14)*y(k,114) & + +rxt(k,19)*y(k,126) +rxt(k,189)*y(k,219)*y(k,135) +rxt(k,589) & + *y(k,227) + loss(k,228) = (rxt(k,259)* y(k,19) +rxt(k,228)* y(k,59) +rxt(k,208)* y(k,90) & + + (rxt(k,191) +rxt(k,192) +rxt(k,193))* y(k,112) +rxt(k,209) & + * y(k,126) + (rxt(k,195) +rxt(k,197))* y(k,134) +rxt(k,196)* y(k,136) & + +rxt(k,462)* y(k,143) +rxt(k,512)* y(k,152) +rxt(k,465)* y(k,191) & + +rxt(k,344)* y(k,200) +rxt(k,452)* y(k,202) +rxt(k,455)* y(k,214) & + +rxt(k,394)* y(k,215) +rxt(k,458)* y(k,216) +rxt(k,210)* y(k,228) & + + rxt(k,17) + rxt(k,529) + het_rates(k,125))* y(k,125) + prod(k,228) = (2.000_r8*rxt(k,199)*y(k,126) +rxt(k,203)*y(k,90) + & + rxt(k,204)*y(k,136) +rxt(k,205)*y(k,134) +rxt(k,226)*y(k,59) + & + rxt(k,258)*y(k,19) +rxt(k,301)*y(k,201) +rxt(k,309)*y(k,207) + & + rxt(k,322)*y(k,197) +rxt(k,333)*y(k,200) +rxt(k,337)*y(k,206) + & + rxt(k,350)*y(k,198) +rxt(k,359)*y(k,231) +rxt(k,363)*y(k,232) + & + rxt(k,369)*y(k,204) +rxt(k,376)*y(k,213) +rxt(k,385)*y(k,215) + & + rxt(k,388)*y(k,217) +rxt(k,398)*y(k,192) + & + .920_r8*rxt(k,408)*y(k,208) +.920_r8*rxt(k,414)*y(k,209) + & + rxt(k,422)*y(k,210) +rxt(k,433)*y(k,237) +rxt(k,437)*y(k,191) + & + rxt(k,440)*y(k,194) +rxt(k,445)*y(k,196) +rxt(k,447)*y(k,199) + & + rxt(k,451)*y(k,202) +rxt(k,454)*y(k,214) +rxt(k,457)*y(k,216) + & + rxt(k,460)*y(k,230) +rxt(k,467)*y(k,235) +rxt(k,473)*y(k,238) + & + rxt(k,476)*y(k,240) +1.600_r8*rxt(k,487)*y(k,223) + & + .900_r8*rxt(k,492)*y(k,233) +.800_r8*rxt(k,497)*y(k,234))*y(k,124) & + + (rxt(k,18) +rxt(k,198)*y(k,90) +rxt(k,200)*y(k,134) + & + rxt(k,201)*y(k,228) +rxt(k,367)*y(k,16) +rxt(k,375)*y(k,213) + & + rxt(k,386)*y(k,215) +rxt(k,409)*y(k,208) +rxt(k,415)*y(k,209) + & + rxt(k,423)*y(k,210) +rxt(k,434)*y(k,237) + & + 2.000_r8*rxt(k,488)*y(k,223))*y(k,126) + (rxt(k,187)*y(k,91) + & + rxt(k,357)*y(k,127) +rxt(k,396)*y(k,1) +.700_r8*rxt(k,416)*y(k,100) + & + rxt(k,494)*y(k,178))*y(k,228) + (rxt(k,11) +rxt(k,212))*y(k,91) & + + (rxt(k,55) +rxt(k,395))*y(k,109) + (rxt(k,13) +rxt(k,213)) & + *y(k,114) + (.600_r8*rxt(k,61) +rxt(k,345))*y(k,141) +rxt(k,20) & + *y(k,1) +rxt(k,77)*y(k,20) +rxt(k,96)*y(k,60) +rxt(k,9)*y(k,89) & + +rxt(k,46)*y(k,94) +rxt(k,49)*y(k,102) +rxt(k,57)*y(k,116) & + +rxt(k,58)*y(k,127) +rxt(k,59)*y(k,128) +rxt(k,60)*y(k,140) & + +rxt(k,470)*y(k,142) +rxt(k,67)*y(k,178) & + +.500_r8*rxt(k,485)*y(k,223)*y(k,201) + loss(k,225) = (rxt(k,479)* y(k,6) +rxt(k,367)* y(k,16) +rxt(k,346)* y(k,29) & + +rxt(k,295)* y(k,42) +rxt(k,327)* y(k,45) +rxt(k,353)* y(k,49) & + +rxt(k,502)* y(k,67) +rxt(k,198)* y(k,90) +rxt(k,418)* y(k,99) & + +rxt(k,482)* y(k,110) +rxt(k,199)* y(k,124) +rxt(k,209)* y(k,125) & + +rxt(k,200)* y(k,134) +rxt(k,499)* y(k,180) +rxt(k,409)* y(k,208) & + +rxt(k,415)* y(k,209) +rxt(k,423)* y(k,210) +rxt(k,375)* y(k,213) & + +rxt(k,386)* y(k,215) +rxt(k,488)* y(k,223) +rxt(k,201)* y(k,228) & + +rxt(k,434)* y(k,237) + rxt(k,18) + rxt(k,19) + rxt(k,530) & + + het_rates(k,126))* y(k,126) + prod(k,225) = (rxt(k,95) +rxt(k,227)*y(k,56) +rxt(k,229)*y(k,134) + & + rxt(k,230)*y(k,228))*y(k,60) + (rxt(k,13) +rxt(k,14) +rxt(k,213)) & + *y(k,114) + (rxt(k,211)*y(k,89) +rxt(k,342)*y(k,141) + & + .500_r8*rxt(k,391)*y(k,109))*y(k,228) + (rxt(k,78) + & + rxt(k,260)*y(k,134))*y(k,20) + (rxt(k,196)*y(k,136) + & + rxt(k,197)*y(k,134))*y(k,125) +rxt(k,274)*y(k,89)*y(k,73) +rxt(k,10) & + *y(k,91) +.400_r8*rxt(k,61)*y(k,141) + loss(k,180) = (rxt(k,357)* y(k,228) + rxt(k,58) + het_rates(k,127))* y(k,127) + prod(k,180) = (.500_r8*rxt(k,417)*y(k,101) +rxt(k,424)*y(k,102) + & + rxt(k,428)*y(k,115) +rxt(k,429)*y(k,116))*y(k,228) & + +rxt(k,346)*y(k,126)*y(k,29) + loss(k,118) = (rxt(k,489)* y(k,228) + rxt(k,59) + rxt(k,531) & + + het_rates(k,128))* y(k,128) + prod(k,118) =rxt(k,486)*y(k,223)*y(k,90) + loss(k,16) = ( + het_rates(k,129))* y(k,129) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,130))* y(k,130) + prod(k,17) = 0._r8 + loss(k,18) = ( + het_rates(k,131))* y(k,131) + prod(k,18) = 0._r8 + loss(k,19) = ( + het_rates(k,132))* y(k,132) + prod(k,19) = 0._r8 + loss(k,20) = ( + het_rates(k,133))* y(k,133) + prod(k,20) = 0._r8 + loss(k,232) = (rxt(k,261)* y(k,19) +rxt(k,260)* y(k,20) +rxt(k,296)* y(k,42) & + +rxt(k,231)* y(k,59) +rxt(k,229)* y(k,60) +rxt(k,170)* y(k,77) & + +rxt(k,171)* y(k,79) +rxt(k,263)* y(k,81) +rxt(k,234)* y(k,85) & + +rxt(k,176)* y(k,90) +rxt(k,265)* y(k,92) +rxt(k,237)* y(k,93) & + +rxt(k,205)* y(k,124) + (rxt(k,195) +rxt(k,197))* y(k,125) & + +rxt(k,200)* y(k,126) + 2._r8*rxt(k,168)* y(k,134) +rxt(k,169) & + * y(k,135) +rxt(k,167)* y(k,136) +rxt(k,504)* y(k,139) & + + (rxt(k,583) +rxt(k,584))* y(k,220) +rxt(k,585)* y(k,222) & + +rxt(k,182)* y(k,228) + rxt(k,120) + rxt(k,121) + rxt(k,122) & + + rxt(k,123) + rxt(k,124) + rxt(k,125) + het_rates(k,134))* y(k,134) + prod(k,232) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,127) +rxt(k,128) + & + rxt(k,129) +rxt(k,131) +rxt(k,132) +rxt(k,133) +2.000_r8*rxt(k,134) + & + 2.000_r8*rxt(k,135) +rxt(k,156)*y(k,224) +rxt(k,157)*y(k,224) + & + rxt(k,194)*y(k,112) +rxt(k,506)*y(k,150) +rxt(k,513)*y(k,152) + & + rxt(k,587)*y(k,222) +rxt(k,593)*y(k,229))*y(k,135) & + + (rxt(k,190)*y(k,124) +rxt(k,191)*y(k,125) +rxt(k,588)*y(k,227)) & + *y(k,112) + (rxt(k,42) +rxt(k,110))*y(k,63) + (rxt(k,579)*y(k,221) + & + 1.150_r8*rxt(k,580)*y(k,227))*y(k,203) +rxt(k,76)*y(k,19) & + +.180_r8*rxt(k,40)*y(k,54) +rxt(k,94)*y(k,59) +rxt(k,174)*y(k,90) & + *y(k,76) +rxt(k,14)*y(k,114) +rxt(k,15)*y(k,124) +rxt(k,17)*y(k,125) & + +rxt(k,18)*y(k,126) +rxt(k,8)*y(k,136) +rxt(k,108)*y(k,138) & + +rxt(k,138)*y(k,152) +rxt(k,139)*y(k,153) +rxt(k,140)*y(k,154) & + +rxt(k,155)*y(k,224) +rxt(k,184)*y(k,228)*y(k,228) +rxt(k,2) & + *y(k,241) + loss(k,222) = (rxt(k,175)* y(k,76) +rxt(k,194)* y(k,112) +rxt(k,169) & + * y(k,134) +rxt(k,506)* y(k,150) +rxt(k,513)* y(k,152) +rxt(k,339) & + * y(k,205) +rxt(k,189)* y(k,219) +rxt(k,582)* y(k,220) & + + (rxt(k,586) +rxt(k,587))* y(k,222) +rxt(k,156)* y(k,224) & + +rxt(k,161)* y(k,225) +rxt(k,593)* y(k,229) + rxt(k,5) + rxt(k,6) & + + rxt(k,126) + rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,130) & + + rxt(k,131) + rxt(k,132) + rxt(k,133) + rxt(k,134) + rxt(k,135) & + + het_rates(k,135))* y(k,135) + prod(k,222) = (rxt(k,172)*y(k,76) +rxt(k,176)*y(k,134) + & + 2.000_r8*rxt(k,177)*y(k,136) +rxt(k,181)*y(k,228) + & + rxt(k,186)*y(k,90) +rxt(k,198)*y(k,126) +rxt(k,218)*y(k,56) + & + rxt(k,225)*y(k,59) +rxt(k,251)*y(k,17) +rxt(k,257)*y(k,19) + & + rxt(k,300)*y(k,201) +rxt(k,321)*y(k,197) +rxt(k,349)*y(k,198) + & + rxt(k,358)*y(k,231))*y(k,90) + (rxt(k,8) + & + 2.000_r8*rxt(k,158)*y(k,224) +2.000_r8*rxt(k,167)*y(k,134) + & + rxt(k,178)*y(k,76) +rxt(k,183)*y(k,228) +rxt(k,196)*y(k,125) + & + rxt(k,204)*y(k,124) +rxt(k,220)*y(k,56) +rxt(k,252)*y(k,17) + & + rxt(k,508)*y(k,150) +rxt(k,514)*y(k,152))*y(k,136) & + + (rxt(k,160)*y(k,225) +rxt(k,168)*y(k,134) +rxt(k,182)*y(k,228) + & + rxt(k,195)*y(k,125) +rxt(k,200)*y(k,126) +rxt(k,231)*y(k,59) + & + rxt(k,261)*y(k,19))*y(k,134) + (rxt(k,222)*y(k,59) + & + rxt(k,223)*y(k,59) +rxt(k,233)*y(k,228) +rxt(k,255)*y(k,19) + & + rxt(k,256)*y(k,19))*y(k,59) + (rxt(k,151) +rxt(k,159) + & + 2.000_r8*rxt(k,161)*y(k,135))*y(k,225) +rxt(k,253)*y(k,19)*y(k,19) & + +rxt(k,187)*y(k,228)*y(k,91) +rxt(k,193)*y(k,125)*y(k,112) & + +rxt(k,207)*y(k,224)*y(k,113) +rxt(k,590)*y(k,227)*y(k,124) & + +rxt(k,19)*y(k,126) +rxt(k,152)*y(k,226) + loss(k,235) = (rxt(k,480)* y(k,6) +rxt(k,252)* y(k,17) +rxt(k,318)* y(k,25) & + +rxt(k,347)* y(k,29) +rxt(k,220)* y(k,56) +rxt(k,178)* y(k,76) & + +rxt(k,177)* y(k,90) +rxt(k,425)* y(k,99) +rxt(k,378)* y(k,105) & + +rxt(k,483)* y(k,110) +rxt(k,392)* y(k,111) +rxt(k,204)* y(k,124) & + +rxt(k,196)* y(k,125) +rxt(k,167)* y(k,134) +rxt(k,463)* y(k,143) & + +rxt(k,508)* y(k,150) +rxt(k,514)* y(k,152) +rxt(k,158)* y(k,224) & + +rxt(k,183)* y(k,228) + rxt(k,7) + rxt(k,8) + het_rates(k,136)) & + * y(k,136) + prod(k,235) = (.150_r8*rxt(k,332)*y(k,200) +.150_r8*rxt(k,383)*y(k,215)) & + *y(k,90) +rxt(k,169)*y(k,135)*y(k,134) + loss(k,21) = ( + het_rates(k,137))* y(k,137) + prod(k,21) = 0._r8 + loss(k,109) = (rxt(k,515)* y(k,152) + rxt(k,108) + het_rates(k,138)) & + * y(k,138) + prod(k,109) = (rxt(k,224)*y(k,59) +rxt(k,254)*y(k,19))*y(k,59) + loss(k,114) = (rxt(k,504)* y(k,134) +rxt(k,505)* y(k,228) + rxt(k,137) & + + het_rates(k,139))* y(k,139) + prod(k,114) = 0._r8 + loss(k,87) = ( + rxt(k,60) + rxt(k,532) + het_rates(k,140))* y(k,140) + prod(k,87) =rxt(k,371)*y(k,228)*y(k,94) +.100_r8*rxt(k,492)*y(k,233)*y(k,124) + loss(k,141) = (rxt(k,342)* y(k,228) + rxt(k,61) + rxt(k,345) & + + het_rates(k,141))* y(k,141) + prod(k,141) =rxt(k,344)*y(k,200)*y(k,125) + loss(k,66) = ( + rxt(k,470) + het_rates(k,142))* y(k,142) + prod(k,66) =rxt(k,465)*y(k,191)*y(k,125) + loss(k,131) = (rxt(k,462)* y(k,125) +rxt(k,463)* y(k,136) + het_rates(k,143)) & + * y(k,143) + prod(k,131) = (.070_r8*rxt(k,449)*y(k,66) +.060_r8*rxt(k,461)*y(k,144) + & + .070_r8*rxt(k,477)*y(k,187))*y(k,228) +rxt(k,32)*y(k,32) & + +rxt(k,447)*y(k,199)*y(k,124) + loss(k,73) = (rxt(k,461)* y(k,228) + het_rates(k,144))* y(k,144) + prod(k,73) =.530_r8*rxt(k,438)*y(k,228)*y(k,7) + loss(k,110) = (rxt(k,464)* y(k,228) + rxt(k,62) + het_rates(k,145))* y(k,145) + prod(k,110) =rxt(k,459)*y(k,230)*y(k,90) + loss(k,22) = ( + het_rates(k,146))* y(k,146) + prod(k,22) = 0._r8 + loss(k,23) = ( + het_rates(k,147))* y(k,147) + prod(k,23) = 0._r8 + loss(k,142) = (rxt(k,360)* y(k,228) + rxt(k,63) + het_rates(k,148))* y(k,148) + prod(k,142) =rxt(k,358)*y(k,231)*y(k,90) + loss(k,119) = (rxt(k,364)* y(k,228) + rxt(k,64) + het_rates(k,149))* y(k,149) + prod(k,119) =.850_r8*rxt(k,362)*y(k,232)*y(k,90) + loss(k,163) = (rxt(k,506)* y(k,135) +rxt(k,508)* y(k,136) +rxt(k,511) & + * y(k,228) + het_rates(k,150))* y(k,150) + prod(k,163) =rxt(k,137)*y(k,139) +rxt(k,138)*y(k,152) + loss(k,24) = ( + rxt(k,109) + het_rates(k,151))* y(k,151) + prod(k,24) = 0._r8 + loss(k,219) = (rxt(k,509)* y(k,19) +rxt(k,510)* y(k,59) +rxt(k,512)* y(k,125) & + +rxt(k,513)* y(k,135) +rxt(k,514)* y(k,136) +rxt(k,515)* y(k,138) & + +rxt(k,516)* y(k,228) + rxt(k,138) + het_rates(k,152))* y(k,152) + prod(k,219) = (rxt(k,506)*y(k,135) +rxt(k,508)*y(k,136) +rxt(k,511)*y(k,228)) & + *y(k,150) +rxt(k,504)*y(k,139)*y(k,134) +rxt(k,139)*y(k,153) + loss(k,186) = (rxt(k,507)* y(k,228) + rxt(k,139) + het_rates(k,153)) & + * y(k,153) + prod(k,186) = (rxt(k,509)*y(k,19) +rxt(k,510)*y(k,59) +rxt(k,512)*y(k,125) + & + rxt(k,513)*y(k,135) +rxt(k,514)*y(k,136) +rxt(k,515)*y(k,138) + & + rxt(k,516)*y(k,228))*y(k,152) + (rxt(k,502)*y(k,126) + & + rxt(k,503)*y(k,228) +.500_r8*rxt(k,517)*y(k,228))*y(k,67) & + +rxt(k,505)*y(k,228)*y(k,139) +rxt(k,140)*y(k,154) + loss(k,94) = (rxt(k,518)* y(k,241) + rxt(k,140) + het_rates(k,154))* y(k,154) + prod(k,94) =rxt(k,136)*y(k,80) +rxt(k,507)*y(k,228)*y(k,153) + loss(k,25) = ( + het_rates(k,155))* y(k,155) + prod(k,25) = 0._r8 + loss(k,26) = ( + het_rates(k,156))* y(k,156) + prod(k,26) = 0._r8 + loss(k,27) = ( + het_rates(k,157))* y(k,157) + prod(k,27) = 0._r8 + loss(k,28) = ( + het_rates(k,158))* y(k,158) + prod(k,28) = 0._r8 + loss(k,29) = ( + rxt(k,141) + het_rates(k,159))* y(k,159) + prod(k,29) = 0._r8 + loss(k,30) = ( + rxt(k,142) + het_rates(k,160))* y(k,160) + prod(k,30) = 0._r8 + loss(k,31) = ( + rxt(k,143) + het_rates(k,161))* y(k,161) + prod(k,31) = 0._r8 + loss(k,32) = ( + rxt(k,144) + het_rates(k,162))* y(k,162) + prod(k,32) = 0._r8 + loss(k,33) = ( + rxt(k,145) + het_rates(k,163))* y(k,163) + prod(k,33) = 0._r8 + loss(k,34) = ( + rxt(k,146) + het_rates(k,164))* y(k,164) + prod(k,34) = 0._r8 + loss(k,35) = ( + rxt(k,147) + het_rates(k,165))* y(k,165) + prod(k,35) = 0._r8 + loss(k,36) = ( + rxt(k,148) + het_rates(k,166))* y(k,166) + prod(k,36) = 0._r8 + loss(k,37) = ( + rxt(k,149) + het_rates(k,167))* y(k,167) + prod(k,37) = 0._r8 + loss(k,38) = ( + rxt(k,150) + het_rates(k,168))* y(k,168) + prod(k,38) = 0._r8 + loss(k,39) = ( + het_rates(k,169))* y(k,169) + prod(k,39) = (.2202005_r8*rxt(k,535)*y(k,193) + & + .0023005_r8*rxt(k,540)*y(k,195) +.0031005_r8*rxt(k,543)*y(k,211) + & + .2381005_r8*rxt(k,547)*y(k,212) +.0508005_r8*rxt(k,551)*y(k,218) + & + .1364005_r8*rxt(k,557)*y(k,236) +.1677005_r8*rxt(k,560)*y(k,239)) & + *y(k,90) + (.1279005_r8*rxt(k,536)*y(k,193) + & + .0097005_r8*rxt(k,541)*y(k,195) +.0003005_r8*rxt(k,544)*y(k,211) + & + .1056005_r8*rxt(k,548)*y(k,212) +.0245005_r8*rxt(k,552)*y(k,218) + & + .0154005_r8*rxt(k,558)*y(k,236) +.0063005_r8*rxt(k,561)*y(k,239)) & + *y(k,124) + (.2202005_r8*rxt(k,537)*y(k,6) + & + .0508005_r8*rxt(k,553)*y(k,110))*y(k,136) +rxt(k,520)*y(k,75) & + +.5931005_r8*rxt(k,555)*y(k,228)*y(k,175) + loss(k,40) = ( + het_rates(k,170))* y(k,170) + prod(k,40) = (.2067005_r8*rxt(k,535)*y(k,193) + & + .0008005_r8*rxt(k,540)*y(k,195) +.0035005_r8*rxt(k,543)*y(k,211) + & + .1308005_r8*rxt(k,547)*y(k,212) +.1149005_r8*rxt(k,551)*y(k,218) + & + .0101005_r8*rxt(k,557)*y(k,236) +.0174005_r8*rxt(k,560)*y(k,239)) & + *y(k,90) + (.1792005_r8*rxt(k,536)*y(k,193) + & + .0034005_r8*rxt(k,541)*y(k,195) +.0003005_r8*rxt(k,544)*y(k,211) + & + .1026005_r8*rxt(k,548)*y(k,212) +.0082005_r8*rxt(k,552)*y(k,218) + & + .0452005_r8*rxt(k,558)*y(k,236) +.0237005_r8*rxt(k,561)*y(k,239)) & + *y(k,124) + (.2067005_r8*rxt(k,537)*y(k,6) + & + .1149005_r8*rxt(k,553)*y(k,110))*y(k,136) & + +.1534005_r8*rxt(k,555)*y(k,228)*y(k,175) + loss(k,41) = ( + het_rates(k,171))* y(k,171) + prod(k,41) = (.0653005_r8*rxt(k,535)*y(k,193) + & + .0843005_r8*rxt(k,540)*y(k,195) +.0003005_r8*rxt(k,543)*y(k,211) + & + .0348005_r8*rxt(k,547)*y(k,212) +.0348005_r8*rxt(k,551)*y(k,218) + & + .0763005_r8*rxt(k,557)*y(k,236) +.086_r8*rxt(k,560)*y(k,239))*y(k,90) & + + (.0676005_r8*rxt(k,536)*y(k,193) + & + .1579005_r8*rxt(k,541)*y(k,195) +.0073005_r8*rxt(k,544)*y(k,211) + & + .0521005_r8*rxt(k,548)*y(k,212) +.0772005_r8*rxt(k,552)*y(k,218) + & + .0966005_r8*rxt(k,558)*y(k,236) +.0025005_r8*rxt(k,561)*y(k,239)) & + *y(k,124) + (.0653005_r8*rxt(k,537)*y(k,6) + & + .0348005_r8*rxt(k,553)*y(k,110))*y(k,136) & + +.0459005_r8*rxt(k,555)*y(k,228)*y(k,175) + loss(k,42) = ( + het_rates(k,172))* y(k,172) + prod(k,42) = (.1284005_r8*rxt(k,535)*y(k,193) + & + .0443005_r8*rxt(k,540)*y(k,195) +.0271005_r8*rxt(k,543)*y(k,211) + & + .0076005_r8*rxt(k,547)*y(k,212) +.0554005_r8*rxt(k,551)*y(k,218) + & + .2157005_r8*rxt(k,557)*y(k,236) +.0512005_r8*rxt(k,560)*y(k,239)) & + *y(k,90) + (.079_r8*rxt(k,536)*y(k,193) + & + .0059005_r8*rxt(k,541)*y(k,195) +.0057005_r8*rxt(k,544)*y(k,211) + & + .0143005_r8*rxt(k,548)*y(k,212) +.0332005_r8*rxt(k,552)*y(k,218) + & + .0073005_r8*rxt(k,558)*y(k,236) +.011_r8*rxt(k,561)*y(k,239)) & + *y(k,124) + (.1749305_r8*rxt(k,534)*y(k,6) + & + .0590245_r8*rxt(k,542)*y(k,99) +.1749305_r8*rxt(k,550)*y(k,110)) & + *y(k,126) + (.1284005_r8*rxt(k,537)*y(k,6) + & + .0033005_r8*rxt(k,545)*y(k,99) +.0554005_r8*rxt(k,553)*y(k,110)) & + *y(k,136) +.0085005_r8*rxt(k,555)*y(k,228)*y(k,175) + loss(k,43) = ( + het_rates(k,173))* y(k,173) + prod(k,43) = (.114_r8*rxt(k,535)*y(k,193) +.1621005_r8*rxt(k,540)*y(k,195) + & + .0474005_r8*rxt(k,543)*y(k,211) +.0113005_r8*rxt(k,547)*y(k,212) + & + .1278005_r8*rxt(k,551)*y(k,218) +.0738005_r8*rxt(k,557)*y(k,236) + & + .1598005_r8*rxt(k,560)*y(k,239))*y(k,90) & + + (.1254005_r8*rxt(k,536)*y(k,193) + & + .0536005_r8*rxt(k,541)*y(k,195) +.0623005_r8*rxt(k,544)*y(k,211) + & + .0166005_r8*rxt(k,548)*y(k,212) +.130_r8*rxt(k,552)*y(k,218) + & + .238_r8*rxt(k,558)*y(k,236) +.1185005_r8*rxt(k,561)*y(k,239)) & + *y(k,124) + (.5901905_r8*rxt(k,534)*y(k,6) + & + .0250245_r8*rxt(k,542)*y(k,99) +.5901905_r8*rxt(k,550)*y(k,110)) & + *y(k,126) + (.114_r8*rxt(k,537)*y(k,6) + & + .1278005_r8*rxt(k,553)*y(k,110))*y(k,136) & + +.0128005_r8*rxt(k,555)*y(k,228)*y(k,175) + loss(k,44) = ( + rxt(k,597) + het_rates(k,174))* y(k,174) + prod(k,44) = 0._r8 + loss(k,45) = (rxt(k,555)* y(k,228) + het_rates(k,175))* y(k,175) + prod(k,45) = 0._r8 + loss(k,80) = ( + rxt(k,65) + het_rates(k,176))* y(k,176) + prod(k,80) = (.100_r8*rxt(k,469)*y(k,183) +.230_r8*rxt(k,471)*y(k,185)) & + *y(k,228) + loss(k,156) = (rxt(k,493)* y(k,228) + rxt(k,66) + het_rates(k,177))* y(k,177) + prod(k,156) =rxt(k,491)*y(k,233)*y(k,90) + loss(k,153) = (rxt(k,494)* y(k,228) + rxt(k,67) + rxt(k,533) & + + het_rates(k,178))* y(k,178) + prod(k,153) = (.200_r8*rxt(k,487)*y(k,223) +.200_r8*rxt(k,497)*y(k,234)) & + *y(k,124) +.500_r8*rxt(k,485)*y(k,223)*y(k,201) + loss(k,134) = (rxt(k,498)* y(k,228) + rxt(k,68) + het_rates(k,179))* y(k,179) + prod(k,134) =rxt(k,496)*y(k,234)*y(k,90) + loss(k,194) = (rxt(k,499)* y(k,126) +rxt(k,500)* y(k,228) + rxt(k,69) & + + het_rates(k,180))* y(k,180) + prod(k,194) = (.500_r8*rxt(k,485)*y(k,201) +.800_r8*rxt(k,487)*y(k,124) + & + rxt(k,488)*y(k,126))*y(k,223) + (.330_r8*rxt(k,480)*y(k,6) + & + .330_r8*rxt(k,483)*y(k,110))*y(k,136) + (rxt(k,67) + & + rxt(k,494)*y(k,228))*y(k,178) + (rxt(k,495)*y(k,201) + & + .800_r8*rxt(k,497)*y(k,124))*y(k,234) +rxt(k,59)*y(k,128) +rxt(k,68) & + *y(k,179) + loss(k,198) = (rxt(k,501)* y(k,228) + rxt(k,70) + het_rates(k,181))* y(k,181) + prod(k,198) = (.300_r8*rxt(k,480)*y(k,6) +.300_r8*rxt(k,483)*y(k,110)) & + *y(k,136) + (rxt(k,490)*y(k,201) +.900_r8*rxt(k,492)*y(k,124)) & + *y(k,233) +rxt(k,66)*y(k,177) +rxt(k,69)*y(k,180) + loss(k,157) = (rxt(k,468)* y(k,228) + rxt(k,71) + het_rates(k,182))* y(k,182) + prod(k,157) =rxt(k,466)*y(k,235)*y(k,90) + loss(k,78) = (rxt(k,469)* y(k,228) + het_rates(k,183))* y(k,183) + prod(k,78) = 0._r8 + loss(k,81) = (rxt(k,435)* y(k,228) + rxt(k,72) + het_rates(k,184))* y(k,184) + prod(k,81) =rxt(k,432)*y(k,237)*y(k,90) + loss(k,82) = (rxt(k,471)* y(k,228) + het_rates(k,185))* y(k,185) + prod(k,82) = 0._r8 + loss(k,164) = (rxt(k,474)* y(k,228) + rxt(k,73) + het_rates(k,186))* y(k,186) + prod(k,164) =rxt(k,472)*y(k,238)*y(k,90) + loss(k,83) = (rxt(k,477)* y(k,228) + het_rates(k,187))* y(k,187) + prod(k,83) =.150_r8*rxt(k,471)*y(k,228)*y(k,185) + loss(k,123) = (rxt(k,478)* y(k,228) + rxt(k,74) + het_rates(k,188))* y(k,188) + prod(k,123) =rxt(k,475)*y(k,240)*y(k,90) + loss(k,139) = (rxt(k,436)* y(k,90) +rxt(k,437)* y(k,124) +rxt(k,465) & + * y(k,125) + het_rates(k,191))* y(k,191) + prod(k,139) =rxt(k,442)*y(k,228)*y(k,22) +rxt(k,470)*y(k,142) + loss(k,191) = (rxt(k,397)* y(k,90) + (rxt(k,398) +rxt(k,399))* y(k,124) & + + het_rates(k,192))* y(k,192) + prod(k,191) = (rxt(k,400)*y(k,2) +rxt(k,401)*y(k,15))*y(k,228) + loss(k,46) = (rxt(k,535)* y(k,90) +rxt(k,536)* y(k,124) + het_rates(k,193)) & + * y(k,193) + prod(k,46) =rxt(k,538)*y(k,228)*y(k,6) + loss(k,135) = (rxt(k,439)* y(k,90) +rxt(k,440)* y(k,124) + het_rates(k,194)) & + * y(k,194) + prod(k,135) = (.350_r8*rxt(k,438)*y(k,7) +rxt(k,441)*y(k,8))*y(k,228) + loss(k,47) = (rxt(k,540)* y(k,90) +rxt(k,541)* y(k,124) + het_rates(k,195)) & + * y(k,195) + prod(k,47) =rxt(k,539)*y(k,228)*y(k,7) + loss(k,125) = (rxt(k,443)* y(k,90) +rxt(k,445)* y(k,124) + het_rates(k,196)) & + * y(k,196) + prod(k,125) = (rxt(k,444)*y(k,23) +.070_r8*rxt(k,469)*y(k,183) + & + .060_r8*rxt(k,471)*y(k,185))*y(k,228) + loss(k,181) = (rxt(k,321)* y(k,90) +rxt(k,322)* y(k,124) + 2._r8*rxt(k,319) & + * y(k,197) +rxt(k,320)* y(k,201) + het_rates(k,197))* y(k,197) + prod(k,181) = (rxt(k,325)*y(k,56) +rxt(k,326)*y(k,228))*y(k,28) & + +.500_r8*rxt(k,324)*y(k,228)*y(k,27) +rxt(k,53)*y(k,107) + loss(k,185) = (rxt(k,349)* y(k,90) +rxt(k,350)* y(k,124) +rxt(k,348) & + * y(k,201) + het_rates(k,198))* y(k,198) + prod(k,185) = (rxt(k,352)*y(k,228) +rxt(k,355)*y(k,56))*y(k,31) & + +rxt(k,351)*y(k,228)*y(k,30) + loss(k,154) = (rxt(k,446)* y(k,90) +rxt(k,447)* y(k,124) + het_rates(k,199)) & + * y(k,199) + prod(k,154) = (.400_r8*rxt(k,436)*y(k,90) +rxt(k,437)*y(k,124))*y(k,191) & + +rxt(k,448)*y(k,228)*y(k,32) +rxt(k,463)*y(k,143)*y(k,136) + loss(k,216) = (rxt(k,332)* y(k,90) +rxt(k,333)* y(k,124) +rxt(k,344) & + * y(k,125) + 2._r8*rxt(k,330)* y(k,200) +rxt(k,331)* y(k,201) & + +rxt(k,405)* y(k,208) +rxt(k,410)* y(k,209) +rxt(k,419)* y(k,210) & + +rxt(k,372)* y(k,213) +rxt(k,430)* y(k,237) + het_rates(k,200)) & + * y(k,200) + prod(k,216) = (.100_r8*rxt(k,378)*y(k,105) +.280_r8*rxt(k,392)*y(k,111) + & + .080_r8*rxt(k,425)*y(k,99) +.060_r8*rxt(k,480)*y(k,6) + & + .060_r8*rxt(k,483)*y(k,110))*y(k,136) + (rxt(k,382)*y(k,201) + & + .450_r8*rxt(k,383)*y(k,90) +2.000_r8*rxt(k,384)*y(k,215) + & + rxt(k,385)*y(k,124) +rxt(k,386)*y(k,126))*y(k,215) & + + (.530_r8*rxt(k,372)*y(k,200) +.260_r8*rxt(k,373)*y(k,201) + & + .530_r8*rxt(k,375)*y(k,126) +.530_r8*rxt(k,376)*y(k,124))*y(k,213) & + + (rxt(k,328)*y(k,45) +.500_r8*rxt(k,335)*y(k,51) + & + rxt(k,354)*y(k,49) +.650_r8*rxt(k,501)*y(k,181))*y(k,228) & + + (.300_r8*rxt(k,361)*y(k,201) +.150_r8*rxt(k,362)*y(k,90) + & + rxt(k,363)*y(k,124))*y(k,232) + (rxt(k,37) +rxt(k,353)*y(k,126)) & + *y(k,49) + (.600_r8*rxt(k,61) +rxt(k,345))*y(k,141) & + + (.200_r8*rxt(k,387)*y(k,90) +rxt(k,388)*y(k,124))*y(k,217) & + +.130_r8*rxt(k,24)*y(k,10) +rxt(k,28)*y(k,14) +rxt(k,327)*y(k,126) & + *y(k,45) +rxt(k,36)*y(k,48) +.330_r8*rxt(k,46)*y(k,94) +rxt(k,48) & + *y(k,96) +1.340_r8*rxt(k,51)*y(k,105) +rxt(k,53)*y(k,107) +rxt(k,54) & + *y(k,108) +.300_r8*rxt(k,56)*y(k,111) +rxt(k,58)*y(k,127) +rxt(k,64) & + *y(k,149) +.500_r8*rxt(k,65)*y(k,176) +.650_r8*rxt(k,70)*y(k,181) + loss(k,238) = (rxt(k,221)* y(k,59) +rxt(k,300)* y(k,90) +rxt(k,301)* y(k,124) & + +rxt(k,320)* y(k,197) +rxt(k,348)* y(k,198) +rxt(k,331)* y(k,200) & + + 2._r8*(rxt(k,298) +rxt(k,299))* y(k,201) +rxt(k,406)* y(k,208) & + +rxt(k,411)* y(k,209) +rxt(k,420)* y(k,210) +rxt(k,373)* y(k,213) & + +rxt(k,382)* y(k,215) +rxt(k,485)* y(k,223) +rxt(k,361)* y(k,232) & + +rxt(k,490)* y(k,233) +rxt(k,495)* y(k,234) +rxt(k,431)* y(k,237) & + + het_rates(k,201))* y(k,201) + prod(k,238) = (2.000_r8*rxt(k,330)*y(k,200) +.900_r8*rxt(k,331)*y(k,201) + & + .450_r8*rxt(k,332)*y(k,90) +rxt(k,333)*y(k,124) + & + rxt(k,372)*y(k,213) +rxt(k,381)*y(k,215) +rxt(k,405)*y(k,208) + & + rxt(k,410)*y(k,209) +rxt(k,419)*y(k,210) +rxt(k,430)*y(k,237)) & + *y(k,200) + (rxt(k,41) +rxt(k,215)*y(k,56) +rxt(k,271)*y(k,73) + & + rxt(k,304)*y(k,228) +rxt(k,310)*y(k,224))*y(k,54) & + + (.330_r8*rxt(k,450)*y(k,202) +.070_r8*rxt(k,456)*y(k,216))*y(k,90) & + + (.830_r8*rxt(k,451)*y(k,202) +.170_r8*rxt(k,457)*y(k,216)) & + *y(k,124) + (.280_r8*rxt(k,347)*y(k,29) +.050_r8*rxt(k,425)*y(k,99)) & + *y(k,136) + (.700_r8*rxt(k,303)*y(k,53) +rxt(k,334)*y(k,50))*y(k,228) & + +rxt(k,88)*y(k,43) +rxt(k,35)*y(k,45) +rxt(k,90)*y(k,46) +rxt(k,36) & + *y(k,48) +rxt(k,38)*y(k,51) +.300_r8*rxt(k,56)*y(k,111) & + +.400_r8*rxt(k,61)*y(k,141) + loss(k,168) = (rxt(k,450)* y(k,90) +rxt(k,451)* y(k,124) +rxt(k,452) & + * y(k,125) + het_rates(k,202))* y(k,202) + prod(k,168) =.600_r8*rxt(k,26)*y(k,12) + loss(k,178) = (rxt(k,581)* y(k,220) +rxt(k,579)* y(k,221) +rxt(k,580) & + * y(k,227) + het_rates(k,203))* y(k,203) + prod(k,178) = (rxt(k,126) +rxt(k,127) +rxt(k,128) +rxt(k,129) +rxt(k,130) + & + rxt(k,131) +rxt(k,132) +rxt(k,133))*y(k,135) + (rxt(k,120) + & + rxt(k,121) +rxt(k,122) +rxt(k,123) +rxt(k,124) +rxt(k,125))*y(k,134) & + +rxt(k,111)*y(k,112) +rxt(k,16)*y(k,124) + loss(k,146) = ((rxt(k,369) +rxt(k,370))* y(k,124) + het_rates(k,204)) & + * y(k,204) + prod(k,146) =rxt(k,368)*y(k,228)*y(k,16) + loss(k,129) = (rxt(k,339)* y(k,135) + rxt(k,338) + het_rates(k,205)) & + * y(k,205) + prod(k,129) =rxt(k,43)*y(k,72) +.750_r8*rxt(k,337)*y(k,206)*y(k,124) + loss(k,170) = (rxt(k,336)* y(k,90) +rxt(k,337)* y(k,124) + het_rates(k,206)) & + * y(k,206) + prod(k,170) =rxt(k,343)*y(k,228)*y(k,25) + loss(k,126) = (rxt(k,307)* y(k,90) +rxt(k,309)* y(k,124) + rxt(k,308) & + + het_rates(k,207))* y(k,207) + prod(k,126) =rxt(k,294)*y(k,90)*y(k,42) + loss(k,211) = (rxt(k,407)* y(k,90) +rxt(k,408)* y(k,124) +rxt(k,409) & + * y(k,126) +rxt(k,405)* y(k,200) +rxt(k,406)* y(k,201) & + + het_rates(k,208))* y(k,208) + prod(k,211) =.600_r8*rxt(k,426)*y(k,228)*y(k,99) + loss(k,212) = (rxt(k,412)* y(k,90) +rxt(k,414)* y(k,124) +rxt(k,415) & + * y(k,126) +rxt(k,410)* y(k,200) +rxt(k,411)* y(k,201) + rxt(k,413) & + + het_rates(k,209))* y(k,209) + prod(k,212) =.400_r8*rxt(k,426)*y(k,228)*y(k,99) + loss(k,208) = (rxt(k,421)* y(k,90) +rxt(k,422)* y(k,124) +rxt(k,423) & + * y(k,126) +rxt(k,419)* y(k,200) +rxt(k,420)* y(k,201) & + + het_rates(k,210))* y(k,210) + prod(k,208) =rxt(k,418)*y(k,126)*y(k,99) + loss(k,48) = (rxt(k,543)* y(k,90) +rxt(k,544)* y(k,124) + het_rates(k,211)) & + * y(k,211) + prod(k,48) =rxt(k,546)*y(k,228)*y(k,99) + loss(k,49) = (rxt(k,547)* y(k,90) +rxt(k,548)* y(k,124) + het_rates(k,212)) & + * y(k,212) + prod(k,49) =rxt(k,549)*y(k,228)*y(k,104) + loss(k,213) = (rxt(k,374)* y(k,90) + (rxt(k,376) +rxt(k,377))* y(k,124) & + +rxt(k,375)* y(k,126) +rxt(k,372)* y(k,200) +rxt(k,373)* y(k,201) & + + het_rates(k,213))* y(k,213) + prod(k,213) = (.500_r8*rxt(k,379)*y(k,105) +.200_r8*rxt(k,380)*y(k,106) + & + rxt(k,393)*y(k,111))*y(k,228) + loss(k,165) = (rxt(k,453)* y(k,90) +rxt(k,454)* y(k,124) +rxt(k,455) & + * y(k,125) + het_rates(k,214))* y(k,214) + prod(k,165) =.600_r8*rxt(k,25)*y(k,11) + loss(k,215) = (rxt(k,383)* y(k,90) +rxt(k,385)* y(k,124) +rxt(k,394) & + * y(k,125) +rxt(k,386)* y(k,126) +rxt(k,381)* y(k,200) +rxt(k,382) & + * y(k,201) + 2._r8*rxt(k,384)* y(k,215) + het_rates(k,215))* y(k,215) + prod(k,215) = (.660_r8*rxt(k,51) +.500_r8*rxt(k,379)*y(k,228))*y(k,105) & + + (rxt(k,55) +rxt(k,395))*y(k,109) +.500_r8*rxt(k,380)*y(k,228) & + *y(k,106) + loss(k,182) = (rxt(k,456)* y(k,90) +rxt(k,457)* y(k,124) +rxt(k,458) & + * y(k,125) + het_rates(k,216))* y(k,216) + prod(k,182) =.600_r8*rxt(k,27)*y(k,13) + loss(k,160) = (rxt(k,387)* y(k,90) +rxt(k,388)* y(k,124) + het_rates(k,217)) & + * y(k,217) + prod(k,160) = (rxt(k,389)*y(k,107) +rxt(k,390)*y(k,108))*y(k,228) + loss(k,51) = (rxt(k,551)* y(k,90) +rxt(k,552)* y(k,124) + het_rates(k,218)) & + * y(k,218) + prod(k,51) =rxt(k,554)*y(k,228)*y(k,110) + loss(k,140) = (rxt(k,188)* y(k,134) +rxt(k,189)* y(k,135) + het_rates(k,219)) & + * y(k,219) + prod(k,140) = (.800_r8*rxt(k,579)*y(k,221) +.900_r8*rxt(k,581)*y(k,220)) & + *y(k,203) +rxt(k,583)*y(k,220)*y(k,134) + loss(k,158) = ((rxt(k,583) +rxt(k,584))* y(k,134) +rxt(k,582)* y(k,135) & + +rxt(k,581)* y(k,203) + het_rates(k,220))* y(k,220) + prod(k,158) = 0._r8 + loss(k,176) = (rxt(k,579)* y(k,203) + het_rates(k,221))* y(k,221) + prod(k,176) = (rxt(k,589) +rxt(k,588)*y(k,112) +rxt(k,590)*y(k,124))*y(k,227) & + +rxt(k,16)*y(k,124) +rxt(k,583)*y(k,220)*y(k,134) & + +rxt(k,587)*y(k,222)*y(k,135) +rxt(k,592)*y(k,229) + loss(k,136) = (rxt(k,585)* y(k,134) + (rxt(k,586) +rxt(k,587))* y(k,135) & + + het_rates(k,222))* y(k,222) + prod(k,136) =rxt(k,111)*y(k,112) + loss(k,197) = (rxt(k,486)* y(k,90) +rxt(k,487)* y(k,124) +rxt(k,488) & + * y(k,126) +rxt(k,485)* y(k,201) + het_rates(k,223))* y(k,223) + prod(k,197) = (rxt(k,479)*y(k,6) +rxt(k,482)*y(k,110) + & + .500_r8*rxt(k,499)*y(k,180))*y(k,126) +rxt(k,489)*y(k,228)*y(k,128) + loss(k,230) = (rxt(k,239)* y(k,33) +rxt(k,240)* y(k,34) +rxt(k,266)* y(k,35) & + +rxt(k,241)* y(k,36) +rxt(k,242)* y(k,37) +rxt(k,243)* y(k,38) & + +rxt(k,244)* y(k,39) +rxt(k,245)* y(k,40) +rxt(k,289)* y(k,41) & + +rxt(k,290)* y(k,43) + (rxt(k,310) +rxt(k,311) +rxt(k,312))* y(k,54) & + +rxt(k,267)* y(k,55) +rxt(k,275)* y(k,64) +rxt(k,276)* y(k,65) & + +rxt(k,153)* y(k,77) +rxt(k,268)* y(k,78) + (rxt(k,269) +rxt(k,270)) & + * y(k,81) +rxt(k,291)* y(k,82) +rxt(k,292)* y(k,83) +rxt(k,293) & + * y(k,84) + (rxt(k,246) +rxt(k,247))* y(k,85) +rxt(k,313)* y(k,86) & + + (rxt(k,206) +rxt(k,207))* y(k,113) + (rxt(k,156) +rxt(k,157)) & + * y(k,135) +rxt(k,158)* y(k,136) +rxt(k,154)* y(k,241) + rxt(k,155) & + + het_rates(k,224))* y(k,224) + prod(k,230) = (rxt(k,6) +rxt(k,189)*y(k,219))*y(k,135) +rxt(k,12)*y(k,113) & + +rxt(k,7)*y(k,136) +.850_r8*rxt(k,580)*y(k,227)*y(k,203) +rxt(k,1) & + *y(k,241) + loss(k,75) = (rxt(k,160)* y(k,134) +rxt(k,161)* y(k,135) + rxt(k,151) & + + rxt(k,159) + het_rates(k,225))* y(k,225) + prod(k,75) = (rxt(k,163) +rxt(k,162)*y(k,63) +rxt(k,164)*y(k,134) + & + rxt(k,165)*y(k,135) +rxt(k,166)*y(k,136))*y(k,226) +rxt(k,7)*y(k,136) + loss(k,76) = (rxt(k,162)* y(k,63) +rxt(k,164)* y(k,134) +rxt(k,165)* y(k,135) & + +rxt(k,166)* y(k,136) + rxt(k,152) + rxt(k,163) + het_rates(k,226)) & + * y(k,226) + prod(k,76) =rxt(k,156)*y(k,224)*y(k,135) + loss(k,177) = (rxt(k,588)* y(k,112) +rxt(k,590)* y(k,124) +rxt(k,580) & + * y(k,203) + rxt(k,589) + het_rates(k,227))* y(k,227) + prod(k,177) = (rxt(k,126) +rxt(k,130) +rxt(k,582)*y(k,220) + & + rxt(k,586)*y(k,222) +rxt(k,593)*y(k,229))*y(k,135) & + +rxt(k,591)*y(k,229)*y(k,63) + loss(k,226) = (rxt(k,396)* y(k,1) +rxt(k,400)* y(k,2) +rxt(k,481)* y(k,6) & + +rxt(k,438)* y(k,7) +rxt(k,441)* y(k,8) +rxt(k,401)* y(k,15) & + +rxt(k,368)* y(k,16) +rxt(k,262)* y(k,19) +rxt(k,442)* y(k,22) & + +rxt(k,444)* y(k,23) +rxt(k,316)* y(k,24) +rxt(k,343)* y(k,25) & + +rxt(k,323)* y(k,26) +rxt(k,324)* y(k,27) +rxt(k,326)* y(k,28) & + +rxt(k,365)* y(k,29) +rxt(k,351)* y(k,30) +rxt(k,352)* y(k,31) & + +rxt(k,448)* y(k,32) +rxt(k,278)* y(k,41) +rxt(k,297)* y(k,42) & + +rxt(k,280)* y(k,43) +rxt(k,281)* y(k,44) +rxt(k,328)* y(k,45) & + +rxt(k,283)* y(k,46) +rxt(k,329)* y(k,47) +rxt(k,366)* y(k,48) & + +rxt(k,354)* y(k,49) +rxt(k,334)* y(k,50) +rxt(k,335)* y(k,51) & + +rxt(k,302)* y(k,52) +rxt(k,303)* y(k,53) +rxt(k,304)* y(k,54) & + +rxt(k,285)* y(k,55) + (rxt(k,232) +rxt(k,233))* y(k,59) +rxt(k,230) & + * y(k,60) +rxt(k,314)* y(k,62) +rxt(k,449)* y(k,66) + (rxt(k,503) + & + rxt(k,517))* y(k,67) +rxt(k,340)* y(k,74) +rxt(k,341)* y(k,75) & + +rxt(k,179)* y(k,77) +rxt(k,180)* y(k,79) +rxt(k,264)* y(k,81) & + +rxt(k,286)* y(k,82) +rxt(k,287)* y(k,83) +rxt(k,288)* y(k,84) & + +rxt(k,235)* y(k,85) +rxt(k,305)* y(k,86) +rxt(k,306)* y(k,87) & + +rxt(k,211)* y(k,89) +rxt(k,181)* y(k,90) +rxt(k,187)* y(k,91) & + +rxt(k,238)* y(k,93) +rxt(k,371)* y(k,94) +rxt(k,402)* y(k,95) & + +rxt(k,356)* y(k,96) +rxt(k,403)* y(k,97) +rxt(k,404)* y(k,98) & + +rxt(k,426)* y(k,99) +rxt(k,416)* y(k,100) +rxt(k,417)* y(k,101) & + +rxt(k,424)* y(k,102) +rxt(k,427)* y(k,103) +rxt(k,379)* y(k,105) & + +rxt(k,380)* y(k,106) +rxt(k,389)* y(k,107) +rxt(k,390)* y(k,108) & + +rxt(k,391)* y(k,109) +rxt(k,484)* y(k,110) +rxt(k,393)* y(k,111) & + +rxt(k,202)* y(k,112) +rxt(k,428)* y(k,115) +rxt(k,429)* y(k,116) & + +rxt(k,519)* y(k,120) +rxt(k,210)* y(k,125) +rxt(k,201)* y(k,126) & + +rxt(k,357)* y(k,127) +rxt(k,489)* y(k,128) +rxt(k,182)* y(k,134) & + +rxt(k,183)* y(k,136) +rxt(k,505)* y(k,139) +rxt(k,342)* y(k,141) & + +rxt(k,461)* y(k,144) +rxt(k,464)* y(k,145) +rxt(k,360)* y(k,148) & + +rxt(k,364)* y(k,149) +rxt(k,511)* y(k,150) +rxt(k,516)* y(k,152) & + +rxt(k,507)* y(k,153) +rxt(k,493)* y(k,177) +rxt(k,494)* y(k,178) & + +rxt(k,498)* y(k,179) +rxt(k,500)* y(k,180) +rxt(k,501)* y(k,181) & + +rxt(k,468)* y(k,182) +rxt(k,469)* y(k,183) +rxt(k,435)* y(k,184) & + +rxt(k,471)* y(k,185) +rxt(k,474)* y(k,186) +rxt(k,477)* y(k,187) & + +rxt(k,478)* y(k,188) + 2._r8*(rxt(k,184) +rxt(k,185))* y(k,228) & + + het_rates(k,228))* y(k,228) + prod(k,226) = (2.000_r8*rxt(k,173)*y(k,76) +rxt(k,176)*y(k,134) + & + rxt(k,177)*y(k,136) +rxt(k,198)*y(k,126) +rxt(k,203)*y(k,124) + & + rxt(k,219)*y(k,56) +.450_r8*rxt(k,332)*y(k,200) + & + .150_r8*rxt(k,362)*y(k,232) +.450_r8*rxt(k,383)*y(k,215) + & + .200_r8*rxt(k,387)*y(k,217) +.400_r8*rxt(k,436)*y(k,191) + & + .400_r8*rxt(k,450)*y(k,202) +.400_r8*rxt(k,456)*y(k,216))*y(k,90) & + + (rxt(k,178)*y(k,76) +.130_r8*rxt(k,318)*y(k,25) + & + .360_r8*rxt(k,347)*y(k,29) +.240_r8*rxt(k,378)*y(k,105) + & + .360_r8*rxt(k,392)*y(k,111) +.320_r8*rxt(k,425)*y(k,99) + & + .630_r8*rxt(k,480)*y(k,6) +.630_r8*rxt(k,483)*y(k,110))*y(k,136) & + + (rxt(k,170)*y(k,77) +rxt(k,171)*y(k,79) +rxt(k,234)*y(k,85) + & + rxt(k,237)*y(k,93) +rxt(k,263)*y(k,81) +rxt(k,265)*y(k,92) + & + rxt(k,296)*y(k,42))*y(k,134) + (.300_r8*rxt(k,303)*y(k,53) + & + .650_r8*rxt(k,316)*y(k,24) +.500_r8*rxt(k,324)*y(k,27) + & + .500_r8*rxt(k,360)*y(k,148) +.100_r8*rxt(k,380)*y(k,106) + & + .600_r8*rxt(k,427)*y(k,103) +.500_r8*rxt(k,435)*y(k,184))*y(k,228) & + + (rxt(k,153)*y(k,77) +2.000_r8*rxt(k,154)*y(k,241) + & + rxt(k,246)*y(k,85) +rxt(k,269)*y(k,81) +rxt(k,310)*y(k,54) + & + rxt(k,313)*y(k,86))*y(k,224) + (rxt(k,3) +rxt(k,273)*y(k,73)) & + *y(k,241) +rxt(k,21)*y(k,2) +rxt(k,22)*y(k,8) +rxt(k,29)*y(k,23) & + +rxt(k,30)*y(k,27) +rxt(k,31)*y(k,30) +rxt(k,32)*y(k,32) +rxt(k,38) & + *y(k,51) +rxt(k,39)*y(k,53) +.330_r8*rxt(k,40)*y(k,54) +rxt(k,43) & + *y(k,72) +2.000_r8*rxt(k,4)*y(k,79) +rxt(k,9)*y(k,89) +rxt(k,10) & + *y(k,91) +rxt(k,106)*y(k,92) +rxt(k,107)*y(k,93) +rxt(k,47)*y(k,95) & + +rxt(k,50)*y(k,103) +rxt(k,54)*y(k,108) +.500_r8*rxt(k,529)*y(k,125) & + +rxt(k,59)*y(k,128) +rxt(k,62)*y(k,145) +rxt(k,63)*y(k,148) & + +rxt(k,64)*y(k,149) +rxt(k,66)*y(k,177) +rxt(k,68)*y(k,179) & + +rxt(k,71)*y(k,182) +rxt(k,72)*y(k,184) +rxt(k,73)*y(k,186) & + +rxt(k,74)*y(k,188) + loss(k,171) = (rxt(k,591)* y(k,63) +rxt(k,593)* y(k,135) + rxt(k,592) & + + het_rates(k,229))* y(k,229) + prod(k,171) = (rxt(k,120) +rxt(k,121) +rxt(k,122) +rxt(k,123) +rxt(k,124) + & + rxt(k,125) +rxt(k,584)*y(k,220) +rxt(k,585)*y(k,222))*y(k,134) & + + (rxt(k,127) +rxt(k,128) +rxt(k,129) +rxt(k,131) +rxt(k,132) + & + rxt(k,133))*y(k,135) + loss(k,127) = (rxt(k,459)* y(k,90) +rxt(k,460)* y(k,124) + het_rates(k,230)) & + * y(k,230) + prod(k,127) = (.200_r8*rxt(k,449)*y(k,66) +.140_r8*rxt(k,461)*y(k,144) + & + rxt(k,464)*y(k,145))*y(k,228) + loss(k,172) = (rxt(k,358)* y(k,90) +rxt(k,359)* y(k,124) + het_rates(k,231)) & + * y(k,231) + prod(k,172) = (.500_r8*rxt(k,360)*y(k,148) +rxt(k,365)*y(k,29))*y(k,228) + loss(k,206) = (rxt(k,362)* y(k,90) +rxt(k,363)* y(k,124) +rxt(k,361) & + * y(k,201) + het_rates(k,232))* y(k,232) + prod(k,206) = (rxt(k,364)*y(k,149) +rxt(k,366)*y(k,48) + & + .150_r8*rxt(k,501)*y(k,181))*y(k,228) + (.060_r8*rxt(k,480)*y(k,6) + & + .060_r8*rxt(k,483)*y(k,110))*y(k,136) +.150_r8*rxt(k,70)*y(k,181) + loss(k,203) = (rxt(k,491)* y(k,90) +rxt(k,492)* y(k,124) +rxt(k,490) & + * y(k,201) + het_rates(k,233))* y(k,233) + prod(k,203) = (.500_r8*rxt(k,499)*y(k,126) +rxt(k,500)*y(k,228))*y(k,180) & + +rxt(k,493)*y(k,228)*y(k,177) + loss(k,193) = (rxt(k,496)* y(k,90) +rxt(k,497)* y(k,124) +rxt(k,495) & + * y(k,201) + het_rates(k,234))* y(k,234) + prod(k,193) = (rxt(k,481)*y(k,6) +rxt(k,484)*y(k,110) +rxt(k,498)*y(k,179)) & + *y(k,228) + loss(k,166) = (rxt(k,466)* y(k,90) +rxt(k,467)* y(k,124) + het_rates(k,235)) & + * y(k,235) + prod(k,166) = (rxt(k,468)*y(k,182) +.650_r8*rxt(k,469)*y(k,183))*y(k,228) + loss(k,52) = (rxt(k,557)* y(k,90) +rxt(k,558)* y(k,124) + het_rates(k,236)) & + * y(k,236) + prod(k,52) =rxt(k,556)*y(k,228)*y(k,183) + loss(k,207) = (rxt(k,432)* y(k,90) +rxt(k,433)* y(k,124) +rxt(k,434) & + * y(k,126) +rxt(k,430)* y(k,200) +rxt(k,431)* y(k,201) & + + het_rates(k,237))* y(k,237) + prod(k,207) = (rxt(k,402)*y(k,95) +rxt(k,403)*y(k,97) +rxt(k,404)*y(k,98) + & + .400_r8*rxt(k,427)*y(k,103) +.500_r8*rxt(k,435)*y(k,184))*y(k,228) + loss(k,167) = (rxt(k,472)* y(k,90) +rxt(k,473)* y(k,124) + het_rates(k,238)) & + * y(k,238) + prod(k,167) = (.560_r8*rxt(k,471)*y(k,185) +rxt(k,474)*y(k,186))*y(k,228) + loss(k,53) = (rxt(k,560)* y(k,90) +rxt(k,561)* y(k,124) + het_rates(k,239)) & + * y(k,239) + prod(k,53) =rxt(k,559)*y(k,228)*y(k,185) + loss(k,137) = (rxt(k,475)* y(k,90) +rxt(k,476)* y(k,124) + het_rates(k,240)) & + * y(k,240) + prod(k,137) = (.300_r8*rxt(k,477)*y(k,187) +rxt(k,478)*y(k,188))*y(k,228) + loss(k,239) = (rxt(k,273)* y(k,73) +rxt(k,518)* y(k,154) +rxt(k,154) & + * y(k,224) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,241)) & + * y(k,241) + prod(k,239) = (rxt(k,179)*y(k,77) +rxt(k,180)*y(k,79) +rxt(k,181)*y(k,90) + & + rxt(k,184)*y(k,228) +rxt(k,187)*y(k,91) +rxt(k,211)*y(k,89) + & + rxt(k,235)*y(k,85) +rxt(k,238)*y(k,93) +rxt(k,264)*y(k,81) + & + rxt(k,278)*y(k,41) +rxt(k,280)*y(k,43) +rxt(k,281)*y(k,44) + & + rxt(k,283)*y(k,46) +rxt(k,288)*y(k,84) +rxt(k,297)*y(k,42) + & + rxt(k,303)*y(k,53) +rxt(k,304)*y(k,54) +rxt(k,306)*y(k,87) + & + rxt(k,326)*y(k,28) +rxt(k,328)*y(k,45) +rxt(k,334)*y(k,50) + & + rxt(k,335)*y(k,51) +rxt(k,351)*y(k,30) +rxt(k,352)*y(k,31) + & + rxt(k,354)*y(k,49) +rxt(k,360)*y(k,148) +rxt(k,364)*y(k,149) + & + rxt(k,366)*y(k,48) +.500_r8*rxt(k,379)*y(k,105) +rxt(k,519)*y(k,120)) & + *y(k,228) + (rxt(k,563)*y(k,93) +rxt(k,569)*y(k,93) + & + rxt(k,570)*y(k,92) +rxt(k,574)*y(k,93) +rxt(k,575)*y(k,92))*y(k,85) & + + (rxt(k,521) +rxt(k,174)*y(k,76))*y(k,90) +.050_r8*rxt(k,40) & + *y(k,54) +rxt(k,136)*y(k,80) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..cc0712e018 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/mo_rxt_rates_conv.F90 @@ -0,0 +1,609 @@ +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,:, 241) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 241) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 241) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 79) ! rate_const*H2O2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 135) ! rate_const*O2 + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 135) ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 136) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 136) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 89) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 91) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 91) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 113) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 124) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 124) ! rate_const*NO + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 125) ! rate_const*NO2 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 126) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 126) ! rate_const*NO3 + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 1) ! rate_const*ALKNIT + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 2) ! rate_const*ALKOOH + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 8) ! rate_const*BENZOOH + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 9) ! rate_const*BEPOMUC + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 10) ! rate_const*BIGALD + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 11) ! rate_const*BIGALD1 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 12) ! rate_const*BIGALD2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 13) ! rate_const*BIGALD3 + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 14) ! rate_const*BIGALD4 + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 23) ! rate_const*BZOOH + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 27) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 30) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 32) ! rate_const*C6H5OOH + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 42) ! rate_const*CH2O + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 42) ! rate_const*CH2O + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 45) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 48) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 49) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 51) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 53) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 54) ! rate_const*CH4 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 54) ! rate_const*CH4 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 63) ! rate_const*CO2 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 72) ! rate_const*EOOH + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 74) ! rate_const*GLYALD + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 75) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 94) ! rate_const*HONITR + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 95) ! rate_const*HPALD + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 96) ! rate_const*HYAC + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 102) ! rate_const*ISOPNOOH + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 103) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 105) ! rate_const*MACR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 105) ! rate_const*MACR + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 107) ! rate_const*MEK + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 108) ! rate_const*MEKOOH + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 109) ! rate_const*MPAN + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 111) ! rate_const*MVK + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 116) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 127) ! rate_const*NOA + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 128) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 140) ! rate_const*ONITR + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 141) ! rate_const*PAN + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 145) ! rate_const*PHENOOH + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 148) ! rate_const*POOH + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 149) ! rate_const*ROOH + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 176) ! rate_const*TEPOMUC + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 177) ! rate_const*TERP2OOH + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 178) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 179) ! rate_const*TERPOOH + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 180) ! rate_const*TERPROD1 + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 181) ! rate_const*TERPROD2 + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 182) ! rate_const*TOLOOH + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 184) ! rate_const*XOOH + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 186) ! rate_const*XYLENOOH + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 188) ! rate_const*XYLOLOOH + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 18) ! rate_const*BRCL + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 19) ! rate_const*BRO + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 33) ! rate_const*CCL4 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 34) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 35) ! rate_const*CF3BR + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 36) ! rate_const*CFC11 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 37) ! rate_const*CFC113 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 38) ! rate_const*CFC114 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 39) ! rate_const*CFC115 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 40) ! rate_const*CFC12 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 41) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 43) ! rate_const*CH3BR + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 44) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 46) ! rate_const*CH3CL + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 55) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 57) ! rate_const*CL2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 58) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 59) ! rate_const*CLO + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 64) ! rate_const*COF2 + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 65) ! rate_const*COFCL + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 78) ! rate_const*H2402 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 81) ! rate_const*HBR + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 82) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 83) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 84) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 85) ! rate_const*HCL + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 88) ! rate_const*HF + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 92) ! rate_const*HOBR + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 93) ! rate_const*HOCL + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 138) ! rate_const*OCLO + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 151) ! rate_const*SF6 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 63) ! rate_const*CO2 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 112) ! rate_const*N + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 134) ! rate_const*O + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 134) ! rate_const*O + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 134) ! rate_const*O + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 134) ! rate_const*O + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 134) ! rate_const*O + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 134) ! rate_const*O + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 135) ! rate_const*O2 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 135) ! rate_const*O2 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 135) ! rate_const*O2 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 135) ! rate_const*O2 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 135) ! rate_const*O2 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 135) ! rate_const*O2 + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 135) ! rate_const*O2 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 135) ! rate_const*O2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 135) ! rate_const*O2 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 135) ! rate_const*O2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 80) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 139) ! rate_const*OCS + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 152) ! rate_const*SO + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 153) ! rate_const*SO2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 154) ! rate_const*SO3 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 159) ! rate_const*soa1_a1 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 160) ! rate_const*soa1_a2 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 161) ! rate_const*soa2_a1 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 162) ! rate_const*soa2_a2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 163) ! rate_const*soa3_a1 + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 164) ! rate_const*soa3_a2 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 165) ! rate_const*soa4_a1 + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 166) ! rate_const*soa4_a2 + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 167) ! rate_const*soa5_a1 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 168) ! rate_const*soa5_a2 + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 225) ! rate_const*O2_1D + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 226) ! rate_const*O2_1S + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 224)*sol(:ncol,:, 77) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 224)*sol(:ncol,:, 241) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 224) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 224)*sol(:ncol,:, 135) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 224)*sol(:ncol,:, 135) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 224)*sol(:ncol,:, 136) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 225) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 225)*sol(:ncol,:, 134) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 225)*sol(:ncol,:, 135) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 226)*sol(:ncol,:, 63) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 226) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 226)*sol(:ncol,:, 134) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 226)*sol(:ncol,:, 135) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 226)*sol(:ncol,:, 136) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 134)*sol(:ncol,:, 136) ! rate_const*O*O3 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 134)*sol(:ncol,:, 134) ! rate_const*M*O*O + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 134)*sol(:ncol,:, 135) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 77)*sol(:ncol,:, 134) ! rate_const*H2*O + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 79)*sol(:ncol,:, 134) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 76)*sol(:ncol,:, 90) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 76)*sol(:ncol,:, 90) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 76)*sol(:ncol,:, 90) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 76)*sol(:ncol,:, 135) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 90)*sol(:ncol,:, 134) ! rate_const*HO2*O + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 90)*sol(:ncol,:, 136) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 76)*sol(:ncol,:, 136) ! rate_const*H*O3 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 228)*sol(:ncol,:, 77) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 228)*sol(:ncol,:, 79) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 228)*sol(:ncol,:, 90) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 228)*sol(:ncol,:, 134) ! rate_const*OH*O + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 228)*sol(:ncol,:, 136) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 228)*sol(:ncol,:, 228) ! rate_const*OH*OH + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 228)*sol(:ncol,:, 228) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 90)*sol(:ncol,:, 90) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 91)*sol(:ncol,:, 228) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 219)*sol(:ncol,:, 134) ! rate_const*N2D*O + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 219)*sol(:ncol,:, 135) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 112)*sol(:ncol,:, 124) ! rate_const*N*NO + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 112)*sol(:ncol,:, 125) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 112)*sol(:ncol,:, 135) ! rate_const*N*O2 + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 125)*sol(:ncol,:, 134) ! rate_const*NO2*O + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 125)*sol(:ncol,:, 136) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 125)*sol(:ncol,:, 134) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 126)*sol(:ncol,:, 90) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 126)*sol(:ncol,:, 124) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 126)*sol(:ncol,:, 134) ! rate_const*NO3*O + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 126)*sol(:ncol,:, 228) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 112)*sol(:ncol,:, 228) ! rate_const*N*OH + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 124)*sol(:ncol,:, 90) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 124)*sol(:ncol,:, 136) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 124)*sol(:ncol,:, 134) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 224)*sol(:ncol,:, 113) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 224)*sol(:ncol,:, 113) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 125)*sol(:ncol,:, 90) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 125)*sol(:ncol,:, 126) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 125)*sol(:ncol,:, 228) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 89)*sol(:ncol,:, 228) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 91) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 114) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 56)*sol(:ncol,:, 42) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 56)*sol(:ncol,:, 54) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 56)*sol(:ncol,:, 77) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 56)*sol(:ncol,:, 79) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 56)*sol(:ncol,:, 90) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 56)*sol(:ncol,:, 90) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 56)*sol(:ncol,:, 136) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 59)*sol(:ncol,:, 201) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 59)*sol(:ncol,:, 90) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 59)*sol(:ncol,:, 124) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 60)*sol(:ncol,:, 56) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 59)*sol(:ncol,:, 125) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 60)*sol(:ncol,:, 134) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 60)*sol(:ncol,:, 228) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 59)*sol(:ncol,:, 134) ! rate_const*CLO*O + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 59)*sol(:ncol,:, 228) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 59)*sol(:ncol,:, 228) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 85)*sol(:ncol,:, 134) ! rate_const*HCL*O + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 85)*sol(:ncol,:, 228) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 93)*sol(:ncol,:, 56) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 93)*sol(:ncol,:, 134) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 93)*sol(:ncol,:, 228) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 224)*sol(:ncol,:, 33) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 224)*sol(:ncol,:, 34) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 224)*sol(:ncol,:, 36) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 224)*sol(:ncol,:, 37) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 224)*sol(:ncol,:, 38) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 224)*sol(:ncol,:, 39) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 224)*sol(:ncol,:, 40) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 224)*sol(:ncol,:, 85) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 224)*sol(:ncol,:, 85) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 59)*sol(:ncol,:, 59) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 58) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 17)*sol(:ncol,:, 42) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 17)*sol(:ncol,:, 90) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 17)*sol(:ncol,:, 136) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 19)*sol(:ncol,:, 19) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 19)*sol(:ncol,:, 59) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 19)*sol(:ncol,:, 90) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 19)*sol(:ncol,:, 124) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 19)*sol(:ncol,:, 125) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 20)*sol(:ncol,:, 134) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 19)*sol(:ncol,:, 134) ! rate_const*BRO*O + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 19)*sol(:ncol,:, 228) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 81)*sol(:ncol,:, 134) ! rate_const*HBR*O + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 81)*sol(:ncol,:, 228) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 92)*sol(:ncol,:, 134) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 224)*sol(:ncol,:, 35) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 224)*sol(:ncol,:, 55) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 224)*sol(:ncol,:, 78) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 224)*sol(:ncol,:, 81) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 224)*sol(:ncol,:, 81) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 73)*sol(:ncol,:, 54) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 73)*sol(:ncol,:, 77) ! rate_const*F*H2 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 73)*sol(:ncol,:, 241) ! rate_const*F*H2O + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 73)*sol(:ncol,:, 89) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 224)*sol(:ncol,:, 64) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 224)*sol(:ncol,:, 65) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 41)*sol(:ncol,:, 56) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 41)*sol(:ncol,:, 228) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 43)*sol(:ncol,:, 56) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 43)*sol(:ncol,:, 228) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 44)*sol(:ncol,:, 228) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 46)*sol(:ncol,:, 56) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 46)*sol(:ncol,:, 228) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 55)*sol(:ncol,:, 56) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 55)*sol(:ncol,:, 228) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 82)*sol(:ncol,:, 228) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 83)*sol(:ncol,:, 228) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 84)*sol(:ncol,:, 228) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 224)*sol(:ncol,:, 41) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 224)*sol(:ncol,:, 43) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 224)*sol(:ncol,:, 82) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 224)*sol(:ncol,:, 83) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 224)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 42)*sol(:ncol,:, 90) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 42)*sol(:ncol,:, 126) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 42)*sol(:ncol,:, 134) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 42)*sol(:ncol,:, 228) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 201)*sol(:ncol,:, 201) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 201)*sol(:ncol,:, 201) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 201)*sol(:ncol,:, 90) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 201)*sol(:ncol,:, 124) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 52)*sol(:ncol,:, 228) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 53)*sol(:ncol,:, 228) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 54)*sol(:ncol,:, 228) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 86)*sol(:ncol,:, 228) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 87)*sol(:ncol,:, 228) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 207)*sol(:ncol,:, 90) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 207) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 207)*sol(:ncol,:, 124) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 224)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 224)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 224)*sol(:ncol,:, 54) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 224)*sol(:ncol,:, 86) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 62)*sol(:ncol,:, 228) ! rate_const*CO*OH + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 24)*sol(:ncol,:, 56) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 24)*sol(:ncol,:, 228) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 25)*sol(:ncol,:, 56) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 25)*sol(:ncol,:, 136) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 197)*sol(:ncol,:, 197) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 197)*sol(:ncol,:, 201) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 197)*sol(:ncol,:, 90) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 197)*sol(:ncol,:, 124) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 26)*sol(:ncol,:, 228) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 27)*sol(:ncol,:, 228) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 28)*sol(:ncol,:, 56) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 28)*sol(:ncol,:, 228) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 45)*sol(:ncol,:, 126) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 45)*sol(:ncol,:, 228) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 47)*sol(:ncol,:, 228) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 200)*sol(:ncol,:, 200) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 200)*sol(:ncol,:, 201) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 200)*sol(:ncol,:, 90) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 200)*sol(:ncol,:, 124) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 50)*sol(:ncol,:, 228) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 51)*sol(:ncol,:, 228) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 206)*sol(:ncol,:, 90) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 206)*sol(:ncol,:, 124) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 205) ! rate_const*EO + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 205)*sol(:ncol,:, 135) ! rate_const*EO*O2 + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 74)*sol(:ncol,:, 228) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 75)*sol(:ncol,:, 228) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 141)*sol(:ncol,:, 228) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 25)*sol(:ncol,:, 228) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 200)*sol(:ncol,:, 125) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 141) ! rate_const*M*PAN + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 29)*sol(:ncol,:, 126) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 29)*sol(:ncol,:, 136) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 198)*sol(:ncol,:, 201) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 198)*sol(:ncol,:, 90) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 198)*sol(:ncol,:, 124) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 30)*sol(:ncol,:, 228) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 31)*sol(:ncol,:, 228) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 49)*sol(:ncol,:, 126) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 49)*sol(:ncol,:, 228) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 56)*sol(:ncol,:, 31) ! rate_const*CL*C3H8 + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 96)*sol(:ncol,:, 228) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 127)*sol(:ncol,:, 228) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 231)*sol(:ncol,:, 90) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 231)*sol(:ncol,:, 124) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 148)*sol(:ncol,:, 228) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 232)*sol(:ncol,:, 201) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 232)*sol(:ncol,:, 90) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 232)*sol(:ncol,:, 124) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 149)*sol(:ncol,:, 228) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 29)*sol(:ncol,:, 228) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 48)*sol(:ncol,:, 228) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 16)*sol(:ncol,:, 126) ! rate_const*BIGENE*NO3 + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 16)*sol(:ncol,:, 228) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 204)*sol(:ncol,:, 124) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 204)*sol(:ncol,:, 124) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 94)*sol(:ncol,:, 228) ! rate_const*HONITR*OH + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 213)*sol(:ncol,:, 200) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 213)*sol(:ncol,:, 201) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 213)*sol(:ncol,:, 90) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 213)*sol(:ncol,:, 126) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 213)*sol(:ncol,:, 124) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 213)*sol(:ncol,:, 124) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 105)*sol(:ncol,:, 136) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 105)*sol(:ncol,:, 228) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 106)*sol(:ncol,:, 228) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 215)*sol(:ncol,:, 200) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 215)*sol(:ncol,:, 201) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 215)*sol(:ncol,:, 90) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 215)*sol(:ncol,:, 215) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 215)*sol(:ncol,:, 124) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 215)*sol(:ncol,:, 126) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 217)*sol(:ncol,:, 90) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 217)*sol(:ncol,:, 124) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 107)*sol(:ncol,:, 228) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 108)*sol(:ncol,:, 228) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 109)*sol(:ncol,:, 228) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 111)*sol(:ncol,:, 136) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 111)*sol(:ncol,:, 228) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 215)*sol(:ncol,:, 125) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 109) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 1)*sol(:ncol,:, 228) ! rate_const*ALKNIT*OH + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 192)*sol(:ncol,:, 90) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 192)*sol(:ncol,:, 124) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 192)*sol(:ncol,:, 124) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 2)*sol(:ncol,:, 228) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 15)*sol(:ncol,:, 228) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 95)*sol(:ncol,:, 228) ! rate_const*HPALD*OH + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 97)*sol(:ncol,:, 228) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 98)*sol(:ncol,:, 228) ! rate_const*IEPOX*OH + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 208)*sol(:ncol,:, 200) ! rate_const*ISOPAO2*CH3CO3 + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 208)*sol(:ncol,:, 201) ! rate_const*ISOPAO2*CH3O2 + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 208)*sol(:ncol,:, 90) ! rate_const*ISOPAO2*HO2 + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 208)*sol(:ncol,:, 124) ! rate_const*ISOPAO2*NO + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 208)*sol(:ncol,:, 126) ! rate_const*ISOPAO2*NO3 + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 209)*sol(:ncol,:, 200) ! rate_const*ISOPBO2*CH3CO3 + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 209)*sol(:ncol,:, 201) ! rate_const*ISOPBO2*CH3O2 + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 209)*sol(:ncol,:, 90) ! rate_const*ISOPBO2*HO2 + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 209) ! rate_const*ISOPBO2 + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 209)*sol(:ncol,:, 124) ! rate_const*ISOPBO2*NO + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 209)*sol(:ncol,:, 126) ! rate_const*ISOPBO2*NO3 + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 100)*sol(:ncol,:, 228) ! rate_const*ISOPNITA*OH + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 101)*sol(:ncol,:, 228) ! rate_const*ISOPNITB*OH + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 99)*sol(:ncol,:, 126) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 210)*sol(:ncol,:, 200) ! rate_const*ISOPNO3*CH3CO3 + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 210)*sol(:ncol,:, 201) ! rate_const*ISOPNO3*CH3O2 + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 210)*sol(:ncol,:, 90) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 210)*sol(:ncol,:, 124) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 210)*sol(:ncol,:, 126) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 102)*sol(:ncol,:, 228) ! rate_const*ISOPNOOH*OH + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 99)*sol(:ncol,:, 136) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 99)*sol(:ncol,:, 228) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 103)*sol(:ncol,:, 228) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 115)*sol(:ncol,:, 228) ! rate_const*NC4CH2OH*OH + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 116)*sol(:ncol,:, 228) ! rate_const*NC4CHO*OH + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 237)*sol(:ncol,:, 200) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 237)*sol(:ncol,:, 201) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 237)*sol(:ncol,:, 90) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 237)*sol(:ncol,:, 124) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 237)*sol(:ncol,:, 126) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 184)*sol(:ncol,:, 228) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 191)*sol(:ncol,:, 90) ! rate_const*ACBZO2*HO2 + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 191)*sol(:ncol,:, 124) ! rate_const*ACBZO2*NO + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 7)*sol(:ncol,:, 228) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 194)*sol(:ncol,:, 90) ! rate_const*BENZO2*HO2 + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 194)*sol(:ncol,:, 124) ! rate_const*BENZO2*NO + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 8)*sol(:ncol,:, 228) ! rate_const*BENZOOH*OH + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 22)*sol(:ncol,:, 228) ! rate_const*BZALD*OH + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 196)*sol(:ncol,:, 90) ! rate_const*BZOO*HO2 + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 23)*sol(:ncol,:, 228) ! rate_const*BZOOH*OH + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 196)*sol(:ncol,:, 124) ! rate_const*BZOO*NO + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 199)*sol(:ncol,:, 90) ! rate_const*C6H5O2*HO2 + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 199)*sol(:ncol,:, 124) ! rate_const*C6H5O2*NO + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 32)*sol(:ncol,:, 228) ! rate_const*C6H5OOH*OH + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 66)*sol(:ncol,:, 228) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 202)*sol(:ncol,:, 90) ! rate_const*DICARBO2*HO2 + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 202)*sol(:ncol,:, 124) ! rate_const*DICARBO2*NO + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 202)*sol(:ncol,:, 125) ! rate_const*M*DICARBO2*NO2 + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 214)*sol(:ncol,:, 90) ! rate_const*MALO2*HO2 + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 214)*sol(:ncol,:, 124) ! rate_const*MALO2*NO + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 214)*sol(:ncol,:, 125) ! rate_const*M*MALO2*NO2 + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 216)*sol(:ncol,:, 90) ! rate_const*MDIALO2*HO2 + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 216)*sol(:ncol,:, 124) ! rate_const*MDIALO2*NO + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 216)*sol(:ncol,:, 125) ! rate_const*M*MDIALO2*NO2 + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 230)*sol(:ncol,:, 90) ! rate_const*PHENO2*HO2 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 230)*sol(:ncol,:, 124) ! rate_const*PHENO2*NO + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 144)*sol(:ncol,:, 228) ! rate_const*PHENOL*OH + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 143)*sol(:ncol,:, 125) ! rate_const*PHENO*NO2 + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 143)*sol(:ncol,:, 136) ! rate_const*PHENO*O3 + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 145)*sol(:ncol,:, 228) ! rate_const*PHENOOH*OH + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 191)*sol(:ncol,:, 125) ! rate_const*M*ACBZO2*NO2 + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 235)*sol(:ncol,:, 90) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 235)*sol(:ncol,:, 124) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 182)*sol(:ncol,:, 228) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 183)*sol(:ncol,:, 228) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 142) ! rate_const*M*PBZNIT + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 185)*sol(:ncol,:, 228) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 238)*sol(:ncol,:, 90) ! rate_const*XYLENO2*HO2 + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 238)*sol(:ncol,:, 124) ! rate_const*XYLENO2*NO + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 186)*sol(:ncol,:, 228) ! rate_const*XYLENOOH*OH + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 240)*sol(:ncol,:, 90) ! rate_const*XYLOLO2*HO2 + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 240)*sol(:ncol,:, 124) ! rate_const*XYLOLO2*NO + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 187)*sol(:ncol,:, 228) ! rate_const*XYLOL*OH + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 188)*sol(:ncol,:, 228) ! rate_const*XYLOLOOH*OH + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 6)*sol(:ncol,:, 126) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 6)*sol(:ncol,:, 136) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 6)*sol(:ncol,:, 228) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 110)*sol(:ncol,:, 126) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 110)*sol(:ncol,:, 136) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 110)*sol(:ncol,:, 228) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 223)*sol(:ncol,:, 201) ! rate_const*NTERPO2*CH3O2 + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 223)*sol(:ncol,:, 90) ! rate_const*NTERPO2*HO2 + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 223)*sol(:ncol,:, 124) ! rate_const*NTERPO2*NO + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 223)*sol(:ncol,:, 126) ! rate_const*NTERPO2*NO3 + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 128)*sol(:ncol,:, 228) ! rate_const*NTERPOOH*OH + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 233)*sol(:ncol,:, 201) ! rate_const*TERP2O2*CH3O2 + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 233)*sol(:ncol,:, 90) ! rate_const*TERP2O2*HO2 + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 233)*sol(:ncol,:, 124) ! rate_const*TERP2O2*NO + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 177)*sol(:ncol,:, 228) ! rate_const*TERP2OOH*OH + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 178)*sol(:ncol,:, 228) ! rate_const*TERPNIT*OH + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 234)*sol(:ncol,:, 201) ! rate_const*TERPO2*CH3O2 + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 234)*sol(:ncol,:, 90) ! rate_const*TERPO2*HO2 + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 234)*sol(:ncol,:, 124) ! rate_const*TERPO2*NO + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 179)*sol(:ncol,:, 228) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 180)*sol(:ncol,:, 126) ! rate_const*TERPROD1*NO3 + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 180)*sol(:ncol,:, 228) ! rate_const*TERPROD1*OH + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 181)*sol(:ncol,:, 228) ! rate_const*TERPROD2*OH + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 67)*sol(:ncol,:, 126) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 67)*sol(:ncol,:, 228) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 139)*sol(:ncol,:, 134) ! rate_const*OCS*O + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 139)*sol(:ncol,:, 228) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 150)*sol(:ncol,:, 135) ! rate_const*S*O2 + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 153)*sol(:ncol,:, 228) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 150)*sol(:ncol,:, 136) ! rate_const*S*O3 + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 152)*sol(:ncol,:, 19) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 152)*sol(:ncol,:, 59) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 150)*sol(:ncol,:, 228) ! rate_const*S*OH + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 152)*sol(:ncol,:, 125) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 152)*sol(:ncol,:, 135) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 152)*sol(:ncol,:, 136) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 152)*sol(:ncol,:, 138) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 152)*sol(:ncol,:, 228) ! rate_const*SO*OH + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 67)*sol(:ncol,:, 228) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 154)*sol(:ncol,:, 241) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 120)*sol(:ncol,:, 228) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 75) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 90) ! rate_const*HO2 + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 94) ! rate_const*HONITR + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 100) ! rate_const*ISOPNITA + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 101) ! rate_const*ISOPNITB + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 115) ! rate_const*NC4CH2OH + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 116) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 121) ! rate_const*NH4 + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 125) ! rate_const*NO2 + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 126) ! rate_const*NO3 + rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 128) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 140) ! rate_const*ONITR + rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 178) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 6)*sol(:ncol,:, 126) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 193)*sol(:ncol,:, 90) ! rate_const*BCARYO2VBS*HO2 + rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 193)*sol(:ncol,:, 124) ! rate_const*BCARYO2VBS*NO + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 6)*sol(:ncol,:, 136) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 6)*sol(:ncol,:, 228) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 7)*sol(:ncol,:, 228) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 195)*sol(:ncol,:, 90) ! rate_const*BENZO2VBS*HO2 + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 195)*sol(:ncol,:, 124) ! rate_const*BENZO2VBS*NO + rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 99)*sol(:ncol,:, 126) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 211)*sol(:ncol,:, 90) ! rate_const*ISOPO2VBS*HO2 + rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 211)*sol(:ncol,:, 124) ! rate_const*ISOPO2VBS*NO + rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 99)*sol(:ncol,:, 136) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 99)*sol(:ncol,:, 228) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 212)*sol(:ncol,:, 90) ! rate_const*IVOCO2VBS*HO2 + rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 212)*sol(:ncol,:, 124) ! rate_const*IVOCO2VBS*NO + rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 104)*sol(:ncol,:, 228) ! rate_const*IVOC*OH + rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 110)*sol(:ncol,:, 126) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 218)*sol(:ncol,:, 90) ! rate_const*MTERPO2VBS*HO2 + rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 218)*sol(:ncol,:, 124) ! rate_const*MTERPO2VBS*NO + rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 110)*sol(:ncol,:, 136) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 110)*sol(:ncol,:, 228) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 175)*sol(:ncol,:, 228) ! rate_const*SVOC*OH + rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 183)*sol(:ncol,:, 228) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 236)*sol(:ncol,:, 90) ! rate_const*TOLUO2VBS*HO2 + rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 236)*sol(:ncol,:, 124) ! rate_const*TOLUO2VBS*NO + rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 185)*sol(:ncol,:, 228) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 239)*sol(:ncol,:, 90) ! rate_const*XYLEO2VBS*HO2 + rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 239)*sol(:ncol,:, 124) ! rate_const*XYLEO2VBS*NO + rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 93)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 93)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 20) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 93)*sol(:ncol,:, 85) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 92)*sol(:ncol,:, 85) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 114) ! rate_const*N2O5 + rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 60) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 60)*sol(:ncol,:, 85) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 221)*sol(:ncol,:, 203) ! rate_const*NOp*e + rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 227)*sol(:ncol,:, 203) ! rate_const*O2p*e + rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 220)*sol(:ncol,:, 203) ! rate_const*N2p*e + rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 220)*sol(:ncol,:, 135) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 220)*sol(:ncol,:, 134) ! rate_const*N2p*O + rxt_rates(:ncol,:, 584) = rxt_rates(:ncol,:, 584)*sol(:ncol,:, 220)*sol(:ncol,:, 134) ! rate_const*N2p*O + rxt_rates(:ncol,:, 585) = rxt_rates(:ncol,:, 585)*sol(:ncol,:, 222)*sol(:ncol,:, 134) ! rate_const*Np*O + rxt_rates(:ncol,:, 586) = rxt_rates(:ncol,:, 586)*sol(:ncol,:, 222)*sol(:ncol,:, 135) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 587) = rxt_rates(:ncol,:, 587)*sol(:ncol,:, 222)*sol(:ncol,:, 135) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 588) = rxt_rates(:ncol,:, 588)*sol(:ncol,:, 227)*sol(:ncol,:, 112) ! rate_const*O2p*N + rxt_rates(:ncol,:, 589) = rxt_rates(:ncol,:, 589)*sol(:ncol,:, 227) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 590) = rxt_rates(:ncol,:, 590)*sol(:ncol,:, 227)*sol(:ncol,:, 124) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 591) = rxt_rates(:ncol,:, 591)*sol(:ncol,:, 229)*sol(:ncol,:, 63) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 592) = rxt_rates(:ncol,:, 592)*sol(:ncol,:, 229) ! rate_const*N2*Op + rxt_rates(:ncol,:, 593) = rxt_rates(:ncol,:, 593)*sol(:ncol,:, 229)*sol(:ncol,:, 135) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 594) = rxt_rates(:ncol,:, 594)*sol(:ncol,:, 71) ! rate_const*E90 + rxt_rates(:ncol,:, 595) = rxt_rates(:ncol,:, 595)*sol(:ncol,:, 123) ! rate_const*NH_50 + rxt_rates(:ncol,:, 596) = rxt_rates(:ncol,:, 596)*sol(:ncol,:, 122) ! rate_const*NH_5 + rxt_rates(:ncol,:, 597) = rxt_rates(:ncol,:, 597)*sol(:ncol,:, 174) ! rate_const*ST80_25 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/mo_setrxt.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/mo_setrxt.F90 new file mode 100644 index 0000000000..fea4569c75 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/mo_setrxt.F90 @@ -0,0 +1,751 @@ + + 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(:,151) = 0.000258_r8 + rate(:,152) = 0.085_r8 + rate(:,153) = 1.2e-10_r8 + rate(:,158) = 1.2e-10_r8 + rate(:,159) = 1e-20_r8 + rate(:,160) = 1.3e-16_r8 + rate(:,162) = 4.2e-13_r8 + rate(:,164) = 8e-14_r8 + rate(:,165) = 3.9e-17_r8 + rate(:,172) = 6.9e-12_r8 + rate(:,173) = 7.2e-11_r8 + rate(:,174) = 1.6e-12_r8 + rate(:,180) = 1.8e-12_r8 + rate(:,184) = 1.8e-12_r8 + rate(:,188) = 7e-13_r8 + rate(:,189) = 5e-12_r8 + rate(:,198) = 3.5e-12_r8 + rate(:,200) = 1.3e-11_r8 + rate(:,201) = 2.2e-11_r8 + rate(:,202) = 5e-11_r8 + rate(:,237) = 1.7e-13_r8 + rate(:,239) = 2.607e-10_r8 + rate(:,240) = 9.75e-11_r8 + rate(:,241) = 2.07e-10_r8 + rate(:,242) = 2.088e-10_r8 + rate(:,243) = 1.17e-10_r8 + rate(:,244) = 4.644e-11_r8 + rate(:,245) = 1.204e-10_r8 + rate(:,246) = 9.9e-11_r8 + rate(:,247) = 3.3e-12_r8 + rate(:,266) = 4.5e-11_r8 + rate(:,267) = 4.62e-10_r8 + rate(:,268) = 1.2e-10_r8 + rate(:,269) = 9e-11_r8 + rate(:,270) = 3e-11_r8 + rate(:,275) = 2.14e-11_r8 + rate(:,276) = 1.9e-10_r8 + rate(:,289) = 2.57e-10_r8 + rate(:,290) = 1.8e-10_r8 + rate(:,291) = 1.794e-10_r8 + rate(:,292) = 1.3e-10_r8 + rate(:,293) = 7.65e-11_r8 + rate(:,306) = 4e-13_r8 + rate(:,310) = 1.31e-10_r8 + rate(:,311) = 3.5e-11_r8 + rate(:,312) = 9e-12_r8 + rate(:,319) = 6.8e-14_r8 + rate(:,320) = 2e-13_r8 + rate(:,335) = 1e-12_r8 + rate(:,339) = 1e-14_r8 + rate(:,340) = 1e-11_r8 + rate(:,341) = 1.15e-11_r8 + rate(:,342) = 4e-14_r8 + rate(:,355) = 1.45e-10_r8 + rate(:,356) = 3e-12_r8 + rate(:,357) = 6.7e-13_r8 + rate(:,367) = 3.5e-13_r8 + rate(:,368) = 5.4e-11_r8 + rate(:,371) = 2e-12_r8 + rate(:,372) = 1.4e-11_r8 + rate(:,375) = 2.4e-12_r8 + rate(:,386) = 5e-12_r8 + rate(:,396) = 1.6e-12_r8 + rate(:,398) = 6.7e-12_r8 + rate(:,401) = 3.5e-12_r8 + rate(:,404) = 1.3e-11_r8 + rate(:,405) = 1.4e-11_r8 + rate(:,409) = 2.4e-12_r8 + rate(:,410) = 1.4e-11_r8 + rate(:,415) = 2.4e-12_r8 + rate(:,416) = 4e-11_r8 + rate(:,417) = 4e-11_r8 + rate(:,419) = 1.4e-11_r8 + rate(:,423) = 2.4e-12_r8 + rate(:,424) = 4e-11_r8 + rate(:,428) = 7e-11_r8 + rate(:,429) = 1e-10_r8 + rate(:,434) = 2.4e-12_r8 + rate(:,449) = 4.7e-11_r8 + rate(:,462) = 2.1e-12_r8 + rate(:,463) = 2.8e-13_r8 + rate(:,471) = 1.7e-11_r8 + rate(:,477) = 8.4e-11_r8 + rate(:,479) = 1.9e-11_r8 + rate(:,480) = 1.2e-14_r8 + rate(:,481) = 2e-10_r8 + rate(:,488) = 2.4e-12_r8 + rate(:,489) = 2e-11_r8 + rate(:,493) = 2.3e-11_r8 + rate(:,494) = 2e-11_r8 + rate(:,498) = 3.3e-11_r8 + rate(:,499) = 1e-12_r8 + rate(:,500) = 5.7e-11_r8 + rate(:,501) = 3.4e-11_r8 + rate(:,506) = 2.3e-12_r8 + rate(:,508) = 1.2e-11_r8 + rate(:,509) = 5.7e-11_r8 + rate(:,510) = 2.8e-11_r8 + rate(:,511) = 6.6e-11_r8 + rate(:,512) = 1.4e-11_r8 + rate(:,515) = 1.9e-12_r8 + rate(:,528) = 6.34e-08_r8 + rate(:,534) = 1.9e-11_r8 + rate(:,537) = 1.2e-14_r8 + rate(:,538) = 2e-10_r8 + rate(:,549) = 1.34e-11_r8 + rate(:,555) = 1.34e-11_r8 + rate(:,559) = 1.7e-11_r8 + rate(:,582) = 6e-11_r8 + rate(:,585) = 1e-12_r8 + rate(:,586) = 4e-10_r8 + rate(:,587) = 2e-10_r8 + rate(:,588) = 1e-10_r8 + rate(:,589) = 5e-16_r8 + rate(:,590) = 4.4e-10_r8 + rate(:,591) = 9e-10_r8 + rate(:,594) = 1.29e-07_r8 + rate(:,595) = 2.31e-07_r8 + rate(:,596) = 2.31e-06_r8 + rate(:,597) = 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(:,154) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,155) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:,156) = 2.64e-11_r8 * exp_fac(:) + rate(:,157) = 6.6e-12_r8 * exp_fac(:) + rate(:,161) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:,163) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:,166) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:,167) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,170) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + exp_fac(:) = exp( -2000._r8 * itemp(:) ) + rate(:,171) = 1.4e-12_r8 * exp_fac(:) + rate(:,425) = 1.05e-14_r8 * exp_fac(:) + rate(:,545) = 1.05e-14_r8 * exp_fac(:) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,176) = 3e-11_r8 * exp_fac(:) + rate(:,264) = 5.5e-12_r8 * exp_fac(:) + rate(:,303) = 3.8e-12_r8 * exp_fac(:) + rate(:,324) = 3.8e-12_r8 * exp_fac(:) + rate(:,351) = 3.8e-12_r8 * exp_fac(:) + rate(:,360) = 3.8e-12_r8 * exp_fac(:) + rate(:,364) = 3.8e-12_r8 * exp_fac(:) + rate(:,380) = 2.3e-11_r8 * exp_fac(:) + rate(:,390) = 3.8e-12_r8 * exp_fac(:) + rate(:,400) = 3.8e-12_r8 * exp_fac(:) + rate(:,427) = 1.52e-11_r8 * exp_fac(:) + rate(:,435) = 1.52e-12_r8 * exp_fac(:) + rate(:,441) = 3.8e-12_r8 * exp_fac(:) + rate(:,444) = 3.8e-12_r8 * exp_fac(:) + rate(:,448) = 3.8e-12_r8 * exp_fac(:) + rate(:,464) = 3.8e-12_r8 * exp_fac(:) + rate(:,468) = 3.8e-12_r8 * exp_fac(:) + rate(:,474) = 3.8e-12_r8 * exp_fac(:) + rate(:,478) = 3.8e-12_r8 * exp_fac(:) + rate(:,177) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,178) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,179) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,181) = 4.8e-11_r8 * exp_fac(:) + rate(:,262) = 1.7e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 180._r8 * itemp(:) ) + rate(:,182) = 1.8e-11_r8 * exp_fac(:) + rate(:,337) = 4.2e-12_r8 * exp_fac(:) + rate(:,350) = 4.2e-12_r8 * exp_fac(:) + rate(:,359) = 4.2e-12_r8 * exp_fac(:) + rate(:,388) = 4.2e-12_r8 * exp_fac(:) + rate(:,408) = 4.4e-12_r8 * exp_fac(:) + rate(:,414) = 4.4e-12_r8 * exp_fac(:) + rate(:,487) = 4.2e-12_r8 * exp_fac(:) + rate(:,492) = 4.2e-12_r8 * exp_fac(:) + rate(:,497) = 4.2e-12_r8 * exp_fac(:) + rate(:,183) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,187) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) + rate(:,190) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,191) = 2.9e-12_r8 * exp_fac(:) + rate(:,192) = 1.45e-12_r8 * exp_fac(:) + rate(:,193) = 1.45e-12_r8 * exp_fac(:) + rate(:,194) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:,195) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,196) = 1.2e-13_r8 * exp_fac(:) + rate(:,222) = 3e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,199) = 1.7e-11_r8 * exp_fac(:) + rate(:,297) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,203) = 3.44e-12_r8 * exp_fac(:) + rate(:,255) = 2.3e-12_r8 * exp_fac(:) + rate(:,258) = 8.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,204) = 3e-12_r8 * exp_fac(:) + rate(:,263) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,206) = 7.26e-11_r8 * exp_fac(:) + rate(:,207) = 4.64e-11_r8 * exp_fac(:) + rate(:,214) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,215) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,216) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,217) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,218) = 1.4e-11_r8 * exp_fac(:) + rate(:,232) = 7.4e-12_r8 * exp_fac(:) + rate(:,333) = 8.1e-12_r8 * exp_fac(:) + rate(:,219) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,220) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,221) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,223) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,224) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,225) = 2.6e-12_r8 * exp_fac(:) + rate(:,226) = 6.4e-12_r8 * exp_fac(:) + rate(:,256) = 4.1e-13_r8 * exp_fac(:) + rate(:,437) = 7.5e-12_r8 * exp_fac(:) + rate(:,451) = 7.5e-12_r8 * exp_fac(:) + rate(:,454) = 7.5e-12_r8 * exp_fac(:) + rate(:,457) = 7.5e-12_r8 * exp_fac(:) + rate(:,227) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,229) = 3.6e-12_r8 * exp_fac(:) + rate(:,278) = 2e-12_r8 * exp_fac(:) + rate(:,230) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,231) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,233) = 6e-13_r8 * exp_fac(:) + rate(:,253) = 1.5e-12_r8 * exp_fac(:) + rate(:,261) = 1.9e-11_r8 * exp_fac(:) + rate(:,234) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,235) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,236) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + exp_fac(:) = exp( -500._r8 * itemp(:) ) + rate(:,238) = 3e-12_r8 * exp_fac(:) + rate(:,272) = 1.4e-10_r8 * exp_fac(:) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,250) = 1.7e-11_r8 * exp_fac(:) + rate(:,277) = 6.3e-12_r8 * exp_fac(:) + rate(:,251) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,252) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,254) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + rate(:,257) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,260) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,265) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,271) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) + exp_fac(:) = exp( 0._r8 * itemp(:) ) + rate(:,273) = 1.4e-11_r8 * exp_fac(:) + rate(:,275) = 2.14e-11_r8 * exp_fac(:) + rate(:,276) = 1.9e-10_r8 * exp_fac(:) + rate(:,289) = 2.57e-10_r8 * exp_fac(:) + rate(:,290) = 1.8e-10_r8 * exp_fac(:) + rate(:,291) = 1.794e-10_r8 * exp_fac(:) + rate(:,292) = 1.3e-10_r8 * exp_fac(:) + rate(:,293) = 7.65e-11_r8 * exp_fac(:) + rate(:,306) = 4e-13_r8 * exp_fac(:) + rate(:,310) = 1.31e-10_r8 * exp_fac(:) + rate(:,311) = 3.5e-11_r8 * exp_fac(:) + rate(:,312) = 9e-12_r8 * exp_fac(:) + rate(:,319) = 6.8e-14_r8 * exp_fac(:) + rate(:,320) = 2e-13_r8 * exp_fac(:) + rate(:,335) = 1e-12_r8 * exp_fac(:) + rate(:,339) = 1e-14_r8 * exp_fac(:) + rate(:,340) = 1e-11_r8 * exp_fac(:) + rate(:,341) = 1.15e-11_r8 * exp_fac(:) + rate(:,342) = 4e-14_r8 * exp_fac(:) + rate(:,355) = 1.45e-10_r8 * exp_fac(:) + rate(:,356) = 3e-12_r8 * exp_fac(:) + rate(:,357) = 6.7e-13_r8 * exp_fac(:) + rate(:,367) = 3.5e-13_r8 * exp_fac(:) + rate(:,368) = 5.4e-11_r8 * exp_fac(:) + rate(:,371) = 2e-12_r8 * exp_fac(:) + rate(:,372) = 1.4e-11_r8 * exp_fac(:) + rate(:,375) = 2.4e-12_r8 * exp_fac(:) + rate(:,386) = 5e-12_r8 * exp_fac(:) + rate(:,396) = 1.6e-12_r8 * exp_fac(:) + rate(:,398) = 6.7e-12_r8 * exp_fac(:) + rate(:,401) = 3.5e-12_r8 * exp_fac(:) + rate(:,404) = 1.3e-11_r8 * exp_fac(:) + rate(:,405) = 1.4e-11_r8 * exp_fac(:) + rate(:,409) = 2.4e-12_r8 * exp_fac(:) + rate(:,410) = 1.4e-11_r8 * exp_fac(:) + rate(:,415) = 2.4e-12_r8 * exp_fac(:) + rate(:,416) = 4e-11_r8 * exp_fac(:) + rate(:,417) = 4e-11_r8 * exp_fac(:) + rate(:,419) = 1.4e-11_r8 * exp_fac(:) + rate(:,423) = 2.4e-12_r8 * exp_fac(:) + rate(:,424) = 4e-11_r8 * exp_fac(:) + rate(:,428) = 7e-11_r8 * exp_fac(:) + rate(:,429) = 1e-10_r8 * exp_fac(:) + rate(:,434) = 2.4e-12_r8 * exp_fac(:) + rate(:,449) = 4.7e-11_r8 * exp_fac(:) + rate(:,462) = 2.1e-12_r8 * exp_fac(:) + rate(:,463) = 2.8e-13_r8 * exp_fac(:) + rate(:,471) = 1.7e-11_r8 * exp_fac(:) + rate(:,477) = 8.4e-11_r8 * exp_fac(:) + rate(:,479) = 1.9e-11_r8 * exp_fac(:) + rate(:,480) = 1.2e-14_r8 * exp_fac(:) + rate(:,481) = 2e-10_r8 * exp_fac(:) + rate(:,488) = 2.4e-12_r8 * exp_fac(:) + rate(:,489) = 2e-11_r8 * exp_fac(:) + rate(:,493) = 2.3e-11_r8 * exp_fac(:) + rate(:,494) = 2e-11_r8 * exp_fac(:) + rate(:,498) = 3.3e-11_r8 * exp_fac(:) + rate(:,499) = 1e-12_r8 * exp_fac(:) + rate(:,500) = 5.7e-11_r8 * exp_fac(:) + rate(:,501) = 3.4e-11_r8 * exp_fac(:) + rate(:,506) = 2.3e-12_r8 * exp_fac(:) + rate(:,508) = 1.2e-11_r8 * exp_fac(:) + rate(:,509) = 5.7e-11_r8 * exp_fac(:) + rate(:,510) = 2.8e-11_r8 * exp_fac(:) + rate(:,511) = 6.6e-11_r8 * exp_fac(:) + rate(:,512) = 1.4e-11_r8 * exp_fac(:) + rate(:,515) = 1.9e-12_r8 * exp_fac(:) + rate(:,528) = 6.34e-08_r8 * exp_fac(:) + rate(:,534) = 1.9e-11_r8 * exp_fac(:) + rate(:,537) = 1.2e-14_r8 * exp_fac(:) + rate(:,538) = 2e-10_r8 * exp_fac(:) + rate(:,549) = 1.34e-11_r8 * exp_fac(:) + rate(:,555) = 1.34e-11_r8 * exp_fac(:) + rate(:,559) = 1.7e-11_r8 * exp_fac(:) + rate(:,582) = 6e-11_r8 * exp_fac(:) + rate(:,585) = 1e-12_r8 * exp_fac(:) + rate(:,586) = 4e-10_r8 * exp_fac(:) + rate(:,587) = 2e-10_r8 * exp_fac(:) + rate(:,588) = 1e-10_r8 * exp_fac(:) + rate(:,589) = 5e-16_r8 * exp_fac(:) + rate(:,590) = 4.4e-10_r8 * exp_fac(:) + rate(:,591) = 9e-10_r8 * exp_fac(:) + rate(:,594) = 1.29e-07_r8 * exp_fac(:) + rate(:,595) = 2.31e-07_r8 * exp_fac(:) + rate(:,596) = 2.31e-06_r8 * exp_fac(:) + rate(:,597) = 4.63e-07_r8 * exp_fac(:) + exp_fac(:) = exp( 400._r8 * itemp(:) ) + rate(:,274) = 6e-12_r8 * exp_fac(:) + rate(:,373) = 5e-13_r8 * exp_fac(:) + rate(:,406) = 5e-13_r8 * exp_fac(:) + rate(:,411) = 5e-13_r8 * exp_fac(:) + rate(:,420) = 5e-13_r8 * exp_fac(:) + rate(:,431) = 5e-13_r8 * exp_fac(:) + rate(:,279) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,280) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + exp_fac(:) = exp( -1520._r8 * itemp(:) ) + rate(:,281) = 1.64e-12_r8 * exp_fac(:) + rate(:,392) = 8.5e-16_r8 * exp_fac(:) + exp_fac(:) = exp( -1100._r8 * itemp(:) ) + rate(:,282) = 2.03e-11_r8 * exp_fac(:) + rate(:,514) = 3.4e-12_r8 * exp_fac(:) + rate(:,283) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,284) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,285) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,286) = 1.25e-12_r8 * exp_fac(:) + rate(:,296) = 3.4e-11_r8 * exp_fac(:) + rate(:,287) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,288) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,294) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) + rate(:,295) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,298) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) + rate(:,299) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) + rate(:,300) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + exp_fac(:) = exp( 300._r8 * itemp(:) ) + rate(:,301) = 2.8e-12_r8 * exp_fac(:) + rate(:,363) = 2.9e-12_r8 * exp_fac(:) + rate(:,302) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) + rate(:,304) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + exp_fac(:) = exp( 700._r8 * itemp(:) ) + rate(:,307) = 7.5e-13_r8 * exp_fac(:) + rate(:,321) = 7.5e-13_r8 * exp_fac(:) + rate(:,336) = 7.5e-13_r8 * exp_fac(:) + rate(:,349) = 7.5e-13_r8 * exp_fac(:) + rate(:,358) = 7.5e-13_r8 * exp_fac(:) + rate(:,362) = 8.6e-13_r8 * exp_fac(:) + rate(:,374) = 8e-13_r8 * exp_fac(:) + rate(:,387) = 7.5e-13_r8 * exp_fac(:) + rate(:,397) = 7.5e-13_r8 * exp_fac(:) + rate(:,407) = 8e-13_r8 * exp_fac(:) + rate(:,412) = 8e-13_r8 * exp_fac(:) + rate(:,421) = 8e-13_r8 * exp_fac(:) + rate(:,432) = 8e-13_r8 * exp_fac(:) + rate(:,439) = 7.5e-13_r8 * exp_fac(:) + rate(:,443) = 7.5e-13_r8 * exp_fac(:) + rate(:,446) = 7.5e-13_r8 * exp_fac(:) + rate(:,459) = 7.5e-13_r8 * exp_fac(:) + rate(:,466) = 7.5e-13_r8 * exp_fac(:) + rate(:,472) = 7.5e-13_r8 * exp_fac(:) + rate(:,475) = 7.5e-13_r8 * exp_fac(:) + rate(:,486) = 7.5e-13_r8 * exp_fac(:) + rate(:,491) = 7.5e-13_r8 * exp_fac(:) + rate(:,496) = 7.5e-13_r8 * exp_fac(:) + rate(:,540) = 7.5e-13_r8 * exp_fac(:) + rate(:,547) = 7.5e-13_r8 * exp_fac(:) + rate(:,557) = 7.5e-13_r8 * exp_fac(:) + rate(:,560) = 7.5e-13_r8 * exp_fac(:) + rate(:,308) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) + rate(:,309) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) + rate(:,313) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) + rate(:,318) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + exp_fac(:) = exp( 365._r8 * itemp(:) ) + rate(:,322) = 2.6e-12_r8 * exp_fac(:) + rate(:,440) = 2.6e-12_r8 * exp_fac(:) + rate(:,445) = 2.6e-12_r8 * exp_fac(:) + rate(:,447) = 2.6e-12_r8 * exp_fac(:) + rate(:,460) = 2.6e-12_r8 * exp_fac(:) + rate(:,467) = 2.6e-12_r8 * exp_fac(:) + rate(:,473) = 2.6e-12_r8 * exp_fac(:) + rate(:,476) = 2.6e-12_r8 * exp_fac(:) + rate(:,541) = 2.6e-12_r8 * exp_fac(:) + rate(:,548) = 2.6e-12_r8 * exp_fac(:) + rate(:,558) = 2.6e-12_r8 * exp_fac(:) + rate(:,561) = 2.6e-12_r8 * exp_fac(:) + rate(:,323) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,325) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,326) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + exp_fac(:) = exp( -1900._r8 * itemp(:) ) + rate(:,327) = 1.4e-12_r8 * exp_fac(:) + rate(:,347) = 6.5e-15_r8 * exp_fac(:) + exp_fac(:) = exp( 350._r8 * itemp(:) ) + rate(:,328) = 4.63e-12_r8 * exp_fac(:) + rate(:,544) = 2.7e-12_r8 * exp_fac(:) + rate(:,329) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) + exp_fac(:) = exp( 500._r8 * itemp(:) ) + rate(:,330) = 2.9e-12_r8 * exp_fac(:) + rate(:,331) = 2e-12_r8 * exp_fac(:) + rate(:,361) = 7.1e-13_r8 * exp_fac(:) + rate(:,382) = 2e-12_r8 * exp_fac(:) + rate(:,485) = 2e-12_r8 * exp_fac(:) + rate(:,490) = 2e-12_r8 * exp_fac(:) + rate(:,495) = 2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 1040._r8 * itemp(:) ) + rate(:,332) = 4.3e-13_r8 * exp_fac(:) + rate(:,383) = 4.3e-13_r8 * exp_fac(:) + rate(:,436) = 4.3e-13_r8 * exp_fac(:) + rate(:,450) = 4.3e-13_r8 * exp_fac(:) + rate(:,453) = 4.3e-13_r8 * exp_fac(:) + rate(:,456) = 4.3e-13_r8 * exp_fac(:) + rate(:,334) = 3.15e-14_r8 * exp( 920._r8 * itemp(:) ) + rate(:,338) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,346) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,348) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,352) = 9.19e-12_r8 * exp( -630._r8 * itemp(:) ) + rate(:,353) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) + rate(:,354) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + rate(:,369) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) + rate(:,370) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) + exp_fac(:) = exp( 360._r8 * itemp(:) ) + rate(:,376) = 2.7e-12_r8 * exp_fac(:) + rate(:,377) = 1.3e-13_r8 * exp_fac(:) + rate(:,379) = 9.6e-12_r8 * exp_fac(:) + rate(:,385) = 5.3e-12_r8 * exp_fac(:) + rate(:,422) = 2.7e-12_r8 * exp_fac(:) + rate(:,433) = 2.7e-12_r8 * exp_fac(:) + rate(:,536) = 2.7e-12_r8 * exp_fac(:) + rate(:,552) = 2.7e-12_r8 * exp_fac(:) + rate(:,378) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) + exp_fac(:) = exp( 530._r8 * itemp(:) ) + rate(:,381) = 4.6e-12_r8 * exp_fac(:) + rate(:,384) = 2.3e-12_r8 * exp_fac(:) + rate(:,389) = 2.3e-12_r8 * exp( -170._r8 * itemp(:) ) + rate(:,393) = 4.13e-12_r8 * exp( 452._r8 * itemp(:) ) + rate(:,399) = 5.4e-14_r8 * exp( 870._r8 * itemp(:) ) + exp_fac(:) = exp( 175._r8 * itemp(:) ) + rate(:,402) = 1.86e-11_r8 * exp_fac(:) + rate(:,403) = 1.86e-11_r8 * exp_fac(:) + rate(:,413) = 1.6e+09_r8 * exp( -8300._r8 * itemp(:) ) + exp_fac(:) = exp( -446._r8 * itemp(:) ) + rate(:,418) = 3.03e-12_r8 * exp_fac(:) + rate(:,542) = 3.03e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 410._r8 * itemp(:) ) + rate(:,426) = 2.54e-11_r8 * exp_fac(:) + rate(:,546) = 2.54e-11_r8 * exp_fac(:) + rate(:,430) = 1.3e-12_r8 * exp( 640._r8 * itemp(:) ) + exp_fac(:) = exp( -193._r8 * itemp(:) ) + rate(:,438) = 2.3e-12_r8 * exp_fac(:) + rate(:,539) = 2.3e-12_r8 * exp_fac(:) + rate(:,442) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) + rate(:,461) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) + exp_fac(:) = exp( 352._r8 * itemp(:) ) + rate(:,469) = 1.7e-12_r8 * exp_fac(:) + rate(:,556) = 1.7e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 490._r8 * itemp(:) ) + rate(:,482) = 1.2e-12_r8 * exp_fac(:) + rate(:,550) = 1.2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -580._r8 * itemp(:) ) + rate(:,483) = 6.3e-16_r8 * exp_fac(:) + rate(:,553) = 6.3e-16_r8 * exp_fac(:) + exp_fac(:) = exp( 440._r8 * itemp(:) ) + rate(:,484) = 1.2e-11_r8 * exp_fac(:) + rate(:,554) = 1.2e-11_r8 * exp_fac(:) + rate(:,502) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,503) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,504) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,505) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,513) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,516) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) + rate(:,519) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + exp_fac(:) = exp( 1300._r8 * itemp(:) ) + rate(:,535) = 2.75e-13_r8 * exp_fac(:) + rate(:,543) = 2.12e-13_r8 * exp_fac(:) + rate(:,551) = 2.6e-13_r8 * exp_fac(:) + + 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(:,175), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,185), 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(:,197), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,205), 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(:,208), 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(:,209), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,210), 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(:,228), 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(:,248), 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(:,259), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.1e-33_r8 * itemp(:)**1.5_r8 + kinf(:) = 9.8e-15_r8 * itemp(:)**(-4.6_r8) + call jpl( rate(:,305), m, 0.8_r8, ko, kinf, n ) + + ko(:) = 5.2e-30_r8 * itemp(:)**2.4_r8 + kinf(:) = 2.2e-10_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,315), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.5e-30_r8 + kinf(:) = 8.3e-13_r8 * itemp(:)**(-2._r8) + call jpl( rate(:,316), 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(:,317), 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(:,343), 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(:,344), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,365), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,391), 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(:,394), m, 0.6_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(:,452), m, 0.6_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(:,455), m, 0.6_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(:,458), m, 0.6_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(:,465), 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(:,507), 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,159) = 1e-20_r8 + rate(:n,160) = 1.3e-16_r8 + rate(:n,164) = 8e-14_r8 + rate(:n,165) = 3.9e-17_r8 + rate(:n,172) = 6.9e-12_r8 + rate(:n,188) = 7e-13_r8 + rate(:n,189) = 5e-12_r8 + rate(:n,582) = 6e-11_r8 + rate(:n,585) = 1e-12_r8 + rate(:n,586) = 4e-10_r8 + rate(:n,587) = 2e-10_r8 + rate(:n,588) = 1e-10_r8 + rate(:n,590) = 4.4e-10_r8 + + do k = 1,kbot + offset = (k-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,k) + end do + + rate(:n,155) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:n,156) = 2.64e-11_r8 * exp_fac(:) + rate(:n,157) = 6.6e-12_r8 * exp_fac(:) + rate(:n,161) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:n,163) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:n,166) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:n,167) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,176) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,177) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,178) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,181) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,182) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,183) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,190) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,194) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:n,195) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,203) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) + rate(:n,204) = 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,175) = wrk(:) + + + + + + + + + + + + + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_tsmlt_mam5/mo_sim_dat.F90 b/src/chemistry/pp_waccm_tsmlt_mam5/mo_sim_dat.F90 new file mode 100644 index 0000000000..1b1ef18da7 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5/mo_sim_dat.F90 @@ -0,0 +1,900 @@ + + 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, 239, 0 /) + + cls_rxt_cnt(:,1) = (/ 9, 0, 0, 2 /) + cls_rxt_cnt(:,4) = (/ 8, 185, 404, 239 /) + + solsym(:241) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','bc_a1 ','bc_a4 ', & + 'BCARY ','BENZENE ','BENZOOH ','BEPOMUC ','BIGALD ', & + 'BIGALD1 ','BIGALD2 ','BIGALD3 ','BIGALD4 ','BIGALK ', & + 'BIGENE ','BR ','BRCL ','BRO ','BRONO2 ', & + 'BRY ','BZALD ','BZOOH ','C2H2 ','C2H4 ', & + 'C2H5OH ','C2H5OOH ','C2H6 ','C3H6 ','C3H7OOH ', & + 'C3H8 ','C6H5OOH ','CCL4 ','CF2CLBR ','CF3BR ', & + 'CFC11 ','CFC113 ','CFC114 ','CFC115 ','CFC12 ', & + 'CH2BR2 ','CH2O ','CH3BR ','CH3CCL3 ','CH3CHO ', & + 'CH3CL ','CH3CN ','CH3COCH3 ','CH3COCHO ','CH3COOH ', & + 'CH3COOOH ','CH3OH ','CH3OOH ','CH4 ','CHBR3 ', & + 'CL ','CL2 ','CL2O2 ','CLO ','CLONO2 ', & + 'CLY ','CO ','CO2 ','COF2 ','COFCL ', & + 'CRESOL ','DMS ','dst_a1 ','dst_a2 ','dst_a3 ', & + 'E90 ','EOOH ','F ','GLYALD ','GLYOXAL ', & + 'H ','H2 ','H2402 ','H2O2 ','H2SO4 ', & + 'HBR ','HCFC141B ','HCFC142B ','HCFC22 ','HCL ', & + 'HCN ','HCOOH ','HF ','HNO3 ','HO2 ', & + 'HO2NO2 ','HOBR ','HOCL ','HONITR ','HPALD ', & + 'HYAC ','HYDRALD ','IEPOX ','ISOP ','ISOPNITA ', & + 'ISOPNITB ','ISOPNOOH ','ISOPOOH ','IVOC ','MACR ', & + 'MACROOH ','MEK ','MEKOOH ','MPAN ','MTERP ', & + 'MVK ','N ','N2O ','N2O5 ','NC4CH2OH ', & + 'NC4CHO ','ncl_a1 ','ncl_a2 ','ncl_a3 ','NH3 ', & + 'NH4 ','NH_5 ','NH_50 ','NO ','NO2 ', & + 'NO3 ','NOA ','NTERPOOH ','num_a1 ','num_a2 ', & + 'num_a3 ','num_a4 ','num_a5 ','O ','O2 ', & + 'O3 ','O3S ','OCLO ','OCS ','ONITR ', & + 'PAN ','PBZNIT ','PHENO ','PHENOL ','PHENOOH ', & + 'pom_a1 ','pom_a4 ','POOH ','ROOH ','S ', & + 'SF6 ','SO ','SO2 ','SO3 ','so4_a1 ', & + 'so4_a2 ','so4_a3 ','so4_a5 ','soa1_a1 ','soa1_a2 ', & + 'soa2_a1 ','soa2_a2 ','soa3_a1 ','soa3_a2 ','soa4_a1 ', & + 'soa4_a2 ','soa5_a1 ','soa5_a2 ','SOAG0 ','SOAG1 ', & + 'SOAG2 ','SOAG3 ','SOAG4 ','ST80_25 ','SVOC ', & + 'TEPOMUC ','TERP2OOH ','TERPNIT ','TERPOOH ','TERPROD1 ', & + 'TERPROD2 ','TOLOOH ','TOLUENE ','XOOH ','XYLENES ', & + 'XYLENOOH ','XYLOL ','XYLOLOOH ','NHDEP ','NDEP ', & + 'ACBZO2 ','ALKO2 ','BCARYO2VBS ','BENZO2 ','BENZO2VBS ', & + 'BZOO ','C2H5O2 ','C3H7O2 ','C6H5O2 ','CH3CO3 ', & + 'CH3O2 ','DICARBO2 ','e ','ENEO2 ','EO ', & + 'EO2 ','HOCH2OO ','ISOPAO2 ','ISOPBO2 ','ISOPNO3 ', & + 'ISOPO2VBS ','IVOCO2VBS ','MACRO2 ','MALO2 ','MCO3 ', & + 'MDIALO2 ','MEKO2 ','MTERPO2VBS ','N2D ','N2p ', & + 'NOp ','Np ','NTERPO2 ','O1D ','O2_1D ', & + 'O2_1S ','O2p ','OH ','Op ','PHENO2 ', & + 'PO2 ','RO2 ','TERP2O2 ','TERPO2 ','TOLO2 ', & + 'TOLUO2VBS ','XO2 ','XYLENO2 ','XYLEO2VBS ','XYLOLO2 ', & + 'H2O ' /) + + adv_mass(:241) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 12.011000_r8, 12.011000_r8, & + 204.342600_r8, 78.110400_r8, 160.122200_r8, 126.108600_r8, 98.098200_r8, & + 84.072400_r8, 98.098200_r8, 98.098200_r8, 112.124000_r8, 72.143800_r8, & + 56.103200_r8, 79.904000_r8, 115.356700_r8, 95.903400_r8, 141.908940_r8, & + 99.716850_r8, 106.120800_r8, 124.135000_r8, 26.036800_r8, 28.051600_r8, & + 46.065800_r8, 62.065200_r8, 30.066400_r8, 42.077400_r8, 76.091000_r8, & + 44.092200_r8, 110.109200_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, 41.050940_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, 66.007206_r8, 82.461503_r8, & + 108.135600_r8, 62.132400_r8, 135.064039_r8, 135.064039_r8, 135.064039_r8, & + 28.010400_r8, 78.064600_r8, 18.998403_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, & + 27.025140_r8, 46.024600_r8, 20.005803_r8, 63.012340_r8, 33.006200_r8, & + 79.011740_r8, 96.910800_r8, 52.459500_r8, 135.114940_r8, 116.112400_r8, & + 74.076200_r8, 100.113000_r8, 118.127200_r8, 68.114200_r8, 147.125940_r8, & + 147.125940_r8, 163.125340_r8, 118.127200_r8, 184.350200_r8, 70.087800_r8, & + 120.100800_r8, 72.102600_r8, 104.101400_r8, 147.084740_r8, 136.228400_r8, & + 70.087800_r8, 14.006740_r8, 44.012880_r8, 108.010480_r8, 147.125940_r8, & + 145.111140_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, 231.239540_r8, 1.007400_r8, 1.007400_r8, & + 1.007400_r8, 1.007400_r8, 1.007400_r8, 15.999400_r8, 31.998800_r8, & + 47.998200_r8, 47.998200_r8, 67.451500_r8, 60.076400_r8, 133.100140_r8, & + 121.047940_r8, 183.117740_r8, 93.102400_r8, 94.109800_r8, 176.121600_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, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 28.010400_r8, 310.582400_r8, & + 140.134400_r8, 200.226000_r8, 215.240140_r8, 186.241400_r8, 168.227200_r8, & + 154.201400_r8, 174.148000_r8, 92.136200_r8, 150.126000_r8, 106.162000_r8, & + 188.173800_r8, 122.161400_r8, 204.173200_r8, 14.006740_r8, 14.006740_r8, & + 137.112200_r8, 103.135200_r8, 253.348200_r8, 159.114800_r8, 159.114800_r8, & + 123.127600_r8, 61.057800_r8, 75.083600_r8, 109.101800_r8, 75.042400_r8, & + 47.032000_r8, 129.089600_r8, 0.548567E-03_r8, 105.108800_r8, 61.057800_r8, & + 77.057200_r8, 63.031400_r8, 117.119800_r8, 117.119800_r8, 162.117940_r8, & + 117.119800_r8, 233.355800_r8, 119.093400_r8, 115.063800_r8, 101.079200_r8, & + 117.078600_r8, 103.094000_r8, 185.234000_r8, 14.006740_r8, 28.013480_r8, & + 30.006140_r8, 14.006740_r8, 230.232140_r8, 15.999400_r8, 31.998800_r8, & + 31.998800_r8, 31.998800_r8, 17.006800_r8, 15.999400_r8, 175.114200_r8, & + 91.083000_r8, 89.068200_r8, 199.218600_r8, 185.234000_r8, 173.140600_r8, & + 173.140600_r8, 149.118600_r8, 187.166400_r8, 187.166400_r8, 203.165800_r8, & + 18.014200_r8 /) + + crb_mass(:241) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, 60.055000_r8, & + 48.044000_r8, 60.055000_r8, 60.055000_r8, 72.066000_r8, 60.055000_r8, & + 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 84.077000_r8, 84.077000_r8, 24.022000_r8, 24.022000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 36.033000_r8, 36.033000_r8, & + 36.033000_r8, 72.066000_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, 24.022000_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, 12.011000_r8, 12.011000_r8, & + 84.077000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 12.011000_r8, 24.022000_r8, 0.000000_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, & + 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 48.044000_r8, 60.055000_r8, & + 36.033000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 156.143000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 120.110000_r8, & + 48.044000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 60.055000_r8, & + 60.055000_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, 120.110000_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, 0.000000_r8, 12.011000_r8, 48.044000_r8, & + 24.022000_r8, 84.077000_r8, 72.066000_r8, 72.066000_r8, 72.066000_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, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 12.011000_r8, 264.242000_r8, & + 84.077000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, & + 108.099000_r8, 84.077000_r8, 84.077000_r8, 60.055000_r8, 96.088000_r8, & + 96.088000_r8, 96.088000_r8, 96.088000_r8, 0.000000_r8, 0.000000_r8, & + 84.077000_r8, 60.055000_r8, 180.165000_r8, 72.066000_r8, 72.066000_r8, & + 84.077000_r8, 24.022000_r8, 36.033000_r8, 72.066000_r8, 24.022000_r8, & + 12.011000_r8, 60.055000_r8, 0.000000_r8, 48.044000_r8, 24.022000_r8, & + 24.022000_r8, 12.011000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 156.143000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 48.044000_r8, 48.044000_r8, 120.110000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 120.110000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 72.066000_r8, & + 36.033000_r8, 36.033000_r8, 120.110000_r8, 120.110000_r8, 84.077000_r8, & + 84.077000_r8, 60.055000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, & + 0.000000_r8 /) + + fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) + + clsmap(: 2,1) = (/ 189, 190 /) + clsmap(:239,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, 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, 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 /) + + permute(:239,4) = (/ 155, 159, 1, 2, 3, 188, 71, 122, 72, 116, & + 130, 98, 149, 108, 85, 113, 221, 86, 223, 145, & + 4, 88, 111, 100, 143, 95, 112, 102, 199, 121, & + 103, 96, 56, 67, 68, 59, 69, 60, 70, 61, & + 133, 229, 150, 62, 200, 115, 57, 195, 210, 161, & + 152, 173, 128, 236, 117, 234, 74, 54, 224, 187, & + 5, 201, 217, 89, 91, 79, 104, 6, 7, 8, & + 9, 63, 184, 202, 192, 233, 218, 58, 147, 64, & + 174, 90, 92, 101, 220, 77, 183, 99, 231, 237, & + 132, 169, 175, 204, 84, 205, 107, 65, 179, 148, & + 144, 120, 162, 50, 209, 105, 138, 106, 151, 190, & + 214, 189, 93, 97, 124, 196, 10, 11, 12, 55, & + 13, 14, 15, 227, 228, 225, 180, 118, 16, 17, & + 18, 19, 20, 232, 222, 235, 21, 109, 114, 87, & + 141, 66, 131, 73, 110, 22, 23, 142, 119, 163, & + 24, 219, 186, 94, 25, 26, 27, 28, 29, 30, & + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, & + 41, 42, 43, 44, 45, 80, 156, 153, 134, 194, & + 198, 157, 78, 81, 82, 164, 83, 123, 139, 191, & + 46, 135, 47, 125, 181, 185, 154, 216, 238, 168, & + 178, 146, 129, 170, 126, 211, 212, 208, 48, 49, & + 213, 165, 215, 182, 160, 51, 140, 158, 176, 136, & + 197, 230, 75, 76, 177, 226, 171, 127, 172, 206, & + 203, 193, 166, 52, 207, 167, 53, 137, 239 /) + + diag_map(:239) = (/ 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, 50, 56, 62, 68, 74, 76, & + 82, 88, 94, 95, 98, 101, 104, 107, 111, 115, & + 119, 123, 127, 130, 133, 136, 139, 144, 149, 154, & + 160, 166, 170, 175, 177, 180, 182, 187, 194, 199, & + 203, 208, 216, 221, 226, 229, 232, 235, 238, 241, & + 246, 251, 256, 261, 265, 269, 273, 279, 282, 285, & + 292, 298, 304, 310, 316, 321, 326, 329, 334, 339, & + 345, 350, 355, 363, 371, 379, 385, 391, 397, 403, & + 409, 415, 421, 427, 435, 441, 448, 454, 460, 465, & + 468, 472, 479, 486, 495, 502, 510, 517, 523, 529, & + 534, 542, 550, 558, 566, 574, 582, 589, 598, 602, & + 611, 620, 627, 635, 642, 652, 665, 676, 687, 698, & + 705, 711, 718, 729, 740, 751, 767, 778, 787, 797, & + 805, 814, 824, 828, 837, 845, 853, 865, 876, 892, & + 901, 910, 919, 925, 935, 947, 955, 974, 999,1018, & + 1042,1054,1062,1072,1080,1090,1106,1119,1133,1151, & + 1160,1166,1178,1195,1208,1217,1233,1253,1269,1281, & + 1299,1332,1356,1376,1397,1428,1450,1461,1476,1495, & + 1511,1542,1565,1592,1652,1818,1914,1960,1987,2031, & + 2055,2099,2121,2168,2233,2259,2368,2421,2449 /) + + extfrc_lst(: 22) = (/ 'CO ','SVOC ','SO2 ','NO2 ','NO ', & + 'num_a1 ','num_a2 ','so4_a1 ','so4_a2 ','num_a5 ', & + 'so4_a5 ','num_a4 ','pom_a4 ','bc_a4 ','O2p ', & + 'N2p ','N2D ','AOA_NH ','N ','OH ', & + 'Op ','e ' /) + + frc_from_dataset(: 22) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .false., & + .false., .false., .false., .false., .false., & + .false., .false. /) + + inv_lst(: 2) = (/ 'M ', 'N2 ' /) + + slvd_lst(: 50) = (/ 'ACBZO2 ', 'ALKO2 ', 'BCARYO2VBS ', 'BENZO2 ', 'BENZO2VBS ', & + 'BZOO ', 'C2H5O2 ', 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', & + 'CH3O2 ', 'DICARBO2 ', 'e ', 'ENEO2 ', 'EO ', & + 'EO2 ', 'HOCH2OO ', 'ISOPAO2 ', 'ISOPBO2 ', 'ISOPNO3 ', & + 'ISOPO2VBS ', 'IVOCO2VBS ', 'MACRO2 ', 'MALO2 ', 'MCO3 ', & + 'MDIALO2 ', 'MEKO2 ', 'MTERPO2VBS ', 'N2D ', 'N2p ', & + 'NOp ', 'Np ', 'NTERPO2 ', 'O1D ', 'O2_1D ', & + 'O2_1S ', 'O2p ', 'OH ', 'Op ', 'PHENO2 ', & + 'PO2 ', 'RO2 ', 'TERP2O2 ', 'TERPO2 ', 'TOLO2 ', & + 'TOLUO2VBS ', 'XO2 ', 'XYLENO2 ', 'XYLEO2VBS ', 'XYLOLO2 ' /) + + 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_c ', & + 'jh2o_a ', 'jh2o2 ', & + 'jo2_b ', 'jo2_a ', & + 'jo3_a ', 'jo3_b ', & + 'jhno3 ', 'jho2no2_a ', & + 'jho2no2_b ', 'jn2o ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jno ', 'jno_i ', & + 'jno2 ', 'jno3_a ', & + 'jno3_b ', 'jalknit ', & + 'jalkooh ', 'jbenzooh ', & + 'jbepomuc ', 'jbigald ', & + 'jbigald1 ', 'jbigald2 ', & + 'jbigald3 ', 'jbigald4 ', & + 'jbzooh ', 'jc2h5ooh ', & + 'jc3h7ooh ', 'jc6h5ooh ', & + 'jch2o_b ', 'jch2o_a ', & + 'jch3cho ', 'jacet ', & + 'jmgly ', 'jch3co3h ', & + 'jch3ooh ', 'jch4_b ', & + 'jch4_a ', 'jco2 ', & + 'jeooh ', 'jglyald ', & + 'jglyoxal ', 'jhonitr ', & + 'jhpald ', 'jhyac ', & + 'jisopnooh ', 'jisopooh ', & + 'jmacr_a ', 'jmacr_b ', & + 'jmek ', 'jmekooh ', & + 'jmpan ', 'jmvk ', & + 'jnc4cho ', 'jnoa ', & + 'jnterpooh ', 'jonitr ', & + 'jpan ', 'jphenooh ', & + 'jpooh ', 'jrooh ', & + 'jtepomuc ', 'jterp2ooh ', & + 'jterpnit ', 'jterpooh ', & + 'jterprd1 ', 'jterprd2 ', & + 'jtolooh ', 'jxooh ', & + 'jxylenooh ', 'jxylolooh ', & + 'jbrcl ', 'jbro ', & + 'jbrono2_b ', 'jbrono2_a ', & + 'jccl4 ', 'jcf2clbr ', & + 'jcf3br ', 'jcfcl3 ', & + 'jcfc113 ', 'jcfc114 ', & + 'jcfc115 ', 'jcf2cl2 ', & + 'jch2br2 ', 'jch3br ', & + 'jch3ccl3 ', 'jch3cl ', & + 'jchbr3 ', 'jcl2 ', & + 'jcl2o2 ', 'jclo ', & + 'jclono2_a ', 'jclono2_b ', & + 'jcof2 ', 'jcofcl ', & + 'jh2402 ', 'jhbr ', & + 'jhcfc141b ', 'jhcfc142b ', & + 'jhcfc22 ', 'jhcl ', & + 'jhf ', 'jhobr ', & + 'jhocl ', 'joclo ', & + 'jsf6 ', 'jeuv_26 ', & + 'jeuv_4 ', 'jeuv_13 ', & + 'jeuv_11 ', 'jeuv_6 ', & + 'jeuv_10 ', 'jeuv_22 ', & + 'jeuv_23 ', 'jeuv_25 ', & + 'jeuv_18 ', 'jeuv_2 ', & + 'jeuv_1 ', 'jeuv_16 ', & + 'jeuv_15 ', 'jeuv_14 ', & + 'jeuv_3 ', 'jeuv_17 ', & + 'jeuv_9 ', 'jeuv_8 ', & + 'jeuv_7 ', 'jeuv_5 ', & + 'jeuv_19 ', 'jeuv_20 ', & + 'jeuv_21 ', 'jeuv_24 ', & + 'jeuv_12 ', 'jh2so4 ', & + 'jocs ', 'jso ', & + 'jso2 ', 'jso3 ', & + 'jsoa1_a1 ', 'jsoa1_a2 ', & + 'jsoa2_a1 ', 'jsoa2_a2 ', & + 'jsoa3_a1 ', 'jsoa3_a2 ', & + 'jsoa4_a1 ', 'jsoa4_a2 ', & + 'jsoa5_a1 ', 'jsoa5_a2 ', & + 'ag1 ', 'ag2 ', & + 'O1D_H2 ', 'O1D_H2O ', & + 'O1D_N2 ', 'O1D_O2 ', & + 'O1D_O2b ', 'O1D_O3 ', & + 'O2_1D_N2 ', 'O2_1D_O ', & + 'O2_1D_O2 ', 'O2_1S_CO2 ', & + 'O2_1S_N2 ', 'O2_1S_O ', & + 'O2_1S_O2 ', 'O2_1S_O3 ', & + '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 ', 'N2D_O ', & + 'N2D_O2 ', 'N_NO ', & + 'N_NO2a ', 'N_NO2b ', & + 'N_NO2c ', 'N_O2 ', & + 'NO2_O ', 'NO2_O3 ', & + 'NO2_O_M ', 'NO3_HO2 ', & + 'NO3_NO ', 'NO3_O ' /) + rxt_tag_lst( 201: 400) = (/ '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 ', & + 'F_CH4 ', 'F_H2 ', & + 'F_H2O ', 'F_HNO3 ', & + 'O1D_COF2 ', 'O1D_COFCL ', & + 'CH2BR2_CL ', 'CH2BR2_OH ', & + 'CH3BR_CL ', 'CH3BR_OH ', & + 'CH3CCL3_OH ', 'CH3CL_CL ', & + 'CH3CL_OH ', 'CHBR3_CL ', & + 'CHBR3_OH ', 'HCFC141B_OH ', & + 'HCFC142B_OH ', 'HCFC22_OH ', & + 'O1D_CH2BR2 ', 'O1D_CH3BR ', & + 'O1D_HCFC141B ', 'O1D_HCFC142B ', & + 'O1D_HCFC22 ', 'CH2O_HO2 ', & + 'CH2O_NO3 ', 'CH2O_O ', & + 'CH2O_OH ', 'CH3O2_CH3O2a ', & + 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & + 'CH3O2_NO ', 'CH3OH_OH ', & + 'CH3OOH_OH ', 'CH4_OH ', & + 'HCN_OH ', 'HCOOH_OH ', & + 'HOCH2OO_HO2 ', 'HOCH2OO_M ', & + 'HOCH2OO_NO ', 'O1D_CH4a ', & + 'O1D_CH4b ', 'O1D_CH4c ', & + 'O1D_HCN ', 'usr_CO_OH ', & + 'C2H2_CL_M ', 'C2H2_OH_M ', & + '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 ', & + 'CH3CN_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 ', & + 'CL_C3H8 ', 'HYAC_OH ', & + 'NOA_OH ', 'PO2_HO2 ', & + 'PO2_NO ', 'POOH_OH ', & + 'RO2_CH3O2 ', 'RO2_HO2 ', & + 'RO2_NO ', 'ROOH_OH ', & + 'tag_C3H6_OH ', 'usr_CH3COCH3_OH ', & + 'BIGENE_NO3 ', 'BIGENE_OH ', & + 'ENEO2_NO ', 'ENEO2_NOb ', & + 'HONITR_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 ', & + 'MEKO2_HO2 ', 'MEKO2_NO ', & + 'MEK_OH ', 'MEKOOH_OH ', & + 'MPAN_OH_M ', 'MVK_O3 ', & + 'MVK_OH ', 'tag_MCO3_NO2 ', & + 'usr_MPAN_M ', 'ALKNIT_OH ', & + 'ALKO2_HO2 ', 'ALKO2_NO ', & + 'ALKO2_NOb ', 'ALKOOH_OH ' /) + rxt_tag_lst( 401: 597) = (/ 'BIGALK_OH ', 'HPALD_OH ', & + 'HYDRALD_OH ', 'IEPOX_OH ', & + 'ISOPAO2_CH3CO3 ', 'ISOPAO2_CH3O2 ', & + 'ISOPAO2_HO2 ', 'ISOPAO2_NO ', & + 'ISOPAO2_NO3 ', 'ISOPBO2_CH3CO3 ', & + 'ISOPBO2_CH3O2 ', 'ISOPBO2_HO2 ', & + 'ISOPBO2_M ', 'ISOPBO2_NO ', & + 'ISOPBO2_NO3 ', 'ISOPNITA_OH ', & + 'ISOPNITB_OH ', 'ISOP_NO3 ', & + 'ISOPNO3_CH3CO3 ', 'ISOPNO3_CH3O2 ', & + 'ISOPNO3_HO2 ', 'ISOPNO3_NO ', & + 'ISOPNO3_NO3 ', 'ISOPNOOH_OH ', & + 'ISOP_O3 ', 'ISOP_OH ', & + 'ISOPOOH_OH ', 'NC4CH2OH_OH ', & + 'NC4CHO_OH ', 'XO2_CH3CO3 ', & + 'XO2_CH3O2 ', 'XO2_HO2 ', & + 'XO2_NO ', 'XO2_NO3 ', & + 'XOOH_OH ', 'ACBZO2_HO2 ', & + 'ACBZO2_NO ', 'BENZENE_OH ', & + 'BENZO2_HO2 ', 'BENZO2_NO ', & + 'BENZOOH_OH ', 'BZALD_OH ', & + 'BZOO_HO2 ', 'BZOOH_OH ', & + 'BZOO_NO ', 'C6H5O2_HO2 ', & + 'C6H5O2_NO ', 'C6H5OOH_OH ', & + 'CRESOL_OH ', 'DICARBO2_HO2 ', & + 'DICARBO2_NO ', 'DICARBO2_NO2 ', & + 'MALO2_HO2 ', 'MALO2_NO ', & + 'MALO2_NO2 ', 'MDIALO2_HO2 ', & + 'MDIALO2_NO ', 'MDIALO2_NO2 ', & + 'PHENO2_HO2 ', 'PHENO2_NO ', & + 'PHENOL_OH ', 'PHENO_NO2 ', & + 'PHENO_O3 ', 'PHENOOH_OH ', & + 'tag_ACBZO2_NO2 ', 'TOLO2_HO2 ', & + 'TOLO2_NO ', 'TOLOOH_OH ', & + 'TOLUENE_OH ', 'usr_PBZNIT_M ', & + 'XYLENES_OH ', 'XYLENO2_HO2 ', & + 'XYLENO2_NO ', 'XYLENOOH_OH ', & + 'XYLOLO2_HO2 ', 'XYLOLO2_NO ', & + 'XYLOL_OH ', 'XYLOLOOH_OH ', & + 'BCARY_NO3 ', 'BCARY_O3 ', & + 'BCARY_OH ', 'MTERP_NO3 ', & + 'MTERP_O3 ', 'MTERP_OH ', & + 'NTERPO2_CH3O2 ', 'NTERPO2_HO2 ', & + 'NTERPO2_NO ', 'NTERPO2_NO3 ', & + 'NTERPOOH_OH ', 'TERP2O2_CH3O2 ', & + 'TERP2O2_HO2 ', 'TERP2O2_NO ', & + 'TERP2OOH_OH ', 'TERPNIT_OH ', & + 'TERPO2_CH3O2 ', 'TERPO2_HO2 ', & + 'TERPO2_NO ', 'TERPOOH_OH ', & + 'TERPROD1_NO3 ', 'TERPROD1_OH ', & + 'TERPROD2_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_GLYOXAL_aer ', & + 'usr_HO2_aer ', 'usr_HONITR_aer ', & + 'usr_ISOPNITA_aer ', 'usr_ISOPNITB_aer ', & + 'usr_N2O5_aer ', 'usr_NC4CH2OH_aer ', & + 'usr_NC4CHO_aer ', 'usr_NH4_strat_tau ', & + 'usr_NO2_aer ', 'usr_NO3_aer ', & + 'usr_NTERPOOH_aer ', 'usr_ONITR_aer ', & + 'usr_TERPNIT_aer ', 'BCARY_NO3_vbs ', & + 'BCARYO2_HO2_vbs ', 'BCARYO2_NO_vbs ', & + 'BCARY_O3_vbs ', 'BCARY_OH_vbs ', & + 'BENZENE_OH_vbs ', 'BENZO2_HO2_vbs ', & + 'BENZO2_NO_vbs ', 'ISOP_NO3_vbs ', & + 'ISOPO2_HO2_vbs ', 'ISOPO2_NO_vbs ', & + 'ISOP_O3_vbs ', 'ISOP_OH_vbs ', & + 'IVOCO2_HO2_vbs ', 'IVOCO2_NO_vbs ', & + 'IVOC_OH_vbs ', 'MTERP_NO3_vbs ', & + 'MTERPO2_HO2_vbs ', 'MTERPO2_NO_vbs ', & + 'MTERP_O3_vbs ', 'MTERP_OH_vbs ', & + 'SVOC_OH ', 'TOLUENE_OH_vbs ', & + 'TOLUO2_HO2_vbs ', 'TOLUO2_NO_vbs ', & + 'XYLENES_OH_vbs ', 'XYLEO2_HO2_vbs ', & + 'XYLEO2_NO_vbs ', 'het1 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ', & + 'het8 ', 'het9 ', & + 'elec1 ', 'elec2 ', & + 'elec3 ', 'ion_N2p_O2 ', & + 'ion_N2p_Oa ', 'ion_N2p_Ob ', & + 'ion_Np_O ', 'ion_Np_O2a ', & + 'ion_Np_O2b ', 'ion_O2p_N ', & + 'ion_O2p_N2 ', 'ion_O2p_NO ', & + 'ion_Op_CO2 ', 'ion_Op_N2 ', & + 'ion_Op_O2 ', '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, 364, 365, 366, 367, 368, 369, 370, & + 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, & + 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, & + 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, & + 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, & + 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, & + 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, & + 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, & + 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, & + 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, & + 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, & + 471, 472, 473, 474, 475, 476, 477, 478, 479, 480, & + 481, 482, 483, 484, 485, 486, 487, 488, 489, 490, & + 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, & + 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, & + 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, & + 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, & + 531, 532, 533, 534, 535, 536, 537, 538, 539, 540, & + 541, 542, 543, 544, 545, 546, 547, 548, 549, 550, & + 551, 552, 553, 554, 555, 556, 557, 558, 559, 560, & + 561, 562, 563, 564, 565, 566, 567, 568, 569, 570, & + 571, 572, 573, 574, 575, 576, 577, 578, 579, 580, & + 581, 582, 583, 584, 585, 586, 587, 588, 589, 590, & + 591, 592, 593, 594, 595, 596, 597 /) + 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 ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + ' ', ' ', ' ', ' ', & + ' ', 'jh2o2 ', ' ', ' ', & + ' ', ' ', 'jch3ooh ', ' ', & + 'jmgly ', 'jch2o_a ', 'jno2 ', ' ', & + 'jch3ooh ', 'jch3ooh ', ' ', ' ', & + 'jacet ', 'jch3ooh ', 'jpan ', ' ', & + 'jch2o_a ', 'jch2o_a ', 'jch3ooh ', 'jch3cho ', & + ' ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jno2 ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3cho ', 'jch3cho ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + '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, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 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, .10_r8, 0.2_r8, .14_r8, & + .20_r8, .20_r8, .006_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, .006_r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, .10_r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 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, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_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(:) = (/ 155, 156, 157, 159, 160, & + 161, 163, 164, 165, 166, & + 167, 168, 169, 172, 175, & + 176, 177, 178, 181, 182, & + 183, 186, 188, 189, 190, & + 194, 195, 203, 204, 579, & + 580, 581, 582, 583, 585, & + 586, 587, 588, 590, 592, & + 593 /) + cph_enthalpy(:) = (/ 189.810000_r8, 32.910000_r8, 189.810000_r8, 94.300000_r8, 94.300000_r8, & + 94.300000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, 62.600000_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, 229.610000_r8, 177.510000_r8, 313.750000_r8, & + 133.750000_r8, 193.020000_r8, 34.470000_r8, 199.170000_r8, 82.389000_r8, & + 508.950000_r8, 354.830000_r8, 339.590000_r8, 67.530000_r8, 95.550000_r8, & + 239.840000_r8, 646.280000_r8, 406.160000_r8, 271.380000_r8, 105.040000_r8, & + 150.110000_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(:) = (/ 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, & + 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, 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, 2, 2, 2, 3, 2, 2, 1, 2, 2, & + 2, 2, 2, 2, 3, 3, 3, 2, 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, 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, & + 3, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 1, 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, 3, 2, 2, 3, 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, 3, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 1, 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, 1, 2, 1, 1, 1, 1, 2, 2, 2, & + 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 1, 1, 1, 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/chem_mech.doc b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/chem_mech.doc new file mode 100644 index 0000000000..16bc23d75f --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/chem_mech.doc @@ -0,0 +1,2096 @@ + + + Solution species + ( 1) ALKNIT (C5H11ONO2) + ( 2) ALKOOH (C5H12O2) + ( 3) AOA_NH (CO) + ( 4) bc_a1 (C) + ( 5) bc_a4 (C) + ( 6) BCARY (C15H24) + ( 7) BCARYO2VBS (C15H25O3) + ( 8) BENZENE (C6H6) + ( 9) BENZO2VBS (C6H7O5) + ( 10) BENZOOH (C6H8O5) + ( 11) BEPOMUC (C6H6O3) + ( 12) BIGALD (C5H6O2) + ( 13) BIGALD1 (C4H4O2) + ( 14) BIGALD2 (C5H6O2) + ( 15) BIGALD3 (C5H6O2) + ( 16) BIGALD4 (C6H8O2) + ( 17) BIGALK (C5H12) + ( 18) BIGENE (C4H8) + ( 19) BR (Br) + ( 20) BRCL (BrCl) + ( 21) BRO (BrO) + ( 22) BRONO2 (BrONO2) + ( 23) BRY + ( 24) BZALD (C7H6O) + ( 25) BZOOH (C7H8O2) + ( 26) C2H2 + ( 27) C2H4 + ( 28) C2H5OH + ( 29) C2H5OOH + ( 30) C2H6 + ( 31) C3H6 + ( 32) C3H7OOH + ( 33) C3H8 + ( 34) C6H5OOH (C6H5OOH) + ( 35) CCL4 (CCl4) + ( 36) CF2CLBR (CF2ClBr) + ( 37) CF3BR (CF3Br) + ( 38) CFC11 (CFCl3) + ( 39) CFC113 (CCl2FCClF2) + ( 40) CFC114 (CClF2CClF2) + ( 41) CFC115 (CClF2CF3) + ( 42) CFC12 (CF2Cl2) + ( 43) CH2BR2 (CH2Br2) + ( 44) CH2O + ( 45) CH3BR (CH3Br) + ( 46) CH3CCL3 (CH3CCl3) + ( 47) CH3CHO + ( 48) CH3CL (CH3Cl) + ( 49) CH3CN + ( 50) CH3COCH3 + ( 51) CH3COCHO + ( 52) CH3COOH + ( 53) CH3COOOH + ( 54) CH3OH + ( 55) CH3OOH + ( 56) CH4 + ( 57) CHBR3 (CHBr3) + ( 58) CL (Cl) + ( 59) CL2 (Cl2) + ( 60) CL2O2 (Cl2O2) + ( 61) CLO (ClO) + ( 62) CLONO2 (ClONO2) + ( 63) CLY + ( 64) CO + ( 65) CO2 + ( 66) COF2 + ( 67) COFCL (COFCl) + ( 68) CRESOL (C7H8O) + ( 69) DMS (CH3SCH3) + ( 70) dst_a1 (AlSiO5) + ( 71) dst_a2 (AlSiO5) + ( 72) dst_a3 (AlSiO5) + ( 73) E90 (CO) + ( 74) EOOH (HOCH2CH2OOH) + ( 75) F + ( 76) GLYALD (HOCH2CHO) + ( 77) GLYOXAL (C2H2O2) + ( 78) H + ( 79) H2 + ( 80) H2402 (CBrF2CBrF2) + ( 81) H2O2 + ( 82) H2SO4 (H2SO4) + ( 83) HBR (HBr) + ( 84) HCFC141B (CH3CCl2F) + ( 85) HCFC142B (CH3CClF2) + ( 86) HCFC22 (CHF2Cl) + ( 87) HCL (HCl) + ( 88) HCN + ( 89) HCOOH + ( 90) HF + ( 91) HNO3 + ( 92) HO2NO2 + ( 93) HOBR (HOBr) + ( 94) HOCL (HOCl) + ( 95) HONITR (C4H9NO4) + ( 96) HPALD (HOOCH2CCH3CHCHO) + ( 97) HYAC (CH3COCH2OH) + ( 98) HYDRALD (HOCH2CCH3CHCHO) + ( 99) IEPOX (C5H10O3) + (100) ISOP (C5H8) + (101) ISOPNITA (C5H9NO4) + (102) ISOPNITB (C5H9NO4) + (103) ISOPNO3 (CH2CHCCH3OOCH2ONO2) + (104) ISOPNOOH (C5H9NO5) + (105) ISOPO2VBS (C5H9O3) + (106) ISOPOOH (HOCH2COOHCH3CHCH2) + (107) IVOCbb (C13H28) + (108) IVOCbbO2VBS (C13H29O3) + (109) IVOCff (C13H28) + (110) IVOCffO2VBS (C13H29O3) + (111) MACR (CH2CCH3CHO) + (112) MACROOH (CH3COCHOOHCH2OH) + (113) MEK (C4H8O) + (114) MEKOOH (C4H8O3) + (115) MPAN (CH2CCH3CO3NO2) + (116) MTERP (C10H16) + (117) MTERPO2VBS (C10H17O3) + (118) MVK (CH2CHCOCH3) + (119) N + (120) N2O + (121) N2O5 + (122) NC4CH2OH (C5H9NO4) + (123) NC4CHO (C5H7NO4) + (124) ncl_a1 (NaCl) + (125) ncl_a2 (NaCl) + (126) ncl_a3 (NaCl) + (127) NH3 + (128) NH4 + (129) NH_5 (CO) + (130) NH_50 (CO) + (131) NO + (132) NO2 + (133) NO3 + (134) NOA (CH3COCH2ONO2) + (135) NTERPOOH (C10H17NO5) + (136) num_a1 (H) + (137) num_a2 (H) + (138) num_a3 (H) + (139) num_a4 (H) + (140) num_a5 (H) + (141) O + (142) O2 + (143) O3 + (144) O3S (O3) + (145) OCLO (OClO) + (146) OCS (OCS) + (147) ONITR (C4H7NO4) + (148) PAN (CH3CO3NO2) + (149) PBZNIT (C7H5O3NO2) + (150) PHENO (C6H5O) + (151) PHENOL (C6H5OH) + (152) PHENOOH (C6H8O6) + (153) pombb1_a1 (C) + (154) pombb1_a4 (C) + (155) pomff1_a1 (C) + (156) pomff1_a4 (C) + (157) POOH (C3H6OHOOH) + (158) ROOH (CH3COCH2OOH) + (159) S (S) + (160) SF6 + (161) SO (SO) + (162) SO2 + (163) SO3 (SO3) + (164) so4_a1 (NH4HSO4) + (165) so4_a2 (NH4HSO4) + (166) so4_a3 (NH4HSO4) + (167) so4_a5 (NH4HSO4) + (168) soabb1_a1 (C15H38O2) + (169) soabb1_a2 (C15H38O2) + (170) soabb2_a1 (C15H38O2) + (171) soabb2_a2 (C15H38O2) + (172) soabb3_a1 (C15H38O2) + (173) soabb3_a2 (C15H38O2) + (174) soabb4_a1 (C15H38O2) + (175) soabb4_a2 (C15H38O2) + (176) soabb5_a1 (C15H38O2) + (177) soabb5_a2 (C15H38O2) + (178) soabg1_a1 (C15H38O2) + (179) soabg1_a2 (C15H38O2) + (180) soabg2_a1 (C15H38O2) + (181) soabg2_a2 (C15H38O2) + (182) soabg3_a1 (C15H38O2) + (183) soabg3_a2 (C15H38O2) + (184) soabg4_a1 (C15H38O2) + (185) soabg4_a2 (C15H38O2) + (186) soabg5_a1 (C15H38O2) + (187) soabg5_a2 (C15H38O2) + (188) soaff1_a1 (C15H38O2) + (189) soaff1_a2 (C15H38O2) + (190) soaff2_a1 (C15H38O2) + (191) soaff2_a2 (C15H38O2) + (192) soaff3_a1 (C15H38O2) + (193) soaff3_a2 (C15H38O2) + (194) soaff4_a1 (C15H38O2) + (195) soaff4_a2 (C15H38O2) + (196) soaff5_a1 (C15H38O2) + (197) soaff5_a2 (C15H38O2) + (198) SOAGbb0 (C15H38O2) + (199) SOAGbb1 (C15H38O2) + (200) SOAGbb2 (C15H38O2) + (201) SOAGbb3 (C15H38O2) + (202) SOAGbb4 (C15H38O2) + (203) SOAGbg0 (C15H38O2) + (204) SOAGbg1 (C15H38O2) + (205) SOAGbg2 (C15H38O2) + (206) SOAGbg3 (C15H38O2) + (207) SOAGbg4 (C15H38O2) + (208) SOAGff0 (C15H38O2) + (209) SOAGff1 (C15H38O2) + (210) SOAGff2 (C15H38O2) + (211) SOAGff3 (C15H38O2) + (212) SOAGff4 (C15H38O2) + (213) ST80_25 (CO) + (214) SVOCbb (C22H46) + (215) SVOCff (C22H46) + (216) TEPOMUC (C7H8O3) + (217) TERP2OOH (C10H16O4) + (218) TERPNIT (C10H17NO4) + (219) TERPOOH (C10H18O3) + (220) TERPROD1 (C10H16O2) + (221) TERPROD2 (C9H14O2) + (222) TOLOOH (C7H10O5) + (223) TOLUENE (C7H8) + (224) TOLUO2VBS (C7H9O5) + (225) XOOH (HOCH2COOHCH3CHOHCHO) + (226) XYLENES (C8H10) + (227) XYLENOOH (C8H12O5) + (228) XYLEO2VBS (C8H11O5) + (229) XYLOL (C8H10O) + (230) XYLOLOOH (C8H12O6) + (231) NHDEP (N) + (232) NDEP (N) + (233) ACBZO2 (C7H5O3) + (234) ALKO2 (C5H11O2) + (235) BENZO2 (C6H7O5) + (236) BZOO (C7H7O2) + (237) C2H5O2 + (238) C3H7O2 + (239) C6H5O2 + (240) CH3CO3 + (241) CH3O2 + (242) DICARBO2 (C5H5O4) + (243) e (E) + (244) ENEO2 (C4H9O3) + (245) EO (HOCH2CH2O) + (246) EO2 (HOCH2CH2O2) + (247) HO2 + (248) HOCH2OO + (249) ISOPAO2 (HOC5H8O2) + (250) ISOPBO2 (HOC5H8O2) + (251) MACRO2 (CH3COCHO2CH2OH) + (252) MALO2 (C4H3O4) + (253) MCO3 (CH2CCH3CO3) + (254) MDIALO2 (C4H5O4) + (255) MEKO2 (C4H7O3) + (256) N2D (N) + (257) N2p (N2) + (258) NOp (NO) + (259) Np (N) + (260) NTERPO2 (C10H16NO5) + (261) O1D (O) + (262) O2_1D (O2) + (263) O2_1S (O2) + (264) O2p (O2) + (265) OH + (266) Op (O) + (267) PHENO2 (C6H7O6) + (268) PO2 (C3H6OHO2) + (269) RO2 (CH3COCH2O2) + (270) TERP2O2 (C10H15O4) + (271) TERPO2 (C10H17O3) + (272) TOLO2 (C7H9O5) + (273) XO2 (HOCH2COOCH3CHOHCHO) + (274) XYLENO2 (C8H11O5) + (275) XYLOLO2 (C8H11O6) + (276) H2O + + + Invariant species + ( 1) M + ( 2) N2 + + + Column integrals + ( 1) O3 - 0.000E+00 + ( 2) O2 - 0.000E+00 + +Class List +========== + Explicit + -------- + ( 1) NHDEP + ( 2) NDEP + + Implicit + -------- + ( 1) ALKNIT + ( 2) ALKOOH + ( 3) AOA_NH + ( 4) bc_a1 + ( 5) bc_a4 + ( 6) BCARY + ( 7) BCARYO2VBS + ( 8) BENZENE + ( 9) BENZO2VBS + ( 10) BENZOOH + ( 11) BEPOMUC + ( 12) BIGALD + ( 13) BIGALD1 + ( 14) BIGALD2 + ( 15) BIGALD3 + ( 16) BIGALD4 + ( 17) BIGALK + ( 18) BIGENE + ( 19) BR + ( 20) BRCL + ( 21) BRO + ( 22) BRONO2 + ( 23) BRY + ( 24) BZALD + ( 25) BZOOH + ( 26) C2H2 + ( 27) C2H4 + ( 28) C2H5OH + ( 29) C2H5OOH + ( 30) C2H6 + ( 31) C3H6 + ( 32) C3H7OOH + ( 33) C3H8 + ( 34) C6H5OOH + ( 35) CCL4 + ( 36) CF2CLBR + ( 37) CF3BR + ( 38) CFC11 + ( 39) CFC113 + ( 40) CFC114 + ( 41) CFC115 + ( 42) CFC12 + ( 43) CH2BR2 + ( 44) CH2O + ( 45) CH3BR + ( 46) CH3CCL3 + ( 47) CH3CHO + ( 48) CH3CL + ( 49) CH3CN + ( 50) CH3COCH3 + ( 51) CH3COCHO + ( 52) CH3COOH + ( 53) CH3COOOH + ( 54) CH3OH + ( 55) CH3OOH + ( 56) CH4 + ( 57) CHBR3 + ( 58) CL + ( 59) CL2 + ( 60) CL2O2 + ( 61) CLO + ( 62) CLONO2 + ( 63) CLY + ( 64) CO + ( 65) CO2 + ( 66) COF2 + ( 67) COFCL + ( 68) CRESOL + ( 69) DMS + ( 70) dst_a1 + ( 71) dst_a2 + ( 72) dst_a3 + ( 73) E90 + ( 74) EOOH + ( 75) F + ( 76) GLYALD + ( 77) GLYOXAL + ( 78) H + ( 79) H2 + ( 80) H2402 + ( 81) H2O2 + ( 82) H2SO4 + ( 83) HBR + ( 84) HCFC141B + ( 85) HCFC142B + ( 86) HCFC22 + ( 87) HCL + ( 88) HCN + ( 89) HCOOH + ( 90) HF + ( 91) HNO3 + ( 92) HO2NO2 + ( 93) HOBR + ( 94) HOCL + ( 95) HONITR + ( 96) HPALD + ( 97) HYAC + ( 98) HYDRALD + ( 99) IEPOX + (100) ISOP + (101) ISOPNITA + (102) ISOPNITB + (103) ISOPNO3 + (104) ISOPNOOH + (105) ISOPO2VBS + (106) ISOPOOH + (107) IVOCbb + (108) IVOCbbO2VBS + (109) IVOCff + (110) IVOCffO2VBS + (111) MACR + (112) MACROOH + (113) MEK + (114) MEKOOH + (115) MPAN + (116) MTERP + (117) MTERPO2VBS + (118) MVK + (119) N + (120) N2O + (121) N2O5 + (122) NC4CH2OH + (123) NC4CHO + (124) ncl_a1 + (125) ncl_a2 + (126) ncl_a3 + (127) NH3 + (128) NH4 + (129) NH_5 + (130) NH_50 + (131) NO + (132) NO2 + (133) NO3 + (134) NOA + (135) NTERPOOH + (136) num_a1 + (137) num_a2 + (138) num_a3 + (139) num_a4 + (140) num_a5 + (141) O + (142) O2 + (143) O3 + (144) O3S + (145) OCLO + (146) OCS + (147) ONITR + (148) PAN + (149) PBZNIT + (150) PHENO + (151) PHENOL + (152) PHENOOH + (153) pombb1_a1 + (154) pombb1_a4 + (155) pomff1_a1 + (156) pomff1_a4 + (157) POOH + (158) ROOH + (159) S + (160) SF6 + (161) SO + (162) SO2 + (163) SO3 + (164) so4_a1 + (165) so4_a2 + (166) so4_a3 + (167) so4_a5 + (168) soabb1_a1 + (169) soabb1_a2 + (170) soabb2_a1 + (171) soabb2_a2 + (172) soabb3_a1 + (173) soabb3_a2 + (174) soabb4_a1 + (175) soabb4_a2 + (176) soabb5_a1 + (177) soabb5_a2 + (178) soabg1_a1 + (179) soabg1_a2 + (180) soabg2_a1 + (181) soabg2_a2 + (182) soabg3_a1 + (183) soabg3_a2 + (184) soabg4_a1 + (185) soabg4_a2 + (186) soabg5_a1 + (187) soabg5_a2 + (188) soaff1_a1 + (189) soaff1_a2 + (190) soaff2_a1 + (191) soaff2_a2 + (192) soaff3_a1 + (193) soaff3_a2 + (194) soaff4_a1 + (195) soaff4_a2 + (196) soaff5_a1 + (197) soaff5_a2 + (198) SOAGbb0 + (199) SOAGbb1 + (200) SOAGbb2 + (201) SOAGbb3 + (202) SOAGbb4 + (203) SOAGbg0 + (204) SOAGbg1 + (205) SOAGbg2 + (206) SOAGbg3 + (207) SOAGbg4 + (208) SOAGff0 + (209) SOAGff1 + (210) SOAGff2 + (211) SOAGff3 + (212) SOAGff4 + (213) ST80_25 + (214) SVOCbb + (215) SVOCff + (216) TEPOMUC + (217) TERP2OOH + (218) TERPNIT + (219) TERPOOH + (220) TERPROD1 + (221) TERPROD2 + (222) TOLOOH + (223) TOLUENE + (224) TOLUO2VBS + (225) XOOH + (226) XYLENES + (227) XYLENOOH + (228) XYLEO2VBS + (229) XYLOL + (230) XYLOLOOH + (231) ACBZO2 + (232) ALKO2 + (233) BENZO2 + (234) BZOO + (235) C2H5O2 + (236) C3H7O2 + (237) C6H5O2 + (238) CH3CO3 + (239) CH3O2 + (240) DICARBO2 + (241) e + (242) ENEO2 + (243) EO + (244) EO2 + (245) HO2 + (246) HOCH2OO + (247) ISOPAO2 + (248) ISOPBO2 + (249) MACRO2 + (250) MALO2 + (251) MCO3 + (252) MDIALO2 + (253) MEKO2 + (254) N2D + (255) N2p + (256) NOp + (257) Np + (258) NTERPO2 + (259) O1D + (260) O2_1D + (261) O2_1S + (262) O2p + (263) OH + (264) Op + (265) PHENO2 + (266) PO2 + (267) RO2 + (268) TERP2O2 + (269) TERPO2 + (270) TOLO2 + (271) XO2 + (272) XYLENO2 + (273) XYLOLO2 + (274) H2O + + Photolysis + jh2o_b ( 1) H2O + hv -> H2 + O1D rate = ** User defined ** ( 1) + jh2o_c ( 2) H2O + hv -> 2*H + O rate = ** User defined ** ( 2) + jh2o_a ( 3) H2O + hv -> OH + H rate = ** User defined ** ( 3) + jh2o2 ( 4) H2O2 + hv -> 2*OH rate = ** User defined ** ( 4) + jo2_b ( 5) O2 + hv -> 2*O rate = ** User defined ** ( 5) + jo2_a ( 6) O2 + hv -> O + O1D rate = ** User defined ** ( 6) + jo3_a ( 7) O3 + hv -> O1D + O2_1D 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) + jno_i ( 16) NO + hv -> NOp + e rate = ** User defined ** ( 16) + jno2 ( 17) NO2 + hv -> NO + O rate = ** User defined ** ( 17) + jno3_a ( 18) NO3 + hv -> NO2 + O rate = ** User defined ** ( 18) + jno3_b ( 19) NO3 + hv -> NO + O2 rate = ** User defined ** ( 19) + jalknit ( 20) ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 rate = ** User defined ** ( 20) + + 0.8*MEK + jalkooh ( 21) ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 rate = ** User defined ** ( 21) + + 0.8*MEK + OH + jbenzooh ( 22) BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 rate = ** User defined ** ( 22) + jbepomuc ( 23) BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO rate = ** User defined ** ( 23) + jbigald ( 24) BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 rate = ** User defined ** ( 24) + + 0.18*CH3COCHO + jbigald1 ( 25) BIGALD1 + hv -> 0.6*MALO2 + HO2 rate = ** User defined ** ( 25) + jbigald2 ( 26) BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 rate = ** User defined ** ( 26) + jbigald3 ( 27) BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 rate = ** User defined ** ( 27) + jbigald4 ( 28) BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 rate = ** User defined ** ( 28) + jbzooh ( 29) BZOOH + hv -> BZALD + OH + HO2 rate = ** User defined ** ( 29) + jc2h5ooh ( 30) C2H5OOH + hv -> CH3CHO + HO2 + OH rate = ** User defined ** ( 30) + jc3h7ooh ( 31) C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 rate = ** User defined ** ( 31) + jc6h5ooh ( 32) C6H5OOH + hv -> PHENO + OH rate = ** User defined ** ( 32) + jch2o_b ( 33) CH2O + hv -> CO + H2 rate = ** User defined ** ( 33) + jch2o_a ( 34) CH2O + hv -> CO + 2*H rate = ** User defined ** ( 34) + jch3cho ( 35) CH3CHO + hv -> CH3O2 + CO + HO2 rate = ** User defined ** ( 35) + jacet ( 36) CH3COCH3 + hv -> CH3CO3 + CH3O2 rate = ** User defined ** ( 36) + jmgly ( 37) CH3COCHO + hv -> CH3CO3 + CO + HO2 rate = ** User defined ** ( 37) + jch3co3h ( 38) CH3COOOH + hv -> CH3O2 + OH + CO2 rate = ** User defined ** ( 38) + jch3ooh ( 39) CH3OOH + hv -> CH2O + H + OH rate = ** User defined ** ( 39) + jch4_b ( 40) CH4 + hv -> 1.44*H2 + 0.18*CH2O + 0.18*O + 0.33*OH + 0.33*H rate = ** User defined ** ( 40) + + 0.44*CO2 + 0.38*CO + 0.05*H2O + jch4_a ( 41) CH4 + hv -> H + CH3O2 rate = ** User defined ** ( 41) + jco2 ( 42) CO2 + hv -> CO + O rate = ** User defined ** ( 42) + jeooh ( 43) EOOH + hv -> EO + OH rate = ** User defined ** ( 43) + jglyald ( 44) GLYALD + hv -> 2*HO2 + CO + CH2O rate = ** User defined ** ( 44) + jglyoxal ( 45) GLYOXAL + hv -> 2*CO + 2*HO2 rate = ** User defined ** ( 45) + jhonitr ( 46) HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO rate = ** User defined ** ( 46) + + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + + 0.17*CH3COCH3 + jhpald ( 47) HPALD + hv -> BIGALD3 + OH + HO2 rate = ** User defined ** ( 47) + jhyac ( 48) HYAC + hv -> CH3CO3 + HO2 + CH2O rate = ** User defined ** ( 48) + jisopnooh ( 49) ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH rate = ** User defined ** ( 49) + jisopooh ( 50) ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + CH2O + HO2 rate = ** User defined ** ( 50) + jmacr_a ( 51) MACR + hv -> 1.34*HO2 + 0.66*MCO3 + 1.34*CH2O + 1.34*CH3CO3 rate = ** User defined ** ( 51) + jmacr_b ( 52) MACR + hv -> 0.66*HO2 + 1.34*CO rate = ** User defined ** ( 52) + jmek ( 53) MEK + hv -> CH3CO3 + C2H5O2 rate = ** User defined ** ( 53) + jmekooh ( 54) MEKOOH + hv -> OH + CH3CO3 + CH3CHO rate = ** User defined ** ( 54) + jmpan ( 55) MPAN + hv -> MCO3 + NO2 rate = ** User defined ** ( 55) + jmvk ( 56) MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 rate = ** User defined ** ( 56) + jnc4cho ( 57) NC4CHO + hv -> BIGALD3 + NO2 + HO2 rate = ** User defined ** ( 57) + jnoa ( 58) NOA + hv -> NO2 + CH2O + CH3CO3 rate = ** User defined ** ( 58) + jnterpooh ( 59) NTERPOOH + hv -> TERPROD1 + NO2 + OH rate = ** User defined ** ( 59) + jonitr ( 60) ONITR + hv -> NO2 rate = ** User defined ** ( 60) + jpan ( 61) PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 rate = ** User defined ** ( 61) + jphenooh ( 62) PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL rate = ** User defined ** ( 62) + jpooh ( 63) POOH + hv -> CH3CHO + CH2O + HO2 + OH rate = ** User defined ** ( 63) + jrooh ( 64) ROOH + hv -> CH3CO3 + CH2O + OH rate = ** User defined ** ( 64) + jtepomuc ( 65) TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO rate = ** User defined ** ( 65) + jterp2ooh ( 66) TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 rate = ** User defined ** ( 66) + + TERPROD2 + HO2 + 0.25*GLYALD + jterpnit ( 67) TERPNIT + hv -> TERPROD1 + NO2 + HO2 rate = ** User defined ** ( 67) + jterpooh ( 68) TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH rate = ** User defined ** ( 68) + jterprd1 ( 69) TERPROD1 + hv -> HO2 + CO + TERPROD2 rate = ** User defined ** ( 69) + jterprd2 ( 70) TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 rate = ** User defined ** ( 70) + + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO + jtolooh ( 71) TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = ** User defined ** ( 71) + + 0.2*BIGALD2 + 0.2*BIGALD3 + jxooh ( 72) XOOH + hv -> OH rate = ** User defined ** ( 72) + jxylenooh ( 73) XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = ** User defined ** ( 73) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + jxylolooh ( 74) XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 rate = ** User defined ** ( 74) + jbrcl ( 75) BRCL + hv -> BR + CL rate = ** User defined ** ( 75) + jbro ( 76) BRO + hv -> BR + O rate = ** User defined ** ( 76) + jbrono2_b ( 77) BRONO2 + hv -> BRO + NO2 rate = ** User defined ** ( 77) + jbrono2_a ( 78) BRONO2 + hv -> BR + NO3 rate = ** User defined ** ( 78) + jccl4 ( 79) CCL4 + hv -> 4*CL rate = ** User defined ** ( 79) + jcf2clbr ( 80) CF2CLBR + hv -> BR + CL + COF2 rate = ** User defined ** ( 80) + jcf3br ( 81) CF3BR + hv -> BR + F + COF2 rate = ** User defined ** ( 81) + jcfcl3 ( 82) CFC11 + hv -> 2*CL + COFCL rate = ** User defined ** ( 82) + jcfc113 ( 83) CFC113 + hv -> 2*CL + COFCL + COF2 rate = ** User defined ** ( 83) + jcfc114 ( 84) CFC114 + hv -> 2*CL + 2*COF2 rate = ** User defined ** ( 84) + jcfc115 ( 85) CFC115 + hv -> CL + F + 2*COF2 rate = ** User defined ** ( 85) + jcf2cl2 ( 86) CFC12 + hv -> 2*CL + COF2 rate = ** User defined ** ( 86) + jch2br2 ( 87) CH2BR2 + hv -> 2*BR rate = ** User defined ** ( 87) + jch3br ( 88) CH3BR + hv -> BR + CH3O2 rate = ** User defined ** ( 88) + jch3ccl3 ( 89) CH3CCL3 + hv -> 3*CL rate = ** User defined ** ( 89) + jch3cl ( 90) CH3CL + hv -> CL + CH3O2 rate = ** User defined ** ( 90) + jchbr3 ( 91) CHBR3 + hv -> 3*BR rate = ** User defined ** ( 91) + jcl2 ( 92) CL2 + hv -> 2*CL rate = ** User defined ** ( 92) + jcl2o2 ( 93) CL2O2 + hv -> 2*CL rate = ** User defined ** ( 93) + jclo ( 94) CLO + hv -> CL + O rate = ** User defined ** ( 94) + jclono2_a ( 95) CLONO2 + hv -> CL + NO3 rate = ** User defined ** ( 95) + jclono2_b ( 96) CLONO2 + hv -> CLO + NO2 rate = ** User defined ** ( 96) + jcof2 ( 97) COF2 + hv -> 2*F rate = ** User defined ** ( 97) + jcofcl ( 98) COFCL + hv -> F + CL rate = ** User defined ** ( 98) + jh2402 ( 99) H2402 + hv -> 2*BR + 2*COF2 rate = ** User defined ** ( 99) + jhbr (100) HBR + hv -> BR + H rate = ** User defined ** (100) + jhcfc141b (101) HCFC141B + hv -> CL + COFCL rate = ** User defined ** (101) + jhcfc142b (102) HCFC142B + hv -> CL + COF2 rate = ** User defined ** (102) + jhcfc22 (103) HCFC22 + hv -> CL + COF2 rate = ** User defined ** (103) + jhcl (104) HCL + hv -> H + CL rate = ** User defined ** (104) + jhf (105) HF + hv -> H + F rate = ** User defined ** (105) + jhobr (106) HOBR + hv -> BR + OH rate = ** User defined ** (106) + jhocl (107) HOCL + hv -> OH + CL rate = ** User defined ** (107) + joclo (108) OCLO + hv -> O + CLO rate = ** User defined ** (108) + jsf6 (109) SF6 + hv -> {sink} rate = ** User defined ** (109) + jeuv_26 (110) CO2 + hv -> CO + O rate = ** User defined ** (110) + jeuv_4 (111) N + hv -> Np + e rate = ** User defined ** (111) + jeuv_13 (112) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** (112) + jeuv_11 (113) N2 + hv -> N2D + Np + e rate = ** User defined ** (113) + jeuv_6 (114) N2 + hv -> N2p + e rate = ** User defined ** (114) + jeuv_10 (115) N2 + hv -> N + Np + e rate = ** User defined ** (115) + jeuv_22 (116) N2 + hv -> N + Np + e rate = ** User defined ** (116) + jeuv_23 (117) N2 + hv -> N2D + Np + e rate = ** User defined ** (117) + jeuv_25 (118) N2 + hv -> 1.2*N2D + 0.8*N rate = ** User defined ** (118) + jeuv_18 (119) N2 + hv -> N2p + e rate = ** User defined ** (119) + jeuv_2 (120) O + hv -> Op + e rate = ** User defined ** (120) + jeuv_1 (121) O + hv -> Op + e rate = ** User defined ** (121) + jeuv_16 (122) O + hv -> Op + e rate = ** User defined ** (122) + jeuv_15 (123) O + hv -> Op + e rate = ** User defined ** (123) + jeuv_14 (124) O + hv -> Op + e rate = ** User defined ** (124) + jeuv_3 (125) O + hv -> Op + e rate = ** User defined ** (125) + jeuv_17 (126) O2 + hv -> O2p + e rate = ** User defined ** (126) + jeuv_9 (127) O2 + hv -> O + Op + e rate = ** User defined ** (127) + jeuv_8 (128) O2 + hv -> O + Op + e rate = ** User defined ** (128) + jeuv_7 (129) O2 + hv -> O + Op + e rate = ** User defined ** (129) + jeuv_5 (130) O2 + hv -> O2p + e rate = ** User defined ** (130) + jeuv_19 (131) O2 + hv -> O + Op + e rate = ** User defined ** (131) + jeuv_20 (132) O2 + hv -> O + Op + e rate = ** User defined ** (132) + jeuv_21 (133) O2 + hv -> O + Op + e rate = ** User defined ** (133) + jeuv_24 (134) O2 + hv -> 2*O rate = ** User defined ** (134) + jeuv_12 (135) O2 + hv -> 2*O rate = ** User defined ** (135) + jh2so4 (136) H2SO4 + hv -> SO3 + H2O rate = ** User defined ** (136) + jocs (137) OCS + hv -> S + CO rate = ** User defined ** (137) + jso (138) SO + hv -> S + O rate = ** User defined ** (138) + jso2 (139) SO2 + hv -> SO + O rate = ** User defined ** (139) + jso3 (140) SO3 + hv -> SO2 + O rate = ** User defined ** (140) + jsoabb1_a1 (141) soabb1_a1 + hv -> (No products) rate = ** User defined ** (141) + jsoabb1_a2 (142) soabb1_a2 + hv -> (No products) rate = ** User defined ** (142) + jsoabb2_a1 (143) soabb2_a1 + hv -> (No products) rate = ** User defined ** (143) + jsoabb2_a2 (144) soabb2_a2 + hv -> (No products) rate = ** User defined ** (144) + jsoabb3_a1 (145) soabb3_a1 + hv -> (No products) rate = ** User defined ** (145) + jsoabb3_a2 (146) soabb3_a2 + hv -> (No products) rate = ** User defined ** (146) + jsoabb4_a1 (147) soabb4_a1 + hv -> (No products) rate = ** User defined ** (147) + jsoabb4_a2 (148) soabb4_a2 + hv -> (No products) rate = ** User defined ** (148) + jsoabb5_a1 (149) soabb5_a1 + hv -> (No products) rate = ** User defined ** (149) + jsoabb5_a2 (150) soabb5_a2 + hv -> (No products) rate = ** User defined ** (150) + jsoabg1_a1 (151) soabg1_a1 + hv -> (No products) rate = ** User defined ** (151) + jsoabg1_a2 (152) soabg1_a2 + hv -> (No products) rate = ** User defined ** (152) + jsoabg2_a1 (153) soabg2_a1 + hv -> (No products) rate = ** User defined ** (153) + jsoabg2_a2 (154) soabg2_a2 + hv -> (No products) rate = ** User defined ** (154) + jsoabg3_a1 (155) soabg3_a1 + hv -> (No products) rate = ** User defined ** (155) + jsoabg3_a2 (156) soabg3_a2 + hv -> (No products) rate = ** User defined ** (156) + jsoabg4_a1 (157) soabg4_a1 + hv -> (No products) rate = ** User defined ** (157) + jsoabg4_a2 (158) soabg4_a2 + hv -> (No products) rate = ** User defined ** (158) + jsoabg5_a1 (159) soabg5_a1 + hv -> (No products) rate = ** User defined ** (159) + jsoabg5_a2 (160) soabg5_a2 + hv -> (No products) rate = ** User defined ** (160) + jsoaff1_a1 (161) soaff1_a1 + hv -> (No products) rate = ** User defined ** (161) + jsoaff1_a2 (162) soaff1_a2 + hv -> (No products) rate = ** User defined ** (162) + jsoaff2_a1 (163) soaff2_a1 + hv -> (No products) rate = ** User defined ** (163) + jsoaff2_a2 (164) soaff2_a2 + hv -> (No products) rate = ** User defined ** (164) + jsoaff3_a1 (165) soaff3_a1 + hv -> (No products) rate = ** User defined ** (165) + jsoaff3_a2 (166) soaff3_a2 + hv -> (No products) rate = ** User defined ** (166) + jsoaff4_a1 (167) soaff4_a1 + hv -> (No products) rate = ** User defined ** (167) + jsoaff4_a2 (168) soaff4_a2 + hv -> (No products) rate = ** User defined ** (168) + jsoaff5_a1 (169) soaff5_a1 + hv -> (No products) rate = ** User defined ** (169) + jsoaff5_a2 (170) soaff5_a2 + hv -> (No products) rate = ** User defined ** (170) + + Reactions + ag1 ( 1) O2_1D -> O2 rate = 2.58E-04 (171) + ag2 ( 2) O2_1S -> O2 rate = 8.50E-02 (172) + O1D_H2 ( 3) O1D + H2 -> H + OH rate = 1.20E-10 (173) + O1D_H2O ( 4) O1D + H2O -> 2*OH rate = 1.63E-10*exp( 60./t) (174) + O1D_N2 ( 5) O1D + N2 -> O + N2 rate = 2.15E-11*exp( 110./t) (175) + O1D_O2 ( 6) O1D + O2 -> O + O2_1S rate = 2.64E-11*exp( 55./t) (176) + O1D_O2b ( 7) O1D + O2 -> O + O2 rate = 6.60E-12*exp( 55./t) (177) + O1D_O3 ( 8) O1D + O3 -> O2 + O2 rate = 1.20E-10 (178) + O2_1D_N2 ( 9) O2_1D + N2 -> O2 + N2 rate = 1.00E-20 (179) + O2_1D_O ( 10) O2_1D + O -> O2 + O rate = 1.30E-16 (180) + O2_1D_O2 ( 11) O2_1D + O2 -> 2*O2 rate = 3.60E-18*exp( -220./t) (181) + O2_1S_CO2 ( 12) O2_1S + CO2 -> O2_1D + CO2 rate = 4.20E-13 (182) + O2_1S_N2 ( 13) O2_1S + N2 -> O2_1D + N2 rate = 1.80E-15*exp( 45./t) (183) + O2_1S_O ( 14) O2_1S + O -> O2_1D + O rate = 8.00E-14 (184) + O2_1S_O2 ( 15) O2_1S + O2 -> O2_1D + O2 rate = 3.90E-17 (185) + O2_1S_O3 ( 16) O2_1S + O3 -> O2_1D + O3 rate = 3.50E-11*exp( -135./t) (186) + O_O3 ( 17) O + O3 -> 2*O2 rate = 8.00E-12*exp( -2060./t) (187) + usr_O_O ( 18) O + O + M -> O2 + M rate = ** User defined ** (188) + usr_O_O2 ( 19) O + O2 + M -> O3 + M rate = ** User defined ** (189) + H2_O ( 20) H2 + O -> OH + H rate = 1.60E-11*exp( -4570./t) (190) + H2O2_O ( 21) H2O2 + O -> OH + HO2 rate = 1.40E-12*exp( -2000./t) (191) + H_HO2 ( 22) H + HO2 -> H2 + O2 rate = 6.90E-12 (192) + H_HO2a ( 23) H + HO2 -> 2*OH rate = 7.20E-11 (193) + H_HO2b ( 24) H + HO2 -> H2O + O rate = 1.60E-12 (194) + H_O2 ( 25) H + O2 + M -> HO2 + M troe : ko=5.30E-32*(300/t)**1.80 (195) + ki=9.50E-11*(300/t)**-0.40 + f=0.60 + HO2_O ( 26) HO2 + O -> OH + O2 rate = 3.00E-11*exp( 200./t) (196) + HO2_O3 ( 27) HO2 + O3 -> OH + 2*O2 rate = 1.00E-14*exp( -490./t) (197) + H_O3 ( 28) H + O3 -> OH + O2 rate = 1.40E-10*exp( -470./t) (198) + OH_H2 ( 29) OH + H2 -> H2O + H rate = 2.80E-12*exp( -1800./t) (199) + OH_H2O2 ( 30) OH + H2O2 -> H2O + HO2 rate = 1.80E-12 (200) + OH_HO2 ( 31) OH + HO2 -> H2O + O2 rate = 4.80E-11*exp( 250./t) (201) + OH_O ( 32) OH + O -> H + O2 rate = 1.80E-11*exp( 180./t) (202) + OH_O3 ( 33) OH + O3 -> HO2 + O2 rate = 1.70E-12*exp( -940./t) (203) + OH_OH ( 34) OH + OH -> H2O + O rate = 1.80E-12 (204) + OH_OH_M ( 35) OH + OH + M -> H2O2 + M troe : ko=6.90E-31*(300/t)**1.00 (205) + ki=2.60E-11 + f=0.60 + usr_HO2_HO2 ( 36) HO2 + HO2 -> H2O2 + O2 rate = ** User defined ** (206) + HO2NO2_OH ( 37) HO2NO2 + OH -> H2O + NO2 + O2 rate = 4.50E-13*exp( 610./t) (207) + N2D_O ( 38) N2D + O -> N + O rate = 7.00E-13 (208) + N2D_O2 ( 39) N2D + O2 -> NO + O1D rate = 5.00E-12 (209) + N_NO ( 40) N + NO -> N2 + O rate = 2.10E-11*exp( 100./t) (210) + N_NO2a ( 41) N + NO2 -> N2O + O rate = 2.90E-12*exp( 220./t) (211) + N_NO2b ( 42) N + NO2 -> 2*NO rate = 1.45E-12*exp( 220./t) (212) + N_NO2c ( 43) N + NO2 -> N2 + O2 rate = 1.45E-12*exp( 220./t) (213) + N_O2 ( 44) N + O2 -> NO + O rate = 3.30E-12*exp( -3150./t) (214) + NO2_O ( 45) NO2 + O -> NO + O2 rate = 5.10E-12*exp( 210./t) (215) + NO2_O3 ( 46) NO2 + O3 -> NO3 + O2 rate = 1.20E-13*exp( -2450./t) (216) + NO2_O_M ( 47) NO2 + O + M -> NO3 + M troe : ko=2.50E-31*(300/t)**1.80 (217) + ki=2.20E-11*(300/t)**0.70 + f=0.60 + NO3_HO2 ( 48) NO3 + HO2 -> OH + NO2 + O2 rate = 3.50E-12 (218) + NO3_NO ( 49) NO3 + NO -> 2*NO2 rate = 1.70E-11*exp( 125./t) (219) + NO3_O ( 50) NO3 + O -> NO2 + O2 rate = 1.30E-11 (220) + NO3_OH ( 51) NO3 + OH -> HO2 + NO2 rate = 2.20E-11 (221) + N_OH ( 52) N + OH -> NO + H rate = 5.00E-11 (222) + NO_HO2 ( 53) NO + HO2 -> NO2 + OH rate = 3.44E-12*exp( 260./t) (223) + NO_O3 ( 54) NO + O3 -> NO2 + O2 rate = 3.00E-12*exp( -1500./t) (224) + NO_O_M ( 55) NO + O + M -> NO2 + M troe : ko=9.00E-32*(300/t)**1.50 (225) + ki=3.00E-11 + f=0.60 + O1D_N2Oa ( 56) O1D + N2O -> 2*NO rate = 7.26E-11*exp( 20./t) (226) + O1D_N2Ob ( 57) O1D + N2O -> N2 + O2 rate = 4.64E-11*exp( 20./t) (227) + tag_NO2_HO2 ( 58) NO2 + HO2 + M -> HO2NO2 + M troe : ko=1.90E-31*(300/t)**3.40 (228) + ki=4.00E-12*(300/t)**0.30 + f=0.60 + tag_NO2_NO3 ( 59) NO2 + NO3 + M -> N2O5 + M troe : ko=2.40E-30*(300/t)**3.00 (229) + ki=1.60E-12*(300/t)**-0.10 + f=0.60 + tag_NO2_OH ( 60) NO2 + OH + M -> HNO3 + M troe : ko=1.80E-30*(300/t)**3.00 (230) + ki=2.80E-11 + f=0.60 + usr_HNO3_OH ( 61) HNO3 + OH -> NO3 + H2O rate = ** User defined ** (231) + usr_HO2NO2_M ( 62) HO2NO2 + M -> HO2 + NO2 + M rate = ** User defined ** (232) + usr_N2O5_M ( 63) N2O5 + M -> NO2 + NO3 + M rate = ** User defined ** (233) + CL_CH2O ( 64) CL + CH2O -> HCL + HO2 + CO rate = 8.10E-11*exp( -30./t) (234) + CL_CH4 ( 65) CL + CH4 -> CH3O2 + HCL rate = 7.10E-12*exp( -1270./t) (235) + CL_H2 ( 66) CL + H2 -> HCL + H rate = 3.05E-11*exp( -2270./t) (236) + CL_H2O2 ( 67) CL + H2O2 -> HCL + HO2 rate = 1.10E-11*exp( -980./t) (237) + CL_HO2a ( 68) CL + HO2 -> HCL + O2 rate = 1.40E-11*exp( 270./t) (238) + CL_HO2b ( 69) CL + HO2 -> OH + CLO rate = 3.60E-11*exp( -375./t) (239) + CL_O3 ( 70) CL + O3 -> CLO + O2 rate = 2.30E-11*exp( -200./t) (240) + CLO_CH3O2 ( 71) CLO + CH3O2 -> CL + HO2 + CH2O rate = 3.30E-12*exp( -115./t) (241) + CLO_CLOa ( 72) CLO + CLO -> 2*CL + O2 rate = 3.00E-11*exp( -2450./t) (242) + CLO_CLOb ( 73) CLO + CLO -> CL2 + O2 rate = 1.00E-12*exp( -1590./t) (243) + CLO_CLOc ( 74) CLO + CLO -> CL + OCLO rate = 3.50E-13*exp( -1370./t) (244) + CLO_HO2 ( 75) CLO + HO2 -> O2 + HOCL rate = 2.60E-12*exp( 290./t) (245) + CLO_NO ( 76) CLO + NO -> NO2 + CL rate = 6.40E-12*exp( 290./t) (246) + CLONO2_CL ( 77) CLONO2 + CL -> CL2 + NO3 rate = 6.50E-12*exp( 135./t) (247) + CLO_NO2_M ( 78) CLO + NO2 + M -> CLONO2 + M troe : ko=1.80E-31*(300/t)**3.40 (248) + ki=1.50E-11*(300/t)**1.90 + f=0.60 + CLONO2_O ( 79) CLONO2 + O -> CLO + NO3 rate = 3.60E-12*exp( -840./t) (249) + CLONO2_OH ( 80) CLONO2 + OH -> HOCL + NO3 rate = 1.20E-12*exp( -330./t) (250) + CLO_O ( 81) CLO + O -> CL + O2 rate = 2.80E-11*exp( 85./t) (251) + CLO_OHa ( 82) CLO + OH -> CL + HO2 rate = 7.40E-12*exp( 270./t) (252) + CLO_OHb ( 83) CLO + OH -> HCL + O2 rate = 6.00E-13*exp( 230./t) (253) + HCL_O ( 84) HCL + O -> CL + OH rate = 1.00E-11*exp( -3300./t) (254) + HCL_OH ( 85) HCL + OH -> H2O + CL rate = 1.80E-12*exp( -250./t) (255) + HOCL_CL ( 86) HOCL + CL -> HCL + CLO rate = 3.40E-12*exp( -130./t) (256) + HOCL_O ( 87) HOCL + O -> CLO + OH rate = 1.70E-13 (257) + HOCL_OH ( 88) HOCL + OH -> H2O + CLO rate = 3.00E-12*exp( -500./t) (258) + O1D_CCL4 ( 89) O1D + CCL4 -> 4*CL rate = 2.61E-10 (259) + O1D_CF2CLBR ( 90) O1D + CF2CLBR -> CL + BR + COF2 rate = 9.75E-11 (260) + O1D_CFC11 ( 91) O1D + CFC11 -> 2*CL + COFCL rate = 2.07E-10 (261) + O1D_CFC113 ( 92) O1D + CFC113 -> 2*CL + COFCL + COF2 rate = 2.09E-10 (262) + O1D_CFC114 ( 93) O1D + CFC114 -> 2*CL + 2*COF2 rate = 1.17E-10 (263) + O1D_CFC115 ( 94) O1D + CFC115 -> CL + F + 2*COF2 rate = 4.64E-11 (264) + O1D_CFC12 ( 95) O1D + CFC12 -> 2*CL + COF2 rate = 1.20E-10 (265) + O1D_HCLa ( 96) O1D + HCL -> CL + OH rate = 9.90E-11 (266) + O1D_HCLb ( 97) O1D + HCL -> CLO + H rate = 3.30E-12 (267) + tag_CLO_CLO_M ( 98) CLO + CLO + M -> CL2O2 + M troe : ko=1.90E-32*(300/t)**3.60 (268) + ki=3.70E-12*(300/t)**1.60 + f=0.60 + usr_CL2O2_M ( 99) CL2O2 + M -> CLO + CLO + M rate = ** User defined ** (269) + BR_CH2O (100) BR + CH2O -> HBR + HO2 + CO rate = 1.70E-11*exp( -800./t) (270) + BR_HO2 (101) BR + HO2 -> HBR + O2 rate = 4.80E-12*exp( -310./t) (271) + BR_O3 (102) BR + O3 -> BRO + O2 rate = 1.60E-11*exp( -780./t) (272) + BRO_BRO (103) BRO + BRO -> 2*BR + O2 rate = 1.50E-12*exp( 230./t) (273) + BRO_CLOa (104) BRO + CLO -> BR + OCLO rate = 9.50E-13*exp( 550./t) (274) + BRO_CLOb (105) BRO + CLO -> BR + CL + O2 rate = 2.30E-12*exp( 260./t) (275) + BRO_CLOc (106) BRO + CLO -> BRCL + O2 rate = 4.10E-13*exp( 290./t) (276) + BRO_HO2 (107) BRO + HO2 -> HOBR + O2 rate = 4.50E-12*exp( 460./t) (277) + BRO_NO (108) BRO + NO -> BR + NO2 rate = 8.80E-12*exp( 260./t) (278) + BRO_NO2_M (109) BRO + NO2 + M -> BRONO2 + M troe : ko=5.20E-31*(300/t)**3.20 (279) + ki=6.90E-12*(300/t)**2.90 + f=0.60 + BRONO2_O (110) BRONO2 + O -> BRO + NO3 rate = 1.90E-11*exp( 215./t) (280) + BRO_O (111) BRO + O -> BR + O2 rate = 1.90E-11*exp( 230./t) (281) + BRO_OH (112) BRO + OH -> BR + HO2 rate = 1.70E-11*exp( 250./t) (282) + HBR_O (113) HBR + O -> BR + OH rate = 5.80E-12*exp( -1500./t) (283) + HBR_OH (114) HBR + OH -> BR + H2O rate = 5.50E-12*exp( 200./t) (284) + HOBR_O (115) HOBR + O -> BRO + OH rate = 1.20E-10*exp( -430./t) (285) + O1D_CF3BR (116) O1D + CF3BR -> BR + F + COF2 rate = 4.50E-11 (286) + O1D_CHBR3 (117) O1D + CHBR3 -> 3*BR rate = 4.62E-10 (287) + O1D_H2402 (118) O1D + H2402 -> 2*BR + 2*COF2 rate = 1.20E-10 (288) + O1D_HBRa (119) O1D + HBR -> BR + OH rate = 9.00E-11 (289) + O1D_HBRb (120) O1D + HBR -> BRO + H rate = 3.00E-11 (290) + F_CH4 (121) F + CH4 -> HF + CH3O2 rate = 1.60E-10*exp( -260./t) (291) + F_H2 (122) F + H2 -> HF + H rate = 1.40E-10*exp( -500./t) (292) + F_H2O (123) F + H2O -> HF + OH rate = 1.40E-11 (293) + F_HNO3 (124) F + HNO3 -> HF + NO3 rate = 6.00E-12*exp( 400./t) (294) + O1D_COF2 (125) O1D + COF2 -> 2*F rate = 2.14E-11 (295) + O1D_COFCL (126) O1D + COFCL -> F + CL rate = 1.90E-10 (296) + CH2BR2_CL (127) CH2BR2 + CL -> 2*BR + HCL rate = 6.30E-12*exp( -800./t) (297) + CH2BR2_OH (128) CH2BR2 + OH -> 2*BR + H2O rate = 2.00E-12*exp( -840./t) (298) + CH3BR_CL (129) CH3BR + CL -> HCL + HO2 + BR rate = 1.46E-11*exp( -1040./t) (299) + CH3BR_OH (130) CH3BR + OH -> BR + H2O + HO2 rate = 1.42E-12*exp( -1150./t) (300) + CH3CCL3_OH (131) CH3CCL3 + OH -> H2O + 3*CL rate = 1.64E-12*exp( -1520./t) (301) + CH3CL_CL (132) CH3CL + CL -> HO2 + CO + 2*HCL rate = 2.03E-11*exp( -1100./t) (302) + CH3CL_OH (133) CH3CL + OH -> CL + H2O + HO2 rate = 1.96E-12*exp( -1200./t) (303) + CHBR3_CL (134) CHBR3 + CL -> 3*BR + HCL rate = 4.85E-12*exp( -850./t) (304) + CHBR3_OH (135) CHBR3 + OH -> 3*BR rate = 9.00E-13*exp( -360./t) (305) + HCFC141B_OH (136) HCFC141B + OH -> CL + COFCL rate = 1.25E-12*exp( -1600./t) (306) + HCFC142B_OH (137) HCFC142B + OH -> CL + COF2 rate = 1.30E-12*exp( -1770./t) (307) + HCFC22_OH (138) HCFC22 + OH -> H2O + CL + COF2 rate = 9.20E-13*exp( -1560./t) (308) + O1D_CH2BR2 (139) O1D + CH2BR2 -> 2*BR rate = 2.57E-10 (309) + O1D_CH3BR (140) O1D + CH3BR -> BR rate = 1.80E-10 (310) + O1D_HCFC141B (141) O1D + HCFC141B -> CL + COFCL rate = 1.79E-10 (311) + O1D_HCFC142B (142) O1D + HCFC142B -> CL + COF2 rate = 1.30E-10 (312) + O1D_HCFC22 (143) O1D + HCFC22 -> CL + COF2 rate = 7.65E-11 (313) + CH2O_HO2 (144) CH2O + HO2 -> HOCH2OO rate = 9.70E-15*exp( 625./t) (314) + CH2O_NO3 (145) CH2O + NO3 -> CO + HO2 + HNO3 rate = 6.00E-13*exp( -2058./t) (315) + CH2O_O (146) CH2O + O -> HO2 + OH + CO rate = 3.40E-11*exp( -1600./t) (316) + CH2O_OH (147) CH2O + OH -> CO + H2O + H rate = 5.50E-12*exp( 125./t) (317) + CH3O2_CH3O2a (148) CH3O2 + CH3O2 -> 2*CH2O + 2*HO2 rate = 5.00E-13*exp( -424./t) (318) + CH3O2_CH3O2b (149) CH3O2 + CH3O2 -> CH2O + CH3OH rate = 1.90E-14*exp( 706./t) (319) + CH3O2_HO2 (150) CH3O2 + HO2 -> CH3OOH + O2 rate = 4.10E-13*exp( 750./t) (320) + CH3O2_NO (151) CH3O2 + NO -> CH2O + NO2 + HO2 rate = 2.80E-12*exp( 300./t) (321) + CH3OH_OH (152) CH3OH + OH -> HO2 + CH2O rate = 2.90E-12*exp( -345./t) (322) + CH3OOH_OH (153) CH3OOH + OH -> 0.7*CH3O2 + 0.3*OH + 0.3*CH2O + H2O rate = 3.80E-12*exp( 200./t) (323) + CH4_OH (154) CH4 + OH -> CH3O2 + H2O rate = 2.45E-12*exp( -1775./t) (324) + HCN_OH (155) HCN + OH + M -> HO2 + M troe : ko=6.10E-33*(300/t)**1.50 (325) + ki=9.80E-15*(300/t)**-4.60 + f=0.80 + HCOOH_OH (156) HCOOH + OH -> HO2 + CO2 + H2O rate = 4.00E-13 (326) + HOCH2OO_HO2 (157) HOCH2OO + HO2 -> HCOOH rate = 7.50E-13*exp( 700./t) (327) + HOCH2OO_M (158) HOCH2OO -> CH2O + HO2 rate = 2.40E+12*exp( -7000./t) (328) + HOCH2OO_NO (159) HOCH2OO + NO -> HCOOH + NO2 + HO2 rate = 2.60E-12*exp( 265./t) (329) + O1D_CH4a (160) O1D + CH4 -> CH3O2 + OH rate = 1.31E-10 (330) + O1D_CH4b (161) O1D + CH4 -> CH2O + H + HO2 rate = 3.50E-11 (331) + O1D_CH4c (162) O1D + CH4 -> CH2O + H2 rate = 9.00E-12 (332) + O1D_HCN (163) O1D + HCN -> OH rate = 1.08E-10*exp( 105./t) (333) + usr_CO_OH (164) CO + OH -> CO2 + HO2 rate = ** User defined ** (334) + C2H2_CL_M (165) C2H2 + CL + M -> CL + M troe : ko=5.20E-30*(300/t)**2.40 (335) + ki=2.20E-10*(300/t)**0.70 + f=0.60 + C2H2_OH_M (166) C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 troe : ko=5.50E-30 (336) + + 0.35*CO + M ki=8.30E-13*(300/t)**-2.00 + f=0.60 + C2H4_CL_M (167) C2H4 + CL + M -> CL + M troe : ko=1.60E-29*(300/t)**3.30 (337) + ki=3.10E-10*(300/t) + f=0.60 + C2H4_O3 (168) C2H4 + O3 -> 0.63*CO + 0.13*OH + 0.13*HO2 + 0.37*HCOOH + CH2O rate = 1.20E-14*exp( -2630./t) (338) + C2H5O2_C2H5O2 (169) C2H5O2 + C2H5O2 -> 1.6*CH3CHO + 1.2*HO2 + 0.4*C2H5OH rate = 6.80E-14 (339) + C2H5O2_CH3O2 (170) C2H5O2 + CH3O2 -> 0.7*CH2O + 0.8*CH3CHO + HO2 + 0.3*CH3OH rate = 2.00E-13 (340) + + 0.2*C2H5OH + C2H5O2_HO2 (171) C2H5O2 + HO2 -> C2H5OOH + O2 rate = 7.50E-13*exp( 700./t) (341) + C2H5O2_NO (172) C2H5O2 + NO -> CH3CHO + HO2 + NO2 rate = 2.60E-12*exp( 365./t) (342) + C2H5OH_OH (173) C2H5OH + OH -> HO2 + CH3CHO rate = 6.90E-12*exp( -230./t) (343) + C2H5OOH_OH (174) C2H5OOH + OH -> 0.5*C2H5O2 + 0.5*CH3CHO + 0.5*OH rate = 3.80E-12*exp( 200./t) (344) + C2H6_CL (175) C2H6 + CL -> HCL + C2H5O2 rate = 7.20E-11*exp( -70./t) (345) + C2H6_OH (176) C2H6 + OH -> C2H5O2 + H2O rate = 7.66E-12*exp( -1020./t) (346) + CH3CHO_NO3 (177) CH3CHO + NO3 -> CH3CO3 + HNO3 rate = 1.40E-12*exp( -1900./t) (347) + CH3CHO_OH (178) CH3CHO + OH -> CH3CO3 + H2O rate = 4.63E-12*exp( 350./t) (348) + CH3CN_OH (179) CH3CN + OH -> HO2 rate = 7.80E-13*exp( -1050./t) (349) + CH3CO3_CH3CO3 (180) CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 rate = 2.90E-12*exp( 500./t) (350) + CH3CO3_CH3O2 (181) CH3CO3 + CH3O2 -> 0.9*CH3O2 + CH2O + 0.9*HO2 + 0.9*CO2 rate = 2.00E-12*exp( 500./t) (351) + + 0.1*CH3COOH + CH3CO3_HO2 (182) CH3CO3 + HO2 -> 0.4*CH3COOOH + 0.15*CH3COOH + 0.15*O3 + 0.45*OH rate = 4.30E-13*exp( 1040./t) (352) + + 0.45*CH3O2 + CH3CO3_NO (183) CH3CO3 + NO -> CH3O2 + CO2 + NO2 rate = 8.10E-12*exp( 270./t) (353) + CH3COOH_OH (184) CH3COOH + OH -> CH3O2 + CO2 + H2O rate = 3.15E-14*exp( 920./t) (354) + CH3COOOH_OH (185) CH3COOOH + OH -> 0.5*CH3CO3 + 0.5*CH2O + 0.5*CO2 + H2O rate = 1.00E-12 (355) + EO2_HO2 (186) EO2 + HO2 -> EOOH rate = 7.50E-13*exp( 700./t) (356) + EO2_NO (187) EO2 + NO -> 0.5*CH2O + 0.25*HO2 + 0.75*EO + NO2 rate = 4.20E-12*exp( 180./t) (357) + EO_M (188) EO -> 2*CH2O + HO2 rate = 1.60E+11*exp( -4150./t) (358) + EO_O2 (189) EO + O2 -> GLYALD + HO2 rate = 1.00E-14 (359) + GLYALD_OH (190) GLYALD + OH -> HO2 + 0.2*GLYOXAL + 0.8*CH2O + 0.8*CO2 rate = 1.00E-11 (360) + GLYOXAL_OH (191) GLYOXAL + OH -> HO2 + CO + CO2 rate = 1.15E-11 (361) + PAN_OH (192) PAN + OH -> CH2O + NO3 rate = 4.00E-14 (362) + tag_C2H4_OH (193) C2H4 + OH + M -> EO2 + M troe : ko=8.60E-29*(300/t)**3.10 (363) + ki=9.00E-12*(300/t)**0.85 + f=0.48 + tag_CH3CO3_NO2 (194) CH3CO3 + NO2 + M -> PAN + M troe : ko=7.30E-29*(300/t)**4.10 (364) + ki=9.50E-12*(300/t)**1.60 + f=0.60 + usr_PAN_M (195) PAN + M -> CH3CO3 + NO2 + M rate = ** User defined ** (365) + C3H6_NO3 (196) C3H6 + NO3 -> NOA rate = 4.60E-13*exp( -1156./t) (366) + C3H6_O3 (197) C3H6 + O3 -> 0.5*CH2O + 0.12*HCOOH + 0.12*CH3COOH + 0.5*CH3CHO rate = 6.50E-15*exp( -1900./t) (367) + + 0.56*CO + 0.28*CH3O2 + 0.1*CH4 + 0.2*CO2 + 0.28*HO2 + + 0.36*OH + C3H7O2_CH3O2 (198) C3H7O2 + CH3O2 -> CH2O + HO2 + 0.82*CH3COCH3 rate = 3.75E-13*exp( -40./t) (368) + C3H7O2_HO2 (199) C3H7O2 + HO2 -> C3H7OOH + O2 rate = 7.50E-13*exp( 700./t) (369) + C3H7O2_NO (200) C3H7O2 + NO -> 0.82*CH3COCH3 + NO2 + HO2 + 0.27*CH3CHO rate = 4.20E-12*exp( 180./t) (370) + C3H7OOH_OH (201) C3H7OOH + OH -> H2O + C3H7O2 rate = 3.80E-12*exp( 200./t) (371) + C3H8_OH (202) C3H8 + OH -> C3H7O2 + H2O rate = 9.19E-12*exp( -630./t) (372) + CH3COCHO_NO3 (203) CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 rate = 1.40E-12*exp( -1860./t) (373) + CH3COCHO_OH (204) CH3COCHO + OH -> CH3CO3 + CO + H2O rate = 8.40E-13*exp( 830./t) (374) + CL_C3H8 (205) CL + C3H8 -> C3H7O2 + HCL rate = 1.45E-10 (375) + HYAC_OH (206) HYAC + OH -> CH3COCHO + HO2 rate = 3.00E-12 (376) + NOA_OH (207) NOA + OH -> NO2 + CH3COCHO rate = 6.70E-13 (377) + PO2_HO2 (208) PO2 + HO2 -> POOH + O2 rate = 7.50E-13*exp( 700./t) (378) + PO2_NO (209) PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 rate = 4.20E-12*exp( 180./t) (379) + POOH_OH (210) POOH + OH -> 0.5*PO2 + 0.5*OH + 0.5*HYAC + H2O rate = 3.80E-12*exp( 200./t) (380) + RO2_CH3O2 (211) RO2 + CH3O2 -> 0.3*CH3CO3 + 0.8*CH2O + 0.3*HO2 + 0.2*HYAC rate = 7.10E-13*exp( 500./t) (381) + + 0.5*CH3COCHO + 0.5*CH3OH + RO2_HO2 (212) RO2 + HO2 -> 0.85*ROOH + 0.15*OH + 0.15*CH2O + 0.15*CH3CO3 rate = 8.60E-13*exp( 700./t) (382) + RO2_NO (213) RO2 + NO -> CH3CO3 + CH2O + NO2 rate = 2.90E-12*exp( 300./t) (383) + ROOH_OH (214) ROOH + OH -> RO2 + H2O rate = 3.80E-12*exp( 200./t) (384) + tag_C3H6_OH (215) C3H6 + OH + M -> PO2 + M troe : ko=8.00E-27*(300/t)**3.50 (385) + ki=3.00E-11 + f=0.50 + usr_CH3COCH3_OH (216) CH3COCH3 + OH -> RO2 + H2O rate = ** User defined ** (386) + BIGENE_NO3 (217) BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 rate = 3.50E-13 (387) + BIGENE_OH (218) BIGENE + OH -> ENEO2 rate = 5.40E-11 (388) + ENEO2_NO (219) ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 rate = 4.80E-12*exp( 120./t) (389) + ENEO2_NOb (220) ENEO2 + NO -> HONITR rate = 5.10E-14*exp( 693./t) (390) + HONITR_OH (221) HONITR + OH -> ONITR + HO2 rate = 2.00E-12 (391) + MACRO2_CH3CO3 (222) MACRO2 + CH3CO3 -> 0.25*CH3COCHO + CH3O2 + 0.22*CO + 0.47*HO2 rate = 1.40E-11 (392) + + 0.53*GLYALD + 0.22*HYAC + 0.25*CH2O + + 0.53*CH3CO3 + MACRO2_CH3O2 (223) MACRO2 + CH3O2 -> 0.73*HO2 + 0.88*CH2O + 0.11*CO + 0.24*CH3COCHO rate = 5.00E-13*exp( 400./t) (393) + + 0.26*GLYALD + 0.26*CH3CO3 + 0.25*CH3OH + + 0.23*HYAC + MACRO2_HO2 (224) MACRO2 + HO2 -> MACROOH rate = 8.00E-13*exp( 700./t) (394) + MACRO2_NO3 (225) MACRO2 + NO3 -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.25*CH3COCHO rate = 2.40E-12 (395) + + 0.22*CO + 0.53*GLYALD + 0.22*HYAC + 0.53*CH3CO3 + MACRO2_NOa (226) MACRO2 + NO -> NO2 + 0.47*HO2 + 0.25*CH2O + 0.53*GLYALD rate = 2.70E-12*exp( 360./t) (396) + + 0.25*CH3COCHO + 0.53*CH3CO3 + 0.22*HYAC + 0.22*CO + MACRO2_NOb (227) MACRO2 + NO -> HONITR rate = 1.30E-13*exp( 360./t) (397) + MACR_O3 (228) MACR + O3 -> 0.12*CH2O + 0.24*OH + 0.65*CO + 0.1*CH3CO3 rate = 1.50E-15*exp( -2100./t) (398) + + 0.88*CH3COCHO + 0.33*HCOOH + 0.14*HO2 + MACR_OH (229) MACR + OH -> 0.5*MACRO2 + 0.5*H2O + 0.5*MCO3 rate = 9.60E-12*exp( 360./t) (399) + MACROOH_OH (230) MACROOH + OH -> 0.5*MCO3 + 0.2*MACRO2 + 0.1*OH + 0.2*HO2 rate = 2.30E-11*exp( 200./t) (400) + MCO3_CH3CO3 (231) MCO3 + CH3CO3 -> 2*CO2 + CH3O2 + CH2O + CH3CO3 rate = 4.60E-12*exp( 530./t) (401) + MCO3_CH3O2 (232) MCO3 + CH3O2 -> 2*CH2O + HO2 + CO2 + CH3CO3 rate = 2.00E-12*exp( 500./t) (402) + MCO3_HO2 (233) MCO3 + HO2 -> 0.15*O3 + 0.15*CH3COOH + 0.4*CH3COOOH + 0.45*OH rate = 4.30E-13*exp( 1040./t) (403) + + 0.45*CO2 + 0.45*CH2O + 0.45*CH3CO3 + MCO3_MCO3 (234) MCO3 + MCO3 -> 2*CO2 + 2*CH2O + 2*CH3CO3 rate = 2.30E-12*exp( 530./t) (404) + MCO3_NO (235) MCO3 + NO -> NO2 + CH2O + CH3CO3 rate = 5.30E-12*exp( 360./t) (405) + MCO3_NO3 (236) MCO3 + NO3 -> NO2 + CH2O + CH3CO3 rate = 5.00E-12 (406) + MEKO2_HO2 (237) MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 rate = 7.50E-13*exp( 700./t) (407) + MEKO2_NO (238) MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 rate = 4.20E-12*exp( 180./t) (408) + MEK_OH (239) MEK + OH -> MEKO2 rate = 2.30E-12*exp( -170./t) (409) + MEKOOH_OH (240) MEKOOH + OH -> MEKO2 rate = 3.80E-12*exp( 200./t) (410) + MPAN_OH_M (241) 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 (411) + + M + 0.5*NDEP ki=3.00E-11 + f=0.50 + MVK_O3 (242) MVK + O3 -> 0.6*CH2O + 0.56*CO + 0.1*CH3CHO + 0.1*CO2 + 0.28*CH3CO3 rate = 8.50E-16*exp( -1520./t) (412) + + 0.5*CH3COCHO + 0.28*HO2 + 0.36*OH + 0.12*HCOOH + MVK_OH (243) MVK + OH -> MACRO2 rate = 4.13E-12*exp( 452./t) (413) + tag_MCO3_NO2 (244) MCO3 + NO2 + M -> MPAN + M troe : ko=9.70E-29*(300/t)**5.60 (414) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + usr_MPAN_M (245) MPAN + M -> MCO3 + NO2 + M rate = ** User defined ** (415) + ALKNIT_OH (246) ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 rate = 1.60E-12 (416) + ALKO2_HO2 (247) ALKO2 + HO2 -> ALKOOH rate = 7.50E-13*exp( 700./t) (417) + ALKO2_NO (248) ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK rate = 6.70E-12 (418) + + NO2 + ALKO2_NOb (249) ALKO2 + NO -> ALKNIT rate = 5.40E-14*exp( 870./t) (419) + ALKOOH_OH (250) ALKOOH + OH -> ALKO2 rate = 3.80E-12*exp( 200./t) (420) + BIGALK_OH (251) BIGALK + OH -> ALKO2 rate = 3.50E-12 (421) + HPALD_OH (252) HPALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (422) + HYDRALD_OH (253) HYDRALD + OH -> XO2 rate = 1.86E-11*exp( 175./t) (423) + IEPOX_OH (254) IEPOX + OH -> XO2 rate = 1.30E-11 (424) + ISOPAO2_CH3CO3 (255) ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 rate = 1.40E-11 (425) + ISOPAO2_CH3O2 (256) ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR rate = 5.00E-13*exp( 400./t) (426) + + 0.44*MVK + ISOPAO2_HO2 (257) ISOPAO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (427) + ISOPAO2_NO (258) ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK rate = 4.40E-12*exp( 180./t) (428) + + 0.92*CH2O + 0.92*HO2 + ISOPAO2_NO3 (259) ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 rate = 2.40E-12 (429) + ISOPBO2_CH3CO3 (260) ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 rate = 1.40E-11 (430) + ISOPBO2_CH3O2 (261) ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD rate = 5.00E-13*exp( 400./t) (431) + ISOPBO2_HO2 (262) ISOPBO2 + HO2 -> ISOPOOH rate = 8.00E-13*exp( 700./t) (432) + ISOPBO2_M (263) ISOPBO2 -> HPALD + HO2 rate = 1.60E+09*exp( -8300./t) (433) + ISOPBO2_NO (264) ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 rate = 4.40E-12*exp( 180./t) (434) + + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + + 0.05*HYAC + ISOPBO2_NO3 (265) ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL rate = 2.40E-12 (435) + + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC + ISOPNITA_OH (266) ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O rate = 4.00E-11 (436) + + 0.3*HONITR + 0.3*HO2 + ISOPNITB_OH (267) ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR rate = 4.00E-11 (437) + ISOP_NO3 (268) ISOP + NO3 -> ISOPNO3 rate = 3.03E-12*exp( -446./t) (438) + ISOPNO3_CH3CO3 (269) ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 rate = 1.40E-11 (439) + ISOPNO3_CH3O2 (270) ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH rate = 5.00E-13*exp( 400./t) (440) + + 0.2*NC4CH2OH + ISOPNO3_HO2 (271) ISOPNO3 + HO2 -> ISOPNOOH rate = 8.00E-13*exp( 700./t) (441) + ISOPNO3_NO (272) ISOPNO3 + NO -> NC4CHO + NO2 + HO2 rate = 2.70E-12*exp( 360./t) (442) + ISOPNO3_NO3 (273) ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 rate = 2.40E-12 (443) + ISOPNOOH_OH (274) ISOPNOOH + OH -> NOA + HO2 rate = 4.00E-11 (444) + ISOP_O3 (275) ISOP + O3 -> 0.3*MACR + 0.2*MVK + 0.11*HCOOH + 0.62*CO + 0.32*OH rate = 1.05E-14*exp( -2000./t) (445) + + 0.37*HO2 + 0.91*CH2O + 0.08*CH3CO3 + 0.13*C3H6 + + 0.05*CH3O2 + ISOP_OH (276) ISOP + OH -> 0.6*ISOPAO2 + 0.4*ISOPBO2 rate = 2.54E-11*exp( 410./t) (446) + ISOPOOH_OH (277) ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH rate = 1.52E-11*exp( 200./t) (447) + NC4CH2OH_OH (278) NC4CH2OH + OH -> GLYALD + NOA + HO2 rate = 7.00E-11 (448) + NC4CHO_OH (279) NC4CHO + OH -> GLYOXAL + NOA + HO2 rate = 1.00E-10 (449) + XO2_CH3CO3 (280) XO2 + CH3CO3 -> 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL + CH3O2 + HO2 rate = 1.30E-12*exp( 640./t) (450) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + CO2 + XO2_CH3O2 (281) XO2 + CH3O2 -> 0.3*CH3OH + 0.8*HO2 + 0.8*CH2O + 0.2*CO rate = 5.00E-13*exp( 400./t) (451) + + 0.1*GLYOXAL + 0.1*CH3COCHO + 0.1*HYAC + 0.1*GLYALD + XO2_HO2 (282) XO2 + HO2 -> XOOH rate = 8.00E-13*exp( 700./t) (452) + XO2_NO (283) XO2 + NO -> NO2 + HO2 + 0.25*CO + 0.25*CH2O + 0.25*GLYOXAL rate = 2.70E-12*exp( 360./t) (453) + + 0.25*CH3COCHO + 0.25*HYAC + 0.25*GLYALD + XO2_NO3 (284) XO2 + NO3 -> NO2 + HO2 + 0.5*CO + 0.25*HYAC + 0.25*GLYOXAL rate = 2.40E-12 (454) + + 0.25*CH3COCHO + 0.25*GLYALD + XOOH_OH (285) XOOH + OH -> 0.5*XO2 + 0.5*OH rate = 1.52E-12*exp( 200./t) (455) + ACBZO2_HO2 (286) ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH rate = 4.30E-13*exp( 1040./t) (456) + ACBZO2_NO (287) ACBZO2 + NO -> C6H5O2 + NO2 rate = 7.50E-12*exp( 290./t) (457) + BENZENE_OH (288) BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 rate = 2.30E-12*exp( -193./t) (458) + BENZO2_HO2 (289) BENZO2 + HO2 -> BENZOOH rate = 7.50E-13*exp( 700./t) (459) + BENZO2_NO (290) BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 rate = 2.60E-12*exp( 365./t) (460) + BENZOOH_OH (291) BENZOOH + OH -> BENZO2 rate = 3.80E-12*exp( 200./t) (461) + BZALD_OH (292) BZALD + OH -> ACBZO2 rate = 5.90E-12*exp( 225./t) (462) + BZOO_HO2 (293) BZOO + HO2 -> BZOOH rate = 7.50E-13*exp( 700./t) (463) + BZOOH_OH (294) BZOOH + OH -> BZOO rate = 3.80E-12*exp( 200./t) (464) + BZOO_NO (295) BZOO + NO -> BZALD + NO2 + HO2 rate = 2.60E-12*exp( 365./t) (465) + C6H5O2_HO2 (296) C6H5O2 + HO2 -> C6H5OOH rate = 7.50E-13*exp( 700./t) (466) + C6H5O2_NO (297) C6H5O2 + NO -> PHENO + NO2 rate = 2.60E-12*exp( 365./t) (467) + C6H5OOH_OH (298) C6H5OOH + OH -> C6H5O2 rate = 3.80E-12*exp( 200./t) (468) + CRESOL_OH (299) CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO rate = 4.70E-11 (469) + DICARBO2_HO2 (300) DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO rate = 4.30E-13*exp( 1040./t) (470) + + 0.33*CH3O2 + DICARBO2_NO (301) DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO rate = 7.50E-12*exp( 290./t) (471) + + 0.83*CH3O2 + DICARBO2_NO2 (302) DICARBO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (472) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MALO2_HO2 (303) MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO rate = 4.30E-13*exp( 1040./t) (473) + MALO2_NO (304) MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 rate = 7.50E-12*exp( 290./t) (474) + MALO2_NO2 (305) MALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (475) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + MDIALO2_HO2 (306) MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO rate = 4.30E-13*exp( 1040./t) (476) + + 0.07*CH3O2 + 0.07*GLYOXAL + MDIALO2_NO (307) MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO rate = 7.50E-12*exp( 290./t) (477) + + 0.17*CH3O2 + 0.17*GLYOXAL + MDIALO2_NO2 (308) MDIALO2 + NO2 + M -> M + NDEP troe : ko=9.70E-29*(300/t)**5.60 (478) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + PHENO2_HO2 (309) PHENO2 + HO2 -> PHENOOH rate = 7.50E-13*exp( 700./t) (479) + PHENO2_NO (310) PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 rate = 2.60E-12*exp( 365./t) (480) + PHENOL_OH (311) PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO rate = 4.70E-13*exp( 1220./t) (481) + PHENO_NO2 (312) PHENO + NO2 -> NDEP rate = 2.10E-12 (482) + PHENO_O3 (313) PHENO + O3 -> C6H5O2 rate = 2.80E-13 (483) + PHENOOH_OH (314) PHENOOH + OH -> PHENO2 rate = 3.80E-12*exp( 200./t) (484) + tag_ACBZO2_NO2 (315) ACBZO2 + NO2 + M -> PBZNIT + M troe : ko=9.70E-29*(300/t)**5.60 (485) + ki=9.30E-12*(300/t)**1.50 + f=0.60 + TOLO2_HO2 (316) TOLO2 + HO2 -> TOLOOH rate = 7.50E-13*exp( 700./t) (486) + TOLO2_NO (317) TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 rate = 2.60E-12*exp( 365./t) (487) + + 0.2*BIGALD2 + 0.2*BIGALD3 + TOLOOH_OH (318) TOLOOH + OH -> TOLO2 rate = 3.80E-12*exp( 200./t) (488) + TOLUENE_OH (319) TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 rate = 1.70E-12*exp( 352./t) (489) + + 0.28*HO2 + usr_PBZNIT_M (320) PBZNIT + M -> ACBZO2 + NO2 + M rate = ** User defined ** (490) + XYLENES_OH (321) XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO rate = 1.70E-11 (491) + + 0.56*XYLENO2 + 0.38*HO2 + XYLENO2_HO2 (322) XYLENO2 + HO2 -> XYLENOOH rate = 7.50E-13*exp( 700./t) (492) + XYLENO2_NO (323) XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO rate = 2.60E-12*exp( 365./t) (493) + + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + + 0.21*BIGALD4 + XYLENOOH_OH (324) XYLENOOH + OH -> XYLENO2 rate = 3.80E-12*exp( 200./t) (494) + XYLOLO2_HO2 (325) XYLOLO2 + HO2 -> XYLOLOOH rate = 7.50E-13*exp( 700./t) (495) + XYLOLO2_NO (326) XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO rate = 2.60E-12*exp( 365./t) (496) + XYLOL_OH (327) XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO rate = 8.40E-11 (497) + XYLOLOOH_OH (328) XYLOLOOH + OH -> XYLOLO2 rate = 3.80E-12*exp( 200./t) (498) + BCARY_NO3 (329) BCARY + NO3 -> NTERPO2 rate = 1.90E-11 (499) + BCARY_O3 (330) BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 1.20E-14 (500) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + BCARY_OH (331) BCARY + OH -> TERPO2 rate = 2.00E-10 (501) + MTERP_NO3 (332) MTERP + NO3 -> NTERPO2 rate = 1.20E-12*exp( 490./t) (502) + MTERP_O3 (333) MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 rate = 6.30E-16*exp( -580./t) (503) + + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + + 0.06*RO2 + MTERP_OH (334) MTERP + OH -> TERPO2 rate = 1.20E-11*exp( 440./t) (504) + NTERPO2_CH3O2 (335) NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 rate = 2.00E-12*exp( 500./t) (505) + + 0.5*TERPROD1 + 0.5*NO2 + NTERPO2_HO2 (336) NTERPO2 + HO2 -> NTERPOOH rate = 7.50E-13*exp( 700./t) (506) + NTERPO2_NO (337) NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP rate = 4.20E-12*exp( 180./t) (507) + NTERPO2_NO3 (338) NTERPO2 + NO3 -> 2*NO2 + TERPROD1 rate = 2.40E-12 (508) + NTERPOOH_OH (339) NTERPOOH + OH -> NTERPO2 rate = 2.00E-11 (509) + TERP2O2_CH3O2 (340) TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (510) + + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + + 0.15*CH3COCH3 + TERP2O2_HO2 (341) TERP2O2 + HO2 -> TERP2OOH rate = 7.50E-13*exp( 700./t) (511) + TERP2O2_NO (342) TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 rate = 4.20E-12*exp( 180./t) (512) + + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + + 0.225*GLYALD + TERP2OOH_OH (343) TERP2OOH + OH -> TERP2O2 rate = 2.30E-11 (513) + TERPNIT_OH (344) TERPNIT + OH -> NO2 + TERPROD1 rate = 2.00E-11 (514) + TERPO2_CH3O2 (345) TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 rate = 2.00E-12*exp( 500./t) (515) + + 0.025*CH3COCH3 + TERPO2_HO2 (346) TERPO2 + HO2 -> TERPOOH rate = 7.50E-13*exp( 700./t) (516) + TERPO2_NO (347) TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 rate = 4.20E-12*exp( 180./t) (517) + + 0.8*TERPROD1 + 0.8*HO2 + TERPOOH_OH (348) TERPOOH + OH -> TERPO2 rate = 3.30E-11 (518) + TERPROD1_NO3 (349) TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP rate = 1.00E-12 (519) + TERPROD1_OH (350) TERPROD1 + OH -> TERP2O2 rate = 5.70E-11 (520) + TERPROD2_OH (351) TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 rate = 3.40E-11 (521) + + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO + DMS_NO3 (352) DMS + NO3 -> SO2 + HNO3 rate = 1.90E-13*exp( 520./t) (522) + DMS_OHa (353) DMS + OH -> SO2 rate = 1.10E-11*exp( -280./t) (523) + OCS_O (354) OCS + O -> SO + CO rate = 2.10E-11*exp( -2200./t) (524) + OCS_OH (355) OCS + OH -> SO2 + CO + H rate = 7.20E-14*exp( -1070./t) (525) + S_O2 (356) S + O2 -> SO + O rate = 2.30E-12 (526) + SO2_OH_M (357) SO2 + OH + M -> SO3 + HO2 troe : ko=2.90E-31*(300/t)**4.10 (527) + ki=1.70E-12*(300/t)**-0.20 + f=0.60 + S_O3 (358) S + O3 -> SO + O2 rate = 1.20E-11 (528) + SO_BRO (359) SO + BRO -> SO2 + BR rate = 5.70E-11 (529) + SO_CLO (360) SO + CLO -> SO2 + CL rate = 2.80E-11 (530) + S_OH (361) S + OH -> SO + H rate = 6.60E-11 (531) + SO_NO2 (362) SO + NO2 -> SO2 + NO rate = 1.40E-11 (532) + SO_O2 (363) SO + O2 -> SO2 + O rate = 1.60E-13*exp( -2280./t) (533) + SO_O3 (364) SO + O3 -> SO2 + O2 rate = 3.40E-12*exp( -1100./t) (534) + SO_OCLO (365) SO + OCLO -> SO2 + CLO rate = 1.90E-12 (535) + SO_OH (366) SO + OH -> SO2 + H rate = 2.60E-11*exp( 330./t) (536) + usr_DMS_OH (367) DMS + OH -> 0.5*SO2 + 0.5*HO2 rate = ** User defined ** (537) + usr_SO3_H2O (368) SO3 + H2O -> H2SO4 rate = ** User defined ** (538) + NH3_OH (369) NH3 + OH -> H2O + NHDEP rate = 1.70E-12*exp( -710./t) (539) + usr_HO2_aer (370) HO2 -> H2O rate = ** User defined ** (540) + usr_HONITR_aer (371) HONITR -> HNO3 rate = ** User defined ** (541) + usr_ISOPNITA_aer (372) ISOPNITA -> HNO3 rate = ** User defined ** (542) + usr_ISOPNITB_aer (373) ISOPNITB -> HNO3 rate = ** User defined ** (543) + usr_N2O5_aer (374) N2O5 -> 2*HNO3 rate = ** User defined ** (544) + usr_NC4CH2OH_aer (375) NC4CH2OH -> HNO3 rate = ** User defined ** (545) + usr_NC4CHO_aer (376) NC4CHO -> HNO3 rate = ** User defined ** (546) + usr_NH4_strat_ta (377) NH4 -> NHDEP rate = 6.34E-08 (547) + usr_NO2_aer (378) NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3 rate = ** User defined ** (548) + usr_NO3_aer (379) NO3 -> HNO3 rate = ** User defined ** (549) + usr_NTERPOOH_aer (380) NTERPOOH -> HNO3 rate = ** User defined ** (550) + usr_ONITR_aer (381) ONITR -> HNO3 rate = ** User defined ** (551) + usr_TERPNIT_aer (382) TERPNIT -> HNO3 rate = ** User defined ** (552) + BCARY_NO3_vbs (383) BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 rate = 1.90E-11 (553) + BCARYO2_HO2_vbs (384) BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 rate = 2.75E-13*exp( 1300./t) (554) + + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + + 0.114*SOAGbg4 + BCARYO2_NO_vbs (385) BCARYO2VBS + NO -> NO + 0.1279*SOAGbg0 + 0.1792*SOAGbg1 rate = 2.70E-12*exp( 360./t) (555) + + 0.0676*SOAGbg2 + 0.079*SOAGbg3 + + 0.1254*SOAGbg4 + BCARY_O3_vbs (386) BCARY + O3 -> BCARY + O3 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 rate = 1.20E-14 (556) + + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 + BCARY_OH_vbs (387) BCARY + OH -> BCARY + OH + BCARYO2VBS rate = 2.00E-10 (557) + BENZENE_OH_vbs (388) BENZENE + OH -> BENZENE + OH + BENZO2VBS rate = 2.30E-12*exp( -193./t) (558) + BENZO2_HO2_vbs (389) BENZO2VBS + HO2 -> HO2 + 0.0023*SOAGff0 + 0.0008*SOAGff1 rate = 7.50E-13*exp( 700./t) (559) + + 0.0843*SOAGff2 + 0.0443*SOAGff3 + + 0.1621*SOAGff4 + BENZO2_NO_vbs (390) BENZO2VBS + NO -> NO + 0.0097*SOAGff0 + 0.0034*SOAGff1 rate = 2.60E-12*exp( 365./t) (560) + + 0.1579*SOAGff2 + 0.0059*SOAGff3 + + 0.0536*SOAGff4 + ISOP_NO3_vbs (391) ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAGbg3 + 0.025024*SOAGbg4 rate = 3.03E-12*exp( -446./t) (561) + ISOPO2_HO2_vbs (392) ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAGbg0 + 0.0035*SOAGbg1 rate = 2.12E-13*exp( 1300./t) (562) + + 0.0003*SOAGbg2 + 0.0271*SOAGbg3 + + 0.0474*SOAGbg4 + ISOPO2_NO_vbs (393) ISOPO2VBS + NO -> NO + 0.0003*SOAGbg0 + 0.0003*SOAGbg1 rate = 2.70E-12*exp( 350./t) (563) + + 0.0073*SOAGbg2 + 0.0057*SOAGbg3 + + 0.0623*SOAGbg4 + ISOP_O3_vbs (394) ISOP + O3 -> ISOP + O3 + 0.0033*SOAGbg3 rate = 1.05E-14*exp( -2000./t) (564) + ISOP_OH_vbs (395) ISOP + OH -> ISOP + OH + ISOPO2VBS rate = 2.54E-11*exp( 410./t) (565) + IVOCbbO2_HO2_vbs (396) IVOCbbO2VBS + HO2 -> HO2 + 0.2381*SOAGbb0 + 0.1308*SOAGbb1 rate = 7.50E-13*exp( 700./t) (566) + + 0.0348*SOAGbb2 + 0.0076*SOAGbb3 + + 0.0113*SOAGbb4 + IVOCbbO2_NO_vbs (397) IVOCbbO2VBS + NO -> NO + 0.1056*SOAGbb0 + 0.1026*SOAGbb1 rate = 2.60E-12*exp( 365./t) (567) + + 0.0521*SOAGbb2 + 0.0143*SOAGbb3 + + 0.0166*SOAGbb4 + IVOCbb_OH_vbs (398) IVOCbb + OH -> OH + IVOCbbO2VBS rate = 1.34E-11 (568) + IVOCffO2_HO2_vbs (399) IVOCffO2VBS + HO2 -> HO2 + 0.2381*SOAGff0 + 0.1308*SOAGff1 rate = 7.50E-13*exp( 700./t) (569) + + 0.0348*SOAGff2 + 0.0076*SOAGff3 + + 0.0113*SOAGff4 + IVOCffO2_NO_vbs (400) IVOCffO2VBS + NO -> NO + 0.1056*SOAGff0 + 0.1026*SOAGff1 rate = 2.60E-12*exp( 365./t) (570) + + 0.0521*SOAGff2 + 0.0143*SOAGff3 + + 0.0166*SOAGff4 + IVOCff_OH_vbs (401) IVOCff + OH -> OH + IVOCffO2VBS rate = 1.34E-11 (571) + MTERP_NO3_vbs (402) MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 rate = 1.20E-12*exp( 490./t) (572) + MTERPO2_HO2_vbs (403) MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 rate = 2.60E-13*exp( 1300./t) (573) + + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + + 0.1278*SOAGbg4 + MTERPO2_NO_vbs (404) MTERPO2VBS + NO -> NO + 0.0245*SOAGbg0 + 0.0082*SOAGbg1 rate = 2.70E-12*exp( 360./t) (574) + + 0.0772*SOAGbg2 + 0.0332*SOAGbg3 + 0.13*SOAGbg4 + MTERP_O3_vbs (405) MTERP + O3 -> MTERP + O3 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 rate = 6.30E-16*exp( -580./t) (575) + + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 + MTERP_OH_vbs (406) MTERP + OH -> MTERP + OH + MTERPO2VBS rate = 1.20E-11*exp( 440./t) (576) + SVOCbb_OH (407) SVOCbb + OH -> OH + 0.5931*SOAGbb0 + 0.1534*SOAGbb1 rate = 1.34E-11 (577) + + 0.0459*SOAGbb2 + 0.0085*SOAGbb3 + 0.0128*SOAGbb4 + SVOCff_OH (408) SVOCff + OH -> OH + 0.5931*SOAGff0 + 0.1534*SOAGff1 rate = 1.34E-11 (578) + + 0.0459*SOAGff2 + 0.0085*SOAGff3 + 0.0128*SOAGff4 + TOLUENE_OH_vbs (409) TOLUENE + OH -> TOLO2 + TOLUO2VBS rate = 1.70E-12*exp( 352./t) (579) + TOLUO2_HO2_vbs (410) TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAGff0 + 0.0101*SOAGff1 rate = 7.50E-13*exp( 700./t) (580) + + 0.0763*SOAGff2 + 0.2157*SOAGff3 + + 0.0738*SOAGff4 + TOLUO2_NO_vbs (411) TOLUO2VBS + NO -> NO + 0.0154*SOAGff0 + 0.0452*SOAGff1 rate = 2.60E-12*exp( 365./t) (581) + + 0.0966*SOAGff2 + 0.0073*SOAGff3 + 0.238*SOAGff4 + usr_GLYOXAL_aer (412) GLYOXAL -> SOAGbg0 rate = ** User defined ** (582) + XYLENES_OH_vbs (413) XYLENES + OH -> XYLENES + OH + XYLEO2VBS rate = 1.70E-11 (583) + XYLEO2_HO2_vbs (414) XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAGff0 + 0.0174*SOAGff1 rate = 7.50E-13*exp( 700./t) (584) + + 0.086*SOAGff2 + 0.0512*SOAGff3 + + 0.1598*SOAGff4 + XYLEO2_NO_vbs (415) XYLEO2VBS + NO -> NO + 0.0063*SOAGff0 + 0.0237*SOAGff1 rate = 2.60E-12*exp( 365./t) (585) + + 0.0025*SOAGff2 + 0.011*SOAGff3 + 0.1185*SOAGff4 + het1 (416) N2O5 -> 2*HNO3 rate = ** User defined ** (586) + het10 (417) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (587) + het11 (418) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (588) + het12 (419) N2O5 -> 2*HNO3 rate = ** User defined ** (589) + het13 (420) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (590) + het14 (421) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (591) + het15 (422) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (592) + het16 (423) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (593) + het17 (424) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (594) + het2 (425) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (595) + het3 (426) BRONO2 -> HOBR + HNO3 rate = ** User defined ** (596) + het4 (427) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (597) + het5 (428) HOCL + HCL -> CL2 + H2O rate = ** User defined ** (598) + het6 (429) HOBR + HCL -> BRCL + H2O rate = ** User defined ** (599) + het7 (430) N2O5 -> 2*HNO3 rate = ** User defined ** (600) + het8 (431) CLONO2 -> HOCL + HNO3 rate = ** User defined ** (601) + het9 (432) CLONO2 + HCL -> CL2 + HNO3 rate = ** User defined ** (602) + elec1 (433) NOp + e -> 0.2*N + 0.8*N2D + O rate = ** User defined ** (603) + elec2 (434) O2p + e -> 1.15*O + 0.85*O1D rate = ** User defined ** (604) + elec3 (435) N2p + e -> 1.1*N + 0.9*N2D rate = ** User defined ** (605) + ion_N2p_O2 (436) N2p + O2 -> O2p + N2 rate = 6.00E-11 (606) + ion_N2p_Oa (437) N2p + O -> NOp + N2D rate = ** User defined ** (607) + ion_N2p_Ob (438) N2p + O -> Op + N2 rate = ** User defined ** (608) + ion_Np_O (439) Np + O -> Op + N rate = 1.00E-12 (609) + ion_Np_O2a (440) Np + O2 -> O2p + N rate = 4.00E-10 (610) + ion_Np_O2b (441) Np + O2 -> NOp + O rate = 2.00E-10 (611) + ion_O2p_N (442) O2p + N -> NOp + O rate = 1.00E-10 (612) + ion_O2p_N2 (443) O2p + N2 -> NOp + NO rate = 5.00E-16 (613) + ion_O2p_NO (444) O2p + NO -> NOp + O2 rate = 4.40E-10 (614) + ion_Op_CO2 (445) Op + CO2 -> O2p + CO rate = 9.00E-10 (615) + ion_Op_N2 (446) Op + N2 -> NOp + N rate = ** User defined ** (616) + ion_Op_O2 (447) Op + O2 -> O2p + O rate = ** User defined ** (617) + E90_tau (448) E90 -> {sink} rate = 1.29E-07 (618) + NH_50_tau (449) NH_50 -> (No products) rate = 2.31E-07 (619) + NH_5_tau (450) NH_5 -> (No products) rate = 2.31E-06 (620) + ST80_25_tau (451) ST80_25 -> (No products) rate = 4.63E-07 (621) + +Extraneous prod/loss species + ( 1) CO (dataset) + ( 2) bc_a4 (dataset) + ( 3) num_a1 (dataset) + ( 4) num_a2 (dataset) + ( 5) num_a4 (dataset) + ( 6) num_a5 (dataset) + ( 7) pombb1_a1 (dataset) + ( 8) pombb1_a4 (dataset) + ( 9) pomff1_a1 (dataset) + (10) pomff1_a4 (dataset) + (11) NO (dataset) + (12) NO2 (dataset) + (13) SO2 (dataset) + (14) SVOCbb (dataset) + (15) SVOCff (dataset) + (16) so4_a1 (dataset) + (17) so4_a2 (dataset) + (18) so4_a5 (dataset) + (19) bc_a1 (dataset) + (20) e + (21) N + (22) N2D + (23) OH + (24) Op + (25) AOA_NH + (26) N2p + (27) Np + + + Equation Report + + d(ALKNIT)/dt = r249*ALKO2*NO + - j20*ALKNIT - r246*OH*ALKNIT + d(ALKOOH)/dt = r247*ALKO2*HO2 + - j21*ALKOOH - r250*OH*ALKOOH + d(AOA_NH)/dt = 0 + d(bc_a1)/dt = 0 + d(bc_a4)/dt = 0 + d(BCARY)/dt = - r329*NO3*BCARY - r330*O3*BCARY - r331*OH*BCARY + d(BCARYO2VBS)/dt = r387*BCARY*OH + - r384*HO2*BCARYO2VBS - r385*NO*BCARYO2VBS + d(BENZENE)/dt = - r288*OH*BENZENE + d(BENZO2VBS)/dt = r388*BENZENE*OH + - r389*HO2*BENZO2VBS - r390*NO*BENZO2VBS + d(BENZOOH)/dt = r289*BENZO2*HO2 + - j22*BENZOOH - r291*OH*BENZOOH + d(BEPOMUC)/dt = .12*r288*BENZENE*OH + - j23*BEPOMUC + d(BIGALD)/dt = .1*r330*BCARY*O3 + .1*r333*MTERP*O3 + - j24*BIGALD + d(BIGALD1)/dt = .5*j22*BENZOOH + j23*BEPOMUC + .2*j71*TOLOOH + .06*j73*XYLENOOH + .5*r290*BENZO2*NO + + .2*r317*TOLO2*NO + .06*r323*XYLENO2*NO + - j25*BIGALD1 + d(BIGALD2)/dt = .2*j71*TOLOOH + .2*j73*XYLENOOH + .2*r317*TOLO2*NO + .2*r323*XYLENO2*NO + - j26*BIGALD2 + d(BIGALD3)/dt = j47*HPALD + j57*NC4CHO + .2*j71*TOLOOH + .15*j73*XYLENOOH + .2*r317*TOLO2*NO + + .15*r323*XYLENO2*NO + - j27*BIGALD3 + d(BIGALD4)/dt = .21*j73*XYLENOOH + .21*r323*XYLENO2*NO + - j28*BIGALD4 + d(BIGALK)/dt = .05*r330*BCARY*O3 + .05*r333*MTERP*O3 + - r251*OH*BIGALK + d(BIGENE)/dt = - r217*NO3*BIGENE - r218*OH*BIGENE + d(BR)/dt = j75*BRCL + j76*BRO + j78*BRONO2 + j80*CF2CLBR + j81*CF3BR + 2*j87*CH2BR2 + j88*CH3BR + + 3*j91*CHBR3 + 2*j99*H2402 + j100*HBR + j106*HOBR + r90*O1D*CF2CLBR + 2*r103*BRO*BRO + + r104*BRO*CLO + r105*BRO*CLO + r108*BRO*NO + r111*BRO*O + r112*BRO*OH + r113*HBR*O + + r114*HBR*OH + r116*O1D*CF3BR + 3*r117*O1D*CHBR3 + 2*r118*O1D*H2402 + r119*O1D*HBR + + 2*r127*CH2BR2*CL + 2*r128*CH2BR2*OH + r129*CH3BR*CL + r130*CH3BR*OH + 3*r134*CHBR3*CL + + 3*r135*CHBR3*OH + 2*r139*O1D*CH2BR2 + r140*O1D*CH3BR + r359*SO*BRO + - r100*CH2O*BR - r101*HO2*BR - r102*O3*BR + d(BRCL)/dt = r106*BRO*CLO + r424*HOBR*HCL + r429*HOBR*HCL + - j75*BRCL + d(BRO)/dt = j77*BRONO2 + r102*BR*O3 + r110*BRONO2*O + r115*HOBR*O + r120*O1D*HBR + - j76*BRO - 2*r103*BRO*BRO - r104*CLO*BRO - r105*CLO*BRO - r106*CLO*BRO - r107*HO2*BRO + - r108*NO*BRO - r109*M*NO2*BRO - r111*O*BRO - r112*OH*BRO - r359*SO*BRO + d(BRONO2)/dt = r109*M*BRO*NO2 + - j77*BRONO2 - j78*BRONO2 - r418*BRONO2 - r421*BRONO2 - r426*BRONO2 - r110*O*BRONO2 + d(BRY)/dt = 0 + d(BZALD)/dt = j29*BZOOH + r295*BZOO*NO + - r292*OH*BZALD + d(BZOOH)/dt = r293*BZOO*HO2 + - j29*BZOOH - r294*OH*BZOOH + d(C2H2)/dt = - r165*M*CL*C2H2 - r166*M*OH*C2H2 + d(C2H4)/dt = - r167*M*CL*C2H4 - r168*O3*C2H4 - r193*M*OH*C2H4 + d(C2H5OH)/dt = .4*r169*C2H5O2*C2H5O2 + .2*r170*C2H5O2*CH3O2 + - r173*OH*C2H5OH + d(C2H5OOH)/dt = r171*C2H5O2*HO2 + - j30*C2H5OOH - r174*OH*C2H5OOH + d(C2H6)/dt = - r175*CL*C2H6 - r176*OH*C2H6 + d(C3H6)/dt = .7*j56*MVK + .13*r275*ISOP*O3 + - r196*NO3*C3H6 - r197*O3*C3H6 - r215*M*OH*C3H6 + d(C3H7OOH)/dt = r199*C3H7O2*HO2 + - j31*C3H7OOH - r201*OH*C3H7OOH + d(C3H8)/dt = - r202*OH*C3H8 - r205*CL*C3H8 + d(C6H5OOH)/dt = r296*C6H5O2*HO2 + - j32*C6H5OOH - r298*OH*C6H5OOH + d(CCL4)/dt = - j79*CCL4 - r89*O1D*CCL4 + d(CF2CLBR)/dt = - j80*CF2CLBR - r90*O1D*CF2CLBR + d(CF3BR)/dt = - j81*CF3BR - r116*O1D*CF3BR + d(CFC11)/dt = - j82*CFC11 - r91*O1D*CFC11 + d(CFC113)/dt = - j83*CFC113 - r92*O1D*CFC113 + d(CFC114)/dt = - j84*CFC114 - r93*O1D*CFC114 + d(CFC115)/dt = - j85*CFC115 - r94*O1D*CFC115 + d(CFC12)/dt = - j86*CFC12 - r95*O1D*CFC12 + d(CH2BR2)/dt = - j87*CH2BR2 - r127*CL*CH2BR2 - r128*OH*CH2BR2 - r139*O1D*CH2BR2 + d(CH2O)/dt = .1*j20*ALKNIT + .1*j21*ALKOOH + j39*CH3OOH + .18*j40*CH4 + j44*GLYALD + .33*j46*HONITR + + j48*HYAC + j50*ISOPOOH + 1.34*j51*MACR + j58*NOA + j63*POOH + j64*ROOH + .375*j66*TERP2OOH + + .4*j68*TERPOOH + .68*j70*TERPROD2 + r158*HOCH2OO + 2*r188*EO + r71*CLO*CH3O2 + + 2*r148*CH3O2*CH3O2 + r149*CH3O2*CH3O2 + r151*CH3O2*NO + r152*CH3OH*OH + .3*r153*CH3OOH*OH + + r161*O1D*CH4 + r162*O1D*CH4 + r168*C2H4*O3 + .7*r170*C2H5O2*CH3O2 + r181*CH3CO3*CH3O2 + + .5*r185*CH3COOOH*OH + .5*r187*EO2*NO + .8*r190*GLYALD*OH + r192*PAN*OH + .5*r197*C3H6*O3 + + r198*C3H7O2*CH3O2 + r209*PO2*NO + .8*r211*RO2*CH3O2 + .15*r212*RO2*HO2 + r213*RO2*NO + + .5*r217*BIGENE*NO3 + .5*r219*ENEO2*NO + .25*r222*MACRO2*CH3CO3 + .88*r223*MACRO2*CH3O2 + + .25*r225*MACRO2*NO3 + .25*r226*MACRO2*NO + .12*r228*MACR*O3 + r231*MCO3*CH3CO3 + + 2*r232*MCO3*CH3O2 + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + r235*MCO3*NO + r236*MCO3*NO3 + + .5*r241*M*MPAN*OH + .6*r242*MVK*O3 + .4*r246*ALKNIT*OH + .1*r248*ALKO2*NO + + r255*ISOPAO2*CH3CO3 + 1.5*r256*ISOPAO2*CH3O2 + .92*r258*ISOPAO2*NO + r259*ISOPAO2*NO3 + + .75*r261*ISOPBO2*CH3O2 + .3*r266*ISOPNITA*OH + .8*r270*ISOPNO3*CH3O2 + .91*r275*ISOP*O3 + + .25*r280*XO2*CH3CO3 + .8*r281*XO2*CH3O2 + .25*r283*XO2*NO + .34*r330*BCARY*O3 + + .34*r333*MTERP*O3 + .75*r335*NTERPO2*CH3O2 + .93*r340*TERP2O2*CH3O2 + .34*r342*TERP2O2*NO + + .95*r345*TERPO2*CH3O2 + .32*r347*TERPO2*NO + .68*r351*TERPROD2*OH + - j33*CH2O - j34*CH2O - r64*CL*CH2O - r100*BR*CH2O - r144*HO2*CH2O - r145*NO3*CH2O + - r146*O*CH2O - r147*OH*CH2O + d(CH3BR)/dt = - j88*CH3BR - r129*CL*CH3BR - r130*OH*CH3BR - r140*O1D*CH3BR + d(CH3CCL3)/dt = - j89*CH3CCL3 - r131*OH*CH3CCL3 + d(CH3CHO)/dt = .4*j20*ALKNIT + .4*j21*ALKOOH + j30*C2H5OOH + .33*j46*HONITR + j54*MEKOOH + j63*POOH + + 1.6*r169*C2H5O2*C2H5O2 + .8*r170*C2H5O2*CH3O2 + r172*C2H5O2*NO + r173*C2H5OH*OH + + .5*r174*C2H5OOH*OH + .5*r197*C3H6*O3 + .27*r200*C3H7O2*NO + r209*PO2*NO + r217*BIGENE*NO3 + + r219*ENEO2*NO + .2*r237*MEKO2*HO2 + r238*MEKO2*NO + .1*r242*MVK*O3 + .8*r246*ALKNIT*OH + + .4*r248*ALKO2*NO + - j35*CH3CHO - r177*NO3*CH3CHO - r178*OH*CH3CHO + d(CH3CL)/dt = - j90*CH3CL - r132*CL*CH3CL - r133*OH*CH3CL + d(CH3CN)/dt = - r179*OH*CH3CN + d(CH3COCH3)/dt = .25*j20*ALKNIT + .25*j21*ALKOOH + .82*j31*C3H7OOH + .17*j46*HONITR + .3*j66*TERP2OOH + + .05*j68*TERPOOH + .5*j70*TERPROD2 + .82*r198*C3H7O2*CH3O2 + .82*r200*C3H7O2*NO + + .5*r217*BIGENE*NO3 + .5*r219*ENEO2*NO + .8*r246*ALKNIT*OH + .25*r248*ALKO2*NO + + .52*r330*BCARY*O3 + .52*r333*MTERP*O3 + .15*r340*TERP2O2*CH3O2 + .27*r342*TERP2O2*NO + + .025*r345*TERPO2*CH3O2 + .04*r347*TERPO2*NO + .5*r351*TERPROD2*OH + - j36*CH3COCH3 - r216*OH*CH3COCH3 + d(CH3COCHO)/dt = .18*j24*BIGALD + j28*BIGALD4 + .4*j71*TOLOOH + .54*j73*XYLENOOH + .51*j74*XYLOLOOH + + r206*HYAC*OH + r207*NOA*OH + .5*r211*RO2*CH3O2 + .25*r222*MACRO2*CH3CO3 + + .24*r223*MACRO2*CH3O2 + .25*r225*MACRO2*NO3 + .25*r226*MACRO2*NO + .88*r228*MACR*O3 + + .5*r242*MVK*O3 + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + .25*r280*XO2*CH3CO3 + + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + .07*r300*DICARBO2*HO2 + + .17*r301*DICARBO2*NO + .07*r306*MDIALO2*HO2 + .17*r307*MDIALO2*NO + .4*r317*TOLO2*NO + + .54*r323*XYLENO2*NO + .51*r326*XYLOLO2*NO + - j37*CH3COCHO - r203*NO3*CH3COCHO - r204*OH*CH3COCHO + d(CH3COOH)/dt = .1*r181*CH3CO3*CH3O2 + .15*r182*CH3CO3*HO2 + .12*r197*C3H6*O3 + .15*r233*MCO3*HO2 + - r184*OH*CH3COOH + d(CH3COOOH)/dt = .4*r182*CH3CO3*HO2 + .4*r233*MCO3*HO2 + - j38*CH3COOOH - r185*OH*CH3COOOH + d(CH3OH)/dt = r149*CH3O2*CH3O2 + .3*r170*C2H5O2*CH3O2 + .5*r211*RO2*CH3O2 + .25*r223*MACRO2*CH3O2 + + .25*r256*ISOPAO2*CH3O2 + .25*r261*ISOPBO2*CH3O2 + .2*r270*ISOPNO3*CH3O2 + .3*r281*XO2*CH3O2 + + .25*r335*NTERPO2*CH3O2 + .25*r340*TERP2O2*CH3O2 + .25*r345*TERPO2*CH3O2 + - r152*OH*CH3OH + d(CH3OOH)/dt = r150*CH3O2*HO2 + - j39*CH3OOH - r153*OH*CH3OOH + d(CH4)/dt = .1*r197*C3H6*O3 + - j40*CH4 - j41*CH4 - r65*CL*CH4 - r121*F*CH4 - r154*OH*CH4 - r160*O1D*CH4 - r161*O1D*CH4 + - r162*O1D*CH4 + d(CHBR3)/dt = - j91*CHBR3 - r117*O1D*CHBR3 - r134*CL*CHBR3 - r135*OH*CHBR3 + d(CL)/dt = j75*BRCL + 4*j79*CCL4 + j80*CF2CLBR + 2*j82*CFC11 + 2*j83*CFC113 + 2*j84*CFC114 + j85*CFC115 + + 2*j86*CFC12 + 3*j89*CH3CCL3 + j90*CH3CL + 2*j92*CL2 + 2*j93*CL2O2 + j94*CLO + j95*CLONO2 + + j98*COFCL + j101*HCFC141B + j102*HCFC142B + j103*HCFC22 + j104*HCL + j107*HOCL + r71*CLO*CH3O2 + + 2*r72*CLO*CLO + r74*CLO*CLO + r76*CLO*NO + r81*CLO*O + r82*CLO*OH + r84*HCL*O + r85*HCL*OH + + 4*r89*O1D*CCL4 + r90*O1D*CF2CLBR + 2*r91*O1D*CFC11 + 2*r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + r94*O1D*CFC115 + 2*r95*O1D*CFC12 + r96*O1D*HCL + r105*BRO*CLO + r126*O1D*COFCL + + 3*r131*CH3CCL3*OH + r133*CH3CL*OH + r136*HCFC141B*OH + r137*HCFC142B*OH + r138*HCFC22*OH + + r141*O1D*HCFC141B + r142*O1D*HCFC142B + r143*O1D*HCFC22 + r360*SO*CLO + - r64*CH2O*CL - r65*CH4*CL - r66*H2*CL - r67*H2O2*CL - r68*HO2*CL - r69*HO2*CL - r70*O3*CL + - r77*CLONO2*CL - r86*HOCL*CL - r127*CH2BR2*CL - r129*CH3BR*CL - r132*CH3CL*CL - r134*CHBR3*CL + - r175*C2H6*CL - r205*C3H8*CL + d(CL2)/dt = r73*CLO*CLO + r77*CLONO2*CL + r417*HOCL*HCL + r422*CLONO2*HCL + r423*HOCL*HCL + r427*CLONO2*HCL + + r428*HOCL*HCL + r432*CLONO2*HCL + - j92*CL2 + d(CL2O2)/dt = r98*M*CLO*CLO + - j93*CL2O2 - r99*M*CL2O2 + d(CLO)/dt = j96*CLONO2 + j108*OCLO + r99*M*CL2O2 + r99*M*CL2O2 + r69*CL*HO2 + r70*CL*O3 + r79*CLONO2*O + + r86*HOCL*CL + r87*HOCL*O + r88*HOCL*OH + r97*O1D*HCL + r365*SO*OCLO + - j94*CLO - r71*CH3O2*CLO - 2*r72*CLO*CLO - 2*r73*CLO*CLO - 2*r74*CLO*CLO - r75*HO2*CLO + - r76*NO*CLO - r78*M*NO2*CLO - r81*O*CLO - r82*OH*CLO - r83*OH*CLO - 2*r98*M*CLO*CLO + - r104*BRO*CLO - r105*BRO*CLO - r106*BRO*CLO - r360*SO*CLO + d(CLONO2)/dt = r78*M*CLO*NO2 + - j95*CLONO2 - j96*CLONO2 - r420*CLONO2 - r425*CLONO2 - r431*CLONO2 - r77*CL*CLONO2 + - r79*O*CLONO2 - r80*OH*CLONO2 - r422*HCL*CLONO2 - r427*HCL*CLONO2 - r432*HCL*CLONO2 + d(CLY)/dt = 0 + d(CO)/dt = 1.5*j23*BEPOMUC + .45*j24*BIGALD + .6*j27*BIGALD3 + j28*BIGALD4 + j33*CH2O + j34*CH2O + + j35*CH3CHO + j37*CH3COCHO + .38*j40*CH4 + j42*CO2 + j44*GLYALD + 2*j45*GLYOXAL + + .33*j46*HONITR + 1.34*j52*MACR + .7*j56*MVK + 1.5*j65*TEPOMUC + .25*j66*TERP2OOH + j69*TERPROD1 + + 1.7*j70*TERPROD2 + j110*CO2 + j137*OCS + r64*CL*CH2O + r100*BR*CH2O + r132*CH3CL*CL + + r145*CH2O*NO3 + r146*CH2O*O + r147*CH2O*OH + .35*r166*M*C2H2*OH + .63*r168*C2H4*O3 + + r191*GLYOXAL*OH + .56*r197*C3H6*O3 + r203*CH3COCHO*NO3 + r204*CH3COCHO*OH + + .22*r222*MACRO2*CH3CO3 + .11*r223*MACRO2*CH3O2 + .22*r225*MACRO2*NO3 + .22*r226*MACRO2*NO + + .65*r228*MACR*O3 + .56*r242*MVK*O3 + .62*r275*ISOP*O3 + .25*r280*XO2*CH3CO3 + .2*r281*XO2*CH3O2 + + .25*r283*XO2*NO + .5*r284*XO2*NO3 + .07*r300*DICARBO2*HO2 + .17*r301*DICARBO2*NO + + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + .14*r306*MDIALO2*HO2 + .35*r307*MDIALO2*NO + + .23*r330*BCARY*O3 + .23*r333*MTERP*O3 + .125*r340*TERP2O2*CH3O2 + .225*r342*TERP2O2*NO + + .7*r351*TERPROD2*OH + r354*OCS*O + r355*OCS*OH + r445*Op*CO2 + - r164*OH*CO + d(CO2)/dt = j38*CH3COOOH + .44*j40*CH4 + .4*j61*PAN + j66*TERP2OOH + .8*j70*TERPROD2 + r156*HCOOH*OH + + r164*CO*OH + 2*r180*CH3CO3*CH3CO3 + .9*r181*CH3CO3*CH3O2 + r183*CH3CO3*NO + r184*CH3COOH*OH + + .5*r185*CH3COOOH*OH + .8*r190*GLYALD*OH + r191*GLYOXAL*OH + .2*r197*C3H6*O3 + + 2*r231*MCO3*CH3CO3 + r232*MCO3*CH3O2 + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + .5*r241*M*MPAN*OH + + .1*r242*MVK*O3 + r255*ISOPAO2*CH3CO3 + r280*XO2*CH3CO3 + .27*r330*BCARY*O3 + .27*r333*MTERP*O3 + + .5*r340*TERP2O2*CH3O2 + .9*r342*TERP2O2*NO + 1.8*r351*TERPROD2*OH + - j42*CO2 - j110*CO2 - r445*Op*CO2 + d(COF2)/dt = j80*CF2CLBR + j81*CF3BR + j83*CFC113 + 2*j84*CFC114 + 2*j85*CFC115 + j86*CFC12 + 2*j99*H2402 + + j102*HCFC142B + j103*HCFC22 + r90*O1D*CF2CLBR + r92*O1D*CFC113 + 2*r93*O1D*CFC114 + + 2*r94*O1D*CFC115 + r95*O1D*CFC12 + r116*O1D*CF3BR + 2*r118*O1D*H2402 + r137*HCFC142B*OH + + r138*HCFC22*OH + r142*O1D*HCFC142B + r143*O1D*HCFC22 + - j97*COF2 - r125*O1D*COF2 + d(COFCL)/dt = j82*CFC11 + j83*CFC113 + j101*HCFC141B + r91*O1D*CFC11 + r92*O1D*CFC113 + r136*HCFC141B*OH + + r141*O1D*HCFC141B + - j98*COFCL - r126*O1D*COFCL + d(CRESOL)/dt = .18*r319*TOLUENE*OH + - r299*OH*CRESOL + d(DMS)/dt = - r352*NO3*DMS - r353*OH*DMS - r367*OH*DMS + d(dst_a1)/dt = 0 + d(dst_a2)/dt = 0 + d(dst_a3)/dt = 0 + d(E90)/dt = - r448*E90 + d(EOOH)/dt = r186*EO2*HO2 + - j43*EOOH + d(F)/dt = j81*CF3BR + j85*CFC115 + 2*j97*COF2 + j98*COFCL + j105*HF + r94*O1D*CFC115 + r116*O1D*CF3BR + + 2*r125*O1D*COF2 + r126*O1D*COFCL + - r121*CH4*F - r122*H2*F - r123*H2O*F - r124*HNO3*F + d(GLYALD)/dt = .33*j46*HONITR + .25*j66*TERP2OOH + r189*EO*O2 + .53*r222*MACRO2*CH3CO3 + .26*r223*MACRO2*CH3O2 + + .53*r225*MACRO2*NO3 + .53*r226*MACRO2*NO + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + + .7*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH + r278*NC4CH2OH*OH + .25*r280*XO2*CH3CO3 + + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + .125*r340*TERP2O2*CH3O2 + + .225*r342*TERP2O2*NO + - j44*GLYALD - r190*OH*GLYALD + d(GLYOXAL)/dt = j22*BENZOOH + .13*j24*BIGALD + .7*j62*PHENOOH + .6*j71*TOLOOH + .34*j73*XYLENOOH + + .17*j74*XYLOLOOH + .65*r166*M*C2H2*OH + .2*r190*GLYALD*OH + .05*r264*ISOPBO2*NO + + .05*r265*ISOPBO2*NO3 + r279*NC4CHO*OH + .25*r280*XO2*CH3CO3 + .1*r281*XO2*CH3O2 + + .25*r283*XO2*NO + .25*r284*XO2*NO3 + r290*BENZO2*NO + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + + .07*r306*MDIALO2*HO2 + .17*r307*MDIALO2*NO + .7*r310*PHENO2*NO + .6*r317*TOLO2*NO + + .34*r323*XYLENO2*NO + .17*r326*XYLOLO2*NO + - j45*GLYOXAL - r412*GLYOXAL - r191*OH*GLYOXAL + d(H)/dt = 2*j2*H2O + j3*H2O + 2*j34*CH2O + j39*CH3OOH + .33*j40*CH4 + j41*CH4 + j100*HBR + j104*HCL + + j105*HF + r3*O1D*H2 + r20*H2*O + r29*OH*H2 + r32*OH*O + r52*N*OH + r66*CL*H2 + r97*O1D*HCL + + r120*O1D*HBR + r122*F*H2 + r147*CH2O*OH + r161*O1D*CH4 + r355*OCS*OH + r361*S*OH + r366*SO*OH + - r22*HO2*H - r23*HO2*H - r24*HO2*H - r25*M*O2*H - r28*O3*H + d(H2)/dt = j1*H2O + j33*CH2O + 1.4400001*j40*CH4 + r22*H*HO2 + r162*O1D*CH4 + - r3*O1D*H2 - r20*O*H2 - r29*OH*H2 - r66*CL*H2 - r122*F*H2 + d(H2402)/dt = - j99*H2402 - r118*O1D*H2402 + d(H2O2)/dt = r35*M*OH*OH + r36*HO2*HO2 + - j4*H2O2 - r21*O*H2O2 - r30*OH*H2O2 - r67*CL*H2O2 + d(H2SO4)/dt = r368*SO3*H2O + - j136*H2SO4 + d(HBR)/dt = r100*BR*CH2O + r101*BR*HO2 + - j100*HBR - r113*O*HBR - r114*OH*HBR - r119*O1D*HBR - r120*O1D*HBR + d(HCFC141B)/dt = - j101*HCFC141B - r136*OH*HCFC141B - r141*O1D*HCFC141B + d(HCFC142B)/dt = - j102*HCFC142B - r137*OH*HCFC142B - r142*O1D*HCFC142B + d(HCFC22)/dt = - j103*HCFC22 - r138*OH*HCFC22 - r143*O1D*HCFC22 + d(HCL)/dt = r64*CL*CH2O + r65*CL*CH4 + r66*CL*H2 + r67*CL*H2O2 + r68*CL*HO2 + r83*CLO*OH + r86*HOCL*CL + + r127*CH2BR2*CL + r129*CH3BR*CL + 2*r132*CH3CL*CL + r134*CHBR3*CL + r175*C2H6*CL + r205*CL*C3H8 + - j104*HCL - r84*O*HCL - r85*OH*HCL - r96*O1D*HCL - r97*O1D*HCL - r417*HOCL*HCL + - r422*CLONO2*HCL - r423*HOCL*HCL - r424*HOBR*HCL - r427*CLONO2*HCL - r428*HOCL*HCL + - r429*HOBR*HCL - r432*CLONO2*HCL + d(HCN)/dt = - r155*M*OH*HCN - r163*O1D*HCN + d(HCOOH)/dt = r157*HOCH2OO*HO2 + r159*HOCH2OO*NO + .35*r166*M*C2H2*OH + .37*r168*C2H4*O3 + .12*r197*C3H6*O3 + + .33*r228*MACR*O3 + .12*r242*MVK*O3 + .11*r275*ISOP*O3 + .05*r330*BCARY*O3 + .05*r333*MTERP*O3 + - r156*OH*HCOOH + d(HF)/dt = r121*F*CH4 + r122*F*H2 + r123*F*H2O + r124*F*HNO3 + - j105*HF + d(HNO3)/dt = r371*HONITR + r372*ISOPNITA + r373*ISOPNITB + 2*r374*N2O5 + r375*NC4CH2OH + r376*NC4CHO + + .5*r378*NO2 + r379*NO3 + r380*NTERPOOH + r381*ONITR + r382*TERPNIT + 2*r416*N2O5 + + r418*BRONO2 + 2*r419*N2O5 + r420*CLONO2 + r421*BRONO2 + r425*CLONO2 + r426*BRONO2 + + 2*r430*N2O5 + r431*CLONO2 + r60*M*NO2*OH + r145*CH2O*NO3 + r177*CH3CHO*NO3 + + r203*CH3COCHO*NO3 + r352*DMS*NO3 + r422*CLONO2*HCL + r427*CLONO2*HCL + r432*CLONO2*HCL + - j9*HNO3 - r61*OH*HNO3 - r124*F*HNO3 + d(HO2NO2)/dt = r58*M*NO2*HO2 + - j10*HO2NO2 - j11*HO2NO2 - r62*M*HO2NO2 - r37*OH*HO2NO2 + d(HOBR)/dt = r418*BRONO2 + r421*BRONO2 + r426*BRONO2 + r107*BRO*HO2 + - j106*HOBR - r115*O*HOBR - r424*HCL*HOBR - r429*HCL*HOBR + d(HOCL)/dt = r420*CLONO2 + r425*CLONO2 + r431*CLONO2 + r75*CLO*HO2 + r80*CLONO2*OH + - j107*HOCL - r86*CL*HOCL - r87*O*HOCL - r88*OH*HOCL - r417*HCL*HOCL - r423*HCL*HOCL + - r428*HCL*HOCL + d(HONITR)/dt = r220*ENEO2*NO + r227*MACRO2*NO + .3*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH + - j46*HONITR - r371*HONITR - r221*OH*HONITR + d(HPALD)/dt = r263*ISOPBO2 + - j47*HPALD - r252*OH*HPALD + d(HYAC)/dt = .17*j46*HONITR + .5*r210*POOH*OH + .2*r211*RO2*CH3O2 + .22*r222*MACRO2*CH3CO3 + + .23*r223*MACRO2*CH3O2 + .22*r225*MACRO2*NO3 + .22*r226*MACRO2*NO + .5*r241*M*MPAN*OH + + .05*r264*ISOPBO2*NO + .05*r265*ISOPBO2*NO3 + .7*r266*ISOPNITA*OH + .5*r267*ISOPNITB*OH + + .25*r280*XO2*CH3CO3 + .1*r281*XO2*CH3O2 + .25*r283*XO2*NO + .25*r284*XO2*NO3 + - j48*HYAC - r206*OH*HYAC + d(HYDRALD)/dt = r260*ISOPBO2*CH3CO3 + .75*r261*ISOPBO2*CH3O2 + .87*r264*ISOPBO2*NO + .95*r265*ISOPBO2*NO3 + - r253*OH*HYDRALD + d(IEPOX)/dt = .6*r277*ISOPOOH*OH + - r254*OH*IEPOX + d(ISOP)/dt = - r268*NO3*ISOP - r275*O3*ISOP - r276*OH*ISOP + d(ISOPNITA)/dt = .08*r258*ISOPAO2*NO + - r372*ISOPNITA - r266*OH*ISOPNITA + d(ISOPNITB)/dt = .08*r264*ISOPBO2*NO + - r373*ISOPNITB - r267*OH*ISOPNITB + d(ISOPNO3)/dt = r268*ISOP*NO3 + - r269*CH3CO3*ISOPNO3 - r270*CH3O2*ISOPNO3 - r271*HO2*ISOPNO3 - r272*NO*ISOPNO3 + - r273*NO3*ISOPNO3 + d(ISOPNOOH)/dt = r271*ISOPNO3*HO2 + - j49*ISOPNOOH - r274*OH*ISOPNOOH + d(ISOPO2VBS)/dt = r395*ISOP*OH + - r392*HO2*ISOPO2VBS - r393*NO*ISOPO2VBS + d(ISOPOOH)/dt = j49*ISOPNOOH + r257*ISOPAO2*HO2 + r262*ISOPBO2*HO2 + - j50*ISOPOOH - r277*OH*ISOPOOH + d(IVOCbb)/dt = - r398*OH*IVOCbb + d(IVOCbbO2VBS)/dt = r398*IVOCbb*OH + - r396*HO2*IVOCbbO2VBS - r397*NO*IVOCbbO2VBS + d(IVOCff)/dt = - r401*OH*IVOCff + d(IVOCffO2VBS)/dt = r401*IVOCff*OH + - r399*HO2*IVOCffO2VBS - r400*NO*IVOCffO2VBS + d(MACR)/dt = .3*j50*ISOPOOH + .39*r255*ISOPAO2*CH3CO3 + .31*r256*ISOPAO2*CH3O2 + .36*r258*ISOPAO2*NO + + .4*r259*ISOPAO2*NO3 + .3*r275*ISOP*O3 + - j51*MACR - j52*MACR - r228*O3*MACR - r229*OH*MACR + d(MACROOH)/dt = r224*MACRO2*HO2 + - r230*OH*MACROOH + d(MEK)/dt = .8*j20*ALKNIT + .8*j21*ALKOOH + .8*r248*ALKO2*NO + - j53*MEK - r239*OH*MEK + d(MEKOOH)/dt = .8*r237*MEKO2*HO2 + - j54*MEKOOH - r240*OH*MEKOOH + d(MPAN)/dt = r244*M*MCO3*NO2 + - j55*MPAN - r245*M*MPAN - r241*M*OH*MPAN + d(MTERP)/dt = - r332*NO3*MTERP - r333*O3*MTERP - r334*OH*MTERP + d(MTERPO2VBS)/dt = r406*MTERP*OH + - r403*HO2*MTERPO2VBS - r404*NO*MTERPO2VBS + d(MVK)/dt = .7*j50*ISOPOOH + .61*r255*ISOPAO2*CH3CO3 + .44*r256*ISOPAO2*CH3O2 + .56*r258*ISOPAO2*NO + + .6*r259*ISOPAO2*NO3 + .2*r275*ISOP*O3 + - j56*MVK - r242*O3*MVK - r243*OH*MVK + d(N)/dt = .8*j112*N2 + j115*N2 + j116*N2 + .8*j118*N2 + j15*NO + r446*N2*Op + r38*N2D*O + .2*r433*NOp*e + + 1.1*r435*N2p*e + r439*Np*O + r440*Np*O2 + - j111*N - r40*NO*N - r41*NO2*N - r42*NO2*N - r43*NO2*N - r44*O2*N - r52*OH*N - r442*O2p*N + d(N2O)/dt = r41*N*NO2 + - j12*N2O - r56*O1D*N2O - r57*O1D*N2O + d(N2O5)/dt = r59*M*NO2*NO3 + - j13*N2O5 - j14*N2O5 - r63*M*N2O5 - r374*N2O5 - r416*N2O5 - r419*N2O5 - r430*N2O5 + d(NC4CH2OH)/dt = .2*r270*ISOPNO3*CH3O2 + - r375*NC4CH2OH - r278*OH*NC4CH2OH + d(NC4CHO)/dt = r269*ISOPNO3*CH3CO3 + .8*r270*ISOPNO3*CH3O2 + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + - j57*NC4CHO - r376*NC4CHO - r279*OH*NC4CHO + d(ncl_a1)/dt = 0 + d(ncl_a2)/dt = 0 + d(ncl_a3)/dt = 0 + d(NH3)/dt = - r369*OH*NH3 + d(NH4)/dt = - r377*NH4 + d(NH_5)/dt = - r450*NH_5 + d(NH_50)/dt = - r449*NH_50 + d(NO)/dt = j14*N2O5 + j17*NO2 + j19*NO3 + .5*r378*NO2 + r443*N2*O2p + r39*N2D*O2 + 2*r42*N*NO2 + r44*N*O2 + + r45*NO2*O + r52*N*OH + 2*r56*O1D*N2O + r362*SO*NO2 + - j15*NO - j16*NO - r40*N*NO - r49*NO3*NO - r53*HO2*NO - r54*O3*NO - r55*M*O*NO - r76*CLO*NO + - r108*BRO*NO - r151*CH3O2*NO - r159*HOCH2OO*NO - r172*C2H5O2*NO - r183*CH3CO3*NO - r187*EO2*NO + - r200*C3H7O2*NO - r209*PO2*NO - r213*RO2*NO - r219*ENEO2*NO - r220*ENEO2*NO - r226*MACRO2*NO + - r227*MACRO2*NO - r235*MCO3*NO - r238*MEKO2*NO - r248*ALKO2*NO - r249*ALKO2*NO - r258*ISOPAO2*NO + - r264*ISOPBO2*NO - r272*ISOPNO3*NO - r283*XO2*NO - r287*ACBZO2*NO - r290*BENZO2*NO + - r295*BZOO*NO - r297*C6H5O2*NO - r301*DICARBO2*NO - r304*MALO2*NO - r307*MDIALO2*NO + - r310*PHENO2*NO - r317*TOLO2*NO - r323*XYLENO2*NO - r326*XYLOLO2*NO - r337*NTERPO2*NO + - r342*TERP2O2*NO - r347*TERPO2*NO - r444*O2p*NO + d(NO2)/dt = j9*HNO3 + j11*HO2NO2 + j13*N2O5 + j18*NO3 + j20*ALKNIT + j46*HONITR + j49*ISOPNOOH + j55*MPAN + + j57*NC4CHO + j58*NOA + j59*NTERPOOH + j60*ONITR + .6*j61*PAN + j67*TERPNIT + j77*BRONO2 + + j96*CLONO2 + r62*M*HO2NO2 + r63*M*N2O5 + r195*M*PAN + r245*M*MPAN + r320*M*PBZNIT + + r37*HO2NO2*OH + r48*NO3*HO2 + 2*r49*NO3*NO + r50*NO3*O + r51*NO3*OH + r53*NO*HO2 + r54*NO*O3 + + r55*M*NO*O + r76*CLO*NO + r108*BRO*NO + r151*CH3O2*NO + r159*HOCH2OO*NO + r172*C2H5O2*NO + + r183*CH3CO3*NO + r187*EO2*NO + r200*C3H7O2*NO + r207*NOA*OH + r209*PO2*NO + r213*RO2*NO + + r217*BIGENE*NO3 + r219*ENEO2*NO + r225*MACRO2*NO3 + r226*MACRO2*NO + r235*MCO3*NO + + r236*MCO3*NO3 + r238*MEKO2*NO + r246*ALKNIT*OH + r248*ALKO2*NO + .92*r258*ISOPAO2*NO + + r259*ISOPAO2*NO3 + .92*r264*ISOPBO2*NO + r265*ISOPBO2*NO3 + .7*r266*ISOPNITA*OH + + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + r283*XO2*NO + r284*XO2*NO3 + r287*ACBZO2*NO + + r290*BENZO2*NO + r295*BZOO*NO + r297*C6H5O2*NO + r301*DICARBO2*NO + r304*MALO2*NO + + r307*MDIALO2*NO + r310*PHENO2*NO + r317*TOLO2*NO + r323*XYLENO2*NO + r326*XYLOLO2*NO + + .5*r335*NTERPO2*CH3O2 + 1.6*r337*NTERPO2*NO + 2*r338*NTERPO2*NO3 + .9*r342*TERP2O2*NO + + r344*TERPNIT*OH + .8*r347*TERPO2*NO + - j17*NO2 - r378*NO2 - r41*N*NO2 - r42*N*NO2 - r43*N*NO2 - r45*O*NO2 - r46*O3*NO2 + - r47*M*O*NO2 - r58*M*HO2*NO2 - r59*M*NO3*NO2 - r60*M*OH*NO2 - r78*M*CLO*NO2 - r109*M*BRO*NO2 + - r194*M*CH3CO3*NO2 - r244*M*MCO3*NO2 - r302*M*DICARBO2*NO2 - r305*M*MALO2*NO2 + - r308*M*MDIALO2*NO2 - r312*PHENO*NO2 - r315*M*ACBZO2*NO2 - r362*SO*NO2 + d(NO3)/dt = j10*HO2NO2 + j13*N2O5 + j14*N2O5 + .4*j61*PAN + j78*BRONO2 + j95*CLONO2 + r63*M*N2O5 + + r46*NO2*O3 + r47*M*NO2*O + r61*HNO3*OH + r77*CLONO2*CL + r79*CLONO2*O + r80*CLONO2*OH + + r110*BRONO2*O + r124*F*HNO3 + r192*PAN*OH + .5*r241*M*MPAN*OH + - j18*NO3 - j19*NO3 - r379*NO3 - r48*HO2*NO3 - r49*NO*NO3 - r50*O*NO3 - r51*OH*NO3 + - r59*M*NO2*NO3 - r145*CH2O*NO3 - r177*CH3CHO*NO3 - r196*C3H6*NO3 - r203*CH3COCHO*NO3 + - r217*BIGENE*NO3 - r225*MACRO2*NO3 - r236*MCO3*NO3 - r259*ISOPAO2*NO3 - r265*ISOPBO2*NO3 + - r268*ISOP*NO3 - r273*ISOPNO3*NO3 - r284*XO2*NO3 - r329*BCARY*NO3 - r332*MTERP*NO3 + - r338*NTERPO2*NO3 - r349*TERPROD1*NO3 - r352*DMS*NO3 + d(NOA)/dt = r196*C3H6*NO3 + .5*r267*ISOPNITB*OH + r274*ISOPNOOH*OH + r278*NC4CH2OH*OH + r279*NC4CHO*OH + - j58*NOA - r207*OH*NOA + d(NTERPOOH)/dt = r336*NTERPO2*HO2 + - j59*NTERPOOH - r380*NTERPOOH - r339*OH*NTERPOOH + 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 = j2*H2O + 2*j5*O2 + j6*O2 + j8*O3 + j14*N2O5 + j15*NO + j17*NO2 + j18*NO3 + .18*j40*CH4 + + j42*CO2 + j76*BRO + j94*CLO + j108*OCLO + j110*CO2 + j127*O2 + j128*O2 + j129*O2 + j131*O2 + + j132*O2 + j133*O2 + 2*j134*O2 + 2*j135*O2 + j138*SO + j139*SO2 + j140*SO3 + r5*N2*O1D + + r6*O1D*O2 + r7*O1D*O2 + r24*H*HO2 + r34*OH*OH + r40*N*NO + r41*N*NO2 + r44*N*O2 + r356*S*O2 + + r363*SO*O2 + r433*NOp*e + 1.15*r434*O2p*e + r441*Np*O2 + r442*O2p*N + r447*Op*O2 + - j120*O - j121*O - j122*O - j123*O - j124*O - j125*O - r17*O3*O - 2*r18*M*O*O - r19*M*O2*O + - r20*H2*O - r21*H2O2*O - r26*HO2*O - r32*OH*O - r45*NO2*O - r47*M*NO2*O - r50*NO3*O + - r55*M*NO*O - r79*CLONO2*O - r81*CLO*O - r84*HCL*O - r87*HOCL*O - r110*BRONO2*O - r111*BRO*O + - r113*HBR*O - r115*HOBR*O - r146*CH2O*O - r354*OCS*O - r437*N2p*O - r438*N2p*O - r439*Np*O + d(O2)/dt = j8*O3 + j19*NO3 + r1*O2_1D + r2*O2_1S + r9*N2*O2_1D + r8*O1D*O3 + r8*O1D*O3 + r10*O2_1D*O + + 2*r11*O2_1D*O2 + 2*r17*O*O3 + r18*M*O*O + r22*H*HO2 + r26*HO2*O + 2*r27*HO2*O3 + r28*H*O3 + + r31*OH*HO2 + r32*OH*O + r33*OH*O3 + r36*HO2*HO2 + r37*HO2NO2*OH + r43*N*NO2 + r45*NO2*O + + r46*NO2*O3 + r48*NO3*HO2 + r50*NO3*O + r54*NO*O3 + r57*O1D*N2O + r68*CL*HO2 + r70*CL*O3 + + r72*CLO*CLO + r73*CLO*CLO + r75*CLO*HO2 + r81*CLO*O + r83*CLO*OH + r101*BR*HO2 + r102*BR*O3 + + r103*BRO*BRO + r105*BRO*CLO + r106*BRO*CLO + r107*BRO*HO2 + r111*BRO*O + r150*CH3O2*HO2 + + r171*C2H5O2*HO2 + r199*C3H7O2*HO2 + r208*PO2*HO2 + r358*S*O3 + r364*SO*O3 + r444*O2p*NO + - j5*O2 - j6*O2 - j126*O2 - j127*O2 - j128*O2 - j129*O2 - j130*O2 - j131*O2 - j132*O2 + - j133*O2 - j134*O2 - j135*O2 - r6*O1D*O2 - r11*O2_1D*O2 - r19*M*O*O2 - r25*M*H*O2 - r39*N2D*O2 + - r44*N*O2 - r189*EO*O2 - r356*S*O2 - r363*SO*O2 - r436*N2p*O2 - r440*Np*O2 - r441*Np*O2 + - r447*Op*O2 + d(O3)/dt = r19*M*O*O2 + .15*r182*CH3CO3*HO2 + .15*r233*MCO3*HO2 + - j7*O3 - j8*O3 - r8*O1D*O3 - r17*O*O3 - r27*HO2*O3 - r28*H*O3 - r33*OH*O3 - r46*NO2*O3 + - r54*NO*O3 - r70*CL*O3 - r102*BR*O3 - r168*C2H4*O3 - r197*C3H6*O3 - r228*MACR*O3 - r242*MVK*O3 + - r275*ISOP*O3 - r313*PHENO*O3 - r330*BCARY*O3 - r333*MTERP*O3 - r358*S*O3 - r364*SO*O3 + d(O3S)/dt = 0 + d(OCLO)/dt = r74*CLO*CLO + r104*BRO*CLO + - j108*OCLO - r365*SO*OCLO + d(OCS)/dt = - j137*OCS - r354*O*OCS - r355*OH*OCS + d(ONITR)/dt = r221*HONITR*OH + .1*r342*TERP2O2*NO + - j60*ONITR - r381*ONITR + d(PAN)/dt = r194*M*CH3CO3*NO2 + - j61*PAN - r195*M*PAN - r192*OH*PAN + d(PBZNIT)/dt = r315*M*ACBZO2*NO2 + - r320*M*PBZNIT + d(PHENO)/dt = j32*C6H5OOH + r297*C6H5O2*NO + .07*r299*CRESOL*OH + .06*r311*PHENOL*OH + .07*r327*XYLOL*OH + - r312*NO2*PHENO - r313*O3*PHENO + d(PHENOL)/dt = .53*r288*BENZENE*OH + - r311*OH*PHENOL + d(PHENOOH)/dt = r309*PHENO2*HO2 + - j62*PHENOOH - r314*OH*PHENOOH + d(pombb1_a1)/dt = 0 + d(pombb1_a4)/dt = 0 + d(pomff1_a1)/dt = 0 + d(pomff1_a4)/dt = 0 + d(POOH)/dt = r208*PO2*HO2 + - j63*POOH - r210*OH*POOH + d(ROOH)/dt = .85*r212*RO2*HO2 + - j64*ROOH - r214*OH*ROOH + d(S)/dt = j137*OCS + j138*SO + - r356*O2*S - r358*O3*S - r361*OH*S + d(SF6)/dt = - j109*SF6 + d(SO)/dt = j139*SO2 + r354*OCS*O + r356*S*O2 + r358*S*O3 + r361*S*OH + - j138*SO - r359*BRO*SO - r360*CLO*SO - r362*NO2*SO - r363*O2*SO - r364*O3*SO - r365*OCLO*SO + - r366*OH*SO + d(SO2)/dt = j140*SO3 + r352*DMS*NO3 + r353*DMS*OH + r355*OCS*OH + r359*SO*BRO + r360*SO*CLO + r362*SO*NO2 + + r363*SO*O2 + r364*SO*O3 + r365*SO*OCLO + r366*SO*OH + .5*r367*DMS*OH + - j139*SO2 - r357*M*OH*SO2 + d(SO3)/dt = j136*H2SO4 + r357*M*SO2*OH + - j140*SO3 - r368*H2O*SO3 + d(so4_a1)/dt = 0 + d(so4_a2)/dt = 0 + d(so4_a3)/dt = 0 + d(so4_a5)/dt = 0 + d(soabb1_a1)/dt = - j141*soabb1_a1 + d(soabb1_a2)/dt = - j142*soabb1_a2 + d(soabb2_a1)/dt = - j143*soabb2_a1 + d(soabb2_a2)/dt = - j144*soabb2_a2 + d(soabb3_a1)/dt = - j145*soabb3_a1 + d(soabb3_a2)/dt = - j146*soabb3_a2 + d(soabb4_a1)/dt = - j147*soabb4_a1 + d(soabb4_a2)/dt = - j148*soabb4_a2 + d(soabb5_a1)/dt = - j149*soabb5_a1 + d(soabb5_a2)/dt = - j150*soabb5_a2 + d(soabg1_a1)/dt = - j151*soabg1_a1 + d(soabg1_a2)/dt = - j152*soabg1_a2 + d(soabg2_a1)/dt = - j153*soabg2_a1 + d(soabg2_a2)/dt = - j154*soabg2_a2 + d(soabg3_a1)/dt = - j155*soabg3_a1 + d(soabg3_a2)/dt = - j156*soabg3_a2 + d(soabg4_a1)/dt = - j157*soabg4_a1 + d(soabg4_a2)/dt = - j158*soabg4_a2 + d(soabg5_a1)/dt = - j159*soabg5_a1 + d(soabg5_a2)/dt = - j160*soabg5_a2 + d(soaff1_a1)/dt = - j161*soaff1_a1 + d(soaff1_a2)/dt = - j162*soaff1_a2 + d(soaff2_a1)/dt = - j163*soaff2_a1 + d(soaff2_a2)/dt = - j164*soaff2_a2 + d(soaff3_a1)/dt = - j165*soaff3_a1 + d(soaff3_a2)/dt = - j166*soaff3_a2 + d(soaff4_a1)/dt = - j167*soaff4_a1 + d(soaff4_a2)/dt = - j168*soaff4_a2 + d(soaff5_a1)/dt = - j169*soaff5_a1 + d(soaff5_a2)/dt = - j170*soaff5_a2 + d(SOAGbb0)/dt = .2381*r396*IVOCbbO2VBS*HO2 + .1056*r397*IVOCbbO2VBS*NO + .5931*r407*SVOCbb*OH + d(SOAGbb1)/dt = .1308*r396*IVOCbbO2VBS*HO2 + .1026*r397*IVOCbbO2VBS*NO + .1534*r407*SVOCbb*OH + d(SOAGbb2)/dt = .0348*r396*IVOCbbO2VBS*HO2 + .0521*r397*IVOCbbO2VBS*NO + .0459*r407*SVOCbb*OH + d(SOAGbb3)/dt = .0076*r396*IVOCbbO2VBS*HO2 + .0143*r397*IVOCbbO2VBS*NO + .0085*r407*SVOCbb*OH + d(SOAGbb4)/dt = .0113*r396*IVOCbbO2VBS*HO2 + .0166*r397*IVOCbbO2VBS*NO + .0128*r407*SVOCbb*OH + d(SOAGbg0)/dt = r412*GLYOXAL + .2202*r384*BCARYO2VBS*HO2 + .1279*r385*BCARYO2VBS*NO + .2202*r386*BCARY*O3 + + .0031*r392*ISOPO2VBS*HO2 + .0003*r393*ISOPO2VBS*NO + .0508*r403*MTERPO2VBS*HO2 + + .0245*r404*MTERPO2VBS*NO + .0508*r405*MTERP*O3 + d(SOAGbg1)/dt = .2067*r384*BCARYO2VBS*HO2 + .1792*r385*BCARYO2VBS*NO + .2067*r386*BCARY*O3 + + .0035*r392*ISOPO2VBS*HO2 + .0003*r393*ISOPO2VBS*NO + .1149*r403*MTERPO2VBS*HO2 + + .0082*r404*MTERPO2VBS*NO + .1149*r405*MTERP*O3 + d(SOAGbg2)/dt = .0653*r384*BCARYO2VBS*HO2 + .0676*r385*BCARYO2VBS*NO + .0653*r386*BCARY*O3 + + .0003*r392*ISOPO2VBS*HO2 + .0073*r393*ISOPO2VBS*NO + .0348*r403*MTERPO2VBS*HO2 + + .0772*r404*MTERPO2VBS*NO + .0348*r405*MTERP*O3 + d(SOAGbg3)/dt = .17493*r383*BCARY*NO3 + .1284*r384*BCARYO2VBS*HO2 + .079*r385*BCARYO2VBS*NO + + .1284*r386*BCARY*O3 + .059024*r391*ISOP*NO3 + .0271*r392*ISOPO2VBS*HO2 + + .0057*r393*ISOPO2VBS*NO + .0033*r394*ISOP*O3 + .17493*r402*MTERP*NO3 + + .0554*r403*MTERPO2VBS*HO2 + .0332*r404*MTERPO2VBS*NO + .0554*r405*MTERP*O3 + d(SOAGbg4)/dt = .59019*r383*BCARY*NO3 + .114*r384*BCARYO2VBS*HO2 + .1254*r385*BCARYO2VBS*NO + + .114*r386*BCARY*O3 + .025024*r391*ISOP*NO3 + .0474*r392*ISOPO2VBS*HO2 + + .0623*r393*ISOPO2VBS*NO + .59019*r402*MTERP*NO3 + .1278*r403*MTERPO2VBS*HO2 + + .13*r404*MTERPO2VBS*NO + .1278*r405*MTERP*O3 + d(SOAGff0)/dt = .0023*r389*BENZO2VBS*HO2 + .0097*r390*BENZO2VBS*NO + .2381*r399*IVOCffO2VBS*HO2 + + .1056*r400*IVOCffO2VBS*NO + .5931*r408*SVOCff*OH + .1364*r410*TOLUO2VBS*HO2 + + .0154*r411*TOLUO2VBS*NO + .1677*r414*XYLEO2VBS*HO2 + .0063*r415*XYLEO2VBS*NO + d(SOAGff1)/dt = .0008*r389*BENZO2VBS*HO2 + .0034*r390*BENZO2VBS*NO + .1308*r399*IVOCffO2VBS*HO2 + + .1026*r400*IVOCffO2VBS*NO + .1534*r408*SVOCff*OH + .0101*r410*TOLUO2VBS*HO2 + + .0452*r411*TOLUO2VBS*NO + .0174*r414*XYLEO2VBS*HO2 + .0237*r415*XYLEO2VBS*NO + d(SOAGff2)/dt = .0843*r389*BENZO2VBS*HO2 + .1579*r390*BENZO2VBS*NO + .0348*r399*IVOCffO2VBS*HO2 + + .0521*r400*IVOCffO2VBS*NO + .0459*r408*SVOCff*OH + .0763*r410*TOLUO2VBS*HO2 + + .0966*r411*TOLUO2VBS*NO + .086*r414*XYLEO2VBS*HO2 + .0025*r415*XYLEO2VBS*NO + d(SOAGff3)/dt = .0443*r389*BENZO2VBS*HO2 + .0059*r390*BENZO2VBS*NO + .0076*r399*IVOCffO2VBS*HO2 + + .0143*r400*IVOCffO2VBS*NO + .0085*r408*SVOCff*OH + .2157*r410*TOLUO2VBS*HO2 + + .0073*r411*TOLUO2VBS*NO + .0512*r414*XYLEO2VBS*HO2 + .011*r415*XYLEO2VBS*NO + d(SOAGff4)/dt = .1621*r389*BENZO2VBS*HO2 + .0536*r390*BENZO2VBS*NO + .0113*r399*IVOCffO2VBS*HO2 + + .0166*r400*IVOCffO2VBS*NO + .0128*r408*SVOCff*OH + .0738*r410*TOLUO2VBS*HO2 + + .238*r411*TOLUO2VBS*NO + .1598*r414*XYLEO2VBS*HO2 + .1185*r415*XYLEO2VBS*NO + d(ST80_25)/dt = - r451*ST80_25 + d(SVOCbb)/dt = - r407*OH*SVOCbb + d(SVOCff)/dt = - r408*OH*SVOCff + d(TEPOMUC)/dt = .1*r319*TOLUENE*OH + .23*r321*XYLENES*OH + - j65*TEPOMUC + d(TERP2OOH)/dt = r341*TERP2O2*HO2 + - j66*TERP2OOH - r343*OH*TERP2OOH + d(TERPNIT)/dt = .5*r335*NTERPO2*CH3O2 + .2*r337*NTERPO2*NO + .2*r347*TERPO2*NO + - j67*TERPNIT - r382*TERPNIT - r344*OH*TERPNIT + d(TERPOOH)/dt = r346*TERPO2*HO2 + - j68*TERPOOH - r348*OH*TERPOOH + d(TERPROD1)/dt = j59*NTERPOOH + j67*TERPNIT + j68*TERPOOH + .33*r330*BCARY*O3 + .33*r333*MTERP*O3 + + .5*r335*NTERPO2*CH3O2 + .8*r337*NTERPO2*NO + r338*NTERPO2*NO3 + r344*TERPNIT*OH + + r345*TERPO2*CH3O2 + .8*r347*TERPO2*NO + - j69*TERPROD1 - r349*NO3*TERPROD1 - r350*OH*TERPROD1 + d(TERPROD2)/dt = j66*TERP2OOH + j69*TERPROD1 + .3*r330*BCARY*O3 + .3*r333*MTERP*O3 + r340*TERP2O2*CH3O2 + + .9*r342*TERP2O2*NO + - j70*TERPROD2 - r351*OH*TERPROD2 + d(TOLOOH)/dt = r316*TOLO2*HO2 + - j71*TOLOOH - r318*OH*TOLOOH + d(TOLUENE)/dt = - r319*OH*TOLUENE - r409*OH*TOLUENE + d(TOLUO2VBS)/dt = r409*TOLUENE*OH + - r410*HO2*TOLUO2VBS - r411*NO*TOLUO2VBS + d(XOOH)/dt = r282*XO2*HO2 + - j72*XOOH - r285*OH*XOOH + d(XYLENES)/dt = - r321*OH*XYLENES + d(XYLENOOH)/dt = r322*XYLENO2*HO2 + - j73*XYLENOOH - r324*OH*XYLENOOH + d(XYLEO2VBS)/dt = r413*XYLENES*OH + - r414*HO2*XYLEO2VBS - r415*NO*XYLEO2VBS + d(XYLOL)/dt = .15*r321*XYLENES*OH + - r327*OH*XYLOL + d(XYLOLOOH)/dt = r325*XYLOLO2*HO2 + - j74*XYLOLOOH - r328*OH*XYLOLOOH + d(NHDEP)/dt = r377*NH4 + r369*NH3*OH + d(NDEP)/dt = .5*r241*M*MPAN*OH + r302*M*DICARBO2*NO2 + r305*M*MALO2*NO2 + r308*M*MDIALO2*NO2 + r312*PHENO*NO2 + + .2*r337*NTERPO2*NO + .5*r349*TERPROD1*NO3 + d(ACBZO2)/dt = r320*M*PBZNIT + r292*BZALD*OH + - r286*HO2*ACBZO2 - r287*NO*ACBZO2 - r315*M*NO2*ACBZO2 + d(ALKO2)/dt = r250*ALKOOH*OH + r251*BIGALK*OH + - r247*HO2*ALKO2 - r248*NO*ALKO2 - r249*NO*ALKO2 + d(BENZO2)/dt = .35*r288*BENZENE*OH + r291*BENZOOH*OH + - r289*HO2*BENZO2 - r290*NO*BENZO2 + d(BZOO)/dt = r294*BZOOH*OH + .07*r319*TOLUENE*OH + .06*r321*XYLENES*OH + - r293*HO2*BZOO - r295*NO*BZOO + d(C2H5O2)/dt = j53*MEK + .5*r174*C2H5OOH*OH + r175*C2H6*CL + r176*C2H6*OH + - 2*r169*C2H5O2*C2H5O2 - r170*CH3O2*C2H5O2 - r171*HO2*C2H5O2 - r172*NO*C2H5O2 + d(C3H7O2)/dt = r201*C3H7OOH*OH + r202*C3H8*OH + r205*CL*C3H8 + - r198*CH3O2*C3H7O2 - r199*HO2*C3H7O2 - r200*NO*C3H7O2 + d(C6H5O2)/dt = .4*r286*ACBZO2*HO2 + r287*ACBZO2*NO + r298*C6H5OOH*OH + r313*PHENO*O3 + - r296*HO2*C6H5O2 - r297*NO*C6H5O2 + d(CH3CO3)/dt = .13*j24*BIGALD + j28*BIGALD4 + j36*CH3COCH3 + j37*CH3COCHO + .33*j46*HONITR + j48*HYAC + + 1.34*j51*MACR + j53*MEK + j54*MEKOOH + .3*j56*MVK + j58*NOA + .6*j61*PAN + j64*ROOH + + .5*j65*TEPOMUC + .65*j70*TERPROD2 + r195*M*PAN + r177*CH3CHO*NO3 + r178*CH3CHO*OH + + .5*r185*CH3COOOH*OH + r203*CH3COCHO*NO3 + r204*CH3COCHO*OH + .3*r211*RO2*CH3O2 + + .15*r212*RO2*HO2 + r213*RO2*NO + .53*r222*MACRO2*CH3CO3 + .26*r223*MACRO2*CH3O2 + + .53*r225*MACRO2*NO3 + .53*r226*MACRO2*NO + .1*r228*MACR*O3 + r232*MCO3*CH3O2 + + .45*r233*MCO3*HO2 + 2*r234*MCO3*MCO3 + r235*MCO3*NO + r236*MCO3*NO3 + .2*r237*MEKO2*HO2 + + r238*MEKO2*NO + .28*r242*MVK*O3 + .08*r275*ISOP*O3 + .06*r330*BCARY*O3 + .06*r333*MTERP*O3 + + .65*r351*TERPROD2*OH + - 2*r180*CH3CO3*CH3CO3 - r181*CH3O2*CH3CO3 - r182*HO2*CH3CO3 - r183*NO*CH3CO3 + - r194*M*NO2*CH3CO3 - r222*MACRO2*CH3CO3 - r255*ISOPAO2*CH3CO3 - r260*ISOPBO2*CH3CO3 + - r269*ISOPNO3*CH3CO3 - r280*XO2*CH3CO3 + d(CH3O2)/dt = j35*CH3CHO + j36*CH3COCH3 + j38*CH3COOOH + j41*CH4 + .3*j56*MVK + .4*j61*PAN + j88*CH3BR + + j90*CH3CL + r65*CL*CH4 + r121*F*CH4 + .7*r153*CH3OOH*OH + r154*CH4*OH + r160*O1D*CH4 + + 2*r180*CH3CO3*CH3CO3 + .9*r181*CH3CO3*CH3O2 + .45*r182*CH3CO3*HO2 + r183*CH3CO3*NO + + r184*CH3COOH*OH + .28*r197*C3H6*O3 + r222*MACRO2*CH3CO3 + r231*MCO3*CH3CO3 + + r255*ISOPAO2*CH3CO3 + r260*ISOPBO2*CH3CO3 + r269*ISOPNO3*CH3CO3 + .05*r275*ISOP*O3 + + r280*XO2*CH3CO3 + .33*r300*DICARBO2*HO2 + .83*r301*DICARBO2*NO + .07*r306*MDIALO2*HO2 + + .17*r307*MDIALO2*NO + - r71*CLO*CH3O2 - 2*r148*CH3O2*CH3O2 - 2*r149*CH3O2*CH3O2 - r150*HO2*CH3O2 - r151*NO*CH3O2 + - r170*C2H5O2*CH3O2 - r181*CH3CO3*CH3O2 - r198*C3H7O2*CH3O2 - r211*RO2*CH3O2 + - r223*MACRO2*CH3O2 - r232*MCO3*CH3O2 - r256*ISOPAO2*CH3O2 - r261*ISOPBO2*CH3O2 + - r270*ISOPNO3*CH3O2 - r281*XO2*CH3O2 - r335*NTERPO2*CH3O2 - r340*TERP2O2*CH3O2 + - r345*TERPO2*CH3O2 + d(DICARBO2)/dt = .6*j26*BIGALD2 + - r300*HO2*DICARBO2 - r301*NO*DICARBO2 - r302*M*NO2*DICARBO2 + d(e)/dt = j113*N2 + j114*N2 + j115*N2 + j116*N2 + j117*N2 + j119*N2 + j16*NO + j111*N + j120*O + j121*O + + j122*O + j123*O + j124*O + j125*O + j126*O2 + j127*O2 + j128*O2 + j129*O2 + j130*O2 + + j131*O2 + j132*O2 + j133*O2 + - r433*NOp*e - r434*O2p*e - r435*N2p*e + d(ENEO2)/dt = r218*BIGENE*OH + - r219*NO*ENEO2 - r220*NO*ENEO2 + d(EO)/dt = j43*EOOH + .75*r187*EO2*NO + - r188*EO - r189*O2*EO + d(EO2)/dt = r193*M*C2H4*OH + - r186*HO2*EO2 - r187*NO*EO2 + d(HO2)/dt = j11*HO2NO2 + j20*ALKNIT + .9*j21*ALKOOH + j22*BENZOOH + 1.5*j23*BEPOMUC + .56*j24*BIGALD + + j25*BIGALD1 + .6*j26*BIGALD2 + .6*j27*BIGALD3 + j28*BIGALD4 + j29*BZOOH + j30*C2H5OOH + + j31*C3H7OOH + j35*CH3CHO + j37*CH3COCHO + 2*j44*GLYALD + 2*j45*GLYOXAL + .67*j46*HONITR + + j47*HPALD + j48*HYAC + j49*ISOPNOOH + j50*ISOPOOH + 1.34*j51*MACR + .66*j52*MACR + j57*NC4CHO + + j62*PHENOOH + j63*POOH + j65*TEPOMUC + j66*TERP2OOH + j67*TERPNIT + j68*TERPOOH + + j69*TERPROD1 + 1.2*j70*TERPROD2 + j71*TOLOOH + j73*XYLENOOH + j74*XYLOLOOH + r62*M*HO2NO2 + + r158*HOCH2OO + r188*EO + r263*ISOPBO2 + r21*H2O2*O + r25*M*H*O2 + r30*OH*H2O2 + r33*OH*O3 + + r51*NO3*OH + r64*CL*CH2O + r67*CL*H2O2 + r71*CLO*CH3O2 + r82*CLO*OH + r100*BR*CH2O + + r112*BRO*OH + r129*CH3BR*CL + r130*CH3BR*OH + r132*CH3CL*CL + r133*CH3CL*OH + r145*CH2O*NO3 + + r146*CH2O*O + 2*r148*CH3O2*CH3O2 + r151*CH3O2*NO + r152*CH3OH*OH + r155*M*HCN*OH + + r156*HCOOH*OH + r159*HOCH2OO*NO + r161*O1D*CH4 + r164*CO*OH + .35*r166*M*C2H2*OH + + .13*r168*C2H4*O3 + 1.2*r169*C2H5O2*C2H5O2 + r170*C2H5O2*CH3O2 + r172*C2H5O2*NO + r173*C2H5OH*OH + + r179*CH3CN*OH + .9*r181*CH3CO3*CH3O2 + .25*r187*EO2*NO + r189*EO*O2 + r190*GLYALD*OH + + r191*GLYOXAL*OH + .28*r197*C3H6*O3 + r198*C3H7O2*CH3O2 + r200*C3H7O2*NO + r206*HYAC*OH + + r209*PO2*NO + .3*r211*RO2*CH3O2 + r219*ENEO2*NO + r221*HONITR*OH + .47*r222*MACRO2*CH3CO3 + + .73*r223*MACRO2*CH3O2 + .47*r225*MACRO2*NO3 + .47*r226*MACRO2*NO + .14*r228*MACR*O3 + + .2*r230*MACROOH*OH + r232*MCO3*CH3O2 + .5*r241*M*MPAN*OH + .28*r242*MVK*O3 + r248*ALKO2*NO + + r255*ISOPAO2*CH3CO3 + r256*ISOPAO2*CH3O2 + .92*r258*ISOPAO2*NO + r259*ISOPAO2*NO3 + + r260*ISOPBO2*CH3CO3 + r261*ISOPBO2*CH3O2 + .92*r264*ISOPBO2*NO + r265*ISOPBO2*NO3 + + .3*r266*ISOPNITA*OH + r267*ISOPNITB*OH + r269*ISOPNO3*CH3CO3 + 1.2*r270*ISOPNO3*CH3O2 + + r272*ISOPNO3*NO + r273*ISOPNO3*NO3 + r274*ISOPNOOH*OH + .37*r275*ISOP*O3 + r278*NC4CH2OH*OH + + r279*NC4CHO*OH + r280*XO2*CH3CO3 + .8*r281*XO2*CH3O2 + r283*XO2*NO + r284*XO2*NO3 + + .65*r288*BENZENE*OH + r290*BENZO2*NO + r295*BZOO*NO + .73*r299*CRESOL*OH + + .07*r300*DICARBO2*HO2 + .17*r301*DICARBO2*NO + .16*r303*MALO2*HO2 + .4*r304*MALO2*NO + + .33*r306*MDIALO2*HO2 + .83*r307*MDIALO2*NO + r310*PHENO2*NO + .8*r311*PHENOL*OH + r317*TOLO2*NO + + .28*r319*TOLUENE*OH + .38*r321*XYLENES*OH + r323*XYLENO2*NO + r326*XYLOLO2*NO + + .63*r327*XYLOL*OH + .57*r330*BCARY*O3 + .57*r333*MTERP*O3 + .5*r335*NTERPO2*CH3O2 + + r340*TERP2O2*CH3O2 + .9*r342*TERP2O2*NO + r345*TERPO2*CH3O2 + .8*r347*TERPO2*NO + + .2*r351*TERPROD2*OH + r357*M*SO2*OH + .5*r367*DMS*OH + - r370*HO2 - r22*H*HO2 - r23*H*HO2 - r24*H*HO2 - r26*O*HO2 - r27*O3*HO2 - r31*OH*HO2 + - 2*r36*HO2*HO2 - r48*NO3*HO2 - r53*NO*HO2 - r58*M*NO2*HO2 - r68*CL*HO2 - r69*CL*HO2 + - r75*CLO*HO2 - r101*BR*HO2 - r107*BRO*HO2 - r144*CH2O*HO2 - r150*CH3O2*HO2 - r157*HOCH2OO*HO2 + - r171*C2H5O2*HO2 - r182*CH3CO3*HO2 - r186*EO2*HO2 - r199*C3H7O2*HO2 - r208*PO2*HO2 + - r212*RO2*HO2 - r224*MACRO2*HO2 - r233*MCO3*HO2 - r237*MEKO2*HO2 - r247*ALKO2*HO2 + - r257*ISOPAO2*HO2 - r262*ISOPBO2*HO2 - r271*ISOPNO3*HO2 - r282*XO2*HO2 - r286*ACBZO2*HO2 + - r289*BENZO2*HO2 - r293*BZOO*HO2 - r296*C6H5O2*HO2 - r300*DICARBO2*HO2 - r303*MALO2*HO2 + - r306*MDIALO2*HO2 - r309*PHENO2*HO2 - r316*TOLO2*HO2 - r322*XYLENO2*HO2 - r325*XYLOLO2*HO2 + - r336*NTERPO2*HO2 - r341*TERP2O2*HO2 - r346*TERPO2*HO2 + d(HOCH2OO)/dt = r144*CH2O*HO2 + - r158*HOCH2OO - r157*HO2*HOCH2OO - r159*NO*HOCH2OO + d(ISOPAO2)/dt = .6*r276*ISOP*OH + - r255*CH3CO3*ISOPAO2 - r256*CH3O2*ISOPAO2 - r257*HO2*ISOPAO2 - r258*NO*ISOPAO2 + - r259*NO3*ISOPAO2 + d(ISOPBO2)/dt = .4*r276*ISOP*OH + - r263*ISOPBO2 - r260*CH3CO3*ISOPBO2 - r261*CH3O2*ISOPBO2 - r262*HO2*ISOPBO2 + - r264*NO*ISOPBO2 - r265*NO3*ISOPBO2 + d(MACRO2)/dt = .5*r229*MACR*OH + .2*r230*MACROOH*OH + r243*MVK*OH + - r222*CH3CO3*MACRO2 - r223*CH3O2*MACRO2 - r224*HO2*MACRO2 - r225*NO3*MACRO2 - r226*NO*MACRO2 + - r227*NO*MACRO2 + d(MALO2)/dt = .6*j25*BIGALD1 + - r303*HO2*MALO2 - r304*NO*MALO2 - r305*M*NO2*MALO2 + d(MCO3)/dt = .66*j51*MACR + j55*MPAN + r245*M*MPAN + .5*r229*MACR*OH + .5*r230*MACROOH*OH + - r231*CH3CO3*MCO3 - r232*CH3O2*MCO3 - r233*HO2*MCO3 - 2*r234*MCO3*MCO3 - r235*NO*MCO3 + - r236*NO3*MCO3 - r244*M*NO2*MCO3 + d(MDIALO2)/dt = .6*j27*BIGALD3 + - r306*HO2*MDIALO2 - r307*NO*MDIALO2 - r308*M*NO2*MDIALO2 + d(MEKO2)/dt = r239*MEK*OH + r240*MEKOOH*OH + - r237*HO2*MEKO2 - r238*NO*MEKO2 + d(N2D)/dt = 1.2*j112*N2 + j113*N2 + j117*N2 + 1.2*j118*N2 + .8*r433*NOp*e + .9*r435*N2p*e + r437*N2p*O + - r38*O*N2D - r39*O2*N2D + d(N2p)/dt = j114*N2 + j119*N2 + - r435*e*N2p - r436*O2*N2p - r437*O*N2p - r438*O*N2p + d(NOp)/dt = j16*NO + r443*N2*O2p + r446*N2*Op + r437*N2p*O + r441*Np*O2 + r442*O2p*N + r444*O2p*NO + - r433*e*NOp + d(Np)/dt = j113*N2 + j115*N2 + j116*N2 + j117*N2 + j111*N + - r439*O*Np - r440*O2*Np - r441*O2*Np + d(NTERPO2)/dt = r329*BCARY*NO3 + r332*MTERP*NO3 + r339*NTERPOOH*OH + .5*r349*TERPROD1*NO3 + - r335*CH3O2*NTERPO2 - r336*HO2*NTERPO2 - r337*NO*NTERPO2 - r338*NO3*NTERPO2 + d(O1D)/dt = j1*H2O + j6*O2 + j7*O3 + j12*N2O + r39*N2D*O2 + .85*r434*O2p*e + - r5*N2*O1D - r3*H2*O1D - r4*H2O*O1D - r6*O2*O1D - r7*O2*O1D - r8*O3*O1D - r56*N2O*O1D + - r57*N2O*O1D - r89*CCL4*O1D - r90*CF2CLBR*O1D - r91*CFC11*O1D - r92*CFC113*O1D - r93*CFC114*O1D + - r94*CFC115*O1D - r95*CFC12*O1D - r96*HCL*O1D - r97*HCL*O1D - r116*CF3BR*O1D - r117*CHBR3*O1D + - r118*H2402*O1D - r119*HBR*O1D - r120*HBR*O1D - r125*COF2*O1D - r126*COFCL*O1D + - r139*CH2BR2*O1D - r140*CH3BR*O1D - r141*HCFC141B*O1D - r142*HCFC142B*O1D - r143*HCFC22*O1D + - r160*CH4*O1D - r161*CH4*O1D - r162*CH4*O1D - r163*HCN*O1D + d(O2_1D)/dt = j7*O3 + r13*N2*O2_1S + r12*O2_1S*CO2 + r14*O2_1S*O + r15*O2_1S*O2 + r16*O2_1S*O3 + - r1*O2_1D - r9*N2*O2_1D - r10*O*O2_1D - r11*O2*O2_1D + d(O2_1S)/dt = r6*O1D*O2 + - r2*O2_1S - r13*N2*O2_1S - r12*CO2*O2_1S - r14*O*O2_1S - r15*O2*O2_1S - r16*O3*O2_1S + d(O2p)/dt = j126*O2 + j130*O2 + r436*N2p*O2 + r440*Np*O2 + r445*Op*CO2 + r447*Op*O2 + - r443*N2*O2p - r434*e*O2p - r442*N*O2p - r444*NO*O2p + d(OH)/dt = j3*H2O + 2*j4*H2O2 + j9*HNO3 + j10*HO2NO2 + j21*ALKOOH + j22*BENZOOH + j29*BZOOH + j30*C2H5OOH + + j31*C3H7OOH + j32*C6H5OOH + j38*CH3COOOH + j39*CH3OOH + .33*j40*CH4 + j43*EOOH + j47*HPALD + + j50*ISOPOOH + j54*MEKOOH + j59*NTERPOOH + j62*PHENOOH + j63*POOH + j64*ROOH + j66*TERP2OOH + + j68*TERPOOH + j71*TOLOOH + j72*XOOH + j73*XYLENOOH + j74*XYLOLOOH + j106*HOBR + j107*HOCL + + .5*r378*NO2 + r3*O1D*H2 + 2*r4*O1D*H2O + r20*H2*O + r21*H2O2*O + 2*r23*H*HO2 + r26*HO2*O + + r27*HO2*O3 + r28*H*O3 + r48*NO3*HO2 + r53*NO*HO2 + r69*CL*HO2 + r84*HCL*O + r87*HOCL*O + + r96*O1D*HCL + r113*HBR*O + r115*HOBR*O + r119*O1D*HBR + r123*F*H2O + r146*CH2O*O + + .3*r153*CH3OOH*OH + r160*O1D*CH4 + r163*O1D*HCN + .65*r166*M*C2H2*OH + .13*r168*C2H4*O3 + + .5*r174*C2H5OOH*OH + .45*r182*CH3CO3*HO2 + .36*r197*C3H6*O3 + .5*r210*POOH*OH + .15*r212*RO2*HO2 + + .24*r228*MACR*O3 + .1*r230*MACROOH*OH + .45*r233*MCO3*HO2 + .2*r237*MEKO2*HO2 + .36*r242*MVK*O3 + + .32*r275*ISOP*O3 + .6*r277*ISOPOOH*OH + .5*r285*XOOH*OH + .4*r286*ACBZO2*HO2 + + .4*r300*DICARBO2*HO2 + .4*r306*MDIALO2*HO2 + .63*r330*BCARY*O3 + .63*r333*MTERP*O3 + - r29*H2*OH - r30*H2O2*OH - r31*HO2*OH - r32*O*OH - r33*O3*OH - 2*r34*OH*OH - 2*r35*M*OH*OH + - r37*HO2NO2*OH - r51*NO3*OH - r52*N*OH - r60*M*NO2*OH - r61*HNO3*OH - r80*CLONO2*OH + - r82*CLO*OH - r83*CLO*OH - r85*HCL*OH - r88*HOCL*OH - r112*BRO*OH - r114*HBR*OH + - r128*CH2BR2*OH - r130*CH3BR*OH - r131*CH3CCL3*OH - r133*CH3CL*OH - r135*CHBR3*OH + - r136*HCFC141B*OH - r137*HCFC142B*OH - r138*HCFC22*OH - r147*CH2O*OH - r152*CH3OH*OH + - r153*CH3OOH*OH - r154*CH4*OH - r155*M*HCN*OH - r156*HCOOH*OH - r164*CO*OH - r166*M*C2H2*OH + - r173*C2H5OH*OH - r174*C2H5OOH*OH - r176*C2H6*OH - r178*CH3CHO*OH - r179*CH3CN*OH + - r184*CH3COOH*OH - r185*CH3COOOH*OH - r190*GLYALD*OH - r191*GLYOXAL*OH - r192*PAN*OH + - r193*M*C2H4*OH - r201*C3H7OOH*OH - r202*C3H8*OH - r204*CH3COCHO*OH - r206*HYAC*OH - r207*NOA*OH + - r210*POOH*OH - r214*ROOH*OH - r215*M*C3H6*OH - r216*CH3COCH3*OH - r218*BIGENE*OH + - r221*HONITR*OH - r229*MACR*OH - r230*MACROOH*OH - r239*MEK*OH - r240*MEKOOH*OH - r241*M*MPAN*OH + - r243*MVK*OH - r246*ALKNIT*OH - r250*ALKOOH*OH - r251*BIGALK*OH - r252*HPALD*OH + - r253*HYDRALD*OH - r254*IEPOX*OH - r266*ISOPNITA*OH - r267*ISOPNITB*OH - r274*ISOPNOOH*OH + - r276*ISOP*OH - r277*ISOPOOH*OH - r278*NC4CH2OH*OH - r279*NC4CHO*OH - r285*XOOH*OH + - r288*BENZENE*OH - r291*BENZOOH*OH - r292*BZALD*OH - r294*BZOOH*OH - r298*C6H5OOH*OH + - r299*CRESOL*OH - r311*PHENOL*OH - r314*PHENOOH*OH - r318*TOLOOH*OH - r319*TOLUENE*OH + - r321*XYLENES*OH - r324*XYLENOOH*OH - r327*XYLOL*OH - r328*XYLOLOOH*OH - r331*BCARY*OH + - r334*MTERP*OH - r339*NTERPOOH*OH - r343*TERP2OOH*OH - r344*TERPNIT*OH - r348*TERPOOH*OH + - r350*TERPROD1*OH - r351*TERPROD2*OH - r353*DMS*OH - r355*OCS*OH - r357*M*SO2*OH - r361*S*OH + - r366*SO*OH - r367*DMS*OH - r369*NH3*OH - r409*TOLUENE*OH + d(Op)/dt = j120*O + j121*O + j122*O + j123*O + j124*O + j125*O + j127*O2 + j128*O2 + j129*O2 + j131*O2 + + j132*O2 + j133*O2 + r438*N2p*O + r439*Np*O + - r446*N2*Op - r445*CO2*Op - r447*O2*Op + d(PHENO2)/dt = .2*r299*CRESOL*OH + .14*r311*PHENOL*OH + r314*PHENOOH*OH + - r309*HO2*PHENO2 - r310*NO*PHENO2 + d(PO2)/dt = .5*r210*POOH*OH + r215*M*C3H6*OH + - r208*HO2*PO2 - r209*NO*PO2 + d(RO2)/dt = .15*j70*TERPROD2 + r214*ROOH*OH + r216*CH3COCH3*OH + .06*r330*BCARY*O3 + .06*r333*MTERP*O3 + + .15*r351*TERPROD2*OH + - r211*CH3O2*RO2 - r212*HO2*RO2 - r213*NO*RO2 + d(TERP2O2)/dt = r343*TERP2OOH*OH + .5*r349*TERPROD1*NO3 + r350*TERPROD1*OH + - r340*CH3O2*TERP2O2 - r341*HO2*TERP2O2 - r342*NO*TERP2O2 + d(TERPO2)/dt = r331*BCARY*OH + r334*MTERP*OH + r348*TERPOOH*OH + - r345*CH3O2*TERPO2 - r346*HO2*TERPO2 - r347*NO*TERPO2 + d(TOLO2)/dt = r318*TOLOOH*OH + .65*r319*TOLUENE*OH + r409*TOLUENE*OH + - r316*HO2*TOLO2 - r317*NO*TOLO2 + d(XO2)/dt = r252*HPALD*OH + r253*HYDRALD*OH + r254*IEPOX*OH + .4*r277*ISOPOOH*OH + .5*r285*XOOH*OH + - r280*CH3CO3*XO2 - r281*CH3O2*XO2 - r282*HO2*XO2 - r283*NO*XO2 - r284*NO3*XO2 + d(XYLENO2)/dt = .56*r321*XYLENES*OH + r324*XYLENOOH*OH + - r322*HO2*XYLENO2 - r323*NO*XYLENO2 + d(XYLOLO2)/dt = .3*r327*XYLOL*OH + r328*XYLOLOOH*OH + - r325*HO2*XYLOLO2 - r326*NO*XYLOLO2 + d(H2O)/dt = .05*j40*CH4 + j136*H2SO4 + r370*HO2 + r24*H*HO2 + r29*OH*H2 + r30*OH*H2O2 + r31*OH*HO2 + + r34*OH*OH + r37*HO2NO2*OH + r61*HNO3*OH + r85*HCL*OH + r88*HOCL*OH + r114*HBR*OH + + r128*CH2BR2*OH + r130*CH3BR*OH + r131*CH3CCL3*OH + r133*CH3CL*OH + r138*HCFC22*OH + + r147*CH2O*OH + r153*CH3OOH*OH + r154*CH4*OH + r156*HCOOH*OH + r176*C2H6*OH + r178*CH3CHO*OH + + r184*CH3COOH*OH + r185*CH3COOOH*OH + r201*C3H7OOH*OH + r202*C3H8*OH + r204*CH3COCHO*OH + + r210*POOH*OH + r214*ROOH*OH + r216*CH3COCH3*OH + .5*r229*MACR*OH + r369*NH3*OH + r417*HOCL*HCL + + r423*HOCL*HCL + r424*HOBR*HCL + r428*HOCL*HCL + r429*HOBR*HCL + - j1*H2O - j2*H2O - j3*H2O - r4*O1D*H2O - r123*F*H2O - r368*SO3*H2O diff --git a/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/chem_mech.in b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/chem_mech.in new file mode 100644 index 0000000000..861fbed32f --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/chem_mech.in @@ -0,0 +1,1390 @@ +* Comments +* User-given Tag Description: TSMLT1.2-MAM5-extendedVBS +* Tag database identifier : MZ325_TSMLT1_fullVBS_20221223 +* Tag created by : lke +* Tag created from branch : TSMLT1-fullVBS +* Tag created on : 2022-12-22 17:04:17.603803-07 +* Comments for this tag follow: +* lke : 2022-12-22 : TSMLT1.2, updated to JPL19; MAM5; VBS-SOA for sectors + + SPECIES + + Solution + ALKNIT -> C5H11ONO2, + ALKOOH -> C5H12O2, + AOA_NH -> CO, + bc_a1 -> C, + bc_a4 -> C, + BCARY -> C15H24, + BCARYO2VBS -> C15H25O3, + BENZENE -> C6H6, + BENZO2VBS -> C6H7O5, + BENZOOH -> C6H8O5, + BEPOMUC -> C6H6O3, + BIGALD -> C5H6O2, + BIGALD1 -> C4H4O2, + BIGALD2 -> C5H6O2, + BIGALD3 -> C5H6O2, + BIGALD4 -> C6H8O2, + BIGALK -> C5H12, + BIGENE -> C4H8, + BR -> Br, + BRCL -> BrCl, + BRO -> BrO, + BRONO2 -> BrONO2, + BRY, + BZALD -> C7H6O, + BZOOH -> C7H8O2, + C2H2, + C2H4, + C2H5OH, + C2H5OOH, + C2H6, + C3H6, + C3H7OOH, + C3H8, + C6H5OOH -> C6H5OOH, + 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, + CH3CN, + CH3COCH3, + CH3COCHO, + CH3COOH, + CH3COOOH, + CH3OH, + CH3OOH, + CH4, + CHBR3 -> CHBr3, + CL -> Cl, + CL2 -> Cl2, + CL2O2 -> Cl2O2, + CLO -> ClO, + CLONO2 -> ClONO2, + CLY, + CO, + CO2, + COF2, + COFCL -> COFCl, + CRESOL -> C7H8O, + DMS -> CH3SCH3, + dst_a1 -> AlSiO5, + dst_a2 -> AlSiO5, + dst_a3 -> AlSiO5, + E90 -> CO, + EOOH -> HOCH2CH2OOH, + F, + GLYALD -> HOCH2CHO, + GLYOXAL -> C2H2O2, + H, + H2, + H2402 -> CBrF2CBrF2, + H2O2, + H2SO4 -> H2SO4, + HBR -> HBr, + HCFC141B -> CH3CCl2F, + HCFC142B -> CH3CClF2, + HCFC22 -> CHF2Cl, + HCL -> HCl, + HCN, + HCOOH, + HF, + HNO3, + HO2NO2, + HOBR -> HOBr, + HOCL -> HOCl, + HONITR -> C4H9NO4, + HPALD -> HOOCH2CCH3CHCHO, + HYAC -> CH3COCH2OH, + HYDRALD -> HOCH2CCH3CHCHO, + IEPOX -> C5H10O3, + ISOP -> C5H8, + ISOPNITA -> C5H9NO4, + ISOPNITB -> C5H9NO4, + ISOPNO3 -> CH2CHCCH3OOCH2ONO2, + ISOPNOOH -> C5H9NO5, + ISOPO2VBS -> C5H9O3, + ISOPOOH -> HOCH2COOHCH3CHCH2, + IVOCbb -> C13H28, + IVOCbbO2VBS -> C13H29O3, + IVOCff -> C13H28, + IVOCffO2VBS -> C13H29O3, + MACR -> CH2CCH3CHO, + MACROOH -> CH3COCHOOHCH2OH, + MEK -> C4H8O, + MEKOOH -> C4H8O3, + MPAN -> CH2CCH3CO3NO2, + MTERP -> C10H16, + MTERPO2VBS -> C10H17O3, + MVK -> CH2CHCOCH3, + N, + N2O, + N2O5, + NC4CH2OH -> C5H9NO4, + NC4CHO -> C5H7NO4, + ncl_a1 -> NaCl, + ncl_a2 -> NaCl, + ncl_a3 -> NaCl, + NH3, + NH4, + NH_5 -> CO, + NH_50 -> CO, + NO, + NO2, + NO3, + NOA -> CH3COCH2ONO2, + NTERPOOH -> C10H17NO5, + num_a1 -> H, + num_a2 -> H, + num_a3 -> H, + num_a4 -> H, + num_a5 -> H, + O, + O2, + O3, + O3S -> O3, + OCLO -> OClO, + OCS -> OCS, + ONITR -> C4H7NO4, + PAN -> CH3CO3NO2, + PBZNIT -> C7H5O3NO2, + PHENO -> C6H5O, + PHENOL -> C6H5OH, + PHENOOH -> C6H8O6, + pombb1_a1 -> C, + pombb1_a4 -> C, + pomff1_a1 -> C, + pomff1_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, + soabb1_a1 -> C15H38O2, + soabb1_a2 -> C15H38O2, + soabb2_a1 -> C15H38O2, + soabb2_a2 -> C15H38O2, + soabb3_a1 -> C15H38O2, + soabb3_a2 -> C15H38O2, + soabb4_a1 -> C15H38O2, + soabb4_a2 -> C15H38O2, + soabb5_a1 -> C15H38O2, + soabb5_a2 -> C15H38O2, + soabg1_a1 -> C15H38O2, + soabg1_a2 -> C15H38O2, + soabg2_a1 -> C15H38O2, + soabg2_a2 -> C15H38O2, + soabg3_a1 -> C15H38O2, + soabg3_a2 -> C15H38O2, + soabg4_a1 -> C15H38O2, + soabg4_a2 -> C15H38O2, + soabg5_a1 -> C15H38O2, + soabg5_a2 -> C15H38O2, + soaff1_a1 -> C15H38O2, + soaff1_a2 -> C15H38O2, + soaff2_a1 -> C15H38O2, + soaff2_a2 -> C15H38O2, + soaff3_a1 -> C15H38O2, + soaff3_a2 -> C15H38O2, + soaff4_a1 -> C15H38O2, + soaff4_a2 -> C15H38O2, + soaff5_a1 -> C15H38O2, + soaff5_a2 -> C15H38O2, + SOAGbb0 -> C15H38O2, + SOAGbb1 -> C15H38O2, + SOAGbb2 -> C15H38O2, + SOAGbb3 -> C15H38O2, + SOAGbb4 -> C15H38O2, + SOAGbg0 -> C15H38O2, + SOAGbg1 -> C15H38O2, + SOAGbg2 -> C15H38O2, + SOAGbg3 -> C15H38O2, + SOAGbg4 -> C15H38O2, + SOAGff0 -> C15H38O2, + SOAGff1 -> C15H38O2, + SOAGff2 -> C15H38O2, + SOAGff3 -> C15H38O2, + SOAGff4 -> C15H38O2, + ST80_25 -> CO, + SVOCbb -> C22H46, + SVOCff -> C22H46, + TEPOMUC -> C7H8O3, + TERP2OOH -> C10H16O4, + TERPNIT -> C10H17NO4, + TERPOOH -> C10H18O3, + TERPROD1 -> C10H16O2, + TERPROD2 -> C9H14O2, + TOLOOH -> C7H10O5, + TOLUENE -> C7H8, + TOLUO2VBS -> C7H9O5, + XOOH -> HOCH2COOHCH3CHOHCHO, + XYLENES -> C8H10, + XYLENOOH -> C8H12O5, + XYLEO2VBS -> C8H11O5, + XYLOL -> C8H10O, + XYLOLOOH -> C8H12O6, + NHDEP -> N, + NDEP -> N, + ACBZO2 -> C7H5O3, + ALKO2 -> C5H11O2, + BENZO2 -> C6H7O5, + BZOO -> C7H7O2, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2 -> C5H5O4, + e -> E, + ENEO2 -> C4H9O3, + EO -> HOCH2CH2O, + EO2 -> HOCH2CH2O2, + HO2, + HOCH2OO, + ISOPAO2 -> HOC5H8O2, + ISOPBO2 -> HOC5H8O2, + MACRO2 -> CH3COCHO2CH2OH, + MALO2 -> C4H3O4, + MCO3 -> CH2CCH3CO3, + MDIALO2 -> C4H5O4, + MEKO2 -> C4H7O3, + N2D -> N, + N2p -> N2, + NOp -> NO, + Np -> N, + NTERPO2 -> C10H16NO5, + O1D -> O, + O2_1D -> O2, + O2_1S -> O2, + O2p -> O2, + OH, + Op -> O, + PHENO2 -> C6H7O6, + PO2 -> C3H6OHO2, + RO2 -> CH3COCH2O2, + TERP2O2 -> C10H15O4, + TERPO2 -> C10H17O3, + TOLO2 -> C7H9O5, + XO2 -> HOCH2COOCH3CHOHCHO, + XYLENO2 -> C8H11O5, + XYLOLO2 -> C8H11O6, + H2O + + End Solution + + + Fixed + M, N2 + End Fixed + + Col-int + O3 = 0. + O2 = 0. + End Col-int + + Not-Transported + ACBZO2, + ALKO2, + BENZO2, + BZOO, + C2H5O2, + C3H7O2, + C6H5O2, + CH3CO3, + CH3O2, + DICARBO2, + e, + ENEO2, + EO, + EO2, + HO2, + HOCH2OO, + ISOPAO2, + ISOPBO2, + MACRO2, + MALO2, + MCO3, + MDIALO2, + MEKO2, + N2D, + N2p, + NOp, + Np, + NTERPO2, + O1D, + O2_1D, + O2_1S, + O2p, + OH, + Op, + PHENO2, + PO2, + RO2, + TERP2O2, + TERPO2, + TOLO2, + XO2, + XYLENO2, + XYLOLO2 + End Not-Transported + + END Species + + + Solution classes + Explicit + NHDEP + NDEP + End Explicit + + Implicit + ALKNIT + ALKOOH + AOA_NH + bc_a1 + bc_a4 + BCARY + BCARYO2VBS + BENZENE + BENZO2VBS + BENZOOH + BEPOMUC + BIGALD + BIGALD1 + BIGALD2 + BIGALD3 + BIGALD4 + BIGALK + BIGENE + BR + BRCL + BRO + BRONO2 + BRY + BZALD + BZOOH + C2H2 + C2H4 + C2H5OH + C2H5OOH + C2H6 + C3H6 + C3H7OOH + C3H8 + C6H5OOH + CCL4 + CF2CLBR + CF3BR + CFC11 + CFC113 + CFC114 + CFC115 + CFC12 + CH2BR2 + CH2O + CH3BR + CH3CCL3 + CH3CHO + CH3CL + CH3CN + CH3COCH3 + CH3COCHO + CH3COOH + CH3COOOH + CH3OH + CH3OOH + CH4 + CHBR3 + CL + CL2 + CL2O2 + CLO + CLONO2 + CLY + CO + CO2 + COF2 + COFCL + CRESOL + DMS + dst_a1 + dst_a2 + dst_a3 + E90 + EOOH + F + GLYALD + GLYOXAL + H + H2 + H2402 + H2O2 + H2SO4 + HBR + HCFC141B + HCFC142B + HCFC22 + HCL + HCN + HCOOH + HF + HNO3 + HO2NO2 + HOBR + HOCL + HONITR + HPALD + HYAC + HYDRALD + IEPOX + ISOP + ISOPNITA + ISOPNITB + ISOPNO3 + ISOPNOOH + ISOPO2VBS + ISOPOOH + IVOCbb + IVOCbbO2VBS + IVOCff + IVOCffO2VBS + MACR + MACROOH + MEK + MEKOOH + MPAN + MTERP + MTERPO2VBS + MVK + N + N2O + N2O5 + NC4CH2OH + NC4CHO + ncl_a1 + ncl_a2 + ncl_a3 + NH3 + NH4 + NH_5 + NH_50 + NO + NO2 + NO3 + NOA + NTERPOOH + num_a1 + num_a2 + num_a3 + num_a4 + num_a5 + O + O2 + O3 + O3S + OCLO + OCS + ONITR + PAN + PBZNIT + PHENO + PHENOL + PHENOOH + pombb1_a1 + pombb1_a4 + pomff1_a1 + pomff1_a4 + POOH + ROOH + S + SF6 + SO + SO2 + SO3 + so4_a1 + so4_a2 + so4_a3 + so4_a5 + soabb1_a1 + soabb1_a2 + soabb2_a1 + soabb2_a2 + soabb3_a1 + soabb3_a2 + soabb4_a1 + soabb4_a2 + soabb5_a1 + soabb5_a2 + soabg1_a1 + soabg1_a2 + soabg2_a1 + soabg2_a2 + soabg3_a1 + soabg3_a2 + soabg4_a1 + soabg4_a2 + soabg5_a1 + soabg5_a2 + soaff1_a1 + soaff1_a2 + soaff2_a1 + soaff2_a2 + soaff3_a1 + soaff3_a2 + soaff4_a1 + soaff4_a2 + soaff5_a1 + soaff5_a2 + SOAGbb0 + SOAGbb1 + SOAGbb2 + SOAGbb3 + SOAGbb4 + SOAGbg0 + SOAGbg1 + SOAGbg2 + SOAGbg3 + SOAGbg4 + SOAGff0 + SOAGff1 + SOAGff2 + SOAGff3 + SOAGff4 + ST80_25 + SVOCbb + SVOCff + TEPOMUC + TERP2OOH + TERPNIT + TERPOOH + TERPROD1 + TERPROD2 + TOLOOH + TOLUENE + TOLUO2VBS + XOOH + XYLENES + XYLENOOH + XYLEO2VBS + XYLOL + XYLOLOOH + ACBZO2 + ALKO2 + BENZO2 + BZOO + C2H5O2 + C3H7O2 + C6H5O2 + CH3CO3 + CH3O2 + DICARBO2 + e + ENEO2 + EO + EO2 + HO2 + HOCH2OO + ISOPAO2 + ISOPBO2 + MACRO2 + MALO2 + MCO3 + MDIALO2 + MEKO2 + N2D + N2p + NOp + Np + NTERPO2 + O1D + O2_1D + O2_1S + O2p + OH + Op + PHENO2 + PO2 + RO2 + TERP2O2 + TERPO2 + TOLO2 + XO2 + XYLENO2 + XYLOLO2 + H2O + End Implicit + + End Solution classes + + + CHEMISTRY + Photolysis +********************************* +*** odd-oxygen +********************************* +[jh2o_b] H2O + hv -> H2 + O1D +[jh2o_c] H2O + hv -> 2*H + O +[jh2o_a] H2O + hv -> OH + H +[jh2o2] H2O2 + hv -> 2*OH +[jo2_b=userdefined,] O2 + hv -> 2*O +[jo2_a=userdefined,] O2 + hv -> O + O1D +[jo3_a] O3 + hv -> O1D + O2_1D +[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 +[jno_i] NO + hv -> NOp + e +[jno2] NO2 + hv -> NO + O +[jno3_a] NO3 + hv -> NO2 + O +[jno3_b] NO3 + hv -> NO + O2 +********************************* +*** organics +********************************* +[jalknit->,jch3ooh] ALKNIT + hv -> NO2 + 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK +[jalkooh->,jch3ooh] ALKOOH + hv -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + 0.9*HO2 + 0.8*MEK + OH +[jbenzooh->,jch3ooh] BENZOOH + hv -> OH + GLYOXAL + 0.5*BIGALD1 + HO2 +[jbepomuc->,.10*jno2] BEPOMUC + hv -> BIGALD1 + 1.5*HO2 + 1.5*CO +[jbigald->,0.2*jno2] BIGALD + hv -> 0.45*CO + 0.13*GLYOXAL + 0.56*HO2 + 0.13*CH3CO3 + 0.18*CH3COCHO +[jbigald1->,.14*jno2] BIGALD1 + hv -> 0.6*MALO2 + HO2 +[jbigald2->,.20*jno2] BIGALD2 + hv -> 0.6*HO2 + 0.6*DICARBO2 +[jbigald3->,.20*jno2] BIGALD3 + hv -> 0.6*HO2 + 0.6*CO + 0.6*MDIALO2 +[jbigald4->,.006*jno2] BIGALD4 + hv -> HO2 + CO + CH3COCHO + CH3CO3 +[jbzooh->,jch3ooh] BZOOH + hv -> BZALD + OH + HO2 +[jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH +[jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82*CH3COCH3 + OH + HO2 +[jc6h5ooh->,jch3ooh] C6H5OOH + hv -> PHENO + OH +[jch2o_b] CH2O + hv -> CO + H2 +[jch2o_a] CH2O + hv -> CO + 2*H +[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 +[jhonitr->,jch2o_a] HONITR + hv -> NO2 + 0.67*HO2 + 0.33*CH3CHO + 0.33*CH2O + 0.33*CO + 0.33*GLYALD + 0.33*CH3CO3 + 0.17*HYAC + 0.17*CH3COCH3 +[jhpald->,.006*jno2] HPALD + hv -> BIGALD3 + OH + HO2 +[jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O +[jisopnooh->,jch3ooh] ISOPNOOH + hv -> NO2 + HO2 + ISOPOOH +[jisopooh->,jch3ooh] ISOPOOH + hv -> 0.7*MVK + 0.3*MACR + OH + 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 +[jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2 +[jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO +[jmpan->,jpan] MPAN + hv -> MCO3 + NO2 +[jmvk] MVK + hv -> 0.7*C3H6 + 0.7*CO + 0.3*CH3O2 + 0.3*CH3CO3 +[jnc4cho->,jch2o_a] NC4CHO + hv -> BIGALD3 + NO2 + HO2 +[jnoa->,jch2o_a] NOA + hv -> NO2 + CH2O + CH3CO3 +[jnterpooh->,jch3ooh] NTERPOOH + hv -> TERPROD1 + NO2 + OH +[jonitr->,jch3cho] ONITR + hv -> NO2 +[jpan] PAN + hv -> 0.6*CH3CO3 + 0.6*NO2 + 0.4*CH3O2 + 0.4*NO3 + 0.4*CO2 +[jphenooh->,jch3ooh] PHENOOH + hv -> OH + HO2 + 0.7*GLYOXAL +[jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH +[jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH +[jtepomuc->,.10*jno2] TEPOMUC + hv -> 0.5*CH3CO3 + HO2 + 1.5*CO +[jterp2ooh->,jch3ooh] TERP2OOH + hv -> OH + 0.375*CH2O + 0.3*CH3COCH3 + 0.25*CO + CO2 + TERPROD2 + HO2 + 0.25*GLYALD +[jterpnit->,jch3ooh] TERPNIT + hv -> TERPROD1 + NO2 + HO2 +[jterpooh->,jch3ooh] TERPOOH + hv -> 0.4*CH2O + 0.05*CH3COCH3 + TERPROD1 + HO2 + OH +[jterprd1->,jch3cho] TERPROD1 + hv -> HO2 + CO + TERPROD2 +[jterprd2->,jch3cho] TERPROD2 + hv -> 0.15*RO2 + 0.68*CH2O + 0.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 1.2*HO2 + 1.7*CO +[jtolooh->,jch3ooh] TOLOOH + hv -> OH + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 +[jxooh->,jch3ooh] XOOH + hv -> OH +[jxylenooh->,jch3ooh] XYLENOOH + hv -> OH + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 +[jxylolooh->,jch3ooh] XYLOLOOH + hv -> OH + 0.17*GLYOXAL + 0.51*CH3COCHO + HO2 +********************************* +*** 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 -> 2*CL + COFCL +[jcfc113] CFC113 + hv -> 2*CL + COFCL + COF2 +[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_a] CLONO2 + hv -> CL + NO3 +[jclono2_b] CLONO2 + hv -> CLO + NO2 +[jcof2] COF2 + hv -> 2*F +[jcofcl] COFCL + hv -> F + CL +[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 +********************************* +*** ions +********************************* +[jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O +[jeuv_4=userdefined,userdefined] N + hv -> Np + e +[jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e +[jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e +[jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + 0.8*N +[jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e +[jeuv_2=userdefined,userdefined] O + hv -> Op + e +[jeuv_1=userdefined,userdefined] O + hv -> Op + e +[jeuv_16=userdefined,userdefined] O + hv -> Op + e +[jeuv_15=userdefined,userdefined] O + hv -> Op + e +[jeuv_14=userdefined,userdefined] O + hv -> Op + e +[jeuv_3=userdefined,userdefined] O + hv -> Op + e +[jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e +[jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e +[jeuv_24=userdefined,userdefined] O2 + hv -> 2*O +[jeuv_12=userdefined,userdefined] O2 + hv -> 2*O +********************************* +*** 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 +********************************* +[jsoabb1_a1->,.0004*jno2] soabb1_a1 + hv -> +[jsoabb1_a2->,.0004*jno2] soabb1_a2 + hv -> +[jsoabb2_a1->,.0004*jno2] soabb2_a1 + hv -> +[jsoabb2_a2->,.0004*jno2] soabb2_a2 + hv -> +[jsoabb3_a1->,.0004*jno2] soabb3_a1 + hv -> +[jsoabb3_a2->,.0004*jno2] soabb3_a2 + hv -> +[jsoabb4_a1->,.0004*jno2] soabb4_a1 + hv -> +[jsoabb4_a2->,.0004*jno2] soabb4_a2 + hv -> +[jsoabb5_a1->,.0004*jno2] soabb5_a1 + hv -> +[jsoabb5_a2->,.0004*jno2] soabb5_a2 + hv -> +[jsoabg1_a1->,.0004*jno2] soabg1_a1 + hv -> +[jsoabg1_a2->,.0004*jno2] soabg1_a2 + hv -> +[jsoabg2_a1->,.0004*jno2] soabg2_a1 + hv -> +[jsoabg2_a2->,.0004*jno2] soabg2_a2 + hv -> +[jsoabg3_a1->,.0004*jno2] soabg3_a1 + hv -> +[jsoabg3_a2->,.0004*jno2] soabg3_a2 + hv -> +[jsoabg4_a1->,.0004*jno2] soabg4_a1 + hv -> +[jsoabg4_a2->,.0004*jno2] soabg4_a2 + hv -> +[jsoabg5_a1->,.0004*jno2] soabg5_a1 + hv -> +[jsoabg5_a2->,.0004*jno2] soabg5_a2 + hv -> +[jsoaff1_a1->,.0004*jno2] soaff1_a1 + hv -> +[jsoaff1_a2->,.0004*jno2] soaff1_a2 + hv -> +[jsoaff2_a1->,.0004*jno2] soaff2_a1 + hv -> +[jsoaff2_a2->,.0004*jno2] soaff2_a2 + hv -> +[jsoaff3_a1->,.0004*jno2] soaff3_a1 + hv -> +[jsoaff3_a2->,.0004*jno2] soaff3_a2 + hv -> +[jsoaff4_a1->,.0004*jno2] soaff4_a1 + hv -> +[jsoaff4_a2->,.0004*jno2] soaff4_a2 + hv -> +[jsoaff5_a1->,.0004*jno2] soaff5_a1 + hv -> +[jsoaff5_a2->,.0004*jno2] soaff5_a2 + hv -> + End Photolysis + + Reactions +********************************* +*** odd-oxygen +********************************* +[ag1] O2_1D -> O2 ; 0.000258 +[ag2] O2_1S -> O2 ; 0.085 +[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_O2,cph=32.91] O1D + O2 -> O + O2_1S ; 2.64e-11, 55 +[O1D_O2b,cph=189.81] O1D + O2 -> O + O2 ; 6.6e-12, 55 +[O1D_O3] O1D + O3 -> O2 + O2 ; 1.2e-10 +[O2_1D_N2,cph=94.3] O2_1D + N2 -> O2 + N2 ; 1e-20 +[O2_1D_O,cph=94.3] O2_1D + O -> O2 + O ; 1.3e-16 +[O2_1D_O2,cph=94.3] O2_1D + O2 -> 2*O2 ; 3.6e-18, -220 +[O2_1S_CO2] O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13 +[O2_1S_N2,cph=62.6] O2_1S + N2 -> O2_1D + N2 ; 1.8e-15, 45 +[O2_1S_O,cph=62.6] O2_1S + O -> O2_1D + O ; 8e-14 +[O2_1S_O2,cph=62.6] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17 +[O2_1S_O3,cph=62.6] O2_1S + O3 -> O2_1D + O3 ; 3.5e-11, -135 +[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 +[N2D_O,cph=229.61] N2D + O -> N + O ; 7e-13 +[N2D_O2,cph=177.51] N2D + O2 -> NO + O1D ; 5e-12 +[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 -> 2*CL + COFCL ; 2.07e-10 +[O1D_CFC113] O1D + CFC113 -> 2*CL + COFCL + COF2 ; 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 +********************************* +*** odd-fluorine +********************************* +[F_CH4] F + CH4 -> HF + CH3O2 ; 1.6e-10, -260 +[F_H2] F + H2 -> HF + H ; 1.4e-10, -500 +[F_H2O] F + H2O -> HF + OH ; 1.4e-11, 0 +[F_HNO3] F + HNO3 -> HF + NO3 ; 6e-12, 400 +[O1D_COF2] O1D + COF2 -> 2*F ; 2.14e-11 +[O1D_COFCL] O1D + COFCL -> F + CL ; 1.9e-10 +********************************* +*** 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 + COFCL ; 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 + COFCL ; 1.794e-10 +[O1D_HCFC142B] O1D + HCFC142B -> CL + COF2 ; 1.3e-10 +[O1D_HCFC22] O1D + HCFC22 -> CL + COF2 ; 7.65e-11 +********************************* +*** C1 +********************************* +[CH2O_HO2] CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625 +[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 +[HCN_OH] HCN + OH + M -> HO2 + M ; 6.1e-33, 1.5, 9.8e-15, -4.6, 0.8 +[HCOOH_OH] HCOOH + OH -> HO2 + CO2 + H2O ; 4e-13 +[HOCH2OO_HO2] HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700 +[HOCH2OO_M] HOCH2OO -> CH2O + HO2 ; 2.4e+12, -7000 +[HOCH2OO_NO] HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265 +[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 +[O1D_HCN] O1D + HCN -> OH ; 1.08e-10, 105 +[usr_CO_OH] CO + OH -> CO2 + HO2 +********************************* +*** C2 +********************************* +[C2H2_CL_M] C2H2 + CL + M -> CL + M ; 5.2e-30, 2.4, 2.2e-10, 0.7, 0.6 +[C2H2_OH_M] C2H2 + OH + M -> 0.65*GLYOXAL + 0.65*OH + 0.35*HCOOH + 0.35*HO2 + 0.35*CO + M ; 5.5e-30, 0, 8.3e-13, -2, 0.6 +[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 +[CH3CN_OH] CH3CN + OH -> HO2 ; 7.8e-13, -1050 +[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 +[CL_C3H8] CL + C3H8 -> C3H7O2 + HCL ; 1.45e-10 +[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 +********************************* +[BIGENE_NO3] BIGENE + NO3 -> NO2 + CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 ; 3.5e-13 +[BIGENE_OH] BIGENE + OH -> ENEO2 ; 5.4e-11 +[ENEO2_NO] ENEO2 + NO -> CH3CHO + 0.5*CH2O + 0.5*CH3COCH3 + HO2 + NO2 ; 4.8e-12, 120 +[ENEO2_NOb] ENEO2 + NO -> HONITR ; 5.1e-14, 693 +[HONITR_OH] HONITR + OH -> ONITR + HO2 ; 2e-12 +[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 -> HONITR ; 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 +[MEKO2_HO2] MEKO2 + HO2 -> 0.8*MEKOOH + 0.2*OH + 0.2*CH3CHO + 0.2*CH3CO3 ; 7.5e-13, 700 +[MEKO2_NO] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180 +[MEK_OH] MEK + OH -> MEKO2 ; 2.3e-12, -170 +[MEKOOH_OH] MEKOOH + OH -> MEKO2 ; 3.8e-12, 200 +[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 +********************************* +[ALKNIT_OH] ALKNIT + OH -> 0.4*CH2O + 0.8*CH3CHO + 0.8*CH3COCH3 + NO2 ; 1.6e-12 +[ALKO2_HO2] ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700 +[ALKO2_NO] ALKO2 + NO -> 0.4*CH3CHO + 0.1*CH2O + 0.25*CH3COCH3 + HO2 + 0.8*MEK + NO2 ; 6.7e-12 +[ALKO2_NOb] ALKO2 + NO -> ALKNIT ; 5.4e-14, 870 +[ALKOOH_OH] ALKOOH + OH -> ALKO2 ; 3.8e-12, 200 +[BIGALK_OH] BIGALK + OH -> ALKO2 ; 3.5e-12 +[HPALD_OH] HPALD + OH -> XO2 ; 1.86e-11, 175 +[HYDRALD_OH] HYDRALD + OH -> XO2 ; 1.86e-11, 175 +[IEPOX_OH] IEPOX + OH -> XO2 ; 1.3e-11 +[ISOPAO2_CH3CO3] ISOPAO2 + CH3CO3 -> CH3O2 + HO2 + CH2O + 0.39*MACR + 0.61*MVK + CO2 ; 1.4e-11 +[ISOPAO2_CH3O2] ISOPAO2 + CH3O2 -> 0.25*CH3OH + HO2 + 1.5*CH2O + 0.31*MACR + 0.44*MVK ; 5e-13, 400 +[ISOPAO2_HO2] ISOPAO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPAO2_NO] ISOPAO2 + NO -> 0.08*ISOPNITA + 0.92*NO2 + 0.36*MACR + 0.56*MVK + 0.92*CH2O + 0.92*HO2 ; 4.4e-12, 180 +[ISOPAO2_NO3] ISOPAO2 + NO3 -> NO2 + 0.4*MACR + 0.6*MVK + CH2O + HO2 ; 2.4e-12 +[ISOPBO2_CH3CO3] ISOPBO2 + CH3CO3 -> HYDRALD + CH3O2 + HO2 ; 1.4e-11 +[ISOPBO2_CH3O2] ISOPBO2 + CH3O2 -> 0.25*CH3OH + HO2 + 0.75*CH2O + 0.75*HYDRALD ; 5e-13, 400 +[ISOPBO2_HO2] ISOPBO2 + HO2 -> ISOPOOH ; 8e-13, 700 +[ISOPBO2_M] ISOPBO2 -> HPALD + HO2 ; 1.6e+09, -8300 +[ISOPBO2_NO] ISOPBO2 + NO -> 0.87*HYDRALD + 0.08*ISOPNITB + 0.92*NO2 + 0.92*HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 4.4e-12, 180 +[ISOPBO2_NO3] ISOPBO2 + NO3 -> NO2 + 0.95*HYDRALD + HO2 + 0.05*GLYOXAL + 0.05*GLYALD + 0.05*CH3COCHO + 0.05*HYAC ; 2.4e-12 +[ISOPNITA_OH] ISOPNITA + OH -> 0.7*HYAC + 0.7*GLYALD + 0.7*NO2 + 0.3*CH2O + 0.3*HONITR + 0.3*HO2 ; 4e-11 +[ISOPNITB_OH] ISOPNITB + OH -> 0.5*HYAC + 0.5*GLYALD + 0.5*NOA + HO2 + 0.5*HONITR ; 4e-11 +[ISOP_NO3] ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446 +[ISOPNO3_CH3CO3] ISOPNO3 + CH3CO3 -> NC4CHO + CH3O2 + HO2 ; 1.4e-11 +[ISOPNO3_CH3O2] ISOPNO3 + CH3O2 -> 0.8*NC4CHO + 1.2*HO2 + 0.8*CH2O + 0.2*CH3OH + 0.2*NC4CH2OH ; 5e-13, 400 +[ISOPNO3_HO2] ISOPNO3 + HO2 -> ISOPNOOH ; 8e-13, 700 +[ISOPNO3_NO] ISOPNO3 + NO -> NC4CHO + NO2 + HO2 ; 2.7e-12, 360 +[ISOPNO3_NO3] ISOPNO3 + NO3 -> NC4CHO + NO2 + HO2 ; 2.4e-12 +[ISOPNOOH_OH] ISOPNOOH + OH -> NOA + HO2 ; 4e-11 +[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 -> 0.6*ISOPAO2 + 0.4*ISOPBO2 ; 2.54e-11, 410 +[ISOPOOH_OH] ISOPOOH + OH -> 0.4*XO2 + 0.6*IEPOX + 0.6*OH ; 1.52e-11, 200 +[NC4CH2OH_OH] NC4CH2OH + OH -> GLYALD + NOA + HO2 ; 7e-11 +[NC4CHO_OH] NC4CHO + OH -> GLYOXAL + NOA + HO2 ; 1e-10 +[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 +********************************* +*** C7 +********************************* +[ACBZO2_HO2] ACBZO2 + HO2 -> 0.4*C6H5O2 + 0.4*OH ; 4.3e-13, 1040 +[ACBZO2_NO] ACBZO2 + NO -> C6H5O2 + NO2 ; 7.5e-12, 290 +[BENZENE_OH] BENZENE + OH -> 0.53*PHENOL + 0.12*BEPOMUC + 0.65*HO2 + 0.35*BENZO2 ; 2.3e-12, -193 +[BENZO2_HO2] BENZO2 + HO2 -> BENZOOH ; 7.5e-13, 700 +[BENZO2_NO] BENZO2 + NO -> NO2 + GLYOXAL + 0.5*BIGALD1 + HO2 ; 2.6e-12, 365 +[BENZOOH_OH] BENZOOH + OH -> BENZO2 ; 3.8e-12, 200 +[BZALD_OH] BZALD + OH -> ACBZO2 ; 5.9e-12, 225 +[BZOO_HO2] BZOO + HO2 -> BZOOH ; 7.5e-13, 700 +[BZOOH_OH] BZOOH + OH -> BZOO ; 3.8e-12, 200 +[BZOO_NO] BZOO + NO -> BZALD + NO2 + HO2 ; 2.6e-12, 365 +[C6H5O2_HO2] C6H5O2 + HO2 -> C6H5OOH ; 7.5e-13, 700 +[C6H5O2_NO] C6H5O2 + NO -> PHENO + NO2 ; 2.6e-12, 365 +[C6H5OOH_OH] C6H5OOH + OH -> C6H5O2 ; 3.8e-12, 200 +[CRESOL_OH] CRESOL + OH -> 0.2*PHENO2 + 0.73*HO2 + 0.07*PHENO ; 4.7e-11 +[DICARBO2_HO2] DICARBO2 + HO2 -> 0.4*OH + 0.07*HO2 + 0.07*CH3COCHO + 0.07*CO + 0.33*CH3O2 ; 4.3e-13, 1040 +[DICARBO2_NO] DICARBO2 + NO -> NO2 + 0.17*HO2 + 0.17*CH3COCHO + 0.17*CO + 0.83*CH3O2 ; 7.5e-12, 290 +[DICARBO2_NO2] DICARBO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MALO2_HO2] MALO2 + HO2 -> 0.16*GLYOXAL + 0.16*HO2 + 0.16*CO ; 4.3e-13, 1040 +[MALO2_NO] MALO2 + NO -> 0.4*GLYOXAL + 0.4*HO2 + 0.4*CO + NO2 ; 7.5e-12, 290 +[MALO2_NO2] MALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[MDIALO2_HO2] MDIALO2 + HO2 -> 0.4*OH + 0.33*HO2 + 0.07*CH3COCHO + 0.14*CO + 0.07*CH3O2 + 0.07*GLYOXAL ; 4.3e-13, 1040 +[MDIALO2_NO] MDIALO2 + NO -> NO2 + 0.83*HO2 + 0.17*CH3COCHO + 0.35*CO + 0.17*CH3O2 + 0.17*GLYOXAL ; 7.5e-12, 290 +[MDIALO2_NO2] MDIALO2 + NO2 + M -> M + 1*NDEP ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[PHENO2_HO2] PHENO2 + HO2 -> PHENOOH ; 7.5e-13, 700 +[PHENO2_NO] PHENO2 + NO -> HO2 + 0.7*GLYOXAL + NO2 ; 2.6e-12, 365 +[PHENOL_OH] PHENOL + OH -> 0.14*PHENO2 + 0.8*HO2 + 0.06*PHENO ; 4.7e-13, 1220 +[PHENO_NO2] PHENO + NO2 -> 1*NDEP ; 2.1e-12 +[PHENO_O3] PHENO + O3 -> C6H5O2 ; 2.8e-13 +[PHENOOH_OH] PHENOOH + OH -> PHENO2 ; 3.8e-12, 200 +[tag_ACBZO2_NO2] ACBZO2 + NO2 + M -> PBZNIT + M ; 9.7e-29, 5.6, 9.3e-12, 1.5, 0.6 +[TOLO2_HO2] TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700 +[TOLO2_NO] TOLO2 + NO -> NO2 + 0.6*GLYOXAL + 0.4*CH3COCHO + HO2 + 0.2*BIGALD1 + 0.2*BIGALD2 + 0.2*BIGALD3 ; 2.6e-12, 365 +[TOLOOH_OH] TOLOOH + OH -> TOLO2 ; 3.8e-12, 200 +[TOLUENE_OH] TOLUENE + OH -> 0.18*CRESOL + 0.1*TEPOMUC + 0.07*BZOO + 0.65*TOLO2 + 0.28*HO2 ; 1.7e-12, 352 +[usr_PBZNIT_M] PBZNIT + M -> ACBZO2 + NO2 + M +[XYLENES_OH] XYLENES + OH -> 0.15*XYLOL + 0.23*TEPOMUC + 0.06*BZOO + 0.56*XYLENO2 + 0.38*HO2 ; 1.7e-11 +[XYLENO2_HO2] XYLENO2 + HO2 -> XYLENOOH ; 7.5e-13, 700 +[XYLENO2_NO] XYLENO2 + NO -> NO2 + HO2 + 0.34*GLYOXAL + 0.54*CH3COCHO + 0.06*BIGALD1 + 0.2*BIGALD2 + 0.15*BIGALD3 + 0.21*BIGALD4 ; 2.6e-12, 365 +[XYLENOOH_OH] XYLENOOH + OH -> XYLENO2 ; 3.8e-12, 200 +[XYLOLO2_HO2] XYLOLO2 + HO2 -> XYLOLOOH ; 7.5e-13, 700 +[XYLOLO2_NO] XYLOLO2 + NO -> HO2 + NO2 + 0.17*GLYOXAL + 0.51*CH3COCHO ; 2.6e-12, 365 +[XYLOL_OH] XYLOL + OH -> 0.3*XYLOLO2 + 0.63*HO2 + 0.07*PHENO ; 8.4e-11 +[XYLOLOOH_OH] XYLOLOOH + OH -> XYLOLO2 ; 3.8e-12, 200 +********************************* +*** C10 +********************************* +[BCARY_NO3] BCARY + NO3 -> NTERPO2 ; 1.9e-11 +[BCARY_O3] BCARY + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 1.2e-14 +[BCARY_OH] BCARY + OH -> TERPO2 ; 2e-10 +[MTERP_NO3] MTERP + NO3 -> NTERPO2 ; 1.2e-12, 490 +[MTERP_O3] MTERP + O3 -> 0.33*TERPROD1 + 0.3*TERPROD2 + 0.63*OH + 0.57*HO2 + 0.23*CO + 0.27*CO2 + 0.52*CH3COCH3 + 0.34*CH2O + 0.1*BIGALD + 0.05*HCOOH + 0.05*BIGALK + 0.06*CH3CO3 + 0.06*RO2 ; 6.3e-16, -580 +[MTERP_OH] MTERP + OH -> TERPO2 ; 1.2e-11, 440 +[NTERPO2_CH3O2] NTERPO2 + CH3O2 -> 0.5*TERPNIT + 0.75*CH2O + 0.25*CH3OH + 0.5*HO2 + 0.5*TERPROD1 + 0.5*NO2 ; 2e-12, 500 +[NTERPO2_HO2] NTERPO2 + HO2 -> NTERPOOH ; 7.5e-13, 700 +[NTERPO2_NO] NTERPO2 + NO -> 0.2*TERPNIT + 1.6*NO2 + 0.8*TERPROD1 + 0.2*NDEP ; 4.2e-12, 180 +[NTERPO2_NO3] NTERPO2 + NO3 -> 2*NO2 + TERPROD1 ; 2.4e-12 +[NTERPOOH_OH] NTERPOOH + OH -> NTERPO2 ; 2e-11 +[TERP2O2_CH3O2] TERP2O2 + CH3O2 -> TERPROD2 + 0.93*CH2O + 0.25*CH3OH + HO2 + 0.5*CO2 + 0.125*CO + 0.125*GLYALD + 0.15*CH3COCH3 ; 2e-12, 500 +[TERP2O2_HO2] TERP2O2 + HO2 -> TERP2OOH ; 7.5e-13, 700 +[TERP2O2_NO] TERP2O2 + NO -> 0.1*ONITR + 0.9*NO2 + 0.34*CH2O + 0.27*CH3COCH3 + 0.225*CO + 0.9*CO2 + 0.9*TERPROD2 + 0.9*HO2 + 0.225*GLYALD ; 4.2e-12, 180 +[TERP2OOH_OH] TERP2OOH + OH -> TERP2O2 ; 2.3e-11 +[TERPNIT_OH] TERPNIT + OH -> NO2 + TERPROD1 ; 2e-11 +[TERPO2_CH3O2] TERPO2 + CH3O2 -> TERPROD1 + 0.95*CH2O + 0.25*CH3OH + HO2 + 0.025*CH3COCH3 ; 2e-12, 500 +[TERPO2_HO2] TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700 +[TERPO2_NO] TERPO2 + NO -> 0.2*TERPNIT + 0.8*NO2 + 0.32*CH2O + 0.04*CH3COCH3 + 0.8*TERPROD1 + 0.8*HO2 ; 4.2e-12, 180 +[TERPOOH_OH] TERPOOH + OH -> TERPO2 ; 3.3e-11 +[TERPROD1_NO3] TERPROD1 + NO3 -> 0.5*TERP2O2 + 0.5*NTERPO2 + 0.5*NDEP ; 1e-12 +[TERPROD1_OH] TERPROD1 + OH -> TERP2O2 ; 5.7e-11 +[TERPROD2_OH] TERPROD2 + OH -> 0.15*RO2 + 0.68*CH2O + 1.8*CO2 + 0.5*CH3COCH3 + 0.65*CH3CO3 + 0.2*HO2 + 0.7*CO ; 3.4e-11 +********************************* +*** 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_HONITR_aer] HONITR -> HNO3 +[usr_ISOPNITA_aer] ISOPNITA -> HNO3 +[usr_ISOPNITB_aer] ISOPNITB -> HNO3 +[usr_N2O5_aer] N2O5 -> 2*HNO3 +[usr_NC4CH2OH_aer] NC4CH2OH -> HNO3 +[usr_NC4CHO_aer] NC4CHO -> 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_NTERPOOH_aer] NTERPOOH -> HNO3 +[usr_ONITR_aer] ONITR -> HNO3 +[usr_TERPNIT_aer] TERPNIT -> HNO3 +********************************* +*** SOA +********************************* +[BCARY_NO3_vbs] BCARY + NO3 -> BCARY + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 ; 1.9e-11 +[BCARYO2_HO2_vbs] BCARYO2VBS + HO2 -> HO2 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 ; 2.75e-13, 1300 +[BCARYO2_NO_vbs] BCARYO2VBS + NO -> NO + 0.1279*SOAGbg0 + 0.1792*SOAGbg1 + 0.0676*SOAGbg2 + 0.079*SOAGbg3 + 0.1254*SOAGbg4 ; 2.7e-12, 360 +[BCARY_O3_vbs] BCARY + O3 -> BCARY + O3 + 0.2202*SOAGbg0 + 0.2067*SOAGbg1 + 0.0653*SOAGbg2 + 0.1284*SOAGbg3 + 0.114*SOAGbg4 ; 1.2e-14 +[BCARY_OH_vbs] BCARY + OH -> BCARY + OH + BCARYO2VBS ; 2e-10 +[BENZENE_OH_vbs] BENZENE + OH -> BENZENE + OH + BENZO2VBS ; 2.3e-12, -193 +[BENZO2_HO2_vbs] BENZO2VBS + HO2 -> HO2 + 0.0023*SOAGff0 + 0.0008*SOAGff1 + 0.0843*SOAGff2 + 0.0443*SOAGff3 + 0.1621*SOAGff4 ; 7.5e-13, 700 +[BENZO2_NO_vbs] BENZO2VBS + NO -> NO + 0.0097*SOAGff0 + 0.0034*SOAGff1 + 0.1579*SOAGff2 + 0.0059*SOAGff3 + 0.0536*SOAGff4 ; 2.6e-12, 365 +[ISOP_NO3_vbs] ISOP + NO3 -> ISOP + NO3 + 0.059024*SOAGbg3 + 0.025024*SOAGbg4 ; 3.03e-12, -446 +[ISOPO2_HO2_vbs] ISOPO2VBS + HO2 -> HO2 + 0.0031*SOAGbg0 + 0.0035*SOAGbg1 + 0.0003*SOAGbg2 + 0.0271*SOAGbg3 + 0.0474*SOAGbg4 ; 2.12e-13, 1300 +[ISOPO2_NO_vbs] ISOPO2VBS + NO -> NO + 0.0003*SOAGbg0 + 0.0003*SOAGbg1 + 0.0073*SOAGbg2 + 0.0057*SOAGbg3 + 0.0623*SOAGbg4 ; 2.7e-12, 350 +[ISOP_O3_vbs] ISOP + O3 -> ISOP + O3 + 0.0033*SOAGbg3 ; 1.05e-14, -2000 +[ISOP_OH_vbs] ISOP + OH -> ISOP + OH + ISOPO2VBS ; 2.54e-11, 410 +[IVOCbbO2_HO2_vbs] IVOCbbO2VBS + HO2 -> HO2 + 0.2381*SOAGbb0 + 0.1308*SOAGbb1 + 0.0348*SOAGbb2 + 0.0076*SOAGbb3 + 0.0113*SOAGbb4 ; 7.5e-13, 700 +[IVOCbbO2_NO_vbs] IVOCbbO2VBS + NO -> NO + 0.1056*SOAGbb0 + 0.1026*SOAGbb1 + 0.0521*SOAGbb2 + 0.0143*SOAGbb3 + 0.0166*SOAGbb4 ; 2.6e-12, 365 +[IVOCbb_OH_vbs] IVOCbb + OH -> OH + IVOCbbO2VBS ; 1.34e-11 +[IVOCffO2_HO2_vbs] IVOCffO2VBS + HO2 -> HO2 + 0.2381*SOAGff0 + 0.1308*SOAGff1 + 0.0348*SOAGff2 + 0.0076*SOAGff3 + 0.0113*SOAGff4 ; 7.5e-13, 700 +[IVOCffO2_NO_vbs] IVOCffO2VBS + NO -> NO + 0.1056*SOAGff0 + 0.1026*SOAGff1 + 0.0521*SOAGff2 + 0.0143*SOAGff3 + 0.0166*SOAGff4 ; 2.6e-12, 365 +[IVOCff_OH_vbs] IVOCff + OH -> OH + IVOCffO2VBS ; 1.34e-11 +[MTERP_NO3_vbs] MTERP + NO3 -> MTERP + NO3 + 0.17493*SOAGbg3 + 0.59019*SOAGbg4 ; 1.2e-12, 490 +[MTERPO2_HO2_vbs] MTERPO2VBS + HO2 -> HO2 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 ; 2.6e-13, 1300 +[MTERPO2_NO_vbs] MTERPO2VBS + NO -> NO + 0.0245*SOAGbg0 + 0.0082*SOAGbg1 + 0.0772*SOAGbg2 + 0.0332*SOAGbg3 + 0.13*SOAGbg4 ; 2.7e-12, 360 +[MTERP_O3_vbs] MTERP + O3 -> MTERP + O3 + 0.0508*SOAGbg0 + 0.1149*SOAGbg1 + 0.0348*SOAGbg2 + 0.0554*SOAGbg3 + 0.1278*SOAGbg4 ; 6.3e-16, -580 +[MTERP_OH_vbs] MTERP + OH -> MTERP + OH + MTERPO2VBS ; 1.2e-11, 440 +[SVOCbb_OH] SVOCbb + OH -> OH + 0.5931*SOAGbb0 + 0.1534*SOAGbb1 + 0.0459*SOAGbb2 + 0.0085*SOAGbb3 + 0.0128*SOAGbb4 ; 1.34e-11 +[SVOCff_OH] SVOCff + OH -> OH + 0.5931*SOAGff0 + 0.1534*SOAGff1 + 0.0459*SOAGff2 + 0.0085*SOAGff3 + 0.0128*SOAGff4 ; 1.34e-11 +[TOLUENE_OH_vbs] TOLUENE + OH -> TOLO2 + TOLUO2VBS ; 1.7e-12, 352 +[TOLUO2_HO2_vbs] TOLUO2VBS + HO2 -> HO2 + 0.1364*SOAGff0 + 0.0101*SOAGff1 + 0.0763*SOAGff2 + 0.2157*SOAGff3 + 0.0738*SOAGff4 ; 7.5e-13, 700 +[TOLUO2_NO_vbs] TOLUO2VBS + NO -> NO + 0.0154*SOAGff0 + 0.0452*SOAGff1 + 0.0966*SOAGff2 + 0.0073*SOAGff3 + 0.238*SOAGff4 ; 2.6e-12, 365 +[usr_GLYOXAL_aer] GLYOXAL -> SOAGbg0 +[XYLENES_OH_vbs] XYLENES + OH -> XYLENES + OH + XYLEO2VBS ; 1.7e-11 +[XYLEO2_HO2_vbs] XYLEO2VBS + HO2 -> HO2 + 0.1677*SOAGff0 + 0.0174*SOAGff1 + 0.086*SOAGff2 + 0.0512*SOAGff3 + 0.1598*SOAGff4 ; 7.5e-13, 700 +[XYLEO2_NO_vbs] XYLEO2VBS + NO -> NO + 0.0063*SOAGff0 + 0.0237*SOAGff1 + 0.0025*SOAGff2 + 0.011*SOAGff3 + 0.1185*SOAGff4 ; 2.6e-12, 365 +********************************* +*** 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 +********************************* +*** Ions +********************************* +[elec1,cph=82.389] NOp + e -> 0.2*N + 0.8*N2D + O +[elec2,cph=508.95] O2p + e -> 1.15*O + 0.85*O1D +[elec3,cph=354.83] N2p + e -> 1.1*N + 0.9*N2D +[ion_N2p_O2,cph=339.59] N2p + O2 -> O2p + N2 ; 6e-11 +[ion_N2p_Oa,cph=67.53] N2p + O -> NOp + N2D +[ion_N2p_Ob] N2p + O -> Op + N2 +[ion_Np_O,cph=95.55] Np + O -> Op + N ; 1e-12 +[ion_Np_O2a,cph=239.84] Np + O2 -> O2p + N ; 4e-10 +[ion_Np_O2b,cph=646.28] Np + O2 -> NOp + O ; 2e-10 +[ion_O2p_N,cph=406.16] O2p + N -> NOp + O ; 1e-10 +[ion_O2p_N2] O2p + N2 -> NOp + NO ; 5e-16 +[ion_O2p_NO,cph=271.38] O2p + NO -> NOp + O2 ; 4.4e-10 +[ion_Op_CO2] Op + CO2 -> O2p + CO ; 9e-10 +[ion_Op_N2,cph=105.04] Op + N2 -> NOp + N +[ion_Op_O2,cph=150.11] Op + O2 -> O2p + O +********************************* +*** 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 + CO <- dataset + bc_a4 <- dataset + num_a1 <- dataset + num_a2 <- dataset + num_a4 <- dataset + num_a5 <- dataset + pombb1_a1 <- dataset + pombb1_a4 <- dataset + pomff1_a1 <- dataset + pomff1_a4 <- dataset + NO <- dataset + NO2 <- dataset + SO2 <- dataset + SVOCbb <- dataset + SVOCff <- dataset + so4_a1 <- dataset + so4_a2 <- dataset + so4_a5 <- dataset + bc_a1 <- dataset + e + N + N2D + OH + Op + AOA_NH + N2p + Np + 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_waccm_tsmlt_mam5_vbsext/chem_mods.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/chem_mods.F90 new file mode 100644 index 0000000000..9df05f93ac --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/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 = 170, & ! number of photolysis reactions + rxntot = 621, & ! number of total reactions + gascnt = 451, & ! number of gas phase reactions + nabscol = 2, & ! number of absorbing column densities + gas_pcnst = 276, & ! number of "gas phase" species + nfs = 2, & ! number of "fixed" species + relcnt = 0, & ! number of relationship species + grpcnt = 0, & ! number of group members + nzcnt = 2524, & ! number of non-zero matrix entries + extcnt = 27, & ! 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 = 274, & ! 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 = 621, & + enthalpy_cnt = 41, & + nslvd = 43 + 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_waccm_tsmlt_mam5_vbsext/m_rxt_id.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/m_rxt_id.F90 new file mode 100644 index 0000000000..d049a0ce13 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/m_rxt_id.F90 @@ -0,0 +1,624 @@ + module m_rxt_id + implicit none + integer, parameter :: rid_jh2o_b = 1 + integer, parameter :: rid_jh2o_c = 2 + integer, parameter :: rid_jh2o_a = 3 + integer, parameter :: rid_jh2o2 = 4 + integer, parameter :: rid_jo2_b = 5 + integer, parameter :: rid_jo2_a = 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_jno_i = 16 + integer, parameter :: rid_jno2 = 17 + integer, parameter :: rid_jno3_a = 18 + integer, parameter :: rid_jno3_b = 19 + integer, parameter :: rid_jalknit = 20 + integer, parameter :: rid_jalkooh = 21 + integer, parameter :: rid_jbenzooh = 22 + integer, parameter :: rid_jbepomuc = 23 + integer, parameter :: rid_jbigald = 24 + integer, parameter :: rid_jbigald1 = 25 + integer, parameter :: rid_jbigald2 = 26 + integer, parameter :: rid_jbigald3 = 27 + integer, parameter :: rid_jbigald4 = 28 + integer, parameter :: rid_jbzooh = 29 + integer, parameter :: rid_jc2h5ooh = 30 + integer, parameter :: rid_jc3h7ooh = 31 + integer, parameter :: rid_jc6h5ooh = 32 + integer, parameter :: rid_jch2o_b = 33 + integer, parameter :: rid_jch2o_a = 34 + integer, parameter :: rid_jch3cho = 35 + integer, parameter :: rid_jacet = 36 + integer, parameter :: rid_jmgly = 37 + integer, parameter :: rid_jch3co3h = 38 + integer, parameter :: rid_jch3ooh = 39 + integer, parameter :: rid_jch4_b = 40 + integer, parameter :: rid_jch4_a = 41 + integer, parameter :: rid_jco2 = 42 + integer, parameter :: rid_jeooh = 43 + integer, parameter :: rid_jglyald = 44 + integer, parameter :: rid_jglyoxal = 45 + integer, parameter :: rid_jhonitr = 46 + integer, parameter :: rid_jhpald = 47 + integer, parameter :: rid_jhyac = 48 + integer, parameter :: rid_jisopnooh = 49 + integer, parameter :: rid_jisopooh = 50 + integer, parameter :: rid_jmacr_a = 51 + integer, parameter :: rid_jmacr_b = 52 + integer, parameter :: rid_jmek = 53 + integer, parameter :: rid_jmekooh = 54 + integer, parameter :: rid_jmpan = 55 + integer, parameter :: rid_jmvk = 56 + integer, parameter :: rid_jnc4cho = 57 + integer, parameter :: rid_jnoa = 58 + integer, parameter :: rid_jnterpooh = 59 + integer, parameter :: rid_jonitr = 60 + integer, parameter :: rid_jpan = 61 + integer, parameter :: rid_jphenooh = 62 + integer, parameter :: rid_jpooh = 63 + integer, parameter :: rid_jrooh = 64 + integer, parameter :: rid_jtepomuc = 65 + integer, parameter :: rid_jterp2ooh = 66 + integer, parameter :: rid_jterpnit = 67 + integer, parameter :: rid_jterpooh = 68 + integer, parameter :: rid_jterprd1 = 69 + integer, parameter :: rid_jterprd2 = 70 + integer, parameter :: rid_jtolooh = 71 + integer, parameter :: rid_jxooh = 72 + integer, parameter :: rid_jxylenooh = 73 + integer, parameter :: rid_jxylolooh = 74 + integer, parameter :: rid_jbrcl = 75 + integer, parameter :: rid_jbro = 76 + integer, parameter :: rid_jbrono2_b = 77 + integer, parameter :: rid_jbrono2_a = 78 + integer, parameter :: rid_jccl4 = 79 + integer, parameter :: rid_jcf2clbr = 80 + integer, parameter :: rid_jcf3br = 81 + integer, parameter :: rid_jcfcl3 = 82 + integer, parameter :: rid_jcfc113 = 83 + integer, parameter :: rid_jcfc114 = 84 + integer, parameter :: rid_jcfc115 = 85 + integer, parameter :: rid_jcf2cl2 = 86 + integer, parameter :: rid_jch2br2 = 87 + integer, parameter :: rid_jch3br = 88 + integer, parameter :: rid_jch3ccl3 = 89 + integer, parameter :: rid_jch3cl = 90 + integer, parameter :: rid_jchbr3 = 91 + integer, parameter :: rid_jcl2 = 92 + integer, parameter :: rid_jcl2o2 = 93 + integer, parameter :: rid_jclo = 94 + integer, parameter :: rid_jclono2_a = 95 + integer, parameter :: rid_jclono2_b = 96 + integer, parameter :: rid_jcof2 = 97 + integer, parameter :: rid_jcofcl = 98 + integer, parameter :: rid_jh2402 = 99 + integer, parameter :: rid_jhbr = 100 + integer, parameter :: rid_jhcfc141b = 101 + integer, parameter :: rid_jhcfc142b = 102 + integer, parameter :: rid_jhcfc22 = 103 + integer, parameter :: rid_jhcl = 104 + integer, parameter :: rid_jhf = 105 + integer, parameter :: rid_jhobr = 106 + integer, parameter :: rid_jhocl = 107 + integer, parameter :: rid_joclo = 108 + integer, parameter :: rid_jsf6 = 109 + integer, parameter :: rid_jeuv_26 = 110 + integer, parameter :: rid_jeuv_4 = 111 + integer, parameter :: rid_jeuv_13 = 112 + integer, parameter :: rid_jeuv_11 = 113 + integer, parameter :: rid_jeuv_6 = 114 + integer, parameter :: rid_jeuv_10 = 115 + integer, parameter :: rid_jeuv_22 = 116 + integer, parameter :: rid_jeuv_23 = 117 + integer, parameter :: rid_jeuv_25 = 118 + integer, parameter :: rid_jeuv_18 = 119 + integer, parameter :: rid_jeuv_2 = 120 + integer, parameter :: rid_jeuv_1 = 121 + integer, parameter :: rid_jeuv_16 = 122 + integer, parameter :: rid_jeuv_15 = 123 + integer, parameter :: rid_jeuv_14 = 124 + integer, parameter :: rid_jeuv_3 = 125 + integer, parameter :: rid_jeuv_17 = 126 + integer, parameter :: rid_jeuv_9 = 127 + integer, parameter :: rid_jeuv_8 = 128 + integer, parameter :: rid_jeuv_7 = 129 + integer, parameter :: rid_jeuv_5 = 130 + integer, parameter :: rid_jeuv_19 = 131 + integer, parameter :: rid_jeuv_20 = 132 + integer, parameter :: rid_jeuv_21 = 133 + integer, parameter :: rid_jeuv_24 = 134 + integer, parameter :: rid_jeuv_12 = 135 + integer, parameter :: rid_jh2so4 = 136 + integer, parameter :: rid_jocs = 137 + integer, parameter :: rid_jso = 138 + integer, parameter :: rid_jso2 = 139 + integer, parameter :: rid_jso3 = 140 + integer, parameter :: rid_jsoabb1_a1 = 141 + integer, parameter :: rid_jsoabb1_a2 = 142 + integer, parameter :: rid_jsoabb2_a1 = 143 + integer, parameter :: rid_jsoabb2_a2 = 144 + integer, parameter :: rid_jsoabb3_a1 = 145 + integer, parameter :: rid_jsoabb3_a2 = 146 + integer, parameter :: rid_jsoabb4_a1 = 147 + integer, parameter :: rid_jsoabb4_a2 = 148 + integer, parameter :: rid_jsoabb5_a1 = 149 + integer, parameter :: rid_jsoabb5_a2 = 150 + integer, parameter :: rid_jsoabg1_a1 = 151 + integer, parameter :: rid_jsoabg1_a2 = 152 + integer, parameter :: rid_jsoabg2_a1 = 153 + integer, parameter :: rid_jsoabg2_a2 = 154 + integer, parameter :: rid_jsoabg3_a1 = 155 + integer, parameter :: rid_jsoabg3_a2 = 156 + integer, parameter :: rid_jsoabg4_a1 = 157 + integer, parameter :: rid_jsoabg4_a2 = 158 + integer, parameter :: rid_jsoabg5_a1 = 159 + integer, parameter :: rid_jsoabg5_a2 = 160 + integer, parameter :: rid_jsoaff1_a1 = 161 + integer, parameter :: rid_jsoaff1_a2 = 162 + integer, parameter :: rid_jsoaff2_a1 = 163 + integer, parameter :: rid_jsoaff2_a2 = 164 + integer, parameter :: rid_jsoaff3_a1 = 165 + integer, parameter :: rid_jsoaff3_a2 = 166 + integer, parameter :: rid_jsoaff4_a1 = 167 + integer, parameter :: rid_jsoaff4_a2 = 168 + integer, parameter :: rid_jsoaff5_a1 = 169 + integer, parameter :: rid_jsoaff5_a2 = 170 + integer, parameter :: rid_ag1 = 171 + integer, parameter :: rid_ag2 = 172 + integer, parameter :: rid_O1D_H2 = 173 + integer, parameter :: rid_O1D_H2O = 174 + integer, parameter :: rid_O1D_N2 = 175 + integer, parameter :: rid_O1D_O2 = 176 + integer, parameter :: rid_O1D_O2b = 177 + integer, parameter :: rid_O1D_O3 = 178 + integer, parameter :: rid_O2_1D_N2 = 179 + integer, parameter :: rid_O2_1D_O = 180 + integer, parameter :: rid_O2_1D_O2 = 181 + integer, parameter :: rid_O2_1S_CO2 = 182 + integer, parameter :: rid_O2_1S_N2 = 183 + integer, parameter :: rid_O2_1S_O = 184 + integer, parameter :: rid_O2_1S_O2 = 185 + integer, parameter :: rid_O2_1S_O3 = 186 + integer, parameter :: rid_O_O3 = 187 + integer, parameter :: rid_usr_O_O = 188 + integer, parameter :: rid_usr_O_O2 = 189 + integer, parameter :: rid_H2_O = 190 + integer, parameter :: rid_H2O2_O = 191 + integer, parameter :: rid_H_HO2 = 192 + integer, parameter :: rid_H_HO2a = 193 + integer, parameter :: rid_H_HO2b = 194 + integer, parameter :: rid_H_O2 = 195 + integer, parameter :: rid_HO2_O = 196 + integer, parameter :: rid_HO2_O3 = 197 + integer, parameter :: rid_H_O3 = 198 + integer, parameter :: rid_OH_H2 = 199 + integer, parameter :: rid_OH_H2O2 = 200 + integer, parameter :: rid_OH_HO2 = 201 + integer, parameter :: rid_OH_O = 202 + integer, parameter :: rid_OH_O3 = 203 + integer, parameter :: rid_OH_OH = 204 + integer, parameter :: rid_OH_OH_M = 205 + integer, parameter :: rid_usr_HO2_HO2 = 206 + integer, parameter :: rid_HO2NO2_OH = 207 + integer, parameter :: rid_N2D_O = 208 + integer, parameter :: rid_N2D_O2 = 209 + integer, parameter :: rid_N_NO = 210 + integer, parameter :: rid_N_NO2a = 211 + integer, parameter :: rid_N_NO2b = 212 + integer, parameter :: rid_N_NO2c = 213 + integer, parameter :: rid_N_O2 = 214 + integer, parameter :: rid_NO2_O = 215 + integer, parameter :: rid_NO2_O3 = 216 + integer, parameter :: rid_NO2_O_M = 217 + integer, parameter :: rid_NO3_HO2 = 218 + integer, parameter :: rid_NO3_NO = 219 + integer, parameter :: rid_NO3_O = 220 + integer, parameter :: rid_NO3_OH = 221 + integer, parameter :: rid_N_OH = 222 + integer, parameter :: rid_NO_HO2 = 223 + integer, parameter :: rid_NO_O3 = 224 + integer, parameter :: rid_NO_O_M = 225 + integer, parameter :: rid_O1D_N2Oa = 226 + integer, parameter :: rid_O1D_N2Ob = 227 + integer, parameter :: rid_tag_NO2_HO2 = 228 + integer, parameter :: rid_tag_NO2_NO3 = 229 + integer, parameter :: rid_tag_NO2_OH = 230 + integer, parameter :: rid_usr_HNO3_OH = 231 + integer, parameter :: rid_usr_HO2NO2_M = 232 + integer, parameter :: rid_usr_N2O5_M = 233 + integer, parameter :: rid_CL_CH2O = 234 + integer, parameter :: rid_CL_CH4 = 235 + integer, parameter :: rid_CL_H2 = 236 + integer, parameter :: rid_CL_H2O2 = 237 + integer, parameter :: rid_CL_HO2a = 238 + integer, parameter :: rid_CL_HO2b = 239 + integer, parameter :: rid_CL_O3 = 240 + integer, parameter :: rid_CLO_CH3O2 = 241 + integer, parameter :: rid_CLO_CLOa = 242 + integer, parameter :: rid_CLO_CLOb = 243 + integer, parameter :: rid_CLO_CLOc = 244 + integer, parameter :: rid_CLO_HO2 = 245 + integer, parameter :: rid_CLO_NO = 246 + integer, parameter :: rid_CLONO2_CL = 247 + integer, parameter :: rid_CLO_NO2_M = 248 + integer, parameter :: rid_CLONO2_O = 249 + integer, parameter :: rid_CLONO2_OH = 250 + integer, parameter :: rid_CLO_O = 251 + integer, parameter :: rid_CLO_OHa = 252 + integer, parameter :: rid_CLO_OHb = 253 + integer, parameter :: rid_HCL_O = 254 + integer, parameter :: rid_HCL_OH = 255 + integer, parameter :: rid_HOCL_CL = 256 + integer, parameter :: rid_HOCL_O = 257 + integer, parameter :: rid_HOCL_OH = 258 + integer, parameter :: rid_O1D_CCL4 = 259 + integer, parameter :: rid_O1D_CF2CLBR = 260 + integer, parameter :: rid_O1D_CFC11 = 261 + integer, parameter :: rid_O1D_CFC113 = 262 + integer, parameter :: rid_O1D_CFC114 = 263 + integer, parameter :: rid_O1D_CFC115 = 264 + integer, parameter :: rid_O1D_CFC12 = 265 + integer, parameter :: rid_O1D_HCLa = 266 + integer, parameter :: rid_O1D_HCLb = 267 + integer, parameter :: rid_tag_CLO_CLO_M = 268 + integer, parameter :: rid_usr_CL2O2_M = 269 + integer, parameter :: rid_BR_CH2O = 270 + integer, parameter :: rid_BR_HO2 = 271 + integer, parameter :: rid_BR_O3 = 272 + integer, parameter :: rid_BRO_BRO = 273 + integer, parameter :: rid_BRO_CLOa = 274 + integer, parameter :: rid_BRO_CLOb = 275 + integer, parameter :: rid_BRO_CLOc = 276 + integer, parameter :: rid_BRO_HO2 = 277 + integer, parameter :: rid_BRO_NO = 278 + integer, parameter :: rid_BRO_NO2_M = 279 + integer, parameter :: rid_BRONO2_O = 280 + integer, parameter :: rid_BRO_O = 281 + integer, parameter :: rid_BRO_OH = 282 + integer, parameter :: rid_HBR_O = 283 + integer, parameter :: rid_HBR_OH = 284 + integer, parameter :: rid_HOBR_O = 285 + integer, parameter :: rid_O1D_CF3BR = 286 + integer, parameter :: rid_O1D_CHBR3 = 287 + integer, parameter :: rid_O1D_H2402 = 288 + integer, parameter :: rid_O1D_HBRa = 289 + integer, parameter :: rid_O1D_HBRb = 290 + integer, parameter :: rid_F_CH4 = 291 + integer, parameter :: rid_F_H2 = 292 + integer, parameter :: rid_F_H2O = 293 + integer, parameter :: rid_F_HNO3 = 294 + integer, parameter :: rid_O1D_COF2 = 295 + integer, parameter :: rid_O1D_COFCL = 296 + integer, parameter :: rid_CH2BR2_CL = 297 + integer, parameter :: rid_CH2BR2_OH = 298 + integer, parameter :: rid_CH3BR_CL = 299 + integer, parameter :: rid_CH3BR_OH = 300 + integer, parameter :: rid_CH3CCL3_OH = 301 + integer, parameter :: rid_CH3CL_CL = 302 + integer, parameter :: rid_CH3CL_OH = 303 + integer, parameter :: rid_CHBR3_CL = 304 + integer, parameter :: rid_CHBR3_OH = 305 + integer, parameter :: rid_HCFC141B_OH = 306 + integer, parameter :: rid_HCFC142B_OH = 307 + integer, parameter :: rid_HCFC22_OH = 308 + integer, parameter :: rid_O1D_CH2BR2 = 309 + integer, parameter :: rid_O1D_CH3BR = 310 + integer, parameter :: rid_O1D_HCFC141B = 311 + integer, parameter :: rid_O1D_HCFC142B = 312 + integer, parameter :: rid_O1D_HCFC22 = 313 + integer, parameter :: rid_CH2O_HO2 = 314 + integer, parameter :: rid_CH2O_NO3 = 315 + integer, parameter :: rid_CH2O_O = 316 + integer, parameter :: rid_CH2O_OH = 317 + integer, parameter :: rid_CH3O2_CH3O2a = 318 + integer, parameter :: rid_CH3O2_CH3O2b = 319 + integer, parameter :: rid_CH3O2_HO2 = 320 + integer, parameter :: rid_CH3O2_NO = 321 + integer, parameter :: rid_CH3OH_OH = 322 + integer, parameter :: rid_CH3OOH_OH = 323 + integer, parameter :: rid_CH4_OH = 324 + integer, parameter :: rid_HCN_OH = 325 + integer, parameter :: rid_HCOOH_OH = 326 + integer, parameter :: rid_HOCH2OO_HO2 = 327 + integer, parameter :: rid_HOCH2OO_M = 328 + integer, parameter :: rid_HOCH2OO_NO = 329 + integer, parameter :: rid_O1D_CH4a = 330 + integer, parameter :: rid_O1D_CH4b = 331 + integer, parameter :: rid_O1D_CH4c = 332 + integer, parameter :: rid_O1D_HCN = 333 + integer, parameter :: rid_usr_CO_OH = 334 + integer, parameter :: rid_C2H2_CL_M = 335 + integer, parameter :: rid_C2H2_OH_M = 336 + integer, parameter :: rid_C2H4_CL_M = 337 + integer, parameter :: rid_C2H4_O3 = 338 + integer, parameter :: rid_C2H5O2_C2H5O2 = 339 + integer, parameter :: rid_C2H5O2_CH3O2 = 340 + integer, parameter :: rid_C2H5O2_HO2 = 341 + integer, parameter :: rid_C2H5O2_NO = 342 + integer, parameter :: rid_C2H5OH_OH = 343 + integer, parameter :: rid_C2H5OOH_OH = 344 + integer, parameter :: rid_C2H6_CL = 345 + integer, parameter :: rid_C2H6_OH = 346 + integer, parameter :: rid_CH3CHO_NO3 = 347 + integer, parameter :: rid_CH3CHO_OH = 348 + integer, parameter :: rid_CH3CN_OH = 349 + integer, parameter :: rid_CH3CO3_CH3CO3 = 350 + integer, parameter :: rid_CH3CO3_CH3O2 = 351 + integer, parameter :: rid_CH3CO3_HO2 = 352 + integer, parameter :: rid_CH3CO3_NO = 353 + integer, parameter :: rid_CH3COOH_OH = 354 + integer, parameter :: rid_CH3COOOH_OH = 355 + integer, parameter :: rid_EO2_HO2 = 356 + integer, parameter :: rid_EO2_NO = 357 + integer, parameter :: rid_EO_M = 358 + integer, parameter :: rid_EO_O2 = 359 + integer, parameter :: rid_GLYALD_OH = 360 + integer, parameter :: rid_GLYOXAL_OH = 361 + integer, parameter :: rid_PAN_OH = 362 + integer, parameter :: rid_tag_C2H4_OH = 363 + integer, parameter :: rid_tag_CH3CO3_NO2 = 364 + integer, parameter :: rid_usr_PAN_M = 365 + integer, parameter :: rid_C3H6_NO3 = 366 + integer, parameter :: rid_C3H6_O3 = 367 + integer, parameter :: rid_C3H7O2_CH3O2 = 368 + integer, parameter :: rid_C3H7O2_HO2 = 369 + integer, parameter :: rid_C3H7O2_NO = 370 + integer, parameter :: rid_C3H7OOH_OH = 371 + integer, parameter :: rid_C3H8_OH = 372 + integer, parameter :: rid_CH3COCHO_NO3 = 373 + integer, parameter :: rid_CH3COCHO_OH = 374 + integer, parameter :: rid_CL_C3H8 = 375 + integer, parameter :: rid_HYAC_OH = 376 + integer, parameter :: rid_NOA_OH = 377 + integer, parameter :: rid_PO2_HO2 = 378 + integer, parameter :: rid_PO2_NO = 379 + integer, parameter :: rid_POOH_OH = 380 + integer, parameter :: rid_RO2_CH3O2 = 381 + integer, parameter :: rid_RO2_HO2 = 382 + integer, parameter :: rid_RO2_NO = 383 + integer, parameter :: rid_ROOH_OH = 384 + integer, parameter :: rid_tag_C3H6_OH = 385 + integer, parameter :: rid_usr_CH3COCH3_OH = 386 + integer, parameter :: rid_BIGENE_NO3 = 387 + integer, parameter :: rid_BIGENE_OH = 388 + integer, parameter :: rid_ENEO2_NO = 389 + integer, parameter :: rid_ENEO2_NOb = 390 + integer, parameter :: rid_HONITR_OH = 391 + integer, parameter :: rid_MACRO2_CH3CO3 = 392 + integer, parameter :: rid_MACRO2_CH3O2 = 393 + integer, parameter :: rid_MACRO2_HO2 = 394 + integer, parameter :: rid_MACRO2_NO3 = 395 + integer, parameter :: rid_MACRO2_NOa = 396 + integer, parameter :: rid_MACRO2_NOb = 397 + integer, parameter :: rid_MACR_O3 = 398 + integer, parameter :: rid_MACR_OH = 399 + integer, parameter :: rid_MACROOH_OH = 400 + integer, parameter :: rid_MCO3_CH3CO3 = 401 + integer, parameter :: rid_MCO3_CH3O2 = 402 + integer, parameter :: rid_MCO3_HO2 = 403 + integer, parameter :: rid_MCO3_MCO3 = 404 + integer, parameter :: rid_MCO3_NO = 405 + integer, parameter :: rid_MCO3_NO3 = 406 + integer, parameter :: rid_MEKO2_HO2 = 407 + integer, parameter :: rid_MEKO2_NO = 408 + integer, parameter :: rid_MEK_OH = 409 + integer, parameter :: rid_MEKOOH_OH = 410 + integer, parameter :: rid_MPAN_OH_M = 411 + integer, parameter :: rid_MVK_O3 = 412 + integer, parameter :: rid_MVK_OH = 413 + integer, parameter :: rid_tag_MCO3_NO2 = 414 + integer, parameter :: rid_usr_MPAN_M = 415 + integer, parameter :: rid_ALKNIT_OH = 416 + integer, parameter :: rid_ALKO2_HO2 = 417 + integer, parameter :: rid_ALKO2_NO = 418 + integer, parameter :: rid_ALKO2_NOb = 419 + integer, parameter :: rid_ALKOOH_OH = 420 + integer, parameter :: rid_BIGALK_OH = 421 + integer, parameter :: rid_HPALD_OH = 422 + integer, parameter :: rid_HYDRALD_OH = 423 + integer, parameter :: rid_IEPOX_OH = 424 + integer, parameter :: rid_ISOPAO2_CH3CO3 = 425 + integer, parameter :: rid_ISOPAO2_CH3O2 = 426 + integer, parameter :: rid_ISOPAO2_HO2 = 427 + integer, parameter :: rid_ISOPAO2_NO = 428 + integer, parameter :: rid_ISOPAO2_NO3 = 429 + integer, parameter :: rid_ISOPBO2_CH3CO3 = 430 + integer, parameter :: rid_ISOPBO2_CH3O2 = 431 + integer, parameter :: rid_ISOPBO2_HO2 = 432 + integer, parameter :: rid_ISOPBO2_M = 433 + integer, parameter :: rid_ISOPBO2_NO = 434 + integer, parameter :: rid_ISOPBO2_NO3 = 435 + integer, parameter :: rid_ISOPNITA_OH = 436 + integer, parameter :: rid_ISOPNITB_OH = 437 + integer, parameter :: rid_ISOP_NO3 = 438 + integer, parameter :: rid_ISOPNO3_CH3CO3 = 439 + integer, parameter :: rid_ISOPNO3_CH3O2 = 440 + integer, parameter :: rid_ISOPNO3_HO2 = 441 + integer, parameter :: rid_ISOPNO3_NO = 442 + integer, parameter :: rid_ISOPNO3_NO3 = 443 + integer, parameter :: rid_ISOPNOOH_OH = 444 + integer, parameter :: rid_ISOP_O3 = 445 + integer, parameter :: rid_ISOP_OH = 446 + integer, parameter :: rid_ISOPOOH_OH = 447 + integer, parameter :: rid_NC4CH2OH_OH = 448 + integer, parameter :: rid_NC4CHO_OH = 449 + integer, parameter :: rid_XO2_CH3CO3 = 450 + integer, parameter :: rid_XO2_CH3O2 = 451 + integer, parameter :: rid_XO2_HO2 = 452 + integer, parameter :: rid_XO2_NO = 453 + integer, parameter :: rid_XO2_NO3 = 454 + integer, parameter :: rid_XOOH_OH = 455 + integer, parameter :: rid_ACBZO2_HO2 = 456 + integer, parameter :: rid_ACBZO2_NO = 457 + integer, parameter :: rid_BENZENE_OH = 458 + integer, parameter :: rid_BENZO2_HO2 = 459 + integer, parameter :: rid_BENZO2_NO = 460 + integer, parameter :: rid_BENZOOH_OH = 461 + integer, parameter :: rid_BZALD_OH = 462 + integer, parameter :: rid_BZOO_HO2 = 463 + integer, parameter :: rid_BZOOH_OH = 464 + integer, parameter :: rid_BZOO_NO = 465 + integer, parameter :: rid_C6H5O2_HO2 = 466 + integer, parameter :: rid_C6H5O2_NO = 467 + integer, parameter :: rid_C6H5OOH_OH = 468 + integer, parameter :: rid_CRESOL_OH = 469 + integer, parameter :: rid_DICARBO2_HO2 = 470 + integer, parameter :: rid_DICARBO2_NO = 471 + integer, parameter :: rid_DICARBO2_NO2 = 472 + integer, parameter :: rid_MALO2_HO2 = 473 + integer, parameter :: rid_MALO2_NO = 474 + integer, parameter :: rid_MALO2_NO2 = 475 + integer, parameter :: rid_MDIALO2_HO2 = 476 + integer, parameter :: rid_MDIALO2_NO = 477 + integer, parameter :: rid_MDIALO2_NO2 = 478 + integer, parameter :: rid_PHENO2_HO2 = 479 + integer, parameter :: rid_PHENO2_NO = 480 + integer, parameter :: rid_PHENOL_OH = 481 + integer, parameter :: rid_PHENO_NO2 = 482 + integer, parameter :: rid_PHENO_O3 = 483 + integer, parameter :: rid_PHENOOH_OH = 484 + integer, parameter :: rid_tag_ACBZO2_NO2 = 485 + integer, parameter :: rid_TOLO2_HO2 = 486 + integer, parameter :: rid_TOLO2_NO = 487 + integer, parameter :: rid_TOLOOH_OH = 488 + integer, parameter :: rid_TOLUENE_OH = 489 + integer, parameter :: rid_usr_PBZNIT_M = 490 + integer, parameter :: rid_XYLENES_OH = 491 + integer, parameter :: rid_XYLENO2_HO2 = 492 + integer, parameter :: rid_XYLENO2_NO = 493 + integer, parameter :: rid_XYLENOOH_OH = 494 + integer, parameter :: rid_XYLOLO2_HO2 = 495 + integer, parameter :: rid_XYLOLO2_NO = 496 + integer, parameter :: rid_XYLOL_OH = 497 + integer, parameter :: rid_XYLOLOOH_OH = 498 + integer, parameter :: rid_BCARY_NO3 = 499 + integer, parameter :: rid_BCARY_O3 = 500 + integer, parameter :: rid_BCARY_OH = 501 + integer, parameter :: rid_MTERP_NO3 = 502 + integer, parameter :: rid_MTERP_O3 = 503 + integer, parameter :: rid_MTERP_OH = 504 + integer, parameter :: rid_NTERPO2_CH3O2 = 505 + integer, parameter :: rid_NTERPO2_HO2 = 506 + integer, parameter :: rid_NTERPO2_NO = 507 + integer, parameter :: rid_NTERPO2_NO3 = 508 + integer, parameter :: rid_NTERPOOH_OH = 509 + integer, parameter :: rid_TERP2O2_CH3O2 = 510 + integer, parameter :: rid_TERP2O2_HO2 = 511 + integer, parameter :: rid_TERP2O2_NO = 512 + integer, parameter :: rid_TERP2OOH_OH = 513 + integer, parameter :: rid_TERPNIT_OH = 514 + integer, parameter :: rid_TERPO2_CH3O2 = 515 + integer, parameter :: rid_TERPO2_HO2 = 516 + integer, parameter :: rid_TERPO2_NO = 517 + integer, parameter :: rid_TERPOOH_OH = 518 + integer, parameter :: rid_TERPROD1_NO3 = 519 + integer, parameter :: rid_TERPROD1_OH = 520 + integer, parameter :: rid_TERPROD2_OH = 521 + integer, parameter :: rid_DMS_NO3 = 522 + integer, parameter :: rid_DMS_OHa = 523 + integer, parameter :: rid_OCS_O = 524 + integer, parameter :: rid_OCS_OH = 525 + integer, parameter :: rid_S_O2 = 526 + integer, parameter :: rid_SO2_OH_M = 527 + integer, parameter :: rid_S_O3 = 528 + integer, parameter :: rid_SO_BRO = 529 + integer, parameter :: rid_SO_CLO = 530 + integer, parameter :: rid_S_OH = 531 + integer, parameter :: rid_SO_NO2 = 532 + integer, parameter :: rid_SO_O2 = 533 + integer, parameter :: rid_SO_O3 = 534 + integer, parameter :: rid_SO_OCLO = 535 + integer, parameter :: rid_SO_OH = 536 + integer, parameter :: rid_usr_DMS_OH = 537 + integer, parameter :: rid_usr_SO3_H2O = 538 + integer, parameter :: rid_NH3_OH = 539 + integer, parameter :: rid_usr_HO2_aer = 540 + integer, parameter :: rid_usr_HONITR_aer = 541 + integer, parameter :: rid_usr_ISOPNITA_aer = 542 + integer, parameter :: rid_usr_ISOPNITB_aer = 543 + integer, parameter :: rid_usr_N2O5_aer = 544 + integer, parameter :: rid_usr_NC4CH2OH_aer = 545 + integer, parameter :: rid_usr_NC4CHO_aer = 546 + integer, parameter :: rid_usr_NH4_strat_tau = 547 + integer, parameter :: rid_usr_NO2_aer = 548 + integer, parameter :: rid_usr_NO3_aer = 549 + integer, parameter :: rid_usr_NTERPOOH_aer = 550 + integer, parameter :: rid_usr_ONITR_aer = 551 + integer, parameter :: rid_usr_TERPNIT_aer = 552 + integer, parameter :: rid_BCARY_NO3_vbs = 553 + integer, parameter :: rid_BCARYO2_HO2_vbs = 554 + integer, parameter :: rid_BCARYO2_NO_vbs = 555 + integer, parameter :: rid_BCARY_O3_vbs = 556 + integer, parameter :: rid_BCARY_OH_vbs = 557 + integer, parameter :: rid_BENZENE_OH_vbs = 558 + integer, parameter :: rid_BENZO2_HO2_vbs = 559 + integer, parameter :: rid_BENZO2_NO_vbs = 560 + integer, parameter :: rid_ISOP_NO3_vbs = 561 + integer, parameter :: rid_ISOPO2_HO2_vbs = 562 + integer, parameter :: rid_ISOPO2_NO_vbs = 563 + integer, parameter :: rid_ISOP_O3_vbs = 564 + integer, parameter :: rid_ISOP_OH_vbs = 565 + integer, parameter :: rid_IVOCbbO2_HO2_vbs = 566 + integer, parameter :: rid_IVOCbbO2_NO_vbs = 567 + integer, parameter :: rid_IVOCbb_OH_vbs = 568 + integer, parameter :: rid_IVOCffO2_HO2_vbs = 569 + integer, parameter :: rid_IVOCffO2_NO_vbs = 570 + integer, parameter :: rid_IVOCff_OH_vbs = 571 + integer, parameter :: rid_MTERP_NO3_vbs = 572 + integer, parameter :: rid_MTERPO2_HO2_vbs = 573 + integer, parameter :: rid_MTERPO2_NO_vbs = 574 + integer, parameter :: rid_MTERP_O3_vbs = 575 + integer, parameter :: rid_MTERP_OH_vbs = 576 + integer, parameter :: rid_SVOCbb_OH = 577 + integer, parameter :: rid_SVOCff_OH = 578 + integer, parameter :: rid_TOLUENE_OH_vbs = 579 + integer, parameter :: rid_TOLUO2_HO2_vbs = 580 + integer, parameter :: rid_TOLUO2_NO_vbs = 581 + integer, parameter :: rid_usr_GLYOXAL_aer = 582 + integer, parameter :: rid_XYLENES_OH_vbs = 583 + integer, parameter :: rid_XYLEO2_HO2_vbs = 584 + integer, parameter :: rid_XYLEO2_NO_vbs = 585 + integer, parameter :: rid_het1 = 586 + integer, parameter :: rid_het10 = 587 + integer, parameter :: rid_het11 = 588 + integer, parameter :: rid_het12 = 589 + integer, parameter :: rid_het13 = 590 + integer, parameter :: rid_het14 = 591 + integer, parameter :: rid_het15 = 592 + integer, parameter :: rid_het16 = 593 + integer, parameter :: rid_het17 = 594 + integer, parameter :: rid_het2 = 595 + integer, parameter :: rid_het3 = 596 + integer, parameter :: rid_het4 = 597 + integer, parameter :: rid_het5 = 598 + integer, parameter :: rid_het6 = 599 + integer, parameter :: rid_het7 = 600 + integer, parameter :: rid_het8 = 601 + integer, parameter :: rid_het9 = 602 + integer, parameter :: rid_elec1 = 603 + integer, parameter :: rid_elec2 = 604 + integer, parameter :: rid_elec3 = 605 + integer, parameter :: rid_ion_N2p_O2 = 606 + integer, parameter :: rid_ion_N2p_Oa = 607 + integer, parameter :: rid_ion_N2p_Ob = 608 + integer, parameter :: rid_ion_Np_O = 609 + integer, parameter :: rid_ion_Np_O2a = 610 + integer, parameter :: rid_ion_Np_O2b = 611 + integer, parameter :: rid_ion_O2p_N = 612 + integer, parameter :: rid_ion_O2p_N2 = 613 + integer, parameter :: rid_ion_O2p_NO = 614 + integer, parameter :: rid_ion_Op_CO2 = 615 + integer, parameter :: rid_ion_Op_N2 = 616 + integer, parameter :: rid_ion_Op_O2 = 617 + integer, parameter :: rid_E90_tau = 618 + integer, parameter :: rid_NH_50_tau = 619 + integer, parameter :: rid_NH_5_tau = 620 + integer, parameter :: rid_ST80_25_tau = 621 + end module m_rxt_id diff --git a/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/m_spc_id.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/m_spc_id.F90 new file mode 100644 index 0000000000..9f67ecbc15 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/m_spc_id.F90 @@ -0,0 +1,279 @@ + module m_spc_id + implicit none + integer, parameter :: id_ALKNIT = 1 + integer, parameter :: id_ALKOOH = 2 + integer, parameter :: id_AOA_NH = 3 + integer, parameter :: id_bc_a1 = 4 + integer, parameter :: id_bc_a4 = 5 + integer, parameter :: id_BCARY = 6 + integer, parameter :: id_BCARYO2VBS = 7 + integer, parameter :: id_BENZENE = 8 + integer, parameter :: id_BENZO2VBS = 9 + integer, parameter :: id_BENZOOH = 10 + integer, parameter :: id_BEPOMUC = 11 + integer, parameter :: id_BIGALD = 12 + integer, parameter :: id_BIGALD1 = 13 + integer, parameter :: id_BIGALD2 = 14 + integer, parameter :: id_BIGALD3 = 15 + integer, parameter :: id_BIGALD4 = 16 + integer, parameter :: id_BIGALK = 17 + integer, parameter :: id_BIGENE = 18 + integer, parameter :: id_BR = 19 + integer, parameter :: id_BRCL = 20 + integer, parameter :: id_BRO = 21 + integer, parameter :: id_BRONO2 = 22 + integer, parameter :: id_BRY = 23 + integer, parameter :: id_BZALD = 24 + integer, parameter :: id_BZOOH = 25 + integer, parameter :: id_C2H2 = 26 + integer, parameter :: id_C2H4 = 27 + integer, parameter :: id_C2H5OH = 28 + integer, parameter :: id_C2H5OOH = 29 + integer, parameter :: id_C2H6 = 30 + integer, parameter :: id_C3H6 = 31 + integer, parameter :: id_C3H7OOH = 32 + integer, parameter :: id_C3H8 = 33 + integer, parameter :: id_C6H5OOH = 34 + integer, parameter :: id_CCL4 = 35 + integer, parameter :: id_CF2CLBR = 36 + integer, parameter :: id_CF3BR = 37 + integer, parameter :: id_CFC11 = 38 + integer, parameter :: id_CFC113 = 39 + integer, parameter :: id_CFC114 = 40 + integer, parameter :: id_CFC115 = 41 + integer, parameter :: id_CFC12 = 42 + integer, parameter :: id_CH2BR2 = 43 + integer, parameter :: id_CH2O = 44 + integer, parameter :: id_CH3BR = 45 + integer, parameter :: id_CH3CCL3 = 46 + integer, parameter :: id_CH3CHO = 47 + integer, parameter :: id_CH3CL = 48 + integer, parameter :: id_CH3CN = 49 + integer, parameter :: id_CH3COCH3 = 50 + integer, parameter :: id_CH3COCHO = 51 + integer, parameter :: id_CH3COOH = 52 + integer, parameter :: id_CH3COOOH = 53 + integer, parameter :: id_CH3OH = 54 + integer, parameter :: id_CH3OOH = 55 + integer, parameter :: id_CH4 = 56 + integer, parameter :: id_CHBR3 = 57 + integer, parameter :: id_CL = 58 + integer, parameter :: id_CL2 = 59 + integer, parameter :: id_CL2O2 = 60 + integer, parameter :: id_CLO = 61 + integer, parameter :: id_CLONO2 = 62 + integer, parameter :: id_CLY = 63 + integer, parameter :: id_CO = 64 + integer, parameter :: id_CO2 = 65 + integer, parameter :: id_COF2 = 66 + integer, parameter :: id_COFCL = 67 + integer, parameter :: id_CRESOL = 68 + integer, parameter :: id_DMS = 69 + integer, parameter :: id_dst_a1 = 70 + integer, parameter :: id_dst_a2 = 71 + integer, parameter :: id_dst_a3 = 72 + integer, parameter :: id_E90 = 73 + integer, parameter :: id_EOOH = 74 + integer, parameter :: id_F = 75 + integer, parameter :: id_GLYALD = 76 + integer, parameter :: id_GLYOXAL = 77 + integer, parameter :: id_H = 78 + integer, parameter :: id_H2 = 79 + integer, parameter :: id_H2402 = 80 + integer, parameter :: id_H2O2 = 81 + integer, parameter :: id_H2SO4 = 82 + integer, parameter :: id_HBR = 83 + integer, parameter :: id_HCFC141B = 84 + integer, parameter :: id_HCFC142B = 85 + integer, parameter :: id_HCFC22 = 86 + integer, parameter :: id_HCL = 87 + integer, parameter :: id_HCN = 88 + integer, parameter :: id_HCOOH = 89 + integer, parameter :: id_HF = 90 + integer, parameter :: id_HNO3 = 91 + integer, parameter :: id_HO2NO2 = 92 + integer, parameter :: id_HOBR = 93 + integer, parameter :: id_HOCL = 94 + integer, parameter :: id_HONITR = 95 + integer, parameter :: id_HPALD = 96 + integer, parameter :: id_HYAC = 97 + integer, parameter :: id_HYDRALD = 98 + integer, parameter :: id_IEPOX = 99 + integer, parameter :: id_ISOP = 100 + integer, parameter :: id_ISOPNITA = 101 + integer, parameter :: id_ISOPNITB = 102 + integer, parameter :: id_ISOPNO3 = 103 + integer, parameter :: id_ISOPNOOH = 104 + integer, parameter :: id_ISOPO2VBS = 105 + integer, parameter :: id_ISOPOOH = 106 + integer, parameter :: id_IVOCbb = 107 + integer, parameter :: id_IVOCbbO2VBS = 108 + integer, parameter :: id_IVOCff = 109 + integer, parameter :: id_IVOCffO2VBS = 110 + integer, parameter :: id_MACR = 111 + integer, parameter :: id_MACROOH = 112 + integer, parameter :: id_MEK = 113 + integer, parameter :: id_MEKOOH = 114 + integer, parameter :: id_MPAN = 115 + integer, parameter :: id_MTERP = 116 + integer, parameter :: id_MTERPO2VBS = 117 + integer, parameter :: id_MVK = 118 + integer, parameter :: id_N = 119 + integer, parameter :: id_N2O = 120 + integer, parameter :: id_N2O5 = 121 + integer, parameter :: id_NC4CH2OH = 122 + integer, parameter :: id_NC4CHO = 123 + integer, parameter :: id_ncl_a1 = 124 + integer, parameter :: id_ncl_a2 = 125 + integer, parameter :: id_ncl_a3 = 126 + integer, parameter :: id_NH3 = 127 + integer, parameter :: id_NH4 = 128 + integer, parameter :: id_NH_5 = 129 + integer, parameter :: id_NH_50 = 130 + integer, parameter :: id_NO = 131 + integer, parameter :: id_NO2 = 132 + integer, parameter :: id_NO3 = 133 + integer, parameter :: id_NOA = 134 + integer, parameter :: id_NTERPOOH = 135 + integer, parameter :: id_num_a1 = 136 + integer, parameter :: id_num_a2 = 137 + integer, parameter :: id_num_a3 = 138 + integer, parameter :: id_num_a4 = 139 + integer, parameter :: id_num_a5 = 140 + integer, parameter :: id_O = 141 + integer, parameter :: id_O2 = 142 + integer, parameter :: id_O3 = 143 + integer, parameter :: id_O3S = 144 + integer, parameter :: id_OCLO = 145 + integer, parameter :: id_OCS = 146 + integer, parameter :: id_ONITR = 147 + integer, parameter :: id_PAN = 148 + integer, parameter :: id_PBZNIT = 149 + integer, parameter :: id_PHENO = 150 + integer, parameter :: id_PHENOL = 151 + integer, parameter :: id_PHENOOH = 152 + integer, parameter :: id_pombb1_a1 = 153 + integer, parameter :: id_pombb1_a4 = 154 + integer, parameter :: id_pomff1_a1 = 155 + integer, parameter :: id_pomff1_a4 = 156 + integer, parameter :: id_POOH = 157 + integer, parameter :: id_ROOH = 158 + integer, parameter :: id_S = 159 + integer, parameter :: id_SF6 = 160 + integer, parameter :: id_SO = 161 + integer, parameter :: id_SO2 = 162 + integer, parameter :: id_SO3 = 163 + integer, parameter :: id_so4_a1 = 164 + integer, parameter :: id_so4_a2 = 165 + integer, parameter :: id_so4_a3 = 166 + integer, parameter :: id_so4_a5 = 167 + integer, parameter :: id_soabb1_a1 = 168 + integer, parameter :: id_soabb1_a2 = 169 + integer, parameter :: id_soabb2_a1 = 170 + integer, parameter :: id_soabb2_a2 = 171 + integer, parameter :: id_soabb3_a1 = 172 + integer, parameter :: id_soabb3_a2 = 173 + integer, parameter :: id_soabb4_a1 = 174 + integer, parameter :: id_soabb4_a2 = 175 + integer, parameter :: id_soabb5_a1 = 176 + integer, parameter :: id_soabb5_a2 = 177 + integer, parameter :: id_soabg1_a1 = 178 + integer, parameter :: id_soabg1_a2 = 179 + integer, parameter :: id_soabg2_a1 = 180 + integer, parameter :: id_soabg2_a2 = 181 + integer, parameter :: id_soabg3_a1 = 182 + integer, parameter :: id_soabg3_a2 = 183 + integer, parameter :: id_soabg4_a1 = 184 + integer, parameter :: id_soabg4_a2 = 185 + integer, parameter :: id_soabg5_a1 = 186 + integer, parameter :: id_soabg5_a2 = 187 + integer, parameter :: id_soaff1_a1 = 188 + integer, parameter :: id_soaff1_a2 = 189 + integer, parameter :: id_soaff2_a1 = 190 + integer, parameter :: id_soaff2_a2 = 191 + integer, parameter :: id_soaff3_a1 = 192 + integer, parameter :: id_soaff3_a2 = 193 + integer, parameter :: id_soaff4_a1 = 194 + integer, parameter :: id_soaff4_a2 = 195 + integer, parameter :: id_soaff5_a1 = 196 + integer, parameter :: id_soaff5_a2 = 197 + integer, parameter :: id_SOAGbb0 = 198 + integer, parameter :: id_SOAGbb1 = 199 + integer, parameter :: id_SOAGbb2 = 200 + integer, parameter :: id_SOAGbb3 = 201 + integer, parameter :: id_SOAGbb4 = 202 + integer, parameter :: id_SOAGbg0 = 203 + integer, parameter :: id_SOAGbg1 = 204 + integer, parameter :: id_SOAGbg2 = 205 + integer, parameter :: id_SOAGbg3 = 206 + integer, parameter :: id_SOAGbg4 = 207 + integer, parameter :: id_SOAGff0 = 208 + integer, parameter :: id_SOAGff1 = 209 + integer, parameter :: id_SOAGff2 = 210 + integer, parameter :: id_SOAGff3 = 211 + integer, parameter :: id_SOAGff4 = 212 + integer, parameter :: id_ST80_25 = 213 + integer, parameter :: id_SVOCbb = 214 + integer, parameter :: id_SVOCff = 215 + integer, parameter :: id_TEPOMUC = 216 + integer, parameter :: id_TERP2OOH = 217 + integer, parameter :: id_TERPNIT = 218 + integer, parameter :: id_TERPOOH = 219 + integer, parameter :: id_TERPROD1 = 220 + integer, parameter :: id_TERPROD2 = 221 + integer, parameter :: id_TOLOOH = 222 + integer, parameter :: id_TOLUENE = 223 + integer, parameter :: id_TOLUO2VBS = 224 + integer, parameter :: id_XOOH = 225 + integer, parameter :: id_XYLENES = 226 + integer, parameter :: id_XYLENOOH = 227 + integer, parameter :: id_XYLEO2VBS = 228 + integer, parameter :: id_XYLOL = 229 + integer, parameter :: id_XYLOLOOH = 230 + integer, parameter :: id_NHDEP = 231 + integer, parameter :: id_NDEP = 232 + integer, parameter :: id_ACBZO2 = 233 + integer, parameter :: id_ALKO2 = 234 + integer, parameter :: id_BENZO2 = 235 + integer, parameter :: id_BZOO = 236 + integer, parameter :: id_C2H5O2 = 237 + integer, parameter :: id_C3H7O2 = 238 + integer, parameter :: id_C6H5O2 = 239 + integer, parameter :: id_CH3CO3 = 240 + integer, parameter :: id_CH3O2 = 241 + integer, parameter :: id_DICARBO2 = 242 + integer, parameter :: id_e = 243 + integer, parameter :: id_ENEO2 = 244 + integer, parameter :: id_EO = 245 + integer, parameter :: id_EO2 = 246 + integer, parameter :: id_HO2 = 247 + integer, parameter :: id_HOCH2OO = 248 + integer, parameter :: id_ISOPAO2 = 249 + integer, parameter :: id_ISOPBO2 = 250 + integer, parameter :: id_MACRO2 = 251 + integer, parameter :: id_MALO2 = 252 + integer, parameter :: id_MCO3 = 253 + integer, parameter :: id_MDIALO2 = 254 + integer, parameter :: id_MEKO2 = 255 + integer, parameter :: id_N2D = 256 + integer, parameter :: id_N2p = 257 + integer, parameter :: id_NOp = 258 + integer, parameter :: id_Np = 259 + integer, parameter :: id_NTERPO2 = 260 + integer, parameter :: id_O1D = 261 + integer, parameter :: id_O2_1D = 262 + integer, parameter :: id_O2_1S = 263 + integer, parameter :: id_O2p = 264 + integer, parameter :: id_OH = 265 + integer, parameter :: id_Op = 266 + integer, parameter :: id_PHENO2 = 267 + integer, parameter :: id_PO2 = 268 + integer, parameter :: id_RO2 = 269 + integer, parameter :: id_TERP2O2 = 270 + integer, parameter :: id_TERPO2 = 271 + integer, parameter :: id_TOLO2 = 272 + integer, parameter :: id_XO2 = 273 + integer, parameter :: id_XYLENO2 = 274 + integer, parameter :: id_XYLOLO2 = 275 + integer, parameter :: id_H2O = 276 + end module m_spc_id diff --git a/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_adjrxt.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_adjrxt.F90 new file mode 100644 index 0000000000..505efdcecb --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_adjrxt.F90 @@ -0,0 +1,462 @@ + 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(:,:, 175) = rate(:,:, 175) * inv(:,:, 2) + rate(:,:, 179) = rate(:,:, 179) * inv(:,:, 2) + rate(:,:, 183) = rate(:,:, 183) * inv(:,:, 2) + rate(:,:, 188) = rate(:,:, 188) * inv(:,:, 1) + rate(:,:, 189) = rate(:,:, 189) * inv(:,:, 1) + rate(:,:, 195) = rate(:,:, 195) * inv(:,:, 1) + rate(:,:, 205) = rate(:,:, 205) * inv(:,:, 1) + rate(:,:, 217) = rate(:,:, 217) * inv(:,:, 1) + rate(:,:, 225) = rate(:,:, 225) * inv(:,:, 1) + rate(:,:, 228) = rate(:,:, 228) * inv(:,:, 1) + rate(:,:, 229) = rate(:,:, 229) * inv(:,:, 1) + rate(:,:, 230) = rate(:,:, 230) * inv(:,:, 1) + rate(:,:, 232) = rate(:,:, 232) * inv(:,:, 1) + rate(:,:, 233) = rate(:,:, 233) * inv(:,:, 1) + rate(:,:, 248) = rate(:,:, 248) * inv(:,:, 1) + rate(:,:, 268) = rate(:,:, 268) * inv(:,:, 1) + rate(:,:, 269) = rate(:,:, 269) * inv(:,:, 1) + rate(:,:, 279) = rate(:,:, 279) * inv(:,:, 1) + rate(:,:, 325) = rate(:,:, 325) * inv(:,:, 1) + rate(:,:, 335) = rate(:,:, 335) * inv(:,:, 1) + rate(:,:, 336) = rate(:,:, 336) * inv(:,:, 1) + rate(:,:, 337) = rate(:,:, 337) * inv(:,:, 1) + rate(:,:, 363) = rate(:,:, 363) * inv(:,:, 1) + rate(:,:, 364) = rate(:,:, 364) * inv(:,:, 1) + rate(:,:, 365) = rate(:,:, 365) * inv(:,:, 1) + rate(:,:, 385) = rate(:,:, 385) * inv(:,:, 1) + rate(:,:, 411) = rate(:,:, 411) * inv(:,:, 1) + rate(:,:, 414) = rate(:,:, 414) * inv(:,:, 1) + rate(:,:, 415) = rate(:,:, 415) * inv(:,:, 1) + rate(:,:, 472) = rate(:,:, 472) * inv(:,:, 1) + rate(:,:, 475) = rate(:,:, 475) * inv(:,:, 1) + rate(:,:, 478) = rate(:,:, 478) * inv(:,:, 1) + rate(:,:, 485) = rate(:,:, 485) * inv(:,:, 1) + rate(:,:, 490) = rate(:,:, 490) * inv(:,:, 1) + rate(:,:, 527) = rate(:,:, 527) * inv(:,:, 1) + rate(:,:, 613) = rate(:,:, 613) * inv(:,:, 2) + rate(:,:, 616) = rate(:,:, 616) * inv(:,:, 2) + rate(:,:, 173) = rate(:,:, 173) * m(:,:) + rate(:,:, 174) = rate(:,:, 174) * m(:,:) + rate(:,:, 176) = rate(:,:, 176) * m(:,:) + rate(:,:, 177) = rate(:,:, 177) * m(:,:) + rate(:,:, 178) = rate(:,:, 178) * m(:,:) + rate(:,:, 180) = rate(:,:, 180) * m(:,:) + rate(:,:, 181) = rate(:,:, 181) * m(:,:) + rate(:,:, 182) = rate(:,:, 182) * 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(:,:, 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(:,:, 245) = rate(:,:, 245) * m(:,:) + rate(:,:, 246) = rate(:,:, 246) * 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(:,:, 252) = rate(:,:, 252) * 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(:,:, 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(:,:, 292) = rate(:,:, 292) * 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(:,:, 322) = rate(:,:, 322) * 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(:,:, 329) = rate(:,:, 329) * 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(:,:, 336) = rate(:,:, 336) * m(:,:) + rate(:,:, 337) = rate(:,:, 337) * m(:,:) + rate(:,:, 338) = rate(:,:, 338) * m(:,:) + rate(:,:, 339) = rate(:,:, 339) * m(:,:) + rate(:,:, 340) = rate(:,:, 340) * m(:,:) + rate(:,:, 341) = rate(:,:, 341) * m(:,:) + rate(:,:, 342) = rate(:,:, 342) * m(:,:) + rate(:,:, 343) = rate(:,:, 343) * m(:,:) + rate(:,:, 344) = rate(:,:, 344) * m(:,:) + rate(:,:, 345) = rate(:,:, 345) * m(:,:) + rate(:,:, 346) = rate(:,:, 346) * m(:,:) + rate(:,:, 347) = rate(:,:, 347) * m(:,:) + rate(:,:, 348) = rate(:,:, 348) * m(:,:) + rate(:,:, 349) = rate(:,:, 349) * m(:,:) + rate(:,:, 350) = rate(:,:, 350) * m(:,:) + rate(:,:, 351) = rate(:,:, 351) * m(:,:) + rate(:,:, 352) = rate(:,:, 352) * m(:,:) + rate(:,:, 353) = rate(:,:, 353) * m(:,:) + rate(:,:, 354) = rate(:,:, 354) * m(:,:) + rate(:,:, 355) = rate(:,:, 355) * m(:,:) + rate(:,:, 356) = rate(:,:, 356) * m(:,:) + rate(:,:, 357) = rate(:,:, 357) * m(:,:) + rate(:,:, 359) = rate(:,:, 359) * m(:,:) + rate(:,:, 360) = rate(:,:, 360) * m(:,:) + rate(:,:, 361) = rate(:,:, 361) * m(:,:) + rate(:,:, 362) = rate(:,:, 362) * m(:,:) + rate(:,:, 363) = rate(:,:, 363) * m(:,:) + rate(:,:, 364) = rate(:,:, 364) * m(:,:) + rate(:,:, 366) = rate(:,:, 366) * m(:,:) + rate(:,:, 367) = rate(:,:, 367) * m(:,:) + rate(:,:, 368) = rate(:,:, 368) * m(:,:) + rate(:,:, 369) = rate(:,:, 369) * m(:,:) + rate(:,:, 370) = rate(:,:, 370) * m(:,:) + rate(:,:, 371) = rate(:,:, 371) * m(:,:) + rate(:,:, 372) = rate(:,:, 372) * m(:,:) + rate(:,:, 373) = rate(:,:, 373) * m(:,:) + rate(:,:, 374) = rate(:,:, 374) * m(:,:) + rate(:,:, 375) = rate(:,:, 375) * m(:,:) + rate(:,:, 376) = rate(:,:, 376) * m(:,:) + rate(:,:, 377) = rate(:,:, 377) * m(:,:) + rate(:,:, 378) = rate(:,:, 378) * m(:,:) + rate(:,:, 379) = rate(:,:, 379) * m(:,:) + rate(:,:, 380) = rate(:,:, 380) * m(:,:) + rate(:,:, 381) = rate(:,:, 381) * m(:,:) + rate(:,:, 382) = rate(:,:, 382) * m(:,:) + rate(:,:, 383) = rate(:,:, 383) * m(:,:) + rate(:,:, 384) = rate(:,:, 384) * m(:,:) + rate(:,:, 385) = rate(:,:, 385) * m(:,:) + rate(:,:, 386) = rate(:,:, 386) * m(:,:) + rate(:,:, 387) = rate(:,:, 387) * m(:,:) + rate(:,:, 388) = rate(:,:, 388) * m(:,:) + rate(:,:, 389) = rate(:,:, 389) * m(:,:) + rate(:,:, 390) = rate(:,:, 390) * m(:,:) + rate(:,:, 391) = rate(:,:, 391) * m(:,:) + rate(:,:, 392) = rate(:,:, 392) * m(:,:) + rate(:,:, 393) = rate(:,:, 393) * m(:,:) + rate(:,:, 394) = rate(:,:, 394) * m(:,:) + rate(:,:, 395) = rate(:,:, 395) * m(:,:) + rate(:,:, 396) = rate(:,:, 396) * m(:,:) + rate(:,:, 397) = rate(:,:, 397) * m(:,:) + rate(:,:, 398) = rate(:,:, 398) * m(:,:) + rate(:,:, 399) = rate(:,:, 399) * m(:,:) + rate(:,:, 400) = rate(:,:, 400) * m(:,:) + rate(:,:, 401) = rate(:,:, 401) * m(:,:) + rate(:,:, 402) = rate(:,:, 402) * m(:,:) + rate(:,:, 403) = rate(:,:, 403) * m(:,:) + rate(:,:, 404) = rate(:,:, 404) * m(:,:) + rate(:,:, 405) = rate(:,:, 405) * m(:,:) + rate(:,:, 406) = rate(:,:, 406) * m(:,:) + rate(:,:, 407) = rate(:,:, 407) * m(:,:) + rate(:,:, 408) = rate(:,:, 408) * m(:,:) + rate(:,:, 409) = rate(:,:, 409) * m(:,:) + rate(:,:, 410) = rate(:,:, 410) * m(:,:) + rate(:,:, 411) = rate(:,:, 411) * m(:,:) + rate(:,:, 412) = rate(:,:, 412) * m(:,:) + rate(:,:, 413) = rate(:,:, 413) * m(:,:) + rate(:,:, 414) = rate(:,:, 414) * m(:,:) + rate(:,:, 416) = rate(:,:, 416) * m(:,:) + rate(:,:, 417) = rate(:,:, 417) * m(:,:) + rate(:,:, 418) = rate(:,:, 418) * m(:,:) + rate(:,:, 419) = rate(:,:, 419) * m(:,:) + rate(:,:, 420) = rate(:,:, 420) * m(:,:) + rate(:,:, 421) = rate(:,:, 421) * m(:,:) + rate(:,:, 422) = rate(:,:, 422) * m(:,:) + rate(:,:, 423) = rate(:,:, 423) * m(:,:) + rate(:,:, 424) = rate(:,:, 424) * m(:,:) + rate(:,:, 425) = rate(:,:, 425) * m(:,:) + rate(:,:, 426) = rate(:,:, 426) * m(:,:) + rate(:,:, 427) = rate(:,:, 427) * m(:,:) + rate(:,:, 428) = rate(:,:, 428) * m(:,:) + rate(:,:, 429) = rate(:,:, 429) * m(:,:) + rate(:,:, 430) = rate(:,:, 430) * m(:,:) + rate(:,:, 431) = rate(:,:, 431) * m(:,:) + rate(:,:, 432) = rate(:,:, 432) * m(:,:) + rate(:,:, 434) = rate(:,:, 434) * m(:,:) + rate(:,:, 435) = rate(:,:, 435) * m(:,:) + rate(:,:, 436) = rate(:,:, 436) * m(:,:) + rate(:,:, 437) = rate(:,:, 437) * m(:,:) + rate(:,:, 438) = rate(:,:, 438) * m(:,:) + rate(:,:, 439) = rate(:,:, 439) * m(:,:) + rate(:,:, 440) = rate(:,:, 440) * m(:,:) + rate(:,:, 441) = rate(:,:, 441) * m(:,:) + rate(:,:, 442) = rate(:,:, 442) * m(:,:) + rate(:,:, 443) = rate(:,:, 443) * m(:,:) + rate(:,:, 444) = rate(:,:, 444) * m(:,:) + rate(:,:, 445) = rate(:,:, 445) * m(:,:) + rate(:,:, 446) = rate(:,:, 446) * m(:,:) + rate(:,:, 447) = rate(:,:, 447) * m(:,:) + rate(:,:, 448) = rate(:,:, 448) * m(:,:) + rate(:,:, 449) = rate(:,:, 449) * m(:,:) + rate(:,:, 450) = rate(:,:, 450) * m(:,:) + rate(:,:, 451) = rate(:,:, 451) * m(:,:) + rate(:,:, 452) = rate(:,:, 452) * m(:,:) + rate(:,:, 453) = rate(:,:, 453) * m(:,:) + rate(:,:, 454) = rate(:,:, 454) * m(:,:) + rate(:,:, 455) = rate(:,:, 455) * m(:,:) + rate(:,:, 456) = rate(:,:, 456) * m(:,:) + rate(:,:, 457) = rate(:,:, 457) * m(:,:) + rate(:,:, 458) = rate(:,:, 458) * m(:,:) + rate(:,:, 459) = rate(:,:, 459) * m(:,:) + rate(:,:, 460) = rate(:,:, 460) * m(:,:) + rate(:,:, 461) = rate(:,:, 461) * m(:,:) + rate(:,:, 462) = rate(:,:, 462) * m(:,:) + rate(:,:, 463) = rate(:,:, 463) * m(:,:) + rate(:,:, 464) = rate(:,:, 464) * m(:,:) + rate(:,:, 465) = rate(:,:, 465) * m(:,:) + rate(:,:, 466) = rate(:,:, 466) * m(:,:) + rate(:,:, 467) = rate(:,:, 467) * m(:,:) + rate(:,:, 468) = rate(:,:, 468) * m(:,:) + rate(:,:, 469) = rate(:,:, 469) * m(:,:) + rate(:,:, 470) = rate(:,:, 470) * m(:,:) + rate(:,:, 471) = rate(:,:, 471) * m(:,:) + rate(:,:, 472) = rate(:,:, 472) * m(:,:) + rate(:,:, 473) = rate(:,:, 473) * m(:,:) + rate(:,:, 474) = rate(:,:, 474) * m(:,:) + rate(:,:, 475) = rate(:,:, 475) * m(:,:) + rate(:,:, 476) = rate(:,:, 476) * m(:,:) + rate(:,:, 477) = rate(:,:, 477) * m(:,:) + rate(:,:, 478) = rate(:,:, 478) * m(:,:) + rate(:,:, 479) = rate(:,:, 479) * m(:,:) + rate(:,:, 480) = rate(:,:, 480) * m(:,:) + rate(:,:, 481) = rate(:,:, 481) * m(:,:) + rate(:,:, 482) = rate(:,:, 482) * m(:,:) + rate(:,:, 483) = rate(:,:, 483) * m(:,:) + rate(:,:, 484) = rate(:,:, 484) * m(:,:) + rate(:,:, 485) = rate(:,:, 485) * m(:,:) + rate(:,:, 486) = rate(:,:, 486) * m(:,:) + rate(:,:, 487) = rate(:,:, 487) * m(:,:) + rate(:,:, 488) = rate(:,:, 488) * m(:,:) + rate(:,:, 489) = rate(:,:, 489) * m(:,:) + rate(:,:, 491) = rate(:,:, 491) * m(:,:) + rate(:,:, 492) = rate(:,:, 492) * m(:,:) + rate(:,:, 493) = rate(:,:, 493) * m(:,:) + rate(:,:, 494) = rate(:,:, 494) * m(:,:) + rate(:,:, 495) = rate(:,:, 495) * m(:,:) + rate(:,:, 496) = rate(:,:, 496) * m(:,:) + rate(:,:, 497) = rate(:,:, 497) * m(:,:) + rate(:,:, 498) = rate(:,:, 498) * m(:,:) + rate(:,:, 499) = rate(:,:, 499) * m(:,:) + rate(:,:, 500) = rate(:,:, 500) * m(:,:) + rate(:,:, 501) = rate(:,:, 501) * m(:,:) + rate(:,:, 502) = rate(:,:, 502) * m(:,:) + rate(:,:, 503) = rate(:,:, 503) * m(:,:) + rate(:,:, 504) = rate(:,:, 504) * m(:,:) + rate(:,:, 505) = rate(:,:, 505) * m(:,:) + rate(:,:, 506) = rate(:,:, 506) * m(:,:) + rate(:,:, 507) = rate(:,:, 507) * m(:,:) + rate(:,:, 508) = rate(:,:, 508) * m(:,:) + rate(:,:, 509) = rate(:,:, 509) * m(:,:) + rate(:,:, 510) = rate(:,:, 510) * m(:,:) + rate(:,:, 511) = rate(:,:, 511) * m(:,:) + rate(:,:, 512) = rate(:,:, 512) * m(:,:) + rate(:,:, 513) = rate(:,:, 513) * m(:,:) + rate(:,:, 514) = rate(:,:, 514) * m(:,:) + rate(:,:, 515) = rate(:,:, 515) * m(:,:) + rate(:,:, 516) = rate(:,:, 516) * m(:,:) + rate(:,:, 517) = rate(:,:, 517) * m(:,:) + rate(:,:, 518) = rate(:,:, 518) * m(:,:) + rate(:,:, 519) = rate(:,:, 519) * m(:,:) + rate(:,:, 520) = rate(:,:, 520) * m(:,:) + rate(:,:, 521) = rate(:,:, 521) * m(:,:) + rate(:,:, 522) = rate(:,:, 522) * m(:,:) + rate(:,:, 523) = rate(:,:, 523) * m(:,:) + rate(:,:, 524) = rate(:,:, 524) * m(:,:) + rate(:,:, 525) = rate(:,:, 525) * m(:,:) + rate(:,:, 526) = rate(:,:, 526) * m(:,:) + rate(:,:, 527) = rate(:,:, 527) * m(:,:) + rate(:,:, 528) = rate(:,:, 528) * m(:,:) + rate(:,:, 529) = rate(:,:, 529) * m(:,:) + rate(:,:, 530) = rate(:,:, 530) * m(:,:) + rate(:,:, 531) = rate(:,:, 531) * m(:,:) + rate(:,:, 532) = rate(:,:, 532) * m(:,:) + rate(:,:, 533) = rate(:,:, 533) * m(:,:) + rate(:,:, 534) = rate(:,:, 534) * m(:,:) + rate(:,:, 535) = rate(:,:, 535) * m(:,:) + rate(:,:, 536) = rate(:,:, 536) * m(:,:) + rate(:,:, 537) = rate(:,:, 537) * m(:,:) + rate(:,:, 538) = rate(:,:, 538) * m(:,:) + rate(:,:, 539) = rate(:,:, 539) * m(:,:) + rate(:,:, 553) = rate(:,:, 553) * m(:,:) + rate(:,:, 554) = rate(:,:, 554) * m(:,:) + rate(:,:, 555) = rate(:,:, 555) * m(:,:) + rate(:,:, 556) = rate(:,:, 556) * m(:,:) + rate(:,:, 557) = rate(:,:, 557) * m(:,:) + rate(:,:, 558) = rate(:,:, 558) * m(:,:) + rate(:,:, 559) = rate(:,:, 559) * m(:,:) + rate(:,:, 560) = rate(:,:, 560) * m(:,:) + rate(:,:, 561) = rate(:,:, 561) * m(:,:) + rate(:,:, 562) = rate(:,:, 562) * m(:,:) + rate(:,:, 563) = rate(:,:, 563) * m(:,:) + rate(:,:, 564) = rate(:,:, 564) * m(:,:) + rate(:,:, 565) = rate(:,:, 565) * m(:,:) + rate(:,:, 566) = rate(:,:, 566) * m(:,:) + rate(:,:, 567) = rate(:,:, 567) * m(:,:) + rate(:,:, 568) = rate(:,:, 568) * m(:,:) + rate(:,:, 569) = rate(:,:, 569) * m(:,:) + rate(:,:, 570) = rate(:,:, 570) * m(:,:) + rate(:,:, 571) = rate(:,:, 571) * m(:,:) + rate(:,:, 572) = rate(:,:, 572) * m(:,:) + rate(:,:, 573) = rate(:,:, 573) * m(:,:) + rate(:,:, 574) = rate(:,:, 574) * m(:,:) + rate(:,:, 575) = rate(:,:, 575) * m(:,:) + rate(:,:, 576) = rate(:,:, 576) * m(:,:) + rate(:,:, 577) = rate(:,:, 577) * m(:,:) + rate(:,:, 578) = rate(:,:, 578) * m(:,:) + rate(:,:, 579) = rate(:,:, 579) * m(:,:) + rate(:,:, 580) = rate(:,:, 580) * m(:,:) + rate(:,:, 581) = rate(:,:, 581) * m(:,:) + rate(:,:, 583) = rate(:,:, 583) * m(:,:) + rate(:,:, 584) = rate(:,:, 584) * m(:,:) + rate(:,:, 585) = rate(:,:, 585) * m(:,:) + rate(:,:, 587) = rate(:,:, 587) * m(:,:) + rate(:,:, 592) = rate(:,:, 592) * m(:,:) + rate(:,:, 593) = rate(:,:, 593) * m(:,:) + rate(:,:, 594) = rate(:,:, 594) * m(:,:) + rate(:,:, 597) = rate(:,:, 597) * m(:,:) + rate(:,:, 598) = rate(:,:, 598) * m(:,:) + rate(:,:, 599) = rate(:,:, 599) * m(:,:) + rate(:,:, 602) = rate(:,:, 602) * m(:,:) + rate(:,:, 603) = rate(:,:, 603) * m(:,:) + rate(:,:, 604) = rate(:,:, 604) * m(:,:) + rate(:,:, 605) = rate(:,:, 605) * m(:,:) + rate(:,:, 606) = rate(:,:, 606) * m(:,:) + rate(:,:, 607) = rate(:,:, 607) * m(:,:) + rate(:,:, 608) = rate(:,:, 608) * m(:,:) + rate(:,:, 609) = rate(:,:, 609) * m(:,:) + rate(:,:, 610) = rate(:,:, 610) * m(:,:) + rate(:,:, 611) = rate(:,:, 611) * m(:,:) + rate(:,:, 612) = rate(:,:, 612) * m(:,:) + rate(:,:, 614) = rate(:,:, 614) * m(:,:) + rate(:,:, 615) = rate(:,:, 615) * m(:,:) + rate(:,:, 617) = rate(:,:, 617) * m(:,:) + end subroutine adjrxt + end module mo_adjrxt diff --git a/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_exp_sol.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_exp_sol.F90 new file mode 100644 index 0000000000..c1cde93fa7 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/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_waccm_tsmlt_mam5_vbsext/mo_imp_sol.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_imp_sol.F90 new file mode 100644 index 0000000000..98cadb9050 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/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_waccm_tsmlt_mam5_vbsext/mo_indprd.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_indprd.F90 new file mode 100644 index 0000000000..56b1dfd5ba --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_indprd.F90 @@ -0,0 +1,311 @@ + 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(:,539)*y(:,265)*y(:,127) +rxt(:,547)*y(:,128) + prod(:,2) = (rxt(:,472)*y(:,242) +rxt(:,475)*y(:,252) +rxt(:,478)*y(:,254) + & + rxt(:,482)*y(:,150))*y(:,132) +.500_r8*rxt(:,411)*y(:,265)*y(:,115) & + +.200_r8*rxt(:,507)*y(:,260)*y(:,131) +.500_r8*rxt(:,519)*y(:,220) & + *y(:,133) +!-------------------------------------------------------------------- +! ... "independent" production for Implicit species +!-------------------------------------------------------------------- + else if( class == 4 ) then + prod(:,191) = 0._r8 + prod(:,192) = 0._r8 + prod(:,1) = + extfrc(:,25) + prod(:,2) = + extfrc(:,19) + prod(:,3) = + extfrc(:,2) + prod(:,225) = 0._r8 + prod(:,75) = 0._r8 + prod(:,107) = 0._r8 + prod(:,81) = 0._r8 + prod(:,155) = 0._r8 + prod(:,108) = 0._r8 + prod(:,158) = 0._r8 + prod(:,164) = 0._r8 + prod(:,134) = 0._r8 + prod(:,188) = 0._r8 + prod(:,144) = 0._r8 + prod(:,120) = 0._r8 + prod(:,149) = 0._r8 + prod(:,256) = 0._r8 + prod(:,121) = 0._r8 + prod(:,258) = 0._r8 + prod(:,179) = 0._r8 + prod(:,4) = 0._r8 + prod(:,123) = 0._r8 + prod(:,142) = 0._r8 + prod(:,133) = 0._r8 + prod(:,181) = 0._r8 + prod(:,130) = 0._r8 + prod(:,143) = 0._r8 + prod(:,135) = 0._r8 + prod(:,234) = 0._r8 + prod(:,153) = 0._r8 + prod(:,136) = 0._r8 + prod(:,131) = 0._r8 + prod(:,90) = 0._r8 + prod(:,102) = 0._r8 + prod(:,103) = 0._r8 + prod(:,93) = 0._r8 + prod(:,104) = 0._r8 + prod(:,94) = 0._r8 + prod(:,105) = 0._r8 + prod(:,95) = 0._r8 + prod(:,166) = 0._r8 + prod(:,273) = 0._r8 + prod(:,182) = 0._r8 + prod(:,96) = 0._r8 + prod(:,235) = 0._r8 + prod(:,148) = 0._r8 + prod(:,91) = 0._r8 + prod(:,230) = 0._r8 + prod(:,245) = 0._r8 + prod(:,196) = 0._r8 + prod(:,183) = 0._r8 + prod(:,207) = 0._r8 + prod(:,156) = 0._r8 + prod(:,265) = 0._r8 + prod(:,157) = 0._r8 + prod(:,267) = 0._r8 + prod(:,106) = 0._r8 + prod(:,92) = 0._r8 + prod(:,259) = 0._r8 + prod(:,223) = 0._r8 + prod(:,5) = 0._r8 + prod(:,236) = + extfrc(:,1) + prod(:,252) = 0._r8 + prod(:,119) = 0._r8 + prod(:,126) = 0._r8 + prod(:,113) = 0._r8 + prod(:,138) = 0._r8 + prod(:,6) = 0._r8 + prod(:,7) = 0._r8 + prod(:,8) = 0._r8 + prod(:,9) = 0._r8 + prod(:,100) = 0._r8 + prod(:,219) = 0._r8 + prod(:,237) = 0._r8 + prod(:,227) = 0._r8 + prod(:,268) = 0._r8 + prod(:,253) = 0._r8 + prod(:,97) = 0._r8 + prod(:,184) = 0._r8 + prod(:,99) = 0._r8 + prod(:,210) = 0._r8 + prod(:,125) = 0._r8 + prod(:,127) = 0._r8 + prod(:,139) = 0._r8 + prod(:,255) = 0._r8 + prod(:,116) = 0._r8 + prod(:,216) = 0._r8 + prod(:,137) = 0._r8 + prod(:,269) = 0._r8 + prod(:,167) = 0._r8 + prod(:,205) = 0._r8 + prod(:,209) = 0._r8 + prod(:,239) = 0._r8 + prod(:,124) = 0._r8 + prod(:,240) = 0._r8 + prod(:,147) = 0._r8 + prod(:,98) = 0._r8 + prod(:,214) = 0._r8 + prod(:,185) = 0._r8 + prod(:,178) = 0._r8 + prod(:,243) = 0._r8 + prod(:,154) = 0._r8 + prod(:,73) = 0._r8 + prod(:,197) = 0._r8 + prod(:,67) = 0._r8 + prod(:,66) = 0._r8 + prod(:,83) = 0._r8 + prod(:,82) = 0._r8 + prod(:,244) = 0._r8 + prod(:,146) = 0._r8 + prod(:,173) = 0._r8 + prod(:,145) = 0._r8 + prod(:,187) = 0._r8 + prod(:,222) = 0._r8 + prod(:,74) = 0._r8 + prod(:,249) = 0._r8 + prod(:,224) = (.800_r8*rxt(:,112) +rxt(:,115) +rxt(:,116) + & + .800_r8*rxt(:,118)) + extfrc(:,21) + prod(:,128) = 0._r8 + prod(:,132) = 0._r8 + prod(:,162) = 0._r8 + prod(:,231) = 0._r8 + prod(:,10) = 0._r8 + prod(:,11) = 0._r8 + prod(:,12) = 0._r8 + prod(:,89) = 0._r8 + prod(:,13) = 0._r8 + prod(:,14) = 0._r8 + prod(:,15) = 0._r8 + prod(:,261) = + extfrc(:,11) + prod(:,260) = + extfrc(:,12) + prod(:,264) = 0._r8 + prod(:,215) = 0._r8 + prod(:,152) = 0._r8 + prod(:,16) = + extfrc(:,3) + prod(:,17) = + extfrc(:,4) + prod(:,18) = 0._r8 + prod(:,19) = + extfrc(:,5) + prod(:,20) = + extfrc(:,6) + prod(:,272) = 0._r8 + prod(:,257) = 0._r8 + prod(:,271) = 0._r8 + prod(:,21) = 0._r8 + prod(:,140) = 0._r8 + prod(:,150) = 0._r8 + prod(:,122) = 0._r8 + prod(:,176) = 0._r8 + prod(:,101) = 0._r8 + prod(:,169) = 0._r8 + prod(:,109) = 0._r8 + prod(:,141) = 0._r8 + prod(:,22) = + extfrc(:,7) + prod(:,23) = + extfrc(:,8) + prod(:,24) = + extfrc(:,9) + prod(:,25) = + extfrc(:,10) + prod(:,177) = 0._r8 + prod(:,151) = 0._r8 + prod(:,199) = 0._r8 + prod(:,26) = 0._r8 + prod(:,254) = 0._r8 + prod(:,221) = + extfrc(:,13) + prod(:,129) = 0._r8 + prod(:,27) = + extfrc(:,16) + prod(:,28) = + extfrc(:,17) + prod(:,29) = 0._r8 + prod(:,30) = + extfrc(:,18) + prod(:,31) = 0._r8 + prod(:,32) = 0._r8 + prod(:,33) = 0._r8 + prod(:,34) = 0._r8 + prod(:,35) = 0._r8 + prod(:,36) = 0._r8 + prod(:,37) = 0._r8 + prod(:,38) = 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(:,45) = 0._r8 + prod(:,46) = 0._r8 + prod(:,47) = 0._r8 + prod(:,48) = 0._r8 + prod(:,49) = 0._r8 + prod(:,50) = 0._r8 + prod(:,51) = 0._r8 + prod(:,52) = 0._r8 + prod(:,53) = 0._r8 + prod(:,54) = 0._r8 + prod(:,55) = 0._r8 + prod(:,56) = 0._r8 + prod(:,57) = 0._r8 + prod(:,58) = 0._r8 + prod(:,59) = 0._r8 + prod(:,60) = 0._r8 + prod(:,61) = 0._r8 + prod(:,62) = 0._r8 + prod(:,63) = 0._r8 + prod(:,64) = 0._r8 + prod(:,65) = 0._r8 + prod(:,68) = 0._r8 + prod(:,69) = 0._r8 + prod(:,70) = 0._r8 + prod(:,71) = 0._r8 + prod(:,72) = 0._r8 + prod(:,76) = 0._r8 + prod(:,77) = 0._r8 + prod(:,78) = 0._r8 + prod(:,79) = 0._r8 + prod(:,80) = 0._r8 + prod(:,84) = 0._r8 + prod(:,85) = + extfrc(:,14) + prod(:,86) = + extfrc(:,15) + prod(:,114) = 0._r8 + prod(:,194) = 0._r8 + prod(:,189) = 0._r8 + prod(:,168) = 0._r8 + prod(:,229) = 0._r8 + prod(:,233) = 0._r8 + prod(:,186) = 0._r8 + prod(:,112) = 0._r8 + prod(:,87) = 0._r8 + prod(:,115) = 0._r8 + prod(:,117) = 0._r8 + prod(:,198) = 0._r8 + prod(:,88) = 0._r8 + prod(:,118) = 0._r8 + prod(:,159) = 0._r8 + prod(:,174) = 0._r8 + prod(:,226) = 0._r8 + prod(:,170) = 0._r8 + prod(:,160) = 0._r8 + prod(:,217) = 0._r8 + prod(:,220) = 0._r8 + prod(:,190) = 0._r8 + prod(:,251) = 0._r8 + prod(:,270) = 0._r8 + prod(:,203) = 0._r8 + prod(:,213) = (rxt(:,113) +rxt(:,114) +rxt(:,115) +rxt(:,116) +rxt(:,117) + & + rxt(:,119)) + extfrc(:,20) + prod(:,180) = 0._r8 + prod(:,165) = 0._r8 + prod(:,204) = 0._r8 + prod(:,266) = 0._r8 + prod(:,161) = 0._r8 + prod(:,246) = 0._r8 + prod(:,247) = 0._r8 + prod(:,248) = 0._r8 + prod(:,200) = 0._r8 + prod(:,250) = 0._r8 + prod(:,218) = 0._r8 + prod(:,193) = 0._r8 + prod(:,175) = (1.200_r8*rxt(:,112) +rxt(:,113) +rxt(:,117) + & + 1.200_r8*rxt(:,118)) + extfrc(:,22) + prod(:,195) = (rxt(:,114) +rxt(:,119)) + extfrc(:,26) + prod(:,211) = 0._r8 + prod(:,171) = (rxt(:,113) +rxt(:,115) +rxt(:,116) +rxt(:,117)) + extfrc(:,27) + prod(:,232) = 0._r8 + prod(:,262) = 0._r8 + prod(:,110) = 0._r8 + prod(:,111) = 0._r8 + prod(:,212) = 0._r8 + prod(:,263) = + extfrc(:,23) + prod(:,206) = + extfrc(:,24) + prod(:,163) = 0._r8 + prod(:,208) = 0._r8 + prod(:,241) = 0._r8 + prod(:,238) = 0._r8 + prod(:,228) = 0._r8 + prod(:,201) = 0._r8 + prod(:,242) = 0._r8 + prod(:,202) = 0._r8 + prod(:,172) = 0._r8 + prod(:,274) = 0._r8 + end if + end subroutine indprd + end module mo_indprd diff --git a/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_lin_matrix.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_lin_matrix.F90 new file mode 100644 index 0000000000..68d9462d99 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_lin_matrix.F90 @@ -0,0 +1,745 @@ + 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,699) = -( rxt(k,20) + het_rates(k,1) ) + mat(k,710) = -( rxt(k,21) + het_rates(k,2) ) + mat(k,1) = -( het_rates(k,3) ) + mat(k,2) = -( het_rates(k,4) ) + mat(k,3) = -( het_rates(k,5) ) + mat(k,1062) = -( het_rates(k,6) ) + mat(k,96) = -( het_rates(k,7) ) + mat(k,208) = -( het_rates(k,8) ) + mat(k,107) = -( het_rates(k,9) ) + mat(k,449) = -( rxt(k,22) + het_rates(k,10) ) + mat(k,214) = -( rxt(k,23) + het_rates(k,11) ) + mat(k,467) = -( rxt(k,24) + het_rates(k,12) ) + mat(k,506) = -( rxt(k,25) + het_rates(k,13) ) + mat(k,450) = .500_r8*rxt(k,22) + mat(k,215) = rxt(k,23) + mat(k,661) = .200_r8*rxt(k,71) + mat(k,764) = .060_r8*rxt(k,73) + mat(k,331) = -( rxt(k,26) + het_rates(k,14) ) + mat(k,660) = .200_r8*rxt(k,71) + mat(k,762) = .200_r8*rxt(k,73) + mat(k,680) = -( rxt(k,27) + het_rates(k,15) ) + mat(k,283) = rxt(k,47) + mat(k,1130) = rxt(k,57) + mat(k,663) = .200_r8*rxt(k,71) + mat(k,765) = .150_r8*rxt(k,73) + mat(k,383) = -( rxt(k,28) + het_rates(k,16) ) + mat(k,763) = .210_r8*rxt(k,73) + mat(k,270) = -( het_rates(k,17) ) + mat(k,409) = -( het_rates(k,18) ) + mat(k,1555) = -( het_rates(k,19) ) + mat(k,274) = rxt(k,75) + mat(k,1607) = rxt(k,76) + mat(k,606) = rxt(k,78) + mat(k,187) = rxt(k,80) + mat(k,193) = rxt(k,81) + mat(k,516) = 2.000_r8*rxt(k,87) + mat(k,630) = rxt(k,88) + mat(k,463) = 3.000_r8*rxt(k,91) + mat(k,171) = 2.000_r8*rxt(k,99) + mat(k,881) = rxt(k,100) + mat(k,843) = rxt(k,106) + mat(k,273) = -( rxt(k,75) + het_rates(k,20) ) + mat(k,1609) = -( rxt(k,76) + het_rates(k,21) ) + mat(k,607) = rxt(k,77) + mat(k,604) = -( rxt(k,77) + rxt(k,78) + rxt(k,588) + rxt(k,591) + rxt(k,596) & + + het_rates(k,22) ) + mat(k,4) = -( het_rates(k,23) ) + mat(k,279) = -( het_rates(k,24) ) + mat(k,372) = rxt(k,29) + mat(k,373) = -( rxt(k,29) + het_rates(k,25) ) + mat(k,325) = -( het_rates(k,26) ) + mat(k,620) = -( het_rates(k,27) ) + mat(k,311) = -( het_rates(k,28) ) + mat(k,378) = -( rxt(k,30) + het_rates(k,29) ) + mat(k,334) = -( het_rates(k,30) ) + mat(k,1177) = -( het_rates(k,31) ) + mat(k,1414) = .700_r8*rxt(k,56) + mat(k,437) = -( rxt(k,31) + het_rates(k,32) ) + mat(k,340) = -( het_rates(k,33) ) + mat(k,315) = -( rxt(k,32) + het_rates(k,34) ) + mat(k,144) = -( rxt(k,79) + het_rates(k,35) ) + mat(k,185) = -( rxt(k,80) + het_rates(k,36) ) + mat(k,190) = -( rxt(k,81) + het_rates(k,37) ) + mat(k,153) = -( rxt(k,82) + het_rates(k,38) ) + mat(k,195) = -( rxt(k,83) + het_rates(k,39) ) + mat(k,157) = -( rxt(k,84) + het_rates(k,40) ) + mat(k,200) = -( rxt(k,85) + het_rates(k,41) ) + mat(k,161) = -( rxt(k,86) + het_rates(k,42) ) + mat(k,514) = -( rxt(k,87) + het_rates(k,43) ) + mat(k,2496) = -( rxt(k,33) + rxt(k,34) + het_rates(k,44) ) + mat(k,708) = .100_r8*rxt(k,20) + mat(k,719) = .100_r8*rxt(k,21) + mat(k,459) = rxt(k,39) + mat(k,2101) = .180_r8*rxt(k,40) + mat(k,1214) = rxt(k,44) + mat(k,1250) = .330_r8*rxt(k,46) + mat(k,1257) = rxt(k,48) + mat(k,761) = rxt(k,50) + mat(k,1322) = 1.340_r8*rxt(k,51) + mat(k,941) = rxt(k,58) + mat(k,594) = rxt(k,63) + mat(k,429) = rxt(k,64) + mat(k,737) = .375_r8*rxt(k,66) + mat(k,534) = .400_r8*rxt(k,68) + mat(k,1171) = .680_r8*rxt(k,70) + mat(k,492) = rxt(k,328) + mat(k,513) = 2.000_r8*rxt(k,358) + mat(k,628) = -( rxt(k,88) + het_rates(k,45) ) + mat(k,165) = -( rxt(k,89) + het_rates(k,46) ) + mat(k,1195) = -( rxt(k,35) + het_rates(k,47) ) + mat(k,703) = .400_r8*rxt(k,20) + mat(k,715) = .400_r8*rxt(k,21) + mat(k,380) = rxt(k,30) + mat(k,1236) = .330_r8*rxt(k,46) + mat(k,390) = rxt(k,54) + mat(k,590) = rxt(k,63) + mat(k,401) = -( rxt(k,90) + het_rates(k,48) ) + mat(k,147) = -( het_rates(k,49) ) + mat(k,1124) = -( rxt(k,36) + het_rates(k,50) ) + mat(k,702) = .250_r8*rxt(k,20) + mat(k,714) = .250_r8*rxt(k,21) + mat(k,439) = .820_r8*rxt(k,31) + mat(k,1235) = .170_r8*rxt(k,46) + mat(k,729) = .300_r8*rxt(k,66) + mat(k,531) = .050_r8*rxt(k,68) + mat(k,1162) = .500_r8*rxt(k,70) + mat(k,1325) = -( rxt(k,37) + het_rates(k,51) ) + mat(k,470) = .180_r8*rxt(k,24) + mat(k,385) = rxt(k,28) + mat(k,668) = .400_r8*rxt(k,71) + mat(k,773) = .540_r8*rxt(k,73) + mat(k,476) = .510_r8*rxt(k,74) + mat(k,749) = -( het_rates(k,52) ) + mat(k,637) = -( rxt(k,38) + het_rates(k,53) ) + mat(k,857) = -( het_rates(k,54) ) + mat(k,455) = -( rxt(k,39) + het_rates(k,55) ) + mat(k,2093) = -( rxt(k,40) + rxt(k,41) + het_rates(k,56) ) + mat(k,461) = -( rxt(k,91) + het_rates(k,57) ) + mat(k,2261) = -( het_rates(k,58) ) + mat(k,275) = rxt(k,75) + mat(k,146) = 4.000_r8*rxt(k,79) + mat(k,189) = rxt(k,80) + mat(k,156) = 2.000_r8*rxt(k,82) + mat(k,199) = 2.000_r8*rxt(k,83) + mat(k,160) = 2.000_r8*rxt(k,84) + mat(k,204) = rxt(k,85) + mat(k,164) = 2.000_r8*rxt(k,86) + mat(k,167) = 3.000_r8*rxt(k,89) + mat(k,406) = rxt(k,90) + mat(k,206) = 2.000_r8*rxt(k,92) + mat(k,152) = 2.000_r8*rxt(k,93) + mat(k,1643) = rxt(k,94) + mat(k,1033) = rxt(k,95) + mat(k,295) = rxt(k,98) + mat(k,291) = rxt(k,101) + mat(k,301) = rxt(k,102) + mat(k,360) = rxt(k,103) + mat(k,1547) = rxt(k,104) + mat(k,877) = rxt(k,107) + mat(k,205) = -( rxt(k,92) + het_rates(k,59) ) + mat(k,150) = -( rxt(k,93) + rxt(k,269) + het_rates(k,60) ) + mat(k,1636) = -( rxt(k,94) + het_rates(k,61) ) + mat(k,1029) = rxt(k,96) + mat(k,365) = rxt(k,108) + mat(k,151) = 2.000_r8*rxt(k,269) + mat(k,1027) = -( rxt(k,95) + rxt(k,96) + rxt(k,590) + rxt(k,595) + rxt(k,601) & + + het_rates(k,62) ) + mat(k,5) = -( het_rates(k,63) ) + mat(k,1204) = -( het_rates(k,64) ) + mat(k,216) = 1.500_r8*rxt(k,23) + mat(k,469) = .450_r8*rxt(k,24) + mat(k,682) = .600_r8*rxt(k,27) + mat(k,384) = rxt(k,28) + mat(k,2475) = rxt(k,33) + rxt(k,34) + mat(k,1196) = rxt(k,35) + mat(k,1324) = rxt(k,37) + mat(k,2080) = .380_r8*rxt(k,40) + mat(k,1493) = rxt(k,42) + rxt(k,110) + mat(k,1209) = rxt(k,44) + mat(k,1099) = 2.000_r8*rxt(k,45) + mat(k,1237) = .330_r8*rxt(k,46) + mat(k,1312) = 1.340_r8*rxt(k,52) + mat(k,1416) = .700_r8*rxt(k,56) + mat(k,242) = 1.500_r8*rxt(k,65) + mat(k,731) = .250_r8*rxt(k,66) + mat(k,1119) = rxt(k,69) + mat(k,1164) = 1.700_r8*rxt(k,70) + mat(k,420) = rxt(k,137) + mat(k,1494) = -( rxt(k,42) + rxt(k,110) + het_rates(k,65) ) + mat(k,639) = rxt(k,38) + mat(k,2081) = .440_r8*rxt(k,40) + mat(k,582) = .400_r8*rxt(k,61) + mat(k,734) = rxt(k,66) + mat(k,1167) = .800_r8*rxt(k,70) + mat(k,267) = -( rxt(k,97) + het_rates(k,66) ) + mat(k,186) = rxt(k,80) + mat(k,191) = rxt(k,81) + mat(k,196) = rxt(k,83) + mat(k,158) = 2.000_r8*rxt(k,84) + mat(k,201) = 2.000_r8*rxt(k,85) + mat(k,162) = rxt(k,86) + mat(k,170) = 2.000_r8*rxt(k,99) + mat(k,296) = rxt(k,102) + mat(k,355) = rxt(k,103) + mat(k,292) = -( rxt(k,98) + het_rates(k,67) ) + mat(k,154) = rxt(k,82) + mat(k,197) = rxt(k,83) + mat(k,288) = rxt(k,101) + mat(k,236) = -( het_rates(k,68) ) + mat(k,349) = -( het_rates(k,69) ) + mat(k,6) = -( het_rates(k,70) ) + mat(k,7) = -( het_rates(k,71) ) + mat(k,8) = -( het_rates(k,72) ) + mat(k,9) = -( rxt(k,618) + het_rates(k,73) ) + mat(k,179) = -( rxt(k,43) + het_rates(k,74) ) + mat(k,969) = -( het_rates(k,75) ) + mat(k,192) = rxt(k,81) + mat(k,202) = rxt(k,85) + mat(k,268) = 2.000_r8*rxt(k,97) + mat(k,293) = rxt(k,98) + mat(k,347) = rxt(k,105) + 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,1210) = -( rxt(k,44) + het_rates(k,76) ) + mat(k,1238) = .330_r8*rxt(k,46) + mat(k,732) = .250_r8*rxt(k,66) + mat(k,1098) = -( rxt(k,45) + rxt(k,582) + het_rates(k,77) ) + mat(k,452) = rxt(k,22) + mat(k,468) = .130_r8*rxt(k,24) + mat(k,369) = .700_r8*rxt(k,62) + mat(k,667) = .600_r8*rxt(k,71) + mat(k,771) = .340_r8*rxt(k,73) + mat(k,475) = .170_r8*rxt(k,74) + mat(k,2283) = -( het_rates(k,78) ) + mat(k,2518) = 2.000_r8*rxt(k,2) + rxt(k,3) + mat(k,2491) = 2.000_r8*rxt(k,34) + mat(k,457) = rxt(k,39) + mat(k,2096) = .330_r8*rxt(k,40) + rxt(k,41) + mat(k,885) = rxt(k,100) + mat(k,1548) = rxt(k,104) + mat(k,348) = rxt(k,105) + mat(k,1505) = -( het_rates(k,79) ) + mat(k,2503) = rxt(k,1) + mat(k,2477) = rxt(k,33) + mat(k,2082) = 1.440_r8*rxt(k,40) + mat(k,169) = -( rxt(k,99) + het_rates(k,80) ) + mat(k,644) = -( rxt(k,4) + het_rates(k,81) ) + mat(k,176) = -( rxt(k,136) + het_rates(k,82) ) + mat(k,880) = -( rxt(k,100) + het_rates(k,83) ) + mat(k,287) = -( rxt(k,101) + het_rates(k,84) ) + mat(k,297) = -( rxt(k,102) + het_rates(k,85) ) + mat(k,356) = -( rxt(k,103) + het_rates(k,86) ) + mat(k,1539) = -( rxt(k,104) + het_rates(k,87) ) + mat(k,248) = -( het_rates(k,88) ) + mat(k,942) = -( het_rates(k,89) ) + mat(k,346) = -( rxt(k,105) + het_rates(k,90) ) + mat(k,2307) = -( rxt(k,9) + het_rates(k,91) ) + mat(k,1248) = rxt(k,541) + mat(k,658) = rxt(k,542) + mat(k,603) = rxt(k,543) + mat(k,323) = 2.000_r8*rxt(k,544) + 2.000_r8*rxt(k,586) + 2.000_r8*rxt(k,589) & + + 2.000_r8*rxt(k,600) + mat(k,498) = rxt(k,545) + mat(k,1143) = rxt(k,546) + mat(k,1690) = .500_r8*rxt(k,548) + mat(k,2072) = rxt(k,549) + mat(k,436) = rxt(k,550) + mat(k,278) = rxt(k,551) + mat(k,689) = rxt(k,552) + mat(k,610) = rxt(k,588) + rxt(k,591) + rxt(k,596) + mat(k,1034) = rxt(k,590) + rxt(k,595) + rxt(k,601) + mat(k,521) = -( rxt(k,10) + rxt(k,11) + rxt(k,232) + het_rates(k,92) ) + mat(k,841) = -( rxt(k,106) + het_rates(k,93) ) + mat(k,605) = rxt(k,588) + rxt(k,591) + rxt(k,596) + mat(k,873) = -( rxt(k,107) + het_rates(k,94) ) + mat(k,1026) = rxt(k,590) + rxt(k,595) + rxt(k,601) + mat(k,1239) = -( rxt(k,46) + rxt(k,541) + het_rates(k,95) ) + mat(k,282) = -( rxt(k,47) + het_rates(k,96) ) + mat(k,1359) = rxt(k,433) + mat(k,1252) = -( rxt(k,48) + het_rates(k,97) ) + mat(k,1240) = .170_r8*rxt(k,46) + mat(k,398) = -( het_rates(k,98) ) + mat(k,173) = -( het_rates(k,99) ) + mat(k,920) = -( het_rates(k,100) ) + mat(k,651) = -( rxt(k,542) + het_rates(k,101) ) + mat(k,596) = -( rxt(k,543) + het_rates(k,102) ) + mat(k,1297) = -( het_rates(k,103) ) + mat(k,443) = -( rxt(k,49) + het_rates(k,104) ) + mat(k,84) = -( het_rates(k,105) ) + mat(k,755) = -( rxt(k,50) + het_rates(k,106) ) + mat(k,444) = rxt(k,49) + mat(k,73) = -( het_rates(k,107) ) + mat(k,71) = -( het_rates(k,108) ) + mat(k,115) = -( het_rates(k,109) ) + mat(k,113) = -( het_rates(k,110) ) + mat(k,1313) = -( rxt(k,51) + rxt(k,52) + het_rates(k,111) ) + mat(k,757) = .300_r8*rxt(k,50) + mat(k,393) = -( het_rates(k,112) ) + mat(k,563) = -( rxt(k,53) + het_rates(k,113) ) + mat(k,698) = .800_r8*rxt(k,20) + mat(k,709) = .800_r8*rxt(k,21) + mat(k,388) = -( rxt(k,54) + het_rates(k,114) ) + mat(k,671) = -( rxt(k,55) + rxt(k,415) + het_rates(k,115) ) + mat(k,1006) = -( het_rates(k,116) ) + mat(k,90) = -( het_rates(k,117) ) + mat(k,1420) = -( rxt(k,56) + het_rates(k,118) ) + mat(k,758) = .700_r8*rxt(k,50) + mat(k,1043) = -( rxt(k,111) + het_rates(k,119) ) + mat(k,1756) = rxt(k,15) + mat(k,852) = rxt(k,616) + mat(k,302) = -( rxt(k,12) + het_rates(k,120) ) + mat(k,319) = -( rxt(k,13) + rxt(k,14) + rxt(k,233) + rxt(k,544) + rxt(k,586) & + + rxt(k,589) + rxt(k,600) + het_rates(k,121) ) + mat(k,493) = -( rxt(k,545) + het_rates(k,122) ) + mat(k,1134) = -( rxt(k,57) + rxt(k,546) + het_rates(k,123) ) + mat(k,10) = -( het_rates(k,124) ) + mat(k,11) = -( het_rates(k,125) ) + mat(k,12) = -( het_rates(k,126) ) + mat(k,141) = -( het_rates(k,127) ) + mat(k,13) = -( rxt(k,547) + het_rates(k,128) ) + mat(k,14) = -( rxt(k,620) + het_rates(k,129) ) + mat(k,15) = -( rxt(k,619) + het_rates(k,130) ) + mat(k,1788) = -( rxt(k,15) + rxt(k,16) + het_rates(k,131) ) + mat(k,321) = rxt(k,14) + mat(k,1682) = rxt(k,17) + .500_r8*rxt(k,548) + mat(k,2064) = rxt(k,19) + mat(k,901) = rxt(k,613) + mat(k,1681) = -( rxt(k,17) + rxt(k,548) + het_rates(k,132) ) + mat(k,2298) = rxt(k,9) + mat(k,523) = rxt(k,11) + rxt(k,232) + mat(k,320) = rxt(k,13) + rxt(k,233) + mat(k,2063) = rxt(k,18) + mat(k,705) = rxt(k,20) + mat(k,1244) = rxt(k,46) + mat(k,446) = rxt(k,49) + mat(k,675) = rxt(k,55) + rxt(k,415) + mat(k,1139) = rxt(k,57) + mat(k,939) = rxt(k,58) + mat(k,434) = rxt(k,59) + mat(k,277) = rxt(k,60) + mat(k,583) = .600_r8*rxt(k,61) + rxt(k,365) + mat(k,686) = rxt(k,67) + mat(k,608) = rxt(k,77) + mat(k,1030) = rxt(k,96) + mat(k,184) = rxt(k,490) + mat(k,2067) = -( rxt(k,18) + rxt(k,19) + rxt(k,549) + het_rates(k,133) ) + mat(k,525) = rxt(k,10) + mat(k,322) = rxt(k,13) + rxt(k,14) + rxt(k,233) + mat(k,585) = .400_r8*rxt(k,61) + mat(k,609) = rxt(k,78) + mat(k,1032) = rxt(k,95) + mat(k,936) = -( rxt(k,58) + het_rates(k,134) ) + mat(k,431) = -( rxt(k,59) + rxt(k,550) + het_rates(k,135) ) + mat(k,16) = -( het_rates(k,136) ) + mat(k,17) = -( het_rates(k,137) ) + mat(k,18) = -( het_rates(k,138) ) + mat(k,19) = -( het_rates(k,139) ) + mat(k,20) = -( het_rates(k,140) ) + mat(k,2469) = -( rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + + rxt(k,125) + het_rates(k,141) ) + mat(k,2522) = rxt(k,2) + mat(k,1597) = 2.000_r8*rxt(k,5) + rxt(k,6) + rxt(k,127) + rxt(k,128) + rxt(k,129) & + + rxt(k,131) + rxt(k,132) + rxt(k,133) + 2.000_r8*rxt(k,134) & + + 2.000_r8*rxt(k,135) + mat(k,2426) = rxt(k,8) + mat(k,324) = rxt(k,14) + mat(k,1799) = rxt(k,15) + mat(k,1693) = rxt(k,17) + mat(k,2075) = rxt(k,18) + mat(k,2100) = .180_r8*rxt(k,40) + mat(k,1502) = rxt(k,42) + rxt(k,110) + mat(k,1621) = rxt(k,76) + mat(k,1648) = rxt(k,94) + mat(k,366) = rxt(k,108) + mat(k,1532) = rxt(k,138) + mat(k,995) = rxt(k,139) + mat(k,309) = rxt(k,140) + mat(k,1842) = rxt(k,175) + mat(k,1586) = -( rxt(k,5) + rxt(k,6) + rxt(k,126) + rxt(k,127) + rxt(k,128) & + + rxt(k,129) + rxt(k,130) + rxt(k,131) + rxt(k,132) + rxt(k,133) & + + rxt(k,134) + rxt(k,135) + het_rates(k,142) ) + mat(k,2411) = rxt(k,8) + mat(k,2060) = rxt(k,19) + mat(k,224) = rxt(k,171) + rxt(k,179) + mat(k,227) = rxt(k,172) + mat(k,2425) = -( rxt(k,7) + rxt(k,8) + het_rates(k,143) ) + mat(k,21) = -( het_rates(k,144) ) + mat(k,362) = -( rxt(k,108) + het_rates(k,145) ) + mat(k,417) = -( rxt(k,137) + het_rates(k,146) ) + mat(k,276) = -( rxt(k,60) + rxt(k,551) + het_rates(k,147) ) + mat(k,580) = -( rxt(k,61) + rxt(k,365) + het_rates(k,148) ) + mat(k,182) = -( rxt(k,490) + het_rates(k,149) ) + mat(k,535) = -( het_rates(k,150) ) + mat(k,316) = rxt(k,32) + mat(k,218) = -( het_rates(k,151) ) + mat(k,367) = -( rxt(k,62) + het_rates(k,152) ) + mat(k,22) = -( het_rates(k,153) ) + mat(k,23) = -( het_rates(k,154) ) + mat(k,24) = -( het_rates(k,155) ) + mat(k,25) = -( het_rates(k,156) ) + mat(k,588) = -( rxt(k,63) + het_rates(k,157) ) + mat(k,425) = -( rxt(k,64) + het_rates(k,158) ) + mat(k,777) = -( het_rates(k,159) ) + mat(k,418) = rxt(k,137) + mat(k,1518) = rxt(k,138) + mat(k,26) = -( rxt(k,109) + het_rates(k,160) ) + mat(k,1520) = -( rxt(k,138) + het_rates(k,161) ) + mat(k,992) = rxt(k,139) + mat(k,991) = -( rxt(k,139) + het_rates(k,162) ) + mat(k,308) = rxt(k,140) + mat(k,307) = -( rxt(k,140) + het_rates(k,163) ) + mat(k,177) = rxt(k,136) + mat(k,27) = -( het_rates(k,164) ) + mat(k,28) = -( het_rates(k,165) ) + mat(k,29) = -( het_rates(k,166) ) + mat(k,30) = -( het_rates(k,167) ) + mat(k,31) = -( rxt(k,141) + het_rates(k,168) ) + mat(k,32) = -( rxt(k,142) + het_rates(k,169) ) + mat(k,33) = -( rxt(k,143) + het_rates(k,170) ) + mat(k,34) = -( rxt(k,144) + het_rates(k,171) ) + mat(k,35) = -( rxt(k,145) + het_rates(k,172) ) + mat(k,36) = -( rxt(k,146) + het_rates(k,173) ) + mat(k,37) = -( rxt(k,147) + het_rates(k,174) ) + mat(k,38) = -( rxt(k,148) + het_rates(k,175) ) + end do + end subroutine linmat02 + subroutine linmat03( 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,39) = -( rxt(k,149) + het_rates(k,176) ) + mat(k,40) = -( rxt(k,150) + het_rates(k,177) ) + mat(k,41) = -( rxt(k,151) + het_rates(k,178) ) + mat(k,42) = -( rxt(k,152) + het_rates(k,179) ) + mat(k,43) = -( rxt(k,153) + het_rates(k,180) ) + mat(k,44) = -( rxt(k,154) + het_rates(k,181) ) + mat(k,45) = -( rxt(k,155) + het_rates(k,182) ) + mat(k,46) = -( rxt(k,156) + het_rates(k,183) ) + mat(k,47) = -( rxt(k,157) + het_rates(k,184) ) + mat(k,48) = -( rxt(k,158) + het_rates(k,185) ) + mat(k,49) = -( rxt(k,159) + het_rates(k,186) ) + mat(k,50) = -( rxt(k,160) + het_rates(k,187) ) + mat(k,51) = -( rxt(k,161) + het_rates(k,188) ) + mat(k,52) = -( rxt(k,162) + het_rates(k,189) ) + mat(k,53) = -( rxt(k,163) + het_rates(k,190) ) + mat(k,54) = -( rxt(k,164) + het_rates(k,191) ) + mat(k,55) = -( rxt(k,165) + het_rates(k,192) ) + mat(k,56) = -( rxt(k,166) + het_rates(k,193) ) + mat(k,57) = -( rxt(k,167) + het_rates(k,194) ) + mat(k,58) = -( rxt(k,168) + het_rates(k,195) ) + mat(k,59) = -( rxt(k,169) + het_rates(k,196) ) + mat(k,60) = -( rxt(k,170) + het_rates(k,197) ) + mat(k,61) = -( het_rates(k,198) ) + mat(k,62) = -( het_rates(k,199) ) + mat(k,63) = -( het_rates(k,200) ) + mat(k,64) = -( het_rates(k,201) ) + mat(k,65) = -( het_rates(k,202) ) + mat(k,74) = -( het_rates(k,203) ) + mat(k,1097) = rxt(k,582) + mat(k,75) = -( het_rates(k,204) ) + mat(k,76) = -( het_rates(k,205) ) + mat(k,77) = -( het_rates(k,206) ) + mat(k,78) = -( het_rates(k,207) ) + mat(k,97) = -( het_rates(k,208) ) + mat(k,98) = -( het_rates(k,209) ) + mat(k,99) = -( het_rates(k,210) ) + mat(k,100) = -( het_rates(k,211) ) + mat(k,101) = -( het_rates(k,212) ) + mat(k,116) = -( rxt(k,621) + het_rates(k,213) ) + mat(k,122) = -( het_rates(k,214) ) + mat(k,128) = -( het_rates(k,215) ) + mat(k,241) = -( rxt(k,65) + het_rates(k,216) ) + mat(k,728) = -( rxt(k,66) + het_rates(k,217) ) + mat(k,684) = -( rxt(k,67) + rxt(k,552) + het_rates(k,218) ) + mat(k,528) = -( rxt(k,68) + het_rates(k,219) ) + mat(k,1116) = -( rxt(k,69) + het_rates(k,220) ) + mat(k,432) = rxt(k,59) + mat(k,685) = rxt(k,67) + mat(k,530) = rxt(k,68) + mat(k,1163) = -( rxt(k,70) + het_rates(k,221) ) + mat(k,730) = rxt(k,66) + mat(k,1118) = rxt(k,69) + mat(k,662) = -( rxt(k,71) + het_rates(k,222) ) + mat(k,229) = -( het_rates(k,223) ) + mat(k,134) = -( het_rates(k,224) ) + mat(k,245) = -( rxt(k,72) + het_rates(k,225) ) + mat(k,254) = -( het_rates(k,226) ) + mat(k,766) = -( rxt(k,73) + het_rates(k,227) ) + mat(k,140) = -( het_rates(k,228) ) + mat(k,262) = -( het_rates(k,229) ) + mat(k,473) = -( rxt(k,74) + het_rates(k,230) ) + mat(k,569) = -( het_rates(k,233) ) + mat(k,183) = rxt(k,490) + mat(k,1086) = -( het_rates(k,234) ) + mat(k,541) = -( het_rates(k,235) ) + mat(k,481) = -( het_rates(k,236) ) + mat(k,950) = -( het_rates(k,237) ) + mat(k,565) = rxt(k,53) + mat(k,979) = -( het_rates(k,238) ) + mat(k,692) = -( het_rates(k,239) ) + mat(k,1472) = -( het_rates(k,240) ) + mat(k,471) = .130_r8*rxt(k,24) + mat(k,386) = rxt(k,28) + mat(k,1126) = rxt(k,36) + mat(k,1326) = rxt(k,37) + mat(k,1242) = .330_r8*rxt(k,46) + mat(k,1254) = rxt(k,48) + mat(k,1317) = 1.340_r8*rxt(k,51) + mat(k,566) = rxt(k,53) + mat(k,391) = rxt(k,54) + mat(k,1422) = .300_r8*rxt(k,56) + mat(k,938) = rxt(k,58) + mat(k,581) = .600_r8*rxt(k,61) + rxt(k,365) + mat(k,427) = rxt(k,64) + mat(k,243) = .500_r8*rxt(k,65) + mat(k,1166) = .650_r8*rxt(k,70) + mat(k,2360) = -( het_rates(k,241) ) + mat(k,1202) = rxt(k,35) + mat(k,1128) = rxt(k,36) + mat(k,641) = rxt(k,38) + mat(k,2098) = rxt(k,41) + mat(k,1432) = .300_r8*rxt(k,56) + mat(k,586) = .400_r8*rxt(k,61) + mat(k,635) = rxt(k,88) + mat(k,407) = rxt(k,90) + mat(k,822) = -( het_rates(k,242) ) + mat(k,332) = .600_r8*rxt(k,26) + mat(k,909) = -( het_rates(k,243) ) + mat(k,1750) = rxt(k,16) + mat(k,1042) = rxt(k,111) + mat(k,2444) = rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + + rxt(k,125) + mat(k,1578) = rxt(k,126) + rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,130) & + + rxt(k,131) + rxt(k,132) + rxt(k,133) + mat(k,612) = -( het_rates(k,244) ) + mat(k,509) = -( rxt(k,358) + het_rates(k,245) ) + mat(k,180) = rxt(k,43) + mat(k,832) = -( het_rates(k,246) ) + mat(k,2214) = -( rxt(k,540) + het_rates(k,247) ) + mat(k,526) = rxt(k,11) + rxt(k,232) + mat(k,707) = rxt(k,20) + mat(k,718) = .900_r8*rxt(k,21) + mat(k,454) = rxt(k,22) + mat(k,217) = 1.500_r8*rxt(k,23) + mat(k,472) = .560_r8*rxt(k,24) + mat(k,508) = rxt(k,25) + mat(k,333) = .600_r8*rxt(k,26) + mat(k,683) = .600_r8*rxt(k,27) + mat(k,387) = rxt(k,28) + mat(k,377) = rxt(k,29) + mat(k,382) = rxt(k,30) + mat(k,441) = rxt(k,31) + mat(k,1200) = rxt(k,35) + mat(k,1330) = rxt(k,37) + mat(k,1213) = 2.000_r8*rxt(k,44) + mat(k,1102) = 2.000_r8*rxt(k,45) + mat(k,1247) = .670_r8*rxt(k,46) + mat(k,286) = rxt(k,47) + mat(k,1256) = rxt(k,48) + mat(k,448) = rxt(k,49) + mat(k,760) = rxt(k,50) + mat(k,1320) = 1.340_r8*rxt(k,51) + .660_r8*rxt(k,52) + mat(k,1142) = rxt(k,57) + mat(k,371) = rxt(k,62) + mat(k,593) = rxt(k,63) + mat(k,244) = rxt(k,65) + mat(k,736) = rxt(k,66) + mat(k,688) = rxt(k,67) + mat(k,533) = rxt(k,68) + mat(k,1123) = rxt(k,69) + mat(k,1169) = 1.200_r8*rxt(k,70) + mat(k,670) = rxt(k,71) + mat(k,776) = rxt(k,73) + mat(k,478) = rxt(k,74) + mat(k,491) = rxt(k,328) + mat(k,512) = rxt(k,358) + mat(k,1386) = rxt(k,433) + mat(k,487) = -( rxt(k,328) + het_rates(k,248) ) + mat(k,1343) = -( het_rates(k,249) ) + mat(k,1376) = -( rxt(k,433) + het_rates(k,250) ) + mat(k,1400) = -( het_rates(k,251) ) + mat(k,784) = -( het_rates(k,252) ) + mat(k,507) = .600_r8*rxt(k,25) + mat(k,1441) = -( het_rates(k,253) ) + mat(k,1316) = .660_r8*rxt(k,51) + mat(k,673) = rxt(k,55) + rxt(k,415) + mat(k,959) = -( het_rates(k,254) ) + mat(k,681) = .600_r8*rxt(k,27) + mat(k,721) = -( het_rates(k,255) ) + mat(k,575) = -( het_rates(k,256) ) + mat(k,739) = -( het_rates(k,257) ) + mat(k,889) = -( het_rates(k,258) ) + mat(k,1748) = rxt(k,16) + mat(k,896) = rxt(k,613) + mat(k,850) = rxt(k,616) + mat(k,548) = -( het_rates(k,259) ) + mat(k,1038) = rxt(k,111) + mat(k,1150) = -( het_rates(k,260) ) + mat(k,1832) = -( rxt(k,175) + het_rates(k,261) ) + mat(k,2512) = rxt(k,1) + mat(k,1591) = rxt(k,6) + mat(k,2416) = rxt(k,7) + mat(k,305) = rxt(k,12) + mat(k,223) = -( rxt(k,171) + rxt(k,179) + het_rates(k,262) ) + mat(k,2370) = rxt(k,7) + mat(k,225) = rxt(k,183) + mat(k,226) = -( rxt(k,172) + rxt(k,183) + het_rates(k,263) ) + mat(k,897) = -( rxt(k,613) + het_rates(k,264) ) + mat(k,1577) = rxt(k,126) + rxt(k,130) + mat(k,2006) = -( het_rates(k,265) ) + mat(k,2513) = rxt(k,3) + mat(k,646) = 2.000_r8*rxt(k,4) + mat(k,2301) = rxt(k,9) + mat(k,524) = rxt(k,10) + mat(k,717) = rxt(k,21) + mat(k,453) = rxt(k,22) + mat(k,376) = rxt(k,29) + mat(k,381) = rxt(k,30) + mat(k,440) = rxt(k,31) + mat(k,318) = rxt(k,32) + mat(k,640) = rxt(k,38) + mat(k,456) = rxt(k,39) + mat(k,2091) = .330_r8*rxt(k,40) + mat(k,181) = rxt(k,43) + mat(k,285) = rxt(k,47) + mat(k,759) = rxt(k,50) + mat(k,392) = rxt(k,54) + mat(k,435) = rxt(k,59) + mat(k,370) = rxt(k,62) + mat(k,592) = rxt(k,63) + mat(k,428) = rxt(k,64) + mat(k,735) = rxt(k,66) + mat(k,532) = rxt(k,68) + mat(k,669) = rxt(k,71) + mat(k,247) = rxt(k,72) + mat(k,775) = rxt(k,73) + mat(k,477) = rxt(k,74) + mat(k,845) = rxt(k,106) + mat(k,876) = rxt(k,107) + mat(k,1684) = .500_r8*rxt(k,548) + end do + end subroutine linmat03 + subroutine linmat04( 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,849) = -( rxt(k,616) + het_rates(k,266) ) + mat(k,2439) = rxt(k,120) + rxt(k,121) + rxt(k,122) + rxt(k,123) + rxt(k,124) & + + rxt(k,125) + mat(k,1575) = rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,131) + rxt(k,132) & + + rxt(k,133) + mat(k,500) = -( het_rates(k,267) ) + mat(k,862) = -( het_rates(k,268) ) + mat(k,1261) = -( het_rates(k,269) ) + mat(k,1165) = .150_r8*rxt(k,70) + mat(k,1222) = -( het_rates(k,270) ) + mat(k,1106) = -( het_rates(k,271) ) + mat(k,795) = -( het_rates(k,272) ) + mat(k,1277) = -( het_rates(k,273) ) + mat(k,811) = -( het_rates(k,274) ) + mat(k,556) = -( het_rates(k,275) ) + mat(k,2524) = -( rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,276) ) + mat(k,2102) = .050_r8*rxt(k,40) + mat(k,178) = rxt(k,136) + mat(k,2222) = rxt(k,540) + end do + end subroutine linmat04 + 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 ) + call linmat03( avec_len, mat, y, rxt, het_rates ) + call linmat04( avec_len, mat, y, rxt, het_rates ) + end subroutine linmat + end module mo_lin_matrix diff --git a/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_lu_factor.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_lu_factor.F90 new file mode 100644 index 0000000000..c21cd1da8b --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_lu_factor.F90 @@ -0,0 +1,8938 @@ + 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) = 1._r8 / lu(k,10) + 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) = 1._r8 / lu(k,33) + 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) = 1._r8 / lu(k,37) + lu(k,38) = 1._r8 / lu(k,38) + lu(k,39) = 1._r8 / lu(k,39) + lu(k,40) = 1._r8 / lu(k,40) + lu(k,41) = 1._r8 / lu(k,41) + lu(k,42) = 1._r8 / lu(k,42) + lu(k,43) = 1._r8 / lu(k,43) + lu(k,44) = 1._r8 / lu(k,44) + lu(k,45) = 1._r8 / lu(k,45) + lu(k,46) = 1._r8 / lu(k,46) + lu(k,47) = 1._r8 / lu(k,47) + lu(k,48) = 1._r8 / lu(k,48) + lu(k,49) = 1._r8 / lu(k,49) + lu(k,50) = 1._r8 / lu(k,50) + lu(k,51) = 1._r8 / lu(k,51) + 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,52) = 1._r8 / lu(k,52) + lu(k,53) = 1._r8 / lu(k,53) + lu(k,54) = 1._r8 / lu(k,54) + lu(k,55) = 1._r8 / lu(k,55) + lu(k,56) = 1._r8 / lu(k,56) + lu(k,57) = 1._r8 / lu(k,57) + lu(k,58) = 1._r8 / lu(k,58) + lu(k,59) = 1._r8 / lu(k,59) + lu(k,60) = 1._r8 / lu(k,60) + lu(k,61) = 1._r8 / lu(k,61) + lu(k,62) = 1._r8 / lu(k,62) + lu(k,63) = 1._r8 / lu(k,63) + lu(k,64) = 1._r8 / lu(k,64) + lu(k,65) = 1._r8 / lu(k,65) + lu(k,71) = 1._r8 / lu(k,71) + lu(k,73) = 1._r8 / lu(k,73) + lu(k,74) = 1._r8 / lu(k,74) + lu(k,75) = 1._r8 / lu(k,75) + lu(k,76) = 1._r8 / lu(k,76) + lu(k,77) = 1._r8 / lu(k,77) + lu(k,78) = 1._r8 / lu(k,78) + lu(k,84) = 1._r8 / lu(k,84) + lu(k,90) = 1._r8 / lu(k,90) + lu(k,96) = 1._r8 / lu(k,96) + lu(k,97) = 1._r8 / lu(k,97) + lu(k,98) = 1._r8 / lu(k,98) + lu(k,99) = 1._r8 / lu(k,99) + lu(k,100) = 1._r8 / lu(k,100) + lu(k,101) = 1._r8 / lu(k,101) + lu(k,107) = 1._r8 / lu(k,107) + lu(k,113) = 1._r8 / lu(k,113) + lu(k,115) = 1._r8 / lu(k,115) + lu(k,116) = 1._r8 / lu(k,116) + lu(k,122) = 1._r8 / lu(k,122) + lu(k,128) = 1._r8 / lu(k,128) + lu(k,134) = 1._r8 / lu(k,134) + lu(k,140) = 1._r8 / lu(k,140) + lu(k,141) = 1._r8 / lu(k,141) + lu(k,142) = lu(k,142) * lu(k,141) + lu(k,143) = lu(k,143) * lu(k,141) + lu(k,2006) = lu(k,2006) - lu(k,142) * lu(k,1867) + lu(k,2017) = lu(k,2017) - lu(k,143) * lu(k,1867) + lu(k,144) = 1._r8 / lu(k,144) + lu(k,145) = lu(k,145) * lu(k,144) + lu(k,146) = lu(k,146) * lu(k,144) + lu(k,1832) = lu(k,1832) - lu(k,145) * lu(k,1802) + lu(k,1837) = lu(k,1837) - lu(k,146) * lu(k,1802) + 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,2006) = lu(k,2006) - lu(k,148) * lu(k,1868) + lu(k,2009) = lu(k,2009) - lu(k,149) * lu(k,1868) + lu(k,150) = 1._r8 / lu(k,150) + lu(k,151) = lu(k,151) * lu(k,150) + lu(k,152) = lu(k,152) * lu(k,150) + lu(k,1636) = lu(k,1636) - lu(k,151) * lu(k,1624) + lu(k,1643) = lu(k,1643) - lu(k,152) * lu(k,1624) + lu(k,153) = 1._r8 / lu(k,153) + lu(k,154) = lu(k,154) * lu(k,153) + lu(k,155) = lu(k,155) * lu(k,153) + lu(k,156) = lu(k,156) * lu(k,153) + lu(k,1815) = lu(k,1815) - lu(k,154) * lu(k,1803) + lu(k,1832) = lu(k,1832) - lu(k,155) * lu(k,1803) + lu(k,1837) = lu(k,1837) - lu(k,156) * lu(k,1803) + 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,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,160) = lu(k,160) * lu(k,157) + lu(k,1813) = lu(k,1813) - lu(k,158) * lu(k,1804) + lu(k,1832) = lu(k,1832) - lu(k,159) * lu(k,1804) + lu(k,1837) = lu(k,1837) - lu(k,160) * lu(k,1804) + lu(k,161) = 1._r8 / lu(k,161) + lu(k,162) = lu(k,162) * lu(k,161) + lu(k,163) = lu(k,163) * lu(k,161) + lu(k,164) = lu(k,164) * lu(k,161) + lu(k,1813) = lu(k,1813) - lu(k,162) * lu(k,1805) + lu(k,1832) = lu(k,1832) - lu(k,163) * lu(k,1805) + lu(k,1837) = lu(k,1837) - lu(k,164) * lu(k,1805) + lu(k,165) = 1._r8 / lu(k,165) + lu(k,166) = lu(k,166) * lu(k,165) + lu(k,167) = lu(k,167) * lu(k,165) + lu(k,168) = lu(k,168) * lu(k,165) + lu(k,2006) = lu(k,2006) - lu(k,166) * lu(k,1869) + lu(k,2010) = lu(k,2010) - lu(k,167) * lu(k,1869) + lu(k,2017) = lu(k,2017) - lu(k,168) * lu(k,1869) + lu(k,169) = 1._r8 / lu(k,169) + lu(k,170) = lu(k,170) * lu(k,169) + lu(k,171) = lu(k,171) * lu(k,169) + lu(k,172) = lu(k,172) * lu(k,169) + lu(k,1813) = lu(k,1813) - lu(k,170) * lu(k,1806) + lu(k,1826) = lu(k,1826) - lu(k,171) * lu(k,1806) + lu(k,1832) = lu(k,1832) - lu(k,172) * lu(k,1806) + lu(k,173) = 1._r8 / lu(k,173) + lu(k,174) = lu(k,174) * lu(k,173) + lu(k,175) = lu(k,175) * lu(k,173) + lu(k,756) = lu(k,756) - lu(k,174) * lu(k,754) + lu(k,759) = lu(k,759) - lu(k,175) * lu(k,754) + lu(k,1985) = lu(k,1985) - lu(k,174) * lu(k,1870) + lu(k,2006) = lu(k,2006) - lu(k,175) * lu(k,1870) + 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,307) = lu(k,307) - lu(k,177) * lu(k,306) + lu(k,310) = lu(k,310) - lu(k,178) * lu(k,306) + lu(k,2499) = lu(k,2499) - lu(k,177) * lu(k,2498) + lu(k,2524) = lu(k,2524) - lu(k,178) * lu(k,2498) + lu(k,179) = 1._r8 / lu(k,179) + lu(k,180) = lu(k,180) * lu(k,179) + lu(k,181) = lu(k,181) * lu(k,179) + lu(k,831) = lu(k,831) - lu(k,180) * lu(k,830) + lu(k,837) = - lu(k,181) * lu(k,830) + lu(k,2145) = - lu(k,180) * lu(k,2126) + lu(k,2211) = lu(k,2211) - lu(k,181) * lu(k,2126) + 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,569) = lu(k,569) - lu(k,183) * lu(k,568) + lu(k,571) = lu(k,571) - lu(k,184) * lu(k,568) + lu(k,1656) = lu(k,1656) - lu(k,183) * lu(k,1651) + lu(k,1681) = lu(k,1681) - lu(k,184) * lu(k,1651) + lu(k,185) = 1._r8 / lu(k,185) + lu(k,186) = lu(k,186) * lu(k,185) + lu(k,187) = lu(k,187) * lu(k,185) + lu(k,188) = lu(k,188) * lu(k,185) + lu(k,189) = lu(k,189) * lu(k,185) + lu(k,1813) = lu(k,1813) - lu(k,186) * lu(k,1807) + lu(k,1826) = lu(k,1826) - lu(k,187) * lu(k,1807) + lu(k,1832) = lu(k,1832) - lu(k,188) * lu(k,1807) + lu(k,1837) = lu(k,1837) - lu(k,189) * lu(k,1807) + lu(k,190) = 1._r8 / lu(k,190) + lu(k,191) = lu(k,191) * lu(k,190) + lu(k,192) = lu(k,192) * lu(k,190) + lu(k,193) = lu(k,193) * lu(k,190) + lu(k,194) = lu(k,194) * lu(k,190) + lu(k,1813) = lu(k,1813) - lu(k,191) * lu(k,1808) + lu(k,1823) = lu(k,1823) - lu(k,192) * lu(k,1808) + lu(k,1826) = lu(k,1826) - lu(k,193) * lu(k,1808) + lu(k,1832) = lu(k,1832) - lu(k,194) * lu(k,1808) + lu(k,195) = 1._r8 / lu(k,195) + lu(k,196) = lu(k,196) * lu(k,195) + lu(k,197) = lu(k,197) * lu(k,195) + lu(k,198) = lu(k,198) * lu(k,195) + lu(k,199) = lu(k,199) * lu(k,195) + lu(k,1813) = lu(k,1813) - lu(k,196) * lu(k,1809) + lu(k,1815) = lu(k,1815) - lu(k,197) * lu(k,1809) + lu(k,1832) = lu(k,1832) - lu(k,198) * lu(k,1809) + lu(k,1837) = lu(k,1837) - lu(k,199) * lu(k,1809) + 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,1813) = lu(k,1813) - lu(k,201) * lu(k,1810) + lu(k,1823) = lu(k,1823) - lu(k,202) * lu(k,1810) + lu(k,1832) = lu(k,1832) - lu(k,203) * lu(k,1810) + lu(k,1837) = lu(k,1837) - lu(k,204) * lu(k,1810) + lu(k,205) = 1._r8 / lu(k,205) + lu(k,206) = lu(k,206) * lu(k,205) + lu(k,877) = lu(k,877) - lu(k,206) * lu(k,872) + lu(k,1033) = lu(k,1033) - lu(k,206) * lu(k,1025) + lu(k,1547) = lu(k,1547) - lu(k,206) * lu(k,1534) + lu(k,1643) = lu(k,1643) - lu(k,206) * lu(k,1625) + lu(k,2261) = lu(k,2261) - lu(k,206) * lu(k,2223) + 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,208) = 1._r8 / lu(k,208) + lu(k,209) = lu(k,209) * lu(k,208) + lu(k,210) = lu(k,210) * lu(k,208) + lu(k,211) = lu(k,211) * lu(k,208) + lu(k,212) = lu(k,212) * lu(k,208) + lu(k,213) = lu(k,213) * lu(k,208) + lu(k,1872) = lu(k,1872) - lu(k,209) * lu(k,1871) + lu(k,1873) = lu(k,1873) - lu(k,210) * lu(k,1871) + lu(k,1922) = lu(k,1922) - lu(k,211) * lu(k,1871) + lu(k,2006) = lu(k,2006) - lu(k,212) * lu(k,1871) + lu(k,2009) = lu(k,2009) - lu(k,213) * lu(k,1871) + lu(k,214) = 1._r8 / lu(k,214) + lu(k,215) = lu(k,215) * lu(k,214) + lu(k,216) = lu(k,216) * lu(k,214) + lu(k,217) = lu(k,217) * lu(k,214) + lu(k,1917) = - lu(k,215) * lu(k,1872) + lu(k,1979) = lu(k,1979) - lu(k,216) * lu(k,1872) + lu(k,2009) = lu(k,2009) - lu(k,217) * lu(k,1872) + lu(k,218) = 1._r8 / lu(k,218) + lu(k,219) = lu(k,219) * lu(k,218) + lu(k,220) = lu(k,220) * lu(k,218) + lu(k,221) = lu(k,221) * lu(k,218) + lu(k,222) = lu(k,222) * lu(k,218) + lu(k,1916) = lu(k,1916) - lu(k,219) * lu(k,1873) + lu(k,1921) = lu(k,1921) - lu(k,220) * lu(k,1873) + lu(k,2006) = lu(k,2006) - lu(k,221) * lu(k,1873) + lu(k,2009) = lu(k,2009) - lu(k,222) * lu(k,1873) + lu(k,223) = 1._r8 / lu(k,223) + lu(k,224) = lu(k,224) * lu(k,223) + lu(k,227) = lu(k,227) - lu(k,224) * lu(k,225) + lu(k,1495) = - lu(k,224) * lu(k,1486) + lu(k,1586) = lu(k,1586) - lu(k,224) * lu(k,1568) + lu(k,2411) = lu(k,2411) - lu(k,224) * lu(k,2370) + lu(k,2454) = lu(k,2454) - lu(k,224) * lu(k,2429) + lu(k,226) = 1._r8 / lu(k,226) + lu(k,227) = lu(k,227) * lu(k,226) + lu(k,1495) = lu(k,1495) - lu(k,227) * lu(k,1487) + lu(k,1586) = lu(k,1586) - lu(k,227) * lu(k,1569) + lu(k,1827) = lu(k,1827) - lu(k,227) * lu(k,1811) + lu(k,2411) = lu(k,2411) - lu(k,227) * lu(k,2371) + lu(k,2454) = lu(k,2454) - lu(k,227) * lu(k,2430) + lu(k,229) = 1._r8 / lu(k,229) + lu(k,230) = lu(k,230) * lu(k,229) + lu(k,231) = lu(k,231) * lu(k,229) + lu(k,232) = lu(k,232) * lu(k,229) + lu(k,233) = lu(k,233) * lu(k,229) + lu(k,234) = lu(k,234) * lu(k,229) + lu(k,235) = lu(k,235) * lu(k,229) + lu(k,1875) = lu(k,1875) - lu(k,230) * lu(k,1874) + lu(k,1876) = lu(k,1876) - lu(k,231) * lu(k,1874) + lu(k,1914) = lu(k,1914) - lu(k,232) * lu(k,1874) + lu(k,1949) = lu(k,1949) - lu(k,233) * lu(k,1874) + lu(k,2006) = lu(k,2006) - lu(k,234) * lu(k,1874) + lu(k,2009) = lu(k,2009) - lu(k,235) * lu(k,1874) + lu(k,236) = 1._r8 / lu(k,236) + lu(k,237) = lu(k,237) * lu(k,236) + lu(k,238) = lu(k,238) * lu(k,236) + lu(k,239) = lu(k,239) * lu(k,236) + lu(k,240) = lu(k,240) * lu(k,236) + lu(k,1916) = lu(k,1916) - lu(k,237) * lu(k,1875) + lu(k,1921) = lu(k,1921) - lu(k,238) * lu(k,1875) + lu(k,2006) = lu(k,2006) - lu(k,239) * lu(k,1875) + lu(k,2009) = lu(k,2009) - lu(k,240) * lu(k,1875) + lu(k,241) = 1._r8 / lu(k,241) + lu(k,242) = lu(k,242) * lu(k,241) + lu(k,243) = lu(k,243) * lu(k,241) + lu(k,244) = lu(k,244) * lu(k,241) + lu(k,258) = - lu(k,242) * lu(k,253) + lu(k,259) = - lu(k,243) * lu(k,253) + lu(k,261) = lu(k,261) - lu(k,244) * lu(k,253) + lu(k,1979) = lu(k,1979) - lu(k,242) * lu(k,1876) + lu(k,1994) = lu(k,1994) - lu(k,243) * lu(k,1876) + lu(k,2009) = lu(k,2009) - lu(k,244) * lu(k,1876) + lu(k,245) = 1._r8 / lu(k,245) + lu(k,246) = lu(k,246) * lu(k,245) + lu(k,247) = lu(k,247) * lu(k,245) + lu(k,1277) = lu(k,1277) - lu(k,246) * lu(k,1271) + lu(k,1283) = - lu(k,247) * lu(k,1271) + lu(k,1985) = lu(k,1985) - lu(k,246) * lu(k,1877) + lu(k,2006) = lu(k,2006) - lu(k,247) * lu(k,1877) + lu(k,2191) = lu(k,2191) - lu(k,246) * lu(k,2127) + lu(k,2211) = lu(k,2211) - lu(k,247) * lu(k,2127) + 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,1832) = lu(k,1832) - lu(k,249) * lu(k,1812) + lu(k,1833) = lu(k,1833) - lu(k,250) * lu(k,1812) + lu(k,1836) = lu(k,1836) - lu(k,251) * lu(k,1812) + lu(k,2005) = - lu(k,249) * lu(k,1878) + lu(k,2006) = lu(k,2006) - lu(k,250) * lu(k,1878) + lu(k,2009) = lu(k,2009) - lu(k,251) * lu(k,1878) + lu(k,254) = 1._r8 / lu(k,254) + lu(k,255) = lu(k,255) * lu(k,254) + lu(k,256) = lu(k,256) * lu(k,254) + lu(k,257) = lu(k,257) * lu(k,254) + lu(k,258) = lu(k,258) * lu(k,254) + lu(k,259) = lu(k,259) * lu(k,254) + lu(k,260) = lu(k,260) * lu(k,254) + lu(k,261) = lu(k,261) * lu(k,254) + lu(k,1880) = lu(k,1880) - lu(k,255) * lu(k,1879) + lu(k,1914) = lu(k,1914) - lu(k,256) * lu(k,1879) + lu(k,1950) = lu(k,1950) - lu(k,257) * lu(k,1879) + lu(k,1979) = lu(k,1979) - lu(k,258) * lu(k,1879) + lu(k,1994) = lu(k,1994) - lu(k,259) * lu(k,1879) + lu(k,2006) = lu(k,2006) - lu(k,260) * lu(k,1879) + lu(k,2009) = lu(k,2009) - lu(k,261) * lu(k,1879) + 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,262) = 1._r8 / lu(k,262) + lu(k,263) = lu(k,263) * lu(k,262) + lu(k,264) = lu(k,264) * lu(k,262) + lu(k,265) = lu(k,265) * lu(k,262) + lu(k,266) = lu(k,266) * lu(k,262) + lu(k,1921) = lu(k,1921) - lu(k,263) * lu(k,1880) + lu(k,1923) = lu(k,1923) - lu(k,264) * lu(k,1880) + lu(k,2006) = lu(k,2006) - lu(k,265) * lu(k,1880) + lu(k,2009) = lu(k,2009) - lu(k,266) * lu(k,1880) + lu(k,267) = 1._r8 / lu(k,267) + lu(k,268) = lu(k,268) * lu(k,267) + lu(k,269) = lu(k,269) * lu(k,267) + lu(k,298) = - lu(k,268) * lu(k,296) + lu(k,299) = lu(k,299) - lu(k,269) * lu(k,296) + lu(k,357) = - lu(k,268) * lu(k,355) + lu(k,358) = lu(k,358) - lu(k,269) * lu(k,355) + lu(k,1823) = lu(k,1823) - lu(k,268) * lu(k,1813) + lu(k,1832) = lu(k,1832) - lu(k,269) * lu(k,1813) + lu(k,1962) = - lu(k,268) * lu(k,1881) + lu(k,2005) = lu(k,2005) - lu(k,269) * lu(k,1881) + lu(k,270) = 1._r8 / lu(k,270) + lu(k,271) = lu(k,271) * lu(k,270) + lu(k,272) = lu(k,272) * lu(k,270) + lu(k,1007) = - lu(k,271) * lu(k,1003) + lu(k,1019) = lu(k,1019) - lu(k,272) * lu(k,1003) + lu(k,1063) = - lu(k,271) * lu(k,1059) + lu(k,1075) = lu(k,1075) - lu(k,272) * lu(k,1059) + lu(k,1969) = lu(k,1969) - lu(k,271) * lu(k,1882) + lu(k,2006) = lu(k,2006) - lu(k,272) * lu(k,1882) + lu(k,2385) = - lu(k,271) * lu(k,2372) + lu(k,2417) = lu(k,2417) - lu(k,272) * lu(k,2372) + lu(k,273) = 1._r8 / lu(k,273) + lu(k,274) = lu(k,274) * lu(k,273) + lu(k,275) = lu(k,275) * lu(k,273) + lu(k,843) = lu(k,843) - lu(k,274) * lu(k,840) + lu(k,846) = - lu(k,275) * lu(k,840) + lu(k,1540) = - lu(k,274) * lu(k,1535) + lu(k,1547) = lu(k,1547) - lu(k,275) * lu(k,1535) + lu(k,1607) = lu(k,1607) - lu(k,274) * lu(k,1600) + lu(k,1617) = lu(k,1617) - lu(k,275) * lu(k,1600) + lu(k,1633) = lu(k,1633) - lu(k,274) * lu(k,1626) + lu(k,1643) = lu(k,1643) - lu(k,275) * lu(k,1626) + 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,1226) = lu(k,1226) - lu(k,277) * lu(k,1215) + lu(k,1230) = - lu(k,278) * lu(k,1215) + lu(k,1244) = lu(k,1244) - lu(k,277) * lu(k,1234) + lu(k,1248) = lu(k,1248) - lu(k,278) * lu(k,1234) + lu(k,1787) = lu(k,1787) - lu(k,277) * lu(k,1719) + lu(k,1796) = - lu(k,278) * lu(k,1719) + lu(k,2003) = lu(k,2003) - lu(k,277) * lu(k,1883) + lu(k,2012) = lu(k,2012) - lu(k,278) * lu(k,1883) + lu(k,279) = 1._r8 / lu(k,279) + lu(k,280) = lu(k,280) * lu(k,279) + lu(k,281) = lu(k,281) * lu(k,279) + lu(k,375) = - lu(k,280) * lu(k,372) + lu(k,376) = lu(k,376) - lu(k,281) * lu(k,372) + lu(k,482) = - lu(k,280) * lu(k,479) + lu(k,485) = - lu(k,281) * lu(k,479) + lu(k,1733) = lu(k,1733) - lu(k,280) * lu(k,1720) + lu(k,1790) = lu(k,1790) - lu(k,281) * lu(k,1720) + lu(k,1925) = lu(k,1925) - lu(k,280) * lu(k,1884) + lu(k,2006) = lu(k,2006) - lu(k,281) * lu(k,1884) + lu(k,282) = 1._r8 / lu(k,282) + lu(k,283) = lu(k,283) * lu(k,282) + lu(k,284) = lu(k,284) * lu(k,282) + lu(k,285) = lu(k,285) * lu(k,282) + lu(k,286) = lu(k,286) * lu(k,282) + lu(k,1362) = - lu(k,283) * lu(k,1359) + lu(k,1373) = - lu(k,284) * lu(k,1359) + lu(k,1384) = - lu(k,285) * lu(k,1359) + lu(k,1386) = lu(k,1386) - lu(k,286) * lu(k,1359) + lu(k,1937) = - lu(k,283) * lu(k,1885) + lu(k,1985) = lu(k,1985) - lu(k,284) * lu(k,1885) + lu(k,2006) = lu(k,2006) - lu(k,285) * lu(k,1885) + lu(k,2009) = lu(k,2009) - lu(k,286) * lu(k,1885) + lu(k,287) = 1._r8 / lu(k,287) + lu(k,288) = lu(k,288) * lu(k,287) + lu(k,289) = lu(k,289) * lu(k,287) + lu(k,290) = lu(k,290) * lu(k,287) + lu(k,291) = lu(k,291) * lu(k,287) + lu(k,1815) = lu(k,1815) - lu(k,288) * lu(k,1814) + lu(k,1832) = lu(k,1832) - lu(k,289) * lu(k,1814) + lu(k,1833) = lu(k,1833) - lu(k,290) * lu(k,1814) + lu(k,1837) = lu(k,1837) - lu(k,291) * lu(k,1814) + lu(k,1887) = lu(k,1887) - lu(k,288) * lu(k,1886) + lu(k,2005) = lu(k,2005) - lu(k,289) * lu(k,1886) + lu(k,2006) = lu(k,2006) - lu(k,290) * lu(k,1886) + lu(k,2010) = lu(k,2010) - lu(k,291) * lu(k,1886) + 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,1823) = lu(k,1823) - lu(k,293) * lu(k,1815) + lu(k,1832) = lu(k,1832) - lu(k,294) * lu(k,1815) + lu(k,1837) = lu(k,1837) - lu(k,295) * lu(k,1815) + lu(k,1962) = lu(k,1962) - lu(k,293) * lu(k,1887) + lu(k,2005) = lu(k,2005) - lu(k,294) * lu(k,1887) + lu(k,2010) = lu(k,2010) - lu(k,295) * lu(k,1887) + 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,297) = 1._r8 / lu(k,297) + lu(k,298) = lu(k,298) * lu(k,297) + lu(k,299) = lu(k,299) * lu(k,297) + lu(k,300) = lu(k,300) * lu(k,297) + lu(k,301) = lu(k,301) * lu(k,297) + lu(k,1823) = lu(k,1823) - lu(k,298) * lu(k,1816) + lu(k,1832) = lu(k,1832) - lu(k,299) * lu(k,1816) + lu(k,1833) = lu(k,1833) - lu(k,300) * lu(k,1816) + lu(k,1837) = lu(k,1837) - lu(k,301) * lu(k,1816) + lu(k,1962) = lu(k,1962) - lu(k,298) * lu(k,1888) + lu(k,2005) = lu(k,2005) - lu(k,299) * lu(k,1888) + lu(k,2006) = lu(k,2006) - lu(k,300) * lu(k,1888) + lu(k,2010) = lu(k,2010) - lu(k,301) * lu(k,1888) + lu(k,302) = 1._r8 / lu(k,302) + lu(k,303) = lu(k,303) * lu(k,302) + lu(k,304) = lu(k,304) * lu(k,302) + lu(k,305) = lu(k,305) * lu(k,302) + lu(k,1046) = lu(k,1046) - lu(k,303) * lu(k,1037) + lu(k,1048) = lu(k,1048) - lu(k,304) * lu(k,1037) + lu(k,1049) = - lu(k,305) * lu(k,1037) + lu(k,1678) = lu(k,1678) - lu(k,303) * lu(k,1652) + lu(k,1682) = lu(k,1682) - lu(k,304) * lu(k,1652) + lu(k,1683) = - lu(k,305) * lu(k,1652) + lu(k,1827) = lu(k,1827) - lu(k,303) * lu(k,1817) + lu(k,1831) = lu(k,1831) - lu(k,304) * lu(k,1817) + lu(k,1832) = lu(k,1832) - lu(k,305) * lu(k,1817) + lu(k,307) = 1._r8 / lu(k,307) + lu(k,308) = lu(k,308) * lu(k,307) + lu(k,309) = lu(k,309) * lu(k,307) + lu(k,310) = lu(k,310) * lu(k,307) + lu(k,991) = lu(k,991) - lu(k,308) * lu(k,990) + lu(k,995) = lu(k,995) - lu(k,309) * lu(k,990) + lu(k,996) = - lu(k,310) * lu(k,990) + lu(k,1964) = lu(k,1964) - lu(k,308) * lu(k,1889) + lu(k,2015) = lu(k,2015) - lu(k,309) * lu(k,1889) + lu(k,2017) = lu(k,2017) - lu(k,310) * lu(k,1889) + lu(k,2502) = - lu(k,308) * lu(k,2499) + lu(k,2522) = lu(k,2522) - lu(k,309) * lu(k,2499) + lu(k,2524) = lu(k,2524) - lu(k,310) * lu(k,2499) + lu(k,311) = 1._r8 / lu(k,311) + lu(k,312) = lu(k,312) * lu(k,311) + lu(k,313) = lu(k,313) * lu(k,311) + lu(k,314) = lu(k,314) * lu(k,311) + lu(k,951) = lu(k,951) - lu(k,312) * lu(k,947) + lu(k,955) = - lu(k,313) * lu(k,947) + lu(k,956) = lu(k,956) - lu(k,314) * lu(k,947) + lu(k,1978) = lu(k,1978) - lu(k,312) * lu(k,1890) + lu(k,2006) = lu(k,2006) - lu(k,313) * lu(k,1890) + lu(k,2009) = lu(k,2009) - lu(k,314) * lu(k,1890) + lu(k,2330) = lu(k,2330) - lu(k,312) * lu(k,2313) + lu(k,2353) = - lu(k,313) * lu(k,2313) + lu(k,2356) = lu(k,2356) - lu(k,314) * lu(k,2313) + lu(k,315) = 1._r8 / lu(k,315) + lu(k,316) = lu(k,316) * lu(k,315) + lu(k,317) = lu(k,317) * lu(k,315) + lu(k,318) = lu(k,318) * lu(k,315) + lu(k,691) = lu(k,691) - lu(k,316) * lu(k,690) + lu(k,692) = lu(k,692) - lu(k,317) * lu(k,690) + lu(k,695) = - lu(k,318) * lu(k,690) + lu(k,1921) = lu(k,1921) - lu(k,316) * lu(k,1891) + lu(k,1939) = lu(k,1939) - lu(k,317) * lu(k,1891) + lu(k,2006) = lu(k,2006) - lu(k,318) * lu(k,1891) + lu(k,2148) = - lu(k,316) * lu(k,2128) + lu(k,2157) = lu(k,2157) - lu(k,317) * lu(k,2128) + lu(k,2211) = lu(k,2211) - lu(k,318) * lu(k,2128) + lu(k,319) = 1._r8 / lu(k,319) + lu(k,320) = lu(k,320) * lu(k,319) + lu(k,321) = lu(k,321) * lu(k,319) + lu(k,322) = lu(k,322) * lu(k,319) + lu(k,323) = lu(k,323) * lu(k,319) + lu(k,324) = lu(k,324) * lu(k,319) + lu(k,1681) = lu(k,1681) - lu(k,320) * lu(k,1653) + lu(k,1682) = lu(k,1682) - lu(k,321) * lu(k,1653) + lu(k,1685) = lu(k,1685) - lu(k,322) * lu(k,1653) + lu(k,1690) = lu(k,1690) - lu(k,323) * lu(k,1653) + lu(k,1693) = lu(k,1693) - lu(k,324) * lu(k,1653) + lu(k,2063) = lu(k,2063) - lu(k,320) * lu(k,2020) + lu(k,2064) = lu(k,2064) - lu(k,321) * lu(k,2020) + lu(k,2067) = lu(k,2067) - lu(k,322) * lu(k,2020) + lu(k,2072) = lu(k,2072) - lu(k,323) * lu(k,2020) + lu(k,2075) = lu(k,2075) - lu(k,324) * lu(k,2020) + lu(k,325) = 1._r8 / lu(k,325) + lu(k,326) = lu(k,326) * lu(k,325) + lu(k,327) = lu(k,327) * lu(k,325) + lu(k,328) = lu(k,328) * lu(k,325) + lu(k,329) = lu(k,329) * lu(k,325) + lu(k,330) = lu(k,330) * lu(k,325) + lu(k,1959) = lu(k,1959) - lu(k,326) * lu(k,1892) + lu(k,1970) = lu(k,1970) - lu(k,327) * lu(k,1892) + lu(k,1979) = lu(k,1979) - lu(k,328) * lu(k,1892) + lu(k,2006) = lu(k,2006) - lu(k,329) * lu(k,1892) + lu(k,2009) = lu(k,2009) - lu(k,330) * lu(k,1892) + lu(k,2235) = - lu(k,326) * lu(k,2224) + lu(k,2239) = - lu(k,327) * lu(k,2224) + lu(k,2242) = lu(k,2242) - lu(k,328) * lu(k,2224) + lu(k,2257) = lu(k,2257) - lu(k,329) * lu(k,2224) + lu(k,2260) = lu(k,2260) - lu(k,330) * lu(k,2224) + lu(k,331) = 1._r8 / lu(k,331) + lu(k,332) = lu(k,332) * lu(k,331) + lu(k,333) = lu(k,333) * lu(k,331) + lu(k,666) = - lu(k,332) * lu(k,660) + lu(k,670) = lu(k,670) - lu(k,333) * lu(k,660) + lu(k,769) = - lu(k,332) * lu(k,762) + lu(k,776) = lu(k,776) - lu(k,333) * lu(k,762) + lu(k,796) = - lu(k,332) * lu(k,790) + lu(k,804) = lu(k,804) - lu(k,333) * lu(k,790) + lu(k,812) = - lu(k,332) * lu(k,805) + lu(k,821) = lu(k,821) - lu(k,333) * lu(k,805) + lu(k,1745) = lu(k,1745) - lu(k,332) * lu(k,1721) + lu(k,1793) = lu(k,1793) - lu(k,333) * lu(k,1721) + lu(k,334) = 1._r8 / lu(k,334) + lu(k,335) = lu(k,335) * lu(k,334) + lu(k,336) = lu(k,336) * lu(k,334) + lu(k,337) = lu(k,337) * lu(k,334) + lu(k,338) = lu(k,338) * lu(k,334) + lu(k,339) = lu(k,339) * lu(k,334) + lu(k,1960) = lu(k,1960) - lu(k,335) * lu(k,1893) + lu(k,1998) = lu(k,1998) - lu(k,336) * lu(k,1893) + lu(k,2006) = lu(k,2006) - lu(k,337) * lu(k,1893) + lu(k,2010) = lu(k,2010) - lu(k,338) * lu(k,1893) + lu(k,2017) = lu(k,2017) - lu(k,339) * lu(k,1893) + lu(k,2236) = lu(k,2236) - lu(k,335) * lu(k,2225) + lu(k,2249) = lu(k,2249) - lu(k,336) * lu(k,2225) + lu(k,2257) = lu(k,2257) - lu(k,337) * lu(k,2225) + lu(k,2261) = lu(k,2261) - lu(k,338) * lu(k,2225) + lu(k,2268) = - lu(k,339) * lu(k,2225) + 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,340) = 1._r8 / lu(k,340) + lu(k,341) = lu(k,341) * lu(k,340) + lu(k,342) = lu(k,342) * lu(k,340) + lu(k,343) = lu(k,343) * lu(k,340) + lu(k,344) = lu(k,344) * lu(k,340) + lu(k,345) = lu(k,345) * lu(k,340) + lu(k,1963) = lu(k,1963) - lu(k,341) * lu(k,1894) + lu(k,1998) = lu(k,1998) - lu(k,342) * lu(k,1894) + lu(k,2006) = lu(k,2006) - lu(k,343) * lu(k,1894) + lu(k,2010) = lu(k,2010) - lu(k,344) * lu(k,1894) + lu(k,2017) = lu(k,2017) - lu(k,345) * lu(k,1894) + lu(k,2237) = lu(k,2237) - lu(k,341) * lu(k,2226) + lu(k,2249) = lu(k,2249) - lu(k,342) * lu(k,2226) + lu(k,2257) = lu(k,2257) - lu(k,343) * lu(k,2226) + lu(k,2261) = lu(k,2261) - lu(k,344) * lu(k,2226) + lu(k,2268) = lu(k,2268) - lu(k,345) * lu(k,2226) + lu(k,346) = 1._r8 / lu(k,346) + lu(k,347) = lu(k,347) * lu(k,346) + lu(k,348) = lu(k,348) * lu(k,346) + lu(k,969) = lu(k,969) - lu(k,347) * lu(k,968) + lu(k,974) = lu(k,974) - lu(k,348) * lu(k,968) + lu(k,1504) = lu(k,1504) - lu(k,347) * lu(k,1503) + lu(k,1512) = lu(k,1512) - lu(k,348) * lu(k,1503) + lu(k,2079) = lu(k,2079) - lu(k,347) * lu(k,2078) + lu(k,2096) = lu(k,2096) - lu(k,348) * lu(k,2078) + lu(k,2291) = lu(k,2291) - lu(k,347) * lu(k,2290) + lu(k,2306) = - lu(k,348) * lu(k,2290) + lu(k,2501) = lu(k,2501) - lu(k,347) * lu(k,2500) + lu(k,2518) = lu(k,2518) - lu(k,348) * lu(k,2500) + lu(k,349) = 1._r8 / lu(k,349) + lu(k,350) = lu(k,350) * lu(k,349) + lu(k,351) = lu(k,351) * lu(k,349) + lu(k,352) = lu(k,352) * lu(k,349) + lu(k,353) = lu(k,353) * lu(k,349) + lu(k,354) = lu(k,354) * lu(k,349) + lu(k,1964) = lu(k,1964) - lu(k,350) * lu(k,1895) + lu(k,2006) = lu(k,2006) - lu(k,351) * lu(k,1895) + lu(k,2007) = lu(k,2007) - lu(k,352) * lu(k,1895) + lu(k,2009) = lu(k,2009) - lu(k,353) * lu(k,1895) + lu(k,2012) = lu(k,2012) - lu(k,354) * lu(k,1895) + lu(k,2028) = lu(k,2028) - lu(k,350) * lu(k,2021) + lu(k,2066) = lu(k,2066) - lu(k,351) * lu(k,2021) + lu(k,2067) = lu(k,2067) - lu(k,352) * lu(k,2021) + lu(k,2069) = lu(k,2069) - lu(k,353) * lu(k,2021) + lu(k,2072) = lu(k,2072) - lu(k,354) * lu(k,2021) + lu(k,356) = 1._r8 / lu(k,356) + lu(k,357) = lu(k,357) * lu(k,356) + lu(k,358) = lu(k,358) * lu(k,356) + lu(k,359) = lu(k,359) * lu(k,356) + lu(k,360) = lu(k,360) * lu(k,356) + lu(k,361) = lu(k,361) * lu(k,356) + lu(k,1823) = lu(k,1823) - lu(k,357) * lu(k,1818) + lu(k,1832) = lu(k,1832) - lu(k,358) * lu(k,1818) + lu(k,1833) = lu(k,1833) - lu(k,359) * lu(k,1818) + lu(k,1837) = lu(k,1837) - lu(k,360) * lu(k,1818) + lu(k,1844) = lu(k,1844) - lu(k,361) * lu(k,1818) + lu(k,1962) = lu(k,1962) - lu(k,357) * lu(k,1896) + lu(k,2005) = lu(k,2005) - lu(k,358) * lu(k,1896) + lu(k,2006) = lu(k,2006) - lu(k,359) * lu(k,1896) + lu(k,2010) = lu(k,2010) - lu(k,360) * lu(k,1896) + lu(k,2017) = lu(k,2017) - lu(k,361) * lu(k,1896) + lu(k,362) = 1._r8 / lu(k,362) + lu(k,363) = lu(k,363) * lu(k,362) + lu(k,364) = lu(k,364) * lu(k,362) + lu(k,365) = lu(k,365) * lu(k,362) + lu(k,366) = lu(k,366) * lu(k,362) + lu(k,1519) = lu(k,1519) - lu(k,363) * lu(k,1517) + lu(k,1520) = lu(k,1520) - lu(k,364) * lu(k,1517) + lu(k,1524) = lu(k,1524) - lu(k,365) * lu(k,1517) + lu(k,1532) = lu(k,1532) - lu(k,366) * lu(k,1517) + lu(k,1604) = lu(k,1604) - lu(k,363) * lu(k,1601) + lu(k,1605) = lu(k,1605) - lu(k,364) * lu(k,1601) + lu(k,1610) = lu(k,1610) - lu(k,365) * lu(k,1601) + lu(k,1621) = lu(k,1621) - lu(k,366) * lu(k,1601) + lu(k,1629) = lu(k,1629) - lu(k,363) * lu(k,1627) + lu(k,1631) = lu(k,1631) - lu(k,364) * lu(k,1627) + lu(k,1636) = lu(k,1636) - lu(k,365) * lu(k,1627) + lu(k,1648) = lu(k,1648) - lu(k,366) * lu(k,1627) + lu(k,367) = 1._r8 / lu(k,367) + lu(k,368) = lu(k,368) * lu(k,367) + lu(k,369) = lu(k,369) * lu(k,367) + lu(k,370) = lu(k,370) * lu(k,367) + lu(k,371) = lu(k,371) * lu(k,367) + lu(k,500) = lu(k,500) - lu(k,368) * lu(k,499) + lu(k,501) = lu(k,501) - lu(k,369) * lu(k,499) + lu(k,504) = - lu(k,370) * lu(k,499) + lu(k,505) = lu(k,505) - lu(k,371) * lu(k,499) + lu(k,1916) = lu(k,1916) - lu(k,368) * lu(k,1897) + lu(k,1970) = lu(k,1970) - lu(k,369) * lu(k,1897) + lu(k,2006) = lu(k,2006) - lu(k,370) * lu(k,1897) + lu(k,2009) = lu(k,2009) - lu(k,371) * lu(k,1897) + lu(k,2143) = lu(k,2143) - lu(k,368) * lu(k,2129) + lu(k,2179) = lu(k,2179) - lu(k,369) * lu(k,2129) + lu(k,2211) = lu(k,2211) - lu(k,370) * lu(k,2129) + lu(k,2214) = lu(k,2214) - lu(k,371) * lu(k,2129) + lu(k,373) = 1._r8 / lu(k,373) + lu(k,374) = lu(k,374) * lu(k,373) + lu(k,375) = lu(k,375) * lu(k,373) + lu(k,376) = lu(k,376) * lu(k,373) + lu(k,377) = lu(k,377) * lu(k,373) + lu(k,481) = lu(k,481) - lu(k,374) * lu(k,480) + lu(k,482) = lu(k,482) - lu(k,375) * lu(k,480) + lu(k,485) = lu(k,485) - lu(k,376) * lu(k,480) + lu(k,486) = lu(k,486) - lu(k,377) * lu(k,480) + lu(k,1914) = lu(k,1914) - lu(k,374) * lu(k,1898) + lu(k,1925) = lu(k,1925) - lu(k,375) * lu(k,1898) + lu(k,2006) = lu(k,2006) - lu(k,376) * lu(k,1898) + lu(k,2009) = lu(k,2009) - lu(k,377) * lu(k,1898) + lu(k,2141) = lu(k,2141) - lu(k,374) * lu(k,2130) + lu(k,2151) = lu(k,2151) - lu(k,375) * lu(k,2130) + lu(k,2211) = lu(k,2211) - lu(k,376) * lu(k,2130) + lu(k,2214) = lu(k,2214) - lu(k,377) * lu(k,2130) + lu(k,378) = 1._r8 / lu(k,378) + lu(k,379) = lu(k,379) * lu(k,378) + lu(k,380) = lu(k,380) * lu(k,378) + lu(k,381) = lu(k,381) * lu(k,378) + lu(k,382) = lu(k,382) * lu(k,378) + lu(k,950) = lu(k,950) - lu(k,379) * lu(k,948) + lu(k,951) = lu(k,951) - lu(k,380) * lu(k,948) + lu(k,955) = lu(k,955) - lu(k,381) * lu(k,948) + lu(k,956) = lu(k,956) - lu(k,382) * lu(k,948) + lu(k,1960) = lu(k,1960) - lu(k,379) * lu(k,1899) + lu(k,1978) = lu(k,1978) - lu(k,380) * lu(k,1899) + lu(k,2006) = lu(k,2006) - lu(k,381) * lu(k,1899) + lu(k,2009) = lu(k,2009) - lu(k,382) * lu(k,1899) + lu(k,2175) = lu(k,2175) - lu(k,379) * lu(k,2131) + lu(k,2185) = lu(k,2185) - lu(k,380) * lu(k,2131) + lu(k,2211) = lu(k,2211) - lu(k,381) * lu(k,2131) + lu(k,2214) = lu(k,2214) - lu(k,382) * lu(k,2131) + lu(k,383) = 1._r8 / lu(k,383) + lu(k,384) = lu(k,384) * lu(k,383) + lu(k,385) = lu(k,385) * lu(k,383) + lu(k,386) = lu(k,386) * lu(k,383) + lu(k,387) = lu(k,387) * lu(k,383) + lu(k,772) = - lu(k,384) * lu(k,763) + lu(k,773) = lu(k,773) - lu(k,385) * lu(k,763) + lu(k,774) = - lu(k,386) * lu(k,763) + lu(k,776) = lu(k,776) - lu(k,387) * lu(k,763) + lu(k,815) = - lu(k,384) * lu(k,806) + lu(k,816) = lu(k,816) - lu(k,385) * lu(k,806) + lu(k,817) = - lu(k,386) * lu(k,806) + lu(k,821) = lu(k,821) - lu(k,387) * lu(k,806) + lu(k,1766) = lu(k,1766) - lu(k,384) * lu(k,1722) + lu(k,1775) = lu(k,1775) - lu(k,385) * lu(k,1722) + lu(k,1781) = lu(k,1781) - lu(k,386) * lu(k,1722) + lu(k,1793) = lu(k,1793) - lu(k,387) * lu(k,1722) + 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,388) = 1._r8 / lu(k,388) + lu(k,389) = lu(k,389) * lu(k,388) + lu(k,390) = lu(k,390) * lu(k,388) + lu(k,391) = lu(k,391) * lu(k,388) + lu(k,392) = lu(k,392) * lu(k,388) + lu(k,721) = lu(k,721) - lu(k,389) * lu(k,720) + lu(k,722) = lu(k,722) - lu(k,390) * lu(k,720) + lu(k,723) = lu(k,723) - lu(k,391) * lu(k,720) + lu(k,726) = lu(k,726) - lu(k,392) * lu(k,720) + lu(k,1942) = lu(k,1942) - lu(k,389) * lu(k,1900) + lu(k,1978) = lu(k,1978) - lu(k,390) * lu(k,1900) + lu(k,1994) = lu(k,1994) - lu(k,391) * lu(k,1900) + lu(k,2006) = lu(k,2006) - lu(k,392) * lu(k,1900) + lu(k,2159) = lu(k,2159) - lu(k,389) * lu(k,2132) + lu(k,2185) = lu(k,2185) - lu(k,390) * lu(k,2132) + lu(k,2200) = lu(k,2200) - lu(k,391) * lu(k,2132) + lu(k,2211) = lu(k,2211) - lu(k,392) * lu(k,2132) + lu(k,393) = 1._r8 / lu(k,393) + lu(k,394) = lu(k,394) * lu(k,393) + lu(k,395) = lu(k,395) * lu(k,393) + lu(k,396) = lu(k,396) * lu(k,393) + lu(k,397) = lu(k,397) * lu(k,393) + lu(k,1400) = lu(k,1400) - lu(k,394) * lu(k,1392) + lu(k,1401) = - lu(k,395) * lu(k,1392) + lu(k,1406) = - lu(k,396) * lu(k,1392) + lu(k,1408) = lu(k,1408) - lu(k,397) * lu(k,1392) + lu(k,1991) = lu(k,1991) - lu(k,394) * lu(k,1901) + lu(k,1993) = lu(k,1993) - lu(k,395) * lu(k,1901) + lu(k,2006) = lu(k,2006) - lu(k,396) * lu(k,1901) + lu(k,2009) = lu(k,2009) - lu(k,397) * lu(k,1901) + lu(k,2197) = lu(k,2197) - lu(k,394) * lu(k,2133) + lu(k,2199) = lu(k,2199) - lu(k,395) * lu(k,2133) + lu(k,2211) = lu(k,2211) - lu(k,396) * lu(k,2133) + lu(k,2214) = lu(k,2214) - lu(k,397) * lu(k,2133) + lu(k,398) = 1._r8 / lu(k,398) + lu(k,399) = lu(k,399) * lu(k,398) + lu(k,400) = lu(k,400) * lu(k,398) + lu(k,1373) = lu(k,1373) - lu(k,399) * lu(k,1360) + lu(k,1384) = lu(k,1384) - lu(k,400) * lu(k,1360) + lu(k,1463) = lu(k,1463) - lu(k,399) * lu(k,1454) + lu(k,1477) = lu(k,1477) - lu(k,400) * lu(k,1454) + lu(k,1772) = lu(k,1772) - lu(k,399) * lu(k,1723) + lu(k,1790) = lu(k,1790) - lu(k,400) * lu(k,1723) + lu(k,1985) = lu(k,1985) - lu(k,399) * lu(k,1902) + lu(k,2006) = lu(k,2006) - lu(k,400) * lu(k,1902) + lu(k,2047) = lu(k,2047) - lu(k,399) * lu(k,2022) + lu(k,2066) = lu(k,2066) - lu(k,400) * lu(k,2022) + lu(k,2336) = lu(k,2336) - lu(k,399) * lu(k,2314) + lu(k,2353) = lu(k,2353) - lu(k,400) * lu(k,2314) + 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,408) = lu(k,408) * lu(k,401) + lu(k,1979) = lu(k,1979) - lu(k,402) * lu(k,1903) + lu(k,1998) = lu(k,1998) - lu(k,403) * lu(k,1903) + lu(k,2006) = lu(k,2006) - lu(k,404) * lu(k,1903) + lu(k,2009) = lu(k,2009) - lu(k,405) * lu(k,1903) + lu(k,2010) = lu(k,2010) - lu(k,406) * lu(k,1903) + lu(k,2013) = lu(k,2013) - lu(k,407) * lu(k,1903) + lu(k,2017) = lu(k,2017) - lu(k,408) * lu(k,1903) + lu(k,2242) = lu(k,2242) - lu(k,402) * lu(k,2227) + lu(k,2249) = lu(k,2249) - lu(k,403) * lu(k,2227) + lu(k,2257) = lu(k,2257) - lu(k,404) * lu(k,2227) + lu(k,2260) = lu(k,2260) - lu(k,405) * lu(k,2227) + lu(k,2261) = lu(k,2261) - lu(k,406) * lu(k,2227) + lu(k,2264) = lu(k,2264) - lu(k,407) * lu(k,2227) + lu(k,2268) = lu(k,2268) - lu(k,408) * lu(k,2227) + lu(k,409) = 1._r8 / lu(k,409) + lu(k,410) = lu(k,410) * lu(k,409) + lu(k,411) = lu(k,411) * lu(k,409) + lu(k,412) = lu(k,412) * lu(k,409) + lu(k,413) = lu(k,413) * lu(k,409) + lu(k,414) = lu(k,414) * lu(k,409) + lu(k,415) = lu(k,415) * lu(k,409) + lu(k,416) = lu(k,416) * lu(k,409) + lu(k,1929) = lu(k,1929) - lu(k,410) * lu(k,1904) + lu(k,1973) = lu(k,1973) - lu(k,411) * lu(k,1904) + lu(k,1978) = lu(k,1978) - lu(k,412) * lu(k,1904) + lu(k,2003) = lu(k,2003) - lu(k,413) * lu(k,1904) + lu(k,2006) = lu(k,2006) - lu(k,414) * lu(k,1904) + lu(k,2007) = lu(k,2007) - lu(k,415) * lu(k,1904) + lu(k,2016) = lu(k,2016) - lu(k,416) * lu(k,1904) + lu(k,2024) = - lu(k,410) * lu(k,2023) + lu(k,2035) = lu(k,2035) - lu(k,411) * lu(k,2023) + lu(k,2040) = lu(k,2040) - lu(k,412) * lu(k,2023) + lu(k,2063) = lu(k,2063) - lu(k,413) * lu(k,2023) + lu(k,2066) = lu(k,2066) - lu(k,414) * lu(k,2023) + lu(k,2067) = lu(k,2067) - lu(k,415) * lu(k,2023) + lu(k,2076) = lu(k,2076) - lu(k,416) * lu(k,2023) + lu(k,417) = 1._r8 / lu(k,417) + lu(k,418) = lu(k,418) * lu(k,417) + lu(k,419) = lu(k,419) * lu(k,417) + lu(k,420) = lu(k,420) * lu(k,417) + lu(k,421) = lu(k,421) * lu(k,417) + lu(k,422) = lu(k,422) * lu(k,417) + lu(k,423) = lu(k,423) * lu(k,417) + lu(k,424) = lu(k,424) * lu(k,417) + lu(k,1947) = lu(k,1947) - lu(k,418) * lu(k,1905) + lu(k,1964) = lu(k,1964) - lu(k,419) * lu(k,1905) + lu(k,1979) = lu(k,1979) - lu(k,420) * lu(k,1905) + lu(k,1997) = lu(k,1997) - lu(k,421) * lu(k,1905) + lu(k,2006) = lu(k,2006) - lu(k,422) * lu(k,1905) + lu(k,2011) = lu(k,2011) - lu(k,423) * lu(k,1905) + lu(k,2015) = lu(k,2015) - lu(k,424) * lu(k,1905) + lu(k,2437) = - lu(k,418) * lu(k,2431) + lu(k,2445) = - lu(k,419) * lu(k,2431) + lu(k,2448) = lu(k,2448) - lu(k,420) * lu(k,2431) + lu(k,2451) = lu(k,2451) - lu(k,421) * lu(k,2431) + lu(k,2460) = lu(k,2460) - lu(k,422) * lu(k,2431) + lu(k,2465) = lu(k,2465) - lu(k,423) * lu(k,2431) + lu(k,2469) = lu(k,2469) - lu(k,424) * lu(k,2431) + lu(k,425) = 1._r8 / lu(k,425) + lu(k,426) = lu(k,426) * lu(k,425) + lu(k,427) = lu(k,427) * lu(k,425) + lu(k,428) = lu(k,428) * lu(k,425) + lu(k,429) = lu(k,429) * lu(k,425) + lu(k,430) = lu(k,430) * lu(k,425) + lu(k,1261) = lu(k,1261) - lu(k,426) * lu(k,1258) + lu(k,1263) = lu(k,1263) - lu(k,427) * lu(k,1258) + lu(k,1266) = lu(k,1266) - lu(k,428) * lu(k,1258) + lu(k,1269) = lu(k,1269) - lu(k,429) * lu(k,1258) + lu(k,1270) = - lu(k,430) * lu(k,1258) + lu(k,1984) = lu(k,1984) - lu(k,426) * lu(k,1906) + lu(k,1994) = lu(k,1994) - lu(k,427) * lu(k,1906) + lu(k,2006) = lu(k,2006) - lu(k,428) * lu(k,1906) + lu(k,2016) = lu(k,2016) - lu(k,429) * lu(k,1906) + lu(k,2017) = lu(k,2017) - lu(k,430) * lu(k,1906) + lu(k,2190) = lu(k,2190) - lu(k,426) * lu(k,2134) + lu(k,2200) = lu(k,2200) - lu(k,427) * lu(k,2134) + lu(k,2211) = lu(k,2211) - lu(k,428) * lu(k,2134) + lu(k,2221) = lu(k,2221) - lu(k,429) * lu(k,2134) + lu(k,2222) = lu(k,2222) - lu(k,430) * lu(k,2134) + lu(k,431) = 1._r8 / lu(k,431) + lu(k,432) = lu(k,432) * lu(k,431) + lu(k,433) = lu(k,433) * lu(k,431) + lu(k,434) = lu(k,434) * lu(k,431) + lu(k,435) = lu(k,435) * lu(k,431) + lu(k,436) = lu(k,436) * lu(k,431) + lu(k,1149) = lu(k,1149) - lu(k,432) * lu(k,1146) + lu(k,1150) = lu(k,1150) - lu(k,433) * lu(k,1146) + lu(k,1154) = lu(k,1154) - lu(k,434) * lu(k,1146) + lu(k,1156) = - lu(k,435) * lu(k,1146) + lu(k,1159) = - lu(k,436) * lu(k,1146) + lu(k,1972) = lu(k,1972) - lu(k,432) * lu(k,1907) + lu(k,1975) = lu(k,1975) - lu(k,433) * lu(k,1907) + lu(k,2003) = lu(k,2003) - lu(k,434) * lu(k,1907) + lu(k,2006) = lu(k,2006) - lu(k,435) * lu(k,1907) + lu(k,2012) = lu(k,2012) - lu(k,436) * lu(k,1907) + lu(k,2181) = - lu(k,432) * lu(k,2135) + lu(k,2183) = lu(k,2183) - lu(k,433) * lu(k,2135) + lu(k,2208) = lu(k,2208) - lu(k,434) * lu(k,2135) + lu(k,2211) = lu(k,2211) - lu(k,435) * lu(k,2135) + lu(k,2217) = - lu(k,436) * lu(k,2135) + 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,437) = 1._r8 / lu(k,437) + lu(k,438) = lu(k,438) * lu(k,437) + lu(k,439) = lu(k,439) * lu(k,437) + lu(k,440) = lu(k,440) * lu(k,437) + lu(k,441) = lu(k,441) * lu(k,437) + lu(k,442) = lu(k,442) * lu(k,437) + lu(k,979) = lu(k,979) - lu(k,438) * lu(k,978) + lu(k,980) = lu(k,980) - lu(k,439) * lu(k,978) + lu(k,985) = - lu(k,440) * lu(k,978) + lu(k,986) = lu(k,986) - lu(k,441) * lu(k,978) + lu(k,989) = - lu(k,442) * lu(k,978) + lu(k,1963) = lu(k,1963) - lu(k,438) * lu(k,1908) + lu(k,1973) = lu(k,1973) - lu(k,439) * lu(k,1908) + lu(k,2006) = lu(k,2006) - lu(k,440) * lu(k,1908) + lu(k,2009) = lu(k,2009) - lu(k,441) * lu(k,1908) + lu(k,2017) = lu(k,2017) - lu(k,442) * lu(k,1908) + lu(k,2177) = lu(k,2177) - lu(k,438) * lu(k,2136) + lu(k,2182) = - lu(k,439) * lu(k,2136) + lu(k,2211) = lu(k,2211) - lu(k,440) * lu(k,2136) + lu(k,2214) = lu(k,2214) - lu(k,441) * lu(k,2136) + lu(k,2222) = lu(k,2222) - lu(k,442) * lu(k,2136) + lu(k,443) = 1._r8 / lu(k,443) + lu(k,444) = lu(k,444) * lu(k,443) + lu(k,445) = lu(k,445) * lu(k,443) + lu(k,446) = lu(k,446) * lu(k,443) + lu(k,447) = lu(k,447) * lu(k,443) + lu(k,448) = lu(k,448) * lu(k,443) + lu(k,1290) = - lu(k,444) * lu(k,1288) + lu(k,1292) = - lu(k,445) * lu(k,1288) + lu(k,1303) = lu(k,1303) - lu(k,446) * lu(k,1288) + lu(k,1305) = - lu(k,447) * lu(k,1288) + lu(k,1307) = lu(k,1307) - lu(k,448) * lu(k,1288) + lu(k,1945) = lu(k,1945) - lu(k,444) * lu(k,1909) + lu(k,1958) = lu(k,1958) - lu(k,445) * lu(k,1909) + lu(k,2003) = lu(k,2003) - lu(k,446) * lu(k,1909) + lu(k,2006) = lu(k,2006) - lu(k,447) * lu(k,1909) + lu(k,2009) = lu(k,2009) - lu(k,448) * lu(k,1909) + lu(k,2162) = lu(k,2162) - lu(k,444) * lu(k,2137) + lu(k,2173) = - lu(k,445) * lu(k,2137) + lu(k,2208) = lu(k,2208) - lu(k,446) * lu(k,2137) + lu(k,2211) = lu(k,2211) - lu(k,447) * lu(k,2137) + lu(k,2214) = lu(k,2214) - lu(k,448) * lu(k,2137) + lu(k,449) = 1._r8 / lu(k,449) + lu(k,450) = lu(k,450) * lu(k,449) + lu(k,451) = lu(k,451) * lu(k,449) + lu(k,452) = lu(k,452) * lu(k,449) + lu(k,453) = lu(k,453) * lu(k,449) + lu(k,454) = lu(k,454) * lu(k,449) + lu(k,540) = lu(k,540) - lu(k,450) * lu(k,539) + lu(k,541) = lu(k,541) - lu(k,451) * lu(k,539) + lu(k,543) = lu(k,543) - lu(k,452) * lu(k,539) + lu(k,546) = - lu(k,453) * lu(k,539) + lu(k,547) = lu(k,547) - lu(k,454) * lu(k,539) + lu(k,1917) = lu(k,1917) - lu(k,450) * lu(k,1910) + lu(k,1922) = lu(k,1922) - lu(k,451) * lu(k,1910) + lu(k,1970) = lu(k,1970) - lu(k,452) * lu(k,1910) + lu(k,2006) = lu(k,2006) - lu(k,453) * lu(k,1910) + lu(k,2009) = lu(k,2009) - lu(k,454) * lu(k,1910) + lu(k,2144) = - lu(k,450) * lu(k,2138) + lu(k,2149) = lu(k,2149) - lu(k,451) * lu(k,2138) + lu(k,2179) = lu(k,2179) - lu(k,452) * lu(k,2138) + lu(k,2211) = lu(k,2211) - lu(k,453) * lu(k,2138) + lu(k,2214) = lu(k,2214) - lu(k,454) * lu(k,2138) + lu(k,455) = 1._r8 / lu(k,455) + lu(k,456) = lu(k,456) * lu(k,455) + lu(k,457) = lu(k,457) * lu(k,455) + lu(k,458) = lu(k,458) * lu(k,455) + lu(k,459) = lu(k,459) * lu(k,455) + lu(k,460) = lu(k,460) * lu(k,455) + lu(k,2006) = lu(k,2006) - lu(k,456) * lu(k,1911) + lu(k,2011) = lu(k,2011) - lu(k,457) * lu(k,1911) + lu(k,2013) = lu(k,2013) - lu(k,458) * lu(k,1911) + lu(k,2016) = lu(k,2016) - lu(k,459) * lu(k,1911) + lu(k,2017) = lu(k,2017) - lu(k,460) * lu(k,1911) + lu(k,2211) = lu(k,2211) - lu(k,456) * lu(k,2139) + lu(k,2216) = lu(k,2216) - lu(k,457) * lu(k,2139) + lu(k,2218) = lu(k,2218) - lu(k,458) * lu(k,2139) + lu(k,2221) = lu(k,2221) - lu(k,459) * lu(k,2139) + lu(k,2222) = lu(k,2222) - lu(k,460) * lu(k,2139) + lu(k,2353) = lu(k,2353) - lu(k,456) * lu(k,2315) + lu(k,2358) = - lu(k,457) * lu(k,2315) + lu(k,2360) = lu(k,2360) - lu(k,458) * lu(k,2315) + lu(k,2363) = lu(k,2363) - lu(k,459) * lu(k,2315) + lu(k,2364) = - lu(k,460) * lu(k,2315) + lu(k,461) = 1._r8 / lu(k,461) + lu(k,462) = lu(k,462) * lu(k,461) + lu(k,463) = lu(k,463) * lu(k,461) + lu(k,464) = lu(k,464) * lu(k,461) + lu(k,465) = lu(k,465) * lu(k,461) + lu(k,466) = lu(k,466) * lu(k,461) + lu(k,1825) = lu(k,1825) - lu(k,462) * lu(k,1819) + lu(k,1826) = lu(k,1826) - lu(k,463) * lu(k,1819) + lu(k,1832) = lu(k,1832) - lu(k,464) * lu(k,1819) + lu(k,1833) = lu(k,1833) - lu(k,465) * lu(k,1819) + lu(k,1837) = lu(k,1837) - lu(k,466) * lu(k,1819) + lu(k,1998) = lu(k,1998) - lu(k,462) * lu(k,1912) + lu(k,1999) = lu(k,1999) - lu(k,463) * lu(k,1912) + lu(k,2005) = lu(k,2005) - lu(k,464) * lu(k,1912) + lu(k,2006) = lu(k,2006) - lu(k,465) * lu(k,1912) + lu(k,2010) = lu(k,2010) - lu(k,466) * lu(k,1912) + lu(k,2249) = lu(k,2249) - lu(k,462) * lu(k,2228) + lu(k,2250) = lu(k,2250) - lu(k,463) * lu(k,2228) + lu(k,2256) = - lu(k,464) * lu(k,2228) + lu(k,2257) = lu(k,2257) - lu(k,465) * lu(k,2228) + lu(k,2261) = lu(k,2261) - lu(k,466) * lu(k,2228) + 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,1008) = - lu(k,468) * lu(k,1004) + lu(k,1014) = lu(k,1014) - lu(k,469) * lu(k,1004) + lu(k,1016) = - lu(k,470) * lu(k,1004) + lu(k,1017) = lu(k,1017) - lu(k,471) * lu(k,1004) + lu(k,1021) = lu(k,1021) - lu(k,472) * lu(k,1004) + lu(k,1064) = - lu(k,468) * lu(k,1060) + lu(k,1070) = lu(k,1070) - lu(k,469) * lu(k,1060) + lu(k,1072) = - lu(k,470) * lu(k,1060) + lu(k,1073) = lu(k,1073) - lu(k,471) * lu(k,1060) + lu(k,1077) = lu(k,1077) - lu(k,472) * lu(k,1060) + lu(k,2386) = - lu(k,468) * lu(k,2373) + lu(k,2394) = lu(k,2394) - lu(k,469) * lu(k,2373) + lu(k,2401) = lu(k,2401) - lu(k,470) * lu(k,2373) + lu(k,2407) = lu(k,2407) - lu(k,471) * lu(k,2373) + lu(k,2420) = lu(k,2420) - lu(k,472) * lu(k,2373) + 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,473) = 1._r8 / lu(k,473) + lu(k,474) = lu(k,474) * lu(k,473) + lu(k,475) = lu(k,475) * lu(k,473) + lu(k,476) = lu(k,476) * lu(k,473) + lu(k,477) = lu(k,477) * lu(k,473) + lu(k,478) = lu(k,478) * lu(k,473) + lu(k,556) = lu(k,556) - lu(k,474) * lu(k,555) + lu(k,557) = lu(k,557) - lu(k,475) * lu(k,555) + lu(k,558) = lu(k,558) - lu(k,476) * lu(k,555) + lu(k,561) = - lu(k,477) * lu(k,555) + lu(k,562) = lu(k,562) - lu(k,478) * lu(k,555) + lu(k,1923) = lu(k,1923) - lu(k,474) * lu(k,1913) + lu(k,1970) = lu(k,1970) - lu(k,475) * lu(k,1913) + lu(k,1988) = lu(k,1988) - lu(k,476) * lu(k,1913) + lu(k,2006) = lu(k,2006) - lu(k,477) * lu(k,1913) + lu(k,2009) = lu(k,2009) - lu(k,478) * lu(k,1913) + lu(k,2150) = lu(k,2150) - lu(k,474) * lu(k,2140) + lu(k,2179) = lu(k,2179) - lu(k,475) * lu(k,2140) + lu(k,2194) = lu(k,2194) - lu(k,476) * lu(k,2140) + lu(k,2211) = lu(k,2211) - lu(k,477) * lu(k,2140) + lu(k,2214) = lu(k,2214) - lu(k,478) * lu(k,2140) + lu(k,481) = 1._r8 / lu(k,481) + lu(k,482) = lu(k,482) * lu(k,481) + lu(k,483) = lu(k,483) * lu(k,481) + lu(k,484) = lu(k,484) * lu(k,481) + lu(k,485) = lu(k,485) * lu(k,481) + lu(k,486) = lu(k,486) * lu(k,481) + lu(k,1733) = lu(k,1733) - lu(k,482) * lu(k,1724) + lu(k,1787) = lu(k,1787) - lu(k,483) * lu(k,1724) + lu(k,1788) = lu(k,1788) - lu(k,484) * lu(k,1724) + lu(k,1790) = lu(k,1790) - lu(k,485) * lu(k,1724) + lu(k,1793) = lu(k,1793) - lu(k,486) * lu(k,1724) + lu(k,1925) = lu(k,1925) - lu(k,482) * lu(k,1914) + lu(k,2003) = lu(k,2003) - lu(k,483) * lu(k,1914) + lu(k,2004) = lu(k,2004) - lu(k,484) * lu(k,1914) + lu(k,2006) = lu(k,2006) - lu(k,485) * lu(k,1914) + lu(k,2009) = lu(k,2009) - lu(k,486) * lu(k,1914) + lu(k,2151) = lu(k,2151) - lu(k,482) * lu(k,2141) + lu(k,2208) = lu(k,2208) - lu(k,483) * lu(k,2141) + lu(k,2209) = lu(k,2209) - lu(k,484) * lu(k,2141) + lu(k,2211) = lu(k,2211) - lu(k,485) * lu(k,2141) + lu(k,2214) = lu(k,2214) - lu(k,486) * lu(k,2141) + lu(k,487) = 1._r8 / lu(k,487) + lu(k,488) = lu(k,488) * lu(k,487) + lu(k,489) = lu(k,489) * lu(k,487) + lu(k,490) = lu(k,490) * lu(k,487) + lu(k,491) = lu(k,491) * lu(k,487) + lu(k,492) = lu(k,492) * lu(k,487) + lu(k,1752) = lu(k,1752) - lu(k,488) * lu(k,1725) + lu(k,1787) = lu(k,1787) - lu(k,489) * lu(k,1725) + lu(k,1788) = lu(k,1788) - lu(k,490) * lu(k,1725) + lu(k,1793) = lu(k,1793) - lu(k,491) * lu(k,1725) + lu(k,1800) = lu(k,1800) - lu(k,492) * lu(k,1725) + lu(k,2174) = lu(k,2174) - lu(k,488) * lu(k,2142) + lu(k,2208) = lu(k,2208) - lu(k,489) * lu(k,2142) + lu(k,2209) = lu(k,2209) - lu(k,490) * lu(k,2142) + lu(k,2214) = lu(k,2214) - lu(k,491) * lu(k,2142) + lu(k,2221) = lu(k,2221) - lu(k,492) * lu(k,2142) + lu(k,2474) = - lu(k,488) * lu(k,2472) + lu(k,2483) = - lu(k,489) * lu(k,2472) + lu(k,2484) = - lu(k,490) * lu(k,2472) + lu(k,2489) = lu(k,2489) - lu(k,491) * lu(k,2472) + lu(k,2496) = lu(k,2496) - lu(k,492) * lu(k,2472) + lu(k,493) = 1._r8 / lu(k,493) + lu(k,494) = lu(k,494) * lu(k,493) + lu(k,495) = lu(k,495) * lu(k,493) + lu(k,496) = lu(k,496) * lu(k,493) + lu(k,497) = lu(k,497) * lu(k,493) + lu(k,498) = lu(k,498) * lu(k,493) + lu(k,1292) = lu(k,1292) - lu(k,494) * lu(k,1289) + lu(k,1295) = - lu(k,495) * lu(k,1289) + lu(k,1305) = lu(k,1305) - lu(k,496) * lu(k,1289) + lu(k,1307) = lu(k,1307) - lu(k,497) * lu(k,1289) + lu(k,1308) = - lu(k,498) * lu(k,1289) + lu(k,1958) = lu(k,1958) - lu(k,494) * lu(k,1915) + lu(k,1980) = lu(k,1980) - lu(k,495) * lu(k,1915) + lu(k,2006) = lu(k,2006) - lu(k,496) * lu(k,1915) + lu(k,2009) = lu(k,2009) - lu(k,497) * lu(k,1915) + lu(k,2012) = lu(k,2012) - lu(k,498) * lu(k,1915) + lu(k,2320) = - lu(k,494) * lu(k,2316) + lu(k,2332) = lu(k,2332) - lu(k,495) * lu(k,2316) + lu(k,2353) = lu(k,2353) - lu(k,496) * lu(k,2316) + lu(k,2356) = lu(k,2356) - lu(k,497) * lu(k,2316) + lu(k,2359) = - lu(k,498) * lu(k,2316) + lu(k,500) = 1._r8 / lu(k,500) + lu(k,501) = lu(k,501) * lu(k,500) + lu(k,502) = lu(k,502) * lu(k,500) + lu(k,503) = lu(k,503) * lu(k,500) + lu(k,504) = lu(k,504) * lu(k,500) + lu(k,505) = lu(k,505) * lu(k,500) + lu(k,1758) = lu(k,1758) - lu(k,501) * lu(k,1726) + lu(k,1787) = lu(k,1787) - lu(k,502) * lu(k,1726) + lu(k,1788) = lu(k,1788) - lu(k,503) * lu(k,1726) + lu(k,1790) = lu(k,1790) - lu(k,504) * lu(k,1726) + lu(k,1793) = lu(k,1793) - lu(k,505) * lu(k,1726) + lu(k,1970) = lu(k,1970) - lu(k,501) * lu(k,1916) + lu(k,2003) = lu(k,2003) - lu(k,502) * lu(k,1916) + lu(k,2004) = lu(k,2004) - lu(k,503) * lu(k,1916) + lu(k,2006) = lu(k,2006) - lu(k,504) * lu(k,1916) + lu(k,2009) = lu(k,2009) - lu(k,505) * lu(k,1916) + lu(k,2179) = lu(k,2179) - lu(k,501) * lu(k,2143) + lu(k,2208) = lu(k,2208) - lu(k,502) * lu(k,2143) + lu(k,2209) = lu(k,2209) - lu(k,503) * lu(k,2143) + lu(k,2211) = lu(k,2211) - lu(k,504) * lu(k,2143) + lu(k,2214) = lu(k,2214) - lu(k,505) * lu(k,2143) + lu(k,506) = 1._r8 / lu(k,506) + lu(k,507) = lu(k,507) * lu(k,506) + lu(k,508) = lu(k,508) * lu(k,506) + lu(k,542) = - lu(k,507) * lu(k,540) + lu(k,547) = lu(k,547) - lu(k,508) * lu(k,540) + lu(k,664) = - lu(k,507) * lu(k,661) + lu(k,670) = lu(k,670) - lu(k,508) * lu(k,661) + lu(k,767) = - lu(k,507) * lu(k,764) + lu(k,776) = lu(k,776) - lu(k,508) * lu(k,764) + lu(k,794) = - lu(k,507) * lu(k,791) + lu(k,804) = lu(k,804) - lu(k,508) * lu(k,791) + lu(k,810) = - lu(k,507) * lu(k,807) + lu(k,821) = lu(k,821) - lu(k,508) * lu(k,807) + lu(k,1742) = lu(k,1742) - lu(k,507) * lu(k,1727) + lu(k,1793) = lu(k,1793) - lu(k,508) * lu(k,1727) + lu(k,1948) = - lu(k,507) * lu(k,1917) + lu(k,2009) = lu(k,2009) - lu(k,508) * lu(k,1917) + lu(k,2164) = lu(k,2164) - lu(k,507) * lu(k,2144) + lu(k,2214) = lu(k,2214) - lu(k,508) * lu(k,2144) + lu(k,509) = 1._r8 / lu(k,509) + lu(k,510) = lu(k,510) * lu(k,509) + lu(k,511) = lu(k,511) * lu(k,509) + lu(k,512) = lu(k,512) * lu(k,509) + lu(k,513) = lu(k,513) * lu(k,509) + lu(k,833) = - lu(k,510) * lu(k,831) + lu(k,834) = - lu(k,511) * lu(k,831) + lu(k,838) = lu(k,838) - lu(k,512) * lu(k,831) + lu(k,839) = lu(k,839) - lu(k,513) * lu(k,831) + lu(k,1582) = lu(k,1582) - lu(k,510) * lu(k,1570) + lu(k,1586) = lu(k,1586) - lu(k,511) * lu(k,1570) + lu(k,1593) = lu(k,1593) - lu(k,512) * lu(k,1570) + lu(k,1598) = - lu(k,513) * lu(k,1570) + lu(k,1767) = lu(k,1767) - lu(k,510) * lu(k,1728) + lu(k,1784) = lu(k,1784) - lu(k,511) * lu(k,1728) + lu(k,1793) = lu(k,1793) - lu(k,512) * lu(k,1728) + lu(k,1800) = lu(k,1800) - lu(k,513) * lu(k,1728) + lu(k,2187) = - lu(k,510) * lu(k,2145) + lu(k,2205) = lu(k,2205) - lu(k,511) * lu(k,2145) + lu(k,2214) = lu(k,2214) - lu(k,512) * lu(k,2145) + lu(k,2221) = lu(k,2221) - lu(k,513) * lu(k,2145) + 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,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,1825) = lu(k,1825) - lu(k,515) * lu(k,1820) + lu(k,1826) = lu(k,1826) - lu(k,516) * lu(k,1820) + lu(k,1832) = lu(k,1832) - lu(k,517) * lu(k,1820) + lu(k,1833) = lu(k,1833) - lu(k,518) * lu(k,1820) + lu(k,1837) = lu(k,1837) - lu(k,519) * lu(k,1820) + lu(k,1844) = lu(k,1844) - lu(k,520) * lu(k,1820) + lu(k,1998) = lu(k,1998) - lu(k,515) * lu(k,1918) + lu(k,1999) = lu(k,1999) - lu(k,516) * lu(k,1918) + lu(k,2005) = lu(k,2005) - lu(k,517) * lu(k,1918) + lu(k,2006) = lu(k,2006) - lu(k,518) * lu(k,1918) + lu(k,2010) = lu(k,2010) - lu(k,519) * lu(k,1918) + lu(k,2017) = lu(k,2017) - lu(k,520) * lu(k,1918) + lu(k,2249) = lu(k,2249) - lu(k,515) * lu(k,2229) + lu(k,2250) = lu(k,2250) - lu(k,516) * lu(k,2229) + lu(k,2256) = lu(k,2256) - lu(k,517) * lu(k,2229) + lu(k,2257) = lu(k,2257) - lu(k,518) * lu(k,2229) + lu(k,2261) = lu(k,2261) - lu(k,519) * lu(k,2229) + lu(k,2268) = lu(k,2268) - lu(k,520) * lu(k,2229) + lu(k,521) = 1._r8 / lu(k,521) + lu(k,522) = lu(k,522) * lu(k,521) + lu(k,523) = lu(k,523) * lu(k,521) + lu(k,524) = lu(k,524) * lu(k,521) + lu(k,525) = lu(k,525) * lu(k,521) + lu(k,526) = lu(k,526) * lu(k,521) + lu(k,527) = lu(k,527) * lu(k,521) + lu(k,1678) = lu(k,1678) - lu(k,522) * lu(k,1654) + lu(k,1681) = lu(k,1681) - lu(k,523) * lu(k,1654) + lu(k,1684) = lu(k,1684) - lu(k,524) * lu(k,1654) + lu(k,1685) = lu(k,1685) - lu(k,525) * lu(k,1654) + lu(k,1687) = lu(k,1687) - lu(k,526) * lu(k,1654) + lu(k,1695) = - lu(k,527) * lu(k,1654) + lu(k,2000) = lu(k,2000) - lu(k,522) * lu(k,1919) + lu(k,2003) = lu(k,2003) - lu(k,523) * lu(k,1919) + lu(k,2006) = lu(k,2006) - lu(k,524) * lu(k,1919) + lu(k,2007) = lu(k,2007) - lu(k,525) * lu(k,1919) + lu(k,2009) = lu(k,2009) - lu(k,526) * lu(k,1919) + lu(k,2017) = lu(k,2017) - lu(k,527) * lu(k,1919) + lu(k,2205) = lu(k,2205) - lu(k,522) * lu(k,2146) + lu(k,2208) = lu(k,2208) - lu(k,523) * lu(k,2146) + lu(k,2211) = lu(k,2211) - lu(k,524) * lu(k,2146) + lu(k,2212) = lu(k,2212) - lu(k,525) * lu(k,2146) + lu(k,2214) = lu(k,2214) - lu(k,526) * lu(k,2146) + lu(k,2222) = lu(k,2222) - lu(k,527) * lu(k,2146) + lu(k,528) = 1._r8 / lu(k,528) + lu(k,529) = lu(k,529) * lu(k,528) + lu(k,530) = lu(k,530) * lu(k,528) + lu(k,531) = lu(k,531) * lu(k,528) + lu(k,532) = lu(k,532) * lu(k,528) + lu(k,533) = lu(k,533) * lu(k,528) + lu(k,534) = lu(k,534) * lu(k,528) + lu(k,1106) = lu(k,1106) - lu(k,529) * lu(k,1103) + lu(k,1107) = lu(k,1107) - lu(k,530) * lu(k,1103) + lu(k,1108) = lu(k,1108) - lu(k,531) * lu(k,1103) + lu(k,1111) = - lu(k,532) * lu(k,1103) + lu(k,1112) = lu(k,1112) - lu(k,533) * lu(k,1103) + lu(k,1115) = lu(k,1115) - lu(k,534) * lu(k,1103) + lu(k,1971) = lu(k,1971) - lu(k,529) * lu(k,1920) + lu(k,1972) = lu(k,1972) - lu(k,530) * lu(k,1920) + lu(k,1973) = lu(k,1973) - lu(k,531) * lu(k,1920) + lu(k,2006) = lu(k,2006) - lu(k,532) * lu(k,1920) + lu(k,2009) = lu(k,2009) - lu(k,533) * lu(k,1920) + lu(k,2016) = lu(k,2016) - lu(k,534) * lu(k,1920) + lu(k,2180) = lu(k,2180) - lu(k,529) * lu(k,2147) + lu(k,2181) = lu(k,2181) - lu(k,530) * lu(k,2147) + lu(k,2182) = lu(k,2182) - lu(k,531) * lu(k,2147) + lu(k,2211) = lu(k,2211) - lu(k,532) * lu(k,2147) + lu(k,2214) = lu(k,2214) - lu(k,533) * lu(k,2147) + lu(k,2221) = lu(k,2221) - lu(k,534) * lu(k,2147) + lu(k,535) = 1._r8 / lu(k,535) + lu(k,536) = lu(k,536) * lu(k,535) + lu(k,537) = lu(k,537) * lu(k,535) + lu(k,538) = lu(k,538) * lu(k,535) + lu(k,692) = lu(k,692) - lu(k,536) * lu(k,691) + lu(k,693) = lu(k,693) - lu(k,537) * lu(k,691) + lu(k,697) = - lu(k,538) * lu(k,691) + lu(k,1660) = - lu(k,536) * lu(k,1655) + lu(k,1681) = lu(k,1681) - lu(k,537) * lu(k,1655) + lu(k,1692) = lu(k,1692) - lu(k,538) * lu(k,1655) + lu(k,1739) = lu(k,1739) - lu(k,536) * lu(k,1729) + lu(k,1787) = lu(k,1787) - lu(k,537) * lu(k,1729) + lu(k,1798) = lu(k,1798) - lu(k,538) * lu(k,1729) + lu(k,1939) = lu(k,1939) - lu(k,536) * lu(k,1921) + lu(k,2003) = lu(k,2003) - lu(k,537) * lu(k,1921) + lu(k,2014) = lu(k,2014) - lu(k,538) * lu(k,1921) + lu(k,2157) = lu(k,2157) - lu(k,536) * lu(k,2148) + lu(k,2208) = lu(k,2208) - lu(k,537) * lu(k,2148) + lu(k,2219) = lu(k,2219) - lu(k,538) * lu(k,2148) + lu(k,2376) = lu(k,2376) - lu(k,536) * lu(k,2374) + lu(k,2414) = lu(k,2414) - lu(k,537) * lu(k,2374) + lu(k,2425) = lu(k,2425) - lu(k,538) * lu(k,2374) + lu(k,541) = 1._r8 / lu(k,541) + lu(k,542) = lu(k,542) * lu(k,541) + lu(k,543) = lu(k,543) * lu(k,541) + lu(k,544) = lu(k,544) * lu(k,541) + lu(k,545) = lu(k,545) * lu(k,541) + lu(k,546) = lu(k,546) * lu(k,541) + lu(k,547) = lu(k,547) * lu(k,541) + lu(k,1742) = lu(k,1742) - lu(k,542) * lu(k,1730) + lu(k,1758) = lu(k,1758) - lu(k,543) * lu(k,1730) + lu(k,1787) = lu(k,1787) - lu(k,544) * lu(k,1730) + lu(k,1788) = lu(k,1788) - lu(k,545) * lu(k,1730) + lu(k,1790) = lu(k,1790) - lu(k,546) * lu(k,1730) + lu(k,1793) = lu(k,1793) - lu(k,547) * lu(k,1730) + lu(k,1948) = lu(k,1948) - lu(k,542) * lu(k,1922) + lu(k,1970) = lu(k,1970) - lu(k,543) * lu(k,1922) + lu(k,2003) = lu(k,2003) - lu(k,544) * lu(k,1922) + lu(k,2004) = lu(k,2004) - lu(k,545) * lu(k,1922) + lu(k,2006) = lu(k,2006) - lu(k,546) * lu(k,1922) + lu(k,2009) = lu(k,2009) - lu(k,547) * lu(k,1922) + lu(k,2164) = lu(k,2164) - lu(k,542) * lu(k,2149) + lu(k,2179) = lu(k,2179) - lu(k,543) * lu(k,2149) + lu(k,2208) = lu(k,2208) - lu(k,544) * lu(k,2149) + lu(k,2209) = lu(k,2209) - lu(k,545) * lu(k,2149) + lu(k,2211) = lu(k,2211) - lu(k,546) * lu(k,2149) + lu(k,2214) = lu(k,2214) - lu(k,547) * lu(k,2149) + lu(k,548) = 1._r8 / lu(k,548) + lu(k,549) = lu(k,549) * lu(k,548) + lu(k,550) = lu(k,550) * lu(k,548) + lu(k,551) = lu(k,551) * lu(k,548) + lu(k,552) = lu(k,552) * lu(k,548) + lu(k,553) = lu(k,553) * lu(k,548) + lu(k,554) = lu(k,554) * lu(k,548) + lu(k,1039) = - lu(k,549) * lu(k,1038) + lu(k,1040) = lu(k,1040) - lu(k,550) * lu(k,1038) + lu(k,1041) = lu(k,1041) - lu(k,551) * lu(k,1038) + lu(k,1043) = lu(k,1043) - lu(k,552) * lu(k,1038) + lu(k,1046) = lu(k,1046) - lu(k,553) * lu(k,1038) + lu(k,1052) = lu(k,1052) - lu(k,554) * lu(k,1038) + lu(k,1575) = lu(k,1575) - lu(k,549) * lu(k,1571) + lu(k,1576) = lu(k,1576) - lu(k,550) * lu(k,1571) + lu(k,1577) = lu(k,1577) - lu(k,551) * lu(k,1571) + lu(k,1580) = lu(k,1580) - lu(k,552) * lu(k,1571) + lu(k,1586) = lu(k,1586) - lu(k,553) * lu(k,1571) + lu(k,1597) = lu(k,1597) - lu(k,554) * lu(k,1571) + lu(k,2439) = lu(k,2439) - lu(k,549) * lu(k,2432) + lu(k,2442) = lu(k,2442) - lu(k,550) * lu(k,2432) + lu(k,2443) = - lu(k,551) * lu(k,2432) + lu(k,2447) = lu(k,2447) - lu(k,552) * lu(k,2432) + lu(k,2454) = lu(k,2454) - lu(k,553) * lu(k,2432) + lu(k,2469) = lu(k,2469) - lu(k,554) * lu(k,2432) + lu(k,556) = 1._r8 / lu(k,556) + lu(k,557) = lu(k,557) * lu(k,556) + lu(k,558) = lu(k,558) * lu(k,556) + lu(k,559) = lu(k,559) * lu(k,556) + lu(k,560) = lu(k,560) * lu(k,556) + lu(k,561) = lu(k,561) * lu(k,556) + lu(k,562) = lu(k,562) * lu(k,556) + lu(k,1758) = lu(k,1758) - lu(k,557) * lu(k,1731) + lu(k,1775) = lu(k,1775) - lu(k,558) * lu(k,1731) + lu(k,1787) = lu(k,1787) - lu(k,559) * lu(k,1731) + lu(k,1788) = lu(k,1788) - lu(k,560) * lu(k,1731) + lu(k,1790) = lu(k,1790) - lu(k,561) * lu(k,1731) + lu(k,1793) = lu(k,1793) - lu(k,562) * lu(k,1731) + lu(k,1970) = lu(k,1970) - lu(k,557) * lu(k,1923) + lu(k,1988) = lu(k,1988) - lu(k,558) * lu(k,1923) + lu(k,2003) = lu(k,2003) - lu(k,559) * lu(k,1923) + lu(k,2004) = lu(k,2004) - lu(k,560) * lu(k,1923) + lu(k,2006) = lu(k,2006) - lu(k,561) * lu(k,1923) + lu(k,2009) = lu(k,2009) - lu(k,562) * lu(k,1923) + lu(k,2179) = lu(k,2179) - lu(k,557) * lu(k,2150) + lu(k,2194) = lu(k,2194) - lu(k,558) * lu(k,2150) + lu(k,2208) = lu(k,2208) - lu(k,559) * lu(k,2150) + lu(k,2209) = lu(k,2209) - lu(k,560) * lu(k,2150) + lu(k,2211) = lu(k,2211) - lu(k,561) * lu(k,2150) + lu(k,2214) = lu(k,2214) - lu(k,562) * lu(k,2150) + 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,563) = 1._r8 / lu(k,563) + lu(k,564) = lu(k,564) * lu(k,563) + lu(k,565) = lu(k,565) * lu(k,563) + lu(k,566) = lu(k,566) * lu(k,563) + lu(k,567) = lu(k,567) * lu(k,563) + lu(k,700) = - lu(k,564) * lu(k,698) + lu(k,701) = - lu(k,565) * lu(k,698) + lu(k,704) = - lu(k,566) * lu(k,698) + lu(k,706) = lu(k,706) - lu(k,567) * lu(k,698) + lu(k,711) = - lu(k,564) * lu(k,709) + lu(k,712) = - lu(k,565) * lu(k,709) + lu(k,716) = - lu(k,566) * lu(k,709) + lu(k,717) = lu(k,717) - lu(k,567) * lu(k,709) + lu(k,1084) = - lu(k,564) * lu(k,1081) + lu(k,1085) = - lu(k,565) * lu(k,1081) + lu(k,1089) = - lu(k,566) * lu(k,1081) + lu(k,1093) = - lu(k,567) * lu(k,1081) + lu(k,1741) = lu(k,1741) - lu(k,564) * lu(k,1732) + lu(k,1753) = lu(k,1753) - lu(k,565) * lu(k,1732) + lu(k,1781) = lu(k,1781) - lu(k,566) * lu(k,1732) + lu(k,1790) = lu(k,1790) - lu(k,567) * lu(k,1732) + lu(k,1942) = lu(k,1942) - lu(k,564) * lu(k,1924) + lu(k,1960) = lu(k,1960) - lu(k,565) * lu(k,1924) + lu(k,1994) = lu(k,1994) - lu(k,566) * lu(k,1924) + lu(k,2006) = lu(k,2006) - lu(k,567) * lu(k,1924) + lu(k,569) = 1._r8 / lu(k,569) + lu(k,570) = lu(k,570) * lu(k,569) + lu(k,571) = lu(k,571) * lu(k,569) + lu(k,572) = lu(k,572) * lu(k,569) + lu(k,573) = lu(k,573) * lu(k,569) + lu(k,574) = lu(k,574) * lu(k,569) + lu(k,1660) = lu(k,1660) - lu(k,570) * lu(k,1656) + lu(k,1681) = lu(k,1681) - lu(k,571) * lu(k,1656) + lu(k,1682) = lu(k,1682) - lu(k,572) * lu(k,1656) + lu(k,1684) = lu(k,1684) - lu(k,573) * lu(k,1656) + lu(k,1687) = lu(k,1687) - lu(k,574) * lu(k,1656) + lu(k,1739) = lu(k,1739) - lu(k,570) * lu(k,1733) + lu(k,1787) = lu(k,1787) - lu(k,571) * lu(k,1733) + lu(k,1788) = lu(k,1788) - lu(k,572) * lu(k,1733) + lu(k,1790) = lu(k,1790) - lu(k,573) * lu(k,1733) + lu(k,1793) = lu(k,1793) - lu(k,574) * lu(k,1733) + lu(k,1939) = lu(k,1939) - lu(k,570) * lu(k,1925) + lu(k,2003) = lu(k,2003) - lu(k,571) * lu(k,1925) + lu(k,2004) = lu(k,2004) - lu(k,572) * lu(k,1925) + lu(k,2006) = lu(k,2006) - lu(k,573) * lu(k,1925) + lu(k,2009) = lu(k,2009) - lu(k,574) * lu(k,1925) + lu(k,2157) = lu(k,2157) - lu(k,570) * lu(k,2151) + lu(k,2208) = lu(k,2208) - lu(k,571) * lu(k,2151) + lu(k,2209) = lu(k,2209) - lu(k,572) * lu(k,2151) + lu(k,2211) = lu(k,2211) - lu(k,573) * lu(k,2151) + lu(k,2214) = lu(k,2214) - lu(k,574) * lu(k,2151) + lu(k,575) = 1._r8 / lu(k,575) + lu(k,576) = lu(k,576) * lu(k,575) + lu(k,577) = lu(k,577) * lu(k,575) + lu(k,578) = lu(k,578) * lu(k,575) + lu(k,579) = lu(k,579) * lu(k,575) + lu(k,744) = lu(k,744) - lu(k,576) * lu(k,738) + lu(k,745) = lu(k,745) - lu(k,577) * lu(k,738) + lu(k,746) = - lu(k,578) * lu(k,738) + lu(k,747) = - lu(k,579) * lu(k,738) + lu(k,891) = lu(k,891) - lu(k,576) * lu(k,888) + lu(k,892) = - lu(k,577) * lu(k,888) + lu(k,893) = - lu(k,578) * lu(k,888) + lu(k,894) = - lu(k,579) * lu(k,888) + lu(k,910) = lu(k,910) - lu(k,576) * lu(k,904) + lu(k,913) = - lu(k,577) * lu(k,904) + lu(k,914) = - lu(k,578) * lu(k,904) + lu(k,915) = lu(k,915) - lu(k,579) * lu(k,904) + lu(k,1580) = lu(k,1580) - lu(k,576) * lu(k,1572) + lu(k,1586) = lu(k,1586) - lu(k,577) * lu(k,1572) + lu(k,1590) = lu(k,1590) - lu(k,578) * lu(k,1572) + lu(k,1591) = lu(k,1591) - lu(k,579) * lu(k,1572) + lu(k,2447) = lu(k,2447) - lu(k,576) * lu(k,2433) + lu(k,2454) = lu(k,2454) - lu(k,577) * lu(k,2433) + lu(k,2458) = lu(k,2458) - lu(k,578) * lu(k,2433) + lu(k,2459) = - lu(k,579) * lu(k,2433) + lu(k,580) = 1._r8 / lu(k,580) + lu(k,581) = lu(k,581) * lu(k,580) + lu(k,582) = lu(k,582) * lu(k,580) + lu(k,583) = lu(k,583) * lu(k,580) + lu(k,584) = lu(k,584) * lu(k,580) + lu(k,585) = lu(k,585) * lu(k,580) + lu(k,586) = lu(k,586) * lu(k,580) + lu(k,587) = lu(k,587) * lu(k,580) + lu(k,1472) = lu(k,1472) - lu(k,581) * lu(k,1455) + lu(k,1473) = lu(k,1473) - lu(k,582) * lu(k,1455) + lu(k,1475) = lu(k,1475) - lu(k,583) * lu(k,1455) + lu(k,1477) = lu(k,1477) - lu(k,584) * lu(k,1455) + lu(k,1478) = - lu(k,585) * lu(k,1455) + lu(k,1482) = lu(k,1482) - lu(k,586) * lu(k,1455) + lu(k,1484) = lu(k,1484) - lu(k,587) * lu(k,1455) + lu(k,1673) = lu(k,1673) - lu(k,581) * lu(k,1657) + lu(k,1674) = - lu(k,582) * lu(k,1657) + lu(k,1681) = lu(k,1681) - lu(k,583) * lu(k,1657) + lu(k,1684) = lu(k,1684) - lu(k,584) * lu(k,1657) + lu(k,1685) = lu(k,1685) - lu(k,585) * lu(k,1657) + lu(k,1691) = - lu(k,586) * lu(k,1657) + lu(k,1694) = - lu(k,587) * lu(k,1657) + lu(k,1994) = lu(k,1994) - lu(k,581) * lu(k,1926) + lu(k,1995) = lu(k,1995) - lu(k,582) * lu(k,1926) + lu(k,2003) = lu(k,2003) - lu(k,583) * lu(k,1926) + lu(k,2006) = lu(k,2006) - lu(k,584) * lu(k,1926) + lu(k,2007) = lu(k,2007) - lu(k,585) * lu(k,1926) + lu(k,2013) = lu(k,2013) - lu(k,586) * lu(k,1926) + lu(k,2016) = lu(k,2016) - lu(k,587) * lu(k,1926) + lu(k,588) = 1._r8 / lu(k,588) + lu(k,589) = lu(k,589) * lu(k,588) + lu(k,590) = lu(k,590) * lu(k,588) + lu(k,591) = lu(k,591) * lu(k,588) + lu(k,592) = lu(k,592) * lu(k,588) + lu(k,593) = lu(k,593) * lu(k,588) + lu(k,594) = lu(k,594) * lu(k,588) + lu(k,595) = lu(k,595) * lu(k,588) + lu(k,862) = lu(k,862) - lu(k,589) * lu(k,861) + lu(k,863) = lu(k,863) - lu(k,590) * lu(k,861) + lu(k,864) = - lu(k,591) * lu(k,861) + lu(k,868) = - lu(k,592) * lu(k,861) + lu(k,869) = lu(k,869) - lu(k,593) * lu(k,861) + lu(k,870) = lu(k,870) - lu(k,594) * lu(k,861) + lu(k,871) = - lu(k,595) * lu(k,861) + lu(k,1954) = lu(k,1954) - lu(k,589) * lu(k,1927) + lu(k,1978) = lu(k,1978) - lu(k,590) * lu(k,1927) + lu(k,1983) = lu(k,1983) - lu(k,591) * lu(k,1927) + lu(k,2006) = lu(k,2006) - lu(k,592) * lu(k,1927) + lu(k,2009) = lu(k,2009) - lu(k,593) * lu(k,1927) + lu(k,2016) = lu(k,2016) - lu(k,594) * lu(k,1927) + lu(k,2017) = lu(k,2017) - lu(k,595) * lu(k,1927) + lu(k,2170) = lu(k,2170) - lu(k,589) * lu(k,2152) + lu(k,2185) = lu(k,2185) - lu(k,590) * lu(k,2152) + lu(k,2189) = - lu(k,591) * lu(k,2152) + lu(k,2211) = lu(k,2211) - lu(k,592) * lu(k,2152) + lu(k,2214) = lu(k,2214) - lu(k,593) * lu(k,2152) + lu(k,2221) = lu(k,2221) - lu(k,594) * lu(k,2152) + lu(k,2222) = lu(k,2222) - lu(k,595) * lu(k,2152) + 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,596) = 1._r8 / lu(k,596) + lu(k,597) = lu(k,597) * lu(k,596) + lu(k,598) = lu(k,598) * lu(k,596) + lu(k,599) = lu(k,599) * lu(k,596) + lu(k,600) = lu(k,600) * lu(k,596) + lu(k,601) = lu(k,601) * lu(k,596) + lu(k,602) = lu(k,602) * lu(k,596) + lu(k,603) = lu(k,603) * lu(k,596) + lu(k,1365) = - lu(k,597) * lu(k,1361) + lu(k,1369) = lu(k,1369) - lu(k,598) * lu(k,1361) + lu(k,1370) = - lu(k,599) * lu(k,1361) + lu(k,1371) = lu(k,1371) - lu(k,600) * lu(k,1361) + lu(k,1384) = lu(k,1384) - lu(k,601) * lu(k,1361) + lu(k,1386) = lu(k,1386) - lu(k,602) * lu(k,1361) + lu(k,1387) = - lu(k,603) * lu(k,1361) + lu(k,1751) = - lu(k,597) * lu(k,1734) + lu(k,1767) = lu(k,1767) - lu(k,598) * lu(k,1734) + lu(k,1769) = lu(k,1769) - lu(k,599) * lu(k,1734) + lu(k,1770) = lu(k,1770) - lu(k,600) * lu(k,1734) + lu(k,1790) = lu(k,1790) - lu(k,601) * lu(k,1734) + lu(k,1793) = lu(k,1793) - lu(k,602) * lu(k,1734) + lu(k,1796) = lu(k,1796) - lu(k,603) * lu(k,1734) + lu(k,1958) = lu(k,1958) - lu(k,597) * lu(k,1928) + lu(k,1980) = lu(k,1980) - lu(k,598) * lu(k,1928) + lu(k,1982) = lu(k,1982) - lu(k,599) * lu(k,1928) + lu(k,1983) = lu(k,1983) - lu(k,600) * lu(k,1928) + lu(k,2006) = lu(k,2006) - lu(k,601) * lu(k,1928) + lu(k,2009) = lu(k,2009) - lu(k,602) * lu(k,1928) + lu(k,2012) = lu(k,2012) - lu(k,603) * lu(k,1928) + lu(k,604) = 1._r8 / lu(k,604) + lu(k,605) = lu(k,605) * lu(k,604) + lu(k,606) = lu(k,606) * lu(k,604) + lu(k,607) = lu(k,607) * lu(k,604) + lu(k,608) = lu(k,608) * lu(k,604) + lu(k,609) = lu(k,609) * lu(k,604) + lu(k,610) = lu(k,610) * lu(k,604) + lu(k,611) = lu(k,611) * lu(k,604) + lu(k,1603) = lu(k,1603) - lu(k,605) * lu(k,1602) + lu(k,1607) = lu(k,1607) - lu(k,606) * lu(k,1602) + lu(k,1609) = lu(k,1609) - lu(k,607) * lu(k,1602) + lu(k,1611) = lu(k,1611) - lu(k,608) * lu(k,1602) + lu(k,1615) = - lu(k,609) * lu(k,1602) + lu(k,1619) = - lu(k,610) * lu(k,1602) + lu(k,1621) = lu(k,1621) - lu(k,611) * lu(k,1602) + lu(k,1663) = - lu(k,605) * lu(k,1658) + lu(k,1677) = - lu(k,606) * lu(k,1658) + lu(k,1679) = lu(k,1679) - lu(k,607) * lu(k,1658) + lu(k,1681) = lu(k,1681) - lu(k,608) * lu(k,1658) + lu(k,1685) = lu(k,1685) - lu(k,609) * lu(k,1658) + lu(k,1690) = lu(k,1690) - lu(k,610) * lu(k,1658) + lu(k,1693) = lu(k,1693) - lu(k,611) * lu(k,1658) + lu(k,2438) = lu(k,2438) - lu(k,605) * lu(k,2434) + lu(k,2453) = lu(k,2453) - lu(k,606) * lu(k,2434) + lu(k,2455) = lu(k,2455) - lu(k,607) * lu(k,2434) + lu(k,2457) = lu(k,2457) - lu(k,608) * lu(k,2434) + lu(k,2461) = lu(k,2461) - lu(k,609) * lu(k,2434) + lu(k,2466) = - lu(k,610) * lu(k,2434) + lu(k,2469) = lu(k,2469) - lu(k,611) * lu(k,2434) + lu(k,612) = 1._r8 / lu(k,612) + lu(k,613) = lu(k,613) * lu(k,612) + lu(k,614) = lu(k,614) * lu(k,612) + lu(k,615) = lu(k,615) * lu(k,612) + lu(k,616) = lu(k,616) * lu(k,612) + lu(k,617) = lu(k,617) * lu(k,612) + lu(k,618) = lu(k,618) * lu(k,612) + lu(k,619) = lu(k,619) * lu(k,612) + lu(k,1761) = lu(k,1761) - lu(k,613) * lu(k,1735) + lu(k,1765) = lu(k,1765) - lu(k,614) * lu(k,1735) + lu(k,1769) = lu(k,1769) - lu(k,615) * lu(k,1735) + lu(k,1787) = lu(k,1787) - lu(k,616) * lu(k,1735) + lu(k,1788) = lu(k,1788) - lu(k,617) * lu(k,1735) + lu(k,1793) = lu(k,1793) - lu(k,618) * lu(k,1735) + lu(k,1800) = lu(k,1800) - lu(k,619) * lu(k,1735) + lu(k,1973) = lu(k,1973) - lu(k,613) * lu(k,1929) + lu(k,1978) = lu(k,1978) - lu(k,614) * lu(k,1929) + lu(k,1982) = lu(k,1982) - lu(k,615) * lu(k,1929) + lu(k,2003) = lu(k,2003) - lu(k,616) * lu(k,1929) + lu(k,2004) = lu(k,2004) - lu(k,617) * lu(k,1929) + lu(k,2009) = lu(k,2009) - lu(k,618) * lu(k,1929) + lu(k,2016) = lu(k,2016) - lu(k,619) * lu(k,1929) + lu(k,2035) = lu(k,2035) - lu(k,613) * lu(k,2024) + lu(k,2040) = lu(k,2040) - lu(k,614) * lu(k,2024) + lu(k,2044) = - lu(k,615) * lu(k,2024) + lu(k,2063) = lu(k,2063) - lu(k,616) * lu(k,2024) + lu(k,2064) = lu(k,2064) - lu(k,617) * lu(k,2024) + lu(k,2069) = lu(k,2069) - lu(k,618) * lu(k,2024) + lu(k,2076) = lu(k,2076) - lu(k,619) * lu(k,2024) + lu(k,620) = 1._r8 / lu(k,620) + lu(k,621) = lu(k,621) * lu(k,620) + lu(k,622) = lu(k,622) * lu(k,620) + lu(k,623) = lu(k,623) * lu(k,620) + lu(k,624) = lu(k,624) * lu(k,620) + lu(k,625) = lu(k,625) * lu(k,620) + lu(k,626) = lu(k,626) * lu(k,620) + lu(k,627) = lu(k,627) * lu(k,620) + lu(k,1952) = lu(k,1952) - lu(k,621) * lu(k,1930) + lu(k,1959) = lu(k,1959) - lu(k,622) * lu(k,1930) + lu(k,1979) = lu(k,1979) - lu(k,623) * lu(k,1930) + lu(k,2006) = lu(k,2006) - lu(k,624) * lu(k,1930) + lu(k,2009) = lu(k,2009) - lu(k,625) * lu(k,1930) + lu(k,2014) = lu(k,2014) - lu(k,626) * lu(k,1930) + lu(k,2016) = lu(k,2016) - lu(k,627) * lu(k,1930) + lu(k,2233) = - lu(k,621) * lu(k,2230) + lu(k,2235) = lu(k,2235) - lu(k,622) * lu(k,2230) + lu(k,2242) = lu(k,2242) - lu(k,623) * lu(k,2230) + lu(k,2257) = lu(k,2257) - lu(k,624) * lu(k,2230) + lu(k,2260) = lu(k,2260) - lu(k,625) * lu(k,2230) + lu(k,2265) = lu(k,2265) - lu(k,626) * lu(k,2230) + lu(k,2267) = lu(k,2267) - lu(k,627) * lu(k,2230) + lu(k,2379) = - lu(k,621) * lu(k,2375) + lu(k,2381) = lu(k,2381) - lu(k,622) * lu(k,2375) + lu(k,2394) = lu(k,2394) - lu(k,623) * lu(k,2375) + lu(k,2417) = lu(k,2417) - lu(k,624) * lu(k,2375) + lu(k,2420) = lu(k,2420) - lu(k,625) * lu(k,2375) + lu(k,2425) = lu(k,2425) - lu(k,626) * lu(k,2375) + lu(k,2427) = lu(k,2427) - lu(k,627) * lu(k,2375) + lu(k,628) = 1._r8 / lu(k,628) + lu(k,629) = lu(k,629) * lu(k,628) + lu(k,630) = lu(k,630) * lu(k,628) + lu(k,631) = lu(k,631) * lu(k,628) + lu(k,632) = lu(k,632) * lu(k,628) + lu(k,633) = lu(k,633) * lu(k,628) + lu(k,634) = lu(k,634) * lu(k,628) + lu(k,635) = lu(k,635) * lu(k,628) + lu(k,636) = lu(k,636) * lu(k,628) + lu(k,1825) = lu(k,1825) - lu(k,629) * lu(k,1821) + lu(k,1826) = lu(k,1826) - lu(k,630) * lu(k,1821) + lu(k,1832) = lu(k,1832) - lu(k,631) * lu(k,1821) + lu(k,1833) = lu(k,1833) - lu(k,632) * lu(k,1821) + lu(k,1836) = lu(k,1836) - lu(k,633) * lu(k,1821) + lu(k,1837) = lu(k,1837) - lu(k,634) * lu(k,1821) + lu(k,1840) = lu(k,1840) - lu(k,635) * lu(k,1821) + lu(k,1844) = lu(k,1844) - lu(k,636) * lu(k,1821) + lu(k,1998) = lu(k,1998) - lu(k,629) * lu(k,1931) + lu(k,1999) = lu(k,1999) - lu(k,630) * lu(k,1931) + lu(k,2005) = lu(k,2005) - lu(k,631) * lu(k,1931) + lu(k,2006) = lu(k,2006) - lu(k,632) * lu(k,1931) + lu(k,2009) = lu(k,2009) - lu(k,633) * lu(k,1931) + lu(k,2010) = lu(k,2010) - lu(k,634) * lu(k,1931) + lu(k,2013) = lu(k,2013) - lu(k,635) * lu(k,1931) + lu(k,2017) = lu(k,2017) - lu(k,636) * lu(k,1931) + lu(k,2249) = lu(k,2249) - lu(k,629) * lu(k,2231) + lu(k,2250) = lu(k,2250) - lu(k,630) * lu(k,2231) + lu(k,2256) = lu(k,2256) - lu(k,631) * lu(k,2231) + lu(k,2257) = lu(k,2257) - lu(k,632) * lu(k,2231) + lu(k,2260) = lu(k,2260) - lu(k,633) * lu(k,2231) + lu(k,2261) = lu(k,2261) - lu(k,634) * lu(k,2231) + lu(k,2264) = lu(k,2264) - lu(k,635) * lu(k,2231) + lu(k,2268) = lu(k,2268) - lu(k,636) * lu(k,2231) + 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,637) = 1._r8 / lu(k,637) + lu(k,638) = lu(k,638) * lu(k,637) + lu(k,639) = lu(k,639) * lu(k,637) + lu(k,640) = lu(k,640) * lu(k,637) + lu(k,641) = lu(k,641) * lu(k,637) + lu(k,642) = lu(k,642) * lu(k,637) + lu(k,643) = lu(k,643) * lu(k,637) + lu(k,1442) = lu(k,1442) - lu(k,638) * lu(k,1436) + lu(k,1443) = lu(k,1443) - lu(k,639) * lu(k,1436) + lu(k,1446) = lu(k,1446) - lu(k,640) * lu(k,1436) + lu(k,1450) = lu(k,1450) - lu(k,641) * lu(k,1436) + lu(k,1452) = lu(k,1452) - lu(k,642) * lu(k,1436) + lu(k,1453) = - lu(k,643) * lu(k,1436) + lu(k,1472) = lu(k,1472) - lu(k,638) * lu(k,1456) + lu(k,1473) = lu(k,1473) - lu(k,639) * lu(k,1456) + lu(k,1477) = lu(k,1477) - lu(k,640) * lu(k,1456) + lu(k,1482) = lu(k,1482) - lu(k,641) * lu(k,1456) + lu(k,1484) = lu(k,1484) - lu(k,642) * lu(k,1456) + lu(k,1485) = - lu(k,643) * lu(k,1456) + lu(k,1994) = lu(k,1994) - lu(k,638) * lu(k,1932) + lu(k,1995) = lu(k,1995) - lu(k,639) * lu(k,1932) + lu(k,2006) = lu(k,2006) - lu(k,640) * lu(k,1932) + lu(k,2013) = lu(k,2013) - lu(k,641) * lu(k,1932) + lu(k,2016) = lu(k,2016) - lu(k,642) * lu(k,1932) + lu(k,2017) = lu(k,2017) - lu(k,643) * lu(k,1932) + lu(k,2200) = lu(k,2200) - lu(k,638) * lu(k,2153) + lu(k,2201) = lu(k,2201) - lu(k,639) * lu(k,2153) + lu(k,2211) = lu(k,2211) - lu(k,640) * lu(k,2153) + lu(k,2218) = lu(k,2218) - lu(k,641) * lu(k,2153) + lu(k,2221) = lu(k,2221) - lu(k,642) * lu(k,2153) + lu(k,2222) = lu(k,2222) - lu(k,643) * lu(k,2153) + lu(k,644) = 1._r8 / lu(k,644) + lu(k,645) = lu(k,645) * lu(k,644) + lu(k,646) = lu(k,646) * lu(k,644) + lu(k,647) = lu(k,647) * lu(k,644) + lu(k,648) = lu(k,648) * lu(k,644) + lu(k,649) = lu(k,649) * lu(k,644) + lu(k,650) = lu(k,650) * lu(k,644) + lu(k,1998) = lu(k,1998) - lu(k,645) * lu(k,1933) + lu(k,2006) = lu(k,2006) - lu(k,646) * lu(k,1933) + lu(k,2009) = lu(k,2009) - lu(k,647) * lu(k,1933) + lu(k,2010) = lu(k,2010) - lu(k,648) * lu(k,1933) + lu(k,2015) = lu(k,2015) - lu(k,649) * lu(k,1933) + lu(k,2017) = lu(k,2017) - lu(k,650) * lu(k,1933) + lu(k,2203) = lu(k,2203) - lu(k,645) * lu(k,2154) + lu(k,2211) = lu(k,2211) - lu(k,646) * lu(k,2154) + lu(k,2214) = lu(k,2214) - lu(k,647) * lu(k,2154) + lu(k,2215) = lu(k,2215) - lu(k,648) * lu(k,2154) + lu(k,2220) = lu(k,2220) - lu(k,649) * lu(k,2154) + lu(k,2222) = lu(k,2222) - lu(k,650) * lu(k,2154) + lu(k,2249) = lu(k,2249) - lu(k,645) * lu(k,2232) + lu(k,2257) = lu(k,2257) - lu(k,646) * lu(k,2232) + lu(k,2260) = lu(k,2260) - lu(k,647) * lu(k,2232) + lu(k,2261) = lu(k,2261) - lu(k,648) * lu(k,2232) + lu(k,2266) = - lu(k,649) * lu(k,2232) + lu(k,2268) = lu(k,2268) - lu(k,650) * lu(k,2232) + lu(k,2452) = lu(k,2452) - lu(k,645) * lu(k,2435) + lu(k,2460) = lu(k,2460) - lu(k,646) * lu(k,2435) + lu(k,2463) = lu(k,2463) - lu(k,647) * lu(k,2435) + lu(k,2464) = lu(k,2464) - lu(k,648) * lu(k,2435) + lu(k,2469) = lu(k,2469) - lu(k,649) * lu(k,2435) + lu(k,2471) = - lu(k,650) * lu(k,2435) + lu(k,651) = 1._r8 / lu(k,651) + lu(k,652) = lu(k,652) * lu(k,651) + lu(k,653) = lu(k,653) * lu(k,651) + lu(k,654) = lu(k,654) * lu(k,651) + lu(k,655) = lu(k,655) * lu(k,651) + lu(k,656) = lu(k,656) * lu(k,651) + lu(k,657) = lu(k,657) * lu(k,651) + lu(k,658) = lu(k,658) * lu(k,651) + lu(k,659) = lu(k,659) * lu(k,651) + lu(k,1336) = - lu(k,652) * lu(k,1333) + lu(k,1337) = - lu(k,653) * lu(k,1333) + lu(k,1338) = - lu(k,654) * lu(k,1333) + lu(k,1349) = lu(k,1349) - lu(k,655) * lu(k,1333) + lu(k,1351) = - lu(k,656) * lu(k,1333) + lu(k,1353) = lu(k,1353) - lu(k,657) * lu(k,1333) + lu(k,1354) = - lu(k,658) * lu(k,1333) + lu(k,1357) = lu(k,1357) - lu(k,659) * lu(k,1333) + lu(k,1767) = lu(k,1767) - lu(k,652) * lu(k,1736) + lu(k,1769) = lu(k,1769) - lu(k,653) * lu(k,1736) + lu(k,1770) = lu(k,1770) - lu(k,654) * lu(k,1736) + lu(k,1787) = lu(k,1787) - lu(k,655) * lu(k,1736) + lu(k,1790) = lu(k,1790) - lu(k,656) * lu(k,1736) + lu(k,1793) = lu(k,1793) - lu(k,657) * lu(k,1736) + lu(k,1796) = lu(k,1796) - lu(k,658) * lu(k,1736) + lu(k,1800) = lu(k,1800) - lu(k,659) * lu(k,1736) + lu(k,1980) = lu(k,1980) - lu(k,652) * lu(k,1934) + lu(k,1982) = lu(k,1982) - lu(k,653) * lu(k,1934) + lu(k,1983) = lu(k,1983) - lu(k,654) * lu(k,1934) + lu(k,2003) = lu(k,2003) - lu(k,655) * lu(k,1934) + lu(k,2006) = lu(k,2006) - lu(k,656) * lu(k,1934) + lu(k,2009) = lu(k,2009) - lu(k,657) * lu(k,1934) + lu(k,2012) = lu(k,2012) - lu(k,658) * lu(k,1934) + lu(k,2016) = lu(k,2016) - lu(k,659) * lu(k,1934) + lu(k,662) = 1._r8 / lu(k,662) + lu(k,663) = lu(k,663) * lu(k,662) + lu(k,664) = lu(k,664) * lu(k,662) + lu(k,665) = lu(k,665) * lu(k,662) + lu(k,666) = lu(k,666) * lu(k,662) + lu(k,667) = lu(k,667) * lu(k,662) + lu(k,668) = lu(k,668) * lu(k,662) + lu(k,669) = lu(k,669) * lu(k,662) + lu(k,670) = lu(k,670) * lu(k,662) + lu(k,793) = lu(k,793) - lu(k,663) * lu(k,792) + lu(k,794) = lu(k,794) - lu(k,664) * lu(k,792) + lu(k,795) = lu(k,795) - lu(k,665) * lu(k,792) + lu(k,796) = lu(k,796) - lu(k,666) * lu(k,792) + lu(k,798) = lu(k,798) - lu(k,667) * lu(k,792) + lu(k,800) = lu(k,800) - lu(k,668) * lu(k,792) + lu(k,803) = - lu(k,669) * lu(k,792) + lu(k,804) = lu(k,804) - lu(k,670) * lu(k,792) + lu(k,1937) = lu(k,1937) - lu(k,663) * lu(k,1935) + lu(k,1948) = lu(k,1948) - lu(k,664) * lu(k,1935) + lu(k,1949) = lu(k,1949) - lu(k,665) * lu(k,1935) + lu(k,1951) = - lu(k,666) * lu(k,1935) + lu(k,1970) = lu(k,1970) - lu(k,667) * lu(k,1935) + lu(k,1988) = lu(k,1988) - lu(k,668) * lu(k,1935) + lu(k,2006) = lu(k,2006) - lu(k,669) * lu(k,1935) + lu(k,2009) = lu(k,2009) - lu(k,670) * lu(k,1935) + lu(k,2156) = - lu(k,663) * lu(k,2155) + lu(k,2164) = lu(k,2164) - lu(k,664) * lu(k,2155) + lu(k,2165) = lu(k,2165) - lu(k,665) * lu(k,2155) + lu(k,2167) = lu(k,2167) - lu(k,666) * lu(k,2155) + lu(k,2179) = lu(k,2179) - lu(k,667) * lu(k,2155) + lu(k,2194) = lu(k,2194) - lu(k,668) * lu(k,2155) + lu(k,2211) = lu(k,2211) - lu(k,669) * lu(k,2155) + lu(k,2214) = lu(k,2214) - lu(k,670) * lu(k,2155) + lu(k,671) = 1._r8 / lu(k,671) + lu(k,672) = lu(k,672) * lu(k,671) + lu(k,673) = lu(k,673) * lu(k,671) + lu(k,674) = lu(k,674) * lu(k,671) + lu(k,675) = lu(k,675) * lu(k,671) + lu(k,676) = lu(k,676) * lu(k,671) + lu(k,677) = lu(k,677) * lu(k,671) + lu(k,678) = lu(k,678) * lu(k,671) + lu(k,679) = lu(k,679) * lu(k,671) + lu(k,1439) = - lu(k,672) * lu(k,1437) + lu(k,1441) = lu(k,1441) - lu(k,673) * lu(k,1437) + lu(k,1443) = lu(k,1443) - lu(k,674) * lu(k,1437) + lu(k,1444) = lu(k,1444) - lu(k,675) * lu(k,1437) + lu(k,1446) = lu(k,1446) - lu(k,676) * lu(k,1437) + lu(k,1447) = lu(k,1447) - lu(k,677) * lu(k,1437) + lu(k,1448) = lu(k,1448) - lu(k,678) * lu(k,1437) + lu(k,1452) = lu(k,1452) - lu(k,679) * lu(k,1437) + lu(k,1670) = - lu(k,672) * lu(k,1659) + lu(k,1672) = lu(k,1672) - lu(k,673) * lu(k,1659) + lu(k,1674) = lu(k,1674) - lu(k,674) * lu(k,1659) + lu(k,1681) = lu(k,1681) - lu(k,675) * lu(k,1659) + lu(k,1684) = lu(k,1684) - lu(k,676) * lu(k,1659) + lu(k,1685) = lu(k,1685) - lu(k,677) * lu(k,1659) + lu(k,1687) = lu(k,1687) - lu(k,678) * lu(k,1659) + lu(k,1694) = lu(k,1694) - lu(k,679) * lu(k,1659) + lu(k,1983) = lu(k,1983) - lu(k,672) * lu(k,1936) + lu(k,1993) = lu(k,1993) - lu(k,673) * lu(k,1936) + lu(k,1995) = lu(k,1995) - lu(k,674) * lu(k,1936) + lu(k,2003) = lu(k,2003) - lu(k,675) * lu(k,1936) + lu(k,2006) = lu(k,2006) - lu(k,676) * lu(k,1936) + lu(k,2007) = lu(k,2007) - lu(k,677) * lu(k,1936) + lu(k,2009) = lu(k,2009) - lu(k,678) * lu(k,1936) + lu(k,2016) = lu(k,2016) - lu(k,679) * lu(k,1936) + 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,680) = 1._r8 / lu(k,680) + lu(k,681) = lu(k,681) * lu(k,680) + lu(k,682) = lu(k,682) * lu(k,680) + lu(k,683) = lu(k,683) * lu(k,680) + lu(k,770) = - lu(k,681) * lu(k,765) + lu(k,772) = lu(k,772) - lu(k,682) * lu(k,765) + lu(k,776) = lu(k,776) - lu(k,683) * lu(k,765) + lu(k,797) = - lu(k,681) * lu(k,793) + lu(k,799) = - lu(k,682) * lu(k,793) + lu(k,804) = lu(k,804) - lu(k,683) * lu(k,793) + lu(k,813) = - lu(k,681) * lu(k,808) + lu(k,815) = lu(k,815) - lu(k,682) * lu(k,808) + lu(k,821) = lu(k,821) - lu(k,683) * lu(k,808) + lu(k,1132) = - lu(k,681) * lu(k,1130) + lu(k,1135) = - lu(k,682) * lu(k,1130) + lu(k,1142) = lu(k,1142) - lu(k,683) * lu(k,1130) + lu(k,1366) = - lu(k,681) * lu(k,1362) + lu(k,1368) = - lu(k,682) * lu(k,1362) + lu(k,1386) = lu(k,1386) - lu(k,683) * lu(k,1362) + lu(k,1754) = lu(k,1754) - lu(k,681) * lu(k,1737) + lu(k,1766) = lu(k,1766) - lu(k,682) * lu(k,1737) + lu(k,1793) = lu(k,1793) - lu(k,683) * lu(k,1737) + lu(k,1961) = - lu(k,681) * lu(k,1937) + lu(k,1979) = lu(k,1979) - lu(k,682) * lu(k,1937) + lu(k,2009) = lu(k,2009) - lu(k,683) * lu(k,1937) + lu(k,2176) = lu(k,2176) - lu(k,681) * lu(k,2156) + lu(k,2186) = lu(k,2186) - lu(k,682) * lu(k,2156) + lu(k,2214) = lu(k,2214) - lu(k,683) * lu(k,2156) + lu(k,684) = 1._r8 / lu(k,684) + lu(k,685) = lu(k,685) * lu(k,684) + lu(k,686) = lu(k,686) * lu(k,684) + lu(k,687) = lu(k,687) * lu(k,684) + lu(k,688) = lu(k,688) * lu(k,684) + lu(k,689) = lu(k,689) * lu(k,684) + lu(k,1107) = lu(k,1107) - lu(k,685) * lu(k,1104) + lu(k,1109) = lu(k,1109) - lu(k,686) * lu(k,1104) + lu(k,1111) = lu(k,1111) - lu(k,687) * lu(k,1104) + lu(k,1112) = lu(k,1112) - lu(k,688) * lu(k,1104) + lu(k,1113) = - lu(k,689) * lu(k,1104) + lu(k,1149) = lu(k,1149) - lu(k,685) * lu(k,1147) + lu(k,1154) = lu(k,1154) - lu(k,686) * lu(k,1147) + lu(k,1156) = lu(k,1156) - lu(k,687) * lu(k,1147) + lu(k,1158) = lu(k,1158) - lu(k,688) * lu(k,1147) + lu(k,1159) = lu(k,1159) - lu(k,689) * lu(k,1147) + lu(k,1760) = lu(k,1760) - lu(k,685) * lu(k,1738) + lu(k,1787) = lu(k,1787) - lu(k,686) * lu(k,1738) + lu(k,1790) = lu(k,1790) - lu(k,687) * lu(k,1738) + lu(k,1793) = lu(k,1793) - lu(k,688) * lu(k,1738) + lu(k,1796) = lu(k,1796) - lu(k,689) * lu(k,1738) + lu(k,1972) = lu(k,1972) - lu(k,685) * lu(k,1938) + lu(k,2003) = lu(k,2003) - lu(k,686) * lu(k,1938) + lu(k,2006) = lu(k,2006) - lu(k,687) * lu(k,1938) + lu(k,2009) = lu(k,2009) - lu(k,688) * lu(k,1938) + lu(k,2012) = lu(k,2012) - lu(k,689) * lu(k,1938) + lu(k,2325) = lu(k,2325) - lu(k,685) * lu(k,2317) + lu(k,2350) = lu(k,2350) - lu(k,686) * lu(k,2317) + lu(k,2353) = lu(k,2353) - lu(k,687) * lu(k,2317) + lu(k,2356) = lu(k,2356) - lu(k,688) * lu(k,2317) + lu(k,2359) = lu(k,2359) - lu(k,689) * lu(k,2317) + lu(k,692) = 1._r8 / lu(k,692) + lu(k,693) = lu(k,693) * lu(k,692) + lu(k,694) = lu(k,694) * lu(k,692) + lu(k,695) = lu(k,695) * lu(k,692) + lu(k,696) = lu(k,696) * lu(k,692) + lu(k,697) = lu(k,697) * lu(k,692) + lu(k,1681) = lu(k,1681) - lu(k,693) * lu(k,1660) + lu(k,1682) = lu(k,1682) - lu(k,694) * lu(k,1660) + lu(k,1684) = lu(k,1684) - lu(k,695) * lu(k,1660) + lu(k,1687) = lu(k,1687) - lu(k,696) * lu(k,1660) + lu(k,1692) = lu(k,1692) - lu(k,697) * lu(k,1660) + lu(k,1787) = lu(k,1787) - lu(k,693) * lu(k,1739) + lu(k,1788) = lu(k,1788) - lu(k,694) * lu(k,1739) + lu(k,1790) = lu(k,1790) - lu(k,695) * lu(k,1739) + lu(k,1793) = lu(k,1793) - lu(k,696) * lu(k,1739) + lu(k,1798) = lu(k,1798) - lu(k,697) * lu(k,1739) + lu(k,2003) = lu(k,2003) - lu(k,693) * lu(k,1939) + lu(k,2004) = lu(k,2004) - lu(k,694) * lu(k,1939) + lu(k,2006) = lu(k,2006) - lu(k,695) * lu(k,1939) + lu(k,2009) = lu(k,2009) - lu(k,696) * lu(k,1939) + lu(k,2014) = lu(k,2014) - lu(k,697) * lu(k,1939) + lu(k,2208) = lu(k,2208) - lu(k,693) * lu(k,2157) + lu(k,2209) = lu(k,2209) - lu(k,694) * lu(k,2157) + lu(k,2211) = lu(k,2211) - lu(k,695) * lu(k,2157) + lu(k,2214) = lu(k,2214) - lu(k,696) * lu(k,2157) + lu(k,2219) = lu(k,2219) - lu(k,697) * lu(k,2157) + lu(k,2414) = lu(k,2414) - lu(k,693) * lu(k,2376) + lu(k,2415) = lu(k,2415) - lu(k,694) * lu(k,2376) + lu(k,2417) = lu(k,2417) - lu(k,695) * lu(k,2376) + lu(k,2420) = lu(k,2420) - lu(k,696) * lu(k,2376) + lu(k,2425) = lu(k,2425) - lu(k,697) * lu(k,2376) + lu(k,699) = 1._r8 / lu(k,699) + lu(k,700) = lu(k,700) * lu(k,699) + lu(k,701) = lu(k,701) * lu(k,699) + lu(k,702) = lu(k,702) * lu(k,699) + lu(k,703) = lu(k,703) * lu(k,699) + lu(k,704) = lu(k,704) * lu(k,699) + lu(k,705) = lu(k,705) * lu(k,699) + lu(k,706) = lu(k,706) * lu(k,699) + lu(k,707) = lu(k,707) * lu(k,699) + lu(k,708) = lu(k,708) * lu(k,699) + lu(k,1084) = lu(k,1084) - lu(k,700) * lu(k,1082) + lu(k,1085) = lu(k,1085) - lu(k,701) * lu(k,1082) + lu(k,1087) = lu(k,1087) - lu(k,702) * lu(k,1082) + lu(k,1088) = lu(k,1088) - lu(k,703) * lu(k,1082) + lu(k,1089) = lu(k,1089) - lu(k,704) * lu(k,1082) + lu(k,1091) = lu(k,1091) - lu(k,705) * lu(k,1082) + lu(k,1093) = lu(k,1093) - lu(k,706) * lu(k,1082) + lu(k,1094) = lu(k,1094) - lu(k,707) * lu(k,1082) + lu(k,1096) = lu(k,1096) - lu(k,708) * lu(k,1082) + lu(k,1741) = lu(k,1741) - lu(k,700) * lu(k,1740) + lu(k,1753) = lu(k,1753) - lu(k,701) * lu(k,1740) + lu(k,1761) = lu(k,1761) - lu(k,702) * lu(k,1740) + lu(k,1765) = lu(k,1765) - lu(k,703) * lu(k,1740) + lu(k,1781) = lu(k,1781) - lu(k,704) * lu(k,1740) + lu(k,1787) = lu(k,1787) - lu(k,705) * lu(k,1740) + lu(k,1790) = lu(k,1790) - lu(k,706) * lu(k,1740) + lu(k,1793) = lu(k,1793) - lu(k,707) * lu(k,1740) + lu(k,1800) = lu(k,1800) - lu(k,708) * lu(k,1740) + lu(k,1942) = lu(k,1942) - lu(k,700) * lu(k,1940) + lu(k,1960) = lu(k,1960) - lu(k,701) * lu(k,1940) + lu(k,1973) = lu(k,1973) - lu(k,702) * lu(k,1940) + lu(k,1978) = lu(k,1978) - lu(k,703) * lu(k,1940) + lu(k,1994) = lu(k,1994) - lu(k,704) * lu(k,1940) + lu(k,2003) = lu(k,2003) - lu(k,705) * lu(k,1940) + lu(k,2006) = lu(k,2006) - lu(k,706) * lu(k,1940) + lu(k,2009) = lu(k,2009) - lu(k,707) * lu(k,1940) + lu(k,2016) = lu(k,2016) - lu(k,708) * lu(k,1940) + lu(k,710) = 1._r8 / lu(k,710) + lu(k,711) = lu(k,711) * lu(k,710) + lu(k,712) = lu(k,712) * lu(k,710) + lu(k,713) = lu(k,713) * lu(k,710) + lu(k,714) = lu(k,714) * lu(k,710) + lu(k,715) = lu(k,715) * lu(k,710) + lu(k,716) = lu(k,716) * lu(k,710) + lu(k,717) = lu(k,717) * lu(k,710) + lu(k,718) = lu(k,718) * lu(k,710) + lu(k,719) = lu(k,719) * lu(k,710) + lu(k,1084) = lu(k,1084) - lu(k,711) * lu(k,1083) + lu(k,1085) = lu(k,1085) - lu(k,712) * lu(k,1083) + lu(k,1086) = lu(k,1086) - lu(k,713) * lu(k,1083) + lu(k,1087) = lu(k,1087) - lu(k,714) * lu(k,1083) + lu(k,1088) = lu(k,1088) - lu(k,715) * lu(k,1083) + lu(k,1089) = lu(k,1089) - lu(k,716) * lu(k,1083) + lu(k,1093) = lu(k,1093) - lu(k,717) * lu(k,1083) + lu(k,1094) = lu(k,1094) - lu(k,718) * lu(k,1083) + lu(k,1096) = lu(k,1096) - lu(k,719) * lu(k,1083) + lu(k,1942) = lu(k,1942) - lu(k,711) * lu(k,1941) + lu(k,1960) = lu(k,1960) - lu(k,712) * lu(k,1941) + lu(k,1969) = lu(k,1969) - lu(k,713) * lu(k,1941) + lu(k,1973) = lu(k,1973) - lu(k,714) * lu(k,1941) + lu(k,1978) = lu(k,1978) - lu(k,715) * lu(k,1941) + lu(k,1994) = lu(k,1994) - lu(k,716) * lu(k,1941) + lu(k,2006) = lu(k,2006) - lu(k,717) * lu(k,1941) + lu(k,2009) = lu(k,2009) - lu(k,718) * lu(k,1941) + lu(k,2016) = lu(k,2016) - lu(k,719) * lu(k,1941) + lu(k,2159) = lu(k,2159) - lu(k,711) * lu(k,2158) + lu(k,2175) = lu(k,2175) - lu(k,712) * lu(k,2158) + lu(k,2178) = lu(k,2178) - lu(k,713) * lu(k,2158) + lu(k,2182) = lu(k,2182) - lu(k,714) * lu(k,2158) + lu(k,2185) = lu(k,2185) - lu(k,715) * lu(k,2158) + lu(k,2200) = lu(k,2200) - lu(k,716) * lu(k,2158) + lu(k,2211) = lu(k,2211) - lu(k,717) * lu(k,2158) + lu(k,2214) = lu(k,2214) - lu(k,718) * lu(k,2158) + lu(k,2221) = lu(k,2221) - lu(k,719) * lu(k,2158) + lu(k,721) = 1._r8 / lu(k,721) + lu(k,722) = lu(k,722) * lu(k,721) + lu(k,723) = lu(k,723) * lu(k,721) + lu(k,724) = lu(k,724) * lu(k,721) + lu(k,725) = lu(k,725) * lu(k,721) + lu(k,726) = lu(k,726) * lu(k,721) + lu(k,727) = lu(k,727) * lu(k,721) + lu(k,1088) = lu(k,1088) - lu(k,722) * lu(k,1084) + lu(k,1089) = lu(k,1089) - lu(k,723) * lu(k,1084) + lu(k,1091) = lu(k,1091) - lu(k,724) * lu(k,1084) + lu(k,1092) = lu(k,1092) - lu(k,725) * lu(k,1084) + lu(k,1093) = lu(k,1093) - lu(k,726) * lu(k,1084) + lu(k,1094) = lu(k,1094) - lu(k,727) * lu(k,1084) + lu(k,1765) = lu(k,1765) - lu(k,722) * lu(k,1741) + lu(k,1781) = lu(k,1781) - lu(k,723) * lu(k,1741) + lu(k,1787) = lu(k,1787) - lu(k,724) * lu(k,1741) + lu(k,1788) = lu(k,1788) - lu(k,725) * lu(k,1741) + lu(k,1790) = lu(k,1790) - lu(k,726) * lu(k,1741) + lu(k,1793) = lu(k,1793) - lu(k,727) * lu(k,1741) + lu(k,1978) = lu(k,1978) - lu(k,722) * lu(k,1942) + lu(k,1994) = lu(k,1994) - lu(k,723) * lu(k,1942) + lu(k,2003) = lu(k,2003) - lu(k,724) * lu(k,1942) + lu(k,2004) = lu(k,2004) - lu(k,725) * lu(k,1942) + lu(k,2006) = lu(k,2006) - lu(k,726) * lu(k,1942) + lu(k,2009) = lu(k,2009) - lu(k,727) * lu(k,1942) + lu(k,2185) = lu(k,2185) - lu(k,722) * lu(k,2159) + lu(k,2200) = lu(k,2200) - lu(k,723) * lu(k,2159) + lu(k,2208) = lu(k,2208) - lu(k,724) * lu(k,2159) + lu(k,2209) = lu(k,2209) - lu(k,725) * lu(k,2159) + lu(k,2211) = lu(k,2211) - lu(k,726) * lu(k,2159) + lu(k,2214) = lu(k,2214) - lu(k,727) * lu(k,2159) + 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,728) = 1._r8 / lu(k,728) + lu(k,729) = lu(k,729) * lu(k,728) + lu(k,730) = lu(k,730) * lu(k,728) + lu(k,731) = lu(k,731) * lu(k,728) + lu(k,732) = lu(k,732) * lu(k,728) + lu(k,733) = lu(k,733) * lu(k,728) + lu(k,734) = lu(k,734) * lu(k,728) + lu(k,735) = lu(k,735) * lu(k,728) + lu(k,736) = lu(k,736) * lu(k,728) + lu(k,737) = lu(k,737) * lu(k,728) + lu(k,1218) = lu(k,1218) - lu(k,729) * lu(k,1216) + lu(k,1219) = lu(k,1219) - lu(k,730) * lu(k,1216) + lu(k,1220) = lu(k,1220) - lu(k,731) * lu(k,1216) + lu(k,1221) = lu(k,1221) - lu(k,732) * lu(k,1216) + lu(k,1222) = lu(k,1222) - lu(k,733) * lu(k,1216) + lu(k,1225) = lu(k,1225) - lu(k,734) * lu(k,1216) + lu(k,1228) = - lu(k,735) * lu(k,1216) + lu(k,1229) = lu(k,1229) - lu(k,736) * lu(k,1216) + lu(k,1232) = lu(k,1232) - lu(k,737) * lu(k,1216) + lu(k,1973) = lu(k,1973) - lu(k,729) * lu(k,1943) + lu(k,1976) = lu(k,1976) - lu(k,730) * lu(k,1943) + lu(k,1979) = lu(k,1979) - lu(k,731) * lu(k,1943) + lu(k,1980) = lu(k,1980) - lu(k,732) * lu(k,1943) + lu(k,1981) = lu(k,1981) - lu(k,733) * lu(k,1943) + lu(k,1995) = lu(k,1995) - lu(k,734) * lu(k,1943) + lu(k,2006) = lu(k,2006) - lu(k,735) * lu(k,1943) + lu(k,2009) = lu(k,2009) - lu(k,736) * lu(k,1943) + lu(k,2016) = lu(k,2016) - lu(k,737) * lu(k,1943) + lu(k,2182) = lu(k,2182) - lu(k,729) * lu(k,2160) + lu(k,2184) = - lu(k,730) * lu(k,2160) + lu(k,2186) = lu(k,2186) - lu(k,731) * lu(k,2160) + lu(k,2187) = lu(k,2187) - lu(k,732) * lu(k,2160) + lu(k,2188) = lu(k,2188) - lu(k,733) * lu(k,2160) + lu(k,2201) = lu(k,2201) - lu(k,734) * lu(k,2160) + lu(k,2211) = lu(k,2211) - lu(k,735) * lu(k,2160) + lu(k,2214) = lu(k,2214) - lu(k,736) * lu(k,2160) + lu(k,2221) = lu(k,2221) - lu(k,737) * lu(k,2160) + lu(k,739) = 1._r8 / lu(k,739) + lu(k,740) = lu(k,740) * lu(k,739) + lu(k,741) = lu(k,741) * lu(k,739) + lu(k,742) = lu(k,742) * lu(k,739) + lu(k,743) = lu(k,743) * lu(k,739) + lu(k,744) = lu(k,744) * lu(k,739) + lu(k,745) = lu(k,745) * lu(k,739) + lu(k,746) = lu(k,746) * lu(k,739) + lu(k,747) = lu(k,747) * lu(k,739) + lu(k,748) = lu(k,748) * lu(k,739) + lu(k,906) = - lu(k,740) * lu(k,905) + lu(k,907) = lu(k,907) - lu(k,741) * lu(k,905) + lu(k,908) = lu(k,908) - lu(k,742) * lu(k,905) + lu(k,909) = lu(k,909) - lu(k,743) * lu(k,905) + lu(k,910) = lu(k,910) - lu(k,744) * lu(k,905) + lu(k,913) = lu(k,913) - lu(k,745) * lu(k,905) + lu(k,914) = lu(k,914) - lu(k,746) * lu(k,905) + lu(k,915) = lu(k,915) - lu(k,747) * lu(k,905) + lu(k,916) = lu(k,916) - lu(k,748) * lu(k,905) + lu(k,1575) = lu(k,1575) - lu(k,740) * lu(k,1573) + lu(k,1576) = lu(k,1576) - lu(k,741) * lu(k,1573) + lu(k,1577) = lu(k,1577) - lu(k,742) * lu(k,1573) + lu(k,1578) = lu(k,1578) - lu(k,743) * lu(k,1573) + lu(k,1580) = lu(k,1580) - lu(k,744) * lu(k,1573) + lu(k,1586) = lu(k,1586) - lu(k,745) * lu(k,1573) + lu(k,1590) = lu(k,1590) - lu(k,746) * lu(k,1573) + lu(k,1591) = lu(k,1591) - lu(k,747) * lu(k,1573) + lu(k,1597) = lu(k,1597) - lu(k,748) * lu(k,1573) + lu(k,2439) = lu(k,2439) - lu(k,740) * lu(k,2436) + lu(k,2442) = lu(k,2442) - lu(k,741) * lu(k,2436) + lu(k,2443) = lu(k,2443) - lu(k,742) * lu(k,2436) + lu(k,2444) = lu(k,2444) - lu(k,743) * lu(k,2436) + lu(k,2447) = lu(k,2447) - lu(k,744) * lu(k,2436) + lu(k,2454) = lu(k,2454) - lu(k,745) * lu(k,2436) + lu(k,2458) = lu(k,2458) - lu(k,746) * lu(k,2436) + lu(k,2459) = lu(k,2459) - lu(k,747) * lu(k,2436) + lu(k,2469) = lu(k,2469) - lu(k,748) * lu(k,2436) + lu(k,749) = 1._r8 / lu(k,749) + lu(k,750) = lu(k,750) * lu(k,749) + lu(k,751) = lu(k,751) * lu(k,749) + lu(k,752) = lu(k,752) * lu(k,749) + lu(k,753) = lu(k,753) * lu(k,749) + lu(k,1183) = lu(k,1183) - lu(k,750) * lu(k,1173) + lu(k,1187) = lu(k,1187) - lu(k,751) * lu(k,1173) + lu(k,1191) = lu(k,1191) - lu(k,752) * lu(k,1173) + lu(k,1194) = - lu(k,753) * lu(k,1173) + lu(k,1443) = lu(k,1443) - lu(k,750) * lu(k,1438) + lu(k,1446) = lu(k,1446) - lu(k,751) * lu(k,1438) + lu(k,1450) = lu(k,1450) - lu(k,752) * lu(k,1438) + lu(k,1453) = lu(k,1453) - lu(k,753) * lu(k,1438) + lu(k,1473) = lu(k,1473) - lu(k,750) * lu(k,1457) + lu(k,1477) = lu(k,1477) - lu(k,751) * lu(k,1457) + lu(k,1482) = lu(k,1482) - lu(k,752) * lu(k,1457) + lu(k,1485) = lu(k,1485) - lu(k,753) * lu(k,1457) + lu(k,1995) = lu(k,1995) - lu(k,750) * lu(k,1944) + lu(k,2006) = lu(k,2006) - lu(k,751) * lu(k,1944) + lu(k,2013) = lu(k,2013) - lu(k,752) * lu(k,1944) + lu(k,2017) = lu(k,2017) - lu(k,753) * lu(k,1944) + lu(k,2201) = lu(k,2201) - lu(k,750) * lu(k,2161) + lu(k,2211) = lu(k,2211) - lu(k,751) * lu(k,2161) + lu(k,2218) = lu(k,2218) - lu(k,752) * lu(k,2161) + lu(k,2222) = lu(k,2222) - lu(k,753) * lu(k,2161) + lu(k,2346) = lu(k,2346) - lu(k,750) * lu(k,2318) + lu(k,2353) = lu(k,2353) - lu(k,751) * lu(k,2318) + lu(k,2360) = lu(k,2360) - lu(k,752) * lu(k,2318) + lu(k,2364) = lu(k,2364) - lu(k,753) * lu(k,2318) + lu(k,2408) = lu(k,2408) - lu(k,750) * lu(k,2377) + lu(k,2417) = lu(k,2417) - lu(k,751) * lu(k,2377) + lu(k,2424) = lu(k,2424) - lu(k,752) * lu(k,2377) + lu(k,2428) = - lu(k,753) * lu(k,2377) + lu(k,755) = 1._r8 / lu(k,755) + lu(k,756) = lu(k,756) * lu(k,755) + lu(k,757) = lu(k,757) * lu(k,755) + lu(k,758) = lu(k,758) * lu(k,755) + lu(k,759) = lu(k,759) * lu(k,755) + lu(k,760) = lu(k,760) * lu(k,755) + lu(k,761) = lu(k,761) * lu(k,755) + lu(k,1296) = - lu(k,756) * lu(k,1290) + lu(k,1298) = - lu(k,757) * lu(k,1290) + lu(k,1300) = - lu(k,758) * lu(k,1290) + lu(k,1305) = lu(k,1305) - lu(k,759) * lu(k,1290) + lu(k,1307) = lu(k,1307) - lu(k,760) * lu(k,1290) + lu(k,1310) = lu(k,1310) - lu(k,761) * lu(k,1290) + lu(k,1340) = - lu(k,756) * lu(k,1334) + lu(k,1341) = lu(k,1341) - lu(k,757) * lu(k,1334) + lu(k,1345) = lu(k,1345) - lu(k,758) * lu(k,1334) + lu(k,1351) = lu(k,1351) - lu(k,759) * lu(k,1334) + lu(k,1353) = lu(k,1353) - lu(k,760) * lu(k,1334) + lu(k,1357) = lu(k,1357) - lu(k,761) * lu(k,1334) + lu(k,1373) = lu(k,1373) - lu(k,756) * lu(k,1363) + lu(k,1374) = - lu(k,757) * lu(k,1363) + lu(k,1378) = - lu(k,758) * lu(k,1363) + lu(k,1384) = lu(k,1384) - lu(k,759) * lu(k,1363) + lu(k,1386) = lu(k,1386) - lu(k,760) * lu(k,1363) + lu(k,1390) = lu(k,1390) - lu(k,761) * lu(k,1363) + lu(k,1985) = lu(k,1985) - lu(k,756) * lu(k,1945) + lu(k,1987) = lu(k,1987) - lu(k,757) * lu(k,1945) + lu(k,1992) = lu(k,1992) - lu(k,758) * lu(k,1945) + lu(k,2006) = lu(k,2006) - lu(k,759) * lu(k,1945) + lu(k,2009) = lu(k,2009) - lu(k,760) * lu(k,1945) + lu(k,2016) = lu(k,2016) - lu(k,761) * lu(k,1945) + lu(k,2191) = lu(k,2191) - lu(k,756) * lu(k,2162) + lu(k,2193) = - lu(k,757) * lu(k,2162) + lu(k,2198) = - lu(k,758) * lu(k,2162) + lu(k,2211) = lu(k,2211) - lu(k,759) * lu(k,2162) + lu(k,2214) = lu(k,2214) - lu(k,760) * lu(k,2162) + lu(k,2221) = lu(k,2221) - lu(k,761) * lu(k,2162) + lu(k,766) = 1._r8 / lu(k,766) + lu(k,767) = lu(k,767) * lu(k,766) + lu(k,768) = lu(k,768) * lu(k,766) + lu(k,769) = lu(k,769) * lu(k,766) + lu(k,770) = lu(k,770) * lu(k,766) + lu(k,771) = lu(k,771) * lu(k,766) + lu(k,772) = lu(k,772) * lu(k,766) + lu(k,773) = lu(k,773) * lu(k,766) + lu(k,774) = lu(k,774) * lu(k,766) + lu(k,775) = lu(k,775) * lu(k,766) + lu(k,776) = lu(k,776) * lu(k,766) + lu(k,810) = lu(k,810) - lu(k,767) * lu(k,809) + lu(k,811) = lu(k,811) - lu(k,768) * lu(k,809) + lu(k,812) = lu(k,812) - lu(k,769) * lu(k,809) + lu(k,813) = lu(k,813) - lu(k,770) * lu(k,809) + lu(k,814) = lu(k,814) - lu(k,771) * lu(k,809) + lu(k,815) = lu(k,815) - lu(k,772) * lu(k,809) + lu(k,816) = lu(k,816) - lu(k,773) * lu(k,809) + lu(k,817) = lu(k,817) - lu(k,774) * lu(k,809) + lu(k,820) = - lu(k,775) * lu(k,809) + lu(k,821) = lu(k,821) - lu(k,776) * lu(k,809) + lu(k,1948) = lu(k,1948) - lu(k,767) * lu(k,1946) + lu(k,1950) = lu(k,1950) - lu(k,768) * lu(k,1946) + lu(k,1951) = lu(k,1951) - lu(k,769) * lu(k,1946) + lu(k,1961) = lu(k,1961) - lu(k,770) * lu(k,1946) + lu(k,1970) = lu(k,1970) - lu(k,771) * lu(k,1946) + lu(k,1979) = lu(k,1979) - lu(k,772) * lu(k,1946) + lu(k,1988) = lu(k,1988) - lu(k,773) * lu(k,1946) + lu(k,1994) = lu(k,1994) - lu(k,774) * lu(k,1946) + lu(k,2006) = lu(k,2006) - lu(k,775) * lu(k,1946) + lu(k,2009) = lu(k,2009) - lu(k,776) * lu(k,1946) + lu(k,2164) = lu(k,2164) - lu(k,767) * lu(k,2163) + lu(k,2166) = lu(k,2166) - lu(k,768) * lu(k,2163) + lu(k,2167) = lu(k,2167) - lu(k,769) * lu(k,2163) + lu(k,2176) = lu(k,2176) - lu(k,770) * lu(k,2163) + lu(k,2179) = lu(k,2179) - lu(k,771) * lu(k,2163) + lu(k,2186) = lu(k,2186) - lu(k,772) * lu(k,2163) + lu(k,2194) = lu(k,2194) - lu(k,773) * lu(k,2163) + lu(k,2200) = lu(k,2200) - lu(k,774) * lu(k,2163) + lu(k,2211) = lu(k,2211) - lu(k,775) * lu(k,2163) + lu(k,2214) = lu(k,2214) - lu(k,776) * lu(k,2163) + 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,777) = 1._r8 / lu(k,777) + lu(k,778) = lu(k,778) * lu(k,777) + lu(k,779) = lu(k,779) * lu(k,777) + lu(k,780) = lu(k,780) * lu(k,777) + lu(k,781) = lu(k,781) * lu(k,777) + lu(k,782) = lu(k,782) * lu(k,777) + lu(k,783) = lu(k,783) * lu(k,777) + lu(k,1520) = lu(k,1520) - lu(k,778) * lu(k,1518) + lu(k,1522) = lu(k,1522) - lu(k,779) * lu(k,1518) + lu(k,1527) = lu(k,1527) - lu(k,780) * lu(k,1518) + lu(k,1530) = lu(k,1530) - lu(k,781) * lu(k,1518) + lu(k,1531) = lu(k,1531) - lu(k,782) * lu(k,1518) + lu(k,1532) = lu(k,1532) - lu(k,783) * lu(k,1518) + lu(k,1584) = lu(k,1584) - lu(k,778) * lu(k,1574) + lu(k,1586) = lu(k,1586) - lu(k,779) * lu(k,1574) + lu(k,1592) = - lu(k,780) * lu(k,1574) + lu(k,1595) = lu(k,1595) - lu(k,781) * lu(k,1574) + lu(k,1596) = lu(k,1596) - lu(k,782) * lu(k,1574) + lu(k,1597) = lu(k,1597) - lu(k,783) * lu(k,1574) + lu(k,1997) = lu(k,1997) - lu(k,778) * lu(k,1947) + lu(k,2000) = lu(k,2000) - lu(k,779) * lu(k,1947) + lu(k,2006) = lu(k,2006) - lu(k,780) * lu(k,1947) + lu(k,2011) = lu(k,2011) - lu(k,781) * lu(k,1947) + lu(k,2014) = lu(k,2014) - lu(k,782) * lu(k,1947) + lu(k,2015) = lu(k,2015) - lu(k,783) * lu(k,1947) + lu(k,2409) = lu(k,2409) - lu(k,778) * lu(k,2378) + lu(k,2411) = lu(k,2411) - lu(k,779) * lu(k,2378) + lu(k,2417) = lu(k,2417) - lu(k,780) * lu(k,2378) + lu(k,2422) = lu(k,2422) - lu(k,781) * lu(k,2378) + lu(k,2425) = lu(k,2425) - lu(k,782) * lu(k,2378) + lu(k,2426) = lu(k,2426) - lu(k,783) * lu(k,2378) + lu(k,2451) = lu(k,2451) - lu(k,778) * lu(k,2437) + lu(k,2454) = lu(k,2454) - lu(k,779) * lu(k,2437) + lu(k,2460) = lu(k,2460) - lu(k,780) * lu(k,2437) + lu(k,2465) = lu(k,2465) - lu(k,781) * lu(k,2437) + lu(k,2468) = lu(k,2468) - lu(k,782) * lu(k,2437) + lu(k,2469) = lu(k,2469) - lu(k,783) * lu(k,2437) + lu(k,784) = 1._r8 / lu(k,784) + lu(k,785) = lu(k,785) * lu(k,784) + lu(k,786) = lu(k,786) * lu(k,784) + lu(k,787) = lu(k,787) * lu(k,784) + lu(k,788) = lu(k,788) * lu(k,784) + lu(k,789) = lu(k,789) * lu(k,784) + lu(k,798) = lu(k,798) - lu(k,785) * lu(k,794) + lu(k,799) = lu(k,799) - lu(k,786) * lu(k,794) + lu(k,801) = lu(k,801) - lu(k,787) * lu(k,794) + lu(k,802) = lu(k,802) - lu(k,788) * lu(k,794) + lu(k,804) = lu(k,804) - lu(k,789) * lu(k,794) + lu(k,814) = lu(k,814) - lu(k,785) * lu(k,810) + lu(k,815) = lu(k,815) - lu(k,786) * lu(k,810) + lu(k,818) = lu(k,818) - lu(k,787) * lu(k,810) + lu(k,819) = lu(k,819) - lu(k,788) * lu(k,810) + lu(k,821) = lu(k,821) - lu(k,789) * lu(k,810) + lu(k,1668) = - lu(k,785) * lu(k,1661) + lu(k,1669) = - lu(k,786) * lu(k,1661) + lu(k,1681) = lu(k,1681) - lu(k,787) * lu(k,1661) + lu(k,1682) = lu(k,1682) - lu(k,788) * lu(k,1661) + lu(k,1687) = lu(k,1687) - lu(k,789) * lu(k,1661) + lu(k,1758) = lu(k,1758) - lu(k,785) * lu(k,1742) + lu(k,1766) = lu(k,1766) - lu(k,786) * lu(k,1742) + lu(k,1787) = lu(k,1787) - lu(k,787) * lu(k,1742) + lu(k,1788) = lu(k,1788) - lu(k,788) * lu(k,1742) + lu(k,1793) = lu(k,1793) - lu(k,789) * lu(k,1742) + lu(k,1970) = lu(k,1970) - lu(k,785) * lu(k,1948) + lu(k,1979) = lu(k,1979) - lu(k,786) * lu(k,1948) + lu(k,2003) = lu(k,2003) - lu(k,787) * lu(k,1948) + lu(k,2004) = lu(k,2004) - lu(k,788) * lu(k,1948) + lu(k,2009) = lu(k,2009) - lu(k,789) * lu(k,1948) + lu(k,2179) = lu(k,2179) - lu(k,785) * lu(k,2164) + lu(k,2186) = lu(k,2186) - lu(k,786) * lu(k,2164) + lu(k,2208) = lu(k,2208) - lu(k,787) * lu(k,2164) + lu(k,2209) = lu(k,2209) - lu(k,788) * lu(k,2164) + lu(k,2214) = lu(k,2214) - lu(k,789) * lu(k,2164) + lu(k,795) = 1._r8 / lu(k,795) + lu(k,796) = lu(k,796) * lu(k,795) + lu(k,797) = lu(k,797) * lu(k,795) + lu(k,798) = lu(k,798) * lu(k,795) + lu(k,799) = lu(k,799) * lu(k,795) + lu(k,800) = lu(k,800) * lu(k,795) + lu(k,801) = lu(k,801) * lu(k,795) + lu(k,802) = lu(k,802) * lu(k,795) + lu(k,803) = lu(k,803) * lu(k,795) + lu(k,804) = lu(k,804) * lu(k,795) + lu(k,1745) = lu(k,1745) - lu(k,796) * lu(k,1743) + lu(k,1754) = lu(k,1754) - lu(k,797) * lu(k,1743) + lu(k,1758) = lu(k,1758) - lu(k,798) * lu(k,1743) + lu(k,1766) = lu(k,1766) - lu(k,799) * lu(k,1743) + lu(k,1775) = lu(k,1775) - lu(k,800) * lu(k,1743) + lu(k,1787) = lu(k,1787) - lu(k,801) * lu(k,1743) + lu(k,1788) = lu(k,1788) - lu(k,802) * lu(k,1743) + lu(k,1790) = lu(k,1790) - lu(k,803) * lu(k,1743) + lu(k,1793) = lu(k,1793) - lu(k,804) * lu(k,1743) + lu(k,1951) = lu(k,1951) - lu(k,796) * lu(k,1949) + lu(k,1961) = lu(k,1961) - lu(k,797) * lu(k,1949) + lu(k,1970) = lu(k,1970) - lu(k,798) * lu(k,1949) + lu(k,1979) = lu(k,1979) - lu(k,799) * lu(k,1949) + lu(k,1988) = lu(k,1988) - lu(k,800) * lu(k,1949) + lu(k,2003) = lu(k,2003) - lu(k,801) * lu(k,1949) + lu(k,2004) = lu(k,2004) - lu(k,802) * lu(k,1949) + lu(k,2006) = lu(k,2006) - lu(k,803) * lu(k,1949) + lu(k,2009) = lu(k,2009) - lu(k,804) * lu(k,1949) + lu(k,2167) = lu(k,2167) - lu(k,796) * lu(k,2165) + lu(k,2176) = lu(k,2176) - lu(k,797) * lu(k,2165) + lu(k,2179) = lu(k,2179) - lu(k,798) * lu(k,2165) + lu(k,2186) = lu(k,2186) - lu(k,799) * lu(k,2165) + lu(k,2194) = lu(k,2194) - lu(k,800) * lu(k,2165) + lu(k,2208) = lu(k,2208) - lu(k,801) * lu(k,2165) + lu(k,2209) = lu(k,2209) - lu(k,802) * lu(k,2165) + lu(k,2211) = lu(k,2211) - lu(k,803) * lu(k,2165) + lu(k,2214) = lu(k,2214) - lu(k,804) * lu(k,2165) + lu(k,811) = 1._r8 / lu(k,811) + lu(k,812) = lu(k,812) * lu(k,811) + lu(k,813) = lu(k,813) * lu(k,811) + lu(k,814) = lu(k,814) * lu(k,811) + lu(k,815) = lu(k,815) * lu(k,811) + lu(k,816) = lu(k,816) * lu(k,811) + lu(k,817) = lu(k,817) * lu(k,811) + lu(k,818) = lu(k,818) * lu(k,811) + lu(k,819) = lu(k,819) * lu(k,811) + lu(k,820) = lu(k,820) * lu(k,811) + lu(k,821) = lu(k,821) * lu(k,811) + lu(k,1745) = lu(k,1745) - lu(k,812) * lu(k,1744) + lu(k,1754) = lu(k,1754) - lu(k,813) * lu(k,1744) + lu(k,1758) = lu(k,1758) - lu(k,814) * lu(k,1744) + lu(k,1766) = lu(k,1766) - lu(k,815) * lu(k,1744) + lu(k,1775) = lu(k,1775) - lu(k,816) * lu(k,1744) + lu(k,1781) = lu(k,1781) - lu(k,817) * lu(k,1744) + lu(k,1787) = lu(k,1787) - lu(k,818) * lu(k,1744) + lu(k,1788) = lu(k,1788) - lu(k,819) * lu(k,1744) + lu(k,1790) = lu(k,1790) - lu(k,820) * lu(k,1744) + lu(k,1793) = lu(k,1793) - lu(k,821) * lu(k,1744) + lu(k,1951) = lu(k,1951) - lu(k,812) * lu(k,1950) + lu(k,1961) = lu(k,1961) - lu(k,813) * lu(k,1950) + lu(k,1970) = lu(k,1970) - lu(k,814) * lu(k,1950) + lu(k,1979) = lu(k,1979) - lu(k,815) * lu(k,1950) + lu(k,1988) = lu(k,1988) - lu(k,816) * lu(k,1950) + lu(k,1994) = lu(k,1994) - lu(k,817) * lu(k,1950) + lu(k,2003) = lu(k,2003) - lu(k,818) * lu(k,1950) + lu(k,2004) = lu(k,2004) - lu(k,819) * lu(k,1950) + lu(k,2006) = lu(k,2006) - lu(k,820) * lu(k,1950) + lu(k,2009) = lu(k,2009) - lu(k,821) * lu(k,1950) + lu(k,2167) = lu(k,2167) - lu(k,812) * lu(k,2166) + lu(k,2176) = lu(k,2176) - lu(k,813) * lu(k,2166) + lu(k,2179) = lu(k,2179) - lu(k,814) * lu(k,2166) + lu(k,2186) = lu(k,2186) - lu(k,815) * lu(k,2166) + lu(k,2194) = lu(k,2194) - lu(k,816) * lu(k,2166) + lu(k,2200) = lu(k,2200) - lu(k,817) * lu(k,2166) + lu(k,2208) = lu(k,2208) - lu(k,818) * lu(k,2166) + lu(k,2209) = lu(k,2209) - lu(k,819) * lu(k,2166) + lu(k,2211) = lu(k,2211) - lu(k,820) * lu(k,2166) + lu(k,2214) = lu(k,2214) - lu(k,821) * lu(k,2166) + lu(k,822) = 1._r8 / lu(k,822) + lu(k,823) = lu(k,823) * lu(k,822) + lu(k,824) = lu(k,824) * lu(k,822) + lu(k,825) = lu(k,825) * lu(k,822) + lu(k,826) = lu(k,826) * lu(k,822) + lu(k,827) = lu(k,827) * lu(k,822) + lu(k,828) = lu(k,828) * lu(k,822) + lu(k,829) = lu(k,829) * lu(k,822) + lu(k,1669) = lu(k,1669) - lu(k,823) * lu(k,1662) + lu(k,1671) = - lu(k,824) * lu(k,1662) + lu(k,1681) = lu(k,1681) - lu(k,825) * lu(k,1662) + lu(k,1682) = lu(k,1682) - lu(k,826) * lu(k,1662) + lu(k,1684) = lu(k,1684) - lu(k,827) * lu(k,1662) + lu(k,1687) = lu(k,1687) - lu(k,828) * lu(k,1662) + lu(k,1691) = lu(k,1691) - lu(k,829) * lu(k,1662) + lu(k,1766) = lu(k,1766) - lu(k,823) * lu(k,1745) + lu(k,1775) = lu(k,1775) - lu(k,824) * lu(k,1745) + lu(k,1787) = lu(k,1787) - lu(k,825) * lu(k,1745) + lu(k,1788) = lu(k,1788) - lu(k,826) * lu(k,1745) + lu(k,1790) = lu(k,1790) - lu(k,827) * lu(k,1745) + lu(k,1793) = lu(k,1793) - lu(k,828) * lu(k,1745) + lu(k,1797) = lu(k,1797) - lu(k,829) * lu(k,1745) + lu(k,1979) = lu(k,1979) - lu(k,823) * lu(k,1951) + lu(k,1988) = lu(k,1988) - lu(k,824) * lu(k,1951) + lu(k,2003) = lu(k,2003) - lu(k,825) * lu(k,1951) + lu(k,2004) = lu(k,2004) - lu(k,826) * lu(k,1951) + lu(k,2006) = lu(k,2006) - lu(k,827) * lu(k,1951) + lu(k,2009) = lu(k,2009) - lu(k,828) * lu(k,1951) + lu(k,2013) = lu(k,2013) - lu(k,829) * lu(k,1951) + lu(k,2186) = lu(k,2186) - lu(k,823) * lu(k,2167) + lu(k,2194) = lu(k,2194) - lu(k,824) * lu(k,2167) + lu(k,2208) = lu(k,2208) - lu(k,825) * lu(k,2167) + lu(k,2209) = lu(k,2209) - lu(k,826) * lu(k,2167) + lu(k,2211) = lu(k,2211) - lu(k,827) * lu(k,2167) + lu(k,2214) = lu(k,2214) - lu(k,828) * lu(k,2167) + lu(k,2218) = lu(k,2218) - lu(k,829) * lu(k,2167) + lu(k,832) = 1._r8 / lu(k,832) + lu(k,833) = lu(k,833) * lu(k,832) + lu(k,834) = lu(k,834) * lu(k,832) + lu(k,835) = lu(k,835) * lu(k,832) + lu(k,836) = lu(k,836) * lu(k,832) + lu(k,837) = lu(k,837) * lu(k,832) + lu(k,838) = lu(k,838) * lu(k,832) + lu(k,839) = lu(k,839) * lu(k,832) + lu(k,1767) = lu(k,1767) - lu(k,833) * lu(k,1746) + lu(k,1784) = lu(k,1784) - lu(k,834) * lu(k,1746) + lu(k,1787) = lu(k,1787) - lu(k,835) * lu(k,1746) + lu(k,1788) = lu(k,1788) - lu(k,836) * lu(k,1746) + lu(k,1790) = lu(k,1790) - lu(k,837) * lu(k,1746) + lu(k,1793) = lu(k,1793) - lu(k,838) * lu(k,1746) + lu(k,1800) = lu(k,1800) - lu(k,839) * lu(k,1746) + lu(k,1980) = lu(k,1980) - lu(k,833) * lu(k,1952) + lu(k,2000) = lu(k,2000) - lu(k,834) * lu(k,1952) + lu(k,2003) = lu(k,2003) - lu(k,835) * lu(k,1952) + lu(k,2004) = lu(k,2004) - lu(k,836) * lu(k,1952) + lu(k,2006) = lu(k,2006) - lu(k,837) * lu(k,1952) + lu(k,2009) = lu(k,2009) - lu(k,838) * lu(k,1952) + lu(k,2016) = lu(k,2016) - lu(k,839) * lu(k,1952) + lu(k,2187) = lu(k,2187) - lu(k,833) * lu(k,2168) + lu(k,2205) = lu(k,2205) - lu(k,834) * lu(k,2168) + lu(k,2208) = lu(k,2208) - lu(k,835) * lu(k,2168) + lu(k,2209) = lu(k,2209) - lu(k,836) * lu(k,2168) + lu(k,2211) = lu(k,2211) - lu(k,837) * lu(k,2168) + lu(k,2214) = lu(k,2214) - lu(k,838) * lu(k,2168) + lu(k,2221) = lu(k,2221) - lu(k,839) * lu(k,2168) + lu(k,2243) = - lu(k,833) * lu(k,2233) + lu(k,2251) = lu(k,2251) - lu(k,834) * lu(k,2233) + lu(k,2254) = - lu(k,835) * lu(k,2233) + lu(k,2255) = - lu(k,836) * lu(k,2233) + lu(k,2257) = lu(k,2257) - lu(k,837) * lu(k,2233) + lu(k,2260) = lu(k,2260) - lu(k,838) * lu(k,2233) + lu(k,2267) = lu(k,2267) - lu(k,839) * lu(k,2233) + lu(k,2395) = - lu(k,833) * lu(k,2379) + lu(k,2411) = lu(k,2411) - lu(k,834) * lu(k,2379) + lu(k,2414) = lu(k,2414) - lu(k,835) * lu(k,2379) + lu(k,2415) = lu(k,2415) - lu(k,836) * lu(k,2379) + lu(k,2417) = lu(k,2417) - lu(k,837) * lu(k,2379) + lu(k,2420) = lu(k,2420) - lu(k,838) * lu(k,2379) + lu(k,2427) = lu(k,2427) - lu(k,839) * lu(k,2379) + 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,841) = 1._r8 / lu(k,841) + lu(k,842) = lu(k,842) * lu(k,841) + lu(k,843) = lu(k,843) * lu(k,841) + lu(k,844) = lu(k,844) * lu(k,841) + lu(k,845) = lu(k,845) * lu(k,841) + lu(k,846) = lu(k,846) * lu(k,841) + lu(k,847) = lu(k,847) * lu(k,841) + lu(k,848) = lu(k,848) * lu(k,841) + lu(k,1539) = lu(k,1539) - lu(k,842) * lu(k,1536) + lu(k,1540) = lu(k,1540) - lu(k,843) * lu(k,1536) + lu(k,1541) = - lu(k,844) * lu(k,1536) + lu(k,1545) = lu(k,1545) - lu(k,845) * lu(k,1536) + lu(k,1547) = lu(k,1547) - lu(k,846) * lu(k,1536) + lu(k,1550) = lu(k,1550) - lu(k,847) * lu(k,1536) + lu(k,1551) = lu(k,1551) - lu(k,848) * lu(k,1536) + lu(k,1606) = - lu(k,842) * lu(k,1603) + lu(k,1607) = lu(k,1607) - lu(k,843) * lu(k,1603) + lu(k,1609) = lu(k,1609) - lu(k,844) * lu(k,1603) + lu(k,1614) = lu(k,1614) - lu(k,845) * lu(k,1603) + lu(k,1617) = lu(k,1617) - lu(k,846) * lu(k,1603) + lu(k,1621) = lu(k,1621) - lu(k,847) * lu(k,1603) + lu(k,1623) = - lu(k,848) * lu(k,1603) + lu(k,1676) = - lu(k,842) * lu(k,1663) + lu(k,1677) = lu(k,1677) - lu(k,843) * lu(k,1663) + lu(k,1679) = lu(k,1679) - lu(k,844) * lu(k,1663) + lu(k,1684) = lu(k,1684) - lu(k,845) * lu(k,1663) + lu(k,1688) = - lu(k,846) * lu(k,1663) + lu(k,1693) = lu(k,1693) - lu(k,847) * lu(k,1663) + lu(k,1695) = lu(k,1695) - lu(k,848) * lu(k,1663) + lu(k,2203) = lu(k,2203) - lu(k,842) * lu(k,2169) + lu(k,2204) = lu(k,2204) - lu(k,843) * lu(k,2169) + lu(k,2206) = lu(k,2206) - lu(k,844) * lu(k,2169) + lu(k,2211) = lu(k,2211) - lu(k,845) * lu(k,2169) + lu(k,2215) = lu(k,2215) - lu(k,846) * lu(k,2169) + lu(k,2220) = lu(k,2220) - lu(k,847) * lu(k,2169) + lu(k,2222) = lu(k,2222) - lu(k,848) * lu(k,2169) + lu(k,2452) = lu(k,2452) - lu(k,842) * lu(k,2438) + lu(k,2453) = lu(k,2453) - lu(k,843) * lu(k,2438) + lu(k,2455) = lu(k,2455) - lu(k,844) * lu(k,2438) + lu(k,2460) = lu(k,2460) - lu(k,845) * lu(k,2438) + lu(k,2464) = lu(k,2464) - lu(k,846) * lu(k,2438) + lu(k,2469) = lu(k,2469) - lu(k,847) * lu(k,2438) + lu(k,2471) = lu(k,2471) - lu(k,848) * lu(k,2438) + lu(k,849) = 1._r8 / lu(k,849) + lu(k,850) = lu(k,850) * lu(k,849) + lu(k,851) = lu(k,851) * lu(k,849) + lu(k,852) = lu(k,852) * lu(k,849) + lu(k,853) = lu(k,853) * lu(k,849) + lu(k,854) = lu(k,854) * lu(k,849) + lu(k,855) = lu(k,855) * lu(k,849) + lu(k,856) = lu(k,856) * lu(k,849) + lu(k,907) = lu(k,907) - lu(k,850) * lu(k,906) + lu(k,908) = lu(k,908) - lu(k,851) * lu(k,906) + lu(k,910) = lu(k,910) - lu(k,852) * lu(k,906) + lu(k,911) = - lu(k,853) * lu(k,906) + lu(k,912) = - lu(k,854) * lu(k,906) + lu(k,913) = lu(k,913) - lu(k,855) * lu(k,906) + lu(k,916) = lu(k,916) - lu(k,856) * lu(k,906) + lu(k,1040) = lu(k,1040) - lu(k,850) * lu(k,1039) + lu(k,1041) = lu(k,1041) - lu(k,851) * lu(k,1039) + lu(k,1043) = lu(k,1043) - lu(k,852) * lu(k,1039) + lu(k,1044) = - lu(k,853) * lu(k,1039) + lu(k,1045) = - lu(k,854) * lu(k,1039) + lu(k,1046) = lu(k,1046) - lu(k,855) * lu(k,1039) + lu(k,1052) = lu(k,1052) - lu(k,856) * lu(k,1039) + lu(k,1489) = - lu(k,850) * lu(k,1488) + lu(k,1490) = lu(k,1490) - lu(k,851) * lu(k,1488) + lu(k,1492) = - lu(k,852) * lu(k,1488) + lu(k,1493) = lu(k,1493) - lu(k,853) * lu(k,1488) + lu(k,1494) = lu(k,1494) - lu(k,854) * lu(k,1488) + lu(k,1495) = lu(k,1495) - lu(k,855) * lu(k,1488) + lu(k,1502) = lu(k,1502) - lu(k,856) * lu(k,1488) + lu(k,1576) = lu(k,1576) - lu(k,850) * lu(k,1575) + lu(k,1577) = lu(k,1577) - lu(k,851) * lu(k,1575) + lu(k,1580) = lu(k,1580) - lu(k,852) * lu(k,1575) + lu(k,1581) = - lu(k,853) * lu(k,1575) + lu(k,1583) = - lu(k,854) * lu(k,1575) + lu(k,1586) = lu(k,1586) - lu(k,855) * lu(k,1575) + lu(k,1597) = lu(k,1597) - lu(k,856) * lu(k,1575) + lu(k,2442) = lu(k,2442) - lu(k,850) * lu(k,2439) + lu(k,2443) = lu(k,2443) - lu(k,851) * lu(k,2439) + lu(k,2447) = lu(k,2447) - lu(k,852) * lu(k,2439) + lu(k,2448) = lu(k,2448) - lu(k,853) * lu(k,2439) + lu(k,2449) = - lu(k,854) * lu(k,2439) + lu(k,2454) = lu(k,2454) - lu(k,855) * lu(k,2439) + lu(k,2469) = lu(k,2469) - lu(k,856) * lu(k,2439) + lu(k,857) = 1._r8 / lu(k,857) + lu(k,858) = lu(k,858) * lu(k,857) + lu(k,859) = lu(k,859) * lu(k,857) + lu(k,860) = lu(k,860) * lu(k,857) + lu(k,955) = lu(k,955) - lu(k,858) * lu(k,949) + lu(k,956) = lu(k,956) - lu(k,859) * lu(k,949) + lu(k,958) = lu(k,958) - lu(k,860) * lu(k,949) + lu(k,1111) = lu(k,1111) - lu(k,858) * lu(k,1105) + lu(k,1112) = lu(k,1112) - lu(k,859) * lu(k,1105) + lu(k,1115) = lu(k,1115) - lu(k,860) * lu(k,1105) + lu(k,1156) = lu(k,1156) - lu(k,858) * lu(k,1148) + lu(k,1158) = lu(k,1158) - lu(k,859) * lu(k,1148) + lu(k,1161) = lu(k,1161) - lu(k,860) * lu(k,1148) + lu(k,1228) = lu(k,1228) - lu(k,858) * lu(k,1217) + lu(k,1229) = lu(k,1229) - lu(k,859) * lu(k,1217) + lu(k,1232) = lu(k,1232) - lu(k,860) * lu(k,1217) + lu(k,1266) = lu(k,1266) - lu(k,858) * lu(k,1259) + lu(k,1267) = lu(k,1267) - lu(k,859) * lu(k,1259) + lu(k,1269) = lu(k,1269) - lu(k,860) * lu(k,1259) + lu(k,1283) = lu(k,1283) - lu(k,858) * lu(k,1272) + lu(k,1285) = lu(k,1285) - lu(k,859) * lu(k,1272) + lu(k,1287) = lu(k,1287) - lu(k,860) * lu(k,1272) + lu(k,1305) = lu(k,1305) - lu(k,858) * lu(k,1291) + lu(k,1307) = lu(k,1307) - lu(k,859) * lu(k,1291) + lu(k,1310) = lu(k,1310) - lu(k,860) * lu(k,1291) + lu(k,1351) = lu(k,1351) - lu(k,858) * lu(k,1335) + lu(k,1353) = lu(k,1353) - lu(k,859) * lu(k,1335) + lu(k,1357) = lu(k,1357) - lu(k,860) * lu(k,1335) + lu(k,1384) = lu(k,1384) - lu(k,858) * lu(k,1364) + lu(k,1386) = lu(k,1386) - lu(k,859) * lu(k,1364) + lu(k,1390) = lu(k,1390) - lu(k,860) * lu(k,1364) + lu(k,1406) = lu(k,1406) - lu(k,858) * lu(k,1393) + lu(k,1408) = lu(k,1408) - lu(k,859) * lu(k,1393) + lu(k,1411) = lu(k,1411) - lu(k,860) * lu(k,1393) + lu(k,2006) = lu(k,2006) - lu(k,858) * lu(k,1953) + lu(k,2009) = lu(k,2009) - lu(k,859) * lu(k,1953) + lu(k,2016) = lu(k,2016) - lu(k,860) * lu(k,1953) + lu(k,2353) = lu(k,2353) - lu(k,858) * lu(k,2319) + lu(k,2356) = lu(k,2356) - lu(k,859) * lu(k,2319) + lu(k,2363) = lu(k,2363) - lu(k,860) * lu(k,2319) + lu(k,862) = 1._r8 / lu(k,862) + lu(k,863) = lu(k,863) * lu(k,862) + lu(k,864) = lu(k,864) * lu(k,862) + lu(k,865) = lu(k,865) * lu(k,862) + lu(k,866) = lu(k,866) * lu(k,862) + lu(k,867) = lu(k,867) * lu(k,862) + lu(k,868) = lu(k,868) * lu(k,862) + lu(k,869) = lu(k,869) * lu(k,862) + lu(k,870) = lu(k,870) * lu(k,862) + lu(k,871) = lu(k,871) * lu(k,862) + lu(k,1178) = lu(k,1178) - lu(k,863) * lu(k,1174) + lu(k,1180) = - lu(k,864) * lu(k,1174) + lu(k,1184) = - lu(k,865) * lu(k,1174) + lu(k,1185) = - lu(k,866) * lu(k,1174) + lu(k,1186) = - lu(k,867) * lu(k,1174) + lu(k,1187) = lu(k,1187) - lu(k,868) * lu(k,1174) + lu(k,1190) = lu(k,1190) - lu(k,869) * lu(k,1174) + lu(k,1193) = lu(k,1193) - lu(k,870) * lu(k,1174) + lu(k,1194) = lu(k,1194) - lu(k,871) * lu(k,1174) + lu(k,1765) = lu(k,1765) - lu(k,863) * lu(k,1747) + lu(k,1770) = lu(k,1770) - lu(k,864) * lu(k,1747) + lu(k,1784) = lu(k,1784) - lu(k,865) * lu(k,1747) + lu(k,1787) = lu(k,1787) - lu(k,866) * lu(k,1747) + lu(k,1788) = lu(k,1788) - lu(k,867) * lu(k,1747) + lu(k,1790) = lu(k,1790) - lu(k,868) * lu(k,1747) + lu(k,1793) = lu(k,1793) - lu(k,869) * lu(k,1747) + lu(k,1800) = lu(k,1800) - lu(k,870) * lu(k,1747) + lu(k,1801) = - lu(k,871) * lu(k,1747) + lu(k,1978) = lu(k,1978) - lu(k,863) * lu(k,1954) + lu(k,1983) = lu(k,1983) - lu(k,864) * lu(k,1954) + lu(k,2000) = lu(k,2000) - lu(k,865) * lu(k,1954) + lu(k,2003) = lu(k,2003) - lu(k,866) * lu(k,1954) + lu(k,2004) = lu(k,2004) - lu(k,867) * lu(k,1954) + lu(k,2006) = lu(k,2006) - lu(k,868) * lu(k,1954) + lu(k,2009) = lu(k,2009) - lu(k,869) * lu(k,1954) + lu(k,2016) = lu(k,2016) - lu(k,870) * lu(k,1954) + lu(k,2017) = lu(k,2017) - lu(k,871) * lu(k,1954) + lu(k,2185) = lu(k,2185) - lu(k,863) * lu(k,2170) + lu(k,2189) = lu(k,2189) - lu(k,864) * lu(k,2170) + lu(k,2205) = lu(k,2205) - lu(k,865) * lu(k,2170) + lu(k,2208) = lu(k,2208) - lu(k,866) * lu(k,2170) + lu(k,2209) = lu(k,2209) - lu(k,867) * lu(k,2170) + lu(k,2211) = lu(k,2211) - lu(k,868) * lu(k,2170) + lu(k,2214) = lu(k,2214) - lu(k,869) * lu(k,2170) + lu(k,2221) = lu(k,2221) - lu(k,870) * lu(k,2170) + lu(k,2222) = lu(k,2222) - lu(k,871) * lu(k,2170) + lu(k,873) = 1._r8 / lu(k,873) + lu(k,874) = lu(k,874) * lu(k,873) + lu(k,875) = lu(k,875) * lu(k,873) + lu(k,876) = lu(k,876) * lu(k,873) + lu(k,877) = lu(k,877) * lu(k,873) + lu(k,878) = lu(k,878) * lu(k,873) + lu(k,879) = lu(k,879) * lu(k,873) + lu(k,1028) = lu(k,1028) - lu(k,874) * lu(k,1026) + lu(k,1029) = lu(k,1029) - lu(k,875) * lu(k,1026) + lu(k,1031) = lu(k,1031) - lu(k,876) * lu(k,1026) + lu(k,1033) = lu(k,1033) - lu(k,877) * lu(k,1026) + lu(k,1035) = lu(k,1035) - lu(k,878) * lu(k,1026) + lu(k,1036) = - lu(k,879) * lu(k,1026) + lu(k,1539) = lu(k,1539) - lu(k,874) * lu(k,1537) + lu(k,1542) = lu(k,1542) - lu(k,875) * lu(k,1537) + lu(k,1545) = lu(k,1545) - lu(k,876) * lu(k,1537) + lu(k,1547) = lu(k,1547) - lu(k,877) * lu(k,1537) + lu(k,1550) = lu(k,1550) - lu(k,878) * lu(k,1537) + lu(k,1551) = lu(k,1551) - lu(k,879) * lu(k,1537) + lu(k,1632) = lu(k,1632) - lu(k,874) * lu(k,1628) + lu(k,1636) = lu(k,1636) - lu(k,875) * lu(k,1628) + lu(k,1640) = lu(k,1640) - lu(k,876) * lu(k,1628) + lu(k,1643) = lu(k,1643) - lu(k,877) * lu(k,1628) + lu(k,1648) = lu(k,1648) - lu(k,878) * lu(k,1628) + lu(k,1650) = - lu(k,879) * lu(k,1628) + lu(k,1998) = lu(k,1998) - lu(k,874) * lu(k,1955) + lu(k,2002) = lu(k,2002) - lu(k,875) * lu(k,1955) + lu(k,2006) = lu(k,2006) - lu(k,876) * lu(k,1955) + lu(k,2010) = lu(k,2010) - lu(k,877) * lu(k,1955) + lu(k,2015) = lu(k,2015) - lu(k,878) * lu(k,1955) + lu(k,2017) = lu(k,2017) - lu(k,879) * lu(k,1955) + lu(k,2203) = lu(k,2203) - lu(k,874) * lu(k,2171) + lu(k,2207) = lu(k,2207) - lu(k,875) * lu(k,2171) + lu(k,2211) = lu(k,2211) - lu(k,876) * lu(k,2171) + lu(k,2215) = lu(k,2215) - lu(k,877) * lu(k,2171) + lu(k,2220) = lu(k,2220) - lu(k,878) * lu(k,2171) + lu(k,2222) = lu(k,2222) - lu(k,879) * lu(k,2171) + lu(k,2249) = lu(k,2249) - lu(k,874) * lu(k,2234) + lu(k,2253) = lu(k,2253) - lu(k,875) * lu(k,2234) + lu(k,2257) = lu(k,2257) - lu(k,876) * lu(k,2234) + lu(k,2261) = lu(k,2261) - lu(k,877) * lu(k,2234) + lu(k,2266) = lu(k,2266) - lu(k,878) * lu(k,2234) + lu(k,2268) = lu(k,2268) - lu(k,879) * lu(k,2234) + lu(k,2452) = lu(k,2452) - lu(k,874) * lu(k,2440) + lu(k,2456) = lu(k,2456) - lu(k,875) * lu(k,2440) + lu(k,2460) = lu(k,2460) - lu(k,876) * lu(k,2440) + lu(k,2464) = lu(k,2464) - lu(k,877) * lu(k,2440) + lu(k,2469) = lu(k,2469) - lu(k,878) * lu(k,2440) + lu(k,2471) = lu(k,2471) - lu(k,879) * lu(k,2440) + end do + end subroutine lu_fac18 + subroutine lu_fac19( 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,880) = 1._r8 / lu(k,880) + lu(k,881) = lu(k,881) * lu(k,880) + lu(k,882) = lu(k,882) * lu(k,880) + lu(k,883) = lu(k,883) * lu(k,880) + lu(k,884) = lu(k,884) * lu(k,880) + lu(k,885) = lu(k,885) * lu(k,880) + lu(k,886) = lu(k,886) * lu(k,880) + lu(k,887) = lu(k,887) * lu(k,880) + lu(k,1555) = lu(k,1555) - lu(k,881) * lu(k,1552) + lu(k,1557) = lu(k,1557) - lu(k,882) * lu(k,1552) + lu(k,1560) = - lu(k,883) * lu(k,1552) + lu(k,1561) = - lu(k,884) * lu(k,1552) + lu(k,1563) = - lu(k,885) * lu(k,1552) + lu(k,1565) = - lu(k,886) * lu(k,1552) + lu(k,1567) = - lu(k,887) * lu(k,1552) + lu(k,1826) = lu(k,1826) - lu(k,881) * lu(k,1822) + lu(k,1828) = lu(k,1828) - lu(k,882) * lu(k,1822) + lu(k,1832) = lu(k,1832) - lu(k,883) * lu(k,1822) + lu(k,1833) = lu(k,1833) - lu(k,884) * lu(k,1822) + lu(k,1838) = lu(k,1838) - lu(k,885) * lu(k,1822) + lu(k,1842) = lu(k,1842) - lu(k,886) * lu(k,1822) + lu(k,1844) = lu(k,1844) - lu(k,887) * lu(k,1822) + lu(k,1999) = lu(k,1999) - lu(k,881) * lu(k,1956) + lu(k,2001) = lu(k,2001) - lu(k,882) * lu(k,1956) + lu(k,2005) = lu(k,2005) - lu(k,883) * lu(k,1956) + lu(k,2006) = lu(k,2006) - lu(k,884) * lu(k,1956) + lu(k,2011) = lu(k,2011) - lu(k,885) * lu(k,1956) + lu(k,2015) = lu(k,2015) - lu(k,886) * lu(k,1956) + lu(k,2017) = lu(k,2017) - lu(k,887) * lu(k,1956) + lu(k,2204) = lu(k,2204) - lu(k,881) * lu(k,2172) + lu(k,2206) = lu(k,2206) - lu(k,882) * lu(k,2172) + lu(k,2210) = - lu(k,883) * lu(k,2172) + lu(k,2211) = lu(k,2211) - lu(k,884) * lu(k,2172) + lu(k,2216) = lu(k,2216) - lu(k,885) * lu(k,2172) + lu(k,2220) = lu(k,2220) - lu(k,886) * lu(k,2172) + lu(k,2222) = lu(k,2222) - lu(k,887) * lu(k,2172) + lu(k,2453) = lu(k,2453) - lu(k,881) * lu(k,2441) + lu(k,2455) = lu(k,2455) - lu(k,882) * lu(k,2441) + lu(k,2459) = lu(k,2459) - lu(k,883) * lu(k,2441) + lu(k,2460) = lu(k,2460) - lu(k,884) * lu(k,2441) + lu(k,2465) = lu(k,2465) - lu(k,885) * lu(k,2441) + lu(k,2469) = lu(k,2469) - lu(k,886) * lu(k,2441) + lu(k,2471) = lu(k,2471) - lu(k,887) * lu(k,2441) + lu(k,2479) = lu(k,2479) - lu(k,881) * lu(k,2473) + lu(k,2481) = - lu(k,882) * lu(k,2473) + lu(k,2485) = - lu(k,883) * lu(k,2473) + lu(k,2486) = lu(k,2486) - lu(k,884) * lu(k,2473) + lu(k,2491) = lu(k,2491) - lu(k,885) * lu(k,2473) + lu(k,2495) = lu(k,2495) - lu(k,886) * lu(k,2473) + lu(k,2497) = lu(k,2497) - lu(k,887) * lu(k,2473) + lu(k,889) = 1._r8 / lu(k,889) + lu(k,890) = lu(k,890) * lu(k,889) + lu(k,891) = lu(k,891) * lu(k,889) + lu(k,892) = lu(k,892) * lu(k,889) + lu(k,893) = lu(k,893) * lu(k,889) + lu(k,894) = lu(k,894) * lu(k,889) + lu(k,895) = lu(k,895) * lu(k,889) + lu(k,898) = lu(k,898) - lu(k,890) * lu(k,896) + lu(k,899) = lu(k,899) - lu(k,891) * lu(k,896) + lu(k,900) = lu(k,900) - lu(k,892) * lu(k,896) + lu(k,901) = lu(k,901) - lu(k,893) * lu(k,896) + lu(k,902) = lu(k,902) - lu(k,894) * lu(k,896) + lu(k,903) = lu(k,903) - lu(k,895) * lu(k,896) + lu(k,909) = lu(k,909) - lu(k,890) * lu(k,907) + lu(k,910) = lu(k,910) - lu(k,891) * lu(k,907) + lu(k,913) = lu(k,913) - lu(k,892) * lu(k,907) + lu(k,914) = lu(k,914) - lu(k,893) * lu(k,907) + lu(k,915) = lu(k,915) - lu(k,894) * lu(k,907) + lu(k,916) = lu(k,916) - lu(k,895) * lu(k,907) + lu(k,1042) = lu(k,1042) - lu(k,890) * lu(k,1040) + lu(k,1043) = lu(k,1043) - lu(k,891) * lu(k,1040) + lu(k,1046) = lu(k,1046) - lu(k,892) * lu(k,1040) + lu(k,1048) = lu(k,1048) - lu(k,893) * lu(k,1040) + lu(k,1049) = lu(k,1049) - lu(k,894) * lu(k,1040) + lu(k,1052) = lu(k,1052) - lu(k,895) * lu(k,1040) + lu(k,1491) = - lu(k,890) * lu(k,1489) + lu(k,1492) = lu(k,1492) - lu(k,891) * lu(k,1489) + lu(k,1495) = lu(k,1495) - lu(k,892) * lu(k,1489) + lu(k,1497) = - lu(k,893) * lu(k,1489) + lu(k,1498) = - lu(k,894) * lu(k,1489) + lu(k,1502) = lu(k,1502) - lu(k,895) * lu(k,1489) + lu(k,1578) = lu(k,1578) - lu(k,890) * lu(k,1576) + lu(k,1580) = lu(k,1580) - lu(k,891) * lu(k,1576) + lu(k,1586) = lu(k,1586) - lu(k,892) * lu(k,1576) + lu(k,1590) = lu(k,1590) - lu(k,893) * lu(k,1576) + lu(k,1591) = lu(k,1591) - lu(k,894) * lu(k,1576) + lu(k,1597) = lu(k,1597) - lu(k,895) * lu(k,1576) + lu(k,1750) = lu(k,1750) - lu(k,890) * lu(k,1748) + lu(k,1756) = lu(k,1756) - lu(k,891) * lu(k,1748) + lu(k,1784) = lu(k,1784) - lu(k,892) * lu(k,1748) + lu(k,1788) = lu(k,1788) - lu(k,893) * lu(k,1748) + lu(k,1789) = - lu(k,894) * lu(k,1748) + lu(k,1799) = lu(k,1799) - lu(k,895) * lu(k,1748) + lu(k,2444) = lu(k,2444) - lu(k,890) * lu(k,2442) + lu(k,2447) = lu(k,2447) - lu(k,891) * lu(k,2442) + lu(k,2454) = lu(k,2454) - lu(k,892) * lu(k,2442) + lu(k,2458) = lu(k,2458) - lu(k,893) * lu(k,2442) + lu(k,2459) = lu(k,2459) - lu(k,894) * lu(k,2442) + lu(k,2469) = lu(k,2469) - lu(k,895) * lu(k,2442) + lu(k,897) = 1._r8 / lu(k,897) + lu(k,898) = lu(k,898) * lu(k,897) + lu(k,899) = lu(k,899) * lu(k,897) + lu(k,900) = lu(k,900) * lu(k,897) + lu(k,901) = lu(k,901) * lu(k,897) + lu(k,902) = lu(k,902) * lu(k,897) + lu(k,903) = lu(k,903) * lu(k,897) + lu(k,909) = lu(k,909) - lu(k,898) * lu(k,908) + lu(k,910) = lu(k,910) - lu(k,899) * lu(k,908) + lu(k,913) = lu(k,913) - lu(k,900) * lu(k,908) + lu(k,914) = lu(k,914) - lu(k,901) * lu(k,908) + lu(k,915) = lu(k,915) - lu(k,902) * lu(k,908) + lu(k,916) = lu(k,916) - lu(k,903) * lu(k,908) + lu(k,1042) = lu(k,1042) - lu(k,898) * lu(k,1041) + lu(k,1043) = lu(k,1043) - lu(k,899) * lu(k,1041) + lu(k,1046) = lu(k,1046) - lu(k,900) * lu(k,1041) + lu(k,1048) = lu(k,1048) - lu(k,901) * lu(k,1041) + lu(k,1049) = lu(k,1049) - lu(k,902) * lu(k,1041) + lu(k,1052) = lu(k,1052) - lu(k,903) * lu(k,1041) + lu(k,1491) = lu(k,1491) - lu(k,898) * lu(k,1490) + lu(k,1492) = lu(k,1492) - lu(k,899) * lu(k,1490) + lu(k,1495) = lu(k,1495) - lu(k,900) * lu(k,1490) + lu(k,1497) = lu(k,1497) - lu(k,901) * lu(k,1490) + lu(k,1498) = lu(k,1498) - lu(k,902) * lu(k,1490) + lu(k,1502) = lu(k,1502) - lu(k,903) * lu(k,1490) + lu(k,1578) = lu(k,1578) - lu(k,898) * lu(k,1577) + lu(k,1580) = lu(k,1580) - lu(k,899) * lu(k,1577) + lu(k,1586) = lu(k,1586) - lu(k,900) * lu(k,1577) + lu(k,1590) = lu(k,1590) - lu(k,901) * lu(k,1577) + lu(k,1591) = lu(k,1591) - lu(k,902) * lu(k,1577) + lu(k,1597) = lu(k,1597) - lu(k,903) * lu(k,1577) + lu(k,1750) = lu(k,1750) - lu(k,898) * lu(k,1749) + lu(k,1756) = lu(k,1756) - lu(k,899) * lu(k,1749) + lu(k,1784) = lu(k,1784) - lu(k,900) * lu(k,1749) + lu(k,1788) = lu(k,1788) - lu(k,901) * lu(k,1749) + lu(k,1789) = lu(k,1789) - lu(k,902) * lu(k,1749) + lu(k,1799) = lu(k,1799) - lu(k,903) * lu(k,1749) + lu(k,2444) = lu(k,2444) - lu(k,898) * lu(k,2443) + lu(k,2447) = lu(k,2447) - lu(k,899) * lu(k,2443) + lu(k,2454) = lu(k,2454) - lu(k,900) * lu(k,2443) + lu(k,2458) = lu(k,2458) - lu(k,901) * lu(k,2443) + lu(k,2459) = lu(k,2459) - lu(k,902) * lu(k,2443) + lu(k,2469) = lu(k,2469) - lu(k,903) * lu(k,2443) + lu(k,909) = 1._r8 / lu(k,909) + lu(k,910) = lu(k,910) * lu(k,909) + lu(k,911) = lu(k,911) * lu(k,909) + lu(k,912) = lu(k,912) * lu(k,909) + lu(k,913) = lu(k,913) * lu(k,909) + lu(k,914) = lu(k,914) * lu(k,909) + lu(k,915) = lu(k,915) * lu(k,909) + lu(k,916) = lu(k,916) * lu(k,909) + lu(k,1043) = lu(k,1043) - lu(k,910) * lu(k,1042) + lu(k,1044) = lu(k,1044) - lu(k,911) * lu(k,1042) + lu(k,1045) = lu(k,1045) - lu(k,912) * lu(k,1042) + lu(k,1046) = lu(k,1046) - lu(k,913) * lu(k,1042) + lu(k,1048) = lu(k,1048) - lu(k,914) * lu(k,1042) + lu(k,1049) = lu(k,1049) - lu(k,915) * lu(k,1042) + lu(k,1052) = lu(k,1052) - lu(k,916) * lu(k,1042) + lu(k,1492) = lu(k,1492) - lu(k,910) * lu(k,1491) + lu(k,1493) = lu(k,1493) - lu(k,911) * lu(k,1491) + lu(k,1494) = lu(k,1494) - lu(k,912) * lu(k,1491) + lu(k,1495) = lu(k,1495) - lu(k,913) * lu(k,1491) + lu(k,1497) = lu(k,1497) - lu(k,914) * lu(k,1491) + lu(k,1498) = lu(k,1498) - lu(k,915) * lu(k,1491) + lu(k,1502) = lu(k,1502) - lu(k,916) * lu(k,1491) + lu(k,1580) = lu(k,1580) - lu(k,910) * lu(k,1578) + lu(k,1581) = lu(k,1581) - lu(k,911) * lu(k,1578) + lu(k,1583) = lu(k,1583) - lu(k,912) * lu(k,1578) + lu(k,1586) = lu(k,1586) - lu(k,913) * lu(k,1578) + lu(k,1590) = lu(k,1590) - lu(k,914) * lu(k,1578) + lu(k,1591) = lu(k,1591) - lu(k,915) * lu(k,1578) + lu(k,1597) = lu(k,1597) - lu(k,916) * lu(k,1578) + lu(k,1756) = lu(k,1756) - lu(k,910) * lu(k,1750) + lu(k,1766) = lu(k,1766) - lu(k,911) * lu(k,1750) + lu(k,1782) = lu(k,1782) - lu(k,912) * lu(k,1750) + lu(k,1784) = lu(k,1784) - lu(k,913) * lu(k,1750) + lu(k,1788) = lu(k,1788) - lu(k,914) * lu(k,1750) + lu(k,1789) = lu(k,1789) - lu(k,915) * lu(k,1750) + lu(k,1799) = lu(k,1799) - lu(k,916) * lu(k,1750) + lu(k,2447) = lu(k,2447) - lu(k,910) * lu(k,2444) + lu(k,2448) = lu(k,2448) - lu(k,911) * lu(k,2444) + lu(k,2449) = lu(k,2449) - lu(k,912) * lu(k,2444) + lu(k,2454) = lu(k,2454) - lu(k,913) * lu(k,2444) + lu(k,2458) = lu(k,2458) - lu(k,914) * lu(k,2444) + lu(k,2459) = lu(k,2459) - lu(k,915) * lu(k,2444) + lu(k,2469) = lu(k,2469) - lu(k,916) * lu(k,2444) + lu(k,920) = 1._r8 / lu(k,920) + lu(k,921) = lu(k,921) * lu(k,920) + lu(k,922) = lu(k,922) * lu(k,920) + lu(k,923) = lu(k,923) * lu(k,920) + lu(k,924) = lu(k,924) * lu(k,920) + lu(k,925) = lu(k,925) * lu(k,920) + lu(k,926) = lu(k,926) * lu(k,920) + lu(k,927) = lu(k,927) * lu(k,920) + lu(k,928) = lu(k,928) * lu(k,920) + lu(k,929) = lu(k,929) * lu(k,920) + lu(k,930) = lu(k,930) * lu(k,920) + lu(k,931) = lu(k,931) * lu(k,920) + lu(k,932) = lu(k,932) * lu(k,920) + lu(k,933) = lu(k,933) * lu(k,920) + lu(k,934) = lu(k,934) * lu(k,920) + lu(k,935) = lu(k,935) * lu(k,920) + lu(k,1959) = lu(k,1959) - lu(k,921) * lu(k,1957) + lu(k,1977) = lu(k,1977) - lu(k,922) * lu(k,1957) + lu(k,1979) = lu(k,1979) - lu(k,923) * lu(k,1957) + lu(k,1986) = - lu(k,924) * lu(k,1957) + lu(k,1987) = lu(k,1987) - lu(k,925) * lu(k,1957) + lu(k,1989) = lu(k,1989) - lu(k,926) * lu(k,1957) + lu(k,1990) = lu(k,1990) - lu(k,927) * lu(k,1957) + lu(k,1992) = lu(k,1992) - lu(k,928) * lu(k,1957) + lu(k,1994) = lu(k,1994) - lu(k,929) * lu(k,1957) + lu(k,2006) = lu(k,2006) - lu(k,930) * lu(k,1957) + lu(k,2007) = lu(k,2007) - lu(k,931) * lu(k,1957) + lu(k,2009) = lu(k,2009) - lu(k,932) * lu(k,1957) + lu(k,2013) = lu(k,2013) - lu(k,933) * lu(k,1957) + lu(k,2014) = lu(k,2014) - lu(k,934) * lu(k,1957) + lu(k,2016) = lu(k,2016) - lu(k,935) * lu(k,1957) + lu(k,2027) = - lu(k,921) * lu(k,2025) + lu(k,2039) = lu(k,2039) - lu(k,922) * lu(k,2025) + lu(k,2041) = lu(k,2041) - lu(k,923) * lu(k,2025) + lu(k,2048) = lu(k,2048) - lu(k,924) * lu(k,2025) + lu(k,2049) = lu(k,2049) - lu(k,925) * lu(k,2025) + lu(k,2051) = lu(k,2051) - lu(k,926) * lu(k,2025) + lu(k,2052) = lu(k,2052) - lu(k,927) * lu(k,2025) + lu(k,2054) = lu(k,2054) - lu(k,928) * lu(k,2025) + lu(k,2056) = lu(k,2056) - lu(k,929) * lu(k,2025) + lu(k,2066) = lu(k,2066) - lu(k,930) * lu(k,2025) + lu(k,2067) = lu(k,2067) - lu(k,931) * lu(k,2025) + lu(k,2069) = lu(k,2069) - lu(k,932) * lu(k,2025) + lu(k,2073) = - lu(k,933) * lu(k,2025) + lu(k,2074) = - lu(k,934) * lu(k,2025) + lu(k,2076) = lu(k,2076) - lu(k,935) * lu(k,2025) + lu(k,2381) = lu(k,2381) - lu(k,921) * lu(k,2380) + lu(k,2392) = lu(k,2392) - lu(k,922) * lu(k,2380) + lu(k,2394) = lu(k,2394) - lu(k,923) * lu(k,2380) + lu(k,2399) = - lu(k,924) * lu(k,2380) + lu(k,2400) = lu(k,2400) - lu(k,925) * lu(k,2380) + lu(k,2402) = - lu(k,926) * lu(k,2380) + lu(k,2403) = - lu(k,927) * lu(k,2380) + lu(k,2405) = lu(k,2405) - lu(k,928) * lu(k,2380) + lu(k,2407) = lu(k,2407) - lu(k,929) * lu(k,2380) + lu(k,2417) = lu(k,2417) - lu(k,930) * lu(k,2380) + lu(k,2418) = lu(k,2418) - lu(k,931) * lu(k,2380) + lu(k,2420) = lu(k,2420) - lu(k,932) * lu(k,2380) + lu(k,2424) = lu(k,2424) - lu(k,933) * lu(k,2380) + lu(k,2425) = lu(k,2425) - lu(k,934) * lu(k,2380) + lu(k,2427) = lu(k,2427) - lu(k,935) * lu(k,2380) + end do + end subroutine lu_fac19 + subroutine lu_fac20( 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,936) = 1._r8 / lu(k,936) + lu(k,937) = lu(k,937) * lu(k,936) + lu(k,938) = lu(k,938) * lu(k,936) + lu(k,939) = lu(k,939) * lu(k,936) + lu(k,940) = lu(k,940) * lu(k,936) + lu(k,941) = lu(k,941) * lu(k,936) + lu(k,1136) = - lu(k,937) * lu(k,1131) + lu(k,1137) = - lu(k,938) * lu(k,1131) + lu(k,1139) = lu(k,1139) - lu(k,939) * lu(k,1131) + lu(k,1141) = lu(k,1141) - lu(k,940) * lu(k,1131) + lu(k,1145) = - lu(k,941) * lu(k,1131) + lu(k,1181) = - lu(k,937) * lu(k,1175) + lu(k,1182) = - lu(k,938) * lu(k,1175) + lu(k,1185) = lu(k,1185) - lu(k,939) * lu(k,1175) + lu(k,1187) = lu(k,1187) - lu(k,940) * lu(k,1175) + lu(k,1193) = lu(k,1193) - lu(k,941) * lu(k,1175) + lu(k,1299) = - lu(k,937) * lu(k,1292) + lu(k,1301) = lu(k,1301) - lu(k,938) * lu(k,1292) + lu(k,1303) = lu(k,1303) - lu(k,939) * lu(k,1292) + lu(k,1305) = lu(k,1305) - lu(k,940) * lu(k,1292) + lu(k,1310) = lu(k,1310) - lu(k,941) * lu(k,1292) + lu(k,1375) = lu(k,1375) - lu(k,937) * lu(k,1365) + lu(k,1380) = lu(k,1380) - lu(k,938) * lu(k,1365) + lu(k,1382) = lu(k,1382) - lu(k,939) * lu(k,1365) + lu(k,1384) = lu(k,1384) - lu(k,940) * lu(k,1365) + lu(k,1390) = lu(k,1390) - lu(k,941) * lu(k,1365) + lu(k,1775) = lu(k,1775) - lu(k,937) * lu(k,1751) + lu(k,1781) = lu(k,1781) - lu(k,938) * lu(k,1751) + lu(k,1787) = lu(k,1787) - lu(k,939) * lu(k,1751) + lu(k,1790) = lu(k,1790) - lu(k,940) * lu(k,1751) + lu(k,1800) = lu(k,1800) - lu(k,941) * lu(k,1751) + lu(k,1988) = lu(k,1988) - lu(k,937) * lu(k,1958) + lu(k,1994) = lu(k,1994) - lu(k,938) * lu(k,1958) + lu(k,2003) = lu(k,2003) - lu(k,939) * lu(k,1958) + lu(k,2006) = lu(k,2006) - lu(k,940) * lu(k,1958) + lu(k,2016) = lu(k,2016) - lu(k,941) * lu(k,1958) + lu(k,2050) = lu(k,2050) - lu(k,937) * lu(k,2026) + lu(k,2056) = lu(k,2056) - lu(k,938) * lu(k,2026) + lu(k,2063) = lu(k,2063) - lu(k,939) * lu(k,2026) + lu(k,2066) = lu(k,2066) - lu(k,940) * lu(k,2026) + lu(k,2076) = lu(k,2076) - lu(k,941) * lu(k,2026) + lu(k,2194) = lu(k,2194) - lu(k,937) * lu(k,2173) + lu(k,2200) = lu(k,2200) - lu(k,938) * lu(k,2173) + lu(k,2208) = lu(k,2208) - lu(k,939) * lu(k,2173) + lu(k,2211) = lu(k,2211) - lu(k,940) * lu(k,2173) + lu(k,2221) = lu(k,2221) - lu(k,941) * lu(k,2173) + lu(k,2339) = lu(k,2339) - lu(k,937) * lu(k,2320) + lu(k,2345) = lu(k,2345) - lu(k,938) * lu(k,2320) + lu(k,2350) = lu(k,2350) - lu(k,939) * lu(k,2320) + lu(k,2353) = lu(k,2353) - lu(k,940) * lu(k,2320) + lu(k,2363) = lu(k,2363) - lu(k,941) * lu(k,2320) + lu(k,942) = 1._r8 / lu(k,942) + lu(k,943) = lu(k,943) * lu(k,942) + lu(k,944) = lu(k,944) * lu(k,942) + lu(k,945) = lu(k,945) * lu(k,942) + lu(k,946) = lu(k,946) * lu(k,942) + lu(k,1018) = lu(k,1018) - lu(k,943) * lu(k,1005) + lu(k,1019) = lu(k,1019) - lu(k,944) * lu(k,1005) + lu(k,1021) = lu(k,1021) - lu(k,945) * lu(k,1005) + lu(k,1024) = - lu(k,946) * lu(k,1005) + lu(k,1074) = lu(k,1074) - lu(k,943) * lu(k,1061) + lu(k,1075) = lu(k,1075) - lu(k,944) * lu(k,1061) + lu(k,1077) = lu(k,1077) - lu(k,945) * lu(k,1061) + lu(k,1080) = - lu(k,946) * lu(k,1061) + lu(k,1183) = lu(k,1183) - lu(k,943) * lu(k,1176) + lu(k,1187) = lu(k,1187) - lu(k,944) * lu(k,1176) + lu(k,1190) = lu(k,1190) - lu(k,945) * lu(k,1176) + lu(k,1194) = lu(k,1194) - lu(k,946) * lu(k,1176) + lu(k,1318) = - lu(k,943) * lu(k,1311) + lu(k,1319) = lu(k,1319) - lu(k,944) * lu(k,1311) + lu(k,1320) = lu(k,1320) - lu(k,945) * lu(k,1311) + lu(k,1323) = lu(k,1323) - lu(k,946) * lu(k,1311) + lu(k,1423) = lu(k,1423) - lu(k,943) * lu(k,1413) + lu(k,1427) = lu(k,1427) - lu(k,944) * lu(k,1413) + lu(k,1430) = lu(k,1430) - lu(k,945) * lu(k,1413) + lu(k,1435) = - lu(k,946) * lu(k,1413) + lu(k,1782) = lu(k,1782) - lu(k,943) * lu(k,1752) + lu(k,1790) = lu(k,1790) - lu(k,944) * lu(k,1752) + lu(k,1793) = lu(k,1793) - lu(k,945) * lu(k,1752) + lu(k,1801) = lu(k,1801) - lu(k,946) * lu(k,1752) + lu(k,1995) = lu(k,1995) - lu(k,943) * lu(k,1959) + lu(k,2006) = lu(k,2006) - lu(k,944) * lu(k,1959) + lu(k,2009) = lu(k,2009) - lu(k,945) * lu(k,1959) + lu(k,2017) = lu(k,2017) - lu(k,946) * lu(k,1959) + lu(k,2057) = - lu(k,943) * lu(k,2027) + lu(k,2066) = lu(k,2066) - lu(k,944) * lu(k,2027) + lu(k,2069) = lu(k,2069) - lu(k,945) * lu(k,2027) + lu(k,2077) = - lu(k,946) * lu(k,2027) + lu(k,2201) = lu(k,2201) - lu(k,943) * lu(k,2174) + lu(k,2211) = lu(k,2211) - lu(k,944) * lu(k,2174) + lu(k,2214) = lu(k,2214) - lu(k,945) * lu(k,2174) + lu(k,2222) = lu(k,2222) - lu(k,946) * lu(k,2174) + lu(k,2247) = - lu(k,943) * lu(k,2235) + lu(k,2257) = lu(k,2257) - lu(k,944) * lu(k,2235) + lu(k,2260) = lu(k,2260) - lu(k,945) * lu(k,2235) + lu(k,2268) = lu(k,2268) - lu(k,946) * lu(k,2235) + lu(k,2408) = lu(k,2408) - lu(k,943) * lu(k,2381) + lu(k,2417) = lu(k,2417) - lu(k,944) * lu(k,2381) + lu(k,2420) = lu(k,2420) - lu(k,945) * lu(k,2381) + lu(k,2428) = lu(k,2428) - lu(k,946) * lu(k,2381) + lu(k,2476) = - lu(k,943) * lu(k,2474) + lu(k,2486) = lu(k,2486) - lu(k,944) * lu(k,2474) + lu(k,2489) = lu(k,2489) - lu(k,945) * lu(k,2474) + lu(k,2497) = lu(k,2497) - lu(k,946) * lu(k,2474) + lu(k,950) = 1._r8 / lu(k,950) + lu(k,951) = lu(k,951) * lu(k,950) + lu(k,952) = lu(k,952) * lu(k,950) + lu(k,953) = lu(k,953) * lu(k,950) + lu(k,954) = lu(k,954) * lu(k,950) + lu(k,955) = lu(k,955) * lu(k,950) + lu(k,956) = lu(k,956) * lu(k,950) + lu(k,957) = lu(k,957) * lu(k,950) + lu(k,958) = lu(k,958) * lu(k,950) + lu(k,1088) = lu(k,1088) - lu(k,951) * lu(k,1085) + lu(k,1090) = - lu(k,952) * lu(k,1085) + lu(k,1091) = lu(k,1091) - lu(k,953) * lu(k,1085) + lu(k,1092) = lu(k,1092) - lu(k,954) * lu(k,1085) + lu(k,1093) = lu(k,1093) - lu(k,955) * lu(k,1085) + lu(k,1094) = lu(k,1094) - lu(k,956) * lu(k,1085) + lu(k,1095) = - lu(k,957) * lu(k,1085) + lu(k,1096) = lu(k,1096) - lu(k,958) * lu(k,1085) + lu(k,1765) = lu(k,1765) - lu(k,951) * lu(k,1753) + lu(k,1784) = lu(k,1784) - lu(k,952) * lu(k,1753) + lu(k,1787) = lu(k,1787) - lu(k,953) * lu(k,1753) + lu(k,1788) = lu(k,1788) - lu(k,954) * lu(k,1753) + lu(k,1790) = lu(k,1790) - lu(k,955) * lu(k,1753) + lu(k,1793) = lu(k,1793) - lu(k,956) * lu(k,1753) + lu(k,1797) = lu(k,1797) - lu(k,957) * lu(k,1753) + lu(k,1800) = lu(k,1800) - lu(k,958) * lu(k,1753) + lu(k,1978) = lu(k,1978) - lu(k,951) * lu(k,1960) + lu(k,2000) = lu(k,2000) - lu(k,952) * lu(k,1960) + lu(k,2003) = lu(k,2003) - lu(k,953) * lu(k,1960) + lu(k,2004) = lu(k,2004) - lu(k,954) * lu(k,1960) + lu(k,2006) = lu(k,2006) - lu(k,955) * lu(k,1960) + lu(k,2009) = lu(k,2009) - lu(k,956) * lu(k,1960) + lu(k,2013) = lu(k,2013) - lu(k,957) * lu(k,1960) + lu(k,2016) = lu(k,2016) - lu(k,958) * lu(k,1960) + lu(k,2185) = lu(k,2185) - lu(k,951) * lu(k,2175) + lu(k,2205) = lu(k,2205) - lu(k,952) * lu(k,2175) + lu(k,2208) = lu(k,2208) - lu(k,953) * lu(k,2175) + lu(k,2209) = lu(k,2209) - lu(k,954) * lu(k,2175) + lu(k,2211) = lu(k,2211) - lu(k,955) * lu(k,2175) + lu(k,2214) = lu(k,2214) - lu(k,956) * lu(k,2175) + lu(k,2218) = lu(k,2218) - lu(k,957) * lu(k,2175) + lu(k,2221) = lu(k,2221) - lu(k,958) * lu(k,2175) + lu(k,2241) = - lu(k,951) * lu(k,2236) + lu(k,2251) = lu(k,2251) - lu(k,952) * lu(k,2236) + lu(k,2254) = lu(k,2254) - lu(k,953) * lu(k,2236) + lu(k,2255) = lu(k,2255) - lu(k,954) * lu(k,2236) + lu(k,2257) = lu(k,2257) - lu(k,955) * lu(k,2236) + lu(k,2260) = lu(k,2260) - lu(k,956) * lu(k,2236) + lu(k,2264) = lu(k,2264) - lu(k,957) * lu(k,2236) + lu(k,2267) = lu(k,2267) - lu(k,958) * lu(k,2236) + lu(k,2330) = lu(k,2330) - lu(k,951) * lu(k,2321) + lu(k,2347) = lu(k,2347) - lu(k,952) * lu(k,2321) + lu(k,2350) = lu(k,2350) - lu(k,953) * lu(k,2321) + lu(k,2351) = lu(k,2351) - lu(k,954) * lu(k,2321) + lu(k,2353) = lu(k,2353) - lu(k,955) * lu(k,2321) + lu(k,2356) = lu(k,2356) - lu(k,956) * lu(k,2321) + lu(k,2360) = lu(k,2360) - lu(k,957) * lu(k,2321) + lu(k,2363) = lu(k,2363) - lu(k,958) * lu(k,2321) + lu(k,959) = 1._r8 / lu(k,959) + lu(k,960) = lu(k,960) * lu(k,959) + lu(k,961) = lu(k,961) * lu(k,959) + lu(k,962) = lu(k,962) * lu(k,959) + lu(k,963) = lu(k,963) * lu(k,959) + lu(k,964) = lu(k,964) * lu(k,959) + lu(k,965) = lu(k,965) * lu(k,959) + lu(k,966) = lu(k,966) * lu(k,959) + lu(k,967) = lu(k,967) * lu(k,959) + lu(k,1133) = lu(k,1133) - lu(k,960) * lu(k,1132) + lu(k,1135) = lu(k,1135) - lu(k,961) * lu(k,1132) + lu(k,1136) = lu(k,1136) - lu(k,962) * lu(k,1132) + lu(k,1139) = lu(k,1139) - lu(k,963) * lu(k,1132) + lu(k,1140) = - lu(k,964) * lu(k,1132) + lu(k,1141) = lu(k,1141) - lu(k,965) * lu(k,1132) + lu(k,1142) = lu(k,1142) - lu(k,966) * lu(k,1132) + lu(k,1144) = - lu(k,967) * lu(k,1132) + lu(k,1367) = lu(k,1367) - lu(k,960) * lu(k,1366) + lu(k,1368) = lu(k,1368) - lu(k,961) * lu(k,1366) + lu(k,1375) = lu(k,1375) - lu(k,962) * lu(k,1366) + lu(k,1382) = lu(k,1382) - lu(k,963) * lu(k,1366) + lu(k,1383) = lu(k,1383) - lu(k,964) * lu(k,1366) + lu(k,1384) = lu(k,1384) - lu(k,965) * lu(k,1366) + lu(k,1386) = lu(k,1386) - lu(k,966) * lu(k,1366) + lu(k,1388) = lu(k,1388) - lu(k,967) * lu(k,1366) + lu(k,1668) = lu(k,1668) - lu(k,960) * lu(k,1664) + lu(k,1669) = lu(k,1669) - lu(k,961) * lu(k,1664) + lu(k,1671) = lu(k,1671) - lu(k,962) * lu(k,1664) + lu(k,1681) = lu(k,1681) - lu(k,963) * lu(k,1664) + lu(k,1682) = lu(k,1682) - lu(k,964) * lu(k,1664) + lu(k,1684) = lu(k,1684) - lu(k,965) * lu(k,1664) + lu(k,1687) = lu(k,1687) - lu(k,966) * lu(k,1664) + lu(k,1691) = lu(k,1691) - lu(k,967) * lu(k,1664) + lu(k,1758) = lu(k,1758) - lu(k,960) * lu(k,1754) + lu(k,1766) = lu(k,1766) - lu(k,961) * lu(k,1754) + lu(k,1775) = lu(k,1775) - lu(k,962) * lu(k,1754) + lu(k,1787) = lu(k,1787) - lu(k,963) * lu(k,1754) + lu(k,1788) = lu(k,1788) - lu(k,964) * lu(k,1754) + lu(k,1790) = lu(k,1790) - lu(k,965) * lu(k,1754) + lu(k,1793) = lu(k,1793) - lu(k,966) * lu(k,1754) + lu(k,1797) = lu(k,1797) - lu(k,967) * lu(k,1754) + lu(k,1970) = lu(k,1970) - lu(k,960) * lu(k,1961) + lu(k,1979) = lu(k,1979) - lu(k,961) * lu(k,1961) + lu(k,1988) = lu(k,1988) - lu(k,962) * lu(k,1961) + lu(k,2003) = lu(k,2003) - lu(k,963) * lu(k,1961) + lu(k,2004) = lu(k,2004) - lu(k,964) * lu(k,1961) + lu(k,2006) = lu(k,2006) - lu(k,965) * lu(k,1961) + lu(k,2009) = lu(k,2009) - lu(k,966) * lu(k,1961) + lu(k,2013) = lu(k,2013) - lu(k,967) * lu(k,1961) + lu(k,2179) = lu(k,2179) - lu(k,960) * lu(k,2176) + lu(k,2186) = lu(k,2186) - lu(k,961) * lu(k,2176) + lu(k,2194) = lu(k,2194) - lu(k,962) * lu(k,2176) + lu(k,2208) = lu(k,2208) - lu(k,963) * lu(k,2176) + lu(k,2209) = lu(k,2209) - lu(k,964) * lu(k,2176) + lu(k,2211) = lu(k,2211) - lu(k,965) * lu(k,2176) + lu(k,2214) = lu(k,2214) - lu(k,966) * lu(k,2176) + lu(k,2218) = lu(k,2218) - lu(k,967) * lu(k,2176) + lu(k,969) = 1._r8 / lu(k,969) + lu(k,970) = lu(k,970) * lu(k,969) + lu(k,971) = lu(k,971) * lu(k,969) + lu(k,972) = lu(k,972) * lu(k,969) + lu(k,973) = lu(k,973) * lu(k,969) + lu(k,974) = lu(k,974) * lu(k,969) + lu(k,975) = lu(k,975) * lu(k,969) + lu(k,976) = lu(k,976) * lu(k,969) + lu(k,977) = lu(k,977) * lu(k,969) + lu(k,1505) = lu(k,1505) - lu(k,970) * lu(k,1504) + lu(k,1508) = lu(k,1508) - lu(k,971) * lu(k,1504) + lu(k,1509) = - lu(k,972) * lu(k,1504) + lu(k,1510) = - lu(k,973) * lu(k,1504) + lu(k,1512) = lu(k,1512) - lu(k,974) * lu(k,1504) + lu(k,1513) = - lu(k,975) * lu(k,1504) + lu(k,1514) = - lu(k,976) * lu(k,1504) + lu(k,1516) = lu(k,1516) - lu(k,977) * lu(k,1504) + lu(k,1824) = lu(k,1824) - lu(k,970) * lu(k,1823) + lu(k,1833) = lu(k,1833) - lu(k,971) * lu(k,1823) + lu(k,1834) = - lu(k,972) * lu(k,1823) + lu(k,1835) = lu(k,1835) - lu(k,973) * lu(k,1823) + lu(k,1838) = lu(k,1838) - lu(k,974) * lu(k,1823) + lu(k,1839) = - lu(k,975) * lu(k,1823) + lu(k,1840) = lu(k,1840) - lu(k,976) * lu(k,1823) + lu(k,1844) = lu(k,1844) - lu(k,977) * lu(k,1823) + lu(k,1996) = lu(k,1996) - lu(k,970) * lu(k,1962) + lu(k,2006) = lu(k,2006) - lu(k,971) * lu(k,1962) + lu(k,2007) = lu(k,2007) - lu(k,972) * lu(k,1962) + lu(k,2008) = lu(k,2008) - lu(k,973) * lu(k,1962) + lu(k,2011) = lu(k,2011) - lu(k,974) * lu(k,1962) + lu(k,2012) = lu(k,2012) - lu(k,975) * lu(k,1962) + lu(k,2013) = lu(k,2013) - lu(k,976) * lu(k,1962) + lu(k,2017) = lu(k,2017) - lu(k,977) * lu(k,1962) + lu(k,2082) = lu(k,2082) - lu(k,970) * lu(k,2079) + lu(k,2091) = lu(k,2091) - lu(k,971) * lu(k,2079) + lu(k,2092) = - lu(k,972) * lu(k,2079) + lu(k,2093) = lu(k,2093) - lu(k,973) * lu(k,2079) + lu(k,2096) = lu(k,2096) - lu(k,974) * lu(k,2079) + lu(k,2097) = - lu(k,975) * lu(k,2079) + lu(k,2098) = lu(k,2098) - lu(k,976) * lu(k,2079) + lu(k,2102) = lu(k,2102) - lu(k,977) * lu(k,2079) + lu(k,2292) = - lu(k,970) * lu(k,2291) + lu(k,2301) = lu(k,2301) - lu(k,971) * lu(k,2291) + lu(k,2302) = lu(k,2302) - lu(k,972) * lu(k,2291) + lu(k,2303) = - lu(k,973) * lu(k,2291) + lu(k,2306) = lu(k,2306) - lu(k,974) * lu(k,2291) + lu(k,2307) = lu(k,2307) - lu(k,975) * lu(k,2291) + lu(k,2308) = - lu(k,976) * lu(k,2291) + lu(k,2312) = lu(k,2312) - lu(k,977) * lu(k,2291) + lu(k,2503) = lu(k,2503) - lu(k,970) * lu(k,2501) + lu(k,2513) = lu(k,2513) - lu(k,971) * lu(k,2501) + lu(k,2514) = - lu(k,972) * lu(k,2501) + lu(k,2515) = - lu(k,973) * lu(k,2501) + lu(k,2518) = lu(k,2518) - lu(k,974) * lu(k,2501) + lu(k,2519) = - lu(k,975) * lu(k,2501) + lu(k,2520) = - lu(k,976) * lu(k,2501) + lu(k,2524) = lu(k,2524) - lu(k,977) * lu(k,2501) + end do + end subroutine lu_fac20 + subroutine lu_fac21( 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,979) = 1._r8 / lu(k,979) + lu(k,980) = lu(k,980) * lu(k,979) + lu(k,981) = lu(k,981) * lu(k,979) + lu(k,982) = lu(k,982) * lu(k,979) + lu(k,983) = lu(k,983) * lu(k,979) + lu(k,984) = lu(k,984) * lu(k,979) + lu(k,985) = lu(k,985) * lu(k,979) + lu(k,986) = lu(k,986) * lu(k,979) + lu(k,987) = lu(k,987) * lu(k,979) + lu(k,988) = lu(k,988) * lu(k,979) + lu(k,989) = lu(k,989) * lu(k,979) + lu(k,1761) = lu(k,1761) - lu(k,980) * lu(k,1755) + lu(k,1765) = lu(k,1765) - lu(k,981) * lu(k,1755) + lu(k,1784) = lu(k,1784) - lu(k,982) * lu(k,1755) + lu(k,1787) = lu(k,1787) - lu(k,983) * lu(k,1755) + lu(k,1788) = lu(k,1788) - lu(k,984) * lu(k,1755) + lu(k,1790) = lu(k,1790) - lu(k,985) * lu(k,1755) + lu(k,1793) = lu(k,1793) - lu(k,986) * lu(k,1755) + lu(k,1797) = lu(k,1797) - lu(k,987) * lu(k,1755) + lu(k,1800) = lu(k,1800) - lu(k,988) * lu(k,1755) + lu(k,1801) = lu(k,1801) - lu(k,989) * lu(k,1755) + lu(k,1973) = lu(k,1973) - lu(k,980) * lu(k,1963) + lu(k,1978) = lu(k,1978) - lu(k,981) * lu(k,1963) + lu(k,2000) = lu(k,2000) - lu(k,982) * lu(k,1963) + lu(k,2003) = lu(k,2003) - lu(k,983) * lu(k,1963) + lu(k,2004) = lu(k,2004) - lu(k,984) * lu(k,1963) + lu(k,2006) = lu(k,2006) - lu(k,985) * lu(k,1963) + lu(k,2009) = lu(k,2009) - lu(k,986) * lu(k,1963) + lu(k,2013) = lu(k,2013) - lu(k,987) * lu(k,1963) + lu(k,2016) = lu(k,2016) - lu(k,988) * lu(k,1963) + lu(k,2017) = lu(k,2017) - lu(k,989) * lu(k,1963) + lu(k,2182) = lu(k,2182) - lu(k,980) * lu(k,2177) + lu(k,2185) = lu(k,2185) - lu(k,981) * lu(k,2177) + lu(k,2205) = lu(k,2205) - lu(k,982) * lu(k,2177) + lu(k,2208) = lu(k,2208) - lu(k,983) * lu(k,2177) + lu(k,2209) = lu(k,2209) - lu(k,984) * lu(k,2177) + lu(k,2211) = lu(k,2211) - lu(k,985) * lu(k,2177) + lu(k,2214) = lu(k,2214) - lu(k,986) * lu(k,2177) + lu(k,2218) = lu(k,2218) - lu(k,987) * lu(k,2177) + lu(k,2221) = lu(k,2221) - lu(k,988) * lu(k,2177) + lu(k,2222) = lu(k,2222) - lu(k,989) * lu(k,2177) + lu(k,2240) = - lu(k,980) * lu(k,2237) + lu(k,2241) = lu(k,2241) - lu(k,981) * lu(k,2237) + lu(k,2251) = lu(k,2251) - lu(k,982) * lu(k,2237) + lu(k,2254) = lu(k,2254) - lu(k,983) * lu(k,2237) + lu(k,2255) = lu(k,2255) - lu(k,984) * lu(k,2237) + lu(k,2257) = lu(k,2257) - lu(k,985) * lu(k,2237) + lu(k,2260) = lu(k,2260) - lu(k,986) * lu(k,2237) + lu(k,2264) = lu(k,2264) - lu(k,987) * lu(k,2237) + lu(k,2267) = lu(k,2267) - lu(k,988) * lu(k,2237) + lu(k,2268) = lu(k,2268) - lu(k,989) * lu(k,2237) + lu(k,2326) = lu(k,2326) - lu(k,980) * lu(k,2322) + lu(k,2330) = lu(k,2330) - lu(k,981) * lu(k,2322) + lu(k,2347) = lu(k,2347) - lu(k,982) * lu(k,2322) + lu(k,2350) = lu(k,2350) - lu(k,983) * lu(k,2322) + lu(k,2351) = lu(k,2351) - lu(k,984) * lu(k,2322) + lu(k,2353) = lu(k,2353) - lu(k,985) * lu(k,2322) + lu(k,2356) = lu(k,2356) - lu(k,986) * lu(k,2322) + lu(k,2360) = lu(k,2360) - lu(k,987) * lu(k,2322) + lu(k,2363) = lu(k,2363) - lu(k,988) * lu(k,2322) + lu(k,2364) = lu(k,2364) - lu(k,989) * lu(k,2322) + lu(k,991) = 1._r8 / lu(k,991) + lu(k,992) = lu(k,992) * lu(k,991) + lu(k,993) = lu(k,993) * lu(k,991) + lu(k,994) = lu(k,994) * lu(k,991) + lu(k,995) = lu(k,995) * lu(k,991) + lu(k,996) = lu(k,996) * lu(k,991) + lu(k,1520) = lu(k,1520) - lu(k,992) * lu(k,1519) + lu(k,1527) = lu(k,1527) - lu(k,993) * lu(k,1519) + lu(k,1528) = - lu(k,994) * lu(k,1519) + lu(k,1532) = lu(k,1532) - lu(k,995) * lu(k,1519) + lu(k,1533) = - lu(k,996) * lu(k,1519) + lu(k,1584) = lu(k,1584) - lu(k,992) * lu(k,1579) + lu(k,1592) = lu(k,1592) - lu(k,993) * lu(k,1579) + lu(k,1593) = lu(k,1593) - lu(k,994) * lu(k,1579) + lu(k,1597) = lu(k,1597) - lu(k,995) * lu(k,1579) + lu(k,1599) = - lu(k,996) * lu(k,1579) + lu(k,1605) = lu(k,1605) - lu(k,992) * lu(k,1604) + lu(k,1614) = lu(k,1614) - lu(k,993) * lu(k,1604) + lu(k,1616) = lu(k,1616) - lu(k,994) * lu(k,1604) + lu(k,1621) = lu(k,1621) - lu(k,995) * lu(k,1604) + lu(k,1623) = lu(k,1623) - lu(k,996) * lu(k,1604) + lu(k,1631) = lu(k,1631) - lu(k,992) * lu(k,1629) + lu(k,1640) = lu(k,1640) - lu(k,993) * lu(k,1629) + lu(k,1642) = lu(k,1642) - lu(k,994) * lu(k,1629) + lu(k,1648) = lu(k,1648) - lu(k,995) * lu(k,1629) + lu(k,1650) = lu(k,1650) - lu(k,996) * lu(k,1629) + lu(k,1675) = lu(k,1675) - lu(k,992) * lu(k,1665) + lu(k,1684) = lu(k,1684) - lu(k,993) * lu(k,1665) + lu(k,1687) = lu(k,1687) - lu(k,994) * lu(k,1665) + lu(k,1693) = lu(k,1693) - lu(k,995) * lu(k,1665) + lu(k,1695) = lu(k,1695) - lu(k,996) * lu(k,1665) + lu(k,1997) = lu(k,1997) - lu(k,992) * lu(k,1964) + lu(k,2006) = lu(k,2006) - lu(k,993) * lu(k,1964) + lu(k,2009) = lu(k,2009) - lu(k,994) * lu(k,1964) + lu(k,2015) = lu(k,2015) - lu(k,995) * lu(k,1964) + lu(k,2017) = lu(k,2017) - lu(k,996) * lu(k,1964) + lu(k,2058) = - lu(k,992) * lu(k,2028) + lu(k,2066) = lu(k,2066) - lu(k,993) * lu(k,2028) + lu(k,2069) = lu(k,2069) - lu(k,994) * lu(k,2028) + lu(k,2075) = lu(k,2075) - lu(k,995) * lu(k,2028) + lu(k,2077) = lu(k,2077) - lu(k,996) * lu(k,2028) + lu(k,2409) = lu(k,2409) - lu(k,992) * lu(k,2382) + lu(k,2417) = lu(k,2417) - lu(k,993) * lu(k,2382) + lu(k,2420) = lu(k,2420) - lu(k,994) * lu(k,2382) + lu(k,2426) = lu(k,2426) - lu(k,995) * lu(k,2382) + lu(k,2428) = lu(k,2428) - lu(k,996) * lu(k,2382) + lu(k,2451) = lu(k,2451) - lu(k,992) * lu(k,2445) + lu(k,2460) = lu(k,2460) - lu(k,993) * lu(k,2445) + lu(k,2463) = lu(k,2463) - lu(k,994) * lu(k,2445) + lu(k,2469) = lu(k,2469) - lu(k,995) * lu(k,2445) + lu(k,2471) = lu(k,2471) - lu(k,996) * lu(k,2445) + lu(k,2504) = - lu(k,992) * lu(k,2502) + lu(k,2513) = lu(k,2513) - lu(k,993) * lu(k,2502) + lu(k,2516) = - lu(k,994) * lu(k,2502) + lu(k,2522) = lu(k,2522) - lu(k,995) * lu(k,2502) + lu(k,2524) = lu(k,2524) - lu(k,996) * lu(k,2502) + lu(k,1006) = 1._r8 / lu(k,1006) + lu(k,1007) = lu(k,1007) * lu(k,1006) + lu(k,1008) = lu(k,1008) * lu(k,1006) + lu(k,1009) = lu(k,1009) * lu(k,1006) + lu(k,1010) = lu(k,1010) * lu(k,1006) + lu(k,1011) = lu(k,1011) * lu(k,1006) + lu(k,1012) = lu(k,1012) * lu(k,1006) + lu(k,1013) = lu(k,1013) * lu(k,1006) + lu(k,1014) = lu(k,1014) * lu(k,1006) + lu(k,1015) = lu(k,1015) * lu(k,1006) + lu(k,1016) = lu(k,1016) * lu(k,1006) + lu(k,1017) = lu(k,1017) * lu(k,1006) + lu(k,1018) = lu(k,1018) * lu(k,1006) + lu(k,1019) = lu(k,1019) * lu(k,1006) + lu(k,1020) = lu(k,1020) * lu(k,1006) + lu(k,1021) = lu(k,1021) * lu(k,1006) + lu(k,1022) = lu(k,1022) * lu(k,1006) + lu(k,1023) = lu(k,1023) * lu(k,1006) + lu(k,1024) = lu(k,1024) * lu(k,1006) + lu(k,1969) = lu(k,1969) - lu(k,1007) * lu(k,1965) + lu(k,1970) = lu(k,1970) - lu(k,1008) * lu(k,1965) + lu(k,1971) = lu(k,1971) - lu(k,1009) * lu(k,1965) + lu(k,1972) = lu(k,1972) - lu(k,1010) * lu(k,1965) + lu(k,1973) = lu(k,1973) - lu(k,1011) * lu(k,1965) + lu(k,1975) = lu(k,1975) - lu(k,1012) * lu(k,1965) + lu(k,1976) = lu(k,1976) - lu(k,1013) * lu(k,1965) + lu(k,1979) = lu(k,1979) - lu(k,1014) * lu(k,1965) + lu(k,1984) = lu(k,1984) - lu(k,1015) * lu(k,1965) + lu(k,1988) = lu(k,1988) - lu(k,1016) * lu(k,1965) + lu(k,1994) = lu(k,1994) - lu(k,1017) * lu(k,1965) + lu(k,1995) = lu(k,1995) - lu(k,1018) * lu(k,1965) + lu(k,2006) = lu(k,2006) - lu(k,1019) * lu(k,1965) + lu(k,2007) = lu(k,2007) - lu(k,1020) * lu(k,1965) + lu(k,2009) = lu(k,2009) - lu(k,1021) * lu(k,1965) + lu(k,2014) = lu(k,2014) - lu(k,1022) * lu(k,1965) + lu(k,2016) = lu(k,2016) - lu(k,1023) * lu(k,1965) + lu(k,2017) = lu(k,2017) - lu(k,1024) * lu(k,1965) + lu(k,2031) = - lu(k,1007) * lu(k,2029) + lu(k,2032) = lu(k,2032) - lu(k,1008) * lu(k,2029) + lu(k,2033) = - lu(k,1009) * lu(k,2029) + lu(k,2034) = lu(k,2034) - lu(k,1010) * lu(k,2029) + lu(k,2035) = lu(k,2035) - lu(k,1011) * lu(k,2029) + lu(k,2037) = lu(k,2037) - lu(k,1012) * lu(k,2029) + lu(k,2038) = - lu(k,1013) * lu(k,2029) + lu(k,2041) = lu(k,2041) - lu(k,1014) * lu(k,2029) + lu(k,2046) = - lu(k,1015) * lu(k,2029) + lu(k,2050) = lu(k,2050) - lu(k,1016) * lu(k,2029) + lu(k,2056) = lu(k,2056) - lu(k,1017) * lu(k,2029) + lu(k,2057) = lu(k,2057) - lu(k,1018) * lu(k,2029) + lu(k,2066) = lu(k,2066) - lu(k,1019) * lu(k,2029) + lu(k,2067) = lu(k,2067) - lu(k,1020) * lu(k,2029) + lu(k,2069) = lu(k,2069) - lu(k,1021) * lu(k,2029) + lu(k,2074) = lu(k,2074) - lu(k,1022) * lu(k,2029) + lu(k,2076) = lu(k,2076) - lu(k,1023) * lu(k,2029) + lu(k,2077) = lu(k,2077) - lu(k,1024) * lu(k,2029) + lu(k,2385) = lu(k,2385) - lu(k,1007) * lu(k,2383) + lu(k,2386) = lu(k,2386) - lu(k,1008) * lu(k,2383) + lu(k,2387) = - lu(k,1009) * lu(k,2383) + lu(k,2388) = lu(k,2388) - lu(k,1010) * lu(k,2383) + lu(k,2389) = lu(k,2389) - lu(k,1011) * lu(k,2383) + lu(k,2390) = - lu(k,1012) * lu(k,2383) + lu(k,2391) = lu(k,2391) - lu(k,1013) * lu(k,2383) + lu(k,2394) = lu(k,2394) - lu(k,1014) * lu(k,2383) + lu(k,2398) = lu(k,2398) - lu(k,1015) * lu(k,2383) + lu(k,2401) = lu(k,2401) - lu(k,1016) * lu(k,2383) + lu(k,2407) = lu(k,2407) - lu(k,1017) * lu(k,2383) + lu(k,2408) = lu(k,2408) - lu(k,1018) * lu(k,2383) + lu(k,2417) = lu(k,2417) - lu(k,1019) * lu(k,2383) + lu(k,2418) = lu(k,2418) - lu(k,1020) * lu(k,2383) + lu(k,2420) = lu(k,2420) - lu(k,1021) * lu(k,2383) + lu(k,2425) = lu(k,2425) - lu(k,1022) * lu(k,2383) + lu(k,2427) = lu(k,2427) - lu(k,1023) * lu(k,2383) + lu(k,2428) = lu(k,2428) - lu(k,1024) * lu(k,2383) + lu(k,1027) = 1._r8 / lu(k,1027) + lu(k,1028) = lu(k,1028) * lu(k,1027) + lu(k,1029) = lu(k,1029) * lu(k,1027) + lu(k,1030) = lu(k,1030) * lu(k,1027) + lu(k,1031) = lu(k,1031) * lu(k,1027) + lu(k,1032) = lu(k,1032) * lu(k,1027) + lu(k,1033) = lu(k,1033) * lu(k,1027) + lu(k,1034) = lu(k,1034) * lu(k,1027) + lu(k,1035) = lu(k,1035) * lu(k,1027) + lu(k,1036) = lu(k,1036) * lu(k,1027) + lu(k,1539) = lu(k,1539) - lu(k,1028) * lu(k,1538) + lu(k,1542) = lu(k,1542) - lu(k,1029) * lu(k,1538) + lu(k,1543) = - lu(k,1030) * lu(k,1538) + lu(k,1545) = lu(k,1545) - lu(k,1031) * lu(k,1538) + lu(k,1546) = - lu(k,1032) * lu(k,1538) + lu(k,1547) = lu(k,1547) - lu(k,1033) * lu(k,1538) + lu(k,1549) = lu(k,1549) - lu(k,1034) * lu(k,1538) + lu(k,1550) = lu(k,1550) - lu(k,1035) * lu(k,1538) + lu(k,1551) = lu(k,1551) - lu(k,1036) * lu(k,1538) + lu(k,1632) = lu(k,1632) - lu(k,1028) * lu(k,1630) + lu(k,1636) = lu(k,1636) - lu(k,1029) * lu(k,1630) + lu(k,1637) = lu(k,1637) - lu(k,1030) * lu(k,1630) + lu(k,1640) = lu(k,1640) - lu(k,1031) * lu(k,1630) + lu(k,1641) = - lu(k,1032) * lu(k,1630) + lu(k,1643) = lu(k,1643) - lu(k,1033) * lu(k,1630) + lu(k,1645) = - lu(k,1034) * lu(k,1630) + lu(k,1648) = lu(k,1648) - lu(k,1035) * lu(k,1630) + lu(k,1650) = lu(k,1650) - lu(k,1036) * lu(k,1630) + lu(k,1676) = lu(k,1676) - lu(k,1028) * lu(k,1666) + lu(k,1680) = lu(k,1680) - lu(k,1029) * lu(k,1666) + lu(k,1681) = lu(k,1681) - lu(k,1030) * lu(k,1666) + lu(k,1684) = lu(k,1684) - lu(k,1031) * lu(k,1666) + lu(k,1685) = lu(k,1685) - lu(k,1032) * lu(k,1666) + lu(k,1688) = lu(k,1688) - lu(k,1033) * lu(k,1666) + lu(k,1690) = lu(k,1690) - lu(k,1034) * lu(k,1666) + lu(k,1693) = lu(k,1693) - lu(k,1035) * lu(k,1666) + lu(k,1695) = lu(k,1695) - lu(k,1036) * lu(k,1666) + lu(k,1998) = lu(k,1998) - lu(k,1028) * lu(k,1966) + lu(k,2002) = lu(k,2002) - lu(k,1029) * lu(k,1966) + lu(k,2003) = lu(k,2003) - lu(k,1030) * lu(k,1966) + lu(k,2006) = lu(k,2006) - lu(k,1031) * lu(k,1966) + lu(k,2007) = lu(k,2007) - lu(k,1032) * lu(k,1966) + lu(k,2010) = lu(k,2010) - lu(k,1033) * lu(k,1966) + lu(k,2012) = lu(k,2012) - lu(k,1034) * lu(k,1966) + lu(k,2015) = lu(k,2015) - lu(k,1035) * lu(k,1966) + lu(k,2017) = lu(k,2017) - lu(k,1036) * lu(k,1966) + lu(k,2249) = lu(k,2249) - lu(k,1028) * lu(k,2238) + lu(k,2253) = lu(k,2253) - lu(k,1029) * lu(k,2238) + lu(k,2254) = lu(k,2254) - lu(k,1030) * lu(k,2238) + lu(k,2257) = lu(k,2257) - lu(k,1031) * lu(k,2238) + lu(k,2258) = lu(k,2258) - lu(k,1032) * lu(k,2238) + lu(k,2261) = lu(k,2261) - lu(k,1033) * lu(k,2238) + lu(k,2263) = - lu(k,1034) * lu(k,2238) + lu(k,2266) = lu(k,2266) - lu(k,1035) * lu(k,2238) + lu(k,2268) = lu(k,2268) - lu(k,1036) * lu(k,2238) + lu(k,2452) = lu(k,2452) - lu(k,1028) * lu(k,2446) + lu(k,2456) = lu(k,2456) - lu(k,1029) * lu(k,2446) + lu(k,2457) = lu(k,2457) - lu(k,1030) * lu(k,2446) + lu(k,2460) = lu(k,2460) - lu(k,1031) * lu(k,2446) + lu(k,2461) = lu(k,2461) - lu(k,1032) * lu(k,2446) + lu(k,2464) = lu(k,2464) - lu(k,1033) * lu(k,2446) + lu(k,2466) = lu(k,2466) - lu(k,1034) * lu(k,2446) + lu(k,2469) = lu(k,2469) - lu(k,1035) * lu(k,2446) + lu(k,2471) = lu(k,2471) - lu(k,1036) * lu(k,2446) + end do + end subroutine lu_fac21 + subroutine lu_fac22( 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,1043) = 1._r8 / lu(k,1043) + lu(k,1044) = lu(k,1044) * lu(k,1043) + lu(k,1045) = lu(k,1045) * lu(k,1043) + lu(k,1046) = lu(k,1046) * lu(k,1043) + lu(k,1047) = lu(k,1047) * lu(k,1043) + lu(k,1048) = lu(k,1048) * lu(k,1043) + lu(k,1049) = lu(k,1049) * lu(k,1043) + lu(k,1050) = lu(k,1050) * lu(k,1043) + lu(k,1051) = lu(k,1051) * lu(k,1043) + lu(k,1052) = lu(k,1052) * lu(k,1043) + lu(k,1493) = lu(k,1493) - lu(k,1044) * lu(k,1492) + lu(k,1494) = lu(k,1494) - lu(k,1045) * lu(k,1492) + lu(k,1495) = lu(k,1495) - lu(k,1046) * lu(k,1492) + lu(k,1496) = - lu(k,1047) * lu(k,1492) + lu(k,1497) = lu(k,1497) - lu(k,1048) * lu(k,1492) + lu(k,1498) = lu(k,1498) - lu(k,1049) * lu(k,1492) + lu(k,1499) = - lu(k,1050) * lu(k,1492) + lu(k,1501) = - lu(k,1051) * lu(k,1492) + lu(k,1502) = lu(k,1502) - lu(k,1052) * lu(k,1492) + lu(k,1581) = lu(k,1581) - lu(k,1044) * lu(k,1580) + lu(k,1583) = lu(k,1583) - lu(k,1045) * lu(k,1580) + lu(k,1586) = lu(k,1586) - lu(k,1046) * lu(k,1580) + lu(k,1589) = - lu(k,1047) * lu(k,1580) + lu(k,1590) = lu(k,1590) - lu(k,1048) * lu(k,1580) + lu(k,1591) = lu(k,1591) - lu(k,1049) * lu(k,1580) + lu(k,1592) = lu(k,1592) - lu(k,1050) * lu(k,1580) + lu(k,1595) = lu(k,1595) - lu(k,1051) * lu(k,1580) + lu(k,1597) = lu(k,1597) - lu(k,1052) * lu(k,1580) + lu(k,1669) = lu(k,1669) - lu(k,1044) * lu(k,1667) + lu(k,1674) = lu(k,1674) - lu(k,1045) * lu(k,1667) + lu(k,1678) = lu(k,1678) - lu(k,1046) * lu(k,1667) + lu(k,1681) = lu(k,1681) - lu(k,1047) * lu(k,1667) + lu(k,1682) = lu(k,1682) - lu(k,1048) * lu(k,1667) + lu(k,1683) = lu(k,1683) - lu(k,1049) * lu(k,1667) + lu(k,1684) = lu(k,1684) - lu(k,1050) * lu(k,1667) + lu(k,1689) = - lu(k,1051) * lu(k,1667) + lu(k,1693) = lu(k,1693) - lu(k,1052) * lu(k,1667) + lu(k,1766) = lu(k,1766) - lu(k,1044) * lu(k,1756) + lu(k,1782) = lu(k,1782) - lu(k,1045) * lu(k,1756) + lu(k,1784) = lu(k,1784) - lu(k,1046) * lu(k,1756) + lu(k,1787) = lu(k,1787) - lu(k,1047) * lu(k,1756) + lu(k,1788) = lu(k,1788) - lu(k,1048) * lu(k,1756) + lu(k,1789) = lu(k,1789) - lu(k,1049) * lu(k,1756) + lu(k,1790) = lu(k,1790) - lu(k,1050) * lu(k,1756) + lu(k,1795) = - lu(k,1051) * lu(k,1756) + lu(k,1799) = lu(k,1799) - lu(k,1052) * lu(k,1756) + lu(k,1979) = lu(k,1979) - lu(k,1044) * lu(k,1967) + lu(k,1995) = lu(k,1995) - lu(k,1045) * lu(k,1967) + lu(k,2000) = lu(k,2000) - lu(k,1046) * lu(k,1967) + lu(k,2003) = lu(k,2003) - lu(k,1047) * lu(k,1967) + lu(k,2004) = lu(k,2004) - lu(k,1048) * lu(k,1967) + lu(k,2005) = lu(k,2005) - lu(k,1049) * lu(k,1967) + lu(k,2006) = lu(k,2006) - lu(k,1050) * lu(k,1967) + lu(k,2011) = lu(k,2011) - lu(k,1051) * lu(k,1967) + lu(k,2015) = lu(k,2015) - lu(k,1052) * lu(k,1967) + lu(k,2448) = lu(k,2448) - lu(k,1044) * lu(k,2447) + lu(k,2449) = lu(k,2449) - lu(k,1045) * lu(k,2447) + lu(k,2454) = lu(k,2454) - lu(k,1046) * lu(k,2447) + lu(k,2457) = lu(k,2457) - lu(k,1047) * lu(k,2447) + lu(k,2458) = lu(k,2458) - lu(k,1048) * lu(k,2447) + lu(k,2459) = lu(k,2459) - lu(k,1049) * lu(k,2447) + lu(k,2460) = lu(k,2460) - lu(k,1050) * lu(k,2447) + lu(k,2465) = lu(k,2465) - lu(k,1051) * lu(k,2447) + lu(k,2469) = lu(k,2469) - lu(k,1052) * lu(k,2447) + lu(k,1062) = 1._r8 / lu(k,1062) + lu(k,1063) = lu(k,1063) * lu(k,1062) + lu(k,1064) = lu(k,1064) * lu(k,1062) + lu(k,1065) = lu(k,1065) * lu(k,1062) + lu(k,1066) = lu(k,1066) * lu(k,1062) + lu(k,1067) = lu(k,1067) * lu(k,1062) + lu(k,1068) = lu(k,1068) * lu(k,1062) + lu(k,1069) = lu(k,1069) * lu(k,1062) + lu(k,1070) = lu(k,1070) * lu(k,1062) + lu(k,1071) = lu(k,1071) * lu(k,1062) + lu(k,1072) = lu(k,1072) * lu(k,1062) + lu(k,1073) = lu(k,1073) * lu(k,1062) + lu(k,1074) = lu(k,1074) * lu(k,1062) + lu(k,1075) = lu(k,1075) * lu(k,1062) + lu(k,1076) = lu(k,1076) * lu(k,1062) + lu(k,1077) = lu(k,1077) * lu(k,1062) + lu(k,1078) = lu(k,1078) * lu(k,1062) + lu(k,1079) = lu(k,1079) * lu(k,1062) + lu(k,1080) = lu(k,1080) * lu(k,1062) + lu(k,1969) = lu(k,1969) - lu(k,1063) * lu(k,1968) + lu(k,1970) = lu(k,1970) - lu(k,1064) * lu(k,1968) + lu(k,1971) = lu(k,1971) - lu(k,1065) * lu(k,1968) + lu(k,1972) = lu(k,1972) - lu(k,1066) * lu(k,1968) + lu(k,1973) = lu(k,1973) - lu(k,1067) * lu(k,1968) + lu(k,1975) = lu(k,1975) - lu(k,1068) * lu(k,1968) + lu(k,1976) = lu(k,1976) - lu(k,1069) * lu(k,1968) + lu(k,1979) = lu(k,1979) - lu(k,1070) * lu(k,1968) + lu(k,1984) = lu(k,1984) - lu(k,1071) * lu(k,1968) + lu(k,1988) = lu(k,1988) - lu(k,1072) * lu(k,1968) + lu(k,1994) = lu(k,1994) - lu(k,1073) * lu(k,1968) + lu(k,1995) = lu(k,1995) - lu(k,1074) * lu(k,1968) + lu(k,2006) = lu(k,2006) - lu(k,1075) * lu(k,1968) + lu(k,2007) = lu(k,2007) - lu(k,1076) * lu(k,1968) + lu(k,2009) = lu(k,2009) - lu(k,1077) * lu(k,1968) + lu(k,2014) = lu(k,2014) - lu(k,1078) * lu(k,1968) + lu(k,2016) = lu(k,2016) - lu(k,1079) * lu(k,1968) + lu(k,2017) = lu(k,2017) - lu(k,1080) * lu(k,1968) + lu(k,2031) = lu(k,2031) - lu(k,1063) * lu(k,2030) + lu(k,2032) = lu(k,2032) - lu(k,1064) * lu(k,2030) + lu(k,2033) = lu(k,2033) - lu(k,1065) * lu(k,2030) + lu(k,2034) = lu(k,2034) - lu(k,1066) * lu(k,2030) + lu(k,2035) = lu(k,2035) - lu(k,1067) * lu(k,2030) + lu(k,2037) = lu(k,2037) - lu(k,1068) * lu(k,2030) + lu(k,2038) = lu(k,2038) - lu(k,1069) * lu(k,2030) + lu(k,2041) = lu(k,2041) - lu(k,1070) * lu(k,2030) + lu(k,2046) = lu(k,2046) - lu(k,1071) * lu(k,2030) + lu(k,2050) = lu(k,2050) - lu(k,1072) * lu(k,2030) + lu(k,2056) = lu(k,2056) - lu(k,1073) * lu(k,2030) + lu(k,2057) = lu(k,2057) - lu(k,1074) * lu(k,2030) + lu(k,2066) = lu(k,2066) - lu(k,1075) * lu(k,2030) + lu(k,2067) = lu(k,2067) - lu(k,1076) * lu(k,2030) + lu(k,2069) = lu(k,2069) - lu(k,1077) * lu(k,2030) + lu(k,2074) = lu(k,2074) - lu(k,1078) * lu(k,2030) + lu(k,2076) = lu(k,2076) - lu(k,1079) * lu(k,2030) + lu(k,2077) = lu(k,2077) - lu(k,1080) * lu(k,2030) + lu(k,2385) = lu(k,2385) - lu(k,1063) * lu(k,2384) + lu(k,2386) = lu(k,2386) - lu(k,1064) * lu(k,2384) + lu(k,2387) = lu(k,2387) - lu(k,1065) * lu(k,2384) + lu(k,2388) = lu(k,2388) - lu(k,1066) * lu(k,2384) + lu(k,2389) = lu(k,2389) - lu(k,1067) * lu(k,2384) + lu(k,2390) = lu(k,2390) - lu(k,1068) * lu(k,2384) + lu(k,2391) = lu(k,2391) - lu(k,1069) * lu(k,2384) + lu(k,2394) = lu(k,2394) - lu(k,1070) * lu(k,2384) + lu(k,2398) = lu(k,2398) - lu(k,1071) * lu(k,2384) + lu(k,2401) = lu(k,2401) - lu(k,1072) * lu(k,2384) + lu(k,2407) = lu(k,2407) - lu(k,1073) * lu(k,2384) + lu(k,2408) = lu(k,2408) - lu(k,1074) * lu(k,2384) + lu(k,2417) = lu(k,2417) - lu(k,1075) * lu(k,2384) + lu(k,2418) = lu(k,2418) - lu(k,1076) * lu(k,2384) + lu(k,2420) = lu(k,2420) - lu(k,1077) * lu(k,2384) + lu(k,2425) = lu(k,2425) - lu(k,1078) * lu(k,2384) + lu(k,2427) = lu(k,2427) - lu(k,1079) * lu(k,2384) + lu(k,2428) = lu(k,2428) - lu(k,1080) * lu(k,2384) + 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,1092) = lu(k,1092) * lu(k,1086) + lu(k,1093) = lu(k,1093) * lu(k,1086) + lu(k,1094) = lu(k,1094) * lu(k,1086) + lu(k,1095) = lu(k,1095) * lu(k,1086) + lu(k,1096) = lu(k,1096) * lu(k,1086) + lu(k,1761) = lu(k,1761) - lu(k,1087) * lu(k,1757) + lu(k,1765) = lu(k,1765) - lu(k,1088) * lu(k,1757) + lu(k,1781) = lu(k,1781) - lu(k,1089) * lu(k,1757) + lu(k,1784) = lu(k,1784) - lu(k,1090) * lu(k,1757) + lu(k,1787) = lu(k,1787) - lu(k,1091) * lu(k,1757) + lu(k,1788) = lu(k,1788) - lu(k,1092) * lu(k,1757) + lu(k,1790) = lu(k,1790) - lu(k,1093) * lu(k,1757) + lu(k,1793) = lu(k,1793) - lu(k,1094) * lu(k,1757) + lu(k,1797) = lu(k,1797) - lu(k,1095) * lu(k,1757) + lu(k,1800) = lu(k,1800) - lu(k,1096) * lu(k,1757) + lu(k,1973) = lu(k,1973) - lu(k,1087) * lu(k,1969) + lu(k,1978) = lu(k,1978) - lu(k,1088) * lu(k,1969) + lu(k,1994) = lu(k,1994) - lu(k,1089) * lu(k,1969) + lu(k,2000) = lu(k,2000) - lu(k,1090) * lu(k,1969) + lu(k,2003) = lu(k,2003) - lu(k,1091) * lu(k,1969) + lu(k,2004) = lu(k,2004) - lu(k,1092) * lu(k,1969) + lu(k,2006) = lu(k,2006) - lu(k,1093) * lu(k,1969) + lu(k,2009) = lu(k,2009) - lu(k,1094) * lu(k,1969) + lu(k,2013) = lu(k,2013) - lu(k,1095) * lu(k,1969) + lu(k,2016) = lu(k,2016) - lu(k,1096) * lu(k,1969) + lu(k,2035) = lu(k,2035) - lu(k,1087) * lu(k,2031) + lu(k,2040) = lu(k,2040) - lu(k,1088) * lu(k,2031) + lu(k,2056) = lu(k,2056) - lu(k,1089) * lu(k,2031) + lu(k,2060) = lu(k,2060) - lu(k,1090) * lu(k,2031) + lu(k,2063) = lu(k,2063) - lu(k,1091) * lu(k,2031) + lu(k,2064) = lu(k,2064) - lu(k,1092) * lu(k,2031) + lu(k,2066) = lu(k,2066) - lu(k,1093) * lu(k,2031) + lu(k,2069) = lu(k,2069) - lu(k,1094) * lu(k,2031) + lu(k,2073) = lu(k,2073) - lu(k,1095) * lu(k,2031) + lu(k,2076) = lu(k,2076) - lu(k,1096) * lu(k,2031) + lu(k,2182) = lu(k,2182) - lu(k,1087) * lu(k,2178) + lu(k,2185) = lu(k,2185) - lu(k,1088) * lu(k,2178) + lu(k,2200) = lu(k,2200) - lu(k,1089) * lu(k,2178) + lu(k,2205) = lu(k,2205) - lu(k,1090) * lu(k,2178) + lu(k,2208) = lu(k,2208) - lu(k,1091) * lu(k,2178) + lu(k,2209) = lu(k,2209) - lu(k,1092) * lu(k,2178) + lu(k,2211) = lu(k,2211) - lu(k,1093) * lu(k,2178) + lu(k,2214) = lu(k,2214) - lu(k,1094) * lu(k,2178) + lu(k,2218) = lu(k,2218) - lu(k,1095) * lu(k,2178) + lu(k,2221) = lu(k,2221) - lu(k,1096) * lu(k,2178) + lu(k,2389) = lu(k,2389) - lu(k,1087) * lu(k,2385) + lu(k,2393) = lu(k,2393) - lu(k,1088) * lu(k,2385) + lu(k,2407) = lu(k,2407) - lu(k,1089) * lu(k,2385) + lu(k,2411) = lu(k,2411) - lu(k,1090) * lu(k,2385) + lu(k,2414) = lu(k,2414) - lu(k,1091) * lu(k,2385) + lu(k,2415) = lu(k,2415) - lu(k,1092) * lu(k,2385) + lu(k,2417) = lu(k,2417) - lu(k,1093) * lu(k,2385) + lu(k,2420) = lu(k,2420) - lu(k,1094) * lu(k,2385) + lu(k,2424) = lu(k,2424) - lu(k,1095) * lu(k,2385) + lu(k,2427) = lu(k,2427) - lu(k,1096) * lu(k,2385) + lu(k,1098) = 1._r8 / lu(k,1098) + lu(k,1099) = lu(k,1099) * lu(k,1098) + lu(k,1100) = lu(k,1100) * lu(k,1098) + lu(k,1101) = lu(k,1101) * lu(k,1098) + lu(k,1102) = lu(k,1102) * lu(k,1098) + lu(k,1135) = lu(k,1135) - lu(k,1099) * lu(k,1133) + lu(k,1138) = - lu(k,1100) * lu(k,1133) + lu(k,1141) = lu(k,1141) - lu(k,1101) * lu(k,1133) + lu(k,1142) = lu(k,1142) - lu(k,1102) * lu(k,1133) + lu(k,1209) = lu(k,1209) - lu(k,1099) * lu(k,1208) + lu(k,1211) = lu(k,1211) - lu(k,1100) * lu(k,1208) + lu(k,1212) = lu(k,1212) - lu(k,1101) * lu(k,1208) + lu(k,1213) = lu(k,1213) - lu(k,1102) * lu(k,1208) + lu(k,1274) = lu(k,1274) - lu(k,1099) * lu(k,1273) + lu(k,1280) = lu(k,1280) - lu(k,1100) * lu(k,1273) + lu(k,1283) = lu(k,1283) - lu(k,1101) * lu(k,1273) + lu(k,1285) = lu(k,1285) - lu(k,1102) * lu(k,1273) + lu(k,1368) = lu(k,1368) - lu(k,1099) * lu(k,1367) + lu(k,1381) = - lu(k,1100) * lu(k,1367) + lu(k,1384) = lu(k,1384) - lu(k,1101) * lu(k,1367) + lu(k,1386) = lu(k,1386) - lu(k,1102) * lu(k,1367) + lu(k,1460) = lu(k,1460) - lu(k,1099) * lu(k,1458) + lu(k,1473) = lu(k,1473) - lu(k,1100) * lu(k,1458) + lu(k,1477) = lu(k,1477) - lu(k,1101) * lu(k,1458) + lu(k,1480) = lu(k,1480) - lu(k,1102) * lu(k,1458) + lu(k,1669) = lu(k,1669) - lu(k,1099) * lu(k,1668) + lu(k,1674) = lu(k,1674) - lu(k,1100) * lu(k,1668) + lu(k,1684) = lu(k,1684) - lu(k,1101) * lu(k,1668) + lu(k,1687) = lu(k,1687) - lu(k,1102) * lu(k,1668) + lu(k,1766) = lu(k,1766) - lu(k,1099) * lu(k,1758) + lu(k,1782) = lu(k,1782) - lu(k,1100) * lu(k,1758) + lu(k,1790) = lu(k,1790) - lu(k,1101) * lu(k,1758) + lu(k,1793) = lu(k,1793) - lu(k,1102) * lu(k,1758) + lu(k,1979) = lu(k,1979) - lu(k,1099) * lu(k,1970) + lu(k,1995) = lu(k,1995) - lu(k,1100) * lu(k,1970) + lu(k,2006) = lu(k,2006) - lu(k,1101) * lu(k,1970) + lu(k,2009) = lu(k,2009) - lu(k,1102) * lu(k,1970) + lu(k,2041) = lu(k,2041) - lu(k,1099) * lu(k,2032) + lu(k,2057) = lu(k,2057) - lu(k,1100) * lu(k,2032) + lu(k,2066) = lu(k,2066) - lu(k,1101) * lu(k,2032) + lu(k,2069) = lu(k,2069) - lu(k,1102) * lu(k,2032) + lu(k,2186) = lu(k,2186) - lu(k,1099) * lu(k,2179) + lu(k,2201) = lu(k,2201) - lu(k,1100) * lu(k,2179) + lu(k,2211) = lu(k,2211) - lu(k,1101) * lu(k,2179) + lu(k,2214) = lu(k,2214) - lu(k,1102) * lu(k,2179) + lu(k,2242) = lu(k,2242) - lu(k,1099) * lu(k,2239) + lu(k,2247) = lu(k,2247) - lu(k,1100) * lu(k,2239) + lu(k,2257) = lu(k,2257) - lu(k,1101) * lu(k,2239) + lu(k,2260) = lu(k,2260) - lu(k,1102) * lu(k,2239) + lu(k,2331) = lu(k,2331) - lu(k,1099) * lu(k,2323) + lu(k,2346) = lu(k,2346) - lu(k,1100) * lu(k,2323) + lu(k,2353) = lu(k,2353) - lu(k,1101) * lu(k,2323) + lu(k,2356) = lu(k,2356) - lu(k,1102) * lu(k,2323) + lu(k,2394) = lu(k,2394) - lu(k,1099) * lu(k,2386) + lu(k,2408) = lu(k,2408) - lu(k,1100) * lu(k,2386) + lu(k,2417) = lu(k,2417) - lu(k,1101) * lu(k,2386) + lu(k,2420) = lu(k,2420) - lu(k,1102) * lu(k,2386) + end do + end subroutine lu_fac22 + subroutine lu_fac23( 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,1106) = 1._r8 / lu(k,1106) + lu(k,1107) = lu(k,1107) * lu(k,1106) + lu(k,1108) = lu(k,1108) * lu(k,1106) + lu(k,1109) = lu(k,1109) * lu(k,1106) + lu(k,1110) = lu(k,1110) * lu(k,1106) + lu(k,1111) = lu(k,1111) * lu(k,1106) + lu(k,1112) = lu(k,1112) * lu(k,1106) + lu(k,1113) = lu(k,1113) * lu(k,1106) + lu(k,1114) = lu(k,1114) * lu(k,1106) + lu(k,1115) = lu(k,1115) * lu(k,1106) + lu(k,1760) = lu(k,1760) - lu(k,1107) * lu(k,1759) + lu(k,1761) = lu(k,1761) - lu(k,1108) * lu(k,1759) + lu(k,1787) = lu(k,1787) - lu(k,1109) * lu(k,1759) + lu(k,1788) = lu(k,1788) - lu(k,1110) * lu(k,1759) + lu(k,1790) = lu(k,1790) - lu(k,1111) * lu(k,1759) + lu(k,1793) = lu(k,1793) - lu(k,1112) * lu(k,1759) + lu(k,1796) = lu(k,1796) - lu(k,1113) * lu(k,1759) + lu(k,1797) = lu(k,1797) - lu(k,1114) * lu(k,1759) + lu(k,1800) = lu(k,1800) - lu(k,1115) * lu(k,1759) + lu(k,1972) = lu(k,1972) - lu(k,1107) * lu(k,1971) + lu(k,1973) = lu(k,1973) - lu(k,1108) * lu(k,1971) + lu(k,2003) = lu(k,2003) - lu(k,1109) * lu(k,1971) + lu(k,2004) = lu(k,2004) - lu(k,1110) * lu(k,1971) + lu(k,2006) = lu(k,2006) - lu(k,1111) * lu(k,1971) + lu(k,2009) = lu(k,2009) - lu(k,1112) * lu(k,1971) + lu(k,2012) = lu(k,2012) - lu(k,1113) * lu(k,1971) + lu(k,2013) = lu(k,2013) - lu(k,1114) * lu(k,1971) + lu(k,2016) = lu(k,2016) - lu(k,1115) * lu(k,1971) + lu(k,2034) = lu(k,2034) - lu(k,1107) * lu(k,2033) + lu(k,2035) = lu(k,2035) - lu(k,1108) * lu(k,2033) + lu(k,2063) = lu(k,2063) - lu(k,1109) * lu(k,2033) + lu(k,2064) = lu(k,2064) - lu(k,1110) * lu(k,2033) + lu(k,2066) = lu(k,2066) - lu(k,1111) * lu(k,2033) + lu(k,2069) = lu(k,2069) - lu(k,1112) * lu(k,2033) + lu(k,2072) = lu(k,2072) - lu(k,1113) * lu(k,2033) + lu(k,2073) = lu(k,2073) - lu(k,1114) * lu(k,2033) + lu(k,2076) = lu(k,2076) - lu(k,1115) * lu(k,2033) + lu(k,2181) = lu(k,2181) - lu(k,1107) * lu(k,2180) + lu(k,2182) = lu(k,2182) - lu(k,1108) * lu(k,2180) + lu(k,2208) = lu(k,2208) - lu(k,1109) * lu(k,2180) + lu(k,2209) = lu(k,2209) - lu(k,1110) * lu(k,2180) + lu(k,2211) = lu(k,2211) - lu(k,1111) * lu(k,2180) + lu(k,2214) = lu(k,2214) - lu(k,1112) * lu(k,2180) + lu(k,2217) = lu(k,2217) - lu(k,1113) * lu(k,2180) + lu(k,2218) = lu(k,2218) - lu(k,1114) * lu(k,2180) + lu(k,2221) = lu(k,2221) - lu(k,1115) * lu(k,2180) + lu(k,2325) = lu(k,2325) - lu(k,1107) * lu(k,2324) + lu(k,2326) = lu(k,2326) - lu(k,1108) * lu(k,2324) + lu(k,2350) = lu(k,2350) - lu(k,1109) * lu(k,2324) + lu(k,2351) = lu(k,2351) - lu(k,1110) * lu(k,2324) + lu(k,2353) = lu(k,2353) - lu(k,1111) * lu(k,2324) + lu(k,2356) = lu(k,2356) - lu(k,1112) * lu(k,2324) + lu(k,2359) = lu(k,2359) - lu(k,1113) * lu(k,2324) + lu(k,2360) = lu(k,2360) - lu(k,1114) * lu(k,2324) + lu(k,2363) = lu(k,2363) - lu(k,1115) * lu(k,2324) + lu(k,2388) = lu(k,2388) - lu(k,1107) * lu(k,2387) + lu(k,2389) = lu(k,2389) - lu(k,1108) * lu(k,2387) + lu(k,2414) = lu(k,2414) - lu(k,1109) * lu(k,2387) + lu(k,2415) = lu(k,2415) - lu(k,1110) * lu(k,2387) + lu(k,2417) = lu(k,2417) - lu(k,1111) * lu(k,2387) + lu(k,2420) = lu(k,2420) - lu(k,1112) * lu(k,2387) + lu(k,2423) = - lu(k,1113) * lu(k,2387) + lu(k,2424) = lu(k,2424) - lu(k,1114) * lu(k,2387) + lu(k,2427) = lu(k,2427) - lu(k,1115) * lu(k,2387) + lu(k,1116) = 1._r8 / lu(k,1116) + lu(k,1117) = lu(k,1117) * lu(k,1116) + lu(k,1118) = lu(k,1118) * lu(k,1116) + lu(k,1119) = lu(k,1119) * lu(k,1116) + lu(k,1120) = lu(k,1120) * lu(k,1116) + lu(k,1121) = lu(k,1121) * lu(k,1116) + lu(k,1122) = lu(k,1122) * lu(k,1116) + lu(k,1123) = lu(k,1123) * lu(k,1116) + lu(k,1150) = lu(k,1150) - lu(k,1117) * lu(k,1149) + lu(k,1151) = - lu(k,1118) * lu(k,1149) + lu(k,1152) = - lu(k,1119) * lu(k,1149) + lu(k,1153) = - lu(k,1120) * lu(k,1149) + lu(k,1156) = lu(k,1156) - lu(k,1121) * lu(k,1149) + lu(k,1157) = lu(k,1157) - lu(k,1122) * lu(k,1149) + lu(k,1158) = lu(k,1158) - lu(k,1123) * lu(k,1149) + lu(k,1763) = lu(k,1763) - lu(k,1117) * lu(k,1760) + lu(k,1764) = lu(k,1764) - lu(k,1118) * lu(k,1760) + lu(k,1766) = lu(k,1766) - lu(k,1119) * lu(k,1760) + lu(k,1768) = lu(k,1768) - lu(k,1120) * lu(k,1760) + lu(k,1790) = lu(k,1790) - lu(k,1121) * lu(k,1760) + lu(k,1791) = lu(k,1791) - lu(k,1122) * lu(k,1760) + lu(k,1793) = lu(k,1793) - lu(k,1123) * lu(k,1760) + lu(k,1975) = lu(k,1975) - lu(k,1117) * lu(k,1972) + lu(k,1976) = lu(k,1976) - lu(k,1118) * lu(k,1972) + lu(k,1979) = lu(k,1979) - lu(k,1119) * lu(k,1972) + lu(k,1981) = lu(k,1981) - lu(k,1120) * lu(k,1972) + lu(k,2006) = lu(k,2006) - lu(k,1121) * lu(k,1972) + lu(k,2007) = lu(k,2007) - lu(k,1122) * lu(k,1972) + lu(k,2009) = lu(k,2009) - lu(k,1123) * lu(k,1972) + lu(k,2037) = lu(k,2037) - lu(k,1117) * lu(k,2034) + lu(k,2038) = lu(k,2038) - lu(k,1118) * lu(k,2034) + lu(k,2041) = lu(k,2041) - lu(k,1119) * lu(k,2034) + lu(k,2043) = lu(k,2043) - lu(k,1120) * lu(k,2034) + lu(k,2066) = lu(k,2066) - lu(k,1121) * lu(k,2034) + lu(k,2067) = lu(k,2067) - lu(k,1122) * lu(k,2034) + lu(k,2069) = lu(k,2069) - lu(k,1123) * lu(k,2034) + lu(k,2183) = lu(k,2183) - lu(k,1117) * lu(k,2181) + lu(k,2184) = lu(k,2184) - lu(k,1118) * lu(k,2181) + lu(k,2186) = lu(k,2186) - lu(k,1119) * lu(k,2181) + lu(k,2188) = lu(k,2188) - lu(k,1120) * lu(k,2181) + lu(k,2211) = lu(k,2211) - lu(k,1121) * lu(k,2181) + lu(k,2212) = lu(k,2212) - lu(k,1122) * lu(k,2181) + lu(k,2214) = lu(k,2214) - lu(k,1123) * lu(k,2181) + lu(k,2328) = lu(k,2328) - lu(k,1117) * lu(k,2325) + lu(k,2329) = lu(k,2329) - lu(k,1118) * lu(k,2325) + lu(k,2331) = lu(k,2331) - lu(k,1119) * lu(k,2325) + lu(k,2333) = lu(k,2333) - lu(k,1120) * lu(k,2325) + lu(k,2353) = lu(k,2353) - lu(k,1121) * lu(k,2325) + lu(k,2354) = - lu(k,1122) * lu(k,2325) + lu(k,2356) = lu(k,2356) - lu(k,1123) * lu(k,2325) + lu(k,2390) = lu(k,2390) - lu(k,1117) * lu(k,2388) + lu(k,2391) = lu(k,2391) - lu(k,1118) * lu(k,2388) + lu(k,2394) = lu(k,2394) - lu(k,1119) * lu(k,2388) + lu(k,2396) = - lu(k,1120) * lu(k,2388) + lu(k,2417) = lu(k,2417) - lu(k,1121) * lu(k,2388) + lu(k,2418) = lu(k,2418) - lu(k,1122) * lu(k,2388) + lu(k,2420) = lu(k,2420) - lu(k,1123) * lu(k,2388) + lu(k,1124) = 1._r8 / lu(k,1124) + lu(k,1125) = lu(k,1125) * lu(k,1124) + lu(k,1126) = lu(k,1126) * lu(k,1124) + lu(k,1127) = lu(k,1127) * lu(k,1124) + lu(k,1128) = lu(k,1128) * lu(k,1124) + lu(k,1129) = lu(k,1129) * lu(k,1124) + lu(k,1165) = lu(k,1165) - lu(k,1125) * lu(k,1162) + lu(k,1166) = lu(k,1166) - lu(k,1126) * lu(k,1162) + lu(k,1168) = lu(k,1168) - lu(k,1127) * lu(k,1162) + lu(k,1170) = - lu(k,1128) * lu(k,1162) + lu(k,1172) = - lu(k,1129) * lu(k,1162) + lu(k,1223) = - lu(k,1125) * lu(k,1218) + lu(k,1224) = - lu(k,1126) * lu(k,1218) + lu(k,1228) = lu(k,1228) - lu(k,1127) * lu(k,1218) + lu(k,1231) = lu(k,1231) - lu(k,1128) * lu(k,1218) + lu(k,1233) = - lu(k,1129) * lu(k,1218) + lu(k,1241) = - lu(k,1125) * lu(k,1235) + lu(k,1242) = lu(k,1242) - lu(k,1126) * lu(k,1235) + lu(k,1245) = lu(k,1245) - lu(k,1127) * lu(k,1235) + lu(k,1249) = - lu(k,1128) * lu(k,1235) + lu(k,1251) = - lu(k,1129) * lu(k,1235) + lu(k,1771) = lu(k,1771) - lu(k,1125) * lu(k,1761) + lu(k,1781) = lu(k,1781) - lu(k,1126) * lu(k,1761) + lu(k,1790) = lu(k,1790) - lu(k,1127) * lu(k,1761) + lu(k,1797) = lu(k,1797) - lu(k,1128) * lu(k,1761) + lu(k,1801) = lu(k,1801) - lu(k,1129) * lu(k,1761) + lu(k,1984) = lu(k,1984) - lu(k,1125) * lu(k,1973) + lu(k,1994) = lu(k,1994) - lu(k,1126) * lu(k,1973) + lu(k,2006) = lu(k,2006) - lu(k,1127) * lu(k,1973) + lu(k,2013) = lu(k,2013) - lu(k,1128) * lu(k,1973) + lu(k,2017) = lu(k,2017) - lu(k,1129) * lu(k,1973) + lu(k,2046) = lu(k,2046) - lu(k,1125) * lu(k,2035) + lu(k,2056) = lu(k,2056) - lu(k,1126) * lu(k,2035) + lu(k,2066) = lu(k,2066) - lu(k,1127) * lu(k,2035) + lu(k,2073) = lu(k,2073) - lu(k,1128) * lu(k,2035) + lu(k,2077) = lu(k,2077) - lu(k,1129) * lu(k,2035) + lu(k,2190) = lu(k,2190) - lu(k,1125) * lu(k,2182) + lu(k,2200) = lu(k,2200) - lu(k,1126) * lu(k,2182) + lu(k,2211) = lu(k,2211) - lu(k,1127) * lu(k,2182) + lu(k,2218) = lu(k,2218) - lu(k,1128) * lu(k,2182) + lu(k,2222) = lu(k,2222) - lu(k,1129) * lu(k,2182) + lu(k,2244) = - lu(k,1125) * lu(k,2240) + lu(k,2246) = - lu(k,1126) * lu(k,2240) + lu(k,2257) = lu(k,2257) - lu(k,1127) * lu(k,2240) + lu(k,2264) = lu(k,2264) - lu(k,1128) * lu(k,2240) + lu(k,2268) = lu(k,2268) - lu(k,1129) * lu(k,2240) + lu(k,2335) = lu(k,2335) - lu(k,1125) * lu(k,2326) + lu(k,2345) = lu(k,2345) - lu(k,1126) * lu(k,2326) + lu(k,2353) = lu(k,2353) - lu(k,1127) * lu(k,2326) + lu(k,2360) = lu(k,2360) - lu(k,1128) * lu(k,2326) + lu(k,2364) = lu(k,2364) - lu(k,1129) * lu(k,2326) + lu(k,2398) = lu(k,2398) - lu(k,1125) * lu(k,2389) + lu(k,2407) = lu(k,2407) - lu(k,1126) * lu(k,2389) + lu(k,2417) = lu(k,2417) - lu(k,1127) * lu(k,2389) + lu(k,2424) = lu(k,2424) - lu(k,1128) * lu(k,2389) + lu(k,2428) = lu(k,2428) - lu(k,1129) * lu(k,2389) + lu(k,1134) = 1._r8 / lu(k,1134) + lu(k,1135) = lu(k,1135) * lu(k,1134) + lu(k,1136) = lu(k,1136) * lu(k,1134) + lu(k,1137) = lu(k,1137) * lu(k,1134) + lu(k,1138) = lu(k,1138) * lu(k,1134) + lu(k,1139) = lu(k,1139) * lu(k,1134) + lu(k,1140) = lu(k,1140) * lu(k,1134) + lu(k,1141) = lu(k,1141) * lu(k,1134) + lu(k,1142) = lu(k,1142) * lu(k,1134) + lu(k,1143) = lu(k,1143) * lu(k,1134) + lu(k,1144) = lu(k,1144) * lu(k,1134) + lu(k,1145) = lu(k,1145) * lu(k,1134) + lu(k,1294) = - lu(k,1135) * lu(k,1293) + lu(k,1299) = lu(k,1299) - lu(k,1136) * lu(k,1293) + lu(k,1301) = lu(k,1301) - lu(k,1137) * lu(k,1293) + lu(k,1302) = - lu(k,1138) * lu(k,1293) + lu(k,1303) = lu(k,1303) - lu(k,1139) * lu(k,1293) + lu(k,1304) = lu(k,1304) - lu(k,1140) * lu(k,1293) + lu(k,1305) = lu(k,1305) - lu(k,1141) * lu(k,1293) + lu(k,1307) = lu(k,1307) - lu(k,1142) * lu(k,1293) + lu(k,1308) = lu(k,1308) - lu(k,1143) * lu(k,1293) + lu(k,1309) = lu(k,1309) - lu(k,1144) * lu(k,1293) + lu(k,1310) = lu(k,1310) - lu(k,1145) * lu(k,1293) + lu(k,1460) = lu(k,1460) - lu(k,1135) * lu(k,1459) + lu(k,1466) = lu(k,1466) - lu(k,1136) * lu(k,1459) + lu(k,1472) = lu(k,1472) - lu(k,1137) * lu(k,1459) + lu(k,1473) = lu(k,1473) - lu(k,1138) * lu(k,1459) + lu(k,1475) = lu(k,1475) - lu(k,1139) * lu(k,1459) + lu(k,1476) = lu(k,1476) - lu(k,1140) * lu(k,1459) + lu(k,1477) = lu(k,1477) - lu(k,1141) * lu(k,1459) + lu(k,1480) = lu(k,1480) - lu(k,1142) * lu(k,1459) + lu(k,1481) = - lu(k,1143) * lu(k,1459) + lu(k,1482) = lu(k,1482) - lu(k,1144) * lu(k,1459) + lu(k,1484) = lu(k,1484) - lu(k,1145) * lu(k,1459) + lu(k,1766) = lu(k,1766) - lu(k,1135) * lu(k,1762) + lu(k,1775) = lu(k,1775) - lu(k,1136) * lu(k,1762) + lu(k,1781) = lu(k,1781) - lu(k,1137) * lu(k,1762) + lu(k,1782) = lu(k,1782) - lu(k,1138) * lu(k,1762) + lu(k,1787) = lu(k,1787) - lu(k,1139) * lu(k,1762) + lu(k,1788) = lu(k,1788) - lu(k,1140) * lu(k,1762) + lu(k,1790) = lu(k,1790) - lu(k,1141) * lu(k,1762) + lu(k,1793) = lu(k,1793) - lu(k,1142) * lu(k,1762) + lu(k,1796) = lu(k,1796) - lu(k,1143) * lu(k,1762) + lu(k,1797) = lu(k,1797) - lu(k,1144) * lu(k,1762) + lu(k,1800) = lu(k,1800) - lu(k,1145) * lu(k,1762) + lu(k,1979) = lu(k,1979) - lu(k,1135) * lu(k,1974) + lu(k,1988) = lu(k,1988) - lu(k,1136) * lu(k,1974) + lu(k,1994) = lu(k,1994) - lu(k,1137) * lu(k,1974) + lu(k,1995) = lu(k,1995) - lu(k,1138) * lu(k,1974) + lu(k,2003) = lu(k,2003) - lu(k,1139) * lu(k,1974) + lu(k,2004) = lu(k,2004) - lu(k,1140) * lu(k,1974) + lu(k,2006) = lu(k,2006) - lu(k,1141) * lu(k,1974) + lu(k,2009) = lu(k,2009) - lu(k,1142) * lu(k,1974) + lu(k,2012) = lu(k,2012) - lu(k,1143) * lu(k,1974) + lu(k,2013) = lu(k,2013) - lu(k,1144) * lu(k,1974) + lu(k,2016) = lu(k,2016) - lu(k,1145) * lu(k,1974) + lu(k,2041) = lu(k,2041) - lu(k,1135) * lu(k,2036) + lu(k,2050) = lu(k,2050) - lu(k,1136) * lu(k,2036) + lu(k,2056) = lu(k,2056) - lu(k,1137) * lu(k,2036) + lu(k,2057) = lu(k,2057) - lu(k,1138) * lu(k,2036) + lu(k,2063) = lu(k,2063) - lu(k,1139) * lu(k,2036) + lu(k,2064) = lu(k,2064) - lu(k,1140) * lu(k,2036) + lu(k,2066) = lu(k,2066) - lu(k,1141) * lu(k,2036) + lu(k,2069) = lu(k,2069) - lu(k,1142) * lu(k,2036) + lu(k,2072) = lu(k,2072) - lu(k,1143) * lu(k,2036) + lu(k,2073) = lu(k,2073) - lu(k,1144) * lu(k,2036) + lu(k,2076) = lu(k,2076) - lu(k,1145) * lu(k,2036) + lu(k,2331) = lu(k,2331) - lu(k,1135) * lu(k,2327) + lu(k,2339) = lu(k,2339) - lu(k,1136) * lu(k,2327) + lu(k,2345) = lu(k,2345) - lu(k,1137) * lu(k,2327) + lu(k,2346) = lu(k,2346) - lu(k,1138) * lu(k,2327) + lu(k,2350) = lu(k,2350) - lu(k,1139) * lu(k,2327) + lu(k,2351) = lu(k,2351) - lu(k,1140) * lu(k,2327) + lu(k,2353) = lu(k,2353) - lu(k,1141) * lu(k,2327) + lu(k,2356) = lu(k,2356) - lu(k,1142) * lu(k,2327) + lu(k,2359) = lu(k,2359) - lu(k,1143) * lu(k,2327) + lu(k,2360) = lu(k,2360) - lu(k,1144) * lu(k,2327) + lu(k,2363) = lu(k,2363) - lu(k,1145) * lu(k,2327) + end do + end subroutine lu_fac23 + subroutine lu_fac24( 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,1150) = 1._r8 / lu(k,1150) + lu(k,1151) = lu(k,1151) * lu(k,1150) + lu(k,1152) = lu(k,1152) * lu(k,1150) + lu(k,1153) = lu(k,1153) * lu(k,1150) + lu(k,1154) = lu(k,1154) * lu(k,1150) + lu(k,1155) = lu(k,1155) * lu(k,1150) + lu(k,1156) = lu(k,1156) * lu(k,1150) + lu(k,1157) = lu(k,1157) * lu(k,1150) + lu(k,1158) = lu(k,1158) * lu(k,1150) + lu(k,1159) = lu(k,1159) * lu(k,1150) + lu(k,1160) = lu(k,1160) * lu(k,1150) + lu(k,1161) = lu(k,1161) * lu(k,1150) + lu(k,1764) = lu(k,1764) - lu(k,1151) * lu(k,1763) + lu(k,1766) = lu(k,1766) - lu(k,1152) * lu(k,1763) + lu(k,1768) = lu(k,1768) - lu(k,1153) * lu(k,1763) + lu(k,1787) = lu(k,1787) - lu(k,1154) * lu(k,1763) + lu(k,1788) = lu(k,1788) - lu(k,1155) * lu(k,1763) + lu(k,1790) = lu(k,1790) - lu(k,1156) * lu(k,1763) + lu(k,1791) = lu(k,1791) - lu(k,1157) * lu(k,1763) + lu(k,1793) = lu(k,1793) - lu(k,1158) * lu(k,1763) + lu(k,1796) = lu(k,1796) - lu(k,1159) * lu(k,1763) + lu(k,1797) = lu(k,1797) - lu(k,1160) * lu(k,1763) + lu(k,1800) = lu(k,1800) - lu(k,1161) * lu(k,1763) + lu(k,1976) = lu(k,1976) - lu(k,1151) * lu(k,1975) + lu(k,1979) = lu(k,1979) - lu(k,1152) * lu(k,1975) + lu(k,1981) = lu(k,1981) - lu(k,1153) * lu(k,1975) + lu(k,2003) = lu(k,2003) - lu(k,1154) * lu(k,1975) + lu(k,2004) = lu(k,2004) - lu(k,1155) * lu(k,1975) + lu(k,2006) = lu(k,2006) - lu(k,1156) * lu(k,1975) + lu(k,2007) = lu(k,2007) - lu(k,1157) * lu(k,1975) + lu(k,2009) = lu(k,2009) - lu(k,1158) * lu(k,1975) + lu(k,2012) = lu(k,2012) - lu(k,1159) * lu(k,1975) + lu(k,2013) = lu(k,2013) - lu(k,1160) * lu(k,1975) + lu(k,2016) = lu(k,2016) - lu(k,1161) * lu(k,1975) + lu(k,2038) = lu(k,2038) - lu(k,1151) * lu(k,2037) + lu(k,2041) = lu(k,2041) - lu(k,1152) * lu(k,2037) + lu(k,2043) = lu(k,2043) - lu(k,1153) * lu(k,2037) + lu(k,2063) = lu(k,2063) - lu(k,1154) * lu(k,2037) + lu(k,2064) = lu(k,2064) - lu(k,1155) * lu(k,2037) + lu(k,2066) = lu(k,2066) - lu(k,1156) * lu(k,2037) + lu(k,2067) = lu(k,2067) - lu(k,1157) * lu(k,2037) + lu(k,2069) = lu(k,2069) - lu(k,1158) * lu(k,2037) + lu(k,2072) = lu(k,2072) - lu(k,1159) * lu(k,2037) + lu(k,2073) = lu(k,2073) - lu(k,1160) * lu(k,2037) + lu(k,2076) = lu(k,2076) - lu(k,1161) * lu(k,2037) + lu(k,2184) = lu(k,2184) - lu(k,1151) * lu(k,2183) + lu(k,2186) = lu(k,2186) - lu(k,1152) * lu(k,2183) + lu(k,2188) = lu(k,2188) - lu(k,1153) * lu(k,2183) + lu(k,2208) = lu(k,2208) - lu(k,1154) * lu(k,2183) + lu(k,2209) = lu(k,2209) - lu(k,1155) * lu(k,2183) + lu(k,2211) = lu(k,2211) - lu(k,1156) * lu(k,2183) + lu(k,2212) = lu(k,2212) - lu(k,1157) * lu(k,2183) + lu(k,2214) = lu(k,2214) - lu(k,1158) * lu(k,2183) + lu(k,2217) = lu(k,2217) - lu(k,1159) * lu(k,2183) + lu(k,2218) = lu(k,2218) - lu(k,1160) * lu(k,2183) + lu(k,2221) = lu(k,2221) - lu(k,1161) * lu(k,2183) + lu(k,2329) = lu(k,2329) - lu(k,1151) * lu(k,2328) + lu(k,2331) = lu(k,2331) - lu(k,1152) * lu(k,2328) + lu(k,2333) = lu(k,2333) - lu(k,1153) * lu(k,2328) + lu(k,2350) = lu(k,2350) - lu(k,1154) * lu(k,2328) + lu(k,2351) = lu(k,2351) - lu(k,1155) * lu(k,2328) + lu(k,2353) = lu(k,2353) - lu(k,1156) * lu(k,2328) + lu(k,2354) = lu(k,2354) - lu(k,1157) * lu(k,2328) + lu(k,2356) = lu(k,2356) - lu(k,1158) * lu(k,2328) + lu(k,2359) = lu(k,2359) - lu(k,1159) * lu(k,2328) + lu(k,2360) = lu(k,2360) - lu(k,1160) * lu(k,2328) + lu(k,2363) = lu(k,2363) - lu(k,1161) * lu(k,2328) + lu(k,2391) = lu(k,2391) - lu(k,1151) * lu(k,2390) + lu(k,2394) = lu(k,2394) - lu(k,1152) * lu(k,2390) + lu(k,2396) = lu(k,2396) - lu(k,1153) * lu(k,2390) + lu(k,2414) = lu(k,2414) - lu(k,1154) * lu(k,2390) + lu(k,2415) = lu(k,2415) - lu(k,1155) * lu(k,2390) + lu(k,2417) = lu(k,2417) - lu(k,1156) * lu(k,2390) + lu(k,2418) = lu(k,2418) - lu(k,1157) * lu(k,2390) + lu(k,2420) = lu(k,2420) - lu(k,1158) * lu(k,2390) + lu(k,2423) = lu(k,2423) - lu(k,1159) * lu(k,2390) + lu(k,2424) = lu(k,2424) - lu(k,1160) * lu(k,2390) + lu(k,2427) = lu(k,2427) - lu(k,1161) * lu(k,2390) + lu(k,1163) = 1._r8 / lu(k,1163) + lu(k,1164) = lu(k,1164) * lu(k,1163) + lu(k,1165) = lu(k,1165) * lu(k,1163) + lu(k,1166) = lu(k,1166) * lu(k,1163) + lu(k,1167) = lu(k,1167) * lu(k,1163) + lu(k,1168) = lu(k,1168) * lu(k,1163) + lu(k,1169) = lu(k,1169) * lu(k,1163) + lu(k,1170) = lu(k,1170) * lu(k,1163) + lu(k,1171) = lu(k,1171) * lu(k,1163) + lu(k,1172) = lu(k,1172) * lu(k,1163) + lu(k,1220) = lu(k,1220) - lu(k,1164) * lu(k,1219) + lu(k,1223) = lu(k,1223) - lu(k,1165) * lu(k,1219) + lu(k,1224) = lu(k,1224) - lu(k,1166) * lu(k,1219) + lu(k,1225) = lu(k,1225) - lu(k,1167) * lu(k,1219) + lu(k,1228) = lu(k,1228) - lu(k,1168) * lu(k,1219) + lu(k,1229) = lu(k,1229) - lu(k,1169) * lu(k,1219) + lu(k,1231) = lu(k,1231) - lu(k,1170) * lu(k,1219) + lu(k,1232) = lu(k,1232) - lu(k,1171) * lu(k,1219) + lu(k,1233) = lu(k,1233) - lu(k,1172) * lu(k,1219) + lu(k,1766) = lu(k,1766) - lu(k,1164) * lu(k,1764) + lu(k,1771) = lu(k,1771) - lu(k,1165) * lu(k,1764) + lu(k,1781) = lu(k,1781) - lu(k,1166) * lu(k,1764) + lu(k,1782) = lu(k,1782) - lu(k,1167) * lu(k,1764) + lu(k,1790) = lu(k,1790) - lu(k,1168) * lu(k,1764) + lu(k,1793) = lu(k,1793) - lu(k,1169) * lu(k,1764) + lu(k,1797) = lu(k,1797) - lu(k,1170) * lu(k,1764) + lu(k,1800) = lu(k,1800) - lu(k,1171) * lu(k,1764) + lu(k,1801) = lu(k,1801) - lu(k,1172) * lu(k,1764) + lu(k,1979) = lu(k,1979) - lu(k,1164) * lu(k,1976) + lu(k,1984) = lu(k,1984) - lu(k,1165) * lu(k,1976) + lu(k,1994) = lu(k,1994) - lu(k,1166) * lu(k,1976) + lu(k,1995) = lu(k,1995) - lu(k,1167) * lu(k,1976) + lu(k,2006) = lu(k,2006) - lu(k,1168) * lu(k,1976) + lu(k,2009) = lu(k,2009) - lu(k,1169) * lu(k,1976) + lu(k,2013) = lu(k,2013) - lu(k,1170) * lu(k,1976) + lu(k,2016) = lu(k,2016) - lu(k,1171) * lu(k,1976) + lu(k,2017) = lu(k,2017) - lu(k,1172) * lu(k,1976) + lu(k,2041) = lu(k,2041) - lu(k,1164) * lu(k,2038) + lu(k,2046) = lu(k,2046) - lu(k,1165) * lu(k,2038) + lu(k,2056) = lu(k,2056) - lu(k,1166) * lu(k,2038) + lu(k,2057) = lu(k,2057) - lu(k,1167) * lu(k,2038) + lu(k,2066) = lu(k,2066) - lu(k,1168) * lu(k,2038) + lu(k,2069) = lu(k,2069) - lu(k,1169) * lu(k,2038) + lu(k,2073) = lu(k,2073) - lu(k,1170) * lu(k,2038) + lu(k,2076) = lu(k,2076) - lu(k,1171) * lu(k,2038) + lu(k,2077) = lu(k,2077) - lu(k,1172) * lu(k,2038) + lu(k,2186) = lu(k,2186) - lu(k,1164) * lu(k,2184) + lu(k,2190) = lu(k,2190) - lu(k,1165) * lu(k,2184) + lu(k,2200) = lu(k,2200) - lu(k,1166) * lu(k,2184) + lu(k,2201) = lu(k,2201) - lu(k,1167) * lu(k,2184) + lu(k,2211) = lu(k,2211) - lu(k,1168) * lu(k,2184) + lu(k,2214) = lu(k,2214) - lu(k,1169) * lu(k,2184) + lu(k,2218) = lu(k,2218) - lu(k,1170) * lu(k,2184) + lu(k,2221) = lu(k,2221) - lu(k,1171) * lu(k,2184) + lu(k,2222) = lu(k,2222) - lu(k,1172) * lu(k,2184) + lu(k,2331) = lu(k,2331) - lu(k,1164) * lu(k,2329) + lu(k,2335) = lu(k,2335) - lu(k,1165) * lu(k,2329) + lu(k,2345) = lu(k,2345) - lu(k,1166) * lu(k,2329) + lu(k,2346) = lu(k,2346) - lu(k,1167) * lu(k,2329) + lu(k,2353) = lu(k,2353) - lu(k,1168) * lu(k,2329) + lu(k,2356) = lu(k,2356) - lu(k,1169) * lu(k,2329) + lu(k,2360) = lu(k,2360) - lu(k,1170) * lu(k,2329) + lu(k,2363) = lu(k,2363) - lu(k,1171) * lu(k,2329) + lu(k,2364) = lu(k,2364) - lu(k,1172) * lu(k,2329) + lu(k,2394) = lu(k,2394) - lu(k,1164) * lu(k,2391) + lu(k,2398) = lu(k,2398) - lu(k,1165) * lu(k,2391) + lu(k,2407) = lu(k,2407) - lu(k,1166) * lu(k,2391) + lu(k,2408) = lu(k,2408) - lu(k,1167) * lu(k,2391) + lu(k,2417) = lu(k,2417) - lu(k,1168) * lu(k,2391) + lu(k,2420) = lu(k,2420) - lu(k,1169) * lu(k,2391) + lu(k,2424) = lu(k,2424) - lu(k,1170) * lu(k,2391) + lu(k,2427) = lu(k,2427) - lu(k,1171) * lu(k,2391) + lu(k,2428) = lu(k,2428) - lu(k,1172) * lu(k,2391) + lu(k,1177) = 1._r8 / lu(k,1177) + lu(k,1178) = lu(k,1178) * lu(k,1177) + lu(k,1179) = lu(k,1179) * lu(k,1177) + lu(k,1180) = lu(k,1180) * lu(k,1177) + lu(k,1181) = lu(k,1181) * lu(k,1177) + lu(k,1182) = lu(k,1182) * lu(k,1177) + lu(k,1183) = lu(k,1183) * lu(k,1177) + lu(k,1184) = lu(k,1184) * lu(k,1177) + lu(k,1185) = lu(k,1185) * lu(k,1177) + lu(k,1186) = lu(k,1186) * lu(k,1177) + lu(k,1187) = lu(k,1187) * lu(k,1177) + lu(k,1188) = lu(k,1188) * lu(k,1177) + lu(k,1189) = lu(k,1189) * lu(k,1177) + lu(k,1190) = lu(k,1190) * lu(k,1177) + lu(k,1191) = lu(k,1191) * lu(k,1177) + lu(k,1192) = lu(k,1192) * lu(k,1177) + lu(k,1193) = lu(k,1193) * lu(k,1177) + lu(k,1194) = lu(k,1194) * lu(k,1177) + lu(k,1415) = lu(k,1415) - lu(k,1178) * lu(k,1414) + lu(k,1416) = lu(k,1416) - lu(k,1179) * lu(k,1414) + lu(k,1417) = - lu(k,1180) * lu(k,1414) + lu(k,1418) = lu(k,1418) - lu(k,1181) * lu(k,1414) + lu(k,1422) = lu(k,1422) - lu(k,1182) * lu(k,1414) + lu(k,1423) = lu(k,1423) - lu(k,1183) * lu(k,1414) + lu(k,1424) = - lu(k,1184) * lu(k,1414) + lu(k,1425) = - lu(k,1185) * lu(k,1414) + lu(k,1426) = - lu(k,1186) * lu(k,1414) + lu(k,1427) = lu(k,1427) - lu(k,1187) * lu(k,1414) + lu(k,1428) = - lu(k,1188) * lu(k,1414) + lu(k,1429) = - lu(k,1189) * lu(k,1414) + lu(k,1430) = lu(k,1430) - lu(k,1190) * lu(k,1414) + lu(k,1432) = lu(k,1432) - lu(k,1191) * lu(k,1414) + lu(k,1433) = lu(k,1433) - lu(k,1192) * lu(k,1414) + lu(k,1434) = lu(k,1434) - lu(k,1193) * lu(k,1414) + lu(k,1435) = lu(k,1435) - lu(k,1194) * lu(k,1414) + lu(k,1978) = lu(k,1978) - lu(k,1178) * lu(k,1977) + lu(k,1979) = lu(k,1979) - lu(k,1179) * lu(k,1977) + lu(k,1983) = lu(k,1983) - lu(k,1180) * lu(k,1977) + lu(k,1988) = lu(k,1988) - lu(k,1181) * lu(k,1977) + lu(k,1994) = lu(k,1994) - lu(k,1182) * lu(k,1977) + lu(k,1995) = lu(k,1995) - lu(k,1183) * lu(k,1977) + lu(k,2000) = lu(k,2000) - lu(k,1184) * lu(k,1977) + lu(k,2003) = lu(k,2003) - lu(k,1185) * lu(k,1977) + lu(k,2004) = lu(k,2004) - lu(k,1186) * lu(k,1977) + lu(k,2006) = lu(k,2006) - lu(k,1187) * lu(k,1977) + lu(k,2007) = lu(k,2007) - lu(k,1188) * lu(k,1977) + lu(k,2008) = lu(k,2008) - lu(k,1189) * lu(k,1977) + lu(k,2009) = lu(k,2009) - lu(k,1190) * lu(k,1977) + lu(k,2013) = lu(k,2013) - lu(k,1191) * lu(k,1977) + lu(k,2014) = lu(k,2014) - lu(k,1192) * lu(k,1977) + lu(k,2016) = lu(k,2016) - lu(k,1193) * lu(k,1977) + lu(k,2017) = lu(k,2017) - lu(k,1194) * lu(k,1977) + lu(k,2040) = lu(k,2040) - lu(k,1178) * lu(k,2039) + lu(k,2041) = lu(k,2041) - lu(k,1179) * lu(k,2039) + lu(k,2045) = lu(k,2045) - lu(k,1180) * lu(k,2039) + lu(k,2050) = lu(k,2050) - lu(k,1181) * lu(k,2039) + lu(k,2056) = lu(k,2056) - lu(k,1182) * lu(k,2039) + lu(k,2057) = lu(k,2057) - lu(k,1183) * lu(k,2039) + lu(k,2060) = lu(k,2060) - lu(k,1184) * lu(k,2039) + lu(k,2063) = lu(k,2063) - lu(k,1185) * lu(k,2039) + lu(k,2064) = lu(k,2064) - lu(k,1186) * lu(k,2039) + lu(k,2066) = lu(k,2066) - lu(k,1187) * lu(k,2039) + lu(k,2067) = lu(k,2067) - lu(k,1188) * lu(k,2039) + lu(k,2068) = - lu(k,1189) * lu(k,2039) + lu(k,2069) = lu(k,2069) - lu(k,1190) * lu(k,2039) + lu(k,2073) = lu(k,2073) - lu(k,1191) * lu(k,2039) + lu(k,2074) = lu(k,2074) - lu(k,1192) * lu(k,2039) + lu(k,2076) = lu(k,2076) - lu(k,1193) * lu(k,2039) + lu(k,2077) = lu(k,2077) - lu(k,1194) * lu(k,2039) + lu(k,2393) = lu(k,2393) - lu(k,1178) * lu(k,2392) + lu(k,2394) = lu(k,2394) - lu(k,1179) * lu(k,2392) + lu(k,2397) = - lu(k,1180) * lu(k,2392) + lu(k,2401) = lu(k,2401) - lu(k,1181) * lu(k,2392) + lu(k,2407) = lu(k,2407) - lu(k,1182) * lu(k,2392) + lu(k,2408) = lu(k,2408) - lu(k,1183) * lu(k,2392) + lu(k,2411) = lu(k,2411) - lu(k,1184) * lu(k,2392) + lu(k,2414) = lu(k,2414) - lu(k,1185) * lu(k,2392) + lu(k,2415) = lu(k,2415) - lu(k,1186) * lu(k,2392) + lu(k,2417) = lu(k,2417) - lu(k,1187) * lu(k,2392) + lu(k,2418) = lu(k,2418) - lu(k,1188) * lu(k,2392) + lu(k,2419) = lu(k,2419) - lu(k,1189) * lu(k,2392) + lu(k,2420) = lu(k,2420) - lu(k,1190) * lu(k,2392) + lu(k,2424) = lu(k,2424) - lu(k,1191) * lu(k,2392) + lu(k,2425) = lu(k,2425) - lu(k,1192) * lu(k,2392) + lu(k,2427) = lu(k,2427) - lu(k,1193) * lu(k,2392) + lu(k,2428) = lu(k,2428) - lu(k,1194) * lu(k,2392) + lu(k,1195) = 1._r8 / lu(k,1195) + lu(k,1196) = lu(k,1196) * lu(k,1195) + lu(k,1197) = lu(k,1197) * lu(k,1195) + lu(k,1198) = lu(k,1198) * lu(k,1195) + lu(k,1199) = lu(k,1199) * lu(k,1195) + lu(k,1200) = lu(k,1200) * lu(k,1195) + lu(k,1201) = lu(k,1201) * lu(k,1195) + lu(k,1202) = lu(k,1202) * lu(k,1195) + lu(k,1203) = lu(k,1203) * lu(k,1195) + lu(k,1237) = lu(k,1237) - lu(k,1196) * lu(k,1236) + lu(k,1242) = lu(k,1242) - lu(k,1197) * lu(k,1236) + lu(k,1245) = lu(k,1245) - lu(k,1198) * lu(k,1236) + lu(k,1246) = - lu(k,1199) * lu(k,1236) + lu(k,1247) = lu(k,1247) - lu(k,1200) * lu(k,1236) + lu(k,1248) = lu(k,1248) - lu(k,1201) * lu(k,1236) + lu(k,1249) = lu(k,1249) - lu(k,1202) * lu(k,1236) + lu(k,1251) = lu(k,1251) - lu(k,1203) * lu(k,1236) + lu(k,1416) = lu(k,1416) - lu(k,1196) * lu(k,1415) + lu(k,1422) = lu(k,1422) - lu(k,1197) * lu(k,1415) + lu(k,1427) = lu(k,1427) - lu(k,1198) * lu(k,1415) + lu(k,1428) = lu(k,1428) - lu(k,1199) * lu(k,1415) + lu(k,1430) = lu(k,1430) - lu(k,1200) * lu(k,1415) + lu(k,1431) = - lu(k,1201) * lu(k,1415) + lu(k,1432) = lu(k,1432) - lu(k,1202) * lu(k,1415) + lu(k,1435) = lu(k,1435) - lu(k,1203) * lu(k,1415) + lu(k,1766) = lu(k,1766) - lu(k,1196) * lu(k,1765) + lu(k,1781) = lu(k,1781) - lu(k,1197) * lu(k,1765) + lu(k,1790) = lu(k,1790) - lu(k,1198) * lu(k,1765) + lu(k,1791) = lu(k,1791) - lu(k,1199) * lu(k,1765) + lu(k,1793) = lu(k,1793) - lu(k,1200) * lu(k,1765) + lu(k,1796) = lu(k,1796) - lu(k,1201) * lu(k,1765) + lu(k,1797) = lu(k,1797) - lu(k,1202) * lu(k,1765) + lu(k,1801) = lu(k,1801) - lu(k,1203) * lu(k,1765) + lu(k,1979) = lu(k,1979) - lu(k,1196) * lu(k,1978) + lu(k,1994) = lu(k,1994) - lu(k,1197) * lu(k,1978) + lu(k,2006) = lu(k,2006) - lu(k,1198) * lu(k,1978) + lu(k,2007) = lu(k,2007) - lu(k,1199) * lu(k,1978) + lu(k,2009) = lu(k,2009) - lu(k,1200) * lu(k,1978) + lu(k,2012) = lu(k,2012) - lu(k,1201) * lu(k,1978) + lu(k,2013) = lu(k,2013) - lu(k,1202) * lu(k,1978) + lu(k,2017) = lu(k,2017) - lu(k,1203) * lu(k,1978) + lu(k,2041) = lu(k,2041) - lu(k,1196) * lu(k,2040) + lu(k,2056) = lu(k,2056) - lu(k,1197) * lu(k,2040) + lu(k,2066) = lu(k,2066) - lu(k,1198) * lu(k,2040) + lu(k,2067) = lu(k,2067) - lu(k,1199) * lu(k,2040) + lu(k,2069) = lu(k,2069) - lu(k,1200) * lu(k,2040) + lu(k,2072) = lu(k,2072) - lu(k,1201) * lu(k,2040) + lu(k,2073) = lu(k,2073) - lu(k,1202) * lu(k,2040) + lu(k,2077) = lu(k,2077) - lu(k,1203) * lu(k,2040) + lu(k,2186) = lu(k,2186) - lu(k,1196) * lu(k,2185) + lu(k,2200) = lu(k,2200) - lu(k,1197) * lu(k,2185) + lu(k,2211) = lu(k,2211) - lu(k,1198) * lu(k,2185) + lu(k,2212) = lu(k,2212) - lu(k,1199) * lu(k,2185) + lu(k,2214) = lu(k,2214) - lu(k,1200) * lu(k,2185) + lu(k,2217) = lu(k,2217) - lu(k,1201) * lu(k,2185) + lu(k,2218) = lu(k,2218) - lu(k,1202) * lu(k,2185) + lu(k,2222) = lu(k,2222) - lu(k,1203) * lu(k,2185) + lu(k,2242) = lu(k,2242) - lu(k,1196) * lu(k,2241) + lu(k,2246) = lu(k,2246) - lu(k,1197) * lu(k,2241) + lu(k,2257) = lu(k,2257) - lu(k,1198) * lu(k,2241) + lu(k,2258) = lu(k,2258) - lu(k,1199) * lu(k,2241) + lu(k,2260) = lu(k,2260) - lu(k,1200) * lu(k,2241) + lu(k,2263) = lu(k,2263) - lu(k,1201) * lu(k,2241) + lu(k,2264) = lu(k,2264) - lu(k,1202) * lu(k,2241) + lu(k,2268) = lu(k,2268) - lu(k,1203) * lu(k,2241) + lu(k,2331) = lu(k,2331) - lu(k,1196) * lu(k,2330) + lu(k,2345) = lu(k,2345) - lu(k,1197) * lu(k,2330) + lu(k,2353) = lu(k,2353) - lu(k,1198) * lu(k,2330) + lu(k,2354) = lu(k,2354) - lu(k,1199) * lu(k,2330) + lu(k,2356) = lu(k,2356) - lu(k,1200) * lu(k,2330) + lu(k,2359) = lu(k,2359) - lu(k,1201) * lu(k,2330) + lu(k,2360) = lu(k,2360) - lu(k,1202) * lu(k,2330) + lu(k,2364) = lu(k,2364) - lu(k,1203) * lu(k,2330) + lu(k,2394) = lu(k,2394) - lu(k,1196) * lu(k,2393) + lu(k,2407) = lu(k,2407) - lu(k,1197) * lu(k,2393) + lu(k,2417) = lu(k,2417) - lu(k,1198) * lu(k,2393) + lu(k,2418) = lu(k,2418) - lu(k,1199) * lu(k,2393) + lu(k,2420) = lu(k,2420) - lu(k,1200) * lu(k,2393) + lu(k,2423) = lu(k,2423) - lu(k,1201) * lu(k,2393) + lu(k,2424) = lu(k,2424) - lu(k,1202) * lu(k,2393) + lu(k,2428) = lu(k,2428) - lu(k,1203) * lu(k,2393) + end do + end subroutine lu_fac24 + subroutine lu_fac25( 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,1204) = 1._r8 / lu(k,1204) + lu(k,1205) = lu(k,1205) * lu(k,1204) + lu(k,1206) = lu(k,1206) * lu(k,1204) + lu(k,1207) = lu(k,1207) * lu(k,1204) + lu(k,1211) = lu(k,1211) - lu(k,1205) * lu(k,1209) + lu(k,1212) = lu(k,1212) - lu(k,1206) * lu(k,1209) + lu(k,1213) = lu(k,1213) - lu(k,1207) * lu(k,1209) + lu(k,1225) = lu(k,1225) - lu(k,1205) * lu(k,1220) + lu(k,1228) = lu(k,1228) - lu(k,1206) * lu(k,1220) + lu(k,1229) = lu(k,1229) - lu(k,1207) * lu(k,1220) + lu(k,1243) = - lu(k,1205) * lu(k,1237) + lu(k,1245) = lu(k,1245) - lu(k,1206) * lu(k,1237) + lu(k,1247) = lu(k,1247) - lu(k,1207) * lu(k,1237) + lu(k,1280) = lu(k,1280) - lu(k,1205) * lu(k,1274) + lu(k,1283) = lu(k,1283) - lu(k,1206) * lu(k,1274) + lu(k,1285) = lu(k,1285) - lu(k,1207) * lu(k,1274) + lu(k,1302) = lu(k,1302) - lu(k,1205) * lu(k,1294) + lu(k,1305) = lu(k,1305) - lu(k,1206) * lu(k,1294) + lu(k,1307) = lu(k,1307) - lu(k,1207) * lu(k,1294) + lu(k,1318) = lu(k,1318) - lu(k,1205) * lu(k,1312) + lu(k,1319) = lu(k,1319) - lu(k,1206) * lu(k,1312) + lu(k,1320) = lu(k,1320) - lu(k,1207) * lu(k,1312) + lu(k,1327) = - lu(k,1205) * lu(k,1324) + lu(k,1328) = lu(k,1328) - lu(k,1206) * lu(k,1324) + lu(k,1330) = lu(k,1330) - lu(k,1207) * lu(k,1324) + lu(k,1381) = lu(k,1381) - lu(k,1205) * lu(k,1368) + lu(k,1384) = lu(k,1384) - lu(k,1206) * lu(k,1368) + lu(k,1386) = lu(k,1386) - lu(k,1207) * lu(k,1368) + lu(k,1403) = - lu(k,1205) * lu(k,1394) + lu(k,1406) = lu(k,1406) - lu(k,1206) * lu(k,1394) + lu(k,1408) = lu(k,1408) - lu(k,1207) * lu(k,1394) + lu(k,1423) = lu(k,1423) - lu(k,1205) * lu(k,1416) + lu(k,1427) = lu(k,1427) - lu(k,1206) * lu(k,1416) + lu(k,1430) = lu(k,1430) - lu(k,1207) * lu(k,1416) + lu(k,1473) = lu(k,1473) - lu(k,1205) * lu(k,1460) + lu(k,1477) = lu(k,1477) - lu(k,1206) * lu(k,1460) + lu(k,1480) = lu(k,1480) - lu(k,1207) * lu(k,1460) + lu(k,1494) = lu(k,1494) - lu(k,1205) * lu(k,1493) + lu(k,1499) = lu(k,1499) - lu(k,1206) * lu(k,1493) + lu(k,1500) = - lu(k,1207) * lu(k,1493) + lu(k,1554) = - lu(k,1205) * lu(k,1553) + lu(k,1561) = lu(k,1561) - lu(k,1206) * lu(k,1553) + lu(k,1562) = lu(k,1562) - lu(k,1207) * lu(k,1553) + lu(k,1583) = lu(k,1583) - lu(k,1205) * lu(k,1581) + lu(k,1592) = lu(k,1592) - lu(k,1206) * lu(k,1581) + lu(k,1593) = lu(k,1593) - lu(k,1207) * lu(k,1581) + lu(k,1674) = lu(k,1674) - lu(k,1205) * lu(k,1669) + lu(k,1684) = lu(k,1684) - lu(k,1206) * lu(k,1669) + lu(k,1687) = lu(k,1687) - lu(k,1207) * lu(k,1669) + lu(k,1782) = lu(k,1782) - lu(k,1205) * lu(k,1766) + lu(k,1790) = lu(k,1790) - lu(k,1206) * lu(k,1766) + lu(k,1793) = lu(k,1793) - lu(k,1207) * lu(k,1766) + lu(k,1995) = lu(k,1995) - lu(k,1205) * lu(k,1979) + lu(k,2006) = lu(k,2006) - lu(k,1206) * lu(k,1979) + lu(k,2009) = lu(k,2009) - lu(k,1207) * lu(k,1979) + lu(k,2057) = lu(k,2057) - lu(k,1205) * lu(k,2041) + lu(k,2066) = lu(k,2066) - lu(k,1206) * lu(k,2041) + lu(k,2069) = lu(k,2069) - lu(k,1207) * lu(k,2041) + lu(k,2081) = lu(k,2081) - lu(k,1205) * lu(k,2080) + lu(k,2091) = lu(k,2091) - lu(k,1206) * lu(k,2080) + lu(k,2094) = lu(k,2094) - lu(k,1207) * lu(k,2080) + lu(k,2201) = lu(k,2201) - lu(k,1205) * lu(k,2186) + lu(k,2211) = lu(k,2211) - lu(k,1206) * lu(k,2186) + lu(k,2214) = lu(k,2214) - lu(k,1207) * lu(k,2186) + lu(k,2247) = lu(k,2247) - lu(k,1205) * lu(k,2242) + lu(k,2257) = lu(k,2257) - lu(k,1206) * lu(k,2242) + lu(k,2260) = lu(k,2260) - lu(k,1207) * lu(k,2242) + lu(k,2346) = lu(k,2346) - lu(k,1205) * lu(k,2331) + lu(k,2353) = lu(k,2353) - lu(k,1206) * lu(k,2331) + lu(k,2356) = lu(k,2356) - lu(k,1207) * lu(k,2331) + lu(k,2408) = lu(k,2408) - lu(k,1205) * lu(k,2394) + lu(k,2417) = lu(k,2417) - lu(k,1206) * lu(k,2394) + lu(k,2420) = lu(k,2420) - lu(k,1207) * lu(k,2394) + lu(k,2449) = lu(k,2449) - lu(k,1205) * lu(k,2448) + lu(k,2460) = lu(k,2460) - lu(k,1206) * lu(k,2448) + lu(k,2463) = lu(k,2463) - lu(k,1207) * lu(k,2448) + lu(k,2476) = lu(k,2476) - lu(k,1205) * lu(k,2475) + lu(k,2486) = lu(k,2486) - lu(k,1206) * lu(k,2475) + lu(k,2489) = lu(k,2489) - lu(k,1207) * lu(k,2475) + lu(k,1210) = 1._r8 / lu(k,1210) + lu(k,1211) = lu(k,1211) * lu(k,1210) + lu(k,1212) = lu(k,1212) * lu(k,1210) + lu(k,1213) = lu(k,1213) * lu(k,1210) + lu(k,1214) = lu(k,1214) * lu(k,1210) + lu(k,1225) = lu(k,1225) - lu(k,1211) * lu(k,1221) + lu(k,1228) = lu(k,1228) - lu(k,1212) * lu(k,1221) + lu(k,1229) = lu(k,1229) - lu(k,1213) * lu(k,1221) + lu(k,1232) = lu(k,1232) - lu(k,1214) * lu(k,1221) + lu(k,1243) = lu(k,1243) - lu(k,1211) * lu(k,1238) + lu(k,1245) = lu(k,1245) - lu(k,1212) * lu(k,1238) + lu(k,1247) = lu(k,1247) - lu(k,1213) * lu(k,1238) + lu(k,1250) = lu(k,1250) - lu(k,1214) * lu(k,1238) + lu(k,1280) = lu(k,1280) - lu(k,1211) * lu(k,1275) + lu(k,1283) = lu(k,1283) - lu(k,1212) * lu(k,1275) + lu(k,1285) = lu(k,1285) - lu(k,1213) * lu(k,1275) + lu(k,1287) = lu(k,1287) - lu(k,1214) * lu(k,1275) + lu(k,1302) = lu(k,1302) - lu(k,1211) * lu(k,1295) + lu(k,1305) = lu(k,1305) - lu(k,1212) * lu(k,1295) + lu(k,1307) = lu(k,1307) - lu(k,1213) * lu(k,1295) + lu(k,1310) = lu(k,1310) - lu(k,1214) * lu(k,1295) + lu(k,1348) = lu(k,1348) - lu(k,1211) * lu(k,1336) + lu(k,1351) = lu(k,1351) - lu(k,1212) * lu(k,1336) + lu(k,1353) = lu(k,1353) - lu(k,1213) * lu(k,1336) + lu(k,1357) = lu(k,1357) - lu(k,1214) * lu(k,1336) + lu(k,1381) = lu(k,1381) - lu(k,1211) * lu(k,1369) + lu(k,1384) = lu(k,1384) - lu(k,1212) * lu(k,1369) + lu(k,1386) = lu(k,1386) - lu(k,1213) * lu(k,1369) + lu(k,1390) = lu(k,1390) - lu(k,1214) * lu(k,1369) + lu(k,1403) = lu(k,1403) - lu(k,1211) * lu(k,1395) + lu(k,1406) = lu(k,1406) - lu(k,1212) * lu(k,1395) + lu(k,1408) = lu(k,1408) - lu(k,1213) * lu(k,1395) + lu(k,1411) = lu(k,1411) - lu(k,1214) * lu(k,1395) + lu(k,1473) = lu(k,1473) - lu(k,1211) * lu(k,1461) + lu(k,1477) = lu(k,1477) - lu(k,1212) * lu(k,1461) + lu(k,1480) = lu(k,1480) - lu(k,1213) * lu(k,1461) + lu(k,1484) = lu(k,1484) - lu(k,1214) * lu(k,1461) + lu(k,1583) = lu(k,1583) - lu(k,1211) * lu(k,1582) + lu(k,1592) = lu(k,1592) - lu(k,1212) * lu(k,1582) + lu(k,1593) = lu(k,1593) - lu(k,1213) * lu(k,1582) + lu(k,1598) = lu(k,1598) - lu(k,1214) * lu(k,1582) + lu(k,1782) = lu(k,1782) - lu(k,1211) * lu(k,1767) + lu(k,1790) = lu(k,1790) - lu(k,1212) * lu(k,1767) + lu(k,1793) = lu(k,1793) - lu(k,1213) * lu(k,1767) + lu(k,1800) = lu(k,1800) - lu(k,1214) * lu(k,1767) + lu(k,1995) = lu(k,1995) - lu(k,1211) * lu(k,1980) + lu(k,2006) = lu(k,2006) - lu(k,1212) * lu(k,1980) + lu(k,2009) = lu(k,2009) - lu(k,1213) * lu(k,1980) + lu(k,2016) = lu(k,2016) - lu(k,1214) * lu(k,1980) + lu(k,2057) = lu(k,2057) - lu(k,1211) * lu(k,2042) + lu(k,2066) = lu(k,2066) - lu(k,1212) * lu(k,2042) + lu(k,2069) = lu(k,2069) - lu(k,1213) * lu(k,2042) + lu(k,2076) = lu(k,2076) - lu(k,1214) * lu(k,2042) + lu(k,2201) = lu(k,2201) - lu(k,1211) * lu(k,2187) + lu(k,2211) = lu(k,2211) - lu(k,1212) * lu(k,2187) + lu(k,2214) = lu(k,2214) - lu(k,1213) * lu(k,2187) + lu(k,2221) = lu(k,2221) - lu(k,1214) * lu(k,2187) + lu(k,2247) = lu(k,2247) - lu(k,1211) * lu(k,2243) + lu(k,2257) = lu(k,2257) - lu(k,1212) * lu(k,2243) + lu(k,2260) = lu(k,2260) - lu(k,1213) * lu(k,2243) + lu(k,2267) = lu(k,2267) - lu(k,1214) * lu(k,2243) + lu(k,2346) = lu(k,2346) - lu(k,1211) * lu(k,2332) + lu(k,2353) = lu(k,2353) - lu(k,1212) * lu(k,2332) + lu(k,2356) = lu(k,2356) - lu(k,1213) * lu(k,2332) + lu(k,2363) = lu(k,2363) - lu(k,1214) * lu(k,2332) + lu(k,2408) = lu(k,2408) - lu(k,1211) * lu(k,2395) + lu(k,2417) = lu(k,2417) - lu(k,1212) * lu(k,2395) + lu(k,2420) = lu(k,2420) - lu(k,1213) * lu(k,2395) + lu(k,2427) = lu(k,2427) - lu(k,1214) * lu(k,2395) + lu(k,1222) = 1._r8 / lu(k,1222) + lu(k,1223) = lu(k,1223) * lu(k,1222) + lu(k,1224) = lu(k,1224) * lu(k,1222) + lu(k,1225) = lu(k,1225) * lu(k,1222) + lu(k,1226) = lu(k,1226) * lu(k,1222) + lu(k,1227) = lu(k,1227) * lu(k,1222) + lu(k,1228) = lu(k,1228) * lu(k,1222) + lu(k,1229) = lu(k,1229) * lu(k,1222) + lu(k,1230) = lu(k,1230) * lu(k,1222) + lu(k,1231) = lu(k,1231) * lu(k,1222) + lu(k,1232) = lu(k,1232) * lu(k,1222) + lu(k,1233) = lu(k,1233) * lu(k,1222) + lu(k,1771) = lu(k,1771) - lu(k,1223) * lu(k,1768) + lu(k,1781) = lu(k,1781) - lu(k,1224) * lu(k,1768) + lu(k,1782) = lu(k,1782) - lu(k,1225) * lu(k,1768) + lu(k,1787) = lu(k,1787) - lu(k,1226) * lu(k,1768) + lu(k,1788) = lu(k,1788) - lu(k,1227) * lu(k,1768) + lu(k,1790) = lu(k,1790) - lu(k,1228) * lu(k,1768) + lu(k,1793) = lu(k,1793) - lu(k,1229) * lu(k,1768) + lu(k,1796) = lu(k,1796) - lu(k,1230) * lu(k,1768) + lu(k,1797) = lu(k,1797) - lu(k,1231) * lu(k,1768) + lu(k,1800) = lu(k,1800) - lu(k,1232) * lu(k,1768) + lu(k,1801) = lu(k,1801) - lu(k,1233) * lu(k,1768) + lu(k,1984) = lu(k,1984) - lu(k,1223) * lu(k,1981) + lu(k,1994) = lu(k,1994) - lu(k,1224) * lu(k,1981) + lu(k,1995) = lu(k,1995) - lu(k,1225) * lu(k,1981) + lu(k,2003) = lu(k,2003) - lu(k,1226) * lu(k,1981) + lu(k,2004) = lu(k,2004) - lu(k,1227) * lu(k,1981) + lu(k,2006) = lu(k,2006) - lu(k,1228) * lu(k,1981) + lu(k,2009) = lu(k,2009) - lu(k,1229) * lu(k,1981) + lu(k,2012) = lu(k,2012) - lu(k,1230) * lu(k,1981) + lu(k,2013) = lu(k,2013) - lu(k,1231) * lu(k,1981) + lu(k,2016) = lu(k,2016) - lu(k,1232) * lu(k,1981) + lu(k,2017) = lu(k,2017) - lu(k,1233) * lu(k,1981) + lu(k,2046) = lu(k,2046) - lu(k,1223) * lu(k,2043) + lu(k,2056) = lu(k,2056) - lu(k,1224) * lu(k,2043) + lu(k,2057) = lu(k,2057) - lu(k,1225) * lu(k,2043) + lu(k,2063) = lu(k,2063) - lu(k,1226) * lu(k,2043) + lu(k,2064) = lu(k,2064) - lu(k,1227) * lu(k,2043) + lu(k,2066) = lu(k,2066) - lu(k,1228) * lu(k,2043) + lu(k,2069) = lu(k,2069) - lu(k,1229) * lu(k,2043) + lu(k,2072) = lu(k,2072) - lu(k,1230) * lu(k,2043) + lu(k,2073) = lu(k,2073) - lu(k,1231) * lu(k,2043) + lu(k,2076) = lu(k,2076) - lu(k,1232) * lu(k,2043) + lu(k,2077) = lu(k,2077) - lu(k,1233) * lu(k,2043) + lu(k,2190) = lu(k,2190) - lu(k,1223) * lu(k,2188) + lu(k,2200) = lu(k,2200) - lu(k,1224) * lu(k,2188) + lu(k,2201) = lu(k,2201) - lu(k,1225) * lu(k,2188) + lu(k,2208) = lu(k,2208) - lu(k,1226) * lu(k,2188) + lu(k,2209) = lu(k,2209) - lu(k,1227) * lu(k,2188) + lu(k,2211) = lu(k,2211) - lu(k,1228) * lu(k,2188) + lu(k,2214) = lu(k,2214) - lu(k,1229) * lu(k,2188) + lu(k,2217) = lu(k,2217) - lu(k,1230) * lu(k,2188) + lu(k,2218) = lu(k,2218) - lu(k,1231) * lu(k,2188) + lu(k,2221) = lu(k,2221) - lu(k,1232) * lu(k,2188) + lu(k,2222) = lu(k,2222) - lu(k,1233) * lu(k,2188) + lu(k,2335) = lu(k,2335) - lu(k,1223) * lu(k,2333) + lu(k,2345) = lu(k,2345) - lu(k,1224) * lu(k,2333) + lu(k,2346) = lu(k,2346) - lu(k,1225) * lu(k,2333) + lu(k,2350) = lu(k,2350) - lu(k,1226) * lu(k,2333) + lu(k,2351) = lu(k,2351) - lu(k,1227) * lu(k,2333) + lu(k,2353) = lu(k,2353) - lu(k,1228) * lu(k,2333) + lu(k,2356) = lu(k,2356) - lu(k,1229) * lu(k,2333) + lu(k,2359) = lu(k,2359) - lu(k,1230) * lu(k,2333) + lu(k,2360) = lu(k,2360) - lu(k,1231) * lu(k,2333) + lu(k,2363) = lu(k,2363) - lu(k,1232) * lu(k,2333) + lu(k,2364) = lu(k,2364) - lu(k,1233) * lu(k,2333) + lu(k,2398) = lu(k,2398) - lu(k,1223) * lu(k,2396) + lu(k,2407) = lu(k,2407) - lu(k,1224) * lu(k,2396) + lu(k,2408) = lu(k,2408) - lu(k,1225) * lu(k,2396) + lu(k,2414) = lu(k,2414) - lu(k,1226) * lu(k,2396) + lu(k,2415) = lu(k,2415) - lu(k,1227) * lu(k,2396) + lu(k,2417) = lu(k,2417) - lu(k,1228) * lu(k,2396) + lu(k,2420) = lu(k,2420) - lu(k,1229) * lu(k,2396) + lu(k,2423) = lu(k,2423) - lu(k,1230) * lu(k,2396) + lu(k,2424) = lu(k,2424) - lu(k,1231) * lu(k,2396) + lu(k,2427) = lu(k,2427) - lu(k,1232) * lu(k,2396) + lu(k,2428) = lu(k,2428) - lu(k,1233) * lu(k,2396) + lu(k,1239) = 1._r8 / lu(k,1239) + lu(k,1240) = lu(k,1240) * lu(k,1239) + lu(k,1241) = lu(k,1241) * lu(k,1239) + lu(k,1242) = lu(k,1242) * lu(k,1239) + lu(k,1243) = lu(k,1243) * lu(k,1239) + lu(k,1244) = lu(k,1244) * lu(k,1239) + lu(k,1245) = lu(k,1245) * lu(k,1239) + lu(k,1246) = lu(k,1246) * lu(k,1239) + lu(k,1247) = lu(k,1247) * lu(k,1239) + lu(k,1248) = lu(k,1248) * lu(k,1239) + lu(k,1249) = lu(k,1249) * lu(k,1239) + lu(k,1250) = lu(k,1250) * lu(k,1239) + lu(k,1251) = lu(k,1251) * lu(k,1239) + lu(k,1338) = lu(k,1338) - lu(k,1240) * lu(k,1337) + lu(k,1339) = - lu(k,1241) * lu(k,1337) + lu(k,1347) = lu(k,1347) - lu(k,1242) * lu(k,1337) + lu(k,1348) = lu(k,1348) - lu(k,1243) * lu(k,1337) + lu(k,1349) = lu(k,1349) - lu(k,1244) * lu(k,1337) + lu(k,1351) = lu(k,1351) - lu(k,1245) * lu(k,1337) + lu(k,1352) = lu(k,1352) - lu(k,1246) * lu(k,1337) + lu(k,1353) = lu(k,1353) - lu(k,1247) * lu(k,1337) + lu(k,1354) = lu(k,1354) - lu(k,1248) * lu(k,1337) + lu(k,1355) = lu(k,1355) - lu(k,1249) * lu(k,1337) + lu(k,1357) = lu(k,1357) - lu(k,1250) * lu(k,1337) + lu(k,1358) = - lu(k,1251) * lu(k,1337) + lu(k,1371) = lu(k,1371) - lu(k,1240) * lu(k,1370) + lu(k,1372) = - lu(k,1241) * lu(k,1370) + lu(k,1380) = lu(k,1380) - lu(k,1242) * lu(k,1370) + lu(k,1381) = lu(k,1381) - lu(k,1243) * lu(k,1370) + lu(k,1382) = lu(k,1382) - lu(k,1244) * lu(k,1370) + lu(k,1384) = lu(k,1384) - lu(k,1245) * lu(k,1370) + lu(k,1385) = lu(k,1385) - lu(k,1246) * lu(k,1370) + lu(k,1386) = lu(k,1386) - lu(k,1247) * lu(k,1370) + lu(k,1387) = lu(k,1387) - lu(k,1248) * lu(k,1370) + lu(k,1388) = lu(k,1388) - lu(k,1249) * lu(k,1370) + lu(k,1390) = lu(k,1390) - lu(k,1250) * lu(k,1370) + lu(k,1391) = - lu(k,1251) * lu(k,1370) + lu(k,1397) = lu(k,1397) - lu(k,1240) * lu(k,1396) + lu(k,1398) = - lu(k,1241) * lu(k,1396) + lu(k,1402) = lu(k,1402) - lu(k,1242) * lu(k,1396) + lu(k,1403) = lu(k,1403) - lu(k,1243) * lu(k,1396) + lu(k,1404) = lu(k,1404) - lu(k,1244) * lu(k,1396) + lu(k,1406) = lu(k,1406) - lu(k,1245) * lu(k,1396) + lu(k,1407) = lu(k,1407) - lu(k,1246) * lu(k,1396) + lu(k,1408) = lu(k,1408) - lu(k,1247) * lu(k,1396) + lu(k,1409) = - lu(k,1248) * lu(k,1396) + lu(k,1410) = lu(k,1410) - lu(k,1249) * lu(k,1396) + lu(k,1411) = lu(k,1411) - lu(k,1250) * lu(k,1396) + lu(k,1412) = - lu(k,1251) * lu(k,1396) + lu(k,1770) = lu(k,1770) - lu(k,1240) * lu(k,1769) + lu(k,1771) = lu(k,1771) - lu(k,1241) * lu(k,1769) + lu(k,1781) = lu(k,1781) - lu(k,1242) * lu(k,1769) + lu(k,1782) = lu(k,1782) - lu(k,1243) * lu(k,1769) + lu(k,1787) = lu(k,1787) - lu(k,1244) * lu(k,1769) + lu(k,1790) = lu(k,1790) - lu(k,1245) * lu(k,1769) + lu(k,1791) = lu(k,1791) - lu(k,1246) * lu(k,1769) + lu(k,1793) = lu(k,1793) - lu(k,1247) * lu(k,1769) + lu(k,1796) = lu(k,1796) - lu(k,1248) * lu(k,1769) + lu(k,1797) = lu(k,1797) - lu(k,1249) * lu(k,1769) + lu(k,1800) = lu(k,1800) - lu(k,1250) * lu(k,1769) + lu(k,1801) = lu(k,1801) - lu(k,1251) * lu(k,1769) + lu(k,1983) = lu(k,1983) - lu(k,1240) * lu(k,1982) + lu(k,1984) = lu(k,1984) - lu(k,1241) * lu(k,1982) + lu(k,1994) = lu(k,1994) - lu(k,1242) * lu(k,1982) + lu(k,1995) = lu(k,1995) - lu(k,1243) * lu(k,1982) + lu(k,2003) = lu(k,2003) - lu(k,1244) * lu(k,1982) + lu(k,2006) = lu(k,2006) - lu(k,1245) * lu(k,1982) + lu(k,2007) = lu(k,2007) - lu(k,1246) * lu(k,1982) + lu(k,2009) = lu(k,2009) - lu(k,1247) * lu(k,1982) + lu(k,2012) = lu(k,2012) - lu(k,1248) * lu(k,1982) + lu(k,2013) = lu(k,2013) - lu(k,1249) * lu(k,1982) + lu(k,2016) = lu(k,2016) - lu(k,1250) * lu(k,1982) + lu(k,2017) = lu(k,2017) - lu(k,1251) * lu(k,1982) + lu(k,2045) = lu(k,2045) - lu(k,1240) * lu(k,2044) + lu(k,2046) = lu(k,2046) - lu(k,1241) * lu(k,2044) + lu(k,2056) = lu(k,2056) - lu(k,1242) * lu(k,2044) + lu(k,2057) = lu(k,2057) - lu(k,1243) * lu(k,2044) + lu(k,2063) = lu(k,2063) - lu(k,1244) * lu(k,2044) + lu(k,2066) = lu(k,2066) - lu(k,1245) * lu(k,2044) + lu(k,2067) = lu(k,2067) - lu(k,1246) * lu(k,2044) + lu(k,2069) = lu(k,2069) - lu(k,1247) * lu(k,2044) + lu(k,2072) = lu(k,2072) - lu(k,1248) * lu(k,2044) + lu(k,2073) = lu(k,2073) - lu(k,1249) * lu(k,2044) + lu(k,2076) = lu(k,2076) - lu(k,1250) * lu(k,2044) + lu(k,2077) = lu(k,2077) - lu(k,1251) * lu(k,2044) + lu(k,1252) = 1._r8 / lu(k,1252) + lu(k,1253) = lu(k,1253) * lu(k,1252) + lu(k,1254) = lu(k,1254) * lu(k,1252) + lu(k,1255) = lu(k,1255) * lu(k,1252) + lu(k,1256) = lu(k,1256) * lu(k,1252) + lu(k,1257) = lu(k,1257) * lu(k,1252) + lu(k,1262) = lu(k,1262) - lu(k,1253) * lu(k,1260) + lu(k,1263) = lu(k,1263) - lu(k,1254) * lu(k,1260) + lu(k,1266) = lu(k,1266) - lu(k,1255) * lu(k,1260) + lu(k,1267) = lu(k,1267) - lu(k,1256) * lu(k,1260) + lu(k,1269) = lu(k,1269) - lu(k,1257) * lu(k,1260) + lu(k,1278) = lu(k,1278) - lu(k,1253) * lu(k,1276) + lu(k,1279) = lu(k,1279) - lu(k,1254) * lu(k,1276) + lu(k,1283) = lu(k,1283) - lu(k,1255) * lu(k,1276) + lu(k,1285) = lu(k,1285) - lu(k,1256) * lu(k,1276) + lu(k,1287) = lu(k,1287) - lu(k,1257) * lu(k,1276) + lu(k,1342) = - lu(k,1253) * lu(k,1338) + lu(k,1347) = lu(k,1347) - lu(k,1254) * lu(k,1338) + lu(k,1351) = lu(k,1351) - lu(k,1255) * lu(k,1338) + lu(k,1353) = lu(k,1353) - lu(k,1256) * lu(k,1338) + lu(k,1357) = lu(k,1357) - lu(k,1257) * lu(k,1338) + lu(k,1375) = lu(k,1375) - lu(k,1253) * lu(k,1371) + lu(k,1380) = lu(k,1380) - lu(k,1254) * lu(k,1371) + lu(k,1384) = lu(k,1384) - lu(k,1255) * lu(k,1371) + lu(k,1386) = lu(k,1386) - lu(k,1256) * lu(k,1371) + lu(k,1390) = lu(k,1390) - lu(k,1257) * lu(k,1371) + lu(k,1399) = lu(k,1399) - lu(k,1253) * lu(k,1397) + lu(k,1402) = lu(k,1402) - lu(k,1254) * lu(k,1397) + lu(k,1406) = lu(k,1406) - lu(k,1255) * lu(k,1397) + lu(k,1408) = lu(k,1408) - lu(k,1256) * lu(k,1397) + lu(k,1411) = lu(k,1411) - lu(k,1257) * lu(k,1397) + lu(k,1418) = lu(k,1418) - lu(k,1253) * lu(k,1417) + lu(k,1422) = lu(k,1422) - lu(k,1254) * lu(k,1417) + lu(k,1427) = lu(k,1427) - lu(k,1255) * lu(k,1417) + lu(k,1430) = lu(k,1430) - lu(k,1256) * lu(k,1417) + lu(k,1434) = lu(k,1434) - lu(k,1257) * lu(k,1417) + lu(k,1440) = - lu(k,1253) * lu(k,1439) + lu(k,1442) = lu(k,1442) - lu(k,1254) * lu(k,1439) + lu(k,1446) = lu(k,1446) - lu(k,1255) * lu(k,1439) + lu(k,1448) = lu(k,1448) - lu(k,1256) * lu(k,1439) + lu(k,1452) = lu(k,1452) - lu(k,1257) * lu(k,1439) + lu(k,1466) = lu(k,1466) - lu(k,1253) * lu(k,1462) + lu(k,1472) = lu(k,1472) - lu(k,1254) * lu(k,1462) + lu(k,1477) = lu(k,1477) - lu(k,1255) * lu(k,1462) + lu(k,1480) = lu(k,1480) - lu(k,1256) * lu(k,1462) + lu(k,1484) = lu(k,1484) - lu(k,1257) * lu(k,1462) + lu(k,1671) = lu(k,1671) - lu(k,1253) * lu(k,1670) + lu(k,1673) = lu(k,1673) - lu(k,1254) * lu(k,1670) + lu(k,1684) = lu(k,1684) - lu(k,1255) * lu(k,1670) + lu(k,1687) = lu(k,1687) - lu(k,1256) * lu(k,1670) + lu(k,1694) = lu(k,1694) - lu(k,1257) * lu(k,1670) + lu(k,1775) = lu(k,1775) - lu(k,1253) * lu(k,1770) + lu(k,1781) = lu(k,1781) - lu(k,1254) * lu(k,1770) + lu(k,1790) = lu(k,1790) - lu(k,1255) * lu(k,1770) + lu(k,1793) = lu(k,1793) - lu(k,1256) * lu(k,1770) + lu(k,1800) = lu(k,1800) - lu(k,1257) * lu(k,1770) + lu(k,1988) = lu(k,1988) - lu(k,1253) * lu(k,1983) + lu(k,1994) = lu(k,1994) - lu(k,1254) * lu(k,1983) + lu(k,2006) = lu(k,2006) - lu(k,1255) * lu(k,1983) + lu(k,2009) = lu(k,2009) - lu(k,1256) * lu(k,1983) + lu(k,2016) = lu(k,2016) - lu(k,1257) * lu(k,1983) + lu(k,2050) = lu(k,2050) - lu(k,1253) * lu(k,2045) + lu(k,2056) = lu(k,2056) - lu(k,1254) * lu(k,2045) + lu(k,2066) = lu(k,2066) - lu(k,1255) * lu(k,2045) + lu(k,2069) = lu(k,2069) - lu(k,1256) * lu(k,2045) + lu(k,2076) = lu(k,2076) - lu(k,1257) * lu(k,2045) + lu(k,2194) = lu(k,2194) - lu(k,1253) * lu(k,2189) + lu(k,2200) = lu(k,2200) - lu(k,1254) * lu(k,2189) + lu(k,2211) = lu(k,2211) - lu(k,1255) * lu(k,2189) + lu(k,2214) = lu(k,2214) - lu(k,1256) * lu(k,2189) + lu(k,2221) = lu(k,2221) - lu(k,1257) * lu(k,2189) + lu(k,2339) = lu(k,2339) - lu(k,1253) * lu(k,2334) + lu(k,2345) = lu(k,2345) - lu(k,1254) * lu(k,2334) + lu(k,2353) = lu(k,2353) - lu(k,1255) * lu(k,2334) + lu(k,2356) = lu(k,2356) - lu(k,1256) * lu(k,2334) + lu(k,2363) = lu(k,2363) - lu(k,1257) * lu(k,2334) + lu(k,2401) = lu(k,2401) - lu(k,1253) * lu(k,2397) + lu(k,2407) = lu(k,2407) - lu(k,1254) * lu(k,2397) + lu(k,2417) = lu(k,2417) - lu(k,1255) * lu(k,2397) + lu(k,2420) = lu(k,2420) - lu(k,1256) * lu(k,2397) + lu(k,2427) = lu(k,2427) - lu(k,1257) * lu(k,2397) + end do + end subroutine lu_fac25 + subroutine lu_fac26( 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,1261) = 1._r8 / lu(k,1261) + lu(k,1262) = lu(k,1262) * lu(k,1261) + lu(k,1263) = lu(k,1263) * lu(k,1261) + lu(k,1264) = lu(k,1264) * lu(k,1261) + lu(k,1265) = lu(k,1265) * lu(k,1261) + lu(k,1266) = lu(k,1266) * lu(k,1261) + lu(k,1267) = lu(k,1267) * lu(k,1261) + lu(k,1268) = lu(k,1268) * lu(k,1261) + lu(k,1269) = lu(k,1269) * lu(k,1261) + lu(k,1270) = lu(k,1270) * lu(k,1261) + lu(k,1342) = lu(k,1342) - lu(k,1262) * lu(k,1339) + lu(k,1347) = lu(k,1347) - lu(k,1263) * lu(k,1339) + lu(k,1349) = lu(k,1349) - lu(k,1264) * lu(k,1339) + lu(k,1350) = lu(k,1350) - lu(k,1265) * lu(k,1339) + lu(k,1351) = lu(k,1351) - lu(k,1266) * lu(k,1339) + lu(k,1353) = lu(k,1353) - lu(k,1267) * lu(k,1339) + lu(k,1355) = lu(k,1355) - lu(k,1268) * lu(k,1339) + lu(k,1357) = lu(k,1357) - lu(k,1269) * lu(k,1339) + lu(k,1358) = lu(k,1358) - lu(k,1270) * lu(k,1339) + lu(k,1375) = lu(k,1375) - lu(k,1262) * lu(k,1372) + lu(k,1380) = lu(k,1380) - lu(k,1263) * lu(k,1372) + lu(k,1382) = lu(k,1382) - lu(k,1264) * lu(k,1372) + lu(k,1383) = lu(k,1383) - lu(k,1265) * lu(k,1372) + lu(k,1384) = lu(k,1384) - lu(k,1266) * lu(k,1372) + lu(k,1386) = lu(k,1386) - lu(k,1267) * lu(k,1372) + lu(k,1388) = lu(k,1388) - lu(k,1268) * lu(k,1372) + lu(k,1390) = lu(k,1390) - lu(k,1269) * lu(k,1372) + lu(k,1391) = lu(k,1391) - lu(k,1270) * lu(k,1372) + lu(k,1399) = lu(k,1399) - lu(k,1262) * lu(k,1398) + lu(k,1402) = lu(k,1402) - lu(k,1263) * lu(k,1398) + lu(k,1404) = lu(k,1404) - lu(k,1264) * lu(k,1398) + lu(k,1405) = lu(k,1405) - lu(k,1265) * lu(k,1398) + lu(k,1406) = lu(k,1406) - lu(k,1266) * lu(k,1398) + lu(k,1408) = lu(k,1408) - lu(k,1267) * lu(k,1398) + lu(k,1410) = lu(k,1410) - lu(k,1268) * lu(k,1398) + lu(k,1411) = lu(k,1411) - lu(k,1269) * lu(k,1398) + lu(k,1412) = lu(k,1412) - lu(k,1270) * lu(k,1398) + lu(k,1775) = lu(k,1775) - lu(k,1262) * lu(k,1771) + lu(k,1781) = lu(k,1781) - lu(k,1263) * lu(k,1771) + lu(k,1787) = lu(k,1787) - lu(k,1264) * lu(k,1771) + lu(k,1788) = lu(k,1788) - lu(k,1265) * lu(k,1771) + lu(k,1790) = lu(k,1790) - lu(k,1266) * lu(k,1771) + lu(k,1793) = lu(k,1793) - lu(k,1267) * lu(k,1771) + lu(k,1797) = lu(k,1797) - lu(k,1268) * lu(k,1771) + lu(k,1800) = lu(k,1800) - lu(k,1269) * lu(k,1771) + lu(k,1801) = lu(k,1801) - lu(k,1270) * lu(k,1771) + lu(k,1988) = lu(k,1988) - lu(k,1262) * lu(k,1984) + lu(k,1994) = lu(k,1994) - lu(k,1263) * lu(k,1984) + lu(k,2003) = lu(k,2003) - lu(k,1264) * lu(k,1984) + lu(k,2004) = lu(k,2004) - lu(k,1265) * lu(k,1984) + lu(k,2006) = lu(k,2006) - lu(k,1266) * lu(k,1984) + lu(k,2009) = lu(k,2009) - lu(k,1267) * lu(k,1984) + lu(k,2013) = lu(k,2013) - lu(k,1268) * lu(k,1984) + lu(k,2016) = lu(k,2016) - lu(k,1269) * lu(k,1984) + lu(k,2017) = lu(k,2017) - lu(k,1270) * lu(k,1984) + lu(k,2050) = lu(k,2050) - lu(k,1262) * lu(k,2046) + lu(k,2056) = lu(k,2056) - lu(k,1263) * lu(k,2046) + lu(k,2063) = lu(k,2063) - lu(k,1264) * lu(k,2046) + lu(k,2064) = lu(k,2064) - lu(k,1265) * lu(k,2046) + lu(k,2066) = lu(k,2066) - lu(k,1266) * lu(k,2046) + lu(k,2069) = lu(k,2069) - lu(k,1267) * lu(k,2046) + lu(k,2073) = lu(k,2073) - lu(k,1268) * lu(k,2046) + lu(k,2076) = lu(k,2076) - lu(k,1269) * lu(k,2046) + lu(k,2077) = lu(k,2077) - lu(k,1270) * lu(k,2046) + lu(k,2194) = lu(k,2194) - lu(k,1262) * lu(k,2190) + lu(k,2200) = lu(k,2200) - lu(k,1263) * lu(k,2190) + lu(k,2208) = lu(k,2208) - lu(k,1264) * lu(k,2190) + lu(k,2209) = lu(k,2209) - lu(k,1265) * lu(k,2190) + lu(k,2211) = lu(k,2211) - lu(k,1266) * lu(k,2190) + lu(k,2214) = lu(k,2214) - lu(k,1267) * lu(k,2190) + lu(k,2218) = lu(k,2218) - lu(k,1268) * lu(k,2190) + lu(k,2221) = lu(k,2221) - lu(k,1269) * lu(k,2190) + lu(k,2222) = lu(k,2222) - lu(k,1270) * lu(k,2190) + lu(k,2245) = - lu(k,1262) * lu(k,2244) + lu(k,2246) = lu(k,2246) - lu(k,1263) * lu(k,2244) + lu(k,2254) = lu(k,2254) - lu(k,1264) * lu(k,2244) + lu(k,2255) = lu(k,2255) - lu(k,1265) * lu(k,2244) + lu(k,2257) = lu(k,2257) - lu(k,1266) * lu(k,2244) + lu(k,2260) = lu(k,2260) - lu(k,1267) * lu(k,2244) + lu(k,2264) = lu(k,2264) - lu(k,1268) * lu(k,2244) + lu(k,2267) = lu(k,2267) - lu(k,1269) * lu(k,2244) + lu(k,2268) = lu(k,2268) - lu(k,1270) * lu(k,2244) + lu(k,2339) = lu(k,2339) - lu(k,1262) * lu(k,2335) + lu(k,2345) = lu(k,2345) - lu(k,1263) * lu(k,2335) + lu(k,2350) = lu(k,2350) - lu(k,1264) * lu(k,2335) + lu(k,2351) = lu(k,2351) - lu(k,1265) * lu(k,2335) + lu(k,2353) = lu(k,2353) - lu(k,1266) * lu(k,2335) + lu(k,2356) = lu(k,2356) - lu(k,1267) * lu(k,2335) + lu(k,2360) = lu(k,2360) - lu(k,1268) * lu(k,2335) + lu(k,2363) = lu(k,2363) - lu(k,1269) * lu(k,2335) + lu(k,2364) = lu(k,2364) - lu(k,1270) * lu(k,2335) + lu(k,2401) = lu(k,2401) - lu(k,1262) * lu(k,2398) + lu(k,2407) = lu(k,2407) - lu(k,1263) * lu(k,2398) + lu(k,2414) = lu(k,2414) - lu(k,1264) * lu(k,2398) + lu(k,2415) = lu(k,2415) - lu(k,1265) * lu(k,2398) + lu(k,2417) = lu(k,2417) - lu(k,1266) * lu(k,2398) + lu(k,2420) = lu(k,2420) - lu(k,1267) * lu(k,2398) + lu(k,2424) = lu(k,2424) - lu(k,1268) * lu(k,2398) + lu(k,2427) = lu(k,2427) - lu(k,1269) * lu(k,2398) + lu(k,2428) = lu(k,2428) - lu(k,1270) * lu(k,2398) + lu(k,1277) = 1._r8 / lu(k,1277) + lu(k,1278) = lu(k,1278) * lu(k,1277) + lu(k,1279) = lu(k,1279) * lu(k,1277) + lu(k,1280) = lu(k,1280) * lu(k,1277) + lu(k,1281) = lu(k,1281) * lu(k,1277) + lu(k,1282) = lu(k,1282) * lu(k,1277) + lu(k,1283) = lu(k,1283) * lu(k,1277) + lu(k,1284) = lu(k,1284) * lu(k,1277) + lu(k,1285) = lu(k,1285) * lu(k,1277) + lu(k,1286) = lu(k,1286) * lu(k,1277) + lu(k,1287) = lu(k,1287) * lu(k,1277) + lu(k,1299) = lu(k,1299) - lu(k,1278) * lu(k,1296) + lu(k,1301) = lu(k,1301) - lu(k,1279) * lu(k,1296) + lu(k,1302) = lu(k,1302) - lu(k,1280) * lu(k,1296) + lu(k,1303) = lu(k,1303) - lu(k,1281) * lu(k,1296) + lu(k,1304) = lu(k,1304) - lu(k,1282) * lu(k,1296) + lu(k,1305) = lu(k,1305) - lu(k,1283) * lu(k,1296) + lu(k,1306) = lu(k,1306) - lu(k,1284) * lu(k,1296) + lu(k,1307) = lu(k,1307) - lu(k,1285) * lu(k,1296) + lu(k,1309) = lu(k,1309) - lu(k,1286) * lu(k,1296) + lu(k,1310) = lu(k,1310) - lu(k,1287) * lu(k,1296) + lu(k,1342) = lu(k,1342) - lu(k,1278) * lu(k,1340) + lu(k,1347) = lu(k,1347) - lu(k,1279) * lu(k,1340) + lu(k,1348) = lu(k,1348) - lu(k,1280) * lu(k,1340) + lu(k,1349) = lu(k,1349) - lu(k,1281) * lu(k,1340) + lu(k,1350) = lu(k,1350) - lu(k,1282) * lu(k,1340) + lu(k,1351) = lu(k,1351) - lu(k,1283) * lu(k,1340) + lu(k,1352) = lu(k,1352) - lu(k,1284) * lu(k,1340) + lu(k,1353) = lu(k,1353) - lu(k,1285) * lu(k,1340) + lu(k,1355) = lu(k,1355) - lu(k,1286) * lu(k,1340) + lu(k,1357) = lu(k,1357) - lu(k,1287) * lu(k,1340) + lu(k,1375) = lu(k,1375) - lu(k,1278) * lu(k,1373) + lu(k,1380) = lu(k,1380) - lu(k,1279) * lu(k,1373) + lu(k,1381) = lu(k,1381) - lu(k,1280) * lu(k,1373) + lu(k,1382) = lu(k,1382) - lu(k,1281) * lu(k,1373) + lu(k,1383) = lu(k,1383) - lu(k,1282) * lu(k,1373) + lu(k,1384) = lu(k,1384) - lu(k,1283) * lu(k,1373) + lu(k,1385) = lu(k,1385) - lu(k,1284) * lu(k,1373) + lu(k,1386) = lu(k,1386) - lu(k,1285) * lu(k,1373) + lu(k,1388) = lu(k,1388) - lu(k,1286) * lu(k,1373) + lu(k,1390) = lu(k,1390) - lu(k,1287) * lu(k,1373) + lu(k,1466) = lu(k,1466) - lu(k,1278) * lu(k,1463) + lu(k,1472) = lu(k,1472) - lu(k,1279) * lu(k,1463) + lu(k,1473) = lu(k,1473) - lu(k,1280) * lu(k,1463) + lu(k,1475) = lu(k,1475) - lu(k,1281) * lu(k,1463) + lu(k,1476) = lu(k,1476) - lu(k,1282) * lu(k,1463) + lu(k,1477) = lu(k,1477) - lu(k,1283) * lu(k,1463) + lu(k,1478) = lu(k,1478) - lu(k,1284) * lu(k,1463) + lu(k,1480) = lu(k,1480) - lu(k,1285) * lu(k,1463) + lu(k,1482) = lu(k,1482) - lu(k,1286) * lu(k,1463) + lu(k,1484) = lu(k,1484) - lu(k,1287) * lu(k,1463) + lu(k,1775) = lu(k,1775) - lu(k,1278) * lu(k,1772) + lu(k,1781) = lu(k,1781) - lu(k,1279) * lu(k,1772) + lu(k,1782) = lu(k,1782) - lu(k,1280) * lu(k,1772) + lu(k,1787) = lu(k,1787) - lu(k,1281) * lu(k,1772) + lu(k,1788) = lu(k,1788) - lu(k,1282) * lu(k,1772) + lu(k,1790) = lu(k,1790) - lu(k,1283) * lu(k,1772) + lu(k,1791) = lu(k,1791) - lu(k,1284) * lu(k,1772) + lu(k,1793) = lu(k,1793) - lu(k,1285) * lu(k,1772) + lu(k,1797) = lu(k,1797) - lu(k,1286) * lu(k,1772) + lu(k,1800) = lu(k,1800) - lu(k,1287) * lu(k,1772) + lu(k,1988) = lu(k,1988) - lu(k,1278) * lu(k,1985) + lu(k,1994) = lu(k,1994) - lu(k,1279) * lu(k,1985) + lu(k,1995) = lu(k,1995) - lu(k,1280) * lu(k,1985) + lu(k,2003) = lu(k,2003) - lu(k,1281) * lu(k,1985) + lu(k,2004) = lu(k,2004) - lu(k,1282) * lu(k,1985) + lu(k,2006) = lu(k,2006) - lu(k,1283) * lu(k,1985) + lu(k,2007) = lu(k,2007) - lu(k,1284) * lu(k,1985) + lu(k,2009) = lu(k,2009) - lu(k,1285) * lu(k,1985) + lu(k,2013) = lu(k,2013) - lu(k,1286) * lu(k,1985) + lu(k,2016) = lu(k,2016) - lu(k,1287) * lu(k,1985) + lu(k,2050) = lu(k,2050) - lu(k,1278) * lu(k,2047) + lu(k,2056) = lu(k,2056) - lu(k,1279) * lu(k,2047) + lu(k,2057) = lu(k,2057) - lu(k,1280) * lu(k,2047) + lu(k,2063) = lu(k,2063) - lu(k,1281) * lu(k,2047) + lu(k,2064) = lu(k,2064) - lu(k,1282) * lu(k,2047) + lu(k,2066) = lu(k,2066) - lu(k,1283) * lu(k,2047) + lu(k,2067) = lu(k,2067) - lu(k,1284) * lu(k,2047) + lu(k,2069) = lu(k,2069) - lu(k,1285) * lu(k,2047) + lu(k,2073) = lu(k,2073) - lu(k,1286) * lu(k,2047) + lu(k,2076) = lu(k,2076) - lu(k,1287) * lu(k,2047) + lu(k,2194) = lu(k,2194) - lu(k,1278) * lu(k,2191) + lu(k,2200) = lu(k,2200) - lu(k,1279) * lu(k,2191) + lu(k,2201) = lu(k,2201) - lu(k,1280) * lu(k,2191) + lu(k,2208) = lu(k,2208) - lu(k,1281) * lu(k,2191) + lu(k,2209) = lu(k,2209) - lu(k,1282) * lu(k,2191) + lu(k,2211) = lu(k,2211) - lu(k,1283) * lu(k,2191) + lu(k,2212) = lu(k,2212) - lu(k,1284) * lu(k,2191) + lu(k,2214) = lu(k,2214) - lu(k,1285) * lu(k,2191) + lu(k,2218) = lu(k,2218) - lu(k,1286) * lu(k,2191) + lu(k,2221) = lu(k,2221) - lu(k,1287) * lu(k,2191) + lu(k,2339) = lu(k,2339) - lu(k,1278) * lu(k,2336) + lu(k,2345) = lu(k,2345) - lu(k,1279) * lu(k,2336) + lu(k,2346) = lu(k,2346) - lu(k,1280) * lu(k,2336) + lu(k,2350) = lu(k,2350) - lu(k,1281) * lu(k,2336) + lu(k,2351) = lu(k,2351) - lu(k,1282) * lu(k,2336) + lu(k,2353) = lu(k,2353) - lu(k,1283) * lu(k,2336) + lu(k,2354) = lu(k,2354) - lu(k,1284) * lu(k,2336) + lu(k,2356) = lu(k,2356) - lu(k,1285) * lu(k,2336) + lu(k,2360) = lu(k,2360) - lu(k,1286) * lu(k,2336) + lu(k,2363) = lu(k,2363) - lu(k,1287) * lu(k,2336) + lu(k,1297) = 1._r8 / lu(k,1297) + lu(k,1298) = lu(k,1298) * lu(k,1297) + lu(k,1299) = lu(k,1299) * lu(k,1297) + lu(k,1300) = lu(k,1300) * lu(k,1297) + lu(k,1301) = lu(k,1301) * lu(k,1297) + lu(k,1302) = lu(k,1302) * lu(k,1297) + lu(k,1303) = lu(k,1303) * lu(k,1297) + lu(k,1304) = lu(k,1304) * lu(k,1297) + lu(k,1305) = lu(k,1305) * lu(k,1297) + lu(k,1306) = lu(k,1306) * lu(k,1297) + lu(k,1307) = lu(k,1307) * lu(k,1297) + lu(k,1308) = lu(k,1308) * lu(k,1297) + lu(k,1309) = lu(k,1309) * lu(k,1297) + lu(k,1310) = lu(k,1310) * lu(k,1297) + lu(k,1465) = lu(k,1465) - lu(k,1298) * lu(k,1464) + lu(k,1466) = lu(k,1466) - lu(k,1299) * lu(k,1464) + lu(k,1470) = lu(k,1470) - lu(k,1300) * lu(k,1464) + lu(k,1472) = lu(k,1472) - lu(k,1301) * lu(k,1464) + lu(k,1473) = lu(k,1473) - lu(k,1302) * lu(k,1464) + lu(k,1475) = lu(k,1475) - lu(k,1303) * lu(k,1464) + lu(k,1476) = lu(k,1476) - lu(k,1304) * lu(k,1464) + lu(k,1477) = lu(k,1477) - lu(k,1305) * lu(k,1464) + lu(k,1478) = lu(k,1478) - lu(k,1306) * lu(k,1464) + lu(k,1480) = lu(k,1480) - lu(k,1307) * lu(k,1464) + lu(k,1481) = lu(k,1481) - lu(k,1308) * lu(k,1464) + lu(k,1482) = lu(k,1482) - lu(k,1309) * lu(k,1464) + lu(k,1484) = lu(k,1484) - lu(k,1310) * lu(k,1464) + lu(k,1774) = lu(k,1774) - lu(k,1298) * lu(k,1773) + lu(k,1775) = lu(k,1775) - lu(k,1299) * lu(k,1773) + lu(k,1779) = lu(k,1779) - lu(k,1300) * lu(k,1773) + lu(k,1781) = lu(k,1781) - lu(k,1301) * lu(k,1773) + lu(k,1782) = lu(k,1782) - lu(k,1302) * lu(k,1773) + lu(k,1787) = lu(k,1787) - lu(k,1303) * lu(k,1773) + lu(k,1788) = lu(k,1788) - lu(k,1304) * lu(k,1773) + lu(k,1790) = lu(k,1790) - lu(k,1305) * lu(k,1773) + lu(k,1791) = lu(k,1791) - lu(k,1306) * lu(k,1773) + lu(k,1793) = lu(k,1793) - lu(k,1307) * lu(k,1773) + lu(k,1796) = lu(k,1796) - lu(k,1308) * lu(k,1773) + lu(k,1797) = lu(k,1797) - lu(k,1309) * lu(k,1773) + lu(k,1800) = lu(k,1800) - lu(k,1310) * lu(k,1773) + lu(k,1987) = lu(k,1987) - lu(k,1298) * lu(k,1986) + lu(k,1988) = lu(k,1988) - lu(k,1299) * lu(k,1986) + lu(k,1992) = lu(k,1992) - lu(k,1300) * lu(k,1986) + lu(k,1994) = lu(k,1994) - lu(k,1301) * lu(k,1986) + lu(k,1995) = lu(k,1995) - lu(k,1302) * lu(k,1986) + lu(k,2003) = lu(k,2003) - lu(k,1303) * lu(k,1986) + lu(k,2004) = lu(k,2004) - lu(k,1304) * lu(k,1986) + lu(k,2006) = lu(k,2006) - lu(k,1305) * lu(k,1986) + lu(k,2007) = lu(k,2007) - lu(k,1306) * lu(k,1986) + lu(k,2009) = lu(k,2009) - lu(k,1307) * lu(k,1986) + lu(k,2012) = lu(k,2012) - lu(k,1308) * lu(k,1986) + lu(k,2013) = lu(k,2013) - lu(k,1309) * lu(k,1986) + lu(k,2016) = lu(k,2016) - lu(k,1310) * lu(k,1986) + lu(k,2049) = lu(k,2049) - lu(k,1298) * lu(k,2048) + lu(k,2050) = lu(k,2050) - lu(k,1299) * lu(k,2048) + lu(k,2054) = lu(k,2054) - lu(k,1300) * lu(k,2048) + lu(k,2056) = lu(k,2056) - lu(k,1301) * lu(k,2048) + lu(k,2057) = lu(k,2057) - lu(k,1302) * lu(k,2048) + lu(k,2063) = lu(k,2063) - lu(k,1303) * lu(k,2048) + lu(k,2064) = lu(k,2064) - lu(k,1304) * lu(k,2048) + lu(k,2066) = lu(k,2066) - lu(k,1305) * lu(k,2048) + lu(k,2067) = lu(k,2067) - lu(k,1306) * lu(k,2048) + lu(k,2069) = lu(k,2069) - lu(k,1307) * lu(k,2048) + lu(k,2072) = lu(k,2072) - lu(k,1308) * lu(k,2048) + lu(k,2073) = lu(k,2073) - lu(k,1309) * lu(k,2048) + lu(k,2076) = lu(k,2076) - lu(k,1310) * lu(k,2048) + lu(k,2193) = lu(k,2193) - lu(k,1298) * lu(k,2192) + lu(k,2194) = lu(k,2194) - lu(k,1299) * lu(k,2192) + lu(k,2198) = lu(k,2198) - lu(k,1300) * lu(k,2192) + lu(k,2200) = lu(k,2200) - lu(k,1301) * lu(k,2192) + lu(k,2201) = lu(k,2201) - lu(k,1302) * lu(k,2192) + lu(k,2208) = lu(k,2208) - lu(k,1303) * lu(k,2192) + lu(k,2209) = lu(k,2209) - lu(k,1304) * lu(k,2192) + lu(k,2211) = lu(k,2211) - lu(k,1305) * lu(k,2192) + lu(k,2212) = lu(k,2212) - lu(k,1306) * lu(k,2192) + lu(k,2214) = lu(k,2214) - lu(k,1307) * lu(k,2192) + lu(k,2217) = lu(k,2217) - lu(k,1308) * lu(k,2192) + lu(k,2218) = lu(k,2218) - lu(k,1309) * lu(k,2192) + lu(k,2221) = lu(k,2221) - lu(k,1310) * lu(k,2192) + lu(k,2338) = lu(k,2338) - lu(k,1298) * lu(k,2337) + lu(k,2339) = lu(k,2339) - lu(k,1299) * lu(k,2337) + lu(k,2343) = lu(k,2343) - lu(k,1300) * lu(k,2337) + lu(k,2345) = lu(k,2345) - lu(k,1301) * lu(k,2337) + lu(k,2346) = lu(k,2346) - lu(k,1302) * lu(k,2337) + lu(k,2350) = lu(k,2350) - lu(k,1303) * lu(k,2337) + lu(k,2351) = lu(k,2351) - lu(k,1304) * lu(k,2337) + lu(k,2353) = lu(k,2353) - lu(k,1305) * lu(k,2337) + lu(k,2354) = lu(k,2354) - lu(k,1306) * lu(k,2337) + lu(k,2356) = lu(k,2356) - lu(k,1307) * lu(k,2337) + lu(k,2359) = lu(k,2359) - lu(k,1308) * lu(k,2337) + lu(k,2360) = lu(k,2360) - lu(k,1309) * lu(k,2337) + lu(k,2363) = lu(k,2363) - lu(k,1310) * lu(k,2337) + lu(k,2400) = lu(k,2400) - lu(k,1298) * lu(k,2399) + lu(k,2401) = lu(k,2401) - lu(k,1299) * lu(k,2399) + lu(k,2405) = lu(k,2405) - lu(k,1300) * lu(k,2399) + lu(k,2407) = lu(k,2407) - lu(k,1301) * lu(k,2399) + lu(k,2408) = lu(k,2408) - lu(k,1302) * lu(k,2399) + lu(k,2414) = lu(k,2414) - lu(k,1303) * lu(k,2399) + lu(k,2415) = lu(k,2415) - lu(k,1304) * lu(k,2399) + lu(k,2417) = lu(k,2417) - lu(k,1305) * lu(k,2399) + lu(k,2418) = lu(k,2418) - lu(k,1306) * lu(k,2399) + lu(k,2420) = lu(k,2420) - lu(k,1307) * lu(k,2399) + lu(k,2423) = lu(k,2423) - lu(k,1308) * lu(k,2399) + lu(k,2424) = lu(k,2424) - lu(k,1309) * lu(k,2399) + lu(k,2427) = lu(k,2427) - lu(k,1310) * lu(k,2399) + lu(k,1313) = 1._r8 / lu(k,1313) + lu(k,1314) = lu(k,1314) * lu(k,1313) + lu(k,1315) = lu(k,1315) * lu(k,1313) + lu(k,1316) = lu(k,1316) * lu(k,1313) + lu(k,1317) = lu(k,1317) * lu(k,1313) + lu(k,1318) = lu(k,1318) * lu(k,1313) + lu(k,1319) = lu(k,1319) * lu(k,1313) + lu(k,1320) = lu(k,1320) * lu(k,1313) + lu(k,1321) = lu(k,1321) * lu(k,1313) + lu(k,1322) = lu(k,1322) * lu(k,1313) + lu(k,1323) = lu(k,1323) * lu(k,1313) + lu(k,1342) = lu(k,1342) - lu(k,1314) * lu(k,1341) + lu(k,1344) = - lu(k,1315) * lu(k,1341) + lu(k,1346) = - lu(k,1316) * lu(k,1341) + lu(k,1347) = lu(k,1347) - lu(k,1317) * lu(k,1341) + lu(k,1348) = lu(k,1348) - lu(k,1318) * lu(k,1341) + lu(k,1351) = lu(k,1351) - lu(k,1319) * lu(k,1341) + lu(k,1353) = lu(k,1353) - lu(k,1320) * lu(k,1341) + lu(k,1356) = - lu(k,1321) * lu(k,1341) + lu(k,1357) = lu(k,1357) - lu(k,1322) * lu(k,1341) + lu(k,1358) = lu(k,1358) - lu(k,1323) * lu(k,1341) + lu(k,1375) = lu(k,1375) - lu(k,1314) * lu(k,1374) + lu(k,1377) = - lu(k,1315) * lu(k,1374) + lu(k,1379) = - lu(k,1316) * lu(k,1374) + lu(k,1380) = lu(k,1380) - lu(k,1317) * lu(k,1374) + lu(k,1381) = lu(k,1381) - lu(k,1318) * lu(k,1374) + lu(k,1384) = lu(k,1384) - lu(k,1319) * lu(k,1374) + lu(k,1386) = lu(k,1386) - lu(k,1320) * lu(k,1374) + lu(k,1389) = - lu(k,1321) * lu(k,1374) + lu(k,1390) = lu(k,1390) - lu(k,1322) * lu(k,1374) + lu(k,1391) = lu(k,1391) - lu(k,1323) * lu(k,1374) + lu(k,1466) = lu(k,1466) - lu(k,1314) * lu(k,1465) + lu(k,1469) = lu(k,1469) - lu(k,1315) * lu(k,1465) + lu(k,1471) = lu(k,1471) - lu(k,1316) * lu(k,1465) + lu(k,1472) = lu(k,1472) - lu(k,1317) * lu(k,1465) + lu(k,1473) = lu(k,1473) - lu(k,1318) * lu(k,1465) + lu(k,1477) = lu(k,1477) - lu(k,1319) * lu(k,1465) + lu(k,1480) = lu(k,1480) - lu(k,1320) * lu(k,1465) + lu(k,1483) = lu(k,1483) - lu(k,1321) * lu(k,1465) + lu(k,1484) = lu(k,1484) - lu(k,1322) * lu(k,1465) + lu(k,1485) = lu(k,1485) - lu(k,1323) * lu(k,1465) + lu(k,1775) = lu(k,1775) - lu(k,1314) * lu(k,1774) + lu(k,1778) = lu(k,1778) - lu(k,1315) * lu(k,1774) + lu(k,1780) = lu(k,1780) - lu(k,1316) * lu(k,1774) + lu(k,1781) = lu(k,1781) - lu(k,1317) * lu(k,1774) + lu(k,1782) = lu(k,1782) - lu(k,1318) * lu(k,1774) + lu(k,1790) = lu(k,1790) - lu(k,1319) * lu(k,1774) + lu(k,1793) = lu(k,1793) - lu(k,1320) * lu(k,1774) + lu(k,1798) = lu(k,1798) - lu(k,1321) * lu(k,1774) + lu(k,1800) = lu(k,1800) - lu(k,1322) * lu(k,1774) + lu(k,1801) = lu(k,1801) - lu(k,1323) * lu(k,1774) + lu(k,1988) = lu(k,1988) - lu(k,1314) * lu(k,1987) + lu(k,1991) = lu(k,1991) - lu(k,1315) * lu(k,1987) + lu(k,1993) = lu(k,1993) - lu(k,1316) * lu(k,1987) + lu(k,1994) = lu(k,1994) - lu(k,1317) * lu(k,1987) + lu(k,1995) = lu(k,1995) - lu(k,1318) * lu(k,1987) + lu(k,2006) = lu(k,2006) - lu(k,1319) * lu(k,1987) + lu(k,2009) = lu(k,2009) - lu(k,1320) * lu(k,1987) + lu(k,2014) = lu(k,2014) - lu(k,1321) * lu(k,1987) + lu(k,2016) = lu(k,2016) - lu(k,1322) * lu(k,1987) + lu(k,2017) = lu(k,2017) - lu(k,1323) * lu(k,1987) + lu(k,2050) = lu(k,2050) - lu(k,1314) * lu(k,2049) + lu(k,2053) = lu(k,2053) - lu(k,1315) * lu(k,2049) + lu(k,2055) = lu(k,2055) - lu(k,1316) * lu(k,2049) + lu(k,2056) = lu(k,2056) - lu(k,1317) * lu(k,2049) + lu(k,2057) = lu(k,2057) - lu(k,1318) * lu(k,2049) + lu(k,2066) = lu(k,2066) - lu(k,1319) * lu(k,2049) + lu(k,2069) = lu(k,2069) - lu(k,1320) * lu(k,2049) + lu(k,2074) = lu(k,2074) - lu(k,1321) * lu(k,2049) + lu(k,2076) = lu(k,2076) - lu(k,1322) * lu(k,2049) + lu(k,2077) = lu(k,2077) - lu(k,1323) * lu(k,2049) + lu(k,2194) = lu(k,2194) - lu(k,1314) * lu(k,2193) + lu(k,2197) = lu(k,2197) - lu(k,1315) * lu(k,2193) + lu(k,2199) = lu(k,2199) - lu(k,1316) * lu(k,2193) + lu(k,2200) = lu(k,2200) - lu(k,1317) * lu(k,2193) + lu(k,2201) = lu(k,2201) - lu(k,1318) * lu(k,2193) + lu(k,2211) = lu(k,2211) - lu(k,1319) * lu(k,2193) + lu(k,2214) = lu(k,2214) - lu(k,1320) * lu(k,2193) + lu(k,2219) = lu(k,2219) - lu(k,1321) * lu(k,2193) + lu(k,2221) = lu(k,2221) - lu(k,1322) * lu(k,2193) + lu(k,2222) = lu(k,2222) - lu(k,1323) * lu(k,2193) + lu(k,2339) = lu(k,2339) - lu(k,1314) * lu(k,2338) + lu(k,2342) = lu(k,2342) - lu(k,1315) * lu(k,2338) + lu(k,2344) = lu(k,2344) - lu(k,1316) * lu(k,2338) + lu(k,2345) = lu(k,2345) - lu(k,1317) * lu(k,2338) + lu(k,2346) = lu(k,2346) - lu(k,1318) * lu(k,2338) + lu(k,2353) = lu(k,2353) - lu(k,1319) * lu(k,2338) + lu(k,2356) = lu(k,2356) - lu(k,1320) * lu(k,2338) + lu(k,2361) = - lu(k,1321) * lu(k,2338) + lu(k,2363) = lu(k,2363) - lu(k,1322) * lu(k,2338) + lu(k,2364) = lu(k,2364) - lu(k,1323) * lu(k,2338) + lu(k,2401) = lu(k,2401) - lu(k,1314) * lu(k,2400) + lu(k,2404) = - lu(k,1315) * lu(k,2400) + lu(k,2406) = - lu(k,1316) * lu(k,2400) + lu(k,2407) = lu(k,2407) - lu(k,1317) * lu(k,2400) + lu(k,2408) = lu(k,2408) - lu(k,1318) * lu(k,2400) + lu(k,2417) = lu(k,2417) - lu(k,1319) * lu(k,2400) + lu(k,2420) = lu(k,2420) - lu(k,1320) * lu(k,2400) + lu(k,2425) = lu(k,2425) - lu(k,1321) * lu(k,2400) + lu(k,2427) = lu(k,2427) - lu(k,1322) * lu(k,2400) + lu(k,2428) = lu(k,2428) - lu(k,1323) * lu(k,2400) + end do + end subroutine lu_fac26 + subroutine lu_fac27( 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,1325) = 1._r8 / lu(k,1325) + lu(k,1326) = lu(k,1326) * lu(k,1325) + lu(k,1327) = lu(k,1327) * lu(k,1325) + lu(k,1328) = lu(k,1328) * lu(k,1325) + lu(k,1329) = lu(k,1329) * lu(k,1325) + lu(k,1330) = lu(k,1330) * lu(k,1325) + lu(k,1331) = lu(k,1331) * lu(k,1325) + lu(k,1332) = lu(k,1332) * lu(k,1325) + lu(k,1347) = lu(k,1347) - lu(k,1326) * lu(k,1342) + lu(k,1348) = lu(k,1348) - lu(k,1327) * lu(k,1342) + lu(k,1351) = lu(k,1351) - lu(k,1328) * lu(k,1342) + lu(k,1352) = lu(k,1352) - lu(k,1329) * lu(k,1342) + lu(k,1353) = lu(k,1353) - lu(k,1330) * lu(k,1342) + lu(k,1354) = lu(k,1354) - lu(k,1331) * lu(k,1342) + lu(k,1358) = lu(k,1358) - lu(k,1332) * lu(k,1342) + lu(k,1380) = lu(k,1380) - lu(k,1326) * lu(k,1375) + lu(k,1381) = lu(k,1381) - lu(k,1327) * lu(k,1375) + lu(k,1384) = lu(k,1384) - lu(k,1328) * lu(k,1375) + lu(k,1385) = lu(k,1385) - lu(k,1329) * lu(k,1375) + lu(k,1386) = lu(k,1386) - lu(k,1330) * lu(k,1375) + lu(k,1387) = lu(k,1387) - lu(k,1331) * lu(k,1375) + lu(k,1391) = lu(k,1391) - lu(k,1332) * lu(k,1375) + lu(k,1402) = lu(k,1402) - lu(k,1326) * lu(k,1399) + lu(k,1403) = lu(k,1403) - lu(k,1327) * lu(k,1399) + lu(k,1406) = lu(k,1406) - lu(k,1328) * lu(k,1399) + lu(k,1407) = lu(k,1407) - lu(k,1329) * lu(k,1399) + lu(k,1408) = lu(k,1408) - lu(k,1330) * lu(k,1399) + lu(k,1409) = lu(k,1409) - lu(k,1331) * lu(k,1399) + lu(k,1412) = lu(k,1412) - lu(k,1332) * lu(k,1399) + lu(k,1422) = lu(k,1422) - lu(k,1326) * lu(k,1418) + lu(k,1423) = lu(k,1423) - lu(k,1327) * lu(k,1418) + lu(k,1427) = lu(k,1427) - lu(k,1328) * lu(k,1418) + lu(k,1428) = lu(k,1428) - lu(k,1329) * lu(k,1418) + lu(k,1430) = lu(k,1430) - lu(k,1330) * lu(k,1418) + lu(k,1431) = lu(k,1431) - lu(k,1331) * lu(k,1418) + lu(k,1435) = lu(k,1435) - lu(k,1332) * lu(k,1418) + lu(k,1442) = lu(k,1442) - lu(k,1326) * lu(k,1440) + lu(k,1443) = lu(k,1443) - lu(k,1327) * lu(k,1440) + lu(k,1446) = lu(k,1446) - lu(k,1328) * lu(k,1440) + lu(k,1447) = lu(k,1447) - lu(k,1329) * lu(k,1440) + lu(k,1448) = lu(k,1448) - lu(k,1330) * lu(k,1440) + lu(k,1449) = - lu(k,1331) * lu(k,1440) + lu(k,1453) = lu(k,1453) - lu(k,1332) * lu(k,1440) + lu(k,1472) = lu(k,1472) - lu(k,1326) * lu(k,1466) + lu(k,1473) = lu(k,1473) - lu(k,1327) * lu(k,1466) + lu(k,1477) = lu(k,1477) - lu(k,1328) * lu(k,1466) + lu(k,1478) = lu(k,1478) - lu(k,1329) * lu(k,1466) + lu(k,1480) = lu(k,1480) - lu(k,1330) * lu(k,1466) + lu(k,1481) = lu(k,1481) - lu(k,1331) * lu(k,1466) + lu(k,1485) = lu(k,1485) - lu(k,1332) * lu(k,1466) + lu(k,1673) = lu(k,1673) - lu(k,1326) * lu(k,1671) + lu(k,1674) = lu(k,1674) - lu(k,1327) * lu(k,1671) + lu(k,1684) = lu(k,1684) - lu(k,1328) * lu(k,1671) + lu(k,1685) = lu(k,1685) - lu(k,1329) * lu(k,1671) + lu(k,1687) = lu(k,1687) - lu(k,1330) * lu(k,1671) + lu(k,1690) = lu(k,1690) - lu(k,1331) * lu(k,1671) + lu(k,1695) = lu(k,1695) - lu(k,1332) * lu(k,1671) + lu(k,1781) = lu(k,1781) - lu(k,1326) * lu(k,1775) + lu(k,1782) = lu(k,1782) - lu(k,1327) * lu(k,1775) + lu(k,1790) = lu(k,1790) - lu(k,1328) * lu(k,1775) + lu(k,1791) = lu(k,1791) - lu(k,1329) * lu(k,1775) + lu(k,1793) = lu(k,1793) - lu(k,1330) * lu(k,1775) + lu(k,1796) = lu(k,1796) - lu(k,1331) * lu(k,1775) + lu(k,1801) = lu(k,1801) - lu(k,1332) * lu(k,1775) + lu(k,1994) = lu(k,1994) - lu(k,1326) * lu(k,1988) + lu(k,1995) = lu(k,1995) - lu(k,1327) * lu(k,1988) + lu(k,2006) = lu(k,2006) - lu(k,1328) * lu(k,1988) + lu(k,2007) = lu(k,2007) - lu(k,1329) * lu(k,1988) + lu(k,2009) = lu(k,2009) - lu(k,1330) * lu(k,1988) + lu(k,2012) = lu(k,2012) - lu(k,1331) * lu(k,1988) + lu(k,2017) = lu(k,2017) - lu(k,1332) * lu(k,1988) + lu(k,2056) = lu(k,2056) - lu(k,1326) * lu(k,2050) + lu(k,2057) = lu(k,2057) - lu(k,1327) * lu(k,2050) + lu(k,2066) = lu(k,2066) - lu(k,1328) * lu(k,2050) + lu(k,2067) = lu(k,2067) - lu(k,1329) * lu(k,2050) + lu(k,2069) = lu(k,2069) - lu(k,1330) * lu(k,2050) + lu(k,2072) = lu(k,2072) - lu(k,1331) * lu(k,2050) + lu(k,2077) = lu(k,2077) - lu(k,1332) * lu(k,2050) + lu(k,2200) = lu(k,2200) - lu(k,1326) * lu(k,2194) + lu(k,2201) = lu(k,2201) - lu(k,1327) * lu(k,2194) + lu(k,2211) = lu(k,2211) - lu(k,1328) * lu(k,2194) + lu(k,2212) = lu(k,2212) - lu(k,1329) * lu(k,2194) + lu(k,2214) = lu(k,2214) - lu(k,1330) * lu(k,2194) + lu(k,2217) = lu(k,2217) - lu(k,1331) * lu(k,2194) + lu(k,2222) = lu(k,2222) - lu(k,1332) * lu(k,2194) + lu(k,2246) = lu(k,2246) - lu(k,1326) * lu(k,2245) + lu(k,2247) = lu(k,2247) - lu(k,1327) * lu(k,2245) + lu(k,2257) = lu(k,2257) - lu(k,1328) * lu(k,2245) + lu(k,2258) = lu(k,2258) - lu(k,1329) * lu(k,2245) + lu(k,2260) = lu(k,2260) - lu(k,1330) * lu(k,2245) + lu(k,2263) = lu(k,2263) - lu(k,1331) * lu(k,2245) + lu(k,2268) = lu(k,2268) - lu(k,1332) * lu(k,2245) + lu(k,2345) = lu(k,2345) - lu(k,1326) * lu(k,2339) + lu(k,2346) = lu(k,2346) - lu(k,1327) * lu(k,2339) + lu(k,2353) = lu(k,2353) - lu(k,1328) * lu(k,2339) + lu(k,2354) = lu(k,2354) - lu(k,1329) * lu(k,2339) + lu(k,2356) = lu(k,2356) - lu(k,1330) * lu(k,2339) + lu(k,2359) = lu(k,2359) - lu(k,1331) * lu(k,2339) + lu(k,2364) = lu(k,2364) - lu(k,1332) * lu(k,2339) + lu(k,2407) = lu(k,2407) - lu(k,1326) * lu(k,2401) + lu(k,2408) = lu(k,2408) - lu(k,1327) * lu(k,2401) + lu(k,2417) = lu(k,2417) - lu(k,1328) * lu(k,2401) + lu(k,2418) = lu(k,2418) - lu(k,1329) * lu(k,2401) + lu(k,2420) = lu(k,2420) - lu(k,1330) * lu(k,2401) + lu(k,2423) = lu(k,2423) - lu(k,1331) * lu(k,2401) + lu(k,2428) = lu(k,2428) - lu(k,1332) * lu(k,2401) + lu(k,1343) = 1._r8 / lu(k,1343) + lu(k,1344) = lu(k,1344) * lu(k,1343) + lu(k,1345) = lu(k,1345) * lu(k,1343) + lu(k,1346) = lu(k,1346) * lu(k,1343) + lu(k,1347) = lu(k,1347) * lu(k,1343) + lu(k,1348) = lu(k,1348) * lu(k,1343) + lu(k,1349) = lu(k,1349) * lu(k,1343) + lu(k,1350) = lu(k,1350) * lu(k,1343) + lu(k,1351) = lu(k,1351) * lu(k,1343) + lu(k,1352) = lu(k,1352) * lu(k,1343) + lu(k,1353) = lu(k,1353) * lu(k,1343) + lu(k,1354) = lu(k,1354) * lu(k,1343) + lu(k,1355) = lu(k,1355) * lu(k,1343) + lu(k,1356) = lu(k,1356) * lu(k,1343) + lu(k,1357) = lu(k,1357) * lu(k,1343) + lu(k,1358) = lu(k,1358) * lu(k,1343) + lu(k,1469) = lu(k,1469) - lu(k,1344) * lu(k,1467) + lu(k,1470) = lu(k,1470) - lu(k,1345) * lu(k,1467) + lu(k,1471) = lu(k,1471) - lu(k,1346) * lu(k,1467) + lu(k,1472) = lu(k,1472) - lu(k,1347) * lu(k,1467) + lu(k,1473) = lu(k,1473) - lu(k,1348) * lu(k,1467) + lu(k,1475) = lu(k,1475) - lu(k,1349) * lu(k,1467) + lu(k,1476) = lu(k,1476) - lu(k,1350) * lu(k,1467) + lu(k,1477) = lu(k,1477) - lu(k,1351) * lu(k,1467) + lu(k,1478) = lu(k,1478) - lu(k,1352) * lu(k,1467) + lu(k,1480) = lu(k,1480) - lu(k,1353) * lu(k,1467) + lu(k,1481) = lu(k,1481) - lu(k,1354) * lu(k,1467) + lu(k,1482) = lu(k,1482) - lu(k,1355) * lu(k,1467) + lu(k,1483) = lu(k,1483) - lu(k,1356) * lu(k,1467) + lu(k,1484) = lu(k,1484) - lu(k,1357) * lu(k,1467) + lu(k,1485) = lu(k,1485) - lu(k,1358) * lu(k,1467) + lu(k,1778) = lu(k,1778) - lu(k,1344) * lu(k,1776) + lu(k,1779) = lu(k,1779) - lu(k,1345) * lu(k,1776) + lu(k,1780) = lu(k,1780) - lu(k,1346) * lu(k,1776) + lu(k,1781) = lu(k,1781) - lu(k,1347) * lu(k,1776) + lu(k,1782) = lu(k,1782) - lu(k,1348) * lu(k,1776) + lu(k,1787) = lu(k,1787) - lu(k,1349) * lu(k,1776) + lu(k,1788) = lu(k,1788) - lu(k,1350) * lu(k,1776) + lu(k,1790) = lu(k,1790) - lu(k,1351) * lu(k,1776) + lu(k,1791) = lu(k,1791) - lu(k,1352) * lu(k,1776) + lu(k,1793) = lu(k,1793) - lu(k,1353) * lu(k,1776) + lu(k,1796) = lu(k,1796) - lu(k,1354) * lu(k,1776) + lu(k,1797) = lu(k,1797) - lu(k,1355) * lu(k,1776) + lu(k,1798) = lu(k,1798) - lu(k,1356) * lu(k,1776) + lu(k,1800) = lu(k,1800) - lu(k,1357) * lu(k,1776) + lu(k,1801) = lu(k,1801) - lu(k,1358) * lu(k,1776) + lu(k,1991) = lu(k,1991) - lu(k,1344) * lu(k,1989) + lu(k,1992) = lu(k,1992) - lu(k,1345) * lu(k,1989) + lu(k,1993) = lu(k,1993) - lu(k,1346) * lu(k,1989) + lu(k,1994) = lu(k,1994) - lu(k,1347) * lu(k,1989) + lu(k,1995) = lu(k,1995) - lu(k,1348) * lu(k,1989) + lu(k,2003) = lu(k,2003) - lu(k,1349) * lu(k,1989) + lu(k,2004) = lu(k,2004) - lu(k,1350) * lu(k,1989) + lu(k,2006) = lu(k,2006) - lu(k,1351) * lu(k,1989) + lu(k,2007) = lu(k,2007) - lu(k,1352) * lu(k,1989) + lu(k,2009) = lu(k,2009) - lu(k,1353) * lu(k,1989) + lu(k,2012) = lu(k,2012) - lu(k,1354) * lu(k,1989) + lu(k,2013) = lu(k,2013) - lu(k,1355) * lu(k,1989) + lu(k,2014) = lu(k,2014) - lu(k,1356) * lu(k,1989) + lu(k,2016) = lu(k,2016) - lu(k,1357) * lu(k,1989) + lu(k,2017) = lu(k,2017) - lu(k,1358) * lu(k,1989) + lu(k,2053) = lu(k,2053) - lu(k,1344) * lu(k,2051) + lu(k,2054) = lu(k,2054) - lu(k,1345) * lu(k,2051) + lu(k,2055) = lu(k,2055) - lu(k,1346) * lu(k,2051) + lu(k,2056) = lu(k,2056) - lu(k,1347) * lu(k,2051) + lu(k,2057) = lu(k,2057) - lu(k,1348) * lu(k,2051) + lu(k,2063) = lu(k,2063) - lu(k,1349) * lu(k,2051) + lu(k,2064) = lu(k,2064) - lu(k,1350) * lu(k,2051) + lu(k,2066) = lu(k,2066) - lu(k,1351) * lu(k,2051) + lu(k,2067) = lu(k,2067) - lu(k,1352) * lu(k,2051) + lu(k,2069) = lu(k,2069) - lu(k,1353) * lu(k,2051) + lu(k,2072) = lu(k,2072) - lu(k,1354) * lu(k,2051) + lu(k,2073) = lu(k,2073) - lu(k,1355) * lu(k,2051) + lu(k,2074) = lu(k,2074) - lu(k,1356) * lu(k,2051) + lu(k,2076) = lu(k,2076) - lu(k,1357) * lu(k,2051) + lu(k,2077) = lu(k,2077) - lu(k,1358) * lu(k,2051) + lu(k,2197) = lu(k,2197) - lu(k,1344) * lu(k,2195) + lu(k,2198) = lu(k,2198) - lu(k,1345) * lu(k,2195) + lu(k,2199) = lu(k,2199) - lu(k,1346) * lu(k,2195) + lu(k,2200) = lu(k,2200) - lu(k,1347) * lu(k,2195) + lu(k,2201) = lu(k,2201) - lu(k,1348) * lu(k,2195) + lu(k,2208) = lu(k,2208) - lu(k,1349) * lu(k,2195) + lu(k,2209) = lu(k,2209) - lu(k,1350) * lu(k,2195) + lu(k,2211) = lu(k,2211) - lu(k,1351) * lu(k,2195) + lu(k,2212) = lu(k,2212) - lu(k,1352) * lu(k,2195) + lu(k,2214) = lu(k,2214) - lu(k,1353) * lu(k,2195) + lu(k,2217) = lu(k,2217) - lu(k,1354) * lu(k,2195) + lu(k,2218) = lu(k,2218) - lu(k,1355) * lu(k,2195) + lu(k,2219) = lu(k,2219) - lu(k,1356) * lu(k,2195) + lu(k,2221) = lu(k,2221) - lu(k,1357) * lu(k,2195) + lu(k,2222) = lu(k,2222) - lu(k,1358) * lu(k,2195) + lu(k,2342) = lu(k,2342) - lu(k,1344) * lu(k,2340) + lu(k,2343) = lu(k,2343) - lu(k,1345) * lu(k,2340) + lu(k,2344) = lu(k,2344) - lu(k,1346) * lu(k,2340) + lu(k,2345) = lu(k,2345) - lu(k,1347) * lu(k,2340) + lu(k,2346) = lu(k,2346) - lu(k,1348) * lu(k,2340) + lu(k,2350) = lu(k,2350) - lu(k,1349) * lu(k,2340) + lu(k,2351) = lu(k,2351) - lu(k,1350) * lu(k,2340) + lu(k,2353) = lu(k,2353) - lu(k,1351) * lu(k,2340) + lu(k,2354) = lu(k,2354) - lu(k,1352) * lu(k,2340) + lu(k,2356) = lu(k,2356) - lu(k,1353) * lu(k,2340) + lu(k,2359) = lu(k,2359) - lu(k,1354) * lu(k,2340) + lu(k,2360) = lu(k,2360) - lu(k,1355) * lu(k,2340) + lu(k,2361) = lu(k,2361) - lu(k,1356) * lu(k,2340) + lu(k,2363) = lu(k,2363) - lu(k,1357) * lu(k,2340) + lu(k,2364) = lu(k,2364) - lu(k,1358) * lu(k,2340) + lu(k,2404) = lu(k,2404) - lu(k,1344) * lu(k,2402) + lu(k,2405) = lu(k,2405) - lu(k,1345) * lu(k,2402) + lu(k,2406) = lu(k,2406) - lu(k,1346) * lu(k,2402) + lu(k,2407) = lu(k,2407) - lu(k,1347) * lu(k,2402) + lu(k,2408) = lu(k,2408) - lu(k,1348) * lu(k,2402) + lu(k,2414) = lu(k,2414) - lu(k,1349) * lu(k,2402) + lu(k,2415) = lu(k,2415) - lu(k,1350) * lu(k,2402) + lu(k,2417) = lu(k,2417) - lu(k,1351) * lu(k,2402) + lu(k,2418) = lu(k,2418) - lu(k,1352) * lu(k,2402) + lu(k,2420) = lu(k,2420) - lu(k,1353) * lu(k,2402) + lu(k,2423) = lu(k,2423) - lu(k,1354) * lu(k,2402) + lu(k,2424) = lu(k,2424) - lu(k,1355) * lu(k,2402) + lu(k,2425) = lu(k,2425) - lu(k,1356) * lu(k,2402) + lu(k,2427) = lu(k,2427) - lu(k,1357) * lu(k,2402) + lu(k,2428) = lu(k,2428) - lu(k,1358) * lu(k,2402) + lu(k,1376) = 1._r8 / lu(k,1376) + lu(k,1377) = lu(k,1377) * lu(k,1376) + lu(k,1378) = lu(k,1378) * lu(k,1376) + lu(k,1379) = lu(k,1379) * lu(k,1376) + lu(k,1380) = lu(k,1380) * lu(k,1376) + lu(k,1381) = lu(k,1381) * lu(k,1376) + lu(k,1382) = lu(k,1382) * lu(k,1376) + lu(k,1383) = lu(k,1383) * lu(k,1376) + lu(k,1384) = lu(k,1384) * lu(k,1376) + lu(k,1385) = lu(k,1385) * lu(k,1376) + lu(k,1386) = lu(k,1386) * lu(k,1376) + lu(k,1387) = lu(k,1387) * lu(k,1376) + lu(k,1388) = lu(k,1388) * lu(k,1376) + lu(k,1389) = lu(k,1389) * lu(k,1376) + lu(k,1390) = lu(k,1390) * lu(k,1376) + lu(k,1391) = lu(k,1391) * lu(k,1376) + lu(k,1469) = lu(k,1469) - lu(k,1377) * lu(k,1468) + lu(k,1470) = lu(k,1470) - lu(k,1378) * lu(k,1468) + lu(k,1471) = lu(k,1471) - lu(k,1379) * lu(k,1468) + lu(k,1472) = lu(k,1472) - lu(k,1380) * lu(k,1468) + lu(k,1473) = lu(k,1473) - lu(k,1381) * lu(k,1468) + lu(k,1475) = lu(k,1475) - lu(k,1382) * lu(k,1468) + lu(k,1476) = lu(k,1476) - lu(k,1383) * lu(k,1468) + lu(k,1477) = lu(k,1477) - lu(k,1384) * lu(k,1468) + lu(k,1478) = lu(k,1478) - lu(k,1385) * lu(k,1468) + lu(k,1480) = lu(k,1480) - lu(k,1386) * lu(k,1468) + lu(k,1481) = lu(k,1481) - lu(k,1387) * lu(k,1468) + lu(k,1482) = lu(k,1482) - lu(k,1388) * lu(k,1468) + lu(k,1483) = lu(k,1483) - lu(k,1389) * lu(k,1468) + lu(k,1484) = lu(k,1484) - lu(k,1390) * lu(k,1468) + lu(k,1485) = lu(k,1485) - lu(k,1391) * lu(k,1468) + lu(k,1778) = lu(k,1778) - lu(k,1377) * lu(k,1777) + lu(k,1779) = lu(k,1779) - lu(k,1378) * lu(k,1777) + lu(k,1780) = lu(k,1780) - lu(k,1379) * lu(k,1777) + lu(k,1781) = lu(k,1781) - lu(k,1380) * lu(k,1777) + lu(k,1782) = lu(k,1782) - lu(k,1381) * lu(k,1777) + lu(k,1787) = lu(k,1787) - lu(k,1382) * lu(k,1777) + lu(k,1788) = lu(k,1788) - lu(k,1383) * lu(k,1777) + lu(k,1790) = lu(k,1790) - lu(k,1384) * lu(k,1777) + lu(k,1791) = lu(k,1791) - lu(k,1385) * lu(k,1777) + lu(k,1793) = lu(k,1793) - lu(k,1386) * lu(k,1777) + lu(k,1796) = lu(k,1796) - lu(k,1387) * lu(k,1777) + lu(k,1797) = lu(k,1797) - lu(k,1388) * lu(k,1777) + lu(k,1798) = lu(k,1798) - lu(k,1389) * lu(k,1777) + lu(k,1800) = lu(k,1800) - lu(k,1390) * lu(k,1777) + lu(k,1801) = lu(k,1801) - lu(k,1391) * lu(k,1777) + lu(k,1991) = lu(k,1991) - lu(k,1377) * lu(k,1990) + lu(k,1992) = lu(k,1992) - lu(k,1378) * lu(k,1990) + lu(k,1993) = lu(k,1993) - lu(k,1379) * lu(k,1990) + lu(k,1994) = lu(k,1994) - lu(k,1380) * lu(k,1990) + lu(k,1995) = lu(k,1995) - lu(k,1381) * lu(k,1990) + lu(k,2003) = lu(k,2003) - lu(k,1382) * lu(k,1990) + lu(k,2004) = lu(k,2004) - lu(k,1383) * lu(k,1990) + lu(k,2006) = lu(k,2006) - lu(k,1384) * lu(k,1990) + lu(k,2007) = lu(k,2007) - lu(k,1385) * lu(k,1990) + lu(k,2009) = lu(k,2009) - lu(k,1386) * lu(k,1990) + lu(k,2012) = lu(k,2012) - lu(k,1387) * lu(k,1990) + lu(k,2013) = lu(k,2013) - lu(k,1388) * lu(k,1990) + lu(k,2014) = lu(k,2014) - lu(k,1389) * lu(k,1990) + lu(k,2016) = lu(k,2016) - lu(k,1390) * lu(k,1990) + lu(k,2017) = lu(k,2017) - lu(k,1391) * lu(k,1990) + lu(k,2053) = lu(k,2053) - lu(k,1377) * lu(k,2052) + lu(k,2054) = lu(k,2054) - lu(k,1378) * lu(k,2052) + lu(k,2055) = lu(k,2055) - lu(k,1379) * lu(k,2052) + lu(k,2056) = lu(k,2056) - lu(k,1380) * lu(k,2052) + lu(k,2057) = lu(k,2057) - lu(k,1381) * lu(k,2052) + lu(k,2063) = lu(k,2063) - lu(k,1382) * lu(k,2052) + lu(k,2064) = lu(k,2064) - lu(k,1383) * lu(k,2052) + lu(k,2066) = lu(k,2066) - lu(k,1384) * lu(k,2052) + lu(k,2067) = lu(k,2067) - lu(k,1385) * lu(k,2052) + lu(k,2069) = lu(k,2069) - lu(k,1386) * lu(k,2052) + lu(k,2072) = lu(k,2072) - lu(k,1387) * lu(k,2052) + lu(k,2073) = lu(k,2073) - lu(k,1388) * lu(k,2052) + lu(k,2074) = lu(k,2074) - lu(k,1389) * lu(k,2052) + lu(k,2076) = lu(k,2076) - lu(k,1390) * lu(k,2052) + lu(k,2077) = lu(k,2077) - lu(k,1391) * lu(k,2052) + lu(k,2197) = lu(k,2197) - lu(k,1377) * lu(k,2196) + lu(k,2198) = lu(k,2198) - lu(k,1378) * lu(k,2196) + lu(k,2199) = lu(k,2199) - lu(k,1379) * lu(k,2196) + lu(k,2200) = lu(k,2200) - lu(k,1380) * lu(k,2196) + lu(k,2201) = lu(k,2201) - lu(k,1381) * lu(k,2196) + lu(k,2208) = lu(k,2208) - lu(k,1382) * lu(k,2196) + lu(k,2209) = lu(k,2209) - lu(k,1383) * lu(k,2196) + lu(k,2211) = lu(k,2211) - lu(k,1384) * lu(k,2196) + lu(k,2212) = lu(k,2212) - lu(k,1385) * lu(k,2196) + lu(k,2214) = lu(k,2214) - lu(k,1386) * lu(k,2196) + lu(k,2217) = lu(k,2217) - lu(k,1387) * lu(k,2196) + lu(k,2218) = lu(k,2218) - lu(k,1388) * lu(k,2196) + lu(k,2219) = lu(k,2219) - lu(k,1389) * lu(k,2196) + lu(k,2221) = lu(k,2221) - lu(k,1390) * lu(k,2196) + lu(k,2222) = lu(k,2222) - lu(k,1391) * lu(k,2196) + lu(k,2342) = lu(k,2342) - lu(k,1377) * lu(k,2341) + lu(k,2343) = lu(k,2343) - lu(k,1378) * lu(k,2341) + lu(k,2344) = lu(k,2344) - lu(k,1379) * lu(k,2341) + lu(k,2345) = lu(k,2345) - lu(k,1380) * lu(k,2341) + lu(k,2346) = lu(k,2346) - lu(k,1381) * lu(k,2341) + lu(k,2350) = lu(k,2350) - lu(k,1382) * lu(k,2341) + lu(k,2351) = lu(k,2351) - lu(k,1383) * lu(k,2341) + lu(k,2353) = lu(k,2353) - lu(k,1384) * lu(k,2341) + lu(k,2354) = lu(k,2354) - lu(k,1385) * lu(k,2341) + lu(k,2356) = lu(k,2356) - lu(k,1386) * lu(k,2341) + lu(k,2359) = lu(k,2359) - lu(k,1387) * lu(k,2341) + lu(k,2360) = lu(k,2360) - lu(k,1388) * lu(k,2341) + lu(k,2361) = lu(k,2361) - lu(k,1389) * lu(k,2341) + lu(k,2363) = lu(k,2363) - lu(k,1390) * lu(k,2341) + lu(k,2364) = lu(k,2364) - lu(k,1391) * lu(k,2341) + lu(k,2404) = lu(k,2404) - lu(k,1377) * lu(k,2403) + lu(k,2405) = lu(k,2405) - lu(k,1378) * lu(k,2403) + lu(k,2406) = lu(k,2406) - lu(k,1379) * lu(k,2403) + lu(k,2407) = lu(k,2407) - lu(k,1380) * lu(k,2403) + lu(k,2408) = lu(k,2408) - lu(k,1381) * lu(k,2403) + lu(k,2414) = lu(k,2414) - lu(k,1382) * lu(k,2403) + lu(k,2415) = lu(k,2415) - lu(k,1383) * lu(k,2403) + lu(k,2417) = lu(k,2417) - lu(k,1384) * lu(k,2403) + lu(k,2418) = lu(k,2418) - lu(k,1385) * lu(k,2403) + lu(k,2420) = lu(k,2420) - lu(k,1386) * lu(k,2403) + lu(k,2423) = lu(k,2423) - lu(k,1387) * lu(k,2403) + lu(k,2424) = lu(k,2424) - lu(k,1388) * lu(k,2403) + lu(k,2425) = lu(k,2425) - lu(k,1389) * lu(k,2403) + lu(k,2427) = lu(k,2427) - lu(k,1390) * lu(k,2403) + lu(k,2428) = lu(k,2428) - lu(k,1391) * lu(k,2403) + lu(k,1400) = 1._r8 / lu(k,1400) + lu(k,1401) = lu(k,1401) * lu(k,1400) + lu(k,1402) = lu(k,1402) * lu(k,1400) + lu(k,1403) = lu(k,1403) * lu(k,1400) + lu(k,1404) = lu(k,1404) * lu(k,1400) + lu(k,1405) = lu(k,1405) * lu(k,1400) + lu(k,1406) = lu(k,1406) * lu(k,1400) + lu(k,1407) = lu(k,1407) * lu(k,1400) + lu(k,1408) = lu(k,1408) * lu(k,1400) + lu(k,1409) = lu(k,1409) * lu(k,1400) + lu(k,1410) = lu(k,1410) * lu(k,1400) + lu(k,1411) = lu(k,1411) * lu(k,1400) + lu(k,1412) = lu(k,1412) * lu(k,1400) + lu(k,1421) = - lu(k,1401) * lu(k,1419) + lu(k,1422) = lu(k,1422) - lu(k,1402) * lu(k,1419) + lu(k,1423) = lu(k,1423) - lu(k,1403) * lu(k,1419) + lu(k,1425) = lu(k,1425) - lu(k,1404) * lu(k,1419) + lu(k,1426) = lu(k,1426) - lu(k,1405) * lu(k,1419) + lu(k,1427) = lu(k,1427) - lu(k,1406) * lu(k,1419) + lu(k,1428) = lu(k,1428) - lu(k,1407) * lu(k,1419) + lu(k,1430) = lu(k,1430) - lu(k,1408) * lu(k,1419) + lu(k,1431) = lu(k,1431) - lu(k,1409) * lu(k,1419) + lu(k,1432) = lu(k,1432) - lu(k,1410) * lu(k,1419) + lu(k,1434) = lu(k,1434) - lu(k,1411) * lu(k,1419) + lu(k,1435) = lu(k,1435) - lu(k,1412) * lu(k,1419) + lu(k,1471) = lu(k,1471) - lu(k,1401) * lu(k,1469) + lu(k,1472) = lu(k,1472) - lu(k,1402) * lu(k,1469) + lu(k,1473) = lu(k,1473) - lu(k,1403) * lu(k,1469) + lu(k,1475) = lu(k,1475) - lu(k,1404) * lu(k,1469) + lu(k,1476) = lu(k,1476) - lu(k,1405) * lu(k,1469) + lu(k,1477) = lu(k,1477) - lu(k,1406) * lu(k,1469) + lu(k,1478) = lu(k,1478) - lu(k,1407) * lu(k,1469) + lu(k,1480) = lu(k,1480) - lu(k,1408) * lu(k,1469) + lu(k,1481) = lu(k,1481) - lu(k,1409) * lu(k,1469) + lu(k,1482) = lu(k,1482) - lu(k,1410) * lu(k,1469) + lu(k,1484) = lu(k,1484) - lu(k,1411) * lu(k,1469) + lu(k,1485) = lu(k,1485) - lu(k,1412) * lu(k,1469) + lu(k,1780) = lu(k,1780) - lu(k,1401) * lu(k,1778) + lu(k,1781) = lu(k,1781) - lu(k,1402) * lu(k,1778) + lu(k,1782) = lu(k,1782) - lu(k,1403) * lu(k,1778) + lu(k,1787) = lu(k,1787) - lu(k,1404) * lu(k,1778) + lu(k,1788) = lu(k,1788) - lu(k,1405) * lu(k,1778) + lu(k,1790) = lu(k,1790) - lu(k,1406) * lu(k,1778) + lu(k,1791) = lu(k,1791) - lu(k,1407) * lu(k,1778) + lu(k,1793) = lu(k,1793) - lu(k,1408) * lu(k,1778) + lu(k,1796) = lu(k,1796) - lu(k,1409) * lu(k,1778) + lu(k,1797) = lu(k,1797) - lu(k,1410) * lu(k,1778) + lu(k,1800) = lu(k,1800) - lu(k,1411) * lu(k,1778) + lu(k,1801) = lu(k,1801) - lu(k,1412) * lu(k,1778) + lu(k,1993) = lu(k,1993) - lu(k,1401) * lu(k,1991) + lu(k,1994) = lu(k,1994) - lu(k,1402) * lu(k,1991) + lu(k,1995) = lu(k,1995) - lu(k,1403) * lu(k,1991) + lu(k,2003) = lu(k,2003) - lu(k,1404) * lu(k,1991) + lu(k,2004) = lu(k,2004) - lu(k,1405) * lu(k,1991) + lu(k,2006) = lu(k,2006) - lu(k,1406) * lu(k,1991) + lu(k,2007) = lu(k,2007) - lu(k,1407) * lu(k,1991) + lu(k,2009) = lu(k,2009) - lu(k,1408) * lu(k,1991) + lu(k,2012) = lu(k,2012) - lu(k,1409) * lu(k,1991) + lu(k,2013) = lu(k,2013) - lu(k,1410) * lu(k,1991) + lu(k,2016) = lu(k,2016) - lu(k,1411) * lu(k,1991) + lu(k,2017) = lu(k,2017) - lu(k,1412) * lu(k,1991) + lu(k,2055) = lu(k,2055) - lu(k,1401) * lu(k,2053) + lu(k,2056) = lu(k,2056) - lu(k,1402) * lu(k,2053) + lu(k,2057) = lu(k,2057) - lu(k,1403) * lu(k,2053) + lu(k,2063) = lu(k,2063) - lu(k,1404) * lu(k,2053) + lu(k,2064) = lu(k,2064) - lu(k,1405) * lu(k,2053) + lu(k,2066) = lu(k,2066) - lu(k,1406) * lu(k,2053) + lu(k,2067) = lu(k,2067) - lu(k,1407) * lu(k,2053) + lu(k,2069) = lu(k,2069) - lu(k,1408) * lu(k,2053) + lu(k,2072) = lu(k,2072) - lu(k,1409) * lu(k,2053) + lu(k,2073) = lu(k,2073) - lu(k,1410) * lu(k,2053) + lu(k,2076) = lu(k,2076) - lu(k,1411) * lu(k,2053) + lu(k,2077) = lu(k,2077) - lu(k,1412) * lu(k,2053) + lu(k,2199) = lu(k,2199) - lu(k,1401) * lu(k,2197) + lu(k,2200) = lu(k,2200) - lu(k,1402) * lu(k,2197) + lu(k,2201) = lu(k,2201) - lu(k,1403) * lu(k,2197) + lu(k,2208) = lu(k,2208) - lu(k,1404) * lu(k,2197) + lu(k,2209) = lu(k,2209) - lu(k,1405) * lu(k,2197) + lu(k,2211) = lu(k,2211) - lu(k,1406) * lu(k,2197) + lu(k,2212) = lu(k,2212) - lu(k,1407) * lu(k,2197) + lu(k,2214) = lu(k,2214) - lu(k,1408) * lu(k,2197) + lu(k,2217) = lu(k,2217) - lu(k,1409) * lu(k,2197) + lu(k,2218) = lu(k,2218) - lu(k,1410) * lu(k,2197) + lu(k,2221) = lu(k,2221) - lu(k,1411) * lu(k,2197) + lu(k,2222) = lu(k,2222) - lu(k,1412) * lu(k,2197) + lu(k,2344) = lu(k,2344) - lu(k,1401) * lu(k,2342) + lu(k,2345) = lu(k,2345) - lu(k,1402) * lu(k,2342) + lu(k,2346) = lu(k,2346) - lu(k,1403) * lu(k,2342) + lu(k,2350) = lu(k,2350) - lu(k,1404) * lu(k,2342) + lu(k,2351) = lu(k,2351) - lu(k,1405) * lu(k,2342) + lu(k,2353) = lu(k,2353) - lu(k,1406) * lu(k,2342) + lu(k,2354) = lu(k,2354) - lu(k,1407) * lu(k,2342) + lu(k,2356) = lu(k,2356) - lu(k,1408) * lu(k,2342) + lu(k,2359) = lu(k,2359) - lu(k,1409) * lu(k,2342) + lu(k,2360) = lu(k,2360) - lu(k,1410) * lu(k,2342) + lu(k,2363) = lu(k,2363) - lu(k,1411) * lu(k,2342) + lu(k,2364) = lu(k,2364) - lu(k,1412) * lu(k,2342) + lu(k,2406) = lu(k,2406) - lu(k,1401) * lu(k,2404) + lu(k,2407) = lu(k,2407) - lu(k,1402) * lu(k,2404) + lu(k,2408) = lu(k,2408) - lu(k,1403) * lu(k,2404) + lu(k,2414) = lu(k,2414) - lu(k,1404) * lu(k,2404) + lu(k,2415) = lu(k,2415) - lu(k,1405) * lu(k,2404) + lu(k,2417) = lu(k,2417) - lu(k,1406) * lu(k,2404) + lu(k,2418) = lu(k,2418) - lu(k,1407) * lu(k,2404) + lu(k,2420) = lu(k,2420) - lu(k,1408) * lu(k,2404) + lu(k,2423) = lu(k,2423) - lu(k,1409) * lu(k,2404) + lu(k,2424) = lu(k,2424) - lu(k,1410) * lu(k,2404) + lu(k,2427) = lu(k,2427) - lu(k,1411) * lu(k,2404) + lu(k,2428) = lu(k,2428) - lu(k,1412) * lu(k,2404) + end do + end subroutine lu_fac27 + subroutine lu_fac28( 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,1420) = 1._r8 / lu(k,1420) + lu(k,1421) = lu(k,1421) * lu(k,1420) + lu(k,1422) = lu(k,1422) * lu(k,1420) + lu(k,1423) = lu(k,1423) * lu(k,1420) + lu(k,1424) = lu(k,1424) * lu(k,1420) + lu(k,1425) = lu(k,1425) * lu(k,1420) + lu(k,1426) = lu(k,1426) * lu(k,1420) + lu(k,1427) = lu(k,1427) * lu(k,1420) + lu(k,1428) = lu(k,1428) * lu(k,1420) + lu(k,1429) = lu(k,1429) * lu(k,1420) + lu(k,1430) = lu(k,1430) * lu(k,1420) + lu(k,1431) = lu(k,1431) * lu(k,1420) + lu(k,1432) = lu(k,1432) * lu(k,1420) + lu(k,1433) = lu(k,1433) * lu(k,1420) + lu(k,1434) = lu(k,1434) * lu(k,1420) + lu(k,1435) = lu(k,1435) * lu(k,1420) + lu(k,1471) = lu(k,1471) - lu(k,1421) * lu(k,1470) + lu(k,1472) = lu(k,1472) - lu(k,1422) * lu(k,1470) + lu(k,1473) = lu(k,1473) - lu(k,1423) * lu(k,1470) + lu(k,1474) = - lu(k,1424) * lu(k,1470) + lu(k,1475) = lu(k,1475) - lu(k,1425) * lu(k,1470) + lu(k,1476) = lu(k,1476) - lu(k,1426) * lu(k,1470) + lu(k,1477) = lu(k,1477) - lu(k,1427) * lu(k,1470) + lu(k,1478) = lu(k,1478) - lu(k,1428) * lu(k,1470) + lu(k,1479) = - lu(k,1429) * lu(k,1470) + lu(k,1480) = lu(k,1480) - lu(k,1430) * lu(k,1470) + lu(k,1481) = lu(k,1481) - lu(k,1431) * lu(k,1470) + lu(k,1482) = lu(k,1482) - lu(k,1432) * lu(k,1470) + lu(k,1483) = lu(k,1483) - lu(k,1433) * lu(k,1470) + lu(k,1484) = lu(k,1484) - lu(k,1434) * lu(k,1470) + lu(k,1485) = lu(k,1485) - lu(k,1435) * lu(k,1470) + lu(k,1780) = lu(k,1780) - lu(k,1421) * lu(k,1779) + lu(k,1781) = lu(k,1781) - lu(k,1422) * lu(k,1779) + lu(k,1782) = lu(k,1782) - lu(k,1423) * lu(k,1779) + lu(k,1784) = lu(k,1784) - lu(k,1424) * lu(k,1779) + lu(k,1787) = lu(k,1787) - lu(k,1425) * lu(k,1779) + lu(k,1788) = lu(k,1788) - lu(k,1426) * lu(k,1779) + lu(k,1790) = lu(k,1790) - lu(k,1427) * lu(k,1779) + lu(k,1791) = lu(k,1791) - lu(k,1428) * lu(k,1779) + lu(k,1792) = - lu(k,1429) * lu(k,1779) + lu(k,1793) = lu(k,1793) - lu(k,1430) * lu(k,1779) + lu(k,1796) = lu(k,1796) - lu(k,1431) * lu(k,1779) + lu(k,1797) = lu(k,1797) - lu(k,1432) * lu(k,1779) + lu(k,1798) = lu(k,1798) - lu(k,1433) * lu(k,1779) + lu(k,1800) = lu(k,1800) - lu(k,1434) * lu(k,1779) + lu(k,1801) = lu(k,1801) - lu(k,1435) * lu(k,1779) + lu(k,1993) = lu(k,1993) - lu(k,1421) * lu(k,1992) + lu(k,1994) = lu(k,1994) - lu(k,1422) * lu(k,1992) + lu(k,1995) = lu(k,1995) - lu(k,1423) * lu(k,1992) + lu(k,2000) = lu(k,2000) - lu(k,1424) * lu(k,1992) + lu(k,2003) = lu(k,2003) - lu(k,1425) * lu(k,1992) + lu(k,2004) = lu(k,2004) - lu(k,1426) * lu(k,1992) + lu(k,2006) = lu(k,2006) - lu(k,1427) * lu(k,1992) + lu(k,2007) = lu(k,2007) - lu(k,1428) * lu(k,1992) + lu(k,2008) = lu(k,2008) - lu(k,1429) * lu(k,1992) + lu(k,2009) = lu(k,2009) - lu(k,1430) * lu(k,1992) + lu(k,2012) = lu(k,2012) - lu(k,1431) * lu(k,1992) + lu(k,2013) = lu(k,2013) - lu(k,1432) * lu(k,1992) + lu(k,2014) = lu(k,2014) - lu(k,1433) * lu(k,1992) + lu(k,2016) = lu(k,2016) - lu(k,1434) * lu(k,1992) + lu(k,2017) = lu(k,2017) - lu(k,1435) * lu(k,1992) + lu(k,2055) = lu(k,2055) - lu(k,1421) * lu(k,2054) + lu(k,2056) = lu(k,2056) - lu(k,1422) * lu(k,2054) + lu(k,2057) = lu(k,2057) - lu(k,1423) * lu(k,2054) + lu(k,2060) = lu(k,2060) - lu(k,1424) * lu(k,2054) + lu(k,2063) = lu(k,2063) - lu(k,1425) * lu(k,2054) + lu(k,2064) = lu(k,2064) - lu(k,1426) * lu(k,2054) + lu(k,2066) = lu(k,2066) - lu(k,1427) * lu(k,2054) + lu(k,2067) = lu(k,2067) - lu(k,1428) * lu(k,2054) + lu(k,2068) = lu(k,2068) - lu(k,1429) * lu(k,2054) + lu(k,2069) = lu(k,2069) - lu(k,1430) * lu(k,2054) + lu(k,2072) = lu(k,2072) - lu(k,1431) * lu(k,2054) + lu(k,2073) = lu(k,2073) - lu(k,1432) * lu(k,2054) + lu(k,2074) = lu(k,2074) - lu(k,1433) * lu(k,2054) + lu(k,2076) = lu(k,2076) - lu(k,1434) * lu(k,2054) + lu(k,2077) = lu(k,2077) - lu(k,1435) * lu(k,2054) + lu(k,2199) = lu(k,2199) - lu(k,1421) * lu(k,2198) + lu(k,2200) = lu(k,2200) - lu(k,1422) * lu(k,2198) + lu(k,2201) = lu(k,2201) - lu(k,1423) * lu(k,2198) + lu(k,2205) = lu(k,2205) - lu(k,1424) * lu(k,2198) + lu(k,2208) = lu(k,2208) - lu(k,1425) * lu(k,2198) + lu(k,2209) = lu(k,2209) - lu(k,1426) * lu(k,2198) + lu(k,2211) = lu(k,2211) - lu(k,1427) * lu(k,2198) + lu(k,2212) = lu(k,2212) - lu(k,1428) * lu(k,2198) + lu(k,2213) = - lu(k,1429) * lu(k,2198) + lu(k,2214) = lu(k,2214) - lu(k,1430) * lu(k,2198) + lu(k,2217) = lu(k,2217) - lu(k,1431) * lu(k,2198) + lu(k,2218) = lu(k,2218) - lu(k,1432) * lu(k,2198) + lu(k,2219) = lu(k,2219) - lu(k,1433) * lu(k,2198) + lu(k,2221) = lu(k,2221) - lu(k,1434) * lu(k,2198) + lu(k,2222) = lu(k,2222) - lu(k,1435) * lu(k,2198) + lu(k,2344) = lu(k,2344) - lu(k,1421) * lu(k,2343) + lu(k,2345) = lu(k,2345) - lu(k,1422) * lu(k,2343) + lu(k,2346) = lu(k,2346) - lu(k,1423) * lu(k,2343) + lu(k,2347) = lu(k,2347) - lu(k,1424) * lu(k,2343) + lu(k,2350) = lu(k,2350) - lu(k,1425) * lu(k,2343) + lu(k,2351) = lu(k,2351) - lu(k,1426) * lu(k,2343) + lu(k,2353) = lu(k,2353) - lu(k,1427) * lu(k,2343) + lu(k,2354) = lu(k,2354) - lu(k,1428) * lu(k,2343) + lu(k,2355) = - lu(k,1429) * lu(k,2343) + lu(k,2356) = lu(k,2356) - lu(k,1430) * lu(k,2343) + lu(k,2359) = lu(k,2359) - lu(k,1431) * lu(k,2343) + lu(k,2360) = lu(k,2360) - lu(k,1432) * lu(k,2343) + lu(k,2361) = lu(k,2361) - lu(k,1433) * lu(k,2343) + lu(k,2363) = lu(k,2363) - lu(k,1434) * lu(k,2343) + lu(k,2364) = lu(k,2364) - lu(k,1435) * lu(k,2343) + lu(k,2406) = lu(k,2406) - lu(k,1421) * lu(k,2405) + lu(k,2407) = lu(k,2407) - lu(k,1422) * lu(k,2405) + lu(k,2408) = lu(k,2408) - lu(k,1423) * lu(k,2405) + lu(k,2411) = lu(k,2411) - lu(k,1424) * lu(k,2405) + lu(k,2414) = lu(k,2414) - lu(k,1425) * lu(k,2405) + lu(k,2415) = lu(k,2415) - lu(k,1426) * lu(k,2405) + lu(k,2417) = lu(k,2417) - lu(k,1427) * lu(k,2405) + lu(k,2418) = lu(k,2418) - lu(k,1428) * lu(k,2405) + lu(k,2419) = lu(k,2419) - lu(k,1429) * lu(k,2405) + lu(k,2420) = lu(k,2420) - lu(k,1430) * lu(k,2405) + lu(k,2423) = lu(k,2423) - lu(k,1431) * lu(k,2405) + lu(k,2424) = lu(k,2424) - lu(k,1432) * lu(k,2405) + lu(k,2425) = lu(k,2425) - lu(k,1433) * lu(k,2405) + lu(k,2427) = lu(k,2427) - lu(k,1434) * lu(k,2405) + lu(k,2428) = lu(k,2428) - lu(k,1435) * lu(k,2405) + lu(k,1441) = 1._r8 / lu(k,1441) + lu(k,1442) = lu(k,1442) * lu(k,1441) + lu(k,1443) = lu(k,1443) * lu(k,1441) + lu(k,1444) = lu(k,1444) * lu(k,1441) + lu(k,1445) = lu(k,1445) * lu(k,1441) + lu(k,1446) = lu(k,1446) * lu(k,1441) + lu(k,1447) = lu(k,1447) * lu(k,1441) + lu(k,1448) = lu(k,1448) * lu(k,1441) + lu(k,1449) = lu(k,1449) * lu(k,1441) + lu(k,1450) = lu(k,1450) * lu(k,1441) + lu(k,1451) = lu(k,1451) * lu(k,1441) + lu(k,1452) = lu(k,1452) * lu(k,1441) + lu(k,1453) = lu(k,1453) * lu(k,1441) + lu(k,1472) = lu(k,1472) - lu(k,1442) * lu(k,1471) + lu(k,1473) = lu(k,1473) - lu(k,1443) * lu(k,1471) + lu(k,1475) = lu(k,1475) - lu(k,1444) * lu(k,1471) + lu(k,1476) = lu(k,1476) - lu(k,1445) * lu(k,1471) + lu(k,1477) = lu(k,1477) - lu(k,1446) * lu(k,1471) + lu(k,1478) = lu(k,1478) - lu(k,1447) * lu(k,1471) + lu(k,1480) = lu(k,1480) - lu(k,1448) * lu(k,1471) + lu(k,1481) = lu(k,1481) - lu(k,1449) * lu(k,1471) + lu(k,1482) = lu(k,1482) - lu(k,1450) * lu(k,1471) + lu(k,1483) = lu(k,1483) - lu(k,1451) * lu(k,1471) + lu(k,1484) = lu(k,1484) - lu(k,1452) * lu(k,1471) + lu(k,1485) = lu(k,1485) - lu(k,1453) * lu(k,1471) + lu(k,1673) = lu(k,1673) - lu(k,1442) * lu(k,1672) + lu(k,1674) = lu(k,1674) - lu(k,1443) * lu(k,1672) + lu(k,1681) = lu(k,1681) - lu(k,1444) * lu(k,1672) + lu(k,1682) = lu(k,1682) - lu(k,1445) * lu(k,1672) + lu(k,1684) = lu(k,1684) - lu(k,1446) * lu(k,1672) + lu(k,1685) = lu(k,1685) - lu(k,1447) * lu(k,1672) + lu(k,1687) = lu(k,1687) - lu(k,1448) * lu(k,1672) + lu(k,1690) = lu(k,1690) - lu(k,1449) * lu(k,1672) + lu(k,1691) = lu(k,1691) - lu(k,1450) * lu(k,1672) + lu(k,1692) = lu(k,1692) - lu(k,1451) * lu(k,1672) + lu(k,1694) = lu(k,1694) - lu(k,1452) * lu(k,1672) + lu(k,1695) = lu(k,1695) - lu(k,1453) * lu(k,1672) + lu(k,1781) = lu(k,1781) - lu(k,1442) * lu(k,1780) + lu(k,1782) = lu(k,1782) - lu(k,1443) * lu(k,1780) + lu(k,1787) = lu(k,1787) - lu(k,1444) * lu(k,1780) + lu(k,1788) = lu(k,1788) - lu(k,1445) * lu(k,1780) + lu(k,1790) = lu(k,1790) - lu(k,1446) * lu(k,1780) + lu(k,1791) = lu(k,1791) - lu(k,1447) * lu(k,1780) + lu(k,1793) = lu(k,1793) - lu(k,1448) * lu(k,1780) + lu(k,1796) = lu(k,1796) - lu(k,1449) * lu(k,1780) + lu(k,1797) = lu(k,1797) - lu(k,1450) * lu(k,1780) + lu(k,1798) = lu(k,1798) - lu(k,1451) * lu(k,1780) + lu(k,1800) = lu(k,1800) - lu(k,1452) * lu(k,1780) + lu(k,1801) = lu(k,1801) - lu(k,1453) * lu(k,1780) + lu(k,1994) = lu(k,1994) - lu(k,1442) * lu(k,1993) + lu(k,1995) = lu(k,1995) - lu(k,1443) * lu(k,1993) + lu(k,2003) = lu(k,2003) - lu(k,1444) * lu(k,1993) + lu(k,2004) = lu(k,2004) - lu(k,1445) * lu(k,1993) + lu(k,2006) = lu(k,2006) - lu(k,1446) * lu(k,1993) + lu(k,2007) = lu(k,2007) - lu(k,1447) * lu(k,1993) + lu(k,2009) = lu(k,2009) - lu(k,1448) * lu(k,1993) + lu(k,2012) = lu(k,2012) - lu(k,1449) * lu(k,1993) + lu(k,2013) = lu(k,2013) - lu(k,1450) * lu(k,1993) + lu(k,2014) = lu(k,2014) - lu(k,1451) * lu(k,1993) + lu(k,2016) = lu(k,2016) - lu(k,1452) * lu(k,1993) + lu(k,2017) = lu(k,2017) - lu(k,1453) * lu(k,1993) + lu(k,2056) = lu(k,2056) - lu(k,1442) * lu(k,2055) + lu(k,2057) = lu(k,2057) - lu(k,1443) * lu(k,2055) + lu(k,2063) = lu(k,2063) - lu(k,1444) * lu(k,2055) + lu(k,2064) = lu(k,2064) - lu(k,1445) * lu(k,2055) + lu(k,2066) = lu(k,2066) - lu(k,1446) * lu(k,2055) + lu(k,2067) = lu(k,2067) - lu(k,1447) * lu(k,2055) + lu(k,2069) = lu(k,2069) - lu(k,1448) * lu(k,2055) + lu(k,2072) = lu(k,2072) - lu(k,1449) * lu(k,2055) + lu(k,2073) = lu(k,2073) - lu(k,1450) * lu(k,2055) + lu(k,2074) = lu(k,2074) - lu(k,1451) * lu(k,2055) + lu(k,2076) = lu(k,2076) - lu(k,1452) * lu(k,2055) + lu(k,2077) = lu(k,2077) - lu(k,1453) * lu(k,2055) + lu(k,2200) = lu(k,2200) - lu(k,1442) * lu(k,2199) + lu(k,2201) = lu(k,2201) - lu(k,1443) * lu(k,2199) + lu(k,2208) = lu(k,2208) - lu(k,1444) * lu(k,2199) + lu(k,2209) = lu(k,2209) - lu(k,1445) * lu(k,2199) + lu(k,2211) = lu(k,2211) - lu(k,1446) * lu(k,2199) + lu(k,2212) = lu(k,2212) - lu(k,1447) * lu(k,2199) + lu(k,2214) = lu(k,2214) - lu(k,1448) * lu(k,2199) + lu(k,2217) = lu(k,2217) - lu(k,1449) * lu(k,2199) + lu(k,2218) = lu(k,2218) - lu(k,1450) * lu(k,2199) + lu(k,2219) = lu(k,2219) - lu(k,1451) * lu(k,2199) + lu(k,2221) = lu(k,2221) - lu(k,1452) * lu(k,2199) + lu(k,2222) = lu(k,2222) - lu(k,1453) * lu(k,2199) + lu(k,2345) = lu(k,2345) - lu(k,1442) * lu(k,2344) + lu(k,2346) = lu(k,2346) - lu(k,1443) * lu(k,2344) + lu(k,2350) = lu(k,2350) - lu(k,1444) * lu(k,2344) + lu(k,2351) = lu(k,2351) - lu(k,1445) * lu(k,2344) + lu(k,2353) = lu(k,2353) - lu(k,1446) * lu(k,2344) + lu(k,2354) = lu(k,2354) - lu(k,1447) * lu(k,2344) + lu(k,2356) = lu(k,2356) - lu(k,1448) * lu(k,2344) + lu(k,2359) = lu(k,2359) - lu(k,1449) * lu(k,2344) + lu(k,2360) = lu(k,2360) - lu(k,1450) * lu(k,2344) + lu(k,2361) = lu(k,2361) - lu(k,1451) * lu(k,2344) + lu(k,2363) = lu(k,2363) - lu(k,1452) * lu(k,2344) + lu(k,2364) = lu(k,2364) - lu(k,1453) * lu(k,2344) + lu(k,2407) = lu(k,2407) - lu(k,1442) * lu(k,2406) + lu(k,2408) = lu(k,2408) - lu(k,1443) * lu(k,2406) + lu(k,2414) = lu(k,2414) - lu(k,1444) * lu(k,2406) + lu(k,2415) = lu(k,2415) - lu(k,1445) * lu(k,2406) + lu(k,2417) = lu(k,2417) - lu(k,1446) * lu(k,2406) + lu(k,2418) = lu(k,2418) - lu(k,1447) * lu(k,2406) + lu(k,2420) = lu(k,2420) - lu(k,1448) * lu(k,2406) + lu(k,2423) = lu(k,2423) - lu(k,1449) * lu(k,2406) + lu(k,2424) = lu(k,2424) - lu(k,1450) * lu(k,2406) + lu(k,2425) = lu(k,2425) - lu(k,1451) * lu(k,2406) + lu(k,2427) = lu(k,2427) - lu(k,1452) * lu(k,2406) + lu(k,2428) = lu(k,2428) - lu(k,1453) * lu(k,2406) + lu(k,1472) = 1._r8 / lu(k,1472) + lu(k,1473) = lu(k,1473) * lu(k,1472) + lu(k,1474) = lu(k,1474) * lu(k,1472) + lu(k,1475) = lu(k,1475) * lu(k,1472) + lu(k,1476) = lu(k,1476) * lu(k,1472) + lu(k,1477) = lu(k,1477) * lu(k,1472) + lu(k,1478) = lu(k,1478) * lu(k,1472) + lu(k,1479) = lu(k,1479) * lu(k,1472) + lu(k,1480) = lu(k,1480) * lu(k,1472) + lu(k,1481) = lu(k,1481) * lu(k,1472) + lu(k,1482) = lu(k,1482) * lu(k,1472) + lu(k,1483) = lu(k,1483) * lu(k,1472) + lu(k,1484) = lu(k,1484) * lu(k,1472) + lu(k,1485) = lu(k,1485) * lu(k,1472) + lu(k,1674) = lu(k,1674) - lu(k,1473) * lu(k,1673) + lu(k,1678) = lu(k,1678) - lu(k,1474) * lu(k,1673) + lu(k,1681) = lu(k,1681) - lu(k,1475) * lu(k,1673) + lu(k,1682) = lu(k,1682) - lu(k,1476) * lu(k,1673) + lu(k,1684) = lu(k,1684) - lu(k,1477) * lu(k,1673) + lu(k,1685) = lu(k,1685) - lu(k,1478) * lu(k,1673) + lu(k,1686) = - lu(k,1479) * lu(k,1673) + lu(k,1687) = lu(k,1687) - lu(k,1480) * lu(k,1673) + lu(k,1690) = lu(k,1690) - lu(k,1481) * lu(k,1673) + lu(k,1691) = lu(k,1691) - lu(k,1482) * lu(k,1673) + lu(k,1692) = lu(k,1692) - lu(k,1483) * lu(k,1673) + lu(k,1694) = lu(k,1694) - lu(k,1484) * lu(k,1673) + lu(k,1695) = lu(k,1695) - lu(k,1485) * lu(k,1673) + lu(k,1782) = lu(k,1782) - lu(k,1473) * lu(k,1781) + lu(k,1784) = lu(k,1784) - lu(k,1474) * lu(k,1781) + lu(k,1787) = lu(k,1787) - lu(k,1475) * lu(k,1781) + lu(k,1788) = lu(k,1788) - lu(k,1476) * lu(k,1781) + lu(k,1790) = lu(k,1790) - lu(k,1477) * lu(k,1781) + lu(k,1791) = lu(k,1791) - lu(k,1478) * lu(k,1781) + lu(k,1792) = lu(k,1792) - lu(k,1479) * lu(k,1781) + lu(k,1793) = lu(k,1793) - lu(k,1480) * lu(k,1781) + lu(k,1796) = lu(k,1796) - lu(k,1481) * lu(k,1781) + lu(k,1797) = lu(k,1797) - lu(k,1482) * lu(k,1781) + lu(k,1798) = lu(k,1798) - lu(k,1483) * lu(k,1781) + lu(k,1800) = lu(k,1800) - lu(k,1484) * lu(k,1781) + lu(k,1801) = lu(k,1801) - lu(k,1485) * lu(k,1781) + lu(k,1995) = lu(k,1995) - lu(k,1473) * lu(k,1994) + lu(k,2000) = lu(k,2000) - lu(k,1474) * lu(k,1994) + lu(k,2003) = lu(k,2003) - lu(k,1475) * lu(k,1994) + lu(k,2004) = lu(k,2004) - lu(k,1476) * lu(k,1994) + lu(k,2006) = lu(k,2006) - lu(k,1477) * lu(k,1994) + lu(k,2007) = lu(k,2007) - lu(k,1478) * lu(k,1994) + lu(k,2008) = lu(k,2008) - lu(k,1479) * lu(k,1994) + lu(k,2009) = lu(k,2009) - lu(k,1480) * lu(k,1994) + lu(k,2012) = lu(k,2012) - lu(k,1481) * lu(k,1994) + lu(k,2013) = lu(k,2013) - lu(k,1482) * lu(k,1994) + lu(k,2014) = lu(k,2014) - lu(k,1483) * lu(k,1994) + lu(k,2016) = lu(k,2016) - lu(k,1484) * lu(k,1994) + lu(k,2017) = lu(k,2017) - lu(k,1485) * lu(k,1994) + lu(k,2057) = lu(k,2057) - lu(k,1473) * lu(k,2056) + lu(k,2060) = lu(k,2060) - lu(k,1474) * lu(k,2056) + lu(k,2063) = lu(k,2063) - lu(k,1475) * lu(k,2056) + lu(k,2064) = lu(k,2064) - lu(k,1476) * lu(k,2056) + lu(k,2066) = lu(k,2066) - lu(k,1477) * lu(k,2056) + lu(k,2067) = lu(k,2067) - lu(k,1478) * lu(k,2056) + lu(k,2068) = lu(k,2068) - lu(k,1479) * lu(k,2056) + lu(k,2069) = lu(k,2069) - lu(k,1480) * lu(k,2056) + lu(k,2072) = lu(k,2072) - lu(k,1481) * lu(k,2056) + lu(k,2073) = lu(k,2073) - lu(k,1482) * lu(k,2056) + lu(k,2074) = lu(k,2074) - lu(k,1483) * lu(k,2056) + lu(k,2076) = lu(k,2076) - lu(k,1484) * lu(k,2056) + lu(k,2077) = lu(k,2077) - lu(k,1485) * lu(k,2056) + lu(k,2201) = lu(k,2201) - lu(k,1473) * lu(k,2200) + lu(k,2205) = lu(k,2205) - lu(k,1474) * lu(k,2200) + lu(k,2208) = lu(k,2208) - lu(k,1475) * lu(k,2200) + lu(k,2209) = lu(k,2209) - lu(k,1476) * lu(k,2200) + lu(k,2211) = lu(k,2211) - lu(k,1477) * lu(k,2200) + lu(k,2212) = lu(k,2212) - lu(k,1478) * lu(k,2200) + lu(k,2213) = lu(k,2213) - lu(k,1479) * lu(k,2200) + lu(k,2214) = lu(k,2214) - lu(k,1480) * lu(k,2200) + lu(k,2217) = lu(k,2217) - lu(k,1481) * lu(k,2200) + lu(k,2218) = lu(k,2218) - lu(k,1482) * lu(k,2200) + lu(k,2219) = lu(k,2219) - lu(k,1483) * lu(k,2200) + lu(k,2221) = lu(k,2221) - lu(k,1484) * lu(k,2200) + lu(k,2222) = lu(k,2222) - lu(k,1485) * lu(k,2200) + lu(k,2247) = lu(k,2247) - lu(k,1473) * lu(k,2246) + lu(k,2251) = lu(k,2251) - lu(k,1474) * lu(k,2246) + lu(k,2254) = lu(k,2254) - lu(k,1475) * lu(k,2246) + lu(k,2255) = lu(k,2255) - lu(k,1476) * lu(k,2246) + lu(k,2257) = lu(k,2257) - lu(k,1477) * lu(k,2246) + lu(k,2258) = lu(k,2258) - lu(k,1478) * lu(k,2246) + lu(k,2259) = lu(k,2259) - lu(k,1479) * lu(k,2246) + lu(k,2260) = lu(k,2260) - lu(k,1480) * lu(k,2246) + lu(k,2263) = lu(k,2263) - lu(k,1481) * lu(k,2246) + lu(k,2264) = lu(k,2264) - lu(k,1482) * lu(k,2246) + lu(k,2265) = lu(k,2265) - lu(k,1483) * lu(k,2246) + lu(k,2267) = lu(k,2267) - lu(k,1484) * lu(k,2246) + lu(k,2268) = lu(k,2268) - lu(k,1485) * lu(k,2246) + lu(k,2346) = lu(k,2346) - lu(k,1473) * lu(k,2345) + lu(k,2347) = lu(k,2347) - lu(k,1474) * lu(k,2345) + lu(k,2350) = lu(k,2350) - lu(k,1475) * lu(k,2345) + lu(k,2351) = lu(k,2351) - lu(k,1476) * lu(k,2345) + lu(k,2353) = lu(k,2353) - lu(k,1477) * lu(k,2345) + lu(k,2354) = lu(k,2354) - lu(k,1478) * lu(k,2345) + lu(k,2355) = lu(k,2355) - lu(k,1479) * lu(k,2345) + lu(k,2356) = lu(k,2356) - lu(k,1480) * lu(k,2345) + lu(k,2359) = lu(k,2359) - lu(k,1481) * lu(k,2345) + lu(k,2360) = lu(k,2360) - lu(k,1482) * lu(k,2345) + lu(k,2361) = lu(k,2361) - lu(k,1483) * lu(k,2345) + lu(k,2363) = lu(k,2363) - lu(k,1484) * lu(k,2345) + lu(k,2364) = lu(k,2364) - lu(k,1485) * lu(k,2345) + lu(k,2408) = lu(k,2408) - lu(k,1473) * lu(k,2407) + lu(k,2411) = lu(k,2411) - lu(k,1474) * lu(k,2407) + lu(k,2414) = lu(k,2414) - lu(k,1475) * lu(k,2407) + lu(k,2415) = lu(k,2415) - lu(k,1476) * lu(k,2407) + lu(k,2417) = lu(k,2417) - lu(k,1477) * lu(k,2407) + lu(k,2418) = lu(k,2418) - lu(k,1478) * lu(k,2407) + lu(k,2419) = lu(k,2419) - lu(k,1479) * lu(k,2407) + lu(k,2420) = lu(k,2420) - lu(k,1480) * lu(k,2407) + lu(k,2423) = lu(k,2423) - lu(k,1481) * lu(k,2407) + lu(k,2424) = lu(k,2424) - lu(k,1482) * lu(k,2407) + lu(k,2425) = lu(k,2425) - lu(k,1483) * lu(k,2407) + lu(k,2427) = lu(k,2427) - lu(k,1484) * lu(k,2407) + lu(k,2428) = lu(k,2428) - lu(k,1485) * lu(k,2407) + lu(k,1494) = 1._r8 / lu(k,1494) + lu(k,1495) = lu(k,1495) * lu(k,1494) + lu(k,1496) = lu(k,1496) * lu(k,1494) + lu(k,1497) = lu(k,1497) * lu(k,1494) + lu(k,1498) = lu(k,1498) * lu(k,1494) + lu(k,1499) = lu(k,1499) * lu(k,1494) + lu(k,1500) = lu(k,1500) * lu(k,1494) + lu(k,1501) = lu(k,1501) * lu(k,1494) + lu(k,1502) = lu(k,1502) * lu(k,1494) + lu(k,1556) = lu(k,1556) - lu(k,1495) * lu(k,1554) + lu(k,1558) = - lu(k,1496) * lu(k,1554) + lu(k,1559) = - lu(k,1497) * lu(k,1554) + lu(k,1560) = lu(k,1560) - lu(k,1498) * lu(k,1554) + lu(k,1561) = lu(k,1561) - lu(k,1499) * lu(k,1554) + lu(k,1562) = lu(k,1562) - lu(k,1500) * lu(k,1554) + lu(k,1563) = lu(k,1563) - lu(k,1501) * lu(k,1554) + lu(k,1565) = lu(k,1565) - lu(k,1502) * lu(k,1554) + lu(k,1586) = lu(k,1586) - lu(k,1495) * lu(k,1583) + lu(k,1589) = lu(k,1589) - lu(k,1496) * lu(k,1583) + lu(k,1590) = lu(k,1590) - lu(k,1497) * lu(k,1583) + lu(k,1591) = lu(k,1591) - lu(k,1498) * lu(k,1583) + lu(k,1592) = lu(k,1592) - lu(k,1499) * lu(k,1583) + lu(k,1593) = lu(k,1593) - lu(k,1500) * lu(k,1583) + lu(k,1595) = lu(k,1595) - lu(k,1501) * lu(k,1583) + lu(k,1597) = lu(k,1597) - lu(k,1502) * lu(k,1583) + lu(k,1678) = lu(k,1678) - lu(k,1495) * lu(k,1674) + lu(k,1681) = lu(k,1681) - lu(k,1496) * lu(k,1674) + lu(k,1682) = lu(k,1682) - lu(k,1497) * lu(k,1674) + lu(k,1683) = lu(k,1683) - lu(k,1498) * lu(k,1674) + lu(k,1684) = lu(k,1684) - lu(k,1499) * lu(k,1674) + lu(k,1687) = lu(k,1687) - lu(k,1500) * lu(k,1674) + lu(k,1689) = lu(k,1689) - lu(k,1501) * lu(k,1674) + lu(k,1693) = lu(k,1693) - lu(k,1502) * lu(k,1674) + lu(k,1784) = lu(k,1784) - lu(k,1495) * lu(k,1782) + lu(k,1787) = lu(k,1787) - lu(k,1496) * lu(k,1782) + lu(k,1788) = lu(k,1788) - lu(k,1497) * lu(k,1782) + lu(k,1789) = lu(k,1789) - lu(k,1498) * lu(k,1782) + lu(k,1790) = lu(k,1790) - lu(k,1499) * lu(k,1782) + lu(k,1793) = lu(k,1793) - lu(k,1500) * lu(k,1782) + lu(k,1795) = lu(k,1795) - lu(k,1501) * lu(k,1782) + lu(k,1799) = lu(k,1799) - lu(k,1502) * lu(k,1782) + lu(k,2000) = lu(k,2000) - lu(k,1495) * lu(k,1995) + lu(k,2003) = lu(k,2003) - lu(k,1496) * lu(k,1995) + lu(k,2004) = lu(k,2004) - lu(k,1497) * lu(k,1995) + lu(k,2005) = lu(k,2005) - lu(k,1498) * lu(k,1995) + lu(k,2006) = lu(k,2006) - lu(k,1499) * lu(k,1995) + lu(k,2009) = lu(k,2009) - lu(k,1500) * lu(k,1995) + lu(k,2011) = lu(k,2011) - lu(k,1501) * lu(k,1995) + lu(k,2015) = lu(k,2015) - lu(k,1502) * lu(k,1995) + lu(k,2060) = lu(k,2060) - lu(k,1495) * lu(k,2057) + lu(k,2063) = lu(k,2063) - lu(k,1496) * lu(k,2057) + lu(k,2064) = lu(k,2064) - lu(k,1497) * lu(k,2057) + lu(k,2065) = - lu(k,1498) * lu(k,2057) + lu(k,2066) = lu(k,2066) - lu(k,1499) * lu(k,2057) + lu(k,2069) = lu(k,2069) - lu(k,1500) * lu(k,2057) + lu(k,2071) = - lu(k,1501) * lu(k,2057) + lu(k,2075) = lu(k,2075) - lu(k,1502) * lu(k,2057) + lu(k,2085) = - lu(k,1495) * lu(k,2081) + lu(k,2088) = - lu(k,1496) * lu(k,2081) + lu(k,2089) = - lu(k,1497) * lu(k,2081) + lu(k,2090) = lu(k,2090) - lu(k,1498) * lu(k,2081) + lu(k,2091) = lu(k,2091) - lu(k,1499) * lu(k,2081) + lu(k,2094) = lu(k,2094) - lu(k,1500) * lu(k,2081) + lu(k,2096) = lu(k,2096) - lu(k,1501) * lu(k,2081) + lu(k,2100) = lu(k,2100) - lu(k,1502) * lu(k,2081) + lu(k,2205) = lu(k,2205) - lu(k,1495) * lu(k,2201) + lu(k,2208) = lu(k,2208) - lu(k,1496) * lu(k,2201) + lu(k,2209) = lu(k,2209) - lu(k,1497) * lu(k,2201) + lu(k,2210) = lu(k,2210) - lu(k,1498) * lu(k,2201) + lu(k,2211) = lu(k,2211) - lu(k,1499) * lu(k,2201) + lu(k,2214) = lu(k,2214) - lu(k,1500) * lu(k,2201) + lu(k,2216) = lu(k,2216) - lu(k,1501) * lu(k,2201) + lu(k,2220) = lu(k,2220) - lu(k,1502) * lu(k,2201) + lu(k,2251) = lu(k,2251) - lu(k,1495) * lu(k,2247) + lu(k,2254) = lu(k,2254) - lu(k,1496) * lu(k,2247) + lu(k,2255) = lu(k,2255) - lu(k,1497) * lu(k,2247) + lu(k,2256) = lu(k,2256) - lu(k,1498) * lu(k,2247) + lu(k,2257) = lu(k,2257) - lu(k,1499) * lu(k,2247) + lu(k,2260) = lu(k,2260) - lu(k,1500) * lu(k,2247) + lu(k,2262) = lu(k,2262) - lu(k,1501) * lu(k,2247) + lu(k,2266) = lu(k,2266) - lu(k,1502) * lu(k,2247) + lu(k,2347) = lu(k,2347) - lu(k,1495) * lu(k,2346) + lu(k,2350) = lu(k,2350) - lu(k,1496) * lu(k,2346) + lu(k,2351) = lu(k,2351) - lu(k,1497) * lu(k,2346) + lu(k,2352) = - lu(k,1498) * lu(k,2346) + lu(k,2353) = lu(k,2353) - lu(k,1499) * lu(k,2346) + lu(k,2356) = lu(k,2356) - lu(k,1500) * lu(k,2346) + lu(k,2358) = lu(k,2358) - lu(k,1501) * lu(k,2346) + lu(k,2362) = - lu(k,1502) * lu(k,2346) + lu(k,2411) = lu(k,2411) - lu(k,1495) * lu(k,2408) + lu(k,2414) = lu(k,2414) - lu(k,1496) * lu(k,2408) + lu(k,2415) = lu(k,2415) - lu(k,1497) * lu(k,2408) + lu(k,2416) = lu(k,2416) - lu(k,1498) * lu(k,2408) + lu(k,2417) = lu(k,2417) - lu(k,1499) * lu(k,2408) + lu(k,2420) = lu(k,2420) - lu(k,1500) * lu(k,2408) + lu(k,2422) = lu(k,2422) - lu(k,1501) * lu(k,2408) + lu(k,2426) = lu(k,2426) - lu(k,1502) * lu(k,2408) + lu(k,2454) = lu(k,2454) - lu(k,1495) * lu(k,2449) + lu(k,2457) = lu(k,2457) - lu(k,1496) * lu(k,2449) + lu(k,2458) = lu(k,2458) - lu(k,1497) * lu(k,2449) + lu(k,2459) = lu(k,2459) - lu(k,1498) * lu(k,2449) + lu(k,2460) = lu(k,2460) - lu(k,1499) * lu(k,2449) + lu(k,2463) = lu(k,2463) - lu(k,1500) * lu(k,2449) + lu(k,2465) = lu(k,2465) - lu(k,1501) * lu(k,2449) + lu(k,2469) = lu(k,2469) - lu(k,1502) * lu(k,2449) + lu(k,2480) = - lu(k,1495) * lu(k,2476) + lu(k,2483) = lu(k,2483) - lu(k,1496) * lu(k,2476) + lu(k,2484) = lu(k,2484) - lu(k,1497) * lu(k,2476) + lu(k,2485) = lu(k,2485) - lu(k,1498) * lu(k,2476) + lu(k,2486) = lu(k,2486) - lu(k,1499) * lu(k,2476) + lu(k,2489) = lu(k,2489) - lu(k,1500) * lu(k,2476) + lu(k,2491) = lu(k,2491) - lu(k,1501) * lu(k,2476) + lu(k,2495) = lu(k,2495) - lu(k,1502) * lu(k,2476) + end do + end subroutine lu_fac28 + subroutine lu_fac29( 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,1505) = 1._r8 / lu(k,1505) + lu(k,1506) = lu(k,1506) * lu(k,1505) + lu(k,1507) = lu(k,1507) * lu(k,1505) + lu(k,1508) = lu(k,1508) * lu(k,1505) + lu(k,1509) = lu(k,1509) * lu(k,1505) + lu(k,1510) = lu(k,1510) * lu(k,1505) + lu(k,1511) = lu(k,1511) * lu(k,1505) + lu(k,1512) = lu(k,1512) * lu(k,1505) + lu(k,1513) = lu(k,1513) * lu(k,1505) + lu(k,1514) = lu(k,1514) * lu(k,1505) + lu(k,1515) = lu(k,1515) * lu(k,1505) + lu(k,1516) = lu(k,1516) * lu(k,1505) + lu(k,1825) = lu(k,1825) - lu(k,1506) * lu(k,1824) + lu(k,1832) = lu(k,1832) - lu(k,1507) * lu(k,1824) + lu(k,1833) = lu(k,1833) - lu(k,1508) * lu(k,1824) + lu(k,1834) = lu(k,1834) - lu(k,1509) * lu(k,1824) + lu(k,1835) = lu(k,1835) - lu(k,1510) * lu(k,1824) + lu(k,1837) = lu(k,1837) - lu(k,1511) * lu(k,1824) + lu(k,1838) = lu(k,1838) - lu(k,1512) * lu(k,1824) + lu(k,1839) = lu(k,1839) - lu(k,1513) * lu(k,1824) + lu(k,1840) = lu(k,1840) - lu(k,1514) * lu(k,1824) + lu(k,1842) = lu(k,1842) - lu(k,1515) * lu(k,1824) + lu(k,1844) = lu(k,1844) - lu(k,1516) * lu(k,1824) + lu(k,1998) = lu(k,1998) - lu(k,1506) * lu(k,1996) + lu(k,2005) = lu(k,2005) - lu(k,1507) * lu(k,1996) + lu(k,2006) = lu(k,2006) - lu(k,1508) * lu(k,1996) + lu(k,2007) = lu(k,2007) - lu(k,1509) * lu(k,1996) + lu(k,2008) = lu(k,2008) - lu(k,1510) * lu(k,1996) + lu(k,2010) = lu(k,2010) - lu(k,1511) * lu(k,1996) + lu(k,2011) = lu(k,2011) - lu(k,1512) * lu(k,1996) + lu(k,2012) = lu(k,2012) - lu(k,1513) * lu(k,1996) + lu(k,2013) = lu(k,2013) - lu(k,1514) * lu(k,1996) + lu(k,2015) = lu(k,2015) - lu(k,1515) * lu(k,1996) + lu(k,2017) = lu(k,2017) - lu(k,1516) * lu(k,1996) + lu(k,2083) = lu(k,2083) - lu(k,1506) * lu(k,2082) + lu(k,2090) = lu(k,2090) - lu(k,1507) * lu(k,2082) + lu(k,2091) = lu(k,2091) - lu(k,1508) * lu(k,2082) + lu(k,2092) = lu(k,2092) - lu(k,1509) * lu(k,2082) + lu(k,2093) = lu(k,2093) - lu(k,1510) * lu(k,2082) + lu(k,2095) = lu(k,2095) - lu(k,1511) * lu(k,2082) + lu(k,2096) = lu(k,2096) - lu(k,1512) * lu(k,2082) + lu(k,2097) = lu(k,2097) - lu(k,1513) * lu(k,2082) + lu(k,2098) = lu(k,2098) - lu(k,1514) * lu(k,2082) + lu(k,2100) = lu(k,2100) - lu(k,1515) * lu(k,2082) + lu(k,2102) = lu(k,2102) - lu(k,1516) * lu(k,2082) + lu(k,2203) = lu(k,2203) - lu(k,1506) * lu(k,2202) + lu(k,2210) = lu(k,2210) - lu(k,1507) * lu(k,2202) + lu(k,2211) = lu(k,2211) - lu(k,1508) * lu(k,2202) + lu(k,2212) = lu(k,2212) - lu(k,1509) * lu(k,2202) + lu(k,2213) = lu(k,2213) - lu(k,1510) * lu(k,2202) + lu(k,2215) = lu(k,2215) - lu(k,1511) * lu(k,2202) + lu(k,2216) = lu(k,2216) - lu(k,1512) * lu(k,2202) + lu(k,2217) = lu(k,2217) - lu(k,1513) * lu(k,2202) + lu(k,2218) = lu(k,2218) - lu(k,1514) * lu(k,2202) + lu(k,2220) = lu(k,2220) - lu(k,1515) * lu(k,2202) + lu(k,2222) = lu(k,2222) - lu(k,1516) * lu(k,2202) + lu(k,2249) = lu(k,2249) - lu(k,1506) * lu(k,2248) + lu(k,2256) = lu(k,2256) - lu(k,1507) * lu(k,2248) + lu(k,2257) = lu(k,2257) - lu(k,1508) * lu(k,2248) + lu(k,2258) = lu(k,2258) - lu(k,1509) * lu(k,2248) + lu(k,2259) = lu(k,2259) - lu(k,1510) * lu(k,2248) + lu(k,2261) = lu(k,2261) - lu(k,1511) * lu(k,2248) + lu(k,2262) = lu(k,2262) - lu(k,1512) * lu(k,2248) + lu(k,2263) = lu(k,2263) - lu(k,1513) * lu(k,2248) + lu(k,2264) = lu(k,2264) - lu(k,1514) * lu(k,2248) + lu(k,2266) = lu(k,2266) - lu(k,1515) * lu(k,2248) + lu(k,2268) = lu(k,2268) - lu(k,1516) * lu(k,2248) + lu(k,2270) = - lu(k,1506) * lu(k,2269) + lu(k,2277) = - lu(k,1507) * lu(k,2269) + lu(k,2278) = lu(k,2278) - lu(k,1508) * lu(k,2269) + lu(k,2279) = - lu(k,1509) * lu(k,2269) + lu(k,2280) = - lu(k,1510) * lu(k,2269) + lu(k,2282) = - lu(k,1511) * lu(k,2269) + lu(k,2283) = lu(k,2283) - lu(k,1512) * lu(k,2269) + lu(k,2284) = - lu(k,1513) * lu(k,2269) + lu(k,2285) = - lu(k,1514) * lu(k,2269) + lu(k,2287) = lu(k,2287) - lu(k,1515) * lu(k,2269) + lu(k,2289) = lu(k,2289) - lu(k,1516) * lu(k,2269) + lu(k,2293) = - lu(k,1506) * lu(k,2292) + lu(k,2300) = - lu(k,1507) * lu(k,2292) + lu(k,2301) = lu(k,2301) - lu(k,1508) * lu(k,2292) + lu(k,2302) = lu(k,2302) - lu(k,1509) * lu(k,2292) + lu(k,2303) = lu(k,2303) - lu(k,1510) * lu(k,2292) + lu(k,2305) = - lu(k,1511) * lu(k,2292) + lu(k,2306) = lu(k,2306) - lu(k,1512) * lu(k,2292) + lu(k,2307) = lu(k,2307) - lu(k,1513) * lu(k,2292) + lu(k,2308) = lu(k,2308) - lu(k,1514) * lu(k,2292) + lu(k,2310) = - lu(k,1515) * lu(k,2292) + lu(k,2312) = lu(k,2312) - lu(k,1516) * lu(k,2292) + lu(k,2452) = lu(k,2452) - lu(k,1506) * lu(k,2450) + lu(k,2459) = lu(k,2459) - lu(k,1507) * lu(k,2450) + lu(k,2460) = lu(k,2460) - lu(k,1508) * lu(k,2450) + lu(k,2461) = lu(k,2461) - lu(k,1509) * lu(k,2450) + lu(k,2462) = - lu(k,1510) * lu(k,2450) + lu(k,2464) = lu(k,2464) - lu(k,1511) * lu(k,2450) + lu(k,2465) = lu(k,2465) - lu(k,1512) * lu(k,2450) + lu(k,2466) = lu(k,2466) - lu(k,1513) * lu(k,2450) + lu(k,2467) = - lu(k,1514) * lu(k,2450) + lu(k,2469) = lu(k,2469) - lu(k,1515) * lu(k,2450) + lu(k,2471) = lu(k,2471) - lu(k,1516) * lu(k,2450) + lu(k,2478) = lu(k,2478) - lu(k,1506) * lu(k,2477) + lu(k,2485) = lu(k,2485) - lu(k,1507) * lu(k,2477) + lu(k,2486) = lu(k,2486) - lu(k,1508) * lu(k,2477) + lu(k,2487) = lu(k,2487) - lu(k,1509) * lu(k,2477) + lu(k,2488) = - lu(k,1510) * lu(k,2477) + lu(k,2490) = lu(k,2490) - lu(k,1511) * lu(k,2477) + lu(k,2491) = lu(k,2491) - lu(k,1512) * lu(k,2477) + lu(k,2492) = lu(k,2492) - lu(k,1513) * lu(k,2477) + lu(k,2493) = - lu(k,1514) * lu(k,2477) + lu(k,2495) = lu(k,2495) - lu(k,1515) * lu(k,2477) + lu(k,2497) = lu(k,2497) - lu(k,1516) * lu(k,2477) + lu(k,2505) = - lu(k,1506) * lu(k,2503) + lu(k,2512) = lu(k,2512) - lu(k,1507) * lu(k,2503) + lu(k,2513) = lu(k,2513) - lu(k,1508) * lu(k,2503) + lu(k,2514) = lu(k,2514) - lu(k,1509) * lu(k,2503) + lu(k,2515) = lu(k,2515) - lu(k,1510) * lu(k,2503) + lu(k,2517) = - lu(k,1511) * lu(k,2503) + lu(k,2518) = lu(k,2518) - lu(k,1512) * lu(k,2503) + lu(k,2519) = lu(k,2519) - lu(k,1513) * lu(k,2503) + lu(k,2520) = lu(k,2520) - lu(k,1514) * lu(k,2503) + lu(k,2522) = lu(k,2522) - lu(k,1515) * lu(k,2503) + lu(k,2524) = lu(k,2524) - lu(k,1516) * lu(k,2503) + lu(k,1520) = 1._r8 / lu(k,1520) + lu(k,1521) = lu(k,1521) * lu(k,1520) + lu(k,1522) = lu(k,1522) * lu(k,1520) + lu(k,1523) = lu(k,1523) * lu(k,1520) + lu(k,1524) = lu(k,1524) * lu(k,1520) + lu(k,1525) = lu(k,1525) * lu(k,1520) + lu(k,1526) = lu(k,1526) * lu(k,1520) + lu(k,1527) = lu(k,1527) * lu(k,1520) + lu(k,1528) = lu(k,1528) * lu(k,1520) + lu(k,1529) = lu(k,1529) * lu(k,1520) + lu(k,1530) = lu(k,1530) * lu(k,1520) + lu(k,1531) = lu(k,1531) * lu(k,1520) + lu(k,1532) = lu(k,1532) * lu(k,1520) + lu(k,1533) = lu(k,1533) * lu(k,1520) + lu(k,1585) = - lu(k,1521) * lu(k,1584) + lu(k,1586) = lu(k,1586) - lu(k,1522) * lu(k,1584) + lu(k,1587) = - lu(k,1523) * lu(k,1584) + lu(k,1588) = - lu(k,1524) * lu(k,1584) + lu(k,1589) = lu(k,1589) - lu(k,1525) * lu(k,1584) + lu(k,1590) = lu(k,1590) - lu(k,1526) * lu(k,1584) + lu(k,1592) = lu(k,1592) - lu(k,1527) * lu(k,1584) + lu(k,1593) = lu(k,1593) - lu(k,1528) * lu(k,1584) + lu(k,1594) = - lu(k,1529) * lu(k,1584) + lu(k,1595) = lu(k,1595) - lu(k,1530) * lu(k,1584) + lu(k,1596) = lu(k,1596) - lu(k,1531) * lu(k,1584) + lu(k,1597) = lu(k,1597) - lu(k,1532) * lu(k,1584) + lu(k,1599) = lu(k,1599) - lu(k,1533) * lu(k,1584) + lu(k,1607) = lu(k,1607) - lu(k,1521) * lu(k,1605) + lu(k,1608) = lu(k,1608) - lu(k,1522) * lu(k,1605) + lu(k,1609) = lu(k,1609) - lu(k,1523) * lu(k,1605) + lu(k,1610) = lu(k,1610) - lu(k,1524) * lu(k,1605) + lu(k,1611) = lu(k,1611) - lu(k,1525) * lu(k,1605) + lu(k,1612) = lu(k,1612) - lu(k,1526) * lu(k,1605) + lu(k,1614) = lu(k,1614) - lu(k,1527) * lu(k,1605) + lu(k,1616) = lu(k,1616) - lu(k,1528) * lu(k,1605) + lu(k,1617) = lu(k,1617) - lu(k,1529) * lu(k,1605) + lu(k,1618) = - lu(k,1530) * lu(k,1605) + lu(k,1620) = - lu(k,1531) * lu(k,1605) + lu(k,1621) = lu(k,1621) - lu(k,1532) * lu(k,1605) + lu(k,1623) = lu(k,1623) - lu(k,1533) * lu(k,1605) + lu(k,1633) = lu(k,1633) - lu(k,1521) * lu(k,1631) + lu(k,1634) = lu(k,1634) - lu(k,1522) * lu(k,1631) + lu(k,1635) = lu(k,1635) - lu(k,1523) * lu(k,1631) + lu(k,1636) = lu(k,1636) - lu(k,1524) * lu(k,1631) + lu(k,1637) = lu(k,1637) - lu(k,1525) * lu(k,1631) + lu(k,1638) = lu(k,1638) - lu(k,1526) * lu(k,1631) + lu(k,1640) = lu(k,1640) - lu(k,1527) * lu(k,1631) + lu(k,1642) = lu(k,1642) - lu(k,1528) * lu(k,1631) + lu(k,1643) = lu(k,1643) - lu(k,1529) * lu(k,1631) + lu(k,1644) = - lu(k,1530) * lu(k,1631) + lu(k,1647) = - lu(k,1531) * lu(k,1631) + lu(k,1648) = lu(k,1648) - lu(k,1532) * lu(k,1631) + lu(k,1650) = lu(k,1650) - lu(k,1533) * lu(k,1631) + lu(k,1677) = lu(k,1677) - lu(k,1521) * lu(k,1675) + lu(k,1678) = lu(k,1678) - lu(k,1522) * lu(k,1675) + lu(k,1679) = lu(k,1679) - lu(k,1523) * lu(k,1675) + lu(k,1680) = lu(k,1680) - lu(k,1524) * lu(k,1675) + lu(k,1681) = lu(k,1681) - lu(k,1525) * lu(k,1675) + lu(k,1682) = lu(k,1682) - lu(k,1526) * lu(k,1675) + lu(k,1684) = lu(k,1684) - lu(k,1527) * lu(k,1675) + lu(k,1687) = lu(k,1687) - lu(k,1528) * lu(k,1675) + lu(k,1688) = lu(k,1688) - lu(k,1529) * lu(k,1675) + lu(k,1689) = lu(k,1689) - lu(k,1530) * lu(k,1675) + lu(k,1692) = lu(k,1692) - lu(k,1531) * lu(k,1675) + lu(k,1693) = lu(k,1693) - lu(k,1532) * lu(k,1675) + lu(k,1695) = lu(k,1695) - lu(k,1533) * lu(k,1675) + lu(k,1999) = lu(k,1999) - lu(k,1521) * lu(k,1997) + lu(k,2000) = lu(k,2000) - lu(k,1522) * lu(k,1997) + lu(k,2001) = lu(k,2001) - lu(k,1523) * lu(k,1997) + lu(k,2002) = lu(k,2002) - lu(k,1524) * lu(k,1997) + lu(k,2003) = lu(k,2003) - lu(k,1525) * lu(k,1997) + lu(k,2004) = lu(k,2004) - lu(k,1526) * lu(k,1997) + lu(k,2006) = lu(k,2006) - lu(k,1527) * lu(k,1997) + lu(k,2009) = lu(k,2009) - lu(k,1528) * lu(k,1997) + lu(k,2010) = lu(k,2010) - lu(k,1529) * lu(k,1997) + lu(k,2011) = lu(k,2011) - lu(k,1530) * lu(k,1997) + lu(k,2014) = lu(k,2014) - lu(k,1531) * lu(k,1997) + lu(k,2015) = lu(k,2015) - lu(k,1532) * lu(k,1997) + lu(k,2017) = lu(k,2017) - lu(k,1533) * lu(k,1997) + lu(k,2059) = - lu(k,1521) * lu(k,2058) + lu(k,2060) = lu(k,2060) - lu(k,1522) * lu(k,2058) + lu(k,2061) = - lu(k,1523) * lu(k,2058) + lu(k,2062) = - lu(k,1524) * lu(k,2058) + lu(k,2063) = lu(k,2063) - lu(k,1525) * lu(k,2058) + lu(k,2064) = lu(k,2064) - lu(k,1526) * lu(k,2058) + lu(k,2066) = lu(k,2066) - lu(k,1527) * lu(k,2058) + lu(k,2069) = lu(k,2069) - lu(k,1528) * lu(k,2058) + lu(k,2070) = - lu(k,1529) * lu(k,2058) + lu(k,2071) = lu(k,2071) - lu(k,1530) * lu(k,2058) + lu(k,2074) = lu(k,2074) - lu(k,1531) * lu(k,2058) + lu(k,2075) = lu(k,2075) - lu(k,1532) * lu(k,2058) + lu(k,2077) = lu(k,2077) - lu(k,1533) * lu(k,2058) + lu(k,2410) = lu(k,2410) - lu(k,1521) * lu(k,2409) + lu(k,2411) = lu(k,2411) - lu(k,1522) * lu(k,2409) + lu(k,2412) = lu(k,2412) - lu(k,1523) * lu(k,2409) + lu(k,2413) = lu(k,2413) - lu(k,1524) * lu(k,2409) + lu(k,2414) = lu(k,2414) - lu(k,1525) * lu(k,2409) + lu(k,2415) = lu(k,2415) - lu(k,1526) * lu(k,2409) + lu(k,2417) = lu(k,2417) - lu(k,1527) * lu(k,2409) + lu(k,2420) = lu(k,2420) - lu(k,1528) * lu(k,2409) + lu(k,2421) = lu(k,2421) - lu(k,1529) * lu(k,2409) + lu(k,2422) = lu(k,2422) - lu(k,1530) * lu(k,2409) + lu(k,2425) = lu(k,2425) - lu(k,1531) * lu(k,2409) + lu(k,2426) = lu(k,2426) - lu(k,1532) * lu(k,2409) + lu(k,2428) = lu(k,2428) - lu(k,1533) * lu(k,2409) + lu(k,2453) = lu(k,2453) - lu(k,1521) * lu(k,2451) + lu(k,2454) = lu(k,2454) - lu(k,1522) * lu(k,2451) + lu(k,2455) = lu(k,2455) - lu(k,1523) * lu(k,2451) + lu(k,2456) = lu(k,2456) - lu(k,1524) * lu(k,2451) + lu(k,2457) = lu(k,2457) - lu(k,1525) * lu(k,2451) + lu(k,2458) = lu(k,2458) - lu(k,1526) * lu(k,2451) + lu(k,2460) = lu(k,2460) - lu(k,1527) * lu(k,2451) + lu(k,2463) = lu(k,2463) - lu(k,1528) * lu(k,2451) + lu(k,2464) = lu(k,2464) - lu(k,1529) * lu(k,2451) + lu(k,2465) = lu(k,2465) - lu(k,1530) * lu(k,2451) + lu(k,2468) = lu(k,2468) - lu(k,1531) * lu(k,2451) + lu(k,2469) = lu(k,2469) - lu(k,1532) * lu(k,2451) + lu(k,2471) = lu(k,2471) - lu(k,1533) * lu(k,2451) + lu(k,2506) = - lu(k,1521) * lu(k,2504) + lu(k,2507) = - lu(k,1522) * lu(k,2504) + lu(k,2508) = - lu(k,1523) * lu(k,2504) + lu(k,2509) = - lu(k,1524) * lu(k,2504) + lu(k,2510) = - lu(k,1525) * lu(k,2504) + lu(k,2511) = - lu(k,1526) * lu(k,2504) + lu(k,2513) = lu(k,2513) - lu(k,1527) * lu(k,2504) + lu(k,2516) = lu(k,2516) - lu(k,1528) * lu(k,2504) + lu(k,2517) = lu(k,2517) - lu(k,1529) * lu(k,2504) + lu(k,2518) = lu(k,2518) - lu(k,1530) * lu(k,2504) + lu(k,2521) = - lu(k,1531) * lu(k,2504) + lu(k,2522) = lu(k,2522) - lu(k,1532) * lu(k,2504) + lu(k,2524) = lu(k,2524) - lu(k,1533) * lu(k,2504) + end do + end subroutine lu_fac29 + subroutine lu_fac30( 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,1539) = 1._r8 / lu(k,1539) + lu(k,1540) = lu(k,1540) * lu(k,1539) + lu(k,1541) = lu(k,1541) * lu(k,1539) + lu(k,1542) = lu(k,1542) * lu(k,1539) + lu(k,1543) = lu(k,1543) * lu(k,1539) + lu(k,1544) = lu(k,1544) * lu(k,1539) + lu(k,1545) = lu(k,1545) * lu(k,1539) + lu(k,1546) = lu(k,1546) * lu(k,1539) + lu(k,1547) = lu(k,1547) * lu(k,1539) + lu(k,1548) = lu(k,1548) * lu(k,1539) + lu(k,1549) = lu(k,1549) * lu(k,1539) + lu(k,1550) = lu(k,1550) * lu(k,1539) + lu(k,1551) = lu(k,1551) * lu(k,1539) + lu(k,1607) = lu(k,1607) - lu(k,1540) * lu(k,1606) + lu(k,1609) = lu(k,1609) - lu(k,1541) * lu(k,1606) + lu(k,1610) = lu(k,1610) - lu(k,1542) * lu(k,1606) + lu(k,1611) = lu(k,1611) - lu(k,1543) * lu(k,1606) + lu(k,1613) = - lu(k,1544) * lu(k,1606) + lu(k,1614) = lu(k,1614) - lu(k,1545) * lu(k,1606) + lu(k,1615) = lu(k,1615) - lu(k,1546) * lu(k,1606) + lu(k,1617) = lu(k,1617) - lu(k,1547) * lu(k,1606) + lu(k,1618) = lu(k,1618) - lu(k,1548) * lu(k,1606) + lu(k,1619) = lu(k,1619) - lu(k,1549) * lu(k,1606) + lu(k,1621) = lu(k,1621) - lu(k,1550) * lu(k,1606) + lu(k,1623) = lu(k,1623) - lu(k,1551) * lu(k,1606) + lu(k,1633) = lu(k,1633) - lu(k,1540) * lu(k,1632) + lu(k,1635) = lu(k,1635) - lu(k,1541) * lu(k,1632) + lu(k,1636) = lu(k,1636) - lu(k,1542) * lu(k,1632) + lu(k,1637) = lu(k,1637) - lu(k,1543) * lu(k,1632) + lu(k,1639) = - lu(k,1544) * lu(k,1632) + lu(k,1640) = lu(k,1640) - lu(k,1545) * lu(k,1632) + lu(k,1641) = lu(k,1641) - lu(k,1546) * lu(k,1632) + lu(k,1643) = lu(k,1643) - lu(k,1547) * lu(k,1632) + lu(k,1644) = lu(k,1644) - lu(k,1548) * lu(k,1632) + lu(k,1645) = lu(k,1645) - lu(k,1549) * lu(k,1632) + lu(k,1648) = lu(k,1648) - lu(k,1550) * lu(k,1632) + lu(k,1650) = lu(k,1650) - lu(k,1551) * lu(k,1632) + lu(k,1677) = lu(k,1677) - lu(k,1540) * lu(k,1676) + lu(k,1679) = lu(k,1679) - lu(k,1541) * lu(k,1676) + lu(k,1680) = lu(k,1680) - lu(k,1542) * lu(k,1676) + lu(k,1681) = lu(k,1681) - lu(k,1543) * lu(k,1676) + lu(k,1683) = lu(k,1683) - lu(k,1544) * lu(k,1676) + lu(k,1684) = lu(k,1684) - lu(k,1545) * lu(k,1676) + lu(k,1685) = lu(k,1685) - lu(k,1546) * lu(k,1676) + lu(k,1688) = lu(k,1688) - lu(k,1547) * lu(k,1676) + lu(k,1689) = lu(k,1689) - lu(k,1548) * lu(k,1676) + lu(k,1690) = lu(k,1690) - lu(k,1549) * lu(k,1676) + lu(k,1693) = lu(k,1693) - lu(k,1550) * lu(k,1676) + lu(k,1695) = lu(k,1695) - lu(k,1551) * lu(k,1676) + lu(k,1826) = lu(k,1826) - lu(k,1540) * lu(k,1825) + lu(k,1828) = lu(k,1828) - lu(k,1541) * lu(k,1825) + lu(k,1829) = lu(k,1829) - lu(k,1542) * lu(k,1825) + lu(k,1830) = - lu(k,1543) * lu(k,1825) + lu(k,1832) = lu(k,1832) - lu(k,1544) * lu(k,1825) + lu(k,1833) = lu(k,1833) - lu(k,1545) * lu(k,1825) + lu(k,1834) = lu(k,1834) - lu(k,1546) * lu(k,1825) + lu(k,1837) = lu(k,1837) - lu(k,1547) * lu(k,1825) + lu(k,1838) = lu(k,1838) - lu(k,1548) * lu(k,1825) + lu(k,1839) = lu(k,1839) - lu(k,1549) * lu(k,1825) + lu(k,1842) = lu(k,1842) - lu(k,1550) * lu(k,1825) + lu(k,1844) = lu(k,1844) - lu(k,1551) * lu(k,1825) + lu(k,1999) = lu(k,1999) - lu(k,1540) * lu(k,1998) + lu(k,2001) = lu(k,2001) - lu(k,1541) * lu(k,1998) + lu(k,2002) = lu(k,2002) - lu(k,1542) * lu(k,1998) + lu(k,2003) = lu(k,2003) - lu(k,1543) * lu(k,1998) + lu(k,2005) = lu(k,2005) - lu(k,1544) * lu(k,1998) + lu(k,2006) = lu(k,2006) - lu(k,1545) * lu(k,1998) + lu(k,2007) = lu(k,2007) - lu(k,1546) * lu(k,1998) + lu(k,2010) = lu(k,2010) - lu(k,1547) * lu(k,1998) + lu(k,2011) = lu(k,2011) - lu(k,1548) * lu(k,1998) + lu(k,2012) = lu(k,2012) - lu(k,1549) * lu(k,1998) + lu(k,2015) = lu(k,2015) - lu(k,1550) * lu(k,1998) + lu(k,2017) = lu(k,2017) - lu(k,1551) * lu(k,1998) + lu(k,2084) = - lu(k,1540) * lu(k,2083) + lu(k,2086) = - lu(k,1541) * lu(k,2083) + lu(k,2087) = - lu(k,1542) * lu(k,2083) + lu(k,2088) = lu(k,2088) - lu(k,1543) * lu(k,2083) + lu(k,2090) = lu(k,2090) - lu(k,1544) * lu(k,2083) + lu(k,2091) = lu(k,2091) - lu(k,1545) * lu(k,2083) + lu(k,2092) = lu(k,2092) - lu(k,1546) * lu(k,2083) + lu(k,2095) = lu(k,2095) - lu(k,1547) * lu(k,2083) + lu(k,2096) = lu(k,2096) - lu(k,1548) * lu(k,2083) + lu(k,2097) = lu(k,2097) - lu(k,1549) * lu(k,2083) + lu(k,2100) = lu(k,2100) - lu(k,1550) * lu(k,2083) + lu(k,2102) = lu(k,2102) - lu(k,1551) * lu(k,2083) + lu(k,2204) = lu(k,2204) - lu(k,1540) * lu(k,2203) + lu(k,2206) = lu(k,2206) - lu(k,1541) * lu(k,2203) + lu(k,2207) = lu(k,2207) - lu(k,1542) * lu(k,2203) + lu(k,2208) = lu(k,2208) - lu(k,1543) * lu(k,2203) + lu(k,2210) = lu(k,2210) - lu(k,1544) * lu(k,2203) + lu(k,2211) = lu(k,2211) - lu(k,1545) * lu(k,2203) + lu(k,2212) = lu(k,2212) - lu(k,1546) * lu(k,2203) + lu(k,2215) = lu(k,2215) - lu(k,1547) * lu(k,2203) + lu(k,2216) = lu(k,2216) - lu(k,1548) * lu(k,2203) + lu(k,2217) = lu(k,2217) - lu(k,1549) * lu(k,2203) + lu(k,2220) = lu(k,2220) - lu(k,1550) * lu(k,2203) + lu(k,2222) = lu(k,2222) - lu(k,1551) * lu(k,2203) + lu(k,2250) = lu(k,2250) - lu(k,1540) * lu(k,2249) + lu(k,2252) = - lu(k,1541) * lu(k,2249) + lu(k,2253) = lu(k,2253) - lu(k,1542) * lu(k,2249) + lu(k,2254) = lu(k,2254) - lu(k,1543) * lu(k,2249) + lu(k,2256) = lu(k,2256) - lu(k,1544) * lu(k,2249) + lu(k,2257) = lu(k,2257) - lu(k,1545) * lu(k,2249) + lu(k,2258) = lu(k,2258) - lu(k,1546) * lu(k,2249) + lu(k,2261) = lu(k,2261) - lu(k,1547) * lu(k,2249) + lu(k,2262) = lu(k,2262) - lu(k,1548) * lu(k,2249) + lu(k,2263) = lu(k,2263) - lu(k,1549) * lu(k,2249) + lu(k,2266) = lu(k,2266) - lu(k,1550) * lu(k,2249) + lu(k,2268) = lu(k,2268) - lu(k,1551) * lu(k,2249) + lu(k,2271) = - lu(k,1540) * lu(k,2270) + lu(k,2273) = - lu(k,1541) * lu(k,2270) + lu(k,2274) = - lu(k,1542) * lu(k,2270) + lu(k,2275) = - lu(k,1543) * lu(k,2270) + lu(k,2277) = lu(k,2277) - lu(k,1544) * lu(k,2270) + lu(k,2278) = lu(k,2278) - lu(k,1545) * lu(k,2270) + lu(k,2279) = lu(k,2279) - lu(k,1546) * lu(k,2270) + lu(k,2282) = lu(k,2282) - lu(k,1547) * lu(k,2270) + lu(k,2283) = lu(k,2283) - lu(k,1548) * lu(k,2270) + lu(k,2284) = lu(k,2284) - lu(k,1549) * lu(k,2270) + lu(k,2287) = lu(k,2287) - lu(k,1550) * lu(k,2270) + lu(k,2289) = lu(k,2289) - lu(k,1551) * lu(k,2270) + lu(k,2294) = - lu(k,1540) * lu(k,2293) + lu(k,2296) = - lu(k,1541) * lu(k,2293) + lu(k,2297) = - lu(k,1542) * lu(k,2293) + lu(k,2298) = lu(k,2298) - lu(k,1543) * lu(k,2293) + lu(k,2300) = lu(k,2300) - lu(k,1544) * lu(k,2293) + lu(k,2301) = lu(k,2301) - lu(k,1545) * lu(k,2293) + lu(k,2302) = lu(k,2302) - lu(k,1546) * lu(k,2293) + lu(k,2305) = lu(k,2305) - lu(k,1547) * lu(k,2293) + lu(k,2306) = lu(k,2306) - lu(k,1548) * lu(k,2293) + lu(k,2307) = lu(k,2307) - lu(k,1549) * lu(k,2293) + lu(k,2310) = lu(k,2310) - lu(k,1550) * lu(k,2293) + lu(k,2312) = lu(k,2312) - lu(k,1551) * lu(k,2293) + lu(k,2453) = lu(k,2453) - lu(k,1540) * lu(k,2452) + lu(k,2455) = lu(k,2455) - lu(k,1541) * lu(k,2452) + lu(k,2456) = lu(k,2456) - lu(k,1542) * lu(k,2452) + lu(k,2457) = lu(k,2457) - lu(k,1543) * lu(k,2452) + lu(k,2459) = lu(k,2459) - lu(k,1544) * lu(k,2452) + lu(k,2460) = lu(k,2460) - lu(k,1545) * lu(k,2452) + lu(k,2461) = lu(k,2461) - lu(k,1546) * lu(k,2452) + lu(k,2464) = lu(k,2464) - lu(k,1547) * lu(k,2452) + lu(k,2465) = lu(k,2465) - lu(k,1548) * lu(k,2452) + lu(k,2466) = lu(k,2466) - lu(k,1549) * lu(k,2452) + lu(k,2469) = lu(k,2469) - lu(k,1550) * lu(k,2452) + lu(k,2471) = lu(k,2471) - lu(k,1551) * lu(k,2452) + lu(k,2479) = lu(k,2479) - lu(k,1540) * lu(k,2478) + lu(k,2481) = lu(k,2481) - lu(k,1541) * lu(k,2478) + lu(k,2482) = - lu(k,1542) * lu(k,2478) + lu(k,2483) = lu(k,2483) - lu(k,1543) * lu(k,2478) + lu(k,2485) = lu(k,2485) - lu(k,1544) * lu(k,2478) + lu(k,2486) = lu(k,2486) - lu(k,1545) * lu(k,2478) + lu(k,2487) = lu(k,2487) - lu(k,1546) * lu(k,2478) + lu(k,2490) = lu(k,2490) - lu(k,1547) * lu(k,2478) + lu(k,2491) = lu(k,2491) - lu(k,1548) * lu(k,2478) + lu(k,2492) = lu(k,2492) - lu(k,1549) * lu(k,2478) + lu(k,2495) = lu(k,2495) - lu(k,1550) * lu(k,2478) + lu(k,2497) = lu(k,2497) - lu(k,1551) * lu(k,2478) + lu(k,2506) = lu(k,2506) - lu(k,1540) * lu(k,2505) + lu(k,2508) = lu(k,2508) - lu(k,1541) * lu(k,2505) + lu(k,2509) = lu(k,2509) - lu(k,1542) * lu(k,2505) + lu(k,2510) = lu(k,2510) - lu(k,1543) * lu(k,2505) + lu(k,2512) = lu(k,2512) - lu(k,1544) * lu(k,2505) + lu(k,2513) = lu(k,2513) - lu(k,1545) * lu(k,2505) + lu(k,2514) = lu(k,2514) - lu(k,1546) * lu(k,2505) + lu(k,2517) = lu(k,2517) - lu(k,1547) * lu(k,2505) + lu(k,2518) = lu(k,2518) - lu(k,1548) * lu(k,2505) + lu(k,2519) = lu(k,2519) - lu(k,1549) * lu(k,2505) + lu(k,2522) = lu(k,2522) - lu(k,1550) * lu(k,2505) + lu(k,2524) = lu(k,2524) - lu(k,1551) * lu(k,2505) + lu(k,1555) = 1._r8 / lu(k,1555) + lu(k,1556) = lu(k,1556) * lu(k,1555) + lu(k,1557) = lu(k,1557) * lu(k,1555) + lu(k,1558) = lu(k,1558) * lu(k,1555) + lu(k,1559) = lu(k,1559) * lu(k,1555) + lu(k,1560) = lu(k,1560) * lu(k,1555) + lu(k,1561) = lu(k,1561) * lu(k,1555) + lu(k,1562) = lu(k,1562) * lu(k,1555) + lu(k,1563) = lu(k,1563) * lu(k,1555) + lu(k,1564) = lu(k,1564) * lu(k,1555) + lu(k,1565) = lu(k,1565) * lu(k,1555) + lu(k,1566) = lu(k,1566) * lu(k,1555) + lu(k,1567) = lu(k,1567) * lu(k,1555) + lu(k,1586) = lu(k,1586) - lu(k,1556) * lu(k,1585) + lu(k,1587) = lu(k,1587) - lu(k,1557) * lu(k,1585) + lu(k,1589) = lu(k,1589) - lu(k,1558) * lu(k,1585) + lu(k,1590) = lu(k,1590) - lu(k,1559) * lu(k,1585) + lu(k,1591) = lu(k,1591) - lu(k,1560) * lu(k,1585) + lu(k,1592) = lu(k,1592) - lu(k,1561) * lu(k,1585) + lu(k,1593) = lu(k,1593) - lu(k,1562) * lu(k,1585) + lu(k,1595) = lu(k,1595) - lu(k,1563) * lu(k,1585) + lu(k,1596) = lu(k,1596) - lu(k,1564) * lu(k,1585) + lu(k,1597) = lu(k,1597) - lu(k,1565) * lu(k,1585) + lu(k,1598) = lu(k,1598) - lu(k,1566) * lu(k,1585) + lu(k,1599) = lu(k,1599) - lu(k,1567) * lu(k,1585) + lu(k,1608) = lu(k,1608) - lu(k,1556) * lu(k,1607) + lu(k,1609) = lu(k,1609) - lu(k,1557) * lu(k,1607) + lu(k,1611) = lu(k,1611) - lu(k,1558) * lu(k,1607) + lu(k,1612) = lu(k,1612) - lu(k,1559) * lu(k,1607) + lu(k,1613) = lu(k,1613) - lu(k,1560) * lu(k,1607) + lu(k,1614) = lu(k,1614) - lu(k,1561) * lu(k,1607) + lu(k,1616) = lu(k,1616) - lu(k,1562) * lu(k,1607) + lu(k,1618) = lu(k,1618) - lu(k,1563) * lu(k,1607) + lu(k,1620) = lu(k,1620) - lu(k,1564) * lu(k,1607) + lu(k,1621) = lu(k,1621) - lu(k,1565) * lu(k,1607) + lu(k,1622) = - lu(k,1566) * lu(k,1607) + lu(k,1623) = lu(k,1623) - lu(k,1567) * lu(k,1607) + lu(k,1634) = lu(k,1634) - lu(k,1556) * lu(k,1633) + lu(k,1635) = lu(k,1635) - lu(k,1557) * lu(k,1633) + lu(k,1637) = lu(k,1637) - lu(k,1558) * lu(k,1633) + lu(k,1638) = lu(k,1638) - lu(k,1559) * lu(k,1633) + lu(k,1639) = lu(k,1639) - lu(k,1560) * lu(k,1633) + lu(k,1640) = lu(k,1640) - lu(k,1561) * lu(k,1633) + lu(k,1642) = lu(k,1642) - lu(k,1562) * lu(k,1633) + lu(k,1644) = lu(k,1644) - lu(k,1563) * lu(k,1633) + lu(k,1647) = lu(k,1647) - lu(k,1564) * lu(k,1633) + lu(k,1648) = lu(k,1648) - lu(k,1565) * lu(k,1633) + lu(k,1649) = lu(k,1649) - lu(k,1566) * lu(k,1633) + lu(k,1650) = lu(k,1650) - lu(k,1567) * lu(k,1633) + lu(k,1678) = lu(k,1678) - lu(k,1556) * lu(k,1677) + lu(k,1679) = lu(k,1679) - lu(k,1557) * lu(k,1677) + lu(k,1681) = lu(k,1681) - lu(k,1558) * lu(k,1677) + lu(k,1682) = lu(k,1682) - lu(k,1559) * lu(k,1677) + lu(k,1683) = lu(k,1683) - lu(k,1560) * lu(k,1677) + lu(k,1684) = lu(k,1684) - lu(k,1561) * lu(k,1677) + lu(k,1687) = lu(k,1687) - lu(k,1562) * lu(k,1677) + lu(k,1689) = lu(k,1689) - lu(k,1563) * lu(k,1677) + lu(k,1692) = lu(k,1692) - lu(k,1564) * lu(k,1677) + lu(k,1693) = lu(k,1693) - lu(k,1565) * lu(k,1677) + lu(k,1694) = lu(k,1694) - lu(k,1566) * lu(k,1677) + lu(k,1695) = lu(k,1695) - lu(k,1567) * lu(k,1677) + lu(k,1784) = lu(k,1784) - lu(k,1556) * lu(k,1783) + lu(k,1785) = lu(k,1785) - lu(k,1557) * lu(k,1783) + lu(k,1787) = lu(k,1787) - lu(k,1558) * lu(k,1783) + lu(k,1788) = lu(k,1788) - lu(k,1559) * lu(k,1783) + lu(k,1789) = lu(k,1789) - lu(k,1560) * lu(k,1783) + lu(k,1790) = lu(k,1790) - lu(k,1561) * lu(k,1783) + lu(k,1793) = lu(k,1793) - lu(k,1562) * lu(k,1783) + lu(k,1795) = lu(k,1795) - lu(k,1563) * lu(k,1783) + lu(k,1798) = lu(k,1798) - lu(k,1564) * lu(k,1783) + lu(k,1799) = lu(k,1799) - lu(k,1565) * lu(k,1783) + lu(k,1800) = lu(k,1800) - lu(k,1566) * lu(k,1783) + lu(k,1801) = lu(k,1801) - lu(k,1567) * lu(k,1783) + lu(k,1827) = lu(k,1827) - lu(k,1556) * lu(k,1826) + lu(k,1828) = lu(k,1828) - lu(k,1557) * lu(k,1826) + lu(k,1830) = lu(k,1830) - lu(k,1558) * lu(k,1826) + lu(k,1831) = lu(k,1831) - lu(k,1559) * lu(k,1826) + lu(k,1832) = lu(k,1832) - lu(k,1560) * lu(k,1826) + lu(k,1833) = lu(k,1833) - lu(k,1561) * lu(k,1826) + lu(k,1836) = lu(k,1836) - lu(k,1562) * lu(k,1826) + lu(k,1838) = lu(k,1838) - lu(k,1563) * lu(k,1826) + lu(k,1841) = lu(k,1841) - lu(k,1564) * lu(k,1826) + lu(k,1842) = lu(k,1842) - lu(k,1565) * lu(k,1826) + lu(k,1843) = lu(k,1843) - lu(k,1566) * lu(k,1826) + lu(k,1844) = lu(k,1844) - lu(k,1567) * lu(k,1826) + lu(k,2000) = lu(k,2000) - lu(k,1556) * lu(k,1999) + lu(k,2001) = lu(k,2001) - lu(k,1557) * lu(k,1999) + lu(k,2003) = lu(k,2003) - lu(k,1558) * lu(k,1999) + lu(k,2004) = lu(k,2004) - lu(k,1559) * lu(k,1999) + lu(k,2005) = lu(k,2005) - lu(k,1560) * lu(k,1999) + lu(k,2006) = lu(k,2006) - lu(k,1561) * lu(k,1999) + lu(k,2009) = lu(k,2009) - lu(k,1562) * lu(k,1999) + lu(k,2011) = lu(k,2011) - lu(k,1563) * lu(k,1999) + lu(k,2014) = lu(k,2014) - lu(k,1564) * lu(k,1999) + lu(k,2015) = lu(k,2015) - lu(k,1565) * lu(k,1999) + lu(k,2016) = lu(k,2016) - lu(k,1566) * lu(k,1999) + lu(k,2017) = lu(k,2017) - lu(k,1567) * lu(k,1999) + lu(k,2060) = lu(k,2060) - lu(k,1556) * lu(k,2059) + lu(k,2061) = lu(k,2061) - lu(k,1557) * lu(k,2059) + lu(k,2063) = lu(k,2063) - lu(k,1558) * lu(k,2059) + lu(k,2064) = lu(k,2064) - lu(k,1559) * lu(k,2059) + lu(k,2065) = lu(k,2065) - lu(k,1560) * lu(k,2059) + lu(k,2066) = lu(k,2066) - lu(k,1561) * lu(k,2059) + lu(k,2069) = lu(k,2069) - lu(k,1562) * lu(k,2059) + lu(k,2071) = lu(k,2071) - lu(k,1563) * lu(k,2059) + lu(k,2074) = lu(k,2074) - lu(k,1564) * lu(k,2059) + lu(k,2075) = lu(k,2075) - lu(k,1565) * lu(k,2059) + lu(k,2076) = lu(k,2076) - lu(k,1566) * lu(k,2059) + lu(k,2077) = lu(k,2077) - lu(k,1567) * lu(k,2059) + lu(k,2085) = lu(k,2085) - lu(k,1556) * lu(k,2084) + lu(k,2086) = lu(k,2086) - lu(k,1557) * lu(k,2084) + lu(k,2088) = lu(k,2088) - lu(k,1558) * lu(k,2084) + lu(k,2089) = lu(k,2089) - lu(k,1559) * lu(k,2084) + lu(k,2090) = lu(k,2090) - lu(k,1560) * lu(k,2084) + lu(k,2091) = lu(k,2091) - lu(k,1561) * lu(k,2084) + lu(k,2094) = lu(k,2094) - lu(k,1562) * lu(k,2084) + lu(k,2096) = lu(k,2096) - lu(k,1563) * lu(k,2084) + lu(k,2099) = - lu(k,1564) * lu(k,2084) + lu(k,2100) = lu(k,2100) - lu(k,1565) * lu(k,2084) + lu(k,2101) = lu(k,2101) - lu(k,1566) * lu(k,2084) + lu(k,2102) = lu(k,2102) - lu(k,1567) * lu(k,2084) + lu(k,2205) = lu(k,2205) - lu(k,1556) * lu(k,2204) + lu(k,2206) = lu(k,2206) - lu(k,1557) * lu(k,2204) + lu(k,2208) = lu(k,2208) - lu(k,1558) * lu(k,2204) + lu(k,2209) = lu(k,2209) - lu(k,1559) * lu(k,2204) + lu(k,2210) = lu(k,2210) - lu(k,1560) * lu(k,2204) + lu(k,2211) = lu(k,2211) - lu(k,1561) * lu(k,2204) + lu(k,2214) = lu(k,2214) - lu(k,1562) * lu(k,2204) + lu(k,2216) = lu(k,2216) - lu(k,1563) * lu(k,2204) + lu(k,2219) = lu(k,2219) - lu(k,1564) * lu(k,2204) + lu(k,2220) = lu(k,2220) - lu(k,1565) * lu(k,2204) + lu(k,2221) = lu(k,2221) - lu(k,1566) * lu(k,2204) + lu(k,2222) = lu(k,2222) - lu(k,1567) * lu(k,2204) + lu(k,2251) = lu(k,2251) - lu(k,1556) * lu(k,2250) + lu(k,2252) = lu(k,2252) - lu(k,1557) * lu(k,2250) + lu(k,2254) = lu(k,2254) - lu(k,1558) * lu(k,2250) + lu(k,2255) = lu(k,2255) - lu(k,1559) * lu(k,2250) + lu(k,2256) = lu(k,2256) - lu(k,1560) * lu(k,2250) + lu(k,2257) = lu(k,2257) - lu(k,1561) * lu(k,2250) + lu(k,2260) = lu(k,2260) - lu(k,1562) * lu(k,2250) + lu(k,2262) = lu(k,2262) - lu(k,1563) * lu(k,2250) + lu(k,2265) = lu(k,2265) - lu(k,1564) * lu(k,2250) + lu(k,2266) = lu(k,2266) - lu(k,1565) * lu(k,2250) + lu(k,2267) = lu(k,2267) - lu(k,1566) * lu(k,2250) + lu(k,2268) = lu(k,2268) - lu(k,1567) * lu(k,2250) + lu(k,2272) = lu(k,2272) - lu(k,1556) * lu(k,2271) + lu(k,2273) = lu(k,2273) - lu(k,1557) * lu(k,2271) + lu(k,2275) = lu(k,2275) - lu(k,1558) * lu(k,2271) + lu(k,2276) = - lu(k,1559) * lu(k,2271) + lu(k,2277) = lu(k,2277) - lu(k,1560) * lu(k,2271) + lu(k,2278) = lu(k,2278) - lu(k,1561) * lu(k,2271) + lu(k,2281) = lu(k,2281) - lu(k,1562) * lu(k,2271) + lu(k,2283) = lu(k,2283) - lu(k,1563) * lu(k,2271) + lu(k,2286) = lu(k,2286) - lu(k,1564) * lu(k,2271) + lu(k,2287) = lu(k,2287) - lu(k,1565) * lu(k,2271) + lu(k,2288) = - lu(k,1566) * lu(k,2271) + lu(k,2289) = lu(k,2289) - lu(k,1567) * lu(k,2271) + lu(k,2295) = - lu(k,1556) * lu(k,2294) + lu(k,2296) = lu(k,2296) - lu(k,1557) * lu(k,2294) + lu(k,2298) = lu(k,2298) - lu(k,1558) * lu(k,2294) + lu(k,2299) = - lu(k,1559) * lu(k,2294) + lu(k,2300) = lu(k,2300) - lu(k,1560) * lu(k,2294) + lu(k,2301) = lu(k,2301) - lu(k,1561) * lu(k,2294) + lu(k,2304) = - lu(k,1562) * lu(k,2294) + lu(k,2306) = lu(k,2306) - lu(k,1563) * lu(k,2294) + lu(k,2309) = - lu(k,1564) * lu(k,2294) + lu(k,2310) = lu(k,2310) - lu(k,1565) * lu(k,2294) + lu(k,2311) = - lu(k,1566) * lu(k,2294) + lu(k,2312) = lu(k,2312) - lu(k,1567) * lu(k,2294) + lu(k,2411) = lu(k,2411) - lu(k,1556) * lu(k,2410) + lu(k,2412) = lu(k,2412) - lu(k,1557) * lu(k,2410) + lu(k,2414) = lu(k,2414) - lu(k,1558) * lu(k,2410) + lu(k,2415) = lu(k,2415) - lu(k,1559) * lu(k,2410) + lu(k,2416) = lu(k,2416) - lu(k,1560) * lu(k,2410) + lu(k,2417) = lu(k,2417) - lu(k,1561) * lu(k,2410) + lu(k,2420) = lu(k,2420) - lu(k,1562) * lu(k,2410) + lu(k,2422) = lu(k,2422) - lu(k,1563) * lu(k,2410) + lu(k,2425) = lu(k,2425) - lu(k,1564) * lu(k,2410) + lu(k,2426) = lu(k,2426) - lu(k,1565) * lu(k,2410) + lu(k,2427) = lu(k,2427) - lu(k,1566) * lu(k,2410) + lu(k,2428) = lu(k,2428) - lu(k,1567) * lu(k,2410) + lu(k,2454) = lu(k,2454) - lu(k,1556) * lu(k,2453) + lu(k,2455) = lu(k,2455) - lu(k,1557) * lu(k,2453) + lu(k,2457) = lu(k,2457) - lu(k,1558) * lu(k,2453) + lu(k,2458) = lu(k,2458) - lu(k,1559) * lu(k,2453) + lu(k,2459) = lu(k,2459) - lu(k,1560) * lu(k,2453) + lu(k,2460) = lu(k,2460) - lu(k,1561) * lu(k,2453) + lu(k,2463) = lu(k,2463) - lu(k,1562) * lu(k,2453) + lu(k,2465) = lu(k,2465) - lu(k,1563) * lu(k,2453) + lu(k,2468) = lu(k,2468) - lu(k,1564) * lu(k,2453) + lu(k,2469) = lu(k,2469) - lu(k,1565) * lu(k,2453) + lu(k,2470) = lu(k,2470) - lu(k,1566) * lu(k,2453) + lu(k,2471) = lu(k,2471) - lu(k,1567) * lu(k,2453) + lu(k,2480) = lu(k,2480) - lu(k,1556) * lu(k,2479) + lu(k,2481) = lu(k,2481) - lu(k,1557) * lu(k,2479) + lu(k,2483) = lu(k,2483) - lu(k,1558) * lu(k,2479) + lu(k,2484) = lu(k,2484) - lu(k,1559) * lu(k,2479) + lu(k,2485) = lu(k,2485) - lu(k,1560) * lu(k,2479) + lu(k,2486) = lu(k,2486) - lu(k,1561) * lu(k,2479) + lu(k,2489) = lu(k,2489) - lu(k,1562) * lu(k,2479) + lu(k,2491) = lu(k,2491) - lu(k,1563) * lu(k,2479) + lu(k,2494) = - lu(k,1564) * lu(k,2479) + lu(k,2495) = lu(k,2495) - lu(k,1565) * lu(k,2479) + lu(k,2496) = lu(k,2496) - lu(k,1566) * lu(k,2479) + lu(k,2497) = lu(k,2497) - lu(k,1567) * lu(k,2479) + lu(k,2507) = lu(k,2507) - lu(k,1556) * lu(k,2506) + lu(k,2508) = lu(k,2508) - lu(k,1557) * lu(k,2506) + lu(k,2510) = lu(k,2510) - lu(k,1558) * lu(k,2506) + lu(k,2511) = lu(k,2511) - lu(k,1559) * lu(k,2506) + lu(k,2512) = lu(k,2512) - lu(k,1560) * lu(k,2506) + lu(k,2513) = lu(k,2513) - lu(k,1561) * lu(k,2506) + lu(k,2516) = lu(k,2516) - lu(k,1562) * lu(k,2506) + lu(k,2518) = lu(k,2518) - lu(k,1563) * lu(k,2506) + lu(k,2521) = lu(k,2521) - lu(k,1564) * lu(k,2506) + lu(k,2522) = lu(k,2522) - lu(k,1565) * lu(k,2506) + lu(k,2523) = - lu(k,1566) * lu(k,2506) + lu(k,2524) = lu(k,2524) - lu(k,1567) * lu(k,2506) + end do + end subroutine lu_fac30 + subroutine lu_fac31( 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,1586) = 1._r8 / lu(k,1586) + lu(k,1587) = lu(k,1587) * lu(k,1586) + lu(k,1588) = lu(k,1588) * lu(k,1586) + lu(k,1589) = lu(k,1589) * lu(k,1586) + lu(k,1590) = lu(k,1590) * lu(k,1586) + lu(k,1591) = lu(k,1591) * lu(k,1586) + lu(k,1592) = lu(k,1592) * lu(k,1586) + lu(k,1593) = lu(k,1593) * lu(k,1586) + lu(k,1594) = lu(k,1594) * lu(k,1586) + lu(k,1595) = lu(k,1595) * lu(k,1586) + lu(k,1596) = lu(k,1596) * lu(k,1586) + lu(k,1597) = lu(k,1597) * lu(k,1586) + lu(k,1598) = lu(k,1598) * lu(k,1586) + lu(k,1599) = lu(k,1599) * lu(k,1586) + lu(k,1609) = lu(k,1609) - lu(k,1587) * lu(k,1608) + lu(k,1610) = lu(k,1610) - lu(k,1588) * lu(k,1608) + lu(k,1611) = lu(k,1611) - lu(k,1589) * lu(k,1608) + lu(k,1612) = lu(k,1612) - lu(k,1590) * lu(k,1608) + lu(k,1613) = lu(k,1613) - lu(k,1591) * lu(k,1608) + lu(k,1614) = lu(k,1614) - lu(k,1592) * lu(k,1608) + lu(k,1616) = lu(k,1616) - lu(k,1593) * lu(k,1608) + lu(k,1617) = lu(k,1617) - lu(k,1594) * lu(k,1608) + lu(k,1618) = lu(k,1618) - lu(k,1595) * lu(k,1608) + lu(k,1620) = lu(k,1620) - lu(k,1596) * lu(k,1608) + lu(k,1621) = lu(k,1621) - lu(k,1597) * lu(k,1608) + lu(k,1622) = lu(k,1622) - lu(k,1598) * lu(k,1608) + lu(k,1623) = lu(k,1623) - lu(k,1599) * lu(k,1608) + lu(k,1635) = lu(k,1635) - lu(k,1587) * lu(k,1634) + lu(k,1636) = lu(k,1636) - lu(k,1588) * lu(k,1634) + lu(k,1637) = lu(k,1637) - lu(k,1589) * lu(k,1634) + lu(k,1638) = lu(k,1638) - lu(k,1590) * lu(k,1634) + lu(k,1639) = lu(k,1639) - lu(k,1591) * lu(k,1634) + lu(k,1640) = lu(k,1640) - lu(k,1592) * lu(k,1634) + lu(k,1642) = lu(k,1642) - lu(k,1593) * lu(k,1634) + lu(k,1643) = lu(k,1643) - lu(k,1594) * lu(k,1634) + lu(k,1644) = lu(k,1644) - lu(k,1595) * lu(k,1634) + lu(k,1647) = lu(k,1647) - lu(k,1596) * lu(k,1634) + lu(k,1648) = lu(k,1648) - lu(k,1597) * lu(k,1634) + lu(k,1649) = lu(k,1649) - lu(k,1598) * lu(k,1634) + lu(k,1650) = lu(k,1650) - lu(k,1599) * lu(k,1634) + lu(k,1679) = lu(k,1679) - lu(k,1587) * lu(k,1678) + lu(k,1680) = lu(k,1680) - lu(k,1588) * lu(k,1678) + lu(k,1681) = lu(k,1681) - lu(k,1589) * lu(k,1678) + lu(k,1682) = lu(k,1682) - lu(k,1590) * lu(k,1678) + lu(k,1683) = lu(k,1683) - lu(k,1591) * lu(k,1678) + lu(k,1684) = lu(k,1684) - lu(k,1592) * lu(k,1678) + lu(k,1687) = lu(k,1687) - lu(k,1593) * lu(k,1678) + lu(k,1688) = lu(k,1688) - lu(k,1594) * lu(k,1678) + lu(k,1689) = lu(k,1689) - lu(k,1595) * lu(k,1678) + lu(k,1692) = lu(k,1692) - lu(k,1596) * lu(k,1678) + lu(k,1693) = lu(k,1693) - lu(k,1597) * lu(k,1678) + lu(k,1694) = lu(k,1694) - lu(k,1598) * lu(k,1678) + lu(k,1695) = lu(k,1695) - lu(k,1599) * lu(k,1678) + lu(k,1785) = lu(k,1785) - lu(k,1587) * lu(k,1784) + lu(k,1786) = lu(k,1786) - lu(k,1588) * lu(k,1784) + lu(k,1787) = lu(k,1787) - lu(k,1589) * lu(k,1784) + lu(k,1788) = lu(k,1788) - lu(k,1590) * lu(k,1784) + lu(k,1789) = lu(k,1789) - lu(k,1591) * lu(k,1784) + lu(k,1790) = lu(k,1790) - lu(k,1592) * lu(k,1784) + lu(k,1793) = lu(k,1793) - lu(k,1593) * lu(k,1784) + lu(k,1794) = lu(k,1794) - lu(k,1594) * lu(k,1784) + lu(k,1795) = lu(k,1795) - lu(k,1595) * lu(k,1784) + lu(k,1798) = lu(k,1798) - lu(k,1596) * lu(k,1784) + lu(k,1799) = lu(k,1799) - lu(k,1597) * lu(k,1784) + lu(k,1800) = lu(k,1800) - lu(k,1598) * lu(k,1784) + lu(k,1801) = lu(k,1801) - lu(k,1599) * lu(k,1784) + lu(k,1828) = lu(k,1828) - lu(k,1587) * lu(k,1827) + lu(k,1829) = lu(k,1829) - lu(k,1588) * lu(k,1827) + lu(k,1830) = lu(k,1830) - lu(k,1589) * lu(k,1827) + lu(k,1831) = lu(k,1831) - lu(k,1590) * lu(k,1827) + lu(k,1832) = lu(k,1832) - lu(k,1591) * lu(k,1827) + lu(k,1833) = lu(k,1833) - lu(k,1592) * lu(k,1827) + lu(k,1836) = lu(k,1836) - lu(k,1593) * lu(k,1827) + lu(k,1837) = lu(k,1837) - lu(k,1594) * lu(k,1827) + lu(k,1838) = lu(k,1838) - lu(k,1595) * lu(k,1827) + lu(k,1841) = lu(k,1841) - lu(k,1596) * lu(k,1827) + lu(k,1842) = lu(k,1842) - lu(k,1597) * lu(k,1827) + lu(k,1843) = lu(k,1843) - lu(k,1598) * lu(k,1827) + lu(k,1844) = lu(k,1844) - lu(k,1599) * lu(k,1827) + lu(k,2001) = lu(k,2001) - lu(k,1587) * lu(k,2000) + lu(k,2002) = lu(k,2002) - lu(k,1588) * lu(k,2000) + lu(k,2003) = lu(k,2003) - lu(k,1589) * lu(k,2000) + lu(k,2004) = lu(k,2004) - lu(k,1590) * lu(k,2000) + lu(k,2005) = lu(k,2005) - lu(k,1591) * lu(k,2000) + lu(k,2006) = lu(k,2006) - lu(k,1592) * lu(k,2000) + lu(k,2009) = lu(k,2009) - lu(k,1593) * lu(k,2000) + lu(k,2010) = lu(k,2010) - lu(k,1594) * lu(k,2000) + lu(k,2011) = lu(k,2011) - lu(k,1595) * lu(k,2000) + lu(k,2014) = lu(k,2014) - lu(k,1596) * lu(k,2000) + lu(k,2015) = lu(k,2015) - lu(k,1597) * lu(k,2000) + lu(k,2016) = lu(k,2016) - lu(k,1598) * lu(k,2000) + lu(k,2017) = lu(k,2017) - lu(k,1599) * lu(k,2000) + lu(k,2061) = lu(k,2061) - lu(k,1587) * lu(k,2060) + lu(k,2062) = lu(k,2062) - lu(k,1588) * lu(k,2060) + lu(k,2063) = lu(k,2063) - lu(k,1589) * lu(k,2060) + lu(k,2064) = lu(k,2064) - lu(k,1590) * lu(k,2060) + lu(k,2065) = lu(k,2065) - lu(k,1591) * lu(k,2060) + lu(k,2066) = lu(k,2066) - lu(k,1592) * lu(k,2060) + lu(k,2069) = lu(k,2069) - lu(k,1593) * lu(k,2060) + lu(k,2070) = lu(k,2070) - lu(k,1594) * lu(k,2060) + lu(k,2071) = lu(k,2071) - lu(k,1595) * lu(k,2060) + lu(k,2074) = lu(k,2074) - lu(k,1596) * lu(k,2060) + lu(k,2075) = lu(k,2075) - lu(k,1597) * lu(k,2060) + lu(k,2076) = lu(k,2076) - lu(k,1598) * lu(k,2060) + lu(k,2077) = lu(k,2077) - lu(k,1599) * lu(k,2060) + lu(k,2086) = lu(k,2086) - lu(k,1587) * lu(k,2085) + lu(k,2087) = lu(k,2087) - lu(k,1588) * lu(k,2085) + lu(k,2088) = lu(k,2088) - lu(k,1589) * lu(k,2085) + lu(k,2089) = lu(k,2089) - lu(k,1590) * lu(k,2085) + lu(k,2090) = lu(k,2090) - lu(k,1591) * lu(k,2085) + lu(k,2091) = lu(k,2091) - lu(k,1592) * lu(k,2085) + lu(k,2094) = lu(k,2094) - lu(k,1593) * lu(k,2085) + lu(k,2095) = lu(k,2095) - lu(k,1594) * lu(k,2085) + lu(k,2096) = lu(k,2096) - lu(k,1595) * lu(k,2085) + lu(k,2099) = lu(k,2099) - lu(k,1596) * lu(k,2085) + lu(k,2100) = lu(k,2100) - lu(k,1597) * lu(k,2085) + lu(k,2101) = lu(k,2101) - lu(k,1598) * lu(k,2085) + lu(k,2102) = lu(k,2102) - lu(k,1599) * lu(k,2085) + lu(k,2206) = lu(k,2206) - lu(k,1587) * lu(k,2205) + lu(k,2207) = lu(k,2207) - lu(k,1588) * lu(k,2205) + lu(k,2208) = lu(k,2208) - lu(k,1589) * lu(k,2205) + lu(k,2209) = lu(k,2209) - lu(k,1590) * lu(k,2205) + lu(k,2210) = lu(k,2210) - lu(k,1591) * lu(k,2205) + lu(k,2211) = lu(k,2211) - lu(k,1592) * lu(k,2205) + lu(k,2214) = lu(k,2214) - lu(k,1593) * lu(k,2205) + lu(k,2215) = lu(k,2215) - lu(k,1594) * lu(k,2205) + lu(k,2216) = lu(k,2216) - lu(k,1595) * lu(k,2205) + lu(k,2219) = lu(k,2219) - lu(k,1596) * lu(k,2205) + lu(k,2220) = lu(k,2220) - lu(k,1597) * lu(k,2205) + lu(k,2221) = lu(k,2221) - lu(k,1598) * lu(k,2205) + lu(k,2222) = lu(k,2222) - lu(k,1599) * lu(k,2205) + lu(k,2252) = lu(k,2252) - lu(k,1587) * lu(k,2251) + lu(k,2253) = lu(k,2253) - lu(k,1588) * lu(k,2251) + lu(k,2254) = lu(k,2254) - lu(k,1589) * lu(k,2251) + lu(k,2255) = lu(k,2255) - lu(k,1590) * lu(k,2251) + lu(k,2256) = lu(k,2256) - lu(k,1591) * lu(k,2251) + lu(k,2257) = lu(k,2257) - lu(k,1592) * lu(k,2251) + lu(k,2260) = lu(k,2260) - lu(k,1593) * lu(k,2251) + lu(k,2261) = lu(k,2261) - lu(k,1594) * lu(k,2251) + lu(k,2262) = lu(k,2262) - lu(k,1595) * lu(k,2251) + lu(k,2265) = lu(k,2265) - lu(k,1596) * lu(k,2251) + lu(k,2266) = lu(k,2266) - lu(k,1597) * lu(k,2251) + lu(k,2267) = lu(k,2267) - lu(k,1598) * lu(k,2251) + lu(k,2268) = lu(k,2268) - lu(k,1599) * lu(k,2251) + lu(k,2273) = lu(k,2273) - lu(k,1587) * lu(k,2272) + lu(k,2274) = lu(k,2274) - lu(k,1588) * lu(k,2272) + lu(k,2275) = lu(k,2275) - lu(k,1589) * lu(k,2272) + lu(k,2276) = lu(k,2276) - lu(k,1590) * lu(k,2272) + lu(k,2277) = lu(k,2277) - lu(k,1591) * lu(k,2272) + lu(k,2278) = lu(k,2278) - lu(k,1592) * lu(k,2272) + lu(k,2281) = lu(k,2281) - lu(k,1593) * lu(k,2272) + lu(k,2282) = lu(k,2282) - lu(k,1594) * lu(k,2272) + lu(k,2283) = lu(k,2283) - lu(k,1595) * lu(k,2272) + lu(k,2286) = lu(k,2286) - lu(k,1596) * lu(k,2272) + lu(k,2287) = lu(k,2287) - lu(k,1597) * lu(k,2272) + lu(k,2288) = lu(k,2288) - lu(k,1598) * lu(k,2272) + lu(k,2289) = lu(k,2289) - lu(k,1599) * lu(k,2272) + lu(k,2296) = lu(k,2296) - lu(k,1587) * lu(k,2295) + lu(k,2297) = lu(k,2297) - lu(k,1588) * lu(k,2295) + lu(k,2298) = lu(k,2298) - lu(k,1589) * lu(k,2295) + lu(k,2299) = lu(k,2299) - lu(k,1590) * lu(k,2295) + lu(k,2300) = lu(k,2300) - lu(k,1591) * lu(k,2295) + lu(k,2301) = lu(k,2301) - lu(k,1592) * lu(k,2295) + lu(k,2304) = lu(k,2304) - lu(k,1593) * lu(k,2295) + lu(k,2305) = lu(k,2305) - lu(k,1594) * lu(k,2295) + lu(k,2306) = lu(k,2306) - lu(k,1595) * lu(k,2295) + lu(k,2309) = lu(k,2309) - lu(k,1596) * lu(k,2295) + lu(k,2310) = lu(k,2310) - lu(k,1597) * lu(k,2295) + lu(k,2311) = lu(k,2311) - lu(k,1598) * lu(k,2295) + lu(k,2312) = lu(k,2312) - lu(k,1599) * lu(k,2295) + lu(k,2348) = - lu(k,1587) * lu(k,2347) + lu(k,2349) = lu(k,2349) - lu(k,1588) * lu(k,2347) + lu(k,2350) = lu(k,2350) - lu(k,1589) * lu(k,2347) + lu(k,2351) = lu(k,2351) - lu(k,1590) * lu(k,2347) + lu(k,2352) = lu(k,2352) - lu(k,1591) * lu(k,2347) + lu(k,2353) = lu(k,2353) - lu(k,1592) * lu(k,2347) + lu(k,2356) = lu(k,2356) - lu(k,1593) * lu(k,2347) + lu(k,2357) = lu(k,2357) - lu(k,1594) * lu(k,2347) + lu(k,2358) = lu(k,2358) - lu(k,1595) * lu(k,2347) + lu(k,2361) = lu(k,2361) - lu(k,1596) * lu(k,2347) + lu(k,2362) = lu(k,2362) - lu(k,1597) * lu(k,2347) + lu(k,2363) = lu(k,2363) - lu(k,1598) * lu(k,2347) + lu(k,2364) = lu(k,2364) - lu(k,1599) * lu(k,2347) + lu(k,2412) = lu(k,2412) - lu(k,1587) * lu(k,2411) + lu(k,2413) = lu(k,2413) - lu(k,1588) * lu(k,2411) + lu(k,2414) = lu(k,2414) - lu(k,1589) * lu(k,2411) + lu(k,2415) = lu(k,2415) - lu(k,1590) * lu(k,2411) + lu(k,2416) = lu(k,2416) - lu(k,1591) * lu(k,2411) + lu(k,2417) = lu(k,2417) - lu(k,1592) * lu(k,2411) + lu(k,2420) = lu(k,2420) - lu(k,1593) * lu(k,2411) + lu(k,2421) = lu(k,2421) - lu(k,1594) * lu(k,2411) + lu(k,2422) = lu(k,2422) - lu(k,1595) * lu(k,2411) + lu(k,2425) = lu(k,2425) - lu(k,1596) * lu(k,2411) + lu(k,2426) = lu(k,2426) - lu(k,1597) * lu(k,2411) + lu(k,2427) = lu(k,2427) - lu(k,1598) * lu(k,2411) + lu(k,2428) = lu(k,2428) - lu(k,1599) * lu(k,2411) + lu(k,2455) = lu(k,2455) - lu(k,1587) * lu(k,2454) + lu(k,2456) = lu(k,2456) - lu(k,1588) * lu(k,2454) + lu(k,2457) = lu(k,2457) - lu(k,1589) * lu(k,2454) + lu(k,2458) = lu(k,2458) - lu(k,1590) * lu(k,2454) + lu(k,2459) = lu(k,2459) - lu(k,1591) * lu(k,2454) + lu(k,2460) = lu(k,2460) - lu(k,1592) * lu(k,2454) + lu(k,2463) = lu(k,2463) - lu(k,1593) * lu(k,2454) + lu(k,2464) = lu(k,2464) - lu(k,1594) * lu(k,2454) + lu(k,2465) = lu(k,2465) - lu(k,1595) * lu(k,2454) + lu(k,2468) = lu(k,2468) - lu(k,1596) * lu(k,2454) + lu(k,2469) = lu(k,2469) - lu(k,1597) * lu(k,2454) + lu(k,2470) = lu(k,2470) - lu(k,1598) * lu(k,2454) + lu(k,2471) = lu(k,2471) - lu(k,1599) * lu(k,2454) + lu(k,2481) = lu(k,2481) - lu(k,1587) * lu(k,2480) + lu(k,2482) = lu(k,2482) - lu(k,1588) * lu(k,2480) + lu(k,2483) = lu(k,2483) - lu(k,1589) * lu(k,2480) + lu(k,2484) = lu(k,2484) - lu(k,1590) * lu(k,2480) + lu(k,2485) = lu(k,2485) - lu(k,1591) * lu(k,2480) + lu(k,2486) = lu(k,2486) - lu(k,1592) * lu(k,2480) + lu(k,2489) = lu(k,2489) - lu(k,1593) * lu(k,2480) + lu(k,2490) = lu(k,2490) - lu(k,1594) * lu(k,2480) + lu(k,2491) = lu(k,2491) - lu(k,1595) * lu(k,2480) + lu(k,2494) = lu(k,2494) - lu(k,1596) * lu(k,2480) + lu(k,2495) = lu(k,2495) - lu(k,1597) * lu(k,2480) + lu(k,2496) = lu(k,2496) - lu(k,1598) * lu(k,2480) + lu(k,2497) = lu(k,2497) - lu(k,1599) * lu(k,2480) + lu(k,2508) = lu(k,2508) - lu(k,1587) * lu(k,2507) + lu(k,2509) = lu(k,2509) - lu(k,1588) * lu(k,2507) + lu(k,2510) = lu(k,2510) - lu(k,1589) * lu(k,2507) + lu(k,2511) = lu(k,2511) - lu(k,1590) * lu(k,2507) + lu(k,2512) = lu(k,2512) - lu(k,1591) * lu(k,2507) + lu(k,2513) = lu(k,2513) - lu(k,1592) * lu(k,2507) + lu(k,2516) = lu(k,2516) - lu(k,1593) * lu(k,2507) + lu(k,2517) = lu(k,2517) - lu(k,1594) * lu(k,2507) + lu(k,2518) = lu(k,2518) - lu(k,1595) * lu(k,2507) + lu(k,2521) = lu(k,2521) - lu(k,1596) * lu(k,2507) + lu(k,2522) = lu(k,2522) - lu(k,1597) * lu(k,2507) + lu(k,2523) = lu(k,2523) - lu(k,1598) * lu(k,2507) + lu(k,2524) = lu(k,2524) - lu(k,1599) * lu(k,2507) + lu(k,1609) = 1._r8 / lu(k,1609) + lu(k,1610) = lu(k,1610) * lu(k,1609) + lu(k,1611) = lu(k,1611) * lu(k,1609) + lu(k,1612) = lu(k,1612) * lu(k,1609) + lu(k,1613) = lu(k,1613) * lu(k,1609) + lu(k,1614) = lu(k,1614) * lu(k,1609) + lu(k,1615) = lu(k,1615) * lu(k,1609) + lu(k,1616) = lu(k,1616) * lu(k,1609) + lu(k,1617) = lu(k,1617) * lu(k,1609) + lu(k,1618) = lu(k,1618) * lu(k,1609) + lu(k,1619) = lu(k,1619) * lu(k,1609) + lu(k,1620) = lu(k,1620) * lu(k,1609) + lu(k,1621) = lu(k,1621) * lu(k,1609) + lu(k,1622) = lu(k,1622) * lu(k,1609) + lu(k,1623) = lu(k,1623) * lu(k,1609) + lu(k,1636) = lu(k,1636) - lu(k,1610) * lu(k,1635) + lu(k,1637) = lu(k,1637) - lu(k,1611) * lu(k,1635) + lu(k,1638) = lu(k,1638) - lu(k,1612) * lu(k,1635) + lu(k,1639) = lu(k,1639) - lu(k,1613) * lu(k,1635) + lu(k,1640) = lu(k,1640) - lu(k,1614) * lu(k,1635) + lu(k,1641) = lu(k,1641) - lu(k,1615) * lu(k,1635) + lu(k,1642) = lu(k,1642) - lu(k,1616) * lu(k,1635) + lu(k,1643) = lu(k,1643) - lu(k,1617) * lu(k,1635) + lu(k,1644) = lu(k,1644) - lu(k,1618) * lu(k,1635) + lu(k,1645) = lu(k,1645) - lu(k,1619) * lu(k,1635) + lu(k,1647) = lu(k,1647) - lu(k,1620) * lu(k,1635) + lu(k,1648) = lu(k,1648) - lu(k,1621) * lu(k,1635) + lu(k,1649) = lu(k,1649) - lu(k,1622) * lu(k,1635) + lu(k,1650) = lu(k,1650) - lu(k,1623) * lu(k,1635) + lu(k,1680) = lu(k,1680) - lu(k,1610) * lu(k,1679) + lu(k,1681) = lu(k,1681) - lu(k,1611) * lu(k,1679) + lu(k,1682) = lu(k,1682) - lu(k,1612) * lu(k,1679) + lu(k,1683) = lu(k,1683) - lu(k,1613) * lu(k,1679) + lu(k,1684) = lu(k,1684) - lu(k,1614) * lu(k,1679) + lu(k,1685) = lu(k,1685) - lu(k,1615) * lu(k,1679) + lu(k,1687) = lu(k,1687) - lu(k,1616) * lu(k,1679) + lu(k,1688) = lu(k,1688) - lu(k,1617) * lu(k,1679) + lu(k,1689) = lu(k,1689) - lu(k,1618) * lu(k,1679) + lu(k,1690) = lu(k,1690) - lu(k,1619) * lu(k,1679) + lu(k,1692) = lu(k,1692) - lu(k,1620) * lu(k,1679) + lu(k,1693) = lu(k,1693) - lu(k,1621) * lu(k,1679) + lu(k,1694) = lu(k,1694) - lu(k,1622) * lu(k,1679) + lu(k,1695) = lu(k,1695) - lu(k,1623) * lu(k,1679) + lu(k,1786) = lu(k,1786) - lu(k,1610) * lu(k,1785) + lu(k,1787) = lu(k,1787) - lu(k,1611) * lu(k,1785) + lu(k,1788) = lu(k,1788) - lu(k,1612) * lu(k,1785) + lu(k,1789) = lu(k,1789) - lu(k,1613) * lu(k,1785) + lu(k,1790) = lu(k,1790) - lu(k,1614) * lu(k,1785) + lu(k,1791) = lu(k,1791) - lu(k,1615) * lu(k,1785) + lu(k,1793) = lu(k,1793) - lu(k,1616) * lu(k,1785) + lu(k,1794) = lu(k,1794) - lu(k,1617) * lu(k,1785) + lu(k,1795) = lu(k,1795) - lu(k,1618) * lu(k,1785) + lu(k,1796) = lu(k,1796) - lu(k,1619) * lu(k,1785) + lu(k,1798) = lu(k,1798) - lu(k,1620) * lu(k,1785) + lu(k,1799) = lu(k,1799) - lu(k,1621) * lu(k,1785) + lu(k,1800) = lu(k,1800) - lu(k,1622) * lu(k,1785) + lu(k,1801) = lu(k,1801) - lu(k,1623) * lu(k,1785) + lu(k,1829) = lu(k,1829) - lu(k,1610) * lu(k,1828) + lu(k,1830) = lu(k,1830) - lu(k,1611) * lu(k,1828) + lu(k,1831) = lu(k,1831) - lu(k,1612) * lu(k,1828) + lu(k,1832) = lu(k,1832) - lu(k,1613) * lu(k,1828) + lu(k,1833) = lu(k,1833) - lu(k,1614) * lu(k,1828) + lu(k,1834) = lu(k,1834) - lu(k,1615) * lu(k,1828) + lu(k,1836) = lu(k,1836) - lu(k,1616) * lu(k,1828) + lu(k,1837) = lu(k,1837) - lu(k,1617) * lu(k,1828) + lu(k,1838) = lu(k,1838) - lu(k,1618) * lu(k,1828) + lu(k,1839) = lu(k,1839) - lu(k,1619) * lu(k,1828) + lu(k,1841) = lu(k,1841) - lu(k,1620) * lu(k,1828) + lu(k,1842) = lu(k,1842) - lu(k,1621) * lu(k,1828) + lu(k,1843) = lu(k,1843) - lu(k,1622) * lu(k,1828) + lu(k,1844) = lu(k,1844) - lu(k,1623) * lu(k,1828) + lu(k,2002) = lu(k,2002) - lu(k,1610) * lu(k,2001) + lu(k,2003) = lu(k,2003) - lu(k,1611) * lu(k,2001) + lu(k,2004) = lu(k,2004) - lu(k,1612) * lu(k,2001) + lu(k,2005) = lu(k,2005) - lu(k,1613) * lu(k,2001) + lu(k,2006) = lu(k,2006) - lu(k,1614) * lu(k,2001) + lu(k,2007) = lu(k,2007) - lu(k,1615) * lu(k,2001) + lu(k,2009) = lu(k,2009) - lu(k,1616) * lu(k,2001) + lu(k,2010) = lu(k,2010) - lu(k,1617) * lu(k,2001) + lu(k,2011) = lu(k,2011) - lu(k,1618) * lu(k,2001) + lu(k,2012) = lu(k,2012) - lu(k,1619) * lu(k,2001) + lu(k,2014) = lu(k,2014) - lu(k,1620) * lu(k,2001) + lu(k,2015) = lu(k,2015) - lu(k,1621) * lu(k,2001) + lu(k,2016) = lu(k,2016) - lu(k,1622) * lu(k,2001) + lu(k,2017) = lu(k,2017) - lu(k,1623) * lu(k,2001) + lu(k,2062) = lu(k,2062) - lu(k,1610) * lu(k,2061) + lu(k,2063) = lu(k,2063) - lu(k,1611) * lu(k,2061) + lu(k,2064) = lu(k,2064) - lu(k,1612) * lu(k,2061) + lu(k,2065) = lu(k,2065) - lu(k,1613) * lu(k,2061) + lu(k,2066) = lu(k,2066) - lu(k,1614) * lu(k,2061) + lu(k,2067) = lu(k,2067) - lu(k,1615) * lu(k,2061) + lu(k,2069) = lu(k,2069) - lu(k,1616) * lu(k,2061) + lu(k,2070) = lu(k,2070) - lu(k,1617) * lu(k,2061) + lu(k,2071) = lu(k,2071) - lu(k,1618) * lu(k,2061) + lu(k,2072) = lu(k,2072) - lu(k,1619) * lu(k,2061) + lu(k,2074) = lu(k,2074) - lu(k,1620) * lu(k,2061) + lu(k,2075) = lu(k,2075) - lu(k,1621) * lu(k,2061) + lu(k,2076) = lu(k,2076) - lu(k,1622) * lu(k,2061) + lu(k,2077) = lu(k,2077) - lu(k,1623) * lu(k,2061) + lu(k,2087) = lu(k,2087) - lu(k,1610) * lu(k,2086) + lu(k,2088) = lu(k,2088) - lu(k,1611) * lu(k,2086) + lu(k,2089) = lu(k,2089) - lu(k,1612) * lu(k,2086) + lu(k,2090) = lu(k,2090) - lu(k,1613) * lu(k,2086) + lu(k,2091) = lu(k,2091) - lu(k,1614) * lu(k,2086) + lu(k,2092) = lu(k,2092) - lu(k,1615) * lu(k,2086) + lu(k,2094) = lu(k,2094) - lu(k,1616) * lu(k,2086) + lu(k,2095) = lu(k,2095) - lu(k,1617) * lu(k,2086) + lu(k,2096) = lu(k,2096) - lu(k,1618) * lu(k,2086) + lu(k,2097) = lu(k,2097) - lu(k,1619) * lu(k,2086) + lu(k,2099) = lu(k,2099) - lu(k,1620) * lu(k,2086) + lu(k,2100) = lu(k,2100) - lu(k,1621) * lu(k,2086) + lu(k,2101) = lu(k,2101) - lu(k,1622) * lu(k,2086) + lu(k,2102) = lu(k,2102) - lu(k,1623) * lu(k,2086) + lu(k,2207) = lu(k,2207) - lu(k,1610) * lu(k,2206) + lu(k,2208) = lu(k,2208) - lu(k,1611) * lu(k,2206) + lu(k,2209) = lu(k,2209) - lu(k,1612) * lu(k,2206) + lu(k,2210) = lu(k,2210) - lu(k,1613) * lu(k,2206) + lu(k,2211) = lu(k,2211) - lu(k,1614) * lu(k,2206) + lu(k,2212) = lu(k,2212) - lu(k,1615) * lu(k,2206) + lu(k,2214) = lu(k,2214) - lu(k,1616) * lu(k,2206) + lu(k,2215) = lu(k,2215) - lu(k,1617) * lu(k,2206) + lu(k,2216) = lu(k,2216) - lu(k,1618) * lu(k,2206) + lu(k,2217) = lu(k,2217) - lu(k,1619) * lu(k,2206) + lu(k,2219) = lu(k,2219) - lu(k,1620) * lu(k,2206) + lu(k,2220) = lu(k,2220) - lu(k,1621) * lu(k,2206) + lu(k,2221) = lu(k,2221) - lu(k,1622) * lu(k,2206) + lu(k,2222) = lu(k,2222) - lu(k,1623) * lu(k,2206) + lu(k,2253) = lu(k,2253) - lu(k,1610) * lu(k,2252) + lu(k,2254) = lu(k,2254) - lu(k,1611) * lu(k,2252) + lu(k,2255) = lu(k,2255) - lu(k,1612) * lu(k,2252) + lu(k,2256) = lu(k,2256) - lu(k,1613) * lu(k,2252) + lu(k,2257) = lu(k,2257) - lu(k,1614) * lu(k,2252) + lu(k,2258) = lu(k,2258) - lu(k,1615) * lu(k,2252) + lu(k,2260) = lu(k,2260) - lu(k,1616) * lu(k,2252) + lu(k,2261) = lu(k,2261) - lu(k,1617) * lu(k,2252) + lu(k,2262) = lu(k,2262) - lu(k,1618) * lu(k,2252) + lu(k,2263) = lu(k,2263) - lu(k,1619) * lu(k,2252) + lu(k,2265) = lu(k,2265) - lu(k,1620) * lu(k,2252) + lu(k,2266) = lu(k,2266) - lu(k,1621) * lu(k,2252) + lu(k,2267) = lu(k,2267) - lu(k,1622) * lu(k,2252) + lu(k,2268) = lu(k,2268) - lu(k,1623) * lu(k,2252) + lu(k,2274) = lu(k,2274) - lu(k,1610) * lu(k,2273) + lu(k,2275) = lu(k,2275) - lu(k,1611) * lu(k,2273) + lu(k,2276) = lu(k,2276) - lu(k,1612) * lu(k,2273) + lu(k,2277) = lu(k,2277) - lu(k,1613) * lu(k,2273) + lu(k,2278) = lu(k,2278) - lu(k,1614) * lu(k,2273) + lu(k,2279) = lu(k,2279) - lu(k,1615) * lu(k,2273) + lu(k,2281) = lu(k,2281) - lu(k,1616) * lu(k,2273) + lu(k,2282) = lu(k,2282) - lu(k,1617) * lu(k,2273) + lu(k,2283) = lu(k,2283) - lu(k,1618) * lu(k,2273) + lu(k,2284) = lu(k,2284) - lu(k,1619) * lu(k,2273) + lu(k,2286) = lu(k,2286) - lu(k,1620) * lu(k,2273) + lu(k,2287) = lu(k,2287) - lu(k,1621) * lu(k,2273) + lu(k,2288) = lu(k,2288) - lu(k,1622) * lu(k,2273) + lu(k,2289) = lu(k,2289) - lu(k,1623) * lu(k,2273) + lu(k,2297) = lu(k,2297) - lu(k,1610) * lu(k,2296) + lu(k,2298) = lu(k,2298) - lu(k,1611) * lu(k,2296) + lu(k,2299) = lu(k,2299) - lu(k,1612) * lu(k,2296) + lu(k,2300) = lu(k,2300) - lu(k,1613) * lu(k,2296) + lu(k,2301) = lu(k,2301) - lu(k,1614) * lu(k,2296) + lu(k,2302) = lu(k,2302) - lu(k,1615) * lu(k,2296) + lu(k,2304) = lu(k,2304) - lu(k,1616) * lu(k,2296) + lu(k,2305) = lu(k,2305) - lu(k,1617) * lu(k,2296) + lu(k,2306) = lu(k,2306) - lu(k,1618) * lu(k,2296) + lu(k,2307) = lu(k,2307) - lu(k,1619) * lu(k,2296) + lu(k,2309) = lu(k,2309) - lu(k,1620) * lu(k,2296) + lu(k,2310) = lu(k,2310) - lu(k,1621) * lu(k,2296) + lu(k,2311) = lu(k,2311) - lu(k,1622) * lu(k,2296) + lu(k,2312) = lu(k,2312) - lu(k,1623) * lu(k,2296) + lu(k,2349) = lu(k,2349) - lu(k,1610) * lu(k,2348) + lu(k,2350) = lu(k,2350) - lu(k,1611) * lu(k,2348) + lu(k,2351) = lu(k,2351) - lu(k,1612) * lu(k,2348) + lu(k,2352) = lu(k,2352) - lu(k,1613) * lu(k,2348) + lu(k,2353) = lu(k,2353) - lu(k,1614) * lu(k,2348) + lu(k,2354) = lu(k,2354) - lu(k,1615) * lu(k,2348) + lu(k,2356) = lu(k,2356) - lu(k,1616) * lu(k,2348) + lu(k,2357) = lu(k,2357) - lu(k,1617) * lu(k,2348) + lu(k,2358) = lu(k,2358) - lu(k,1618) * lu(k,2348) + lu(k,2359) = lu(k,2359) - lu(k,1619) * lu(k,2348) + lu(k,2361) = lu(k,2361) - lu(k,1620) * lu(k,2348) + lu(k,2362) = lu(k,2362) - lu(k,1621) * lu(k,2348) + lu(k,2363) = lu(k,2363) - lu(k,1622) * lu(k,2348) + lu(k,2364) = lu(k,2364) - lu(k,1623) * lu(k,2348) + lu(k,2413) = lu(k,2413) - lu(k,1610) * lu(k,2412) + lu(k,2414) = lu(k,2414) - lu(k,1611) * lu(k,2412) + lu(k,2415) = lu(k,2415) - lu(k,1612) * lu(k,2412) + lu(k,2416) = lu(k,2416) - lu(k,1613) * lu(k,2412) + lu(k,2417) = lu(k,2417) - lu(k,1614) * lu(k,2412) + lu(k,2418) = lu(k,2418) - lu(k,1615) * lu(k,2412) + lu(k,2420) = lu(k,2420) - lu(k,1616) * lu(k,2412) + lu(k,2421) = lu(k,2421) - lu(k,1617) * lu(k,2412) + lu(k,2422) = lu(k,2422) - lu(k,1618) * lu(k,2412) + lu(k,2423) = lu(k,2423) - lu(k,1619) * lu(k,2412) + lu(k,2425) = lu(k,2425) - lu(k,1620) * lu(k,2412) + lu(k,2426) = lu(k,2426) - lu(k,1621) * lu(k,2412) + lu(k,2427) = lu(k,2427) - lu(k,1622) * lu(k,2412) + lu(k,2428) = lu(k,2428) - lu(k,1623) * lu(k,2412) + lu(k,2456) = lu(k,2456) - lu(k,1610) * lu(k,2455) + lu(k,2457) = lu(k,2457) - lu(k,1611) * lu(k,2455) + lu(k,2458) = lu(k,2458) - lu(k,1612) * lu(k,2455) + lu(k,2459) = lu(k,2459) - lu(k,1613) * lu(k,2455) + lu(k,2460) = lu(k,2460) - lu(k,1614) * lu(k,2455) + lu(k,2461) = lu(k,2461) - lu(k,1615) * lu(k,2455) + lu(k,2463) = lu(k,2463) - lu(k,1616) * lu(k,2455) + lu(k,2464) = lu(k,2464) - lu(k,1617) * lu(k,2455) + lu(k,2465) = lu(k,2465) - lu(k,1618) * lu(k,2455) + lu(k,2466) = lu(k,2466) - lu(k,1619) * lu(k,2455) + lu(k,2468) = lu(k,2468) - lu(k,1620) * lu(k,2455) + lu(k,2469) = lu(k,2469) - lu(k,1621) * lu(k,2455) + lu(k,2470) = lu(k,2470) - lu(k,1622) * lu(k,2455) + lu(k,2471) = lu(k,2471) - lu(k,1623) * lu(k,2455) + lu(k,2482) = lu(k,2482) - lu(k,1610) * lu(k,2481) + lu(k,2483) = lu(k,2483) - lu(k,1611) * lu(k,2481) + lu(k,2484) = lu(k,2484) - lu(k,1612) * lu(k,2481) + lu(k,2485) = lu(k,2485) - lu(k,1613) * lu(k,2481) + lu(k,2486) = lu(k,2486) - lu(k,1614) * lu(k,2481) + lu(k,2487) = lu(k,2487) - lu(k,1615) * lu(k,2481) + lu(k,2489) = lu(k,2489) - lu(k,1616) * lu(k,2481) + lu(k,2490) = lu(k,2490) - lu(k,1617) * lu(k,2481) + lu(k,2491) = lu(k,2491) - lu(k,1618) * lu(k,2481) + lu(k,2492) = lu(k,2492) - lu(k,1619) * lu(k,2481) + lu(k,2494) = lu(k,2494) - lu(k,1620) * lu(k,2481) + lu(k,2495) = lu(k,2495) - lu(k,1621) * lu(k,2481) + lu(k,2496) = lu(k,2496) - lu(k,1622) * lu(k,2481) + lu(k,2497) = lu(k,2497) - lu(k,1623) * lu(k,2481) + lu(k,2509) = lu(k,2509) - lu(k,1610) * lu(k,2508) + lu(k,2510) = lu(k,2510) - lu(k,1611) * lu(k,2508) + lu(k,2511) = lu(k,2511) - lu(k,1612) * lu(k,2508) + lu(k,2512) = lu(k,2512) - lu(k,1613) * lu(k,2508) + lu(k,2513) = lu(k,2513) - lu(k,1614) * lu(k,2508) + lu(k,2514) = lu(k,2514) - lu(k,1615) * lu(k,2508) + lu(k,2516) = lu(k,2516) - lu(k,1616) * lu(k,2508) + lu(k,2517) = lu(k,2517) - lu(k,1617) * lu(k,2508) + lu(k,2518) = lu(k,2518) - lu(k,1618) * lu(k,2508) + lu(k,2519) = lu(k,2519) - lu(k,1619) * lu(k,2508) + lu(k,2521) = lu(k,2521) - lu(k,1620) * lu(k,2508) + lu(k,2522) = lu(k,2522) - lu(k,1621) * lu(k,2508) + lu(k,2523) = lu(k,2523) - lu(k,1622) * lu(k,2508) + lu(k,2524) = lu(k,2524) - lu(k,1623) * lu(k,2508) + lu(k,1636) = 1._r8 / lu(k,1636) + lu(k,1637) = lu(k,1637) * lu(k,1636) + lu(k,1638) = lu(k,1638) * lu(k,1636) + lu(k,1639) = lu(k,1639) * lu(k,1636) + lu(k,1640) = lu(k,1640) * lu(k,1636) + lu(k,1641) = lu(k,1641) * lu(k,1636) + lu(k,1642) = lu(k,1642) * lu(k,1636) + lu(k,1643) = lu(k,1643) * lu(k,1636) + lu(k,1644) = lu(k,1644) * lu(k,1636) + lu(k,1645) = lu(k,1645) * lu(k,1636) + lu(k,1646) = lu(k,1646) * lu(k,1636) + lu(k,1647) = lu(k,1647) * lu(k,1636) + lu(k,1648) = lu(k,1648) * lu(k,1636) + lu(k,1649) = lu(k,1649) * lu(k,1636) + lu(k,1650) = lu(k,1650) * lu(k,1636) + lu(k,1681) = lu(k,1681) - lu(k,1637) * lu(k,1680) + lu(k,1682) = lu(k,1682) - lu(k,1638) * lu(k,1680) + lu(k,1683) = lu(k,1683) - lu(k,1639) * lu(k,1680) + lu(k,1684) = lu(k,1684) - lu(k,1640) * lu(k,1680) + lu(k,1685) = lu(k,1685) - lu(k,1641) * lu(k,1680) + lu(k,1687) = lu(k,1687) - lu(k,1642) * lu(k,1680) + lu(k,1688) = lu(k,1688) - lu(k,1643) * lu(k,1680) + lu(k,1689) = lu(k,1689) - lu(k,1644) * lu(k,1680) + lu(k,1690) = lu(k,1690) - lu(k,1645) * lu(k,1680) + lu(k,1691) = lu(k,1691) - lu(k,1646) * lu(k,1680) + lu(k,1692) = lu(k,1692) - lu(k,1647) * lu(k,1680) + lu(k,1693) = lu(k,1693) - lu(k,1648) * lu(k,1680) + lu(k,1694) = lu(k,1694) - lu(k,1649) * lu(k,1680) + lu(k,1695) = lu(k,1695) - lu(k,1650) * lu(k,1680) + lu(k,1787) = lu(k,1787) - lu(k,1637) * lu(k,1786) + lu(k,1788) = lu(k,1788) - lu(k,1638) * lu(k,1786) + lu(k,1789) = lu(k,1789) - lu(k,1639) * lu(k,1786) + lu(k,1790) = lu(k,1790) - lu(k,1640) * lu(k,1786) + lu(k,1791) = lu(k,1791) - lu(k,1641) * lu(k,1786) + lu(k,1793) = lu(k,1793) - lu(k,1642) * lu(k,1786) + lu(k,1794) = lu(k,1794) - lu(k,1643) * lu(k,1786) + lu(k,1795) = lu(k,1795) - lu(k,1644) * lu(k,1786) + lu(k,1796) = lu(k,1796) - lu(k,1645) * lu(k,1786) + lu(k,1797) = lu(k,1797) - lu(k,1646) * lu(k,1786) + lu(k,1798) = lu(k,1798) - lu(k,1647) * lu(k,1786) + lu(k,1799) = lu(k,1799) - lu(k,1648) * lu(k,1786) + lu(k,1800) = lu(k,1800) - lu(k,1649) * lu(k,1786) + lu(k,1801) = lu(k,1801) - lu(k,1650) * lu(k,1786) + lu(k,1830) = lu(k,1830) - lu(k,1637) * lu(k,1829) + lu(k,1831) = lu(k,1831) - lu(k,1638) * lu(k,1829) + lu(k,1832) = lu(k,1832) - lu(k,1639) * lu(k,1829) + lu(k,1833) = lu(k,1833) - lu(k,1640) * lu(k,1829) + lu(k,1834) = lu(k,1834) - lu(k,1641) * lu(k,1829) + lu(k,1836) = lu(k,1836) - lu(k,1642) * lu(k,1829) + lu(k,1837) = lu(k,1837) - lu(k,1643) * lu(k,1829) + lu(k,1838) = lu(k,1838) - lu(k,1644) * lu(k,1829) + lu(k,1839) = lu(k,1839) - lu(k,1645) * lu(k,1829) + lu(k,1840) = lu(k,1840) - lu(k,1646) * lu(k,1829) + lu(k,1841) = lu(k,1841) - lu(k,1647) * lu(k,1829) + lu(k,1842) = lu(k,1842) - lu(k,1648) * lu(k,1829) + lu(k,1843) = lu(k,1843) - lu(k,1649) * lu(k,1829) + lu(k,1844) = lu(k,1844) - lu(k,1650) * lu(k,1829) + lu(k,2003) = lu(k,2003) - lu(k,1637) * lu(k,2002) + lu(k,2004) = lu(k,2004) - lu(k,1638) * lu(k,2002) + lu(k,2005) = lu(k,2005) - lu(k,1639) * lu(k,2002) + lu(k,2006) = lu(k,2006) - lu(k,1640) * lu(k,2002) + lu(k,2007) = lu(k,2007) - lu(k,1641) * lu(k,2002) + lu(k,2009) = lu(k,2009) - lu(k,1642) * lu(k,2002) + lu(k,2010) = lu(k,2010) - lu(k,1643) * lu(k,2002) + lu(k,2011) = lu(k,2011) - lu(k,1644) * lu(k,2002) + lu(k,2012) = lu(k,2012) - lu(k,1645) * lu(k,2002) + lu(k,2013) = lu(k,2013) - lu(k,1646) * lu(k,2002) + lu(k,2014) = lu(k,2014) - lu(k,1647) * lu(k,2002) + lu(k,2015) = lu(k,2015) - lu(k,1648) * lu(k,2002) + lu(k,2016) = lu(k,2016) - lu(k,1649) * lu(k,2002) + lu(k,2017) = lu(k,2017) - lu(k,1650) * lu(k,2002) + lu(k,2063) = lu(k,2063) - lu(k,1637) * lu(k,2062) + lu(k,2064) = lu(k,2064) - lu(k,1638) * lu(k,2062) + lu(k,2065) = lu(k,2065) - lu(k,1639) * lu(k,2062) + lu(k,2066) = lu(k,2066) - lu(k,1640) * lu(k,2062) + lu(k,2067) = lu(k,2067) - lu(k,1641) * lu(k,2062) + lu(k,2069) = lu(k,2069) - lu(k,1642) * lu(k,2062) + lu(k,2070) = lu(k,2070) - lu(k,1643) * lu(k,2062) + lu(k,2071) = lu(k,2071) - lu(k,1644) * lu(k,2062) + lu(k,2072) = lu(k,2072) - lu(k,1645) * lu(k,2062) + lu(k,2073) = lu(k,2073) - lu(k,1646) * lu(k,2062) + lu(k,2074) = lu(k,2074) - lu(k,1647) * lu(k,2062) + lu(k,2075) = lu(k,2075) - lu(k,1648) * lu(k,2062) + lu(k,2076) = lu(k,2076) - lu(k,1649) * lu(k,2062) + lu(k,2077) = lu(k,2077) - lu(k,1650) * lu(k,2062) + lu(k,2088) = lu(k,2088) - lu(k,1637) * lu(k,2087) + lu(k,2089) = lu(k,2089) - lu(k,1638) * lu(k,2087) + lu(k,2090) = lu(k,2090) - lu(k,1639) * lu(k,2087) + lu(k,2091) = lu(k,2091) - lu(k,1640) * lu(k,2087) + lu(k,2092) = lu(k,2092) - lu(k,1641) * lu(k,2087) + lu(k,2094) = lu(k,2094) - lu(k,1642) * lu(k,2087) + lu(k,2095) = lu(k,2095) - lu(k,1643) * lu(k,2087) + lu(k,2096) = lu(k,2096) - lu(k,1644) * lu(k,2087) + lu(k,2097) = lu(k,2097) - lu(k,1645) * lu(k,2087) + lu(k,2098) = lu(k,2098) - lu(k,1646) * lu(k,2087) + lu(k,2099) = lu(k,2099) - lu(k,1647) * lu(k,2087) + lu(k,2100) = lu(k,2100) - lu(k,1648) * lu(k,2087) + lu(k,2101) = lu(k,2101) - lu(k,1649) * lu(k,2087) + lu(k,2102) = lu(k,2102) - lu(k,1650) * lu(k,2087) + lu(k,2208) = lu(k,2208) - lu(k,1637) * lu(k,2207) + lu(k,2209) = lu(k,2209) - lu(k,1638) * lu(k,2207) + lu(k,2210) = lu(k,2210) - lu(k,1639) * lu(k,2207) + lu(k,2211) = lu(k,2211) - lu(k,1640) * lu(k,2207) + lu(k,2212) = lu(k,2212) - lu(k,1641) * lu(k,2207) + lu(k,2214) = lu(k,2214) - lu(k,1642) * lu(k,2207) + lu(k,2215) = lu(k,2215) - lu(k,1643) * lu(k,2207) + lu(k,2216) = lu(k,2216) - lu(k,1644) * lu(k,2207) + lu(k,2217) = lu(k,2217) - lu(k,1645) * lu(k,2207) + lu(k,2218) = lu(k,2218) - lu(k,1646) * lu(k,2207) + lu(k,2219) = lu(k,2219) - lu(k,1647) * lu(k,2207) + lu(k,2220) = lu(k,2220) - lu(k,1648) * lu(k,2207) + lu(k,2221) = lu(k,2221) - lu(k,1649) * lu(k,2207) + lu(k,2222) = lu(k,2222) - lu(k,1650) * lu(k,2207) + lu(k,2254) = lu(k,2254) - lu(k,1637) * lu(k,2253) + lu(k,2255) = lu(k,2255) - lu(k,1638) * lu(k,2253) + lu(k,2256) = lu(k,2256) - lu(k,1639) * lu(k,2253) + lu(k,2257) = lu(k,2257) - lu(k,1640) * lu(k,2253) + lu(k,2258) = lu(k,2258) - lu(k,1641) * lu(k,2253) + lu(k,2260) = lu(k,2260) - lu(k,1642) * lu(k,2253) + lu(k,2261) = lu(k,2261) - lu(k,1643) * lu(k,2253) + lu(k,2262) = lu(k,2262) - lu(k,1644) * lu(k,2253) + lu(k,2263) = lu(k,2263) - lu(k,1645) * lu(k,2253) + lu(k,2264) = lu(k,2264) - lu(k,1646) * lu(k,2253) + lu(k,2265) = lu(k,2265) - lu(k,1647) * lu(k,2253) + lu(k,2266) = lu(k,2266) - lu(k,1648) * lu(k,2253) + lu(k,2267) = lu(k,2267) - lu(k,1649) * lu(k,2253) + lu(k,2268) = lu(k,2268) - lu(k,1650) * lu(k,2253) + lu(k,2275) = lu(k,2275) - lu(k,1637) * lu(k,2274) + lu(k,2276) = lu(k,2276) - lu(k,1638) * lu(k,2274) + lu(k,2277) = lu(k,2277) - lu(k,1639) * lu(k,2274) + lu(k,2278) = lu(k,2278) - lu(k,1640) * lu(k,2274) + lu(k,2279) = lu(k,2279) - lu(k,1641) * lu(k,2274) + lu(k,2281) = lu(k,2281) - lu(k,1642) * lu(k,2274) + lu(k,2282) = lu(k,2282) - lu(k,1643) * lu(k,2274) + lu(k,2283) = lu(k,2283) - lu(k,1644) * lu(k,2274) + lu(k,2284) = lu(k,2284) - lu(k,1645) * lu(k,2274) + lu(k,2285) = lu(k,2285) - lu(k,1646) * lu(k,2274) + lu(k,2286) = lu(k,2286) - lu(k,1647) * lu(k,2274) + lu(k,2287) = lu(k,2287) - lu(k,1648) * lu(k,2274) + lu(k,2288) = lu(k,2288) - lu(k,1649) * lu(k,2274) + lu(k,2289) = lu(k,2289) - lu(k,1650) * lu(k,2274) + lu(k,2298) = lu(k,2298) - lu(k,1637) * lu(k,2297) + lu(k,2299) = lu(k,2299) - lu(k,1638) * lu(k,2297) + lu(k,2300) = lu(k,2300) - lu(k,1639) * lu(k,2297) + lu(k,2301) = lu(k,2301) - lu(k,1640) * lu(k,2297) + lu(k,2302) = lu(k,2302) - lu(k,1641) * lu(k,2297) + lu(k,2304) = lu(k,2304) - lu(k,1642) * lu(k,2297) + lu(k,2305) = lu(k,2305) - lu(k,1643) * lu(k,2297) + lu(k,2306) = lu(k,2306) - lu(k,1644) * lu(k,2297) + lu(k,2307) = lu(k,2307) - lu(k,1645) * lu(k,2297) + lu(k,2308) = lu(k,2308) - lu(k,1646) * lu(k,2297) + lu(k,2309) = lu(k,2309) - lu(k,1647) * lu(k,2297) + lu(k,2310) = lu(k,2310) - lu(k,1648) * lu(k,2297) + lu(k,2311) = lu(k,2311) - lu(k,1649) * lu(k,2297) + lu(k,2312) = lu(k,2312) - lu(k,1650) * lu(k,2297) + lu(k,2350) = lu(k,2350) - lu(k,1637) * lu(k,2349) + lu(k,2351) = lu(k,2351) - lu(k,1638) * lu(k,2349) + lu(k,2352) = lu(k,2352) - lu(k,1639) * lu(k,2349) + lu(k,2353) = lu(k,2353) - lu(k,1640) * lu(k,2349) + lu(k,2354) = lu(k,2354) - lu(k,1641) * lu(k,2349) + lu(k,2356) = lu(k,2356) - lu(k,1642) * lu(k,2349) + lu(k,2357) = lu(k,2357) - lu(k,1643) * lu(k,2349) + lu(k,2358) = lu(k,2358) - lu(k,1644) * lu(k,2349) + lu(k,2359) = lu(k,2359) - lu(k,1645) * lu(k,2349) + lu(k,2360) = lu(k,2360) - lu(k,1646) * lu(k,2349) + lu(k,2361) = lu(k,2361) - lu(k,1647) * lu(k,2349) + lu(k,2362) = lu(k,2362) - lu(k,1648) * lu(k,2349) + lu(k,2363) = lu(k,2363) - lu(k,1649) * lu(k,2349) + lu(k,2364) = lu(k,2364) - lu(k,1650) * lu(k,2349) + lu(k,2414) = lu(k,2414) - lu(k,1637) * lu(k,2413) + lu(k,2415) = lu(k,2415) - lu(k,1638) * lu(k,2413) + lu(k,2416) = lu(k,2416) - lu(k,1639) * lu(k,2413) + lu(k,2417) = lu(k,2417) - lu(k,1640) * lu(k,2413) + lu(k,2418) = lu(k,2418) - lu(k,1641) * lu(k,2413) + lu(k,2420) = lu(k,2420) - lu(k,1642) * lu(k,2413) + lu(k,2421) = lu(k,2421) - lu(k,1643) * lu(k,2413) + lu(k,2422) = lu(k,2422) - lu(k,1644) * lu(k,2413) + lu(k,2423) = lu(k,2423) - lu(k,1645) * lu(k,2413) + lu(k,2424) = lu(k,2424) - lu(k,1646) * lu(k,2413) + lu(k,2425) = lu(k,2425) - lu(k,1647) * lu(k,2413) + lu(k,2426) = lu(k,2426) - lu(k,1648) * lu(k,2413) + lu(k,2427) = lu(k,2427) - lu(k,1649) * lu(k,2413) + lu(k,2428) = lu(k,2428) - lu(k,1650) * lu(k,2413) + lu(k,2457) = lu(k,2457) - lu(k,1637) * lu(k,2456) + lu(k,2458) = lu(k,2458) - lu(k,1638) * lu(k,2456) + lu(k,2459) = lu(k,2459) - lu(k,1639) * lu(k,2456) + lu(k,2460) = lu(k,2460) - lu(k,1640) * lu(k,2456) + lu(k,2461) = lu(k,2461) - lu(k,1641) * lu(k,2456) + lu(k,2463) = lu(k,2463) - lu(k,1642) * lu(k,2456) + lu(k,2464) = lu(k,2464) - lu(k,1643) * lu(k,2456) + lu(k,2465) = lu(k,2465) - lu(k,1644) * lu(k,2456) + lu(k,2466) = lu(k,2466) - lu(k,1645) * lu(k,2456) + lu(k,2467) = lu(k,2467) - lu(k,1646) * lu(k,2456) + lu(k,2468) = lu(k,2468) - lu(k,1647) * lu(k,2456) + lu(k,2469) = lu(k,2469) - lu(k,1648) * lu(k,2456) + lu(k,2470) = lu(k,2470) - lu(k,1649) * lu(k,2456) + lu(k,2471) = lu(k,2471) - lu(k,1650) * lu(k,2456) + lu(k,2483) = lu(k,2483) - lu(k,1637) * lu(k,2482) + lu(k,2484) = lu(k,2484) - lu(k,1638) * lu(k,2482) + lu(k,2485) = lu(k,2485) - lu(k,1639) * lu(k,2482) + lu(k,2486) = lu(k,2486) - lu(k,1640) * lu(k,2482) + lu(k,2487) = lu(k,2487) - lu(k,1641) * lu(k,2482) + lu(k,2489) = lu(k,2489) - lu(k,1642) * lu(k,2482) + lu(k,2490) = lu(k,2490) - lu(k,1643) * lu(k,2482) + lu(k,2491) = lu(k,2491) - lu(k,1644) * lu(k,2482) + lu(k,2492) = lu(k,2492) - lu(k,1645) * lu(k,2482) + lu(k,2493) = lu(k,2493) - lu(k,1646) * lu(k,2482) + lu(k,2494) = lu(k,2494) - lu(k,1647) * lu(k,2482) + lu(k,2495) = lu(k,2495) - lu(k,1648) * lu(k,2482) + lu(k,2496) = lu(k,2496) - lu(k,1649) * lu(k,2482) + lu(k,2497) = lu(k,2497) - lu(k,1650) * lu(k,2482) + lu(k,2510) = lu(k,2510) - lu(k,1637) * lu(k,2509) + lu(k,2511) = lu(k,2511) - lu(k,1638) * lu(k,2509) + lu(k,2512) = lu(k,2512) - lu(k,1639) * lu(k,2509) + lu(k,2513) = lu(k,2513) - lu(k,1640) * lu(k,2509) + lu(k,2514) = lu(k,2514) - lu(k,1641) * lu(k,2509) + lu(k,2516) = lu(k,2516) - lu(k,1642) * lu(k,2509) + lu(k,2517) = lu(k,2517) - lu(k,1643) * lu(k,2509) + lu(k,2518) = lu(k,2518) - lu(k,1644) * lu(k,2509) + lu(k,2519) = lu(k,2519) - lu(k,1645) * lu(k,2509) + lu(k,2520) = lu(k,2520) - lu(k,1646) * lu(k,2509) + lu(k,2521) = lu(k,2521) - lu(k,1647) * lu(k,2509) + lu(k,2522) = lu(k,2522) - lu(k,1648) * lu(k,2509) + lu(k,2523) = lu(k,2523) - lu(k,1649) * lu(k,2509) + lu(k,2524) = lu(k,2524) - lu(k,1650) * lu(k,2509) + lu(k,1681) = 1._r8 / lu(k,1681) + lu(k,1682) = lu(k,1682) * lu(k,1681) + lu(k,1683) = lu(k,1683) * lu(k,1681) + lu(k,1684) = lu(k,1684) * lu(k,1681) + lu(k,1685) = lu(k,1685) * lu(k,1681) + lu(k,1686) = lu(k,1686) * lu(k,1681) + lu(k,1687) = lu(k,1687) * lu(k,1681) + lu(k,1688) = lu(k,1688) * lu(k,1681) + lu(k,1689) = lu(k,1689) * lu(k,1681) + lu(k,1690) = lu(k,1690) * lu(k,1681) + lu(k,1691) = lu(k,1691) * lu(k,1681) + lu(k,1692) = lu(k,1692) * lu(k,1681) + lu(k,1693) = lu(k,1693) * lu(k,1681) + lu(k,1694) = lu(k,1694) * lu(k,1681) + lu(k,1695) = lu(k,1695) * lu(k,1681) + lu(k,1788) = lu(k,1788) - lu(k,1682) * lu(k,1787) + lu(k,1789) = lu(k,1789) - lu(k,1683) * lu(k,1787) + lu(k,1790) = lu(k,1790) - lu(k,1684) * lu(k,1787) + lu(k,1791) = lu(k,1791) - lu(k,1685) * lu(k,1787) + lu(k,1792) = lu(k,1792) - lu(k,1686) * lu(k,1787) + lu(k,1793) = lu(k,1793) - lu(k,1687) * lu(k,1787) + lu(k,1794) = lu(k,1794) - lu(k,1688) * lu(k,1787) + lu(k,1795) = lu(k,1795) - lu(k,1689) * lu(k,1787) + lu(k,1796) = lu(k,1796) - lu(k,1690) * lu(k,1787) + lu(k,1797) = lu(k,1797) - lu(k,1691) * lu(k,1787) + lu(k,1798) = lu(k,1798) - lu(k,1692) * lu(k,1787) + lu(k,1799) = lu(k,1799) - lu(k,1693) * lu(k,1787) + lu(k,1800) = lu(k,1800) - lu(k,1694) * lu(k,1787) + lu(k,1801) = lu(k,1801) - lu(k,1695) * lu(k,1787) + lu(k,1831) = lu(k,1831) - lu(k,1682) * lu(k,1830) + lu(k,1832) = lu(k,1832) - lu(k,1683) * lu(k,1830) + lu(k,1833) = lu(k,1833) - lu(k,1684) * lu(k,1830) + lu(k,1834) = lu(k,1834) - lu(k,1685) * lu(k,1830) + lu(k,1835) = lu(k,1835) - lu(k,1686) * lu(k,1830) + lu(k,1836) = lu(k,1836) - lu(k,1687) * lu(k,1830) + lu(k,1837) = lu(k,1837) - lu(k,1688) * lu(k,1830) + lu(k,1838) = lu(k,1838) - lu(k,1689) * lu(k,1830) + lu(k,1839) = lu(k,1839) - lu(k,1690) * lu(k,1830) + lu(k,1840) = lu(k,1840) - lu(k,1691) * lu(k,1830) + lu(k,1841) = lu(k,1841) - lu(k,1692) * lu(k,1830) + lu(k,1842) = lu(k,1842) - lu(k,1693) * lu(k,1830) + lu(k,1843) = lu(k,1843) - lu(k,1694) * lu(k,1830) + lu(k,1844) = lu(k,1844) - lu(k,1695) * lu(k,1830) + lu(k,2004) = lu(k,2004) - lu(k,1682) * lu(k,2003) + lu(k,2005) = lu(k,2005) - lu(k,1683) * lu(k,2003) + lu(k,2006) = lu(k,2006) - lu(k,1684) * lu(k,2003) + lu(k,2007) = lu(k,2007) - lu(k,1685) * lu(k,2003) + lu(k,2008) = lu(k,2008) - lu(k,1686) * lu(k,2003) + lu(k,2009) = lu(k,2009) - lu(k,1687) * lu(k,2003) + lu(k,2010) = lu(k,2010) - lu(k,1688) * lu(k,2003) + lu(k,2011) = lu(k,2011) - lu(k,1689) * lu(k,2003) + lu(k,2012) = lu(k,2012) - lu(k,1690) * lu(k,2003) + lu(k,2013) = lu(k,2013) - lu(k,1691) * lu(k,2003) + lu(k,2014) = lu(k,2014) - lu(k,1692) * lu(k,2003) + lu(k,2015) = lu(k,2015) - lu(k,1693) * lu(k,2003) + lu(k,2016) = lu(k,2016) - lu(k,1694) * lu(k,2003) + lu(k,2017) = lu(k,2017) - lu(k,1695) * lu(k,2003) + lu(k,2064) = lu(k,2064) - lu(k,1682) * lu(k,2063) + lu(k,2065) = lu(k,2065) - lu(k,1683) * lu(k,2063) + lu(k,2066) = lu(k,2066) - lu(k,1684) * lu(k,2063) + lu(k,2067) = lu(k,2067) - lu(k,1685) * lu(k,2063) + lu(k,2068) = lu(k,2068) - lu(k,1686) * lu(k,2063) + lu(k,2069) = lu(k,2069) - lu(k,1687) * lu(k,2063) + lu(k,2070) = lu(k,2070) - lu(k,1688) * lu(k,2063) + lu(k,2071) = lu(k,2071) - lu(k,1689) * lu(k,2063) + lu(k,2072) = lu(k,2072) - lu(k,1690) * lu(k,2063) + lu(k,2073) = lu(k,2073) - lu(k,1691) * lu(k,2063) + lu(k,2074) = lu(k,2074) - lu(k,1692) * lu(k,2063) + lu(k,2075) = lu(k,2075) - lu(k,1693) * lu(k,2063) + lu(k,2076) = lu(k,2076) - lu(k,1694) * lu(k,2063) + lu(k,2077) = lu(k,2077) - lu(k,1695) * lu(k,2063) + lu(k,2089) = lu(k,2089) - lu(k,1682) * lu(k,2088) + lu(k,2090) = lu(k,2090) - lu(k,1683) * lu(k,2088) + lu(k,2091) = lu(k,2091) - lu(k,1684) * lu(k,2088) + lu(k,2092) = lu(k,2092) - lu(k,1685) * lu(k,2088) + lu(k,2093) = lu(k,2093) - lu(k,1686) * lu(k,2088) + lu(k,2094) = lu(k,2094) - lu(k,1687) * lu(k,2088) + lu(k,2095) = lu(k,2095) - lu(k,1688) * lu(k,2088) + lu(k,2096) = lu(k,2096) - lu(k,1689) * lu(k,2088) + lu(k,2097) = lu(k,2097) - lu(k,1690) * lu(k,2088) + lu(k,2098) = lu(k,2098) - lu(k,1691) * lu(k,2088) + lu(k,2099) = lu(k,2099) - lu(k,1692) * lu(k,2088) + lu(k,2100) = lu(k,2100) - lu(k,1693) * lu(k,2088) + lu(k,2101) = lu(k,2101) - lu(k,1694) * lu(k,2088) + lu(k,2102) = lu(k,2102) - lu(k,1695) * lu(k,2088) + lu(k,2209) = lu(k,2209) - lu(k,1682) * lu(k,2208) + lu(k,2210) = lu(k,2210) - lu(k,1683) * lu(k,2208) + lu(k,2211) = lu(k,2211) - lu(k,1684) * lu(k,2208) + lu(k,2212) = lu(k,2212) - lu(k,1685) * lu(k,2208) + lu(k,2213) = lu(k,2213) - lu(k,1686) * lu(k,2208) + lu(k,2214) = lu(k,2214) - lu(k,1687) * lu(k,2208) + lu(k,2215) = lu(k,2215) - lu(k,1688) * lu(k,2208) + lu(k,2216) = lu(k,2216) - lu(k,1689) * lu(k,2208) + lu(k,2217) = lu(k,2217) - lu(k,1690) * lu(k,2208) + lu(k,2218) = lu(k,2218) - lu(k,1691) * lu(k,2208) + lu(k,2219) = lu(k,2219) - lu(k,1692) * lu(k,2208) + lu(k,2220) = lu(k,2220) - lu(k,1693) * lu(k,2208) + lu(k,2221) = lu(k,2221) - lu(k,1694) * lu(k,2208) + lu(k,2222) = lu(k,2222) - lu(k,1695) * lu(k,2208) + lu(k,2255) = lu(k,2255) - lu(k,1682) * lu(k,2254) + lu(k,2256) = lu(k,2256) - lu(k,1683) * lu(k,2254) + lu(k,2257) = lu(k,2257) - lu(k,1684) * lu(k,2254) + lu(k,2258) = lu(k,2258) - lu(k,1685) * lu(k,2254) + lu(k,2259) = lu(k,2259) - lu(k,1686) * lu(k,2254) + lu(k,2260) = lu(k,2260) - lu(k,1687) * lu(k,2254) + lu(k,2261) = lu(k,2261) - lu(k,1688) * lu(k,2254) + lu(k,2262) = lu(k,2262) - lu(k,1689) * lu(k,2254) + lu(k,2263) = lu(k,2263) - lu(k,1690) * lu(k,2254) + lu(k,2264) = lu(k,2264) - lu(k,1691) * lu(k,2254) + lu(k,2265) = lu(k,2265) - lu(k,1692) * lu(k,2254) + lu(k,2266) = lu(k,2266) - lu(k,1693) * lu(k,2254) + lu(k,2267) = lu(k,2267) - lu(k,1694) * lu(k,2254) + lu(k,2268) = lu(k,2268) - lu(k,1695) * lu(k,2254) + lu(k,2276) = lu(k,2276) - lu(k,1682) * lu(k,2275) + lu(k,2277) = lu(k,2277) - lu(k,1683) * lu(k,2275) + lu(k,2278) = lu(k,2278) - lu(k,1684) * lu(k,2275) + lu(k,2279) = lu(k,2279) - lu(k,1685) * lu(k,2275) + lu(k,2280) = lu(k,2280) - lu(k,1686) * lu(k,2275) + lu(k,2281) = lu(k,2281) - lu(k,1687) * lu(k,2275) + lu(k,2282) = lu(k,2282) - lu(k,1688) * lu(k,2275) + lu(k,2283) = lu(k,2283) - lu(k,1689) * lu(k,2275) + lu(k,2284) = lu(k,2284) - lu(k,1690) * lu(k,2275) + lu(k,2285) = lu(k,2285) - lu(k,1691) * lu(k,2275) + lu(k,2286) = lu(k,2286) - lu(k,1692) * lu(k,2275) + lu(k,2287) = lu(k,2287) - lu(k,1693) * lu(k,2275) + lu(k,2288) = lu(k,2288) - lu(k,1694) * lu(k,2275) + lu(k,2289) = lu(k,2289) - lu(k,1695) * lu(k,2275) + lu(k,2299) = lu(k,2299) - lu(k,1682) * lu(k,2298) + lu(k,2300) = lu(k,2300) - lu(k,1683) * lu(k,2298) + lu(k,2301) = lu(k,2301) - lu(k,1684) * lu(k,2298) + lu(k,2302) = lu(k,2302) - lu(k,1685) * lu(k,2298) + lu(k,2303) = lu(k,2303) - lu(k,1686) * lu(k,2298) + lu(k,2304) = lu(k,2304) - lu(k,1687) * lu(k,2298) + lu(k,2305) = lu(k,2305) - lu(k,1688) * lu(k,2298) + lu(k,2306) = lu(k,2306) - lu(k,1689) * lu(k,2298) + lu(k,2307) = lu(k,2307) - lu(k,1690) * lu(k,2298) + lu(k,2308) = lu(k,2308) - lu(k,1691) * lu(k,2298) + lu(k,2309) = lu(k,2309) - lu(k,1692) * lu(k,2298) + lu(k,2310) = lu(k,2310) - lu(k,1693) * lu(k,2298) + lu(k,2311) = lu(k,2311) - lu(k,1694) * lu(k,2298) + lu(k,2312) = lu(k,2312) - lu(k,1695) * lu(k,2298) + lu(k,2351) = lu(k,2351) - lu(k,1682) * lu(k,2350) + lu(k,2352) = lu(k,2352) - lu(k,1683) * lu(k,2350) + lu(k,2353) = lu(k,2353) - lu(k,1684) * lu(k,2350) + lu(k,2354) = lu(k,2354) - lu(k,1685) * lu(k,2350) + lu(k,2355) = lu(k,2355) - lu(k,1686) * lu(k,2350) + lu(k,2356) = lu(k,2356) - lu(k,1687) * lu(k,2350) + lu(k,2357) = lu(k,2357) - lu(k,1688) * lu(k,2350) + lu(k,2358) = lu(k,2358) - lu(k,1689) * lu(k,2350) + lu(k,2359) = lu(k,2359) - lu(k,1690) * lu(k,2350) + lu(k,2360) = lu(k,2360) - lu(k,1691) * lu(k,2350) + lu(k,2361) = lu(k,2361) - lu(k,1692) * lu(k,2350) + lu(k,2362) = lu(k,2362) - lu(k,1693) * lu(k,2350) + lu(k,2363) = lu(k,2363) - lu(k,1694) * lu(k,2350) + lu(k,2364) = lu(k,2364) - lu(k,1695) * lu(k,2350) + lu(k,2415) = lu(k,2415) - lu(k,1682) * lu(k,2414) + lu(k,2416) = lu(k,2416) - lu(k,1683) * lu(k,2414) + lu(k,2417) = lu(k,2417) - lu(k,1684) * lu(k,2414) + lu(k,2418) = lu(k,2418) - lu(k,1685) * lu(k,2414) + lu(k,2419) = lu(k,2419) - lu(k,1686) * lu(k,2414) + lu(k,2420) = lu(k,2420) - lu(k,1687) * lu(k,2414) + lu(k,2421) = lu(k,2421) - lu(k,1688) * lu(k,2414) + lu(k,2422) = lu(k,2422) - lu(k,1689) * lu(k,2414) + lu(k,2423) = lu(k,2423) - lu(k,1690) * lu(k,2414) + lu(k,2424) = lu(k,2424) - lu(k,1691) * lu(k,2414) + lu(k,2425) = lu(k,2425) - lu(k,1692) * lu(k,2414) + lu(k,2426) = lu(k,2426) - lu(k,1693) * lu(k,2414) + lu(k,2427) = lu(k,2427) - lu(k,1694) * lu(k,2414) + lu(k,2428) = lu(k,2428) - lu(k,1695) * lu(k,2414) + lu(k,2458) = lu(k,2458) - lu(k,1682) * lu(k,2457) + lu(k,2459) = lu(k,2459) - lu(k,1683) * lu(k,2457) + lu(k,2460) = lu(k,2460) - lu(k,1684) * lu(k,2457) + lu(k,2461) = lu(k,2461) - lu(k,1685) * lu(k,2457) + lu(k,2462) = lu(k,2462) - lu(k,1686) * lu(k,2457) + lu(k,2463) = lu(k,2463) - lu(k,1687) * lu(k,2457) + lu(k,2464) = lu(k,2464) - lu(k,1688) * lu(k,2457) + lu(k,2465) = lu(k,2465) - lu(k,1689) * lu(k,2457) + lu(k,2466) = lu(k,2466) - lu(k,1690) * lu(k,2457) + lu(k,2467) = lu(k,2467) - lu(k,1691) * lu(k,2457) + lu(k,2468) = lu(k,2468) - lu(k,1692) * lu(k,2457) + lu(k,2469) = lu(k,2469) - lu(k,1693) * lu(k,2457) + lu(k,2470) = lu(k,2470) - lu(k,1694) * lu(k,2457) + lu(k,2471) = lu(k,2471) - lu(k,1695) * lu(k,2457) + lu(k,2484) = lu(k,2484) - lu(k,1682) * lu(k,2483) + lu(k,2485) = lu(k,2485) - lu(k,1683) * lu(k,2483) + lu(k,2486) = lu(k,2486) - lu(k,1684) * lu(k,2483) + lu(k,2487) = lu(k,2487) - lu(k,1685) * lu(k,2483) + lu(k,2488) = lu(k,2488) - lu(k,1686) * lu(k,2483) + lu(k,2489) = lu(k,2489) - lu(k,1687) * lu(k,2483) + lu(k,2490) = lu(k,2490) - lu(k,1688) * lu(k,2483) + lu(k,2491) = lu(k,2491) - lu(k,1689) * lu(k,2483) + lu(k,2492) = lu(k,2492) - lu(k,1690) * lu(k,2483) + lu(k,2493) = lu(k,2493) - lu(k,1691) * lu(k,2483) + lu(k,2494) = lu(k,2494) - lu(k,1692) * lu(k,2483) + lu(k,2495) = lu(k,2495) - lu(k,1693) * lu(k,2483) + lu(k,2496) = lu(k,2496) - lu(k,1694) * lu(k,2483) + lu(k,2497) = lu(k,2497) - lu(k,1695) * lu(k,2483) + lu(k,2511) = lu(k,2511) - lu(k,1682) * lu(k,2510) + lu(k,2512) = lu(k,2512) - lu(k,1683) * lu(k,2510) + lu(k,2513) = lu(k,2513) - lu(k,1684) * lu(k,2510) + lu(k,2514) = lu(k,2514) - lu(k,1685) * lu(k,2510) + lu(k,2515) = lu(k,2515) - lu(k,1686) * lu(k,2510) + lu(k,2516) = lu(k,2516) - lu(k,1687) * lu(k,2510) + lu(k,2517) = lu(k,2517) - lu(k,1688) * lu(k,2510) + lu(k,2518) = lu(k,2518) - lu(k,1689) * lu(k,2510) + lu(k,2519) = lu(k,2519) - lu(k,1690) * lu(k,2510) + lu(k,2520) = lu(k,2520) - lu(k,1691) * lu(k,2510) + lu(k,2521) = lu(k,2521) - lu(k,1692) * lu(k,2510) + lu(k,2522) = lu(k,2522) - lu(k,1693) * lu(k,2510) + lu(k,2523) = lu(k,2523) - lu(k,1694) * lu(k,2510) + lu(k,2524) = lu(k,2524) - lu(k,1695) * lu(k,2510) + end do + end subroutine lu_fac31 + subroutine lu_fac32( 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,1788) = 1._r8 / lu(k,1788) + lu(k,1789) = lu(k,1789) * lu(k,1788) + lu(k,1790) = lu(k,1790) * lu(k,1788) + lu(k,1791) = lu(k,1791) * lu(k,1788) + lu(k,1792) = lu(k,1792) * lu(k,1788) + lu(k,1793) = lu(k,1793) * lu(k,1788) + lu(k,1794) = lu(k,1794) * lu(k,1788) + lu(k,1795) = lu(k,1795) * lu(k,1788) + lu(k,1796) = lu(k,1796) * lu(k,1788) + lu(k,1797) = lu(k,1797) * lu(k,1788) + lu(k,1798) = lu(k,1798) * lu(k,1788) + lu(k,1799) = lu(k,1799) * lu(k,1788) + lu(k,1800) = lu(k,1800) * lu(k,1788) + lu(k,1801) = lu(k,1801) * lu(k,1788) + lu(k,1832) = lu(k,1832) - lu(k,1789) * lu(k,1831) + lu(k,1833) = lu(k,1833) - lu(k,1790) * lu(k,1831) + lu(k,1834) = lu(k,1834) - lu(k,1791) * lu(k,1831) + lu(k,1835) = lu(k,1835) - lu(k,1792) * lu(k,1831) + lu(k,1836) = lu(k,1836) - lu(k,1793) * lu(k,1831) + lu(k,1837) = lu(k,1837) - lu(k,1794) * lu(k,1831) + lu(k,1838) = lu(k,1838) - lu(k,1795) * lu(k,1831) + lu(k,1839) = lu(k,1839) - lu(k,1796) * lu(k,1831) + lu(k,1840) = lu(k,1840) - lu(k,1797) * lu(k,1831) + lu(k,1841) = lu(k,1841) - lu(k,1798) * lu(k,1831) + lu(k,1842) = lu(k,1842) - lu(k,1799) * lu(k,1831) + lu(k,1843) = lu(k,1843) - lu(k,1800) * lu(k,1831) + lu(k,1844) = lu(k,1844) - lu(k,1801) * lu(k,1831) + lu(k,2005) = lu(k,2005) - lu(k,1789) * lu(k,2004) + lu(k,2006) = lu(k,2006) - lu(k,1790) * lu(k,2004) + lu(k,2007) = lu(k,2007) - lu(k,1791) * lu(k,2004) + lu(k,2008) = lu(k,2008) - lu(k,1792) * lu(k,2004) + lu(k,2009) = lu(k,2009) - lu(k,1793) * lu(k,2004) + lu(k,2010) = lu(k,2010) - lu(k,1794) * lu(k,2004) + lu(k,2011) = lu(k,2011) - lu(k,1795) * lu(k,2004) + lu(k,2012) = lu(k,2012) - lu(k,1796) * lu(k,2004) + lu(k,2013) = lu(k,2013) - lu(k,1797) * lu(k,2004) + lu(k,2014) = lu(k,2014) - lu(k,1798) * lu(k,2004) + lu(k,2015) = lu(k,2015) - lu(k,1799) * lu(k,2004) + lu(k,2016) = lu(k,2016) - lu(k,1800) * lu(k,2004) + lu(k,2017) = lu(k,2017) - lu(k,1801) * lu(k,2004) + lu(k,2065) = lu(k,2065) - lu(k,1789) * lu(k,2064) + lu(k,2066) = lu(k,2066) - lu(k,1790) * lu(k,2064) + lu(k,2067) = lu(k,2067) - lu(k,1791) * lu(k,2064) + lu(k,2068) = lu(k,2068) - lu(k,1792) * lu(k,2064) + lu(k,2069) = lu(k,2069) - lu(k,1793) * lu(k,2064) + lu(k,2070) = lu(k,2070) - lu(k,1794) * lu(k,2064) + lu(k,2071) = lu(k,2071) - lu(k,1795) * lu(k,2064) + lu(k,2072) = lu(k,2072) - lu(k,1796) * lu(k,2064) + lu(k,2073) = lu(k,2073) - lu(k,1797) * lu(k,2064) + lu(k,2074) = lu(k,2074) - lu(k,1798) * lu(k,2064) + lu(k,2075) = lu(k,2075) - lu(k,1799) * lu(k,2064) + lu(k,2076) = lu(k,2076) - lu(k,1800) * lu(k,2064) + lu(k,2077) = lu(k,2077) - lu(k,1801) * lu(k,2064) + lu(k,2090) = lu(k,2090) - lu(k,1789) * lu(k,2089) + lu(k,2091) = lu(k,2091) - lu(k,1790) * lu(k,2089) + lu(k,2092) = lu(k,2092) - lu(k,1791) * lu(k,2089) + lu(k,2093) = lu(k,2093) - lu(k,1792) * lu(k,2089) + lu(k,2094) = lu(k,2094) - lu(k,1793) * lu(k,2089) + lu(k,2095) = lu(k,2095) - lu(k,1794) * lu(k,2089) + lu(k,2096) = lu(k,2096) - lu(k,1795) * lu(k,2089) + lu(k,2097) = lu(k,2097) - lu(k,1796) * lu(k,2089) + lu(k,2098) = lu(k,2098) - lu(k,1797) * lu(k,2089) + lu(k,2099) = lu(k,2099) - lu(k,1798) * lu(k,2089) + lu(k,2100) = lu(k,2100) - lu(k,1799) * lu(k,2089) + lu(k,2101) = lu(k,2101) - lu(k,1800) * lu(k,2089) + lu(k,2102) = lu(k,2102) - lu(k,1801) * lu(k,2089) + lu(k,2210) = lu(k,2210) - lu(k,1789) * lu(k,2209) + lu(k,2211) = lu(k,2211) - lu(k,1790) * lu(k,2209) + lu(k,2212) = lu(k,2212) - lu(k,1791) * lu(k,2209) + lu(k,2213) = lu(k,2213) - lu(k,1792) * lu(k,2209) + lu(k,2214) = lu(k,2214) - lu(k,1793) * lu(k,2209) + lu(k,2215) = lu(k,2215) - lu(k,1794) * lu(k,2209) + lu(k,2216) = lu(k,2216) - lu(k,1795) * lu(k,2209) + lu(k,2217) = lu(k,2217) - lu(k,1796) * lu(k,2209) + lu(k,2218) = lu(k,2218) - lu(k,1797) * lu(k,2209) + lu(k,2219) = lu(k,2219) - lu(k,1798) * lu(k,2209) + lu(k,2220) = lu(k,2220) - lu(k,1799) * lu(k,2209) + lu(k,2221) = lu(k,2221) - lu(k,1800) * lu(k,2209) + lu(k,2222) = lu(k,2222) - lu(k,1801) * lu(k,2209) + lu(k,2256) = lu(k,2256) - lu(k,1789) * lu(k,2255) + lu(k,2257) = lu(k,2257) - lu(k,1790) * lu(k,2255) + lu(k,2258) = lu(k,2258) - lu(k,1791) * lu(k,2255) + lu(k,2259) = lu(k,2259) - lu(k,1792) * lu(k,2255) + lu(k,2260) = lu(k,2260) - lu(k,1793) * lu(k,2255) + lu(k,2261) = lu(k,2261) - lu(k,1794) * lu(k,2255) + lu(k,2262) = lu(k,2262) - lu(k,1795) * lu(k,2255) + lu(k,2263) = lu(k,2263) - lu(k,1796) * lu(k,2255) + lu(k,2264) = lu(k,2264) - lu(k,1797) * lu(k,2255) + lu(k,2265) = lu(k,2265) - lu(k,1798) * lu(k,2255) + lu(k,2266) = lu(k,2266) - lu(k,1799) * lu(k,2255) + lu(k,2267) = lu(k,2267) - lu(k,1800) * lu(k,2255) + lu(k,2268) = lu(k,2268) - lu(k,1801) * lu(k,2255) + lu(k,2277) = lu(k,2277) - lu(k,1789) * lu(k,2276) + lu(k,2278) = lu(k,2278) - lu(k,1790) * lu(k,2276) + lu(k,2279) = lu(k,2279) - lu(k,1791) * lu(k,2276) + lu(k,2280) = lu(k,2280) - lu(k,1792) * lu(k,2276) + lu(k,2281) = lu(k,2281) - lu(k,1793) * lu(k,2276) + lu(k,2282) = lu(k,2282) - lu(k,1794) * lu(k,2276) + lu(k,2283) = lu(k,2283) - lu(k,1795) * lu(k,2276) + lu(k,2284) = lu(k,2284) - lu(k,1796) * lu(k,2276) + lu(k,2285) = lu(k,2285) - lu(k,1797) * lu(k,2276) + lu(k,2286) = lu(k,2286) - lu(k,1798) * lu(k,2276) + lu(k,2287) = lu(k,2287) - lu(k,1799) * lu(k,2276) + lu(k,2288) = lu(k,2288) - lu(k,1800) * lu(k,2276) + lu(k,2289) = lu(k,2289) - lu(k,1801) * lu(k,2276) + lu(k,2300) = lu(k,2300) - lu(k,1789) * lu(k,2299) + lu(k,2301) = lu(k,2301) - lu(k,1790) * lu(k,2299) + lu(k,2302) = lu(k,2302) - lu(k,1791) * lu(k,2299) + lu(k,2303) = lu(k,2303) - lu(k,1792) * lu(k,2299) + lu(k,2304) = lu(k,2304) - lu(k,1793) * lu(k,2299) + lu(k,2305) = lu(k,2305) - lu(k,1794) * lu(k,2299) + lu(k,2306) = lu(k,2306) - lu(k,1795) * lu(k,2299) + lu(k,2307) = lu(k,2307) - lu(k,1796) * lu(k,2299) + lu(k,2308) = lu(k,2308) - lu(k,1797) * lu(k,2299) + lu(k,2309) = lu(k,2309) - lu(k,1798) * lu(k,2299) + lu(k,2310) = lu(k,2310) - lu(k,1799) * lu(k,2299) + lu(k,2311) = lu(k,2311) - lu(k,1800) * lu(k,2299) + lu(k,2312) = lu(k,2312) - lu(k,1801) * lu(k,2299) + lu(k,2352) = lu(k,2352) - lu(k,1789) * lu(k,2351) + lu(k,2353) = lu(k,2353) - lu(k,1790) * lu(k,2351) + lu(k,2354) = lu(k,2354) - lu(k,1791) * lu(k,2351) + lu(k,2355) = lu(k,2355) - lu(k,1792) * lu(k,2351) + lu(k,2356) = lu(k,2356) - lu(k,1793) * lu(k,2351) + lu(k,2357) = lu(k,2357) - lu(k,1794) * lu(k,2351) + lu(k,2358) = lu(k,2358) - lu(k,1795) * lu(k,2351) + lu(k,2359) = lu(k,2359) - lu(k,1796) * lu(k,2351) + lu(k,2360) = lu(k,2360) - lu(k,1797) * lu(k,2351) + lu(k,2361) = lu(k,2361) - lu(k,1798) * lu(k,2351) + lu(k,2362) = lu(k,2362) - lu(k,1799) * lu(k,2351) + lu(k,2363) = lu(k,2363) - lu(k,1800) * lu(k,2351) + lu(k,2364) = lu(k,2364) - lu(k,1801) * lu(k,2351) + lu(k,2416) = lu(k,2416) - lu(k,1789) * lu(k,2415) + lu(k,2417) = lu(k,2417) - lu(k,1790) * lu(k,2415) + lu(k,2418) = lu(k,2418) - lu(k,1791) * lu(k,2415) + lu(k,2419) = lu(k,2419) - lu(k,1792) * lu(k,2415) + lu(k,2420) = lu(k,2420) - lu(k,1793) * lu(k,2415) + lu(k,2421) = lu(k,2421) - lu(k,1794) * lu(k,2415) + lu(k,2422) = lu(k,2422) - lu(k,1795) * lu(k,2415) + lu(k,2423) = lu(k,2423) - lu(k,1796) * lu(k,2415) + lu(k,2424) = lu(k,2424) - lu(k,1797) * lu(k,2415) + lu(k,2425) = lu(k,2425) - lu(k,1798) * lu(k,2415) + lu(k,2426) = lu(k,2426) - lu(k,1799) * lu(k,2415) + lu(k,2427) = lu(k,2427) - lu(k,1800) * lu(k,2415) + lu(k,2428) = lu(k,2428) - lu(k,1801) * lu(k,2415) + lu(k,2459) = lu(k,2459) - lu(k,1789) * lu(k,2458) + lu(k,2460) = lu(k,2460) - lu(k,1790) * lu(k,2458) + lu(k,2461) = lu(k,2461) - lu(k,1791) * lu(k,2458) + lu(k,2462) = lu(k,2462) - lu(k,1792) * lu(k,2458) + lu(k,2463) = lu(k,2463) - lu(k,1793) * lu(k,2458) + lu(k,2464) = lu(k,2464) - lu(k,1794) * lu(k,2458) + lu(k,2465) = lu(k,2465) - lu(k,1795) * lu(k,2458) + lu(k,2466) = lu(k,2466) - lu(k,1796) * lu(k,2458) + lu(k,2467) = lu(k,2467) - lu(k,1797) * lu(k,2458) + lu(k,2468) = lu(k,2468) - lu(k,1798) * lu(k,2458) + lu(k,2469) = lu(k,2469) - lu(k,1799) * lu(k,2458) + lu(k,2470) = lu(k,2470) - lu(k,1800) * lu(k,2458) + lu(k,2471) = lu(k,2471) - lu(k,1801) * lu(k,2458) + lu(k,2485) = lu(k,2485) - lu(k,1789) * lu(k,2484) + lu(k,2486) = lu(k,2486) - lu(k,1790) * lu(k,2484) + lu(k,2487) = lu(k,2487) - lu(k,1791) * lu(k,2484) + lu(k,2488) = lu(k,2488) - lu(k,1792) * lu(k,2484) + lu(k,2489) = lu(k,2489) - lu(k,1793) * lu(k,2484) + lu(k,2490) = lu(k,2490) - lu(k,1794) * lu(k,2484) + lu(k,2491) = lu(k,2491) - lu(k,1795) * lu(k,2484) + lu(k,2492) = lu(k,2492) - lu(k,1796) * lu(k,2484) + lu(k,2493) = lu(k,2493) - lu(k,1797) * lu(k,2484) + lu(k,2494) = lu(k,2494) - lu(k,1798) * lu(k,2484) + lu(k,2495) = lu(k,2495) - lu(k,1799) * lu(k,2484) + lu(k,2496) = lu(k,2496) - lu(k,1800) * lu(k,2484) + lu(k,2497) = lu(k,2497) - lu(k,1801) * lu(k,2484) + lu(k,2512) = lu(k,2512) - lu(k,1789) * lu(k,2511) + lu(k,2513) = lu(k,2513) - lu(k,1790) * lu(k,2511) + lu(k,2514) = lu(k,2514) - lu(k,1791) * lu(k,2511) + lu(k,2515) = lu(k,2515) - lu(k,1792) * lu(k,2511) + lu(k,2516) = lu(k,2516) - lu(k,1793) * lu(k,2511) + lu(k,2517) = lu(k,2517) - lu(k,1794) * lu(k,2511) + lu(k,2518) = lu(k,2518) - lu(k,1795) * lu(k,2511) + lu(k,2519) = lu(k,2519) - lu(k,1796) * lu(k,2511) + lu(k,2520) = lu(k,2520) - lu(k,1797) * lu(k,2511) + lu(k,2521) = lu(k,2521) - lu(k,1798) * lu(k,2511) + lu(k,2522) = lu(k,2522) - lu(k,1799) * lu(k,2511) + lu(k,2523) = lu(k,2523) - lu(k,1800) * lu(k,2511) + lu(k,2524) = lu(k,2524) - lu(k,1801) * lu(k,2511) + lu(k,1832) = 1._r8 / lu(k,1832) + lu(k,1833) = lu(k,1833) * lu(k,1832) + lu(k,1834) = lu(k,1834) * lu(k,1832) + lu(k,1835) = lu(k,1835) * lu(k,1832) + lu(k,1836) = lu(k,1836) * lu(k,1832) + lu(k,1837) = lu(k,1837) * lu(k,1832) + lu(k,1838) = lu(k,1838) * lu(k,1832) + lu(k,1839) = lu(k,1839) * lu(k,1832) + lu(k,1840) = lu(k,1840) * lu(k,1832) + lu(k,1841) = lu(k,1841) * lu(k,1832) + lu(k,1842) = lu(k,1842) * lu(k,1832) + lu(k,1843) = lu(k,1843) * lu(k,1832) + lu(k,1844) = lu(k,1844) * lu(k,1832) + lu(k,2006) = lu(k,2006) - lu(k,1833) * lu(k,2005) + lu(k,2007) = lu(k,2007) - lu(k,1834) * lu(k,2005) + lu(k,2008) = lu(k,2008) - lu(k,1835) * lu(k,2005) + lu(k,2009) = lu(k,2009) - lu(k,1836) * lu(k,2005) + lu(k,2010) = lu(k,2010) - lu(k,1837) * lu(k,2005) + lu(k,2011) = lu(k,2011) - lu(k,1838) * lu(k,2005) + lu(k,2012) = lu(k,2012) - lu(k,1839) * lu(k,2005) + lu(k,2013) = lu(k,2013) - lu(k,1840) * lu(k,2005) + lu(k,2014) = lu(k,2014) - lu(k,1841) * lu(k,2005) + lu(k,2015) = lu(k,2015) - lu(k,1842) * lu(k,2005) + lu(k,2016) = lu(k,2016) - lu(k,1843) * lu(k,2005) + lu(k,2017) = lu(k,2017) - lu(k,1844) * lu(k,2005) + lu(k,2066) = lu(k,2066) - lu(k,1833) * lu(k,2065) + lu(k,2067) = lu(k,2067) - lu(k,1834) * lu(k,2065) + lu(k,2068) = lu(k,2068) - lu(k,1835) * lu(k,2065) + lu(k,2069) = lu(k,2069) - lu(k,1836) * lu(k,2065) + lu(k,2070) = lu(k,2070) - lu(k,1837) * lu(k,2065) + lu(k,2071) = lu(k,2071) - lu(k,1838) * lu(k,2065) + lu(k,2072) = lu(k,2072) - lu(k,1839) * lu(k,2065) + lu(k,2073) = lu(k,2073) - lu(k,1840) * lu(k,2065) + lu(k,2074) = lu(k,2074) - lu(k,1841) * lu(k,2065) + lu(k,2075) = lu(k,2075) - lu(k,1842) * lu(k,2065) + lu(k,2076) = lu(k,2076) - lu(k,1843) * lu(k,2065) + lu(k,2077) = lu(k,2077) - lu(k,1844) * lu(k,2065) + lu(k,2091) = lu(k,2091) - lu(k,1833) * lu(k,2090) + lu(k,2092) = lu(k,2092) - lu(k,1834) * lu(k,2090) + lu(k,2093) = lu(k,2093) - lu(k,1835) * lu(k,2090) + lu(k,2094) = lu(k,2094) - lu(k,1836) * lu(k,2090) + lu(k,2095) = lu(k,2095) - lu(k,1837) * lu(k,2090) + lu(k,2096) = lu(k,2096) - lu(k,1838) * lu(k,2090) + lu(k,2097) = lu(k,2097) - lu(k,1839) * lu(k,2090) + lu(k,2098) = lu(k,2098) - lu(k,1840) * lu(k,2090) + lu(k,2099) = lu(k,2099) - lu(k,1841) * lu(k,2090) + lu(k,2100) = lu(k,2100) - lu(k,1842) * lu(k,2090) + lu(k,2101) = lu(k,2101) - lu(k,1843) * lu(k,2090) + lu(k,2102) = lu(k,2102) - lu(k,1844) * lu(k,2090) + lu(k,2211) = lu(k,2211) - lu(k,1833) * lu(k,2210) + lu(k,2212) = lu(k,2212) - lu(k,1834) * lu(k,2210) + lu(k,2213) = lu(k,2213) - lu(k,1835) * lu(k,2210) + lu(k,2214) = lu(k,2214) - lu(k,1836) * lu(k,2210) + lu(k,2215) = lu(k,2215) - lu(k,1837) * lu(k,2210) + lu(k,2216) = lu(k,2216) - lu(k,1838) * lu(k,2210) + lu(k,2217) = lu(k,2217) - lu(k,1839) * lu(k,2210) + lu(k,2218) = lu(k,2218) - lu(k,1840) * lu(k,2210) + lu(k,2219) = lu(k,2219) - lu(k,1841) * lu(k,2210) + lu(k,2220) = lu(k,2220) - lu(k,1842) * lu(k,2210) + lu(k,2221) = lu(k,2221) - lu(k,1843) * lu(k,2210) + lu(k,2222) = lu(k,2222) - lu(k,1844) * lu(k,2210) + lu(k,2257) = lu(k,2257) - lu(k,1833) * lu(k,2256) + lu(k,2258) = lu(k,2258) - lu(k,1834) * lu(k,2256) + lu(k,2259) = lu(k,2259) - lu(k,1835) * lu(k,2256) + lu(k,2260) = lu(k,2260) - lu(k,1836) * lu(k,2256) + lu(k,2261) = lu(k,2261) - lu(k,1837) * lu(k,2256) + lu(k,2262) = lu(k,2262) - lu(k,1838) * lu(k,2256) + lu(k,2263) = lu(k,2263) - lu(k,1839) * lu(k,2256) + lu(k,2264) = lu(k,2264) - lu(k,1840) * lu(k,2256) + lu(k,2265) = lu(k,2265) - lu(k,1841) * lu(k,2256) + lu(k,2266) = lu(k,2266) - lu(k,1842) * lu(k,2256) + lu(k,2267) = lu(k,2267) - lu(k,1843) * lu(k,2256) + lu(k,2268) = lu(k,2268) - lu(k,1844) * lu(k,2256) + lu(k,2278) = lu(k,2278) - lu(k,1833) * lu(k,2277) + lu(k,2279) = lu(k,2279) - lu(k,1834) * lu(k,2277) + lu(k,2280) = lu(k,2280) - lu(k,1835) * lu(k,2277) + lu(k,2281) = lu(k,2281) - lu(k,1836) * lu(k,2277) + lu(k,2282) = lu(k,2282) - lu(k,1837) * lu(k,2277) + lu(k,2283) = lu(k,2283) - lu(k,1838) * lu(k,2277) + lu(k,2284) = lu(k,2284) - lu(k,1839) * lu(k,2277) + lu(k,2285) = lu(k,2285) - lu(k,1840) * lu(k,2277) + lu(k,2286) = lu(k,2286) - lu(k,1841) * lu(k,2277) + lu(k,2287) = lu(k,2287) - lu(k,1842) * lu(k,2277) + lu(k,2288) = lu(k,2288) - lu(k,1843) * lu(k,2277) + lu(k,2289) = lu(k,2289) - lu(k,1844) * lu(k,2277) + lu(k,2301) = lu(k,2301) - lu(k,1833) * lu(k,2300) + lu(k,2302) = lu(k,2302) - lu(k,1834) * lu(k,2300) + lu(k,2303) = lu(k,2303) - lu(k,1835) * lu(k,2300) + lu(k,2304) = lu(k,2304) - lu(k,1836) * lu(k,2300) + lu(k,2305) = lu(k,2305) - lu(k,1837) * lu(k,2300) + lu(k,2306) = lu(k,2306) - lu(k,1838) * lu(k,2300) + lu(k,2307) = lu(k,2307) - lu(k,1839) * lu(k,2300) + lu(k,2308) = lu(k,2308) - lu(k,1840) * lu(k,2300) + lu(k,2309) = lu(k,2309) - lu(k,1841) * lu(k,2300) + lu(k,2310) = lu(k,2310) - lu(k,1842) * lu(k,2300) + lu(k,2311) = lu(k,2311) - lu(k,1843) * lu(k,2300) + lu(k,2312) = lu(k,2312) - lu(k,1844) * lu(k,2300) + lu(k,2353) = lu(k,2353) - lu(k,1833) * lu(k,2352) + lu(k,2354) = lu(k,2354) - lu(k,1834) * lu(k,2352) + lu(k,2355) = lu(k,2355) - lu(k,1835) * lu(k,2352) + lu(k,2356) = lu(k,2356) - lu(k,1836) * lu(k,2352) + lu(k,2357) = lu(k,2357) - lu(k,1837) * lu(k,2352) + lu(k,2358) = lu(k,2358) - lu(k,1838) * lu(k,2352) + lu(k,2359) = lu(k,2359) - lu(k,1839) * lu(k,2352) + lu(k,2360) = lu(k,2360) - lu(k,1840) * lu(k,2352) + lu(k,2361) = lu(k,2361) - lu(k,1841) * lu(k,2352) + lu(k,2362) = lu(k,2362) - lu(k,1842) * lu(k,2352) + lu(k,2363) = lu(k,2363) - lu(k,1843) * lu(k,2352) + lu(k,2364) = lu(k,2364) - lu(k,1844) * lu(k,2352) + lu(k,2417) = lu(k,2417) - lu(k,1833) * lu(k,2416) + lu(k,2418) = lu(k,2418) - lu(k,1834) * lu(k,2416) + lu(k,2419) = lu(k,2419) - lu(k,1835) * lu(k,2416) + lu(k,2420) = lu(k,2420) - lu(k,1836) * lu(k,2416) + lu(k,2421) = lu(k,2421) - lu(k,1837) * lu(k,2416) + lu(k,2422) = lu(k,2422) - lu(k,1838) * lu(k,2416) + lu(k,2423) = lu(k,2423) - lu(k,1839) * lu(k,2416) + lu(k,2424) = lu(k,2424) - lu(k,1840) * lu(k,2416) + lu(k,2425) = lu(k,2425) - lu(k,1841) * lu(k,2416) + lu(k,2426) = lu(k,2426) - lu(k,1842) * lu(k,2416) + lu(k,2427) = lu(k,2427) - lu(k,1843) * lu(k,2416) + lu(k,2428) = lu(k,2428) - lu(k,1844) * lu(k,2416) + lu(k,2460) = lu(k,2460) - lu(k,1833) * lu(k,2459) + lu(k,2461) = lu(k,2461) - lu(k,1834) * lu(k,2459) + lu(k,2462) = lu(k,2462) - lu(k,1835) * lu(k,2459) + lu(k,2463) = lu(k,2463) - lu(k,1836) * lu(k,2459) + lu(k,2464) = lu(k,2464) - lu(k,1837) * lu(k,2459) + lu(k,2465) = lu(k,2465) - lu(k,1838) * lu(k,2459) + lu(k,2466) = lu(k,2466) - lu(k,1839) * lu(k,2459) + lu(k,2467) = lu(k,2467) - lu(k,1840) * lu(k,2459) + lu(k,2468) = lu(k,2468) - lu(k,1841) * lu(k,2459) + lu(k,2469) = lu(k,2469) - lu(k,1842) * lu(k,2459) + lu(k,2470) = lu(k,2470) - lu(k,1843) * lu(k,2459) + lu(k,2471) = lu(k,2471) - lu(k,1844) * lu(k,2459) + lu(k,2486) = lu(k,2486) - lu(k,1833) * lu(k,2485) + lu(k,2487) = lu(k,2487) - lu(k,1834) * lu(k,2485) + lu(k,2488) = lu(k,2488) - lu(k,1835) * lu(k,2485) + lu(k,2489) = lu(k,2489) - lu(k,1836) * lu(k,2485) + lu(k,2490) = lu(k,2490) - lu(k,1837) * lu(k,2485) + lu(k,2491) = lu(k,2491) - lu(k,1838) * lu(k,2485) + lu(k,2492) = lu(k,2492) - lu(k,1839) * lu(k,2485) + lu(k,2493) = lu(k,2493) - lu(k,1840) * lu(k,2485) + lu(k,2494) = lu(k,2494) - lu(k,1841) * lu(k,2485) + lu(k,2495) = lu(k,2495) - lu(k,1842) * lu(k,2485) + lu(k,2496) = lu(k,2496) - lu(k,1843) * lu(k,2485) + lu(k,2497) = lu(k,2497) - lu(k,1844) * lu(k,2485) + lu(k,2513) = lu(k,2513) - lu(k,1833) * lu(k,2512) + lu(k,2514) = lu(k,2514) - lu(k,1834) * lu(k,2512) + lu(k,2515) = lu(k,2515) - lu(k,1835) * lu(k,2512) + lu(k,2516) = lu(k,2516) - lu(k,1836) * lu(k,2512) + lu(k,2517) = lu(k,2517) - lu(k,1837) * lu(k,2512) + lu(k,2518) = lu(k,2518) - lu(k,1838) * lu(k,2512) + lu(k,2519) = lu(k,2519) - lu(k,1839) * lu(k,2512) + lu(k,2520) = lu(k,2520) - lu(k,1840) * lu(k,2512) + lu(k,2521) = lu(k,2521) - lu(k,1841) * lu(k,2512) + lu(k,2522) = lu(k,2522) - lu(k,1842) * lu(k,2512) + lu(k,2523) = lu(k,2523) - lu(k,1843) * lu(k,2512) + lu(k,2524) = lu(k,2524) - lu(k,1844) * lu(k,2512) + lu(k,2006) = 1._r8 / lu(k,2006) + lu(k,2007) = lu(k,2007) * lu(k,2006) + lu(k,2008) = lu(k,2008) * lu(k,2006) + lu(k,2009) = lu(k,2009) * lu(k,2006) + lu(k,2010) = lu(k,2010) * lu(k,2006) + lu(k,2011) = lu(k,2011) * lu(k,2006) + lu(k,2012) = lu(k,2012) * lu(k,2006) + lu(k,2013) = lu(k,2013) * lu(k,2006) + lu(k,2014) = lu(k,2014) * lu(k,2006) + lu(k,2015) = lu(k,2015) * lu(k,2006) + lu(k,2016) = lu(k,2016) * lu(k,2006) + lu(k,2017) = lu(k,2017) * lu(k,2006) + lu(k,2067) = lu(k,2067) - lu(k,2007) * lu(k,2066) + lu(k,2068) = lu(k,2068) - lu(k,2008) * lu(k,2066) + lu(k,2069) = lu(k,2069) - lu(k,2009) * lu(k,2066) + lu(k,2070) = lu(k,2070) - lu(k,2010) * lu(k,2066) + lu(k,2071) = lu(k,2071) - lu(k,2011) * lu(k,2066) + lu(k,2072) = lu(k,2072) - lu(k,2012) * lu(k,2066) + lu(k,2073) = lu(k,2073) - lu(k,2013) * lu(k,2066) + lu(k,2074) = lu(k,2074) - lu(k,2014) * lu(k,2066) + lu(k,2075) = lu(k,2075) - lu(k,2015) * lu(k,2066) + lu(k,2076) = lu(k,2076) - lu(k,2016) * lu(k,2066) + lu(k,2077) = lu(k,2077) - lu(k,2017) * lu(k,2066) + lu(k,2092) = lu(k,2092) - lu(k,2007) * lu(k,2091) + lu(k,2093) = lu(k,2093) - lu(k,2008) * lu(k,2091) + lu(k,2094) = lu(k,2094) - lu(k,2009) * lu(k,2091) + lu(k,2095) = lu(k,2095) - lu(k,2010) * lu(k,2091) + lu(k,2096) = lu(k,2096) - lu(k,2011) * lu(k,2091) + lu(k,2097) = lu(k,2097) - lu(k,2012) * lu(k,2091) + lu(k,2098) = lu(k,2098) - lu(k,2013) * lu(k,2091) + lu(k,2099) = lu(k,2099) - lu(k,2014) * lu(k,2091) + lu(k,2100) = lu(k,2100) - lu(k,2015) * lu(k,2091) + lu(k,2101) = lu(k,2101) - lu(k,2016) * lu(k,2091) + lu(k,2102) = lu(k,2102) - lu(k,2017) * lu(k,2091) + lu(k,2212) = lu(k,2212) - lu(k,2007) * lu(k,2211) + lu(k,2213) = lu(k,2213) - lu(k,2008) * lu(k,2211) + lu(k,2214) = lu(k,2214) - lu(k,2009) * lu(k,2211) + lu(k,2215) = lu(k,2215) - lu(k,2010) * lu(k,2211) + lu(k,2216) = lu(k,2216) - lu(k,2011) * lu(k,2211) + lu(k,2217) = lu(k,2217) - lu(k,2012) * lu(k,2211) + lu(k,2218) = lu(k,2218) - lu(k,2013) * lu(k,2211) + lu(k,2219) = lu(k,2219) - lu(k,2014) * lu(k,2211) + lu(k,2220) = lu(k,2220) - lu(k,2015) * lu(k,2211) + lu(k,2221) = lu(k,2221) - lu(k,2016) * lu(k,2211) + lu(k,2222) = lu(k,2222) - lu(k,2017) * lu(k,2211) + lu(k,2258) = lu(k,2258) - lu(k,2007) * lu(k,2257) + lu(k,2259) = lu(k,2259) - lu(k,2008) * lu(k,2257) + lu(k,2260) = lu(k,2260) - lu(k,2009) * lu(k,2257) + lu(k,2261) = lu(k,2261) - lu(k,2010) * lu(k,2257) + lu(k,2262) = lu(k,2262) - lu(k,2011) * lu(k,2257) + lu(k,2263) = lu(k,2263) - lu(k,2012) * lu(k,2257) + lu(k,2264) = lu(k,2264) - lu(k,2013) * lu(k,2257) + lu(k,2265) = lu(k,2265) - lu(k,2014) * lu(k,2257) + lu(k,2266) = lu(k,2266) - lu(k,2015) * lu(k,2257) + lu(k,2267) = lu(k,2267) - lu(k,2016) * lu(k,2257) + lu(k,2268) = lu(k,2268) - lu(k,2017) * lu(k,2257) + lu(k,2279) = lu(k,2279) - lu(k,2007) * lu(k,2278) + lu(k,2280) = lu(k,2280) - lu(k,2008) * lu(k,2278) + lu(k,2281) = lu(k,2281) - lu(k,2009) * lu(k,2278) + lu(k,2282) = lu(k,2282) - lu(k,2010) * lu(k,2278) + lu(k,2283) = lu(k,2283) - lu(k,2011) * lu(k,2278) + lu(k,2284) = lu(k,2284) - lu(k,2012) * lu(k,2278) + lu(k,2285) = lu(k,2285) - lu(k,2013) * lu(k,2278) + lu(k,2286) = lu(k,2286) - lu(k,2014) * lu(k,2278) + lu(k,2287) = lu(k,2287) - lu(k,2015) * lu(k,2278) + lu(k,2288) = lu(k,2288) - lu(k,2016) * lu(k,2278) + lu(k,2289) = lu(k,2289) - lu(k,2017) * lu(k,2278) + lu(k,2302) = lu(k,2302) - lu(k,2007) * lu(k,2301) + lu(k,2303) = lu(k,2303) - lu(k,2008) * lu(k,2301) + lu(k,2304) = lu(k,2304) - lu(k,2009) * lu(k,2301) + lu(k,2305) = lu(k,2305) - lu(k,2010) * lu(k,2301) + lu(k,2306) = lu(k,2306) - lu(k,2011) * lu(k,2301) + lu(k,2307) = lu(k,2307) - lu(k,2012) * lu(k,2301) + lu(k,2308) = lu(k,2308) - lu(k,2013) * lu(k,2301) + lu(k,2309) = lu(k,2309) - lu(k,2014) * lu(k,2301) + lu(k,2310) = lu(k,2310) - lu(k,2015) * lu(k,2301) + lu(k,2311) = lu(k,2311) - lu(k,2016) * lu(k,2301) + lu(k,2312) = lu(k,2312) - lu(k,2017) * lu(k,2301) + lu(k,2354) = lu(k,2354) - lu(k,2007) * lu(k,2353) + lu(k,2355) = lu(k,2355) - lu(k,2008) * lu(k,2353) + lu(k,2356) = lu(k,2356) - lu(k,2009) * lu(k,2353) + lu(k,2357) = lu(k,2357) - lu(k,2010) * lu(k,2353) + lu(k,2358) = lu(k,2358) - lu(k,2011) * lu(k,2353) + lu(k,2359) = lu(k,2359) - lu(k,2012) * lu(k,2353) + lu(k,2360) = lu(k,2360) - lu(k,2013) * lu(k,2353) + lu(k,2361) = lu(k,2361) - lu(k,2014) * lu(k,2353) + lu(k,2362) = lu(k,2362) - lu(k,2015) * lu(k,2353) + lu(k,2363) = lu(k,2363) - lu(k,2016) * lu(k,2353) + lu(k,2364) = lu(k,2364) - lu(k,2017) * lu(k,2353) + lu(k,2418) = lu(k,2418) - lu(k,2007) * lu(k,2417) + lu(k,2419) = lu(k,2419) - lu(k,2008) * lu(k,2417) + lu(k,2420) = lu(k,2420) - lu(k,2009) * lu(k,2417) + lu(k,2421) = lu(k,2421) - lu(k,2010) * lu(k,2417) + lu(k,2422) = lu(k,2422) - lu(k,2011) * lu(k,2417) + lu(k,2423) = lu(k,2423) - lu(k,2012) * lu(k,2417) + lu(k,2424) = lu(k,2424) - lu(k,2013) * lu(k,2417) + lu(k,2425) = lu(k,2425) - lu(k,2014) * lu(k,2417) + lu(k,2426) = lu(k,2426) - lu(k,2015) * lu(k,2417) + lu(k,2427) = lu(k,2427) - lu(k,2016) * lu(k,2417) + lu(k,2428) = lu(k,2428) - lu(k,2017) * lu(k,2417) + lu(k,2461) = lu(k,2461) - lu(k,2007) * lu(k,2460) + lu(k,2462) = lu(k,2462) - lu(k,2008) * lu(k,2460) + lu(k,2463) = lu(k,2463) - lu(k,2009) * lu(k,2460) + lu(k,2464) = lu(k,2464) - lu(k,2010) * lu(k,2460) + lu(k,2465) = lu(k,2465) - lu(k,2011) * lu(k,2460) + lu(k,2466) = lu(k,2466) - lu(k,2012) * lu(k,2460) + lu(k,2467) = lu(k,2467) - lu(k,2013) * lu(k,2460) + lu(k,2468) = lu(k,2468) - lu(k,2014) * lu(k,2460) + lu(k,2469) = lu(k,2469) - lu(k,2015) * lu(k,2460) + lu(k,2470) = lu(k,2470) - lu(k,2016) * lu(k,2460) + lu(k,2471) = lu(k,2471) - lu(k,2017) * lu(k,2460) + lu(k,2487) = lu(k,2487) - lu(k,2007) * lu(k,2486) + lu(k,2488) = lu(k,2488) - lu(k,2008) * lu(k,2486) + lu(k,2489) = lu(k,2489) - lu(k,2009) * lu(k,2486) + lu(k,2490) = lu(k,2490) - lu(k,2010) * lu(k,2486) + lu(k,2491) = lu(k,2491) - lu(k,2011) * lu(k,2486) + lu(k,2492) = lu(k,2492) - lu(k,2012) * lu(k,2486) + lu(k,2493) = lu(k,2493) - lu(k,2013) * lu(k,2486) + lu(k,2494) = lu(k,2494) - lu(k,2014) * lu(k,2486) + lu(k,2495) = lu(k,2495) - lu(k,2015) * lu(k,2486) + lu(k,2496) = lu(k,2496) - lu(k,2016) * lu(k,2486) + lu(k,2497) = lu(k,2497) - lu(k,2017) * lu(k,2486) + lu(k,2514) = lu(k,2514) - lu(k,2007) * lu(k,2513) + lu(k,2515) = lu(k,2515) - lu(k,2008) * lu(k,2513) + lu(k,2516) = lu(k,2516) - lu(k,2009) * lu(k,2513) + lu(k,2517) = lu(k,2517) - lu(k,2010) * lu(k,2513) + lu(k,2518) = lu(k,2518) - lu(k,2011) * lu(k,2513) + lu(k,2519) = lu(k,2519) - lu(k,2012) * lu(k,2513) + lu(k,2520) = lu(k,2520) - lu(k,2013) * lu(k,2513) + lu(k,2521) = lu(k,2521) - lu(k,2014) * lu(k,2513) + lu(k,2522) = lu(k,2522) - lu(k,2015) * lu(k,2513) + lu(k,2523) = lu(k,2523) - lu(k,2016) * lu(k,2513) + lu(k,2524) = lu(k,2524) - lu(k,2017) * lu(k,2513) + lu(k,2067) = 1._r8 / lu(k,2067) + lu(k,2068) = lu(k,2068) * lu(k,2067) + lu(k,2069) = lu(k,2069) * lu(k,2067) + lu(k,2070) = lu(k,2070) * lu(k,2067) + lu(k,2071) = lu(k,2071) * lu(k,2067) + lu(k,2072) = lu(k,2072) * lu(k,2067) + lu(k,2073) = lu(k,2073) * lu(k,2067) + lu(k,2074) = lu(k,2074) * lu(k,2067) + lu(k,2075) = lu(k,2075) * lu(k,2067) + lu(k,2076) = lu(k,2076) * lu(k,2067) + lu(k,2077) = lu(k,2077) * lu(k,2067) + lu(k,2093) = lu(k,2093) - lu(k,2068) * lu(k,2092) + lu(k,2094) = lu(k,2094) - lu(k,2069) * lu(k,2092) + lu(k,2095) = lu(k,2095) - lu(k,2070) * lu(k,2092) + lu(k,2096) = lu(k,2096) - lu(k,2071) * lu(k,2092) + lu(k,2097) = lu(k,2097) - lu(k,2072) * lu(k,2092) + lu(k,2098) = lu(k,2098) - lu(k,2073) * lu(k,2092) + lu(k,2099) = lu(k,2099) - lu(k,2074) * lu(k,2092) + lu(k,2100) = lu(k,2100) - lu(k,2075) * lu(k,2092) + lu(k,2101) = lu(k,2101) - lu(k,2076) * lu(k,2092) + lu(k,2102) = lu(k,2102) - lu(k,2077) * lu(k,2092) + lu(k,2213) = lu(k,2213) - lu(k,2068) * lu(k,2212) + lu(k,2214) = lu(k,2214) - lu(k,2069) * lu(k,2212) + lu(k,2215) = lu(k,2215) - lu(k,2070) * lu(k,2212) + lu(k,2216) = lu(k,2216) - lu(k,2071) * lu(k,2212) + lu(k,2217) = lu(k,2217) - lu(k,2072) * lu(k,2212) + lu(k,2218) = lu(k,2218) - lu(k,2073) * lu(k,2212) + lu(k,2219) = lu(k,2219) - lu(k,2074) * lu(k,2212) + lu(k,2220) = lu(k,2220) - lu(k,2075) * lu(k,2212) + lu(k,2221) = lu(k,2221) - lu(k,2076) * lu(k,2212) + lu(k,2222) = lu(k,2222) - lu(k,2077) * lu(k,2212) + lu(k,2259) = lu(k,2259) - lu(k,2068) * lu(k,2258) + lu(k,2260) = lu(k,2260) - lu(k,2069) * lu(k,2258) + lu(k,2261) = lu(k,2261) - lu(k,2070) * lu(k,2258) + lu(k,2262) = lu(k,2262) - lu(k,2071) * lu(k,2258) + lu(k,2263) = lu(k,2263) - lu(k,2072) * lu(k,2258) + lu(k,2264) = lu(k,2264) - lu(k,2073) * lu(k,2258) + lu(k,2265) = lu(k,2265) - lu(k,2074) * lu(k,2258) + lu(k,2266) = lu(k,2266) - lu(k,2075) * lu(k,2258) + lu(k,2267) = lu(k,2267) - lu(k,2076) * lu(k,2258) + lu(k,2268) = lu(k,2268) - lu(k,2077) * lu(k,2258) + lu(k,2280) = lu(k,2280) - lu(k,2068) * lu(k,2279) + lu(k,2281) = lu(k,2281) - lu(k,2069) * lu(k,2279) + lu(k,2282) = lu(k,2282) - lu(k,2070) * lu(k,2279) + lu(k,2283) = lu(k,2283) - lu(k,2071) * lu(k,2279) + lu(k,2284) = lu(k,2284) - lu(k,2072) * lu(k,2279) + lu(k,2285) = lu(k,2285) - lu(k,2073) * lu(k,2279) + lu(k,2286) = lu(k,2286) - lu(k,2074) * lu(k,2279) + lu(k,2287) = lu(k,2287) - lu(k,2075) * lu(k,2279) + lu(k,2288) = lu(k,2288) - lu(k,2076) * lu(k,2279) + lu(k,2289) = lu(k,2289) - lu(k,2077) * lu(k,2279) + lu(k,2303) = lu(k,2303) - lu(k,2068) * lu(k,2302) + lu(k,2304) = lu(k,2304) - lu(k,2069) * lu(k,2302) + lu(k,2305) = lu(k,2305) - lu(k,2070) * lu(k,2302) + lu(k,2306) = lu(k,2306) - lu(k,2071) * lu(k,2302) + lu(k,2307) = lu(k,2307) - lu(k,2072) * lu(k,2302) + lu(k,2308) = lu(k,2308) - lu(k,2073) * lu(k,2302) + lu(k,2309) = lu(k,2309) - lu(k,2074) * lu(k,2302) + lu(k,2310) = lu(k,2310) - lu(k,2075) * lu(k,2302) + lu(k,2311) = lu(k,2311) - lu(k,2076) * lu(k,2302) + lu(k,2312) = lu(k,2312) - lu(k,2077) * lu(k,2302) + lu(k,2355) = lu(k,2355) - lu(k,2068) * lu(k,2354) + lu(k,2356) = lu(k,2356) - lu(k,2069) * lu(k,2354) + lu(k,2357) = lu(k,2357) - lu(k,2070) * lu(k,2354) + lu(k,2358) = lu(k,2358) - lu(k,2071) * lu(k,2354) + lu(k,2359) = lu(k,2359) - lu(k,2072) * lu(k,2354) + lu(k,2360) = lu(k,2360) - lu(k,2073) * lu(k,2354) + lu(k,2361) = lu(k,2361) - lu(k,2074) * lu(k,2354) + lu(k,2362) = lu(k,2362) - lu(k,2075) * lu(k,2354) + lu(k,2363) = lu(k,2363) - lu(k,2076) * lu(k,2354) + lu(k,2364) = lu(k,2364) - lu(k,2077) * lu(k,2354) + lu(k,2419) = lu(k,2419) - lu(k,2068) * lu(k,2418) + lu(k,2420) = lu(k,2420) - lu(k,2069) * lu(k,2418) + lu(k,2421) = lu(k,2421) - lu(k,2070) * lu(k,2418) + lu(k,2422) = lu(k,2422) - lu(k,2071) * lu(k,2418) + lu(k,2423) = lu(k,2423) - lu(k,2072) * lu(k,2418) + lu(k,2424) = lu(k,2424) - lu(k,2073) * lu(k,2418) + lu(k,2425) = lu(k,2425) - lu(k,2074) * lu(k,2418) + lu(k,2426) = lu(k,2426) - lu(k,2075) * lu(k,2418) + lu(k,2427) = lu(k,2427) - lu(k,2076) * lu(k,2418) + lu(k,2428) = lu(k,2428) - lu(k,2077) * lu(k,2418) + lu(k,2462) = lu(k,2462) - lu(k,2068) * lu(k,2461) + lu(k,2463) = lu(k,2463) - lu(k,2069) * lu(k,2461) + lu(k,2464) = lu(k,2464) - lu(k,2070) * lu(k,2461) + lu(k,2465) = lu(k,2465) - lu(k,2071) * lu(k,2461) + lu(k,2466) = lu(k,2466) - lu(k,2072) * lu(k,2461) + lu(k,2467) = lu(k,2467) - lu(k,2073) * lu(k,2461) + lu(k,2468) = lu(k,2468) - lu(k,2074) * lu(k,2461) + lu(k,2469) = lu(k,2469) - lu(k,2075) * lu(k,2461) + lu(k,2470) = lu(k,2470) - lu(k,2076) * lu(k,2461) + lu(k,2471) = lu(k,2471) - lu(k,2077) * lu(k,2461) + lu(k,2488) = lu(k,2488) - lu(k,2068) * lu(k,2487) + lu(k,2489) = lu(k,2489) - lu(k,2069) * lu(k,2487) + lu(k,2490) = lu(k,2490) - lu(k,2070) * lu(k,2487) + lu(k,2491) = lu(k,2491) - lu(k,2071) * lu(k,2487) + lu(k,2492) = lu(k,2492) - lu(k,2072) * lu(k,2487) + lu(k,2493) = lu(k,2493) - lu(k,2073) * lu(k,2487) + lu(k,2494) = lu(k,2494) - lu(k,2074) * lu(k,2487) + lu(k,2495) = lu(k,2495) - lu(k,2075) * lu(k,2487) + lu(k,2496) = lu(k,2496) - lu(k,2076) * lu(k,2487) + lu(k,2497) = lu(k,2497) - lu(k,2077) * lu(k,2487) + lu(k,2515) = lu(k,2515) - lu(k,2068) * lu(k,2514) + lu(k,2516) = lu(k,2516) - lu(k,2069) * lu(k,2514) + lu(k,2517) = lu(k,2517) - lu(k,2070) * lu(k,2514) + lu(k,2518) = lu(k,2518) - lu(k,2071) * lu(k,2514) + lu(k,2519) = lu(k,2519) - lu(k,2072) * lu(k,2514) + lu(k,2520) = lu(k,2520) - lu(k,2073) * lu(k,2514) + lu(k,2521) = lu(k,2521) - lu(k,2074) * lu(k,2514) + lu(k,2522) = lu(k,2522) - lu(k,2075) * lu(k,2514) + lu(k,2523) = lu(k,2523) - lu(k,2076) * lu(k,2514) + lu(k,2524) = lu(k,2524) - lu(k,2077) * lu(k,2514) + lu(k,2093) = 1._r8 / lu(k,2093) + lu(k,2094) = lu(k,2094) * lu(k,2093) + lu(k,2095) = lu(k,2095) * lu(k,2093) + lu(k,2096) = lu(k,2096) * lu(k,2093) + lu(k,2097) = lu(k,2097) * lu(k,2093) + lu(k,2098) = lu(k,2098) * lu(k,2093) + lu(k,2099) = lu(k,2099) * lu(k,2093) + lu(k,2100) = lu(k,2100) * lu(k,2093) + lu(k,2101) = lu(k,2101) * lu(k,2093) + lu(k,2102) = lu(k,2102) * lu(k,2093) + lu(k,2214) = lu(k,2214) - lu(k,2094) * lu(k,2213) + lu(k,2215) = lu(k,2215) - lu(k,2095) * lu(k,2213) + lu(k,2216) = lu(k,2216) - lu(k,2096) * lu(k,2213) + lu(k,2217) = lu(k,2217) - lu(k,2097) * lu(k,2213) + lu(k,2218) = lu(k,2218) - lu(k,2098) * lu(k,2213) + lu(k,2219) = lu(k,2219) - lu(k,2099) * lu(k,2213) + lu(k,2220) = lu(k,2220) - lu(k,2100) * lu(k,2213) + lu(k,2221) = lu(k,2221) - lu(k,2101) * lu(k,2213) + lu(k,2222) = lu(k,2222) - lu(k,2102) * lu(k,2213) + lu(k,2260) = lu(k,2260) - lu(k,2094) * lu(k,2259) + lu(k,2261) = lu(k,2261) - lu(k,2095) * lu(k,2259) + lu(k,2262) = lu(k,2262) - lu(k,2096) * lu(k,2259) + lu(k,2263) = lu(k,2263) - lu(k,2097) * lu(k,2259) + lu(k,2264) = lu(k,2264) - lu(k,2098) * lu(k,2259) + lu(k,2265) = lu(k,2265) - lu(k,2099) * lu(k,2259) + lu(k,2266) = lu(k,2266) - lu(k,2100) * lu(k,2259) + lu(k,2267) = lu(k,2267) - lu(k,2101) * lu(k,2259) + lu(k,2268) = lu(k,2268) - lu(k,2102) * lu(k,2259) + lu(k,2281) = lu(k,2281) - lu(k,2094) * lu(k,2280) + lu(k,2282) = lu(k,2282) - lu(k,2095) * lu(k,2280) + lu(k,2283) = lu(k,2283) - lu(k,2096) * lu(k,2280) + lu(k,2284) = lu(k,2284) - lu(k,2097) * lu(k,2280) + lu(k,2285) = lu(k,2285) - lu(k,2098) * lu(k,2280) + lu(k,2286) = lu(k,2286) - lu(k,2099) * lu(k,2280) + lu(k,2287) = lu(k,2287) - lu(k,2100) * lu(k,2280) + lu(k,2288) = lu(k,2288) - lu(k,2101) * lu(k,2280) + lu(k,2289) = lu(k,2289) - lu(k,2102) * lu(k,2280) + lu(k,2304) = lu(k,2304) - lu(k,2094) * lu(k,2303) + lu(k,2305) = lu(k,2305) - lu(k,2095) * lu(k,2303) + lu(k,2306) = lu(k,2306) - lu(k,2096) * lu(k,2303) + lu(k,2307) = lu(k,2307) - lu(k,2097) * lu(k,2303) + lu(k,2308) = lu(k,2308) - lu(k,2098) * lu(k,2303) + lu(k,2309) = lu(k,2309) - lu(k,2099) * lu(k,2303) + lu(k,2310) = lu(k,2310) - lu(k,2100) * lu(k,2303) + lu(k,2311) = lu(k,2311) - lu(k,2101) * lu(k,2303) + lu(k,2312) = lu(k,2312) - lu(k,2102) * lu(k,2303) + lu(k,2356) = lu(k,2356) - lu(k,2094) * lu(k,2355) + lu(k,2357) = lu(k,2357) - lu(k,2095) * lu(k,2355) + lu(k,2358) = lu(k,2358) - lu(k,2096) * lu(k,2355) + lu(k,2359) = lu(k,2359) - lu(k,2097) * lu(k,2355) + lu(k,2360) = lu(k,2360) - lu(k,2098) * lu(k,2355) + lu(k,2361) = lu(k,2361) - lu(k,2099) * lu(k,2355) + lu(k,2362) = lu(k,2362) - lu(k,2100) * lu(k,2355) + lu(k,2363) = lu(k,2363) - lu(k,2101) * lu(k,2355) + lu(k,2364) = lu(k,2364) - lu(k,2102) * lu(k,2355) + lu(k,2420) = lu(k,2420) - lu(k,2094) * lu(k,2419) + lu(k,2421) = lu(k,2421) - lu(k,2095) * lu(k,2419) + lu(k,2422) = lu(k,2422) - lu(k,2096) * lu(k,2419) + lu(k,2423) = lu(k,2423) - lu(k,2097) * lu(k,2419) + lu(k,2424) = lu(k,2424) - lu(k,2098) * lu(k,2419) + lu(k,2425) = lu(k,2425) - lu(k,2099) * lu(k,2419) + lu(k,2426) = lu(k,2426) - lu(k,2100) * lu(k,2419) + lu(k,2427) = lu(k,2427) - lu(k,2101) * lu(k,2419) + lu(k,2428) = lu(k,2428) - lu(k,2102) * lu(k,2419) + lu(k,2463) = lu(k,2463) - lu(k,2094) * lu(k,2462) + lu(k,2464) = lu(k,2464) - lu(k,2095) * lu(k,2462) + lu(k,2465) = lu(k,2465) - lu(k,2096) * lu(k,2462) + lu(k,2466) = lu(k,2466) - lu(k,2097) * lu(k,2462) + lu(k,2467) = lu(k,2467) - lu(k,2098) * lu(k,2462) + lu(k,2468) = lu(k,2468) - lu(k,2099) * lu(k,2462) + lu(k,2469) = lu(k,2469) - lu(k,2100) * lu(k,2462) + lu(k,2470) = lu(k,2470) - lu(k,2101) * lu(k,2462) + lu(k,2471) = lu(k,2471) - lu(k,2102) * lu(k,2462) + lu(k,2489) = lu(k,2489) - lu(k,2094) * lu(k,2488) + lu(k,2490) = lu(k,2490) - lu(k,2095) * lu(k,2488) + lu(k,2491) = lu(k,2491) - lu(k,2096) * lu(k,2488) + lu(k,2492) = lu(k,2492) - lu(k,2097) * lu(k,2488) + lu(k,2493) = lu(k,2493) - lu(k,2098) * lu(k,2488) + lu(k,2494) = lu(k,2494) - lu(k,2099) * lu(k,2488) + lu(k,2495) = lu(k,2495) - lu(k,2100) * lu(k,2488) + lu(k,2496) = lu(k,2496) - lu(k,2101) * lu(k,2488) + lu(k,2497) = lu(k,2497) - lu(k,2102) * lu(k,2488) + lu(k,2516) = lu(k,2516) - lu(k,2094) * lu(k,2515) + lu(k,2517) = lu(k,2517) - lu(k,2095) * lu(k,2515) + lu(k,2518) = lu(k,2518) - lu(k,2096) * lu(k,2515) + lu(k,2519) = lu(k,2519) - lu(k,2097) * lu(k,2515) + lu(k,2520) = lu(k,2520) - lu(k,2098) * lu(k,2515) + lu(k,2521) = lu(k,2521) - lu(k,2099) * lu(k,2515) + lu(k,2522) = lu(k,2522) - lu(k,2100) * lu(k,2515) + lu(k,2523) = lu(k,2523) - lu(k,2101) * lu(k,2515) + lu(k,2524) = lu(k,2524) - lu(k,2102) * lu(k,2515) + end do + end subroutine lu_fac32 + subroutine lu_fac33( 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,2214) = 1._r8 / lu(k,2214) + lu(k,2215) = lu(k,2215) * lu(k,2214) + lu(k,2216) = lu(k,2216) * lu(k,2214) + lu(k,2217) = lu(k,2217) * lu(k,2214) + lu(k,2218) = lu(k,2218) * lu(k,2214) + lu(k,2219) = lu(k,2219) * lu(k,2214) + lu(k,2220) = lu(k,2220) * lu(k,2214) + lu(k,2221) = lu(k,2221) * lu(k,2214) + lu(k,2222) = lu(k,2222) * lu(k,2214) + lu(k,2261) = lu(k,2261) - lu(k,2215) * lu(k,2260) + lu(k,2262) = lu(k,2262) - lu(k,2216) * lu(k,2260) + lu(k,2263) = lu(k,2263) - lu(k,2217) * lu(k,2260) + lu(k,2264) = lu(k,2264) - lu(k,2218) * lu(k,2260) + lu(k,2265) = lu(k,2265) - lu(k,2219) * lu(k,2260) + lu(k,2266) = lu(k,2266) - lu(k,2220) * lu(k,2260) + lu(k,2267) = lu(k,2267) - lu(k,2221) * lu(k,2260) + lu(k,2268) = lu(k,2268) - lu(k,2222) * lu(k,2260) + lu(k,2282) = lu(k,2282) - lu(k,2215) * lu(k,2281) + lu(k,2283) = lu(k,2283) - lu(k,2216) * lu(k,2281) + lu(k,2284) = lu(k,2284) - lu(k,2217) * lu(k,2281) + lu(k,2285) = lu(k,2285) - lu(k,2218) * lu(k,2281) + lu(k,2286) = lu(k,2286) - lu(k,2219) * lu(k,2281) + lu(k,2287) = lu(k,2287) - lu(k,2220) * lu(k,2281) + lu(k,2288) = lu(k,2288) - lu(k,2221) * lu(k,2281) + lu(k,2289) = lu(k,2289) - lu(k,2222) * lu(k,2281) + lu(k,2305) = lu(k,2305) - lu(k,2215) * lu(k,2304) + lu(k,2306) = lu(k,2306) - lu(k,2216) * lu(k,2304) + lu(k,2307) = lu(k,2307) - lu(k,2217) * lu(k,2304) + lu(k,2308) = lu(k,2308) - lu(k,2218) * lu(k,2304) + lu(k,2309) = lu(k,2309) - lu(k,2219) * lu(k,2304) + lu(k,2310) = lu(k,2310) - lu(k,2220) * lu(k,2304) + lu(k,2311) = lu(k,2311) - lu(k,2221) * lu(k,2304) + lu(k,2312) = lu(k,2312) - lu(k,2222) * lu(k,2304) + lu(k,2357) = lu(k,2357) - lu(k,2215) * lu(k,2356) + lu(k,2358) = lu(k,2358) - lu(k,2216) * lu(k,2356) + lu(k,2359) = lu(k,2359) - lu(k,2217) * lu(k,2356) + lu(k,2360) = lu(k,2360) - lu(k,2218) * lu(k,2356) + lu(k,2361) = lu(k,2361) - lu(k,2219) * lu(k,2356) + lu(k,2362) = lu(k,2362) - lu(k,2220) * lu(k,2356) + lu(k,2363) = lu(k,2363) - lu(k,2221) * lu(k,2356) + lu(k,2364) = lu(k,2364) - lu(k,2222) * lu(k,2356) + lu(k,2421) = lu(k,2421) - lu(k,2215) * lu(k,2420) + lu(k,2422) = lu(k,2422) - lu(k,2216) * lu(k,2420) + lu(k,2423) = lu(k,2423) - lu(k,2217) * lu(k,2420) + lu(k,2424) = lu(k,2424) - lu(k,2218) * lu(k,2420) + lu(k,2425) = lu(k,2425) - lu(k,2219) * lu(k,2420) + lu(k,2426) = lu(k,2426) - lu(k,2220) * lu(k,2420) + lu(k,2427) = lu(k,2427) - lu(k,2221) * lu(k,2420) + lu(k,2428) = lu(k,2428) - lu(k,2222) * lu(k,2420) + lu(k,2464) = lu(k,2464) - lu(k,2215) * lu(k,2463) + lu(k,2465) = lu(k,2465) - lu(k,2216) * lu(k,2463) + lu(k,2466) = lu(k,2466) - lu(k,2217) * lu(k,2463) + lu(k,2467) = lu(k,2467) - lu(k,2218) * lu(k,2463) + lu(k,2468) = lu(k,2468) - lu(k,2219) * lu(k,2463) + lu(k,2469) = lu(k,2469) - lu(k,2220) * lu(k,2463) + lu(k,2470) = lu(k,2470) - lu(k,2221) * lu(k,2463) + lu(k,2471) = lu(k,2471) - lu(k,2222) * lu(k,2463) + lu(k,2490) = lu(k,2490) - lu(k,2215) * lu(k,2489) + lu(k,2491) = lu(k,2491) - lu(k,2216) * lu(k,2489) + lu(k,2492) = lu(k,2492) - lu(k,2217) * lu(k,2489) + lu(k,2493) = lu(k,2493) - lu(k,2218) * lu(k,2489) + lu(k,2494) = lu(k,2494) - lu(k,2219) * lu(k,2489) + lu(k,2495) = lu(k,2495) - lu(k,2220) * lu(k,2489) + lu(k,2496) = lu(k,2496) - lu(k,2221) * lu(k,2489) + lu(k,2497) = lu(k,2497) - lu(k,2222) * lu(k,2489) + lu(k,2517) = lu(k,2517) - lu(k,2215) * lu(k,2516) + lu(k,2518) = lu(k,2518) - lu(k,2216) * lu(k,2516) + lu(k,2519) = lu(k,2519) - lu(k,2217) * lu(k,2516) + lu(k,2520) = lu(k,2520) - lu(k,2218) * lu(k,2516) + lu(k,2521) = lu(k,2521) - lu(k,2219) * lu(k,2516) + lu(k,2522) = lu(k,2522) - lu(k,2220) * lu(k,2516) + lu(k,2523) = lu(k,2523) - lu(k,2221) * lu(k,2516) + lu(k,2524) = lu(k,2524) - lu(k,2222) * lu(k,2516) + lu(k,2261) = 1._r8 / lu(k,2261) + lu(k,2262) = lu(k,2262) * lu(k,2261) + lu(k,2263) = lu(k,2263) * lu(k,2261) + lu(k,2264) = lu(k,2264) * lu(k,2261) + lu(k,2265) = lu(k,2265) * lu(k,2261) + lu(k,2266) = lu(k,2266) * lu(k,2261) + lu(k,2267) = lu(k,2267) * lu(k,2261) + lu(k,2268) = lu(k,2268) * lu(k,2261) + lu(k,2283) = lu(k,2283) - lu(k,2262) * lu(k,2282) + lu(k,2284) = lu(k,2284) - lu(k,2263) * lu(k,2282) + lu(k,2285) = lu(k,2285) - lu(k,2264) * lu(k,2282) + lu(k,2286) = lu(k,2286) - lu(k,2265) * lu(k,2282) + lu(k,2287) = lu(k,2287) - lu(k,2266) * lu(k,2282) + lu(k,2288) = lu(k,2288) - lu(k,2267) * lu(k,2282) + lu(k,2289) = lu(k,2289) - lu(k,2268) * lu(k,2282) + lu(k,2306) = lu(k,2306) - lu(k,2262) * lu(k,2305) + lu(k,2307) = lu(k,2307) - lu(k,2263) * lu(k,2305) + lu(k,2308) = lu(k,2308) - lu(k,2264) * lu(k,2305) + lu(k,2309) = lu(k,2309) - lu(k,2265) * lu(k,2305) + lu(k,2310) = lu(k,2310) - lu(k,2266) * lu(k,2305) + lu(k,2311) = lu(k,2311) - lu(k,2267) * lu(k,2305) + lu(k,2312) = lu(k,2312) - lu(k,2268) * lu(k,2305) + lu(k,2358) = lu(k,2358) - lu(k,2262) * lu(k,2357) + lu(k,2359) = lu(k,2359) - lu(k,2263) * lu(k,2357) + lu(k,2360) = lu(k,2360) - lu(k,2264) * lu(k,2357) + lu(k,2361) = lu(k,2361) - lu(k,2265) * lu(k,2357) + lu(k,2362) = lu(k,2362) - lu(k,2266) * lu(k,2357) + lu(k,2363) = lu(k,2363) - lu(k,2267) * lu(k,2357) + lu(k,2364) = lu(k,2364) - lu(k,2268) * lu(k,2357) + lu(k,2422) = lu(k,2422) - lu(k,2262) * lu(k,2421) + lu(k,2423) = lu(k,2423) - lu(k,2263) * lu(k,2421) + lu(k,2424) = lu(k,2424) - lu(k,2264) * lu(k,2421) + lu(k,2425) = lu(k,2425) - lu(k,2265) * lu(k,2421) + lu(k,2426) = lu(k,2426) - lu(k,2266) * lu(k,2421) + lu(k,2427) = lu(k,2427) - lu(k,2267) * lu(k,2421) + lu(k,2428) = lu(k,2428) - lu(k,2268) * lu(k,2421) + lu(k,2465) = lu(k,2465) - lu(k,2262) * lu(k,2464) + lu(k,2466) = lu(k,2466) - lu(k,2263) * lu(k,2464) + lu(k,2467) = lu(k,2467) - lu(k,2264) * lu(k,2464) + lu(k,2468) = lu(k,2468) - lu(k,2265) * lu(k,2464) + lu(k,2469) = lu(k,2469) - lu(k,2266) * lu(k,2464) + lu(k,2470) = lu(k,2470) - lu(k,2267) * lu(k,2464) + lu(k,2471) = lu(k,2471) - lu(k,2268) * lu(k,2464) + lu(k,2491) = lu(k,2491) - lu(k,2262) * lu(k,2490) + lu(k,2492) = lu(k,2492) - lu(k,2263) * lu(k,2490) + lu(k,2493) = lu(k,2493) - lu(k,2264) * lu(k,2490) + lu(k,2494) = lu(k,2494) - lu(k,2265) * lu(k,2490) + lu(k,2495) = lu(k,2495) - lu(k,2266) * lu(k,2490) + lu(k,2496) = lu(k,2496) - lu(k,2267) * lu(k,2490) + lu(k,2497) = lu(k,2497) - lu(k,2268) * lu(k,2490) + lu(k,2518) = lu(k,2518) - lu(k,2262) * lu(k,2517) + lu(k,2519) = lu(k,2519) - lu(k,2263) * lu(k,2517) + lu(k,2520) = lu(k,2520) - lu(k,2264) * lu(k,2517) + lu(k,2521) = lu(k,2521) - lu(k,2265) * lu(k,2517) + lu(k,2522) = lu(k,2522) - lu(k,2266) * lu(k,2517) + lu(k,2523) = lu(k,2523) - lu(k,2267) * lu(k,2517) + lu(k,2524) = lu(k,2524) - lu(k,2268) * lu(k,2517) + lu(k,2283) = 1._r8 / lu(k,2283) + lu(k,2284) = lu(k,2284) * lu(k,2283) + lu(k,2285) = lu(k,2285) * lu(k,2283) + lu(k,2286) = lu(k,2286) * lu(k,2283) + lu(k,2287) = lu(k,2287) * lu(k,2283) + lu(k,2288) = lu(k,2288) * lu(k,2283) + lu(k,2289) = lu(k,2289) * lu(k,2283) + lu(k,2307) = lu(k,2307) - lu(k,2284) * lu(k,2306) + lu(k,2308) = lu(k,2308) - lu(k,2285) * lu(k,2306) + lu(k,2309) = lu(k,2309) - lu(k,2286) * lu(k,2306) + lu(k,2310) = lu(k,2310) - lu(k,2287) * lu(k,2306) + lu(k,2311) = lu(k,2311) - lu(k,2288) * lu(k,2306) + lu(k,2312) = lu(k,2312) - lu(k,2289) * lu(k,2306) + lu(k,2359) = lu(k,2359) - lu(k,2284) * lu(k,2358) + lu(k,2360) = lu(k,2360) - lu(k,2285) * lu(k,2358) + lu(k,2361) = lu(k,2361) - lu(k,2286) * lu(k,2358) + lu(k,2362) = lu(k,2362) - lu(k,2287) * lu(k,2358) + lu(k,2363) = lu(k,2363) - lu(k,2288) * lu(k,2358) + lu(k,2364) = lu(k,2364) - lu(k,2289) * lu(k,2358) + lu(k,2423) = lu(k,2423) - lu(k,2284) * lu(k,2422) + lu(k,2424) = lu(k,2424) - lu(k,2285) * lu(k,2422) + lu(k,2425) = lu(k,2425) - lu(k,2286) * lu(k,2422) + lu(k,2426) = lu(k,2426) - lu(k,2287) * lu(k,2422) + lu(k,2427) = lu(k,2427) - lu(k,2288) * lu(k,2422) + lu(k,2428) = lu(k,2428) - lu(k,2289) * lu(k,2422) + lu(k,2466) = lu(k,2466) - lu(k,2284) * lu(k,2465) + lu(k,2467) = lu(k,2467) - lu(k,2285) * lu(k,2465) + lu(k,2468) = lu(k,2468) - lu(k,2286) * lu(k,2465) + lu(k,2469) = lu(k,2469) - lu(k,2287) * lu(k,2465) + lu(k,2470) = lu(k,2470) - lu(k,2288) * lu(k,2465) + lu(k,2471) = lu(k,2471) - lu(k,2289) * lu(k,2465) + lu(k,2492) = lu(k,2492) - lu(k,2284) * lu(k,2491) + lu(k,2493) = lu(k,2493) - lu(k,2285) * lu(k,2491) + lu(k,2494) = lu(k,2494) - lu(k,2286) * lu(k,2491) + lu(k,2495) = lu(k,2495) - lu(k,2287) * lu(k,2491) + lu(k,2496) = lu(k,2496) - lu(k,2288) * lu(k,2491) + lu(k,2497) = lu(k,2497) - lu(k,2289) * lu(k,2491) + lu(k,2519) = lu(k,2519) - lu(k,2284) * lu(k,2518) + lu(k,2520) = lu(k,2520) - lu(k,2285) * lu(k,2518) + lu(k,2521) = lu(k,2521) - lu(k,2286) * lu(k,2518) + lu(k,2522) = lu(k,2522) - lu(k,2287) * lu(k,2518) + lu(k,2523) = lu(k,2523) - lu(k,2288) * lu(k,2518) + lu(k,2524) = lu(k,2524) - lu(k,2289) * lu(k,2518) + lu(k,2307) = 1._r8 / lu(k,2307) + lu(k,2308) = lu(k,2308) * lu(k,2307) + lu(k,2309) = lu(k,2309) * lu(k,2307) + lu(k,2310) = lu(k,2310) * lu(k,2307) + lu(k,2311) = lu(k,2311) * lu(k,2307) + lu(k,2312) = lu(k,2312) * lu(k,2307) + lu(k,2360) = lu(k,2360) - lu(k,2308) * lu(k,2359) + lu(k,2361) = lu(k,2361) - lu(k,2309) * lu(k,2359) + lu(k,2362) = lu(k,2362) - lu(k,2310) * lu(k,2359) + lu(k,2363) = lu(k,2363) - lu(k,2311) * lu(k,2359) + lu(k,2364) = lu(k,2364) - lu(k,2312) * lu(k,2359) + lu(k,2424) = lu(k,2424) - lu(k,2308) * lu(k,2423) + lu(k,2425) = lu(k,2425) - lu(k,2309) * lu(k,2423) + lu(k,2426) = lu(k,2426) - lu(k,2310) * lu(k,2423) + lu(k,2427) = lu(k,2427) - lu(k,2311) * lu(k,2423) + lu(k,2428) = lu(k,2428) - lu(k,2312) * lu(k,2423) + lu(k,2467) = lu(k,2467) - lu(k,2308) * lu(k,2466) + lu(k,2468) = lu(k,2468) - lu(k,2309) * lu(k,2466) + lu(k,2469) = lu(k,2469) - lu(k,2310) * lu(k,2466) + lu(k,2470) = lu(k,2470) - lu(k,2311) * lu(k,2466) + lu(k,2471) = lu(k,2471) - lu(k,2312) * lu(k,2466) + lu(k,2493) = lu(k,2493) - lu(k,2308) * lu(k,2492) + lu(k,2494) = lu(k,2494) - lu(k,2309) * lu(k,2492) + lu(k,2495) = lu(k,2495) - lu(k,2310) * lu(k,2492) + lu(k,2496) = lu(k,2496) - lu(k,2311) * lu(k,2492) + lu(k,2497) = lu(k,2497) - lu(k,2312) * lu(k,2492) + lu(k,2520) = lu(k,2520) - lu(k,2308) * lu(k,2519) + lu(k,2521) = lu(k,2521) - lu(k,2309) * lu(k,2519) + lu(k,2522) = lu(k,2522) - lu(k,2310) * lu(k,2519) + lu(k,2523) = lu(k,2523) - lu(k,2311) * lu(k,2519) + lu(k,2524) = lu(k,2524) - lu(k,2312) * lu(k,2519) + lu(k,2360) = 1._r8 / lu(k,2360) + lu(k,2361) = lu(k,2361) * lu(k,2360) + lu(k,2362) = lu(k,2362) * lu(k,2360) + lu(k,2363) = lu(k,2363) * lu(k,2360) + lu(k,2364) = lu(k,2364) * lu(k,2360) + lu(k,2425) = lu(k,2425) - lu(k,2361) * lu(k,2424) + lu(k,2426) = lu(k,2426) - lu(k,2362) * lu(k,2424) + lu(k,2427) = lu(k,2427) - lu(k,2363) * lu(k,2424) + lu(k,2428) = lu(k,2428) - lu(k,2364) * lu(k,2424) + lu(k,2468) = lu(k,2468) - lu(k,2361) * lu(k,2467) + lu(k,2469) = lu(k,2469) - lu(k,2362) * lu(k,2467) + lu(k,2470) = lu(k,2470) - lu(k,2363) * lu(k,2467) + lu(k,2471) = lu(k,2471) - lu(k,2364) * lu(k,2467) + lu(k,2494) = lu(k,2494) - lu(k,2361) * lu(k,2493) + lu(k,2495) = lu(k,2495) - lu(k,2362) * lu(k,2493) + lu(k,2496) = lu(k,2496) - lu(k,2363) * lu(k,2493) + lu(k,2497) = lu(k,2497) - lu(k,2364) * lu(k,2493) + lu(k,2521) = lu(k,2521) - lu(k,2361) * lu(k,2520) + lu(k,2522) = lu(k,2522) - lu(k,2362) * lu(k,2520) + lu(k,2523) = lu(k,2523) - lu(k,2363) * lu(k,2520) + lu(k,2524) = lu(k,2524) - lu(k,2364) * lu(k,2520) + lu(k,2425) = 1._r8 / lu(k,2425) + lu(k,2426) = lu(k,2426) * lu(k,2425) + lu(k,2427) = lu(k,2427) * lu(k,2425) + lu(k,2428) = lu(k,2428) * lu(k,2425) + lu(k,2469) = lu(k,2469) - lu(k,2426) * lu(k,2468) + lu(k,2470) = lu(k,2470) - lu(k,2427) * lu(k,2468) + lu(k,2471) = lu(k,2471) - lu(k,2428) * lu(k,2468) + lu(k,2495) = lu(k,2495) - lu(k,2426) * lu(k,2494) + lu(k,2496) = lu(k,2496) - lu(k,2427) * lu(k,2494) + lu(k,2497) = lu(k,2497) - lu(k,2428) * lu(k,2494) + lu(k,2522) = lu(k,2522) - lu(k,2426) * lu(k,2521) + lu(k,2523) = lu(k,2523) - lu(k,2427) * lu(k,2521) + lu(k,2524) = lu(k,2524) - lu(k,2428) * lu(k,2521) + lu(k,2469) = 1._r8 / lu(k,2469) + lu(k,2470) = lu(k,2470) * lu(k,2469) + lu(k,2471) = lu(k,2471) * lu(k,2469) + lu(k,2496) = lu(k,2496) - lu(k,2470) * lu(k,2495) + lu(k,2497) = lu(k,2497) - lu(k,2471) * lu(k,2495) + lu(k,2523) = lu(k,2523) - lu(k,2470) * lu(k,2522) + lu(k,2524) = lu(k,2524) - lu(k,2471) * lu(k,2522) + lu(k,2496) = 1._r8 / lu(k,2496) + lu(k,2497) = lu(k,2497) * lu(k,2496) + lu(k,2524) = lu(k,2524) - lu(k,2497) * lu(k,2523) + lu(k,2524) = 1._r8 / lu(k,2524) + end do + end subroutine lu_fac33 + 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 ) + call lu_fac19( avec_len, lu ) + call lu_fac20( avec_len, lu ) + call lu_fac21( avec_len, lu ) + call lu_fac22( avec_len, lu ) + call lu_fac23( avec_len, lu ) + call lu_fac24( avec_len, lu ) + call lu_fac25( avec_len, lu ) + call lu_fac26( avec_len, lu ) + call lu_fac27( avec_len, lu ) + call lu_fac28( avec_len, lu ) + call lu_fac29( avec_len, lu ) + call lu_fac30( avec_len, lu ) + call lu_fac31( avec_len, lu ) + call lu_fac32( avec_len, lu ) + call lu_fac33( avec_len, lu ) + end subroutine lu_fac + end module mo_lu_factor diff --git a/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_lu_solve.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_lu_solve.F90 new file mode 100644 index 0000000000..78e24390c0 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_lu_solve.F90 @@ -0,0 +1,2817 @@ + 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,263) = b(k,263) - lu(k,142) * b(k,89) + b(k,274) = b(k,274) - lu(k,143) * b(k,89) + b(k,262) = b(k,262) - lu(k,145) * b(k,90) + b(k,267) = b(k,267) - lu(k,146) * b(k,90) + b(k,263) = b(k,263) - lu(k,148) * b(k,91) + b(k,266) = b(k,266) - lu(k,149) * b(k,91) + b(k,259) = b(k,259) - lu(k,151) * b(k,92) + b(k,267) = b(k,267) - lu(k,152) * b(k,92) + b(k,126) = b(k,126) - lu(k,154) * b(k,93) + b(k,262) = b(k,262) - lu(k,155) * b(k,93) + b(k,267) = b(k,267) - lu(k,156) * b(k,93) + b(k,119) = b(k,119) - lu(k,158) * b(k,94) + b(k,262) = b(k,262) - lu(k,159) * b(k,94) + b(k,267) = b(k,267) - lu(k,160) * b(k,94) + b(k,119) = b(k,119) - lu(k,162) * b(k,95) + b(k,262) = b(k,262) - lu(k,163) * b(k,95) + b(k,267) = b(k,267) - lu(k,164) * b(k,95) + b(k,263) = b(k,263) - lu(k,166) * b(k,96) + b(k,267) = b(k,267) - lu(k,167) * b(k,96) + b(k,274) = b(k,274) - lu(k,168) * b(k,96) + b(k,119) = b(k,119) - lu(k,170) * b(k,97) + b(k,256) = b(k,256) - lu(k,171) * b(k,97) + b(k,262) = b(k,262) - lu(k,172) * b(k,97) + b(k,242) = b(k,242) - lu(k,174) * b(k,98) + b(k,263) = b(k,263) - lu(k,175) * b(k,98) + b(k,129) = b(k,129) - lu(k,177) * b(k,99) + b(k,274) = b(k,274) - lu(k,178) * b(k,99) + b(k,165) = b(k,165) - lu(k,180) * b(k,100) + b(k,263) = b(k,263) - lu(k,181) * b(k,100) + b(k,174) = b(k,174) - lu(k,183) * b(k,101) + b(k,260) = b(k,260) - lu(k,184) * b(k,101) + b(k,119) = b(k,119) - lu(k,186) * b(k,102) + b(k,256) = b(k,256) - lu(k,187) * b(k,102) + b(k,262) = b(k,262) - lu(k,188) * b(k,102) + b(k,267) = b(k,267) - lu(k,189) * b(k,102) + b(k,119) = b(k,119) - lu(k,191) * b(k,103) + b(k,219) = b(k,219) - lu(k,192) * b(k,103) + b(k,256) = b(k,256) - lu(k,193) * b(k,103) + b(k,262) = b(k,262) - lu(k,194) * b(k,103) + b(k,119) = b(k,119) - lu(k,196) * b(k,104) + b(k,126) = b(k,126) - lu(k,197) * b(k,104) + b(k,262) = b(k,262) - lu(k,198) * b(k,104) + b(k,267) = b(k,267) - lu(k,199) * b(k,104) + b(k,119) = b(k,119) - lu(k,201) * b(k,105) + b(k,219) = b(k,219) - lu(k,202) * b(k,105) + b(k,262) = b(k,262) - lu(k,203) * b(k,105) + b(k,267) = b(k,267) - lu(k,204) * b(k,105) + b(k,267) = b(k,267) - lu(k,206) * b(k,106) + b(k,108) = b(k,108) - lu(k,209) * b(k,107) + b(k,109) = b(k,109) - lu(k,210) * b(k,107) + b(k,170) = b(k,170) - lu(k,211) * b(k,107) + b(k,263) = b(k,263) - lu(k,212) * b(k,107) + b(k,266) = b(k,266) - lu(k,213) * b(k,107) + b(k,164) = b(k,164) - lu(k,215) * b(k,108) + b(k,236) = b(k,236) - lu(k,216) * b(k,108) + b(k,266) = b(k,266) - lu(k,217) * b(k,108) + b(k,163) = b(k,163) - lu(k,219) * b(k,109) + b(k,169) = b(k,169) - lu(k,220) * b(k,109) + b(k,263) = b(k,263) - lu(k,221) * b(k,109) + b(k,266) = b(k,266) - lu(k,222) * b(k,109) + b(k,257) = b(k,257) - lu(k,224) * b(k,110) + b(k,257) = b(k,257) - lu(k,227) * b(k,111) + b(k,113) = b(k,113) - lu(k,230) * b(k,112) + b(k,114) = b(k,114) - lu(k,231) * b(k,112) + b(k,160) = b(k,160) - lu(k,232) * b(k,112) + b(k,201) = b(k,201) - lu(k,233) * b(k,112) + b(k,263) = b(k,263) - lu(k,234) * b(k,112) + b(k,266) = b(k,266) - lu(k,235) * b(k,112) + b(k,163) = b(k,163) - lu(k,237) * b(k,113) + b(k,169) = b(k,169) - lu(k,238) * b(k,113) + b(k,263) = b(k,263) - lu(k,239) * b(k,113) + b(k,266) = b(k,266) - lu(k,240) * b(k,113) + b(k,236) = b(k,236) - lu(k,242) * b(k,114) + b(k,251) = b(k,251) - lu(k,243) * b(k,114) + b(k,266) = b(k,266) - lu(k,244) * b(k,114) + b(k,242) = b(k,242) - lu(k,246) * b(k,115) + b(k,263) = b(k,263) - lu(k,247) * b(k,115) + b(k,262) = b(k,262) - lu(k,249) * b(k,116) + b(k,263) = b(k,263) - lu(k,250) * b(k,116) + b(k,266) = b(k,266) - lu(k,251) * b(k,116) + b(k,118) = b(k,118) - lu(k,255) * b(k,117) + b(k,160) = b(k,160) - lu(k,256) * b(k,117) + b(k,202) = b(k,202) - lu(k,257) * b(k,117) + b(k,236) = b(k,236) - lu(k,258) * b(k,117) + b(k,251) = b(k,251) - lu(k,259) * b(k,117) + b(k,263) = b(k,263) - lu(k,260) * b(k,117) + b(k,266) = b(k,266) - lu(k,261) * b(k,117) + b(k,169) = b(k,169) - lu(k,263) * b(k,118) + b(k,172) = b(k,172) - lu(k,264) * b(k,118) + b(k,263) = b(k,263) - lu(k,265) * b(k,118) + b(k,266) = b(k,266) - lu(k,266) * b(k,118) + b(k,219) = b(k,219) - lu(k,268) * b(k,119) + b(k,262) = b(k,262) - lu(k,269) * b(k,119) + b(k,226) = b(k,226) - lu(k,271) * b(k,120) + b(k,263) = b(k,263) - lu(k,272) * b(k,120) + b(k,256) = b(k,256) - lu(k,274) * b(k,121) + b(k,267) = b(k,267) - lu(k,275) * b(k,121) + b(k,260) = b(k,260) - lu(k,277) * b(k,122) + b(k,269) = b(k,269) - lu(k,278) * b(k,122) + b(k,174) = b(k,174) - lu(k,280) * b(k,123) + b(k,263) = b(k,263) - lu(k,281) * b(k,123) + b(k,188) = b(k,188) - lu(k,283) * b(k,124) + b(k,242) = b(k,242) - lu(k,284) * b(k,124) + b(k,263) = b(k,263) - lu(k,285) * b(k,124) + b(k,266) = b(k,266) - lu(k,286) * b(k,124) + b(k,126) = b(k,126) - lu(k,288) * b(k,125) + b(k,262) = b(k,262) - lu(k,289) * b(k,125) + b(k,263) = b(k,263) - lu(k,290) * b(k,125) + b(k,267) = b(k,267) - lu(k,291) * b(k,125) + b(k,219) = b(k,219) - lu(k,293) * b(k,126) + b(k,262) = b(k,262) - lu(k,294) * b(k,126) + b(k,267) = b(k,267) - lu(k,295) * b(k,126) + b(k,219) = b(k,219) - lu(k,298) * b(k,127) + b(k,262) = b(k,262) - lu(k,299) * b(k,127) + b(k,263) = b(k,263) - lu(k,300) * b(k,127) + b(k,267) = b(k,267) - lu(k,301) * b(k,127) + b(k,257) = b(k,257) - lu(k,303) * b(k,128) + b(k,261) = b(k,261) - lu(k,304) * b(k,128) + b(k,262) = b(k,262) - lu(k,305) * b(k,128) + b(k,221) = b(k,221) - lu(k,308) * b(k,129) + b(k,272) = b(k,272) - lu(k,309) * b(k,129) + b(k,274) = b(k,274) - lu(k,310) * b(k,129) + b(k,235) = b(k,235) - lu(k,312) * b(k,130) + b(k,263) = b(k,263) - lu(k,313) * b(k,130) + b(k,266) = b(k,266) - lu(k,314) * b(k,130) + b(k,169) = b(k,169) - lu(k,316) * b(k,131) + b(k,190) = b(k,190) - lu(k,317) * b(k,131) + b(k,263) = b(k,263) - lu(k,318) * b(k,131) + b(k,260) = b(k,260) - lu(k,320) * b(k,132) + b(k,261) = b(k,261) - lu(k,321) * b(k,132) + b(k,264) = b(k,264) - lu(k,322) * b(k,132) + b(k,269) = b(k,269) - lu(k,323) * b(k,132) + b(k,272) = b(k,272) - lu(k,324) * b(k,132) + b(k,216) = b(k,216) - lu(k,326) * b(k,133) + b(k,227) = b(k,227) - lu(k,327) * b(k,133) + b(k,236) = b(k,236) - lu(k,328) * b(k,133) + b(k,263) = b(k,263) - lu(k,329) * b(k,133) + b(k,266) = b(k,266) - lu(k,330) * b(k,133) + b(k,203) = b(k,203) - lu(k,332) * b(k,134) + b(k,266) = b(k,266) - lu(k,333) * b(k,134) + b(k,217) = b(k,217) - lu(k,335) * b(k,135) + b(k,255) = b(k,255) - lu(k,336) * b(k,135) + b(k,263) = b(k,263) - lu(k,337) * b(k,135) + b(k,267) = b(k,267) - lu(k,338) * b(k,135) + b(k,274) = b(k,274) - lu(k,339) * b(k,135) + b(k,220) = b(k,220) - lu(k,341) * b(k,136) + b(k,255) = b(k,255) - lu(k,342) * b(k,136) + b(k,263) = b(k,263) - lu(k,343) * b(k,136) + b(k,267) = b(k,267) - lu(k,344) * b(k,136) + b(k,274) = b(k,274) - lu(k,345) * b(k,136) + b(k,219) = b(k,219) - lu(k,347) * b(k,137) + b(k,268) = b(k,268) - lu(k,348) * b(k,137) + b(k,221) = b(k,221) - lu(k,350) * b(k,138) + b(k,263) = b(k,263) - lu(k,351) * b(k,138) + b(k,264) = b(k,264) - lu(k,352) * b(k,138) + b(k,266) = b(k,266) - lu(k,353) * b(k,138) + b(k,269) = b(k,269) - lu(k,354) * b(k,138) + b(k,219) = b(k,219) - lu(k,357) * b(k,139) + b(k,262) = b(k,262) - lu(k,358) * b(k,139) + b(k,263) = b(k,263) - lu(k,359) * b(k,139) + b(k,267) = b(k,267) - lu(k,360) * b(k,139) + b(k,274) = b(k,274) - lu(k,361) * b(k,139) + b(k,221) = b(k,221) - lu(k,363) * b(k,140) + b(k,254) = b(k,254) - lu(k,364) * b(k,140) + b(k,259) = b(k,259) - lu(k,365) * b(k,140) + b(k,272) = b(k,272) - lu(k,366) * b(k,140) + b(k,163) = b(k,163) - lu(k,368) * b(k,141) + b(k,227) = b(k,227) - lu(k,369) * b(k,141) + b(k,263) = b(k,263) - lu(k,370) * b(k,141) + b(k,266) = b(k,266) - lu(k,371) * b(k,141) + b(k,160) = b(k,160) - lu(k,374) * b(k,142) + b(k,174) = b(k,174) - lu(k,375) * b(k,142) + b(k,263) = b(k,263) - lu(k,376) * b(k,142) + b(k,266) = b(k,266) - lu(k,377) * b(k,142) + b(k,217) = b(k,217) - lu(k,379) * b(k,143) + b(k,235) = b(k,235) - lu(k,380) * b(k,143) + b(k,263) = b(k,263) - lu(k,381) * b(k,143) + b(k,266) = b(k,266) - lu(k,382) * b(k,143) + b(k,236) = b(k,236) - lu(k,384) * b(k,144) + b(k,245) = b(k,245) - lu(k,385) * b(k,144) + b(k,251) = b(k,251) - lu(k,386) * b(k,144) + b(k,266) = b(k,266) - lu(k,387) * b(k,144) + b(k,193) = b(k,193) - lu(k,389) * b(k,145) + b(k,235) = b(k,235) - lu(k,390) * b(k,145) + b(k,251) = b(k,251) - lu(k,391) * b(k,145) + b(k,263) = b(k,263) - lu(k,392) * b(k,145) + b(k,248) = b(k,248) - lu(k,394) * b(k,146) + b(k,250) = b(k,250) - lu(k,395) * b(k,146) + b(k,263) = b(k,263) - lu(k,396) * b(k,146) + b(k,266) = b(k,266) - lu(k,397) * b(k,146) + b(k,242) = b(k,242) - lu(k,399) * b(k,147) + b(k,263) = b(k,263) - lu(k,400) * b(k,147) + b(k,236) = b(k,236) - lu(k,402) * b(k,148) + b(k,255) = b(k,255) - lu(k,403) * b(k,148) + b(k,263) = b(k,263) - lu(k,404) * b(k,148) + b(k,266) = b(k,266) - lu(k,405) * b(k,148) + b(k,267) = b(k,267) - lu(k,406) * b(k,148) + b(k,270) = b(k,270) - lu(k,407) * b(k,148) + b(k,274) = b(k,274) - lu(k,408) * b(k,148) + b(k,180) = b(k,180) - lu(k,410) * b(k,149) + b(k,230) = b(k,230) - lu(k,411) * b(k,149) + b(k,235) = b(k,235) - lu(k,412) * b(k,149) + b(k,260) = b(k,260) - lu(k,413) * b(k,149) + b(k,263) = b(k,263) - lu(k,414) * b(k,149) + b(k,264) = b(k,264) - lu(k,415) * b(k,149) + b(k,273) = b(k,273) - lu(k,416) * b(k,149) + 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,199) = b(k,199) - lu(k,418) * b(k,150) + b(k,221) = b(k,221) - lu(k,419) * b(k,150) + b(k,236) = b(k,236) - lu(k,420) * b(k,150) + b(k,254) = b(k,254) - lu(k,421) * b(k,150) + b(k,263) = b(k,263) - lu(k,422) * b(k,150) + b(k,268) = b(k,268) - lu(k,423) * b(k,150) + b(k,272) = b(k,272) - lu(k,424) * b(k,150) + b(k,241) = b(k,241) - lu(k,426) * b(k,151) + b(k,251) = b(k,251) - lu(k,427) * b(k,151) + b(k,263) = b(k,263) - lu(k,428) * b(k,151) + b(k,273) = b(k,273) - lu(k,429) * b(k,151) + b(k,274) = b(k,274) - lu(k,430) * b(k,151) + b(k,229) = b(k,229) - lu(k,432) * b(k,152) + b(k,232) = b(k,232) - lu(k,433) * b(k,152) + b(k,260) = b(k,260) - lu(k,434) * b(k,152) + b(k,263) = b(k,263) - lu(k,435) * b(k,152) + b(k,269) = b(k,269) - lu(k,436) * b(k,152) + b(k,220) = b(k,220) - lu(k,438) * b(k,153) + b(k,230) = b(k,230) - lu(k,439) * b(k,153) + b(k,263) = b(k,263) - lu(k,440) * b(k,153) + b(k,266) = b(k,266) - lu(k,441) * b(k,153) + b(k,274) = b(k,274) - lu(k,442) * b(k,153) + b(k,197) = b(k,197) - lu(k,444) * b(k,154) + b(k,215) = b(k,215) - lu(k,445) * b(k,154) + b(k,260) = b(k,260) - lu(k,446) * b(k,154) + b(k,263) = b(k,263) - lu(k,447) * b(k,154) + b(k,266) = b(k,266) - lu(k,448) * b(k,154) + b(k,164) = b(k,164) - lu(k,450) * b(k,155) + b(k,170) = b(k,170) - lu(k,451) * b(k,155) + b(k,227) = b(k,227) - lu(k,452) * b(k,155) + b(k,263) = b(k,263) - lu(k,453) * b(k,155) + b(k,266) = b(k,266) - lu(k,454) * b(k,155) + b(k,263) = b(k,263) - lu(k,456) * b(k,156) + b(k,268) = b(k,268) - lu(k,457) * b(k,156) + b(k,270) = b(k,270) - lu(k,458) * b(k,156) + b(k,273) = b(k,273) - lu(k,459) * b(k,156) + b(k,274) = b(k,274) - lu(k,460) * b(k,156) + b(k,255) = b(k,255) - lu(k,462) * b(k,157) + b(k,256) = b(k,256) - lu(k,463) * b(k,157) + b(k,262) = b(k,262) - lu(k,464) * b(k,157) + b(k,263) = b(k,263) - lu(k,465) * b(k,157) + b(k,267) = b(k,267) - lu(k,466) * b(k,157) + b(k,227) = b(k,227) - lu(k,468) * b(k,158) + b(k,236) = b(k,236) - lu(k,469) * b(k,158) + b(k,245) = b(k,245) - lu(k,470) * b(k,158) + b(k,251) = b(k,251) - lu(k,471) * b(k,158) + b(k,266) = b(k,266) - lu(k,472) * b(k,158) + b(k,172) = b(k,172) - lu(k,474) * b(k,159) + b(k,227) = b(k,227) - lu(k,475) * b(k,159) + b(k,245) = b(k,245) - lu(k,476) * b(k,159) + b(k,263) = b(k,263) - lu(k,477) * b(k,159) + b(k,266) = b(k,266) - lu(k,478) * b(k,159) + b(k,174) = b(k,174) - lu(k,482) * b(k,160) + b(k,260) = b(k,260) - lu(k,483) * b(k,160) + b(k,261) = b(k,261) - lu(k,484) * b(k,160) + b(k,263) = b(k,263) - lu(k,485) * b(k,160) + b(k,266) = b(k,266) - lu(k,486) * b(k,160) + b(k,216) = b(k,216) - lu(k,488) * b(k,161) + b(k,260) = b(k,260) - lu(k,489) * b(k,161) + b(k,261) = b(k,261) - lu(k,490) * b(k,161) + b(k,266) = b(k,266) - lu(k,491) * b(k,161) + b(k,273) = b(k,273) - lu(k,492) * b(k,161) + b(k,215) = b(k,215) - lu(k,494) * b(k,162) + b(k,237) = b(k,237) - lu(k,495) * b(k,162) + b(k,263) = b(k,263) - lu(k,496) * b(k,162) + b(k,266) = b(k,266) - lu(k,497) * b(k,162) + b(k,269) = b(k,269) - lu(k,498) * b(k,162) + b(k,227) = b(k,227) - lu(k,501) * b(k,163) + b(k,260) = b(k,260) - lu(k,502) * b(k,163) + b(k,261) = b(k,261) - lu(k,503) * b(k,163) + b(k,263) = b(k,263) - lu(k,504) * b(k,163) + b(k,266) = b(k,266) - lu(k,505) * b(k,163) + b(k,200) = b(k,200) - lu(k,507) * b(k,164) + b(k,266) = b(k,266) - lu(k,508) * b(k,164) + b(k,237) = b(k,237) - lu(k,510) * b(k,165) + b(k,257) = b(k,257) - lu(k,511) * b(k,165) + b(k,266) = b(k,266) - lu(k,512) * b(k,165) + b(k,273) = b(k,273) - lu(k,513) * b(k,165) + b(k,255) = b(k,255) - lu(k,515) * b(k,166) + b(k,256) = b(k,256) - lu(k,516) * b(k,166) + b(k,262) = b(k,262) - lu(k,517) * b(k,166) + b(k,263) = b(k,263) - lu(k,518) * b(k,166) + b(k,267) = b(k,267) - lu(k,519) * b(k,166) + b(k,274) = b(k,274) - lu(k,520) * b(k,166) + b(k,257) = b(k,257) - lu(k,522) * b(k,167) + b(k,260) = b(k,260) - lu(k,523) * b(k,167) + b(k,263) = b(k,263) - lu(k,524) * b(k,167) + b(k,264) = b(k,264) - lu(k,525) * b(k,167) + b(k,266) = b(k,266) - lu(k,526) * b(k,167) + b(k,274) = b(k,274) - lu(k,527) * b(k,167) + b(k,228) = b(k,228) - lu(k,529) * b(k,168) + b(k,229) = b(k,229) - lu(k,530) * b(k,168) + b(k,230) = b(k,230) - lu(k,531) * b(k,168) + b(k,263) = b(k,263) - lu(k,532) * b(k,168) + b(k,266) = b(k,266) - lu(k,533) * b(k,168) + b(k,273) = b(k,273) - lu(k,534) * b(k,168) + b(k,190) = b(k,190) - lu(k,536) * b(k,169) + b(k,260) = b(k,260) - lu(k,537) * b(k,169) + b(k,271) = b(k,271) - lu(k,538) * b(k,169) + b(k,200) = b(k,200) - lu(k,542) * b(k,170) + b(k,227) = b(k,227) - lu(k,543) * b(k,170) + b(k,260) = b(k,260) - lu(k,544) * b(k,170) + b(k,261) = b(k,261) - lu(k,545) * b(k,170) + b(k,263) = b(k,263) - lu(k,546) * b(k,170) + b(k,266) = b(k,266) - lu(k,547) * b(k,170) + b(k,206) = b(k,206) - lu(k,549) * b(k,171) + b(k,211) = b(k,211) - lu(k,550) * b(k,171) + b(k,212) = b(k,212) - lu(k,551) * b(k,171) + b(k,224) = b(k,224) - lu(k,552) * b(k,171) + b(k,257) = b(k,257) - lu(k,553) * b(k,171) + b(k,272) = b(k,272) - lu(k,554) * b(k,171) + b(k,227) = b(k,227) - lu(k,557) * b(k,172) + b(k,245) = b(k,245) - lu(k,558) * b(k,172) + b(k,260) = b(k,260) - lu(k,559) * b(k,172) + b(k,261) = b(k,261) - lu(k,560) * b(k,172) + b(k,263) = b(k,263) - lu(k,561) * b(k,172) + b(k,266) = b(k,266) - lu(k,562) * b(k,172) + b(k,193) = b(k,193) - lu(k,564) * b(k,173) + b(k,217) = b(k,217) - lu(k,565) * b(k,173) + b(k,251) = b(k,251) - lu(k,566) * b(k,173) + b(k,263) = b(k,263) - lu(k,567) * b(k,173) + b(k,190) = b(k,190) - lu(k,570) * b(k,174) + b(k,260) = b(k,260) - lu(k,571) * b(k,174) + b(k,261) = b(k,261) - lu(k,572) * b(k,174) + b(k,263) = b(k,263) - lu(k,573) * b(k,174) + b(k,266) = b(k,266) - lu(k,574) * b(k,174) + b(k,224) = b(k,224) - lu(k,576) * b(k,175) + b(k,257) = b(k,257) - lu(k,577) * b(k,175) + b(k,261) = b(k,261) - lu(k,578) * b(k,175) + b(k,262) = b(k,262) - lu(k,579) * b(k,175) + b(k,251) = b(k,251) - lu(k,581) * b(k,176) + b(k,252) = b(k,252) - lu(k,582) * b(k,176) + b(k,260) = b(k,260) - lu(k,583) * b(k,176) + b(k,263) = b(k,263) - lu(k,584) * b(k,176) + b(k,264) = b(k,264) - lu(k,585) * b(k,176) + b(k,270) = b(k,270) - lu(k,586) * b(k,176) + b(k,273) = b(k,273) - lu(k,587) * b(k,176) + b(k,208) = b(k,208) - lu(k,589) * b(k,177) + b(k,235) = b(k,235) - lu(k,590) * b(k,177) + b(k,240) = b(k,240) - lu(k,591) * b(k,177) + b(k,263) = b(k,263) - lu(k,592) * b(k,177) + b(k,266) = b(k,266) - lu(k,593) * b(k,177) + b(k,273) = b(k,273) - lu(k,594) * b(k,177) + b(k,274) = b(k,274) - lu(k,595) * b(k,177) + b(k,215) = b(k,215) - lu(k,597) * b(k,178) + b(k,237) = b(k,237) - lu(k,598) * b(k,178) + b(k,239) = b(k,239) - lu(k,599) * b(k,178) + b(k,240) = b(k,240) - lu(k,600) * b(k,178) + b(k,263) = b(k,263) - lu(k,601) * b(k,178) + b(k,266) = b(k,266) - lu(k,602) * b(k,178) + b(k,269) = b(k,269) - lu(k,603) * b(k,178) + b(k,205) = b(k,205) - lu(k,605) * b(k,179) + b(k,256) = b(k,256) - lu(k,606) * b(k,179) + b(k,258) = b(k,258) - lu(k,607) * b(k,179) + b(k,260) = b(k,260) - lu(k,608) * b(k,179) + b(k,264) = b(k,264) - lu(k,609) * b(k,179) + b(k,269) = b(k,269) - lu(k,610) * b(k,179) + b(k,272) = b(k,272) - lu(k,611) * b(k,179) + b(k,230) = b(k,230) - lu(k,613) * b(k,180) + b(k,235) = b(k,235) - lu(k,614) * b(k,180) + b(k,239) = b(k,239) - lu(k,615) * b(k,180) + b(k,260) = b(k,260) - lu(k,616) * b(k,180) + b(k,261) = b(k,261) - lu(k,617) * b(k,180) + b(k,266) = b(k,266) - lu(k,618) * b(k,180) + b(k,273) = b(k,273) - lu(k,619) * b(k,180) + b(k,204) = b(k,204) - lu(k,621) * b(k,181) + b(k,216) = b(k,216) - lu(k,622) * b(k,181) + b(k,236) = b(k,236) - lu(k,623) * b(k,181) + b(k,263) = b(k,263) - lu(k,624) * b(k,181) + b(k,266) = b(k,266) - lu(k,625) * b(k,181) + b(k,271) = b(k,271) - lu(k,626) * b(k,181) + b(k,273) = b(k,273) - lu(k,627) * b(k,181) + b(k,255) = b(k,255) - lu(k,629) * b(k,182) + b(k,256) = b(k,256) - lu(k,630) * b(k,182) + b(k,262) = b(k,262) - lu(k,631) * b(k,182) + b(k,263) = b(k,263) - lu(k,632) * b(k,182) + b(k,266) = b(k,266) - lu(k,633) * b(k,182) + b(k,267) = b(k,267) - lu(k,634) * b(k,182) + b(k,270) = b(k,270) - lu(k,635) * b(k,182) + b(k,274) = b(k,274) - lu(k,636) * b(k,182) + b(k,251) = b(k,251) - lu(k,638) * b(k,183) + b(k,252) = b(k,252) - lu(k,639) * b(k,183) + b(k,263) = b(k,263) - lu(k,640) * b(k,183) + b(k,270) = b(k,270) - lu(k,641) * b(k,183) + b(k,273) = b(k,273) - lu(k,642) * b(k,183) + b(k,274) = b(k,274) - lu(k,643) * b(k,183) + b(k,255) = b(k,255) - lu(k,645) * b(k,184) + b(k,263) = b(k,263) - lu(k,646) * b(k,184) + b(k,266) = b(k,266) - lu(k,647) * b(k,184) + b(k,267) = b(k,267) - lu(k,648) * b(k,184) + b(k,272) = b(k,272) - lu(k,649) * b(k,184) + b(k,274) = b(k,274) - lu(k,650) * b(k,184) + b(k,237) = b(k,237) - lu(k,652) * b(k,185) + b(k,239) = b(k,239) - lu(k,653) * b(k,185) + b(k,240) = b(k,240) - lu(k,654) * b(k,185) + b(k,260) = b(k,260) - lu(k,655) * b(k,185) + b(k,263) = b(k,263) - lu(k,656) * b(k,185) + b(k,266) = b(k,266) - lu(k,657) * b(k,185) + b(k,269) = b(k,269) - lu(k,658) * b(k,185) + b(k,273) = b(k,273) - lu(k,659) * b(k,185) + b(k,188) = b(k,188) - lu(k,663) * b(k,186) + b(k,200) = b(k,200) - lu(k,664) * b(k,186) + b(k,201) = b(k,201) - lu(k,665) * b(k,186) + b(k,203) = b(k,203) - lu(k,666) * b(k,186) + b(k,227) = b(k,227) - lu(k,667) * b(k,186) + b(k,245) = b(k,245) - lu(k,668) * b(k,186) + b(k,263) = b(k,263) - lu(k,669) * b(k,186) + b(k,266) = b(k,266) - lu(k,670) * b(k,186) + 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,240) = b(k,240) - lu(k,672) * b(k,187) + b(k,250) = b(k,250) - lu(k,673) * b(k,187) + b(k,252) = b(k,252) - lu(k,674) * b(k,187) + b(k,260) = b(k,260) - lu(k,675) * b(k,187) + b(k,263) = b(k,263) - lu(k,676) * b(k,187) + b(k,264) = b(k,264) - lu(k,677) * b(k,187) + b(k,266) = b(k,266) - lu(k,678) * b(k,187) + b(k,273) = b(k,273) - lu(k,679) * b(k,187) + b(k,218) = b(k,218) - lu(k,681) * b(k,188) + b(k,236) = b(k,236) - lu(k,682) * b(k,188) + b(k,266) = b(k,266) - lu(k,683) * b(k,188) + b(k,229) = b(k,229) - lu(k,685) * b(k,189) + b(k,260) = b(k,260) - lu(k,686) * b(k,189) + b(k,263) = b(k,263) - lu(k,687) * b(k,189) + b(k,266) = b(k,266) - lu(k,688) * b(k,189) + b(k,269) = b(k,269) - lu(k,689) * b(k,189) + b(k,260) = b(k,260) - lu(k,693) * b(k,190) + b(k,261) = b(k,261) - lu(k,694) * b(k,190) + b(k,263) = b(k,263) - lu(k,695) * b(k,190) + b(k,266) = b(k,266) - lu(k,696) * b(k,190) + b(k,271) = b(k,271) - lu(k,697) * b(k,190) + b(k,193) = b(k,193) - lu(k,700) * b(k,191) + b(k,217) = b(k,217) - lu(k,701) * b(k,191) + b(k,230) = b(k,230) - lu(k,702) * b(k,191) + b(k,235) = b(k,235) - lu(k,703) * b(k,191) + b(k,251) = b(k,251) - lu(k,704) * b(k,191) + b(k,260) = b(k,260) - lu(k,705) * b(k,191) + b(k,263) = b(k,263) - lu(k,706) * b(k,191) + b(k,266) = b(k,266) - lu(k,707) * b(k,191) + b(k,273) = b(k,273) - lu(k,708) * b(k,191) + b(k,193) = b(k,193) - lu(k,711) * b(k,192) + b(k,217) = b(k,217) - lu(k,712) * b(k,192) + b(k,226) = b(k,226) - lu(k,713) * b(k,192) + b(k,230) = b(k,230) - lu(k,714) * b(k,192) + b(k,235) = b(k,235) - lu(k,715) * b(k,192) + b(k,251) = b(k,251) - lu(k,716) * b(k,192) + b(k,263) = b(k,263) - lu(k,717) * b(k,192) + b(k,266) = b(k,266) - lu(k,718) * b(k,192) + b(k,273) = b(k,273) - lu(k,719) * b(k,192) + b(k,235) = b(k,235) - lu(k,722) * b(k,193) + b(k,251) = b(k,251) - lu(k,723) * b(k,193) + b(k,260) = b(k,260) - lu(k,724) * b(k,193) + b(k,261) = b(k,261) - lu(k,725) * b(k,193) + b(k,263) = b(k,263) - lu(k,726) * b(k,193) + b(k,266) = b(k,266) - lu(k,727) * b(k,193) + b(k,230) = b(k,230) - lu(k,729) * b(k,194) + b(k,233) = b(k,233) - lu(k,730) * b(k,194) + b(k,236) = b(k,236) - lu(k,731) * b(k,194) + b(k,237) = b(k,237) - lu(k,732) * b(k,194) + b(k,238) = b(k,238) - lu(k,733) * b(k,194) + b(k,252) = b(k,252) - lu(k,734) * b(k,194) + b(k,263) = b(k,263) - lu(k,735) * b(k,194) + b(k,266) = b(k,266) - lu(k,736) * b(k,194) + b(k,273) = b(k,273) - lu(k,737) * b(k,194) + b(k,206) = b(k,206) - lu(k,740) * b(k,195) + b(k,211) = b(k,211) - lu(k,741) * b(k,195) + b(k,212) = b(k,212) - lu(k,742) * b(k,195) + b(k,213) = b(k,213) - lu(k,743) * b(k,195) + b(k,224) = b(k,224) - lu(k,744) * b(k,195) + b(k,257) = b(k,257) - lu(k,745) * b(k,195) + b(k,261) = b(k,261) - lu(k,746) * b(k,195) + b(k,262) = b(k,262) - lu(k,747) * b(k,195) + b(k,272) = b(k,272) - lu(k,748) * b(k,195) + b(k,252) = b(k,252) - lu(k,750) * b(k,196) + b(k,263) = b(k,263) - lu(k,751) * b(k,196) + b(k,270) = b(k,270) - lu(k,752) * b(k,196) + b(k,274) = b(k,274) - lu(k,753) * b(k,196) + b(k,242) = b(k,242) - lu(k,756) * b(k,197) + b(k,244) = b(k,244) - lu(k,757) * b(k,197) + b(k,249) = b(k,249) - lu(k,758) * b(k,197) + b(k,263) = b(k,263) - lu(k,759) * b(k,197) + b(k,266) = b(k,266) - lu(k,760) * b(k,197) + b(k,273) = b(k,273) - lu(k,761) * b(k,197) + b(k,200) = b(k,200) - lu(k,767) * b(k,198) + b(k,202) = b(k,202) - lu(k,768) * b(k,198) + b(k,203) = b(k,203) - lu(k,769) * b(k,198) + b(k,218) = b(k,218) - lu(k,770) * b(k,198) + b(k,227) = b(k,227) - lu(k,771) * b(k,198) + b(k,236) = b(k,236) - lu(k,772) * b(k,198) + b(k,245) = b(k,245) - lu(k,773) * b(k,198) + b(k,251) = b(k,251) - lu(k,774) * b(k,198) + b(k,263) = b(k,263) - lu(k,775) * b(k,198) + b(k,266) = b(k,266) - lu(k,776) * b(k,198) + b(k,254) = b(k,254) - lu(k,778) * b(k,199) + b(k,257) = b(k,257) - lu(k,779) * b(k,199) + b(k,263) = b(k,263) - lu(k,780) * b(k,199) + b(k,268) = b(k,268) - lu(k,781) * b(k,199) + b(k,271) = b(k,271) - lu(k,782) * b(k,199) + b(k,272) = b(k,272) - lu(k,783) * b(k,199) + b(k,227) = b(k,227) - lu(k,785) * b(k,200) + b(k,236) = b(k,236) - lu(k,786) * b(k,200) + b(k,260) = b(k,260) - lu(k,787) * b(k,200) + b(k,261) = b(k,261) - lu(k,788) * b(k,200) + b(k,266) = b(k,266) - lu(k,789) * b(k,200) + b(k,203) = b(k,203) - lu(k,796) * b(k,201) + b(k,218) = b(k,218) - lu(k,797) * b(k,201) + b(k,227) = b(k,227) - lu(k,798) * b(k,201) + b(k,236) = b(k,236) - lu(k,799) * b(k,201) + b(k,245) = b(k,245) - lu(k,800) * b(k,201) + b(k,260) = b(k,260) - lu(k,801) * b(k,201) + b(k,261) = b(k,261) - lu(k,802) * b(k,201) + b(k,263) = b(k,263) - lu(k,803) * b(k,201) + b(k,266) = b(k,266) - lu(k,804) * b(k,201) + b(k,203) = b(k,203) - lu(k,812) * b(k,202) + b(k,218) = b(k,218) - lu(k,813) * b(k,202) + b(k,227) = b(k,227) - lu(k,814) * b(k,202) + b(k,236) = b(k,236) - lu(k,815) * b(k,202) + b(k,245) = b(k,245) - lu(k,816) * b(k,202) + b(k,251) = b(k,251) - lu(k,817) * b(k,202) + b(k,260) = b(k,260) - lu(k,818) * b(k,202) + b(k,261) = b(k,261) - lu(k,819) * b(k,202) + b(k,263) = b(k,263) - lu(k,820) * b(k,202) + b(k,266) = b(k,266) - lu(k,821) * b(k,202) + b(k,236) = b(k,236) - lu(k,823) * b(k,203) + b(k,245) = b(k,245) - lu(k,824) * b(k,203) + b(k,260) = b(k,260) - lu(k,825) * b(k,203) + b(k,261) = b(k,261) - lu(k,826) * b(k,203) + b(k,263) = b(k,263) - lu(k,827) * b(k,203) + b(k,266) = b(k,266) - lu(k,828) * b(k,203) + b(k,270) = b(k,270) - lu(k,829) * b(k,203) + b(k,237) = b(k,237) - lu(k,833) * b(k,204) + b(k,257) = b(k,257) - lu(k,834) * b(k,204) + b(k,260) = b(k,260) - lu(k,835) * b(k,204) + b(k,261) = b(k,261) - lu(k,836) * b(k,204) + b(k,263) = b(k,263) - lu(k,837) * b(k,204) + b(k,266) = b(k,266) - lu(k,838) * b(k,204) + b(k,273) = b(k,273) - lu(k,839) * b(k,204) + b(k,255) = b(k,255) - lu(k,842) * b(k,205) + b(k,256) = b(k,256) - lu(k,843) * b(k,205) + b(k,258) = b(k,258) - lu(k,844) * b(k,205) + b(k,263) = b(k,263) - lu(k,845) * b(k,205) + b(k,267) = b(k,267) - lu(k,846) * b(k,205) + b(k,272) = b(k,272) - lu(k,847) * b(k,205) + b(k,274) = b(k,274) - lu(k,848) * b(k,205) + b(k,211) = b(k,211) - lu(k,850) * b(k,206) + b(k,212) = b(k,212) - lu(k,851) * b(k,206) + b(k,224) = b(k,224) - lu(k,852) * b(k,206) + b(k,236) = b(k,236) - lu(k,853) * b(k,206) + b(k,252) = b(k,252) - lu(k,854) * b(k,206) + b(k,257) = b(k,257) - lu(k,855) * b(k,206) + b(k,272) = b(k,272) - lu(k,856) * b(k,206) + b(k,263) = b(k,263) - lu(k,858) * b(k,207) + b(k,266) = b(k,266) - lu(k,859) * b(k,207) + b(k,273) = b(k,273) - lu(k,860) * b(k,207) + b(k,235) = b(k,235) - lu(k,863) * b(k,208) + b(k,240) = b(k,240) - lu(k,864) * b(k,208) + b(k,257) = b(k,257) - lu(k,865) * b(k,208) + b(k,260) = b(k,260) - lu(k,866) * b(k,208) + b(k,261) = b(k,261) - lu(k,867) * b(k,208) + b(k,263) = b(k,263) - lu(k,868) * b(k,208) + b(k,266) = b(k,266) - lu(k,869) * b(k,208) + b(k,273) = b(k,273) - lu(k,870) * b(k,208) + b(k,274) = b(k,274) - lu(k,871) * b(k,208) + b(k,255) = b(k,255) - lu(k,874) * b(k,209) + b(k,259) = b(k,259) - lu(k,875) * b(k,209) + b(k,263) = b(k,263) - lu(k,876) * b(k,209) + b(k,267) = b(k,267) - lu(k,877) * b(k,209) + b(k,272) = b(k,272) - lu(k,878) * b(k,209) + b(k,274) = b(k,274) - lu(k,879) * b(k,209) + b(k,256) = b(k,256) - lu(k,881) * b(k,210) + b(k,258) = b(k,258) - lu(k,882) * b(k,210) + b(k,262) = b(k,262) - lu(k,883) * b(k,210) + b(k,263) = b(k,263) - lu(k,884) * b(k,210) + b(k,268) = b(k,268) - lu(k,885) * b(k,210) + b(k,272) = b(k,272) - lu(k,886) * b(k,210) + b(k,274) = b(k,274) - lu(k,887) * b(k,210) + b(k,213) = b(k,213) - lu(k,890) * b(k,211) + b(k,224) = b(k,224) - lu(k,891) * b(k,211) + b(k,257) = b(k,257) - lu(k,892) * b(k,211) + b(k,261) = b(k,261) - lu(k,893) * b(k,211) + b(k,262) = b(k,262) - lu(k,894) * b(k,211) + b(k,272) = b(k,272) - lu(k,895) * b(k,211) + b(k,213) = b(k,213) - lu(k,898) * b(k,212) + b(k,224) = b(k,224) - lu(k,899) * b(k,212) + b(k,257) = b(k,257) - lu(k,900) * b(k,212) + b(k,261) = b(k,261) - lu(k,901) * b(k,212) + b(k,262) = b(k,262) - lu(k,902) * b(k,212) + b(k,272) = b(k,272) - lu(k,903) * b(k,212) + b(k,224) = b(k,224) - lu(k,910) * b(k,213) + b(k,236) = b(k,236) - lu(k,911) * b(k,213) + b(k,252) = b(k,252) - lu(k,912) * b(k,213) + b(k,257) = b(k,257) - lu(k,913) * b(k,213) + b(k,261) = b(k,261) - lu(k,914) * b(k,213) + b(k,262) = b(k,262) - lu(k,915) * b(k,213) + b(k,272) = b(k,272) - lu(k,916) * b(k,213) + b(k,216) = b(k,216) - lu(k,921) * b(k,214) + b(k,234) = b(k,234) - lu(k,922) * b(k,214) + b(k,236) = b(k,236) - lu(k,923) * b(k,214) + b(k,243) = b(k,243) - lu(k,924) * b(k,214) + b(k,244) = b(k,244) - lu(k,925) * b(k,214) + b(k,246) = b(k,246) - lu(k,926) * b(k,214) + b(k,247) = b(k,247) - lu(k,927) * b(k,214) + b(k,249) = b(k,249) - lu(k,928) * b(k,214) + b(k,251) = b(k,251) - lu(k,929) * b(k,214) + b(k,263) = b(k,263) - lu(k,930) * b(k,214) + b(k,264) = b(k,264) - lu(k,931) * b(k,214) + b(k,266) = b(k,266) - lu(k,932) * b(k,214) + b(k,270) = b(k,270) - lu(k,933) * b(k,214) + b(k,271) = b(k,271) - lu(k,934) * b(k,214) + b(k,273) = b(k,273) - lu(k,935) * b(k,214) + b(k,245) = b(k,245) - lu(k,937) * b(k,215) + b(k,251) = b(k,251) - lu(k,938) * b(k,215) + b(k,260) = b(k,260) - lu(k,939) * b(k,215) + b(k,263) = b(k,263) - lu(k,940) * b(k,215) + b(k,273) = b(k,273) - lu(k,941) * b(k,215) + 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,252) = b(k,252) - lu(k,943) * b(k,216) + b(k,263) = b(k,263) - lu(k,944) * b(k,216) + b(k,266) = b(k,266) - lu(k,945) * b(k,216) + b(k,274) = b(k,274) - lu(k,946) * b(k,216) + b(k,235) = b(k,235) - lu(k,951) * b(k,217) + b(k,257) = b(k,257) - lu(k,952) * b(k,217) + b(k,260) = b(k,260) - lu(k,953) * b(k,217) + b(k,261) = b(k,261) - lu(k,954) * b(k,217) + b(k,263) = b(k,263) - lu(k,955) * b(k,217) + b(k,266) = b(k,266) - lu(k,956) * b(k,217) + b(k,270) = b(k,270) - lu(k,957) * b(k,217) + b(k,273) = b(k,273) - lu(k,958) * b(k,217) + b(k,227) = b(k,227) - lu(k,960) * b(k,218) + b(k,236) = b(k,236) - lu(k,961) * b(k,218) + b(k,245) = b(k,245) - lu(k,962) * b(k,218) + b(k,260) = b(k,260) - lu(k,963) * b(k,218) + b(k,261) = b(k,261) - lu(k,964) * b(k,218) + b(k,263) = b(k,263) - lu(k,965) * b(k,218) + b(k,266) = b(k,266) - lu(k,966) * b(k,218) + b(k,270) = b(k,270) - lu(k,967) * b(k,218) + b(k,253) = b(k,253) - lu(k,970) * b(k,219) + b(k,263) = b(k,263) - lu(k,971) * b(k,219) + b(k,264) = b(k,264) - lu(k,972) * b(k,219) + b(k,265) = b(k,265) - lu(k,973) * b(k,219) + b(k,268) = b(k,268) - lu(k,974) * b(k,219) + b(k,269) = b(k,269) - lu(k,975) * b(k,219) + b(k,270) = b(k,270) - lu(k,976) * b(k,219) + b(k,274) = b(k,274) - lu(k,977) * b(k,219) + b(k,230) = b(k,230) - lu(k,980) * b(k,220) + b(k,235) = b(k,235) - lu(k,981) * b(k,220) + b(k,257) = b(k,257) - lu(k,982) * b(k,220) + b(k,260) = b(k,260) - lu(k,983) * b(k,220) + b(k,261) = b(k,261) - lu(k,984) * b(k,220) + b(k,263) = b(k,263) - lu(k,985) * b(k,220) + b(k,266) = b(k,266) - lu(k,986) * b(k,220) + b(k,270) = b(k,270) - lu(k,987) * b(k,220) + b(k,273) = b(k,273) - lu(k,988) * b(k,220) + b(k,274) = b(k,274) - lu(k,989) * b(k,220) + b(k,254) = b(k,254) - lu(k,992) * b(k,221) + b(k,263) = b(k,263) - lu(k,993) * b(k,221) + b(k,266) = b(k,266) - lu(k,994) * b(k,221) + b(k,272) = b(k,272) - lu(k,995) * b(k,221) + b(k,274) = b(k,274) - lu(k,996) * b(k,221) + b(k,226) = b(k,226) - lu(k,1007) * b(k,222) + b(k,227) = b(k,227) - lu(k,1008) * b(k,222) + b(k,228) = b(k,228) - lu(k,1009) * b(k,222) + b(k,229) = b(k,229) - lu(k,1010) * b(k,222) + b(k,230) = b(k,230) - lu(k,1011) * b(k,222) + b(k,232) = b(k,232) - lu(k,1012) * b(k,222) + b(k,233) = b(k,233) - lu(k,1013) * b(k,222) + b(k,236) = b(k,236) - lu(k,1014) * b(k,222) + b(k,241) = b(k,241) - lu(k,1015) * b(k,222) + b(k,245) = b(k,245) - lu(k,1016) * b(k,222) + b(k,251) = b(k,251) - lu(k,1017) * b(k,222) + b(k,252) = b(k,252) - lu(k,1018) * b(k,222) + b(k,263) = b(k,263) - lu(k,1019) * b(k,222) + b(k,264) = b(k,264) - lu(k,1020) * b(k,222) + b(k,266) = b(k,266) - lu(k,1021) * b(k,222) + b(k,271) = b(k,271) - lu(k,1022) * b(k,222) + b(k,273) = b(k,273) - lu(k,1023) * b(k,222) + b(k,274) = b(k,274) - lu(k,1024) * b(k,222) + b(k,255) = b(k,255) - lu(k,1028) * b(k,223) + b(k,259) = b(k,259) - lu(k,1029) * b(k,223) + b(k,260) = b(k,260) - lu(k,1030) * b(k,223) + b(k,263) = b(k,263) - lu(k,1031) * b(k,223) + b(k,264) = b(k,264) - lu(k,1032) * b(k,223) + b(k,267) = b(k,267) - lu(k,1033) * b(k,223) + b(k,269) = b(k,269) - lu(k,1034) * b(k,223) + b(k,272) = b(k,272) - lu(k,1035) * b(k,223) + b(k,274) = b(k,274) - lu(k,1036) * b(k,223) + b(k,236) = b(k,236) - lu(k,1044) * b(k,224) + b(k,252) = b(k,252) - lu(k,1045) * b(k,224) + b(k,257) = b(k,257) - lu(k,1046) * b(k,224) + b(k,260) = b(k,260) - lu(k,1047) * b(k,224) + b(k,261) = b(k,261) - lu(k,1048) * b(k,224) + b(k,262) = b(k,262) - lu(k,1049) * b(k,224) + b(k,263) = b(k,263) - lu(k,1050) * b(k,224) + b(k,268) = b(k,268) - lu(k,1051) * b(k,224) + b(k,272) = b(k,272) - lu(k,1052) * b(k,224) + b(k,226) = b(k,226) - lu(k,1063) * b(k,225) + b(k,227) = b(k,227) - lu(k,1064) * b(k,225) + b(k,228) = b(k,228) - lu(k,1065) * b(k,225) + b(k,229) = b(k,229) - lu(k,1066) * b(k,225) + b(k,230) = b(k,230) - lu(k,1067) * b(k,225) + b(k,232) = b(k,232) - lu(k,1068) * b(k,225) + b(k,233) = b(k,233) - lu(k,1069) * b(k,225) + b(k,236) = b(k,236) - lu(k,1070) * b(k,225) + b(k,241) = b(k,241) - lu(k,1071) * b(k,225) + b(k,245) = b(k,245) - lu(k,1072) * b(k,225) + b(k,251) = b(k,251) - lu(k,1073) * b(k,225) + b(k,252) = b(k,252) - lu(k,1074) * b(k,225) + b(k,263) = b(k,263) - lu(k,1075) * b(k,225) + b(k,264) = b(k,264) - lu(k,1076) * b(k,225) + b(k,266) = b(k,266) - lu(k,1077) * b(k,225) + b(k,271) = b(k,271) - lu(k,1078) * b(k,225) + b(k,273) = b(k,273) - lu(k,1079) * b(k,225) + b(k,274) = b(k,274) - lu(k,1080) * b(k,225) + b(k,230) = b(k,230) - lu(k,1087) * b(k,226) + b(k,235) = b(k,235) - lu(k,1088) * b(k,226) + b(k,251) = b(k,251) - lu(k,1089) * b(k,226) + b(k,257) = b(k,257) - lu(k,1090) * b(k,226) + b(k,260) = b(k,260) - lu(k,1091) * b(k,226) + b(k,261) = b(k,261) - lu(k,1092) * b(k,226) + b(k,263) = b(k,263) - lu(k,1093) * b(k,226) + b(k,266) = b(k,266) - lu(k,1094) * b(k,226) + b(k,270) = b(k,270) - lu(k,1095) * b(k,226) + b(k,273) = b(k,273) - lu(k,1096) * b(k,226) + b(k,236) = b(k,236) - lu(k,1099) * b(k,227) + b(k,252) = b(k,252) - lu(k,1100) * b(k,227) + b(k,263) = b(k,263) - lu(k,1101) * b(k,227) + b(k,266) = b(k,266) - lu(k,1102) * b(k,227) + b(k,229) = b(k,229) - lu(k,1107) * b(k,228) + b(k,230) = b(k,230) - lu(k,1108) * b(k,228) + b(k,260) = b(k,260) - lu(k,1109) * b(k,228) + b(k,261) = b(k,261) - lu(k,1110) * b(k,228) + b(k,263) = b(k,263) - lu(k,1111) * b(k,228) + b(k,266) = b(k,266) - lu(k,1112) * b(k,228) + b(k,269) = b(k,269) - lu(k,1113) * b(k,228) + b(k,270) = b(k,270) - lu(k,1114) * b(k,228) + b(k,273) = b(k,273) - lu(k,1115) * b(k,228) + b(k,232) = b(k,232) - lu(k,1117) * b(k,229) + b(k,233) = b(k,233) - lu(k,1118) * b(k,229) + b(k,236) = b(k,236) - lu(k,1119) * b(k,229) + b(k,238) = b(k,238) - lu(k,1120) * b(k,229) + b(k,263) = b(k,263) - lu(k,1121) * b(k,229) + b(k,264) = b(k,264) - lu(k,1122) * b(k,229) + b(k,266) = b(k,266) - lu(k,1123) * b(k,229) + b(k,241) = b(k,241) - lu(k,1125) * b(k,230) + b(k,251) = b(k,251) - lu(k,1126) * b(k,230) + b(k,263) = b(k,263) - lu(k,1127) * b(k,230) + b(k,270) = b(k,270) - lu(k,1128) * b(k,230) + b(k,274) = b(k,274) - lu(k,1129) * b(k,230) + b(k,236) = b(k,236) - lu(k,1135) * b(k,231) + b(k,245) = b(k,245) - lu(k,1136) * b(k,231) + b(k,251) = b(k,251) - lu(k,1137) * b(k,231) + b(k,252) = b(k,252) - lu(k,1138) * b(k,231) + b(k,260) = b(k,260) - lu(k,1139) * b(k,231) + b(k,261) = b(k,261) - lu(k,1140) * b(k,231) + b(k,263) = b(k,263) - lu(k,1141) * b(k,231) + b(k,266) = b(k,266) - lu(k,1142) * b(k,231) + b(k,269) = b(k,269) - lu(k,1143) * b(k,231) + b(k,270) = b(k,270) - lu(k,1144) * b(k,231) + b(k,273) = b(k,273) - lu(k,1145) * b(k,231) + b(k,233) = b(k,233) - lu(k,1151) * b(k,232) + b(k,236) = b(k,236) - lu(k,1152) * b(k,232) + b(k,238) = b(k,238) - lu(k,1153) * b(k,232) + b(k,260) = b(k,260) - lu(k,1154) * b(k,232) + b(k,261) = b(k,261) - lu(k,1155) * b(k,232) + b(k,263) = b(k,263) - lu(k,1156) * b(k,232) + b(k,264) = b(k,264) - lu(k,1157) * b(k,232) + b(k,266) = b(k,266) - lu(k,1158) * b(k,232) + b(k,269) = b(k,269) - lu(k,1159) * b(k,232) + b(k,270) = b(k,270) - lu(k,1160) * b(k,232) + b(k,273) = b(k,273) - lu(k,1161) * b(k,232) + b(k,236) = b(k,236) - lu(k,1164) * b(k,233) + b(k,241) = b(k,241) - lu(k,1165) * b(k,233) + b(k,251) = b(k,251) - lu(k,1166) * b(k,233) + b(k,252) = b(k,252) - lu(k,1167) * b(k,233) + b(k,263) = b(k,263) - lu(k,1168) * b(k,233) + b(k,266) = b(k,266) - lu(k,1169) * b(k,233) + b(k,270) = b(k,270) - lu(k,1170) * b(k,233) + b(k,273) = b(k,273) - lu(k,1171) * b(k,233) + b(k,274) = b(k,274) - lu(k,1172) * b(k,233) + b(k,235) = b(k,235) - lu(k,1178) * b(k,234) + b(k,236) = b(k,236) - lu(k,1179) * b(k,234) + b(k,240) = b(k,240) - lu(k,1180) * b(k,234) + b(k,245) = b(k,245) - lu(k,1181) * b(k,234) + b(k,251) = b(k,251) - lu(k,1182) * b(k,234) + b(k,252) = b(k,252) - lu(k,1183) * b(k,234) + b(k,257) = b(k,257) - lu(k,1184) * b(k,234) + b(k,260) = b(k,260) - lu(k,1185) * b(k,234) + b(k,261) = b(k,261) - lu(k,1186) * b(k,234) + b(k,263) = b(k,263) - lu(k,1187) * b(k,234) + b(k,264) = b(k,264) - lu(k,1188) * b(k,234) + b(k,265) = b(k,265) - lu(k,1189) * b(k,234) + b(k,266) = b(k,266) - lu(k,1190) * b(k,234) + b(k,270) = b(k,270) - lu(k,1191) * b(k,234) + b(k,271) = b(k,271) - lu(k,1192) * b(k,234) + b(k,273) = b(k,273) - lu(k,1193) * b(k,234) + b(k,274) = b(k,274) - lu(k,1194) * b(k,234) + b(k,236) = b(k,236) - lu(k,1196) * b(k,235) + b(k,251) = b(k,251) - lu(k,1197) * b(k,235) + b(k,263) = b(k,263) - lu(k,1198) * b(k,235) + b(k,264) = b(k,264) - lu(k,1199) * b(k,235) + b(k,266) = b(k,266) - lu(k,1200) * b(k,235) + b(k,269) = b(k,269) - lu(k,1201) * b(k,235) + b(k,270) = b(k,270) - lu(k,1202) * b(k,235) + b(k,274) = b(k,274) - lu(k,1203) * b(k,235) + b(k,252) = b(k,252) - lu(k,1205) * b(k,236) + b(k,263) = b(k,263) - lu(k,1206) * b(k,236) + b(k,266) = b(k,266) - lu(k,1207) * b(k,236) + b(k,252) = b(k,252) - lu(k,1211) * b(k,237) + b(k,263) = b(k,263) - lu(k,1212) * b(k,237) + b(k,266) = b(k,266) - lu(k,1213) * b(k,237) + b(k,273) = b(k,273) - lu(k,1214) * b(k,237) + b(k,241) = b(k,241) - lu(k,1223) * b(k,238) + b(k,251) = b(k,251) - lu(k,1224) * b(k,238) + b(k,252) = b(k,252) - lu(k,1225) * b(k,238) + b(k,260) = b(k,260) - lu(k,1226) * b(k,238) + b(k,261) = b(k,261) - lu(k,1227) * b(k,238) + b(k,263) = b(k,263) - lu(k,1228) * b(k,238) + b(k,266) = b(k,266) - lu(k,1229) * b(k,238) + b(k,269) = b(k,269) - lu(k,1230) * b(k,238) + b(k,270) = b(k,270) - lu(k,1231) * b(k,238) + b(k,273) = b(k,273) - lu(k,1232) * b(k,238) + b(k,274) = b(k,274) - lu(k,1233) * b(k,238) + 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 + b(k,240) = b(k,240) - lu(k,1240) * b(k,239) + b(k,241) = b(k,241) - lu(k,1241) * b(k,239) + b(k,251) = b(k,251) - lu(k,1242) * b(k,239) + b(k,252) = b(k,252) - lu(k,1243) * b(k,239) + b(k,260) = b(k,260) - lu(k,1244) * b(k,239) + b(k,263) = b(k,263) - lu(k,1245) * b(k,239) + b(k,264) = b(k,264) - lu(k,1246) * b(k,239) + b(k,266) = b(k,266) - lu(k,1247) * b(k,239) + b(k,269) = b(k,269) - lu(k,1248) * b(k,239) + b(k,270) = b(k,270) - lu(k,1249) * b(k,239) + b(k,273) = b(k,273) - lu(k,1250) * b(k,239) + b(k,274) = b(k,274) - lu(k,1251) * b(k,239) + b(k,245) = b(k,245) - lu(k,1253) * b(k,240) + b(k,251) = b(k,251) - lu(k,1254) * b(k,240) + b(k,263) = b(k,263) - lu(k,1255) * b(k,240) + b(k,266) = b(k,266) - lu(k,1256) * b(k,240) + b(k,273) = b(k,273) - lu(k,1257) * b(k,240) + b(k,245) = b(k,245) - lu(k,1262) * b(k,241) + b(k,251) = b(k,251) - lu(k,1263) * b(k,241) + b(k,260) = b(k,260) - lu(k,1264) * b(k,241) + b(k,261) = b(k,261) - lu(k,1265) * b(k,241) + b(k,263) = b(k,263) - lu(k,1266) * b(k,241) + b(k,266) = b(k,266) - lu(k,1267) * b(k,241) + b(k,270) = b(k,270) - lu(k,1268) * b(k,241) + b(k,273) = b(k,273) - lu(k,1269) * b(k,241) + b(k,274) = b(k,274) - lu(k,1270) * b(k,241) + b(k,245) = b(k,245) - lu(k,1278) * b(k,242) + b(k,251) = b(k,251) - lu(k,1279) * b(k,242) + b(k,252) = b(k,252) - lu(k,1280) * b(k,242) + b(k,260) = b(k,260) - lu(k,1281) * b(k,242) + b(k,261) = b(k,261) - lu(k,1282) * b(k,242) + b(k,263) = b(k,263) - lu(k,1283) * b(k,242) + b(k,264) = b(k,264) - lu(k,1284) * b(k,242) + b(k,266) = b(k,266) - lu(k,1285) * b(k,242) + b(k,270) = b(k,270) - lu(k,1286) * b(k,242) + b(k,273) = b(k,273) - lu(k,1287) * b(k,242) + b(k,244) = b(k,244) - lu(k,1298) * b(k,243) + b(k,245) = b(k,245) - lu(k,1299) * b(k,243) + b(k,249) = b(k,249) - lu(k,1300) * b(k,243) + b(k,251) = b(k,251) - lu(k,1301) * b(k,243) + b(k,252) = b(k,252) - lu(k,1302) * b(k,243) + b(k,260) = b(k,260) - lu(k,1303) * b(k,243) + b(k,261) = b(k,261) - lu(k,1304) * b(k,243) + b(k,263) = b(k,263) - lu(k,1305) * b(k,243) + b(k,264) = b(k,264) - lu(k,1306) * b(k,243) + b(k,266) = b(k,266) - lu(k,1307) * b(k,243) + b(k,269) = b(k,269) - lu(k,1308) * b(k,243) + b(k,270) = b(k,270) - lu(k,1309) * b(k,243) + b(k,273) = b(k,273) - lu(k,1310) * b(k,243) + b(k,245) = b(k,245) - lu(k,1314) * b(k,244) + b(k,248) = b(k,248) - lu(k,1315) * b(k,244) + b(k,250) = b(k,250) - lu(k,1316) * b(k,244) + b(k,251) = b(k,251) - lu(k,1317) * b(k,244) + b(k,252) = b(k,252) - lu(k,1318) * b(k,244) + b(k,263) = b(k,263) - lu(k,1319) * b(k,244) + b(k,266) = b(k,266) - lu(k,1320) * b(k,244) + b(k,271) = b(k,271) - lu(k,1321) * b(k,244) + b(k,273) = b(k,273) - lu(k,1322) * b(k,244) + b(k,274) = b(k,274) - lu(k,1323) * b(k,244) + b(k,251) = b(k,251) - lu(k,1326) * b(k,245) + b(k,252) = b(k,252) - lu(k,1327) * b(k,245) + b(k,263) = b(k,263) - lu(k,1328) * b(k,245) + b(k,264) = b(k,264) - lu(k,1329) * b(k,245) + b(k,266) = b(k,266) - lu(k,1330) * b(k,245) + b(k,269) = b(k,269) - lu(k,1331) * b(k,245) + b(k,274) = b(k,274) - lu(k,1332) * b(k,245) + b(k,248) = b(k,248) - lu(k,1344) * b(k,246) + b(k,249) = b(k,249) - lu(k,1345) * b(k,246) + b(k,250) = b(k,250) - lu(k,1346) * b(k,246) + b(k,251) = b(k,251) - lu(k,1347) * b(k,246) + b(k,252) = b(k,252) - lu(k,1348) * b(k,246) + b(k,260) = b(k,260) - lu(k,1349) * b(k,246) + b(k,261) = b(k,261) - lu(k,1350) * b(k,246) + b(k,263) = b(k,263) - lu(k,1351) * b(k,246) + b(k,264) = b(k,264) - lu(k,1352) * b(k,246) + b(k,266) = b(k,266) - lu(k,1353) * b(k,246) + b(k,269) = b(k,269) - lu(k,1354) * b(k,246) + b(k,270) = b(k,270) - lu(k,1355) * b(k,246) + b(k,271) = b(k,271) - lu(k,1356) * b(k,246) + b(k,273) = b(k,273) - lu(k,1357) * b(k,246) + b(k,274) = b(k,274) - lu(k,1358) * b(k,246) + b(k,248) = b(k,248) - lu(k,1377) * b(k,247) + b(k,249) = b(k,249) - lu(k,1378) * b(k,247) + b(k,250) = b(k,250) - lu(k,1379) * b(k,247) + b(k,251) = b(k,251) - lu(k,1380) * b(k,247) + b(k,252) = b(k,252) - lu(k,1381) * b(k,247) + b(k,260) = b(k,260) - lu(k,1382) * b(k,247) + b(k,261) = b(k,261) - lu(k,1383) * b(k,247) + b(k,263) = b(k,263) - lu(k,1384) * b(k,247) + b(k,264) = b(k,264) - lu(k,1385) * b(k,247) + b(k,266) = b(k,266) - lu(k,1386) * b(k,247) + b(k,269) = b(k,269) - lu(k,1387) * b(k,247) + b(k,270) = b(k,270) - lu(k,1388) * b(k,247) + b(k,271) = b(k,271) - lu(k,1389) * b(k,247) + b(k,273) = b(k,273) - lu(k,1390) * b(k,247) + b(k,274) = b(k,274) - lu(k,1391) * b(k,247) + b(k,250) = b(k,250) - lu(k,1401) * b(k,248) + b(k,251) = b(k,251) - lu(k,1402) * b(k,248) + b(k,252) = b(k,252) - lu(k,1403) * b(k,248) + b(k,260) = b(k,260) - lu(k,1404) * b(k,248) + b(k,261) = b(k,261) - lu(k,1405) * b(k,248) + b(k,263) = b(k,263) - lu(k,1406) * b(k,248) + b(k,264) = b(k,264) - lu(k,1407) * b(k,248) + b(k,266) = b(k,266) - lu(k,1408) * b(k,248) + b(k,269) = b(k,269) - lu(k,1409) * b(k,248) + b(k,270) = b(k,270) - lu(k,1410) * b(k,248) + b(k,273) = b(k,273) - lu(k,1411) * b(k,248) + b(k,274) = b(k,274) - lu(k,1412) * b(k,248) + b(k,250) = b(k,250) - lu(k,1421) * b(k,249) + b(k,251) = b(k,251) - lu(k,1422) * b(k,249) + b(k,252) = b(k,252) - lu(k,1423) * b(k,249) + b(k,257) = b(k,257) - lu(k,1424) * b(k,249) + b(k,260) = b(k,260) - lu(k,1425) * b(k,249) + b(k,261) = b(k,261) - lu(k,1426) * b(k,249) + b(k,263) = b(k,263) - lu(k,1427) * b(k,249) + b(k,264) = b(k,264) - lu(k,1428) * b(k,249) + b(k,265) = b(k,265) - lu(k,1429) * b(k,249) + b(k,266) = b(k,266) - lu(k,1430) * b(k,249) + b(k,269) = b(k,269) - lu(k,1431) * b(k,249) + b(k,270) = b(k,270) - lu(k,1432) * b(k,249) + b(k,271) = b(k,271) - lu(k,1433) * b(k,249) + b(k,273) = b(k,273) - lu(k,1434) * b(k,249) + b(k,274) = b(k,274) - lu(k,1435) * b(k,249) + b(k,251) = b(k,251) - lu(k,1442) * b(k,250) + b(k,252) = b(k,252) - lu(k,1443) * b(k,250) + b(k,260) = b(k,260) - lu(k,1444) * b(k,250) + b(k,261) = b(k,261) - lu(k,1445) * b(k,250) + b(k,263) = b(k,263) - lu(k,1446) * b(k,250) + b(k,264) = b(k,264) - lu(k,1447) * b(k,250) + b(k,266) = b(k,266) - lu(k,1448) * b(k,250) + b(k,269) = b(k,269) - lu(k,1449) * b(k,250) + b(k,270) = b(k,270) - lu(k,1450) * b(k,250) + b(k,271) = b(k,271) - lu(k,1451) * b(k,250) + b(k,273) = b(k,273) - lu(k,1452) * b(k,250) + b(k,274) = b(k,274) - lu(k,1453) * b(k,250) + b(k,252) = b(k,252) - lu(k,1473) * b(k,251) + b(k,257) = b(k,257) - lu(k,1474) * b(k,251) + b(k,260) = b(k,260) - lu(k,1475) * b(k,251) + b(k,261) = b(k,261) - lu(k,1476) * b(k,251) + b(k,263) = b(k,263) - lu(k,1477) * b(k,251) + b(k,264) = b(k,264) - lu(k,1478) * b(k,251) + b(k,265) = b(k,265) - lu(k,1479) * b(k,251) + b(k,266) = b(k,266) - lu(k,1480) * b(k,251) + b(k,269) = b(k,269) - lu(k,1481) * b(k,251) + b(k,270) = b(k,270) - lu(k,1482) * b(k,251) + b(k,271) = b(k,271) - lu(k,1483) * b(k,251) + b(k,273) = b(k,273) - lu(k,1484) * b(k,251) + b(k,274) = b(k,274) - lu(k,1485) * b(k,251) + b(k,257) = b(k,257) - lu(k,1495) * b(k,252) + b(k,260) = b(k,260) - lu(k,1496) * b(k,252) + b(k,261) = b(k,261) - lu(k,1497) * b(k,252) + b(k,262) = b(k,262) - lu(k,1498) * b(k,252) + b(k,263) = b(k,263) - lu(k,1499) * b(k,252) + b(k,266) = b(k,266) - lu(k,1500) * b(k,252) + b(k,268) = b(k,268) - lu(k,1501) * b(k,252) + b(k,272) = b(k,272) - lu(k,1502) * b(k,252) + b(k,255) = b(k,255) - lu(k,1506) * b(k,253) + b(k,262) = b(k,262) - lu(k,1507) * b(k,253) + b(k,263) = b(k,263) - lu(k,1508) * b(k,253) + b(k,264) = b(k,264) - lu(k,1509) * b(k,253) + b(k,265) = b(k,265) - lu(k,1510) * b(k,253) + b(k,267) = b(k,267) - lu(k,1511) * b(k,253) + b(k,268) = b(k,268) - lu(k,1512) * b(k,253) + b(k,269) = b(k,269) - lu(k,1513) * b(k,253) + b(k,270) = b(k,270) - lu(k,1514) * b(k,253) + b(k,272) = b(k,272) - lu(k,1515) * b(k,253) + b(k,274) = b(k,274) - lu(k,1516) * b(k,253) + b(k,256) = b(k,256) - lu(k,1521) * b(k,254) + b(k,257) = b(k,257) - lu(k,1522) * b(k,254) + b(k,258) = b(k,258) - lu(k,1523) * b(k,254) + b(k,259) = b(k,259) - lu(k,1524) * b(k,254) + b(k,260) = b(k,260) - lu(k,1525) * b(k,254) + b(k,261) = b(k,261) - lu(k,1526) * b(k,254) + b(k,263) = b(k,263) - lu(k,1527) * b(k,254) + b(k,266) = b(k,266) - lu(k,1528) * b(k,254) + b(k,267) = b(k,267) - lu(k,1529) * b(k,254) + b(k,268) = b(k,268) - lu(k,1530) * b(k,254) + b(k,271) = b(k,271) - lu(k,1531) * b(k,254) + b(k,272) = b(k,272) - lu(k,1532) * b(k,254) + b(k,274) = b(k,274) - lu(k,1533) * b(k,254) + b(k,256) = b(k,256) - lu(k,1540) * b(k,255) + b(k,258) = b(k,258) - lu(k,1541) * b(k,255) + b(k,259) = b(k,259) - lu(k,1542) * b(k,255) + b(k,260) = b(k,260) - lu(k,1543) * b(k,255) + b(k,262) = b(k,262) - lu(k,1544) * b(k,255) + b(k,263) = b(k,263) - lu(k,1545) * b(k,255) + b(k,264) = b(k,264) - lu(k,1546) * b(k,255) + b(k,267) = b(k,267) - lu(k,1547) * b(k,255) + b(k,268) = b(k,268) - lu(k,1548) * b(k,255) + b(k,269) = b(k,269) - lu(k,1549) * b(k,255) + b(k,272) = b(k,272) - lu(k,1550) * b(k,255) + b(k,274) = b(k,274) - lu(k,1551) * b(k,255) + b(k,257) = b(k,257) - lu(k,1556) * b(k,256) + b(k,258) = b(k,258) - lu(k,1557) * b(k,256) + b(k,260) = b(k,260) - lu(k,1558) * b(k,256) + b(k,261) = b(k,261) - lu(k,1559) * b(k,256) + b(k,262) = b(k,262) - lu(k,1560) * b(k,256) + b(k,263) = b(k,263) - lu(k,1561) * b(k,256) + b(k,266) = b(k,266) - lu(k,1562) * b(k,256) + b(k,268) = b(k,268) - lu(k,1563) * b(k,256) + b(k,271) = b(k,271) - lu(k,1564) * b(k,256) + b(k,272) = b(k,272) - lu(k,1565) * b(k,256) + b(k,273) = b(k,273) - lu(k,1566) * b(k,256) + b(k,274) = b(k,274) - lu(k,1567) * b(k,256) + 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,258) = b(k,258) - lu(k,1587) * b(k,257) + b(k,259) = b(k,259) - lu(k,1588) * b(k,257) + b(k,260) = b(k,260) - lu(k,1589) * b(k,257) + b(k,261) = b(k,261) - lu(k,1590) * b(k,257) + b(k,262) = b(k,262) - lu(k,1591) * b(k,257) + b(k,263) = b(k,263) - lu(k,1592) * b(k,257) + b(k,266) = b(k,266) - lu(k,1593) * b(k,257) + b(k,267) = b(k,267) - lu(k,1594) * b(k,257) + b(k,268) = b(k,268) - lu(k,1595) * b(k,257) + b(k,271) = b(k,271) - lu(k,1596) * b(k,257) + b(k,272) = b(k,272) - lu(k,1597) * b(k,257) + b(k,273) = b(k,273) - lu(k,1598) * b(k,257) + b(k,274) = b(k,274) - lu(k,1599) * b(k,257) + b(k,259) = b(k,259) - lu(k,1610) * b(k,258) + b(k,260) = b(k,260) - lu(k,1611) * b(k,258) + b(k,261) = b(k,261) - lu(k,1612) * b(k,258) + b(k,262) = b(k,262) - lu(k,1613) * b(k,258) + b(k,263) = b(k,263) - lu(k,1614) * b(k,258) + b(k,264) = b(k,264) - lu(k,1615) * b(k,258) + b(k,266) = b(k,266) - lu(k,1616) * b(k,258) + b(k,267) = b(k,267) - lu(k,1617) * b(k,258) + b(k,268) = b(k,268) - lu(k,1618) * b(k,258) + b(k,269) = b(k,269) - lu(k,1619) * b(k,258) + b(k,271) = b(k,271) - lu(k,1620) * b(k,258) + b(k,272) = b(k,272) - lu(k,1621) * b(k,258) + b(k,273) = b(k,273) - lu(k,1622) * b(k,258) + b(k,274) = b(k,274) - lu(k,1623) * b(k,258) + b(k,260) = b(k,260) - lu(k,1637) * b(k,259) + b(k,261) = b(k,261) - lu(k,1638) * b(k,259) + b(k,262) = b(k,262) - lu(k,1639) * b(k,259) + b(k,263) = b(k,263) - lu(k,1640) * b(k,259) + b(k,264) = b(k,264) - lu(k,1641) * b(k,259) + b(k,266) = b(k,266) - lu(k,1642) * b(k,259) + b(k,267) = b(k,267) - lu(k,1643) * b(k,259) + b(k,268) = b(k,268) - lu(k,1644) * b(k,259) + b(k,269) = b(k,269) - lu(k,1645) * b(k,259) + b(k,270) = b(k,270) - lu(k,1646) * b(k,259) + b(k,271) = b(k,271) - lu(k,1647) * b(k,259) + b(k,272) = b(k,272) - lu(k,1648) * b(k,259) + b(k,273) = b(k,273) - lu(k,1649) * b(k,259) + b(k,274) = b(k,274) - lu(k,1650) * b(k,259) + b(k,261) = b(k,261) - lu(k,1682) * b(k,260) + b(k,262) = b(k,262) - lu(k,1683) * b(k,260) + b(k,263) = b(k,263) - lu(k,1684) * b(k,260) + b(k,264) = b(k,264) - lu(k,1685) * b(k,260) + b(k,265) = b(k,265) - lu(k,1686) * b(k,260) + b(k,266) = b(k,266) - lu(k,1687) * b(k,260) + b(k,267) = b(k,267) - lu(k,1688) * b(k,260) + b(k,268) = b(k,268) - lu(k,1689) * b(k,260) + b(k,269) = b(k,269) - lu(k,1690) * b(k,260) + b(k,270) = b(k,270) - lu(k,1691) * b(k,260) + b(k,271) = b(k,271) - lu(k,1692) * b(k,260) + b(k,272) = b(k,272) - lu(k,1693) * b(k,260) + b(k,273) = b(k,273) - lu(k,1694) * b(k,260) + b(k,274) = b(k,274) - lu(k,1695) * b(k,260) + b(k,262) = b(k,262) - lu(k,1789) * b(k,261) + b(k,263) = b(k,263) - lu(k,1790) * b(k,261) + b(k,264) = b(k,264) - lu(k,1791) * b(k,261) + b(k,265) = b(k,265) - lu(k,1792) * b(k,261) + b(k,266) = b(k,266) - lu(k,1793) * b(k,261) + b(k,267) = b(k,267) - lu(k,1794) * b(k,261) + b(k,268) = b(k,268) - lu(k,1795) * b(k,261) + b(k,269) = b(k,269) - lu(k,1796) * b(k,261) + b(k,270) = b(k,270) - lu(k,1797) * b(k,261) + b(k,271) = b(k,271) - lu(k,1798) * b(k,261) + b(k,272) = b(k,272) - lu(k,1799) * b(k,261) + b(k,273) = b(k,273) - lu(k,1800) * b(k,261) + b(k,274) = b(k,274) - lu(k,1801) * b(k,261) + b(k,263) = b(k,263) - lu(k,1833) * b(k,262) + b(k,264) = b(k,264) - lu(k,1834) * b(k,262) + b(k,265) = b(k,265) - lu(k,1835) * b(k,262) + b(k,266) = b(k,266) - lu(k,1836) * b(k,262) + b(k,267) = b(k,267) - lu(k,1837) * b(k,262) + b(k,268) = b(k,268) - lu(k,1838) * b(k,262) + b(k,269) = b(k,269) - lu(k,1839) * b(k,262) + b(k,270) = b(k,270) - lu(k,1840) * b(k,262) + b(k,271) = b(k,271) - lu(k,1841) * b(k,262) + b(k,272) = b(k,272) - lu(k,1842) * b(k,262) + b(k,273) = b(k,273) - lu(k,1843) * b(k,262) + b(k,274) = b(k,274) - lu(k,1844) * b(k,262) + b(k,264) = b(k,264) - lu(k,2007) * b(k,263) + b(k,265) = b(k,265) - lu(k,2008) * b(k,263) + b(k,266) = b(k,266) - lu(k,2009) * b(k,263) + b(k,267) = b(k,267) - lu(k,2010) * b(k,263) + b(k,268) = b(k,268) - lu(k,2011) * b(k,263) + b(k,269) = b(k,269) - lu(k,2012) * b(k,263) + b(k,270) = b(k,270) - lu(k,2013) * b(k,263) + b(k,271) = b(k,271) - lu(k,2014) * b(k,263) + b(k,272) = b(k,272) - lu(k,2015) * b(k,263) + b(k,273) = b(k,273) - lu(k,2016) * b(k,263) + b(k,274) = b(k,274) - lu(k,2017) * b(k,263) + b(k,265) = b(k,265) - lu(k,2068) * b(k,264) + b(k,266) = b(k,266) - lu(k,2069) * b(k,264) + b(k,267) = b(k,267) - lu(k,2070) * b(k,264) + b(k,268) = b(k,268) - lu(k,2071) * b(k,264) + b(k,269) = b(k,269) - lu(k,2072) * b(k,264) + b(k,270) = b(k,270) - lu(k,2073) * b(k,264) + b(k,271) = b(k,271) - lu(k,2074) * b(k,264) + b(k,272) = b(k,272) - lu(k,2075) * b(k,264) + b(k,273) = b(k,273) - lu(k,2076) * b(k,264) + b(k,274) = b(k,274) - lu(k,2077) * b(k,264) + b(k,266) = b(k,266) - lu(k,2094) * b(k,265) + b(k,267) = b(k,267) - lu(k,2095) * b(k,265) + b(k,268) = b(k,268) - lu(k,2096) * b(k,265) + b(k,269) = b(k,269) - lu(k,2097) * b(k,265) + b(k,270) = b(k,270) - lu(k,2098) * b(k,265) + b(k,271) = b(k,271) - lu(k,2099) * b(k,265) + b(k,272) = b(k,272) - lu(k,2100) * b(k,265) + b(k,273) = b(k,273) - lu(k,2101) * b(k,265) + b(k,274) = b(k,274) - lu(k,2102) * b(k,265) + b(k,267) = b(k,267) - lu(k,2215) * b(k,266) + b(k,268) = b(k,268) - lu(k,2216) * b(k,266) + b(k,269) = b(k,269) - lu(k,2217) * b(k,266) + b(k,270) = b(k,270) - lu(k,2218) * b(k,266) + b(k,271) = b(k,271) - lu(k,2219) * b(k,266) + b(k,272) = b(k,272) - lu(k,2220) * b(k,266) + b(k,273) = b(k,273) - lu(k,2221) * b(k,266) + b(k,274) = b(k,274) - lu(k,2222) * b(k,266) + b(k,268) = b(k,268) - lu(k,2262) * b(k,267) + b(k,269) = b(k,269) - lu(k,2263) * b(k,267) + b(k,270) = b(k,270) - lu(k,2264) * b(k,267) + b(k,271) = b(k,271) - lu(k,2265) * b(k,267) + b(k,272) = b(k,272) - lu(k,2266) * b(k,267) + b(k,273) = b(k,273) - lu(k,2267) * b(k,267) + b(k,274) = b(k,274) - lu(k,2268) * b(k,267) + b(k,269) = b(k,269) - lu(k,2284) * b(k,268) + b(k,270) = b(k,270) - lu(k,2285) * b(k,268) + b(k,271) = b(k,271) - lu(k,2286) * b(k,268) + b(k,272) = b(k,272) - lu(k,2287) * b(k,268) + b(k,273) = b(k,273) - lu(k,2288) * b(k,268) + b(k,274) = b(k,274) - lu(k,2289) * b(k,268) + b(k,270) = b(k,270) - lu(k,2308) * b(k,269) + b(k,271) = b(k,271) - lu(k,2309) * b(k,269) + b(k,272) = b(k,272) - lu(k,2310) * b(k,269) + b(k,273) = b(k,273) - lu(k,2311) * b(k,269) + b(k,274) = b(k,274) - lu(k,2312) * b(k,269) + b(k,271) = b(k,271) - lu(k,2361) * b(k,270) + b(k,272) = b(k,272) - lu(k,2362) * b(k,270) + b(k,273) = b(k,273) - lu(k,2363) * b(k,270) + b(k,274) = b(k,274) - lu(k,2364) * b(k,270) + b(k,272) = b(k,272) - lu(k,2426) * b(k,271) + b(k,273) = b(k,273) - lu(k,2427) * b(k,271) + b(k,274) = b(k,274) - lu(k,2428) * b(k,271) + b(k,273) = b(k,273) - lu(k,2470) * b(k,272) + b(k,274) = b(k,274) - lu(k,2471) * b(k,272) + b(k,274) = b(k,274) - lu(k,2497) * b(k,273) + 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 +!----------------------------------------------------------------------- +! ... Solve U * x = y +!----------------------------------------------------------------------- + b(k,274) = b(k,274) * lu(k,2524) + b(k,273) = b(k,273) - lu(k,2523) * b(k,274) + b(k,272) = b(k,272) - lu(k,2522) * b(k,274) + b(k,271) = b(k,271) - lu(k,2521) * b(k,274) + b(k,270) = b(k,270) - lu(k,2520) * b(k,274) + b(k,269) = b(k,269) - lu(k,2519) * b(k,274) + b(k,268) = b(k,268) - lu(k,2518) * b(k,274) + b(k,267) = b(k,267) - lu(k,2517) * b(k,274) + b(k,266) = b(k,266) - lu(k,2516) * b(k,274) + b(k,265) = b(k,265) - lu(k,2515) * b(k,274) + b(k,264) = b(k,264) - lu(k,2514) * b(k,274) + b(k,263) = b(k,263) - lu(k,2513) * b(k,274) + b(k,262) = b(k,262) - lu(k,2512) * b(k,274) + b(k,261) = b(k,261) - lu(k,2511) * b(k,274) + b(k,260) = b(k,260) - lu(k,2510) * b(k,274) + b(k,259) = b(k,259) - lu(k,2509) * b(k,274) + b(k,258) = b(k,258) - lu(k,2508) * b(k,274) + b(k,257) = b(k,257) - lu(k,2507) * b(k,274) + b(k,256) = b(k,256) - lu(k,2506) * b(k,274) + b(k,255) = b(k,255) - lu(k,2505) * b(k,274) + b(k,254) = b(k,254) - lu(k,2504) * b(k,274) + b(k,253) = b(k,253) - lu(k,2503) * b(k,274) + b(k,221) = b(k,221) - lu(k,2502) * b(k,274) + b(k,219) = b(k,219) - lu(k,2501) * b(k,274) + b(k,137) = b(k,137) - lu(k,2500) * b(k,274) + b(k,129) = b(k,129) - lu(k,2499) * b(k,274) + b(k,99) = b(k,99) - lu(k,2498) * b(k,274) + b(k,273) = b(k,273) * lu(k,2496) + b(k,272) = b(k,272) - lu(k,2495) * b(k,273) + b(k,271) = b(k,271) - lu(k,2494) * b(k,273) + b(k,270) = b(k,270) - lu(k,2493) * b(k,273) + b(k,269) = b(k,269) - lu(k,2492) * b(k,273) + b(k,268) = b(k,268) - lu(k,2491) * b(k,273) + b(k,267) = b(k,267) - lu(k,2490) * b(k,273) + b(k,266) = b(k,266) - lu(k,2489) * b(k,273) + b(k,265) = b(k,265) - lu(k,2488) * b(k,273) + b(k,264) = b(k,264) - lu(k,2487) * b(k,273) + b(k,263) = b(k,263) - lu(k,2486) * b(k,273) + b(k,262) = b(k,262) - lu(k,2485) * b(k,273) + b(k,261) = b(k,261) - lu(k,2484) * b(k,273) + b(k,260) = b(k,260) - lu(k,2483) * b(k,273) + b(k,259) = b(k,259) - lu(k,2482) * b(k,273) + b(k,258) = b(k,258) - lu(k,2481) * b(k,273) + b(k,257) = b(k,257) - lu(k,2480) * b(k,273) + b(k,256) = b(k,256) - lu(k,2479) * b(k,273) + b(k,255) = b(k,255) - lu(k,2478) * b(k,273) + b(k,253) = b(k,253) - lu(k,2477) * b(k,273) + b(k,252) = b(k,252) - lu(k,2476) * b(k,273) + b(k,236) = b(k,236) - lu(k,2475) * b(k,273) + b(k,216) = b(k,216) - lu(k,2474) * b(k,273) + b(k,210) = b(k,210) - lu(k,2473) * b(k,273) + b(k,161) = b(k,161) - lu(k,2472) * b(k,273) + b(k,272) = b(k,272) * lu(k,2469) + b(k,271) = b(k,271) - lu(k,2468) * b(k,272) + b(k,270) = b(k,270) - lu(k,2467) * b(k,272) + b(k,269) = b(k,269) - lu(k,2466) * b(k,272) + b(k,268) = b(k,268) - lu(k,2465) * b(k,272) + b(k,267) = b(k,267) - lu(k,2464) * b(k,272) + b(k,266) = b(k,266) - lu(k,2463) * b(k,272) + b(k,265) = b(k,265) - lu(k,2462) * b(k,272) + b(k,264) = b(k,264) - lu(k,2461) * b(k,272) + b(k,263) = b(k,263) - lu(k,2460) * b(k,272) + b(k,262) = b(k,262) - lu(k,2459) * b(k,272) + b(k,261) = b(k,261) - lu(k,2458) * b(k,272) + b(k,260) = b(k,260) - lu(k,2457) * b(k,272) + b(k,259) = b(k,259) - lu(k,2456) * b(k,272) + b(k,258) = b(k,258) - lu(k,2455) * b(k,272) + b(k,257) = b(k,257) - lu(k,2454) * b(k,272) + b(k,256) = b(k,256) - lu(k,2453) * b(k,272) + b(k,255) = b(k,255) - lu(k,2452) * b(k,272) + b(k,254) = b(k,254) - lu(k,2451) * b(k,272) + b(k,253) = b(k,253) - lu(k,2450) * b(k,272) + b(k,252) = b(k,252) - lu(k,2449) * b(k,272) + b(k,236) = b(k,236) - lu(k,2448) * b(k,272) + b(k,224) = b(k,224) - lu(k,2447) * b(k,272) + b(k,223) = b(k,223) - lu(k,2446) * b(k,272) + b(k,221) = b(k,221) - lu(k,2445) * b(k,272) + b(k,213) = b(k,213) - lu(k,2444) * b(k,272) + b(k,212) = b(k,212) - lu(k,2443) * b(k,272) + b(k,211) = b(k,211) - lu(k,2442) * b(k,272) + b(k,210) = b(k,210) - lu(k,2441) * b(k,272) + b(k,209) = b(k,209) - lu(k,2440) * b(k,272) + b(k,206) = b(k,206) - lu(k,2439) * b(k,272) + b(k,205) = b(k,205) - lu(k,2438) * b(k,272) + b(k,199) = b(k,199) - lu(k,2437) * b(k,272) + b(k,195) = b(k,195) - lu(k,2436) * b(k,272) + b(k,184) = b(k,184) - lu(k,2435) * b(k,272) + b(k,179) = b(k,179) - lu(k,2434) * b(k,272) + b(k,175) = b(k,175) - lu(k,2433) * b(k,272) + b(k,171) = b(k,171) - lu(k,2432) * b(k,272) + b(k,150) = b(k,150) - lu(k,2431) * b(k,272) + b(k,111) = b(k,111) - lu(k,2430) * b(k,272) + b(k,110) = b(k,110) - lu(k,2429) * b(k,272) + b(k,271) = b(k,271) * lu(k,2425) + b(k,270) = b(k,270) - lu(k,2424) * b(k,271) + b(k,269) = b(k,269) - lu(k,2423) * b(k,271) + b(k,268) = b(k,268) - lu(k,2422) * b(k,271) + b(k,267) = b(k,267) - lu(k,2421) * b(k,271) + b(k,266) = b(k,266) - lu(k,2420) * b(k,271) + b(k,265) = b(k,265) - lu(k,2419) * b(k,271) + b(k,264) = b(k,264) - lu(k,2418) * b(k,271) + b(k,263) = b(k,263) - lu(k,2417) * b(k,271) + b(k,262) = b(k,262) - lu(k,2416) * b(k,271) + b(k,261) = b(k,261) - lu(k,2415) * b(k,271) + b(k,260) = b(k,260) - lu(k,2414) * b(k,271) + b(k,259) = b(k,259) - lu(k,2413) * b(k,271) + b(k,258) = b(k,258) - lu(k,2412) * b(k,271) + b(k,257) = b(k,257) - lu(k,2411) * b(k,271) + b(k,256) = b(k,256) - lu(k,2410) * b(k,271) + b(k,254) = b(k,254) - lu(k,2409) * b(k,271) + b(k,252) = b(k,252) - lu(k,2408) * b(k,271) + b(k,251) = b(k,251) - lu(k,2407) * b(k,271) + b(k,250) = b(k,250) - lu(k,2406) * b(k,271) + b(k,249) = b(k,249) - lu(k,2405) * b(k,271) + b(k,248) = b(k,248) - lu(k,2404) * b(k,271) + b(k,247) = b(k,247) - lu(k,2403) * b(k,271) + b(k,246) = b(k,246) - lu(k,2402) * b(k,271) + b(k,245) = b(k,245) - lu(k,2401) * b(k,271) + b(k,244) = b(k,244) - lu(k,2400) * b(k,271) + b(k,243) = b(k,243) - lu(k,2399) * b(k,271) + b(k,241) = b(k,241) - lu(k,2398) * b(k,271) + b(k,240) = b(k,240) - lu(k,2397) * b(k,271) + b(k,238) = b(k,238) - lu(k,2396) * b(k,271) + b(k,237) = b(k,237) - lu(k,2395) * b(k,271) + b(k,236) = b(k,236) - lu(k,2394) * b(k,271) + b(k,235) = b(k,235) - lu(k,2393) * b(k,271) + b(k,234) = b(k,234) - lu(k,2392) * b(k,271) + b(k,233) = b(k,233) - lu(k,2391) * b(k,271) + b(k,232) = b(k,232) - lu(k,2390) * b(k,271) + b(k,230) = b(k,230) - lu(k,2389) * b(k,271) + b(k,229) = b(k,229) - lu(k,2388) * b(k,271) + b(k,228) = b(k,228) - lu(k,2387) * b(k,271) + b(k,227) = b(k,227) - lu(k,2386) * b(k,271) + b(k,226) = b(k,226) - lu(k,2385) * b(k,271) + b(k,225) = b(k,225) - lu(k,2384) * b(k,271) + b(k,222) = b(k,222) - lu(k,2383) * b(k,271) + b(k,221) = b(k,221) - lu(k,2382) * b(k,271) + b(k,216) = b(k,216) - lu(k,2381) * b(k,271) + b(k,214) = b(k,214) - lu(k,2380) * b(k,271) + b(k,204) = b(k,204) - lu(k,2379) * b(k,271) + b(k,199) = b(k,199) - lu(k,2378) * b(k,271) + b(k,196) = b(k,196) - lu(k,2377) * b(k,271) + b(k,190) = b(k,190) - lu(k,2376) * b(k,271) + b(k,181) = b(k,181) - lu(k,2375) * b(k,271) + b(k,169) = b(k,169) - lu(k,2374) * b(k,271) + b(k,158) = b(k,158) - lu(k,2373) * b(k,271) + b(k,120) = b(k,120) - lu(k,2372) * b(k,271) + b(k,111) = b(k,111) - lu(k,2371) * b(k,271) + b(k,110) = b(k,110) - lu(k,2370) * b(k,271) + b(k,72) = b(k,72) - lu(k,2369) * b(k,271) + b(k,71) = b(k,71) - lu(k,2368) * b(k,271) + b(k,70) = b(k,70) - lu(k,2367) * b(k,271) + b(k,69) = b(k,69) - lu(k,2366) * b(k,271) + b(k,68) = b(k,68) - lu(k,2365) * b(k,271) + b(k,270) = b(k,270) * lu(k,2360) + b(k,269) = b(k,269) - lu(k,2359) * b(k,270) + b(k,268) = b(k,268) - lu(k,2358) * b(k,270) + b(k,267) = b(k,267) - lu(k,2357) * b(k,270) + b(k,266) = b(k,266) - lu(k,2356) * b(k,270) + b(k,265) = b(k,265) - lu(k,2355) * b(k,270) + b(k,264) = b(k,264) - lu(k,2354) * b(k,270) + b(k,263) = b(k,263) - lu(k,2353) * b(k,270) + b(k,262) = b(k,262) - lu(k,2352) * b(k,270) + b(k,261) = b(k,261) - lu(k,2351) * b(k,270) + b(k,260) = b(k,260) - lu(k,2350) * b(k,270) + b(k,259) = b(k,259) - lu(k,2349) * b(k,270) + b(k,258) = b(k,258) - lu(k,2348) * b(k,270) + b(k,257) = b(k,257) - lu(k,2347) * b(k,270) + b(k,252) = b(k,252) - lu(k,2346) * b(k,270) + b(k,251) = b(k,251) - lu(k,2345) * b(k,270) + b(k,250) = b(k,250) - lu(k,2344) * b(k,270) + b(k,249) = b(k,249) - lu(k,2343) * b(k,270) + b(k,248) = b(k,248) - lu(k,2342) * b(k,270) + b(k,247) = b(k,247) - lu(k,2341) * b(k,270) + b(k,246) = b(k,246) - lu(k,2340) * b(k,270) + b(k,245) = b(k,245) - lu(k,2339) * b(k,270) + b(k,244) = b(k,244) - lu(k,2338) * b(k,270) + b(k,243) = b(k,243) - lu(k,2337) * b(k,270) + b(k,242) = b(k,242) - lu(k,2336) * b(k,270) + b(k,241) = b(k,241) - lu(k,2335) * b(k,270) + b(k,240) = b(k,240) - lu(k,2334) * b(k,270) + b(k,238) = b(k,238) - lu(k,2333) * b(k,270) + b(k,237) = b(k,237) - lu(k,2332) * b(k,270) + b(k,236) = b(k,236) - lu(k,2331) * b(k,270) + b(k,235) = b(k,235) - lu(k,2330) * b(k,270) + b(k,233) = b(k,233) - lu(k,2329) * b(k,270) + b(k,232) = b(k,232) - lu(k,2328) * b(k,270) + b(k,231) = b(k,231) - lu(k,2327) * b(k,270) + b(k,230) = b(k,230) - lu(k,2326) * b(k,270) + b(k,229) = b(k,229) - lu(k,2325) * b(k,270) + b(k,228) = b(k,228) - lu(k,2324) * b(k,270) + b(k,227) = b(k,227) - lu(k,2323) * b(k,270) + b(k,220) = b(k,220) - lu(k,2322) * b(k,270) + b(k,217) = b(k,217) - lu(k,2321) * b(k,270) + b(k,215) = b(k,215) - lu(k,2320) * b(k,270) + b(k,207) = b(k,207) - lu(k,2319) * b(k,270) + b(k,196) = b(k,196) - lu(k,2318) * b(k,270) + b(k,189) = b(k,189) - lu(k,2317) * b(k,270) + b(k,162) = b(k,162) - lu(k,2316) * b(k,270) + b(k,156) = b(k,156) - lu(k,2315) * b(k,270) + b(k,147) = b(k,147) - lu(k,2314) * b(k,270) + b(k,130) = b(k,130) - lu(k,2313) * b(k,270) + 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,269) = b(k,269) * lu(k,2307) + b(k,268) = b(k,268) - lu(k,2306) * b(k,269) + b(k,267) = b(k,267) - lu(k,2305) * b(k,269) + b(k,266) = b(k,266) - lu(k,2304) * b(k,269) + b(k,265) = b(k,265) - lu(k,2303) * b(k,269) + b(k,264) = b(k,264) - lu(k,2302) * b(k,269) + b(k,263) = b(k,263) - lu(k,2301) * b(k,269) + b(k,262) = b(k,262) - lu(k,2300) * b(k,269) + b(k,261) = b(k,261) - lu(k,2299) * b(k,269) + b(k,260) = b(k,260) - lu(k,2298) * b(k,269) + b(k,259) = b(k,259) - lu(k,2297) * b(k,269) + b(k,258) = b(k,258) - lu(k,2296) * b(k,269) + b(k,257) = b(k,257) - lu(k,2295) * b(k,269) + b(k,256) = b(k,256) - lu(k,2294) * b(k,269) + b(k,255) = b(k,255) - lu(k,2293) * b(k,269) + b(k,253) = b(k,253) - lu(k,2292) * b(k,269) + b(k,219) = b(k,219) - lu(k,2291) * b(k,269) + b(k,137) = b(k,137) - lu(k,2290) * b(k,269) + b(k,268) = b(k,268) * lu(k,2283) + b(k,267) = b(k,267) - lu(k,2282) * b(k,268) + b(k,266) = b(k,266) - lu(k,2281) * b(k,268) + b(k,265) = b(k,265) - lu(k,2280) * b(k,268) + b(k,264) = b(k,264) - lu(k,2279) * b(k,268) + b(k,263) = b(k,263) - lu(k,2278) * b(k,268) + b(k,262) = b(k,262) - lu(k,2277) * b(k,268) + b(k,261) = b(k,261) - lu(k,2276) * b(k,268) + b(k,260) = b(k,260) - lu(k,2275) * b(k,268) + b(k,259) = b(k,259) - lu(k,2274) * b(k,268) + b(k,258) = b(k,258) - lu(k,2273) * b(k,268) + b(k,257) = b(k,257) - lu(k,2272) * b(k,268) + b(k,256) = b(k,256) - lu(k,2271) * b(k,268) + b(k,255) = b(k,255) - lu(k,2270) * b(k,268) + b(k,253) = b(k,253) - lu(k,2269) * b(k,268) + b(k,267) = b(k,267) * lu(k,2261) + b(k,266) = b(k,266) - lu(k,2260) * b(k,267) + b(k,265) = b(k,265) - lu(k,2259) * b(k,267) + b(k,264) = b(k,264) - lu(k,2258) * b(k,267) + b(k,263) = b(k,263) - lu(k,2257) * b(k,267) + b(k,262) = b(k,262) - lu(k,2256) * b(k,267) + b(k,261) = b(k,261) - lu(k,2255) * b(k,267) + b(k,260) = b(k,260) - lu(k,2254) * b(k,267) + b(k,259) = b(k,259) - lu(k,2253) * b(k,267) + b(k,258) = b(k,258) - lu(k,2252) * b(k,267) + b(k,257) = b(k,257) - lu(k,2251) * b(k,267) + b(k,256) = b(k,256) - lu(k,2250) * b(k,267) + b(k,255) = b(k,255) - lu(k,2249) * b(k,267) + b(k,253) = b(k,253) - lu(k,2248) * b(k,267) + b(k,252) = b(k,252) - lu(k,2247) * b(k,267) + b(k,251) = b(k,251) - lu(k,2246) * b(k,267) + b(k,245) = b(k,245) - lu(k,2245) * b(k,267) + b(k,241) = b(k,241) - lu(k,2244) * b(k,267) + b(k,237) = b(k,237) - lu(k,2243) * b(k,267) + b(k,236) = b(k,236) - lu(k,2242) * b(k,267) + b(k,235) = b(k,235) - lu(k,2241) * b(k,267) + b(k,230) = b(k,230) - lu(k,2240) * b(k,267) + b(k,227) = b(k,227) - lu(k,2239) * b(k,267) + b(k,223) = b(k,223) - lu(k,2238) * b(k,267) + b(k,220) = b(k,220) - lu(k,2237) * b(k,267) + b(k,217) = b(k,217) - lu(k,2236) * b(k,267) + b(k,216) = b(k,216) - lu(k,2235) * b(k,267) + b(k,209) = b(k,209) - lu(k,2234) * b(k,267) + b(k,204) = b(k,204) - lu(k,2233) * b(k,267) + b(k,184) = b(k,184) - lu(k,2232) * b(k,267) + b(k,182) = b(k,182) - lu(k,2231) * b(k,267) + b(k,181) = b(k,181) - lu(k,2230) * b(k,267) + b(k,166) = b(k,166) - lu(k,2229) * b(k,267) + b(k,157) = b(k,157) - lu(k,2228) * b(k,267) + b(k,148) = b(k,148) - lu(k,2227) * b(k,267) + b(k,136) = b(k,136) - lu(k,2226) * b(k,267) + b(k,135) = b(k,135) - lu(k,2225) * b(k,267) + b(k,133) = b(k,133) - lu(k,2224) * b(k,267) + b(k,106) = b(k,106) - lu(k,2223) * b(k,267) + b(k,266) = b(k,266) * lu(k,2214) + b(k,265) = b(k,265) - lu(k,2213) * b(k,266) + b(k,264) = b(k,264) - lu(k,2212) * b(k,266) + b(k,263) = b(k,263) - lu(k,2211) * b(k,266) + b(k,262) = b(k,262) - lu(k,2210) * b(k,266) + b(k,261) = b(k,261) - lu(k,2209) * b(k,266) + b(k,260) = b(k,260) - lu(k,2208) * b(k,266) + b(k,259) = b(k,259) - lu(k,2207) * b(k,266) + b(k,258) = b(k,258) - lu(k,2206) * b(k,266) + b(k,257) = b(k,257) - lu(k,2205) * b(k,266) + b(k,256) = b(k,256) - lu(k,2204) * b(k,266) + b(k,255) = b(k,255) - lu(k,2203) * b(k,266) + b(k,253) = b(k,253) - lu(k,2202) * b(k,266) + b(k,252) = b(k,252) - lu(k,2201) * b(k,266) + b(k,251) = b(k,251) - lu(k,2200) * b(k,266) + b(k,250) = b(k,250) - lu(k,2199) * b(k,266) + b(k,249) = b(k,249) - lu(k,2198) * b(k,266) + b(k,248) = b(k,248) - lu(k,2197) * b(k,266) + b(k,247) = b(k,247) - lu(k,2196) * b(k,266) + b(k,246) = b(k,246) - lu(k,2195) * b(k,266) + b(k,245) = b(k,245) - lu(k,2194) * b(k,266) + b(k,244) = b(k,244) - lu(k,2193) * b(k,266) + b(k,243) = b(k,243) - lu(k,2192) * b(k,266) + b(k,242) = b(k,242) - lu(k,2191) * b(k,266) + b(k,241) = b(k,241) - lu(k,2190) * b(k,266) + b(k,240) = b(k,240) - lu(k,2189) * b(k,266) + b(k,238) = b(k,238) - lu(k,2188) * b(k,266) + b(k,237) = b(k,237) - lu(k,2187) * b(k,266) + b(k,236) = b(k,236) - lu(k,2186) * b(k,266) + b(k,235) = b(k,235) - lu(k,2185) * b(k,266) + b(k,233) = b(k,233) - lu(k,2184) * b(k,266) + b(k,232) = b(k,232) - lu(k,2183) * b(k,266) + b(k,230) = b(k,230) - lu(k,2182) * b(k,266) + b(k,229) = b(k,229) - lu(k,2181) * b(k,266) + b(k,228) = b(k,228) - lu(k,2180) * b(k,266) + b(k,227) = b(k,227) - lu(k,2179) * b(k,266) + b(k,226) = b(k,226) - lu(k,2178) * b(k,266) + b(k,220) = b(k,220) - lu(k,2177) * b(k,266) + b(k,218) = b(k,218) - lu(k,2176) * b(k,266) + b(k,217) = b(k,217) - lu(k,2175) * b(k,266) + b(k,216) = b(k,216) - lu(k,2174) * b(k,266) + b(k,215) = b(k,215) - lu(k,2173) * b(k,266) + b(k,210) = b(k,210) - lu(k,2172) * b(k,266) + b(k,209) = b(k,209) - lu(k,2171) * b(k,266) + b(k,208) = b(k,208) - lu(k,2170) * b(k,266) + b(k,205) = b(k,205) - lu(k,2169) * b(k,266) + b(k,204) = b(k,204) - lu(k,2168) * b(k,266) + b(k,203) = b(k,203) - lu(k,2167) * b(k,266) + b(k,202) = b(k,202) - lu(k,2166) * b(k,266) + b(k,201) = b(k,201) - lu(k,2165) * b(k,266) + b(k,200) = b(k,200) - lu(k,2164) * b(k,266) + b(k,198) = b(k,198) - lu(k,2163) * b(k,266) + b(k,197) = b(k,197) - lu(k,2162) * b(k,266) + b(k,196) = b(k,196) - lu(k,2161) * b(k,266) + b(k,194) = b(k,194) - lu(k,2160) * b(k,266) + b(k,193) = b(k,193) - lu(k,2159) * b(k,266) + b(k,192) = b(k,192) - lu(k,2158) * b(k,266) + b(k,190) = b(k,190) - lu(k,2157) * b(k,266) + b(k,188) = b(k,188) - lu(k,2156) * b(k,266) + b(k,186) = b(k,186) - lu(k,2155) * b(k,266) + b(k,184) = b(k,184) - lu(k,2154) * b(k,266) + b(k,183) = b(k,183) - lu(k,2153) * b(k,266) + b(k,177) = b(k,177) - lu(k,2152) * b(k,266) + b(k,174) = b(k,174) - lu(k,2151) * b(k,266) + b(k,172) = b(k,172) - lu(k,2150) * b(k,266) + b(k,170) = b(k,170) - lu(k,2149) * b(k,266) + b(k,169) = b(k,169) - lu(k,2148) * b(k,266) + b(k,168) = b(k,168) - lu(k,2147) * b(k,266) + b(k,167) = b(k,167) - lu(k,2146) * b(k,266) + b(k,165) = b(k,165) - lu(k,2145) * b(k,266) + b(k,164) = b(k,164) - lu(k,2144) * b(k,266) + b(k,163) = b(k,163) - lu(k,2143) * b(k,266) + b(k,161) = b(k,161) - lu(k,2142) * b(k,266) + b(k,160) = b(k,160) - lu(k,2141) * b(k,266) + b(k,159) = b(k,159) - lu(k,2140) * b(k,266) + b(k,156) = b(k,156) - lu(k,2139) * b(k,266) + b(k,155) = b(k,155) - lu(k,2138) * b(k,266) + b(k,154) = b(k,154) - lu(k,2137) * b(k,266) + b(k,153) = b(k,153) - lu(k,2136) * b(k,266) + b(k,152) = b(k,152) - lu(k,2135) * b(k,266) + b(k,151) = b(k,151) - lu(k,2134) * b(k,266) + b(k,146) = b(k,146) - lu(k,2133) * b(k,266) + b(k,145) = b(k,145) - lu(k,2132) * b(k,266) + b(k,143) = b(k,143) - lu(k,2131) * b(k,266) + b(k,142) = b(k,142) - lu(k,2130) * b(k,266) + b(k,141) = b(k,141) - lu(k,2129) * b(k,266) + b(k,131) = b(k,131) - lu(k,2128) * b(k,266) + b(k,115) = b(k,115) - lu(k,2127) * b(k,266) + b(k,100) = b(k,100) - lu(k,2126) * b(k,266) + b(k,88) = b(k,88) - lu(k,2125) * b(k,266) + b(k,87) = b(k,87) - lu(k,2124) * b(k,266) + b(k,82) = b(k,82) - lu(k,2123) * b(k,266) + b(k,81) = b(k,81) - lu(k,2122) * b(k,266) + b(k,80) = b(k,80) - lu(k,2121) * b(k,266) + b(k,79) = b(k,79) - lu(k,2120) * b(k,266) + b(k,78) = b(k,78) - lu(k,2119) * b(k,266) + b(k,77) = b(k,77) - lu(k,2118) * b(k,266) + b(k,76) = b(k,76) - lu(k,2117) * b(k,266) + b(k,75) = b(k,75) - lu(k,2116) * b(k,266) + b(k,74) = b(k,74) - lu(k,2115) * b(k,266) + b(k,73) = b(k,73) - lu(k,2114) * b(k,266) + b(k,72) = b(k,72) - lu(k,2113) * b(k,266) + b(k,71) = b(k,71) - lu(k,2112) * b(k,266) + b(k,70) = b(k,70) - lu(k,2111) * b(k,266) + b(k,69) = b(k,69) - lu(k,2110) * b(k,266) + b(k,68) = b(k,68) - lu(k,2109) * b(k,266) + b(k,66) = b(k,66) - lu(k,2108) * b(k,266) + b(k,65) = b(k,65) - lu(k,2107) * b(k,266) + b(k,64) = b(k,64) - lu(k,2106) * b(k,266) + b(k,63) = b(k,63) - lu(k,2105) * b(k,266) + b(k,62) = b(k,62) - lu(k,2104) * b(k,266) + b(k,61) = b(k,61) - lu(k,2103) * b(k,266) + b(k,265) = b(k,265) * lu(k,2093) + b(k,264) = b(k,264) - lu(k,2092) * b(k,265) + b(k,263) = b(k,263) - lu(k,2091) * b(k,265) + b(k,262) = b(k,262) - lu(k,2090) * b(k,265) + b(k,261) = b(k,261) - lu(k,2089) * b(k,265) + b(k,260) = b(k,260) - lu(k,2088) * b(k,265) + b(k,259) = b(k,259) - lu(k,2087) * b(k,265) + b(k,258) = b(k,258) - lu(k,2086) * b(k,265) + b(k,257) = b(k,257) - lu(k,2085) * b(k,265) + b(k,256) = b(k,256) - lu(k,2084) * b(k,265) + b(k,255) = b(k,255) - lu(k,2083) * b(k,265) + b(k,253) = b(k,253) - lu(k,2082) * b(k,265) + b(k,252) = b(k,252) - lu(k,2081) * b(k,265) + b(k,236) = b(k,236) - lu(k,2080) * b(k,265) + b(k,219) = b(k,219) - lu(k,2079) * b(k,265) + b(k,137) = b(k,137) - lu(k,2078) * b(k,265) + b(k,264) = b(k,264) * lu(k,2067) + b(k,263) = b(k,263) - lu(k,2066) * b(k,264) + b(k,262) = b(k,262) - lu(k,2065) * b(k,264) + b(k,261) = b(k,261) - lu(k,2064) * b(k,264) + b(k,260) = b(k,260) - lu(k,2063) * b(k,264) + b(k,259) = b(k,259) - lu(k,2062) * b(k,264) + b(k,258) = b(k,258) - lu(k,2061) * b(k,264) + b(k,257) = b(k,257) - lu(k,2060) * b(k,264) + b(k,256) = b(k,256) - lu(k,2059) * b(k,264) + b(k,254) = b(k,254) - lu(k,2058) * b(k,264) + b(k,252) = b(k,252) - lu(k,2057) * b(k,264) + b(k,251) = b(k,251) - lu(k,2056) * b(k,264) + b(k,250) = b(k,250) - lu(k,2055) * b(k,264) + b(k,249) = b(k,249) - lu(k,2054) * b(k,264) + b(k,248) = b(k,248) - lu(k,2053) * b(k,264) + b(k,247) = b(k,247) - lu(k,2052) * b(k,264) + b(k,246) = b(k,246) - lu(k,2051) * b(k,264) + b(k,245) = b(k,245) - lu(k,2050) * b(k,264) + b(k,244) = b(k,244) - lu(k,2049) * b(k,264) + b(k,243) = b(k,243) - lu(k,2048) * b(k,264) + b(k,242) = b(k,242) - lu(k,2047) * b(k,264) + b(k,241) = b(k,241) - lu(k,2046) * b(k,264) + b(k,240) = b(k,240) - lu(k,2045) * b(k,264) + b(k,239) = b(k,239) - lu(k,2044) * b(k,264) + b(k,238) = b(k,238) - lu(k,2043) * b(k,264) + b(k,237) = b(k,237) - lu(k,2042) * b(k,264) + b(k,236) = b(k,236) - lu(k,2041) * b(k,264) + b(k,235) = b(k,235) - lu(k,2040) * b(k,264) + b(k,234) = b(k,234) - lu(k,2039) * b(k,264) + b(k,233) = b(k,233) - lu(k,2038) * b(k,264) + b(k,232) = b(k,232) - lu(k,2037) * b(k,264) + b(k,231) = b(k,231) - lu(k,2036) * b(k,264) + b(k,230) = b(k,230) - lu(k,2035) * b(k,264) + b(k,229) = b(k,229) - lu(k,2034) * b(k,264) + b(k,228) = b(k,228) - lu(k,2033) * b(k,264) + b(k,227) = b(k,227) - lu(k,2032) * b(k,264) + b(k,226) = b(k,226) - lu(k,2031) * b(k,264) + b(k,225) = b(k,225) - lu(k,2030) * b(k,264) + b(k,222) = b(k,222) - lu(k,2029) * b(k,264) + b(k,221) = b(k,221) - lu(k,2028) * b(k,264) + b(k,216) = b(k,216) - lu(k,2027) * b(k,264) + b(k,215) = b(k,215) - lu(k,2026) * b(k,264) + b(k,214) = b(k,214) - lu(k,2025) * b(k,264) + b(k,180) = b(k,180) - lu(k,2024) * b(k,264) + b(k,149) = b(k,149) - lu(k,2023) * b(k,264) + b(k,147) = b(k,147) - lu(k,2022) * b(k,264) + b(k,138) = b(k,138) - lu(k,2021) * b(k,264) + b(k,132) = b(k,132) - lu(k,2020) * b(k,264) + b(k,72) = b(k,72) - lu(k,2019) * b(k,264) + b(k,71) = b(k,71) - lu(k,2018) * b(k,264) + end do + end subroutine lu_slv08 + subroutine lu_slv09( 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,263) = b(k,263) * lu(k,2006) + b(k,262) = b(k,262) - lu(k,2005) * b(k,263) + b(k,261) = b(k,261) - lu(k,2004) * b(k,263) + b(k,260) = b(k,260) - lu(k,2003) * b(k,263) + b(k,259) = b(k,259) - lu(k,2002) * b(k,263) + b(k,258) = b(k,258) - lu(k,2001) * b(k,263) + b(k,257) = b(k,257) - lu(k,2000) * b(k,263) + b(k,256) = b(k,256) - lu(k,1999) * b(k,263) + b(k,255) = b(k,255) - lu(k,1998) * b(k,263) + b(k,254) = b(k,254) - lu(k,1997) * b(k,263) + b(k,253) = b(k,253) - lu(k,1996) * b(k,263) + b(k,252) = b(k,252) - lu(k,1995) * b(k,263) + b(k,251) = b(k,251) - lu(k,1994) * b(k,263) + b(k,250) = b(k,250) - lu(k,1993) * b(k,263) + b(k,249) = b(k,249) - lu(k,1992) * b(k,263) + b(k,248) = b(k,248) - lu(k,1991) * b(k,263) + b(k,247) = b(k,247) - lu(k,1990) * b(k,263) + b(k,246) = b(k,246) - lu(k,1989) * b(k,263) + b(k,245) = b(k,245) - lu(k,1988) * b(k,263) + b(k,244) = b(k,244) - lu(k,1987) * b(k,263) + b(k,243) = b(k,243) - lu(k,1986) * b(k,263) + b(k,242) = b(k,242) - lu(k,1985) * b(k,263) + b(k,241) = b(k,241) - lu(k,1984) * b(k,263) + b(k,240) = b(k,240) - lu(k,1983) * b(k,263) + b(k,239) = b(k,239) - lu(k,1982) * b(k,263) + b(k,238) = b(k,238) - lu(k,1981) * b(k,263) + b(k,237) = b(k,237) - lu(k,1980) * b(k,263) + b(k,236) = b(k,236) - lu(k,1979) * b(k,263) + b(k,235) = b(k,235) - lu(k,1978) * b(k,263) + b(k,234) = b(k,234) - lu(k,1977) * b(k,263) + b(k,233) = b(k,233) - lu(k,1976) * b(k,263) + b(k,232) = b(k,232) - lu(k,1975) * b(k,263) + b(k,231) = b(k,231) - lu(k,1974) * b(k,263) + b(k,230) = b(k,230) - lu(k,1973) * b(k,263) + b(k,229) = b(k,229) - lu(k,1972) * b(k,263) + b(k,228) = b(k,228) - lu(k,1971) * b(k,263) + b(k,227) = b(k,227) - lu(k,1970) * b(k,263) + b(k,226) = b(k,226) - lu(k,1969) * b(k,263) + b(k,225) = b(k,225) - lu(k,1968) * b(k,263) + b(k,224) = b(k,224) - lu(k,1967) * b(k,263) + b(k,223) = b(k,223) - lu(k,1966) * b(k,263) + b(k,222) = b(k,222) - lu(k,1965) * b(k,263) + b(k,221) = b(k,221) - lu(k,1964) * b(k,263) + b(k,220) = b(k,220) - lu(k,1963) * b(k,263) + b(k,219) = b(k,219) - lu(k,1962) * b(k,263) + b(k,218) = b(k,218) - lu(k,1961) * b(k,263) + b(k,217) = b(k,217) - lu(k,1960) * b(k,263) + b(k,216) = b(k,216) - lu(k,1959) * b(k,263) + b(k,215) = b(k,215) - lu(k,1958) * b(k,263) + b(k,214) = b(k,214) - lu(k,1957) * b(k,263) + b(k,210) = b(k,210) - lu(k,1956) * b(k,263) + b(k,209) = b(k,209) - lu(k,1955) * b(k,263) + b(k,208) = b(k,208) - lu(k,1954) * b(k,263) + b(k,207) = b(k,207) - lu(k,1953) * b(k,263) + b(k,204) = b(k,204) - lu(k,1952) * b(k,263) + b(k,203) = b(k,203) - lu(k,1951) * b(k,263) + b(k,202) = b(k,202) - lu(k,1950) * b(k,263) + b(k,201) = b(k,201) - lu(k,1949) * b(k,263) + b(k,200) = b(k,200) - lu(k,1948) * b(k,263) + b(k,199) = b(k,199) - lu(k,1947) * b(k,263) + b(k,198) = b(k,198) - lu(k,1946) * b(k,263) + b(k,197) = b(k,197) - lu(k,1945) * b(k,263) + b(k,196) = b(k,196) - lu(k,1944) * b(k,263) + b(k,194) = b(k,194) - lu(k,1943) * b(k,263) + b(k,193) = b(k,193) - lu(k,1942) * b(k,263) + b(k,192) = b(k,192) - lu(k,1941) * b(k,263) + b(k,191) = b(k,191) - lu(k,1940) * b(k,263) + b(k,190) = b(k,190) - lu(k,1939) * b(k,263) + b(k,189) = b(k,189) - lu(k,1938) * b(k,263) + b(k,188) = b(k,188) - lu(k,1937) * b(k,263) + b(k,187) = b(k,187) - lu(k,1936) * b(k,263) + b(k,186) = b(k,186) - lu(k,1935) * b(k,263) + b(k,185) = b(k,185) - lu(k,1934) * b(k,263) + b(k,184) = b(k,184) - lu(k,1933) * b(k,263) + b(k,183) = b(k,183) - lu(k,1932) * b(k,263) + b(k,182) = b(k,182) - lu(k,1931) * b(k,263) + b(k,181) = b(k,181) - lu(k,1930) * b(k,263) + b(k,180) = b(k,180) - lu(k,1929) * b(k,263) + b(k,178) = b(k,178) - lu(k,1928) * b(k,263) + b(k,177) = b(k,177) - lu(k,1927) * b(k,263) + b(k,176) = b(k,176) - lu(k,1926) * b(k,263) + b(k,174) = b(k,174) - lu(k,1925) * b(k,263) + b(k,173) = b(k,173) - lu(k,1924) * b(k,263) + b(k,172) = b(k,172) - lu(k,1923) * b(k,263) + b(k,170) = b(k,170) - lu(k,1922) * b(k,263) + b(k,169) = b(k,169) - lu(k,1921) * b(k,263) + b(k,168) = b(k,168) - lu(k,1920) * b(k,263) + b(k,167) = b(k,167) - lu(k,1919) * b(k,263) + b(k,166) = b(k,166) - lu(k,1918) * b(k,263) + b(k,164) = b(k,164) - lu(k,1917) * b(k,263) + b(k,163) = b(k,163) - lu(k,1916) * b(k,263) + b(k,162) = b(k,162) - lu(k,1915) * b(k,263) + b(k,160) = b(k,160) - lu(k,1914) * b(k,263) + b(k,159) = b(k,159) - lu(k,1913) * b(k,263) + b(k,157) = b(k,157) - lu(k,1912) * b(k,263) + b(k,156) = b(k,156) - lu(k,1911) * b(k,263) + b(k,155) = b(k,155) - lu(k,1910) * b(k,263) + b(k,154) = b(k,154) - lu(k,1909) * b(k,263) + b(k,153) = b(k,153) - lu(k,1908) * b(k,263) + b(k,152) = b(k,152) - lu(k,1907) * b(k,263) + b(k,151) = b(k,151) - lu(k,1906) * b(k,263) + b(k,150) = b(k,150) - lu(k,1905) * b(k,263) + b(k,149) = b(k,149) - lu(k,1904) * b(k,263) + b(k,148) = b(k,148) - lu(k,1903) * b(k,263) + b(k,147) = b(k,147) - lu(k,1902) * b(k,263) + b(k,146) = b(k,146) - lu(k,1901) * b(k,263) + b(k,145) = b(k,145) - lu(k,1900) * b(k,263) + b(k,143) = b(k,143) - lu(k,1899) * b(k,263) + b(k,142) = b(k,142) - lu(k,1898) * b(k,263) + b(k,141) = b(k,141) - lu(k,1897) * b(k,263) + b(k,139) = b(k,139) - lu(k,1896) * b(k,263) + b(k,138) = b(k,138) - lu(k,1895) * b(k,263) + b(k,136) = b(k,136) - lu(k,1894) * b(k,263) + b(k,135) = b(k,135) - lu(k,1893) * b(k,263) + b(k,133) = b(k,133) - lu(k,1892) * b(k,263) + b(k,131) = b(k,131) - lu(k,1891) * b(k,263) + b(k,130) = b(k,130) - lu(k,1890) * b(k,263) + b(k,129) = b(k,129) - lu(k,1889) * b(k,263) + b(k,127) = b(k,127) - lu(k,1888) * b(k,263) + b(k,126) = b(k,126) - lu(k,1887) * b(k,263) + b(k,125) = b(k,125) - lu(k,1886) * b(k,263) + b(k,124) = b(k,124) - lu(k,1885) * b(k,263) + b(k,123) = b(k,123) - lu(k,1884) * b(k,263) + b(k,122) = b(k,122) - lu(k,1883) * b(k,263) + b(k,120) = b(k,120) - lu(k,1882) * b(k,263) + b(k,119) = b(k,119) - lu(k,1881) * b(k,263) + b(k,118) = b(k,118) - lu(k,1880) * b(k,263) + b(k,117) = b(k,117) - lu(k,1879) * b(k,263) + b(k,116) = b(k,116) - lu(k,1878) * b(k,263) + b(k,115) = b(k,115) - lu(k,1877) * b(k,263) + b(k,114) = b(k,114) - lu(k,1876) * b(k,263) + b(k,113) = b(k,113) - lu(k,1875) * b(k,263) + b(k,112) = b(k,112) - lu(k,1874) * b(k,263) + b(k,109) = b(k,109) - lu(k,1873) * b(k,263) + b(k,108) = b(k,108) - lu(k,1872) * b(k,263) + b(k,107) = b(k,107) - lu(k,1871) * b(k,263) + b(k,98) = b(k,98) - lu(k,1870) * b(k,263) + b(k,96) = b(k,96) - lu(k,1869) * b(k,263) + b(k,91) = b(k,91) - lu(k,1868) * b(k,263) + b(k,89) = b(k,89) - lu(k,1867) * b(k,263) + b(k,88) = b(k,88) - lu(k,1866) * b(k,263) + b(k,87) = b(k,87) - lu(k,1865) * b(k,263) + b(k,86) = b(k,86) - lu(k,1864) * b(k,263) + b(k,85) = b(k,85) - lu(k,1863) * b(k,263) + b(k,83) = b(k,83) - lu(k,1862) * b(k,263) + b(k,82) = b(k,82) - lu(k,1861) * b(k,263) + b(k,81) = b(k,81) - lu(k,1860) * b(k,263) + b(k,80) = b(k,80) - lu(k,1859) * b(k,263) + b(k,79) = b(k,79) - lu(k,1858) * b(k,263) + b(k,78) = b(k,78) - lu(k,1857) * b(k,263) + b(k,77) = b(k,77) - lu(k,1856) * b(k,263) + b(k,76) = b(k,76) - lu(k,1855) * b(k,263) + b(k,75) = b(k,75) - lu(k,1854) * b(k,263) + b(k,74) = b(k,74) - lu(k,1853) * b(k,263) + b(k,73) = b(k,73) - lu(k,1852) * b(k,263) + b(k,67) = b(k,67) - lu(k,1851) * b(k,263) + b(k,66) = b(k,66) - lu(k,1850) * b(k,263) + b(k,65) = b(k,65) - lu(k,1849) * b(k,263) + b(k,64) = b(k,64) - lu(k,1848) * b(k,263) + b(k,63) = b(k,63) - lu(k,1847) * b(k,263) + b(k,62) = b(k,62) - lu(k,1846) * b(k,263) + b(k,61) = b(k,61) - lu(k,1845) * b(k,263) + b(k,262) = b(k,262) * lu(k,1832) + b(k,261) = b(k,261) - lu(k,1831) * b(k,262) + b(k,260) = b(k,260) - lu(k,1830) * b(k,262) + b(k,259) = b(k,259) - lu(k,1829) * b(k,262) + b(k,258) = b(k,258) - lu(k,1828) * b(k,262) + b(k,257) = b(k,257) - lu(k,1827) * b(k,262) + b(k,256) = b(k,256) - lu(k,1826) * b(k,262) + b(k,255) = b(k,255) - lu(k,1825) * b(k,262) + b(k,253) = b(k,253) - lu(k,1824) * b(k,262) + b(k,219) = b(k,219) - lu(k,1823) * b(k,262) + b(k,210) = b(k,210) - lu(k,1822) * b(k,262) + b(k,182) = b(k,182) - lu(k,1821) * b(k,262) + b(k,166) = b(k,166) - lu(k,1820) * b(k,262) + b(k,157) = b(k,157) - lu(k,1819) * b(k,262) + b(k,139) = b(k,139) - lu(k,1818) * b(k,262) + b(k,128) = b(k,128) - lu(k,1817) * b(k,262) + b(k,127) = b(k,127) - lu(k,1816) * b(k,262) + b(k,126) = b(k,126) - lu(k,1815) * b(k,262) + b(k,125) = b(k,125) - lu(k,1814) * b(k,262) + b(k,119) = b(k,119) - lu(k,1813) * b(k,262) + b(k,116) = b(k,116) - lu(k,1812) * b(k,262) + b(k,111) = b(k,111) - lu(k,1811) * b(k,262) + b(k,105) = b(k,105) - lu(k,1810) * b(k,262) + b(k,104) = b(k,104) - lu(k,1809) * b(k,262) + b(k,103) = b(k,103) - lu(k,1808) * b(k,262) + b(k,102) = b(k,102) - lu(k,1807) * b(k,262) + b(k,97) = b(k,97) - lu(k,1806) * b(k,262) + b(k,95) = b(k,95) - lu(k,1805) * b(k,262) + b(k,94) = b(k,94) - lu(k,1804) * b(k,262) + b(k,93) = b(k,93) - lu(k,1803) * b(k,262) + b(k,90) = b(k,90) - lu(k,1802) * b(k,262) + b(k,261) = b(k,261) * lu(k,1788) + b(k,260) = b(k,260) - lu(k,1787) * b(k,261) + b(k,259) = b(k,259) - lu(k,1786) * b(k,261) + b(k,258) = b(k,258) - lu(k,1785) * b(k,261) + b(k,257) = b(k,257) - lu(k,1784) * b(k,261) + b(k,256) = b(k,256) - lu(k,1783) * b(k,261) + b(k,252) = b(k,252) - lu(k,1782) * b(k,261) + b(k,251) = b(k,251) - lu(k,1781) * b(k,261) + b(k,250) = b(k,250) - lu(k,1780) * b(k,261) + b(k,249) = b(k,249) - lu(k,1779) * b(k,261) + b(k,248) = b(k,248) - lu(k,1778) * b(k,261) + b(k,247) = b(k,247) - lu(k,1777) * b(k,261) + b(k,246) = b(k,246) - lu(k,1776) * b(k,261) + b(k,245) = b(k,245) - lu(k,1775) * b(k,261) + b(k,244) = b(k,244) - lu(k,1774) * b(k,261) + b(k,243) = b(k,243) - lu(k,1773) * b(k,261) + b(k,242) = b(k,242) - lu(k,1772) * b(k,261) + b(k,241) = b(k,241) - lu(k,1771) * b(k,261) + b(k,240) = b(k,240) - lu(k,1770) * b(k,261) + b(k,239) = b(k,239) - lu(k,1769) * b(k,261) + b(k,238) = b(k,238) - lu(k,1768) * b(k,261) + b(k,237) = b(k,237) - lu(k,1767) * b(k,261) + b(k,236) = b(k,236) - lu(k,1766) * b(k,261) + b(k,235) = b(k,235) - lu(k,1765) * b(k,261) + b(k,233) = b(k,233) - lu(k,1764) * b(k,261) + b(k,232) = b(k,232) - lu(k,1763) * b(k,261) + b(k,231) = b(k,231) - lu(k,1762) * b(k,261) + b(k,230) = b(k,230) - lu(k,1761) * b(k,261) + b(k,229) = b(k,229) - lu(k,1760) * b(k,261) + b(k,228) = b(k,228) - lu(k,1759) * b(k,261) + b(k,227) = b(k,227) - lu(k,1758) * b(k,261) + b(k,226) = b(k,226) - lu(k,1757) * b(k,261) + b(k,224) = b(k,224) - lu(k,1756) * b(k,261) + b(k,220) = b(k,220) - lu(k,1755) * b(k,261) + b(k,218) = b(k,218) - lu(k,1754) * b(k,261) + b(k,217) = b(k,217) - lu(k,1753) * b(k,261) + b(k,216) = b(k,216) - lu(k,1752) * b(k,261) + b(k,215) = b(k,215) - lu(k,1751) * b(k,261) + b(k,213) = b(k,213) - lu(k,1750) * b(k,261) + b(k,212) = b(k,212) - lu(k,1749) * b(k,261) + b(k,211) = b(k,211) - lu(k,1748) * b(k,261) + b(k,208) = b(k,208) - lu(k,1747) * b(k,261) + b(k,204) = b(k,204) - lu(k,1746) * b(k,261) + b(k,203) = b(k,203) - lu(k,1745) * b(k,261) + b(k,202) = b(k,202) - lu(k,1744) * b(k,261) + b(k,201) = b(k,201) - lu(k,1743) * b(k,261) + b(k,200) = b(k,200) - lu(k,1742) * b(k,261) + b(k,193) = b(k,193) - lu(k,1741) * b(k,261) + b(k,191) = b(k,191) - lu(k,1740) * b(k,261) + b(k,190) = b(k,190) - lu(k,1739) * b(k,261) + b(k,189) = b(k,189) - lu(k,1738) * b(k,261) + b(k,188) = b(k,188) - lu(k,1737) * b(k,261) + b(k,185) = b(k,185) - lu(k,1736) * b(k,261) + b(k,180) = b(k,180) - lu(k,1735) * b(k,261) + b(k,178) = b(k,178) - lu(k,1734) * b(k,261) + b(k,174) = b(k,174) - lu(k,1733) * b(k,261) + b(k,173) = b(k,173) - lu(k,1732) * b(k,261) + b(k,172) = b(k,172) - lu(k,1731) * b(k,261) + b(k,170) = b(k,170) - lu(k,1730) * b(k,261) + b(k,169) = b(k,169) - lu(k,1729) * b(k,261) + b(k,165) = b(k,165) - lu(k,1728) * b(k,261) + b(k,164) = b(k,164) - lu(k,1727) * b(k,261) + b(k,163) = b(k,163) - lu(k,1726) * b(k,261) + b(k,161) = b(k,161) - lu(k,1725) * b(k,261) + b(k,160) = b(k,160) - lu(k,1724) * b(k,261) + b(k,147) = b(k,147) - lu(k,1723) * b(k,261) + b(k,144) = b(k,144) - lu(k,1722) * b(k,261) + b(k,134) = b(k,134) - lu(k,1721) * b(k,261) + b(k,123) = b(k,123) - lu(k,1720) * b(k,261) + b(k,122) = b(k,122) - lu(k,1719) * b(k,261) + b(k,88) = b(k,88) - lu(k,1718) * b(k,261) + b(k,87) = b(k,87) - lu(k,1717) * b(k,261) + b(k,82) = b(k,82) - lu(k,1716) * b(k,261) + b(k,81) = b(k,81) - lu(k,1715) * b(k,261) + b(k,80) = b(k,80) - lu(k,1714) * b(k,261) + b(k,79) = b(k,79) - lu(k,1713) * b(k,261) + b(k,78) = b(k,78) - lu(k,1712) * b(k,261) + b(k,77) = b(k,77) - lu(k,1711) * b(k,261) + b(k,76) = b(k,76) - lu(k,1710) * b(k,261) + b(k,75) = b(k,75) - lu(k,1709) * b(k,261) + b(k,74) = b(k,74) - lu(k,1708) * b(k,261) + b(k,73) = b(k,73) - lu(k,1707) * b(k,261) + b(k,72) = b(k,72) - lu(k,1706) * b(k,261) + b(k,71) = b(k,71) - lu(k,1705) * b(k,261) + b(k,70) = b(k,70) - lu(k,1704) * b(k,261) + b(k,69) = b(k,69) - lu(k,1703) * b(k,261) + b(k,68) = b(k,68) - lu(k,1702) * b(k,261) + b(k,66) = b(k,66) - lu(k,1701) * b(k,261) + b(k,65) = b(k,65) - lu(k,1700) * b(k,261) + b(k,64) = b(k,64) - lu(k,1699) * b(k,261) + b(k,63) = b(k,63) - lu(k,1698) * b(k,261) + b(k,62) = b(k,62) - lu(k,1697) * b(k,261) + b(k,61) = b(k,61) - lu(k,1696) * b(k,261) + end do + end subroutine lu_slv09 + subroutine lu_slv10( 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,260) = b(k,260) * lu(k,1681) + b(k,259) = b(k,259) - lu(k,1680) * b(k,260) + b(k,258) = b(k,258) - lu(k,1679) * b(k,260) + b(k,257) = b(k,257) - lu(k,1678) * b(k,260) + b(k,256) = b(k,256) - lu(k,1677) * b(k,260) + b(k,255) = b(k,255) - lu(k,1676) * b(k,260) + b(k,254) = b(k,254) - lu(k,1675) * b(k,260) + b(k,252) = b(k,252) - lu(k,1674) * b(k,260) + b(k,251) = b(k,251) - lu(k,1673) * b(k,260) + b(k,250) = b(k,250) - lu(k,1672) * b(k,260) + b(k,245) = b(k,245) - lu(k,1671) * b(k,260) + b(k,240) = b(k,240) - lu(k,1670) * b(k,260) + b(k,236) = b(k,236) - lu(k,1669) * b(k,260) + b(k,227) = b(k,227) - lu(k,1668) * b(k,260) + b(k,224) = b(k,224) - lu(k,1667) * b(k,260) + b(k,223) = b(k,223) - lu(k,1666) * b(k,260) + b(k,221) = b(k,221) - lu(k,1665) * b(k,260) + b(k,218) = b(k,218) - lu(k,1664) * b(k,260) + b(k,205) = b(k,205) - lu(k,1663) * b(k,260) + b(k,203) = b(k,203) - lu(k,1662) * b(k,260) + b(k,200) = b(k,200) - lu(k,1661) * b(k,260) + b(k,190) = b(k,190) - lu(k,1660) * b(k,260) + b(k,187) = b(k,187) - lu(k,1659) * b(k,260) + b(k,179) = b(k,179) - lu(k,1658) * b(k,260) + b(k,176) = b(k,176) - lu(k,1657) * b(k,260) + b(k,174) = b(k,174) - lu(k,1656) * b(k,260) + b(k,169) = b(k,169) - lu(k,1655) * b(k,260) + b(k,167) = b(k,167) - lu(k,1654) * b(k,260) + b(k,132) = b(k,132) - lu(k,1653) * b(k,260) + b(k,128) = b(k,128) - lu(k,1652) * b(k,260) + b(k,101) = b(k,101) - lu(k,1651) * b(k,260) + b(k,259) = b(k,259) * lu(k,1636) + b(k,258) = b(k,258) - lu(k,1635) * b(k,259) + b(k,257) = b(k,257) - lu(k,1634) * b(k,259) + b(k,256) = b(k,256) - lu(k,1633) * b(k,259) + b(k,255) = b(k,255) - lu(k,1632) * b(k,259) + b(k,254) = b(k,254) - lu(k,1631) * b(k,259) + b(k,223) = b(k,223) - lu(k,1630) * b(k,259) + b(k,221) = b(k,221) - lu(k,1629) * b(k,259) + b(k,209) = b(k,209) - lu(k,1628) * b(k,259) + b(k,140) = b(k,140) - lu(k,1627) * b(k,259) + b(k,121) = b(k,121) - lu(k,1626) * b(k,259) + b(k,106) = b(k,106) - lu(k,1625) * b(k,259) + b(k,92) = b(k,92) - lu(k,1624) * b(k,259) + b(k,258) = b(k,258) * lu(k,1609) + b(k,257) = b(k,257) - lu(k,1608) * b(k,258) + b(k,256) = b(k,256) - lu(k,1607) * b(k,258) + b(k,255) = b(k,255) - lu(k,1606) * b(k,258) + b(k,254) = b(k,254) - lu(k,1605) * b(k,258) + b(k,221) = b(k,221) - lu(k,1604) * b(k,258) + b(k,205) = b(k,205) - lu(k,1603) * b(k,258) + b(k,179) = b(k,179) - lu(k,1602) * b(k,258) + b(k,140) = b(k,140) - lu(k,1601) * b(k,258) + b(k,121) = b(k,121) - lu(k,1600) * b(k,258) + b(k,257) = b(k,257) * lu(k,1586) + b(k,256) = b(k,256) - lu(k,1585) * b(k,257) + b(k,254) = b(k,254) - lu(k,1584) * b(k,257) + b(k,252) = b(k,252) - lu(k,1583) * b(k,257) + b(k,237) = b(k,237) - lu(k,1582) * b(k,257) + b(k,236) = b(k,236) - lu(k,1581) * b(k,257) + b(k,224) = b(k,224) - lu(k,1580) * b(k,257) + b(k,221) = b(k,221) - lu(k,1579) * b(k,257) + b(k,213) = b(k,213) - lu(k,1578) * b(k,257) + b(k,212) = b(k,212) - lu(k,1577) * b(k,257) + b(k,211) = b(k,211) - lu(k,1576) * b(k,257) + b(k,206) = b(k,206) - lu(k,1575) * b(k,257) + b(k,199) = b(k,199) - lu(k,1574) * b(k,257) + b(k,195) = b(k,195) - lu(k,1573) * b(k,257) + b(k,175) = b(k,175) - lu(k,1572) * b(k,257) + b(k,171) = b(k,171) - lu(k,1571) * b(k,257) + b(k,165) = b(k,165) - lu(k,1570) * b(k,257) + b(k,111) = b(k,111) - lu(k,1569) * b(k,257) + b(k,110) = b(k,110) - lu(k,1568) * b(k,257) + b(k,256) = b(k,256) * lu(k,1555) + b(k,252) = b(k,252) - lu(k,1554) * b(k,256) + b(k,236) = b(k,236) - lu(k,1553) * b(k,256) + b(k,210) = b(k,210) - lu(k,1552) * b(k,256) + b(k,255) = b(k,255) * lu(k,1539) + b(k,223) = b(k,223) - lu(k,1538) * b(k,255) + b(k,209) = b(k,209) - lu(k,1537) * b(k,255) + b(k,205) = b(k,205) - lu(k,1536) * b(k,255) + b(k,121) = b(k,121) - lu(k,1535) * b(k,255) + b(k,106) = b(k,106) - lu(k,1534) * b(k,255) + b(k,254) = b(k,254) * lu(k,1520) + b(k,221) = b(k,221) - lu(k,1519) * b(k,254) + b(k,199) = b(k,199) - lu(k,1518) * b(k,254) + b(k,140) = b(k,140) - lu(k,1517) * b(k,254) + b(k,253) = b(k,253) * lu(k,1505) + b(k,219) = b(k,219) - lu(k,1504) * b(k,253) + b(k,137) = b(k,137) - lu(k,1503) * b(k,253) + b(k,252) = b(k,252) * lu(k,1494) + b(k,236) = b(k,236) - lu(k,1493) * b(k,252) + b(k,224) = b(k,224) - lu(k,1492) * b(k,252) + b(k,213) = b(k,213) - lu(k,1491) * b(k,252) + b(k,212) = b(k,212) - lu(k,1490) * b(k,252) + b(k,211) = b(k,211) - lu(k,1489) * b(k,252) + b(k,206) = b(k,206) - lu(k,1488) * b(k,252) + b(k,111) = b(k,111) - lu(k,1487) * b(k,252) + b(k,110) = b(k,110) - lu(k,1486) * b(k,252) + b(k,251) = b(k,251) * lu(k,1472) + b(k,250) = b(k,250) - lu(k,1471) * b(k,251) + b(k,249) = b(k,249) - lu(k,1470) * b(k,251) + b(k,248) = b(k,248) - lu(k,1469) * b(k,251) + b(k,247) = b(k,247) - lu(k,1468) * b(k,251) + b(k,246) = b(k,246) - lu(k,1467) * b(k,251) + b(k,245) = b(k,245) - lu(k,1466) * b(k,251) + b(k,244) = b(k,244) - lu(k,1465) * b(k,251) + b(k,243) = b(k,243) - lu(k,1464) * b(k,251) + b(k,242) = b(k,242) - lu(k,1463) * b(k,251) + b(k,240) = b(k,240) - lu(k,1462) * b(k,251) + b(k,237) = b(k,237) - lu(k,1461) * b(k,251) + b(k,236) = b(k,236) - lu(k,1460) * b(k,251) + b(k,231) = b(k,231) - lu(k,1459) * b(k,251) + b(k,227) = b(k,227) - lu(k,1458) * b(k,251) + b(k,196) = b(k,196) - lu(k,1457) * b(k,251) + b(k,183) = b(k,183) - lu(k,1456) * b(k,251) + b(k,176) = b(k,176) - lu(k,1455) * b(k,251) + b(k,147) = b(k,147) - lu(k,1454) * b(k,251) + b(k,250) = b(k,250) * lu(k,1441) + b(k,245) = b(k,245) - lu(k,1440) * b(k,250) + b(k,240) = b(k,240) - lu(k,1439) * b(k,250) + b(k,196) = b(k,196) - lu(k,1438) * b(k,250) + b(k,187) = b(k,187) - lu(k,1437) * b(k,250) + b(k,183) = b(k,183) - lu(k,1436) * b(k,250) + b(k,249) = b(k,249) * lu(k,1420) + b(k,248) = b(k,248) - lu(k,1419) * b(k,249) + b(k,245) = b(k,245) - lu(k,1418) * b(k,249) + b(k,240) = b(k,240) - lu(k,1417) * b(k,249) + b(k,236) = b(k,236) - lu(k,1416) * b(k,249) + b(k,235) = b(k,235) - lu(k,1415) * b(k,249) + b(k,234) = b(k,234) - lu(k,1414) * b(k,249) + b(k,216) = b(k,216) - lu(k,1413) * b(k,249) + b(k,248) = b(k,248) * lu(k,1400) + b(k,245) = b(k,245) - lu(k,1399) * b(k,248) + b(k,241) = b(k,241) - lu(k,1398) * b(k,248) + b(k,240) = b(k,240) - lu(k,1397) * b(k,248) + b(k,239) = b(k,239) - lu(k,1396) * b(k,248) + b(k,237) = b(k,237) - lu(k,1395) * b(k,248) + b(k,236) = b(k,236) - lu(k,1394) * b(k,248) + b(k,207) = b(k,207) - lu(k,1393) * b(k,248) + b(k,146) = b(k,146) - lu(k,1392) * b(k,248) + b(k,247) = b(k,247) * lu(k,1376) + b(k,245) = b(k,245) - lu(k,1375) * b(k,247) + b(k,244) = b(k,244) - lu(k,1374) * b(k,247) + b(k,242) = b(k,242) - lu(k,1373) * b(k,247) + b(k,241) = b(k,241) - lu(k,1372) * b(k,247) + b(k,240) = b(k,240) - lu(k,1371) * b(k,247) + b(k,239) = b(k,239) - lu(k,1370) * b(k,247) + b(k,237) = b(k,237) - lu(k,1369) * b(k,247) + b(k,236) = b(k,236) - lu(k,1368) * b(k,247) + b(k,227) = b(k,227) - lu(k,1367) * b(k,247) + b(k,218) = b(k,218) - lu(k,1366) * b(k,247) + b(k,215) = b(k,215) - lu(k,1365) * b(k,247) + b(k,207) = b(k,207) - lu(k,1364) * b(k,247) + b(k,197) = b(k,197) - lu(k,1363) * b(k,247) + b(k,188) = b(k,188) - lu(k,1362) * b(k,247) + b(k,178) = b(k,178) - lu(k,1361) * b(k,247) + b(k,147) = b(k,147) - lu(k,1360) * b(k,247) + b(k,124) = b(k,124) - lu(k,1359) * b(k,247) + b(k,246) = b(k,246) * lu(k,1343) + b(k,245) = b(k,245) - lu(k,1342) * b(k,246) + b(k,244) = b(k,244) - lu(k,1341) * b(k,246) + b(k,242) = b(k,242) - lu(k,1340) * b(k,246) + b(k,241) = b(k,241) - lu(k,1339) * b(k,246) + b(k,240) = b(k,240) - lu(k,1338) * b(k,246) + b(k,239) = b(k,239) - lu(k,1337) * b(k,246) + b(k,237) = b(k,237) - lu(k,1336) * b(k,246) + b(k,207) = b(k,207) - lu(k,1335) * b(k,246) + b(k,197) = b(k,197) - lu(k,1334) * b(k,246) + b(k,185) = b(k,185) - lu(k,1333) * b(k,246) + b(k,245) = b(k,245) * lu(k,1325) + b(k,236) = b(k,236) - lu(k,1324) * b(k,245) + b(k,244) = b(k,244) * lu(k,1313) + b(k,236) = b(k,236) - lu(k,1312) * b(k,244) + b(k,216) = b(k,216) - lu(k,1311) * b(k,244) + b(k,243) = b(k,243) * lu(k,1297) + b(k,242) = b(k,242) - lu(k,1296) * b(k,243) + b(k,237) = b(k,237) - lu(k,1295) * b(k,243) + b(k,236) = b(k,236) - lu(k,1294) * b(k,243) + b(k,231) = b(k,231) - lu(k,1293) * b(k,243) + b(k,215) = b(k,215) - lu(k,1292) * b(k,243) + b(k,207) = b(k,207) - lu(k,1291) * b(k,243) + b(k,197) = b(k,197) - lu(k,1290) * b(k,243) + b(k,162) = b(k,162) - lu(k,1289) * b(k,243) + b(k,154) = b(k,154) - lu(k,1288) * b(k,243) + b(k,242) = b(k,242) * lu(k,1277) + b(k,240) = b(k,240) - lu(k,1276) * b(k,242) + b(k,237) = b(k,237) - lu(k,1275) * b(k,242) + b(k,236) = b(k,236) - lu(k,1274) * b(k,242) + b(k,227) = b(k,227) - lu(k,1273) * b(k,242) + b(k,207) = b(k,207) - lu(k,1272) * b(k,242) + b(k,115) = b(k,115) - lu(k,1271) * b(k,242) + b(k,241) = b(k,241) * lu(k,1261) + b(k,240) = b(k,240) - lu(k,1260) * b(k,241) + b(k,207) = b(k,207) - lu(k,1259) * b(k,241) + b(k,151) = b(k,151) - lu(k,1258) * b(k,241) + b(k,240) = b(k,240) * lu(k,1252) + b(k,239) = b(k,239) * lu(k,1239) + b(k,237) = b(k,237) - lu(k,1238) * b(k,239) + b(k,236) = b(k,236) - lu(k,1237) * b(k,239) + b(k,235) = b(k,235) - lu(k,1236) * b(k,239) + b(k,230) = b(k,230) - lu(k,1235) * b(k,239) + b(k,122) = b(k,122) - lu(k,1234) * b(k,239) + end do + end subroutine lu_slv10 + subroutine lu_slv11( 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,238) = b(k,238) * lu(k,1222) + b(k,237) = b(k,237) - lu(k,1221) * b(k,238) + b(k,236) = b(k,236) - lu(k,1220) * b(k,238) + b(k,233) = b(k,233) - lu(k,1219) * b(k,238) + b(k,230) = b(k,230) - lu(k,1218) * b(k,238) + b(k,207) = b(k,207) - lu(k,1217) * b(k,238) + b(k,194) = b(k,194) - lu(k,1216) * b(k,238) + b(k,122) = b(k,122) - lu(k,1215) * b(k,238) + b(k,237) = b(k,237) * lu(k,1210) + b(k,236) = b(k,236) - lu(k,1209) * b(k,237) + b(k,227) = b(k,227) - lu(k,1208) * b(k,237) + b(k,236) = b(k,236) * lu(k,1204) + b(k,235) = b(k,235) * lu(k,1195) + b(k,234) = b(k,234) * lu(k,1177) + b(k,216) = b(k,216) - lu(k,1176) * b(k,234) + b(k,215) = b(k,215) - lu(k,1175) * b(k,234) + b(k,208) = b(k,208) - lu(k,1174) * b(k,234) + b(k,196) = b(k,196) - lu(k,1173) * b(k,234) + b(k,233) = b(k,233) * lu(k,1163) + b(k,230) = b(k,230) - lu(k,1162) * b(k,233) + b(k,232) = b(k,232) * lu(k,1150) + b(k,229) = b(k,229) - lu(k,1149) * b(k,232) + b(k,207) = b(k,207) - lu(k,1148) * b(k,232) + b(k,189) = b(k,189) - lu(k,1147) * b(k,232) + b(k,152) = b(k,152) - lu(k,1146) * b(k,232) + b(k,231) = b(k,231) * lu(k,1134) + b(k,227) = b(k,227) - lu(k,1133) * b(k,231) + b(k,218) = b(k,218) - lu(k,1132) * b(k,231) + b(k,215) = b(k,215) - lu(k,1131) * b(k,231) + b(k,188) = b(k,188) - lu(k,1130) * b(k,231) + b(k,230) = b(k,230) * lu(k,1124) + b(k,229) = b(k,229) * lu(k,1116) + b(k,228) = b(k,228) * lu(k,1106) + b(k,207) = b(k,207) - lu(k,1105) * b(k,228) + b(k,189) = b(k,189) - lu(k,1104) * b(k,228) + b(k,168) = b(k,168) - lu(k,1103) * b(k,228) + b(k,227) = b(k,227) * lu(k,1098) + b(k,68) = b(k,68) - lu(k,1097) * b(k,227) + b(k,226) = b(k,226) * lu(k,1086) + b(k,217) = b(k,217) - lu(k,1085) * b(k,226) + b(k,193) = b(k,193) - lu(k,1084) * b(k,226) + b(k,192) = b(k,192) - lu(k,1083) * b(k,226) + b(k,191) = b(k,191) - lu(k,1082) * b(k,226) + b(k,173) = b(k,173) - lu(k,1081) * b(k,226) + b(k,225) = b(k,225) * lu(k,1062) + b(k,216) = b(k,216) - lu(k,1061) * b(k,225) + b(k,158) = b(k,158) - lu(k,1060) * b(k,225) + b(k,120) = b(k,120) - lu(k,1059) * b(k,225) + b(k,75) = b(k,75) - lu(k,1058) * b(k,225) + b(k,72) = b(k,72) - lu(k,1057) * b(k,225) + b(k,71) = b(k,71) - lu(k,1056) * b(k,225) + b(k,70) = b(k,70) - lu(k,1055) * b(k,225) + b(k,69) = b(k,69) - lu(k,1054) * b(k,225) + b(k,68) = b(k,68) - lu(k,1053) * b(k,225) + b(k,224) = b(k,224) * lu(k,1043) + b(k,213) = b(k,213) - lu(k,1042) * b(k,224) + b(k,212) = b(k,212) - lu(k,1041) * b(k,224) + b(k,211) = b(k,211) - lu(k,1040) * b(k,224) + b(k,206) = b(k,206) - lu(k,1039) * b(k,224) + b(k,171) = b(k,171) - lu(k,1038) * b(k,224) + b(k,128) = b(k,128) - lu(k,1037) * b(k,224) + b(k,223) = b(k,223) * lu(k,1027) + b(k,209) = b(k,209) - lu(k,1026) * b(k,223) + b(k,106) = b(k,106) - lu(k,1025) * b(k,223) + b(k,222) = b(k,222) * lu(k,1006) + b(k,216) = b(k,216) - lu(k,1005) * b(k,222) + b(k,158) = b(k,158) - lu(k,1004) * b(k,222) + b(k,120) = b(k,120) - lu(k,1003) * b(k,222) + b(k,74) = b(k,74) - lu(k,1002) * b(k,222) + b(k,72) = b(k,72) - lu(k,1001) * b(k,222) + b(k,71) = b(k,71) - lu(k,1000) * b(k,222) + b(k,70) = b(k,70) - lu(k,999) * b(k,222) + b(k,69) = b(k,69) - lu(k,998) * b(k,222) + b(k,68) = b(k,68) - lu(k,997) * b(k,222) + b(k,221) = b(k,221) * lu(k,991) + b(k,129) = b(k,129) - lu(k,990) * b(k,221) + b(k,220) = b(k,220) * lu(k,979) + b(k,153) = b(k,153) - lu(k,978) * b(k,220) + b(k,219) = b(k,219) * lu(k,969) + b(k,137) = b(k,137) - lu(k,968) * b(k,219) + b(k,218) = b(k,218) * lu(k,959) + b(k,217) = b(k,217) * lu(k,950) + b(k,207) = b(k,207) - lu(k,949) * b(k,217) + b(k,143) = b(k,143) - lu(k,948) * b(k,217) + b(k,130) = b(k,130) - lu(k,947) * b(k,217) + b(k,216) = b(k,216) * lu(k,942) + b(k,215) = b(k,215) * lu(k,936) + b(k,214) = b(k,214) * lu(k,920) + b(k,73) = b(k,73) - lu(k,919) * b(k,214) + b(k,72) = b(k,72) - lu(k,918) * b(k,214) + b(k,71) = b(k,71) - lu(k,917) * b(k,214) + b(k,213) = b(k,213) * lu(k,909) + b(k,212) = b(k,212) - lu(k,908) * b(k,213) + b(k,211) = b(k,211) - lu(k,907) * b(k,213) + b(k,206) = b(k,206) - lu(k,906) * b(k,213) + b(k,195) = b(k,195) - lu(k,905) * b(k,213) + b(k,175) = b(k,175) - lu(k,904) * b(k,213) + b(k,212) = b(k,212) * lu(k,897) + b(k,211) = b(k,211) - lu(k,896) * b(k,212) + b(k,211) = b(k,211) * lu(k,889) + b(k,175) = b(k,175) - lu(k,888) * b(k,211) + b(k,210) = b(k,210) * lu(k,880) + b(k,209) = b(k,209) * lu(k,873) + b(k,106) = b(k,106) - lu(k,872) * b(k,209) + b(k,208) = b(k,208) * lu(k,862) + b(k,177) = b(k,177) - lu(k,861) * b(k,208) + b(k,207) = b(k,207) * lu(k,857) + b(k,206) = b(k,206) * lu(k,849) + b(k,205) = b(k,205) * lu(k,841) + b(k,121) = b(k,121) - lu(k,840) * b(k,205) + b(k,204) = b(k,204) * lu(k,832) + b(k,165) = b(k,165) - lu(k,831) * b(k,204) + b(k,100) = b(k,100) - lu(k,830) * b(k,204) + b(k,203) = b(k,203) * lu(k,822) + b(k,202) = b(k,202) * lu(k,811) + b(k,200) = b(k,200) - lu(k,810) * b(k,202) + b(k,198) = b(k,198) - lu(k,809) * b(k,202) + b(k,188) = b(k,188) - lu(k,808) * b(k,202) + b(k,164) = b(k,164) - lu(k,807) * b(k,202) + b(k,144) = b(k,144) - lu(k,806) * b(k,202) + b(k,134) = b(k,134) - lu(k,805) * b(k,202) + b(k,201) = b(k,201) * lu(k,795) + b(k,200) = b(k,200) - lu(k,794) * b(k,201) + b(k,188) = b(k,188) - lu(k,793) * b(k,201) + b(k,186) = b(k,186) - lu(k,792) * b(k,201) + b(k,164) = b(k,164) - lu(k,791) * b(k,201) + b(k,134) = b(k,134) - lu(k,790) * b(k,201) + b(k,200) = b(k,200) * lu(k,784) + b(k,199) = b(k,199) * lu(k,777) + b(k,198) = b(k,198) * lu(k,766) + b(k,188) = b(k,188) - lu(k,765) * b(k,198) + b(k,164) = b(k,164) - lu(k,764) * b(k,198) + b(k,144) = b(k,144) - lu(k,763) * b(k,198) + b(k,134) = b(k,134) - lu(k,762) * b(k,198) + b(k,197) = b(k,197) * lu(k,755) + b(k,98) = b(k,98) - lu(k,754) * b(k,197) + b(k,196) = b(k,196) * lu(k,749) + b(k,195) = b(k,195) * lu(k,739) + b(k,175) = b(k,175) - lu(k,738) * b(k,195) + b(k,194) = b(k,194) * lu(k,728) + b(k,193) = b(k,193) * lu(k,721) + b(k,145) = b(k,145) - lu(k,720) * b(k,193) + b(k,192) = b(k,192) * lu(k,710) + b(k,173) = b(k,173) - lu(k,709) * b(k,192) + b(k,191) = b(k,191) * lu(k,699) + b(k,173) = b(k,173) - lu(k,698) * b(k,191) + b(k,190) = b(k,190) * lu(k,692) + b(k,169) = b(k,169) - lu(k,691) * b(k,190) + b(k,131) = b(k,131) - lu(k,690) * b(k,190) + b(k,189) = b(k,189) * lu(k,684) + b(k,188) = b(k,188) * lu(k,680) + b(k,187) = b(k,187) * lu(k,671) + b(k,186) = b(k,186) * lu(k,662) + b(k,164) = b(k,164) - lu(k,661) * b(k,186) + b(k,134) = b(k,134) - lu(k,660) * b(k,186) + b(k,185) = b(k,185) * lu(k,651) + b(k,184) = b(k,184) * lu(k,644) + b(k,183) = b(k,183) * lu(k,637) + b(k,182) = b(k,182) * lu(k,628) + b(k,181) = b(k,181) * lu(k,620) + b(k,180) = b(k,180) * lu(k,612) + b(k,179) = b(k,179) * lu(k,604) + b(k,178) = b(k,178) * lu(k,596) + b(k,177) = b(k,177) * lu(k,588) + b(k,176) = b(k,176) * lu(k,580) + b(k,175) = b(k,175) * lu(k,575) + b(k,174) = b(k,174) * lu(k,569) + b(k,101) = b(k,101) - lu(k,568) * b(k,174) + b(k,173) = b(k,173) * lu(k,563) + b(k,172) = b(k,172) * lu(k,556) + b(k,159) = b(k,159) - lu(k,555) * b(k,172) + b(k,171) = b(k,171) * lu(k,548) + b(k,170) = b(k,170) * lu(k,541) + b(k,164) = b(k,164) - lu(k,540) * b(k,170) + b(k,155) = b(k,155) - lu(k,539) * b(k,170) + b(k,169) = b(k,169) * lu(k,535) + b(k,168) = b(k,168) * lu(k,528) + b(k,167) = b(k,167) * lu(k,521) + b(k,166) = b(k,166) * lu(k,514) + b(k,165) = b(k,165) * lu(k,509) + b(k,164) = b(k,164) * lu(k,506) + b(k,163) = b(k,163) * lu(k,500) + b(k,141) = b(k,141) - lu(k,499) * b(k,163) + b(k,162) = b(k,162) * lu(k,493) + b(k,161) = b(k,161) * lu(k,487) + b(k,160) = b(k,160) * lu(k,481) + b(k,142) = b(k,142) - lu(k,480) * b(k,160) + b(k,123) = b(k,123) - lu(k,479) * b(k,160) + b(k,159) = b(k,159) * lu(k,473) + b(k,158) = b(k,158) * lu(k,467) + b(k,157) = b(k,157) * lu(k,461) + b(k,156) = b(k,156) * lu(k,455) + b(k,155) = b(k,155) * lu(k,449) + b(k,154) = b(k,154) * lu(k,443) + b(k,153) = b(k,153) * lu(k,437) + b(k,152) = b(k,152) * lu(k,431) + b(k,151) = b(k,151) * lu(k,425) + b(k,150) = b(k,150) * lu(k,417) + b(k,149) = b(k,149) * lu(k,409) + b(k,148) = b(k,148) * lu(k,401) + b(k,147) = b(k,147) * lu(k,398) + end do + end subroutine lu_slv11 + subroutine lu_slv12( 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,146) = b(k,146) * lu(k,393) + b(k,145) = b(k,145) * lu(k,388) + b(k,144) = b(k,144) * lu(k,383) + b(k,143) = b(k,143) * lu(k,378) + b(k,142) = b(k,142) * lu(k,373) + b(k,123) = b(k,123) - lu(k,372) * b(k,142) + b(k,141) = b(k,141) * lu(k,367) + b(k,140) = b(k,140) * lu(k,362) + b(k,139) = b(k,139) * lu(k,356) + b(k,119) = b(k,119) - lu(k,355) * b(k,139) + b(k,138) = b(k,138) * lu(k,349) + b(k,137) = b(k,137) * lu(k,346) + b(k,136) = b(k,136) * lu(k,340) + b(k,135) = b(k,135) * lu(k,334) + b(k,134) = b(k,134) * lu(k,331) + b(k,133) = b(k,133) * lu(k,325) + b(k,132) = b(k,132) * lu(k,319) + b(k,131) = b(k,131) * lu(k,315) + b(k,130) = b(k,130) * lu(k,311) + b(k,129) = b(k,129) * lu(k,307) + b(k,99) = b(k,99) - lu(k,306) * b(k,129) + b(k,128) = b(k,128) * lu(k,302) + b(k,127) = b(k,127) * lu(k,297) + b(k,119) = b(k,119) - lu(k,296) * b(k,127) + b(k,126) = b(k,126) * lu(k,292) + b(k,125) = b(k,125) * lu(k,287) + b(k,124) = b(k,124) * lu(k,282) + b(k,123) = b(k,123) * lu(k,279) + b(k,122) = b(k,122) * lu(k,276) + b(k,121) = b(k,121) * lu(k,273) + b(k,120) = b(k,120) * lu(k,270) + b(k,119) = b(k,119) * lu(k,267) + b(k,118) = b(k,118) * lu(k,262) + b(k,117) = b(k,117) * lu(k,254) + b(k,114) = b(k,114) - lu(k,253) * b(k,117) + b(k,88) = b(k,88) - lu(k,252) * b(k,117) + b(k,116) = b(k,116) * lu(k,248) + b(k,115) = b(k,115) * lu(k,245) + b(k,114) = b(k,114) * lu(k,241) + b(k,113) = b(k,113) * lu(k,236) + b(k,112) = b(k,112) * lu(k,229) + b(k,87) = b(k,87) - lu(k,228) * b(k,112) + b(k,111) = b(k,111) * lu(k,226) + b(k,110) = b(k,110) - lu(k,225) * b(k,111) + b(k,110) = b(k,110) * lu(k,223) + b(k,109) = b(k,109) * lu(k,218) + b(k,108) = b(k,108) * lu(k,214) + b(k,107) = b(k,107) * lu(k,208) + b(k,81) = b(k,81) - lu(k,207) * b(k,107) + b(k,106) = b(k,106) * lu(k,205) + b(k,105) = b(k,105) * lu(k,200) + b(k,104) = b(k,104) * lu(k,195) + b(k,103) = b(k,103) * lu(k,190) + b(k,102) = b(k,102) * lu(k,185) + b(k,101) = b(k,101) * lu(k,182) + b(k,100) = b(k,100) * lu(k,179) + b(k,99) = b(k,99) * lu(k,176) + b(k,98) = b(k,98) * lu(k,173) + b(k,97) = b(k,97) * lu(k,169) + b(k,96) = b(k,96) * lu(k,165) + b(k,95) = b(k,95) * lu(k,161) + b(k,94) = b(k,94) * lu(k,157) + b(k,93) = b(k,93) * lu(k,153) + b(k,92) = b(k,92) * lu(k,150) + b(k,91) = b(k,91) * lu(k,147) + b(k,90) = b(k,90) * lu(k,144) + b(k,89) = b(k,89) * lu(k,141) + b(k,88) = b(k,88) * lu(k,140) + b(k,80) = b(k,80) - lu(k,139) * b(k,88) + b(k,79) = b(k,79) - lu(k,138) * b(k,88) + b(k,78) = b(k,78) - lu(k,137) * b(k,88) + b(k,77) = b(k,77) - lu(k,136) * b(k,88) + b(k,76) = b(k,76) - lu(k,135) * b(k,88) + b(k,87) = b(k,87) * lu(k,134) + b(k,80) = b(k,80) - lu(k,133) * b(k,87) + b(k,79) = b(k,79) - lu(k,132) * b(k,87) + b(k,78) = b(k,78) - lu(k,131) * b(k,87) + b(k,77) = b(k,77) - lu(k,130) * b(k,87) + b(k,76) = b(k,76) - lu(k,129) * b(k,87) + b(k,86) = b(k,86) * lu(k,128) + b(k,80) = b(k,80) - lu(k,127) * b(k,86) + b(k,79) = b(k,79) - lu(k,126) * b(k,86) + b(k,78) = b(k,78) - lu(k,125) * b(k,86) + b(k,77) = b(k,77) - lu(k,124) * b(k,86) + b(k,76) = b(k,76) - lu(k,123) * b(k,86) + b(k,85) = b(k,85) * lu(k,122) + b(k,65) = b(k,65) - lu(k,121) * b(k,85) + b(k,64) = b(k,64) - lu(k,120) * b(k,85) + b(k,63) = b(k,63) - lu(k,119) * b(k,85) + b(k,62) = b(k,62) - lu(k,118) * b(k,85) + b(k,61) = b(k,61) - lu(k,117) * b(k,85) + b(k,84) = b(k,84) * lu(k,116) + b(k,83) = b(k,83) * lu(k,115) + b(k,82) = b(k,82) - lu(k,114) * b(k,83) + b(k,82) = b(k,82) * lu(k,113) + b(k,80) = b(k,80) - lu(k,112) * b(k,82) + b(k,79) = b(k,79) - lu(k,111) * b(k,82) + b(k,78) = b(k,78) - lu(k,110) * b(k,82) + b(k,77) = b(k,77) - lu(k,109) * b(k,82) + b(k,76) = b(k,76) - lu(k,108) * b(k,82) + b(k,81) = b(k,81) * lu(k,107) + b(k,80) = b(k,80) - lu(k,106) * b(k,81) + b(k,79) = b(k,79) - lu(k,105) * b(k,81) + b(k,78) = b(k,78) - lu(k,104) * b(k,81) + b(k,77) = b(k,77) - lu(k,103) * b(k,81) + b(k,76) = b(k,76) - lu(k,102) * b(k,81) + b(k,80) = b(k,80) * lu(k,101) + b(k,79) = b(k,79) * lu(k,100) + b(k,78) = b(k,78) * lu(k,99) + b(k,77) = b(k,77) * lu(k,98) + b(k,76) = b(k,76) * lu(k,97) + b(k,75) = b(k,75) * lu(k,96) + b(k,72) = b(k,72) - lu(k,95) * b(k,75) + b(k,71) = b(k,71) - lu(k,94) * b(k,75) + b(k,70) = b(k,70) - lu(k,93) * b(k,75) + b(k,69) = b(k,69) - lu(k,92) * b(k,75) + b(k,68) = b(k,68) - lu(k,91) * b(k,75) + b(k,74) = b(k,74) * lu(k,90) + b(k,72) = b(k,72) - lu(k,89) * b(k,74) + b(k,71) = b(k,71) - lu(k,88) * b(k,74) + b(k,70) = b(k,70) - lu(k,87) * b(k,74) + b(k,69) = b(k,69) - lu(k,86) * b(k,74) + b(k,68) = b(k,68) - lu(k,85) * b(k,74) + b(k,73) = b(k,73) * lu(k,84) + b(k,72) = b(k,72) - lu(k,83) * b(k,73) + b(k,71) = b(k,71) - lu(k,82) * b(k,73) + b(k,70) = b(k,70) - lu(k,81) * b(k,73) + b(k,69) = b(k,69) - lu(k,80) * b(k,73) + b(k,68) = b(k,68) - lu(k,79) * b(k,73) + b(k,72) = b(k,72) * lu(k,78) + b(k,71) = b(k,71) * lu(k,77) + b(k,70) = b(k,70) * lu(k,76) + b(k,69) = b(k,69) * lu(k,75) + b(k,68) = b(k,68) * lu(k,74) + b(k,67) = b(k,67) * lu(k,73) + b(k,66) = b(k,66) - lu(k,72) * b(k,67) + b(k,66) = b(k,66) * lu(k,71) + b(k,65) = b(k,65) - lu(k,70) * b(k,66) + b(k,64) = b(k,64) - lu(k,69) * b(k,66) + b(k,63) = b(k,63) - lu(k,68) * b(k,66) + b(k,62) = b(k,62) - lu(k,67) * b(k,66) + b(k,61) = b(k,61) - lu(k,66) * b(k,66) + b(k,65) = b(k,65) * lu(k,65) + b(k,64) = b(k,64) * lu(k,64) + b(k,63) = b(k,63) * lu(k,63) + b(k,62) = b(k,62) * lu(k,62) + b(k,61) = b(k,61) * lu(k,61) + b(k,60) = b(k,60) * lu(k,60) + b(k,59) = b(k,59) * lu(k,59) + b(k,58) = b(k,58) * lu(k,58) + b(k,57) = b(k,57) * lu(k,57) + b(k,56) = b(k,56) * lu(k,56) + b(k,55) = b(k,55) * lu(k,55) + b(k,54) = b(k,54) * lu(k,54) + b(k,53) = b(k,53) * lu(k,53) + b(k,52) = b(k,52) * lu(k,52) + b(k,51) = b(k,51) * lu(k,51) + b(k,50) = b(k,50) * lu(k,50) + b(k,49) = b(k,49) * lu(k,49) + b(k,48) = b(k,48) * lu(k,48) + b(k,47) = b(k,47) * lu(k,47) + b(k,46) = b(k,46) * lu(k,46) + b(k,45) = b(k,45) * lu(k,45) + b(k,44) = b(k,44) * lu(k,44) + b(k,43) = b(k,43) * lu(k,43) + b(k,42) = b(k,42) * lu(k,42) + b(k,41) = b(k,41) * lu(k,41) + b(k,40) = b(k,40) * lu(k,40) + b(k,39) = b(k,39) * lu(k,39) + b(k,38) = b(k,38) * lu(k,38) + b(k,37) = b(k,37) * lu(k,37) + b(k,36) = b(k,36) * lu(k,36) + b(k,35) = b(k,35) * lu(k,35) + b(k,34) = b(k,34) * lu(k,34) + b(k,33) = b(k,33) * lu(k,33) + b(k,32) = b(k,32) * lu(k,32) + b(k,31) = b(k,31) * lu(k,31) + b(k,30) = b(k,30) * lu(k,30) + b(k,29) = b(k,29) * lu(k,29) + b(k,28) = b(k,28) * lu(k,28) + b(k,27) = b(k,27) * lu(k,27) + b(k,26) = b(k,26) * lu(k,26) + b(k,25) = b(k,25) * lu(k,25) + b(k,24) = b(k,24) * lu(k,24) + b(k,23) = b(k,23) * lu(k,23) + b(k,22) = b(k,22) * lu(k,22) + b(k,21) = b(k,21) * lu(k,21) + b(k,20) = b(k,20) * lu(k,20) + b(k,19) = b(k,19) * lu(k,19) + b(k,18) = b(k,18) * lu(k,18) + b(k,17) = b(k,17) * lu(k,17) + b(k,16) = b(k,16) * lu(k,16) + b(k,15) = b(k,15) * lu(k,15) + b(k,14) = b(k,14) * lu(k,14) + b(k,13) = b(k,13) * lu(k,13) + b(k,12) = b(k,12) * lu(k,12) + b(k,11) = b(k,11) * lu(k,11) + b(k,10) = b(k,10) * lu(k,10) + 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) + end do + end subroutine lu_slv12 + subroutine lu_slv13( 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,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_slv13 + 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 ) + call lu_slv09( avec_len, lu, b ) + call lu_slv10( avec_len, lu, b ) + call lu_slv11( avec_len, lu, b ) + call lu_slv12( avec_len, lu, b ) + call lu_slv13( avec_len, lu, b ) + end subroutine lu_slv + end module mo_lu_solve diff --git a/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_nln_matrix.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_nln_matrix.F90 new file mode 100644 index 0000000000..a13c9749f0 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_nln_matrix.F90 @@ -0,0 +1,4090 @@ + 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,699) = -(rxt(k,416)*y(k,265)) + mat(k,1940) = -rxt(k,416)*y(k,1) + mat(k,1740) = rxt(k,419)*y(k,234) + mat(k,1082) = rxt(k,419)*y(k,131) + mat(k,710) = -(rxt(k,420)*y(k,265)) + mat(k,1941) = -rxt(k,420)*y(k,2) + mat(k,1083) = rxt(k,417)*y(k,247) + mat(k,2158) = rxt(k,417)*y(k,234) + mat(k,1062) = -(rxt(k,499)*y(k,133) + rxt(k,500)*y(k,143) + rxt(k,501) & + *y(k,265)) + mat(k,2030) = -rxt(k,499)*y(k,6) + mat(k,2384) = -rxt(k,500)*y(k,6) + mat(k,1968) = -rxt(k,501)*y(k,6) + mat(k,96) = -(rxt(k,554)*y(k,247) + rxt(k,555)*y(k,131)) + mat(k,2116) = -rxt(k,554)*y(k,7) + mat(k,1709) = -rxt(k,555)*y(k,7) + mat(k,1058) = rxt(k,557)*y(k,265) + mat(k,1854) = rxt(k,557)*y(k,6) + mat(k,208) = -(rxt(k,458)*y(k,265)) + mat(k,1871) = -rxt(k,458)*y(k,8) + mat(k,107) = -(rxt(k,559)*y(k,247) + rxt(k,560)*y(k,131)) + mat(k,2122) = -rxt(k,559)*y(k,9) + mat(k,1715) = -rxt(k,560)*y(k,9) + mat(k,207) = rxt(k,558)*y(k,265) + mat(k,1860) = rxt(k,558)*y(k,8) + mat(k,449) = -(rxt(k,461)*y(k,265)) + mat(k,1910) = -rxt(k,461)*y(k,10) + mat(k,539) = rxt(k,459)*y(k,247) + mat(k,2138) = rxt(k,459)*y(k,235) + mat(k,209) = .120_r8*rxt(k,458)*y(k,265) + mat(k,1872) = .120_r8*rxt(k,458)*y(k,8) + mat(k,1060) = .100_r8*rxt(k,500)*y(k,143) + mat(k,1004) = .100_r8*rxt(k,503)*y(k,143) + mat(k,2373) = .100_r8*rxt(k,500)*y(k,6) + .100_r8*rxt(k,503)*y(k,116) + mat(k,1727) = .500_r8*rxt(k,460)*y(k,235) + .200_r8*rxt(k,487)*y(k,272) & + + .060_r8*rxt(k,493)*y(k,274) + mat(k,540) = .500_r8*rxt(k,460)*y(k,131) + mat(k,791) = .200_r8*rxt(k,487)*y(k,131) + mat(k,807) = .060_r8*rxt(k,493)*y(k,131) + mat(k,1721) = .200_r8*rxt(k,487)*y(k,272) + .200_r8*rxt(k,493)*y(k,274) + mat(k,790) = .200_r8*rxt(k,487)*y(k,131) + mat(k,805) = .200_r8*rxt(k,493)*y(k,131) + mat(k,1737) = .200_r8*rxt(k,487)*y(k,272) + .150_r8*rxt(k,493)*y(k,274) + mat(k,793) = .200_r8*rxt(k,487)*y(k,131) + mat(k,808) = .150_r8*rxt(k,493)*y(k,131) + mat(k,1722) = .210_r8*rxt(k,493)*y(k,274) + mat(k,806) = .210_r8*rxt(k,493)*y(k,131) + mat(k,270) = -(rxt(k,421)*y(k,265)) + mat(k,1882) = -rxt(k,421)*y(k,17) + mat(k,1059) = .050_r8*rxt(k,500)*y(k,143) + mat(k,1003) = .050_r8*rxt(k,503)*y(k,143) + mat(k,2372) = .050_r8*rxt(k,500)*y(k,6) + .050_r8*rxt(k,503)*y(k,116) + mat(k,409) = -(rxt(k,387)*y(k,133) + rxt(k,388)*y(k,265)) + mat(k,2023) = -rxt(k,387)*y(k,18) + mat(k,1904) = -rxt(k,388)*y(k,18) + mat(k,1555) = -(rxt(k,270)*y(k,44) + rxt(k,271)*y(k,247) + rxt(k,272) & + *y(k,143)) + mat(k,2479) = -rxt(k,270)*y(k,19) + mat(k,2204) = -rxt(k,271)*y(k,19) + mat(k,2410) = -rxt(k,272)*y(k,19) + mat(k,1607) = 4.000_r8*rxt(k,273)*y(k,21) + (rxt(k,274)+rxt(k,275))*y(k,61) & + + rxt(k,278)*y(k,131) + rxt(k,281)*y(k,141) + rxt(k,529) & + *y(k,161) + rxt(k,282)*y(k,265) + mat(k,187) = rxt(k,260)*y(k,261) + mat(k,193) = rxt(k,286)*y(k,261) + mat(k,516) = 2.000_r8*rxt(k,297)*y(k,58) + 2.000_r8*rxt(k,309)*y(k,261) & + + 2.000_r8*rxt(k,298)*y(k,265) + mat(k,630) = rxt(k,299)*y(k,58) + rxt(k,310)*y(k,261) + rxt(k,300)*y(k,265) + mat(k,463) = 3.000_r8*rxt(k,304)*y(k,58) + 3.000_r8*rxt(k,287)*y(k,261) & + + 3.000_r8*rxt(k,305)*y(k,265) + mat(k,2250) = 2.000_r8*rxt(k,297)*y(k,43) + rxt(k,299)*y(k,45) & + + 3.000_r8*rxt(k,304)*y(k,57) + mat(k,1633) = (rxt(k,274)+rxt(k,275))*y(k,21) + mat(k,171) = 2.000_r8*rxt(k,288)*y(k,261) + mat(k,881) = rxt(k,283)*y(k,141) + rxt(k,289)*y(k,261) + rxt(k,284)*y(k,265) + mat(k,1783) = rxt(k,278)*y(k,21) + mat(k,2453) = rxt(k,281)*y(k,21) + rxt(k,283)*y(k,83) + mat(k,1521) = rxt(k,529)*y(k,21) + mat(k,1826) = rxt(k,260)*y(k,36) + rxt(k,286)*y(k,37) + 2.000_r8*rxt(k,309) & + *y(k,43) + rxt(k,310)*y(k,45) + 3.000_r8*rxt(k,287)*y(k,57) & + + 2.000_r8*rxt(k,288)*y(k,80) + rxt(k,289)*y(k,83) + mat(k,1999) = rxt(k,282)*y(k,21) + 2.000_r8*rxt(k,298)*y(k,43) + rxt(k,300) & + *y(k,45) + 3.000_r8*rxt(k,305)*y(k,57) + rxt(k,284)*y(k,83) + mat(k,1600) = rxt(k,276)*y(k,61) + mat(k,1626) = rxt(k,276)*y(k,21) + mat(k,1535) = (rxt(k,594)+rxt(k,599))*y(k,93) + mat(k,840) = (rxt(k,594)+rxt(k,599))*y(k,87) + mat(k,1609) = -(4._r8*rxt(k,273)*y(k,21) + (rxt(k,274) + rxt(k,275) + rxt(k,276) & + ) * y(k,61) + rxt(k,277)*y(k,247) + rxt(k,278)*y(k,131) & + + rxt(k,279)*y(k,132) + rxt(k,281)*y(k,141) + rxt(k,282) & + *y(k,265) + rxt(k,529)*y(k,161)) + mat(k,1635) = -(rxt(k,274) + rxt(k,275) + rxt(k,276)) * y(k,21) + mat(k,2206) = -rxt(k,277)*y(k,21) + mat(k,1785) = -rxt(k,278)*y(k,21) + mat(k,1679) = -rxt(k,279)*y(k,21) + mat(k,2455) = -rxt(k,281)*y(k,21) + mat(k,2001) = -rxt(k,282)*y(k,21) + mat(k,1523) = -rxt(k,529)*y(k,21) + mat(k,1557) = rxt(k,272)*y(k,143) + mat(k,607) = rxt(k,280)*y(k,141) + mat(k,882) = rxt(k,290)*y(k,261) + mat(k,844) = rxt(k,285)*y(k,141) + mat(k,2455) = mat(k,2455) + rxt(k,280)*y(k,22) + rxt(k,285)*y(k,93) + mat(k,2412) = rxt(k,272)*y(k,19) + mat(k,1828) = rxt(k,290)*y(k,83) + mat(k,604) = -(rxt(k,280)*y(k,141)) + mat(k,2434) = -rxt(k,280)*y(k,22) + mat(k,1602) = rxt(k,279)*y(k,132) + mat(k,1658) = rxt(k,279)*y(k,21) + mat(k,279) = -(rxt(k,462)*y(k,265)) + mat(k,1884) = -rxt(k,462)*y(k,24) + mat(k,1720) = rxt(k,465)*y(k,236) + mat(k,479) = rxt(k,465)*y(k,131) + mat(k,373) = -(rxt(k,464)*y(k,265)) + mat(k,1898) = -rxt(k,464)*y(k,25) + mat(k,480) = rxt(k,463)*y(k,247) + mat(k,2130) = rxt(k,463)*y(k,236) + mat(k,325) = -(rxt(k,335)*y(k,58) + rxt(k,336)*y(k,265)) + mat(k,2224) = -rxt(k,335)*y(k,26) + mat(k,1892) = -rxt(k,336)*y(k,26) + mat(k,620) = -(rxt(k,337)*y(k,58) + rxt(k,338)*y(k,143) + rxt(k,363)*y(k,265)) + mat(k,2230) = -rxt(k,337)*y(k,27) + mat(k,2375) = -rxt(k,338)*y(k,27) + mat(k,1930) = -rxt(k,363)*y(k,27) + mat(k,311) = -(rxt(k,343)*y(k,265)) + mat(k,1890) = -rxt(k,343)*y(k,28) + mat(k,947) = .800_r8*rxt(k,339)*y(k,237) + .200_r8*rxt(k,340)*y(k,241) + mat(k,2313) = .200_r8*rxt(k,340)*y(k,237) + mat(k,378) = -(rxt(k,344)*y(k,265)) + mat(k,1899) = -rxt(k,344)*y(k,29) + mat(k,948) = rxt(k,341)*y(k,247) + mat(k,2131) = rxt(k,341)*y(k,237) + mat(k,334) = -(rxt(k,345)*y(k,58) + rxt(k,346)*y(k,265)) + mat(k,2225) = -rxt(k,345)*y(k,30) + mat(k,1893) = -rxt(k,346)*y(k,30) + mat(k,1177) = -(rxt(k,366)*y(k,133) + rxt(k,367)*y(k,143) + rxt(k,385) & + *y(k,265)) + mat(k,2039) = -rxt(k,366)*y(k,31) + mat(k,2392) = -rxt(k,367)*y(k,31) + mat(k,1977) = -rxt(k,385)*y(k,31) + mat(k,922) = .130_r8*rxt(k,445)*y(k,143) + mat(k,2392) = mat(k,2392) + .130_r8*rxt(k,445)*y(k,100) + mat(k,437) = -(rxt(k,371)*y(k,265)) + mat(k,1908) = -rxt(k,371)*y(k,32) + mat(k,978) = rxt(k,369)*y(k,247) + mat(k,2136) = rxt(k,369)*y(k,238) + mat(k,340) = -(rxt(k,372)*y(k,265) + rxt(k,375)*y(k,58)) + mat(k,1894) = -rxt(k,372)*y(k,33) + mat(k,2226) = -rxt(k,375)*y(k,33) + mat(k,315) = -(rxt(k,468)*y(k,265)) + mat(k,1891) = -rxt(k,468)*y(k,34) + mat(k,690) = rxt(k,466)*y(k,247) + mat(k,2128) = rxt(k,466)*y(k,239) + mat(k,144) = -(rxt(k,259)*y(k,261)) + mat(k,1802) = -rxt(k,259)*y(k,35) + mat(k,185) = -(rxt(k,260)*y(k,261)) + mat(k,1807) = -rxt(k,260)*y(k,36) + mat(k,190) = -(rxt(k,286)*y(k,261)) + mat(k,1808) = -rxt(k,286)*y(k,37) + mat(k,153) = -(rxt(k,261)*y(k,261)) + mat(k,1803) = -rxt(k,261)*y(k,38) + mat(k,195) = -(rxt(k,262)*y(k,261)) + mat(k,1809) = -rxt(k,262)*y(k,39) + mat(k,157) = -(rxt(k,263)*y(k,261)) + mat(k,1804) = -rxt(k,263)*y(k,40) + mat(k,200) = -(rxt(k,264)*y(k,261)) + mat(k,1810) = -rxt(k,264)*y(k,41) + mat(k,161) = -(rxt(k,265)*y(k,261)) + mat(k,1805) = -rxt(k,265)*y(k,42) + mat(k,514) = -(rxt(k,297)*y(k,58) + rxt(k,298)*y(k,265) + rxt(k,309)*y(k,261)) + mat(k,2229) = -rxt(k,297)*y(k,43) + mat(k,1918) = -rxt(k,298)*y(k,43) + mat(k,1820) = -rxt(k,309)*y(k,43) + mat(k,2496) = -(rxt(k,234)*y(k,58) + rxt(k,270)*y(k,19) + rxt(k,314)*y(k,247) & + + rxt(k,315)*y(k,133) + rxt(k,316)*y(k,141) + rxt(k,317) & + *y(k,265)) + mat(k,2267) = -rxt(k,234)*y(k,44) + mat(k,1566) = -rxt(k,270)*y(k,44) + mat(k,2221) = -rxt(k,314)*y(k,44) + mat(k,2076) = -rxt(k,315)*y(k,44) + mat(k,2470) = -rxt(k,316)*y(k,44) + mat(k,2016) = -rxt(k,317)*y(k,44) + mat(k,708) = .400_r8*rxt(k,416)*y(k,265) + mat(k,1079) = .340_r8*rxt(k,500)*y(k,143) + mat(k,416) = .500_r8*rxt(k,387)*y(k,133) + mat(k,627) = rxt(k,338)*y(k,143) + mat(k,1193) = .500_r8*rxt(k,367)*y(k,143) + mat(k,642) = .500_r8*rxt(k,355)*y(k,265) + mat(k,860) = rxt(k,322)*y(k,265) + mat(k,459) = .300_r8*rxt(k,323)*y(k,265) + mat(k,2101) = (rxt(k,331)+rxt(k,332))*y(k,261) + mat(k,1649) = rxt(k,241)*y(k,241) + mat(k,1214) = .800_r8*rxt(k,360)*y(k,265) + mat(k,935) = .910_r8*rxt(k,445)*y(k,143) + mat(k,659) = .300_r8*rxt(k,436)*y(k,265) + mat(k,1310) = .800_r8*rxt(k,440)*y(k,241) + mat(k,1322) = .120_r8*rxt(k,398)*y(k,143) + mat(k,679) = .500_r8*rxt(k,411)*y(k,265) + mat(k,1023) = .340_r8*rxt(k,503)*y(k,143) + mat(k,1434) = .600_r8*rxt(k,412)*y(k,143) + mat(k,1800) = .100_r8*rxt(k,418)*y(k,234) + rxt(k,321)*y(k,241) & + + .500_r8*rxt(k,389)*y(k,244) + .500_r8*rxt(k,357)*y(k,246) & + + .920_r8*rxt(k,428)*y(k,249) + .250_r8*rxt(k,396)*y(k,251) & + + rxt(k,405)*y(k,253) + rxt(k,379)*y(k,268) + rxt(k,383) & + *y(k,269) + .340_r8*rxt(k,512)*y(k,270) + .320_r8*rxt(k,517) & + *y(k,271) + .250_r8*rxt(k,453)*y(k,273) + mat(k,2076) = mat(k,2076) + .500_r8*rxt(k,387)*y(k,18) + rxt(k,429)*y(k,249) & + + .250_r8*rxt(k,395)*y(k,251) + rxt(k,406)*y(k,253) + mat(k,2427) = .340_r8*rxt(k,500)*y(k,6) + rxt(k,338)*y(k,27) & + + .500_r8*rxt(k,367)*y(k,31) + .910_r8*rxt(k,445)*y(k,100) & + + .120_r8*rxt(k,398)*y(k,111) + .340_r8*rxt(k,503)*y(k,116) & + + .600_r8*rxt(k,412)*y(k,118) + mat(k,587) = rxt(k,362)*y(k,265) + mat(k,1171) = .680_r8*rxt(k,521)*y(k,265) + mat(k,1096) = .100_r8*rxt(k,418)*y(k,131) + mat(k,958) = .700_r8*rxt(k,340)*y(k,241) + mat(k,988) = rxt(k,368)*y(k,241) + mat(k,1484) = rxt(k,351)*y(k,241) + rxt(k,425)*y(k,249) + .250_r8*rxt(k,392) & + *y(k,251) + rxt(k,401)*y(k,253) + .250_r8*rxt(k,450)*y(k,273) + mat(k,2363) = rxt(k,241)*y(k,61) + .800_r8*rxt(k,440)*y(k,103) + rxt(k,321) & + *y(k,131) + .700_r8*rxt(k,340)*y(k,237) + rxt(k,368)*y(k,238) & + + rxt(k,351)*y(k,240) + (4.000_r8*rxt(k,318)+2.000_r8*rxt(k,319)) & + *y(k,241) + 1.500_r8*rxt(k,426)*y(k,249) + .750_r8*rxt(k,431) & + *y(k,250) + .880_r8*rxt(k,393)*y(k,251) + 2.000_r8*rxt(k,402) & + *y(k,253) + .750_r8*rxt(k,505)*y(k,260) + .800_r8*rxt(k,381) & + *y(k,269) + .930_r8*rxt(k,510)*y(k,270) + .950_r8*rxt(k,515) & + *y(k,271) + .800_r8*rxt(k,451)*y(k,273) + mat(k,619) = .500_r8*rxt(k,389)*y(k,131) + mat(k,839) = .500_r8*rxt(k,357)*y(k,131) + mat(k,2221) = mat(k,2221) + .450_r8*rxt(k,403)*y(k,253) + .150_r8*rxt(k,382) & + *y(k,269) + mat(k,1357) = .920_r8*rxt(k,428)*y(k,131) + rxt(k,429)*y(k,133) + rxt(k,425) & + *y(k,240) + 1.500_r8*rxt(k,426)*y(k,241) + mat(k,1390) = .750_r8*rxt(k,431)*y(k,241) + mat(k,1411) = .250_r8*rxt(k,396)*y(k,131) + .250_r8*rxt(k,395)*y(k,133) & + + .250_r8*rxt(k,392)*y(k,240) + .880_r8*rxt(k,393)*y(k,241) + mat(k,1452) = rxt(k,405)*y(k,131) + rxt(k,406)*y(k,133) + rxt(k,401)*y(k,240) & + + 2.000_r8*rxt(k,402)*y(k,241) + .450_r8*rxt(k,403)*y(k,247) & + + 4.000_r8*rxt(k,404)*y(k,253) + mat(k,1161) = .750_r8*rxt(k,505)*y(k,241) + mat(k,1843) = (rxt(k,331)+rxt(k,332))*y(k,56) + mat(k,2016) = mat(k,2016) + .400_r8*rxt(k,416)*y(k,1) + .500_r8*rxt(k,355) & + *y(k,53) + rxt(k,322)*y(k,54) + .300_r8*rxt(k,323)*y(k,55) & + + .800_r8*rxt(k,360)*y(k,76) + .300_r8*rxt(k,436)*y(k,101) & + + .500_r8*rxt(k,411)*y(k,115) + rxt(k,362)*y(k,148) & + + .680_r8*rxt(k,521)*y(k,221) + mat(k,870) = rxt(k,379)*y(k,131) + mat(k,1269) = rxt(k,383)*y(k,131) + .800_r8*rxt(k,381)*y(k,241) & + + .150_r8*rxt(k,382)*y(k,247) + mat(k,1232) = .340_r8*rxt(k,512)*y(k,131) + .930_r8*rxt(k,510)*y(k,241) + mat(k,1115) = .320_r8*rxt(k,517)*y(k,131) + .950_r8*rxt(k,515)*y(k,241) + mat(k,1287) = .250_r8*rxt(k,453)*y(k,131) + .250_r8*rxt(k,450)*y(k,240) & + + .800_r8*rxt(k,451)*y(k,241) + 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,628) = -(rxt(k,299)*y(k,58) + rxt(k,300)*y(k,265) + rxt(k,310)*y(k,261)) + mat(k,2231) = -rxt(k,299)*y(k,45) + mat(k,1931) = -rxt(k,300)*y(k,45) + mat(k,1821) = -rxt(k,310)*y(k,45) + mat(k,165) = -(rxt(k,301)*y(k,265)) + mat(k,1869) = -rxt(k,301)*y(k,46) + mat(k,1195) = -(rxt(k,347)*y(k,133) + rxt(k,348)*y(k,265)) + mat(k,2040) = -rxt(k,347)*y(k,47) + mat(k,1978) = -rxt(k,348)*y(k,47) + mat(k,703) = .800_r8*rxt(k,416)*y(k,265) + mat(k,412) = rxt(k,387)*y(k,133) + mat(k,312) = rxt(k,343)*y(k,265) + mat(k,380) = .500_r8*rxt(k,344)*y(k,265) + mat(k,1178) = .500_r8*rxt(k,367)*y(k,143) + mat(k,1415) = .100_r8*rxt(k,412)*y(k,143) + mat(k,1765) = .400_r8*rxt(k,418)*y(k,234) + rxt(k,342)*y(k,237) & + + .270_r8*rxt(k,370)*y(k,238) + rxt(k,389)*y(k,244) + rxt(k,408) & + *y(k,255) + rxt(k,379)*y(k,268) + mat(k,2040) = mat(k,2040) + rxt(k,387)*y(k,18) + mat(k,2393) = .500_r8*rxt(k,367)*y(k,31) + .100_r8*rxt(k,412)*y(k,118) + mat(k,1088) = .400_r8*rxt(k,418)*y(k,131) + mat(k,951) = rxt(k,342)*y(k,131) + 3.200_r8*rxt(k,339)*y(k,237) & + + .800_r8*rxt(k,340)*y(k,241) + mat(k,981) = .270_r8*rxt(k,370)*y(k,131) + mat(k,2330) = .800_r8*rxt(k,340)*y(k,237) + mat(k,614) = rxt(k,389)*y(k,131) + mat(k,2185) = .200_r8*rxt(k,407)*y(k,255) + mat(k,722) = rxt(k,408)*y(k,131) + .200_r8*rxt(k,407)*y(k,247) + mat(k,1978) = mat(k,1978) + .800_r8*rxt(k,416)*y(k,1) + rxt(k,343)*y(k,28) & + + .500_r8*rxt(k,344)*y(k,29) + mat(k,863) = rxt(k,379)*y(k,131) + mat(k,401) = -(rxt(k,302)*y(k,58) + rxt(k,303)*y(k,265)) + mat(k,2227) = -rxt(k,302)*y(k,48) + mat(k,1903) = -rxt(k,303)*y(k,48) + mat(k,147) = -(rxt(k,349)*y(k,265)) + mat(k,1868) = -rxt(k,349)*y(k,49) + mat(k,1124) = -(rxt(k,386)*y(k,265)) + mat(k,1973) = -rxt(k,386)*y(k,50) + mat(k,702) = .800_r8*rxt(k,416)*y(k,265) + mat(k,1067) = .520_r8*rxt(k,500)*y(k,143) + mat(k,411) = .500_r8*rxt(k,387)*y(k,133) + mat(k,1011) = .520_r8*rxt(k,503)*y(k,143) + mat(k,1761) = .250_r8*rxt(k,418)*y(k,234) + .820_r8*rxt(k,370)*y(k,238) & + + .500_r8*rxt(k,389)*y(k,244) + .270_r8*rxt(k,512)*y(k,270) & + + .040_r8*rxt(k,517)*y(k,271) + mat(k,2035) = .500_r8*rxt(k,387)*y(k,18) + mat(k,2389) = .520_r8*rxt(k,500)*y(k,6) + .520_r8*rxt(k,503)*y(k,116) + mat(k,1162) = .500_r8*rxt(k,521)*y(k,265) + mat(k,1087) = .250_r8*rxt(k,418)*y(k,131) + mat(k,980) = .820_r8*rxt(k,370)*y(k,131) + .820_r8*rxt(k,368)*y(k,241) + mat(k,2326) = .820_r8*rxt(k,368)*y(k,238) + .150_r8*rxt(k,510)*y(k,270) & + + .025_r8*rxt(k,515)*y(k,271) + mat(k,613) = .500_r8*rxt(k,389)*y(k,131) + mat(k,1973) = mat(k,1973) + .800_r8*rxt(k,416)*y(k,1) + .500_r8*rxt(k,521) & + *y(k,221) + mat(k,1218) = .270_r8*rxt(k,512)*y(k,131) + .150_r8*rxt(k,510)*y(k,241) + mat(k,1108) = .040_r8*rxt(k,517)*y(k,131) + .025_r8*rxt(k,515)*y(k,241) + mat(k,1325) = -(rxt(k,373)*y(k,133) + rxt(k,374)*y(k,265)) + mat(k,2050) = -rxt(k,373)*y(k,51) + mat(k,1988) = -rxt(k,374)*y(k,51) + mat(k,1253) = rxt(k,376)*y(k,265) + mat(k,1314) = .880_r8*rxt(k,398)*y(k,143) + mat(k,1418) = .500_r8*rxt(k,412)*y(k,143) + mat(k,1775) = .170_r8*rxt(k,471)*y(k,242) + .050_r8*rxt(k,434)*y(k,250) & + + .250_r8*rxt(k,396)*y(k,251) + .170_r8*rxt(k,477)*y(k,254) & + + .400_r8*rxt(k,487)*y(k,272) + .250_r8*rxt(k,453)*y(k,273) & + + .540_r8*rxt(k,493)*y(k,274) + .510_r8*rxt(k,496)*y(k,275) + mat(k,2050) = mat(k,2050) + .050_r8*rxt(k,435)*y(k,250) + .250_r8*rxt(k,395) & + *y(k,251) + .250_r8*rxt(k,454)*y(k,273) + mat(k,937) = rxt(k,377)*y(k,265) + mat(k,2401) = .880_r8*rxt(k,398)*y(k,111) + .500_r8*rxt(k,412)*y(k,118) + mat(k,1466) = .250_r8*rxt(k,392)*y(k,251) + .250_r8*rxt(k,450)*y(k,273) + mat(k,2339) = .240_r8*rxt(k,393)*y(k,251) + .500_r8*rxt(k,381)*y(k,269) & + + .100_r8*rxt(k,451)*y(k,273) + mat(k,824) = .170_r8*rxt(k,471)*y(k,131) + .070_r8*rxt(k,470)*y(k,247) + mat(k,2194) = .070_r8*rxt(k,470)*y(k,242) + .070_r8*rxt(k,476)*y(k,254) + mat(k,1375) = .050_r8*rxt(k,434)*y(k,131) + .050_r8*rxt(k,435)*y(k,133) + mat(k,1399) = .250_r8*rxt(k,396)*y(k,131) + .250_r8*rxt(k,395)*y(k,133) & + + .250_r8*rxt(k,392)*y(k,240) + .240_r8*rxt(k,393)*y(k,241) + mat(k,962) = .170_r8*rxt(k,477)*y(k,131) + .070_r8*rxt(k,476)*y(k,247) + mat(k,1988) = mat(k,1988) + rxt(k,376)*y(k,97) + rxt(k,377)*y(k,134) + mat(k,1262) = .500_r8*rxt(k,381)*y(k,241) + mat(k,800) = .400_r8*rxt(k,487)*y(k,131) + mat(k,1278) = .250_r8*rxt(k,453)*y(k,131) + .250_r8*rxt(k,454)*y(k,133) & + + .250_r8*rxt(k,450)*y(k,240) + .100_r8*rxt(k,451)*y(k,241) + mat(k,816) = .540_r8*rxt(k,493)*y(k,131) + mat(k,558) = .510_r8*rxt(k,496)*y(k,131) + mat(k,749) = -(rxt(k,354)*y(k,265)) + mat(k,1944) = -rxt(k,354)*y(k,52) + mat(k,1173) = .120_r8*rxt(k,367)*y(k,143) + mat(k,2377) = .120_r8*rxt(k,367)*y(k,31) + mat(k,1457) = .100_r8*rxt(k,351)*y(k,241) + .150_r8*rxt(k,352)*y(k,247) + mat(k,2318) = .100_r8*rxt(k,351)*y(k,240) + mat(k,2161) = .150_r8*rxt(k,352)*y(k,240) + .150_r8*rxt(k,403)*y(k,253) + mat(k,1438) = .150_r8*rxt(k,403)*y(k,247) + mat(k,637) = -(rxt(k,355)*y(k,265)) + mat(k,1932) = -rxt(k,355)*y(k,53) + mat(k,1456) = .400_r8*rxt(k,352)*y(k,247) + mat(k,2153) = .400_r8*rxt(k,352)*y(k,240) + .400_r8*rxt(k,403)*y(k,253) + mat(k,1436) = .400_r8*rxt(k,403)*y(k,247) + mat(k,857) = -(rxt(k,322)*y(k,265)) + mat(k,1953) = -rxt(k,322)*y(k,54) + mat(k,1291) = .200_r8*rxt(k,440)*y(k,241) + mat(k,949) = .300_r8*rxt(k,340)*y(k,241) + mat(k,2319) = .200_r8*rxt(k,440)*y(k,103) + .300_r8*rxt(k,340)*y(k,237) & + + 2.000_r8*rxt(k,319)*y(k,241) + .250_r8*rxt(k,426)*y(k,249) & + + .250_r8*rxt(k,431)*y(k,250) + .250_r8*rxt(k,393)*y(k,251) & + + .250_r8*rxt(k,505)*y(k,260) + .500_r8*rxt(k,381)*y(k,269) & + + .250_r8*rxt(k,510)*y(k,270) + .250_r8*rxt(k,515)*y(k,271) & + + .300_r8*rxt(k,451)*y(k,273) + mat(k,1335) = .250_r8*rxt(k,426)*y(k,241) + mat(k,1364) = .250_r8*rxt(k,431)*y(k,241) + mat(k,1393) = .250_r8*rxt(k,393)*y(k,241) + mat(k,1148) = .250_r8*rxt(k,505)*y(k,241) + mat(k,1259) = .500_r8*rxt(k,381)*y(k,241) + mat(k,1217) = .250_r8*rxt(k,510)*y(k,241) + mat(k,1105) = .250_r8*rxt(k,515)*y(k,241) + mat(k,1272) = .300_r8*rxt(k,451)*y(k,241) + mat(k,455) = -(rxt(k,323)*y(k,265)) + mat(k,1911) = -rxt(k,323)*y(k,55) + mat(k,2315) = rxt(k,320)*y(k,247) + mat(k,2139) = rxt(k,320)*y(k,241) + mat(k,2093) = -(rxt(k,235)*y(k,58) + rxt(k,291)*y(k,75) + rxt(k,324)*y(k,265) & + + (rxt(k,330) + rxt(k,331) + rxt(k,332)) * y(k,261)) + mat(k,2259) = -rxt(k,235)*y(k,56) + mat(k,973) = -rxt(k,291)*y(k,56) + mat(k,2008) = -rxt(k,324)*y(k,56) + mat(k,1835) = -(rxt(k,330) + rxt(k,331) + rxt(k,332)) * y(k,56) + mat(k,1189) = .100_r8*rxt(k,367)*y(k,143) + mat(k,2419) = .100_r8*rxt(k,367)*y(k,31) + mat(k,461) = -(rxt(k,287)*y(k,261) + rxt(k,304)*y(k,58) + rxt(k,305)*y(k,265)) + mat(k,1819) = -rxt(k,287)*y(k,57) + mat(k,2228) = -rxt(k,304)*y(k,57) + mat(k,1912) = -rxt(k,305)*y(k,57) + mat(k,2261) = -(rxt(k,234)*y(k,44) + rxt(k,235)*y(k,56) + rxt(k,236)*y(k,79) & + + rxt(k,237)*y(k,81) + (rxt(k,238) + rxt(k,239)) * y(k,247) & + + rxt(k,240)*y(k,143) + rxt(k,247)*y(k,62) + rxt(k,256)*y(k,94) & + + rxt(k,297)*y(k,43) + rxt(k,299)*y(k,45) + rxt(k,302)*y(k,48) & + + rxt(k,304)*y(k,57) + rxt(k,345)*y(k,30) + rxt(k,375)*y(k,33)) + mat(k,2490) = -rxt(k,234)*y(k,58) + mat(k,2095) = -rxt(k,235)*y(k,58) + mat(k,1511) = -rxt(k,236)*y(k,58) + mat(k,648) = -rxt(k,237)*y(k,58) + mat(k,2215) = -(rxt(k,238) + rxt(k,239)) * y(k,58) + mat(k,2421) = -rxt(k,240)*y(k,58) + mat(k,1033) = -rxt(k,247)*y(k,58) + mat(k,877) = -rxt(k,256)*y(k,58) + mat(k,519) = -rxt(k,297)*y(k,58) + mat(k,634) = -rxt(k,299)*y(k,58) + mat(k,406) = -rxt(k,302)*y(k,58) + mat(k,466) = -rxt(k,304)*y(k,58) + mat(k,338) = -rxt(k,345)*y(k,58) + mat(k,344) = -rxt(k,375)*y(k,58) + mat(k,1617) = rxt(k,275)*y(k,61) + mat(k,146) = 4.000_r8*rxt(k,259)*y(k,261) + mat(k,189) = rxt(k,260)*y(k,261) + mat(k,156) = 2.000_r8*rxt(k,261)*y(k,261) + mat(k,199) = 2.000_r8*rxt(k,262)*y(k,261) + mat(k,160) = 2.000_r8*rxt(k,263)*y(k,261) + mat(k,204) = rxt(k,264)*y(k,261) + mat(k,164) = 2.000_r8*rxt(k,265)*y(k,261) + mat(k,167) = 3.000_r8*rxt(k,301)*y(k,265) + mat(k,406) = mat(k,406) + rxt(k,303)*y(k,265) + mat(k,1643) = rxt(k,275)*y(k,21) + (4.000_r8*rxt(k,242)+2.000_r8*rxt(k,244)) & + *y(k,61) + rxt(k,246)*y(k,131) + rxt(k,251)*y(k,141) & + + rxt(k,530)*y(k,161) + rxt(k,241)*y(k,241) + rxt(k,252) & + *y(k,265) + mat(k,295) = rxt(k,296)*y(k,261) + mat(k,291) = rxt(k,311)*y(k,261) + rxt(k,306)*y(k,265) + mat(k,301) = rxt(k,312)*y(k,261) + rxt(k,307)*y(k,265) + mat(k,360) = rxt(k,313)*y(k,261) + rxt(k,308)*y(k,265) + mat(k,1547) = rxt(k,254)*y(k,141) + rxt(k,266)*y(k,261) + rxt(k,255)*y(k,265) + mat(k,1794) = rxt(k,246)*y(k,61) + mat(k,2464) = rxt(k,251)*y(k,61) + rxt(k,254)*y(k,87) + mat(k,1529) = rxt(k,530)*y(k,61) + mat(k,2357) = rxt(k,241)*y(k,61) + mat(k,1837) = 4.000_r8*rxt(k,259)*y(k,35) + rxt(k,260)*y(k,36) & + + 2.000_r8*rxt(k,261)*y(k,38) + 2.000_r8*rxt(k,262)*y(k,39) & + + 2.000_r8*rxt(k,263)*y(k,40) + rxt(k,264)*y(k,41) & + + 2.000_r8*rxt(k,265)*y(k,42) + rxt(k,296)*y(k,67) + rxt(k,311) & + *y(k,84) + rxt(k,312)*y(k,85) + rxt(k,313)*y(k,86) + rxt(k,266) & + *y(k,87) + mat(k,2010) = 3.000_r8*rxt(k,301)*y(k,46) + rxt(k,303)*y(k,48) + rxt(k,252) & + *y(k,61) + rxt(k,306)*y(k,84) + rxt(k,307)*y(k,85) + rxt(k,308) & + *y(k,86) + rxt(k,255)*y(k,87) + mat(k,2223) = rxt(k,247)*y(k,62) + mat(k,1625) = 2.000_r8*rxt(k,243)*y(k,61) + mat(k,1025) = rxt(k,247)*y(k,58) + (rxt(k,592)+rxt(k,597)+rxt(k,602))*y(k,87) + mat(k,1534) = (rxt(k,592)+rxt(k,597)+rxt(k,602))*y(k,62) + (rxt(k,587) & + +rxt(k,593)+rxt(k,598))*y(k,94) + mat(k,872) = (rxt(k,587)+rxt(k,593)+rxt(k,598))*y(k,87) + mat(k,1624) = 2.000_r8*rxt(k,268)*y(k,61) + mat(k,1636) = -(rxt(k,241)*y(k,241) + (4._r8*rxt(k,242) + 4._r8*rxt(k,243) & + + 4._r8*rxt(k,244) + 4._r8*rxt(k,268)) * y(k,61) + rxt(k,245) & + *y(k,247) + rxt(k,246)*y(k,131) + rxt(k,248)*y(k,132) + rxt(k,251) & + *y(k,141) + (rxt(k,252) + rxt(k,253)) * y(k,265) + (rxt(k,274) & + + rxt(k,275) + rxt(k,276)) * y(k,21) + rxt(k,530)*y(k,161)) + mat(k,2349) = -rxt(k,241)*y(k,61) + mat(k,2207) = -rxt(k,245)*y(k,61) + mat(k,1786) = -rxt(k,246)*y(k,61) + mat(k,1680) = -rxt(k,248)*y(k,61) + mat(k,2456) = -rxt(k,251)*y(k,61) + mat(k,2002) = -(rxt(k,252) + rxt(k,253)) * y(k,61) + mat(k,1610) = -(rxt(k,274) + rxt(k,275) + rxt(k,276)) * y(k,61) + mat(k,1524) = -rxt(k,530)*y(k,61) + mat(k,2253) = rxt(k,256)*y(k,94) + rxt(k,240)*y(k,143) + rxt(k,239)*y(k,247) + mat(k,1029) = rxt(k,249)*y(k,141) + mat(k,1542) = rxt(k,267)*y(k,261) + mat(k,875) = rxt(k,256)*y(k,58) + rxt(k,257)*y(k,141) + rxt(k,258)*y(k,265) + mat(k,2456) = mat(k,2456) + rxt(k,249)*y(k,62) + rxt(k,257)*y(k,94) + mat(k,2413) = rxt(k,240)*y(k,58) + mat(k,365) = rxt(k,535)*y(k,161) + mat(k,1524) = mat(k,1524) + rxt(k,535)*y(k,145) + mat(k,2207) = mat(k,2207) + rxt(k,239)*y(k,58) + mat(k,1829) = rxt(k,267)*y(k,87) + mat(k,2002) = mat(k,2002) + rxt(k,258)*y(k,94) + 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,1027) = -(rxt(k,247)*y(k,58) + rxt(k,249)*y(k,141) + rxt(k,250) & + *y(k,265) + (rxt(k,592) + rxt(k,597) + rxt(k,602)) * y(k,87)) + mat(k,2238) = -rxt(k,247)*y(k,62) + mat(k,2446) = -rxt(k,249)*y(k,62) + mat(k,1966) = -rxt(k,250)*y(k,62) + mat(k,1538) = -(rxt(k,592) + rxt(k,597) + rxt(k,602)) * y(k,62) + mat(k,1630) = rxt(k,248)*y(k,132) + mat(k,1666) = rxt(k,248)*y(k,61) + mat(k,1204) = -(rxt(k,334)*y(k,265)) + mat(k,1979) = -rxt(k,334)*y(k,64) + mat(k,1070) = .230_r8*rxt(k,500)*y(k,143) + mat(k,1553) = rxt(k,270)*y(k,44) + mat(k,328) = .350_r8*rxt(k,336)*y(k,265) + mat(k,623) = .630_r8*rxt(k,338)*y(k,143) + mat(k,1179) = .560_r8*rxt(k,367)*y(k,143) + mat(k,2475) = rxt(k,270)*y(k,19) + rxt(k,234)*y(k,58) + rxt(k,315)*y(k,133) & + + rxt(k,316)*y(k,141) + rxt(k,317)*y(k,265) + mat(k,402) = rxt(k,302)*y(k,58) + mat(k,1324) = rxt(k,373)*y(k,133) + rxt(k,374)*y(k,265) + mat(k,2242) = rxt(k,234)*y(k,44) + rxt(k,302)*y(k,48) + mat(k,1493) = rxt(k,615)*y(k,266) + mat(k,1099) = rxt(k,361)*y(k,265) + mat(k,923) = .620_r8*rxt(k,445)*y(k,143) + mat(k,1312) = .650_r8*rxt(k,398)*y(k,143) + mat(k,1014) = .230_r8*rxt(k,503)*y(k,143) + mat(k,1416) = .560_r8*rxt(k,412)*y(k,143) + mat(k,1766) = .170_r8*rxt(k,471)*y(k,242) + .220_r8*rxt(k,396)*y(k,251) & + + .400_r8*rxt(k,474)*y(k,252) + .350_r8*rxt(k,477)*y(k,254) & + + .225_r8*rxt(k,512)*y(k,270) + .250_r8*rxt(k,453)*y(k,273) + mat(k,2041) = rxt(k,315)*y(k,44) + rxt(k,373)*y(k,51) + .220_r8*rxt(k,395) & + *y(k,251) + .500_r8*rxt(k,454)*y(k,273) + mat(k,2448) = rxt(k,316)*y(k,44) + rxt(k,524)*y(k,146) + mat(k,2394) = .230_r8*rxt(k,500)*y(k,6) + .630_r8*rxt(k,338)*y(k,27) & + + .560_r8*rxt(k,367)*y(k,31) + .620_r8*rxt(k,445)*y(k,100) & + + .650_r8*rxt(k,398)*y(k,111) + .230_r8*rxt(k,503)*y(k,116) & + + .560_r8*rxt(k,412)*y(k,118) + mat(k,420) = rxt(k,524)*y(k,141) + rxt(k,525)*y(k,265) + mat(k,1164) = .700_r8*rxt(k,521)*y(k,265) + mat(k,1460) = .220_r8*rxt(k,392)*y(k,251) + .250_r8*rxt(k,450)*y(k,273) + mat(k,2331) = .110_r8*rxt(k,393)*y(k,251) + .125_r8*rxt(k,510)*y(k,270) & + + .200_r8*rxt(k,451)*y(k,273) + mat(k,823) = .170_r8*rxt(k,471)*y(k,131) + .070_r8*rxt(k,470)*y(k,247) + mat(k,2186) = .070_r8*rxt(k,470)*y(k,242) + .160_r8*rxt(k,473)*y(k,252) & + + .140_r8*rxt(k,476)*y(k,254) + mat(k,1394) = .220_r8*rxt(k,396)*y(k,131) + .220_r8*rxt(k,395)*y(k,133) & + + .220_r8*rxt(k,392)*y(k,240) + .110_r8*rxt(k,393)*y(k,241) + mat(k,786) = .400_r8*rxt(k,474)*y(k,131) + .160_r8*rxt(k,473)*y(k,247) + mat(k,961) = .350_r8*rxt(k,477)*y(k,131) + .140_r8*rxt(k,476)*y(k,247) + mat(k,1979) = mat(k,1979) + .350_r8*rxt(k,336)*y(k,26) + rxt(k,317)*y(k,44) & + + rxt(k,374)*y(k,51) + rxt(k,361)*y(k,77) + rxt(k,525)*y(k,146) & + + .700_r8*rxt(k,521)*y(k,221) + mat(k,853) = rxt(k,615)*y(k,65) + mat(k,1220) = .225_r8*rxt(k,512)*y(k,131) + .125_r8*rxt(k,510)*y(k,241) + mat(k,1274) = .250_r8*rxt(k,453)*y(k,131) + .500_r8*rxt(k,454)*y(k,133) & + + .250_r8*rxt(k,450)*y(k,240) + .200_r8*rxt(k,451)*y(k,241) + mat(k,1494) = -(rxt(k,615)*y(k,266)) + mat(k,854) = -rxt(k,615)*y(k,65) + mat(k,1074) = .270_r8*rxt(k,500)*y(k,143) + mat(k,1183) = .200_r8*rxt(k,367)*y(k,143) + mat(k,750) = rxt(k,354)*y(k,265) + mat(k,639) = .500_r8*rxt(k,355)*y(k,265) + mat(k,1205) = rxt(k,334)*y(k,265) + mat(k,1211) = .800_r8*rxt(k,360)*y(k,265) + mat(k,1100) = rxt(k,361)*y(k,265) + mat(k,943) = rxt(k,326)*y(k,265) + mat(k,674) = .500_r8*rxt(k,411)*y(k,265) + mat(k,1018) = .270_r8*rxt(k,503)*y(k,143) + mat(k,1423) = .100_r8*rxt(k,412)*y(k,143) + mat(k,1782) = rxt(k,353)*y(k,240) + .900_r8*rxt(k,512)*y(k,270) + mat(k,2408) = .270_r8*rxt(k,500)*y(k,6) + .200_r8*rxt(k,367)*y(k,31) & + + .270_r8*rxt(k,503)*y(k,116) + .100_r8*rxt(k,412)*y(k,118) + mat(k,1167) = 1.800_r8*rxt(k,521)*y(k,265) + mat(k,1473) = rxt(k,353)*y(k,131) + 4.000_r8*rxt(k,350)*y(k,240) & + + .900_r8*rxt(k,351)*y(k,241) + rxt(k,425)*y(k,249) & + + 2.000_r8*rxt(k,401)*y(k,253) + rxt(k,450)*y(k,273) + mat(k,2346) = .900_r8*rxt(k,351)*y(k,240) + rxt(k,402)*y(k,253) & + + .500_r8*rxt(k,510)*y(k,270) + mat(k,2201) = .450_r8*rxt(k,403)*y(k,253) + mat(k,1348) = rxt(k,425)*y(k,240) + mat(k,1443) = 2.000_r8*rxt(k,401)*y(k,240) + rxt(k,402)*y(k,241) & + + .450_r8*rxt(k,403)*y(k,247) + 4.000_r8*rxt(k,404)*y(k,253) + mat(k,1995) = rxt(k,354)*y(k,52) + .500_r8*rxt(k,355)*y(k,53) + rxt(k,334) & + *y(k,64) + .800_r8*rxt(k,360)*y(k,76) + rxt(k,361)*y(k,77) & + + rxt(k,326)*y(k,89) + .500_r8*rxt(k,411)*y(k,115) & + + 1.800_r8*rxt(k,521)*y(k,221) + mat(k,1225) = .900_r8*rxt(k,512)*y(k,131) + .500_r8*rxt(k,510)*y(k,241) + mat(k,1280) = rxt(k,450)*y(k,240) + mat(k,267) = -(rxt(k,295)*y(k,261)) + mat(k,1813) = -rxt(k,295)*y(k,66) + mat(k,186) = rxt(k,260)*y(k,261) + mat(k,191) = rxt(k,286)*y(k,261) + mat(k,196) = rxt(k,262)*y(k,261) + mat(k,158) = 2.000_r8*rxt(k,263)*y(k,261) + mat(k,201) = 2.000_r8*rxt(k,264)*y(k,261) + mat(k,162) = rxt(k,265)*y(k,261) + mat(k,170) = 2.000_r8*rxt(k,288)*y(k,261) + mat(k,296) = rxt(k,312)*y(k,261) + rxt(k,307)*y(k,265) + mat(k,355) = rxt(k,313)*y(k,261) + rxt(k,308)*y(k,265) + mat(k,1813) = mat(k,1813) + rxt(k,260)*y(k,36) + rxt(k,286)*y(k,37) & + + rxt(k,262)*y(k,39) + 2.000_r8*rxt(k,263)*y(k,40) & + + 2.000_r8*rxt(k,264)*y(k,41) + rxt(k,265)*y(k,42) & + + 2.000_r8*rxt(k,288)*y(k,80) + rxt(k,312)*y(k,85) + rxt(k,313) & + *y(k,86) + mat(k,1881) = rxt(k,307)*y(k,85) + rxt(k,308)*y(k,86) + mat(k,292) = -(rxt(k,296)*y(k,261)) + mat(k,1815) = -rxt(k,296)*y(k,67) + mat(k,154) = rxt(k,261)*y(k,261) + mat(k,197) = rxt(k,262)*y(k,261) + mat(k,288) = rxt(k,311)*y(k,261) + rxt(k,306)*y(k,265) + mat(k,1815) = mat(k,1815) + rxt(k,261)*y(k,38) + rxt(k,262)*y(k,39) & + + rxt(k,311)*y(k,84) + mat(k,1887) = rxt(k,306)*y(k,84) + mat(k,236) = -(rxt(k,469)*y(k,265)) + mat(k,1875) = -rxt(k,469)*y(k,68) + mat(k,230) = .180_r8*rxt(k,489)*y(k,265) + mat(k,1875) = mat(k,1875) + .180_r8*rxt(k,489)*y(k,223) + mat(k,349) = -(rxt(k,522)*y(k,133) + (rxt(k,523) + rxt(k,537)) * y(k,265)) + mat(k,2021) = -rxt(k,522)*y(k,69) + mat(k,1895) = -(rxt(k,523) + rxt(k,537)) * y(k,69) + mat(k,830) = rxt(k,356)*y(k,247) + mat(k,2126) = rxt(k,356)*y(k,246) + mat(k,969) = -(rxt(k,291)*y(k,56) + rxt(k,292)*y(k,79) + rxt(k,293)*y(k,276) & + + rxt(k,294)*y(k,91)) + mat(k,2079) = -rxt(k,291)*y(k,75) + mat(k,1504) = -rxt(k,292)*y(k,75) + mat(k,2501) = -rxt(k,293)*y(k,75) + mat(k,2291) = -rxt(k,294)*y(k,75) + mat(k,192) = rxt(k,286)*y(k,261) + mat(k,202) = rxt(k,264)*y(k,261) + mat(k,268) = 2.000_r8*rxt(k,295)*y(k,261) + mat(k,293) = rxt(k,296)*y(k,261) + mat(k,1823) = rxt(k,286)*y(k,37) + rxt(k,264)*y(k,41) + 2.000_r8*rxt(k,295) & + *y(k,66) + rxt(k,296)*y(k,67) + mat(k,1210) = -(rxt(k,360)*y(k,265)) + mat(k,1980) = -rxt(k,360)*y(k,76) + mat(k,652) = .700_r8*rxt(k,436)*y(k,265) + mat(k,598) = .500_r8*rxt(k,437)*y(k,265) + mat(k,495) = rxt(k,448)*y(k,265) + mat(k,1767) = .050_r8*rxt(k,434)*y(k,250) + .530_r8*rxt(k,396)*y(k,251) & + + .225_r8*rxt(k,512)*y(k,270) + .250_r8*rxt(k,453)*y(k,273) + mat(k,2042) = .050_r8*rxt(k,435)*y(k,250) + .530_r8*rxt(k,395)*y(k,251) & + + .250_r8*rxt(k,454)*y(k,273) + mat(k,1582) = rxt(k,359)*y(k,245) + mat(k,1461) = .530_r8*rxt(k,392)*y(k,251) + .250_r8*rxt(k,450)*y(k,273) + mat(k,2332) = .260_r8*rxt(k,393)*y(k,251) + .125_r8*rxt(k,510)*y(k,270) & + + .100_r8*rxt(k,451)*y(k,273) + mat(k,510) = rxt(k,359)*y(k,142) + mat(k,1369) = .050_r8*rxt(k,434)*y(k,131) + .050_r8*rxt(k,435)*y(k,133) + mat(k,1395) = .530_r8*rxt(k,396)*y(k,131) + .530_r8*rxt(k,395)*y(k,133) & + + .530_r8*rxt(k,392)*y(k,240) + .260_r8*rxt(k,393)*y(k,241) + mat(k,1980) = mat(k,1980) + .700_r8*rxt(k,436)*y(k,101) + .500_r8*rxt(k,437) & + *y(k,102) + rxt(k,448)*y(k,122) + mat(k,1221) = .225_r8*rxt(k,512)*y(k,131) + .125_r8*rxt(k,510)*y(k,241) + mat(k,1275) = .250_r8*rxt(k,453)*y(k,131) + .250_r8*rxt(k,454)*y(k,133) & + + .250_r8*rxt(k,450)*y(k,240) + .100_r8*rxt(k,451)*y(k,241) + mat(k,1098) = -(rxt(k,361)*y(k,265)) + mat(k,1970) = -rxt(k,361)*y(k,77) + mat(k,327) = .650_r8*rxt(k,336)*y(k,265) + mat(k,1208) = .200_r8*rxt(k,360)*y(k,265) + mat(k,1133) = rxt(k,449)*y(k,265) + mat(k,1758) = rxt(k,460)*y(k,235) + .050_r8*rxt(k,434)*y(k,250) & + + .400_r8*rxt(k,474)*y(k,252) + .170_r8*rxt(k,477)*y(k,254) & + + .700_r8*rxt(k,480)*y(k,267) + .600_r8*rxt(k,487)*y(k,272) & + + .250_r8*rxt(k,453)*y(k,273) + .340_r8*rxt(k,493)*y(k,274) & + + .170_r8*rxt(k,496)*y(k,275) + mat(k,2032) = .050_r8*rxt(k,435)*y(k,250) + .250_r8*rxt(k,454)*y(k,273) + mat(k,543) = rxt(k,460)*y(k,131) + mat(k,1458) = .250_r8*rxt(k,450)*y(k,273) + mat(k,2323) = .100_r8*rxt(k,451)*y(k,273) + mat(k,2179) = .160_r8*rxt(k,473)*y(k,252) + .070_r8*rxt(k,476)*y(k,254) + mat(k,1367) = .050_r8*rxt(k,434)*y(k,131) + .050_r8*rxt(k,435)*y(k,133) + mat(k,785) = .400_r8*rxt(k,474)*y(k,131) + .160_r8*rxt(k,473)*y(k,247) + mat(k,960) = .170_r8*rxt(k,477)*y(k,131) + .070_r8*rxt(k,476)*y(k,247) + mat(k,1970) = mat(k,1970) + .650_r8*rxt(k,336)*y(k,26) + .200_r8*rxt(k,360) & + *y(k,76) + rxt(k,449)*y(k,123) + mat(k,501) = .700_r8*rxt(k,480)*y(k,131) + mat(k,798) = .600_r8*rxt(k,487)*y(k,131) + mat(k,1273) = .250_r8*rxt(k,453)*y(k,131) + .250_r8*rxt(k,454)*y(k,133) & + + .250_r8*rxt(k,450)*y(k,240) + .100_r8*rxt(k,451)*y(k,241) + mat(k,814) = .340_r8*rxt(k,493)*y(k,131) + mat(k,557) = .170_r8*rxt(k,496)*y(k,131) + mat(k,2283) = -((rxt(k,192) + rxt(k,193) + rxt(k,194)) * y(k,247) + rxt(k,195) & + *y(k,142) + rxt(k,198)*y(k,143)) + mat(k,2216) = -(rxt(k,192) + rxt(k,193) + rxt(k,194)) * y(k,78) + mat(k,1595) = -rxt(k,195)*y(k,78) + mat(k,2422) = -rxt(k,198)*y(k,78) + mat(k,2491) = rxt(k,317)*y(k,265) + mat(k,2096) = rxt(k,331)*y(k,261) + mat(k,2262) = rxt(k,236)*y(k,79) + mat(k,974) = rxt(k,292)*y(k,79) + mat(k,1512) = rxt(k,236)*y(k,58) + rxt(k,292)*y(k,75) + rxt(k,190)*y(k,141) & + + rxt(k,173)*y(k,261) + rxt(k,199)*y(k,265) + mat(k,885) = rxt(k,290)*y(k,261) + mat(k,1548) = rxt(k,267)*y(k,261) + mat(k,1051) = rxt(k,222)*y(k,265) + mat(k,2465) = rxt(k,190)*y(k,79) + rxt(k,202)*y(k,265) + mat(k,423) = rxt(k,525)*y(k,265) + mat(k,781) = rxt(k,531)*y(k,265) + mat(k,1530) = rxt(k,536)*y(k,265) + mat(k,1838) = rxt(k,331)*y(k,56) + rxt(k,173)*y(k,79) + rxt(k,290)*y(k,83) & + + rxt(k,267)*y(k,87) + mat(k,2011) = rxt(k,317)*y(k,44) + rxt(k,199)*y(k,79) + rxt(k,222)*y(k,119) & + + rxt(k,202)*y(k,141) + rxt(k,525)*y(k,146) + rxt(k,531) & + *y(k,159) + rxt(k,536)*y(k,161) + 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,1505) = -(rxt(k,173)*y(k,261) + rxt(k,190)*y(k,141) + rxt(k,199) & + *y(k,265) + rxt(k,236)*y(k,58) + rxt(k,292)*y(k,75)) + mat(k,1824) = -rxt(k,173)*y(k,79) + mat(k,2450) = -rxt(k,190)*y(k,79) + mat(k,1996) = -rxt(k,199)*y(k,79) + mat(k,2248) = -rxt(k,236)*y(k,79) + mat(k,970) = -rxt(k,292)*y(k,79) + mat(k,2082) = rxt(k,332)*y(k,261) + mat(k,2269) = rxt(k,192)*y(k,247) + mat(k,2202) = rxt(k,192)*y(k,78) + mat(k,1824) = mat(k,1824) + rxt(k,332)*y(k,56) + mat(k,169) = -(rxt(k,288)*y(k,261)) + mat(k,1806) = -rxt(k,288)*y(k,80) + mat(k,644) = -(rxt(k,191)*y(k,141) + rxt(k,200)*y(k,265) + rxt(k,237)*y(k,58)) + mat(k,2435) = -rxt(k,191)*y(k,81) + mat(k,1933) = -rxt(k,200)*y(k,81) + mat(k,2232) = -rxt(k,237)*y(k,81) + mat(k,2154) = 2.000_r8*rxt(k,206)*y(k,247) + mat(k,1933) = mat(k,1933) + 2.000_r8*rxt(k,205)*y(k,265) + mat(k,306) = rxt(k,538)*y(k,276) + mat(k,2498) = rxt(k,538)*y(k,163) + mat(k,880) = -(rxt(k,283)*y(k,141) + rxt(k,284)*y(k,265) + (rxt(k,289) & + + rxt(k,290)) * y(k,261)) + mat(k,2441) = -rxt(k,283)*y(k,83) + mat(k,1956) = -rxt(k,284)*y(k,83) + mat(k,1822) = -(rxt(k,289) + rxt(k,290)) * y(k,83) + mat(k,1552) = rxt(k,270)*y(k,44) + rxt(k,271)*y(k,247) + mat(k,2473) = rxt(k,270)*y(k,19) + mat(k,2172) = rxt(k,271)*y(k,19) + mat(k,287) = -(rxt(k,306)*y(k,265) + rxt(k,311)*y(k,261)) + mat(k,1886) = -rxt(k,306)*y(k,84) + mat(k,1814) = -rxt(k,311)*y(k,84) + mat(k,297) = -(rxt(k,307)*y(k,265) + rxt(k,312)*y(k,261)) + mat(k,1888) = -rxt(k,307)*y(k,85) + mat(k,1816) = -rxt(k,312)*y(k,85) + mat(k,356) = -(rxt(k,308)*y(k,265) + rxt(k,313)*y(k,261)) + mat(k,1896) = -rxt(k,308)*y(k,86) + mat(k,1818) = -rxt(k,313)*y(k,86) + mat(k,1539) = -(rxt(k,254)*y(k,141) + rxt(k,255)*y(k,265) + (rxt(k,266) & + + rxt(k,267)) * y(k,261) + (rxt(k,587) + rxt(k,593) + rxt(k,598) & + ) * y(k,94) + (rxt(k,592) + rxt(k,597) + rxt(k,602)) * y(k,62) & + + (rxt(k,594) + rxt(k,599)) * y(k,93)) + mat(k,2452) = -rxt(k,254)*y(k,87) + mat(k,1998) = -rxt(k,255)*y(k,87) + mat(k,1825) = -(rxt(k,266) + rxt(k,267)) * y(k,87) + mat(k,874) = -(rxt(k,587) + rxt(k,593) + rxt(k,598)) * y(k,87) + mat(k,1028) = -(rxt(k,592) + rxt(k,597) + rxt(k,602)) * y(k,87) + mat(k,842) = -(rxt(k,594) + rxt(k,599)) * y(k,87) + mat(k,336) = rxt(k,345)*y(k,58) + mat(k,342) = rxt(k,375)*y(k,58) + mat(k,515) = rxt(k,297)*y(k,58) + mat(k,2478) = rxt(k,234)*y(k,58) + mat(k,629) = rxt(k,299)*y(k,58) + mat(k,403) = 2.000_r8*rxt(k,302)*y(k,58) + mat(k,2083) = rxt(k,235)*y(k,58) + mat(k,462) = rxt(k,304)*y(k,58) + mat(k,2249) = rxt(k,345)*y(k,30) + rxt(k,375)*y(k,33) + rxt(k,297)*y(k,43) & + + rxt(k,234)*y(k,44) + rxt(k,299)*y(k,45) + 2.000_r8*rxt(k,302) & + *y(k,48) + rxt(k,235)*y(k,56) + rxt(k,304)*y(k,57) + rxt(k,236) & + *y(k,79) + rxt(k,237)*y(k,81) + rxt(k,256)*y(k,94) + rxt(k,238) & + *y(k,247) + mat(k,1632) = rxt(k,253)*y(k,265) + mat(k,1506) = rxt(k,236)*y(k,58) + mat(k,645) = rxt(k,237)*y(k,58) + mat(k,874) = mat(k,874) + rxt(k,256)*y(k,58) + mat(k,2203) = rxt(k,238)*y(k,58) + mat(k,1998) = mat(k,1998) + rxt(k,253)*y(k,61) + mat(k,248) = -(rxt(k,325)*y(k,265) + rxt(k,333)*y(k,261)) + mat(k,1878) = -rxt(k,325)*y(k,88) + mat(k,1812) = -rxt(k,333)*y(k,88) + mat(k,942) = -(rxt(k,326)*y(k,265)) + mat(k,1959) = -rxt(k,326)*y(k,89) + mat(k,1061) = .050_r8*rxt(k,500)*y(k,143) + mat(k,326) = .350_r8*rxt(k,336)*y(k,265) + mat(k,622) = .370_r8*rxt(k,338)*y(k,143) + mat(k,1176) = .120_r8*rxt(k,367)*y(k,143) + mat(k,921) = .110_r8*rxt(k,445)*y(k,143) + mat(k,1311) = .330_r8*rxt(k,398)*y(k,143) + mat(k,1005) = .050_r8*rxt(k,503)*y(k,143) + mat(k,1413) = .120_r8*rxt(k,412)*y(k,143) + mat(k,1752) = rxt(k,329)*y(k,248) + mat(k,2381) = .050_r8*rxt(k,500)*y(k,6) + .370_r8*rxt(k,338)*y(k,27) & + + .120_r8*rxt(k,367)*y(k,31) + .110_r8*rxt(k,445)*y(k,100) & + + .330_r8*rxt(k,398)*y(k,111) + .050_r8*rxt(k,503)*y(k,116) & + + .120_r8*rxt(k,412)*y(k,118) + mat(k,2174) = rxt(k,327)*y(k,248) + mat(k,488) = rxt(k,329)*y(k,131) + rxt(k,327)*y(k,247) + mat(k,1959) = mat(k,1959) + .350_r8*rxt(k,336)*y(k,26) + mat(k,2078) = rxt(k,291)*y(k,75) + mat(k,968) = rxt(k,291)*y(k,56) + rxt(k,292)*y(k,79) + rxt(k,294)*y(k,91) & + + rxt(k,293)*y(k,276) + mat(k,1503) = rxt(k,292)*y(k,75) + mat(k,2290) = rxt(k,294)*y(k,75) + mat(k,2500) = rxt(k,293)*y(k,75) + mat(k,2307) = -(rxt(k,231)*y(k,265) + rxt(k,294)*y(k,75)) + mat(k,2012) = -rxt(k,231)*y(k,91) + mat(k,975) = -rxt(k,294)*y(k,91) + mat(k,2492) = rxt(k,315)*y(k,133) + mat(k,1201) = rxt(k,347)*y(k,133) + mat(k,1331) = rxt(k,373)*y(k,133) + mat(k,1034) = (rxt(k,592)+rxt(k,597)+rxt(k,602))*y(k,87) + mat(k,354) = rxt(k,522)*y(k,133) + mat(k,1549) = (rxt(k,592)+rxt(k,597)+rxt(k,602))*y(k,62) + mat(k,1690) = rxt(k,230)*y(k,265) + mat(k,2072) = rxt(k,315)*y(k,44) + rxt(k,347)*y(k,47) + rxt(k,373)*y(k,51) & + + rxt(k,522)*y(k,69) + mat(k,2012) = mat(k,2012) + rxt(k,230)*y(k,132) + mat(k,521) = -(rxt(k,207)*y(k,265)) + mat(k,1919) = -rxt(k,207)*y(k,92) + mat(k,1654) = rxt(k,228)*y(k,247) + mat(k,2146) = rxt(k,228)*y(k,132) + mat(k,841) = -(rxt(k,285)*y(k,141) + (rxt(k,594) + rxt(k,599)) * y(k,87)) + mat(k,2438) = -rxt(k,285)*y(k,93) + mat(k,1536) = -(rxt(k,594) + rxt(k,599)) * y(k,93) + mat(k,1603) = rxt(k,277)*y(k,247) + mat(k,2169) = rxt(k,277)*y(k,21) + mat(k,873) = -(rxt(k,256)*y(k,58) + rxt(k,257)*y(k,141) + rxt(k,258)*y(k,265) & + + (rxt(k,587) + rxt(k,593) + rxt(k,598)) * y(k,87)) + mat(k,2234) = -rxt(k,256)*y(k,94) + mat(k,2440) = -rxt(k,257)*y(k,94) + mat(k,1955) = -rxt(k,258)*y(k,94) + mat(k,1537) = -(rxt(k,587) + rxt(k,593) + rxt(k,598)) * y(k,94) + mat(k,1628) = rxt(k,245)*y(k,247) + mat(k,1026) = rxt(k,250)*y(k,265) + mat(k,2171) = rxt(k,245)*y(k,61) + mat(k,1955) = mat(k,1955) + rxt(k,250)*y(k,62) + mat(k,1239) = -(rxt(k,391)*y(k,265)) + mat(k,1982) = -rxt(k,391)*y(k,95) + mat(k,653) = .300_r8*rxt(k,436)*y(k,265) + mat(k,599) = .500_r8*rxt(k,437)*y(k,265) + mat(k,1769) = rxt(k,390)*y(k,244) + rxt(k,397)*y(k,251) + mat(k,615) = rxt(k,390)*y(k,131) + mat(k,1396) = rxt(k,397)*y(k,131) + mat(k,1982) = mat(k,1982) + .300_r8*rxt(k,436)*y(k,101) + .500_r8*rxt(k,437) & + *y(k,102) + mat(k,282) = -(rxt(k,422)*y(k,265)) + mat(k,1885) = -rxt(k,422)*y(k,96) + mat(k,1252) = -(rxt(k,376)*y(k,265)) + mat(k,1983) = -rxt(k,376)*y(k,97) + mat(k,654) = .700_r8*rxt(k,436)*y(k,265) + mat(k,600) = .500_r8*rxt(k,437)*y(k,265) + mat(k,672) = .500_r8*rxt(k,411)*y(k,265) + mat(k,1770) = .050_r8*rxt(k,434)*y(k,250) + .220_r8*rxt(k,396)*y(k,251) & + + .250_r8*rxt(k,453)*y(k,273) + mat(k,2045) = .050_r8*rxt(k,435)*y(k,250) + .220_r8*rxt(k,395)*y(k,251) & + + .250_r8*rxt(k,454)*y(k,273) + mat(k,591) = .500_r8*rxt(k,380)*y(k,265) + mat(k,1462) = .220_r8*rxt(k,392)*y(k,251) + .250_r8*rxt(k,450)*y(k,273) + mat(k,2334) = .230_r8*rxt(k,393)*y(k,251) + .200_r8*rxt(k,381)*y(k,269) & + + .100_r8*rxt(k,451)*y(k,273) + mat(k,1371) = .050_r8*rxt(k,434)*y(k,131) + .050_r8*rxt(k,435)*y(k,133) + mat(k,1397) = .220_r8*rxt(k,396)*y(k,131) + .220_r8*rxt(k,395)*y(k,133) & + + .220_r8*rxt(k,392)*y(k,240) + .230_r8*rxt(k,393)*y(k,241) + mat(k,1983) = mat(k,1983) + .700_r8*rxt(k,436)*y(k,101) + .500_r8*rxt(k,437) & + *y(k,102) + .500_r8*rxt(k,411)*y(k,115) + .500_r8*rxt(k,380) & + *y(k,157) + mat(k,1260) = .200_r8*rxt(k,381)*y(k,241) + mat(k,1276) = .250_r8*rxt(k,453)*y(k,131) + .250_r8*rxt(k,454)*y(k,133) & + + .250_r8*rxt(k,450)*y(k,240) + .100_r8*rxt(k,451)*y(k,241) + mat(k,398) = -(rxt(k,423)*y(k,265)) + mat(k,1902) = -rxt(k,423)*y(k,98) + mat(k,1723) = .870_r8*rxt(k,434)*y(k,250) + mat(k,2022) = .950_r8*rxt(k,435)*y(k,250) + mat(k,1454) = rxt(k,430)*y(k,250) + mat(k,2314) = .750_r8*rxt(k,431)*y(k,250) + mat(k,1360) = .870_r8*rxt(k,434)*y(k,131) + .950_r8*rxt(k,435)*y(k,133) & + + rxt(k,430)*y(k,240) + .750_r8*rxt(k,431)*y(k,241) + mat(k,173) = -(rxt(k,424)*y(k,265)) + mat(k,1870) = -rxt(k,424)*y(k,99) + mat(k,754) = .600_r8*rxt(k,447)*y(k,265) + mat(k,1870) = mat(k,1870) + .600_r8*rxt(k,447)*y(k,106) + mat(k,920) = -(rxt(k,438)*y(k,133) + rxt(k,445)*y(k,143) + rxt(k,446) & + *y(k,265)) + mat(k,2025) = -rxt(k,438)*y(k,100) + mat(k,2380) = -rxt(k,445)*y(k,100) + mat(k,1957) = -rxt(k,446)*y(k,100) + mat(k,651) = -(rxt(k,436)*y(k,265)) + mat(k,1934) = -rxt(k,436)*y(k,101) + mat(k,1736) = .080_r8*rxt(k,428)*y(k,249) + mat(k,1333) = .080_r8*rxt(k,428)*y(k,131) + mat(k,596) = -(rxt(k,437)*y(k,265)) + mat(k,1928) = -rxt(k,437)*y(k,102) + mat(k,1734) = .080_r8*rxt(k,434)*y(k,250) + mat(k,1361) = .080_r8*rxt(k,434)*y(k,131) + mat(k,1297) = -(rxt(k,439)*y(k,240) + rxt(k,440)*y(k,241) + rxt(k,441) & + *y(k,247) + rxt(k,442)*y(k,131) + rxt(k,443)*y(k,133)) + mat(k,1464) = -rxt(k,439)*y(k,103) + mat(k,2337) = -rxt(k,440)*y(k,103) + mat(k,2192) = -rxt(k,441)*y(k,103) + mat(k,1773) = -rxt(k,442)*y(k,103) + mat(k,2048) = -rxt(k,443)*y(k,103) + mat(k,924) = rxt(k,438)*y(k,133) + mat(k,2048) = mat(k,2048) + rxt(k,438)*y(k,100) + mat(k,443) = -(rxt(k,444)*y(k,265)) + mat(k,1909) = -rxt(k,444)*y(k,104) + mat(k,1288) = rxt(k,441)*y(k,247) + mat(k,2137) = rxt(k,441)*y(k,103) + mat(k,84) = -(rxt(k,562)*y(k,247) + rxt(k,563)*y(k,131)) + mat(k,2114) = -rxt(k,562)*y(k,105) + mat(k,1707) = -rxt(k,563)*y(k,105) + mat(k,919) = rxt(k,565)*y(k,265) + mat(k,1852) = rxt(k,565)*y(k,100) + 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,755) = -(rxt(k,447)*y(k,265)) + mat(k,1945) = -rxt(k,447)*y(k,106) + mat(k,2162) = rxt(k,427)*y(k,249) + rxt(k,432)*y(k,250) + mat(k,1334) = rxt(k,427)*y(k,247) + mat(k,1363) = rxt(k,432)*y(k,247) + mat(k,73) = -(rxt(k,568)*y(k,265)) + mat(k,1851) = -rxt(k,568)*y(k,107) + mat(k,71) = -(rxt(k,566)*y(k,247) + rxt(k,567)*y(k,131)) + mat(k,2108) = -rxt(k,566)*y(k,108) + mat(k,1701) = -rxt(k,567)*y(k,108) + mat(k,72) = rxt(k,568)*y(k,265) + mat(k,1850) = rxt(k,568)*y(k,107) + mat(k,115) = -(rxt(k,571)*y(k,265)) + mat(k,1862) = -rxt(k,571)*y(k,109) + mat(k,113) = -(rxt(k,569)*y(k,247) + rxt(k,570)*y(k,131)) + mat(k,2123) = -rxt(k,569)*y(k,110) + mat(k,1716) = -rxt(k,570)*y(k,110) + mat(k,114) = rxt(k,571)*y(k,265) + mat(k,1861) = rxt(k,571)*y(k,109) + mat(k,1313) = -(rxt(k,398)*y(k,143) + rxt(k,399)*y(k,265)) + mat(k,2400) = -rxt(k,398)*y(k,111) + mat(k,1987) = -rxt(k,399)*y(k,111) + mat(k,925) = .300_r8*rxt(k,445)*y(k,143) + mat(k,1774) = .360_r8*rxt(k,428)*y(k,249) + mat(k,2049) = .400_r8*rxt(k,429)*y(k,249) + mat(k,2400) = mat(k,2400) + .300_r8*rxt(k,445)*y(k,100) + mat(k,1465) = .390_r8*rxt(k,425)*y(k,249) + mat(k,2338) = .310_r8*rxt(k,426)*y(k,249) + mat(k,1341) = .360_r8*rxt(k,428)*y(k,131) + .400_r8*rxt(k,429)*y(k,133) & + + .390_r8*rxt(k,425)*y(k,240) + .310_r8*rxt(k,426)*y(k,241) + mat(k,393) = -(rxt(k,400)*y(k,265)) + mat(k,1901) = -rxt(k,400)*y(k,112) + mat(k,2133) = rxt(k,394)*y(k,251) + mat(k,1392) = rxt(k,394)*y(k,247) + mat(k,563) = -(rxt(k,409)*y(k,265)) + mat(k,1924) = -rxt(k,409)*y(k,113) + mat(k,1732) = .800_r8*rxt(k,418)*y(k,234) + mat(k,1081) = .800_r8*rxt(k,418)*y(k,131) + mat(k,388) = -(rxt(k,410)*y(k,265)) + mat(k,1900) = -rxt(k,410)*y(k,114) + mat(k,2132) = .800_r8*rxt(k,407)*y(k,255) + mat(k,720) = .800_r8*rxt(k,407)*y(k,247) + mat(k,671) = -(rxt(k,411)*y(k,265)) + mat(k,1936) = -rxt(k,411)*y(k,115) + mat(k,1659) = rxt(k,414)*y(k,253) + mat(k,1437) = rxt(k,414)*y(k,132) + mat(k,1006) = -(rxt(k,502)*y(k,133) + rxt(k,503)*y(k,143) + rxt(k,504) & + *y(k,265)) + mat(k,2029) = -rxt(k,502)*y(k,116) + mat(k,2383) = -rxt(k,503)*y(k,116) + mat(k,1965) = -rxt(k,504)*y(k,116) + mat(k,90) = -(rxt(k,573)*y(k,247) + rxt(k,574)*y(k,131)) + mat(k,2115) = -rxt(k,573)*y(k,117) + mat(k,1708) = -rxt(k,574)*y(k,117) + mat(k,1002) = rxt(k,576)*y(k,265) + mat(k,1853) = rxt(k,576)*y(k,116) + mat(k,1420) = -(rxt(k,412)*y(k,143) + rxt(k,413)*y(k,265)) + mat(k,2405) = -rxt(k,412)*y(k,118) + mat(k,1992) = -rxt(k,413)*y(k,118) + mat(k,928) = .200_r8*rxt(k,445)*y(k,143) + mat(k,1779) = .560_r8*rxt(k,428)*y(k,249) + mat(k,2054) = .600_r8*rxt(k,429)*y(k,249) + mat(k,2405) = mat(k,2405) + .200_r8*rxt(k,445)*y(k,100) + mat(k,1470) = .610_r8*rxt(k,425)*y(k,249) + mat(k,2343) = .440_r8*rxt(k,426)*y(k,249) + mat(k,1345) = .560_r8*rxt(k,428)*y(k,131) + .600_r8*rxt(k,429)*y(k,133) & + + .610_r8*rxt(k,425)*y(k,240) + .440_r8*rxt(k,426)*y(k,241) + mat(k,1043) = -(rxt(k,210)*y(k,131) + (rxt(k,211) + rxt(k,212) + rxt(k,213) & + ) * y(k,132) + rxt(k,214)*y(k,142) + rxt(k,222)*y(k,265) & + + rxt(k,612)*y(k,264)) + mat(k,1756) = -rxt(k,210)*y(k,119) + mat(k,1667) = -(rxt(k,211) + rxt(k,212) + rxt(k,213)) * y(k,119) + mat(k,1580) = -rxt(k,214)*y(k,119) + mat(k,1967) = -rxt(k,222)*y(k,119) + mat(k,899) = -rxt(k,612)*y(k,119) + mat(k,2447) = rxt(k,208)*y(k,256) + rxt(k,609)*y(k,259) + mat(k,1580) = mat(k,1580) + rxt(k,610)*y(k,259) + mat(k,910) = 1.100_r8*rxt(k,605)*y(k,257) + .200_r8*rxt(k,603)*y(k,258) + mat(k,576) = rxt(k,208)*y(k,141) + mat(k,744) = 1.100_r8*rxt(k,605)*y(k,243) + mat(k,891) = .200_r8*rxt(k,603)*y(k,243) + mat(k,552) = rxt(k,609)*y(k,141) + rxt(k,610)*y(k,142) + mat(k,302) = -((rxt(k,226) + rxt(k,227)) * y(k,261)) + mat(k,1817) = -(rxt(k,226) + rxt(k,227)) * y(k,120) + mat(k,1037) = rxt(k,211)*y(k,132) + mat(k,1652) = rxt(k,211)*y(k,119) + mat(k,1653) = rxt(k,229)*y(k,133) + mat(k,2020) = rxt(k,229)*y(k,132) + mat(k,493) = -(rxt(k,448)*y(k,265)) + mat(k,1915) = -rxt(k,448)*y(k,122) + mat(k,1289) = .200_r8*rxt(k,440)*y(k,241) + mat(k,2316) = .200_r8*rxt(k,440)*y(k,103) + mat(k,1134) = -(rxt(k,449)*y(k,265)) + mat(k,1974) = -rxt(k,449)*y(k,123) + mat(k,1293) = rxt(k,442)*y(k,131) + rxt(k,443)*y(k,133) + rxt(k,439)*y(k,240) & + + .800_r8*rxt(k,440)*y(k,241) + mat(k,1762) = rxt(k,442)*y(k,103) + mat(k,2036) = rxt(k,443)*y(k,103) + mat(k,1459) = rxt(k,439)*y(k,103) + mat(k,2327) = .800_r8*rxt(k,440)*y(k,103) + mat(k,141) = -(rxt(k,539)*y(k,265)) + mat(k,1867) = -rxt(k,539)*y(k,127) + mat(k,1788) = -(rxt(k,210)*y(k,119) + rxt(k,219)*y(k,133) + rxt(k,223) & + *y(k,247) + rxt(k,224)*y(k,143) + rxt(k,225)*y(k,141) + rxt(k,246) & + *y(k,61) + rxt(k,278)*y(k,21) + rxt(k,321)*y(k,241) + rxt(k,329) & + *y(k,248) + rxt(k,342)*y(k,237) + rxt(k,353)*y(k,240) + rxt(k,357) & + *y(k,246) + rxt(k,370)*y(k,238) + rxt(k,379)*y(k,268) + rxt(k,383) & + *y(k,269) + (rxt(k,389) + rxt(k,390)) * y(k,244) + (rxt(k,396) & + + rxt(k,397)) * y(k,251) + rxt(k,405)*y(k,253) + rxt(k,408) & + *y(k,255) + (rxt(k,418) + rxt(k,419)) * y(k,234) + rxt(k,428) & + *y(k,249) + rxt(k,434)*y(k,250) + rxt(k,442)*y(k,103) + rxt(k,453) & + *y(k,273) + rxt(k,457)*y(k,233) + rxt(k,460)*y(k,235) + rxt(k,465) & + *y(k,236) + rxt(k,467)*y(k,239) + rxt(k,471)*y(k,242) + rxt(k,474) & + *y(k,252) + rxt(k,477)*y(k,254) + rxt(k,480)*y(k,267) + rxt(k,487) & + *y(k,272) + rxt(k,493)*y(k,274) + rxt(k,496)*y(k,275) + rxt(k,507) & + *y(k,260) + rxt(k,512)*y(k,270) + rxt(k,517)*y(k,271) + rxt(k,614) & + *y(k,264)) + mat(k,1048) = -rxt(k,210)*y(k,131) + mat(k,2064) = -rxt(k,219)*y(k,131) + mat(k,2209) = -rxt(k,223)*y(k,131) + mat(k,2415) = -rxt(k,224)*y(k,131) + mat(k,2458) = -rxt(k,225)*y(k,131) + mat(k,1638) = -rxt(k,246)*y(k,131) + mat(k,1612) = -rxt(k,278)*y(k,131) + mat(k,2351) = -rxt(k,321)*y(k,131) + mat(k,490) = -rxt(k,329)*y(k,131) + mat(k,954) = -rxt(k,342)*y(k,131) + mat(k,1476) = -rxt(k,353)*y(k,131) + mat(k,836) = -rxt(k,357)*y(k,131) + mat(k,984) = -rxt(k,370)*y(k,131) + mat(k,867) = -rxt(k,379)*y(k,131) + mat(k,1265) = -rxt(k,383)*y(k,131) + mat(k,617) = -(rxt(k,389) + rxt(k,390)) * y(k,131) + mat(k,1405) = -(rxt(k,396) + rxt(k,397)) * y(k,131) + mat(k,1445) = -rxt(k,405)*y(k,131) + mat(k,725) = -rxt(k,408)*y(k,131) + mat(k,1092) = -(rxt(k,418) + rxt(k,419)) * y(k,131) + mat(k,1350) = -rxt(k,428)*y(k,131) + mat(k,1383) = -rxt(k,434)*y(k,131) + mat(k,1304) = -rxt(k,442)*y(k,131) + mat(k,1282) = -rxt(k,453)*y(k,131) + mat(k,572) = -rxt(k,457)*y(k,131) + mat(k,545) = -rxt(k,460)*y(k,131) + mat(k,484) = -rxt(k,465)*y(k,131) + mat(k,694) = -rxt(k,467)*y(k,131) + mat(k,826) = -rxt(k,471)*y(k,131) + mat(k,788) = -rxt(k,474)*y(k,131) + mat(k,964) = -rxt(k,477)*y(k,131) + mat(k,503) = -rxt(k,480)*y(k,131) + mat(k,802) = -rxt(k,487)*y(k,131) + mat(k,819) = -rxt(k,493)*y(k,131) + mat(k,560) = -rxt(k,496)*y(k,131) + mat(k,1155) = -rxt(k,507)*y(k,131) + mat(k,1227) = -rxt(k,512)*y(k,131) + mat(k,1110) = -rxt(k,517)*y(k,131) + mat(k,901) = -rxt(k,614)*y(k,131) + mat(k,1048) = mat(k,1048) + 2.000_r8*rxt(k,212)*y(k,132) + rxt(k,214) & + *y(k,142) + rxt(k,222)*y(k,265) + mat(k,304) = 2.000_r8*rxt(k,226)*y(k,261) + mat(k,1682) = 2.000_r8*rxt(k,212)*y(k,119) + rxt(k,215)*y(k,141) + rxt(k,532) & + *y(k,161) + mat(k,2458) = mat(k,2458) + rxt(k,215)*y(k,132) + mat(k,1590) = rxt(k,214)*y(k,119) + rxt(k,209)*y(k,256) + mat(k,1526) = rxt(k,532)*y(k,132) + mat(k,578) = rxt(k,209)*y(k,142) + mat(k,1831) = 2.000_r8*rxt(k,226)*y(k,120) + mat(k,2004) = rxt(k,222)*y(k,119) + mat(k,1681) = -((rxt(k,211) + rxt(k,212) + rxt(k,213)) * y(k,119) + (rxt(k,215) & + + rxt(k,217)) * y(k,141) + rxt(k,216)*y(k,143) + rxt(k,228) & + *y(k,247) + rxt(k,229)*y(k,133) + rxt(k,230)*y(k,265) + rxt(k,248) & + *y(k,61) + rxt(k,279)*y(k,21) + rxt(k,364)*y(k,240) + rxt(k,414) & + *y(k,253) + rxt(k,472)*y(k,242) + rxt(k,475)*y(k,252) + rxt(k,478) & + *y(k,254) + rxt(k,482)*y(k,150) + rxt(k,485)*y(k,233) + rxt(k,532) & + *y(k,161)) + mat(k,1047) = -(rxt(k,211) + rxt(k,212) + rxt(k,213)) * y(k,132) + mat(k,2457) = -(rxt(k,215) + rxt(k,217)) * y(k,132) + mat(k,2414) = -rxt(k,216)*y(k,132) + mat(k,2208) = -rxt(k,228)*y(k,132) + mat(k,2063) = -rxt(k,229)*y(k,132) + mat(k,2003) = -rxt(k,230)*y(k,132) + mat(k,1637) = -rxt(k,248)*y(k,132) + mat(k,1611) = -rxt(k,279)*y(k,132) + mat(k,1475) = -rxt(k,364)*y(k,132) + mat(k,1444) = -rxt(k,414)*y(k,132) + mat(k,825) = -rxt(k,472)*y(k,132) + mat(k,787) = -rxt(k,475)*y(k,132) + mat(k,963) = -rxt(k,478)*y(k,132) + mat(k,537) = -rxt(k,482)*y(k,132) + mat(k,571) = -rxt(k,485)*y(k,132) + mat(k,1525) = -rxt(k,532)*y(k,132) + mat(k,705) = rxt(k,416)*y(k,265) + mat(k,413) = rxt(k,387)*y(k,133) + mat(k,1611) = mat(k,1611) + rxt(k,278)*y(k,131) + mat(k,1637) = mat(k,1637) + rxt(k,246)*y(k,131) + mat(k,523) = rxt(k,207)*y(k,265) + mat(k,655) = .700_r8*rxt(k,436)*y(k,265) + mat(k,1303) = rxt(k,442)*y(k,131) + rxt(k,443)*y(k,133) + mat(k,1787) = rxt(k,278)*y(k,21) + rxt(k,246)*y(k,61) + rxt(k,442)*y(k,103) & + + 2.000_r8*rxt(k,219)*y(k,133) + rxt(k,225)*y(k,141) & + + rxt(k,224)*y(k,143) + rxt(k,457)*y(k,233) + rxt(k,418) & + *y(k,234) + rxt(k,460)*y(k,235) + rxt(k,465)*y(k,236) & + + rxt(k,342)*y(k,237) + rxt(k,370)*y(k,238) + rxt(k,467) & + *y(k,239) + rxt(k,353)*y(k,240) + rxt(k,321)*y(k,241) & + + rxt(k,471)*y(k,242) + rxt(k,389)*y(k,244) + rxt(k,357) & + *y(k,246) + rxt(k,223)*y(k,247) + rxt(k,329)*y(k,248) & + + .920_r8*rxt(k,428)*y(k,249) + .920_r8*rxt(k,434)*y(k,250) & + + rxt(k,396)*y(k,251) + rxt(k,474)*y(k,252) + rxt(k,405) & + *y(k,253) + rxt(k,477)*y(k,254) + rxt(k,408)*y(k,255) & + + 1.600_r8*rxt(k,507)*y(k,260) + rxt(k,480)*y(k,267) & + + rxt(k,379)*y(k,268) + rxt(k,383)*y(k,269) + .900_r8*rxt(k,512) & + *y(k,270) + .800_r8*rxt(k,517)*y(k,271) + rxt(k,487)*y(k,272) & + + rxt(k,453)*y(k,273) + rxt(k,493)*y(k,274) + rxt(k,496) & + *y(k,275) + mat(k,2063) = mat(k,2063) + rxt(k,387)*y(k,18) + rxt(k,443)*y(k,103) & + + 2.000_r8*rxt(k,219)*y(k,131) + rxt(k,220)*y(k,141) & + + rxt(k,218)*y(k,247) + rxt(k,429)*y(k,249) + rxt(k,435) & + *y(k,250) + rxt(k,395)*y(k,251) + rxt(k,406)*y(k,253) & + + 2.000_r8*rxt(k,508)*y(k,260) + rxt(k,221)*y(k,265) & + + rxt(k,454)*y(k,273) + mat(k,939) = rxt(k,377)*y(k,265) + mat(k,2457) = mat(k,2457) + rxt(k,225)*y(k,131) + rxt(k,220)*y(k,133) + mat(k,2414) = mat(k,2414) + rxt(k,224)*y(k,131) + mat(k,686) = rxt(k,514)*y(k,265) + mat(k,571) = mat(k,571) + rxt(k,457)*y(k,131) + mat(k,1091) = rxt(k,418)*y(k,131) + mat(k,544) = rxt(k,460)*y(k,131) + mat(k,483) = rxt(k,465)*y(k,131) + mat(k,953) = rxt(k,342)*y(k,131) + mat(k,983) = rxt(k,370)*y(k,131) + mat(k,693) = rxt(k,467)*y(k,131) + mat(k,1475) = mat(k,1475) + rxt(k,353)*y(k,131) + mat(k,2350) = rxt(k,321)*y(k,131) + .500_r8*rxt(k,505)*y(k,260) + mat(k,825) = mat(k,825) + rxt(k,471)*y(k,131) + mat(k,616) = rxt(k,389)*y(k,131) + mat(k,835) = rxt(k,357)*y(k,131) + mat(k,2208) = mat(k,2208) + rxt(k,223)*y(k,131) + rxt(k,218)*y(k,133) + mat(k,489) = rxt(k,329)*y(k,131) + mat(k,1349) = .920_r8*rxt(k,428)*y(k,131) + rxt(k,429)*y(k,133) + mat(k,1382) = .920_r8*rxt(k,434)*y(k,131) + rxt(k,435)*y(k,133) + mat(k,1404) = rxt(k,396)*y(k,131) + rxt(k,395)*y(k,133) + mat(k,787) = mat(k,787) + rxt(k,474)*y(k,131) + mat(k,1444) = mat(k,1444) + rxt(k,405)*y(k,131) + rxt(k,406)*y(k,133) + mat(k,963) = mat(k,963) + rxt(k,477)*y(k,131) + mat(k,724) = rxt(k,408)*y(k,131) + mat(k,1154) = 1.600_r8*rxt(k,507)*y(k,131) + 2.000_r8*rxt(k,508)*y(k,133) & + + .500_r8*rxt(k,505)*y(k,241) + mat(k,2003) = mat(k,2003) + rxt(k,416)*y(k,1) + rxt(k,207)*y(k,92) & + + .700_r8*rxt(k,436)*y(k,101) + rxt(k,221)*y(k,133) + rxt(k,377) & + *y(k,134) + rxt(k,514)*y(k,218) + mat(k,502) = rxt(k,480)*y(k,131) + mat(k,866) = rxt(k,379)*y(k,131) + mat(k,1264) = rxt(k,383)*y(k,131) + mat(k,1226) = .900_r8*rxt(k,512)*y(k,131) + mat(k,1109) = .800_r8*rxt(k,517)*y(k,131) + mat(k,801) = rxt(k,487)*y(k,131) + mat(k,1281) = rxt(k,453)*y(k,131) + rxt(k,454)*y(k,133) + mat(k,818) = rxt(k,493)*y(k,131) + mat(k,559) = rxt(k,496)*y(k,131) + 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,2067) = -(rxt(k,218)*y(k,247) + rxt(k,219)*y(k,131) + rxt(k,220) & + *y(k,141) + rxt(k,221)*y(k,265) + rxt(k,229)*y(k,132) + rxt(k,315) & + *y(k,44) + rxt(k,347)*y(k,47) + rxt(k,366)*y(k,31) + rxt(k,373) & + *y(k,51) + rxt(k,387)*y(k,18) + rxt(k,395)*y(k,251) + rxt(k,406) & + *y(k,253) + rxt(k,429)*y(k,249) + rxt(k,435)*y(k,250) + rxt(k,438) & + *y(k,100) + rxt(k,443)*y(k,103) + rxt(k,454)*y(k,273) + rxt(k,499) & + *y(k,6) + rxt(k,502)*y(k,116) + rxt(k,508)*y(k,260) + rxt(k,519) & + *y(k,220) + rxt(k,522)*y(k,69)) + mat(k,2212) = -rxt(k,218)*y(k,133) + mat(k,1791) = -rxt(k,219)*y(k,133) + mat(k,2461) = -rxt(k,220)*y(k,133) + mat(k,2007) = -rxt(k,221)*y(k,133) + mat(k,1685) = -rxt(k,229)*y(k,133) + mat(k,2487) = -rxt(k,315)*y(k,133) + mat(k,1199) = -rxt(k,347)*y(k,133) + mat(k,1188) = -rxt(k,366)*y(k,133) + mat(k,1329) = -rxt(k,373)*y(k,133) + mat(k,415) = -rxt(k,387)*y(k,133) + mat(k,1407) = -rxt(k,395)*y(k,133) + mat(k,1447) = -rxt(k,406)*y(k,133) + mat(k,1352) = -rxt(k,429)*y(k,133) + mat(k,1385) = -rxt(k,435)*y(k,133) + mat(k,931) = -rxt(k,438)*y(k,133) + mat(k,1306) = -rxt(k,443)*y(k,133) + mat(k,1284) = -rxt(k,454)*y(k,133) + mat(k,1076) = -rxt(k,499)*y(k,133) + mat(k,1020) = -rxt(k,502)*y(k,133) + mat(k,1157) = -rxt(k,508)*y(k,133) + mat(k,1122) = -rxt(k,519)*y(k,133) + mat(k,352) = -rxt(k,522)*y(k,133) + mat(k,609) = rxt(k,280)*y(k,141) + mat(k,2258) = rxt(k,247)*y(k,62) + mat(k,1032) = rxt(k,247)*y(k,58) + rxt(k,249)*y(k,141) + rxt(k,250)*y(k,265) + mat(k,972) = rxt(k,294)*y(k,91) + mat(k,2302) = rxt(k,294)*y(k,75) + rxt(k,231)*y(k,265) + mat(k,677) = .500_r8*rxt(k,411)*y(k,265) + mat(k,1685) = mat(k,1685) + rxt(k,217)*y(k,141) + rxt(k,216)*y(k,143) + mat(k,2461) = mat(k,2461) + rxt(k,280)*y(k,22) + rxt(k,249)*y(k,62) & + + rxt(k,217)*y(k,132) + mat(k,2418) = rxt(k,216)*y(k,132) + mat(k,585) = rxt(k,362)*y(k,265) + mat(k,2007) = mat(k,2007) + rxt(k,250)*y(k,62) + rxt(k,231)*y(k,91) & + + .500_r8*rxt(k,411)*y(k,115) + rxt(k,362)*y(k,148) + mat(k,936) = -(rxt(k,377)*y(k,265)) + mat(k,1958) = -rxt(k,377)*y(k,134) + mat(k,1175) = rxt(k,366)*y(k,133) + mat(k,597) = .500_r8*rxt(k,437)*y(k,265) + mat(k,445) = rxt(k,444)*y(k,265) + mat(k,494) = rxt(k,448)*y(k,265) + mat(k,1131) = rxt(k,449)*y(k,265) + mat(k,2026) = rxt(k,366)*y(k,31) + mat(k,1958) = mat(k,1958) + .500_r8*rxt(k,437)*y(k,102) + rxt(k,444)*y(k,104) & + + rxt(k,448)*y(k,122) + rxt(k,449)*y(k,123) + mat(k,431) = -(rxt(k,509)*y(k,265)) + mat(k,1907) = -rxt(k,509)*y(k,135) + mat(k,2135) = rxt(k,506)*y(k,260) + mat(k,1146) = rxt(k,506)*y(k,247) + mat(k,2469) = -(rxt(k,187)*y(k,143) + 4._r8*rxt(k,188)*y(k,141) + rxt(k,189) & + *y(k,142) + rxt(k,190)*y(k,79) + rxt(k,191)*y(k,81) + rxt(k,196) & + *y(k,247) + rxt(k,202)*y(k,265) + (rxt(k,215) + rxt(k,217) & + ) * y(k,132) + rxt(k,220)*y(k,133) + rxt(k,225)*y(k,131) & + + rxt(k,249)*y(k,62) + rxt(k,251)*y(k,61) + rxt(k,254)*y(k,87) & + + rxt(k,257)*y(k,94) + rxt(k,280)*y(k,22) + rxt(k,281)*y(k,21) & + + rxt(k,283)*y(k,83) + rxt(k,285)*y(k,93) + rxt(k,316)*y(k,44) & + + rxt(k,524)*y(k,146) + (rxt(k,607) + rxt(k,608)) * y(k,257) & + + rxt(k,609)*y(k,259)) + mat(k,2426) = -rxt(k,187)*y(k,141) + mat(k,1597) = -rxt(k,189)*y(k,141) + mat(k,1515) = -rxt(k,190)*y(k,141) + mat(k,649) = -rxt(k,191)*y(k,141) + mat(k,2220) = -rxt(k,196)*y(k,141) + mat(k,2015) = -rxt(k,202)*y(k,141) + mat(k,1693) = -(rxt(k,215) + rxt(k,217)) * y(k,141) + mat(k,2075) = -rxt(k,220)*y(k,141) + mat(k,1799) = -rxt(k,225)*y(k,141) + mat(k,1035) = -rxt(k,249)*y(k,141) + mat(k,1648) = -rxt(k,251)*y(k,141) + mat(k,1550) = -rxt(k,254)*y(k,141) + mat(k,878) = -rxt(k,257)*y(k,141) + mat(k,611) = -rxt(k,280)*y(k,141) + mat(k,1621) = -rxt(k,281)*y(k,141) + mat(k,886) = -rxt(k,283)*y(k,141) + mat(k,847) = -rxt(k,285)*y(k,141) + mat(k,2495) = -rxt(k,316)*y(k,141) + mat(k,424) = -rxt(k,524)*y(k,141) + mat(k,748) = -(rxt(k,607) + rxt(k,608)) * y(k,141) + mat(k,554) = -rxt(k,609)*y(k,141) + mat(k,2287) = rxt(k,194)*y(k,247) + mat(k,1052) = rxt(k,210)*y(k,131) + rxt(k,211)*y(k,132) + rxt(k,214)*y(k,142) & + + rxt(k,612)*y(k,264) + mat(k,1799) = mat(k,1799) + rxt(k,210)*y(k,119) + mat(k,1693) = mat(k,1693) + rxt(k,211)*y(k,119) + mat(k,1597) = mat(k,1597) + rxt(k,214)*y(k,119) + rxt(k,526)*y(k,159) & + + rxt(k,533)*y(k,161) + rxt(k,611)*y(k,259) + (rxt(k,176) & + +rxt(k,177))*y(k,261) + rxt(k,617)*y(k,266) + mat(k,783) = rxt(k,526)*y(k,142) + mat(k,1532) = rxt(k,533)*y(k,142) + mat(k,916) = rxt(k,603)*y(k,258) + 1.150_r8*rxt(k,604)*y(k,264) + mat(k,2220) = mat(k,2220) + rxt(k,194)*y(k,78) + mat(k,895) = rxt(k,603)*y(k,243) + mat(k,554) = mat(k,554) + rxt(k,611)*y(k,142) + mat(k,1842) = (rxt(k,176)+rxt(k,177))*y(k,142) + mat(k,903) = rxt(k,612)*y(k,119) + 1.150_r8*rxt(k,604)*y(k,243) + mat(k,2015) = mat(k,2015) + 2.000_r8*rxt(k,204)*y(k,265) + mat(k,856) = rxt(k,617)*y(k,142) + mat(k,1586) = -(rxt(k,176)*y(k,261) + rxt(k,181)*y(k,262) + rxt(k,189) & + *y(k,141) + rxt(k,195)*y(k,78) + rxt(k,209)*y(k,256) + rxt(k,214) & + *y(k,119) + rxt(k,359)*y(k,245) + rxt(k,526)*y(k,159) + rxt(k,533) & + *y(k,161) + rxt(k,606)*y(k,257) + (rxt(k,610) + rxt(k,611) & + ) * y(k,259) + rxt(k,617)*y(k,266)) + mat(k,1827) = -rxt(k,176)*y(k,142) + mat(k,224) = -rxt(k,181)*y(k,142) + mat(k,2454) = -rxt(k,189)*y(k,142) + mat(k,2272) = -rxt(k,195)*y(k,142) + mat(k,577) = -rxt(k,209)*y(k,142) + mat(k,1046) = -rxt(k,214)*y(k,142) + mat(k,511) = -rxt(k,359)*y(k,142) + mat(k,779) = -rxt(k,526)*y(k,142) + mat(k,1522) = -rxt(k,533)*y(k,142) + mat(k,745) = -rxt(k,606)*y(k,142) + mat(k,553) = -(rxt(k,610) + rxt(k,611)) * y(k,142) + mat(k,855) = -rxt(k,617)*y(k,142) + mat(k,1556) = rxt(k,272)*y(k,143) + rxt(k,271)*y(k,247) + mat(k,1608) = 2.000_r8*rxt(k,273)*y(k,21) + (rxt(k,275)+rxt(k,276))*y(k,61) & + + rxt(k,281)*y(k,141) + rxt(k,277)*y(k,247) + mat(k,2251) = rxt(k,240)*y(k,143) + rxt(k,238)*y(k,247) + mat(k,1634) = (rxt(k,275)+rxt(k,276))*y(k,21) + (2.000_r8*rxt(k,242) & + +2.000_r8*rxt(k,243))*y(k,61) + rxt(k,251)*y(k,141) & + + rxt(k,245)*y(k,247) + rxt(k,253)*y(k,265) + mat(k,2272) = mat(k,2272) + rxt(k,198)*y(k,143) + rxt(k,192)*y(k,247) + mat(k,522) = rxt(k,207)*y(k,265) + mat(k,1046) = mat(k,1046) + rxt(k,213)*y(k,132) + mat(k,303) = rxt(k,227)*y(k,261) + mat(k,1784) = rxt(k,224)*y(k,143) + rxt(k,614)*y(k,264) + mat(k,1678) = rxt(k,213)*y(k,119) + rxt(k,215)*y(k,141) + rxt(k,216)*y(k,143) + mat(k,2060) = rxt(k,220)*y(k,141) + rxt(k,218)*y(k,247) + mat(k,2454) = mat(k,2454) + rxt(k,281)*y(k,21) + rxt(k,251)*y(k,61) & + + rxt(k,215)*y(k,132) + rxt(k,220)*y(k,133) & + + 2.000_r8*rxt(k,188)*y(k,141) + 2.000_r8*rxt(k,187)*y(k,143) & + + rxt(k,196)*y(k,247) + rxt(k,180)*y(k,262) + rxt(k,202) & + *y(k,265) + mat(k,1586) = mat(k,1586) + 2.000_r8*rxt(k,181)*y(k,262) + mat(k,2411) = rxt(k,272)*y(k,19) + rxt(k,240)*y(k,58) + rxt(k,198)*y(k,78) & + + rxt(k,224)*y(k,131) + rxt(k,216)*y(k,132) & + + 2.000_r8*rxt(k,187)*y(k,141) + rxt(k,528)*y(k,159) & + + rxt(k,534)*y(k,161) + 2.000_r8*rxt(k,197)*y(k,247) & + + 2.000_r8*rxt(k,178)*y(k,261) + rxt(k,203)*y(k,265) + mat(k,779) = mat(k,779) + rxt(k,528)*y(k,143) + mat(k,1522) = mat(k,1522) + rxt(k,534)*y(k,143) + mat(k,952) = rxt(k,341)*y(k,247) + mat(k,982) = rxt(k,369)*y(k,247) + mat(k,2347) = rxt(k,320)*y(k,247) + mat(k,2205) = rxt(k,271)*y(k,19) + rxt(k,277)*y(k,21) + rxt(k,238)*y(k,58) & + + rxt(k,245)*y(k,61) + rxt(k,192)*y(k,78) + rxt(k,218)*y(k,133) & + + rxt(k,196)*y(k,141) + 2.000_r8*rxt(k,197)*y(k,143) & + + rxt(k,341)*y(k,237) + rxt(k,369)*y(k,238) + rxt(k,320) & + *y(k,241) + 2.000_r8*rxt(k,206)*y(k,247) + rxt(k,201)*y(k,265) & + + rxt(k,378)*y(k,268) + mat(k,1827) = mat(k,1827) + rxt(k,227)*y(k,120) + 2.000_r8*rxt(k,178) & + *y(k,143) + mat(k,224) = mat(k,224) + rxt(k,180)*y(k,141) + 2.000_r8*rxt(k,181)*y(k,142) + mat(k,900) = rxt(k,614)*y(k,131) + mat(k,2000) = rxt(k,253)*y(k,61) + rxt(k,207)*y(k,92) + rxt(k,202)*y(k,141) & + + rxt(k,203)*y(k,143) + rxt(k,201)*y(k,247) + mat(k,865) = rxt(k,378)*y(k,247) + mat(k,2425) = -(rxt(k,178)*y(k,261) + rxt(k,187)*y(k,141) + rxt(k,197) & + *y(k,247) + rxt(k,198)*y(k,78) + rxt(k,203)*y(k,265) + rxt(k,216) & + *y(k,132) + rxt(k,224)*y(k,131) + rxt(k,240)*y(k,58) + rxt(k,272) & + *y(k,19) + rxt(k,338)*y(k,27) + rxt(k,367)*y(k,31) + rxt(k,398) & + *y(k,111) + rxt(k,412)*y(k,118) + rxt(k,445)*y(k,100) + rxt(k,483) & + *y(k,150) + rxt(k,500)*y(k,6) + rxt(k,503)*y(k,116) + rxt(k,528) & + *y(k,159) + rxt(k,534)*y(k,161)) + mat(k,1841) = -rxt(k,178)*y(k,143) + mat(k,2468) = -rxt(k,187)*y(k,143) + mat(k,2219) = -rxt(k,197)*y(k,143) + mat(k,2286) = -rxt(k,198)*y(k,143) + mat(k,2014) = -rxt(k,203)*y(k,143) + mat(k,1692) = -rxt(k,216)*y(k,143) + mat(k,1798) = -rxt(k,224)*y(k,143) + mat(k,2265) = -rxt(k,240)*y(k,143) + mat(k,1564) = -rxt(k,272)*y(k,143) + mat(k,626) = -rxt(k,338)*y(k,143) + mat(k,1192) = -rxt(k,367)*y(k,143) + mat(k,1321) = -rxt(k,398)*y(k,143) + mat(k,1433) = -rxt(k,412)*y(k,143) + mat(k,934) = -rxt(k,445)*y(k,143) + mat(k,538) = -rxt(k,483)*y(k,143) + mat(k,1078) = -rxt(k,500)*y(k,143) + mat(k,1022) = -rxt(k,503)*y(k,143) + mat(k,782) = -rxt(k,528)*y(k,143) + mat(k,1531) = -rxt(k,534)*y(k,143) + mat(k,2468) = mat(k,2468) + rxt(k,189)*y(k,142) + mat(k,1596) = rxt(k,189)*y(k,141) + mat(k,1483) = .150_r8*rxt(k,352)*y(k,247) + mat(k,2219) = mat(k,2219) + .150_r8*rxt(k,352)*y(k,240) + .150_r8*rxt(k,403) & + *y(k,253) + mat(k,1451) = .150_r8*rxt(k,403)*y(k,247) + mat(k,362) = -(rxt(k,535)*y(k,161)) + mat(k,1517) = -rxt(k,535)*y(k,145) + mat(k,1601) = rxt(k,274)*y(k,61) + mat(k,1627) = rxt(k,274)*y(k,21) + 2.000_r8*rxt(k,244)*y(k,61) + 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,417) = -(rxt(k,524)*y(k,141) + rxt(k,525)*y(k,265)) + mat(k,2431) = -rxt(k,524)*y(k,146) + mat(k,1905) = -rxt(k,525)*y(k,146) + mat(k,1234) = rxt(k,391)*y(k,265) + mat(k,1719) = .100_r8*rxt(k,512)*y(k,270) + mat(k,1883) = rxt(k,391)*y(k,95) + mat(k,1215) = .100_r8*rxt(k,512)*y(k,131) + mat(k,580) = -(rxt(k,362)*y(k,265)) + mat(k,1926) = -rxt(k,362)*y(k,148) + mat(k,1657) = rxt(k,364)*y(k,240) + mat(k,1455) = rxt(k,364)*y(k,132) + mat(k,1651) = rxt(k,485)*y(k,233) + mat(k,568) = rxt(k,485)*y(k,132) + mat(k,535) = -(rxt(k,482)*y(k,132) + rxt(k,483)*y(k,143)) + mat(k,1655) = -rxt(k,482)*y(k,150) + mat(k,2374) = -rxt(k,483)*y(k,150) + mat(k,238) = .070_r8*rxt(k,469)*y(k,265) + mat(k,1729) = rxt(k,467)*y(k,239) + mat(k,220) = .060_r8*rxt(k,481)*y(k,265) + mat(k,263) = .070_r8*rxt(k,497)*y(k,265) + mat(k,691) = rxt(k,467)*y(k,131) + mat(k,1921) = .070_r8*rxt(k,469)*y(k,68) + .060_r8*rxt(k,481)*y(k,151) & + + .070_r8*rxt(k,497)*y(k,229) + mat(k,218) = -(rxt(k,481)*y(k,265)) + mat(k,1873) = -rxt(k,481)*y(k,151) + mat(k,210) = .530_r8*rxt(k,458)*y(k,265) + mat(k,1873) = mat(k,1873) + .530_r8*rxt(k,458)*y(k,8) + mat(k,367) = -(rxt(k,484)*y(k,265)) + mat(k,1897) = -rxt(k,484)*y(k,152) + mat(k,2129) = rxt(k,479)*y(k,267) + mat(k,499) = rxt(k,479)*y(k,247) + mat(k,588) = -(rxt(k,380)*y(k,265)) + mat(k,1927) = -rxt(k,380)*y(k,157) + mat(k,2152) = rxt(k,378)*y(k,268) + mat(k,861) = rxt(k,378)*y(k,247) + mat(k,425) = -(rxt(k,384)*y(k,265)) + mat(k,1906) = -rxt(k,384)*y(k,158) + mat(k,2134) = .850_r8*rxt(k,382)*y(k,269) + mat(k,1258) = .850_r8*rxt(k,382)*y(k,247) + mat(k,777) = -(rxt(k,526)*y(k,142) + rxt(k,528)*y(k,143) + rxt(k,531) & + *y(k,265)) + mat(k,1574) = -rxt(k,526)*y(k,159) + mat(k,2378) = -rxt(k,528)*y(k,159) + mat(k,1947) = -rxt(k,531)*y(k,159) + mat(k,1520) = -(rxt(k,529)*y(k,21) + rxt(k,530)*y(k,61) + rxt(k,532)*y(k,132) & + + rxt(k,533)*y(k,142) + rxt(k,534)*y(k,143) + rxt(k,535) & + *y(k,145) + rxt(k,536)*y(k,265)) + mat(k,1605) = -rxt(k,529)*y(k,161) + mat(k,1631) = -rxt(k,530)*y(k,161) + mat(k,1675) = -rxt(k,532)*y(k,161) + mat(k,1584) = -rxt(k,533)*y(k,161) + mat(k,2409) = -rxt(k,534)*y(k,161) + mat(k,364) = -rxt(k,535)*y(k,161) + mat(k,1997) = -rxt(k,536)*y(k,161) + mat(k,2451) = rxt(k,524)*y(k,146) + mat(k,1584) = mat(k,1584) + rxt(k,526)*y(k,159) + mat(k,2409) = mat(k,2409) + rxt(k,528)*y(k,159) + mat(k,421) = rxt(k,524)*y(k,141) + mat(k,778) = rxt(k,526)*y(k,142) + rxt(k,528)*y(k,143) + rxt(k,531)*y(k,265) + mat(k,1997) = mat(k,1997) + rxt(k,531)*y(k,159) + mat(k,991) = -(rxt(k,527)*y(k,265)) + mat(k,1964) = -rxt(k,527)*y(k,162) + mat(k,1604) = rxt(k,529)*y(k,161) + mat(k,1629) = rxt(k,530)*y(k,161) + mat(k,350) = rxt(k,522)*y(k,133) + (rxt(k,523)+.500_r8*rxt(k,537))*y(k,265) + mat(k,1665) = rxt(k,532)*y(k,161) + mat(k,2028) = rxt(k,522)*y(k,69) + mat(k,1579) = rxt(k,533)*y(k,161) + mat(k,2382) = rxt(k,534)*y(k,161) + mat(k,363) = rxt(k,535)*y(k,161) + mat(k,419) = rxt(k,525)*y(k,265) + mat(k,1519) = rxt(k,529)*y(k,21) + rxt(k,530)*y(k,61) + rxt(k,532)*y(k,132) & + + rxt(k,533)*y(k,142) + rxt(k,534)*y(k,143) + rxt(k,535) & + *y(k,145) + rxt(k,536)*y(k,265) + mat(k,1964) = mat(k,1964) + (rxt(k,523)+.500_r8*rxt(k,537))*y(k,69) & + + rxt(k,525)*y(k,146) + rxt(k,536)*y(k,161) + mat(k,307) = -(rxt(k,538)*y(k,276)) + mat(k,2499) = -rxt(k,538)*y(k,163) + mat(k,990) = rxt(k,527)*y(k,265) + mat(k,1889) = rxt(k,527)*y(k,162) + mat(k,66) = .1056005_r8*rxt(k,567)*y(k,131) + .2381005_r8*rxt(k,566)*y(k,247) + mat(k,1696) = .1056005_r8*rxt(k,567)*y(k,108) + mat(k,117) = .5931005_r8*rxt(k,577)*y(k,265) + mat(k,2103) = .2381005_r8*rxt(k,566)*y(k,108) + mat(k,1845) = .5931005_r8*rxt(k,577)*y(k,214) + mat(k,67) = .1026005_r8*rxt(k,567)*y(k,131) + .1308005_r8*rxt(k,566)*y(k,247) + mat(k,1697) = .1026005_r8*rxt(k,567)*y(k,108) + mat(k,118) = .1534005_r8*rxt(k,577)*y(k,265) + mat(k,2104) = .1308005_r8*rxt(k,566)*y(k,108) + mat(k,1846) = .1534005_r8*rxt(k,577)*y(k,214) + mat(k,68) = .0521005_r8*rxt(k,567)*y(k,131) + .0348005_r8*rxt(k,566)*y(k,247) + mat(k,1698) = .0521005_r8*rxt(k,567)*y(k,108) + mat(k,119) = .0459005_r8*rxt(k,577)*y(k,265) + mat(k,2105) = .0348005_r8*rxt(k,566)*y(k,108) + mat(k,1847) = .0459005_r8*rxt(k,577)*y(k,214) + mat(k,69) = .0143005_r8*rxt(k,567)*y(k,131) + .0076005_r8*rxt(k,566)*y(k,247) + mat(k,1699) = .0143005_r8*rxt(k,567)*y(k,108) + mat(k,120) = .0085005_r8*rxt(k,577)*y(k,265) + mat(k,2106) = .0076005_r8*rxt(k,566)*y(k,108) + mat(k,1848) = .0085005_r8*rxt(k,577)*y(k,214) + mat(k,70) = .0166005_r8*rxt(k,567)*y(k,131) + .0113005_r8*rxt(k,566)*y(k,247) + mat(k,1700) = .0166005_r8*rxt(k,567)*y(k,108) + mat(k,121) = .0128005_r8*rxt(k,577)*y(k,265) + mat(k,2107) = .0113005_r8*rxt(k,566)*y(k,108) + mat(k,1849) = .0128005_r8*rxt(k,577)*y(k,214) + mat(k,1053) = .2202005_r8*rxt(k,556)*y(k,143) + mat(k,91) = .1279005_r8*rxt(k,555)*y(k,131) + .2202005_r8*rxt(k,554)*y(k,247) + mat(k,79) = .0003005_r8*rxt(k,563)*y(k,131) + .0031005_r8*rxt(k,562)*y(k,247) + mat(k,997) = .0508005_r8*rxt(k,575)*y(k,143) + mat(k,85) = .0245005_r8*rxt(k,574)*y(k,131) + .0508005_r8*rxt(k,573)*y(k,247) + mat(k,1702) = .1279005_r8*rxt(k,555)*y(k,7) + .0003005_r8*rxt(k,563)*y(k,105) & + + .0245005_r8*rxt(k,574)*y(k,117) + mat(k,2365) = .2202005_r8*rxt(k,556)*y(k,6) + .0508005_r8*rxt(k,575)*y(k,116) + mat(k,2109) = .2202005_r8*rxt(k,554)*y(k,7) + .0031005_r8*rxt(k,562)*y(k,105) & + + .0508005_r8*rxt(k,573)*y(k,117) + mat(k,1054) = .2067005_r8*rxt(k,556)*y(k,143) + mat(k,92) = .1792005_r8*rxt(k,555)*y(k,131) + .2067005_r8*rxt(k,554)*y(k,247) + mat(k,80) = .0003005_r8*rxt(k,563)*y(k,131) + .0035005_r8*rxt(k,562)*y(k,247) + mat(k,998) = .1149005_r8*rxt(k,575)*y(k,143) + mat(k,86) = .0082005_r8*rxt(k,574)*y(k,131) + .1149005_r8*rxt(k,573)*y(k,247) + mat(k,1703) = .1792005_r8*rxt(k,555)*y(k,7) + .0003005_r8*rxt(k,563)*y(k,105) & + + .0082005_r8*rxt(k,574)*y(k,117) + mat(k,2366) = .2067005_r8*rxt(k,556)*y(k,6) + .1149005_r8*rxt(k,575)*y(k,116) + mat(k,2110) = .2067005_r8*rxt(k,554)*y(k,7) + .0035005_r8*rxt(k,562)*y(k,105) & + + .1149005_r8*rxt(k,573)*y(k,117) + mat(k,1055) = .0653005_r8*rxt(k,556)*y(k,143) + mat(k,93) = .0676005_r8*rxt(k,555)*y(k,131) + .0653005_r8*rxt(k,554)*y(k,247) + mat(k,81) = .0073005_r8*rxt(k,563)*y(k,131) + .0003005_r8*rxt(k,562)*y(k,247) + mat(k,999) = .0348005_r8*rxt(k,575)*y(k,143) + mat(k,87) = .0772005_r8*rxt(k,574)*y(k,131) + .0348005_r8*rxt(k,573)*y(k,247) + mat(k,1704) = .0676005_r8*rxt(k,555)*y(k,7) + .0073005_r8*rxt(k,563)*y(k,105) & + + .0772005_r8*rxt(k,574)*y(k,117) + mat(k,2367) = .0653005_r8*rxt(k,556)*y(k,6) + .0348005_r8*rxt(k,575)*y(k,116) + mat(k,2111) = .0653005_r8*rxt(k,554)*y(k,7) + .0003005_r8*rxt(k,562)*y(k,105) & + + .0348005_r8*rxt(k,573)*y(k,117) + mat(k,1056) = .1749305_r8*rxt(k,553)*y(k,133) + .1284005_r8*rxt(k,556) & + *y(k,143) + mat(k,94) = .079_r8*rxt(k,555)*y(k,131) + .1284005_r8*rxt(k,554)*y(k,247) + mat(k,917) = .0590245_r8*rxt(k,561)*y(k,133) + .0033005_r8*rxt(k,564) & + *y(k,143) + mat(k,82) = .0057005_r8*rxt(k,563)*y(k,131) + .0271005_r8*rxt(k,562)*y(k,247) + mat(k,1000) = .1749305_r8*rxt(k,572)*y(k,133) + .0554005_r8*rxt(k,575) & + *y(k,143) + mat(k,88) = .0332005_r8*rxt(k,574)*y(k,131) + .0554005_r8*rxt(k,573)*y(k,247) + mat(k,1705) = .079_r8*rxt(k,555)*y(k,7) + .0057005_r8*rxt(k,563)*y(k,105) & + + .0332005_r8*rxt(k,574)*y(k,117) + mat(k,2018) = .1749305_r8*rxt(k,553)*y(k,6) + .0590245_r8*rxt(k,561)*y(k,100) & + + .1749305_r8*rxt(k,572)*y(k,116) + mat(k,2368) = .1284005_r8*rxt(k,556)*y(k,6) + .0033005_r8*rxt(k,564)*y(k,100) & + + .0554005_r8*rxt(k,575)*y(k,116) + mat(k,2112) = .1284005_r8*rxt(k,554)*y(k,7) + .0271005_r8*rxt(k,562)*y(k,105) & + + .0554005_r8*rxt(k,573)*y(k,117) + mat(k,1057) = .5901905_r8*rxt(k,553)*y(k,133) + .114_r8*rxt(k,556)*y(k,143) + mat(k,95) = .1254005_r8*rxt(k,555)*y(k,131) + .114_r8*rxt(k,554)*y(k,247) + mat(k,918) = .0250245_r8*rxt(k,561)*y(k,133) + mat(k,83) = .0623005_r8*rxt(k,563)*y(k,131) + .0474005_r8*rxt(k,562)*y(k,247) + mat(k,1001) = .5901905_r8*rxt(k,572)*y(k,133) + .1278005_r8*rxt(k,575) & + *y(k,143) + mat(k,89) = .130_r8*rxt(k,574)*y(k,131) + .1278005_r8*rxt(k,573)*y(k,247) + mat(k,1706) = .1254005_r8*rxt(k,555)*y(k,7) + .0623005_r8*rxt(k,563)*y(k,105) & + + .130_r8*rxt(k,574)*y(k,117) + mat(k,2019) = .5901905_r8*rxt(k,553)*y(k,6) + .0250245_r8*rxt(k,561)*y(k,100) & + + .5901905_r8*rxt(k,572)*y(k,116) + mat(k,2369) = .114_r8*rxt(k,556)*y(k,6) + .1278005_r8*rxt(k,575)*y(k,116) + mat(k,2113) = .114_r8*rxt(k,554)*y(k,7) + .0474005_r8*rxt(k,562)*y(k,105) & + + .1278005_r8*rxt(k,573)*y(k,117) + mat(k,102) = .0097005_r8*rxt(k,560)*y(k,131) + .0023005_r8*rxt(k,559) & + *y(k,247) + mat(k,108) = .1056005_r8*rxt(k,570)*y(k,131) + .2381005_r8*rxt(k,569) & + *y(k,247) + mat(k,1710) = .0097005_r8*rxt(k,560)*y(k,9) + .1056005_r8*rxt(k,570)*y(k,110) & + + .0154005_r8*rxt(k,581)*y(k,224) + .0063005_r8*rxt(k,585) & + *y(k,228) + mat(k,123) = .5931005_r8*rxt(k,578)*y(k,265) + mat(k,129) = .0154005_r8*rxt(k,581)*y(k,131) + .1364005_r8*rxt(k,580) & + *y(k,247) + mat(k,135) = .0063005_r8*rxt(k,585)*y(k,131) + .1677005_r8*rxt(k,584) & + *y(k,247) + mat(k,2117) = .0023005_r8*rxt(k,559)*y(k,9) + .2381005_r8*rxt(k,569)*y(k,110) & + + .1364005_r8*rxt(k,580)*y(k,224) + .1677005_r8*rxt(k,584) & + *y(k,228) + mat(k,1855) = .5931005_r8*rxt(k,578)*y(k,215) + mat(k,103) = .0034005_r8*rxt(k,560)*y(k,131) + .0008005_r8*rxt(k,559) & + *y(k,247) + mat(k,109) = .1026005_r8*rxt(k,570)*y(k,131) + .1308005_r8*rxt(k,569) & + *y(k,247) + mat(k,1711) = .0034005_r8*rxt(k,560)*y(k,9) + .1026005_r8*rxt(k,570)*y(k,110) & + + .0452005_r8*rxt(k,581)*y(k,224) + .0237005_r8*rxt(k,585) & + *y(k,228) + mat(k,124) = .1534005_r8*rxt(k,578)*y(k,265) + mat(k,130) = .0452005_r8*rxt(k,581)*y(k,131) + .0101005_r8*rxt(k,580) & + *y(k,247) + mat(k,136) = .0237005_r8*rxt(k,585)*y(k,131) + .0174005_r8*rxt(k,584) & + *y(k,247) + mat(k,2118) = .0008005_r8*rxt(k,559)*y(k,9) + .1308005_r8*rxt(k,569)*y(k,110) & + + .0101005_r8*rxt(k,580)*y(k,224) + .0174005_r8*rxt(k,584) & + *y(k,228) + mat(k,1856) = .1534005_r8*rxt(k,578)*y(k,215) + mat(k,104) = .1579005_r8*rxt(k,560)*y(k,131) + .0843005_r8*rxt(k,559) & + *y(k,247) + mat(k,110) = .0521005_r8*rxt(k,570)*y(k,131) + .0348005_r8*rxt(k,569) & + *y(k,247) + mat(k,1712) = .1579005_r8*rxt(k,560)*y(k,9) + .0521005_r8*rxt(k,570)*y(k,110) & + + .0966005_r8*rxt(k,581)*y(k,224) + .0025005_r8*rxt(k,585) & + *y(k,228) + mat(k,125) = .0459005_r8*rxt(k,578)*y(k,265) + mat(k,131) = .0966005_r8*rxt(k,581)*y(k,131) + .0763005_r8*rxt(k,580) & + *y(k,247) + mat(k,137) = .0025005_r8*rxt(k,585)*y(k,131) + .086_r8*rxt(k,584)*y(k,247) + mat(k,2119) = .0843005_r8*rxt(k,559)*y(k,9) + .0348005_r8*rxt(k,569)*y(k,110) & + + .0763005_r8*rxt(k,580)*y(k,224) + .086_r8*rxt(k,584)*y(k,228) + mat(k,1857) = .0459005_r8*rxt(k,578)*y(k,215) + end do + end subroutine nlnmat07 + subroutine nlnmat08( 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,105) = .0059005_r8*rxt(k,560)*y(k,131) + .0443005_r8*rxt(k,559) & + *y(k,247) + mat(k,111) = .0143005_r8*rxt(k,570)*y(k,131) + .0076005_r8*rxt(k,569) & + *y(k,247) + mat(k,1713) = .0059005_r8*rxt(k,560)*y(k,9) + .0143005_r8*rxt(k,570)*y(k,110) & + + .0073005_r8*rxt(k,581)*y(k,224) + .011_r8*rxt(k,585)*y(k,228) + mat(k,126) = .0085005_r8*rxt(k,578)*y(k,265) + mat(k,132) = .0073005_r8*rxt(k,581)*y(k,131) + .2157005_r8*rxt(k,580) & + *y(k,247) + mat(k,138) = .011_r8*rxt(k,585)*y(k,131) + .0512005_r8*rxt(k,584)*y(k,247) + mat(k,2120) = .0443005_r8*rxt(k,559)*y(k,9) + .0076005_r8*rxt(k,569)*y(k,110) & + + .2157005_r8*rxt(k,580)*y(k,224) + .0512005_r8*rxt(k,584) & + *y(k,228) + mat(k,1858) = .0085005_r8*rxt(k,578)*y(k,215) + mat(k,106) = .0536005_r8*rxt(k,560)*y(k,131) + .1621005_r8*rxt(k,559) & + *y(k,247) + mat(k,112) = .0166005_r8*rxt(k,570)*y(k,131) + .0113005_r8*rxt(k,569) & + *y(k,247) + mat(k,1714) = .0536005_r8*rxt(k,560)*y(k,9) + .0166005_r8*rxt(k,570)*y(k,110) & + + .238_r8*rxt(k,581)*y(k,224) + .1185005_r8*rxt(k,585)*y(k,228) + mat(k,127) = .0128005_r8*rxt(k,578)*y(k,265) + mat(k,133) = .238_r8*rxt(k,581)*y(k,131) + .0738005_r8*rxt(k,580)*y(k,247) + mat(k,139) = .1185005_r8*rxt(k,585)*y(k,131) + .1598005_r8*rxt(k,584) & + *y(k,247) + mat(k,2121) = .1621005_r8*rxt(k,559)*y(k,9) + .0113005_r8*rxt(k,569)*y(k,110) & + + .0738005_r8*rxt(k,580)*y(k,224) + .1598005_r8*rxt(k,584) & + *y(k,228) + mat(k,1859) = .0128005_r8*rxt(k,578)*y(k,215) + mat(k,122) = -(rxt(k,577)*y(k,265)) + mat(k,1863) = -rxt(k,577)*y(k,214) + mat(k,128) = -(rxt(k,578)*y(k,265)) + mat(k,1864) = -rxt(k,578)*y(k,215) + mat(k,231) = .100_r8*rxt(k,489)*y(k,265) + mat(k,253) = .230_r8*rxt(k,491)*y(k,265) + mat(k,1876) = .100_r8*rxt(k,489)*y(k,223) + .230_r8*rxt(k,491)*y(k,226) + mat(k,728) = -(rxt(k,513)*y(k,265)) + mat(k,1943) = -rxt(k,513)*y(k,217) + mat(k,2160) = rxt(k,511)*y(k,270) + mat(k,1216) = rxt(k,511)*y(k,247) + mat(k,684) = -(rxt(k,514)*y(k,265)) + mat(k,1938) = -rxt(k,514)*y(k,218) + mat(k,1738) = .200_r8*rxt(k,507)*y(k,260) + .200_r8*rxt(k,517)*y(k,271) + mat(k,2317) = .500_r8*rxt(k,505)*y(k,260) + mat(k,1147) = .200_r8*rxt(k,507)*y(k,131) + .500_r8*rxt(k,505)*y(k,241) + mat(k,1104) = .200_r8*rxt(k,517)*y(k,131) + mat(k,528) = -(rxt(k,518)*y(k,265)) + mat(k,1920) = -rxt(k,518)*y(k,219) + mat(k,2147) = rxt(k,516)*y(k,271) + mat(k,1103) = rxt(k,516)*y(k,247) + mat(k,1116) = -(rxt(k,519)*y(k,133) + rxt(k,520)*y(k,265)) + mat(k,2034) = -rxt(k,519)*y(k,220) + mat(k,1972) = -rxt(k,520)*y(k,220) + mat(k,1066) = .330_r8*rxt(k,500)*y(k,143) + mat(k,1010) = .330_r8*rxt(k,503)*y(k,143) + mat(k,1760) = .800_r8*rxt(k,507)*y(k,260) + .800_r8*rxt(k,517)*y(k,271) + mat(k,2034) = mat(k,2034) + rxt(k,508)*y(k,260) + mat(k,2388) = .330_r8*rxt(k,500)*y(k,6) + .330_r8*rxt(k,503)*y(k,116) + mat(k,685) = rxt(k,514)*y(k,265) + mat(k,2325) = .500_r8*rxt(k,505)*y(k,260) + rxt(k,515)*y(k,271) + mat(k,1149) = .800_r8*rxt(k,507)*y(k,131) + rxt(k,508)*y(k,133) & + + .500_r8*rxt(k,505)*y(k,241) + mat(k,1972) = mat(k,1972) + rxt(k,514)*y(k,218) + mat(k,1107) = .800_r8*rxt(k,517)*y(k,131) + rxt(k,515)*y(k,241) + mat(k,1163) = -(rxt(k,521)*y(k,265)) + mat(k,1976) = -rxt(k,521)*y(k,221) + mat(k,1069) = .300_r8*rxt(k,500)*y(k,143) + mat(k,1013) = .300_r8*rxt(k,503)*y(k,143) + mat(k,1764) = .900_r8*rxt(k,512)*y(k,270) + mat(k,2391) = .300_r8*rxt(k,500)*y(k,6) + .300_r8*rxt(k,503)*y(k,116) + mat(k,2329) = rxt(k,510)*y(k,270) + mat(k,1219) = .900_r8*rxt(k,512)*y(k,131) + rxt(k,510)*y(k,241) + mat(k,662) = -(rxt(k,488)*y(k,265)) + mat(k,1935) = -rxt(k,488)*y(k,222) + mat(k,2155) = rxt(k,486)*y(k,272) + mat(k,792) = rxt(k,486)*y(k,247) + mat(k,229) = -((rxt(k,489) + rxt(k,579)) * y(k,265)) + mat(k,1874) = -(rxt(k,489) + rxt(k,579)) * y(k,223) + mat(k,134) = -(rxt(k,580)*y(k,247) + rxt(k,581)*y(k,131)) + mat(k,2124) = -rxt(k,580)*y(k,224) + mat(k,1717) = -rxt(k,581)*y(k,224) + mat(k,228) = rxt(k,579)*y(k,265) + mat(k,1865) = rxt(k,579)*y(k,223) + mat(k,245) = -(rxt(k,455)*y(k,265)) + mat(k,1877) = -rxt(k,455)*y(k,225) + mat(k,2127) = rxt(k,452)*y(k,273) + mat(k,1271) = rxt(k,452)*y(k,247) + mat(k,254) = -(rxt(k,491)*y(k,265)) + mat(k,1879) = -rxt(k,491)*y(k,226) + mat(k,766) = -(rxt(k,494)*y(k,265)) + mat(k,1946) = -rxt(k,494)*y(k,227) + mat(k,2163) = rxt(k,492)*y(k,274) + mat(k,809) = rxt(k,492)*y(k,247) + mat(k,140) = -(rxt(k,584)*y(k,247) + rxt(k,585)*y(k,131)) + mat(k,2125) = -rxt(k,584)*y(k,228) + mat(k,1718) = -rxt(k,585)*y(k,228) + mat(k,252) = rxt(k,583)*y(k,265) + mat(k,1866) = rxt(k,583)*y(k,226) + mat(k,262) = -(rxt(k,497)*y(k,265)) + mat(k,1880) = -rxt(k,497)*y(k,229) + mat(k,255) = .150_r8*rxt(k,491)*y(k,265) + mat(k,1880) = mat(k,1880) + .150_r8*rxt(k,491)*y(k,226) + mat(k,473) = -(rxt(k,498)*y(k,265)) + mat(k,1913) = -rxt(k,498)*y(k,230) + mat(k,2140) = rxt(k,495)*y(k,275) + mat(k,555) = rxt(k,495)*y(k,247) + mat(k,569) = -(rxt(k,456)*y(k,247) + rxt(k,457)*y(k,131) + rxt(k,485) & + *y(k,132)) + mat(k,2151) = -rxt(k,456)*y(k,233) + mat(k,1733) = -rxt(k,457)*y(k,233) + mat(k,1656) = -rxt(k,485)*y(k,233) + mat(k,280) = rxt(k,462)*y(k,265) + mat(k,1925) = rxt(k,462)*y(k,24) + mat(k,1086) = -(rxt(k,417)*y(k,247) + (rxt(k,418) + rxt(k,419)) * y(k,131)) + mat(k,2178) = -rxt(k,417)*y(k,234) + mat(k,1757) = -(rxt(k,418) + rxt(k,419)) * y(k,234) + mat(k,713) = rxt(k,420)*y(k,265) + mat(k,271) = rxt(k,421)*y(k,265) + mat(k,1969) = rxt(k,420)*y(k,2) + rxt(k,421)*y(k,17) + mat(k,541) = -(rxt(k,459)*y(k,247) + rxt(k,460)*y(k,131)) + mat(k,2149) = -rxt(k,459)*y(k,235) + mat(k,1730) = -rxt(k,460)*y(k,235) + mat(k,211) = .350_r8*rxt(k,458)*y(k,265) + mat(k,451) = rxt(k,461)*y(k,265) + mat(k,1922) = .350_r8*rxt(k,458)*y(k,8) + rxt(k,461)*y(k,10) + mat(k,481) = -(rxt(k,463)*y(k,247) + rxt(k,465)*y(k,131)) + mat(k,2141) = -rxt(k,463)*y(k,236) + mat(k,1724) = -rxt(k,465)*y(k,236) + mat(k,374) = rxt(k,464)*y(k,265) + mat(k,232) = .070_r8*rxt(k,489)*y(k,265) + mat(k,256) = .060_r8*rxt(k,491)*y(k,265) + mat(k,1914) = rxt(k,464)*y(k,25) + .070_r8*rxt(k,489)*y(k,223) & + + .060_r8*rxt(k,491)*y(k,226) + mat(k,950) = -(4._r8*rxt(k,339)*y(k,237) + rxt(k,340)*y(k,241) + rxt(k,341) & + *y(k,247) + rxt(k,342)*y(k,131)) + mat(k,2321) = -rxt(k,340)*y(k,237) + mat(k,2175) = -rxt(k,341)*y(k,237) + mat(k,1753) = -rxt(k,342)*y(k,237) + mat(k,379) = .500_r8*rxt(k,344)*y(k,265) + mat(k,335) = rxt(k,345)*y(k,58) + rxt(k,346)*y(k,265) + mat(k,2236) = rxt(k,345)*y(k,30) + mat(k,1960) = .500_r8*rxt(k,344)*y(k,29) + rxt(k,346)*y(k,30) + mat(k,979) = -(rxt(k,368)*y(k,241) + rxt(k,369)*y(k,247) + rxt(k,370) & + *y(k,131)) + mat(k,2322) = -rxt(k,368)*y(k,238) + mat(k,2177) = -rxt(k,369)*y(k,238) + mat(k,1755) = -rxt(k,370)*y(k,238) + mat(k,438) = rxt(k,371)*y(k,265) + mat(k,341) = rxt(k,375)*y(k,58) + rxt(k,372)*y(k,265) + mat(k,2237) = rxt(k,375)*y(k,33) + mat(k,1963) = rxt(k,371)*y(k,32) + rxt(k,372)*y(k,33) + mat(k,692) = -(rxt(k,466)*y(k,247) + rxt(k,467)*y(k,131)) + mat(k,2157) = -rxt(k,466)*y(k,239) + mat(k,1739) = -rxt(k,467)*y(k,239) + mat(k,317) = rxt(k,468)*y(k,265) + mat(k,1739) = mat(k,1739) + rxt(k,457)*y(k,233) + mat(k,2376) = rxt(k,483)*y(k,150) + mat(k,536) = rxt(k,483)*y(k,143) + mat(k,570) = rxt(k,457)*y(k,131) + .400_r8*rxt(k,456)*y(k,247) + mat(k,2157) = mat(k,2157) + .400_r8*rxt(k,456)*y(k,233) + mat(k,1939) = rxt(k,468)*y(k,34) + mat(k,1472) = -(4._r8*rxt(k,350)*y(k,240) + rxt(k,351)*y(k,241) + rxt(k,352) & + *y(k,247) + rxt(k,353)*y(k,131) + rxt(k,364)*y(k,132) + rxt(k,392) & + *y(k,251) + rxt(k,425)*y(k,249) + rxt(k,430)*y(k,250) + rxt(k,439) & + *y(k,103) + rxt(k,450)*y(k,273)) + mat(k,2345) = -rxt(k,351)*y(k,240) + mat(k,2200) = -rxt(k,352)*y(k,240) + mat(k,1781) = -rxt(k,353)*y(k,240) + mat(k,1673) = -rxt(k,364)*y(k,240) + mat(k,1402) = -rxt(k,392)*y(k,240) + mat(k,1347) = -rxt(k,425)*y(k,240) + mat(k,1380) = -rxt(k,430)*y(k,240) + mat(k,1301) = -rxt(k,439)*y(k,240) + mat(k,1279) = -rxt(k,450)*y(k,240) + mat(k,1073) = .060_r8*rxt(k,500)*y(k,143) + mat(k,1197) = rxt(k,347)*y(k,133) + rxt(k,348)*y(k,265) + mat(k,1326) = rxt(k,373)*y(k,133) + rxt(k,374)*y(k,265) + mat(k,638) = .500_r8*rxt(k,355)*y(k,265) + mat(k,929) = .080_r8*rxt(k,445)*y(k,143) + mat(k,1317) = .100_r8*rxt(k,398)*y(k,143) + mat(k,1017) = .060_r8*rxt(k,503)*y(k,143) + mat(k,1422) = .280_r8*rxt(k,412)*y(k,143) + mat(k,1781) = mat(k,1781) + .530_r8*rxt(k,396)*y(k,251) + rxt(k,405)*y(k,253) & + + rxt(k,408)*y(k,255) + rxt(k,383)*y(k,269) + mat(k,2056) = rxt(k,347)*y(k,47) + rxt(k,373)*y(k,51) + .530_r8*rxt(k,395) & + *y(k,251) + rxt(k,406)*y(k,253) + mat(k,2407) = .060_r8*rxt(k,500)*y(k,6) + .080_r8*rxt(k,445)*y(k,100) & + + .100_r8*rxt(k,398)*y(k,111) + .060_r8*rxt(k,503)*y(k,116) & + + .280_r8*rxt(k,412)*y(k,118) + mat(k,1166) = .650_r8*rxt(k,521)*y(k,265) + mat(k,1472) = mat(k,1472) + .530_r8*rxt(k,392)*y(k,251) + mat(k,2345) = mat(k,2345) + .260_r8*rxt(k,393)*y(k,251) + rxt(k,402)*y(k,253) & + + .300_r8*rxt(k,381)*y(k,269) + mat(k,2200) = mat(k,2200) + .450_r8*rxt(k,403)*y(k,253) + .200_r8*rxt(k,407) & + *y(k,255) + .150_r8*rxt(k,382)*y(k,269) + mat(k,1402) = mat(k,1402) + .530_r8*rxt(k,396)*y(k,131) + .530_r8*rxt(k,395) & + *y(k,133) + .530_r8*rxt(k,392)*y(k,240) + .260_r8*rxt(k,393) & + *y(k,241) + mat(k,1442) = rxt(k,405)*y(k,131) + rxt(k,406)*y(k,133) + rxt(k,402)*y(k,241) & + + .450_r8*rxt(k,403)*y(k,247) + 4.000_r8*rxt(k,404)*y(k,253) + mat(k,723) = rxt(k,408)*y(k,131) + .200_r8*rxt(k,407)*y(k,247) + mat(k,1994) = rxt(k,348)*y(k,47) + rxt(k,374)*y(k,51) + .500_r8*rxt(k,355) & + *y(k,53) + .650_r8*rxt(k,521)*y(k,221) + mat(k,1263) = rxt(k,383)*y(k,131) + .300_r8*rxt(k,381)*y(k,241) & + + .150_r8*rxt(k,382)*y(k,247) + end do + end subroutine nlnmat08 + subroutine nlnmat09( 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,2360) = -(rxt(k,241)*y(k,61) + (4._r8*rxt(k,318) + 4._r8*rxt(k,319) & + ) * y(k,241) + rxt(k,320)*y(k,247) + rxt(k,321)*y(k,131) & + + rxt(k,340)*y(k,237) + rxt(k,351)*y(k,240) + rxt(k,368) & + *y(k,238) + rxt(k,381)*y(k,269) + rxt(k,393)*y(k,251) + rxt(k,402) & + *y(k,253) + rxt(k,426)*y(k,249) + rxt(k,431)*y(k,250) + rxt(k,440) & + *y(k,103) + rxt(k,451)*y(k,273) + rxt(k,505)*y(k,260) + rxt(k,510) & + *y(k,270) + rxt(k,515)*y(k,271)) + mat(k,1646) = -rxt(k,241)*y(k,241) + mat(k,2218) = -rxt(k,320)*y(k,241) + mat(k,1797) = -rxt(k,321)*y(k,241) + mat(k,957) = -rxt(k,340)*y(k,241) + mat(k,1482) = -rxt(k,351)*y(k,241) + mat(k,987) = -rxt(k,368)*y(k,241) + mat(k,1268) = -rxt(k,381)*y(k,241) + mat(k,1410) = -rxt(k,393)*y(k,241) + mat(k,1450) = -rxt(k,402)*y(k,241) + mat(k,1355) = -rxt(k,426)*y(k,241) + mat(k,1388) = -rxt(k,431)*y(k,241) + mat(k,1309) = -rxt(k,440)*y(k,241) + mat(k,1286) = -rxt(k,451)*y(k,241) + mat(k,1160) = -rxt(k,505)*y(k,241) + mat(k,1231) = -rxt(k,510)*y(k,241) + mat(k,1114) = -rxt(k,515)*y(k,241) + mat(k,1191) = .280_r8*rxt(k,367)*y(k,143) + mat(k,752) = rxt(k,354)*y(k,265) + mat(k,458) = .700_r8*rxt(k,323)*y(k,265) + mat(k,2098) = rxt(k,235)*y(k,58) + rxt(k,291)*y(k,75) + rxt(k,330)*y(k,261) & + + rxt(k,324)*y(k,265) + mat(k,2264) = rxt(k,235)*y(k,56) + mat(k,976) = rxt(k,291)*y(k,56) + mat(k,933) = .050_r8*rxt(k,445)*y(k,143) + mat(k,1309) = mat(k,1309) + rxt(k,439)*y(k,240) + mat(k,1797) = mat(k,1797) + rxt(k,353)*y(k,240) + .830_r8*rxt(k,471)*y(k,242) & + + .170_r8*rxt(k,477)*y(k,254) + mat(k,2424) = .280_r8*rxt(k,367)*y(k,31) + .050_r8*rxt(k,445)*y(k,100) + mat(k,1482) = mat(k,1482) + rxt(k,439)*y(k,103) + rxt(k,353)*y(k,131) & + + 4.000_r8*rxt(k,350)*y(k,240) + .900_r8*rxt(k,351)*y(k,241) & + + .450_r8*rxt(k,352)*y(k,247) + rxt(k,425)*y(k,249) + rxt(k,430) & + *y(k,250) + rxt(k,392)*y(k,251) + rxt(k,401)*y(k,253) & + + rxt(k,450)*y(k,273) + mat(k,2360) = mat(k,2360) + .900_r8*rxt(k,351)*y(k,240) + mat(k,829) = .830_r8*rxt(k,471)*y(k,131) + .330_r8*rxt(k,470)*y(k,247) + mat(k,2218) = mat(k,2218) + .450_r8*rxt(k,352)*y(k,240) + .330_r8*rxt(k,470) & + *y(k,242) + .070_r8*rxt(k,476)*y(k,254) + mat(k,1355) = mat(k,1355) + rxt(k,425)*y(k,240) + mat(k,1388) = mat(k,1388) + rxt(k,430)*y(k,240) + mat(k,1410) = mat(k,1410) + rxt(k,392)*y(k,240) + mat(k,1450) = mat(k,1450) + rxt(k,401)*y(k,240) + mat(k,967) = .170_r8*rxt(k,477)*y(k,131) + .070_r8*rxt(k,476)*y(k,247) + mat(k,1840) = rxt(k,330)*y(k,56) + mat(k,2013) = rxt(k,354)*y(k,52) + .700_r8*rxt(k,323)*y(k,55) + rxt(k,324) & + *y(k,56) + mat(k,1286) = mat(k,1286) + rxt(k,450)*y(k,240) + mat(k,822) = -(rxt(k,470)*y(k,247) + rxt(k,471)*y(k,131) + rxt(k,472) & + *y(k,132)) + mat(k,2167) = -rxt(k,470)*y(k,242) + mat(k,1745) = -rxt(k,471)*y(k,242) + mat(k,1662) = -rxt(k,472)*y(k,242) + mat(k,909) = -(rxt(k,603)*y(k,258) + rxt(k,604)*y(k,264) + rxt(k,605) & + *y(k,257)) + mat(k,890) = -rxt(k,603)*y(k,243) + mat(k,898) = -rxt(k,604)*y(k,243) + mat(k,743) = -rxt(k,605)*y(k,243) + mat(k,612) = -((rxt(k,389) + rxt(k,390)) * y(k,131)) + mat(k,1735) = -(rxt(k,389) + rxt(k,390)) * y(k,244) + mat(k,410) = rxt(k,388)*y(k,265) + mat(k,1929) = rxt(k,388)*y(k,18) + mat(k,509) = -(rxt(k,359)*y(k,142)) + mat(k,1570) = -rxt(k,359)*y(k,245) + mat(k,1728) = .750_r8*rxt(k,357)*y(k,246) + mat(k,831) = .750_r8*rxt(k,357)*y(k,131) + mat(k,832) = -(rxt(k,356)*y(k,247) + rxt(k,357)*y(k,131)) + mat(k,2168) = -rxt(k,356)*y(k,246) + mat(k,1746) = -rxt(k,357)*y(k,246) + mat(k,621) = rxt(k,363)*y(k,265) + mat(k,1952) = rxt(k,363)*y(k,27) + mat(k,2214) = -((rxt(k,192) + rxt(k,193) + rxt(k,194)) * y(k,78) + rxt(k,196) & + *y(k,141) + rxt(k,197)*y(k,143) + rxt(k,201)*y(k,265) & + + 4._r8*rxt(k,206)*y(k,247) + rxt(k,218)*y(k,133) + rxt(k,223) & + *y(k,131) + rxt(k,228)*y(k,132) + (rxt(k,238) + rxt(k,239) & + ) * y(k,58) + rxt(k,245)*y(k,61) + rxt(k,271)*y(k,19) + rxt(k,277) & + *y(k,21) + rxt(k,314)*y(k,44) + rxt(k,320)*y(k,241) + rxt(k,327) & + *y(k,248) + rxt(k,341)*y(k,237) + rxt(k,352)*y(k,240) + rxt(k,356) & + *y(k,246) + rxt(k,369)*y(k,238) + rxt(k,378)*y(k,268) + rxt(k,382) & + *y(k,269) + rxt(k,394)*y(k,251) + rxt(k,403)*y(k,253) + rxt(k,407) & + *y(k,255) + rxt(k,417)*y(k,234) + rxt(k,427)*y(k,249) + rxt(k,432) & + *y(k,250) + rxt(k,441)*y(k,103) + rxt(k,452)*y(k,273) + rxt(k,456) & + *y(k,233) + rxt(k,459)*y(k,235) + rxt(k,463)*y(k,236) + rxt(k,466) & + *y(k,239) + rxt(k,470)*y(k,242) + rxt(k,473)*y(k,252) + rxt(k,476) & + *y(k,254) + rxt(k,479)*y(k,267) + rxt(k,486)*y(k,272) + rxt(k,492) & + *y(k,274) + rxt(k,495)*y(k,275) + rxt(k,506)*y(k,260) + rxt(k,511) & + *y(k,270) + rxt(k,516)*y(k,271)) + mat(k,2281) = -(rxt(k,192) + rxt(k,193) + rxt(k,194)) * y(k,247) + mat(k,2463) = -rxt(k,196)*y(k,247) + mat(k,2420) = -rxt(k,197)*y(k,247) + mat(k,2009) = -rxt(k,201)*y(k,247) + mat(k,2069) = -rxt(k,218)*y(k,247) + mat(k,1793) = -rxt(k,223)*y(k,247) + mat(k,1687) = -rxt(k,228)*y(k,247) + mat(k,2260) = -(rxt(k,238) + rxt(k,239)) * y(k,247) + mat(k,1642) = -rxt(k,245)*y(k,247) + mat(k,1562) = -rxt(k,271)*y(k,247) + mat(k,1616) = -rxt(k,277)*y(k,247) + mat(k,2489) = -rxt(k,314)*y(k,247) + mat(k,2356) = -rxt(k,320)*y(k,247) + mat(k,491) = -rxt(k,327)*y(k,247) + mat(k,956) = -rxt(k,341)*y(k,247) + mat(k,1480) = -rxt(k,352)*y(k,247) + mat(k,838) = -rxt(k,356)*y(k,247) + mat(k,986) = -rxt(k,369)*y(k,247) + mat(k,869) = -rxt(k,378)*y(k,247) + mat(k,1267) = -rxt(k,382)*y(k,247) + mat(k,1408) = -rxt(k,394)*y(k,247) + mat(k,1448) = -rxt(k,403)*y(k,247) + mat(k,727) = -rxt(k,407)*y(k,247) + mat(k,1094) = -rxt(k,417)*y(k,247) + mat(k,1353) = -rxt(k,427)*y(k,247) + mat(k,1386) = -rxt(k,432)*y(k,247) + mat(k,1307) = -rxt(k,441)*y(k,247) + mat(k,1285) = -rxt(k,452)*y(k,247) + mat(k,574) = -rxt(k,456)*y(k,247) + mat(k,547) = -rxt(k,459)*y(k,247) + mat(k,486) = -rxt(k,463)*y(k,247) + mat(k,696) = -rxt(k,466)*y(k,247) + mat(k,828) = -rxt(k,470)*y(k,247) + mat(k,789) = -rxt(k,473)*y(k,247) + mat(k,966) = -rxt(k,476)*y(k,247) + mat(k,505) = -rxt(k,479)*y(k,247) + mat(k,804) = -rxt(k,486)*y(k,247) + mat(k,821) = -rxt(k,492)*y(k,247) + mat(k,562) = -rxt(k,495)*y(k,247) + mat(k,1158) = -rxt(k,506)*y(k,247) + mat(k,1229) = -rxt(k,511)*y(k,247) + mat(k,1112) = -rxt(k,516)*y(k,247) + mat(k,1077) = .570_r8*rxt(k,500)*y(k,143) + mat(k,213) = .650_r8*rxt(k,458)*y(k,265) + mat(k,1562) = mat(k,1562) + rxt(k,270)*y(k,44) + mat(k,1616) = mat(k,1616) + rxt(k,282)*y(k,265) + mat(k,330) = .350_r8*rxt(k,336)*y(k,265) + mat(k,625) = .130_r8*rxt(k,338)*y(k,143) + mat(k,314) = rxt(k,343)*y(k,265) + mat(k,1190) = .280_r8*rxt(k,367)*y(k,143) + mat(k,2489) = mat(k,2489) + rxt(k,270)*y(k,19) + rxt(k,234)*y(k,58) & + + rxt(k,315)*y(k,133) + rxt(k,316)*y(k,141) + mat(k,633) = rxt(k,299)*y(k,58) + rxt(k,300)*y(k,265) + mat(k,405) = rxt(k,302)*y(k,58) + rxt(k,303)*y(k,265) + mat(k,149) = rxt(k,349)*y(k,265) + mat(k,859) = rxt(k,322)*y(k,265) + mat(k,2094) = rxt(k,331)*y(k,261) + mat(k,2260) = mat(k,2260) + rxt(k,234)*y(k,44) + rxt(k,299)*y(k,45) & + + rxt(k,302)*y(k,48) + rxt(k,237)*y(k,81) + mat(k,1642) = mat(k,1642) + rxt(k,241)*y(k,241) + rxt(k,252)*y(k,265) + mat(k,1207) = rxt(k,334)*y(k,265) + mat(k,240) = .730_r8*rxt(k,469)*y(k,265) + mat(k,353) = .500_r8*rxt(k,537)*y(k,265) + mat(k,1213) = rxt(k,360)*y(k,265) + mat(k,1102) = rxt(k,361)*y(k,265) + mat(k,2281) = mat(k,2281) + rxt(k,195)*y(k,142) + mat(k,647) = rxt(k,237)*y(k,58) + rxt(k,191)*y(k,141) + rxt(k,200)*y(k,265) + mat(k,251) = rxt(k,325)*y(k,265) + mat(k,945) = rxt(k,326)*y(k,265) + mat(k,1247) = rxt(k,391)*y(k,265) + mat(k,1256) = rxt(k,376)*y(k,265) + mat(k,932) = .370_r8*rxt(k,445)*y(k,143) + mat(k,657) = .300_r8*rxt(k,436)*y(k,265) + mat(k,602) = rxt(k,437)*y(k,265) + mat(k,1307) = mat(k,1307) + rxt(k,442)*y(k,131) + rxt(k,443)*y(k,133) & + + rxt(k,439)*y(k,240) + 1.200_r8*rxt(k,440)*y(k,241) + mat(k,448) = rxt(k,444)*y(k,265) + mat(k,1320) = .140_r8*rxt(k,398)*y(k,143) + mat(k,397) = .200_r8*rxt(k,400)*y(k,265) + mat(k,678) = .500_r8*rxt(k,411)*y(k,265) + mat(k,1021) = .570_r8*rxt(k,503)*y(k,143) + mat(k,1430) = .280_r8*rxt(k,412)*y(k,143) + mat(k,497) = rxt(k,448)*y(k,265) + mat(k,1142) = rxt(k,449)*y(k,265) + mat(k,1793) = mat(k,1793) + rxt(k,442)*y(k,103) + rxt(k,418)*y(k,234) & + + rxt(k,460)*y(k,235) + rxt(k,465)*y(k,236) + rxt(k,342) & + *y(k,237) + rxt(k,370)*y(k,238) + rxt(k,321)*y(k,241) & + + .170_r8*rxt(k,471)*y(k,242) + rxt(k,389)*y(k,244) & + + .250_r8*rxt(k,357)*y(k,246) + rxt(k,329)*y(k,248) & + + .920_r8*rxt(k,428)*y(k,249) + .920_r8*rxt(k,434)*y(k,250) & + + .470_r8*rxt(k,396)*y(k,251) + .400_r8*rxt(k,474)*y(k,252) & + + .830_r8*rxt(k,477)*y(k,254) + rxt(k,480)*y(k,267) + rxt(k,379) & + *y(k,268) + .900_r8*rxt(k,512)*y(k,270) + .800_r8*rxt(k,517) & + *y(k,271) + rxt(k,487)*y(k,272) + rxt(k,453)*y(k,273) & + + rxt(k,493)*y(k,274) + rxt(k,496)*y(k,275) + mat(k,2069) = mat(k,2069) + rxt(k,315)*y(k,44) + rxt(k,443)*y(k,103) & + + rxt(k,429)*y(k,249) + rxt(k,435)*y(k,250) + .470_r8*rxt(k,395) & + *y(k,251) + rxt(k,221)*y(k,265) + rxt(k,454)*y(k,273) + mat(k,2463) = mat(k,2463) + rxt(k,316)*y(k,44) + rxt(k,191)*y(k,81) + mat(k,1593) = rxt(k,195)*y(k,78) + rxt(k,359)*y(k,245) + mat(k,2420) = mat(k,2420) + .570_r8*rxt(k,500)*y(k,6) + .130_r8*rxt(k,338) & + *y(k,27) + .280_r8*rxt(k,367)*y(k,31) + .370_r8*rxt(k,445) & + *y(k,100) + .140_r8*rxt(k,398)*y(k,111) + .570_r8*rxt(k,503) & + *y(k,116) + .280_r8*rxt(k,412)*y(k,118) + rxt(k,203)*y(k,265) + mat(k,222) = .800_r8*rxt(k,481)*y(k,265) + mat(k,994) = rxt(k,527)*y(k,265) + mat(k,1169) = .200_r8*rxt(k,521)*y(k,265) + mat(k,235) = .280_r8*rxt(k,489)*y(k,265) + mat(k,261) = .380_r8*rxt(k,491)*y(k,265) + mat(k,266) = .630_r8*rxt(k,497)*y(k,265) + mat(k,1094) = mat(k,1094) + rxt(k,418)*y(k,131) + mat(k,547) = mat(k,547) + rxt(k,460)*y(k,131) + mat(k,486) = mat(k,486) + rxt(k,465)*y(k,131) + mat(k,956) = mat(k,956) + rxt(k,342)*y(k,131) + 2.400_r8*rxt(k,339)*y(k,237) & + + rxt(k,340)*y(k,241) + mat(k,986) = mat(k,986) + rxt(k,370)*y(k,131) + rxt(k,368)*y(k,241) + mat(k,1480) = mat(k,1480) + rxt(k,439)*y(k,103) + .900_r8*rxt(k,351)*y(k,241) & + + rxt(k,425)*y(k,249) + rxt(k,430)*y(k,250) + .470_r8*rxt(k,392) & + *y(k,251) + rxt(k,450)*y(k,273) + mat(k,2356) = mat(k,2356) + rxt(k,241)*y(k,61) + 1.200_r8*rxt(k,440)*y(k,103) & + + rxt(k,321)*y(k,131) + rxt(k,340)*y(k,237) + rxt(k,368) & + *y(k,238) + .900_r8*rxt(k,351)*y(k,240) + 4.000_r8*rxt(k,318) & + *y(k,241) + rxt(k,426)*y(k,249) + rxt(k,431)*y(k,250) & + + .730_r8*rxt(k,393)*y(k,251) + rxt(k,402)*y(k,253) & + + .500_r8*rxt(k,505)*y(k,260) + .300_r8*rxt(k,381)*y(k,269) & + + rxt(k,510)*y(k,270) + rxt(k,515)*y(k,271) + .800_r8*rxt(k,451) & + *y(k,273) + mat(k,828) = mat(k,828) + .170_r8*rxt(k,471)*y(k,131) + .070_r8*rxt(k,470) & + *y(k,247) + mat(k,618) = rxt(k,389)*y(k,131) + mat(k,512) = rxt(k,359)*y(k,142) + mat(k,838) = mat(k,838) + .250_r8*rxt(k,357)*y(k,131) + mat(k,2214) = mat(k,2214) + .070_r8*rxt(k,470)*y(k,242) + .160_r8*rxt(k,473) & + *y(k,252) + .330_r8*rxt(k,476)*y(k,254) + mat(k,491) = mat(k,491) + rxt(k,329)*y(k,131) + mat(k,1353) = mat(k,1353) + .920_r8*rxt(k,428)*y(k,131) + rxt(k,429)*y(k,133) & + + rxt(k,425)*y(k,240) + rxt(k,426)*y(k,241) + mat(k,1386) = mat(k,1386) + .920_r8*rxt(k,434)*y(k,131) + rxt(k,435)*y(k,133) & + + rxt(k,430)*y(k,240) + rxt(k,431)*y(k,241) + mat(k,1408) = mat(k,1408) + .470_r8*rxt(k,396)*y(k,131) + .470_r8*rxt(k,395) & + *y(k,133) + .470_r8*rxt(k,392)*y(k,240) + .730_r8*rxt(k,393) & + *y(k,241) + mat(k,789) = mat(k,789) + .400_r8*rxt(k,474)*y(k,131) + .160_r8*rxt(k,473) & + *y(k,247) + mat(k,1448) = mat(k,1448) + rxt(k,402)*y(k,241) + mat(k,966) = mat(k,966) + .830_r8*rxt(k,477)*y(k,131) + .330_r8*rxt(k,476) & + *y(k,247) + mat(k,1158) = mat(k,1158) + .500_r8*rxt(k,505)*y(k,241) + mat(k,1836) = rxt(k,331)*y(k,56) + mat(k,2009) = mat(k,2009) + .650_r8*rxt(k,458)*y(k,8) + rxt(k,282)*y(k,21) & + + .350_r8*rxt(k,336)*y(k,26) + rxt(k,343)*y(k,28) + rxt(k,300) & + *y(k,45) + rxt(k,303)*y(k,48) + rxt(k,349)*y(k,49) + rxt(k,322) & + *y(k,54) + rxt(k,252)*y(k,61) + rxt(k,334)*y(k,64) & + + .730_r8*rxt(k,469)*y(k,68) + .500_r8*rxt(k,537)*y(k,69) & + + rxt(k,360)*y(k,76) + rxt(k,361)*y(k,77) + rxt(k,200)*y(k,81) & + + rxt(k,325)*y(k,88) + rxt(k,326)*y(k,89) + rxt(k,391)*y(k,95) & + + rxt(k,376)*y(k,97) + .300_r8*rxt(k,436)*y(k,101) + rxt(k,437) & + *y(k,102) + rxt(k,444)*y(k,104) + .200_r8*rxt(k,400)*y(k,112) & + + .500_r8*rxt(k,411)*y(k,115) + rxt(k,448)*y(k,122) + rxt(k,449) & + *y(k,123) + rxt(k,221)*y(k,133) + rxt(k,203)*y(k,143) & + + .800_r8*rxt(k,481)*y(k,151) + rxt(k,527)*y(k,162) & + + .200_r8*rxt(k,521)*y(k,221) + .280_r8*rxt(k,489)*y(k,223) & + + .380_r8*rxt(k,491)*y(k,226) + .630_r8*rxt(k,497)*y(k,229) + mat(k,505) = mat(k,505) + rxt(k,480)*y(k,131) + mat(k,869) = mat(k,869) + rxt(k,379)*y(k,131) + mat(k,1267) = mat(k,1267) + .300_r8*rxt(k,381)*y(k,241) + mat(k,1229) = mat(k,1229) + .900_r8*rxt(k,512)*y(k,131) + rxt(k,510)*y(k,241) + mat(k,1112) = mat(k,1112) + .800_r8*rxt(k,517)*y(k,131) + rxt(k,515)*y(k,241) + mat(k,804) = mat(k,804) + rxt(k,487)*y(k,131) + mat(k,1285) = mat(k,1285) + rxt(k,453)*y(k,131) + rxt(k,454)*y(k,133) & + + rxt(k,450)*y(k,240) + .800_r8*rxt(k,451)*y(k,241) + mat(k,821) = mat(k,821) + rxt(k,493)*y(k,131) + mat(k,562) = mat(k,562) + rxt(k,496)*y(k,131) + end do + end subroutine nlnmat09 + subroutine nlnmat10( 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,487) = -(rxt(k,327)*y(k,247) + rxt(k,329)*y(k,131)) + mat(k,2142) = -rxt(k,327)*y(k,248) + mat(k,1725) = -rxt(k,329)*y(k,248) + mat(k,2472) = rxt(k,314)*y(k,247) + mat(k,2142) = mat(k,2142) + rxt(k,314)*y(k,44) + mat(k,1343) = -(rxt(k,425)*y(k,240) + rxt(k,426)*y(k,241) + rxt(k,427) & + *y(k,247) + rxt(k,428)*y(k,131) + rxt(k,429)*y(k,133)) + mat(k,1467) = -rxt(k,425)*y(k,249) + mat(k,2340) = -rxt(k,426)*y(k,249) + mat(k,2195) = -rxt(k,427)*y(k,249) + mat(k,1776) = -rxt(k,428)*y(k,249) + mat(k,2051) = -rxt(k,429)*y(k,249) + mat(k,926) = .600_r8*rxt(k,446)*y(k,265) + mat(k,1989) = .600_r8*rxt(k,446)*y(k,100) + mat(k,1376) = -(rxt(k,430)*y(k,240) + rxt(k,431)*y(k,241) + rxt(k,432) & + *y(k,247) + rxt(k,434)*y(k,131) + rxt(k,435)*y(k,133)) + mat(k,1468) = -rxt(k,430)*y(k,250) + mat(k,2341) = -rxt(k,431)*y(k,250) + mat(k,2196) = -rxt(k,432)*y(k,250) + mat(k,1777) = -rxt(k,434)*y(k,250) + mat(k,2052) = -rxt(k,435)*y(k,250) + mat(k,927) = .400_r8*rxt(k,446)*y(k,265) + mat(k,1990) = .400_r8*rxt(k,446)*y(k,100) + mat(k,1400) = -(rxt(k,392)*y(k,240) + rxt(k,393)*y(k,241) + rxt(k,394) & + *y(k,247) + rxt(k,395)*y(k,133) + (rxt(k,396) + rxt(k,397) & + ) * y(k,131)) + mat(k,1469) = -rxt(k,392)*y(k,251) + mat(k,2342) = -rxt(k,393)*y(k,251) + mat(k,2197) = -rxt(k,394)*y(k,251) + mat(k,2053) = -rxt(k,395)*y(k,251) + mat(k,1778) = -(rxt(k,396) + rxt(k,397)) * y(k,251) + mat(k,1315) = .500_r8*rxt(k,399)*y(k,265) + mat(k,394) = .200_r8*rxt(k,400)*y(k,265) + mat(k,1419) = rxt(k,413)*y(k,265) + mat(k,1991) = .500_r8*rxt(k,399)*y(k,111) + .200_r8*rxt(k,400)*y(k,112) & + + rxt(k,413)*y(k,118) + mat(k,784) = -(rxt(k,473)*y(k,247) + rxt(k,474)*y(k,131) + rxt(k,475) & + *y(k,132)) + mat(k,2164) = -rxt(k,473)*y(k,252) + mat(k,1742) = -rxt(k,474)*y(k,252) + mat(k,1661) = -rxt(k,475)*y(k,252) + mat(k,1441) = -(rxt(k,401)*y(k,240) + rxt(k,402)*y(k,241) + rxt(k,403) & + *y(k,247) + 4._r8*rxt(k,404)*y(k,253) + rxt(k,405)*y(k,131) & + + rxt(k,406)*y(k,133) + rxt(k,414)*y(k,132)) + mat(k,1471) = -rxt(k,401)*y(k,253) + mat(k,2344) = -rxt(k,402)*y(k,253) + mat(k,2199) = -rxt(k,403)*y(k,253) + mat(k,1780) = -rxt(k,405)*y(k,253) + mat(k,2055) = -rxt(k,406)*y(k,253) + mat(k,1672) = -rxt(k,414)*y(k,253) + mat(k,1316) = .500_r8*rxt(k,399)*y(k,265) + mat(k,395) = .500_r8*rxt(k,400)*y(k,265) + mat(k,1993) = .500_r8*rxt(k,399)*y(k,111) + .500_r8*rxt(k,400)*y(k,112) + mat(k,959) = -(rxt(k,476)*y(k,247) + rxt(k,477)*y(k,131) + rxt(k,478) & + *y(k,132)) + mat(k,2176) = -rxt(k,476)*y(k,254) + mat(k,1754) = -rxt(k,477)*y(k,254) + mat(k,1664) = -rxt(k,478)*y(k,254) + mat(k,721) = -(rxt(k,407)*y(k,247) + rxt(k,408)*y(k,131)) + mat(k,2159) = -rxt(k,407)*y(k,255) + mat(k,1741) = -rxt(k,408)*y(k,255) + mat(k,564) = rxt(k,409)*y(k,265) + mat(k,389) = rxt(k,410)*y(k,265) + mat(k,1942) = rxt(k,409)*y(k,113) + rxt(k,410)*y(k,114) + mat(k,575) = -(rxt(k,208)*y(k,141) + rxt(k,209)*y(k,142)) + mat(k,2433) = -rxt(k,208)*y(k,256) + mat(k,1572) = -rxt(k,209)*y(k,256) + mat(k,2433) = mat(k,2433) + rxt(k,607)*y(k,257) + mat(k,904) = .900_r8*rxt(k,605)*y(k,257) + .800_r8*rxt(k,603)*y(k,258) + mat(k,738) = rxt(k,607)*y(k,141) + .900_r8*rxt(k,605)*y(k,243) + mat(k,888) = .800_r8*rxt(k,603)*y(k,243) + mat(k,739) = -(rxt(k,605)*y(k,243) + rxt(k,606)*y(k,142) + (rxt(k,607) & + + rxt(k,608)) * y(k,141)) + mat(k,905) = -rxt(k,605)*y(k,257) + mat(k,1573) = -rxt(k,606)*y(k,257) + mat(k,2436) = -(rxt(k,607) + rxt(k,608)) * y(k,257) + mat(k,889) = -(rxt(k,603)*y(k,243)) + mat(k,907) = -rxt(k,603)*y(k,258) + mat(k,1040) = rxt(k,612)*y(k,264) + mat(k,1748) = rxt(k,614)*y(k,264) + mat(k,2442) = rxt(k,607)*y(k,257) + mat(k,1576) = rxt(k,611)*y(k,259) + mat(k,741) = rxt(k,607)*y(k,141) + mat(k,550) = rxt(k,611)*y(k,142) + mat(k,896) = rxt(k,612)*y(k,119) + rxt(k,614)*y(k,131) + mat(k,548) = -(rxt(k,609)*y(k,141) + (rxt(k,610) + rxt(k,611)) * y(k,142)) + mat(k,2432) = -rxt(k,609)*y(k,259) + mat(k,1571) = -(rxt(k,610) + rxt(k,611)) * y(k,259) + mat(k,1150) = -(rxt(k,505)*y(k,241) + rxt(k,506)*y(k,247) + rxt(k,507) & + *y(k,131) + rxt(k,508)*y(k,133)) + mat(k,2328) = -rxt(k,505)*y(k,260) + mat(k,2183) = -rxt(k,506)*y(k,260) + mat(k,1763) = -rxt(k,507)*y(k,260) + mat(k,2037) = -rxt(k,508)*y(k,260) + mat(k,1068) = rxt(k,499)*y(k,133) + mat(k,1012) = rxt(k,502)*y(k,133) + mat(k,2037) = mat(k,2037) + rxt(k,499)*y(k,6) + rxt(k,502)*y(k,116) & + + .500_r8*rxt(k,519)*y(k,220) + mat(k,433) = rxt(k,509)*y(k,265) + mat(k,1117) = .500_r8*rxt(k,519)*y(k,133) + mat(k,1975) = rxt(k,509)*y(k,135) + mat(k,1832) = -(rxt(k,173)*y(k,79) + rxt(k,174)*y(k,276) + (rxt(k,176) & + + rxt(k,177)) * y(k,142) + rxt(k,178)*y(k,143) + (rxt(k,226) & + + rxt(k,227)) * y(k,120) + rxt(k,259)*y(k,35) + rxt(k,260) & + *y(k,36) + rxt(k,261)*y(k,38) + rxt(k,262)*y(k,39) + rxt(k,263) & + *y(k,40) + rxt(k,264)*y(k,41) + rxt(k,265)*y(k,42) + (rxt(k,266) & + + rxt(k,267)) * y(k,87) + rxt(k,286)*y(k,37) + rxt(k,287) & + *y(k,57) + rxt(k,288)*y(k,80) + (rxt(k,289) + rxt(k,290) & + ) * y(k,83) + rxt(k,295)*y(k,66) + rxt(k,296)*y(k,67) + rxt(k,309) & + *y(k,43) + rxt(k,310)*y(k,45) + rxt(k,311)*y(k,84) + rxt(k,312) & + *y(k,85) + rxt(k,313)*y(k,86) + (rxt(k,330) + rxt(k,331) & + + rxt(k,332)) * y(k,56) + rxt(k,333)*y(k,88)) + mat(k,1507) = -rxt(k,173)*y(k,261) + mat(k,2512) = -rxt(k,174)*y(k,261) + mat(k,1591) = -(rxt(k,176) + rxt(k,177)) * y(k,261) + mat(k,2416) = -rxt(k,178)*y(k,261) + mat(k,305) = -(rxt(k,226) + rxt(k,227)) * y(k,261) + mat(k,145) = -rxt(k,259)*y(k,261) + mat(k,188) = -rxt(k,260)*y(k,261) + mat(k,155) = -rxt(k,261)*y(k,261) + mat(k,198) = -rxt(k,262)*y(k,261) + mat(k,159) = -rxt(k,263)*y(k,261) + mat(k,203) = -rxt(k,264)*y(k,261) + mat(k,163) = -rxt(k,265)*y(k,261) + mat(k,1544) = -(rxt(k,266) + rxt(k,267)) * y(k,261) + mat(k,194) = -rxt(k,286)*y(k,261) + mat(k,464) = -rxt(k,287)*y(k,261) + mat(k,172) = -rxt(k,288)*y(k,261) + mat(k,883) = -(rxt(k,289) + rxt(k,290)) * y(k,261) + mat(k,269) = -rxt(k,295)*y(k,261) + mat(k,294) = -rxt(k,296)*y(k,261) + mat(k,517) = -rxt(k,309)*y(k,261) + mat(k,631) = -rxt(k,310)*y(k,261) + mat(k,289) = -rxt(k,311)*y(k,261) + mat(k,299) = -rxt(k,312)*y(k,261) + mat(k,358) = -rxt(k,313)*y(k,261) + mat(k,2090) = -(rxt(k,330) + rxt(k,331) + rxt(k,332)) * y(k,261) + mat(k,249) = -rxt(k,333)*y(k,261) + mat(k,1591) = mat(k,1591) + rxt(k,209)*y(k,256) + mat(k,915) = .850_r8*rxt(k,604)*y(k,264) + mat(k,579) = rxt(k,209)*y(k,142) + mat(k,902) = .850_r8*rxt(k,604)*y(k,243) + mat(k,223) = -(rxt(k,180)*y(k,141) + rxt(k,181)*y(k,142)) + mat(k,2429) = -rxt(k,180)*y(k,262) + mat(k,1568) = -rxt(k,181)*y(k,262) + mat(k,1486) = rxt(k,182)*y(k,263) + mat(k,2429) = mat(k,2429) + rxt(k,184)*y(k,263) + mat(k,1568) = mat(k,1568) + rxt(k,185)*y(k,263) + mat(k,2370) = rxt(k,186)*y(k,263) + mat(k,225) = rxt(k,182)*y(k,65) + rxt(k,184)*y(k,141) + rxt(k,185)*y(k,142) & + + rxt(k,186)*y(k,143) + mat(k,226) = -(rxt(k,182)*y(k,65) + rxt(k,184)*y(k,141) + rxt(k,185)*y(k,142) & + + rxt(k,186)*y(k,143)) + mat(k,1487) = -rxt(k,182)*y(k,263) + mat(k,2430) = -rxt(k,184)*y(k,263) + mat(k,1569) = -rxt(k,185)*y(k,263) + mat(k,2371) = -rxt(k,186)*y(k,263) + mat(k,1569) = mat(k,1569) + rxt(k,176)*y(k,261) + mat(k,1811) = rxt(k,176)*y(k,142) + mat(k,897) = -(rxt(k,604)*y(k,243) + rxt(k,612)*y(k,119) + rxt(k,614) & + *y(k,131)) + mat(k,908) = -rxt(k,604)*y(k,264) + mat(k,1041) = -rxt(k,612)*y(k,264) + mat(k,1749) = -rxt(k,614)*y(k,264) + mat(k,1490) = rxt(k,615)*y(k,266) + mat(k,1577) = rxt(k,606)*y(k,257) + rxt(k,610)*y(k,259) + rxt(k,617)*y(k,266) + mat(k,742) = rxt(k,606)*y(k,142) + mat(k,551) = rxt(k,610)*y(k,142) + mat(k,851) = rxt(k,615)*y(k,65) + rxt(k,617)*y(k,142) + mat(k,2006) = -(rxt(k,199)*y(k,79) + rxt(k,200)*y(k,81) + rxt(k,201)*y(k,247) & + + rxt(k,202)*y(k,141) + rxt(k,203)*y(k,143) + (4._r8*rxt(k,204) & + + 4._r8*rxt(k,205)) * y(k,265) + rxt(k,207)*y(k,92) + rxt(k,221) & + *y(k,133) + rxt(k,222)*y(k,119) + rxt(k,230)*y(k,132) + rxt(k,231) & + *y(k,91) + rxt(k,250)*y(k,62) + (rxt(k,252) + rxt(k,253) & + ) * y(k,61) + rxt(k,255)*y(k,87) + rxt(k,258)*y(k,94) + rxt(k,282) & + *y(k,21) + rxt(k,284)*y(k,83) + rxt(k,298)*y(k,43) + rxt(k,300) & + *y(k,45) + rxt(k,301)*y(k,46) + rxt(k,303)*y(k,48) + rxt(k,305) & + *y(k,57) + rxt(k,306)*y(k,84) + rxt(k,307)*y(k,85) + rxt(k,308) & + *y(k,86) + rxt(k,317)*y(k,44) + rxt(k,322)*y(k,54) + rxt(k,323) & + *y(k,55) + rxt(k,324)*y(k,56) + rxt(k,325)*y(k,88) + rxt(k,326) & + *y(k,89) + rxt(k,334)*y(k,64) + rxt(k,336)*y(k,26) + rxt(k,343) & + *y(k,28) + rxt(k,344)*y(k,29) + rxt(k,346)*y(k,30) + rxt(k,348) & + *y(k,47) + rxt(k,349)*y(k,49) + rxt(k,354)*y(k,52) + rxt(k,355) & + *y(k,53) + rxt(k,360)*y(k,76) + rxt(k,361)*y(k,77) + rxt(k,362) & + *y(k,148) + rxt(k,363)*y(k,27) + rxt(k,371)*y(k,32) + rxt(k,372) & + *y(k,33) + rxt(k,374)*y(k,51) + rxt(k,376)*y(k,97) + rxt(k,377) & + *y(k,134) + rxt(k,380)*y(k,157) + rxt(k,384)*y(k,158) + rxt(k,385) & + *y(k,31) + rxt(k,386)*y(k,50) + rxt(k,388)*y(k,18) + rxt(k,391) & + *y(k,95) + rxt(k,399)*y(k,111) + rxt(k,400)*y(k,112) + rxt(k,409) & + *y(k,113) + rxt(k,410)*y(k,114) + rxt(k,411)*y(k,115) + rxt(k,413) & + *y(k,118) + rxt(k,416)*y(k,1) + rxt(k,420)*y(k,2) + rxt(k,421) & + *y(k,17) + rxt(k,422)*y(k,96) + rxt(k,423)*y(k,98) + rxt(k,424) & + *y(k,99) + rxt(k,436)*y(k,101) + rxt(k,437)*y(k,102) + rxt(k,444) & + *y(k,104) + rxt(k,446)*y(k,100) + rxt(k,447)*y(k,106) + rxt(k,448) & + *y(k,122) + rxt(k,449)*y(k,123) + rxt(k,455)*y(k,225) + rxt(k,458) & + *y(k,8) + rxt(k,461)*y(k,10) + rxt(k,462)*y(k,24) + rxt(k,464) & + *y(k,25) + rxt(k,468)*y(k,34) + rxt(k,469)*y(k,68) + rxt(k,481) & + *y(k,151) + rxt(k,484)*y(k,152) + rxt(k,488)*y(k,222) + (rxt(k,489) & + + rxt(k,579)) * y(k,223) + rxt(k,491)*y(k,226) + rxt(k,494) & + *y(k,227) + rxt(k,497)*y(k,229) + rxt(k,498)*y(k,230) + rxt(k,501) & + *y(k,6) + rxt(k,504)*y(k,116) + rxt(k,509)*y(k,135) + rxt(k,513) & + *y(k,217) + rxt(k,514)*y(k,218) + rxt(k,518)*y(k,219) + rxt(k,520) & + *y(k,220) + rxt(k,521)*y(k,221) + (rxt(k,523) + rxt(k,537) & + ) * y(k,69) + rxt(k,525)*y(k,146) + rxt(k,527)*y(k,162) & + + rxt(k,531)*y(k,159) + rxt(k,536)*y(k,161) + rxt(k,539) & + *y(k,127)) + mat(k,1508) = -rxt(k,199)*y(k,265) + mat(k,646) = -rxt(k,200)*y(k,265) + mat(k,2211) = -rxt(k,201)*y(k,265) + mat(k,2460) = -rxt(k,202)*y(k,265) + mat(k,2417) = -rxt(k,203)*y(k,265) + mat(k,524) = -rxt(k,207)*y(k,265) + mat(k,2066) = -rxt(k,221)*y(k,265) + mat(k,1050) = -rxt(k,222)*y(k,265) + mat(k,1684) = -rxt(k,230)*y(k,265) + mat(k,2301) = -rxt(k,231)*y(k,265) + mat(k,1031) = -rxt(k,250)*y(k,265) + mat(k,1640) = -(rxt(k,252) + rxt(k,253)) * y(k,265) + mat(k,1545) = -rxt(k,255)*y(k,265) + mat(k,876) = -rxt(k,258)*y(k,265) + mat(k,1614) = -rxt(k,282)*y(k,265) + mat(k,884) = -rxt(k,284)*y(k,265) + mat(k,518) = -rxt(k,298)*y(k,265) + mat(k,632) = -rxt(k,300)*y(k,265) + mat(k,166) = -rxt(k,301)*y(k,265) + mat(k,404) = -rxt(k,303)*y(k,265) + mat(k,465) = -rxt(k,305)*y(k,265) + mat(k,290) = -rxt(k,306)*y(k,265) + mat(k,300) = -rxt(k,307)*y(k,265) + mat(k,359) = -rxt(k,308)*y(k,265) + mat(k,2486) = -rxt(k,317)*y(k,265) + mat(k,858) = -rxt(k,322)*y(k,265) + mat(k,456) = -rxt(k,323)*y(k,265) + mat(k,2091) = -rxt(k,324)*y(k,265) + mat(k,250) = -rxt(k,325)*y(k,265) + mat(k,944) = -rxt(k,326)*y(k,265) + mat(k,1206) = -rxt(k,334)*y(k,265) + mat(k,329) = -rxt(k,336)*y(k,265) + mat(k,313) = -rxt(k,343)*y(k,265) + mat(k,381) = -rxt(k,344)*y(k,265) + mat(k,337) = -rxt(k,346)*y(k,265) + mat(k,1198) = -rxt(k,348)*y(k,265) + mat(k,148) = -rxt(k,349)*y(k,265) + mat(k,751) = -rxt(k,354)*y(k,265) + mat(k,640) = -rxt(k,355)*y(k,265) + mat(k,1212) = -rxt(k,360)*y(k,265) + mat(k,1101) = -rxt(k,361)*y(k,265) + mat(k,584) = -rxt(k,362)*y(k,265) + mat(k,624) = -rxt(k,363)*y(k,265) + mat(k,440) = -rxt(k,371)*y(k,265) + mat(k,343) = -rxt(k,372)*y(k,265) + mat(k,1328) = -rxt(k,374)*y(k,265) + mat(k,1255) = -rxt(k,376)*y(k,265) + mat(k,940) = -rxt(k,377)*y(k,265) + mat(k,592) = -rxt(k,380)*y(k,265) + mat(k,428) = -rxt(k,384)*y(k,265) + mat(k,1187) = -rxt(k,385)*y(k,265) + mat(k,1127) = -rxt(k,386)*y(k,265) + mat(k,414) = -rxt(k,388)*y(k,265) + mat(k,1245) = -rxt(k,391)*y(k,265) + mat(k,1319) = -rxt(k,399)*y(k,265) + mat(k,396) = -rxt(k,400)*y(k,265) + mat(k,567) = -rxt(k,409)*y(k,265) + mat(k,392) = -rxt(k,410)*y(k,265) + mat(k,676) = -rxt(k,411)*y(k,265) + mat(k,1427) = -rxt(k,413)*y(k,265) + mat(k,706) = -rxt(k,416)*y(k,265) + mat(k,717) = -rxt(k,420)*y(k,265) + mat(k,272) = -rxt(k,421)*y(k,265) + mat(k,285) = -rxt(k,422)*y(k,265) + mat(k,400) = -rxt(k,423)*y(k,265) + mat(k,175) = -rxt(k,424)*y(k,265) + mat(k,656) = -rxt(k,436)*y(k,265) + mat(k,601) = -rxt(k,437)*y(k,265) + mat(k,447) = -rxt(k,444)*y(k,265) + mat(k,930) = -rxt(k,446)*y(k,265) + mat(k,759) = -rxt(k,447)*y(k,265) + mat(k,496) = -rxt(k,448)*y(k,265) + mat(k,1141) = -rxt(k,449)*y(k,265) + mat(k,247) = -rxt(k,455)*y(k,265) + mat(k,212) = -rxt(k,458)*y(k,265) + mat(k,453) = -rxt(k,461)*y(k,265) + mat(k,281) = -rxt(k,462)*y(k,265) + mat(k,376) = -rxt(k,464)*y(k,265) + mat(k,318) = -rxt(k,468)*y(k,265) + mat(k,239) = -rxt(k,469)*y(k,265) + mat(k,221) = -rxt(k,481)*y(k,265) + mat(k,370) = -rxt(k,484)*y(k,265) + mat(k,669) = -rxt(k,488)*y(k,265) + mat(k,234) = -(rxt(k,489) + rxt(k,579)) * y(k,265) + mat(k,260) = -rxt(k,491)*y(k,265) + mat(k,775) = -rxt(k,494)*y(k,265) + mat(k,265) = -rxt(k,497)*y(k,265) + mat(k,477) = -rxt(k,498)*y(k,265) + mat(k,1075) = -rxt(k,501)*y(k,265) + mat(k,1019) = -rxt(k,504)*y(k,265) + mat(k,435) = -rxt(k,509)*y(k,265) + mat(k,735) = -rxt(k,513)*y(k,265) + mat(k,687) = -rxt(k,514)*y(k,265) + mat(k,532) = -rxt(k,518)*y(k,265) + mat(k,1121) = -rxt(k,520)*y(k,265) + mat(k,1168) = -rxt(k,521)*y(k,265) + mat(k,351) = -(rxt(k,523) + rxt(k,537)) * y(k,265) + mat(k,422) = -rxt(k,525)*y(k,265) + mat(k,993) = -rxt(k,527)*y(k,265) + mat(k,780) = -rxt(k,531)*y(k,265) + mat(k,1527) = -rxt(k,536)*y(k,265) + mat(k,142) = -rxt(k,539)*y(k,265) + mat(k,1075) = mat(k,1075) + .630_r8*rxt(k,500)*y(k,143) + mat(k,329) = mat(k,329) + .650_r8*rxt(k,336)*y(k,265) + mat(k,624) = mat(k,624) + .130_r8*rxt(k,338)*y(k,143) + mat(k,381) = mat(k,381) + .500_r8*rxt(k,344)*y(k,265) + mat(k,1187) = mat(k,1187) + .360_r8*rxt(k,367)*y(k,143) + mat(k,2486) = mat(k,2486) + rxt(k,316)*y(k,141) + mat(k,456) = mat(k,456) + .300_r8*rxt(k,323)*y(k,265) + mat(k,2091) = mat(k,2091) + rxt(k,330)*y(k,261) + mat(k,2257) = rxt(k,239)*y(k,247) + mat(k,971) = rxt(k,293)*y(k,276) + mat(k,2278) = rxt(k,198)*y(k,143) + 2.000_r8*rxt(k,193)*y(k,247) + mat(k,1508) = mat(k,1508) + rxt(k,190)*y(k,141) + rxt(k,173)*y(k,261) + mat(k,646) = mat(k,646) + rxt(k,191)*y(k,141) + mat(k,884) = mat(k,884) + rxt(k,283)*y(k,141) + rxt(k,289)*y(k,261) + mat(k,1545) = mat(k,1545) + rxt(k,254)*y(k,141) + rxt(k,266)*y(k,261) + mat(k,250) = mat(k,250) + rxt(k,333)*y(k,261) + mat(k,845) = rxt(k,285)*y(k,141) + mat(k,876) = mat(k,876) + rxt(k,257)*y(k,141) + mat(k,930) = mat(k,930) + .320_r8*rxt(k,445)*y(k,143) + mat(k,759) = mat(k,759) + .600_r8*rxt(k,447)*y(k,265) + mat(k,1319) = mat(k,1319) + .240_r8*rxt(k,398)*y(k,143) + mat(k,396) = mat(k,396) + .100_r8*rxt(k,400)*y(k,265) + mat(k,1019) = mat(k,1019) + .630_r8*rxt(k,503)*y(k,143) + mat(k,1427) = mat(k,1427) + .360_r8*rxt(k,412)*y(k,143) + mat(k,1790) = rxt(k,223)*y(k,247) + mat(k,2066) = mat(k,2066) + rxt(k,218)*y(k,247) + mat(k,2460) = mat(k,2460) + rxt(k,316)*y(k,44) + rxt(k,190)*y(k,79) & + + rxt(k,191)*y(k,81) + rxt(k,283)*y(k,83) + rxt(k,254)*y(k,87) & + + rxt(k,285)*y(k,93) + rxt(k,257)*y(k,94) + rxt(k,196)*y(k,247) + mat(k,2417) = mat(k,2417) + .630_r8*rxt(k,500)*y(k,6) + .130_r8*rxt(k,338) & + *y(k,27) + .360_r8*rxt(k,367)*y(k,31) + rxt(k,198)*y(k,78) & + + .320_r8*rxt(k,445)*y(k,100) + .240_r8*rxt(k,398)*y(k,111) & + + .630_r8*rxt(k,503)*y(k,116) + .360_r8*rxt(k,412)*y(k,118) & + + rxt(k,197)*y(k,247) + mat(k,592) = mat(k,592) + .500_r8*rxt(k,380)*y(k,265) + mat(k,247) = mat(k,247) + .500_r8*rxt(k,455)*y(k,265) + mat(k,573) = .400_r8*rxt(k,456)*y(k,247) + mat(k,1477) = .450_r8*rxt(k,352)*y(k,247) + mat(k,827) = .400_r8*rxt(k,470)*y(k,247) + mat(k,2211) = mat(k,2211) + rxt(k,239)*y(k,58) + 2.000_r8*rxt(k,193)*y(k,78) & + + rxt(k,223)*y(k,131) + rxt(k,218)*y(k,133) + rxt(k,196) & + *y(k,141) + rxt(k,197)*y(k,143) + .400_r8*rxt(k,456)*y(k,233) & + + .450_r8*rxt(k,352)*y(k,240) + .400_r8*rxt(k,470)*y(k,242) & + + .450_r8*rxt(k,403)*y(k,253) + .400_r8*rxt(k,476)*y(k,254) & + + .200_r8*rxt(k,407)*y(k,255) + .150_r8*rxt(k,382)*y(k,269) + mat(k,1446) = .450_r8*rxt(k,403)*y(k,247) + mat(k,965) = .400_r8*rxt(k,476)*y(k,247) + mat(k,726) = .200_r8*rxt(k,407)*y(k,247) + mat(k,1833) = rxt(k,330)*y(k,56) + rxt(k,173)*y(k,79) + rxt(k,289)*y(k,83) & + + rxt(k,266)*y(k,87) + rxt(k,333)*y(k,88) + 2.000_r8*rxt(k,174) & + *y(k,276) + mat(k,2006) = mat(k,2006) + .650_r8*rxt(k,336)*y(k,26) + .500_r8*rxt(k,344) & + *y(k,29) + .300_r8*rxt(k,323)*y(k,55) + .600_r8*rxt(k,447) & + *y(k,106) + .100_r8*rxt(k,400)*y(k,112) + .500_r8*rxt(k,380) & + *y(k,157) + .500_r8*rxt(k,455)*y(k,225) + mat(k,1266) = .150_r8*rxt(k,382)*y(k,247) + mat(k,2513) = rxt(k,293)*y(k,75) + 2.000_r8*rxt(k,174)*y(k,261) + end do + end subroutine nlnmat10 + subroutine nlnmat11( 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,849) = -(rxt(k,615)*y(k,65) + rxt(k,617)*y(k,142)) + mat(k,1488) = -rxt(k,615)*y(k,266) + mat(k,1575) = -rxt(k,617)*y(k,266) + mat(k,2439) = rxt(k,608)*y(k,257) + rxt(k,609)*y(k,259) + mat(k,740) = rxt(k,608)*y(k,141) + mat(k,549) = rxt(k,609)*y(k,141) + mat(k,500) = -(rxt(k,479)*y(k,247) + rxt(k,480)*y(k,131)) + mat(k,2143) = -rxt(k,479)*y(k,267) + mat(k,1726) = -rxt(k,480)*y(k,267) + mat(k,237) = .200_r8*rxt(k,469)*y(k,265) + mat(k,219) = .140_r8*rxt(k,481)*y(k,265) + mat(k,368) = rxt(k,484)*y(k,265) + mat(k,1916) = .200_r8*rxt(k,469)*y(k,68) + .140_r8*rxt(k,481)*y(k,151) & + + rxt(k,484)*y(k,152) + mat(k,862) = -(rxt(k,378)*y(k,247) + rxt(k,379)*y(k,131)) + mat(k,2170) = -rxt(k,378)*y(k,268) + mat(k,1747) = -rxt(k,379)*y(k,268) + mat(k,1174) = rxt(k,385)*y(k,265) + mat(k,589) = .500_r8*rxt(k,380)*y(k,265) + mat(k,1954) = rxt(k,385)*y(k,31) + .500_r8*rxt(k,380)*y(k,157) + mat(k,1261) = -(rxt(k,381)*y(k,241) + rxt(k,382)*y(k,247) + rxt(k,383) & + *y(k,131)) + mat(k,2335) = -rxt(k,381)*y(k,269) + mat(k,2190) = -rxt(k,382)*y(k,269) + mat(k,1771) = -rxt(k,383)*y(k,269) + mat(k,1071) = .060_r8*rxt(k,500)*y(k,143) + mat(k,1125) = rxt(k,386)*y(k,265) + mat(k,1015) = .060_r8*rxt(k,503)*y(k,143) + mat(k,2398) = .060_r8*rxt(k,500)*y(k,6) + .060_r8*rxt(k,503)*y(k,116) + mat(k,426) = rxt(k,384)*y(k,265) + mat(k,1165) = .150_r8*rxt(k,521)*y(k,265) + mat(k,1984) = rxt(k,386)*y(k,50) + rxt(k,384)*y(k,158) + .150_r8*rxt(k,521) & + *y(k,221) + mat(k,1222) = -(rxt(k,510)*y(k,241) + rxt(k,511)*y(k,247) + rxt(k,512) & + *y(k,131)) + mat(k,2333) = -rxt(k,510)*y(k,270) + mat(k,2188) = -rxt(k,511)*y(k,270) + mat(k,1768) = -rxt(k,512)*y(k,270) + mat(k,2043) = .500_r8*rxt(k,519)*y(k,220) + mat(k,733) = rxt(k,513)*y(k,265) + mat(k,1120) = .500_r8*rxt(k,519)*y(k,133) + rxt(k,520)*y(k,265) + mat(k,1981) = rxt(k,513)*y(k,217) + rxt(k,520)*y(k,220) + mat(k,1106) = -(rxt(k,515)*y(k,241) + rxt(k,516)*y(k,247) + rxt(k,517) & + *y(k,131)) + mat(k,2324) = -rxt(k,515)*y(k,271) + mat(k,2180) = -rxt(k,516)*y(k,271) + mat(k,1759) = -rxt(k,517)*y(k,271) + mat(k,1065) = rxt(k,501)*y(k,265) + mat(k,1009) = rxt(k,504)*y(k,265) + mat(k,529) = rxt(k,518)*y(k,265) + mat(k,1971) = rxt(k,501)*y(k,6) + rxt(k,504)*y(k,116) + rxt(k,518)*y(k,219) + mat(k,795) = -(rxt(k,486)*y(k,247) + rxt(k,487)*y(k,131)) + mat(k,2165) = -rxt(k,486)*y(k,272) + mat(k,1743) = -rxt(k,487)*y(k,272) + mat(k,665) = rxt(k,488)*y(k,265) + mat(k,233) = (.650_r8*rxt(k,489)+rxt(k,579))*y(k,265) + mat(k,1949) = rxt(k,488)*y(k,222) + (.650_r8*rxt(k,489)+rxt(k,579))*y(k,223) + mat(k,1277) = -(rxt(k,450)*y(k,240) + rxt(k,451)*y(k,241) + rxt(k,452) & + *y(k,247) + rxt(k,453)*y(k,131) + rxt(k,454)*y(k,133)) + mat(k,1463) = -rxt(k,450)*y(k,273) + mat(k,2336) = -rxt(k,451)*y(k,273) + mat(k,2191) = -rxt(k,452)*y(k,273) + mat(k,1772) = -rxt(k,453)*y(k,273) + mat(k,2047) = -rxt(k,454)*y(k,273) + mat(k,284) = rxt(k,422)*y(k,265) + mat(k,399) = rxt(k,423)*y(k,265) + mat(k,174) = rxt(k,424)*y(k,265) + mat(k,756) = .400_r8*rxt(k,447)*y(k,265) + mat(k,246) = .500_r8*rxt(k,455)*y(k,265) + mat(k,1985) = rxt(k,422)*y(k,96) + rxt(k,423)*y(k,98) + rxt(k,424)*y(k,99) & + + .400_r8*rxt(k,447)*y(k,106) + .500_r8*rxt(k,455)*y(k,225) + mat(k,811) = -(rxt(k,492)*y(k,247) + rxt(k,493)*y(k,131)) + mat(k,2166) = -rxt(k,492)*y(k,274) + mat(k,1744) = -rxt(k,493)*y(k,274) + mat(k,257) = .560_r8*rxt(k,491)*y(k,265) + mat(k,768) = rxt(k,494)*y(k,265) + mat(k,1950) = .560_r8*rxt(k,491)*y(k,226) + rxt(k,494)*y(k,227) + mat(k,556) = -(rxt(k,495)*y(k,247) + rxt(k,496)*y(k,131)) + mat(k,2150) = -rxt(k,495)*y(k,275) + mat(k,1731) = -rxt(k,496)*y(k,275) + mat(k,264) = .300_r8*rxt(k,497)*y(k,265) + mat(k,474) = rxt(k,498)*y(k,265) + mat(k,1923) = .300_r8*rxt(k,497)*y(k,229) + rxt(k,498)*y(k,230) + mat(k,2524) = -(rxt(k,174)*y(k,261) + rxt(k,293)*y(k,75) + rxt(k,538) & + *y(k,163)) + mat(k,1844) = -rxt(k,174)*y(k,276) + mat(k,977) = -rxt(k,293)*y(k,276) + mat(k,310) = -rxt(k,538)*y(k,276) + mat(k,339) = rxt(k,346)*y(k,265) + mat(k,442) = rxt(k,371)*y(k,265) + mat(k,345) = rxt(k,372)*y(k,265) + mat(k,520) = rxt(k,298)*y(k,265) + mat(k,2497) = rxt(k,317)*y(k,265) + mat(k,636) = rxt(k,300)*y(k,265) + mat(k,168) = rxt(k,301)*y(k,265) + mat(k,1203) = rxt(k,348)*y(k,265) + mat(k,408) = rxt(k,303)*y(k,265) + mat(k,1129) = rxt(k,386)*y(k,265) + mat(k,1332) = rxt(k,374)*y(k,265) + mat(k,753) = rxt(k,354)*y(k,265) + mat(k,643) = rxt(k,355)*y(k,265) + mat(k,460) = rxt(k,323)*y(k,265) + mat(k,2102) = rxt(k,324)*y(k,265) + mat(k,2289) = rxt(k,194)*y(k,247) + mat(k,1516) = rxt(k,199)*y(k,265) + mat(k,650) = rxt(k,200)*y(k,265) + mat(k,887) = rxt(k,284)*y(k,265) + mat(k,361) = rxt(k,308)*y(k,265) + mat(k,1551) = (rxt(k,594)+rxt(k,599))*y(k,93) + (rxt(k,587)+rxt(k,593) & + +rxt(k,598))*y(k,94) + rxt(k,255)*y(k,265) + mat(k,946) = rxt(k,326)*y(k,265) + mat(k,2312) = rxt(k,231)*y(k,265) + mat(k,527) = rxt(k,207)*y(k,265) + mat(k,848) = (rxt(k,594)+rxt(k,599))*y(k,87) + mat(k,879) = (rxt(k,587)+rxt(k,593)+rxt(k,598))*y(k,87) + rxt(k,258)*y(k,265) + mat(k,1323) = .500_r8*rxt(k,399)*y(k,265) + mat(k,143) = rxt(k,539)*y(k,265) + mat(k,595) = rxt(k,380)*y(k,265) + mat(k,430) = rxt(k,384)*y(k,265) + mat(k,2222) = rxt(k,194)*y(k,78) + rxt(k,201)*y(k,265) + mat(k,2017) = rxt(k,346)*y(k,30) + rxt(k,371)*y(k,32) + rxt(k,372)*y(k,33) & + + rxt(k,298)*y(k,43) + rxt(k,317)*y(k,44) + rxt(k,300)*y(k,45) & + + rxt(k,301)*y(k,46) + rxt(k,348)*y(k,47) + rxt(k,303)*y(k,48) & + + rxt(k,386)*y(k,50) + rxt(k,374)*y(k,51) + rxt(k,354)*y(k,52) & + + rxt(k,355)*y(k,53) + rxt(k,323)*y(k,55) + rxt(k,324)*y(k,56) & + + rxt(k,199)*y(k,79) + rxt(k,200)*y(k,81) + rxt(k,284)*y(k,83) & + + rxt(k,308)*y(k,86) + rxt(k,255)*y(k,87) + rxt(k,326)*y(k,89) & + + rxt(k,231)*y(k,91) + rxt(k,207)*y(k,92) + rxt(k,258)*y(k,94) & + + .500_r8*rxt(k,399)*y(k,111) + rxt(k,539)*y(k,127) + rxt(k,380) & + *y(k,157) + rxt(k,384)*y(k,158) + rxt(k,201)*y(k,247) & + + 2.000_r8*rxt(k,204)*y(k,265) + end do + end subroutine nlnmat11 + 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) = lmat(k, 39) + mat(k, 40) = lmat(k, 40) + mat(k, 41) = lmat(k, 41) + mat(k, 42) = lmat(k, 42) + mat(k, 43) = lmat(k, 43) + mat(k, 44) = lmat(k, 44) + mat(k, 45) = lmat(k, 45) + mat(k, 46) = lmat(k, 46) + mat(k, 47) = lmat(k, 47) + mat(k, 48) = lmat(k, 48) + mat(k, 49) = lmat(k, 49) + mat(k, 50) = lmat(k, 50) + mat(k, 51) = lmat(k, 51) + mat(k, 52) = lmat(k, 52) + mat(k, 53) = lmat(k, 53) + mat(k, 54) = lmat(k, 54) + mat(k, 55) = lmat(k, 55) + mat(k, 56) = lmat(k, 56) + mat(k, 57) = lmat(k, 57) + mat(k, 58) = lmat(k, 58) + mat(k, 59) = lmat(k, 59) + mat(k, 60) = lmat(k, 60) + mat(k, 61) = lmat(k, 61) + mat(k, 62) = lmat(k, 62) + mat(k, 63) = lmat(k, 63) + mat(k, 64) = lmat(k, 64) + mat(k, 65) = lmat(k, 65) + mat(k, 71) = mat(k, 71) + lmat(k, 71) + mat(k, 73) = mat(k, 73) + lmat(k, 73) + mat(k, 74) = lmat(k, 74) + mat(k, 75) = lmat(k, 75) + mat(k, 76) = lmat(k, 76) + mat(k, 77) = lmat(k, 77) + mat(k, 78) = lmat(k, 78) + mat(k, 84) = mat(k, 84) + lmat(k, 84) + mat(k, 90) = mat(k, 90) + lmat(k, 90) + mat(k, 96) = mat(k, 96) + lmat(k, 96) + mat(k, 97) = lmat(k, 97) + mat(k, 98) = lmat(k, 98) + mat(k, 99) = lmat(k, 99) + mat(k, 100) = lmat(k, 100) + mat(k, 101) = lmat(k, 101) + mat(k, 107) = mat(k, 107) + lmat(k, 107) + mat(k, 113) = mat(k, 113) + lmat(k, 113) + mat(k, 115) = mat(k, 115) + lmat(k, 115) + mat(k, 116) = lmat(k, 116) + mat(k, 122) = mat(k, 122) + lmat(k, 122) + mat(k, 128) = mat(k, 128) + lmat(k, 128) + mat(k, 134) = mat(k, 134) + lmat(k, 134) + mat(k, 140) = mat(k, 140) + lmat(k, 140) + mat(k, 141) = mat(k, 141) + lmat(k, 141) + mat(k, 144) = mat(k, 144) + lmat(k, 144) + mat(k, 146) = mat(k, 146) + lmat(k, 146) + mat(k, 147) = mat(k, 147) + lmat(k, 147) + mat(k, 150) = lmat(k, 150) + mat(k, 151) = lmat(k, 151) + mat(k, 152) = lmat(k, 152) + mat(k, 153) = mat(k, 153) + lmat(k, 153) + mat(k, 154) = mat(k, 154) + lmat(k, 154) + mat(k, 156) = mat(k, 156) + lmat(k, 156) + mat(k, 157) = mat(k, 157) + lmat(k, 157) + mat(k, 158) = mat(k, 158) + lmat(k, 158) + mat(k, 160) = mat(k, 160) + lmat(k, 160) + mat(k, 161) = mat(k, 161) + lmat(k, 161) + mat(k, 162) = mat(k, 162) + lmat(k, 162) + mat(k, 164) = mat(k, 164) + lmat(k, 164) + mat(k, 165) = mat(k, 165) + lmat(k, 165) + mat(k, 167) = mat(k, 167) + lmat(k, 167) + mat(k, 169) = mat(k, 169) + lmat(k, 169) + mat(k, 170) = mat(k, 170) + lmat(k, 170) + mat(k, 171) = mat(k, 171) + lmat(k, 171) + mat(k, 173) = mat(k, 173) + lmat(k, 173) + mat(k, 176) = lmat(k, 176) + mat(k, 177) = lmat(k, 177) + mat(k, 178) = lmat(k, 178) + mat(k, 179) = lmat(k, 179) + mat(k, 180) = lmat(k, 180) + mat(k, 181) = lmat(k, 181) + mat(k, 182) = lmat(k, 182) + mat(k, 183) = lmat(k, 183) + mat(k, 184) = lmat(k, 184) + mat(k, 185) = mat(k, 185) + lmat(k, 185) + mat(k, 186) = mat(k, 186) + lmat(k, 186) + mat(k, 187) = mat(k, 187) + lmat(k, 187) + mat(k, 189) = mat(k, 189) + lmat(k, 189) + mat(k, 190) = mat(k, 190) + lmat(k, 190) + mat(k, 191) = mat(k, 191) + lmat(k, 191) + mat(k, 192) = mat(k, 192) + lmat(k, 192) + mat(k, 193) = mat(k, 193) + lmat(k, 193) + mat(k, 195) = mat(k, 195) + lmat(k, 195) + mat(k, 196) = mat(k, 196) + lmat(k, 196) + mat(k, 197) = mat(k, 197) + lmat(k, 197) + mat(k, 199) = mat(k, 199) + lmat(k, 199) + mat(k, 200) = mat(k, 200) + lmat(k, 200) + mat(k, 201) = mat(k, 201) + lmat(k, 201) + mat(k, 202) = mat(k, 202) + lmat(k, 202) + mat(k, 204) = mat(k, 204) + lmat(k, 204) + mat(k, 205) = lmat(k, 205) + mat(k, 206) = lmat(k, 206) + mat(k, 208) = mat(k, 208) + lmat(k, 208) + mat(k, 214) = lmat(k, 214) + mat(k, 215) = lmat(k, 215) + mat(k, 216) = lmat(k, 216) + mat(k, 217) = lmat(k, 217) + mat(k, 218) = mat(k, 218) + lmat(k, 218) + mat(k, 223) = mat(k, 223) + lmat(k, 223) + mat(k, 224) = mat(k, 224) + lmat(k, 224) + mat(k, 225) = mat(k, 225) + lmat(k, 225) + mat(k, 226) = mat(k, 226) + lmat(k, 226) + mat(k, 227) = lmat(k, 227) + mat(k, 229) = mat(k, 229) + lmat(k, 229) + mat(k, 236) = mat(k, 236) + lmat(k, 236) + mat(k, 241) = lmat(k, 241) + mat(k, 242) = lmat(k, 242) + mat(k, 243) = lmat(k, 243) + mat(k, 244) = lmat(k, 244) + mat(k, 245) = mat(k, 245) + lmat(k, 245) + mat(k, 247) = mat(k, 247) + lmat(k, 247) + mat(k, 248) = mat(k, 248) + lmat(k, 248) + mat(k, 254) = mat(k, 254) + lmat(k, 254) + mat(k, 262) = mat(k, 262) + lmat(k, 262) + mat(k, 267) = mat(k, 267) + lmat(k, 267) + mat(k, 268) = mat(k, 268) + lmat(k, 268) + mat(k, 270) = mat(k, 270) + lmat(k, 270) + mat(k, 273) = lmat(k, 273) + mat(k, 274) = lmat(k, 274) + mat(k, 275) = lmat(k, 275) + mat(k, 276) = lmat(k, 276) + mat(k, 277) = lmat(k, 277) + mat(k, 278) = lmat(k, 278) + mat(k, 279) = mat(k, 279) + lmat(k, 279) + mat(k, 282) = mat(k, 282) + lmat(k, 282) + mat(k, 283) = lmat(k, 283) + mat(k, 285) = mat(k, 285) + lmat(k, 285) + mat(k, 286) = lmat(k, 286) + mat(k, 287) = mat(k, 287) + lmat(k, 287) + mat(k, 288) = mat(k, 288) + lmat(k, 288) + mat(k, 291) = mat(k, 291) + lmat(k, 291) + mat(k, 292) = mat(k, 292) + lmat(k, 292) + mat(k, 293) = mat(k, 293) + lmat(k, 293) + mat(k, 295) = mat(k, 295) + lmat(k, 295) + mat(k, 296) = mat(k, 296) + lmat(k, 296) + mat(k, 297) = mat(k, 297) + lmat(k, 297) + mat(k, 301) = mat(k, 301) + lmat(k, 301) + mat(k, 302) = mat(k, 302) + lmat(k, 302) + mat(k, 305) = mat(k, 305) + lmat(k, 305) + mat(k, 307) = mat(k, 307) + lmat(k, 307) + mat(k, 308) = lmat(k, 308) + mat(k, 309) = lmat(k, 309) + mat(k, 311) = mat(k, 311) + lmat(k, 311) + mat(k, 315) = mat(k, 315) + lmat(k, 315) + mat(k, 316) = lmat(k, 316) + mat(k, 318) = mat(k, 318) + lmat(k, 318) + mat(k, 319) = lmat(k, 319) + mat(k, 320) = lmat(k, 320) + mat(k, 321) = lmat(k, 321) + mat(k, 322) = lmat(k, 322) + mat(k, 323) = lmat(k, 323) + mat(k, 324) = lmat(k, 324) + mat(k, 325) = mat(k, 325) + lmat(k, 325) + mat(k, 331) = lmat(k, 331) + mat(k, 332) = lmat(k, 332) + mat(k, 333) = lmat(k, 333) + mat(k, 334) = mat(k, 334) + lmat(k, 334) + mat(k, 340) = mat(k, 340) + lmat(k, 340) + mat(k, 346) = lmat(k, 346) + mat(k, 347) = lmat(k, 347) + mat(k, 348) = lmat(k, 348) + mat(k, 349) = mat(k, 349) + lmat(k, 349) + mat(k, 355) = mat(k, 355) + lmat(k, 355) + mat(k, 356) = mat(k, 356) + lmat(k, 356) + mat(k, 360) = mat(k, 360) + lmat(k, 360) + mat(k, 362) = mat(k, 362) + lmat(k, 362) + mat(k, 365) = mat(k, 365) + lmat(k, 365) + mat(k, 366) = lmat(k, 366) + mat(k, 367) = mat(k, 367) + lmat(k, 367) + mat(k, 369) = lmat(k, 369) + mat(k, 370) = mat(k, 370) + lmat(k, 370) + mat(k, 371) = lmat(k, 371) + mat(k, 372) = lmat(k, 372) + mat(k, 373) = mat(k, 373) + lmat(k, 373) + mat(k, 376) = mat(k, 376) + lmat(k, 376) + mat(k, 377) = lmat(k, 377) + mat(k, 378) = mat(k, 378) + lmat(k, 378) + mat(k, 380) = mat(k, 380) + lmat(k, 380) + mat(k, 381) = mat(k, 381) + lmat(k, 381) + mat(k, 382) = lmat(k, 382) + mat(k, 383) = lmat(k, 383) + mat(k, 384) = lmat(k, 384) + mat(k, 385) = lmat(k, 385) + mat(k, 386) = lmat(k, 386) + mat(k, 387) = lmat(k, 387) + mat(k, 388) = mat(k, 388) + lmat(k, 388) + mat(k, 390) = lmat(k, 390) + mat(k, 391) = lmat(k, 391) + mat(k, 392) = mat(k, 392) + lmat(k, 392) + mat(k, 393) = mat(k, 393) + lmat(k, 393) + mat(k, 398) = mat(k, 398) + lmat(k, 398) + mat(k, 401) = mat(k, 401) + lmat(k, 401) + mat(k, 406) = mat(k, 406) + lmat(k, 406) + mat(k, 407) = lmat(k, 407) + mat(k, 409) = mat(k, 409) + lmat(k, 409) + mat(k, 417) = mat(k, 417) + lmat(k, 417) + mat(k, 418) = lmat(k, 418) + mat(k, 420) = mat(k, 420) + lmat(k, 420) + mat(k, 425) = mat(k, 425) + lmat(k, 425) + mat(k, 427) = lmat(k, 427) + mat(k, 428) = mat(k, 428) + lmat(k, 428) + mat(k, 429) = lmat(k, 429) + mat(k, 431) = mat(k, 431) + lmat(k, 431) + mat(k, 432) = lmat(k, 432) + mat(k, 434) = lmat(k, 434) + mat(k, 435) = mat(k, 435) + lmat(k, 435) + mat(k, 436) = lmat(k, 436) + mat(k, 437) = mat(k, 437) + lmat(k, 437) + mat(k, 439) = lmat(k, 439) + mat(k, 440) = mat(k, 440) + lmat(k, 440) + mat(k, 441) = lmat(k, 441) + mat(k, 443) = mat(k, 443) + lmat(k, 443) + mat(k, 444) = lmat(k, 444) + mat(k, 446) = lmat(k, 446) + mat(k, 448) = mat(k, 448) + lmat(k, 448) + mat(k, 449) = mat(k, 449) + lmat(k, 449) + mat(k, 450) = lmat(k, 450) + mat(k, 452) = lmat(k, 452) + mat(k, 453) = mat(k, 453) + lmat(k, 453) + mat(k, 454) = lmat(k, 454) + mat(k, 455) = mat(k, 455) + lmat(k, 455) + mat(k, 456) = mat(k, 456) + lmat(k, 456) + mat(k, 457) = lmat(k, 457) + mat(k, 459) = mat(k, 459) + lmat(k, 459) + mat(k, 461) = mat(k, 461) + lmat(k, 461) + mat(k, 463) = mat(k, 463) + lmat(k, 463) + mat(k, 467) = lmat(k, 467) + mat(k, 468) = lmat(k, 468) + mat(k, 469) = lmat(k, 469) + mat(k, 470) = lmat(k, 470) + mat(k, 471) = lmat(k, 471) + mat(k, 472) = lmat(k, 472) + mat(k, 473) = mat(k, 473) + lmat(k, 473) + mat(k, 475) = lmat(k, 475) + mat(k, 476) = lmat(k, 476) + mat(k, 477) = mat(k, 477) + lmat(k, 477) + mat(k, 478) = lmat(k, 478) + mat(k, 481) = mat(k, 481) + lmat(k, 481) + mat(k, 487) = mat(k, 487) + lmat(k, 487) + mat(k, 491) = mat(k, 491) + lmat(k, 491) + mat(k, 492) = lmat(k, 492) + mat(k, 493) = mat(k, 493) + lmat(k, 493) + mat(k, 498) = lmat(k, 498) + mat(k, 500) = mat(k, 500) + lmat(k, 500) + mat(k, 506) = lmat(k, 506) + mat(k, 507) = lmat(k, 507) + mat(k, 508) = lmat(k, 508) + mat(k, 509) = mat(k, 509) + lmat(k, 509) + mat(k, 512) = mat(k, 512) + lmat(k, 512) + mat(k, 513) = lmat(k, 513) + mat(k, 514) = mat(k, 514) + lmat(k, 514) + mat(k, 516) = mat(k, 516) + lmat(k, 516) + mat(k, 521) = mat(k, 521) + lmat(k, 521) + mat(k, 523) = mat(k, 523) + lmat(k, 523) + mat(k, 524) = mat(k, 524) + lmat(k, 524) + mat(k, 525) = lmat(k, 525) + mat(k, 526) = lmat(k, 526) + mat(k, 528) = mat(k, 528) + lmat(k, 528) + mat(k, 530) = lmat(k, 530) + mat(k, 531) = lmat(k, 531) + mat(k, 532) = mat(k, 532) + lmat(k, 532) + mat(k, 533) = lmat(k, 533) + mat(k, 534) = lmat(k, 534) + mat(k, 535) = mat(k, 535) + lmat(k, 535) + mat(k, 541) = mat(k, 541) + lmat(k, 541) + mat(k, 548) = mat(k, 548) + lmat(k, 548) + mat(k, 556) = mat(k, 556) + lmat(k, 556) + mat(k, 563) = mat(k, 563) + lmat(k, 563) + mat(k, 565) = lmat(k, 565) + mat(k, 566) = lmat(k, 566) + mat(k, 569) = mat(k, 569) + lmat(k, 569) + mat(k, 575) = mat(k, 575) + lmat(k, 575) + mat(k, 580) = mat(k, 580) + lmat(k, 580) + mat(k, 581) = lmat(k, 581) + mat(k, 582) = lmat(k, 582) + mat(k, 583) = lmat(k, 583) + mat(k, 585) = mat(k, 585) + lmat(k, 585) + mat(k, 586) = lmat(k, 586) + mat(k, 588) = mat(k, 588) + lmat(k, 588) + mat(k, 590) = lmat(k, 590) + mat(k, 592) = mat(k, 592) + lmat(k, 592) + mat(k, 593) = lmat(k, 593) + mat(k, 594) = lmat(k, 594) + mat(k, 596) = mat(k, 596) + lmat(k, 596) + mat(k, 603) = lmat(k, 603) + mat(k, 604) = mat(k, 604) + lmat(k, 604) + mat(k, 605) = lmat(k, 605) + mat(k, 606) = lmat(k, 606) + mat(k, 607) = mat(k, 607) + lmat(k, 607) + mat(k, 608) = lmat(k, 608) + mat(k, 609) = mat(k, 609) + lmat(k, 609) + mat(k, 610) = lmat(k, 610) + mat(k, 612) = mat(k, 612) + lmat(k, 612) + mat(k, 620) = mat(k, 620) + lmat(k, 620) + mat(k, 628) = mat(k, 628) + lmat(k, 628) + mat(k, 630) = mat(k, 630) + lmat(k, 630) + mat(k, 635) = lmat(k, 635) + mat(k, 637) = mat(k, 637) + lmat(k, 637) + mat(k, 639) = mat(k, 639) + lmat(k, 639) + mat(k, 640) = mat(k, 640) + lmat(k, 640) + mat(k, 641) = lmat(k, 641) + mat(k, 644) = mat(k, 644) + lmat(k, 644) + mat(k, 646) = mat(k, 646) + lmat(k, 646) + mat(k, 651) = mat(k, 651) + lmat(k, 651) + mat(k, 658) = lmat(k, 658) + mat(k, 660) = lmat(k, 660) + mat(k, 661) = lmat(k, 661) + mat(k, 662) = mat(k, 662) + lmat(k, 662) + mat(k, 663) = lmat(k, 663) + mat(k, 667) = lmat(k, 667) + mat(k, 668) = lmat(k, 668) + mat(k, 669) = mat(k, 669) + lmat(k, 669) + mat(k, 670) = lmat(k, 670) + mat(k, 671) = mat(k, 671) + lmat(k, 671) + mat(k, 673) = lmat(k, 673) + mat(k, 675) = lmat(k, 675) + mat(k, 680) = lmat(k, 680) + mat(k, 681) = lmat(k, 681) + mat(k, 682) = lmat(k, 682) + mat(k, 683) = lmat(k, 683) + mat(k, 684) = mat(k, 684) + lmat(k, 684) + mat(k, 685) = mat(k, 685) + lmat(k, 685) + mat(k, 686) = mat(k, 686) + lmat(k, 686) + mat(k, 688) = lmat(k, 688) + mat(k, 689) = lmat(k, 689) + mat(k, 692) = mat(k, 692) + lmat(k, 692) + mat(k, 698) = lmat(k, 698) + mat(k, 699) = mat(k, 699) + lmat(k, 699) + mat(k, 702) = mat(k, 702) + lmat(k, 702) + mat(k, 703) = mat(k, 703) + lmat(k, 703) + mat(k, 705) = mat(k, 705) + lmat(k, 705) + mat(k, 707) = lmat(k, 707) + mat(k, 708) = mat(k, 708) + lmat(k, 708) + mat(k, 709) = lmat(k, 709) + mat(k, 710) = mat(k, 710) + lmat(k, 710) + mat(k, 714) = lmat(k, 714) + mat(k, 715) = lmat(k, 715) + mat(k, 717) = mat(k, 717) + lmat(k, 717) + mat(k, 718) = lmat(k, 718) + mat(k, 719) = lmat(k, 719) + mat(k, 721) = mat(k, 721) + lmat(k, 721) + mat(k, 728) = mat(k, 728) + lmat(k, 728) + mat(k, 729) = lmat(k, 729) + mat(k, 730) = lmat(k, 730) + mat(k, 731) = lmat(k, 731) + mat(k, 732) = lmat(k, 732) + mat(k, 734) = lmat(k, 734) + mat(k, 735) = mat(k, 735) + lmat(k, 735) + mat(k, 736) = lmat(k, 736) + mat(k, 737) = lmat(k, 737) + mat(k, 739) = mat(k, 739) + lmat(k, 739) + mat(k, 749) = mat(k, 749) + lmat(k, 749) + mat(k, 755) = mat(k, 755) + lmat(k, 755) + mat(k, 757) = lmat(k, 757) + mat(k, 758) = lmat(k, 758) + mat(k, 759) = mat(k, 759) + lmat(k, 759) + mat(k, 760) = lmat(k, 760) + mat(k, 761) = lmat(k, 761) + mat(k, 762) = lmat(k, 762) + mat(k, 763) = lmat(k, 763) + mat(k, 764) = lmat(k, 764) + mat(k, 765) = lmat(k, 765) + mat(k, 766) = mat(k, 766) + lmat(k, 766) + mat(k, 771) = lmat(k, 771) + mat(k, 773) = lmat(k, 773) + mat(k, 775) = mat(k, 775) + lmat(k, 775) + mat(k, 776) = lmat(k, 776) + mat(k, 777) = mat(k, 777) + lmat(k, 777) + mat(k, 784) = mat(k, 784) + lmat(k, 784) + mat(k, 795) = mat(k, 795) + lmat(k, 795) + mat(k, 811) = mat(k, 811) + lmat(k, 811) + mat(k, 822) = mat(k, 822) + lmat(k, 822) + mat(k, 832) = mat(k, 832) + lmat(k, 832) + mat(k, 841) = mat(k, 841) + lmat(k, 841) + mat(k, 843) = lmat(k, 843) + mat(k, 845) = mat(k, 845) + lmat(k, 845) + mat(k, 849) = mat(k, 849) + lmat(k, 849) + mat(k, 850) = lmat(k, 850) + mat(k, 852) = lmat(k, 852) + mat(k, 857) = mat(k, 857) + lmat(k, 857) + mat(k, 862) = mat(k, 862) + lmat(k, 862) + mat(k, 873) = mat(k, 873) + lmat(k, 873) + mat(k, 876) = mat(k, 876) + lmat(k, 876) + mat(k, 877) = mat(k, 877) + lmat(k, 877) + mat(k, 880) = mat(k, 880) + lmat(k, 880) + mat(k, 881) = mat(k, 881) + lmat(k, 881) + mat(k, 885) = mat(k, 885) + lmat(k, 885) + mat(k, 889) = mat(k, 889) + lmat(k, 889) + mat(k, 896) = mat(k, 896) + lmat(k, 896) + mat(k, 897) = mat(k, 897) + lmat(k, 897) + mat(k, 901) = mat(k, 901) + lmat(k, 901) + mat(k, 909) = mat(k, 909) + lmat(k, 909) + mat(k, 920) = mat(k, 920) + lmat(k, 920) + mat(k, 936) = mat(k, 936) + lmat(k, 936) + mat(k, 938) = lmat(k, 938) + mat(k, 939) = mat(k, 939) + lmat(k, 939) + mat(k, 941) = lmat(k, 941) + mat(k, 942) = mat(k, 942) + lmat(k, 942) + mat(k, 950) = mat(k, 950) + lmat(k, 950) + mat(k, 959) = mat(k, 959) + lmat(k, 959) + mat(k, 969) = mat(k, 969) + lmat(k, 969) + mat(k, 979) = mat(k, 979) + lmat(k, 979) + mat(k, 991) = mat(k, 991) + lmat(k, 991) + mat(k, 992) = lmat(k, 992) + mat(k, 995) = lmat(k, 995) + mat(k,1006) = mat(k,1006) + lmat(k,1006) + mat(k,1026) = mat(k,1026) + lmat(k,1026) + mat(k,1027) = mat(k,1027) + lmat(k,1027) + mat(k,1029) = mat(k,1029) + lmat(k,1029) + mat(k,1030) = lmat(k,1030) + mat(k,1032) = mat(k,1032) + lmat(k,1032) + mat(k,1033) = mat(k,1033) + lmat(k,1033) + mat(k,1034) = mat(k,1034) + lmat(k,1034) + mat(k,1038) = lmat(k,1038) + mat(k,1042) = lmat(k,1042) + mat(k,1043) = mat(k,1043) + lmat(k,1043) + mat(k,1062) = mat(k,1062) + lmat(k,1062) + mat(k,1086) = mat(k,1086) + lmat(k,1086) + mat(k,1097) = lmat(k,1097) + mat(k,1098) = mat(k,1098) + lmat(k,1098) + mat(k,1099) = mat(k,1099) + lmat(k,1099) + mat(k,1102) = mat(k,1102) + lmat(k,1102) + mat(k,1106) = mat(k,1106) + lmat(k,1106) + mat(k,1116) = mat(k,1116) + lmat(k,1116) + mat(k,1118) = lmat(k,1118) + mat(k,1119) = lmat(k,1119) + mat(k,1123) = lmat(k,1123) + mat(k,1124) = mat(k,1124) + lmat(k,1124) + mat(k,1126) = lmat(k,1126) + mat(k,1128) = lmat(k,1128) + mat(k,1130) = lmat(k,1130) + mat(k,1134) = mat(k,1134) + lmat(k,1134) + mat(k,1139) = lmat(k,1139) + mat(k,1142) = mat(k,1142) + lmat(k,1142) + mat(k,1143) = lmat(k,1143) + mat(k,1150) = mat(k,1150) + lmat(k,1150) + mat(k,1162) = mat(k,1162) + lmat(k,1162) + mat(k,1163) = mat(k,1163) + lmat(k,1163) + mat(k,1164) = mat(k,1164) + lmat(k,1164) + mat(k,1165) = mat(k,1165) + lmat(k,1165) + mat(k,1166) = mat(k,1166) + lmat(k,1166) + mat(k,1167) = mat(k,1167) + lmat(k,1167) + mat(k,1169) = mat(k,1169) + lmat(k,1169) + mat(k,1171) = mat(k,1171) + lmat(k,1171) + mat(k,1177) = mat(k,1177) + lmat(k,1177) + mat(k,1195) = mat(k,1195) + lmat(k,1195) + mat(k,1196) = lmat(k,1196) + mat(k,1200) = lmat(k,1200) + mat(k,1202) = lmat(k,1202) + mat(k,1204) = mat(k,1204) + lmat(k,1204) + mat(k,1209) = lmat(k,1209) + mat(k,1210) = mat(k,1210) + lmat(k,1210) + mat(k,1213) = mat(k,1213) + lmat(k,1213) + mat(k,1214) = mat(k,1214) + lmat(k,1214) + mat(k,1222) = mat(k,1222) + lmat(k,1222) + mat(k,1235) = lmat(k,1235) + mat(k,1236) = lmat(k,1236) + mat(k,1237) = lmat(k,1237) + mat(k,1238) = lmat(k,1238) + mat(k,1239) = mat(k,1239) + lmat(k,1239) + mat(k,1240) = lmat(k,1240) + mat(k,1242) = lmat(k,1242) + mat(k,1244) = lmat(k,1244) + mat(k,1247) = mat(k,1247) + lmat(k,1247) + mat(k,1248) = lmat(k,1248) + mat(k,1250) = lmat(k,1250) + mat(k,1252) = mat(k,1252) + lmat(k,1252) + mat(k,1254) = lmat(k,1254) + mat(k,1256) = mat(k,1256) + lmat(k,1256) + mat(k,1257) = lmat(k,1257) + mat(k,1261) = mat(k,1261) + lmat(k,1261) + mat(k,1277) = mat(k,1277) + lmat(k,1277) + mat(k,1297) = mat(k,1297) + lmat(k,1297) + mat(k,1312) = mat(k,1312) + lmat(k,1312) + mat(k,1313) = mat(k,1313) + lmat(k,1313) + mat(k,1316) = mat(k,1316) + lmat(k,1316) + mat(k,1317) = mat(k,1317) + lmat(k,1317) + mat(k,1320) = mat(k,1320) + lmat(k,1320) + mat(k,1322) = mat(k,1322) + lmat(k,1322) + mat(k,1324) = mat(k,1324) + lmat(k,1324) + mat(k,1325) = mat(k,1325) + lmat(k,1325) + mat(k,1326) = mat(k,1326) + lmat(k,1326) + mat(k,1330) = lmat(k,1330) + mat(k,1343) = mat(k,1343) + lmat(k,1343) + mat(k,1359) = lmat(k,1359) + mat(k,1376) = mat(k,1376) + lmat(k,1376) + mat(k,1386) = mat(k,1386) + lmat(k,1386) + mat(k,1400) = mat(k,1400) + lmat(k,1400) + mat(k,1414) = lmat(k,1414) + mat(k,1416) = mat(k,1416) + lmat(k,1416) + mat(k,1420) = mat(k,1420) + lmat(k,1420) + mat(k,1422) = mat(k,1422) + lmat(k,1422) + mat(k,1432) = lmat(k,1432) + mat(k,1441) = mat(k,1441) + lmat(k,1441) + mat(k,1472) = mat(k,1472) + lmat(k,1472) + mat(k,1493) = mat(k,1493) + lmat(k,1493) + mat(k,1494) = mat(k,1494) + lmat(k,1494) + mat(k,1502) = lmat(k,1502) + mat(k,1505) = mat(k,1505) + lmat(k,1505) + mat(k,1518) = lmat(k,1518) + mat(k,1520) = mat(k,1520) + lmat(k,1520) + mat(k,1532) = mat(k,1532) + lmat(k,1532) + mat(k,1539) = mat(k,1539) + lmat(k,1539) + mat(k,1547) = mat(k,1547) + lmat(k,1547) + mat(k,1548) = mat(k,1548) + lmat(k,1548) + mat(k,1555) = mat(k,1555) + lmat(k,1555) + mat(k,1575) = mat(k,1575) + lmat(k,1575) + mat(k,1577) = mat(k,1577) + lmat(k,1577) + mat(k,1578) = lmat(k,1578) + mat(k,1586) = mat(k,1586) + lmat(k,1586) + mat(k,1591) = mat(k,1591) + lmat(k,1591) + mat(k,1597) = mat(k,1597) + lmat(k,1597) + mat(k,1607) = mat(k,1607) + lmat(k,1607) + mat(k,1609) = mat(k,1609) + lmat(k,1609) + mat(k,1621) = mat(k,1621) + lmat(k,1621) + mat(k,1636) = mat(k,1636) + lmat(k,1636) + mat(k,1643) = mat(k,1643) + lmat(k,1643) + mat(k,1648) = mat(k,1648) + lmat(k,1648) + mat(k,1681) = mat(k,1681) + lmat(k,1681) + mat(k,1682) = mat(k,1682) + lmat(k,1682) + mat(k,1684) = mat(k,1684) + lmat(k,1684) + mat(k,1690) = mat(k,1690) + lmat(k,1690) + mat(k,1693) = mat(k,1693) + lmat(k,1693) + mat(k,1748) = mat(k,1748) + lmat(k,1748) + mat(k,1750) = lmat(k,1750) + mat(k,1756) = mat(k,1756) + lmat(k,1756) + mat(k,1788) = mat(k,1788) + lmat(k,1788) + mat(k,1799) = mat(k,1799) + lmat(k,1799) + mat(k,1832) = mat(k,1832) + lmat(k,1832) + mat(k,1842) = mat(k,1842) + lmat(k,1842) + mat(k,2006) = mat(k,2006) + lmat(k,2006) + mat(k,2060) = mat(k,2060) + lmat(k,2060) + mat(k,2063) = mat(k,2063) + lmat(k,2063) + mat(k,2064) = mat(k,2064) + lmat(k,2064) + mat(k,2067) = mat(k,2067) + lmat(k,2067) + mat(k,2072) = mat(k,2072) + lmat(k,2072) + mat(k,2075) = mat(k,2075) + lmat(k,2075) + mat(k,2080) = lmat(k,2080) + mat(k,2081) = lmat(k,2081) + mat(k,2082) = mat(k,2082) + lmat(k,2082) + mat(k,2091) = mat(k,2091) + lmat(k,2091) + mat(k,2093) = mat(k,2093) + lmat(k,2093) + mat(k,2096) = mat(k,2096) + lmat(k,2096) + mat(k,2098) = mat(k,2098) + lmat(k,2098) + mat(k,2100) = lmat(k,2100) + mat(k,2101) = mat(k,2101) + lmat(k,2101) + mat(k,2102) = mat(k,2102) + lmat(k,2102) + mat(k,2214) = mat(k,2214) + lmat(k,2214) + mat(k,2222) = mat(k,2222) + lmat(k,2222) + mat(k,2261) = mat(k,2261) + lmat(k,2261) + mat(k,2283) = mat(k,2283) + lmat(k,2283) + mat(k,2298) = lmat(k,2298) + mat(k,2301) = mat(k,2301) + lmat(k,2301) + mat(k,2307) = mat(k,2307) + lmat(k,2307) + mat(k,2360) = mat(k,2360) + lmat(k,2360) + mat(k,2370) = mat(k,2370) + lmat(k,2370) + mat(k,2411) = mat(k,2411) + lmat(k,2411) + mat(k,2416) = mat(k,2416) + lmat(k,2416) + mat(k,2425) = mat(k,2425) + lmat(k,2425) + mat(k,2426) = mat(k,2426) + lmat(k,2426) + mat(k,2439) = mat(k,2439) + lmat(k,2439) + mat(k,2444) = lmat(k,2444) + mat(k,2469) = mat(k,2469) + lmat(k,2469) + mat(k,2475) = mat(k,2475) + lmat(k,2475) + mat(k,2477) = lmat(k,2477) + mat(k,2491) = mat(k,2491) + lmat(k,2491) + mat(k,2496) = mat(k,2496) + lmat(k,2496) + mat(k,2503) = lmat(k,2503) + mat(k,2512) = mat(k,2512) + lmat(k,2512) + mat(k,2513) = mat(k,2513) + lmat(k,2513) + mat(k,2518) = lmat(k,2518) + mat(k,2522) = lmat(k,2522) + mat(k,2524) = mat(k,2524) + lmat(k,2524) + mat(k, 258) = 0._r8 + mat(k, 259) = 0._r8 + mat(k, 298) = 0._r8 + mat(k, 357) = 0._r8 + mat(k, 375) = 0._r8 + mat(k, 482) = 0._r8 + mat(k, 485) = 0._r8 + mat(k, 504) = 0._r8 + mat(k, 542) = 0._r8 + mat(k, 546) = 0._r8 + mat(k, 561) = 0._r8 + mat(k, 664) = 0._r8 + mat(k, 666) = 0._r8 + mat(k, 695) = 0._r8 + mat(k, 697) = 0._r8 + mat(k, 700) = 0._r8 + mat(k, 701) = 0._r8 + mat(k, 704) = 0._r8 + mat(k, 711) = 0._r8 + mat(k, 712) = 0._r8 + mat(k, 716) = 0._r8 + mat(k, 746) = 0._r8 + mat(k, 747) = 0._r8 + mat(k, 767) = 0._r8 + mat(k, 769) = 0._r8 + mat(k, 770) = 0._r8 + mat(k, 772) = 0._r8 + mat(k, 774) = 0._r8 + mat(k, 794) = 0._r8 + mat(k, 796) = 0._r8 + mat(k, 797) = 0._r8 + mat(k, 799) = 0._r8 + mat(k, 803) = 0._r8 + mat(k, 810) = 0._r8 + mat(k, 812) = 0._r8 + mat(k, 813) = 0._r8 + mat(k, 815) = 0._r8 + mat(k, 817) = 0._r8 + mat(k, 820) = 0._r8 + mat(k, 833) = 0._r8 + mat(k, 834) = 0._r8 + mat(k, 837) = 0._r8 + mat(k, 846) = 0._r8 + mat(k, 864) = 0._r8 + mat(k, 868) = 0._r8 + mat(k, 871) = 0._r8 + mat(k, 892) = 0._r8 + mat(k, 893) = 0._r8 + mat(k, 894) = 0._r8 + mat(k, 906) = 0._r8 + mat(k, 911) = 0._r8 + mat(k, 912) = 0._r8 + mat(k, 913) = 0._r8 + mat(k, 914) = 0._r8 + mat(k, 955) = 0._r8 + mat(k, 985) = 0._r8 + mat(k, 989) = 0._r8 + mat(k, 996) = 0._r8 + mat(k,1007) = 0._r8 + mat(k,1008) = 0._r8 + mat(k,1016) = 0._r8 + mat(k,1024) = 0._r8 + mat(k,1036) = 0._r8 + mat(k,1039) = 0._r8 + mat(k,1044) = 0._r8 + mat(k,1045) = 0._r8 + mat(k,1049) = 0._r8 + mat(k,1063) = 0._r8 + mat(k,1064) = 0._r8 + mat(k,1072) = 0._r8 + mat(k,1080) = 0._r8 + mat(k,1084) = 0._r8 + mat(k,1085) = 0._r8 + mat(k,1089) = 0._r8 + mat(k,1090) = 0._r8 + mat(k,1093) = 0._r8 + mat(k,1095) = 0._r8 + mat(k,1111) = 0._r8 + mat(k,1113) = 0._r8 + mat(k,1132) = 0._r8 + mat(k,1135) = 0._r8 + mat(k,1136) = 0._r8 + mat(k,1137) = 0._r8 + mat(k,1138) = 0._r8 + mat(k,1140) = 0._r8 + mat(k,1144) = 0._r8 + mat(k,1145) = 0._r8 + mat(k,1151) = 0._r8 + mat(k,1152) = 0._r8 + mat(k,1153) = 0._r8 + mat(k,1156) = 0._r8 + mat(k,1159) = 0._r8 + mat(k,1170) = 0._r8 + mat(k,1172) = 0._r8 + mat(k,1180) = 0._r8 + mat(k,1181) = 0._r8 + mat(k,1182) = 0._r8 + mat(k,1184) = 0._r8 + mat(k,1185) = 0._r8 + mat(k,1186) = 0._r8 + mat(k,1194) = 0._r8 + mat(k,1223) = 0._r8 + mat(k,1224) = 0._r8 + mat(k,1228) = 0._r8 + mat(k,1230) = 0._r8 + mat(k,1233) = 0._r8 + mat(k,1241) = 0._r8 + mat(k,1243) = 0._r8 + mat(k,1246) = 0._r8 + mat(k,1249) = 0._r8 + mat(k,1251) = 0._r8 + mat(k,1270) = 0._r8 + mat(k,1283) = 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,1302) = 0._r8 + mat(k,1305) = 0._r8 + mat(k,1308) = 0._r8 + mat(k,1318) = 0._r8 + mat(k,1327) = 0._r8 + mat(k,1336) = 0._r8 + mat(k,1337) = 0._r8 + mat(k,1338) = 0._r8 + mat(k,1339) = 0._r8 + mat(k,1340) = 0._r8 + mat(k,1342) = 0._r8 + mat(k,1344) = 0._r8 + mat(k,1346) = 0._r8 + mat(k,1351) = 0._r8 + mat(k,1354) = 0._r8 + mat(k,1356) = 0._r8 + mat(k,1358) = 0._r8 + mat(k,1362) = 0._r8 + mat(k,1365) = 0._r8 + mat(k,1366) = 0._r8 + mat(k,1368) = 0._r8 + mat(k,1370) = 0._r8 + mat(k,1372) = 0._r8 + mat(k,1373) = 0._r8 + mat(k,1374) = 0._r8 + mat(k,1377) = 0._r8 + mat(k,1378) = 0._r8 + mat(k,1379) = 0._r8 + mat(k,1381) = 0._r8 + mat(k,1384) = 0._r8 + mat(k,1387) = 0._r8 + mat(k,1389) = 0._r8 + mat(k,1391) = 0._r8 + mat(k,1398) = 0._r8 + mat(k,1401) = 0._r8 + mat(k,1403) = 0._r8 + mat(k,1406) = 0._r8 + mat(k,1409) = 0._r8 + mat(k,1412) = 0._r8 + mat(k,1417) = 0._r8 + mat(k,1421) = 0._r8 + mat(k,1424) = 0._r8 + mat(k,1425) = 0._r8 + mat(k,1426) = 0._r8 + mat(k,1428) = 0._r8 + mat(k,1429) = 0._r8 + mat(k,1431) = 0._r8 + mat(k,1435) = 0._r8 + mat(k,1439) = 0._r8 + mat(k,1440) = 0._r8 + mat(k,1449) = 0._r8 + mat(k,1453) = 0._r8 + mat(k,1474) = 0._r8 + mat(k,1478) = 0._r8 + mat(k,1479) = 0._r8 + mat(k,1481) = 0._r8 + mat(k,1485) = 0._r8 + mat(k,1489) = 0._r8 + mat(k,1491) = 0._r8 + mat(k,1492) = 0._r8 + mat(k,1495) = 0._r8 + mat(k,1496) = 0._r8 + mat(k,1497) = 0._r8 + mat(k,1498) = 0._r8 + mat(k,1499) = 0._r8 + mat(k,1500) = 0._r8 + mat(k,1501) = 0._r8 + mat(k,1509) = 0._r8 + mat(k,1510) = 0._r8 + mat(k,1513) = 0._r8 + mat(k,1514) = 0._r8 + mat(k,1528) = 0._r8 + mat(k,1533) = 0._r8 + mat(k,1540) = 0._r8 + mat(k,1541) = 0._r8 + mat(k,1543) = 0._r8 + mat(k,1546) = 0._r8 + mat(k,1554) = 0._r8 + mat(k,1558) = 0._r8 + mat(k,1559) = 0._r8 + mat(k,1560) = 0._r8 + mat(k,1561) = 0._r8 + mat(k,1563) = 0._r8 + mat(k,1565) = 0._r8 + mat(k,1567) = 0._r8 + mat(k,1581) = 0._r8 + mat(k,1583) = 0._r8 + mat(k,1585) = 0._r8 + mat(k,1587) = 0._r8 + mat(k,1588) = 0._r8 + mat(k,1589) = 0._r8 + mat(k,1592) = 0._r8 + mat(k,1594) = 0._r8 + mat(k,1598) = 0._r8 + mat(k,1599) = 0._r8 + mat(k,1606) = 0._r8 + mat(k,1613) = 0._r8 + mat(k,1615) = 0._r8 + mat(k,1618) = 0._r8 + mat(k,1619) = 0._r8 + mat(k,1620) = 0._r8 + mat(k,1622) = 0._r8 + mat(k,1623) = 0._r8 + mat(k,1639) = 0._r8 + mat(k,1641) = 0._r8 + mat(k,1644) = 0._r8 + mat(k,1645) = 0._r8 + mat(k,1647) = 0._r8 + mat(k,1650) = 0._r8 + mat(k,1660) = 0._r8 + mat(k,1663) = 0._r8 + mat(k,1668) = 0._r8 + mat(k,1669) = 0._r8 + mat(k,1670) = 0._r8 + mat(k,1671) = 0._r8 + mat(k,1674) = 0._r8 + mat(k,1676) = 0._r8 + mat(k,1677) = 0._r8 + mat(k,1683) = 0._r8 + mat(k,1686) = 0._r8 + mat(k,1688) = 0._r8 + mat(k,1689) = 0._r8 + mat(k,1691) = 0._r8 + mat(k,1694) = 0._r8 + mat(k,1695) = 0._r8 + mat(k,1751) = 0._r8 + mat(k,1789) = 0._r8 + mat(k,1792) = 0._r8 + mat(k,1795) = 0._r8 + mat(k,1796) = 0._r8 + mat(k,1801) = 0._r8 + mat(k,1830) = 0._r8 + mat(k,1834) = 0._r8 + mat(k,1839) = 0._r8 + mat(k,1917) = 0._r8 + mat(k,1937) = 0._r8 + mat(k,1948) = 0._r8 + mat(k,1951) = 0._r8 + mat(k,1961) = 0._r8 + mat(k,1962) = 0._r8 + mat(k,1986) = 0._r8 + mat(k,2005) = 0._r8 + mat(k,2024) = 0._r8 + mat(k,2027) = 0._r8 + mat(k,2031) = 0._r8 + mat(k,2033) = 0._r8 + mat(k,2038) = 0._r8 + mat(k,2044) = 0._r8 + mat(k,2046) = 0._r8 + mat(k,2057) = 0._r8 + mat(k,2058) = 0._r8 + mat(k,2059) = 0._r8 + mat(k,2061) = 0._r8 + mat(k,2062) = 0._r8 + mat(k,2065) = 0._r8 + mat(k,2068) = 0._r8 + mat(k,2070) = 0._r8 + mat(k,2071) = 0._r8 + mat(k,2073) = 0._r8 + mat(k,2074) = 0._r8 + mat(k,2077) = 0._r8 + mat(k,2084) = 0._r8 + mat(k,2085) = 0._r8 + mat(k,2086) = 0._r8 + mat(k,2087) = 0._r8 + mat(k,2088) = 0._r8 + mat(k,2089) = 0._r8 + mat(k,2092) = 0._r8 + mat(k,2097) = 0._r8 + mat(k,2099) = 0._r8 + mat(k,2144) = 0._r8 + mat(k,2145) = 0._r8 + mat(k,2148) = 0._r8 + mat(k,2156) = 0._r8 + mat(k,2173) = 0._r8 + mat(k,2181) = 0._r8 + mat(k,2182) = 0._r8 + mat(k,2184) = 0._r8 + mat(k,2187) = 0._r8 + mat(k,2189) = 0._r8 + mat(k,2193) = 0._r8 + mat(k,2198) = 0._r8 + mat(k,2210) = 0._r8 + mat(k,2213) = 0._r8 + mat(k,2217) = 0._r8 + mat(k,2233) = 0._r8 + mat(k,2235) = 0._r8 + mat(k,2239) = 0._r8 + mat(k,2240) = 0._r8 + mat(k,2241) = 0._r8 + mat(k,2243) = 0._r8 + mat(k,2244) = 0._r8 + mat(k,2245) = 0._r8 + mat(k,2246) = 0._r8 + mat(k,2247) = 0._r8 + mat(k,2252) = 0._r8 + mat(k,2254) = 0._r8 + mat(k,2255) = 0._r8 + mat(k,2256) = 0._r8 + mat(k,2263) = 0._r8 + mat(k,2266) = 0._r8 + mat(k,2268) = 0._r8 + mat(k,2270) = 0._r8 + mat(k,2271) = 0._r8 + mat(k,2273) = 0._r8 + mat(k,2274) = 0._r8 + mat(k,2275) = 0._r8 + mat(k,2276) = 0._r8 + mat(k,2277) = 0._r8 + mat(k,2279) = 0._r8 + mat(k,2280) = 0._r8 + mat(k,2282) = 0._r8 + mat(k,2284) = 0._r8 + mat(k,2285) = 0._r8 + mat(k,2288) = 0._r8 + mat(k,2292) = 0._r8 + mat(k,2293) = 0._r8 + mat(k,2294) = 0._r8 + mat(k,2295) = 0._r8 + mat(k,2296) = 0._r8 + mat(k,2297) = 0._r8 + mat(k,2299) = 0._r8 + mat(k,2300) = 0._r8 + mat(k,2303) = 0._r8 + mat(k,2304) = 0._r8 + mat(k,2305) = 0._r8 + mat(k,2306) = 0._r8 + mat(k,2308) = 0._r8 + mat(k,2309) = 0._r8 + mat(k,2310) = 0._r8 + mat(k,2311) = 0._r8 + mat(k,2320) = 0._r8 + mat(k,2348) = 0._r8 + mat(k,2352) = 0._r8 + mat(k,2353) = 0._r8 + mat(k,2354) = 0._r8 + mat(k,2355) = 0._r8 + mat(k,2358) = 0._r8 + mat(k,2359) = 0._r8 + mat(k,2361) = 0._r8 + mat(k,2362) = 0._r8 + mat(k,2364) = 0._r8 + mat(k,2379) = 0._r8 + mat(k,2385) = 0._r8 + mat(k,2386) = 0._r8 + mat(k,2387) = 0._r8 + mat(k,2390) = 0._r8 + mat(k,2395) = 0._r8 + mat(k,2396) = 0._r8 + mat(k,2397) = 0._r8 + mat(k,2399) = 0._r8 + mat(k,2402) = 0._r8 + mat(k,2403) = 0._r8 + mat(k,2404) = 0._r8 + mat(k,2406) = 0._r8 + mat(k,2423) = 0._r8 + mat(k,2428) = 0._r8 + mat(k,2437) = 0._r8 + mat(k,2443) = 0._r8 + mat(k,2445) = 0._r8 + mat(k,2449) = 0._r8 + mat(k,2459) = 0._r8 + mat(k,2462) = 0._r8 + mat(k,2466) = 0._r8 + mat(k,2467) = 0._r8 + mat(k,2471) = 0._r8 + mat(k,2474) = 0._r8 + mat(k,2476) = 0._r8 + mat(k,2480) = 0._r8 + mat(k,2481) = 0._r8 + mat(k,2482) = 0._r8 + mat(k,2483) = 0._r8 + mat(k,2484) = 0._r8 + mat(k,2485) = 0._r8 + mat(k,2488) = 0._r8 + mat(k,2493) = 0._r8 + mat(k,2494) = 0._r8 + mat(k,2502) = 0._r8 + mat(k,2504) = 0._r8 + mat(k,2505) = 0._r8 + mat(k,2506) = 0._r8 + mat(k,2507) = 0._r8 + mat(k,2508) = 0._r8 + mat(k,2509) = 0._r8 + mat(k,2510) = 0._r8 + mat(k,2511) = 0._r8 + mat(k,2514) = 0._r8 + mat(k,2515) = 0._r8 + mat(k,2516) = 0._r8 + mat(k,2517) = 0._r8 + mat(k,2519) = 0._r8 + mat(k,2520) = 0._r8 + mat(k,2521) = 0._r8 + mat(k,2523) = 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, 10) = mat(k, 10) - 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, 33) = mat(k, 33) - 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, 37) = mat(k, 37) - dti(k) + mat(k, 38) = mat(k, 38) - dti(k) + mat(k, 39) = mat(k, 39) - dti(k) + mat(k, 40) = mat(k, 40) - dti(k) + mat(k, 41) = mat(k, 41) - dti(k) + mat(k, 42) = mat(k, 42) - dti(k) + mat(k, 43) = mat(k, 43) - dti(k) + mat(k, 44) = mat(k, 44) - dti(k) + mat(k, 45) = mat(k, 45) - dti(k) + mat(k, 46) = mat(k, 46) - dti(k) + mat(k, 47) = mat(k, 47) - dti(k) + mat(k, 48) = mat(k, 48) - dti(k) + mat(k, 49) = mat(k, 49) - dti(k) + mat(k, 50) = mat(k, 50) - dti(k) + mat(k, 51) = mat(k, 51) - dti(k) + mat(k, 52) = mat(k, 52) - dti(k) + mat(k, 53) = mat(k, 53) - dti(k) + mat(k, 54) = mat(k, 54) - dti(k) + mat(k, 55) = mat(k, 55) - dti(k) + mat(k, 56) = mat(k, 56) - dti(k) + mat(k, 57) = mat(k, 57) - dti(k) + mat(k, 58) = mat(k, 58) - dti(k) + mat(k, 59) = mat(k, 59) - dti(k) + mat(k, 60) = mat(k, 60) - dti(k) + mat(k, 61) = mat(k, 61) - dti(k) + mat(k, 62) = mat(k, 62) - dti(k) + mat(k, 63) = mat(k, 63) - dti(k) + mat(k, 64) = mat(k, 64) - dti(k) + mat(k, 65) = mat(k, 65) - dti(k) + mat(k, 71) = mat(k, 71) - dti(k) + mat(k, 73) = mat(k, 73) - dti(k) + mat(k, 74) = mat(k, 74) - dti(k) + mat(k, 75) = mat(k, 75) - dti(k) + mat(k, 76) = mat(k, 76) - dti(k) + mat(k, 77) = mat(k, 77) - dti(k) + mat(k, 78) = mat(k, 78) - dti(k) + mat(k, 84) = mat(k, 84) - dti(k) + mat(k, 90) = mat(k, 90) - dti(k) + mat(k, 96) = mat(k, 96) - dti(k) + mat(k, 97) = mat(k, 97) - dti(k) + mat(k, 98) = mat(k, 98) - dti(k) + mat(k, 99) = mat(k, 99) - dti(k) + mat(k, 100) = mat(k, 100) - dti(k) + mat(k, 101) = mat(k, 101) - dti(k) + mat(k, 107) = mat(k, 107) - dti(k) + mat(k, 113) = mat(k, 113) - dti(k) + mat(k, 115) = mat(k, 115) - dti(k) + mat(k, 116) = mat(k, 116) - dti(k) + mat(k, 122) = mat(k, 122) - dti(k) + mat(k, 128) = mat(k, 128) - dti(k) + mat(k, 134) = mat(k, 134) - dti(k) + mat(k, 140) = mat(k, 140) - dti(k) + mat(k, 141) = mat(k, 141) - dti(k) + mat(k, 144) = mat(k, 144) - dti(k) + mat(k, 147) = mat(k, 147) - dti(k) + mat(k, 150) = mat(k, 150) - dti(k) + mat(k, 153) = mat(k, 153) - dti(k) + mat(k, 157) = mat(k, 157) - dti(k) + mat(k, 161) = mat(k, 161) - dti(k) + mat(k, 165) = mat(k, 165) - dti(k) + mat(k, 169) = mat(k, 169) - dti(k) + mat(k, 173) = mat(k, 173) - dti(k) + mat(k, 176) = mat(k, 176) - dti(k) + mat(k, 179) = mat(k, 179) - dti(k) + mat(k, 182) = mat(k, 182) - dti(k) + mat(k, 185) = mat(k, 185) - dti(k) + mat(k, 190) = mat(k, 190) - dti(k) + mat(k, 195) = mat(k, 195) - dti(k) + mat(k, 200) = mat(k, 200) - dti(k) + mat(k, 205) = mat(k, 205) - dti(k) + mat(k, 208) = mat(k, 208) - dti(k) + mat(k, 214) = mat(k, 214) - dti(k) + mat(k, 218) = mat(k, 218) - dti(k) + mat(k, 223) = mat(k, 223) - dti(k) + mat(k, 226) = mat(k, 226) - dti(k) + mat(k, 229) = mat(k, 229) - dti(k) + mat(k, 236) = mat(k, 236) - dti(k) + mat(k, 241) = mat(k, 241) - dti(k) + mat(k, 245) = mat(k, 245) - dti(k) + mat(k, 248) = mat(k, 248) - dti(k) + mat(k, 254) = mat(k, 254) - dti(k) + mat(k, 262) = mat(k, 262) - dti(k) + mat(k, 267) = mat(k, 267) - dti(k) + mat(k, 270) = mat(k, 270) - dti(k) + mat(k, 273) = mat(k, 273) - dti(k) + mat(k, 276) = mat(k, 276) - dti(k) + mat(k, 279) = mat(k, 279) - dti(k) + mat(k, 282) = mat(k, 282) - dti(k) + mat(k, 287) = mat(k, 287) - dti(k) + mat(k, 292) = mat(k, 292) - dti(k) + mat(k, 297) = mat(k, 297) - dti(k) + mat(k, 302) = mat(k, 302) - dti(k) + mat(k, 307) = mat(k, 307) - dti(k) + mat(k, 311) = mat(k, 311) - dti(k) + mat(k, 315) = mat(k, 315) - dti(k) + mat(k, 319) = mat(k, 319) - dti(k) + mat(k, 325) = mat(k, 325) - dti(k) + mat(k, 331) = mat(k, 331) - dti(k) + mat(k, 334) = mat(k, 334) - dti(k) + mat(k, 340) = mat(k, 340) - dti(k) + mat(k, 346) = mat(k, 346) - dti(k) + mat(k, 349) = mat(k, 349) - dti(k) + mat(k, 356) = mat(k, 356) - dti(k) + mat(k, 362) = mat(k, 362) - dti(k) + mat(k, 367) = mat(k, 367) - dti(k) + mat(k, 373) = mat(k, 373) - dti(k) + mat(k, 378) = mat(k, 378) - dti(k) + mat(k, 383) = mat(k, 383) - dti(k) + mat(k, 388) = mat(k, 388) - dti(k) + mat(k, 393) = mat(k, 393) - dti(k) + mat(k, 398) = mat(k, 398) - dti(k) + mat(k, 401) = mat(k, 401) - dti(k) + mat(k, 409) = mat(k, 409) - dti(k) + mat(k, 417) = mat(k, 417) - dti(k) + mat(k, 425) = mat(k, 425) - dti(k) + mat(k, 431) = mat(k, 431) - dti(k) + mat(k, 437) = mat(k, 437) - dti(k) + mat(k, 443) = mat(k, 443) - dti(k) + mat(k, 449) = mat(k, 449) - dti(k) + mat(k, 455) = mat(k, 455) - dti(k) + mat(k, 461) = mat(k, 461) - dti(k) + mat(k, 467) = mat(k, 467) - dti(k) + mat(k, 473) = mat(k, 473) - dti(k) + mat(k, 481) = mat(k, 481) - dti(k) + mat(k, 487) = mat(k, 487) - dti(k) + mat(k, 493) = mat(k, 493) - dti(k) + mat(k, 500) = mat(k, 500) - dti(k) + mat(k, 506) = mat(k, 506) - dti(k) + mat(k, 509) = mat(k, 509) - dti(k) + mat(k, 514) = mat(k, 514) - dti(k) + mat(k, 521) = mat(k, 521) - dti(k) + mat(k, 528) = mat(k, 528) - dti(k) + mat(k, 535) = mat(k, 535) - dti(k) + mat(k, 541) = mat(k, 541) - dti(k) + mat(k, 548) = mat(k, 548) - dti(k) + mat(k, 556) = mat(k, 556) - dti(k) + mat(k, 563) = mat(k, 563) - dti(k) + mat(k, 569) = mat(k, 569) - dti(k) + mat(k, 575) = mat(k, 575) - dti(k) + mat(k, 580) = mat(k, 580) - dti(k) + mat(k, 588) = mat(k, 588) - dti(k) + mat(k, 596) = mat(k, 596) - dti(k) + mat(k, 604) = mat(k, 604) - dti(k) + mat(k, 612) = mat(k, 612) - dti(k) + mat(k, 620) = mat(k, 620) - dti(k) + mat(k, 628) = mat(k, 628) - dti(k) + mat(k, 637) = mat(k, 637) - dti(k) + mat(k, 644) = mat(k, 644) - dti(k) + mat(k, 651) = mat(k, 651) - dti(k) + mat(k, 662) = mat(k, 662) - dti(k) + mat(k, 671) = mat(k, 671) - dti(k) + mat(k, 680) = mat(k, 680) - dti(k) + mat(k, 684) = mat(k, 684) - dti(k) + mat(k, 692) = mat(k, 692) - dti(k) + mat(k, 699) = mat(k, 699) - dti(k) + mat(k, 710) = mat(k, 710) - dti(k) + mat(k, 721) = mat(k, 721) - dti(k) + mat(k, 728) = mat(k, 728) - dti(k) + mat(k, 739) = mat(k, 739) - dti(k) + mat(k, 749) = mat(k, 749) - dti(k) + mat(k, 755) = mat(k, 755) - dti(k) + mat(k, 766) = mat(k, 766) - dti(k) + mat(k, 777) = mat(k, 777) - dti(k) + mat(k, 784) = mat(k, 784) - dti(k) + mat(k, 795) = mat(k, 795) - dti(k) + mat(k, 811) = mat(k, 811) - dti(k) + mat(k, 822) = mat(k, 822) - dti(k) + mat(k, 832) = mat(k, 832) - dti(k) + mat(k, 841) = mat(k, 841) - dti(k) + mat(k, 849) = mat(k, 849) - dti(k) + mat(k, 857) = mat(k, 857) - dti(k) + mat(k, 862) = mat(k, 862) - dti(k) + mat(k, 873) = mat(k, 873) - dti(k) + mat(k, 880) = mat(k, 880) - dti(k) + mat(k, 889) = mat(k, 889) - dti(k) + mat(k, 897) = mat(k, 897) - dti(k) + mat(k, 909) = mat(k, 909) - dti(k) + mat(k, 920) = mat(k, 920) - dti(k) + mat(k, 936) = mat(k, 936) - dti(k) + mat(k, 942) = mat(k, 942) - dti(k) + mat(k, 950) = mat(k, 950) - dti(k) + mat(k, 959) = mat(k, 959) - dti(k) + mat(k, 969) = mat(k, 969) - dti(k) + mat(k, 979) = mat(k, 979) - dti(k) + mat(k, 991) = mat(k, 991) - dti(k) + mat(k,1006) = mat(k,1006) - dti(k) + mat(k,1027) = mat(k,1027) - dti(k) + mat(k,1043) = mat(k,1043) - dti(k) + mat(k,1062) = mat(k,1062) - dti(k) + mat(k,1086) = mat(k,1086) - dti(k) + mat(k,1098) = mat(k,1098) - dti(k) + mat(k,1106) = mat(k,1106) - dti(k) + mat(k,1116) = mat(k,1116) - dti(k) + mat(k,1124) = mat(k,1124) - dti(k) + mat(k,1134) = mat(k,1134) - dti(k) + mat(k,1150) = mat(k,1150) - dti(k) + mat(k,1163) = mat(k,1163) - dti(k) + mat(k,1177) = mat(k,1177) - dti(k) + mat(k,1195) = mat(k,1195) - dti(k) + mat(k,1204) = mat(k,1204) - dti(k) + mat(k,1210) = mat(k,1210) - dti(k) + mat(k,1222) = mat(k,1222) - dti(k) + mat(k,1239) = mat(k,1239) - dti(k) + mat(k,1252) = mat(k,1252) - dti(k) + mat(k,1261) = mat(k,1261) - dti(k) + mat(k,1277) = mat(k,1277) - dti(k) + mat(k,1297) = mat(k,1297) - dti(k) + mat(k,1313) = mat(k,1313) - dti(k) + mat(k,1325) = mat(k,1325) - dti(k) + mat(k,1343) = mat(k,1343) - dti(k) + mat(k,1376) = mat(k,1376) - dti(k) + mat(k,1400) = mat(k,1400) - dti(k) + mat(k,1420) = mat(k,1420) - dti(k) + mat(k,1441) = mat(k,1441) - dti(k) + mat(k,1472) = mat(k,1472) - dti(k) + mat(k,1494) = mat(k,1494) - dti(k) + mat(k,1505) = mat(k,1505) - dti(k) + mat(k,1520) = mat(k,1520) - dti(k) + mat(k,1539) = mat(k,1539) - dti(k) + mat(k,1555) = mat(k,1555) - dti(k) + mat(k,1586) = mat(k,1586) - dti(k) + mat(k,1609) = mat(k,1609) - dti(k) + mat(k,1636) = mat(k,1636) - dti(k) + mat(k,1681) = mat(k,1681) - dti(k) + mat(k,1788) = mat(k,1788) - dti(k) + mat(k,1832) = mat(k,1832) - dti(k) + mat(k,2006) = mat(k,2006) - dti(k) + mat(k,2067) = mat(k,2067) - dti(k) + mat(k,2093) = mat(k,2093) - dti(k) + mat(k,2214) = mat(k,2214) - dti(k) + mat(k,2261) = mat(k,2261) - dti(k) + mat(k,2283) = mat(k,2283) - dti(k) + mat(k,2307) = mat(k,2307) - dti(k) + mat(k,2360) = mat(k,2360) - dti(k) + mat(k,2425) = mat(k,2425) - dti(k) + mat(k,2469) = mat(k,2469) - dti(k) + mat(k,2496) = mat(k,2496) - dti(k) + mat(k,2524) = mat(k,2524) - 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 nlnmat08( avec_len, mat, y, rxt ) + call nlnmat09( avec_len, mat, y, rxt ) + call nlnmat10( avec_len, mat, y, rxt ) + call nlnmat11( 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_waccm_tsmlt_mam5_vbsext/mo_phtadj.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_phtadj.F90 new file mode 100644 index 0000000000..6a03fe4d4b --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_phtadj.F90 @@ -0,0 +1,33 @@ + 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,112) = p_rate(:,k,112) * inv(:,k, 2) * im(:,k) + p_rate(:,k,113) = p_rate(:,k,113) * inv(:,k, 2) * im(:,k) + p_rate(:,k,114) = p_rate(:,k,114) * inv(:,k, 2) * im(:,k) + p_rate(:,k,115) = p_rate(:,k,115) * inv(:,k, 2) * im(:,k) + p_rate(:,k,116) = p_rate(:,k,116) * inv(:,k, 2) * im(:,k) + p_rate(:,k,117) = p_rate(:,k,117) * inv(:,k, 2) * im(:,k) + p_rate(:,k,118) = p_rate(:,k,118) * inv(:,k, 2) * im(:,k) + p_rate(:,k,119) = p_rate(:,k,119) * inv(:,k, 2) * im(:,k) + end do + end subroutine phtadj + end module mo_phtadj diff --git a/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_prod_loss.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_prod_loss.F90 new file mode 100644 index 0000000000..0d38183ca3 --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_prod_loss.F90 @@ -0,0 +1,1424 @@ + 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,231))* y(k,231) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,232))* y(k,232) + 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,191) = (rxt(k,416)* y(k,265) + rxt(k,20) + het_rates(k,1))* y(k,1) + prod(k,191) =rxt(k,419)*y(k,234)*y(k,131) + loss(k,192) = (rxt(k,420)* y(k,265) + rxt(k,21) + het_rates(k,2))* y(k,2) + prod(k,192) =rxt(k,417)*y(k,247)*y(k,234) + loss(k,1) = ( + het_rates(k,3))* y(k,3) + prod(k,1) = 0._r8 + loss(k,2) = ( + het_rates(k,4))* y(k,4) + prod(k,2) = 0._r8 + loss(k,3) = ( + het_rates(k,5))* y(k,5) + prod(k,3) = 0._r8 + loss(k,225) = (rxt(k,499)* y(k,133) +rxt(k,500)* y(k,143) +rxt(k,501) & + * y(k,265) + het_rates(k,6))* y(k,6) + prod(k,225) = 0._r8 + loss(k,75) = (rxt(k,555)* y(k,131) +rxt(k,554)* y(k,247) + het_rates(k,7)) & + * y(k,7) + prod(k,75) =rxt(k,557)*y(k,265)*y(k,6) + loss(k,107) = (rxt(k,458)* y(k,265) + het_rates(k,8))* y(k,8) + prod(k,107) = 0._r8 + loss(k,81) = (rxt(k,560)* y(k,131) +rxt(k,559)* y(k,247) + het_rates(k,9)) & + * y(k,9) + prod(k,81) =rxt(k,558)*y(k,265)*y(k,8) + loss(k,155) = (rxt(k,461)* y(k,265) + rxt(k,22) + het_rates(k,10))* y(k,10) + prod(k,155) =rxt(k,459)*y(k,247)*y(k,235) + loss(k,108) = ( + rxt(k,23) + het_rates(k,11))* y(k,11) + prod(k,108) =.120_r8*rxt(k,458)*y(k,265)*y(k,8) + loss(k,158) = ( + rxt(k,24) + het_rates(k,12))* y(k,12) + prod(k,158) = (.100_r8*rxt(k,500)*y(k,6) +.100_r8*rxt(k,503)*y(k,116)) & + *y(k,143) + loss(k,164) = ( + rxt(k,25) + het_rates(k,13))* y(k,13) + prod(k,164) = (.500_r8*rxt(k,460)*y(k,235) +.200_r8*rxt(k,487)*y(k,272) + & + .060_r8*rxt(k,493)*y(k,274))*y(k,131) +.500_r8*rxt(k,22)*y(k,10) & + +rxt(k,23)*y(k,11) +.200_r8*rxt(k,71)*y(k,222) +.060_r8*rxt(k,73) & + *y(k,227) + loss(k,134) = ( + rxt(k,26) + het_rates(k,14))* y(k,14) + prod(k,134) = (.200_r8*rxt(k,487)*y(k,272) +.200_r8*rxt(k,493)*y(k,274)) & + *y(k,131) +.200_r8*rxt(k,71)*y(k,222) +.200_r8*rxt(k,73)*y(k,227) + loss(k,188) = ( + rxt(k,27) + het_rates(k,15))* y(k,15) + prod(k,188) = (.200_r8*rxt(k,487)*y(k,272) +.150_r8*rxt(k,493)*y(k,274)) & + *y(k,131) +rxt(k,47)*y(k,96) +rxt(k,57)*y(k,123) +.200_r8*rxt(k,71) & + *y(k,222) +.150_r8*rxt(k,73)*y(k,227) + loss(k,144) = ( + rxt(k,28) + het_rates(k,16))* y(k,16) + prod(k,144) =.210_r8*rxt(k,493)*y(k,274)*y(k,131) +.210_r8*rxt(k,73)*y(k,227) + loss(k,120) = (rxt(k,421)* y(k,265) + het_rates(k,17))* y(k,17) + prod(k,120) = (.050_r8*rxt(k,500)*y(k,6) +.050_r8*rxt(k,503)*y(k,116)) & + *y(k,143) + loss(k,149) = (rxt(k,387)* y(k,133) +rxt(k,388)* y(k,265) + het_rates(k,18)) & + * y(k,18) + prod(k,149) = 0._r8 + loss(k,256) = (rxt(k,270)* y(k,44) +rxt(k,272)* y(k,143) +rxt(k,271) & + * y(k,247) + het_rates(k,19))* y(k,19) + prod(k,256) = (rxt(k,76) +2.000_r8*rxt(k,273)*y(k,21) +rxt(k,274)*y(k,61) + & + rxt(k,275)*y(k,61) +rxt(k,278)*y(k,131) +rxt(k,281)*y(k,141) + & + rxt(k,282)*y(k,265) +rxt(k,529)*y(k,161))*y(k,21) & + + (rxt(k,260)*y(k,36) +rxt(k,286)*y(k,37) + & + 3.000_r8*rxt(k,287)*y(k,57) +2.000_r8*rxt(k,288)*y(k,80) + & + rxt(k,289)*y(k,83) +2.000_r8*rxt(k,309)*y(k,43) +rxt(k,310)*y(k,45)) & + *y(k,261) + (rxt(k,284)*y(k,83) +2.000_r8*rxt(k,298)*y(k,43) + & + rxt(k,300)*y(k,45) +3.000_r8*rxt(k,305)*y(k,57))*y(k,265) & + + (2.000_r8*rxt(k,297)*y(k,43) +rxt(k,299)*y(k,45) + & + 3.000_r8*rxt(k,304)*y(k,57))*y(k,58) + (rxt(k,100) + & + rxt(k,283)*y(k,141))*y(k,83) +rxt(k,75)*y(k,20) +rxt(k,78)*y(k,22) & + +rxt(k,80)*y(k,36) +rxt(k,81)*y(k,37) +2.000_r8*rxt(k,87)*y(k,43) & + +rxt(k,88)*y(k,45) +3.000_r8*rxt(k,91)*y(k,57) +2.000_r8*rxt(k,99) & + *y(k,80) +rxt(k,106)*y(k,93) + loss(k,121) = ( + rxt(k,75) + het_rates(k,20))* y(k,20) + prod(k,121) = (rxt(k,594)*y(k,93) +rxt(k,599)*y(k,93))*y(k,87) & + +rxt(k,276)*y(k,61)*y(k,21) + loss(k,258) = (2._r8*rxt(k,273)* y(k,21) + (rxt(k,274) +rxt(k,275) + & + rxt(k,276))* y(k,61) +rxt(k,278)* y(k,131) +rxt(k,279)* y(k,132) & + +rxt(k,281)* y(k,141) +rxt(k,529)* y(k,161) +rxt(k,277)* y(k,247) & + +rxt(k,282)* y(k,265) + rxt(k,76) + het_rates(k,21))* y(k,21) + prod(k,258) = (rxt(k,77) +rxt(k,280)*y(k,141))*y(k,22) +rxt(k,272)*y(k,143) & + *y(k,19) +rxt(k,290)*y(k,261)*y(k,83) +rxt(k,285)*y(k,141)*y(k,93) + loss(k,179) = (rxt(k,280)* y(k,141) + rxt(k,77) + rxt(k,78) + rxt(k,588) & + + rxt(k,591) + rxt(k,596) + het_rates(k,22))* y(k,22) + prod(k,179) =rxt(k,279)*y(k,132)*y(k,21) + loss(k,4) = ( + het_rates(k,23))* y(k,23) + prod(k,4) = 0._r8 + loss(k,123) = (rxt(k,462)* y(k,265) + het_rates(k,24))* y(k,24) + prod(k,123) =rxt(k,29)*y(k,25) +rxt(k,465)*y(k,236)*y(k,131) + loss(k,142) = (rxt(k,464)* y(k,265) + rxt(k,29) + het_rates(k,25))* y(k,25) + prod(k,142) =rxt(k,463)*y(k,247)*y(k,236) + loss(k,133) = (rxt(k,335)* y(k,58) +rxt(k,336)* y(k,265) + het_rates(k,26)) & + * y(k,26) + prod(k,133) = 0._r8 + loss(k,181) = (rxt(k,337)* y(k,58) +rxt(k,338)* y(k,143) +rxt(k,363) & + * y(k,265) + het_rates(k,27))* y(k,27) + prod(k,181) = 0._r8 + loss(k,130) = (rxt(k,343)* y(k,265) + het_rates(k,28))* y(k,28) + prod(k,130) = (.400_r8*rxt(k,339)*y(k,237) +.200_r8*rxt(k,340)*y(k,241)) & + *y(k,237) + loss(k,143) = (rxt(k,344)* y(k,265) + rxt(k,30) + het_rates(k,29))* y(k,29) + prod(k,143) =rxt(k,341)*y(k,247)*y(k,237) + loss(k,135) = (rxt(k,345)* y(k,58) +rxt(k,346)* y(k,265) + het_rates(k,30)) & + * y(k,30) + prod(k,135) = 0._r8 + loss(k,234) = (rxt(k,366)* y(k,133) +rxt(k,367)* y(k,143) +rxt(k,385) & + * y(k,265) + het_rates(k,31))* y(k,31) + prod(k,234) =.130_r8*rxt(k,445)*y(k,143)*y(k,100) +.700_r8*rxt(k,56)*y(k,118) + loss(k,153) = (rxt(k,371)* y(k,265) + rxt(k,31) + het_rates(k,32))* y(k,32) + prod(k,153) =rxt(k,369)*y(k,247)*y(k,238) + loss(k,136) = (rxt(k,375)* y(k,58) +rxt(k,372)* y(k,265) + het_rates(k,33)) & + * y(k,33) + prod(k,136) = 0._r8 + loss(k,131) = (rxt(k,468)* y(k,265) + rxt(k,32) + het_rates(k,34))* y(k,34) + prod(k,131) =rxt(k,466)*y(k,247)*y(k,239) + loss(k,90) = (rxt(k,259)* y(k,261) + rxt(k,79) + het_rates(k,35))* y(k,35) + prod(k,90) = 0._r8 + loss(k,102) = (rxt(k,260)* y(k,261) + rxt(k,80) + het_rates(k,36))* y(k,36) + prod(k,102) = 0._r8 + loss(k,103) = (rxt(k,286)* y(k,261) + rxt(k,81) + het_rates(k,37))* y(k,37) + prod(k,103) = 0._r8 + loss(k,93) = (rxt(k,261)* y(k,261) + rxt(k,82) + het_rates(k,38))* y(k,38) + prod(k,93) = 0._r8 + loss(k,104) = (rxt(k,262)* y(k,261) + rxt(k,83) + het_rates(k,39))* y(k,39) + prod(k,104) = 0._r8 + loss(k,94) = (rxt(k,263)* y(k,261) + rxt(k,84) + het_rates(k,40))* y(k,40) + prod(k,94) = 0._r8 + loss(k,105) = (rxt(k,264)* y(k,261) + rxt(k,85) + het_rates(k,41))* y(k,41) + prod(k,105) = 0._r8 + loss(k,95) = (rxt(k,265)* y(k,261) + rxt(k,86) + het_rates(k,42))* y(k,42) + prod(k,95) = 0._r8 + loss(k,166) = (rxt(k,297)* y(k,58) +rxt(k,309)* y(k,261) +rxt(k,298) & + * y(k,265) + rxt(k,87) + het_rates(k,43))* y(k,43) + prod(k,166) = 0._r8 + loss(k,273) = (rxt(k,270)* y(k,19) +rxt(k,234)* y(k,58) +rxt(k,315)* y(k,133) & + +rxt(k,316)* y(k,141) +rxt(k,314)* y(k,247) +rxt(k,317)* y(k,265) & + + rxt(k,33) + rxt(k,34) + het_rates(k,44))* y(k,44) + prod(k,273) = (rxt(k,241)*y(k,61) +2.000_r8*rxt(k,318)*y(k,241) + & + rxt(k,319)*y(k,241) +rxt(k,321)*y(k,131) + & + .700_r8*rxt(k,340)*y(k,237) +rxt(k,351)*y(k,240) + & + rxt(k,368)*y(k,238) +.800_r8*rxt(k,381)*y(k,269) + & + .880_r8*rxt(k,393)*y(k,251) +2.000_r8*rxt(k,402)*y(k,253) + & + 1.500_r8*rxt(k,426)*y(k,249) +.750_r8*rxt(k,431)*y(k,250) + & + .800_r8*rxt(k,440)*y(k,103) +.800_r8*rxt(k,451)*y(k,273) + & + .750_r8*rxt(k,505)*y(k,260) +.930_r8*rxt(k,510)*y(k,270) + & + .950_r8*rxt(k,515)*y(k,271))*y(k,241) & + + (.500_r8*rxt(k,357)*y(k,246) +rxt(k,379)*y(k,268) + & + rxt(k,383)*y(k,269) +.500_r8*rxt(k,389)*y(k,244) + & + .250_r8*rxt(k,396)*y(k,251) +rxt(k,405)*y(k,253) + & + .100_r8*rxt(k,418)*y(k,234) +.920_r8*rxt(k,428)*y(k,249) + & + .250_r8*rxt(k,453)*y(k,273) +.340_r8*rxt(k,512)*y(k,270) + & + .320_r8*rxt(k,517)*y(k,271))*y(k,131) + (rxt(k,322)*y(k,54) + & + .300_r8*rxt(k,323)*y(k,55) +.500_r8*rxt(k,355)*y(k,53) + & + .800_r8*rxt(k,360)*y(k,76) +rxt(k,362)*y(k,148) + & + .500_r8*rxt(k,411)*y(k,115) +.400_r8*rxt(k,416)*y(k,1) + & + .300_r8*rxt(k,436)*y(k,101) +.680_r8*rxt(k,521)*y(k,221))*y(k,265) & + + (rxt(k,338)*y(k,27) +.500_r8*rxt(k,367)*y(k,31) + & + .120_r8*rxt(k,398)*y(k,111) +.600_r8*rxt(k,412)*y(k,118) + & + .910_r8*rxt(k,445)*y(k,100) +.340_r8*rxt(k,500)*y(k,6) + & + .340_r8*rxt(k,503)*y(k,116))*y(k,143) + (.500_r8*rxt(k,387)*y(k,18) + & + .250_r8*rxt(k,395)*y(k,251) +rxt(k,406)*y(k,253) + & + rxt(k,429)*y(k,249))*y(k,133) + (.250_r8*rxt(k,392)*y(k,251) + & + rxt(k,401)*y(k,253) +rxt(k,425)*y(k,249) + & + .250_r8*rxt(k,450)*y(k,273))*y(k,240) + (.180_r8*rxt(k,40) + & + rxt(k,331)*y(k,261) +rxt(k,332)*y(k,261))*y(k,56) & + + (.150_r8*rxt(k,382)*y(k,269) +.450_r8*rxt(k,403)*y(k,253)) & + *y(k,247) +.100_r8*rxt(k,20)*y(k,1) +.100_r8*rxt(k,21)*y(k,2) & + +rxt(k,39)*y(k,55) +rxt(k,44)*y(k,76) +.330_r8*rxt(k,46)*y(k,95) & + +rxt(k,48)*y(k,97) +rxt(k,50)*y(k,106) +1.340_r8*rxt(k,51)*y(k,111) & + +rxt(k,58)*y(k,134) +rxt(k,63)*y(k,157) +rxt(k,64)*y(k,158) & + +.375_r8*rxt(k,66)*y(k,217) +.400_r8*rxt(k,68)*y(k,219) & + +.680_r8*rxt(k,70)*y(k,221) +2.000_r8*rxt(k,358)*y(k,245) & + +rxt(k,328)*y(k,248) +2.000_r8*rxt(k,404)*y(k,253)*y(k,253) + loss(k,182) = (rxt(k,299)* y(k,58) +rxt(k,310)* y(k,261) +rxt(k,300) & + * y(k,265) + rxt(k,88) + het_rates(k,45))* y(k,45) + prod(k,182) = 0._r8 + loss(k,96) = (rxt(k,301)* y(k,265) + rxt(k,89) + het_rates(k,46))* y(k,46) + prod(k,96) = 0._r8 + loss(k,235) = (rxt(k,347)* y(k,133) +rxt(k,348)* y(k,265) + rxt(k,35) & + + het_rates(k,47))* y(k,47) + prod(k,235) = (rxt(k,342)*y(k,237) +.270_r8*rxt(k,370)*y(k,238) + & + rxt(k,379)*y(k,268) +rxt(k,389)*y(k,244) +rxt(k,408)*y(k,255) + & + .400_r8*rxt(k,418)*y(k,234))*y(k,131) + (rxt(k,343)*y(k,28) + & + .500_r8*rxt(k,344)*y(k,29) +.800_r8*rxt(k,416)*y(k,1))*y(k,265) & + + (.500_r8*rxt(k,367)*y(k,31) +.100_r8*rxt(k,412)*y(k,118))*y(k,143) & + + (1.600_r8*rxt(k,339)*y(k,237) +.800_r8*rxt(k,340)*y(k,241)) & + *y(k,237) +.400_r8*rxt(k,20)*y(k,1) +.400_r8*rxt(k,21)*y(k,2) & + +rxt(k,387)*y(k,133)*y(k,18) +rxt(k,30)*y(k,29) +.330_r8*rxt(k,46) & + *y(k,95) +rxt(k,54)*y(k,114) +rxt(k,63)*y(k,157) & + +.200_r8*rxt(k,407)*y(k,255)*y(k,247) + loss(k,148) = (rxt(k,302)* y(k,58) +rxt(k,303)* y(k,265) + rxt(k,90) & + + het_rates(k,48))* y(k,48) + prod(k,148) = 0._r8 + loss(k,91) = (rxt(k,349)* y(k,265) + het_rates(k,49))* y(k,49) + prod(k,91) = 0._r8 + loss(k,230) = (rxt(k,386)* y(k,265) + rxt(k,36) + het_rates(k,50))* y(k,50) + prod(k,230) = (.820_r8*rxt(k,370)*y(k,238) +.500_r8*rxt(k,389)*y(k,244) + & + .250_r8*rxt(k,418)*y(k,234) +.270_r8*rxt(k,512)*y(k,270) + & + .040_r8*rxt(k,517)*y(k,271))*y(k,131) & + + (.820_r8*rxt(k,368)*y(k,238) +.150_r8*rxt(k,510)*y(k,270) + & + .025_r8*rxt(k,515)*y(k,271))*y(k,241) + (.250_r8*rxt(k,20) + & + .800_r8*rxt(k,416)*y(k,265))*y(k,1) + (.520_r8*rxt(k,500)*y(k,6) + & + .520_r8*rxt(k,503)*y(k,116))*y(k,143) + (.500_r8*rxt(k,70) + & + .500_r8*rxt(k,521)*y(k,265))*y(k,221) +.250_r8*rxt(k,21)*y(k,2) & + +.500_r8*rxt(k,387)*y(k,133)*y(k,18) +.820_r8*rxt(k,31)*y(k,32) & + +.170_r8*rxt(k,46)*y(k,95) +.300_r8*rxt(k,66)*y(k,217) & + +.050_r8*rxt(k,68)*y(k,219) + loss(k,245) = (rxt(k,373)* y(k,133) +rxt(k,374)* y(k,265) + rxt(k,37) & + + het_rates(k,51))* y(k,51) + prod(k,245) = (.250_r8*rxt(k,396)*y(k,251) +.050_r8*rxt(k,434)*y(k,250) + & + .250_r8*rxt(k,453)*y(k,273) +.170_r8*rxt(k,471)*y(k,242) + & + .170_r8*rxt(k,477)*y(k,254) +.400_r8*rxt(k,487)*y(k,272) + & + .540_r8*rxt(k,493)*y(k,274) +.510_r8*rxt(k,496)*y(k,275))*y(k,131) & + + (.250_r8*rxt(k,395)*y(k,251) +.050_r8*rxt(k,435)*y(k,250) + & + .250_r8*rxt(k,454)*y(k,273))*y(k,133) & + + (.500_r8*rxt(k,381)*y(k,269) +.240_r8*rxt(k,393)*y(k,251) + & + .100_r8*rxt(k,451)*y(k,273))*y(k,241) & + + (.880_r8*rxt(k,398)*y(k,111) +.500_r8*rxt(k,412)*y(k,118)) & + *y(k,143) + (.250_r8*rxt(k,392)*y(k,251) + & + .250_r8*rxt(k,450)*y(k,273))*y(k,240) & + + (.070_r8*rxt(k,470)*y(k,242) +.070_r8*rxt(k,476)*y(k,254)) & + *y(k,247) + (rxt(k,376)*y(k,97) +rxt(k,377)*y(k,134))*y(k,265) & + +.180_r8*rxt(k,24)*y(k,12) +rxt(k,28)*y(k,16) +.400_r8*rxt(k,71) & + *y(k,222) +.540_r8*rxt(k,73)*y(k,227) +.510_r8*rxt(k,74)*y(k,230) + loss(k,196) = (rxt(k,354)* y(k,265) + het_rates(k,52))* y(k,52) + prod(k,196) = (.100_r8*rxt(k,351)*y(k,241) +.150_r8*rxt(k,352)*y(k,247)) & + *y(k,240) +.120_r8*rxt(k,367)*y(k,143)*y(k,31) & + +.150_r8*rxt(k,403)*y(k,253)*y(k,247) + loss(k,183) = (rxt(k,355)* y(k,265) + rxt(k,38) + het_rates(k,53))* y(k,53) + prod(k,183) = (.400_r8*rxt(k,352)*y(k,240) +.400_r8*rxt(k,403)*y(k,253)) & + *y(k,247) + loss(k,207) = (rxt(k,322)* y(k,265) + het_rates(k,54))* y(k,54) + prod(k,207) = (rxt(k,319)*y(k,241) +.300_r8*rxt(k,340)*y(k,237) + & + .500_r8*rxt(k,381)*y(k,269) +.250_r8*rxt(k,393)*y(k,251) + & + .250_r8*rxt(k,426)*y(k,249) +.250_r8*rxt(k,431)*y(k,250) + & + .200_r8*rxt(k,440)*y(k,103) +.300_r8*rxt(k,451)*y(k,273) + & + .250_r8*rxt(k,505)*y(k,260) +.250_r8*rxt(k,510)*y(k,270) + & + .250_r8*rxt(k,515)*y(k,271))*y(k,241) + loss(k,156) = (rxt(k,323)* y(k,265) + rxt(k,39) + het_rates(k,55))* y(k,55) + prod(k,156) =rxt(k,320)*y(k,247)*y(k,241) + loss(k,265) = (rxt(k,235)* y(k,58) +rxt(k,291)* y(k,75) + (rxt(k,330) + & + rxt(k,331) +rxt(k,332))* y(k,261) +rxt(k,324)* y(k,265) + rxt(k,40) & + + rxt(k,41) + het_rates(k,56))* y(k,56) + prod(k,265) =.100_r8*rxt(k,367)*y(k,143)*y(k,31) + loss(k,157) = (rxt(k,304)* y(k,58) +rxt(k,287)* y(k,261) +rxt(k,305) & + * y(k,265) + rxt(k,91) + het_rates(k,57))* y(k,57) + prod(k,157) = 0._r8 + loss(k,267) = (rxt(k,345)* y(k,30) +rxt(k,375)* y(k,33) +rxt(k,297)* y(k,43) & + +rxt(k,234)* y(k,44) +rxt(k,299)* y(k,45) +rxt(k,302)* y(k,48) & + +rxt(k,235)* y(k,56) +rxt(k,304)* y(k,57) +rxt(k,247)* y(k,62) & + +rxt(k,236)* y(k,79) +rxt(k,237)* y(k,81) +rxt(k,256)* y(k,94) & + +rxt(k,240)* y(k,143) + (rxt(k,238) +rxt(k,239))* y(k,247) & + + het_rates(k,58))* y(k,58) + prod(k,267) = (4.000_r8*rxt(k,259)*y(k,35) +rxt(k,260)*y(k,36) + & + 2.000_r8*rxt(k,261)*y(k,38) +2.000_r8*rxt(k,262)*y(k,39) + & + 2.000_r8*rxt(k,263)*y(k,40) +rxt(k,264)*y(k,41) + & + 2.000_r8*rxt(k,265)*y(k,42) +rxt(k,266)*y(k,87) +rxt(k,296)*y(k,67) + & + rxt(k,311)*y(k,84) +rxt(k,312)*y(k,85) +rxt(k,313)*y(k,86))*y(k,261) & + + (rxt(k,94) +rxt(k,241)*y(k,241) +2.000_r8*rxt(k,242)*y(k,61) + & + rxt(k,244)*y(k,61) +rxt(k,246)*y(k,131) +rxt(k,251)*y(k,141) + & + rxt(k,252)*y(k,265) +rxt(k,275)*y(k,21) +rxt(k,530)*y(k,161))*y(k,61) & + + (rxt(k,255)*y(k,87) +3.000_r8*rxt(k,301)*y(k,46) + & + rxt(k,303)*y(k,48) +rxt(k,306)*y(k,84) +rxt(k,307)*y(k,85) + & + rxt(k,308)*y(k,86))*y(k,265) + (rxt(k,104) +rxt(k,254)*y(k,141)) & + *y(k,87) +rxt(k,75)*y(k,20) +4.000_r8*rxt(k,79)*y(k,35) +rxt(k,80) & + *y(k,36) +2.000_r8*rxt(k,82)*y(k,38) +2.000_r8*rxt(k,83)*y(k,39) & + +2.000_r8*rxt(k,84)*y(k,40) +rxt(k,85)*y(k,41) +2.000_r8*rxt(k,86) & + *y(k,42) +3.000_r8*rxt(k,89)*y(k,46) +rxt(k,90)*y(k,48) & + +2.000_r8*rxt(k,92)*y(k,59) +2.000_r8*rxt(k,93)*y(k,60) +rxt(k,95) & + *y(k,62) +rxt(k,98)*y(k,67) +rxt(k,101)*y(k,84) +rxt(k,102)*y(k,85) & + +rxt(k,103)*y(k,86) +rxt(k,107)*y(k,94) + loss(k,106) = ( + rxt(k,92) + het_rates(k,59))* y(k,59) + prod(k,106) = (rxt(k,587)*y(k,94) +rxt(k,592)*y(k,62) +rxt(k,593)*y(k,94) + & + rxt(k,597)*y(k,62) +rxt(k,598)*y(k,94) +rxt(k,602)*y(k,62))*y(k,87) & + +rxt(k,247)*y(k,62)*y(k,58) +rxt(k,243)*y(k,61)*y(k,61) + loss(k,92) = ( + rxt(k,93) + rxt(k,269) + het_rates(k,60))* y(k,60) + prod(k,92) =rxt(k,268)*y(k,61)*y(k,61) + loss(k,259) = ((rxt(k,274) +rxt(k,275) +rxt(k,276))* y(k,21) & + + 2._r8*(rxt(k,242) +rxt(k,243) +rxt(k,244) +rxt(k,268))* y(k,61) & + +rxt(k,246)* y(k,131) +rxt(k,248)* y(k,132) +rxt(k,251)* y(k,141) & + +rxt(k,530)* y(k,161) +rxt(k,241)* y(k,241) +rxt(k,245)* y(k,247) & + + (rxt(k,252) +rxt(k,253))* y(k,265) + rxt(k,94) + het_rates(k,61)) & + * y(k,61) + prod(k,259) = (rxt(k,239)*y(k,247) +rxt(k,240)*y(k,143) +rxt(k,256)*y(k,94)) & + *y(k,58) + (rxt(k,96) +rxt(k,249)*y(k,141))*y(k,62) & + + (rxt(k,257)*y(k,141) +rxt(k,258)*y(k,265))*y(k,94) + (rxt(k,108) + & + rxt(k,535)*y(k,161))*y(k,145) +2.000_r8*rxt(k,269)*y(k,60) & + +rxt(k,267)*y(k,261)*y(k,87) + loss(k,223) = (rxt(k,247)* y(k,58) + (rxt(k,592) +rxt(k,597) +rxt(k,602)) & + * y(k,87) +rxt(k,249)* y(k,141) +rxt(k,250)* y(k,265) + rxt(k,95) & + + rxt(k,96) + rxt(k,590) + rxt(k,595) + rxt(k,601) & + + het_rates(k,62))* y(k,62) + prod(k,223) =rxt(k,248)*y(k,132)*y(k,61) + loss(k,5) = ( + het_rates(k,63))* y(k,63) + prod(k,5) = 0._r8 + loss(k,236) = (rxt(k,334)* y(k,265) + het_rates(k,64))* y(k,64) + prod(k,236) = (rxt(k,33) +rxt(k,34) +rxt(k,234)*y(k,58) +rxt(k,270)*y(k,19) + & + rxt(k,315)*y(k,133) +rxt(k,316)*y(k,141) +rxt(k,317)*y(k,265)) & + *y(k,44) + (.630_r8*rxt(k,338)*y(k,27) +.560_r8*rxt(k,367)*y(k,31) + & + .650_r8*rxt(k,398)*y(k,111) +.560_r8*rxt(k,412)*y(k,118) + & + .620_r8*rxt(k,445)*y(k,100) +.230_r8*rxt(k,500)*y(k,6) + & + .230_r8*rxt(k,503)*y(k,116))*y(k,143) & + + (.220_r8*rxt(k,396)*y(k,251) +.250_r8*rxt(k,453)*y(k,273) + & + .170_r8*rxt(k,471)*y(k,242) +.400_r8*rxt(k,474)*y(k,252) + & + .350_r8*rxt(k,477)*y(k,254) +.225_r8*rxt(k,512)*y(k,270))*y(k,131) & + + (.350_r8*rxt(k,336)*y(k,26) +rxt(k,361)*y(k,77) + & + rxt(k,374)*y(k,51) +.700_r8*rxt(k,521)*y(k,221) +rxt(k,525)*y(k,146)) & + *y(k,265) + (rxt(k,42) +rxt(k,110) +rxt(k,615)*y(k,266))*y(k,65) & + + (rxt(k,373)*y(k,51) +.220_r8*rxt(k,395)*y(k,251) + & + .500_r8*rxt(k,454)*y(k,273))*y(k,133) & + + (.110_r8*rxt(k,393)*y(k,251) +.200_r8*rxt(k,451)*y(k,273) + & + .125_r8*rxt(k,510)*y(k,270))*y(k,241) & + + (.070_r8*rxt(k,470)*y(k,242) +.160_r8*rxt(k,473)*y(k,252) + & + .140_r8*rxt(k,476)*y(k,254))*y(k,247) + (rxt(k,137) + & + rxt(k,524)*y(k,141))*y(k,146) + (.220_r8*rxt(k,392)*y(k,251) + & + .250_r8*rxt(k,450)*y(k,273))*y(k,240) +1.500_r8*rxt(k,23)*y(k,11) & + +.450_r8*rxt(k,24)*y(k,12) +.600_r8*rxt(k,27)*y(k,15) +rxt(k,28) & + *y(k,16) +rxt(k,35)*y(k,47) +rxt(k,302)*y(k,58)*y(k,48) +rxt(k,37) & + *y(k,51) +.380_r8*rxt(k,40)*y(k,56) +rxt(k,44)*y(k,76) & + +2.000_r8*rxt(k,45)*y(k,77) +.330_r8*rxt(k,46)*y(k,95) & + +1.340_r8*rxt(k,52)*y(k,111) +.700_r8*rxt(k,56)*y(k,118) & + +1.500_r8*rxt(k,65)*y(k,216) +.250_r8*rxt(k,66)*y(k,217) +rxt(k,69) & + *y(k,220) +1.700_r8*rxt(k,70)*y(k,221) + loss(k,252) = (rxt(k,615)* y(k,266) + rxt(k,42) + rxt(k,110) & + + het_rates(k,65))* y(k,65) + prod(k,252) = (rxt(k,326)*y(k,89) +rxt(k,334)*y(k,64) +rxt(k,354)*y(k,52) + & + .500_r8*rxt(k,355)*y(k,53) +.800_r8*rxt(k,360)*y(k,76) + & + rxt(k,361)*y(k,77) +.500_r8*rxt(k,411)*y(k,115) + & + 1.800_r8*rxt(k,521)*y(k,221))*y(k,265) & + + (2.000_r8*rxt(k,350)*y(k,240) +.900_r8*rxt(k,351)*y(k,241) + & + rxt(k,353)*y(k,131) +2.000_r8*rxt(k,401)*y(k,253) + & + rxt(k,425)*y(k,249) +rxt(k,450)*y(k,273))*y(k,240) & + + (.200_r8*rxt(k,367)*y(k,31) +.100_r8*rxt(k,412)*y(k,118) + & + .270_r8*rxt(k,500)*y(k,6) +.270_r8*rxt(k,503)*y(k,116))*y(k,143) & + + (rxt(k,402)*y(k,241) +.450_r8*rxt(k,403)*y(k,247) + & + 2.000_r8*rxt(k,404)*y(k,253))*y(k,253) & + + (.500_r8*rxt(k,510)*y(k,241) +.900_r8*rxt(k,512)*y(k,131)) & + *y(k,270) +rxt(k,38)*y(k,53) +.440_r8*rxt(k,40)*y(k,56) & + +.400_r8*rxt(k,61)*y(k,148) +rxt(k,66)*y(k,217) +.800_r8*rxt(k,70) & + *y(k,221) + loss(k,119) = (rxt(k,295)* y(k,261) + rxt(k,97) + het_rates(k,66))* y(k,66) + prod(k,119) = (rxt(k,260)*y(k,36) +rxt(k,262)*y(k,39) + & + 2.000_r8*rxt(k,263)*y(k,40) +2.000_r8*rxt(k,264)*y(k,41) + & + rxt(k,265)*y(k,42) +rxt(k,286)*y(k,37) +2.000_r8*rxt(k,288)*y(k,80) + & + rxt(k,312)*y(k,85) +rxt(k,313)*y(k,86))*y(k,261) + (rxt(k,102) + & + rxt(k,307)*y(k,265))*y(k,85) + (rxt(k,103) +rxt(k,308)*y(k,265)) & + *y(k,86) +rxt(k,80)*y(k,36) +rxt(k,81)*y(k,37) +rxt(k,83)*y(k,39) & + +2.000_r8*rxt(k,84)*y(k,40) +2.000_r8*rxt(k,85)*y(k,41) +rxt(k,86) & + *y(k,42) +2.000_r8*rxt(k,99)*y(k,80) + loss(k,126) = (rxt(k,296)* y(k,261) + rxt(k,98) + het_rates(k,67))* y(k,67) + prod(k,126) = (rxt(k,101) +rxt(k,306)*y(k,265) +rxt(k,311)*y(k,261))*y(k,84) & + + (rxt(k,82) +rxt(k,261)*y(k,261))*y(k,38) + (rxt(k,83) + & + rxt(k,262)*y(k,261))*y(k,39) + loss(k,113) = (rxt(k,469)* y(k,265) + het_rates(k,68))* y(k,68) + prod(k,113) =.180_r8*rxt(k,489)*y(k,265)*y(k,223) + loss(k,138) = (rxt(k,522)* y(k,133) + (rxt(k,523) +rxt(k,537))* y(k,265) & + + het_rates(k,69))* y(k,69) + prod(k,138) = 0._r8 + loss(k,6) = ( + het_rates(k,70))* y(k,70) + prod(k,6) = 0._r8 + loss(k,7) = ( + het_rates(k,71))* y(k,71) + prod(k,7) = 0._r8 + loss(k,8) = ( + het_rates(k,72))* y(k,72) + prod(k,8) = 0._r8 + loss(k,9) = ( + rxt(k,618) + het_rates(k,73))* y(k,73) + prod(k,9) = 0._r8 + loss(k,100) = ( + rxt(k,43) + het_rates(k,74))* y(k,74) + prod(k,100) =rxt(k,356)*y(k,247)*y(k,246) + loss(k,219) = (rxt(k,291)* y(k,56) +rxt(k,292)* y(k,79) +rxt(k,294)* y(k,91) & + +rxt(k,293)* y(k,276) + het_rates(k,75))* y(k,75) + prod(k,219) = (rxt(k,264)*y(k,41) +rxt(k,286)*y(k,37) + & + 2.000_r8*rxt(k,295)*y(k,66) +rxt(k,296)*y(k,67))*y(k,261) +rxt(k,81) & + *y(k,37) +rxt(k,85)*y(k,41) +2.000_r8*rxt(k,97)*y(k,66) +rxt(k,98) & + *y(k,67) +rxt(k,105)*y(k,90) + loss(k,237) = (rxt(k,360)* y(k,265) + rxt(k,44) + het_rates(k,76))* y(k,76) + prod(k,237) = (.530_r8*rxt(k,396)*y(k,251) +.050_r8*rxt(k,434)*y(k,250) + & + .250_r8*rxt(k,453)*y(k,273) +.225_r8*rxt(k,512)*y(k,270))*y(k,131) & + + (.530_r8*rxt(k,395)*y(k,251) +.050_r8*rxt(k,435)*y(k,250) + & + .250_r8*rxt(k,454)*y(k,273))*y(k,133) & + + (.260_r8*rxt(k,393)*y(k,251) +.100_r8*rxt(k,451)*y(k,273) + & + .125_r8*rxt(k,510)*y(k,270))*y(k,241) & + + (.700_r8*rxt(k,436)*y(k,101) +.500_r8*rxt(k,437)*y(k,102) + & + rxt(k,448)*y(k,122))*y(k,265) + (.530_r8*rxt(k,392)*y(k,251) + & + .250_r8*rxt(k,450)*y(k,273))*y(k,240) +.330_r8*rxt(k,46)*y(k,95) & + +rxt(k,359)*y(k,245)*y(k,142) +.250_r8*rxt(k,66)*y(k,217) + loss(k,227) = (rxt(k,361)* y(k,265) + rxt(k,45) + rxt(k,582) & + + het_rates(k,77))* y(k,77) + prod(k,227) = (.050_r8*rxt(k,434)*y(k,250) +.250_r8*rxt(k,453)*y(k,273) + & + rxt(k,460)*y(k,235) +.400_r8*rxt(k,474)*y(k,252) + & + .170_r8*rxt(k,477)*y(k,254) +.700_r8*rxt(k,480)*y(k,267) + & + .600_r8*rxt(k,487)*y(k,272) +.340_r8*rxt(k,493)*y(k,274) + & + .170_r8*rxt(k,496)*y(k,275))*y(k,131) + (.650_r8*rxt(k,336)*y(k,26) + & + .200_r8*rxt(k,360)*y(k,76) +rxt(k,449)*y(k,123))*y(k,265) & + + (.250_r8*rxt(k,450)*y(k,240) +.100_r8*rxt(k,451)*y(k,241) + & + .250_r8*rxt(k,454)*y(k,133))*y(k,273) & + + (.160_r8*rxt(k,473)*y(k,252) +.070_r8*rxt(k,476)*y(k,254)) & + *y(k,247) +rxt(k,22)*y(k,10) +.130_r8*rxt(k,24)*y(k,12) & + +.050_r8*rxt(k,435)*y(k,250)*y(k,133) +.700_r8*rxt(k,62)*y(k,152) & + +.600_r8*rxt(k,71)*y(k,222) +.340_r8*rxt(k,73)*y(k,227) & + +.170_r8*rxt(k,74)*y(k,230) + loss(k,268) = (rxt(k,195)* y(k,142) +rxt(k,198)* y(k,143) + (rxt(k,192) + & + rxt(k,193) +rxt(k,194))* y(k,247) + het_rates(k,78))* y(k,78) + prod(k,268) = (rxt(k,199)*y(k,79) +rxt(k,202)*y(k,141) +rxt(k,222)*y(k,119) + & + rxt(k,317)*y(k,44) +rxt(k,525)*y(k,146) +rxt(k,531)*y(k,159) + & + rxt(k,536)*y(k,161))*y(k,265) + (rxt(k,173)*y(k,261) + & + rxt(k,190)*y(k,141) +rxt(k,236)*y(k,58) +rxt(k,292)*y(k,75))*y(k,79) & + + (.330_r8*rxt(k,40) +rxt(k,41) +rxt(k,331)*y(k,261))*y(k,56) & + + (rxt(k,100) +rxt(k,290)*y(k,261))*y(k,83) + (rxt(k,104) + & + rxt(k,267)*y(k,261))*y(k,87) + (2.000_r8*rxt(k,2) +rxt(k,3))*y(k,276) & + +2.000_r8*rxt(k,34)*y(k,44) +rxt(k,39)*y(k,55) +rxt(k,105)*y(k,90) + loss(k,253) = (rxt(k,236)* y(k,58) +rxt(k,292)* y(k,75) +rxt(k,190)* y(k,141) & + +rxt(k,173)* y(k,261) +rxt(k,199)* y(k,265) + het_rates(k,79)) & + * y(k,79) + prod(k,253) = (1.440_r8*rxt(k,40) +rxt(k,332)*y(k,261))*y(k,56) +rxt(k,33) & + *y(k,44) +rxt(k,192)*y(k,247)*y(k,78) +rxt(k,1)*y(k,276) + loss(k,97) = (rxt(k,288)* y(k,261) + rxt(k,99) + het_rates(k,80))* y(k,80) + prod(k,97) = 0._r8 + loss(k,184) = (rxt(k,237)* y(k,58) +rxt(k,191)* y(k,141) +rxt(k,200) & + * y(k,265) + rxt(k,4) + het_rates(k,81))* y(k,81) + prod(k,184) =rxt(k,206)*y(k,247)*y(k,247) +rxt(k,205)*y(k,265)*y(k,265) + loss(k,99) = ( + rxt(k,136) + het_rates(k,82))* y(k,82) + prod(k,99) =rxt(k,538)*y(k,276)*y(k,163) + loss(k,210) = (rxt(k,283)* y(k,141) + (rxt(k,289) +rxt(k,290))* y(k,261) & + +rxt(k,284)* y(k,265) + rxt(k,100) + het_rates(k,83))* y(k,83) + prod(k,210) = (rxt(k,270)*y(k,44) +rxt(k,271)*y(k,247))*y(k,19) + loss(k,125) = (rxt(k,311)* y(k,261) +rxt(k,306)* y(k,265) + rxt(k,101) & + + het_rates(k,84))* y(k,84) + prod(k,125) = 0._r8 + loss(k,127) = (rxt(k,312)* y(k,261) +rxt(k,307)* y(k,265) + rxt(k,102) & + + het_rates(k,85))* y(k,85) + prod(k,127) = 0._r8 + loss(k,139) = (rxt(k,313)* y(k,261) +rxt(k,308)* y(k,265) + rxt(k,103) & + + het_rates(k,86))* y(k,86) + prod(k,139) = 0._r8 + loss(k,255) = ((rxt(k,592) +rxt(k,597) +rxt(k,602))* y(k,62) + (rxt(k,594) + & + rxt(k,599))* y(k,93) + (rxt(k,587) +rxt(k,593) +rxt(k,598))* y(k,94) & + +rxt(k,254)* y(k,141) + (rxt(k,266) +rxt(k,267))* y(k,261) & + +rxt(k,255)* y(k,265) + rxt(k,104) + het_rates(k,87))* y(k,87) + prod(k,255) = (rxt(k,234)*y(k,44) +rxt(k,235)*y(k,56) +rxt(k,236)*y(k,79) + & + rxt(k,237)*y(k,81) +rxt(k,238)*y(k,247) +rxt(k,256)*y(k,94) + & + rxt(k,297)*y(k,43) +rxt(k,299)*y(k,45) +2.000_r8*rxt(k,302)*y(k,48) + & + rxt(k,304)*y(k,57) +rxt(k,345)*y(k,30) +rxt(k,375)*y(k,33))*y(k,58) & + +rxt(k,253)*y(k,265)*y(k,61) + loss(k,116) = (rxt(k,333)* y(k,261) +rxt(k,325)* y(k,265) + het_rates(k,88)) & + * y(k,88) + prod(k,116) = 0._r8 + loss(k,216) = (rxt(k,326)* y(k,265) + het_rates(k,89))* y(k,89) + prod(k,216) = (.370_r8*rxt(k,338)*y(k,27) +.120_r8*rxt(k,367)*y(k,31) + & + .330_r8*rxt(k,398)*y(k,111) +.120_r8*rxt(k,412)*y(k,118) + & + .110_r8*rxt(k,445)*y(k,100) +.050_r8*rxt(k,500)*y(k,6) + & + .050_r8*rxt(k,503)*y(k,116))*y(k,143) + (rxt(k,327)*y(k,247) + & + rxt(k,329)*y(k,131))*y(k,248) +.350_r8*rxt(k,336)*y(k,265)*y(k,26) + loss(k,137) = ( + rxt(k,105) + het_rates(k,90))* y(k,90) + prod(k,137) = (rxt(k,291)*y(k,56) +rxt(k,292)*y(k,79) +rxt(k,293)*y(k,276) + & + rxt(k,294)*y(k,91))*y(k,75) + loss(k,269) = (rxt(k,294)* y(k,75) +rxt(k,231)* y(k,265) + rxt(k,9) & + + het_rates(k,91))* y(k,91) + prod(k,269) = (rxt(k,590) +rxt(k,595) +rxt(k,601) +rxt(k,592)*y(k,87) + & + rxt(k,597)*y(k,87) +rxt(k,602)*y(k,87))*y(k,62) + (rxt(k,549) + & + rxt(k,315)*y(k,44) +rxt(k,347)*y(k,47) +rxt(k,373)*y(k,51) + & + rxt(k,522)*y(k,69))*y(k,133) + (2.000_r8*rxt(k,544) + & + 2.000_r8*rxt(k,586) +2.000_r8*rxt(k,589) +2.000_r8*rxt(k,600)) & + *y(k,121) + (rxt(k,588) +rxt(k,591) +rxt(k,596))*y(k,22) & + + (.500_r8*rxt(k,548) +rxt(k,230)*y(k,265))*y(k,132) +rxt(k,541) & + *y(k,95) +rxt(k,542)*y(k,101) +rxt(k,543)*y(k,102) +rxt(k,545) & + *y(k,122) +rxt(k,546)*y(k,123) +rxt(k,550)*y(k,135) +rxt(k,551) & + *y(k,147) +rxt(k,552)*y(k,218) + loss(k,167) = (rxt(k,207)* y(k,265) + rxt(k,10) + rxt(k,11) + rxt(k,232) & + + het_rates(k,92))* y(k,92) + prod(k,167) =rxt(k,228)*y(k,247)*y(k,132) + loss(k,205) = ((rxt(k,594) +rxt(k,599))* y(k,87) +rxt(k,285)* y(k,141) & + + rxt(k,106) + het_rates(k,93))* y(k,93) + prod(k,205) = (rxt(k,588) +rxt(k,591) +rxt(k,596))*y(k,22) & + +rxt(k,277)*y(k,247)*y(k,21) + loss(k,209) = (rxt(k,256)* y(k,58) + (rxt(k,587) +rxt(k,593) +rxt(k,598)) & + * y(k,87) +rxt(k,257)* y(k,141) +rxt(k,258)* y(k,265) + rxt(k,107) & + + het_rates(k,94))* y(k,94) + prod(k,209) = (rxt(k,590) +rxt(k,595) +rxt(k,601) +rxt(k,250)*y(k,265)) & + *y(k,62) +rxt(k,245)*y(k,247)*y(k,61) + loss(k,239) = (rxt(k,391)* y(k,265) + rxt(k,46) + rxt(k,541) & + + het_rates(k,95))* y(k,95) + prod(k,239) = (rxt(k,390)*y(k,244) +rxt(k,397)*y(k,251))*y(k,131) & + + (.300_r8*rxt(k,436)*y(k,101) +.500_r8*rxt(k,437)*y(k,102)) & + *y(k,265) + loss(k,124) = (rxt(k,422)* y(k,265) + rxt(k,47) + het_rates(k,96))* y(k,96) + prod(k,124) =rxt(k,433)*y(k,250) + loss(k,240) = (rxt(k,376)* y(k,265) + rxt(k,48) + het_rates(k,97))* y(k,97) + prod(k,240) = (.220_r8*rxt(k,392)*y(k,240) +.230_r8*rxt(k,393)*y(k,241) + & + .220_r8*rxt(k,395)*y(k,133) +.220_r8*rxt(k,396)*y(k,131))*y(k,251) & + + (.500_r8*rxt(k,380)*y(k,157) +.500_r8*rxt(k,411)*y(k,115) + & + .700_r8*rxt(k,436)*y(k,101) +.500_r8*rxt(k,437)*y(k,102))*y(k,265) & + + (.250_r8*rxt(k,450)*y(k,240) +.100_r8*rxt(k,451)*y(k,241) + & + .250_r8*rxt(k,453)*y(k,131) +.250_r8*rxt(k,454)*y(k,133))*y(k,273) & + + (.050_r8*rxt(k,434)*y(k,131) +.050_r8*rxt(k,435)*y(k,133)) & + *y(k,250) +.170_r8*rxt(k,46)*y(k,95) +.200_r8*rxt(k,381)*y(k,269) & + *y(k,241) + loss(k,147) = (rxt(k,423)* y(k,265) + het_rates(k,98))* y(k,98) + prod(k,147) = (rxt(k,430)*y(k,240) +.750_r8*rxt(k,431)*y(k,241) + & + .870_r8*rxt(k,434)*y(k,131) +.950_r8*rxt(k,435)*y(k,133))*y(k,250) + loss(k,98) = (rxt(k,424)* y(k,265) + het_rates(k,99))* y(k,99) + prod(k,98) =.600_r8*rxt(k,447)*y(k,265)*y(k,106) + loss(k,214) = (rxt(k,438)* y(k,133) +rxt(k,445)* y(k,143) +rxt(k,446) & + * y(k,265) + het_rates(k,100))* y(k,100) + prod(k,214) = 0._r8 + loss(k,185) = (rxt(k,436)* y(k,265) + rxt(k,542) + het_rates(k,101)) & + * y(k,101) + prod(k,185) =.080_r8*rxt(k,428)*y(k,249)*y(k,131) + loss(k,178) = (rxt(k,437)* y(k,265) + rxt(k,543) + het_rates(k,102)) & + * y(k,102) + prod(k,178) =.080_r8*rxt(k,434)*y(k,250)*y(k,131) + loss(k,243) = (rxt(k,442)* y(k,131) +rxt(k,443)* y(k,133) +rxt(k,439) & + * y(k,240) +rxt(k,440)* y(k,241) +rxt(k,441)* y(k,247) & + + het_rates(k,103))* y(k,103) + prod(k,243) =rxt(k,438)*y(k,133)*y(k,100) + loss(k,154) = (rxt(k,444)* y(k,265) + rxt(k,49) + het_rates(k,104))* y(k,104) + prod(k,154) =rxt(k,441)*y(k,247)*y(k,103) + loss(k,73) = (rxt(k,563)* y(k,131) +rxt(k,562)* y(k,247) + het_rates(k,105)) & + * y(k,105) + prod(k,73) =rxt(k,565)*y(k,265)*y(k,100) + loss(k,197) = (rxt(k,447)* y(k,265) + rxt(k,50) + het_rates(k,106))* y(k,106) + prod(k,197) = (rxt(k,427)*y(k,249) +rxt(k,432)*y(k,250))*y(k,247) +rxt(k,49) & + *y(k,104) + loss(k,67) = (rxt(k,568)* y(k,265) + het_rates(k,107))* y(k,107) + prod(k,67) = 0._r8 + loss(k,66) = (rxt(k,567)* y(k,131) +rxt(k,566)* y(k,247) + het_rates(k,108)) & + * y(k,108) + prod(k,66) =rxt(k,568)*y(k,265)*y(k,107) + loss(k,83) = (rxt(k,571)* y(k,265) + het_rates(k,109))* y(k,109) + prod(k,83) = 0._r8 + loss(k,82) = (rxt(k,570)* y(k,131) +rxt(k,569)* y(k,247) + het_rates(k,110)) & + * y(k,110) + prod(k,82) =rxt(k,571)*y(k,265)*y(k,109) + loss(k,244) = (rxt(k,398)* y(k,143) +rxt(k,399)* y(k,265) + rxt(k,51) & + + rxt(k,52) + het_rates(k,111))* y(k,111) + prod(k,244) = (.390_r8*rxt(k,425)*y(k,240) +.310_r8*rxt(k,426)*y(k,241) + & + .360_r8*rxt(k,428)*y(k,131) +.400_r8*rxt(k,429)*y(k,133))*y(k,249) & + +.300_r8*rxt(k,445)*y(k,143)*y(k,100) +.300_r8*rxt(k,50)*y(k,106) + loss(k,146) = (rxt(k,400)* y(k,265) + het_rates(k,112))* y(k,112) + prod(k,146) =rxt(k,394)*y(k,251)*y(k,247) + loss(k,173) = (rxt(k,409)* y(k,265) + rxt(k,53) + het_rates(k,113))* y(k,113) + prod(k,173) =.800_r8*rxt(k,20)*y(k,1) +.800_r8*rxt(k,21)*y(k,2) & + +.800_r8*rxt(k,418)*y(k,234)*y(k,131) + loss(k,145) = (rxt(k,410)* y(k,265) + rxt(k,54) + het_rates(k,114))* y(k,114) + prod(k,145) =.800_r8*rxt(k,407)*y(k,255)*y(k,247) + loss(k,187) = (rxt(k,411)* y(k,265) + rxt(k,55) + rxt(k,415) & + + het_rates(k,115))* y(k,115) + prod(k,187) =rxt(k,414)*y(k,253)*y(k,132) + loss(k,222) = (rxt(k,502)* y(k,133) +rxt(k,503)* y(k,143) +rxt(k,504) & + * y(k,265) + het_rates(k,116))* y(k,116) + prod(k,222) = 0._r8 + loss(k,74) = (rxt(k,574)* y(k,131) +rxt(k,573)* y(k,247) + het_rates(k,117)) & + * y(k,117) + prod(k,74) =rxt(k,576)*y(k,265)*y(k,116) + loss(k,249) = (rxt(k,412)* y(k,143) +rxt(k,413)* y(k,265) + rxt(k,56) & + + het_rates(k,118))* y(k,118) + prod(k,249) = (.610_r8*rxt(k,425)*y(k,240) +.440_r8*rxt(k,426)*y(k,241) + & + .560_r8*rxt(k,428)*y(k,131) +.600_r8*rxt(k,429)*y(k,133))*y(k,249) & + +.200_r8*rxt(k,445)*y(k,143)*y(k,100) +.700_r8*rxt(k,50)*y(k,106) + loss(k,224) = (rxt(k,210)* y(k,131) + (rxt(k,211) +rxt(k,212) +rxt(k,213)) & + * y(k,132) +rxt(k,214)* y(k,142) +rxt(k,612)* y(k,264) +rxt(k,222) & + * y(k,265) + rxt(k,111) + het_rates(k,119))* y(k,119) + prod(k,224) = (rxt(k,208)*y(k,256) +rxt(k,609)*y(k,259))*y(k,141) & + + (.200_r8*rxt(k,603)*y(k,258) +1.100_r8*rxt(k,605)*y(k,257)) & + *y(k,243) +rxt(k,15)*y(k,131) +rxt(k,610)*y(k,259)*y(k,142) & + +rxt(k,616)*y(k,266) + loss(k,128) = ((rxt(k,226) +rxt(k,227))* y(k,261) + rxt(k,12) & + + het_rates(k,120))* y(k,120) + prod(k,128) =rxt(k,211)*y(k,132)*y(k,119) + loss(k,132) = ( + rxt(k,13) + rxt(k,14) + rxt(k,233) + rxt(k,544) & + + rxt(k,586) + rxt(k,589) + rxt(k,600) + het_rates(k,121))* y(k,121) + prod(k,132) =rxt(k,229)*y(k,133)*y(k,132) + loss(k,162) = (rxt(k,448)* y(k,265) + rxt(k,545) + het_rates(k,122)) & + * y(k,122) + prod(k,162) =.200_r8*rxt(k,440)*y(k,241)*y(k,103) + loss(k,231) = (rxt(k,449)* y(k,265) + rxt(k,57) + rxt(k,546) & + + het_rates(k,123))* y(k,123) + prod(k,231) = (rxt(k,439)*y(k,240) +.800_r8*rxt(k,440)*y(k,241) + & + rxt(k,442)*y(k,131) +rxt(k,443)*y(k,133))*y(k,103) + loss(k,10) = ( + het_rates(k,124))* y(k,124) + prod(k,10) = 0._r8 + loss(k,11) = ( + het_rates(k,125))* y(k,125) + prod(k,11) = 0._r8 + loss(k,12) = ( + het_rates(k,126))* y(k,126) + prod(k,12) = 0._r8 + loss(k,89) = (rxt(k,539)* y(k,265) + het_rates(k,127))* y(k,127) + prod(k,89) = 0._r8 + loss(k,13) = ( + rxt(k,547) + het_rates(k,128))* y(k,128) + prod(k,13) = 0._r8 + loss(k,14) = ( + rxt(k,620) + het_rates(k,129))* y(k,129) + prod(k,14) = 0._r8 + loss(k,15) = ( + rxt(k,619) + het_rates(k,130))* y(k,130) + prod(k,15) = 0._r8 + loss(k,261) = (rxt(k,278)* y(k,21) +rxt(k,246)* y(k,61) +rxt(k,442)* y(k,103) & + +rxt(k,210)* y(k,119) +rxt(k,219)* y(k,133) +rxt(k,225)* y(k,141) & + +rxt(k,224)* y(k,143) +rxt(k,457)* y(k,233) + (rxt(k,418) + & + rxt(k,419))* y(k,234) +rxt(k,460)* y(k,235) +rxt(k,465)* y(k,236) & + +rxt(k,342)* y(k,237) +rxt(k,370)* y(k,238) +rxt(k,467)* y(k,239) & + +rxt(k,353)* y(k,240) +rxt(k,321)* y(k,241) +rxt(k,471)* y(k,242) & + + (rxt(k,389) +rxt(k,390))* y(k,244) +rxt(k,357)* y(k,246) & + +rxt(k,223)* y(k,247) +rxt(k,329)* y(k,248) +rxt(k,428)* y(k,249) & + +rxt(k,434)* y(k,250) + (rxt(k,396) +rxt(k,397))* y(k,251) & + +rxt(k,474)* y(k,252) +rxt(k,405)* y(k,253) +rxt(k,477)* y(k,254) & + +rxt(k,408)* y(k,255) +rxt(k,507)* y(k,260) +rxt(k,614)* y(k,264) & + +rxt(k,480)* y(k,267) +rxt(k,379)* y(k,268) +rxt(k,383)* y(k,269) & + +rxt(k,512)* y(k,270) +rxt(k,517)* y(k,271) +rxt(k,487)* y(k,272) & + +rxt(k,453)* y(k,273) +rxt(k,493)* y(k,274) +rxt(k,496)* y(k,275) & + + rxt(k,15) + rxt(k,16) + het_rates(k,131))* y(k,131) + prod(k,261) = (rxt(k,17) +.500_r8*rxt(k,548) +2.000_r8*rxt(k,212)*y(k,119) + & + rxt(k,215)*y(k,141) +rxt(k,532)*y(k,161))*y(k,132) & + + (rxt(k,214)*y(k,142) +rxt(k,222)*y(k,265))*y(k,119) & + +2.000_r8*rxt(k,226)*y(k,261)*y(k,120) +rxt(k,14)*y(k,121) & + +rxt(k,19)*y(k,133) +rxt(k,209)*y(k,256)*y(k,142) +rxt(k,613) & + *y(k,264) + loss(k,260) = (rxt(k,279)* y(k,21) +rxt(k,248)* y(k,61) + (rxt(k,211) + & + rxt(k,212) +rxt(k,213))* y(k,119) +rxt(k,229)* y(k,133) & + + (rxt(k,215) +rxt(k,217))* y(k,141) +rxt(k,216)* y(k,143) & + +rxt(k,482)* y(k,150) +rxt(k,532)* y(k,161) +rxt(k,485)* y(k,233) & + +rxt(k,364)* y(k,240) +rxt(k,472)* y(k,242) +rxt(k,228)* y(k,247) & + +rxt(k,475)* y(k,252) +rxt(k,414)* y(k,253) +rxt(k,478)* y(k,254) & + +rxt(k,230)* y(k,265) + rxt(k,17) + rxt(k,548) + het_rates(k,132)) & + * y(k,132) + prod(k,260) = (2.000_r8*rxt(k,219)*y(k,133) +rxt(k,223)*y(k,247) + & + rxt(k,224)*y(k,143) +rxt(k,225)*y(k,141) +rxt(k,246)*y(k,61) + & + rxt(k,278)*y(k,21) +rxt(k,321)*y(k,241) +rxt(k,329)*y(k,248) + & + rxt(k,342)*y(k,237) +rxt(k,353)*y(k,240) +rxt(k,357)*y(k,246) + & + rxt(k,370)*y(k,238) +rxt(k,379)*y(k,268) +rxt(k,383)*y(k,269) + & + rxt(k,389)*y(k,244) +rxt(k,396)*y(k,251) +rxt(k,405)*y(k,253) + & + rxt(k,408)*y(k,255) +rxt(k,418)*y(k,234) + & + .920_r8*rxt(k,428)*y(k,249) +.920_r8*rxt(k,434)*y(k,250) + & + rxt(k,442)*y(k,103) +rxt(k,453)*y(k,273) +rxt(k,457)*y(k,233) + & + rxt(k,460)*y(k,235) +rxt(k,465)*y(k,236) +rxt(k,467)*y(k,239) + & + rxt(k,471)*y(k,242) +rxt(k,474)*y(k,252) +rxt(k,477)*y(k,254) + & + rxt(k,480)*y(k,267) +rxt(k,487)*y(k,272) +rxt(k,493)*y(k,274) + & + rxt(k,496)*y(k,275) +1.600_r8*rxt(k,507)*y(k,260) + & + .900_r8*rxt(k,512)*y(k,270) +.800_r8*rxt(k,517)*y(k,271))*y(k,131) & + + (rxt(k,18) +rxt(k,218)*y(k,247) +rxt(k,220)*y(k,141) + & + rxt(k,221)*y(k,265) +rxt(k,387)*y(k,18) +rxt(k,395)*y(k,251) + & + rxt(k,406)*y(k,253) +rxt(k,429)*y(k,249) +rxt(k,435)*y(k,250) + & + rxt(k,443)*y(k,103) +rxt(k,454)*y(k,273) + & + 2.000_r8*rxt(k,508)*y(k,260))*y(k,133) + (rxt(k,207)*y(k,92) + & + rxt(k,377)*y(k,134) +rxt(k,416)*y(k,1) +.700_r8*rxt(k,436)*y(k,101) + & + rxt(k,514)*y(k,218))*y(k,265) + (rxt(k,11) +rxt(k,232))*y(k,92) & + + (rxt(k,55) +rxt(k,415))*y(k,115) + (rxt(k,13) +rxt(k,233)) & + *y(k,121) + (.600_r8*rxt(k,61) +rxt(k,365))*y(k,148) +rxt(k,20) & + *y(k,1) +rxt(k,77)*y(k,22) +rxt(k,96)*y(k,62) +rxt(k,9)*y(k,91) & + +rxt(k,46)*y(k,95) +rxt(k,49)*y(k,104) +rxt(k,57)*y(k,123) & + +rxt(k,58)*y(k,134) +rxt(k,59)*y(k,135) +rxt(k,60)*y(k,147) & + +rxt(k,490)*y(k,149) +rxt(k,67)*y(k,218) & + +.500_r8*rxt(k,505)*y(k,260)*y(k,241) + loss(k,264) = (rxt(k,499)* y(k,6) +rxt(k,387)* y(k,18) +rxt(k,366)* y(k,31) & + +rxt(k,315)* y(k,44) +rxt(k,347)* y(k,47) +rxt(k,373)* y(k,51) & + +rxt(k,522)* y(k,69) +rxt(k,438)* y(k,100) +rxt(k,443)* y(k,103) & + +rxt(k,502)* y(k,116) +rxt(k,219)* y(k,131) +rxt(k,229)* y(k,132) & + +rxt(k,220)* y(k,141) +rxt(k,519)* y(k,220) +rxt(k,218)* y(k,247) & + +rxt(k,429)* y(k,249) +rxt(k,435)* y(k,250) +rxt(k,395)* y(k,251) & + +rxt(k,406)* y(k,253) +rxt(k,508)* y(k,260) +rxt(k,221)* y(k,265) & + +rxt(k,454)* y(k,273) + rxt(k,18) + rxt(k,19) + rxt(k,549) & + + het_rates(k,133))* y(k,133) + prod(k,264) = (rxt(k,95) +rxt(k,247)*y(k,58) +rxt(k,249)*y(k,141) + & + rxt(k,250)*y(k,265))*y(k,62) + (rxt(k,13) +rxt(k,14) +rxt(k,233)) & + *y(k,121) + (rxt(k,231)*y(k,91) +rxt(k,362)*y(k,148) + & + .500_r8*rxt(k,411)*y(k,115))*y(k,265) + (rxt(k,78) + & + rxt(k,280)*y(k,141))*y(k,22) + (rxt(k,216)*y(k,143) + & + rxt(k,217)*y(k,141))*y(k,132) +rxt(k,294)*y(k,91)*y(k,75) +rxt(k,10) & + *y(k,92) +.400_r8*rxt(k,61)*y(k,148) + loss(k,215) = (rxt(k,377)* y(k,265) + rxt(k,58) + het_rates(k,134))* y(k,134) + prod(k,215) = (.500_r8*rxt(k,437)*y(k,102) +rxt(k,444)*y(k,104) + & + rxt(k,448)*y(k,122) +rxt(k,449)*y(k,123))*y(k,265) & + +rxt(k,366)*y(k,133)*y(k,31) + loss(k,152) = (rxt(k,509)* y(k,265) + rxt(k,59) + rxt(k,550) & + + het_rates(k,135))* y(k,135) + prod(k,152) =rxt(k,506)*y(k,260)*y(k,247) + loss(k,16) = ( + het_rates(k,136))* y(k,136) + prod(k,16) = 0._r8 + loss(k,17) = ( + het_rates(k,137))* y(k,137) + prod(k,17) = 0._r8 + loss(k,18) = ( + het_rates(k,138))* y(k,138) + prod(k,18) = 0._r8 + loss(k,19) = ( + het_rates(k,139))* y(k,139) + prod(k,19) = 0._r8 + loss(k,20) = ( + het_rates(k,140))* y(k,140) + prod(k,20) = 0._r8 + loss(k,272) = (rxt(k,281)* y(k,21) +rxt(k,280)* y(k,22) +rxt(k,316)* y(k,44) & + +rxt(k,251)* y(k,61) +rxt(k,249)* y(k,62) +rxt(k,190)* y(k,79) & + +rxt(k,191)* y(k,81) +rxt(k,283)* y(k,83) +rxt(k,254)* y(k,87) & + +rxt(k,285)* y(k,93) +rxt(k,257)* y(k,94) +rxt(k,225)* y(k,131) & + + (rxt(k,215) +rxt(k,217))* y(k,132) +rxt(k,220)* y(k,133) & + + 2._r8*rxt(k,188)* y(k,141) +rxt(k,189)* y(k,142) +rxt(k,187) & + * y(k,143) +rxt(k,524)* y(k,146) +rxt(k,196)* y(k,247) & + + (rxt(k,607) +rxt(k,608))* y(k,257) +rxt(k,609)* y(k,259) & + +rxt(k,202)* y(k,265) + rxt(k,120) + rxt(k,121) + rxt(k,122) & + + rxt(k,123) + rxt(k,124) + rxt(k,125) + het_rates(k,141))* y(k,141) + prod(k,272) = (2.000_r8*rxt(k,5) +rxt(k,6) +rxt(k,127) +rxt(k,128) + & + rxt(k,129) +rxt(k,131) +rxt(k,132) +rxt(k,133) +2.000_r8*rxt(k,134) + & + 2.000_r8*rxt(k,135) +rxt(k,176)*y(k,261) +rxt(k,177)*y(k,261) + & + rxt(k,214)*y(k,119) +rxt(k,526)*y(k,159) +rxt(k,533)*y(k,161) + & + rxt(k,611)*y(k,259) +rxt(k,617)*y(k,266))*y(k,142) & + + (rxt(k,210)*y(k,131) +rxt(k,211)*y(k,132) +rxt(k,612)*y(k,264)) & + *y(k,119) + (rxt(k,42) +rxt(k,110))*y(k,65) + (rxt(k,603)*y(k,258) + & + 1.150_r8*rxt(k,604)*y(k,264))*y(k,243) +rxt(k,76)*y(k,21) & + +.180_r8*rxt(k,40)*y(k,56) +rxt(k,94)*y(k,61) +rxt(k,194)*y(k,247) & + *y(k,78) +rxt(k,14)*y(k,121) +rxt(k,15)*y(k,131) +rxt(k,17)*y(k,132) & + +rxt(k,18)*y(k,133) +rxt(k,8)*y(k,143) +rxt(k,108)*y(k,145) & + +rxt(k,138)*y(k,161) +rxt(k,139)*y(k,162) +rxt(k,140)*y(k,163) & + +rxt(k,175)*y(k,261) +rxt(k,204)*y(k,265)*y(k,265) +rxt(k,2) & + *y(k,276) + loss(k,257) = (rxt(k,195)* y(k,78) +rxt(k,214)* y(k,119) +rxt(k,189) & + * y(k,141) +rxt(k,526)* y(k,159) +rxt(k,533)* y(k,161) +rxt(k,359) & + * y(k,245) +rxt(k,209)* y(k,256) +rxt(k,606)* y(k,257) & + + (rxt(k,610) +rxt(k,611))* y(k,259) +rxt(k,176)* y(k,261) & + +rxt(k,181)* y(k,262) +rxt(k,617)* y(k,266) + rxt(k,5) + rxt(k,6) & + + rxt(k,126) + rxt(k,127) + rxt(k,128) + rxt(k,129) + rxt(k,130) & + + rxt(k,131) + rxt(k,132) + rxt(k,133) + rxt(k,134) + rxt(k,135) & + + het_rates(k,142))* y(k,142) + prod(k,257) = (rxt(k,192)*y(k,78) +rxt(k,196)*y(k,141) + & + 2.000_r8*rxt(k,197)*y(k,143) +rxt(k,201)*y(k,265) + & + rxt(k,206)*y(k,247) +rxt(k,218)*y(k,133) +rxt(k,238)*y(k,58) + & + rxt(k,245)*y(k,61) +rxt(k,271)*y(k,19) +rxt(k,277)*y(k,21) + & + rxt(k,320)*y(k,241) +rxt(k,341)*y(k,237) +rxt(k,369)*y(k,238) + & + rxt(k,378)*y(k,268))*y(k,247) + (rxt(k,8) + & + 2.000_r8*rxt(k,178)*y(k,261) +2.000_r8*rxt(k,187)*y(k,141) + & + rxt(k,198)*y(k,78) +rxt(k,203)*y(k,265) +rxt(k,216)*y(k,132) + & + rxt(k,224)*y(k,131) +rxt(k,240)*y(k,58) +rxt(k,272)*y(k,19) + & + rxt(k,528)*y(k,159) +rxt(k,534)*y(k,161))*y(k,143) & + + (rxt(k,180)*y(k,262) +rxt(k,188)*y(k,141) +rxt(k,202)*y(k,265) + & + rxt(k,215)*y(k,132) +rxt(k,220)*y(k,133) +rxt(k,251)*y(k,61) + & + rxt(k,281)*y(k,21))*y(k,141) + (rxt(k,242)*y(k,61) + & + rxt(k,243)*y(k,61) +rxt(k,253)*y(k,265) +rxt(k,275)*y(k,21) + & + rxt(k,276)*y(k,21))*y(k,61) + (rxt(k,171) +rxt(k,179) + & + 2.000_r8*rxt(k,181)*y(k,142))*y(k,262) +rxt(k,273)*y(k,21)*y(k,21) & + +rxt(k,207)*y(k,265)*y(k,92) +rxt(k,213)*y(k,132)*y(k,119) & + +rxt(k,227)*y(k,261)*y(k,120) +rxt(k,614)*y(k,264)*y(k,131) & + +rxt(k,19)*y(k,133) +rxt(k,172)*y(k,263) + loss(k,271) = (rxt(k,500)* y(k,6) +rxt(k,272)* y(k,19) +rxt(k,338)* y(k,27) & + +rxt(k,367)* y(k,31) +rxt(k,240)* y(k,58) +rxt(k,198)* y(k,78) & + +rxt(k,445)* y(k,100) +rxt(k,398)* y(k,111) +rxt(k,503)* y(k,116) & + +rxt(k,412)* y(k,118) +rxt(k,224)* y(k,131) +rxt(k,216)* y(k,132) & + +rxt(k,187)* y(k,141) +rxt(k,483)* y(k,150) +rxt(k,528)* y(k,159) & + +rxt(k,534)* y(k,161) +rxt(k,197)* y(k,247) +rxt(k,178)* y(k,261) & + +rxt(k,203)* y(k,265) + rxt(k,7) + rxt(k,8) + het_rates(k,143)) & + * y(k,143) + prod(k,271) = (.150_r8*rxt(k,352)*y(k,240) +.150_r8*rxt(k,403)*y(k,253)) & + *y(k,247) +rxt(k,189)*y(k,142)*y(k,141) + loss(k,21) = ( + het_rates(k,144))* y(k,144) + prod(k,21) = 0._r8 + loss(k,140) = (rxt(k,535)* y(k,161) + rxt(k,108) + het_rates(k,145)) & + * y(k,145) + prod(k,140) = (rxt(k,244)*y(k,61) +rxt(k,274)*y(k,21))*y(k,61) + loss(k,150) = (rxt(k,524)* y(k,141) +rxt(k,525)* y(k,265) + rxt(k,137) & + + het_rates(k,146))* y(k,146) + prod(k,150) = 0._r8 + loss(k,122) = ( + rxt(k,60) + rxt(k,551) + het_rates(k,147))* y(k,147) + prod(k,122) =rxt(k,391)*y(k,265)*y(k,95) +.100_r8*rxt(k,512)*y(k,270) & + *y(k,131) + loss(k,176) = (rxt(k,362)* y(k,265) + rxt(k,61) + rxt(k,365) & + + het_rates(k,148))* y(k,148) + prod(k,176) =rxt(k,364)*y(k,240)*y(k,132) + loss(k,101) = ( + rxt(k,490) + het_rates(k,149))* y(k,149) + prod(k,101) =rxt(k,485)*y(k,233)*y(k,132) + loss(k,169) = (rxt(k,482)* y(k,132) +rxt(k,483)* y(k,143) + het_rates(k,150)) & + * y(k,150) + prod(k,169) = (.070_r8*rxt(k,469)*y(k,68) +.060_r8*rxt(k,481)*y(k,151) + & + .070_r8*rxt(k,497)*y(k,229))*y(k,265) +rxt(k,32)*y(k,34) & + +rxt(k,467)*y(k,239)*y(k,131) + loss(k,109) = (rxt(k,481)* y(k,265) + het_rates(k,151))* y(k,151) + prod(k,109) =.530_r8*rxt(k,458)*y(k,265)*y(k,8) + loss(k,141) = (rxt(k,484)* y(k,265) + rxt(k,62) + het_rates(k,152))* y(k,152) + prod(k,141) =rxt(k,479)*y(k,267)*y(k,247) + loss(k,22) = ( + het_rates(k,153))* y(k,153) + prod(k,22) = 0._r8 + loss(k,23) = ( + het_rates(k,154))* y(k,154) + prod(k,23) = 0._r8 + loss(k,24) = ( + het_rates(k,155))* y(k,155) + prod(k,24) = 0._r8 + loss(k,25) = ( + het_rates(k,156))* y(k,156) + prod(k,25) = 0._r8 + loss(k,177) = (rxt(k,380)* y(k,265) + rxt(k,63) + het_rates(k,157))* y(k,157) + prod(k,177) =rxt(k,378)*y(k,268)*y(k,247) + loss(k,151) = (rxt(k,384)* y(k,265) + rxt(k,64) + het_rates(k,158))* y(k,158) + prod(k,151) =.850_r8*rxt(k,382)*y(k,269)*y(k,247) + loss(k,199) = (rxt(k,526)* y(k,142) +rxt(k,528)* y(k,143) +rxt(k,531) & + * y(k,265) + het_rates(k,159))* y(k,159) + prod(k,199) =rxt(k,137)*y(k,146) +rxt(k,138)*y(k,161) + loss(k,26) = ( + rxt(k,109) + het_rates(k,160))* y(k,160) + prod(k,26) = 0._r8 + loss(k,254) = (rxt(k,529)* y(k,21) +rxt(k,530)* y(k,61) +rxt(k,532)* y(k,132) & + +rxt(k,533)* y(k,142) +rxt(k,534)* y(k,143) +rxt(k,535)* y(k,145) & + +rxt(k,536)* y(k,265) + rxt(k,138) + het_rates(k,161))* y(k,161) + prod(k,254) = (rxt(k,526)*y(k,142) +rxt(k,528)*y(k,143) +rxt(k,531)*y(k,265)) & + *y(k,159) +rxt(k,524)*y(k,146)*y(k,141) +rxt(k,139)*y(k,162) + loss(k,221) = (rxt(k,527)* y(k,265) + rxt(k,139) + het_rates(k,162)) & + * y(k,162) + prod(k,221) = (rxt(k,529)*y(k,21) +rxt(k,530)*y(k,61) +rxt(k,532)*y(k,132) + & + rxt(k,533)*y(k,142) +rxt(k,534)*y(k,143) +rxt(k,535)*y(k,145) + & + rxt(k,536)*y(k,265))*y(k,161) + (rxt(k,522)*y(k,133) + & + rxt(k,523)*y(k,265) +.500_r8*rxt(k,537)*y(k,265))*y(k,69) & + +rxt(k,525)*y(k,265)*y(k,146) +rxt(k,140)*y(k,163) + loss(k,129) = (rxt(k,538)* y(k,276) + rxt(k,140) + het_rates(k,163)) & + * y(k,163) + prod(k,129) =rxt(k,136)*y(k,82) +rxt(k,527)*y(k,265)*y(k,162) + loss(k,27) = ( + het_rates(k,164))* y(k,164) + prod(k,27) = 0._r8 + loss(k,28) = ( + het_rates(k,165))* y(k,165) + prod(k,28) = 0._r8 + loss(k,29) = ( + het_rates(k,166))* y(k,166) + prod(k,29) = 0._r8 + loss(k,30) = ( + het_rates(k,167))* y(k,167) + prod(k,30) = 0._r8 + loss(k,31) = ( + rxt(k,141) + het_rates(k,168))* y(k,168) + prod(k,31) = 0._r8 + loss(k,32) = ( + rxt(k,142) + het_rates(k,169))* y(k,169) + prod(k,32) = 0._r8 + loss(k,33) = ( + rxt(k,143) + het_rates(k,170))* y(k,170) + prod(k,33) = 0._r8 + loss(k,34) = ( + rxt(k,144) + het_rates(k,171))* y(k,171) + prod(k,34) = 0._r8 + loss(k,35) = ( + rxt(k,145) + het_rates(k,172))* y(k,172) + prod(k,35) = 0._r8 + loss(k,36) = ( + rxt(k,146) + het_rates(k,173))* y(k,173) + prod(k,36) = 0._r8 + loss(k,37) = ( + rxt(k,147) + het_rates(k,174))* y(k,174) + prod(k,37) = 0._r8 + loss(k,38) = ( + rxt(k,148) + het_rates(k,175))* y(k,175) + prod(k,38) = 0._r8 + loss(k,39) = ( + rxt(k,149) + het_rates(k,176))* y(k,176) + prod(k,39) = 0._r8 + loss(k,40) = ( + rxt(k,150) + het_rates(k,177))* y(k,177) + prod(k,40) = 0._r8 + loss(k,41) = ( + rxt(k,151) + het_rates(k,178))* y(k,178) + prod(k,41) = 0._r8 + loss(k,42) = ( + rxt(k,152) + het_rates(k,179))* y(k,179) + prod(k,42) = 0._r8 + loss(k,43) = ( + rxt(k,153) + het_rates(k,180))* y(k,180) + prod(k,43) = 0._r8 + loss(k,44) = ( + rxt(k,154) + het_rates(k,181))* y(k,181) + prod(k,44) = 0._r8 + loss(k,45) = ( + rxt(k,155) + het_rates(k,182))* y(k,182) + prod(k,45) = 0._r8 + loss(k,46) = ( + rxt(k,156) + het_rates(k,183))* y(k,183) + prod(k,46) = 0._r8 + loss(k,47) = ( + rxt(k,157) + het_rates(k,184))* y(k,184) + prod(k,47) = 0._r8 + loss(k,48) = ( + rxt(k,158) + het_rates(k,185))* y(k,185) + prod(k,48) = 0._r8 + loss(k,49) = ( + rxt(k,159) + het_rates(k,186))* y(k,186) + prod(k,49) = 0._r8 + loss(k,50) = ( + rxt(k,160) + het_rates(k,187))* y(k,187) + prod(k,50) = 0._r8 + loss(k,51) = ( + rxt(k,161) + het_rates(k,188))* y(k,188) + prod(k,51) = 0._r8 + loss(k,52) = ( + rxt(k,162) + het_rates(k,189))* y(k,189) + prod(k,52) = 0._r8 + loss(k,53) = ( + rxt(k,163) + het_rates(k,190))* y(k,190) + prod(k,53) = 0._r8 + loss(k,54) = ( + rxt(k,164) + het_rates(k,191))* y(k,191) + prod(k,54) = 0._r8 + loss(k,55) = ( + rxt(k,165) + het_rates(k,192))* y(k,192) + prod(k,55) = 0._r8 + loss(k,56) = ( + rxt(k,166) + het_rates(k,193))* y(k,193) + prod(k,56) = 0._r8 + loss(k,57) = ( + rxt(k,167) + het_rates(k,194))* y(k,194) + prod(k,57) = 0._r8 + loss(k,58) = ( + rxt(k,168) + het_rates(k,195))* y(k,195) + prod(k,58) = 0._r8 + loss(k,59) = ( + rxt(k,169) + het_rates(k,196))* y(k,196) + prod(k,59) = 0._r8 + loss(k,60) = ( + rxt(k,170) + het_rates(k,197))* y(k,197) + prod(k,60) = 0._r8 + loss(k,61) = ( + het_rates(k,198))* y(k,198) + prod(k,61) = (.2381005_r8*rxt(k,566)*y(k,247) + & + .1056005_r8*rxt(k,567)*y(k,131))*y(k,108) & + +.5931005_r8*rxt(k,577)*y(k,265)*y(k,214) + loss(k,62) = ( + het_rates(k,199))* y(k,199) + prod(k,62) = (.1308005_r8*rxt(k,566)*y(k,247) + & + .1026005_r8*rxt(k,567)*y(k,131))*y(k,108) & + +.1534005_r8*rxt(k,577)*y(k,265)*y(k,214) + loss(k,63) = ( + het_rates(k,200))* y(k,200) + prod(k,63) = (.0348005_r8*rxt(k,566)*y(k,247) + & + .0521005_r8*rxt(k,567)*y(k,131))*y(k,108) & + +.0459005_r8*rxt(k,577)*y(k,265)*y(k,214) + loss(k,64) = ( + het_rates(k,201))* y(k,201) + prod(k,64) = (.0076005_r8*rxt(k,566)*y(k,247) + & + .0143005_r8*rxt(k,567)*y(k,131))*y(k,108) & + +.0085005_r8*rxt(k,577)*y(k,265)*y(k,214) + loss(k,65) = ( + het_rates(k,202))* y(k,202) + prod(k,65) = (.0113005_r8*rxt(k,566)*y(k,247) + & + .0166005_r8*rxt(k,567)*y(k,131))*y(k,108) & + +.0128005_r8*rxt(k,577)*y(k,265)*y(k,214) + loss(k,68) = ( + het_rates(k,203))* y(k,203) + prod(k,68) = (.1279005_r8*rxt(k,555)*y(k,7) + & + .0003005_r8*rxt(k,563)*y(k,105) +.0245005_r8*rxt(k,574)*y(k,117)) & + *y(k,131) + (.2202005_r8*rxt(k,554)*y(k,7) + & + .0031005_r8*rxt(k,562)*y(k,105) +.0508005_r8*rxt(k,573)*y(k,117)) & + *y(k,247) + (.2202005_r8*rxt(k,556)*y(k,6) + & + .0508005_r8*rxt(k,575)*y(k,116))*y(k,143) +rxt(k,582)*y(k,77) + loss(k,69) = ( + het_rates(k,204))* y(k,204) + prod(k,69) = (.1792005_r8*rxt(k,555)*y(k,7) + & + .0003005_r8*rxt(k,563)*y(k,105) +.0082005_r8*rxt(k,574)*y(k,117)) & + *y(k,131) + (.2067005_r8*rxt(k,554)*y(k,7) + & + .0035005_r8*rxt(k,562)*y(k,105) +.1149005_r8*rxt(k,573)*y(k,117)) & + *y(k,247) + (.2067005_r8*rxt(k,556)*y(k,6) + & + .1149005_r8*rxt(k,575)*y(k,116))*y(k,143) + loss(k,70) = ( + het_rates(k,205))* y(k,205) + prod(k,70) = (.0676005_r8*rxt(k,555)*y(k,7) + & + .0073005_r8*rxt(k,563)*y(k,105) +.0772005_r8*rxt(k,574)*y(k,117)) & + *y(k,131) + (.0653005_r8*rxt(k,554)*y(k,7) + & + .0003005_r8*rxt(k,562)*y(k,105) +.0348005_r8*rxt(k,573)*y(k,117)) & + *y(k,247) + (.0653005_r8*rxt(k,556)*y(k,6) + & + .0348005_r8*rxt(k,575)*y(k,116))*y(k,143) + loss(k,71) = ( + het_rates(k,206))* y(k,206) + prod(k,71) = (.079_r8*rxt(k,555)*y(k,7) +.0057005_r8*rxt(k,563)*y(k,105) + & + .0332005_r8*rxt(k,574)*y(k,117))*y(k,131) & + + (.1749305_r8*rxt(k,553)*y(k,6) +.0590245_r8*rxt(k,561)*y(k,100) + & + .1749305_r8*rxt(k,572)*y(k,116))*y(k,133) & + + (.1284005_r8*rxt(k,556)*y(k,6) +.0033005_r8*rxt(k,564)*y(k,100) + & + .0554005_r8*rxt(k,575)*y(k,116))*y(k,143) & + + (.1284005_r8*rxt(k,554)*y(k,7) +.0271005_r8*rxt(k,562)*y(k,105) + & + .0554005_r8*rxt(k,573)*y(k,117))*y(k,247) + loss(k,72) = ( + het_rates(k,207))* y(k,207) + prod(k,72) = (.1254005_r8*rxt(k,555)*y(k,7) + & + .0623005_r8*rxt(k,563)*y(k,105) +.130_r8*rxt(k,574)*y(k,117)) & + *y(k,131) + (.5901905_r8*rxt(k,553)*y(k,6) + & + .0250245_r8*rxt(k,561)*y(k,100) +.5901905_r8*rxt(k,572)*y(k,116)) & + *y(k,133) + (.114_r8*rxt(k,554)*y(k,7) + & + .0474005_r8*rxt(k,562)*y(k,105) +.1278005_r8*rxt(k,573)*y(k,117)) & + *y(k,247) + (.114_r8*rxt(k,556)*y(k,6) + & + .1278005_r8*rxt(k,575)*y(k,116))*y(k,143) + loss(k,76) = ( + het_rates(k,208))* y(k,208) + prod(k,76) = (.0097005_r8*rxt(k,560)*y(k,9) + & + .1056005_r8*rxt(k,570)*y(k,110) +.0154005_r8*rxt(k,581)*y(k,224) + & + .0063005_r8*rxt(k,585)*y(k,228))*y(k,131) & + + (.0023005_r8*rxt(k,559)*y(k,9) +.2381005_r8*rxt(k,569)*y(k,110) + & + .1364005_r8*rxt(k,580)*y(k,224) +.1677005_r8*rxt(k,584)*y(k,228)) & + *y(k,247) +.5931005_r8*rxt(k,578)*y(k,265)*y(k,215) + loss(k,77) = ( + het_rates(k,209))* y(k,209) + prod(k,77) = (.0034005_r8*rxt(k,560)*y(k,9) + & + .1026005_r8*rxt(k,570)*y(k,110) +.0452005_r8*rxt(k,581)*y(k,224) + & + .0237005_r8*rxt(k,585)*y(k,228))*y(k,131) & + + (.0008005_r8*rxt(k,559)*y(k,9) +.1308005_r8*rxt(k,569)*y(k,110) + & + .0101005_r8*rxt(k,580)*y(k,224) +.0174005_r8*rxt(k,584)*y(k,228)) & + *y(k,247) +.1534005_r8*rxt(k,578)*y(k,265)*y(k,215) + loss(k,78) = ( + het_rates(k,210))* y(k,210) + prod(k,78) = (.1579005_r8*rxt(k,560)*y(k,9) + & + .0521005_r8*rxt(k,570)*y(k,110) +.0966005_r8*rxt(k,581)*y(k,224) + & + .0025005_r8*rxt(k,585)*y(k,228))*y(k,131) & + + (.0843005_r8*rxt(k,559)*y(k,9) +.0348005_r8*rxt(k,569)*y(k,110) + & + .0763005_r8*rxt(k,580)*y(k,224) +.086_r8*rxt(k,584)*y(k,228)) & + *y(k,247) +.0459005_r8*rxt(k,578)*y(k,265)*y(k,215) + loss(k,79) = ( + het_rates(k,211))* y(k,211) + prod(k,79) = (.0059005_r8*rxt(k,560)*y(k,9) + & + .0143005_r8*rxt(k,570)*y(k,110) +.0073005_r8*rxt(k,581)*y(k,224) + & + .011_r8*rxt(k,585)*y(k,228))*y(k,131) & + + (.0443005_r8*rxt(k,559)*y(k,9) +.0076005_r8*rxt(k,569)*y(k,110) + & + .2157005_r8*rxt(k,580)*y(k,224) +.0512005_r8*rxt(k,584)*y(k,228)) & + *y(k,247) +.0085005_r8*rxt(k,578)*y(k,265)*y(k,215) + loss(k,80) = ( + het_rates(k,212))* y(k,212) + prod(k,80) = (.0536005_r8*rxt(k,560)*y(k,9) + & + .0166005_r8*rxt(k,570)*y(k,110) +.238_r8*rxt(k,581)*y(k,224) + & + .1185005_r8*rxt(k,585)*y(k,228))*y(k,131) & + + (.1621005_r8*rxt(k,559)*y(k,9) +.0113005_r8*rxt(k,569)*y(k,110) + & + .0738005_r8*rxt(k,580)*y(k,224) +.1598005_r8*rxt(k,584)*y(k,228)) & + *y(k,247) +.0128005_r8*rxt(k,578)*y(k,265)*y(k,215) + loss(k,84) = ( + rxt(k,621) + het_rates(k,213))* y(k,213) + prod(k,84) = 0._r8 + loss(k,85) = (rxt(k,577)* y(k,265) + het_rates(k,214))* y(k,214) + prod(k,85) = 0._r8 + loss(k,86) = (rxt(k,578)* y(k,265) + het_rates(k,215))* y(k,215) + prod(k,86) = 0._r8 + loss(k,114) = ( + rxt(k,65) + het_rates(k,216))* y(k,216) + prod(k,114) = (.100_r8*rxt(k,489)*y(k,223) +.230_r8*rxt(k,491)*y(k,226)) & + *y(k,265) + loss(k,194) = (rxt(k,513)* y(k,265) + rxt(k,66) + het_rates(k,217))* y(k,217) + prod(k,194) =rxt(k,511)*y(k,270)*y(k,247) + loss(k,189) = (rxt(k,514)* y(k,265) + rxt(k,67) + rxt(k,552) & + + het_rates(k,218))* y(k,218) + prod(k,189) = (.200_r8*rxt(k,507)*y(k,260) +.200_r8*rxt(k,517)*y(k,271)) & + *y(k,131) +.500_r8*rxt(k,505)*y(k,260)*y(k,241) + loss(k,168) = (rxt(k,518)* y(k,265) + rxt(k,68) + het_rates(k,219))* y(k,219) + prod(k,168) =rxt(k,516)*y(k,271)*y(k,247) + loss(k,229) = (rxt(k,519)* y(k,133) +rxt(k,520)* y(k,265) + rxt(k,69) & + + het_rates(k,220))* y(k,220) + prod(k,229) = (.500_r8*rxt(k,505)*y(k,241) +.800_r8*rxt(k,507)*y(k,131) + & + rxt(k,508)*y(k,133))*y(k,260) + (.330_r8*rxt(k,500)*y(k,6) + & + .330_r8*rxt(k,503)*y(k,116))*y(k,143) + (rxt(k,67) + & + rxt(k,514)*y(k,265))*y(k,218) + (rxt(k,515)*y(k,241) + & + .800_r8*rxt(k,517)*y(k,131))*y(k,271) +rxt(k,59)*y(k,135) +rxt(k,68) & + *y(k,219) + loss(k,233) = (rxt(k,521)* y(k,265) + rxt(k,70) + het_rates(k,221))* y(k,221) + prod(k,233) = (.300_r8*rxt(k,500)*y(k,6) +.300_r8*rxt(k,503)*y(k,116)) & + *y(k,143) + (rxt(k,510)*y(k,241) +.900_r8*rxt(k,512)*y(k,131)) & + *y(k,270) +rxt(k,66)*y(k,217) +rxt(k,69)*y(k,220) + loss(k,186) = (rxt(k,488)* y(k,265) + rxt(k,71) + het_rates(k,222))* y(k,222) + prod(k,186) =rxt(k,486)*y(k,272)*y(k,247) + loss(k,112) = ((rxt(k,489) +rxt(k,579))* y(k,265) + het_rates(k,223)) & + * y(k,223) + prod(k,112) = 0._r8 + loss(k,87) = (rxt(k,581)* y(k,131) +rxt(k,580)* y(k,247) + het_rates(k,224)) & + * y(k,224) + prod(k,87) =rxt(k,579)*y(k,265)*y(k,223) + loss(k,115) = (rxt(k,455)* y(k,265) + rxt(k,72) + het_rates(k,225))* y(k,225) + prod(k,115) =rxt(k,452)*y(k,273)*y(k,247) + loss(k,117) = (rxt(k,491)* y(k,265) + het_rates(k,226))* y(k,226) + prod(k,117) = 0._r8 + loss(k,198) = (rxt(k,494)* y(k,265) + rxt(k,73) + het_rates(k,227))* y(k,227) + prod(k,198) =rxt(k,492)*y(k,274)*y(k,247) + loss(k,88) = (rxt(k,585)* y(k,131) +rxt(k,584)* y(k,247) + het_rates(k,228)) & + * y(k,228) + prod(k,88) =rxt(k,583)*y(k,265)*y(k,226) + loss(k,118) = (rxt(k,497)* y(k,265) + het_rates(k,229))* y(k,229) + prod(k,118) =.150_r8*rxt(k,491)*y(k,265)*y(k,226) + loss(k,159) = (rxt(k,498)* y(k,265) + rxt(k,74) + het_rates(k,230))* y(k,230) + prod(k,159) =rxt(k,495)*y(k,275)*y(k,247) + loss(k,174) = (rxt(k,457)* y(k,131) +rxt(k,485)* y(k,132) +rxt(k,456) & + * y(k,247) + het_rates(k,233))* y(k,233) + prod(k,174) =rxt(k,462)*y(k,265)*y(k,24) +rxt(k,490)*y(k,149) + loss(k,226) = ((rxt(k,418) +rxt(k,419))* y(k,131) +rxt(k,417)* y(k,247) & + + het_rates(k,234))* y(k,234) + prod(k,226) = (rxt(k,420)*y(k,2) +rxt(k,421)*y(k,17))*y(k,265) + loss(k,170) = (rxt(k,460)* y(k,131) +rxt(k,459)* y(k,247) + het_rates(k,235)) & + * y(k,235) + prod(k,170) = (.350_r8*rxt(k,458)*y(k,8) +rxt(k,461)*y(k,10))*y(k,265) + loss(k,160) = (rxt(k,465)* y(k,131) +rxt(k,463)* y(k,247) + het_rates(k,236)) & + * y(k,236) + prod(k,160) = (rxt(k,464)*y(k,25) +.070_r8*rxt(k,489)*y(k,223) + & + .060_r8*rxt(k,491)*y(k,226))*y(k,265) + loss(k,217) = (rxt(k,342)* y(k,131) + 2._r8*rxt(k,339)* y(k,237) +rxt(k,340) & + * y(k,241) +rxt(k,341)* y(k,247) + het_rates(k,237))* y(k,237) + prod(k,217) = (rxt(k,345)*y(k,58) +rxt(k,346)*y(k,265))*y(k,30) & + +.500_r8*rxt(k,344)*y(k,265)*y(k,29) +rxt(k,53)*y(k,113) + loss(k,220) = (rxt(k,370)* y(k,131) +rxt(k,368)* y(k,241) +rxt(k,369) & + * y(k,247) + het_rates(k,238))* y(k,238) + prod(k,220) = (rxt(k,372)*y(k,265) +rxt(k,375)*y(k,58))*y(k,33) & + +rxt(k,371)*y(k,265)*y(k,32) + loss(k,190) = (rxt(k,467)* y(k,131) +rxt(k,466)* y(k,247) + het_rates(k,239)) & + * y(k,239) + prod(k,190) = (.400_r8*rxt(k,456)*y(k,247) +rxt(k,457)*y(k,131))*y(k,233) & + +rxt(k,468)*y(k,265)*y(k,34) +rxt(k,483)*y(k,150)*y(k,143) + loss(k,251) = (rxt(k,439)* y(k,103) +rxt(k,353)* y(k,131) +rxt(k,364) & + * y(k,132) + 2._r8*rxt(k,350)* y(k,240) +rxt(k,351)* y(k,241) & + +rxt(k,352)* y(k,247) +rxt(k,425)* y(k,249) +rxt(k,430)* y(k,250) & + +rxt(k,392)* y(k,251) +rxt(k,450)* y(k,273) + het_rates(k,240)) & + * y(k,240) + prod(k,251) = (.100_r8*rxt(k,398)*y(k,111) +.280_r8*rxt(k,412)*y(k,118) + & + .080_r8*rxt(k,445)*y(k,100) +.060_r8*rxt(k,500)*y(k,6) + & + .060_r8*rxt(k,503)*y(k,116))*y(k,143) + (rxt(k,402)*y(k,241) + & + .450_r8*rxt(k,403)*y(k,247) +2.000_r8*rxt(k,404)*y(k,253) + & + rxt(k,405)*y(k,131) +rxt(k,406)*y(k,133))*y(k,253) & + + (.530_r8*rxt(k,392)*y(k,240) +.260_r8*rxt(k,393)*y(k,241) + & + .530_r8*rxt(k,395)*y(k,133) +.530_r8*rxt(k,396)*y(k,131))*y(k,251) & + + (rxt(k,348)*y(k,47) +.500_r8*rxt(k,355)*y(k,53) + & + rxt(k,374)*y(k,51) +.650_r8*rxt(k,521)*y(k,221))*y(k,265) & + + (.300_r8*rxt(k,381)*y(k,241) +.150_r8*rxt(k,382)*y(k,247) + & + rxt(k,383)*y(k,131))*y(k,269) + (rxt(k,37) +rxt(k,373)*y(k,133)) & + *y(k,51) + (.600_r8*rxt(k,61) +rxt(k,365))*y(k,148) & + + (.200_r8*rxt(k,407)*y(k,247) +rxt(k,408)*y(k,131))*y(k,255) & + +.130_r8*rxt(k,24)*y(k,12) +rxt(k,28)*y(k,16) +rxt(k,347)*y(k,133) & + *y(k,47) +rxt(k,36)*y(k,50) +.330_r8*rxt(k,46)*y(k,95) +rxt(k,48) & + *y(k,97) +1.340_r8*rxt(k,51)*y(k,111) +rxt(k,53)*y(k,113) +rxt(k,54) & + *y(k,114) +.300_r8*rxt(k,56)*y(k,118) +rxt(k,58)*y(k,134) +rxt(k,64) & + *y(k,158) +.500_r8*rxt(k,65)*y(k,216) +.650_r8*rxt(k,70)*y(k,221) + loss(k,270) = (rxt(k,241)* y(k,61) +rxt(k,440)* y(k,103) +rxt(k,321) & + * y(k,131) +rxt(k,340)* y(k,237) +rxt(k,368)* y(k,238) +rxt(k,351) & + * y(k,240) + 2._r8*(rxt(k,318) +rxt(k,319))* y(k,241) +rxt(k,320) & + * y(k,247) +rxt(k,426)* y(k,249) +rxt(k,431)* y(k,250) +rxt(k,393) & + * y(k,251) +rxt(k,402)* y(k,253) +rxt(k,505)* y(k,260) +rxt(k,381) & + * y(k,269) +rxt(k,510)* y(k,270) +rxt(k,515)* y(k,271) +rxt(k,451) & + * y(k,273) + het_rates(k,241))* y(k,241) + prod(k,270) = (2.000_r8*rxt(k,350)*y(k,240) +.900_r8*rxt(k,351)*y(k,241) + & + .450_r8*rxt(k,352)*y(k,247) +rxt(k,353)*y(k,131) + & + rxt(k,392)*y(k,251) +rxt(k,401)*y(k,253) +rxt(k,425)*y(k,249) + & + rxt(k,430)*y(k,250) +rxt(k,439)*y(k,103) +rxt(k,450)*y(k,273)) & + *y(k,240) + (rxt(k,41) +rxt(k,235)*y(k,58) +rxt(k,291)*y(k,75) + & + rxt(k,324)*y(k,265) +rxt(k,330)*y(k,261))*y(k,56) & + + (.830_r8*rxt(k,471)*y(k,242) +.170_r8*rxt(k,477)*y(k,254)) & + *y(k,131) + (.280_r8*rxt(k,367)*y(k,31) +.050_r8*rxt(k,445)*y(k,100)) & + *y(k,143) + (.330_r8*rxt(k,470)*y(k,242) + & + .070_r8*rxt(k,476)*y(k,254))*y(k,247) + (.700_r8*rxt(k,323)*y(k,55) + & + rxt(k,354)*y(k,52))*y(k,265) +rxt(k,88)*y(k,45) +rxt(k,35)*y(k,47) & + +rxt(k,90)*y(k,48) +rxt(k,36)*y(k,50) +rxt(k,38)*y(k,53) & + +.300_r8*rxt(k,56)*y(k,118) +.400_r8*rxt(k,61)*y(k,148) + loss(k,203) = (rxt(k,471)* y(k,131) +rxt(k,472)* y(k,132) +rxt(k,470) & + * y(k,247) + het_rates(k,242))* y(k,242) + prod(k,203) =.600_r8*rxt(k,26)*y(k,14) + loss(k,213) = (rxt(k,605)* y(k,257) +rxt(k,603)* y(k,258) +rxt(k,604) & + * y(k,264) + het_rates(k,243))* y(k,243) + prod(k,213) = (rxt(k,126) +rxt(k,127) +rxt(k,128) +rxt(k,129) +rxt(k,130) + & + rxt(k,131) +rxt(k,132) +rxt(k,133))*y(k,142) + (rxt(k,120) + & + rxt(k,121) +rxt(k,122) +rxt(k,123) +rxt(k,124) +rxt(k,125))*y(k,141) & + +rxt(k,111)*y(k,119) +rxt(k,16)*y(k,131) + loss(k,180) = ((rxt(k,389) +rxt(k,390))* y(k,131) + het_rates(k,244)) & + * y(k,244) + prod(k,180) =rxt(k,388)*y(k,265)*y(k,18) + loss(k,165) = (rxt(k,359)* y(k,142) + rxt(k,358) + het_rates(k,245)) & + * y(k,245) + prod(k,165) =rxt(k,43)*y(k,74) +.750_r8*rxt(k,357)*y(k,246)*y(k,131) + loss(k,204) = (rxt(k,357)* y(k,131) +rxt(k,356)* y(k,247) + het_rates(k,246)) & + * y(k,246) + prod(k,204) =rxt(k,363)*y(k,265)*y(k,27) + loss(k,266) = (rxt(k,271)* y(k,19) +rxt(k,277)* y(k,21) +rxt(k,314)* y(k,44) & + + (rxt(k,238) +rxt(k,239))* y(k,58) +rxt(k,245)* y(k,61) & + + (rxt(k,192) +rxt(k,193) +rxt(k,194))* y(k,78) +rxt(k,441) & + * y(k,103) +rxt(k,223)* y(k,131) +rxt(k,228)* y(k,132) +rxt(k,218) & + * y(k,133) +rxt(k,196)* y(k,141) +rxt(k,197)* y(k,143) +rxt(k,456) & + * y(k,233) +rxt(k,417)* y(k,234) +rxt(k,459)* y(k,235) +rxt(k,463) & + * y(k,236) +rxt(k,341)* y(k,237) +rxt(k,369)* y(k,238) +rxt(k,466) & + * y(k,239) +rxt(k,352)* y(k,240) +rxt(k,320)* y(k,241) +rxt(k,470) & + * y(k,242) +rxt(k,356)* y(k,246) + 2._r8*rxt(k,206)* y(k,247) & + +rxt(k,327)* y(k,248) +rxt(k,427)* y(k,249) +rxt(k,432)* y(k,250) & + +rxt(k,394)* y(k,251) +rxt(k,473)* y(k,252) +rxt(k,403)* y(k,253) & + +rxt(k,476)* y(k,254) +rxt(k,407)* y(k,255) +rxt(k,506)* y(k,260) & + +rxt(k,201)* y(k,265) +rxt(k,479)* y(k,267) +rxt(k,378)* y(k,268) & + +rxt(k,382)* y(k,269) +rxt(k,511)* y(k,270) +rxt(k,516)* y(k,271) & + +rxt(k,486)* y(k,272) +rxt(k,452)* y(k,273) +rxt(k,492)* y(k,274) & + +rxt(k,495)* y(k,275) + rxt(k,540) + het_rates(k,247))* y(k,247) + prod(k,266) = (rxt(k,200)*y(k,81) +rxt(k,203)*y(k,143) +rxt(k,221)*y(k,133) + & + rxt(k,252)*y(k,61) +rxt(k,282)*y(k,21) +rxt(k,300)*y(k,45) + & + rxt(k,303)*y(k,48) +rxt(k,322)*y(k,54) +rxt(k,325)*y(k,88) + & + rxt(k,326)*y(k,89) +rxt(k,334)*y(k,64) +.350_r8*rxt(k,336)*y(k,26) + & + rxt(k,343)*y(k,28) +rxt(k,349)*y(k,49) +rxt(k,360)*y(k,76) + & + rxt(k,361)*y(k,77) +rxt(k,376)*y(k,97) +rxt(k,391)*y(k,95) + & + .200_r8*rxt(k,400)*y(k,112) +.500_r8*rxt(k,411)*y(k,115) + & + .300_r8*rxt(k,436)*y(k,101) +rxt(k,437)*y(k,102) + & + rxt(k,444)*y(k,104) +rxt(k,448)*y(k,122) +rxt(k,449)*y(k,123) + & + .650_r8*rxt(k,458)*y(k,8) +.730_r8*rxt(k,469)*y(k,68) + & + .800_r8*rxt(k,481)*y(k,151) +.280_r8*rxt(k,489)*y(k,223) + & + .380_r8*rxt(k,491)*y(k,226) +.630_r8*rxt(k,497)*y(k,229) + & + .200_r8*rxt(k,521)*y(k,221) +rxt(k,527)*y(k,162) + & + .500_r8*rxt(k,537)*y(k,69))*y(k,265) + (rxt(k,321)*y(k,241) + & + rxt(k,329)*y(k,248) +rxt(k,342)*y(k,237) + & + .250_r8*rxt(k,357)*y(k,246) +rxt(k,370)*y(k,238) + & + rxt(k,379)*y(k,268) +rxt(k,389)*y(k,244) + & + .470_r8*rxt(k,396)*y(k,251) +rxt(k,418)*y(k,234) + & + .920_r8*rxt(k,428)*y(k,249) +.920_r8*rxt(k,434)*y(k,250) + & + rxt(k,442)*y(k,103) +rxt(k,453)*y(k,273) +rxt(k,460)*y(k,235) + & + rxt(k,465)*y(k,236) +.170_r8*rxt(k,471)*y(k,242) + & + .400_r8*rxt(k,474)*y(k,252) +.830_r8*rxt(k,477)*y(k,254) + & + rxt(k,480)*y(k,267) +rxt(k,487)*y(k,272) +rxt(k,493)*y(k,274) + & + rxt(k,496)*y(k,275) +.900_r8*rxt(k,512)*y(k,270) + & + .800_r8*rxt(k,517)*y(k,271))*y(k,131) + (rxt(k,241)*y(k,61) + & + 2.000_r8*rxt(k,318)*y(k,241) +rxt(k,340)*y(k,237) + & + .900_r8*rxt(k,351)*y(k,240) +rxt(k,368)*y(k,238) + & + .300_r8*rxt(k,381)*y(k,269) +.730_r8*rxt(k,393)*y(k,251) + & + rxt(k,402)*y(k,253) +rxt(k,426)*y(k,249) +rxt(k,431)*y(k,250) + & + 1.200_r8*rxt(k,440)*y(k,103) +.800_r8*rxt(k,451)*y(k,273) + & + .500_r8*rxt(k,505)*y(k,260) +rxt(k,510)*y(k,270) + & + rxt(k,515)*y(k,271))*y(k,241) + (.130_r8*rxt(k,338)*y(k,27) + & + .280_r8*rxt(k,367)*y(k,31) +.140_r8*rxt(k,398)*y(k,111) + & + .280_r8*rxt(k,412)*y(k,118) +.370_r8*rxt(k,445)*y(k,100) + & + .570_r8*rxt(k,500)*y(k,6) +.570_r8*rxt(k,503)*y(k,116))*y(k,143) & + + (rxt(k,315)*y(k,44) +.470_r8*rxt(k,395)*y(k,251) + & + rxt(k,429)*y(k,249) +rxt(k,435)*y(k,250) +rxt(k,443)*y(k,103) + & + rxt(k,454)*y(k,273))*y(k,133) + (.470_r8*rxt(k,392)*y(k,251) + & + rxt(k,425)*y(k,249) +rxt(k,430)*y(k,250) +rxt(k,439)*y(k,103) + & + rxt(k,450)*y(k,273))*y(k,240) + (rxt(k,234)*y(k,44) + & + rxt(k,237)*y(k,81) +rxt(k,299)*y(k,45) +rxt(k,302)*y(k,48))*y(k,58) & + + (.070_r8*rxt(k,470)*y(k,242) +.160_r8*rxt(k,473)*y(k,252) + & + .330_r8*rxt(k,476)*y(k,254))*y(k,247) + (rxt(k,270)*y(k,19) + & + rxt(k,316)*y(k,141))*y(k,44) + (rxt(k,11) +rxt(k,232))*y(k,92) & + + (1.340_r8*rxt(k,51) +.660_r8*rxt(k,52))*y(k,111) & + + (rxt(k,195)*y(k,78) +rxt(k,359)*y(k,245))*y(k,142) +rxt(k,20) & + *y(k,1) +.900_r8*rxt(k,21)*y(k,2) +rxt(k,22)*y(k,10) & + +1.500_r8*rxt(k,23)*y(k,11) +.560_r8*rxt(k,24)*y(k,12) +rxt(k,25) & + *y(k,13) +.600_r8*rxt(k,26)*y(k,14) +.600_r8*rxt(k,27)*y(k,15) & + +rxt(k,28)*y(k,16) +rxt(k,29)*y(k,25) +rxt(k,30)*y(k,29) +rxt(k,31) & + *y(k,32) +rxt(k,35)*y(k,47) +rxt(k,37)*y(k,51) +rxt(k,331)*y(k,261) & + *y(k,56) +2.000_r8*rxt(k,44)*y(k,76) +2.000_r8*rxt(k,45)*y(k,77) & + +rxt(k,191)*y(k,141)*y(k,81) +.670_r8*rxt(k,46)*y(k,95) +rxt(k,47) & + *y(k,96) +rxt(k,48)*y(k,97) +rxt(k,49)*y(k,104) +rxt(k,50)*y(k,106) & + +rxt(k,57)*y(k,123) +rxt(k,62)*y(k,152) +rxt(k,63)*y(k,157) & + +rxt(k,65)*y(k,216) +rxt(k,66)*y(k,217) +rxt(k,67)*y(k,218) & + +rxt(k,68)*y(k,219) +rxt(k,69)*y(k,220) +1.200_r8*rxt(k,70)*y(k,221) & + +rxt(k,71)*y(k,222) +rxt(k,73)*y(k,227) +rxt(k,74)*y(k,230) & + +1.200_r8*rxt(k,339)*y(k,237)*y(k,237) +rxt(k,358)*y(k,245) & + +rxt(k,328)*y(k,248) +rxt(k,433)*y(k,250) + loss(k,161) = (rxt(k,329)* y(k,131) +rxt(k,327)* y(k,247) + rxt(k,328) & + + het_rates(k,248))* y(k,248) + prod(k,161) =rxt(k,314)*y(k,247)*y(k,44) + loss(k,246) = (rxt(k,428)* y(k,131) +rxt(k,429)* y(k,133) +rxt(k,425) & + * y(k,240) +rxt(k,426)* y(k,241) +rxt(k,427)* y(k,247) & + + het_rates(k,249))* y(k,249) + prod(k,246) =.600_r8*rxt(k,446)*y(k,265)*y(k,100) + loss(k,247) = (rxt(k,434)* y(k,131) +rxt(k,435)* y(k,133) +rxt(k,430) & + * y(k,240) +rxt(k,431)* y(k,241) +rxt(k,432)* y(k,247) + rxt(k,433) & + + het_rates(k,250))* y(k,250) + prod(k,247) =.400_r8*rxt(k,446)*y(k,265)*y(k,100) + loss(k,248) = ((rxt(k,396) +rxt(k,397))* y(k,131) +rxt(k,395)* y(k,133) & + +rxt(k,392)* y(k,240) +rxt(k,393)* y(k,241) +rxt(k,394)* y(k,247) & + + het_rates(k,251))* y(k,251) + prod(k,248) = (.500_r8*rxt(k,399)*y(k,111) +.200_r8*rxt(k,400)*y(k,112) + & + rxt(k,413)*y(k,118))*y(k,265) + loss(k,200) = (rxt(k,474)* y(k,131) +rxt(k,475)* y(k,132) +rxt(k,473) & + * y(k,247) + het_rates(k,252))* y(k,252) + prod(k,200) =.600_r8*rxt(k,25)*y(k,13) + loss(k,250) = (rxt(k,405)* y(k,131) +rxt(k,414)* y(k,132) +rxt(k,406) & + * y(k,133) +rxt(k,401)* y(k,240) +rxt(k,402)* y(k,241) +rxt(k,403) & + * y(k,247) + 2._r8*rxt(k,404)* y(k,253) + het_rates(k,253))* y(k,253) + prod(k,250) = (.660_r8*rxt(k,51) +.500_r8*rxt(k,399)*y(k,265))*y(k,111) & + + (rxt(k,55) +rxt(k,415))*y(k,115) +.500_r8*rxt(k,400)*y(k,265) & + *y(k,112) + loss(k,218) = (rxt(k,477)* y(k,131) +rxt(k,478)* y(k,132) +rxt(k,476) & + * y(k,247) + het_rates(k,254))* y(k,254) + prod(k,218) =.600_r8*rxt(k,27)*y(k,15) + loss(k,193) = (rxt(k,408)* y(k,131) +rxt(k,407)* y(k,247) + het_rates(k,255)) & + * y(k,255) + prod(k,193) = (rxt(k,409)*y(k,113) +rxt(k,410)*y(k,114))*y(k,265) + loss(k,175) = (rxt(k,208)* y(k,141) +rxt(k,209)* y(k,142) + het_rates(k,256)) & + * y(k,256) + prod(k,175) = (.800_r8*rxt(k,603)*y(k,258) +.900_r8*rxt(k,605)*y(k,257)) & + *y(k,243) +rxt(k,607)*y(k,257)*y(k,141) + loss(k,195) = ((rxt(k,607) +rxt(k,608))* y(k,141) +rxt(k,606)* y(k,142) & + +rxt(k,605)* y(k,243) + het_rates(k,257))* y(k,257) + prod(k,195) = 0._r8 + loss(k,211) = (rxt(k,603)* y(k,243) + het_rates(k,258))* y(k,258) + prod(k,211) = (rxt(k,613) +rxt(k,612)*y(k,119) +rxt(k,614)*y(k,131))*y(k,264) & + +rxt(k,16)*y(k,131) +rxt(k,607)*y(k,257)*y(k,141) & + +rxt(k,611)*y(k,259)*y(k,142) +rxt(k,616)*y(k,266) + loss(k,171) = (rxt(k,609)* y(k,141) + (rxt(k,610) +rxt(k,611))* y(k,142) & + + het_rates(k,259))* y(k,259) + prod(k,171) =rxt(k,111)*y(k,119) + loss(k,232) = (rxt(k,507)* y(k,131) +rxt(k,508)* y(k,133) +rxt(k,505) & + * y(k,241) +rxt(k,506)* y(k,247) + het_rates(k,260))* y(k,260) + prod(k,232) = (rxt(k,499)*y(k,6) +rxt(k,502)*y(k,116) + & + .500_r8*rxt(k,519)*y(k,220))*y(k,133) +rxt(k,509)*y(k,265)*y(k,135) + loss(k,262) = (rxt(k,259)* y(k,35) +rxt(k,260)* y(k,36) +rxt(k,286)* y(k,37) & + +rxt(k,261)* y(k,38) +rxt(k,262)* y(k,39) +rxt(k,263)* y(k,40) & + +rxt(k,264)* y(k,41) +rxt(k,265)* y(k,42) +rxt(k,309)* y(k,43) & + +rxt(k,310)* y(k,45) + (rxt(k,330) +rxt(k,331) +rxt(k,332))* y(k,56) & + +rxt(k,287)* y(k,57) +rxt(k,295)* y(k,66) +rxt(k,296)* y(k,67) & + +rxt(k,173)* y(k,79) +rxt(k,288)* y(k,80) + (rxt(k,289) +rxt(k,290)) & + * y(k,83) +rxt(k,311)* y(k,84) +rxt(k,312)* y(k,85) +rxt(k,313) & + * y(k,86) + (rxt(k,266) +rxt(k,267))* y(k,87) +rxt(k,333)* y(k,88) & + + (rxt(k,226) +rxt(k,227))* y(k,120) + (rxt(k,176) +rxt(k,177)) & + * y(k,142) +rxt(k,178)* y(k,143) +rxt(k,174)* y(k,276) + rxt(k,175) & + + het_rates(k,261))* y(k,261) + prod(k,262) = (rxt(k,6) +rxt(k,209)*y(k,256))*y(k,142) +rxt(k,12)*y(k,120) & + +rxt(k,7)*y(k,143) +.850_r8*rxt(k,604)*y(k,264)*y(k,243) +rxt(k,1) & + *y(k,276) + loss(k,110) = (rxt(k,180)* y(k,141) +rxt(k,181)* y(k,142) + rxt(k,171) & + + rxt(k,179) + het_rates(k,262))* y(k,262) + prod(k,110) = (rxt(k,183) +rxt(k,182)*y(k,65) +rxt(k,184)*y(k,141) + & + rxt(k,185)*y(k,142) +rxt(k,186)*y(k,143))*y(k,263) +rxt(k,7)*y(k,143) + loss(k,111) = (rxt(k,182)* y(k,65) +rxt(k,184)* y(k,141) +rxt(k,185) & + * y(k,142) +rxt(k,186)* y(k,143) + rxt(k,172) + rxt(k,183) & + + het_rates(k,263))* y(k,263) + prod(k,111) =rxt(k,176)*y(k,261)*y(k,142) + loss(k,212) = (rxt(k,612)* y(k,119) +rxt(k,614)* y(k,131) +rxt(k,604) & + * y(k,243) + rxt(k,613) + het_rates(k,264))* y(k,264) + prod(k,212) = (rxt(k,126) +rxt(k,130) +rxt(k,606)*y(k,257) + & + rxt(k,610)*y(k,259) +rxt(k,617)*y(k,266))*y(k,142) & + +rxt(k,615)*y(k,266)*y(k,65) + loss(k,263) = (rxt(k,416)* y(k,1) +rxt(k,420)* y(k,2) +rxt(k,501)* y(k,6) & + +rxt(k,458)* y(k,8) +rxt(k,461)* y(k,10) +rxt(k,421)* y(k,17) & + +rxt(k,388)* y(k,18) +rxt(k,282)* y(k,21) +rxt(k,462)* y(k,24) & + +rxt(k,464)* y(k,25) +rxt(k,336)* y(k,26) +rxt(k,363)* y(k,27) & + +rxt(k,343)* y(k,28) +rxt(k,344)* y(k,29) +rxt(k,346)* y(k,30) & + +rxt(k,385)* y(k,31) +rxt(k,371)* y(k,32) +rxt(k,372)* y(k,33) & + +rxt(k,468)* y(k,34) +rxt(k,298)* y(k,43) +rxt(k,317)* y(k,44) & + +rxt(k,300)* y(k,45) +rxt(k,301)* y(k,46) +rxt(k,348)* y(k,47) & + +rxt(k,303)* y(k,48) +rxt(k,349)* y(k,49) +rxt(k,386)* y(k,50) & + +rxt(k,374)* y(k,51) +rxt(k,354)* y(k,52) +rxt(k,355)* y(k,53) & + +rxt(k,322)* y(k,54) +rxt(k,323)* y(k,55) +rxt(k,324)* y(k,56) & + +rxt(k,305)* y(k,57) + (rxt(k,252) +rxt(k,253))* y(k,61) +rxt(k,250) & + * y(k,62) +rxt(k,334)* y(k,64) +rxt(k,469)* y(k,68) + (rxt(k,523) + & + rxt(k,537))* y(k,69) +rxt(k,360)* y(k,76) +rxt(k,361)* y(k,77) & + +rxt(k,199)* y(k,79) +rxt(k,200)* y(k,81) +rxt(k,284)* y(k,83) & + +rxt(k,306)* y(k,84) +rxt(k,307)* y(k,85) +rxt(k,308)* y(k,86) & + +rxt(k,255)* y(k,87) +rxt(k,325)* y(k,88) +rxt(k,326)* y(k,89) & + +rxt(k,231)* y(k,91) +rxt(k,207)* y(k,92) +rxt(k,258)* y(k,94) & + +rxt(k,391)* y(k,95) +rxt(k,422)* y(k,96) +rxt(k,376)* y(k,97) & + +rxt(k,423)* y(k,98) +rxt(k,424)* y(k,99) +rxt(k,446)* y(k,100) & + +rxt(k,436)* y(k,101) +rxt(k,437)* y(k,102) +rxt(k,444)* y(k,104) & + +rxt(k,447)* y(k,106) +rxt(k,399)* y(k,111) +rxt(k,400)* y(k,112) & + +rxt(k,409)* y(k,113) +rxt(k,410)* y(k,114) +rxt(k,411)* y(k,115) & + +rxt(k,504)* y(k,116) +rxt(k,413)* y(k,118) +rxt(k,222)* y(k,119) & + +rxt(k,448)* y(k,122) +rxt(k,449)* y(k,123) +rxt(k,539)* y(k,127) & + +rxt(k,230)* y(k,132) +rxt(k,221)* y(k,133) +rxt(k,377)* y(k,134) & + +rxt(k,509)* y(k,135) +rxt(k,202)* y(k,141) +rxt(k,203)* y(k,143) & + +rxt(k,525)* y(k,146) +rxt(k,362)* y(k,148) +rxt(k,481)* y(k,151) & + +rxt(k,484)* y(k,152) +rxt(k,380)* y(k,157) +rxt(k,384)* y(k,158) & + +rxt(k,531)* y(k,159) +rxt(k,536)* y(k,161) +rxt(k,527)* y(k,162) & + +rxt(k,513)* y(k,217) +rxt(k,514)* y(k,218) +rxt(k,518)* y(k,219) & + +rxt(k,520)* y(k,220) +rxt(k,521)* y(k,221) +rxt(k,488)* y(k,222) & + + (rxt(k,489) +rxt(k,579))* y(k,223) +rxt(k,455)* y(k,225) & + +rxt(k,491)* y(k,226) +rxt(k,494)* y(k,227) +rxt(k,497)* y(k,229) & + +rxt(k,498)* y(k,230) +rxt(k,201)* y(k,247) + 2._r8*(rxt(k,204) + & + rxt(k,205))* y(k,265) + het_rates(k,265))* y(k,265) + prod(k,263) = (2.000_r8*rxt(k,193)*y(k,78) +rxt(k,196)*y(k,141) + & + rxt(k,197)*y(k,143) +rxt(k,218)*y(k,133) +rxt(k,223)*y(k,131) + & + rxt(k,239)*y(k,58) +.450_r8*rxt(k,352)*y(k,240) + & + .150_r8*rxt(k,382)*y(k,269) +.450_r8*rxt(k,403)*y(k,253) + & + .200_r8*rxt(k,407)*y(k,255) +.400_r8*rxt(k,456)*y(k,233) + & + .400_r8*rxt(k,470)*y(k,242) +.400_r8*rxt(k,476)*y(k,254))*y(k,247) & + + (rxt(k,198)*y(k,78) +.130_r8*rxt(k,338)*y(k,27) + & + .360_r8*rxt(k,367)*y(k,31) +.240_r8*rxt(k,398)*y(k,111) + & + .360_r8*rxt(k,412)*y(k,118) +.320_r8*rxt(k,445)*y(k,100) + & + .630_r8*rxt(k,500)*y(k,6) +.630_r8*rxt(k,503)*y(k,116))*y(k,143) & + + (rxt(k,190)*y(k,79) +rxt(k,191)*y(k,81) +rxt(k,254)*y(k,87) + & + rxt(k,257)*y(k,94) +rxt(k,283)*y(k,83) +rxt(k,285)*y(k,93) + & + rxt(k,316)*y(k,44))*y(k,141) + (.300_r8*rxt(k,323)*y(k,55) + & + .650_r8*rxt(k,336)*y(k,26) +.500_r8*rxt(k,344)*y(k,29) + & + .500_r8*rxt(k,380)*y(k,157) +.100_r8*rxt(k,400)*y(k,112) + & + .600_r8*rxt(k,447)*y(k,106) +.500_r8*rxt(k,455)*y(k,225))*y(k,265) & + + (rxt(k,173)*y(k,79) +2.000_r8*rxt(k,174)*y(k,276) + & + rxt(k,266)*y(k,87) +rxt(k,289)*y(k,83) +rxt(k,330)*y(k,56) + & + rxt(k,333)*y(k,88))*y(k,261) + (rxt(k,3) +rxt(k,293)*y(k,75)) & + *y(k,276) +rxt(k,21)*y(k,2) +rxt(k,22)*y(k,10) +rxt(k,29)*y(k,25) & + +rxt(k,30)*y(k,29) +rxt(k,31)*y(k,32) +rxt(k,32)*y(k,34) +rxt(k,38) & + *y(k,53) +rxt(k,39)*y(k,55) +.330_r8*rxt(k,40)*y(k,56) +rxt(k,43) & + *y(k,74) +2.000_r8*rxt(k,4)*y(k,81) +rxt(k,9)*y(k,91) +rxt(k,10) & + *y(k,92) +rxt(k,106)*y(k,93) +rxt(k,107)*y(k,94) +rxt(k,47)*y(k,96) & + +rxt(k,50)*y(k,106) +rxt(k,54)*y(k,114) +.500_r8*rxt(k,548)*y(k,132) & + +rxt(k,59)*y(k,135) +rxt(k,62)*y(k,152) +rxt(k,63)*y(k,157) & + +rxt(k,64)*y(k,158) +rxt(k,66)*y(k,217) +rxt(k,68)*y(k,219) & + +rxt(k,71)*y(k,222) +rxt(k,72)*y(k,225) +rxt(k,73)*y(k,227) & + +rxt(k,74)*y(k,230) + loss(k,206) = (rxt(k,615)* y(k,65) +rxt(k,617)* y(k,142) + rxt(k,616) & + + het_rates(k,266))* y(k,266) + prod(k,206) = (rxt(k,120) +rxt(k,121) +rxt(k,122) +rxt(k,123) +rxt(k,124) + & + rxt(k,125) +rxt(k,608)*y(k,257) +rxt(k,609)*y(k,259))*y(k,141) & + + (rxt(k,127) +rxt(k,128) +rxt(k,129) +rxt(k,131) +rxt(k,132) + & + rxt(k,133))*y(k,142) + loss(k,163) = (rxt(k,480)* y(k,131) +rxt(k,479)* y(k,247) + het_rates(k,267)) & + * y(k,267) + prod(k,163) = (.200_r8*rxt(k,469)*y(k,68) +.140_r8*rxt(k,481)*y(k,151) + & + rxt(k,484)*y(k,152))*y(k,265) + loss(k,208) = (rxt(k,379)* y(k,131) +rxt(k,378)* y(k,247) + het_rates(k,268)) & + * y(k,268) + prod(k,208) = (.500_r8*rxt(k,380)*y(k,157) +rxt(k,385)*y(k,31))*y(k,265) + loss(k,241) = (rxt(k,383)* y(k,131) +rxt(k,381)* y(k,241) +rxt(k,382) & + * y(k,247) + het_rates(k,269))* y(k,269) + prod(k,241) = (rxt(k,384)*y(k,158) +rxt(k,386)*y(k,50) + & + .150_r8*rxt(k,521)*y(k,221))*y(k,265) + (.060_r8*rxt(k,500)*y(k,6) + & + .060_r8*rxt(k,503)*y(k,116))*y(k,143) +.150_r8*rxt(k,70)*y(k,221) + loss(k,238) = (rxt(k,512)* y(k,131) +rxt(k,510)* y(k,241) +rxt(k,511) & + * y(k,247) + het_rates(k,270))* y(k,270) + prod(k,238) = (.500_r8*rxt(k,519)*y(k,133) +rxt(k,520)*y(k,265))*y(k,220) & + +rxt(k,513)*y(k,265)*y(k,217) + loss(k,228) = (rxt(k,517)* y(k,131) +rxt(k,515)* y(k,241) +rxt(k,516) & + * y(k,247) + het_rates(k,271))* y(k,271) + prod(k,228) = (rxt(k,501)*y(k,6) +rxt(k,504)*y(k,116) +rxt(k,518)*y(k,219)) & + *y(k,265) + loss(k,201) = (rxt(k,487)* y(k,131) +rxt(k,486)* y(k,247) + het_rates(k,272)) & + * y(k,272) + prod(k,201) = (rxt(k,488)*y(k,222) +.650_r8*rxt(k,489)*y(k,223) + & + rxt(k,579)*y(k,223))*y(k,265) + loss(k,242) = (rxt(k,453)* y(k,131) +rxt(k,454)* y(k,133) +rxt(k,450) & + * y(k,240) +rxt(k,451)* y(k,241) +rxt(k,452)* y(k,247) & + + het_rates(k,273))* y(k,273) + prod(k,242) = (rxt(k,422)*y(k,96) +rxt(k,423)*y(k,98) +rxt(k,424)*y(k,99) + & + .400_r8*rxt(k,447)*y(k,106) +.500_r8*rxt(k,455)*y(k,225))*y(k,265) + loss(k,202) = (rxt(k,493)* y(k,131) +rxt(k,492)* y(k,247) + het_rates(k,274)) & + * y(k,274) + prod(k,202) = (.560_r8*rxt(k,491)*y(k,226) +rxt(k,494)*y(k,227))*y(k,265) + loss(k,172) = (rxt(k,496)* y(k,131) +rxt(k,495)* y(k,247) + het_rates(k,275)) & + * y(k,275) + prod(k,172) = (.300_r8*rxt(k,497)*y(k,229) +rxt(k,498)*y(k,230))*y(k,265) + loss(k,274) = (rxt(k,293)* y(k,75) +rxt(k,538)* y(k,163) +rxt(k,174) & + * y(k,261) + rxt(k,1) + rxt(k,2) + rxt(k,3) + het_rates(k,276)) & + * y(k,276) + prod(k,274) = (rxt(k,199)*y(k,79) +rxt(k,200)*y(k,81) +rxt(k,201)*y(k,247) + & + rxt(k,204)*y(k,265) +rxt(k,207)*y(k,92) +rxt(k,231)*y(k,91) + & + rxt(k,255)*y(k,87) +rxt(k,258)*y(k,94) +rxt(k,284)*y(k,83) + & + rxt(k,298)*y(k,43) +rxt(k,300)*y(k,45) +rxt(k,301)*y(k,46) + & + rxt(k,303)*y(k,48) +rxt(k,308)*y(k,86) +rxt(k,317)*y(k,44) + & + rxt(k,323)*y(k,55) +rxt(k,324)*y(k,56) +rxt(k,326)*y(k,89) + & + rxt(k,346)*y(k,30) +rxt(k,348)*y(k,47) +rxt(k,354)*y(k,52) + & + rxt(k,355)*y(k,53) +rxt(k,371)*y(k,32) +rxt(k,372)*y(k,33) + & + rxt(k,374)*y(k,51) +rxt(k,380)*y(k,157) +rxt(k,384)*y(k,158) + & + rxt(k,386)*y(k,50) +.500_r8*rxt(k,399)*y(k,111) +rxt(k,539)*y(k,127)) & + *y(k,265) + (rxt(k,587)*y(k,94) +rxt(k,593)*y(k,94) + & + rxt(k,594)*y(k,93) +rxt(k,598)*y(k,94) +rxt(k,599)*y(k,93))*y(k,87) & + + (rxt(k,540) +rxt(k,194)*y(k,78))*y(k,247) +.050_r8*rxt(k,40) & + *y(k,56) +rxt(k,136)*y(k,82) + end do + end subroutine imp_prod_loss + end module mo_prod_loss diff --git a/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_rxt_rates_conv.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_rxt_rates_conv.F90 new file mode 100644 index 0000000000..3081fef32d --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_rxt_rates_conv.F90 @@ -0,0 +1,633 @@ +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,:, 276) ! rate_const*H2O + rxt_rates(:ncol,:, 2) = rxt_rates(:ncol,:, 2)*sol(:ncol,:, 276) ! rate_const*H2O + rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 276) ! rate_const*H2O + rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 81) ! rate_const*H2O2 + rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 142) ! rate_const*O2 + rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 142) ! rate_const*O2 + rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 143) ! rate_const*O3 + rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 143) ! rate_const*O3 + rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 91) ! rate_const*HNO3 + rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 92) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 92) ! rate_const*HO2NO2 + rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 120) ! rate_const*N2O + rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 14) = rxt_rates(:ncol,:, 14)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 15) = rxt_rates(:ncol,:, 15)*sol(:ncol,:, 131) ! rate_const*NO + rxt_rates(:ncol,:, 16) = rxt_rates(:ncol,:, 16)*sol(:ncol,:, 131) ! rate_const*NO + rxt_rates(:ncol,:, 17) = rxt_rates(:ncol,:, 17)*sol(:ncol,:, 132) ! rate_const*NO2 + rxt_rates(:ncol,:, 18) = rxt_rates(:ncol,:, 18)*sol(:ncol,:, 133) ! rate_const*NO3 + rxt_rates(:ncol,:, 19) = rxt_rates(:ncol,:, 19)*sol(:ncol,:, 133) ! rate_const*NO3 + rxt_rates(:ncol,:, 20) = rxt_rates(:ncol,:, 20)*sol(:ncol,:, 1) ! rate_const*ALKNIT + rxt_rates(:ncol,:, 21) = rxt_rates(:ncol,:, 21)*sol(:ncol,:, 2) ! rate_const*ALKOOH + rxt_rates(:ncol,:, 22) = rxt_rates(:ncol,:, 22)*sol(:ncol,:, 10) ! rate_const*BENZOOH + rxt_rates(:ncol,:, 23) = rxt_rates(:ncol,:, 23)*sol(:ncol,:, 11) ! rate_const*BEPOMUC + rxt_rates(:ncol,:, 24) = rxt_rates(:ncol,:, 24)*sol(:ncol,:, 12) ! rate_const*BIGALD + rxt_rates(:ncol,:, 25) = rxt_rates(:ncol,:, 25)*sol(:ncol,:, 13) ! rate_const*BIGALD1 + rxt_rates(:ncol,:, 26) = rxt_rates(:ncol,:, 26)*sol(:ncol,:, 14) ! rate_const*BIGALD2 + rxt_rates(:ncol,:, 27) = rxt_rates(:ncol,:, 27)*sol(:ncol,:, 15) ! rate_const*BIGALD3 + rxt_rates(:ncol,:, 28) = rxt_rates(:ncol,:, 28)*sol(:ncol,:, 16) ! rate_const*BIGALD4 + rxt_rates(:ncol,:, 29) = rxt_rates(:ncol,:, 29)*sol(:ncol,:, 25) ! rate_const*BZOOH + rxt_rates(:ncol,:, 30) = rxt_rates(:ncol,:, 30)*sol(:ncol,:, 29) ! rate_const*C2H5OOH + rxt_rates(:ncol,:, 31) = rxt_rates(:ncol,:, 31)*sol(:ncol,:, 32) ! rate_const*C3H7OOH + rxt_rates(:ncol,:, 32) = rxt_rates(:ncol,:, 32)*sol(:ncol,:, 34) ! rate_const*C6H5OOH + rxt_rates(:ncol,:, 33) = rxt_rates(:ncol,:, 33)*sol(:ncol,:, 44) ! rate_const*CH2O + rxt_rates(:ncol,:, 34) = rxt_rates(:ncol,:, 34)*sol(:ncol,:, 44) ! rate_const*CH2O + rxt_rates(:ncol,:, 35) = rxt_rates(:ncol,:, 35)*sol(:ncol,:, 47) ! rate_const*CH3CHO + rxt_rates(:ncol,:, 36) = rxt_rates(:ncol,:, 36)*sol(:ncol,:, 50) ! rate_const*CH3COCH3 + rxt_rates(:ncol,:, 37) = rxt_rates(:ncol,:, 37)*sol(:ncol,:, 51) ! rate_const*CH3COCHO + rxt_rates(:ncol,:, 38) = rxt_rates(:ncol,:, 38)*sol(:ncol,:, 53) ! rate_const*CH3COOOH + rxt_rates(:ncol,:, 39) = rxt_rates(:ncol,:, 39)*sol(:ncol,:, 55) ! rate_const*CH3OOH + rxt_rates(:ncol,:, 40) = rxt_rates(:ncol,:, 40)*sol(:ncol,:, 56) ! rate_const*CH4 + rxt_rates(:ncol,:, 41) = rxt_rates(:ncol,:, 41)*sol(:ncol,:, 56) ! rate_const*CH4 + rxt_rates(:ncol,:, 42) = rxt_rates(:ncol,:, 42)*sol(:ncol,:, 65) ! rate_const*CO2 + rxt_rates(:ncol,:, 43) = rxt_rates(:ncol,:, 43)*sol(:ncol,:, 74) ! rate_const*EOOH + rxt_rates(:ncol,:, 44) = rxt_rates(:ncol,:, 44)*sol(:ncol,:, 76) ! rate_const*GLYALD + rxt_rates(:ncol,:, 45) = rxt_rates(:ncol,:, 45)*sol(:ncol,:, 77) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 46) = rxt_rates(:ncol,:, 46)*sol(:ncol,:, 95) ! rate_const*HONITR + rxt_rates(:ncol,:, 47) = rxt_rates(:ncol,:, 47)*sol(:ncol,:, 96) ! rate_const*HPALD + rxt_rates(:ncol,:, 48) = rxt_rates(:ncol,:, 48)*sol(:ncol,:, 97) ! rate_const*HYAC + rxt_rates(:ncol,:, 49) = rxt_rates(:ncol,:, 49)*sol(:ncol,:, 104) ! rate_const*ISOPNOOH + rxt_rates(:ncol,:, 50) = rxt_rates(:ncol,:, 50)*sol(:ncol,:, 106) ! rate_const*ISOPOOH + rxt_rates(:ncol,:, 51) = rxt_rates(:ncol,:, 51)*sol(:ncol,:, 111) ! rate_const*MACR + rxt_rates(:ncol,:, 52) = rxt_rates(:ncol,:, 52)*sol(:ncol,:, 111) ! rate_const*MACR + rxt_rates(:ncol,:, 53) = rxt_rates(:ncol,:, 53)*sol(:ncol,:, 113) ! rate_const*MEK + rxt_rates(:ncol,:, 54) = rxt_rates(:ncol,:, 54)*sol(:ncol,:, 114) ! rate_const*MEKOOH + rxt_rates(:ncol,:, 55) = rxt_rates(:ncol,:, 55)*sol(:ncol,:, 115) ! rate_const*MPAN + rxt_rates(:ncol,:, 56) = rxt_rates(:ncol,:, 56)*sol(:ncol,:, 118) ! rate_const*MVK + rxt_rates(:ncol,:, 57) = rxt_rates(:ncol,:, 57)*sol(:ncol,:, 123) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 58) = rxt_rates(:ncol,:, 58)*sol(:ncol,:, 134) ! rate_const*NOA + rxt_rates(:ncol,:, 59) = rxt_rates(:ncol,:, 59)*sol(:ncol,:, 135) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 60) = rxt_rates(:ncol,:, 60)*sol(:ncol,:, 147) ! rate_const*ONITR + rxt_rates(:ncol,:, 61) = rxt_rates(:ncol,:, 61)*sol(:ncol,:, 148) ! rate_const*PAN + rxt_rates(:ncol,:, 62) = rxt_rates(:ncol,:, 62)*sol(:ncol,:, 152) ! rate_const*PHENOOH + rxt_rates(:ncol,:, 63) = rxt_rates(:ncol,:, 63)*sol(:ncol,:, 157) ! rate_const*POOH + rxt_rates(:ncol,:, 64) = rxt_rates(:ncol,:, 64)*sol(:ncol,:, 158) ! rate_const*ROOH + rxt_rates(:ncol,:, 65) = rxt_rates(:ncol,:, 65)*sol(:ncol,:, 216) ! rate_const*TEPOMUC + rxt_rates(:ncol,:, 66) = rxt_rates(:ncol,:, 66)*sol(:ncol,:, 217) ! rate_const*TERP2OOH + rxt_rates(:ncol,:, 67) = rxt_rates(:ncol,:, 67)*sol(:ncol,:, 218) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 68) = rxt_rates(:ncol,:, 68)*sol(:ncol,:, 219) ! rate_const*TERPOOH + rxt_rates(:ncol,:, 69) = rxt_rates(:ncol,:, 69)*sol(:ncol,:, 220) ! rate_const*TERPROD1 + rxt_rates(:ncol,:, 70) = rxt_rates(:ncol,:, 70)*sol(:ncol,:, 221) ! rate_const*TERPROD2 + rxt_rates(:ncol,:, 71) = rxt_rates(:ncol,:, 71)*sol(:ncol,:, 222) ! rate_const*TOLOOH + rxt_rates(:ncol,:, 72) = rxt_rates(:ncol,:, 72)*sol(:ncol,:, 225) ! rate_const*XOOH + rxt_rates(:ncol,:, 73) = rxt_rates(:ncol,:, 73)*sol(:ncol,:, 227) ! rate_const*XYLENOOH + rxt_rates(:ncol,:, 74) = rxt_rates(:ncol,:, 74)*sol(:ncol,:, 230) ! rate_const*XYLOLOOH + rxt_rates(:ncol,:, 75) = rxt_rates(:ncol,:, 75)*sol(:ncol,:, 20) ! rate_const*BRCL + rxt_rates(:ncol,:, 76) = rxt_rates(:ncol,:, 76)*sol(:ncol,:, 21) ! rate_const*BRO + rxt_rates(:ncol,:, 77) = rxt_rates(:ncol,:, 77)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 78) = rxt_rates(:ncol,:, 78)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 79) = rxt_rates(:ncol,:, 79)*sol(:ncol,:, 35) ! rate_const*CCL4 + rxt_rates(:ncol,:, 80) = rxt_rates(:ncol,:, 80)*sol(:ncol,:, 36) ! rate_const*CF2CLBR + rxt_rates(:ncol,:, 81) = rxt_rates(:ncol,:, 81)*sol(:ncol,:, 37) ! rate_const*CF3BR + rxt_rates(:ncol,:, 82) = rxt_rates(:ncol,:, 82)*sol(:ncol,:, 38) ! rate_const*CFC11 + rxt_rates(:ncol,:, 83) = rxt_rates(:ncol,:, 83)*sol(:ncol,:, 39) ! rate_const*CFC113 + rxt_rates(:ncol,:, 84) = rxt_rates(:ncol,:, 84)*sol(:ncol,:, 40) ! rate_const*CFC114 + rxt_rates(:ncol,:, 85) = rxt_rates(:ncol,:, 85)*sol(:ncol,:, 41) ! rate_const*CFC115 + rxt_rates(:ncol,:, 86) = rxt_rates(:ncol,:, 86)*sol(:ncol,:, 42) ! rate_const*CFC12 + rxt_rates(:ncol,:, 87) = rxt_rates(:ncol,:, 87)*sol(:ncol,:, 43) ! rate_const*CH2BR2 + rxt_rates(:ncol,:, 88) = rxt_rates(:ncol,:, 88)*sol(:ncol,:, 45) ! rate_const*CH3BR + rxt_rates(:ncol,:, 89) = rxt_rates(:ncol,:, 89)*sol(:ncol,:, 46) ! rate_const*CH3CCL3 + rxt_rates(:ncol,:, 90) = rxt_rates(:ncol,:, 90)*sol(:ncol,:, 48) ! rate_const*CH3CL + rxt_rates(:ncol,:, 91) = rxt_rates(:ncol,:, 91)*sol(:ncol,:, 57) ! rate_const*CHBR3 + rxt_rates(:ncol,:, 92) = rxt_rates(:ncol,:, 92)*sol(:ncol,:, 59) ! rate_const*CL2 + rxt_rates(:ncol,:, 93) = rxt_rates(:ncol,:, 93)*sol(:ncol,:, 60) ! rate_const*CL2O2 + rxt_rates(:ncol,:, 94) = rxt_rates(:ncol,:, 94)*sol(:ncol,:, 61) ! rate_const*CLO + rxt_rates(:ncol,:, 95) = rxt_rates(:ncol,:, 95)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 96) = rxt_rates(:ncol,:, 96)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 97) = rxt_rates(:ncol,:, 97)*sol(:ncol,:, 66) ! rate_const*COF2 + rxt_rates(:ncol,:, 98) = rxt_rates(:ncol,:, 98)*sol(:ncol,:, 67) ! rate_const*COFCL + rxt_rates(:ncol,:, 99) = rxt_rates(:ncol,:, 99)*sol(:ncol,:, 80) ! rate_const*H2402 + rxt_rates(:ncol,:, 100) = rxt_rates(:ncol,:, 100)*sol(:ncol,:, 83) ! rate_const*HBR + rxt_rates(:ncol,:, 101) = rxt_rates(:ncol,:, 101)*sol(:ncol,:, 84) ! rate_const*HCFC141B + rxt_rates(:ncol,:, 102) = rxt_rates(:ncol,:, 102)*sol(:ncol,:, 85) ! rate_const*HCFC142B + rxt_rates(:ncol,:, 103) = rxt_rates(:ncol,:, 103)*sol(:ncol,:, 86) ! rate_const*HCFC22 + rxt_rates(:ncol,:, 104) = rxt_rates(:ncol,:, 104)*sol(:ncol,:, 87) ! rate_const*HCL + rxt_rates(:ncol,:, 105) = rxt_rates(:ncol,:, 105)*sol(:ncol,:, 90) ! rate_const*HF + rxt_rates(:ncol,:, 106) = rxt_rates(:ncol,:, 106)*sol(:ncol,:, 93) ! rate_const*HOBR + rxt_rates(:ncol,:, 107) = rxt_rates(:ncol,:, 107)*sol(:ncol,:, 94) ! rate_const*HOCL + rxt_rates(:ncol,:, 108) = rxt_rates(:ncol,:, 108)*sol(:ncol,:, 145) ! rate_const*OCLO + rxt_rates(:ncol,:, 109) = rxt_rates(:ncol,:, 109)*sol(:ncol,:, 160) ! rate_const*SF6 + rxt_rates(:ncol,:, 110) = rxt_rates(:ncol,:, 110)*sol(:ncol,:, 65) ! rate_const*CO2 + rxt_rates(:ncol,:, 111) = rxt_rates(:ncol,:, 111)*sol(:ncol,:, 119) ! rate_const*N + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + ! rate_const*N2 + rxt_rates(:ncol,:, 120) = rxt_rates(:ncol,:, 120)*sol(:ncol,:, 141) ! rate_const*O + rxt_rates(:ncol,:, 121) = rxt_rates(:ncol,:, 121)*sol(:ncol,:, 141) ! rate_const*O + rxt_rates(:ncol,:, 122) = rxt_rates(:ncol,:, 122)*sol(:ncol,:, 141) ! rate_const*O + rxt_rates(:ncol,:, 123) = rxt_rates(:ncol,:, 123)*sol(:ncol,:, 141) ! rate_const*O + rxt_rates(:ncol,:, 124) = rxt_rates(:ncol,:, 124)*sol(:ncol,:, 141) ! rate_const*O + rxt_rates(:ncol,:, 125) = rxt_rates(:ncol,:, 125)*sol(:ncol,:, 141) ! rate_const*O + rxt_rates(:ncol,:, 126) = rxt_rates(:ncol,:, 126)*sol(:ncol,:, 142) ! rate_const*O2 + rxt_rates(:ncol,:, 127) = rxt_rates(:ncol,:, 127)*sol(:ncol,:, 142) ! rate_const*O2 + rxt_rates(:ncol,:, 128) = rxt_rates(:ncol,:, 128)*sol(:ncol,:, 142) ! rate_const*O2 + rxt_rates(:ncol,:, 129) = rxt_rates(:ncol,:, 129)*sol(:ncol,:, 142) ! rate_const*O2 + rxt_rates(:ncol,:, 130) = rxt_rates(:ncol,:, 130)*sol(:ncol,:, 142) ! rate_const*O2 + rxt_rates(:ncol,:, 131) = rxt_rates(:ncol,:, 131)*sol(:ncol,:, 142) ! rate_const*O2 + rxt_rates(:ncol,:, 132) = rxt_rates(:ncol,:, 132)*sol(:ncol,:, 142) ! rate_const*O2 + rxt_rates(:ncol,:, 133) = rxt_rates(:ncol,:, 133)*sol(:ncol,:, 142) ! rate_const*O2 + rxt_rates(:ncol,:, 134) = rxt_rates(:ncol,:, 134)*sol(:ncol,:, 142) ! rate_const*O2 + rxt_rates(:ncol,:, 135) = rxt_rates(:ncol,:, 135)*sol(:ncol,:, 142) ! rate_const*O2 + rxt_rates(:ncol,:, 136) = rxt_rates(:ncol,:, 136)*sol(:ncol,:, 82) ! rate_const*H2SO4 + rxt_rates(:ncol,:, 137) = rxt_rates(:ncol,:, 137)*sol(:ncol,:, 146) ! rate_const*OCS + rxt_rates(:ncol,:, 138) = rxt_rates(:ncol,:, 138)*sol(:ncol,:, 161) ! rate_const*SO + rxt_rates(:ncol,:, 139) = rxt_rates(:ncol,:, 139)*sol(:ncol,:, 162) ! rate_const*SO2 + rxt_rates(:ncol,:, 140) = rxt_rates(:ncol,:, 140)*sol(:ncol,:, 163) ! rate_const*SO3 + rxt_rates(:ncol,:, 141) = rxt_rates(:ncol,:, 141)*sol(:ncol,:, 168) ! rate_const*soabb1_a1 + rxt_rates(:ncol,:, 142) = rxt_rates(:ncol,:, 142)*sol(:ncol,:, 169) ! rate_const*soabb1_a2 + rxt_rates(:ncol,:, 143) = rxt_rates(:ncol,:, 143)*sol(:ncol,:, 170) ! rate_const*soabb2_a1 + rxt_rates(:ncol,:, 144) = rxt_rates(:ncol,:, 144)*sol(:ncol,:, 171) ! rate_const*soabb2_a2 + rxt_rates(:ncol,:, 145) = rxt_rates(:ncol,:, 145)*sol(:ncol,:, 172) ! rate_const*soabb3_a1 + rxt_rates(:ncol,:, 146) = rxt_rates(:ncol,:, 146)*sol(:ncol,:, 173) ! rate_const*soabb3_a2 + rxt_rates(:ncol,:, 147) = rxt_rates(:ncol,:, 147)*sol(:ncol,:, 174) ! rate_const*soabb4_a1 + rxt_rates(:ncol,:, 148) = rxt_rates(:ncol,:, 148)*sol(:ncol,:, 175) ! rate_const*soabb4_a2 + rxt_rates(:ncol,:, 149) = rxt_rates(:ncol,:, 149)*sol(:ncol,:, 176) ! rate_const*soabb5_a1 + rxt_rates(:ncol,:, 150) = rxt_rates(:ncol,:, 150)*sol(:ncol,:, 177) ! rate_const*soabb5_a2 + rxt_rates(:ncol,:, 151) = rxt_rates(:ncol,:, 151)*sol(:ncol,:, 178) ! rate_const*soabg1_a1 + rxt_rates(:ncol,:, 152) = rxt_rates(:ncol,:, 152)*sol(:ncol,:, 179) ! rate_const*soabg1_a2 + rxt_rates(:ncol,:, 153) = rxt_rates(:ncol,:, 153)*sol(:ncol,:, 180) ! rate_const*soabg2_a1 + rxt_rates(:ncol,:, 154) = rxt_rates(:ncol,:, 154)*sol(:ncol,:, 181) ! rate_const*soabg2_a2 + rxt_rates(:ncol,:, 155) = rxt_rates(:ncol,:, 155)*sol(:ncol,:, 182) ! rate_const*soabg3_a1 + rxt_rates(:ncol,:, 156) = rxt_rates(:ncol,:, 156)*sol(:ncol,:, 183) ! rate_const*soabg3_a2 + rxt_rates(:ncol,:, 157) = rxt_rates(:ncol,:, 157)*sol(:ncol,:, 184) ! rate_const*soabg4_a1 + rxt_rates(:ncol,:, 158) = rxt_rates(:ncol,:, 158)*sol(:ncol,:, 185) ! rate_const*soabg4_a2 + rxt_rates(:ncol,:, 159) = rxt_rates(:ncol,:, 159)*sol(:ncol,:, 186) ! rate_const*soabg5_a1 + rxt_rates(:ncol,:, 160) = rxt_rates(:ncol,:, 160)*sol(:ncol,:, 187) ! rate_const*soabg5_a2 + rxt_rates(:ncol,:, 161) = rxt_rates(:ncol,:, 161)*sol(:ncol,:, 188) ! rate_const*soaff1_a1 + rxt_rates(:ncol,:, 162) = rxt_rates(:ncol,:, 162)*sol(:ncol,:, 189) ! rate_const*soaff1_a2 + rxt_rates(:ncol,:, 163) = rxt_rates(:ncol,:, 163)*sol(:ncol,:, 190) ! rate_const*soaff2_a1 + rxt_rates(:ncol,:, 164) = rxt_rates(:ncol,:, 164)*sol(:ncol,:, 191) ! rate_const*soaff2_a2 + rxt_rates(:ncol,:, 165) = rxt_rates(:ncol,:, 165)*sol(:ncol,:, 192) ! rate_const*soaff3_a1 + rxt_rates(:ncol,:, 166) = rxt_rates(:ncol,:, 166)*sol(:ncol,:, 193) ! rate_const*soaff3_a2 + rxt_rates(:ncol,:, 167) = rxt_rates(:ncol,:, 167)*sol(:ncol,:, 194) ! rate_const*soaff4_a1 + rxt_rates(:ncol,:, 168) = rxt_rates(:ncol,:, 168)*sol(:ncol,:, 195) ! rate_const*soaff4_a2 + rxt_rates(:ncol,:, 169) = rxt_rates(:ncol,:, 169)*sol(:ncol,:, 196) ! rate_const*soaff5_a1 + rxt_rates(:ncol,:, 170) = rxt_rates(:ncol,:, 170)*sol(:ncol,:, 197) ! rate_const*soaff5_a2 + rxt_rates(:ncol,:, 171) = rxt_rates(:ncol,:, 171)*sol(:ncol,:, 262) ! rate_const*O2_1D + rxt_rates(:ncol,:, 172) = rxt_rates(:ncol,:, 172)*sol(:ncol,:, 263) ! rate_const*O2_1S + rxt_rates(:ncol,:, 173) = rxt_rates(:ncol,:, 173)*sol(:ncol,:, 261)*sol(:ncol,:, 79) ! rate_const*O1D*H2 + rxt_rates(:ncol,:, 174) = rxt_rates(:ncol,:, 174)*sol(:ncol,:, 261)*sol(:ncol,:, 276) ! rate_const*O1D*H2O + rxt_rates(:ncol,:, 175) = rxt_rates(:ncol,:, 175)*sol(:ncol,:, 261) ! rate_const*N2*O1D + rxt_rates(:ncol,:, 176) = rxt_rates(:ncol,:, 176)*sol(:ncol,:, 261)*sol(:ncol,:, 142) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 177) = rxt_rates(:ncol,:, 177)*sol(:ncol,:, 261)*sol(:ncol,:, 142) ! rate_const*O1D*O2 + rxt_rates(:ncol,:, 178) = rxt_rates(:ncol,:, 178)*sol(:ncol,:, 261)*sol(:ncol,:, 143) ! rate_const*O1D*O3 + rxt_rates(:ncol,:, 179) = rxt_rates(:ncol,:, 179)*sol(:ncol,:, 262) ! rate_const*N2*O2_1D + rxt_rates(:ncol,:, 180) = rxt_rates(:ncol,:, 180)*sol(:ncol,:, 262)*sol(:ncol,:, 141) ! rate_const*O2_1D*O + rxt_rates(:ncol,:, 181) = rxt_rates(:ncol,:, 181)*sol(:ncol,:, 262)*sol(:ncol,:, 142) ! rate_const*O2_1D*O2 + rxt_rates(:ncol,:, 182) = rxt_rates(:ncol,:, 182)*sol(:ncol,:, 263)*sol(:ncol,:, 65) ! rate_const*O2_1S*CO2 + rxt_rates(:ncol,:, 183) = rxt_rates(:ncol,:, 183)*sol(:ncol,:, 263) ! rate_const*N2*O2_1S + rxt_rates(:ncol,:, 184) = rxt_rates(:ncol,:, 184)*sol(:ncol,:, 263)*sol(:ncol,:, 141) ! rate_const*O2_1S*O + rxt_rates(:ncol,:, 185) = rxt_rates(:ncol,:, 185)*sol(:ncol,:, 263)*sol(:ncol,:, 142) ! rate_const*O2_1S*O2 + rxt_rates(:ncol,:, 186) = rxt_rates(:ncol,:, 186)*sol(:ncol,:, 263)*sol(:ncol,:, 143) ! rate_const*O2_1S*O3 + rxt_rates(:ncol,:, 187) = rxt_rates(:ncol,:, 187)*sol(:ncol,:, 141)*sol(:ncol,:, 143) ! rate_const*O*O3 + rxt_rates(:ncol,:, 188) = rxt_rates(:ncol,:, 188)*sol(:ncol,:, 141)*sol(:ncol,:, 141) ! rate_const*M*O*O + rxt_rates(:ncol,:, 189) = rxt_rates(:ncol,:, 189)*sol(:ncol,:, 141)*sol(:ncol,:, 142) ! rate_const*M*O*O2 + rxt_rates(:ncol,:, 190) = rxt_rates(:ncol,:, 190)*sol(:ncol,:, 79)*sol(:ncol,:, 141) ! rate_const*H2*O + rxt_rates(:ncol,:, 191) = rxt_rates(:ncol,:, 191)*sol(:ncol,:, 81)*sol(:ncol,:, 141) ! rate_const*H2O2*O + rxt_rates(:ncol,:, 192) = rxt_rates(:ncol,:, 192)*sol(:ncol,:, 78)*sol(:ncol,:, 247) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 193) = rxt_rates(:ncol,:, 193)*sol(:ncol,:, 78)*sol(:ncol,:, 247) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 194) = rxt_rates(:ncol,:, 194)*sol(:ncol,:, 78)*sol(:ncol,:, 247) ! rate_const*H*HO2 + rxt_rates(:ncol,:, 195) = rxt_rates(:ncol,:, 195)*sol(:ncol,:, 78)*sol(:ncol,:, 142) ! rate_const*M*H*O2 + rxt_rates(:ncol,:, 196) = rxt_rates(:ncol,:, 196)*sol(:ncol,:, 247)*sol(:ncol,:, 141) ! rate_const*HO2*O + rxt_rates(:ncol,:, 197) = rxt_rates(:ncol,:, 197)*sol(:ncol,:, 247)*sol(:ncol,:, 143) ! rate_const*HO2*O3 + rxt_rates(:ncol,:, 198) = rxt_rates(:ncol,:, 198)*sol(:ncol,:, 78)*sol(:ncol,:, 143) ! rate_const*H*O3 + rxt_rates(:ncol,:, 199) = rxt_rates(:ncol,:, 199)*sol(:ncol,:, 265)*sol(:ncol,:, 79) ! rate_const*OH*H2 + rxt_rates(:ncol,:, 200) = rxt_rates(:ncol,:, 200)*sol(:ncol,:, 265)*sol(:ncol,:, 81) ! rate_const*OH*H2O2 + rxt_rates(:ncol,:, 201) = rxt_rates(:ncol,:, 201)*sol(:ncol,:, 265)*sol(:ncol,:, 247) ! rate_const*OH*HO2 + rxt_rates(:ncol,:, 202) = rxt_rates(:ncol,:, 202)*sol(:ncol,:, 265)*sol(:ncol,:, 141) ! rate_const*OH*O + rxt_rates(:ncol,:, 203) = rxt_rates(:ncol,:, 203)*sol(:ncol,:, 265)*sol(:ncol,:, 143) ! rate_const*OH*O3 + rxt_rates(:ncol,:, 204) = rxt_rates(:ncol,:, 204)*sol(:ncol,:, 265)*sol(:ncol,:, 265) ! rate_const*OH*OH + rxt_rates(:ncol,:, 205) = rxt_rates(:ncol,:, 205)*sol(:ncol,:, 265)*sol(:ncol,:, 265) ! rate_const*M*OH*OH + rxt_rates(:ncol,:, 206) = rxt_rates(:ncol,:, 206)*sol(:ncol,:, 247)*sol(:ncol,:, 247) ! rate_const*HO2*HO2 + rxt_rates(:ncol,:, 207) = rxt_rates(:ncol,:, 207)*sol(:ncol,:, 92)*sol(:ncol,:, 265) ! rate_const*HO2NO2*OH + rxt_rates(:ncol,:, 208) = rxt_rates(:ncol,:, 208)*sol(:ncol,:, 256)*sol(:ncol,:, 141) ! rate_const*N2D*O + rxt_rates(:ncol,:, 209) = rxt_rates(:ncol,:, 209)*sol(:ncol,:, 256)*sol(:ncol,:, 142) ! rate_const*N2D*O2 + rxt_rates(:ncol,:, 210) = rxt_rates(:ncol,:, 210)*sol(:ncol,:, 119)*sol(:ncol,:, 131) ! rate_const*N*NO + rxt_rates(:ncol,:, 211) = rxt_rates(:ncol,:, 211)*sol(:ncol,:, 119)*sol(:ncol,:, 132) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 212) = rxt_rates(:ncol,:, 212)*sol(:ncol,:, 119)*sol(:ncol,:, 132) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 213) = rxt_rates(:ncol,:, 213)*sol(:ncol,:, 119)*sol(:ncol,:, 132) ! rate_const*N*NO2 + rxt_rates(:ncol,:, 214) = rxt_rates(:ncol,:, 214)*sol(:ncol,:, 119)*sol(:ncol,:, 142) ! rate_const*N*O2 + rxt_rates(:ncol,:, 215) = rxt_rates(:ncol,:, 215)*sol(:ncol,:, 132)*sol(:ncol,:, 141) ! rate_const*NO2*O + rxt_rates(:ncol,:, 216) = rxt_rates(:ncol,:, 216)*sol(:ncol,:, 132)*sol(:ncol,:, 143) ! rate_const*NO2*O3 + rxt_rates(:ncol,:, 217) = rxt_rates(:ncol,:, 217)*sol(:ncol,:, 132)*sol(:ncol,:, 141) ! rate_const*M*NO2*O + rxt_rates(:ncol,:, 218) = rxt_rates(:ncol,:, 218)*sol(:ncol,:, 133)*sol(:ncol,:, 247) ! rate_const*NO3*HO2 + rxt_rates(:ncol,:, 219) = rxt_rates(:ncol,:, 219)*sol(:ncol,:, 133)*sol(:ncol,:, 131) ! rate_const*NO3*NO + rxt_rates(:ncol,:, 220) = rxt_rates(:ncol,:, 220)*sol(:ncol,:, 133)*sol(:ncol,:, 141) ! rate_const*NO3*O + rxt_rates(:ncol,:, 221) = rxt_rates(:ncol,:, 221)*sol(:ncol,:, 133)*sol(:ncol,:, 265) ! rate_const*NO3*OH + rxt_rates(:ncol,:, 222) = rxt_rates(:ncol,:, 222)*sol(:ncol,:, 119)*sol(:ncol,:, 265) ! rate_const*N*OH + rxt_rates(:ncol,:, 223) = rxt_rates(:ncol,:, 223)*sol(:ncol,:, 131)*sol(:ncol,:, 247) ! rate_const*NO*HO2 + rxt_rates(:ncol,:, 224) = rxt_rates(:ncol,:, 224)*sol(:ncol,:, 131)*sol(:ncol,:, 143) ! rate_const*NO*O3 + rxt_rates(:ncol,:, 225) = rxt_rates(:ncol,:, 225)*sol(:ncol,:, 131)*sol(:ncol,:, 141) ! rate_const*M*NO*O + rxt_rates(:ncol,:, 226) = rxt_rates(:ncol,:, 226)*sol(:ncol,:, 261)*sol(:ncol,:, 120) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 227) = rxt_rates(:ncol,:, 227)*sol(:ncol,:, 261)*sol(:ncol,:, 120) ! rate_const*O1D*N2O + rxt_rates(:ncol,:, 228) = rxt_rates(:ncol,:, 228)*sol(:ncol,:, 132)*sol(:ncol,:, 247) ! rate_const*M*NO2*HO2 + rxt_rates(:ncol,:, 229) = rxt_rates(:ncol,:, 229)*sol(:ncol,:, 132)*sol(:ncol,:, 133) ! rate_const*M*NO2*NO3 + rxt_rates(:ncol,:, 230) = rxt_rates(:ncol,:, 230)*sol(:ncol,:, 132)*sol(:ncol,:, 265) ! rate_const*M*NO2*OH + rxt_rates(:ncol,:, 231) = rxt_rates(:ncol,:, 231)*sol(:ncol,:, 91)*sol(:ncol,:, 265) ! rate_const*HNO3*OH + rxt_rates(:ncol,:, 232) = rxt_rates(:ncol,:, 232)*sol(:ncol,:, 92) ! rate_const*M*HO2NO2 + rxt_rates(:ncol,:, 233) = rxt_rates(:ncol,:, 233)*sol(:ncol,:, 121) ! rate_const*M*N2O5 + rxt_rates(:ncol,:, 234) = rxt_rates(:ncol,:, 234)*sol(:ncol,:, 58)*sol(:ncol,:, 44) ! rate_const*CL*CH2O + rxt_rates(:ncol,:, 235) = rxt_rates(:ncol,:, 235)*sol(:ncol,:, 58)*sol(:ncol,:, 56) ! rate_const*CL*CH4 + rxt_rates(:ncol,:, 236) = rxt_rates(:ncol,:, 236)*sol(:ncol,:, 58)*sol(:ncol,:, 79) ! rate_const*CL*H2 + rxt_rates(:ncol,:, 237) = rxt_rates(:ncol,:, 237)*sol(:ncol,:, 58)*sol(:ncol,:, 81) ! rate_const*CL*H2O2 + rxt_rates(:ncol,:, 238) = rxt_rates(:ncol,:, 238)*sol(:ncol,:, 58)*sol(:ncol,:, 247) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 239) = rxt_rates(:ncol,:, 239)*sol(:ncol,:, 58)*sol(:ncol,:, 247) ! rate_const*CL*HO2 + rxt_rates(:ncol,:, 240) = rxt_rates(:ncol,:, 240)*sol(:ncol,:, 58)*sol(:ncol,:, 143) ! rate_const*CL*O3 + rxt_rates(:ncol,:, 241) = rxt_rates(:ncol,:, 241)*sol(:ncol,:, 61)*sol(:ncol,:, 241) ! rate_const*CLO*CH3O2 + rxt_rates(:ncol,:, 242) = rxt_rates(:ncol,:, 242)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 243) = rxt_rates(:ncol,:, 243)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 244) = rxt_rates(:ncol,:, 244)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*CLO*CLO + rxt_rates(:ncol,:, 245) = rxt_rates(:ncol,:, 245)*sol(:ncol,:, 61)*sol(:ncol,:, 247) ! rate_const*CLO*HO2 + rxt_rates(:ncol,:, 246) = rxt_rates(:ncol,:, 246)*sol(:ncol,:, 61)*sol(:ncol,:, 131) ! rate_const*CLO*NO + rxt_rates(:ncol,:, 247) = rxt_rates(:ncol,:, 247)*sol(:ncol,:, 62)*sol(:ncol,:, 58) ! rate_const*CLONO2*CL + rxt_rates(:ncol,:, 248) = rxt_rates(:ncol,:, 248)*sol(:ncol,:, 61)*sol(:ncol,:, 132) ! rate_const*M*CLO*NO2 + rxt_rates(:ncol,:, 249) = rxt_rates(:ncol,:, 249)*sol(:ncol,:, 62)*sol(:ncol,:, 141) ! rate_const*CLONO2*O + rxt_rates(:ncol,:, 250) = rxt_rates(:ncol,:, 250)*sol(:ncol,:, 62)*sol(:ncol,:, 265) ! rate_const*CLONO2*OH + rxt_rates(:ncol,:, 251) = rxt_rates(:ncol,:, 251)*sol(:ncol,:, 61)*sol(:ncol,:, 141) ! rate_const*CLO*O + rxt_rates(:ncol,:, 252) = rxt_rates(:ncol,:, 252)*sol(:ncol,:, 61)*sol(:ncol,:, 265) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 253) = rxt_rates(:ncol,:, 253)*sol(:ncol,:, 61)*sol(:ncol,:, 265) ! rate_const*CLO*OH + rxt_rates(:ncol,:, 254) = rxt_rates(:ncol,:, 254)*sol(:ncol,:, 87)*sol(:ncol,:, 141) ! rate_const*HCL*O + rxt_rates(:ncol,:, 255) = rxt_rates(:ncol,:, 255)*sol(:ncol,:, 87)*sol(:ncol,:, 265) ! rate_const*HCL*OH + rxt_rates(:ncol,:, 256) = rxt_rates(:ncol,:, 256)*sol(:ncol,:, 94)*sol(:ncol,:, 58) ! rate_const*HOCL*CL + rxt_rates(:ncol,:, 257) = rxt_rates(:ncol,:, 257)*sol(:ncol,:, 94)*sol(:ncol,:, 141) ! rate_const*HOCL*O + rxt_rates(:ncol,:, 258) = rxt_rates(:ncol,:, 258)*sol(:ncol,:, 94)*sol(:ncol,:, 265) ! rate_const*HOCL*OH + rxt_rates(:ncol,:, 259) = rxt_rates(:ncol,:, 259)*sol(:ncol,:, 261)*sol(:ncol,:, 35) ! rate_const*O1D*CCL4 + rxt_rates(:ncol,:, 260) = rxt_rates(:ncol,:, 260)*sol(:ncol,:, 261)*sol(:ncol,:, 36) ! rate_const*O1D*CF2CLBR + rxt_rates(:ncol,:, 261) = rxt_rates(:ncol,:, 261)*sol(:ncol,:, 261)*sol(:ncol,:, 38) ! rate_const*O1D*CFC11 + rxt_rates(:ncol,:, 262) = rxt_rates(:ncol,:, 262)*sol(:ncol,:, 261)*sol(:ncol,:, 39) ! rate_const*O1D*CFC113 + rxt_rates(:ncol,:, 263) = rxt_rates(:ncol,:, 263)*sol(:ncol,:, 261)*sol(:ncol,:, 40) ! rate_const*O1D*CFC114 + rxt_rates(:ncol,:, 264) = rxt_rates(:ncol,:, 264)*sol(:ncol,:, 261)*sol(:ncol,:, 41) ! rate_const*O1D*CFC115 + rxt_rates(:ncol,:, 265) = rxt_rates(:ncol,:, 265)*sol(:ncol,:, 261)*sol(:ncol,:, 42) ! rate_const*O1D*CFC12 + rxt_rates(:ncol,:, 266) = rxt_rates(:ncol,:, 266)*sol(:ncol,:, 261)*sol(:ncol,:, 87) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 267) = rxt_rates(:ncol,:, 267)*sol(:ncol,:, 261)*sol(:ncol,:, 87) ! rate_const*O1D*HCL + rxt_rates(:ncol,:, 268) = rxt_rates(:ncol,:, 268)*sol(:ncol,:, 61)*sol(:ncol,:, 61) ! rate_const*M*CLO*CLO + rxt_rates(:ncol,:, 269) = rxt_rates(:ncol,:, 269)*sol(:ncol,:, 60) ! rate_const*M*CL2O2 + rxt_rates(:ncol,:, 270) = rxt_rates(:ncol,:, 270)*sol(:ncol,:, 19)*sol(:ncol,:, 44) ! rate_const*BR*CH2O + rxt_rates(:ncol,:, 271) = rxt_rates(:ncol,:, 271)*sol(:ncol,:, 19)*sol(:ncol,:, 247) ! rate_const*BR*HO2 + rxt_rates(:ncol,:, 272) = rxt_rates(:ncol,:, 272)*sol(:ncol,:, 19)*sol(:ncol,:, 143) ! rate_const*BR*O3 + rxt_rates(:ncol,:, 273) = rxt_rates(:ncol,:, 273)*sol(:ncol,:, 21)*sol(:ncol,:, 21) ! rate_const*BRO*BRO + rxt_rates(:ncol,:, 274) = rxt_rates(:ncol,:, 274)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 275) = rxt_rates(:ncol,:, 275)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 276) = rxt_rates(:ncol,:, 276)*sol(:ncol,:, 21)*sol(:ncol,:, 61) ! rate_const*BRO*CLO + rxt_rates(:ncol,:, 277) = rxt_rates(:ncol,:, 277)*sol(:ncol,:, 21)*sol(:ncol,:, 247) ! rate_const*BRO*HO2 + rxt_rates(:ncol,:, 278) = rxt_rates(:ncol,:, 278)*sol(:ncol,:, 21)*sol(:ncol,:, 131) ! rate_const*BRO*NO + rxt_rates(:ncol,:, 279) = rxt_rates(:ncol,:, 279)*sol(:ncol,:, 21)*sol(:ncol,:, 132) ! rate_const*M*BRO*NO2 + rxt_rates(:ncol,:, 280) = rxt_rates(:ncol,:, 280)*sol(:ncol,:, 22)*sol(:ncol,:, 141) ! rate_const*BRONO2*O + rxt_rates(:ncol,:, 281) = rxt_rates(:ncol,:, 281)*sol(:ncol,:, 21)*sol(:ncol,:, 141) ! rate_const*BRO*O + rxt_rates(:ncol,:, 282) = rxt_rates(:ncol,:, 282)*sol(:ncol,:, 21)*sol(:ncol,:, 265) ! rate_const*BRO*OH + rxt_rates(:ncol,:, 283) = rxt_rates(:ncol,:, 283)*sol(:ncol,:, 83)*sol(:ncol,:, 141) ! rate_const*HBR*O + rxt_rates(:ncol,:, 284) = rxt_rates(:ncol,:, 284)*sol(:ncol,:, 83)*sol(:ncol,:, 265) ! rate_const*HBR*OH + rxt_rates(:ncol,:, 285) = rxt_rates(:ncol,:, 285)*sol(:ncol,:, 93)*sol(:ncol,:, 141) ! rate_const*HOBR*O + rxt_rates(:ncol,:, 286) = rxt_rates(:ncol,:, 286)*sol(:ncol,:, 261)*sol(:ncol,:, 37) ! rate_const*O1D*CF3BR + rxt_rates(:ncol,:, 287) = rxt_rates(:ncol,:, 287)*sol(:ncol,:, 261)*sol(:ncol,:, 57) ! rate_const*O1D*CHBR3 + rxt_rates(:ncol,:, 288) = rxt_rates(:ncol,:, 288)*sol(:ncol,:, 261)*sol(:ncol,:, 80) ! rate_const*O1D*H2402 + rxt_rates(:ncol,:, 289) = rxt_rates(:ncol,:, 289)*sol(:ncol,:, 261)*sol(:ncol,:, 83) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 290) = rxt_rates(:ncol,:, 290)*sol(:ncol,:, 261)*sol(:ncol,:, 83) ! rate_const*O1D*HBR + rxt_rates(:ncol,:, 291) = rxt_rates(:ncol,:, 291)*sol(:ncol,:, 75)*sol(:ncol,:, 56) ! rate_const*F*CH4 + rxt_rates(:ncol,:, 292) = rxt_rates(:ncol,:, 292)*sol(:ncol,:, 75)*sol(:ncol,:, 79) ! rate_const*F*H2 + rxt_rates(:ncol,:, 293) = rxt_rates(:ncol,:, 293)*sol(:ncol,:, 75)*sol(:ncol,:, 276) ! rate_const*F*H2O + rxt_rates(:ncol,:, 294) = rxt_rates(:ncol,:, 294)*sol(:ncol,:, 75)*sol(:ncol,:, 91) ! rate_const*F*HNO3 + rxt_rates(:ncol,:, 295) = rxt_rates(:ncol,:, 295)*sol(:ncol,:, 261)*sol(:ncol,:, 66) ! rate_const*O1D*COF2 + rxt_rates(:ncol,:, 296) = rxt_rates(:ncol,:, 296)*sol(:ncol,:, 261)*sol(:ncol,:, 67) ! rate_const*O1D*COFCL + rxt_rates(:ncol,:, 297) = rxt_rates(:ncol,:, 297)*sol(:ncol,:, 43)*sol(:ncol,:, 58) ! rate_const*CH2BR2*CL + rxt_rates(:ncol,:, 298) = rxt_rates(:ncol,:, 298)*sol(:ncol,:, 43)*sol(:ncol,:, 265) ! rate_const*CH2BR2*OH + rxt_rates(:ncol,:, 299) = rxt_rates(:ncol,:, 299)*sol(:ncol,:, 45)*sol(:ncol,:, 58) ! rate_const*CH3BR*CL + rxt_rates(:ncol,:, 300) = rxt_rates(:ncol,:, 300)*sol(:ncol,:, 45)*sol(:ncol,:, 265) ! rate_const*CH3BR*OH + rxt_rates(:ncol,:, 301) = rxt_rates(:ncol,:, 301)*sol(:ncol,:, 46)*sol(:ncol,:, 265) ! rate_const*CH3CCL3*OH + rxt_rates(:ncol,:, 302) = rxt_rates(:ncol,:, 302)*sol(:ncol,:, 48)*sol(:ncol,:, 58) ! rate_const*CH3CL*CL + rxt_rates(:ncol,:, 303) = rxt_rates(:ncol,:, 303)*sol(:ncol,:, 48)*sol(:ncol,:, 265) ! rate_const*CH3CL*OH + rxt_rates(:ncol,:, 304) = rxt_rates(:ncol,:, 304)*sol(:ncol,:, 57)*sol(:ncol,:, 58) ! rate_const*CHBR3*CL + rxt_rates(:ncol,:, 305) = rxt_rates(:ncol,:, 305)*sol(:ncol,:, 57)*sol(:ncol,:, 265) ! rate_const*CHBR3*OH + rxt_rates(:ncol,:, 306) = rxt_rates(:ncol,:, 306)*sol(:ncol,:, 84)*sol(:ncol,:, 265) ! rate_const*HCFC141B*OH + rxt_rates(:ncol,:, 307) = rxt_rates(:ncol,:, 307)*sol(:ncol,:, 85)*sol(:ncol,:, 265) ! rate_const*HCFC142B*OH + rxt_rates(:ncol,:, 308) = rxt_rates(:ncol,:, 308)*sol(:ncol,:, 86)*sol(:ncol,:, 265) ! rate_const*HCFC22*OH + rxt_rates(:ncol,:, 309) = rxt_rates(:ncol,:, 309)*sol(:ncol,:, 261)*sol(:ncol,:, 43) ! rate_const*O1D*CH2BR2 + rxt_rates(:ncol,:, 310) = rxt_rates(:ncol,:, 310)*sol(:ncol,:, 261)*sol(:ncol,:, 45) ! rate_const*O1D*CH3BR + rxt_rates(:ncol,:, 311) = rxt_rates(:ncol,:, 311)*sol(:ncol,:, 261)*sol(:ncol,:, 84) ! rate_const*O1D*HCFC141B + rxt_rates(:ncol,:, 312) = rxt_rates(:ncol,:, 312)*sol(:ncol,:, 261)*sol(:ncol,:, 85) ! rate_const*O1D*HCFC142B + rxt_rates(:ncol,:, 313) = rxt_rates(:ncol,:, 313)*sol(:ncol,:, 261)*sol(:ncol,:, 86) ! rate_const*O1D*HCFC22 + rxt_rates(:ncol,:, 314) = rxt_rates(:ncol,:, 314)*sol(:ncol,:, 44)*sol(:ncol,:, 247) ! rate_const*CH2O*HO2 + rxt_rates(:ncol,:, 315) = rxt_rates(:ncol,:, 315)*sol(:ncol,:, 44)*sol(:ncol,:, 133) ! rate_const*CH2O*NO3 + rxt_rates(:ncol,:, 316) = rxt_rates(:ncol,:, 316)*sol(:ncol,:, 44)*sol(:ncol,:, 141) ! rate_const*CH2O*O + rxt_rates(:ncol,:, 317) = rxt_rates(:ncol,:, 317)*sol(:ncol,:, 44)*sol(:ncol,:, 265) ! rate_const*CH2O*OH + rxt_rates(:ncol,:, 318) = rxt_rates(:ncol,:, 318)*sol(:ncol,:, 241)*sol(:ncol,:, 241) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 319) = rxt_rates(:ncol,:, 319)*sol(:ncol,:, 241)*sol(:ncol,:, 241) ! rate_const*CH3O2*CH3O2 + rxt_rates(:ncol,:, 320) = rxt_rates(:ncol,:, 320)*sol(:ncol,:, 241)*sol(:ncol,:, 247) ! rate_const*CH3O2*HO2 + rxt_rates(:ncol,:, 321) = rxt_rates(:ncol,:, 321)*sol(:ncol,:, 241)*sol(:ncol,:, 131) ! rate_const*CH3O2*NO + rxt_rates(:ncol,:, 322) = rxt_rates(:ncol,:, 322)*sol(:ncol,:, 54)*sol(:ncol,:, 265) ! rate_const*CH3OH*OH + rxt_rates(:ncol,:, 323) = rxt_rates(:ncol,:, 323)*sol(:ncol,:, 55)*sol(:ncol,:, 265) ! rate_const*CH3OOH*OH + rxt_rates(:ncol,:, 324) = rxt_rates(:ncol,:, 324)*sol(:ncol,:, 56)*sol(:ncol,:, 265) ! rate_const*CH4*OH + rxt_rates(:ncol,:, 325) = rxt_rates(:ncol,:, 325)*sol(:ncol,:, 88)*sol(:ncol,:, 265) ! rate_const*M*HCN*OH + rxt_rates(:ncol,:, 326) = rxt_rates(:ncol,:, 326)*sol(:ncol,:, 89)*sol(:ncol,:, 265) ! rate_const*HCOOH*OH + rxt_rates(:ncol,:, 327) = rxt_rates(:ncol,:, 327)*sol(:ncol,:, 248)*sol(:ncol,:, 247) ! rate_const*HOCH2OO*HO2 + rxt_rates(:ncol,:, 328) = rxt_rates(:ncol,:, 328)*sol(:ncol,:, 248) ! rate_const*HOCH2OO + rxt_rates(:ncol,:, 329) = rxt_rates(:ncol,:, 329)*sol(:ncol,:, 248)*sol(:ncol,:, 131) ! rate_const*HOCH2OO*NO + rxt_rates(:ncol,:, 330) = rxt_rates(:ncol,:, 330)*sol(:ncol,:, 261)*sol(:ncol,:, 56) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 331) = rxt_rates(:ncol,:, 331)*sol(:ncol,:, 261)*sol(:ncol,:, 56) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 332) = rxt_rates(:ncol,:, 332)*sol(:ncol,:, 261)*sol(:ncol,:, 56) ! rate_const*O1D*CH4 + rxt_rates(:ncol,:, 333) = rxt_rates(:ncol,:, 333)*sol(:ncol,:, 261)*sol(:ncol,:, 88) ! rate_const*O1D*HCN + rxt_rates(:ncol,:, 334) = rxt_rates(:ncol,:, 334)*sol(:ncol,:, 64)*sol(:ncol,:, 265) ! rate_const*CO*OH + rxt_rates(:ncol,:, 335) = rxt_rates(:ncol,:, 335)*sol(:ncol,:, 26)*sol(:ncol,:, 58) ! rate_const*M*C2H2*CL + rxt_rates(:ncol,:, 336) = rxt_rates(:ncol,:, 336)*sol(:ncol,:, 26)*sol(:ncol,:, 265) ! rate_const*M*C2H2*OH + rxt_rates(:ncol,:, 337) = rxt_rates(:ncol,:, 337)*sol(:ncol,:, 27)*sol(:ncol,:, 58) ! rate_const*M*C2H4*CL + rxt_rates(:ncol,:, 338) = rxt_rates(:ncol,:, 338)*sol(:ncol,:, 27)*sol(:ncol,:, 143) ! rate_const*C2H4*O3 + rxt_rates(:ncol,:, 339) = rxt_rates(:ncol,:, 339)*sol(:ncol,:, 237)*sol(:ncol,:, 237) ! rate_const*C2H5O2*C2H5O2 + rxt_rates(:ncol,:, 340) = rxt_rates(:ncol,:, 340)*sol(:ncol,:, 237)*sol(:ncol,:, 241) ! rate_const*C2H5O2*CH3O2 + rxt_rates(:ncol,:, 341) = rxt_rates(:ncol,:, 341)*sol(:ncol,:, 237)*sol(:ncol,:, 247) ! rate_const*C2H5O2*HO2 + rxt_rates(:ncol,:, 342) = rxt_rates(:ncol,:, 342)*sol(:ncol,:, 237)*sol(:ncol,:, 131) ! rate_const*C2H5O2*NO + rxt_rates(:ncol,:, 343) = rxt_rates(:ncol,:, 343)*sol(:ncol,:, 28)*sol(:ncol,:, 265) ! rate_const*C2H5OH*OH + rxt_rates(:ncol,:, 344) = rxt_rates(:ncol,:, 344)*sol(:ncol,:, 29)*sol(:ncol,:, 265) ! rate_const*C2H5OOH*OH + rxt_rates(:ncol,:, 345) = rxt_rates(:ncol,:, 345)*sol(:ncol,:, 30)*sol(:ncol,:, 58) ! rate_const*C2H6*CL + rxt_rates(:ncol,:, 346) = rxt_rates(:ncol,:, 346)*sol(:ncol,:, 30)*sol(:ncol,:, 265) ! rate_const*C2H6*OH + rxt_rates(:ncol,:, 347) = rxt_rates(:ncol,:, 347)*sol(:ncol,:, 47)*sol(:ncol,:, 133) ! rate_const*CH3CHO*NO3 + rxt_rates(:ncol,:, 348) = rxt_rates(:ncol,:, 348)*sol(:ncol,:, 47)*sol(:ncol,:, 265) ! rate_const*CH3CHO*OH + rxt_rates(:ncol,:, 349) = rxt_rates(:ncol,:, 349)*sol(:ncol,:, 49)*sol(:ncol,:, 265) ! rate_const*CH3CN*OH + rxt_rates(:ncol,:, 350) = rxt_rates(:ncol,:, 350)*sol(:ncol,:, 240)*sol(:ncol,:, 240) ! rate_const*CH3CO3*CH3CO3 + rxt_rates(:ncol,:, 351) = rxt_rates(:ncol,:, 351)*sol(:ncol,:, 240)*sol(:ncol,:, 241) ! rate_const*CH3CO3*CH3O2 + rxt_rates(:ncol,:, 352) = rxt_rates(:ncol,:, 352)*sol(:ncol,:, 240)*sol(:ncol,:, 247) ! rate_const*CH3CO3*HO2 + rxt_rates(:ncol,:, 353) = rxt_rates(:ncol,:, 353)*sol(:ncol,:, 240)*sol(:ncol,:, 131) ! rate_const*CH3CO3*NO + rxt_rates(:ncol,:, 354) = rxt_rates(:ncol,:, 354)*sol(:ncol,:, 52)*sol(:ncol,:, 265) ! rate_const*CH3COOH*OH + rxt_rates(:ncol,:, 355) = rxt_rates(:ncol,:, 355)*sol(:ncol,:, 53)*sol(:ncol,:, 265) ! rate_const*CH3COOOH*OH + rxt_rates(:ncol,:, 356) = rxt_rates(:ncol,:, 356)*sol(:ncol,:, 246)*sol(:ncol,:, 247) ! rate_const*EO2*HO2 + rxt_rates(:ncol,:, 357) = rxt_rates(:ncol,:, 357)*sol(:ncol,:, 246)*sol(:ncol,:, 131) ! rate_const*EO2*NO + rxt_rates(:ncol,:, 358) = rxt_rates(:ncol,:, 358)*sol(:ncol,:, 245) ! rate_const*EO + rxt_rates(:ncol,:, 359) = rxt_rates(:ncol,:, 359)*sol(:ncol,:, 245)*sol(:ncol,:, 142) ! rate_const*EO*O2 + rxt_rates(:ncol,:, 360) = rxt_rates(:ncol,:, 360)*sol(:ncol,:, 76)*sol(:ncol,:, 265) ! rate_const*GLYALD*OH + rxt_rates(:ncol,:, 361) = rxt_rates(:ncol,:, 361)*sol(:ncol,:, 77)*sol(:ncol,:, 265) ! rate_const*GLYOXAL*OH + rxt_rates(:ncol,:, 362) = rxt_rates(:ncol,:, 362)*sol(:ncol,:, 148)*sol(:ncol,:, 265) ! rate_const*PAN*OH + rxt_rates(:ncol,:, 363) = rxt_rates(:ncol,:, 363)*sol(:ncol,:, 27)*sol(:ncol,:, 265) ! rate_const*M*C2H4*OH + rxt_rates(:ncol,:, 364) = rxt_rates(:ncol,:, 364)*sol(:ncol,:, 240)*sol(:ncol,:, 132) ! rate_const*M*CH3CO3*NO2 + rxt_rates(:ncol,:, 365) = rxt_rates(:ncol,:, 365)*sol(:ncol,:, 148) ! rate_const*M*PAN + rxt_rates(:ncol,:, 366) = rxt_rates(:ncol,:, 366)*sol(:ncol,:, 31)*sol(:ncol,:, 133) ! rate_const*C3H6*NO3 + rxt_rates(:ncol,:, 367) = rxt_rates(:ncol,:, 367)*sol(:ncol,:, 31)*sol(:ncol,:, 143) ! rate_const*C3H6*O3 + rxt_rates(:ncol,:, 368) = rxt_rates(:ncol,:, 368)*sol(:ncol,:, 238)*sol(:ncol,:, 241) ! rate_const*C3H7O2*CH3O2 + rxt_rates(:ncol,:, 369) = rxt_rates(:ncol,:, 369)*sol(:ncol,:, 238)*sol(:ncol,:, 247) ! rate_const*C3H7O2*HO2 + rxt_rates(:ncol,:, 370) = rxt_rates(:ncol,:, 370)*sol(:ncol,:, 238)*sol(:ncol,:, 131) ! rate_const*C3H7O2*NO + rxt_rates(:ncol,:, 371) = rxt_rates(:ncol,:, 371)*sol(:ncol,:, 32)*sol(:ncol,:, 265) ! rate_const*C3H7OOH*OH + rxt_rates(:ncol,:, 372) = rxt_rates(:ncol,:, 372)*sol(:ncol,:, 33)*sol(:ncol,:, 265) ! rate_const*C3H8*OH + rxt_rates(:ncol,:, 373) = rxt_rates(:ncol,:, 373)*sol(:ncol,:, 51)*sol(:ncol,:, 133) ! rate_const*CH3COCHO*NO3 + rxt_rates(:ncol,:, 374) = rxt_rates(:ncol,:, 374)*sol(:ncol,:, 51)*sol(:ncol,:, 265) ! rate_const*CH3COCHO*OH + rxt_rates(:ncol,:, 375) = rxt_rates(:ncol,:, 375)*sol(:ncol,:, 58)*sol(:ncol,:, 33) ! rate_const*CL*C3H8 + rxt_rates(:ncol,:, 376) = rxt_rates(:ncol,:, 376)*sol(:ncol,:, 97)*sol(:ncol,:, 265) ! rate_const*HYAC*OH + rxt_rates(:ncol,:, 377) = rxt_rates(:ncol,:, 377)*sol(:ncol,:, 134)*sol(:ncol,:, 265) ! rate_const*NOA*OH + rxt_rates(:ncol,:, 378) = rxt_rates(:ncol,:, 378)*sol(:ncol,:, 268)*sol(:ncol,:, 247) ! rate_const*PO2*HO2 + rxt_rates(:ncol,:, 379) = rxt_rates(:ncol,:, 379)*sol(:ncol,:, 268)*sol(:ncol,:, 131) ! rate_const*PO2*NO + rxt_rates(:ncol,:, 380) = rxt_rates(:ncol,:, 380)*sol(:ncol,:, 157)*sol(:ncol,:, 265) ! rate_const*POOH*OH + rxt_rates(:ncol,:, 381) = rxt_rates(:ncol,:, 381)*sol(:ncol,:, 269)*sol(:ncol,:, 241) ! rate_const*RO2*CH3O2 + rxt_rates(:ncol,:, 382) = rxt_rates(:ncol,:, 382)*sol(:ncol,:, 269)*sol(:ncol,:, 247) ! rate_const*RO2*HO2 + rxt_rates(:ncol,:, 383) = rxt_rates(:ncol,:, 383)*sol(:ncol,:, 269)*sol(:ncol,:, 131) ! rate_const*RO2*NO + rxt_rates(:ncol,:, 384) = rxt_rates(:ncol,:, 384)*sol(:ncol,:, 158)*sol(:ncol,:, 265) ! rate_const*ROOH*OH + rxt_rates(:ncol,:, 385) = rxt_rates(:ncol,:, 385)*sol(:ncol,:, 31)*sol(:ncol,:, 265) ! rate_const*M*C3H6*OH + rxt_rates(:ncol,:, 386) = rxt_rates(:ncol,:, 386)*sol(:ncol,:, 50)*sol(:ncol,:, 265) ! rate_const*CH3COCH3*OH + rxt_rates(:ncol,:, 387) = rxt_rates(:ncol,:, 387)*sol(:ncol,:, 18)*sol(:ncol,:, 133) ! rate_const*BIGENE*NO3 + rxt_rates(:ncol,:, 388) = rxt_rates(:ncol,:, 388)*sol(:ncol,:, 18)*sol(:ncol,:, 265) ! rate_const*BIGENE*OH + rxt_rates(:ncol,:, 389) = rxt_rates(:ncol,:, 389)*sol(:ncol,:, 244)*sol(:ncol,:, 131) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 390) = rxt_rates(:ncol,:, 390)*sol(:ncol,:, 244)*sol(:ncol,:, 131) ! rate_const*ENEO2*NO + rxt_rates(:ncol,:, 391) = rxt_rates(:ncol,:, 391)*sol(:ncol,:, 95)*sol(:ncol,:, 265) ! rate_const*HONITR*OH + rxt_rates(:ncol,:, 392) = rxt_rates(:ncol,:, 392)*sol(:ncol,:, 251)*sol(:ncol,:, 240) ! rate_const*MACRO2*CH3CO3 + rxt_rates(:ncol,:, 393) = rxt_rates(:ncol,:, 393)*sol(:ncol,:, 251)*sol(:ncol,:, 241) ! rate_const*MACRO2*CH3O2 + rxt_rates(:ncol,:, 394) = rxt_rates(:ncol,:, 394)*sol(:ncol,:, 251)*sol(:ncol,:, 247) ! rate_const*MACRO2*HO2 + rxt_rates(:ncol,:, 395) = rxt_rates(:ncol,:, 395)*sol(:ncol,:, 251)*sol(:ncol,:, 133) ! rate_const*MACRO2*NO3 + rxt_rates(:ncol,:, 396) = rxt_rates(:ncol,:, 396)*sol(:ncol,:, 251)*sol(:ncol,:, 131) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 397) = rxt_rates(:ncol,:, 397)*sol(:ncol,:, 251)*sol(:ncol,:, 131) ! rate_const*MACRO2*NO + rxt_rates(:ncol,:, 398) = rxt_rates(:ncol,:, 398)*sol(:ncol,:, 111)*sol(:ncol,:, 143) ! rate_const*MACR*O3 + rxt_rates(:ncol,:, 399) = rxt_rates(:ncol,:, 399)*sol(:ncol,:, 111)*sol(:ncol,:, 265) ! rate_const*MACR*OH + rxt_rates(:ncol,:, 400) = rxt_rates(:ncol,:, 400)*sol(:ncol,:, 112)*sol(:ncol,:, 265) ! rate_const*MACROOH*OH + rxt_rates(:ncol,:, 401) = rxt_rates(:ncol,:, 401)*sol(:ncol,:, 253)*sol(:ncol,:, 240) ! rate_const*MCO3*CH3CO3 + rxt_rates(:ncol,:, 402) = rxt_rates(:ncol,:, 402)*sol(:ncol,:, 253)*sol(:ncol,:, 241) ! rate_const*MCO3*CH3O2 + rxt_rates(:ncol,:, 403) = rxt_rates(:ncol,:, 403)*sol(:ncol,:, 253)*sol(:ncol,:, 247) ! rate_const*MCO3*HO2 + rxt_rates(:ncol,:, 404) = rxt_rates(:ncol,:, 404)*sol(:ncol,:, 253)*sol(:ncol,:, 253) ! rate_const*MCO3*MCO3 + rxt_rates(:ncol,:, 405) = rxt_rates(:ncol,:, 405)*sol(:ncol,:, 253)*sol(:ncol,:, 131) ! rate_const*MCO3*NO + rxt_rates(:ncol,:, 406) = rxt_rates(:ncol,:, 406)*sol(:ncol,:, 253)*sol(:ncol,:, 133) ! rate_const*MCO3*NO3 + rxt_rates(:ncol,:, 407) = rxt_rates(:ncol,:, 407)*sol(:ncol,:, 255)*sol(:ncol,:, 247) ! rate_const*MEKO2*HO2 + rxt_rates(:ncol,:, 408) = rxt_rates(:ncol,:, 408)*sol(:ncol,:, 255)*sol(:ncol,:, 131) ! rate_const*MEKO2*NO + rxt_rates(:ncol,:, 409) = rxt_rates(:ncol,:, 409)*sol(:ncol,:, 113)*sol(:ncol,:, 265) ! rate_const*MEK*OH + rxt_rates(:ncol,:, 410) = rxt_rates(:ncol,:, 410)*sol(:ncol,:, 114)*sol(:ncol,:, 265) ! rate_const*MEKOOH*OH + rxt_rates(:ncol,:, 411) = rxt_rates(:ncol,:, 411)*sol(:ncol,:, 115)*sol(:ncol,:, 265) ! rate_const*M*MPAN*OH + rxt_rates(:ncol,:, 412) = rxt_rates(:ncol,:, 412)*sol(:ncol,:, 118)*sol(:ncol,:, 143) ! rate_const*MVK*O3 + rxt_rates(:ncol,:, 413) = rxt_rates(:ncol,:, 413)*sol(:ncol,:, 118)*sol(:ncol,:, 265) ! rate_const*MVK*OH + rxt_rates(:ncol,:, 414) = rxt_rates(:ncol,:, 414)*sol(:ncol,:, 253)*sol(:ncol,:, 132) ! rate_const*M*MCO3*NO2 + rxt_rates(:ncol,:, 415) = rxt_rates(:ncol,:, 415)*sol(:ncol,:, 115) ! rate_const*M*MPAN + rxt_rates(:ncol,:, 416) = rxt_rates(:ncol,:, 416)*sol(:ncol,:, 1)*sol(:ncol,:, 265) ! rate_const*ALKNIT*OH + rxt_rates(:ncol,:, 417) = rxt_rates(:ncol,:, 417)*sol(:ncol,:, 234)*sol(:ncol,:, 247) ! rate_const*ALKO2*HO2 + rxt_rates(:ncol,:, 418) = rxt_rates(:ncol,:, 418)*sol(:ncol,:, 234)*sol(:ncol,:, 131) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 419) = rxt_rates(:ncol,:, 419)*sol(:ncol,:, 234)*sol(:ncol,:, 131) ! rate_const*ALKO2*NO + rxt_rates(:ncol,:, 420) = rxt_rates(:ncol,:, 420)*sol(:ncol,:, 2)*sol(:ncol,:, 265) ! rate_const*ALKOOH*OH + rxt_rates(:ncol,:, 421) = rxt_rates(:ncol,:, 421)*sol(:ncol,:, 17)*sol(:ncol,:, 265) ! rate_const*BIGALK*OH + rxt_rates(:ncol,:, 422) = rxt_rates(:ncol,:, 422)*sol(:ncol,:, 96)*sol(:ncol,:, 265) ! rate_const*HPALD*OH + rxt_rates(:ncol,:, 423) = rxt_rates(:ncol,:, 423)*sol(:ncol,:, 98)*sol(:ncol,:, 265) ! rate_const*HYDRALD*OH + rxt_rates(:ncol,:, 424) = rxt_rates(:ncol,:, 424)*sol(:ncol,:, 99)*sol(:ncol,:, 265) ! rate_const*IEPOX*OH + rxt_rates(:ncol,:, 425) = rxt_rates(:ncol,:, 425)*sol(:ncol,:, 249)*sol(:ncol,:, 240) ! rate_const*ISOPAO2*CH3CO3 + rxt_rates(:ncol,:, 426) = rxt_rates(:ncol,:, 426)*sol(:ncol,:, 249)*sol(:ncol,:, 241) ! rate_const*ISOPAO2*CH3O2 + rxt_rates(:ncol,:, 427) = rxt_rates(:ncol,:, 427)*sol(:ncol,:, 249)*sol(:ncol,:, 247) ! rate_const*ISOPAO2*HO2 + rxt_rates(:ncol,:, 428) = rxt_rates(:ncol,:, 428)*sol(:ncol,:, 249)*sol(:ncol,:, 131) ! rate_const*ISOPAO2*NO + rxt_rates(:ncol,:, 429) = rxt_rates(:ncol,:, 429)*sol(:ncol,:, 249)*sol(:ncol,:, 133) ! rate_const*ISOPAO2*NO3 + rxt_rates(:ncol,:, 430) = rxt_rates(:ncol,:, 430)*sol(:ncol,:, 250)*sol(:ncol,:, 240) ! rate_const*ISOPBO2*CH3CO3 + rxt_rates(:ncol,:, 431) = rxt_rates(:ncol,:, 431)*sol(:ncol,:, 250)*sol(:ncol,:, 241) ! rate_const*ISOPBO2*CH3O2 + rxt_rates(:ncol,:, 432) = rxt_rates(:ncol,:, 432)*sol(:ncol,:, 250)*sol(:ncol,:, 247) ! rate_const*ISOPBO2*HO2 + rxt_rates(:ncol,:, 433) = rxt_rates(:ncol,:, 433)*sol(:ncol,:, 250) ! rate_const*ISOPBO2 + rxt_rates(:ncol,:, 434) = rxt_rates(:ncol,:, 434)*sol(:ncol,:, 250)*sol(:ncol,:, 131) ! rate_const*ISOPBO2*NO + rxt_rates(:ncol,:, 435) = rxt_rates(:ncol,:, 435)*sol(:ncol,:, 250)*sol(:ncol,:, 133) ! rate_const*ISOPBO2*NO3 + rxt_rates(:ncol,:, 436) = rxt_rates(:ncol,:, 436)*sol(:ncol,:, 101)*sol(:ncol,:, 265) ! rate_const*ISOPNITA*OH + rxt_rates(:ncol,:, 437) = rxt_rates(:ncol,:, 437)*sol(:ncol,:, 102)*sol(:ncol,:, 265) ! rate_const*ISOPNITB*OH + rxt_rates(:ncol,:, 438) = rxt_rates(:ncol,:, 438)*sol(:ncol,:, 100)*sol(:ncol,:, 133) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 439) = rxt_rates(:ncol,:, 439)*sol(:ncol,:, 103)*sol(:ncol,:, 240) ! rate_const*ISOPNO3*CH3CO3 + rxt_rates(:ncol,:, 440) = rxt_rates(:ncol,:, 440)*sol(:ncol,:, 103)*sol(:ncol,:, 241) ! rate_const*ISOPNO3*CH3O2 + rxt_rates(:ncol,:, 441) = rxt_rates(:ncol,:, 441)*sol(:ncol,:, 103)*sol(:ncol,:, 247) ! rate_const*ISOPNO3*HO2 + rxt_rates(:ncol,:, 442) = rxt_rates(:ncol,:, 442)*sol(:ncol,:, 103)*sol(:ncol,:, 131) ! rate_const*ISOPNO3*NO + rxt_rates(:ncol,:, 443) = rxt_rates(:ncol,:, 443)*sol(:ncol,:, 103)*sol(:ncol,:, 133) ! rate_const*ISOPNO3*NO3 + rxt_rates(:ncol,:, 444) = rxt_rates(:ncol,:, 444)*sol(:ncol,:, 104)*sol(:ncol,:, 265) ! rate_const*ISOPNOOH*OH + rxt_rates(:ncol,:, 445) = rxt_rates(:ncol,:, 445)*sol(:ncol,:, 100)*sol(:ncol,:, 143) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 446) = rxt_rates(:ncol,:, 446)*sol(:ncol,:, 100)*sol(:ncol,:, 265) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 447) = rxt_rates(:ncol,:, 447)*sol(:ncol,:, 106)*sol(:ncol,:, 265) ! rate_const*ISOPOOH*OH + rxt_rates(:ncol,:, 448) = rxt_rates(:ncol,:, 448)*sol(:ncol,:, 122)*sol(:ncol,:, 265) ! rate_const*NC4CH2OH*OH + rxt_rates(:ncol,:, 449) = rxt_rates(:ncol,:, 449)*sol(:ncol,:, 123)*sol(:ncol,:, 265) ! rate_const*NC4CHO*OH + rxt_rates(:ncol,:, 450) = rxt_rates(:ncol,:, 450)*sol(:ncol,:, 273)*sol(:ncol,:, 240) ! rate_const*XO2*CH3CO3 + rxt_rates(:ncol,:, 451) = rxt_rates(:ncol,:, 451)*sol(:ncol,:, 273)*sol(:ncol,:, 241) ! rate_const*XO2*CH3O2 + rxt_rates(:ncol,:, 452) = rxt_rates(:ncol,:, 452)*sol(:ncol,:, 273)*sol(:ncol,:, 247) ! rate_const*XO2*HO2 + rxt_rates(:ncol,:, 453) = rxt_rates(:ncol,:, 453)*sol(:ncol,:, 273)*sol(:ncol,:, 131) ! rate_const*XO2*NO + rxt_rates(:ncol,:, 454) = rxt_rates(:ncol,:, 454)*sol(:ncol,:, 273)*sol(:ncol,:, 133) ! rate_const*XO2*NO3 + rxt_rates(:ncol,:, 455) = rxt_rates(:ncol,:, 455)*sol(:ncol,:, 225)*sol(:ncol,:, 265) ! rate_const*XOOH*OH + rxt_rates(:ncol,:, 456) = rxt_rates(:ncol,:, 456)*sol(:ncol,:, 233)*sol(:ncol,:, 247) ! rate_const*ACBZO2*HO2 + rxt_rates(:ncol,:, 457) = rxt_rates(:ncol,:, 457)*sol(:ncol,:, 233)*sol(:ncol,:, 131) ! rate_const*ACBZO2*NO + rxt_rates(:ncol,:, 458) = rxt_rates(:ncol,:, 458)*sol(:ncol,:, 8)*sol(:ncol,:, 265) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 459) = rxt_rates(:ncol,:, 459)*sol(:ncol,:, 235)*sol(:ncol,:, 247) ! rate_const*BENZO2*HO2 + rxt_rates(:ncol,:, 460) = rxt_rates(:ncol,:, 460)*sol(:ncol,:, 235)*sol(:ncol,:, 131) ! rate_const*BENZO2*NO + rxt_rates(:ncol,:, 461) = rxt_rates(:ncol,:, 461)*sol(:ncol,:, 10)*sol(:ncol,:, 265) ! rate_const*BENZOOH*OH + rxt_rates(:ncol,:, 462) = rxt_rates(:ncol,:, 462)*sol(:ncol,:, 24)*sol(:ncol,:, 265) ! rate_const*BZALD*OH + rxt_rates(:ncol,:, 463) = rxt_rates(:ncol,:, 463)*sol(:ncol,:, 236)*sol(:ncol,:, 247) ! rate_const*BZOO*HO2 + rxt_rates(:ncol,:, 464) = rxt_rates(:ncol,:, 464)*sol(:ncol,:, 25)*sol(:ncol,:, 265) ! rate_const*BZOOH*OH + rxt_rates(:ncol,:, 465) = rxt_rates(:ncol,:, 465)*sol(:ncol,:, 236)*sol(:ncol,:, 131) ! rate_const*BZOO*NO + rxt_rates(:ncol,:, 466) = rxt_rates(:ncol,:, 466)*sol(:ncol,:, 239)*sol(:ncol,:, 247) ! rate_const*C6H5O2*HO2 + rxt_rates(:ncol,:, 467) = rxt_rates(:ncol,:, 467)*sol(:ncol,:, 239)*sol(:ncol,:, 131) ! rate_const*C6H5O2*NO + rxt_rates(:ncol,:, 468) = rxt_rates(:ncol,:, 468)*sol(:ncol,:, 34)*sol(:ncol,:, 265) ! rate_const*C6H5OOH*OH + rxt_rates(:ncol,:, 469) = rxt_rates(:ncol,:, 469)*sol(:ncol,:, 68)*sol(:ncol,:, 265) ! rate_const*CRESOL*OH + rxt_rates(:ncol,:, 470) = rxt_rates(:ncol,:, 470)*sol(:ncol,:, 242)*sol(:ncol,:, 247) ! rate_const*DICARBO2*HO2 + rxt_rates(:ncol,:, 471) = rxt_rates(:ncol,:, 471)*sol(:ncol,:, 242)*sol(:ncol,:, 131) ! rate_const*DICARBO2*NO + rxt_rates(:ncol,:, 472) = rxt_rates(:ncol,:, 472)*sol(:ncol,:, 242)*sol(:ncol,:, 132) ! rate_const*M*DICARBO2*NO2 + rxt_rates(:ncol,:, 473) = rxt_rates(:ncol,:, 473)*sol(:ncol,:, 252)*sol(:ncol,:, 247) ! rate_const*MALO2*HO2 + rxt_rates(:ncol,:, 474) = rxt_rates(:ncol,:, 474)*sol(:ncol,:, 252)*sol(:ncol,:, 131) ! rate_const*MALO2*NO + rxt_rates(:ncol,:, 475) = rxt_rates(:ncol,:, 475)*sol(:ncol,:, 252)*sol(:ncol,:, 132) ! rate_const*M*MALO2*NO2 + rxt_rates(:ncol,:, 476) = rxt_rates(:ncol,:, 476)*sol(:ncol,:, 254)*sol(:ncol,:, 247) ! rate_const*MDIALO2*HO2 + rxt_rates(:ncol,:, 477) = rxt_rates(:ncol,:, 477)*sol(:ncol,:, 254)*sol(:ncol,:, 131) ! rate_const*MDIALO2*NO + rxt_rates(:ncol,:, 478) = rxt_rates(:ncol,:, 478)*sol(:ncol,:, 254)*sol(:ncol,:, 132) ! rate_const*M*MDIALO2*NO2 + rxt_rates(:ncol,:, 479) = rxt_rates(:ncol,:, 479)*sol(:ncol,:, 267)*sol(:ncol,:, 247) ! rate_const*PHENO2*HO2 + rxt_rates(:ncol,:, 480) = rxt_rates(:ncol,:, 480)*sol(:ncol,:, 267)*sol(:ncol,:, 131) ! rate_const*PHENO2*NO + rxt_rates(:ncol,:, 481) = rxt_rates(:ncol,:, 481)*sol(:ncol,:, 151)*sol(:ncol,:, 265) ! rate_const*PHENOL*OH + rxt_rates(:ncol,:, 482) = rxt_rates(:ncol,:, 482)*sol(:ncol,:, 150)*sol(:ncol,:, 132) ! rate_const*PHENO*NO2 + rxt_rates(:ncol,:, 483) = rxt_rates(:ncol,:, 483)*sol(:ncol,:, 150)*sol(:ncol,:, 143) ! rate_const*PHENO*O3 + rxt_rates(:ncol,:, 484) = rxt_rates(:ncol,:, 484)*sol(:ncol,:, 152)*sol(:ncol,:, 265) ! rate_const*PHENOOH*OH + rxt_rates(:ncol,:, 485) = rxt_rates(:ncol,:, 485)*sol(:ncol,:, 233)*sol(:ncol,:, 132) ! rate_const*M*ACBZO2*NO2 + rxt_rates(:ncol,:, 486) = rxt_rates(:ncol,:, 486)*sol(:ncol,:, 272)*sol(:ncol,:, 247) ! rate_const*TOLO2*HO2 + rxt_rates(:ncol,:, 487) = rxt_rates(:ncol,:, 487)*sol(:ncol,:, 272)*sol(:ncol,:, 131) ! rate_const*TOLO2*NO + rxt_rates(:ncol,:, 488) = rxt_rates(:ncol,:, 488)*sol(:ncol,:, 222)*sol(:ncol,:, 265) ! rate_const*TOLOOH*OH + rxt_rates(:ncol,:, 489) = rxt_rates(:ncol,:, 489)*sol(:ncol,:, 223)*sol(:ncol,:, 265) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 490) = rxt_rates(:ncol,:, 490)*sol(:ncol,:, 149) ! rate_const*M*PBZNIT + rxt_rates(:ncol,:, 491) = rxt_rates(:ncol,:, 491)*sol(:ncol,:, 226)*sol(:ncol,:, 265) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 492) = rxt_rates(:ncol,:, 492)*sol(:ncol,:, 274)*sol(:ncol,:, 247) ! rate_const*XYLENO2*HO2 + rxt_rates(:ncol,:, 493) = rxt_rates(:ncol,:, 493)*sol(:ncol,:, 274)*sol(:ncol,:, 131) ! rate_const*XYLENO2*NO + rxt_rates(:ncol,:, 494) = rxt_rates(:ncol,:, 494)*sol(:ncol,:, 227)*sol(:ncol,:, 265) ! rate_const*XYLENOOH*OH + rxt_rates(:ncol,:, 495) = rxt_rates(:ncol,:, 495)*sol(:ncol,:, 275)*sol(:ncol,:, 247) ! rate_const*XYLOLO2*HO2 + rxt_rates(:ncol,:, 496) = rxt_rates(:ncol,:, 496)*sol(:ncol,:, 275)*sol(:ncol,:, 131) ! rate_const*XYLOLO2*NO + rxt_rates(:ncol,:, 497) = rxt_rates(:ncol,:, 497)*sol(:ncol,:, 229)*sol(:ncol,:, 265) ! rate_const*XYLOL*OH + rxt_rates(:ncol,:, 498) = rxt_rates(:ncol,:, 498)*sol(:ncol,:, 230)*sol(:ncol,:, 265) ! rate_const*XYLOLOOH*OH + rxt_rates(:ncol,:, 499) = rxt_rates(:ncol,:, 499)*sol(:ncol,:, 6)*sol(:ncol,:, 133) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 500) = rxt_rates(:ncol,:, 500)*sol(:ncol,:, 6)*sol(:ncol,:, 143) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 501) = rxt_rates(:ncol,:, 501)*sol(:ncol,:, 6)*sol(:ncol,:, 265) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 502) = rxt_rates(:ncol,:, 502)*sol(:ncol,:, 116)*sol(:ncol,:, 133) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 503) = rxt_rates(:ncol,:, 503)*sol(:ncol,:, 116)*sol(:ncol,:, 143) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 504) = rxt_rates(:ncol,:, 504)*sol(:ncol,:, 116)*sol(:ncol,:, 265) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 505) = rxt_rates(:ncol,:, 505)*sol(:ncol,:, 260)*sol(:ncol,:, 241) ! rate_const*NTERPO2*CH3O2 + rxt_rates(:ncol,:, 506) = rxt_rates(:ncol,:, 506)*sol(:ncol,:, 260)*sol(:ncol,:, 247) ! rate_const*NTERPO2*HO2 + rxt_rates(:ncol,:, 507) = rxt_rates(:ncol,:, 507)*sol(:ncol,:, 260)*sol(:ncol,:, 131) ! rate_const*NTERPO2*NO + rxt_rates(:ncol,:, 508) = rxt_rates(:ncol,:, 508)*sol(:ncol,:, 260)*sol(:ncol,:, 133) ! rate_const*NTERPO2*NO3 + rxt_rates(:ncol,:, 509) = rxt_rates(:ncol,:, 509)*sol(:ncol,:, 135)*sol(:ncol,:, 265) ! rate_const*NTERPOOH*OH + rxt_rates(:ncol,:, 510) = rxt_rates(:ncol,:, 510)*sol(:ncol,:, 270)*sol(:ncol,:, 241) ! rate_const*TERP2O2*CH3O2 + rxt_rates(:ncol,:, 511) = rxt_rates(:ncol,:, 511)*sol(:ncol,:, 270)*sol(:ncol,:, 247) ! rate_const*TERP2O2*HO2 + rxt_rates(:ncol,:, 512) = rxt_rates(:ncol,:, 512)*sol(:ncol,:, 270)*sol(:ncol,:, 131) ! rate_const*TERP2O2*NO + rxt_rates(:ncol,:, 513) = rxt_rates(:ncol,:, 513)*sol(:ncol,:, 217)*sol(:ncol,:, 265) ! rate_const*TERP2OOH*OH + rxt_rates(:ncol,:, 514) = rxt_rates(:ncol,:, 514)*sol(:ncol,:, 218)*sol(:ncol,:, 265) ! rate_const*TERPNIT*OH + rxt_rates(:ncol,:, 515) = rxt_rates(:ncol,:, 515)*sol(:ncol,:, 271)*sol(:ncol,:, 241) ! rate_const*TERPO2*CH3O2 + rxt_rates(:ncol,:, 516) = rxt_rates(:ncol,:, 516)*sol(:ncol,:, 271)*sol(:ncol,:, 247) ! rate_const*TERPO2*HO2 + rxt_rates(:ncol,:, 517) = rxt_rates(:ncol,:, 517)*sol(:ncol,:, 271)*sol(:ncol,:, 131) ! rate_const*TERPO2*NO + rxt_rates(:ncol,:, 518) = rxt_rates(:ncol,:, 518)*sol(:ncol,:, 219)*sol(:ncol,:, 265) ! rate_const*TERPOOH*OH + rxt_rates(:ncol,:, 519) = rxt_rates(:ncol,:, 519)*sol(:ncol,:, 220)*sol(:ncol,:, 133) ! rate_const*TERPROD1*NO3 + rxt_rates(:ncol,:, 520) = rxt_rates(:ncol,:, 520)*sol(:ncol,:, 220)*sol(:ncol,:, 265) ! rate_const*TERPROD1*OH + rxt_rates(:ncol,:, 521) = rxt_rates(:ncol,:, 521)*sol(:ncol,:, 221)*sol(:ncol,:, 265) ! rate_const*TERPROD2*OH + rxt_rates(:ncol,:, 522) = rxt_rates(:ncol,:, 522)*sol(:ncol,:, 69)*sol(:ncol,:, 133) ! rate_const*DMS*NO3 + rxt_rates(:ncol,:, 523) = rxt_rates(:ncol,:, 523)*sol(:ncol,:, 69)*sol(:ncol,:, 265) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 524) = rxt_rates(:ncol,:, 524)*sol(:ncol,:, 146)*sol(:ncol,:, 141) ! rate_const*OCS*O + rxt_rates(:ncol,:, 525) = rxt_rates(:ncol,:, 525)*sol(:ncol,:, 146)*sol(:ncol,:, 265) ! rate_const*OCS*OH + rxt_rates(:ncol,:, 526) = rxt_rates(:ncol,:, 526)*sol(:ncol,:, 159)*sol(:ncol,:, 142) ! rate_const*S*O2 + rxt_rates(:ncol,:, 527) = rxt_rates(:ncol,:, 527)*sol(:ncol,:, 162)*sol(:ncol,:, 265) ! rate_const*M*SO2*OH + rxt_rates(:ncol,:, 528) = rxt_rates(:ncol,:, 528)*sol(:ncol,:, 159)*sol(:ncol,:, 143) ! rate_const*S*O3 + rxt_rates(:ncol,:, 529) = rxt_rates(:ncol,:, 529)*sol(:ncol,:, 161)*sol(:ncol,:, 21) ! rate_const*SO*BRO + rxt_rates(:ncol,:, 530) = rxt_rates(:ncol,:, 530)*sol(:ncol,:, 161)*sol(:ncol,:, 61) ! rate_const*SO*CLO + rxt_rates(:ncol,:, 531) = rxt_rates(:ncol,:, 531)*sol(:ncol,:, 159)*sol(:ncol,:, 265) ! rate_const*S*OH + rxt_rates(:ncol,:, 532) = rxt_rates(:ncol,:, 532)*sol(:ncol,:, 161)*sol(:ncol,:, 132) ! rate_const*SO*NO2 + rxt_rates(:ncol,:, 533) = rxt_rates(:ncol,:, 533)*sol(:ncol,:, 161)*sol(:ncol,:, 142) ! rate_const*SO*O2 + rxt_rates(:ncol,:, 534) = rxt_rates(:ncol,:, 534)*sol(:ncol,:, 161)*sol(:ncol,:, 143) ! rate_const*SO*O3 + rxt_rates(:ncol,:, 535) = rxt_rates(:ncol,:, 535)*sol(:ncol,:, 161)*sol(:ncol,:, 145) ! rate_const*SO*OCLO + rxt_rates(:ncol,:, 536) = rxt_rates(:ncol,:, 536)*sol(:ncol,:, 161)*sol(:ncol,:, 265) ! rate_const*SO*OH + rxt_rates(:ncol,:, 537) = rxt_rates(:ncol,:, 537)*sol(:ncol,:, 69)*sol(:ncol,:, 265) ! rate_const*DMS*OH + rxt_rates(:ncol,:, 538) = rxt_rates(:ncol,:, 538)*sol(:ncol,:, 163)*sol(:ncol,:, 276) ! rate_const*SO3*H2O + rxt_rates(:ncol,:, 539) = rxt_rates(:ncol,:, 539)*sol(:ncol,:, 127)*sol(:ncol,:, 265) ! rate_const*NH3*OH + rxt_rates(:ncol,:, 540) = rxt_rates(:ncol,:, 540)*sol(:ncol,:, 247) ! rate_const*HO2 + rxt_rates(:ncol,:, 541) = rxt_rates(:ncol,:, 541)*sol(:ncol,:, 95) ! rate_const*HONITR + rxt_rates(:ncol,:, 542) = rxt_rates(:ncol,:, 542)*sol(:ncol,:, 101) ! rate_const*ISOPNITA + rxt_rates(:ncol,:, 543) = rxt_rates(:ncol,:, 543)*sol(:ncol,:, 102) ! rate_const*ISOPNITB + rxt_rates(:ncol,:, 544) = rxt_rates(:ncol,:, 544)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 545) = rxt_rates(:ncol,:, 545)*sol(:ncol,:, 122) ! rate_const*NC4CH2OH + rxt_rates(:ncol,:, 546) = rxt_rates(:ncol,:, 546)*sol(:ncol,:, 123) ! rate_const*NC4CHO + rxt_rates(:ncol,:, 547) = rxt_rates(:ncol,:, 547)*sol(:ncol,:, 128) ! rate_const*NH4 + rxt_rates(:ncol,:, 548) = rxt_rates(:ncol,:, 548)*sol(:ncol,:, 132) ! rate_const*NO2 + rxt_rates(:ncol,:, 549) = rxt_rates(:ncol,:, 549)*sol(:ncol,:, 133) ! rate_const*NO3 + rxt_rates(:ncol,:, 550) = rxt_rates(:ncol,:, 550)*sol(:ncol,:, 135) ! rate_const*NTERPOOH + rxt_rates(:ncol,:, 551) = rxt_rates(:ncol,:, 551)*sol(:ncol,:, 147) ! rate_const*ONITR + rxt_rates(:ncol,:, 552) = rxt_rates(:ncol,:, 552)*sol(:ncol,:, 218) ! rate_const*TERPNIT + rxt_rates(:ncol,:, 553) = rxt_rates(:ncol,:, 553)*sol(:ncol,:, 6)*sol(:ncol,:, 133) ! rate_const*BCARY*NO3 + rxt_rates(:ncol,:, 554) = rxt_rates(:ncol,:, 554)*sol(:ncol,:, 7)*sol(:ncol,:, 247) ! rate_const*BCARYO2VBS*HO2 + rxt_rates(:ncol,:, 555) = rxt_rates(:ncol,:, 555)*sol(:ncol,:, 7)*sol(:ncol,:, 131) ! rate_const*BCARYO2VBS*NO + rxt_rates(:ncol,:, 556) = rxt_rates(:ncol,:, 556)*sol(:ncol,:, 6)*sol(:ncol,:, 143) ! rate_const*BCARY*O3 + rxt_rates(:ncol,:, 557) = rxt_rates(:ncol,:, 557)*sol(:ncol,:, 6)*sol(:ncol,:, 265) ! rate_const*BCARY*OH + rxt_rates(:ncol,:, 558) = rxt_rates(:ncol,:, 558)*sol(:ncol,:, 8)*sol(:ncol,:, 265) ! rate_const*BENZENE*OH + rxt_rates(:ncol,:, 559) = rxt_rates(:ncol,:, 559)*sol(:ncol,:, 9)*sol(:ncol,:, 247) ! rate_const*BENZO2VBS*HO2 + rxt_rates(:ncol,:, 560) = rxt_rates(:ncol,:, 560)*sol(:ncol,:, 9)*sol(:ncol,:, 131) ! rate_const*BENZO2VBS*NO + rxt_rates(:ncol,:, 561) = rxt_rates(:ncol,:, 561)*sol(:ncol,:, 100)*sol(:ncol,:, 133) ! rate_const*ISOP*NO3 + rxt_rates(:ncol,:, 562) = rxt_rates(:ncol,:, 562)*sol(:ncol,:, 105)*sol(:ncol,:, 247) ! rate_const*ISOPO2VBS*HO2 + rxt_rates(:ncol,:, 563) = rxt_rates(:ncol,:, 563)*sol(:ncol,:, 105)*sol(:ncol,:, 131) ! rate_const*ISOPO2VBS*NO + rxt_rates(:ncol,:, 564) = rxt_rates(:ncol,:, 564)*sol(:ncol,:, 100)*sol(:ncol,:, 143) ! rate_const*ISOP*O3 + rxt_rates(:ncol,:, 565) = rxt_rates(:ncol,:, 565)*sol(:ncol,:, 100)*sol(:ncol,:, 265) ! rate_const*ISOP*OH + rxt_rates(:ncol,:, 566) = rxt_rates(:ncol,:, 566)*sol(:ncol,:, 108)*sol(:ncol,:, 247) ! rate_const*IVOCbbO2VBS*HO2 + rxt_rates(:ncol,:, 567) = rxt_rates(:ncol,:, 567)*sol(:ncol,:, 108)*sol(:ncol,:, 131) ! rate_const*IVOCbbO2VBS*NO + rxt_rates(:ncol,:, 568) = rxt_rates(:ncol,:, 568)*sol(:ncol,:, 107)*sol(:ncol,:, 265) ! rate_const*IVOCbb*OH + rxt_rates(:ncol,:, 569) = rxt_rates(:ncol,:, 569)*sol(:ncol,:, 110)*sol(:ncol,:, 247) ! rate_const*IVOCffO2VBS*HO2 + rxt_rates(:ncol,:, 570) = rxt_rates(:ncol,:, 570)*sol(:ncol,:, 110)*sol(:ncol,:, 131) ! rate_const*IVOCffO2VBS*NO + rxt_rates(:ncol,:, 571) = rxt_rates(:ncol,:, 571)*sol(:ncol,:, 109)*sol(:ncol,:, 265) ! rate_const*IVOCff*OH + rxt_rates(:ncol,:, 572) = rxt_rates(:ncol,:, 572)*sol(:ncol,:, 116)*sol(:ncol,:, 133) ! rate_const*MTERP*NO3 + rxt_rates(:ncol,:, 573) = rxt_rates(:ncol,:, 573)*sol(:ncol,:, 117)*sol(:ncol,:, 247) ! rate_const*MTERPO2VBS*HO2 + rxt_rates(:ncol,:, 574) = rxt_rates(:ncol,:, 574)*sol(:ncol,:, 117)*sol(:ncol,:, 131) ! rate_const*MTERPO2VBS*NO + rxt_rates(:ncol,:, 575) = rxt_rates(:ncol,:, 575)*sol(:ncol,:, 116)*sol(:ncol,:, 143) ! rate_const*MTERP*O3 + rxt_rates(:ncol,:, 576) = rxt_rates(:ncol,:, 576)*sol(:ncol,:, 116)*sol(:ncol,:, 265) ! rate_const*MTERP*OH + rxt_rates(:ncol,:, 577) = rxt_rates(:ncol,:, 577)*sol(:ncol,:, 214)*sol(:ncol,:, 265) ! rate_const*SVOCbb*OH + rxt_rates(:ncol,:, 578) = rxt_rates(:ncol,:, 578)*sol(:ncol,:, 215)*sol(:ncol,:, 265) ! rate_const*SVOCff*OH + rxt_rates(:ncol,:, 579) = rxt_rates(:ncol,:, 579)*sol(:ncol,:, 223)*sol(:ncol,:, 265) ! rate_const*TOLUENE*OH + rxt_rates(:ncol,:, 580) = rxt_rates(:ncol,:, 580)*sol(:ncol,:, 224)*sol(:ncol,:, 247) ! rate_const*TOLUO2VBS*HO2 + rxt_rates(:ncol,:, 581) = rxt_rates(:ncol,:, 581)*sol(:ncol,:, 224)*sol(:ncol,:, 131) ! rate_const*TOLUO2VBS*NO + rxt_rates(:ncol,:, 582) = rxt_rates(:ncol,:, 582)*sol(:ncol,:, 77) ! rate_const*GLYOXAL + rxt_rates(:ncol,:, 583) = rxt_rates(:ncol,:, 583)*sol(:ncol,:, 226)*sol(:ncol,:, 265) ! rate_const*XYLENES*OH + rxt_rates(:ncol,:, 584) = rxt_rates(:ncol,:, 584)*sol(:ncol,:, 228)*sol(:ncol,:, 247) ! rate_const*XYLEO2VBS*HO2 + rxt_rates(:ncol,:, 585) = rxt_rates(:ncol,:, 585)*sol(:ncol,:, 228)*sol(:ncol,:, 131) ! rate_const*XYLEO2VBS*NO + rxt_rates(:ncol,:, 586) = rxt_rates(:ncol,:, 586)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 587) = rxt_rates(:ncol,:, 587)*sol(:ncol,:, 94)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 588) = rxt_rates(:ncol,:, 588)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 589) = rxt_rates(:ncol,:, 589)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 590) = rxt_rates(:ncol,:, 590)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 591) = rxt_rates(:ncol,:, 591)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 592) = rxt_rates(:ncol,:, 592)*sol(:ncol,:, 62)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 593) = rxt_rates(:ncol,:, 593)*sol(:ncol,:, 94)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 594) = rxt_rates(:ncol,:, 594)*sol(:ncol,:, 93)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 595) = rxt_rates(:ncol,:, 595)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 596) = rxt_rates(:ncol,:, 596)*sol(:ncol,:, 22) ! rate_const*BRONO2 + rxt_rates(:ncol,:, 597) = rxt_rates(:ncol,:, 597)*sol(:ncol,:, 62)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 598) = rxt_rates(:ncol,:, 598)*sol(:ncol,:, 94)*sol(:ncol,:, 87) ! rate_const*HOCL*HCL + rxt_rates(:ncol,:, 599) = rxt_rates(:ncol,:, 599)*sol(:ncol,:, 93)*sol(:ncol,:, 87) ! rate_const*HOBR*HCL + rxt_rates(:ncol,:, 600) = rxt_rates(:ncol,:, 600)*sol(:ncol,:, 121) ! rate_const*N2O5 + rxt_rates(:ncol,:, 601) = rxt_rates(:ncol,:, 601)*sol(:ncol,:, 62) ! rate_const*CLONO2 + rxt_rates(:ncol,:, 602) = rxt_rates(:ncol,:, 602)*sol(:ncol,:, 62)*sol(:ncol,:, 87) ! rate_const*CLONO2*HCL + rxt_rates(:ncol,:, 603) = rxt_rates(:ncol,:, 603)*sol(:ncol,:, 258)*sol(:ncol,:, 243) ! rate_const*NOp*e + rxt_rates(:ncol,:, 604) = rxt_rates(:ncol,:, 604)*sol(:ncol,:, 264)*sol(:ncol,:, 243) ! rate_const*O2p*e + rxt_rates(:ncol,:, 605) = rxt_rates(:ncol,:, 605)*sol(:ncol,:, 257)*sol(:ncol,:, 243) ! rate_const*N2p*e + rxt_rates(:ncol,:, 606) = rxt_rates(:ncol,:, 606)*sol(:ncol,:, 257)*sol(:ncol,:, 142) ! rate_const*N2p*O2 + rxt_rates(:ncol,:, 607) = rxt_rates(:ncol,:, 607)*sol(:ncol,:, 257)*sol(:ncol,:, 141) ! rate_const*N2p*O + rxt_rates(:ncol,:, 608) = rxt_rates(:ncol,:, 608)*sol(:ncol,:, 257)*sol(:ncol,:, 141) ! rate_const*N2p*O + rxt_rates(:ncol,:, 609) = rxt_rates(:ncol,:, 609)*sol(:ncol,:, 259)*sol(:ncol,:, 141) ! rate_const*Np*O + rxt_rates(:ncol,:, 610) = rxt_rates(:ncol,:, 610)*sol(:ncol,:, 259)*sol(:ncol,:, 142) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 611) = rxt_rates(:ncol,:, 611)*sol(:ncol,:, 259)*sol(:ncol,:, 142) ! rate_const*Np*O2 + rxt_rates(:ncol,:, 612) = rxt_rates(:ncol,:, 612)*sol(:ncol,:, 264)*sol(:ncol,:, 119) ! rate_const*O2p*N + rxt_rates(:ncol,:, 613) = rxt_rates(:ncol,:, 613)*sol(:ncol,:, 264) ! rate_const*N2*O2p + rxt_rates(:ncol,:, 614) = rxt_rates(:ncol,:, 614)*sol(:ncol,:, 264)*sol(:ncol,:, 131) ! rate_const*O2p*NO + rxt_rates(:ncol,:, 615) = rxt_rates(:ncol,:, 615)*sol(:ncol,:, 266)*sol(:ncol,:, 65) ! rate_const*Op*CO2 + rxt_rates(:ncol,:, 616) = rxt_rates(:ncol,:, 616)*sol(:ncol,:, 266) ! rate_const*N2*Op + rxt_rates(:ncol,:, 617) = rxt_rates(:ncol,:, 617)*sol(:ncol,:, 266)*sol(:ncol,:, 142) ! rate_const*Op*O2 + rxt_rates(:ncol,:, 618) = rxt_rates(:ncol,:, 618)*sol(:ncol,:, 73) ! rate_const*E90 + rxt_rates(:ncol,:, 619) = rxt_rates(:ncol,:, 619)*sol(:ncol,:, 130) ! rate_const*NH_50 + rxt_rates(:ncol,:, 620) = rxt_rates(:ncol,:, 620)*sol(:ncol,:, 129) ! rate_const*NH_5 + rxt_rates(:ncol,:, 621) = rxt_rates(:ncol,:, 621)*sol(:ncol,:, 213) ! rate_const*ST80_25 + end subroutine set_rates +end module mo_rxt_rates_conv diff --git a/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_setrxt.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_setrxt.F90 new file mode 100644 index 0000000000..eefe84491d --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_setrxt.F90 @@ -0,0 +1,757 @@ + + 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(:,171) = 0.000258_r8 + rate(:,172) = 0.085_r8 + rate(:,173) = 1.2e-10_r8 + rate(:,178) = 1.2e-10_r8 + rate(:,179) = 1e-20_r8 + rate(:,180) = 1.3e-16_r8 + rate(:,182) = 4.2e-13_r8 + rate(:,184) = 8e-14_r8 + rate(:,185) = 3.9e-17_r8 + rate(:,192) = 6.9e-12_r8 + rate(:,193) = 7.2e-11_r8 + rate(:,194) = 1.6e-12_r8 + rate(:,200) = 1.8e-12_r8 + rate(:,204) = 1.8e-12_r8 + rate(:,208) = 7e-13_r8 + rate(:,209) = 5e-12_r8 + rate(:,218) = 3.5e-12_r8 + rate(:,220) = 1.3e-11_r8 + rate(:,221) = 2.2e-11_r8 + rate(:,222) = 5e-11_r8 + rate(:,257) = 1.7e-13_r8 + rate(:,259) = 2.607e-10_r8 + rate(:,260) = 9.75e-11_r8 + rate(:,261) = 2.07e-10_r8 + rate(:,262) = 2.088e-10_r8 + rate(:,263) = 1.17e-10_r8 + rate(:,264) = 4.644e-11_r8 + rate(:,265) = 1.204e-10_r8 + rate(:,266) = 9.9e-11_r8 + rate(:,267) = 3.3e-12_r8 + rate(:,286) = 4.5e-11_r8 + rate(:,287) = 4.62e-10_r8 + rate(:,288) = 1.2e-10_r8 + rate(:,289) = 9e-11_r8 + rate(:,290) = 3e-11_r8 + rate(:,295) = 2.14e-11_r8 + rate(:,296) = 1.9e-10_r8 + rate(:,309) = 2.57e-10_r8 + rate(:,310) = 1.8e-10_r8 + rate(:,311) = 1.794e-10_r8 + rate(:,312) = 1.3e-10_r8 + rate(:,313) = 7.65e-11_r8 + rate(:,326) = 4e-13_r8 + rate(:,330) = 1.31e-10_r8 + rate(:,331) = 3.5e-11_r8 + rate(:,332) = 9e-12_r8 + rate(:,339) = 6.8e-14_r8 + rate(:,340) = 2e-13_r8 + rate(:,355) = 1e-12_r8 + rate(:,359) = 1e-14_r8 + rate(:,360) = 1e-11_r8 + rate(:,361) = 1.15e-11_r8 + rate(:,362) = 4e-14_r8 + rate(:,375) = 1.45e-10_r8 + rate(:,376) = 3e-12_r8 + rate(:,377) = 6.7e-13_r8 + rate(:,387) = 3.5e-13_r8 + rate(:,388) = 5.4e-11_r8 + rate(:,391) = 2e-12_r8 + rate(:,392) = 1.4e-11_r8 + rate(:,395) = 2.4e-12_r8 + rate(:,406) = 5e-12_r8 + rate(:,416) = 1.6e-12_r8 + rate(:,418) = 6.7e-12_r8 + rate(:,421) = 3.5e-12_r8 + rate(:,424) = 1.3e-11_r8 + rate(:,425) = 1.4e-11_r8 + rate(:,429) = 2.4e-12_r8 + rate(:,430) = 1.4e-11_r8 + rate(:,435) = 2.4e-12_r8 + rate(:,436) = 4e-11_r8 + rate(:,437) = 4e-11_r8 + rate(:,439) = 1.4e-11_r8 + rate(:,443) = 2.4e-12_r8 + rate(:,444) = 4e-11_r8 + rate(:,448) = 7e-11_r8 + rate(:,449) = 1e-10_r8 + rate(:,454) = 2.4e-12_r8 + rate(:,469) = 4.7e-11_r8 + rate(:,482) = 2.1e-12_r8 + rate(:,483) = 2.8e-13_r8 + rate(:,491) = 1.7e-11_r8 + rate(:,497) = 8.4e-11_r8 + rate(:,499) = 1.9e-11_r8 + rate(:,500) = 1.2e-14_r8 + rate(:,501) = 2e-10_r8 + rate(:,508) = 2.4e-12_r8 + rate(:,509) = 2e-11_r8 + rate(:,513) = 2.3e-11_r8 + rate(:,514) = 2e-11_r8 + rate(:,518) = 3.3e-11_r8 + rate(:,519) = 1e-12_r8 + rate(:,520) = 5.7e-11_r8 + rate(:,521) = 3.4e-11_r8 + rate(:,526) = 2.3e-12_r8 + rate(:,528) = 1.2e-11_r8 + rate(:,529) = 5.7e-11_r8 + rate(:,530) = 2.8e-11_r8 + rate(:,531) = 6.6e-11_r8 + rate(:,532) = 1.4e-11_r8 + rate(:,535) = 1.9e-12_r8 + rate(:,547) = 6.34e-08_r8 + rate(:,553) = 1.9e-11_r8 + rate(:,556) = 1.2e-14_r8 + rate(:,557) = 2e-10_r8 + rate(:,568) = 1.34e-11_r8 + rate(:,571) = 1.34e-11_r8 + rate(:,577) = 1.34e-11_r8 + rate(:,578) = 1.34e-11_r8 + rate(:,583) = 1.7e-11_r8 + rate(:,606) = 6e-11_r8 + rate(:,609) = 1e-12_r8 + rate(:,610) = 4e-10_r8 + rate(:,611) = 2e-10_r8 + rate(:,612) = 1e-10_r8 + rate(:,613) = 5e-16_r8 + rate(:,614) = 4.4e-10_r8 + rate(:,615) = 9e-10_r8 + rate(:,618) = 1.29e-07_r8 + rate(:,619) = 2.31e-07_r8 + rate(:,620) = 2.31e-06_r8 + rate(:,621) = 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(:,174) = 1.63e-10_r8 * exp( 60._r8 * itemp(:) ) + rate(:,175) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:,176) = 2.64e-11_r8 * exp_fac(:) + rate(:,177) = 6.6e-12_r8 * exp_fac(:) + rate(:,181) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:,183) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:,186) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:,187) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:,190) = 1.6e-11_r8 * exp( -4570._r8 * itemp(:) ) + exp_fac(:) = exp( -2000._r8 * itemp(:) ) + rate(:,191) = 1.4e-12_r8 * exp_fac(:) + rate(:,445) = 1.05e-14_r8 * exp_fac(:) + rate(:,564) = 1.05e-14_r8 * exp_fac(:) + exp_fac(:) = exp( 200._r8 * itemp(:) ) + rate(:,196) = 3e-11_r8 * exp_fac(:) + rate(:,284) = 5.5e-12_r8 * exp_fac(:) + rate(:,323) = 3.8e-12_r8 * exp_fac(:) + rate(:,344) = 3.8e-12_r8 * exp_fac(:) + rate(:,371) = 3.8e-12_r8 * exp_fac(:) + rate(:,380) = 3.8e-12_r8 * exp_fac(:) + rate(:,384) = 3.8e-12_r8 * exp_fac(:) + rate(:,400) = 2.3e-11_r8 * exp_fac(:) + rate(:,410) = 3.8e-12_r8 * exp_fac(:) + rate(:,420) = 3.8e-12_r8 * exp_fac(:) + rate(:,447) = 1.52e-11_r8 * exp_fac(:) + rate(:,455) = 1.52e-12_r8 * exp_fac(:) + rate(:,461) = 3.8e-12_r8 * exp_fac(:) + rate(:,464) = 3.8e-12_r8 * exp_fac(:) + rate(:,468) = 3.8e-12_r8 * exp_fac(:) + rate(:,484) = 3.8e-12_r8 * exp_fac(:) + rate(:,488) = 3.8e-12_r8 * exp_fac(:) + rate(:,494) = 3.8e-12_r8 * exp_fac(:) + rate(:,498) = 3.8e-12_r8 * exp_fac(:) + rate(:,197) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:,198) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:,199) = 2.8e-12_r8 * exp( -1800._r8 * itemp(:) ) + exp_fac(:) = exp( 250._r8 * itemp(:) ) + rate(:,201) = 4.8e-11_r8 * exp_fac(:) + rate(:,282) = 1.7e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 180._r8 * itemp(:) ) + rate(:,202) = 1.8e-11_r8 * exp_fac(:) + rate(:,357) = 4.2e-12_r8 * exp_fac(:) + rate(:,370) = 4.2e-12_r8 * exp_fac(:) + rate(:,379) = 4.2e-12_r8 * exp_fac(:) + rate(:,408) = 4.2e-12_r8 * exp_fac(:) + rate(:,428) = 4.4e-12_r8 * exp_fac(:) + rate(:,434) = 4.4e-12_r8 * exp_fac(:) + rate(:,507) = 4.2e-12_r8 * exp_fac(:) + rate(:,512) = 4.2e-12_r8 * exp_fac(:) + rate(:,517) = 4.2e-12_r8 * exp_fac(:) + rate(:,203) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:,207) = 4.5e-13_r8 * exp( 610._r8 * itemp(:) ) + rate(:,210) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + exp_fac(:) = exp( 220._r8 * itemp(:) ) + rate(:,211) = 2.9e-12_r8 * exp_fac(:) + rate(:,212) = 1.45e-12_r8 * exp_fac(:) + rate(:,213) = 1.45e-12_r8 * exp_fac(:) + rate(:,214) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:,215) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + exp_fac(:) = exp( -2450._r8 * itemp(:) ) + rate(:,216) = 1.2e-13_r8 * exp_fac(:) + rate(:,242) = 3e-11_r8 * exp_fac(:) + exp_fac(:) = exp( 125._r8 * itemp(:) ) + rate(:,219) = 1.7e-11_r8 * exp_fac(:) + rate(:,317) = 5.5e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 260._r8 * itemp(:) ) + rate(:,223) = 3.44e-12_r8 * exp_fac(:) + rate(:,275) = 2.3e-12_r8 * exp_fac(:) + rate(:,278) = 8.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -1500._r8 * itemp(:) ) + rate(:,224) = 3e-12_r8 * exp_fac(:) + rate(:,283) = 5.8e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 20._r8 * itemp(:) ) + rate(:,226) = 7.26e-11_r8 * exp_fac(:) + rate(:,227) = 4.64e-11_r8 * exp_fac(:) + rate(:,234) = 8.1e-11_r8 * exp( -30._r8 * itemp(:) ) + rate(:,235) = 7.1e-12_r8 * exp( -1270._r8 * itemp(:) ) + rate(:,236) = 3.05e-11_r8 * exp( -2270._r8 * itemp(:) ) + rate(:,237) = 1.1e-11_r8 * exp( -980._r8 * itemp(:) ) + exp_fac(:) = exp( 270._r8 * itemp(:) ) + rate(:,238) = 1.4e-11_r8 * exp_fac(:) + rate(:,252) = 7.4e-12_r8 * exp_fac(:) + rate(:,353) = 8.1e-12_r8 * exp_fac(:) + rate(:,239) = 3.6e-11_r8 * exp( -375._r8 * itemp(:) ) + rate(:,240) = 2.3e-11_r8 * exp( -200._r8 * itemp(:) ) + rate(:,241) = 3.3e-12_r8 * exp( -115._r8 * itemp(:) ) + rate(:,243) = 1e-12_r8 * exp( -1590._r8 * itemp(:) ) + rate(:,244) = 3.5e-13_r8 * exp( -1370._r8 * itemp(:) ) + exp_fac(:) = exp( 290._r8 * itemp(:) ) + rate(:,245) = 2.6e-12_r8 * exp_fac(:) + rate(:,246) = 6.4e-12_r8 * exp_fac(:) + rate(:,276) = 4.1e-13_r8 * exp_fac(:) + rate(:,457) = 7.5e-12_r8 * exp_fac(:) + rate(:,471) = 7.5e-12_r8 * exp_fac(:) + rate(:,474) = 7.5e-12_r8 * exp_fac(:) + rate(:,477) = 7.5e-12_r8 * exp_fac(:) + rate(:,247) = 6.5e-12_r8 * exp( 135._r8 * itemp(:) ) + exp_fac(:) = exp( -840._r8 * itemp(:) ) + rate(:,249) = 3.6e-12_r8 * exp_fac(:) + rate(:,298) = 2e-12_r8 * exp_fac(:) + rate(:,250) = 1.2e-12_r8 * exp( -330._r8 * itemp(:) ) + rate(:,251) = 2.8e-11_r8 * exp( 85._r8 * itemp(:) ) + exp_fac(:) = exp( 230._r8 * itemp(:) ) + rate(:,253) = 6e-13_r8 * exp_fac(:) + rate(:,273) = 1.5e-12_r8 * exp_fac(:) + rate(:,281) = 1.9e-11_r8 * exp_fac(:) + rate(:,254) = 1e-11_r8 * exp( -3300._r8 * itemp(:) ) + rate(:,255) = 1.8e-12_r8 * exp( -250._r8 * itemp(:) ) + rate(:,256) = 3.4e-12_r8 * exp( -130._r8 * itemp(:) ) + exp_fac(:) = exp( -500._r8 * itemp(:) ) + rate(:,258) = 3e-12_r8 * exp_fac(:) + rate(:,292) = 1.4e-10_r8 * exp_fac(:) + exp_fac(:) = exp( -800._r8 * itemp(:) ) + rate(:,270) = 1.7e-11_r8 * exp_fac(:) + rate(:,297) = 6.3e-12_r8 * exp_fac(:) + rate(:,271) = 4.8e-12_r8 * exp( -310._r8 * itemp(:) ) + rate(:,272) = 1.6e-11_r8 * exp( -780._r8 * itemp(:) ) + rate(:,274) = 9.5e-13_r8 * exp( 550._r8 * itemp(:) ) + rate(:,277) = 4.5e-12_r8 * exp( 460._r8 * itemp(:) ) + rate(:,280) = 1.9e-11_r8 * exp( 215._r8 * itemp(:) ) + rate(:,285) = 1.2e-10_r8 * exp( -430._r8 * itemp(:) ) + rate(:,291) = 1.6e-10_r8 * exp( -260._r8 * itemp(:) ) + exp_fac(:) = exp( 0._r8 * itemp(:) ) + rate(:,293) = 1.4e-11_r8 * exp_fac(:) + rate(:,295) = 2.14e-11_r8 * exp_fac(:) + rate(:,296) = 1.9e-10_r8 * exp_fac(:) + rate(:,309) = 2.57e-10_r8 * exp_fac(:) + rate(:,310) = 1.8e-10_r8 * exp_fac(:) + rate(:,311) = 1.794e-10_r8 * exp_fac(:) + rate(:,312) = 1.3e-10_r8 * exp_fac(:) + rate(:,313) = 7.65e-11_r8 * exp_fac(:) + rate(:,326) = 4e-13_r8 * exp_fac(:) + rate(:,330) = 1.31e-10_r8 * exp_fac(:) + rate(:,331) = 3.5e-11_r8 * exp_fac(:) + rate(:,332) = 9e-12_r8 * exp_fac(:) + rate(:,339) = 6.8e-14_r8 * exp_fac(:) + rate(:,340) = 2e-13_r8 * exp_fac(:) + rate(:,355) = 1e-12_r8 * exp_fac(:) + rate(:,359) = 1e-14_r8 * exp_fac(:) + rate(:,360) = 1e-11_r8 * exp_fac(:) + rate(:,361) = 1.15e-11_r8 * exp_fac(:) + rate(:,362) = 4e-14_r8 * exp_fac(:) + rate(:,375) = 1.45e-10_r8 * exp_fac(:) + rate(:,376) = 3e-12_r8 * exp_fac(:) + rate(:,377) = 6.7e-13_r8 * exp_fac(:) + rate(:,387) = 3.5e-13_r8 * exp_fac(:) + rate(:,388) = 5.4e-11_r8 * exp_fac(:) + rate(:,391) = 2e-12_r8 * exp_fac(:) + rate(:,392) = 1.4e-11_r8 * exp_fac(:) + rate(:,395) = 2.4e-12_r8 * exp_fac(:) + rate(:,406) = 5e-12_r8 * exp_fac(:) + rate(:,416) = 1.6e-12_r8 * exp_fac(:) + rate(:,418) = 6.7e-12_r8 * exp_fac(:) + rate(:,421) = 3.5e-12_r8 * exp_fac(:) + rate(:,424) = 1.3e-11_r8 * exp_fac(:) + rate(:,425) = 1.4e-11_r8 * exp_fac(:) + rate(:,429) = 2.4e-12_r8 * exp_fac(:) + rate(:,430) = 1.4e-11_r8 * exp_fac(:) + rate(:,435) = 2.4e-12_r8 * exp_fac(:) + rate(:,436) = 4e-11_r8 * exp_fac(:) + rate(:,437) = 4e-11_r8 * exp_fac(:) + rate(:,439) = 1.4e-11_r8 * exp_fac(:) + rate(:,443) = 2.4e-12_r8 * exp_fac(:) + rate(:,444) = 4e-11_r8 * exp_fac(:) + rate(:,448) = 7e-11_r8 * exp_fac(:) + rate(:,449) = 1e-10_r8 * exp_fac(:) + rate(:,454) = 2.4e-12_r8 * exp_fac(:) + rate(:,469) = 4.7e-11_r8 * exp_fac(:) + rate(:,482) = 2.1e-12_r8 * exp_fac(:) + rate(:,483) = 2.8e-13_r8 * exp_fac(:) + rate(:,491) = 1.7e-11_r8 * exp_fac(:) + rate(:,497) = 8.4e-11_r8 * exp_fac(:) + rate(:,499) = 1.9e-11_r8 * exp_fac(:) + rate(:,500) = 1.2e-14_r8 * exp_fac(:) + rate(:,501) = 2e-10_r8 * exp_fac(:) + rate(:,508) = 2.4e-12_r8 * exp_fac(:) + rate(:,509) = 2e-11_r8 * exp_fac(:) + rate(:,513) = 2.3e-11_r8 * exp_fac(:) + rate(:,514) = 2e-11_r8 * exp_fac(:) + rate(:,518) = 3.3e-11_r8 * exp_fac(:) + rate(:,519) = 1e-12_r8 * exp_fac(:) + rate(:,520) = 5.7e-11_r8 * exp_fac(:) + rate(:,521) = 3.4e-11_r8 * exp_fac(:) + rate(:,526) = 2.3e-12_r8 * exp_fac(:) + rate(:,528) = 1.2e-11_r8 * exp_fac(:) + rate(:,529) = 5.7e-11_r8 * exp_fac(:) + rate(:,530) = 2.8e-11_r8 * exp_fac(:) + rate(:,531) = 6.6e-11_r8 * exp_fac(:) + rate(:,532) = 1.4e-11_r8 * exp_fac(:) + rate(:,535) = 1.9e-12_r8 * exp_fac(:) + rate(:,547) = 6.34e-08_r8 * exp_fac(:) + rate(:,553) = 1.9e-11_r8 * exp_fac(:) + rate(:,556) = 1.2e-14_r8 * exp_fac(:) + rate(:,557) = 2e-10_r8 * exp_fac(:) + rate(:,568) = 1.34e-11_r8 * exp_fac(:) + rate(:,571) = 1.34e-11_r8 * exp_fac(:) + rate(:,577) = 1.34e-11_r8 * exp_fac(:) + rate(:,578) = 1.34e-11_r8 * exp_fac(:) + rate(:,583) = 1.7e-11_r8 * exp_fac(:) + rate(:,606) = 6e-11_r8 * exp_fac(:) + rate(:,609) = 1e-12_r8 * exp_fac(:) + rate(:,610) = 4e-10_r8 * exp_fac(:) + rate(:,611) = 2e-10_r8 * exp_fac(:) + rate(:,612) = 1e-10_r8 * exp_fac(:) + rate(:,613) = 5e-16_r8 * exp_fac(:) + rate(:,614) = 4.4e-10_r8 * exp_fac(:) + rate(:,615) = 9e-10_r8 * exp_fac(:) + rate(:,618) = 1.29e-07_r8 * exp_fac(:) + rate(:,619) = 2.31e-07_r8 * exp_fac(:) + rate(:,620) = 2.31e-06_r8 * exp_fac(:) + rate(:,621) = 4.63e-07_r8 * exp_fac(:) + exp_fac(:) = exp( 400._r8 * itemp(:) ) + rate(:,294) = 6e-12_r8 * exp_fac(:) + rate(:,393) = 5e-13_r8 * exp_fac(:) + rate(:,426) = 5e-13_r8 * exp_fac(:) + rate(:,431) = 5e-13_r8 * exp_fac(:) + rate(:,440) = 5e-13_r8 * exp_fac(:) + rate(:,451) = 5e-13_r8 * exp_fac(:) + rate(:,299) = 1.46e-11_r8 * exp( -1040._r8 * itemp(:) ) + rate(:,300) = 1.42e-12_r8 * exp( -1150._r8 * itemp(:) ) + exp_fac(:) = exp( -1520._r8 * itemp(:) ) + rate(:,301) = 1.64e-12_r8 * exp_fac(:) + rate(:,412) = 8.5e-16_r8 * exp_fac(:) + exp_fac(:) = exp( -1100._r8 * itemp(:) ) + rate(:,302) = 2.03e-11_r8 * exp_fac(:) + rate(:,534) = 3.4e-12_r8 * exp_fac(:) + rate(:,303) = 1.96e-12_r8 * exp( -1200._r8 * itemp(:) ) + rate(:,304) = 4.85e-12_r8 * exp( -850._r8 * itemp(:) ) + rate(:,305) = 9e-13_r8 * exp( -360._r8 * itemp(:) ) + exp_fac(:) = exp( -1600._r8 * itemp(:) ) + rate(:,306) = 1.25e-12_r8 * exp_fac(:) + rate(:,316) = 3.4e-11_r8 * exp_fac(:) + rate(:,307) = 1.3e-12_r8 * exp( -1770._r8 * itemp(:) ) + rate(:,308) = 9.2e-13_r8 * exp( -1560._r8 * itemp(:) ) + rate(:,314) = 9.7e-15_r8 * exp( 625._r8 * itemp(:) ) + rate(:,315) = 6e-13_r8 * exp( -2058._r8 * itemp(:) ) + rate(:,318) = 5e-13_r8 * exp( -424._r8 * itemp(:) ) + rate(:,319) = 1.9e-14_r8 * exp( 706._r8 * itemp(:) ) + rate(:,320) = 4.1e-13_r8 * exp( 750._r8 * itemp(:) ) + exp_fac(:) = exp( 300._r8 * itemp(:) ) + rate(:,321) = 2.8e-12_r8 * exp_fac(:) + rate(:,383) = 2.9e-12_r8 * exp_fac(:) + rate(:,322) = 2.9e-12_r8 * exp( -345._r8 * itemp(:) ) + rate(:,324) = 2.45e-12_r8 * exp( -1775._r8 * itemp(:) ) + exp_fac(:) = exp( 700._r8 * itemp(:) ) + rate(:,327) = 7.5e-13_r8 * exp_fac(:) + rate(:,341) = 7.5e-13_r8 * exp_fac(:) + rate(:,356) = 7.5e-13_r8 * exp_fac(:) + rate(:,369) = 7.5e-13_r8 * exp_fac(:) + rate(:,378) = 7.5e-13_r8 * exp_fac(:) + rate(:,382) = 8.6e-13_r8 * exp_fac(:) + rate(:,394) = 8e-13_r8 * exp_fac(:) + rate(:,407) = 7.5e-13_r8 * exp_fac(:) + rate(:,417) = 7.5e-13_r8 * exp_fac(:) + rate(:,427) = 8e-13_r8 * exp_fac(:) + rate(:,432) = 8e-13_r8 * exp_fac(:) + rate(:,441) = 8e-13_r8 * exp_fac(:) + rate(:,452) = 8e-13_r8 * exp_fac(:) + rate(:,459) = 7.5e-13_r8 * exp_fac(:) + rate(:,463) = 7.5e-13_r8 * exp_fac(:) + rate(:,466) = 7.5e-13_r8 * exp_fac(:) + rate(:,479) = 7.5e-13_r8 * exp_fac(:) + rate(:,486) = 7.5e-13_r8 * exp_fac(:) + rate(:,492) = 7.5e-13_r8 * exp_fac(:) + rate(:,495) = 7.5e-13_r8 * exp_fac(:) + rate(:,506) = 7.5e-13_r8 * exp_fac(:) + rate(:,511) = 7.5e-13_r8 * exp_fac(:) + rate(:,516) = 7.5e-13_r8 * exp_fac(:) + rate(:,559) = 7.5e-13_r8 * exp_fac(:) + rate(:,566) = 7.5e-13_r8 * exp_fac(:) + rate(:,569) = 7.5e-13_r8 * exp_fac(:) + rate(:,580) = 7.5e-13_r8 * exp_fac(:) + rate(:,584) = 7.5e-13_r8 * exp_fac(:) + rate(:,328) = 2.4e+12_r8 * exp( -7000._r8 * itemp(:) ) + rate(:,329) = 2.6e-12_r8 * exp( 265._r8 * itemp(:) ) + rate(:,333) = 1.08e-10_r8 * exp( 105._r8 * itemp(:) ) + rate(:,338) = 1.2e-14_r8 * exp( -2630._r8 * itemp(:) ) + exp_fac(:) = exp( 365._r8 * itemp(:) ) + rate(:,342) = 2.6e-12_r8 * exp_fac(:) + rate(:,460) = 2.6e-12_r8 * exp_fac(:) + rate(:,465) = 2.6e-12_r8 * exp_fac(:) + rate(:,467) = 2.6e-12_r8 * exp_fac(:) + rate(:,480) = 2.6e-12_r8 * exp_fac(:) + rate(:,487) = 2.6e-12_r8 * exp_fac(:) + rate(:,493) = 2.6e-12_r8 * exp_fac(:) + rate(:,496) = 2.6e-12_r8 * exp_fac(:) + rate(:,560) = 2.6e-12_r8 * exp_fac(:) + rate(:,567) = 2.6e-12_r8 * exp_fac(:) + rate(:,570) = 2.6e-12_r8 * exp_fac(:) + rate(:,581) = 2.6e-12_r8 * exp_fac(:) + rate(:,585) = 2.6e-12_r8 * exp_fac(:) + rate(:,343) = 6.9e-12_r8 * exp( -230._r8 * itemp(:) ) + rate(:,345) = 7.2e-11_r8 * exp( -70._r8 * itemp(:) ) + rate(:,346) = 7.66e-12_r8 * exp( -1020._r8 * itemp(:) ) + exp_fac(:) = exp( -1900._r8 * itemp(:) ) + rate(:,347) = 1.4e-12_r8 * exp_fac(:) + rate(:,367) = 6.5e-15_r8 * exp_fac(:) + exp_fac(:) = exp( 350._r8 * itemp(:) ) + rate(:,348) = 4.63e-12_r8 * exp_fac(:) + rate(:,563) = 2.7e-12_r8 * exp_fac(:) + rate(:,349) = 7.8e-13_r8 * exp( -1050._r8 * itemp(:) ) + exp_fac(:) = exp( 500._r8 * itemp(:) ) + rate(:,350) = 2.9e-12_r8 * exp_fac(:) + rate(:,351) = 2e-12_r8 * exp_fac(:) + rate(:,381) = 7.1e-13_r8 * exp_fac(:) + rate(:,402) = 2e-12_r8 * exp_fac(:) + rate(:,505) = 2e-12_r8 * exp_fac(:) + rate(:,510) = 2e-12_r8 * exp_fac(:) + rate(:,515) = 2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 1040._r8 * itemp(:) ) + rate(:,352) = 4.3e-13_r8 * exp_fac(:) + rate(:,403) = 4.3e-13_r8 * exp_fac(:) + rate(:,456) = 4.3e-13_r8 * exp_fac(:) + rate(:,470) = 4.3e-13_r8 * exp_fac(:) + rate(:,473) = 4.3e-13_r8 * exp_fac(:) + rate(:,476) = 4.3e-13_r8 * exp_fac(:) + rate(:,354) = 3.15e-14_r8 * exp( 920._r8 * itemp(:) ) + rate(:,358) = 1.6e+11_r8 * exp( -4150._r8 * itemp(:) ) + rate(:,366) = 4.6e-13_r8 * exp( -1156._r8 * itemp(:) ) + rate(:,368) = 3.75e-13_r8 * exp( -40._r8 * itemp(:) ) + rate(:,372) = 9.19e-12_r8 * exp( -630._r8 * itemp(:) ) + rate(:,373) = 1.4e-12_r8 * exp( -1860._r8 * itemp(:) ) + rate(:,374) = 8.4e-13_r8 * exp( 830._r8 * itemp(:) ) + rate(:,389) = 4.8e-12_r8 * exp( 120._r8 * itemp(:) ) + rate(:,390) = 5.1e-14_r8 * exp( 693._r8 * itemp(:) ) + exp_fac(:) = exp( 360._r8 * itemp(:) ) + rate(:,396) = 2.7e-12_r8 * exp_fac(:) + rate(:,397) = 1.3e-13_r8 * exp_fac(:) + rate(:,399) = 9.6e-12_r8 * exp_fac(:) + rate(:,405) = 5.3e-12_r8 * exp_fac(:) + rate(:,442) = 2.7e-12_r8 * exp_fac(:) + rate(:,453) = 2.7e-12_r8 * exp_fac(:) + rate(:,555) = 2.7e-12_r8 * exp_fac(:) + rate(:,574) = 2.7e-12_r8 * exp_fac(:) + rate(:,398) = 1.5e-15_r8 * exp( -2100._r8 * itemp(:) ) + exp_fac(:) = exp( 530._r8 * itemp(:) ) + rate(:,401) = 4.6e-12_r8 * exp_fac(:) + rate(:,404) = 2.3e-12_r8 * exp_fac(:) + rate(:,409) = 2.3e-12_r8 * exp( -170._r8 * itemp(:) ) + rate(:,413) = 4.13e-12_r8 * exp( 452._r8 * itemp(:) ) + rate(:,419) = 5.4e-14_r8 * exp( 870._r8 * itemp(:) ) + exp_fac(:) = exp( 175._r8 * itemp(:) ) + rate(:,422) = 1.86e-11_r8 * exp_fac(:) + rate(:,423) = 1.86e-11_r8 * exp_fac(:) + rate(:,433) = 1.6e+09_r8 * exp( -8300._r8 * itemp(:) ) + exp_fac(:) = exp( -446._r8 * itemp(:) ) + rate(:,438) = 3.03e-12_r8 * exp_fac(:) + rate(:,561) = 3.03e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 410._r8 * itemp(:) ) + rate(:,446) = 2.54e-11_r8 * exp_fac(:) + rate(:,565) = 2.54e-11_r8 * exp_fac(:) + rate(:,450) = 1.3e-12_r8 * exp( 640._r8 * itemp(:) ) + exp_fac(:) = exp( -193._r8 * itemp(:) ) + rate(:,458) = 2.3e-12_r8 * exp_fac(:) + rate(:,558) = 2.3e-12_r8 * exp_fac(:) + rate(:,462) = 5.9e-12_r8 * exp( 225._r8 * itemp(:) ) + rate(:,481) = 4.7e-13_r8 * exp( 1220._r8 * itemp(:) ) + exp_fac(:) = exp( 352._r8 * itemp(:) ) + rate(:,489) = 1.7e-12_r8 * exp_fac(:) + rate(:,579) = 1.7e-12_r8 * exp_fac(:) + exp_fac(:) = exp( 490._r8 * itemp(:) ) + rate(:,502) = 1.2e-12_r8 * exp_fac(:) + rate(:,572) = 1.2e-12_r8 * exp_fac(:) + exp_fac(:) = exp( -580._r8 * itemp(:) ) + rate(:,503) = 6.3e-16_r8 * exp_fac(:) + rate(:,575) = 6.3e-16_r8 * exp_fac(:) + exp_fac(:) = exp( 440._r8 * itemp(:) ) + rate(:,504) = 1.2e-11_r8 * exp_fac(:) + rate(:,576) = 1.2e-11_r8 * exp_fac(:) + rate(:,522) = 1.9e-13_r8 * exp( 520._r8 * itemp(:) ) + rate(:,523) = 1.1e-11_r8 * exp( -280._r8 * itemp(:) ) + rate(:,524) = 2.1e-11_r8 * exp( -2200._r8 * itemp(:) ) + rate(:,525) = 7.2e-14_r8 * exp( -1070._r8 * itemp(:) ) + rate(:,533) = 1.6e-13_r8 * exp( -2280._r8 * itemp(:) ) + rate(:,536) = 2.6e-11_r8 * exp( 330._r8 * itemp(:) ) + rate(:,539) = 1.7e-12_r8 * exp( -710._r8 * itemp(:) ) + exp_fac(:) = exp( 1300._r8 * itemp(:) ) + rate(:,554) = 2.75e-13_r8 * exp_fac(:) + rate(:,562) = 2.12e-13_r8 * exp_fac(:) + rate(:,573) = 2.6e-13_r8 * exp_fac(:) + + 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(:,195), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.9e-31_r8 * itemp(:)**1._r8 + kinf(:) = 2.6e-11_r8 + call jpl( rate(:,205), 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(:,217), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 9e-32_r8 * itemp(:)**1.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,225), 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(:,228), 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(:,229), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 1.8e-30_r8 * itemp(:)**3._r8 + kinf(:) = 2.8e-11_r8 + call jpl( rate(:,230), 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(:,248), 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(:,268), 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(:,279), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 6.1e-33_r8 * itemp(:)**1.5_r8 + kinf(:) = 9.8e-15_r8 * itemp(:)**(-4.6_r8) + call jpl( rate(:,325), m, 0.8_r8, ko, kinf, n ) + + ko(:) = 5.2e-30_r8 * itemp(:)**2.4_r8 + kinf(:) = 2.2e-10_r8 * itemp(:)**0.7_r8 + call jpl( rate(:,335), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 5.5e-30_r8 + kinf(:) = 8.3e-13_r8 * itemp(:)**(-2._r8) + call jpl( rate(:,336), 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(:,337), 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(:,363), 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(:,364), m, 0.6_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,385), m, 0.5_r8, ko, kinf, n ) + + ko(:) = 8e-27_r8 * itemp(:)**3.5_r8 + kinf(:) = 3e-11_r8 + call jpl( rate(:,411), 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(:,414), m, 0.6_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(:,472), m, 0.6_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(:,475), m, 0.6_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(:,478), m, 0.6_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(:,485), 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(:,527), 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,179) = 1e-20_r8 + rate(:n,180) = 1.3e-16_r8 + rate(:n,184) = 8e-14_r8 + rate(:n,185) = 3.9e-17_r8 + rate(:n,192) = 6.9e-12_r8 + rate(:n,208) = 7e-13_r8 + rate(:n,209) = 5e-12_r8 + rate(:n,606) = 6e-11_r8 + rate(:n,609) = 1e-12_r8 + rate(:n,610) = 4e-10_r8 + rate(:n,611) = 2e-10_r8 + rate(:n,612) = 1e-10_r8 + rate(:n,614) = 4.4e-10_r8 + + do k = 1,kbot + offset = (k-1)*ncol + itemp(offset+1:offset+ncol) = 1._r8 / temp(:ncol,k) + end do + + rate(:n,175) = 2.15e-11_r8 * exp( 110._r8 * itemp(:) ) + exp_fac(:) = exp( 55._r8 * itemp(:) ) + rate(:n,176) = 2.64e-11_r8 * exp_fac(:) + rate(:n,177) = 6.6e-12_r8 * exp_fac(:) + rate(:n,181) = 3.6e-18_r8 * exp( -220._r8 * itemp(:) ) + rate(:n,183) = 1.8e-15_r8 * exp( 45._r8 * itemp(:) ) + rate(:n,186) = 3.5e-11_r8 * exp( -135._r8 * itemp(:) ) + rate(:n,187) = 8e-12_r8 * exp( -2060._r8 * itemp(:) ) + rate(:n,196) = 3e-11_r8 * exp( 200._r8 * itemp(:) ) + rate(:n,197) = 1e-14_r8 * exp( -490._r8 * itemp(:) ) + rate(:n,198) = 1.4e-10_r8 * exp( -470._r8 * itemp(:) ) + rate(:n,201) = 4.8e-11_r8 * exp( 250._r8 * itemp(:) ) + rate(:n,202) = 1.8e-11_r8 * exp( 180._r8 * itemp(:) ) + rate(:n,203) = 1.7e-12_r8 * exp( -940._r8 * itemp(:) ) + rate(:n,210) = 2.1e-11_r8 * exp( 100._r8 * itemp(:) ) + rate(:n,214) = 3.3e-12_r8 * exp( -3150._r8 * itemp(:) ) + rate(:n,215) = 5.1e-12_r8 * exp( 210._r8 * itemp(:) ) + rate(:n,223) = 3.44e-12_r8 * exp( 260._r8 * itemp(:) ) + rate(:n,224) = 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,195) = wrk(:) + + + + + + + + + + + + + + + + + + + + + + + + + end subroutine setrxt_hrates + + end module mo_setrxt diff --git a/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_sim_dat.F90 b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_sim_dat.F90 new file mode 100644 index 0000000000..ecbf59902b --- /dev/null +++ b/src/chemistry/pp_waccm_tsmlt_mam5_vbsext/mo_sim_dat.F90 @@ -0,0 +1,968 @@ + + 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, 274, 0 /) + + cls_rxt_cnt(:,1) = (/ 9, 0, 0, 2 /) + cls_rxt_cnt(:,4) = (/ 8, 205, 408, 274 /) + + solsym(:276) = (/ 'ALKNIT ','ALKOOH ','AOA_NH ','bc_a1 ','bc_a4 ', & + 'BCARY ','BCARYO2VBS ','BENZENE ','BENZO2VBS ','BENZOOH ', & + 'BEPOMUC ','BIGALD ','BIGALD1 ','BIGALD2 ','BIGALD3 ', & + 'BIGALD4 ','BIGALK ','BIGENE ','BR ','BRCL ', & + 'BRO ','BRONO2 ','BRY ','BZALD ','BZOOH ', & + 'C2H2 ','C2H4 ','C2H5OH ','C2H5OOH ','C2H6 ', & + 'C3H6 ','C3H7OOH ','C3H8 ','C6H5OOH ','CCL4 ', & + 'CF2CLBR ','CF3BR ','CFC11 ','CFC113 ','CFC114 ', & + 'CFC115 ','CFC12 ','CH2BR2 ','CH2O ','CH3BR ', & + 'CH3CCL3 ','CH3CHO ','CH3CL ','CH3CN ','CH3COCH3 ', & + 'CH3COCHO ','CH3COOH ','CH3COOOH ','CH3OH ','CH3OOH ', & + 'CH4 ','CHBR3 ','CL ','CL2 ','CL2O2 ', & + 'CLO ','CLONO2 ','CLY ','CO ','CO2 ', & + 'COF2 ','COFCL ','CRESOL ','DMS ','dst_a1 ', & + 'dst_a2 ','dst_a3 ','E90 ','EOOH ','F ', & + 'GLYALD ','GLYOXAL ','H ','H2 ','H2402 ', & + 'H2O2 ','H2SO4 ','HBR ','HCFC141B ','HCFC142B ', & + 'HCFC22 ','HCL ','HCN ','HCOOH ','HF ', & + 'HNO3 ','HO2NO2 ','HOBR ','HOCL ','HONITR ', & + 'HPALD ','HYAC ','HYDRALD ','IEPOX ','ISOP ', & + 'ISOPNITA ','ISOPNITB ','ISOPNO3 ','ISOPNOOH ','ISOPO2VBS ', & + 'ISOPOOH ','IVOCbb ','IVOCbbO2VBS ','IVOCff ','IVOCffO2VBS ', & + 'MACR ','MACROOH ','MEK ','MEKOOH ','MPAN ', & + 'MTERP ','MTERPO2VBS ','MVK ','N ','N2O ', & + 'N2O5 ','NC4CH2OH ','NC4CHO ','ncl_a1 ','ncl_a2 ', & + 'ncl_a3 ','NH3 ','NH4 ','NH_5 ','NH_50 ', & + 'NO ','NO2 ','NO3 ','NOA ','NTERPOOH ', & + 'num_a1 ','num_a2 ','num_a3 ','num_a4 ','num_a5 ', & + 'O ','O2 ','O3 ','O3S ','OCLO ', & + 'OCS ','ONITR ','PAN ','PBZNIT ','PHENO ', & + 'PHENOL ','PHENOOH ','pombb1_a1 ','pombb1_a4 ','pomff1_a1 ', & + 'pomff1_a4 ','POOH ','ROOH ','S ','SF6 ', & + 'SO ','SO2 ','SO3 ','so4_a1 ','so4_a2 ', & + 'so4_a3 ','so4_a5 ','soabb1_a1 ','soabb1_a2 ','soabb2_a1 ', & + 'soabb2_a2 ','soabb3_a1 ','soabb3_a2 ','soabb4_a1 ','soabb4_a2 ', & + 'soabb5_a1 ','soabb5_a2 ','soabg1_a1 ','soabg1_a2 ','soabg2_a1 ', & + 'soabg2_a2 ','soabg3_a1 ','soabg3_a2 ','soabg4_a1 ','soabg4_a2 ', & + 'soabg5_a1 ','soabg5_a2 ','soaff1_a1 ','soaff1_a2 ','soaff2_a1 ', & + 'soaff2_a2 ','soaff3_a1 ','soaff3_a2 ','soaff4_a1 ','soaff4_a2 ', & + 'soaff5_a1 ','soaff5_a2 ','SOAGbb0 ','SOAGbb1 ','SOAGbb2 ', & + 'SOAGbb3 ','SOAGbb4 ','SOAGbg0 ','SOAGbg1 ','SOAGbg2 ', & + 'SOAGbg3 ','SOAGbg4 ','SOAGff0 ','SOAGff1 ','SOAGff2 ', & + 'SOAGff3 ','SOAGff4 ','ST80_25 ','SVOCbb ','SVOCff ', & + 'TEPOMUC ','TERP2OOH ','TERPNIT ','TERPOOH ','TERPROD1 ', & + 'TERPROD2 ','TOLOOH ','TOLUENE ','TOLUO2VBS ','XOOH ', & + 'XYLENES ','XYLENOOH ','XYLEO2VBS ','XYLOL ','XYLOLOOH ', & + 'NHDEP ','NDEP ','ACBZO2 ','ALKO2 ','BENZO2 ', & + 'BZOO ','C2H5O2 ','C3H7O2 ','C6H5O2 ','CH3CO3 ', & + 'CH3O2 ','DICARBO2 ','e ','ENEO2 ','EO ', & + 'EO2 ','HO2 ','HOCH2OO ','ISOPAO2 ','ISOPBO2 ', & + 'MACRO2 ','MALO2 ','MCO3 ','MDIALO2 ','MEKO2 ', & + 'N2D ','N2p ','NOp ','Np ','NTERPO2 ', & + 'O1D ','O2_1D ','O2_1S ','O2p ','OH ', & + 'Op ','PHENO2 ','PO2 ','RO2 ','TERP2O2 ', & + 'TERPO2 ','TOLO2 ','XO2 ','XYLENO2 ','XYLOLO2 ', & + 'H2O ' /) + + adv_mass(:276) = (/ 133.141340_r8, 104.142600_r8, 28.010400_r8, 12.011000_r8, 12.011000_r8, & + 204.342600_r8, 253.348200_r8, 78.110400_r8, 159.114800_r8, 160.122200_r8, & + 126.108600_r8, 98.098200_r8, 84.072400_r8, 98.098200_r8, 98.098200_r8, & + 112.124000_r8, 72.143800_r8, 56.103200_r8, 79.904000_r8, 115.356700_r8, & + 95.903400_r8, 141.908940_r8, 99.716850_r8, 106.120800_r8, 124.135000_r8, & + 26.036800_r8, 28.051600_r8, 46.065800_r8, 62.065200_r8, 30.066400_r8, & + 42.077400_r8, 76.091000_r8, 44.092200_r8, 110.109200_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, 41.050940_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, & + 66.007206_r8, 82.461503_r8, 108.135600_r8, 62.132400_r8, 135.064039_r8, & + 135.064039_r8, 135.064039_r8, 28.010400_r8, 78.064600_r8, 18.998403_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, 27.025140_r8, 46.024600_r8, 20.005803_r8, & + 63.012340_r8, 79.011740_r8, 96.910800_r8, 52.459500_r8, 135.114940_r8, & + 116.112400_r8, 74.076200_r8, 100.113000_r8, 118.127200_r8, 68.114200_r8, & + 147.125940_r8, 147.125940_r8, 162.117940_r8, 163.125340_r8, 117.119800_r8, & + 118.127200_r8, 184.350200_r8, 233.355800_r8, 184.350200_r8, 233.355800_r8, & + 70.087800_r8, 120.100800_r8, 72.102600_r8, 104.101400_r8, 147.084740_r8, & + 136.228400_r8, 185.234000_r8, 70.087800_r8, 14.006740_r8, 44.012880_r8, & + 108.010480_r8, 147.125940_r8, 145.111140_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, 231.239540_r8, & + 1.007400_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, 1.007400_r8, & + 15.999400_r8, 31.998800_r8, 47.998200_r8, 47.998200_r8, 67.451500_r8, & + 60.076400_r8, 133.100140_r8, 121.047940_r8, 183.117740_r8, 93.102400_r8, & + 94.109800_r8, 176.121600_r8, 12.011000_r8, 12.011000_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, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, 250.445000_r8, & + 250.445000_r8, 250.445000_r8, 28.010400_r8, 310.582400_r8, 310.582400_r8, & + 140.134400_r8, 200.226000_r8, 215.240140_r8, 186.241400_r8, 168.227200_r8, & + 154.201400_r8, 174.148000_r8, 92.136200_r8, 173.140600_r8, 150.126000_r8, & + 106.162000_r8, 188.173800_r8, 187.166400_r8, 122.161400_r8, 204.173200_r8, & + 14.006740_r8, 14.006740_r8, 137.112200_r8, 103.135200_r8, 159.114800_r8, & + 123.127600_r8, 61.057800_r8, 75.083600_r8, 109.101800_r8, 75.042400_r8, & + 47.032000_r8, 129.089600_r8, 0.548567E-03_r8, 105.108800_r8, 61.057800_r8, & + 77.057200_r8, 33.006200_r8, 63.031400_r8, 117.119800_r8, 117.119800_r8, & + 119.093400_r8, 115.063800_r8, 101.079200_r8, 117.078600_r8, 103.094000_r8, & + 14.006740_r8, 28.013480_r8, 30.006140_r8, 14.006740_r8, 230.232140_r8, & + 15.999400_r8, 31.998800_r8, 31.998800_r8, 31.998800_r8, 17.006800_r8, & + 15.999400_r8, 175.114200_r8, 91.083000_r8, 89.068200_r8, 199.218600_r8, & + 185.234000_r8, 173.140600_r8, 149.118600_r8, 187.166400_r8, 203.165800_r8, & + 18.014200_r8 /) + + crb_mass(:276) = (/ 60.055000_r8, 60.055000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, & + 180.165000_r8, 180.165000_r8, 72.066000_r8, 72.066000_r8, 72.066000_r8, & + 72.066000_r8, 60.055000_r8, 48.044000_r8, 60.055000_r8, 60.055000_r8, & + 72.066000_r8, 60.055000_r8, 48.044000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 84.077000_r8, 84.077000_r8, & + 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, 24.022000_r8, & + 36.033000_r8, 36.033000_r8, 36.033000_r8, 72.066000_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, 24.022000_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, & + 12.011000_r8, 12.011000_r8, 84.077000_r8, 24.022000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 12.011000_r8, 24.022000_r8, 0.000000_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, 12.011000_r8, 12.011000_r8, 0.000000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 48.044000_r8, & + 60.055000_r8, 36.033000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, 60.055000_r8, & + 60.055000_r8, 156.143000_r8, 156.143000_r8, 156.143000_r8, 156.143000_r8, & + 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, 48.044000_r8, & + 120.110000_r8, 120.110000_r8, 48.044000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 60.055000_r8, 60.055000_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, 120.110000_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, 0.000000_r8, & + 12.011000_r8, 48.044000_r8, 24.022000_r8, 84.077000_r8, 72.066000_r8, & + 72.066000_r8, 72.066000_r8, 12.011000_r8, 12.011000_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, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, 180.165000_r8, & + 180.165000_r8, 180.165000_r8, 12.011000_r8, 264.242000_r8, 264.242000_r8, & + 84.077000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, 120.110000_r8, & + 108.099000_r8, 84.077000_r8, 84.077000_r8, 84.077000_r8, 60.055000_r8, & + 96.088000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, 96.088000_r8, & + 0.000000_r8, 0.000000_r8, 84.077000_r8, 60.055000_r8, 72.066000_r8, & + 84.077000_r8, 24.022000_r8, 36.033000_r8, 72.066000_r8, 24.022000_r8, & + 12.011000_r8, 60.055000_r8, 0.000000_r8, 48.044000_r8, 24.022000_r8, & + 24.022000_r8, 0.000000_r8, 12.011000_r8, 60.055000_r8, 60.055000_r8, & + 48.044000_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, 120.110000_r8, & + 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, & + 0.000000_r8, 72.066000_r8, 36.033000_r8, 36.033000_r8, 120.110000_r8, & + 120.110000_r8, 84.077000_r8, 60.055000_r8, 96.088000_r8, 96.088000_r8, & + 0.000000_r8 /) + + fix_mass(: 2) = (/ 0.00000000_r8, 28.0134800_r8 /) + + clsmap(: 2,1) = (/ 231, 232 /) + clsmap(:274,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, 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, & + 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 /) + + permute(:274,4) = (/ 191, 192, 1, 2, 3, 225, 75, 107, 81, 155, & + 108, 158, 164, 134, 188, 144, 120, 149, 256, 121, & + 258, 179, 4, 123, 142, 133, 181, 130, 143, 135, & + 234, 153, 136, 131, 90, 102, 103, 93, 104, 94, & + 105, 95, 166, 273, 182, 96, 235, 148, 91, 230, & + 245, 196, 183, 207, 156, 265, 157, 267, 106, 92, & + 259, 223, 5, 236, 252, 119, 126, 113, 138, 6, & + 7, 8, 9, 100, 219, 237, 227, 268, 253, 97, & + 184, 99, 210, 125, 127, 139, 255, 116, 216, 137, & + 269, 167, 205, 209, 239, 124, 240, 147, 98, 214, & + 185, 178, 243, 154, 73, 197, 67, 66, 83, 82, & + 244, 146, 173, 145, 187, 222, 74, 249, 224, 128, & + 132, 162, 231, 10, 11, 12, 89, 13, 14, 15, & + 261, 260, 264, 215, 152, 16, 17, 18, 19, 20, & + 272, 257, 271, 21, 140, 150, 122, 176, 101, 169, & + 109, 141, 22, 23, 24, 25, 177, 151, 199, 26, & + 254, 221, 129, 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, 68, 69, 70, 71, 72, 76, 77, 78, & + 79, 80, 84, 85, 86, 114, 194, 189, 168, 229, & + 233, 186, 112, 87, 115, 117, 198, 88, 118, 159, & + 174, 226, 170, 160, 217, 220, 190, 251, 270, 203, & + 213, 180, 165, 204, 266, 161, 246, 247, 248, 200, & + 250, 218, 193, 175, 195, 211, 171, 232, 262, 110, & + 111, 212, 263, 206, 163, 208, 241, 238, 228, 201, & + 242, 202, 172, 274 /) + + diag_map(:274) = (/ 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, 71, 73, 74, 75, 76, & + 77, 78, 84, 90, 96, 97, 98, 99, 100, 101, & + 107, 113, 115, 116, 122, 128, 134, 140, 141, 144, & + 147, 150, 153, 157, 161, 165, 169, 173, 176, 179, & + 182, 185, 190, 195, 200, 205, 208, 214, 218, 223, & + 226, 229, 236, 241, 245, 248, 254, 262, 267, 270, & + 273, 276, 279, 282, 287, 292, 297, 302, 307, 311, & + 315, 319, 325, 331, 334, 340, 346, 349, 356, 362, & + 367, 373, 378, 383, 388, 393, 398, 401, 409, 417, & + 425, 431, 437, 443, 449, 455, 461, 467, 473, 481, & + 487, 493, 500, 506, 509, 514, 521, 528, 535, 541, & + 548, 556, 563, 569, 575, 580, 588, 596, 604, 612, & + 620, 628, 637, 644, 651, 662, 671, 680, 684, 692, & + 699, 710, 721, 728, 739, 749, 755, 766, 777, 784, & + 795, 811, 822, 832, 841, 849, 857, 862, 873, 880, & + 889, 897, 909, 920, 936, 942, 950, 959, 969, 979, & + 991,1006,1027,1043,1062,1086,1098,1106,1116,1124, & + 1134,1150,1163,1177,1195,1204,1210,1222,1239,1252, & + 1261,1277,1297,1313,1325,1343,1376,1400,1420,1441, & + 1472,1494,1505,1520,1539,1555,1586,1609,1636,1681, & + 1788,1832,2006,2067,2093,2214,2261,2283,2307,2360, & + 2425,2469,2496,2524 /) + + extfrc_lst(: 27) = (/ 'CO ','bc_a4 ','num_a1 ','num_a2 ','num_a4 ', & + 'num_a5 ','pombb1_a1 ','pombb1_a4 ','pomff1_a1 ','pomff1_a4 ', & + 'NO ','NO2 ','SO2 ','SVOCbb ','SVOCff ', & + 'so4_a1 ','so4_a2 ','so4_a5 ','bc_a1 ','e ', & + 'N ','N2D ','OH ','Op ','AOA_NH ', & + 'N2p ','Np ' /) + + frc_from_dataset(: 27) = (/ .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .true., & + .true., .true., .true., .true., .false., & + .false., .false., .false., .false., .false., & + .false., .false. /) + + inv_lst(: 2) = (/ 'M ', 'N2 ' /) + + slvd_lst(: 43) = (/ 'ACBZO2 ', 'ALKO2 ', 'BENZO2 ', 'BZOO ', 'C2H5O2 ', & + 'C3H7O2 ', 'C6H5O2 ', 'CH3CO3 ', 'CH3O2 ', 'DICARBO2 ', & + 'e ', 'ENEO2 ', 'EO ', 'EO2 ', 'HO2 ', & + 'HOCH2OO ', 'ISOPAO2 ', 'ISOPBO2 ', 'MACRO2 ', 'MALO2 ', & + 'MCO3 ', 'MDIALO2 ', 'MEKO2 ', 'N2D ', 'N2p ', & + 'NOp ', 'Np ', 'NTERPO2 ', 'O1D ', 'O2_1D ', & + 'O2_1S ', 'O2p ', 'OH ', 'Op ', 'PHENO2 ', & + 'PO2 ', 'RO2 ', 'TERP2O2 ', 'TERPO2 ', 'TOLO2 ', & + 'XO2 ', 'XYLENO2 ', 'XYLOLO2 ' /) + + 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_c ', & + 'jh2o_a ', 'jh2o2 ', & + 'jo2_b ', 'jo2_a ', & + 'jo3_a ', 'jo3_b ', & + 'jhno3 ', 'jho2no2_a ', & + 'jho2no2_b ', 'jn2o ', & + 'jn2o5_a ', 'jn2o5_b ', & + 'jno ', 'jno_i ', & + 'jno2 ', 'jno3_a ', & + 'jno3_b ', 'jalknit ', & + 'jalkooh ', 'jbenzooh ', & + 'jbepomuc ', 'jbigald ', & + 'jbigald1 ', 'jbigald2 ', & + 'jbigald3 ', 'jbigald4 ', & + 'jbzooh ', 'jc2h5ooh ', & + 'jc3h7ooh ', 'jc6h5ooh ', & + 'jch2o_b ', 'jch2o_a ', & + 'jch3cho ', 'jacet ', & + 'jmgly ', 'jch3co3h ', & + 'jch3ooh ', 'jch4_b ', & + 'jch4_a ', 'jco2 ', & + 'jeooh ', 'jglyald ', & + 'jglyoxal ', 'jhonitr ', & + 'jhpald ', 'jhyac ', & + 'jisopnooh ', 'jisopooh ', & + 'jmacr_a ', 'jmacr_b ', & + 'jmek ', 'jmekooh ', & + 'jmpan ', 'jmvk ', & + 'jnc4cho ', 'jnoa ', & + 'jnterpooh ', 'jonitr ', & + 'jpan ', 'jphenooh ', & + 'jpooh ', 'jrooh ', & + 'jtepomuc ', 'jterp2ooh ', & + 'jterpnit ', 'jterpooh ', & + 'jterprd1 ', 'jterprd2 ', & + 'jtolooh ', 'jxooh ', & + 'jxylenooh ', 'jxylolooh ', & + 'jbrcl ', 'jbro ', & + 'jbrono2_b ', 'jbrono2_a ', & + 'jccl4 ', 'jcf2clbr ', & + 'jcf3br ', 'jcfcl3 ', & + 'jcfc113 ', 'jcfc114 ', & + 'jcfc115 ', 'jcf2cl2 ', & + 'jch2br2 ', 'jch3br ', & + 'jch3ccl3 ', 'jch3cl ', & + 'jchbr3 ', 'jcl2 ', & + 'jcl2o2 ', 'jclo ', & + 'jclono2_a ', 'jclono2_b ', & + 'jcof2 ', 'jcofcl ', & + 'jh2402 ', 'jhbr ', & + 'jhcfc141b ', 'jhcfc142b ', & + 'jhcfc22 ', 'jhcl ', & + 'jhf ', 'jhobr ', & + 'jhocl ', 'joclo ', & + 'jsf6 ', 'jeuv_26 ', & + 'jeuv_4 ', 'jeuv_13 ', & + 'jeuv_11 ', 'jeuv_6 ', & + 'jeuv_10 ', 'jeuv_22 ', & + 'jeuv_23 ', 'jeuv_25 ', & + 'jeuv_18 ', 'jeuv_2 ', & + 'jeuv_1 ', 'jeuv_16 ', & + 'jeuv_15 ', 'jeuv_14 ', & + 'jeuv_3 ', 'jeuv_17 ', & + 'jeuv_9 ', 'jeuv_8 ', & + 'jeuv_7 ', 'jeuv_5 ', & + 'jeuv_19 ', 'jeuv_20 ', & + 'jeuv_21 ', 'jeuv_24 ', & + 'jeuv_12 ', 'jh2so4 ', & + 'jocs ', 'jso ', & + 'jso2 ', 'jso3 ', & + 'jsoabb1_a1 ', 'jsoabb1_a2 ', & + 'jsoabb2_a1 ', 'jsoabb2_a2 ', & + 'jsoabb3_a1 ', 'jsoabb3_a2 ', & + 'jsoabb4_a1 ', 'jsoabb4_a2 ', & + 'jsoabb5_a1 ', 'jsoabb5_a2 ', & + 'jsoabg1_a1 ', 'jsoabg1_a2 ', & + 'jsoabg2_a1 ', 'jsoabg2_a2 ', & + 'jsoabg3_a1 ', 'jsoabg3_a2 ', & + 'jsoabg4_a1 ', 'jsoabg4_a2 ', & + 'jsoabg5_a1 ', 'jsoabg5_a2 ', & + 'jsoaff1_a1 ', 'jsoaff1_a2 ', & + 'jsoaff2_a1 ', 'jsoaff2_a2 ', & + 'jsoaff3_a1 ', 'jsoaff3_a2 ', & + 'jsoaff4_a1 ', 'jsoaff4_a2 ', & + 'jsoaff5_a1 ', 'jsoaff5_a2 ', & + 'ag1 ', 'ag2 ', & + 'O1D_H2 ', 'O1D_H2O ', & + 'O1D_N2 ', 'O1D_O2 ', & + 'O1D_O2b ', 'O1D_O3 ', & + 'O2_1D_N2 ', 'O2_1D_O ', & + 'O2_1D_O2 ', 'O2_1S_CO2 ', & + 'O2_1S_N2 ', 'O2_1S_O ', & + 'O2_1S_O2 ', 'O2_1S_O3 ', & + '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 ' /) + rxt_tag_lst( 201: 400) = (/ 'OH_HO2 ', 'OH_O ', & + 'OH_O3 ', 'OH_OH ', & + 'OH_OH_M ', 'usr_HO2_HO2 ', & + 'HO2NO2_OH ', 'N2D_O ', & + 'N2D_O2 ', '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 ', & + 'F_CH4 ', 'F_H2 ', & + 'F_H2O ', 'F_HNO3 ', & + 'O1D_COF2 ', 'O1D_COFCL ', & + 'CH2BR2_CL ', 'CH2BR2_OH ', & + 'CH3BR_CL ', 'CH3BR_OH ', & + 'CH3CCL3_OH ', 'CH3CL_CL ', & + 'CH3CL_OH ', 'CHBR3_CL ', & + 'CHBR3_OH ', 'HCFC141B_OH ', & + 'HCFC142B_OH ', 'HCFC22_OH ', & + 'O1D_CH2BR2 ', 'O1D_CH3BR ', & + 'O1D_HCFC141B ', 'O1D_HCFC142B ', & + 'O1D_HCFC22 ', 'CH2O_HO2 ', & + 'CH2O_NO3 ', 'CH2O_O ', & + 'CH2O_OH ', 'CH3O2_CH3O2a ', & + 'CH3O2_CH3O2b ', 'CH3O2_HO2 ', & + 'CH3O2_NO ', 'CH3OH_OH ', & + 'CH3OOH_OH ', 'CH4_OH ', & + 'HCN_OH ', 'HCOOH_OH ', & + 'HOCH2OO_HO2 ', 'HOCH2OO_M ', & + 'HOCH2OO_NO ', 'O1D_CH4a ', & + 'O1D_CH4b ', 'O1D_CH4c ', & + 'O1D_HCN ', 'usr_CO_OH ', & + 'C2H2_CL_M ', 'C2H2_OH_M ', & + '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 ', & + 'CH3CN_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 ', & + 'CL_C3H8 ', 'HYAC_OH ', & + 'NOA_OH ', 'PO2_HO2 ', & + 'PO2_NO ', 'POOH_OH ', & + 'RO2_CH3O2 ', 'RO2_HO2 ', & + 'RO2_NO ', 'ROOH_OH ', & + 'tag_C3H6_OH ', 'usr_CH3COCH3_OH ', & + 'BIGENE_NO3 ', 'BIGENE_OH ', & + 'ENEO2_NO ', 'ENEO2_NOb ', & + 'HONITR_OH ', 'MACRO2_CH3CO3 ', & + 'MACRO2_CH3O2 ', 'MACRO2_HO2 ', & + 'MACRO2_NO3 ', 'MACRO2_NOa ', & + 'MACRO2_NOb ', 'MACR_O3 ', & + 'MACR_OH ', 'MACROOH_OH ' /) + rxt_tag_lst( 401: 600) = (/ 'MCO3_CH3CO3 ', 'MCO3_CH3O2 ', & + 'MCO3_HO2 ', 'MCO3_MCO3 ', & + 'MCO3_NO ', 'MCO3_NO3 ', & + 'MEKO2_HO2 ', 'MEKO2_NO ', & + 'MEK_OH ', 'MEKOOH_OH ', & + 'MPAN_OH_M ', 'MVK_O3 ', & + 'MVK_OH ', 'tag_MCO3_NO2 ', & + 'usr_MPAN_M ', 'ALKNIT_OH ', & + 'ALKO2_HO2 ', 'ALKO2_NO ', & + 'ALKO2_NOb ', 'ALKOOH_OH ', & + 'BIGALK_OH ', 'HPALD_OH ', & + 'HYDRALD_OH ', 'IEPOX_OH ', & + 'ISOPAO2_CH3CO3 ', 'ISOPAO2_CH3O2 ', & + 'ISOPAO2_HO2 ', 'ISOPAO2_NO ', & + 'ISOPAO2_NO3 ', 'ISOPBO2_CH3CO3 ', & + 'ISOPBO2_CH3O2 ', 'ISOPBO2_HO2 ', & + 'ISOPBO2_M ', 'ISOPBO2_NO ', & + 'ISOPBO2_NO3 ', 'ISOPNITA_OH ', & + 'ISOPNITB_OH ', 'ISOP_NO3 ', & + 'ISOPNO3_CH3CO3 ', 'ISOPNO3_CH3O2 ', & + 'ISOPNO3_HO2 ', 'ISOPNO3_NO ', & + 'ISOPNO3_NO3 ', 'ISOPNOOH_OH ', & + 'ISOP_O3 ', 'ISOP_OH ', & + 'ISOPOOH_OH ', 'NC4CH2OH_OH ', & + 'NC4CHO_OH ', 'XO2_CH3CO3 ', & + 'XO2_CH3O2 ', 'XO2_HO2 ', & + 'XO2_NO ', 'XO2_NO3 ', & + 'XOOH_OH ', 'ACBZO2_HO2 ', & + 'ACBZO2_NO ', 'BENZENE_OH ', & + 'BENZO2_HO2 ', 'BENZO2_NO ', & + 'BENZOOH_OH ', 'BZALD_OH ', & + 'BZOO_HO2 ', 'BZOOH_OH ', & + 'BZOO_NO ', 'C6H5O2_HO2 ', & + 'C6H5O2_NO ', 'C6H5OOH_OH ', & + 'CRESOL_OH ', 'DICARBO2_HO2 ', & + 'DICARBO2_NO ', 'DICARBO2_NO2 ', & + 'MALO2_HO2 ', 'MALO2_NO ', & + 'MALO2_NO2 ', 'MDIALO2_HO2 ', & + 'MDIALO2_NO ', 'MDIALO2_NO2 ', & + 'PHENO2_HO2 ', 'PHENO2_NO ', & + 'PHENOL_OH ', 'PHENO_NO2 ', & + 'PHENO_O3 ', 'PHENOOH_OH ', & + 'tag_ACBZO2_NO2 ', 'TOLO2_HO2 ', & + 'TOLO2_NO ', 'TOLOOH_OH ', & + 'TOLUENE_OH ', 'usr_PBZNIT_M ', & + 'XYLENES_OH ', 'XYLENO2_HO2 ', & + 'XYLENO2_NO ', 'XYLENOOH_OH ', & + 'XYLOLO2_HO2 ', 'XYLOLO2_NO ', & + 'XYLOL_OH ', 'XYLOLOOH_OH ', & + 'BCARY_NO3 ', 'BCARY_O3 ', & + 'BCARY_OH ', 'MTERP_NO3 ', & + 'MTERP_O3 ', 'MTERP_OH ', & + 'NTERPO2_CH3O2 ', 'NTERPO2_HO2 ', & + 'NTERPO2_NO ', 'NTERPO2_NO3 ', & + 'NTERPOOH_OH ', 'TERP2O2_CH3O2 ', & + 'TERP2O2_HO2 ', 'TERP2O2_NO ', & + 'TERP2OOH_OH ', 'TERPNIT_OH ', & + 'TERPO2_CH3O2 ', 'TERPO2_HO2 ', & + 'TERPO2_NO ', 'TERPOOH_OH ', & + 'TERPROD1_NO3 ', 'TERPROD1_OH ', & + 'TERPROD2_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_HONITR_aer ', 'usr_ISOPNITA_aer ', & + 'usr_ISOPNITB_aer ', 'usr_N2O5_aer ', & + 'usr_NC4CH2OH_aer ', 'usr_NC4CHO_aer ', & + 'usr_NH4_strat_tau ', 'usr_NO2_aer ', & + 'usr_NO3_aer ', 'usr_NTERPOOH_aer ', & + 'usr_ONITR_aer ', 'usr_TERPNIT_aer ', & + 'BCARY_NO3_vbs ', 'BCARYO2_HO2_vbs ', & + 'BCARYO2_NO_vbs ', 'BCARY_O3_vbs ', & + 'BCARY_OH_vbs ', 'BENZENE_OH_vbs ', & + 'BENZO2_HO2_vbs ', 'BENZO2_NO_vbs ', & + 'ISOP_NO3_vbs ', 'ISOPO2_HO2_vbs ', & + 'ISOPO2_NO_vbs ', 'ISOP_O3_vbs ', & + 'ISOP_OH_vbs ', 'IVOCbbO2_HO2_vbs ', & + 'IVOCbbO2_NO_vbs ', 'IVOCbb_OH_vbs ', & + 'IVOCffO2_HO2_vbs ', 'IVOCffO2_NO_vbs ', & + 'IVOCff_OH_vbs ', 'MTERP_NO3_vbs ', & + 'MTERPO2_HO2_vbs ', 'MTERPO2_NO_vbs ', & + 'MTERP_O3_vbs ', 'MTERP_OH_vbs ', & + 'SVOCbb_OH ', 'SVOCff_OH ', & + 'TOLUENE_OH_vbs ', 'TOLUO2_HO2_vbs ', & + 'TOLUO2_NO_vbs ', 'usr_GLYOXAL_aer ', & + 'XYLENES_OH_vbs ', 'XYLEO2_HO2_vbs ', & + 'XYLEO2_NO_vbs ', 'het1 ', & + 'het10 ', 'het11 ', & + 'het12 ', 'het13 ', & + 'het14 ', 'het15 ', & + 'het16 ', 'het17 ', & + 'het2 ', 'het3 ', & + 'het4 ', 'het5 ', & + 'het6 ', 'het7 ' /) + rxt_tag_lst( 601: 621) = (/ 'het8 ', 'het9 ', & + 'elec1 ', 'elec2 ', & + 'elec3 ', 'ion_N2p_O2 ', & + 'ion_N2p_Oa ', 'ion_N2p_Ob ', & + 'ion_Np_O ', 'ion_Np_O2a ', & + 'ion_Np_O2b ', 'ion_O2p_N ', & + 'ion_O2p_N2 ', 'ion_O2p_NO ', & + 'ion_Op_CO2 ', 'ion_Op_N2 ', & + 'ion_Op_O2 ', '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, 364, 365, 366, 367, 368, 369, 370, & + 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, & + 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, & + 391, 392, 393, 394, 395, 396, 397, 398, 399, 400, & + 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, & + 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, & + 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, & + 431, 432, 433, 434, 435, 436, 437, 438, 439, 440, & + 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, & + 451, 452, 453, 454, 455, 456, 457, 458, 459, 460, & + 461, 462, 463, 464, 465, 466, 467, 468, 469, 470, & + 471, 472, 473, 474, 475, 476, 477, 478, 479, 480, & + 481, 482, 483, 484, 485, 486, 487, 488, 489, 490, & + 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, & + 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, & + 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, & + 521, 522, 523, 524, 525, 526, 527, 528, 529, 530, & + 531, 532, 533, 534, 535, 536, 537, 538, 539, 540, & + 541, 542, 543, 544, 545, 546, 547, 548, 549, 550, & + 551, 552, 553, 554, 555, 556, 557, 558, 559, 560, & + 561, 562, 563, 564, 565, 566, 567, 568, 569, 570, & + 571, 572, 573, 574, 575, 576, 577, 578, 579, 580, & + 581, 582, 583, 584, 585, 586, 587, 588, 589, 590, & + 591, 592, 593, 594, 595, 596, 597, 598, 599, 600, & + 601, 602, 603, 604, 605, 606, 607, 608, 609, 610, & + 611, 612, 613, 614, 615, 616, 617, 618, 619, 620, & + 621 /) + 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 ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ' /) + pht_alias_lst(:,2) = (/ ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + ' ', ' ', ' ', ' ', & + ' ', 'jh2o2 ', ' ', ' ', & + ' ', ' ', 'jch3ooh ', ' ', & + 'jmgly ', 'jch2o_a ', 'jno2 ', ' ', & + 'jch3ooh ', 'jch3ooh ', ' ', ' ', & + 'jacet ', 'jch3ooh ', 'jpan ', ' ', & + 'jch2o_a ', 'jch2o_a ', 'jch3ooh ', 'jch3cho ', & + ' ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jno2 ', 'jch3ooh ', 'jch3ooh ', 'jch3ooh ', & + 'jch3cho ', 'jch3cho ', 'jch3ooh ', 'jch3ooh ', & + 'jch3ooh ', 'jch3ooh ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', ' ', ' ', ' ', & + ' ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', 'userdefined ', & + 'userdefined ', 'userdefined ', 'userdefined ', ' ', & + ' ', ' ', ' ', ' ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + 'jno2 ', 'jno2 ', 'jno2 ', 'jno2 ', & + '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, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 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, .10_r8, 0.2_r8, .14_r8, & + .20_r8, .20_r8, .006_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, .006_r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, .10_r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & + 1._r8, 1._r8, 1._r8, 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, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_r8, .0004_r8, .0004_r8, & + .0004_r8, .0004_r8, .0004_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(:) = (/ 175, 176, 177, 179, 180, & + 181, 183, 184, 185, 186, & + 187, 188, 189, 192, 195, & + 196, 197, 198, 201, 202, & + 203, 206, 208, 209, 210, & + 214, 215, 223, 224, 603, & + 604, 605, 606, 607, 609, & + 610, 611, 612, 614, 616, & + 617 /) + cph_enthalpy(:) = (/ 189.810000_r8, 32.910000_r8, 189.810000_r8, 94.300000_r8, 94.300000_r8, & + 94.300000_r8, 62.600000_r8, 62.600000_r8, 62.600000_r8, 62.600000_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, 229.610000_r8, 177.510000_r8, 313.750000_r8, & + 133.750000_r8, 193.020000_r8, 34.470000_r8, 199.170000_r8, 82.389000_r8, & + 508.950000_r8, 354.830000_r8, 339.590000_r8, 67.530000_r8, 95.550000_r8, & + 239.840000_r8, 646.280000_r8, 406.160000_r8, 271.380000_r8, 105.040000_r8, & + 150.110000_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(:) = (/ 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, & + 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, 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, 2, 2, 2, 3, 2, 2, 1, 2, 2, & + 2, 2, 2, 2, 3, 3, 3, 2, 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, 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, & + 3, 2, 2, 3, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 1, 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, 3, 2, 2, 3, 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, 3, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, & + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & + 1, 1, 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, 1, 2, 2, 2, 1, 2, 1, 1, 1, & + 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, & + 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, & + 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, & + 1 /) + + end subroutine set_sim_dat + + end module mo_sim_dat diff --git a/src/chemistry/utils/aircraft_emit.F90 b/src/chemistry/utils/aircraft_emit.F90 index 1403a4e264..f2a242aa63 100644 --- a/src/chemistry/utils/aircraft_emit.F90 +++ b/src/chemistry/utils/aircraft_emit.F90 @@ -23,6 +23,7 @@ module aircraft_emit public :: aircraft_emit_adv public :: aircraft_emit_register public :: aircraft_emit_readnl + public :: get_aircraft type :: forcing_air real(r8) :: mw @@ -40,16 +41,15 @@ module aircraft_emit type(forcing_air),allocatable :: forcings_air(:) - integer, parameter :: N_AERO = 10 - character(len=11) :: aero_names(N_AERO) = (/'ac_HC ','ac_NOX ','ac_PMNV ',& - 'ac_PMSO ','ac_PMFO ','ac_FUELBURN','ac_CO2 ','ac_H2O ',& - 'ac_SOX ','ac_CO '/) + integer, parameter :: N_AERO = 13 + character(len=13) :: aero_names(N_AERO) = (/'ac_SLANT_DIST','ac_TRACK_DIST','ac_HC ','ac_NOX ','ac_PMNV ',& + 'ac_PMSO ','ac_PMFO ','ac_FUELBURN ','ac_CO2 ','ac_H2O ',& + 'ac_SOX ','ac_CO ','ac_BC '/) real(r8), parameter :: molmass(N_AERO) = 1._r8 - logical :: advective_tracer(N_AERO) = (/.false., .false., .false., .false., .false., & - .false., .false., .false., .false.,.false./) - character(len=3) :: mixtype(N_AERO) = (/'wet','wet','wet','wet','wet','wet','wet','wet','wet','wet'/) + logical :: advective_tracer(N_AERO) = .false. + character(len=3) :: mixtype(N_AERO) = 'wet' real(r8) :: cptmp = 666.0_r8 real(r8) :: qmin = 0.0_r8 @@ -67,9 +67,26 @@ module aircraft_emit integer :: aircraft_cnt = 0 character(len=16) :: spc_name_list(N_AERO) character(len=256) :: spc_flist(N_AERO),spc_fname(N_AERO) + logical :: dist(N_AERO) contains + subroutine get_aircraft(cnt, spc_name_list_out) + integer, intent(out) :: cnt + character(len=16), optional, intent(out) :: spc_name_list_out(N_AERO) + integer :: i + + spc_name_list_out = '' + + cnt = aircraft_cnt + if( cnt>0 ) then + do i=1,cnt + spc_name_list_out(i) = spc_name_list(i) + end do + end if + + end subroutine get_aircraft + subroutine aircraft_emit_register() !------------------------------------------------------------------ @@ -90,6 +107,8 @@ subroutine aircraft_emit_register() !------------------------------------------------------------------ ! Return if air_specifier is blank (no aircraft data to process) !------------------------------------------------------------------ + dist(:) = .false. + aircraft_cnt = 0 if (air_specifier(1) == "") return ! count aircraft emission species used in the simulation @@ -108,6 +127,8 @@ subroutine aircraft_emit_register() call endrun('aircraft_emit_register: '//trim(spc_name)//' is not in the aircraft emission dataset') endif + if (trim(spc_name) == 'ac_SLANT_DIST'.or. trim(spc_name) == 'ac_TRACK_DIST') dist(n) = .true. + aircraft_cnt = aircraft_cnt + 1 call pbuf_add_field(aero_names(mm),'physpkg',dtype_r8,(/pcols,pver/),idx) @@ -189,6 +210,7 @@ subroutine aircraft_emit_init() forcings_air(m)%file%cyclical_list = .true. ! Aircraft data cycles over the filename list forcings_air(m)%file%weight_by_lat = .true. ! Aircraft data - interpolated with latitude weighting forcings_air(m)%file%conserve_column = .true. ! Aircraft data - vertically interpolated to conserve the total column + forcings_air(m)%file%dist = dist(m) forcings_air(m)%species = spc_name forcings_air(m)%sectors = spc_name ! Only one species per file for aircraft data forcings_air(m)%nsectors = 1 @@ -314,6 +336,8 @@ subroutine aircraft_emit_adv( state, pbuf2d) caseid = 4 case ('kg m-2 s-1') caseid = 5 + case ('m/sec' ) + caseid = 6 case default print*, 'aircraft_emit_adv: units = ',trim(forcings_air(m)%fields(i)%units) ,' are not recognized' call endrun('aircraft_emit_adv: units are not recognized') @@ -339,6 +363,8 @@ subroutine aircraft_emit_adv( state, pbuf2d) to_mmr(:ncol,:) = 1.0_r8 elseif (caseid == 5) then to_mmr(:ncol,:) = 1.0_r8 + elseif (caseid == 6) then + to_mmr(:ncol,:) = 1.0_r8 else to_mmr(:ncol,:) = molmass(ind)/mwdry endif diff --git a/src/chemistry/utils/apex.F90 b/src/chemistry/utils/apex.F90 index d4b60af9b1..bb690a8b42 100644 --- a/src/chemistry/utils/apex.F90 +++ b/src/chemistry/utils/apex.F90 @@ -2015,8 +2015,8 @@ subroutine cofrm(date) ! Set outputs gb(ncoef) and gv(ncoef) ! These are module data above. ! - gb(1) = 0._r8 - gv(1) = 0._r8 + gb(:) = 0._r8 + gv(:) = 0._r8 f0 = -1.e-5_r8 do k=2,kmx if (n < m) then diff --git a/src/chemistry/utils/horizontal_interpolate.F90 b/src/chemistry/utils/horizontal_interpolate.F90 index e19ee36aa3..6a7ae7e4f8 100644 --- a/src/chemistry/utils/horizontal_interpolate.F90 +++ b/src/chemistry/utils/horizontal_interpolate.F90 @@ -17,7 +17,7 @@ module horizontal_interpolate public :: xy_interp_init, xy_interp contains - subroutine xy_interp_init(im1,jm1,lon0,lat0,im2,jm2,weight_x,weight_y) + subroutine xy_interp_init(im1,jm1,lon0,lat0,im2,jm2,weight_x,weight_y,use_flight_distance) !------------------------------------------------------------------------------------------------------------ ! This program computes weighting functions to map a variable of (im1,jm1) resolution to (im2,jm2) resolution ! weight_x(im2,im1) is the weighting function for zonal interpolation @@ -28,6 +28,7 @@ subroutine xy_interp_init(im1,jm1,lon0,lat0,im2,jm2,weight_x,weight_y) !------------------------------------------------------------------------------------------------------------ implicit none integer, intent(in) :: im1, jm1, im2, jm2 + logical, intent(in) :: use_flight_distance !.true. = flight distance, .false. = all mixing ratios real(r8), intent(in) :: lon0(im1), lat0(jm1) real(r8), intent(out) :: weight_x(im2,im1), weight_y(jm2,jm1) @@ -110,28 +111,40 @@ subroutine xy_interp_init(im1,jm1,lon0,lat0,im2,jm2,weight_x,weight_y) ! check if there is any overlap between the source grid and the target grid ! if no overlap, then weighting is zero ! there are three scenarios overlaps can take place - if( (x1_west.ge.x2_west).and.(x1_east.le.x2_east) ) then + if( (x1_west>=x2_west).and.(x1_east<=x2_east) ) then ! case 1: ! x1_west x1_east ! |-------------------| ! |---------------------------------| ! x2_west x2_east + if(use_flight_distance) then + weight_x(i2,i1) = 1.0_r8 + else weight_x(i2,i1) = (x1_east-x1_west)/(x2_east-x2_west) - elseif ( (x1_west.ge.x2_west).and.(x1_west.lt.x2_east) ) then + endif + elseif ( (x1_west>=x2_west).and.(x1_westx2_west).and.(x1_east.le.x2_east) ) then + endif + elseif ( (x1_east>x2_west).and.(x1_east<=x2_east) ) then ! case 3: ! x1_west x1_east ! |--------------------------------| ! |---------------------------------| ! x2_west x2_east + if(use_flight_distance) then + weight_x(i2,i1) = (x1_east-x2_west)/(x1_east-x1_west) + else weight_x(i2,i1) = (x1_east-x2_west)/(x2_east-x2_west) - elseif ( (x1_east.gt.x2_east).and.(x1_west.lt.x2_west) ) then + endif + elseif ( (x1_east>x2_east).and.(x1_westslon2(im2+1)) then ! case 1: ! slon1(im1) slon1(im1+1) <--- end point ! |-------------------------| ! |----------------|......................| ! slon2(im2) slon2(im2+1) slon2(2) (note: slon2(im2+1) = slon2(1)) - weight_x(1,im1)= weight_x(1,im1)+(slon1(im1+1)-slon2(im2+1))/(slon2(2)-slon2(1)) + if(use_flight_distance) then + weight_x(1,im1)= weight_x(1,im1)+(slon1(im1+1)-slon2(im2+1))/(slon1(im1+1)-slon1(im1)) + else + weight_x(1,im1)= weight_x(1,im1)+(slon1(im1+1)-slon2(im2+1))/(slon2(2)-slon2(1)) + endif endif - if(slon1(im1+1).lt.slon2(im2+1)) then + if(slon1(im1+1)=y2_south).and.(y1_north<=y2_north) ) then ! case 1: ! y1_south y1_north ! |-------------------| ! |---------------------------------| ! y2_south y2_north - weight_y(j2,j1) = gw1(j1)/gw2(j2) - elseif ( (y1_south.ge.y2_south).and.(y1_south.lt.y2_north) ) then + if(use_flight_distance) then + weight_y(j2,j1) = 1.0_r8 + else + weight_y(j2,j1) = gw1(j1)/gw2(j2) + endif + elseif ( (y1_south>=y2_south).and.(y1_southy2_south).and.(y1_north<=y2_north) ) then ! case 3: ! y1_south y1_north ! |--------------------------------| ! |---------------------------------| ! y2_south y2_north - weight_y(j2,j1) = (y1_north-y2_south)/(y1_north-y1_south)*gw1(j1)/gw2(j2) - elseif ( (y1_north.gt.y2_north).and.(y1_south.lt.y2_south) ) then + if(use_flight_distance) then + weight_y(j2,j1) = (y1_north-y2_south)/(y1_north-y1_south) + else + weight_y(j2,j1) = (y1_north-y2_south)/(y1_north-y1_south)*gw1(j1)/gw2(j2) + endif + elseif ( (y1_north>y2_north).and.(y1_south 0) then + ! time:units = "days since YYYY-MM-DD hh:mm:ss" + ! 1234567890123456789012345678901234567890 + ! 1 2 3 + yri = 12 + moni = 17 + dayi = 20 + hri = 23 + mini = 26 + seci = 29 + else if(index( time_units, 'seconds since') > 0) then + ! time:units = "seconds since YYYY-MM-DD hh:mm:ss" + ! 1234567890123456789012345678901234567890 + ! 1 2 3 + yri = 15 + moni = 20 + dayi = 23 + hri = 26 + mini = 29 + seci = 32 + time_in_secs = .true. + else + call endrun('time units not recognized') + end if + + ! parse out ref date and time - ! time:units = "days since YYYY-MM-DD hh:mm:ss" ; - yr_str = time_units(12:15) - mon_str = time_units(17:18) - day_str = time_units(20:21) - hr_str = time_units(23:24) - min_str = time_units(26:27) + yr_str = time_units(yri:yri+3) + mon_str = time_units(moni:moni+1) + day_str = time_units(dayi:dayi+1) + hr_str = time_units(hri:hri+1) + min_str = time_units(mini:mini+1) read( yr_str, * ) ref_yr read( mon_str, * ) ref_mon read( day_str, * ) ref_day read( hr_str, * ) ref_hr read( min_str, * ) ref_min - if (len_trim(time_units).ge.30) then - sec_str = time_units(29:30) + if (len_trim(time_units)>seci) then + sec_str = time_units(seci:seci+1) read( sec_str, * ) ref_sec else ref_sec = 0 @@ -172,8 +210,12 @@ subroutine initialize( this, filepath, fixed, fixed_ymd, fixed_tod, force_time_i call set_time_float_from_date( ref_time, ref_yr, ref_mon, ref_day, tod ) ierr = pio_get_var( fileid, varid, times_file ) + if (time_in_secs) then + times_file = times_file/SHR_CONST_CDAY + endif + if (ierr.ne.PIO_NOERR) then - call endrun('time_coordinate%initialize: not able to read times') + call endrun(prefix//'not able to read times') endif times_file = times_file + ref_time @@ -207,26 +249,89 @@ subroutine initialize( this, filepath, fixed, fixed_ymd, fixed_tod, force_time_i ! try using date and datesec allocate(dates(this%ntimes), stat=ierr ) if( ierr /= 0 ) then - write(iulog,*) 'time_coordinate%initialize: failed to allocate dates; error = ',ierr - call endrun('time_coordinate%initialize: failed to allocate dates') + write(iulog,*) prefix//'failed to allocate dates; error = ',ierr + call endrun(prefix//'failed to allocate dates') end if allocate(datesecs(this%ntimes), stat=ierr ) if( ierr /= 0 ) then - write(iulog,*) 'time_coordinate%initialize: failed to allocate datesecs; error = ',ierr - call endrun('time_coordinate%initialize: failed to allocate datesecs') + write(iulog,*) prefix//'failed to allocate datesecs; error = ',ierr + call endrun(prefix//'failed to allocate datesecs') end if - ierr = pio_inq_varid( fileid, 'date', varid ) - if (ierr/=PIO_NOERR) then - call endrun('time_coordinate%initialize: input file must contain time or date variable '//trim(filepath)) + ierr = pio_inq_varid( fileid, 'date', varid ) + if (ierr==PIO_NOERR) then + ierr = pio_get_var( fileid, varid, dates ) + if (ierr/=PIO_NOERR) then + call endrun(prefix//' error reading date in '//trim(filepath)) + endif + else + ! try year, month, day + allocate(year(this%ntimes), stat=ierr ) + if (ierr/=0) then + call endrun(prefix//'issue with allocation of year array') + endif + allocate(month(this%ntimes), stat=ierr ) + if (ierr/=0) then + call endrun(prefix//'issue with allocation of month array') + endif + allocate(day(this%ntimes), stat=ierr ) + if (ierr/=0) then + call endrun(prefix//'issue with allocation of day array') + endif + + ierr = pio_inq_varid( fileid, 'year', varid ) + if (ierr/=PIO_NOERR) then + call endrun(prefix//' error inquiring year var in '//trim(filepath)) + endif + ierr = pio_get_var( fileid, varid, year ) + if (ierr/=PIO_NOERR) then + call endrun(prefix//' error reading year in '//trim(filepath)) + endif + + ierr = pio_inq_varid( fileid, 'month', varid ) + if (ierr/=PIO_NOERR) then + call endrun(prefix//' error inquiring month var in '//trim(filepath)) + endif + ierr = pio_get_var( fileid, varid, month ) + if (ierr/=PIO_NOERR) then + call endrun(prefix//' error reading month in '//trim(filepath)) + endif + + ierr = pio_inq_varid( fileid, 'day', varid ) + if (ierr/=PIO_NOERR) then + call endrun(prefix//' error inquiring day var in '//trim(filepath)) + endif + ierr = pio_get_var( fileid, varid, day ) + if (ierr/=PIO_NOERR) then + call endrun(prefix//' error reading day in '//trim(filepath)) + endif + + dates(:) = year(:)*10000 + month(:)*100 + day(:) + + deallocate(year,month,day) endif - ierr = pio_get_var( fileid, varid, dates ) ierr = pio_inq_varid( fileid, 'datesec', varid ) if (ierr==PIO_NOERR) then ierr = pio_get_var( fileid, varid, datesecs ) + if (ierr/=PIO_NOERR) then + call endrun(prefix//' error reading datesec in '//trim(filepath)) + endif else - datesecs(:) = 0 + ! try ut + + allocate(ut(this%ntimes), stat=ierr ) + ierr = pio_inq_varid( fileid, 'ut', varid ) ! fractional hours + if (ierr==PIO_NOERR) then + ierr = pio_get_var( fileid, varid, ut ) + if (ierr/=PIO_NOERR) then + call endrun(prefix//' error reading ut in '//trim(filepath)) + endif + datesecs = int(3600._r8*ut) ! hours -> secs + else + datesecs(:) = 0 + endif + deallocate(ut) endif call convert_dates( dates, datesecs, times_modl ) @@ -256,7 +361,7 @@ subroutine initialize( this, filepath, fixed, fixed_ymd, fixed_tod, force_time_i deallocate( times_modl, times_file ) if (use_time_bnds) deallocate(time_bnds_file) - call pio_seterrorhandling(fileid, PIO_INTERNAL_ERROR) + call pio_seterrorhandling( fileid, err_handling ) call cam_pio_closefile(fileid) @@ -298,6 +403,28 @@ function read_more(this) result(check) end function read_more + !----------------------------------------------------------------------------- + ! times_check -- returns timing status indicator + ! -1 : current model time is before the data times + ! 0 : current model time is within the data times + ! 1 : current model time is after the data times + !----------------------------------------------------------------------------- + integer function times_check(this) + class(time_coordinate), intent(in) :: this + + real(r8) :: model_time + + model_time = get_model_time() + + times_check = 0 + if (model_timethis%times(this%ntimes)) then + times_check = 1 + end if + + end function times_check + !----------------------------------------------------------------------------- ! destroy method -- deallocate memory and revert to default settings !----------------------------------------------------------------------------- diff --git a/src/chemistry/utils/mo_msis_ubc.F90 b/src/chemistry/utils/mo_msis_ubc.F90 index e0b46c2c2c..3b91311ffb 100644 --- a/src/chemistry/utils/mo_msis_ubc.F90 +++ b/src/chemistry/utils/mo_msis_ubc.F90 @@ -1,5 +1,3 @@ - - module mo_msis_ubc !--------------------------------------------------------------- ! ... msis upper bndy values @@ -19,30 +17,25 @@ module mo_msis_ubc save - integer :: ndx_n, ndx_h, ndx_o, ndx_o2 ! n, h, o, o2 spc indicies - integer :: msis_cnt = 0 ! count of msis species in simulation - integer :: ndx(pcnst) = -1 + integer :: ndx_n=-1, ndx_h=-1, ndx_o=-1, ndx_o2=-1 ! n, h, o, o2 spc indicies real(r8), allocatable :: msis_ubc(:,:,:) ! module array for msis ub values (kg/kg) logical :: zonal_average = .false. ! use zonal averaged tgcm values contains - subroutine msis_ubc_inti( zonal_avg ) + subroutine msis_ubc_inti( zonal_avg_in, n_ndx_in,h_ndx_in,o_ndx_in,o2_ndx_in ) !------------------------------------------------------------------ ! ... initialize upper boundary values !------------------------------------------------------------------ - use ppgrid, only : pcols, begchunk, endchunk - use constituents, only : cnst_get_ind, cnst_fixed_ubc - - implicit none + use ppgrid, only : pcols, begchunk, endchunk !------------------------------------------------------------------ ! ... dummy args !------------------------------------------------------------------ - logical, intent(in) :: & - zonal_avg ! zonal averaging switch + logical, intent(in) :: zonal_avg_in ! zonal averaging switch + integer, intent(in) :: n_ndx_in,h_ndx_in,o_ndx_in,o2_ndx_in !------------------------------------------------------------------ ! ... local variables @@ -50,43 +43,28 @@ subroutine msis_ubc_inti( zonal_avg ) integer :: astat real(r8) :: msis_switches(25) = 1._r8 - zonal_average = zonal_avg -!------------------------------------------------------------------ -! ... check for msis species in simuation -!------------------------------------------------------------------ - call cnst_get_ind( 'H', ndx_h, abort=.false. ) - if( ndx_h > 0 ) then - if( cnst_fixed_ubc(ndx_h) ) then - ndx(ndx_h) = ndx_h - end if - end if - call cnst_get_ind( 'N', ndx_n, abort=.false. ) - if( ndx_n > 0 ) then - if( cnst_fixed_ubc(ndx_n) ) then - ndx(ndx_n) = ndx_n - end if - end if - call cnst_get_ind( 'O', ndx_o, abort=.false. ) - if( ndx_o > 0 ) then - if( cnst_fixed_ubc(ndx_o) ) then - ndx(ndx_o) = ndx_o - end if - end if - call cnst_get_ind( 'O2', ndx_o2, abort=.false. ) - if( ndx_o2 > 0 ) then - if( cnst_fixed_ubc(ndx_o2) ) then - ndx(ndx_o2) = ndx_o2 - end if - end if + zonal_average = zonal_avg_in + + if (h_ndx_in>0) then + ndx_h = h_ndx_in + endif + if (n_ndx_in>0) then + ndx_n = n_ndx_in + endif + if (o_ndx_in>0) then + ndx_o = o_ndx_in + endif + if (o2_ndx_in>0) then + ndx_o2 = o2_ndx_in + endif !------------------------------------------------------------------ ! ... allocate msis ubc array !------------------------------------------------------------------ - msis_cnt = count( ndx(:) /= -1 ) allocate( msis_ubc(pcols,6,begchunk:endchunk),stat=astat ) if( astat /= 0 ) then write(iulog,*) 'msis_ubc_inti: failed to allocate msis_ubc; error = ',astat - call endrun + call endrun('msis_ubc_inti: failed to allocate msis_ubc') end if if( zonal_average ) then @@ -101,6 +79,7 @@ subroutine msis_ubc_inti( zonal_avg ) call addfld( 'MSIS_T', horiz_only, 'A', 'K', 'T upper boundary condition from MSIS') call addfld( 'MSIS_H', horiz_only, 'A', 'kg/kg', 'H upper boundary condition from MSIS') + call addfld( 'MSIS_N', horiz_only, 'A', 'kg/kg', 'N upper boundary condition from MSIS') call addfld( 'MSIS_O', horiz_only, 'A', 'kg/kg', 'O upper boundary condition from MSIS') call addfld( 'MSIS_O2',horiz_only, 'A', 'kg/kg', 'O2 upper boundary condition from MSIS') @@ -120,8 +99,6 @@ subroutine msis_timestep_init( ap, f107p_in, f107a_in ) use physconst, only : pi use cam_control_mod,only : lambm0, eccen, mvelpp, obliqr use shr_orb_mod, only : shr_orb_decl - - implicit none !-------------------------------------------------------------------- ! ... dummy args @@ -152,7 +129,7 @@ subroutine msis_timestep_init( ap, f107p_in, f107a_in ) real(r8) :: pint(pcols) ! top interface pressure (Pa) real(r8) :: calday, delta, esfact real(r8) :: f107p, f107a - + !-------------------------------------------------------------------- ! ... get values from msis !-------------------------------------------------------------------- @@ -166,7 +143,7 @@ subroutine msis_timestep_init( ap, f107p_in, f107a_in ) msis_ap(:) = 0._r8 msis_ap(1) = ap pint(:) = ptop_ref - + calday = get_curr_calday() esfact = 1._r8 @@ -174,7 +151,7 @@ subroutine msis_timestep_init( ap, f107p_in, f107a_in ) f107p = esfact*f107p_in f107a = esfact*f107a_in - + #ifdef MSIS_DIAGS if( masterproc ) then write(iulog,*) '====================================' @@ -203,35 +180,33 @@ subroutine msis_timestep_init( ap, f107p_in, f107a_in ) write(iulog,*) 'yrday, rtod, alt,press = ',yrday,rtod,alt,msis_press write(iulog,*) 'msis_temp = ',msis_temp(2) #endif - if( msis_cnt > 0 ) then - msis_ubc(i,2,c) = msis_conc(7) ! h (molec/cm^3) - msis_ubc(i,3,c) = msis_conc(8) ! n (molec/cm^3) - msis_ubc(i,4,c) = msis_conc(2) ! o (molec/cm^3) - msis_ubc(i,5,c) = msis_conc(4) ! o2 (molec/cm^3) - msis_ubc(i,6,c) = msis_conc(6) ! total atm dens (g/cm^3) - end if + msis_ubc(i,2,c) = msis_conc(7) ! h (molec/cm^3) + msis_ubc(i,3,c) = msis_conc(8) ! n (molec/cm^3) + msis_ubc(i,4,c) = msis_conc(2) ! o (molec/cm^3) + msis_ubc(i,5,c) = msis_conc(4) ! o2 (molec/cm^3) + msis_ubc(i,6,c) = msis_conc(6) ! total atm dens (g/cm^3) + #ifdef MSIS_DIAGS write(iulog,*) 'msis h,n,o,o2,m = ',msis_ubc(i,2:6,c) write(iulog,*) '====================================' #endif end do column_loop + !-------------------------------------------------------------------- ! ... transform from molecular density to mass mixing ratio !-------------------------------------------------------------------- - if( msis_cnt > 0 ) then - dnom(:ncol) = amu_fac/msis_ubc(:ncol,6,c) - if( ndx(ndx_h) > 0 ) then - msis_ubc(:ncol,2,c) = cnst_mw(ndx_h)*msis_ubc(:ncol,2,c)*dnom(:ncol) - end if - if( ndx(ndx_n) > 0 ) then - msis_ubc(:ncol,3,c) = cnst_mw(ndx_n)*msis_ubc(:ncol,3,c)*dnom(:ncol) - end if - if( ndx(ndx_o) > 0 ) then - msis_ubc(:ncol,4,c) = cnst_mw(ndx_o)*msis_ubc(:ncol,4,c)*dnom(:ncol) - end if - if( ndx(ndx_o2) > 0 ) then - msis_ubc(:ncol,5,c) = cnst_mw(ndx_o2)*msis_ubc(:ncol,5,c)*dnom(:ncol) - end if + dnom(:ncol) = amu_fac/msis_ubc(:ncol,6,c) + if( ndx_h > 0 ) then + msis_ubc(:ncol,2,c) = cnst_mw(ndx_h)*msis_ubc(:ncol,2,c)*dnom(:ncol) + end if + if( ndx_n > 0 ) then + msis_ubc(:ncol,3,c) = cnst_mw(ndx_n)*msis_ubc(:ncol,3,c)*dnom(:ncol) + end if + if( ndx_o > 0 ) then + msis_ubc(:ncol,4,c) = cnst_mw(ndx_o)*msis_ubc(:ncol,4,c)*dnom(:ncol) + end if + if( ndx_o2 > 0 ) then + msis_ubc(:ncol,5,c) = cnst_mw(ndx_o2)*msis_ubc(:ncol,5,c)*dnom(:ncol) end if end do chunk_loop @@ -244,14 +219,12 @@ subroutine get_msis_ubc( lchunk, ncol, temp, mmr ) use ppgrid, only : pcols - implicit none - !-------------------------------------------------------------------- ! ... dummy args !-------------------------------------------------------------------- integer, intent(in) :: lchunk ! chunk id integer, intent(in) :: ncol ! columns in chunk - real(r8), intent(inout) :: temp(pcols) ! msis temperature at top interface (K) + real(r8), intent(out) :: temp(pcols) ! msis temperature at top interface (K) real(r8), intent(inout) :: mmr(pcols,pcnst) ! msis concentrations at top interface (kg/kg) !-------------------------------------------------------------------- @@ -261,22 +234,21 @@ subroutine get_msis_ubc( lchunk, ncol, temp, mmr ) call outfld( 'MSIS_T', msis_ubc(:ncol,1,lchunk), ncol, lchunk) call outfld( 'MSIS_H', msis_ubc(:ncol,2,lchunk), ncol, lchunk) - call outfld( 'MSIS_O', msis_ubc(:ncol,3,lchunk), ncol, lchunk) - call outfld( 'MSIS_O2',msis_ubc(:ncol,4,lchunk), ncol, lchunk) + call outfld( 'MSIS_N', msis_ubc(:ncol,3,lchunk), ncol, lchunk) + call outfld( 'MSIS_O', msis_ubc(:ncol,4,lchunk), ncol, lchunk) + call outfld( 'MSIS_O2',msis_ubc(:ncol,5,lchunk), ncol, lchunk) - if( msis_cnt > 0 ) then - if( ndx(ndx_h) > 0 ) then - mmr(:ncol,ndx_h) = msis_ubc(:ncol,2,lchunk) - end if - if( ndx(ndx_n) > 0 ) then - mmr(:ncol,ndx_n) = msis_ubc(:ncol,3,lchunk) - end if - if( ndx(ndx_o) > 0 ) then - mmr(:ncol,ndx_o) = msis_ubc(:ncol,4,lchunk) - end if - if( ndx(ndx_o2) > 0 ) then - mmr(:ncol,ndx_o2) = msis_ubc(:ncol,5,lchunk) - end if + if( ndx_h > 0 ) then + mmr(:ncol,ndx_h) = msis_ubc(:ncol,2,lchunk) + end if + if( ndx_n > 0 ) then + mmr(:ncol,ndx_n) = msis_ubc(:ncol,3,lchunk) + end if + if( ndx_o > 0 ) then + mmr(:ncol,ndx_o) = msis_ubc(:ncol,4,lchunk) + end if + if( ndx_o2 > 0 ) then + mmr(:ncol,ndx_o2) = msis_ubc(:ncol,5,lchunk) end if end subroutine get_msis_ubc diff --git a/src/chemistry/utils/modal_aero_wateruptake.F90 b/src/chemistry/utils/modal_aero_wateruptake.F90 index 4bef377af9..a102aad7c4 100644 --- a/src/chemistry/utils/modal_aero_wateruptake.F90 +++ b/src/chemistry/utils/modal_aero_wateruptake.F90 @@ -161,7 +161,7 @@ subroutine modal_aero_wateruptake_dr(state, pbuf, list_idx_in, dgnumdry_m, dgnum use time_manager, only: is_first_step use cam_history, only: outfld, fieldname_len - use tropopause, only: tropopause_find, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE + use tropopause, only: tropopause_find_cam, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE ! Arguments type(physics_state), target, intent(in) :: state ! Physics state variables type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer @@ -318,7 +318,10 @@ subroutine modal_aero_wateruptake_dr(state, pbuf, list_idx_in, dgnumdry_m, dgnum if (modal_strat_sulfate) then ! get tropopause level - call tropopause_find(state, tropLev, primary=TROP_ALG_HYBSTOB, backup=TROP_ALG_CLIMATE) + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + tropLev(:) = 0 + !REMOVECAM_END + call tropopause_find_cam(state, tropLev, primary=TROP_ALG_HYBSTOB, backup=TROP_ALG_CLIMATE) endif h2ommr => state%q(:,:,1) @@ -393,7 +396,7 @@ subroutine modal_aero_wateruptake_dr(state, pbuf, list_idx_in, dgnumdry_m, dgnum call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) do k = top_lev, pver - call qsat_water(t(:ncol,k), pmid(:ncol,k), es(:ncol), qs(:ncol)) + call qsat_water(t(1:ncol,k), pmid(1:ncol,k), es(1:ncol), qs(1:ncol), ncol) do i = 1, ncol if (qs(i) > h2ommr(i,k)) then rh(i,k) = h2ommr(i,k)/qs(i) diff --git a/src/chemistry/utils/prescribed_ozone.F90 b/src/chemistry/utils/prescribed_ozone.F90 index 92a4ac84b4..cc82603025 100644 --- a/src/chemistry/utils/prescribed_ozone.F90 +++ b/src/chemistry/utils/prescribed_ozone.F90 @@ -215,13 +215,8 @@ subroutine prescribed_ozone_adv( state, pbuf2d) if( .not. has_prescribed_ozone ) return - if( cam_physpkg_is('cam3') .and. aqua_planet ) then - molmass = 48._r8 - amass = 28.9644_r8 - else - molmass = 47.9981995_r8 - amass = mwdry - end if + molmass = 47.9981995_r8 + amass = mwdry call advance_trcdata( fields, file, state, pbuf2d ) diff --git a/src/chemistry/utils/prescribed_strataero.F90 b/src/chemistry/utils/prescribed_strataero.F90 index 658fc6df62..cb3f00b8d7 100644 --- a/src/chemistry/utils/prescribed_strataero.F90 +++ b/src/chemistry/utils/prescribed_strataero.F90 @@ -418,6 +418,9 @@ subroutine prescribed_strataero_adv( state, pbuf2d) area(:ncol,:) = area_fact*area(:ncol,:) ! this definition of tropopause is consistent with what is used in chemistry + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + tropLev = 0 + !REMOVECAM_END call tropopause_findChemTrop(state(c), tropLev) do i = 1,ncol diff --git a/src/chemistry/utils/prescribed_volcaero.F90 b/src/chemistry/utils/prescribed_volcaero.F90 index 092310a7b9..2a0f4d90bb 100644 --- a/src/chemistry/utils/prescribed_volcaero.F90 +++ b/src/chemistry/utils/prescribed_volcaero.F90 @@ -206,7 +206,7 @@ subroutine prescribed_volcaero_adv( state, pbuf2d) use cam_history, only : outfld use physconst, only : mwdry ! molecular weight dry air ~ kg/kmole use physconst, only : boltz, gravit ! J/K/molecule - use tropopause, only : tropopause_find, TROP_ALG_TWMO, TROP_ALG_CLIMATE + use tropopause, only : tropopause_find_cam use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk @@ -260,7 +260,10 @@ subroutine prescribed_volcaero_adv( state, pbuf2d) call pbuf_get_field(pbuf_chnk, fields(1)%pbuf_ndx, data) data(:ncol,:) = to_mmr(:ncol,:) * data(:ncol,:) ! mmr - call tropopause_find(state(c), tropLev, primary=TROP_ALG_TWMO, backup=TROP_ALG_CLIMATE) + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + tropLev(:) = 0 + !REMOVECAM_END + call tropopause_find_cam(state(c), tropLev) do i = 1,ncol do k = 1,pver ! set to zero below tropopause diff --git a/src/chemistry/utils/solar_data.F90 b/src/chemistry/utils/solar_data.F90 index da18fbc777..51ad7ad82b 100644 --- a/src/chemistry/utils/solar_data.F90 +++ b/src/chemistry/utils/solar_data.F90 @@ -91,6 +91,7 @@ subroutine solar_data_readnl( nlfile ) write(iulog,*) 'solar_data_readnl: solar_data_type = ',trim(solar_data_type) write(iulog,*) 'solar_data_readnl: solar_data_ymd = ',solar_data_ymd write(iulog,*) 'solar_data_readnl: solar_data_tod = ',solar_data_tod + write(iulog,*) 'solar_data_readnl: solar_htng_spctrl_scl = ',solar_htng_spctrl_scl endif solar_parms_on = solar_parms_data_file.ne.'NONE' diff --git a/src/chemistry/utils/tracer_data.F90 b/src/chemistry/utils/tracer_data.F90 index 64ad69dd99..f1eeb00e17 100644 --- a/src/chemistry/utils/tracer_data.F90 +++ b/src/chemistry/utils/tracer_data.F90 @@ -1,11 +1,11 @@ module tracer_data -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! module used to read (and interpolate) offline tracer data (sources and ! mixing ratios) ! Created by: Francis Vitt -- 2 May 2006 ! Modified by : Jim Edwards -- 10 March 2009 ! Modified by : Cheryl Craig and Chih-Chieh (Jack) Chen -- February 2010 -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- use perf_mod, only : t_startf, t_stopf use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl @@ -14,7 +14,7 @@ module tracer_data use ppgrid, only : pcols, pver, pverp, begchunk, endchunk use cam_abortutils, only : endrun use cam_logfile, only : iulog - + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_index use time_manager, only : set_time_float_from_date, set_date_from_time_float use pio, only : file_desc_t, var_desc_t, & @@ -30,7 +30,7 @@ module tracer_data implicit none private ! all unless made public - save + save public :: trfld, input3d, input2d, trfile public :: trcdata_init @@ -74,7 +74,7 @@ module tracer_data type(file_desc_t) :: curr_fileid type(file_desc_t) :: next_fileid - type(var_desc_t), pointer :: currfnameid => null() ! pio restart file var id + type(var_desc_t), pointer :: currfnameid => null() ! pio restart file var id type(var_desc_t), pointer :: nextfnameid => null() ! pio restart file var id character(len=shr_kind_cl) :: filenames_list = '' @@ -92,10 +92,10 @@ module tracer_data real(r8) :: one_yr = 0 real(r8) :: curr_mod_time ! model time - calendar day real(r8) :: next_mod_time ! model time - calendar day - next time step - integer :: nlon - integer :: nlat - integer :: nlev - integer :: nilev + integer :: nlon = 0 + integer :: nlat = 0 + integer :: nlev = 0 + integer :: nilev = 0 integer :: ps_coords(3) ! LATDIM | LONDIM | TIMDIM integer :: ps_order(3) ! LATDIM | LONDIM | TIMDIM real(r8), pointer, dimension(:) :: lons => null() @@ -104,19 +104,24 @@ module tracer_data real(r8), pointer, dimension(:) :: ilevs => null() real(r8), pointer, dimension(:) :: hyam => null() real(r8), pointer, dimension(:) :: hybm => null() - real(r8), pointer, dimension(:,:) :: ps => null() real(r8), pointer, dimension(:) :: hyai => null() real(r8), pointer, dimension(:) :: hybi => null() real(r8), pointer, dimension(:,:) :: weight_x => null(), weight_y => null() integer, pointer, dimension(:) :: count_x => null(), count_y => null() integer, pointer, dimension(:,:) :: index_x => null(), index_y => null() + + real(r8), pointer, dimension(:,:) :: weight0_x=>null(), weight0_y=>null() + integer, pointer, dimension(:) :: count0_x=>null(), count0_y=>null() + integer, pointer, dimension(:,:) :: index0_x=>null(), index0_y=>null() + logical :: dist + real(r8) :: p0 type(var_desc_t) :: ps_id logical, allocatable, dimension(:) :: in_pbuf logical :: has_ps = .false. logical :: zonal_ave = .false. logical :: unstructured = .false. - logical :: alt_data = .false. + logical :: alt_data = .false. logical :: geop_alt = .false. logical :: cyclical = .false. logical :: cyclical_list = .false. @@ -126,6 +131,7 @@ module tracer_data logical :: fixed = .false. logical :: initialized = .false. logical :: top_bndry = .false. + logical :: top_layer = .false. logical :: stepTime = .false. ! Do not interpolate in time, but use stepwise times endtype trfile @@ -162,9 +168,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & use phys_grid, only : get_rlat_all_p, get_rlon_all_p, get_ncols_p use dycore, only : dycore_is use horizontal_interpolate, only : xy_interp_init -#if ( defined SPMD ) - use mpishorthand, only: mpicom, mpir8, mpiint -#endif + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_real8, mpi_integer implicit none @@ -180,6 +184,8 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & integer, intent(in) :: data_fixed_tod character(len=*), intent(in) :: data_type + character(len=*), parameter :: sub = 'trcdata_init' + integer :: f, mxnflds, astat integer :: str_yr, str_mon, str_day integer :: lon_dimid, lat_dimid, lev_dimid, tim_dimid, old_dimid @@ -197,24 +203,27 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & real(r8):: rlats(pcols), rlons(pcols) integer :: lchnk, ncol, icol, i,j logical :: found + integer :: aircraft_cnt + integer :: err_handling call specify_fields( specifier, flds ) file%datatimep=-1.e36_r8 file%datatimem=-1.e36_r8 - mxnflds = 0 + mxnflds = 0 if (associated(flds)) mxnflds = size( flds ) if (mxnflds < 1) return - + file%remove_trc_file = rmv_file file%pathname = trim(datapath) file%filenames_list = trim(filelist) file%fill_in_months = .false. - file%cyclical = .false. - file%cyclical_list = .false. + file%cyclical = .false. + file%cyclical_list = .false. + file%dist = .false. select case ( data_type ) case( 'FIXED' ) @@ -228,7 +237,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & file%cyclical_list = .true. file%cyc_yr = data_cycle_yr case( 'SERIAL' ) - case default + case default write(iulog,*) 'trcdata_init: invalid data type: '//trim(data_type)//' file: '//trim(filename) write(iulog,*) 'trcdata_init: valid data types: SERIAL | CYCLICAL | CYCLICAL_LIST | FIXED | INTERP_MISSING_MONTHS ' call endrun('trcdata_init: invalid data type: '//trim(data_type)//' file: '//trim(filename)) @@ -241,6 +250,10 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & call endrun('trcdata_init: Cannot specify data_cycle_yr if data type is not CYCLICAL') endif + if (file%top_bndry .and. file%top_layer) then + call endrun('trcdata_init: Cannot set both file%top_bndry and file%top_layer to TRUE.') + end if + if (masterproc) then write(iulog,*) 'trcdata_init: data type: '//trim(data_type)//' file: '//trim(filename) endif @@ -287,14 +300,14 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & file%curr_data_times = file%curr_data_times - file%offset_time endif - call pio_seterrorhandling(File%curr_fileid, PIO_BCAST_ERROR) + call pio_seterrorhandling(File%curr_fileid, PIO_BCAST_ERROR, oldmethod=err_handling) ierr = pio_inq_dimid( file%curr_fileid, 'ncol', idx ) file%unstructured = (ierr==PIO_NOERR) if (.not.file%unstructured) then ierr = pio_inq_dimid( file%curr_fileid, 'lon', idx ) file%zonal_ave = (ierr/=PIO_NOERR) endif - call pio_seterrorhandling(File%curr_fileid, PIO_INTERNAL_ERROR) + call pio_seterrorhandling(File%curr_fileid, err_handling) plon = get_dyn_grid_parm('plon') plat = get_dyn_grid_parm('plat') @@ -309,7 +322,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & call get_dimension( file%curr_fileid, 'lon', file%nlon, dimid=old_dimid, data=file%lons ) file%lons = file%lons * d2r - + lon_dimid = old_dimid end if endif @@ -326,19 +339,13 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & lat_dimid = old_dimid endif - allocate( file%ps(file%nlon,file%nlat), stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'trcdata_init: file%ps allocation error = ',astat - call endrun('trcdata_init: failed to allocate x array') - end if - - call pio_seterrorhandling(File%curr_fileid, PIO_BCAST_ERROR) + call pio_seterrorhandling(File%curr_fileid, PIO_BCAST_ERROR, oldmethod=err_handling) ierr = pio_inq_varid( file%curr_fileid, 'PS', file%ps_id ) file%has_ps = (ierr==PIO_NOERR) ierr = pio_inq_dimid( file%curr_fileid, 'altitude', idx ) file%alt_data = (ierr==PIO_NOERR) - call pio_seterrorhandling(File%curr_fileid, PIO_INTERNAL_ERROR) + call pio_seterrorhandling(File%curr_fileid, err_handling) if ( file%has_ps .and. .not.file%unstructured ) then if ( file%zonal_ave ) then @@ -369,8 +376,8 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & end if endif - if (masterproc) then - write(iulog,*) 'trcdata_init: file%has_ps = ' , file%has_ps + if (masterproc) then + write(iulog,*) 'trcdata_init: file%has_ps = ' , file%has_ps endif ! masterproc if (file%alt_data) then @@ -401,9 +408,9 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & call endrun('trcdata_init: failed to allocate file%hyai and file%hybi arrays') end if - call pio_seterrorhandling(File%curr_fileid, PIO_BCAST_ERROR) + call pio_seterrorhandling(File%curr_fileid, PIO_BCAST_ERROR, oldmethod=err_handling) ierr = pio_inq_varid( file%curr_fileid, 'P0', varid) - call pio_seterrorhandling(File%curr_fileid, PIO_INTERNAL_ERROR) + call pio_seterrorhandling(File%curr_fileid, err_handling) if ( ierr == PIO_NOERR ) then ierr = pio_get_var( file%curr_fileid, varid, file%p0 ) @@ -421,11 +428,6 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & ierr = pio_get_var( file%curr_fileid, varid, file%hybi ) endif - allocate( file %ps (pcols,begchunk:endchunk), stat=astat ) - if( astat/= 0 ) then - write(iulog,*) 'trcdata_init: failed to allocate file%ps array; error = ',astat - call endrun - end if allocate( file%ps_in(1)%data(pcols,begchunk:endchunk), stat=astat ) if( astat/= 0 ) then write(iulog,*) 'trcdata_init: failed to allocate file%ps_in(1)%data array; error = ',astat @@ -451,10 +453,16 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & endif + call pio_seterrorhandling(File%curr_fileid, PIO_BCAST_ERROR, oldmethod=err_handling) + flds_loop: do f = 1,mxnflds ! get netcdf variable id for the field ierr = pio_inq_varid( file%curr_fileid, flds(f)%srcnam, flds(f)%var_id ) + if (ierr/=pio_noerr) then + call endrun('trcdata_init: Cannot find var "'//trim(flds(f)%srcnam)// & + '" in file "'//trim(file%curr_filename)//'"') + endif ! determine if the field has a vertical dimension @@ -468,11 +476,11 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & ! allocate memory only if not already in pbuf2d - if ( .not. file%in_pbuf(f) ) then - if ( flds(f)%srf_fld .or. file%top_bndry ) then - allocate( flds(f) %data(pcols,1,begchunk:endchunk), stat=astat ) + if ( .not. file%in_pbuf(f) ) then + if ( flds(f)%srf_fld .or. file%top_bndry .or. file%top_layer ) then + allocate( flds(f)%data(pcols,1,begchunk:endchunk), stat=astat ) else - allocate( flds(f) %data(pcols,pver,begchunk:endchunk), stat=astat ) + allocate( flds(f)%data(pcols,pver,begchunk:endchunk), stat=astat ) endif if( astat/= 0 ) then write(iulog,*) 'trcdata_init: failed to allocate flds(f)%data array; error = ',astat @@ -481,7 +489,7 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & else flds(f)%pbuf_ndx = pbuf_get_index(flds(f)%fldnam,errcode) endif - + if (flds(f)%srf_fld) then allocate( flds(f)%input(1)%data(pcols,1,begchunk:endchunk), stat=astat ) else @@ -574,6 +582,8 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & enddo flds_loop + call pio_seterrorhandling(File%curr_fileid, err_handling) + ! if weighting by latitude, compute weighting for horizontal interpolation if( file%weight_by_lat ) then if(dycore_is('UNSTRUCTURED') ) then @@ -588,8 +598,8 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & call get_horiz_grid_d(plat, clat_d_out=phi) call get_horiz_grid_d(plon, clon_d_out=lam) - allocate(lon_global_grid_ndx(pcols,begchunk:endchunk)) - allocate(lat_global_grid_ndx(pcols,begchunk:endchunk)) + if(.not.allocated(lon_global_grid_ndx)) allocate(lon_global_grid_ndx(pcols,begchunk:endchunk)) + if(.not.allocated(lat_global_grid_ndx)) allocate(lat_global_grid_ndx(pcols,begchunk:endchunk)) lon_global_grid_ndx=-huge(1) lat_global_grid_ndx=-huge(1) @@ -613,16 +623,40 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & lat_global_grid_ndx(icol,lchnk) = j end do enddo - + deallocate(phi,lam) - + ! weight_x & weight_y are weighting function for x & y interpolation - allocate(file%weight_x(plon,file%nlon)) - allocate(file%weight_y(plat,file%nlat)) - allocate(file%count_x(plon)) - allocate(file%count_y(plat)) - allocate(file%index_x(plon,file%nlon)) - allocate(file%index_y(plat,file%nlat)) + allocate(file%weight_x(plon,file%nlon), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%weight_x allocation error = ',astat + call endrun('trcdata_init: failed to allocate weight_x array') + end if + allocate(file%weight_y(plat,file%nlat), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%weight_y allocation error = ',astat + call endrun('trcdata_init: failed to allocate weight_y array') + end if + allocate(file%count_x(plon), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%count_x allocation error = ',astat + call endrun('trcdata_init: failed to allocate count_x array') + end if + allocate(file%count_y(plat), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%count_y allocation error = ',astat + call endrun('trcdata_init: failed to allocate count_y array') + end if + allocate(file%index_x(plon,file%nlon), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%index_x allocation error = ',astat + call endrun('trcdata_init: failed to allocate index_x array') + end if + allocate(file%index_y(plat,file%nlat), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%index_y allocation error = ',astat + call endrun('trcdata_init: failed to allocate index_y array') + end if file%weight_x(:,:) = 0.0_r8 file%weight_y(:,:) = 0.0_r8 file%count_x(:) = 0 @@ -630,14 +664,54 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & file%index_x(:,:) = 0 file%index_y(:,:) = 0 + if( file%dist ) then + allocate(file%weight0_x(plon,file%nlon), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%weight0_x allocation error = ',astat + call endrun('trcdata_init: failed to allocate weight0_x array') + end if + allocate(file%weight0_y(plat,file%nlat), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%weight0_y allocation error = ',astat + call endrun('trcdata_init: failed to allocate weight0_y array') + end if + allocate(file%count0_x(plon), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%count0_x allocation error = ',astat + call endrun('trcdata_init: failed to allocate count0_x array') + end if + allocate(file%count0_y(plat), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%count0_y allocation error = ',astat + call endrun('trcdata_init: failed to allocate count0_y array') + end if + allocate(file%index0_x(plon,file%nlon), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%index0_x allocation error = ',astat + call endrun('trcdata_init: failed to allocate index0_x array') + end if + allocate(file%index0_y(plat,file%nlat), stat=astat) + if( astat /= 0 ) then + write(iulog,*) 'trcdata_init: file%index0_y allocation error = ',astat + call endrun('trcdata_init: failed to allocate index0_y array') + end if + file%weight0_x(:,:) = 0.0_r8 + file%weight0_y(:,:) = 0.0_r8 + file%count0_x(:) = 0 + file%count0_y(:) = 0 + file%index0_x(:,:) = 0 + file%index0_y(:,:) = 0 + endif + if(masterproc) then -! compute weighting - call xy_interp_init(file%nlon,file%nlat,file%lons,file%lats,plon,plat,file%weight_x,file%weight_y) +! compute weighting + call xy_interp_init(file%nlon,file%nlat,file%lons,file%lats, & + plon,plat,file%weight_x,file%weight_y,file%dist) do i2=1,plon file%count_x(i2) = 0 do i1=1,file%nlon - if(file%weight_x(i2,i1).gt.0.0_r8 ) then + if(file%weight_x(i2,i1)>0.0_r8 ) then file%count_x(i2) = file%count_x(i2) + 1 file%index_x(i2,file%count_x(i2)) = i1 endif @@ -647,28 +721,71 @@ subroutine trcdata_init( specifier, filename, filelist, datapath, flds, file, & do j2=1,plat file%count_y(j2) = 0 do j1=1,file%nlat - if(file%weight_y(j2,j1).gt.0.0_r8 ) then + if(file%weight_y(j2,j1)>0.0_r8 ) then file%count_y(j2) = file%count_y(j2) + 1 file%index_y(j2,file%count_y(j2)) = j1 endif enddo enddo + + if( file%dist ) then + call xy_interp_init(file%nlon,file%nlat,file%lons,file%lats,& + plon,plat,file%weight0_x,file%weight0_y,file%dist) + + do i2=1,plon + file%count0_x(i2) = 0 + do i1=1,file%nlon + if(file%weight0_x(i2,i1)>0.0_r8 ) then + file%count0_x(i2) = file%count0_x(i2) + 1 + file%index0_x(i2,file%count0_x(i2)) = i1 + endif + enddo + enddo + + do j2=1,plat + file%count0_y(j2) = 0 + do j1=1,file%nlat + if(file%weight0_y(j2,j1)>0.0_r8 ) then + file%count0_y(j2) = file%count0_y(j2) + 1 + file%index0_y(j2,file%count0_y(j2)) = j1 + endif + enddo + enddo + endif endif -#if ( defined SPMD) - call mpibcast(file%weight_x, plon*file%nlon, mpir8 , 0, mpicom) - call mpibcast(file%weight_y, plat*file%nlat, mpir8 , 0, mpicom) - call mpibcast(file%count_x, plon, mpiint , 0, mpicom) - call mpibcast(file%count_y, plat, mpiint , 0, mpicom) - call mpibcast(file%index_x, plon*file%nlon, mpiint , 0, mpicom) - call mpibcast(file%index_y, plat*file%nlat, mpiint , 0, mpicom) -#endif + call mpi_bcast(file%weight_x, plon*file%nlon, mpi_real8 , mstrid, mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: file%weight_x") + call mpi_bcast(file%weight_y, plat*file%nlat, mpi_real8 , mstrid, mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: file%weight_y") + call mpi_bcast(file%count_x, plon, mpi_integer , mstrid, mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: file%count_x") + call mpi_bcast(file%count_y, plat, mpi_integer , mstrid, mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: file%count_y") + call mpi_bcast(file%index_x, plon*file%nlon, mpi_integer , mstrid, mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: file%index_x") + call mpi_bcast(file%index_y, plat*file%nlat, mpi_integer , mstrid, mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: file%index_y") + if( file%dist ) then + call mpi_bcast(file%weight0_x, plon*file%nlon, mpi_real8 , mstrid, mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: file%weight0_x") + call mpi_bcast(file%weight0_y, plat*file%nlat, mpi_real8 , mstrid, mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: file%weight0_y") + call mpi_bcast(file%count0_x, plon, mpi_integer , mstrid, mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: file%count0_x") + call mpi_bcast(file%count0_y, plon, mpi_integer , mstrid, mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: file%count0_y") + call mpi_bcast(file%index0_x, plon*file%nlon, mpi_integer , mstrid, mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: file%index0_x") + call mpi_bcast(file%index0_y, plat*file%nlat, mpi_integer , mstrid, mpicom,ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: file%index0_y") + endif endif end subroutine trcdata_init !----------------------------------------------------------------------- -! Reads more data if needed and interpolates data to current model time +! Reads more data if needed and interpolates data to current model time !----------------------------------------------------------------------- subroutine advance_trcdata( flds, file, state, pbuf2d ) use physics_types,only : physics_state @@ -678,7 +795,7 @@ subroutine advance_trcdata( flds, file, state, pbuf2d ) type(trfile), intent(inout) :: file type(trfld), intent(inout) :: flds(:) type(physics_state), intent(in) :: state(begchunk:endchunk) - + type(physics_buffer_desc), pointer :: pbuf2d(:,:) real(r8) :: data_time @@ -693,7 +810,7 @@ subroutine advance_trcdata( flds, file, state, pbuf2d ) if ( file%cyclical .or. file%cyclical_list ) then ! wrap around if ( (file%datatimepfile%datatimem) ) then - data_time = data_time + file%one_yr + data_time = data_time + file%one_yr endif endif @@ -707,7 +824,7 @@ subroutine advance_trcdata( flds, file, state, pbuf2d ) end if endif - + ! need to interpolate the data, regardless ! each mpi task needs to interpolate call t_startf('interpolate_trcdata') @@ -733,7 +850,7 @@ subroutine get_fld_data( flds, field_name, data, ncol, lchnk, pbuf ) integer, intent(in) :: lchnk integer, intent(in) :: ncol type(physics_buffer_desc), pointer :: pbuf(:) - + integer :: f, nflds real(r8),pointer :: tmpptr(:,:) @@ -762,7 +879,7 @@ subroutine get_fld_ndx( flds, field_name, idx ) type(trfld), intent(in) :: flds(:) character(len=*), intent(in) :: field_name - integer, intent(out) :: idx + integer, intent(out) :: idx integer :: f, nflds idx = -1 @@ -821,7 +938,7 @@ subroutine check_files( file, fids, itms, times_found) if ((file%curr_mod_time > file%datatimep)) then call advance_file(file) - + endif endif @@ -838,15 +955,15 @@ subroutine check_files( file, fids, itms, times_found) file%next_data_times = file%next_data_times - file%offset_time endif endif - + !----------------------------------------------------------------------- ! If using next_data_times and the current is greater than or equal to the next, then ! close the current file, and set up for next file. !----------------------------------------------------------------------- if ( associated(file%next_data_times) ) then - if (file%cyclical_list .and. list_cycled) then ! special case - list cycled + if (file%cyclical_list .and. list_cycled) then ! special case - list cycled - file%datatimem = file%curr_data_times(size(file%curr_data_times)) + file%datatimem = file%curr_data_times(size(file%curr_data_times)) itms(1)=size(file%curr_data_times) fids(1)=file%curr_fileid @@ -881,7 +998,7 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ implicit none character(len=*), intent(in) :: filename ! present dynamical dataset filename - character(len=*), optional, intent(in) :: filenames_list + character(len=*), optional, intent(in) :: filenames_list character(len=*), optional, intent(in) :: datapath logical , optional, intent(in) :: cyclical_list ! If true, allow list to cycle logical , optional, intent(out) :: list_cycled @@ -898,8 +1015,8 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ character(len=shr_kind_cl) :: fn_new, line, filepath integer :: ios,unitnumber logical :: abort_run - - if (present(abort)) then + + if (present(abort)) then abort_run = abort else abort_run = .true. @@ -946,11 +1063,11 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ !------------------------------------------------------------------- ! ... read file names !------------------------------------------------------------------- - read( unit=unitnumber, fmt='(A)', iostat=ios ) line + read( unit=unitnumber, fmt='(A)', iostat=ios ) line if (ios /= 0) then if (abort_run) then call endrun('not able to increment file name from filenames_list file: '//trim(filenames_list)) - else + else fn_new = 'NOT_FOUND' incr_filename = trim(fn_new) return @@ -961,31 +1078,31 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ ! If current filename is '', then initialize with the first filename read in ! and skip this section. !------------------------------------------------------------------- - if (filename /= '') then + if (filename /= '') then !------------------------------------------------------------------- ! otherwise read until find current filename !------------------------------------------------------------------- do while( trim(line) /= trim(filename) ) - read( unit=unitnumber, fmt='(A)', iostat=ios ) line + read( unit=unitnumber, fmt='(A)', iostat=ios ) line if (ios /= 0) then if (abort_run) then call endrun('not able to increment file name from filenames_list file: '//trim(filenames_list)) - else + else fn_new = 'NOT_FOUND' incr_filename = trim(fn_new) return endif endif enddo - + !------------------------------------------------------------------- ! Read next filename !------------------------------------------------------------------- - read( unit=unitnumber, fmt='(A)', iostat=ios ) line + read( unit=unitnumber, fmt='(A)', iostat=ios ) line !--------------------------------------------------------------------------------- - ! If cyclical_list, then an end of file is not an error, but rather + ! If cyclical_list, then an end of file is not an error, but rather ! a signal to rewind and start over !--------------------------------------------------------------------------------- @@ -994,7 +1111,7 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ if (cyclical_list) then list_cycled=.true. rewind(unitnumber) - read( unit=unitnumber, fmt='(A)', iostat=ios ) line + read( unit=unitnumber, fmt='(A)', iostat=ios ) line ! Error here should never happen, but check just in case if (ios /= 0) then call endrun('not able to increment file name from filenames_list file: '//trim(filenames_list)) @@ -1005,7 +1122,7 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ else if (abort_run) then call endrun('not able to increment file name from filenames_list file: '//trim(filenames_list)) - else + else fn_new = 'NOT_FOUND' incr_filename = trim(fn_new) return @@ -1025,7 +1142,7 @@ function incr_filename( filename, filenames_list, datapath, cyclical_list, list_ endif !--------------------------------------------------------------------------------- - ! return the current filename + ! return the current filename !--------------------------------------------------------------------------------- incr_filename = trim(fn_new) if ( masterproc ) write(iulog,*) 'incr_flnm: new filename = ',trim(incr_filename) @@ -1050,7 +1167,7 @@ subroutine find_times( itms, fids, time, file, datatimem, datatimep, times_found logical, intent(inout) :: times_found integer :: np1 ! current forward time index of dataset - integer :: n,i ! + integer :: n,i ! integer :: curr_tsize, next_tsize, all_tsize integer :: astat integer :: cyc_tsize @@ -1080,14 +1197,14 @@ subroutine find_times( itms, fids, time, file, datatimem, datatimep, times_found call endrun('find_times: all(all_data_times(:) > time) '// trim(file%curr_filename) ) endif - ! find bracketing times + ! find bracketing times find_times_loop : do n=1, all_tsize-1 np1 = n + 1 datatimem = all_data_times(n) !+ file%offset_time datatimep = all_data_times(np1) !+ file%offset_time ! When stepTime, datatimep may not equal the time (as only datatimem is used) ! Should not break other runs? - if ( (time .ge. datatimem) .and. (time .lt. datatimep) ) then + if ( (time >= datatimem) .and. (time < datatimep) ) then times_found = .true. exit find_times_loop endif @@ -1107,8 +1224,8 @@ subroutine find_times( itms, fids, time, file, datatimem, datatimep, times_found np1 = n+1 endif - datatimem = all_data_times(n +file%cyc_ndx_beg-1) - datatimep = all_data_times(np1+file%cyc_ndx_beg-1) + datatimem = all_data_times(n +file%cyc_ndx_beg-1) + datatimep = all_data_times(np1+file%cyc_ndx_beg-1) times_found = .true. endif @@ -1129,7 +1246,7 @@ subroutine find_times( itms, fids, time, file, datatimem, datatimep, times_found write(iulog,*) 'find_times: failed to deallocate all_data_times array; error = ',astat call endrun end if - + if ( .not. file%cyclical ) then itms(1) = n itms(2) = np1 @@ -1141,8 +1258,8 @@ subroutine find_times( itms, fids, time, file, datatimem, datatimep, times_found fids(:) = file%curr_fileid do i=1,2 - if ( itms(i) > curr_tsize ) then - itms(i) = itms(i) - curr_tsize + if ( itms(i) > curr_tsize ) then + itms(i) = itms(i) - curr_tsize fids(i) = file%next_fileid endif enddo @@ -1157,28 +1274,28 @@ subroutine read_next_trcdata( flds, file ) type (trfile), intent(inout) :: file type (trfld),intent(inout) :: flds(:) - integer :: recnos(4),i,f,nflds ! + integer :: recnos(4),i,f,nflds ! integer :: cnt4(4) ! array of counts for each dimension integer :: strt4(4) ! array of starting indices integer :: cnt3(3) ! array of counts for each dimension integer :: strt3(3) ! array of starting indices type(file_desc_t) :: fids(4) - logical :: times_found + logical :: times_found integer :: cur_yr, cur_mon, cur_day, cur_sec, yr1, yr2, mon, date, sec real(r8) :: series1_time, series2_time type(file_desc_t) :: fid1, fid2 - + nflds = size(flds) times_found = .false. - + do while( .not. times_found ) call find_times( recnos, fids, file%curr_mod_time, file,file%datatimem, file%datatimep, times_found ) if ( .not. times_found ) then call check_files( file, fids, recnos, times_found ) endif enddo - + !-------------------------------------------------------------- ! If stepTime, then no time interpolation is to be done !-------------------------------------------------------------- @@ -1225,9 +1342,9 @@ subroutine read_next_trcdata( flds, file ) call set_date_from_time_float( file%datatimes(1), yr1, mon, date, sec ) call set_time_float_from_date( file%datatimem, cur_yr, mon, date, sec ) if (file%datatimes(1) > file%datatimes(2) ) then ! wrap around - if ( cur_mon == 1 ) then + if ( cur_mon == 1 ) then call set_time_float_from_date( file%datatimem, cur_yr-1, mon, date, sec ) - endif + endif endif call set_date_from_time_float( file%datatimes(2), yr1, mon, date, sec ) @@ -1235,7 +1352,7 @@ subroutine read_next_trcdata( flds, file ) if (file%datatimes(1) > file%datatimes(2) ) then ! wrap around if ( cur_mon == 12 ) then call set_time_float_from_date( file%datatimep, cur_yr+1, mon, date, sec ) - endif + endif endif endif @@ -1267,7 +1384,7 @@ subroutine read_next_trcdata( flds, file ) if ( file%unstructured ) then ! read data directly onto the unstructureed phys grid -- assumes input data is on same grid as phys call read_physgrid_2d( fids(i), flds(f)%fldnam, recnos(i), flds(f)%input(i)%data(:,1,:) ) - else + else cnt3( flds(f)%coords(LONDIM)) = file%nlon cnt3( flds(f)%coords(LATDIM)) = file%nlat cnt3( flds(f)%coords(PS_TIMDIM)) = 1 @@ -1283,7 +1400,7 @@ subroutine read_next_trcdata( flds, file ) else call read_physgrid_3d( fids(i), flds(f)%fldnam, 'lev', file%nlev, recnos(i), flds(f)%input(i)%data(:,:,:) ) end if - else + else cnt4(flds(f)%coords(LONDIM)) = file%nlon cnt4(flds(f)%coords(LATDIM)) = file%nlat cnt4(flds(f)%coords(LEVDIM)) = file%nlev @@ -1328,9 +1445,10 @@ end subroutine read_next_trcdata subroutine read_2d_trc( fid, vid, loc_arr, strt, cnt, file, order ) use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish - use phys_grid, only : pcols, begchunk, endchunk, get_ncols_p, get_rlat_all_p, get_rlon_all_p - use mo_constants, only : pi - use dycore, only: dycore_is + use ppgrid, only: pcols, begchunk, endchunk + use phys_grid, only: get_ncols_p, get_rlat_all_p, get_rlon_all_p + use mo_constants, only: pi + use dycore, only: dycore_is use polar_avg, only: polar_average use horizontal_interpolate, only : xy_interp @@ -1347,7 +1465,7 @@ subroutine read_2d_trc( fid, vid, loc_arr, strt, cnt, file, order ) integer :: c, ierr, ncols real(r8), parameter :: zero=0_r8, twopi=2_r8*pi - type(interp_type) :: lon_wgts, lat_wgts + type(interp_type) :: lon_wgts, lat_wgts integer :: lons(pcols), lats(pcols) real(r8) :: file_lats(file%nlat) @@ -1420,8 +1538,8 @@ subroutine read_2d_trc( fid, vid, loc_arr, strt, cnt, file, order ) call lininterp_init(file%lons, file%nlon, to_lons, ncols, 2, lon_wgts, zero, twopi) call lininterp_init(file%lats, file%nlat, to_lats, ncols, 1, lat_wgts) - call lininterp(wrk2d_in, file%nlon, file%nlat, loc_arr(1:ncols,c-begchunk+1), ncols, lon_wgts, lat_wgts) - + call lininterp(wrk2d_in, file%nlon, file%nlat, loc_arr(1:ncols,c-begchunk+1), ncols, lon_wgts, lat_wgts) + call lininterp_finish(lon_wgts) call lininterp_finish(lat_wgts) end do @@ -1441,7 +1559,8 @@ end subroutine read_2d_trc subroutine read_za_trc( fid, vid, loc_arr, strt, cnt, file, order ) use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish - use phys_grid, only : pcols, begchunk, endchunk, get_ncols_p, get_rlat_all_p + use ppgrid, only : pcols, begchunk, endchunk + use phys_grid, only : get_ncols_p, get_rlat_all_p implicit none type(file_desc_t), intent(in) :: fid @@ -1487,7 +1606,7 @@ subroutine read_za_trc( fid, vid, loc_arr, strt, cnt, file, order ) call lininterp_init(file%lats, file%nlat, to_lats, ncols, 1, lat_wgts) do k=1,file%nlev - call lininterp(wrk2d_in(:,k), file%nlat, wrk(1:ncols), ncols, lat_wgts) + call lininterp(wrk2d_in(:,k), file%nlat, wrk(1:ncols), ncols, lat_wgts) loc_arr(1:ncols,k,c-begchunk+1) = wrk(1:ncols) end do call lininterp_finish(lat_wgts) @@ -1530,7 +1649,7 @@ subroutine read_physgrid_2d(ncid, varname, recno, data ) end if end subroutine read_physgrid_2d - + !------------------------------------------------------------------------ !------------------------------------------------------------------------ ! this assumes the input data is gridded to match the physics grid @@ -1564,14 +1683,15 @@ subroutine read_physgrid_3d(ncid, varname, vrt_coord_name, nlevs, recno, data ) end if end subroutine read_physgrid_3d - + !------------------------------------------------------------------------ - + subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish - use phys_grid, only : pcols, begchunk, endchunk, get_ncols_p, get_rlat_all_p, get_rlon_all_p + use ppgrid, only : pcols, begchunk, endchunk + use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p use mo_constants, only : pi - use dycore, only : dycore_is + use dycore, only : dycore_is use polar_avg, only : polar_average use horizontal_interpolate, only : xy_interp @@ -1581,7 +1701,7 @@ subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) type(var_desc_t), intent(in) :: vid integer, intent(in) :: strt(:), cnt(:), order(3) real(r8),intent(out) :: loc_arr(:,:,:) - + type (trfile), intent(in) :: file integer :: astat, c, ncols @@ -1593,7 +1713,7 @@ subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) real(r8), pointer :: wrk3d_in(:,:,:) real(r8) :: to_lons(pcols), to_lats(pcols) real(r8), parameter :: zero=0_r8, twopi=2_r8*pi - type(interp_type) :: lon_wgts, lat_wgts + type(interp_type) :: lon_wgts, lat_wgts loc_arr(:,:,:) = 0._r8 nullify(wrk3d_in) @@ -1623,16 +1743,27 @@ subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) if(file%weight_by_lat) then call t_startf('xy_interp') - - do c = begchunk,endchunk + if( file%dist ) then + do c = begchunk,endchunk ncols = get_ncols_p(c) lons(:ncols) = lon_global_grid_ndx(:ncols,c) lats(:ncols) = lat_global_grid_ndx(:ncols,c) - call xy_interp(file%nlon,file%nlat,file%nlev,plon,plat,pcols,ncols,file%weight_x,file%weight_y,wrk3d_in, & - loc_arr(:,:,c-begchunk+1), lons,lats,file%count_x,file%count_y,file%index_x,file%index_y) - enddo + call xy_interp(file%nlon,file%nlat,file%nlev,plon,plat,pcols,ncols, & + file%weight0_x,file%weight0_y,wrk3d_in,loc_arr(:,:,c-begchunk+1), & + lons,lats,file%count0_x,file%count0_y,file%index0_x,file%index0_y) + enddo + else + do c = begchunk,endchunk + ncols = get_ncols_p(c) + lons(:ncols) = lon_global_grid_ndx(:ncols,c) + lats(:ncols) = lat_global_grid_ndx(:ncols,c) + call xy_interp(file%nlon,file%nlat,file%nlev,plon,plat,pcols,ncols,& + file%weight_x,file%weight_y,wrk3d_in,loc_arr(:,:,c-begchunk+1), & + lons,lats,file%count_x,file%count_y,file%index_x,file%index_y) + enddo + endif call t_stopf('xy_interp') else @@ -1645,7 +1776,7 @@ subroutine read_3d_trc( fid, vid, loc_arr, strt, cnt, file, order) call lininterp_init(file%lats, file%nlat, to_lats(1:ncols), ncols, 1, lat_wgts) - call lininterp(wrk3d_in, file%nlon, file%nlat, file%nlev, loc_arr(:,:,c-begchunk+1), ncols, pcols, lon_wgts, lat_wgts) + call lininterp(wrk3d_in, file%nlon, file%nlat, file%nlev, loc_arr(:,:,c-begchunk+1), ncols, pcols, lon_wgts, lat_wgts) call lininterp_finish(lon_wgts) @@ -1674,10 +1805,10 @@ subroutine interpolate_trcdata( state, flds, file, pbuf2d ) implicit none - type(physics_state), intent(in) :: state(begchunk:endchunk) + type(physics_state), intent(in) :: state(begchunk:endchunk) type (trfld), intent(inout) :: flds(:) type (trfile), intent(inout) :: file - + type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -1704,10 +1835,10 @@ subroutine interpolate_trcdata( state, flds, file, pbuf2d ) do c = begchunk,endchunk ncol = state(c)%ncol if ( file%has_ps ) then - file%ps_in(1)%data(:ncol,c) = fact1*file%ps_in(1)%data(:ncol,c) + fact2*file%ps_in(3)%data(:ncol,c) + file%ps_in(1)%data(:ncol,c) = fact1*file%ps_in(1)%data(:ncol,c) + fact2*file%ps_in(3)%data(:ncol,c) endif do f = 1,nflds - flds(f)%input(1)%data(:ncol,:,c) = fact1*flds(f)%input(1)%data(:ncol,:,c) + fact2*flds(f)%input(3)%data(:ncol,:,c) + flds(f)%input(1)%data(:ncol,:,c) = fact1*flds(f)%input(1)%data(:ncol,:,c) + fact2*flds(f)%input(3)%data(:ncol,:,c) enddo enddo @@ -1719,10 +1850,10 @@ subroutine interpolate_trcdata( state, flds, file, pbuf2d ) do c = begchunk,endchunk ncol = state(c)%ncol if ( file%has_ps ) then - file%ps_in(2)%data(:ncol,c) = fact1*file%ps_in(2)%data(:ncol,c) + fact2*file%ps_in(4)%data(:ncol,c) + file%ps_in(2)%data(:ncol,c) = fact1*file%ps_in(2)%data(:ncol,c) + fact2*file%ps_in(4)%data(:ncol,c) endif do f = 1,nflds - flds(f)%input(2)%data(:ncol,:,c) = fact1*flds(f)%input(2)%data(:ncol,:,c) + fact2*flds(f)%input(4)%data(:ncol,:,c) + flds(f)%input(2)%data(:ncol,:,c) = fact1*flds(f)%input(2)%data(:ncol,:,c) + fact2*flds(f)%input(4)%data(:ncol,:,c) enddo enddo @@ -1779,10 +1910,10 @@ subroutine interpolate_trcdata( state, flds, file, pbuf2d ) if (fact2 == 0) then ! This needed as %data is not set if fact2=0 (and lahey compiler core dumps) datain(:ncol,:) = fact1*flds(f)%input(nm)%data(:ncol,:,c) else - datain(:ncol,:) = fact1*flds(f)%input(nm)%data(:ncol,:,c) + fact2*flds(f)%input(np)%data(:ncol,:,c) + datain(:ncol,:) = fact1*flds(f)%input(nm)%data(:ncol,:,c) + fact2*flds(f)%input(np)%data(:ncol,:,c) end if do i = 1,ncol - model_z(1:pverp) = m2km * state(c)%zi(i,pverp:1:-1) + model_z(1:pverp) = m2km * state(c)%zi(i,pverp:1:-1) if (file%geop_alt) then model_z(1:pverp) = model_z(1:pverp) + m2km * state(c)%phis(i)*rga endif @@ -1801,7 +1932,7 @@ subroutine interpolate_trcdata( state, flds, file, pbuf2d ) if (fact2 == 0) then ! This needed as %data is not set if fact2=0 (and lahey compiler core dumps) ps(:ncol) = fact1*file%ps_in(nm)%data(:ncol,c) else - ps(:ncol) = fact1*file%ps_in(nm)%data(:ncol,c) + fact2*file%ps_in(np)%data(:ncol,c) + ps(:ncol) = fact1*file%ps_in(nm)%data(:ncol,c) + fact2*file%ps_in(np)%data(:ncol,c) end if do i = 1,ncol do k = 1,file%nlev @@ -1822,7 +1953,7 @@ subroutine interpolate_trcdata( state, flds, file, pbuf2d ) fact1*flds(f)%input(nm)%data(i,1,c) else data_out(i,1) = & - fact1*flds(f)%input(nm)%data(i,1,c) + fact2*flds(f)%input(np)%data(i,1,c) + fact1*flds(f)%input(nm)%data(i,1,c) + fact2*flds(f)%input(np)%data(i,1,c) endif enddo else @@ -1832,11 +1963,13 @@ subroutine interpolate_trcdata( state, flds, file, pbuf2d ) datain(:ncol,:) = fact1*flds(f)%input(nm)%data(:ncol,:,c) + fact2*flds(f)%input(np)%data(:ncol,:,c) end if if ( file%top_bndry ) then - call vert_interp_ub(ncol, file%nlev, file%levs, datain(:ncol,:), data_out(:ncol,:) ) + call vert_interp_ub(ncol, file%nlev, file%levs, datain(:ncol,:), data_out(:ncol,1) ) + else if ( file%top_layer ) then + call vert_interp_ub_var(ncol, file%nlev, file%levs, state(c)%pmid(:ncol,1), datain(:ncol,:), data_out(:ncol,1) ) else if(file%conserve_column) then call vert_interp_mixrat(ncol,file%nlev,pver,state(c)%pint, & datain, data_out(:,:), & - file%p0,ps,file%hyai,file%hybi) + file%p0,ps,file%hyai,file%hybi,file%dist) else call vert_interp(ncol, file%nlev, pin, state(c)%pmid, datain, data_out(:,:) ) endif @@ -1861,10 +1994,11 @@ subroutine get_dimension( fid, dname, dsize, dimid, data ) real(r8), optional, pointer, dimension(:) :: data integer :: vid, ierr, id + integer :: err_handling - call pio_seterrorhandling( fid, PIO_BCAST_ERROR) + call pio_seterrorhandling( fid, PIO_BCAST_ERROR, oldmethod=err_handling) ierr = pio_inq_dimid( fid, dname, id ) - call pio_seterrorhandling( fid, PIO_INTERNAL_ERROR) + call pio_seterrorhandling( fid, err_handling) if ( ierr==PIO_NOERR ) then @@ -1971,6 +2105,7 @@ subroutine open_trc_datafile( fname, path, piofile, times, cyc_ndx_beg, cyc_ndx_ integer, allocatable , dimension(:) :: dates, datesecs integer :: astat, ierr logical :: need_first_ndx + integer :: err_handling if (len_trim(path) == 0) then filepath = trim(fname) @@ -1985,7 +2120,7 @@ subroutine open_trc_datafile( fname, path, piofile, times, cyc_ndx_beg, cyc_ndx_ if(masterproc) write(iulog,*)'open_trc_datafile: ',trim(filen) call get_dimension(piofile, 'time', timesize) - + if ( associated(times) ) then deallocate(times, stat=ierr) if( ierr /= 0 ) then @@ -2011,10 +2146,10 @@ subroutine open_trc_datafile( fname, path, piofile, times, cyc_ndx_beg, cyc_ndx_ end if ierr = pio_inq_varid( piofile, 'date', dateid ) - call pio_seterrorhandling( piofile, PIO_BCAST_ERROR) + call pio_seterrorhandling( piofile, PIO_BCAST_ERROR, oldmethod=err_handling) ierr = pio_inq_varid( piofile, 'datesec', secid ) - call pio_seterrorhandling( piofile, PIO_INTERNAL_ERROR) - + call pio_seterrorhandling( piofile, err_handling) + if(ierr==PIO_NOERR) then ierr = pio_get_var( piofile, secid, datesecs ) else @@ -2047,12 +2182,12 @@ subroutine open_trc_datafile( fname, path, piofile, times, cyc_ndx_beg, cyc_ndx_ if(masterproc) write(iulog,*) 'open_trc_datafile: failed to deallocate dates array; error = ',astat call endrun end if - deallocate( datesecs, stat=astat ) + deallocate( datesecs, stat=astat ) if( astat/= 0 ) then if(masterproc) write(iulog,*) 'open_trc_datafile: failed to deallocate datesec array; error = ',astat call endrun end if - + if ( present(cyc_yr) .and. present(cyc_ndx_beg) ) then if (cyc_ndx_beg < 0) then write(iulog,*) 'open_trc_datafile: cycle year not found : ' , cyc_yr @@ -2140,15 +2275,15 @@ subroutine init_trc_restart( whence, piofile, tr_file ) character(len=*), intent(in) :: whence type(file_desc_t), intent(inout) :: piofile type(trfile), intent(inout) :: tr_file - + character(len=32) :: name integer :: ioerr, mcdimid, maxlen - + integer :: err_handling ! Dimension should already be defined in restart file - call pio_seterrorhandling(pioFile, PIO_BCAST_ERROR) + call pio_seterrorhandling(pioFile, PIO_BCAST_ERROR, oldmethod=err_handling) ioerr = pio_inq_dimid(pioFile,'max_chars', mcdimid) - call pio_seterrorhandling(pioFile, PIO_INTERNAL_ERROR) + call pio_seterrorhandling(pioFile, err_handling) ! but define it if nessasary if(ioerr/= PIO_NOERR) then ioerr = pio_def_dim(pioFile, 'max_chars', SHR_KIND_CL, mcdimid) @@ -2160,7 +2295,7 @@ subroutine init_trc_restart( whence, piofile, tr_file ) ioerr = pio_def_var(pioFile, name,pio_char, (/mcdimid/), tr_file%currfnameid) ioerr = pio_put_att(pioFile, tr_file%currfnameid, 'offset_time', tr_file%offset_time) maxlen = len_trim(tr_file%curr_filename) - ioerr = pio_put_att(pioFile, tr_file%currfnameid, 'actual_len', maxlen) + ioerr = pio_put_att(pioFile, tr_file%currfnameid, 'actual_len', maxlen) else nullify(tr_file%currfnameid) end if @@ -2212,8 +2347,9 @@ subroutine read_trc_restart( whence, piofile, tr_file ) character(len=64) :: name integer :: ioerr ! error status integer :: slen + integer :: err_handling - call PIO_SetErrorHandling(piofile, PIO_BCAST_ERROR) + call PIO_SetErrorHandling(piofile, PIO_BCAST_ERROR, oldmethod=err_handling) name = trim(whence)//'_curr_fname' ioerr = pio_inq_varid(piofile, name, vdesc) if(ioerr==PIO_NOERR) then @@ -2232,14 +2368,14 @@ subroutine read_trc_restart( whence, piofile, tr_file ) ioerr = pio_get_var(piofile, vdesc, tr_file%next_filename) if(slensrc_x(1)) ) then do sil = 1,nsrc - if ( (tl-src_x(sil))*(tl-src_x(sil+1)).le.0.0_r8 ) then + if ( (tl-src_x(sil))*(tl-src_x(sil+1))<=0.0_r8 ) then exit end if end do - if ( tl.lt.src_x(1) ) sil = 1 + if ( tlsrc_x(j+1) ) then y = y+(src_x(j+1)-bot)*src(j)/(src_x(j+1)-src_x(j)) bot = src_x(j+1) else @@ -2287,12 +2423,12 @@ subroutine interpz_conserve( nsrc, ntrg, src_x, trg_x, src, trg) end if end do - if ( trg_x(1).gt.src_x(1) ) then + if ( trg_x(1)>src_x(1) ) then top = trg_x(1) bot = src_x(1) y = 0.0_r8 do j = 1, nsrc - if ( top.gt.src_x(j+1) ) then + if ( top>src_x(j+1) ) then y = y+(src_x(j+1)-bot)*src(j)/(src_x(j+1)-src_x(j)) bot = src_x(j+1) else @@ -2307,16 +2443,17 @@ subroutine interpz_conserve( nsrc, ntrg, src_x, trg_x, src, trg) end subroutine interpz_conserve !------------------------------------------------------------------------------ - subroutine vert_interp_mixrat( ncol, nsrc, ntrg, trg_x, src, trg, p0, ps, hyai, hybi) - + subroutine vert_interp_mixrat( ncol, nsrc, ntrg, trg_x, src, trg, p0, ps, hyai, hybi, use_flight_distance) + implicit none - integer, intent(in) :: ncol + integer, intent(in) :: ncol integer, intent(in) :: nsrc ! dimension source array integer, intent(in) :: ntrg ! dimension target array real(r8) :: src_x(nsrc+1) ! source coordinates real(r8), intent(in) :: trg_x(pcols,ntrg+1) ! target coordinates real(r8), intent(in) :: src(pcols,nsrc) ! source array + logical, intent(in) :: use_flight_distance ! .true. = flight distance, .false. = mixing ratio real(r8), intent(out) :: trg(pcols,ntrg) ! target array real(r8) :: ps(pcols), p0, hyai(nsrc+1), hybi(nsrc+1) @@ -2327,72 +2464,90 @@ subroutine vert_interp_mixrat( ncol, nsrc, ntrg, trg_x, src, trg, p0, ps, hyai, integer :: sil real(r8) :: tl, y real(r8) :: bot, top - - - + + + do n = 1,ncol - - do i=1,nsrc+1 - src_x(i) = p0*hyai(i)+ps(n)*hybi(i) - enddo - do i = 1, ntrg - tl = trg_x(n,i+1) - if( (tl.gt.src_x(1)).and.(trg_x(n,i).lt.src_x(nsrc+1)) ) then - do sil = 1,nsrc - if( (tl-src_x(sil))*(tl-src_x(sil+1)).le.0.0_r8 ) then - exit - end if - end do + do i=1,nsrc+1 + src_x(i) = p0*hyai(i)+ps(n)*hybi(i) + enddo - if( tl.gt.src_x(nsrc+1)) sil = nsrc + do i = 1, ntrg + tl = trg_x(n,i+1) + if( (tl>src_x(1)).and.(trg_x(n,i)src_x(nsrc+1)) sil = nsrc + + y = 0.0_r8 + bot = min(tl,src_x(nsrc+1)) + top = trg_x(n,i) + do j = sil,1,-1 + if( top pin(i,levsiz)) then dataout(i,k) = datain(i,levsiz) else dpu = pmid(i,k) - pin(i,kupper(i)) @@ -2467,8 +2622,8 @@ subroutine vert_interp_ub( ncol, nlevs, plevs, datain, dataout ) use ref_pres, only : ptop_ref - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Interpolate data from current time-interpolated values to top interface pressure ! -- from mo_tgcm_ubc.F90 !-------------------------------------------------------------------------- @@ -2479,14 +2634,14 @@ subroutine vert_interp_ub( ncol, nlevs, plevs, datain, dataout ) integer, intent(in) :: nlevs real(r8), intent(in) :: plevs(nlevs) real(r8), intent(in) :: datain(ncol,nlevs) - real(r8), intent(out) :: dataout(ncol) + real(r8), intent(out) :: dataout(ncol) ! ! local variables ! integer :: i,ku,kl,kk real(r8) :: pinterp, delp - + pinterp = ptop_ref if( pinterp <= plevs(1) ) then @@ -2516,6 +2671,59 @@ subroutine vert_interp_ub( ncol, nlevs, plevs, datain, dataout ) end subroutine vert_interp_ub !------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + subroutine vert_interp_ub_var( ncol, nlevs, plevs, press, datain, dataout ) + + !----------------------------------------------------------------------- + ! + ! Interpolate data from current time-interpolated values to press + ! + !-------------------------------------------------------------------------- + ! Arguments + ! + integer, intent(in) :: ncol + integer, intent(in) :: nlevs + real(r8), intent(in) :: plevs(nlevs) + real(r8), intent(in) :: press(ncol) + real(r8), intent(in) :: datain(ncol,nlevs) + real(r8), intent(out) :: dataout(ncol) + + ! + ! local variables + ! + integer :: i,k + integer :: ku,kl + real(r8) :: delp + + + do i = 1,ncol + + if( press(i) <= plevs(1) ) then + kl = 1 + ku = 1 + delp = 0._r8 + else if( press(i) >= plevs(nlevs) ) then + kl = nlevs + ku = nlevs + delp = 0._r8 + else + + do k = 2,nlevs + if( press(i) <= plevs(k) ) then + ku = k + kl = k - 1 + delp = log( press(i)/plevs(k) ) / log( plevs(k-1)/plevs(k) ) + exit + end if + end do + + end if + + dataout(i) = datain(i,kl) + delp * (datain(i,ku) - datain(i,kl)) + end do + + end subroutine vert_interp_ub_var +!------------------------------------------------------------------------------ !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ @@ -2536,7 +2744,7 @@ subroutine advance_file(file) ! local variables !----------------------------------------------------------------------- character(len=shr_kind_cl) :: ctmp - character(len=shr_kind_cl) :: loc_fname + character(len=shr_kind_cl) :: loc_fname integer :: istat, astat !----------------------------------------------------------------------- @@ -2549,19 +2757,19 @@ subroutine advance_file(file) !----------------------------------------------------------------------- if( file%remove_trc_file ) then call getfil( file%curr_filename, loc_fname, 0 ) - write(iulog,*) 'advance_file: removing file = ',trim(loc_fname) - ctmp = 'rm -f ' // trim(loc_fname) + write(iulog,*) 'advance_file: removing file = ',trim(loc_fname) + ctmp = 'rm -f ' // trim(loc_fname) write(iulog,*) 'advance_file: fsystem issuing command - ' write(iulog,*) trim(ctmp) call shr_sys_system( ctmp, istat ) end if - + !----------------------------------------------------------------------- ! Advance the filename and file id !----------------------------------------------------------------------- file%curr_filename = file%next_filename file%curr_fileid = file%next_fileid - + !----------------------------------------------------------------------- ! Advance the curr_data_times !----------------------------------------------------------------------- @@ -2576,12 +2784,12 @@ subroutine advance_file(file) call endrun end if file%curr_data_times(:) = file%next_data_times(:) - + !----------------------------------------------------------------------- ! delete information about next file (as was just assigned to current) !----------------------------------------------------------------------- file%next_filename = '' - + deallocate( file%next_data_times, stat=astat ) if( astat/= 0 ) then write(iulog,*) 'advance_file: failed to deallocate file%next_data_times array; error = ',astat diff --git a/src/control/cam_budget.F90 b/src/control/cam_budget.F90 new file mode 100644 index 0000000000..016875ff63 --- /dev/null +++ b/src/control/cam_budget.F90 @@ -0,0 +1,398 @@ +module cam_budget + !---------------------------------------------------------------------------- + ! + ! Adds support for energy and mass snapshots and budgets using cam_history api. + ! + ! Public functions/subroutines: + ! + ! cam_budget_init + ! cam_budget_em_snapshot + ! cam_budget_em_register + ! cam_budget_get_global + ! cam_budget_readnl + ! budget_ind_byname + ! is_cam_budget + !----------------------------------------------------------------------- + + use cam_abortutils, only: endrun + use cam_history, only: addfld, add_default, horiz_only + use cam_history_support, only: max_fieldname_len + use cam_logfile, only: iulog + use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & + thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars,teidx,wvidx,wlidx,wiidx + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_kind_mod, only: cl => shr_kind_cl + use spmd_utils, only: masterproc, masterprocid, mpicom + + implicit none + private + save + + ! Public interfaces + public :: & + cam_budget_init, &! initialize budget variables + cam_budget_em_snapshot, &! define a snapshot and add to history buffer + cam_budget_em_register, &! define a budget and add to history buffer + cam_budget_get_global, &! get global budget from history buffer + cam_budget_readnl, &! read budget namelist setting + is_cam_budget ! return logical if budget_defined + + ! Private + real(r8) :: dstepsize + integer, parameter :: budget_array_max = 500 ! max number of budgets + character*3 :: budget_optype(budget_array_max) = '' ! allows 'dif' or 'sum' + character*3 :: budget_pkgtype(budget_array_max) = '' ! allows 'phy' or 'dyn' + + ! Public data + integer, public, protected :: budget_num = 0 ! current number of defined budgets. + character(cl), public, protected :: budget_name(budget_array_max) = '' ! budget names + character(cl), public, protected :: budget_longname(budget_array_max) = '' ! descriptive name of budget + character(cl), public, protected :: budget_stagename(budget_array_max)= '' ! shortname of both of the 3 char snapshot components + character(cl), public, protected :: budget_stg1name(budget_array_max) = '' ! The 1st of 2 snapshots used to calculate a budget + character(cl), public, protected :: budget_stg2name(budget_array_max) = '' ! The 2nd of 2 snapshots used to calculate a budget + + integer, public, protected :: thermo_budget_histfile_num = 1 ! The history tape number for budget fields + logical, public, protected :: thermo_budget_history = .false. ! Turn budgeting on or off + + + !============================================================================================== +CONTAINS + !============================================================================================== + ! + ! Read namelist variables. + subroutine cam_budget_readnl(nlfile) + use dycore, only: dycore_is + use namelist_utils, only: find_group_name + use spmd_utils, only: mpi_character, mpi_logical, mpi_integer, mpi_success + use shr_string_mod, only: shr_string_toUpper + use string_utils, only: int2str + + ! Dummy argument: filepath for file containing namelist input + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'cam_budget_readnl :: ' + + namelist /thermo_budget_nl/ thermo_budget_history, thermo_budget_histfile_num + !----------------------------------------------------------------------- + + if (masterproc) then + open(newunit=unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'thermo_budget_nl', status=ierr) + if (ierr == 0) then + read(unitn, thermo_budget_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname//'ERROR reading namelist, thermo_budget_nl, errcode = '//int2str(ierr)) + end if + end if + close(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(thermo_budget_history , 1 , mpi_logical , masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_history") + call mpi_bcast(thermo_budget_histfile_num , 1 , mpi_integer , masterprocid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_histfile_num") + + ! Write out thermo_budget options + if (masterproc) then + if (thermo_budget_history) then + if (dycore_is('FV') .or. dycore_is('FV3')) then + call endrun(subname//'ERROR thermodynamic budgets not implemented for this dycore') + else + write(iulog,*)'Thermo budgets will be written to the log file and diagnostics saved to history file:',& + thermo_budget_histfile_num + end if + end if + end if + end subroutine cam_budget_readnl + + !============================================================================================== + + subroutine cam_budget_init() + use time_manager, only: get_step_size + + dstepsize=get_step_size() + + end subroutine cam_budget_init + + !============================================================================================== + + subroutine cam_budget_em_snapshot (name, pkgtype, longname) + use dycore, only: dycore_is + use cam_grid_support, only: cam_grid_id + + character(len=*), intent(in) :: & + name ! budget name used as variable name in history file output (8 char max) + character(len=*), intent(in) :: & + pkgtype ! budget type either phy or dyn + character(len=*), intent(in) :: & + longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) + + character (cl) :: errmsg + character (len=max_fieldname_len) :: name_str + character (cl) :: desc_str, units_str + character (cl) :: gridname + integer :: ivars + character(len=*), parameter :: sub='cam_budget_em_snapshot' + logical :: use_cslam ! using cslam transport for mass tracers + !----------------------------------------------------------------------- + + if (thermo_budget_history) then + ! FVM grid is only registered when using cslam + use_cslam=cam_grid_id('FVM')>0 + + do ivars=1, thermo_budget_num_vars + write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) + write(desc_str,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + TRIM(ADJUSTL(longname)) + write(units_str,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + + if (budget_num < budget_array_max) then + budget_num = budget_num + 1 + else + write(errmsg, *) sub, ': Maximum number of budgets reached - increase budget_array_max parameter ' + call endrun(errmsg) + end if + ! set budget name and constants + budget_name(budget_num) = trim(name_str) + budget_longname(budget_num) = trim(desc_str) + + budget_pkgtype(budget_num)=pkgtype + budget_stagename(budget_num)= trim(name) + + if (pkgtype=='phy') then + gridname='physgrid' + else + if (dycore_is('SE')) then + if (use_cslam .and. thermo_budget_vars_massv(ivars)) then + gridname='FVM' + else + gridname='GLL' + end if + else if (dycore_is('MPAS')) then + gridname='mpas_cell' + else + write(errmsg, *) sub, ': budget_add is only supported for MPAS and SE dycores' + call endrun(errmsg) + end if + end if + call addfld (TRIM(ADJUSTL(name_str)), horiz_only, 'N', TRIM(ADJUSTL(units_str)), & + TRIM(ADJUSTL(desc_str)), gridname=trim(gridname)) + call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') + end do + end if + end subroutine cam_budget_em_snapshot + + !============================================================================== + + subroutine cam_budget_em_register (name, stg1name, stg2name, pkgtype, optype, longname) + use dycore, only: dycore_is + use cam_grid_support, only: cam_grid_id + + ! Register a budget. + + character(len=*), intent(in) :: & + name,stg1name,stg2name ! budget name used as variable name in history file output (8 char max) + + character(len=*), intent(in) :: & + pkgtype ! budget type either phy or dyn + + character(len=*), intent(in) :: & + optype ! dif (difference) or sum + + character(len=*), intent(in) :: & + longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) + + character(len=*), parameter :: sub='cam_budget_em_register' + character(cl) :: errmsg + character(len=1) :: opchar + character (len=max_fieldname_len) :: name_str + character (cl) :: desc_str, units_str + character (cl) :: gridname + character (cl) :: strstg1, strstg2 + integer :: ivars + logical :: use_cslam ! true => use cslam to transport mass variables + !----------------------------------------------------------------------- + + if (thermo_budget_history) then + ! the FVM gridname is only defined when use_cslam is true. + use_cslam=cam_grid_id('FVM')>0 + + ! register history budget variables + do ivars=1, thermo_budget_num_vars + write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) + write(strstg1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg1name)) + write(strstg2,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg2name)) + write(desc_str,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + TRIM(ADJUSTL(longname)) + write(units_str,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + + if (budget_num < budget_array_max) then + budget_num = budget_num + 1 + else + write(errmsg, *) sub, ': Maximum number of budgets reached - increase budget_array_max parameter ' + call endrun(errmsg) + end if + budget_pkgtype(budget_num)=pkgtype + + ! set budget name and constants + budget_name(budget_num) = trim(name_str) + budget_longname(budget_num) = trim(desc_str) + + if (optype=='dif') then + opchar='-' + else if (optype=='sum') then + opchar='+' + else + write(errmsg,*) sub, ': FATAL: unknown operation type, expecting "sum" or "dif":', optype + call endrun(errmsg) + end if + budget_stg1name(budget_num) = trim(adjustl(strstg1)) + budget_stg2name(budget_num) = trim(adjustl(strstg2)) + budget_stagename(budget_num)= trim(adjustl(strstg1))//trim(opchar)//trim(adjustl(strstg2)) + budget_optype(budget_num)=optype + + if (pkgtype=='phy') then + gridname='physgrid' + else + if (dycore_is('SE')) then + if (use_cslam .and. thermo_budget_vars_massv(ivars)) then + gridname='FVM' + else + gridname='GLL' + end if + else if (dycore_is('MPAS')) then + gridname='mpas_cell' + else + write(errmsg, *) sub, ': budget_add is only supported for MPAS and SE dycores' + call endrun(errmsg) + end if + end if + call addfld (TRIM(ADJUSTL(name_str)), horiz_only, 'N', TRIM(ADJUSTL(units_str)),TRIM(ADJUSTL(desc_str)), & + gridname=gridname,optype=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') + end do + end if + end subroutine cam_budget_em_register + + !============================================================================== + + subroutine cam_budget_get_global (name, me_idx, global) + + use cam_history, only: get_field_properties + use cam_history_support, only: active_entry,ptapes + use cam_thermo, only: thermo_budget_vars_massv + + ! Get the global integral of a budget. Endrun will be called + ! when name is not found. + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + integer, intent(in) :: me_idx ! mass energy variable index + real(r8), intent(out) :: global ! global integral of the budget field + + !---------------------------Local workspace----------------------------- + type (active_entry), pointer :: tape(:) ! history tapes + character (len=max_fieldname_len) :: name_str + character(cl) :: errmsg + integer :: b_ind ! budget index + integer :: h_ind(ptapes) ! hentry index + integer :: m_ind ! masterlist index + integer :: idx,pidx,midx,uidx ! substring index for sum dif char + integer :: m ! budget index + logical :: found ! true if global integral found + + character(len=*), parameter :: sub='cam_budget_get_global' + !----------------------------------------------------------------------- + ! Initialize tape pointer here to avoid initialization only on first invocation + nullify(tape) + + name_str='' + write(name_str,*) TRIM(ADJUSTL(name)) + + midx=index(name_str, '-') + pidx=index(name_str, '+') + idx=midx+pidx + + ! check for budget using stagename short format (stg1//op//stg2) where stg1 is name without thermo string appended + if (idx /= 0 .and. (midx==0 .or. pidx==0)) then + write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(name_str(1:idx)))// & + TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//TRIM(ADJUSTL(name_str(idx+1:))) + end if + + uidx=index(name_str, '_') + if (uidx == 0) then + !This is a stage name need to append the type of thermo variable using input index + write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(name_str(1:))) + end if + + b_ind=budget_ind_byname(trim(adjustl(name_str))) + + if (b_ind < 0) call endrun(sub//': FATAL field name '//name//' not found'//' looked for '//trim(adjustl(name_str))) + + write(name_str,*) TRIM(ADJUSTL(budget_name(b_ind))) + + ! Find budget name in list and return global value + call get_field_properties(trim(adjustl(name_str)), found, tape_out=tape, ff_out=m_ind, f_out=h_ind) + + if (found.and.h_ind(thermo_budget_histfile_num)>0) then + call tape(thermo_budget_histfile_num)%hlist(h_ind(thermo_budget_histfile_num))%get_global(global) + if (.not. thermo_budget_vars_massv(me_idx)) & + global=global/dstepsize + else + write(errmsg,*) sub, ': FATAL: name not found: ', trim(name) + call endrun(errmsg) + end if + + CONTAINS + pure function budget_ind_byname (name) + ! + ! Get the index of a budget. Ret -1 for not found + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + + !---------------------------Local workspace----------------------------- + integer :: budget_ind_byname ! function return + integer :: m ! budget index + !----------------------------------------------------------------------- + ! Find budget name in list + budget_ind_byname = -1 + do m = 1, budget_num + if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or. & + trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then + budget_ind_byname = m + return + end if + end do + end function budget_ind_byname + end subroutine cam_budget_get_global + !============================================================================== + + pure function is_cam_budget(name) + + ! Get the index of a budget. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + + !---------------------------Local workspace----------------------------- + logical :: is_cam_budget ! function return + integer :: m ! budget index + !----------------------------------------------------------------------- + + ! Find budget name in list of defined budgets + + is_cam_budget = .false. + do m = 1, budget_num + if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or. & + trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then + is_cam_budget = .true. + return + end if + end do + end function is_cam_budget + + !=========================================================================== + +end module cam_budget diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index 5adf0d5c62..a040762067 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -5,7 +5,7 @@ module cam_comp ! ! This interface layer is CAM specific, i.e., it deals entirely with CAM ! specific data structures. It is the layer above this, either atm_comp_mct -! or atm_comp_esmf, which translates between CAM and either MCT or ESMF +! or atm_comp_nuopc, which translates between CAM and either MCT or NUOPC ! data structures in order to interface with the driver/coupler. ! !----------------------------------------------------------------------- @@ -16,9 +16,7 @@ module cam_comp use spmd_utils, only: masterproc, mpicom use cam_control_mod, only: cam_ctrl_init, cam_ctrl_set_orbit use runtime_opts, only: read_namelist -use time_manager, only: timemgr_init, get_step_size, & - get_nstep, is_first_step, is_first_restart_step - +use time_manager, only: timemgr_init, get_nstep use camsrfexch, only: cam_out_t, cam_in_t use ppgrid, only: begchunk, endchunk use physics_types, only: physics_state, physics_tend @@ -72,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 @@ -83,16 +80,13 @@ 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, only: cam_snapshot_deactivate - use physconst, only: composition_init -#if (defined BFB_CAM_SCAM_IOP) - use history_defaults, only: initialize_iop_history -#endif - + use cam_snapshot_common, only: cam_snapshot_deactivate + use air_composition, only: air_composition_init + use phys_grid_ctem, only: phys_grid_ctem_reg ! Arguments character(len=cl), intent(in) :: caseid ! case ID @@ -169,6 +163,9 @@ subroutine cam_init( & ! Initialize physics grid decomposition call phys_grid_init() + ! Register zonal average grid for phys TEM diagnostics + call phys_grid_ctem_reg() + ! Register advected tracers and physics buffer fields call phys_register () @@ -176,7 +173,7 @@ subroutine cam_init( & ! are set in dyn_init call chem_surfvals_init() - call composition_init() + call air_composition_init() ! initialize ionosphere call ionosphere_init() @@ -192,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) @@ -308,13 +302,9 @@ subroutine cam_run2( cam_out, cam_in ) ! Ion transport ! call t_startf('ionosphere_run2') - call ionosphere_run2( phys_state, dyn_in, pbuf2d ) + call ionosphere_run2( phys_state, pbuf2d ) call t_stopf ('ionosphere_run2') - if (is_first_step() .or. is_first_restart_step()) then - call t_startf ('cam_run2_memusage') - call t_stopf ('cam_run2_memusage') - end if end subroutine cam_run2 ! @@ -346,10 +336,6 @@ subroutine cam_run3( cam_out ) call t_stopf ('stepon_run3') - if (is_first_step() .or. is_first_restart_step()) then - call t_startf ('cam_run3_memusage') - call t_stopf ('cam_run3_memusage') - end if end subroutine cam_run3 ! @@ -366,7 +352,8 @@ subroutine cam_run4( cam_out, cam_in, rstwr, nlend, & ! file output. ! !----------------------------------------------------------------------- - use cam_history, only: wshist, wrapup + use dycore_budget, only: print_budget + use cam_history, only: wshist, wrapup, hstwr use cam_restart, only: cam_write_restart use qneg_module, only: qneg_print_summary use time_manager, only: is_last_step @@ -409,6 +396,8 @@ subroutine cam_run4( cam_out, cam_in, rstwr, nlend, & call qneg_print_summary(is_last_step()) + call print_budget(hstwr) + call shr_sys_flush(iulog) end subroutine cam_run4 @@ -423,12 +412,12 @@ subroutine cam_final( cam_out, cam_in ) ! Purpose: CAM finalization. ! !----------------------------------------------------------------------- - use stepon, only: stepon_final - use physpkg, only: phys_final - use cam_initfiles, only: cam_initfiles_close - use camsrfexch, only: atm2hub_deallocate, hub2atm_deallocate + use stepon, only: stepon_final + use physpkg, only: phys_final + use cam_initfiles, only: cam_initfiles_close + use camsrfexch, only: atm2hub_deallocate, hub2atm_deallocate use ionosphere_interface, only: ionosphere_final - use cam_control_mod, only: initial_run + use cam_control_mod, only: initial_run ! ! Arguments diff --git a/src/control/cam_control_mod.F90 b/src/control/cam_control_mod.F90 index 06347487f8..02789f4537 100644 --- a/src/control/cam_control_mod.F90 +++ b/src/control/cam_control_mod.F90 @@ -33,8 +33,9 @@ module cam_control_mod logical, protected :: ideal_phys ! true => run Held-Suarez (1994) physics logical, protected :: kessler_phys ! true => run Kessler physics logical, protected :: tj2016_phys ! true => run tj2016 physics +logical, protected :: frierson_phys ! true => run frierson physics logical, protected :: simple_phys ! true => adiabatic or ideal_phys or kessler_phys - ! or tj2016 + ! or tj2016 or frierson logical, protected :: aqua_planet ! Flag to run model in "aqua planet" mode logical, protected :: moist_physics ! true => moist physics enabled, i.e., ! (.not. ideal_phys) .and. (.not. adiabatic) @@ -68,10 +69,7 @@ subroutine cam_ctrl_init( & logical, intent(in) :: brnch_retain_casename_in ! Flag to allow a branch to use the same ! caseid as the run being branched from. - integer :: unitn, ierr - character(len=*), parameter :: sub='cam_ctrl_init' - character(len=128) :: errmsg !--------------------------------------------------------------------------------------------- caseid = caseid_in @@ -138,8 +136,9 @@ subroutine cam_ctrl_set_physics_type(phys_package) ideal_phys = trim(phys_package) == 'held_suarez' kessler_phys = trim(phys_package) == 'kessler' tj2016_phys = trim(phys_package) == 'tj2016' + frierson_phys = trim(phys_package) == 'grayrad' - simple_phys = adiabatic .or. ideal_phys .or. kessler_phys .or. tj2016_phys + simple_phys = adiabatic .or. ideal_phys .or. kessler_phys .or. tj2016_phys .or. frierson_phys moist_physics = .not. (adiabatic .or. ideal_phys) @@ -150,13 +149,15 @@ subroutine cam_ctrl_set_physics_type(phys_package) if (masterproc) then if (adiabatic) then write(iulog,*) 'Run model ADIABATICALLY (i.e. no physics)' - write(iulog,*) ' Global energy fixer is on for non-Eulerian dycores.' + write(iulog,*) ' Global energy fixer is on.' else if (ideal_phys) then write(iulog,*) 'Run model with Held-Suarez physics forcing' else if (kessler_phys) then write(iulog,*) 'Run model with Kessler warm-rain physics forcing' else if (tj2016_phys) then write(iulog,*) 'Run model with Thatcher-Jablonowski (2016) physics forcing (moist Held-Suarez)' + else if (frierson_phys) then + write(iulog,*) 'Run model with Frierson (2006) physics' end if end if diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index dc38e3f2e2..81659ec12a 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -38,7 +38,8 @@ module cam_history pio_int, pio_real, pio_double, pio_char, & pio_offset_kind, pio_unlimited, pio_global, & pio_inq_dimlen, pio_def_var, pio_enddef, & - pio_put_att, pio_put_var, pio_get_att + pio_put_att, pio_put_var, pio_get_att, & + pio_file_is_open use perf_mod, only: t_startf, t_stopf @@ -49,7 +50,8 @@ module cam_history field_info, active_entry, hentry, & horiz_only, write_hist_coord_attrs, & write_hist_coord_vars, interp_info_t, & - lookup_hist_coord_indices, get_hist_coord_index + lookup_hist_coord_indices, get_hist_coord_index, & + field_op_len use string_utils, only: date2yyyymmdd, sec2hms use sat_hist, only: is_satfile use solar_parms_data, only: solar_parms_on, kp=>solar_parms_kp, ap=>solar_parms_ap @@ -57,6 +59,7 @@ module cam_history use solar_wind_data, only: solar_wind_on, byimf=>solar_wind_byimf, bzimf=>solar_wind_bzimf use solar_wind_data, only: swvel=>solar_wind_swvel, swden=>solar_wind_swden use epotential_params, only: epot_active, epot_crit_colats + use cam_grid_support, only: maxsplitfiles implicit none private @@ -68,19 +71,28 @@ module cam_history public :: cam_history_snapshot_deactivate public :: cam_history_snapshot_activate + type grid_area_entry + integer :: decomp_type = -1 ! type of decomposition (e.g., physics or dynamics) + real(r8), allocatable :: wbuf(:,:) ! for area weights + end type grid_area_entry + type (grid_area_entry), target, allocatable:: grid_wts(:) ! area wts for each decomp type + type (grid_area_entry), pointer :: allgrids_wt(:) => null() ! area wts for each decomp type ! ! master_entry: elements of an entry in the master field list ! type master_entry - type (field_info) :: field ! field information + type (field_info) :: field ! field information character(len=max_fieldname_len) :: meridional_field = '' ! for vector fields character(len=max_fieldname_len) :: zonal_field = '' ! for vector fields - character(len=1) :: avgflag(ptapes) ! averaging flag - character(len=max_chars) :: time_op(ptapes) ! time operator (e.g. max, min, avg) - logical :: act_sometape ! Field is active on some tape - logical :: actflag(ptapes) ! Per tape active/inactive flag - integer :: htapeindx(ptapes)! This field's index on particular history tape - type(master_entry), pointer :: next_entry => null() ! The next master entry + character(len=1) :: avgflag(ptapes) ! averaging flag + character(len=max_chars) :: time_op(ptapes) ! time operator (e.g. max, min, avg) + character(len=field_op_len) :: field_op = '' ! field derived from sum or dif of field1 and field2 + character(len=max_fieldname_len) :: op_field1 = '' ! first field name to be operated on + character(len=max_fieldname_len) :: op_field2 = '' ! second field name to be operated on + logical :: act_sometape ! Field is active on some tape + logical :: actflag(ptapes) ! Per tape active/inactive flag + integer :: htapeindx(ptapes)! This field's index on particular history tape + type(master_entry), pointer :: next_entry => null() ! The next master entry end type master_entry type (master_entry), pointer :: masterlinkedlist => null() ! master field linkedlist top @@ -97,22 +109,26 @@ module cam_history type (active_entry), target, allocatable :: restarthistory_tape(:) ! restart history tapes type rvar_id - type(var_desc_t), pointer :: vdesc => null() - integer :: type - integer :: ndims - integer :: dims(4) + type(var_desc_t), pointer :: vdesc => null() + integer :: type + integer :: ndims + integer :: dims(4) character(len=fieldname_lenp2) :: name + logical :: fillset = .false. + integer :: ifill + real(r4) :: rfill + real(r8) :: dfill end type rvar_id type rdim_id - integer :: len - integer :: dimid + integer :: len + integer :: dimid character(len=fieldname_lenp2) :: name end type rdim_id ! ! The size of these parameters should match the assignments in restart_vars_setnames and restart_dims_setnames below ! - integer, parameter :: restartvarcnt = 38 - integer, parameter :: restartdimcnt = 10 + integer, parameter :: restartvarcnt = 45 + integer, parameter :: restartdimcnt = 11 type(rvar_id) :: restartvars(restartvarcnt) type(rdim_id) :: restartdims(restartdimcnt) integer, parameter :: ptapes_dim_ind = 1 @@ -125,6 +141,15 @@ module cam_history integer, parameter :: maxvarmdims_dim_ind = 8 integer, parameter :: registeredmdims_dim_ind = 9 integer, parameter :: max_hcoordname_len_dim_ind = 10 + integer, parameter :: max_num_split_files = 11 + + ! Indices for split history files; must be 1 and 2 + integer, parameter :: instantaneous_file_index = 1 + integer, parameter :: accumulated_file_index = 2 + ! Indices for non-split history files; must be 1 or 2 + integer, parameter :: sat_file_index = 1 + integer, parameter :: restart_file_index = 1 + integer, parameter :: init_file_index = 1 integer :: nfmaster = 0 ! number of fields in master field list integer :: nflds(ptapes) ! number of fields per tape @@ -142,6 +167,7 @@ module cam_history logical :: rgnht(ptapes) = .false. ! flag array indicating regeneration volumes logical :: hstwr(ptapes) = .false. ! Flag for history writes logical :: empty_htapes = .false. ! Namelist flag indicates no default history fields + logical :: write_nstep0 = .false. ! write nstep==0 time sample to history files (except monthly) logical :: htapes_defined = .false. ! flag indicates history contents have been defined character(len=cl) :: model_doi_url = '' ! Model DOI @@ -149,13 +175,14 @@ module cam_history character(len=*), parameter :: history_namelist = 'cam_history_nl' character(len=max_string_len) :: hrestpath(ptapes) = (/(' ',idx=1,ptapes)/) ! Full history restart pathnames character(len=max_string_len) :: nfpath(ptapes) = (/(' ',idx=1,ptapes)/) ! Array of first pathnames, for header - character(len=max_string_len) :: cpath(ptapes) ! Array of current pathnames - character(len=max_string_len) :: nhfil(ptapes) ! Array of current file names + character(len=max_string_len) :: cpath(ptapes,maxsplitfiles) ! Array of current pathnames + character(len=max_string_len) :: nhfil(ptapes,maxsplitfiles) ! Array of current file names character(len=1) :: avgflag_pertape(ptapes) = (/(' ',idx=1,ptapes)/) ! per tape averaging flag character(len=16) :: logname ! user name 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 @@ -173,8 +200,7 @@ module cam_history ! Allowed history averaging flags ! This should match namelist_definition.xml => avgflag_pertape (+ ' ') - ! The presence of 'ABI' and 'XML' in this string is a coincidence - character(len=7), parameter :: HIST_AVG_FLAGS = ' ABIXML' + character(len=9), parameter :: HIST_AVG_FLAGS = ' ABILMNSX' character(len=22) ,parameter :: LT_DESC = 'mean (over local time)' ! local time description logical :: collect_column_output(ptapes) @@ -219,7 +245,8 @@ module cam_history ! Do *not* modify the parameters below. ! integer, parameter :: tbl_hash_pri_sz = 2**tbl_hash_pri_sz_lg2 - integer, parameter :: tbl_hash_oflow_sz = tbl_hash_pri_sz * (tbl_hash_oflow_percent/100.0_r8) + integer, parameter :: tbl_hash_oflow_sz = int(tbl_hash_pri_sz * & + (tbl_hash_oflow_percent / 100.0_r8)) ! ! The primary and overflow tables are organized to mimimize space (read: ! try to maximimze cache line usage). @@ -282,6 +309,9 @@ module cam_history ! character(len=max_string_len) :: rhfilename_spec = '%c.cam.rh%t.%y-%m-%d-%s.nc' ! history restart character(len=max_string_len) :: hfilename_spec(ptapes) = (/ (' ', idx=1, ptapes) /) ! filename specifyer + logical :: default_monthly_filename(ptapes) = .false. + ! Flag for if there are accumulated fields specified for a given tape + logical :: hfile_accum(ptapes) = .false. interface addfld @@ -289,8 +319,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) @@ -344,6 +375,8 @@ subroutine intht (model_doi_url_in) use cam_control_mod, only: restart_run, branch_run use sat_hist, only: sat_hist_init use spmd_utils, only: mpicom, masterprocid, mpi_character + use cam_grid_support, only: cam_grid_get_areawt + use cam_history_support, only: dim_index_2d ! !----------------------------------------------------------------------- ! @@ -353,7 +386,7 @@ subroutine intht (model_doi_url_in) ! ! Local workspace ! - integer :: t, f ! tape, field indices + integer :: t, fld ! tape, field indices integer :: begdim1 ! on-node dim1 start index integer :: enddim1 ! on-node dim1 end index integer :: begdim2 ! on-node dim2 start index @@ -362,8 +395,13 @@ subroutine intht (model_doi_url_in) integer :: enddim3 ! on-node chunk or lat end index integer :: day, sec ! day and seconds from base date integer :: rcode ! shr_sys_getenv return code + integer :: wtidx(1) ! area weight index + integer :: i,k,c,ib,ie,jb,je,count ! index + integer :: fdecomp ! field decomp + type(dim_index_2d) :: dimind ! 2-D dimension index + real(r8), pointer :: areawt(:) ! pointer to areawt values for attribute type(master_entry), pointer :: listentry - character(len=32) :: fldname ! temp variable used to produce a left justified field name + character(len=32) :: fldname ! temp variable used to produce a left justified field name ! in the formatted logfile output ! @@ -380,18 +418,18 @@ subroutine intht (model_doi_url_in) write(iulog,*)' ******* MASTER FIELD LIST *******' end if listentry=>masterlinkedlist - f=0 + fld=0 do while(associated(listentry)) - f=f+1 + fld=fld+1 if(masterproc) then fldname = listentry%field%name - write(iulog,9000) f, fldname, listentry%field%units, listentry%field%numlev, & + write(iulog,9000) fld, fldname, listentry%field%units, listentry%field%numlev, & listentry%avgflag(1), trim(listentry%field%long_name) 9000 format(i5, 1x, a32, 1x, a16, 1x, i4, 1x, a1, 2x, a) end if listentry=>listentry%next_entry end do - nfmaster = f + nfmaster = fld if(masterproc) write(iulog,*)'intht:nfmaster=',nfmaster ! @@ -448,27 +486,67 @@ subroutine intht (model_doi_url_in) ! Initialize history variables ! do t=1,ptapes - do f=1,nflds(t) - begdim1 = tape(t)%hlist(f)%field%begdim1 - enddim1 = tape(t)%hlist(f)%field%enddim1 - begdim2 = tape(t)%hlist(f)%field%begdim2 - enddim2 = tape(t)%hlist(f)%field%enddim2 - begdim3 = tape(t)%hlist(f)%field%begdim3 - enddim3 = tape(t)%hlist(f)%field%enddim3 - allocate(tape(t)%hlist(f)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) - tape(t)%hlist(f)%hbuf = 0._r8 - if (tape(t)%hlist(f)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev - allocate(tape(t)%hlist(f)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) - tape(t)%hlist(f)%sbuf = 0._r8 + do fld=1,nflds(t) + if ((.not. tape(t)%hlist(fld)%field%sampled_on_subcycle) .and. nhtfrq(t) == 1) then + ! Override accumulate flag to "I" if nhtfrq equals 1 and subcycle + ! averaging is not enabled + tape(t)%hlist(fld)%avgflag = 'I' + end if + + if (tape(t)%hlist(fld)%avgflag .ne. 'I') then + hfile_accum(t) = .true. + end if + begdim1 = tape(t)%hlist(fld)%field%begdim1 + enddim1 = tape(t)%hlist(fld)%field%enddim1 + begdim2 = tape(t)%hlist(fld)%field%begdim2 + enddim2 = tape(t)%hlist(fld)%field%enddim2 + begdim3 = tape(t)%hlist(fld)%field%begdim3 + enddim3 = tape(t)%hlist(fld)%field%enddim3 + allocate(tape(t)%hlist(fld)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + tape(t)%hlist(fld)%hbuf = 0._r8 + if (tape(t)%hlist(fld)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev + allocate(tape(t)%hlist(fld)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + tape(t)%hlist(fld)%sbuf = 0._r8 + endif + if (tape(t)%hlist(fld)%avgflag .eq. 'N') then ! set up areawt weight buffer + fdecomp = tape(t)%hlist(fld)%field%decomp_type + if (any(allgrids_wt(:)%decomp_type == fdecomp)) then + wtidx=MAXLOC(allgrids_wt(:)%decomp_type, MASK = allgrids_wt(:)%decomp_type .EQ. fdecomp) + tape(t)%hlist(fld)%wbuf => allgrids_wt(wtidx(1))%wbuf + else + ! area weights not found for this grid, then create them + ! first check for an available spot in the array + if (any(allgrids_wt(:)%decomp_type == -1)) then + wtidx=MINLOC(allgrids_wt(:)%decomp_type) + else + call endrun('cam_history:intht: Error initializing allgrids_wt with area weights') + end if + allgrids_wt(wtidx)%decomp_type=fdecomp + areawt => cam_grid_get_areawt(fdecomp) + allocate(allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim3:enddim3)) + allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim3:enddim3)=0._r8 + count=0 + do c=begdim3,enddim3 + dimind = tape(t)%hlist(fld)%field%get_dims(c) + ib=dimind%beg1 + ie=dimind%end1 + do i=ib,ie + count=count+1 + allgrids_wt(wtidx(1))%wbuf(i,c)=areawt(count) + end do + end do + tape(t)%hlist(fld)%wbuf => allgrids_wt(wtidx(1))%wbuf + endif endif - if(tape(t)%hlist(f)%field%flag_xyfill .or. (avgflag_pertape(t) .eq. 'L')) then - allocate (tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) + if(tape(t)%hlist(fld)%field%flag_xyfill .or. (avgflag_pertape(t) .eq. 'L')) then + allocate (tape(t)%hlist(fld)%nacs(begdim1:enddim1,begdim3:enddim3)) else - allocate (tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) + allocate (tape(t)%hlist(fld)%nacs(1,begdim3:enddim3)) end if - tape(t)%hlist(f)%nacs(:,:) = 0 - tape(t)%hlist(f)%field%meridional_complement = -1 - tape(t)%hlist(f)%field%zonal_complement = -1 + tape(t)%hlist(fld)%nacs(:,:) = 0 + tape(t)%hlist(fld)%beg_nstep = 0 + tape(t)%hlist(fld)%field%meridional_complement = -1 + tape(t)%hlist(fld)%field%zonal_complement = -1 end do end do ! Setup vector pairs for unstructured grid interpolation @@ -501,6 +579,7 @@ subroutine history_readnl(nlfile) integer :: dtime ! Step time in seconds integer :: unitn, ierr, f, t character(len=8) :: ctemp ! Temporary character string + integer :: filename_len character(len=fieldname_lenp2) :: fincl1(pflds) character(len=fieldname_lenp2) :: fincl2(pflds) @@ -553,7 +632,7 @@ subroutine history_readnl(nlfile) ! History namelist items namelist /cam_history_nl/ ndens, nhtfrq, mfilt, inithist, inithist_all, & - avgflag_pertape, empty_htapes, lcltod_start, lcltod_stop, & + avgflag_pertape, empty_htapes, write_nstep0, lcltod_start, lcltod_stop,& fincl1lonlat, fincl2lonlat, fincl3lonlat, fincl4lonlat, fincl5lonlat, & fincl6lonlat, fincl7lonlat, fincl8lonlat, fincl9lonlat, & fincl10lonlat, collect_column_output, hfilename_spec, & @@ -716,6 +795,13 @@ subroutine history_readnl(nlfile) nhtfrq(t) = nint((-nhtfrq(t) * 3600._r8) / dtime) end if end do + ! If nhtfrq == 1, then the output is instantaneous. Enforce this by setting + ! the per-file averaging flag. + do t = 1, ptapes + if (nhtfrq(t) == 1) then + avgflag_pertape(t) = 'I' + end if + end do ! ! Initialize the filename specifier if not already set ! This is the format for the history filenames: @@ -726,10 +812,16 @@ subroutine history_readnl(nlfile) if ( len_trim(hfilename_spec(t)) == 0 )then if ( nhtfrq(t) == 0 )then ! Monthly files - hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.h%t.%y-%m.nc' + hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.h%t%f.%y-%m.nc' + default_monthly_filename(t) = .true. else - hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.h%t.%y-%m-%d-%s.nc' + hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.h%t%f.%y-%m-%d-%s.nc' end if + else + ! Append file type - instantaneous or accumulated - to filename + ! specifier provided (in front of the .nc extension). + filename_len = len_trim(hfilename_spec(t)) + hfilename_spec(t) = hfilename_spec(t)(:filename_len-3) // '%f.nc' end if ! ! Only one time sample allowed per monthly average file @@ -740,8 +832,14 @@ subroutine history_readnl(nlfile) end do end if ! masterproc - ! Print per-tape averaging flags + ! log output if (masterproc) then + + if (write_nstep0) then + write(iulog,*)'nstep==0 time sample will be written to all files except monthly average.' + end if + + ! Print per-tape averaging flags do t = 1, ptapes if (avgflag_pertape(t) /= ' ') then write(iulog,*)'Unless overridden by namelist input on a per-field basis (FINCL),' @@ -760,25 +858,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 @@ -800,8 +879,10 @@ subroutine history_readnl(nlfile) call mpi_bcast(lcltod_stop, ptapes, mpi_integer, masterprocid, mpicom, ierr) call mpi_bcast(collect_column_output, ptapes, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(empty_htapes,1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(write_nstep0,1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(avgflag_pertape, ptapes, mpi_character, masterprocid, mpicom, ierr) call mpi_bcast(hfilename_spec, len(hfilename_spec(1))*ptapes, mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(default_monthly_filename, ptapes, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(fincl, len(fincl (1,1))*pflds*ptapes, mpi_character, masterprocid, mpicom, ierr) call mpi_bcast(fexcl, len(fexcl (1,1))*pflds*ptapes, mpi_character, masterprocid, mpicom, ierr) @@ -823,6 +904,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) @@ -883,7 +985,7 @@ subroutine setup_interpolation_and_define_vector_complements() use interp_mod, only: setup_history_interpolation ! Local variables - integer :: hf, f, ff + integer :: hf, fld, ffld logical :: interp_ok character(len=max_fieldname_len) :: mname character(len=max_fieldname_len) :: zname @@ -895,31 +997,31 @@ subroutine setup_interpolation_and_define_vector_complements() interpolate_output, interpolate_info) do hf = 1, ptapes - 2 if((.not. is_satfile(hf)) .and. (.not. is_initfile(hf))) then - do f = 1, nflds(hf) - if (field_part_of_vector(trim(tape(hf)%hlist(f)%field%name), & + do fld = 1, nflds(hf) + if (field_part_of_vector(trim(tape(hf)%hlist(fld)%field%name), & mname, zname)) then if (len_trim(mname) > 0) then ! This field is a zonal part of a set, find the meridional partner - do ff = 1, nflds(hf) - if (trim(mname) == trim(tape(hf)%hlist(ff)%field%name)) then - tape(hf)%hlist(f)%field%meridional_complement = ff - tape(hf)%hlist(ff)%field%zonal_complement = f + do ffld = 1, nflds(hf) + if (trim(mname) == trim(tape(hf)%hlist(ffld)%field%name)) then + tape(hf)%hlist(fld)%field%meridional_complement = ffld + tape(hf)%hlist(ffld)%field%zonal_complement = fld exit end if - if (ff == nflds(hf)) then - call endrun(trim(subname)//': No meridional match for '//trim(tape(hf)%hlist(f)%field%name)) + if (ffld == nflds(hf)) then + call endrun(trim(subname)//': No meridional match for '//trim(tape(hf)%hlist(fld)%field%name)) end if end do else if (len_trim(zname) > 0) then ! This field is a meridional part of a set, find the zonal partner - do ff = 1, nflds(hf) - if (trim(zname) == trim(tape(hf)%hlist(ff)%field%name)) then - tape(hf)%hlist(f)%field%zonal_complement = ff - tape(hf)%hlist(ff)%field%meridional_complement = f + do ffld = 1, nflds(hf) + if (trim(zname) == trim(tape(hf)%hlist(ffld)%field%name)) then + tape(hf)%hlist(fld)%field%zonal_complement = ffld + tape(hf)%hlist(ffld)%field%meridional_complement = fld exit end if - if (ff == nflds(hf)) then - call endrun(trim(subname)//': No zonal match for '//trim(tape(hf)%hlist(f)%field%name)) + if (ffld == nflds(hf)) then + call endrun(trim(subname)//': No zonal match for '//trim(tape(hf)%hlist(fld)%field%name)) end if end do else @@ -932,6 +1034,47 @@ subroutine setup_interpolation_and_define_vector_complements() end if end subroutine setup_interpolation_and_define_vector_complements + subroutine define_composed_field_ids(t) + + ! Dummy arguments + integer, intent(in) :: t ! Current tape + + ! Local variables + integer :: fld, ffld + character(len=max_fieldname_len) :: field1 + character(len=max_fieldname_len) :: field2 + character(len=*), parameter :: subname='define_composed_field_ids' + logical :: is_composed + + do fld = 1, nflds(t) + call composed_field_info(tape(t)%hlist(fld)%field%name,is_composed,fname1=field1,fname2=field2) + if (is_composed) then + if (len_trim(field1) > 0 .and. len_trim(field2) > 0) then + ! set field1/field2 names for htape from the masterfield list + tape(t)%hlist(fld)%op_field1=trim(field1) + tape(t)%hlist(fld)%op_field2=trim(field2) + ! find ids for field1/2 + do ffld = 1, nflds(t) + if (trim(field1) == trim(tape(t)%hlist(ffld)%field%name)) then + tape(t)%hlist(fld)%field%op_field1_id = ffld + end if + if (trim(field2) == trim(tape(t)%hlist(ffld)%field%name)) then + tape(t)%hlist(fld)%field%op_field2_id = ffld + end if + end do + if (tape(t)%hlist(fld)%field%op_field1_id == -1) then + call endrun(trim(subname)//': No op_field1 match for '//trim(tape(t)%hlist(fld)%field%name)) + end if + if (tape(t)%hlist(fld)%field%op_field2_id == -1) then + call endrun(trim(subname)//': No op_field2 match for '//trim(tape(t)%hlist(fld)%field%name)) + end if + else + call endrun(trim(subname)//': Component fields not found for composed field') + end if + end if + end do + end subroutine define_composed_field_ids + subroutine restart_vars_setnames() ! Local variable @@ -977,16 +1120,18 @@ subroutine restart_vars_setnames() rvindex = rvindex + 1 restartvars(rvindex)%name = 'cpath' restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%ndims = 3 restartvars(rvindex)%dims(1) = max_string_len_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%dims(3) = max_num_split_files rvindex = rvindex + 1 restartvars(rvindex)%name = 'nhfil' restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%ndims = 3 restartvars(rvindex)%dims(1) = max_string_len_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%dims(3) = max_num_split_files rvindex = rvindex + 1 restartvars(rvindex)%name = 'ndens' @@ -1044,6 +1189,8 @@ subroutine restart_vars_setnames() restartvars(rvindex)%ndims = 2 restartvars(rvindex)%dims(1) = maxnflds_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 rvindex = rvindex + 1 restartvars(rvindex)%name = 'numlev' @@ -1051,6 +1198,8 @@ subroutine restart_vars_setnames() restartvars(rvindex)%ndims = 2 restartvars(rvindex)%dims(1) = maxnflds_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 rvindex = rvindex + 1 restartvars(rvindex)%name = 'hrestpath' @@ -1065,6 +1214,27 @@ subroutine restart_vars_setnames() restartvars(rvindex)%ndims = 2 restartvars(rvindex)%dims(1) = maxnflds_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'beg_nstep' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'hbuf_integral' + restartvars(rvindex)%type = pio_double + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 + rvindex = rvindex + 1 restartvars(rvindex)%name = 'avgflag' @@ -1130,6 +1300,9 @@ subroutine restart_vars_setnames() restartvars(rvindex)%ndims = 2 restartvars(rvindex)%dims(1) = maxnflds_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%dfill = 0.0_r8 + rvindex = rvindex + 1 restartvars(rvindex)%name = 'mdims' @@ -1138,6 +1311,8 @@ subroutine restart_vars_setnames() restartvars(rvindex)%dims(1) = maxvarmdims_dim_ind restartvars(rvindex)%dims(2) = maxnflds_dim_ind restartvars(rvindex)%dims(3) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 rvindex = rvindex + 1 restartvars(rvindex)%name = 'mdimnames' @@ -1189,6 +1364,8 @@ subroutine restart_vars_setnames() restartvars(rvindex)%ndims = 2 restartvars(rvindex)%dims(1) = maxnflds_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 rvindex = rvindex + 1 restartvars(rvindex)%name = 'zonal_complement' @@ -1196,6 +1373,50 @@ subroutine restart_vars_setnames() restartvars(rvindex)%ndims = 2 restartvars(rvindex)%dims(1) = maxnflds_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'field_op' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = max_chars_dim_ind + restartvars(rvindex)%dims(2) = maxnflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'op_field1_id' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'op_field2_id' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'op_field1' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = max_fieldname_len_dim_ind + restartvars(rvindex)%dims(2) = maxnflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'op_field2' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = max_fieldname_len_dim_ind + restartvars(rvindex)%dims(2) = maxnflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind end subroutine restart_vars_setnames @@ -1233,6 +1454,9 @@ subroutine restart_dims_setnames() restartdims(max_hcoordname_len_dim_ind)%name = 'max_hcoordname_len' restartdims(max_hcoordname_len_dim_ind)%len = max_hcoordname_len + restartdims(max_num_split_files)%name = 'max_num_split_files' + restartdims(max_num_split_files)%len = maxsplitfiles + end subroutine restart_dims_setnames @@ -1268,15 +1492,27 @@ subroutine init_restart_history (File) restartdims(i)%dimid, existOK=.true.) end do - do i=1,restartvarcnt - ndims= restartvars(i)%ndims - do k=1,ndims - dimids(k)=restartdims(restartvars(i)%dims(k))%dimid + do i = 1, restartvarcnt + ndims = restartvars(i)%ndims + do k = 1 ,ndims + dimids(k) = restartdims(restartvars(i)%dims(k))%dimid end do allocate(restartvars(i)%vdesc) ierr = pio_def_var(File, restartvars(i)%name, restartvars(i)%type, dimids(1:ndims), restartvars(i)%vdesc) call cam_pio_handle_error(ierr, 'INIT_RESTART_HISTORY: Error defining '//trim(restartvars(i)%name)) - + if(restartvars(i)%fillset) then + if(restartvars(i)%type == PIO_INT) then + ierr = pio_put_att(File, restartvars(i)%vdesc, "_FillValue", & + restartvars(i)%ifill) + else if(restartvars(i)%type == PIO_REAL) then + ierr = pio_put_att(File, restartvars(i)%vdesc, "_FillValue", & + restartvars(i)%rfill) + else if(restartvars(i)%type == PIO_DOUBLE) then + ierr = pio_put_att(File, restartvars(i)%vdesc, "_FillValue", & + restartvars(i)%dfill) + end if + call cam_pio_handle_error(ierr, 'INIT_RESTART_HISTORY: Error setting fill'//trim(restartvars(i)%name)) + end if end do end if end subroutine init_restart_history @@ -1320,7 +1556,7 @@ subroutine write_restart_history ( File, & ! ! Local workspace ! - integer :: ierr, t, f + integer :: ierr, t, fld integer :: rgnht_int(ptapes), start(2), startc(3) type(var_desc_t), pointer :: vdesc @@ -1334,6 +1570,8 @@ subroutine write_restart_history ( File, & type(var_desc_t), pointer :: longname_desc type(var_desc_t), pointer :: units_desc type(var_desc_t), pointer :: hwrt_prec_desc + type(var_desc_t), pointer :: hbuf_integral_desc + type(var_desc_t), pointer :: beg_nstep_desc type(var_desc_t), pointer :: xyfill_desc type(var_desc_t), pointer :: mdims_desc ! mdim name indices type(var_desc_t), pointer :: mdimname_desc ! mdim names @@ -1346,6 +1584,11 @@ subroutine write_restart_history ( File, & type(var_desc_t), pointer :: interpolate_nlon_desc type(var_desc_t), pointer :: meridional_complement_desc type(var_desc_t), pointer :: zonal_complement_desc + type(var_desc_t), pointer :: field_op_desc + type(var_desc_t), pointer :: op_field1_id_desc + type(var_desc_t), pointer :: op_field2_id_desc + type(var_desc_t), pointer :: op_field1_desc + type(var_desc_t), pointer :: op_field2_desc integer, allocatable :: allmdims(:,:,:) integer, allocatable :: xyfill(:,:) @@ -1353,7 +1596,7 @@ subroutine write_restart_history ( File, & integer, allocatable :: interp_output(:) integer :: maxnflds - + real(r8) :: integral ! hbuf area weighted integral maxnflds = maxval(nflds) allocate(xyfill(maxnflds, ptapes)) @@ -1422,10 +1665,10 @@ subroutine write_restart_history ( File, & ierr= pio_put_var(File, vdesc, nfpath(1:ptapes)) vdesc => restartvar_getdesc('cpath') - ierr= pio_put_var(File, vdesc, cpath(1:ptapes)) + ierr= pio_put_var(File, vdesc, cpath(1:ptapes,:)) vdesc => restartvar_getdesc('nhfil') - ierr= pio_put_var(File, vdesc, nhfil(1:ptapes)) + ierr= pio_put_var(File, vdesc, nhfil(1:ptapes,:)) vdesc => restartvar_getdesc('ndens') ierr= pio_put_var(File, vdesc, ndens(1:ptapes)) @@ -1447,6 +1690,8 @@ subroutine write_restart_history ( File, & decomp_type_desc => restartvar_getdesc('decomp_type') numlev_desc => restartvar_getdesc('numlev') hwrt_prec_desc => restartvar_getdesc('hwrt_prec') + hbuf_integral_desc => restartvar_getdesc('hbuf_integral') + beg_nstep_desc => restartvar_getdesc('beg_nstep') sseq_desc => restartvar_getdesc('sampling_seq') cm_desc => restartvar_getdesc('cell_methods') @@ -1465,6 +1710,12 @@ subroutine write_restart_history ( File, & meridional_complement_desc => restartvar_getdesc('meridional_complement') zonal_complement_desc => restartvar_getdesc('zonal_complement') + field_op_desc => restartvar_getdesc('field_op') + op_field1_id_desc => restartvar_getdesc('op_field1_id') + op_field2_id_desc => restartvar_getdesc('op_field2_id') + op_field1_desc => restartvar_getdesc('op_field1') + op_field2_desc => restartvar_getdesc('op_field2') + mdims_desc => restartvar_getdesc('mdims') mdimname_desc => restartvar_getdesc('mdimnames') fillval_desc => restartvar_getdesc('fillvalue') @@ -1479,32 +1730,40 @@ subroutine write_restart_history ( File, & do t = 1,ptapes start(2)=t startc(3)=t - do f=1,nflds(t) - start(1)=f - startc(2)=f - ierr = pio_put_var(File, field_name_desc,startc,tape(t)%hlist(f)%field%name) - ierr = pio_put_var(File, decomp_type_desc,start,tape(t)%hlist(f)%field%decomp_type) - ierr = pio_put_var(File, numlev_desc,start,tape(t)%hlist(f)%field%numlev) - - ierr = pio_put_var(File, hwrt_prec_desc,start,tape(t)%hlist(f)%hwrt_prec) - ierr = pio_put_var(File, sseq_desc,startc,tape(t)%hlist(f)%field%sampling_seq) - ierr = pio_put_var(File, cm_desc,startc,tape(t)%hlist(f)%field%cell_methods) - ierr = pio_put_var(File, longname_desc,startc,tape(t)%hlist(f)%field%long_name) - ierr = pio_put_var(File, units_desc,startc,tape(t)%hlist(f)%field%units) - ierr = pio_put_var(File, avgflag_desc,start, tape(t)%hlist(f)%avgflag) - - ierr = pio_put_var(File, fillval_desc,start, tape(t)%hlist(f)%field%fillvalue) - ierr = pio_put_var(File, meridional_complement_desc,start, tape(t)%hlist(f)%field%meridional_complement) - ierr = pio_put_var(File, zonal_complement_desc,start, tape(t)%hlist(f)%field%zonal_complement) - if(associated(tape(t)%hlist(f)%field%mdims)) then - allmdims(1:size(tape(t)%hlist(f)%field%mdims),f,t) = tape(t)%hlist(f)%field%mdims + do fld=1,nflds(t) + start(1)=fld + startc(2)=fld + ierr = pio_put_var(File, field_name_desc,startc,tape(t)%hlist(fld)%field%name) + ierr = pio_put_var(File, decomp_type_desc,start,tape(t)%hlist(fld)%field%decomp_type) + ierr = pio_put_var(File, numlev_desc,start,tape(t)%hlist(fld)%field%numlev) + + ierr = pio_put_var(File, hwrt_prec_desc,start,tape(t)%hlist(fld)%hwrt_prec) + call tape(t)%hlist(fld)%get_global(integral) + ierr = pio_put_var(File, hbuf_integral_desc,start,integral) + ierr = pio_put_var(File, beg_nstep_desc,start,tape(t)%hlist(fld)%beg_nstep) + ierr = pio_put_var(File, sseq_desc,startc,tape(t)%hlist(fld)%field%sampling_seq) + ierr = pio_put_var(File, cm_desc,startc,tape(t)%hlist(fld)%field%cell_methods) + ierr = pio_put_var(File, longname_desc,startc,tape(t)%hlist(fld)%field%long_name) + ierr = pio_put_var(File, units_desc,startc,tape(t)%hlist(fld)%field%units) + ierr = pio_put_var(File, avgflag_desc,start, tape(t)%hlist(fld)%avgflag) + + ierr = pio_put_var(File, fillval_desc,start, tape(t)%hlist(fld)%field%fillvalue) + ierr = pio_put_var(File, meridional_complement_desc,start, tape(t)%hlist(fld)%field%meridional_complement) + ierr = pio_put_var(File, zonal_complement_desc,start, tape(t)%hlist(fld)%field%zonal_complement) + ierr = pio_put_var(File, field_op_desc,startc, tape(t)%hlist(fld)%field%field_op) + ierr = pio_put_var(File, op_field1_id_desc,start, tape(t)%hlist(fld)%field%op_field1_id) + ierr = pio_put_var(File, op_field2_id_desc,start, tape(t)%hlist(fld)%field%op_field2_id) + ierr = pio_put_var(File, op_field1_desc,startc, tape(t)%hlist(fld)%op_field1) + ierr = pio_put_var(File, op_field2_desc,startc, tape(t)%hlist(fld)%op_field2) + if(associated(tape(t)%hlist(fld)%field%mdims)) then + allmdims(1:size(tape(t)%hlist(fld)%field%mdims),fld,t) = tape(t)%hlist(fld)%field%mdims else end if - if(tape(t)%hlist(f)%field%flag_xyfill) then - xyfill(f,t) = 1 + if(tape(t)%hlist(fld)%field%flag_xyfill) then + xyfill(fld,t) = 1 end if - if(tape(t)%hlist(f)%field%is_subcol) then - is_subcol(f,t) = 1 + if(tape(t)%hlist(fld)%field%is_subcol) then + is_subcol(fld,t) = 1 end if end do if (interpolate_output(t)) then @@ -1538,13 +1797,12 @@ subroutine write_restart_history ( File, & ierr = pio_put_var(File, interpolate_nlon_desc, interp_output) ! Registered history coordinates start(1) = 1 - do f = 1, registeredmdims - start(2) = f - ierr = pio_put_var(File, mdimname_desc, start, hist_coord_name(f)) + do fld = 1, registeredmdims + start(2) = fld + ierr = pio_put_var(File, mdimname_desc, start, hist_coord_name(fld)) end do - deallocate(xyfill, allmdims) - return + deallocate(xyfill, allmdims, is_subcol, interp_output, restarthistory_tape) end subroutine write_restart_history @@ -1559,11 +1817,13 @@ subroutine read_restart_history (File) use ioFileMod, only: getfil use sat_hist, only: sat_hist_define, sat_hist_init use cam_grid_support, only: cam_grid_read_dist_array, cam_grid_num_grids - use cam_history_support, only: get_hist_coord_index, add_hist_coord + use cam_history_support, only: get_hist_coord_index, add_hist_coord, dim_index_2d use constituents, only: cnst_get_ind, cnst_get_type_byind + use cam_grid_support, only: cam_grid_get_areawt use shr_sys_mod, only: shr_sys_getenv use spmd_utils, only: mpicom, mpi_character, masterprocid + use time_manager, only: get_nstep ! !----------------------------------------------------------------------- ! @@ -1573,7 +1833,7 @@ subroutine read_restart_history (File) ! ! Local workspace ! - integer t, f, ff ! tape, field indices + integer t, f, fld, ffld ! tape, file, field indices integer begdim2 ! on-node vert start index integer enddim2 ! on-node vert end index integer begdim1 ! on-node dim1 start index @@ -1587,8 +1847,11 @@ subroutine read_restart_history (File) character(len=max_string_len) :: locfn ! Local filename character(len=max_fieldname_len), allocatable :: tmpname(:,:) + character(len=max_fieldname_len), allocatable :: tmpf1name(:,:) + character(len=max_fieldname_len), allocatable :: tmpf2name(:,:) integer, allocatable :: decomp(:,:), tmpnumlev(:,:) - integer, pointer :: nacs(:,:) ! accumulation counter + integer, pointer :: nacs(:,:) ! outfld accumulation counter + integer :: beg_nstep ! start timestep of this slice for nstep accumulation counter character(len=max_fieldname_len) :: fname_tmp ! local copy of field name character(len=max_fieldname_len) :: dname_tmp ! local copy of dim name @@ -1603,7 +1866,15 @@ subroutine read_restart_history (File) type(var_desc_t) :: fillval_desc type(var_desc_t) :: meridional_complement_desc type(var_desc_t) :: zonal_complement_desc + type(var_desc_t) :: field_op_desc + type(var_desc_t) :: op_field1_id_desc + type(var_desc_t) :: op_field2_id_desc + type(var_desc_t) :: op_field1_desc + type(var_desc_t) :: op_field2_desc + type(dim_index_2d) :: dimind ! 2-D dimension index integer, allocatable :: tmpprec(:,:) + real(r8), allocatable :: tmpintegral(:,:) + integer, allocatable :: tmpbeg_nstep(:,:) integer, allocatable :: xyfill(:,:) integer, allocatable :: allmdims(:,:,:) integer, allocatable :: is_subcol(:,:) @@ -1626,6 +1897,8 @@ subroutine read_restart_history (File) integer :: fdecomp ! Grid ID for field integer :: idx character(len=3) :: mixing_ratio + integer :: c,ib,ie,jb,je,k,cnt,wtidx(1) + real(r8), pointer :: areawt(:) ! pointer to areawt values for attribute ! ! Get users logname and machine hostname @@ -1673,9 +1946,9 @@ subroutine read_restart_history (File) ierr = pio_inq_varid(File, 'nfpath', vdesc) ierr = pio_get_var(File, vdesc, nfpath(1:mtapes)) ierr = pio_inq_varid(File, 'cpath', vdesc) - ierr = pio_get_var(File, vdesc, cpath(1:mtapes)) + ierr = pio_get_var(File, vdesc, cpath(1:mtapes,:)) ierr = pio_inq_varid(File, 'nhfil', vdesc) - ierr = pio_get_var(File, vdesc, nhfil(1:mtapes)) + ierr = pio_get_var(File, vdesc, nhfil(1:mtapes,:)) ierr = pio_inq_varid(File, 'hrestpath', vdesc) ierr = pio_get_var(File, vdesc, hrestpath(1:mtapes)) @@ -1703,33 +1976,38 @@ subroutine read_restart_history (File) ierr = pio_inq_varid(File, 'lcltod_stop', vdesc) ierr = pio_get_var(File, vdesc, lcltod_stop(1:mtapes)) - - - allocate(tmpname(maxnflds, mtapes), decomp(maxnflds, mtapes), tmpnumlev(maxnflds,mtapes)) ierr = pio_inq_varid(File, 'field_name', vdesc) ierr = pio_get_var(File, vdesc, tmpname) - ierr = pio_inq_varid(File, 'decomp_type', vdesc) ierr = pio_get_var(File, vdesc, decomp) ierr = pio_inq_varid(File, 'numlev', vdesc) ierr = pio_get_var(File, vdesc, tmpnumlev) - allocate(tmpprec(maxnflds,mtapes)) + ierr = pio_inq_varid(File, 'hbuf_integral',vdesc) + allocate(tmpintegral(maxnflds,mtapes)) + ierr = pio_get_var(File, vdesc, tmpintegral(:,:)) + + ierr = pio_inq_varid(File, 'hwrt_prec',vdesc) + allocate(tmpprec(maxnflds,mtapes)) ierr = pio_get_var(File, vdesc, tmpprec(:,:)) - allocate(xyfill(maxnflds,mtapes)) + ierr = pio_inq_varid(File, 'beg_nstep',vdesc) + allocate(tmpbeg_nstep(maxnflds,mtapes)) + ierr = pio_get_var(File, vdesc, tmpbeg_nstep(:,:)) + ierr = pio_inq_varid(File, 'xyfill', vdesc) + allocate(xyfill(maxnflds,mtapes)) ierr = pio_get_var(File, vdesc, xyfill) - allocate(is_subcol(maxnflds,mtapes)) ierr = pio_inq_varid(File, 'is_subcol', vdesc) + allocate(is_subcol(maxnflds,mtapes)) ierr = pio_get_var(File, vdesc, is_subcol) !! interpolated output - allocate(interp_output(mtapes)) ierr = pio_inq_varid(File, 'interpolate_output', vdesc) + allocate(interp_output(mtapes)) ierr = pio_get_var(File, vdesc, interp_output) interpolate_output(1:mtapes) = interp_output(1:mtapes) > 0 if (ptapes > mtapes) then @@ -1784,6 +2062,13 @@ subroutine read_restart_history (File) end if end do + allocate(tmpf1name(maxnflds, mtapes), tmpf2name(maxnflds, mtapes)) + ierr = pio_inq_varid(File, 'op_field1', vdesc) + ierr = pio_get_var(File, vdesc, tmpf1name) + ierr = pio_inq_varid(File, 'op_field2', vdesc) + ierr = pio_get_var(File, vdesc, tmpf2name) + + ierr = pio_inq_varid(File, 'avgflag', avgflag_desc) ierr = pio_inq_varid(File, 'long_name', longname_desc) @@ -1794,6 +2079,9 @@ subroutine read_restart_history (File) ierr = pio_inq_varid(File, 'fillvalue', fillval_desc) ierr = pio_inq_varid(File, 'meridional_complement', meridional_complement_desc) ierr = pio_inq_varid(File, 'zonal_complement', zonal_complement_desc) + ierr = pio_inq_varid(File, 'field_op', field_op_desc) + ierr = pio_inq_varid(File, 'op_field1_id', op_field1_id_desc) + ierr = pio_inq_varid(File, 'op_field2_id', op_field2_id_desc) rgnht(:)=.false. @@ -1807,111 +2095,160 @@ subroutine read_restart_history (File) call strip_null(nfpath(t)) - call strip_null(cpath(t)) + call strip_null(cpath(t,1)) + call strip_null(cpath(t,2)) call strip_null(hrestpath(t)) allocate(tape(t)%hlist(nflds(t))) - do f=1,nflds(t) - if (associated(tape(t)%hlist(f)%field%mdims)) then - deallocate(tape(t)%hlist(f)%field%mdims) + do fld=1,nflds(t) + if (associated(tape(t)%hlist(fld)%field%mdims)) then + deallocate(tape(t)%hlist(fld)%field%mdims) end if - nullify(tape(t)%hlist(f)%field%mdims) - ierr = pio_get_var(File,fillval_desc, (/f,t/), tape(t)%hlist(f)%field%fillvalue) - ierr = pio_get_var(File,meridional_complement_desc, (/f,t/), tape(t)%hlist(f)%field%meridional_complement) - ierr = pio_get_var(File,zonal_complement_desc, (/f,t/), tape(t)%hlist(f)%field%zonal_complement) - ierr = pio_get_var(File,avgflag_desc, (/f,t/), tape(t)%hlist(f)%avgflag) - ierr = pio_get_var(File,longname_desc, (/1,f,t/), tape(t)%hlist(f)%field%long_name) - ierr = pio_get_var(File,units_desc, (/1,f,t/), tape(t)%hlist(f)%field%units) - tape(t)%hlist(f)%field%sampling_seq(1:max_chars) = ' ' - ierr = pio_get_var(File,sseq_desc, (/1,f,t/), tape(t)%hlist(f)%field%sampling_seq) - call strip_null(tape(t)%hlist(f)%field%sampling_seq) - tape(t)%hlist(f)%field%cell_methods(1:max_chars) = ' ' - ierr = pio_get_var(File,cm_desc, (/1,f,t/), tape(t)%hlist(f)%field%cell_methods) - call strip_null(tape(t)%hlist(f)%field%cell_methods) - if(xyfill(f,t) ==1) then - tape(t)%hlist(f)%field%flag_xyfill=.true. + nullify(tape(t)%hlist(fld)%field%mdims) + ierr = pio_get_var(File,fillval_desc, (/fld,t/), tape(t)%hlist(fld)%field%fillvalue) + ierr = pio_get_var(File,meridional_complement_desc, (/fld,t/), tape(t)%hlist(fld)%field%meridional_complement) + ierr = pio_get_var(File,zonal_complement_desc, (/fld,t/), tape(t)%hlist(fld)%field%zonal_complement) + tape(t)%hlist(fld)%field%field_op(1:field_op_len) = ' ' + ierr = pio_get_var(File,field_op_desc, (/1,fld,t/), tape(t)%hlist(fld)%field%field_op) + call strip_null(tape(t)%hlist(fld)%field%field_op) + ierr = pio_get_var(File,op_field1_id_desc, (/fld,t/), tape(t)%hlist(fld)%field%op_field1_id) + ierr = pio_get_var(File,op_field2_id_desc, (/fld,t/), tape(t)%hlist(fld)%field%op_field2_id) + ierr = pio_get_var(File,avgflag_desc, (/fld,t/), tape(t)%hlist(fld)%avgflag) + ierr = pio_get_var(File,longname_desc, (/1,fld,t/), tape(t)%hlist(fld)%field%long_name) + ierr = pio_get_var(File,units_desc, (/1,fld,t/), tape(t)%hlist(fld)%field%units) + tape(t)%hlist(fld)%field%sampling_seq(1:max_chars) = ' ' + ierr = pio_get_var(File,sseq_desc, (/1,fld,t/), tape(t)%hlist(fld)%field%sampling_seq) + call strip_null(tape(t)%hlist(fld)%field%sampling_seq) + tape(t)%hlist(fld)%field%cell_methods(1:max_chars) = ' ' + ierr = pio_get_var(File,cm_desc, (/1,fld,t/), tape(t)%hlist(fld)%field%cell_methods) + call strip_null(tape(t)%hlist(fld)%field%cell_methods) + if(xyfill(fld,t) ==1) then + tape(t)%hlist(fld)%field%flag_xyfill=.true. else - tape(t)%hlist(f)%field%flag_xyfill=.false. + tape(t)%hlist(fld)%field%flag_xyfill=.false. end if - if(is_subcol(f,t) ==1) then - tape(t)%hlist(f)%field%is_subcol=.true. + if(is_subcol(fld,t) ==1) then + tape(t)%hlist(fld)%field%is_subcol=.true. else - tape(t)%hlist(f)%field%is_subcol=.false. + tape(t)%hlist(fld)%field%is_subcol=.false. end if - call strip_null(tmpname(f,t)) - tape(t)%hlist(f)%field%name = tmpname(f,t) - tape(t)%hlist(f)%field%decomp_type = decomp(f,t) - tape(t)%hlist(f)%field%numlev = tmpnumlev(f,t) - tape(t)%hlist(f)%hwrt_prec = tmpprec(f,t) - + call strip_null(tmpname(fld,t)) + call strip_null(tmpf1name(fld,t)) + call strip_null(tmpf2name(fld,t)) + tape(t)%hlist(fld)%field%name = tmpname(fld,t) + tape(t)%hlist(fld)%op_field1 = tmpf1name(fld,t) + tape(t)%hlist(fld)%op_field2 = tmpf2name(fld,t) + tape(t)%hlist(fld)%field%decomp_type = decomp(fld,t) + tape(t)%hlist(fld)%field%numlev = tmpnumlev(fld,t) + tape(t)%hlist(fld)%hwrt_prec = tmpprec(fld,t) + tape(t)%hlist(fld)%beg_nstep = tmpbeg_nstep(fld,t) + call tape(t)%hlist(fld)%put_global(tmpintegral(fld,t)) ! If the field is an advected constituent set the mixing_ratio attribute - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) + fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) call cnst_get_ind(fname_tmp, idx, abort=.false.) mixing_ratio = '' if (idx > 0) then mixing_ratio = cnst_get_type_byind(idx) end if - tape(t)%hlist(f)%field%mixing_ratio = mixing_ratio + tape(t)%hlist(fld)%field%mixing_ratio = mixing_ratio - mdimcnt = count(allmdims(:,f,t) > 0) + mdimcnt = count(allmdims(:,fld,t) > 0) if(mdimcnt > 0) then - allocate(tape(t)%hlist(f)%field%mdims(mdimcnt)) + allocate(tape(t)%hlist(fld)%field%mdims(mdimcnt)) do i = 1, mdimcnt - tape(t)%hlist(f)%field%mdims(i) = get_hist_coord_index(mdimnames(allmdims(i,f,t))) + tape(t)%hlist(fld)%field%mdims(i) = get_hist_coord_index(mdimnames(allmdims(i,fld,t))) end do end if - end do end do - deallocate(tmpname, tmpnumlev, tmpprec, decomp, xyfill, is_subcol) + deallocate(tmpname, tmpnumlev, tmpprec, tmpbeg_nstep, decomp, xyfill, is_subcol, tmpintegral) deallocate(mdimnames) + deallocate(tmpf1name,tmpf2name) + + allocate(grid_wts(cam_grid_num_grids() + 1)) + allgrids_wt => grid_wts allocate(gridsontape(cam_grid_num_grids() + 1, ptapes)) gridsontape = -1 do t = 1, ptapes - do f = 1, nflds(t) - call set_field_dimensions(tape(t)%hlist(f)%field) - - begdim1 = tape(t)%hlist(f)%field%begdim1 - enddim1 = tape(t)%hlist(f)%field%enddim1 - begdim2 = tape(t)%hlist(f)%field%begdim2 - enddim2 = tape(t)%hlist(f)%field%enddim2 - begdim3 = tape(t)%hlist(f)%field%begdim3 - enddim3 = tape(t)%hlist(f)%field%enddim3 - - allocate(tape(t)%hlist(f)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) - if (tape(t)%hlist(f)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev - allocate(tape(t)%hlist(f)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + do fld = 1, nflds(t) + if (tape(t)%hlist(fld)%avgflag .ne. 'I') then + hfile_accum(t) = .true. + end if + call set_field_dimensions(tape(t)%hlist(fld)%field) + + begdim1 = tape(t)%hlist(fld)%field%begdim1 + enddim1 = tape(t)%hlist(fld)%field%enddim1 + begdim2 = tape(t)%hlist(fld)%field%begdim2 + enddim2 = tape(t)%hlist(fld)%field%enddim2 + begdim3 = tape(t)%hlist(fld)%field%begdim3 + enddim3 = tape(t)%hlist(fld)%field%enddim3 + + allocate(tape(t)%hlist(fld)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + if (tape(t)%hlist(fld)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev + allocate(tape(t)%hlist(fld)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) endif - if (associated(tape(t)%hlist(f)%varid)) then - deallocate(tape(t)%hlist(f)%varid) + if (associated(tape(t)%hlist(fld)%varid)) then + deallocate(tape(t)%hlist(fld)%varid) end if - nullify(tape(t)%hlist(f)%varid) - if (associated(tape(t)%hlist(f)%nacs)) then - deallocate(tape(t)%hlist(f)%nacs) + nullify(tape(t)%hlist(fld)%varid) + if (associated(tape(t)%hlist(fld)%nacs)) then + deallocate(tape(t)%hlist(fld)%nacs) end if - nullify(tape(t)%hlist(f)%nacs) - if(tape(t)%hlist(f)%field%flag_xyfill .or. (avgflag_pertape(t)=='L')) then - allocate (tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) + nullify(tape(t)%hlist(fld)%nacs) + if(tape(t)%hlist(fld)%field%flag_xyfill .or. (avgflag_pertape(t)=='L')) then + allocate (tape(t)%hlist(fld)%nacs(begdim1:enddim1,begdim3:enddim3)) else - allocate(tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) + allocate(tape(t)%hlist(fld)%nacs(1,begdim3:enddim3)) end if ! initialize all buffers to zero - this will be overwritten later by the ! data in the history restart file if it exists. - call h_zero(f,t) + call h_zero(fld,t) ! Make sure this field's decomp is listed on the tape - fdecomp = tape(t)%hlist(f)%field%decomp_type - do ff = 1, size(gridsontape, 1) - if (fdecomp == gridsontape(ff, t)) then + fdecomp = tape(t)%hlist(fld)%field%decomp_type + do ffld = 1, size(gridsontape, 1) + if (fdecomp == gridsontape(ffld, t)) then exit - else if (gridsontape(ff, t) < 0) then - gridsontape(ff, t) = fdecomp + else if (gridsontape(ffld, t) < 0) then + gridsontape(ffld, t) = fdecomp exit end if end do - + ! + !rebuild area wt array and set field wbuf pointer + ! + if (tape(t)%hlist(fld)%avgflag .eq. 'N') then ! set up area weight buffer + nullify(tape(t)%hlist(fld)%wbuf) + + if (any(allgrids_wt(:)%decomp_type == tape(t)%hlist(fld)%field%decomp_type)) then + wtidx=MAXLOC(allgrids_wt(:)%decomp_type, MASK = allgrids_wt(:)%decomp_type .EQ. fdecomp) + tape(t)%hlist(fld)%wbuf => allgrids_wt(wtidx(1))%wbuf + else + ! area weights not found for this grid, then create them + ! first check for an available spot in the array + if (any(allgrids_wt(:)%decomp_type == -1)) then + wtidx=MINLOC(allgrids_wt(:)%decomp_type) + else + call endrun('cam_history.F90:read_restart_history: Error initializing allgrids_wt with area weights') + end if + allgrids_wt(wtidx)%decomp_type=fdecomp + areawt => cam_grid_get_areawt(fdecomp) + allocate(allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim3:enddim3)) + cnt=0 + do c=begdim3,enddim3 + dimind = tape(t)%hlist(fld)%field%get_dims(c) + ib=dimind%beg1 + ie=dimind%end1 + do i=ib,ie + cnt=cnt+1 + allgrids_wt(wtidx(1))%wbuf(i,c)=areawt(cnt) + end do + end do + tape(t)%hlist(fld)%wbuf => allgrids_wt(wtidx(1))%wbuf + endif + endif end do end do ! @@ -1935,21 +2272,21 @@ subroutine read_restart_history (File) ! Open history restart file ! call getfil (hrestpath(t), locfn) - call cam_pio_openfile(tape(t)%File, locfn, 0) + call cam_pio_openfile(tape(t)%Files(restart_file_index), locfn, 0) ! ! Read history restart file ! - do f = 1, nflds(t) + do fld = 1, nflds(t) - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) + fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) if(masterproc) write(iulog, *) 'Reading history variable ',fname_tmp - ierr = pio_inq_varid(tape(t)%File, fname_tmp, vdesc) + ierr = pio_inq_varid(tape(t)%Files(restart_file_index), fname_tmp, vdesc) + call cam_pio_var_info(tape(t)%Files(restart_file_index), vdesc, ndims, dimids, dimlens) - call cam_pio_var_info(tape(t)%File, vdesc, ndims, dimids, dimlens) - if(.not. associated(tape(t)%hlist(f)%field%mdims)) then + if(.not. associated(tape(t)%hlist(fld)%field%mdims)) then dimcnt = 0 do i=1,ndims - ierr = pio_inq_dimname(tape(t)%File, dimids(i), dname_tmp) + ierr = pio_inq_dimname(tape(t)%Files(restart_file_index), dimids(i), dname_tmp) dimid = get_hist_coord_index(dname_tmp) if(dimid >= 1) then dimcnt = dimcnt + 1 @@ -1958,20 +2295,20 @@ subroutine read_restart_history (File) end if end do if(dimcnt > 0) then - allocate(tape(t)%hlist(f)%field%mdims(dimcnt)) - tape(t)%hlist(f)%field%mdims(:) = tmpdims(1:dimcnt) + allocate(tape(t)%hlist(fld)%field%mdims(dimcnt)) + tape(t)%hlist(fld)%field%mdims(:) = tmpdims(1:dimcnt) if(dimcnt > maxvarmdims) maxvarmdims=dimcnt end if end if - call set_field_dimensions(tape(t)%hlist(f)%field) - begdim1 = tape(t)%hlist(f)%field%begdim1 - enddim1 = tape(t)%hlist(f)%field%enddim1 + call set_field_dimensions(tape(t)%hlist(fld)%field) + begdim1 = tape(t)%hlist(fld)%field%begdim1 + enddim1 = tape(t)%hlist(fld)%field%enddim1 fdims(1) = enddim1 - begdim1 + 1 - begdim2 = tape(t)%hlist(f)%field%begdim2 - enddim2 = tape(t)%hlist(f)%field%enddim2 + begdim2 = tape(t)%hlist(fld)%field%begdim2 + enddim2 = tape(t)%hlist(fld)%field%enddim2 fdims(2) = enddim2 - begdim2 + 1 - begdim3 = tape(t)%hlist(f)%field%begdim3 - enddim3 = tape(t)%hlist(f)%field%enddim3 + begdim3 = tape(t)%hlist(fld)%field%begdim3 + enddim3 = tape(t)%hlist(fld)%field%enddim3 fdims(3) = enddim3 - begdim3 + 1 if (fdims(2) > 1) then nfdims = 3 @@ -1979,66 +2316,69 @@ subroutine read_restart_history (File) nfdims = 2 fdims(2) = fdims(3) end if - fdecomp = tape(t)%hlist(f)%field%decomp_type + fdecomp = tape(t)%hlist(fld)%field%decomp_type if (nfdims > 2) then - call cam_grid_read_dist_array(tape(t)%File, fdecomp, & - fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%hbuf, vdesc) + call cam_grid_read_dist_array(tape(t)%Files(restart_file_index), fdecomp, & + fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(fld)%hbuf, vdesc) else - call cam_grid_read_dist_array(tape(t)%File, fdecomp, & - fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%hbuf(:,1,:), vdesc) + call cam_grid_read_dist_array(tape(t)%Files(restart_file_index), fdecomp, & + fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(fld)%hbuf(:,1,:), vdesc) end if - if ( associated(tape(t)%hlist(f)%sbuf) ) then + if ( associated(tape(t)%hlist(fld)%sbuf) ) then ! read in variance for standard deviation - ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp)//'_var', vdesc) + ierr = pio_inq_varid(tape(t)%Files(restart_file_index), trim(fname_tmp)//'_var', vdesc) if (nfdims > 2) then - call cam_grid_read_dist_array(tape(t)%File, fdecomp, & - fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%sbuf, vdesc) + call cam_grid_read_dist_array(tape(t)%Files(restart_file_index), fdecomp, & + fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(fld)%sbuf, vdesc) else - call cam_grid_read_dist_array(tape(t)%File, fdecomp, & - fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%sbuf(:,1,:), vdesc) + call cam_grid_read_dist_array(tape(t)%Files(restart_file_index), fdecomp, & + fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(fld)%sbuf(:,1,:), vdesc) end if endif - ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp)//'_nacs', vdesc) - call cam_pio_var_info(tape(t)%File, vdesc, nacsdimcnt, dimids, dimlens) + ierr = pio_inq_varid(tape(t)%Files(restart_file_index), trim(fname_tmp)//'_nacs', vdesc) + call cam_pio_var_info(tape(t)%Files(restart_file_index), vdesc, nacsdimcnt, dimids, dimlens) if(nacsdimcnt > 0) then if (nfdims > 2) then ! nacs only has 2 dims (no levels) fdims(2) = fdims(3) end if - allocate(tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) - nacs => tape(t)%hlist(f)%nacs(:,:) - call cam_grid_read_dist_array(tape(t)%File, fdecomp, fdims(1:2), & + allocate(tape(t)%hlist(fld)%nacs(begdim1:enddim1,begdim3:enddim3)) + nacs => tape(t)%hlist(fld)%nacs(:,:) + call cam_grid_read_dist_array(tape(t)%Files(restart_file_index), fdecomp, fdims(1:2), & dimlens(1:nacsdimcnt), nacs, vdesc) else - allocate(tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) - ierr = pio_get_var(tape(t)%File, vdesc, nacsval) - tape(t)%hlist(f)%nacs(1,:)= nacsval + allocate(tape(t)%hlist(fld)%nacs(1,begdim3:enddim3)) + ierr = pio_get_var(tape(t)%Files(restart_file_index), vdesc, nacsval) + tape(t)%hlist(fld)%nacs(1,:)= nacsval end if + ierr = pio_inq_varid(tape(t)%Files(restart_file_index), trim(fname_tmp)//'_nacs', vdesc) + call cam_pio_var_info(tape(t)%Files(restart_file_index), vdesc, nacsdimcnt, dimids, dimlens) + end do ! ! Done reading this history restart file ! - call cam_pio_closefile(tape(t)%File) + call cam_pio_closefile(tape(t)%Files(restart_file_index)) end if ! rgnht(t) ! (re)create the master list of grid IDs - ff = 0 - do f = 1, size(gridsontape, 1) - if (gridsontape(f, t) > 0) then - ff = ff + 1 + ffld = 0 + do fld = 1, size(gridsontape, 1) + if (gridsontape(fld, t) > 0) then + ffld = ffld + 1 end if end do - allocate(tape(t)%grid_ids(ff)) - ff = 1 - do f = 1, size(gridsontape, 1) - if (gridsontape(f, t) > 0) then - tape(t)%grid_ids(ff) = gridsontape(f, t) - ff = ff + 1 + allocate(tape(t)%grid_ids(ffld)) + ffld = 1 + do fld = 1, size(gridsontape, 1) + if (gridsontape(fld, t) > 0) then + tape(t)%grid_ids(ffld) = gridsontape(fld, t) + ffld = ffld + 1 end if end do call patch_init(t) @@ -2050,7 +2390,6 @@ subroutine read_restart_history (File) ! ! NOTE: No need to perform this operation for IC history files or empty files ! - do t=1,mtapes if (is_initfile(file_index=t)) then ! Initialize filename specifier for IC file @@ -2060,13 +2399,19 @@ subroutine read_restart_history (File) nfils(t) = 0 else if (nfils(t) > 0) then - call getfil (cpath(t), locfn) - call cam_pio_openfile(tape(t)%File, locfn, PIO_WRITE) + ! Always create the instantaneous file + call getfil (cpath(t,instantaneous_file_index), locfn) + call cam_pio_openfile(tape(t)%Files(instantaneous_file_index), locfn, PIO_WRITE) + if (hfile_accum(t)) then + ! Conditionally create the accumulated file + call getfil (cpath(t,accumulated_file_index), locfn) + call cam_pio_openfile(tape(t)%Files(accumulated_file_index), locfn, PIO_WRITE) + end if call h_inquire (t) if(is_satfile(t)) then ! Initialize the sat following history subsystem call sat_hist_init() - call sat_hist_define(tape(t)%File) + call sat_hist_define(tape(t)%Files(sat_file_index)) end if end if ! @@ -2074,13 +2419,21 @@ subroutine read_restart_history (File) ! if (nfils(t) >= mfilt(t)) then if (masterproc) then - write(iulog,*)'READ_RESTART_HISTORY: nf_close(',t,')=',nhfil(t), mfilt(t) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + write(iulog,*)'READ_RESTART_HISTORY: nf_close(',t,')=',nhfil(t,f), mfilt(t) + end if + end do end if - do f=1,nflds(t) - deallocate(tape(t)%hlist(f)%varid) - nullify(tape(t)%hlist(f)%varid) + do fld=1,nflds(t) + deallocate(tape(t)%hlist(fld)%varid) + nullify(tape(t)%hlist(fld)%varid) + end do + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_pio_closefile(tape(t)%Files(f)) + end if end do - call cam_pio_closefile(tape(t)%File) nfils(t) = 0 end if end if @@ -2098,7 +2451,7 @@ end subroutine read_restart_history !####################################################################### - character(len=max_string_len) function get_hfilepath( tape ) + character(len=max_string_len) function get_hfilepath( tape, accumulated_flag ) ! !----------------------------------------------------------------------- ! @@ -2109,8 +2462,14 @@ character(len=max_string_len) function get_hfilepath( tape ) !----------------------------------------------------------------------- ! integer, intent(in) :: tape ! Tape number + logical, intent(in) :: accumulated_flag ! True if calling routine wants the accumulated + ! file path, False for instantaneous - get_hfilepath = cpath( tape ) + if (accumulated_flag) then + get_hfilepath = cpath( tape, accumulated_file_index ) + else + get_hfilepath = cpath( tape, instantaneous_file_index ) + end if end function get_hfilepath !####################################################################### @@ -2178,8 +2537,10 @@ subroutine AvgflagToString(avgflag, time_op) time_op(:) = 'mean' case ('B') time_op(:) = 'mean00z' + case ('N') + time_op(:) = 'mean_over_nsteps' case ('I') - time_op(:) = ' ' + time_op(:) = 'point' case ('X') time_op(:) = 'maximum' case ('M') @@ -2200,6 +2561,7 @@ subroutine fldlst () use cam_grid_support, only: cam_grid_num_grids use spmd_utils, only: mpicom use dycore, only: dycore_is + use shr_kind_mod, only: cm => shr_kind_cm !----------------------------------------------------------------------- ! @@ -2212,9 +2574,11 @@ subroutine fldlst () ! !---------------------------Local variables----------------------------- ! - integer t, f ! tape, field indices - integer ff ! index into include, exclude and fprec list + integer t, fld ! tape, field indices + integer ffld ! index into include, exclude and fprec list integer :: i + character(len=cm) :: duplicate_error ! string to be populated if an incompatible duplicate is found + character(len=cm) :: tempmsg ! string to be populated if an incompatible duplicate is found character(len=fieldname_len) :: name ! field name portion of fincl (i.e. no avgflag separator) character(len=max_fieldname_len) :: mastername ! name from masterlist field character(len=max_chars) :: errormsg ! error output field @@ -2232,16 +2596,6 @@ subroutine fldlst () ! on that grid. integer, allocatable :: gridsontape(:,:) - ! The following list of field names are only valid for the FV dycore. They appear - ! in fincl settings of WACCM use case files which are not restricted to the FV dycore. - ! To avoid duplicating long fincl lists in use case files to provide both FV and non-FV - ! versions this short list of fields is checked for and removed from fincl lists when - ! the dycore is not FV. - integer, parameter :: n_fv_only = 10 - character(len=6) :: fv_only_flds(n_fv_only) = & - [ 'VTHzm ', 'WTHzm ', 'UVzm ', 'UWzm ', 'Uzm ', 'Vzm ', 'Wzm ', & - 'THzm ', 'TH ', 'MSKtem' ] - integer :: n_vec_comp, add_fincl_idx integer, parameter :: nvecmax = 50 ! max number of vector components in a fincl list character(len=2) :: avg_suffix @@ -2254,34 +2608,18 @@ subroutine fldlst () errors_found = 0 do t=1,ptapes - f = 1 + fld = 1 n_vec_comp = 0 vec_comp_names = ' ' vec_comp_avgflag = ' ' -fincls: do while (f < pflds .and. fincl(f,t) /= ' ') - name = getname (fincl(f,t)) - - if (.not. dycore_is('FV')) then - ! filter out fields only provided by FV dycore - do i = 1, n_fv_only - if (name == fv_only_flds(i)) then - write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(name), & - ' in fincl(', f,', ',t, ') only available with FV dycore' - if (masterproc) then - write(iulog,*) trim(errormsg) - call shr_sys_flush(iulog) - end if - f = f + 1 - cycle fincls - end if - end do - end if + do while (fld < pflds .and. fincl(fld,t) /= ' ') + name = getname (fincl(fld,t)) mastername='' listentry => get_entry_by_name(masterlinkedlist, name) if (associated(listentry)) mastername = listentry%field%name if (name /= mastername) then - write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(name), ' in fincl(', f,', ',t, ') not found' + write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(name), ' in fincl(', fld,', ',t, ') not found' if (masterproc) then write(iulog,*) trim(errormsg) call shr_sys_flush(iulog) @@ -2291,7 +2629,7 @@ subroutine fldlst () if (len_trim(mastername)>0 .and. interpolate_output(t)) then if (n_vec_comp >= nvecmax) call endrun('FLDLST: need to increase nvecmax') ! If this is a vector component then save the name of the complement - avgflag = getflag(fincl(f,t)) + avgflag = getflag(fincl(fld,t)) if (len_trim(listentry%meridional_field) > 0) then n_vec_comp = n_vec_comp + 1 vec_comp_names(n_vec_comp) = listentry%meridional_field @@ -2303,20 +2641,20 @@ subroutine fldlst () end if end if end if - f = f + 1 - end do fincls + fld = fld + 1 + end do ! Interpolation of vector components requires that both be present. If the fincl ! specifier contains any vector components, then the complement was saved in the ! array vec_comp_names. Next insure (for interpolated output only) that all complements ! are also present in the fincl array. - ! The first empty slot in the current fincl array is index f from loop above. - add_fincl_idx = f - if (f > 1 .and. interpolate_output(t)) then + ! The first empty slot in the current fincl array is index fld from loop above. + add_fincl_idx = fld + if (fld > 1 .and. interpolate_output(t)) then do i = 1, n_vec_comp - call list_index(fincl(:,t), vec_comp_names(i), ff) - if (ff == 0) then + call list_index(fincl(:,t), vec_comp_names(i), ffld) + if (ffld == 0) then ! Add vector component to fincl. Don't need to check whether its in the master ! list since this was done at the time of registering the vector components. @@ -2335,39 +2673,39 @@ subroutine fldlst () end do end if - f = 1 - do while (f < pflds .and. fexcl(f,t) /= ' ') + fld = 1 + do while (fld < pflds .and. fexcl(fld,t) /= ' ') mastername='' - listentry => get_entry_by_name(masterlinkedlist, fexcl(f,t)) + listentry => get_entry_by_name(masterlinkedlist, fexcl(fld,t)) if(associated(listentry)) mastername = listentry%field%name - if (fexcl(f,t) /= mastername) then - write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(fexcl(f,t)), ' in fexcl(', f,', ',t, ') not found' + if (fexcl(fld,t) /= mastername) then + write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(fexcl(fld,t)), ' in fexcl(', fld,', ',t, ') not found' if (masterproc) then write(iulog,*) trim(errormsg) call shr_sys_flush(iulog) end if errors_found = errors_found + 1 end if - f = f + 1 + fld = fld + 1 end do - f = 1 - do while (f < pflds .and. fwrtpr(f,t) /= ' ') - name = getname (fwrtpr(f,t)) + fld = 1 + do while (fld < pflds .and. fwrtpr(fld,t) /= ' ') + name = getname (fwrtpr(fld,t)) mastername='' listentry => get_entry_by_name(masterlinkedlist, name) if(associated(listentry)) mastername = listentry%field%name if (name /= mastername) then - write(errormsg,'(3a,i0,a)')'FLDLST: ', trim(name), ' in fwrtpr(', f, ') not found' + write(errormsg,'(3a,i0,a)')'FLDLST: ', trim(name), ' in fwrtpr(', fld, ') not found' if (masterproc) then write(iulog,*) trim(errormsg) call shr_sys_flush(iulog) end if errors_found = errors_found + 1 end if - do ff=1,f-1 ! If duplicate entry is found, stop - if (trim(name) == trim(getname(fwrtpr(ff,t)))) then + do ffld=1,fld-1 ! If duplicate entry is found, stop + if (trim(name) == trim(getname(fwrtpr(ffld,t)))) then write(errormsg,'(3a)')'FLDLST: Duplicate field ', trim(name), ' in fwrtpr' if (masterproc) then write(iulog,*) trim(errormsg) @@ -2376,7 +2714,7 @@ subroutine fldlst () errors_found = errors_found + 1 end if end do - f = f + 1 + fld = fld + 1 end do end do @@ -2398,9 +2736,12 @@ subroutine fldlst () end if + allocate(grid_wts(cam_grid_num_grids() + 1)) + allgrids_wt => grid_wts allocate(gridsontape(cam_grid_num_grids() + 1, ptapes)) gridsontape = -1 + errormsg = '' do t=1,ptapes ! ! Add the field to the tape if specified via namelist (FINCL[1-ptapes]), or if @@ -2412,26 +2753,34 @@ subroutine fldlst () listentry => masterlinkedlist do while(associated(listentry)) mastername = listentry%field%name - call list_index (fincl(1,t), mastername, ff) + call list_index (fincl(1,t), mastername, ffld, duplicate_error=duplicate_error) + if (len(trim(duplicate_error)) > 0) then + if (len_trim(errormsg) == 0) then + write(errormsg,*) & + 'FLDLST: Found duplicate field(s) with different averaging flags. Place in separate fincl lists: ' + end if + write(tempmsg, '(2a, i0, a)') trim(duplicate_error), ' (fincl', t, '). ' + errormsg = trim(errormsg) // trim(tempmsg) + end if fieldontape = .false. - if (ff > 0) then + if (ffld > 0) then fieldontape = .true. else if ((.not. empty_htapes) .or. (is_initfile(file_index=t))) then - call list_index (fexcl(1,t), mastername, ff) - if (ff == 0 .and. listentry%actflag(t)) then + call list_index (fexcl(1,t), mastername, ffld) + if (ffld == 0 .and. listentry%actflag(t)) then fieldontape = .true. end if end if if (fieldontape) then - ! The field is active so increment the number fo fields and add + ! The field is active so increment the number of fields and add ! its decomp type to the list of decomp types on this tape nflds(t) = nflds(t) + 1 - do ff = 1, size(gridsontape, 1) - if (listentry%field%decomp_type == gridsontape(ff, t)) then + do ffld = 1, size(gridsontape, 1) + if (listentry%field%decomp_type == gridsontape(ffld, t)) then exit - else if (gridsontape(ff, t) < 0) then - gridsontape(ff, t) = listentry%field%decomp_type + else if (gridsontape(ffld, t) < 0) then + gridsontape(ffld, t) = listentry%field%decomp_type exit end if end do @@ -2439,6 +2788,9 @@ subroutine fldlst () listentry=>listentry%next_entry end do end do + if (len_trim(errormsg) > 0) then + call endrun(trim(errormsg)) + end if ! ! Determine total number of active history tapes ! @@ -2460,26 +2812,27 @@ subroutine fldlst () ! Allocate the correct number of hentry slots allocate(tape(t)%hlist(nflds(t))) ! Count up the number of grids output on this tape - ff = 0 - do f = 1, size(gridsontape, 1) - if (gridsontape(f, t) > 0) then - ff = ff + 1 + ffld = 0 + do fld = 1, size(gridsontape, 1) + if (gridsontape(fld, t) > 0) then + ffld = ffld + 1 end if end do - allocate(tape(t)%grid_ids(ff)) - ff = 1 - do f = 1, size(gridsontape, 1) - if (gridsontape(f, t) > 0) then - tape(t)%grid_ids(ff) = gridsontape(f, t) - ff = ff + 1 + allocate(tape(t)%grid_ids(ffld)) + ffld = 1 + do fld = 1, size(gridsontape, 1) + if (gridsontape(fld, t) > 0) then + tape(t)%grid_ids(ffld) = gridsontape(fld, t) + ffld = ffld + 1 end if end do end if - do ff=1,nflds(t) - nullify(tape(t)%hlist(ff)%hbuf) - nullify(tape(t)%hlist(ff)%sbuf) - nullify(tape(t)%hlist(ff)%nacs) - nullify(tape(t)%hlist(ff)%varid) + do ffld=1,nflds(t) + nullify(tape(t)%hlist(ffld)%hbuf) + nullify(tape(t)%hlist(ffld)%sbuf) + nullify(tape(t)%hlist(ffld)%wbuf) + nullify(tape(t)%hlist(ffld)%nacs) + nullify(tape(t)%hlist(ffld)%varid) end do @@ -2488,21 +2841,21 @@ subroutine fldlst () do while(associated(listentry)) mastername = listentry%field%name - call list_index (fwrtpr(1,t), mastername, ff) - if (ff > 0) then - prec_wrt = getflag(fwrtpr(ff,t)) + call list_index (fwrtpr(1,t), mastername, ffld) + if (ffld > 0) then + prec_wrt = getflag(fwrtpr(ffld,t)) else prec_wrt = ' ' end if - call list_index (fincl(1,t), mastername, ff) + call list_index (fincl(1,t), mastername, ffld) - if (ff > 0) then - avgflag = getflag (fincl(ff,t)) + if (ffld > 0) then + avgflag = getflag (fincl(ffld,t)) call inifld (t, listentry, avgflag, prec_wrt) else if ((.not. empty_htapes) .or. (is_initfile(file_index=t))) then - call list_index (fexcl(1,t), mastername, ff) - if (ff == 0 .and. listentry%actflag(t)) then + call list_index (fexcl(1,t), mastername, ffld) + if (ffld == 0 .and. listentry%actflag(t)) then call inifld (t, listentry, ' ', prec_wrt) else listentry%actflag(t) = .false. @@ -2528,19 +2881,29 @@ subroutine fldlst () ! entries for efficiency in OUTFLD. Simple bubble sort. ! !!XXgoldyXX: v In the future, we will sort according to decomp to speed I/O - do f=nflds(t)-1,1,-1 - do ff=1,f + do fld=nflds(t)-1,1,-1 + do ffld=1,fld - if (tape(t)%hlist(ff)%field%name > tape(t)%hlist(ff+1)%field%name) then + if (tape(t)%hlist(ffld)%field%numlev > tape(t)%hlist(ffld+1)%field%numlev) then + tmp = tape(t)%hlist(ffld) + tape(t)%hlist(ffld ) = tape(t)%hlist(ffld+1) + tape(t)%hlist(ffld+1) = tmp + end if + + end do + + do ffld=1,fld - tmp = tape(t)%hlist(ff) - tape(t)%hlist(ff ) = tape(t)%hlist(ff+1) - tape(t)%hlist(ff+1) = tmp + if ((tape(t)%hlist(ffld)%field%numlev == tape(t)%hlist(ffld+1)%field%numlev) .and. & + (tape(t)%hlist(ffld)%field%name > tape(t)%hlist(ffld+1)%field%name)) then - else if (tape(t)%hlist(ff )%field%name == tape(t)%hlist(ff+1)%field%name) then + tmp = tape(t)%hlist(ffld) + tape(t)%hlist(ffld ) = tape(t)%hlist(ffld+1) + tape(t)%hlist(ffld+1) = tmp + else if (tape(t)%hlist(ffld)%field%name == tape(t)%hlist(ffld+1)%field%name) then write(errormsg,'(2a,2(a,i3))') 'FLDLST: Duplicate field: ', & - trim(tape(t)%hlist(ff)%field%name),', tape = ', t, ', ff = ', ff + trim(tape(t)%hlist(ffld)%field%name),', tape = ', t, ', ffld = ', ffld call endrun(errormsg) end if @@ -2548,6 +2911,9 @@ subroutine fldlst () end do end do + ! Initialize the field names/ids for each composed field on tapes + call define_composed_field_ids(t) + end do ! do t=1,ptapes deallocate(gridsontape) @@ -2581,7 +2947,7 @@ end subroutine fldlst subroutine print_active_fldlst() - integer :: f, ff, i, t + integer :: fld, ffld, i, t integer :: num_patches character(len=6) :: prec_str @@ -2597,7 +2963,7 @@ subroutine print_active_fldlst() if (nflds(t) > 0) then write(iulog,*) ' ' - write(iulog,*)'FLDLST: History file ', t, ' contains ', nflds(t), ' fields' + write(iulog,*)'FLDLST: History stream ', t, ' contains ', nflds(t), ' fields' if (is_initfile(file_index=t)) then write(iulog,*) ' Write frequency: ',inithist,' (INITIAL CONDITIONS)' @@ -2632,23 +2998,23 @@ subroutine print_active_fldlst() end if - do f = 1, nflds(t) + do fld = 1, nflds(t) if (associated(hfile(t)%patches)) then num_patches = size(hfile(t)%patches) - fldname = strip_suffix(hfile(t)%hlist(f)%field%name) + fldname = strip_suffix(hfile(t)%hlist(fld)%field%name) do i = 1, num_patches - ff = (f-1)*num_patches + i + ffld = (fld-1)*num_patches + i fname_tmp = trim(fldname) call hfile(t)%patches(i)%field_name(fname_tmp) - write(iulog,9000) ff, fname_tmp, hfile(t)%hlist(f)%field%units, & - hfile(t)%hlist(f)%field%numlev, hfile(t)%hlist(f)%avgflag, & - trim(hfile(t)%hlist(f)%field%long_name) + write(iulog,9000) ffld, fname_tmp, hfile(t)%hlist(fld)%field%units, & + hfile(t)%hlist(fld)%field%numlev, hfile(t)%hlist(fld)%avgflag, & + trim(hfile(t)%hlist(fld)%field%long_name) end do else - fldname = hfile(t)%hlist(f)%field%name - write(iulog,9000) f, fldname, hfile(t)%hlist(f)%field%units, & - hfile(t)%hlist(f)%field%numlev, hfile(t)%hlist(f)%avgflag, & - trim(hfile(t)%hlist(f)%field%long_name) + fldname = hfile(t)%hlist(fld)%field%name + write(iulog,9000) fld, fldname, hfile(t)%hlist(fld)%field%units, & + hfile(t)%hlist(fld)%field%numlev, hfile(t)%hlist(fld)%avgflag, & + trim(hfile(t)%hlist(fld)%field%long_name) end if end do @@ -3155,12 +3521,13 @@ end function getflag !####################################################################### - subroutine list_index (list, name, index) + subroutine list_index (list, name, index, duplicate_error) ! ! Input arguments ! - character(len=*), intent(in) :: list(pflds) ! input list of names, possibly ":" delimited - character(len=max_fieldname_len), intent(in) :: name ! name to be searched for + character(len=*), intent(in) :: list(pflds) ! input list of names, possibly ":" delimited + character(len=*), intent(in) :: name ! name to be searched for + character(len=*), optional, intent(out) :: duplicate_error ! if present, check the flags and return an error if incompatible ! ! Output arguments ! @@ -3169,9 +3536,15 @@ subroutine list_index (list, name, index) ! Local workspace ! character(len=fieldname_len) :: listname ! input name with ":" stripped off. - integer f ! field index + character(len=fieldname_len) :: flag ! accumulate flag for field + character(len=fieldname_len) :: flag_comp ! accumulate flag to compare with previous entry + integer :: f ! field index index = 0 + if (present(duplicate_error)) then + duplicate_error = '' + end if + do f=1,pflds ! ! Only list items @@ -3179,8 +3552,21 @@ subroutine list_index (list, name, index) listname = getname (list(f)) if (listname == ' ') exit if (listname == name) then - index = f - exit + if (index /= 0 .and. present(duplicate_error)) then + ! This already exists in the field list - check the flag + flag_comp = getflag(list(f)) + if (trim(flag_comp) /= trim(flag)) then + write(duplicate_error,*) & + '"', trim(list(f)), '", "', trim(name), & + ':', trim(flag), '"' + return + ! No else - if the flags are identical, we're ok to return the first + ! instance + end if + else + index = f + flag = getflag(list(f)) + end if end if end do @@ -3245,12 +3631,13 @@ end subroutine subcol_field_avg_handler ! ! Local variables ! - integer :: t, f ! tape, field indices + integer :: t, fld ! tape, field indices character*1 :: avgflag ! averaging flag type (active_entry), pointer :: otape(:) ! Local history_tape pointer real(r8),pointer :: hbuf(:,:) ! history buffer + real(r8),pointer :: wbuf(:) ! area weights for field real(r8),pointer :: sbuf(:,:) ! variance buffer integer, pointer :: nacs(:) ! accumulation counter integer :: begdim2, enddim2, endi @@ -3281,27 +3668,30 @@ end subroutine subcol_field_avg_handler ! write(iulog,*)'fname_loc=',fname_loc do t = 1, ptapes if ( .not. masterlist(ff)%thisentry%actflag(t)) cycle - f = masterlist(ff)%thisentry%htapeindx(t) + fld = masterlist(ff)%thisentry%htapeindx(t) ! ! Update history buffer ! - flag_xyfill = otape(t)%hlist(f)%field%flag_xyfill - fillvalue = otape(t)%hlist(f)%field%fillvalue - avgflag = otape(t)%hlist(f)%avgflag - nacs => otape(t)%hlist(f)%nacs(:,c) - hbuf => otape(t)%hlist(f)%hbuf(:,:,c) - if (associated(tape(t)%hlist(f)%sbuf)) then - sbuf => otape(t)%hlist(f)%sbuf(:,:,c) + flag_xyfill = otape(t)%hlist(fld)%field%flag_xyfill + fillvalue = otape(t)%hlist(fld)%field%fillvalue + avgflag = otape(t)%hlist(fld)%avgflag + nacs => otape(t)%hlist(fld)%nacs(:,c) + hbuf => otape(t)%hlist(fld)%hbuf(:,:,c) + if (associated(tape(t)%hlist(fld)%wbuf)) then + wbuf => otape(t)%hlist(fld)%wbuf(:,c) + endif + if (associated(tape(t)%hlist(fld)%sbuf)) then + sbuf => otape(t)%hlist(fld)%sbuf(:,:,c) endif - dimind = otape(t)%hlist(f)%field%get_dims(c) + dimind = otape(t)%hlist(fld)%field%get_dims(c) ! See notes above about validity of avg_subcol_field - if (otape(t)%hlist(f)%field%is_subcol) then + if (otape(t)%hlist(fld)%field%is_subcol) then if (present(avg_subcol_field)) then call endrun('OUTFLD: Cannot average '//trim(fname)//', subcolumn output was requested in addfld') end if avg_subcols = .false. - else if (otape(t)%hlist(f)%field%decomp_type == phys_decomp) then + else if (otape(t)%hlist(fld)%field%decomp_type == phys_decomp) then if (present(avg_subcol_field)) then avg_subcols = avg_subcol_field else @@ -3315,15 +3705,15 @@ end subroutine subcol_field_avg_handler end if end if - begdim2 = otape(t)%hlist(f)%field%begdim2 - enddim2 = otape(t)%hlist(f)%field%enddim2 + begdim2 = otape(t)%hlist(fld)%field%begdim2 + enddim2 = otape(t)%hlist(fld)%field%enddim2 if (avg_subcols) then allocate(afield(pcols, begdim2:enddim2)) call subcol_field_avg_handler(idim, field, c, afield) ! Hack! Avoid duplicating select statement below call outfld(fname, afield, pcols, c) deallocate(afield) - else if (otape(t)%hlist(f)%field%is_subcol) then + else if (otape(t)%hlist(fld)%field%is_subcol) then ! We have to assume that using mdimnames (e.g., psubcols) is ! incompatible with the begdimx, enddimx usage (checked in addfld) ! Since psubcols is included in levels, take that out @@ -3363,6 +3753,10 @@ end subroutine subcol_field_avg_handler call hbuf_accum_add00z(hbuf, ufield, nacs, dimind, pcols, & flag_xyfill, fillvalue) + case ('N') ! Time average over nsteps + call hbuf_accum_add(hbuf, ufield, nacs, dimind, pcols, & + flag_xyfill, fillvalue) + case ('X') ! Maximum over time call hbuf_accum_max (hbuf, ufield, nacs, dimind, pcols, & flag_xyfill, fillvalue) @@ -3374,7 +3768,7 @@ end subroutine subcol_field_avg_handler case ('L') call hbuf_accum_addlcltime(hbuf, ufield, nacs, dimind, pcols, & flag_xyfill, fillvalue, c, & - otape(t)%hlist(f)%field%decomp_type, & + otape(t)%hlist(fld)%field%decomp_type, & lcltod_start(t), lcltod_stop(t)) case ('S') ! Standard deviation @@ -3401,6 +3795,10 @@ end subroutine subcol_field_avg_handler call hbuf_accum_add00z(hbuf, field, nacs, dimind, idim, & flag_xyfill, fillvalue) + case ('N') ! Time average over nsteps + call hbuf_accum_add (hbuf, field, nacs, dimind, idim, & + flag_xyfill, fillvalue) + case ('X') ! Maximum over time call hbuf_accum_max (hbuf, field, nacs, dimind, idim, & flag_xyfill, fillvalue) @@ -3412,7 +3810,7 @@ end subroutine subcol_field_avg_handler case ('L') call hbuf_accum_addlcltime(hbuf, field, nacs, dimind, idim, & flag_xyfill, fillvalue, c, & - otape(t)%hlist(f)%field%decomp_type, & + otape(t)%hlist(fld)%field%decomp_type, & lcltod_start(t), lcltod_stop(t)) case ('S') ! Standard deviation @@ -3432,7 +3830,7 @@ end subroutine outfld !####################################################################### - subroutine get_field_properties(fname, found, tape_out, ff_out, no_tape_check_in) + subroutine get_field_properties(fname, found, tape_out, ff_out, no_tape_check_in, f_out) implicit none ! @@ -3455,6 +3853,7 @@ subroutine get_field_properties(fname, found, tape_out, ff_out, no_tape_check_in type(active_entry), pointer, optional :: tape_out(:) integer, intent(out), optional :: ff_out logical, intent(in), optional :: no_tape_check_in + integer, intent(out), optional :: f_out(:) ! ! Local variables @@ -3483,6 +3882,9 @@ subroutine get_field_properties(fname, found, tape_out, ff_out, no_tape_check_in if (present(ff_out)) then ff_out = -1 end if + if (present(f_out)) then + f_out = -1 + end if ! ! If ( ff < 0 ), the field is not defined on the masterlist. This check @@ -3516,8 +3918,12 @@ subroutine get_field_properties(fname, found, tape_out, ff_out, no_tape_check_in if (present(ff_out)) then ff_out = ff end if - ! We found the info so we are done with the loop - exit + if (present(f_out)) then + f_out(t) = masterlist(ff)%thisentry%htapeindx(t) + else + ! only need to loop through all ptapes if f_out present + exit + end if end if end do @@ -3599,7 +4005,7 @@ subroutine h_inquire (t) ! ! Local workspace ! - integer :: f ! field index + integer :: f, fld ! file, field index integer :: ierr integer :: i integer :: num_patches @@ -3612,101 +4018,120 @@ subroutine h_inquire (t) ! tape => history_tape - - ! ! Create variables for model timing and header information ! - if(.not. is_satfile(t)) then - ierr=pio_inq_varid (tape(t)%File,'ndcur ', tape(t)%ndcurid) - ierr=pio_inq_varid (tape(t)%File,'nscur ', tape(t)%nscurid) - ierr=pio_inq_varid (tape(t)%File,'nsteph ', tape(t)%nstephid) - - ierr=pio_inq_varid (tape(t)%File,'time_bnds', tape(t)%tbndid) - ierr=pio_inq_varid (tape(t)%File,'date_written',tape(t)%date_writtenid) - ierr=pio_inq_varid (tape(t)%File,'time_written',tape(t)%time_writtenid) + do f = 1, maxsplitfiles + if (.not. pio_file_is_open(tape(t)%Files(f))) then + cycle + end if + if(.not. is_satfile(t)) then + if (f == instantaneous_file_index) then + ierr=pio_inq_varid (tape(t)%Files(f),'ndcur ', tape(t)%ndcurid) + ierr=pio_inq_varid (tape(t)%Files(f),'nscur ', tape(t)%nscurid) + ierr=pio_inq_varid (tape(t)%Files(f),'nsteph ', tape(t)%nstephid) + end if + if (f == accumulated_file_index) then + ierr=pio_inq_varid (tape(t)%Files(f),'time_bounds', tape(t)%tbndid) + end if + ierr=pio_inq_varid (tape(t)%Files(f),'date_written', tape(t)%date_writtenid) + ierr=pio_inq_varid (tape(t)%Files(f),'time_written', tape(t)%time_writtenid) #if ( defined BFB_CAM_SCAM_IOP ) - ierr=pio_inq_varid (tape(t)%File,'tsec ',tape(t)%tsecid) - ierr=pio_inq_varid (tape(t)%File,'bdate ',tape(t)%bdateid) + ierr=pio_inq_varid (tape(t)%Files(f),'tsec ',tape(t)%tsecid) + ierr=pio_inq_varid (tape(t)%Files(f),'bdate ',tape(t)%bdateid) #endif - if (.not. is_initfile(file_index=t) ) then - ! Don't write the GHG/Solar forcing data to the IC file. It is never - ! read from that file so it's confusing to have it there. - ierr=pio_inq_varid (tape(t)%File,'co2vmr ', tape(t)%co2vmrid) - ierr=pio_inq_varid (tape(t)%File,'ch4vmr ', tape(t)%ch4vmrid) - ierr=pio_inq_varid (tape(t)%File,'n2ovmr ', tape(t)%n2ovmrid) - ierr=pio_inq_varid (tape(t)%File,'f11vmr ', tape(t)%f11vmrid) - ierr=pio_inq_varid (tape(t)%File,'f12vmr ', tape(t)%f12vmrid) - ierr=pio_inq_varid (tape(t)%File,'sol_tsi ', tape(t)%sol_tsiid) - if (solar_parms_on) then - ierr=pio_inq_varid (tape(t)%File,'f107 ', tape(t)%f107id) - ierr=pio_inq_varid (tape(t)%File,'f107a ', tape(t)%f107aid) - ierr=pio_inq_varid (tape(t)%File,'f107p ', tape(t)%f107pid) - ierr=pio_inq_varid (tape(t)%File,'kp ', tape(t)%kpid) - ierr=pio_inq_varid (tape(t)%File,'ap ', tape(t)%apid) - endif - if (solar_wind_on) then - ierr=pio_inq_varid (tape(t)%File,'byimf', tape(t)%byimfid) - ierr=pio_inq_varid (tape(t)%File,'bzimf', tape(t)%bzimfid) - ierr=pio_inq_varid (tape(t)%File,'swvel', tape(t)%swvelid) - ierr=pio_inq_varid (tape(t)%File,'swden', tape(t)%swdenid) - endif - if (epot_active) then - ierr=pio_inq_varid (tape(t)%File,'colat_crit1', tape(t)%colat_crit1_id) - ierr=pio_inq_varid (tape(t)%File,'colat_crit2', tape(t)%colat_crit2_id) - endif - end if - end if - ierr=pio_inq_varid (tape(t)%File,'date ', tape(t)%dateid) - ierr=pio_inq_varid (tape(t)%File,'datesec ', tape(t)%datesecid) - ierr=pio_inq_varid (tape(t)%File,'time ', tape(t)%timeid) - + if (.not. is_initfile(file_index=t) .and. f == instantaneous_file_index) then + ! Don't write the GHG/Solar forcing data to the IC file. It is never + ! read from that file so it's confusing to have it there. + ! Only write the GHG/Solar forcing data to the instantaneous file + ierr=pio_inq_varid (tape(t)%Files(f),'co2vmr ', tape(t)%co2vmrid) + ierr=pio_inq_varid (tape(t)%Files(f),'ch4vmr ', tape(t)%ch4vmrid) + ierr=pio_inq_varid (tape(t)%Files(f),'n2ovmr ', tape(t)%n2ovmrid) + ierr=pio_inq_varid (tape(t)%Files(f),'f11vmr ', tape(t)%f11vmrid) + ierr=pio_inq_varid (tape(t)%Files(f),'f12vmr ', tape(t)%f12vmrid) + ierr=pio_inq_varid (tape(t)%Files(f),'sol_tsi ', tape(t)%sol_tsiid) + if (solar_parms_on) then + ierr=pio_inq_varid (tape(t)%Files(f),'f107 ', tape(t)%f107id) + ierr=pio_inq_varid (tape(t)%Files(f),'f107a ', tape(t)%f107aid) + ierr=pio_inq_varid (tape(t)%Files(f),'f107p ', tape(t)%f107pid) + ierr=pio_inq_varid (tape(t)%Files(f),'kp ', tape(t)%kpid) + ierr=pio_inq_varid (tape(t)%Files(f),'ap ', tape(t)%apid) + endif + if (solar_wind_on) then + ierr=pio_inq_varid (tape(t)%Files(f),'byimf', tape(t)%byimfid) + ierr=pio_inq_varid (tape(t)%Files(f),'bzimf', tape(t)%bzimfid) + ierr=pio_inq_varid (tape(t)%Files(f),'swvel', tape(t)%swvelid) + ierr=pio_inq_varid (tape(t)%Files(f),'swden', tape(t)%swdenid) + endif + if (epot_active) then + ierr=pio_inq_varid (tape(t)%Files(f),'colat_crit1', tape(t)%colat_crit1_id) + ierr=pio_inq_varid (tape(t)%Files(f),'colat_crit2', tape(t)%colat_crit2_id) + endif + end if + end if + ierr=pio_inq_varid (tape(t)%Files(f),'date ', tape(t)%dateid) + ierr=pio_inq_varid (tape(t)%Files(f),'datesec ', tape(t)%datesecid) + ierr=pio_inq_varid (tape(t)%Files(f),'time ', tape(t)%timeid) + + ! + ! Obtain variable name from ID which was read from restart file + ! + do fld=1,nflds(t) + if (f == accumulated_file_index) then + ! this is the accumulated file - skip instantaneous fields + if (tape(t)%hlist(fld)%avgflag == 'I') then + cycle + end if + else + ! this is the instantaneous file - skip accumulated fields + if (tape(t)%hlist(fld)%avgflag /= 'I') then + cycle + end if + end if - ! - ! Obtain variable name from ID which was read from restart file - ! - do f=1,nflds(t) - if(.not. associated(tape(t)%hlist(f)%varid)) then - if (associated(tape(t)%patches)) then - allocate(tape(t)%hlist(f)%varid(size(tape(t)%patches))) - else - allocate(tape(t)%hlist(f)%varid(1)) - end if - end if - ! - ! If this field will be put out as columns then get column names for field - ! - if (associated(tape(t)%patches)) then - num_patches = size(tape(t)%patches) - fldname = strip_suffix(tape(t)%hlist(f)%field%name) - do i = 1, num_patches - fname_tmp = trim(fldname) - call tape(t)%patches(i)%field_name(fname_tmp) - ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp), tape(t)%hlist(f)%varid(i)) - call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting ID for '//trim(fname_tmp)) - ierr = pio_get_att(tape(t)%File, tape(t)%hlist(f)%varid(i), 'basename', basename) - call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting basename for '//trim(fname_tmp)) - if (trim(fldname) /= trim(basename)) then - call endrun('H_INQUIRE: basename ('//trim(basename)//') does not match fldname ('//trim(fldname)//')') - end if - end do - else - fldname = tape(t)%hlist(f)%field%name - ierr = pio_inq_varid(tape(t)%File, trim(fldname), tape(t)%hlist(f)%varid(1)) - call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting ID for '//trim(fldname)) - end if - if(tape(t)%hlist(f)%field%numlev>1) then - ierr = pio_inq_attlen(tape(t)%File,tape(t)%hlist(f)%varid(1),'mdims', mdimsize) - if(.not. associated(tape(t)%hlist(f)%field%mdims)) then - allocate(tape(t)%hlist(f)%field%mdims(mdimsize)) - end if - ierr=pio_get_att(tape(t)%File,tape(t)%hlist(f)%varid(1),'mdims', & - tape(t)%hlist(f)%field%mdims(1:mdimsize)) - if(mdimsize>maxvarmdims) maxvarmdims=mdimsize - end if + if(.not. associated(tape(t)%hlist(fld)%varid)) then + if (associated(tape(t)%patches)) then + allocate(tape(t)%hlist(fld)%varid(size(tape(t)%patches))) + else + allocate(tape(t)%hlist(fld)%varid(1)) + end if + end if + ! + ! If this field will be put out as columns then get column names for field + ! + if (associated(tape(t)%patches)) then + num_patches = size(tape(t)%patches) + fldname = strip_suffix(tape(t)%hlist(fld)%field%name) + do i = 1, num_patches + fname_tmp = trim(fldname) + call tape(t)%patches(i)%field_name(fname_tmp) + ierr = pio_inq_varid(tape(t)%Files(f), trim(fname_tmp), tape(t)%hlist(fld)%varid(i)) + call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting ID for '//trim(fname_tmp)) + ierr = pio_get_att(tape(t)%Files(f), tape(t)%hlist(fld)%varid(i), 'basename', basename) + call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting basename for '//trim(fname_tmp)) + if (trim(fldname) /= trim(basename)) then + call endrun('H_INQUIRE: basename ('//trim(basename)//') does not match fldname ('//trim(fldname)//')') + end if + end do + else + fldname = tape(t)%hlist(fld)%field%name + ierr = pio_inq_varid(tape(t)%Files(f), trim(fldname), tape(t)%hlist(fld)%varid(1)) + call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting ID for '//trim(fldname)) + end if + if(tape(t)%hlist(fld)%field%numlev>1) then + ierr = pio_inq_attlen(tape(t)%Files(f),tape(t)%hlist(fld)%varid(1),'mdims', mdimsize) + if(.not. associated(tape(t)%hlist(fld)%field%mdims)) then + allocate(tape(t)%hlist(fld)%field%mdims(mdimsize)) + end if + ierr=pio_get_att(tape(t)%Files(f),tape(t)%hlist(fld)%varid(1),'mdims', & + tape(t)%hlist(fld)%field%mdims(1:mdimsize)) + if(mdimsize > int(maxvarmdims, kind=pio_offset_kind)) then + maxvarmdims = int(mdimsize) + end if + end if + end do end do - if(masterproc) then write(iulog,*)'H_INQUIRE: Successfully opened netcdf file ' end if @@ -3800,15 +4225,16 @@ subroutine h_override (t) type(master_entry), pointer :: listentry - avgflg = avgflag_pertape(t) - listentry=>masterlinkedlist do while(associated(listentry)) - call AvgflagToString(avgflg, listentry%time_op(t)) - listentry%avgflag(t) = avgflag_pertape(t) - listentry=>listentry%next_entry + ! Budgets require flag to be N, dont override + if (listentry%avgflag(t) /= 'N' ) then + call AvgflagToString(avgflg, listentry%time_op(t)) + listentry%avgflag(t) = avgflag_pertape(t) + end if + listentry=>listentry%next_entry end do end subroutine h_override @@ -3824,7 +4250,7 @@ subroutine h_define (t, restart) ! Method: Issue the required netcdf wrapper calls to define the history file contents ! !----------------------------------------------------------------------- - use phys_control, only: phys_getopts + use phys_control, only: phys_getopts use cam_grid_support, only: cam_grid_header_info_t use cam_grid_support, only: cam_grid_write_attr, cam_grid_write_var use time_manager, only: get_step_size, get_ref_date, timemgr_get_calendar_cf @@ -3843,9 +4269,9 @@ subroutine h_define (t, restart) ! ! Local workspace ! - integer :: i, j ! longitude, latitude indices + integer :: i, j, f ! longitude, latitude, file indices integer :: grd ! indices for looping through grids - integer :: f ! field index + integer :: fld ! field index integer :: ncreal ! real data type for output integer :: dtime ! timestep size integer :: sec_nhtfrq ! nhtfrq converted to seconds @@ -3900,6 +4326,7 @@ subroutine h_define (t, restart) character(len=32) :: cam_take_snapshot_before character(len=32) :: cam_take_snapshot_after + call phys_getopts(cam_take_snapshot_before_out= cam_take_snapshot_before, & cam_take_snapshot_after_out = cam_take_snapshot_after, & cam_snapshot_before_num_out = cam_snapshot_before_num, & @@ -3910,34 +4337,50 @@ subroutine h_define (t, restart) if(masterproc) write(iulog,*)'Opening netcdf history restart file ', trim(hrestpath(t)) else tape => history_tape - if(masterproc) write(iulog,*)'Opening netcdf history file ', trim(nhfil(t)) + if(masterproc) then + if (hfile_accum(t)) then + ! We have an accumulated file in addition to the instantaneous + write(iulog,*)'Opening netcdf history files ', trim(nhfil(t,accumulated_file_index)), & + ' ', trim(nhfil(t,instantaneous_file_index)) + else + ! We just have the instantaneous file + write(iulog,*)'Opening instantaneous netcdf history file ', trim(nhfil(t,instantaneous_file_index)) + end if + end if end if amode = PIO_CLOBBER if(restart) then - call cam_pio_createfile (tape(t)%File, hrestpath(t), amode) + call cam_pio_createfile (tape(t)%Files(restart_file_index), hrestpath(t), amode) + else if (is_initfile(file_index=t) .or. is_satfile(t)) then + call cam_pio_createfile (tape(t)%Files(sat_file_index), nhfil(t,sat_file_index), amode) else - call cam_pio_createfile (tape(t)%File, nhfil(t), amode) + ! figure out how many history files to generate for this tape + ! Always create the instantaneous file + call cam_pio_createfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), amode) + if (hfile_accum(t)) then + ! Conditionally create the accumulated file + call cam_pio_createfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), amode) + end if end if if(is_satfile(t)) then interpolate = .false. ! !!XXgoldyXX: Do we ever want to support this? patch_output = .false. - call cam_pio_def_dim(tape(t)%File, 'ncol', pio_unlimited, timdim) - call cam_pio_def_dim(tape(t)%File, 'nbnd', 2, bnddim) + call cam_pio_def_dim(tape(t)%Files(sat_file_index), 'ncol', pio_unlimited, timdim) + call cam_pio_def_dim(tape(t)%Files(sat_file_index), 'nbnd', 2, bnddim) allocate(latvar(1), lonvar(1)) allocate(latvar(1)%vd, lonvar(1)%vd) - call cam_pio_def_var(tape(t)%File, 'lat', pio_double, (/timdim/), & + call cam_pio_def_var(tape(t)%Files(sat_file_index), 'lat', pio_double, (/timdim/), & latvar(1)%vd) - ierr=pio_put_att (tape(t)%File, latvar(1)%vd, 'long_name', 'latitude') - ierr=pio_put_att (tape(t)%File, latvar(1)%vd, 'units', 'degrees_north') + ierr=pio_put_att (tape(t)%Files(sat_file_index), latvar(1)%vd, 'long_name', 'latitude') + ierr=pio_put_att (tape(t)%Files(sat_file_index), latvar(1)%vd, 'units', 'degrees_north') - call cam_pio_def_var(tape(t)%File, 'lon', pio_double, (/timdim/), & + call cam_pio_def_var(tape(t)%Files(sat_file_index), 'lon', pio_double, (/timdim/), & lonvar(1)%vd) - ierr=pio_put_att (tape(t)%File, lonvar(1)%vd,'long_name','longitude') - ierr=pio_put_att (tape(t)%File, lonvar(1)%vd,'units','degrees_east') - + ierr=pio_put_att (tape(t)%Files(sat_file_index), lonvar(1)%vd,'long_name','longitude') + ierr=pio_put_att (tape(t)%Files(sat_file_index), lonvar(1)%vd,'units','degrees_east') else ! ! Setup netcdf file - create the dimensions of lat,lon,time,level @@ -3950,7 +4393,11 @@ subroutine h_define (t, restart) ! Interpolation is special in that we ignore the native grids if(interpolate) then allocate(header_info(1)) - call cam_grid_write_attr(tape(t)%File, interpolate_info(t)%grid_id, header_info(1)) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_grid_write_attr(tape(t)%Files(f), interpolate_info(t)%grid_id, header_info(1), file_index=f) + end if + end do else if (patch_output) then ! We are doing patch (column) output if (allocated(header_info)) then @@ -3958,91 +4405,42 @@ subroutine h_define (t, restart) call endrun('H_DEFINE: header_info should not be allocated for patch output') end if do i = 1, size(tape(t)%patches) - call tape(t)%patches(i)%write_attrs(tape(t)%File) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call tape(t)%patches(i)%write_attrs(tape(t)%Files(f)) + end if + end do end do else allocate(header_info(size(tape(t)%grid_ids))) do i = 1, size(tape(t)%grid_ids) - call cam_grid_write_attr(tape(t)%File, tape(t)%grid_ids(i), header_info(i)) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_grid_write_attr(tape(t)%Files(f), tape(t)%grid_ids(i), header_info(i), file_index=f) + end if + end do end do end if ! interpolate - ! Define the unlimited time dim - call cam_pio_def_dim(tape(t)%File, 'time', pio_unlimited, timdim) - call cam_pio_def_dim(tape(t)%File, 'nbnd', 2, bnddim, existOK=.true.) - call cam_pio_def_dim(tape(t)%File, 'chars', 8, chardim) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_pio_def_dim(tape(t)%Files(f), 'time', pio_unlimited, timdim) + call cam_pio_def_dim(tape(t)%Files(f), 'nbnd', 2, bnddim, existOK=.true.) + call cam_pio_def_dim(tape(t)%Files(f), 'chars', 8, chardim) + end if + end do end if ! is satfile - ! Store snapshot location - if (t == cam_snapshot_before_num) then - ierr=pio_put_att(tape(t)%File, PIO_GLOBAL, 'cam_snapshot_before', & - trim(cam_take_snapshot_before)) - end if - if (t == cam_snapshot_after_num) then - ierr=pio_put_att(tape(t)%File, PIO_GLOBAL, 'cam_snapshot_after', & - trim(cam_take_snapshot_after)) - end if - - ! Populate the history coordinate (well, mdims anyway) attributes - ! This routine also allocates the mdimids array - call write_hist_coord_attrs(tape(t)%File, bnddim, mdimids, restart) - call get_ref_date(yr, mon, day, nbsec) nbdate = yr*10000 + mon*100 + day - ierr=pio_def_var (tape(t)%File,'time',pio_double,(/timdim/),tape(t)%timeid) - ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'long_name', 'time') - str = 'days since ' // date2yyyymmdd(nbdate) // ' ' // sec2hms(nbsec) - ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'units', trim(str)) - calendar = timemgr_get_calendar_cf() - ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'calendar', trim(calendar)) - - - ierr=pio_def_var (tape(t)%File,'date ',pio_int,(/timdim/),tape(t)%dateid) - str = 'current date (YYYYMMDD)' - ierr=pio_put_att (tape(t)%File, tape(t)%dateid, 'long_name', trim(str)) - - - ierr=pio_def_var (tape(t)%File,'datesec ',pio_int,(/timdim/), tape(t)%datesecid) - str = 'current seconds of current date' - ierr=pio_put_att (tape(t)%File, tape(t)%datesecid, 'long_name', trim(str)) - - ! - ! Character header information - ! - str = 'CF-1.0' - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'Conventions', trim(str)) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'source', 'CAM') -#if ( defined BFB_CAM_SCAM_IOP ) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'CAM_GENERATED_FORCING','create SCAM IOP dataset') -#endif - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'case',caseid) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'logname',logname) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'host', host) - -! Put these back in when they are filled properly -! ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'title',ctitle) -! ierr= pio_put_att (tape(t)%File, PIO_GLOBAL, 'Version', & -! '$Name$') -! ierr= pio_put_att (tape(t)%File, PIO_GLOBAL, 'revision_Id', & -! '$Id$') - - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'initial_file', ncdata) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'topography_file', bnd_topo) - if (len_trim(model_doi_url) > 0) then - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'model_doi_url', model_doi_url) - end if - ! Determine what time period frequency is being output for each file ! Note that nhtfrq is now in timesteps - sec_nhtfrq = nhtfrq(t) - ! If nhtfrq is in hours, convert to seconds if (nhtfrq(t) < 0) then sec_nhtfrq = abs(nhtfrq(t))*3600 end if - dtime = get_step_size() if (sec_nhtfrq == 0) then !month time_per_freq = 'month_1' @@ -4056,413 +4454,538 @@ subroutine h_define (t, restart) write(time_per_freq,999) 'second_',sec_nhtfrq*dtime end if 999 format(a,i0) + do f = 1, maxsplitfiles + if (.not. pio_file_is_open(tape(t)%Files(f))) then + cycle + end if + ! Store snapshot location + if (t == cam_snapshot_before_num) then + ierr=pio_put_att(tape(t)%Files(f), PIO_GLOBAL, 'cam_snapshot_before', & + trim(cam_take_snapshot_before)) + end if + if (t == cam_snapshot_after_num) then + ierr=pio_put_att(tape(t)%Files(f), PIO_GLOBAL, 'cam_snapshot_after', & + trim(cam_take_snapshot_after)) + end if - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'time_period_freq', trim(time_per_freq)) - - if(.not. is_satfile(t)) then + ! Populate the history coordinate (well, mdims anyway) attributes + ! This routine also allocates the mdimids array + call write_hist_coord_attrs(tape(t)%Files(f), bnddim, mdimids, restart) - ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'bounds', 'time_bnds') + ierr=pio_def_var (tape(t)%Files(f),'time',pio_double,(/timdim/),tape(t)%timeid) - ierr=pio_def_var (tape(t)%File,'time_bnds',pio_double,(/bnddim,timdim/),tape(t)%tbndid) - ierr=pio_put_att (tape(t)%File, tape(t)%tbndid, 'long_name', 'time interval endpoints') - ! - ! Character - ! - dimenchar(1) = chardim - dimenchar(2) = timdim - ierr=pio_def_var (tape(t)%File,'date_written',PIO_CHAR,dimenchar, tape(t)%date_writtenid) - ierr=pio_def_var (tape(t)%File,'time_written',PIO_CHAR,dimenchar, tape(t)%time_writtenid) - ! - ! Integer Header - ! + ierr=pio_put_att (tape(t)%Files(f), tape(t)%timeid, 'long_name', 'time') + str = 'days since ' // date2yyyymmdd(nbdate) // ' ' // sec2hms(nbsec) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%timeid, 'units', trim(str)) - ierr=pio_def_var (tape(t)%File,'ndbase',PIO_INT,tape(t)%ndbaseid) - str = 'base day' - ierr=pio_put_att (tape(t)%File, tape(t)%ndbaseid, 'long_name', trim(str)) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%timeid, 'calendar', trim(calendar)) - ierr=pio_def_var (tape(t)%File,'nsbase',PIO_INT,tape(t)%nsbaseid) - str = 'seconds of base day' - ierr=pio_put_att (tape(t)%File, tape(t)%nsbaseid, 'long_name', trim(str)) + ierr=pio_def_var (tape(t)%Files(f),'date ',pio_int,(/timdim/),tape(t)%dateid) + str = 'current date (YYYYMMDD)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%dateid, 'long_name', trim(str)) - ierr=pio_def_var (tape(t)%File,'nbdate',PIO_INT,tape(t)%nbdateid) - str = 'base date (YYYYMMDD)' - ierr=pio_put_att (tape(t)%File, tape(t)%nbdateid, 'long_name', trim(str)) + ierr=pio_def_var (tape(t)%Files(f),'datesec ',pio_int,(/timdim/), tape(t)%datesecid) + str = 'current seconds of current date' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%datesecid, 'long_name', trim(str)) + ! + ! Character header information + ! + str = 'CF-1.0' + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'Conventions', trim(str)) + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'source', 'CAM') #if ( defined BFB_CAM_SCAM_IOP ) - ierr=pio_def_var (tape(t)%File,'bdate',PIO_INT,tape(t)%bdateid) - str = 'base date (YYYYMMDD)' - ierr=pio_put_att (tape(t)%File, tape(t)%bdateid, 'long_name', trim(str)) + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'CAM_GENERATED_FORCING','create SCAM IOP dataset') #endif - ierr=pio_def_var (tape(t)%File,'nbsec',PIO_INT,tape(t)%nbsecid) - str = 'seconds of base date' - ierr=pio_put_att (tape(t)%File, tape(t)%nbsecid, 'long_name', trim(str)) + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'case',caseid) + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'logname',logname) + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'host', host) + + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'initial_file', ncdata) + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'topography_file', bnd_topo) + if (len_trim(model_doi_url) > 0) then + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'model_doi_url', model_doi_url) + end if - ierr=pio_def_var (tape(t)%File,'mdt',PIO_INT,tape(t)%mdtid) - ierr=pio_put_att (tape(t)%File, tape(t)%mdtid, 'long_name', 'timestep') - ierr=pio_put_att (tape(t)%File, tape(t)%mdtid, 'units', 's') + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'time_period_freq', trim(time_per_freq)) - ! - ! Create variables for model timing and header information - ! + if(.not. is_satfile(t)) then - ierr=pio_def_var (tape(t)%File,'ndcur ',pio_int,(/timdim/),tape(t)%ndcurid) - str = 'current day (from base day)' - ierr=pio_put_att (tape(t)%File, tape(t)%ndcurid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'nscur ',pio_int,(/timdim/),tape(t)%nscurid) - str = 'current seconds of current day' - ierr=pio_put_att (tape(t)%File, tape(t)%nscurid, 'long_name', trim(str)) - - - if (.not. is_initfile(file_index=t)) then - ! Don't write the GHG/Solar forcing data to the IC file. - ierr=pio_def_var (tape(t)%File,'co2vmr ',pio_double,(/timdim/),tape(t)%co2vmrid) - str = 'co2 volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%co2vmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'ch4vmr ',pio_double,(/timdim/),tape(t)%ch4vmrid) - str = 'ch4 volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%ch4vmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'n2ovmr ',pio_double,(/timdim/),tape(t)%n2ovmrid) - str = 'n2o volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%n2ovmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'f11vmr ',pio_double,(/timdim/),tape(t)%f11vmrid) - str = 'f11 volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%f11vmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'f12vmr ',pio_double,(/timdim/),tape(t)%f12vmrid) - str = 'f12 volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%f12vmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'sol_tsi ',pio_double,(/timdim/),tape(t)%sol_tsiid) - str = 'total solar irradiance' - ierr=pio_put_att (tape(t)%File, tape(t)%sol_tsiid, 'long_name', trim(str)) - str = 'W/m2' - ierr=pio_put_att (tape(t)%File, tape(t)%sol_tsiid, 'units', trim(str)) - - if (solar_parms_on) then - ! solar / geomagetic activity indices... - ierr=pio_def_var (tape(t)%File,'f107',pio_double,(/timdim/),tape(t)%f107id) - str = '10.7 cm solar radio flux (F10.7)' - ierr=pio_put_att (tape(t)%File, tape(t)%f107id, 'long_name', trim(str)) - str = '10^-22 W m^-2 Hz^-1' - ierr=pio_put_att (tape(t)%File, tape(t)%f107id, 'units', trim(str)) - - ierr=pio_def_var (tape(t)%File,'f107a',pio_double,(/timdim/),tape(t)%f107aid) - str = '81-day centered mean of 10.7 cm solar radio flux (F10.7)' - ierr=pio_put_att (tape(t)%File, tape(t)%f107aid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'f107p',pio_double,(/timdim/),tape(t)%f107pid) - str = 'Pervious day 10.7 cm solar radio flux (F10.7)' - ierr=pio_put_att (tape(t)%File, tape(t)%f107pid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'kp',pio_double,(/timdim/),tape(t)%kpid) - str = 'Daily planetary K geomagnetic index' - ierr=pio_put_att (tape(t)%File, tape(t)%kpid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'ap',pio_double,(/timdim/),tape(t)%apid) - str = 'Daily planetary A geomagnetic index' - ierr=pio_put_att (tape(t)%File, tape(t)%apid, 'long_name', trim(str)) - endif - if (solar_wind_on) then - - ierr=pio_def_var (tape(t)%File,'byimf',pio_double,(/timdim/),tape(t)%byimfid) - str = 'Y component of the interplanetary magnetic field' - ierr=pio_put_att (tape(t)%File, tape(t)%byimfid, 'long_name', trim(str)) - str = 'nT' - ierr=pio_put_att (tape(t)%File, tape(t)%byimfid, 'units', trim(str)) - - ierr=pio_def_var (tape(t)%File,'bzimf',pio_double,(/timdim/),tape(t)%bzimfid) - str = 'Z component of the interplanetary magnetic field' - ierr=pio_put_att (tape(t)%File, tape(t)%bzimfid, 'long_name', trim(str)) - str = 'nT' - ierr=pio_put_att (tape(t)%File, tape(t)%bzimfid, 'units', trim(str)) - - ierr=pio_def_var (tape(t)%File,'swvel',pio_double,(/timdim/),tape(t)%swvelid) - str = 'Solar wind speed' - ierr=pio_put_att (tape(t)%File, tape(t)%swvelid, 'long_name', trim(str)) - str = 'km/sec' - ierr=pio_put_att (tape(t)%File, tape(t)%swvelid, 'units', trim(str)) - - ierr=pio_def_var (tape(t)%File,'swden',pio_double,(/timdim/),tape(t)%swdenid) - str = 'Solar wind ion number density' - ierr=pio_put_att (tape(t)%File, tape(t)%swdenid, 'long_name', trim(str)) - str = 'cm-3' - ierr=pio_put_att (tape(t)%File, tape(t)%swdenid, 'units', trim(str)) + ! + ! Character + ! + dimenchar(1) = chardim + dimenchar(2) = timdim + ierr=pio_def_var (tape(t)%Files(f),'date_written',PIO_CHAR,dimenchar, tape(t)%date_writtenid) + ierr=pio_def_var (tape(t)%Files(f),'time_written',PIO_CHAR,dimenchar, tape(t)%time_writtenid) + ! + ! Integer Header + ! - endif - if (epot_active) then - ierr=pio_def_var (tape(t)%File,'colat_crit1',pio_double,(/timdim/),tape(t)%colat_crit1_id) - ierr=pio_put_att (tape(t)%File, tape(t)%colat_crit1_id, 'long_name', & - 'First co-latitude of electro-potential critical angle') - ierr=pio_put_att (tape(t)%File, tape(t)%colat_crit1_id, 'units', 'degrees') - - ierr=pio_def_var (tape(t)%File,'colat_crit2',pio_double,(/timdim/),tape(t)%colat_crit2_id) - ierr=pio_put_att (tape(t)%File, tape(t)%colat_crit2_id, 'long_name',& - 'Second co-latitude of electro-potential critical angle') - ierr=pio_put_att (tape(t)%File, tape(t)%colat_crit2_id, 'units', 'degrees') - endif - end if + ierr=pio_def_var (tape(t)%Files(f),'ndbase',PIO_INT,tape(t)%ndbaseid) + str = 'base day' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%ndbaseid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'nsbase',PIO_INT,tape(t)%nsbaseid) + str = 'seconds of base day' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%nsbaseid, 'long_name', trim(str)) + ierr=pio_def_var (tape(t)%Files(f),'nbdate',PIO_INT,tape(t)%nbdateid) + str = 'base date (YYYYMMDD)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%nbdateid, 'long_name', trim(str)) #if ( defined BFB_CAM_SCAM_IOP ) - ierr=pio_def_var (tape(t)%File,'tsec ',pio_int,(/timdim/), tape(t)%tsecid) - str = 'current seconds of current date needed for scam' - ierr=pio_put_att (tape(t)%File, tape(t)%tsecid, 'long_name', trim(str)) + ierr=pio_def_var (tape(t)%Files(f),'bdate',PIO_INT,tape(t)%bdateid) + str = 'base date (YYYYMMDD)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%bdateid, 'long_name', trim(str)) #endif - ierr=pio_def_var (tape(t)%File,'nsteph ',pio_int,(/timdim/),tape(t)%nstephid) - str = 'current timestep' - ierr=pio_put_att (tape(t)%File, tape(t)%nstephid, 'long_name', trim(str)) - end if ! .not. is_satfile - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! Create variables and attributes for field list - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - do f = 1, nflds(t) - - !! Collect some field properties - call AvgflagToString(tape(t)%hlist(f)%avgflag, tape(t)%hlist(f)%time_op) - - if ((tape(t)%hlist(f)%hwrt_prec == 8) .or. restart) then - ncreal = pio_double - else - ncreal = pio_real - end if - - if(associated(tape(t)%hlist(f)%field%mdims)) then - mdims => tape(t)%hlist(f)%field%mdims - mdimsize = size(mdims) - else if(tape(t)%hlist(f)%field%numlev > 1) then - call endrun('mdims not defined for variable '//trim(tape(t)%hlist(f)%field%name)) - else - mdimsize=0 - end if + ierr=pio_def_var (tape(t)%Files(f),'nbsec',PIO_INT,tape(t)%nbsecid) + str = 'seconds of base date' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%nbsecid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'mdt',PIO_INT,tape(t)%mdtid) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%mdtid, 'long_name', 'timestep') + ierr=pio_put_att (tape(t)%Files(f), tape(t)%mdtid, 'units', 's') + + ! + ! Create variables for model timing and header information + ! + if (f == instantaneous_file_index) then + ierr=pio_def_var (tape(t)%Files(f),'ndcur ',pio_int,(/timdim/),tape(t)%ndcurid) + str = 'current day (from base day)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%ndcurid, 'long_name', trim(str)) + ierr=pio_def_var (tape(t)%Files(f),'nscur ',pio_int,(/timdim/),tape(t)%nscurid) + str = 'current seconds of current day' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%nscurid, 'long_name', trim(str)) + end if - ! num_patches will loop through the number of patches (or just one - ! for the whole grid) for this field for this tape - if (patch_output) then - num_patches = size(tape(t)%patches) - else - num_patches = 1 - end if - if(.not.associated(tape(t)%hlist(f)%varid)) then - allocate(tape(t)%hlist(f)%varid(num_patches)) - end if - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) - - if(is_satfile(t)) then - num_hdims=0 - nfils(t)=1 - call sat_hist_define(tape(t)%File) - else if (interpolate) then - ! Interpolate can't use normal grid code since we are forcing fields - ! to use interpolate decomp - if (.not. allocated(header_info)) then - ! Safety check - call endrun('h_define: header_info not allocated') - end if - num_hdims = 2 - do i = 1, num_hdims - dimindex(i) = header_info(1)%get_hdimid(i) - nacsdims(i) = header_info(1)%get_hdimid(i) - end do - else if (patch_output) then - ! All patches for this variable should be on the same grid - num_hdims = tape(t)%patches(1)%num_hdims(tape(t)%hlist(f)%field%decomp_type) - else - ! Normal grid output - ! Find appropriate grid in header_info - if (.not. allocated(header_info)) then - ! Safety check - call endrun('h_define: header_info not allocated') - end if - grd = -1 - do i = 1, size(header_info) - if (header_info(i)%get_gridid() == tape(t)%hlist(f)%field%decomp_type) then - grd = i - exit - end if - end do - if (grd < 0) then - write(errormsg, '(a,i0,2a)') 'grid, ',tape(t)%hlist(f)%field%decomp_type,', not found for ',trim(fname_tmp) - call endrun('H_DEFINE: '//errormsg) - end if - num_hdims = header_info(grd)%num_hdims() - do i = 1, num_hdims - dimindex(i) = header_info(grd)%get_hdimid(i) - nacsdims(i) = header_info(grd)%get_hdimid(i) - end do - end if ! is_satfile + if (.not. is_initfile(file_index=t) .and. f == instantaneous_file_index) then + ! Don't write the GHG/Solar forcing data to the IC file. + ! Only write the GHG/Solar forcing data to the instantaneous file + ierr=pio_def_var (tape(t)%Files(f),'co2vmr ',pio_double,(/timdim/),tape(t)%co2vmrid) + str = 'co2 volume mixing ratio' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%co2vmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'ch4vmr ',pio_double,(/timdim/),tape(t)%ch4vmrid) + str = 'ch4 volume mixing ratio' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%ch4vmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'n2ovmr ',pio_double,(/timdim/),tape(t)%n2ovmrid) + str = 'n2o volume mixing ratio' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%n2ovmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'f11vmr ',pio_double,(/timdim/),tape(t)%f11vmrid) + str = 'f11 volume mixing ratio' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%f11vmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'f12vmr ',pio_double,(/timdim/),tape(t)%f12vmrid) + str = 'f12 volume mixing ratio' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%f12vmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'sol_tsi ',pio_double,(/timdim/),tape(t)%sol_tsiid) + str = 'total solar irradiance' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%sol_tsiid, 'long_name', trim(str)) + str = 'W/m2' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%sol_tsiid, 'units', trim(str)) + + if (solar_parms_on) then + ! solar / geomagnetic activity indices... + ierr=pio_def_var (tape(t)%Files(f),'f107',pio_double,(/timdim/),tape(t)%f107id) + str = '10.7 cm solar radio flux (F10.7)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%f107id, 'long_name', trim(str)) + str = '10^-22 W m^-2 Hz^-1' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%f107id, 'units', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'f107a',pio_double,(/timdim/),tape(t)%f107aid) + str = '81-day centered mean of 10.7 cm solar radio flux (F10.7)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%f107aid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'f107p',pio_double,(/timdim/),tape(t)%f107pid) + str = 'Pervious day 10.7 cm solar radio flux (F10.7)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%f107pid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'kp',pio_double,(/timdim/),tape(t)%kpid) + str = 'Daily planetary K geomagnetic index' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%kpid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'ap',pio_double,(/timdim/),tape(t)%apid) + str = 'Daily planetary A geomagnetic index' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%apid, 'long_name', trim(str)) + endif + if (solar_wind_on) then + + ierr=pio_def_var (tape(t)%Files(f),'byimf',pio_double,(/timdim/),tape(t)%byimfid) + str = 'Y component of the interplanetary magnetic field' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%byimfid, 'long_name', trim(str)) + str = 'nT' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%byimfid, 'units', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'bzimf',pio_double,(/timdim/),tape(t)%bzimfid) + str = 'Z component of the interplanetary magnetic field' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%bzimfid, 'long_name', trim(str)) + str = 'nT' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%bzimfid, 'units', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'swvel',pio_double,(/timdim/),tape(t)%swvelid) + str = 'Solar wind speed' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%swvelid, 'long_name', trim(str)) + str = 'km/sec' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%swvelid, 'units', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'swden',pio_double,(/timdim/),tape(t)%swdenid) + str = 'Solar wind ion number density' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%swdenid, 'long_name', trim(str)) + str = 'cm-3' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%swdenid, 'units', trim(str)) + + endif + if (epot_active) then + ierr=pio_def_var (tape(t)%Files(f),'colat_crit1',pio_double,(/timdim/),tape(t)%colat_crit1_id) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%colat_crit1_id, 'long_name', & + 'First co-latitude of electro-potential critical angle') + ierr=pio_put_att (tape(t)%Files(f), tape(t)%colat_crit1_id, 'units', 'degrees') + + ierr=pio_def_var (tape(t)%Files(f),'colat_crit2',pio_double,(/timdim/),tape(t)%colat_crit2_id) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%colat_crit2_id, 'long_name',& + 'Second co-latitude of electro-potential critical angle') + ierr=pio_put_att (tape(t)%Files(f), tape(t)%colat_crit2_id, 'units', 'degrees') + endif + end if - ! - ! Create variables and atributes for fields written out as columns - ! + if (f == instantaneous_file_index) then +#if ( defined BFB_CAM_SCAM_IOP ) + ierr=pio_def_var (tape(t)%Files(f),'tsec ',pio_int,(/timdim/), tape(t)%tsecid) + str = 'current seconds of current date needed for scam' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%tsecid, 'long_name', trim(str)) +#endif + ierr=pio_def_var (tape(t)%Files(f),'nsteph ',pio_int,(/timdim/),tape(t)%nstephid) + str = 'current timestep' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%nstephid, 'long_name', trim(str)) + else if (f == accumulated_file_index) then + ierr=pio_def_var (tape(t)%Files(f),'time_bounds',pio_double,(/bnddim,timdim/),tape(t)%tbndid) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%timeid, 'bounds', 'time_bounds') + ierr=pio_put_att (tape(t)%Files(f), tape(t)%tbndid, 'long_name', 'time interval endpoints') + str = 'days since ' // date2yyyymmdd(nbdate) // ' ' // sec2hms(nbsec) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%tbndid, 'units', trim(str)) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%tbndid, 'calendar', trim(calendar)) + end if + end if ! .not. is_satfile + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! Create variables and attributes for field list + ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + do fld = 1, nflds(t) + if (.not. is_satfile(t) .and. .not. restart .and. .not. is_initfile(t)) then + if (f == accumulated_file_index) then + ! this is the accumulated file of a potentially split history tape - skip instantaneous fields + if (tape(t)%hlist(fld)%avgflag == 'I') then + cycle + end if + else + ! this is the instantaneous file of a potentially split history tape - skip accumulated fields + if (tape(t)%hlist(fld)%avgflag /= 'I') then + cycle + end if + end if + end if + !! Collect some field properties + call AvgflagToString(tape(t)%hlist(fld)%avgflag, tape(t)%hlist(fld)%time_op) + if ((tape(t)%hlist(fld)%hwrt_prec == 8) .or. restart) then + ncreal = pio_double + else + ncreal = pio_real + end if - do i = 1, num_patches - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) - varid => tape(t)%hlist(f)%varid(i) - dimids_tmp = dimindex - ! Figure the dimension ID array for this field - ! We have defined the horizontal grid dimensions in dimindex - fdims = num_hdims - do j = 1, mdimsize - fdims = fdims + 1 - dimids_tmp(fdims) = mdimids(mdims(j)) - end do - if(.not. restart) then - ! Only add time dimension if this is not a restart history tape - fdims = fdims + 1 - dimids_tmp(fdims) = timdim - end if - if (patch_output) then - ! For patch output, we need new dimension IDs and a different name - call tape(t)%patches(i)%get_var_data(fname_tmp, & - dimids_tmp(1:fdims), tape(t)%hlist(f)%field%decomp_type) - end if - ! Define the variable - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), ncreal, & - dimids_tmp(1:fdims), varid) - if (mdimsize > 0) then - ierr = pio_put_att(tape(t)%File, varid, 'mdims', mdims(1:mdimsize)) - call cam_pio_handle_error(ierr, 'h_define: cannot define mdims for '//trim(fname_tmp)) - end if - str = tape(t)%hlist(f)%field%sampling_seq - if (len_trim(str) > 0) then - ierr = pio_put_att(tape(t)%File, varid, 'Sampling_Sequence', trim(str)) - call cam_pio_handle_error(ierr, 'h_define: cannot define Sampling_Sequence for '//trim(fname_tmp)) - end if + if(associated(tape(t)%hlist(fld)%field%mdims)) then + mdims => tape(t)%hlist(fld)%field%mdims + mdimsize = size(mdims) + else if(tape(t)%hlist(fld)%field%numlev > 1) then + call endrun('mdims not defined for variable '//trim(tape(t)%hlist(fld)%field%name)) + else + mdimsize=0 + end if - if (tape(t)%hlist(f)%field%flag_xyfill) then - ! Add both _FillValue and missing_value to cover expectations - ! of various applications. - ! The attribute type must match the data type. - if ((tape(t)%hlist(f)%hwrt_prec == 8) .or. restart) then - ierr = pio_put_att(tape(t)%File, varid, '_FillValue', & - tape(t)%hlist(f)%field%fillvalue) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define _FillValue for '//trim(fname_tmp)) - ierr = pio_put_att(tape(t)%File, varid, 'missing_value', & - tape(t)%hlist(f)%field%fillvalue) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define missing_value for '//trim(fname_tmp)) - else - ierr = pio_put_att(tape(t)%File, varid, '_FillValue', & - REAL(tape(t)%hlist(f)%field%fillvalue,r4)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define _FillValue for '//trim(fname_tmp)) - ierr = pio_put_att(tape(t)%File, varid, 'missing_value', & - REAL(tape(t)%hlist(f)%field%fillvalue,r4)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define missing_value for '//trim(fname_tmp)) - end if - end if + ! num_patches will loop through the number of patches (or just one + ! for the whole grid) for this field for this tape + if (patch_output) then + num_patches = size(tape(t)%patches) + else + num_patches = 1 + end if + if(.not.associated(tape(t)%hlist(fld)%varid)) then + allocate(tape(t)%hlist(fld)%varid(num_patches)) + end if + fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) + + if(is_satfile(t)) then + num_hdims=0 + nfils(t)=1 + call sat_hist_define(tape(t)%Files(f)) + else if (interpolate) then + ! Interpolate can't use normal grid code since we are forcing fields + ! to use interpolate decomp + if (.not. allocated(header_info)) then + ! Safety check + call endrun('h_define: header_info not allocated') + end if + num_hdims = 2 + do i = 1, num_hdims + dimindex(i) = header_info(1)%get_hdimid(i) + end do + else if (patch_output) then + ! All patches for this variable should be on the same grid + num_hdims = tape(t)%patches(1)%num_hdims(tape(t)%hlist(fld)%field%decomp_type) + else + ! Normal grid output + ! Find appropriate grid in header_info + if (.not. allocated(header_info)) then + ! Safety check + call endrun('h_define: header_info not allocated') + end if + grd = -1 + do i = 1, size(header_info) + if (header_info(i)%get_gridid() == tape(t)%hlist(fld)%field%decomp_type) then + grd = i + exit + end if + end do + if (grd < 0) then + write(errormsg, '(a,i0,2a)') 'grid, ',tape(t)%hlist(fld)%field%decomp_type,', not found for ',trim(fname_tmp) + call endrun('H_DEFINE: '//errormsg) + end if + num_hdims = header_info(grd)%num_hdims() + do i = 1, num_hdims + dimindex(i) = header_info(grd)%get_hdimid(i) + end do + end if ! is_satfile + + ! + ! Create variables and atributes for fields written out as columns + ! + + do i = 1, num_patches + fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) + varid => tape(t)%hlist(fld)%varid(i) + dimids_tmp = dimindex + ! Figure the dimension ID array for this field + ! We have defined the horizontal grid dimensions in dimindex + fdims = num_hdims + do j = 1, mdimsize + fdims = fdims + 1 + dimids_tmp(fdims) = mdimids(mdims(j)) + end do + if(.not. restart) then + ! Only add time dimension if this is not a restart history tape + fdims = fdims + 1 + dimids_tmp(fdims) = timdim + end if + if (patch_output) then + ! For patch output, we need new dimension IDs and a different name + call tape(t)%patches(i)%get_var_data(fname_tmp, & + dimids_tmp(1:fdims), tape(t)%hlist(fld)%field%decomp_type) + end if + ! Define the variable + call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), ncreal, & + dimids_tmp(1:fdims), varid) + if (mdimsize > 0) then + ierr = pio_put_att(tape(t)%Files(f), varid, 'mdims', mdims(1:mdimsize)) + call cam_pio_handle_error(ierr, 'h_define: cannot define mdims for '//trim(fname_tmp)) + end if + str = tape(t)%hlist(fld)%field%sampling_seq + if (len_trim(str) > 0) then + ierr = pio_put_att(tape(t)%Files(f), varid, 'Sampling_Sequence', trim(str)) + call cam_pio_handle_error(ierr, 'h_define: cannot define Sampling_Sequence for '//trim(fname_tmp)) + end if - str = tape(t)%hlist(f)%field%units - if (len_trim(str) > 0) then - ierr=pio_put_att (tape(t)%File, varid, 'units', trim(str)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define units for '//trim(fname_tmp)) - end if + if (tape(t)%hlist(fld)%field%flag_xyfill) then + ! Add both _FillValue and missing_value to cover expectations + ! of various applications. + ! The attribute type must match the data type. + if ((tape(t)%hlist(fld)%hwrt_prec == 8) .or. restart) then + ierr = pio_put_att(tape(t)%Files(f), varid, '_FillValue', & + tape(t)%hlist(fld)%field%fillvalue) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define _FillValue for '//trim(fname_tmp)) + ierr = pio_put_att(tape(t)%Files(f), varid, 'missing_value', & + tape(t)%hlist(fld)%field%fillvalue) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define missing_value for '//trim(fname_tmp)) + else + ierr = pio_put_att(tape(t)%Files(f), varid, '_FillValue', & + REAL(tape(t)%hlist(fld)%field%fillvalue,r4)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define _FillValue for '//trim(fname_tmp)) + ierr = pio_put_att(tape(t)%Files(f), varid, 'missing_value', & + REAL(tape(t)%hlist(fld)%field%fillvalue,r4)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define missing_value for '//trim(fname_tmp)) + end if + end if - str = tape(t)%hlist(f)%field%mixing_ratio - if (len_trim(str) > 0) then - ierr=pio_put_att (tape(t)%File, varid, 'mixing_ratio', trim(str)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define mixing_ratio for '//trim(fname_tmp)) - end if + str = tape(t)%hlist(fld)%field%units + if (len_trim(str) > 0) then + ierr=pio_put_att (tape(t)%Files(f), varid, 'units', trim(str)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define units for '//trim(fname_tmp)) + end if - str = tape(t)%hlist(f)%field%long_name - ierr=pio_put_att (tape(t)%File, varid, 'long_name', trim(str)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define long_name for '//trim(fname_tmp)) + str = tape(t)%hlist(fld)%field%mixing_ratio + if (len_trim(str) > 0) then + ierr=pio_put_att (tape(t)%Files(f), varid, 'mixing_ratio', trim(str)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define mixing_ratio for '//trim(fname_tmp)) + end if - ! Assign field attributes defining valid levels and averaging info + str = tape(t)%hlist(fld)%field%long_name + ierr=pio_put_att (tape(t)%Files(f), varid, 'long_name', trim(str)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define long_name for '//trim(fname_tmp)) - cell_methods = '' - if (len_trim(tape(t)%hlist(f)%field%cell_methods) > 0) then - if (len_trim(cell_methods) > 0) then - cell_methods = trim(cell_methods)//' '//trim(tape(t)%hlist(f)%field%cell_methods) - else - cell_methods = trim(cell_methods)//trim(tape(t)%hlist(f)%field%cell_methods) - end if - end if - ! Time cell methods is after field method because time averaging is - ! applied later (just before output) than field method which is applied - ! before outfld call. - str = tape(t)%hlist(f)%time_op - select case (str) - case ('mean', 'maximum', 'minimum', 'standard_deviation') - if (len_trim(cell_methods) > 0) then - cell_methods = trim(cell_methods)//' '//'time: '//str - else - cell_methods = trim(cell_methods)//'time: '//str - end if - end select - if (len_trim(cell_methods) > 0) then - ierr = pio_put_att(tape(t)%File, varid, 'cell_methods', trim(cell_methods)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define cell_methods for '//trim(fname_tmp)) - end if - if (patch_output) then - ierr = pio_put_att(tape(t)%File, varid, 'basename', & - tape(t)%hlist(f)%field%name) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define basename for '//trim(fname_tmp)) - end if + ! Assign field attributes defining valid levels and averaging info - if (restart) then - ! For restart history files, we need to save accumulation counts - fname_tmp = trim(fname_tmp)//'_nacs' - if (.not. associated(tape(t)%hlist(f)%nacs_varid)) then - allocate(tape(t)%hlist(f)%nacs_varid) - end if - if (size(tape(t)%hlist(f)%nacs, 1) > 1) then - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & - nacsdims(1:num_hdims), tape(t)%hlist(f)%nacs_varid) - else - ! Save just one value representing all chunks - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & - tape(t)%hlist(f)%nacs_varid) + cell_methods = '' + if (len_trim(tape(t)%hlist(fld)%field%cell_methods) > 0) then + if (len_trim(cell_methods) > 0) then + cell_methods = trim(cell_methods)//' '//trim(tape(t)%hlist(fld)%field%cell_methods) + else + cell_methods = trim(cell_methods)//trim(tape(t)%hlist(fld)%field%cell_methods) + end if + end if + ! Time cell methods is after field method because time averaging is + ! applied later (just before output) than field method which is applied + ! before outfld call. + str = tape(t)%hlist(fld)%time_op + if (tape(t)%hlist(fld)%avgflag == 'I') then + str = 'point' + else + str = tape(t)%hlist(fld)%time_op + end if + cell_methods = adjustl(trim(cell_methods)//' '//'time: '//str) + if (len_trim(cell_methods) > 0) then + ierr = pio_put_att(tape(t)%Files(f), varid, 'cell_methods', trim(cell_methods)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define cell_methods for '//trim(fname_tmp)) + end if + if (patch_output) then + ierr = pio_put_att(tape(t)%Files(f), varid, 'basename', & + tape(t)%hlist(fld)%field%name) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define basename for '//trim(fname_tmp)) end if - ! for standard deviation - if (associated(tape(t)%hlist(f)%sbuf)) then - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) - fname_tmp = trim(fname_tmp)//'_var' - if ( .not.associated(tape(t)%hlist(f)%sbuf_varid)) then - allocate(tape(t)%hlist(f)%sbuf_varid) + if(restart) then + ! for standard deviation + if (associated(tape(t)%hlist(fld)%sbuf)) then + fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) + fname_tmp = trim(fname_tmp)//'_var' + if ( .not.associated(tape(t)%hlist(fld)%sbuf_varid)) then + allocate(tape(t)%hlist(fld)%sbuf_varid) + endif + call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_double, & + dimids_tmp(1:fdims), tape(t)%hlist(fld)%sbuf_varid) endif - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_double, & - dimids_tmp(1:fdims), tape(t)%hlist(f)%sbuf_varid) endif - end if - end do ! Loop over output patches - end do ! Loop over fields - ! - deallocate(mdimids) - ret = pio_enddef(tape(t)%File) + end do ! Loop over output patches + end do ! Loop over fields + if (restart) then + do fld = 1, nflds(t) + if(is_satfile(t)) then + num_hdims=0 + nfils(t)=1 + else if (interpolate) then + ! Interpolate can't use normal grid code since we are forcing fields + ! to use interpolate decomp + if (.not. allocated(header_info)) then + ! Safety check + call endrun('h_define: header_info not allocated') + end if + num_hdims = 2 + do i = 1, num_hdims + nacsdims(i) = header_info(1)%get_hdimid(i) + end do + else if (patch_output) then + ! All patches for this variable should be on the same grid + num_hdims = tape(t)%patches(1)%num_hdims(tape(t)%hlist(fld)%field%decomp_type) + else + ! Normal grid output + ! Find appropriate grid in header_info + if (.not. allocated(header_info)) then + ! Safety check + call endrun('h_define: header_info not allocated') + end if + grd = -1 + do i = 1, size(header_info) + if (header_info(i)%get_gridid() == tape(t)%hlist(fld)%field%decomp_type) then + grd = i + exit + end if + end do + if (grd < 0) then + write(errormsg, '(a,i0,2a)') 'grid, ',tape(t)%hlist(fld)%field%decomp_type,', not found for ',trim(fname_tmp) + call endrun('H_DEFINE: '//errormsg) + end if + num_hdims = header_info(grd)%num_hdims() + do i = 1, num_hdims + nacsdims(i) = header_info(grd)%get_hdimid(i) + end do + end if ! is_satfile - if(masterproc) then - write(iulog,*)'H_DEFINE: Successfully opened netcdf file ' - endif + fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) + ! For restart history files, we need to save accumulation counts + fname_tmp = trim(fname_tmp)//'_nacs' + if (.not. associated(tape(t)%hlist(fld)%nacs_varid)) then + allocate(tape(t)%hlist(fld)%nacs_varid) + end if + if (size(tape(t)%hlist(fld)%nacs, 1) > 1) then + call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_int, & + nacsdims(1:num_hdims), tape(t)%hlist(fld)%nacs_varid) + else + ! Save just one value representing all chunks + call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_int, & + tape(t)%hlist(fld)%nacs_varid) + end if + + end do ! Loop over fields + end if + ! + deallocate(mdimids) + ret = pio_enddef(tape(t)%Files(f)) + if (ret /= PIO_NOERR) then + call endrun('H_DEFINE: ERROR exiting define mode in PIO') + end if + + if(masterproc) then + write(iulog,*)'H_DEFINE: Successfully opened netcdf file ' + endif + end do ! Loop over files ! ! Write time-invariant portion of history header ! if(.not. is_satfile(t)) then if(interpolate) then - call cam_grid_write_var(tape(t)%File, interpolate_info(t)%grid_id) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_grid_write_var(tape(t)%Files(f), interpolate_info(t)%grid_id, file_index=f) + end if + end do else if((.not. patch_output) .or. restart) then do i = 1, size(tape(t)%grid_ids) - call cam_grid_write_var(tape(t)%File, tape(t)%grid_ids(i)) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_grid_write_var(tape(t)%Files(f), tape(t)%grid_ids(i), file_index=f) + end if + end do end do else ! Patch output do i = 1, size(tape(t)%patches) - call tape(t)%patches(i)%write_vals(tape(t)%File) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call tape(t)%patches(i)%write_vals(tape(t)%Files(f)) + end if + end do end do end if ! interpolate if (allocated(lonvar)) then @@ -4473,28 +4996,32 @@ subroutine h_define (t, restart) end if dtime = get_step_size() - ierr = pio_put_var(tape(t)%File, tape(t)%mdtid, (/dtime/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put mdt') - ! - ! Model date info - ! - ierr = pio_put_var(tape(t)%File, tape(t)%ndbaseid, (/ndbase/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put ndbase') - ierr = pio_put_var(tape(t)%File, tape(t)%nsbaseid, (/nsbase/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put nsbase') - - ierr = pio_put_var(tape(t)%File, tape(t)%nbdateid, (/nbdate/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put nbdate') + do f = 1, maxsplitfiles + if (.not. pio_file_is_open(tape(t)%Files(f))) then + cycle + end if + ierr = pio_put_var(tape(t)%Files(f), tape(t)%mdtid, (/dtime/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put mdt') + ! + ! Model date info + ! + ierr = pio_put_var(tape(t)%Files(f), tape(t)%ndbaseid, (/ndbase/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put ndbase') + ierr = pio_put_var(tape(t)%Files(f), tape(t)%nsbaseid, (/nsbase/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put nsbase') + + ierr = pio_put_var(tape(t)%Files(f), tape(t)%nbdateid, (/nbdate/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put nbdate') #if ( defined BFB_CAM_SCAM_IOP ) - ierr = pio_put_var(tape(t)%File, tape(t)%bdateid, (/nbdate/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put bdate') + ierr = pio_put_var(tape(t)%Files(f), tape(t)%bdateid, (/nbdate/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put bdate') #endif - ierr = pio_put_var(tape(t)%File, tape(t)%nbsecid, (/nbsec/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put nbsec') - ! - ! Reduced grid info - ! - + ierr = pio_put_var(tape(t)%Files(f), tape(t)%nbsecid, (/nbsec/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put nbsec') + ! + ! Reduced grid info + ! + end do end if ! .not. is_satfile if (allocated(header_info)) then @@ -4504,16 +5031,22 @@ subroutine h_define (t, restart) deallocate(header_info) end if + ! Write the mdim variable data - call write_hist_coord_vars(tape(t)%File, restart) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call write_hist_coord_vars(tape(t)%Files(f), restart) + end if + end do end subroutine h_define !####################################################################### - subroutine h_normalize (f, t) + subroutine h_normalize (fld, t) use cam_history_support, only: dim_index_2d + use time_manager, only: get_nstep ! !----------------------------------------------------------------------- @@ -4527,7 +5060,7 @@ subroutine h_normalize (f, t) ! ! Input arguments ! - integer, intent(in) :: f ! field index + integer, intent(in) :: fld ! field index integer, intent(in) :: t ! tape index ! ! Local workspace @@ -4539,23 +5072,26 @@ subroutine h_normalize (f, t) integer :: begdim3, enddim3 ! Chunk or block bounds integer :: k ! level integer :: i, ii + integer :: currstep, nsteps real(r8) :: variance, tmpfill logical :: flag_xyfill ! non-applicable xy points flagged with fillvalue character*1 :: avgflag ! averaging flag + character(len=max_chars) :: errmsg + character(len=*), parameter :: sub='H_NORMALIZE:' call t_startf ('h_normalize') - call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) + call tape(t)%hlist(fld)%field%get_bounds(3, begdim3, enddim3) ! ! normalize by number of accumulations for averaged case ! - flag_xyfill = tape(t)%hlist(f)%field%flag_xyfill - avgflag = tape(t)%hlist(f)%avgflag + flag_xyfill = tape(t)%hlist(fld)%field%flag_xyfill + avgflag = tape(t)%hlist(fld)%avgflag do c = begdim3, enddim3 - dimind = tape(t)%hlist(f)%field%get_dims(c) + dimind = tape(t)%hlist(fld)%field%get_dims(c) ib = dimind%beg1 ie = dimind%end1 @@ -4564,41 +5100,55 @@ subroutine h_normalize (f, t) if (flag_xyfill) then do k = jb, je - where (tape(t)%hlist(f)%nacs(ib:ie, c) == 0) - tape(t)%hlist(f)%hbuf(ib:ie,k,c) = tape(t)%hlist(f)%field%fillvalue + where (tape(t)%hlist(fld)%nacs(ib:ie, c) == 0) + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) = tape(t)%hlist(fld)%field%fillvalue endwhere end do end if if (avgflag == 'A' .or. avgflag == 'B' .or. avgflag == 'L') then - if (size(tape(t)%hlist(f)%nacs, 1) > 1) then + if (size(tape(t)%hlist(fld)%nacs, 1) > 1) then do k = jb, je - where (tape(t)%hlist(f)%nacs(ib:ie,c) /= 0) - tape(t)%hlist(f)%hbuf(ib:ie,k,c) = & - tape(t)%hlist(f)%hbuf(ib:ie,k,c) & - / tape(t)%hlist(f)%nacs(ib:ie,c) + where (tape(t)%hlist(fld)%nacs(ib:ie,c) /= 0) + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) = & + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) & + / tape(t)%hlist(fld)%nacs(ib:ie,c) endwhere end do - else if(tape(t)%hlist(f)%nacs(1,c) > 0) then + else if(tape(t)%hlist(fld)%nacs(1,c) > 0) then do k=jb,je - tape(t)%hlist(f)%hbuf(ib:ie,k,c) = & - tape(t)%hlist(f)%hbuf(ib:ie,k,c) & - / tape(t)%hlist(f)%nacs(1,c) + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) = & + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) & + / tape(t)%hlist(fld)%nacs(1,c) end do end if end if + currstep=get_nstep() + if (avgflag == 'N' .and. currstep > 0) then + if( currstep > tape(t)%hlist(fld)%beg_nstep) then + nsteps=currstep-tape(t)%hlist(fld)%beg_nstep + do k=jb,je + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) = & + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) & + / nsteps + end do + else + write(errmsg,*) sub,'FATAL: bad nstep normalization, currstep, beg_nstep=',currstep,',',tape(t)%hlist(fld)%beg_nstep + call endrun(trim(errmsg)) + end if + end if if (avgflag == 'S') then ! standard deviation ... ! from http://www.johndcook.com/blog/standard_deviation/ - tmpfill = merge(tape(t)%hlist(f)%field%fillvalue,0._r8,flag_xyfill) + tmpfill = merge(tape(t)%hlist(fld)%field%fillvalue,0._r8,flag_xyfill) do k=jb,je do i = ib,ie ii = merge(i,1,flag_xyfill) - if (tape(t)%hlist(f)%nacs(ii,c) > 1) then - variance = tape(t)%hlist(f)%sbuf(i,k,c)/(tape(t)%hlist(f)%nacs(ii,c)-1) - tape(t)%hlist(f)%hbuf(i,k,c) = sqrt(variance) + if (tape(t)%hlist(fld)%nacs(ii,c) > 1) then + variance = tape(t)%hlist(fld)%sbuf(i,k,c)/(tape(t)%hlist(fld)%nacs(ii,c)-1) + tape(t)%hlist(fld)%hbuf(i,k,c) = sqrt(variance) else - tape(t)%hlist(f)%hbuf(i,k,c) = tmpfill + tape(t)%hlist(fld)%hbuf(i,k,c) = tmpfill endif end do end do @@ -4612,8 +5162,9 @@ end subroutine h_normalize !####################################################################### - subroutine h_zero (f, t) + subroutine h_zero (fld, t) use cam_history_support, only: dim_index_2d + use time_manager, only: get_nstep, is_first_restart_step ! !----------------------------------------------------------------------- ! @@ -4623,7 +5174,7 @@ subroutine h_zero (f, t) ! !----------------------------------------------------------------------- ! - integer, intent(in) :: f ! field index + integer, intent(in) :: fld ! field index integer, intent(in) :: t ! tape index ! ! Local workspace @@ -4635,16 +5186,19 @@ subroutine h_zero (f, t) call t_startf ('h_zero') - call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) + call tape(t)%hlist(fld)%field%get_bounds(3, begdim3, enddim3) do c = begdim3, enddim3 - dimind = tape(t)%hlist(f)%field%get_dims(c) - tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c)=0._r8 - if (associated(tape(t)%hlist(f)%sbuf)) then ! zero out variance buffer for standard deviation - tape(t)%hlist(f)%sbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c)=0._r8 - endif + dimind = tape(t)%hlist(fld)%field%get_dims(c) + tape(t)%hlist(fld)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c)=0._r8 + if (associated(tape(t)%hlist(fld)%sbuf)) then ! zero out variance buffer for standard deviation + tape(t)%hlist(fld)%sbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c)=0._r8 + end if end do - tape(t)%hlist(f)%nacs(:,:) = 0 + tape(t)%hlist(fld)%nacs(:,:) = 0 + + !Don't reset beg_nstep if this is a restart + if (.not. is_first_restart_step()) tape(t)%hlist(fld)%beg_nstep = get_nstep() call t_stopf ('h_zero') @@ -4653,14 +5207,135 @@ end subroutine h_zero !####################################################################### - subroutine dump_field (f, t, restart) - use cam_history_support, only: history_patch_t, dim_index_3d + subroutine h_global (fld, t) + + use cam_history_support, only: dim_index_2d + use shr_reprosum_mod, only: shr_reprosum_calc + use spmd_utils, only: mpicom + ! + !----------------------------------------------------------------------- + ! + ! Purpose: compute globals of field + ! + ! Method: Loop through fields on the tape + ! + !----------------------------------------------------------------------- + ! + integer, intent(in) :: fld ! field index + integer, intent(in) :: t ! tape index + ! + ! Local workspace + ! + type (dim_index_2d) :: dimind ! 2-D dimension index + integer :: ie ! dim3 index + integer :: count ! tmp index + integer :: i1 ! dim1 index + integer :: j1 ! dim2 index + integer :: fdims(3) ! array shape + integer :: begdim1,enddim1,begdim2,enddim2,begdim3,enddim3 ! + real(r8) :: globalsum(1) ! globalsum + real(r8), allocatable :: globalarr(:) ! globalarr values for this pe + + call t_startf ('h_global') + + ! wbuf contains the area weighting for this field decomposition + if (associated(tape(t)%hlist(fld)%wbuf) ) then + + begdim1 = tape(t)%hlist(fld)%field%begdim1 + enddim1 = tape(t)%hlist(fld)%field%enddim1 + fdims(1) = enddim1 - begdim1 + 1 + begdim2 = tape(t)%hlist(fld)%field%begdim2 + enddim2 = tape(t)%hlist(fld)%field%enddim2 + fdims(2) = enddim2 - begdim2 + 1 + begdim3 = tape(t)%hlist(fld)%field%begdim3 + enddim3 = tape(t)%hlist(fld)%field%enddim3 + fdims(3) = enddim3 - begdim3 + 1 + + allocate(globalarr(fdims(1)*fdims(2)*fdims(3))) + count=0 + globalarr=0._r8 + do ie = begdim3, enddim3 + dimind = tape(t)%hlist(fld)%field%get_dims(ie) + do j1 = dimind%beg2, dimind%end2 + do i1 = dimind%beg1, dimind%end1 + count=count+1 + globalarr(count)=globalarr(count)+tape(t)%hlist(fld)%hbuf(i1,j1,ie)*tape(t)%hlist(fld)%wbuf(i1,ie) + end do + end do + end do + ! call fixed-point algorithm + call shr_reprosum_calc (globalarr, globalsum, count, count, 1, commid=mpicom) + if (masterproc) write(iulog,*)'h_global:field:',trim(tape(t)%hlist(fld)%field%name),' global integral=',globalsum(1) + ! store global entry for this history tape entry + call tape(t)%hlist(fld)%put_global(globalsum(1)) + ! deallocate temp array + deallocate(globalarr) + end if + call t_stopf ('h_global') + end subroutine h_global + + subroutine h_field_op (fld, t) + use cam_history_support, only: dim_index_2d + ! + !----------------------------------------------------------------------- + ! + ! Purpose: run field sum or dif opperation on all contructed fields + ! + ! Method: Loop through fields on the tape + ! + !----------------------------------------------------------------------- + ! + integer, intent(in) :: fld ! field index + integer, intent(in) :: t ! tape index + ! + ! Local workspace + ! + type (dim_index_2d) :: dimind ! 2-D dimension index + integer :: c ! chunk index + integer :: fld1,fld2 ! fields to be operated on + integer :: begdim1, begdim2, begdim3 ! on-node chunk or lat start index + integer :: enddim1, enddim2, enddim3 ! on-node chunk or lat end index + character(len=field_op_len) :: optype ! field operation only sum or diff supported + + call t_startf ('h_field_op') + fld1 = tape(t)%hlist(fld)%field%op_field1_id + fld2 = tape(t)%hlist(fld)%field%op_field2_id + optype = trim(adjustl(tape(t)%hlist(fld)%field%field_op)) + + begdim3 = tape(t)%hlist(fld)%field%begdim3 + enddim3 = tape(t)%hlist(fld)%field%enddim3 + + do c = begdim3, enddim3 + dimind = tape(t)%hlist(fld)%field%get_dims(c) + if (trim(optype) == 'dif') then + tape(t)%hlist(fld)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) = & + tape(t)%hlist(fld1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) - & + tape(t)%hlist(fld2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + else if (trim(optype) == 'sum') then + tape(t)%hlist(fld)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) = & + tape(t)%hlist(fld1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + & + tape(t)%hlist(fld2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + else + call endrun('h_field_op: ERROR: composed field operation type unknown:'//trim(optype)) + end if + end do + ! Set nsteps for composed fields using value of one of the component fields + tape(t)%hlist(fld)%beg_nstep=tape(t)%hlist(fld1)%beg_nstep + tape(t)%hlist(fld)%nacs(:,:)=tape(t)%hlist(fld1)%nacs(:,:) + call t_stopf ('h_field_op') + end subroutine h_field_op + + !####################################################################### + + subroutine dump_field (fld, t, f, restart) + use cam_history_support, only: history_patch_t, dim_index_2d, dim_index_3d use cam_grid_support, only: cam_grid_write_dist_array, cam_grid_dimensions use interp_mod, only : write_interpolated ! Dummy arguments - integer, intent(in) :: f - integer, intent(in) :: t + integer, intent(in) :: fld ! Field index + integer, intent(in) :: t ! Tape index + integer, intent(in) :: f ! File index logical, intent(in) :: restart ! !----------------------------------------------------------------------- @@ -4677,16 +5352,22 @@ subroutine dump_field (f, t, restart) integer :: fdims(8) ! Field file dim sizes integer :: frank ! Field file rank integer :: nacsrank ! Field file rank for nacs + type(dim_index_2d) :: dimind2 ! 2-D dimension index type(dim_index_3d) :: dimind ! 3-D dimension index integer :: adims(3) ! Field array dim sizes integer :: nadims ! # of used adims integer :: fdecomp integer :: num_patches integer :: mdimsize ! Total # on-node elements + integer :: bdim3, edim3 + integer :: ncreal ! Real output kind (double or single) logical :: interpolate logical :: patch_output type(history_patch_t), pointer :: patchptr - integer :: i + integer :: index + real(r4), allocatable :: rtemp2(:,:) + real(r4), allocatable :: rtemp3(:,:,:) + integer :: begdim3, enddim3, ind3 interpolate = (interpolate_output(t) .and. (.not. restart)) patch_output = (associated(tape(t)%patches) .and. (.not. restart)) @@ -4694,10 +5375,10 @@ subroutine dump_field (f, t, restart) !!! Get the field's shape and decomposition ! Shape on disk - call tape(t)%hlist(f)%field%get_shape(fdims, frank) + call tape(t)%hlist(fld)%field%get_shape(fdims, frank) ! Shape of array - dimind = tape(t)%hlist(f)%field%get_dims() + dimind = tape(t)%hlist(fld)%field%get_dims() call dimind%dim_sizes(adims) if (adims(2) <= 1) then adims(2) = adims(3) @@ -4705,7 +5386,7 @@ subroutine dump_field (f, t, restart) else nadims = 3 end if - fdecomp = tape(t)%hlist(f)%field%decomp_type + fdecomp = tape(t)%hlist(fld)%field%decomp_type ! num_patches will loop through the number of patches (or just one ! for the whole grid) for this field for this tape @@ -4715,84 +5396,122 @@ subroutine dump_field (f, t, restart) num_patches = 1 end if - do i = 1, num_patches - varid => tape(t)%hlist(f)%varid(i) + do index = 1, num_patches + varid => tape(t)%hlist(fld)%varid(index) if (restart) then - call pio_setframe(tape(t)%File, varid, int(-1,kind=PIO_OFFSET_KIND)) + call pio_setframe(tape(t)%Files(f), varid, int(-1,kind=PIO_OFFSET_KIND)) else - call pio_setframe(tape(t)%File, varid, int(max(1,nfils(t)),kind=PIO_OFFSET_KIND)) + call pio_setframe(tape(t)%Files(f), varid, int(max(1,nfils(t)),kind=PIO_OFFSET_KIND)) end if if (patch_output) then ! We are outputting patches - patchptr => tape(t)%patches(i) + patchptr => tape(t)%patches(index) if (interpolate) then call endrun('dump_field: interpolate incompatible with regional output') end if - call patchptr%write_var(tape(t)%File, fdecomp, adims(1:nadims), & - pio_double, tape(t)%hlist(f)%hbuf, varid) + call patchptr%write_var(tape(t)%Files(f), fdecomp, adims(1:nadims), & + pio_double, tape(t)%hlist(fld)%hbuf, varid) else ! We are doing output via the field's grid if (interpolate) then - mdimsize = tape(t)%hlist(f)%field%enddim2 - tape(t)%hlist(f)%field%begdim2 + 1 + + !Determine what the output field kind should be: + if (tape(t)%hlist(fld)%hwrt_prec == 8) then + ncreal = pio_double + else + ncreal = pio_real + end if + + mdimsize = tape(t)%hlist(fld)%field%enddim2 - tape(t)%hlist(fld)%field%begdim2 + 1 if (mdimsize == 0) then - mdimsize = tape(t)%hlist(f)%field%numlev + mdimsize = tape(t)%hlist(fld)%field%numlev end if - if (tape(t)%hlist(f)%field%meridional_complement > 0) then - compind = tape(t)%hlist(f)%field%meridional_complement - compid => tape(t)%hlist(compind)%varid(i) + if (tape(t)%hlist(fld)%field%meridional_complement > 0) then + compind = tape(t)%hlist(fld)%field%meridional_complement + compid => tape(t)%hlist(compind)%varid(index) ! We didn't call set frame on the meridional complement field - call pio_setframe(tape(t)%File, compid, int(max(1,nfils(t)),kind=PIO_OFFSET_KIND)) - call write_interpolated(tape(t)%File, varid, compid, & - tape(t)%hlist(f)%hbuf, tape(t)%hlist(compind)%hbuf, & - mdimsize, PIO_DOUBLE, fdecomp) - else if (tape(t)%hlist(f)%field%zonal_complement > 0) then - ! We don't want to double write so do nothing here -! compind = tape(t)%hlist(f)%field%zonal_complement -! compid => tape(t)%hlist(compind)%varid(i) -! call write_interpolated(tape(t)%File, compid, varid, & -! tape(t)%hlist(compind)%hbuf, tape(t)%hlist(f)%hbuf, & -! mdimsize, PIO_DOUBLE, fdecomp) - else + call pio_setframe(tape(t)%Files(f), compid, int(max(1,nfils(t)),kind=PIO_OFFSET_KIND)) + call write_interpolated(tape(t)%Files(f), varid, compid, & + tape(t)%hlist(fld)%hbuf, tape(t)%hlist(compind)%hbuf, & + mdimsize, ncreal, fdecomp) + else if (tape(t)%hlist(fld)%field%zonal_complement <= 0) then ! Scalar field - call write_interpolated(tape(t)%File, varid, & - tape(t)%hlist(f)%hbuf, mdimsize, PIO_DOUBLE, fdecomp) + call write_interpolated(tape(t)%Files(f), varid, & + tape(t)%hlist(fld)%hbuf, mdimsize, ncreal, fdecomp) end if else if (nadims == 2) then ! Special case for 2D field (no levels) due to hbuf structure - call cam_grid_write_dist_array(tape(t)%File, fdecomp, & - adims(1:nadims), fdims(1:frank), tape(t)%hlist(f)%hbuf(:,1,:), varid) + if ((tape(t)%hlist(fld)%hwrt_prec == 4) .and. (.not. restart)) then + call tape(t)%hlist(fld)%field%get_bounds(3, begdim3, enddim3) + allocate(rtemp2(dimind%beg1:dimind%end1, begdim3:enddim3)) + rtemp2 = 0.0_r4 + do ind3 = begdim3, enddim3 + dimind2 = tape(t)%hlist(fld)%field%get_dims(ind3) + rtemp2(dimind2%beg1:dimind2%end1,ind3) = & + tape(t)%hlist(fld)%hbuf(dimind2%beg1:dimind2%end1, 1, ind3) + end do + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, & + adims(1:nadims), fdims(1:frank), rtemp2, varid) + deallocate(rtemp2) + else + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, & + adims(1:nadims), fdims(1:frank), & + tape(t)%hlist(fld)%hbuf(:,1,:), varid) + end if else - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & - fdims(1:frank), tape(t)%hlist(f)%hbuf, varid) + if ((tape(t)%hlist(fld)%hwrt_prec == 4) .and. (.not. restart)) then + call tape(t)%hlist(fld)%field%get_bounds(3, begdim3, enddim3) + allocate(rtemp3(dimind%beg1:dimind%end1, & + dimind%beg2:dimind%end2, begdim3:enddim3)) + rtemp3 = 0.0_r4 + do ind3 = begdim3, enddim3 + dimind2 = tape(t)%hlist(fld)%field%get_dims(ind3) + rtemp3(dimind2%beg1:dimind2%end1, dimind2%beg2:dimind2%end2, & + ind3) = tape(t)%hlist(fld)%hbuf(dimind2%beg1:dimind2%end1,& + dimind2%beg2:dimind2%end2, ind3) + end do + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, adims, & + fdims(1:frank), rtemp3, varid) + deallocate(rtemp3) + else + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, adims, & + fdims(1:frank), & + tape(t)%hlist(fld)%hbuf, varid) + end if end if end if end do !! write accumulation counter and variance to hist restart file if(restart) then - if (associated(tape(t)%hlist(f)%sbuf) ) then + if (associated(tape(t)%hlist(fld)%sbuf) ) then ! write variance data to restart file for standard deviation calc if (nadims == 2) then ! Special case for 2D field (no levels) due to sbuf structure - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims(1:nadims), & - fdims(1:frank), tape(t)%hlist(f)%sbuf(:,1,:), tape(t)%hlist(f)%sbuf_varid) + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, & + adims(1:nadims), fdims(1:frank), & + tape(t)%hlist(fld)%sbuf(:,1,:), tape(t)%hlist(fld)%sbuf_varid) else - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & - fdims(1:frank), tape(t)%hlist(f)%sbuf, tape(t)%hlist(f)%sbuf_varid) + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, adims, & + fdims(1:frank), tape(t)%hlist(fld)%sbuf, & + tape(t)%hlist(fld)%sbuf_varid) endif endif !! NACS - if (size(tape(t)%hlist(f)%nacs, 1) > 1) then + if (size(tape(t)%hlist(fld)%nacs, 1) > 1) then if (nadims > 2) then adims(2) = adims(3) nadims = 2 end if call cam_grid_dimensions(fdecomp, fdims(1:2), nacsrank) - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims(1:nadims), & - fdims(1:nacsrank), tape(t)%hlist(f)%nacs, tape(t)%hlist(f)%nacs_varid) + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, & + adims(1:nadims), fdims(1:nacsrank), & + tape(t)%hlist(fld)%nacs, tape(t)%hlist(fld)%nacs_varid) else - ierr = pio_put_var(tape(t)%File, tape(t)%hlist(f)%nacs_varid, & - tape(t)%hlist(f)%nacs(:, tape(t)%hlist(f)%field%begdim3:tape(t)%hlist(f)%field%enddim3)) + bdim3 = tape(t)%hlist(fld)%field%begdim3 + edim3 = tape(t)%hlist(fld)%field%enddim3 + ierr = pio_put_var(tape(t)%Files(f), tape(t)%hlist(fld)%nacs_varid, & + tape(t)%hlist(fld)%nacs(:, bdim3:edim3)) end if end if @@ -4859,6 +5578,7 @@ subroutine wshist (rgnht_in) ! !----------------------------------------------------------------------- use time_manager, only: get_nstep, get_curr_date, get_curr_time, get_step_size + use time_manager, only: set_date_from_time_float use chem_surfvals, only: chem_surfvals_get, chem_surfvals_co2_rad use solar_irrad_data, only: sol_tsi use sat_hist, only: sat_hist_write @@ -4874,7 +5594,7 @@ subroutine wshist (rgnht_in) character(len=8) :: ctime ! system time logical :: rgnht(ptapes), restart - integer t, f ! tape, field indices + integer t, f, fld ! tape, file, field indices integer start ! starting index required by nf_put_vara integer count1 ! count values required by nf_put_vara integer startc(2) ! start values required by nf_put_vara (character) @@ -4885,21 +5605,25 @@ subroutine wshist (rgnht_in) #endif integer :: yr, mon, day ! year, month, and day components of a date + integer :: yr_mid, mon_mid, day_mid ! year, month, and day components of midpoint date integer :: nstep ! current timestep number - integer :: ncdate ! current date in integer format [yyyymmdd] - integer :: ncsec ! current time of day [seconds] + integer :: ncdate(maxsplitfiles) ! current (or midpoint) date in integer format [yyyymmdd] + integer :: ncsec(maxsplitfiles) ! current (or midpoint) time of day [seconds] integer :: ndcur ! day component of current time integer :: nscur ! seconds component of current time - real(r8) :: time ! current time + real(r8) :: time ! current (or midpoint) time real(r8) :: tdata(2) ! time interval boundaries character(len=max_string_len) :: fname ! Filename + character(len=max_string_len) :: fname_inst ! Filename for instantaneous tape + character(len=max_string_len) :: fname_acc ! Filename for accumulated tape + character(len=max_string_len) :: inst_filename_spec ! Filename specifier override for monthly inst. files logical :: prev ! Label file with previous date rather than current + logical :: duplicate ! Flag for duplicate file name integer :: ierr #if ( defined BFB_CAM_SCAM_IOP ) integer :: tsec ! day component of current time integer :: dtime ! seconds component of current time #endif - if(present(rgnht_in)) then rgnht=rgnht_in restart=.true. @@ -4911,8 +5635,8 @@ subroutine wshist (rgnht_in) end if nstep = get_nstep() - call get_curr_date(yr, mon, day, ncsec) - ncdate = yr*10000 + mon*100 + day + call get_curr_date(yr, mon, day, ncsec(instantaneous_file_index)) + ncdate(instantaneous_file_index) = yr*10000 + mon*100 + day call get_curr_time(ndcur, nscur) ! ! Write time-varying portion of history file header @@ -4930,30 +5654,61 @@ subroutine wshist (rgnht_in) prev = .false. else if (nhtfrq(t) == 0) then - hstwr(t) = nstep /= 0 .and. day == 1 .and. ncsec == 0 + hstwr(t) = nstep /= 0 .and. day == 1 .and. ncsec(instantaneous_file_index) == 0 prev = .true. else - hstwr(t) = mod(nstep,nhtfrq(t)) == 0 - prev = .false. - end if + if (nstep == 0) then + if (write_nstep0) then + hstwr(t) = .true. + else + ! zero the buffers if nstep==0 data not written + do f = 1, nflds(t) + call h_zero(f, t) + end do + end if + else + hstwr(t) = mod(nstep,nhtfrq(t)) == 0 + endif + prev = .false. + end if end if end if + + time = ndcur + nscur/86400._r8 + if (is_initfile(file_index=t)) then + tdata = time ! Inithist file is always instantanious data + else + tdata(1) = beg_time(t) + tdata(2) = time + end if + + ! Set midpoint date/datesec for accumulated file + call set_date_from_time_float((tdata(1) + tdata(2)) / 2._r8, & + yr_mid, mon_mid, day_mid, ncsec(accumulated_file_index) ) + ncdate(accumulated_file_index) = yr_mid*10000 + mon_mid*100 + day_mid + if (hstwr(t) .or. (restart .and. rgnht(t))) then if(masterproc) then if(is_initfile(file_index=t)) then - write(iulog,100) yr,mon,day,ncsec + write(iulog,100) yr,mon,day,ncsec(init_file_index) 100 format('WSHIST: writing time sample to Initial Conditions h-file', & ' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) else if(is_satfile(t)) then - write(iulog,150) nfils(t),t,yr,mon,day,ncsec + write(iulog,150) nfils(t),t,yr,mon,day,ncsec(sat_file_index) 150 format('WSHIST: writing sat columns ',i6,' to h-file ', & i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) else if(hstwr(t)) then - write(iulog,200) nfils(t),t,yr,mon,day,ncsec -200 format('WSHIST: writing time sample ',i3,' to h-file ', & - i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) + do f = 1, maxsplitfiles + if (f == instantaneous_file_index) then + write(iulog,200) nfils(t),'instantaneous',t,yr,mon,day,ncsec(f) + else + write(iulog,200) nfils(t),'accumulated',t,yr_mid,mon_mid,day_mid,ncsec(f) + end if +200 format('WSHIST: writing time sample ',i3,' to ', a, ' h-file ', & + i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) + end do else if(restart .and. rgnht(t)) then - write(iulog,300) nfils(t),t,yr,mon,day,ncsec + write(iulog,300) nfils(t),t,yr,mon,day,ncsec(restart_file_index) 300 format('WSHIST: writing history restart ',i3,' to hr-file ', & i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) end if @@ -4962,6 +5717,9 @@ subroutine wshist (rgnht_in) ! ! Starting a new volume => define the metadata ! + fname = '' + fname_acc = '' + fname_inst = '' if (nfils(t)==0 .or. (restart.and.rgnht(t))) then if(restart) then rhfilename_spec = '%c.cam' // trim(inst_suffix) // '.rh%t.%y-%m-%d-%s.nc' @@ -4970,28 +5728,60 @@ subroutine wshist (rgnht_in) else if(is_initfile(file_index=t)) then fname = interpret_filename_spec( hfilename_spec(t) ) else - fname = interpret_filename_spec( hfilename_spec(t), number=(t-1), & - prev=prev ) + fname_acc = interpret_filename_spec( hfilename_spec(t), number=(t-1), & + prev=prev, flag_spec='a' ) + ! If this is a monthly instantaneous file, override to default timestamp + ! unless the user input a filename specifier + if (default_monthly_filename(t)) then + inst_filename_spec = '%c.cam' // trim(inst_suffix) // '.h%t%f.%y-%m-%d-%s.nc' + else + inst_filename_spec = hfilename_spec(t) + end if + fname_inst = interpret_filename_spec( inst_filename_spec, number=(t-1), & + flag_spec='i' ) end if ! ! Check that this new filename isn't the same as a previous or current filename ! - do f = 1, ptapes - if (masterproc.and. trim(fname) == trim(nhfil(f)) )then - write(iulog,*)'WSHIST: New filename same as old file = ', trim(fname) - write(iulog,*)'Is there an error in your filename specifiers?' - write(iulog,*)'hfilename_spec(', t, ') = ', hfilename_spec(t) - if ( t /= f )then - write(iulog,*)'hfilename_spec(', f, ') = ', hfilename_spec(f) + duplicate = .false. + do f = 1, t + if (masterproc)then + if (trim(fname) == trim(nhfil(f,1)) .and. trim(fname) /= '') then + write(iulog,*)'WSHIST: New filename same as old file = ', trim(fname) + duplicate = .true. + else if (trim(fname_acc) == trim(nhfil(f,accumulated_file_index)) .and. trim(fname_acc) /= '') then + write(iulog,*)'WSHIST: New accumulated filename same as old file = ', trim(fname_acc) + duplicate = .true. + else if (trim(fname_inst) == trim(nhfil(f,instantaneous_file_index)) .and. trim(fname_inst) /= '') then + write(iulog,*)'WSHIST: New instantaneous filename same as old file = ', trim(fname_inst) + duplicate = .true. + end if + if (duplicate) then + write(iulog,*)'Is there an error in your filename specifiers?' + write(iulog,*)'hfilename_spec(', t, ') = ', trim(hfilename_spec(t)) + if ( t /= f )then + write(iulog,*)'hfilename_spec(', f, ') = ', trim(hfilename_spec(f)) + end if + call endrun('WSHIST: ERROR - see atm log file for information') end if - call endrun end if end do if(.not. restart) then - nhfil(t) = fname - if(masterproc) write(iulog,*)'WSHIST: nhfil(',t,')=',trim(nhfil(t)) - cpath(t) = nhfil(t) - if ( len_trim(nfpath(t)) == 0 ) nfpath(t) = cpath(t) + if (is_initfile(file_index=t)) then + nhfil(t,:) = fname + if(masterproc) then + write(iulog,*)'WSHIST: initfile nhfil(',t,')=',trim(nhfil(t,init_file_index)) + end if + else + nhfil(t,accumulated_file_index) = fname_acc + nhfil(t,instantaneous_file_index) = fname_inst + if(masterproc) then + write(iulog,*)'WSHIST: accumulated nhfil(',t,')=',trim(nhfil(t,accumulated_file_index)) + write(iulog,*)'WSHIST: instantaneous nhfil(',t,')=',trim(nhfil(t,instantaneous_file_index)) + end if + end if + cpath(t,:) = nhfil(t,:) + if ( len_trim(nfpath(t)) == 0 ) nfpath(t) = cpath(t, 1) end if call h_define (t, restart) end if @@ -5010,104 +5800,154 @@ subroutine wshist (rgnht_in) if (interpolate_output(t) .and. (.not. restart)) then call set_interp_hfile(t, interpolate_info) end if + ierr = pio_put_var (tape(t)%Files(instantaneous_file_index),tape(t)%ndcurid,(/start/),(/count1/),(/ndcur/)) + ierr = pio_put_var (tape(t)%Files(instantaneous_file_index), tape(t)%nscurid,(/start/),(/count1/),(/nscur/)) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + ierr = pio_put_var (tape(t)%Files(f), tape(t)%dateid,(/start/),(/count1/),(/ncdate(f)/)) + end if + end do - ierr = pio_put_var (tape(t)%File, tape(t)%ndcurid,(/start/), (/count1/),(/ndcur/)) - ierr = pio_put_var (tape(t)%File, tape(t)%nscurid,(/start/), (/count1/),(/nscur/)) - ierr = pio_put_var (tape(t)%File, tape(t)%dateid,(/start/), (/count1/),(/ncdate/)) - - if (.not. is_initfile(file_index=t)) then - ! Don't write the GHG/Solar forcing data to the IC file. - ierr=pio_put_var (tape(t)%File, tape(t)%co2vmrid,(/start/), (/count1/),(/chem_surfvals_co2_rad(vmr_in=.true.)/)) - ierr=pio_put_var (tape(t)%File, tape(t)%ch4vmrid,(/start/), (/count1/),(/chem_surfvals_get('CH4VMR')/)) - ierr=pio_put_var (tape(t)%File, tape(t)%n2ovmrid,(/start/), (/count1/),(/chem_surfvals_get('N2OVMR')/)) - ierr=pio_put_var (tape(t)%File, tape(t)%f11vmrid,(/start/), (/count1/),(/chem_surfvals_get('F11VMR')/)) - ierr=pio_put_var (tape(t)%File, tape(t)%f12vmrid,(/start/), (/count1/),(/chem_surfvals_get('F12VMR')/)) - ierr=pio_put_var (tape(t)%File, tape(t)%sol_tsiid,(/start/), (/count1/),(/sol_tsi/)) - - if (solar_parms_on) then - ierr=pio_put_var (tape(t)%File, tape(t)%f107id, (/start/), (/count1/),(/ f107 /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%f107aid,(/start/), (/count1/),(/ f107a /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%f107pid,(/start/), (/count1/),(/ f107p /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%kpid, (/start/), (/count1/),(/ kp /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%apid, (/start/), (/count1/),(/ ap /) ) - endif - if (solar_wind_on) then - ierr=pio_put_var (tape(t)%File, tape(t)%byimfid, (/start/), (/count1/),(/ byimf /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%bzimfid, (/start/), (/count1/),(/ bzimf /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%swvelid, (/start/), (/count1/),(/ swvel /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%swdenid, (/start/), (/count1/),(/ swden /) ) - endif - if (epot_active) then - ierr=pio_put_var (tape(t)%File, tape(t)%colat_crit1_id, (/start/), (/count1/),(/ epot_crit_colats(1) /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%colat_crit2_id, (/start/), (/count1/),(/ epot_crit_colats(2) /) ) - endif - end if - - ierr = pio_put_var (tape(t)%File, tape(t)%datesecid,(/start/),(/count1/),(/ncsec/)) + do f = 1, maxsplitfiles + if (.not. is_initfile(file_index=t) .and. f == instantaneous_file_index) then + ! Don't write the GHG/Solar forcing data to the IC file. + ! Only write GHG/Solar forcing data to the instantaneous file + ierr=pio_put_var (tape(t)%Files(f), tape(t)%co2vmrid,(/start/), (/count1/),(/chem_surfvals_co2_rad(vmr_in=.true.)/)) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%ch4vmrid,(/start/), (/count1/),(/chem_surfvals_get('CH4VMR')/)) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%n2ovmrid,(/start/), (/count1/),(/chem_surfvals_get('N2OVMR')/)) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%f11vmrid,(/start/), (/count1/),(/chem_surfvals_get('F11VMR')/)) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%f12vmrid,(/start/), (/count1/),(/chem_surfvals_get('F12VMR')/)) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%sol_tsiid,(/start/), (/count1/),(/sol_tsi/)) + + if (solar_parms_on) then + ierr=pio_put_var (tape(t)%Files(f), tape(t)%f107id, (/start/), (/count1/),(/ f107 /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%f107aid,(/start/), (/count1/),(/ f107a /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%f107pid,(/start/), (/count1/),(/ f107p /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%kpid, (/start/), (/count1/),(/ kp /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%apid, (/start/), (/count1/),(/ ap /) ) + endif + if (solar_wind_on) then + ierr=pio_put_var (tape(t)%Files(f), tape(t)%byimfid, (/start/), (/count1/),(/ byimf /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%bzimfid, (/start/), (/count1/),(/ bzimf /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%swvelid, (/start/), (/count1/),(/ swvel /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%swdenid, (/start/), (/count1/),(/ swden /) ) + endif + if (epot_active) then + ierr=pio_put_var (tape(t)%Files(f), tape(t)%colat_crit1_id, (/start/), (/count1/),(/ epot_crit_colats(1) /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%colat_crit2_id, (/start/), (/count1/),(/ epot_crit_colats(2) /) ) + endif + end if + end do + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + ierr = pio_put_var (tape(t)%Files(f),tape(t)%datesecid,(/start/),(/count1/),(/ncsec(f)/)) + end if + end do #if ( defined BFB_CAM_SCAM_IOP ) dtime = get_step_size() tsec=dtime*nstep - ierr = pio_put_var (tape(t)%File, tape(t)%tsecid,(/start/),(/count1/),(/tsec/)) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + ierr = pio_put_var (tape(t)%Files(f),tape(t)%tsecid,(/start/),(/count1/),(/tsec/)) + end if + end do #endif - ierr = pio_put_var (tape(t)%File, tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) - time = ndcur + nscur/86400._r8 - ierr=pio_put_var (tape(t)%File, tape(t)%timeid, (/start/),(/count1/),(/time/)) - + ierr = pio_put_var (tape(t)%Files(instantaneous_file_index),tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) startc(1) = 1 startc(2) = start countc(1) = 2 countc(2) = 1 - if (is_initfile(file_index=t)) then - tdata = time ! Inithist file is always instantanious data - else - tdata(1) = beg_time(t) - tdata(2) = time - end if - ierr=pio_put_var (tape(t)%File, tape(t)%tbndid, startc, countc, tdata) + do f = 1, maxsplitfiles + if (.not. pio_file_is_open(tape(t)%Files(f))) then + cycle + end if + ! We have two files - one for accumulated and one for instantaneous fields + if (f == accumulated_file_index) then + if (.not. restart .and. .not. is_initfile(t)) then + ! accumulated tape - time is midpoint of time_bounds + ierr=pio_put_var (tape(t)%Files(f), tape(t)%timeid, (/start/),(/count1/),(/(tdata(1) + tdata(2)) / 2._r8/)) + else + ! restart or initfile - time is current time + ierr=pio_put_var (tape(t)%Files(f), tape(t)%timeid, (/start/),(/count1/),(/time/)) + end if + ierr=pio_put_var (tape(t)%Files(f), tape(t)%tbndid, startc, countc, tdata) + else + ! not an accumulated history tape - time is current time + ierr=pio_put_var (tape(t)%Files(f), tape(t)%timeid, (/start/),(/count1/),(/time/)) + end if + end do if(.not.restart) beg_time(t) = time ! update beginning time of next interval startc(1) = 1 startc(2) = start countc(1) = 8 countc(2) = 1 call datetime (cdate, ctime) - ierr = pio_put_var (tape(t)%File, tape(t)%date_writtenid, startc, countc, (/cdate/)) - ierr = pio_put_var (tape(t)%File, tape(t)%time_writtenid, startc, countc, (/ctime/)) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + ierr = pio_put_var (tape(t)%Files(f), tape(t)%date_writtenid, startc, countc, (/cdate/)) + ierr = pio_put_var (tape(t)%Files(f), tape(t)%time_writtenid, startc, countc, (/ctime/)) + end if + end do if(.not. restart) then - !$OMP PARALLEL DO PRIVATE (F) - do f=1,nflds(t) - ! Normalized averaged fields - if (tape(t)%hlist(f)%avgflag /= 'I') then - call h_normalize (f, t) - end if - end do + !$OMP PARALLEL DO PRIVATE (FLD) + do fld=1,nflds(t) + ! Normalize all non composed fields, composed fields are calculated next using the normalized components + if (tape(t)%hlist(fld)%avgflag /= 'I'.and..not.tape(t)%hlist(fld)%field%is_composed()) then + call h_normalize (fld, t) + end if + end do + end if + + if(.not. restart) then + !$OMP PARALLEL DO PRIVATE (FLD) + do fld=1,nflds(t) + ! calculate composed fields from normalized components + if (tape(t)%hlist(fld)%field%is_composed()) then + call h_field_op (fld, t) + end if + end do end if ! ! Write field to history tape. Note that this is NOT threaded due to netcdf limitations ! call t_startf ('dump_field') - do f=1,nflds(t) - call dump_field(f, t, restart) + do fld=1,nflds(t) + do f = 1, maxsplitfiles + if (.not. pio_file_is_open(tape(t)%Files(f))) then + cycle + end if + ! we may have a history split, conditionally skip fields that are for the other file + if ((tape(t)%hlist(fld)%avgflag .eq. 'I') .and. f == accumulated_file_index .and. .not. restart) then + cycle + else if ((tape(t)%hlist(fld)%avgflag .ne. 'I') .and. f == instantaneous_file_index .and. .not. restart) then + cycle + end if + call dump_field(fld, t, f, restart) + end do end do call t_stopf ('dump_field') ! + ! Calculate globals + ! + do fld=1,nflds(t) + call h_global(fld, t) + end do + ! ! Zero history buffers and accumulators now that the fields have been written. ! - - - if(restart) then - do f=1,nflds(t) - if(associated(tape(t)%hlist(f)%varid)) then - deallocate(tape(t)%hlist(f)%varid) - nullify(tape(t)%hlist(f)%varid) + do fld=1,nflds(t) + if(associated(tape(t)%hlist(fld)%varid)) then + deallocate(tape(t)%hlist(fld)%varid) + nullify(tape(t)%hlist(fld)%varid) end if end do - call cam_pio_closefile(tape(t)%File) + call cam_pio_closefile(tape(t)%Files(restart_file_index)) else - !$OMP PARALLEL DO PRIVATE (F) - do f=1,nflds(t) - call h_zero (f, t) + !$OMP PARALLEL DO PRIVATE (FLD) + do fld=1,nflds(t) + call h_zero (fld, t) end do end if end if @@ -5121,7 +5961,8 @@ end subroutine wshist !####################################################################### subroutine addfld_1d(fname, vdim_name, avgflag, units, long_name, & - gridname, flag_xyfill, sampling_seq, standard_name, fill_value) + gridname, flag_xyfill, sampling_seq, standard_name, fill_value, & + optype, op_f1name, op_f2name, sampled_on_subcycle) ! !----------------------------------------------------------------------- @@ -5150,7 +5991,10 @@ subroutine addfld_1d(fname, vdim_name, avgflag, units, long_name, & ! every other; only during LW/SW radiation calcs, etc. character(len=*), intent(in), optional :: standard_name ! CF standard name (max_chars) real(r8), intent(in), optional :: fill_value - + character(len=*), intent(in), optional :: optype ! currently 'dif' or 'sum' is supported + character(len=*), intent(in), optional :: op_f1name ! first field to be operated on + character(len=*), intent(in), optional :: op_f2name ! second field which is subtracted from or added to first field + logical, intent(in), optional :: sampled_on_subcycle ! If .true., subcycle averaging is enabled ! ! Local workspace ! @@ -5168,12 +6012,14 @@ subroutine addfld_1d(fname, vdim_name, avgflag, units, long_name, & dimnames(1) = trim(vdim_name) end if call addfld(fname, dimnames, avgflag, units, long_name, gridname, & - flag_xyfill, sampling_seq, standard_name, fill_value) + flag_xyfill, sampling_seq, standard_name, fill_value, optype, op_f1name, & + op_f2name, sampled_on_subcycle) end subroutine addfld_1d subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & - gridname, flag_xyfill, sampling_seq, standard_name, fill_value) + gridname, flag_xyfill, sampling_seq, standard_name, fill_value, optype, & + op_f1name, op_f2name, sampled_on_subcycle) ! !----------------------------------------------------------------------- @@ -5188,7 +6034,7 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & use cam_history_support, only: fillvalue, hist_coord_find_levels use cam_grid_support, only: cam_grid_id, cam_grid_is_zonal use cam_grid_support, only: cam_grid_get_coord_names - use constituents, only: pcnst, cnst_get_ind, cnst_get_type_byind + use constituents, only: cnst_get_ind, cnst_get_type_byind ! ! Arguments @@ -5206,6 +6052,10 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & ! every other; only during LW/SW radiation calcs, etc. character(len=*), intent(in), optional :: standard_name ! CF standard name (max_chars) real(r8), intent(in), optional :: fill_value + character(len=*), intent(in), optional :: optype ! currently 'dif' or 'sum' supported + character(len=*), intent(in), optional :: op_f1name ! first field to be operated on + character(len=*), intent(in), optional :: op_f2name ! second field which is subtracted from or added to first field + logical, intent(in), optional :: sampled_on_subcycle ! If .true., subcycle averaging is enabled ! ! Local workspace @@ -5215,10 +6065,13 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & character(len=128) :: errormsg character(len=3) :: mixing_ratio type(master_entry), pointer :: listentry + type(master_entry), pointer :: f1listentry,f2listentry integer :: dimcnt integer :: idx + character(len=*), parameter :: subname='ADDFLD_ND' + if (htapes_defined) then call endrun ('ADDFLD: Attempt to add field '//trim(fname)//' after history files set') end if @@ -5268,6 +6121,11 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & listentry%field%mixing_ratio = mixing_ratio listentry%field%meridional_complement = -1 listentry%field%zonal_complement = -1 + listentry%field%field_op = '' + listentry%field%op_field1_id = -1 + listentry%field%op_field2_id = -1 + listentry%op_field1 = '' + listentry%op_field2 = '' listentry%htapeindx(:) = -1 listentry%act_sometape = .false. listentry%actflag(:) = .false. @@ -5322,6 +6180,15 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & listentry%field%fillvalue = fillvalue endif + ! + ! Whether to allow subcycle averages; default is false + ! + if (present(sampled_on_subcycle)) then + listentry%field%sampled_on_subcycle = sampled_on_subcycle + else + listentry%field%sampled_on_subcycle = .false. + end if + ! ! Process shape ! @@ -5344,8 +6211,8 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & write(errormsg, *) "Cannot add ", trim(fname), & "Subcolumn history output only allowed on physgrid" call endrun("ADDFLD: "//errormsg) - listentry%field%is_subcol = .true. end if + listentry%field%is_subcol = .true. end if end if ! Levels @@ -5369,6 +6236,45 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & call AvgflagToString(avgflag, listentry%time_op(dimcnt)) end do + if (present(optype)) then + ! make sure optype is "sum" or "dif" + if (.not.(trim(optype) == 'dif' .or. trim(optype) == 'sum')) then + write(errormsg, '(2a)')': Fatal : optype must be "sum" or "dif" not ',trim(optype) + call endrun (trim(subname)//errormsg) + end if + listentry%field%field_op = optype + if (present(op_f1name).and.present(op_f2name)) then + ! Look for the field IDs + f1listentry => get_entry_by_name(masterlinkedlist, trim(op_f1name)) + f2listentry => get_entry_by_name(masterlinkedlist, trim(op_f2name)) + if (associated(f1listentry).and.associated(f2listentry)) then + listentry%op_field1=trim(op_f1name) + listentry%op_field2=trim(op_f2name) + else + write(errormsg, '(5a)') ': Attempt to create a composed field using (', & + trim(op_f1name), ', ', trim(op_f2name), & + ') but both fields have not been added to masterlist via addfld first' + call endrun (trim(subname)//errormsg) + end if + else + write(errormsg, *) ': Attempt to create a composed field but no component fields have been specified' + call endrun (trim(subname)//errormsg) + end if + + else + if (present(op_f1name)) then + write(errormsg, '(3a)') ': creating a composed field using component field 1:',& + trim(op_f1name),' but no field operation (optype=sum or dif) has been defined' + call endrun (trim(subname)//errormsg) + end if + if (present(op_f2name)) then + write(errormsg, '(3a)') ': creating a composed field using component field 2:',& + trim(op_f2name),' but no field operation (optype=sum or dif) has been defined' + call endrun (trim(subname)//errormsg) + end if + end if + + nullify(listentry%next_entry) call add_entry_to_master(listentry) @@ -5377,7 +6283,7 @@ end subroutine addfld_nd !####################################################################### - ! field_part_of_vector: Determinie if fname is part of a vector set + ! field_part_of_vector: Determine if fname is part of a vector set ! Optionally fill in the names of the vector set fields logical function field_part_of_vector(fname, meridional_name, zonal_name) @@ -5417,6 +6323,53 @@ logical function field_part_of_vector(fname, meridional_name, zonal_name) end function field_part_of_vector + !####################################################################### + ! composed field_info: Determine if a field is derived from a mathematical + ! operation using 2 other defined fields. Optionally, + ! retrieve names of the composing fields + subroutine composed_field_info(fname, is_composed, fname1, fname2) + + ! Dummy arguments + character(len=*), intent(in) :: fname + logical, intent(out) :: is_composed + character(len=*), optional, intent(out) :: fname1 + character(len=*), optional, intent(out) :: fname2 + + ! Local variables + type(master_entry), pointer :: listentry + character(len=128) :: errormsg + character(len=*), parameter :: subname='composed_field_info' + + listentry => get_entry_by_name(masterlinkedlist, fname) + if (associated(listentry)) then + if ( (len_trim(listentry%op_field1) > 0) .or. & + (len_trim(listentry%op_field2) > 0)) then + is_composed = .true. + else + is_composed = .false. + end if + if (is_composed) then + if (present(fname1)) then + fname1=trim(listentry%op_field1) + end if + if (present(fname2)) then + fname2=trim(listentry%op_field2) + end if + else + if (present(fname1)) then + fname1 = '' + end if + if (present(fname2)) then + fname2 = '' + end if + end if + else + write(errormsg, '(3a)') ': Field:',trim(fname),' not defined in masterlist' + call endrun (trim(subname)//errormsg) + end if + + end subroutine composed_field_info + ! register_vector_field: Register a pair of history field names as ! being a vector complement set. @@ -5540,7 +6493,6 @@ subroutine wrapup (rstwr, nlend) ! !----------------------------------------------------------------------- ! - use pio, only : pio_file_is_open use shr_kind_mod, only: r8 => shr_kind_r8 use ioFileMod use time_manager, only: get_nstep, get_curr_date, get_curr_time @@ -5566,7 +6518,8 @@ subroutine wrapup (rstwr, nlend) logical :: lhfill ! true => history file is full integer :: t ! History file number - integer :: f + integer :: f ! File index + integer :: fld ! Field index real(r8) :: tday ! Model day number for printout !----------------------------------------------------------------------- @@ -5586,7 +6539,6 @@ subroutine wrapup (rstwr, nlend) ! do t=1,ptapes if (nflds(t) == 0) cycle - lfill(t) = .false. ! ! Find out if file is full @@ -5608,18 +6560,29 @@ subroutine wrapup (rstwr, nlend) ! Is this the 0 timestep data of a monthly run? ! If so, just close primary unit do not dispose. ! - if (masterproc) write(iulog,*)'WRAPUP: nf_close(',t,')=',trim(nhfil(t)) - if(pio_file_is_open(tape(t)%File)) then + if (masterproc) then + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + write(iulog,*)'WRAPUP: nf_close(',t,')=',trim(nhfil(t,f)) + end if + end do + end if + if(pio_file_is_open(tape(t)%Files(accumulated_file_index)) .or. & + pio_file_is_open(tape(t)%Files(instantaneous_file_index))) then if (nlend .or. lfill(t)) then - do f=1,nflds(t) - if (associated(tape(t)%hlist(f)%varid)) then - deallocate(tape(t)%hlist(f)%varid) - nullify(tape(t)%hlist(f)%varid) + do fld=1,nflds(t) + if (associated(tape(t)%hlist(fld)%varid)) then + deallocate(tape(t)%hlist(fld)%varid) + nullify(tape(t)%hlist(fld)%varid) end if end do end if - call cam_pio_closefile(tape(t)%File) end if + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_pio_closefile(tape(t)%Files(f)) + end if + end do if (nhtfrq(t) /= 0 .or. nstep > 0) then ! @@ -5642,7 +6605,12 @@ subroutine wrapup (rstwr, nlend) ! Must position auxiliary files if not full ! if (.not.nlend .and. .not.lfill(t)) then - call cam_PIO_openfile (tape(t)%File, nhfil(t), PIO_WRITE) + ! Always open the instantaneous file + call cam_PIO_openfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), PIO_WRITE) + if (hfile_accum(t)) then + ! Conditionally open the accumulated file + call cam_PIO_openfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), PIO_WRITE) + end if call h_inquire(t) end if endif ! if 0 timestep of montly run**** @@ -5864,35 +6832,6 @@ subroutine bld_outfld_hash_tbls() end if end do - ! - ! Dump out primary and overflow hashing tables. - ! - ! if ( masterproc ) then - ! do ii = 0, tbl_hash_pri_sz-1 - ! if ( tbl_hash_pri(ii) /= 0 ) write(iulog,666) 'tbl_hash_pri', ii, tbl_hash_pri(ii) - ! end do - ! - ! do ii = 1, tbl_hash_oflow_sz - ! if ( tbl_hash_oflow(ii) /= 0 ) write(iulog,666) 'tbl_hash_oflow', ii, tbl_hash_oflow(ii) - ! end do - ! - ! itemp = 0 - ! ii = 1 - ! do - ! if ( tbl_hash_oflow(ii) == 0 ) exit - ! itemp = itemp + 1 - ! write(iulog,*) 'Overflow chain ', itemp, ' has ', tbl_hash_oflow(ii), ' entries:' - ! do ff = 1, tbl_hash_oflow(ii) ! dump out colliding names on this chain - ! write(iulog,*) ' ', ff, ' = ', tbl_hash_oflow(ii+ff), & - ! ' ', masterlist(tbl_hash_oflow(ii+ff))%thisentry%field%name - ! end do - ! ii = ii + tbl_hash_oflow(ii) +1 !advance pointer to start of next chain - ! end do - ! end if - - return -666 format(1x, a, '(', i4, ')', 1x, i6) - end subroutine bld_outfld_hash_tbls !####################################################################### @@ -5916,7 +6855,7 @@ subroutine bld_htapefld_indices ! ! Local. ! - integer :: f + integer :: fld integer :: t ! @@ -5934,17 +6873,17 @@ subroutine bld_htapefld_indices end do do t = 1, ptapes - do f = 1, nflds(t) - listentry => get_entry_by_name(masterlinkedlist, tape(t)%hlist(f)%field%name) + do fld = 1, nflds(t) + listentry => get_entry_by_name(masterlinkedlist, tape(t)%hlist(fld)%field%name) if(.not.associated(listentry)) then write(iulog,*) 'BLD_HTAPEFLD_INDICES: something wrong, field not found on masterlist' - write(iulog,*) 'BLD_HTAPEFLD_INDICES: t, f, ff = ', t, f - write(iulog,*) 'BLD_HTAPEFLD_INDICES: tape%name = ', tape(t)%hlist(f)%field%name + write(iulog,*) 'BLD_HTAPEFLD_INDICES: t, f, ff = ', t, fld + write(iulog,*) 'BLD_HTAPEFLD_INDICES: tape%name = ', tape(t)%hlist(fld)%field%name call endrun end if listentry%act_sometape = .true. listentry%actflag(t) = .true. - listentry%htapeindx(t) = f + listentry%htapeindx(t) = fld end do end do @@ -6007,10 +6946,10 @@ function hist_fld_col_active(fname, lchnk, numcols) logical :: hist_fld_col_active(numcols) ! Local variables - integer :: ff ! masterlist index pointer + integer :: ffld ! masterlist index pointer integer :: i integer :: t ! history file (tape) index - integer :: f ! field index + integer :: fld ! field index integer :: decomp logical :: activeloc(numcols) integer :: num_patches @@ -6026,22 +6965,22 @@ function hist_fld_col_active(fname, lchnk, numcols) hist_fld_col_active = .false. ! Check for name in the master list. - call get_field_properties(fname, found, tape_out=tape, ff_out=ff) + call get_field_properties(fname, found, tape_out=tape, ff_out=ffld) ! If not in master list then return. if (.not. found) return ! If in master list, but not active on any file then return - if (.not. masterlist(ff)%thisentry%act_sometape) return + if (.not. masterlist(ffld)%thisentry%act_sometape) return ! Loop over history files and check for the field/column in each one do t = 1, ptapes ! Is the field active in this file? If not the cycle to next file. - if (.not. masterlist(ff)%thisentry%actflag(t)) cycle + if (.not. masterlist(ffld)%thisentry%actflag(t)) cycle - f = masterlist(ff)%thisentry%htapeindx(t) - decomp = tape(t)%hlist(f)%field%decomp_type + fld = masterlist(ffld)%thisentry%htapeindx(t) + decomp = tape(t)%hlist(fld)%field%decomp_type patch_output = associated(tape(t)%patches) ! Check whether this file has patch (column) output. diff --git a/src/control/cam_history_buffers.F90 b/src/control/cam_history_buffers.F90 index f9a141247a..b26162753c 100644 --- a/src/control/cam_history_buffers.F90 +++ b/src/control/cam_history_buffers.F90 @@ -111,6 +111,7 @@ subroutine hbuf_accum_add (buf8, field, nacs, dimind, idim, flag_xyfill, fillval end subroutine hbuf_accum_add !####################################################################### + subroutine hbuf_accum_variance (hbuf, sbuf, field, nacs, dimind, idim, flag_xyfill, fillvalue) ! !----------------------------------------------------------------------- diff --git a/src/control/cam_history_support.F90 b/src/control/cam_history_support.F90 index dba255727f..6dbc04fb14 100644 --- a/src/control/cam_history_support.F90 +++ b/src/control/cam_history_support.F90 @@ -9,25 +9,25 @@ module cam_history_support !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - use shr_kind_mod, only: r8=>shr_kind_r8, shr_kind_cl - use shr_sys_mod, only: shr_sys_flush + use shr_kind_mod, only: r8=>shr_kind_r8, shr_kind_cl, shr_kind_cxx use pio, only: var_desc_t, file_desc_t use cam_abortutils, only: endrun use cam_logfile, only: iulog use spmd_utils, only: masterproc use cam_grid_support, only: cam_grid_patch_t, cam_grid_header_info_t - use cam_grid_support, only: max_hcoordname_len + use cam_grid_support, only: max_hcoordname_len, maxsplitfiles use cam_pio_utils, only: cam_pio_handle_error implicit none private save - integer, parameter, public :: max_string_len = 256 ! Length of strings + integer, parameter, public :: max_string_len = shr_kind_cxx integer, parameter, public :: max_chars = shr_kind_cl ! max chars for char variables - integer, parameter, public :: fieldname_len = 24 ! max chars for field name - integer, parameter, public :: fieldname_suffix_len = 3 ! length of field name suffix ("&IC") - integer, parameter, public :: fieldname_lenp2 = fieldname_len + 2 ! allow for extra characters + integer, parameter, public :: field_op_len = 3 ! max chars for field operation string (sum/dif) + integer, parameter, public :: fieldname_len = 32 ! max chars for field name + integer, parameter, public :: fieldname_suffix_len = 3 ! length of field name suffix ("&IC") + integer, parameter, public :: fieldname_lenp2 = fieldname_len + 2 ! allow for extra characters ! max_fieldname_len = max chars for field name (including suffix) integer, parameter, public :: max_fieldname_len = fieldname_len + fieldname_suffix_len @@ -118,6 +118,13 @@ module cam_history_support integer :: meridional_complement ! meridional field id or -1 integer :: zonal_complement ! zonal field id or -1 + ! Logical to determine if subcycle averages are allowed + logical :: sampled_on_subcycle = .false. + + character(len=field_op_len) :: field_op = '' ! 'sum' or 'dif' + integer :: op_field1_id ! first field id or -1 + integer :: op_field2_id ! second field id or -1 + character(len=max_fieldname_len) :: name ! field name character(len=max_chars) :: long_name ! long name character(len=max_chars) :: units ! units @@ -127,6 +134,7 @@ module cam_history_support ! radiation calcs; etc. character(len=max_chars) :: cell_methods ! optional cell_methods attribute contains + procedure :: is_composed => field_info_is_composed procedure :: get_shape => field_info_get_shape procedure :: get_bounds => field_info_get_bounds procedure :: get_dims_2d => field_info_get_dims_2d @@ -153,17 +161,27 @@ module cam_history_support ! !--------------------------------------------------------------------------- type, public:: hentry - type (field_info) :: field ! field information - character(len=1) :: avgflag ! averaging flag - character(len=max_chars) :: time_op ! time operator (e.g. max, min, avg) + type (field_info) :: field ! field information + character(len=1) :: avgflag ! averaging flag + character(len=max_chars) :: time_op ! time operator (e.g. max, min, avg) + character(len=max_fieldname_len) :: op_field1 ! field1 name for sum or dif operation + character(len=max_fieldname_len) :: op_field2 ! field2 name for sum or dif operation - integer :: hwrt_prec ! history output precision + integer :: hwrt_prec ! history output precision real(r8), pointer :: hbuf(:,:,:) => NULL() + real(r8), private :: hbuf_integral ! area weighted integral of active field real(r8), pointer :: sbuf(:,:,:) => NULL() ! for standard deviation + real(r8), pointer :: wbuf(:,:) => NULL() ! pointer to area weights type(var_desc_t), pointer :: varid(:) => NULL() ! variable ids integer, pointer :: nacs(:,:) => NULL() ! accumulation counter type(var_desc_t), pointer :: nacs_varid => NULL() + integer :: beg_nstep ! starting time step for nstep normalization + type(var_desc_t), pointer :: beg_nstep_varid=> NULL() type(var_desc_t), pointer :: sbuf_varid => NULL() + type(var_desc_t), pointer :: wbuf_varid => NULL() + contains + procedure :: get_global => hentry_get_global + procedure :: put_global => hentry_put_global end type hentry !--------------------------------------------------------------------------- @@ -182,7 +200,7 @@ module cam_history_support ! PIO ids ! - type(file_desc_t) :: File ! PIO file id + type(file_desc_t) :: Files(maxsplitfiles) ! PIO file ids type(var_desc_t) :: mdtid ! var id for timestep type(var_desc_t) :: ndbaseid ! var id for base day @@ -205,7 +223,7 @@ module cam_history_support #endif type(var_desc_t) :: nstephid ! var id for current timestep type(var_desc_t) :: timeid ! var id for time - type(var_desc_t) :: tbndid ! var id for time_bnds + type(var_desc_t) :: tbndid ! var id for time_bounds type(var_desc_t) :: date_writtenid ! var id for date time sample written type(var_desc_t) :: time_writtenid ! var id for time time sample written type(var_desc_t) :: f107id ! var id for f107 @@ -283,7 +301,7 @@ module cam_history_support character(len=28) :: gridname = '' integer :: grid_id = -1 ! gridtype = 1 equally spaced, including poles (FV scalars output grid) - ! gridtype = 2 Gauss grid (CAM Eulerian) + ! gridtype = 2 Gauss grid (not implemented) ! gridtype = 3 equally spaced, no poles (FV staggered velocity) integer :: interp_gridtype = interp_gridtype_equal_poles ! interpolate_type = 0: native high order interpolation @@ -308,6 +326,7 @@ module cam_history_support public :: lookup_hist_coord_indices, hist_coord_find_levels public :: get_hist_coord_index, hist_coord_name, hist_coord_size public :: hist_dimension_name + public :: hist_dimension_values interface add_hist_coord module procedure add_hist_coord_regonly @@ -318,7 +337,12 @@ module cam_history_support interface hist_coord_size module procedure hist_coord_size_char module procedure hist_coord_size_int - end interface + end interface hist_coord_size + + interface hist_dimension_values + module procedure hist_dimension_values_r8 + module procedure hist_dimension_values_int + end interface hist_dimension_values interface assignment(=) module procedure field_copy @@ -429,6 +453,14 @@ type(dim_index_3d) function field_info_get_dims_3d(this) result(dims) end function field_info_get_dims_3d + ! field_info_is_composed: Return whether this field is composed of two other fields + pure logical function field_info_is_composed(this) + class(field_info), intent(IN) :: this + + field_info_is_composed = ((trim(adjustl(this%field_op))=='sum' .or. trim(adjustl(this%field_op))=='dif') .and. & + this%op_field1_id /= -1 .and. this%op_field2_id /= -1) + end function field_info_is_composed + ! field_info_get_shape: Return a pointer to the field's global shape. ! Calculate it first if necessary subroutine field_info_get_shape(this, shape_out, rank_out) @@ -497,6 +529,26 @@ subroutine field_info_get_bounds(this, dim, beg, end) end subroutine field_info_get_bounds + subroutine hentry_get_global(this, gval) + + ! Dummy arguments + class(hentry) :: this + real(r8), intent(out) :: gval + + gval=this%hbuf_integral + + end subroutine hentry_get_global + + subroutine hentry_put_global(this, gval) + + ! Dummy arguments + class(hentry) :: this + real(r8), intent(in) :: gval + + this%hbuf_integral=gval + + end subroutine hentry_put_global + ! history_patch_write_attrs: Define coordinate variables and attributes ! for a patch subroutine history_patch_write_attrs(this, File) @@ -645,16 +697,8 @@ subroutine history_patch_write_vals(this, File) type(cam_grid_patch_t), pointer :: patchptr type(var_desc_t), pointer :: vardesc => NULL() ! PIO var desc character(len=128) :: errormsg - character(len=max_chars) :: lat_name - character(len=max_chars) :: lon_name - character(len=max_chars) :: col_name - character(len=max_chars) :: temp_str - integer :: dimid ! PIO dimension ID integer :: num_patches - integer :: temp1, temp2 - integer :: latid, lonid ! Coordinate dims integer :: i - logical :: col_only num_patches = size(this%patches) if (.not. associated(this%header_info)) then @@ -951,6 +995,9 @@ subroutine field_copy(f_out, f_in) f_out%meridional_complement = f_in%meridional_complement ! id or -1 f_out%zonal_complement = f_in%zonal_complement ! id or -1 + f_out%field_op = f_in%field_op ! sum,dif, or '' + f_out%op_field1_id = f_in%op_field1_id ! id or -1 + f_out%op_field2_id = f_in%op_field2_id ! id or -1 f_out%name = f_in%name ! field name f_out%long_name = f_in%long_name ! long name @@ -1362,7 +1409,10 @@ subroutine add_hist_coord_int(name, vlen, long_name, units, values, & ! Register the name if necessary if (i == 0) then call add_hist_coord(trim(name), i) - ! if(masterproc) write(iulog,*) 'Registering hist coord',name,'(',i,') with length: ',vlen + if(masterproc) then + write(iulog, '(3a,i0,a,i0)') 'Registering hist coord: ', trim(name), & + '(', i, ') with length: ', vlen + end if end if ! Set the coord's values @@ -1424,7 +1474,10 @@ subroutine add_hist_coord_r8(name, vlen, long_name, units, values, & ! Register the name if necessary if (i == 0) then call add_hist_coord(trim(name), i) - ! if(masterproc) write(iulog,*) 'Registering hist coord',name,'(',i,') with length: ',vlen + if(masterproc) then + write(iulog, '(3a,i0,a,i0)') 'Registering hist coord: ', trim(name), & + '(', i, ') with length: ', vlen + end if end if ! Set the coord's size @@ -1500,7 +1553,10 @@ subroutine add_vert_coord(name, vlen, long_name, units, values, & positive=positive, standard_name=standard_name, & vertical_coord=.true.) i = get_hist_coord_index(trim(name)) - ! if(masterproc) write(iulog,*) 'Registering hist coord',name,'(',i,') with length: ',vlen + if(masterproc) then + write(iulog, '(3a,i0,a,i0)') 'Registering hist coord: ', trim(name), & + '(', i, ') with length: ', vlen + end if end if if (present(formula_terms)) then @@ -1929,7 +1985,7 @@ end function hist_coord_find_levels !####################################################################### - character(len=max_hcoordname_len) function hist_dimension_name (size) + character(len=max_hcoordname_len) function hist_dimension_name(size) ! Given a specific size value, return the first registered dimension name which matches the size, if it exists ! Otherwise the name returned is blank @@ -1950,4 +2006,134 @@ end function hist_dimension_name !####################################################################### + subroutine hist_dimension_values_r8(name, rvalues, istart, istop, found) + ! Given the name of a dimension, return its (real) values in + ! If and are present, they are the beginning and ending + ! indices of the dimension values to return in . By default, + ! the entire array is copied. + ! If is passed, return .true. if is a defined dimension + ! with real values. + + ! Dummy arguments + character(len=*), intent(in) :: name + real(r8), intent(out) :: rvalues(:) + integer, optional, intent(in) :: istart + integer, optional, intent(in) :: istop + logical, optional, intent(out) :: found + ! Local variables + integer :: indx, jndx, rndx + integer :: ibeg + integer :: iend + logical :: dim_ok + real(r8), parameter :: unset_r8 = huge(1.0_r8) + character(len=*), parameter :: subname = ': hist_dimension_values_r8' + + dim_ok = .false. + rvalues(:) = unset_r8 + + do indx = 1, registeredmdims + if(trim(name) == trim(hist_coords(indx)%name)) then + dim_ok = associated(hist_coords(indx)%real_values) + if (dim_ok) then + if (present(istart)) then + ibeg = istart + if (ibeg < LBOUND(hist_coords(indx)%real_values, 1)) then + call endrun(subname//": istart is outside the bounds") + end if + else + ibeg = LBOUND(hist_coords(indx)%real_values, 1) + end if + if (present(istop)) then + iend = istop + if (iend > UBOUND(hist_coords(indx)%real_values, 1)) then + call endrun(subname//": istop is outside the bounds") + end if + else + iend = UBOUND(hist_coords(indx)%real_values, 1) + end if + if (SIZE(rvalues) < (iend - ibeg + 1)) then + call endrun(subname//": rvalues too small") + end if + rndx = 1 + do jndx = ibeg, iend + rvalues(rndx) = hist_coords(indx)%real_values(jndx) + rndx = rndx + 1 + end do + end if + exit + end if + end do + if (present(found)) then + found = dim_ok + end if + + end subroutine hist_dimension_values_r8 + + !####################################################################### + + subroutine hist_dimension_values_int(name, ivalues, istart, istop, found) + ! Given the name of a dimension, return its (integer) values in + ! If and are present, they are the beginning and ending + ! indices of the dimension values to return in . By default, + ! the entire array is copied. + ! If is passed, return .true. if is a defined dimension + ! with integer values. + + ! Dummy arguments + character(len=*), intent(in) :: name + integer, intent(out) :: ivalues(:) + integer, optional, intent(in) :: istart + integer, optional, intent(in) :: istop + logical, optional, intent(out) :: found + ! Local variables + integer :: indx, jndx, rndx + integer :: ibeg + integer :: iend + logical :: dim_ok + integer, parameter :: unset_i = huge(1) + character(len=*), parameter :: subname = 'hist_dimension_values_int' + + dim_ok = .false. + ivalues(:) = unset_i + + do indx = 1, registeredmdims + if(trim(name) == trim(hist_coords(indx)%name)) then + dim_ok = associated(hist_coords(indx)%integer_values) + if (dim_ok) then + if (present(istart)) then + ibeg = istart + if (ibeg < LBOUND(hist_coords(indx)%integer_values, 1)) then + call endrun(subname//": istart is outside the bounds") + end if + else + ibeg = LBOUND(hist_coords(indx)%integer_values, 1) + end if + if (present(istop)) then + iend = istop + if (iend > UBOUND(hist_coords(indx)%integer_values, 1)) then + call endrun(subname//": istop is outside the bounds") + end if + else + iend = UBOUND(hist_coords(indx)%integer_values, 1) + end if + if (SIZE(ivalues) < (iend - ibeg + 1)) then + call endrun(subname//": ivalues too small") + end if + rndx = 1 + do jndx = ibeg, iend + ivalues(rndx) = hist_coords(indx)%integer_values(jndx) + rndx = rndx + 1 + end do + end if + exit + end if + end do + if (present(found)) then + found = dim_ok + end if + + end subroutine hist_dimension_values_int + + !####################################################################### + end module cam_history_support diff --git a/src/control/cam_initfiles.F90 b/src/control/cam_initfiles.F90 index e2ed25d353..08de6340ad 100644 --- a/src/control/cam_initfiles.F90 +++ b/src/control/cam_initfiles.F90 @@ -1,8 +1,8 @@ module cam_initfiles !--------------------------------------------------------------------------------------- -! +! ! Open, close, and provide access to the initial, topography, and primary restart files. -! +! !--------------------------------------------------------------------------------------- use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl @@ -15,7 +15,7 @@ module cam_initfiles pio_closefile use cam_logfile, only: iulog use cam_abortutils, only: endrun - + implicit none private save @@ -40,10 +40,8 @@ module cam_initfiles ! initial values character(len=cl) :: cam_branch_file = ' ' ! Filepath of primary restart file for a branch run -! The restart pointer file contains name of most recently written primary restart file. -! The contents of this file are updated by cam_write_restart as new restart files are written. -character(len=cl), public, protected :: rest_pfile - +real(r8), public, protected :: scale_dry_air_mass = 0.0_r8 ! Toggle and target avg air mass for MPAS dycore + ! Filename for initial restart file. character(len=cl) :: restart_file = ' ' @@ -66,21 +64,25 @@ subroutine cam_initfiles_readnl(nlfile) use spmd_utils, only: mpicom, mstrid=>masterprocid, mpir8=>mpi_real8, & mpichar=>mpi_character, mpi_logical use cam_instance, only: inst_suffix - + use filenames, only: interpret_filename_spec + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input ! Local variables integer :: unitn, ierr - character(len=cl) :: locfn logical :: filefound integer :: xtype integer(pio_offset_kind) :: slen + logical :: found + + ! The restart pointer file contains name of most recently written primary restart file. + character(len=cl) :: rest_pfile character(len=*), parameter :: sub = 'cam_initfiles_readnl' namelist /cam_initfiles_nl/ ncdata, use_topo_file, bnd_topo, pertlim, & - cam_branch_file + cam_branch_file, scale_dry_air_mass !----------------------------------------------------------------------------- if (masterproc) then @@ -107,19 +109,29 @@ subroutine cam_initfiles_readnl(nlfile) if (ierr /= 0) call endrun(sub//": ERROR: mpi_bcast: pertlim") call mpi_bcast(cam_branch_file, len(cam_branch_file), mpichar, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": ERROR: mpi_bcast: cam_branch_file") - - ! Set pointer file name based on instance suffix - rest_pfile = './rpointer.atm' // trim(inst_suffix) + call mpi_bcast(scale_dry_air_mass, 1, mpir8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": ERROR: mpi_bcast: scale_dry_air_mass") ! Set name of primary restart file if (restart_run) then ! Read name of restart file from pointer file if (masterproc) then + rest_pfile = interpret_filename_spec("rpointer.cam"//trim(inst_suffix)//".%y-%m-%d-%s", prev=.true.) + inquire(file=trim(rest_pfile),exist=found) + if(.not. found) then + write(iulog, "INFO : rpointer file "//trim(rest_pfile)//" not found.") + rest_pfile = "rpointer.cam"//trim(inst_suffix) + write(iulog, " Try looking for "//trim(rest_pfile)//" ...") + inquire(file=trim(rest_pfile),exist=found) + if(.not. found) then + call endrun(sub // ': ERROR: rpointer file: '//trim(rest_pfile) // ' not found') + endif + endif unitn = getunit() call opnfil(rest_pfile, unitn, 'f', status="old") read (unitn, '(a)', iostat=ierr) restart_file if (ierr /= 0) then - call endrun(sub // ': ERROR: reading rpointer file') + call endrun(sub // ': ERROR: reading rpointer file: '//trim(rest_pfile)) end if close(unitn) call freeunit(unitn) @@ -127,7 +139,7 @@ subroutine cam_initfiles_readnl(nlfile) call mpi_bcast(restart_file, len(restart_file), mpichar, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": ERROR: mpi_bcast: restart_file") - + else if (branch_run) then ! use namelist input restart_file = trim(cam_branch_file) @@ -178,6 +190,13 @@ subroutine cam_initfiles_readnl(nlfile) write(iulog,*) & ' Maximum abs value of scale factor used to perturb initial conditions, pertlim= ', pertlim + if (scale_dry_air_mass > 0) then + write(iulog,*) & + ' Initial condition dry mass will be scaled to: ',scale_dry_air_mass,' Pa' + else + write(iulog,*) & + ' Initial condition dry mass will not be scaled.' + end if #ifdef PERGRO write(iulog,*)' The PERGRO CPP token is defined.' @@ -187,7 +206,7 @@ subroutine cam_initfiles_readnl(nlfile) end subroutine cam_initfiles_readnl -!======================================================================= +!======================================================================= subroutine cam_initfiles_open() @@ -195,8 +214,8 @@ subroutine cam_initfiles_open() character(len=256) :: ncdata_loc ! filepath of initial file on local disk character(len=256) :: bnd_topo_loc ! filepath of topo file on local disk - !----------------------------------------------------------------------- - + !----------------------------------------------------------------------- + ! Open initial dataset if (initial_run) then @@ -228,21 +247,21 @@ subroutine cam_initfiles_open() end subroutine cam_initfiles_open -!======================================================================= +!======================================================================= function initial_file_get_id() type(file_desc_t), pointer :: initial_file_get_id initial_file_get_id => fh_ini end function initial_file_get_id -!======================================================================= +!======================================================================= function topo_file_get_id() type(file_desc_t), pointer :: topo_file_get_id topo_file_get_id => fh_topo end function topo_file_get_id -!======================================================================= +!======================================================================= subroutine cam_initfiles_close() @@ -259,7 +278,7 @@ subroutine cam_initfiles_close() ! then it just needs to be nullified. nullify(fh_topo) end if - + call pio_closefile(fh_ini) deallocate(fh_ini) nullify(fh_ini) @@ -267,7 +286,7 @@ subroutine cam_initfiles_close() end if end subroutine cam_initfiles_close -!======================================================================= +!======================================================================= character(len=cl) function cam_initfiles_get_caseid() @@ -283,7 +302,7 @@ end subroutine cam_initfiles_close end function cam_initfiles_get_caseid -!======================================================================= +!======================================================================= character(len=cl) function cam_initfiles_get_restdir() diff --git a/src/control/cam_restart.F90 b/src/control/cam_restart.F90 index 4aefd92c68..35087aa89b 100644 --- a/src/control/cam_restart.F90 +++ b/src/control/cam_restart.F90 @@ -6,7 +6,7 @@ module cam_restart use spmd_utils, only: masterproc use cam_control_mod, only: restart_run, caseid use ioFileMod, only: opnfil -use camsrfexch, only: cam_in_t, cam_out_t +use camsrfexch, only: cam_in_t, cam_out_t use dyn_comp, only: dyn_import_t, dyn_export_t use physics_buffer, only: physics_buffer_desc use units, only: getunit, freeunit @@ -53,11 +53,11 @@ subroutine cam_read_restart(cam_in, cam_out, dyn_in, dyn_out, pbuf2d, & character(len=*), parameter :: sub = 'cam_read_restart' !--------------------------------------------------------------------------- - + ! get filehandle pointer to primary restart file fh_ini => initial_file_get_id() - call read_restart_dynamics(fh_ini, dyn_in, dyn_out) + call read_restart_dynamics(fh_ini, dyn_in, dyn_out) call ionosphere_read_restart(fh_ini) call hub2atm_alloc(cam_in) @@ -79,7 +79,7 @@ subroutine cam_write_restart(cam_in, cam_out, dyn_out, pbuf2d, & yr_spec, mon_spec, day_spec, sec_spec ) use filenames, only: interpret_filename_spec - use cam_pio_utils, only: cam_pio_createfile + use cam_pio_utils, only: cam_pio_createfile, cam_pio_set_fill use restart_dynamics, only: write_restart_dynamics, init_restart_dynamics use restart_physics, only: write_restart_physics, init_restart_physics use cam_history, only: write_restart_history, init_restart_history @@ -106,15 +106,11 @@ subroutine cam_write_restart(cam_in, cam_out, dyn_out, pbuf2d, & ! (%c = caseid, $y = year, $m = month, $d = day, $s = seconds in day, %t = number) rfilename_spec = '%c.cam' // trim(inst_suffix) //'.r.%y-%m-%d-%s.nc' - if (present(yr_spec).and.present(mon_spec).and.present(day_spec).and.present(sec_spec)) then - fname = interpret_filename_spec( rfilename_spec, & - yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) - else - fname = interpret_filename_spec( rfilename_spec ) - end if + fname = interpret_filename_spec( rfilename_spec, & + yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) call cam_pio_createfile(fh, trim(fname), 0) - + ierr = cam_pio_set_fill(fh) call init_restart_dynamics(fh, dyn_out) call ionosphere_init_restart(fh) call init_restart_physics(fh, pbuf2d) @@ -132,38 +128,39 @@ subroutine cam_write_restart(cam_in, cam_out, dyn_out, pbuf2d, & call ionosphere_write_restart(fh) call write_restart_physics(fh, cam_in, cam_out, pbuf2d) - if (present(yr_spec).and.present(mon_spec).and.& - present(day_spec).and.present(sec_spec)) then - call write_restart_history(fh, yr_spec=yr_spec, mon_spec=mon_spec, & - day_spec=day_spec, sec_spec= sec_spec ) - else - call write_restart_history(fh) - end if + call write_restart_history(fh, yr_spec=yr_spec, mon_spec=mon_spec, & + day_spec=day_spec, sec_spec= sec_spec ) ! Close the primary restart file call pio_closefile(fh) - + ! Update the restart pointer file - call write_rest_pfile(fname) + call write_rest_pfile(fname, yr_spec=yr_spec, mon_spec=mon_spec, & + day_spec=day_spec, sec_spec= sec_spec ) end subroutine cam_write_restart !======================================================================================== -subroutine write_rest_pfile(restart_file) +subroutine write_rest_pfile(restart_file, yr_spec, mon_spec, day_spec, sec_spec) ! Write the restart pointer file - - use cam_initfiles, only: rest_pfile - + use cam_instance, only: inst_suffix + use filenames, only: interpret_filename_spec character(len=*), intent(in) :: restart_file + integer, optional, intent(in) :: yr_spec ! Simulation year + integer, optional, intent(in) :: mon_spec ! Simulation month + integer, optional, intent(in) :: day_spec ! Simulation day + integer, optional, intent(in) :: sec_spec ! Seconds into current simulation day integer :: nsds, ierr + character(len=CL) :: rest_pfile character(len=*), parameter :: sub='write_rest_pfile' !--------------------------------------------------------------------------- - - if (masterproc) then + if (masterproc) then + rest_pfile = interpret_filename_spec('rpointer.cam'//trim(inst_suffix)//'.'//'%y-%m-%d-%s',& + yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) nsds = getunit() call opnfil(rest_pfile, nsds, 'f') rewind nsds diff --git a/src/control/cam_snapshot.F90 b/src/control/cam_snapshot.F90 deleted file mode 100644 index a9f314b1f4..0000000000 --- a/src/control/cam_snapshot.F90 +++ /dev/null @@ -1,1829 +0,0 @@ -module cam_snapshot -!-------------------------------------------------------- -! The purpose of this module is to handle taking the "snapshot" of CAM data. -! -! This module writes out ALL the state, tend and pbuf fields. It also includes the cam_in and cam_out -! fields which are used within CAM -!-------------------------------------------------------- - -use shr_kind_mod, only: r8 => shr_kind_r8 -use cam_history, only: addfld, add_default, outfld -use cam_history, only: cam_history_snapshot_deactivate, cam_history_snapshot_activate -use cam_history_support, only: horiz_only -use cam_abortutils, only: endrun -use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_get_field_name -use physics_types, only: physics_state, physics_tend, physics_ptend -use camsrfexch, only: cam_out_t, cam_in_t -use ppgrid, only: pcols, begchunk, endchunk -use constituents, only: pcnst -use phys_control, only: phys_getopts -use cam_logfile, only: iulog - -implicit none - -private - -public :: cam_snapshot_init, cam_snapshot_deactivate -public :: cam_snapshot_all_outfld, cam_snapshot_all_outfld_tphysbc, cam_snapshot_all_outfld_tphysac -public :: cam_snapshot_ptend_outfld - -! This is the number of pbuf fields in the CAM code that are declared with the fieldname as opposed to being data driven. -integer, parameter :: npbuf_all = 327 - -type snapshot_type - character(len=40) :: ddt_string - character(len=256) :: standard_name - character(len=20) :: dim_name - character(len=8) :: units -end type snapshot_type - -type snapshot_type_nd - character(len=40) :: ddt_string - character(len=256) :: standard_name - character(len=20) :: dim_name(6) ! hardwired 6 potential dimensions in pbuf - character(len=8) :: units -end type snapshot_type_nd - -type pbuf_info_type - character(len=40) :: name - character(len=256) :: standard_name - character(len=8) :: units - character(len=100) :: dim_string(6) ! hardwired 6 potential dimensions in pbuf -end type pbuf_info_type - -integer :: nstate_var -integer :: ncnst_var -integer :: ntend_var -integer :: ncam_in_var -integer :: ncam_out_var -integer :: npbuf_var -integer :: ntphysbc_var -integer :: ntphysac_var - -integer :: cam_snapshot_before_num, cam_snapshot_after_num - -! Note the maximum number of variables for each type -type (snapshot_type) :: state_snapshot(27) -type (snapshot_type) :: cnst_snapshot(pcnst) -type (snapshot_type) :: tend_snapshot(6) -type (snapshot_type) :: cam_in_snapshot(30) -type (snapshot_type) :: cam_out_snapshot(30) -type (snapshot_type) :: tphysbc_snapshot(30) -type (snapshot_type) :: tphysac_snapshot(30) -type (snapshot_type_nd) :: pbuf_snapshot(250) - -contains - -subroutine cam_snapshot_init(cam_in_arr, cam_out_arr, pbuf, index) - - -!-------------------------------------------------------- -! This subroutine does the addfld calls for ALL state, tend, ptend, and pbuf fields. It also includes the cam_in and cam_out -! elements which are used within CAM -!-------------------------------------------------------- - type(cam_in_t), intent(in) :: cam_in_arr(begchunk:endchunk) - type(cam_out_t), intent(in) :: cam_out_arr(begchunk:endchunk) - type(physics_buffer_desc), pointer, intent(inout) :: pbuf(:,:) - integer, intent(in) :: index - - - call phys_getopts(cam_snapshot_before_num_out = cam_snapshot_before_num, & - cam_snapshot_after_num_out = cam_snapshot_after_num) - - - ! Return if not turned on - if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested - - call cam_state_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) - call cam_cnst_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) - call cam_tend_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) - call cam_ptend_snapshot_init(cam_snapshot_after_num) - call cam_in_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, cam_in_arr(index)) - call cam_out_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, cam_out_arr(index)) - call cam_pbuf_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, pbuf(:,index)) - call cam_tphysac_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) - call cam_tphysbc_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) - -end subroutine cam_snapshot_init - -subroutine cam_snapshot_all_outfld_tphysbc(file_num, state, tend, cam_in, cam_out, pbuf, flx_heat, cmfmc, cmfcme, & - pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) - -use time_manager, only: is_first_step - -!-------------------------------------------------------- -! This subroutine does the outfld calls for ALL state, tend and pbuf fields for routines in tphysbc. -! It also includes the cam_in and cam_out elements which are used within CAM as well as variables which -! are local to tphysac. -!-------------------------------------------------------- - - integer, intent(in) :: file_num - type(physics_state), intent(in) :: state - type(physics_tend), intent(in) :: tend - type(cam_in_t), intent(in) :: cam_in - type(cam_out_t), intent(in) :: cam_out - type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) - real(r8), intent(in) :: flx_heat(:) ! Heat flux for check_energy_chng. - real(r8), intent(in) :: cmfmc(:,:) ! convective mass flux - real(r8), intent(in) :: cmfcme(:,:) ! cmf condensation - evaporation - real(r8), intent(in) :: pflx(:,:) ! convective rain flux throughout bottom of level - real(r8), intent(in) :: zdu(:,:) ! detraining mass flux from deep convection - real(r8), intent(in) :: rliq(:) ! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(in) :: rice(:) ! vertical integral of ice not yet in q(ixcldice) - real(r8), intent(in) :: dlf(:,:) ! local copy of DLFZM (copy so need to output) - real(r8), intent(in) :: dlf2(:,:) ! Detraining cld H20 from shallow convections - real(r8), intent(in) :: rliq2(:) ! vertical integral of liquid from shallow scheme - real(r8), intent(in) :: det_s(:) ! vertical integral of detrained static energy from ice - real(r8), intent(in) :: det_ice(:) ! vertical integral of detrained ice - real(r8), intent(in) :: net_flx(:) - - integer :: lchnk - - ! Return if the first timestep as not all fields may be filled in and this will cause a core dump - if (is_first_step()) return - - ! Return if not turned on - if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested - - lchnk = state%lchnk - - call outfld('flx_heat_snapshot', flx_heat, pcols, lchnk) - call outfld('cmfmc_snapshot', cmfmc, pcols, lchnk) - call outfld('cmfcme_snapshot', cmfcme, pcols, lchnk) - call outfld('pflx_snapshot', pflx, pcols, lchnk) - call outfld('zdu_snapshot', zdu, pcols, lchnk) - call outfld('rliq_snapshot', rliq, pcols, lchnk) - call outfld('rice_snapshot', rice, pcols, lchnk) - call outfld('dlf_snapshot', dlf, pcols, lchnk) - call outfld('dlf2_snapshot', dlf2, pcols, lchnk) - call outfld('rliq2_snapshot', rliq2, pcols, lchnk) - call outfld('det_s_snapshot', det_s, pcols, lchnk) - call outfld('det_ice_snapshot', det_ice, pcols, lchnk) - call outfld('net_flx_snapshot', net_flx, pcols, lchnk) - - call cam_snapshot_all_outfld(file_num, state, tend, cam_in, cam_out, pbuf) - -end subroutine cam_snapshot_all_outfld_tphysbc - -subroutine cam_snapshot_all_outfld_tphysac(file_num, state, tend, cam_in, cam_out, pbuf, fh2o, surfric, obklen, flx_heat) - -use time_manager, only: is_first_step - -!-------------------------------------------------------- -! This subroutine does the outfld calls for ALL state, tend and pbuf fields for routines in tphysac. -! It also includes the cam_in and cam_out elements which are used within CAM as well as variables which -! are local to tphysac. -!-------------------------------------------------------- - - integer, intent(in) :: file_num - type(physics_state), intent(in) :: state - type(physics_tend), intent(in) :: tend - type(cam_in_t), intent(in) :: cam_in - type(cam_out_t), intent(in) :: cam_out - type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) - real(r8), intent(in) :: fh2o(:) ! h2o flux to balance source from methane chemistry - real(r8), intent(in) :: surfric(:) ! surface friction velocity - real(r8), intent(in) :: obklen(:) ! Obukhov length - real(r8), intent(in) :: flx_heat(:) ! Heat flux for check_energy_chng. - - integer :: lchnk - - ! Return if the first timestep as not all fields may be filled in and this will cause a core dump - if (is_first_step()) return - - ! Return if not turned on - if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested - - lchnk = state%lchnk - - call outfld('fh2o_snapshot', fh2o, pcols, lchnk) - call outfld('surfric_snapshot', surfric, pcols, lchnk) - call outfld('obklen_snapshot', obklen, pcols, lchnk) - call outfld('flx_heat_snapshot', flx_heat, pcols, lchnk) - - call cam_snapshot_all_outfld(file_num, state, tend, cam_in, cam_out, pbuf) - -end subroutine cam_snapshot_all_outfld_tphysac - -subroutine cam_snapshot_all_outfld(file_num, state, tend, cam_in, cam_out, pbuf) - -use time_manager, only: is_first_step - -!-------------------------------------------------------- -! This subroutine does the outfld calls for ALL state, tend and pbuf fields. It also includes the cam_in and cam_out -! elements which are used within CAM -!-------------------------------------------------------- - - integer, intent(in) :: file_num - type(physics_state), intent(in) :: state - type(physics_tend), intent(in) :: tend - type(cam_in_t), intent(in) :: cam_in - type(cam_out_t), intent(in) :: cam_out - type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) - - - integer :: lchnk - - ! Return if the first timestep as not all fields may be filled in and this will cause a core dump - if (is_first_step()) return - - ! Return if not turned on - if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested - - lchnk = state%lchnk - - ! Write out all the state fields - call state_snapshot_all_outfld(lchnk, file_num, state) - - ! Write out all the constituent fields - call cnst_snapshot_all_outfld(lchnk, file_num, state%q) - - ! Write out all the tendency fields - call tend_snapshot_all_outfld(lchnk, file_num, tend) - - ! Write out all the cam_in fields - call cam_in_snapshot_all_outfld(lchnk, file_num, cam_in) - - ! Write out all the cam_out fields - call cam_out_snapshot_all_outfld(lchnk, file_num, cam_out) - - ! Write out all the pbuf fields - call cam_pbuf_snapshot_all_outfld(lchnk, file_num, pbuf) - -end subroutine cam_snapshot_all_outfld - -subroutine cam_snapshot_deactivate() - -!-------------------------------------------------------- -! This subroutine deactivates the printing of the snapshot before and after files -! Note - this needs to be done as add_default has been called to setup the proper -! outputting of the requested fields. The outfld calls will only write -! one file at a time (using the same name in both files), hence the writing -! needs to be turned off for all fields, and will be turned on individaully -! when needed. -!-------------------------------------------------------- - integer :: i - - ! Return if not turned on - if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested - - do i=1,nstate_var - call cam_history_snapshot_deactivate(state_snapshot(i)%standard_name) - end do - - do i=1,ncnst_var - call cam_history_snapshot_deactivate(cnst_snapshot(i)%standard_name) - end do - - do i=1,ntend_var - call cam_history_snapshot_deactivate(tend_snapshot(i)%standard_name) - end do - - do i=1,ncam_in_var - call cam_history_snapshot_deactivate(cam_in_snapshot(i)%standard_name) - end do - - do i=1,ncam_out_var - call cam_history_snapshot_deactivate(cam_out_snapshot(i)%standard_name) - end do - - do i=1,npbuf_var - call cam_history_snapshot_deactivate(pbuf_snapshot(i)%standard_name) - end do - -end subroutine cam_snapshot_deactivate - - -subroutine cam_state_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) - -!-------------------------------------------------------- -! This subroutine does the addfld calls for state -!-------------------------------------------------------- - - integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num - - nstate_var = 0 - - !-------------------------------------------------------- - ! Add the state variables to the output - !-------------------------------------------------------- - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%ps', 'ps_snapshot', 'Pa', horiz_only) - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%psdry', 'psdry_snapshot', 'Pa', horiz_only) - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%phis', 'phis_snapshot', 'm2/m2', horiz_only) - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%t', 't_snapshot', 'K', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%u', 'u_snapshot', 'm s-1', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%v', 'v_snapshot', 'm s-1', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%s', 's_snapshot', ' ', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%omega', 'omega_snapshot', 'Pa s-1', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%pmid', 'pmid_snapshot', 'Pa', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%pmiddry', 'pmiddry_snapshot', 'Pa', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%pdel', 'pdel_snapshot', 'Pa', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%pdeldry', 'pdeldry_snapshot', 'Pa', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%rpdel', 'rpdel_snapshot', 'Pa', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%rpdeldry', 'rpdeldry_snapshot', 'Pa', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%lnpmid', 'lnpmid_snapshot', 'unset', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%lnpmiddry', 'lnpmiddry_snapshot', 'unset', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%exner', 'exner_snapshot', 'unset', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%zm', 'zm_snapshot', 'm', 'lev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%pint', 'pint_snapshot', 'Pa', 'ilev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%pintdry', 'pintdry_snapshot', 'Pa', 'ilev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%lnpint', 'lnpint_snapshot', 'unset', 'ilev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%lnpintdry', 'lnpintdry_snapshot', 'unset', 'ilev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%zi', 'zi_snapshot', 'm', 'ilev') - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%te_ini', 'te_ini_snapshot', 'unset', horiz_only) - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%te_cur', 'te_cur_snapshot', 'unset', horiz_only) - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%tw_ini', 'tw_ini_snapshot', 'unset', horiz_only) - - call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%tw_cur', 'tw_cur_snapshot', 'unset', horiz_only) - -end subroutine cam_state_snapshot_init - -subroutine cam_cnst_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) - -!-------------------------------------------------------- -! This subroutine does the addfld calls for state constituent (q) fields -!-------------------------------------------------------- - - use constituents, only: cnst_name, cnst_longname - - integer, intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num - - !-------------------------------------------------------- - ! Add the cnst variables to the output - !-------------------------------------------------------- - - ncnst_var = 0 ! Updated inside snapshot_addfld - - do while (ncnst_var < pcnst) - call snapshot_addfld(ncnst_var, cnst_snapshot, cam_snapshot_before_num, & - cam_snapshot_after_num, cnst_name(ncnst_var+1), & - trim(cnst_name(ncnst_var+1))//'_snapshot', 'kg kg-1', 'lev') - end do - -end subroutine cam_cnst_snapshot_init - -subroutine cam_tend_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) - -!-------------------------------------------------------- -! This subroutine does the addfld calls for tend fields. -!-------------------------------------------------------- - - integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num - - ntend_var = 0 - - !-------------------------------------------------------- - ! Add the physics_tend variables to the output - !-------------------------------------------------------- - - call snapshot_addfld( ntend_var, tend_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'tend%dtdt', 'dtdt_snapshot', 'K s-1', 'lev') - - call snapshot_addfld( ntend_var, tend_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'tend%dudt', 'dudt_snapshot', '', 'lev') - - call snapshot_addfld( ntend_var, tend_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'tend%dvdt', 'dvdt_snapshot', '', 'lev') - - call snapshot_addfld( ntend_var, tend_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'tend%flx_net', 'flx_net_snapshot', '', horiz_only) - - call snapshot_addfld( ntend_var, tend_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'tend%te_tnd', 'te_tnd_snapshot', '', horiz_only) - - call snapshot_addfld( ntend_var, tend_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'tend%tw_tnd', 'tw_tnd_snapshot', '', horiz_only) - -end subroutine cam_tend_snapshot_init - -subroutine cam_ptend_snapshot_init(cam_snapshot_after_num) - use constituents, only: cnst_name, cnst_longname - - !-------------------------------------------------------- - ! This subroutine does the addfld calls for ptend fields. - !-------------------------------------------------------- - - integer,intent(in) :: cam_snapshot_after_num - - integer :: mcnst - character(len=64) :: fname - character(len=128) :: lname - character(len=32) :: cam_take_snapshot_before - character(len=32) :: cam_take_snapshot_after - - call phys_getopts(cam_take_snapshot_before_out = cam_take_snapshot_before, & - cam_take_snapshot_after_out = cam_take_snapshot_after) - - if (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after)) then - - !-------------------------------------------------------- - ! Add the physics_ptend variables to the output - !-------------------------------------------------------- - - call addfld('ptend_s_snapshot', (/ 'lev' /), 'I', 'J kg-1 s-1', & - 'heating rate snapshot') - call add_default('ptend_s_snapshot', cam_snapshot_after_num, ' ') - - call addfld('ptend_u_snapshot', (/ 'lev' /), 'I', 'm s-1 s-1', & - 'momentum tendency snapshot') - call add_default('ptend_u_snapshot', cam_snapshot_after_num, ' ') - - call addfld('ptend_v_snapshot', (/ 'lev' /), 'I', 'm s-1 s-1', & - 'momentum tendency snapshot') - call add_default('ptend_v_snapshot', cam_snapshot_after_num, ' ') - - call addfld('ptend_hflux_srf_snapshot', horiz_only, 'I', 'W m-2', & - 'net zonal stress at surface snapshot') - call add_default('ptend_hflux_srf_snapshot', cam_snapshot_after_num, ' ') - - call addfld('ptend_hflux_top_snapshot', horiz_only, 'I', 'W m-2', & - 'net zonal stress at top of model snapshot') - call add_default('ptend_hflux_top_snapshot', cam_snapshot_after_num, ' ') - - call addfld('ptend_taux_srf_snapshot', horiz_only, 'I', 'Pa', & - 'net meridional stress at surface snapshot') - call add_default('ptend_taux_srf_snapshot', cam_snapshot_after_num, ' ') - - call addfld('ptend_taux_top_snapshot', horiz_only, 'I', 'Pa', & - 'net zonal stress at top of model snapshot') - call add_default('ptend_taux_top_snapshot', cam_snapshot_after_num, ' ') - - call addfld('ptend_tauy_srf_snapshot', horiz_only, 'I', 'Pa', & - 'net meridional stress at surface snapshot') - call add_default('ptend_tauy_srf_snapshot', cam_snapshot_after_num, ' ') - - call addfld('ptend_tauy_top_snapshot', horiz_only, 'I', 'Pa', & - 'net meridional stress at top of model snapshot') - call add_default('ptend_tauy_top_snapshot', cam_snapshot_after_num, ' ') - - do mcnst = 1, pcnst - fname = 'ptend_'//trim(cnst_name(mcnst))//'_snapshot' - lname = 'tendency of '//trim(cnst_longname(mcnst))//' snapshot' - call addfld(trim(fname), (/ 'lev' /), 'I', 'kg kg-1 s-1', trim(lname)) - call add_default(trim(fname), cam_snapshot_after_num, ' ') - - fname = 'cflx_srf_'//trim(cnst_name(mcnst))//'_snapshot' - lname = 'flux of '//trim(cnst_longname(mcnst))//' at surface snapshot' - call addfld(trim(fname), horiz_only, 'I', 'kg m-2 s-1', trim(lname)) - call add_default(trim(fname), cam_snapshot_after_num, ' ') - - fname = 'cflx_top_'//trim(cnst_name(mcnst))//'_snapshot' - lname = 'flux of '//trim(cnst_longname(mcnst))//' at top of model snapshot' - call addfld(trim(fname), horiz_only, 'I', 'kg m-2 s-1', trim(lname)) - call add_default(trim(fname), cam_snapshot_after_num, ' ') - end do - - end if - -end subroutine cam_ptend_snapshot_init - -subroutine cam_in_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, cam_in) - -!-------------------------------------------------------- -! This subroutine does the addfld calls for cam_in fields -!-------------------------------------------------------- - - type(cam_in_t), intent(in) :: cam_in - - integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num - - ncam_in_var = 0 - - !-------------------------------------------------------- - ! Add the state variables to the output - !-------------------------------------------------------- - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%landfrac', 'landfrac_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%ocnfrac', 'ocnfrac_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%snowhland', 'snowhland_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%ts', 'ts_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%sst', 'sst_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%icefrac', 'icefrac_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%shf', 'shf_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%cflx', 'cflx_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%wsx', 'wsx_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%wsy', 'wsy_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%asdif', 'asdif_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%aldif', 'aldif_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%lwup', 'lwup_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%asdir', 'asdir_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%aldir', 'aldir_snapshot', 'unset', horiz_only) - - if (associated (cam_in%meganflx)) & - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%meganflx', 'meganflx_snapshot', 'unset', horiz_only) - - if (associated (cam_in%fireflx)) & - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%fireflx', 'fireflx_snapshot', 'unset', horiz_only) - - if (associated (cam_in%fireztop)) & - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%fireztop', 'fireztop_snapshot', 'unset', horiz_only) - - if (associated (cam_in%depvel)) & - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%depvel', 'depvel_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%lhf', 'lhf_snapshot', 'unset', horiz_only) - - if (associated (cam_in%fv)) & - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%fv', 'fv_snapshot', 'unset', horiz_only) - - if (associated (cam_in%ram1)) & - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%ram1', 'ram1_snapshot', 'unset', horiz_only) - - if (associated (cam_in%dstflx)) & - call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_in%dstflx', 'dstflx_snapshot', 'unset', horiz_only) - -end subroutine cam_in_snapshot_init - -subroutine cam_out_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, cam_out) - -!-------------------------------------------------------- -! This subroutine does the addfld calls for cam_out fields -!-------------------------------------------------------- - - type(cam_out_t), intent(in) :: cam_out - - integer, intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num - - ncam_out_var = 0 - - !-------------------------------------------------------- - ! Add the state variables to the output - !-------------------------------------------------------- - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%precc', 'precc_snapshot', 'm s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%precl', 'precl_snapshot', 'm s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%precsc', 'precsc_snapshot', 'm s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%precsl', 'precsl_snapshot', 'm s-1', horiz_only) - - if (associated(cam_out%nhx_nitrogen_flx)) & - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%nhx_nitrogen_flx', 'nhx_nitro_flx_snapshot', 'kgN m2-1 sec-1', horiz_only) - - if (associated(cam_out%noy_nitrogen_flx)) & - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%noy_nitrogen_flx', 'noy_nitro_flx_snapshot', 'kgN m2-1 sec-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%bcphodry', 'bcphodry_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%bcphidry', 'bcphidry_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%ocphodry', 'ocphodry_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%ocphidry', 'ocphidry_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%bcphiwet', 'bcphiwet_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%ocphiwet', 'ocphiwet_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%dstwet1', 'dstwet1_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%dstwet2', 'dstwet2_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%dstwet3', 'dstwet3_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%dstwet4', 'dstwet4_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%dstdry1', 'dstdry1_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%dstdry2', 'dstdry2_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%dstdry3', 'dstdry3_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%dstdry4', 'dstdry4_snapshot', 'kg m-2 s-1', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%sols', 'sols_snapshot', 'W m-2', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%soll', 'soll_snapshot', 'W m-2', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%solsd', 'solsd_snapshot', 'W m-2', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%solld', 'solld_snapshot', 'W m-2', horiz_only) - - call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cam_out%netsw', 'netsw_snapshot', 'unset', horiz_only) - -end subroutine cam_out_snapshot_init - -subroutine cam_pbuf_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, pbuf) - -!-------------------------------------------------------- -! This subroutine does the addfld calls for pbuf fields. -!-------------------------------------------------------- - - use physics_buffer, only: pbuf_get_dim_strings - - integer, intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num - type(physics_buffer_desc), intent(in) :: pbuf(:) - - integer :: i, j, npbuf - type(pbuf_info_type) :: pbuf_info(size(pbuf)) - character(len=40) :: const_cname(ncnst_var) - character(len=40) :: dim_strings(size(pbuf),6) ! Hardwired 6 potential dimensions in pbuf - - npbuf = size(pbuf(:)) - - !-------------------------------------------------------- - ! fill the name, standard name and units for pbuf_info - !-------------------------------------------------------- - - call fill_pbuf_info(pbuf_info, pbuf, const_cname) - - !-------------------------------------------------------- - ! Determine the indices for the addfld call based on the dimensions in the pbuf - !-------------------------------------------------------- - - call pbuf_get_dim_strings(pbuf, dim_strings) - do i=1, npbuf - ! If the second dimension is empty, then this is a horiz_only field - if (trim(dim_strings(i,2)) == '') then - pbuf_info(i)%dim_string(1) = horiz_only - else - ! The first dimension is the horizontal dimension and should not be used in the addfld call - do j=2,6 - pbuf_info(i)%dim_string(j-1) = dim_strings(i,j) - end do - end if - end do - - !-------------------------------------------------------- - ! Now that all of the information for the pbufs is stored, call the addfld - !-------------------------------------------------------- - npbuf_var = 0 ! Updated inside snapshot_addfld - - do while (npbuf_var < npbuf) - call snapshot_addfld_nd( npbuf_var, pbuf_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - pbuf_info(npbuf_var+1)%name, pbuf_info(npbuf_var+1)%standard_name, pbuf_info(npbuf_var+1)%units,& - pbuf_info(npbuf_var+1)%dim_string) - end do - -end subroutine cam_pbuf_snapshot_init - -subroutine cam_tphysbc_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) - -!-------------------------------------------------------- -! This subroutine does the addfld calls for the misc tphysbc physics variables that are passed individually -! into physics packages -!-------------------------------------------------------- - - integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num - - ntphysbc_var = 0 - - !-------------------------------------------------------- - ! Add the misc tphysbc variables to the output - ! NOTE - flx_heat is added in tphysac - !-------------------------------------------------------- - - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cmfmc', 'cmfmc_snapshot', 'unset', 'lev') - - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'cmfcme', 'cmfcme_snapshot', 'unset', 'lev') - - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'pflx', 'pflx_snapshot', 'unset', 'lev') - - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'zdu', 'zdu_snapshot', 'unset', 'lev') - - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'rliq', 'rliq_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'rice', 'rice_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'dlf', 'dlf_snapshot', 'unset', 'lev') - - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'dlf2', 'dlf2_snapshot', 'unset', 'lev') - - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'rliq2', 'rliq2_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'det_s', 'det_s_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'det_ice', 'det_ice_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'net_flx', 'net_flx_snapshot', 'unset', horiz_only) - - -end subroutine cam_tphysbc_snapshot_init - -subroutine cam_tphysac_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) - -!-------------------------------------------------------- -! This subroutine does the addfld calls for the misc tphysac physics variables that are passed individually -! into physics packages -!-------------------------------------------------------- - - integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num - - ntphysac_var = 0 - - !-------------------------------------------------------- - ! Add the misc tphysac variables to the output - !-------------------------------------------------------- - - call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'fh2o', 'fh2o_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'surfric', 'surfric_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'obklen', 'obklen_snapshot', 'unset', horiz_only) - - call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'flx', 'flx_heat_snapshot', 'unset', horiz_only) - -end subroutine cam_tphysac_snapshot_init - -subroutine snapshot_addfld_nd(nddt_var, ddt_snapshot, cam_snapshot_before_num, cam_snapshot_after_num,& - ddt_string, standard_name, units, dimension_string) - - integer, intent(inout) :: nddt_var - type (snapshot_type_nd), intent(inout) :: ddt_snapshot(:) - - - integer, intent(in) :: cam_snapshot_before_num - integer, intent(in) :: cam_snapshot_after_num - character(len=*), intent(in) :: ddt_string - character(len=*), intent(in) :: standard_name - character(len=*), intent(in) :: units - character(len=*), intent(in) :: dimension_string(:) - - integer :: ndims - - nddt_var=nddt_var+1 - - if (nddt_var > size(ddt_snapshot)) & - call endrun(' ERROR in snapshot_addfld: ddt_snapshot array not allocated large enough') - - ndims = count(dimension_string /= '') - - if (trim(dimension_string(1)) == horiz_only) then - call addfld(standard_name, horiz_only, 'I', units, standard_name) - else - call addfld(standard_name, dimension_string(1:ndims), 'I', units, standard_name) - end if - if (cam_snapshot_before_num > 0) call add_default(standard_name, cam_snapshot_before_num, ' ') - if (cam_snapshot_after_num > 0) call add_default(standard_name, cam_snapshot_after_num, ' ') - - ddt_snapshot(nddt_var)%ddt_string = ddt_string - ddt_snapshot(nddt_var)%standard_name = standard_name - ddt_snapshot(nddt_var)%dim_name(:) = dimension_string(:) - ddt_snapshot(nddt_var)%units = units - - -end subroutine snapshot_addfld_nd - -subroutine snapshot_addfld(nddt_var, ddt_snapshot, cam_snapshot_before_num, cam_snapshot_after_num,& - ddt_string, standard_name, units, dimension_string) - - integer, intent(inout) :: nddt_var - type (snapshot_type), intent(inout) :: ddt_snapshot(:) - - - integer, intent(in) :: cam_snapshot_before_num - integer, intent(in) :: cam_snapshot_after_num - character(len=*), intent(in) :: ddt_string - character(len=*), intent(in) :: standard_name - character(len=*), intent(in) :: units - character(len=*), intent(in) :: dimension_string - - - nddt_var=nddt_var+1 - - if (nddt_var > size(ddt_snapshot)) & - call endrun(' ERROR in snapshot_addfld: ddt_snapshot array not allocated large enough') - - call addfld(standard_name, dimension_string, 'I', units, standard_name) - if (cam_snapshot_before_num > 0) call add_default(standard_name, cam_snapshot_before_num, ' ') - if (cam_snapshot_after_num > 0) call add_default(standard_name, cam_snapshot_after_num, ' ') - - ddt_snapshot(nddt_var)%ddt_string = ddt_string - ddt_snapshot(nddt_var)%standard_name = standard_name - ddt_snapshot(nddt_var)%dim_name = dimension_string - ddt_snapshot(nddt_var)%units = units - - -end subroutine snapshot_addfld - -subroutine state_snapshot_all_outfld(lchnk, file_num, state) - - integer, intent(in) :: lchnk - integer, intent(in) :: file_num - type(physics_state), intent(in) :: state - - integer :: i - - do i=1, nstate_var - - ! Turn on the writing for only the requested tape (file_num) - call cam_history_snapshot_activate(trim(state_snapshot(i)%standard_name), file_num) - - ! Select the state field which is being written - select case(state_snapshot(i)%ddt_string) - - case ('state%ps') - call outfld(state_snapshot(i)%standard_name, state%ps, pcols, lchnk) - - case ('state%psdry') - call outfld(state_snapshot(i)%standard_name, state%psdry, pcols, lchnk) - - case ('state%phis') - call outfld(state_snapshot(i)%standard_name, state%phis, pcols, lchnk) - - case ('state%t') - call outfld(state_snapshot(i)%standard_name, state%t, pcols, lchnk) - - case ('state%u') - call outfld(state_snapshot(i)%standard_name, state%u, pcols, lchnk) - - case ('state%v') - call outfld(state_snapshot(i)%standard_name, state%v, pcols, lchnk) - - case ('state%s') - call outfld(state_snapshot(i)%standard_name, state%s, pcols, lchnk) - - case ('state%omega') - call outfld(state_snapshot(i)%standard_name, state%omega, pcols, lchnk) - - case ('state%pmid') - call outfld(state_snapshot(i)%standard_name, state%pmid, pcols, lchnk) - - case ('state%pmiddry') - call outfld(state_snapshot(i)%standard_name, state%pmiddry, pcols, lchnk) - - case ('state%pdel') - call outfld(state_snapshot(i)%standard_name, state%pdel, pcols, lchnk) - - case ('state%pdeldry') - call outfld(state_snapshot(i)%standard_name, state%pdeldry, pcols, lchnk) - - case ('state%rpdel') - call outfld(state_snapshot(i)%standard_name, state%rpdel, pcols, lchnk) - - case ('state%rpdeldry') - call outfld(state_snapshot(i)%standard_name, state%rpdeldry, pcols, lchnk) - - case ('state%lnpmid') - call outfld(state_snapshot(i)%standard_name, state%lnpmid, pcols, lchnk) - - case ('state%lnpmiddry') - call outfld(state_snapshot(i)%standard_name, state%lnpmiddry, pcols, lchnk) - - case ('state%exner') - call outfld(state_snapshot(i)%standard_name, state%exner, pcols, lchnk) - - case ('state%zm') - call outfld(state_snapshot(i)%standard_name, state%zm, pcols, lchnk) - - case ('state%pint') - call outfld(state_snapshot(i)%standard_name, state%pint, pcols, lchnk) - - case ('state%pintdry') - call outfld(state_snapshot(i)%standard_name, state%pintdry, pcols, lchnk) - - case ('state%lnpint') - call outfld(state_snapshot(i)%standard_name, state%lnpint, pcols, lchnk) - - case ('state%lnpintdry') - call outfld(state_snapshot(i)%standard_name, state%lnpintdry, pcols, lchnk) - - case ('state%zi') - call outfld(state_snapshot(i)%standard_name, state%zi, pcols, lchnk) - - case ('state%te_ini') - call outfld(state_snapshot(i)%standard_name, state%te_ini, pcols, lchnk) - - case ('state%te_cur') - call outfld(state_snapshot(i)%standard_name, state%te_cur, pcols, lchnk) - - case ('state%tw_ini') - call outfld(state_snapshot(i)%standard_name, state%tw_ini, pcols, lchnk) - - case ('state%tw_cur') - call outfld(state_snapshot(i)%standard_name, state%tw_cur, pcols, lchnk) - - case default - call endrun('ERROR in state_snapshot_all_outfld: no match found for '//trim(state_snapshot(i)%ddt_string)) - - end select - - call cam_history_snapshot_deactivate(trim(state_snapshot(i)%standard_name)) - - end do - -end subroutine state_snapshot_all_outfld - -subroutine cam_snapshot_ptend_outfld(ptend, lchnk) - - use constituents, only: cnst_name, cnst_longname - !-------------------------------------------------------- - ! This subroutine does the outfld calls for ptend fields. - !-------------------------------------------------------- - - type(physics_ptend), intent(in) :: ptend - integer, intent(in) :: lchnk - - integer :: mcnst - character(len=128) :: fname - - !-------------------------------------------------------- - ! Add the physics_ptend variables to the output - !-------------------------------------------------------- - - if (ptend%ls) then - call outfld('ptend_s_snapshot', ptend%s, pcols, lchnk) - - call outfld('ptend_hflux_srf_snapshot', ptend%hflux_srf, pcols, lchnk) - - call outfld('ptend_hflux_top_snapshot', ptend%hflux_top, pcols, lchnk) - end if - - if (ptend%lu) then - call outfld('ptend_u_snapshot', ptend%u, pcols, lchnk) - - call outfld('ptend_taux_srf_snapshot', ptend%taux_srf, pcols, lchnk) - - call outfld('ptend_taux_top_snapshot', ptend%taux_top, pcols, lchnk) - end if - - if (ptend%lv) then - call outfld('ptend_v_snapshot', ptend%v, pcols, lchnk) - - call outfld('ptend_tauy_srf_snapshot', ptend%tauy_srf, pcols, lchnk) - - call outfld('ptend_tauy_top_snapshot', ptend%tauy_top, pcols, lchnk) - end if - - do mcnst = 1, pcnst - if (ptend%lq(mcnst)) then - fname = 'ptend_'//trim(cnst_name(mcnst))//'_snapshot' - call outfld(trim(fname), ptend%q(:,:,mcnst), pcols, lchnk) - - fname = 'cflx_srf_'//trim(cnst_name(mcnst))//'_snapshot' - call outfld(trim(fname), ptend%cflx_srf(:,mcnst), pcols, lchnk) - - fname = 'cflx_top_'//trim(cnst_name(mcnst))//'_snapshot' - call outfld(trim(fname), ptend%cflx_top(:,mcnst), pcols, lchnk) - end if - end do - - -end subroutine cam_snapshot_ptend_outfld - -subroutine cnst_snapshot_all_outfld(lchnk, file_num, cnst) - - integer, intent(in) :: lchnk - integer, intent(in) :: file_num - real(r8), intent(in) :: cnst(:,:,:) - - integer :: i - - do i=1, ncnst_var - - ! Turn on the writing for only the requested tape (file_num) - call cam_history_snapshot_activate(trim(cnst_snapshot(i)%standard_name), file_num) - call outfld(cnst_snapshot(i)%standard_name, cnst(:,:,i), pcols, lchnk) - - ! Now that the field has been written, turn off the writing for field - call cam_history_snapshot_deactivate(trim(cnst_snapshot(i)%standard_name)) - - end do - -end subroutine cnst_snapshot_all_outfld - -subroutine tend_snapshot_all_outfld(lchnk, file_num, tend) - - integer, intent(in) :: lchnk - integer, intent(in) :: file_num - type(physics_tend), intent(in) :: tend - - integer :: i - - do i=1, ntend_var - - ! Turn on the writing for only the requested tape (file_num) - call cam_history_snapshot_activate(trim(tend_snapshot(i)%standard_name), file_num) - - ! Select the tend field which is being written - select case(tend_snapshot(i)%ddt_string) - - case ('tend%dtdt') - call outfld(tend_snapshot(i)%standard_name, tend%dtdt, pcols, lchnk) - - case ('tend%dudt') - call outfld(tend_snapshot(i)%standard_name, tend%dudt, pcols, lchnk) - - case ('tend%dvdt') - call outfld(tend_snapshot(i)%standard_name, tend%dvdt, pcols, lchnk) - - case ('tend%flx_net') - call outfld(tend_snapshot(i)%standard_name, tend%flx_net, pcols, lchnk) - - case ('tend%te_tnd') - call outfld(tend_snapshot(i)%standard_name, tend%te_tnd, pcols, lchnk) - - case ('tend%tw_tnd') - call outfld(tend_snapshot(i)%standard_name, tend%tw_tnd, pcols, lchnk) - - case default - call endrun('ERROR in tend_snapshot_all_outfld: no match found for '//trim(tend_snapshot(i)%ddt_string)) - - end select - - call cam_history_snapshot_deactivate(trim(tend_snapshot(i)%standard_name)) - - end do - -end subroutine tend_snapshot_all_outfld - -subroutine cam_in_snapshot_all_outfld(lchnk, file_num, cam_in) - - integer, intent(in) :: lchnk - integer, intent(in) :: file_num - type(cam_in_t), intent(in) :: cam_in - - integer :: i - - do i=1, ncam_in_var - - ! Turn on the writing for only the requested tape (file_num) - call cam_history_snapshot_activate(trim(cam_in_snapshot(i)%standard_name), file_num) - - ! Select the cam_in field which is being written - select case(cam_in_snapshot(i)%ddt_string) - - case ('cam_in%landfrac') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%landfrac, pcols, lchnk) - case ('cam_in%ocnfrac') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%ocnfrac, pcols, lchnk) - case ('cam_in%snowhland') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%snowhland, pcols, lchnk) - case ('cam_in%ts') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%ts, pcols, lchnk) - case ('cam_in%sst') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%sst, pcols, lchnk) - case ('cam_in%icefrac') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%icefrac, pcols, lchnk) - case ('cam_in%shf') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%shf, pcols, lchnk) - case ('cam_in%cflx') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%cflx, pcols, lchnk) - case ('cam_in%wsx') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%wsx, pcols, lchnk) - case ('cam_in%wsy') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%wsy, pcols, lchnk) - case ('cam_in%asdif') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%asdif, pcols, lchnk) - case ('cam_in%aldif') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%aldif, pcols, lchnk) - case ('cam_in%lwup') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%lwup, pcols, lchnk) - case ('cam_in%asdir') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%asdir, pcols, lchnk) - case ('cam_in%aldir') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%aldir, pcols, lchnk) - case ('cam_in%meganflx') - if (associated (cam_in%meganflx)) & - call outfld(cam_in_snapshot(i)%standard_name, cam_in%meganflx, pcols, lchnk) - case ('cam_in%fireflx') - if (associated (cam_in%fireflx)) & - call outfld(cam_in_snapshot(i)%standard_name, cam_in%fireflx, pcols, lchnk) - case ('cam_in%fireztop') - if (associated (cam_in%fireztop)) & - call outfld(cam_in_snapshot(i)%standard_name, cam_in%fireztop, pcols, lchnk) - case ('cam_in%depvel') - if (associated (cam_in%depvel)) & - call outfld(cam_in_snapshot(i)%standard_name, cam_in%depvel, pcols, lchnk) - case ('cam_in%lhf') - call outfld(cam_in_snapshot(i)%standard_name, cam_in%lhf, pcols, lchnk) - case ('cam_in%fv') - if (associated (cam_in%fv)) & - call outfld(cam_in_snapshot(i)%standard_name, cam_in%fv, pcols, lchnk) - case ('cam_in%ram1') - if (associated (cam_in%ram1)) & - call outfld(cam_in_snapshot(i)%standard_name, cam_in%ram1, pcols, lchnk) - case ('cam_in%dstflx') - if (associated (cam_in%dstflx)) & - call outfld(cam_in_snapshot(i)%standard_name, cam_in%dstflx, pcols, lchnk) - - case default - call endrun('ERROR in cam_in_snapshot_all_outfld: no match found for '//trim(cam_in_snapshot(i)%ddt_string)) - - end select - - call cam_history_snapshot_deactivate(trim(cam_in_snapshot(i)%standard_name)) - - end do - -end subroutine cam_in_snapshot_all_outfld - -subroutine cam_out_snapshot_all_outfld(lchnk, file_num, cam_out) - - integer, intent(in) :: lchnk - integer, intent(in) :: file_num - type(cam_out_t), intent(in) :: cam_out - - integer :: i - - do i=1, ncam_out_var - - ! Turn on the writing for only the requested tape (file_num) - call cam_history_snapshot_activate(trim(cam_out_snapshot(i)%standard_name), file_num) - - ! Select the cam_out field which is being written - select case(cam_out_snapshot(i)%ddt_string) - - case ('cam_out%precc') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%precc, pcols, lchnk) - - case ('cam_out%precl') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%precl, pcols, lchnk) - - case ('cam_out%precsc') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%precsc, pcols, lchnk) - - case ('cam_out%precsl') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%precsl, pcols, lchnk) - - case ('cam_out%nhx_nitrogen_flx') - if (associated(cam_out%nhx_nitrogen_flx)) & - call outfld(cam_out_snapshot(i)%standard_name, cam_out%nhx_nitrogen_flx, pcols, lchnk) - - case ('cam_out%noy_nitrogen_flx') - if (associated(cam_out%noy_nitrogen_flx)) & - call outfld(cam_out_snapshot(i)%standard_name, cam_out%noy_nitrogen_flx, pcols, lchnk) - - case ('cam_out%bcphodry') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%bcphodry, pcols, lchnk) - - case ('cam_out%bcphidry') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%bcphidry, pcols, lchnk) - - case ('cam_out%ocphodry') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%ocphodry, pcols, lchnk) - - case ('cam_out%ocphidry') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%ocphidry, pcols, lchnk) - - case ('cam_out%bcphiwet') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%bcphiwet, pcols, lchnk) - - case ('cam_out%ocphiwet') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%ocphiwet, pcols, lchnk) - - case ('cam_out%dstwet1') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstwet1, pcols, lchnk) - - case ('cam_out%dstwet2') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstwet2, pcols, lchnk) - - case ('cam_out%dstwet3') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstwet3, pcols, lchnk) - - case ('cam_out%dstwet4') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstwet4, pcols, lchnk) - - case ('cam_out%dstdry1') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstdry1, pcols, lchnk) - - case ('cam_out%dstdry2') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstdry2, pcols, lchnk) - - case ('cam_out%dstdry3') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstdry3, pcols, lchnk) - - case ('cam_out%dstdry4') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstdry4, pcols, lchnk) - - case ('cam_out%sols') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%sols, pcols, lchnk) - - case ('cam_out%soll') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%soll, pcols, lchnk) - - case ('cam_out%solsd') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%solsd, pcols, lchnk) - - case ('cam_out%solld') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%solld, pcols, lchnk) - - case ('cam_out%flwds') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%flwds, pcols, lchnk) - - case ('cam_out%netsw') - call outfld(cam_out_snapshot(i)%standard_name, cam_out%netsw, pcols, lchnk) - - case default - call endrun('ERROR in cam_out_snapshot_all_outfld: no match found for '//trim(cam_out_snapshot(i)%ddt_string)) - - end select - - call cam_history_snapshot_deactivate(trim(cam_out_snapshot(i)%standard_name)) - - end do - -end subroutine cam_out_snapshot_all_outfld - -subroutine cam_pbuf_snapshot_all_outfld(lchnk, file_num, pbuf) - use physics_buffer, only: pbuf_is_used - - integer, intent(in) :: lchnk - integer, intent(in) :: file_num - type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) - - integer :: i, pbuf_idx, ndims - real(r8), pointer, dimension(:,:) :: tmpptr2d - real(r8), pointer, dimension(:,:,:) :: tmpptr3d - real(r8), pointer, dimension(:,:,:,:) :: tmpptr4d - real(r8), pointer, dimension(:,:,:,:,:) :: tmpptr5d - - - do i=1, npbuf_var - - pbuf_idx= pbuf_get_index(pbuf_snapshot(i)%ddt_string) - - if (pbuf_is_used(pbuf(pbuf_idx))) then - ! Turn on the writing for only the requested tape (file_num) - call cam_history_snapshot_activate(trim(pbuf_snapshot(i)%standard_name), file_num) - - ! Retrieve the pbuf data (dependent on the number of dimensions) - ndims = count(pbuf_snapshot(i)%dim_name(:) /= '') - - select case (ndims) ! Note that dimension 5 and 6 do not work with pbuf_get_field, so these are not used here - - case (1) - call pbuf_get_field(pbuf, pbuf_idx, tmpptr2d) - call outfld(pbuf_snapshot(i)%standard_name, tmpptr2d, pcols, lchnk) - - case (2) - call pbuf_get_field(pbuf, pbuf_idx, tmpptr3d) - call outfld(pbuf_snapshot(i)%standard_name, tmpptr3d, pcols, lchnk) - - case (3) - call pbuf_get_field(pbuf, pbuf_idx, tmpptr3d) - call outfld(pbuf_snapshot(i)%standard_name, tmpptr4d, pcols, lchnk) - - case (4) - call pbuf_get_field(pbuf, pbuf_idx, tmpptr5d) - call outfld(pbuf_snapshot(i)%standard_name, tmpptr5d, pcols, lchnk) - - end select - - ! Now that the field has been written, turn off the writing for field - call cam_history_snapshot_deactivate(trim(pbuf_snapshot(i)%standard_name)) - - - end if - - end do - -end subroutine cam_pbuf_snapshot_all_outfld - -subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) - -!--------------------------------------------------- -! This subroutine exists to link the pbuf name with units. It can be expanded to include standard_names -! at a later date if needed. It is a list of all the pbuf fields that are called within CAM with actual -! names. -!--------------------------------------------------- - - type(pbuf_info_type), intent(inout) :: pbuf_info(:) - type(physics_buffer_desc), intent(in) :: pbuf(:) - character(len=*), intent(in) :: const_cname(:) - - logical, dimension(size(pbuf)) :: found - character(len=24), dimension(2,npbuf_all) :: pbuf_all - character(len=24) :: pbuf_name - integer :: i, ipbuf - - found(:) = .false. - - pbuf_all(1:2,1:100) = reshape ( (/ & - 'ACCRE_ENHAN ','unset ',& - 'ACGCME ','unset ',& - 'ACLDY_CEN ','unset ',& - 'ACNUM ','unset ',& - 'ACPRECL ','unset ',& - 'AIST ','unset ',& - 'ALST ','unset ',& - 'am_evp_st ','unset ',& - 'AMIE_efxg ','mW/m2 ',& - 'AMIE_kevg ','keV ',& - 'AST ','1 ',& - 'AurIPRateSum ','unset ',& - 'awk_PBL ','unset ',& - 'bprod ','unset ',& - 'cam3_bcphi ','unset ',& - 'cam3_bcpho ','unset ',& - 'cam3_dust1 ','unset ',& - 'cam3_dust2 ','unset ',& - 'cam3_dust3 ','unset ',& - 'cam3_dust4 ','unset ',& - 'cam3_ocphi ','unset ',& - 'cam3_ocpho ','unset ',& - 'cam3_ssam ','unset ',& - 'cam3_sscm ','unset ',& - 'cam3_sul ','unset ',& - 'CC_ni ','unset ',& - 'CC_nl ','unset ',& - 'CC_qi ','unset ',& - 'CC_ql ','unset ',& - 'CC_qlst ','unset ',& - 'CC_qv ','unset ',& - 'CC_T ','unset ',& - 'CICEWP ','unset ',& - 'CLDBOT ','1 ',& - 'CLDEMIS ','unset ',& - 'CLDFGRAU ','1 ',& - 'CLDFSNOW ','1 ',& - 'CLD ','unset ',& - 'CLDICEINI ','unset ',& - 'CLDLIQINI ','unset ',& - 'CLDO ','unset ',& - 'CLDTAU ','unset ',& - 'CLDTOP ','1 ',& - 'CLIQWP ','unset ',& - 'CLOUD_FRAC ','unset ',& - 'CLUBB_BUFFER ','unset ',& - 'CMELIQ ','kg/kg/s ',& - 'CMFMC_SH ','unset ',& - 'cmfr_det ','kg/m2/s ',& - 'CONCLD ','fraction ',& - 'CRM_CLD_RAD ','unset ',& - 'CRM_DGNUMWET ','unset ',& - 'CRM_NC ','/kg ',& - 'CRM_NC_RAD ','unset ',& - 'CRM_NG ','/kg ',& - 'CRM_NI ','/kg ',& - 'CRM_NI_RAD ','unset ',& - 'CRM_NR ','/kg ',& - 'CRM_NS ','/kg ',& - 'CRM_NS_RAD ','unset ',& - 'CRM_QAERWAT ','unset ',& - 'CRM_QC ','kg/kg ',& - 'CRM_QC_RAD ','unset ',& - 'CRM_QG ','kg/kg ',& - 'CRM_QI ','kg/kg ',& - 'CRM_QI_RAD ','unset ',& - 'CRM_QN ','unset ',& - 'CRM_QP ','kg/kg ',& - 'CRM_QRAD ','unset ',& - 'CRM_QR ','kg/kg ',& - 'CRM_QS ','kg/kg ',& - 'CRM_QS_RAD ','unset ',& - 'CRM_QT ','unset ',& - 'CRM_QV_RAD ','unset ',& - 'CRM_T ',' K ',& - 'CRM_T_RAD ','unset ',& - 'CRM_U ','m/s ',& - 'CRM_V ','m/s ',& - 'CRM_W ','m/s ',& - 'CT ','unset ',& - 'cu_cmfr ','kg/m2/s ',& - 'cuorg ','unset ',& - 'cu_qir ','kg/kg ',& - 'cu_qlr ','kg/kg ',& - 'cu_qtr ','kg/kg ',& - 'cushavg ','m ',& - 'cush ','m ',& - 'cu_thlr ','K ',& - 'cu_trr ','unset ',& - 'cu_ur ','m/s ',& - 'cu_vr ','m/s ',& - 'CV_REFFICE ','micron ',& - 'CV_REFFLIQ ','micron ',& - 'DEGRAU ','unset ',& - 'DEI ','unset ',& - 'delta_qt_PBL ','unset ',& - 'delta_thl_PBL ','unset ',& - 'delta_tr_PBL ','unset ',& - 'delta_u_PBL ','unset ',& - 'delta_v_PBL ','unset '/) , (/2,100/)) - - pbuf_all(1:2,101:200) = reshape ( (/ & - 'DES ','unset ',& - 'DGNUM ','unset ',& - 'DGNUMWET ','unset ',& - 'DIFZM ','kg/kg/s ',& - 'DLFZM ','kg/kg/s ',& - 'DNIFZM ','1/kg/s ',& - 'DNLFZM ','1/kg/s ',& - 'DP_CLDICE ','unset ',& - 'DP_CLDLIQ ','unset ',& - 'DP_FLXPRC ','unset ',& - 'DP_FLXSNW ','unset ',& - 'DP_FRAC ','unset ',& - 'dragblj ','1/s ',& - 'DRYMASS ','unset ',& - 'DRYRAD ','unset ',& - 'DRYVOL ','unset ',& - 'DTCORE ','K/s ',& - 'evprain_st ','unset ',& - 'evpsnow_st ','unset ',& - 'FICE ','fraction ',& - 'FLNS ','W/m2 ',& - 'FLNT ','W/m2 ',& - 'FRACIS ','unset ',& - 'FRACSOA ','unset ',& - 'FRACSOG ','unset ',& - 'FRONTGA ','unset ',& - 'FRONTGF ','K^2/M^2/S ',& - 'FRZCNT ','unset ',& - 'FRZDEP ','unset ',& - 'FRZIMM ','unset ',& - 'FSDS ','W/m2 ',& - 'FSNS ','W/m2 ',& - 'FSNT ','W/m2 ',& - 'HallConduct ','unset ',& - 'HYGRO ','unset ',& - 'ICCWAT ','unset ',& - 'ICGRAUWP ','unset ',& - 'ICIWP ','unset ',& - 'ICIWPST ','unset ',& - 'ICLWP ','unset ',& - 'ICLWPST ','unset ',& - 'ICSWP ','unset ',& - 'ICWMRDP ','kg/kg ',& - 'ICWMRSH ','kg/kg ',& - 'IonRates ','unset ',& - 'ipbl ','unset ',& - 'ISS_FRAC ','unset ',& - 'kpblh ','unset ',& - 'ksrftms ','unset ',& - 'kvh ','m2/s ',& - 'kvm ','m2/s ',& - 'kvt ','m2/s ',& - 'LAMBDAC ','unset ',& - 'LANDM ','unset ',& - 'LCWAT ','unset ',& - 'LD ','unset ',& - 'LHFLX ','W/m2 ',& - 'LHFLX_RES ','unset ',& - 'LS_FLXPRC ','kg/m2/s ',& - 'LS_FLXSNW ','kg/m2/s ',& - 'LS_MRPRC ','unset ',& - 'LS_MRSNW ','unset ',& - 'LS_REFFRAIN ','micron ',& - 'LS_REFFSNOW ','micron ',& - 'LU ','unset ',& - 'MAMH2SO4EQ ','unset ',& - 'MU ','Pa/s ',& - 'NAAI_HOM ','unset ',& - 'NAAI ','unset ',& - 'NACON ','unset ',& - 'NAER ','unset ',& - 'NEVAPR_DPCU ','unset ',& - 'NEVAPR ','unset ',& - 'NEVAPR_SHCU ','unset ',& - 'NIWAT ','unset ',& - 'NLWAT ','unset ',& - 'NMXRGN ','unset ',& - 'NPCCN ','unset ',& - 'NRAIN ','m-3 ',& - 'NSNOW ','m-3 ',& - 'O3 ','unset ',& - 'pblh ','m ',& - 'PDF_PARAMS ','unset ',& - 'PDF_PARAMS_ZM ','unset ',& - 'PedConduct ','unset ',& - 'PMXRGN ','unset ',& - 'PRAIN ','unset ',& - 'PREC_DP ','unset ',& - 'PREC_PCW ','m/s ',& - 'PREC_SED ','unset ',& - 'PREC_SH ','unset ',& - 'PREC_SH ','unset ',& - 'PREC_STR ','unset ',& - 'PRER_EVAP ','unset ',& - 'PSL ','Pa ',& - 'QAERWAT ','unset ',& - 'QCWAT ','unset ',& - 'QFLX ','kg/m2/s ',& - 'QFLX_RES ','unset ',& - 'QINI ','unset ' /), (/2,100/)) - - pbuf_all(1:2,201:300) = reshape ( (/ & - 'qir_det ','kg/kg ',& - 'QIST ','unset ',& - 'qlr_det ','kg/kg ',& - 'QLST ','unset ',& - 'QME ','unset ',& - 'qpert ','kg/kg ',& - 'QRAIN ','kg/kg ',& - 'QRL ','K/s ',& - 'qrlin ','unset ',& - 'QRS ','K/s ',& - 'qrsin ','unset ',& - 'QSATFAC ','- ',& - 'QSNOW ','kg/kg ',& - 'QTeAur ','unset ',& - 'qti_flx ','unset ',& - 'qtl_flx ','unset ',& - 'RAD_CLUBB ','unset ',& - 'RATE1_CW2PR_ST ','unset ',& - 'RCM ','unset ',& - 'RE_ICE ','unset ',& - 'REI ','micron ',& - 'RELHUM ','percent ',& - 'REL ','micron ',& - 'RELVAR ','- ',& - 'RNDST ','unset ',& - 'RPRDDP ','unset ',& - 'RPRDSH ','unset ',& - 'RPRDTOT ','unset ',& - 'RTM ','unset ',& - 'rtp2_mc_zt ','unset ',& - 'RTP2_nadv ','unset ',& - 'rtpthlp_mc_zt ','unset ',& - 'RTPTHLP_nadv ','unset ',& - 'RTPTHVP ','unset ',& - 'SADICE ','cm2/cm3 ',& - 'SADSNOW ','cm2/cm3 ',& - 'SADSULF ','unset ',& - 'SD ','unset ',& - 'SGH30 ','unset ',& - 'SGH ','unset ',& - 'SH_CLDICE1 ','unset ',& - 'SH_CLDICE ','unset ',& - 'SH_CLDLIQ1 ','unset ',& - 'SH_CLDLIQ ','unset ',& - 'SH_E_ED_RATIO ','unset ',& - 'SHFLX ','W/m2 ',& - 'SH_FLXPRC ','unset ',& - 'SHFLX_RES ','unset ',& - 'SH_FLXSNW ','unset ',& - 'SH_FRAC ','unset ',& - 'shfrc ','unset ',& - 'smaw ','unset ',& - 'SNOW_DP ','unset ',& - 'SNOW_PCW ','unset ',& - 'SNOW_SED ','unset ',& - 'SNOW_SH ','unset ',& - 'SNOW_STR ','unset ',& - 'SO4DRYVOL ','unset ',& - 'SSLTA ','kg/kg ',& - 'SSLTC ','kg/kg ',& - 'SU ','unset ',& - "taubljx ",'N/m2 ',& - "taubljy ",'N/m2 ',& - 'tauresx ','unset ',& - 'tauresy ','unset ',& - "tautmsx ",'N/m2 ',& - "tautmsy ",'N/m2 ',& - 'TAUX ','N/m2 ',& - 'TAUX_RES ','unset ',& - 'TAUY ','N/m2 ',& - 'TAUY_RES ','unset ',& - 'tcorr ','unset ',& - 'TCWAT ','unset ',& - 'TElec ','K ',& - 'TEOUT ','J/m2 ',& - 'THLM ','unset ',& - 'thlp2_mc_zt ','unset ',& - 'THLP2_nadv ','unset ',& - 'THLPTHVP ','unset ',& - 'TIon ','K ',& - 'TK_CRM ','unset ',& - 'tke ','m2/s2 ',& - 'tkes ','m2/s2 ',& - 'TND_NSNOW ','unset ',& - 'TND_QSNOW ','unset ',& - 'tpert ','K ',& - 'TREFMNAV ','K ',& - 'TREFMXAV ','K ',& - 'tropp ','unset ',& - 'TSTCPY_SCOL ','unset ',& - 'TTEND_DP ','unset ',& - 'TTEND_SH ','unset ',& - 'T_TTEND ','unset ',& - 'turbtype ','unset ',& - "UI ",'m/s ',& - 'UM ','unset ',& - 'UP2_nadv ','unset ',& - 'UPWP ','m^2/s^2 ',& - 'UZM ','M/S ',& - 'VI ','m/s ' /), (/2,100/)) - - pbuf_all(1:2,301:npbuf_all) = reshape ( (/ & - 'VM ','m/s ',& - 'VOLC_MMR ','unset ',& - 'VOLC_RAD_GEOM ','unset ',& - 'VP2_nadv ','unset ',& - 'VPWP ','m^2/s^2 ',& - 'went ','m/s ',& - 'WETDENS_AP ','unset ',& - "WI ",'m/s ',& - 'WP3_nadv ','unset ',& - 'wprtp_mc_zt ','unset ',& - 'WPRTP_nadv ','unset ',& - 'wpthlp_mc_zt ','unset ',& - 'WPTHLP_nadv ','unset ',& - 'WPTHVP ','unset ',& - 'WSEDL ','unset ',& - 'wstarPBL ','unset ',& - 'ZM_DP ','unset ',& - 'ZM_DSUBCLD ','unset ',& - 'ZM_DU ','unset ',& - 'ZM_ED ','unset ',& - 'ZM_EU ','unset ',& - 'ZM_IDEEP ','unset ',& - 'ZM_JT ','unset ',& - 'ZM_MAXG ','unset ',& - 'ZM_MD ','unset ',& - 'ZM_MU ','unset ',& - 'ZTODT ','unset ' /), (/2,27/)) - -! Fields which are added with pbuf_add_field calls, but are data driven. These are not -! included in the above list. This means that these fields will not have proper units -! set for them -! 'CG' // shortname, 'unset', & -! 'CI' // shortname, 'unset', & -! 'CL' // shortname, 'unset', & -! ghg_names(i), 'unset', & -! mmr_name1, 'unset', & -! mmr_name2, 'unset', & -! mmr_name3, 'unset', & -! mmr_name, 'unset', & -! ozone_name, 'unset', & -! pbufname, 'unset', & -! pbufname, 'unset', & -! pbuf_names(i), 'unset', & -! rad_name1, 'unset', & -! rad_name2, 'unset', & -! rad_name3, 'unset', & -! rad_name, 'unset', & -! sad_name, 'cm2/cm3', & -! volcaero_name, 'kg/kg', & -! volcrad_name, 'm', & -! xname_massptrcw(l, 'unset', & -! xname_numptrcw, 'unset', & -! aero_names(mm) -! cnst_names(iconst) - - do ipbuf = 1, size(pbuf) - pbuf_name = pbuf_get_field_name(ipbuf) - i = 1 - do while ((i <= npbuf_all) .and. .not. found(ipbuf)) - if (trim(pbuf_all(1,i)) == trim(pbuf_name)) then - pbuf_info(ipbuf)%name = trim(pbuf_all(1,i)) - pbuf_info(ipbuf)%standard_name = trim(pbuf_all(1,i))//'_snapshot' - pbuf_info(ipbuf)%units = trim(pbuf_all(2,i)) - pbuf_info(ipbuf)%dim_string(:) = ' ' - found(ipbuf) = .true. - end if - i = i+1 - end do - if (.not. found(ipbuf)) then - - i = 1 - ! Check if variable is a variation of constituent - then use the same units - do while ((i <= ncnst_var) .and. .not. found(ipbuf)) - if (trim(const_cname(i)) == trim(pbuf_name)) then - pbuf_info(ipbuf) = pbuf_info_type(trim(const_cname(i)),trim(const_cname(i))//'_snapshot',& - trim(cnst_snapshot(i)%units), ' ') - found(ipbuf) = .true. - end if - i = i+1 - end do - end if - - ! Found a pbuf that has not been added to this routine - if (.not. found(ipbuf)) then - write(iulog,*) 'WARNING - no units information for: '//trim(pbuf_name) - - pbuf_info(ipbuf)%name = trim(pbuf_name) - pbuf_info(ipbuf)%standard_name = trim(pbuf_name)//'_snapshot' - pbuf_info(ipbuf)%units = 'unset' - pbuf_info(ipbuf)%dim_string(:) = ' ' - found(ipbuf) = .true. - end if - - end do - -end subroutine fill_pbuf_info - - -end module cam_snapshot diff --git a/src/control/cam_snapshot_common.F90 b/src/control/cam_snapshot_common.F90 new file mode 100644 index 0000000000..0f49d27a02 --- /dev/null +++ b/src/control/cam_snapshot_common.F90 @@ -0,0 +1,1638 @@ +module cam_snapshot_common +!-------------------------------------------------------- +! The purpose of this module is to handle taking the "snapshot" of CAM data. +! +! This module writes out ALL the state, tend and pbuf fields. It also includes the cam_in and cam_out +! fields which are used within CAM +!-------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use cam_history, only: addfld, add_default, outfld +use cam_history, only: cam_history_snapshot_deactivate, cam_history_snapshot_activate +use cam_history_support, only: horiz_only +use cam_abortutils, only: endrun +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_get_field_name +use physics_types, only: physics_state, physics_tend, physics_ptend +use camsrfexch, only: cam_out_t, cam_in_t +use ppgrid, only: pcols, begchunk, endchunk +use constituents, only: pcnst +use phys_control, only: phys_getopts +use cam_logfile, only: iulog + +implicit none + +private + +public :: cam_snapshot_deactivate +public :: cam_snapshot_all_outfld +public :: cam_snapshot_ptend_outfld +public :: snapshot_type +public :: cam_state_snapshot_init +public :: cam_cnst_snapshot_init +public :: cam_tend_snapshot_init +public :: cam_ptend_snapshot_init +public :: cam_in_snapshot_init +public :: cam_out_snapshot_init +public :: cam_pbuf_snapshot_init +public :: snapshot_addfld + +private :: snapshot_addfld_nd +private :: state_snapshot_all_outfld +private :: cnst_snapshot_all_outfld +private :: tend_snapshot_all_outfld +private :: cam_in_snapshot_all_outfld +private :: cam_out_snapshot_all_outfld +private :: cam_pbuf_snapshot_all_outfld +private :: fill_pbuf_info + + + +! This is the number of pbuf fields in the CAM code that are declared with the fieldname as opposed to being data driven. +integer, parameter :: npbuf_all = 310 + +type snapshot_type + character(len=40) :: ddt_string + character(len=256) :: standard_name + character(len=20) :: dim_name + character(len=8) :: units +end type snapshot_type + +type snapshot_type_nd + character(len=40) :: ddt_string + character(len=256) :: standard_name + character(len=20) :: dim_name(6) ! hardwired 6 potential dimensions in pbuf + character(len=8) :: units +end type snapshot_type_nd + +type pbuf_info_type + character(len=40) :: name + character(len=256) :: standard_name + character(len=8) :: units + character(len=100) :: dim_string(6) ! hardwired 6 potential dimensions in pbuf +end type pbuf_info_type + +integer :: nstate_var +integer :: ncnst_var +integer :: ntend_var +integer :: ncam_in_var +integer :: ncam_out_var +integer :: npbuf_var + +integer :: cam_snapshot_before_num, cam_snapshot_after_num + +! Note the maximum number of variables for each type +type (snapshot_type) :: state_snapshot(30) +type (snapshot_type) :: cnst_snapshot(pcnst) +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(300) + +contains + +subroutine cam_snapshot_all_outfld(file_num, state, tend, cam_in, cam_out, pbuf) + +use time_manager, only: is_first_step + +!-------------------------------------------------------- +! This subroutine does the outfld calls for ALL state, tend and pbuf fields. It also includes the cam_in and cam_out +! elements which are used within CAM +!-------------------------------------------------------- + + integer, intent(in) :: file_num + type(physics_state), intent(in) :: state + type(physics_tend), intent(in) :: tend + type(cam_in_t), intent(in) :: cam_in + type(cam_out_t), intent(in) :: cam_out + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) + + + integer :: lchnk + + ! Return if the first timestep as not all fields may be filled in and this will cause a core dump + if (is_first_step()) return + + ! Return if not turned on + if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested + + lchnk = state%lchnk + + ! Write out all the state fields + call state_snapshot_all_outfld(lchnk, file_num, state) + + ! Write out all the constituent fields + call cnst_snapshot_all_outfld(lchnk, file_num, state%q) + + ! Write out all the tendency fields + call tend_snapshot_all_outfld(lchnk, file_num, tend) + + ! Write out all the cam_in fields + call cam_in_snapshot_all_outfld(lchnk, file_num, cam_in) + + ! Write out all the cam_out fields + call cam_out_snapshot_all_outfld(lchnk, file_num, cam_out) + + ! Write out all the pbuf fields + call cam_pbuf_snapshot_all_outfld(lchnk, file_num, pbuf) + +end subroutine cam_snapshot_all_outfld + +subroutine cam_snapshot_deactivate() + +!-------------------------------------------------------- +! This subroutine deactivates the printing of the snapshot before and after files +! Note - this needs to be done as add_default has been called to setup the proper +! outputting of the requested fields. The outfld calls will only write +! one file at a time (using the same name in both files), hence the writing +! needs to be turned off for all fields, and will be turned on individaully +! when needed. +!-------------------------------------------------------- + integer :: i + + ! Return if not turned on + if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested + + do i=1,nstate_var + call cam_history_snapshot_deactivate(state_snapshot(i)%standard_name) + end do + + do i=1,ncnst_var + call cam_history_snapshot_deactivate(cnst_snapshot(i)%standard_name) + end do + + do i=1,ntend_var + call cam_history_snapshot_deactivate(tend_snapshot(i)%standard_name) + end do + + do i=1,ncam_in_var + call cam_history_snapshot_deactivate(cam_in_snapshot(i)%standard_name) + end do + + do i=1,ncam_out_var + call cam_history_snapshot_deactivate(cam_out_snapshot(i)%standard_name) + end do + + do i=1,npbuf_var + call cam_history_snapshot_deactivate(pbuf_snapshot(i)%standard_name) + end do + +end subroutine cam_snapshot_deactivate + + +subroutine cam_state_snapshot_init(cam_snapshot_before_num_in, cam_snapshot_after_num_in) + +!-------------------------------------------------------- +! This subroutine does the addfld calls for state +!-------------------------------------------------------- + + integer,intent(in) :: cam_snapshot_before_num_in, cam_snapshot_after_num_in + + nstate_var = 0 + + cam_snapshot_before_num = cam_snapshot_before_num_in + cam_snapshot_after_num = cam_snapshot_after_num_in + + !-------------------------------------------------------- + ! Add the state variables to the output + !-------------------------------------------------------- + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%ps', 'state_ps', 'Pa', horiz_only) + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%psdry', 'state_psdry', 'Pa', horiz_only) + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%phis', 'state_phis', 'm2/m2', horiz_only) + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%t', 'state_t', 'K', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%u', 'state_u', 'm s-1', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%v', 'state_v', 'm s-1', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%s', 'state_s', ' ', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%omega', 'state_omega', 'Pa s-1', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%pmid', 'state_pmid', 'Pa', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%pmiddry', 'state_pmiddry', 'Pa', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%pdel', 'state_pdel', 'Pa', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%pdeldry', 'state_pdeldry', 'Pa', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%rpdel', 'state_rpdel', 'Pa', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%rpdeldry', 'state_rpdeldry', 'Pa', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%lnpmid', 'state_lnpmid', 'unset', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%lnpmiddry', 'state_lnpmiddry', 'unset', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%exner', 'state_exner', 'unset', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%zm', 'state_zm', 'm', 'lev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%pint', 'state_pint', 'Pa', 'ilev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%pintdry', 'state_pintdry', 'Pa', 'ilev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%lnpint', 'state_lnpint', 'unset', 'ilev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%lnpintdry', 'state_lnpintdry', 'unset', 'ilev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%zi', 'state_zi', 'm', 'ilev') + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%te_ini_phys', 'state_te_ini_phys', 'unset', horiz_only) + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%te_cur_phys', 'state_te_cur_phys', 'unset', horiz_only) + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%tw_ini', 'state_tw_ini', 'unset', horiz_only) + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%tw_cur', 'state_tw_cur', 'unset', horiz_only) + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%te_ini_dyn', 'state_te_ini_dyn', 'unset', horiz_only) + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%te_cur_dyn', 'state_te_cur_dyn', 'unset', horiz_only) + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'air_composition_cp_or_cv_dycore', 'cp_or_cv_dycore', 'J kg-1 K-1', 'lev') + +end subroutine cam_state_snapshot_init + +subroutine cam_cnst_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + +!-------------------------------------------------------- +! This subroutine does the addfld calls for state constituent (q) fields +!-------------------------------------------------------- + + use constituents, only: cnst_name, cnst_longname + + integer, intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num + + !-------------------------------------------------------- + ! Add the cnst variables to the output + !-------------------------------------------------------- + + ncnst_var = 0 ! Updated inside snapshot_addfld + + do while (ncnst_var < pcnst) + call snapshot_addfld(ncnst_var, cnst_snapshot, cam_snapshot_before_num, & + cam_snapshot_after_num, cnst_name(ncnst_var+1), & + trim('cnst_'//cnst_name(ncnst_var+1)), 'kg kg-1', 'lev') + end do + +end subroutine cam_cnst_snapshot_init + +subroutine cam_tend_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + +!-------------------------------------------------------- +! This subroutine does the addfld calls for tend fields. +!-------------------------------------------------------- + + integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num + + ntend_var = 0 + + !-------------------------------------------------------- + ! Add the physics_tend variables to the output + !-------------------------------------------------------- + + call snapshot_addfld( ntend_var, tend_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'tend%dtdt', 'tend_dtdt', 'K s-1', 'lev') + + call snapshot_addfld( ntend_var, tend_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'tend%dudt', 'tend_dudt', '', 'lev') + + call snapshot_addfld( ntend_var, tend_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'tend%dvdt', 'tend_dvdt', '', 'lev') + + call snapshot_addfld( ntend_var, tend_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'tend%flx_net', 'tend_flx_net', '', horiz_only) + + call snapshot_addfld( ntend_var, tend_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'tend%te_tnd', 'tend_te_tnd', '', horiz_only) + + call snapshot_addfld( ntend_var, tend_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'tend%tw_tnd', 'tend_tw_tnd', '', horiz_only) + +end subroutine cam_tend_snapshot_init + +subroutine cam_ptend_snapshot_init(cam_snapshot_after_num) + use constituents, only: cnst_name, cnst_longname + + !-------------------------------------------------------- + ! This subroutine does the addfld calls for ptend fields. + !-------------------------------------------------------- + + integer,intent(in) :: cam_snapshot_after_num + + integer :: mcnst + character(len=64) :: fname + character(len=128) :: lname + character(len=32) :: cam_take_snapshot_before + character(len=32) :: cam_take_snapshot_after + + call phys_getopts(cam_take_snapshot_before_out = cam_take_snapshot_before, & + cam_take_snapshot_after_out = cam_take_snapshot_after) + + if (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after)) then + + !-------------------------------------------------------- + ! Add the physics_ptend variables to the output + !-------------------------------------------------------- + + call addfld('ptend_s', (/ 'lev' /), 'I', 'J kg-1 s-1', & + 'heating rate snapshot') + call add_default('ptend_s', cam_snapshot_after_num, ' ') + + call addfld('ptend_u', (/ 'lev' /), 'I', 'm s-1 s-1', & + 'momentum tendency snapshot') + call add_default('ptend_u', cam_snapshot_after_num, ' ') + + call addfld('ptend_v', (/ 'lev' /), 'I', 'm s-1 s-1', & + 'momentum tendency snapshot') + call add_default('ptend_v', cam_snapshot_after_num, ' ') + + call addfld('ptend_hflux_srf', horiz_only, 'I', 'W m-2', & + 'net zonal stress at surface snapshot') + call add_default('ptend_hflux_srf', cam_snapshot_after_num, ' ') + + call addfld('ptend_hflux_top', horiz_only, 'I', 'W m-2', & + 'net zonal stress at top of model snapshot') + call add_default('ptend_hflux_top', cam_snapshot_after_num, ' ') + + call addfld('ptend_taux_srf', horiz_only, 'I', 'Pa', & + 'net meridional stress at surface snapshot') + call add_default('ptend_taux_srf', cam_snapshot_after_num, ' ') + + call addfld('ptend_taux_top', horiz_only, 'I', 'Pa', & + 'net zonal stress at top of model snapshot') + call add_default('ptend_taux_top', cam_snapshot_after_num, ' ') + + call addfld('ptend_tauy_srf', horiz_only, 'I', 'Pa', & + 'net meridional stress at surface snapshot') + call add_default('ptend_tauy_srf', cam_snapshot_after_num, ' ') + + call addfld('ptend_tauy_top', horiz_only, 'I', 'Pa', & + 'net meridional stress at top of model snapshot') + call add_default('ptend_tauy_top', cam_snapshot_after_num, ' ') + + do mcnst = 1, pcnst + fname = 'ptend_'//trim(cnst_name(mcnst)) + lname = 'tendency of '//trim(cnst_longname(mcnst)) + call addfld(trim(fname), (/ 'lev' /), 'I', 'kg kg-1 s-1', trim(lname)) + call add_default(trim(fname), cam_snapshot_after_num, ' ') + + fname = 'ptend_cflx_srf_'//trim(cnst_name(mcnst)) + lname = 'flux of '//trim(cnst_longname(mcnst))//' at surface snapshot' + call addfld(trim(fname), horiz_only, 'I', 'kg m-2 s-1', trim(lname)) + call add_default(trim(fname), cam_snapshot_after_num, ' ') + + fname = 'ptend_cflx_top_'//trim(cnst_name(mcnst)) + lname = 'flux of '//trim(cnst_longname(mcnst))//' at top of model snapshot' + call addfld(trim(fname), horiz_only, 'I', 'kg m-2 s-1', trim(lname)) + call add_default(trim(fname), cam_snapshot_after_num, ' ') + end do + + end if + +end subroutine cam_ptend_snapshot_init + +subroutine cam_in_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, cam_in) + +!-------------------------------------------------------- +! This subroutine does the addfld calls for cam_in fields +!-------------------------------------------------------- + + type(cam_in_t), intent(in) :: cam_in + + integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num + + ncam_in_var = 0 + + !-------------------------------------------------------- + ! Add the state variables to the output + !-------------------------------------------------------- + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%landfrac', 'cam_in_landfrac', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%ocnfrac', 'cam_in_ocnfrac', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%snowhland', 'cam_in_snowhland', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%ts', 'cam_in_ts', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%sst', 'cam_in_sst', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%icefrac', 'cam_in_icefrac', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%shf', 'cam_in_shf', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%cflx', 'cam_in_cflx', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%wsx', 'cam_in_wsx', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%wsy', 'cam_in_wsy', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%asdif', 'cam_in_asdif', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%aldif', 'cam_in_aldif', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%lwup', 'cam_in_lwup', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%asdir', 'cam_in_asdir', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%aldir', 'cam_in_aldir', 'unset', horiz_only) + + if (associated (cam_in%meganflx)) & + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%meganflx', 'cam_in_meganflx', 'unset', horiz_only) + + if (associated (cam_in%fireflx)) & + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%fireflx', 'cam_in_fireflx', 'unset', horiz_only) + + if (associated (cam_in%fireztop)) & + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%fireztop', 'cam_in_fireztop', 'unset', horiz_only) + + if (associated (cam_in%depvel)) & + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%depvel', 'cam_in_depvel', 'unset', horiz_only) + + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%lhf', 'cam_in_lhf', 'unset', horiz_only) + + if (associated (cam_in%fv)) & + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%fv', 'cam_in_fv', 'unset', horiz_only) + + if (associated (cam_in%ram1)) & + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%ram1', 'cam_in_ram1', 'unset', horiz_only) + + if (associated (cam_in%dstflx)) & + call snapshot_addfld( ncam_in_var, cam_in_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_in%dstflx', 'cam_in_dstflx', 'unset', horiz_only) + +end subroutine cam_in_snapshot_init + +subroutine cam_out_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, cam_out) + +!-------------------------------------------------------- +! This subroutine does the addfld calls for cam_out fields +!-------------------------------------------------------- + + type(cam_out_t), intent(in) :: cam_out + + integer, intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num + + ncam_out_var = 0 + + !-------------------------------------------------------- + ! Add the state variables to the output + !-------------------------------------------------------- + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%precc', 'cam_out_precc', 'm s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%precl', 'cam_out_precl', 'm s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%precsc', 'cam_out_precsc', 'm s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%precsl', 'cam_out_precsl', 'm s-1', horiz_only) + + if (associated(cam_out%nhx_nitrogen_flx)) & + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%nhx_nitrogen_flx', 'cam_out_nhx_nitrogen_flx', 'kgN m2-1 sec-1', horiz_only) + + if (associated(cam_out%noy_nitrogen_flx)) & + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%noy_nitrogen_flx', 'cam_out_noy_nitrogen_flx', 'kgN m2-1 sec-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%bcphodry', 'cam_out_bcphodry', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%bcphidry', 'cam_out_bcphidry', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%ocphodry', 'cam_out_ocphodry', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%ocphidry', 'cam_out_ocphidry', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%bcphiwet', 'cam_out_bcphiwet', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%ocphiwet', 'cam_out_ocphiwet', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%dstwet1', 'cam_out_dstwet1', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%dstwet2', 'cam_out_dstwet2', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%dstwet3', 'cam_out_dstwet3', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%dstwet4', 'cam_out_dstwet4', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%dstdry1', 'cam_out_dstdry1', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%dstdry2', 'cam_out_dstdry2', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%dstdry3', 'cam_out_dstdry3', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%dstdry4', 'cam_out_dstdry4', 'kg m-2 s-1', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%sols', 'cam_out_sols', 'W m-2', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%soll', 'cam_out_soll', 'W m-2', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%solsd', 'cam_out_solsd', 'W m-2', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%solld', 'cam_out_solld', 'W m-2', horiz_only) + + call snapshot_addfld( ncam_out_var, cam_out_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cam_out%netsw', 'cam_out_netsw', 'unset', horiz_only) + +end subroutine cam_out_snapshot_init + +subroutine cam_pbuf_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, pbuf) + +!-------------------------------------------------------- +! This subroutine does the addfld calls for pbuf fields. +!-------------------------------------------------------- + + use physics_buffer, only: pbuf_get_dim_strings + + integer, intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num + type(physics_buffer_desc), intent(in) :: pbuf(:) + + integer :: i, j, npbuf + type(pbuf_info_type) :: pbuf_info(size(pbuf)) + character(len=40) :: const_cname(ncnst_var) + character(len=40) :: dim_strings(size(pbuf),6) ! Hardwired 6 potential dimensions in pbuf + + npbuf = size(pbuf(:)) + + !-------------------------------------------------------- + ! fill the name, standard name and units for pbuf_info + !-------------------------------------------------------- + + call fill_pbuf_info(pbuf_info, pbuf, const_cname) + + !-------------------------------------------------------- + ! Determine the indices for the addfld call based on the dimensions in the pbuf + !-------------------------------------------------------- + + call pbuf_get_dim_strings(pbuf, dim_strings) + do i=1, npbuf + ! If the second dimension is empty, then this is a horiz_only field + if (trim(dim_strings(i,2)) == '') then + pbuf_info(i)%dim_string(1) = horiz_only + else + ! The first dimension is the horizontal dimension and should not be used in the addfld call + do j=2,6 + pbuf_info(i)%dim_string(j-1) = dim_strings(i,j) + end do + end if + end do + + !-------------------------------------------------------- + ! Now that all of the information for the pbufs is stored, call the addfld + !-------------------------------------------------------- + npbuf_var = 0 ! Updated inside snapshot_addfld + + do while (npbuf_var < npbuf) + call snapshot_addfld_nd( npbuf_var, pbuf_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + pbuf_info(npbuf_var+1)%name, pbuf_info(npbuf_var+1)%standard_name, pbuf_info(npbuf_var+1)%units,& + pbuf_info(npbuf_var+1)%dim_string) + end do + +end subroutine cam_pbuf_snapshot_init + +subroutine snapshot_addfld_nd(nddt_var, ddt_snapshot, cam_snapshot_before_num, cam_snapshot_after_num,& + ddt_string, standard_name, units, dimension_string) + + integer, intent(inout) :: nddt_var + type (snapshot_type_nd), intent(inout) :: ddt_snapshot(:) + + + integer, intent(in) :: cam_snapshot_before_num + integer, intent(in) :: cam_snapshot_after_num + character(len=*), intent(in) :: ddt_string + character(len=*), intent(in) :: standard_name + character(len=*), intent(in) :: units + character(len=*), intent(in) :: dimension_string(:) + + integer :: ndims + + nddt_var=nddt_var+1 + + if (nddt_var > size(ddt_snapshot)) & + call endrun(' ERROR in snapshot_addfld: ddt_snapshot array not allocated large enough') + + ndims = count(dimension_string /= '') + + if (trim(dimension_string(1)) == horiz_only) then + call addfld(standard_name, horiz_only, 'I', units, standard_name) + else + call addfld(standard_name, dimension_string(1:ndims), 'I', units, standard_name) + end if + if (cam_snapshot_before_num > 0) call add_default(standard_name, cam_snapshot_before_num, ' ') + if (cam_snapshot_after_num > 0) call add_default(standard_name, cam_snapshot_after_num, ' ') + + ddt_snapshot(nddt_var)%ddt_string = ddt_string + ddt_snapshot(nddt_var)%standard_name = standard_name + ddt_snapshot(nddt_var)%dim_name(:) = dimension_string(:) + ddt_snapshot(nddt_var)%units = units + + +end subroutine snapshot_addfld_nd + +subroutine snapshot_addfld(nddt_var, ddt_snapshot, cam_snapshot_before_num, cam_snapshot_after_num,& + ddt_string, standard_name, units, dimension_string) + + integer, intent(inout) :: nddt_var + type (snapshot_type), intent(inout) :: ddt_snapshot(:) + + + integer, intent(in) :: cam_snapshot_before_num + integer, intent(in) :: cam_snapshot_after_num + character(len=*), intent(in) :: ddt_string + character(len=*), intent(in) :: standard_name + character(len=*), intent(in) :: units + character(len=*), intent(in) :: dimension_string + + + nddt_var=nddt_var+1 + + if (nddt_var > size(ddt_snapshot)) & + call endrun(' ERROR in snapshot_addfld: ddt_snapshot array not allocated large enough') + + call addfld(standard_name, dimension_string, 'I', units, standard_name) + if (cam_snapshot_before_num > 0) call add_default(standard_name, cam_snapshot_before_num, ' ') + if (cam_snapshot_after_num > 0) call add_default(standard_name, cam_snapshot_after_num, ' ') + + ddt_snapshot(nddt_var)%ddt_string = ddt_string + ddt_snapshot(nddt_var)%standard_name = standard_name + ddt_snapshot(nddt_var)%dim_name = dimension_string + ddt_snapshot(nddt_var)%units = units + + +end subroutine snapshot_addfld + +subroutine state_snapshot_all_outfld(lchnk, file_num, state) + + use physics_types, only: phys_te_idx, dyn_te_idx + use air_composition, only: cp_or_cv_dycore + + integer, intent(in) :: lchnk + integer, intent(in) :: file_num + type(physics_state), intent(in) :: state + + integer :: i + + do i=1, nstate_var + + ! Turn on the writing for only the requested tape (file_num) + call cam_history_snapshot_activate(trim(state_snapshot(i)%standard_name), file_num) + + ! Select the state field which is being written + select case(state_snapshot(i)%ddt_string) + + case ('state%ps') + call outfld(state_snapshot(i)%standard_name, state%ps, pcols, lchnk) + + case ('state%psdry') + call outfld(state_snapshot(i)%standard_name, state%psdry, pcols, lchnk) + + case ('state%phis') + call outfld(state_snapshot(i)%standard_name, state%phis, pcols, lchnk) + + case ('state%t') + call outfld(state_snapshot(i)%standard_name, state%t, pcols, lchnk) + + case ('state%u') + call outfld(state_snapshot(i)%standard_name, state%u, pcols, lchnk) + + case ('state%v') + call outfld(state_snapshot(i)%standard_name, state%v, pcols, lchnk) + + case ('state%s') + call outfld(state_snapshot(i)%standard_name, state%s, pcols, lchnk) + + case ('state%omega') + call outfld(state_snapshot(i)%standard_name, state%omega, pcols, lchnk) + + case ('state%pmid') + call outfld(state_snapshot(i)%standard_name, state%pmid, pcols, lchnk) + + case ('state%pmiddry') + call outfld(state_snapshot(i)%standard_name, state%pmiddry, pcols, lchnk) + + case ('state%pdel') + call outfld(state_snapshot(i)%standard_name, state%pdel, pcols, lchnk) + + case ('state%pdeldry') + call outfld(state_snapshot(i)%standard_name, state%pdeldry, pcols, lchnk) + + case ('state%rpdel') + call outfld(state_snapshot(i)%standard_name, state%rpdel, pcols, lchnk) + + case ('state%rpdeldry') + call outfld(state_snapshot(i)%standard_name, state%rpdeldry, pcols, lchnk) + + case ('state%lnpmid') + call outfld(state_snapshot(i)%standard_name, state%lnpmid, pcols, lchnk) + + case ('state%lnpmiddry') + call outfld(state_snapshot(i)%standard_name, state%lnpmiddry, pcols, lchnk) + + case ('state%exner') + call outfld(state_snapshot(i)%standard_name, state%exner, pcols, lchnk) + + case ('state%zm') + call outfld(state_snapshot(i)%standard_name, state%zm, pcols, lchnk) + + case ('state%pint') + call outfld(state_snapshot(i)%standard_name, state%pint, pcols, lchnk) + + case ('state%pintdry') + call outfld(state_snapshot(i)%standard_name, state%pintdry, pcols, lchnk) + + case ('state%lnpint') + call outfld(state_snapshot(i)%standard_name, state%lnpint, pcols, lchnk) + + case ('state%lnpintdry') + call outfld(state_snapshot(i)%standard_name, state%lnpintdry, pcols, lchnk) + + case ('state%zi') + call outfld(state_snapshot(i)%standard_name, state%zi, pcols, lchnk) + + case ('state%te_ini_phys') + call outfld(state_snapshot(i)%standard_name, state%te_ini(:, phys_te_idx), pcols, lchnk) + + case ('state%te_cur_phys') + call outfld(state_snapshot(i)%standard_name, state%te_cur(:, phys_te_idx), pcols, lchnk) + + case ('state%tw_ini') + call outfld(state_snapshot(i)%standard_name, state%tw_ini, pcols, lchnk) + + case ('state%tw_cur') + call outfld(state_snapshot(i)%standard_name, state%tw_cur, pcols, lchnk) + + case ('state%te_ini_dyn') + call outfld(state_snapshot(i)%standard_name, state%te_ini(:, dyn_te_idx), pcols, lchnk) + + case ('state%te_cur_dyn') + call outfld(state_snapshot(i)%standard_name, state%te_cur(:, dyn_te_idx), pcols, lchnk) + + case ('air_composition_cp_or_cv_dycore') + ! this field is not part of physics state (it is in air_composition) + ! but describes the atmospheric thermodynamic state and thus saved within the snapshot + call outfld(state_snapshot(i)%standard_name, cp_or_cv_dycore(:,:,lchnk), pcols, lchnk) + + case default + call endrun('ERROR in state_snapshot_all_outfld: no match found for '//trim(state_snapshot(i)%ddt_string)) + + end select + + call cam_history_snapshot_deactivate(trim(state_snapshot(i)%standard_name)) + + end do + +end subroutine state_snapshot_all_outfld + +subroutine cam_snapshot_ptend_outfld(ptend, lchnk) + + use constituents, only: cnst_name, cnst_longname + !-------------------------------------------------------- + ! This subroutine does the outfld calls for ptend fields. + !-------------------------------------------------------- + + type(physics_ptend), intent(in) :: ptend + integer, intent(in) :: lchnk + + integer :: mcnst + character(len=128) :: fname + + !-------------------------------------------------------- + ! Add the physics_ptend variables to the output + !-------------------------------------------------------- + + if (ptend%ls) then + call outfld('ptend_s', ptend%s, pcols, lchnk) + + call outfld('ptend_hflux_srf', ptend%hflux_srf, pcols, lchnk) + + call outfld('ptend_hflux_top', ptend%hflux_top, pcols, lchnk) + end if + + if (ptend%lu) then + call outfld('ptend_u', ptend%u, pcols, lchnk) + + call outfld('ptend_taux_srf', ptend%taux_srf, pcols, lchnk) + + call outfld('ptend_taux_top', ptend%taux_top, pcols, lchnk) + end if + + if (ptend%lv) then + call outfld('ptend_v', ptend%v, pcols, lchnk) + + call outfld('ptend_tauy_srf', ptend%tauy_srf, pcols, lchnk) + + call outfld('ptend_tauy_top', ptend%tauy_top, pcols, lchnk) + end if + + do mcnst = 1, pcnst + if (ptend%lq(mcnst)) then + fname = 'ptend_'//trim(cnst_name(mcnst)) + call outfld(trim(fname), ptend%q(:,:,mcnst), pcols, lchnk) + + fname = 'ptend_cflx_srf_'//trim(cnst_name(mcnst)) + call outfld(trim(fname), ptend%cflx_srf(:,mcnst), pcols, lchnk) + + fname = 'ptend_cflx_top_'//trim(cnst_name(mcnst)) + call outfld(trim(fname), ptend%cflx_top(:,mcnst), pcols, lchnk) + end if + end do + + +end subroutine cam_snapshot_ptend_outfld + +subroutine cnst_snapshot_all_outfld(lchnk, file_num, cnst) + + integer, intent(in) :: lchnk + integer, intent(in) :: file_num + real(r8), intent(in) :: cnst(:,:,:) + + integer :: i + + do i=1, ncnst_var + + ! Turn on the writing for only the requested tape (file_num) + call cam_history_snapshot_activate(trim(cnst_snapshot(i)%standard_name), file_num) + call outfld(cnst_snapshot(i)%standard_name, cnst(:,:,i), pcols, lchnk) + + ! Now that the field has been written, turn off the writing for field + call cam_history_snapshot_deactivate(trim(cnst_snapshot(i)%standard_name)) + + end do + +end subroutine cnst_snapshot_all_outfld + +subroutine tend_snapshot_all_outfld(lchnk, file_num, tend) + + integer, intent(in) :: lchnk + integer, intent(in) :: file_num + type(physics_tend), intent(in) :: tend + + integer :: i + + do i=1, ntend_var + + ! Turn on the writing for only the requested tape (file_num) + call cam_history_snapshot_activate(trim(tend_snapshot(i)%standard_name), file_num) + + ! Select the tend field which is being written + select case(tend_snapshot(i)%ddt_string) + + case ('tend%dtdt') + call outfld(tend_snapshot(i)%standard_name, tend%dtdt, pcols, lchnk) + + case ('tend%dudt') + call outfld(tend_snapshot(i)%standard_name, tend%dudt, pcols, lchnk) + + case ('tend%dvdt') + call outfld(tend_snapshot(i)%standard_name, tend%dvdt, pcols, lchnk) + + case ('tend%flx_net') + call outfld(tend_snapshot(i)%standard_name, tend%flx_net, pcols, lchnk) + + case ('tend%te_tnd') + call outfld(tend_snapshot(i)%standard_name, tend%te_tnd, pcols, lchnk) + + case ('tend%tw_tnd') + call outfld(tend_snapshot(i)%standard_name, tend%tw_tnd, pcols, lchnk) + + case default + call endrun('ERROR in tend_snapshot_all_outfld: no match found for '//trim(tend_snapshot(i)%ddt_string)) + + end select + + call cam_history_snapshot_deactivate(trim(tend_snapshot(i)%standard_name)) + + end do + +end subroutine tend_snapshot_all_outfld + +subroutine cam_in_snapshot_all_outfld(lchnk, file_num, cam_in) + + integer, intent(in) :: lchnk + integer, intent(in) :: file_num + type(cam_in_t), intent(in) :: cam_in + + integer :: i + + do i=1, ncam_in_var + + ! Turn on the writing for only the requested tape (file_num) + call cam_history_snapshot_activate(trim(cam_in_snapshot(i)%standard_name), file_num) + + ! Select the cam_in field which is being written + select case(cam_in_snapshot(i)%ddt_string) + + case ('cam_in%landfrac') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%landfrac, pcols, lchnk) + case ('cam_in%ocnfrac') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%ocnfrac, pcols, lchnk) + case ('cam_in%snowhland') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%snowhland, pcols, lchnk) + case ('cam_in%ts') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%ts, pcols, lchnk) + case ('cam_in%sst') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%sst, pcols, lchnk) + case ('cam_in%icefrac') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%icefrac, pcols, lchnk) + case ('cam_in%shf') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%shf, pcols, lchnk) + case ('cam_in%cflx') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%cflx, pcols, lchnk) + case ('cam_in%wsx') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%wsx, pcols, lchnk) + case ('cam_in%wsy') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%wsy, pcols, lchnk) + case ('cam_in%asdif') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%asdif, pcols, lchnk) + case ('cam_in%aldif') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%aldif, pcols, lchnk) + case ('cam_in%lwup') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%lwup, pcols, lchnk) + case ('cam_in%asdir') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%asdir, pcols, lchnk) + case ('cam_in%aldir') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%aldir, pcols, lchnk) + case ('cam_in%meganflx') + if (associated (cam_in%meganflx)) & + call outfld(cam_in_snapshot(i)%standard_name, cam_in%meganflx, pcols, lchnk) + case ('cam_in%fireflx') + if (associated (cam_in%fireflx)) & + call outfld(cam_in_snapshot(i)%standard_name, cam_in%fireflx, pcols, lchnk) + case ('cam_in%fireztop') + if (associated (cam_in%fireztop)) & + call outfld(cam_in_snapshot(i)%standard_name, cam_in%fireztop, pcols, lchnk) + case ('cam_in%depvel') + if (associated (cam_in%depvel)) & + call outfld(cam_in_snapshot(i)%standard_name, cam_in%depvel, pcols, lchnk) + case ('cam_in%lhf') + call outfld(cam_in_snapshot(i)%standard_name, cam_in%lhf, pcols, lchnk) + case ('cam_in%fv') + if (associated (cam_in%fv)) & + call outfld(cam_in_snapshot(i)%standard_name, cam_in%fv, pcols, lchnk) + case ('cam_in%ram1') + if (associated (cam_in%ram1)) & + call outfld(cam_in_snapshot(i)%standard_name, cam_in%ram1, pcols, lchnk) + case ('cam_in%dstflx') + if (associated (cam_in%dstflx)) & + call outfld(cam_in_snapshot(i)%standard_name, cam_in%dstflx, pcols, lchnk) + + case default + call endrun('ERROR in cam_in_snapshot_all_outfld: no match found for '//trim(cam_in_snapshot(i)%ddt_string)) + + end select + + call cam_history_snapshot_deactivate(trim(cam_in_snapshot(i)%standard_name)) + + end do + +end subroutine cam_in_snapshot_all_outfld + +subroutine cam_out_snapshot_all_outfld(lchnk, file_num, cam_out) + + integer, intent(in) :: lchnk + integer, intent(in) :: file_num + type(cam_out_t), intent(in) :: cam_out + + integer :: i + + do i=1, ncam_out_var + + ! Turn on the writing for only the requested tape (file_num) + call cam_history_snapshot_activate(trim(cam_out_snapshot(i)%standard_name), file_num) + + ! Select the cam_out field which is being written + select case(cam_out_snapshot(i)%ddt_string) + + case ('cam_out%precc') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%precc, pcols, lchnk) + + case ('cam_out%precl') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%precl, pcols, lchnk) + + case ('cam_out%precsc') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%precsc, pcols, lchnk) + + case ('cam_out%precsl') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%precsl, pcols, lchnk) + + case ('cam_out%nhx_nitrogen_flx') + if (associated(cam_out%nhx_nitrogen_flx)) & + call outfld(cam_out_snapshot(i)%standard_name, cam_out%nhx_nitrogen_flx, pcols, lchnk) + + case ('cam_out%noy_nitrogen_flx') + if (associated(cam_out%noy_nitrogen_flx)) & + call outfld(cam_out_snapshot(i)%standard_name, cam_out%noy_nitrogen_flx, pcols, lchnk) + + case ('cam_out%bcphodry') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%bcphodry, pcols, lchnk) + + case ('cam_out%bcphidry') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%bcphidry, pcols, lchnk) + + case ('cam_out%ocphodry') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%ocphodry, pcols, lchnk) + + case ('cam_out%ocphidry') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%ocphidry, pcols, lchnk) + + case ('cam_out%bcphiwet') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%bcphiwet, pcols, lchnk) + + case ('cam_out%ocphiwet') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%ocphiwet, pcols, lchnk) + + case ('cam_out%dstwet1') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstwet1, pcols, lchnk) + + case ('cam_out%dstwet2') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstwet2, pcols, lchnk) + + case ('cam_out%dstwet3') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstwet3, pcols, lchnk) + + case ('cam_out%dstwet4') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstwet4, pcols, lchnk) + + case ('cam_out%dstdry1') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstdry1, pcols, lchnk) + + case ('cam_out%dstdry2') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstdry2, pcols, lchnk) + + case ('cam_out%dstdry3') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstdry3, pcols, lchnk) + + case ('cam_out%dstdry4') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%dstdry4, pcols, lchnk) + + case ('cam_out%sols') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%sols, pcols, lchnk) + + case ('cam_out%soll') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%soll, pcols, lchnk) + + case ('cam_out%solsd') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%solsd, pcols, lchnk) + + case ('cam_out%solld') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%solld, pcols, lchnk) + + case ('cam_out%flwds') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%flwds, pcols, lchnk) + + case ('cam_out%netsw') + call outfld(cam_out_snapshot(i)%standard_name, cam_out%netsw, pcols, lchnk) + + case default + call endrun('ERROR in cam_out_snapshot_all_outfld: no match found for '//trim(cam_out_snapshot(i)%ddt_string)) + + end select + + call cam_history_snapshot_deactivate(trim(cam_out_snapshot(i)%standard_name)) + + end do + +end subroutine cam_out_snapshot_all_outfld + +subroutine cam_pbuf_snapshot_all_outfld(lchnk, file_num, pbuf) + use physics_buffer, only: pbuf_is_used + + integer, intent(in) :: lchnk + integer, intent(in) :: file_num + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) + + integer :: i, pbuf_idx, ndims + real(r8), pointer, dimension(:,:) :: tmpptr2d + real(r8), pointer, dimension(:,:,:) :: tmpptr3d + real(r8), pointer, dimension(:,:,:,:) :: tmpptr4d + real(r8), pointer, dimension(:,:,:,:,:) :: tmpptr5d + + + do i=1, npbuf_var + + pbuf_idx= pbuf_get_index(pbuf_snapshot(i)%ddt_string) + + if (pbuf_is_used(pbuf(pbuf_idx))) then + ! Turn on the writing for only the requested tape (file_num) + call cam_history_snapshot_activate(trim(pbuf_snapshot(i)%standard_name), file_num) + + ! Retrieve the pbuf data (dependent on the number of dimensions) + ndims = count(pbuf_snapshot(i)%dim_name(:) /= '') + + select case (ndims) ! Note that dimension 5 and 6 do not work with pbuf_get_field, so these are not used here + + case (1) + call pbuf_get_field(pbuf, pbuf_idx, tmpptr2d) + call outfld(pbuf_snapshot(i)%standard_name, tmpptr2d, pcols, lchnk) + + case (2) + call pbuf_get_field(pbuf, pbuf_idx, tmpptr3d) + call outfld(pbuf_snapshot(i)%standard_name, tmpptr3d, pcols, lchnk) + + case (3) + call pbuf_get_field(pbuf, pbuf_idx, tmpptr3d) + call outfld(pbuf_snapshot(i)%standard_name, tmpptr4d, pcols, lchnk) + + case (4) + call pbuf_get_field(pbuf, pbuf_idx, tmpptr5d) + call outfld(pbuf_snapshot(i)%standard_name, tmpptr5d, pcols, lchnk) + + end select + + ! Now that the field has been written, turn off the writing for field + call cam_history_snapshot_deactivate(trim(pbuf_snapshot(i)%standard_name)) + + + end if + + end do + +end subroutine cam_pbuf_snapshot_all_outfld + +subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) + +!--------------------------------------------------- +! This subroutine exists to link the pbuf name with units. It can be expanded to include standard_names +! at a later date if needed. It is a list of all the pbuf fields that are called within CAM with actual +! names. +!--------------------------------------------------- + + type(pbuf_info_type), intent(inout) :: pbuf_info(:) + type(physics_buffer_desc), intent(in) :: pbuf(:) + character(len=*), intent(in) :: const_cname(:) + + logical, dimension(size(pbuf)) :: found + character(len=24), dimension(2,npbuf_all) :: pbuf_all + character(len=24) :: pbuf_name + integer :: i, ipbuf + + found(:) = .false. + + pbuf_all(1:2,1:100) = reshape ( (/ & + 'ACCRE_ENHAN ','unset ',& + 'ACGCME ','unset ',& + 'ACLDY_CEN ','unset ',& + 'ACNUM ','unset ',& + 'ACPRECL ','unset ',& + 'AIST ','unset ',& + 'ALST ','unset ',& + 'am_evp_st ','unset ',& + 'AMIE_efxg ','mW/m2 ',& + 'AMIE_kevg ','keV ',& + 'AST ','1 ',& + 'AurIPRateSum ','unset ',& + 'awk_PBL ','unset ',& + 'bprod ','unset ',& + 'CC_ni ','unset ',& + 'CC_nl ','unset ',& + 'CC_qi ','unset ',& + 'CC_ql ','unset ',& + 'CC_qlst ','unset ',& + 'CC_qv ','unset ',& + 'CC_T ','unset ',& + 'CICEWP ','unset ',& + 'CLDBOT ','1 ',& + 'CLDEMIS ','unset ',& + 'CLDFGRAU ','1 ',& + 'CLDFSNOW ','1 ',& + 'CLD ','unset ',& + 'CLDICEINI ','unset ',& + 'CLDLIQINI ','unset ',& + 'CLDO ','unset ',& + 'CLDTAU ','unset ',& + 'CLDTOP ','1 ',& + 'CLIQWP ','unset ',& + 'CLOUD_FRAC ','unset ',& + 'CLUBB_BUFFER ','unset ',& + 'CMELIQ ','kg/kg/s ',& + 'CMFMC_SH ','unset ',& + 'cmfr_det ','kg/m2/s ',& + 'CONCLD ','fraction ',& + 'CRM_CLD_RAD ','unset ',& + 'CRM_DGNUMWET ','unset ',& + 'CRM_NC ','/kg ',& + 'CRM_NC_RAD ','unset ',& + 'CRM_NG ','/kg ',& + 'CRM_NI ','/kg ',& + 'CRM_NI_RAD ','unset ',& + 'CRM_NR ','/kg ',& + 'CRM_NS ','/kg ',& + 'CRM_NS_RAD ','unset ',& + 'CRM_QAERWAT ','unset ',& + 'CRM_QC ','kg/kg ',& + 'CRM_QC_RAD ','unset ',& + 'CRM_QG ','kg/kg ',& + 'CRM_QI ','kg/kg ',& + 'CRM_QI_RAD ','unset ',& + 'CRM_QN ','unset ',& + 'CRM_QP ','kg/kg ',& + 'CRM_QRAD ','unset ',& + 'CRM_QR ','kg/kg ',& + 'CRM_QS ','kg/kg ',& + 'CRM_QS_RAD ','unset ',& + 'CRM_QT ','unset ',& + 'CRM_QV_RAD ','unset ',& + 'CRM_T ',' K ',& + 'CRM_T_RAD ','unset ',& + 'CRM_U ','m/s ',& + 'CRM_V ','m/s ',& + 'CRM_W ','m/s ',& + 'CT ','unset ',& + 'cu_cmfr ','kg/m2/s ',& + 'cuorg ','unset ',& + 'cu_qir ','kg/kg ',& + 'cu_qlr ','kg/kg ',& + 'cu_qtr ','kg/kg ',& + 'cushavg ','m ',& + 'cush ','m ',& + 'cu_thlr ','K ',& + 'cu_trr ','unset ',& + 'cu_ur ','m/s ',& + 'cu_vr ','m/s ',& + 'CV_REFFICE ','micron ',& + 'CV_REFFLIQ ','micron ',& + 'DEGRAU ','unset ',& + 'DEI ','unset ',& + 'delta_qt_PBL ','unset ',& + 'delta_thl_PBL ','unset ',& + 'delta_tr_PBL ','unset ',& + 'delta_u_PBL ','unset ',& + 'delta_v_PBL ','unset ',& + 'DES ','unset ',& + 'DGNUM ','unset ',& + 'DGNUMWET ','unset ',& + 'DIFZM ','kg/kg/s ',& + 'DLFZM ','kg/kg/s ',& + 'DNIFZM ','1/kg/s ',& + 'DNLFZM ','1/kg/s ',& + 'DP_FLXPRC ','unset ',& + 'DP_FLXSNW ','unset ',& + 'DP_FRAC ','unset ',& + 'dragblj ','1/s ' /), (/2,100/)) + + pbuf_all(1:2,101:200) = reshape ( (/ & + 'DRYMASS ','unset ',& + 'DRYRAD ','unset ',& + 'DRYVOL ','unset ',& + 'DTCORE ','K/s ',& + 'evprain_st ','unset ',& + 'evpsnow_st ','unset ',& + 'FICE ','fraction ',& + 'FLNS ','W/m2 ',& + 'FLNT ','W/m2 ',& + 'FRACIS ','unset ',& + 'FRACSOA ','unset ',& + 'FRACSOG ','unset ',& + 'FRONTGA ','unset ',& + 'FRONTGF ','K^2/M^2/S ',& + 'FRZCNT ','unset ',& + 'FRZDEP ','unset ',& + 'FRZIMM ','unset ',& + 'FSDS ','W/m2 ',& + 'FSNS ','W/m2 ',& + 'FSNT ','W/m2 ',& + 'HallConduct ','unset ',& + 'HYGRO ','unset ',& + 'ICCWAT ','unset ',& + 'ICGRAUWP ','unset ',& + 'ICIWP ','unset ',& + 'ICIWPST ','unset ',& + 'ICLWP ','unset ',& + 'ICLWPST ','unset ',& + 'ICSWP ','unset ',& + 'ICWMRDP ','kg/kg ',& + 'ICWMRSH ','kg/kg ',& + 'IonRates ','unset ',& + 'ipbl ','unset ',& + 'ISS_FRAC ','unset ',& + 'kpblh ','unset ',& + 'ksrftms ','unset ',& + 'kvh ','m2/s ',& + 'kvm ','m2/s ',& + 'kvt ','m2/s ',& + 'LAMBDAC ','unset ',& + 'LANDM ','unset ',& + 'LCWAT ','unset ',& + 'LD ','unset ',& + 'LHFLX ','W/m2 ',& + 'LHFLX_RES ','unset ',& + 'LS_FLXPRC ','kg/m2/s ',& + 'LS_FLXSNW ','kg/m2/s ',& + 'LS_MRPRC ','unset ',& + 'LS_MRSNW ','unset ',& + 'LS_REFFRAIN ','micron ',& + 'LS_REFFSNOW ','micron ',& + 'LU ','unset ',& + 'MAMH2SO4EQ ','unset ',& + 'MU ','Pa/s ',& + 'NAAI_HOM ','unset ',& + 'NAAI ','unset ',& + 'NACON ','unset ',& + 'NAER ','unset ',& + 'NEVAPR_DPCU ','unset ',& + 'NEVAPR ','unset ',& + 'NEVAPR_SHCU ','unset ',& + 'NIWAT ','unset ',& + 'NLWAT ','unset ',& + 'NMXRGN ','unset ',& + 'NPCCN ','unset ',& + 'NRAIN ','m-3 ',& + 'NSNOW ','m-3 ',& + 'O3 ','unset ',& + 'pblh ','m ',& + 'PDF_PARAMS ','unset ',& + 'PDF_PARAMS_ZM ','unset ',& + 'PedConduct ','unset ',& + 'PMXRGN ','unset ',& + 'PRAIN ','unset ',& + 'PREC_DP ','unset ',& + 'PREC_PCW ','m/s ',& + 'PREC_SED ','unset ',& + 'PREC_SH ','unset ',& + 'PREC_SH ','unset ',& + 'PREC_STR ','unset ',& + 'PRER_EVAP ','unset ',& + 'PSL ','Pa ',& + 'QAERWAT ','unset ',& + 'QCWAT ','unset ',& + 'QFLX ','kg/m2/s ',& + 'QFLX_RES ','unset ',& + 'QINI ','unset ',& + 'qir_det ','kg/kg ',& + 'QIST ','unset ',& + 'qlr_det ','kg/kg ',& + 'QLST ','unset ',& + 'QME ','unset ',& + 'qpert ','kg/kg ',& + 'QRAIN ','kg/kg ',& + 'QRL ','K/s ',& + 'qrlin ','unset ',& + 'QRS ','K/s ',& + 'qrsin ','unset ',& + 'QSATFAC ','- ',& + 'QSNOW ','kg/kg ' /), (/2,100/)) + + pbuf_all(1:2,201:300) = reshape ( (/ & + 'QTeAur ','unset ',& + 'qti_flx ','unset ',& + 'qtl_flx ','unset ',& + 'RAD_CLUBB ','unset ',& + 'RATE1_CW2PR_ST ','unset ',& + 'RCM ','unset ',& + 'RE_ICE ','unset ',& + 'REI ','micron ',& + 'RELHUM ','percent ',& + 'REL ','micron ',& + 'RELVAR ','- ',& + 'RNDST ','unset ',& + 'RPRDDP ','unset ',& + 'RPRDSH ','unset ',& + 'RPRDTOT ','unset ',& + 'RTM ','unset ',& + 'rtp2_mc_zt ','unset ',& + 'RTP2_nadv ','unset ',& + 'rtpthlp_mc_zt ','unset ',& + 'RTPTHLP_nadv ','unset ',& + 'RTPTHVP ','unset ',& + 'SADICE ','cm2/cm3 ',& + 'SADSNOW ','cm2/cm3 ',& + 'SADSULF ','unset ',& + 'SD ','unset ',& + 'SGH30 ','unset ',& + 'SGH ','unset ',& + 'SH_CLDICE ','unset ',& + 'SH_CLDLIQ ','unset ',& + 'SH_E_ED_RATIO ','unset ',& + 'SHFLX ','W/m2 ',& + 'SH_FLXPRC ','unset ',& + 'SHFLX_RES ','unset ',& + 'SH_FLXSNW ','unset ',& + 'SH_FRAC ','unset ',& + 'shfrc ','unset ',& + 'SNOW_DP ','unset ',& + 'SNOW_PCW ','unset ',& + 'SNOW_SED ','unset ',& + 'SNOW_SH ','unset ',& + 'SNOW_STR ','unset ',& + 'SO4DRYVOL ','unset ',& + 'SSLTA ','kg/kg ',& + 'SSLTC ','kg/kg ',& + 'SU ','unset ',& + "taubljx ",'N/m2 ',& + "taubljy ",'N/m2 ',& + 'tauresx ','unset ',& + 'tauresy ','unset ',& + "tautmsx ",'N/m2 ',& + "tautmsy ",'N/m2 ',& + 'TAUX ','N/m2 ',& + 'TAUX_RES ','unset ',& + 'TAUY ','N/m2 ',& + 'TAUY_RES ','unset ',& + 'tcorr ','unset ',& + 'TCWAT ','unset ',& + 'TElec ','K ',& + 'TEOUT ','J/m2 ',& + 'THLM ','unset ',& + 'thlp2_mc_zt ','unset ',& + 'THLP2_nadv ','unset ',& + 'THLPTHVP ','unset ',& + 'TIon ','K ',& + 'TK_CRM ','unset ',& + 'tke ','m2/s2 ',& + 'tkes ','m2/s2 ',& + 'TND_NSNOW ','unset ',& + 'TND_QSNOW ','unset ',& + 'tpert ','K ',& + 'TREFMNAV ','K ',& + 'TREFMXAV ','K ',& + 'tropp ','unset ',& + 'TSTCPY_SCOL ','unset ',& + 'TTEND_DP ','unset ',& + 'TTEND_SH ','unset ',& + 'T_TTEND ','unset ',& + "UI ",'m/s ',& + 'UM ','unset ',& + 'UP2_nadv ','unset ',& + 'UPWP ','m^2/s^2 ',& + 'UZM ','M/S ',& + 'VI ','m/s ',& + 'VM ','m/s ',& + 'VOLC_MMR ','unset ',& + 'VOLC_RAD_GEOM ','unset ',& + 'VP2_nadv ','unset ',& + 'VPWP ','m^2/s^2 ',& + 'went ','m/s ',& + 'WETDENS_AP ','unset ',& + "WI ",'m/s ',& + 'WP3_nadv ','unset ',& + 'wprtp_mc_zt ','unset ',& + 'WPRTP_nadv ','unset ',& + 'wpthlp_mc_zt ','unset ',& + 'WPTHLP_nadv ','unset ',& + 'WPTHVP ','unset ',& + 'WSEDL ','unset ',& + 'wstarPBL ','unset ',& + 'ZM_DP ','unset ' /), (/2,100/)) + + pbuf_all(1:2,301:npbuf_all) = reshape ( (/ & + 'ZM_DSUBCLD ','unset ',& + 'ZM_DU ','unset ',& + 'ZM_ED ','unset ',& + 'ZM_EU ','unset ',& + 'ZM_IDEEP ','unset ',& + 'ZM_JT ','unset ',& + 'ZM_MAXG ','unset ',& + 'ZM_MD ','unset ',& + 'ZM_MU ','unset ',& + 'ZTODT ','unset ' /), (/2,10/)) + +! Fields which are added with pbuf_add_field calls, but are data driven. These are not +! included in the above list. This means that these fields will not have proper units +! set for them +! 'CG' // shortname, 'unset', & +! 'CI' // shortname, 'unset', & +! 'CL' // shortname, 'unset', & +! ghg_names(i), 'unset', & +! mmr_name1, 'unset', & +! mmr_name2, 'unset', & +! mmr_name3, 'unset', & +! mmr_name, 'unset', & +! ozone_name, 'unset', & +! pbufname, 'unset', & +! pbufname, 'unset', & +! pbuf_names(i), 'unset', & +! rad_name1, 'unset', & +! rad_name2, 'unset', & +! rad_name3, 'unset', & +! rad_name, 'unset', & +! sad_name, 'cm2/cm3', & +! volcaero_name, 'kg/kg', & +! volcrad_name, 'm', & +! xname_massptrcw(l, 'unset', & +! xname_numptrcw, 'unset', & +! aero_names(mm) +! cnst_names(iconst) + + do ipbuf = 1, size(pbuf) + pbuf_name = pbuf_get_field_name(ipbuf) + i = 1 + do while ((i <= npbuf_all) .and. .not. found(ipbuf)) + if (trim(pbuf_all(1,i)) == trim(pbuf_name)) then + pbuf_info(ipbuf)%name = trim(pbuf_all(1,i)) + pbuf_info(ipbuf)%standard_name = 'pbuf_'//trim(pbuf_all(1,i)) + pbuf_info(ipbuf)%units = trim(pbuf_all(2,i)) + pbuf_info(ipbuf)%dim_string(:) = ' ' + found(ipbuf) = .true. + end if + i = i+1 + end do + if (.not. found(ipbuf)) then + + i = 1 + ! Check if variable is a variation of constituent - then use the same units + do while ((i <= ncnst_var) .and. .not. found(ipbuf)) + if (trim(const_cname(i)) == trim(pbuf_name)) then + pbuf_info(ipbuf) = pbuf_info_type(trim(const_cname(i)),trim('pbuf_'//const_cname(i)),& + trim(cnst_snapshot(i)%units), ' ') + found(ipbuf) = .true. + end if + i = i+1 + end do + end if + + ! Found a pbuf that has not been added to this routine + if (.not. found(ipbuf)) then + write(iulog,*) 'WARNING - no units information for: '//trim(pbuf_name) + + pbuf_info(ipbuf)%name = trim(pbuf_name) + pbuf_info(ipbuf)%standard_name = 'pbuf_'//trim(pbuf_name) + pbuf_info(ipbuf)%units = 'unset' + pbuf_info(ipbuf)%dim_string(:) = ' ' + found(ipbuf) = .true. + end if + + end do + +end subroutine fill_pbuf_info + +end module cam_snapshot_common diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index c92f602a0f..1470c46198 100644 --- a/src/control/camsrfexch.F90 +++ b/src/control/camsrfexch.F90 @@ -13,10 +13,8 @@ module camsrfexch use cam_abortutils, only: endrun use cam_logfile, only: iulog use srf_field_check, only: active_Sl_ram1, active_Sl_fv, active_Sl_soilw, & - active_Fall_flxdst1, active_Fall_flxvoc, active_Fall_flxfire, & - active_Faxa_nhx, active_Faxa_noy - - + active_Fall_flxdst1, active_Fall_flxvoc, active_Fall_flxfire + use cam_control_mod, only: aqua_planet, simple_phys implicit none private @@ -36,7 +34,7 @@ module camsrfexch ! This is the data that is sent from the atmosphere to the surface models !--------------------------------------------------------------------------- - type cam_out_t + type cam_out_t integer :: lchnk ! chunk index integer :: ncol ! number of columns in chunk real(r8) :: tbot(pcols) ! bot level temperature @@ -46,20 +44,22 @@ module camsrfexch real(r8) :: vbot(pcols) ! bot level v wind real(r8) :: qbot(pcols,pcnst) ! bot level specific humidity real(r8) :: pbot(pcols) ! bot level pressure - real(r8) :: rho(pcols) ! bot level density - real(r8) :: netsw(pcols) ! - real(r8) :: flwds(pcols) ! + real(r8) :: rho(pcols) ! bot level density + real(r8) :: netsw(pcols) ! + real(r8) :: flwds(pcols) ! real(r8) :: precsc(pcols) ! real(r8) :: precsl(pcols) ! - real(r8) :: precc(pcols) ! - real(r8) :: precl(pcols) ! - real(r8) :: soll(pcols) ! - real(r8) :: sols(pcols) ! + real(r8) :: precc(pcols) ! + real(r8) :: precl(pcols) ! + real(r8) :: soll(pcols) ! + real(r8) :: sols(pcols) ! real(r8) :: solld(pcols) ! real(r8) :: solsd(pcols) ! - real(r8) :: thbot(pcols) ! + real(r8) :: thbot(pcols) ! real(r8) :: co2prog(pcols) ! prognostic co2 real(r8) :: co2diag(pcols) ! diagnostic co2 + real(r8) :: ozone(pcols) ! surface ozone concentration (mole/mole) + real(r8) :: lightning_flash_freq(pcols) ! cloud-to-ground lightning flash frequency (/min) real(r8) :: psl(pcols) real(r8) :: bcphiwet(pcols) ! wet deposition of hydrophilic black carbon real(r8) :: bcphidry(pcols) ! dry deposition of hydrophilic black carbon @@ -77,13 +77,13 @@ module camsrfexch real(r8) :: dstdry4(pcols) ! dry deposition of dust (bin4) real(r8), pointer, dimension(:) :: nhx_nitrogen_flx ! nitrogen deposition fluxes (kgN/m2/s) real(r8), pointer, dimension(:) :: noy_nitrogen_flx ! nitrogen deposition fluxes (kgN/m2/s) - end type cam_out_t + end type cam_out_t !--------------------------------------------------------------------------- ! This is the merged state of sea-ice, land and ocean surface parameterizations !--------------------------------------------------------------------------- - type cam_in_t + type cam_in_t integer :: lchnk ! chunk index integer :: ncol ! number of active columns real(r8) :: asdir(pcols) ! albedo: shortwave, direct @@ -96,11 +96,13 @@ module camsrfexch real(r8) :: wsx(pcols) ! surface u-stress (N) real(r8) :: wsy(pcols) ! surface v-stress (N) real(r8) :: tref(pcols) ! ref height surface air temp - real(r8) :: qref(pcols) ! ref height specific humidity + real(r8) :: qref(pcols) ! ref height specific humidity real(r8) :: u10(pcols) ! 10m wind speed - real(r8) :: ts(pcols) ! merged surface temp + real(r8) :: ugustOut(pcols) ! gustiness added + real(r8) :: u10withGusts(pcols) ! 10m wind speed with gusts added + real(r8) :: ts(pcols) ! merged surface temp real(r8) :: sst(pcols) ! sea surface temp - real(r8) :: snowhland(pcols) ! snow depth (liquid water equivalent) over land + real(r8) :: snowhland(pcols) ! snow depth (liquid water equivalent) over land real(r8) :: snowhice(pcols) ! snow depth over ice real(r8) :: fco2_lnd(pcols) ! co2 flux from lnd real(r8) :: fco2_ocn(pcols) ! co2 flux from ocn @@ -120,7 +122,7 @@ module camsrfexch real(r8), pointer, dimension(:,:) :: meganflx ! MEGAN fluxes real(r8), pointer, dimension(:,:) :: fireflx ! wild fire emissions real(r8), pointer, dimension(:) :: fireztop ! wild fire emissions vert distribution top - end type cam_in_t + end type cam_in_t !=============================================================================== CONTAINS @@ -131,7 +133,7 @@ subroutine hub2atm_alloc( cam_in ) ! Allocate space for the surface to atmosphere data type. And initialize ! the values. - use seq_drydep_mod, only: lnd_drydep, n_drydep + use shr_drydep_mod, only: n_drydep use shr_megan_mod, only: shr_megan_mechcomps_n use shr_fire_emis_mod,only: shr_fire_emis_mechcomps_n @@ -142,7 +144,7 @@ subroutine hub2atm_alloc( cam_in ) integer :: c ! chunk index integer :: ierror ! Error code character(len=*), parameter :: sub = 'hub2atm_alloc' - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- if ( .not. phys_grid_initialized() ) call endrun(sub//": phys_grid not called yet") allocate (cam_in(begchunk:endchunk), stat=ierror) @@ -160,8 +162,8 @@ subroutine hub2atm_alloc( cam_in ) nullify(cam_in(c)%meganflx) nullify(cam_in(c)%fireflx) nullify(cam_in(c)%fireztop) - enddo - do c = begchunk,endchunk + enddo + do c = begchunk,endchunk if (active_Sl_ram1) then allocate (cam_in(c)%ram1(pcols), stat=ierror) if ( ierror /= 0 ) call endrun(sub//': allocation error ram1') @@ -185,15 +187,15 @@ subroutine hub2atm_alloc( cam_in ) endif end do - if (lnd_drydep .and. n_drydep>0) then - do c = begchunk,endchunk + if (n_drydep>0) then + do c = begchunk,endchunk allocate (cam_in(c)%depvel(pcols,n_drydep), stat=ierror) if ( ierror /= 0 ) call endrun(sub//': allocation error depvel') end do endif if (active_Fall_flxfire .and. shr_fire_emis_mechcomps_n>0) then - do c = begchunk,endchunk + do c = begchunk,endchunk allocate(cam_in(c)%fireflx(pcols,shr_fire_emis_mechcomps_n), stat=ierror) if ( ierror /= 0 ) call endrun(sub//': allocation error fireflx') allocate(cam_in(c)%fireztop(pcols), stat=ierror) @@ -216,6 +218,8 @@ subroutine hub2atm_alloc( cam_in ) cam_in(c)%tref (:) = 0._r8 cam_in(c)%qref (:) = 0._r8 cam_in(c)%u10 (:) = 0._r8 + cam_in(c)%ugustOut (:) = 0._r8 + cam_in(c)%u10withGusts (:) = 0._r8 cam_in(c)%ts (:) = 0._r8 cam_in(c)%sst (:) = 0._r8 cam_in(c)%snowhland(:) = 0._r8 @@ -242,7 +246,7 @@ subroutine hub2atm_alloc( cam_in ) cam_in(c)%ustar (:) = 0._r8 cam_in(c)%re (:) = 0._r8 cam_in(c)%ssq (:) = 0._r8 - if (lnd_drydep .and. n_drydep>0) then + if (n_drydep>0) then cam_in(c)%depvel (:,:) = 0._r8 endif if (active_Fall_flxfire .and. shr_fire_emis_mechcomps_n>0) then @@ -267,7 +271,7 @@ subroutine atm2hub_alloc( cam_out ) integer :: c ! chunk index integer :: ierror ! Error code character(len=*), parameter :: sub = 'atm2hub_alloc' - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- if (.not. phys_grid_initialized()) call endrun(sub//": phys_grid not called yet") allocate (cam_out(begchunk:endchunk), stat=ierror) @@ -300,6 +304,8 @@ subroutine atm2hub_alloc( cam_out ) cam_out(c)%thbot(:) = 0._r8 cam_out(c)%co2prog(:) = 0._r8 cam_out(c)%co2diag(:) = 0._r8 + cam_out(c)%ozone(:) = 0._r8 + cam_out(c)%lightning_flash_freq(:) = 0._r8 cam_out(c)%psl(:) = 0._r8 cam_out(c)%bcphidry(:) = 0._r8 cam_out(c)%bcphodry(:) = 0._r8 @@ -319,16 +325,18 @@ subroutine atm2hub_alloc( cam_out ) nullify(cam_out(c)%nhx_nitrogen_flx) nullify(cam_out(c)%noy_nitrogen_flx) - if (active_Faxa_nhx) then + if (.not.(simple_phys .or. aqua_planet)) then + allocate (cam_out(c)%nhx_nitrogen_flx(pcols), stat=ierror) if ( ierror /= 0 ) call endrun(sub//': allocation error nhx_nitrogen_flx') cam_out(c)%nhx_nitrogen_flx(:) = 0._r8 - endif - if (active_Faxa_noy) then + allocate (cam_out(c)%noy_nitrogen_flx(pcols), stat=ierror) if ( ierror /= 0 ) call endrun(sub//': allocation error noy_nitrogen_flx') cam_out(c)%noy_nitrogen_flx(:) = 0._r8 + endif + end do end subroutine atm2hub_alloc @@ -338,7 +346,7 @@ end subroutine atm2hub_alloc subroutine atm2hub_deallocate(cam_out) type(cam_out_t), pointer :: cam_out(:) ! Atmosphere to surface input - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- if(associated(cam_out)) then deallocate(cam_out) @@ -354,7 +362,7 @@ subroutine hub2atm_deallocate(cam_in) type(cam_in_t), pointer :: cam_in(:) ! Atmosphere to surface input integer :: c - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- if(associated(cam_in)) then do c=begchunk,endchunk @@ -382,7 +390,7 @@ subroutine hub2atm_deallocate(cam_in) deallocate(cam_in(c)%depvel) nullify(cam_in(c)%depvel) end if - + enddo deallocate(cam_in) @@ -403,14 +411,16 @@ subroutine cam_export(state,cam_out,pbuf) use cam_history, only: outfld use chem_surfvals, only: chem_surfvals_get use co2_cycle, only: co2_transport, c_i - use physconst, only: rair, mwdry, mwco2, gravit + use physconst, only: rair, mwdry, mwco2, gravit, mwo3 use constituents, only: pcnst use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc + use rad_constituents, only: rad_cnst_get_gas + use cam_control_mod, only: simple_phys implicit none ! Input arguments - type(physics_state), intent(in) :: state + type(physics_state), intent(in) :: state type (cam_out_t), intent(inout) :: cam_out type(physics_buffer_desc), pointer :: pbuf(:) @@ -423,6 +433,7 @@ subroutine cam_export(state,cam_out,pbuf) integer :: psl_idx integer :: prec_dp_idx, snow_dp_idx, prec_sh_idx, snow_sh_idx integer :: prec_sed_idx,snow_sed_idx,prec_pcw_idx,snow_pcw_idx + integer :: srf_ozone_idx, lightning_idx real(r8), pointer :: psl(:) @@ -434,6 +445,8 @@ subroutine cam_export(state,cam_out,pbuf) real(r8), pointer :: snow_sed(:) ! snow from ZM convection real(r8), pointer :: prec_pcw(:) ! total precipitation from Hack convection real(r8), pointer :: snow_pcw(:) ! snow from Hack convection + real(r8), pointer :: o3_ptr(:,:), srf_o3_ptr(:) + real(r8), pointer :: lightning_ptr(:) !----------------------------------------------------------------------- lchnk = state%lchnk @@ -450,6 +463,8 @@ subroutine cam_export(state,cam_out,pbuf) snow_sed_idx = pbuf_get_index('SNOW_SED', errcode=i) prec_pcw_idx = pbuf_get_index('PREC_PCW', errcode=i) snow_pcw_idx = pbuf_get_index('SNOW_PCW', errcode=i) + srf_ozone_idx = pbuf_get_index('SRFOZONE', errcode=i) + lightning_idx = pbuf_get_index('LGHT_FLASH_FREQ', errcode=i) if (prec_dp_idx > 0) then call pbuf_get_field(pbuf, prec_dp_idx, prec_dp) @@ -489,16 +504,32 @@ subroutine cam_export(state,cam_out,pbuf) end do do m = 1, pcnst do i = 1, ncol - cam_out%qbot(i,m) = state%q(i,pver,m) + cam_out%qbot(i,m) = state%q(i,pver,m) end do end do - cam_out%co2diag(:ncol) = chem_surfvals_get('CO2VMR') * 1.0e+6_r8 + cam_out%co2diag(:ncol) = chem_surfvals_get('CO2VMR') * 1.0e+6_r8 if (co2_transport()) then do i=1,ncol cam_out%co2prog(i) = state%q(i,pver,c_i(4)) * 1.0e+6_r8 *mwdry/mwco2 end do end if + + ! get bottom layer ozone concentrations to export to surface models + if (srf_ozone_idx > 0) then + call pbuf_get_field(pbuf, srf_ozone_idx, srf_o3_ptr) + cam_out%ozone(:ncol) = srf_o3_ptr(:ncol) + else if (.not.simple_phys) then + call rad_cnst_get_gas(0, 'O3', state, pbuf, o3_ptr) + cam_out%ozone(:ncol) = o3_ptr(:ncol,pver) * mwdry/mwo3 ! mole/mole + endif + + ! get cloud to ground lightning flash freq (/min) to export to surface models + if (lightning_idx>0) then + call pbuf_get_field(pbuf, lightning_idx, lightning_ptr) + cam_out%lightning_flash_freq(:ncol) = lightning_ptr(:ncol) + end if + ! ! Precipation and snow rates from shallow convection, deep convection and stratiform processes. ! Compute total convective and stratiform precipitation and snow rates diff --git a/src/control/filenames.F90 b/src/control/filenames.F90 index 71166c4b07..2640ab6d20 100644 --- a/src/control/filenames.F90 +++ b/src/control/filenames.F90 @@ -48,7 +48,7 @@ end function get_dir !=============================================================================== character(len=cl) function interpret_filename_spec( filename_spec, number, prev, case, & - yr_spec, mon_spec, day_spec, sec_spec ) + yr_spec, mon_spec, day_spec, sec_spec, flag_spec ) ! Create a filename from a filename specifier. The ! filename specifyer includes codes for setting things such as the @@ -77,12 +77,14 @@ end function get_dir integer , intent(in), optional :: mon_spec ! Simulation month integer , intent(in), optional :: day_spec ! Simulation day integer , intent(in), optional :: sec_spec ! Seconds into current simulation day + character(len=*), intent(in), optional :: flag_spec ! flag for accumulated or instantaneous ! Local variables integer :: year ! Simulation year integer :: month ! Simulation month integer :: day ! Simulation day integer :: ncsec ! Seconds into current simulation day + character(len=1) :: flag character(len=cl) :: string ! Temporary character string character(len=cl) :: format ! Format character string integer :: i, n ! Loop variables @@ -116,6 +118,11 @@ end function get_dir call get_curr_date(year, month, day, ncsec) end if end if + if (present(flag_spec)) then + flag = flag_spec + else + flag = '' + end if ! ! Go through each character in the filename specifyer and interpret if special string ! @@ -170,6 +177,8 @@ end function get_dir write(string,'(i2.2)') day case( 's' ) ! second write(string,'(i5.5)') ncsec + case( 'f' ) ! flag + write(string,'(a)') flag case( '%' ) ! percent character string = "%" case default 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..a961fc502e 100644 --- a/src/control/history_scam.F90 +++ b/src/control/history_scam.F90 @@ -1,106 +1,215 @@ 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 + 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 + 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 a01305c5cd..f25039d97c 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 @@ -56,7 +56,8 @@ module ncdio_atm ! ! !INTERFACE: subroutine infld_real_1d_2d(varname, ncid, dimname1, & - dim1b, dim1e, dim2b, dim2e, field, readvar, gridname, timelevel) + dim1b, dim1e, dim2b, dim2e, field, readvar, gridname, timelevel, & + fillvalue) ! ! !DESCRIPTION: ! Netcdf I/O of initial real field from netCDF file @@ -65,11 +66,9 @@ 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 cam_pio_utils, only: cam_pio_check_var + 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 ! ! !ARGUMENTS: @@ -85,16 +84,17 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, & logical, intent(out) :: readvar ! true => variable is on initial dataset character(len=*), optional, intent(in) :: gridname ! Name of variable's grid integer, optional, intent(in) :: timelevel + real(r8), optional, intent(out) :: fillvalue ! !EOP ! ! !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 integer :: arraydimsize(2) ! field dimension lengths integer :: ndims ! number of dimensions @@ -102,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 ! @@ -188,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 @@ -211,15 +204,13 @@ 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) + ! 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) @@ -239,7 +230,8 @@ 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: ! Netcdf I/O of initial real field from netCDF file @@ -249,9 +241,9 @@ 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 cam_pio_utils, only: cam_permute_array, calc_permutation, cam_pio_check_var + 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 ! ! !ARGUMENTS: @@ -268,6 +260,7 @@ subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & logical, intent(out) :: readvar ! true => variable is on initial dataset character(len=*), optional, intent(in) :: gridname ! Name of variable's grid integer, optional, intent(in) :: timelevel + real(r8), optional, intent(out) :: fillvalue ! !EOP ! @@ -298,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 @@ -320,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 ! @@ -405,9 +396,9 @@ subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & strt(1) = dim1b strt(2) = dim2b cnt = arraydimsize - call shr_scam_getCloseLatLon(ncid%fh,scmlat,scmlon,closelat,closelon,latidx,lonidx) + call shr_scam_getCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx) if (trim(field_dnames(1)) == 'lon') then - strt(1) = lonidx ! First dim always lon for Eulerian dycore + strt(1) = lonidx else call endrun(trim(subname)//': lon should be first dimension for '//trim(varname)) end if @@ -442,6 +433,9 @@ subroutine infld_real_2d_2d(varname, ncid, dimname1, dimname2, & call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:2), & pio_double, iodesc, field_dnames=field_dnames) 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 if (masterproc) write(iulog,*) subname//': read field '//trim(varname) @@ -463,7 +457,7 @@ end subroutine infld_real_2d_2d ! !INTERFACE: subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & dim1b, dim1e, dim2b, dim2e, dim3b, dim3e, & - field, readvar, gridname, timelevel) + field, readvar, gridname, timelevel, fillvalue) ! ! !DESCRIPTION: ! Netcdf I/O of initial real field from netCDF file @@ -473,10 +467,8 @@ 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, cam_pio_check_var + use pio, only: PIO_MAX_NAME, pio_inq_dimname + use cam_pio_utils, only: cam_pio_check_var, cam_pio_inq_var_fill ! ! !ARGUMENTS: @@ -495,20 +487,18 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, & logical, intent(out) :: readvar ! true => variable is on initial dataset character(len=*), optional, intent(in) :: gridname ! Name of variable's grid integer, optional, intent(in) :: timelevel + real(r8), optional, intent(out) :: fillvalue ! !EOP ! ! !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 @@ -520,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 ! @@ -609,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 @@ -635,16 +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) + ! 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) @@ -665,7 +645,7 @@ end subroutine infld_real_2d_3d ! !INTERFACE: subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & dim1b, dim1e, dim2b, dim2e, dim3b, dim3e, & - field, readvar, gridname, timelevel) + field, readvar, gridname, timelevel, fillvalue) ! ! !DESCRIPTION: ! Netcdf I/O of initial real field from netCDF file @@ -675,9 +655,9 @@ 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 cam_pio_utils, only: cam_permute_array, calc_permutation, cam_pio_check_var + 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 ! ! !ARGUMENTS: @@ -697,6 +677,7 @@ subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & logical, intent(out) :: readvar ! true => variable is on initial dataset character(len=*), optional, intent(in) :: gridname ! Name of variable's grid integer, optional, intent(in) :: timelevel + real(r8), optional, intent(out) :: fillvalue ! !EOP ! @@ -729,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 @@ -751,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 ! @@ -850,9 +829,9 @@ subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & strt(2) = dim2b strt(3) = dim3b cnt = arraydimsize - call shr_scam_getCloseLatLon(ncid%fh,scmlat,scmlon,closelat,closelon,latidx,lonidx) + call shr_scam_getCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx) if (trim(field_dnames(1)) == 'lon') then - strt(1) = lonidx ! First dim always lon for Eulerian dycore + strt(1) = lonidx else call endrun(trim(subname)//': lon should be first dimension for '//trim(varname)) end if @@ -889,9 +868,13 @@ subroutine infld_real_3d_3d(varname, ncid, dimname1, dimname2, dimname3, & end if else ! All distributed array processing - call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:pdims), & - pio_double, iodesc, field_dnames=field_dnames, file_dnames=file_dnames(1:3)) + call cam_grid_get_decomp(grid_id, arraydimsize, dimlens(1:pdims), & + pio_double, iodesc, field_dnames=field_dnames, & + file_dnames=file_dnames(1:3)) 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 ! end of single column if (masterproc) write(iulog,*) subname//': read field '//trim(varname) diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index 35b2c82fd9..f7bc2a40ff 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -36,12 +36,11 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use spmd_utils, only: spmd_utils_readnl use cam_history, only: history_readnl use physconst, only: physconst_readnl + use air_composition, only: air_composition_readnl use physics_buffer, only: pbuf_readnl use phys_control, only: phys_ctl_readnl use wv_saturation, only: wv_sat_readnl use ref_pres, only: ref_pres_readnl - use cam3_aero_data, only: cam3_aero_data_readnl - use cam3_ozone_data, only: cam3_ozone_data_readnl use dadadj_cam, only: dadadj_readnl use macrop_driver, only: macrop_driver_readnl use microp_driver, only: microp_driver_readnl @@ -63,7 +62,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use conv_water, only: conv_water_readnl use rad_constituents, only: rad_cnst_readnl use radiation_data, only: rad_data_readnl - use modal_aer_opt, only: modal_aer_opt_readnl + use aerosol_optics_cam, only: aerosol_optics_cam_readnl use clubb_intr, only: clubb_readnl use chemistry, only: chem_readnl use prescribed_volcaero, only: prescribed_volcaero_readnl @@ -90,11 +89,20 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use rate_diags, only: rate_diags_readnl use tracers, only: tracers_readnl use nudging, only: nudging_readnl +#if ( defined SIMPLE ) + use frierson_cam, only: frierson_readnl +#endif use dyn_comp, only: dyn_readnl use ionosphere_interface,only: ionosphere_readnl use qneg_module, only: qneg_readnl use lunar_tides, only: lunar_tides_readnl + use hemco_interface, only: hemco_readnl + use upper_bc, only: ubc_readnl + use cam_budget, only: cam_budget_readnl + use phys_grid_ctem, only: phys_grid_ctem_readnl + use mo_lightning, only: lightning_readnl + use atm_stream_ndep, only: stream_ndep_readnl !---------------------------Arguments----------------------------------- @@ -121,6 +129,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call spmd_utils_readnl(nlfilename) call phys_grid_readnl(nlfilename) + call air_composition_readnl(nlfilename) call physconst_readnl(nlfilename) !++bee 13 Oct 2015, need to fix the pbuf_global_allocate functionality, then ! can uncomment the pbuf_readnl line @@ -129,11 +138,10 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call cnst_readnl(nlfilename) call history_readnl(nlfilename) call chem_surfvals_readnl(nlfilename) + call ubc_readnl(nlfilename) call phys_ctl_readnl(nlfilename) call wv_sat_readnl(nlfilename) call ref_pres_readnl(nlfilename) - call cam3_aero_data_readnl(nlfilename) - call cam3_ozone_data_readnl(nlfilename) call dadadj_readnl(nlfilename) call macrop_driver_readnl(nlfilename) call microp_driver_readnl(nlfilename) @@ -158,8 +166,9 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call radiation_readnl(nlfilename) call rad_cnst_readnl(nlfilename) call rad_data_readnl(nlfilename) - call modal_aer_opt_readnl(nlfilename) + call aerosol_optics_cam_readnl(nlfilename) call chem_readnl(nlfilename) + call lightning_readnl(nlfilename) call prescribed_volcaero_readnl(nlfilename) call prescribed_strataero_readnl(nlfilename) call solar_data_readnl(nlfilename) @@ -187,10 +196,17 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call rate_diags_readnl(nlfilename) call scam_readnl(nlfilename, single_column, scmlat, scmlon) call nudging_readnl(nlfilename) +#if ( defined SIMPLE ) + call frierson_readnl(nlfilename) +#endif call dyn_readnl(nlfilename) call ionosphere_readnl(nlfilename) call qneg_readnl(nlfilename) + call hemco_readnl(nlfilename) + call cam_budget_readnl(nlfilename) + call phys_grid_ctem_readnl(nlfilename) + call stream_ndep_readnl(nlfilename) end subroutine read_namelist diff --git a/src/control/sat_hist.F90 b/src/control/sat_hist.F90 index e59b8935db..35879cff90 100644 --- a/src/control/sat_hist.F90 +++ b/src/control/sat_hist.F90 @@ -5,6 +5,7 @@ module sat_hist use perf_mod, only: t_startf, t_stopf + use shr_kind_mod, only: r4 => shr_kind_r8 use shr_kind_mod, only: r8 => shr_kind_r8, cl=>shr_kind_cl use cam_logfile, only: iulog use ppgrid, only: pcols, pver, pverp, begchunk, endchunk @@ -22,8 +23,8 @@ module sat_hist #ifdef SPMD use mpishorthand, only: mpichar, mpiint #endif - use physconst, only: pi - + use physconst, only: pi + implicit none private @@ -56,7 +57,7 @@ module sat_hist integer, allocatable :: date_buffer(:), time_buffer(:) integer :: sat_tape_num=ptapes-1 - + ! input file integer :: n_profiles integer :: time_vid, date_vid, lat_vid, lon_vid, instr_vid, orbit_vid, prof_vid, zenith_vid @@ -91,7 +92,7 @@ module sat_hist logical :: has_dyn_ilev_flds = .false. contains - + !------------------------------------------------------------------------------- logical function is_satfile (file_index) @@ -101,7 +102,7 @@ end function is_satfile !------------------------------------------------------------------------------- subroutine sat_hist_readnl(nlfile, hfilename_spec, mfilt, fincl, nhtfrq, avgflag_pertape) - + use namelist_utils, only: find_group_name use units, only: getunit, freeunit use cam_history_support, only: pflds @@ -114,7 +115,7 @@ subroutine sat_hist_readnl(nlfile, hfilename_spec, mfilt, fincl, nhtfrq, avgflag character(len=*), intent(inout) :: fincl(:,:) character(len=1), intent(inout) :: avgflag_pertape(:) integer, intent(inout) :: mfilt(:), nhtfrq(:) - + ! Local variables integer :: unitn, ierr character(len=*), parameter :: subname = 'sat_hist_readnl' @@ -176,7 +177,7 @@ subroutine sat_hist_readnl(nlfile, hfilename_spec, mfilt, fincl, nhtfrq, avgflag fcnt=fcnt+1 end if enddo - + nhtfrq(sat_tape_num) = 1 avgflag_pertape(sat_tape_num) = 'I' @@ -191,7 +192,7 @@ subroutine sat_hist_readnl(nlfile, hfilename_spec, mfilt, fincl, nhtfrq, avgflag end subroutine sat_hist_readnl - + !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- subroutine sat_hist_init @@ -291,7 +292,7 @@ subroutine read_datetime( datetime, index ) ierr = pio_get_var( infile, time_vid, start, cnt, time ) ierr = pio_get_var( infile, date_vid, start, cnt, date ) - + datetime = convert_date_time( date(1),time(1) ) end subroutine read_datetime @@ -309,14 +310,14 @@ subroutine read_buffered_datetime( datetime, index ) integer :: cnt integer :: start integer :: date, time - + ! If the request is outside of the buffer then reload the buffer. if ((last_start_index == -1) .or. (index < last_start_index) & .or. (index >= (last_start_index + t_buffer_size))) then start = (index - 1) / t_buffer_size * t_buffer_size + 1 if ( start+t_buffer_size-1 <= n_profiles ) then - cnt = t_buffer_size + cnt = t_buffer_size else cnt = n_profiles-start+1 endif @@ -348,7 +349,7 @@ function convert_date_time( date,time ) yr = date/1000 doy = date - yr*1000 call set_time_float_from_date( datetime, yr, 1, doy, time ) - else + else yr = date/10000 mon = (date - yr*10000)/100 dom = date - yr*10000 - mon*100 @@ -364,7 +365,7 @@ subroutine sat_hist_define(outfile) integer :: coldim integer :: ierr - + ierr = pio_inquire(outfile, unlimitedDimId=coldim) call pio_seterrorhandling(outfile, PIO_BCAST_ERROR) @@ -415,13 +416,13 @@ subroutine sat_hist_write( tape , nflds, nfils) use phys_grid, only: phys_decomp use dyn_grid, only: dyn_decomp use cam_history_support, only : active_entry - use pio, only : pio_file_is_open - implicit none + use pio, only : pio_file_is_open, pio_syncfile + type(active_entry) :: tape integer, intent(in) :: nflds integer, intent(inout) :: nfils - integer :: ncols, nocols + integer :: ncols, nocols integer :: ierr integer, allocatable :: col_ndxs(:) @@ -465,52 +466,53 @@ subroutine sat_hist_write( tape , nflds, nfils) call get_indices( obs_lats, obs_lons, ncols, nocols, has_dyn_flds, col_ndxs, chk_ndxs, & fdyn_ndxs, ldyn_ndxs, phs_owners, dyn_owners, mlats, mlons, phs_dists ) - if ( .not. pio_file_is_open(tape%File) ) then + if ( .not. pio_file_is_open(tape%Files(1)) ) then call endrun('sat file not open') endif - ierr = pio_inq_dimid(tape%File,'ncol',coldim ) - - ierr = pio_inq_varid(tape%File, 'lat', out_latid ) - ierr = pio_inq_varid(tape%File, 'lon', out_lonid ) - ierr = pio_inq_varid(tape%File, 'distance', out_dstid ) + ierr = pio_inq_dimid(tape%Files(1),'ncol',coldim ) + + ierr = pio_inq_varid(tape%Files(1), 'lat', out_latid ) + ierr = pio_inq_varid(tape%Files(1), 'lon', out_lonid ) + ierr = pio_inq_varid(tape%Files(1), 'distance', out_dstid ) call write_record_coord( tape, mlats(:), mlons(:), phs_dists(:), ncols, nfils ) ! dump columns of 2D fields if (has_phys_srf_flds) then - call dump_columns( tape%File, tape%hlist, nflds, nocols, 1, nfils, & + call dump_columns( tape%Files(1), tape%hlist, nflds, nocols, 1, nfils, & col_ndxs, chk_ndxs, phs_owners, phys_decomp ) endif if (has_dyn_srf_flds) then - call dump_columns( tape%File, tape%hlist, nflds, nocols, 1, nfils, & + call dump_columns( tape%Files(1), tape%hlist, nflds, nocols, 1, nfils, & fdyn_ndxs, ldyn_ndxs, dyn_owners, dyn_decomp ) endif ! dump columns of 3D fields defined on mid pres levels if (has_phys_lev_flds) then - call dump_columns( tape%File, tape%hlist, nflds, nocols, pver, nfils, & + call dump_columns( tape%Files(1), tape%hlist, nflds, nocols, pver, nfils, & col_ndxs, chk_ndxs, phs_owners, phys_decomp ) endif if (has_dyn_lev_flds) then - call dump_columns( tape%File, tape%hlist, nflds, nocols, pver, nfils, & + call dump_columns( tape%Files(1), tape%hlist, nflds, nocols, pver, nfils, & fdyn_ndxs, ldyn_ndxs, dyn_owners, dyn_decomp ) endif ! dump columns of 3D fields defined on interface pres levels if (has_phys_ilev_flds) then - call dump_columns( tape%File, tape%hlist, nflds, nocols, pverp, nfils, & + call dump_columns( tape%Files(1), tape%hlist, nflds, nocols, pverp, nfils, & col_ndxs, chk_ndxs, phs_owners, phys_decomp ) endif if (has_dyn_ilev_flds) then - call dump_columns( tape%File, tape%hlist, nflds, nocols, pverp, nfils, & + call dump_columns( tape%Files(1), tape%hlist, nflds, nocols, pverp, nfils, & fdyn_ndxs, ldyn_ndxs, dyn_owners, dyn_decomp ) endif deallocate( col_ndxs, chk_ndxs, fdyn_ndxs, ldyn_ndxs, phs_owners, dyn_owners ) deallocate( mlons, mlats, phs_dists ) deallocate( obs_lons, obs_lats ) + call pio_syncfile(tape%Files(1)) nfils = nfils + nocols @@ -522,6 +524,7 @@ end subroutine sat_hist_write subroutine dump_columns( File, hitems, nflds, ncols, nlevs, nfils, fdims, ldims, owners, decomp ) use cam_history_support, only: field_info, hentry, fillvalue use pio, only: pio_setframe, pio_offset_kind + use spmd_utils, only: mpi_real4, mpi_real8, mpicom, mpi_sum type(File_desc_t),intent(inout) :: File type(hentry), intent(in), target :: hitems(:) @@ -537,137 +540,58 @@ subroutine dump_columns( File, hitems, nflds, ncols, nlevs, nfils, fdims, ldims, type(field_info), pointer :: field type(var_desc_t) :: vardesc - type(iosystem_desc_t), pointer :: sat_iosystem integer :: ierr - type(io_desc_t), pointer :: iodesc - real(r8), allocatable :: buf(:) + real(r8) :: sbuf1d(ncols),rbuf1d(ncols) + real(r4) :: buf1d(ncols) + real(r8) :: sbuf2d(nlevs,ncols), rbuf2d(nlevs,ncols) + real(r4) :: buf2d(nlevs,ncols) integer :: i,k,f, cnt call t_startf ('sat_hist::dump_columns') - sat_iosystem => File%iosystem - - cnt = 0 - - do i = 1,ncols - do k = 1,nlevs - if ( iam == owners(i) ) then - cnt = cnt+1 - endif - enddo - enddo - allocate( buf(cnt) ) - - iodesc => create_iodesc( File, ncols, nlevs, owners ) - do f = 1,nflds field => hitems(f)%field if (field%numlev==nlevs .and. field%decomp_type==decomp) then vardesc = hitems(f)%varid(1) - cnt = 0 - buf = fillvalue - do i = 1,ncols - do k = 1,nlevs + if (nlevs==1) then + sbuf1d = 0.0_r8 + rbuf1d = 0.0_r8 + do i=1,ncols if ( iam == owners(i) ) then - cnt = cnt+1 - buf(cnt) = hitems(f)%hbuf( fdims(i), k, ldims(i) ) + sbuf1d(i) = hitems(f)%hbuf( fdims(i), 1, ldims(i) ) endif enddo - enddo + call mpi_allreduce(sbuf1d,rbuf1d,ncols,mpi_real8, mpi_sum, mpicom, ierr) + buf1d(:) = real(rbuf1d(:),r4) + ierr = pio_put_var(File, vardesc, (/nfils/),(/ncols/), buf1d(:)) + else + sbuf2d = 0.0_r8 + rbuf2d = 0.0_r8 + do i=1,ncols + if ( iam == owners(i) ) then + do k = 1,nlevs + sbuf2d(k,i) = hitems(f)%hbuf( fdims(i), k, ldims(i) ) + enddo + endif + enddo + call mpi_allreduce(sbuf2d,rbuf2d,ncols*nlevs,mpi_real8, mpi_sum, mpicom, ierr) + buf2d(:,:) = real(rbuf2d(:,:),r4) + ierr = pio_put_var(File, vardesc, (/1,nfils/),(/nlevs,ncols/), buf2d(:,:)) + endif - call pio_setframe(File, vardesc, int(nfils,kind=pio_offset_kind)) ! sets varsesc -- correct offset - call pio_write_darray(File, vardesc, iodesc, buf, ierr, fillval=fillvalue) endif enddo - call destroy_iodesc( File, iodesc ) - - deallocate( buf ) - call t_stopf ('sat_hist::dump_columns') end subroutine dump_columns !------------------------------------------------------------------------------- -! creates an iodesc object -!------------------------------------------------------------------------------- - function create_iodesc( File, ncols, nlevs, owners ) result(iodesc) - use pio, only: pio_initdecomp, PIO_REARR_SUBSET - - ! args - type(File_desc_t),intent(inout) :: File - integer, intent(in) :: ncols - integer, intent(in) :: nlevs - integer, intent(in) :: owners(:) - - ! returned pointer - type(io_desc_t), pointer :: iodesc - - ! local vars - integer :: i,k, cnt - integer, allocatable :: dof(:) - integer, allocatable :: dimlens(:) - integer :: ndims - - if (nlevs >1) then - ndims = 2 - else - ndims = 1 - endif - allocate (dimlens(ndims)) - dimlens(:) = ncols - if (nlevs >1) then - dimlens(1) = nlevs - endif - - cnt = 0 - - do i = 1,ncols - do k = 1,nlevs - if ( iam == owners(i) ) then - cnt = cnt+1 - endif - enddo - enddo - allocate(dof(cnt)) - dof = 0 - cnt = 0 - do i = 1,ncols - do k = 1,nlevs - if ( iam == owners(i) ) then - cnt = cnt+1 - dof(cnt) = k + (i-1)*nlevs - endif - enddo - enddo - - allocate(iodesc) - call pio_initdecomp(File%iosystem, pio_double, dimlens, dof, iodesc, rearr=PIO_REARR_SUBSET ) - - deallocate( dof ) - deallocate( dimlens ) - - end function create_iodesc - -!------------------------------------------------------------------------------- -! cleans up iodesc obj -!------------------------------------------------------------------------------- - subroutine destroy_iodesc( File, iodesc ) - use pio, only: pio_freedecomp - - type(File_desc_t),intent(inout) :: File - type(io_desc_t), pointer :: iodesc - - call pio_freedecomp(File, iodesc) - deallocate(iodesc) - end subroutine destroy_iodesc - -!------------------------------------------------------------------------------- -! scan the fields for possible different decompositions +! scan the fields for possible different decompositions !------------------------------------------------------------------------------- subroutine scan_flds( tape, nflds ) use cam_history_support, only : active_entry @@ -727,13 +651,13 @@ subroutine scan_flds( tape, nflds ) flds_scanned = .true. end subroutine scan_flds - + !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- subroutine read_next_position( ncols ) use time_manager, only: get_curr_date use time_manager, only: set_time_float_from_date - + implicit none integer, intent(out) :: ncols @@ -798,7 +722,7 @@ subroutine read_next_position( ncols ) call t_stopf ('sat_hist::read_next_position') end subroutine read_next_position - + !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- subroutine write_record_coord( tape, mod_lats, mod_lons, mod_dists, ncols, nfils ) @@ -837,65 +761,65 @@ subroutine write_record_coord( tape, mod_lats, mod_lons, mod_dists, ncols, nfils allocate( itmp(ncols * sathist_nclosest) ) allocate( rtmp(ncols * sathist_nclosest) ) - + itmp(:) = ncdate - ierr = pio_put_var(tape%File, tape%dateid,(/nfils/), (/ncols * sathist_nclosest/),itmp) + ierr = pio_put_var(tape%Files(1), tape%dateid,(/nfils/), (/ncols * sathist_nclosest/),itmp) itmp(:) = ncsec - ierr = pio_put_var(tape%File, tape%datesecid,(/nfils/),(/ncols * sathist_nclosest/),itmp) + ierr = pio_put_var(tape%Files(1), tape%datesecid,(/nfils/),(/ncols * sathist_nclosest/),itmp) rtmp(:) = time - ierr = pio_put_var(tape%File, tape%timeid, (/nfils/),(/ncols * sathist_nclosest/),rtmp) - + ierr = pio_put_var(tape%Files(1), tape%timeid, (/nfils/),(/ncols * sathist_nclosest/),rtmp) + deallocate(itmp) deallocate(rtmp) ! output model column coordinates - ierr = pio_put_var(tape%File, out_latid, (/nfils/),(/ncols * sathist_nclosest/), mod_lats) - ierr = pio_put_var(tape%File, out_lonid, (/nfils/),(/ncols * sathist_nclosest/), mod_lons) - ierr = pio_put_var(tape%File, out_dstid, (/nfils/),(/ncols * sathist_nclosest/), mod_dists / 1000._r8) - + ierr = pio_put_var(tape%Files(1), out_latid, (/nfils/),(/ncols * sathist_nclosest/), mod_lats) + ierr = pio_put_var(tape%Files(1), out_lonid, (/nfils/),(/ncols * sathist_nclosest/), mod_lons) + ierr = pio_put_var(tape%Files(1), out_dstid, (/nfils/),(/ncols * sathist_nclosest/), mod_dists / 1000._r8) + ! output instrument location allocate( out_lats(ncols * sathist_nclosest) ) allocate( out_lons(ncols * sathist_nclosest) ) - + do i = 1, ncols out_lats(((i-1)*sathist_nclosest)+1 : (i*sathist_nclosest)) = obs_lats(i) out_lons(((i-1)*sathist_nclosest)+1 : (i*sathist_nclosest)) = obs_lons(i) enddo - ierr = pio_put_var(tape%File, out_instr_lat_vid, (/nfils/),(/ncols * sathist_nclosest/), out_lats) - ierr = pio_put_var(tape%File, out_instr_lon_vid, (/nfils/),(/ncols * sathist_nclosest/), out_lons) + ierr = pio_put_var(tape%Files(1), out_instr_lat_vid, (/nfils/),(/ncols * sathist_nclosest/), out_lats) + ierr = pio_put_var(tape%Files(1), out_instr_lon_vid, (/nfils/),(/ncols * sathist_nclosest/), out_lons) deallocate(out_lats) deallocate(out_lons) - - - ierr = copy_data( infile, date_vid, tape%File, out_obs_date_vid, in_start_col, nfils, ncols ) - ierr = copy_data( infile, time_vid, tape%File, out_obs_time_vid, in_start_col, nfils, ncols ) - + + + ierr = copy_data( infile, date_vid, tape%Files(1), out_obs_date_vid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, time_vid, tape%Files(1), out_obs_time_vid, in_start_col, nfils, ncols ) + ! output observation identifiers if (instr_vid>0) then - ierr = copy_data( infile, instr_vid, tape%File, out_instrid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, instr_vid, tape%Files(1), out_instrid, in_start_col, nfils, ncols ) endif if (orbit_vid>0) then - ierr = copy_data( infile, orbit_vid, tape%File, out_orbid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, orbit_vid, tape%Files(1), out_orbid, in_start_col, nfils, ncols ) endif if (prof_vid>0) then - ierr = copy_data( infile, prof_vid, tape%File, out_profid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, prof_vid, tape%Files(1), out_profid, in_start_col, nfils, ncols ) endif if (zenith_vid>0) then - ierr = copy_data( infile, zenith_vid, tape%File, out_zenithid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, zenith_vid, tape%Files(1), out_zenithid, in_start_col, nfils, ncols ) endif if (in_julian_vid>0) then - ierr = copy_data( infile, in_julian_vid, tape%File, out_julian_vid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, in_julian_vid, tape%Files(1), out_julian_vid, in_start_col, nfils, ncols ) endif if (in_occ_type_vid>0) then - ierr = copy_data( infile, in_occ_type_vid, tape%File, out_occ_type_vid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, in_occ_type_vid, tape%Files(1), out_occ_type_vid, in_start_col, nfils, ncols ) endif if (in_localtime_vid>0) then - ierr = copy_data( infile, in_localtime_vid, tape%File, out_localtime_vid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, in_localtime_vid, tape%Files(1), out_localtime_vid, in_start_col, nfils, ncols ) endif if (in_doy_vid>0) then - ierr = copy_data( infile, in_doy_vid, tape%File, out_doy_vid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, in_doy_vid, tape%Files(1), out_doy_vid, in_start_col, nfils, ncols ) endif call t_stopf ('sat_hist::write_record_coord') @@ -926,7 +850,7 @@ subroutine get_indices( lats, lons, ncols, nocols, has_dyn_flds, col_ndxs, chk_n integer :: i, j, ndx real(r8) :: lat, lon - + integer, allocatable :: ichks(:),icols(:),idyn1s(:),idyn2s(:), iphs_owners(:), idyn_owners(:) real(r8), allocatable :: rlats(:), rlons(:), plats(:), plons(:), iphs_dists(:) @@ -967,7 +891,7 @@ subroutine get_indices( lats, lons, ncols, nocols, has_dyn_flds, col_ndxs, chk_n write(iulog,*) 'sat_hist::get_indices lon = ',lon call endrun('sat_hist::get_indices : lon must be between 0 and 360 degrees (0<=lon<360)') endif - + call find_cols( lat, lon, sathist_nclosest, iphs_owners, ichks, icols, & gcols, iphs_dists, plats, plons ) @@ -976,7 +900,7 @@ subroutine get_indices( lats, lons, ncols, nocols, has_dyn_flds, col_ndxs, chk_n endif do j = 1, sathist_nclosest - + if (debug .and. iam==iphs_owners(j) ) then if ( abs(plats(j)-rlats(j))>1.e-3_r8 ) then write(*,'(a,3f20.12)') ' lat, plat, rlat = ', lat, plats(j), rlats(j) @@ -989,9 +913,9 @@ subroutine get_indices( lats, lons, ncols, nocols, has_dyn_flds, col_ndxs, chk_n call endrun('sat_hist::get_indices: dyn lon is different than phys lon ') endif endif - + ndx = ndx+1 - + chk_ndxs(ndx) = ichks(j) col_ndxs(ndx) = icols(j) fdyn_ndxs(ndx) = idyn1s(j) @@ -1060,11 +984,11 @@ integer function copy_data( infile, in_vid, outfile, out_id, instart, outstart, res = pio_get_var( infile, in_vid, (/instart/), (/ncols/), data ) allocate( outdata(ncols * sathist_nclosest) ) - + do i = 1, ncols outdata(((i-1)*sathist_nclosest)+1 : (i*sathist_nclosest)) = data(i) enddo - + res = pio_put_var( outfile, out_id, (/outstart/), (/ncols * sathist_nclosest/), outdata ) deallocate(outdata) @@ -1085,7 +1009,7 @@ integer function copy_att( infile, in_vid, att_name, outfile, out_id ) result(re type(var_desc_t), intent(in) :: out_id character(len=1024) :: att - + res = pio_get_att( infile, in_vid, trim(att_name), att ) if (res==PIO_NOERR) then @@ -1094,7 +1018,7 @@ integer function copy_att( infile, in_vid, att_name, outfile, out_id ) result(re end function copy_att - + !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- subroutine find_cols(lat, lon, nclosest, owner, lcid, icol, gcol, distmin, mlats, mlons) @@ -1107,7 +1031,7 @@ subroutine find_cols(lat, lon, nclosest, owner, lcid, icol, gcol, distmin, mlats integer, intent(out) :: owner(nclosest) ! rank of chunk owner integer, intent(out) :: lcid(nclosest) ! local chunk index integer, intent(out) :: icol(nclosest) ! column index within the chunk - integer, intent(out) :: gcol(nclosest) ! global column index + integer, intent(out) :: gcol(nclosest) ! global column index real(r8),intent(out) :: distmin(nclosest) ! the distance (m) of the closest column(s) real(r8),intent(out) :: mlats(nclosest) ! the latitude of the closest column(s) real(r8),intent(out) :: mlons(nclosest) ! the longitude of the closest column(s) @@ -1134,7 +1058,7 @@ subroutine find_cols(lat, lon, nclosest, owner, lcid, icol, gcol, distmin, mlats latr = lat/rad2deg ! to radians lonr = lon/rad2deg ! to radians - + my_owner(:) = -999 my_lcid(:) = -999 my_icol(:) = -999 @@ -1150,7 +1074,7 @@ subroutine find_cols(lat, lon, nclosest, owner, lcid, icol, gcol, distmin, mlats col_loop: do i = 1,ncols ! Use the Spherical Law of Cosines to find the great-circle distance. - dist = acos(sin(latr) * sin(rlats(i)) + cos(latr) * cos(rlats(i)) * cos(rlons(i) - lonr)) * rearth + dist = acos(sin(latr) * sin(rlats(i)) + cos(latr) * cos(rlats(i)) * cos(rlons(i) - lonr)) * rearth closest_loop: do j = nclosest, 1, -1 if (dist < my_distmin(j)) then @@ -1173,7 +1097,7 @@ subroutine find_cols(lat, lon, nclosest, owner, lcid, icol, gcol, distmin, mlats my_mlats(j) = rlats(i) * rad2deg my_mlons(j) = rlons(i) * rad2deg else - exit + exit end if enddo closest_loop diff --git a/src/control/scamMod.F90 b/src/control/scamMod.F90 index b18169b340..65cc4e8e80 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('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/mct/atm_comp_mct.F90 b/src/cpl/mct/atm_comp_mct.F90 index 17643d07f0..2f7a1083b2 100644 --- a/src/cpl/mct/atm_comp_mct.F90 +++ b/src/cpl/mct/atm_comp_mct.F90 @@ -2,13 +2,13 @@ module atm_comp_mct use pio , only: file_desc_t, io_desc_t, var_desc_t, pio_double, pio_def_dim, & pio_put_att, pio_enddef, pio_initdecomp, pio_read_darray, pio_freedecomp, & - pio_closefile, pio_write_darray, pio_def_var, pio_inq_varid, & + pio_write_darray, pio_def_var, pio_inq_varid, & pio_noerr, pio_bcast_error, pio_internal_error, pio_seterrorhandling use mct_mod use seq_cdata_mod use esmf - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix, num_inst_atm + use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix use shr_flds_mod , only: shr_flds_dom_coord, shr_flds_dom_other use seq_flds_mod , only: seq_flds_x2a_fields, seq_flds_a2x_fields use seq_infodata_mod @@ -28,16 +28,16 @@ module atm_comp_mct use cam_cpl_indices use atm_import_export use cam_comp, only: cam_init, cam_run1, cam_run2, cam_run3, cam_run4, cam_final - use cam_instance , only: cam_instance_init, inst_suffix, inst_index + use cam_instance , only: cam_instance_init use cam_control_mod , only: cam_ctrl_set_orbit - use radiation , only: radiation_nextsw_cday - use phys_grid , only: get_ncols_p, ngcols, get_gcol_p, get_rlat_all_p, & - get_rlon_all_p, get_area_all_p + use phys_grid , only: pgcols => num_global_phys_cols + use phys_grid , only: get_ncols_p, get_gcol_p, get_area_all_p + use phys_grid , only: get_rlat_all_p, get_rlon_all_p + use phys_grid , only: get_grid_dims use ppgrid , only: pcols, begchunk, endchunk - use dyn_grid , only: get_horiz_grid_dim_d use camsrfexch , only: cam_out_t, cam_in_t + use radiation , only: nextsw_cday use cam_initfiles , only: cam_initfiles_get_caseid, cam_initfiles_get_restdir - use cam_abortutils , only: endrun use filenames , only: interpret_filename_spec use spmd_utils , only: spmdinit, masterproc, iam use time_manager , only: get_curr_calday, advance_timestep, get_curr_date, get_nstep, & @@ -81,9 +81,9 @@ module atm_comp_mct logical :: dart_mode = .false. -!================================================================================ +!============================================================================== CONTAINS -!================================================================================ +!============================================================================== subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) @@ -124,12 +124,8 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) logical :: perpetual_run ! If in perpetual mode or not integer :: perpetual_ymd ! Perpetual date (YYYYMMDD) - real(r8) :: nextsw_cday ! calendar of next atm shortwave integer :: stepno ! time step integer :: dtime ! time step increment (sec) - integer :: atm_cpl_dt ! driver atm coupling time step - integer :: nstep ! CAM nstep - real(r8) :: caldayp1 ! CAM calendar day for for next cam time step integer :: start_ymd ! Start date (YYYYMMDD) integer :: start_tod ! Start time of day (sec) integer :: curr_ymd ! Start date (YYYYMMDD) @@ -281,6 +277,7 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) curr_tod=curr_tod, & cam_out=cam_out, & cam_in=cam_in) + ! ! Initialize MCT gsMap, domain and attribute vectors (and dof) ! @@ -309,7 +306,7 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) ! Set flag to specify that an extra albedo calculation is to be done (i.e. specify active) ! call seq_infodata_PutData(infodata, atm_prognostic=.true.) - call get_horiz_grid_dim_d(hdim1_d, hdim2_d) + call get_grid_dims(hdim1_d, hdim2_d) call seq_infodata_PutData(infodata, atm_nx=hdim1_d, atm_ny=hdim2_d) ! Set flag to indicate that CAM will provide carbon and dust deposition fluxes. @@ -322,7 +319,6 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) ! This will only be used on the first timestep of an initial run ! if (initial_run) then - nextsw_cday = get_curr_calday() call seq_infodata_PutData( infodata, nextsw_cday=nextsw_cday ) end if @@ -359,20 +355,7 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) call cam_run1 ( cam_in, cam_out ) end if - ! Compute time of next radiation computation, like in run method for exact restart - - call seq_timemgr_EClockGetData(Eclock,dtime=atm_cpl_dt) - dtime = get_step_size() - nstep = get_nstep() - if (nstep < 1 .or. dtime < atm_cpl_dt) then - nextsw_cday = radiation_nextsw_cday() - else if (dtime == atm_cpl_dt) then - caldayp1 = get_curr_calday(offset=int(dtime)) - nextsw_cday = radiation_nextsw_cday() - if (caldayp1 /= nextsw_cday) nextsw_cday = -1._r8 - else - call shr_sys_abort('dtime must be less than or equal to atm_cpl_dt') - end if + ! Compute time of next radiation computation call seq_infodata_PutData( infodata, nextsw_cday=nextsw_cday ) ! End redirection of share output to cam log @@ -418,7 +401,6 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) logical :: dosend ! true => send data back to driver integer :: dtime ! time step increment (sec) - integer :: atm_cpl_dt ! driver atm coupling time step integer :: ymd_sync ! Sync date (YYYYMMDD) integer :: yr_sync ! Sync current year integer :: mon_sync ! Sync current month @@ -430,8 +412,6 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) integer :: day ! CAM current day integer :: tod ! CAM current time of day (sec) - real(r8):: caldayp1 ! CAM calendar day for for next cam time step - real(r8):: nextsw_cday ! calendar of next atm shortwave logical :: rstwr ! .true. ==> write restart file before returning logical :: nlend ! Flag signaling last time-step logical :: rstwr_sync ! .true. ==> write restart file before returning @@ -529,21 +509,8 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) end do - ! Get time of next radiation calculation - albedos will need to be + ! Pass time of next radiation calculation - albedos will need to be ! calculated by each surface model at this time - - call seq_timemgr_EClockGetData(Eclock,dtime=atm_cpl_dt) - dtime = get_step_size() - if (dtime < atm_cpl_dt) then - nextsw_cday = radiation_nextsw_cday() - else if (dtime == atm_cpl_dt) then - caldayp1 = get_curr_calday(offset=int(dtime)) - nextsw_cday = radiation_nextsw_cday() - if (caldayp1 /= nextsw_cday) nextsw_cday = -1._r8 - else - call shr_sys_abort('dtime must be less than or equal to atm_cpl_dt') - end if - call seq_infodata_PutData( infodata, nextsw_cday=nextsw_cday ) ! Write merged surface data restart file if appropriate @@ -611,7 +578,6 @@ subroutine atm_SetgsMap_mct( mpicom_atm, ATMID, GSMap_atm ) ! integer, allocatable :: gindex(:) integer :: i, n, c, ncols, sizebuf, nlcols - integer :: ier ! error status !------------------------------------------------------------------- ! Build the atmosphere grid numbering for MCT @@ -640,7 +606,7 @@ subroutine atm_SetgsMap_mct( mpicom_atm, ATMID, GSMap_atm ) end do nlcols = get_nlcols_p() - call mct_gsMap_init( gsMap_atm, gindex, mpicom_atm, ATMID, nlcols, ngcols) + call mct_gsMap_init( gsMap_atm, gindex, mpicom_atm, ATMID, nlcols, pgcols) deallocate(gindex) @@ -794,7 +760,7 @@ subroutine atm_read_srfrest_mct( EClock, x2a_a, a2x_a) call getfil(pname_srf_cam, fname_srf_cam) call cam_pio_openfile(File, fname_srf_cam, 0) - call pio_initdecomp(pio_subsystem, pio_double, (/ngcols/), dof, iodesc) + call pio_initdecomp(pio_subsystem, pio_double, (/pgcols/), dof, iodesc) allocate(tmp(size(dof))) nf_x2a = mct_aVect_nRattr(x2a_a) @@ -869,12 +835,12 @@ subroutine atm_write_srfrest_mct( x2a_a, a2x_a, & yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) call cam_pio_createfile(File, fname_srf_cam, 0) - call pio_initdecomp(pio_subsystem, pio_double, (/ngcols/), dof, iodesc) + call pio_initdecomp(pio_subsystem, pio_double, (/pgcols/), dof, iodesc) nf_x2a = mct_aVect_nRattr(x2a_a) allocate(varid_x2a(nf_x2a)) - rcode = pio_def_dim(File,'x2a_nx',ngcols,dimid(1)) + rcode = pio_def_dim(File,'x2a_nx',pgcols,dimid(1)) do k = 1,nf_x2a call mct_aVect_getRList(mstring,k,x2a_a) itemc = mct_string_toChar(mstring) @@ -886,7 +852,7 @@ subroutine atm_write_srfrest_mct( x2a_a, a2x_a, & nf_a2x = mct_aVect_nRattr(a2x_a) allocate(varid_a2x(nf_a2x)) - rcode = pio_def_dim(File,'a2x_nx',ngcols,dimid(1)) + rcode = pio_def_dim(File,'a2x_nx',pgcols,dimid(1)) do k = 1,nf_a2x call mct_aVect_getRList(mstring,k,a2x_a) itemc = mct_string_toChar(mstring) diff --git a/src/cpl/mct/atm_import_export.F90 b/src/cpl/mct/atm_import_export.F90 index 31222c982d..b4d8a686c4 100644 --- a/src/cpl/mct/atm_import_export.F90 +++ b/src/cpl/mct/atm_import_export.F90 @@ -21,7 +21,7 @@ subroutine atm_import( x2a, cam_in, restart_init ) use ppgrid , only: begchunk, endchunk use shr_const_mod , only: shr_const_stebol use shr_sys_mod , only: shr_sys_abort - use seq_drydep_mod , only: n_drydep + use shr_drydep_mod , only: n_drydep use shr_fire_emis_mod , only: shr_fire_emis_mechcomps_n use co2_cycle , only: c_i, co2_readFlux_ocn, co2_readFlux_fuel use co2_cycle , only: co2_transport, co2_time_interp_ocn, co2_time_interp_fuel diff --git a/src/cpl/mct/cam_cpl_indices.F90 b/src/cpl/mct/cam_cpl_indices.F90 index af44fb7e67..f5fe1ef26c 100644 --- a/src/cpl/mct/cam_cpl_indices.F90 +++ b/src/cpl/mct/cam_cpl_indices.F90 @@ -1,8 +1,8 @@ module cam_cpl_indices - + use seq_flds_mod use mct_mod - use seq_drydep_mod, only: drydep_fields_token, lnd_drydep + use shr_drydep_mod, only: drydep_fields_token, n_drydep use shr_megan_mod, only: shr_megan_fields_token, shr_megan_mechcomps_n use shr_fire_emis_mod, only: shr_fire_emis_fields_token, shr_fire_emis_ztop_token, & shr_fire_emis_mechcomps_n @@ -56,41 +56,41 @@ module cam_cpl_indices integer :: index_a2x_Faxa_nhx ! flux: Nitrogen deposition integer :: index_a2x_Faxa_noy ! flux: Nitrogen deposition - integer :: index_x2a_Sx_t ! surface temperature - integer :: index_x2a_So_t ! sea surface temperature - integer :: index_x2a_Sf_lfrac ! surface land fraction - integer :: index_x2a_Sf_ifrac ! surface ice fraction - integer :: index_x2a_Sf_ofrac ! surface ocn fraction - integer :: index_x2a_Sx_tref ! 2m reference temperature - integer :: index_x2a_Sx_qref ! 2m reference specific humidity - integer :: index_x2a_Sx_avsdr ! albedo, visible, direct - integer :: index_x2a_Sx_anidr ! albedo, near-ir, direct - integer :: index_x2a_Sx_avsdf ! albedo, visible, diffuse - integer :: index_x2a_Sx_anidf ! albedo, near-ir, diffuse + integer :: index_x2a_Sx_t ! surface temperature + integer :: index_x2a_So_t ! sea surface temperature + integer :: index_x2a_Sf_lfrac ! surface land fraction + integer :: index_x2a_Sf_ifrac ! surface ice fraction + integer :: index_x2a_Sf_ofrac ! surface ocn fraction + integer :: index_x2a_Sx_tref ! 2m reference temperature + integer :: index_x2a_Sx_qref ! 2m reference specific humidity + integer :: index_x2a_Sx_avsdr ! albedo, visible, direct + integer :: index_x2a_Sx_anidr ! albedo, near-ir, direct + integer :: index_x2a_Sx_avsdf ! albedo, visible, diffuse + integer :: index_x2a_Sx_anidf ! albedo, near-ir, diffuse integer :: index_x2a_Sl_snowh ! surface snow depth over land integer :: index_x2a_Si_snowh ! surface snow depth over ice integer :: index_x2a_Sl_fv ! friction velocity integer :: index_x2a_Sl_ram1 ! aerodynamical resistance integer :: index_x2a_Sl_soilw ! volumetric soil water - integer :: index_x2a_Faxx_taux ! wind stress, zonal - integer :: index_x2a_Faxx_tauy ! wind stress, meridional - integer :: index_x2a_Faxx_lat ! latent heat flux - integer :: index_x2a_Faxx_sen ! sensible heat flux - integer :: index_x2a_Faxx_lwup ! upward longwave heat flux - integer :: index_x2a_Faxx_evap ! evaporation water flux - integer :: index_x2a_Fall_flxdst1 ! dust flux size bin 1 - integer :: index_x2a_Fall_flxdst2 ! dust flux size bin 2 - integer :: index_x2a_Fall_flxdst3 ! dust flux size bin 3 + integer :: index_x2a_Faxx_taux ! wind stress, zonal + integer :: index_x2a_Faxx_tauy ! wind stress, meridional + integer :: index_x2a_Faxx_lat ! latent heat flux + integer :: index_x2a_Faxx_sen ! sensible heat flux + integer :: index_x2a_Faxx_lwup ! upward longwave heat flux + integer :: index_x2a_Faxx_evap ! evaporation water flux + integer :: index_x2a_Fall_flxdst1 ! dust flux size bin 1 + integer :: index_x2a_Fall_flxdst2 ! dust flux size bin 2 + integer :: index_x2a_Fall_flxdst3 ! dust flux size bin 3 integer :: index_x2a_Fall_flxdst4 ! dust flux size bin 4 - integer :: index_x2a_Fall_flxvoc ! MEGAN emissions fluxes - integer :: index_x2a_Fall_flxfire ! Fire emissions fluxes - integer :: index_x2a_Sl_ztopfire ! Fire emissions fluxes top of vert distribution - integer :: index_x2a_Fall_fco2_lnd ! co2 flux from land - integer :: index_x2a_Faoo_fco2_ocn ! co2 flux from ocean + integer :: index_x2a_Fall_flxvoc ! MEGAN emissions fluxes + integer :: index_x2a_Fall_flxfire ! Fire emissions fluxes + integer :: index_x2a_Sl_ztopfire ! Fire emissions fluxes top of vert distribution + integer :: index_x2a_Fall_fco2_lnd ! co2 flux from land + integer :: index_x2a_Faoo_fco2_ocn ! co2 flux from ocean integer :: index_x2a_Faoo_fdms_ocn ! dms flux from ocean integer :: index_x2a_So_ustar ! surface friction velocity in ocean - integer :: index_x2a_So_re ! square of atm/ocn exch. coeff - integer :: index_x2a_So_ssq ! surface saturation specific humidity in ocean + integer :: index_x2a_So_re ! square of atm/ocn exch. coeff + integer :: index_x2a_So_ssq ! surface saturation specific humidity in ocean integer :: index_x2a_Sl_ddvel ! dry deposition velocities from land integer :: index_x2a_Sx_u10 ! 10m wind @@ -116,11 +116,11 @@ subroutine cam_cpl_indices_set( ) index_x2a_So_t = mct_avect_indexra(x2a,'So_t') index_x2a_Sl_snowh = mct_avect_indexra(x2a,'Sl_snowh') index_x2a_Si_snowh = mct_avect_indexra(x2a,'Si_snowh') - + index_x2a_Sl_fv = mct_avect_indexra(x2a,'Sl_fv') index_x2a_Sl_ram1 = mct_avect_indexra(x2a,'Sl_ram1') index_x2a_Sl_soilw = mct_avect_indexra(x2a,'Sl_soilw',perrWith='quiet') - + index_x2a_Sx_tref = mct_avect_indexra(x2a,'Sx_tref') index_x2a_Sx_qref = mct_avect_indexra(x2a,'Sx_qref') @@ -162,7 +162,7 @@ subroutine cam_cpl_indices_set( ) index_x2a_Sl_ztopfire = 0 endif - if ( lnd_drydep )then + if ( n_drydep>0 )then index_x2a_Sl_ddvel = mct_avect_indexra(x2a, trim(drydep_fields_token)) else index_x2a_Sl_ddvel = 0 diff --git a/src/cpl/nuopc/atm_comp_nuopc.F90 b/src/cpl/nuopc/atm_comp_nuopc.F90 index 8fd2343a5a..bfde73912d 100644 --- a/src/cpl/nuopc/atm_comp_nuopc.F90 +++ b/src/cpl/nuopc/atm_comp_nuopc.F90 @@ -4,54 +4,78 @@ module atm_comp_nuopc ! This is the NUOPC cap for CAM !---------------------------------------------------------------------------- - use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_IsUpdated, NUOPC_IsAtTime - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC , only : NUOPC_SetAttribute, NUOPC_CompAttributeGet, NUOPC_CompAttributeSet - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - use NUOPC_Model , only : model_label_DataInitialize => label_DataInitialize - use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock - use NUOPC_Model , only : model_label_Finalize => label_Finalize - use NUOPC_Model , only : NUOPC_ModelGet - use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_sys_mod , only : shr_sys_abort - use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit - use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date - use shr_const_mod , only : shr_const_pi - use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT - use cam_instance , only : cam_instance_init, inst_suffix, inst_index - use cam_comp , only : cam_init, cam_run1, cam_run2, cam_run3, cam_run4, cam_final - use radiation , only : radiation_nextsw_cday - use camsrfexch , only : cam_out_t, cam_in_t - use cam_logfile , only : iulog - use spmd_utils , only : spmdinit, masterproc, iam, mpicom - use time_manager , only : get_curr_calday, advance_timestep, get_curr_date, get_nstep, get_step_size - use atm_import_export , only : advertise_fields, realize_fields - use atm_import_export , only : import_fields, export_fields - use atm_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit - use atm_shr_methods , only : set_component_logging, get_component_instance, log_clock_advance - use ioFileMod - use perf_mod , only : t_startf, t_stopf - use ppgrid , only : pcols, begchunk, endchunk - use phys_grid , only : get_ncols_p, get_gcol_p, get_rlon_all_p, get_rlat_all_p, ngcols - use dyn_grid , only : get_horiz_grid_dim_d - use cam_control_mod , only : cam_ctrl_set_orbit - use cam_pio_utils , only : cam_pio_createfile, cam_pio_openfile, cam_pio_closefile, pio_subsystem - use cam_initfiles , only : cam_initfiles_get_caseid, cam_initfiles_get_restdir - use cam_history_support , only : fillvalue - use filenames , only : interpret_filename_spec - use pio , only : file_desc_t, io_desc_t, var_desc_t, pio_double, pio_def_dim, PIO_MAX_NAME - use pio , only : pio_initdecomp, pio_freedecomp - use pio , only : pio_closefile, pio_inq_varid, pio_put_att, pio_enddef - use pio , only : pio_read_darray, pio_write_darray, pio_def_var, pio_inq_varid - use pio , only : pio_noerr, pio_bcast_error, pio_internal_error, pio_seterrorhandling + use ESMF , only : operator(<=), operator(>), operator(==), operator(+) + use ESMF , only : ESMF_MethodRemove + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_State, ESMF_StateGet + use ESMF , only : ESMF_Grid, ESMF_GridCreateNoPeriDimUfrm, ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_DistGrid, ESMF_DistGridCreate + use ESMF , only : ESMF_Mesh, ESMF_MeshCreate, ESMF_MeshGet, ESMF_FILEFORMAT_ESMFMESH + use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockGetNextTime, ESMF_ClockAdvance + use ESMF , only : ESMF_Time, ESMF_TimeGet + use ESMF , only : ESMF_Alarm, ESMF_ClockGetAlarm, ESMF_AlarmRingerOff, ESMF_AlarmIsRinging + use ESMF , only : ESMF_ClockGetAlarmList, ESMF_ALARMLIST_ALL, ESMF_AlarmSet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet + use ESMF , only : ESMF_CalKind_Flag, ESMF_MAXSTR, ESMF_KIND_I8 + use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN + use ESMF , only : ESMF_GridCompSetEntryPoint + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_LogWrite, ESMF_LogSetError, ESMF_LogFoundError + use ESMF , only : ESMF_SUCCESS, ESMF_METHOD_INITIALIZE, ESMF_FAILURE, ESMF_RC_NOT_VALID + use ESMF , only : ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_IsUpdated, NUOPC_IsAtTime + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC , only : NUOPC_SetAttribute, NUOPC_CompAttributeGet, NUOPC_CompAttributeSet + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : SetVM + use NUOPC_Model , only : model_label_Advance => label_Advance + use NUOPC_Model , only : model_label_DataInitialize => label_DataInitialize + use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock + use NUOPC_Model , only : model_label_Finalize => label_Finalize + use NUOPC_Model , only : NUOPC_ModelGet + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use shr_log_mod , only : shr_log_getlogunit, shr_log_setlogunit + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use shr_const_mod , only : shr_const_pi + use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT + use cam_instance , only : cam_instance_init, inst_suffix, inst_index + use cam_comp , only : cam_init, cam_run1, cam_run2, cam_run3, cam_run4, cam_final + use camsrfexch , only : cam_out_t, cam_in_t + use radiation , only : nextsw_cday + use cam_logfile , only : iulog + use spmd_utils , only : spmdinit, masterproc, iam, mpicom + use time_manager , only : get_curr_calday, advance_timestep, get_curr_date, get_nstep, get_step_size + use atm_import_export , only : read_surface_fields_namelists, advertise_fields, realize_fields + use atm_import_export , only : import_fields, export_fields + use nuopc_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit + use nuopc_shr_methods , only : set_component_logging, get_component_instance, log_clock_advance + use perf_mod , only : t_startf, t_stopf + use ppgrid , only : pcols, begchunk, endchunk + use dyn_grid , only : get_horiz_grid_dim_d + use phys_grid , only : get_ncols_p, get_gcol_p, get_rlon_all_p, get_rlat_all_p + use phys_grid , only : ngcols=>num_global_phys_cols + use cam_control_mod , only : cam_ctrl_set_orbit + use cam_pio_utils , only : cam_pio_createfile, cam_pio_openfile, cam_pio_closefile, pio_subsystem + use cam_initfiles , only : cam_initfiles_get_caseid, cam_initfiles_get_restdir + use cam_history_support , only : fillvalue + use filenames , only : interpret_filename_spec + use pio , only : file_desc_t, io_desc_t, var_desc_t, pio_double, pio_def_dim, PIO_MAX_NAME + use pio , only : pio_closefile, pio_put_att, pio_enddef, pio_nowrite + use pio , only : pio_inq_dimid, pio_inq_varid, pio_inquire_dimension, pio_def_var + use pio , only : pio_initdecomp, pio_freedecomp + use pio , only : pio_read_darray, pio_write_darray + use pio , only : pio_noerr, pio_bcast_error, pio_internal_error, pio_seterrorhandling + use pio , only : pio_def_var, pio_get_var, pio_put_var, PIO_INT + use ioFileMod + !$use omp_lib , only : omp_set_num_threads implicit none private ! except public :: SetServices + public :: SetVM !-------------------------------------------------------------------------- ! Private interfaces @@ -67,39 +91,47 @@ module atm_comp_nuopc private :: cam_write_srfrest private :: cam_orbital_init private :: cam_orbital_update + private :: cam_set_mesh_for_single_column + private :: cam_pio_checkerr !-------------------------------------------------------------------------- ! Private module data !-------------------------------------------------------------------------- - character(len=CL) :: flds_scalar_name = '' - integer :: flds_scalar_num = 0 - integer :: flds_scalar_index_nx = 0 - integer :: flds_scalar_index_ny = 0 - integer :: flds_scalar_index_nextsw_cday = 0 - - integer , parameter :: dbug_flag = 6 - type(cam_in_t) , pointer :: cam_in(:) - type(cam_out_t) , pointer :: cam_out(:) - integer , pointer :: dof(:) ! global index space decomposition - character(len=256) :: rsfilename_spec_cam ! Filename specifier for restart surface file - character(*) ,parameter :: modName = "(atm_comp_nuopc)" - character(*) ,parameter :: u_FILE_u = & + character(len=CL) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0 + integer :: nthrds + integer , parameter :: dbug_flag = 0 + type(cam_in_t) , pointer :: cam_in(:) + type(cam_out_t) , pointer :: cam_out(:) + integer , pointer :: dof(:) ! global index space decomposition + character(len=256) :: rsfilename_spec_cam ! Filename specifier for restart surface file + character(*) ,parameter :: modName = "(atm_comp_nuopc)" + character(*) ,parameter :: u_FILE_u = & __FILE__ - logical :: dart_mode = .false. + logical :: dart_mode = .false. + logical :: mediator_present - character(len=CL) :: orb_mode ! attribute - orbital mode - integer :: orb_iyear ! attribute - orbital year - integer :: orb_iyear_align ! attribute - associated with model year - real(R8) :: orb_obliq ! attribute - obliquity in degrees - real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude - real(R8) :: orb_eccen ! attribute and update- orbital eccentricity + character(len=CL) :: orb_mode ! attribute - orbital mode + integer :: orb_iyear ! attribute - orbital year + integer :: orb_iyear_align ! attribute - associated with model year + real(R8) :: orb_obliq ! attribute - obliquity in degrees + real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude + real(R8) :: orb_eccen ! attribute and update- orbital eccentricity character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' + real(R8) , parameter :: grid_tol = 1.e-2_r8 ! tolerance for calculated lat/lon vs read in + + type(ESMF_Mesh) :: model_mesh ! model_mesh + type(ESMF_Clock) :: model_clock ! model_clock + !=============================================================================== contains !=============================================================================== @@ -112,7 +144,6 @@ subroutine SetServices(gcomp, rc) character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS - if (dbug_flag > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! the NUOPC gcomp component will register the generic methods @@ -155,12 +186,9 @@ subroutine SetServices(gcomp, rc) specRoutine=ModelFinalize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - end subroutine SetServices !=============================================================================== - subroutine InitializeP0(gcomp, importState, exportState, clock, rc) type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -177,7 +205,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) end subroutine InitializeP0 !=============================================================================== - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! intput/output variables @@ -198,7 +225,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -212,7 +241,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call set_component_logging(gcomp, localpet==0, iulog, shrlogunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_file_setLogUnit (shrlogunit) + call shr_log_setLogUnit (iulog) !---------------------------------------------------------------------------- ! advertise import/export fields @@ -272,17 +301,31 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxNextSwCday') endif - call advertise_fields(gcomp, flds_scalar_name, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! read mediator fields namelists + call read_surface_fields_namelists() - if (dbug_flag > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + call NUOPC_CompAttributeGet(gcomp, name="mediator_present", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read (cvalue,*) mediator_present + if (mediator_present) then + call advertise_fields(gcomp, flds_scalar_name, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + else + call shr_sys_abort(subname//'Need to set attribute mediator_present') + endif + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + end if end subroutine InitializeAdvertise !=============================================================================== - subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + use ESMF, only : ESMF_VMGet + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState @@ -291,15 +334,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables + type(ESMF_VM) :: vm type(ESMF_Time) :: currTime ! Current time type(ESMF_Time) :: startTime ! Start time type(ESMF_Time) :: stopTime ! Stop time type(ESMF_Time) :: refTime ! Ref time type(ESMF_TimeInterval) :: timeStep - type(ESMF_Calendar) :: esmf_calendar ! esmf calendar type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type type(ESMF_DistGrid) :: distGrid - type(ESMF_Mesh) :: Emesh, EmeshTemp integer :: spatialDim integer :: numOwnedElements real(R8), pointer :: ownedElemCoords(:) @@ -335,25 +377,26 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(len=cl) :: model_doi_url ! DOI for CESM model run logical :: aqua_planet ! Flag to run model in "aqua planet" mode logical :: brnch_retain_casename ! true => branch run has same caseid as run being branched from - logical :: single_column - real(r8) :: scmlat - real(r8) :: scmlon + logical :: single_column = .false. + character(len=cl) :: single_column_lnd_domainfile + real(r8) :: scol_lon + real(r8) :: scol_lat + real(r8) :: scol_spval real(r8) :: eccen real(r8) :: obliqr real(r8) :: lambm0 real(r8) :: mvelpp - logical :: dart_mode_in !character(len=cl) :: atm_resume_all_inst(num_inst_atm) ! atm resume file integer :: lbnum character(CS) :: inst_name integer :: inst_index character(CS) :: inst_suffix integer :: lmpicom - type(ESMF_VM) :: vm - logical :: isPresent + logical :: isPresent, isSet character(len=512) :: diro character(len=512) :: logfile integer :: compid ! component id + integer :: localPet, localPeCount logical :: initial_run ! startup mode which only requires a minimal initial file logical :: restart_run ! continue a previous run; requires a restart file logical :: branch_run ! branch from a previous run; requires a restart file @@ -366,34 +409,41 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if - call shr_file_setLogUnit (iulog) + call shr_log_setLogUnit (iulog) !---------------------------------------------------------------------------- ! generate local mpi comm !---------------------------------------------------------------------------- - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + call ESMF_GridCompGet(gcomp, vm=vm, localpet=localPet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, mpiCommunicator=lmpicom, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(localPeCount == 1) then + call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + read(cvalue,*) nthrds + else + nthrds = localPeCount + endif + +!$ call omp_set_num_threads(nthrds) !---------------------------------------------------------------------------- ! determine instance information !---------------------------------------------------------------------------- - call ESMF_AttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - cvalue = inst_suffix(2:) - read(cvalue, *) inst_index - else - inst_suffix = '' - inst_index = 1 - end if + inst_name = 'ATM'//inst_suffix ! Set filename specifier for restart surface file ! (%c=caseid, $y=year, $m=month, $d=day, $s=seconds in day) @@ -450,51 +500,56 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) read(cvalue,*) caseid ctitle=caseid - call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) + ! starting info + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlon - - call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) + read(cvalue,*) start_type + call NUOPC_CompAttributeGet(gcomp, name='brnch_retain_casename', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlat + read(cvalue,*) brnch_retain_casename - call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, rc=rc) + ! single column input + call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) single_column - - call NUOPC_CompAttributeGet(gcomp, name='brnch_retain_casename', value=cvalue, rc=rc) + read(cvalue,*) scol_lon + call NUOPC_CompAttributeGet(gcomp, name='scol_lat', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) brnch_retain_casename + read(cvalue,*) scol_lat + call NUOPC_CompAttributeGet(gcomp, name='scol_spval', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_spval - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) + ! For single column mode in cam need to have a valid single_column_lnd_domainfile for the mask + call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', value=single_column_lnd_domainfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) start_type + if (scol_lon > scol_spval .and. scol_lat > scol_spval) then + if (trim(single_column_lnd_domainfile) /= 'UNSET') then + single_column = .true. + else + call shr_sys_abort('single_column_lnd_domainfile cannot be null for single column mode') + end if + else + single_column = .false. + end if + ! aqua planet input call NUOPC_CompAttributeGet(gcomp, name='aqua_planet', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) aqua_planet + ! perpetual input call NUOPC_CompAttributeGet(gcomp, name='perpetual', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) perpetual_run - call NUOPC_CompAttributeGet(gcomp, name='perpetual_ymd', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) perpetual_ymd - ! TODO: query the config attributes for the number of instances - assumes multi-driver + ! TODO: query the config attributes for the number of instances - ASSUMES multi-driver ! TODO: must obtain model_doi_url from gcomp - for now hardwire to 'not_set' model_doi_url = 'not_set' - ! TODO: obtain dart_mode as a attribute variable - ! DART always starts up as an initial run. - if (dart_mode) then - initial_run = .true. - restart_run = .false. - branch_run = .false. - end if - ! Initialize CAM, allocate cam_in and cam_out and determine ! atm decomposition (needed to initialize gsmap) ! for an initial run, cam_in and cam_out are allocated in cam_init @@ -516,6 +571,19 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_sys_abort( subname//' ERROR: unknown start_type' ) end if + ! DART always starts up as an initial run. + call NUOPC_CompAttributeGet(gcomp, name='data_assimilation_atm', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) dart_mode + end if + if (dart_mode) then + initial_run = .true. + restart_run = .false. + branch_run = .false. + end if + ! Get properties from clock call ESMF_ClockGet( clock, & currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, & @@ -553,7 +621,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if ! Initialize module orbital values and update orbital - call cam_orbital_init(gcomp, iulog, masterproc, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call cam_orbital_update(clock, iulog, masterproc, eccen, obliqr, lambm0, mvelpp, rc) @@ -566,174 +633,145 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if call cam_init( & - caseid=caseid, & - ctitle=ctitle, & - model_doi_url=model_doi_url, & - initial_run_in=initial_run, & - restart_run_in=restart_run, & - branch_run_in=branch_run, & - calendar=calendar, & - brnch_retain_casename=brnch_retain_casename, & - aqua_planet=aqua_planet, & - single_column=single_column, & - scmlat=scmlat, & - scmlon=scmlon, & - eccen=eccen, & - obliqr=obliqr, & - lambm0=lambm0, & - mvelpp=mvelpp, & - perpetual_run=perpetual_run, & - perpetual_ymd=perpetual_ymd, & - dtime=dtime, & - start_ymd=start_ymd, & - start_tod=start_tod, & - ref_ymd=ref_ymd, & - ref_tod=ref_tod, & - stop_ymd=stop_ymd, & - stop_tod=stop_tod, & - curr_ymd=curr_ymd, & - curr_tod=curr_tod, & - cam_out=cam_out, & - cam_in=cam_in) - - !-------------------------------- - ! generate the mesh - !-------------------------------- - - lsize = 0 - do c = begchunk, endchunk - do i = 1, get_ncols_p(c) - lsize = lsize + 1 - end do - end do - allocate(dof(lsize)) - n = 0 - do c = begchunk, endchunk - do i = 1, get_ncols_p(c) - n = n+1 - dof(n) = get_gcol_p(c,i) - end do - end do - - ! create distGrid from global index array - DistGrid = ESMF_DistGridCreate(arbSeqIndexList=dof, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! read in the mesh - call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc) then - write(iulog,*)'mesh file for cam domain is ',trim(cvalue) - end if + caseid=caseid, ctitle=ctitle, model_doi_url=model_doi_url, & + initial_run_in=initial_run, restart_run_in=restart_run, & + branch_run_in=branch_run, post_assim_in=dart_mode, & + calendar=calendar, brnch_retain_casename=brnch_retain_casename, aqua_planet=aqua_planet, & + single_column=single_column, scmlat=scol_lat, scmlon=scol_lon, & + eccen=eccen, obliqr=obliqr, lambm0=lambm0, mvelpp=mvelpp, & + perpetual_run=perpetual_run, perpetual_ymd=perpetual_ymd, & + dtime=dtime, start_ymd=start_ymd, start_tod=start_tod, ref_ymd=ref_ymd, ref_tod=ref_tod, & + stop_ymd=stop_ymd, stop_tod=stop_tod, curr_ymd=curr_ymd, curr_tod=curr_tod, & + cam_out=cam_out, cam_in=cam_in) + + if (mediator_present) then + + if (single_column) then + + call cam_set_mesh_for_single_column(scol_lon, scol_lat, model_mesh, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(dof(1)) + dof(1) = 1 - ! recreate the mesh using the above distGrid - EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + else - ! obtain mesh lats and lons - call ESMF_MeshGet(Emesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (numOwnedElements /= lsize) then - write(tempc1,'(i10)') numOwnedElements - write(tempc2,'(i10)') lsize - call ESMF_LogWrite(trim(subname)//": ERROR numOwnedElements "// trim(tempc1) // & - " not equal to local size "// trim(tempc2), ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - end if - allocate(ownedElemCoords(spatialDim*numOwnedElements)) - allocate(lonMesh(lsize), latMesh(lsize)) - call ESMF_MeshGet(Emesh, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,lsize - lonMesh(n) = ownedElemCoords(2*n-1) - latMesh(n) = ownedElemCoords(2*n) - end do + ! generate the dof + lsize = 0 + do c = begchunk, endchunk + do i = 1, get_ncols_p(c) + lsize = lsize + 1 + end do + end do + allocate(dof(lsize)) + n = 0 + do c = begchunk, endchunk + do i = 1, get_ncols_p(c) + n = n+1 + dof(n) = get_gcol_p(c,i) + end do + end do - ! obtain internally generated cam lats and lons - allocate(lon(lsize)); lon(:) = 0._r8 - allocate(lat(lsize)); 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 + ! create distGrid from global index array + DistGrid = ESMF_DistGridCreate(arbSeqIndexList=dof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! error check differences between internally generated lons and those read in - do n = 1,lsize - if (abs(lonMesh(n) - lon(n)) > 1.e-12_r8) then - write(6,100)n,lon(n),lonMesh(n), abs(lonMesh(n)-lon(n)) -100 format('ERROR: CAM n, lonmesh(n), lon(n), diff_lon = ',i6,2(f21.13,3x),d21.5) - end if - if (abs(latMesh(n) - lat(n)) > 1.e-12_r8) then - write(6,100)n,lat(n),latMesh(n), abs(latMesh(n)-lat(n)) -101 format('ERROR: CAM n, latmesh(n), lat(n), diff_lat = ',i6,2(f21.13,3x),d21.5) - end if - end do + ! read in the mesh + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! deallocate memory - deallocate(ownedElemCoords) - deallocate(lon, lonMesh) - deallocate(lat, latMesh) + model_mesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, & + elementDistgrid=Distgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc) then + write(iulog,*)'mesh file for cam domain is ',trim(cvalue) + end if - !-------------------------------- - ! realize the actively coupled fields - !-------------------------------- + ! obtain mesh lats and lons + call ESMF_MeshGet(model_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (numOwnedElements /= lsize) then + write(tempc1,'(i10)') numOwnedElements + write(tempc2,'(i10)') lsize + call ESMF_LogWrite(trim(subname)//": ERROR numOwnedElements "// trim(tempc1) // & + " not equal to local size "// trim(tempc2), ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + end if + allocate(ownedElemCoords(spatialDim*numOwnedElements)) + allocate(lonMesh(lsize), latMesh(lsize)) + call ESMF_MeshGet(model_mesh, ownedElemCoords=ownedElemCoords) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize + lonMesh(n) = ownedElemCoords(2*n-1) + latMesh(n) = ownedElemCoords(2*n) + end do + + ! obtain internally generated cam lats and lons + allocate(lon(lsize)); lon(:) = 0._r8 + allocate(lat(lsize)); 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 + + ! error check differences between internally generated lons and those read in + do n = 1,lsize + if (abs(lonMesh(n) - lon(n)) > grid_tol .and. .not. & + abs(abs(lonMesh(n) - lon(n))- 360._r8) < grid_tol) then + write(6,100)n,lon(n),lonMesh(n), abs(lonMesh(n)-lon(n)) +100 format('ERROR: CAM n, lonmesh(n), lon(n), diff_lon = ',i6,2(f21.13,3x),d21.5) + call shr_sys_abort() + end if + if (abs(latMesh(n) - lat(n)) > grid_tol) then + write(6,100)n,lat(n),latMesh(n), abs(latMesh(n)-lat(n)) +101 format('ERROR: CAM n, latmesh(n), lat(n), diff_lat = ',i6,2(f21.13,3x),d21.5) + call shr_sys_abort() + end if + end do - call realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! deallocate memory + deallocate(ownedElemCoords) + deallocate(lon, lonMesh) + deallocate(lat, latMesh) - !-------------------------------- - ! Create cam export array and set the state scalars - !-------------------------------- + end if ! end of if single_column - call export_fields( gcomp, cam_out, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! realize the actively coupled fields + call realize_fields(gcomp, model_mesh, flds_scalar_name, flds_scalar_num, single_column, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call get_horiz_grid_dim_d(hdim1_d, hdim2_d) - call State_SetScalar(dble(hdim1_d), flds_scalar_index_nx, exportState, & - flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_SetScalar(dble(hdim2_d), flds_scalar_index_ny, exportState, & - flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Create model_clock as a module variable - needed for generating streams + model_clock = clock - !-------------------------------- - ! diagnostics - !-------------------------------- + ! Create cam export array and set the state scalars + call export_fields( gcomp, model_mesh, model_clock, cam_out, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - call State_diagnose(exportState,subname//':ES',rc=rc) + call get_horiz_grid_dim_d(hdim1_d, hdim2_d) + call State_SetScalar(dble(hdim1_d), flds_scalar_index_nx, exportState, & + flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call State_SetScalar(dble(hdim2_d), flds_scalar_index_ny, exportState, & + flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - call ESMF_AttributeAdd(comp, convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ShortName", "CAM", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", "Community Atmosphere Model", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "Description", "Community Atmosphere Model", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2017", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Atmosphere", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "Name", "TBD", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "EmailAddress", TBD, convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", convention=convCIM, purpose=purpComp, rc=rc) -#endif + ! diagnostics + if (dbug_flag > 1) then + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif - call shr_file_setLogUnit (shrlogunit) + end if ! end of mediator_present if-block - if (dbug_flag > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + call shr_log_setLogUnit (shrlogunit) #if (defined _MEMTRACE) if(masterproc) then @@ -744,11 +782,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) endif #endif + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + end if + end subroutine InitializeRealize !=============================================================================== - subroutine DataInitialize(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -763,11 +805,7 @@ subroutine DataInitialize(gcomp, rc) integer :: n, fieldCount integer :: shrlogunit ! original log unit integer(ESMF_KIND_I8) :: stepno ! time step - integer :: dtime ! time step increment (sec) integer :: atm_cpl_dt ! driver atm coupling time step - integer :: nstep ! CAM nstep - real(r8) :: caldayp1 ! CAM calendar day for for next cam time step - real(r8) :: nextsw_cday ! calendar of next atm shortwave logical :: importDone ! true => import data is valid logical :: atCorrectTime ! true => field is at correct time character(CL) :: cvalue @@ -775,10 +813,12 @@ subroutine DataInitialize(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if - call shr_file_getLogUnit (shrlogunit) - call shr_file_setLogUnit (iulog) + call shr_log_getLogUnit (shrlogunit) + call shr_log_setLogUnit (iulog) #if (defined _MEMTRACE) if (masterproc) then @@ -803,154 +843,133 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - !-------------------------------- - ! Determine if all the import state has been initialized - ! And if not initialized, then return - !-------------------------------- + !--------------------------------------------------------------- + if (mediator_present) then + !--------------------------------------------------------------- - call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine if all the import state has been initialized + ! And if not initialized, then return - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(importState, itemNameList=fieldNameList, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - importDone = .true. - do n=1, fieldCount - call ESMF_StateGet(importState, itemName=fieldNameList(n), field=field, rc=rc) + call ESMF_StateGet(importState, itemCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - atCorrectTime = NUOPC_IsAtTime(field, currTime, rc=rc) + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(importState, itemNameList=fieldNameList, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (.not. atCorrectTime) then - call ESMF_LogWrite("CAM - Initialize-Data-Dependency NOT YET SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) + importDone = .true. + do n=1, fieldCount + call ESMF_StateGet(importState, itemName=fieldNameList(n), field=field, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - importDone = .false. - exit ! break out of the loop when first not satisfied found - end if - end do - deallocate(fieldNameList) - - !-------------------------------- - ! Import state has not been initialized - RETURN - !-------------------------------- - - if (.not. importDone) then - ! Simply return if the import has not been initialized - call ESMF_LogWrite("CAM - Initialize-Data-Dependency Returning to mediator without doing tphysbc", & - ESMF_LOGMSG_INFO, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - RETURN - end if - - !-------------------------------- - ! Import state has been initialized - continue with tphysbc - !-------------------------------- - - call ESMF_LogWrite("CAM - Initialize-Data-Dependency doing tphysbc", ESMF_LOGMSG_INFO, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + atCorrectTime = NUOPC_IsAtTime(field, currTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- - ! get the current step number and coupling interval - !-------------------------------- + if (.not. atCorrectTime) then + call ESMF_LogWrite("CAM - Initialize-Data-Dependency NOT YET SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet( clock, TimeStep=timeStep, advanceCount=stepno, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + importDone = .false. + exit ! break out of the loop when first not satisfied found + end if + end do + deallocate(fieldNameList) - call ESMF_TimeIntervalGet( timeStep, s=atm_cpl_dt, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! *** Import state has not been initialized - RETURN **** - !-------------------------------- - ! For initial run, unpack the import state, run cam radiation/clouds and return - ! For restart run, read the import state from the restart and run radiation/clouds and return - !-------------------------------- + if (.not. importDone) then + ! Simply return if the import has not been initialized + call ESMF_LogWrite("CAM - Initialize-Data-Dependency Returning to mediator without doing tphysbc", & + ESMF_LOGMSG_INFO, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + RETURN + end if - ! Note - cam_run1 is called only for the purposes of finishing the - ! flux averaged calculation to compute cam-out - ! Note - cam_run1 is called on restart only to have cam internal state consistent with the - ! cam_out state sent to the coupler + ! *** Import state has been initialized - continue with tphysbc *** - if (stepno == 0) then - call import_fields( gcomp, cam_in, rc=rc ) + call ESMF_LogWrite("CAM - Initialize-Data-Dependency doing tphysbc", ESMF_LOGMSG_INFO, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call cam_run1 ( cam_in, cam_out ) - - call export_fields( gcomp, cam_out, rc=rc ) + ! get the current step number and coupling interval + call ESMF_ClockGet( clock, TimeStep=timeStep, advanceCount=stepno, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call cam_read_srfrest( gcomp, clock, rc=rc ) + call ESMF_TimeIntervalGet( timeStep, s=atm_cpl_dt, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call import_fields( gcomp, cam_in, restart_init=.true., rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! For initial run, unpack the import state, run cam radiation/clouds and return + ! For restart run, read the import state from the restart and run radiation/clouds and return - call cam_run1 ( cam_in, cam_out ) + ! Note - cam_run1 is called only for the purposes of finishing the + ! flux averaged calculation to compute cam-out + ! Note - cam_run1 is called on restart only to have cam internal state consistent with the + ! cam_out state sent to the coupler + + if (stepno == 0) then + call import_fields( gcomp, cam_in, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call cam_run1 ( cam_in, cam_out ) + call export_fields( gcomp, model_mesh, model_clock, cam_out, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call cam_read_srfrest( gcomp, clock, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call import_fields( gcomp, cam_in, restart_init=.true., rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call cam_run1 ( cam_in, cam_out ) + call export_fields( gcomp, model_mesh, model_clock, cam_out, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - call export_fields( gcomp, cam_out, rc=rc ) + ! Compute time of next radiation computation + call State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & + flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - ! Compute time of next radiation computation, like in run method for exact restart - dtime = get_step_size() - nstep = get_nstep() - if (nstep < 1 .or. dtime < atm_cpl_dt) then - nextsw_cday = radiation_nextsw_cday() - else if (dtime == atm_cpl_dt) then - caldayp1 = get_curr_calday(offset=int(dtime)) - nextsw_cday = radiation_nextsw_cday() - if (caldayp1 /= nextsw_cday) nextsw_cday = -1._r8 - else - call shr_sys_abort('dtime must be less than or equal to atm_cpl_dt') - end if + ! diagnostics + if (dbug_flag > 1) then + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif - call State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & - flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! CAM data is now fully initialized - !-------------------------------- - ! diagnostics - !-------------------------------- + call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - call State_diagnose(exportState,subname//':ES',rc=rc) + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - !-------------------------------- - ! CAM data is now fully initialized - !-------------------------------- + do n=1, fieldCount + call ESMF_StateGet(exportState, itemName=fieldNameList(n), field=field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + deallocate(fieldNameList) - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! check whether all Fields in the exportState are "Updated" + if (NUOPC_IsUpdated(exportState)) then + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n=1, fieldCount - call ESMF_StateGet(exportState, itemName=fieldNameList(n), field=field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite("CAM - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - deallocate(fieldNameList) + !--------------------------------------------------------------- + else ! mediator is not present + !--------------------------------------------------------------- - ! check whether all Fields in the exportState are "Updated" - if (NUOPC_IsUpdated(exportState)) then - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) + call cam_run1 ( cam_in, cam_out ) - call ESMF_LogWrite("CAM - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - !-------------------------------- ! End redirection of share output to cam log - !-------------------------------- - - call shr_file_setLogUnit (shrlogunit) + call shr_log_setLogUnit (shrlogunit) #if (defined _MEMTRACE) if(masterproc) then @@ -959,20 +978,24 @@ subroutine DataInitialize(gcomp, rc) endif #endif + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + end if + end subroutine DataInitialize !=============================================================================== - subroutine ModelAdvance(gcomp, rc) - ! !DESCRIPTION: + use ESMF, only : ESMF_GridCompGet, esmf_vmget, esmf_vm ! Run CAM - ! !ARGUMENTS: + ! Input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - ! !LOCAL VARIABLES: + ! local variables + type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_Alarm) :: alarm type(ESMF_Time) :: time @@ -990,7 +1013,6 @@ subroutine ModelAdvance(gcomp, rc) real(r8) :: mvelpp logical :: dosend ! true => send data back to driver integer :: dtime ! time step increment (sec) - integer :: atm_cpl_dt ! driver atm coupling time step integer :: ymd_sync ! Sync ymd integer :: yr_sync ! Sync current year integer :: mon_sync ! Sync current month @@ -1001,19 +1023,20 @@ subroutine ModelAdvance(gcomp, rc) integer :: mon ! CAM current month integer :: day ! CAM current day integer :: tod ! CAM current time of day (sec) - real(r8) :: caldayp1 ! CAM calendar day for for next cam time step - real(r8) :: nextsw_cday ! calendar of next atm shortwave logical :: rstwr ! .true. ==> write restart file before returning logical :: nlend ! Flag signaling last time-step integer :: lbnum + integer :: localPet, localPeCount + logical :: first_time = .true. character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - call shr_file_getLogUnit (shrlogunit) - call shr_file_setLogUnit (iulog) +!$ call omp_set_num_threads(nthrds) + + call shr_log_getLogUnit (shrlogunit) + call shr_log_setLogUnit (iulog) #if (defined _MEMTRACE) if(masterproc) then @@ -1046,35 +1069,31 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_TimeGet(nexttime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_GetScalar(importState, flds_scalar_index_nextsw_cday, nextsw_cday, & - flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !---------------------- ! Update and load orbital parameters !---------------------- - call cam_orbital_update(clock, iulog, masterproc, eccen, obliqr, lambm0, mvelpp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call cam_ctrl_set_orbit(eccen, obliqr, lambm0, mvelpp) + if (trim(orb_mode) == trim(orb_variable_year) .or. first_time) then + call cam_orbital_update(clock, iulog, masterproc, eccen, obliqr, lambm0, mvelpp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call cam_ctrl_set_orbit(eccen, obliqr, lambm0, mvelpp) + end if + first_time = .false. !-------------------------------- - ! Unpack import state + ! Run cam !-------------------------------- - call t_startf ('CAM_import') - call State_diagnose(importState, string=subname//':IS', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call import_fields( gcomp, cam_in, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call t_stopf ('CAM_import') + ! Unpack import state + if (mediator_present) then + call t_startf ('CAM_import') + call State_diagnose(importState, string=subname//':IS', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- - ! Run cam - !-------------------------------- + call import_fields( gcomp, cam_in, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf ('CAM_import') + end if dosend = .false. do while (.not. dosend) @@ -1138,50 +1157,47 @@ subroutine ModelAdvance(gcomp, rc) call cam_run1 ( cam_in, cam_out ) call t_stopf ('CAM_run1') - ! Map output from cam to nuopc state fields + end do + if (mediator_present) then + ! Set export fields call t_startf ('CAM_export') - call export_fields( gcomp, cam_out, rc ) + call export_fields( gcomp, model_mesh, model_clock, cam_out, rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf ('CAM_export') - end do - - !-------------------------------- - ! Set the coupling scalars - !-------------------------------- + ! Set the coupling scalars + ! Return time of next radiation calculation - albedos will need to be + ! calculated by each surface model at this time + call State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & + flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Return time of next radiation calculation - albedos will need to be - ! calculated by each surface model at this time + ! diagnostics + if (dbug_flag > 1) then + call State_diagnose(exportState, string=subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc) then + call log_clock_advance(clock, 'CAM', iulog, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + endif - call ESMF_ClockGet( clock, TimeStep=timeStep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet( timeStep, s=atm_cpl_dt, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Write merged surface data restart file if appropriate + if (rstwr) then + call cam_write_srfrest( gcomp, & + yr_spec=yr_sync, mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - dtime = get_step_size() - if (dtime < atm_cpl_dt) then - nextsw_cday = radiation_nextsw_cday() - else if (dtime == atm_cpl_dt) then - caldayp1 = get_curr_calday(offset=int(dtime)) - nextsw_cday = radiation_nextsw_cday() - if (caldayp1 /= nextsw_cday) nextsw_cday = -1._r8 else - call shr_sys_abort('dtime must be less than or equal to atm_cpl_dt') - end if - call State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & - flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !-------------------------------- - ! Write merged surface data restart file if appropriate - !-------------------------------- + ! if there is no mediator, then write the clock info to a driver restart file + if (rstwr) then + call cam_write_clockrest( clock, yr_sync, mon_sync, day_sync, tod_sync, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - if (rstwr) then - call cam_write_srfrest( gcomp, & - yr_spec=yr_sync, mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Check for consistency of internal cam clock with master sync clock @@ -1204,19 +1220,6 @@ subroutine ModelAdvance(gcomp, rc) call shr_sys_abort( subname//': CAM clock is not in sync with master Sync Clock' ) end if - !-------------------------------- - ! diagnostics - !-------------------------------- - - if (dbug_flag > 1) then - call State_diagnose(exportState, string=subname//':ES',rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc) then - call log_clock_advance(clock, 'CAM', iulog, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - endif - #if (defined _MEMTRACE) if(masterproc) then lbnum=1 @@ -1228,9 +1231,7 @@ subroutine ModelAdvance(gcomp, rc) ! Reset shr logging to my original values !-------------------------------- - call shr_file_setLogUnit (shrlogunit) - - if (dbug_flag > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + call shr_log_setLogUnit (shrlogunit) end subroutine ModelAdvance @@ -1262,7 +1263,6 @@ subroutine ModelSetRunClock(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! query the Component for its clocks call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) @@ -1296,51 +1296,51 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO) !---------------- - ! Restart alarm + ! Stop alarm !---------------- - call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="stop_option", value=stop_option, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="stop_n", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) restart_n + read(cvalue,*) stop_n - call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="stop_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) restart_ymd + read(cvalue,*) stop_ymd - call alarmInit(mclock, restart_alarm, restart_option, & - opt_n = restart_n, & - opt_ymd = restart_ymd, & + call alarmInit(mclock, stop_alarm, stop_option, & + opt_n = stop_n, & + opt_ymd = stop_ymd, & RefTime = mcurrTime, & - alarmname = 'alarm_restart', rc=rc) + alarmname = 'alarm_stop', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) + call ESMF_AlarmSet(stop_alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------- - ! Stop alarm + ! Restart alarm !---------------- - call NUOPC_CompAttributeGet(gcomp, name="stop_option", value=stop_option, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="stop_n", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) stop_n + read(cvalue,*) restart_n - call NUOPC_CompAttributeGet(gcomp, name="stop_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) stop_ymd + read(cvalue,*) restart_ymd - call alarmInit(mclock, stop_alarm, stop_option, & - opt_n = stop_n, & - opt_ymd = stop_ymd, & + call alarmInit(mclock, restart_alarm, restart_option, & + opt_n = restart_n, & + opt_ymd = restart_ymd, & RefTime = mcurrTime, & - alarmname = 'alarm_stop', rc=rc) + alarmname = 'alarm_restart', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AlarmSet(stop_alarm, clock=mclock, rc=rc) + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1355,12 +1355,9 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - end subroutine ModelSetRunClock !=============================================================================== - subroutine ModelFinalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -1377,10 +1374,11 @@ subroutine ModelFinalize(gcomp, rc) !-------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - call shr_file_getLogUnit (shrlogunit) - call shr_file_setLogUnit (iulog) + call shr_log_getLogUnit (shrlogunit) + call shr_log_setLogUnit (iulog) + + call cam_final( cam_out, cam_in ) if (masterproc) then write(iulog,F91) @@ -1388,14 +1386,11 @@ subroutine ModelFinalize(gcomp, rc) write(iulog,F91) end if - call shr_file_setLogUnit (shrlogunit) - - if (dbug_flag > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + call shr_log_setLogUnit (shrlogunit) end subroutine ModelFinalize !=============================================================================== - subroutine cam_orbital_init(gcomp, logunit, mastertask, rc) !---------------------------------------------------------- @@ -1405,7 +1400,7 @@ subroutine cam_orbital_init(gcomp, logunit, mastertask, rc) ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp integer , intent(in) :: logunit - logical , intent(in) :: mastertask + logical , intent(in) :: mastertask integer , intent(out) :: rc ! output error ! local variables @@ -1495,16 +1490,15 @@ subroutine cam_orbital_init(gcomp, logunit, mastertask, rc) end subroutine cam_orbital_init !=============================================================================== - subroutine cam_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0, mvelpp, rc) !---------------------------------------------------------- - ! Update orbital settings + ! Update orbital settings !---------------------------------------------------------- ! input/output variables type(ESMF_Clock) , intent(in) :: clock - integer , intent(in) :: logunit + integer , intent(in) :: logunit logical , intent(in) :: mastertask real(R8) , intent(inout) :: eccen ! orbital eccentricity real(R8) , intent(inout) :: obliqr ! Earths obliquity in rad @@ -1514,12 +1508,15 @@ subroutine cam_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0 ! local variables type(ESMF_Time) :: CurrTime ! current time - integer :: year ! model year at current time + integer :: year ! model year at current time integer :: orb_year ! orbital year for current orbital computation character(len=CL) :: msgstr ! temporary + logical, save :: logprint = .true. character(len=*) , parameter :: subname = "(cam_orbital_update)" !------------------------------------------- + rc = ESMF_SUCCESS + if (trim(orb_mode) == trim(orb_variable_year)) then call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1527,12 +1524,16 @@ subroutine cam_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0 if (chkerr(rc,__LINE__,u_FILE_u)) return orb_year = orb_iyear + (year - orb_iyear_align) else - orb_year = orb_iyear + orb_year = orb_iyear end if + if(.not. (logprint .and. mastertask)) then + logprint = .false. + endif eccen = orb_eccen - call shr_orb_params(orb_year, eccen, orb_obliq, orb_mvelp, obliqr, lambm0, mvelpp, mastertask) + call shr_orb_params(orb_year, eccen, orb_obliq, orb_mvelp, obliqr, lambm0, mvelpp, logprint) + logprint = .false. if ( eccen == SHR_ORB_UNDEF_REAL .or. obliqr == SHR_ORB_UNDEF_REAL .or. & mvelpp == SHR_ORB_UNDEF_REAL .or. lambm0 == SHR_ORB_UNDEF_REAL) then write (msgstr, *) subname//' ERROR: orb params incorrect' @@ -1543,7 +1544,6 @@ subroutine cam_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0 end subroutine cam_orbital_update !=============================================================================== - subroutine cam_read_srfrest( gcomp, clock, rc ) ! input/output variables @@ -1565,7 +1565,6 @@ subroutine cam_read_srfrest( gcomp, clock, rc ) real(r8), pointer :: fldptr(:) real(r8), pointer :: tmpptr(:) real(r8), pointer :: fldptr2d(:,:) - logical :: exists type(ESMF_Time) :: currTime ! time at previous interval integer :: yr_spec ! Current year integer :: mon_spec ! Current month @@ -1577,7 +1576,7 @@ subroutine cam_read_srfrest( gcomp, clock, rc ) integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fieldds integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fieldds integer :: lsize - character(len=2) :: cvalue + character(len=8) :: cvalue integer :: nloop character(len=4) :: prefix !----------------------------------------------------------------------- @@ -1679,7 +1678,7 @@ subroutine cam_read_srfrest( gcomp, clock, rc ) allocate(tmpptr(lsize)) do n = 1,ungriddedUBound(1) - cvalue = convert_int_to_string(n) + write(cvalue,'(i0)') n varname = trim(prefix)//trim(fieldnameList(nf))//trim(cvalue) rcode = pio_inq_varid(File,trim(varname) ,varid) @@ -1716,7 +1715,6 @@ subroutine cam_read_srfrest( gcomp, clock, rc ) end subroutine cam_read_srfrest !=========================================================================================== - subroutine cam_write_srfrest( gcomp, yr_spec, mon_spec, day_spec, sec_spec, rc ) ! Arguments @@ -1742,7 +1740,7 @@ subroutine cam_write_srfrest( gcomp, yr_spec, mon_spec, day_spec, sec_spec, rc ) real(r8), pointer :: fldptr2d(:,:) character(len=PIO_MAX_NAME) :: varname character(len=256) :: fname_srf_cam ! surface restart filename - character(len=2) :: cvalue + character(len=8) :: cvalue integer :: nloop character(len=4) :: prefix integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fieldds @@ -1826,7 +1824,7 @@ subroutine cam_write_srfrest( gcomp, yr_spec, mon_spec, day_spec, sec_spec, rc ) ! Output for each ungriddedUbound index do n = 1,ungriddedUBound(1) - cvalue = convert_int_to_string(n) + write(cvalue,'(i0)') n varname = trim(prefix)//trim(fieldNameList(nf))//trim(cvalue) rcode = pio_def_var(File,trim(varname), PIO_DOUBLE, dimid, varid) rcode = pio_put_att(File, varid, "_fillvalue", fillvalue) @@ -1897,7 +1895,7 @@ subroutine cam_write_srfrest( gcomp, yr_spec, mon_spec, day_spec, sec_spec, rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ungriddedUBound(1) - cvalue = convert_int_to_string(n) + write(cvalue,'(i0)') n varname = trim(prefix)//trim(fieldNameList(nf))//trim(cvalue) rcode = pio_inq_varid(File, trim(varname), varid) if (gridToFieldMap(1) == 1) then @@ -1923,20 +1921,140 @@ subroutine cam_write_srfrest( gcomp, yr_spec, mon_spec, day_spec, sec_spec, rc ) end subroutine cam_write_srfrest !=============================================================================== - function convert_int_to_string(number) result(output_string) - ! Returns a string corresponding to a given integer + subroutine cam_write_clockrest( clock, yr_spec, mon_spec, day_spec, sec_spec, rc ) + + ! When there is no mediator, the driver needs to have restart information to start up + ! This routine writes this out and the driver reads it back in on a restart run + + ! Arguments + type(ESMF_Clock) , intent(in) :: clock + integer , intent(in) :: yr_spec ! Simulation year + integer , intent(in) :: mon_spec ! Simulation month + integer , intent(in) :: day_spec ! Simulation day + integer , intent(in) :: sec_spec ! Seconds into current simulation day + integer , intent(out) :: rc ! error code + + ! Local variables + type(ESMF_Time) :: startTime + type(ESMF_Time) :: currTime + type(ESMF_Time) :: nextTime + integer :: unitn + type(file_desc_t) :: File + integer :: start_ymd + integer :: start_tod + integer :: curr_ymd + integer :: curr_tod + integer :: yy,mm,dd ! Temporaries for time query + type(var_desc_t) :: varid_start_ymd + type(var_desc_t) :: varid_start_tod + type(var_desc_t) :: varid_curr_ymd + type(var_desc_t) :: varid_curr_tod + integer :: rcode + character(ESMF_MAXSTR) :: restart_pfile + character(ESMF_MAXSTR) :: restart_file + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Get properties from clock + call ESMF_ClockGet( clock, startTime=startTime, currTime=currTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,start_ymd) + + call ESMF_TimeGet( nextTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_cal_ymd2date(yy,mm,dd,curr_ymd) + + ! Open clock info restart dataset + restart_file = interpret_filename_spec( '%c.cpl.r.%y-%m-%d-%s.nc', & + yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) + + if (masterproc) then + restart_pfile = interpret_filename_spec('rpointer.cpl.%y-%m-%d-%s',& + yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) + + write(iulog,*) " In this configuration, there is no mediator" + write(iulog,*) " Normally, the mediator restart file provides the restart time info" + write(iulog,*) " In this case, CAM will create the rpointer.cpl and cpl restart file" + write(iulog,*) " containing this information" + write(iulog,*) " writing rpointer file for driver clock info, rpointer.cpl" + write(iulog,*) " writing restart clock info for driver= "//trim(restart_file) + open(newunit=unitn, file=trim(restart_pfile), form='FORMATTED') + write(unitn,'(a)') trim(restart_file) + close(unitn) + endif + + call cam_pio_createfile(File, trim(restart_file), 0) + rcode = pio_def_var(File, 'start_ymd', PIO_INT, varid_start_ymd) + rcode = pio_def_var(File, 'start_tod', PIO_INT, varid_start_tod) + rcode = pio_def_var(File, 'curr_ymd' , PIO_INT, varid_curr_ymd) + rcode = pio_def_var(File, 'curr_tod' , PIO_INT, varid_curr_tod) + rcode = pio_enddef(File) + rcode = pio_put_var(File, varid_start_ymd, start_ymd) + rcode = pio_put_var(File, varid_start_tod, start_tod) + rcode = pio_put_var(File, varid_curr_ymd, curr_ymd) + rcode = pio_put_var(File, varid_curr_tod, curr_tod) + call cam_pio_closefile(File) + + end subroutine cam_write_clockrest + + !=============================================================================== + subroutine cam_set_mesh_for_single_column(scol_lon, scol_lat, mesh, rc) + + ! Generate a mesh for single column + use netcdf ! input/output variables - integer, intent(in) :: number - character(2) :: output_string ! function result - ! + real(r8) , intent(in) :: scol_lon + real(r8) , intent(in) :: scol_lat + type(ESMF_Mesh) , intent(out) :: mesh + integer , intent(out) :: rc + ! local variables - character(len=16) :: format_string - !----------------------------------------------------------------------- + type(ESMF_Grid) :: lgrid + integer :: maxIndex(2) + real(r8) :: mincornerCoord(2) + real(r8) :: maxcornerCoord(2) + character(len=*), parameter :: subname= ' (lnd_set_mesh_for_single_column) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Use center and come up with arbitrary area delta lon and lat = .1 degree + maxIndex(1) = 1 ! number of lons + maxIndex(2) = 1 ! number of lats + mincornerCoord(1) = scol_lon - .1_r8 ! min lon + mincornerCoord(2) = scol_lat - .1_r8 ! min lat + maxcornerCoord(1) = scol_lon + .1_r8 ! max lon + maxcornerCoord(2) = scol_lat + .1_r8 ! max lat - write(format_string,'(a,i0,a,i0,a)') '(i', 2, '.', 2, ')' - write(output_string,trim(format_string)) number + ! create the ESMF grid + lgrid = ESMF_GridCreateNoPeriDimUfrm (maxindex=maxindex, & + mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, & + staggerloclist=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - end function convert_int_to_string + ! create the mesh from the lgrid + mesh = ESMF_MeshCreate(lgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine cam_set_mesh_for_single_column + + !=============================================================================== + subroutine cam_pio_checkerr(ierror, description) + use pio, only : PIO_NOERR + integer , intent(in) :: ierror + character(*), intent(in) :: description + if (ierror /= PIO_NOERR) then + write (*,'(6a)') 'ERROR ', trim(description) + call shr_sys_abort() + endif + end subroutine cam_pio_checkerr end module atm_comp_nuopc diff --git a/src/cpl/nuopc/atm_import_export.F90 b/src/cpl/nuopc/atm_import_export.F90 index 13dc4a2e5f..c5ad5c253d 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -1,38 +1,44 @@ module atm_import_export - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise, NUOPC_IsConnected - use NUOPC_Model , only : NUOPC_ModelGet - use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Mesh, ESMF_StateGet - use ESMF , only : ESMF_KIND_R8, ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LogFoundError - use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag - use ESMF , only : operator(/=), operator(==) - use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs, cx=>shr_kind_cx - use shr_sys_mod , only : shr_sys_abort - use atm_shr_methods , only : chkerr - use cam_logfile , only : iulog - use srf_field_check , only : set_active_Sl_ram1 - use srf_field_check , only : set_active_Sl_fv - use srf_field_check , only : set_active_Sl_soilw - use srf_field_check , only : set_active_Fall_flxdst1 - use srf_field_check , only : set_active_Fall_flxvoc - use srf_field_check , only : set_active_Fall_flxfire - use srf_field_check , only : set_active_Fall_fco2_lnd - use srf_field_check , only : set_active_Faoo_fco2_ocn - use srf_field_check , only : set_active_Faxa_nhx - use srf_field_check , only : set_active_Faxa_noy + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise, NUOPC_IsConnected + use NUOPC_Model , only : NUOPC_ModelGet + use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Mesh, ESMF_StateGet, ESMF_Field + use ESMF , only : ESMF_Clock + use ESMF , only : ESMF_KIND_R8, ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LogFoundError + use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag + use ESMF , only : operator(/=), operator(==) + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs, cx=>shr_kind_cx + use shr_sys_mod , only : shr_sys_abort + use shr_mpi_mod , only : shr_mpi_min, shr_mpi_max + use nuopc_shr_methods , only : chkerr + use cam_logfile , only : iulog + use spmd_utils , only : masterproc, mpicom + use srf_field_check , only : set_active_Sl_ram1 + use srf_field_check , only : set_active_Sl_fv + use srf_field_check , only : set_active_Sl_soilw + use srf_field_check , only : set_active_Fall_flxdst1 + use srf_field_check , only : set_active_Fall_flxvoc + use srf_field_check , only : set_active_Fall_flxfire + use srf_field_check , only : set_active_Fall_fco2_lnd + use srf_field_check , only : set_active_Faoo_fco2_ocn + use atm_stream_ndep , only : stream_ndep_init, stream_ndep_interp, stream_ndep_is_initialized + use atm_stream_ndep , only : ndep_stream_active + use chemistry , only : chem_has_ndep_flx + use cam_control_mod , only : aqua_planet, simple_phys implicit none private ! except + public :: read_surface_fields_namelists public :: advertise_fields public :: realize_fields public :: import_fields public :: export_fields - public :: state_getfldptr private :: fldlist_add private :: fldlist_realize + private :: state_getfldptr type fldlist_type character(len=128) :: stdname @@ -46,35 +52,49 @@ module atm_import_export type (fldlist_type) , public, protected :: fldsToAtm(fldsMax) type (fldlist_type) , public, protected :: fldsFrAtm(fldsMax) - ! from lnd->atm - character(len=cx) :: carma_fields ! list of CARMA fields from lnd->atm - integer :: drydep_nflds ! number of dry deposition velocity fields lnd-> atm - integer :: megan_nflds ! number of MEGAN voc fields from lnd-> atm - integer :: emis_nflds ! number of fire emission fields from lnd-> atm + ! area correction factors for fluxes send and received from mediator + real(r8), allocatable :: mod2med_areacor(:) + real(r8), allocatable :: med2mod_areacor(:) - ! from atm-lnd/ocn - - integer :: dbug_flag = 6 ! ESMF log output - integer, parameter :: debug_import = 0 ! internal debug level - integer, parameter :: debug_export = 0 ! internal debug level + character(len=cx) :: carma_fields = ' ' ! list of CARMA fields from lnd->atm + integer :: drydep_nflds = -huge(1) ! number of dry deposition velocity fields lnd-> atm + integer :: megan_nflds = -huge(1) ! number of MEGAN voc fields from lnd-> atm + integer :: emis_nflds = -huge(1) ! number of fire emission fields from lnd-> atm + logical :: atm_provides_lightning = .false. ! cld to grnd lightning flash freq (min-1) character(*),parameter :: F01 = "('(cam_import_export) ',a,i8,2x,i8,2x,d21.14)" character(*),parameter :: F02 = "('(cam_import_export) ',a,i8,2x,i8,2x,i8,2x,d21.14)" - character(*),parameter :: u_FILE_u = & - __FILE__ + character(*),parameter :: u_FILE_u = __FILE__ !=============================================================================== contains !=============================================================================== - subroutine advertise_fields(gcomp, flds_scalar_name, rc) + !----------------------------------------------------------- + ! read mediator fields namelist file + !----------------------------------------------------------- + subroutine read_surface_fields_namelists() - use spmd_utils , only : masterproc - use seq_drydep_mod , only : seq_drydep_readnl, seq_drydep_init + use shr_drydep_mod , only : shr_drydep_readnl use shr_megan_mod , only : shr_megan_readnl use shr_fire_emis_mod , only : shr_fire_emis_readnl use shr_carma_mod , only : shr_carma_readnl - use shr_ndep_mod , only : shr_ndep_readnl + use shr_lightning_coupling_mod, only : shr_lightning_coupling_readnl + + character(len=*), parameter :: nl_file_name = 'drv_flds_in' + + ! read mediator fields options + call shr_drydep_readnl(nl_file_name, drydep_nflds) + call shr_megan_readnl(nl_file_name, megan_nflds) + call shr_fire_emis_readnl(nl_file_name, emis_nflds) + call shr_carma_readnl(nl_file_name, carma_fields) + call shr_lightning_coupling_readnl(nl_file_name, atm_provides_lightning) + + end subroutine read_surface_fields_namelists + + !----------------------------------------------------------- + ! advertise fields + !----------------------------------------------------------- + subroutine advertise_fields(gcomp, flds_scalar_name, rc) ! input/output variables type(ESMF_GridComp) :: gcomp @@ -86,18 +106,15 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) type(ESMF_State) :: exportState character(ESMF_MAXSTR) :: stdname character(ESMF_MAXSTR) :: cvalue - character(len=2) :: nec_str integer :: n, num logical :: flds_co2a ! use case logical :: flds_co2b ! use case logical :: flds_co2c ! use case - integer :: ndep_nflds, megan_nflds, emis_nflds character(len=128) :: fldname character(len=*), parameter :: subname='(atm_import_export:advertise_fields)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 10) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -109,25 +126,25 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2a - call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO) + if (masterproc) write(iulog,'(a)') trim(subname)//'flds_co2a = '// trim(cvalue) call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2b - call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO) + if (masterproc) write(iulog,'(a)') trim(subname)//'flds_co2b = '// trim(cvalue) call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2c - call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO) + if (masterproc) write(iulog,'(a)') trim(subname)//'flds_co2c = '// trim(cvalue) !-------------------------------- ! Export fields !-------------------------------- - if (dbug_flag > 10) call ESMF_LogWrite(subname//' export fields', ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrAtm_num, fldsFrAtm, trim(flds_scalar_name)) + if (masterproc) write(iulog,'(a)') trim(subname)//'export_fields ' + call fldlist_add(fldsFrAtm_num, fldsFrAtm, trim(flds_scalar_name)) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_topo' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_z' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_u' ) @@ -138,6 +155,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_pbot' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_dens' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_pslv' ) + call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_o3' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainc' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainl' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_snowc' ) @@ -158,14 +176,14 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ocph', ungridded_lbound=1, ungridded_ubound=3) ! from atm - wet dust deposition frluxes (4 sizes) - ! (1) => dstwet1, (2) => dstwet2, (3) => dstwet3, (4) => dstwet4 + ! (1) => dstwet1, (2) => dstwet2, (3) => dstwet3, (4) => dstwet4 call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) ! from atm - dry dust deposition frluxes (4 sizes) - ! (1) => dstdry1, (2) => dstdry2, (3) => dstdry3, (4) => dstdry4 + ! (1) => dstdry1, (2) => dstdry2, (3) => dstdry3, (4) => dstdry4 call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) - if (dbug_flag > 10) call ESMF_LogWrite(subname//' export fields co2', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//' export fields co2', ESMF_LOGMSG_INFO) ! from atm co2 fields if (flds_co2a .or. flds_co2b .or. flds_co2c) then @@ -173,16 +191,17 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_co2diag' ) end if - ! from atm - nitrogen deposition - call shr_ndep_readnl("drv_flds_in", ndep_nflds) - if (ndep_nflds > 0) then - call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=ndep_nflds) - call set_active_Faxa_nhx(.true.) - call set_active_Faxa_noy(.true.) + ! Nitrogen deposition fluxes + ! Assume that 2 fields are always sent as part of Faxa_ndep + call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=2) + + ! lightning flash freq + if (atm_provides_lightning) then + call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_lightning') end if ! Now advertise above export fields - if (dbug_flag > 10) call ESMF_LogWrite(subname//' advertise export fields ', ESMF_LOGMSG_INFO) + if (masterproc) write(iulog,*) trim(subname)//' advertise export fields' do n = 1,fldsFrAtm_num call NUOPC_Advertise(exportState, standardName=fldsFrAtm(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) @@ -193,10 +212,9 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) ! Import fields !----------------- - if (dbug_flag > 10) call ESMF_LogWrite(subname//' Import Fields', ESMF_LOGMSG_INFO) + if (masterproc) write(iulog,'(a)') trim(subname)//' import fields ' call fldlist_add(fldsToAtm_num, fldsToAtm, trim(flds_scalar_name)) - call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_anidr' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_avsdf' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_anidf' ) @@ -214,7 +232,10 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Si_snowh' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ssq' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_re' ) + call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ustar' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sx_u10' ) + call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_ugustOut') + call fldlist_add(fldsToAtm_num, fldsToAtm, 'So_u10withGust') call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_taux' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_tauy' ) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Faxx_lat' ) @@ -237,21 +258,17 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) end if ! dry deposition velocities from land - ALSO initialize drydep here - call seq_drydep_readnl("drv_flds_in", drydep_nflds) if (drydep_nflds > 0) then call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sl_ddvel', ungridded_lbound=1, ungridded_ubound=drydep_nflds) end if - call seq_drydep_init( ) ! MEGAN VOC emissions fluxes from land - call shr_megan_readnl('drv_flds_in', megan_nflds) if (megan_nflds > 0) then call fldlist_add(fldsToAtm_num, fldsToAtm, 'Fall_voc', ungridded_lbound=1, ungridded_ubound=megan_nflds) call set_active_Fall_flxvoc(.true.) end if ! fire emissions fluxes from land - call shr_fire_emis_readnl('drv_flds_in', emis_nflds) if (emis_nflds > 0) then call fldlist_add(fldsToAtm_num, fldsToAtm, 'Fall_fire', ungridded_lbound=1, ungridded_ubound=emis_nflds) call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sl_fztop') @@ -259,7 +276,6 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) end if ! CARMA volumetric soil water from land - call shr_carma_readnl('drv_flds_in', carma_fields) if (carma_fields /= ' ') then call fldlist_add(fldsToAtm_num, fldsToAtm, 'Sl_soilw') ! optional for carma call set_active_Sl_soilw(.true.) ! check for carma @@ -268,35 +284,62 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) ! ------------------------------------------ ! Now advertise above import fields ! ------------------------------------------ + call ESMF_LogWrite(trim(subname)//' advertise import fields ', ESMF_LOGMSG_INFO) do n = 1,fldsToAtm_num call NUOPC_Advertise(importState, standardName=fldsToAtm(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo - if (dbug_flag > 10) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - end subroutine advertise_fields !=============================================================================== - subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) + subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, single_column, rc) + + use ESMF , only : ESMF_MeshGet, ESMF_StateGet + use ESMF , only : ESMF_FieldRegridGetArea,ESMF_FieldGet + use ppgrid , only : pcols, begchunk, endchunk + use phys_grid , only : get_area_all_p, get_ncols_p ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp type(ESMF_Mesh) , intent(in) :: Emesh character(len=*) , intent(in) :: flds_scalar_name - integer , intent(in) :: flds_scalar_num + integer , intent(in) :: flds_scalar_num + logical , intent(in) :: single_column integer , intent(out) :: rc ! local variables - type(ESMF_State) :: importState - type(ESMF_State) :: exportState + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Field) :: lfield + integer :: numOwnedElements + integer :: c,i,n,ncols + real(r8), allocatable :: mesh_areas(:) + real(r8), allocatable :: model_areas(:) + real(r8), allocatable :: area(:) + real(r8), pointer :: dataptr(:) + real(r8) :: max_mod2med_areacor + real(r8) :: max_med2mod_areacor + real(r8) :: min_mod2med_areacor + real(r8) :: min_med2mod_areacor + real(r8) :: max_mod2med_areacor_glob + real(r8) :: max_med2mod_areacor_glob + real(r8) :: min_mod2med_areacor_glob + real(r8) :: min_med2mod_areacor_glob + character(len=cl) :: cvalue + character(len=cl) :: mesh_atm + character(len=cl) :: mesh_lnd + character(len=cl) :: mesh_ocn + logical :: samegrid_atm_lnd_ocn character(len=*), parameter :: subname='(atm_import_export:realize_fields)' !--------------------------------------------------------------------------- rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -320,6 +363,89 @@ subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) mesh=Emesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine if atm/lnd/ocn are on the same grid - if so set area correction factors to 1 + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=mesh_atm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=mesh_lnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=mesh_ocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + samegrid_atm_lnd_ocn = .false. + if ( trim(mesh_lnd) /= 'UNSET' .and. trim(mesh_atm) == trim(mesh_lnd) .and. & + trim(mesh_ocn) /= 'UNSET' .and. trim(mesh_atm) == trim(mesh_ocn)) then + samegrid_atm_lnd_ocn = .true. + elseif ( trim(mesh_lnd) == 'UNSET' .and. trim(mesh_atm) == trim(mesh_ocn)) then + samegrid_atm_lnd_ocn = .true. + elseif ( trim(mesh_ocn) == 'UNSET' .and. trim(mesh_atm) == trim(mesh_lnd)) then + samegrid_atm_lnd_ocn = .true. + end if + + ! allocate area correction factors + call ESMF_MeshGet(Emesh, numOwnedElements=numOwnedElements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate (mod2med_areacor(numOwnedElements)) + allocate (med2mod_areacor(numOwnedElements)) + + if (single_column .or. samegrid_atm_lnd_ocn) then + + mod2med_areacor(:) = 1._r8 + med2mod_areacor(:) = 1._r8 + + else + + ! Determine areas for regridding + call ESMF_StateGet(exportState, itemName=trim(fldsFrAtm(2)%stdname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridGetArea(lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(mesh_areas(numOwnedElements)) + mesh_areas(:) = dataptr(:) + + ! Determine model areas + allocate(model_areas(numOwnedElements)) + allocate(area(numOwnedElements)) + n = 0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + call get_area_all_p(c, ncols, area) + do i = 1,ncols + n = n + 1 + model_areas(n) = area(i) + end do + end do + deallocate(area) + + ! Determine flux correction factors (module variables) + do n = 1,numOwnedElements + mod2med_areacor(n) = model_areas(n) / mesh_areas(n) + med2mod_areacor(n) = 1._r8 / mod2med_areacor(n) + end do + deallocate(model_areas) + deallocate(mesh_areas) + + end if + + min_mod2med_areacor = minval(mod2med_areacor) + max_mod2med_areacor = maxval(mod2med_areacor) + min_med2mod_areacor = minval(med2mod_areacor) + max_med2mod_areacor = maxval(med2mod_areacor) + call shr_mpi_max(max_mod2med_areacor, max_mod2med_areacor_glob, mpicom) + call shr_mpi_min(min_mod2med_areacor, min_mod2med_areacor_glob, mpicom) + call shr_mpi_max(max_med2mod_areacor, max_med2mod_areacor_glob, mpicom) + call shr_mpi_min(min_med2mod_areacor, min_med2mod_areacor_glob, mpicom) + + if (masterproc) then + write(iulog,'(2A,2g23.15,A )') trim(subname),' : min_mod2med_areacor, max_mod2med_areacor ',& + min_mod2med_areacor_glob, max_mod2med_areacor_glob, 'CAM' + write(iulog,'(2A,2g23.15,A )') trim(subname),' : min_med2mod_areacor, max_med2mod_areacor ',& + min_med2mod_areacor_glob, max_med2mod_areacor_glob, 'CAM' + end if + + call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) + end subroutine realize_fields !=============================================================================== @@ -327,11 +453,10 @@ end subroutine realize_fields subroutine import_fields( gcomp, cam_in, restart_init, rc) ! ----------------------------------------------------- - ! Set field pointers in import state and + ! Set field pointers in import state and ! copy from field pointer to chunk array data structure ! ----------------------------------------------------- - use spmd_utils , only : masterproc use camsrfexch , only : cam_in_t use phys_grid , only : get_ncols_p use ppgrid , only : begchunk, endchunk @@ -385,7 +510,6 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) !--------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 10) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! Get import state call NUOPC_ModelGet(gcomp, importState=importState, rc=rc) @@ -412,10 +536,10 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) g = 1 do c = begchunk,endchunk do i = 1,get_ncols_p(c) - cam_in(c)%wsx(i) = -fldptr_taux(g) - cam_in(c)%wsy(i) = -fldptr_tauy(g) - cam_in(c)%shf(i) = -fldptr_sen(g) - cam_in(c)%cflx(i,1) = -fldptr_evap(g) + cam_in(c)%wsx(i) = -fldptr_taux(g) * med2mod_areacor(g) + cam_in(c)%wsy(i) = -fldptr_tauy(g) * med2mod_areacor(g) + cam_in(c)%shf(i) = -fldptr_sen(g) * med2mod_areacor(g) + cam_in(c)%cflx(i,1) = -fldptr_evap(g) * med2mod_areacor(g) g = g + 1 end do end do @@ -453,11 +577,13 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getfldptr(importState, 'Sl_lfrac', fldptr=fldptr_lfrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Only do area correction on fluxes g = 1 do c = begchunk,endchunk do i = 1,get_ncols_p(c) - cam_in(c)%lhf(i) = -fldptr_lat(g) - cam_in(c)%lwup(i) = -fldptr_lwup(g) + cam_in(c)%lhf(i) = -fldptr_lat(g) * med2mod_areacor(g) + cam_in(c)%lwup(i) = -fldptr_lwup(g) * med2mod_areacor(g) cam_in(c)%asdir(i) = fldptr_avsdr(g) cam_in(c)%aldir(i) = fldptr_anidr(g) cam_in(c)%asdif(i) = fldptr_avsdf(g) @@ -530,7 +656,7 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) if ( associated(cam_in(c)%dstflx) ) then do i = 1,get_ncols_p(c) do n = 1, size(fldptr2d, dim=1) - cam_in(c)%dstflx(i,n) = fldptr2d(n,g) + cam_in(c)%dstflx(i,n) = fldptr2d(n,g) * med2mod_areacor(g) end do g = g + 1 end do @@ -547,7 +673,7 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) if ( associated(cam_in(c)%meganflx) ) then do i = 1,get_ncols_p(c) do n = 1, size(fldptr2d, dim=1) - cam_in(c)%meganflx(i,n) = fldptr2d(n,g) + cam_in(c)%meganflx(i,n) = fldptr2d(n,g) * med2mod_areacor(g) end do g = g + 1 end do @@ -564,7 +690,7 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) if ( associated(cam_in(c)%fireflx) .and. associated(cam_in(c)%fireztop) ) then do i = 1,get_ncols_p(c) do n = 1, size(fldptr2d, dim=1) - cam_in(c)%fireflx(i,n) = fldptr2d(n,g) + cam_in(c)%fireflx(i,n) = fldptr2d(n,g) * med2mod_areacor(g) end do g = g + 1 end do @@ -632,6 +758,30 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) end do end if + call state_getfldptr(importState, 'So_ugustOut', fldptr=fldptr1d, exists=exists, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + g = 1 + do c = begchunk,endchunk + do i = 1,get_ncols_p(c) + cam_in(c)%ugustOut(i) = fldptr1d(g) + g = g + 1 + end do + end do + end if + + call state_getfldptr(importState, 'So_u10withGust', fldptr=fldptr1d, exists=exists, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + g = 1 + do c = begchunk,endchunk + do i = 1,get_ncols_p(c) + cam_in(c)%u10withGusts(i) = fldptr1d(g) + g = g + 1 + end do + end do + end if + ! bgc scenarios call state_getfldptr(importState, 'Fall_fco2_lnd', fldptr=fldptr1d, exists=exists_fco2_lnd, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -639,7 +789,7 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) g = 1 do c = begchunk,endchunk do i = 1,get_ncols_p(c) - cam_in(c)%fco2_lnd(i) = -fldptr1d(g) + cam_in(c)%fco2_lnd(i) = -fldptr1d(g) * med2mod_areacor(g) g = g + 1 end do end do @@ -650,7 +800,7 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) g = 1 do c = begchunk,endchunk do i = 1,get_ncols_p(c) - cam_in(c)%fco2_ocn(i) = -fldptr1d(g) + cam_in(c)%fco2_ocn(i) = -fldptr1d(g) * med2mod_areacor(g) g = g + 1 end do end do @@ -665,7 +815,7 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) g = 1 do c = begchunk,endchunk do i = 1,get_ncols_p(c) - cam_in(c)%fdms(i) = -fldptr1d(g) + cam_in(c)%fdms(i) = -fldptr1d(g) * med2mod_areacor(g) g = g + 1 end do end do @@ -696,7 +846,7 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) do i=1, get_ncols_p(c) ! co2 flux from ocn - if (exists_fco2_ocn /= 0) then + if (exists_fco2_ocn) then cam_in(c)%cflx(i,c_i(1)) = cam_in(c)%fco2_ocn(i) else if (co2_readFlux_ocn) then ! convert from molesCO2/m2/s to kgCO2/m2/s @@ -738,47 +888,11 @@ subroutine import_fields( gcomp, cam_in, restart_init, rc) first_time = .false. end if - !----------------------------------------------------------------- - ! Debug import - !----------------------------------------------------------------- - - if (debug_import > 0 .and. masterproc .and. get_nstep()<5) then - nstep = get_nstep() - g=1 - do c=begchunk, endchunk - do i=1, get_ncols_p(c) - write(iulog,F01)'import: nstep, g, Faxx_tauy = ',nstep,g,-cam_in(c)%wsy(i) - write(iulog,F01)'import: nstep, g, Faxx_taux = ',nstep,g,-cam_in(c)%wsx(i) - write(iulog,F01)'import: nstep, g, Faxx_shf = ',nstep,g,-cam_in(c)%shf(i) - write(iulog,F01)'import: nstep, g, Faxx_lhf = ',nstep,g,-cam_in(c)%lhf(i) - write(iulog,F01)'import: nstep, g, Faxx_evap = ',nstep,g,-cam_in(c)%cflx(i,1) - write(iulog,F01)'import: nstep, g, Faxa_lwup = ',nstep,g,-cam_in(c)%lwup(i) - write(iulog,F01)'import: nstep, g, Sx_asdir = ',nstep,g, cam_in(c)%asdir(i) - write(iulog,F01)'import: nstep, g, Sx_aldir = ',nstep,g, cam_in(c)%aldir(i) - write(iulog,F01)'import: nstep, g, Sx_asdif = ',nstep,g, cam_in(c)%asdif(i) - write(iulog,F01)'import: nstep, g, Sx_aldif = ',nstep,g, cam_in(c)%aldif(i) - write(iulog,F01)'import: nstep, g, Sx_t = ',nstep,g, cam_in(c)%ts(i) - write(iulog,F01)'import: nstep, g, So_t = ',nstep,g, cam_in(c)%sst(i) - write(iulog,F01)'import: nstep, g, Sl_snowh = ',nstep,g, cam_in(c)%snowhland(i) - write(iulog,F01)'import: nstep, g, Si_snowh = ',nstep,g, cam_in(c)%snowhice(i) - write(iulog,F01)'import: nstep, g, Si_ifrac = ',nstep,g, cam_in(c)%icefrac(i) - write(iulog,F01)'import: nstep, g, So_ofrac = ',nstep,g, cam_in(c)%ocnfrac(i) - write(iulog,F01)'import: nstep, g, Sl_lfrac = ',nstep,g, cam_in(c)%landfrac(i) - write(iulog,F01)'import: nstep, g, Sx_tref = ',nstep,g, cam_in(c)%tref(i) - write(iulog,F01)'import: nstep, g, Sx_qref = ',nstep,g, cam_in(c)%qref(i) - write(iulog,F01)'import: nstep, g, Sx_qu10 = ',nstep,g, cam_in(c)%u10(i) - g = g + 1 - end do - end do - end if - - if (dbug_flag > 10) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - end subroutine import_fields !=============================================================================== - subroutine export_fields( gcomp, cam_out, rc) + subroutine export_fields( gcomp, model_mesh, model_clock, cam_out, rc) ! ----------------------------------------------------- ! Set field pointers in export set @@ -796,12 +910,15 @@ subroutine export_fields( gcomp, cam_out, rc) !------------------------------- ! input/output variables - type(ESMF_GridComp) :: gcomp - type(cam_out_t) , intent(in) :: cam_out(begchunk:endchunk) - integer , intent(out) :: rc + type(ESMF_GridComp) :: gcomp + type(ESMF_Mesh) , intent(in) :: model_mesh + type(ESMF_Clock), intent(in) :: model_clock + type(cam_out_t) , intent(inout) :: cam_out(begchunk:endchunk) + integer , intent(out) :: rc ! local variables type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock integer :: i,m,c,n,g ! indices integer :: ncols ! Number of columns integer :: nstep @@ -809,7 +926,7 @@ subroutine export_fields( gcomp, cam_out, rc) ! 2d pointers real(r8), pointer :: fldptr_ndep(:,:) real(r8), pointer :: fldptr_bcph(:,:) , fldptr_ocph(:,:) - real(r8), pointer :: fldptr_dstwet(:,:), fldptr_dstdry(:,:) + real(r8), pointer :: fldptr_dstwet(:,:), fldptr_dstdry(:,:) ! 1d pointers real(r8), pointer :: fldptr_soll(:) , fldptr_sols(:) real(r8), pointer :: fldptr_solld(:) , fldptr_solsd(:) @@ -819,9 +936,11 @@ subroutine export_fields( gcomp, cam_out, rc) real(r8), pointer :: fldptr_topo(:) , fldptr_zbot(:) real(r8), pointer :: fldptr_ubot(:) , fldptr_vbot(:) real(r8), pointer :: fldptr_pbot(:) , fldptr_tbot(:) - real(r8), pointer :: fldptr_shum(:) , fldptr_dens(:) - real(r8), pointer :: fldptr_ptem(:) , fldptr_pslv(:) + real(r8), pointer :: fldptr_shum(:) , fldptr_dens(:) + real(r8), pointer :: fldptr_ptem(:) , fldptr_pslv(:) real(r8), pointer :: fldptr_co2prog(:) , fldptr_co2diag(:) + real(r8), pointer :: fldptr_ozone(:) + real(r8), pointer :: fldptr_lght(:) character(len=*), parameter :: subname='(atm_import_export:export_fields)' !--------------------------------------------------------------------------- @@ -870,7 +989,7 @@ subroutine export_fields( gcomp, cam_out, rc) end do ! required export flux variables - call state_getfldptr(exportState, 'Faxa_swnet', fldptr=fldptr_swnet, rc=rc) + call state_getfldptr(exportState, 'Faxa_swnet', fldptr=fldptr_swnet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getfldptr(exportState, 'Faxa_lwdn' , fldptr=fldptr_lwdn , rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -893,16 +1012,16 @@ subroutine export_fields( gcomp, cam_out, rc) g = 1 do c = begchunk,endchunk do i = 1,get_ncols_p(c) - fldptr_lwdn(g) = cam_out(c)%flwds(i) - fldptr_swnet(g) = cam_out(c)%netsw(i) - fldptr_snowc(g) = cam_out(c)%precsc(i)*1000._r8 - fldptr_snowl(g) = cam_out(c)%precsl(i)*1000._r8 - fldptr_rainc(g) = (cam_out(c)%precc(i)-cam_out(c)%precsc(i))*1000._r8 - fldptr_rainl(g) = (cam_out(c)%precl(i)-cam_out(c)%precsl(i))*1000._r8 - fldptr_soll(g) = cam_out(c)%soll(i) - fldptr_sols(g) = cam_out(c)%sols(i) - fldptr_solld(g) = cam_out(c)%solld(i) - fldptr_solsd(g) = cam_out(c)%solsd(i) + fldptr_lwdn(g) = cam_out(c)%flwds(i) * mod2med_areacor(g) + fldptr_swnet(g) = cam_out(c)%netsw(i) * mod2med_areacor(g) + fldptr_snowc(g) = cam_out(c)%precsc(i)*1000._r8 * mod2med_areacor(g) + fldptr_snowl(g) = cam_out(c)%precsl(i)*1000._r8 * mod2med_areacor(g) + fldptr_rainc(g) = (cam_out(c)%precc(i) - cam_out(c)%precsc(i))*1000._r8 * mod2med_areacor(g) + fldptr_rainl(g) = (cam_out(c)%precl(i) - cam_out(c)%precsl(i))*1000._r8 * mod2med_areacor(g) + fldptr_soll(g) = cam_out(c)%soll(i) * mod2med_areacor(g) + fldptr_sols(g) = cam_out(c)%sols(i) * mod2med_areacor(g) + fldptr_solld(g) = cam_out(c)%solld(i) * mod2med_areacor(g) + fldptr_solsd(g) = cam_out(c)%solsd(i) * mod2med_areacor(g) g = g + 1 end do end do @@ -921,111 +1040,112 @@ subroutine export_fields( gcomp, cam_out, rc) g = 1 do c = begchunk,endchunk do i = 1,get_ncols_p(c) - fldptr_bcph(1,g) = cam_out(c)%bcphidry(i) - fldptr_bcph(2,g) = cam_out(c)%bcphodry(i) - fldptr_bcph(3,g) = cam_out(c)%bcphiwet(i) - fldptr_ocph(1,g) = cam_out(c)%ocphidry(i) - fldptr_ocph(2,g) = cam_out(c)%ocphodry(i) - fldptr_ocph(3,g) = cam_out(c)%ocphiwet(i) - fldptr_dstdry(1,g) = cam_out(c)%dstdry1(i) - fldptr_dstdry(2,g) = cam_out(c)%dstdry2(i) - fldptr_dstdry(3,g) = cam_out(c)%dstdry3(i) - fldptr_dstdry(4,g) = cam_out(c)%dstdry4(i) - fldptr_dstwet(1,g) = cam_out(c)%dstwet1(i) - fldptr_dstwet(2,g) = cam_out(c)%dstwet2(i) - fldptr_dstwet(3,g) = cam_out(c)%dstwet3(i) - fldptr_dstwet(4,g) = cam_out(c)%dstwet4(i) + fldptr_bcph(1,g) = cam_out(c)%bcphidry(i) * mod2med_areacor(g) + fldptr_bcph(2,g) = cam_out(c)%bcphodry(i) * mod2med_areacor(g) + fldptr_bcph(3,g) = cam_out(c)%bcphiwet(i) * mod2med_areacor(g) + fldptr_ocph(1,g) = cam_out(c)%ocphidry(i) * mod2med_areacor(g) + fldptr_ocph(2,g) = cam_out(c)%ocphodry(i) * mod2med_areacor(g) + fldptr_ocph(3,g) = cam_out(c)%ocphiwet(i) * mod2med_areacor(g) + fldptr_dstdry(1,g) = cam_out(c)%dstdry1(i) * mod2med_areacor(g) + fldptr_dstdry(2,g) = cam_out(c)%dstdry2(i) * mod2med_areacor(g) + fldptr_dstdry(3,g) = cam_out(c)%dstdry3(i) * mod2med_areacor(g) + fldptr_dstdry(4,g) = cam_out(c)%dstdry4(i) * mod2med_areacor(g) + fldptr_dstwet(1,g) = cam_out(c)%dstwet1(i) * mod2med_areacor(g) + fldptr_dstwet(2,g) = cam_out(c)%dstwet2(i) * mod2med_areacor(g) + fldptr_dstwet(3,g) = cam_out(c)%dstwet3(i) * mod2med_areacor(g) + fldptr_dstwet(4,g) = cam_out(c)%dstwet4(i) * mod2med_areacor(g) g = g + 1 end do end do - call state_getfldptr(exportState, 'Sa_co2prog', fldptr=fldptr_co2prog, exists=exists, rc=rc) + call state_getfldptr(exportState, 'Sa_o3', fldptr=fldptr_ozone, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then g = 1 do c = begchunk,endchunk do i = 1,get_ncols_p(c) - fldptr_co2prog(g) = cam_out(c)%co2prog(i) ! atm prognostic co2 + fldptr_ozone(g) = cam_out(c)%ozone(i) ! atm ozone g = g + 1 end do end do end if - call state_getfldptr(exportState, 'Sa_co2diag', fldptr=fldptr_co2diag, exists=exists, rc=rc) + call state_getfldptr(exportState, 'Sa_lightning', fldptr=fldptr_lght, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then g = 1 do c = begchunk,endchunk do i = 1,get_ncols_p(c) - fldptr_co2diag(g) = cam_out(c)%co2diag(i) ! atm diagnostic co2 + fldptr_lght(g) = cam_out(c)%lightning_flash_freq(i) ! cloud-to-ground lightning flash frequency (/min) g = g + 1 end do end do end if - call state_getfldptr(exportState, 'Faxa_ndep', fldptr2d=fldptr_ndep, exists=exists, rc=rc) + call state_getfldptr(exportState, 'Sa_co2prog', fldptr=fldptr_co2prog, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then - ! (1) => nhx, (2) => noy g = 1 do c = begchunk,endchunk do i = 1,get_ncols_p(c) - fldptr_ndep(1,g) = cam_out(c)%nhx_nitrogen_flx(i) - fldptr_ndep(2,g) = cam_out(c)%noy_nitrogen_flx(i) + fldptr_co2prog(g) = cam_out(c)%co2prog(i) ! atm prognostic co2 g = g + 1 end do end do end if - !----------------------------------------------------------------- - ! Debug export - !----------------------------------------------------------------- - - if (debug_export > 0 .and. masterproc .and. get_nstep()<5) then - nstep = get_nstep() - g=1 - do c=begchunk, endchunk - do i=1, get_ncols_p(c) - write(iulog,F01)'export: nstep, g, Sa_z = ',nstep,g,cam_out(c)%zbot(i) - write(iulog,F01)'export: nstep, g, Sa_topo = ',nstep,g,cam_out(c)%topo(i) - write(iulog,F01)'export: nstep, g, Sa_u = ',nstep,g,cam_out(c)%ubot(i) - write(iulog,F01)'export: nstep, g, Sa_v = ',nstep,g,cam_out(c)%vbot(i) - write(iulog,F01)'export: nstep, g, Sa_tbot = ',nstep,g,cam_out(c)%tbot(i) - write(iulog,F01)'export: nstep, g, Sa_ptem = ',nstep,g,cam_out(c)%thbot(i) - write(iulog,F01)'export: nstep, g, Sa_pbot = ',nstep,g,cam_out(c)%pbot(i) - write(iulog,F01)'export: nstep, g, Sa_shum = ',nstep,g,cam_out(c)%qbot(i,1) - write(iulog,F01)'export: nstep, g, Sa_dens = ',nstep,g,cam_out(c)%rho(i) - write(iulog,F01)'export: nstep, g, Faxa_swnet = ',nstep,g,cam_out(c)%netsw(i) - write(iulog,F01)'export: nstep, g, Faxa_lwdn = ',nstep,g,cam_out(c)%flwds(i) - write(iulog,F01)'export: nstep, g, Faxa_rainc = ',nstep,g,(cam_out(c)%precc(i)-cam_out(c)%precsc(i))*1000._r8 - write(iulog,F01)'export: nstep, g, Faxa_rainl = ',nstep,g,(cam_out(c)%precl(i)-cam_out(c)%precsl(i))*1000._r8 - write(iulog,F01)'export: nstep, g, Faxa_snowc = ',nstep,g,cam_out(c)%precsc(i)*1000._r8 - write(iulog,F01)'export: nstep, g, Faxa_snowl = ',nstep,g,cam_out(c)%precsl(i)*1000._r8 - write(iulog,F01)'export: nstep, g, Faxa_swndr = ',nstep,g,cam_out(c)%soll(i) - write(iulog,F01)'export: nstep, g, Faxa_swvdr = ',nstep,g,cam_out(c)%sols(i) - write(iulog,F01)'export: nstep, g, Faxa_swndf = ',nstep,g,cam_out(c)%solld(i) - write(iulog,F01)'export: nstep, g, Faxa_swvdf = ',nstep,g,cam_out(c)%solsd(i) - write(iulog,F01)'export: nstep, g, Faxa_bcphidry = ',nstep,g,cam_out(c)%bcphidry(i) - write(iulog,F01)'export: nstep, g, Faxa_bcphodry = ',nstep,g,cam_out(c)%bcphodry(i) - write(iulog,F01)'export: nstep, g, Faxa_bcphiwet = ',nstep,g,cam_out(c)%bcphiwet(i) - write(iulog,F01)'export: nstep, g, Faxa_ocphidry = ',nstep,g,cam_out(c)%ocphidry(i) - write(iulog,F01)'export: nstep, g, Faxa_ocphodry = ',nstep,g,cam_out(c)%ocphodry(i) - write(iulog,F01)'export: nstep, g, Faxa_ocphidry = ',nstep,g,cam_out(c)%ocphiwet(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet1 = ',nstep,g,cam_out(c)%dstwet1(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet1 = ',nstep,g,cam_out(c)%dstdry1(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet2 = ',nstep,g,cam_out(c)%dstwet2(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet2 = ',nstep,g,cam_out(c)%dstdry2(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet3 = ',nstep,g,cam_out(c)%dstwet3(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet3 = ',nstep,g,cam_out(c)%dstdry3(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet4 = ',nstep,g,cam_out(c)%dstwet4(i) - write(iulog,F01)'export: nstep, g, Faxa_dstwet4 = ',nstep,g,cam_out(c)%dstdry4(i) - write(iulog,F01)'export: nstep, g, Sa_co2prog = ',nstep,g,cam_out(c)%co2prog(i) - write(iulog,F01)'export: nstep, g, Sa_co2diag = ',nstep,g,cam_out(c)%co2diag(i) + call state_getfldptr(exportState, 'Sa_co2diag', fldptr=fldptr_co2diag, exists=exists, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + g = 1 + do c = begchunk,endchunk + do i = 1,get_ncols_p(c) + fldptr_co2diag(g) = cam_out(c)%co2diag(i) ! atm diagnostic co2 g = g + 1 end do end do end if + call state_getfldptr(exportState, 'Faxa_ndep', fldptr2d=fldptr_ndep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + fldptr_ndep(:,:) = 0._r8 + + if (.not. (simple_phys .or. aqua_planet)) then + + ! 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 + + if (ndep_stream_active.or.chem_has_ndep_flx) then + + ! Nitrogen dep fluxes are obtained from the ndep input stream if input data is available + ! otherwise computed by chemistry + if (ndep_stream_active) then + + ! get ndep fluxes from the stream + call stream_ndep_interp(cam_out, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end if + + g = 1 + do c = begchunk,endchunk + do i = 1,get_ncols_p(c) + fldptr_ndep(1,g) = cam_out(c)%nhx_nitrogen_flx(i) * mod2med_areacor(g) + fldptr_ndep(2,g) = cam_out(c)%noy_nitrogen_flx(i) * mod2med_areacor(g) + g = g + 1 + end do + end do + + end if + + end if + end subroutine export_fields !=============================================================================== @@ -1070,8 +1190,9 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala use ESMF , only : ESMF_LogFoundError, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGERR_PASSTHRU + ! input/output variables type(ESMF_State) , intent(inout) :: state - type(fldlist_type) , intent(in) :: fldList(:) + type(fldlist_type) , intent(in) :: fldList(:) integer , intent(in) :: numflds character(len=*) , intent(in) :: flds_scalar_name integer , intent(in) :: flds_scalar_num @@ -1083,6 +1204,7 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala integer :: n type(ESMF_Field) :: field character(len=80) :: stdname + character(CL) :: msg character(len=*),parameter :: subname='(atm_import_export:fldlist_realize)' ! ---------------------------------------------- @@ -1092,14 +1214,13 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala stdname = fldList(n)%stdname if (NUOPC_IsConnected(state, fieldName=stdname)) then if (stdname == trim(flds_scalar_name)) then - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected on root pe", & - ESMF_LOGMSG_INFO) + if (masterproc) then + write(iulog,'(a)') trim(subname)//trim(tag)//" field = "//trim(stdname)//" is connected on root pe" + end if ! Create the scalar field call SetScalarField(field, flds_scalar_name, flds_scalar_num, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & - ESMF_LOGMSG_INFO) ! Create the field if (fldlist(n)%ungridded_lbound > 0 .and. fldlist(n)%ungridded_ubound > 0) then field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, & @@ -1107,9 +1228,17 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala ungriddedUbound=(/fldlist(n)%ungridded_ubound/), & gridToFieldMap=(/2/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc) then + write(iulog,'(a,i8,a,i8)') trim(subname)// trim(tag)//" Field = "//trim(stdname)// & + " is connected using mesh with lbound ", fldlist(n)%ungridded_lbound,& + " and with ubound ",fldlist(n)%ungridded_ubound + end if else field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (masterproc) then + write(iulog,'(a)') trim(subname)// trim(tag)//" Field = "//trim(stdname)// " is connected using mesh " + end if end if endif @@ -1118,8 +1247,9 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return else if (stdname /= trim(flds_scalar_name)) then - call ESMF_LogWrite(subname // trim(tag) // " Field = "// trim(stdname) // " is not connected.", & - ESMF_LOGMSG_INFO) + if (masterproc) then + write(iulog,'(a)')trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is not connected" + end if call ESMF_StateRemove(state, (/stdname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return end if @@ -1167,7 +1297,6 @@ end subroutine SetScalarField end subroutine fldlist_realize !=============================================================================== - subroutine state_getfldptr(State, fldname, fldptr, fldptr2d, exists, rc) ! ---------------------------------------------- @@ -1192,56 +1321,27 @@ subroutine state_getfldptr(State, fldname, fldptr, fldptr2d, exists, rc) type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh integer :: nnodes, nelements + logical :: lexists character(len=*), parameter :: subname='(atm_import_export:state_getfldptr)' ! ---------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif + lexists = .true. ! Determine if field with name fldname exists in state - call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (present(exists)) then - ! if field exists then create output array - else do nothing - if (itemflag == ESMF_STATEITEM_NOTFOUND) then - exists = .false. - RETURN - else - exists = .true. - end if - else + call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (itemflag == ESMF_STATEITEM_NOTFOUND) then - call shr_sys_abort('variable '//trim(fldname)//' must be present ') + lexists = .false. end if + exists = lexists end if - - call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldGet(lfield, status=status, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (status /= ESMF_FIELDSTATUS_COMPLETE) then - call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - else - call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (lexists) then + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (nnodes == 0 .and. nelements == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (present(fldptr)) then call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1249,11 +1349,7 @@ subroutine state_getfldptr(State, fldname, fldptr, fldptr2d, exists, rc) call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - endif ! status - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif + end if end subroutine state_getfldptr diff --git a/src/cpl/nuopc/atm_shr_methods.F90 b/src/cpl/nuopc/atm_shr_methods.F90 deleted file mode 100644 index 190edb93e7..0000000000 --- a/src/cpl/nuopc/atm_shr_methods.F90 +++ /dev/null @@ -1,838 +0,0 @@ -module atm_shr_methods - - use ESMF , only : operator(<), operator(/=), operator(+) - use ESMF , only : operator(-), operator(*) , operator(>=) - use ESMF , only : operator(<=), operator(>), operator(==) - use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_LogFoundError, ESMF_LOGMSG_ERROR, ESMF_MAXSTR - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE - use ESMF , only : ESMF_State, ESMF_StateGet - use ESMF , only : ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet - use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldStatus_Flag - use ESMF , only : ESMF_Mesh, ESMF_MeshGet - use ESMF , only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_COMPLETE - use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet - use ESMF , only : ESMF_ClockPrint, ESMF_ClockAdvance - use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet, ESMF_AlarmSet - use ESMF , only : ESMF_Calendar, ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN - use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast, ESMF_VMGetCurrent - use NUOPC , only : NUOPC_CompAttributeGet - use NUOPC_Model , only : NUOPC_ModelGet - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_sys_mod , only : shr_sys_abort - use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit - - implicit none - private - - public :: memcheck - public :: get_component_instance - public :: set_component_logging - public :: log_clock_advance - public :: state_getscalar - public :: state_setscalar - public :: state_diagnose - public :: alarmInit - public :: chkerr - - private :: timeInit - private :: field_getfldptr - - ! Clock and alarm options - character(len=*), private, parameter :: & - optNONE = "none" , & - optNever = "never" , & - optNSteps = "nsteps" , & - optNStep = "nstep" , & - optNSeconds = "nseconds" , & - optNSecond = "nsecond" , & - optNMinutes = "nminutes" , & - optNMinute = "nminute" , & - optNHours = "nhours" , & - optNHour = "nhour" , & - optNDays = "ndays" , & - optNDay = "nday" , & - optNMonths = "nmonths" , & - optNMonth = "nmonth" , & - optNYears = "nyears" , & - optNYear = "nyear" , & - optMonthly = "monthly" , & - optYearly = "yearly" , & - optDate = "date" , & - optIfdays0 = "ifdays0" - - ! Module data - integer, parameter :: SecPerDay = 86400 ! Seconds per day - integer, parameter :: memdebug_level=1 - character(len=1024) :: msgString - character(len=*), parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine memcheck(string, level, mastertask) - - ! input/output variables - character(len=*) , intent(in) :: string - integer , intent(in) :: level - logical , intent(in) :: mastertask - - ! local variables - integer :: ierr - integer, external :: GPTLprint_memusage - !----------------------------------------------------------------------- - - if ((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then - ierr = GPTLprint_memusage(string) - endif - - end subroutine memcheck - -!=============================================================================== - - subroutine get_component_instance(gcomp, inst_suffix, inst_index, rc) - - ! input/output variables - type(ESMF_GridComp) :: gcomp - character(len=*) , intent(out) :: inst_suffix - integer , intent(out) :: inst_index - integer , intent(out) :: rc - - ! local variables - logical :: isPresent - character(len=4) :: cvalue - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - cvalue = inst_suffix(2:) - read(cvalue, *) inst_index - else - inst_suffix = "" - inst_index=1 - endif - - end subroutine get_component_instance - -!=============================================================================== - - subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - - ! input/output variables - type(ESMF_GridComp) :: gcomp - logical, intent(in) :: mastertask - integer, intent(out) :: logunit - integer, intent(out) :: shrlogunit - integer, intent(out) :: rc - - ! local variables - character(len=CL) :: diro - character(len=CL) :: logfile - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - shrlogunit = 6 - - if (mastertask) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - else - logUnit = 6 - endif - - call shr_file_setLogUnit (logunit) - - end subroutine set_component_logging - -!=============================================================================== - - subroutine log_clock_advance(clock, component, logunit, rc) - - ! input/output variables - type(ESMF_Clock) :: clock - character(len=*) , intent(in) :: component - integer , intent(in) :: logunit - integer , intent(out) :: rc - - ! local variables - character(len=CL) :: cvalue, prestring - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - write(prestring, *) "------>Advancing ",trim(component)," from: " - call ESMF_ClockPrint(clock, options="currTime", unit=cvalue, preString=trim(prestring), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(logunit, *) trim(cvalue) - - call ESMF_ClockPrint(clock, options="stopTime", unit=cvalue, & - preString="--------------------------------> to: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(logunit, *) trim(cvalue) - - end subroutine log_clock_advance - -!=============================================================================== - - subroutine state_getscalar(state, scalar_id, scalar_value, flds_scalar_name, flds_scalar_num, rc) - - ! ---------------------------------------------- - ! Get scalar data from State for a particular name and broadcast it to all other pets - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State), intent(in) :: state - integer, intent(in) :: scalar_id - real(r8), intent(out) :: scalar_value - character(len=*), intent(in) :: flds_scalar_name - integer, intent(in) :: flds_scalar_num - integer, intent(inout) :: rc - - ! local variables - integer :: mytask, ierr, len - type(ESMF_VM) :: vm - type(ESMF_Field) :: field - real(r8), pointer :: farrayptr(:,:) - real(r8) :: tmp(1) - character(len=*), parameter :: subname='(state_getscalar)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_VMGetCurrent(vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=mytask, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (mytask == 0) then - call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - endif - tmp(:) = farrayptr(scalar_id,:) - endif - call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - scalar_value = tmp(1) - - end subroutine state_getscalar - -!================================================================================ - - subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) - - ! ---------------------------------------------- - ! Set scalar data from State for a particular name - ! ---------------------------------------------- - - ! input/output arguments - real(r8), intent(in) :: scalar_value - integer, intent(in) :: scalar_id - type(ESMF_State), intent(inout) :: State - character(len=*), intent(in) :: flds_scalar_name - integer, intent(in) :: flds_scalar_num - integer, intent(inout) :: rc - - ! local variables - integer :: mytask - type(ESMF_Field) :: lfield - type(ESMF_VM) :: vm - real(r8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname='(state_setscalar)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_VMGetCurrent(vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=mytask, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (mytask == 0) then - call ESMF_FieldGet(lfield, farrayPtr = farrayptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - endif - farrayptr(scalar_id,1) = scalar_value - endif - - end subroutine state_setscalar - -!=============================================================================== - - subroutine state_diagnose(State, string, rc) - - ! ---------------------------------------------- - ! Diagnose status of State - ! ---------------------------------------------- - - type(ESMF_State), intent(in) :: state - character(len=*), intent(in) :: string - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - type(ESMf_Field) :: lfield - integer :: fieldCount, lrank - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - real(r8), pointer :: dataPtr1d(:) - real(r8), pointer :: dataPtr2d(:,:) - character(len=*),parameter :: subname='(state_diagnose)' - ! ---------------------------------------------- - - call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldnamelist(fieldCount)) - - call ESMF_StateGet(state, itemNameList=lfieldnamelist, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - do n = 1, fieldCount - - call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (lrank == 0) then - ! no local data - elseif (lrank == 1) then - if (size(dataPtr1d) > 0) then - write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & - minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) - else - write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" - endif - elseif (lrank == 2) then - if (size(dataPtr2d) > 0) then - write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & - minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) - else - write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" - endif - else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - endif - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - enddo - - deallocate(lfieldnamelist) - - end subroutine state_diagnose - -!=============================================================================== - - subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) - - ! ---------------------------------------------- - ! for a field, determine rank and return fldptr1 or fldptr2 - ! abort is true by default and will abort if fldptr is not yet allocated in field - ! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_Field) , intent(in) :: field - real(r8), pointer , intent(inout), optional :: fldptr1(:) - real(r8), pointer , intent(inout), optional :: fldptr2(:,:) - integer , intent(out) , optional :: rank - logical , intent(in) , optional :: abort - integer , intent(out) , optional :: rc - - ! local variables - type(ESMF_GeomType_Flag) :: geomtype - type(ESMF_FieldStatus_Flag) :: status - type(ESMF_Mesh) :: lmesh - integer :: lrank, nnodes, nelements - logical :: labort - character(len=*), parameter :: subname='(field_getfldptr)' - ! ---------------------------------------------- - - if (.not.present(rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - - rc = ESMF_SUCCESS - - labort = .true. - if (present(abort)) then - labort = abort - endif - lrank = -99 - - call ESMF_FieldGet(field, status=status, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (status /= ESMF_FIELDSTATUS_COMPLETE) then - lrank = 0 - if (labort) then - call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - else - call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - endif - else - - call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (geomtype == ESMF_GEOMTYPE_GRID) then - call ESMF_FieldGet(field, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - elseif (geomtype == ESMF_GEOMTYPE_MESH) then - call ESMF_FieldGet(field, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, mesh=lmesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (nnodes == 0 .and. nelements == 0) lrank = 0 - else - call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & - ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - endif ! geomtype - - if (lrank == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & - ESMF_LOGMSG_INFO) - elseif (lrank == 1) then - if (.not.present(fldptr1)) then - call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - elseif (lrank == 2) then - if (.not.present(fldptr2)) then - call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - - endif ! status - - if (present(rank)) then - rank = lrank - endif - - end subroutine field_getfldptr - -!=============================================================================== - - subroutine alarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) - - ! Setup an alarm in a clock - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm - ! time. If you send an arbitrary but proper ringtime from the - ! past and the ring interval, the alarm will always go off on the - ! next clock advance and this will cause serious problems. Even - ! if it makes sense to initialize an alarm with some reference - ! time and the alarm interval, that reference time has to be - ! advance forward to be >= the current time. In the logic below - ! we set an appropriate "NextAlarm" and then we make sure to - ! advance it properly based on the ring interval. - - ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - integer , intent(inout) :: rc ! Return code - - ! local variables - type(ESMF_Calendar) :: cal ! calendar - integer :: lymd ! local ymd - integer :: ltod ! local tod - integer :: cyy,cmm,cdd,csec ! time info - character(len=64) :: lalarmname ! local alarm name - logical :: update_nextalarm ! update next alarm - type(ESMF_Time) :: CurrTime ! Current Time - type(ESMF_Time) :: NextAlarm ! Next restart alarm time - type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - integer :: sec - character(len=*), parameter :: subname = '(set_alarmInit): ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - lalarmname = 'alarm_unknown' - if (present(alarmname)) lalarmname = trim(alarmname) - ltod = 0 - if (present(opt_tod)) ltod = opt_tod - lymd = -1 - if (present(opt_ymd)) lymd = opt_ymd - - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! initial guess of next alarm, this will be updated below - if (present(RefTime)) then - NextAlarm = RefTime - else - NextAlarm = CurrTime - endif - - ! Determine calendar - call ESMF_ClockGet(clock, calendar=cal) - - ! Determine inputs for call to create alarm - selectcase (trim(option)) - - case (optNONE) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optDate) - if (.not. present(opt_ymd)) then - call shr_sys_abort(subname//trim(option)//' requires opt_ymd') - end if - if (lymd < 0 .or. ltod < 0) then - call shr_sys_abort(subname//trim(option)//'opt_ymd, opt_tod invalid') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call timeInit(NextAlarm, lymd, cal, ltod, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optIfdays0) - if (.not. present(opt_ymd)) then - call shr_sys_abort(subname//trim(option)//' requires opt_ymd') - end if - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case (optNSteps) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNStep) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSeconds) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSecond) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinutes) - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinute) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHours) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHour) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDays) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDay) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonths) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonth) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optMonthly) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case (optNYears) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNYear) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optYearly) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case default - call shr_sys_abort(subname//'unknown option '//trim(option)) - - end select - - ! -------------------------------------------------------------------------------- - ! --- AlarmInterval and NextAlarm should be set --- - ! -------------------------------------------------------------------------------- - - ! --- advance Next Alarm so it won't ring on first timestep for - ! --- most options above. go back one alarminterval just to be careful - - if (update_nextalarm) then - NextAlarm = NextAlarm - AlarmInterval - do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval - enddo - endif - - alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & - ringInterval=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine alarmInit - -!=============================================================================== - - subroutine timeInit( Time, ymd, cal, tod, rc) - - ! Create the ESMF_Time object corresponding to the given input time, - ! given in YMD (Year Month Day) and TOD (Time-of-day) format. - ! Set the time by an integer as YYYYMMDD and integer seconds in the day - - ! input/output parameters: - type(ESMF_Time) , intent(inout) :: Time ! ESMF time - integer , intent(in) :: ymd ! year, month, day YYYYMMDD - type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar - integer , intent(in) :: tod ! time of day in seconds - integer , intent(out) :: rc - - ! local variables - integer :: year, mon, day ! year, month, day as integers - integer :: tdate ! temporary date - integer :: date ! coded-date (yyyymmdd) - character(len=*), parameter :: subname='(timeInit)' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if ( (ymd < 0) .or. (tod < 0) .or. (tod > SecPerDay) )then - call shr_sys_abort( subname//'ERROR yymmdd is a negative number or time-of-day out of bounds' ) - end if - - tdate = abs(date) - year = int(tdate/10000) - if (date < 0) year = -year - mon = int( mod(tdate,10000)/ 100) - day = mod(tdate, 100) - - call ESMF_TimeSet( Time, yy=year, mm=mon, dd=day, s=tod, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine timeInit - -!=============================================================================== - - logical function chkerr(rc, line, file) - - integer, intent(in) :: rc - integer, intent(in) :: line - character(len=*), intent(in) :: file - - integer :: lrc - - chkerr = .false. - lrc = rc - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then - chkerr = .true. - endif - end function chkerr - -end module atm_shr_methods diff --git a/src/cpl/nuopc/atm_stream_ndep.F90 b/src/cpl/nuopc/atm_stream_ndep.F90 new file mode 100644 index 0000000000..f54509b269 --- /dev/null +++ b/src/cpl/nuopc/atm_stream_ndep.F90 @@ -0,0 +1,285 @@ +module atm_stream_ndep + + !----------------------------------------------------------------------- + ! Contains methods for reading in nitrogen deposition data file + ! Also includes functions for dynamic ndep file handling and + ! interpolation. + !----------------------------------------------------------------------- + ! + use ESMF , only : ESMF_Clock, ESMF_Mesh + use ESMF , only : ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT + use ESMF , only : ESMF_Finalize, ESMF_LogFoundError + use nuopc_shr_methods , only : chkerr + use dshr_strdata_mod , only : shr_strdata_type + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_cl, CS => shr_kind_cs + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmd_utils , only : mpicom, masterproc, iam + use spmd_utils , only : mpi_character, mpi_integer + use cam_logfile , only : iulog + use cam_abortutils , only : endrun + + implicit none + private + + public :: stream_ndep_readnl ! read runtime options + public :: stream_ndep_init ! position datasets for dynamic ndep + public :: stream_ndep_interp ! interpolates between two years of ndep file data + + 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 'UNSET' or empty string. + logical, public, protected :: ndep_stream_active = .false. + + type(shr_strdata_type) :: sdat_ndep ! input data stream + logical, public :: stream_ndep_is_initialized = .false. + character(len=CS) :: stream_varlist_ndep(2) + type(ESMF_Clock) :: model_clock + + character(len=*), parameter :: sourcefile = __FILE__ + + character(len=CL) :: stream_ndep_data_filename + character(len=CL) :: stream_ndep_mesh_filename + integer :: stream_ndep_year_first ! first year in stream to use + integer :: stream_ndep_year_last ! last year in stream to use + integer :: stream_ndep_year_align ! align stream_year_firstndep with + +!============================================================================== +contains +!============================================================================== + + subroutine stream_ndep_readnl(nlfile) + + ! Uses: + use shr_nl_mod, only: shr_nl_find_group_name + + ! input/output variables + character(len=*), intent(in) :: nlfile + + ! local variables + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + integer :: ierr + character(*), parameter :: subName = "('stream_ndep_readnl')" + !----------------------------------------------------------------------- + + namelist /ndep_stream_nl/ & + stream_ndep_data_filename, & + stream_ndep_mesh_filename, & + stream_ndep_year_first, & + stream_ndep_year_last, & + stream_ndep_year_align + + ! Default values for namelist + stream_ndep_data_filename = ' ' + stream_ndep_mesh_filename = ' ' + stream_ndep_year_first = 1 ! first year in stream to use + stream_ndep_year_last = 1 ! last year in stream to use + stream_ndep_year_align = 1 ! align stream_ndep_year_first with this model year + + ! For now variable list in stream data file is hard-wired + stream_varlist_ndep = (/'NDEP_NHx_month', 'NDEP_NOy_month'/) + + ! Read ndep_stream namelist + if (masterproc) then + open( newunit=nu_nml, file=trim(nlfile), status='old', iostat=nml_error ) + if (nml_error /= 0) then + call endrun(subName//': ERROR opening '//trim(nlfile)//errMsg(sourcefile, __LINE__)) + end if + call shr_nl_find_group_name(nu_nml, 'ndep_stream_nl', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=ndep_stream_nl, iostat=nml_error) + if (nml_error /= 0) then + call endrun(' ERROR reading ndep_stream_nl namelist'//errMsg(sourcefile, __LINE__)) + end if + end if + close(nu_nml) + endif + call mpi_bcast(stream_ndep_mesh_filename, len(stream_ndep_mesh_filename), mpi_character, 0, mpicom, ierr) + if (ierr /= 0) call endrun(trim(subname)//": FATAL: mpi_bcast: stream_ndep_mesh_filename") + call mpi_bcast(stream_ndep_data_filename, len(stream_ndep_data_filename), mpi_character, 0, mpicom, ierr) + if (ierr /= 0) call endrun(trim(subname)//": FATAL: mpi_bcast: stream_ndep_data_filename") + call mpi_bcast(stream_ndep_year_first, 1, mpi_integer, 0, mpicom, ierr) + if (ierr /= 0) call endrun(trim(subname)//": FATAL: mpi_bcast: stream_ndep_year_first") + call mpi_bcast(stream_ndep_year_last, 1, mpi_integer, 0, mpicom, ierr) + if (ierr /= 0) call endrun(trim(subname)//": FATAL: mpi_bcast: stream_ndep_year_last") + 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") + + ndep_stream_active = len_trim(stream_ndep_data_filename)>0 .and. stream_ndep_data_filename/='UNSET' + + ! Check whether the stream is being used. + if (.not.ndep_stream_active) then + 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:' + write(iulog,'(a,a)' ) ' stream_ndep_data_filename = ',trim(stream_ndep_data_filename) + write(iulog,'(a,a)' ) ' stream_ndep_mesh_filename = ',trim(stream_ndep_mesh_filename) + write(iulog,'(a,a,a)') ' stream_varlist_ndep = ',trim(stream_varlist_ndep(1)), trim(stream_varlist_ndep(2)) + write(iulog,'(a,i8)') ' stream_ndep_year_first = ',stream_ndep_year_first + write(iulog,'(a,i8)') ' stream_ndep_year_last = ',stream_ndep_year_last + write(iulog,'(a,i8)') ' stream_ndep_year_align = ',stream_ndep_year_align + write(iulog,'(a)' ) ' ' + endif + + end subroutine stream_ndep_readnl + + subroutine stream_ndep_init(model_mesh, model_clock, rc) + use dshr_strdata_mod, only: shr_strdata_init_from_inline + + ! input/output variables + type(ESMF_CLock), intent(in) :: model_clock + type(ESMF_Mesh) , intent(in) :: model_mesh + integer , intent(out) :: rc + + ! local variables + character(*), parameter :: subName = "('stream_ndep_init')" + + rc = ESMF_SUCCESS + if (.not.ndep_stream_active) then + return + end if + ! + ! Initialize data stream information. + ! Read in units + call stream_ndep_check_units(stream_ndep_data_filename) + + ! Initialize the cdeps data type sdat_ndep + call shr_strdata_init_from_inline(sdat_ndep, & + my_task = iam, & + logunit = iulog, & + compname = 'ATM', & + model_clock = model_clock, & + model_mesh = model_mesh, & + stream_meshfile = trim(stream_ndep_mesh_filename), & + stream_filenames = (/trim(stream_ndep_data_filename)/), & + stream_yearFirst = stream_ndep_year_first, & + stream_yearLast = stream_ndep_year_last, & + stream_yearAlign = stream_ndep_year_align, & + stream_fldlistFile = stream_varlist_ndep, & + stream_fldListModel = stream_varlist_ndep, & + stream_lev_dimname = 'null', & + stream_mapalgo = 'bilinear', & + stream_offset = 0, & + stream_taxmode = 'cycle', & + stream_dtlimit = 1.0e30_r8, & + stream_tintalgo = 'linear', & + stream_name = 'Nitrogen deposition data ', & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + end subroutine stream_ndep_init + + !================================================================ + subroutine stream_ndep_check_units( stream_fldFileName_ndep) + + !-------------------------------------------------------- + ! Check that units are correct on the file and if need any conversion + !-------------------------------------------------------- + + use cam_pio_utils , only : cam_pio_createfile, cam_pio_openfile, cam_pio_closefile, pio_subsystem + use pio , only : file_desc_t, io_desc_t, var_desc_t, pio_double, pio_def_dim + use pio , only : pio_bcast_error, pio_seterrorhandling, pio_inq_varid, pio_get_att + use pio , only : PIO_NOERR, PIO_NOWRITE + + ! Arguments + character(len=*), intent(in) :: stream_fldFileName_ndep ! ndep filename + ! + ! Local variables + type(file_desc_t) :: File ! NetCDF filehandle for ndep file + type(var_desc_t) :: vardesc ! variable descriptor + integer :: ierr ! error status + integer :: err_handling ! temporary + character(len=CS) :: ndepunits! ndep units + !----------------------------------------------------------------------- + + call cam_pio_openfile( File, trim(stream_fldFileName_ndep), PIO_NOWRITE) + call pio_seterrorhandling(File, PIO_BCAST_ERROR, err_handling) + ierr = pio_inq_varid(File, stream_varlist_ndep(1), vardesc) + if (ierr /= PIO_NOERR) then + call endrun(' ERROR finding variable: '//trim(stream_varlist_ndep(1))//" in file: "// & + trim(stream_fldFileName_ndep)//errMsg(sourcefile, __LINE__)) + else + ierr = PIO_get_att(File, vardesc, "units", ndepunits) + end if + call pio_seterrorhandling(File, err_handling) + call cam_pio_closefile(File) + + ! Now check to make sure they are correct + if (.not. trim(ndepunits) == "g(N)/m2/s" )then + call endrun(' ERROR in units for nitrogen deposition equal to: '//trim(ndepunits)//" not units expected"// & + errMsg(sourcefile, __LINE__)) + end if + + end subroutine stream_ndep_check_units + + !================================================================ + subroutine stream_ndep_interp(cam_out, rc) + + use dshr_methods_mod , only : dshr_fldbun_getfldptr + use dshr_strdata_mod , only : shr_strdata_advance + use camsrfexch , only : cam_out_t + use ppgrid , only : begchunk, endchunk + use time_manager , only : get_curr_date + use phys_grid , only : get_ncols_p + + ! input/output variables + type(cam_out_t) , intent(inout) :: cam_out(begchunk:endchunk) + integer , intent(out) :: rc + + ! local variables + integer :: i,c,g + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: mcdate ! Current model date (yyyymmdd) + real(r8), pointer :: dataptr1d_nhx(:) + real(r8), pointer :: dataptr1d_noy(:) + + ! NDEP read from forcing is expected to be in units of gN/m2/sec - but the mediator + ! expects units of kgN/m2/sec + real(r8), parameter :: scale_ndep = .001_r8 + + !----------------------------------------------------------------------- + + ! Advance sdat stream + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + call shr_strdata_advance(sdat_ndep, ymd=mcdate, tod=sec, logunit=iulog, istr='ndepdyn', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + ! Get pointer for stream data that is time and spatially interpolated to model time and grid + call dshr_fldbun_getFldPtr(sdat_ndep%pstrm(1)%fldbun_model, stream_varlist_ndep(1), fldptr1=dataptr1d_nhx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + call dshr_fldbun_getFldPtr(sdat_ndep%pstrm(1)%fldbun_model, stream_varlist_ndep(2), fldptr1=dataptr1d_noy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + g = 1 + do c = begchunk,endchunk + do i = 1,get_ncols_p(c) + cam_out(c)%nhx_nitrogen_flx(i) = dataptr1d_nhx(g) * scale_ndep + cam_out(c)%noy_nitrogen_flx(i) = dataptr1d_noy(g) * scale_ndep + g = g + 1 + end do + end do + + end subroutine stream_ndep_interp + +end module atm_stream_ndep diff --git a/src/dynamics/eul/bndexch.F90 b/src/dynamics/eul/bndexch.F90 deleted file mode 100644 index 95b6a04cb5..0000000000 --- a/src/dynamics/eul/bndexch.F90 +++ /dev/null @@ -1,248 +0,0 @@ - -subroutine bndexch( adv_state ) - -!----------------------------------------------------------------------- -! -! Purpose: Pack and Exchange initial prognostic information among all the -! processors -! -! Method: -! -! Author: -! -!----------------------------------------------------------------------- -! $Id$ -! $Author$ -! -!----------------------------Parameters--------------------------------- - -#ifdef SPMD - use spmd_dyn, only: cut, cutex, neighs, neighs_proc, & - neighn, neighn_proc, dyn_npes - use spmd_utils, only: iam -#endif - use scanslt, only: advection_state - - implicit none -! -! Arguments -! - type(advection_state), intent(inout) :: adv_state ! Advection state data -! -! Local workspace -! -#ifdef SPMD - integer ns, nn - integer inreg( 2 ) - integer outreg( 2 ) - integer others,othern ! Other node -! -! Return if number of processors is less than 2 -! - if (dyn_npes .lt. 2) return -! -! For each partition (south and north) communicate boundaries -! on each side of partition among however many neighbors necessary -! -! send south, receive north -! - ns = 1 - nn = 1 - do while (ns .le. neighs .or. nn .le. neighn) - if (ns .le. neighs) then - others = neighs_proc(ns) -! -! Intersection of my cuts and neighbor processor's extended -! cuts tells if this node needs to send data to neighbor -! - call intersct(cut(1,iam),cutex(1,others),outreg) - ns = ns + 1 - else - others = -1 - outreg(1) = 0 - outreg(2) = 0 - end if - - if (nn .le. neighn) then - othern = neighn_proc(nn) -! -! Intersection of neighbor cuts and this node's extended -! cut tells if this node receives data from neighbor -! - call intersct(cut(1,othern),cutex(1,iam),inreg) - nn = nn + 1 - else - othern = -1 - inreg(1) = 0 - inreg(2) = 0 - end if - - call bndexch_mpi(others,outreg,othern,inreg,adv_state) - end do - -! -! send north, receive south -! - ns = 1 - nn = 1 - do while (ns .le. neighs .or. nn .le. neighn) - if (nn .le. neighn) then - othern = neighn_proc(nn) -! -! Intersection of my cuts and neighbor processor's extended -! cuts tells if this node needs to send data to neighbor -! - call intersct(cut(1,iam),cutex(1,othern),outreg) - nn = nn + 1 - else - othern = -1 - outreg(1) = 0 - outreg(2) = 0 - end if - - if (ns .le. neighs) then - others = neighs_proc(ns) -! -! Intersection of neighbor cuts and this node's extended -! cut tells if this node receives data from neighbor -! - call intersct(cut(1,others),cutex(1,iam),inreg) - ns = ns + 1 - else - others = -1 - inreg(1) = 0 - inreg(2) = 0 - end if - - call bndexch_mpi(othern,outreg,others,inreg, adv_state) - end do -#endif - return -end subroutine bndexch - -#ifdef SPMD -subroutine bndexch_mpi(othero,outreg,otheri,inreg, adv_state) -!----------------------------------------------------------------------- -! Send initial prognostic information to my peer process -!----------------------------------------------------------------------- - use scanslt, only: plndlv, j1 - use pmgrid, only: plat - use constituents, only: pcnst - use scanslt, only: advection_state - use mpishorthand - - implicit none -! -! Arguments -! - integer othero,outreg(2),otheri,inreg(2) - type(advection_state), intent(inout) :: adv_state ! Advection state data -! -! Local variables -! - integer, parameter :: msgtype = 6000 - integer, parameter :: j1m = j1 - 1 - integer, parameter :: siz = (2 + pcnst)*plndlv - integer num - integer msg - - integer reqs(3*(plat+1)) - integer stats(MPI_STATUS_SIZE, 3*(plat+1)) - - integer reqr(3*(plat+1)) - integer statr(MPI_STATUS_SIZE, 3*(plat+1)) - - integer i,j - integer reqs_i,reqr_i - - reqr_i = 0 - if (otheri .ne. -1) then - do i = inreg(1), inreg(2) - j = 3*(i-inreg(1)) - msg = msgtype + j - reqr_i = reqr_i + 1 - call mpiirecv (adv_state%u3(1,1,j1m+i),plndlv,mpir8, otheri,msg,mpicom,reqr(reqr_i)) - - msg = msgtype + j + 1 - reqr_i = reqr_i + 1 - call mpiirecv (adv_state%v3(1,1,j1m+i),plndlv,mpir8, otheri,msg,mpicom,reqr(reqr_i)) - - msg = msgtype + j + 2 - reqr_i = reqr_i + 1 - num = pcnst*plndlv - call mpiirecv (adv_state%qminus(1,1,1,j1m+i),num,mpir8, otheri,msg,mpicom,reqr(reqr_i)) - - end do - end if - - reqs_i = 0 - if (othero .ne. -1) then - do i = outreg(1), outreg(2) - j = 3*(i-outreg(1)) - - msg = msgtype + j - reqs_i = reqs_i + 1 - call mpiisend (adv_state%u3(1,1,j1m+i),plndlv,mpir8, othero,msg,mpicom,reqs(reqs_i)) - - msg = msgtype + j + 1 - reqs_i = reqs_i + 1 - call mpiisend (adv_state%v3(1,1,j1m+i),plndlv,mpir8, othero,msg,mpicom,reqs(reqs_i)) - - msg = msgtype + j + 2 - reqs_i = reqs_i + 1 - num = pcnst*plndlv - call mpiisend (adv_state%qminus(1,1,1,j1m+i),num,mpir8, othero,msg,mpicom,reqs(reqs_i)) - - end do - end if - - if (reqs_i .ne. 0) then - call mpiwaitall(reqs_i,reqs,stats) - end if - - if (reqr_i .ne. 0) then - call mpiwaitall(reqr_i,reqr,statr) - end if - - return -end subroutine bndexch_mpi - -subroutine intersct (regiona, regionb, regionc) - -!----------------------------------------------------------------------- -! -! Purpose: -! -! Method: -! Given two regions (a,b) output the intersection (common latitudes) -! of these two sets. The routine is used in bndexch to determine which -! latitudes need to be communicated to neighboring processors. Typically -! this routine is invoked as the intersection of the set of resident -! latitudes on processor A with the set of extended latitudes (needed for -! the SLT) of processor B. Any common latitudes will need to be -! communicated to B to complete SLT processing. -! -! Author: -! Original version: CCM2 -! Standardized: J. Rosinski, Oct 1995 -! J. Truesdale, Feb. 1996 -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------Commons------------------------------------ - implicit none -! -!---------------------------Local workspace----------------------------- -! - integer regiona( 2 ),regionb( 2 ),regionc( 2 ) -! -!----------------------------------------------------------------------- -! - regionc( 1 ) = max( regiona( 1 ), regionb( 1 ) ) - regionc( 2 ) = min( regiona( 2 ), regionb( 2 ) ) - - return -end subroutine intersct -#endif diff --git a/src/dynamics/eul/commap.F90 b/src/dynamics/eul/commap.F90 deleted file mode 100644 index a47acecbb5..0000000000 --- a/src/dynamics/eul/commap.F90 +++ /dev/null @@ -1,23 +0,0 @@ -module commap - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plev, plat, plon - use pspect, only: pmmax, pnmax - - real(r8) :: bps(plev) ! coefficient for ln(ps) term in divergence eqn - real(r8) :: sq(pnmax) ! n(n+1)/a^2 (del^2 response function) - real(r8) :: rsq(pnmax) ! a^2/(n(n+1)) - real(r8) :: slat((plat+1)/2) ! |sine latitude| (hemisphere) - real(r8), target :: w(plat) ! gaussian weights (hemisphere) - real(r8) :: cs((plat+1)/2) ! cosine squared latitude (hemisphere) - real(r8) :: href(plev,plev) ! reference hydrostatic equation matrix - real(r8) :: ecref(plev,plev) ! reference energy conversion matrix - real(r8), target :: clat(plat) ! model latitudes (radians) - real(r8), target :: clon(plon,plat) ! model longitudes (radians) - real(r8), target :: latdeg(plat) ! model latitudes (degrees) - real(r8) :: bm1(plev,plev,pnmax) ! transpose of right eigenvectors of semi-implicit matrix - real(r8) :: tau(plev,plev ) ! matrix for reference d term in thermodynamic eqn - real(r8), target :: londeg(plon,plat) ! model longitudes (degrees) - real(r8) :: t0(plev) ! Reference temperature for t-prime computations - real(r8) :: xm(pmmax) ! m (longitudinal wave number) -end module commap diff --git a/src/dynamics/eul/comspe.F90 b/src/dynamics/eul/comspe.F90 deleted file mode 100644 index f33933d445..0000000000 --- a/src/dynamics/eul/comspe.F90 +++ /dev/null @@ -1,43 +0,0 @@ -module comspe - -! Spectral space arrays - -use shr_kind_mod, only: r8 => shr_kind_r8 -use pmgrid, only: plev, plat -use pspect, only: pmmax, pspt - -implicit none - -real(r8), dimension(:,:), allocatable :: vz ! Vorticity spectral coefficients -real(r8), dimension(:,:), allocatable :: d ! Divergence spectral coefficients -real(r8), dimension(:,:), allocatable :: t ! Temperature spectral coefficients -real(r8), dimension(:), allocatable :: alps ! Log-pressure spectral coefficients - -#if ( defined SPMD ) -integer :: maxm = huge(1) ! max number of Fourier wavenumbers per MPI task -integer :: lpspt = huge(1) ! number of local spectral coefficients -integer, dimension(:), allocatable :: numm - ! number of Fourier wavenumbers owned per task -integer, dimension(:,:), allocatable :: locm, locrm - ! assignment of wavenumbers to MPI tasks -integer, dimension(:), allocatable :: lnstart - ! Starting indices for local spectral arrays (real) -#else -integer :: numm(0:0) = pmmax -integer :: maxm = pmmax -integer :: lpspt = pspt -integer :: locm(1:pmmax, 0:0) = huge(1) -integer :: locrm(1:2*pmmax, 0:0) = huge(1) -integer :: lnstart(1:pmmax) = huge(1) -#endif - -integer :: nstart(pmmax) = huge(1) ! Starting indices for spectral arrays (real) -integer :: nlen(pmmax) = huge(1) ! Length vectors for spectral arrays - -real(r8), dimension(:,:), allocatable :: alp ! Legendre polynomials (pspt,plat/2) -real(r8), dimension(:,:), allocatable :: dalp ! Legendre polynomial derivatives (pspt,plat/2) - -real(r8), dimension(:,:), allocatable :: lalp ! local Legendre polynomials -real(r8), dimension(:,:), allocatable :: ldalp ! local Legendre polynomial derivatives - -end module comspe diff --git a/src/dynamics/eul/comsta.h b/src/dynamics/eul/comsta.h deleted file mode 100644 index 70393bcc47..0000000000 --- a/src/dynamics/eul/comsta.h +++ /dev/null @@ -1,15 +0,0 @@ -! -! $Id$ -! $Author$ -! -! -! Diagnostic statistics integrals -! - common/comsta/rmsz(plat) ,rmsd(plat) ,rmst(plat) ,stq(plat), & - psurf(plat) -! - real(r8) rmsz ! lambda/p sum of w*dp/ps times square vorticity - real(r8) rmsd ! lambda/p sum of w*dp/ps times square divergence - real(r8) rmst ! lambda/p sum of w*dp/ps times square temperature - real(r8) stq ! lambda/p sum of w*dp/ps times square moisture - real(r8) psurf ! lambda/p sum of w*dp/ps times square surface press diff --git a/src/dynamics/eul/courlim.F90 b/src/dynamics/eul/courlim.F90 deleted file mode 100644 index f1a84853f2..0000000000 --- a/src/dynamics/eul/courlim.F90 +++ /dev/null @@ -1,170 +0,0 @@ - -subroutine courlim (vmax2d, vmax2dt, vcour) - -!----------------------------------------------------------------------- -! -! Purpose: -! Find out whether Courant limiter needs to be applied -! -! Method: -! -! Author: -! Original version: CCM2 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - use pspect - use physconst, only: rga - use time_manager, only: get_nstep, is_first_step - use eul_control_mod -#ifdef SPMD - use mpishorthand -#endif - use spmd_utils, only: masterproc - use perf_mod - use cam_logfile, only: iulog - - implicit none - -#include - -! -! Arguments -! - real(r8), intent(inout) :: vmax2d(plev,plat) ! Max. wind at each level, latitude - real(r8), intent(inout) :: vmax2dt(plev,plat) ! Max. truncated wind at each lvl,lat - real(r8), intent(inout) :: vcour(plev,plat) ! Maximum Courant number in slice -! -!--------------------------Local Variables------------------------------ -! - integer k,lat ! Indices - integer latarr(1) ! Output from maxloc (needs to be array for conformability) - integer :: nstep ! Current timestep number - - real(r8) vcourmax ! Max courant number in the vertical wind field - real(r8) vmax1d(plev) ! Sqrt of max wind speed - real(r8) vmax1dt(plev) ! Sqrt of max wind speed - real(r8) cn ! Estimate of truncated Courant number - real(r8) cnmax ! Max. courant no. horiz. wind field - real(r8) psurfsum ! Summing variable - global mass - real(r8) stqsum ! Summing variable - global moisture - real(r8) rmszsum ! Summing variable - global vorticity - real(r8) rmsdsum ! Summing variable - global divergence - real(r8) rmstsum ! Summing variable - global temperature - real(r8) stps ! Global Mass integral - real(r8) stqf ! Global Moisture integral - real(r8) rmszf ! Global RMS Vorticity - real(r8) rmsdf ! Global RMS Divergence - real(r8) rmstf ! Global RMS Temperature -! -!----------------------------------------------------------------------- -! -#if ( defined SPMD ) - call t_barrierf ('sync_realloc7', mpicom) - call t_startf ('realloc7') - call realloc7 (vmax2d, vmax2dt, vcour) - call t_stopf ('realloc7') -#endif - - nstep = get_nstep() -! -! Compute maximum wind speed for each level -! - do k=1,plev - vmax1d(k) = sqrt (maxval (vmax2d(k,:))) - vmax1dt(k) = sqrt (maxval (vmax2dt(k,:))) - end do -! -! Compute max. vertical Courant number (k is index to Model interfaces) -! - vcourmax = maxval (vcour(2:,:)) -! -! Determine whether the CFL limit has been exceeded for each level -! within the specified range (k<=kmxhdc). Set the truncation wave number -! (for each level independently) so that the CFL limit will not be -! violated and print a message (information only). The trunc wavenumber -! is used later in "hordif" to adjust the diffusion coefficients for -! waves beyond the limit. Store the maximum Courant number for printing -! on the stats line. Note that the max Courant number is not computed -! for the entire vertical domain, just the portion for which the limiter -! is actually applied. -! - cnmax = 0._r8 - do k=1,kmxhdc - cn = vmax1dt(k)*cnfac ! estimate of truncated Courant number - cnmax = max(cnmax,cn) - if (cn .gt. cnlim) then - nindex(k) = int(nmaxhd*cnlim/cn + 1._r8) - latarr = maxloc (vmax2dt(k,:)) - if (masterproc) write(iulog,800)k,latarr,cn,nindex(k)-1 - else - nindex(k) = 2*nmaxhd - endif - end do -! -! Write out estimate of original Courant number if limit is exceeded -! - do k=1,kmxhdc - cn = vmax1d(k)*cnfac ! estimate of original Courant number - if (cn .gt. cnlim) then - latarr = maxloc (vmax2d(k,:)) - if (masterproc) write(iulog,805) k,latarr,cn - end if - end do -! -! Compute Max Courant # for whole atmosphere for diagnostic output -! - cnmax = 0._r8 - do k=1,plev-1 - cn = vmax1dt(k)*cnfac ! estimate of Courant number - cnmax = max(cnmax,cn) - end do -! -! Write out statisitics to standard output -! - psurfsum = 0._r8 - stqsum = 0._r8 - rmszsum = 0._r8 - rmsdsum = 0._r8 - rmstsum = 0._r8 - - do lat=1,plat - psurfsum = psurfsum + psurf(lat) - stqsum = stqsum + stq(lat) - rmszsum = rmszsum + rmsz(lat) - rmsdsum = rmsdsum + rmsd(lat) - rmstsum = rmstsum + rmst(lat) - end do - - stps = 0.5_r8*psurfsum - stqf = 0.5_r8*rga*stqsum - rmszf = sqrt(0.5_r8*rmszsum) - rmsdf = sqrt(0.5_r8*rmsdsum) - rmstf = sqrt(0.5_r8*rmstsum) - if (masterproc) then - if (is_first_step()) write(iulog,810) - write(iulog,820) nstep, rmszf, rmsdf, rmstf, stps, stqf, cnmax, vcourmax - end if -! - return -! -! Formats -! -800 format('COURLIM: *** Courant limit exceeded at k,lat=',2i3, & - ' (estimate = ',f6.3, '), solution has been truncated to ', & - 'wavenumber ',i3,' ***') -805 format(' *** Original Courant limit exceeded at k,lat=',2i3, & - ' (estimate = ',f6.3,')',' ***') -810 format(/109x,'COURANT'/10x,'NSTEP',4x,'RMSZ',19x,'RMSD',19x, & - 'RMST',4x,'STPS',9x,'STQ',19x,'HOR VERT') -820 format(' NSTEP =',i8,1x,1p,2e23.15,0p,1f8.3,1p,1e13.5,e23.15, & - 0p,1f5.2,f6.2) -end subroutine courlim - diff --git a/src/dynamics/eul/cubxdr.F90 b/src/dynamics/eul/cubxdr.F90 deleted file mode 100644 index 4731a2e46e..0000000000 --- a/src/dynamics/eul/cubxdr.F90 +++ /dev/null @@ -1,83 +0,0 @@ -subroutine cubxdr(pidim ,ibeg ,len ,dx ,f , & - fxl ,fxr ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Compute Lagrangian cubic derivative estimates for data on an equally -! spaced grid. -! -! Method: -! Compute Lagrangian cubic derivative estimates for data on an equally -! spaced grid. Suppose grid interval i is centered in a 4 point -! stencil consisting of grid points i-1, i, i+1, and i+2. Then the -! derivative at the left edge of the interval (i.e., grid point i) -! is stored in fxl(i), and the derivative at the right edge of the -! interval (i.e., grid point i+1) is stored in fxr(i). Note that -! fxl(i) is not necessarily equal to fxr(i-1) even though both of -! these values are estimates of the derivative at grid point i. -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer, intent(in) :: pidim ! dimension - integer, intent(in) :: ibeg ! starting index to perform computation - integer, intent(in) :: len ! length over which to perform comp. -! - real(r8), intent(in) :: dx ! grid interval - real(r8), intent(in) :: f(pidim) ! input field values -! -! Output arguments -! - real(r8), intent(out) :: fxl(pidim) ! left derivative of interval i in "f" - real(r8), intent(out) :: fxr(pidim) ! right derivative of interval i in "f" -!----------------------------------------------------------------------- -! -! pidim Length of f, fxl, and fxr. -! ibeg First interval of grid for which derivatives are computed. -! len Number of grid intervals for which derivatives are computed. -! (There are pidim - 1 intervals between the pidim gridpoints -! represented in f, fxl, and fxr.) -! dx Value of grid spacing. -! f Values on equally spaced grid for which derivatives are -! computed. -! fxl fxl(i) is the derivative at the left edge of interval i. -! fxr fxr(i) is the derivative at the right edge of interval i. -! -!---------------------------Local variables----------------------------- -! - integer i ! index - integer iend ! index denoting end of computation -! - real(r8) rdx6 ! normalization weight -! -!----------------------------------------------------------------------- -! - fxl = 0._r8 - fxr = 0._r8 - - iend = ibeg + len - 1 - rdx6 = 1._r8/(6._r8*dx) -! - do i = ibeg,iend - fxl(i) = ( -2._r8*f(i-1) - 3._r8*f(i) + 6._r8*f(i+1) - f(i+2) )*rdx6 - fxr(i) = ( f(i-1) - 6._r8*f(i) + 3._r8*f(i+1) + 2._r8*f(i+2) )*rdx6 - end do -! - return -end subroutine cubxdr - diff --git a/src/dynamics/eul/cubydr.F90 b/src/dynamics/eul/cubydr.F90 deleted file mode 100644 index b20ccc6f86..0000000000 --- a/src/dynamics/eul/cubydr.F90 +++ /dev/null @@ -1,130 +0,0 @@ -subroutine cubydr(pf ,fint ,wdy ,jdp ,jcen , & - fyb ,fyt ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Compute Lagrangian cubic derivative estimates at both ends of the -! intervals in the y coordinate (unequally spaced) containing the -! departure points for the latitude slice being forecasted. -! -! Method: -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev - use scanslt, only: platd - use cam_abortutils, only: endrun - use cam_logfile, only: iulog -#if ( ! defined UNICOSMP ) - use srchutil, only: whenieq -#endif -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -#include -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer, intent(in) :: pf ! number of constituent fields -! - real(r8), intent(in) :: fint(plon,plev,ppdy,pf) ! constituent x- interpolants - real(r8), intent(in) :: wdy(4,2,platd) ! latitude interpolation weights -! - integer, intent(in) :: jdp(plon,plev) ! indices of latitude intervals - integer, intent(in) :: jcen ! current latitude index - integer, intent(in) :: nlon -! -! Output arguments -! - real(r8), intent(out) :: fyb(plon,plev,pf) ! Derivative at south end of interval - real(r8), intent(out) :: fyt(plon,plev,pf) ! Derivative at north end of interval -!----------------------------------------------------------------------- -! -! pf Number of fields being interpolated. -! fint (fint(i,k,j,m),j=1,ppdy) contains the x interpolants at each -! latitude needed for the y derivative estimates at the -! endpoints of the interval that contains the departure point -! for grid point (i,k). The last index of fint allows for -! interpolation of multiple fields. fint is generated by a -! call to herxin. -! wdy Weights for Lagrange cubic derivative estimates on the -! unequally spaced latitude grid. If grid interval j (in -! extended array) is surrounded by a 4 point stencil, then -! the derivative at the "bottom" of the interval uses the -! weights wdy(1,1,j),wdy(2,1,j), wdy(3,1,j), and wdy(4,1,j). -! The derivative at the "top" of the interval uses wdy(1,2,j), -! wdy(2,2,j), wdy(3,2,j), and wdy(4,2,j). -! jdp jdp(i,k) is the index of the y-interval that contains the -! departure point corresponding to global grid point (i,k) in -! the latitude slice being forecasted. -! Suppose yb contains the y-coordinates of the extended array -! and ydp(i,k) is the y-coordinate of the departure point -! corresponding to grid point (i,k). Then, -! yb(jdp(i,k)) .le. ydp(i,k) .lt. yb(jdp(i,k)+1) . -! fyb fyb(i,k,.) is the derivative at the bottom of the y interval -! that contains the departure point of global grid point (i,k). -! fyt fyt(i,k,.) is the derivative at the top of the y interval -! that contains the departure point of global grid point (i,k). -! -!---------------------------Local variables----------------------------- -! - integer i,k ! index - integer m ! index - integer jdpval ! index - integer icount ! counter - integer ii ! index - integer indx(plon) ! set of indices for indirect addressing - integer nval(plev) ! number of indices for given "jdpval" -! -!----------------------------------------------------------------------- -! - icount = 0 - do jdpval=jcen-2,jcen+1 -!$OMP PARALLEL DO PRIVATE (K, INDX, M, II, I) - do k=1,plev - call whenieq(nlon,jdp(1,k),1,jdpval,indx,nval(k)) - do m=1,pf - do ii=1,nval(k) - i=indx(ii) - fyb(i,k,m) = wdy(1,1,jdpval)*fint(i,k,1,m) + & - wdy(2,1,jdpval)*fint(i,k,2,m) + & - wdy(3,1,jdpval)*fint(i,k,3,m) + & - wdy(4,1,jdpval)*fint(i,k,4,m) -! - fyt(i,k,m) = wdy(1,2,jdpval)*fint(i,k,1,m) + & - wdy(2,2,jdpval)*fint(i,k,2,m) + & - wdy(3,2,jdpval)*fint(i,k,3,m) + & - wdy(4,2,jdpval)*fint(i,k,4,m) - end do - end do - end do - do k=1,plev - icount = icount + nval(k) - enddo - if (icount.eq.nlon*plev) return - end do - if (icount.ne.nlon*plev) then - write(iulog,*)'CUBYDR: Departure point out of bounds: jcen,icount,nlon*plev=',jcen,icount,nlon*plev - write(iulog,*)' ****** MODEL IS BLOWING UP: CFL condition likely violated *********' - write(iulog,*)' Possible solutions: a) reduce time step' - write(iulog,*)' b) if initial run, set "DIVDAMPN = 1." in namelist and rerun' - write(iulog,*)' c) modified code may be in error' - call endrun () - end if -! - return -end subroutine cubydr diff --git a/src/dynamics/eul/cubzdr.F90 b/src/dynamics/eul/cubzdr.F90 deleted file mode 100644 index c5760249ce..0000000000 --- a/src/dynamics/eul/cubzdr.F90 +++ /dev/null @@ -1,99 +0,0 @@ - -subroutine cubzdr(nlon ,pkdim ,f ,lbasdz ,dfz1 , & - dfz2 ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Vertical derivative estimates for a vertical slice using Lagrangian -! cubic formulas. -! -! Method: -! Derivatives are set to zero at the top and bottom. -! At the "inner nodes" of the top and bottom intervals, a "one sided" -! estimate is used. -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, March 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon -!----------------------------------------------------------------------- - implicit none -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer, intent(in) :: nlon ! number of longitudes - integer, intent(in) :: pkdim ! vertical dimension -! - real(r8), intent(in) :: f(plon,pkdim) ! constituent field - real(r8), intent(in) :: lbasdz(4,2,pkdim) ! vertical interpolation weights -! -! Output arguments -! - real(r8), intent(out) :: dfz1(plon,pkdim) ! derivative at top of interval - real(r8), intent(out) :: dfz2(plon,pkdim) ! derivative at bot of interval -!----------------------------------------------------------------------- -! -! nlon Number of longitudes -! pkdim Vertical dimension of arrays. -! f Vertical slice of data for which derivative estimates are -! made -! lbasdz Lagrangian cubic basis functions for evaluating the -! derivatives on the unequally spaced vertical grid. -! dfz1 dfz1 contains derivative estimates at the "top" edges of the -! intervals in the f array. -! dfz2 dfz2 contains derivative estimates at the "bottom" edges of -! the intervals in the f array. -! -!---------------------------Local variables----------------------------- -! - integer i,k ! indices -! -!----------------------------------------------------------------------- -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=2,pkdim-2 - do i=1,nlon -! -! Lagrangian derivative estimates (cubic) for the two center nodes in a -! four node stencil. -! - dfz1(i,k) = lbasdz(1,1,k)*f(i,k-1) + & - lbasdz(2,1,k)*f(i,k) + & - lbasdz(3,1,k)*f(i,k+1) + & - lbasdz(4,1,k)*f(i,k+2) -! - dfz2(i,k) = lbasdz(1,2,k)*f(i,k-1) + & - lbasdz(2,2,k)*f(i,k) + & - lbasdz(3,2,k)*f(i,k+1) + & - lbasdz(4,2,k)*f(i,k+2) - end do - end do -! -! Constrain derivatives to zero at top and bottom of vertical grid. -! At the interior nodes of the intervals at the top and bottom of the -! vertical grid, use the derivative estimate at that same node for the -! adjacent interval. (This is a "one-sided" estimate for that node.) -! - do i=1,nlon - dfz1(i,1) = 0.0_r8 - dfz2(i,1) = dfz1(i,2) - dfz1(i,pkdim-1) = dfz2(i,pkdim-2) - dfz2(i,pkdim-1) = 0.0_r8 - end do -! - return -end subroutine cubzdr - diff --git a/src/dynamics/eul/diag_dynvar_ic.F90 b/src/dynamics/eul/diag_dynvar_ic.F90 deleted file mode 100644 index c963605fe6..0000000000 --- a/src/dynamics/eul/diag_dynvar_ic.F90 +++ /dev/null @@ -1,67 +0,0 @@ - - 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 constituents, only: pcnst, cnst_name - use commap, only:clat,clon - use dyn_grid, only : get_horiz_grid_d - implicit none -! -!----------------------------------------------------------------------- -! -! Arguments -! - real(r8), intent(in) :: phis(plon, beglat:endlat) ! Surface geopotential - real(r8), intent(in) :: ps (plon, beglat:endlat) ! surface pressure - real(r8), intent(in) :: t3 (plon, plev, beglat:endlat) ! temperature - real(r8), intent(in) :: u3 (plon, plev, beglat:endlat) ! u-wind component - real(r8), intent(in) :: v3 (plon, plev, beglat:endlat) ! v-wind component - real(r8), intent(in) :: q3 (plon, plev, pcnst, beglat:endlat) ! constituents - real(r8) :: clat_plon(plon) ! constituents - real(r8) :: phi(plat) ! constituents - real(r8) :: lam(plon) ! constituents -! -!---------------------------Local workspace----------------------------- -! - integer lat, m ! indices -! -!----------------------------------------------------------------------- -! - if( write_inithist() ) then - -!$OMP PARALLEL DO PRIVATE (LAT, M) - do lat=beglat,endlat - - call outfld('PS&IC ' , ps (1 ,lat), plon, lat) - 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 - - do m=1,pcnst - call outfld(trim(cnst_name(m))//'&IC', q3(1,1,m,lat), plon, lat) - end do - - end do - - end if - - return - end subroutine diag_dynvar_ic diff --git a/src/dynamics/eul/dp_coupling.F90 b/src/dynamics/eul/dp_coupling.F90 deleted file mode 100644 index 661b66a953..0000000000 --- a/src/dynamics/eul/dp_coupling.F90 +++ /dev/null @@ -1,474 +0,0 @@ - -!------------------------------------------------------------------------------- -! dynamics - physics coupling module -!------------------------------------------------------------------------------- -module dp_coupling - - use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, pver - use pmgrid, only: plev, beglat, endlat, plon - - use phys_grid - use physics_types, only: physics_state, physics_tend - use constituents, only: pcnst - use physconst, only: cpair, gravit, rair, zvir, rairv - use geopotential, only: geopotential_t - use check_energy, only: check_energy_timestep_init -#if (defined SPMD) - use spmd_dyn, only: buf1, buf1win, buf2, buf2win, & - spmdbuf_siz, local_dp_map, & - block_buf_nrecs, chunk_buf_nrecs - use mpishorthand, only: mpicom -#endif - use cam_abortutils, only: endrun - use perf_mod - - implicit none - -!=============================================================================== -CONTAINS -!=============================================================================== - -!=============================================================================== - subroutine d_p_coupling(ps, t3, u3, v3, q3, & - omga, phis, phys_state, phys_tend, pbuf2d, pdeld) -!------------------------------------------------------------------------------ -! Coupler for converting dynamics output variables into physics input variables -! also writes dynamics variables (on physics grid) to history file -!------------------------------------------------------------------------------ - use physconst, only: cappa - use constituents, only: cnst_get_type_byind, qmin - use physics_types, only: set_state_pdry - use physics_buffer, only: pbuf_get_chunk, physics_buffer_desc - use qneg_module, only: qneg3 - -!------------------------------Arguments-------------------------------- - real(r8), intent(in) :: ps (plon, beglat:endlat) ! surface pressure - real(r8), intent(in) :: t3 (plon, plev, beglat:endlat) ! temperature - real(r8), intent(in) :: u3 (plon, plev, beglat:endlat) ! u-wind component - real(r8), intent(in) :: v3 (plon, plev, beglat:endlat) ! v-wind component - real(r8), intent(in) :: q3 (plon, plev, pcnst, beglat:endlat) ! constituents - real(r8), intent(in) :: omga(plon, plev, beglat:endlat) ! vertical velocity - real(r8), intent(in) :: phis(plon, beglat:endlat) ! Surface geopotential - real(r8), intent(in) :: pdeld (:,:,beglat:) - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state - type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend - -! -!---------------------------Local workspace----------------------------- -#if (! defined SPMD) - real(r8) :: buf1(1), buf2(1) ! transpose buffers - integer :: buf1win, buf2win ! MPI-2 window ids - integer :: spmdbuf_siz = 0 - integer :: block_buf_nrecs = 0 - integer :: chunk_buf_nrecs = 0 - integer :: mpicom = 0 - logical :: local_dp_map=.true. -#endif - - integer :: i,k,j,m,lchnk ! indices - integer :: ncol ! number of columns in current chunk - integer :: lats(pcols) ! array of latitude indices - integer :: lons(pcols) ! array of longitude indices - integer :: tsize ! amount of data per grid point passed to physics - integer :: bpter(plon,0:plev) ! offsets into block buffer for packing data - integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data - logical :: wetq(pcnst) ! 'moist-type' constituent flag - real(r8) :: rlat(pcols) ! array of latitudes (radians) - real(r8) :: rlon(pcols) ! array of longitudes (radians) - real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer - - type(physics_buffer_desc), pointer :: pbuf_chnk(:) - -!----------------------------------------------------------------------- - -! Determine which constituents are wet and which are dry - do m=2,pcnst - if (cnst_get_type_byind(m).eq.'wet') then - wetq(m) = .true. - else - wetq(m) = .false. - endif - enddo - -!----------------------------------------------------------------------- -! copy data from dynamics data structure to physics data structure -!----------------------------------------------------------------------- - if (local_dp_map) then - -!$OMP PARALLEL DO PRIVATE (LCHNK, NCOL, I, K, M, LONS, LATS) - do lchnk = begchunk,endchunk - ncol = phys_state(lchnk)%ncol - call get_lon_all_p(lchnk, ncol, lons) - call get_lat_all_p(lchnk, ncol, lats) - - do i=1,ncol - phys_state(lchnk)%ps (i) = ps (lons(i),lats(i)) - phys_state(lchnk)%phis (i) = phis(lons(i),lats(i)) - end do - - do k=1,plev - do i=1,ncol - phys_state(lchnk)%t (i,k) = t3 (lons(i),k,lats(i)) - phys_state(lchnk)%u (i,k) = u3 (lons(i),k,lats(i)) - phys_state(lchnk)%v (i,k) = v3 (lons(i),k,lats(i)) - phys_state(lchnk)%omega(i,k) = omga(lons(i),k,lats(i)) - phys_state(lchnk)%q(i,k,1) = q3 (lons(i),k,1,lats(i)) - end do - end do - - do k=1,plev - do i=1,ncol - phys_state(lchnk)%pdeldry(i,k) = pdeld(lons(i),k,lats(i)) - end do - end do - - ! convert moist-type constituents from dry to moist mixing ratio - - do m=2,pcnst - if (wetq(m)) then - do k=1,plev - do i=1,ncol - phys_state(lchnk)%q(i,k,m) = q3(lons(i),k,m,lats(i))*(1._r8 - q3(lons(i),k,1,lats(i))) - end do - end do - else - do k=1,plev - do i=1,ncol - phys_state(lchnk)%q(i,k,m) = q3(lons(i),k,m,lats(i)) - end do - end do - endif - end do - - end do - - else - - tsize = 5 + pcnst - - if (tsize*max(block_buf_nrecs,chunk_buf_nrecs) > spmdbuf_siz) then - call endrun ('p_d_coupling: communication buffers (spmdbuf_siz) too small') - endif - -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE (J, BPTER, I, K, M) -#endif - do j=beglat,endlat - - call block_to_chunk_send_pters(j,plon,plev+1,tsize,bpter) - - do i=1,plon - buf1(bpter(i,0)) = ps (i,j) - buf1(bpter(i,0)+1) = phis(i,j) - end do - -!$OMP PARALLEL DO PRIVATE (K, I, M) - do k=1,plev - - do i=1,plon - - buf1(bpter(i,k)) = t3 (i,k,j) - buf1(bpter(i,k)+1) = u3 (i,k,j) - buf1(bpter(i,k)+2) = v3 (i,k,j) - buf1(bpter(i,k)+3) = omga(i,k,j) - buf1(bpter(i,k)+4) = q3 (i,k,1,j) - - ! convert moist-type constituents from dry to moist mixing ratio - - do m=2,pcnst - if (wetq(m)) then - buf1(bpter(i,k)+3+m) = q3(i,k,m,j)*(1._r8 - q3(i,k,1,j)) - else - buf1(bpter(i,k)+3+m) = q3(i,k,m,j) - endif - end do - - buf1(bpter(i,k)+4+pcnst) = pdeld(i,k,j) - - end do - - end do - - end do - - call t_barrierf ('sync_blk_to_chk', mpicom) - call t_startf ('block_to_chunk') - call transpose_block_to_chunk(tsize, buf1, buf2, buf2win) - call t_stopf ('block_to_chunk') - -!$OMP PARALLEL DO PRIVATE (LCHNK, NCOL, CPTER, I, K, M) - do lchnk = begchunk,endchunk - ncol = phys_state(lchnk)%ncol - - call block_to_chunk_recv_pters(lchnk,pcols,pver+1,tsize,cpter) - - do i=1,ncol - phys_state(lchnk)%ps (i) = buf2(cpter(i,0)) - phys_state(lchnk)%phis (i) = buf2(cpter(i,0)+1) - end do - - do k=1,plev - - do i=1,ncol - - phys_state(lchnk)%t (i,k) = buf2(cpter(i,k)) - phys_state(lchnk)%u (i,k) = buf2(cpter(i,k)+1) - phys_state(lchnk)%v (i,k) = buf2(cpter(i,k)+2) - phys_state(lchnk)%omega (i,k) = buf2(cpter(i,k)+3) - - do m=1,pcnst - phys_state(lchnk)%q (i,k,m) = buf2(cpter(i,k)+3+m) - end do - - phys_state(lchnk)%pdeldry(i,k) = buf2(cpter(i,k)+4+pcnst) - - end do - - end do - - end do - - endif - -!----------------------------------------------------------------------- -! Fill auxilliary arrays in physics data structure -!----------------------------------------------------------------------- -!$OMP PARALLEL DO PRIVATE (LCHNK, NCOL, I, K, M, LONS, LATS, ZVIRV, pbuf_chnk) - - do lchnk = begchunk,endchunk - ncol = phys_state(lchnk)%ncol - -! pressure arrays - call plevs0(ncol, pcols, pver, & - phys_state(lchnk)%ps, phys_state(lchnk)%pint, & - phys_state(lchnk)%pmid, phys_state(lchnk)%pdel) - -! log(pressure) arrays and Exner function - do k=1,pver+1 - do i=1,ncol - phys_state(lchnk)%lnpint(i,k) = log(phys_state(lchnk)%pint(i,k)) - end do - end do - do k=1,pver - do i=1,ncol - phys_state(lchnk)%rpdel(i,k) = 1._r8/phys_state(lchnk)%pdel(i,k) - phys_state(lchnk)%lnpmid(i,k) = log(phys_state(lchnk)%pmid(i,k)) - phys_state(lchnk)%exner (i,k) = (phys_state(lchnk)%pint(i,pver+1) & - / phys_state(lchnk)%pmid(i,k))**cappa - end do - end do - -!----------------------------------------------------------------------------------- -! Need to fill zvirv 2D variable to be compatible with geopotential_t interface -!----------------------------------------------------------------------------------- - zvirv(:,:) = zvir - -! Compute initial geopotential heights - call geopotential_t (phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint , & - phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & - phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,1), rairv(:,:,lchnk), gravit, zvirv, & - phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol ) - -! Compute initial dry static energy, include surface geopotential - do k = 1, pver - do i=1,ncol - phys_state(lchnk)%s(i,k) = cpair*phys_state(lchnk)%t(i,k) & - + gravit*phys_state(lchnk)%zm(i,k) + phys_state(lchnk)%phis(i) - end do - end do - -! Compute other dry fields in phys_state, using pdeld copied from dynamics above - call set_state_pdry(phys_state(lchnk),pdeld_calc=.false.) - -! -! Ensure tracers are all positive -! - call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & - 1, pcnst, qmin ,phys_state(lchnk)%q) - -! Compute energy and water integrals of input state - pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) - call check_energy_timestep_init(phys_state(lchnk), phys_tend(lchnk), pbuf_chnk ) - - end do - - return - end subroutine d_p_coupling - -!=============================================================================== - subroutine p_d_coupling(phys_state, phys_tend, t2, fu, fv, flx_net, qminus) -!------------------------------------------------------------------------------ -! Coupler for converting physics output variables into dynamics input variables -!------------------------------Arguments-------------------------------- - use constituents, only: cnst_get_type_byind - - type(physics_state),intent(in), dimension(begchunk:endchunk) :: phys_state - type(physics_tend), intent(in), dimension(begchunk:endchunk) :: phys_tend - - real(r8), intent(out) :: t2(plon, plev, beglat:endlat) ! temp tendency - real(r8), intent(out) :: fu(plon, plev, beglat:endlat) ! u wind tendency - real(r8), intent(out) :: fv(plon, plev, beglat:endlat) ! v wind tendency - real(r8), intent(out) :: flx_net(plon,beglat:endlat) ! net flux - real(r8), intent(out) :: qminus(plon, plev, pcnst, beglat:endlat) ! constituents -! -!---------------------------Local workspace----------------------------- -#if (! defined SPMD) - real(r8) :: buf1(1), buf2(1) ! transpose buffers - integer :: buf1win, buf2win ! MPI-2 window ids - integer :: spmdbuf_siz = 0 - integer :: block_buf_nrecs = 0 - integer :: chunk_buf_nrecs = 0 - integer :: mpicom = 0 - logical :: local_dp_map=.true. -#endif - - integer :: i,j,k,m,lchnk ! indices - integer :: ncol ! number of columns in current chunk - integer :: lats(pcols) ! array of latitude indices - integer :: lons(pcols) ! array of longitude indices - integer :: tsize ! amount of data per grid point passed to physics - integer :: bpter(plon,0:plev) ! offsets into block buffer for packing data - integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data - logical :: wetq(pcnst) ! 'wet' constituent flag -!----------------------------------------------------------------------- - -! Determine which constituents are wet and which are dry - do m=2,pcnst - if (cnst_get_type_byind(m).eq.'wet') then - wetq(m) = .true. - else - wetq(m) = .false. - endif - enddo -!----------------------------------------------------------------------- -! copy data from physics data structure to dynamics data structure -!----------------------------------------------------------------------- - if (local_dp_map) then - -!$OMP PARALLEL DO PRIVATE (LCHNK, NCOL, I, K, M, LONS, LATS) - - do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - call get_lon_all_p(lchnk, ncol, lons) - call get_lat_all_p(lchnk, ncol, lats) - - do k=1,plev - do i=1,ncol - t2(lons(i),k,lats(i)) = phys_tend(lchnk)%dTdt (i,k) - fu(lons(i),k,lats(i)) = phys_tend(lchnk)%dudt (i,k) - fv(lons(i),k,lats(i)) = phys_tend(lchnk)%dvdt (i,k) - qminus(lons(i),k,1,lats(i)) = phys_state(lchnk)%q(i,k,1) - end do - end do - - do i=1,ncol - flx_net(lons(i),lats(i)) = phys_tend(lchnk)%flx_net(i) - end do - - ! convert moist-type constituents from moist to dry mixing ratio - - do m=2,pcnst - if (wetq(m)) then - do k=1,plev - do i=1,ncol - qminus(lons(i),k,m,lats(i)) = phys_state(lchnk)%q(i,k,m) / & - (1._r8 - phys_state(lchnk)%q(i,k,1)) - end do - end do - else - do k=1,plev - do i=1,ncol - qminus(lons(i),k,m,lats(i)) = phys_state(lchnk)%q(i,k,m) - end do - end do - endif - end do - - end do - - else - - tsize = 3 + pcnst - - if (tsize*max(block_buf_nrecs,chunk_buf_nrecs) > spmdbuf_siz) then - call endrun ('d_p_coupling: communication buffers (spmdbuf_siz) too small') - endif - -!$OMP PARALLEL DO PRIVATE (LCHNK, NCOL, CPTER, I, K, M) - do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - - call chunk_to_block_send_pters(lchnk,pcols,pver+1,tsize,cpter) - - do i=1,ncol - buf2(cpter(i,0)) = phys_tend(lchnk)%flx_net(i) - end do - - do k=1,plev - - do i=1,ncol - - buf2(cpter(i,k)) = phys_tend(lchnk)%dTdt (i,k) - buf2(cpter(i,k)+1) = phys_tend(lchnk)%dudt (i,k) - buf2(cpter(i,k)+2) = phys_tend(lchnk)%dvdt (i,k) - buf2(cpter(i,k)+3) = phys_state(lchnk)%q(i,k,1) - - ! convert moist-type constituents from moist to dry mixing ratio - - do m=2,pcnst - if (wetq(m)) then - buf2(cpter(i,k)+2+m) = phys_state(lchnk)%q(i,k,m) / & - (1._r8 - phys_state(lchnk)%q(i,k,1)) - else - buf2(cpter(i,k)+2+m) = phys_state(lchnk)%q(i,k,m) - endif - end do - - end do - - end do - - end do - - call t_barrierf ('sync_chk_to_blk', mpicom) - call t_startf ('chunk_to_block') - call transpose_chunk_to_block(tsize, buf2, buf1, buf1win) - call t_stopf ('chunk_to_block') - -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE (J, BPTER, I, K, M) -#endif - do j=beglat,endlat - - call chunk_to_block_recv_pters(j,plon,plev+1,tsize,bpter) - - do i=1,plon - flx_net(i,j) = buf1(bpter(i,0)) - end do - -!$OMP PARALLEL DO PRIVATE (K, I, M) - do k=1,plev - - do i=1,plon - - t2(i,k,j) = buf1(bpter(i,k)) - fu(i,k,j) = buf1(bpter(i,k)+1) - fv(i,k,j) = buf1(bpter(i,k)+2) - - do m=1,pcnst - qminus(i,k,m,j) = buf1(bpter(i,k)+2+m) - end do - - end do - - end do - - end do - - endif - - return - end subroutine p_d_coupling -end module dp_coupling diff --git a/src/dynamics/eul/dycore.F90 b/src/dynamics/eul/dycore.F90 deleted file mode 100644 index 726396e9a4..0000000000 --- a/src/dynamics/eul/dycore.F90 +++ /dev/null @@ -1,28 +0,0 @@ -module dycore - -implicit none -private - -public :: dycore_is - -!========================================================================================= -CONTAINS -!========================================================================================= - -logical function dycore_is(name) - - character(len=*), intent(in) :: name - - if (name == 'eul' .or. name == 'EUL') then - dycore_is = .true. - else - dycore_is = .false. - end if - -end function dycore_is - -!========================================================================================= - -end module dycore - - diff --git a/src/dynamics/eul/dyn.F90 b/src/dynamics/eul/dyn.F90 deleted file mode 100644 index be70698c4e..0000000000 --- a/src/dynamics/eul/dyn.F90 +++ /dev/null @@ -1,124 +0,0 @@ - subroutine dyn(irow ,grlps1 ,grt1 ,grz1 ,grd1 , & - grfu1 ,grfv1 ,grut1 ,grvt1 ,grrh1 , & - grlps2 ,grt2 ,grz2 ,grd2 ,grfu2 , & - grfv2 ,grut2 ,grvt2 ,grrh2, ztodt ) -!----------------------------------------------------------------------- -! -! Combine undifferentiated and longitudinally differentiated Fourier -! coefficient terms for later use in the Gaussian quadrature -! -! Computational note: Index "2*m-1" refers to the real part of the -! complex coefficient, and "2*m" to the imaginary. -! -! The naming convention is as follows: -! - t, q, d, z refer to temperature, specific humidity, divergence -! and vorticity -! - "1" suffix to an array => symmetric component of current latitude pair -! - "2" suffix to an array => antisymmetric component -! -!---------------------------Code history-------------------------------- -! -! Original version: J. Rosinski -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, B. Boville, J. Hack, August 1992 -! Reviewed: D. Williamson, March 1996 -! Modified: P. Worley, September 2002 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - use pspect - use comspe - use commap - use physconst, only: rearth - use time_manager, only: get_step_size, is_first_step - use spmd_utils, only: iam - implicit none - -! -! Input arguments -! - integer irow ! latitude pair index -! -! Input/output arguments -! - real(r8) grlps1(2*maxm) ! sym. surface pressure equation term - real(r8) grt1(2*maxm,plev) ! sym. undifferentiated term in t eqn. - real(r8) grz1(2*maxm,plev) ! sym. undifferentiated term in z eqn. - real(r8) grd1(2*maxm,plev) ! sym. undifferentiated term in d eqn. - real(r8) grfu1(2*maxm,plev) ! sym. nonlinear terms in u eqn. - real(r8) grfv1(2*maxm,plev) ! sym. nonlinear terms in v eqn. - real(r8) grut1(2*maxm,plev) ! sym. lambda derivative term in t eqn. - real(r8) grvt1(2*maxm,plev) ! sym. mu derivative term in t eqn. - real(r8) grrh1(2*maxm,plev) ! sym. RHS of divergence eqn (del^2 term) - real(r8) grlps2(2*maxm) ! antisym. surface pressure equation term - real(r8) grt2(2*maxm,plev) ! antisym. undifferentiated term in t eqn. - real(r8) grz2(2*maxm,plev) ! antisym. undifferentiated term in z eqn. - real(r8) grd2(2*maxm,plev) ! antisym. undifferentiated term in d eqn. - real(r8) grfu2(2*maxm,plev) ! antisym. nonlinear terms in u eqn. - real(r8) grfv2(2*maxm,plev) ! antisym. nonlinear terms in v eqn. - real(r8) grut2(2*maxm,plev) ! antisym. lambda derivative term in t eqn. - real(r8) grvt2(2*maxm,plev) ! antisym. mu derivative term in t eqn. - real(r8) grrh2(2*maxm,plev) ! antisym. RHS of divergence eqn (del^2 term) - real(r8) ztodt -! -!---------------------------Local workspace----------------------------- -! - real(r8) tmp1,tmp2 ! temporaries - real(r8) zxm(pmmax) ! m*2dt/(a*cos(lat)**2) - real(r8) zrcsj ! 1./(a*cos(lat)**2) -! real(r8) dtime ! timestep size [seconds] - real(r8) ztdtrc ! 2dt/(a*cos(lat)**2) 1dt/..... at nstep=0 - integer lm, mlength ! local Fourier wavenumber index - ! and number of local indices - integer k ! level index -! -! Set constants -! - mlength = numm(iam) -! dtime = get_step_size() - - zrcsj = 1._r8/(cs(irow)*rearth) - ztdtrc = ztodt*zrcsj - -! if (is_first_step()) then -! ztdtrc = dtime*zrcsj -! else -! ztdtrc = 2.0_r8*dtime*zrcsj -! end if -! -! Combine constants with Fourier wavenumber m -! - do lm=1,mlength - zxm(lm) = ztdtrc*xm(locm(lm,iam)) - end do -! -! Combine undifferentiated and longitudinal derivative terms for -! later use in Gaussian quadrature -! - do k=1,plev - do lm=1,mlength - grt1(2*lm-1,k) = grt1(2*lm-1,k) + zxm(lm)*grut1(2*lm,k) - grt1(2*lm,k) = grt1(2*lm,k) - zxm(lm)*grut1(2*lm-1,k) - grd1(2*lm-1,k) = grd1(2*lm-1,k) - zxm(lm)*grfu1(2*lm,k) - grd1(2*lm,k) = grd1(2*lm,k) + zxm(lm)*grfu1(2*lm-1,k) - grz1(2*lm-1,k) = grz1(2*lm-1,k) - zxm(lm)*grfv1(2*lm,k) - grz1(2*lm,k) = grz1(2*lm,k) + zxm(lm)*grfv1(2*lm-1,k) -! - grt2(2*lm-1,k) = grt2(2*lm-1,k) + zxm(lm)*grut2(2*lm,k) - grt2(2*lm,k) = grt2(2*lm,k) - zxm(lm)*grut2(2*lm-1,k) - grd2(2*lm-1,k) = grd2(2*lm-1,k) - zxm(lm)*grfu2(2*lm,k) - grd2(2*lm,k) = grd2(2*lm,k) + zxm(lm)*grfu2(2*lm-1,k) - grz2(2*lm-1,k) = grz2(2*lm-1,k) - zxm(lm)*grfv2(2*lm,k) - grz2(2*lm,k) = grz2(2*lm,k) + zxm(lm)*grfv2(2*lm-1,k) - end do - end do - - return - end subroutine dyn - diff --git a/src/dynamics/eul/dyn_comp.F90 b/src/dynamics/eul/dyn_comp.F90 deleted file mode 100644 index 1726b35f1b..0000000000 --- a/src/dynamics/eul/dyn_comp.F90 +++ /dev/null @@ -1,1177 +0,0 @@ -module dyn_comp -!----------------------------------------------------------------------- -! -! Eulerian dycore interface module -! -!----------------------------------------------------------------------- - -use shr_kind_mod, only: r8=>shr_kind_r8 - -use spmd_utils, only: masterproc, npes, mpicom, mpir8 - -use physconst, only: pi -use pmgrid, only: plon, plat, plev, plevp, plnlv, beglat, endlat -use commap, only: clat, clon -use dyn_grid, only: ptimelevels - - -use prognostics, only: n3, ps, u3, v3, t3, q3, phis, pdeld, dpsm, dpsl, div, vort - -use cam_control_mod, only: initial_run, moist_physics, adiabatic, simple_phys -use phys_control, only: phys_getopts -use constituents, only: pcnst, cnst_name, cnst_longname, sflxnam, tendnam, & - fixcnam, tottnam, hadvnam, vadvnam, cnst_get_ind, & - cnst_read_iv, qmin -use cam_initfiles, only: initial_file_get_id, topo_file_get_id, pertlim -use inic_analytic, only: analytic_ic_active, analytic_ic_set_ic -use dyn_tests_utils, only: vc_moist_pressure -use cam_history, only: addfld, add_default, horiz_only - -use eul_control_mod, only: dif2, hdif_order, kmnhdn, hdif_coef, divdampn, eps, & - kmxhdc, eul_nsplit - -use scamMod, only: single_column, use_camiop, have_u, have_v, & - have_cldliq, have_cldice, loniop, latiop, scmlat, scmlon, & - qobs,tobs,scm_cambfb_mode - -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, & - pio_inq_attlen, pio_inq_dimid, pio_inq_dimlen, & - pio_get_var,var_desc_t, pio_seterrorhandling, & - pio_bcast_error, pio_internal_error, pio_offset_kind - -#if (defined SPMD) -use spmd_dyn, only: spmd_readnl -#endif - -use cam_logfile, only: iulog -use cam_abortutils, only: endrun - -implicit none -private -save - -public :: & - dyn_import_t, & - dyn_export_t, & - dyn_readnl, & - dyn_register, & - dyn_init - -! these structures are not used in this dycore, but are included -! for interface compatibility. -type dyn_import_t - integer :: placeholder -end type dyn_import_t - -type dyn_export_t - integer :: placeholder -end type dyn_export_t - - -real(r8), allocatable :: ps_tmp (:,: ) -real(r8), allocatable :: phis_tmp(:,: ) -real(r8), allocatable :: q3_tmp (:,:,:) -real(r8), allocatable :: t3_tmp (:,:,:) -real(r8), allocatable :: arr3d_a (:,:,:) -real(r8), allocatable :: arr3d_b (:,:,:) - -logical readvar ! inquiry flag: true => variable exists on netCDF file - -!========================================================================================= -CONTAINS -!========================================================================================= - -subroutine dyn_readnl(nlfile) - - ! Read dynamics namelist group. - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_real8 - - ! args - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! local vars - integer :: unitn, ierr - - real(r8) :: eul_dif2_coef ! del2 horizontal diffusion coeff. - integer :: eul_hdif_order ! Order of horizontal diffusion operator - integer :: eul_hdif_kmnhdn ! Nth order horizontal diffusion operator top level. - real(r8) :: eul_hdif_coef ! Nth order horizontal diffusion coefficient. - real(r8) :: eul_divdampn ! Number of days to invoke divergence damper - real(r8) :: eul_tfilt_eps ! Time filter coefficient. Defaults to 0.06. - integer :: eul_kmxhdc ! Number of levels to apply Courant limiter - - namelist /dyn_eul_inparm/ eul_dif2_coef, eul_hdif_order, eul_hdif_kmnhdn, & - eul_hdif_coef, eul_divdampn, eul_tfilt_eps, eul_kmxhdc, eul_nsplit - - character(len=*), parameter :: sub = 'dyn_readnl' - !----------------------------------------------------------------------------- - - ! Read namelist - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'dyn_eul_inparm', status=ierr) - if (ierr == 0) then - read(unitn, dyn_eul_inparm, iostat=ierr) - if (ierr /= 0) then - call endrun(sub//': ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - - call mpi_bcast(eul_dif2_coef, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_dif2_coef") - - call mpi_bcast(eul_hdif_order, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_hdif_order") - - call mpi_bcast(eul_hdif_kmnhdn, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_hdif_kmnhdn") - - call mpi_bcast(eul_hdif_coef, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_hdif_coef") - - call mpi_bcast(eul_divdampn, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_divdampn") - - call mpi_bcast(eul_tfilt_eps, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_tfilt_eps") - - call mpi_bcast(eul_kmxhdc, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_kmxhdc") - - call mpi_bcast(eul_nsplit, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: eul_nsplit") - - dif2 = eul_dif2_coef - hdif_order = eul_hdif_order - kmnhdn = eul_hdif_kmnhdn - hdif_coef = eul_hdif_coef - divdampn = eul_divdampn - eps = eul_tfilt_eps - kmxhdc = eul_kmxhdc - - ! Write namelist variables to logfile - if (masterproc) then - - write(iulog,*) 'Eulerian Dycore Parameters:' - - - ! Order of diffusion - if (hdif_order < 2 .or. mod(hdif_order, 2) /= 0) then - write(iulog,*) sub//': Order of diffusion must be greater than 0 and multiple of 2' - write(iulog,*) 'hdif_order = ', hdif_order - call endrun(sub//': ERROR: invalid eul_hdif_order specified') - end if - - if (divdampn > 0._r8) then - write(iulog,*) ' Divergence damper for spectral dycore invoked for days 0. to ',divdampn,' of this case' - elseif (divdampn < 0._r8) then - call endrun (sub//': divdampn must be non-negative') - else - write(iulog,*) ' Divergence damper for spectral dycore NOT invoked' - endif - - if (kmxhdc >= plev .or. kmxhdc < 0) then - call endrun (sub//': ERROR: KMXHDC must be between 0 and plev-1') - end if - - write(iulog,9108) eps, hdif_order, kmnhdn, hdif_coef, kmxhdc, eul_nsplit - - if (kmnhdn > 1) then - write(iulog,9109) dif2 - end if - - end if - -#if (defined SPMD) - call spmd_readnl(nlfile) -#endif - -9108 format(' Time filter coefficient (EPS) ',f10.3,/,& - ' Horizontal diffusion order (N) ',i10/, & - ' Top layer for Nth order horizontal diffusion ',i10/, & - ' Nth order horizontal diffusion coefficient ',e10.3/, & - ' Number of levels Courant limiter applied ',i10/, & - ' Dynamics Subcycling ',i10) - -9109 format(' DEL2 horizontal diffusion applied above Nth order diffusion',/,& - ' DEL2 Horizontal diffusion coefficient (DIF2) ',e10.3) - - -end subroutine dyn_readnl - -!========================================================================================= - -subroutine dyn_register() -end subroutine dyn_register - -!========================================================================================= - -subroutine dyn_init(dyn_in, dyn_out) - - use prognostics, only: initialize_prognostics - use scanslt, only: scanslt_alloc - - 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 - - ! Arguments are not used in this dycore, included for compatibility - type(dyn_import_t), intent(out) :: dyn_in - type(dyn_export_t), intent(out) :: dyn_out - - ! Local workspace - integer :: m - integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. - logical :: history_amwg ! output for AMWG diagnostics - logical :: history_budget ! output tendencies and state variables for CAM4 - ! temperature, water vapor, cloud ice and cloud - ! liquid budgets. - integer :: history_budget_histfile_num ! output history file number for budget fields - !---------------------------------------------------------------------------- - - ! Initialize prognostics variables - call initialize_prognostics - call scanslt_alloc() - -#if (defined SPMD) - ! Allocate communication buffers for collective communications in realloc - ! routines and in dp_coupling. Call must come after phys_grid_init. - call spmdbuf () -#endif - - 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 - - call addfld ('ETADOT',(/ 'ilev' /),'A', '1/s','Vertical (eta) velocity', gridname='gauss_grid') - call addfld ('U&IC', (/ 'lev' /), 'I', 'm/s','Zonal wind', gridname='gauss_grid' ) - call addfld ('V&IC', (/ 'lev' /), 'I', 'm/s','Meridional wind', gridname='gauss_grid' ) - call add_default ('U&IC',0, 'I') - call add_default ('V&IC',0, 'I') - - call addfld ('PS&IC',horiz_only,'I', 'Pa','Surface pressure', gridname='gauss_grid' ) - call addfld ('T&IC',(/ 'lev' /),'I', 'K','Temperature', gridname='gauss_grid' ) - call add_default ('PS&IC',0, 'I') - call add_default ('T&IC',0, 'I') - - do m = 1, pcnst - call addfld (trim(cnst_name(m))//'&IC',(/ 'lev' /),'I', 'kg/kg',cnst_longname(m), gridname='gauss_grid' ) - call add_default(trim(cnst_name(m))//'&IC',0, 'I') - call addfld (hadvnam(m), (/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(m))//' horizontal advection tendency', & - gridname='gauss_grid') - call addfld (vadvnam(m), (/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(m))//' vertical advection tendency', & - gridname='gauss_grid') - call addfld (tendnam(m), (/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(m))//' total tendency', & - gridname='gauss_grid') - call addfld (tottnam(m), (/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(m))//' horz + vert + fixer tendency', & - gridname='gauss_grid') - call addfld (fixcnam(m), (/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(m))//' tendency due to slt fixer', & - gridname='gauss_grid') - end do - - call addfld ('DUH ',(/ 'lev' /),'A', 'K/s ','U horizontal diffusive heating', gridname='gauss_grid') - call addfld ('DVH ',(/ 'lev' /),'A', 'K/s ','V horizontal diffusive heating', gridname='gauss_grid') - call addfld ('DTH ',(/ 'lev' /),'A', 'K/s ','T horizontal diffusive heating', gridname='gauss_grid') - - call addfld ('ENGYCORR',(/ 'lev' /),'A', 'W/m2 ','Energy correction for over-all conservation', gridname='gauss_grid') - call addfld ('TFIX ',horiz_only ,'A', 'K/s ','T fixer (T equivalent of Energy correction)', gridname='gauss_grid') - - call addfld ('FU ',(/ 'lev' /),'A', 'm/s2 ','Zonal wind forcing term', gridname='gauss_grid') - call addfld ('FV ',(/ 'lev' /),'A', 'm/s2 ','Meridional wind forcing term', gridname='gauss_grid') - call addfld ('UTEND ',(/ 'lev' /),'A', 'm/s2 ','U tendency', gridname='gauss_grid') - call addfld ('VTEND ',(/ 'lev' /),'A', 'm/s2 ','V tendency', gridname='gauss_grid') - call addfld ('TTEND ',(/ 'lev' /),'A', 'K/s ','T tendency', gridname='gauss_grid') - call addfld ('LPSTEN ',horiz_only ,'A', 'Pa/s ','Surface pressure tendency', gridname='gauss_grid') - call addfld ('VAT ',(/ 'lev' /),'A', 'K/s ','Vertical advective tendency of T',gridname='gauss_grid') - call addfld ('KTOOP ',(/ 'lev' /),'A', 'K/s ','(Kappa*T)*(omega/P)', gridname='gauss_grid') - - call phys_getopts(history_amwg_out=history_amwg, & - history_budget_out = history_budget, & - history_budget_histfile_num_out = history_budget_histfile_num) - - if (history_amwg) then - call add_default ('DTH ', 1, ' ') - end if - - if ( history_budget ) then - if (.not.adiabatic) then - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - end if - ! The following variables are not defined for single column - if (.not. single_column) then - call add_default(hadvnam( 1), history_budget_histfile_num, ' ') - call add_default(vadvnam( 1), history_budget_histfile_num, ' ') - if (.not.adiabatic) then - call add_default(hadvnam(ixcldliq), history_budget_histfile_num, ' ') - call add_default(hadvnam(ixcldice), history_budget_histfile_num, ' ') - call add_default(vadvnam(ixcldliq), history_budget_histfile_num, ' ') - call add_default(vadvnam(ixcldice), history_budget_histfile_num, ' ') - end if - end if - call add_default(fixcnam( 1), history_budget_histfile_num, ' ') - call add_default(tottnam( 1), history_budget_histfile_num, ' ') - call add_default(tendnam( 1), history_budget_histfile_num, ' ') - if (.not.adiabatic) then - call add_default(fixcnam(ixcldliq), history_budget_histfile_num, ' ') - call add_default(fixcnam(ixcldice), history_budget_histfile_num, ' ') - call add_default(tottnam(ixcldliq), history_budget_histfile_num, ' ') - call add_default(tottnam(ixcldice), history_budget_histfile_num, ' ') - call add_default(tendnam(ixcldliq), history_budget_histfile_num, ' ') - call add_default(tendnam(ixcldice), history_budget_histfile_num, ' ') - end if - call add_default('TTEND', history_budget_histfile_num, ' ') - call add_default('TFIX', history_budget_histfile_num, ' ') - call add_default('KTOOP', history_budget_histfile_num, ' ') - call add_default('VAT', history_budget_histfile_num, ' ') - call add_default('DTH', history_budget_histfile_num, ' ') - end if - -end subroutine dyn_init - -!========================================================================================= -! Private routines -!========================================================================================= - -subroutine read_inidat() - ! Read initial dataset and spectrally truncate as appropriate. - ! Read and process the fields one at a time to minimize - ! memory usage. - - use ppgrid, only: begchunk, endchunk, pcols - use phys_grid, only: clat_p, clon_p - use comspe, only: alp, dalp - - use ncdio_atm, only: infld - - use iop, only: setiopupdate,readiopdata - - ! Local variables - - integer i,c,m,n,lat ! indices - integer ncol - integer ixcldice, ixcldliq ! indices into q3 array for cloud liq and cloud ice - - integer :: ierr, pio_errtype - integer :: lonid, latid - integer :: mlon, morec ! lon/lat dimension lengths from IC file - - type(file_desc_t), pointer :: fh_ini - - real(r8), pointer, dimension(:,:,:) :: convptr_2d - real(r8), pointer, dimension(:,:,:,:) :: convptr_3d - real(r8), pointer, dimension(:,:,:,:) :: cldptr - real(r8), pointer, dimension(:,: ) :: arr2d_tmp - real(r8), pointer, dimension(:,: ) :: arr2d - character*16 fieldname ! field name - - real(r8) :: clat2d(plon,plat),clon2d(plon,plat) - - ! variables for analytic initial conditions - integer, allocatable :: glob_ind(:) - integer :: m_cnst(1) - real(r8), allocatable :: q4_tmp(:,:,:,:) - - integer londimid,dimlon,latdimid,dimlat,latvarid,lonvarid - integer strt(3),cnt(3) - character(len=3), parameter :: arraydims3(3) = (/ 'lon', 'lev', 'lat' /) - character(len=3), parameter :: arraydims2(2) = (/ 'lon', 'lat' /) - type(var_desc_t) :: varid - real(r8), allocatable :: tmp2d(:,:) - - character(len=*), parameter :: sub='read_inidat' - !---------------------------------------------------------------------------- - - fh_ini => initial_file_get_id() - - allocate ( ps_tmp (plon,plat ) ) - allocate ( q3_tmp (plon,plev,plat) ) - allocate ( t3_tmp (plon,plev,plat) ) - allocate ( arr3d_a (plon,plev,plat) ) - allocate ( arr3d_b (plon,plev,plat) ) - - if (analytic_ic_active()) then - - allocate(glob_ind(plon * plat)) - m = 1 - do c = 1, plat - do i = 1, plon - ! Create a global column index - glob_ind(m) = i + (c-1)*plon - m = m + 1 - end do - end do - call analytic_ic_set_ic(vc_moist_pressure, clat(:), clon(:,1), & - glob_ind(:), U=arr3d_a, V=arr3d_b, T=t3_tmp, PS=ps_tmp, PHIS_IN=phis_tmp) - readvar = .false. - call process_inidat('PS') - call process_inidat('UV') - call process_inidat('T') - - allocate(q4_tmp(plon,plev,plat,1)) - do m = 1, pcnst - m_cnst(1) = m - call analytic_ic_set_ic(vc_moist_pressure, clat(:), clon(:,1), & - glob_ind(:), Q=q4_tmp, m_cnst=m_cnst) - arr3d_a(:,:,:) = q4_tmp(:,:,:,1) - call process_inidat('CONSTS', m_cnst=m, fh=fh_ini) - end do - deallocate(q4_tmp) - deallocate(glob_ind) - deallocate ( arr3d_a ) - deallocate ( arr3d_b ) - else - !--------------------- - ! Read required fields - !--------------------- - - call pio_seterrorhandling(fh_ini, PIO_BCAST_ERROR, pio_errtype) - - ierr = pio_inq_dimid(fh_ini, 'lon', lonid) - ierr = pio_inq_dimid(fh_ini, 'lat', latid) - ierr = pio_inq_dimlen(fh_ini, lonid, mlon) - ierr = pio_inq_dimlen(fh_ini, latid, morec) - if (.not. single_column .and. (mlon /= plon .or. morec /= plat)) then - write(iulog,*) sub//': ERROR: model parameters do not match initial dataset parameters' - write(iulog,*)'Model Parameters: plon = ',plon,' plat = ',plat - write(iulog,*)'Dataset Parameters: dlon = ',mlon,' dlat = ',morec - call endrun(sub//': ERROR: model parameters do not match initial dataset parameters') - end if - - call pio_seterrorhandling(fh_ini, pio_errtype) - !----------- - ! 3-D fields - !----------- - - fieldname = 'U' - call cam_pio_get_var(fieldname, fh_ini, arraydims3, arr3d_a, found=readvar) - if (.not. readvar) then - call endrun(sub//': ERROR: reading '//trim(fieldname)) - end if - - fieldname = 'V' - call cam_pio_get_var(fieldname, fh_ini, arraydims3, arr3d_b, found=readvar) - if (.not. readvar) then - call endrun(sub//': ERROR: reading '//trim(fieldname)) - end if - - call process_inidat('UV') - - fieldname = 'T' - call cam_pio_get_var(fieldname, fh_ini, arraydims3, t3_tmp, found=readvar) - if (.not. readvar) then - call endrun(sub//': ERROR: reading '//trim(fieldname)) - end if - - call process_inidat('T') - - ! Constituents (read and process one at a time) - - do m = 1,pcnst - - readvar = .false. - fieldname = cnst_name(m) - if (cnst_read_iv(m)) then - call cam_pio_get_var(fieldname, fh_ini, arraydims3, arr3d_a, found=readvar) - end if - call process_inidat('CONSTS', m_cnst=m, fh=fh_ini) - - end do - - deallocate ( arr3d_a ) - deallocate ( arr3d_b ) - - !----------- - ! 2-D fields - !----------- - - fieldname = 'PS' - call cam_pio_get_var(fieldname, fh_ini, arraydims2, ps_tmp, found=readvar) - if (.not. readvar) then - call endrun(sub//': ERROR: reading '//trim(fieldname)) - end if - call process_inidat('PS') - end if - - if (single_column) then - ps(:,:,1) = ps_tmp(:,:) - else - ! Integrals of mass, moisture and geopotential height - ! (fix mass of moisture as well) - call global_int - end if - - ! module data used in global_int - deallocate ( ps_tmp ) - deallocate ( phis_tmp ) - - if (single_column) then - if ( scm_cambfb_mode ) then - - fieldname = 'CLAT1' - call infld(fieldname, fh_ini, 'lon', 'lat', 1, pcols, begchunk, endchunk, & - clat2d, readvar, gridname='physgrid') - if (.not. readvar) then - call endrun('CLAT not on iop initial file') - else - clat(:) = clat2d(1,:) - clat_p(:)=clat(:) - end if - - fieldname = 'CLON1' - call infld(fieldname, fh_ini, 'lon', 'lat', 1, pcols, begchunk, endchunk, & - clon2d, readvar, gridname='physgrid') - if (.not. readvar) then - call endrun('CLON not on iop initial file') - else - clon = clon2d - clon_p(:)=clon(:,1) - end if - - ! Get latdeg/londeg from initial file for bfb calculations - ! needed for dyn_grid to determine bounding area and verticies - ierr = pio_inq_dimid (fh_ini, 'lon' , londimid) - ierr = pio_inq_dimlen (fh_ini, londimid, dimlon) - ierr = pio_inq_dimid (fh_ini, 'lat' , latdimid) - ierr = pio_inq_dimlen (fh_ini, latdimid, dimlat) - strt(:)=1 - cnt(1)=dimlon - cnt(2)=dimlat - cnt(3)=1 - allocate(latiop(dimlat)) - allocate(loniop(dimlon)) - allocate(tmp2d(dimlon,dimlat)) - ierr = pio_inq_varid (fh_ini,'CLAT1', varid) - ierr = pio_get_var(fh_ini,varid,strt,cnt,tmp2d) - latiop(:)=tmp2d(1,:) - ierr = pio_inq_varid (fh_ini,'CLON1', varid) - ierr = pio_get_var(fh_ini,varid,strt,cnt,tmp2d) - loniop(:)=tmp2d(:,1) - deallocate(tmp2d) - else - - ! Using a standard iop - make the default grid size is - ! 4x4 degree square for mo_drydep deposition.(standard ARM IOP area) - allocate(latiop(2)) - allocate(loniop(2)) - latiop(1)=(scmlat-2._r8)*pi/180_r8 - latiop(2)=(scmlat+2._r8)*pi/180_r8 - 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 - end if - end if - - deallocate ( q3_tmp ) - deallocate ( t3_tmp ) - - if (.not. single_column) then - deallocate ( alp ) - deallocate ( dalp ) - end if - - call copytimelevels() - -end subroutine read_inidat - -!========================================================================================= - -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 - character(len=3), parameter :: arraydims2(2) = (/ 'lon', 'lat' /) - - character(len=16) :: fieldname - - integer :: c, i, m - integer, allocatable :: glob_ind(:) - - character(len=*), parameter :: sub='set_phis' - !---------------------------------------------------------------------------- - - fh_topo => topo_file_get_id() - - allocate( phis_tmp(plon,plat) ) - - readvar = .false. - - if (associated(fh_topo)) then - - call pio_seterrorhandling(fh_topo, PIO_BCAST_ERROR, pio_errtype) - - ierr = pio_inq_dimid(fh_topo, 'lon', lonid) - ierr = pio_inq_dimid(fh_topo, 'lat', latid) - ierr = pio_inq_dimlen(fh_topo, lonid, mlon) - ierr = pio_inq_dimlen(fh_topo, latid, morec) - if (.not. single_column .and. (mlon /= plon .or. morec /= plat)) then - write(iulog,*) sub//': ERROR: model parameters do not match initial dataset parameters' - write(iulog,*)'Model Parameters: plon = ',plon,' plat = ',plat - write(iulog,*)'Dataset Parameters: dlon = ',mlon,' dlat = ',morec - call endrun(sub//': ERROR: model parameters do not match initial dataset parameters') - end if - call pio_seterrorhandling(fh_topo, pio_errtype) - - fieldname = 'PHIS' - call cam_pio_get_var(fieldname, fh_topo, arraydims2, phis_tmp, found=readvar) - if (.not. readvar) then - call endrun(sub//': ERROR: reading '//trim(fieldname)) - end if - - else if (analytic_ic_active()) then - - allocate(glob_ind(plon*plat)) - m = 1 - do c = 1, plat - do i = 1, plon - ! Create a global column index - glob_ind(m) = i + (c-1)*plon - m = m + 1 - end do - end do - call analytic_ic_set_ic(vc_moist_pressure, clat(:), clon(:,1), & - glob_ind(:), PHIS_OUT=phis_tmp) - - deallocate(glob_ind) - - else - - phis_tmp(:,:) = 0._r8 - - end if - - call process_inidat('PHIS', fh=fh_topo) - -end subroutine set_phis - -!========================================================================================= - -subroutine process_inidat(fieldname, m_cnst, fh) - -! Post-process input fields - - use commap - use comspe - use spetru - use dyn_grid, only: get_horiz_grid_dim_d - use const_init, only: cnst_init_default - use qneg_module, only: qneg3 - -#if ( defined SPMD ) - use spmd_dyn, only: compute_gsfactors -#endif - - ! arguments - character(len=*), intent(in) :: fieldname ! fields to be processed - integer, intent(in), optional :: m_cnst ! constituent index - type(file_desc_t), intent(inout), optional :: fh ! pio file handle - - !---------------------------Local workspace----------------------------- - - integer i,j,k,n,lat,irow ! grid and constituent indices - integer :: nglon, nglat, rndm_seed_sz ! For pertlim - integer, allocatable :: rndm_seed(:) ! For pertlim - real(r8) pertval ! perturbation value - integer varid ! netCDF variable id - integer ret - integer(pio_offset_kind) :: attlen ! netcdf return values - logical phis_hires ! true => PHIS came from hi res topo - character*256 text - character*256 trunits ! tracer untis - - real(r8), pointer, dimension(:,:,:) :: q_tmp - real(r8), pointer, dimension(:,:,:) :: tmp3d_a, tmp3d_b, tmp3d_extend - real(r8), pointer, dimension(:,: ) :: tmp2d_a, tmp2d_b - -#if ( defined BFB_CAM_SCAM_IOP ) - real(r8), allocatable :: ps_sav(:,:) - real(r8), allocatable :: u3_sav(:,:,:) - real(r8), allocatable :: v3_sav(:,:,:) -#endif - -#if ( defined SPMD ) - integer :: numperlat ! number of values per latitude band - integer :: numsend(0:npes-1) ! number of items to be sent - integer :: numrecv ! number of items to be received - integer :: displs(0:npes-1) ! displacement array -#endif - character(len=*), parameter :: sub='process_inidat' - !---------------------------------------------------------------------------- - - select case (fieldname) - - !------------ - ! Process U/V - !------------ - - case ('UV') - - allocate ( tmp3d_a(plon,plev,plat) ) - allocate ( tmp3d_b(plon,plev,plat) ) - - ! Spectral truncation - - if (single_column) then - tmp3d_a(:,:,:) = 0._r8 - tmp3d_b(:,:,:) = 0._r8 - else -#if (( defined BFB_CAM_SCAM_IOP ) && ( ! defined DO_SPETRU )) - allocate ( u3_sav (plon,plev,plat) ) - allocate ( v3_sav (plon,plev,plat) ) - u3_sav(:plon,:plev,:plat) = arr3d_a(:plon,:plev,:plat) - v3_sav(:plon,:plev,:plat) = arr3d_b(:plon,:plev,:plat) - call spetru_uv(u3_sav ,v3_sav ,vort=tmp3d_a, div=tmp3d_b) - deallocate ( u3_sav ) - deallocate ( v3_sav ) -#else - call spetru_uv(arr3d_a ,arr3d_b ,vort=tmp3d_a, div=tmp3d_b) -#endif - end if - -#if ( defined SPMD ) - numperlat = plnlv - call compute_gsfactors (numperlat, numrecv, numsend, displs) - - call mpiscatterv (arr3d_a ,numsend, displs, mpir8,u3 (:,:,beglat:endlat,1) ,numrecv, mpir8,0,mpicom) - call mpiscatterv (arr3d_b ,numsend, displs, mpir8,v3 (:,:,beglat:endlat,1) ,numrecv, mpir8,0,mpicom) - call mpiscatterv (tmp3d_a ,numsend, displs, mpir8,vort(:,:,beglat:endlat,1) ,numrecv, mpir8,0,mpicom) - call mpiscatterv (tmp3d_b ,numsend, displs, mpir8,div (:,:,beglat:endlat,1) ,numrecv, mpir8,0,mpicom) -#else - u3 (:,:,:,1) = arr3d_a(:plon,:plev,:plat) - v3 (:,:,:,1) = arr3d_b(:plon,:plev,:plat) - vort (:,:,:,1) = tmp3d_a(:,:,:) - div (:,:,:,1) = tmp3d_b(:,:,:) -#endif - deallocate ( tmp3d_a ) - deallocate ( tmp3d_b ) - - !---------- - ! Process T - !---------- - - case ('T') - - ! Add random perturbation to temperature if required - - if (pertlim .ne. 0.0_r8) then - if (masterproc) write(iulog,*) sub//': INFO: Adding random perturbation bounded by +/-', & - pertlim,' to initial temperature field' - - call get_horiz_grid_dim_d(nglon, nglat) - call random_seed(size=rndm_seed_sz) - allocate(rndm_seed(rndm_seed_sz)) - - do lat = 1, plat - do i = 1, plon - ! seed random_number generator based on global column index - rndm_seed = i + (lat-1)*nglon - call random_seed(put=rndm_seed) - do k = 1, plev - call random_number (pertval) - pertval = 2._r8*pertlim*(0.5_r8 - pertval) - t3_tmp(i,k,lat) = t3_tmp(i,k,lat)*(1._r8 + pertval) - end do - end do - end do - deallocate(rndm_seed) - end if - - ! Spectral truncation - - if (.not. single_column) then -#if ( ( ! defined BFB_CAM_SCAM_IOP ) || ( defined DO_SPETRU ) ) - call spetru_3d_scalar(t3_tmp) -#endif - end if - -#if ( defined SPMD ) - numperlat = plnlv - call compute_gsfactors (numperlat, numrecv, numsend, displs) - call mpiscatterv (t3_tmp ,numsend, displs, mpir8,t3(:,:,beglat:endlat,1) ,numrecv, mpir8,0,mpicom) -#else - t3 (:,:,:,1) = t3_tmp(:plon,:plev,:plat) -#endif - - !--------------------- - ! Process Constituents - !--------------------- - - case ('CONSTS') - - if (.not. present(m_cnst)) then - call endrun(sub//': ERROR: m_cnst needs to be present in the'// & - ' argument list') - end if - - allocate(tmp3d_extend(plon,plev,beglat:endlat)) - - if (readvar) then - ! Check that all tracer units are in mass mixing ratios - ret = pio_inq_varid(fh, cnst_name(m_cnst), varid) - ret = pio_get_att(fh, varid, 'units', trunits) - if (trunits(1:5) .ne. 'KG/KG' .and. trunits(1:5) .ne. 'kg/kg') then - call endrun(sub//': ERROR: Units for tracer ' & - //trim(cnst_name(m_cnst))//' must be in KG/KG') - end if - - else if (.not. analytic_ic_active()) then - - ! Constituents not read from initial file are initialized by the - ! package that implements them. Note that the analytic IC code calls - ! cnst_init_default internally - - if (m_cnst == 1 .and. moist_physics) then - call endrun(sub//': ERROR: Q must be on Initial File') - end if - - call cnst_init_default(m_cnst, clat, clon(:,1), arr3d_a) - end if - -!$omp parallel do private(lat) - do lat = 1,plat - call qneg3(sub, lat, plon, plon, plev , & - m_cnst, m_cnst, qmin(m_cnst) ,arr3d_a(1,1,lat)) - end do - - ! if "Q", "CLDLIQ", or "CLDICE", save off for later use - if (m_cnst == 1) q3_tmp(:plon,:,:) = arr3d_a(:plon,:,:) - -#if ( defined SPMD ) - numperlat = plnlv - call compute_gsfactors(numperlat, numrecv, numsend, displs) - call mpiscatterv(arr3d_a, numsend, displs, mpir8, tmp3d_extend, numrecv, mpir8,0,mpicom) - q3(:,:,m_cnst,:,1) = tmp3d_extend(:,:,beglat:endlat) -#else - q3(:,:plev,m_cnst,:,1) = arr3d_a(:plon,:plev,:plat) -#endif - deallocate ( tmp3d_extend ) - - !----------- - ! Process PS - !----------- - - case ('PS') - - allocate ( tmp2d_a(plon,plat) ) - allocate ( tmp2d_b(plon,plat) ) - - ! Spectral truncation - - if (single_column) then - tmp2d_a(:,:) = 0._r8 - tmp2d_b(:,:) = 0._r8 - else -#if (( defined BFB_CAM_SCAM_IOP ) && ( ! defined DO_SPETRU )) - allocate ( ps_sav(plon,plat) ) - ps_sav(:plon,:plat)=ps_tmp(:plon,:plat) - call spetru_ps(ps_sav, tmp2d_a, tmp2d_b) - deallocate ( ps_sav ) -#else - call spetru_ps(ps_tmp, tmp2d_a, tmp2d_b) -#endif - end if - -#if ( defined SPMD ) - numperlat = plon - call compute_gsfactors (numperlat, numrecv, numsend, displs) - call mpiscatterv (tmp2d_a ,numsend, displs, mpir8,dpsl ,numrecv, mpir8,0,mpicom) - call mpiscatterv (tmp2d_b ,numsend, displs, mpir8,dpsm ,numrecv, mpir8,0,mpicom) -#else - dpsl(:,:) = tmp2d_a(:,:) - dpsm(:,:) = tmp2d_b(:,:) -#endif - deallocate ( tmp2d_a ) - deallocate ( tmp2d_b ) - - !------------- - ! Process PHIS - !------------- - - case ('PHIS') - - ! Check for presence of 'from_hires' attribute to decide whether to filter - if (readvar) then - ret = pio_inq_varid (fh, 'PHIS', varid) - ! Allow pio to return errors in case from_hires doesn't exist - call pio_seterrorhandling(fh, PIO_BCAST_ERROR) - ret = pio_inq_attlen (fh, varid, 'from_hires', attlen) - if (ret.eq.PIO_NOERR .and. attlen.gt.256) then - call endrun(sub//': ERROR: from_hires attribute length is too long') - end if - ret = pio_get_att(fh, varid, 'from_hires', text) - - if (ret.eq.PIO_NOERR .and. text(1:4).eq.'true') then - phis_hires = .true. - if(masterproc) write(iulog,*) sub//': INFO: Will filter input PHIS: attribute from_hires is true' - else - phis_hires = .false. - if(masterproc) write(iulog,*) sub//': INFO: Will not filter input PHIS: attribute ', & - 'from_hires is either false or not present' - end if - call pio_seterrorhandling(fh, PIO_INTERNAL_ERROR) - - else - phis_hires = .false. - - end if - - ! Spectral truncation - - if (.not. single_column) then -#if (( ! defined BFB_CAM_SCAM_IOP ) || ( defined DO_SPETRU )) - call spetru_phis(phis_tmp, phis_hires) -#endif - end if - -#if ( defined SPMD ) - numperlat = plon - call compute_gsfactors (numperlat, numrecv, numsend, displs) - call mpiscatterv (phis_tmp ,numsend, displs, mpir8,phis ,numrecv, mpir8,0,mpicom) -#else - phis = phis_tmp -#endif - - end select - -end subroutine process_inidat - -!========================================================================================= - -subroutine global_int() - - ! Compute global integrals of mass, moisture and geopotential height - ! and fix mass of atmosphere - - use commap - use physconst, only: gravit -#if ( defined SPMD ) - use mpishorthand - use spmd_dyn, only: compute_gsfactors - use spmd_utils, only: npes -#endif - use hycoef, only: hyai, ps0 - use eul_control_mod, only: pdela, qmass1, tmassf, fixmas, & - tmass0, zgsint, qmass2, qmassf - use inic_analytic, only: analytic_ic_active - - !---------------------------Local workspace----------------------------- - - integer i,k,lat,ihem,irow ! grid indices - real(r8) pdelb(plon,plev) ! pressure diff between interfaces - ! using "B" part of hybrid grid only - real(r8) pssum ! surface pressure sum - real(r8) dotproda ! dot product - real(r8) dotprodb ! dot product - real(r8) zgssum ! partial sums of phis - real(r8) hyad (plev) ! del (A) - real(r8) tmassf_tmp ! Global mass integral - real(r8) qmass1_tmp ! Partial Global moisture mass integral - real(r8) qmass2_tmp ! Partial Global moisture mass integral - real(r8) qmassf_tmp ! Global moisture mass integral - real(r8) zgsint_tmp ! Geopotential integral - - integer platov2 ! plat/2 or plat (if in scm mode) -#if ( defined SPMD ) - integer :: numperlat ! number of values per latitude band - integer :: numsend(0:npes-1) ! number of items to be sent - integer :: numrecv ! number of items to be received - integer :: displs(0:npes-1) ! displacement array -#endif - - type(file_desc_t), pointer :: fh_topo - - character(len=*), parameter :: sub='global_int' - !----------------------------------------------------------------------- - - fh_topo => topo_file_get_id() - - if (masterproc) then - - ! Initialize mass and moisture integrals for summation - ! in a third calculation loop (assures bit-for-bit compare - ! with non-random history tape). - - tmassf_tmp = 0._r8 - qmass1_tmp = 0._r8 - qmass2_tmp = 0._r8 - zgsint_tmp = 0._r8 - - ! Compute pdel from "A" portion of hybrid vertical grid for later use in global integrals - do k = 1,plev - hyad(k) = hyai(k+1) - hyai(k) - end do - do k = 1,plev - do i = 1,plon - pdela(i,k) = hyad(k)*ps0 - end do - end do - - ! Compute integrals of mass, moisture, and geopotential height - if (single_column) then - platov2 = 1 - else - platov2 = plat/2 - endif - do irow = 1,platov2 - do ihem = 1,2 - if (ihem.eq.1) then - lat = irow - else - lat = plat - irow + 1 - end if - - ! Accumulate average mass of atmosphere - call pdelb0 (ps_tmp(1,lat), pdelb, plon) - pssum = 0._r8 - do i = 1, plon - pssum = pssum + ps_tmp (i,lat) - end do - tmassf_tmp = tmassf_tmp + w(irow)*pssum/plon - - zgssum = 0._r8 - do i = 1, plon - zgssum = zgssum + phis_tmp(i,lat) - end do - zgsint_tmp = zgsint_tmp + w(irow)*zgssum/plon - - ! Calculate global integrals needed for water vapor adjustment - do k = 1,plev - dotproda = 0._r8 - dotprodb = 0._r8 - do i = 1, plon - dotproda = dotproda + q3_tmp(i,k,lat)*pdela(i,k) - dotprodb = dotprodb + q3_tmp(i,k,lat)*pdelb(i,k) - end do - qmass1_tmp = qmass1_tmp + w(irow)*dotproda/plon - qmass2_tmp = qmass2_tmp + w(irow)*dotprodb/plon - end do - end do - end do ! end of latitude loop - - ! Normalize average mass, height - tmassf_tmp = tmassf_tmp*.5_r8/gravit - qmass1_tmp = qmass1_tmp*.5_r8/gravit - qmass2_tmp = qmass2_tmp*.5_r8/gravit - zgsint_tmp = zgsint_tmp*.5_r8/gravit - qmassf_tmp = qmass1_tmp + qmass2_tmp - - if (simple_phys) then - tmass0 = tmassf_tmp - qmassf_tmp - else - ! Globally avgd sfc. partial pressure of dry air (i.e. global dry mass): - tmass0 = 98222._r8/gravit - if (.not. associated(fh_topo)) tmass0 = (101325._r8-245._r8)/gravit - end if - - if (masterproc) then - write(iulog,*) sub//': INFO:' - write(iulog,*) ' Mass of initial data before correction = ', tmassf_tmp - write(iulog,*) ' Dry mass will be held at = ', tmass0 - write(iulog,*) ' Mass of moisture after removal of negatives = ', qmassf_tmp - write(iulog,*) ' Globally averaged geopotential height (m) = ', zgsint_tmp - end if - - if (simple_phys) then - fixmas = 1._r8 - else - ! Compute and apply an initial mass fix factor which preserves horizontal - ! gradients of ln(ps). - fixmas = (tmass0 + qmass1_tmp)/(tmassf_tmp - qmass2_tmp) - ps_tmp = ps_tmp*fixmas - end if - - ! Global integerals - tmassf = tmassf_tmp - qmass1 = qmass1_tmp - qmass2 = qmass2_tmp - qmassf = qmassf_tmp - zgsint = zgsint_tmp - - end if ! end of if-masterproc - -#if ( defined SPMD ) - call mpibcast (tmass0,1,mpir8,0,mpicom) - call mpibcast (tmassf,1,mpir8,0,mpicom) - call mpibcast (qmass1,1,mpir8,0,mpicom) - call mpibcast (qmass2,1,mpir8,0,mpicom) - call mpibcast (qmassf,1,mpir8,0,mpicom) - call mpibcast (zgsint,1,mpir8,0,mpicom) - - numperlat = plon - call compute_gsfactors(numperlat, numrecv, numsend, displs) - call mpiscatterv(ps_tmp, numsend, displs, mpir8, ps(:,beglat:endlat,1), numrecv, & - mpir8, 0, mpicom) -#else - ps(:,:,1) = ps_tmp(:,:) -#endif - -end subroutine global_int - -!========================================================================================= - -subroutine copytimelevels() - - !---------------------------Local variables----------------------------- - - integer n,i,k,lat ! index - real(r8) pdel(plon,plev) ! pressure arrays needed to calculate - real(r8) pint(plon,plevp) ! pdeld - real(r8) pmid(plon,plev) ! - - ! If dry-type tracers are present, initialize pdeld - ! First, set current time pressure arrays for model levels etc. to get pdel - do lat = beglat, endlat - call plevs0(plon, plon, plev, ps(:,lat,1), pint, pmid, pdel) - do k = 1, plev - do i = 1, plon - pdeld(i,k,lat,1) = pdel(i,k)*(1._r8-q3(i,k,1,lat,1)) - end do - end do - end do - - ! Make all time levels of prognostics contain identical data. - ! Fields to be convectively adjusted only *require* n3 time - ! level since copy gets done in linems. - do n = 2, ptimelevels - ps(:,:,n) = ps(:,:,1) - u3(:,:,:,n) = u3(:,:,:,1) - v3(:,:,:,n) = v3(:,:,:,1) - t3(:,:,:,n) = t3(:,:,:,1) - q3(1:plon,:,:,:,n) = q3(1:plon,:,:,:,1) - vort(:,:,:,n) = vort(:,:,:,1) - div(:,:,:,n) = div(:,:,:,1) - pdeld(1:plon,:,:,n) = pdeld(1:plon,:,:,1) - end do - -end subroutine copytimelevels - -!========================================================================================= - -end module dyn_comp diff --git a/src/dynamics/eul/dyn_grid.F90 b/src/dynamics/eul/dyn_grid.F90 deleted file mode 100644 index e8cd67b0a0..0000000000 --- a/src/dynamics/eul/dyn_grid.F90 +++ /dev/null @@ -1,1198 +0,0 @@ -module dyn_grid -!----------------------------------------------------------------------- -! -! Define grid and decomposition for Eulerian spectral dynamics. -! -! Original code: John Drake and Patrick Worley -! -!----------------------------------------------------------------------- - -use shr_kind_mod, only: r8 => shr_kind_r8 -use pmgrid, only: plat, plev, plon, plevp -use physconst, only: rair, rearth, ra -use spmd_utils, only: masterproc, iam - -use pio, only: file_desc_t -use cam_initfiles, only: initial_file_get_id - -use cam_abortutils, only: endrun -use cam_logfile, only: iulog - -#if (defined SPMD) -use spmd_dyn, only: spmdinit_dyn -#endif - -implicit none -private -save - -public :: & - dyn_grid_init, & - dyn_grid_find_gcols, &! find nearest column for given lat/lon - dyn_grid_get_colndx, &! global lat and lon coordinate and MPI process indices - ! corresponding to a specified global column index - dyn_grid_get_elem_coords, &! coordinates of a specified element (latitude) - ! of the dynamics grid (lat slice of the block) - get_block_bounds_d, &! first and last indices in global block ordering - get_block_gcol_d, &! global column indices for given block - get_block_gcol_cnt_d, &! number of columns in given block - get_block_levels_d, &! vertical levels in column - get_block_lvl_cnt_d, &! number of vertical levels in column - get_block_owner_d, &! process "owning" given block - get_dyn_grid_parm, & - get_dyn_grid_parm_real1d, & - get_gcol_block_d, &! global block indices and local columns - ! index for given global column index - get_gcol_block_cnt_d, &! number of blocks containing data - ! from a given global column index - get_horiz_grid_d, &! horizontal grid coordinates - get_horiz_grid_dim_d, &! horizontal dimensions of dynamics grid - physgrid_copy_attributes_d - -! The Eulerian dynamics grids -integer, parameter, public :: dyn_decomp = 101 - -integer, parameter, public :: ptimelevels = 3 ! number of time levels in the dycore - -integer :: ngcols_d = 0 ! number of dynamics columns - -!======================================================================================== -contains -!======================================================================================== - -subroutine dyn_grid_init - - ! Initialize dynamics grid - - use pspect, only: ptrm, ptrn, ptrk, pnmax, pmmax, pspt - use comspe, only: lpspt, numm, locm, lnstart, nstart, nlen, & - alp, dalp, lalp, ldalp - use scanslt, only: nlonex, platd, j1 - use gauaw_mod, only: gauaw - use commap, only: sq, rsq, slat, w, cs, href, ecref, clat, clon, & - 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 ref_pres, only: ref_pres_init - use eul_control_mod, only: ifax, trig, eul_nsplit - - ! Local variables - type(file_desc_t), pointer :: fh_ini - - real(r8) zsi(plat) ! sine of latitudes - real(r8) zw(plat) ! Gaussian weights - real(r8) zra2 ! ra squared - real(r8) zalp(2*pspt) ! Legendre function array - real(r8) zdalp(2*pspt) ! Derivative array - real(r8) zslat ! sin of lat and cosine of colatitude - - integer i ! longitude index - integer j ! Latitude index - integer k ! Level index - integer kk ! Level index - integer kkk ! Level index - integer m,lm,mr,lmr ! Indices for legendre array - integer n ! Index for legendre array - integer nkk ! Print control variables - integer ik1 ! Print index temporary variable - integer ik2 ! Print index temporary variable - integer itmp ! Dimension of polynomial arrays temporary. - integer iter ! Iteration index - real(r8) :: zdt ! Time step for settau - - integer :: irow ! Latitude pair index - integer :: lat ! Latitude index - - real(r8) :: xlat ! Latitude (radians) - real(r8) :: pi ! Mathematical pi (3.14...) - real(r8) :: dtime ! timestep size [seconds] - - character(len=*), parameter :: sub='dyn_grid_init' - !----------------------------------------------------------------------- - - ! File handle for initial file. Needed for vertical coordinate data. - fh_ini => initial_file_get_id() - - ! Compute truncation parameters - call trunc() - -#if (defined SPMD) - call spmdinit_dyn() -#endif - - ! Initialize hybrid coordinate arrays - call hycoef_init(fh_ini) - - ! Initialize reference pressures - call ref_pres_init(hypi, hypm, nprlev) - - - dtime = get_step_size() - zdt = dtime/eul_nsplit - - ! Initialize horizontal diffusion coefficients - call hdinti(rearth, zdt) - - if (.not. single_column) then - - if (pmmax > plon/2) then - call endrun (sub//': ERROR: mmax=ptrm+1 .gt. plon/2') - end if - end if - - ! NMAX dependent arrays - zra2 = ra*ra - do j = 2, pnmax - sq(j) = j*(j-1)*zra2 - rsq(j) = 1._r8/sq(j) - end do - sq(1) = 0._r8 - rsq(1) = 0._r8 - - ! MMAX dependent arrays - do j = 1, pmmax - xm(j) = j-1 - end do - - ! Integration matrices of hydrostatic equation(href) and conversion - ! term(a). href computed as in ccm0 but isothermal bottom ecref - ! calculated to conserve energy - - do k = 1, plev - do kk = 1, plev - href(kk,k) = 0._r8 - ecref(kk,k) = 0._r8 - end do - end do - - ! Mean atmosphere energy conversion term is consistent with continiuty - ! Eq. In ecref, 1st index = column; 2nd index = row of matrix. - ! Mean atmosphere energy conversion term is energy conserving - - do k = 1, plev - ecref(k,k) = 0.5_r8/hypm(k) * hypd(k) - do kk = 1, k-1 - ecref(kk,k) = 1._r8/hypm(k) * hypd(kk) - end do - end do - - ! Reference hydrostatic integration matrix consistent with conversion - ! term for energy conservation. In href, 1st index = column; - ! 2nd index = row of matrix. - - do k = 1, plev - do kk = k, plev - href(kk,k) = ecref(k,kk)*hypd(kk)/hypd(k) - end do - end do - - href = href*rair - - if (single_column) then - - do j = 1, plat - slat(j) = 1.0_r8 * sin(4.0_r8*atan(1.0_r8)*scmlat/180._r8) - w(j) = 2.0_r8/plat - cs(j) = 10._r8 - slat(j)*slat(j) - end do - - xlat = asin(slat(1)) - clat(1) = xlat - - clat(1)=scmlat*atan(1._r8)/45._r8 - latdeg(1) = clat(1)*45._r8/atan(1._r8) - clon(1,1) = 4.0_r8*atan(1._r8)*mod((scmlon+360._r8),360._r8)/180._r8 - londeg(1,1) = mod((scmlon+360._r8),360._r8) - - else - - ! Gaussian latitude dependent arrays - call gauaw(zsi, zw, plat) - do irow = 1, plat/2 - slat(irow) = zsi(irow) - w(irow) = zw(irow) - w(plat-irow+1) = zw(irow) - cs(irow) = 1._r8 - zsi(irow)*zsi(irow) - xlat = asin(slat(irow)) - clat(irow) = -xlat - clat(plat-irow+1) = xlat - end do - - do lat = 1, plat - latdeg(lat) = clat(lat)*45._r8/atan(1._r8) - end do - - ! Compute constants related to Legendre transforms - ! Compute and reorder ALP and DALP - - allocate(alp(pspt,plat/2)) - allocate(dalp(pspt,plat/2)) - - do j = 1, plat/2 - zslat = slat(j) - itmp = 2*pspt - 1 - call phcs(zalp, zdalp, itmp, zslat) - call reordp(j, itmp, zalp, zdalp) - end do - - ! Copy and save local ALP and DALP - - allocate(lalp(lpspt,plat/2)) - allocate(ldalp(lpspt,plat/2)) - - do j = 1, plat/2 - do lm = 1, numm(iam) - m = locm(lm,iam) - mr = nstart(m) - lmr = lnstart(lm) - do n = 1, nlen(m) - lalp(lmr+n,j) = alp(mr+n,j) - ldalp(lmr+n,j) = dalp(mr+n,j) - end do - end do - end do - - ! Mirror latitudes south of south pole - - lat = 1 - do j = j1-2, 1, -1 - nlonex(j) = plon - lat = lat + 1 - end do - nlonex(j1-1) = plon ! south pole - - ! Real latitudes - - j = j1 - do lat = 1, plat - nlonex(j) = plon - j = j + 1 - end do - nlonex(j1+plat) = plon ! north pole - - ! Mirror latitudes north of north pole - - lat = plat - do j = j1+plat+1, platd - nlonex(j) = plon - lat = lat - 1 - end do - - ! Longitude array - - pi = 4.0_r8*atan(1.0_r8) - do lat = 1, plat - do i = 1, plon - londeg(i,lat) = (i-1)*360._r8/plon - clon(i,lat) = (i-1)*2.0_r8*pi/plon - end do - end do - - ! Set up trigonometric tables for fft - - do j = 1, plat - call set99(trig(1,j), ifax(1,j), plon) - end do - end if - - ! Define the CAM grids (must be before addfld calls) - call define_cam_grids() - - if (masterproc) then - write(iulog,*) ' ' - write(iulog,*) 'EULERIAN dycore -- Done grid and decomposition initialization' - write(iulog,*) ' Truncation Parameters: M =',ptrm,' N =',ptrn,' K =',ptrk - write(iulog,*) ' zdt, dtime=', zdt, dtime - write(iulog,*) ' ' - end if - -end subroutine dyn_grid_init - -!======================================================================================== - - subroutine get_block_bounds_d(block_first,block_last) - -!----------------------------------------------------------------------- -! -! -! Purpose: Return first and last indices used in global block ordering -! -! Method: -! -! Author: Patrick Worley -! -!----------------------------------------------------------------------- - use pmgrid, only: plat - - implicit none -!------------------------------Arguments-------------------------------- - integer, intent(out) :: block_first ! first (global) index used for blocks - integer, intent(out) :: block_last ! last (global) index used for blocks - -!----------------------------------------------------------------------- -! latitude slice block - block_first = 1 - block_last = plat - - return - end subroutine get_block_bounds_d - -! -!======================================================================== -! - subroutine get_block_gcol_d(blockid,size,cdex) - -!----------------------------------------------------------------------- -! -! -! Purpose: Return list of dynamics column indices in given block -! -! Method: -! -! Author: Patrick Worley -! -!----------------------------------------------------------------------- - use pmgrid, only: plat, plon - - implicit none -!------------------------------Arguments-------------------------------- - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: size ! array size - - integer, intent(out):: cdex(size) ! global column indices -!---------------------------Local workspace----------------------------- -! - integer i,j ! loop indices - integer n ! column index -!----------------------------------------------------------------------- -! block == latitude slice - if (size < plon) then - write(iulog,*)'GET_BLOCK_GCOL_D: array not large enough (', & - size,' < ',plon,' ) ' - call endrun - else - n = (blockid-1)*plon - do i = 1,plon - n = n + 1 - cdex(i) = n - end do - end if -! - return - end subroutine get_block_gcol_d -! -!======================================================================== -! - integer function get_block_gcol_cnt_d(blockid) - -!----------------------------------------------------------------------- -! -! -! Purpose: Return number of dynamics columns in indicated block -! -! Method: -! -! Author: Patrick Worley -! -!----------------------------------------------------------------------- - use pmgrid, only: plon - - implicit none -!------------------------------Arguments-------------------------------- - integer, intent(in) :: blockid ! global block id - -!----------------------------------------------------------------------- -! latitude slice block - get_block_gcol_cnt_d = plon - - return - end function get_block_gcol_cnt_d - -! -!======================================================================== -! - integer function get_block_lvl_cnt_d(blockid,bcid) - -!----------------------------------------------------------------------- -! -! -! Purpose: Return number of levels in indicated column. If column -! includes surface fields, then it is defined to also -! include level 0. -! -! Method: -! -! Author: Patrick Worley -! -!----------------------------------------------------------------------- - - implicit none -!------------------------------Arguments-------------------------------- - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: bcid ! column index within block - -!----------------------------------------------------------------------- -! latitude slice block - get_block_lvl_cnt_d = plev + 1 - - return - end function get_block_lvl_cnt_d -! -!======================================================================== -! - subroutine get_block_levels_d(blockid, bcid, lvlsiz, levels) - -!----------------------------------------------------------------------- -! -! -! Purpose: Return level indices in indicated column. If column -! includes surface fields, then it is defined to also -! include level 0. -! -! Method: -! -! Author: Patrick Worley -! -!----------------------------------------------------------------------- - - implicit none -!------------------------------Arguments-------------------------------- - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: bcid ! column index within block - integer, intent(in) :: lvlsiz ! dimension of levels array - - integer, intent(out) :: levels(lvlsiz) ! levels indices for block - -!---------------------------Local workspace----------------------------- -! - integer k ! loop index -!----------------------------------------------------------------------- -! latitude slice block - if (lvlsiz < plev + 1) then - write(iulog,*)'GET_BLOCK_LEVELS_D: levels array not large enough (', & - lvlsiz,' < ',plev + 1,' ) ' - call endrun - else - do k=0,plev - levels(k+1) = k - end do - do k=plev+2,lvlsiz - levels(k) = -1 - end do - end if - - return - end subroutine get_block_levels_d - -! -!======================================================================== -! - subroutine get_gcol_block_d(gcol,cnt,blockid,bcid,localblockid) - -!----------------------------------------------------------------------- -! -! -! Purpose: Return global block index and local column index -! for global column index -! -! Method: -! -! Author: Patrick Worley -! -!----------------------------------------------------------------------- - use pmgrid, only: plat, plon - - implicit none -!------------------------------Arguments-------------------------------- - integer, intent(in) :: gcol ! global column index - integer, intent(in) :: cnt ! size of blockid and bcid arrays - - integer, intent(out) :: blockid(cnt) ! block index - integer, intent(out) :: bcid(cnt) ! column index within block - integer, intent(out), optional :: localblockid(cnt) -!---------------------------Local workspace----------------------------- -! - integer jb ! loop index -!----------------------------------------------------------------------- -! latitude slice block - if (cnt < 1) then - write(iulog,*)'GET_GCOL_BLOCK_D: arrays not large enough (', & - cnt,' < ',1,' ) ' - call endrun - else - blockid(1) = (gcol-1)/plon + 1 - bcid(1) = gcol - (blockid(1)-1)*plon - do jb=2,cnt - blockid(jb) = -1 - bcid(jb) = -1 - end do - end if -! - return - end subroutine get_gcol_block_d -! -!======================================================================== -! - integer function get_gcol_block_cnt_d(gcol) - -!----------------------------------------------------------------------- -! -! -! Purpose: Return number of blocks contain data for the vertical column -! with the given global column index -! -! Method: -! -! Author: Patrick Worley -! -!----------------------------------------------------------------------- - - implicit none -!------------------------------Arguments-------------------------------- - integer, intent(in) :: gcol ! global column index -!----------------------------------------------------------------------- -! latitude slice block - get_gcol_block_cnt_d = 1 - - return - end function get_gcol_block_cnt_d -! -!======================================================================== -! - integer function get_block_owner_d(blockid) - -!----------------------------------------------------------------------- -! -! -! Purpose: Return id of processor that "owns" the indicated block -! -! Method: -! -! Author: Patrick Worley -! -!----------------------------------------------------------------------- -#if ( defined SPMD ) - use spmd_dyn, only: proc -#endif - - implicit none -!------------------------------Arguments-------------------------------- - integer, intent(in) :: blockid ! global block id - -!----------------------------------------------------------------------- -! latitude slice block -#if (defined SPMD) - get_block_owner_d = proc(blockid) -#else - get_block_owner_d = 0 -#endif - - return - end function get_block_owner_d -! -!======================================================================== -! - subroutine get_horiz_grid_dim_d(hdim1_d,hdim2_d) - -!----------------------------------------------------------------------- -! -! -! Purpose: Returns declared horizontal dimensions of computational grid. -! Note that global column ordering is assumed to be compatible -! with the first dimension major ordering of the 2D array. -! -! Method: -! -! Author: Patrick Worley -! -!----------------------------------------------------------------------- - use pmgrid, only: plat, plon - -!------------------------------Arguments-------------------------------- - integer, intent(out) :: hdim1_d ! first horizontal dimension - integer, intent(out) :: hdim2_d ! second horizontal dimension -!----------------------------------------------------------------------- - if (ngcols_d == 0) then - ngcols_d = plat*plon - end if - hdim1_d = plon - hdim2_d = plat - - return - end subroutine get_horiz_grid_dim_d -! -!======================================================================== -! - subroutine get_horiz_grid_d(size,clat_d_out,clon_d_out,area_d_out, & - wght_d_out,lat_d_out,lon_d_out) - -!----------------------------------------------------------------------- -! -! -! Purpose: Return latitude and longitude (in radians), column surface -! area (in radians squared) and surface integration weights -! for global column indices that will be passed to/from physics -! -! Method: -! -! Author: Patrick Worley -! -!----------------------------------------------------------------------- - use pmgrid, only: plat, plon - use commap, only: clat, clon, londeg, latdeg, w - use physconst, only: pi, spval - implicit none -!------------------------------Arguments-------------------------------- - integer, intent(in) :: size ! array sizes - - real(r8), intent(out), optional :: clat_d_out(size) ! column latitudes - real(r8), intent(out), optional :: clon_d_out(size) ! column longitudes - real(r8), intent(out), optional :: area_d_out(size) ! column surface - ! area - real(r8), intent(out), optional :: wght_d_out(size) ! column integration - ! weight - real(r8), intent(out), optional :: lat_d_out(size) ! column deg latitudes - real(r8), intent(out), optional :: lon_d_out(size) ! column deg longitudes -!---------------------------Local workspace----------------------------- -! - integer i,j ! loop indices - integer n ! column index - real(r8) :: ns_vert(2,plon) ! latitude grid vertices - real(r8) :: ew_vert(2,plon) ! longitude grid vertices - real(r8) :: del_theta ! difference in latitude at a grid point - real(r8) :: del_phi ! difference in longitude at a grid point - real(r8), parameter :: degtorad=pi/180_r8 -!----------------------------------------------------------------------- - if(present(clon_d_out)) then - if(size == ngcols_d) then - n = 0 - do j = 1,plat - do i = 1, plon - n = n + 1 - clon_d_out(n) = clon(i,j) - end do - end do - else if(size == plon) then - clon_d_out(:) = clon(:,1) - else - write(iulog,*)'GET_HORIZ_GRID_D: arrays not large enough (', & - size,' < ',ngcols_d,' ) ' - call endrun - end if - end if - if(present(clat_d_out)) then - if(size == ngcols_d) then - n = 0 - do j = 1,plat - do i = 1, plon - n = n + 1 - clat_d_out(n) = clat(j) - end do - end do - else if(size == plat) then - clat_d_out(:) = clat(:) - else - write(iulog,*)'GET_HORIZ_GRID_D: arrays not large enough (', & - size,' < ',ngcols_d,' ) ' - call endrun - end if - end if - if ( ( present(wght_d_out) ) ) then - - if(size==plat) then - wght_d_out(:) = (0.5_r8*w(:)/plon)* (4.0_r8*pi) - else if(size == ngcols_d) then - n = 0 - do j = 1,plat - do i = 1, plon - n = n + 1 - wght_d_out(n) = ( 0.5_r8*w(j)/plon ) * (4.0_r8*pi) - end do - end do - end if - end if - if ( present(area_d_out) ) then - if(size < ngcols_d) then - write(iulog,*)'GET_HORIZ_GRID_D: arrays not large enough (', & - size,' < ',ngcols_d,' ) ' - call endrun - end if - n = 0 - do j = 1,plat - - ! First, determine vertices of each grid point. - ! Verticies are ordered as follows: - ! ns_vert: 1=lower left, 2 = upper left - ! ew_vert: 1=lower left, 2 = lower right - - ! Latitude vertices - ns_vert(:,:) = spval - if (j .eq. 1) then - ns_vert(1,:plon) = -90.0_r8 - else - ns_vert(1,:plon) = (latdeg(j) + latdeg(j-1) )*0.5_r8 - end if - - if (j .eq. plat) then - ns_vert(2,:plon) = 90.0_r8 - else - ns_vert(2,:plon) = (latdeg(j) + latdeg(j+1) )*0.5_r8 - end if - - ! Longitude vertices - ew_vert(:,:) = spval - ew_vert(1,1) = (londeg(1,j) - 360.0_r8 + londeg(plon,j))*0.5_r8 - ew_vert(1,2:plon) = (londeg(1:plon-1,j)+ londeg(2:plon,j))*0.5_r8 - ew_vert(2,:plon-1) = ew_vert(1,2:plon) - ew_vert(2,plon) = (londeg(plon,j) + (360.0_r8 + londeg(1,j)))*0.5_r8 - - do i = 1, plon - n = n + 1 - del_phi = sin( ns_vert(2,i)*degtorad ) - sin( ns_vert(1,i)*degtorad ) - del_theta = ( ew_vert(2,i) - ew_vert(1,i) )*degtorad - area_d_out(n) = del_theta*del_phi - end do - - end do - end if - if(present(lon_d_out)) then - if(size == ngcols_d) then - n = 0 - do j = 1,plat - do i = 1, plon - n = n + 1 - lon_d_out(n) = londeg(i,j) - end do - end do - else if(size == plon) then - lon_d_out(:) = londeg(:,1) - else - write(iulog,*)'GET_HORIZ_GRID_D: arrays not large enough (', & - size,' < ',ngcols_d,' ) ' - call endrun - end if - end if - if(present(lat_d_out)) then - if(size == ngcols_d) then - n = 0 - do j = 1,plat - do i = 1, plon - n = n + 1 - lat_d_out(n) = latdeg(j) - end do - end do - else if(size == plat) then - lat_d_out(:) = latdeg(:) - else - write(iulog,*)'GET_HORIZ_GRID_D: arrays not large enough (', & - size,' < ',ngcols_d,' ) ' - call endrun - end if - end if -! - return - end subroutine get_horiz_grid_d - - -!####################################################################### - function get_dyn_grid_parm_real2d(name) result(rval) - use commap, only : londeg, clon - character(len=*), intent(in) :: name - real(r8), pointer :: rval(:,:) - - if(name.eq.'clon') then - rval => clon - else if(name.eq.'londeg') then - rval => londeg - else - nullify(rval) - end if - end function get_dyn_grid_parm_real2d - -!####################################################################### - function get_dyn_grid_parm_real1d(name) result(rval) - use commap, only : latdeg, clat, w - character(len=*), intent(in) :: name - real(r8), pointer :: rval(:) - - if(name.eq.'clat') then - rval => clat - else if(name.eq.'latdeg') then - rval => latdeg - else if(name.eq.'w') then - rval => w - else - nullify(rval) - end if - end function get_dyn_grid_parm_real1d - - - - - integer function get_dyn_grid_parm(name) result(ival) - use pmgrid, only : beglat, endlat, plat, plon, plev, plevp - character(len=*), intent(in) :: name - - if(name.eq.'beglat' .or. name .eq. 'beglatxy') then - ival = beglat - else if(name.eq.'endlat' .or. name .eq. 'endlatxy') then - ival = endlat - else if(name.eq.'plat') then - ival = plat - else if(name.eq.'plon' .or. name .eq. 'endlonxy') then - ival = plon - else if(name.eq.'plev') then - ival = plev - else if(name.eq.'plevp') then - ival = plevp - else if(name .eq. 'beglonxy') then - ival = 1 - else - ival = -1 - end if - - - end function get_dyn_grid_parm - -!####################################################################### - -!------------------------------------------------------------------------------- -! This returns the lat/lon information (and corresponding MPI task numbers (owners)) -! of the global model grid columns nearest to the input satellite coordinate (lat,lon) -!------------------------------------------------------------------------------- -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 - real(r8), intent(in) :: lon - integer, intent(in) :: nclosest - integer, intent(out) :: owners(nclosest) - integer, intent(out) :: indx(nclosest) - integer, intent(out) :: jndx(nclosest) - - real(r8),optional, intent(out) :: rlon(nclosest) - real(r8),optional, intent(out) :: rlat(nclosest) - real(r8),optional, intent(out) :: idyn_dists(nclosest) - - real(r8) :: dist ! the distance (in radians**2 from lat, lon) - real(r8) :: latr, lonr ! lat, lon inputs converted to radians - integer :: ngcols - integer :: i, j - - integer :: blockid(1), bcid(1), lclblockid(1) - - 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 - - ngcols = plon*plat - allocate( clat_d(1:ngcols) ) - allocate( clon_d(1:ngcols) ) - allocate( igcol(nclosest) ) - allocate( distmin(nclosest) ) - - call get_horiz_grid_d(ngcols, clat_d_out=clat_d, clon_d_out=clon_d) - - igcol(:) = -999 - distmin(:) = 1.e10_r8 - - do i = 1,ngcols - - ! Use the Spherical Law of Cosines to find the great-circle distance. - dist = acos(sin(latr) * sin(clat_d(i)) + cos(latr) * cos(clat_d(i)) * cos(clon_d(i) - lonr)) * SHR_CONST_REARTH - do j = nclosest, 1, -1 - if (dist < distmin(j)) then - - if (j < nclosest) then - distmin(j+1) = distmin(j) - igcol(j+1) = igcol(j) - end if - - distmin(j) = dist - igcol(j) = i - else - exit - end if - end do - - end do - - do i = 1,nclosest - - call get_gcol_block_d( igcol(i), 1, blockid, bcid, lclblockid ) - owners(i) = get_block_owner_d(blockid(1)) - - if ( iam==owners(i) ) then - ! get global lat and lon coordinate indices from global column index - ! -- plon is global number of longitude grid points - jndx(i) = (igcol(i)-1)/plon + 1 - indx(i) = igcol(i) - (jndx(i)-1)*plon - else - jndx(i) = -1 - indx(i) = -1 - end if - - if ( present(rlat) ) rlat(i) = clat_d(igcol(i)) * rad2deg - if ( present(rlon) ) rlon(i) = clon_d(igcol(i)) * rad2deg - - if (present(idyn_dists)) then - idyn_dists(i) = distmin(i) - end if - - end do - - deallocate( clat_d ) - deallocate( clon_d ) - deallocate( igcol ) - deallocate( distmin ) - -end subroutine dyn_grid_find_gcols - -!####################################################################### -subroutine dyn_grid_get_colndx( igcol, nclosest, owners, indx, jndx ) - use spmd_utils, only: iam - use pmgrid, only: plon - - integer, intent(in) :: nclosest - integer, intent(in) :: igcol(nclosest) - integer, intent(out) :: owners(nclosest) - integer, intent(out) :: indx(nclosest) - integer, intent(out) :: jndx(nclosest) - - integer :: i - integer :: blockid(1), bcid(1), lclblockid(1) - - do i = 1,nclosest - - call get_gcol_block_d( igcol(i), 1, blockid, bcid, lclblockid ) - owners(i) = get_block_owner_d(blockid(1)) - - if ( iam==owners(i) ) then - ! get global lat and lon coordinate indices from global column index - ! -- plon is global number of longitude grid points - jndx(i) = (igcol(i)-1)/plon + 1 - indx(i) = igcol(i) - (jndx(i)-1)*plon - else - jndx(i) = -1 - indx(i) = -1 - endif - - end do - -end subroutine dyn_grid_get_colndx -!####################################################################### - -! this returns coordinates of a latitude slice of the block corresponding -! to latitude index latndx - -subroutine dyn_grid_get_elem_coords( latndx, rlon, rlat, cdex ) - use commap, only : clat, clon - use pmgrid, only : plon - - integer, intent(in) :: latndx ! lat index - - real(r8),optional, intent(out) :: rlon(:) ! longitudes of the columns in the latndx slice - real(r8),optional, intent(out) :: rlat(:) ! latitudes of the columns in the latndx slice - integer, optional, intent(out) :: cdex(:) ! global column index - - integer :: i,ii,j - - if (present(cdex)) cdex(:) = -1 - if (present(rlat)) rlat(:) = -999._r8 - if (present(rlon)) rlon(:) = -999._r8 - - j = latndx - ii=0 - do i = 1,plon - ii = ii+1 - if (present(cdex)) cdex(ii) = i + (j-1)*plon - if (present(rlat)) rlat(ii) = clat(j) - if (present(rlon)) rlon(ii) = clon(i,1) - end do - -end subroutine dyn_grid_get_elem_coords - -!####################################################################### - -subroutine physgrid_copy_attributes_d(gridname, grid_attribute_names) - use cam_grid_support, only: max_hcoordname_len - - ! Dummy arguments - character(len=max_hcoordname_len), intent(out) :: gridname - character(len=max_hcoordname_len), pointer, intent(out) :: grid_attribute_names(:) - - gridname = 'gauss_grid' - allocate(grid_attribute_names(4)) - grid_attribute_names(1) = 'gw' - grid_attribute_names(2) = 'ntrm' - grid_attribute_names(3) = 'ntrn' - grid_attribute_names(4) = 'ntrk' - -end subroutine physgrid_copy_attributes_d - -!======================================================================================== -! Private Methods -!======================================================================================== - - -subroutine trunc() -!----------------------------------------------------------------------- -! -! Purpose: -! Check consistency of truncation parameters and evaluate pointers -! and displacements for spectral arrays -! -! Method: -! -! Author: -! Original version: CCM1 -! Standardized: L. Bath, June 1992 -! T. Acker, March 1996 -! Reviewed: J. Hack, D. Williamson, August 1992 -! Reviewed: J. Hack, D. Williamson, April 1996 -!----------------------------------------------------------------------- - - use pspect, only: ptrm, ptrn, ptrk, pmmax - use comspe, only: nstart, nlen, locm, lnstart - -!---------------------------Local variables----------------------------- -! - integer m ! loop index -! -!----------------------------------------------------------------------- -! -! trunc first evaluates truncation parameters for a general pentagonal -! truncation for which the following parameter relationships are true -! -! 0 .le. |m| .le. ptrm -! -! |m| .le. n .le. |m|+ptrn for |m| .le. ptrk-ptrn -! -! |m| .le. n .le. ptrk for (ptrk-ptrn) .le. |m| .le. ptrm -! -! Most commonly utilized truncations include: -! 1: triangular truncation for which ptrk=ptrm=ptrn -! 2: rhomboidal truncation for which ptrk=ptrm+ptrn -! 3: trapezoidal truncation for which ptrn=ptrk .gt. ptrm -! -! Simple sanity check -! It is necessary that ptrm .ge. ptrk-ptrn .ge. 0 -! - if (ptrm.lt.(ptrk-ptrn)) then - call endrun ('TRUNC: Error in truncation parameters. ntrm < (ptrk-ptrn)') - end if - if (ptrk.lt.ptrn) then - call endrun ('TRUNC: Error in truncation parameters. ptrk < ptrn') - end if -! -! Evaluate pointers and displacement info based on truncation params -! - nstart(1) = 0 - nlen(1) = ptrn + 1 - do m=2,pmmax - nstart(m) = nstart(m-1) + nlen(m-1) - nlen(m) = min0(ptrn+1,ptrk+2-m) - end do -! -! Assign wavenumbers and spectral offsets if not SPMD -! -#if ( ! defined SPMD ) - do m=1,pmmax - locm(m,0) = m - lnstart(m) = nstart(m) - enddo -#endif - -end subroutine trunc - -!======================================================================================== - -subroutine define_cam_grids() - use pspect, only: ptrm, ptrn, ptrk - use pmgrid, only: beglat, endlat, plon, plat - use commap, only: londeg, latdeg, w - use cam_grid_support, only: horiz_coord_t, horiz_coord_create, iMap - use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register - - ! Local variables - integer :: i, j, ind - integer(iMap), pointer :: grid_map(:,:) - integer(iMap) :: latmap(endlat - beglat + 1) - type(horiz_coord_t), pointer :: lat_coord - type(horiz_coord_t), pointer :: lon_coord - real(r8), pointer :: rattval(:) - - nullify(grid_map) - nullify(lat_coord) - nullify(lon_coord) - nullify(rattval) - - ! Dynamics Grid - ! Make grid and lat maps (need to do this because lat indices are distributed) - ! Note that for this dycore, some pes may be inactive - if(endlat >= beglat) then - allocate(grid_map(4, (plon * (endlat - beglat + 1)))) - ind = 0 - do i = beglat, endlat - do j = 1, plon - ind = ind + 1 - grid_map(1, ind) = j - grid_map(2, ind) = i - grid_map(3, ind) = j - grid_map(4, ind) = i - end do - end do - ! Do we need a lat map? - if ((beglat /= 1) .or. (endlat /= plat)) then - do i = beglat, endlat - latmap(i - beglat + 1) = i - end do - end if - else - allocate(grid_map(4, 0)) - end if - - ! Create the lat coordinate - if ((beglat /= 1) .or. (endlat /= plat)) then - lat_coord => horiz_coord_create('lat', '', plat, 'latitude', & - 'degrees_north', beglat, endlat, latdeg(beglat:endlat), map=latmap) - else - lat_coord => horiz_coord_create('lat', '', plat, 'latitude', & - 'degrees_north', beglat, endlat, latdeg(beglat:endlat)) - end if - - ! Create the lon coordinate - lon_coord => horiz_coord_create('lon', '', plon, 'longitude', & - 'degrees_east', 1, plon, londeg(1:plon, 1)) - - call cam_grid_register('gauss_grid', dyn_decomp, lat_coord, lon_coord, & - grid_map, unstruct=.false.) - - allocate(rattval(size(w))) - rattval = w - call cam_grid_attribute_register('gauss_grid', 'gw', 'gauss weights', 'lat', rattval) - nullify(rattval) ! belongs to attribute - - ! Scalar variable 'attributes' - call cam_grid_attribute_register('gauss_grid', 'ntrm', & - 'spectral truncation parameter M', ptrm) - call cam_grid_attribute_register('gauss_grid', 'ntrn', & - 'spectral truncation parameter N', ptrn) - call cam_grid_attribute_register('gauss_grid', 'ntrk', & - 'spectral truncation parameter K', ptrk) - ! These belong to the grid now - nullify(grid_map) - nullify(lat_coord) - nullify(lon_coord) - -end subroutine define_cam_grids - -!======================================================================================== - -end module dyn_grid diff --git a/src/dynamics/eul/dyndrv.F90 b/src/dynamics/eul/dyndrv.F90 deleted file mode 100644 index b3afd7adc6..0000000000 --- a/src/dynamics/eul/dyndrv.F90 +++ /dev/null @@ -1,142 +0,0 @@ -subroutine dyndrv(grlps1, grt1, grz1, grd1, grfu1, & - grfv1, grut1, grvt1, grrh1, grlps2, & - grt2, grz2, grd2, grfu2, grfv2, & - grut2, grvt2, grrh2, vmax2d, vmax2dt, & - vcour, ztodt ) -!----------------------------------------------------------------------- -! -! Driving routine for Gaussian quadrature, semi-implicit equation -! solution and linear part of horizontal diffusion. -! The need for this interface routine is to have a multitasking -! driver for the spectral space routines it invokes. -! -!---------------------------Code history-------------------------------- -! -! Original version: J. Rosinski -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, B. Boville, J. Hack, August 1992 -! Reviewed: D. Williamson, March 1996 -! Modified: P. Worley, September 2002 -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - use pspect - use comspe - use commap -! use time_manager, only: get_step_size, is_first_step - use spmd_utils, only: iam - use perf_mod - - implicit none - -! -! Input arguments -! - real(r8), intent(in) :: grlps1(2*maxm,(plat+1)/2) ! ---------------------------- - real(r8), intent(inout) :: grt1(2*maxm,plev,(plat+1)/2) ! | - real(r8), intent(inout) :: grz1(2*maxm,plev,(plat+1)/2) ! | - real(r8), intent(inout) :: grd1(2*maxm,plev,(plat+1)/2) ! | - real(r8), intent(in) :: grfu1(2*maxm,plev,(plat+1)/2) ! | - real(r8), intent(in) :: grfv1(2*maxm,plev,(plat+1)/2) ! | - real(r8), intent(in) :: grut1(2*maxm,plev,(plat+1)/2) ! | - real(r8), intent(in) :: grvt1(2*maxm,plev,(plat+1)/2) ! | - real(r8), intent(in) :: grrh1(2*maxm,plev,(plat+1)/2) ! |- see linems and quad for - real(r8), intent(in) :: grlps2(2*maxm,(plat+1)/2) ! | definitions: these variables are - real(r8), intent(inout) :: grt2(2*maxm,plev,(plat+1)/2) ! | declared here for data scoping - real(r8), intent(inout) :: grz2(2*maxm,plev,(plat+1)/2) ! | - real(r8), intent(inout) :: grd2(2*maxm,plev,(plat+1)/2) ! | - real(r8), intent(in) :: grfu2(2*maxm,plev,(plat+1)/2) ! | - real(r8), intent(in) :: grfv2(2*maxm,plev,(plat+1)/2) ! | - real(r8), intent(in) :: grut2(2*maxm,plev,(plat+1)/2) ! | - real(r8), intent(in) :: grvt2(2*maxm,plev,(plat+1)/2) ! | - real(r8), intent(in) :: grrh2(2*maxm,plev,(plat+1)/2) ! ---------------------------- - real(r8), intent(inout) :: vmax2d(plev,plat) ! max. wind at each level, latitude - real(r8), intent(inout) :: vmax2dt(plev,plat) ! max. truncated wind at each lvl,lat - real(r8), intent(inout) :: vcour(plev,plat) ! maximum Courant number in slice - real(r8), intent(in) :: ztodt -! -!---------------------------Local workspace----------------------------- -! - real(r8) ztdtsq(pnmax) ! 2dt*(n(n+1)/a^2) - real(r8) zdt ! dt unless nstep = 0 - real(r8) ztdt ! 2*zdt (2dt) - integer irow ! latitude pair index - integer lm ! local longitudinal wavenumber index - integer n ! total wavenumber index - integer k ! level index - - call t_startf('dyn') - -!$OMP PARALLEL DO PRIVATE (IROW) - do irow=1,plat/2 - call dyn(irow, grlps1(:,irow), grt1(:,:,irow), & - grz1(:,:,irow), grd1(:,:,irow), & - grfu1(:,:,irow), grfv1(:,:,irow), & - grut1(:,:,irow), grvt1(:,:,irow), & - grrh1(:,:,irow), & - grlps2(:,irow), grt2(:,:,irow), & - grz2(:,:,irow), grd2(:,:,irow), & - grfu2(:,:,irow), & - grfv2(:,:,irow), grut2(:,:,irow), & - grvt2(:,:,irow), grrh2(:,:,irow),ztodt ) - end do - - call t_stopf('dyn') -! -!----------------------------------------------------------------------- -! -! Build vector with del^2 response function -! - - ztdt = ztodt - zdt = ztdt/2 -! zdt = get_step_size() -! if (is_first_step()) zdt = .5_r8*zdt -! ztdt = 2._r8*zdt - - - do n=1,pnmax - ztdtsq(n) = ztdt*sq(n) - end do - - call t_startf ('quad-tstep') - -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE(LM) -#endif - do lm=1,numm(iam) -! -! Perform Gaussian quadrature -! - call quad(lm, zdt, ztdtsq, grlps1, grlps2, & - grt1, grz1, grd1, grfu1, grfv1, & - grvt1, grrh1, grt2, grz2, grd2, & - grfu2, grfv2, grvt2, grrh2 ) -! -! Complete time advance, solve vertically coupled semi-implicit system -! - call tstep(lm,zdt,ztdtsq) - end do - call t_stopf ('quad-tstep') -! -! Find out if courant limit has been exceeded. If so, the limiter will be -! applied in HORDIF -! - call t_startf('courlim') - call courlim(vmax2d, vmax2dt, vcour ) - call t_stopf('courlim') -! -! Linear part of horizontal diffusion -! - call t_startf('hordif') - -!$OMP PARALLEL DO PRIVATE(K) - do k=1,plev - call hordif(k,ztdt) - end do - - call t_stopf('hordif') - - return -end subroutine dyndrv diff --git a/src/dynamics/eul/dynpkg.F90 b/src/dynamics/eul/dynpkg.F90 deleted file mode 100644 index 94fcec48f9..0000000000 --- a/src/dynamics/eul/dynpkg.F90 +++ /dev/null @@ -1,153 +0,0 @@ - -subroutine dynpkg (adv_state, t2 ,fu ,fv ,etamid , & - cwava ,detam ,flx_net ,ztodt ) -!----------------------------------------------------------------------- -! -! Purpose: -! Driving routines for dynamics and transport. -! -! Method: -! -! Author: -! Original version: CCM3 -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plat, plev, plevp, beglat, endlat - use pspect - use comspe - 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 -!----------------------------------------------------------------------- - implicit none - -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - type(advection_state), intent(inout) :: adv_state ! Advection state data - real(r8), intent(inout) :: t2(plon,plev,beglat:endlat) ! temp tendency - 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(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 - real(r8), intent(in) :: ztodt ! twice time step unless nstep=0 -! -!---------------------------Local workspace----------------------------- -! - real(r8) etadot(plon,plevp,beglat:endlat) ! Vertical motion (slt) -! -! Fourier coefficient arrays which have a latitude index on them for -! multitasking. These arrays are defined in LINEMSAC and used in QUAD -! to compute spectral coefficients. They contain a latitude index so -! that the sums over latitude can be performed in a specified order. -! - real(r8) grlps1(2*maxm,plat/2) ! ------------------------------ - real(r8) grlps2(2*maxm,plat/2) ! | - real(r8) grt1(2*maxm,plev,plat/2) ! | - real(r8) grt2(2*maxm,plev,plat/2) ! | - real(r8) grz1(2*maxm,plev,plat/2) ! | - real(r8) grz2(2*maxm,plev,plat/2) ! | - 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) grfv1(2*maxm,plev,plat/2) ! | - real(r8) grfv2(2*maxm,plev,plat/2) ! | - real(r8) grut1(2*maxm,plev,plat/2) ! | - real(r8) grut2(2*maxm,plev,plat/2) ! | - real(r8) grvt1(2*maxm,plev,plat/2) ! | - real(r8) grvt2(2*maxm,plev,plat/2) ! | - real(r8) grrh1(2*maxm,plev,plat/2) ! | - real(r8) grrh2(2*maxm,plev,plat/2) ! ------------------------------ - real(r8) :: vcour(plev,plat) ! maximum Courant number in slice - real(r8) :: vmax2d(plev,plat) ! max. wind at each level, latitude - real(r8) :: vmax2dt(plev,plat) ! max. truncated wind at each lvl,lat - integer c - - call settau(ztodt/2) - if(single_column.and.scm_crm_mode) return -!---------------------------------------------------------- -! 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 ( single_column ) then - etadot(1,:,1)=wfldh(:) -else - call t_startf('scandyn') - call scandyn(ztodt ,etadot ,etamid ,grlps1 ,grt1 , & - grz1 ,grd1 ,grfu1 ,grfv1 ,grut1 , & - grvt1 ,grrh1 ,grlps2 ,grt2 ,grz2 , & - grd2 ,grfu2 ,grfv2 ,grut2 ,grvt2 , & - grrh2 ,vcour ,vmax2d, vmax2dt ,detam , & - cwava ,flx_net ,t2 ,fu ,fv ) - call t_stopf('scandyn') -endif -! -!---------------------------------------------------------- -! SLT scan from south to north -!---------------------------------------------------------- -! - call t_startf('sltrun') - call scanslt_run(adv_state, ztodt ,etadot , detam, etamid, cwava ) - call t_stopf('sltrun') - - if ( single_column ) then - call scan2run (ztodt, cwava, etamid ,t2 ,fu ,fv ) - else -! -!---------------------------------------------------------- -! Accumulate spectral coefficients -!---------------------------------------------------------- -! - call t_startf('dynpkg_alloc') - allocate( vz (2*lpspt,plev) ) - allocate( d (2*lpspt,plev) ) - allocate( t (2*lpspt,plev) ) - allocate( alps(2*lpspt) ) - call t_stopf('dynpkg_alloc') - - call t_startf('dyndrv') - call dyndrv(grlps1 ,grt1 ,grz1 ,grd1 ,grfu1 , & - grfv1 ,grut1 ,grvt1 ,grrh1 ,grlps2 , & - grt2 ,grz2 ,grd2 ,grfu2 ,grfv2 , & - grut2 ,grvt2 ,grrh2 ,vmax2d ,vmax2dt , & - vcour, ztodt ) - call t_stopf('dyndrv') -! -!---------------------------------------------------------- -! Second gaussian scan (spectral -> grid) -!---------------------------------------------------------- -! - call t_startf('scan2') - call scan2run (ztodt, cwava, etamid) - call t_stopf('scan2') - - call t_startf('dynpkg_dealloc') - deallocate( vz ) - deallocate( d ) - deallocate( t ) - deallocate( alps ) - call t_stopf('dynpkg_dealloc') -endif - - return -end subroutine dynpkg - diff --git a/src/dynamics/eul/eul_control_mod.F90 b/src/dynamics/eul/eul_control_mod.F90 deleted file mode 100644 index d484ba33b8..0000000000 --- a/src/dynamics/eul/eul_control_mod.F90 +++ /dev/null @@ -1,55 +0,0 @@ -module eul_control_mod - -! Eulerian dynamics shared data - -use shr_kind_mod, only: r8=>shr_kind_r8 -use pmgrid, only: plat, plon, plev -use spmd_utils, only: masterproc -use pspect, only: pnmax - -implicit none -private -save - -real(r8) ,public :: tmass(plat) ! Mass integral for each latitude pair -real(r8) ,public :: tmass0 ! Specified dry mass of atmosphere -real(r8) ,public :: tmassf ! Global mass integral -real(r8) ,public :: qmassf ! Global moisture integral -real(r8) ,public :: fixmas ! Proportionality factor for ps in dry mass fixer -real(r8) ,public :: qmass1 ! Contribution to global moisture integral (mass - ! weighting is based upon the "A" part of the hybrid grid) -real(r8) ,public :: qmass2 ! Contribution to global moisture integral (mass - ! weighting is based upon the "B" part of the hybrid grid) -real(r8) ,public :: pdela(plon,plev)! pressure difference between interfaces (pressure - ! defined using the "A" part of hybrid grid only) -real(r8) ,public :: zgsint ! global integral of geopotential height - -integer ,public :: pcray ! length of vector register (words) for FFT workspace -parameter (pcray=64) - -real(r8) ,public :: trig (3*plon/2+1,plat) ! trigonometric funct values used by fft -integer ,public :: ifax(19,plat) ! fft factorization of plon/2 -real(r8), public :: cnfac ! Courant num factor(multiply by max |V|) -real(r8), public :: cnlim ! Maximum allowable courant number -real(r8), public :: hdfsd2(pnmax) ! Del^2 mult. for each wave (vort-div) -real(r8), public :: hdfst2(pnmax) ! Del^2 multiplier for each wave (t-q) -real(r8), public :: hdfsdn(pnmax) ! Del^N mult. for each wave (vort-div) -real(r8), public :: hdfstn(pnmax) ! Del^N multiplier for each wave (t-q) -real(r8), public :: hdiftq(pnmax,plev) ! Temperature-tracer diffusion factors -real(r8), public :: hdifzd(pnmax,plev) ! Vorticity-divergence diffusion factors -integer, parameter, public :: kmxhd2 = 2 ! Bottom level for increased del^2 diffusion -integer, public :: nindex(plev) ! Starting index for spectral truncation -integer, public :: nmaxhd ! Maximum two dimensional wave number - -! Variables set by namelist -real(r8), public :: dif2 ! del2 horizontal diffusion coeff. -integer, public :: hdif_order ! Order of horizontal diffusion operator -integer, public :: kmnhdn ! Nth order diffusion applied at and below layer kmnhdn. - ! 2nd order diffusion is applied above layer kmnhdn. -real(r8), public :: hdif_coef ! Nth order horizontal diffusion coefficient. -real(r8), public :: divdampn ! Number of days (from nstep 0) to run divergence -real(r8), public :: eps ! time filter coefficient. Defaults to 0.06. -integer, public :: kmxhdc ! number of levels (starting from model top) to apply Courant limiter. -integer, public :: eul_nsplit ! Intended number of dynamics timesteps per physics timestep - -end module eul_control_mod diff --git a/src/dynamics/eul/grcalc.F90 b/src/dynamics/eul/grcalc.F90 deleted file mode 100644 index 6219a1c69b..0000000000 --- a/src/dynamics/eul/grcalc.F90 +++ /dev/null @@ -1,513 +0,0 @@ - -subroutine grcalcs (irow ,ztodt ,grts ,grths ,grds ,& - grzs ,grus ,gruhs ,grvs ,grvhs ,& - grpss ,grdpss ,grpms ,grpls ,tmpSPEcoef) -!----------------------------------------------------------------------- -! -! Complete inverse Legendre transforms from spectral to Fourier space at -! the the given latitude. Only positive latitudes are considered and -! symmetric and antisymmetric (about equator) components are computed. -! The sum and difference of these components give the actual fourier -! coefficients for the latitude circle in the northern and southern -! hemispheres respectively. -! -! The naming convention is as follows: -! - The fourier coefficient arrays all begin with "gr"; -! - "t, q, d, z, ps" refer to temperature, specific humidity, -! divergence, vorticity, and surface pressure; -! - "h" refers to the horizontal diffusive tendency for the field. -! - "s" suffix to an array => symmetric component; -! - "a" suffix to an array => antisymmetric component. -! Thus "grts" contains the symmetric Fourier coeffs of temperature and -! "grtha" contains the antisymmetric Fourier coeffs of the temperature -! tendency due to horizontal diffusion. -! Three additional surface pressure related quantities are returned: -! 1. "grdpss" and "grdpsa" contain the surface pressure factor -! (proportional to del^4 ps) used for the partial correction of -! the horizontal diffusion to pressure surfaces. -! 2. "grpms" and "grpma" contain the longitudinal component of the -! surface pressure gradient. -! 3. "grpls" and "grpla" contain the latitudinal component of the -! surface pressure gradient. -! -!---------------------------Code history-------------------------------- -! -! Original version: CCM1 -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, D. Williamson, J. Hack, August 1992 -! Reviewed: B. Boville, D. Williamson, April 1996 -! Modified: P. Worley, October 2002 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - use pspect - use comspe - use commap - use physconst, only: ez, ra - use eul_control_mod - use spmd_utils, only : iam - implicit none - -! -! Input arguments -! - integer, intent(in) :: irow ! latitude pair index - real(r8), intent(in) :: ztodt ! twice the timestep unless nstep = 0 - real(r8), intent(in) :: tmpSPEcoef(plev*24,pnmax,maxm) ! rearranged variables array -! -! Output arguments: symmetric fourier coefficients -! - real(r8), intent(out) :: grts(2*maxm,plev) ! sum(n) of t(n,m)*P(n,m) - real(r8), intent(out) :: grths(2*maxm,plev) ! sum(n) of K(2i)*t(n,m)*P(n,m) - real(r8), intent(out) :: grds(2*maxm,plev) ! sum(n) of d(n,m)*P(n,m) - real(r8), intent(out) :: grzs(2*maxm,plev) ! sum(n) of z(n,m)*P(n,m) - real(r8), intent(out) :: grus(2*maxm,plev) ! sum(n) of z(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(out) :: gruhs(2*maxm,plev) ! sum(n) of K(2i)*z(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(out) :: grvs(2*maxm,plev) ! sum(n) of d(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(out) :: grvhs(2*maxm,plev) ! sum(n) of K(2i)*d(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(out) :: grpss(2*maxm) ! sum(n) of lnps(n,m)*P(n,m) - real(r8), intent(out) :: grdpss(2*maxm) ! sum(n) of K(4)*(n(n+1)/a**2)**2*2dt*lnps(n,m)*P(n,m) - real(r8), intent(out) :: grpms(2*maxm) ! sum(n) of lnps(n,m)*H(n,m) - real(r8), intent(out) :: grpls(2*maxm) ! sum(n) of lnps(n,m)*P(n,m)*m/a -! -!---------------------------Local workspace----------------------------- -! - real(r8) dalpn(pspt) ! (a/(n(n+1)))*derivative of Legendre functions (complex) - real(r8) zurcor ! conversion term relating abs. & rel. vort. - real(r8) tmpGRcoef(plev*24,maxm) ! temporal storage for Fourier coeffs - - integer k ! level index - integer lm, m ! local and global Fourier wavenumber indices of spectral array - integer mlength ! number of local wavenumbers - integer n ! meridional wavenumber index - integer ir,ii ! spectral indices - integer lmr,lmc ! spectral indices - integer lmwave0 ! local index for wavenumber 0 - integer lmrwave0 ! local offset for wavenumber 0 - integer kv ! level x variable index -! -!----------------------------------------------------------------------- -! -! Compute alpn and dalpn -! - lmwave0 = -1 - lmrwave0 = 0 - dalpn(2) = 0.0_r8 - mlength = numm(iam) - do lm=1,mlength - m = locm(lm,iam) - lmr = lnstart(lm) - if (m .eq. 1) then - lmwave0 = lm - lmrwave0 = lmr - endif - do n=1,nlen(m) - dalpn(lmr+n) = ldalp(lmr+n,irow)*rsq(m+n-1)*ra - end do - end do - zurcor = ez*dalpn(lmrwave0 + 2) -! -! Initialize sums -! - grpss (:) = 0._r8 - grpls (:) = 0._r8 - grpms (:) = 0._r8 - grdpss(:) = 0._r8 - tmpGRcoef (:,:) = 0._r8 -! -! Loop over n for t,q,d,and end of u and v -! - do lm=1,mlength - m = locm(lm,iam) - lmr = lnstart(lm) - do n=2,nlen(m),2 - do kv=1,plev*8 - tmpGRcoef(kv,lm) = tmpGRcoef(kv,lm) + tmpSPEcoef(kv,n,lm)*dalpn(lmr+n) - end do - end do - end do -! - do lm=1,mlength - m = locm(lm,iam) - lmr = lnstart(lm) - do n=1,nlen(m),2 - do kv=plev*8+1,plev*24 - tmpGRcoef(kv,lm) = tmpGRcoef(kv,lm) + tmpSPEcoef(kv,n,lm)*lalp(lmr+n,irow) - end do - end do - end do -! -! Combine the two parts of u(m) and v(m) -! - do lm=1,mlength - do kv=1,plev*8 - tmpGRcoef(kv,lm) = tmpGRcoef(kv,lm) + tmpGRcoef(kv+plev*16,lm) - end do - end do -! -! Save accumulated results to gr* arrays -! - do lm=1,mlength - do k=1,plev - grus (2*lm-1,k) = tmpGRcoef(k ,lm) - grus (2*lm ,k) = tmpGRcoef(k+plev ,lm) - grvs (2*lm-1,k) = tmpGRcoef(k+plev*2 ,lm) - grvs (2*lm ,k) = tmpGRcoef(k+plev*3 ,lm) - gruhs(2*lm-1,k) = tmpGRcoef(k+plev*4 ,lm) - gruhs(2*lm ,k) = tmpGRcoef(k+plev*5 ,lm) - grvhs(2*lm-1,k) = tmpGRcoef(k+plev*6 ,lm) - grvhs(2*lm ,k) = tmpGRcoef(k+plev*7 ,lm) - - grts (2*lm-1,k) = tmpGRcoef(k+plev*8 ,lm) - grts (2*lm ,k) = tmpGRcoef(k+plev*9 ,lm) - grths(2*lm-1,k) = tmpGRcoef(k+plev*10,lm) - grths(2*lm ,k) = tmpGRcoef(k+plev*11,lm) - grds (2*lm-1,k) = tmpGRcoef(k+plev*12,lm) - grds (2*lm ,k) = tmpGRcoef(k+plev*13,lm) - grzs (2*lm-1,k) = tmpGRcoef(k+plev*14,lm) - grzs (2*lm ,k) = tmpGRcoef(k+plev*15,lm) - end do - end do -! -! Remove Coriolis contribution to absolute vorticity from u(m) -! Correction for u:zeta=vz-ez=(zeta+f)-f -! - if (lmwave0 .ne. -1) then - do k=1,plev -! grus(1,k) = grus(1,k) - zurcor - grus(2*lmwave0-1,k) = grus(2*lmwave0-1,k) - zurcor - end do - endif -! -!----------------------------------------------------------------------- -! -! Computation for 1-level variables (ln(p*) and derivatives). -! - do lm=1,mlength - m = locm(lm,iam) - lmr = lnstart(lm) - lmc = 2*lmr - do n=1,nlen(m),2 - ir = lmc + 2*n - 1 - ii = ir + 1 -! - grpss (2*lm-1) = grpss (2*lm-1) + alps(ir)*lalp(lmr+n,irow) - grpss (2*lm ) = grpss (2*lm ) + alps(ii)*lalp(lmr+n,irow) -! - grdpss(2*lm-1) = grdpss(2*lm-1) + alps(ir)*lalp(lmr+n,irow)*hdfstn(m+n-1)*ztodt - grdpss(2*lm ) = grdpss(2*lm ) + alps(ii)*lalp(lmr+n,irow)*hdfstn(m+n-1)*ztodt - end do - end do - - do lm=1,mlength - m = locm(lm,iam) - lmr = lnstart(lm) - lmc = 2*lmr - do n=2,nlen(m),2 - ir = lmc + 2*n - 1 - ii = ir + 1 -! - grpms(2*lm-1) = grpms(2*lm-1) + alps(ir)*ldalp(lmr+n,irow)*ra - grpms(2*lm ) = grpms(2*lm ) + alps(ii)*ldalp(lmr+n,irow)*ra - end do -! -! Multiply by m/a to get d(ln(p*))/dlamda -! and by 1/a to get (1-mu**2)d(ln(p*))/dmu -! - grpls(2*lm-1) = -grpss(2*lm )*ra*xm(m) - grpls(2*lm ) = grpss(2*lm-1)*ra*xm(m) - end do -! - return -end subroutine grcalcs - -subroutine grcalca (irow ,ztodt ,grta ,grtha ,grda ,& - grza ,grua ,gruha ,grva ,grvha ,& - grpsa ,grdpsa ,grpma ,grpla ,tmpSPEcoef) - -!----------------------------------------------------------------------- -! -! Complete inverse Legendre transforms from spectral to Fourier space at -! the the given latitude. Only positive latitudes are considered and -! symmetric and antisymmetric (about equator) components are computed. -! The sum and difference of these components give the actual fourier -! coefficients for the latitude circle in the northern and southern -! hemispheres respectively. -! -! The naming convention is as follows: -! - The fourier coefficient arrays all begin with "gr"; -! - "t, q, d, z, ps" refer to temperature, specific humidity, -! divergence, vorticity, and surface pressure; -! - "h" refers to the horizontal diffusive tendency for the field. -! - "s" suffix to an array => symmetric component; -! - "a" suffix to an array => antisymmetric component. -! Thus "grts" contains the symmetric Fourier coeffs of temperature and -! "grtha" contains the antisymmetric Fourier coeffs of the temperature -! tendency due to horizontal diffusion. -! Three additional surface pressure related quantities are returned: -! 1. "grdpss" and "grdpsa" contain the surface pressure factor -! (proportional to del^4 ps) used for the partial correction of -! the horizontal diffusion to pressure surfaces. -! 2. "grpms" and "grpma" contain the longitudinal component of the -! surface pressure gradient. -! 3. "grpls" and "grpla" contain the latitudinal component of the -! surface pressure gradient. -! -!---------------------------Code history-------------------------------- -! -! Original version: CCM1 -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, D. Williamson, J. Hack, August 1992 -! Reviewed: B. Boville, D. Williamson, April 1996 -! Modified: P. Worley, October 2002 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - use pspect - use comspe - use commap - use physconst, only: ra - use eul_control_mod - use spmd_utils, only : iam - implicit none - -! -! Input arguments -! - integer, intent(in) :: irow ! latitude pair index - real(r8), intent(in) :: ztodt ! twice the timestep unless nstep = 0 - real(r8), intent(in) :: tmpSPEcoef(plev*24,pnmax,maxm) ! array for rearranged variables -! -! -! Output arguments: antisymmetric fourier coefficients -! - real(r8), intent(out) :: grta(2*maxm,plev) ! sum(n) of t(n,m)*P(n,m) - real(r8), intent(out) :: grtha(2*maxm,plev) ! sum(n) of K(2i)*t(n,m)*P(n,m) - real(r8), intent(out) :: grda(2*maxm,plev) ! sum(n) of d(n,m)*P(n,m) - real(r8), intent(out) :: grza(2*maxm,plev) ! sum(n) of z(n,m)*P(n,m) - real(r8), intent(out) :: grua(2*maxm,plev) ! sum(n) of z(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(out) :: gruha(2*maxm,plev) ! sum(n) of K(2i)*z(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(out) :: grva(2*maxm,plev) ! sum(n) of d(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(out) :: grvha(2*maxm,plev) ! sum(n) of K(2i)*d(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(out) :: grpsa(2*maxm) ! sum(n) of lnps(n,m)*P(n,m) - real(r8), intent(out) :: grdpsa(2*maxm) ! sum(n) of K(4)*(n(n+1)/a**2)**2*2dt*lnps(n,m)*P(n,m) - real(r8), intent(out) :: grpma(2*maxm) ! sum(n) of lnps(n,m)*H(n,m) - real(r8), intent(out) :: grpla(2*maxm) ! sum(n) of lnps(n,m)*P(n,m)*m/a -! -!---------------------------Local workspace----------------------------- -! - real(r8) dalpn(pspt) ! (a/(n(n+1)))*derivative of Legendre functions (complex) - real(r8) tmpGRcoef(plev*24,maxm) ! temporal storage for Fourier coefficients - - integer k ! level index - integer lm, m ! local and global Fourier wavenumber indices of spectral array - integer mlength ! number of local wavenumbers - integer n ! meridional wavenumber index - integer ir,ii ! spectral indices - integer lmr,lmc ! spectral indices - integer kv ! level x variable index -! -!----------------------------------------------------------------------- -! -! Compute alpn and dalpn -! - mlength = numm(iam) - do lm=1,mlength - m = locm(lm,iam) - lmr = lnstart(lm) - do n=1,nlen(m) - dalpn(lmr+n) = ldalp(lmr+n,irow)*rsq(m+n-1)*ra - end do - end do -! -! Initialize sums -! - grpsa (:) = 0._r8 - grpla (:) = 0._r8 - grpma (:) = 0._r8 - grdpsa(:) = 0._r8 - tmpGRcoef(:,:) = 0._r8 -! -! Loop over n for t,q,d,and end of u and v -! - do lm=1,mlength - m = locm(lm,iam) - lmr = lnstart(lm) - do n=1,nlen(m),2 - do kv=1,plev*8 - tmpGRcoef(kv,lm) = tmpGRcoef(kv,lm) + tmpSPEcoef(kv,n,lm)*dalpn(lmr+n) - end do - end do - end do - - do lm=1,mlength - m = locm(lm,iam) - lmr = lnstart(lm) - do n=2,nlen(m),2 - do kv=plev*8+1,plev*24 - tmpGRcoef(kv,lm) = tmpGRcoef(kv,lm) + tmpSPEcoef(kv,n,lm)*lalp(lmr+n,irow) - end do - end do - end do -! -! Combine the two parts of u(m) and v(m) -! - do lm=1,mlength - do kv=1,plev*8 - tmpGRcoef(kv,lm) = tmpGRcoef(kv,lm) + tmpGRcoef(kv+plev*16,lm) - end do - end do -! -! Save accumulated results to gr* arrays -! - do lm=1,mlength - do k=1,plev - grua (2*lm-1,k) = tmpGRcoef(k ,lm) - grua (2*lm ,k) = tmpGRcoef(k+plev ,lm) - grva (2*lm-1,k) = tmpGRcoef(k+plev*2 ,lm) - grva (2*lm ,k) = tmpGRcoef(k+plev*3 ,lm) - gruha(2*lm-1,k) = tmpGRcoef(k+plev*4 ,lm) - gruha(2*lm ,k) = tmpGRcoef(k+plev*5 ,lm) - grvha(2*lm-1,k) = tmpGRcoef(k+plev*6 ,lm) - grvha(2*lm ,k) = tmpGRcoef(k+plev*7 ,lm) - - grta (2*lm-1,k) = tmpGRcoef(k+plev*8 ,lm) - grta (2*lm ,k) = tmpGRcoef(k+plev*9 ,lm) - grtha(2*lm-1,k) = tmpGRcoef(k+plev*10,lm) - grtha(2*lm ,k) = tmpGRcoef(k+plev*11,lm) - grda (2*lm-1,k) = tmpGRcoef(k+plev*12,lm) - grda (2*lm ,k) = tmpGRcoef(k+plev*13,lm) - grza (2*lm-1,k) = tmpGRcoef(k+plev*14,lm) - grza (2*lm ,k) = tmpGRcoef(k+plev*15,lm) - end do - end do -! -!----------------------------------------------------------------------- -! -! Computation for 1-level variables (ln(p*) and derivatives). -! - do lm=1,mlength - m = locm(lm,iam) - lmr = lnstart(lm) - lmc = 2*lmr - do n=1,nlen(m),2 - ir = lmc + 2*n - 1 - ii = ir + 1 - - grpma(2*lm-1) = grpma(2*lm-1) + alps(ir)*ldalp(lmr+n,irow)*ra - grpma(2*lm ) = grpma(2*lm ) + alps(ii)*ldalp(lmr+n,irow)*ra - end do - end do - - do lm=1,mlength - m = locm(lm,iam) - lmr = lnstart(lm) - lmc = 2*lmr - do n=2,nlen(m),2 - ir = lmc + 2*n - 1 - ii = ir + 1 -! - grpsa (2*lm-1) = grpsa (2*lm-1) + alps(ir)*lalp(lmr+n,irow) - grpsa (2*lm ) = grpsa (2*lm ) + alps(ii)*lalp(lmr+n,irow) -! - grdpsa(2*lm-1) = grdpsa(2*lm-1) + alps(ir)*lalp(lmr+n,irow)*hdfstn(m+n-1)*ztodt - grdpsa(2*lm ) = grdpsa(2*lm ) + alps(ii)*lalp(lmr+n,irow)*hdfstn(m+n-1)*ztodt - end do -! -! Multiply by m/a to get d(ln(p*))/dlamda -! and by 1/a to get (1-mu**2)d(ln(p*))/dmu -! - grpla(2*lm-1) = -grpsa(2*lm )*ra*xm(m) - grpla(2*lm ) = grpsa(2*lm-1)*ra*xm(m) - end do -! - return -end subroutine grcalca - -subroutine prepGRcalc(tmpSPEcoef) - -!----------------------------------------------------------------------- -! -! Rearrange multi-level spectral coefficients for vectorization. -! The results are saved to "tmpSPEcoef" and will be used in -! "grcalcs" and "grcalca". -! -!----------------------------------------------------------------------- -! - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - use pspect - use comspe - use commap - use physconst, only: ra - use eul_control_mod, only: hdiftq, hdifzd - use spmd_utils, only : iam -! - implicit none -! -! -!---------------------------Output argument----------------------------- -! - real(r8), intent(out) :: tmpSPEcoef(plev*24,pnmax,maxm) ! array for rearranged variables -! -!---------------------------Local workspace----------------------------- -! - real(r8) raxm -! - integer lm, m, n, k - integer lmr, lmc - integer ir ,ii -! -!----------------------------------------------------------------------- -! - do lm=1,numm(iam) - m = locm(lm,iam) - lmr = lnstart(lm) - lmc = 2*lmr - raxm = ra*xm(m) - do n=1,nlen(m) - ir = lmc + 2*n - 1 - ii = ir + 1 - do k=1,plev - tmpSPEcoef(k ,n,lm) = vz(ir,k) - tmpSPEcoef(k+plev ,n,lm) = vz(ii,k) - tmpSPEcoef(k+plev*2 ,n,lm) = -d(ir,k) - tmpSPEcoef(k+plev*3 ,n,lm) = -d(ii,k) - tmpSPEcoef(k+plev*4 ,n,lm) = -vz(ir,k)*hdifzd(n+m-1,k) - tmpSPEcoef(k+plev*5 ,n,lm) = -vz(ii,k)*hdifzd(n+m-1,k) - tmpSPEcoef(k+plev*6 ,n,lm) = d(ir,k)*hdifzd(n+m-1,k) - tmpSPEcoef(k+plev*7 ,n,lm) = d(ii,k)*hdifzd(n+m-1,k) - - tmpSPEcoef(k+plev*8 ,n,lm) = t(ir,k) - tmpSPEcoef(k+plev*9 ,n,lm) = t(ii,k) - tmpSPEcoef(k+plev*10,n,lm) = -t(ir,k)*hdiftq(n+m-1,k) - tmpSPEcoef(k+plev*11,n,lm) = -t(ii,k)*hdiftq(n+m-1,k) - tmpSPEcoef(k+plev*12,n,lm) = d(ir,k) - tmpSPEcoef(k+plev*13,n,lm) = d(ii,k) - tmpSPEcoef(k+plev*14,n,lm) = vz(ir,k) - tmpSPEcoef(k+plev*15,n,lm) = vz(ii,k) - - tmpSPEcoef(k+plev*16,n,lm) = d (ii,k)*rsq(m+n-1)*raxm - tmpSPEcoef(k+plev*17,n,lm) = -d (ir,k)*rsq(m+n-1)*raxm - tmpSPEcoef(k+plev*18,n,lm) = vz(ii,k)*rsq(m+n-1)*raxm - tmpSPEcoef(k+plev*19,n,lm) = -vz(ir,k)*rsq(m+n-1)*raxm - tmpSPEcoef(k+plev*20,n,lm) = -d (ii,k)*hdifzd(n+m-1,k)*rsq(m+n-1)*raxm - tmpSPEcoef(k+plev*21,n,lm) = d (ir,k)*hdifzd(n+m-1,k)*rsq(m+n-1)*raxm - tmpSPEcoef(k+plev*22,n,lm) = -vz(ii,k)*hdifzd(n+m-1,k)*rsq(m+n-1)*raxm - tmpSPEcoef(k+plev*23,n,lm) = vz(ir,k)*hdifzd(n+m-1,k)*rsq(m+n-1)*raxm - end do - end do - end do -! - return -end subroutine prepGRcalc diff --git a/src/dynamics/eul/grmult.F90 b/src/dynamics/eul/grmult.F90 deleted file mode 100644 index 11f8136bd5..0000000000 --- a/src/dynamics/eul/grmult.F90 +++ /dev/null @@ -1,322 +0,0 @@ - -subroutine grmult(rcoslat ,d ,qm1 ,tm1 ,um1 ,& - vm1 ,z ,tm2 ,phis ,dpsl ,& - dpsm ,omga ,pdel ,pbot ,logpsm2 ,& - logpsm1 ,rpmid ,rpdel ,fu ,fv ,& - t2 ,ut ,vt ,drhs ,pmid ,& - etadot ,etamid ,engy ,ddpn ,vpdsn ,& - dpslon ,dpslat ,vat ,ktoop ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Non-linear dynamics calculations in grid point space -! -! Method: -! -! Author: -! Original version: CCM1 -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, D. Williamson, J. Hack, August 1992 -! Reviewed: B. Boville, D. Williamson, April 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev, plevp, plon - use pspect - use commap - use physconst, only: rair, cappa, cpvir, zvir - use hycoef, only : hybi, hybm, hybd, nprlev - - implicit none - -! -! Input arguments -! - real(r8), intent(in) :: rcoslat ! 1./cosine(latitude) - real(r8), intent(in) :: d(plon,plev) ! divergence - real(r8), intent(in) :: qm1(plon,plev) ! specific humidity - real(r8), intent(in) :: tm1(plon,plev) ! temperature - real(r8), intent(in) :: um1(plon,plev) ! zonal wind * cos(lat) - real(r8), intent(in) :: vm1(plon,plev) ! meridional wind * cos(lat) - real(r8), intent(in) :: z(plon,plev) ! vorticity - real(r8), intent(in) :: phis(plon) ! surface geopotential - real(r8), intent(in) :: dpsl(plon) ! longitudinal component of grad ln(ps) - real(r8), intent(in) :: dpsm(plon) ! latitudinal component of grad ln(ps) - real(r8), intent(in) :: omga(plon,plev) ! vertical pressure velocity - real(r8), intent(in) :: pdel(plon,plev) ! layer thicknesses (pressure) - real(r8), intent(in) :: pbot(plon) ! bottom interface pressure - real(r8), intent(in) :: logpsm2(plon) ! log(psm2) - real(r8), intent(in) :: logpsm1(plon) ! log(ps) - real(r8), intent(in) :: rpmid(plon,plev) ! 1./pmid - real(r8), intent(in) :: rpdel(plon,plev) ! 1./pdel - real(r8), intent(in) :: tm2(plon,plev) ! temperature at previous time step - integer, intent(in) :: nlon -! -! Input/Output arguments -! - real(r8), intent(inout) :: fu(plon,plev) ! nonlinear term - u momentum eqn - real(r8), intent(inout) :: fv(plon,plev) ! nonlinear term - v momentum eqn - real(r8), intent(inout) :: t2(plon,plev) ! nonlinear term - temperature - real(r8), intent(inout) :: ut(plon,plev) ! (u*TM1) - heat flux - zonal - real(r8), intent(inout) :: vt(plon,plev) ! (u*TM1) - heat flux - meridional - real(r8), intent(inout) :: drhs(plon,plev) ! RHS of divergence eqn (del^2 term) - real(r8), intent(inout) :: pmid(plon,plev) ! pressure at full levels - real(r8), intent(inout) :: etadot(plon,plevp) ! vertical velocity in eta coordinates - real(r8), intent(in) :: etamid(plev) ! midpoint values of eta (a+b) - real(r8), intent(inout) :: engy(plon,plev) ! kinetic energy -! -! Output arguments -! - real(r8), intent(out) :: ddpn(plon) ! complete sum of d*delta p - real(r8), intent(out) :: vpdsn(plon) ! complete sum V dot grad(ln(ps)) delta b - real(r8), intent(out) :: dpslat(plon,plev) ! ln(ps) component of lon press gradient - real(r8), intent(out) :: dpslon(plon,plev) ! ln(ps) component of lat press gradient - real(r8), intent(out) :: vat (plon,plev) ! Vertical advection of temperature - real(r8), intent(out) :: ktoop (plon,plev) ! (Kappa*T)*(omega/P) - -! -!---------------------------Local workspace----------------------------- -! - real(r8) tv(plon,plev) ! virtual temperature - real(r8) ddpk(plon) ! partial sum of d*delta p - real(r8) vkdp ! V dot grad(ln(ps)) - real(r8) vpdsk(plon) ! partial sum V dot grad(ln(ps)) delta b - real(r8) tk0(plon) ! tm1 at phony level 0 - real(r8) uk0(plon) ! u at phony level 0 - real(r8) vk0(plon) ! v at phone level 0 - real(r8) rtv(plon,plev) ! rair*tv - real(r8) pterm(plon,plev) ! intermediate term for hydrostatic eqn - real(r8) tterm(plon,plev) ! intermediate term for hydrostatic eqn - real(r8) tmp ! temporary workspace - real(r8) tmpk ! temporary workspace - real(r8) tmpkp1 ! temporary workspace - real(r8) edotdpde(plon,plevp) ! etadot*dp/deta - real(r8) udel(plon,0:plev-1) ! vertical u difference - real(r8) vdel(plon,0:plev-1) ! vertical v difference - real(r8) tdel(plon,0:plev-1) ! vertical TM1 difference - - integer i,k,kk ! longitude, level indices -! -! Initialize arrays which represent vertical sums (ddpk, ddpn, vpdsk, -! vpdsn). Set upper boundary condition arrays (k=0: tk0, uk0, vk0). -! - ddpk = 0.0_r8 - ddpn = 0.0_r8 - vpdsk = 0.0_r8 - vpdsn = 0.0_r8 - tk0 = 0.0_r8 - uk0 = 0.0_r8 - vk0 = 0.0_r8 -! -! Virtual temperature -! -tv(:nlon,:) = tm1(:nlon,:) * (1.0_r8 + zvir * qm1(:nlon,:)) - -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i=1,nlon - rtv(i,k) = rair*tv(i,k) - end do - end do -! -!$OMP PARALLEL DO PRIVATE (I, K, VKDP) - do i=1,nlon -! -! sum(plev)(d(k)*dp(k)) -! - do k=1,plev - ddpn(i) = ddpn(i) + d(i,k)*pdel(i,k) - end do -! -! sum(plev)(v(k)*grad(lnps)*db(k)) -! - do k=nprlev,plev - vkdp = rcoslat*(um1(i,k)*dpsl(i) + vm1(i,k)*dpsm(i))*pbot(i) - vpdsn(i) = vpdsn(i) + vkdp*hybd(k) - end do -! -! Compute etadot (dp/deta) (k+1/2). Note: sum(k)(d(j)*dp(j)) required in -! pressure region. sum(k)(d(j)*dp(j)) and sum(k)(v(j)*grad(ps)*db(j)) -! required in hybrid region -! - edotdpde(i,1) = 0._r8 - do k=1,nprlev-1 - ddpk(i) = ddpk(i) + d(i,k)*pdel(i,k) - edotdpde(i,k+1) = -ddpk(i) - end do -! - do k=nprlev,plev-1 - ddpk(i) = ddpk(i) + d(i,k)*pdel(i,k) - vkdp = rcoslat*(um1(i,k)*dpsl(i) + vm1(i,k)*dpsm(i))*pbot(i) - vpdsk(i) = vpdsk(i) + vkdp*hybd(k) - edotdpde(i,k+1) = -ddpk(i) - vpdsk(i) + hybi(k+1)*(ddpn(i)+vpdsn(i)) - end do - edotdpde(i,plevp) = 0._r8 -! -! - end do - -! -! Nonlinear advection terms. u*tm1, v*tm1, kinetic energy first -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i=1,nlon - ut(i,k) = um1(i,k)*tm1(i,k) - vt(i,k) = vm1(i,k)*tm1(i,k) - engy(i,k) = 0.5_r8*(um1(i,k)**2 + vm1(i,k)**2) - end do - end do -! -! Compute workspace arrays for delta-u, delta-v, delta-tm1 (k) -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=0,plev-1 - if (k == 0) then - do i=1,nlon - udel(i,0) = um1(i,1) - uk0(i) - vdel(i,0) = vm1(i,1) - vk0(i) - tdel(i,0) = tm1(i,1) - tk0(i) - end do - else - do i=1,nlon - udel(i,k) = um1(i,k+1) - um1(i,k) - vdel(i,k) = vm1(i,k+1) - vm1(i,k) - tdel(i,k) = tm1(i,k+1) - tm1(i,k) - end do - endif - end do -! -!$OMP PARALLEL DO PRIVATE (K, I, TMPK, TMPKP1, TMP) - do k=1,plev -! - if (k < nprlev) then -! -! Horizontal advection: u*z, v*z, energy conversion term (omega/p), -! vertical advection for interface above. Pure pressure region first. -! - do i=1,nlon - dpslat(i,k) = 0._r8 - dpslon(i,k) = 0._r8 - tmpk = 0.5_r8*rpdel(i,k)*edotdpde(i,k ) - tmpkp1 = 0.5_r8*rpdel(i,k)*edotdpde(i,k+1) - fu(i,k) = fu(i,k) + vm1(i,k)*z(i,k) - udel(i,k-1)*tmpk - udel(i,k )*tmpkp1 - fv(i,k) = fv(i,k) - um1(i,k)*z(i,k) - vdel(i,k-1)*tmpk - vdel(i,k )*tmpkp1 - vat (i,k) = - (tdel(i,k-1)*tmpk + tdel(i,k)*tmpkp1) - ktoop(i,k) = cappa*tv(i,k)/(1._r8 + cpvir*qm1(i,k))* & - omga(i,k)*rpmid(i,k) - t2 (i,k) = t2(i,k) + d(i,k)*tm1(i,k) - tdel(i,k-1)*tmpk + & - ktoop(i,k) - tdel(i,k)*tmpkp1 - end do -! - else if (k < plev) then -! -! Hybrid region above bottom level: Computations are the same as in pure -! pressure region, except that pressure gradient terms are added to -! momentum tendencies. -! - do i=1,nlon - tmpk = 0.5_r8*rpdel(i,k)*edotdpde(i,k ) - tmpkp1 = 0.5_r8*rpdel(i,k)*edotdpde(i,k+1) - tmp = rtv(i,k)*hybm(k)*rpmid(i,k)*pbot(i) - dpslon(i,k) = rcoslat*tmp*dpsl(i) - dpslat(i,k) = rcoslat*tmp*dpsm(i) - fu(i,k) = fu(i,k) + vm1(i,k)*z(i,k) - udel(i,k-1)*tmpk - & - udel(i,k )*tmpkp1 - dpslon(i,k) - fv(i,k) = fv(i,k) - um1(i,k)*z(i,k) - vdel(i,k-1)*tmpk - & - vdel(i,k )*tmpkp1 - dpslat(i,k) - vat (i,k) = - (tdel(i,k-1)*tmpk + tdel(i,k)*tmpkp1) - ktoop(i,k) = cappa*tv(i,k)/(1._r8 + cpvir*qm1(i,k))* & - omga(i,k)*rpmid(i,k) - t2 (i,k) = t2(i,k) + d(i,k)*tm1(i,k) - tdel(i,k-1)*tmpk + & - ktoop(i,k) - tdel(i,k)*tmpkp1 - end do -! - else -! -! Bottom level -! - do i=1,nlon - tmpk = 0.5_r8*rpdel(i,plev)*edotdpde(i,plev ) - tmp = rtv(i,plev)*hybm(plev)*rpmid(i,plev)*pbot(i) - dpslon(i,plev) = rcoslat*tmp*dpsl(i) - dpslat(i,plev) = rcoslat*tmp*dpsm(i) - fu(i,plev) = fu(i,plev) + vm1(i,plev)*z(i,plev) - & - udel(i,plev-1)*tmpk - dpslon(i,plev) - fv(i,plev) = fv(i,plev) - um1(i,plev)*z(i,plev) - & - vdel(i,plev-1)*tmpk - dpslat(i,plev) - vat (i,plev) = -(tdel(i,plev-1)*tmpk) - ktoop(i,plev) = cappa*tv(i,plev)/(1._r8 + cpvir*qm1(i,plev))* & - omga(i,plev)*rpmid(i,plev) - t2 (i,plev) = t2(i,plev) + d(i,plev)*tm1(i,plev) - & - tdel(i,plev-1)*tmpk + ktoop(i,plev) - end do -! - end if -! - enddo -! -! Convert eta-dot(dp/deta) to eta-dot (top and bottom = 0.) -! - etadot(:,1) = 0._r8 - etadot(:,plevp) = 0._r8 -!$OMP PARALLEL DO PRIVATE (K, TMP, I) - do k=2,plev - tmp = etamid(k) - etamid(k-1) - do i=1,nlon - etadot(i,k) = edotdpde(i,k)*tmp/(pmid(i,k) - pmid(i,k-1)) - end do - end do -! -!----------------------------------------------------------------------- -! -! Divergence and hydrostatic equations -! -! Del squared part of RHS of divergence equation. -! Kinetic energy and diagonal term of hydrostatic equation. -! Total temperature as opposed to perturbation temperature is acceptable -! since del-square operator will operate on this term. -! (Also store some temporary terms.) -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i=1,nlon - tterm(i,k) = 0.5_r8*tm2(i,k) - tm1(i,k) - pterm(i,k) = rtv(i,k)*rpmid(i,k)*pdel(i,k) - drhs(i,k) = phis(i) + engy(i,k) + rtv(i,k)*0.5_r8* & - rpmid(i,k)*pdel(i,k) + href(k,k)*tterm(i,k) + & - bps(k)*(0.5_r8*logpsm2(i) - logpsm1(i)) - end do - end do - -! -! Bottom level term of hydrostatic equation -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev-1 - do i=1,nlon - drhs(i,k) = drhs(i,k) + rtv(i,plev)* & - rpmid(i,plev)*pdel(i,plev) + & - href(plev,k)*tterm(i,plev) - end do - end do -! -! Interior terms of hydrostatic equation -! -!$OMP PARALLEL DO PRIVATE (K, KK, I) - do k=1,plev-2 - do kk=k+1,plev-1 - do i=1,nlon - drhs(i,k) = drhs(i,k) + pterm(i,kk) + href(kk,k)*tterm(i,kk) - end do - end do - end do -! - return -end subroutine grmult diff --git a/src/dynamics/eul/hdinti.F90 b/src/dynamics/eul/hdinti.F90 deleted file mode 100644 index 67a4110fa4..0000000000 --- a/src/dynamics/eul/hdinti.F90 +++ /dev/null @@ -1,80 +0,0 @@ - -subroutine hdinti(rearth, deltat) - -!----------------------------------------------------------------------- -! -! Purpose: -! Time independent initialization for the horizontal diffusion. -! -! Method: -! -! Author: -! Original version: D. Williamson -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, J. Hack, August 1992 -! Reviewed: B. Boville, April 1996 -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8=>shr_kind_r8 - use cam_abortutils, only: endrun - use pmgrid - use pspect - use eul_control_mod - use cam_logfile, only: iulog - implicit none - -!------------------------------Arguments-------------------------------- - - real(r8), intent(in) :: rearth ! radius of the earth - real(r8), intent(in) :: deltat ! time step - -!---------------------------Local workspace----------------------------- - - integer :: k ! level index - integer :: n ! n-wavenumber index - integer :: iexpon - real(r8) :: fn -! -!----------------------------------------------------------------------- -! -! Initialize physical constants for courant number based spect truncation -! - nmaxhd = ptrk - cnlim = 0.999_r8 ! maximum allowable Courant number - cnfac = deltat*real(nmaxhd,r8)/rearth -! -! Initialize arrays used for courant number based spectral truncation -! - do k=1,plev - nindex(k) = 2*nmaxhd - end do -! -! Set the Del^2 and Del^N diffusion coefficients for each wavenumber -! - hdfst2(1) = 0._r8 - hdfsd2(1) = 0._r8 -! - hdfstn(1) = 0._r8 - hdfsdn(1) = 0._r8 - - iexpon = hdif_order/2 - - do n=2,pnmax - - hdfst2(n) = dif2 * (n*(n-1) ) / rearth**2 - hdfsd2(n) = dif2 * (n*(n-1)-2) / rearth**2 - - fn = n*(n-1) - fn = fn/rearth**2 - fn = fn**iexpon - - hdfstn(n) = hdif_coef * fn - fn = 2._r8/rearth**2 - hdfsdn(n) = hdfstn(n) - hdif_coef * fn**iexpon - - end do -! - return -end subroutine hdinti - diff --git a/src/dynamics/eul/herxin.F90 b/src/dynamics/eul/herxin.F90 deleted file mode 100644 index afed4de04f..0000000000 --- a/src/dynamics/eul/herxin.F90 +++ /dev/null @@ -1,143 +0,0 @@ - -subroutine herxin(pf ,pkcnst ,fb ,fxl ,fxr , & - x ,xdp ,idp ,jdp ,fint , & - nlon ,nlonex ) - -!----------------------------------------------------------------------- -! -! Purpose: -! -! Method: -! For each departure point in the latitude slice being forecast, -! interpolate (using equally spaced Hermite cubic formulas) to its -! x value at each latitude required for later interpolation in the y -! direction. -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plev, plon - use scanslt, only: plond, beglatex, endlatex, platd, nxpt - use cam_abortutils, only: endrun -!----------------------------------------------------------------------- - implicit none -!------------------------------Parameters------------------------------- -#include -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer, intent(in) :: pf ! dimension (number of fields) - integer, intent(in) :: pkcnst ! dimension,=p3d -! - real(r8), intent(in) :: fb (plond,plev,pkcnst,beglatex:endlatex) ! field - real(r8), intent(in) :: fxl(plond,plev,pf,beglatex:endlatex) ! left x derivative - real(r8), intent(in) :: fxr(plond,plev,pf,beglatex:endlatex) ! right x derivative - real(r8), intent(in) :: x(plond,platd) ! longitudinal grid coordinates - real(r8), intent(in) :: xdp(plon,plev) ! departure point coordinates -! - integer, intent(in) :: idp(plon,plev,4) ! longitude index of dep pt. - integer, intent(in) :: jdp(plon,plev) ! latitude index of dep pt. - integer, intent(in) :: nlon - integer, intent(in) :: nlonex(platd) -! -! Output arguments -! - real(r8), intent(out) :: fint(plon,plev,ppdy,pf) ! x-interpolants -! -!----------------------------------------------------------------------- -! -! pf Number of fields being interpolated. -! pkcnst Dimensioning construct for 3-D arrays. -! fb extended array of data to be interpolated. -! fxl x derivatives at the left edge of each interval containing -! the departure point -! fxr x derivatives at the right edge of each interval containing -! the departure point -! x Equally spaced x grid values in extended arrays. -! xdp xdp(i,k) is the x-coordinate (extended grid) of the -! departure point that corresponds to global grid point (i,k) -! in the latitude slice being forecasted. -! idp idp(i,k) is the index of the x-interval (extended grid) that -! contains the departure point corresponding to global grid -! point (i,k) in the latitude slice being forecasted. -! Note that -! x(idp(i,k)) .le. xdp(i,k) .lt. x(idp(i,k)+1) . -! jdp jdp(i,k) is the index of the y-interval (extended grid) that -! contains the departure point corresponding to global grid -! point (i,k) in the latitude slice being forecasted. -! Suppose yb contains the y-coordinates of the extended array -! and ydp(i,k) is the y-coordinate of the departure point -! corresponding to grid point (i,k). Then, -! yb(jdp(i,k)) .le. ydp(i,k) .lt. yb(jdp(i,k)+1) . -! fint (fint(i,k,j,n),j=1,ppdy) contains the x interpolants at each -! latitude needed for the y derivative estimates at the -! endpoints of the interval that contains the departure point -! for grid point (i,k). The last index of fint allows for -! interpolation of multiple fields. -! -!---------------------------Local workspace----------------------------- -! - integer i,j,k,m ! indices -! - real(r8) dx (platd) ! x-increment - real(r8) rdx(platd) ! 1./dx - real(r8) xl ! | - real(r8) xr ! | - real(r8) hl (plon,plev) ! | --interpolation coeffs - real(r8) hr (plon,plev) ! | - real(r8) dhl(plon,plev) ! | - real(r8) dhr(plon,plev) ! | - - integer n - -! -!----------------------------------------------------------------------- -! - if(ppdy .ne. 4) then - call endrun ('HERXIN:Fatal error: ppdy must be set to 4') - end if - - dx (1) = x(nxpt+2,1) - x(nxpt+1,1) - rdx(1) = 1._r8/dx(1) -!$OMP PARALLEL DO PRIVATE (K, I, XL, XR) - do k=1,plev - do i=1,nlon - xl = ( x(idp(i,k,1)+1,1) - xdp(i,k) )*rdx(1) - xr = 1._r8 - xl - hl (i,k) = ( 3.0_r8 - 2.0_r8*xl)*xl**2 - hr (i,k) = ( 3.0_r8 - 2.0_r8*xr )*xr**2 - dhl(i,k) = -dx(1)*( xl - 1._r8 )*xl**2 - dhr(i,k) = dx(1)*( xr - 1._r8 )*xr**2 - end do - end do - - ! x interpolation at each latitude needed for y interpolation. - ! Once for each field. - - do m = 1,pf -!$OMP PARALLEL DO PRIVATE (N, K, I) - do n=1,4 - do k = 1,plev - do i = 1,nlon - fint(i,k,n,m) = & - fb (idp(i,k,1) ,k,m,jdp(i,k)+(n-2))*hl (i,k) + & - fb (idp(i,k,1)+1,k,m,jdp(i,k)+(n-2))*hr (i,k) + & - fxl(idp(i,k,1) ,k,m,jdp(i,k)+(n-2))*dhl(i,k) + & - fxr(idp(i,k,1) ,k,m,jdp(i,k)+(n-2))*dhr(i,k) - enddo - enddo - enddo - enddo - -end subroutine herxin diff --git a/src/dynamics/eul/heryin.F90 b/src/dynamics/eul/heryin.F90 deleted file mode 100644 index 69a378ed88..0000000000 --- a/src/dynamics/eul/heryin.F90 +++ /dev/null @@ -1,129 +0,0 @@ - -subroutine heryin(pf ,fint ,fyb ,fyt ,y , & - dy ,ydp ,jdp ,fdp ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! -! Method: -! For each departure point in the latitude slice to be forecast, -! interpolate (using unequally spaced Hermite cubic formulas) the -! x interpolants to the y value of the departure point. -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev - use scanslt, only: platd -!----------------------------------------------------------------------- - implicit none -!------------------------------Parameters------------------------------- -#include -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer, intent(in) :: pf ! dimension (number of fields) -! - real(r8), intent(in) :: fint(plon,plev,ppdy,pf) ! x-interpolants - real(r8), intent(in) :: fyb (plon,plev,pf) ! y-derivatives at bottom of interval - real(r8), intent(in) :: fyt (plon,plev,pf) ! y-derivatives at top of interval - real(r8), intent(in) :: y (platd) ! latitude grid coordinates - real(r8), intent(in) :: dy (platd) ! intervals between latitude grid pts. - real(r8), intent(in) :: ydp (plon,plev) ! lat. coord of departure point. -! - integer, intent(in) :: jdp (plon,plev) ! lat. index of departure point. - integer, intent(in) :: nlon -! -! Output arguments -! - real(r8), intent(out) :: fdp (plon,plev,pf) ! y-interpolants - -! -!----------------------------------------------------------------------- -! -! pf Number of fields being interpolated. -! fint (fint(i,k,j,m),j=ppdy/2,ppdy/2 + 1) contains the x -! interpolants at the endpoints of the y-interval that -! contains the departure point for grid point (i,k). The last -! index of fint allows for interpolation of multiple fields. -! fint is generated by a call to herxin. -! fyb fyb(i,k,.) is the derivative at the "bottom" of the -! y-interval that contains the departure point of grid -! point (i,k). fyb is generated by a call to cubydr. -! fyt fyt(i,k,.) is the derivative at the "top" of the y-interval -! that contains the departure point of grid point (i,k). -! fyt is generated by a call to cubydr. -! y y-coordinate (latitude) values in the extended array. -! dy Increment in the y-coordinate value for each interval in the -! extended array. -! ydp ydp(i,k) is the y-coordinate of the departure point that -! corresponds to global grid point (i,k) in the latitude slice -! being forecasted. -! jdp jdp(i,k) is the index of the y-interval that contains the -! departure point corresponding to global grid point (i,k) in -! the latitude slice being forecasted. -! Note that -! y(jdp(i,k)) .le. ydp(i,k) .lt. y(jdp(i,k)+1) . -! fdp Horizontally interpolated field values at the departure point -! for the latitude slice being forecasted. -! -!---------------------------Local variables----------------------------- -! - integer i,k ! index - integer jb ! index corresponding to bot of interval - integer jt ! index corresponding to top of interval - integer m ! index -! - real(r8) dyj(plon,plev) ! latitude interval containing dep. pt. - real(r8) yb (plon,plev) ! | - real(r8) yt (plon,plev) ! | - real(r8) hb (plon,plev) ! | -- interpolation coefficients - real(r8) ht (plon,plev) ! | - real(r8) dhb(plon,plev) ! | - real(r8) dht(plon,plev) ! | -! -!----------------------------------------------------------------------- -! - jb = ppdy/2 - jt = jb + 1 -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i = 1,nlon - dyj(i,k) = dy(jdp(i,k)) - yb (i,k) = ( y(jdp(i,k)+1) - ydp(i,k) )/dyj(i,k) - yt (i,k) = 1._r8 - yb(i,k) - hb (i,k) = ( 3.0_r8 - 2.0_r8*yb(i,k) )*yb(i,k)**2 - ht (i,k) = ( 3.0_r8 - 2.0_r8*yt(i,k) )*yt(i,k)**2 - dhb(i,k) = -dyj(i,k)*( yb(i,k) - 1._r8 )*yb(i,k)**2 - dht(i,k) = dyj(i,k)*( yt(i,k) - 1._r8 )*yt(i,k)**2 - end do - end do -! -! Loop over fields. -! - do m = 1,pf -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i = 1,nlon - fdp(i,k,m) = fint(i,k,jb,m)*hb(i,k) + fyb(i,k,m)*dhb(i,k) + & - fint(i,k,jt,m)*ht(i,k) + fyt(i,k,m)*dht(i,k) - end do - end do - end do -! - return -end subroutine heryin diff --git a/src/dynamics/eul/herzin.F90 b/src/dynamics/eul/herzin.F90 deleted file mode 100644 index d56a3d0fe0..0000000000 --- a/src/dynamics/eul/herzin.F90 +++ /dev/null @@ -1,107 +0,0 @@ - -subroutine herzin(pkdim ,pf ,f ,fst ,fsb , & - sig ,dsig ,sigdp ,kdp ,fdp , & - nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Interpolate field on vertical slice to vertical departure point using -! Hermite cubic interpolation. -! -! Method: -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev -!----------------------------------------------------------------------- - implicit none -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer, intent(in) :: pkdim ! vertical dimension - integer, intent(in) :: pf ! dimension (number of fields) -! - real(r8), intent(in) :: f (plon,pkdim,pf) ! fields - real(r8), intent(in) :: fst (plon,pkdim,pf) ! z-derivatives at top edge of interval - real(r8), intent(in) :: fsb (plon,pkdim,pf) ! z-derivatives at bot edge of interval - real(r8), intent(in) :: sig (pkdim) ! vertical grid coordinates - real(r8), intent(in) :: dsig (pkdim) ! intervals between vertical grid pts. - real(r8), intent(in) :: sigdp(plon,plev) ! vertical coord. of departure point -! - integer, intent(in) :: kdp (plon,plev) ! vertical index of departure point - integer, intent(in) :: nlon -! -! Output arguments -! - real(r8), intent(out) :: fdp(plon,plev,pf) ! z-interpolants -! -!----------------------------------------------------------------------- -! -! pkdim Vertical dimension of vertical slice arrays. -! pf Number of fields being interpolated. -! f Vertical slice of data to be interpolated. -! fst z-derivatives at the top edge of each interval contained in f -! fsb z-derivatives at the bot edge of each interval contained in f -! sig Sigma values corresponding to the vertical grid -! dsig Increment in sigma value for each interval in vertical grid. -! sigdp Sigma value at the trajectory midpoint or endpoint for each -! gridpoint in a vertical slice from the global grid. -! kdp Vertical index for each gridpoint. This index points into a -! vertical slice array whose vertical grid is given by sig. -! E.g., sig(kdp(i,j)) .le. sigdp(i,j) .lt. sig(kdp(i,j)+1) . -! fdp Value of field at the trajectory midpoints or endpoints. -! -!---------------------------Local variables----------------------------- -! - integer i,k,m ! indices -! - real(r8) dzk ! vert interval containing the dep. pt. - real(r8) zt ! | - real(r8) zb ! | - real(r8) ht (plon) ! | -- interpolation coefficients - real(r8) hb (plon) ! | - real(r8) dht(plon) ! | - real(r8) dhb(plon) ! | -! -!----------------------------------------------------------------------- -! -!$OMP PARALLEL DO PRIVATE (K, I, DZK, ZT, ZB, HT, HB, DHT, DHB, M) - do k=1,plev - do i=1,nlon - dzk = dsig(kdp(i,k)) - zt = ( sig(kdp(i,k)+1) - sigdp(i,k) )/dzk - zb = 1._r8 - zt - ht (i) = ( 3.0_r8 - 2.0_r8*zt )*zt**2 - hb (i) = ( 3.0_r8 - 2.0_r8*zb )*zb**2 - dht(i) = -dzk*( zt - 1._r8 )*zt**2 - dhb(i) = dzk*( zb - 1._r8 )*zb**2 - end do -! -! Loop over fields. -! - do m=1,pf - do i=1,nlon - fdp(i,k,m) = f(i,kdp(i,k) ,m)* ht(i) + & - fst(i,kdp(i,k),m)*dht(i) + & - f(i,kdp(i,k)+1,m)* hb(i) + & - fsb(i,kdp(i,k),m)*dhb(i) - end do - end do - end do -! - return -end subroutine herzin diff --git a/src/dynamics/eul/hordif.F90 b/src/dynamics/eul/hordif.F90 deleted file mode 100644 index c745b562cc..0000000000 --- a/src/dynamics/eul/hordif.F90 +++ /dev/null @@ -1,154 +0,0 @@ -subroutine hordif(k,ztdt) - -!----------------------------------------------------------------------- -! -! Purpose: -! -! Method: -! Horizontal diffusion of z,d,t,q -! 1. implicit del**2 form above level kmnhdn -! 2. implicit del**N form at level kmnhdn and below -! 3. courant number based truncation at level kmxhdc and above -! 4. increased del**2 coefficient at level kmxhd2 and above -! -! Computational note: this routine is multitasked by level, hence it -! is called once for each k -! -! Author: -! Original version: CCM1 -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, J. Hack, August 1992 -! Reviewed: B. Boville, April 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - use pspect - use comspe - use time_manager, only: get_step_size, is_first_step, get_nstep - use eul_control_mod - use spmd_utils, only : iam -!----------------------------------------------------------------------- - implicit none -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer, intent(in) :: k ! level index - - real(r8), intent(in) :: ztdt ! 2 times time step unless nstep=0 -! -!---------------------------Local workspace----------------------------- -! - integer ir,ii ! spectral indices - integer lmr,lmc ! spectral indices - real(r8) dfac ! large coefficient on del^n multipliers to -! strongly damp waves req'd by Courant limiter - integer lm,m,n ! spectral indices - real(r8) ztodt ! 2 delta t - real(r8) zdt ! model time step - real(r8) dmpini ! used to compute divergence damp rate - real(r8) dmptim ! used to compute divergence damp rate - real(r8) dmprat ! divergence damping rate - real(r8) coef ! coeff. used to apply damping rate to divergence - real(r8) two -! -!----------------------------------------------------------------------- - two=2._r8 -! -! Set the horizontal diffusion factors for each wavenumer at this level -! depending on: whether del^2 or del^N diffusion is to be applied; and -! whether the courant number limit is to be applied. -! - if (k .ge. kmnhdn) then ! Del^N diffusion factors - do n=1,pnmax - hdiftq(n,k) = hdfstn(n) - hdifzd(n,k) = hdfsdn(n) - end do -! -! Spectrally truncate selected levels (if courant number too large) -! - if (k.le. kmxhdc .and. nindex(k).le.pnmax) then - dfac = 1000._r8 - do n=nindex(k),pnmax - hdiftq(n,k) = dfac*hdfstn(n) - hdifzd(n,k) = dfac*hdfsdn(n) - end do - end if - else ! Del^2 diffusion factors - if (k.le.kmxhd2) then -! -! Buggy sun compiler gives wrong answer for following line when -! using -Qoption f90comp -r8const flags -! dfac = 2.**(real(kmxhd2-k+1,r8)) - dfac = two**(real(kmxhd2-k+1,r8)) - else - dfac = 1.0_r8 - end if - do n=1,pnmax - hdiftq(n,k) = dfac*hdfst2(n) - hdifzd(n,k) = dfac*hdfsd2(n) - end do -! -! Spectrally truncate selected levels (if courant number too large) -! - if ((k.le.kmxhdc).and.(nindex(k).le.pnmax)) then - dfac = 1000._r8 - do n=nindex(k),pnmax - hdiftq(n,k) = dfac*hdfst2(n) - hdifzd(n,k) = dfac*hdfsd2(n) - end do - end if - end if -! -! Define damping rate for divergence damper -! - zdt = get_step_size() - -! ztodt = 2._r8*zdt -! if (is_first_step()) ztodt = .5_r8*ztodt - ztodt = ztdt -! -! Initial damping rate (e-folding time = zdt) and then linearly decrease -! to 0. over number of days specified by "divdampn". -! - coef = 1._r8 - if (divdampn .gt. 0.0_r8) then - dmpini = 1._r8/(zdt) - dmptim = divdampn*86400._r8 - dmprat = dmpini * (dmptim - real(get_nstep(),r8)*zdt) / dmptim - if (dmprat .gt. 0.0_r8) coef = 1.0_r8 / (1.0_r8+ztodt*dmprat) - endif -! -! Compute time-split implicit factors for this level -! - do lm=1,numm(iam) - m=locm(lm,iam) - lmr = lnstart(lm) - lmc = 2*lmr - do n=1,nlen(m) - ir = lmc + 2*n - 1 - ii = ir + 1 -! -! time-split implicit factors -! - t(ir,k) = t(ir,k)/(1._r8 + ztdt*hdiftq(n+m-1,k)) - t(ii,k) = t(ii,k)/(1._r8 + ztdt*hdiftq(n+m-1,k)) -! - d(ir,k) = d(ir,k)*coef/(1._r8 + ztdt*hdifzd(n+m-1,k)) - d(ii,k) = d(ii,k)*coef/(1._r8 + ztdt*hdifzd(n+m-1,k)) -! - vz(ir,k) = vz(ir,k)/(1._r8 + ztdt*hdifzd(n+m-1,k)) - vz(ii,k) = vz(ii,k)/(1._r8 + ztdt*hdifzd(n+m-1,k)) - end do - end do -! - return -end subroutine hordif - diff --git a/src/dynamics/eul/hrintp.F90 b/src/dynamics/eul/hrintp.F90 deleted file mode 100644 index 84ab7668b0..0000000000 --- a/src/dynamics/eul/hrintp.F90 +++ /dev/null @@ -1,139 +0,0 @@ - -subroutine hrintp(pf ,pkcnst ,fb ,fxl ,fxr , & - x ,y ,dy ,wdy ,xdp , & - ydp ,idp ,jdp ,jcen ,limitd , & - fint ,fyb ,fyt ,fdp ,nlon , & - nlonex ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Interpolate 2-d field to departure point using tensor product -! Hermite cubic interpolation. -! -! Method: -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plev, plon - use scanslt, only: plond, platd, beglatex, endlatex -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -#include -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer, intent(in) :: pf ! dimension (number of fields) - integer, intent(in) :: pkcnst ! dimension (see ext. document) -! - real(r8), intent(in) :: fb (plond,plev,pkcnst,beglatex:endlatex) ! input fields - real(r8), intent(in) :: fxl(plond,plev,pf ,beglatex:endlatex) ! left x-derivs - real(r8), intent(in) :: fxr(plond,plev,pf ,beglatex:endlatex) ! right x-derivs - real(r8), intent(in) :: x (plond,platd) ! long. grid coordinates - real(r8), intent(in) :: y (platd) ! lat. grid coordinates - real(r8), intent(in) :: dy (platd) ! intervals betwn lat grid pts. - real(r8), intent(in) :: wdy(4,2,platd) ! lat. derivative weights - real(r8), intent(in) :: xdp(plon,plev) ! x-coord of dep. pt. - real(r8), intent(in) :: ydp(plon,plev) ! y-coord of dep. pt. -! - integer, intent(in) :: idp(plon,plev,4) ! i index of dep. pt. - integer, intent(in) :: jdp(plon,plev) ! j index of dep. pt. - integer, intent(in) :: jcen -! - logical, intent(in) :: limitd ! flag for shape-preservation -! -! Output arguments -! - real(r8), intent(out) :: fint(plon,plev,ppdy,pf) ! x interpolants - real(r8), intent(out) :: fyb (plon,plev,pf) ! y-derivatives at bot of int. - real(r8), intent(out) :: fyt (plon,plev,pf) ! y-derivatives at top of int. - real(r8), intent(out) :: fdp (plon,plev,pf) ! horizontal interpolants - - integer, intent(in) :: nlon - integer, intent(in) :: nlonex(platd) -! -!----------------------------------------------------------------------- -! -! pf Number of fields being interpolated. -! pkcnst dimensioning construct for 3-D arrays. (see ext. document) -! fb Extended array of data to be interpolated. -! fxl x-derivatives at the left edge of each interval containing -! the departure point. -! fxr x-derivatives at the right edge of each interval containing -! the departure point. -! x Equally spaced x grid values in extended arrays. -! y y-coordinate (latitude) values in the extended array. -! dy Increment in the y-coordinate value for each interval in the -! extended array. -! wdy Weights for Lagrange cubic derivative estimates on the -! unequally spaced y-grid. If grid interval j (in extended -! array is surrounded by a 4 point stencil, then the -! derivative at the "bottom" of the interval uses the weights -! wdy(1,1,j),wdy(2,1,j), wdy(3,1,j), and wdy(4,1,j). The -! derivative at the "top" of the interval uses wdy(1,2,j), -! wdy(2,2,j), wdy(3,2,j) and wdy(4,2,j). -! xdp xdp(i,k) is the x-coordinate of the departure point that -! corresponds to global grid point (i,k) in the latitude slice -! being forecasted. -! ydp ydp(i,k) is the y-coordinate of the departure point that -! corresponds to global grid point (i,k) in the latitude slice -! being forecasted. -! idp idp(i,k) is the index of the x-interval that contains the -! departure point corresponding to global grid point (i,k) in -! the latitude slice being forecasted. -! Note that -! x(idp(i,k)) .le. xdp(i,k) .lt. x(idp(i,k)+1) . -! jdp jdp(i,k) is the index of the y-interval that contains the -! departure point corresponding to global grid point (i,k) in -! the latitude slice being forecasted. -! Suppose yb contains the y-coordinates of the extended array -! and ydp(i,k) is the y-coordinate of the departure point -! corresponding to grid point (i,k). Then, -! yb(jdp(i,k)) .le. ydp(i,k) .lt. yb(jdp(i,k)+1) . -! limitd Logical flag to specify whether or not the y-derivatives will -! be limited. -! fint WORK ARRAY, results not used on return -! fyb WORK ARRAY, results not used on return -! fyt WORK ARRAY, results not used on return -! fdp Value of field at the horizontal departure points. -! -!----------------------------------------------------------------------- -! -! Hermite cubic interpolation to the x-coordinate of each -! departure point at each y-coordinate required to compute the -! y-derivatives. -! - call herxin(pf ,pkcnst ,fb ,fxl ,fxr , & - x ,xdp ,idp ,jdp ,fint , & - nlon ,nlonex ) -! -! Compute y-derivatives. -! - call cubydr(pf ,fint ,wdy ,jdp ,jcen , & - fyb ,fyt ,nlon ) - if( limitd )then - call limdy(pf ,fint ,dy ,jdp ,fyb , & - fyt ,nlon ) - end if -! -! Hermite cubic interpolation in the y-coordinate. -! - call heryin(pf ,fint ,fyb ,fyt ,y , & - dy ,ydp ,jdp ,fdp ,nlon ) -! - return -end subroutine hrintp diff --git a/src/dynamics/eul/interp_mod.F90 b/src/dynamics/eul/interp_mod.F90 deleted file mode 100644 index a36f01d731..0000000000 --- a/src/dynamics/eul/interp_mod.F90 +++ /dev/null @@ -1,65 +0,0 @@ -module interp_mod - use shr_kind_mod, only : r8=>shr_kind_r8 - use cam_abortutils, only : endrun - - implicit none - private - save - - public :: setup_history_interpolation - public :: set_interp_hfile - public :: write_interpolated - - interface write_interpolated - module procedure write_interpolated_scalar - module procedure write_interpolated_vector - end interface - integer, parameter :: nlat=0, nlon=0 -contains - - subroutine setup_history_interpolation(interp_ok, mtapes, interp_output, & - interp_info) - use cam_history_support, only: interp_info_t - - ! Dummy arguments - logical, intent(inout) :: interp_ok - integer, intent(in) :: mtapes - logical, intent(in) :: interp_output(:) - type(interp_info_t), intent(inout) :: interp_info(:) - - interp_ok = .false. - - end subroutine setup_history_interpolation - - subroutine set_interp_hfile(hfilenum, interp_info) - use cam_history_support, only: interp_info_t - - ! Dummy arguments - integer, intent(in) :: hfilenum - type(interp_info_t), intent(inout) :: interp_info(:) - end subroutine set_interp_hfile - - subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp_type) - use pio, only : file_desc_t, var_desc_t - use shr_kind_mod, only : r8=>shr_kind_r8 - implicit none - type(file_desc_t), intent(inout) :: File - type(var_desc_t), intent(inout) :: varid - real(r8), intent(in) :: fld(:,:,:) - integer, intent(in) :: numlev, data_type, decomp_type - call endrun('This routine is a stub, you shouldnt get here') - - end subroutine write_interpolated_scalar - - subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, data_type, decomp_type) - use pio, only : file_desc_t, var_desc_t - implicit none - type(file_desc_t), intent(inout) :: File - type(var_desc_t), intent(inout) :: varidu, varidv - real(r8), intent(in) :: fldu(:,:,:), fldv(:,:,:) - integer, intent(in) :: numlev, data_type, decomp_type - call endrun('This routine is a stub, you shouldnt get here') - - end subroutine write_interpolated_vector - -end module interp_mod diff --git a/src/dynamics/eul/iop.F90 b/src/dynamics/eul/iop.F90 deleted file mode 100644 index 24791ad0ed..0000000000 --- a/src/dynamics/eul/iop.F90 +++ /dev/null @@ -1,1155 +0,0 @@ -module iop -!----------------------------------------------------------------------- -!BOP -! -! !MODULE: iop -! -! !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 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 -! -! !PUBLIC TYPES: - implicit none - - - 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 :: divq3dsav(:,:,:,:) - 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 DATA: - public betasav, & - dqfx3sav, divq3dsav, divt3dsav,divu3dsav,divv3dsav,t2sav,fusav,fvsav - -! -! !REVISION HISTORY: -! Created by John Truesdale -! -!EOP -! -! !PRIVATE MEMBER FUNCTIONS: -!----------------------------------------------------------------------- - -contains - subroutine init_iop_fields() -!------------------------------------------------------------------------------ -! Coupler for converting dynamics output variables into physics input variables -! also writes dynamics variables (on physics grid) to history file -!------------------------------------------------------------------------------ - implicit none - character(len=*), parameter :: sub = "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 - endif - - if(.not.allocated(dqfx3sav)) then - allocate (dqfx3sav(plon,plev,pcnst,beglat:endlat)) - dqfx3sav(:,:,:,:)=0._r8 - endif - if(.not.allocated(divq3dsav)) then - allocate (divq3dsav(plon,plev,pcnst,beglat:endlat)) - divq3dsav(:,:,:,:)=0._r8 - endif - if(.not.allocated(divt3dsav)) then - allocate (divt3dsav(plon,plev,beglat:endlat)) - divt3dsav(:,:,:)=0._r8 - endif - if(.not.allocated(divu3dsav)) then - allocate (divu3dsav(plon,plev,beglat:endlat)) - divu3dsav(:,:,:)=0._r8 - endif - if(.not.allocated(divv3dsav)) then - allocate (divv3dsav(plon,plev,beglat:endlat)) - divv3dsav(:,:,:)=0._r8 - endif - if(.not.allocated(t2sav)) then - allocate (t2sav(plon,plev,beglat:endlat)) ! temp tendency - t2sav(:,:,:)=0._r8 - endif - if(.not.allocated(fusav)) then - allocate (fusav(plon,plev,beglat:endlat)) ! U wind tendency - fusav(:,:,:)=0._r8 - endif - if(.not.allocated(fvsav)) then - allocate (fvsav(plon,plev,beglat:endlat)) ! v wind tendency - fvsav(:,:,:)=0._r8 - 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 -!------------------------------------------------------------------------------ - - 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. - -!------------------------------------------------------------------------------ -! 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 - - 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 - - return - -end subroutine setiopupdate - -end module iop - diff --git a/src/dynamics/eul/lagyin.F90 b/src/dynamics/eul/lagyin.F90 deleted file mode 100644 index faaa5f10b3..0000000000 --- a/src/dynamics/eul/lagyin.F90 +++ /dev/null @@ -1,151 +0,0 @@ - -subroutine lagyin(pf ,fint ,wdy ,ydp ,jdp , & - jcen ,fdp ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! For each departure point in the latitude slice to be forecast, -! interpolate (using unequally spaced Lagrange cubic formulas) the -! x interpolants to the y value of the departure point. -! -! Method: -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev - use scanslt, only: platd - use cam_abortutils, only: endrun - use cam_logfile, only: iulog -#if (!defined UNICOSMP) - use srchutil, only: whenieq -#endif -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -#include -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer, intent(in) :: pf ! dimension (number of fields) -! - real(r8), intent(in) :: fint(plon,plev,ppdy,pf) ! x-interpolants - real(r8), intent(in) :: wdy(4,2,platd) ! y-interpolation weights - real(r8), intent(in) :: ydp(plon,plev) ! y-coordinates of departure pts. -! - integer, intent(in) :: jdp(plon,plev) ! j-index of departure point coord. - integer, intent(in) :: jcen ! current latitude - integer, intent(in) :: nlon -! -! Output arguments -! - real(r8), intent(out) :: fdp(plon,plev,pf) ! interpolants at the horiz. depart. pt. -! -!----------------------------------------------------------------------- -! -! pf Number of fields being interpolated. -! fint (fint(i,k,j,m),j=ppdy/2,ppdy/2 + 1) contains the x -! interpolants at the endpoints of the y-interval that contains -! the departure point for grid point (i,k). The last index of -! fint allows for interpolation of multiple fields. fint is -! generated by a call to herxin. -! wdy Grid values and weights for Lagrange cubic interpolation on -! the unequally spaced y-grid. -! ydp ydp(i,k) is the y-coordinate of the departure point that -! corresponds to global grid point (i,k) in the latitude slice -! being forecasted. -! jdp jdp(i,k) is the index of the y-interval that contains the -! departure point corresponding to global grid point (i,k) in -! the latitude slice being forecasted. -! Note that -! y(jdp(i,k)) .le. ydp(i,k) .lt. y(jdp(i,k)+1) . -! fdp Horizontally interpolated field values at the departure point -! for the latitude slice being forecasted. -! -!---------------------------Local variables----------------------------- -! - integer i,m ! indices -! - real(r8) ymy1 ! | - real(r8) ymy2 ! | - real(r8) ymy3 ! | - real(r8) ymy4 ! | - real(r8) coef12 ! | - real(r8) coef34 ! | -- interpolation weights/coeffs. - real(r8) term1(plon,plev) ! | - real(r8) term2(plon,plev) ! | - real(r8) term3(plon,plev) ! | - real(r8) term4(plon,plev) ! | -! - integer jdpval,icount,ii,indx(plon),nval(plev) - integer k -! -!----------------------------------------------------------------------- -! - if( ppdy .ne. 4) then - call endrun ('LAGYIN:Error: ppdy .ne. 4') - end if - icount = 0 - do jdpval=jcen-2,jcen+1 - if (icount.lt.nlon*plev) then -!$OMP PARALLEL DO PRIVATE (K, INDX, II, I, YMY3, YMY4, COEF12, YMY2, YMY1, COEF34) - do k=1,plev - call whenieq(nlon,jdp(1,k),1,jdpval,indx,nval(k)) -! - do ii = 1,nval(k) - i=indx(ii) - ymy3 = ydp(i,k) - wdy(3,1,jdpval) - ymy4 = ydp(i,k) - wdy(4,1,jdpval) - coef12 = ymy3*ymy4 - ymy2 = ydp(i,k) - wdy(2,1,jdpval) - term1(i,k) = coef12*ymy2*wdy(1,2,jdpval) - ymy1 = ydp(i,k) - wdy(1,1,jdpval) - term2(i,k) = coef12*ymy1*wdy(2,2,jdpval) - coef34 = ymy1*ymy2 - term3(i,k) = coef34*ymy4*wdy(3,2,jdpval) - term4(i,k) = coef34*ymy3*wdy(4,2,jdpval) - end do - end do - do k=1,plev - icount = icount + nval(k) - enddo - end if - end do - if (icount.ne.nlon*plev) then - write(iulog,*)'LAGYIN: Departure pt out of bounds: jcen,icount,nlon*plev=',jcen,icount,nlon*plev - write(iulog,*)' ****** MODEL IS BLOWING UP: CFL condition likely violated *********' - write(iulog,*)' Possible solutions: a) reduce time step' - write(iulog,*)' b) if initial run, set "DIVDAMPN = 1." in namelist and rerun' - write(iulog,*)' c) modified code may be in error' - call endrun - end if -! -! Loop over fields. -! - do m = 1,pf -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i = 1,nlon - fdp(i,k,m) = fint(i,k,1,m)*term1(i,k) + & - fint(i,k,2,m)*term2(i,k) + & - fint(i,k,3,m)*term3(i,k) + & - fint(i,k,4,m)*term4(i,k) - end do - end do - end do -! - return -end subroutine lagyin diff --git a/src/dynamics/eul/limdx.F90 b/src/dynamics/eul/limdx.F90 deleted file mode 100644 index 7d9ab9aa40..0000000000 --- a/src/dynamics/eul/limdx.F90 +++ /dev/null @@ -1,100 +0,0 @@ - -subroutine limdx(pidim ,ibeg ,len ,dx ,f ,& - fxl ,fxr ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Limit the derivative estimates for data on an equally spaced grid -! so they satisfy the SCM0 condition, that is, the spline will be -! monotonic, but only C0 continuous on the domain -! -! Method: -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use scanslt, only: plond - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - -!----------------------------------------------------------------------- - implicit none -!---------------------------Local parameters---------------------------- -! - integer pbpts ! (length of latitude slice)*fields - parameter(pbpts = plond) -! -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer, intent(in) :: pidim ! vector dimension - integer, intent(in) :: ibeg ! index of vector to begin computation - integer, intent(in) :: len ! length of vector to compute -! - real(r8), intent(in) :: dx ! length of grid inteval - real(r8), intent(in) :: f(pidim) ! field -! -! Input/output arguments -! - real(r8), intent(inout) :: fxl(pidim) ! x-derivs at left edge of interval - real(r8), intent(inout) :: fxr(pidim) ! x-derivs at right edge of interval -! -!----------------------------------------------------------------------- -! -! pidim Length of f, fxl, and fxr. -! ibeg First interval of grid for which derivatives are computed. -! len Number of grid intervals for which derivatives are computed. -! (There are pidim - 1 intervals between the pidim gridpoints -! represented in f, fxl, and fxr.) -! dx Value of grid spacing. -! f Values on equally spaced grid from which derivatives fxl and -! fxr were computed. -! fxl fxl(i) is the limited derivative at the left edge of -! interval -! fxr fxr(i) is the limited derivative at the right edge of -! interval -! -!---------------------------Local variables----------------------------- -! - integer i ! index - integer iend ! index to end work on vector -! - real(r8) rdx ! 1./dx - real(r8) deli(pbpts) ! simple linear derivative -! -!----------------------------------------------------------------------- -! - if(pidim .gt. pbpts) then - write(iulog,9000) pidim - call endrun - end if -! - iend = ibeg + len - 1 - rdx = 1._r8/dx -! - do i = ibeg,iend - deli(i) = ( f(i+1) - f(i) )*rdx - end do -! -! Limiter -! - call scm0(len ,deli(ibeg),fxl(ibeg),fxr(ibeg)) -! - return -9000 format('LIMDX: Local work array DELI not dimensioned large enough' & - ,/' Increase local parameter pbpts to ',i5) -end subroutine limdx - diff --git a/src/dynamics/eul/limdy.F90 b/src/dynamics/eul/limdy.F90 deleted file mode 100644 index abcb526b35..0000000000 --- a/src/dynamics/eul/limdy.F90 +++ /dev/null @@ -1,126 +0,0 @@ - -subroutine limdy(pf ,fint ,dy ,jdp ,fyb ,& - fyt ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Limit the y-derivative estimates so they satisy the SCM0 for the -! x-interpolated data corresponding to the departure points of a single -! latitude slice in the global grid, that is, they are monotonic, but -! spline has only C0 continuity -! -! Method: -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996! -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev - use scanslt, only: platd -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -#include -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer, intent(in) :: pf ! dimension (number of fields) -! - real(r8), intent(in) :: fint(plon,plev,ppdy,pf) ! x-interpolants - real(r8), intent(in) :: dy(platd) ! interval lengths in lat grid -! - integer, intent(in) :: jdp(plon,plev) ! j-index of coord. of dep. pt. - integer, intent(in) :: nlon -! -! Input/output arguments -! - real(r8), intent(inout) :: fyb(plon,plev,pf) ! y-derivatives at bot of interval - real(r8), intent(inout) :: fyt(plon,plev,pf) ! y-derivatives at top of interval -! -!----------------------------------------------------------------------- -! -! pf Number of fields being interpolated. -! fint (fint(i,k,j,m),j=1,ppdy) contains the x interpolants at each -! latitude needed for the y derivative estimates at the -! endpoints of the interval that contains the departure point -! for grid point (i,k). The last index of fint allows for -! interpolation of multiple fields. fint is generated by a -! call to herxin. -! dy Increment in the y-coordinate value for each interval in the -! extended array. -! jdp jdp(i,k) is the index of the y-interval that contains the -! departure point corresponding to global grid point (i,k) in -! the latitude slice being forecasted. -! Suppose yb contains the y-coordinates of the extended array -! and ydp(i,k) is the y-coordinate of the departure point -! corresponding to grid point (i,k). Then, -! yb(jdp(i,k)) .le. ydp(i,k) .lt. yb(jdp(i,k)+1) . -! fyb fyb(i,k,.) is the limited derivative at the bot of the y -! interval that contains the departure point of global grid -! point (i,k). -! fyt fyt(i,k,.) is the limited derivative at the top of the y -! interval that contains the departure point of global grid -! point (i,k). -! -!---------------------------Local variables----------------------------- -! - integer i,k,m ! indices - integer jb ! index for bottom of interval - integer jt ! index for top of interval -! - real(r8) rdy (plon,plev) ! 1./dy - real(r8) deli(plon) ! simple linear derivative - -!GRCJR - real(r8) fac,tmp1,tmp2 - fac = 3._r8*(1._r8 - 10._r8*epsilon(fac)) -! -!----------------------------------------------------------------------- -! - jb = ppdy/2 - jt = jb + 1 -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k = 1,plev - do i = 1,nlon - rdy(i,k) = 1._r8/dy(jdp(i,k)) - end do - end do -! -! Loop over fields. -! - do m = 1,pf -!$OMP PARALLEL DO PRIVATE (K, I, DELI, TMP1, TMP2) - do k = 1,plev - do i = 1,nlon - deli(i) = ( fint(i,k,jt,m) - fint(i,k,jb,m) )*rdy(i,k) -! end do -! -! Limiter -! -!GRCJR call scm0(nlon,deli,fyb(1,k,m),fyt(1,k,m)) -! do i = 1,nlon - tmp1 = fac*deli(i) - tmp2 = abs( tmp1 ) - if( deli(i)*fyb(i,k,m) <= 0.0_r8 ) fyb(i,k,m) = 0._r8 - if( deli(i)*fyt(i,k,m) <= 0.0_r8 ) fyt(i,k,m) = 0._r8 - if( abs( fyb(i,k,m) ) > tmp2 ) fyb(i,k,m) = tmp1 - if( abs( fyt(i,k,m) ) > tmp2 ) fyt(i,k,m) = tmp1 - end do - end do - end do -! - return -end subroutine limdy diff --git a/src/dynamics/eul/limdz.F90 b/src/dynamics/eul/limdz.F90 deleted file mode 100644 index d13eb4ce33..0000000000 --- a/src/dynamics/eul/limdz.F90 +++ /dev/null @@ -1,96 +0,0 @@ - -subroutine limdz(f ,dsig ,fst ,fsb ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Apply SCMO limiter to vertical derivative estimates on a vertical -! slice. -! -! Method: -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - use constituents, only: pcnst -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- - integer plevm1 - parameter( plevm1 = plev - 1 ) -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - real(r8), intent(in) :: f(plon,plev,pcnst) ! input field - real(r8), intent(in) :: dsig(plev) ! size of vertical interval - - integer, intent(in) :: nlon -! -! Input/output arguments -! - real(r8), intent(inout) :: fst(plon,plev,pcnst) ! z-derivative at top of interval - real(r8), intent(inout) :: fsb(plon,plev,pcnst) ! z-derivative at bot of interval -! -!----------------------------------------------------------------------- -! -! f Field values used to compute the discrete differences for -! each interval in the vertical grid. -! dsig Increment in the sigma-coordinate value for each interval. -! fst Limited derivative at the top of each interval. -! fsb Limited derivative at the bottom of each interval. -! -!---------------------------Local variables----------------------------- -! - integer i ! longitude index - integer k ! vertical index - integer m ! constituent index -! - real(r8) rdsig ! 1./dsig - real(r8) deli(plon) ! simple linear derivative - -!GRCJR - real(r8) fac,tmp1,tmp2 - fac = 3._r8*(1._r8 - 10._r8*epsilon(fac)) - -! -!------------------------------Externals-------------------------------- -! -!GRCJR external scm0 -! -!----------------------------------------------------------------------- -! -! Loop over fields. -! - do m = 1,pcnst -!$OMP PARALLEL DO PRIVATE (K, RDSIG, I, DELI, TMP1, TMP2) - do k = 1,plev-1 - rdsig = 1.0_r8/dsig(k) - do i = 1,nlon - deli(i) = ( f(i,k+1,m) - f(i,k,m) )*rdsig -!GRCJR end do -!GRCJR call scm0(nlon,deli,fst(1,k,m),fsb(1,k,m) ) -!GRCJR do i=1,nlon - tmp1 = fac*deli(i) - tmp2 = abs( tmp1 ) - if( deli(i)*fst(i,k,m) <= 0.0_r8 ) fst(i,k,m) = 0._r8 - if( deli(i)*fsb(i,k,m) <= 0.0_r8 ) fsb(i,k,m) = 0._r8 - if( abs( fst(i,k,m) ) > tmp2 ) fst(i,k,m) = tmp1 - if( abs( fsb(i,k,m) ) > tmp2 ) fsb(i,k,m) = tmp1 - end do - end do - end do -! - return -end subroutine limdz diff --git a/src/dynamics/eul/linemsdyn.F90 b/src/dynamics/eul/linemsdyn.F90 deleted file mode 100644 index 1ec5104f8b..0000000000 --- a/src/dynamics/eul/linemsdyn.F90 +++ /dev/null @@ -1,563 +0,0 @@ - -module linemsdyn - -!----------------------------------------------------------------------- -! -! Purpose: -! Control non-linear dynamical terms, FFT and combine terms -! in preparation for Fourier -> spectral quadrature. -! -! Method: -! The naming convention is as follows: -! - prefix gr contains grid point values before FFT and Fourier -! coefficients after -! - t, q, d, z and ps refer to temperature, specific humidity, -! divergence, vorticity and surface pressure -! - "1" suffix to an array => symmetric component current latitude pair -! - "2" suffix to an array => antisymmetric component. -! -! Author: -! Original version: CCM3 -! Modified: P. Worley, October 2002 -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev, plevp, plat, beglat, endlat - use spmd_utils, only: iam - use perf_mod - implicit none - - private -! -! Public interfaces -! - public linemsdyn_bft ! Before FFT - public linemsdyn_fft ! FFT - public linemsdyn_aft ! After FFT -! -! Public data -! - integer, public, parameter :: plondfft = plon + 2 ! Length needed for FFT - integer, public, parameter :: plndlvfft = plondfft*plev ! Length of multilevel 3-d field slice - -! -!----------------------------------------------------------------------- -! - -contains - -!----------------------------------------------------------------------- - -subroutine linemsdyn_bft( & - lat ,nlon ,nlon_fft, & - psm1 ,psm2 ,u3m1 , & - u3m2 ,v3m1 ,v3m2 ,t3m1 ,t3m2 , & - q3m1 ,etadot ,etamid , & - ztodt , vcour ,vmax ,vmaxt , & - detam ,t2 ,fu ,fv , & - divm1 ,vortm2 ,divm2 ,vortm1 ,phis , & - dpsl ,dpsm ,omga ,cwava ,flx_net , & - fftbuf ) -!----------------------------------------------------------------------- -! -! Purpose: -! Control non-linear dynamical terms and fill FFT buffer -! in preparation for Fourier -> spectral quadrature. -! -! Author: -! Original version: CCM3 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ - - use constituents, only: pcnst - use pspect, only: ptrm, ptrn - use scanslt, only: engy1lat - use commap, only: clat, tau, w - use cam_history, only: outfld - use time_manager, only: get_step_size - use hycoef, only : hypd, hypi - use cam_control_mod, only : adiabatic - use eul_control_mod, only : eul_nsplit -! -! Input arguments -! - integer lat ! latitude index for S->N storage - integer nlon - integer, intent(in) :: nlon_fft ! first dimension of FFT work array - - real(r8), intent(in) :: psm1(plon) ! surface pressure (time n) - real(r8), intent(in) :: psm2(plon) ! surface pressure (time n-1) - real(r8), intent(in) :: u3m1(plon,plev) ! u-wind (time n) - real(r8), intent(in) :: u3m2(plon,plev) ! u-wind (time n-1) - real(r8), intent(in) :: v3m1(plon,plev) ! v-wind (time n) - real(r8), intent(in) :: v3m2(plon,plev) ! v-wind (time n-1) - real(r8), intent(in) :: t3m1(plon,plev) ! temperature (time n) - real(r8), intent(in) :: q3m1(plon,plev,pcnst) ! constituent conc(time n: h2o first) - real(r8), intent(inout) :: etadot(plon,plevp) ! vertical motion (3-d used by slt) - real(r8), intent(in) :: etamid(plev) ! midpoint values of eta (a+b) - real(r8), intent(in) :: ztodt ! 2*timestep unless nstep = 0 - real(r8), intent(in) :: detam(plev) ! maximum Courant number in vert. -! -! Input/Output arguments -! - real(r8), intent(inout) :: t2(plon,plev) ! t tend - real(r8), intent(inout) :: fu(plon,plev) ! nonlinear term - u momentum eqn. - real(r8), intent(inout) :: fv(plon,plev) ! nonlinear term - v momentum eqn. - real(r8), intent(inout) :: divm1(plon,plev) - real(r8), intent(inout) :: vortm2(plon,plev) - real(r8), intent(inout) :: divm2(plon,plev) - real(r8), intent(inout) :: vortm1(plon,plev) - real(r8), intent(inout) :: phis(plon) - real(r8), intent(inout) :: dpsl(plon) - real(r8), intent(inout) :: dpsm(plon) - real(r8), intent(inout) :: omga(plon,plev) - real(r8), intent(inout) :: t3m2(plon,plev) ! temperature (time n-1) - real(r8), intent(in) :: cwava ! weight for global water vapor int. - real(r8), intent(in) :: flx_net(plon) ! net flux from physics -! -! Output arguments -! - real(r8), intent(out) :: fftbuf(nlon_fft,9,plev) ! buffer used for in-place FFTs - real(r8), intent(out) :: vcour(plev) ! maximum Courant number in vert. - real(r8), intent(out) :: vmax(plev) ! maximum wind speed squared (m^2/s^2) - real(r8), intent(out) :: vmaxt(plev) ! maximum truncated wind speed (m^2/s^2) -! -!---------------------------Local workspace----------------------------- -! - real(r8) :: dtime ! timestep size - real(r8) :: bpstr(plon) ! - real(r8) pmid(plon,plev) ! pressure at model levels (time n) - real(r8) rpmid(plon,plev) ! 1./pmid - real(r8) pint(plon,plevp) ! pressure at model interfaces (n ) - real(r8) pdel(plon,plev) ! pdel(k) = pint (k+1)-pint (k) - real(r8) rpdel(plon,plev) ! 1./pdel - real(r8) tdyn(plon,plev) ! temperature for dynamics - real(r8) logpsm1(plon) ! log(psm1) - real(r8) logpsm2(plon) ! log(psm2) - real(r8) engy(plon,plev) ! kinetic energy - real(r8) vat (plon,plev) ! Vertical advection of temperature - real(r8) ktoop(plon,plev) ! (Kappa*T)*(omega/P) - real(r8) ut(plon,plev) ! (u*T) - heat flux - zonal - real(r8) vt(plon,plev) ! (v*T) - heat flux - meridional - real(r8) drhs(plon,plev) ! RHS of divergence eqn. (del^2 term) - real(r8) lvcour ! local vertical courant number - real(r8) dtdz ! dt/detam(k) - real(r8) ddivdt(plon,plev) ! temporary workspace - real(r8) ddpn(plon) ! complete sum of d*delta p - real(r8) vpdsn(plon) ! complete sum V dot grad(ln(ps)) delta b - real(r8) dpslat(plon,plev) ! Pressure gradient term - real(r8) dpslon(plon,plev) ! Pressure gradient term - real(r8) coslat ! cosine(latitude) - real(r8) rcoslat ! 1./cosine(latitude) - real(r8) rhypi ! 1./hypi(plevp) - - real(r8) wind ! u**2 + v**2 (m/s) - real(r8) utfac ! asymmetric truncation factor for courant calculation - real(r8) vtfac ! asymmetric truncation factor for courant calculation - - real(r8) tmp ! accumulator - integer i,k,kk ! longitude,level,constituent indices - integer, parameter :: tdyndex = 1 ! indices into fftbuf - integer, parameter :: fudex = 2 - integer, parameter :: fvdex = 3 - integer, parameter :: utdex = 4 - integer, parameter :: vtdex = 5 - integer, parameter :: drhsdex = 6 - integer, parameter :: vortdyndex = 7 - integer, parameter :: divdyndex = 8 - integer, parameter :: bpstrdex = 9 -! -! This group of arrays are glued together via equivalence to exbuf for -! communication from LINEMSBC. -! -! -!----------------------------------------------------------------------- -! -! -! Compute maximum wind speed this latitude (used in Courant number estimate) -! - if (ptrm .lt. ptrn) then - utfac = real(ptrm,r8)/real(ptrn,r8) - vtfac = 1._r8 - else if (ptrn .lt. ptrm) then - utfac = 1._r8 - vtfac = real(ptrn,r8)/real(ptrm,r8) - else if (ptrn .eq. ptrm) then - utfac = 1._r8 - vtfac = 1._r8 - end if - -!$OMP PARALLEL DO PRIVATE (K, I, WIND) - do k=1,plev - vmax(k) = 0._r8 - vmaxt(k) = 0._r8 - do i=1,nlon - wind = u3m2(i,k)**2 + v3m2(i,k)**2 - vmax(k) = max(wind,vmax(k)) -! -! Change to Courant limiter for non-triangular truncations. -! - wind = utfac*u3m2(i,k)**2 + vtfac*v3m2(i,k)**2 - vmaxt(k) = max(wind,vmaxt(k)) - end do - end do -! -! Variables needed in tphysac -! - coslat = cos(clat(lat)) - rcoslat = 1._r8/coslat -! -! Set current time pressure arrays for model levels etc. -! - call plevs0(nlon,plon,plev,psm1,pint,pmid,pdel) -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i=1,nlon - rpmid(i,k) = 1._r8/pmid(i,k) - rpdel(i,k) = 1._r8/pdel(i,k) - end do - end do -! -! Accumulate statistics for diagnostic print -! - call stats(lat, pint, pdel, psm1, & - vortm1, divm1, t3m1, q3m1(:,:,1), nlon ) -! -! Compute log(surface pressure) for use by grmult and when adding tendency. -! -!$OMP PARALLEL DO PRIVATE (I) - do i=1,nlon - logpsm1(i) = log(psm1(i)) - logpsm2(i) = log(psm2(i)) - end do -! -! Compute integrals -! - call plevs0(nlon,plon,plev,psm2,pint,pmid,pdel) - call engy_te (cwava,w(lat),t3m2,u3m2,v3m2,phis ,pdel, psm2, tmp ,nlon) - engy1lat(lat) = tmp - call plevs0(nlon,plon,plev,psm1,pint,pmid,pdel) -! -! Include top/bottom flux integral to energy integral -! - call flxint (w(lat) ,flx_net ,tmp ,nlon ) - engy1lat(lat) = engy1lat(lat) + tmp *ztodt -! -! Calculate non-linear terms in tendencies -! - if (adiabatic) t2(:,:) = 0._r8 - call outfld('FU ',fu ,plon,lat) - call outfld('FV ',fv ,plon,lat) - call grmult(rcoslat ,divm1 ,q3m1(1,1,1),t3m1 ,u3m1 , & - v3m1 ,vortm1 ,t3m2 ,phis ,dpsl , & - dpsm ,omga ,pdel ,pint(1,plevp),logpsm2, & - logpsm1 ,rpmid ,rpdel ,fu ,fv , & - t2 ,ut ,vt ,drhs ,pmid , & - etadot ,etamid ,engy ,ddpn ,vpdsn , & - dpslon ,dpslat ,vat ,ktoop ,nlon ) -! -! Add tendencies to previous timestep values of surface pressure, -! temperature, and (if spectral transport) moisture. Store *log* surface -! pressure in bpstr array for transform to spectral space. -! - rhypi = 1._r8/hypi(plevp) -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i=1,nlon - ddivdt(i,k) = ztodt*(0.5_r8*divm2(i,k) - divm1(i,k)) - tdyn(i,k) = t3m2(i,k) + ztodt*t2(i,k) - end do - end do - -!$OMP PARALLEL DO PRIVATE (I, K) - do i=1,nlon - bpstr(i) = logpsm2(i) - ztodt*(vpdsn(i)+ddpn(i))/psm1(i) - do k=1,plev - bpstr(i) = bpstr(i) - ddivdt(i,k)*hypd(k)*rhypi - end do - end do - -!$OMP PARALLEL DO PRIVATE (K, KK, I) - do k=1,plev - do kk=1,plev - do i=1,nlon - tdyn(i,k) = tdyn(i,k) - ddivdt(i,kk)*tau(kk,k) - end do - end do - end do - -! -! Compute maximum vertical Courant number this latitude. -! - dtime = get_step_size()/eul_nsplit - vcour(:) = 0._r8 -!$OMP PARALLEL DO PRIVATE (K, DTDZ, I, LVCOUR) - do k=2,plev - dtdz = dtime/detam(k-1) - do i=1,nlon - lvcour = abs(etadot(i,k))*dtdz - vcour(k) = max(lvcour,vcour(k)) - end do - end do - - call outfld('ETADOT ',etadot,plon,lat) - call outfld('VAT ',vat ,plon,lat) - call outfld('KTOOP ',ktoop ,plon,lat) - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! -! Apply cos(lat) to momentum terms before fft -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i=1,nlon - fu(i,k) = coslat*fu(i,k) - fv(i,k) = coslat*fv(i,k) - ut(i,k) = coslat*ut(i,k) - vt(i,k) = coslat*vt(i,k) - end do - end do - -! -! Copy fields into FFT buffer -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i=1,nlon -! -! undifferentiated terms - fftbuf(i,tdyndex,k) = tdyn(i,k) -! longitudinally and latitudinally differentiated terms - fftbuf(i,fudex,k) = fu(i,k) - fftbuf(i,fvdex,k) = fv(i,k) - fftbuf(i,utdex,k) = ut(i,k) - fftbuf(i,vtdex,k) = vt(i,k) - fftbuf(i,drhsdex,k) = drhs(i,k) -! vort,div - fftbuf(i,vortdyndex,k) = vortm2(i,k) - fftbuf(i,divdyndex,k) = divm2(i,k) -! - enddo - enddo -! ps - do i=1,nlon - fftbuf(i,bpstrdex,1) = bpstr(i) - enddo - - return -end subroutine linemsdyn_bft - -!----------------------------------------------------------------------- - -subroutine linemsdyn_fft(nlon_fft,nlon_fft2,fftbuf,fftbuf2) -!----------------------------------------------------------------------- -! -! Purpose: -! Compute FFT of non-linear dynamical terms -! in preparation for Fourier -> spectral quadrature. -! -! Author: -! Original version: CCM3 -! Modified: P. Worley, September 2002 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ - - use pmgrid, only: plon, plat - use eul_control_mod, only : trig, ifax -#if (defined SPMD) - use mpishorthand, only: mpicom -#endif - -! -! Input arguments -! - integer, intent(in) :: nlon_fft ! first dimension of first FFT work array - integer, intent(in) :: nlon_fft2 ! first dimension of second FFT work array -! -! Input/Output arguments -! - real(r8), intent(inout) :: fftbuf(nlon_fft,9,plev,beglat:endlat) - ! buffer used for in-place FFTs -! -! Output arguments -! -#if (defined SPMD) - real(r8), intent(out) :: fftbuf2(nlon_fft2,9,plev,plat) - ! buffer for returning reorderd Fourier coefficients -#else - real(r8), intent(in) :: fftbuf2(1) - ! buffer unused -#endif -! -!---------------------------Local workspace----------------------------- -! -! The "work" array has a different size requirement depending upon whether -! the proprietary Cray assembly language version of the FFT library -! routines, or the all-Fortran version, is being used. -! -#if ( ! defined USEFFTLIB ) - real(r8) work((plon+1)*plev*9) -#else - real(r8) work((plon+1)*pcray) ! workspace array for fft991 -#endif - integer lat ! latitude index - integer inc ! increment for fft991 - integer isign ! flag indicates transform direction - integer ntr ! number of transforms to perform - integer k ! vertical level index -! - inc = 1 - isign = -1 -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE (LAT, NTR, K, WORK) -#endif - do lat=beglat,endlat - ntr = 8 -!$OMP PARALLEL DO PRIVATE (K, WORK) - do k=1,plev - fftbuf(plon+1:nlon_fft,:,k,lat) = 0.0_r8 - call fft991(fftbuf(1,1,k,lat) ,work ,trig(1,lat),ifax(1,lat),inc ,& - nlon_fft ,plon ,ntr ,isign ) - enddo - ntr = 1 - fftbuf(plon+1:nlon_fft,9,1,lat) = 0.0_r8 - call fft991(fftbuf(1,9,1,lat) ,work ,trig(1,lat),ifax(1,lat),inc ,& - nlon_fft ,plon ,ntr ,isign ) - enddo -! -#if ( defined SPMD ) -! -! reorder Fourier coefficients -! - call t_barrierf ('sync_realloc4a', mpicom) - call t_startf('realloc4a') - call realloc4a(nlon_fft, nlon_fft2, fftbuf, fftbuf2) - call t_stopf('realloc4a') -#endif - - return -end subroutine linemsdyn_fft - -!----------------------------------------------------------------------- - -subroutine linemsdyn_aft( & - irow ,nlon_fft,fftbufs ,fftbufn , & - grlps1 ,grt1 ,grz1 ,grd1 , & - grfu1 ,grfv1 ,grut1 ,grvt1 ,grrh1 , & - grlps2 ,grt2 ,grz2 ,grd2 ,grfu2 , & - grfv2 ,grut2 ,grvt2 ,grrh2 ) -!----------------------------------------------------------------------- -! -! Purpose: -! Combine terms in preparation for Fourier -> spectral quadrature. -! -! Author: -! Original version: CCM3 -! Modified: P. Worley, September 2002 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ - - use pspect, only: pmmax -#if (defined SPMD) - use comspe, only: numm, maxm -#else - use comspe, only: maxm -#endif -! Input arguments -! - integer, intent(in) :: irow ! latitude pair index - integer, intent(in) :: nlon_fft ! first dimension of FFT work arrays - - real(r8), intent(in) :: fftbufs(nlon_fft,9,plev) ! southern latitude Fourier coefficients - real(r8), intent(in) :: fftbufn(nlon_fft,9,plev) ! northern latitude Fourier coefficients -! -! Output arguments -! - real(r8), intent(out) :: grlps1(2*maxm) ! sym. undiff. term in lnps eqn. - real(r8), intent(out) :: grlps2(2*maxm) ! antisym undiff. term in lnps eqn. - real(r8), intent(out) :: grt1(2*maxm,plev) ! sym. undiff. term in t eqn. - real(r8), intent(out) :: grt2(2*maxm,plev) ! antisym. undiff. term in t eqn. - real(r8), intent(out) :: grz1(2*maxm,plev) ! sym. undiff. term in z eqn. - real(r8), intent(out) :: grz2(2*maxm,plev) ! antisym. undiff. term in z eqn. - real(r8), intent(out) :: grd1(2*maxm,plev) ! sym. undiff. term in d eqn. - real(r8), intent(out) :: grd2(2*maxm,plev) ! antisym. undiff. term in d eqn. - real(r8), intent(out) :: grfu1(2*maxm,plev) ! sym. nonlinear terms in u eqn. - real(r8), intent(out) :: grfu2(2*maxm,plev) ! antisym. nonlinear terms in u eqn. - real(r8), intent(out) :: grfv1(2*maxm,plev) ! sym. nonlinear terms in v eqn. - real(r8), intent(out) :: grfv2(2*maxm,plev) ! antisym. nonlinear terms in v eqn. - real(r8), intent(out) :: grut1(2*maxm,plev) ! sym. lambda deriv. term in t eqn. - real(r8), intent(out) :: grut2(2*maxm,plev) ! antisym. lambda deriv. term in t eqn. - real(r8), intent(out) :: grvt1(2*maxm,plev) ! sym. mu derivative term in t eqn. - real(r8), intent(out) :: grvt2(2*maxm,plev) ! antisym. mu deriv. term in t eqn. - real(r8), intent(out) :: grrh1(2*maxm,plev) ! sym. del**2 term in d eqn. - real(r8), intent(out) :: grrh2(2*maxm,plev) ! antisym. del**2 term in d eqn. -! -!---------------------------Local workspace----------------------------- -! - integer i,k ! longitude,level indices - integer mlength ! number of wavenumbers - integer, parameter :: tdyndex = 1 ! indices into fftbuf - integer, parameter :: fudex = 2 - integer, parameter :: fvdex = 3 - integer, parameter :: utdex = 4 - integer, parameter :: vtdex = 5 - integer, parameter :: drhsdex = 6 - integer, parameter :: vortdyndex = 7 - integer, parameter :: divdyndex = 8 - integer, parameter :: bpstrdex = 9 -! -#if (defined SPMD) - mlength = numm(iam) -#else - mlength = pmmax -#endif - do k=1,plev - do i=1,2*mlength - - grt1(i,k) = 0.5_r8*(fftbufn(i,tdyndex,k)+fftbufs(i,tdyndex,k)) - grt2(i,k) = 0.5_r8*(fftbufn(i,tdyndex,k)-fftbufs(i,tdyndex,k)) - - grz1(i,k) = 0.5_r8*(fftbufn(i,vortdyndex,k)+fftbufs(i,vortdyndex,k)) - grz2(i,k) = 0.5_r8*(fftbufn(i,vortdyndex,k)-fftbufs(i,vortdyndex,k)) - - grd1(i,k) = 0.5_r8*(fftbufn(i,divdyndex,k)+fftbufs(i,divdyndex,k)) - grd2(i,k) = 0.5_r8*(fftbufn(i,divdyndex,k)-fftbufs(i,divdyndex,k)) - - grfu1(i,k) = 0.5_r8*(fftbufn(i,fudex,k)+fftbufs(i,fudex,k)) - grfu2(i,k) = 0.5_r8*(fftbufn(i,fudex,k)-fftbufs(i,fudex,k)) - - grfv1(i,k) = 0.5_r8*(fftbufn(i,fvdex,k)+fftbufs(i,fvdex,k)) - grfv2(i,k) = 0.5_r8*(fftbufn(i,fvdex,k)-fftbufs(i,fvdex,k)) - - grut1(i,k) = 0.5_r8*(fftbufn(i,utdex,k)+fftbufs(i,utdex,k)) - grut2(i,k) = 0.5_r8*(fftbufn(i,utdex,k)-fftbufs(i,utdex,k)) - - grvt1(i,k) = 0.5_r8*(fftbufn(i,vtdex,k)+fftbufs(i,vtdex,k)) - grvt2(i,k) = 0.5_r8*(fftbufn(i,vtdex,k)-fftbufs(i,vtdex,k)) - - grrh1(i,k) = 0.5_r8*(fftbufn(i,drhsdex,k)+fftbufs(i,drhsdex,k)) - grrh2(i,k) = 0.5_r8*(fftbufn(i,drhsdex,k)-fftbufs(i,drhsdex,k)) - - end do - end do - - do i=1,2*mlength - grlps1(i) = 0.5_r8*(fftbufn(i,bpstrdex,1)+fftbufs(i,bpstrdex,1)) - grlps2(i) = 0.5_r8*(fftbufn(i,bpstrdex,1)-fftbufs(i,bpstrdex,1)) - end do - - return -end subroutine linemsdyn_aft - -!----------------------------------------------------------------------- - -end module linemsdyn diff --git a/src/dynamics/eul/massfix.F90 b/src/dynamics/eul/massfix.F90 deleted file mode 100644 index f701e18a87..0000000000 --- a/src/dynamics/eul/massfix.F90 +++ /dev/null @@ -1,37 +0,0 @@ -!----------------------------------------------------------------------- -module massfix -!----------------------------------------------------------------------- -! -! Purpose: Module for mass fixer, contains global integrals -! -!----------------------------------------------------------------------- -! -! Written by: Dani Bundy Coleman, Oct 2004 -! -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use constituents, only: pcnst - -!----------------------------------------------------------------------- - implicit none -! -! By default everything is private to this module -! - private -! -! Public interfaces -! - - public hw1, hw2, hw3, alpha ! Needs to be public for restart - -! -! Module data -! - real(r8) :: hw1(pcnst) ! Pre-SLT global integral of constituent - real(r8) :: hw2(pcnst) ! Post-SLT global integral of const. - real(r8) :: hw3(pcnst) ! Global integral for denom. of expr. for alpha - real(r8) :: alpha(pcnst) ! alpha(m) = ( hw1(m) - hw2(m) )/hw3(m) - - -end module massfix diff --git a/src/dynamics/eul/parslt.h b/src/dynamics/eul/parslt.h deleted file mode 100644 index 5d9d96c317..0000000000 --- a/src/dynamics/eul/parslt.h +++ /dev/null @@ -1,13 +0,0 @@ -! -! $Id$ -! $Author$ -! -! -! Parameters common to many SLT routines -! - integer ppdy ! length of interpolation grid stencil - logical plimdr ! flag to limit derivatives -! - parameter(ppdy = 4, plimdr = .true.) -! - diff --git a/src/dynamics/eul/pmgrid.F90 b/src/dynamics/eul/pmgrid.F90 deleted file mode 100644 index 1a9eccc8a6..0000000000 --- a/src/dynamics/eul/pmgrid.F90 +++ /dev/null @@ -1,29 +0,0 @@ -module pmgrid - -! Parameters and variables related to the dynamics grid - - implicit none - - public - - integer, parameter :: plon = PLON ! number of longitudes - integer, parameter :: plev = PLEV ! number of vertical levels - integer, parameter :: plat = PLAT ! number of latitudes - integer, parameter :: plevp = plev + 1 ! plev + 1 - integer, parameter :: plnlv = plon*plev ! Length of multilevel field slice - - integer :: beglat ! beg. index for latitudes owned by a given proc - integer :: endlat ! end. index for latitudes owned by a given proc - integer :: begirow ! beg. index for latitude pairs owned by a given proc - integer :: endirow ! end. index for latitude pairs owned by a given proc - integer :: numlats ! number of latitudes owned by a given proc - -#if ( ! defined SPMD ) - parameter (beglat = 1) - parameter (endlat = plat) - parameter (begirow = 1) - parameter (endirow = plat/2) - parameter (numlats = plat) -#endif - -end module pmgrid diff --git a/src/dynamics/eul/prognostics.F90 b/src/dynamics/eul/prognostics.F90 deleted file mode 100644 index 275635031e..0000000000 --- a/src/dynamics/eul/prognostics.F90 +++ /dev/null @@ -1,113 +0,0 @@ - -module prognostics - -!----------------------------------------------------------------------- -! -! Purpose: -! Prognostic variables held in-core for convenient access. -! q3 is specific humidity (water vapor) and other constituents. -! -! Author: G. Grant -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev, beglat, endlat - use infnan, only: posinf, assignment(=) - use constituents, only: pcnst - - - implicit none - - private - - public ps, u3, v3, t3, q3, qminus, vort, div, dpsl, dpsm, dps, omga, phis, hadv, pdeld - public n3, n3m1, n3m2, ptimelevels - public initialize_prognostics - public shift_time_indices - - integer, parameter :: ptimelevels = 3 ! number of time levels in the dycore - integer :: n3 = 3 - integer :: n3m1 = 2 - integer :: n3m2 = 1 - - real(r8), allocatable, target :: ps(:,:,:) - real(r8), allocatable, target :: u3(:,:,:,:) - real(r8), allocatable, target :: v3(:,:,:,:) - real(r8), allocatable, target :: t3(:,:,:,:) - real(r8), allocatable, target :: pdeld(:,:,:,:) - real(r8), allocatable, target :: q3(:,:,:,:,:) - real(r8), allocatable :: qminus(:,:,:,:) - real(r8), allocatable :: hadv (:,:,:,:) - - real(r8), allocatable, target :: vort(:,:,:,:) ! vorticity - real(r8), allocatable, target :: div(:,:,:,:) ! divergence - - real(r8), allocatable, target :: dpsl(:,:) ! longitudinal pressure gradient - real(r8), allocatable, target :: dpsm(:,:) ! meridional pressure gradient - real(r8), allocatable, target :: dps(:,:) ! pressure gradient - real(r8), allocatable, target :: phis(:,:) ! surface geopotential - real(r8), allocatable, target :: omga(:,:,:) ! vertical velocity - -CONTAINS - - subroutine initialize_prognostics -! -! Purpose: Allocate and initialize the prognostic arrays. -! - - allocate (ps (plon ,beglat:endlat ,ptimelevels)) - allocate (u3 (plon,plev ,beglat:endlat,ptimelevels)) - allocate (v3 (plon,plev ,beglat:endlat,ptimelevels)) - allocate (t3 (plon,plev ,beglat:endlat,ptimelevels)) - allocate (q3 (plon,plev,pcnst,beglat:endlat,ptimelevels)) - allocate (qminus(plon,plev,pcnst,beglat:endlat )) - allocate (hadv (plon,plev,pcnst,beglat:endlat )) - - allocate (vort (plon,plev,beglat:endlat,ptimelevels)) - allocate (div (plon,plev,beglat:endlat,ptimelevels)) - - allocate (dpsl (plon,beglat:endlat)) - allocate (dpsm (plon,beglat:endlat)) - allocate (dps (plon,beglat:endlat)) - allocate (phis (plon,beglat:endlat)) - allocate (omga (plon,plev,beglat:endlat)) - allocate (pdeld (plon,plev,beglat:endlat,ptimelevels)) - - ps(:,:,:) = posinf - u3(:,:,:,:) = posinf - v3(:,:,:,:) = posinf - t3(:,:,:,:) = posinf - pdeld(:,:,:,:) = posinf - q3(:,:,:,:,:) = posinf - qminus(:,:,:,:) = posinf - hadv (:,:,:,:) = posinf - - vort(:,:,:,:) = posinf - div (:,:,:,:) = posinf - - dpsl (:,:) = posinf - dpsm (:,:) = posinf - dps (:,:) = posinf - phis (:,:) = posinf - omga (:,:,:) = posinf - - return - end subroutine initialize_prognostics - - subroutine shift_time_indices -! -! Purpose: -! Shift the indices that keep track of which index stores -! the relative times (current time, previous, time before previous etc). -! - integer :: itmp - - itmp = n3m2 - - n3m2 = n3m1 - n3m1 = n3 - n3 = itmp - end subroutine shift_time_indices - -end module prognostics diff --git a/src/dynamics/eul/pspect.F90 b/src/dynamics/eul/pspect.F90 deleted file mode 100644 index f428af14fc..0000000000 --- a/src/dynamics/eul/pspect.F90 +++ /dev/null @@ -1,18 +0,0 @@ -module pspect - -! Parameters related to spectral domain - -integer, parameter :: ptrm = PTRM ! M truncation parameter -integer, parameter :: ptrn = PTRN ! N truncation parameter -integer, parameter :: ptrk = PTRK ! K truncation parameter - -integer, parameter :: pmax = ptrn+1 ! number of diagonals -integer, parameter :: pmaxp = pmax+1 ! Number of diagonals plus 1 -integer, parameter :: pnmax = ptrk+1 ! Number of values of N -integer, parameter :: pmmax = ptrm+1 ! Number of values of M -integer, parameter :: par0 = ptrm+ptrn-ptrk ! intermediate parameter -integer, parameter :: par2 = par0*(par0+1)/2 ! intermediate parameter -integer, parameter :: pspt = (ptrn+1)*pmmax-par2 ! Total num complex spectral coeffs retained -integer, parameter :: psp = 2*pspt ! 2*pspt (real) size of coeff array per level - -end module pspect diff --git a/src/dynamics/eul/quad.F90 b/src/dynamics/eul/quad.F90 deleted file mode 100644 index 0402a96623..0000000000 --- a/src/dynamics/eul/quad.F90 +++ /dev/null @@ -1,278 +0,0 @@ - -subroutine quad(lm ,zdt ,ztdtsq ,grlps1 ,grlps2 ,& - grt1 ,grz1 ,grd1 ,grfu1 ,grfv1 ,& - grvt1 ,grrh1 ,grt2 ,grz2 ,grd2 ,& - grfu2 ,grfv2 ,grvt2 ,grrh2 ) -!----------------------------------------------------------------------- -! -! Perform gaussian quadrature for 1 Fourier wavenumber (m) to obtain the -! spectral coefficients of ln(ps), temperature, vorticity, and divergence. -! Add the tendency terms requiring meridional derivatives during the -! transform. -! -!---------------------------Code history-------------------------------- -! -! Original version: J. Rosinski -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, D. Williamson, J. Hack, August 1992 -! Reviewed: B. Boville, D. Williamson, April 1996 -! Modified: P. Worley, September 2002 -! Modified: NEC, April 2004 -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - use pspect - use comspe - use commap - use physconst, only: rearth - use spmd_utils, only : iam - implicit none -! -! Input arguments -! - integer, intent(in) :: lm ! local Fourier wavenumber index - real(r8), intent(in) :: zdt ! timestep(dt) unless nstep = 0 - real(r8), intent(in) :: ztdtsq(pnmax) ! 2*zdt*n(n+1)/(a^2) -! where n IS the 2-d wavenumber -! -! Fourier coefficient arrays which have a latitude index on them for -! multitasking. These arrays are defined in LINEMS and and in QUAD -! to compute spectral coefficients. They contain a latitude index so -! that the sums over latitude can be performed in a specified order. -! -! Suffixes 1 and 2 refer to symmetric and antisymmetric components -! respectively. -! - real(r8), intent(in) :: grlps1(2*maxm,(plat+1)/2) ! ln(ps) - symmetric - real(r8), intent(in) :: grlps2(2*maxm,(plat+1)/2) ! ln(ps) - antisymmetric -! -! symmetric components -! - real(r8), intent(in) :: grt1(2*maxm,plev,(plat+1)/2) ! temperature - real(r8), intent(in) :: grz1(2*maxm,plev,(plat+1)/2) ! vorticity - real(r8), intent(in) :: grd1(2*maxm,plev,(plat+1)/2) ! divergence - real(r8), intent(in) :: grfu1(2*maxm,plev,(plat+1)/2) ! partial u momentum tendency (fu) - real(r8), intent(in) :: grfv1(2*maxm,plev,(plat+1)/2) ! partial v momentum tendency (fv) - real(r8), intent(in) :: grvt1(2*maxm,plev,(plat+1)/2) ! heat flux - real(r8), intent(in) :: grrh1(2*maxm,plev,(plat+1)/2) ! rhs of div eqn (del^2 term) -! -! antisymmetric components -! - real(r8), intent(in) :: grt2(2*maxm,plev,(plat+1)/2) ! temperature - real(r8), intent(in) :: grz2(2*maxm,plev,(plat+1)/2) ! vorticity - real(r8), intent(in) :: grd2(2*maxm,plev,(plat+1)/2) ! divergence - real(r8), intent(in) :: grfu2(2*maxm,plev,(plat+1)/2) ! partial u momentum tend (fu) - real(r8), intent(in) :: grfv2(2*maxm,plev,(plat+1)/2) ! partial v momentum tend (fv) - real(r8), intent(in) :: grvt2(2*maxm,plev,(plat+1)/2) ! heat flux - real(r8), intent(in) :: grrh2(2*maxm,plev,(plat+1)/2) ! rhs of div eqn (del^2 term) -! -!---------------------------Local workspace----------------------------- -! - integer j ! latitude pair index - integer m ! global wavenumber index - integer n ! total wavenumber index - integer ir,ii ! spectral indices - integer lmr,lmc ! spectral indices - integer k ! level index - integer kv ! index for vectorization - - real(r8) zcsj ! cos**2(lat)*radius of earth - real(r8) zrcsj ! 1./(a*cos^2(lat)) - real(r8) zdtrc ! dt/(a*cos^2(lat)) - real(r8) ztdtrc ! 2dt/(a*cos^2(lat)) - real(r8) zw((plat+1)/2) ! 2*w - real(r8) ztdtrw((plat+1)/2) ! 2w*2dt/(a*cos^2(lat)) - real(r8) zwalp ! zw*alp - real(r8) zwdalp ! zw*dalp - real(r8) sqzwalp ! ztdtsq*zw*alp - - real(r8) tmpGR1odd(plev*6,(plat+1)/2) ! temporary space for Fourier coeffs - real(r8) tmpGR2odd(plev*6,(plat+1)/2) ! - real(r8) tmpGR3odd(plev*6,(plat+1)/2) ! - real(r8) tmpGR1evn(plev*6,(plat+1)/2) ! - real(r8) tmpGR2evn(plev*6,(plat+1)/2) ! - real(r8) tmpGR3evn(plev*6,(plat+1)/2) ! - - real(r8) tmpSPEodd(plev*6,2*ptrn) ! temporary space for spectral coeffs - real(r8) tmpSPEevn(plev*6,2*ptrn) ! -! -!----------------------------------------------------------------------- -! -! Compute constants -! -!$OMP PARALLEL DO PRIVATE(J, ZCSJ, ZRCSJ, ZDTRC, ZTDTRC) - do j=1,plat/2 - zcsj = cs(j)*rearth - zrcsj = 1._r8/zcsj - zdtrc = zdt*zrcsj - ztdtrc = 2._r8*zdtrc - zw(j) = w(j)*2._r8 - ztdtrw(j) = ztdtrc*zw(j) - end do -! -! Accumulate contributions to spectral coefficients of ln(p*), the only -! single level field. Use symmetric or antisymmetric fourier cofficients -! depending on whether the total wavenumber is even or odd. -! - m = locm(lm,iam) - lmr = lnstart(lm) - lmc = 2*lmr - do n=1,2*nlen(m) - alps(lmc+n) = 0._r8 - end do -!$OMP PARALLEL DO PRIVATE(N, J, IR, II, ZWALP) - do n=1,nlen(m),2 - ir = lmc + 2*n - 1 - ii = ir + 1 - do j=1,plat/2 - zwalp = zw(j)*lalp(lmr+n,j) - alps(ir) = alps(ir) + grlps1(2*lm-1,j)*zwalp - alps(ii) = alps(ii) + grlps1(2*lm ,j)*zwalp - end do - end do -!$OMP PARALLEL DO PRIVATE(N, J, IR, II, ZWALP) - do n=2,nlen(m),2 - ir = lmc + 2*n - 1 - ii = ir + 1 - do j=1,plat/2 - zwalp = zw(j)*lalp(lmr+n,j) - alps(ir) = alps(ir) + grlps2(2*lm-1,j)*zwalp - alps(ii) = alps(ii) + grlps2(2*lm ,j)*zwalp - end do - end do -! -! Accumulate contributions to spectral coefficients of the multilevel fields. -! Use symmetric or antisymmetric fourier coefficients depending on whether -! the total wavenumber is even or odd. -! -! -! Initialize temporary storage for spectral coefficients -! - do n=1,nlen(m) - do kv=1,plev*6 - tmpSPEodd(kv,n) = 0._r8 - tmpSPEevn(kv,n) = 0._r8 - end do - end do -! -! Rearrange Fourier coefficients to temporal storage -! -!$OMP PARALLEL DO PRIVATE(J, K) - do j = 1,plat/2 - do k=1,plev - - tmpGR1odd(k ,j) = grt1 (2*lm-1,k,j) ! first term for odd n - tmpGR1odd(k+plev ,j) = grt1 (2*lm ,k,j) - tmpGR1odd(k+plev*2,j) = grd1 (2*lm-1,k,j) - tmpGR1odd(k+plev*3,j) = grd1 (2*lm ,k,j) - tmpGR1odd(k+plev*4,j) = grz1 (2*lm-1,k,j) - tmpGR1odd(k+plev*5,j) = grz1 (2*lm ,k,j) - - tmpGR2odd(k ,j) = grvt2(2*lm-1,k,j) ! second term for odd n - tmpGR2odd(k+plev ,j) = grvt2(2*lm ,k,j) - tmpGR2odd(k+plev*2,j) = -grfv2(2*lm-1,k,j) - tmpGR2odd(k+plev*3,j) = -grfv2(2*lm ,k,j) - tmpGR2odd(k+plev*4,j) = grfu2(2*lm-1,k,j) - tmpGR2odd(k+plev*5,j) = grfu2(2*lm ,k,j) - - tmpGR3odd(k+plev*2,j) = grrh1(2*lm-1,k,j) ! additional term for odd n - tmpGR3odd(k+plev*3,j) = grrh1(2*lm ,k,j) - - tmpGR1evn(k ,j) = grt2 (2*lm-1,k,j) ! first term for even n - tmpGR1evn(k+plev ,j) = grt2 (2*lm ,k,j) - tmpGR1evn(k+plev*2,j) = grd2 (2*lm-1,k,j) - tmpGR1evn(k+plev*3,j) = grd2 (2*lm ,k,j) - tmpGR1evn(k+plev*4,j) = grz2 (2*lm-1,k,j) - tmpGR1evn(k+plev*5,j) = grz2 (2*lm ,k,j) - - tmpGR2evn(k ,j) = grvt1(2*lm-1,k,j) ! first term for even n - tmpGR2evn(k+plev ,j) = grvt1(2*lm ,k,j) - tmpGR2evn(k+plev*2,j) = -grfv1(2*lm-1,k,j) - tmpGR2evn(k+plev*3,j) = -grfv1(2*lm ,k,j) - tmpGR2evn(k+plev*4,j) = grfu1(2*lm-1,k,j) - tmpGR2evn(k+plev*5,j) = grfu1(2*lm ,k,j) - - tmpGR3evn(k+plev*2,j) = grrh2(2*lm-1,k,j) ! additional term for even n - tmpGR3evn(k+plev*3,j) = grrh2(2*lm ,k,j) - - end do - end do -! -! Accumulate first and second terms -! -!$OMP PARALLEL DO PRIVATE(N, J, ZWDALP, ZWALP, KV) - do n=1,nlen(m),2 - do j=1,plat/2 - zwdalp = ztdtrw(j)*ldalp(lmr+n,j) - zwalp = zw(j) *lalp (lmr+n,j) - do kv=1,plev*6 - tmpSPEodd(kv,n) = tmpSPEodd(kv,n) + & - zwalp*tmpGR1odd(kv,j) + zwdalp*tmpGR2odd(kv,j) - end do - end do - end do -!$OMP PARALLEL DO PRIVATE(N, J, ZWDALP, ZWALP, KV) - do n=2,nlen(m),2 - do j=1,plat/2 - zwdalp = ztdtrw(j)*ldalp(lmr+n,j) - zwalp = zw(j) *lalp (lmr+n,j) - do kv=1,plev*6 - tmpSPEevn(kv,n) = tmpSPEevn(kv,n) + & - zwalp*tmpGR1evn(kv,j) + zwdalp*tmpGR2evn(kv,j) - end do - end do - end do -! -! Add additional term for divergence -! -!$OMP PARALLEL DO PRIVATE(N, J, SQZWALP, KV) - do n=1,nlen(m),2 - do j=1,plat/2 - sqzwalp = ztdtsq(n+m-1)*zw(j)*lalp (lmr+n,j) - do kv=plev*2+1,plev*4 - tmpSPEodd(kv,n) = tmpSPEodd(kv,n) + sqzwalp*tmpGR3odd(kv,j) - end do - end do - end do -!$OMP PARALLEL DO PRIVATE(N, J, SQZWALP, KV) - do n=2,nlen(m),2 - do j=1,plat/2 - sqzwalp = ztdtsq(n+m-1)*zw(j)*lalp (lmr+n,j) - do kv=plev*2+1,plev*4 - tmpSPEevn(kv,n) = tmpSPEevn(kv,n) + sqzwalp*tmpGR3evn(kv,j) - end do - end do - end do -! -! Save accumulated results -! -!$OMP PARALLEL DO PRIVATE(N, IR, II, K) - do n=1,nlen(m),2 - ir = lmc+2*n-1 - ii = ir+1 - do k=1,plev - t (ir,k) = tmpSPEodd(k ,n) - t (ii,k) = tmpSPEodd(k+plev ,n) - d (ir,k) = tmpSPEodd(k+plev*2,n) - d (ii,k) = tmpSPEodd(k+plev*3,n) - vz(ir,k) = tmpSPEodd(k+plev*4,n) - vz(ii,k) = tmpSPEodd(k+plev*5,n) - end do - end do -!$OMP PARALLEL DO PRIVATE(N, IR, II, K) - do n=2,nlen(m),2 - ir = lmc+2*n-1 - ii = ir+1 - do k=1,plev - t (ir,k) = tmpSPEevn(k ,n) - t (ii,k) = tmpSPEevn(k+plev ,n) - d (ir,k) = tmpSPEevn(k+plev*2,n) - d (ii,k) = tmpSPEevn(k+plev*3,n) - vz(ir,k) = tmpSPEevn(k+plev*4,n) - vz(ii,k) = tmpSPEevn(k+plev*5,n) - end do - end do -! - return -end subroutine quad diff --git a/src/dynamics/eul/realloc4.F90 b/src/dynamics/eul/realloc4.F90 deleted file mode 100644 index 3a76a1272f..0000000000 --- a/src/dynamics/eul/realloc4.F90 +++ /dev/null @@ -1,423 +0,0 @@ - -!----------------------------------------------------------------------- -! -! Purpose: -! Reallocation routines for the Fourier coefficients -! -! Method: -! 1) After FFT preceding Legendre analysis, reallocate fftbuf -! to decompose over wavenumber, recombining latitudes. -! 2) Before FFT following Legendre synthesis, reallocate fftbuf -! to recombine wavenumbers, decomposing over latitude. -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- -subroutine realloc4a(nlon_fft_in, nlon_fft_out, fftbuf_in, fftbuf_out ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Reallocation routines for the Fourier coefficients -! -! Method: -! After FFT preceding Legendre analysis, reallocate fftbuf -! to decompose over wavenumber, combining latitudes. -! -! Author: -! Original version: J. Rosinski -! Standardized: J. Rosinski, Oct 1995 -! J. Truesdale, Feb. 1996 -! Modified: P. Worley, September 2002, December 2003, -! October 2004, April 2007 -! -!----------------------------------------------------------------------- - -#ifdef SPMD - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - use pspect - use comspe - use spmd_dyn - use mpishorthand - use spmd_utils, only : iam, npes, altalltoallv -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -#include -!------------------------------Parameters------------------------------- -! - integer, parameter :: msgtag = 1000 -!---------------------------Input arguments----------------------------- -! - integer, intent(in) :: nlon_fft_in ! first dimension of input array - integer, intent(in) :: nlon_fft_out ! first dimension of output array - real(r8), intent(in) :: fftbuf_in(nlon_fft_in,9,plev,beglat:endlat) - ! buffer used for in-place FFTs - real(r8), intent(out) :: fftbuf_out(nlon_fft_out,9,plev,plat) - ! buffer used for reordered Fourier coefficients -! -!---------------------------Local workspace----------------------------- -! -! xxx_l: local decomposition -! xxx_r: remote decomposition - integer :: procid - integer :: length_r, length_l - integer :: bpos - integer :: step, ifld, k, i - integer :: lat_l, lat_r, beglat_r, endlat_r -! - logical, save :: first = .true. - integer, allocatable, save :: sndcnts(:), sdispls(:) - integer, allocatable, save :: rcvcnts(:), rdispls(:) - integer, allocatable, save :: sndcnts_act(:), sdispls_act(:) - integer, allocatable, save :: rcvcnts_act(:), rdispls_act(:) - integer, allocatable, save :: pdispls(:) -!----------------------------------------------------------------------- - if (first) then -! Compute send/recv/put counts and displacements - allocate(sndcnts(0:npes-1)) - allocate(sdispls(0:npes-1)) - allocate(rcvcnts(0:npes-1)) - allocate(rdispls(0:npes-1)) - allocate(pdispls(0:npes-1)) -! - sndcnts(:) = 0 - do step=1,realloc4_steps - procid = realloc4_proc(step) - length_r = 2*numm(procid) - sndcnts(procid) = length_r*(plev*8 + 1)*numlats - enddo -! - sdispls(0) = 0 - do procid=1,npes-1 - sdispls(procid) = sdispls(procid-1) + sndcnts(procid-1) - enddo -! - length_l = 2*numm(iam) - rcvcnts(:) = 0 - do step=1,realloc4_steps - procid = realloc4_proc(step) - rcvcnts(procid) = length_l*(plev*8 + 1)*nlat_p(procid) - enddo -! - rdispls(0) = 0 - do procid=1,npes-1 - rdispls(procid) = rdispls(procid-1) + rcvcnts(procid-1) - enddo -! - pdispls(:) = 0 - call mpialltoallint(rdispls, 1, pdispls, 1, mpicom) -! - allocate(sndcnts_act(0:dyn_npes-1)) - allocate(sdispls_act(0:dyn_npes-1)) - allocate(rcvcnts_act(0:dyn_npes-1)) - allocate(rdispls_act(0:dyn_npes-1)) -! - do procid=0,dyn_npes-1 - sndcnts_act(procid) = sndcnts(procid*dyn_npes_stride) - sdispls_act(procid) = sdispls(procid*dyn_npes_stride) - enddo -! - do procid=0,dyn_npes-1 - rcvcnts_act(procid) = rcvcnts(procid*dyn_npes_stride) - rdispls_act(procid) = rdispls(procid*dyn_npes_stride) - enddo -! - first = .false. - endif -! -! Copy local data to new location - length_l = 2*numm(iam) - do lat_l=beglat,endlat -!$OMP PARALLEL DO PRIVATE(K, IFLD, I) - do k=1,plev - do ifld=1,8 - do i=1,length_l - fftbuf_out(i,ifld,k,lat_l) = fftbuf_in(locrm(i,iam),ifld,k,lat_l) - enddo - enddo - enddo - do i=1,length_l - fftbuf_out(i,9,1,lat_l) = fftbuf_in(locrm(i,iam),9,1,lat_l) - enddo - enddo -! -! Fill message buffer -!$OMP PARALLEL DO PRIVATE (STEP, PROCID, LENGTH_R, BPOS, LAT_L, IFLD, K, I) - do step=1,realloc4_steps - procid = realloc4_proc(step) - length_r = 2*numm(procid) -! - bpos = sdispls(procid) - do lat_l=beglat,endlat - do k=1,plev - do ifld=1,8 - do i=1,length_r - buf1(bpos+i) = fftbuf_in(locrm(i,procid),ifld,k,lat_l) - enddo - bpos = bpos+length_r - enddo - enddo - do i=1,length_r - buf1(bpos+i) = fftbuf_in(locrm(i,procid),9,1,lat_l) - enddo - bpos = bpos+length_r - enddo - enddo -! -! Get remote data -! - if (dyn_alltoall .eq. 0) then - if (beglat <= endlat) then - call mpialltoallv(buf1, sndcnts_act, sdispls_act, mpir8, & - buf2, rcvcnts_act, rdispls_act, mpir8, & - mpicom_dyn_active) - endif - else - call altalltoallv(dyn_alltoall, iam, npes, & - realloc4_steps, realloc4_proc, & - buf1, spmdbuf_siz, sndcnts, sdispls, mpir8, & - buf2, spmdbuf_siz, rcvcnts, rdispls, mpir8, & - msgtag, pdispls, mpir8, buf2win, mpicom) - endif -! -! Copy out of message buffers -! -!$OMP PARALLEL DO PRIVATE (STEP, PROCID, BEGLAT_R, ENDLAT_R, BPOS, LAT_R, IFLD, K, I) - do step=1,realloc4_steps - procid = realloc4_proc(step) - beglat_r = cut(1,procid) - endlat_r = cut(2,procid) - bpos = rdispls(procid) - do lat_r=beglat_r,endlat_r - do k=1,plev - do ifld=1,8 - do i=1,length_l - fftbuf_out(i,ifld,k,lat_r) = buf2(bpos+i) - enddo - bpos = bpos+length_l - enddo - enddo - do i=1,length_l - fftbuf_out(i,9,1,lat_r) = buf2(bpos+i) - enddo - bpos = bpos+length_l - enddo -! - end do -#endif - return - end subroutine realloc4a - -subroutine realloc4b(nlon_fft_in, nlon_fft_out, fftbuf_in, fftbuf_out ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Reallocation routines for the Fourier coefficients -! -! Method: -! Before FFT following Legendre synthesis, reallocate fftbuf -! to combine wavenumbers, decomposing over latitude. -! -! Author: P. Worley, September 2002 -! Modified: P. Worley, December 2003, October 2004 -! -!----------------------------------------------------------------------- - -#ifdef SPMD - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - use pspect - use comspe - use spmd_dyn - use mpishorthand - use spmd_utils, only : iam, npes, altalltoallv - -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -#include -!------------------------------Parameters------------------------------- -! - integer, parameter :: msgtag = 2000 -!---------------------------Input arguments-------------------------- -! - integer, intent(in) :: nlon_fft_in ! first dimension of input array - integer, intent(in) :: nlon_fft_out ! first dimension of output array - real(r8), intent(in) :: fftbuf_in(nlon_fft_in,8,plevp,plat) - ! buffer of Fourier coefficients to be reordered - real(r8), intent(out) :: fftbuf_out(nlon_fft_out,8,plevp,beglat:endlat) - ! buffer used for in-place FFTs -! -!---------------------------Local workspace----------------------------- -! -! xxx_l: local decomposition -! xxx_r: remote decomposition - integer :: procid - integer :: length_r, length_l - integer :: bpos - integer :: step, ifld, k, i - integer :: lat_l, lat_r - integer :: beglat_r, endlat_r -! - logical, save :: first = .true. - integer, allocatable, save :: sndcnts(:), sdispls(:) - integer, allocatable, save :: rcvcnts(:), rdispls(:) - integer, allocatable, save :: sndcnts_act(:), sdispls_act(:) - integer, allocatable, save :: rcvcnts_act(:), rdispls_act(:) - integer, allocatable, save :: pdispls(:) -!----------------------------------------------------------------------- - if (first) then -! Compute send/recv counts and displacements - allocate(sndcnts(0:npes-1)) - allocate(sdispls(0:npes-1)) - allocate(rcvcnts(0:npes-1)) - allocate(rdispls(0:npes-1)) - allocate(pdispls(0:npes-1)) -! - length_l = 2*numm(iam) - sndcnts(:) = 0 - do step=1,realloc4_steps - procid = realloc4_proc(step) - sndcnts(procid) = length_l*(8*plev + 4)*nlat_p(procid) - enddo -! - sdispls(0) = 0 - do procid=1,npes-1 - sdispls(procid) = sdispls(procid-1) + sndcnts(procid-1) - enddo -! - rcvcnts(:) = 0 - do step=1,realloc4_steps - procid = realloc4_proc(step) - length_r = 2*numm(procid) - rcvcnts(procid) = length_r*(8*plev + 4)*numlats - enddo -! - rdispls(0) = 0 - do procid=1,npes-1 - rdispls(procid) = rdispls(procid-1) + rcvcnts(procid-1) - enddo -! - pdispls(:) = 0 - call mpialltoallint(rdispls, 1, pdispls, 1, mpicom) -! - allocate(sndcnts_act(0:dyn_npes-1)) - allocate(sdispls_act(0:dyn_npes-1)) - allocate(rcvcnts_act(0:dyn_npes-1)) - allocate(rdispls_act(0:dyn_npes-1)) -! - do procid=0,dyn_npes-1 - sndcnts_act(procid) = sndcnts(procid*dyn_npes_stride) - sdispls_act(procid) = sdispls(procid*dyn_npes_stride) - enddo -! - do procid=0,dyn_npes-1 - rcvcnts_act(procid) = rcvcnts(procid*dyn_npes_stride) - rdispls_act(procid) = rdispls(procid*dyn_npes_stride) - enddo -! - first = .false. - endif -! -! Copy local data to new location - length_l = 2*numm(iam) - do lat_l=beglat,endlat -!$OMP PARALLEL DO PRIVATE(K, IFLD, I) - do k=1,plev - do ifld=1,8 - do i=1,length_l - fftbuf_out(locrm(i,iam),ifld,k,lat_l) = fftbuf_in(i,ifld,k,lat_l) - enddo - enddo - enddo -! -!$OMP PARALLEL DO PRIVATE(IFLD, I) - do ifld=1,4 - do i=1,length_l - fftbuf_out(locrm(i,iam),ifld,plevp,lat_l) = fftbuf_in(i,ifld,plevp,lat_l) - enddo - enddo - enddo -! -! Fill message buffer -!$OMP PARALLEL DO PRIVATE (STEP, PROCID, BEGLAT_R, ENDLAT_R, BPOS, LAT_R, K, IFLD, I) - do step=1,realloc4_steps - procid = realloc4_proc(step) - beglat_r = cut(1,procid) - endlat_r = cut(2,procid) - bpos = sdispls(procid) -! - do lat_r=beglat_r,endlat_r - do k=1,plev - do ifld=1,8 - do i=1,length_l - buf1(bpos+i) = fftbuf_in(i,ifld,k,lat_r) - enddo - bpos = bpos+length_l - enddo - enddo - do ifld=1,4 - do i=1,length_l - buf1(bpos+i) = fftbuf_in(i,ifld,plevp,lat_r) - enddo - bpos = bpos+length_l - enddo - enddo - enddo -! -! Get remote data -! - if (dyn_alltoall .eq. 0) then - if (beglat <= endlat) then - call mpialltoallv(buf1, sndcnts_act, sdispls_act, mpir8, & - buf2, rcvcnts_act, rdispls_act, mpir8, & - mpicom_dyn_active) - endif - else - call altalltoallv(dyn_alltoall, iam, npes, & - realloc4_steps, realloc4_proc, & - buf1, spmdbuf_siz, sndcnts, sdispls, mpir8, & - buf2, spmdbuf_siz, rcvcnts, rdispls, mpir8, & - msgtag, pdispls, mpir8, buf2win, mpicom) - endif -! -! Copy out of message buffers -! -!$OMP PARALLEL DO PRIVATE (STEP, PROCID, LENGTH_R, BPOS, LAT_L, K, IFLD, I) - do step=1,realloc4_steps - procid = realloc4_proc(step) - length_r = 2*numm(procid) - bpos = rdispls(procid) - - do lat_l=beglat,endlat - do k=1,plev - do ifld=1,8 - do i=1,length_r - fftbuf_out(locrm(i,procid),ifld,k,lat_l) = buf2(bpos+i) - enddo - bpos = bpos+length_r - enddo - enddo - - do ifld=1,4 - do i=1,length_r - fftbuf_out(locrm(i,procid),ifld,plevp,lat_l) = buf2(bpos+i) - enddo - bpos = bpos+length_r - enddo - - enddo -! - end do -#endif - return - end subroutine realloc4b - diff --git a/src/dynamics/eul/realloc7.F90 b/src/dynamics/eul/realloc7.F90 deleted file mode 100644 index 1adc399b9f..0000000000 --- a/src/dynamics/eul/realloc7.F90 +++ /dev/null @@ -1,213 +0,0 @@ - -subroutine realloc7 (vmax2d, vmax2dt, vcour) - -!----------------------------------------------------------------------- -! -! Purpose: Reallocation routine for energy and log stats -! -! Method: MPI_Allgatherv (or point-to-point implementation) -! -! Author: J. Rosinski -! Modified: P. Worley, September 2002, December 2003, October 2004 -! -!----------------------------------------------------------------------- - -#ifdef SPMD - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, numlats, beglat, endlat - use mpishorthand - use spmd_dyn - use spmd_utils, only : iam, npes, altalltoallv -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -#include -!------------------------------Parameters------------------------------- -! - integer, parameter :: msgtag = 3000 -!---------------------------Input arguments----------------------------- -! - real(r8), intent(inout) :: vmax2d(plev,plat) ! Max. wind at each lvl, lat - real(r8), intent(inout) :: vmax2dt(plev,plat) ! Max. truncated wind at each lvl, lat - real(r8), intent(inout) :: vcour(plev,plat) ! Max. Courant number at each lvl, lat -! -!---------------------------Local workspace----------------------------- -! - integer procid - integer bufpos - integer procj - integer step, j, k, jstrt - integer beglat_p, endlat_p, numlats_p, jstrt_p -! - logical, save :: first = .true. - integer, save :: sndcnt - integer, allocatable, save :: sndcnts(:), sdispls(:) - integer, allocatable, save :: rcvcnts(:), rdispls(:) - integer, allocatable, save :: pdispls(:) -!----------------------------------------------------------------------- - if (first) then -! Compute send/recv/put counts and displacements - allocate(sndcnts(0:npes-1)) - allocate(sdispls(0:npes-1)) - allocate(rcvcnts(0:npes-1)) - allocate(rdispls(0:npes-1)) - allocate(pdispls(0:npes-1)) -! -! Compute send count - sndcnt = (plev*3 + 5)*numlats - sndcnts(:) = 0 - do step=1,allgather_steps - procid = allgather_proc(step) - sndcnts(procid) = sndcnt - enddo -! - sdispls(0) = 0 - do procid=1,npes-1 - sdispls(procid) = 0 - enddo -! -! Compute recv counts and displacements - rcvcnts(:) = 0 - do step=1,allgather_steps - procid = allgather_proc(step) - rcvcnts(procid) = (plev*3 + 5)*nlat_p(procid) - enddo - rcvcnts(iam) = (plev*3 + 5)*numlats -! - rdispls(0) = 0 - do procid=1,npes-1 - rdispls(procid) = rdispls(procid-1) + rcvcnts(procid-1) - enddo -! - pdispls(:) = 0 - call mpialltoallint(rdispls, 1, pdispls, 1, mpicom) -! - first = .false. - endif -! -! Fill send buffer - jstrt = beglat - 1 - bufpos = 0 -! psurf - do j=1,numlats - buf1(bufpos+j) = psurf(jstrt+j) - enddo - bufpos = bufpos + numlats -! stq - do j=1,numlats - buf1(bufpos+j) = stq(jstrt+j) - enddo - bufpos = bufpos + numlats -! rmst - do j=1,numlats - buf1(bufpos+j) = rmst(jstrt+j) - enddo - bufpos = bufpos + numlats -! rmsd - do j=1,numlats - buf1(bufpos+j) = rmsd(jstrt+j) - enddo - bufpos = bufpos + numlats -! rmsz - do j=1,numlats - buf1(bufpos+j) = rmsz(jstrt+j) - enddo - bufpos = bufpos + numlats -!vmax2d - do j=beglat,endlat - do k=1,plev - buf1(bufpos+k) = vmax2d(k,j) - enddo - bufpos = bufpos + plev - enddo -! vmax2dt - do j=beglat,endlat - do k=1,plev - buf1(bufpos+k) = vmax2dt(k,j) - enddo - bufpos = bufpos + plev - enddo -! vcour - do j=beglat,endlat - do k=1,plev - buf1(bufpos+k) = vcour(k,j) - enddo - bufpos = bufpos + plev - enddo -! -! Gather the data -! - if (dyn_allgather .eq. 0) then - call mpiallgatherv(buf1, sndcnt, mpir8, & - buf2, rcvcnts, rdispls, mpir8, & - mpicom) - else - call altalltoallv(dyn_allgather, iam, npes, & - allgather_steps, allgather_proc, & - buf1, spmdbuf_siz, sndcnts, sdispls, mpir8, & - buf2, spmdbuf_siz, rcvcnts, rdispls, mpir8, & - msgtag, pdispls, mpir8, buf2win, mpicom) - endif -! -! Copy out of message buffers -! -!$OMP PARALLEL DO PRIVATE (STEP, PROCID, BEGLAT_P, ENDLAT_P, NUMLATS_P, JSTRT_P, BUFPOS, J, K) - do step=1,allgather_steps - procid = allgather_proc(step) - beglat_p = cut(1,procid) - endlat_p = cut(2,procid) - numlats_p = nlat_p(procid) - bufpos = rdispls(procid) -! psurf - jstrt_p = beglat_p - 1 - do j=1,numlats_p - psurf(jstrt_p+j) = buf2(bufpos+j) - enddo - bufpos = bufpos + numlats_p -! stq - do j=1,numlats_p - stq(jstrt_p+j) = buf2(bufpos+j) - enddo - bufpos = bufpos + numlats_p -! rmst - do j=1,numlats_p - rmst(jstrt_p+j) = buf2(bufpos+j) - enddo - bufpos = bufpos + numlats_p -! rmsd - do j=1,numlats_p - rmsd(jstrt_p+j) = buf2(bufpos+j) - enddo - bufpos = bufpos + numlats_p -! rmsz - do j=1,numlats_p - rmsz(jstrt_p+j) = buf2(bufpos+j) - enddo - bufpos = bufpos + numlats_p -! vmax2d - do j=beglat_p,endlat_p - do k=1,plev - vmax2d(k,j) = buf2(bufpos+k) - enddo - bufpos = bufpos + plev - enddo -! vmax2dt - do j=beglat_p,endlat_p - do k=1,plev - vmax2dt(k,j) = buf2(bufpos+k) - enddo - bufpos = bufpos + plev - enddo -! vcour - do j=beglat_p,endlat_p - do k=1,plev - vcour(k,j) = buf2(bufpos+k) - enddo - bufpos = bufpos + plev - enddo -! - enddo -#endif - return -end subroutine realloc7 - diff --git a/src/dynamics/eul/restart_dynamics.F90 b/src/dynamics/eul/restart_dynamics.F90 deleted file mode 100644 index 348c2aa26c..0000000000 --- a/src/dynamics/eul/restart_dynamics.F90 +++ /dev/null @@ -1,557 +0,0 @@ -module restart_dynamics - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pio, only : var_desc_t, file_desc_t, pio_double, pio_unlimited, pio_def_var, & - pio_def_dim, io_desc_t, pio_offset_kind, pio_put_var, pio_write_darray, & - pio_setdebuglevel,pio_setframe, pio_initdecomp, pio_freedecomp, & - pio_read_darray, pio_inq_varid, pio_get_var - use prognostics, only: u3, v3, t3, q3, & - 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 - - implicit none - private - save - public :: read_restart_dynamics, init_restart_dynamics, write_restart_dynamics - - integer, parameter :: namlen=16 - - type restart_var_t - real(r8), pointer :: v1d(:) => null() - real(r8), pointer :: v2d(:,:) => null() - real(r8), pointer :: v3d(:, :, :) => null() - real(r8), pointer :: v4d(:, :, :, :) => null() - real(r8), pointer :: v5d(:, :, :, :, :) => null() - - type(var_desc_t), pointer :: vdesc => null() - integer :: ndims - integer :: timelevels - character(len=namlen) :: name - end type restart_var_t -#if ( defined BFB_CAM_SCAM_IOP ) - integer, parameter :: restartvarcnt = 24 -#else - integer, parameter :: restartvarcnt = 17 -#endif - type(var_desc_t) :: timedesc, tmass0desc, fixmasdesc, hw1desc, hw2desc, hw3desc, alphadesc - - type(restart_var_t) :: restartvars(restartvarcnt) - logical :: restart_varlist_initialized=.false. - -CONTAINS - - subroutine set_r_var(name, timelevels, index, v1, v2, v3, v4, v5) - use cam_abortutils, only: endrun - - character(len=*), intent(in) :: name - integer, intent(in) :: timelevels, index - real(r8), target, optional :: v1(:), v2(:,:), v3(:,:,:), v4(:,:,:,:), v5(:,:,:,:,:) - - restartvars(index)%name=name - restartvars(index)%timelevels = timelevels - if(present(v1)) then - restartvars(index)%ndims = 1 - restartvars(index)%v1d => v1 - else if(present(v2)) then - restartvars(index)%ndims = 2 - restartvars(index)%v2d => v2 - else if(present(v3)) then - restartvars(index)%ndims = 3 - restartvars(index)%v3d => v3 - else if(present(v4)) then - restartvars(index)%ndims = 4 - restartvars(index)%v4d => v4 - else if(present(v5)) then - restartvars(index)%ndims = 5 - restartvars(index)%v5d => v5 - else - call endrun('bad ndims in call to set_r_var') - end if - allocate(restartvars(index)%vdesc) - - end subroutine set_r_var - - subroutine init_restart_varlist() - use cam_abortutils, only: endrun - - - integer :: vcnt=1 - integer :: i - - -! Should only be called once - if(restart_varlist_initialized) return - restart_varlist_initialized=.true. - call set_r_var('VORT', ptimelevels, vcnt, v4=vort) - - vcnt=vcnt+1 - call set_r_var('DIV', ptimelevels, vcnt, v4=div) - - vcnt=vcnt+1 - call set_r_var('DPSL', 1, vcnt, v2=dpsl) - - vcnt=vcnt+1 - call set_r_var('DPSM', 1, vcnt, v2=dpsm) - - vcnt=vcnt+1 - call set_r_var('DPS', 1, vcnt, v2=dps) - - vcnt=vcnt+1 - call set_r_var('PHIS', 1, vcnt, v2=phis) - - vcnt=vcnt+1 - call set_r_var('OMEGA', 1, vcnt, v3=omga) - - vcnt=vcnt+1 - call set_r_var('U', ptimelevels, vcnt, v4=u3) - - vcnt=vcnt+1 - call set_r_var('V', ptimelevels, vcnt, v4=v3) - - vcnt=vcnt+1 - call set_r_var('T', ptimelevels, vcnt, v4=t3) - - vcnt=vcnt+1 - call set_r_var('PS', ptimelevels, vcnt, v3=ps) - - vcnt=vcnt+1 - call set_r_var( 'Q', ptimelevels, vcnt, v5=Q3 ) - - vcnt=vcnt+1 - call set_r_var('PDELD', ptimelevels, vcnt, v4=pdeld ) - - - vcnt=vcnt+1 - call set_r_var('LAMMP', 1, vcnt, v3=lammp ) - vcnt=vcnt+1 - call set_r_var('PHIMP', 1, vcnt, v3=phimp ) - vcnt=vcnt+1 - call set_r_var('SIGMP', 1, vcnt, v3=sigmp ) - - vcnt=vcnt+1 - 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 ) - - 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('T2', 1, vcnt, v3=t2sav ) - - 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('BETA', 1, vcnt, v1=betasav ) - -#endif - - if(vcnt.ne.restartvarcnt) then - write(iulog,*) 'vcnt= ',vcnt, ' restartvarcnt=',restartvarcnt - call endrun('bad restartvarcnt') - end if - - end subroutine init_restart_varlist - - - -subroutine init_restart_dynamics(File, dyn_out) - - use dyn_comp, only: dyn_export_t - use constituents, only: pcnst - use hycoef, only: init_restart_hycoef - use cam_grid_support, only: cam_grid_write_attr, cam_grid_id - use cam_grid_support, only: cam_grid_header_info_t - - ! Input arguments - type(File_desc_t), intent(inout) :: File - type(Dyn_export_t), intent(in) :: dyn_out - - integer :: hdimids(2) - integer :: vdimids(2) - character(len=namlen) :: name - - integer :: alldims(4), alldims2d(3), qdims(5) - integer :: timelevels_dimid, i, ierr - type(var_desc_t), pointer :: vdesc - integer :: grid_id - integer :: ndims, timelevels - type(cam_grid_header_info_t) :: info - - call init_restart_hycoef(File, vdimids) - - ! Grid attributes - grid_id = cam_grid_id('gauss_grid') - call cam_grid_write_attr(File, grid_id, info) - hdimids(1) = info%get_hdimid(1) - hdimids(2) = info%get_hdimid(2) - - ierr = PIO_Def_Dim(File,'timelevels',PIO_UNLIMITED,timelevels_dimid) - - ierr = PIO_Def_Dim(File,'pcnst',pcnst, qdims(4)) - - ierr = PIO_Def_Var(File, 'time', pio_double, (/timelevels_dimid/), timedesc) - - ierr = PIO_Def_var(File, 'tmass0', pio_double, tmass0desc) - ierr = PIO_Def_var(File, 'fixmas', pio_double, fixmasdesc) - ierr = PIO_Def_var(File, 'hw1', pio_double, qdims(4:4), hw1desc) - ierr = PIO_Def_var(File, 'hw2', pio_double, qdims(4:4), hw2desc) - ierr = PIO_Def_var(File, 'hw3', pio_double, qdims(4:4), hw3desc) - ierr = PIO_Def_var(File, 'alpha', pio_double, qdims(4:4), alphadesc) - - - - - alldims(1:2) = hdimids(1:2) - alldims(3) = vdimids(1) - alldims(4) = timelevels_dimid - - alldims2d(1:2) = hdimids(1:2) - alldims2d(3) = timelevels_dimid - - 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 - ierr = PIO_Def_Var(File, name, pio_double, alldims2d, vdesc) - else if(ndims==4) then - ierr = PIO_Def_Var(File, name, pio_double, alldims, vdesc) - else if(ndims==5) then - ierr = PIO_Def_Var(File, name, pio_double, qdims, vdesc) - end if - else - if(ndims==1) then -! broken i think - ierr = PIO_Def_Var(File, name, pio_double, hdimids(2:2), vdesc) - else if(ndims==2) then - ierr = PIO_Def_Var(File, name, pio_double, alldims2d(1:2), vdesc) - else if(ndims==3) then - ierr = PIO_Def_Var(File, name, pio_double, alldims(1:3), vdesc) - else if(ndims==4) then - ierr = PIO_Def_Var(File, name, pio_double, qdims(1:4), vdesc) - end if - end if - end do - - - end subroutine init_restart_dynamics - - - subroutine write_restart_dynamics (File, dyn_out) - use cam_pio_utils, only : pio_subsystem - use dyn_comp, only : dyn_export_t - use time_manager, only: get_curr_time, get_step_size - use prognostics, only: ptimelevels, n3m2, n3m1, n3 - use pmgrid, only: plon, plat - use ppgrid, only: pver - use massfix, only: alpha, hw1, hw2, hw3 - use constituents, only: pcnst - use eul_control_mod, only: fixmas, tmass0 - use hycoef, only: write_restart_hycoef - use cam_grid_support, only: cam_grid_write_var - use dyn_grid, only: dyn_decomp - - - ! - ! Input arguments - ! - type(File_desc_t), intent(inout) :: File ! Unit number - type(Dyn_export_t), intent(in) :: dyn_out ! Not used in eul dycore - - ! - ! Local workspace - ! - integer :: ierr ! error status - integer :: ndcur, nscur - real(r8) :: time, dtime, mold(1) - integer :: i, s3d(1), s2d(1), ct - integer(kind=pio_offset_kind) :: t - type(io_desc_t) :: iodesc4d, iodesc3d, iodesc2d - integer, pointer :: ldof(:) - integer :: ndims, timelevels - type(var_desc_t), pointer :: vdesc - character(len=namlen) :: name - ! - - ! Write grid vars - call cam_grid_write_var(File, dyn_decomp) - - call write_restart_hycoef(File) - - call get_curr_time(ndcur, nscur) - dtime = get_step_size() - - ldof => get_restart_decomp(plon, plat, pver) - call pio_initdecomp(pio_subsystem, pio_double, (/plon,plat,pver/), ldof, iodesc3d) - deallocate(ldof) - - ldof => get_restart_decomp(plon, plat, pver*pcnst) - call pio_initdecomp(pio_subsystem, pio_double, (/plon,plat,pver,pcnst/), ldof, iodesc4d) - deallocate(ldof) - - ldof => get_restart_decomp(plon, plat, 1) - call pio_initdecomp(pio_subsystem, pio_double, (/plon,plat/), ldof, iodesc2d) - deallocate(ldof) - - ierr = pio_put_var(File, tmass0desc, (/tmass0/)) - ierr = pio_put_var(File, fixmasdesc, (/fixmas/)) - - ierr = pio_put_var(File, hw1desc, hw1) - ierr = pio_put_var(File, hw2desc, hw2) - ierr = pio_put_var(File, hw3desc, hw3) - ierr = pio_put_var(File, alphadesc, alpha) - - - do t=1,ptimelevels - time = ndcur+(real(nscur,kind=r8)+ (t-2)*dtime)/86400._r8 - ierr = pio_put_var(File,timedesc%varid, (/int(t)/), time) - end do - do i=1,restartvarcnt - call get_restart_var(i, name, timelevels, ndims, vdesc) - if(timelevels==1) then - if(ndims==2) then - call pio_write_darray(File, vdesc, iodesc2d, transfer(restartvars(i)%v2d(:,:), mold), ierr) - else if(ndims==3) then - call pio_write_darray(File, vdesc, iodesc3d, transfer(restartvars(i)%v3d(:,:,:), mold), ierr) - else if(ndims==4) then - call pio_write_darray(File, vdesc, iodesc4d, transfer(restartvars(i)%v4d(:,:,:,:), mold), ierr) - end if - else - do t=1,timelevels - if(t==1) ct=n3m2 - if(t==2) ct=n3m1 - if(t==3) ct=n3 - - call pio_setframe(File, vdesc, t) - if(ndims==3) then - call pio_write_darray(File, vdesc, iodesc2d, transfer(restartvars(i)%v3d(:,:,ct), mold), ierr) - else if(ndims==4) then - call pio_write_darray(File, vdesc, iodesc3d, transfer(restartvars(i)%v4d(:,:,:,ct), mold), ierr) - 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 - - subroutine get_restart_var(i,name, timelevels, ndims, vdesc) - integer, intent(in) :: i - character(len=namlen), intent(out) :: name - integer, intent(out) :: ndims, timelevels - type(var_desc_t), pointer :: vdesc - - name = restartvars(i)%name - timelevels = restartvars(i)%timelevels - ndims = restartvars(i)%ndims - if(.not.associated(restartvars(i)%vdesc)) then - allocate(restartvars(i)%vdesc) - end if - vdesc => restartvars(i)%vdesc - - end subroutine get_restart_var - - !####################################################################### - - subroutine read_restart_dynamics (File, dyn_in, dyn_out) - - use dyn_comp, only : dyn_init, dyn_import_t, dyn_export_t - use cam_pio_utils, only : pio_subsystem - - 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 - - use constituents, only: pcnst - use eul_control_mod, only: fixmas, tmass0 - - ! - ! Input arguments - ! - type(file_desc_t), intent(inout) :: File ! PIO file handle - type(dyn_import_t), intent(out) :: dyn_in - type(dyn_export_t), intent(out) :: dyn_out - ! - ! Local workspace - ! - type(io_desc_t) :: iodesc4d, iodesc3d, iodesc2d - integer, pointer :: ldof(:) - integer :: ioerr ! error status - real(r8), allocatable :: tmp(:) - ! - integer :: dims3d(3), dims2d(2), dims4d(4) - integer :: ierr, ct - integer(kind=pio_offset_kind) :: t - character(len=namlen) :: name - integer :: ndims, timelevels, i, s2d, s3d, s4d - type(var_desc_t), pointer :: vdesc - - call dyn_init(dyn_in, dyn_out) - - dims4d(1) = plon - dims4d(2) = pver - dims4d(3) = pcnst - dims4d(4) = endlat-beglat+1 - s4d=dims4d(1)*dims4d(2)*dims4d(3)*dims4d(4) - dims3d(1) = plon - dims3d(2) = pver - dims3d(3) = endlat-beglat+1 - s3d=dims3d(1)*dims3d(2)*dims3d(3) - dims2d(1) = plon - dims2d(2) = dims3d(3) - s2d=dims2d(1)*dims2d(2) - - allocate(tmp(s4d)) - - ldof => get_restart_decomp(plon, plat, pver*pcnst) - call pio_initdecomp(pio_subsystem, pio_double, (/plon,plat,pver,pcnst/), ldof, iodesc4d) - deallocate(ldof) - ldof => get_restart_decomp(plon, plat, pver) - call pio_initdecomp(pio_subsystem, pio_double, (/plon,plat,pver/), ldof, iodesc3d) - deallocate(ldof) - ldof => get_restart_decomp(plon, plat, 1) - call pio_initdecomp(pio_subsystem, pio_double, (/plon,plat/), ldof, iodesc2d) - deallocate(ldof) - - ierr = PIO_Inq_varid(File, 'tmass0', tmass0desc) - ierr = pio_get_var(File, tmass0desc, tmass0) - ierr = PIO_Inq_varid(File,'fixmas', fixmasdesc) - ierr = pio_get_var(File, fixmasdesc, fixmas) - - ierr = PIO_Inq_varid(File, 'hw1', hw1desc) - ierr = pio_get_var(File, hw1desc, hw1) - ierr = PIO_Inq_varid(File, 'hw2', hw2desc) - ierr = pio_get_var(File, hw2desc, hw2) - ierr = PIO_Inq_varid(File, 'hw3', hw3desc) - ierr = pio_get_var(File, hw3desc, hw3) - ierr = PIO_Inq_varid(File,'alpha', alphadesc) - ierr = pio_get_var(File, alphadesc, alpha) - - call init_restart_varlist() - -#if ( defined BFB_CAM_SCAM_IOP ) - call init_iop_fields() -#endif - do i=1,restartvarcnt - call get_restart_var(i, name, timelevels, ndims, vdesc) - - - ierr = PIO_Inq_varid(File, name, vdesc) - if(timelevels == 1) then - if(ndims==2) then - call pio_read_darray(File, vdesc, iodesc2d, tmp(1:s2d), ierr) - restartvars(i)%v2d(:,:) = reshape(tmp(1:s2d), dims2d) - else if(ndims==3) then - call pio_read_darray(File, restartvars(i)%vdesc, iodesc3d, tmp(1:s3d), ierr) - restartvars(i)%v3d(:,:,:) = reshape(tmp(1:s3d), dims3d) - else if(ndims==4) then - call pio_read_darray(File, restartvars(i)%vdesc, iodesc4d, tmp, ierr) - restartvars(i)%v4d(:,:,:,:) = reshape(tmp, dims4d) - end if - - else - do t=1,timelevels - if(t==1) ct=n3m2 - if(t==2) ct=n3m1 - if(t==3) ct=n3 - call pio_setframe(File, vdesc, t) - if(ndims==3) then - call pio_read_darray(File, vdesc, iodesc2d, tmp(1:s2d), ierr) - restartvars(i)%v3d(:,:,ct) = reshape(tmp(1:s2d), dims2d) - else if(ndims==4) then - call pio_read_darray(File, vdesc, iodesc3d, tmp(1:s3d), ierr) - restartvars(i)%v4d(:,:,:,ct) = reshape(tmp(1:s3d), dims3d) - else if(ndims==5) then - call pio_read_darray(File, vdesc, iodesc4d, tmp, ierr) - restartvars(i)%v5d(:,:,:,:,ct) = reshape(tmp, dims4d) - end if - - end do - end if - end do - deallocate(tmp) - call pio_freedecomp(File, iodesc2d) - call pio_freedecomp(File, iodesc3d) - call pio_freedecomp(File, iodesc4d) - - return - - end subroutine read_restart_dynamics - function get_restart_decomp(hdim1, hdim2, nlev) result(ldof) - use dyn_grid, only : get_dyn_grid_parm - - integer, intent(in) :: hdim1, hdim2, nlev - integer, pointer :: ldof(:) - integer :: i, k, j - integer :: lcnt - integer, allocatable :: gcols(:) - - integer :: beglatxy, beglonxy, endlatxy, endlonxy, plat - - - beglonxy = get_dyn_grid_parm('beglonxy') - endlonxy = get_dyn_grid_parm('endlonxy') - beglatxy = get_dyn_grid_parm('beglatxy') - 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 - do j=beglatxy,endlatxy - do k=1,nlev - do i=beglonxy, endlonxy - lcnt=lcnt+1 - ldof(lcnt)=i+(j-(plat-hdim2+1))*hdim1+(k-1)*hdim1*hdim2 - end do - end do - end do - - end function get_restart_decomp - - - - -end module restart_dynamics diff --git a/src/dynamics/eul/scan2.F90 b/src/dynamics/eul/scan2.F90 deleted file mode 100644 index a282a92058..0000000000 --- a/src/dynamics/eul/scan2.F90 +++ /dev/null @@ -1,774 +0,0 @@ -!----------------------------------------------------------------------- -module scan2 -!----------------------------------------------------------------------- -! -! Purpose: Module for second gaussian latitude scan, to convert from -! spectral coefficients to grid point values. -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon, beglat, endlat, plevp - use constituents, only: pcnst - use scmforecast, only: forecast - use perf_mod -!----------------------------------------------------------------------- - implicit none -! -! By default everything is private to this module -! - private -! -! Public interfaces -! - public scan2run ! Public run method - -! -! Private module data -! - integer, parameter :: plondfft = plon + 2 - -!----------------------------------------------------------------------- -contains -!----------------------------------------------------------------------- - -! -!----------------------------------------------------------------------- -! - -subroutine scan2run (ztodt, cwava, etamid,t2 ,fu ,fv ) -!----------------------------------------------------------------------- -! -! Purpose: -! Second gaussian latitude scan, converts from spectral coefficients to -! grid point values, from poles to equator, with read/calculate/write cycle. -! -! Method: -! The latitude pair loop in this routine is multitasked. -! -! The grid point values of ps, t, u, v, z (vorticity), and d (divergence) -! are calculated and stored for each latitude from the spectral coefficients. -! In addition, the pressure-surface corrections to the horizontal diffusion -! are applied and the global integrals of the constituent fields are -! computed for the mass fixer. -! -! Author: -! Original version: CCM1 -! -!----------------------------------------------------------------------- - use prognostics, only: ps, u3, v3, q3, t3, dps, dpsl, dpsm, vort, & - qminus, div, n3, n3m1, n3m2, phis, omga, & - shift_time_indices, hadv, pdeld - use comspe, only: maxm - use scanslt, only: hw1lat, engy1lat, qfcst -#ifdef SPMD - use mpishorthand, only: mpicom, mpir8 -#endif - use physconst, only: cpair - use scamMod, only: fixmascam,alphacam,betacam, single_column, scm_cambfb_mode - use pspect, only: pnmax - use tfilt_massfix, only: tfilt_massfixrun - use massfix, only: hw1,hw2,hw3,alpha - use cam_control_mod, only: ideal_phys, adiabatic - use eul_control_mod, only: qmassf, tmass, tmass0, fixmas, tmassf - -!----------------------------------------------------------------------- -! -! Input arguments -! - real(r8), intent(in) :: ztodt ! twice the timestep unless nstep = 0 - real(r8), intent(in) :: cwava(plat) ! weight applied to global integrals - real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints - real(r8), optional, intent(inout) :: t2(plon,plev,beglat:endlat) ! tot dT/dt to to physics - real(r8), optional, intent(inout) :: fu(plon,plev,beglat:endlat) ! u wind tend - real(r8), optional, intent(inout) :: fv(plon,plev,beglat:endlat) ! v wind tend -! -!---------------------------Local workspace----------------------------- -! - real(r8) engy1 ! component of global energy integral (for time step n) - real(r8) engy2 ! component of global energy integral (for time step n+1) - real(r8) engy2a ! component of global energy integral (for time step n+1) - real(r8) engy2b ! component of global energy integral (for time step n+1) - real(r8) difft ! component of global delta-temp integral ( (n+1) - n ) - real(r8) diffta ! component of global delta-temp integral ( (n+1) - n ) - real(r8) difftb ! component of global delta-temp integral ( (n+1) - n ) - real(r8) hw2a(pcnst) ! component of constituent global mass integral (mass weighting is - ! based upon the "A" portion of the hybrid grid) - real(r8) hw2b(pcnst) ! component of constituent global mass integral (mass weighting is - ! based upon the "B" portion of the hybrid grid) - real(r8) hw3a(pcnst) ! component of constituent global mass integral (mass weighting is - ! based upon the "A" portion of the hybrid grid) - real(r8) hw3b(pcnst) ! component of constituent global mass integral (mass weighting is - ! based upon the "B" portion of the hybrid grid) - real(r8) hwxa(pcnst,4) - real(r8) hwxb(pcnst,4) - real(r8) engy2alat(plat) ! lat contribution to total energy integral - real(r8) engy2blat(plat) ! lat contribution to total energy integral - real(r8) difftalat(plat) ! lat contribution to delta-temperature integral - real(r8) difftblat(plat) ! lat contribution to delta-temperature integral - real(r8) hw2al(pcnst,plat) ! |------------------------------------ - real(r8) hw2bl(pcnst,plat) ! | latitudinal contributions to the - real(r8) hw3al(pcnst,plat) ! | components of global mass integrals - real(r8) hw3bl(pcnst,plat) ! | - real(r8) hwxal(pcnst,4,plat) ! | - real(r8) hwxbl(pcnst,4,plat) ! |----------------------------------- -! -! Symmetric fourier coefficient arrays for all variables transformed -! from spherical harmonics (see subroutine grcalc) -! - real(r8) grdpss(2*maxm,(plat+1)/2) ! sum(n) of K(4)*(n(n+1)/a**2)**2*2dt*lnps(n,m)*P(n,m) - real(r8) grzs(2*maxm,plev,(plat+1)/2) ! sum(n) of z(n,m)*P(n,m) - real(r8) grds(2*maxm,plev,(plat+1)/2) ! sum(n) of d(n,m)*P(n,m) - real(r8) gruhs(2*maxm,plev,(plat+1)/2) ! sum(n) of K(2i)*z(n,m)*H(n,m)*a/(n(n+1)) - real(r8) grvhs(2*maxm,plev,(plat+1)/2) ! sum(n) of K(2i)*d(n,m)*H(n,m)*a/(n(n+1)) - real(r8) grths(2*maxm,plev,(plat+1)/2) ! sum(n) of K(2i)*t(n,m)*P(n,m) - real(r8) grpss(2*maxm,(plat+1)/2) ! sum(n) of lnps(n,m)*P(n,m) - real(r8) grus(2*maxm,plev,(plat+1)/2) ! sum(n) of z(n,m)*H(n,m)*a/(n(n+1)) - real(r8) grvs(2*maxm,plev,(plat+1)/2) ! sum(n) of d(n,m)*H(n,m)*a/(n(n+1)) - real(r8) grts(2*maxm,plev,(plat+1)/2) ! sum(n) of t(n,m)*P(n,m) - real(r8) grpls(2*maxm,(plat+1)/2) ! sum(n) of lnps(n,m)*P(n,m)*m/a - real(r8) grpms(2*maxm,(plat+1)/2) ! sum(n) of lnps(n,m)*H(n,m) -! -! Antisymmetric fourier coefficient arrays for all variables transformed -! from spherical harmonics (see grcalc) -! - real(r8) grdpsa(2*maxm,(plat+1)/2) ! sum(n) of K(4)*(n(n+1)/a**2)**2*2dt*lnps(n,m)*P(n,m) - real(r8) grza(2*maxm,plev,(plat+1)/2) ! sum(n) of z(n,m)*P(n,m) - real(r8) grda(2*maxm,plev,(plat+1)/2) ! sum(n) of d(n,m)*P(n,m) - real(r8) gruha(2*maxm,plev,(plat+1)/2) ! sum(n)K(2i)*z(n,m)*H(n,m)*a/(n(n+1)) - real(r8) grvha(2*maxm,plev,(plat+1)/2) ! sum(n)K(2i)*d(n,m)*H(n,m)*a/(n(n+1)) - real(r8) grtha(2*maxm,plev,(plat+1)/2) ! sum(n) of K(2i)*t(n,m)*P(n,m) - real(r8) grpsa(2*maxm,(plat+1)/2) ! sum(n) of lnps(n,m)*P(n,m) - real(r8) grua(2*maxm,plev,(plat+1)/2) ! sum(n) of z(n,m)*H(n,m)*a/(n(n+1)) - real(r8) grva(2*maxm,plev,(plat+1)/2) ! sum(n) of d(n,m)*H(n,m)*a/(n(n+1)) - real(r8) grta(2*maxm,plev,(plat+1)/2) ! sum(n) of t(n,m)*P(n,m) - real(r8) grpla(2*maxm,(plat+1)/2) ! sum(n) of lnps(n,m)*P(n,m)*m/a - real(r8) grpma(2*maxm,(plat+1)/2) ! sum(n) of lnps(n,m)*H(n,m) - real(r8) residual ! residual energy integral - real(r8) beta ! energy fixer coefficient -! - integer m,n ! indices - integer lat,j,irow ! latitude indices - integer nlon_fft_in ! FFT work array inner dimension - integer nlon_fft_out ! FFT work array inner dimension -! -! FFT buffers -! - real(r8), allocatable:: fftbuf_in(:,:,:,:) ! fftbuf_in(nlon_fft_in,8,plevp,plat) - real(r8), allocatable:: fftbuf_out(:,:,:,:) ! fftbuf_out(nlon_fft_out,8,plevp,beglat:endlat) -! -! Temporal space for rearranged spectral coeffs. The rearrangement will -! be made in prepGRcalc and the rearranged coeffs will be transformed -! to Fourier coeffs in grcalca and grcalcs. -! - real(r8) tmpSPEcoef(plev*24,pnmax,maxm) - -! -!----------------------------------------------------------------------- - if (.not. single_column) then - - call t_startf ('grcalc') - - call prepGRcalc(tmpSPEcoef) - -#if ( defined SPMD ) - -!$OMP PARALLEL DO PRIVATE (J) - do j=1,plat/2 - call grcalcs (j, ztodt, grts(1,1,j), grths(1,1,j), grds(1,1,j), & - grzs(1,1,j), grus(1,1,j), gruhs(1,1,j), grvs(1,1,j), grvhs(1,1,j), & - grpss(1,j), grdpss(1,j), grpms(1,j), grpls(1,j), tmpSPEcoef) - - call grcalca (j, ztodt, grta(1,1,j), grtha(1,1,j), grda(1,1,j), & - grza(1,1,j), grua(1,1,j), gruha(1,1,j), grva(1,1,j), grvha(1,1,j), & - grpsa(1,j), grdpsa(1,j), grpma(1,j), grpla(1,j), tmpSPEcoef) - end do - -#else - -!$OMP PARALLEL DO PRIVATE (LAT, J) - do lat=beglat,endlat - if (lat > plat/2) then - j = plat - lat + 1 - call grcalcs (j, ztodt, grts(1,1,j), grths(1,1,j), grds(1,1,j), & - grzs(1,1,j), grus(1,1,j), gruhs(1,1,j), grvs(1,1,j), grvhs(1,1,j), & - grpss(1,j), grdpss(1,j), grpms(1,j), grpls(1,j), tmpSPEcoef) - else - j = lat - call grcalca (j, ztodt, grta(1,1,j), grtha(1,1,j), grda(1,1,j), & - grza(1,1,j), grua(1,1,j), gruha(1,1,j), grva(1,1,j), grvha(1,1,j), & - grpsa(1,j), grdpsa(1,j), grpma(1,j), grpla(1,j), tmpSPEcoef) - end if - end do - -#endif - - call t_stopf ('grcalc') - - call t_startf('spegrd_alloc') -#if ( defined SPMD ) - nlon_fft_in = 2*maxm - allocate(fftbuf_in(nlon_fft_in,8,plevp,plat)) -#else - nlon_fft_in = 1 - allocate(fftbuf_in(1,1,1,1)) -#endif - - nlon_fft_out = plondfft - allocate(fftbuf_out(nlon_fft_out,8,plevp,beglat:endlat)) - call t_stopf('spegrd_alloc') -! - call t_startf('spegrd_bft') -!$OMP PARALLEL DO PRIVATE (LAT, IROW) - do lat=1,plat - irow = lat - if (lat > plat/2) irow = plat - lat + 1 -#if ( defined SPMD ) - call spegrd_bft (lat, nlon_fft_in, & - grdpss(1,irow), grzs(1,1,irow), grds(1,1,irow), gruhs(1,1,irow), grvhs(1,1,irow), & - grths(1,1,irow), grpss(1,irow), grus(1,1,irow), grvs(1,1,irow), grts(1,1,irow), & - grpls(1,irow), grpms(1,irow), grdpsa(1,irow), grza(1,1,irow), grda(1,1,irow), & - gruha(1,1,irow), grvha(1,1,irow), grtha(1,1,irow), grpsa(1,irow), grua(1,1,irow), & - grva(1,1,irow), grta(1,1,irow), grpla(1,irow), grpma(1,irow), fftbuf_in(1,1,1,lat) ) -#else - call spegrd_bft (lat, nlon_fft_out, & - grdpss(1,irow), grzs(1,1,irow), grds(1,1,irow), gruhs(1,1,irow), grvhs(1,1,irow), & - grths(1,1,irow), grpss(1,irow), grus(1,1,irow), grvs(1,1,irow), grts(1,1,irow), & - grpls(1,irow), grpms(1,irow), grdpsa(1,irow), grza(1,1,irow), grda(1,1,irow), & - gruha(1,1,irow), grvha(1,1,irow), grtha(1,1,irow), grpsa(1,irow), grua(1,1,irow), & - grva(1,1,irow), grta(1,1,irow), grpla(1,irow), grpma(1,irow), fftbuf_out(1,1,1,lat) ) -#endif - end do - call t_stopf('spegrd_bft') - - call t_startf('spegrd_ift') - call spegrd_ift ( nlon_fft_in, nlon_fft_out, fftbuf_in, fftbuf_out ) - call t_stopf('spegrd_ift') - - call t_startf('spegrd_aft') -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE (LAT) -#endif - do lat=beglat,endlat - call spegrd_aft (ztodt, lat, plon, nlon_fft_out, & - cwava(lat), qfcst(1,1,1,lat), etamid, ps(1,lat,n3), & - u3(1,1,lat,n3), v3(1,1,lat,n3), t3(1,1,lat,n3), & - qminus(1,1,1,lat), vort(1,1,lat,n3), div(1,1,lat,n3), hw2al(1,lat), hw2bl(1,lat), & - hw3al(1,lat), hw3bl(1,lat), hwxal(1,1,lat), hwxbl(1,1,lat), q3(1,1,1,lat,n3m1), & - dps(1,lat), dpsl(1,lat), dpsm(1,lat), t3(1,1,lat,n3m2) ,engy2alat(lat), engy2blat(lat), & - difftalat(lat), difftblat(lat), phis(1,lat), fftbuf_out(1,1,1,lat) ) - - end do - call t_stopf('spegrd_aft') -! - call t_startf('spegrd_dealloc') - deallocate(fftbuf_in) - deallocate(fftbuf_out) - call t_stopf('spegrd_dealloc') -! -#ifdef SPMD - call t_barrierf ('sync_realloc5', mpicom) - call t_startf('realloc5') - call realloc5 (hw2al ,hw2bl ,hw3al ,hw3bl ,tmass , & - hw1lat ,hwxal ,hwxbl ,engy1lat,engy2alat, & - engy2blat, difftalat, difftblat) - call t_stopf('realloc5') -#endif - -! -! Accumulate and normalize global integrals for mass fixer (dry mass of -! atmosphere is held constant). -! - call t_startf ('scan2_single') - tmassf = 0._r8 - do lat=1,plat - tmassf = tmassf + tmass(lat) - end do - tmassf = tmassf*.5_r8 -! -! Initialize moisture, mass, energy, and temperature integrals -! - hw1(1) = 0._r8 - engy1 = 0._r8 - engy2a = 0._r8 - engy2b = 0._r8 - diffta = 0._r8 - difftb = 0._r8 - do m=1,pcnst - hw2a(m) = 0._r8 - hw2b(m) = 0._r8 - hw3a(m) = 0._r8 - hw3b(m) = 0._r8 - do n=1,4 - hwxa(m,n) = 0._r8 - hwxb(m,n) = 0._r8 - end do - end do -! -! Sum water and energy integrals over latitudes -! - do lat=1,plat - engy1 = engy1 + engy1lat (lat) - engy2a = engy2a + engy2alat(lat) - engy2b = engy2b + engy2blat(lat) - diffta = diffta + difftalat(lat) - difftb = difftb + difftblat(lat) - hw1(1) = hw1(1) + hw1lat(1,lat) - hw2a(1) = hw2a(1) + hw2al(1,lat) - hw2b(1) = hw2b(1) + hw2bl(1,lat) - hw3a(1) = hw3a(1) + hw3al(1,lat) - hw3b(1) = hw3b(1) + hw3bl(1,lat) - end do -! -! Compute atmospheric mass fixer coefficient -! - qmassf = hw1(1) - if (adiabatic .or. ideal_phys) then - fixmas = tmass0/tmassf - else - fixmas = (tmass0 + qmassf)/tmassf - end if -! -! Compute alpha for water ONLY -! - hw2(1) = hw2a(1) + fixmas*hw2b(1) - hw3(1) = hw3a(1) + fixmas*hw3b(1) - if(hw3(1) .ne. 0._r8) then - alpha(1) = ( hw1(1) - hw2(1) )/hw3(1) - else - alpha(1) = 1._r8 - endif -! -! Compute beta for energy -! - engy2 = engy2a + fixmas*engy2b - difft = diffta + fixmas*difftb - residual = (engy2 - engy1)/ztodt - if(difft .ne. 0._r8) then - beta = -residual*ztodt/(cpair*difft) - else - beta = 0._r8 - endif -!! write(iulog,125) residual,beta -!!125 format(' resid, beta = ',25x,2f25.15) -! -! Compute alpha for non-water constituents -! - do m = 2,pcnst - hw1(m) = 0._r8 - do lat=1,plat - hw1(m) = hw1(m) + hw1lat(m,lat) - end do - do n = 1,4 - do lat=1,plat - hwxa(m,n) = hwxa(m,n) + hwxal(m,n,lat) - hwxb(m,n) = hwxb(m,n) + hwxbl(m,n,lat) - end do - end do - hw2a(m) = hwxa(m,1) - alpha(1)*hwxa(m,2) - hw2b(m) = hwxb(m,1) - alpha(1)*hwxb(m,2) - hw3a(m) = hwxa(m,3) - alpha(1)*hwxa(m,4) - hw3b(m) = hwxb(m,3) - alpha(1)*hwxb(m,4) - hw2 (m) = hw2a(m) + fixmas*hw2b(m) - hw3 (m) = hw3a(m) + fixmas*hw3b(m) - if(hw3(m) .ne. 0._r8) then - alpha(m) = ( hw1(m) - hw2(m) )/hw3(m) - else - alpha(m) = 1._r8 - end if - end do - - call t_stopf ('scan2_single') - - -else - - do lat=beglat,endlat - j = lat - irow = lat - if (lat > plat/2) irow = plat - lat + 1 - call forecast( lat , plon , ztodt , & - ps(1,lat,n3m1) , ps(1,lat,n3m2) , ps(1,lat,n3) , & - u3(1,1,j,n3) , u3(1,1,j,n3m1) , u3(1,1,j,n3m2) , & - v3(1,1,j,n3) , v3(1,1,j,n3m1) , v3(1,1,j,n3m2) , & - t3(1,1,j,n3) , t3(1,1,j,n3m1) , t3(1,1,j,n3m2) , & - q3(1,1,1,j,n3) , q3(1,1,1,j,n3m1) , q3(1,1,1,j,n3m2) , & - t2(1,1,lat) , fu(1,1,lat) , fv(1,1,lat) , & - qminus(1,1,1,j) , qfcst(1,1,1,lat) ) - end do -! -! Initialize fixer variables for routines not called in scam version of -! model -! - engy2alat=0._r8 - engy2blat=0._r8 - difftalat=0._r8 - difftblat=0._r8 - engy2b=0._r8 - -! -! read in fixer for scam -! - if ( scm_cambfb_mode ) then - fixmas=fixmascam - beta=betacam - do m = 1, pcnst - alpha(m)=alphacam(m) - end do - else - fixmas=1._r8 - beta=0._r8 - alpha(:)=0._r8 - endif -endif ! if not SCAM - -call t_startf ('tfilt_massfix') - -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE (LAT) -#endif - do lat=beglat,endlat - - call tfilt_massfixrun (ztodt, lat, u3(1,1,lat,n3m1),u3(1,1,lat,n3), & - v3(1,1,lat,n3m1), v3(1,1,lat,n3), t3(1,1,lat,n3m1), t3(1,1,lat,n3), & - q3(1,1,1,lat,n3m1), & - q3(1,1,1,lat,n3), ps(1,lat,n3m1), ps(1,lat,n3), alpha, & - etamid, qfcst(1,1,1,lat), vort(1,1,lat,n3), div(1,1,lat,n3), & - vort(1,1,lat,n3m2), & - div(1,1,lat,n3m2), qminus(1,1,1,lat), ps(1,lat,n3m2), & - u3(1,1,lat,n3m2), & - v3(1,1,lat,n3m2), t3(1,1,lat,n3m2), q3(1,1,1,lat,n3m2), vort(1,1,lat,n3m1), & - div(1,1,lat,n3m1), & - omga(1,1,lat), dpsl(1,lat), dpsm(1,lat), beta, hadv(1,1,1,lat) ,plon, & - pdeld(:,:,lat,n3), pdeld(:,:,lat,n3m1), pdeld(:,:,lat,n3m2)) - - end do - call t_stopf ('tfilt_massfix') -! -! Shift time pointers -! - call shift_time_indices () - - return -end subroutine scan2run - -! -!----------------------------------------------------------------------- -! - -#ifdef SPMD -subroutine realloc5 (hw2al ,hw2bl ,hw3al ,hw3bl ,tmass , & - hw1lat ,hwxal ,hwxbl ,engy1lat,engy2alat, & - engy2blat,difftalat,difftblat ) -!----------------------------------------------------------------------- -! -! Purpose: Reallocation routine for slt variables. -! -! Method: MPI_Allgatherv (or point-to-point implementation) -! -! Author: J. Rosinski -! Standardized: J. Rosinski, Oct 1995 -! J. Truesdale, Feb. 1996 -! Modified: P. Worley, December 2003, October 2004 -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - use pmgrid, only: numlats, plat - use mpishorthand, only: mpicom, mpir8 - use spmd_dyn - use spmd_utils, only : iam, npes, altalltoallv -!---------------------------------Parameters---------------------------------- - integer, parameter :: msgtag = 5000 -!---------------------------------Commons------------------------------------- -#include -!----------------------------------------------------------------------- -! -! Input arguments -! - real(r8), intent(inout) :: hw2al(pcnst,plat) - real(r8), intent(inout) :: hw2bl(pcnst,plat) - real(r8), intent(inout) :: hw3al(pcnst,plat) - real(r8), intent(inout) :: hw3bl(pcnst,plat) - real(r8), intent(inout) :: tmass (plat) - real(r8), intent(inout) :: hw1lat(pcnst,plat) - real(r8), intent(inout) :: hwxal(pcnst,4,plat) - real(r8), intent(inout) :: hwxbl(pcnst,4,plat) -! ! - - real(r8), intent(inout) :: engy1lat (plat) ! lat contribution to total energy (n) - real(r8), intent(inout) :: engy2alat(plat) ! lat contribution to total energy (n+1) - real(r8), intent(inout) :: engy2blat(plat) ! lat contribution to total energy (n+1) - real(r8), intent(inout) :: difftalat(plat) ! lat contribution to delta-T integral - real(r8), intent(inout) :: difftblat(plat) ! lat contribution to delta-T integral -! -!---------------------------Local workspace----------------------------- -! - integer procid - integer bufpos - integer procj - integer step, i, j, m, jstrt - integer beglat_p, endlat_p, numlats_p, jstrt_p -! - logical, save :: first = .true. - integer, save :: sndcnt - integer, allocatable, save :: sndcnts(:), sdispls(:) - integer, allocatable, save :: rcvcnts(:), rdispls(:) - integer, allocatable, save :: pdispls(:) -!----------------------------------------------------------------------- - if (first) then -! Compute send/recv/put counts and displacements - allocate(sndcnts(0:npes-1)) - allocate(sdispls(0:npes-1)) - allocate(rcvcnts(0:npes-1)) - allocate(rdispls(0:npes-1)) - allocate(pdispls(0:npes-1)) -! -! Compute send count - sndcnt = (pcnst*(5 + 2*4) + 6)*numlats - sndcnts(:) = 0 - do step=1,allgather_steps - procid = allgather_proc(step) - sndcnts(procid) = sndcnt - enddo -! - sdispls(0) = 0 - do procid=1,npes-1 - sdispls(procid) = 0 - enddo -! -! Compute recv counts and displacements - rcvcnts(:) = 0 - do step=1,allgather_steps - procid = allgather_proc(step) - rcvcnts(procid) = (pcnst*(5 + 2*4) + 6)*nlat_p(procid) - enddo - rcvcnts(iam) = (pcnst*(5 + 2*4) + 6)*numlats -! - rdispls(0) = 0 - do procid=1,npes-1 - rdispls(procid) = rdispls(procid-1) + rcvcnts(procid-1) - enddo -! - pdispls(:) = 0 - call mpialltoallint(rdispls, 1, pdispls, 1, mpicom) -! - first = .false. - endif -! -! Fill send buffer - jstrt = beglat - 1 - bufpos = 0 -! tmass - do j=1,numlats - buf1(bufpos+j) = tmass(jstrt+j) - enddo - bufpos = bufpos + numlats -! engy1lat - do j=1,numlats - buf1(bufpos+j) = engy1lat(jstrt+j) - enddo - bufpos = bufpos + numlats -! engy2alat - do j=1,numlats - buf1(bufpos+j) = engy2alat(jstrt+j) - enddo - bufpos = bufpos + numlats -! engy2blat - do j=1,numlats - buf1(bufpos+j) = engy2blat(jstrt+j) - enddo - bufpos = bufpos + numlats -! difftalat - do j=1,numlats - buf1(bufpos+j) = difftalat(jstrt+j) - enddo - bufpos = bufpos + numlats -! difftblat - do j=1,numlats - buf1(bufpos+j) = difftblat(jstrt+j) - enddo - bufpos = bufpos + numlats -!hw1lat - do j=beglat,endlat - do m=1,pcnst - buf1(bufpos+m) = hw1lat(m,j) - enddo - bufpos = bufpos + pcnst - enddo -!hw2al - do j=beglat,endlat - do m=1,pcnst - buf1(bufpos+m) = hw2al(m,j) - enddo - bufpos = bufpos + pcnst - enddo -!hw2bl - do j=beglat,endlat - do m=1,pcnst - buf1(bufpos+m) = hw2bl(m,j) - enddo - bufpos = bufpos + pcnst - enddo -!hw3al - do j=beglat,endlat - do m=1,pcnst - buf1(bufpos+m) = hw3al(m,j) - enddo - bufpos = bufpos + pcnst - enddo -!hw3bl - do j=beglat,endlat - do m=1,pcnst - buf1(bufpos+m) = hw3bl(m,j) - enddo - bufpos = bufpos + pcnst - enddo -!hwxal - do j=beglat,endlat - do i=1,4 - do m=1,pcnst - buf1(bufpos+m) = hwxal(m,i,j) - enddo - bufpos = bufpos + pcnst - enddo - enddo -!hwxbl - do j=beglat,endlat - do i=1,4 - do m=1,pcnst - buf1(bufpos+m) = hwxbl(m,i,j) - enddo - bufpos = bufpos + pcnst - enddo - enddo -! -! Gather the data -! - if (dyn_allgather .eq. 0) then - call mpiallgatherv(buf1, sndcnt, mpir8, & - buf2, rcvcnts, rdispls, mpir8, & - mpicom) - else - call altalltoallv(dyn_allgather, iam, npes, & - allgather_steps, allgather_proc, & - buf1, spmdbuf_siz, sndcnts, sdispls, mpir8, & - buf2, spmdbuf_siz, rcvcnts, rdispls, mpir8, & - msgtag, pdispls, mpir8, buf2win, mpicom) - endif -! -! Copy out of message buffers -! -!$OMP PARALLEL DO PRIVATE (STEP, PROCID, BEGLAT_P, ENDLAT_P, NUMLATS_P, BUFPOS, JSTRT_P, I, J, M) - do step=1,allgather_steps - procid = allgather_proc(step) - beglat_p = cut(1,procid) - endlat_p = cut(2,procid) - numlats_p = nlat_p(procid) - bufpos = rdispls(procid) -! tmass - jstrt_p = beglat_p - 1 - do j=1,numlats_p - tmass(jstrt_p+j) = buf2(bufpos+j) - enddo - bufpos = bufpos + numlats_p -! engy1lat - jstrt_p = beglat_p - 1 - do j=1,numlats_p - engy1lat(jstrt_p+j) = buf2(bufpos+j) - enddo - bufpos = bufpos + numlats_p -! engy2alat - jstrt_p = beglat_p - 1 - do j=1,numlats_p - engy2alat(jstrt_p+j) = buf2(bufpos+j) - enddo - bufpos = bufpos + numlats_p -! engy2blat - jstrt_p = beglat_p - 1 - do j=1,numlats_p - engy2blat(jstrt_p+j) = buf2(bufpos+j) - enddo - bufpos = bufpos + numlats_p -! difftalat - jstrt_p = beglat_p - 1 - do j=1,numlats_p - difftalat(jstrt_p+j) = buf2(bufpos+j) - enddo - bufpos = bufpos + numlats_p -! difftblat - jstrt_p = beglat_p - 1 - do j=1,numlats_p - difftblat(jstrt_p+j) = buf2(bufpos+j) - enddo - bufpos = bufpos + numlats_p -! hw1lat - do j=beglat_p,endlat_p - do m=1,pcnst - hw1lat(m,j) = buf2(bufpos+m) - enddo - bufpos = bufpos + pcnst - enddo -! hw2al - do j=beglat_p,endlat_p - do m=1,pcnst - hw2al(m,j) = buf2(bufpos+m) - enddo - bufpos = bufpos + pcnst - enddo -! hw2bl - do j=beglat_p,endlat_p - do m=1,pcnst - hw2bl(m,j) = buf2(bufpos+m) - enddo - bufpos = bufpos + pcnst - enddo -! hw3al - do j=beglat_p,endlat_p - do m=1,pcnst - hw3al(m,j) = buf2(bufpos+m) - enddo - bufpos = bufpos + pcnst - enddo -! hw3bl - do j=beglat_p,endlat_p - do m=1,pcnst - hw3bl(m,j) = buf2(bufpos+m) - enddo - bufpos = bufpos + pcnst - enddo -! hwxal - do j=beglat_p,endlat_p - do i=1,4 - do m=1,pcnst - hwxal(m,i,j) = buf2(bufpos+m) - enddo - bufpos = bufpos + pcnst - enddo - enddo -! hwxbl - do j=beglat_p,endlat_p - do i=1,4 - do m=1,pcnst - hwxbl(m,i,j) = buf2(bufpos+m) - enddo - bufpos = bufpos + pcnst - enddo - enddo -! - end do -! - return -end subroutine realloc5 -#endif - -! -!----------------------------------------------------------------------- -! - - -end module scan2 diff --git a/src/dynamics/eul/scandyn.F90 b/src/dynamics/eul/scandyn.F90 deleted file mode 100644 index 1165957729..0000000000 --- a/src/dynamics/eul/scandyn.F90 +++ /dev/null @@ -1,207 +0,0 @@ - -subroutine scandyn (ztodt, etadot, etamid, grlps1, grt1, & - grz1, grd1, grfu1, grfv1, grut1, & - grvt1, grrh1, grlps2, grt2, grz2, & - grd2, grfu2, grfv2, grut2, grvt2, & - grrh2, vcour, vmax2d, vmax2dt, detam, & - cwava, flx_net, t2, fu, fv) -!----------------------------------------------------------------------- -! -! Purpose: -! -! Method: -! "After coupling" gaussian latitude scan for which some of the physics -! and nonlinear dynamics calculations are completed. The main loop over -! latitude in this routine is multitasked. -! -! Note: the "ifdef" constructs in this routine are associated with the -! message-passing version of CAM. Messages are sent which -! have no relevance to the shared-memory case. -! -! Author: -! Original version: CCM3 -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plat, plev, beglat, endlat, plevp - use prognostics, only: u3, v3, q3, t3, div, vort, phis, omga, dpsl, & - dpsm, ps, n3m1, n3, n3m2, qminus, pdeld - use constituents, only: pcnst - use scanslt, only: hw1lat - use comspe, only: maxm - use linemsdyn, only: linemsdyn_bft, linemsdyn_fft, linemsdyn_aft, & - plondfft - use commap, only: w - use qmassa, only: qmassarun - use perf_mod -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -! -! Input arguments -! - real(r8), intent(in) :: ztodt ! two delta t unless nstep =0 - real(r8), intent(inout) :: etadot(plon,plevp,beglat:endlat) ! vertical motion (slt) - real(r8), intent(in) :: etamid(plev) ! hybrd coord value at levels - real(r8), intent(in) :: detam(plev) -! -! Fourier coefficient arrays which have a latitude index on them for -! multitasking. These arrays are defined in LINEMSDYN and and used in QUAD -! to compute spectral coefficients. They contain a latitude index so -! that the sums over latitude can be performed in a specified order. -! - real(r8), intent(in) :: cwava(plat) ! weight applied to global integrals - real(r8), intent(in) :: flx_net(plon,beglat:endlat) ! net flx from physics - real(r8), intent(inout) :: t2(plon,plev,beglat:endlat) ! tot dT/dt to to physics - real(r8), intent(inout) :: fu(plon,plev,beglat:endlat) ! u wind tend - real(r8), intent(inout) :: fv(plon,plev,beglat:endlat) ! v wind tend -! -! Output arguments -! - real(r8), intent(out) :: grlps1(2*maxm,(plat+1)/2) ! sym. undiff. term in lnps eqn. - real(r8), intent(out) :: grlps2(2*maxm,(plat+1)/2) ! antisym undiff. term in lnps eqn. - real(r8), intent(out) :: grt1(2*maxm,plev,(plat+1)/2) ! sym. undiff. term in t eqn. - real(r8), intent(out) :: grt2(2*maxm,plev,(plat+1)/2) ! antisym. undiff. term in t eqn. - real(r8), intent(out) :: grz1(2*maxm,plev,(plat+1)/2) ! sym. undiff. term in z eqn. - real(r8), intent(out) :: grz2(2*maxm,plev,(plat+1)/2) ! antisym. undiff. term in z eqn. - real(r8), intent(out) :: grd1(2*maxm,plev,(plat+1)/2) ! sym. undiff. term in d eqn. - real(r8), intent(out) :: grd2(2*maxm,plev,(plat+1)/2) ! antisym. undiff. term in d eqn. - real(r8), intent(out) :: grfu1(2*maxm,plev,(plat+1)/2) ! sym. nonlinear terms in u eqn. - real(r8), intent(out) :: grfu2(2*maxm,plev,(plat+1)/2) ! antisym. nonlinear terms in u eqn. - real(r8), intent(out) :: grfv1(2*maxm,plev,(plat+1)/2) ! sym. nonlinear terms in v eqn. - real(r8), intent(out) :: grfv2(2*maxm,plev,(plat+1)/2) ! antisym. nonlinear terms in v eqn. - real(r8), intent(out) :: grut1(2*maxm,plev,(plat+1)/2) ! sym. lambda deriv. term in t eqn. - real(r8), intent(out) :: grut2(2*maxm,plev,(plat+1)/2) ! antisym. lambda deriv. term in t eqn. - real(r8), intent(out) :: grvt1(2*maxm,plev,(plat+1)/2) ! sym. mu derivative term in t eqn. - real(r8), intent(out) :: grvt2(2*maxm,plev,(plat+1)/2) ! antisym. mu deriv. term in t eqn. - real(r8), intent(out) :: grrh1(2*maxm,plev,(plat+1)/2) ! sym. del**2 term in d eqn. - real(r8), intent(out) :: grrh2(2*maxm,plev,(plat+1)/2) ! antisym. del**2 term in d eqn. - real(r8), intent(out) :: vcour(plev,plat) ! maximum Courant number in vert. - real(r8), intent(out) :: vmax2d(plev,plat) ! max. wind at each level, latitude - real(r8), intent(out) :: vmax2dt(plev,plat) ! max. truncated wind at each lvl,lat - -! Local variables - - integer irow ! latitude pair index - integer lat,latn,lats ! latitude indices - integer nlon_fft_in ! FFT work array inner dimension - integer nlon_fft_out ! FFT work array inner dimension - real(r8) pmid(plon,plev) ! pressure at model levels - real(r8) pint(plon,plevp) ! pressure at interfaces - real(r8) pdel(plon,plev) ! pressure difference between - integer :: m ! constituent index -! -! FFT buffers -! - real(r8), allocatable:: fftbuf_in(:,:,:,:) ! fftbuf_in(nlon_fft_in,9,plev,beglat:endlat) - real(r8), allocatable:: fftbuf_out(:,:,:,:) ! fftbuf_out(nlon_fft_out,9,plev,plat) -! - call t_startf ('scandyn_alloc') - nlon_fft_in = plondfft - allocate(fftbuf_in(nlon_fft_in,9,plev,beglat:endlat)) - -#if ( defined SPMD ) -#ifdef NEC_SX - nlon_fft_out = 2*maxm + 1 -#else - nlon_fft_out = 2*maxm -#endif - allocate(fftbuf_out(nlon_fft_out,9,plev,plat)) -#else - nlon_fft_out = 1 - allocate(fftbuf_out(1,1,1,1)) -#endif - call t_stopf ('scandyn_alloc') -! - call t_startf ('linemsdyn_bft') -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE (LAT) -#endif - do lat=beglat,endlat - - call linemsdyn_bft (lat, plon, nlon_fft_in, & - ps(1,lat,n3m1), ps(1,lat,n3m2), u3(1,1,lat,n3m1), & - u3(1,1,lat,n3m2), v3(1,1,lat,n3m1), v3(1,1,lat,n3m2), t3(1,1,lat,n3m1), t3(1,1,lat,n3m2), & - q3(1,1,1,lat,n3m1), etadot(1,1,lat), etamid, & - ztodt, vcour(1,lat), vmax2d(1,lat), vmax2dt(1,lat), & - detam, t2(1,1,lat), fu(1,1,lat), fv(1,1,lat), & - div(1,1,lat,n3m1), vort(1,1,lat,n3m2), div(1,1,lat,n3m2), vort(1,1,lat,n3m1), & - phis(1,lat), dpsl(1,lat), dpsm(1,lat), omga(1,1,lat), & - cwava(lat), flx_net(1,lat), fftbuf_in(1,1,1,lat) ) - end do - call t_stopf ('linemsdyn_bft') - - call t_startf ('linemsdyn_fft') - call linemsdyn_fft (nlon_fft_in,nlon_fft_out,fftbuf_in,fftbuf_out) - call t_stopf ('linemsdyn_fft') - - call t_startf ('linemsdyn_aft') -!$OMP PARALLEL DO PRIVATE (IROW, LATN, LATS) - do irow=1,plat/2 - - lats = irow - latn = plat - irow + 1 -#if ( defined SPMD ) - call linemsdyn_aft (irow, nlon_fft_out, fftbuf_out(1,1,1,lats), fftbuf_out(1,1,1,latn), & - grlps1(1,irow), grt1(1,1,irow), grz1(1,1,irow), grd1(1,1,irow), & - grfu1(1,1,irow), grfv1(1,1,irow), & - grut1(1,1,irow), grvt1(1,1,irow), grrh1(1,1,irow), grlps2(1,irow),grt2(1,1,irow), & - grz2(1,1,irow), grd2(1,1,irow), grfu2(1,1,irow), grfv2(1,1,irow), grut2(1,1,irow), & - grvt2(1,1,irow), grrh2(1,1,irow) ) -#else - call linemsdyn_aft (irow, nlon_fft_in, fftbuf_in(1,1,1,lats), fftbuf_in(1,1,1,latn), & - grlps1(1,irow), grt1(1,1,irow), grz1(1,1,irow), grd1(1,1,irow), & - grfu1(1,1,irow), grfv1(1,1,irow), & - grut1(1,1,irow), grvt1(1,1,irow), grrh1(1,1,irow), grlps2(1,irow),grt2(1,1,irow), & - grz2(1,1,irow), grd2(1,1,irow), grfu2(1,1,irow), grfv2(1,1,irow), grut2(1,1,irow), & - grvt2(1,1,irow), grrh2(1,1,irow) ) -#endif - end do - call t_stopf ('linemsdyn_aft') -! - call t_startf ('scandyn_dealloc') - deallocate(fftbuf_in) - deallocate(fftbuf_out) - call t_stopf ('scandyn_dealloc') - -! - call t_startf ('moisture_mass') -! -! Initialize moisture mass integrals. -! - hw1lat = 0.0_r8 -! -! Calculate total mass of moisture in fields advected -! -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE (LAT, IROW) -#endif - do lat=beglat,endlat - if(lat.le.plat/2) then - irow = lat - else - irow = plat + 1 - lat - end if -! -! Only pdel is needed pint and pmid are not. -! - call plevs0 (plon,plon,plev,ps(1,lat,n3m2), pint, pmid, pdel) -! -! Calculate mass of moisture in field being advected -! - -! q3 is plon,plev,pcnst,beglat:endlat,ptimelevs -! qminus is plon,plev,pcnst,beglat:endlat - call qmassarun (cwava(lat),w(irow) ,qminus(1,1,1,lat),pdel , & - hw1lat(1,lat),plon, q3(1,1,1,lat,n3m2), lat, & - pdeld(:,:,lat,n3m2 )) - end do - call t_stopf ('moisture_mass') - - return -end subroutine scandyn - diff --git a/src/dynamics/eul/scanslt.F90 b/src/dynamics/eul/scanslt.F90 deleted file mode 100644 index 40390729a0..0000000000 --- a/src/dynamics/eul/scanslt.F90 +++ /dev/null @@ -1,1430 +0,0 @@ -module scanslt -!----------------------------------------------------------------------- -! -! Module to handle Semi-Lagrangian transport in the context of -! Eulerian Spectral dynamics. -! -!----------------------------------------------------------------------- -! -! $Id$ -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plat, plev, beglat, endlat, plevp - use constituents, only: pcnst - use cam_abortutils, only: endrun - use scamMod, only: single_column - use perf_mod -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- - private -! -! Public interfaces -! - public scanslt_initial ! Advection initialization method - public scanslt_run ! Advection run method - public scanslt_final ! Advection finalization method - public scanslt_alloc ! Allocate some slt data needed for restarting -! -! Public extended grid parameters -! - integer, public, parameter :: nxpt = 1 ! no. of pts outside active domain of interpolant - integer, public, parameter :: jintmx = 2 ! number of extra latitudes in polar region - integer, public, parameter :: i1 = 1 + nxpt ! model starting longitude index - integer, public, parameter :: j1 = 1 + nxpt + jintmx ! model starting latitude index - integer, public, parameter :: plond = plon + 1 + 2*nxpt ! slt extended domain longitude - integer, public, parameter :: plond1 = plond - i1 +1 ! slt extended domain longitude starting at i1 - integer, public, parameter :: platd = plat + 2*nxpt + 2*jintmx ! slt extended domain lat. - integer, public, parameter :: numbnd = nxpt + jintmx ! no.of lats passed N and S of forecast lat - integer, public, parameter :: plndlv = plond*plev ! Length of multilevel 3-d field slice - - integer, public :: beglatex ! extended grid beglat - integer, public :: endlatex ! extended grid endlat - integer, public :: numlatsex ! number of latitudes owned by a given proc extended grid - -#if ( ! defined SPMD ) - parameter (beglatex = 1) - parameter (endlatex = platd) - parameter (numlatsex= platd) -#endif - - public engy1lat ! For calculation of total energy - public hw1lat ! For calculation of total moisture -! -! Public data structures -! - public advection_state - - ! advection data structure of data that will be on the extended grid for SLT - type advection_state - real(r8), pointer :: u3(:,:,:) => null() ! u-wind - real(r8), pointer :: v3(:,:,:) => null() ! v-wind - real(r8), pointer :: qminus(:,:,:,:) => null() ! constituents on previous step - end type advection_state - - public lammp, phimp, sigmp, qfcst ! Needed for restart -! - integer, public :: nlonex(platd) = huge(1) ! num longitudes per lat (extended grid) - real(r8) :: hw1lat (pcnst,plat) ! lat contribution to const. mass integral - real(r8) :: engy1lat(plat) ! lat contribution to total energy integral - real(r8), allocatable, target :: lammp(:,:,:) ! Lamda midpoint coordinate - real(r8), allocatable, target :: phimp(:,:,:) ! Phi midpoint coordinate - real(r8), allocatable, target :: sigmp(:,:,:) ! Sigma midpoint coordinate - real(r8), allocatable, target :: qfcst(:,:,:,:) ! slt forecast of moisture and constituents -! -! Private data -! - integer, parameter :: pmap = 20000 -! ! max dimension of evenly spaced vert. -! ! grid used by SLT code to map the departure pts into true -! ! model levels. -! - real(r8) :: etaint(plevp) ! vertical coords at interfaces - real(r8) :: dlam(platd) ! longitudinal grid interval (radians) - real(r8) :: lam(plond,platd) ! longitude coords of extended grid - real(r8) :: phi(platd) ! latitude coords of extended grid - real(r8) :: dphi(platd) ! latitude intervals (radians) - real(r8) :: sinlam(plond,platd) ! sin(lam) model domain only - real(r8) :: coslam(plond,platd) ! cos(lam) model domain only - real(r8) :: lbasdy(4,2,platd) ! latitude derivative weights - real(r8) :: lbasdz(4,2,plev) ! vert (full levels) deriv wghts - real(r8) :: lbassd(4,2,plevp) ! vert (half levels) deriv wghts - real(r8) :: lbasiy(4,2,platd) ! Lagrange cubic interp wghts (lat.) - real(r8) :: detai(plevp) ! intervals between vert half levs. - integer :: kdpmpf(pmap) ! artificial full vert grid indices - integer :: kdpmph(pmap) ! artificial half vert grid indices - real(r8) :: gravit ! gravitational constant - -!----------------------------------------------------------------------- -contains -!----------------------------------------------------------------------- - -! -!----------------------------------------------------------------------- -! - -subroutine scanslt_alloc() -!----------------------------------------------------------------------- -! -! Purpose: -! Allocate some scanslt data -! -! Author: -! -! Erik Kluzek -! -!----------------------------------------------------------------------- - use infnan, only: nan, assignment(=) - - allocate (lammp(plon,plev,beglat:endlat)) - allocate (phimp(plon,plev,beglat:endlat)) - allocate (sigmp(plon,plev,beglat:endlat)) - allocate (qfcst(plon,plev,pcnst,beglat:endlat)) - - lammp (:,:,:) = nan - phimp (:,:,:) = nan - sigmp (:,:,:) = nan - qfcst (:,:,:,:) = nan -end subroutine scanslt_alloc - -! -!----------------------------------------------------------------------- -! -subroutine scanslt_initial( adv_state, etamid, gravit_in, detam, cwava ) -!----------------------------------------------------------------------- -! -! Purpose: -! SLT initialization for Eulerian dynamics -! -! Author: -! -! Erik Kluzek -! -!----------------------------------------------------------------------- - use commap, only: clat - use prognostics, only: ps, n3 - use time_manager, only: is_first_step - use hycoef, only: hyam, hybm, hyai, hybi, ps0 - use eul_control_mod, only : pdela -! -! Input arguments -! - real(r8), intent(out) :: etamid(plev) ! vertical coords at midpoints - real(r8), intent(in) :: gravit_in ! Gravitational constant -! -! Output arguments -! - real(r8), intent(out) :: detam(plev) ! intervals between vert full levs. - real(r8), intent(out) :: cwava(plat) ! weight applied to global integrals - type(advection_state), intent(out) :: adv_state ! Advection state data - -! -! Local variables -! - integer :: i, j, k, lat ! indices - real(r8) :: hyad (plev) ! del (A) - real(r8) :: pmid(plon,plev) ! pressure at model levels - real(r8) :: pint(plon,plevp) ! pressure at interfaces - real(r8) :: pdel(plon,plev) ! pressure difference between - real(r8) :: gw(plat) ! Gaussian weights needed for SCAM grdini call -! -! Allocate memory for scanslt variables -! - call adv_state_alloc( adv_state ) - - do k = 1, plev - etamid(k) = hyam(k) + hybm(k) - etaint(k) = hyai(k) + hybi(k) - end do - etaint(plevp) = hyai(plevp) + hybi(plevp) -! -! For SCAM compute pressure levels to use for eta interface -! - if (single_column) then - lat = beglat - call plevs0(plon, plon, plev, ps(1,lat,n3), pint, pmid, pdel) - etamid(:) = pmid(lat,:) - etaint(:) = pint(lat,:) - if ( any(etamid == 0.0_r8) ) call endrun('etamid == 0') - if ( any(etaint == 0.0_r8) ) call endrun('etaint == 0') - endif -! -! Set slt module variables -! - gravit = gravit_in - call grdini(pmap ,etamid ,etaint ,gravit ,dlam , & - lam ,phi ,dphi ,gw ,sinlam , & - coslam ,lbasdy ,lbasdz ,lbassd ,lbasiy , & - detam ,detai ,kdpmpf ,kdpmph ,cwava ) -! -! Initial guess for trajectory midpoints in spherical coords. -! nstep = 0: use arrival points as initial guess for trajectory midpoints. -! nstep > 0: use calculated trajectory midpoints from previous time -! step as first guess. -! NOTE: reduce number of iters necessary for convergence after nstep = 1. -! - if (is_first_step()) then - do lat=beglat,endlat - j = j1 - 1 + lat -! -! Set current time pressure arrays for model levels etc. -! - call plevs0(plon, plon, plev, ps(1,lat,n3), pint, pmid, pdel) - - do k=1,plev - do i=1,plon - if (single_column) then - sigmp(i,k,lat) = pmid(i,k) - else - lammp(i,k,lat) = real(i-1,r8)*dlam(j1-1+lat) - phimp(i,k,lat) = clat(lat) - sigmp(i,k,lat) = etamid(k) - endif - end do - end do - end do - end if -! -! Compute pdel from "A" portion of hybrid vertical grid -! - do k=1,plev - hyad(k) = hyai(k+1) - hyai(k) - end do - do k=1,plev - do i=1,plon - pdela(i,k) = hyad(k)*ps0 - end do - end do - -end subroutine scanslt_initial - -! -!----------------------------------------------------------------------- -! - -subroutine scanslt_run(adv_state, ztodt ,etadot ,detam, etamid, cwava ) -!----------------------------------------------------------------------- -! -! Purpose: -! Driving routine for semi-lagrangian transport. -! -! Method: -! The latitude loop in this routine is multitasked. -! -! Author: -! Original version: J. Rosinski -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996 -! -!----------------------------------------------------------------------- - use physconst, only: ra - use prognostics, only: hadv - use time_manager, only: get_nstep - use pmgrid, only: plon, plat -#if (defined SPMD) - use mpishorthand, only: mpicom -#endif -!------------------------------Parameters------------------------------- - integer itermx ! number of iterations to be used in departure -! ! point calculation for nstep = 0 and 1 - integer itermn ! number of iterations to be used in departure -! ! point calculation for nstep > 1 - parameter(itermx=4,itermn=1) -!----------------------------------------------------------------------- -! -! Input arguments -! - real(r8), intent(in) :: ztodt ! twice the time step unless nstep = 0 - real(r8), intent(in) :: etadot(plon,plevp,beglat:endlat)! vertical motion (slt) - real(r8), intent(in) :: etamid(plev) ! eta at levels -! -! In/Output arguments -! - real(r8), intent(inout) :: detam(plev) ! delta eta at levels - ! needs intent(out) because of SCAM - real(r8), intent(inout) :: cwava(plat) ! weight for global water vapor int. - ! needs intent(out) because of SCAM - type(advection_state), intent(inout) :: adv_state ! Advection state data -! -!---------------------------Local workspace----------------------------- -! - integer iter ! number of iterations for -! ! departure point calculation - integer m - integer lat ! latitude index - integer irow ! N/S latitude pair index - integer jcen ! lat index (extended grid) of forecast - integer :: nstep ! current timestep number - real(r8) :: pmid(plon,plev) ! pressure at model levels - real(r8) :: pint(plon,plevp)! pressure at interfaces - real(r8) :: pdel(plon,plev) ! pressure difference between -! -! Dynamic (SPMD) vs stack (shared memory) -! - real(r8) uxl(plond,plev,beglatex:endlatex) ! left x-deriv of u/v - real(r8) uxr(plond,plev,beglatex:endlatex) ! left x-deriv of u/v - real(r8) vxl(plond,plev,beglatex:endlatex) ! left x-deriv of u/v - real(r8) vxr(plond,plev,beglatex:endlatex) ! left x-deriv of u/v - real(r8) qxl(plond,plev,pcnst,beglatex:endlatex) ! left x-deriv of constituents - real(r8) qxr(plond,plev,pcnst,beglatex:endlatex) ! right x-deriv of constituents - real(r8) :: gw(plat) ! Gaussian weights needed for SCAM grdini call - integer :: k ! Vertical index needed for SCAM -! -!----------------------------------------------------------------------- -! -! Copy dynamics data into SLT advection structure -! - call t_startf ('scanslt_da_coup') - call da_coupling( cwava, adv_state ) - call t_stopf ('scanslt_da_coup') -! -! For SCAM reset vertical grid -! - if (single_column) then -! -! IF surface pressure changes with time we need to remap the vertical -! coordinate for the slt advection process. It has been empirically -! determined that we can get away with 500 for pmap (instead of 20000) -! This is necessary to make the procedure computationally feasible -! - call grdini(pmap ,etamid ,etaint ,gravit ,dlam , & - lam ,phi ,dphi ,gw ,sinlam , & - coslam ,lbasdy ,lbasdz ,lbassd ,lbasiy , & - detam ,detai ,kdpmpf ,kdpmph ,cwava ) -! -! Initial guess for trajectory midpoints in spherical coords. -! nstep = 0: use arrival points as initial guess for trajectory midpoints. -! nstep > 0: use calculated trajectory midpoints from previous time -! step as first guess. -! NOTE: reduce number of iters necessary for convergence after nstep = 1. -! - do k=1,plev - sigmp(1,k,beglat) = etamid(k) - end do - - else -! -! Mpi barrier -! -#if ( defined SPMD ) -! -! Communicate boundary information -! - call t_barrierf ('sync_bndexch', mpicom) - call t_startf ('bndexch') - call bndexch( adv_state ) - call t_stopf ('bndexch') -#endif - - nstep = get_nstep() -! -! Initialize extended arrays -! - call t_startf('sltini') - call sltini (dlam, sinlam, coslam, uxl, uxr, & - vxl, vxr, qxl, qxr, adv_state ) - call t_stopf('sltini') - endif - nstep = get_nstep() - if (nstep .le. 1) then - iter = itermx - else - iter = itermn - end if -! -! Loop through latitudes producing forecast -! - call t_startf ('sltb1') -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE (LAT, IROW, JCEN) -#endif - do lat=beglat,endlat - if(lat.le.plat/2) then - irow = lat - else - irow = plat + 1 - lat - end if - jcen = j1 - 1 + lat -! -! Call slt interface routine. -! - call sltb1 (pmap ,jcen ,lat ,ztodt ,ra , & - iter ,uxl ,uxr ,vxl ,vxr , & - etadot(1,1,lat) ,qxl ,qxr ,lam , & - phi ,dphi ,etamid ,etaint ,detam , & - detai ,lbasdy ,lbasdz ,lbassd ,lbasiy , & - kdpmpf ,kdpmph ,lammp(1,1,lat), phimp(1,1,lat), sigmp(1,1,lat), & - qfcst(1,1,1,lat) ,adv_state, plon, hadv, nlonex ) - end do - call t_stopf ('sltb1') -! -! Copy SLT advection structure data back into dynamics data -! - call t_startf ('scanslt_ad_coup') - call ad_coupling( adv_state ) - call t_stopf ('scanslt_ad_coup') - return -end subroutine scanslt_run - -! -!----------------------------------------------------------------------- -! -subroutine scanslt_final( adv_state ) -!----------------------------------------------------------------------- -! -! Purpose: -! SLT finalization for Eulerian dynamics -! -! Author: -! -! Erik Kluzek -! -!----------------------------------------------------------------------- -! -! Arguments -! - type(advection_state), intent(inout) :: adv_state ! Advection state data - - call adv_state_dealloc( adv_state ) -end subroutine scanslt_final - -! -!----------------------------------------------------------------------- -! - -subroutine ad_coupling( adv_state ) -!----------------------------------------------------------------------- -! -! Purpose: -! Copy advection data into dynamics state. -! -! Author: -! -! Erik Kluzek -! -!----------------------------------------------------------------------- - use prognostics, only: u3, v3, qminus, n3m1 -! -! Arguments -! - type(advection_state), intent(in) :: adv_state ! Advection state data - - integer :: i, j, k, c ! Indices - -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE (J,K,I,C) -#endif - do j = beglat, endlat -!$OMP PARALLEL DO PRIVATE (K,I,C) - do k = 1, plev - do i = 1, plon - u3(i,k,j,n3m1) = adv_state%u3(i+i1-1,k,j+beglatex+numbnd-beglat) - v3(i,k,j,n3m1) = adv_state%v3(i+i1-1,k,j+beglatex+numbnd-beglat) - do c = 1, pcnst - qminus(i,k,c,j) = adv_state%qminus(i+i1-1,k,c,j+beglatex+numbnd-beglat) - end do - end do - end do - end do - -end subroutine ad_coupling - -! -!----------------------------------------------------------------------- -! - -subroutine da_coupling( cwava, adv_state ) -!----------------------------------------------------------------------- -! -! Purpose: -! Copy dynamics data into advection state -! Also find the total moisture mass before SLT. -! -! Author: -! -! Erik Kluzek -! -!----------------------------------------------------------------------- - use prognostics, only: u3, v3, qminus, n3m1, ps, n3m2, q3, pdeld - use commap, only: w - use qmassa, only: qmassarun - -! -! Arguments -! - real(r8), intent(in) :: cwava(plat) ! weight for global water vapor int. - type(advection_state), intent(inout) :: adv_state ! Advection state data -! -! Local variables -! - integer :: i, j, k, c, irow, lat ! Indices - - real(r8) :: pmid(plon,plev) ! pressure at model levels - real(r8) :: pint(plon,plevp) ! pressure at interfaces - real(r8) :: pdel(plon,plev) ! pressure difference between -! -! Initialize moisture mass integrals. -! - hw1lat = 0.0_r8 -! -! Find moisture mass before SLT -! -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE (LAT, IROW, PINT, PMID, PDEL) -#endif - do lat=beglat,endlat - if(lat.le.plat/2) then - irow = lat - else - irow = plat + 1 - lat - end if -! -! Only pdel is needed inside SLT. pint and pmid are not. -! - call plevs0 (plon,plon,plev,ps(1,lat,n3m2), pint, pmid, pdel) -! -! Calculate mass of moisture in field being advected by slt. (hw1lat) -! - -! q3 is plon,plev,pcnst,beglat:endlat,ptimelevs -! qminus is plon,plev,pcnst,beglat:endlat - call qmassarun (cwava(lat),w(irow) ,qminus(1,1,1,lat),pdel , & - hw1lat(1,lat),plon, q3(1,1,1,lat,n3m2), lat, pdeld(:,:,lat,n3m2 )) - end do - -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE (J,K,I,C) -#endif - do j = beglat, endlat -!$OMP PARALLEL DO PRIVATE (K,I,C) - do k = 1, plev - do i = 1, plon - adv_state%u3(i+i1-1,k,j+beglatex+numbnd-beglat) = u3(i,k,j,n3m1) - adv_state%v3(i+i1-1,k,j+beglatex+numbnd-beglat) = v3(i,k,j,n3m1) - do c = 1, pcnst - adv_state%qminus(i+i1-1,k,c,j+beglatex+numbnd-beglat) = qminus(i,k,c,j) - end do - end do - end do - end do - -end subroutine da_coupling - -! -!----------------------------------------------------------------------- -! - -subroutine adv_state_alloc( adv_state ) -!----------------------------------------------------------------------- -! -! Purpose: -! Allocate advection state data -! -! Author: -! -! Erik Kluzek -! -!----------------------------------------------------------------------- - use infnan, only: posinf, assignment(=) -! -! Arguments -! - type(advection_state), intent(out) :: adv_state ! Advection state data - - allocate (adv_state%u3 (plond,plev ,beglatex:endlatex) ) - allocate (adv_state%v3 (plond,plev ,beglatex:endlatex) ) - allocate (adv_state%qminus(plond,plev,pcnst ,beglatex:endlatex) ) - adv_state%u3 (:,:, beglatex:endlatex) = posinf - adv_state%v3 (:,:, beglatex:endlatex) = posinf - adv_state%qminus(:,:,:,beglatex:endlatex) = posinf - -end subroutine adv_state_alloc - -! -!----------------------------------------------------------------------- -! - -subroutine adv_state_dealloc( adv_state ) -!----------------------------------------------------------------------- -! -! Purpose: -! De-allocate advection state data -! -! Author: -! -! Erik Kluzek -! -!----------------------------------------------------------------------- -! -! Arguments -! - type(advection_state), intent(inout) :: adv_state ! Advection state data - - deallocate (adv_state%u3 ) - deallocate (adv_state%v3 ) - deallocate (adv_state%qminus) - -end subroutine adv_state_dealloc - -! -!----------------------------------------------------------------------- -! - -subroutine grdini(pmap ,etamid ,etaint ,gravit ,dlam , & - lam ,phi ,dphi ,gw ,sinlam , & - coslam ,lbasdy ,lbasdz ,lbassd ,lbasiy , & - detam ,detai ,kdpmpf ,kdpmph ,cwava ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Initialize model and extended grid parameters -! Initialize weights for Lagrange cubic derivative estimates -! Initialize weights for Lagrange cubic interpolant -! -! Method: -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996 -! -!----------------------------------------------------------------------- - use vrtmap_mod, only: vrtmap -!------------------------------Parameters------------------------------- -! -! Input arguments -! - integer, intent(in) :: pmap ! dimension of artificial vert. grid -! - real(r8), intent(in) :: etamid(plev) ! full-level model vertical grid - real(r8), intent(in) :: etaint(plevp) ! half-level model vertical grid - real(r8), intent(in) :: gravit ! gravitational constant -! -! Output arguments -! - real(r8), intent(out) :: dlam(platd) ! longitudinal grid interval (radians) - real(r8), intent(out) :: lam (plond,platd) ! longitudinal coords of extended grid - real(r8), intent(out) :: phi (platd) ! latitudinal coords of extended grid - real(r8), intent(out) :: dphi (platd) ! latitude intervals (radians) - real(r8), intent(out) :: gw (plat) ! Gaussian weights - real(r8), intent(out) :: sinlam(plond,platd) ! sin(lam) model domain only - real(r8), intent(out) :: coslam(plond,platd) ! cos(lam) model domain only - real(r8), intent(out) :: lbasdy(4,2,platd) ! latitude derivative weights - real(r8), intent(out) :: lbasdz(4,2,plev) ! vertical (full levels) deriv weights - real(r8), intent(out) :: lbassd(4,2,plevp) ! vertical (half levels) deriv weights - real(r8), intent(out) :: lbasiy(4,2,platd) ! Lagrange cubic interp weights (lat.) - real(r8), intent(out) :: detam (plev) ! intervals between vertical full levs. - real(r8), intent(out) :: detai (plevp) ! intervals between vertical half levs. -! - integer, intent(out) :: kdpmpf(pmap) ! artificial full vertical grid indices - integer, intent(out) :: kdpmph(pmap) ! artificial half vertical grid indices -! - real(r8), intent(out) :: cwava(plat) ! weight applied to global integrals -! -!----------------------------------------------------------------------- -! -! pmap Dimension of artificial evenly spaced vertical grid arrays -! etamid Full-index hybrid-levels in vertical grid. -! etaint Half-index hybrid-levels from sig(1/2) = etaint(1) = 0. to -! sig(plev+1/2) = etaint(plevp) = 1. -! gravit Gravitational constant. -! dlam Length of increment in longitude grid. -! lam Longitude values in the extended grid. -! phi Latitude values in the extended grid. -! dphi Interval between latitudes in the extended grid -! gw Gauss weights for latitudes in the global grid. (These sum -! to 2.0.) -! sinlam Sine of longitudes in global grid (no extension points). -! coslam Cosine of longitudes in global grid (no extension points). -! lbasdy Weights for Lagrange cubic derivative estimates on the -! unequally spaced latitude grid -! lbasdz Weights for Lagrange cubic derivative estimates on the -! unequally spaced vertical grid (corresponding to model -! full levels). -! lbassd Weights for Lagrange cubic derivative estimates on the -! unequally spaced vertical grid (corresponding to model -! half levels). -! lbasiy Weights for Lagrange cubic interpolation on the -! unequally spaced latitude grid -! detam Increment between model mid-levels ("full" levels) -! detai Increment between model interfaces ("half" levels). -! kdpmpf Array of indicies of the model full levels which are mapped -! into an artificial evenly spaced vertical grid. Used to aid -! in search for vertical position of departure point -! kdpmph Array of indicies of the model half levels which are mapped -! into an artificial evenly spaced vertical grid. Used to aid -! in search for vertical position of departure point -! cwava 1./(plon*gravit) -! -!---------------------------Local variables----------------------------- -! - integer j ! index - integer k ! index -! - real(r8) etamln(plev) ! log(etamid) - real(r8) etailn(plevp) ! log(etaint) - real(r8) detamln(plev) ! dlog(etamid) - real(r8) detailn(plevp) ! dlog(etaint) -! -!----------------------------------------------------------------------- - if (single_column) then - - dlam(:)=0._r8 - lam(:,:)=0._r8 - phi(:)=0._r8 - dphi(:)=0._r8 - sinlam(:,:)=0._r8 - coslam(:,:)=0._r8 - detai(:)=0._r8 - kdpmpf(:)=0._r8 - kdpmph(:)=0._r8 - gw(:)=1._r8 - call basdz(plev ,etamid ,lbasdz ) - call basdz(plevp ,etaint ,lbassd ) - - else - ! - ! Initialize extended horizontal grid coordinates. - ! - call grdxy(dlam ,lam ,phi ,gw ,sinlam , & - coslam ) - ! - ! Basis functions for computing Lagrangian cubic derivatives - ! on unequally spaced latitude and vertical grids. - ! - call basdy(phi ,lbasdy ) - - call basdz(plev ,etamid ,lbasdz ) - call basdz(plevp ,etaint ,lbassd ) - - - ! - ! Basis functions for computing weights for Lagrangian cubic - ! interpolation on unequally spaced latitude grids. - ! - call basiy(phi ,lbasiy ) - ! - ! Compute interval lengths in latitudinal grid - ! - do j = 1,platd-1 - dphi(j) = phi(j+1) - phi(j) - end do - - endif -! -! Compute interval lengths in vertical grids. -! - do k = 1,plev - etamln(k) = log(etamid(k)) - end do - do k = 1,plevp - etailn(k) = log(etaint(k)) - end do - do k = 1,plev-1 - detam (k) = etamid(k+1) - etamid(k) - detamln(k) = etamln(k+1) - etamln(k) - end do - do k = 1,plev - detai (k) = etaint(k+1) - etaint(k) - detailn(k) = etailn(k+1) - etailn(k) - end do -! -! Build artificial evenly spaced vertical grid for use in determining -! vertical position of departure point. -! Build one grid for full model levels and one for half levels. -! - call vrtmap(plev ,pmap ,etamln ,detamln ,kdpmpf ) - call vrtmap(plevp ,pmap ,etailn ,detailn ,kdpmph ) -! -! Compute moisture integration constant -! -if (single_column) then - cwava = 1._r8 -else - do j=1,plat - cwava(j) = 1._r8/(plon*gravit) - end do -endif -! - return -end subroutine grdini - -! -!----------------------------------------------------------------------- -! - -subroutine grdxy(dlam ,lam ,phi ,w ,sinlam , & - coslam ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Define the "extended" grid used in the semi-Lagrangian transport -! scheme. The longitudes are equally spaced and the latitudes are -! Gaussian. The global grid is extended to include "wraparound" points -! on all sides. -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- - use gauaw_mod, only: gauaw -!------------------------------Parameters------------------------------- - integer, parameter :: istart = nxpt+1 ! index for first model long. - integer, parameter :: jstart = nxpt+jintmx+1 ! index for first model lat. - integer, parameter :: jstop = jstart-1+plat ! index for last model lat. -!----------------------------------------------------------------------- - -!------------------------------Arguments-------------------------------- - real(r8), intent(out) :: dlam(platd) ! longitudinal increment - real(r8), intent(out) :: lam (plond,platd) ! long. coords. in extended grid - real(r8), intent(out) :: phi (platd) ! lat. coords. in extended grid - real(r8), intent(out) :: w (plat) ! Gaussian weights - real(r8), intent(out) :: sinlam(plond,platd) ! sin(lam) - real(r8), intent(out) :: coslam(plond,platd) ! cos(lam) -! -! dlam Length of increment in longitude grid. -! lam Longitude values in the extended grid. -! phi Latitude values in the extended grid. -! w Gauss weights for latitudes in the global grid. (These sum -! to 2.0 like the ones in CCM1.) -! sinlam Sine of longitudes in global grid (no extension points). -! coslam Cosine of longitudes in global grid (no extension points). -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i,j,ig ! indices - integer nlond ! extended long dim - real(r8) lam0 ! lamda = 0 - real(r8) pi ! 3.14... - real(r8) wrk(platd) ! work space -!----------------------------------------------------------------------- -! - lam0 = 0.0_r8 - pi = 4._r8*atan(1._r8) -! -! Interval length in equally spaced longitude grid. -! - do j=1,platd - dlam(j) = 2._r8*pi/real(nlonex(j),r8) -! -! Longitude values on extended grid. -! - nlond = nlonex(j) + 1 + 2*nxpt - do i = 1,nlond - lam(i,j) = real(i-istart,r8)*dlam(j) + lam0 - end do - end do -! -! Compute Gauss latitudes and weights. On return; phi contains the -! sine of the latitudes starting closest to the north pole and going -! toward the south; w contains the corresponding Gauss weights. -! - call gauaw(phi ,w ,plat ) -! -! Reorder and compute latitude values. -! - do j = jstart,jstop - wrk(j) = asin( phi(jstop-j+1) ) - end do - phi(jstart:jstop) = wrk(jstart:jstop) -! -! North and south poles. -! - phi(jstart-1) = -pi/2.0_r8 - phi(jstop +1) = pi/2.0_r8 -! -! Extend Gauss latitudes below south pole so that the spacing above -! the pole is symmetric, and phi is decreasing, i.e., phi < -pi/2 -! - if( jstart > 2 )then - do j = 1,jstart-2 - phi(j) = -pi - phi(2*jstart-2-j) - end do - end if -! -! Analogously for Northern Hemisphere -! - if( platd > jstop+1 )then - do j = jstop+2,platd - phi(j) = pi - phi(2*jstop+2-j) - end do - end if -! -! Sine and cosine of longitude. -! - do j=1,platd - ig = 0 - do i = istart,nlonex(j)+nxpt - ig = ig + 1 - sinlam(ig,j) = sin( lam(i,j) ) - coslam(ig,j) = cos( lam(i,j) ) - end do - end do - - return -end subroutine grdxy - -! -!----------------------------------------------------------------------- -! - -subroutine sltb1(pmap ,jcen ,jgc ,dt ,ra , & - iterdp ,uxl ,uxr ,vxl ,vxr , & - wb ,fxl ,fxr ,lam ,phib , & - dphib ,sig ,sigh ,dsig ,dsigh , & - lbasdy ,lbasdz ,lbassd ,lbasiy ,kdpmpf , & - kdpmph ,lammp ,phimp ,sigmp ,fbout , & - adv_state ,nlon ,hadv ,nlonex ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Drive the slt algorithm on a given latitude slice in the extended -! data arrays using information from the entire latitudinal extent -! of the arrays. -! -! Method: -! Compute departure points and corresponding indices. -! Poleward of latitude phigs (radians), perform the computation in -! local geodesic coordinates. -! Equatorward of latitude phigs, perform the computation in global -! spherical coordinates -! -! Author: J. Olson -! -!----------------------------------------------------------------------- - -#include - -!------------------------------Parameters------------------------------- - real(r8), parameter :: phigs = 1.221730_r8 ! cut-off latitude: about 70 degrees -!----------------------------------------------------------------------- - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: nlon ! longitude dimension - integer , intent(in) :: nlonex(platd) ! extended longitude dimension - integer , intent(in) :: pmap ! artificial vert grid dim. - integer , intent(in) :: jcen ! index of lat slice(extend) - integer , intent(in) :: jgc ! index of lat slice (model) - real(r8), intent(in) :: dt ! time step (seconds) - real(r8), intent(in) :: ra ! 1./(radius of earth) - integer , intent(in) :: iterdp ! iteration count - real(r8), intent(in) :: uxl(plond,plev,beglatex:endlatex) ! left x-deriv of ub - real(r8), intent(in) :: uxr(plond,plev,beglatex:endlatex) ! right x-deriv of ub - real(r8), intent(in) :: vxl(plond,plev,beglatex:endlatex) ! left x-deriv of vb - real(r8), intent(in) :: vxr(plond,plev,beglatex:endlatex) ! right x-deriv of vb - real(r8), intent(in) :: wb(plon,plevp) ! eta-dot - real(r8), intent(in) :: fxl(plond,plev, pcnst,beglatex:endlatex) ! left fb x-deriv - real(r8), intent(in) :: fxr(plond,plev, pcnst,beglatex:endlatex) ! right fb x-deriv - real(r8), intent(in) :: lam (plond,platd) ! long. coord of model grid - real(r8), intent(in) :: phib (platd) ! lat. coord of model grid - real(r8), intent(in) :: dphib(platd) ! increment between lats. - real(r8), intent(in) :: sig (plev) ! vertical full levels - real(r8), intent(in) :: sigh (plevp) ! vertical half levels - real(r8), intent(in) :: dsig (plev) ! inc. between full levs - real(r8), intent(in) :: dsigh(plevp) ! inc. between half levs - real(r8), intent(in) :: lbasdy(4,2,platd) ! lat deriv weights - real(r8), intent(in) :: lbasdz(4,2,plev) ! vert full level deriv wts - real(r8), intent(in) :: lbassd(4,2,plevp) ! vert half level deriv wts - real(r8), intent(in) :: lbasiy(4,2,platd) ! lat interp wts(lagrng) - integer , intent(in) :: kdpmpf(pmap) ! artificial vert grid index - integer , intent(in) :: kdpmph(pmap) ! artificial vert grid index - real(r8), intent(inout) :: hadv (plon, plev, pcnst, beglat:endlat) ! horizontal advection tendency - real(r8), intent(inout) :: lammp(plon,plev) ! long coord of mid-point - real(r8), intent(inout) :: phimp(plon,plev) ! lat coord of mid-point - real(r8), intent(inout) :: sigmp(plon,plev) ! vert coord of mid-point - real(r8), intent(out) :: fbout(plon,plev,pcnst) ! advected constituents - type(advection_state), intent(in) :: adv_state ! Advection state -! -! pmap Dimension of kdpmpX arrays -! jcen Latitude index in extended grid corresponding to lat slice -! being forecasted. -! jgc Latitude index in model grid corresponding to lat slice -! being forecasted. -! dt Time interval that parameterizes the parcel trajectory. -! ra Reciprocal of radius of earth. -! iterdp Number of iterations used for departure point calculation. -! uxl x-derivatives of u at the left (west) edge of given interval -! vxl x-derivatives of v at the left (west) edge of given interval -! uxr x-derivatives of u at the right (east) edge of given interval -! vxr x-derivatives of v at the right (east) edge of given interval -! wb z-velocity component (eta-dot). -! fxl x-derivatives at the left edge of each interval containing -! the departure point. -! fxr x-derivatives at the right edge of each interval containing -! the departure point. -! lam Longitude values for the extended grid. -! phib Latitude values for the extended grid. -! dphib Interval between latitudes in the extended grid. -! sig Hybrid eta values at the "full-index" levels. -! sigh Half-index eta-levels including sigh(i,1) = eta(1/2) = 0.0 -! and sigh(i,plev+1) = eta(plev+1/2) = 1. Note that in general -! sigh(i,k) .lt. sig(i,k) where sig(i,k) is the hybrid value -! at the k_th full-index level. -! dsig Interval lengths in full-index hybrid level grid. -! dsigh Interval lengths in half-index hybrid level grid. -! lbasdy Weights for Lagrange cubic derivative estimates on the -! unequally spaced latitude grid. -! lbasdz Weights for Lagrange cubic derivative estimates on the -! unequally spaced vertical grid (full levels). -! lbassd Weights for Lagrange cubic derivative estimates on the -! unequally spaced vertical grid (half levels). -! lbasiy Weights for Lagrange cubic interpolation on the unequally -! spaced latitude grid. -! kdpmpf indices of artificial grid mapped into the full level grid -! kdpmph indices of artificial grid mapped into the half level grid -! lammp Longitude coordinates of the trajectory mid-points of the -! parcels that correspond to the global grid points contained -! in the latitude slice being forecasted. On entry lammp -! is an initial guess. -! phimp Latitude coordinates of the trajectory mid-points of the -! parcels that correspond to the global grid points contained -! in the latitude slice being forecasted. On entry phimp -! is an initial guess. -! sigmp Hybrid value at the trajectory midpoint for each gridpoint -! in a vertical slice from the global grid. On entry sigmp is -! an initial guess. -! fbout Extended array only one latitude of which, however, is filled -! with forecasted (transported) values. This routine must be -! called multiple times to fill the entire array. This is -! done to facilitate multi-tasking. -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer m ! constituent index - integer idp(plon,plev,4) ! zonal dep point index - integer jdp(plon,plev) ! meridional dep point index - integer kdp(plon,plev) ! vertical dep point index - real(r8) fhr(plon,plev,pcnst) ! horizontal interpolants - real(r8) lamdp(plon,plev) ! zonal departure pt. coord. - real(r8) phidp(plon,plev) ! meridional departure pt. coord. - real(r8) sigdp(plon,plev) ! vertical departure pt. coord. - real(r8) fhst(plon,plev,pcnst) ! derivative at top of interval - real(r8) fhsb(plon,plev,pcnst) ! derivative at bot of interval - real(r8) wst(plon,plevp) ! w derivative at top of interval - real(r8) wsb(plon,plevp) ! w derivative at bot of interval - real(r8) fint(plon,plev,ppdy,pcnst) ! work space - real(r8) fyb(plon,plev,pcnst) ! work space - real(r8) fyt(plon,plev,pcnst) ! work space - logical locgeo ! flag indicating coordinate sys - integer :: k,i ! indices (needed for SCAM) -!----------------------------------------------------------------------- - if (.not. single_column) then - -! -! Horizontal interpolation -! - locgeo = abs(phib(jcen))>=phigs -! - call sphdep(jcen ,jgc ,dt ,ra ,iterdp , & - locgeo ,adv_state%u3 ,uxl ,uxr ,lam , & - phib ,lbasiy ,lammp ,phimp ,lamdp , & - phidp ,idp ,jdp ,adv_state%v3, & - vxl ,vxr ,nlon ,nlonex ) -! -! Interpolate scalar fields to the departure points. -! - call hrintp(pcnst ,pcnst ,adv_state%qminus, fxl ,fxr , & - lam ,phib ,dphib ,lbasdy ,lamdp , & - phidp ,idp ,jdp ,jcen ,plimdr , & - fint ,fyb ,fyt ,fhr ,nlon , & - nlonex ) - - do m = 1,pcnst -!$OMP PARALLEL DO PRIVATE (K, I) - do k = 1,plev - do i = 1,nlon - hadv(i,k,m,jgc) = (fhr(i,k,m) - adv_state%qminus(i1-1+i,k,m,jcen))/dt - end do - end do - end do -else -! -! fill in fhr in leiu of horizontal interpolation -! - do m = 1,pcnst - do k = 1,plev - do i = 1,nlon - fhr(i,k,m) = adv_state%qminus(i1+i-1,k,m,jcen) - hadv(i,k,m,jgc) = 0._r8 - end do - end do - end do -endif -! -! Vertical interpolation. -! Compute vertical derivatives of vertical wind -! - call cubzdr(nlon ,plevp ,wb ,lbassd ,wst , & - wsb ) -! -! Compute departure points and corresponding indices. -! - call vrtdep(pmap ,dt ,iterdp ,wb ,wst , & - wsb ,sig ,sigh ,dsigh ,kdpmpf , & - kdpmph ,sigmp ,sigdp ,kdp ,nlon ) -! -! Vertical derivatives of scalar fields. -! Loop over constituents. -! - do m = 1,pcnst - call cubzdr(nlon ,plev ,fhr(:,:,m), lbasdz ,fhst(:,:,m), & - fhsb(:,:,m) ) - end do - if( plimdr )then - call limdz(fhr ,dsig ,fhst ,fhsb ,nlon ) - end if -! -! Vertical interpolation of scalar fields. -! - call herzin(plev ,pcnst ,fhr ,fhst ,fhsb , & - sig ,dsig ,sigdp ,kdp ,fbout , & - nlon ) - - return -end subroutine sltb1 - -! -!============================================================================================ -! - -subroutine vrtdep(pmap ,dt ,iterdp ,wb ,wst , & - wsb ,sig ,sigh ,dsigh ,kdpmpf , & - kdpmph ,sigmp ,sigdp ,kdp ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Compute vertical departure point and departure point index. -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- - integer , intent(in) :: nlon ! longitude dimension - integer , intent(in) :: pmap ! dimension of artificial vert grid - real(r8), intent(in) :: dt ! time step (seconds) - integer , intent(in) :: iterdp ! number of iterations - real(r8), intent(in) :: wb (plon,plevp) ! vertical velocity - real(r8), intent(in) :: wst(plon,plevp) ! z-derivative of wb at top of interval - real(r8), intent(in) :: wsb(plon,plevp) ! z-derivative of wb at bot of interval - real(r8), intent(in) :: sig (plev ) ! sigma values of model full levels - real(r8), intent(in) :: sigh (plevp) ! sigma values of model half levels - real(r8), intent(in) :: dsigh(plevp) ! increment between half levels - integer , intent(in) :: kdpmpf(pmap) ! artificial grid indices - integer , intent(in) :: kdpmph(pmap) ! artificial grid indices - real(r8), intent(inout) :: sigmp(plon,plev) ! vert coords of traj mid-points - real(r8), intent(out) :: sigdp(plon,plev) ! vert coords of traj departure points - integer , intent(out) :: kdp(plon,plev) ! vertical departure point indices -! -! pmap Dimension of kdpmap arrays -! dt Time interval that parameterizes the parcel trajectory. -! iterdp Number of iterations used for departure point calculation. -! wb Vertical velocity component (sigma dot). -! wst z-derivs at the top edge of each interval contained in wb -! wsb z-derivs at the bot edge of each interval contained in wb -! sig Sigma values at the full-index levels. -! sigh Half-index sigma levels including sigh(1) = sigma(1/2) = 0.0 -! sigh(plev+1) = sigma(plev+1/2) = 1.0 . Note that in general -! sigh(k) .lt. sig(k) where sig(k) is the sigma value at the -! k_th full-index level. -! dsigh Increment in half-index sigma levels. -! kdpmpf Array of indices of the model full levels which are mapped -! into an artificial evenly spaced vertical grid. Used to aid -! in search for vertical position of departure point -! kdpmph Array of indices of the model half levels which are mapped -! into an artificial evenly spaced vertical grid. Used to aid -! in search for vertical position of departure point -! sigmp Sigma value at the trajectory midpoint for each gridpoint -! in a vertical slice from the global grid. On entry sigmp is -! an initial guess. -! sigdp Sigma value at the trajectory endpoint for each gridpoint -! in a vertical slice from the global grid. -! kdp Vertical index for each gridpoint. This index points into a -! vertical slice array whose vertical grid is given by sig. -! E.g., sig(kdp(i,k)) .le. sigdp(i,k) .lt. sig(kdp(i,k)+1). -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i ! | - integer iter ! |-- indices - integer k ! | - real(r8) wmp(plon,plev) ! vert vel. at midpoint -!----------------------------------------------------------------------- -! -! Loop over departure point iterates. -! - do iter = 1,iterdp -! -! Compute midpoint indices in half-index sigma-level arrays (use kdp -! as temporary storage). -! - call kdpfnd(plevp ,pmap ,sigh ,sigmp ,kdpmph , & - kdp ,nlon ) -! -! Interpolate sigma dot field to trajectory midpoints using Hermite -! cubic interpolant. -! - call herzin(plevp ,1 ,wb ,wst ,wsb , & - sigh ,dsigh ,sigmp ,kdp ,wmp , & - nlon ) -! -! Update estimate of trajectory midpoint. -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k = 1,plev - do i = 1,nlon - sigmp(i,k) = sig(k) - .5_r8*dt*wmp(i,k) - end do - end do -! -! Restrict vertical midpoints to be between the top and bottom half- -! index sigma levels. -! - call vdplim(plevp ,sigh ,sigmp ,nlon) - end do -! -! Compute trajectory endpoints. -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k = 1,plev - do i = 1,nlon - sigdp(i,k) = sig(k) - dt*wmp(i,k) - end do - end do -! -! Restrict vertical departure points to be between the top and bottom -! full-index sigma levels. -! - call vdplim(plev ,sig ,sigdp ,nlon) -! -! Vertical indices for trajectory endpoints that point into full-index -! sigma level arrays. -! - call kdpfnd(plev ,pmap ,sig ,sigdp ,kdpmpf , & - kdp ,nlon ) -! - return -end subroutine vrtdep - -! -!============================================================================================ -! - -subroutine vdplim(pkdim ,sig ,sigdp ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Restrict vertical departure points to be between the top and bottom -! sigma levels of the "full-" or "half-" level grid -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -!---------------------- Arguments -------------------------------------- - integer , intent(in) :: nlon ! longitude dimension - integer , intent(in) :: pkdim ! vertical dimension - real(r8), intent(in) :: sig(pkdim) ! vertical coordinate of model grid - real(r8), intent(inout) :: sigdp(plon,plev) ! vertical coords. of departure points. -! pkdim Vertical dimension of "sig" -! sig Sigma values at the "full" or "half" model levels -! sigdp Sigma value at the trajectory endpoint or midpoint for each -! gridpoint in a vertical slice from the global grid. This -! routine restricts those departure points to within the -! model's vertical grid. -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i,k ! index -!----------------------------------------------------------------------- -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i = 1,nlon - if (sigdp(i,k) < sig(1)) then - sigdp(i,k) = sig(1) - end if - if (sigdp(i,k) >= sig(pkdim)) then - sigdp(i,k) = sig(pkdim)*(1._r8 - 10._r8*epsilon(sigdp)) - end if - end do - end do - - return -end subroutine vdplim - -! -!----------------------------------------------------------------------- -! - -subroutine sltini(dlam, sinlam, coslam, uxl, uxr, & - vxl, vxr, qxl, qxr, adv_state ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Prepare the extended arrays for use in the SLT routines -! -! 1) Fill latitude extensions. -! 2) Fill longitude extensions. -! 3) Compute x-derivatives -! -! Method: -! Computational note: The latitude loop in this routine is multitasked -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996 -! -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -#include -!---------------------------Local parameters---------------------------- -! - integer puvpts ! number of u/v pts in lat slice - integer pqpts ! number of constituent pts in lat slice -! - parameter(puvpts = plond*plev, pqpts = plond*plev*pcnst) -!----------------------------------------------------------------------- -! -! Input arguments -! - real(r8), intent(in) :: dlam(platd) ! increment in x-direction - real(r8), intent(in) :: sinlam(plond,platd) ! sin(lamda) - real(r8), intent(in) :: coslam(plond,platd) ! cos(lamda) - real(r8), intent(inout) :: uxl (plond,plev, beglatex:endlatex) - real(r8), intent(inout) :: uxr (plond,plev, beglatex:endlatex) - real(r8), intent(inout) :: vxl (plond,plev, beglatex:endlatex) - real(r8), intent(inout) :: vxr (plond,plev, beglatex:endlatex) - real(r8), intent(inout) :: qxl (plond,plev,pcnst,beglatex:endlatex) - real(r8), intent(inout) :: qxr (plond,plev,pcnst,beglatex:endlatex) - type(advection_state), intent(inout) :: adv_state ! Advection data state -! -! -!----------------------------------------------------------------------- -! -! dlam Length of increment in longitude grid. -! sinlam Sin of longitudes in global grid (model grid pts only). -! coslam Cos of longitudes in global grid (model grid pts only). -! uxl x-derivatives of u at the left (west) edge of given interval -! vxl x-derivatives of v at the left (west) edge of given interval -! uxr x-derivatives of u at the right (east) edge of given interval -! vxr x-derivatives of v at the right (east) edge of given interval -! qxl x-derivatives of scalar species at the left (west) edge -! of given interval -! qxr x-derivatives of scalar species at the right (east) edge -! of given interval -! -!---------------------------Local variables----------------------------- -! - integer m,j,k ! index - integer nlond -! -!------------------------------Externals-------------------------------- -! - external cubxdr,extx,extys,extyv,limdx -! -!----------------------------------------------------------------------- -! -! Fill latitude extensions beyond the southern- and northern-most -! latitudes in the global grid -! - call t_startf ('slt_single') - if (beglatex .le. endlatex) then - call extyv(1, plev, coslam, sinlam, adv_state%u3, adv_state%v3) - call extys(pcnst, plev ,adv_state%qminus, pcnst) -! -! Fill longitude extensions -! - call extx(1 ,plev ,adv_state%u3, 1) - call extx(1 ,plev ,adv_state%v3, 1) - call extx(pcnst, plev ,adv_state%qminus, pcnst) - endif - call t_stopf ('slt_single') -! -! Compute x-derivatives. -! -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE (J, NLOND, K, M) -#endif - do j = beglatex, endlatex - nlond = 1 + 2*nxpt + nlonex(j) -!$OMP PARALLEL DO PRIVATE (K, M) - do k=1,plev - call cubxdr (nlond, 2, nlond-3, dlam(j), adv_state%u3(1:nlond,k,j), & - uxl(1:nlond,k,j), uxr(1:nlond,k,j)) - call cubxdr (nlond, 2, nlond-3, dlam(j), adv_state%v3(1:nlond,k,j), & - vxl(1:nlond,k,j), vxr(1:nlond,k,j)) - do m=1,pcnst - call cubxdr (nlond, 2, nlond-3, dlam(j), adv_state%qminus(1:nlond,k,m,j), & - qxl(1:nlond,k,m,j), qxr(1:nlond,k,m,j)) - if( plimdr )then - call limdx (nlond, 2, nlond-3, dlam(j), adv_state%qminus(1:nlond,k,m,j), & - qxl(1:nlond,k,m,j), qxr(1:nlond,k,m,j)) - end if - end do - end do - end do - - return -end subroutine sltini - -! -!----------------------------------------------------------------------- -! - -end module scanslt diff --git a/src/dynamics/eul/scmforecast.F90 b/src/dynamics/eul/scmforecast.F90 deleted file mode 100644 index f9c0cbc6a8..0000000000 --- a/src/dynamics/eul/scmforecast.F90 +++ /dev/null @@ -1,562 +0,0 @@ -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. ! - ! ! - ! --------------------------------------------------------------------------- ! - use spmd_utils, only: masterproc - use cam_logfile, only: iulog - use cam_control_mod, only: adiabatic - - implicit none - private - save - - public forecast -! -! Private module data -! - -!======================================================================= -contains -!======================================================================= - - - subroutine forecast( lat , nlon , ztodt , & - psm1 , psm2 , ps , & - u3 , u3m1 , u3m2 , & - v3 , v3m1 , v3m2 , & - t3 , t3m1 , t3m2 , & - 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. ! - ! ! - ! Author : Sungsu Park. 2010. Sep. ! - ! ! - ! --------------------------------------------------------------------------- ! - - use shr_kind_mod, only : r8 => shr_kind_r8, i8 => shr_kind_i8 - use pmgrid, only : plev, plat, plevp, plon - use cam_history, only : outfld - use constituents, only : pcnst, cnst_get_ind, cnst_name - use physconst, only : rair, cpair, gravit, rga - use scammod, only : divq,divq3d,divt,divu,divt3d,divu3d,have_divv, & - divv,divv3d,have_aldif,have_aldir,have_asdif,have_asdir, & - have_cld,have_cldice,have_cldliq,have_clwp,have_divq,have_divq3d, & - have_divt,have_divt3d,have_divu,have_divu3d,have_divv3d,have_numice, & - have_numliq,have_omega,have_phis,have_prec,have_ps,have_ptend, & - have_q,have_q1,have_q2,have_t,have_u,have_v, & - have_vertdivq,have_vertdivt,have_vertdivu,have_vertdivv,qdiff,qobs, & - 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_use_obs_qv,scm_use_obs_t,scm_use_obs_uv,scm_zadv_q,scm_zadv_t, & - scm_zadv_uv,tdiff,tobs,uobs,use_3dfrc,use_camiop,vertdivq, & - vertdivt,vertdivu,vertdivv,vobs,wfld,qinitobs,scm_relax_fincl - use time_manager, only : get_curr_calday, get_nstep, get_step_size, is_first_step - use cam_abortutils, only : endrun - use string_utils, only: to_upper - - implicit none - - ! ---------------------- ! - ! Parameters ! - ! ---------------------- ! - - character(len=*), parameter :: subname = "forecast" - - ! --------------------------------------------------- ! - ! x = t, u, v, q ! - ! x3m1 : state variable used for computing 'forcing' ! - ! x3m2 : initial state variable before time-marching ! - ! x3 : final state variable after time-marching ! - ! --------------------------------------------------- ! - - 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 ] - real(r8), intent(in) :: psm1(plon) ! Surface pressure [ Pa ] - real(r8), intent(in) :: psm2(plon) ! Surface pressure [ Pa ] - - real(r8), intent(in) :: t3m1(plev) ! Temperature [ K ] - real(r8), intent(in) :: t3m2(plev) ! Temperature [ K ] - real(r8), intent(in) :: u3m1(plev) ! Zonal wind [ m/s ] - real(r8), intent(in) :: u3m2(plev) ! Zonal wind [ m/s ] - real(r8), intent(in) :: v3m1(plev) ! Meridional wind [ m/s ] - real(r8), intent(in) :: v3m2(plev) ! Meridional wind [ m/s ] - real(r8), intent(inout) :: q3m1(plev,pcnst) ! Tracers [ kg/kg, #/kg ] - real(r8), intent(inout) :: q3m2(plev,pcnst) ! Tracers [ kg/kg, #/kg ] - - real(r8), intent(inout) :: tten_phys(plev) ! Tendency of T by the 'physics' [ K/s ] - 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(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 ] - - - ! --------------- ! - ! Local Variables ! - ! --------------- ! - - integer dummy - integer dummy_dyndecomp - integer i, k, m - integer ixcldliq, ixcldice, ixnumliq, ixnumice - 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 ] - 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) qten_zadv_EULc(plev,pcnst) ! Vertical advective forcing of tracers [ #/kg/s, kg/kg/s ] - - ! --------------------------------- ! - ! SLT vertical advective tendencies ! - ! --------------------------------- ! - real(r8) qten_zadv_SLT(plev,pcnst) ! Vertical advective forcing of tracers [ #/kg/s, kg/kg/s ] - - ! ---------------------------- ! - ! Eulerian compression heating ! - ! ---------------------------- ! - - 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) qten_zadv(plev,pcnst) ! Vertical advective forcing of tracers [ #/kg/s, kg/kg/s ] - - ! --------------------------- ! - ! 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 - -!+++ BPM check what we have: - if (masterproc .and. is_first_step()) write(iulog,*) 'SCAM FORECAST REPORT: ' , & - 'have_divq ', have_divq , & - 'have_divt ', have_divt , & - 'have_divq3d ', have_divq3d , & - 'have_vertdivt ', have_vertdivt , & - 'have_vertdivu ', have_vertdivu , & - 'have_vertdivv ', have_vertdivv , & - 'have_vertdivq ', have_vertdivq , & - 'have_divt3d ', have_divt3d , & - 'have_divu3d ', have_divu3d , & - 'have_divv3d ', have_divv3d , & - 'have_divu ', have_divu , & - 'have_divv ', have_divv , & - 'have_omega ', have_omega , & - 'have_phis ', have_phis , & - 'have_ptend ', have_ptend , & - 'have_ps ', have_ps , & - 'have_q ', have_q , & - 'have_q1 ', have_q1 , & - 'have_q2 ', have_q2 , & - 'have_prec ', have_prec , & - 'have_t ', have_t , & - 'have_u ', have_u , & - 'have_v ', have_v , & - 'have_cld ', have_cld , & - 'have_cldliq ', have_cldliq , & - 'have_cldice ', have_cldice , & - 'have_numliq ', have_numliq , & - 'have_numice ', have_numice , & - 'have_clwp ', have_clwp , & - 'have_aldir ', have_aldir , & - 'have_aldif ', have_aldif , & - 'have_asdir ', have_asdir , & - 'have_asdif ', have_asdif , & - 'use_camiop ', use_camiop , & - 'use_obs_uv ', scm_use_obs_uv , & - 'use_obs_qv ', scm_use_obs_qv , & - 'use_obs_T ', scm_use_obs_T , & - 'relaxation ', scm_relaxation , & - 'use_3dfrc ', use_3dfrc - - !---BPM - - - ! ---------------------------- ! - ! ! - ! Main Computation Begins Here ! - ! ! - ! ---------------------------- ! - - dummy = 2 - dummy_dyndecomp = 1 - - - ! ------------------------------------------------------------ ! - ! Calculate midpoint pressure levels ! - ! ------------------------------------------------------------ ! - call plevs0( nlon, plon, plev, psm1, pintm1, pmidm1, pdelm1 ) - - call cnst_get_ind( 'CLDLIQ', ixcldliq, abort=.false. ) - call cnst_get_ind( 'CLDICE', ixcldice, abort=.false. ) - call cnst_get_ind( 'NUMLIQ', ixnumliq, abort=.false. ) - call cnst_get_ind( 'NUMICE', ixnumice, abort=.false. ) - - ! ------------------------------------------------------------ ! - ! Extract physical tendencies of tracers q. ! - ! Note 'tten_phys, uten_phys, vten_phys' are already input. ! - ! ------------------------------------------------------------ ! - - 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 - - ! ------------------------------------------------------- ! - ! use_camiop = .true. : Use CAM-generated 3D IOP file ! - ! = .false. : Use User-generated SCAM IOP file ! - ! ------------------------------------------------------- ! - - - if( use_camiop ) then - do k = 1, plev - tfcst(k) = t3m2(k) + ztodt * tten_phys(k) + ztodt * divt3d(k) - 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 - ! 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) ) - ! Below is the 'expanded' one. - qfcst(1,k,m) = qminus(1,k,m) + ztodt * divq3d(k,m) - enddo - enddo - - else - - ! ---------------------------------------------------------------------------- ! - ! 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. ! - ! ------------------------------------------------------------ ! - - do k = 1, plev - tten_comp_EUL(k) = wfld(k) * t3m1(k) * rair / ( cpair * pmidm1(k) ) - enddo - - ! ---------------------------------------------------------------------------- ! - ! 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) ) ) - 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) ) ) - end do - end do - - k = 1 - fac = 1._r8 / ( 2.0_r8 * pdelm1(k) ) - tten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( t3m1(k+1) - t3m1(k) ) ) - vten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( v3m1(k+1) - v3m1(k) ) ) - uten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( u3m1(k+1) - u3m1(k) ) ) - do m = 1, pcnst - qten_zadv_EULc(k,m) = -fac * ( wfldint(k+1) * ( q3m1(k+1,m) - q3m1(k,m) ) ) - end do - - k = plev - fac = 1._r8 / ( 2.0_r8 * pdelm1(k) ) - tten_zadv_EULc(k) = -fac * ( wfldint(k) * ( t3m1(k) - t3m1(k-1) ) ) - vten_zadv_EULc(k) = -fac * ( wfldint(k) * ( v3m1(k) - v3m1(k-1) ) ) - uten_zadv_EULc(k) = -fac * ( wfldint(k) * ( u3m1(k) - u3m1(k-1) ) ) - do m = 1, pcnst - qten_zadv_EULc(k,m) = -fac * ( wfldint(k) * ( q3m1(k,m) - q3m1(k-1,m) ) ) - end do - - ! ------------------------------------- ! - ! Manupulate individual forcings before ! - ! computing the final forecasted state ! - ! ------------------------------------- ! - - ! -------------------------------------------------------------- ! - ! Select the type of vertical advection : EULc,IOP,OFF supported! - ! -------------------------------------------------------------- ! - - select case (scm_zadv_T) - case ('iop') - if (have_vertdivt) then - tten_zadv(:plev) = vertdivt(:plev) - else - call endrun( subname//':: user set scm_zadv_tten to iop but vertdivt not on file') - end if - case ('eulc') - tten_zadv(:) = tten_zadv_EULc(:) + tten_comp_EUL(:) - case ('off') - tten_zadv(:) = 0._r8 - end select - - select case (scm_zadv_uv) - case ('iop') - if (have_vertdivu .and. have_vertdivv) then - uten_zadv(:) = vertdivu(:) - vten_zadv(:) = vertdivv(:) - else - call endrun( subname//':: user set scm_zadv_uv to iop but vertdivu/v not on file') - end if - case ('eulc') - uten_zadv(:) = uten_zadv_EULc(:) - vten_zadv(:) = vten_zadv_EULc(:) - case ('off') - uten_zadv(:) = 0._r8 - vten_zadv(:) = 0._r8 - end select - - select case (scm_zadv_q) - case ('iop') - if (have_vertdivq) then - qten_zadv(:plev,:pcnst) = vertdivq(:plev,:pcnst) - else - call endrun( subname//':: user set scm_zadv_qten to iop but vertdivq not on file') - end if - case ('eulc') - qten_zadv(:plev,:pcnst) = qten_zadv_EULc(:plev,:pcnst) - case ('slt') - qten_zadv = qten_zadv_SLT - case ('off') - qten_zadv = 0._r8 - end select - - ! -------------------------------------------------------------- ! - ! 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 - - ! ----------------------------------- ! - ! ! - ! 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 - 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 - if( .not. scm_use_obs_T .and. .not. have_divt) then - call endrun( subname//':: divt not on the dataset. Unable to forecast Temperature. Stopping') - end if - if( .not. scm_use_obs_qv .and. .not. have_divq) then - call endrun( subname//':: divq not on the dataset. Unable to forecast Humidity. Stopping') - end if - - do k = 1, plev - tfcst(k) = t3m2(k) + ztodt * ( tten_phys(k) + divt(k) + tten_zadv(k) ) - 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) ) - enddo - enddo - - ! ------------------ ! - ! Diagnostic Outputs ! - ! ------------------ ! - - call outfld( 'TTEN_XYADV' , divt, plon, dummy_dyndecomp ) - call outfld( 'UTEN_XYADV' , divu, plon, dummy_dyndecomp ) - call outfld( 'VTEN_XYADV' , divv, plon, dummy_dyndecomp ) - call outfld( 'QVTEN_XYADV', divq(:,1), plon, dummy_dyndecomp ) - if (.not.adiabatic) then - call outfld( 'QLTEN_XYADV', divq(:,ixcldliq), plon, dummy_dyndecomp ) - call outfld( 'QITEN_XYADV', divq(:,ixcldice), plon, dummy_dyndecomp ) - call outfld( 'NLTEN_XYADV', divq(:,ixnumliq), plon, dummy_dyndecomp ) - call outfld( 'NITEN_XYADV', divq(:,ixnumice), plon, dummy_dyndecomp ) - call outfld( 'QLTEN_ZADV' , qten_zadv(:,ixcldliq), plon, dummy_dyndecomp ) - call outfld( 'QITEN_ZADV' , qten_zadv(:,ixcldice), plon, dummy_dyndecomp ) - call outfld( 'NLTEN_ZADV' , qten_zadv(:,ixnumliq), plon, dummy_dyndecomp ) - call outfld( 'NITEN_ZADV' , qten_zadv(:,ixnumice), plon, dummy_dyndecomp ) - call outfld( 'QLTEN_PHYS' , qten_phys(:,ixcldliq), plon, dummy ) - call outfld( 'QITEN_PHYS' , qten_phys(:,ixcldice), plon, dummy ) - call outfld( 'NLTEN_PHYS' , qten_phys(:,ixnumliq), plon, dummy ) - call outfld( 'NITEN_PHYS' , qten_phys(:,ixnumice), plon, dummy ) - end if - call outfld( 'TTEN_ZADV' , tten_zadv, plon, dummy_dyndecomp ) - call outfld( 'UTEN_ZADV' , uten_zadv, plon, dummy_dyndecomp ) - call outfld( 'VTEN_ZADV' , vten_zadv, plon, dummy_dyndecomp ) - call outfld( 'QVTEN_ZADV' , qten_zadv(:,1), plon, dummy_dyndecomp ) - call outfld( 'TTEN_ZADV' , vertdivt, plon, dummy_dyndecomp ) - call outfld( 'QVTEN_ZADV' , vertdivq(:,1), plon, dummy_dyndecomp ) - - call outfld( 'TTEN_PHYS' , tten_phys, plon, dummy ) - call outfld( 'UTEN_PHYS' , uten_phys, plon, dummy ) - call outfld( 'VTEN_PHYS' , vten_phys, plon, dummy ) - call outfld( 'QVTEN_PHYS' , qten_phys(:,1), plon, dummy ) - - endif - - ! ---------------------------------------------------------------- ! - ! Used the SCAM-IOP-specified state instead of forecasted state ! - ! 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 - 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 - endif - - if( scm_use_obs_qv .and. have_q ) then - do k = 1, plev - qfcst(1,k,1) = qobs(k) - enddo - endif - - ! ------------------------------------------------------------------- ! - ! 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 - 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_relaxation.and.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 - - ! prepare scm_relax_fincl for comparison in scmforecast.F90 - 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( scm_relaxation ) then - if ( pmidm1(k).le.scm_relax_bot_p.and.pmidm1(k).ge.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 - 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 - 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(:).eq.'T')) & - tfcst(k) = tfcst(k) + relax_T(k) * ztodt - if (scm_fincl_empty .or.ANY(scm_relax_fincl(:).eq.'U')) & - ufcst(k) = ufcst(k) + relax_u(k) * ztodt - if (scm_fincl_empty .or. ANY(scm_relax_fincl(:).eq.'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 - qfcst(1,k,m) = qfcst(1,k,m) + relax_q(k,m) * ztodt - end if - enddo - end if - endif - enddo - 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 - end module scmforecast diff --git a/src/dynamics/eul/settau.F90 b/src/dynamics/eul/settau.F90 deleted file mode 100644 index 80ec456e00..0000000000 --- a/src/dynamics/eul/settau.F90 +++ /dev/null @@ -1,543 +0,0 @@ -subroutine settau(zdt) - -!----------------------------------------------------------------------- -! -! Purpose: -! Set time invariant hydrostatic matrices, which depend on the reference -! temperature and pressure in the semi-implicit time step. Note that -! this subroutine is actually called twice, because the effective time -! step changes between step 0 and step 1. -! -! Method: -! zdt = delta t for next semi-implicit time step. -! -! Author: CCM1 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - use pspect - use commap - use physconst, only: cappa, rair, gravit - use cam_abortutils, only: endrun - use spmd_utils, only: masterproc - use hycoef, only : hypi, hybi, hypd - use sgexx, only: dgeco, dgedi - use cam_logfile, only: iulog - - implicit none - - -!------------------------------Arguments-------------------------------- - real(r8), intent(in) :: zdt ! time step (or dt/2 at time 0) -!---------------------------Local workspace----------------------------- - real(r8) aq(plev,plev) - real(r8) rcond,z(plev),det(2),work(plev) - integer ipvt(plev) - real(r8) zcr(plev) ! gravity wave equivalent depth - real(r8) zci(plev) ! dummy, used to print phase speeds - real(r8) zdt2 ! zdt**2 - real(r8) factor ! intermediate workspace - real(r8) zdt0u ! vertical diff. of ref. temp (above) - real(r8) zshu ! interface "sigma" (above) - real(r8) zr2ds ! 1./(2.*hypd(k)) - real(r8) zdt0d ! vertical diff. of ref. temp (below) - real(r8) zshd ! interface "sigma" (below) - real(r8) ztd ! temporary accumulator - real(r8) zcn ! sq(n) - real(r8) zb(plev,plev) ! semi-implicit matrix in d equation - real(r8), save :: zdt_init=0 ! reinitialize if zdt <> zdt_init - - integer k,kk,kkk ! level indices - integer n ! n-wavenumber index - integer nneg ! number of unstable mean temperatures -!----------------------------------------------------------------------- -! - if (zdt == zdt_init) return - -! save dt for which this code has performed the initialization - zdt_init=zdt - - zdt2 = zdt*zdt -! -! Set mean temperature -! NOTE: Making t0 an actual function of height ***DOES NOT WORK*** -! - do k=1,plev - t0(k) = 300._r8 - end do -! -! Calculate hydrostatic matrix tau -! - zdt0u = 0._r8 - zshu = 0._r8 - do k=1,plev - zr2ds = 1._r8/(2._r8*hypd(k)) - if (k < plev) then - zdt0d = t0(k+1) - t0(k) - zshd = hybi(k+1) - else - zdt0d = 0._r8 - zshd = 0._r8 - end if - - factor = ((zdt0u*zshu + zdt0d*zshd) - (zdt0d + zdt0u))*zr2ds - do kk=1,k-1 - tau(kk,k) = factor*hypd(kk) + cappa*t0(k)*ecref(kk,k) - end do - - factor = (zdt0u*zshu + zdt0d*zshd - zdt0d)*zr2ds - tau(k,k) = factor*hypd(k) + cappa*t0(k)*ecref(k,k) - - factor = (zdt0u*zshu + zdt0d*zshd)*zr2ds - do kk=k+1,plev - tau(kk,k) = factor*hypd(kk) - end do - zdt0u = zdt0d - zshu = zshd - end do -! -! Vector for linear surface pressure term in divergence -! Pressure gradient and diagonal term of hydrostatic components -! - do k=1,plev - bps(k) = t0(k) - bps(k) = bps(k)*rair - end do - do k=1,plev - do kk=1,plev - ztd = bps(k) * hypd(kk)/hypi(plevp) - do kkk=1,plev - ztd = ztd + href(kkk,k)*tau(kk,kkk) - end do - zb(kk,k) = ztd - aq(kk,k) = ztd - end do - end do -! -! Compute and print gravity wave equivalent depths and phase speeds -! - call qreig(zb ,plev ,zcr ) - - do k=1,plev - zci(k) = sign(1._r8,zcr(k))*sqrt(abs(zcr(k))) - zcr(k) = zcr(k) / gravit - end do - - if (masterproc) then - write(iulog,910) (t0(k),k=1,plev) - write(iulog,920) (zci(k),k=1,plev) - write(iulog,930) (zcr(k),k=1,plev) - end if -! -! Test for unstable mean temperatures (negative phase speed and eqivalent -! depth) for at least one gravity wave. -! - nneg = 0 - do k=1,plev - if (zcr(k)<=0._r8) nneg = nneg + 1 - end do - - if (nneg/=0) then - call endrun ('SETTAU: UNSTABLE MEAN TEMPERATURE.') - end if -! -! Compute and invert matrix a(n)=(i+sq*b*delt**2) -! - do k=1,plev - do kk=1,plev - aq(kk,k) = aq(kk,k)*zdt2 - bm1(kk,k,1) = 0._r8 - end do - end do - do n=2,pnmax - zcn = sq(n) - do k=1,plev - do kk=1,plev - zb(kk,k) = zcn*aq(kk,k) - if(kk.eq.k) zb(kk,k) = zb(kk,k) + 1._r8 - end do - end do -! -! Use linpack routines to invert matrix -! - call dgeco(zb,plev,plev,ipvt,rcond,z) - call dgedi(zb,plev,plev,ipvt,det,work,01) - do k=1,plev - do kk=1,plev - bm1(kk,k,n) = zb(kk,k) - end do - end do - end do - -910 format(' REFERENCE TEMPERATURES FOR SEMI-IMPLICIT SCHEME = ', /(1x,12f9.3)) -920 format(' GRAVITY WAVE PHASE SPEEDS (M/S) FOR MEAN STATE = ' /(1x,12f9.3)) -930 format(' GRAVITY WAVE EQUIVALENT DEPTHS (M) FOR MEAN STATE = ' /(1x,12f9.3)) - - return -end subroutine settau - -!============================================================================================ - -subroutine qreig(a ,i ,b ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Create complex matrix P with real part = A and imaginary part = 0 -! Find its eigenvalues and return their real parts. -! -! Method: -! This routine is of unknown lineage. It is only used to provide the -! equivalent depths of the reference atmosphere for a diagnostic print -! in SETTAU and has no effect on the model simulation. Therefore it can -! be replaced at any time with a functionally equivalent, but more -! understandable, procedure. Consequently, the internal commenting has -! not been brought up to CAM standards. -! -! Author: -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - implicit none - -!------------------------------Arguments-------------------------------- - real(r8), intent(in) :: a(*) ! Input real part - integer , intent(in) :: i - real(r8), intent(out) :: b(*) -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - complex(r8) p(plev*plev) - complex(r8) q(plev*plev) - integer l,ij,ik ! indicies -!----------------------------------------------------------------------- -! -! l = 0 -! do ij=1,i -! do ik=1,i -! l = l + 1 -! p(l) = cmplx(a(l),0._r8,r8) -! end do -! end do - - do l = 1, i*i - p(l) = cmplx( a(l), 0.0_r8, r8) - end do - - call cmphes(p ,i ,1 ,i ) - call cmplr(p ,q ,i) - - do ij=1,i - b(ij) = real(q(ij),r8) - end do - - return -end subroutine qreig - -!============================================================================================ - -subroutine cmphes(ac ,nac ,k ,l ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Reduce complex matrix (ac) to upper Hessenburg matrix (ac) -! -! Method: -! This routine is of unknown lineage. It is only used to provide the -! equivalent depths of the reference atmosphere for a diagnostic print -! in SETTAU and has no effect on the model simulation. Therefore it can -! be replaced at any time with a functionally equivalent, but more -! understandable, procedure. Consequently, the internal commenting has -! not been brought up to CCM3 or CAM standards. -! -! Author: -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - -!------------------------------Arguments-------------------------------- - integer, intent(in) :: nac ! Dimension of one side of matrix ac - integer, intent(in) :: k,l ! - complex(r8), intent(inout) :: ac(nac,nac) ! On input, complex matrix to be converted - ! On output, upper Hessenburg matrix -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - complex(r8) x - complex(r8) y - integer la - integer m1 - integer i,m,j ! Indices - integer j1,i1 ! Loop limits -!----------------------------------------------------------------------- -! - la = l - 1 - m1 = k + 1 - do m=m1,la - i = m - x = (0.0_r8,0.0_r8) - do j=m,l - if (abs(ac(j,m-1))>abs(x)) then - x = ac(j,m-1) - i = j - end if - end do - if (i/=m) then - j1 = m - 1 - do j=j1,nac - y = ac(i,j) - ac(i,j) = ac(m,j) - ac(m,j) = y - end do - do j=1,l - y = ac(j,i) - ac(j,i) = ac(j,m) - ac(j,m) = y - end do - end if - if (x/=(0.0_r8,0.0_r8)) then - i1 = m + 1 - do i=i1,l - y = ac(i,m-1) - if (y/=(0.0_r8,0.0_r8)) then - y = y/x - ac(i,m-1) = y - do j=m,nac - ac(i,j) = ac(i,j) - y*ac(m,j) - end do - do j=1,l - ac(j,m) = ac(j,m) + y*ac(j,i) - end do - end if - end do - end if - end do - - return -end subroutine cmphes - -!============================================================================================ - -subroutine cmplr(hes ,w ,nc) - -!----------------------------------------------------------------------- -! -! Purpose: -! Compute w, eigenvalues of upper Hessenburg matrix hes -! -! Method: -! This routine is of unknown lineage. It is only used to provide the -! equivalent depths of the reference atmosphere for a diagnostic print -! in SETTAU and has no effect on the model simulation. Therefore it can -! be replaced at any time with a functionally equivalent, but more -! understandable, procedure. Consequently, the internal commenting has -! not been brought up to CCM3 or CAM standards. -! -! Author: -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - - implicit none - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: nc ! Dimension of input and output matrices - complex(r8), intent(inout) :: hes(nc,nc) ! Upper hessenberg matrix from comhes - complex(r8), intent(out):: w(nc) ! Weights -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer itest - integer nfail ! Limit for number of iterations to convergence - integer ntest - integer n,j,m - integer i ! Eigenvalue - integer its ! Iteration counter - integer l - integer l1,m1,n1,i1 - real(r8) a - real(r8) sr - real(r8) si - real(r8) tr - real(r8) ti - real(r8) xr - real(r8) yr - real(r8) zr - real(r8) xi - real(r8) yi - real(r8) areal - real(r8) eps - complex(r8) s - complex(r8) t - complex(r8) x - complex(r8) y - complex(r8) z - complex(r8) u - - data itest/0/ - save a,eps,sr,itest -!----------------------------------------------------------------------- -! - nfail = 30 - if (itest==0) then - a = 1 -5 continue - eps = a - sr = 1 + a - a = a/2.0_r8 - if (sr/=1.0_r8) go to 5 - itest = 1 - end if - if (nc.le.0) then - write(iulog,*)'CMPLR: Entered with incorrect dimension ' - write(iulog,*)'NC=',NC - call endrun - end if - ntest = 10 - n = nc - t = 0.0_r8 -10 continue - if (n==0) go to 300 - its = 0 -20 continue - if (n/=1) then - do l1=2,n - l = n + 2 - l1 - if (abs(hes(l,l-1)) <= eps*(abs(hes(l-1,l-1))+abs(hes(l,l)))) go to 50 - end do - end if - l = 1 -50 continue - if (l/=n) then - if (its==nfail) then - i = nc - n + 1 - write(iulog,*)'CMPLR: Failed to converge in ',nfail,' iterations' - write(iulog,*)'Eigenvalue=',i - call endrun - end if - if (its==ntest) then - ntest = ntest + 10 - sr = hes(n,n-1) - si = hes(n-1,n-2) - sr = abs(sr)+abs(si) - u = (0.0_r8,-1.0_r8)*hes(n,n-1) - tr = u - u = (0.0_r8,-1.0_r8)*hes(n-1,n-2) - ti = u - tr = abs(tr) + abs(ti) - s = cmplx(sr,tr) - else - s = hes(n,n) - x = hes(n-1,n)*hes(n,n-1) - if (abs(x)/=0.0_r8) then - y = 0.5_r8*(hes(n-1,n-1)-s) - u = y*y + x - z = sqrt(u) - u = conjg(z)*y - areal = u - if (areal<0.0_r8) z = -z - x = x/(y+z) - s = s - x - end if - end if - do i=1,n - hes(i,i) = hes(i,i) - s - end do - t = t + s - its = its + 1 - j = l + 1 - xr = abs(hes(n-1,n-1)) - yr = abs(hes(n,n-1)) - zr = abs(hes(n,n)) - n1 = n - 1 - if ((n1/=1).and.(n1>=j)) then - do m1=j,n1 - m = n1 + j - m1 - yi = yr - yr = abs(hes(m,m-1)) - xi = zr - zr = xr - xr = abs(hes(m-1,m-1)) - if (yr.le.eps*zr/yi*(zr+xr+xi)) go to 100 - end do - end if - m = l -100 continue - m1 = m + 1 - do i=m1,n - x = hes(i-1,i-1) - y = hes(i,i-1) - if (abs(x)0.0_r8) then - do i=l,j - z = hes(i,j-1) - hes(i,j-1) = hes(i,j) - hes(i,j) = z - end do - end if - do i=l,j - hes(i,j-1) = hes(i,j-1) + x*hes(i,j) - end do - end do - go to 20 - end if - w(n) = hes(n,n) + t - n = n - 1 - go to 10 -300 continue - - return -end subroutine cmplr - diff --git a/src/dynamics/eul/spegrd.F90 b/src/dynamics/eul/spegrd.F90 deleted file mode 100644 index 0c89afa941..0000000000 --- a/src/dynamics/eul/spegrd.F90 +++ /dev/null @@ -1,512 +0,0 @@ - -!----------------------------------------------------------------------- -! -! Purpose: -! Transfrom variables from spherical harmonic coefficients -! to grid point values during second gaussian latitude scan (scan2) -! -! Method: -! Assemble northern and southern hemisphere grid values from the -! symmetric and antisymmetric fourier coefficients. -! 1. Determine the fourier coefficients for the northern or southern -! hemisphere latitude. -! 2. Transform to gridpoint values -! 3. Clean up -! -! Author: -! Original version: J. Rosinski -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, J. Hack, August 1992 -! Reviewed: B. Boville, April 1996 -! Modified: P. Worley, September 2002 -! -!----------------------------------------------------------------------- -! - -subroutine spegrd_bft (lat ,nlon_fft, & - grdps ,grzs ,grds ,gruhs ,grvhs , & - grths ,grpss ,grus ,grvs ,grts , & - grpls ,grpms ,grdpa ,grza ,grda , & - gruha ,grvha ,grtha ,grpsa ,grua , & - grva ,grta ,grpla ,grpma ,fftbuf ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Preparation for transform of variables from spherical harmonic -! coefficients to grid point values during second gaussian latitude scan -! (scan2) -! -! Original version: J. Rosinski -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, J. Hack, August 1992 -! Reviewed: B. Boville, April 1996 -! Modified: P. Worley, September 2002 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plevp - use spmd_utils, only: iam - use comspe, only: maxm, numm -!----------------------------------------------------------------------- - implicit none -!--------------------------------------------------------------------- -! -! Arguments -! - integer, intent(in) :: lat ! latitude index - integer, intent(in) :: nlon_fft ! first dimension of FFT work array -! -! Symmetric fourier coefficient arrays for all variables transformed -! from spherical harmonics (see grcalc) -! - real(r8), intent(in) :: grdps(2*maxm) ! sum(n) of K(4)*(n(n+1)/a**2)**2*2dt*lnps(n,m)*P(n,m) - real(r8), intent(in) :: grzs(2*maxm,plev) ! sum(n) of z(n,m)*P(n,m) - real(r8), intent(in) :: grds(2*maxm,plev) ! sum(n) of d(n,m)*P(n,m) - real(r8), intent(in) :: gruhs(2*maxm,plev) ! sum(n) of K(2i)*z(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(in) :: grvhs(2*maxm,plev) ! sum(n) of K(2i)*d(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(in) :: grths(2*maxm,plev) ! sum(n) of K(2i)*t(n,m)*P(n,m) - real(r8), intent(in) :: grpss(2*maxm) ! sum(n) of lnps(n,m)*P(n,m) - real(r8), intent(in) :: grus(2*maxm,plev) ! sum(n) of z(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(in) :: grvs(2*maxm,plev) ! sum(n) of d(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(in) :: grts(2*maxm,plev) ! sum(n) of t(n,m)*P(n,m) - real(r8), intent(in) :: grpls(2*maxm) ! sum(n) of lnps(n,m)*P(n,m)*m/a - real(r8), intent(in) :: grpms(2*maxm) ! sum(n) of lnps(n,m)*H(n,m) -! -! Antisymmetric fourier coefficient arrays for all variables transformed -! from spherical harmonics (see grcalc) -! - real(r8), intent(in) :: grdpa(2*maxm) ! sum(n) of K(4)*(n(n+1)/a**2)**2*2dt*lnps(n,m)*P(n,m) - real(r8), intent(in) :: grza(2*maxm,plev) ! sum(n) of z(n,m)*P(n,m) - real(r8), intent(in) :: grda(2*maxm,plev) ! sum(n) of d(n,m)*P(n,m) - real(r8), intent(in) :: gruha(2*maxm,plev) ! sum(n)K(2i)*z(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(in) :: grvha(2*maxm,plev) ! sum(n)K(2i)*d(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(in) :: grtha(2*maxm,plev) ! sum(n) of K(2i)*t(n,m)*P(n,m) - real(r8), intent(in) :: grpsa(2*maxm) ! sum(n) of lnps(n,m)*P(n,m) - real(r8), intent(in) :: grua(2*maxm,plev) ! sum(n) of z(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(in) :: grva(2*maxm,plev) ! sum(n) of d(n,m)*H(n,m)*a/(n(n+1)) - real(r8), intent(in) :: grta(2*maxm,plev) ! sum(n) of t(n,m)*P(n,m) - real(r8), intent(in) :: grpla(2*maxm) ! sum(n) of lnps(n,m)*P(n,m)*m/a - real(r8), intent(in) :: grpma(2*maxm) ! sum(n) of lnps(n,m)*H(n,m) - - real(r8), intent(out) :: fftbuf(nlon_fft,8,plevp) ! buffer used for in-place FFTs - -! -!---------------------------Local workspace----------------------------- -! - integer i,k ! longitude, level indices - integer rmlength ! twice number of local wavenumbers - integer, parameter :: vortdex = 1 ! indices into fftbuf - integer, parameter :: divdex = 2 - integer, parameter :: duhdex = 3 - integer, parameter :: dvhdex = 4 - integer, parameter :: dthdex = 5 - integer, parameter :: u3dex = 6 - integer, parameter :: v3dex = 7 - integer, parameter :: t3dex = 8 - integer, parameter :: dpsdex = 1 - integer, parameter :: psdex = 2 - integer, parameter :: dpsldex = 3 - integer, parameter :: dpsmdex = 4 -! -!----------------------------------------------------------------------- -! -! Assemble northern and southern hemisphere grid values from the -! symmetric and antisymmetric fourier coefficients: pre-FFT -! - rmlength = 2*numm(iam) - if (lat > plat/2) then ! Northern hemisphere - do k=1,plev - do i=1,rmlength - fftbuf(i,vortdex,k) = grzs(i,k) + grza(i,k) - fftbuf(i,divdex,k) = grds(i,k) + grda(i,k) - fftbuf(i,duhdex,k) = gruhs(i,k) + gruha(i,k) - fftbuf(i,dvhdex,k) = grvhs(i,k) + grvha(i,k) - fftbuf(i,dthdex,k) = grths(i,k) + grtha(i,k) - fftbuf(i,u3dex,k) = grus(i,k) + grua(i,k) - fftbuf(i,v3dex,k) = grvs(i,k) + grva(i,k) - fftbuf(i,t3dex,k) = grts(i,k) + grta(i,k) - end do - end do -! - do i=1,rmlength - fftbuf(i,dpsdex,plevp) = grdps(i) + grdpa(i) - fftbuf(i,psdex,plevp) = grpss(i) + grpsa(i) - fftbuf(i,dpsldex,plevp) = grpls(i) + grpla(i) - fftbuf(i,dpsmdex,plevp) = grpms(i) + grpma(i) - end do - - else ! Southern hemisphere - - do k=1,plev - do i=1,rmlength - fftbuf(i,vortdex,k) = grzs(i,k) - grza(i,k) - fftbuf(i,divdex,k) = grds(i,k) - grda(i,k) - fftbuf(i,duhdex,k) = gruhs(i,k) - gruha(i,k) - fftbuf(i,dvhdex,k) = grvhs(i,k) - grvha(i,k) - fftbuf(i,dthdex,k) = grths(i,k) - grtha(i,k) - fftbuf(i,u3dex,k) = grus(i,k) - grua(i,k) - fftbuf(i,v3dex,k) = grvs(i,k) - grva(i,k) - fftbuf(i,t3dex,k) = grts(i,k) - grta(i,k) - end do - end do - - do i=1,rmlength - fftbuf(i,dpsdex,plevp) = grdps(i) - grdpa(i) - fftbuf(i,psdex,plevp) = grpss(i) - grpsa(i) - fftbuf(i,dpsldex,plevp) = grpls(i) - grpla(i) - fftbuf(i,dpsmdex,plevp) = grpms(i) - grpma(i) - end do - - end if - - return -end subroutine spegrd_bft - -subroutine spegrd_ift (nlon_fft_in, nlon_fft_out, fftbuf_in, fftbuf_out) - -!----------------------------------------------------------------------- -! -! Purpose: -! Inverse Fourier transform of variables from spherical harmonic -! coefficients to grid point values during second gaussian latitude scan -! (scan2) -! -! Author: P. Worley, September 2002 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plat, plevp, beglat, endlat, plev - use comspe, only: maxm - use pspect, only: pmmax -#if ( defined SPMD ) - use mpishorthand -#endif - use eul_control_mod, only : trig, ifax, pcray - use perf_mod -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- - -!--------------------------------------------------------------------- -! -! Arguments -! -! -! Input arguments -! - integer, intent(in) :: nlon_fft_in ! first dimension of first FFT work array - integer, intent(in) :: nlon_fft_out ! first dimension of second FFT work array -#if (defined SPMD) - real(r8), intent(in) :: fftbuf_in(nlon_fft_in,8,plevp,plat) - ! buffer containing fields dcomposed over wavenumbers -#else - real(r8), intent(in) :: fftbuf_in(1,1,1,1) - ! buffer unused -#endif -! -! Input/Output arguments -! - real(r8), intent(inout) :: fftbuf_out(nlon_fft_out,8,plevp,beglat:endlat) - ! buffer used for in-place FFTs -! -!---------------------------Local workspace----------------------------- -! -#if ( ! defined USEFFTLIB ) - real(r8) work((plon+1)*8*plevp) -#else - real(r8) work((plon+1)*pcray) ! workspace needed by fft991 -#endif - integer lat ! latitude index - integer isign ! +1 => transform spectral to grid - integer ntr ! number of transforms to perform - integer inc ! distance between transform elements - integer begtrm ! (real) location of first truncated wavenumber - integer k, ifld ! level and field indices -! -!----------------------------------------------------------------------- -! -! -#if ( defined SPMD ) -! -! reorder Fourier coefficients -! - call t_barrierf ('sync_realloc4b', mpicom) - call t_startf('realloc4b') - call realloc4b(nlon_fft_in, nlon_fft_out, fftbuf_in, fftbuf_out) - call t_stopf('realloc4b') -#endif -! -! Zero elements corresponding to truncated wavenumbers, then -! transform from fourier coefficients to gridpoint values. -! ps,vort,div,duh,dvh,dth,dpsl,dpsm,dps, -! u,v,t (SLT) [If you want to do spectral transport, do q as well] -! - begtrm = 2*pmmax+1 - inc = 1 - isign = +1 -#ifdef OUTER_OMP -!$OMP PARALLEL DO PRIVATE (LAT, NTR, K, IFLD, WORK) -#endif - do lat=beglat,endlat - ntr = 8 -!$OMP PARALLEL DO PRIVATE (K, WORK) - do k=1,plev - fftbuf_out(begtrm:nlon_fft_out,:,k,lat) = 0.0_r8 - call fft991 (fftbuf_out(1,1,k,lat), work, trig(1,lat), ifax(1,lat), inc, & - nlon_fft_out, plon, ntr, isign) - enddo - ntr = 1 -!$OMP PARALLEL DO PRIVATE (IFLD, WORK) - do ifld=1,4 - fftbuf_out(begtrm:nlon_fft_out,ifld,plevp,lat) = 0.0_r8 - call fft991 (fftbuf_out(1,ifld,plevp,lat), work, trig(1,lat), ifax(1,lat), inc, & - nlon_fft_out, plon, ntr, isign) - enddo - enddo -! - return -end subroutine spegrd_ift - -subroutine spegrd_aft (ztodt ,lat ,nlon ,nlon_fft, & - cwava ,qfcst , & - etamid ,ps ,u3 ,v3 ,t3 , & - qminus ,vort ,div ,hw2al ,hw2bl , & - hw3al ,hw3bl ,hwxal ,hwxbl ,q3m1 , & - dps ,dpsl ,dpsm ,t3m2 ,engy2alat, & - engy2blat,difftalat, difftblat,phis,fftbuf ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Completion of transformation of variables from spherical harmonic -! coefficients to grid point values during second gaussian latitude scan -! (scan2) -! -! Method: -! -! Original version: J. Rosinski -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, J. Hack, August 1992 -! Reviewed: B. Boville, April 1996 -! Modified: P. Worley, September 2002 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plat, plev, plevp - use pspect - use commap - use cam_history, only: outfld - use physconst, only: rga - use constituents, only: pcnst - use eul_control_mod - use hycoef, only: nprlev -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -! -! Arguments -! - integer, intent(in) :: lat ! latitude index - integer, intent(in) :: nlon ! number of longitudes - integer, intent(in) :: nlon_fft ! first dimension of FFT work arrays - - real(r8), intent(in) :: ztodt ! twice the timestep unles nstep=0 - real(r8), intent(in) :: cwava ! normalization factor (1/g*plon) - real(r8), intent(in) :: qfcst(plon,plev,pcnst) - real(r8), intent(in) :: qminus(plon,plev,pcnst) - real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints - - real(r8), intent(inout) :: ps(plon) - real(r8), intent(inout) :: u3(plon,plev) - real(r8), intent(inout) :: v3(plon,plev) - real(r8), intent(inout) :: t3(plon,plev) - real(r8), intent(inout) :: vort(plon,plev) - real(r8), intent(inout) :: div(plon,plev) - real(r8), intent(inout) :: q3m1(plon,plev,pcnst) - - real(r8), intent(out) :: hw2al(pcnst) ! - - real(r8), intent(out) :: hw2bl(pcnst) ! | lat contributions to components - real(r8), intent(out) :: hw3al(pcnst) ! | of slt global mass integrals - real(r8), intent(out) :: hw3bl(pcnst) ! - - real(r8), intent(out) :: hwxal(pcnst,4) - real(r8), intent(out) :: hwxbl(pcnst,4) - - real(r8), intent(out) :: dps(plon) - real(r8), intent(out) :: dpsl(plon) - real(r8), intent(out) :: dpsm(plon) - real(r8), intent(in) :: t3m2(plon,plev) ! temperature - real(r8), intent(out) :: engy2alat - real(r8), intent(out) :: engy2blat - real(r8), intent(out) :: difftalat - real(r8), intent(out) :: difftblat - real(r8), intent(in) :: phis(plon) - real(r8), intent(in) :: fftbuf(nlon_fft,8,plevp) ! buffer used for in-place FFTs -! -!---------------------------Local workspace----------------------------- -! - real(r8) :: duh(plon,plev) ! - real(r8) :: dvh(plon,plev) ! - real(r8) :: dth(plon,plev) ! - real(r8) :: ps_tmp(plon) - - real(r8) pmid(plon,plev) ! pressure at model levels - real(r8) pint(plon,plevp) ! pressure at model interfaces - real(r8) pdel(plon,plev) ! pdel(k) = pint(k+1) - pint(k) - real(r8) pdelb(plon,plev) ! pressure diff bet intfcs (press defined using the "B" part - ! of the hybrid grid only) - real(r8) hcwavaw ! 0.5*cwava*w(lat) - real(r8) sum -! - real(r8) rcoslat ! 1./cosine(latitude) - real(r8) dotproda ! dot product - real(r8) dotprodb ! dot product - integer i,k,m ! longitude, level, constituent indices - integer klev ! top level where hybrid coordinates apply - integer, parameter :: vortdex = 1 ! indices into fftbuf - integer, parameter :: divdex = 2 - integer, parameter :: duhdex = 3 - integer, parameter :: dvhdex = 4 - integer, parameter :: dthdex = 5 - integer, parameter :: u3dex = 6 - integer, parameter :: v3dex = 7 - integer, parameter :: t3dex = 8 - integer, parameter :: dpsdex = 1 - integer, parameter :: psdex = 2 - integer, parameter :: dpsldex = 3 - integer, parameter :: dpsmdex = 4 -! -!----------------------------------------------------------------------- -! -! Copy 3D fields out of FFT buffer, removing cosine(latitude) from momentum variables -! - rcoslat = 1._r8/cos(clat(lat)) -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i=1,nlon - vort(i,k) = fftbuf(i,vortdex,k) - div(i,k) = fftbuf(i,divdex,k) - duh(i,k) = fftbuf(i,duhdex,k)*rcoslat - dvh(i,k) = fftbuf(i,dvhdex,k)*rcoslat - dth(i,k) = fftbuf(i,dthdex,k) - u3(i,k) = fftbuf(i,u3dex,k)*rcoslat - v3(i,k) = fftbuf(i,v3dex,k)*rcoslat - t3(i,k) = fftbuf(i,t3dex,k) - end do - end do -! -! Copy 2D fields out of FFT buffer, converting -! log(ps) to ps. -! -!$OMP PARALLEL DO PRIVATE (I) - do i=1,nlon - dps(i) = fftbuf(i,dpsdex,plevp) - dpsl(i) = fftbuf(i,dpsldex,plevp) - dpsm(i) = fftbuf(i,dpsmdex,plevp) - ps(i) = exp(fftbuf(i,psdex,plevp)) - end do - -! -! Diagnose pressure arrays needed by DIFCOR -! - call plevs0 (nlon, plon, plev, ps, pint, pmid, pdel) - call pdelb0 (ps, pdelb, nlon) -! -! Accumulate mass integrals -! - sum = 0._r8 - do i=1,nlon - sum = sum + ps(i) - end do - tmass(lat) = w(lat)*rga*sum/nlon -! -! Finish horizontal diffusion: add pressure surface correction term to t and -! q diffusions; add kinetic energy dissipation to internal energy (temperature) -! - klev = max(kmnhdn,nprlev) - call difcor (klev, ztodt, dps, u3, v3, & - q3m1(1,1,1), pdel, pint, t3, dth, & - duh, dvh, nlon) -! -! Calculate SLT moisture, constituent, energy, and temperature integrals -! - hcwavaw = 0.5_r8*cwava*w(lat) - engy2alat = 0._r8 - engy2blat = 0._r8 - difftalat = 0._r8 - difftblat = 0._r8 -!$OMP PARALLEL DO PRIVATE (M, K, DOTPRODA, DOTPRODB, I) - do m=1,pcnst - hw2al(m) = 0._r8 - hw2bl(m) = 0._r8 - hw3al(m) = 0._r8 - hw3bl(m) = 0._r8 - hwxal(m,1) = 0._r8 - hwxal(m,2) = 0._r8 - hwxal(m,3) = 0._r8 - hwxal(m,4) = 0._r8 - hwxbl(m,1) = 0._r8 - hwxbl(m,2) = 0._r8 - hwxbl(m,3) = 0._r8 - hwxbl(m,4) = 0._r8 - do k=1,plev - dotproda = 0._r8 - dotprodb = 0._r8 - do i=1,nlon - dotproda = dotproda + qfcst(i,k,m)*pdela(i,k) - dotprodb = dotprodb + qfcst(i,k,m)*pdelb(i,k) - end do - hw2al(m) = hw2al(m) + hcwavaw*dotproda - hw2bl(m) = hw2bl(m) + hcwavaw*dotprodb - end do - end do - - do i=1,nlon - ps_tmp(i) = 0._r8 - end do - -! using do loop and select to enable functional parallelism with OpenMP -!$OMP PARALLEL DO PRIVATE (I) - do i=1,6 - select case (i) - case (1) - call engy_te (cwava ,w(lat) ,t3 ,u3 ,v3 ,phis ,pdela, ps_tmp, engy2alat ,nlon) - case (2) - call engy_te (cwava ,w(lat) ,t3 ,u3 ,v3 ,phis ,pdelb, ps , engy2blat ,nlon) - case (3) - call engy_tdif(cwava ,w(lat) ,t3 ,t3m2 ,pdela, difftalat ,nlon) - case (4) - call engy_tdif(cwava ,w(lat) ,t3 ,t3m2 ,pdelb, difftblat ,nlon) - case (5) - call qmassd (cwava, etamid, w(lat), qminus, qfcst, & - pdela, hw3al, nlon) - case (6) - call qmassd (cwava, etamid, w(lat), qminus, qfcst, & - pdelb, hw3bl, nlon) - end select - end do - - if (pcnst.gt.1) then - call xqmass (cwava, etamid, w(lat), qminus, qfcst, & - qminus, qfcst, pdela, pdelb, hwxal, & - hwxbl, nlon) - end if - - call outfld ('DTH ',dth ,plon ,lat ) - - return -end subroutine spegrd_aft - - diff --git a/src/dynamics/eul/spetru.F90 b/src/dynamics/eul/spetru.F90 deleted file mode 100644 index abd8c40619..0000000000 --- a/src/dynamics/eul/spetru.F90 +++ /dev/null @@ -1,1287 +0,0 @@ - -module spetru - -!----------------------------------------------------------------------- -! -! Purpose: Spectrally truncate initial data fields. -! -! Method: Truncate one or a few fields at a time, to minimize the -! memory requirements -! -! Original version: J. Rosinski -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, J. Hack, August 1992 -! Modified to implement processing of subsets of fields: P. Worley, May 2003 -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev, plat - use pspect, only: psp, pspt, ptrn, pmmax - use comspe, only: alp, nlen, nstart, dalp - use commap, only: w, xm - use physconst, only: rearth, ra - use eul_control_mod, only: trig, ifax, pcray - implicit none -! -! By default make data and interfaces to this module private -! - private - -! -! Public interfaces -! - public spetru_phis ! Spectrally truncate PHIS - public spetru_ps ! Spectrally truncate PS - public spetru_3d_scalar ! Spectrally truncate 3D scalar fields - public spetru_uv ! Spectrally truncate winds (U and V) -! -! Private module data -! - integer, parameter :: plondfft = plon + 2 ! Size of longitude needed for FFT's - -! -!======================================================================= -contains - -!************************************************************************ -subroutine spetru_phis (phis, phis_hires, phisl, phism, phi_out) - -!----------------------------------------------------------------------- -! -! Purpose: -! -! Method: -! Spectrally truncate PHIS input field. -! -! Author: -! Original version: J. Rosinski -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, J. Hack, August 1992 -! Modified: P. Worley, May 2003 -! Modified: J. Olson, Apr 2004 -! -!----------------------------------------------------------------------- - - use pmgrid, only: plon, plat - -! -! Input/Output arguments -! - real(r8), intent(inout) :: phis(plon,plat) ! Fourier -> spec. coeffs. for sfc geo. - logical, intent(in) :: phis_hires ! true => PHIS came from hi res topo file - real(r8), intent(out), optional :: phisl(plon,plat) ! Spectrally trunc d(phis)/d(longitude) - real(r8), intent(out), optional :: phism(plon,plat) ! Spectrally trunc d(phis)/d(latitude) - real(r8), intent(out), optional :: phi_out(2,psp/2) ! used in spectral truncation of phis -! -!---------------------------Local workspace----------------------------- -! - real(r8), pointer :: phis_tmp(:,:) ! Temporary to compute Phis of size needed for FFT - real(r8), pointer :: phisl_tmp(:,:) ! Temporary to compute phisl of size needed for FFT - real(r8), pointer :: phism_tmp(:,:) ! Temporary to compute phism of size needed for FFT - real(r8) tmp1 ! vector temporary - real(r8) tmp2 ! vector temporary - real(r8) phialpr,phialpi ! phi*alp (real and imaginary) - real(r8) phdalpr,phdalpi ! phi*dalp (real and imaginary) - real(r8) zwalp ! zw*alp - real(r8) zw ! w**2 - real(r8) filtlim ! filter function - real(r8) ft ! filter multiplier for spectral coefficients - real(r8) phi(2,psp/2) ! used in spectral truncation of phis -#if ( ! defined USEFFTLIB ) - real(r8) work((plon+1)*plev) ! Workspace for fft -#else - real(r8) work((plon+1)*pcray) ! Workspace for fft -#endif - - integer i ! longitude index - integer irow ! latitude pair index - integer latm,latp ! symmetric latitude indices - integer lat - integer m ! longitudinal wavenumber index - integer n ! latitudinal wavenumber index - integer nspec - integer mr ! spectral indices -! -!----------------------------------------------------------------------- -! -! Zero spectral array -! - phi(:,:) = 0._r8 -! -! Transform grid -> fourier -! - allocate(phis_tmp(plondfft,plat)) - phis_tmp(:plon,:) = phis(:plon,:) - do lat=1,plat - irow = lat - if (lat.gt.plat/2) irow = plat - lat + 1 - call fft991(phis_tmp(1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & - plon,1,-1) - end do ! lat=1,plat -! -! Loop over latitude pairs -! - do irow=1,plat/2 - latp = irow - latm = plat - irow + 1 - zw = w(irow)*2._r8 - do i=1,2*pmmax -! -! Compute symmetric and antisymmetric components -! - tmp1 = 0.5_r8*(phis_tmp(i,latm) - phis_tmp(i,latp)) - tmp2 = 0.5_r8*(phis_tmp(i,latm) + phis_tmp(i,latp)) - phis_tmp(i,latm) = tmp1 - phis_tmp(i,latp) = tmp2 - end do -! -! Compute phi*mn -! - do m=1,pmmax - mr = nstart(m) - do n=1,nlen(m),2 - zwalp = zw*alp(mr+n,irow) - phi(1,mr+n) = phi(1,mr+n) + zwalp*phis_tmp(2*m-1,latp) - phi(2,mr+n) = phi(2,mr+n) + zwalp*phis_tmp(2*m ,latp) - end do - - do n=2,nlen(m),2 - zwalp = zw*alp(mr+n,irow) - phi(1,mr+n) = phi(1,mr+n) + zwalp*phis_tmp(2*m-1,latm) - phi(2,mr+n) = phi(2,mr+n) + zwalp*phis_tmp(2*m ,latm) - end do - end do - enddo ! irow=1,plat/2 -! - if (phis_hires) then -! -! Apply spectral filter to phis -! filter is a function of n -! if n < filter limit then -! spectral_coeff = spectral_coeff * (1. - (real(n,r8)/filtlim)**2) -! else -! spectral_coeff = 0. -! endif -! where filter limit = 1.4*PTRN -! - filtlim = real(int(1.4_r8*real(ptrn,r8)),r8) - do m=1,pmmax - mr = nstart(m) - do n=1,nlen(m) - nspec=m-1+n - ft = 1._r8 - (real(nspec,r8)/filtlim)**2 - if (real(nspec,r8) .ge. filtlim) ft = 0._r8 - phi(1,mr+n) = phi(1,mr+n)*ft - phi(2,mr+n) = phi(2,mr+n)*ft - end do - end do - call hordif1(rearth,phi) - end if -! -! Compute grid point values of phi*. -! - do irow=1,plat/2 - latp = irow - latm = plat - irow + 1 -! -! Zero fourier fields -! - phis_tmp(:,latm) = 0._r8 - phis_tmp(:,latp) = 0._r8 -! -! Compute(phi*)m -! - do m=1,pmmax - mr = nstart(m) - do n=1,nlen(m),2 - phialpr = phi(1,mr+n)*alp(mr+n,irow) - phialpi = phi(2,mr+n)*alp(mr+n,irow) - phis_tmp(2*m-1,latm) = phis_tmp(2*m-1,latm) + phialpr - phis_tmp(2*m ,latm) = phis_tmp(2*m ,latm) + phialpi - end do - end do - - do m=1,pmmax - mr = nstart(m) - do n=2,nlen(m),2 - phialpr = phi(1,mr+n)*alp(mr+n,irow) - phialpi = phi(2,mr+n)*alp(mr+n,irow) - phis_tmp(2*m-1,latp) = phis_tmp(2*m-1,latp) + phialpr - phis_tmp(2*m ,latp) = phis_tmp(2*m ,latp) + phialpi - end do - end do -! -! Recompute real fields from symmetric and antisymmetric parts -! - do i=1,plon+2 - tmp1 = phis_tmp(i,latm) + phis_tmp(i,latp) - tmp2 = phis_tmp(i,latm) - phis_tmp(i,latp) - phis_tmp(i,latm) = tmp1 - phis_tmp(i,latp) = tmp2 - end do - - enddo ! irow=1,plat/2 - - if(present(phisl)) then - allocate(phisl_tmp(plondfft,plat)) - do irow=1,plat/2 - latp = irow - latm = plat - irow + 1 -! -! Zero fourier fields -! - phisl_tmp(:,latm) = 0._r8 - phisl_tmp(:,latp) = 0._r8 -! -! Compute(phi*)m -! - do m=1,pmmax - mr = nstart(m) - do n=1,nlen(m),2 - phialpr = phi(1,mr+n)*alp(mr+n,irow) - phialpi = phi(2,mr+n)*alp(mr+n,irow) - phisl_tmp(2*m-1,latm) = phisl_tmp(2*m-1,latm) - phialpi*ra - phisl_tmp(2*m ,latm) = phisl_tmp(2*m ,latm) + phialpr*ra - end do - end do - - do m=1,pmmax - mr = nstart(m) - do n=2,nlen(m),2 - phialpr = phi(1,mr+n)*alp(mr+n,irow) - phialpi = phi(2,mr+n)*alp(mr+n,irow) - phisl_tmp(2*m-1,latp) = phisl_tmp(2*m-1,latp) - phialpi*ra - phisl_tmp(2*m ,latp) = phisl_tmp(2*m ,latp) + phialpr*ra - end do - end do -! -! d(Phi)/d(lamda) -! - do m=1,pmmax - phisl_tmp(2*m-1,latm) = xm(m)*phisl_tmp(2*m-1,latm) - phisl_tmp(2*m ,latm) = xm(m)*phisl_tmp(2*m ,latm) - phisl_tmp(2*m-1,latp) = xm(m)*phisl_tmp(2*m-1,latp) - phisl_tmp(2*m ,latp) = xm(m)*phisl_tmp(2*m ,latp) - end do -! -! Recompute real fields from symmetric and antisymmetric parts -! - do i=1,plon+2 - tmp1 = phisl_tmp(i,latm) + phisl_tmp(i,latp) - tmp2 = phisl_tmp(i,latm) - phisl_tmp(i,latp) - phisl_tmp(i,latm) = tmp1 - phisl_tmp(i,latp) = tmp2 - end do - enddo ! irow=1,plat/2 - end if - - if(present(phism)) then - allocate(phism_tmp(plondfft,plat)) - do irow=1,plat/2 - latp = irow - latm = plat - irow + 1 -! -! Zero fourier fields -! - phism_tmp(:,latm) = 0._r8 - phism_tmp(:,latp) = 0._r8 -! -! Compute(phi*)m -! - do m=1,pmmax - mr = nstart(m) - do n=1,nlen(m),2 - phdalpr = phi(1,mr+n)*dalp(mr+n,irow) - phdalpi = phi(2,mr+n)*dalp(mr+n,irow) - phism_tmp(2*m-1,latp) = phism_tmp(2*m-1,latp) + phdalpr*ra - phism_tmp(2*m ,latp) = phism_tmp(2*m ,latp) + phdalpi*ra - end do - end do - - do m=1,pmmax - mr = nstart(m) - do n=2,nlen(m),2 - phdalpr = phi(1,mr+n)*dalp(mr+n,irow) - phdalpi = phi(2,mr+n)*dalp(mr+n,irow) - phism_tmp(2*m-1,latm) = phism_tmp(2*m-1,latm) + phdalpr*ra - phism_tmp(2*m ,latm) = phism_tmp(2*m ,latm) + phdalpi*ra - end do - end do -! -! Recompute real fields from symmetric and antisymmetric parts -! - do i=1,plon+2 - tmp1 = phism_tmp(i,latm) + phism_tmp(i,latp) - tmp2 = phism_tmp(i,latm) - phism_tmp(i,latp) - phism_tmp(i,latm) = tmp1 - phism_tmp(i,latp) = tmp2 - end do - enddo ! irow=1,plat/2 - end if -! - do lat=1,plat -! -! Transform Fourier -> grid, obtaining spectrally truncated -! grid point values. -! - irow = lat - if (lat.gt.plat/2) irow = plat - lat + 1 - - call fft991(phis_tmp(1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & - plon,1,+1) - phis(:plon,lat) = phis_tmp(:plon,lat) - if(present(phisl)) then - call fft991 (phisl_tmp(1,lat),work ,trig(1,irow),ifax(1,irow),1 , & - plondfft ,plon,1 ,+1 ) - phisl(:plon,lat) = phisl_tmp(:plon,lat) - end if - if(present(phism)) then - call fft991 (phism_tmp(1,lat),work ,trig(1,irow),ifax(1,irow),1 , & - plondfft ,plon,1 ,+1 ) - phism(:plon,lat) = phism_tmp(:plon,lat) - end if - enddo - deallocate( phis_tmp ) - if ( present(phisl) ) deallocate( phisl_tmp ) - if ( present(phism) ) deallocate( phism_tmp ) - - if(present(phi_out)) then - phi_out(:,:) = phi(:,:) - end if - - return -end subroutine spetru_phis - -!************************************************************************ -subroutine spetru_ps(ps ,dpsl ,dpsm) - -!----------------------------------------------------------------------- -! -! Purpose: -! -! Method: -! Spectrally truncate PS input field. -! -! Author: -! Original version: J. Rosinski -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, J. Hack, August 1992 -! Modified: P. Worley, May 2003 -! Modified: J. Olson, Apr 2004 -! -!----------------------------------------------------------------------- - - use pmgrid, only: plon, plat - -! -! Input/Output arguments -! - real(r8), intent(inout) :: ps(plon,plat) ! Fourier -> spec. coeffs. for ln(ps) -! -! Output arguments -! - real(r8), intent(out) :: dpsl(plon,plat) ! Spectrally trunc d(ln(ps))/d(longitude) - real(r8), intent(out) :: dpsm(plon,plat) ! Spectrally trunc d(ln(ps))/d(latitude) - -! -!---------------------------Local workspace----------------------------- -! - real(r8), pointer :: log_ps(:,:) ! log(ps) - real(r8), pointer :: dpsm_tmp(:,:) ! Temporary to compute dpsm of size needed for FFT - real(r8), pointer :: dpsl_tmp(:,:) ! Temporary to compute dpsl of size needed for FFT - real(r8) alps_tmp(psp) ! used in spectral truncation of phis - real(r8) tmp1 ! vector temporary - real(r8) tmp2 ! vector temporary - real(r8) zwalp ! zw*alp - real(r8) psdalpr,psdalpi ! alps (real and imaginary)*dalp - real(r8) psalpr,psalpi ! alps (real and imaginary)*alp - real(r8) zw ! w**2 -#if ( ! defined USEFFTLIB ) - real(r8) work((plon+1)*plev) ! Workspace for fft -#else - real(r8) work((plon+1)*pcray) ! Workspace for fft -#endif - - integer ir,ii ! indices complex coeffs. of spec. arrs. - integer i,k ! longitude, level indices - integer irow ! latitude pair index - integer latm,latp ! symmetric latitude indices - integer lat - integer m ! longitudinal wavenumber index - integer n ! latitudinal wavenumber index - integer nspec - integer mr,mc ! spectral indices -! -!----------------------------------------------------------------------- -! -! Zero spectral array -! - alps_tmp(:) = 0._r8 -! -! Compute the 2D quantities which are transformed to spectral space: -! ps= ln(ps). -! - allocate( log_ps(plondfft,plat) ) - do lat=1,plat - irow = lat - if (lat.gt.plat/2) irow = plat - lat + 1 - do i=1,plon - log_ps(i,lat) = log(ps(i,lat)) - end do -! -! Transform grid -> fourier -! - call fft991(log_ps(1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & - plon,1,-1) - - end do ! lat=1,plat - allocate( dpsl_tmp(plondfft,plat) ) - allocate( dpsm_tmp(plondfft,plat) ) -! -! Loop over latitude pairs -! - do irow=1,plat/2 - latp = irow - latm = plat - irow + 1 - zw = w(irow)*2._r8 - do i=1,2*pmmax -! -! Compute symmetric and antisymmetric components -! - tmp1 = 0.5_r8*(log_ps(i,latm) - log_ps(i,latp)) - tmp2 = 0.5_r8*(log_ps(i,latm) + log_ps(i,latp)) - log_ps(i,latm) = tmp1 - log_ps(i,latp) = tmp2 - - end do -! -! Compute ln(p*)mn -! - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=1,nlen(m),2 - zwalp = zw*alp(mr+n,irow) - ir = mc + 2*n - 1 - ii = ir + 1 - alps_tmp(ir) = alps_tmp(ir) + zwalp*log_ps(2*m-1,latp) - alps_tmp(ii) = alps_tmp(ii) + zwalp*log_ps(2*m ,latp) - end do - - do n=2,nlen(m),2 - zwalp = zw*alp(mr+n,irow) - ir = mc + 2*n - 1 - ii = ir + 1 - alps_tmp(ir) = alps_tmp(ir) + zwalp*log_ps(2*m-1,latm) - alps_tmp(ii) = alps_tmp(ii) + zwalp*log_ps(2*m ,latm) - end do - end do - enddo ! irow=1,plat/2 -! -! Compute grid point values of:ln(p*) and grad(ln(p*)). -! - do irow=1,plat/2 - latp = irow - latm = plat - irow + 1 -! -! Zero fourier fields -! - log_ps(:,latm) = 0._r8 - log_ps(:,latp) = 0._r8 - - dpsl_tmp(:,latm) = 0._r8 - dpsl_tmp(:,latp) = 0._r8 - - dpsm_tmp(:,latm) = 0._r8 - dpsm_tmp(:,latp) = 0._r8 - -! -! Compute(ln(p*),grad(ln(p*)))m -! - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=1,nlen(m),2 - ir = mc + 2*n - 1 - ii = ir + 1 - psalpr = alps_tmp(ir)*alp(mr+n,irow) - psalpi = alps_tmp(ii)*alp(mr+n,irow) -! - log_ps(2*m-1,latm) = log_ps(2*m-1,latm) + psalpr - log_ps(2*m ,latm) = log_ps(2*m ,latm) + psalpi - dpsl_tmp(2*m-1,latm) = dpsl_tmp(2*m-1,latm) - psalpi*ra - dpsl_tmp(2*m ,latm) = dpsl_tmp(2*m ,latm) + psalpr*ra -! - psdalpr = alps_tmp(ir)*dalp(mr+n,irow) - psdalpi = alps_tmp(ii)*dalp(mr+n,irow) -! - dpsm_tmp(2*m-1,latp) = dpsm_tmp(2*m-1,latp) + psdalpr*ra - dpsm_tmp(2*m ,latp) = dpsm_tmp(2*m ,latp) + psdalpi*ra - end do - end do - - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=2,nlen(m),2 - ir = mc + 2*n - 1 - ii = ir + 1 - psalpr = alps_tmp(ir)*alp(mr+n,irow) - psalpi = alps_tmp(ii)*alp(mr+n,irow) -! - log_ps(2*m-1,latp) = log_ps(2*m-1,latp) + psalpr - log_ps(2*m ,latp) = log_ps(2*m ,latp) + psalpi - dpsl_tmp(2*m-1,latp) = dpsl_tmp(2*m-1,latp) - psalpi*ra - dpsl_tmp(2*m ,latp) = dpsl_tmp(2*m ,latp) + psalpr*ra -! - psdalpr = alps_tmp(ir)*dalp(mr+n,irow) - psdalpi = alps_tmp(ii)*dalp(mr+n,irow) -! - dpsm_tmp(2*m-1,latm) = dpsm_tmp(2*m-1,latm) + psdalpr*ra - dpsm_tmp(2*m ,latm) = dpsm_tmp(2*m ,latm) + psdalpi*ra - end do - end do - - do m=1,pmmax - dpsl_tmp(2*m-1,latm) = xm(m)*dpsl_tmp(2*m-1,latm) - dpsl_tmp(2*m ,latm) = xm(m)*dpsl_tmp(2*m ,latm) - dpsl_tmp(2*m-1,latp) = xm(m)*dpsl_tmp(2*m-1,latp) - dpsl_tmp(2*m ,latp) = xm(m)*dpsl_tmp(2*m ,latp) - end do -! -! Recompute real fields from symmetric and antisymmetric parts -! - do i=1,plon+2 -! - tmp1 = log_ps(i,latm) + log_ps(i,latp) - tmp2 = log_ps(i,latm) - log_ps(i,latp) - log_ps(i,latm) = tmp1 - log_ps(i,latp) = tmp2 -! - tmp1 = dpsl_tmp(i,latm) + dpsl_tmp(i,latp) - tmp2 = dpsl_tmp(i,latm) - dpsl_tmp(i,latp) - dpsl_tmp(i,latm) = tmp1 - dpsl_tmp(i,latp) = tmp2 -! - tmp1 = dpsm_tmp(i,latm) + dpsm_tmp(i,latp) - tmp2 = dpsm_tmp(i,latm) - dpsm_tmp(i,latp) - dpsm_tmp(i,latm) = tmp1 - dpsm_tmp(i,latp) = tmp2 - end do -! - enddo ! irow=1,plat/2 -! - do lat=1,plat -! -! Transform Fourier -> grid, obtaining spectrally truncated -! grid point values. -! - irow = lat - if (lat.gt.plat/2) irow = plat - lat + 1 - - call fft991(log_ps(1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & - plon,1,+1) - call fft991(dpsl_tmp(1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & - plon,1,+1) - call fft991(dpsm_tmp(1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & - plon,1,+1) -! -! Convert from ln(ps) to ps, copy temporaries to input arrays -! - do i=1,plon - ps(i,lat) = exp(log_ps(i,lat)) - dpsl(i,lat) = dpsl_tmp(i,lat) - dpsm(i,lat) = dpsm_tmp(i,lat) - end do -! - enddo - deallocate( log_ps ) - deallocate( dpsm_tmp ) - deallocate( dpsl_tmp ) - - return -end subroutine spetru_ps - -!************************************************************************ - -subroutine spetru_3d_scalar(x3, dl, dm) - -!----------------------------------------------------------------------- -! -! Purpose: -! -! Method: -! Spectrally truncate 3-D scalar field. -! -! Author: -! Original version: J. Rosinski -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, J. Hack, August 1992 -! Modified: P. Worley, May 2003 -! Modified: J. Olson, Apr 2004 -! -!----------------------------------------------------------------------- - - use pmgrid, only: plon, plat - -! -! Input/Output arguments -! - real(r8), intent(inout) :: x3(plon,plev,plat) ! Fourier -> spec. coeffs. for X - real(r8), intent(out), optional :: dl(plon,plev,plat) ! Spectrally trunc d(X)/d(longitude) - real(r8), intent(out), optional :: dm(plon,plev,plat) ! Spectrally trunc d(X)/d(latitude) -! -!---------------------------Local workspace----------------------------- -! - real(r8), pointer :: x3_tmp(:,:,:) ! Temporary to compute x3 of size needed for FFT - real(r8), pointer :: dl_tmp(:,:,:) ! Temporary to compute dl of size needed for FFT - real(r8), pointer :: dm_tmp(:,:,:) ! Temporary to compute dm of size needed for FFT - real(r8) t_tmp(psp) ! used in spectral truncation of t - real(r8) tmp1 ! vector temporary - real(r8) tmp2 ! vector temporary - real(r8) tmpr ! vector temporary (real) - real(r8) tmpi ! vector temporary (imaginary) - real(r8) zwalp ! zw*alp - real(r8) zw ! w**2 -#if ( ! defined USEFFTLIB ) - real(r8) work((plon+1)*plev) ! Workspace for fft -#else - real(r8) work((plon+1)*pcray) ! Workspace for fft -#endif - - integer ir,ii ! indices complex coeffs. of spec. arrs. - integer i,k ! longitude, level indices - integer irow ! latitude pair index - integer latm,latp ! symmetric latitude indices - integer lat - integer m ! longitudinal wavenumber index - integer n ! latitudinal wavenumber index - integer nspec - integer mr,mc ! spectral indices -! -!----------------------------------------------------------------------- -! -! Transform grid -> fourier -! - allocate( x3_tmp(plondfft,plev,plat) ) - if(present(dm)) allocate( dm_tmp(plondfft,plev,plat) ) - if(present(dl)) allocate( dl_tmp(plondfft,plev,plat) ) - do lat=1,plat - irow = lat - if (lat.gt.plat/2) irow = plat - lat + 1 - x3_tmp(:plon,:,lat) = x3(:plon,:,lat) - call fft991(x3_tmp(1,1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & - plon,plev,-1) - end do ! lat=1,plat -! -! Loop over vertical levels -! - do k=1,plev -! -! Zero spectral array -! - t_tmp(:) = 0._r8 -! -! Loop over latitude pairs -! - do irow=1,plat/2 - latp = irow - latm = plat - irow + 1 - zw = w(irow)*2._r8 -! -! Multi-level field: T -! - do i=1,2*pmmax - tmp1 = 0.5_r8*(x3_tmp(i,k,latm) - x3_tmp(i,k,latp)) - tmp2 = 0.5_r8*(x3_tmp(i,k,latm) + x3_tmp(i,k,latp)) - x3_tmp(i,k,latm) = tmp1 - x3_tmp(i,k,latp) = tmp2 - end do -! -! Compute tmn -! - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=1,nlen(m),2 - zwalp = zw*alp (mr+n,irow) - ir = mc + 2*n - 1 - ii = ir + 1 - t_tmp(ir) = t_tmp(ir) + zwalp*x3_tmp(2*m-1,k,latp) - t_tmp(ii) = t_tmp(ii) + zwalp*x3_tmp(2*m ,k,latp) - end do - end do - - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=2,nlen(m),2 - zwalp = zw*alp (mr+n,irow) - ir = mc + 2*n - 1 - ii = ir + 1 - t_tmp(ir) = t_tmp(ir) + zwalp*x3_tmp(2*m-1,k,latm) - t_tmp(ii) = t_tmp(ii) + zwalp*x3_tmp(2*m ,k,latm) - end do - end do - enddo ! irow=1,plat/2 -! -! Compute grid point values of:t. -! - do irow=1,plat/2 - latp = irow - latm = plat - irow + 1 -! -! Zero fourier fields -! - x3_tmp(:,k,latm) = 0._r8 - x3_tmp(:,k,latp) = 0._r8 - - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=1,nlen(m),2 - ir = mc + 2*n - 1 - ii = ir + 1 - tmpr = t_tmp(ir)*alp(mr+n,irow) - tmpi = t_tmp(ii)*alp(mr+n,irow) - x3_tmp(2*m-1,k,latm) = x3_tmp(2*m-1,k,latm) + tmpr - x3_tmp(2*m ,k,latm) = x3_tmp(2*m ,k,latm) + tmpi - end do - end do - - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=2,nlen(m),2 - ir = mc + 2*n - 1 - ii = ir + 1 - tmpr = t_tmp(ir)*alp(mr+n,irow) - tmpi = t_tmp(ii)*alp(mr+n,irow) - x3_tmp(2*m-1,k,latp) = x3_tmp(2*m-1,k,latp) + tmpr - x3_tmp(2*m ,k,latp) = x3_tmp(2*m ,k,latp) + tmpi - end do - end do -! -! Recompute real fields from symmetric and antisymmetric parts -! - do i=1,plon+2 - tmp1 = x3_tmp(i,k,latm) + x3_tmp(i,k,latp) - tmp2 = x3_tmp(i,k,latm) - x3_tmp(i,k,latp) - x3_tmp(i,k,latm) = tmp1 - x3_tmp(i,k,latp) = tmp2 - end do - enddo ! irow=1,plat/2 - - if(present(dl)) then - do irow=1,plat/2 - latp = irow - latm = plat - irow + 1 -! -! Zero fourier fields -! - dl_tmp(:,k,latm) = 0._r8 - dl_tmp(:,k,latp) = 0._r8 - - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=1,nlen(m),2 - ir = mc + 2*n - 1 - ii = ir + 1 - tmpr = t_tmp(ir)*alp(mr+n,irow) - tmpi = t_tmp(ii)*alp(mr+n,irow) - dl_tmp(2*m-1,k,latm) = dl_tmp(2*m-1,k,latm) - tmpi*ra - dl_tmp(2*m ,k,latm) = dl_tmp(2*m ,k,latm) + tmpr*ra - end do - end do - - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=2,nlen(m),2 - ir = mc + 2*n - 1 - ii = ir + 1 - tmpr = t_tmp(ir)*alp(mr+n,irow) - tmpi = t_tmp(ii)*alp(mr+n,irow) - dl_tmp(2*m-1,k,latp) = dl_tmp(2*m-1,k,latp) - tmpi*ra - dl_tmp(2*m ,k,latp) = dl_tmp(2*m ,k,latp) + tmpr*ra - end do - end do -! -! d(T)/d(lamda) -! - do m=1,pmmax - dl_tmp(2*m-1,k,latm) = xm(m)*dl_tmp(2*m-1,k,latm) - dl_tmp(2*m ,k,latm) = xm(m)*dl_tmp(2*m ,k,latm) - dl_tmp(2*m-1,k,latp) = xm(m)*dl_tmp(2*m-1,k,latp) - dl_tmp(2*m ,k,latp) = xm(m)*dl_tmp(2*m ,k,latp) - end do -! -! Recompute real fields from symmetric and antisymmetric parts -! - do i=1,plon+2 - tmp1 = dl_tmp(i,k,latm) + dl_tmp(i,k,latp) - tmp2 = dl_tmp(i,k,latm) - dl_tmp(i,k,latp) - dl_tmp(i,k,latm) = tmp1 - dl_tmp(i,k,latp) = tmp2 - end do - enddo ! irow=1,plat/2 - end if - - if(present(dm)) then - do irow=1,plat/2 - latp = irow - latm = plat - irow + 1 -! -! Zero fourier fields -! - dm_tmp(:,k,latm) = 0._r8 - dm_tmp(:,k,latp) = 0._r8 - - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=1,nlen(m),2 - ir = mc + 2*n - 1 - ii = ir + 1 - tmpr = t_tmp(ir)*dalp(mr+n,irow) - tmpi = t_tmp(ii)*dalp(mr+n,irow) - dm_tmp(2*m-1,k,latp) = dm_tmp(2*m-1,k,latp) + tmpr*ra - dm_tmp(2*m ,k,latp) = dm_tmp(2*m ,k,latp) + tmpi*ra - end do - end do - - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=2,nlen(m),2 - ir = mc + 2*n - 1 - ii = ir + 1 - tmpr = t_tmp(ir)*dalp(mr+n,irow) - tmpi = t_tmp(ii)*dalp(mr+n,irow) - dm_tmp(2*m-1,k,latm) = dm_tmp(2*m-1,k,latm) + tmpr*ra - dm_tmp(2*m ,k,latm) = dm_tmp(2*m ,k,latm) + tmpi*ra - end do - end do -! -! Recompute real fields from symmetric and antisymmetric parts -! - do i=1,plon+2 - tmp1 = dm_tmp(i,k,latm) + dm_tmp(i,k,latp) - tmp2 = dm_tmp(i,k,latm) - dm_tmp(i,k,latp) - dm_tmp(i,k,latm) = tmp1 - dm_tmp(i,k,latp) = tmp2 - end do - enddo ! irow=1,plat/2 - end if - - enddo ! k=1,plev -! - do lat=1,plat -! -! Transform Fourier -> grid, obtaining spectrally truncated -! grid point values. - - irow = lat - if (lat.gt.plat/2) irow = plat - lat + 1 - - call fft991(x3_tmp(1,1,lat) ,work ,trig(1,irow),ifax(1,irow),1 , & - plondfft ,plon,plev ,+1) - x3(:plon,:,lat) = x3_tmp(:plon,:,lat) - if(present(dl)) then - call fft991(dl_tmp(1,1,lat) ,work ,trig(1,irow),ifax(1,irow),1 , & - plondfft ,plon,plev ,+1 ) - dl(:plon,:,lat) = dl_tmp(:plon,:,lat) - end if - if(present(dm)) then - call fft991(dm_tmp(1,1,lat) ,work ,trig(1,irow),ifax(1,irow),1 , & - plondfft ,plon,plev ,+1 ) - dm(:plon,:,lat) = dm_tmp(:plon,:,lat) - end if - end do - deallocate( x3_tmp ) - if ( present(dm) ) deallocate( dm_tmp ) - if ( present(dl) ) deallocate( dl_tmp ) - - return -end subroutine spetru_3d_scalar - -!*********************************************************************** - -subroutine spetru_uv(u3 ,v3 ,div ,vort ) - -!----------------------------------------------------------------------- -! -! Purpose: -! -! Method: -! Spectrally truncate U, V input fields. -! -! Author: -! Original version: J. Rosinski -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, J. Hack, August 1992 -! Modified: P. Worley, May 2003 -! Modified: J. Olson, Apr 2004 -! -!----------------------------------------------------------------------- - - use pmgrid, only: plon, plat - use commap, only: rsq, cs - use physconst,only: ez - -! -! Input/Output arguments -! - real(r8), intent(inout) :: u3(plon,plev,plat) ! Fourier -> spec. coeffs. for u-wind - real(r8), intent(inout) :: v3(plon,plev,plat) ! Fourier -> spec. coeffs. for v-wind -! -! Output arguments -! - real(r8), intent(out), optional :: div (plon,plev,plat) ! Spectrally truncated divergence - real(r8), intent(out), optional :: vort(plon,plev,plat) ! Spectrally truncated vorticity - -! -!---------------------------Local workspace----------------------------- -! - real(r8), pointer :: u_cosphi(:,:,:) ! u3*cos(phi) - real(r8), pointer :: v_cosphi(:,:,:) ! v3*cos(phi) - real(r8), pointer :: div_tmp(:,:,:) ! Temporary to compute div of size needed for FFT - real(r8), pointer :: vort_tmp(:,:,:) ! Temporary to compute vort of size needed for FFT - real(r8) d_tmp(psp) ! used in spectral truncation of div - real(r8) vz_tmp(psp) ! used in spectral truncation of vort - real(r8) alpn(pspt) ! alp*rsq*xm*ra - real(r8) dalpn(pspt) ! dalp*rsq*ra - real(r8) tmp1 ! vector temporary - real(r8) tmp2 ! vector temporary - real(r8) tmpr ! vector temporary (real) - real(r8) tmpi ! vector temporary (imaginary) - real(r8) zcor ! correction for absolute vorticity - real(r8) zwalp ! zw*alp - real(r8) zwdalp ! zw*dalp - real(r8) zrcsj ! ra/(cos**2 latitude) - real(r8) zw ! w**2 -#if ( ! defined USEFFTLIB ) - real(r8) work((plon+1)*plev) ! Workspace for fft -#else - real(r8) work((plon+1)*pcray) ! Workspace for fft -#endif - real(r8) zsqcs - - integer ir,ii ! indices complex coeffs. of spec. arrs. - integer i,k ! longitude, level indices - integer irow ! latitude pair index - integer latm,latp ! symmetric latitude indices - integer lat - integer m ! longitudinal wavenumber index - integer n ! latitudinal wavenumber index - integer nspec - integer mr,mc ! spectral indices - -! -!----------------------------------------------------------------------- -! -! Compute the quantities which are transformed to spectral space: -! 1. u = u*sqrt(1-mu*mu), u * cos(phi) -! 2. v = v*sqrt(1-mu*mu), v * cos(phi) -! - allocate( u_cosphi(plondfft,plev,plat) ) - allocate( v_cosphi(plondfft,plev,plat) ) - do lat=1,plat - irow = lat - if (lat.gt.plat/2) irow = plat - lat + 1 - zsqcs = sqrt(cs(irow)) - do k=1,plev - do i=1,plon - u_cosphi(i,k,lat) = u3(i,k,lat)*zsqcs - v_cosphi(i,k,lat) = v3(i,k,lat)*zsqcs - end do - end do -! -! Transform grid -> fourier -! 1st transform: U,V,T: note contiguity assumptions -! 2nd transform: LN(PS). 3rd transform: surface geopotential -! - call fft991(u_cosphi(1,1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & - plon,plev,-1) - call fft991(v_cosphi(1,1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & - plon,plev,-1) - - end do ! lat=1,plat -! -! Multi-level fields: U, V -! - if ( present(div) ) allocate( div_tmp(plondfft,plev,plat) ) - if ( present(vort) ) allocate( vort_tmp(plondfft,plev,plat) ) - do k=1,plev -! -! Zero spectral arrays -! - vz_tmp(:) = 0._r8 - d_tmp(:) = 0._r8 -! -! Loop over latitude pairs -! - do irow=1,plat/2 - latp = irow - latm = plat - irow + 1 - zrcsj = ra/cs(irow) - zw = w(irow)*2._r8 - do i=1,2*pmmax - - tmp1 = 0.5_r8*(u_cosphi(i,k,latm) - u_cosphi(i,k,latp)) - tmp2 = 0.5_r8*(u_cosphi(i,k,latm) + u_cosphi(i,k,latp)) - u_cosphi(i,k,latm) = tmp1 - u_cosphi(i,k,latp) = tmp2 - - tmp1 = 0.5_r8*(v_cosphi(i,k,latm) - v_cosphi(i,k,latp)) - tmp2 = 0.5_r8*(v_cosphi(i,k,latm) + v_cosphi(i,k,latp)) - v_cosphi(i,k,latm) = tmp1 - v_cosphi(i,k,latp) = tmp2 - - end do -! -! Compute vzmn and dmn -! - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=1,nlen(m),2 - zwdalp = zw*dalp(mr+n,irow) - zwalp = zw*alp (mr+n,irow) - ir = mc + 2*n - 1 - ii = ir + 1 - d_tmp(ir) = d_tmp(ir) - (zwdalp*v_cosphi(2*m-1,k,latm) + & - xm(m)*zwalp*u_cosphi(2*m ,k,latp))*zrcsj - d_tmp(ii) = d_tmp(ii) - (zwdalp*v_cosphi(2*m ,k,latm) - & - xm(m)*zwalp*u_cosphi(2*m-1,k,latp))*zrcsj - vz_tmp(ir) = vz_tmp(ir) + (zwdalp*u_cosphi(2*m-1,k,latm) - & - xm(m)*zwalp*v_cosphi(2*m ,k,latp))*zrcsj - vz_tmp(ii) = vz_tmp(ii) + (zwdalp*u_cosphi(2*m ,k,latm) + & - xm(m)*zwalp*v_cosphi(2*m-1,k,latp))*zrcsj - end do - end do - - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=2,nlen(m),2 - zwdalp = zw*dalp(mr+n,irow) - zwalp = zw*alp (mr+n,irow) - ir = mc + 2*n - 1 - ii = ir + 1 - d_tmp(ir) = d_tmp(ir) - (zwdalp*v_cosphi(2*m-1,k,latp) + & - xm(m)*zwalp*u_cosphi(2*m ,k,latm))*zrcsj - d_tmp(ii) = d_tmp(ii) - (zwdalp*v_cosphi(2*m ,k,latp) - & - xm(m)*zwalp*u_cosphi(2*m-1,k,latm))*zrcsj - vz_tmp(ir) = vz_tmp(ir) + (zwdalp*u_cosphi(2*m-1,k,latp) - & - xm(m)*zwalp*v_cosphi(2*m ,k,latm))*zrcsj - vz_tmp(ii) = vz_tmp(ii) + (zwdalp*u_cosphi(2*m ,k,latp) + & - xm(m)*zwalp*v_cosphi(2*m-1,k,latm))*zrcsj - end do - end do - enddo ! irow=1,plat/2 -! -! Compute grid point values of:u,v,vz, and d. -! - do irow=1,plat/2 - latp = irow - latm = plat - irow + 1 - zcor = ez*alp(2,irow) -! -! Compute(u,v,vz,d)m -! - do m=1,pmmax - mr = nstart(m) - do n=1,nlen(m) -! -! These statements will likely not be bfb since xm*ra is now a scalar -! - alpn (mr+n) = alp(mr+n,irow)*rsq(n+m-1)*xm(m)*ra - dalpn(mr+n) = dalp(mr+n,irow)*rsq(n+m-1) *ra - end do - end do -! -! Zero fourier fields -! - u_cosphi(:,k,latm) = 0._r8 - u_cosphi(:,k,latp) = 0._r8 - - v_cosphi(:,k,latm) = 0._r8 - v_cosphi(:,k,latp) = 0._r8 - - if(present(vort)) then - vort_tmp(:,k,latm) = 0._r8 - vort_tmp(:,k,latp) = 0._r8 - end if - - if(present(div)) then - div_tmp(:,k,latm) = 0._r8 - div_tmp(:,k,latp) = 0._r8 - end if - - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=1,nlen(m),2 - ir = mc + 2*n - 1 - ii = ir + 1 -! - tmpr = d_tmp(ir)*alpn(mr+n) - tmpi = d_tmp(ii)*alpn(mr+n) - u_cosphi(2*m-1,k,latm) = u_cosphi(2*m-1,k,latm) + tmpi - u_cosphi(2*m ,k,latm) = u_cosphi(2*m ,k,latm) - tmpr -! - tmpr = d_tmp(ir)*dalpn(mr+n) - tmpi = d_tmp(ii)*dalpn(mr+n) - v_cosphi(2*m-1,k,latp) = v_cosphi(2*m-1,k,latp) - tmpr - v_cosphi(2*m ,k,latp) = v_cosphi(2*m ,k,latp) - tmpi -! - tmpr = vz_tmp(ir)*dalpn(mr+n) - tmpi = vz_tmp(ii)*dalpn(mr+n) - u_cosphi(2*m-1,k,latp) = u_cosphi(2*m-1,k,latp) + tmpr - u_cosphi(2*m ,k,latp) = u_cosphi(2*m ,k,latp) + tmpi -! - tmpr = vz_tmp(ir)*alpn(mr+n) - tmpi = vz_tmp(ii)*alpn(mr+n) - v_cosphi(2*m-1,k,latm) = v_cosphi(2*m-1,k,latm) + tmpi - v_cosphi(2*m ,k,latm) = v_cosphi(2*m ,k,latm) - tmpr -! - if(present(div)) then - tmpr = d_tmp(ir)*alp(mr+n,irow) - tmpi = d_tmp(ii)*alp(mr+n,irow) - div_tmp(2*m-1,k,latm) = div_tmp(2*m-1,k,latm) + tmpr - div_tmp(2*m ,k,latm) = div_tmp(2*m ,k,latm) + tmpi - end if -! - if(present(vort)) then - tmpr = vz_tmp(ir)*alp(mr+n,irow) - tmpi = vz_tmp(ii)*alp(mr+n,irow) - vort_tmp(2*m-1,k,latm) = vort_tmp(2*m-1,k,latm) + tmpr - vort_tmp(2*m ,k,latm) = vort_tmp(2*m ,k,latm) + tmpi - end if - end do - end do - - do m=1,pmmax - mr = nstart(m) - mc = 2*mr - do n=2,nlen(m),2 - ir = mc + 2*n - 1 - ii = ir + 1 -! - tmpr = d_tmp(ir)*alpn(mr+n) - tmpi = d_tmp(ii)*alpn(mr+n) - u_cosphi(2*m-1,k,latp) = u_cosphi(2*m-1,k,latp) + tmpi - u_cosphi(2*m ,k,latp) = u_cosphi(2*m ,k,latp) - tmpr -! - tmpr = d_tmp(ir)*dalpn(mr+n) - tmpi = d_tmp(ii)*dalpn(mr+n) - v_cosphi(2*m-1,k,latm) = v_cosphi(2*m-1,k,latm) - tmpr - v_cosphi(2*m ,k,latm) = v_cosphi(2*m ,k,latm) - tmpi -! - tmpr = vz_tmp(ir)*dalpn(mr+n) - tmpi = vz_tmp(ii)*dalpn(mr+n) - u_cosphi(2*m-1,k,latm) = u_cosphi(2*m-1,k,latm) + tmpr - u_cosphi(2*m ,k,latm) = u_cosphi(2*m ,k,latm) + tmpi -! - tmpr = vz_tmp(ir)*alpn(mr+n) - tmpi = vz_tmp(ii)*alpn(mr+n) - v_cosphi(2*m-1,k,latp) = v_cosphi(2*m-1,k,latp) + tmpi - v_cosphi(2*m ,k,latp) = v_cosphi(2*m ,k,latp) - tmpr -! - if(present(div)) then - tmpr = d_tmp(ir)*alp(mr+n,irow) - tmpi = d_tmp(ii)*alp(mr+n,irow) - div_tmp(2*m-1,k,latp) = div_tmp(2*m-1,k,latp) + tmpr - div_tmp(2*m ,k,latp) = div_tmp(2*m ,k,latp) + tmpi - end if -! - if(present(vort)) then - tmpr = vz_tmp(ir)*alp(mr+n,irow) - tmpi = vz_tmp(ii)*alp(mr+n,irow) - vort_tmp(2*m-1,k,latp) = vort_tmp(2*m-1,k,latp) + tmpr - vort_tmp(2*m ,k,latp) = vort_tmp(2*m ,k,latp) + tmpi - end if - end do - end do -! -! Correction to get the absolute vorticity. -! - if(present(vort)) then - vort_tmp(1,k,latp) = vort_tmp(1,k,latp) + zcor - end if -! -! Recompute real fields from symmetric and antisymmetric parts -! - do i=1,plon+2 - tmp1 = u_cosphi(i,k,latm) + u_cosphi(i,k,latp) - tmp2 = u_cosphi(i,k,latm) - u_cosphi(i,k,latp) - u_cosphi(i,k,latm) = tmp1 - u_cosphi(i,k,latp) = tmp2 -! - tmp1 = v_cosphi(i,k,latm) + v_cosphi(i,k,latp) - tmp2 = v_cosphi(i,k,latm) - v_cosphi(i,k,latp) - v_cosphi(i,k,latm) = tmp1 - v_cosphi(i,k,latp) = tmp2 -! - if(present(vort)) then - tmp1 = vort_tmp(i,k,latm) + vort_tmp(i,k,latp) - tmp2 = vort_tmp(i,k,latm) - vort_tmp(i,k,latp) - vort_tmp(i,k,latm) = tmp1 - vort_tmp(i,k,latp) = tmp2 - end if -! - if(present(div)) then - tmp1 = div_tmp(i,k,latm) + div_tmp(i,k,latp) - tmp2 = div_tmp(i,k,latm) - div_tmp(i,k,latp) - div_tmp(i,k,latm) = tmp1 - div_tmp(i,k,latp) = tmp2 - end if - end do - enddo ! irow=1,plat/2 - enddo ! k=1,plev -! - do lat=1,plat -! -! Transform Fourier -> grid, obtaining spectrally truncated -! grid point values. -! - irow = lat - if (lat.gt.plat/2) irow = plat - lat + 1 - - call fft991(u_cosphi(1,1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & - plon,plev,+1) - call fft991(v_cosphi(1,1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & - plon,plev,+1) - if(present(vort)) then - call fft991(vort_tmp(1,1,lat),work,trig(1,irow),ifax(1,irow),1, & - plondfft,plon,plev,+1) - vort(:plon,:,lat) = vort_tmp(:plon,:,lat) - end if - if(present(div)) then - call fft991(div_tmp(1,1,lat),work,trig(1,irow),ifax(1,irow),1,plondfft, & - plon,plev,+1) - div(:plon,:,lat) = div_tmp(:plon,:,lat) - end if -! -! Convert U,V to u,v -! - zsqcs = sqrt(cs(irow)) - do k=1,plev - do i=1,plon - u3(i,k,lat) = u_cosphi(i,k,lat)/zsqcs - v3(i,k,lat) = v_cosphi(i,k,lat)/zsqcs - end do - end do - enddo - deallocate( u_cosphi ) - deallocate( v_cosphi ) - if ( present(div) ) deallocate( div_tmp ) - if ( present(vort) ) deallocate( vort_tmp ) - - return -end subroutine spetru_uv - -end module spetru diff --git a/src/dynamics/eul/sphdep.F90 b/src/dynamics/eul/sphdep.F90 deleted file mode 100644 index e7ebeeeb73..0000000000 --- a/src/dynamics/eul/sphdep.F90 +++ /dev/null @@ -1,765 +0,0 @@ - -subroutine sphdep(jcen ,jgc ,dt ,ra ,iterdp , & - locgeo ,ub ,uxl ,uxr ,lam , & - phib ,lbasiy ,lammp ,phimp ,lamdp , & - phidp ,idp ,jdp ,vb ,vxl , & - vxr ,nlon ,nlonex ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Compute departure points for semi-Lagrangian transport on surface of -! sphere using midpoint quadrature. Computations are done in: -! -! 1) "local geodesic" coordinates for "locgeo" = .true. -! 2) "global spherical" coordinates for "locgeo" = .false. -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plev, plon, plat - use scanslt, only: platd, plond, beglatex, endlatex, i1, nxpt, j1 - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - - implicit none -#include - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: nlon ! longitude dimension - integer , intent(in) :: nlonex(platd) ! extended longitude dimension - integer , intent(in) :: jcen ! index of lat slice (extnd) - integer , intent(in) :: jgc ! index of lat slice (model) - real(r8), intent(in) :: dt ! time step (seconds) - real(r8), intent(in) :: ra ! 1./(radius of earth) - integer , intent(in) :: iterdp ! number of iterations - logical , intent(in) :: locgeo ! computation type flag - real(r8), intent(in) :: ub (plond,plev,beglatex:endlatex) ! x-deriv - real(r8), intent(in) :: vb (plond,plev,beglatex:endlatex) ! x-deriv - real(r8), intent(in) :: uxl(plond,plev,beglatex:endlatex) ! left x-deriv (u) - real(r8), intent(in) :: uxr(plond,plev,beglatex:endlatex) ! right x-deriv - real(r8), intent(in) :: vxl(plond,plev,beglatex:endlatex) ! left x-deriv (v) - real(r8), intent(in) :: vxr(plond,plev,beglatex:endlatex) ! right x-deriv - real(r8), intent(in) :: lam(plond,platd) ! long. coord. of model grid - real(r8), intent(in) :: phib(platd) ! lat. coord. of model grid - real(r8), intent(in) :: lbasiy(4,2,platd) ! lat interpolation weights - real(r8), intent(inout) :: lammp(plon,plev) ! long coord of midpoint - real(r8), intent(inout) :: phimp(plon,plev) ! lat coord of midpoint - real(r8), intent(out) :: lamdp(plon,plev) ! long coord of dep. point - real(r8), intent(out) :: phidp(plon,plev) ! lat coord of dep. point - integer , intent(out) :: idp(plon,plev,4) ! long index of dep. point - integer , intent(out) :: jdp(plon,plev) ! lat index of dep. point -! -! jcen Index in extended grid corresponding to latitude being -! forecast. -! jgc Index in model grid corresponding to latitude being -! forecast. -! dt Time interval that parameterizes the parcel trajectory. -! ra Reciprocal of radius of earth. -! iterdp Number of iterations used for departure point calculation. -! locgeo Logical flag to indicate computation in "local geodesic" or -! "global spherical" space. -! ub Longitudinal velocity components in spherical coordinates. -! uxl x-derivatives of u at the left (west) edge of given interval -! vxl x-derivatives of v at the left (west) edge of given interval -! uxr x-derivatives of u at the right (east) edge of given interval -! vxr x-derivatives of v at the right (east) edge of given interval -! lam Longitude values for the extended grid. -! phib Latitude values for the extended grid. -! lbasiy Weights for Lagrange cubic interpolation on the unequally -! spaced latitude grid. -! lammp Longitude coordinates of the trajectory mid-points of the -! parcels that correspond to the global grid points contained -! in the latitude slice being forecast. On entry lammp -! is an initial guess. -! phimp Latitude coordinates of the trajectory mid-points of the -! parcels that correspond to the global grid points contained -! in the latitude slice being forecast. On entry phimp -! is an initial guess. -! lamdp Longitude coordinates of the departure points that correspond -! to the global grid points contained in the latitude slice -! being forecast. lamdp is constrained so that -! 0.0 .le. lamdp(i) .lt. 2*pi . -! phidp Latitude coordinates of the departure points that correspond -! to the global grid points contained in the latitude slice -! being forecast. If phidp is computed outside the latitudinal -! domain of the extended grid, then an abort will be called by -! subroutine "trjgl". -! idp Longitude index of departure points. This index points into -! the extended arrays, e.g., -! lam (idp(i,k)) .le. lamdp(i,k) .lt. lam (idp(i,k)+1). -! jdp Latitude index of departure points. This index points into -! the extended arrays, e.g., -! phib(jdp(i,k)) .le. phidp(i,k) .lt. phib(jdp(i,k)+1). -!----------------------------------------------------------------------- - - !------------------------ local variables ------------------------------ - integer iter ! index - integer i, j, k ! indices - integer imax, imin, kmin, kmax ! indices - real(r8) finc ! time step factor - real(r8) dttmp ! time step (seconds) - real(r8) dlam(platd) ! increment of grid in x-direction - real(r8) phicen ! latitude coord of current lat slice - real(r8) cphic ! cos(phicen) - real(r8) sphic ! sin(phicen) - real(r8) upr (plon,plev) ! u in local geodesic coords - real(r8) vpr (plon,plev) ! v in local geodesic coords - real(r8) lampr(plon,plev) ! relative long coord of dep pt - real(r8) phipr(plon,plev) ! relative lat coord of dep pt - real(r8) uvmp (plon,plev,2) ! u/v (spherical) interpltd to dep pt - real(r8) fint (plon,plev,ppdy,2) ! u/v x-interpolants - real(r8) phidpmax - real(r8) phidpmin - real(r8) phimpmax - real(r8) phimpmin -!----------------------------------------------------------------------- -! - do j=1,platd - dlam(j) = lam(nxpt+2,j) - lam(nxpt+1,j) - end do - phicen = phib(jcen) - cphic = cos( phicen ) - sphic = sin( phicen ) -! -! Convert latitude coordinates of trajectory midpoints from spherical -! to local geodesic basis. -! - if( locgeo ) call s2gphi(lam(i1,jcen) ,cphic ,sphic ,lammp ,phimp, & - phipr ,nlon ) -! -! Loop over departure point iterates. -! - do 30 iter = 1,iterdp -! -! Compute midpoint indicies. -! - call bandij(dlam ,phib ,lammp ,phimp ,idp , & - jdp ,nlon ) -! -! Hermite cubic interpolation to the x-coordinate of each -! departure point at each y-coordinate required to compute the -! y-interpolants. -! - call herxin(1 ,1 ,ub ,uxl ,uxr , & - lam ,lammp ,idp ,jdp ,fint(1,1,1,1), & - nlon ,nlonex ) - - call herxin(1 ,1 ,vb ,vxl ,vxr , & - lam ,lammp ,idp ,jdp ,fint(1,1,1,2), & - nlon ,nlonex ) - - call lagyin(2 ,fint ,lbasiy ,phimp ,jdp , & - jcen ,uvmp ,nlon ) -! -! Put u/v on unit sphere -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k = 1,plev - do i = 1,nlon - uvmp(i,k,1) = uvmp(i,k,1)*ra - uvmp(i,k,2) = uvmp(i,k,2)*ra - end do - end do -! -! For local geodesic: -! -! a) Convert velocity coordinates at trajectory midpoints from -! spherical coordinates to local geodesic coordinates, -! b) Estimate midpoint parcel trajectory, -! c) Convert back to spherical coordinates -! -! Else, for global spherical -! -! Estimate midpoint trajectory with no conversions -! - if ( locgeo ) then - call s2gvel(uvmp(1,1,1),uvmp(1,1,2) ,lam(i1,jcen) ,cphic ,sphic , & - lammp ,phimp ,upr ,vpr ,nlon ) - call trajmp(dt ,upr ,vpr ,phipr ,lampr , & - nlon ) - dttmp = 0.5_r8*dt - call g2spos(dttmp ,lam(i1,jcen) ,phib ,phicen ,cphic , & - sphic ,upr ,vpr ,lampr ,phipr , & - lammp ,phimp ,nlon ) - else - call trjmps(dt ,uvmp(1,1,1) ,uvmp(1,1,2), phimp ,lampr , & - phipr ,nlon ) - finc = 1._r8 - call trjgl (finc ,phicen ,lam(i1,jcen) ,lampr ,phipr , & - lammp ,phimp ,nlon ) - end if -! -! Test that the latitudinal extent of trajectory is NOT over the poles -! Distributed memory case: check that the latitudinal extent of the -! trajectory is not more than "jintmx" gridpoints away. -! - phimpmax = -1.e36_r8 - phimpmin = 1.e36_r8 - do k=1,plev - do i=1,nlon - if (phimp(i,k)>phimpmax) then - phimpmax = phimp(i,k) - imax = i - kmax = k - end if - if (phimp(i,k)= phib(endlatex-nxpt) ) then -#else - if ( phimp(imax,kmax) >= phib(j1+plat) ) then -#endif - write(iulog,*)'SPHDEP: ****** MODEL IS BLOWING UP: CFL condition likely violated *********' - write(iulog,9000) imax,kmax,jgc - write(iulog,*)' Possible solutions: a) reduce time step' - write(iulog,*)' b) if initial run, set "DIVDAMPN = 1." in namelist and rerun' - write(iulog,*)' c) modified code may be in error' - call endrun -#if ( defined SPMD ) - else if( phimp(imin,kmin) < phib(beglatex+nxpt) ) then -#else - else if( phimp(imin,kmin) < phib(j1-1) ) then -#endif - write(iulog,*)'SPHDEP: ****** MODEL IS BLOWING UP: CFL condition likely violated *********' - write(iulog,9000) imin,kmin,jgc - write(iulog,*)' Possible solutions: a) reduce time step' - write(iulog,*)' b) if initial run, set "DIVDAMPN = 1." in namelist and rerun' - write(iulog,*)' c) modified code may be in error' - call endrun - end if - -30 continue ! End of iter=1,iterdp loop -! -! Compute departure points in geodesic coordinates, and convert back -! to spherical coordinates. -! -! Else, compute departure points directly in spherical coordinates -! - if (locgeo) then -!$OMP PARALLEL DO PRIVATE (K, I) - do k = 1,plev - do i = 1,nlon - lampr(i,k) = 2._r8*lampr(i,k) - phipr(i,k) = 2._r8*phipr(i,k) - end do - end do - dttmp = dt - call g2spos(dttmp ,lam(i1,jcen) ,phib ,phicen ,cphic , & - sphic ,upr ,vpr ,lampr ,phipr , & - lamdp ,phidp ,nlon ) - else - finc = 2._r8 - call trjgl (finc ,phicen ,lam(i1,jcen) ,lampr ,phipr , & - lamdp ,phidp ,nlon ) - end if -! -! Test that the latitudinal extent of trajectory is NOT over the poles -! Distributed memory case: check that the latitudinal extent of the -! trajectory is not more than "jintmx" gridpoints away. -! - phidpmax = -1.e36_r8 - phidpmin = 1.e36_r8 - do k=1,plev - do i=1,nlon - if (phidp(i,k)>phidpmax) then - phidpmax = phidp(i,k) - imax = i - kmax = k - end if - if (phidp(i,k)= phib(endlatex-nxpt) ) then -#else - if ( phidp(imax,kmax) >= phib(j1+plat) ) then -#endif - write(iulog,*)'SPHDEP: ****** MODEL IS BLOWING UP: CFL condition likely violated *********' - write(iulog,9000) imax,kmax,jgc - write(iulog,*)' Possible solutions: a) reduce time step' - write(iulog,*)' b) if initial run, set "DIVDAMPN = 1." in namelist and rerun' - write(iulog,*)' c) modified code may be in error' - call endrun -#if ( defined SPMD ) - else if( phidp(imin,kmin) < phib(beglatex+nxpt) ) then -#else - else if( phidp(imin,kmin) < phib(j1-1) ) then -#endif - write(iulog,*)'SPHDEP: ****** MODEL IS BLOWING UP: CFL condition likely violated *********' - write(iulog,9000) imin,kmin,jgc - write(iulog,*)' Possible solutions: a) reduce time step' - write(iulog,*)' b) if initial run, set "DIVDAMPN = 1." in namelist and rerun' - write(iulog,*)' c) modified code may be in error' - call endrun - end if -! -! Compute departure point indicies. -! - call bandij(dlam ,phib ,lamdp ,phidp ,idp , & - jdp ,nlon ) - -9000 format(//'Parcel associated with longitude ',i5,', level ',i5, & - ' and latitude ',i5,' is outside the model domain.') - - return -end subroutine sphdep - -!============================================================================================ - -subroutine g2spos(dttmp ,lam ,phib ,phi ,cosphi , & - sinphi ,upr ,vpr ,lamgc ,phigc , & - lamsc ,phisc ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Transform position coordinates for a set of points, each of which is -! associated with a grid point in a global latitude slice, from local -! geodesic to spherical coordinates. -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev, plat - use scanslt, only: plond1, platd, j1 - implicit none - -!------------------------------Arguments-------------------------------- - real(r8), intent(in) :: dttmp ! time step - real(r8), intent(in) :: lam(plond1) ! model longitude coordinates - real(r8), intent(in) :: phib(platd) ! extended grid latitude coordinates - real(r8), intent(in) :: phi ! current latitude coordinate (radians) - real(r8), intent(in) :: cosphi ! cos of current latitude - real(r8), intent(in) :: sinphi ! sin of current latitude - real(r8), intent(in) :: upr (plon,plev) ! u-wind in geodesic coord - real(r8), intent(in) :: vpr (plon,plev) ! v-wind in geodesic coord - real(r8), intent(in) :: lamgc(plon,plev) ! geodesic long coord. of dep. point - real(r8), intent(in) :: phigc(plon,plev) ! geodesic lat coord. of dep. point - integer , intent(in) :: nlon ! longitude dimension - real(r8), intent(out):: lamsc(plon,plev) ! spherical long coord. of dep. point - real(r8), intent(out):: phisc(plon,plev) ! spherical lat coord. of dep. point -! -! -! dttmp Time step over which midpoint/endpoint trajectory is -! calculated (seconds). -! lam Longitude coordinates of the global grid points in spherical -! system. The grid points in the global array are the reference -! points for the local geodesic systems. -! phib Latitude values for the extended grid. -! phi Latitude coordinate (in the global grid) of the current -! latitude slice. -! cosphi cos( phi ) -! sinphi sin( phi ) -! upr zonal velocity at departure point in local geodesic coord -! vpr Meridional velocity at departure point in local geodesic coord -! lamgc Longitude coordinate of points in geodesic coordinates. -! phigc Latitude coordinate of points in geodesic coordinates. -! lamsc Longitude coordinate of points in spherical coordinates. -! phisc Latitude coordinate of points in spherical coordinates. -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i,ii,k ! indices - integer nval(plev) ! number of values returned from whenfgt - integer indx(plon,plev) ! index holder - real(r8) pi ! 4.*atan(1.) - real(r8) twopi ! 2.*pi - real(r8) pi2 ! pi/2 - real(r8) sgnphi ! holds sign of phi - real(r8) sphigc ! sin(phigc) - real(r8) cphigc ! cos(phigc) - real(r8) clamgc ! cos(lamgc) - real(r8) slam2 ! sin(lamgc)**2 - real(r8) phipi2 ! tmp variable - real(r8) slamgc(plon,plev) ! sin(lamgc) - real(r8) dlam(plon,plev) ! zonal extent of trajectory - real(r8) coeff ! tmp variable - real(r8) distmx ! max distance - real(r8) dist(plon,plev) ! approx. distance traveled along traj. - real(r8) fac ! 1. - 10*eps, eps from mach. precision - integer s_nval -!----------------------------------------------------------------------- -! - fac = 1._r8 - 10._r8*epsilon (fac) - pi = 4._r8*atan(1._r8) - twopi = pi*2._r8 - pi2 = pi/2._r8 - coeff = (1.1_r8*dttmp)**2 - distmx = (sign(pi2,phi) - phi)**2/coeff - sgnphi = sign( 1._r8, phi ) - -!$OMP PARALLEL DO PRIVATE (K, I, SPHIGC, CPHIGC, CLAMGC, S_NVAL) - do k=1,plev - do i=1,nlon - sphigc = sin( phigc(i,k) ) - cphigc = cos( phigc(i,k) ) - slamgc(i,k) = sin( lamgc(i,k) ) - clamgc = cos( lamgc(i,k) ) - phisc(i,k) = asin((sphigc*cosphi + cphigc*sinphi*clamgc)*fac) - if ( abs(phisc(i,k)) .ge. phib(j1+plat)*fac ) then - phisc(i,k) = sign( phib(j1+plat),phisc(i,k) )*fac - end if - dlam(i,k) = asin((slamgc(i,k)*cphigc/cos(phisc(i,k)))*fac) -! -! Compute estimated trajectory distance based upon winds alone -! - dist(i,k) = upr(i,k)**2 + vpr(i,k)**2 - end do -! -! Determine which trajectories may have crossed over pole -! - s_nval = 0 - do i=1,nlon - if (dist(i,k) > distmx) then - s_nval = s_nval + 1 - indx(s_nval,k) = i - end if - end do - nval(k) = s_nval - end do -! -! Check that proper branch of arcsine is used for calculation of -! dlam for those trajectories which may have crossed over pole. -! -!$OMP PARALLEL DO PRIVATE (K, II, I, SLAM2, PHIPI2) - do k=1,plev - do ii=1,nval(k) - i = indx(ii,k) - slam2 = slamgc(i,k)**2 - phipi2 = asin((sqrt((slam2 - 1._r8)/(slam2 - 1._r8/cosphi**2)))*fac) - if (sgnphi*phigc(i,k) > phipi2) then - dlam(i,k) = sign(pi,lamgc(i,k)) - dlam(i,k) - end if - end do - - do i=1,nlon - lamsc(i,k) = lam(i) + dlam(i,k) -! -! Restrict longitude to be in the range [0, twopi). -! - if( lamsc(i,k) >= twopi ) lamsc(i,k) = lamsc(i,k) - twopi - if( lamsc(i,k) < 0.0_r8 ) lamsc(i,k) = lamsc(i,k) + twopi - end do - end do - - return -end subroutine g2spos - -!============================================================================================ - -subroutine s2gphi(lam ,cosphi ,sinphi ,lamsc ,phisc , & - phigc ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate transformed local geodesic latitude coordinates for a set -! of points, each of which is associated with a grid point in a global -! latitude slice. Transformation is spherical to local geodesic. -! (Williamson and Rasch, 1991) -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev - use scanslt, only: plond1 - implicit none - -!------------------------------Arguments-------------------------------- - real(r8), intent(in) :: lam(plond1) ! long coordinates of model grid - real(r8), intent(in) :: cosphi ! cos(latitude) - real(r8), intent(in) :: sinphi ! sin(latitude) - real(r8), intent(in) :: lamsc(plon,plev) ! spher. long coords of dep points - real(r8), intent(in) :: phisc(plon,plev) ! spher. lat coords of dep points - integer , intent(in) :: nlon ! longitude dimension - real(r8), intent(out) :: phigc(plon,plev) ! loc geod. lat coords of dep points -! -! lam longitude coordinates of the global grid points in spherical -! system. The grid points in the global array are the reference -! points for the local geodesic systems. -! cosphi cosine of the latitude of the global latitude slice. -! sinphi sine of the latitude of the global latitude slice. -! lamsc longitude coordinate of dep. points in spherical coordinates. -! phisc latitude coordinate of dep. points in spherical coordinates. -! phigc latitude coordinate of dep. points in local geodesic coords. -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i,k ! longitude, level indices - real(r8) sphisc ! | - real(r8) cphisc ! | -- temporary variables - real(r8) clamsc ! | -!----------------------------------------------------------------------- -! -!$OMP PARALLEL DO PRIVATE (K, I, SPHISC, CPHISC, CLAMSC) - do k = 1,plev - do i = 1,nlon - sphisc = sin( phisc(i,k) ) - cphisc = cos( phisc(i,k) ) - clamsc = cos( lam(i) - lamsc(i,k) ) - phigc(i,k) = asin( sphisc*cosphi - cphisc*sinphi*clamsc ) - end do - end do - - return -end subroutine s2gphi - -!============================================================================================ - -subroutine s2gvel(udp ,vdp ,lam ,cosphi ,sinphi , & - lamdp ,phidp ,upr ,vpr ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Transform velocity components at departure points associated with a -! single latitude slice from spherical coordinates to local geodesic -! coordinates. (Williamson and Rasch, 1991) -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev - use scanslt, only: plond1 - implicit none - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: nlon ! longitude dimension - real(r8), intent(in) :: udp(plon,plev) ! u in spherical coords. - real(r8), intent(in) :: vdp(plon,plev) ! v in spherical coords. - real(r8), intent(in) :: lam(plond1) ! x-coordinates of model grid - real(r8), intent(in) :: cosphi ! cos(latitude) - real(r8), intent(in) :: sinphi ! sin(latitude) - real(r8), intent(in) :: lamdp(plon,plev) ! spherical longitude coord of dep pt. - real(r8), intent(in) :: phidp(plon,plev) ! spherical latitude coord of dep pt. - real(r8), intent(out) :: upr(plon,plev) ! u in local geodesic coords. - real(r8), intent(out) :: vpr(plon,plev) ! v in local geodesic coords. -! -! udp u-component of departure point velocity in spherical coords. -! vdp v-component of departure point velocity in spherical coords. -! lam Longitude of arrival point position (model grid point) in spherical coordinates. -! cosphi Cos of latitude of arrival point positions (model grid pt). -! sinphi Sin of latitude of arrival point positions (model grid pt). -! lamdp Longitude of departure point position in spherical coordinates. -! phidp Latitude of departure point position in spherical coordinates. -! upr u-component of departure point velocity in geodesic coords. -! vpr v-component of departure point velocity in geodesic coords. -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i,k ! longitude, level indices - real(r8) cdlam ! | - real(r8) clamp ! | - real(r8) cphid ! | - real(r8) cphip ! | - real(r8) dlam ! | -- temporary variables - real(r8) sdlam ! | - real(r8) slamp ! | - real(r8) sphid ! | - real(r8) sphip ! | -!----------------------------------------------------------------------- -! -!$OMP PARALLEL DO PRIVATE (K, I, DLAM, SDLAM, CDLAM, SPHID, CPHID, SPHIP, & -!$OMP CPHIP, SLAMP, CLAMP) - do k = 1,plev - do i = 1,nlon - dlam = lam(i) - lamdp(i,k) - sdlam = sin( dlam ) - cdlam = cos( dlam ) - sphid = sin( phidp(i,k) ) - cphid = cos( phidp(i,k) ) - sphip = sphid*cosphi - cphid*sinphi*cdlam - cphip = cos( asin( sphip ) ) - slamp = -sdlam*cphid/cphip - clamp = cos( asin( slamp ) ) - vpr(i,k) = (vdp(i,k)*(cphid*cosphi + sphid*sinphi*cdlam) - & - udp(i,k)*sinphi*sdlam)/cphip - upr(i,k) = (udp(i,k)*cdlam + vdp(i,k)*sphid*sdlam + & - vpr(i,k)*slamp*sphip)/clamp - end do - end do - - return -end subroutine s2gvel - -!============================================================================================ - -subroutine trajmp(dt ,upr ,vpr ,phipr ,lampr , & - nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Estimate mid-point of parcel trajectory (geodesic coordinates) based -! upon horizontal wind field. -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev - implicit none - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: nlon ! longitude dimension - real(r8), intent(in) :: dt ! time step (seconds) - real(r8), intent(in) :: upr(plon,plev) ! u-component of wind in local geodesic - real(r8), intent(in) :: vpr(plon,plev) ! v-component of wind in local geodesic - real(r8), intent(inout) :: phipr(plon,plev) ! latitude coord of trajectory mid-point - real(r8), intent(out) :: lampr(plon,plev) ! longitude coord of traj. mid-point -! -! dt Time interval that corresponds to the parcel trajectory. -! upr u-coordinate of velocity corresponding to the most recent -! estimate of the trajectory mid-point (in geodesic system). -! vpr v-coordinate of velocity corresponding to the most recent -! estimate of the trajectory mid-point (in geodesic system). -! phipr Phi value at trajectory mid-point (geodesic coordinates). -! On entry this is the most recent estimate. -! lampr Lambda value at trajectory mid-point (geodesic coordinates). -!----------------------------------------------------------------------- - -!---------------------------Local variables----------------------------- - integer i,k ! index -!----------------------------------------------------------------------- -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i = 1,nlon - lampr(i,k) = -.5_r8*dt* upr(i,k) / cos( phipr(i,k) ) - phipr(i,k) = -.5_r8*dt* vpr(i,k) - end do - end do - - return -end subroutine trajmp - -!============================================================================================ - -subroutine trjgl(finc ,phicen ,lam ,lampr ,phipr , & - lamp ,phip ,nlon ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Map relative trajectory mid/departure point coordinates to global -! latitude/longitude coordinates and test limits -! -! Method: -! -! Author: J. Olson -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev - use scanslt, only: plond1 - implicit none - -!------------------------------Arguments-------------------------------- - integer , intent(in) :: nlon ! longitude dimension - real(r8), intent(in) :: finc ! number of time increments - real(r8), intent(in) :: phicen ! current latitude value in extnded grid - real(r8), intent(in) :: lam(plond1) ! longitude values for the extended grid - real(r8), intent(in) :: lampr(plon,plev) ! relative x-coordinate of departure pt. - real(r8), intent(in) :: phipr(plon,plev) ! relative y-coordinate of departure pt. - real(r8), intent(out) :: lamp (plon,plev) ! long coords of traj midpoints - real(r8), intent(out) :: phip (plon,plev) ! lat coords of traj midpoints -! -! finc Time step factor (1. for midpoint, 2. for dep. point) -! phicen Latitude value for current latitude being forecast. -! lam Longitude values for the extended grid. -! lampr Longitude coordinates (relative to the arrival point) of the -! trajectory mid-points of the parcels that correspond to the -! global grid points contained in the latitude slice being forecast. -! phipr Latitude coordinates (relative to the arrival point) of the -! trajectory mid-points of the parcels that correspond to the -! global grid points contained in the latitude slice being forecast. -! lamp Longitude coordinates of the trajectory mid-points of the -! parcels that correspond to the global grid points contained -! in the latitude slice being forecast. -! phip Latitude coordinates of the trajectory mid-points of the -! parcels that correspond to the global grid points contained -! in the latitude slice being forecast. -!----------------------------------------------------------------------- - -!--------------------------Local variables------------------------------ - integer i ! longitude index - integer k ! level index - real(r8) pi ! 3.14....... - real(r8) twopi ! 2*pi -!----------------------------------------------------------------------- -! - pi = 4._r8*atan(1._r8) - twopi = pi*2._r8 -!$OMP PARALLEL DO PRIVATE (K, I) - do k = 1,plev - do i = 1,nlon - lamp(i,k) = lam(i) + finc*lampr(i,k) - phip(i,k) = phicen + finc*phipr(i,k) - if(lamp(i,k) >= twopi) lamp(i,k) = lamp(i,k) - twopi - if(lamp(i,k) < 0.0_r8) lamp(i,k) = lamp(i,k) + twopi - end do - end do - - return -end subroutine trjgl - diff --git a/src/dynamics/eul/spmd_dyn.F90 b/src/dynamics/eul/spmd_dyn.F90 deleted file mode 100644 index b9928fe43f..0000000000 --- a/src/dynamics/eul/spmd_dyn.F90 +++ /dev/null @@ -1,1111 +0,0 @@ -module spmd_dyn - -!----------------------------------------------------------------------- -! -! Purpose: SPMD implementation of CAM spectral Eulerian dynamics. -! -! Author: CCM Core Group -! Modified: P. Worley, September 2002, November 2003, December 2003, -! November 2004, January 2005, April 2007 -! -!----------------------------------------------------------------------- - -#if (defined SPMD) - - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plat, numlats, & - beglat, endlat, begirow, endirow, plev - use spmd_utils, only: iam, masterproc, npes, proc_smp_map - use scamMod, only: single_column - use scanslt, only: beglatex, endlatex, numbnd, numlatsex - use mpishorthand, only: mpir8, mpicom - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - - implicit none - - private - save - - public spmdinit_dyn, compute_gsfactors, spmdbuf - public spmd_readnl - - logical, public :: local_dp_map=.false. ! flag indicates that mapping between dynamics - ! and physics decompositions does not require - ! interprocess communication - integer, public :: block_buf_nrecs ! number of local grid points (lon,lat,lev) - ! in dynamics decomposition (including level 0) - integer, public :: chunk_buf_nrecs ! number of local grid points (lon,lat,lev) - ! in physics decomposition (including level 0) - - integer, public, allocatable :: & - cut(:,:), &! partition for MPI tasks - cutex(:,:) ! extended partition - integer, public :: proc(plat) ! MPI task id associated with a given lat. - integer, public :: neighs ! number of south neighbors to comm guardcells - integer, public, allocatable :: neighs_proc(:) ! sorted south process neighbors - integer, public :: neighn ! number of north neighbors to comm guardcells - integer, public, allocatable :: neighn_proc(:) ! sorted north process neighbors - integer, public :: npessp ! number of MPI tasks in spectral space - integer, public :: maxlats ! max number of lats on any MPI task - integer, public :: maxcols ! max number of columns on any MPI task - integer, public, allocatable :: nlat_p(:) ! number of latitudes per MPI task - integer, public, allocatable :: ncol_p(:) ! number of columns per MPI task - integer, public :: realloc4_steps ! number of swaps in realloc4 algorithms - integer, public, allocatable :: realloc4_proc(:) - ! swap partner in each step of - ! realloc4 algorithms - integer, public, allocatable :: realloc4_step(:) - ! step in realloc4 algorithms - ! in which communicate with a given - ! process - integer, public :: allgather_steps ! number of swaps in allgather algorithm - integer, public, allocatable :: allgather_proc(:) - ! swap partner in each step of - ! allgather (realloc5/7) algorithm - integer, public, allocatable :: allgather_step(:) - ! step in allgather (realloc5/7) algorithm - ! in which communicate with a given - ! process -! - logical, private, parameter :: def_equi_by_col = .true. ! default - logical, private :: dyn_equi_by_col = def_equi_by_col - ! flag indicating whether to assign - ! latitudes to equidistribute columns or - ! latitudes. This only matters when using a - ! reduced grid. -! - logical, private, parameter :: def_mirror = .false. ! default - logical, private :: mirror = def_mirror ! flag indicating whether latitudes and their - ! reflections across the equator should assigned - ! to consecutive processes -! -! Dynamics communication transpose algorithm option: -! 0: use mpi_alltoallv -! 1: use point-to-point MPI-1 two-sided implementation -! 2: use point-to-point MPI-2 one-sided implementation if supported, -! otherwise use MPI-1 implementation -! 3: use Co-Array Fortran implementation if supported, -! otherwise use MPI-1 implementation - integer, private, parameter :: min_alltoall = 0 - integer, private, parameter :: max_alltoall = 3 - integer, private, parameter :: def_alltoall = 0 ! default - integer, public :: dyn_alltoall = def_alltoall -! -! Dynamics communication allgather (realloc5/7) algorithm option: -! 0: use mpi_allgatherv -! 1: use point-to-point MPI-1 two-sided implementation -! 2: use point-to-point MPI-2 one-sided implementation if supported, -! otherwise use MPI-1 implementation -! 3: use Co-Array Fortran implementation if supported, -! otherwise use MPI-1 implementation - integer, private, parameter :: min_allgather = 0 - integer, private, parameter :: max_allgather = 3 - integer, private, parameter :: def_allgather = 0 ! default - integer, public :: dyn_allgather = def_allgather -! -! Dynamics dyn_npes option: -! 1 <= dyn_npes <= min( 2*(npes/2), plat ) - integer, private, parameter :: min_npes = 1 - integer, private, parameter :: max_npes = plat - integer, private, parameter :: def_npes = plat - integer, public :: dyn_npes = def_npes -! -! Dynamics dyn_npes_stride option: -! 1 <= dyn_npes_stride <= npes/dyn_npes - integer, private, parameter :: min_npes_stride = 1 - integer, private, parameter :: max_npes_stride = plat - integer, private, parameter :: def_npes_stride = 1 - integer, public :: dyn_npes_stride = def_npes_stride -! -! MPI communicator for active dynamics processes -! - integer, public :: mpicom_dyn_active -! -! Collective communication send/receive buffers -#if (defined CAF) - real(r8), public, allocatable :: buf1(:)[:],buf2(:)[:] ! buffers for packing MPI msgs -#else - real(r8), public, allocatable :: buf1(:),buf2(:) ! buffers for packing MPI msgs -#endif - integer, public :: spmdbuf_siz = 0 ! buffer size (in r8s) - integer, public :: buf1win ! buf1 Window id - integer, public :: buf2win ! buf2 Window id - -contains - -!---------------------------------------------------------------------- - - subroutine spmd_readnl(nlfilename) - - ! !USES: - use units, only: getunit, freeunit - use namelist_utils, only: find_group_name - use spmd_utils, only: npes, masterproc - use pmgrid, only: plat, plev, plon - use mpishorthand - - implicit none - - ! - ! !PARAMETERS: - character(len=*), intent(in) :: nlfilename - -! !DESCRIPTION: Read in EUL-specific namelist variables. Must be -! performed before dyn\_init -! -! !REVISION HISTORY: -! 2010.05.15 Sawyer Creation -! -!EOP -!========================================================================= -!BOC -! Local variables - integer :: ierr ! error code - integer :: unitn ! namelist unit number - character(len=*), parameter :: subname = "spmd_readnl" - - namelist /spmd_dyn_inparm/ dyn_alltoall, & - dyn_allgather, & - dyn_equi_by_col,& - dyn_npes, & - dyn_npes_stride - - if (masterproc) then - write(iulog,*) 'Read in spmd_dyn_inparm namelist from: ', trim(nlfilename) - unitn = getunit() - open( unitn, file=trim(nlfilename), status='old' ) - - ! Look for dyn_eul_inparm group name in the input file. If found, leave the - ! file positioned at that namelist group. - call find_group_name(unitn, 'spmd_dyn_inparm', status=ierr) - if (ierr == 0) then ! found spmd_dyn_inparm - read(unitn, spmd_dyn_inparm, iostat=ierr) ! read the spmd_dyn_inparm namelist group - if (ierr /= 0) then - call endrun( subname//':: namelist read returns an'// & - ' error condition for spmd_dyn_inparm' ) - end if - end if - close( unitn ) - call freeunit( unitn ) - endif - - call mpibcast (dyn_alltoall ,1,mpiint,0,mpicom) - call mpibcast (dyn_allgather ,1,mpiint,0,mpicom) - call mpibcast (dyn_equi_by_col,1,mpilog,0,mpicom) - call mpibcast (dyn_npes ,1,mpiint,0,mpicom) - call mpibcast (dyn_npes_stride,1,mpiint,0,mpicom) - - if ((dyn_alltoall.lt.min_alltoall).or. & - (dyn_alltoall.gt.max_alltoall)) then - write(iulog,*) & - 'spmd_readnl: ERROR: dyn_alltoall=', & - dyn_alltoall, & - ' is out of range. It must be between ', & - min_alltoall,' and ',max_alltoall - call endrun - endif - - if ((dyn_allgather.lt.min_allgather).or. & - (dyn_allgather.gt.max_allgather)) then - write(iulog,*) & - 'spmd_readnl: ERROR: dyn_allgather=', & - dyn_allgather, & - ' is out of range. It must be between ', & - min_allgather,' and ',max_allgather - call endrun - endif - ! - if ((dyn_npes.lt.min_npes).or. & - (dyn_npes.gt.max_npes)) then - write(iulog,*) & - 'spmd_readnl: ERROR: dyn_npes=', & - dyn_npes, & - ' is out of range. It must be between ', & - min_npes,' and ',max_npes - call endrun - endif - ! - if ((dyn_npes_stride.lt.min_npes_stride).or. & - (dyn_npes_stride.gt.max_npes_stride)) then - write(iulog,*) & - 'spmd_readnl: ERROR: dyn_npes_stride=', & - dyn_npes_stride, & - ' is out of range. It must be between ', & - min_npes_stride,' and ',max_npes_stride - call endrun - endif - - - end subroutine spmd_readnl - - -!======================================================================== - - subroutine spmdinit_dyn () -!----------------------------------------------------------------------- -! -! Purpose: Distribute latitudes among available processes -! -! Method: Distribution is S->N for processes 0->dyn_npes -! -! Author: CCM Core Group -! Modified: P. Worley, November 2003 to improve SMP load balance, and to -! change distribution to -! S->E for processes 0,2,..,dyn_npes-2 -! and -! N->E for processes 1,3,..,dyn_npes-1 -! when mirror flag is set (at request of physics) -! Modified: P. Worley, November 2004 to improve load balance for -! reduced grid by equidistributing columns (not latitudes) -! in latitude decomposition. Used when equi_by_col flag is set. -! On by default, and gives identical decomposition as -! equidistributing by latitude when using a full grid. -! Modified: P. Worley, April 2007 to support idle processes when -! in the dynamics (dyn_npes < npes) -! -!----------------------------------------------------------------------- - use comspe, only: numm - use spmd_utils -#if (defined MODCM_DP_TRANSPOSE) - use parutilitiesmodule, only : parinit -#endif -!----------------------------------------------------------------------- -! -! Local workspace -! - integer i ! loop index - integer tot_cols ! total number of columns in computational grid - integer m2,m3,m5 ! 2, 3, 5 prime factors for problem decomposition - integer tot_nx ! total number of latitudes/columns in - ! computational grid - integer nx_base ! approx. number of latitudes/columns per proc - integer nx_p(0:npes-1) ! number of latitudes/columns per process - integer nx_smp(0:npes-1) ! number of latitudes/columns per SMP - integer nproc_smp(0:npes-1) ! number of MPI processes per SMP - integer workleft ! amount of work still to be parcelled out - - integer smpid ! SMP id - integer smpids ! SMP id for SH process - integer smpidn ! SMP id for NH process - integer procj ! process offset loop index - integer procid ! process id - integer procids ! process id SH - integer procidn ! process id NH - integer procid_s ! strided process id - integer procids_s ! strided process id SH - integer procidn_s ! strided process id NH - - integer max_ncols ! maximum number of columns assigned to a process - integer min_max_ncols ! minmax number of columns assigned - ! to a process over all latitude assignments - integer ncol ! number of columns assigned to current process - integer ncol_curtot ! current total number of columns assigned - integer ncol_curgoal ! target number of columns to be assigned to process - integer lat ! latitude index - integer iend ! ending latitude band of work for a given proc - integer neighn_minlat(plat) ! minimum latitude in north neighbor - integer neighs_maxlat(plat) ! maximum latitude in south neighbor - integer active_proc ! +1 for active dynamics processes - integer ierror ! MPI error return - - real(r8) avgnx_proc(0:npes-1) ! average number of latitudes/columns per - ! MPI process in a given SMP node - real(r8) minavgnx_proc ! minimum average number of - ! latitudes/columns per - ! MPI process over SMP nodes - real(r8) alpha ! slop factor in assigning latitudes to processes - real(r8) opt_alpha! best slop factor in assigning latitudes to processes - - logical done ! exit flag for latitude assignment loop -! -!----------------------------------------------------------------------- -! -! Initialize Pilgrim library -! -#if (defined MODCM_DP_TRANSPOSE) - call parinit(mpicom) -#endif -! -! Initialize mirror flag -! - mirror = phys_mirror_decomp_req -! -! Allocate memory for MPI task partition array -! and extended partition -! - allocate (cut (2,0:npes-1)) - cut(1,0:npes-1) = 1 - cut(2,0:npes-1) = 0 -! - allocate (cutex(2,0:npes-1)) - cutex(1,0:npes-1) = 1 - cutex(2,0:npes-1) = 0 -! -! Allocate memory for number of lats per proc -! - allocate (nlat_p (0:npes-1)) - nlat_p(0:npes-1) = 0 -! -! Allocate memory for number of columns per proc -! - allocate (ncol_p (0:npes-1)) - ncol_p(0:npes-1) = 0 -! -! determine total number of columns -! - tot_cols = 0 - do lat=1,plat - tot_cols = tot_cols + plon - enddo -! -! Make sure number of PEs, latitudes, and columns are kosher -! - call factor (plat, m2, m3, m5) - - if (.not. single_column) then - if (m2 < 1) then - call endrun('SPMDINIT_DYN: Problem size is not divisible by 2') - end if - end if - - - if (masterproc) then - write(iulog,*) 'Problem factors: 2**',m2,' * 3**',m3,' * 5**',m5 - end if - - if (npes > 1) then - if (dyn_npes > min( 2*(npes/2), plat ) ) then - dyn_npes = min( 2*(npes/2), plat ) - endif - if (dyn_npes_stride > npes/dyn_npes) then - dyn_npes_stride = npes/dyn_npes - endif - else - dyn_npes = 1 - dyn_npes_stride = 1 - endif - - if (.not. single_column) then - if ((dyn_equi_by_col) .and. (mod(tot_cols,2) /= 0)) then - write(iulog,*)'SPMDINIT_DYN: Total number of columns(', & - tot_cols,') must be a multiple of 2' - call endrun('SPMDINIT_DYN: number of columns must be multiple of 2') - end if - end if -! -! Initialization for inactive processes -! - beglat = 1 - endlat = 0 - numlats = 0 - begirow = 1 - endirow = 0 - - beglatex = 1 - endlatex = 0 - numlatsex = 0 -! -! Special initialization for dyn_npes == 1 case -! - if (dyn_npes .eq. 1) then -! - nlat_p(0) = plat - cut(1,0) = 1 - cut(2,0) = plat -! - ncol_p(0) = 0 - do lat=1,plat - ncol_p(0) = ncol_p(0) + plon - enddo -! - if (iam .eq. 0) then - beglat = 1 - endlat = plat - numlats = plat - begirow = 1 - endirow = plat/2 - endif -! - else -! -! Determine approximate number of columns or latitudes per process -! - if (dyn_equi_by_col) then - tot_nx = tot_cols - else - tot_nx = plat - endif - nx_base = tot_nx/dyn_npes - do procid=0,dyn_npes-1 - procid_s = dyn_npes_stride*procid - nx_p(procid_s) = nx_base - enddo -! -! Calculate initial distribution of columns or latitudes and -! distribution of processes by SMP -! - nx_smp(0:npes-1) = 0 - nproc_smp(0:npes-1) = 0 - do procid=0,dyn_npes-1 - procid_s = dyn_npes_stride*procid - smpid = proc_smp_map(procid_s) - nproc_smp(smpid) = nproc_smp(smpid) + 1 - enddo -! - do smpid=0,nsmps-1 - nx_smp(smpid) = nx_base*nproc_smp(smpid) - avgnx_proc(smpid) = real(nx_base,r8) - enddo -! -! Equi-distribute remaining columns or latitudes across SMPs -! without increasing per process imbalance beyond minimum -! - workleft = tot_nx - dyn_npes*nx_base - do while (workleft > 0) -! -! (a) Find minimun number of columns or latitudes assigned to an SMP -! - minavgnx_proc = avgnx_proc(0) - do smpid=1,nsmps-1 - if (minavgnx_proc > avgnx_proc(smpid)) then - minavgnx_proc = avgnx_proc(smpid) - endif - enddo -! -! (b) Assign an additional column or latitude to processes with -! nx_base latitudes/columns in SMPs with the minimum -! average number of latitudes/columns -! - do procid=dyn_npes/2-1,0,-1 - if (mirror) then - procids = 2*procid - procidn = procids + 1 - else - procids = procid - procidn = dyn_npes - procids - 1 - endif -! - procids_s = dyn_npes_stride*procids - procidn_s = dyn_npes_stride*procidn -! - smpids = proc_smp_map(procids_s) - smpidn = proc_smp_map(procidn_s) - if ((nx_p(procids_s) .eq. nx_base) .and. & - ((avgnx_proc(smpids) .eq. minavgnx_proc) .or. & - (avgnx_proc(smpidn) .eq. minavgnx_proc)) .and. & - (workleft > 0)) then -! - nx_p(procids_s) = nx_p(procids_s) + 1 - nx_smp(smpids) = nx_smp(smpids) + 1 - avgnx_proc(smpids) = & - real(nx_smp(smpids),r8)/real(nproc_smp(smpids),r8) -! - nx_p(procidn_s) = nx_p(procids_s) - nx_smp(smpidn) = nx_smp(smpidn) + 1 - avgnx_proc(smpidn) = & - real(nx_smp(smpidn),r8)/real(nproc_smp(smpidn),r8) -! - workleft = workleft - 2 - endif - enddo - end do -! -! Partition latitudes over processes, equidistributing either -! a) columns, or -! b) latitudes -! - if (dyn_equi_by_col) then -! -! Evaluate different latitude assignments -! - min_max_ncols = tot_cols - do i=0,10 - alpha = .05_r8*i - max_ncols = 0 -! - iend = 0 - ncol_curtot = 0 - ncol_curgoal = 0 - do procid=0,dyn_npes/2-1 - if (mirror) then - procids = 2*procid - else - procids = procid - endif - procids_s = dyn_npes_stride*procids - ncol_curgoal = ncol_curgoal + nx_p(procids_s) - ncol = 0 -! - done = .false. -! -! Add latitudes until near column per process goal for current process -! - do while ((.not. done) .and. & - (ncol_curtot < ncol_curgoal)) - if (iend .ge. plat/2) then - write(iulog,*)'SPMDINIT_DYN: error in assigning latitudes to processes' - call endrun - endif - if (ncol_curtot + plon .le. & - ncol_curgoal + alpha*plon) then - iend = iend + 1 - ncol = ncol + plon - ncol_curtot = ncol_curtot + plon - else - done = .true. - endif - enddo - if (ncol > max_ncols) max_ncols = ncol -! - enddo - if (max_ncols < min_max_ncols) then - min_max_ncols = max_ncols - opt_alpha = alpha - endif - enddo -! -! Determine latitude assignments when equidistributing columns -! - iend = 0 - ncol_curtot = 0 - ncol_curgoal = 0 - do procid=0,dyn_npes/2-1 - if (mirror) then - procids = 2*procid - procidn = procids + 1 - else - procids = procid - procidn = dyn_npes - procids - 1 - endif -! - procids_s = dyn_npes_stride*procids - procidn_s = dyn_npes_stride*procidn -! - ncol_curgoal = ncol_curgoal + nx_p(procids_s) - ncol_p(procids_s) = 0 -! - cut(1,procids_s) = iend + 1 - cut(2,procids_s) = iend - done = .false. -! -! Add latitudes until near column per process goal for current process -! - do while ((.not. done) .and. & - (ncol_curtot < ncol_curgoal)) - if (ncol_curtot + plon .le. & - ncol_curgoal + opt_alpha*plon) then - iend = iend + 1 - cut(2,procids_s) = iend - ncol_p(procids_s) = ncol_p(procids_s) + plon - ncol_curtot = ncol_curtot + plon - nlat_p(procids_s) = nlat_p(procids_s) + 1 - else - done = .true. - endif - enddo -! -! Assign mirror latitudes -! - cut(1,procidn_s) = plat - cut(2,procids_s) + 1 - cut(2,procidn_s) = plat - cut(1,procids_s) + 1 - ncol_p(procidn_s) = ncol_p(procids_s) - nlat_p(procidn_s) = nlat_p(procids_s) -! -! Save local information -! - if (iam == procids_s .or. iam == procidn_s) then - beglat = cut(1,iam) - endlat = cut(2,iam) - numlats = nlat_p(iam) - begirow = cut(1,procids_s) - endirow = cut(2,procids_s) - end if -! - enddo -! - else -! -! Determine latitude assignments when -! equidistributing latitudes -! - iend = 0 - do procid=0,dyn_npes/2-1 - if (mirror) then - procids = 2*procid - procidn = procids + 1 - else - procids = procid - procidn = dyn_npes - procids - 1 - endif -! - procids_s = dyn_npes_stride*procids - procidn_s = dyn_npes_stride*procidn -! - nlat_p(procids_s) = nx_p(procids_s) - cut(1,procids_s) = iend + 1 - cut(2,procids_s) = iend + nlat_p(procids_s) - iend = iend + nlat_p(procids_s) -! - ncol_p(procids_s) = 0 - do lat=cut(1,procids_s),cut(2,procids_s) - ncol_p(procids_s) = ncol_p(procids_s) + plon - enddo -! -! Assign mirror latitudes -! - nlat_p(procidn_s) = nx_p(procidn_s) - cut(1,procidn_s) = plat - cut(2,procids_s) + 1 - cut(2,procidn_s) = plat - cut(1,procids_s) + 1 -! - ncol_p(procidn_s) = 0 - do lat=cut(1,procidn_s),cut(2,procidn_s) - ncol_p(procidn_s) = ncol_p(procidn_s) + plon - enddo -! -! Save local information -! - if (iam == procids_s .or. iam == procidn_s) then - beglat = cut(1,iam) - endlat = cut(2,iam) - numlats = nlat_p(iam) - begirow = cut(1,procids_s) - endirow = cut(2,procids_s) - end if -! - enddo - endif -! - endif -! -! Calculate maximum number of latitudes and columns assigned to a process -! - maxlats = maxval(nlat_p) - maxcols = maxval(ncol_p) -! - do procid=0,dyn_npes-1 - procid_s = dyn_npes_stride*procid - if (masterproc) then - write(iulog,*)'procid ',procid_s,' assigned ', & - cut(2,procid_s)-cut(1,procid_s)+1,' latitude values from', & - cut(1,procid_s),' through ',cut(2,procid_s),' containing', & - ncol_p(procid_s),' vertical columns' - end if -! -! Determine which process is responsible for the defined latitudes -! - do lat=cut(1,procid_s),cut(2,procid_s) - proc(lat) = procid_s - end do -! -! The extended regions are simply "numbnd" wider at each -! side. The extended region do not go beyond 1 and plat, though -! - cutex(1,procid_s) = cut(1,procid_s) - numbnd - cutex(2,procid_s) = cut(2,procid_s) + numbnd - if (iam == procid_s) then - beglatex = cutex(1,procid_s) + numbnd - endlatex = cutex(2,procid_s) + numbnd - numlatsex = endlatex - beglatex + 1 - end if - end do -! -! Determine neighbor processes needed for boundary communication. -! North first. -! - neighn = 0 - neighn_minlat(:) = -1 - do procid=0,dyn_npes-1 - procid_s = dyn_npes_stride*procid - if (procid_s /= iam) then - if ((cut(1,procid_s) > cut(2,iam)) .and. & - (cut(1,procid_s) <= cut(2,iam)+numbnd)) then - neighn_minlat(cut(1,procid_s)) = procid_s - neighn = neighn + 1 - endif - endif - enddo -! -! Sort north processes by increasing latitude -! - allocate (neighn_proc (neighn)) - neighn = 0 - do lat=1,plat - if (neighn_minlat(lat) /= -1) then - neighn = neighn + 1 - neighn_proc(neighn) = neighn_minlat(lat) - endif - enddo -! -! South next. -! - neighs = 0 - neighs_maxlat(:) = -1 - do procid=0,dyn_npes-1 - procid_s = dyn_npes_stride*procid - if (procid_s /= iam) then - if ((cut(2,procid_s) < cut(1,iam)) .and. & - (cut(2,procid_s) >= cut(1,iam)-numbnd)) then - neighs_maxlat(cut(2,procid_s)) = procid_s - neighs = neighs + 1 - endif - endif - enddo -! -! Sort south processes by decreasing latitude -! - allocate (neighs_proc (neighs)) - neighs = 0 - do lat=plat,1,-1 - if (neighs_maxlat(lat) /= -1) then - neighs = neighs + 1 - neighs_proc(neighs) = neighs_maxlat(lat) - endif - enddo -! - if (masterproc) then - write(iulog,*)'-----------------------------------------' - write(iulog,*)'Number of lats passed north & south = ',numbnd - write(iulog,*)'Node Partition Extended Partition' - write(iulog,*)'-----------------------------------------' - do procid=0,dyn_npes-1 - procid_s = dyn_npes_stride*procid - write(iulog,200) procid_s,cut(1,procid_s),cut(2,procid_s) ,cutex(1,procid_s), & - cutex(2,procid_s) -200 format(i3,4x,i3,'-',i3,7x,i3,'-',i3) - end do - end if -! write(iulog,*)'iam=',iam,'Number of south neighbors needed for bndry exchange = ',neighs -! write(iulog,*)'iam=',iam,'Number of north neighbors needed for bndry exchange = ',neighn - - call decomp_wavenumbers () -! -! Make communicator for active dynamics processors (for use in realloc4a/4b) - if (beglat <= endlat) then - active_proc = 1 - else - active_proc = 0 - endif - call mpi_comm_split(mpicom, active_proc, iam, mpicom_dyn_active, ierror) -! -! Precompute swap partners and number of steps in realloc4 alltoall algorithm. -! First, determine number of swaps. -! - realloc4_steps = 0 - do procj=1,ceil2(npes)-1 - procid = pair(npes,procj,iam) - if (procid >= 0) then - if (((numm(iam) > 0) .and. (nlat_p(procid) > 0)) .or. & - ((numm(procid) > 0) .and. (numlats > 0))) then - realloc4_steps = realloc4_steps + 1 - end if - end if - end do -! -! Second, determine swap partners. -! - allocate( realloc4_proc(realloc4_steps) ) - allocate( realloc4_step(0:npes-1) ) - realloc4_step(:) = -1 - realloc4_steps = 0 - do procj=1,ceil2(npes)-1 - procid = pair(npes,procj,iam) - if (procid >= 0) then - if (((numm(iam) > 0) .and. (nlat_p(procid) > 0)) .or. & - ((numm(procid) > 0) .and. (numlats > 0))) then - realloc4_steps = realloc4_steps + 1 - realloc4_proc(realloc4_steps) = procid - realloc4_step(procid) = realloc4_steps - end if - end if - end do -! -! Precompute swap partners in realloc5/7 allgather algorithm. - allocate( allgather_proc(npes-1) ) - allocate( allgather_step(0:npes-1) ) - allgather_step(:) = -1 - allgather_steps = 0 - do procj=1,ceil2(npes)-1 - procid = pair(npes,procj,iam) - if (procid >= 0) then - allgather_steps = allgather_steps + 1 - allgather_proc(allgather_steps) = procid - allgather_step(procid) = allgather_steps - end if - end do -! - return - end subroutine spmdinit_dyn - -!======================================================================== - - subroutine factor (nitems, m2, m3, m5) -!----------------------------------------------------------------------- -! -! Purpose: Factor a given number into powers of 2,3,5 -! -! Method: Brute force application of "mod" function -! -! Author: CCM Core Group -! -!----------------------------------------------------------------------- -! -! Arguments -! - integer, intent(in) :: nitems ! Number to be factored into powers of 2,3,5 - integer, intent(out) :: m2,m3,m5 ! Powers of 2, 3, and 5 respectively -! -! Local workspace -! - integer num ! current number to be factored -! -!----------------------------------------------------------------------- -! - num = nitems - m2 = 0 - m3 = 0 - m5 = 0 - -2 if (mod(num,2) == 0) then - m2 = m2 + 1 - num = num/2 - goto 2 - end if - -3 if (mod(num,3) == 0) then - m3 = m3 + 1 - num = num/3 - goto 3 - end if - -5 if (mod(num,5) == 0) then - m5 = m5 + 1 - num = num/5 - goto 5 - end if - - if (num /= 1) then - write(iulog,*) 'FACTOR: ',nitems,' has a prime factor other than 2, 3, or 5. Aborting...' - call endrun - end if - - return - end subroutine factor - -!======================================================================== - - subroutine decomp_wavenumbers -!----------------------------------------------------------------------- -! -! Purpose: partition the spectral work among the given number of processes -! -! Method: Approximately equidistribute both the number of spectral -! coefficients and the number of wavenumbers assigned to each -! MPI task using a modified version of the mapping due to -! Barros and Kauranne. -! -! Author: P. Worley, September 2002 -! -!----------------------------------------------------------------------- - use pspect, only: pmmax - use comspe, only: numm, maxm, locm, locrm, nlen, lpspt, lnstart -! -! Local workspace -! - integer procid ! process id - integer procid_s ! strided process id - integer m, lm ! global and local fourier wavenumber indices - integer mstride ! Stride over wavenumbers used in decomposition - integer begm1 ! Starting Fourier wavenumbers owned by an MPI task - integer begm2 ! when using Barros & Kauranne decomposition - integer speccount(0:npes-1) - ! number of spectral coefficients assigned to - ! each MPI task -!----------------------------------------------------------------------- -! -! determine upper bound on number of wavenumbers to be assigned to each -! process - if (mod(pmmax,dyn_npes) .eq. 0) then - maxm = pmmax/dyn_npes - else - maxm = (pmmax/dyn_npes) + 1 - endif - allocate ( numm(0:npes-1) ) - allocate ( locm(1:maxm, 0:npes-1) ) - allocate ( locrm(1:2*maxm, 0:npes-1) ) -! -! assign wavenumbers to approximately equidistribute the number -! of spectral coefficients assigned to each process - numm(:) = 0 - locm(:,:) = huge(1) - locrm(:,:) = huge(1) - speccount(:) = 0 - mstride = 2*dyn_npes - npessp = 0 - do procid = 0,dyn_npes-1 - procid_s = dyn_npes_stride*procid - begm1 = procid + 1 - begm2 = mstride - procid - do m=begm1,pmmax,mstride - numm(procid_s) = numm(procid_s) + 1 - locm(numm(procid_s),procid_s) = m - speccount(procid_s) = speccount(procid_s) + nlen(m) - enddo - do m=begm2,pmmax,mstride - numm(procid_s) = numm(procid_s) + 1 - locm(numm(procid_s),procid_s) = m - speccount(procid_s) = speccount(procid_s) + nlen(m) - enddo -! - if (numm(procid_s) .gt. 0) then - npessp = npessp + 1 - endif -! - enddo -! - do procid = 0,dyn_npes-1 - procid_s = dyn_npes_stride*procid - if (masterproc) then - write(iulog,*)'procid ',procid_s,' assigned ', speccount(procid_s), & - ' spectral coefficients and ', numm(procid_s), & - ' m values: ', (locm(lm,procid_s),lm=1,numm(procid_s)) - end if - do lm=1,numm(procid_s) - locrm(2*lm-1,procid_s) = 2*locm(lm,procid_s)-1 - locrm(2*lm ,procid_s) = 2*locm(lm,procid_s) - enddo - enddo -! -! Calculate number of local spectral coefficients - lpspt = 0 - do lm=1,numm(iam) - lpspt = lpspt + nlen(locm(lm,iam)) - enddo -! -! Evaluate displacement info based on truncation params and -! wavenumber assignment - allocate ( lnstart(1:maxm) ) - lnstart(1) = 0 - do lm=2,numm(iam) - lnstart(lm) = lnstart(lm-1) + nlen(locm(lm-1,iam)) - enddo -! - return - end subroutine decomp_wavenumbers - -!======================================================================== - - subroutine spmdbuf -!----------------------------------------------------------------------- -! -! Purpose: allocate spmd pack buffers used in collective communications -! -! Author: CCM Core Group -! -! Note: Call after phys_grid_init -! -!----------------------------------------------------------------------- - use error_messages, only: alloc_err - use comspe, only: maxm - use constituents, only: pcnst -!----------------------------------------------------------------------- -! -! Local workspace -! - integer :: maxcount(5),m - integer :: length,i,lm,istat1,istat2 - integer :: bsiz, glb_bsiz ! buffer size (in bytes) -! -! realloc4a max: 8 2 plev*numm*numlats (e.g. tdyn) -! 1 2 *numm*numlats (bpstr) -! - maxcount(1) = (npes-1)*maxlats*(2*maxm*(plev*8 + 1)) -! -! realloc4b max: 8 2 plev*numm*numlats (e.g. vort) -! 4 2 *numm*numlats (e.g. dps) -! - maxcount(2) = (npes-1)*maxlats*(2*maxm*(plev*8 + 4)) -! -! realloc5 max: 6 numlats (e.g. tmass) -! 5 numlats *pcnst (e.g. hw1lat) -! 2 4*numlats*pcnst (e.g. hw2al) -! - maxcount(3) = npes*maxlats*(6 + (5 + 2*4)*pcnst) -! -! realloc7 max: 3 plev *numlats (e.g. vmax2d) -! 5 *numlats (e.g. psurf) -! - maxcount(4) = npes*maxlats*(3*plev + 5) -! -! dp_coupling max: -! - if (.not. local_dp_map) then - maxcount(5) = (5 + pcnst)*max(block_buf_nrecs,chunk_buf_nrecs) - else - maxcount(5) = 0 - endif -! - m = maxval(maxcount) - call mpipack_size (m, mpir8, mpicom, bsiz) - call mpiallmaxint(bsiz, glb_bsiz, 1, mpicom) - if (masterproc) then - write(iulog,*) 'SPMDBUF: Allocating SPMD buffers of size ',glb_bsiz - endif - spmdbuf_siz = glb_bsiz/8 + 1 -#if (defined CAF) - allocate(buf1(spmdbuf_siz)[*], stat=istat1) - allocate(buf2(spmdbuf_siz)[*], stat=istat2) -#else - allocate(buf1(spmdbuf_siz), stat=istat1) - allocate(buf2(spmdbuf_siz), stat=istat2) -#endif - call alloc_err( istat1, 'spmdbuf', 'buf1', spmdbuf_siz ) - call alloc_err( istat2, 'spmdbuf', 'buf2', spmdbuf_siz ) - call mpiwincreate(buf1,spmdbuf_siz*8,mpicom,buf1win) - call mpiwincreate(buf2,spmdbuf_siz*8,mpicom,buf2win) - buf1 = 0.0_r8 - buf2 = 0.0_r8 - return - end subroutine spmdbuf - -!======================================================================== - - subroutine compute_gsfactors (numperlat, numtot, numperproc, displs) -!----------------------------------------------------------------------- -! -! Purpose: Compute arguments for gatherv, scatterv -! -! Author: CCM Core Group -! -!----------------------------------------------------------------------- -! -! Input arguments -! - integer, intent(in) :: numperlat ! number of elements per latitude -! -! Output arguments -! - integer, intent(out) :: numtot ! total number of elements (to send or recv) - integer, intent(out) :: numperproc(0:npes-1) ! per-PE number of items to receive - integer, intent(out) :: displs(0:npes-1) ! per-PE displacements -! -! Local variables -! - integer :: p ! index - - numtot = numperlat*numlats - - do p=0,npes-1 - numperproc(p) = numperlat*nlat_p(p) - end do - - displs(0) = 0 - do p=1,npes-1 - displs(p) = numperlat*(cut(1,p)-1) - end do - - end subroutine compute_gsfactors - -#endif - -end module spmd_dyn diff --git a/src/dynamics/eul/stats.F90 b/src/dynamics/eul/stats.F90 deleted file mode 100644 index 72df933fc9..0000000000 --- a/src/dynamics/eul/stats.F90 +++ /dev/null @@ -1,110 +0,0 @@ -subroutine stats(lat ,pint ,pdel ,pstar , & - vort ,div ,t ,q ,nlon ) -!----------------------------------------------------------------------- -! -! Purpose: -! Accumulation of diagnostic statistics for 1 latitude. -! -! Method: -! -! Author: -! Original version: J. Rosinski -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, J. Hack, August 1992 -! Reviewed: D. Williamson, March 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev, plevp, plat - use pspect - use commap - - implicit none - -#include -! -! Input arguments -! - integer, intent(in) :: lat ! latitude index (S->N) - integer, intent(in) :: nlon - - real(r8), intent(in) :: pint(plon,plevp) ! pressure at model interfaces - real(r8), intent(in) :: pdel(plon,plev) ! pdel(k) = pint(k+1) - pint(k) - real(r8), intent(in) :: pstar(plon) ! ps + psr (surface pressure) - real(r8), intent(in) :: vort(plon,plev) ! vorticity - real(r8), intent(in) :: div(plon,plev) ! divergence - real(r8), intent(in) :: t(plon,plev) ! temperature - real(r8), intent(in) :: q(plon,plev) ! moisture -! -!---------------------------Local workspace----------------------------- -! - real(r8) prat ! pdel(i,k)/pint(i,plevp) - - integer i,k ! longitude, level indices - integer ifld ! field index -! -!----------------------------------------------------------------------- -! -! Compute statistics for current latitude line -! - psurf(lat) = 0._r8 - do i=1,nlon - psurf(lat) = psurf(lat) + pstar(i) - end do - psurf(lat)= w(lat)*psurf(lat)/nlon - -!$OMP PARALLEL DO PRIVATE (IFLD, K, I, PRAT) - do ifld=1,4 - if (ifld == 1) then - - rmsz (lat) = 0._r8 - do k=1,plev - do i=1,nlon - prat = pdel(i,k)/pint(i,plevp) - rmsz(lat) = rmsz(lat) + vort(i,k)*vort(i,k)*prat - end do - end do - rmsz(lat) = w(lat)*rmsz(lat)/nlon - - elseif (ifld == 2) then - - rmsd (lat) = 0._r8 - do k=1,plev - do i=1,nlon - prat = pdel(i,k)/pint(i,plevp) - rmsd(lat) = rmsd(lat) + div(i,k)*div(i,k)*prat - end do - end do - rmsd(lat) = w(lat)*rmsd(lat)/nlon - - elseif (ifld == 3) then - - rmst (lat) = 0._r8 - do k=1,plev - do i=1,nlon - prat = pdel(i,k)/pint(i,plevp) - rmst(lat) = rmst(lat) + (t(i,k)**2)*prat - end do - end do - rmst(lat) = w(lat)*rmst(lat)/nlon - - else - - stq (lat) = 0._r8 - do k=1,plev - do i=1,nlon - prat = pdel(i,k)/pint(i,plevp) - stq(lat) = stq(lat) + q(i,k)*pdel(i,k) - end do - end do - stq (lat) = w(lat)*stq(lat)/nlon - - endif - enddo -! - return -end subroutine stats diff --git a/src/dynamics/eul/stepon.F90 b/src/dynamics/eul/stepon.F90 deleted file mode 100644 index 4939f8d1c1..0000000000 --- a/src/dynamics/eul/stepon.F90 +++ /dev/null @@ -1,371 +0,0 @@ -module stepon -!----------------------------------------------------------------------- -! -! Purpose: -! Module for time-stepping of the CAM Eulerian Spectral dynamics. -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use shr_sys_mod, only: shr_sys_flush - use pmgrid, only: plev, plat, plevp, plon, beglat, endlat - use spmd_utils, only: masterproc - use scanslt, only: advection_state - use prognostics, only: ps, u3, v3, t3, q3, qminus, div, & - dpsl, dpsm, omga, phis, n3, n3m2, n3m1 - use camsrfexch, only: cam_out_t - 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 perf_mod - - implicit none - private - save - - public stepon_init ! Initialization - public stepon_run1 ! Run method phase 1 - public stepon_run2 ! Run method phase 2 - public stepon_run3 ! Run method phase 3 - public stepon_final ! Finalization -! -! Private module data -! - type(physics_state), pointer :: phys_state(:) ! Physics state data - type(physics_tend ), pointer :: phys_tend(:) ! Physics tendency data - - real(r8) :: detam(plev) ! intervals between vert full levs. - real(r8) :: cwava(plat) ! weight applied to global integrals - real(r8), allocatable :: t2(:,:,:) ! temp tendency - real(r8), allocatable :: fu(:,:,:) ! u wind tendency - real(r8), allocatable :: fv(:,:,:) ! v wind tendency - real(r8), allocatable :: flx_net(:,:) ! net flux from physics - real(r8), allocatable :: fq(:,:,:,:) ! Q tendencies,for eul_nsplit>1 - real(r8), allocatable :: t2_save(:,:,:) ! temp tendency - real(r8), allocatable :: fu_save(:,:,:) ! u wind tendency - real(r8), allocatable :: fv_save(:,:,:) ! v wind tendency - real(r8) :: coslat(plon) ! cosine of latitude - real(r8) :: rcoslat(plon) ! Inverse of coseine of latitude - real(r8) :: rpmid(plon,plev) ! inverse of midpoint pressure - real(r8) :: pdel(plon,plev) ! Pressure depth of layer - real(r8) :: pint(plon,plevp) ! Pressure at interfaces - real(r8) :: pmid(plon,plev) ! Pressure at midpoint - type(advection_state) :: adv_state ! Advection state data - - real(r8) :: etamid(plev) ! vertical coords at midpoints or pmid if single_column - -!======================================================================= -contains -!======================================================================= - -subroutine stepon_init(dyn_in, dyn_out) -!----------------------------------------------------------------------- -! -! Purpose: Initialization, primarily of dynamics. -! -!----------------------------------------------------------------------- - use dyn_comp, only: dyn_import_t, dyn_export_t - use scanslt, only: scanslt_initial - use commap, only: clat - 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 -! - type(dyn_import_t) :: dyn_in ! included for compatibility - type(dyn_export_t) :: dyn_out ! included for compatibility -!----------------------------------------------------------------------- -! Local variables -! - integer :: k, lat, i - !----------------------------------------------------------------------- - - call t_startf ('stepon_startup') - - call scanslt_initial(adv_state, etamid, gravit, detam, cwava) - ! - ! Initial guess for trajectory midpoints in spherical coords. - ! nstep = 0: use arrival points as initial guess for trajectory midpoints. - ! nstep > 0: use calculated trajectory midpoints from previous time - ! step as first guess. - ! NOTE: reduce number of iters necessary for convergence after nstep = 1. - ! - if (is_first_step()) then - do lat=beglat,endlat - if (.not. single_column) then - do i=1,plon - coslat(i) = cos(clat(lat)) - rcoslat(i) = 1._r8/coslat(i) - end do - endif - ! - ! Set current time pressure arrays for model levels etc. - ! - call plevs0(plon, plon, plev, ps(1,lat,n3), pint, pmid, pdel) - ! - do k=1,plev - do i=1,plon - rpmid(i,k) = 1._r8/pmid(i,k) - end do - end do - - if (.not. single_column) then - ! - ! Calculate vertical motion field - ! - call omcalc (rcoslat, div(1,1,lat,n3), u3(1,1,lat,n3), v3(1,1,lat,n3), dpsl(1,lat), & - dpsm(1,lat), pmid, pdel, rpmid ,pint(1,plevp), & - omga(1,1,lat), plon) - else - - omga(1,:,lat)=wfld(:) - endif - end do - end if - - allocate(t2(plon,plev,beglat:endlat)) - allocate(fu(plon,plev,beglat:endlat)) - allocate(fv(plon,plev,beglat:endlat)) - allocate( flx_net(plon,beglat:endlat)) - if (eul_nsplit>1) then - allocate(fq(plon,plev,pcnst,beglat:endlat)) - allocate(t2_save(plon,plev,beglat:endlat)) - allocate(fu_save(plon,plev,beglat:endlat)) - allocate(fv_save(plon,plev,beglat:endlat)) - endif - ! - ! Beginning of basic time step loop - ! - call t_stopf ('stepon_startup') - - -#if ( defined BFB_CAM_SCAM_IOP ) - if (is_first_step()) then - call init_iop_fields() - endif -#endif -end subroutine stepon_init - -! -!======================================================================= -! - -subroutine stepon_run1( ztodt, phys_state, phys_tend , pbuf2d, dyn_in, dyn_out) -!----------------------------------------------------------------------- -! -! Purpose: Phase 1 run method of dynamics. Set the time-step -! to use for physics. And couple from dynamics to physics. -! -!----------------------------------------------------------------------- - use dyn_comp, only: dyn_import_t, dyn_export_t - use time_manager, only: get_nstep - use prognostics, only: pdeld - - use dp_coupling, only: d_p_coupling - use eul_control_mod,only: eul_nsplit - use physics_buffer, only : physics_buffer_desc - real(r8), intent(out) :: ztodt ! twice time step unless nstep=0 - type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) - type(physics_tend), intent(inout) :: phys_tend(begchunk:endchunk) - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - type(dyn_import_t) :: dyn_in ! included for compatibility - type(dyn_export_t) :: dyn_out ! included for compatibility - - real(r8) :: dtime ! timestep size - !----------------------------------------------------------------------- - - dtime = get_step_size() - - ztodt = 2.0_r8*dtime - - ! If initial time step adjust dt - if (is_first_step()) ztodt = dtime - - ! subcycling case, physics dt is always dtime - if (eul_nsplit>1) ztodt = dtime - - ! Dump state variables to IC file - call t_startf ('diag_dynvar_ic') - call diag_dynvar_ic (phis, ps(:,beglat:endlat,n3m1), t3(:,:,beglat:endlat,n3m1), u3(:,:,beglat:endlat,n3m1), & - v3(:,:,beglat:endlat,n3m1), q3(:,:,:,beglat:endlat,n3m1) ) - call t_stopf ('diag_dynvar_ic') - ! - !---------------------------------------------------------- - ! Couple from dynamics to physics - !---------------------------------------------------------- - ! - call t_startf ('d_p_coupling') - call d_p_coupling (ps(:,beglat:endlat,n3m2), t3(:,:,beglat:endlat,n3m2), u3(:,:,beglat:endlat,n3m2), & - v3(:,:,beglat:endlat,n3m2), q3(:,:,:,beglat:endlat,n3m2), & - omga, phis, phys_state, phys_tend, pbuf2d, pdeld(:,:,:,n3m2)) - call t_stopf ('d_p_coupling') -end subroutine stepon_run1 - -! -!======================================================================= -! - -subroutine stepon_run2( phys_state, phys_tend, dyn_in, dyn_out ) -!----------------------------------------------------------------------- -! -! Purpose: Phase 2 run method of dynamics. Couple from physics -! to dynamics. -! -!----------------------------------------------------------------------- - use dyn_comp, only: dyn_import_t, dyn_export_t - use dp_coupling, only: p_d_coupling - type(physics_state), intent(in):: phys_state(begchunk:endchunk) - type(physics_tend), intent(in):: phys_tend(begchunk:endchunk) - type(dyn_import_t) :: dyn_in ! included for compatibility - type(dyn_export_t) :: dyn_out ! included for compatibility - - call t_startf ('p_d_coupling') - call p_d_coupling (phys_state, phys_tend, t2, fu, fv, flx_net, & - qminus ) - call t_stopf ('p_d_coupling') -end subroutine stepon_run2 - -! -!======================================================================= -! - -subroutine stepon_run3( ztodt, cam_out, phys_state, dyn_in, dyn_out ) -!----------------------------------------------------------------------- -! -! Purpose: Final phase of dynamics run method. Run the actual dynamics. -! -!----------------------------------------------------------------------- - use dyn_comp, only: dyn_import_t, dyn_export_t - use eul_control_mod,only: eul_nsplit - 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) - type(dyn_import_t) :: dyn_in ! included for compatibility - type(dyn_export_t) :: dyn_out ! included for compatibility - real(r8) :: dt_dyn0,dt_dyn - integer :: stage - if (single_column) then - - ! Determine whether it is time for an IOP update; - ! doiopupdate set to true if model time step > next available IOP - if (use_iop) then - call setiopupdate - end if - - ! Update IOP properties e.g. omega, divT, divQ - - if (doiopupdate) call readiopdata() - - endif - - !---------------------------------------------------------- - ! DYNPKG Call the Dynamics Package - !---------------------------------------------------------- - call t_startf ('dynpkg') - - if (eul_nsplit==1) then - call dynpkg(adv_state, t2 ,fu ,fv ,etamid , & - cwava ,detam ,flx_net ,ztodt) - else - dt_dyn0 = ztodt/eul_nsplit - dt_dyn = dt_dyn0 - if (is_first_step()) dt_dyn = 2*dt_dyn0 - - ! convert q adjustment to a tendency - fq = (qminus(:,:,:,:) - q3(:,:,:,:,n3m2))/ztodt - ! save a copy of t2,fu,fv - t2_save=t2 - fu_save=fu - fv_save=fv - - call apply_fq(qminus,q3(:,:,:,:,n3m2),fq,dt_dyn0) - call dynpkg(adv_state, t2 ,fu ,fv ,etamid , & - cwava ,detam ,flx_net ,dt_dyn0) - - do stage=2,eul_nsplit - t2=t2_save - fu=fu_save - fv=fv_save - call apply_fq(qminus,q3(:,:,:,:,n3m2),fq,dt_dyn) - call dynpkg(adv_state, t2 ,fu ,fv ,etamid , & - cwava ,detam ,flx_net ,dt_dyn) - enddo - endif - - call t_stopf ('dynpkg') -end subroutine stepon_run3 - - - -subroutine apply_fq(qminus,q3,fq,dt) - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plat, plev, plevp, beglat, endlat - use constituents, only: pcnst - - real(r8), intent(in) :: q3(plon,plev,beglat:endlat,pcnst) - real(r8), intent(in) :: fq(plon,plev,beglat:endlat,pcnst) - real(r8), intent(out) :: qminus(plon,plev,beglat:endlat,pcnst) - real(r8), intent(in) :: dt - - !local - real(r8) :: q_tmp,fq_tmp - integer :: q,c,k,i - - do q=1,pcnst - do c=beglat,endlat - do k=1,plev - do i=1,plon - fq_tmp = dt*fq(i,k,c,q) - q_tmp = q3(i,k,c,q) - ! if forcing is > 0, do nothing (it makes q less negative) - if (fq_tmp<0 .and. q_tmp+fq_tmp<0 ) then - ! reduce magnitude of forcing so it wont drive q negative - ! but we only reduce the magnitude of the forcing, dont increase - ! its magnitude or change the sign - - ! if q<=0, then this will set fq=0 (q already negative) - ! if q>0, then we know from above that fq < -q < 0, so we - ! can reduce the magnitive of fq by setting fq = -q: - fq_tmp = min(-q_tmp,0._r8) - endif - qminus(i,k,c,q) = q_tmp + fq_tmp - enddo - enddo - enddo - enddo - -end subroutine - - -! -!======================================================================= -! - -subroutine stepon_final(dyn_in, dyn_out) -!----------------------------------------------------------------------- -! -! Purpose: Stepon finalization. -! -!----------------------------------------------------------------------- - use dyn_comp, only: dyn_import_t, dyn_export_t - use scanslt, only: scanslt_final - type(dyn_import_t) :: dyn_in ! included for compatibility - type(dyn_export_t) :: dyn_out ! included for compatibility - - call scanslt_final( adv_state ) - deallocate(t2) - deallocate(fu) - deallocate(fv) - deallocate(flx_net) - -end subroutine stepon_final -! -!======================================================================= -! - -end module stepon diff --git a/src/dynamics/eul/tfilt_massfix.F90 b/src/dynamics/eul/tfilt_massfix.F90 deleted file mode 100644 index a603c38fc9..0000000000 --- a/src/dynamics/eul/tfilt_massfix.F90 +++ /dev/null @@ -1,489 +0,0 @@ -module tfilt_massfix -!----------------------------------------------------------------------- -! -! Purpose: -! Time filter (second half of filter for vorticity and divergence only) -! -!----------------------------------------------------------------------- - implicit none - private - save - - public tfilt_massfixrun -! -! Private module data -! - -!======================================================================= -contains -!======================================================================= - -subroutine tfilt_massfixrun (ztodt, lat, u3m1, u3, & - v3m1, v3, t3m1, t3, q3m1, & - q3, psm1, ps, alpha, & - etamid, qfcst, vort, div, vortm2, & - divm2, qminus, psm2, um2, & - vm2, tm2, qm2, vortm1, divm1, & - omga, dpsl, dpsm, beta, hadv , & - nlon, pdeldry, pdelm1dry, pdelm2dry) -!----------------------------------------------------------------------- -! -! Purpose: -! Time filter (second half of filter for vorticity and divergence only) -! -! Method: -! -! Author: -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use cam_control_mod, only: ideal_phys, tj2016_phys - use cam_history, only: outfld - use eul_control_mod, only: fixmas,eps - use pmgrid, only: plon, plev, plevp, plat - use commap, only: clat - use constituents, only: pcnst, qmin, cnst_cam_outfld, & - tottnam, tendnam, cnst_get_type_byind, fixcnam, & - hadvnam, vadvnam - use time_manager, only: get_nstep - use physconst, only: cpair, gravit - use scamMod, only: single_column, dqfxcam - 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 - -! -! Input arguments -! - real(r8), intent(in) :: ztodt ! two delta t (unless nstep<2) - - real(r8), intent(inout) :: qfcst(plon,plev,pcnst)! slt moisture forecast - real(r8), intent(in) :: vort(plon,plev) - real(r8), intent(in) :: div(plon,plev) - real(r8), intent(inout) :: vortm2(plon,plev) - real(r8), intent(inout) :: divm2(plon,plev) - real(r8), intent(in) :: qminus(plon,plev,pcnst) - real(r8), intent(inout) :: psm2(plon) - real(r8), intent(inout) :: um2(plon,plev) - real(r8), intent(inout) :: vm2(plon,plev) - real(r8), intent(inout) :: tm2(plon,plev) - real(r8), intent(inout) :: qm2(plon,plev,pcnst) - real(r8), intent(inout) :: omga(plon,plev) - real(r8), intent(in) :: dpsl(plon) - real(r8), intent(in) :: dpsm(plon) - real(r8), intent(in) :: beta ! energy fixer coefficient - real(r8), intent(in) :: hadv(plon,plev,pcnst) ! horizonal q advection tendency - real(r8), intent(in) :: alpha(pcnst) - real(r8), intent(in) :: etamid(plev) ! vertical coords at midpoints - real(r8), intent(in) :: u3(plon,plev) - real(r8), intent(in) :: v3(plon,plev) - real(r8), intent(inout) :: t3(plon,plev) - real(r8), intent(inout) :: pdeldry(:,:) ! dry pressure difference at time n3 - real(r8), intent(inout) :: pdelm1dry(:,:) ! dry pressure difference at time n3m1 - real(r8), intent(in) :: pdelm2dry(:,:) ! dry pressure difference at time n3m2 - - - integer, intent(in) :: lat - integer, intent(in) :: nlon - -! Input/Output arguments - - real(r8), intent(inout) :: q3(plon,plev,pcnst) - real(r8), intent(inout) :: ps(plon) - real(r8), intent(inout) :: vortm1(plon,plev) - real(r8), intent(inout) :: psm1(plon) - real(r8), intent(inout) :: u3m1(plon,plev) - real(r8), intent(inout) :: v3m1(plon,plev) - real(r8), intent(inout) :: t3m1(plon,plev) - real(r8), intent(inout) :: divm1(plon,plev) - real(r8), intent(inout) :: q3m1(plon,plev,pcnst) -! -! Local workspace -! - integer ifcnt ! Counter - integer :: nstep ! current timestep number - integer :: timefiltstep ! - - real(r8) tfix (plon) ! T correction - real(r8) engycorr(plon,plev) ! energy equivalent to T correction - real(r8) rpmid(plon,plev) ! 1./pmid - real(r8) pdel(plon,plev) ! pdel(k) = pint (k+1)-pint (k) - real(r8) pint(plon,plevp) ! pressure at model interfaces (n ) - real(r8) pmid(plon,plev) ! pressure at model levels (time n) - real(r8) utend(plon,plev) ! du/dt - real(r8) vtend(plon,plev) ! dv/dt - real(r8) ttend(plon,plev) ! dT/dt - real(r8) qtend(plon,plev,pcnst)! dq/dt - real(r8) pstend(plon) ! d(ps)/dt - real(r8) vadv (plon,plev,pcnst) ! vertical q advection tendency - real(r8) pintm1(plon,plevp) ! pressure at model interfaces (n-1) - real(r8) pmidm1(plon,plev) ! pressure at model levels (time n-1) - real(r8) pdelm1(plon,plev) ! pdelm1(k) = pintm1(k+1)-pintm1(k) - real(r8) om2eps - real(r8) corm - real(r8) wm - real(r8) absf - real(r8) worst - logical lfixlim ! flag to turn on fixer limiter - - real(r8) ta(plon,plev,pcnst) ! total advection of constituents - real(r8) dqfx3(plon,plev,pcnst)! q tendency due to mass adjustment - real(r8) coslat ! cosine(latitude) - real(r8) rcoslat(plon) ! 1./cosine(latitude) -! real(r8) engt ! Thermal energy integral -! 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) - real(r8) alpha_plon(plon) - -!----------------------------------------------------------------------- - 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) - 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 - 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 - - - coslat = cos(clat(lat)) - do i=1,nlon - rcoslat(i) = 1._r8/coslat - enddo - lfixlim = .true. - - -! -! Set average dry mass to specified constant preserving horizontal -! gradients of ln(ps). Proportionality factor was calculated in STEPON -! for nstep=0 or SCAN2 otherwise from integrals calculated in INIDAT -! and SCAN2 respectively. -! Set p*. -! - do i=1,nlon - ps(i) = ps(i)*fixmas - end do -! -! Set current time pressure arrays for model levels etc. -! - call plevs0(nlon ,plon ,plev ,ps ,pint ,pmid ,pdel) -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i=1,nlon - rpmid(i,k) = 1._r8/pmid(i,k) - enddo - enddo -! -! Add temperature correction for energy conservation -! - if (ideal_phys .or. tj2016_phys) then - engycorr(:,:) = 0._r8 - else -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i=1,nlon - engycorr(i,k) = (cpair/gravit)*beta*pdel(i,k)/ztodt - t3 (i,k) = t3(i,k) + beta - end do - end do - end if - do i=1,nlon - tfix(i) = beta/ztodt - end do -! -! Output Energy correction term -! -! using do loop and select in order to enable functional parallelism with OpenMP -!$OMP PARALLEL DO PRIVATE (I) - do i=1,2 - select case (i) - case (1) - call outfld ('ENGYCORR',engycorr ,plon ,lat ) - case (2) - call outfld ('TFIX ',tfix ,plon ,lat ) - end select - end do - -! -! Compute q tendency due to mass adjustment -! If LFIXLIM = .T., then: -! Check to see if fixer is exceeding a desired fractional limit of the -! constituent mixing ratio ("corm"). If so, then limit the fixer to -! that specified limit. -! - do m=1,pcnst - if (cnst_get_type_byind(m).eq.'dry' ) then - corm = 1.e36_r8 - else - corm = 0.1_r8 - end if - -!$OMP PARALLEL DO PRIVATE (K, I, IFCNT, WORST, WM, ABSF) - do k=1,plev - do i=1,nlon - if (single_column) then - 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 - endif - end do - if (lfixlim) then - ifcnt = 0 - worst = 0._r8 - wm = 0._r8 - do i = 1,nlon - absf = abs(dqfx3(i,k,m)) - if (absf.gt.corm) then - ifcnt = ifcnt + 1 - worst = max(absf,worst) - wm = wm + absf - dqfx3(i,k,m) = sign(corm,dqfx3(i,k,m)) - endif - end do - if (ifcnt.gt.0) then - wm = wm/real(ifcnt,r8) - -! TBH: Commented out as of CAM CRB meeting on 6/20/03 -! write(iulog,1000) m,corm,ifcnt,k,lat,wm,worst - - endif - endif - do i=1,nlon - dqfx3(i,k,m) = qfcst(i,k,m)*dqfx3(i,k,m)/ztodt - q3 (i,k,m) = qfcst(i,k,m) + ztodt*dqfx3(i,k,m) - ta (i,k,m) = (q3 (i,k,m) - qminus(i,k,m))/ztodt - vadv (i,k,m) = (qfcst(i,k,m) - qminus(i,k,m))/ztodt - hadv(i,k,m) - end do - end do - end do - -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i=1,nlon - pdeldry(i,k) = pdel(i,k)*(1._r8-q3(i,k,1)) - 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 -! -! Check for and correct invalid constituents -! - call qneg3 ('TFILT_MASSFIX',lat ,nlon ,plon ,plev , & - 1, pcnst, qmin ,q3(1,1,1)) -! -! Send slt tendencies to the history tape -! -!$OMP PARALLEL DO PRIVATE (M) - do m=1,pcnst - if ( cnst_cam_outfld(m) ) then - call outfld(tottnam(m),ta(1,1,m),plon ,lat ) - end if - end do - if (.not. single_column) then -! -! Calculate vertical motion field -! - call omcalc (rcoslat ,div ,u3 ,v3 ,dpsl , & - dpsm ,pmid ,pdel ,rpmid ,pint(1,plevp), & - omga ,nlon ) - - endif - -! write(iulog,*)'tfilt: lat=',lat -! write(iulog,*)'omga=',omga -! -! Time filter (second half of filter for vorticity and divergence only) -! -! if(lat.eq.2) then -! write(iulog,*)'tfilt: ps=',psm2(13),psm1(13),ps(13) -! write(iulog,*)'tfilt: u=',um2(13,18),u3m1(13,18),u3(13,18) -! write(iulog,*)'tfilt: t=',tm2(13,18),t3m1(13,18),t3(13,18) -! write(iulog,*)'tfilt: water=',qm2(13,18,1),q3m1(13,18,1),q3(13,18,1) -! write(iulog,*)'tfilt: cwat=',qm2(13,18,2),q3m1(13,18,2),q3(13,18,2) -! write(iulog,*)'tfilt: vort=',vortm2(13,18),vortm1(13,18),vort(13,18) -! write(iulog,*)'tfilt: div=',divm2(13,18),divm1(13,18),div(13,18) -! end if - - om2eps = 1._r8 - 2._r8*eps - - if (nstep.ge.2) then -!$OMP PARALLEL DO PRIVATE (K, I, M) - do k=1,plev - do i=1,nlon - u3m1(i,k) = om2eps*u3m1(i,k) + eps*um2(i,k) + eps*u3(i,k) - v3m1(i,k) = om2eps*v3m1(i,k) + eps*vm2(i,k) + eps*v3(i,k) - t3m1(i,k) = om2eps*t3m1(i,k) + eps*tm2(i,k) + eps*t3(i,k) - q3m1(i,k,1) = om2eps*q3m1(i,k,1) + eps*qm2(i,k,1) + eps*q3(i,k,1) - vortm1(i,k) = om2eps*vortm1(i,k) + eps*vortm2(i,k) + eps*vort(i,k) - divm1(i,k) = om2eps*divm1(i,k) + eps*divm2(i,k) + eps*div(i,k) - end do - do m=2,pcnst - if (cnst_get_type_byind(m) .eq. 'wet') then - do i=1,nlon - q3m1(i,k,m) = om2eps*q3m1(i,k,m) + eps*qm2(i,k,m) + eps*q3(i,k,m) - end do - endif - end do - do m=2,pcnst - if (cnst_get_type_byind(m) .eq. 'dry') then - do i=1,nlon ! calculate numerator (timefiltered mass * pdeldry) - q3m1(i,k,m) = (om2eps*pdelm1dry(i,k)*q3m1(i,k,m) + & - eps*pdelm2dry(i,k)*qm2(i,k,m) + & - eps*pdeldry(i,k)*q3(i,k,m)) - end do !i - endif !dry - end do !m - do i=1,nlon ! calculate time filtered value of pdeldry - pdelm1dry(i,k) = om2eps*pdelm1dry(i,k) + & - eps*pdelm2dry(i,k) + eps*pdeldry(i,k) - end do !i - ! divide time filtered mass*pdeldry by timefiltered pdeldry - do m=2,pcnst - if (cnst_get_type_byind(m) == 'dry') then - do i=1,nlon - q3m1(i,k,m) = q3m1(i,k,m)/pdelm1dry(i,k) - end do !i - endif ! dry - end do !m - - end do - do i=1,nlon - psm1(i) = om2eps*psm1(i) + eps*psm2(i) + eps*ps(i) - end do - end if - - call plevs0 (nlon ,plon ,plev ,psm1 ,pintm1 ,pmidm1 ,pdelm1) -! -! Compute time tendencies:comment out since currently not on h-t -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i=1,nlon - ttend(i,k) = (t3(i,k)-tm2(i,k))/ztodt - utend(i,k) = (u3(i,k)-um2(i,k))/ztodt - vtend(i,k) = (v3(i,k)-vm2(i,k))/ztodt - end do - end do - -!$OMP PARALLEL DO PRIVATE (M, K, I) - do m=1,pcnst - do k=1,plev - do i=1,nlon - qtend(i,k,m) = (q3(i,k,m) - qm2(i,k,m))/ztodt - end do - end do - end do - - do i=1,nlon - pstend(i) = (ps(i) - psm2(i))/ztodt - end do - -!$OMP PARALLEL DO PRIVATE (M) - do m=1,pcnst - if ( cnst_cam_outfld(m) ) then - call outfld (tendnam(m),qtend(1,1,m),plon,lat) - call outfld (fixcnam(m),dqfx3(1,1,m),plon,lat) - call outfld (hadvnam(m),hadv (1,1,m),plon,lat) - call outfld (vadvnam(m),vadv (1,1,m),plon,lat) - end if - end do - -! using do loop and select in order to enable functional parallelism with OpenMP -!$OMP PARALLEL DO PRIVATE (I) - do i=1,4 - select case (i) - case (1) - call outfld ('UTEND ',utend,plon,lat) - case (2) - call outfld ('VTEND ',vtend,plon,lat) - case (3) - call outfld ('TTEND ',ttend,plon,lat) - case (4) - call outfld ('LPSTEN ',pstend,plon,lat) - end select - end do - - return -1000 format(' TIMEFILTER: WARNING: fixer for tracer ',i3,' exceeded ', & - f8.5,' for ',i5,' points at k,lat = ',2i4, & - ' Avg/Worst = ',1p2e10.2) - -end subroutine tfilt_massfixrun - -end module tfilt_massfix diff --git a/src/dynamics/eul/trjmps.F90 b/src/dynamics/eul/trjmps.F90 deleted file mode 100644 index 9c856e38a9..0000000000 --- a/src/dynamics/eul/trjmps.F90 +++ /dev/null @@ -1,71 +0,0 @@ -subroutine trjmps(dt ,upr ,vpr ,phimp ,lampr , & - phipr ,nlon ) -!----------------------------------------------------------------------- -! -! Purpose: -! Estimate mid-point interval of parcel trajectory (global spherical -! coordinates). -! -! Method: -! -! Author: -! Original version: J. Olson -! Standardized: J. Rosinski, June 1992 -! Reviewed: D. Williamson, P. Rasch, August 1992 -! Reviewed: D. Williamson, P. Rasch, March 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plon, plev -!----------------------------------------------------------------------- - implicit none -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - real(r8), intent(in) :: dt ! time step (seconds) - real(r8), intent(in) :: upr (plon,plev) ! u-comp of wind at midpoint - real(r8), intent(in) :: vpr (plon,plev) ! v-comp of wind at midpoint - real(r8), intent(in) :: phimp(plon,plev) ! lat coord at midpoint - - integer, intent(in) :: nlon -! -! Output arguments -! - real(r8), intent(out) :: lampr(plon,plev) ! relative long coord of midpoint - real(r8), intent(out) :: phipr(plon,plev) ! relative lat coord of midpoint -! -!----------------------------------------------------------------------- -! -! dt Time interval that corresponds to the parcel trajectory. -! upr u-coordinate of velocity corresponding to the most recent -! estimate of the trajectory mid-point. -! vpr v-coordinate of velocity corresponding to the most recent -! estimate of the trajectory mid-point. -! phimp Phi value of trajectory midpoint (most recent estimate). -! lampr Longitude coordinate of trajectory mid-point relative to the -! arrival point. -! phipr Latitude coordinate of trajectory mid-point relative to the -! arrival point. -! -!---------------------------Local variables----------------------------- -! - integer i,k ! index -! -!----------------------------------------------------------------------- -! -!$OMP PARALLEL DO PRIVATE (K, I) - do k=1,plev - do i = 1,nlon - lampr(i,k) = -.5_r8*dt* upr(i,k) / cos( phimp(i,k) ) - phipr(i,k) = -.5_r8*dt* vpr(i,k) - end do - end do -! - return -end subroutine trjmps diff --git a/src/dynamics/eul/tstep.F90 b/src/dynamics/eul/tstep.F90 deleted file mode 100644 index 53cdfa1d7b..0000000000 --- a/src/dynamics/eul/tstep.F90 +++ /dev/null @@ -1,153 +0,0 @@ - subroutine tstep(lm ,zdt ,ztdtsq ) -!----------------------------------------------------------------------- -! -! Solution of the vertically coupled system of equations arising -! from the semi-impicit equations for each spectral element along -! two dimensional wavenumber n. The inverse matrix depends -! only on two dimensional wavenumber and the reference atmosphere. -! It is precomputed and stored for use during the forecast. The routine -! overwrites the d,T and lnps coefficients with the new values. -! -!---------------------------Code history-------------------------------- -! -! Original version: CCM1 -! Standardized: J. Rosinski, June 1992 -! Reviewed: B. Boville, D. Williamson, August 1992 -! Reviewed: B. Boville, D. Williamson, April 1996 -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid - use pspect - use comspe - use commap - use spmd_utils, only : iam - use hycoef, only : hypi, hypd - implicit none - -!----------------------------------------------------------------------- -! -! Input arguments -! - integer, intent(in) :: lm ! local Fourier wavenumber index - - real(r8), intent(in) :: zdt ! timestep, dt (seconds) - real(r8), intent(in) :: ztdtsq(pnmax) ! dt*(n(n+1)/a^2 where n is 2-d wavenumber -! -!---------------------------Local workspace----------------------------- -! - real(r8) z(2*pnmax,plev) ! workspace for computation of spectral array d - real(r8) hhref ! href/2 (reference hydrostatic matrix / 2) - real(r8) hbps ! bps/2 (ref. coeff. for lnps term in div. eq. / 2) - real(r8) ztemp ! temporary workspace - - integer m ! global wavenumber index - integer n,j ! 2-d wavenumber index - integer k,kk ! level indices - integer lmr,lmc ! real and imaginary spectral indices - integer ir,ii ! real and imaginary spectral indices - integer nn ! real and imaginary spectral indices -! -!----------------------------------------------------------------------- -! -! Complete rhs of helmholtz eq. -! - m = locm(lm,iam) - lmr = lnstart(lm) - lmc = 2*lmr -!$OMP PARALLEL DO PRIVATE (K, HHREF, HBPS, N, IR, II, KK) - do k=1,plev -! -! Coefficients for diagonal terms -! - hhref = 0.5_r8*href(k,k) - hbps = 0.5_r8*bps(k) -! -! Loop along total wavenumber index (in spectral space) -! Add lnps and diagonal (vertical space) T terms to d(t-1) -! - do n=1,nlen(m) - ir = lmc + 2*n - 1 - ii = ir + 1 - d(ir,k) = d(ir,k) + ztdtsq(n+m-1)*(hhref*t(ir,k) + hbps*alps(ir)) - d(ii,k) = d(ii,k) + ztdtsq(n+m-1)*(hhref*t(ii,k) + hbps*alps(ii)) - end do - if (k.lt.plev) then - do kk=k+1,plev -! -! Add off-diagonal (vertical space) T terms to d(t-1) -! - hhref = 0.5_r8*href(kk,k) - do n=1,nlen(m) - ir = lmc + 2*n - 1 - ii = ir + 1 - d(ir,k) = d(ir,k) + ztdtsq(n+m-1)*hhref*t(ir,kk) - d(ii,k) = d(ii,k) + ztdtsq(n+m-1)*hhref*t(ii,kk) - end do - end do - end if - end do ! k=1,plev (calculation level) -! -! Solution of helmholtz equation -! First: initialize temporary space for solution -! - z = 0._r8 -! -! Multiply right hand side by inverse matrix -! -!$OMP PARALLEL DO PRIVATE (K, KK, N, IR, II) - do k=1,plev - do kk=1,plev - do n=1,nlen(m) - ir = lmc + 2*n - 1 - ii = ir + 1 - z(2*n-1,k) = z(2*n-1,k) + bm1(kk,k,m+n-1)*d(ir,kk) - z(2*n ,k) = z(2*n ,k) + bm1(kk,k,m+n-1)*d(ii,kk) - end do - end do ! inner loop over levels - end do ! outer loop over levels -! -! Move solution for divergence to d -! -!$OMP PARALLEL DO PRIVATE (K, N, IR, II) - do k=1,plev - do n=1,nlen(m) - ir = lmc + 2*n - 1 - ii = ir + 1 - d(ir,k) = z(2*n-1,k) - d(ii,k) = z(2*n ,k) - end do - end do ! outer loop over levels -! -! Complete ln(pstar) and T forecasts -! Add semi-implicit part to surface pressure (vector multiply) -! - do k=1,plev - ztemp = zdt*hypd(k)/hypi(plevp) - do n=1,nlen(m) - ir = lmc + 2*n - 1 - ii = ir + 1 - alps(ir) = alps(ir) - ztemp*d(ir,k) - alps(ii) = alps(ii) - ztemp*d(ii,k) - end do - end do -! -! Add semi-implicit part to temperature (matrix multiply) -! -!$OMP PARALLEL DO PRIVATE (K, KK, NN) - do k=1,plev - do kk=1,plev - do nn = lmc+1, lmc+2*nlen(m) - t(nn,k) = t(nn,k) - zdt*tau(kk,k)*d(nn,kk) - end do - end do - end do -! - return - end subroutine tstep - diff --git a/src/dynamics/fv/cd_core.F90 b/src/dynamics/fv/cd_core.F90 index f7f64e6512..ad5e35aab8 100644 --- a/src/dynamics/fv/cd_core.F90 +++ b/src/dynamics/fv/cd_core.F90 @@ -251,7 +251,6 @@ subroutine cd_core(grid, nx, u, v, pt, & ! with coefficient del2coef (default 3E5) ! ! - ldiv2: 2nd-order divergence damping everywhere and increasing in top layers - ! (default cam3.5 setting) ! ! - ldiv4: 4th-order divergence damping everywhere and increasing in top layers ! @@ -530,7 +529,6 @@ subroutine cd_core(grid, nx, u, v, pt, & if (div24del2flag == 2) then - ! cam3.5 default damping setting ldiv2 = .true. ldiv4 = .false. ldel2 = .false. @@ -608,7 +606,7 @@ subroutine cd_core(grid, nx, u, v, pt, & !*********************************************** ! - ! cam3 default second-order divergence damping + ! second-order divergence damping ! !*********************************************** press = D0_5 * ( grid%ak(k)+grid%ak(k+1) + & diff --git a/src/dynamics/fv/dp_coupling.F90 b/src/dynamics/fv/dp_coupling.F90 index 7fc3f18fbf..fc02821471 100644 --- a/src/dynamics/fv/dp_coupling.F90 +++ b/src/dynamics/fv/dp_coupling.F90 @@ -7,9 +7,10 @@ module dp_coupling use ppgrid, only: pcols, pver use phys_grid - use physics_types, only: physics_state, physics_tend + use physics_types, only: physics_state, physics_tend, physics_cnst_limit use constituents, only: pcnst - use physconst, only: gravit, zvir, cpairv, rairv + use physconst, only: gravit, zvir + use air_composition, only: cpairv, rairv use geopotential, only: geopotential_t use check_energy, only: check_energy_timestep_init use dynamics_vars, only: T_FVDYCORE_GRID, t_fvdycore_state @@ -21,11 +22,6 @@ module dp_coupling #endif use perf_mod use cam_logfile, only: iulog - -!-------------------------------------------- -! Variables needed for WACCM-X -!-------------------------------------------- - use constituents, only: cnst_get_ind !Needed to access constituent indices ! ! !PUBLIC MEMBER FUNCTIONS: PUBLIC d_p_coupling, p_d_coupling @@ -81,7 +77,7 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) use ctem, only: ctem_diags, do_circulation_diags use diag_module, only: fv_diag_am_calc use gravity_waves_sources, only: gws_src_fnct - use physconst, only: physconst_update + use cam_thermo, only: cam_thermo_dry_air_update use shr_const_mod, only: shr_const_rwv use dyn_comp, only: frontgf_idx, frontga_idx, uzm_idx use qbo, only: qbo_use_forcing @@ -89,7 +85,7 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) use zonal_mean, only: zonal_mean_3D use d2a3dikj_mod, only: d2a3dikj use qneg_module, only: qneg3 - + use air_composition,only: dry_air_species_num !----------------------------------------------------------------------- implicit none !----------------------------------------------------------------------- @@ -196,15 +192,6 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) real(r8), pointer :: pbuf_frontga(:,:) ! needed for qbo real(r8), pointer :: pbuf_uzm(:,:) - -!-------------------------------------------- -! Variables needed for WACCM-X -!-------------------------------------------- - integer :: ixo, ixo2, ixh, ixh2 ! indices into state structure for O, O2, H, and H2 - real(r8) :: mmrSum_O_O2_H ! Sum of mass mixing ratios for O, O2, and H - real(r8), parameter :: mmrMin=1.e-20_r8 ! lower limit of o2, o, and h mixing ratios - real(r8), parameter :: N2mmrMin=1.e-6_r8 ! lower limit of o2, o, and h mixing ratios - #if (! defined SPMD) integer :: block_buf_nrecs = 0 integer :: chunk_buf_nrecs = 0 @@ -541,7 +528,7 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) ! Evaluate derived quantities ! call t_startf ('derived_fields') -!$omp parallel do private (lchnk, ncol, i, k, m, qmavl, dqreq, qbot, qbotm1, zvirv, pbuf_chnk, mmrSum_O_O2_H) +!$omp parallel do private (lchnk, ncol, i, k, m, qmavl, dqreq, qbot, qbotm1, zvirv, pbuf_chnk) do lchnk = begchunk,endchunk ncol = phys_state(lchnk)%ncol do k=1,km @@ -584,49 +571,22 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) end if end do end do - -!----------------------------------------------------------------------------------------------------------------- -! Ensure O2 + O + H (N2) mmr greater than one. Check for unusually large H2 values and set to lower value -!----------------------------------------------------------------------------------------------------------------- - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - - call cnst_get_ind('O', ixo) - call cnst_get_ind('O2', ixo2) - call cnst_get_ind('H', ixh) - call cnst_get_ind('H2', ixh2) - - do i=1,ncol - do k=1,pver - - if (phys_state(lchnk)%q(i,k,ixo) < mmrMin) phys_state(lchnk)%q(i,k,ixo) = mmrMin - if (phys_state(lchnk)%q(i,k,ixo2) < mmrMin) phys_state(lchnk)%q(i,k,ixo2) = mmrMin - - mmrSum_O_O2_H = phys_state(lchnk)%q(i,k,ixo)+phys_state(lchnk)%q(i,k,ixo2)+phys_state(lchnk)%q(i,k,ixh) - - if ((1._r8-mmrMin-mmrSum_O_O2_H) < 0._r8) then - - phys_state(lchnk)%q(i,k,ixo) = phys_state(lchnk)%q(i,k,ixo) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H - - phys_state(lchnk)%q(i,k,ixo2) = phys_state(lchnk)%q(i,k,ixo2) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H - - phys_state(lchnk)%q(i,k,ixh) = phys_state(lchnk)%q(i,k,ixh) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H - - endif - - if(phys_state(lchnk)%q(i,k,ixh2) .gt. 6.e-5_r8) then - phys_state(lchnk)%q(i,k,ixh2) = 6.e-5_r8 - endif - - end do - end do - endif - + ! + ! Convert dry type constituents from moist to dry mixing ratio + ! (note: cam_thermo_dry_air_update assumes dry unless optional conversion factor provided) + ! + call set_state_pdry(phys_state(lchnk)) ! First get dry pressure to use for this timestep + call set_wet_to_dry(phys_state(lchnk), convert_cnst_type='dry') ! Dynamics had moist, physics wants dry + if (dry_air_species_num>0) then +!------------------------------------------------------------ +! Apply limiters to mixing ratios of major species +!------------------------------------------------------------ + call physics_cnst_limit( phys_state(lchnk) ) !----------------------------------------------------------------------------- -! Call physconst_update to compute cpairv, rairv, mbarv, and cappav as constituent dependent variables +! Call cam_thermo_update to compute cpairv, rairv, mbarv, and cappav as constituent dependent variables ! and compute molecular viscosity(kmvis) and conductivity(kmcnd) !----------------------------------------------------------------------------- - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - call physconst_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol) + call cam_thermo_dry_air_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol) endif !------------------------------------------------------------------------ @@ -641,7 +601,7 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) ! Compute initial geopotential heights call geopotential_t (phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint , & phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & - phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,1), rairv(:,:,lchnk), gravit, zvirv, & + phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,:), rairv(:,:,lchnk), gravit, zvirv, & phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol ) ! Compute initial dry static energy, include surface geopotential @@ -653,11 +613,6 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) end do ! -! Convert dry type constituents from moist to dry mixing ratio -! - call set_state_pdry(phys_state(lchnk)) ! First get dry pressure to use for this timestep - call set_wet_to_dry(phys_state(lchnk)) ! Dynamics had moist, physics wants dry. -! ! Ensure tracers are all positive ! call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & @@ -698,7 +653,7 @@ subroutine p_d_coupling(grid, phys_state, phys_tend, & use metdata, only: get_met_fields #endif use physics_buffer, only: physics_buffer_desc - use physconst, only: physconst_calc_kappav + use cam_thermo, only: cam_thermo_calc_kappav !----------------------------------------------------------------------- implicit none @@ -959,7 +914,7 @@ subroutine p_d_coupling(grid, phys_state, phys_tend, & call t_startf ('p_d_adjust') if (iam .lt. grid%npes_xy) then if (grid%high_alt) then - call physconst_calc_kappav(ifirstxy,ilastxy,jfirstxy,jlastxy,1,km, grid%ntotq, tracer, cappa3v ) + call cam_thermo_calc_kappav(tracer, cappa3v ) else cappa3v = cappa endif diff --git a/src/dynamics/fv/dryairm.F90 b/src/dynamics/fv/dryairm.F90 index 94c8637e6a..eefb618136 100644 --- a/src/dynamics/fv/dryairm.F90 +++ b/src/dynamics/fv/dryairm.F90 @@ -22,8 +22,7 @@ subroutine dryairm( grid, moun, ps, tracer, delp, & use mean_module, only: gmeanxy use pio, only: file_desc_t - use cam_initfiles, only: topo_file_get_id - + use cam_initfiles, only: topo_file_get_id, scale_dry_air_mass use cam_logfile, only: iulog implicit none @@ -63,21 +62,12 @@ subroutine dryairm( grid, moun, ps, tracer, delp, & real(r8), allocatable :: psdkg(:,:,:) ! global work array ! dry surface pressure real(r8) psd(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) - real(r8) drym,drym_loc ! global mean dry air mass in pascals integer :: im, jm, km ! Dimensions integer :: ifirstxy, ilastxy, jfirstxy, jlastxy ! XY slice integer :: nq ! Number of advective tracers real(r8):: ptop -#if defined ( NAVY10 ) - parameter (drym = 98222.0_r8) ! For US NAVY 10-min terrain -#else - parameter (drym = 98288.0_r8) ! For USGS terrain -#endif - real(r8), parameter :: D245_0 = 245._r8 - real(r8), parameter :: D101325_0 = 101325._r8 - type(file_desc_t), pointer :: fh_topo integer i, j, k, ic @@ -97,11 +87,8 @@ subroutine dryairm( grid, moun, ps, tracer, delp, & jlastxy = grid%jlastxy nq = grid%nq ptop = grid%ptop - - drym_loc = drym - if (.not. associated(fh_topo)) then - drym_loc = D101325_0 - D245_0 - end if + + if (scale_dry_air_mass <= 0.0_r8) return ! Check global maximum/minimum @@ -194,7 +181,7 @@ subroutine dryairm( grid, moun, ps, tracer, delp, & if( nlres_loc ) return if(moun) then - dpd = drym_loc - psdry + dpd = scale_dry_air_mass - psdry else dpd = 1000._r8*100._r8 - psdry endif diff --git a/src/dynamics/fv/dycore_budget.F90 b/src/dynamics/fv/dycore_budget.F90 new file mode 100644 index 0000000000..a672fef9cc --- /dev/null +++ b/src/dynamics/fv/dycore_budget.F90 @@ -0,0 +1,27 @@ +module dycore_budget +implicit none + +public :: print_budget + +!========================================================================================= +contains +!========================================================================================= + +subroutine print_budget(hstwr) + + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use cam_budget, only: thermo_budget_histfile_num, thermo_budget_history + + ! arguments + logical, intent(in) :: hstwr(:) + character(len=*), parameter :: subname = 'dycore_budget:print_budgets:' + + !-------------------------------------------------------------------------------------- + + if (masterproc .and. thermo_budget_history .and. hstwr(thermo_budget_histfile_num)) then + call endrun(subname//' is not implemented for the FV dycore') + end if +end subroutine print_budget + +end module dycore_budget diff --git a/src/dynamics/fv/dyn_comp.F90 b/src/dynamics/fv/dyn_comp.F90 index f4f1c662c7..5d52dfa878 100644 --- a/src/dynamics/fv/dyn_comp.F90 +++ b/src/dynamics/fv/dyn_comp.F90 @@ -463,7 +463,12 @@ subroutine dyn_init(dyn_in, dyn_out) ! Initialize FV dynamical core state variables - use physconst, only: pi, omega, rearth, rair, cpair, zvir + use physconst, only: omega, rearth, rair, cpair, zvir + use air_composition, only: thermodynamic_active_species_idx + use air_composition, only: thermodynamic_active_species_idx_dycore + use air_composition, only: thermodynamic_active_species_liq_idx,thermodynamic_active_species_ice_idx + use air_composition, only: thermodynamic_active_species_liq_idx_dycore,thermodynamic_active_species_ice_idx_dycore + use air_composition, only: thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num use infnan, only: inf, assignment(=) use constituents, only: pcnst, cnst_name, cnst_longname, tottnam, cnst_get_ind @@ -475,6 +480,7 @@ subroutine dyn_init(dyn_in, dyn_out) #endif use ctem, only: ctem_init use diag_module, only: fv_diag_init + use dyn_tests_utils, only: vc_dycore, vc_moist_pressure, string_vc, vc_str_lgth ! arguments: type (dyn_import_t), intent(out) :: dyn_in @@ -497,8 +503,13 @@ subroutine dyn_init(dyn_in, dyn_out) integer :: budget_hfile_num character(len=*), parameter :: sub='dyn_init' + character (len=vc_str_lgth) :: vc_str !---------------------------------------------------------------------------- - + vc_dycore = vc_moist_pressure + if (masterproc) then + call string_vc(vc_dycore,vc_str) + write(iulog,*) sub//': vertical coordinate dycore : ',trim(vc_str) + end if dyn_state => get_dyn_state() grid => dyn_state%grid constants => dyn_state%constants @@ -688,6 +699,20 @@ subroutine dyn_init(dyn_in, dyn_out) call add_default('TTEND ' , budget_hfile_num, ' ') end if + thermodynamic_active_species_idx_dycore(:) = thermodynamic_active_species_idx(:) + do m=1,thermodynamic_active_species_liq_num + thermodynamic_active_species_liq_idx_dycore(m) = thermodynamic_active_species_liq_idx(m) + if (masterproc) then + write(iulog,*) sub//": m,thermodynamic_active_species_idx_liq_dycore: ",m,thermodynamic_active_species_liq_idx_dycore(m) + end if + end do + do m=1,thermodynamic_active_species_ice_num + thermodynamic_active_species_ice_idx_dycore(m) = thermodynamic_active_species_ice_idx(m) + if (masterproc) then + write(iulog,*) sub//": m,thermodynamic_active_species_idx_ice_dycore: ",m,thermodynamic_active_species_ice_idx_dycore(m) + end if + end do + end subroutine dyn_init !============================================================================================= @@ -822,23 +847,23 @@ subroutine dyn_run(ptop, ndt, te0, dyn_state, dyn_in, dyn_out, rc) use metdata, only: met_fix_mass use shr_reprosum_mod, only: shr_reprosum_calc - use physconst, only: physconst_calc_kappav + use cam_thermo, only: cam_thermo_calc_kappav #if defined( SPMD ) #include "mpif.h" #endif ! arguments - real(r8), intent(in) :: ptop ! Pressure at model top (interface pres) - integer, intent(in) :: ndt ! the large time step in seconds - ! Also the mapping time step in this setup + real(r8), intent(in) :: ptop ! Pressure at model top (interface pres) + integer, intent(in) :: ndt ! the large time step in seconds + ! Also the mapping time step in this setup - real(r8), intent(out) :: te0 ! Total energy before dynamics - type (T_FVDYCORE_STATE), target :: dyn_state ! Internal state - type (dyn_import_t) :: dyn_in ! Import container - type (dyn_export_t) :: dyn_out ! Export container + real(r8), intent(out) :: te0 ! Total energy before dynamics + type (T_FVDYCORE_STATE), target :: dyn_state ! Internal state + type (dyn_import_t), intent(in) :: dyn_in ! Import container + type (dyn_export_t), intent(inout) :: dyn_out ! Export container - integer, intent(out) :: rc ! Return code + integer, intent(out) :: rc ! Return code integer, parameter :: DYN_RUN_SUCCESS = 0 integer, parameter :: DYN_RUN_FAILURE = -1 @@ -1225,7 +1250,7 @@ subroutine dyn_run(ptop, ndt, te0, dyn_state, dyn_in, dyn_out, rc) #endif if (high_alt) then - call physconst_calc_kappav(ifirstxy,ilastxy,jfirstxy,jlastxy,1,km, grid%ntotq, tracer, cap3v, cpv=cp3v ) + call cam_thermo_calc_kappav( tracer, cap3v, cpv=cp3v ) else cp3v = cp cp3vc = cp @@ -2417,7 +2442,7 @@ subroutine dyn_run(ptop, ndt, te0, dyn_state, dyn_in, dyn_out, rc) ! These updates of cp3vc, cap3vc etc are currently not passed back to physics. ! This update is put here, after the transpose of pexy to pe, since we need pe (on yz decomp). - call physconst_calc_kappav(1,im,jfirst,jlast,kfirst,klast, grid%ntotq, q_internal, cap3vc ) + call cam_thermo_calc_kappav( q_internal, cap3vc ) !$omp parallel do private(i,j,k) do k = kfirst,klast diff --git a/src/dynamics/fv/dyn_grid.F90 b/src/dynamics/fv/dyn_grid.F90 index 722fd8e6fe..610df45831 100644 --- a/src/dynamics/fv/dyn_grid.F90 +++ b/src/dynamics/fv/dyn_grid.F90 @@ -1113,8 +1113,13 @@ subroutine define_cam_grids() ind = ind + 1 grid_map(1, ind) = 1 grid_map(2, ind) = i - grid_map(3, ind) = 1 - grid_map(4, ind) = i + if (beglonxy == 1) then + grid_map(3, ind) = 1 + grid_map(4, ind) = i + else + grid_map(3, ind) = 0 + grid_map(4, ind) = 0 + end if end do ! We need a special, size-one "longigude" coordinate ! NB: This is never a distributed coordinate so calc even on inactive PEs diff --git a/src/dynamics/fv/dynamics_vars.F90 b/src/dynamics/fv/dynamics_vars.F90 index 97cbfb7d34..73f8c1e26b 100644 --- a/src/dynamics/fv/dynamics_vars.F90 +++ b/src/dynamics/fv/dynamics_vars.F90 @@ -927,7 +927,6 @@ subroutine grid_vars_init(pi, ae, om, dt, fft_flt, & grid%cosp, grid%cose, ycrit) !for filtering of u and v in div4 damping - !(needs larger halo than cam3.5 code) call pft_cf(im, jm, js2gs, jn2gd, jn1gs, & grid%scdiv4, grid%sediv4, grid%dcdiv4, grid%dediv4, & grid%cosp, grid%cose, ycrit) diff --git a/src/dynamics/fv/metdata.F90 b/src/dynamics/fv/metdata.F90 index 3708394635..06957af5ef 100644 --- a/src/dynamics/fv/metdata.F90 +++ b/src/dynamics/fv/metdata.F90 @@ -1,5 +1,5 @@ module metdata -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! ! BOP ! @@ -29,12 +29,12 @@ module metdata pio_inq_dimid, pio_inq_dimlen, pio_closefile, pio_get_var, pio_inq_varid, & pio_offset_kind use cam_pio_utils, only: cam_pio_openfile - + implicit none private ! all unless made public - save + save ! !PUBLIC MEMBERS @@ -44,7 +44,7 @@ module metdata public :: get_met_fields ! interface to set meteorology fields public :: get_met_srf1 public :: get_met_srf2 - public :: get_us_vs + public :: get_us_vs public :: metdata_readnl public :: met_winds_on_walls public :: write_met_restart @@ -74,10 +74,10 @@ module metdata Interface get_met_fields ! overload accessors Module Procedure get_dyn_flds Module Procedure get_uv_centered - Module Procedure get_ps - Module Procedure get_ocn_ice_frcs + Module Procedure get_ps + Module Procedure get_ocn_ice_frcs End Interface - + real(r8), allocatable :: met_ps_next(:,:) ! PS interpolated to next timestep real(r8), allocatable :: met_ps_curr(:,:) ! PS interpolated to next timestep @@ -100,13 +100,13 @@ module metdata ! to the non land fraction, rather than just where ! LANDFRAC=1 logical :: met_srf_rad = .false. ! nudge albedo and lwup? - logical :: met_srf_refs = .false. ! nudge 2m Q and T and 10m wind - logical :: met_srf_sst = .false. ! nudge sea surface temperature + logical :: met_srf_refs = .false. ! nudge 2m Q and T and 10m wind + logical :: met_srf_sst = .false. ! nudge sea surface temperature logical :: met_srf_tau = .true. ! nudge taux and tauy logical :: met_nudge_temp = .true. ! nudge atmospheric temperature - - - ! radiation/albedo surface field fill value (where there is no sunlight) read in from input data file + + + ! radiation/albedo surface field fill value (where there is no sunlight) read in from input data file real(r8) :: srf_fill_value ! !REVISION HISTORY: @@ -117,13 +117,13 @@ module metdata ! 16 Dec 2004 F Vitt Added offline_met_defaultopts and offline_met_setopts ! 14 Jul 2005 W Sawyer Removed pmgrid, spmd_dyn dependencies ! 12 Apr 2006 W Sawyer Removed unneeded ghosting of met_us, met_vs -! 08 Apr 2010 J Edwards Replaced serial netcdf calls with pio interface +! 08 Apr 2010 J Edwards Replaced serial netcdf calls with pio interface ! ! EOP -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- ! $Id$ ! $Author$ -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- type input2d real(r8), dimension(:,:), pointer :: data => null() @@ -133,7 +133,7 @@ module metdata real(r8), dimension(:,:,:), pointer :: data => null() endtype input3d - real(r8), allocatable :: met_t(:,:,:) ! interpolated temperature + real(r8), allocatable :: met_t(:,:,:) ! interpolated temperature real(r8), allocatable :: met_u(:,:,:) ! interpolated zonal wind real(r8), allocatable :: met_v(:,:,:) ! interpolated meridional wind real(r8), allocatable :: met_us(:,:,:) ! interpolated zonal wind -staggered @@ -143,7 +143,7 @@ module metdata real(r8), allocatable :: met_lhflx(:,:)! interpolated latent heat flux real(r8), allocatable :: met_shflx(:,:)! interpolated sensible heat flux real(r8), allocatable :: met_qflx(:,:) ! interpolated water vapor flux - real(r8), allocatable :: met_taux(:,:) ! interpolated + real(r8), allocatable :: met_taux(:,:) ! interpolated real(r8), allocatable :: met_tauy(:,:) ! interpolated real(r8), allocatable :: met_snowh(:,:) ! interpolated snow height @@ -188,7 +188,7 @@ module metdata type(input2d) :: met_u10i(2) integer :: dateid ! var id of the date in the netCDF - integer :: secid ! var id of the sec data + integer :: secid ! var id of the sec data real(r8) :: datatimem = -1.e36_r8 ! time of prv. values read in real(r8) :: datatimep = -1.e36_r8 ! time of nxt. values read in real(r8) :: datatimemn = -1.e36_r8 ! time of prv. values read in for next timestep @@ -207,13 +207,13 @@ module metdata real(r8), pointer, dimension(:) :: curr_data_times => null() real(r8), pointer, dimension(:) :: next_data_times => null() - real(r8) :: alpha = 1.0_r8 ! don't read in water vapor + real(r8) :: alpha = 1.0_r8 ! don't read in water vapor ! real(r8), private :: alpha = 0.0 ! read in water vaper each time step real(r8), parameter :: D0_0 = 0.0_r8 real(r8), parameter :: D0_5 = 0.5_r8 real(r8), parameter :: D0_75 = 0.75_r8 - real(r8), parameter :: D1_0 = 1.0_r8 + real(r8), parameter :: D1_0 = 1.0_r8 real(r8), parameter :: days_per_month = 30.6_r8 real(r8), parameter :: days_per_non_leapyear = 365.0_r8 real(r8), parameter :: days_per_year = 365.25_r8 @@ -226,13 +226,13 @@ module metdata real(r8) :: met_rlx(pver) = 0._r8 integer :: met_levels integer :: num_met_levels - + real(r8) :: met_rlx_top = 60._r8 real(r8) :: met_rlx_bot = 50._r8 real(r8) :: met_rlx_bot_top = 0._r8 real(r8) :: met_rlx_bot_bot = 0._r8 - + real(r8) :: met_rlx_time = 0._r8 #if ( defined OFFLINE_DYN ) @@ -242,7 +242,7 @@ module metdata #endif logical :: has_ts = .false. logical :: has_lhflx = .false. ! Is LHFLX present in the met file? - + contains !------------------------------------------------------------------------- @@ -262,8 +262,8 @@ subroutine metdata_readnl(nlfile) namelist /metdata_nl/ & met_data_file, & - met_data_path, & - met_remove_file, & + met_data_path, & + met_remove_file, & met_cell_wall_winds, & met_filenames_list, & met_rlx_top, & @@ -283,7 +283,7 @@ subroutine metdata_readnl(nlfile) met_srf_land_scale, & met_srf_rad, & met_srf_refs, & - met_srf_sst, & + met_srf_sst, & met_srf_tau, & met_nudge_temp @@ -337,17 +337,17 @@ subroutine metdata_readnl(nlfile) write(iulog,*)'Time-variant meteorological dataset (met_data_file) is: ', trim(met_data_file) write(iulog,*)'Meteorological data file will be removed (met_remove_file): ', met_remove_file write(iulog,*)'Meteorological winds are on cell walls (met_cell_wall_winds): ', met_cell_wall_winds - write(iulog,*)'Meteorological file names list file: ', trim(met_filenames_list) + write(iulog,*)'Meteorological file names list file: ', trim(met_filenames_list) write(iulog,*)'Meteorological relax ramp region top at top is (km): ', met_rlx_top write(iulog,*)'Meteorological relax ramp region bottom at top is (km): ', met_rlx_bot write(iulog,*)'Meteorological relax ramp region top at bottom is (km): ', met_rlx_bot_top write(iulog,*)'Meteorological relax ramp region bottom at bottom is (km): ', met_rlx_bot_bot write(iulog,*)'Meteorological relaxation time (hours): ',met_rlx_time write(iulog,*)'Offline driver mass fixer is trurned on (met_fix_mass): ',met_fix_mass - write(iulog,*)'Meteorological shflx field name : ', trim(met_shflx_name) + write(iulog,*)'Meteorological shflx field name : ', trim(met_shflx_name) write(iulog,*)'Meteorological shflx multiplication factor : ', met_shflx_factor - write(iulog,*)'Meteorological qflx field name : ', trim(met_qflx_name) - write(iulog,*)'Meteorological qflx multiplication factor : ', met_qflx_factor + write(iulog,*)'Meteorological qflx field name : ', trim(met_qflx_name) + write(iulog,*)'Meteorological qflx multiplication factor : ', met_qflx_factor write(iulog,*)'Meteorological snowh multiplication factor : ', met_snowh_factor write(iulog,*)'Meteorological allow srf models feedbacks : ', met_srf_feedback write(iulog,*)'Meteorological allow srf land nudging : ', met_srf_land @@ -373,7 +373,7 @@ subroutine metdata_dyn_init(grid) type (T_FVDYCORE_GRID), intent(in) :: grid - integer :: im, km, jfirst, jlast, kfirst, klast + integer :: im, km, jfirst, jlast, kfirst, klast integer :: ng_d, ng_s im = grid%im @@ -401,7 +401,7 @@ subroutine metdata_dyn_init(grid) ! ! allocate space for data arrays ... -! +! ! dynamics grid allocate( met_psi_next(nm)%data(im, jfirst:jlast) ) @@ -471,7 +471,7 @@ subroutine metdata_phys_init call addfld ('MET_TREF', horiz_only, 'A', 'K', 'Meteorology TREF', gridname='physgrid') call addfld ('MET_U10', horiz_only, 'A', 'ms-1', 'Meteorology U10', gridname='physgrid') -! allocate chunked arrays +! allocate chunked arrays allocate( met_ti(nm)%data(pcols,pver,begchunk:endchunk) ) allocate( met_ti(np)%data(pcols,pver,begchunk:endchunk) ) @@ -505,7 +505,7 @@ subroutine metdata_phys_init allocate( met_tsi(np)%data(pcols,begchunk:endchunk) ) allocate( met_ts(pcols,begchunk:endchunk) ) met_ts(:,:) = nan - + if(.not.met_srf_feedback) then allocate( met_snowhi(nm)%data(pcols,begchunk:endchunk) ) allocate( met_snowhi(np)%data(pcols,begchunk:endchunk) ) @@ -572,7 +572,7 @@ end subroutine metdata_phys_init !----------------------------------------------------------------------- -! Reads more data if needed and interpolates data to current model time +! Reads more data if needed and interpolates data to current model time !----------------------------------------------------------------------- subroutine advance_met(grid) use cam_history, only : outfld @@ -620,8 +620,8 @@ subroutine advance_met(grid) end subroutine advance_met !------------------------------------------------------------------- -! Method to get some the meteorology data. -! Sets the following cam_in_t member fields to the +! Method to get some the meteorology data. +! Sets the following cam_in_t member fields to the ! meteorology data : ! qflx ! lhflx @@ -631,7 +631,7 @@ end subroutine advance_met ! snowh !------------------------------------------------------------------- subroutine get_met_srf2( cam_in ) - use camsrfexch, only: cam_in_t + use camsrfexch, only: cam_in_t use phys_grid, only: get_ncols_p use cam_history, only: outfld use shr_const_mod, only: shr_const_stebol @@ -643,7 +643,7 @@ subroutine get_met_srf2( cam_in ) integer :: c,ncol,i real(r8) :: met_rlx_sfc(pcols) - real(r8) :: lcl_rlx(pcols) + real(r8) :: lcl_rlx(pcols) do c=begchunk,endchunk ncol = get_ncols_p(c) @@ -660,9 +660,11 @@ subroutine get_met_srf2( cam_in ) ! Nudging land and forcing ocean. if (met_srf_land_scale) then - met_rlx_sfc(:ncol) = (1._r8 - cam_in(c)%landfrac(:ncol)) * met_rlx_sfc(:ncol) + cam_in(c)%landfrac(:ncol) * met_rlx(pver) + met_rlx_sfc(:ncol) = (1._r8 - cam_in(c)%landfrac(:ncol)) * & + met_rlx_sfc(:ncol) + & + cam_in(c)%landfrac(:ncol) * met_rlx(pver) else - where(cam_in(c)%landfrac(:ncol) .eq. 1._r8) met_rlx_sfc(:ncol) = 0._r8 + where(cam_in(c)%landfrac(:ncol) == 1._r8) met_rlx_sfc(:ncol) = 0._r8 end if end if @@ -670,7 +672,7 @@ subroutine get_met_srf2( cam_in ) cam_in(c)%wsx(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%wsx(:ncol) + met_rlx_sfc(:ncol) * met_taux(:ncol,c) cam_in(c)%wsy(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%wsy(:ncol) + met_rlx_sfc(:ncol) * met_tauy(:ncol,c) end if - + cam_in(c)%shf(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%shf(:ncol) + & met_rlx_sfc(:ncol) * (met_shflx(:ncol,c) * met_shflx_factor) cam_in(c)%cflx(:ncol,1) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%cflx(:ncol,1) + & @@ -693,40 +695,61 @@ subroutine get_met_srf2( cam_in ) ! an area with no downwelling solar. Time interpolate around the terminator could cause ! problems, but the interpolation provides a non-fill value if either endpoint of the ! interpolation is not fill. - lcl_rlx(:ncol) = met_rlx_sfc(:ncol) - where(met_asdir(:ncol,c) .eq. srf_fill_value) lcl_rlx(:ncol) = 0._r8 - cam_in(c)%asdir(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%asdir(:ncol) + lcl_rlx(:ncol) * met_asdir(:ncol,c) - - lcl_rlx(:ncol) = met_rlx_sfc(:ncol) - where(met_asdif(:ncol,c) .eq. srf_fill_value) lcl_rlx(:ncol) = 0._r8 - cam_in(c)%asdif(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%asdif(:ncol) + lcl_rlx(:ncol) * met_asdif(:ncol,c) - - lcl_rlx(:ncol) = met_rlx_sfc(:ncol) - where(met_aldir(:ncol,c) .eq. srf_fill_value) lcl_rlx(:ncol) = 0._r8 - cam_in(c)%aldir(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%aldir(:ncol) + lcl_rlx(:ncol) * met_aldir(:ncol,c) - - lcl_rlx(:ncol) = met_rlx_sfc(:ncol) - where(met_aldif(:ncol,c) .eq. srf_fill_value) lcl_rlx(:ncol) = 0._r8 - cam_in(c)%aldif(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%aldif(:ncol) + lcl_rlx(:ncol) * met_aldif(:ncol,c) - - cam_in(c)%lwup(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%lwup(:ncol) + met_rlx_sfc(:ncol) * met_lwup(:ncol,c) + where(met_asdir(:ncol,c) == srf_fill_value) + lcl_rlx(:ncol) = 0._r8 + elsewhere + lcl_rlx(:ncol) = met_rlx_sfc(:ncol) + end where + cam_in(c)%asdir(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%asdir(:ncol) + lcl_rlx(:ncol) * met_asdir(:ncol,c) + + where(met_asdif(:ncol,c) == srf_fill_value) + lcl_rlx(:ncol) = 0._r8 + elsewhere + lcl_rlx(:ncol) = met_rlx_sfc(:ncol) + end where + cam_in(c)%asdif(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%asdif(:ncol) + lcl_rlx(:ncol) * met_asdif(:ncol,c) + + where(met_aldir(:ncol,c) == srf_fill_value) + lcl_rlx(:ncol) = 0._r8 + elsewhere + lcl_rlx(:ncol) = met_rlx_sfc(:ncol) + end where + cam_in(c)%aldir(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%aldir(:ncol) + lcl_rlx(:ncol) * met_aldir(:ncol,c) + + where(met_aldif(:ncol,c) == srf_fill_value) + lcl_rlx(:ncol) = 0._r8 + elsewhere + lcl_rlx(:ncol) = met_rlx_sfc(:ncol) + end where + cam_in(c)%aldif(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%aldif(:ncol) + lcl_rlx(:ncol) * met_aldif(:ncol,c) + + cam_in(c)%lwup(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%lwup(:ncol) + met_rlx_sfc(:ncol) * met_lwup(:ncol,c) end if if (met_srf_refs) then - cam_in(c)%qref(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%qref(:ncol) + met_rlx_sfc(:ncol) * met_qref(:ncol,c) - cam_in(c)%tref(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%tref(:ncol) + met_rlx_sfc(:ncol) * met_tref(:ncol,c) - cam_in(c)%u10(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%u10(:ncol) + met_rlx_sfc(:ncol) * met_u10(:ncol,c) + cam_in(c)%qref(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%qref(:ncol) + met_rlx_sfc(:ncol) * met_qref(:ncol,c) + cam_in(c)%tref(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%tref(:ncol) + met_rlx_sfc(:ncol) * met_tref(:ncol,c) + cam_in(c)%u10(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%u10(:ncol) + met_rlx_sfc(:ncol) * met_u10(:ncol,c) end if if (met_srf_sst) then ! Meteorological sst is 0 over 100% land, so use the cam_in value if the meteorology thinks ! it is land. - lcl_rlx(:ncol) = met_rlx_sfc(:ncol) - where(met_sst(:ncol,c) .eq. srf_fill_value) lcl_rlx(:ncol) = 0._r8 - cam_in(c)%sst(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%sst(:ncol) + lcl_rlx(:ncol) * met_sst(:ncol,c) + where(met_sst(:ncol,c) == srf_fill_value) + lcl_rlx(:ncol) = 0._r8 + elsewhere + lcl_rlx(:ncol) = met_rlx_sfc(:ncol) + end where + cam_in(c)%sst(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%sst(:ncol) + lcl_rlx(:ncol) * met_sst(:ncol,c) + + where(met_icefrac(:ncol,c) == srf_fill_value) + lcl_rlx(:ncol) = 0._r8 + elsewhere + lcl_rlx(:ncol) = met_rlx_sfc(:ncol) + end where + cam_in(c)%icefrac(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%icefrac(:ncol) + lcl_rlx(:ncol) * met_icefrac(:ncol,c) - cam_in(c)%icefrac(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%icefrac(:ncol) + lcl_rlx(:ncol) * met_icefrac(:ncol,c) end if end do ! Chunk loop @@ -749,7 +772,7 @@ subroutine get_met_srf2( cam_in ) write(iulog,*)'METDATA maxval(met_icefrac),minval(met_icefrac): ',maxval(met_icefrac),minval(met_icefrac) endif endif - + do c = begchunk, endchunk call outfld('MET_TAUX',cam_in(c)%wsx , pcols ,c ) call outfld('MET_TAUY',cam_in(c)%wsy , pcols ,c ) @@ -773,7 +796,7 @@ end subroutine get_met_srf2 !------------------------------------------------------------------- !------------------------------------------------------------------- subroutine get_met_srf1( cam_in ) - use camsrfexch, only: cam_in_t + use camsrfexch, only: cam_in_t use phys_grid, only: get_ncols_p use cam_history, only: outfld use shr_const_mod, only: shr_const_stebol @@ -783,7 +806,7 @@ subroutine get_met_srf1( cam_in ) type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in integer :: c,ncol,i - + if (met_srf_feedback) return if (.not.has_ts) then call endrun('The meteorolgy input must have TS to run with met_srf_feedback set to FALSE') @@ -823,22 +846,26 @@ subroutine get_ocn_ice_frcs( lndfrc, ocnfrc, icefrc, lchnk, ncol ) real(r8), intent(out) :: ocnfrc (pcols) real(r8), intent(out) :: icefrc (pcols) - integer, intent(in) :: lchnk + integer, intent(in) :: lchnk integer, intent(in) :: ncol ! local vars integer :: i - + if (met_srf_sst) then do i = 1,ncol ! If configured for using SST, and ICEFRAC, then get icefrc ! directly from the meteorological data. - icefrc(i) = min(met_icefrac(i,lchnk), 1._r8 - lndfrc(i)) + if (met_icefrac(i,lchnk) == srf_fill_value) then + icefrc(i) = 0._r8 + else + icefrc(i) = min(met_icefrac(i,lchnk), 1._r8 - lndfrc(i)) + end if ocnfrc(i) = 1._r8 - lndfrc(i) - icefrc(i) enddo else - + if (.not.has_ts) then if (masterproc) then write(iulog,*) 'get_ocn_ice_frcs: TS is not in the met dataset and cannot set ocnfrc and icefrc' @@ -866,7 +893,7 @@ subroutine get_ocn_ice_frcs( lndfrc, ocnfrc, icefrc, lchnk, ncol ) endsubroutine get_ocn_ice_frcs !------------------------------------------------------------------- -! allows access to physics state fields +! allows access to physics state fields ! q : water vapor ! ps : surface pressure ! t : temperature @@ -876,7 +903,9 @@ subroutine get_dyn_flds( state, tend, dt ) use physics_types, only: physics_state, physics_tend, physics_dme_adjust use ppgrid, only: pcols, pver, begchunk, endchunk use phys_grid, only: get_ncols_p - use cam_history, only: outfld + use cam_history, only: outfld + use air_composition,only: thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num + use air_composition,only: thermodynamic_active_species_liq_idx,thermodynamic_active_species_ice_idx implicit none @@ -887,22 +916,37 @@ subroutine get_dyn_flds( state, tend, dt ) integer :: lats(pcols) ! array of latitude indices integer :: lons(pcols) ! array of longitude indices integer :: c, ncol, i,j,k - real(r8):: qini(pcols,pver) ! initial specific humidity + integer :: m_cnst,m + real(r8):: qini(pcols,pver) ! initial specific humidity + real(r8):: totliqini(pcols,pver) ! initial total liquid + real(r8):: toticeini(pcols,pver) ! initial total ice real(r8) :: tmp(pcols,pver) - + call t_startf('MET__GET_DYN2') - + do c = begchunk, endchunk ncol = get_ncols_p(c) + ! + ! update water variables + ! + qini(:ncol,:pver) = state(c)%q(:ncol,:pver,1) + totliqini = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_liq_num + m = thermodynamic_active_species_liq_idx(m_cnst) + totliqini(:ncol,:pver) = totliqini(:ncol,:pver)+state(c)%q(:ncol,:pver,m) + end do + toticeini = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_ice_num + m = thermodynamic_active_species_ice_idx(m_cnst) + toticeini(:ncol,:pver) = toticeini(:ncol,:pver)+state(c)%q(:ncol,:pver,m) + end do + do k=1,pver do i=1,ncol if (met_nudge_temp) then state(c)%t(i,k) = (1._r8-met_rlx(k))*state(c)%t(i,k) + met_rlx(k)*met_t(i,k,c) end if - - qini(i,k) = state(c)%q(i,k,1) - ! at this point tracer mixing ratios have already been ! converted from dry to moist state(c)%q(i,k,1) = alpha*state(c)%q(i,k,1) + (D1_0-alpha)*met_q(i,k,c) @@ -915,7 +959,7 @@ subroutine get_dyn_flds( state, tend, dt ) ! now adjust mass of each layer now that water vapor has changed if (( .not. online_test ) .and. (alpha .ne. D1_0 )) then - call physics_dme_adjust(state(c), tend(c), qini, dt) + call physics_dme_adjust(state(c), tend(c), qini, totliqini, toticeini, dt) endif end do @@ -926,7 +970,7 @@ subroutine get_dyn_flds( state, tend, dt ) write(iulog,*)'METDATA maxval(met_ps_next),minval(met_ps_next): ', maxval(met_ps_next),minval(met_ps_next) endif endif - + do c = begchunk, endchunk call outfld('MET_T ',state(c)%t , pcols ,c ) enddo @@ -986,7 +1030,7 @@ subroutine get_uv_centered( grid, u, v ) minval(v(:, max(1,jfirst-ng_s):min(jm,jlast+ng_d), kfirst:klast )) endif - if ( grid%twod_decomp .eq. 0 ) then + if ( grid%twod_decomp == 0 ) then do j = jfirst, jlast do k = kfirst, klast do i = 1, grid%im @@ -1023,7 +1067,7 @@ subroutine get_ps( grid, ps, nsubsteps, n ) ps(:,:) = met_ps_curr(:,:) + num1*(met_ps_next(:,:)-met_ps_curr(:,:))/num2 - if ( grid%twod_decomp .eq. 0 ) then + if ( grid%twod_decomp == 0 ) then do j = grid%jfirst, grid%jlast call outfld('MET_PS',ps(:,j), grid%im ,j ) enddo @@ -1099,14 +1143,14 @@ end subroutine get_us_vs subroutine write_met_restart_pio(File) type(file_desc_t), intent(inout) :: File - integer :: ierr + integer :: ierr ierr = pio_put_att(File, PIO_GLOBAL, 'current_metdata_filename', curr_filename) ierr = pio_put_att(File, PIO_GLOBAL, 'next_metdata_filename', next_filename) end subroutine write_met_restart_pio subroutine read_met_restart_pio(File) type(file_desc_t), intent(inout) :: File - + integer :: ierr, xtype integer(pio_offset_kind) :: slen @@ -1161,8 +1205,8 @@ subroutine read_met_restart_bin( nrg ) end if #if ( defined SPMD ) - call mpibcast ( curr_filename ,len(curr_filename) ,mpichar,0,mpicom) - call mpibcast ( next_filename ,len(next_filename) ,mpichar,0,mpicom) + call mpibcast ( curr_filename ,len(curr_filename) ,mpichar,0,mpicom) + call mpibcast ( next_filename ,len(next_filename) ,mpichar,0,mpicom) #endif end subroutine read_met_restart_bin @@ -1254,7 +1298,7 @@ subroutine check_files() ! ... local variables !----------------------------------------------------------------------- character(len=256) :: ctmp - character(len=256) :: loc_fname + character(len=256) :: loc_fname integer :: istat @@ -1275,8 +1319,8 @@ subroutine check_files() ! remove if requested if( met_remove_file ) then call getfil( curr_filename, loc_fname, 0 ) - write(iulog,*) 'check_files: removing file = ',trim(loc_fname) - ctmp = 'rm -f ' // trim(loc_fname) + write(iulog,*) 'check_files: removing file = ',trim(loc_fname) + ctmp = 'rm -f ' // trim(loc_fname) write(iulog,*) 'check_files: fsystem issuing command - ' write(iulog,*) trim(ctmp) call shr_sys_system( ctmp, istat ) @@ -1318,6 +1362,7 @@ function incr_filename( filename ) character(len=*), intent(in) :: filename ! present dynamical dataset filename character(len=256) :: incr_filename ! next filename in the sequence + character(len=*), parameter :: subname = 'incr_filename' ! set new next_filename ... @@ -1330,7 +1375,7 @@ function incr_filename( filename ) character(len=5) :: num integer :: ios,unitnumber - if ( len_trim(met_filenames_list) .eq. 0) then + if ( len_trim(met_filenames_list) == 0) then !----------------------------------------------------------------------- ! ... ccm type filename !----------------------------------------------------------------------- @@ -1344,14 +1389,14 @@ function incr_filename( filename ) if( istat /= 0 ) then write(iulog,*) 'incr_flnm: incstr returned ', istat write(iulog,*) ' while trying to decrement ',trim( fn_new ) - call endrun + call endrun (subname // ':: ERRROR - check atm.log for error message') end if else ! open met_filenames_list if (masterproc) write(iulog,*) 'incr_flnm: old filename = ',trim(filename) - if (masterproc) write(iulog,*) 'incr_flnm: open met_filenames_list : ',met_filenames_list + if (masterproc) write(iulog,*) 'incr_flnm: open met_filenames_list : ',met_filenames_list unitnumber = shr_file_getUnit() open( unit=unitnumber, file=met_filenames_list, iostat=ios, status="OLD") if (ios /= 0) then @@ -1359,18 +1404,18 @@ function incr_filename( filename ) endif ! read file names - read( unit=unitnumber, fmt='(A)', iostat=ios ) line + read( unit=unitnumber, fmt='(A)', iostat=ios ) line if (ios /= 0) then call endrun('not able to increment file name from met_filenames_list file: '//met_filenames_list) endif do while( trim(line) /= trim(filename) ) - read( unit=unitnumber, fmt='(A)', iostat=ios ) line + read( unit=unitnumber, fmt='(A)', iostat=ios ) line if (ios /= 0) then call endrun('not able to increment file name from met_filenames_list file: '//met_filenames_list) endif enddo - read( unit=unitnumber, fmt='(A)', iostat=ios ) line + read( unit=unitnumber, fmt='(A)', iostat=ios ) line if (ios /= 0) then call endrun('not able to increment file name from met_filenames_list file: '//met_filenames_list) endif @@ -1394,9 +1439,10 @@ subroutine find_times( itms, fids, datatm, datatp, time ) type(file_desc_t), intent(out) :: fids(2) ! ids of files that contains these recs real(r8), intent(in) :: time ! time of interest real(r8), intent(out):: datatm, datatp + character(len=*), parameter :: subname = 'find_times' integer np1 ! current forward time index of dataset - integer n,i ! + integer n,i ! integer :: curr_tsize, next_tsize, all_tsize real(r8), allocatable, dimension(:):: all_data_times @@ -1412,7 +1458,7 @@ subroutine find_times( itms, fids, datatm, datatp, time ) all_data_times(:curr_tsize) = curr_data_times(:) if (next_tsize > 0) all_data_times(curr_tsize+1:all_tsize) = next_data_times(:) - ! find bracketing times + ! find bracketing times do n=1, all_tsize-1 np1 = n + 1 datatm = all_data_times(n) @@ -1427,19 +1473,19 @@ subroutine find_times( itms, fids, datatm, datatp, time ) write(iulog,*)' datatp = ',datatp write(iulog,*)' all_data_times = ',all_data_times - call endrun + call endrun (subname // ':: ERRROR - check atm.log for error message') 20 continue deallocate( all_data_times ) - + itms(1) = n itms(2) = np1 fids(:) = curr_fileid - + do i=1,2 - if ( itms(i) > curr_tsize ) then - itms(i) = itms(i) - curr_tsize + if ( itms(i) > curr_tsize ) then + itms(i) = itms(i) - curr_tsize fids(i) = next_fileid endif enddo @@ -1456,7 +1502,7 @@ subroutine read_next_ps(grid) type (T_FVDYCORE_GRID), intent(in) :: grid integer :: recnos(2) - type(file_desc_t) :: fids(2) + type(file_desc_t) :: fids(2) character(len=8) :: varname integer :: ifirstxy, ilastxy, jfirstxy, jlastxy @@ -1506,7 +1552,7 @@ subroutine transpose_xy2yz_2d( xy_2d, yz_2d, grid ) integer :: i,j,k if (grid%iam .lt. grid%npes_xy) then - if ( grid%twod_decomp .eq. 1 ) then + if ( grid%twod_decomp == 1 ) then #if defined( SPMD ) !$omp parallel do private(i,j,k) @@ -1543,7 +1589,7 @@ subroutine transpose_xy2yz_3d( xy_3d, yz_3d, grid ) real(r8), intent(out) :: yz_3d(1:grid%im, grid%jfirst:grid%jlast, grid%kfirst:grid%klast) if (grid%iam .lt. grid%npes_xy) then - if ( grid%twod_decomp .eq. 1 ) then + if ( grid%twod_decomp == 1 ) then #if defined( SPMD ) call mp_sendirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, & grid%ijk_xy_to_yz%RecvDesc, xy_3d, yz_3d, & @@ -1571,7 +1617,7 @@ subroutine read_next_metdata(grid) implicit none type (T_FVDYCORE_GRID), intent(in) :: grid - integer recnos(2), i ! + integer recnos(2), i ! type(file_desc_t) :: fids(2) character(len=8) :: Uname, Vname, Tname, Qname, psname @@ -1624,7 +1670,7 @@ subroutine read_next_metdata(grid) Uname='U' Vname='V' end if - + end if @@ -1685,7 +1731,7 @@ subroutine read_next_metdata(grid) met_qi(i)%data(:,blev1:elev1,:) = tmp_data(:, blev2:elev2, :) - if (met_cell_wall_winds) then + if (met_cell_wall_winds) then wrk3_xy = 0._r8 met_usi(i)%data(:,:,:) = 0._r8 @@ -1760,12 +1806,12 @@ subroutine read_phys_srf_flds( ) call infld(met_shflx_name, fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & met_shflxi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) - + if (has_lhflx) then call infld('LHFLX', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & met_lhflxi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) end if - + call infld(met_qflx_name, fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & met_qflxi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) call infld('TAUX', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & @@ -1785,31 +1831,31 @@ subroutine read_phys_srf_flds( ) if (met_srf_rad) then call infld('ASDIR', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & - met_asdiri(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + met_asdiri(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) call infld('ASDIF', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & - met_asdifi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + met_asdifi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) call infld('ALDIR', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & - met_aldiri(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + met_aldiri(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) call infld('ALDIF', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & - met_aldifi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + met_aldifi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) call infld('LWUP', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & - met_lwupi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + met_lwupi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) endif - + if (met_srf_refs) then call infld('QREF', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & - met_qrefi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + met_qrefi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) call infld('TREF', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & - met_trefi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + met_trefi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) call infld('U10', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & - met_u10i(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + met_u10i(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) endif - + if (met_srf_sst) then call infld('SST', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & - met_ssti(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + met_ssti(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) call infld('ICEFRAC', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, & - met_icefraci(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) + met_icefraci(i)%data, readvar, gridname='physgrid',timelevel=recnos(i)) endif enddo end subroutine read_phys_srf_flds @@ -1825,7 +1871,7 @@ subroutine interp_phys_srf_flds( ) deltat = datatimep - datatimem fact1 = (datatimep - curr_mod_time)/deltat fact2 = D1_0-fact1 - + do c=begchunk,endchunk ncol = get_ncols_p(c) @@ -1863,33 +1909,33 @@ subroutine interp_phys_srf_flds( ) ! solar. However, this changes slowly, so for interpolation use either end-point ! if nothing is present. If there is no solar, then the albedo won't matter, so ! should not cause problems. - if (met_asdiri(nm)%data(i,c) .eq. srf_fill_value) then + if (met_asdiri(nm)%data(i,c) == srf_fill_value) then met_asdir(i,c) = met_asdiri(np)%data(i,c) - else if (met_asdiri(np)%data(i,c) .eq. srf_fill_value) then + else if (met_asdiri(np)%data(i,c) == srf_fill_value) then met_asdir(i,c) = met_asdiri(nm)%data(i,c) else met_asdir(i,c) = fact1*met_asdiri(nm)%data(i,c) + fact2*met_asdiri(np)%data(i,c) endif - if (met_asdifi(nm)%data(i,c) .eq. srf_fill_value) then + if (met_asdifi(nm)%data(i,c) == srf_fill_value) then met_asdif(i,c) = met_asdifi(np)%data(i,c) - else if (met_asdifi(np)%data(i,c) .eq. srf_fill_value) then + else if (met_asdifi(np)%data(i,c) == srf_fill_value) then met_asdif(i,c) = met_asdifi(nm)%data(i,c) else met_asdif(i,c) = fact1*met_asdifi(nm)%data(i,c) + fact2*met_asdifi(np)%data(i,c) endif - if (met_aldiri(nm)%data(i,c) .eq. srf_fill_value) then + if (met_aldiri(nm)%data(i,c) == srf_fill_value) then met_aldir(i,c) = met_aldiri(np)%data(i,c) - else if (met_aldiri(np)%data(i,c) .eq. srf_fill_value) then + else if (met_aldiri(np)%data(i,c) == srf_fill_value) then met_aldir(i,c) = met_aldiri(nm)%data(i,c) else met_aldir(i,c) = fact1*met_aldiri(nm)%data(i,c) + fact2*met_aldiri(np)%data(i,c) endif - if (met_aldifi(nm)%data(i,c) .eq. srf_fill_value) then + if (met_aldifi(nm)%data(i,c) == srf_fill_value) then met_aldif(i,c) = met_aldifi(np)%data(i,c) - else if (met_aldifi(np)%data(i,c) .eq. srf_fill_value) then + else if (met_aldifi(np)%data(i,c) == srf_fill_value) then met_aldif(i,c) = met_aldifi(nm)%data(i,c) else met_aldif(i,c) = fact1*met_aldifi(nm)%data(i,c) + fact2*met_aldifi(np)%data(i,c) @@ -1915,18 +1961,25 @@ subroutine interp_phys_srf_flds( ) do i=1,ncol ! The sst is fill value over land, which should not change from timestep to ! timestep, but just in case use the sst value if only one is present. - if (met_ssti(nm)%data(i,c) .eq. srf_fill_value) then + if (met_ssti(nm)%data(i,c) == srf_fill_value) then met_sst(i,c) = met_ssti(np)%data(i,c) - else if (met_ssti(np)%data(i,c) .eq. srf_fill_value) then + else if (met_ssti(np)%data(i,c) == srf_fill_value) then met_sst(i,c) = met_ssti(nm)%data(i,c) else met_sst(i,c) = fact1*met_ssti(nm)%data(i,c) + fact2*met_ssti(np)%data(i,c) endif - met_icefrac(i,c) = fact1*met_icefraci(nm)%data(i,c) + fact2*met_icefraci(np)%data(i,c) + + if (met_icefraci(nm)%data(i,c) == srf_fill_value) then + met_icefrac(i,c) = met_icefraci(np)%data(i,c) + else if (met_ssti(np)%data(i,c) == srf_fill_value) then + met_icefrac(i,c) = met_icefraci(nm)%data(i,c) + else + met_icefrac(i,c) = fact1*met_icefraci(nm)%data(i,c) + fact2*met_icefraci(np)%data(i,c) + endif enddo enddo endif - + end subroutine interp_phys_srf_flds !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ @@ -2064,8 +2117,9 @@ subroutine open_met_datafile( fname, fileid, times, datapath, check_dims, grid ) logical, optional, intent(in) :: check_dims type (T_FVDYCORE_GRID), optional, intent(in) :: grid - character(len=256) :: filepath - character(len=256) :: filen + character(len=256) :: filepath + character(len=256) :: filen + character(len=*), parameter :: subname = 'open_met_datafile' integer :: year, month, day, dsize, i, timesize integer :: dateid,secid integer, allocatable , dimension(:) :: dates, datesecs @@ -2119,7 +2173,7 @@ subroutine open_met_datafile( fname, fileid, times, datapath, check_dims, grid ) enddo deallocate( dates ) - deallocate( datesecs ) + deallocate( datesecs ) ! @@ -2135,12 +2189,12 @@ subroutine open_met_datafile( fname, fileid, times, datapath, check_dims, grid ) call get_dimension( fileid, 'lon', dsize ) if (dsize /= im) then write(iulog,*)'open_met_datafile: lonsiz=',dsize,' must = ',im - call endrun + call endrun (subname // ':: ERRROR - check atm.log for error message') endif call get_dimension( fileid, 'lat', dsize ) if (dsize /= jm) then write(iulog,*)'open_met_datafile: latsiz=',dsize,' must = ',jm - call endrun + call endrun (subname // ':: ERRROR - check atm.log for error message') endif call get_dimension( fileid, 'lev', dsize ) met_levels = min( dsize, km ) @@ -2152,7 +2206,7 @@ subroutine open_met_datafile( fname, fileid, times, datapath, check_dims, grid ) ierr = pio_inq_varid( fileid, 'ASDIR', varid ) ierr = pio_get_att( fileid, varid, '_FillValue', srf_fill_value) endif - + end subroutine open_met_datafile !------------------------------------------------------------------------------ @@ -2188,7 +2242,7 @@ function get_time_float( year, month, day, sec ) else ! assume no_leap (all years are 365 days) fltdy = (year - refyr)*days_per_non_leapyear + & (doy(month)-doy(refmn)) + & - (day-refdy) + (day-refdy) endif get_time_float = fltdy + ((sec-refsc)/seconds_per_day) @@ -2259,7 +2313,7 @@ subroutine set_met_rlx( ) dtime_hrs = get_step_size()/hsec ! hours - if (met_rlx_time > dtime_hrs) then + if (met_rlx_time > dtime_hrs) then met_max_rlxdt = dtime_hrs/met_rlx_time elseif (met_rlx_time < 0._r8) then met_max_rlxdt = 0._r8 @@ -2307,7 +2361,7 @@ subroutine set_met_rlx( ) k_top = max(plev - met_levels, 1) ! ramp region at model top - k_cnt = count(p_top < hypm .and. hypm < p_bot) + k_cnt = count(p_top < hypm .and. hypm < p_bot) if (k_cnt > 0) then k_top = max(plev - met_levels, 1) do while ( met_rlx(k_top) /= 999._r8 ) @@ -2324,7 +2378,7 @@ subroutine set_met_rlx( ) if (masterproc) then write(iulog,*) 'top of model ramped region:' write(iulog,fmt=996) 'k_cnt = ',k_cnt - write(iulog,fmt=996) 'k_top = ',k_top + write(iulog,fmt=996) 'k_top = ',k_top endif do k = k_top,k_top+k_cnt @@ -2342,13 +2396,13 @@ subroutine set_met_rlx( ) call endrun ( 'set_met_rlx: cannot find ramped region ') endif enddo - + if (masterproc) then write(iulog,*) 'bottom of model ramped region:' write(iulog,fmt=996) 'k_cnt = ',k_cnt - write(iulog,fmt=996) 'k_top = ',k_top + write(iulog,fmt=996) 'k_top = ',k_top endif - + do k = k_top,k_top+k_cnt-1 met_rlx(k) = met_max_rlxdt*(1._r8 - real( k - k_top +1) / real(k_cnt)) enddo diff --git a/src/dynamics/fv/stepon.F90 b/src/dynamics/fv/stepon.F90 index 6d6efa9702..18bfd0fa3a 100644 --- a/src/dynamics/fv/stepon.F90 +++ b/src/dynamics/fv/stepon.F90 @@ -3,7 +3,7 @@ module stepon !---------------------------------------------------------------------- ! stepon provides the interface layer that allows the different dynamical ! cores to be called from different locations in the time loop. It also -! provides a standard interface that is called from the higher level CAM +! provides a standard interface that is called from the higher level CAM ! component run methods while leaving non-standardized dycore interface ! methods to be called from this layer. Ideally only the run methods ! which allow flexibility in the dynamics/physics calling sequence should @@ -14,7 +14,7 @@ module stepon use shr_kind_mod, only: r8 => shr_kind_r8 use spmd_utils, only: mpicom, iam, masterproc -use cam_control_mod, only: initial_run, moist_physics, simple_phys +use cam_control_mod, only: initial_run, moist_physics use ppgrid, only: begchunk, endchunk use physconst, only: zvir, cappa @@ -28,6 +28,10 @@ module stepon use cam_abortutils, only: endrun use perf_mod, only: t_startf, t_stopf, t_barrierf +use aerosol_properties_mod, only: aerosol_properties +use aerosol_state_mod, only: aerosol_state +use microp_aero, only: aerosol_state_object, aerosol_properties_object + implicit none private save @@ -49,6 +53,9 @@ module stepon ! set it to false for production runs real (r8) :: ptop +class(aerosol_properties), pointer :: aero_props_obj => null() +logical :: aerosols_transported = .false. + !========================================================================================= contains !========================================================================================= @@ -57,8 +64,10 @@ subroutine stepon_init(dyn_in, dyn_out) use constituents, only: pcnst use time_manager, only: get_step_size - use physconst, only: physconst_calc_kappav, rair, cpair + use physconst, only: rair, cpair + use cam_thermo, only: cam_thermo_calc_kappav use inic_analytic, only: analytic_ic_active + use cam_initfiles, only: scale_dry_air_mass type (dyn_import_t) :: dyn_in ! Dynamics import container type (dyn_export_t) :: dyn_out ! Dynamics export container @@ -77,6 +86,7 @@ subroutine stepon_init(dyn_in, dyn_out) real(r8), allocatable :: delpdryxy(:,:,:) real(r8), allocatable :: cap3vi(:,:,:), cappa3v(:,:,:) + !---------------------------------------------------------------------------- if (.not. initial_run) nlres=.true. @@ -127,9 +137,9 @@ subroutine stepon_init(dyn_in, dyn_out) enddo enddo else - + ! Initial run --> generate pe and delp from the surface pressure - + !$omp parallel do private(i,j,k) do j = jfirstxy, jlastxy do k=1,km+1 @@ -154,7 +164,7 @@ subroutine stepon_init(dyn_in, dyn_out) ! Print out diagnostic message if restart run !---------------------------------------------------------- - if (.not. simple_phys) then + if (scale_dry_air_mass /= 0.0_r8) then call dryairm( grid, .true., dyn_in%ps, dyn_in%tracer, & dyn_in%delp, dyn_in%pe, nlres ) endif @@ -164,7 +174,7 @@ subroutine stepon_init(dyn_in, dyn_out) allocate( cappa3v(ifirstxy:ilastxy,jfirstxy:jlastxy,km) ) allocate( cap3vi(ifirstxy:ilastxy,jfirstxy:jlastxy,km+1) ) if (grid%high_alt) then - call physconst_calc_kappav( ifirstxy,ilastxy,jfirstxy,jlastxy,1,km, grid%ntotq, dyn_in%tracer, cappa3v ) + call cam_thermo_calc_kappav( dyn_in%tracer, cappa3v ) !$omp parallel do private(i,j,k) do k=2,km @@ -213,7 +223,7 @@ subroutine stepon_init(dyn_in, dyn_out) do i = ifirstxy, ilastxy dyn_in%pt(i,j,k) = dyn_in%t3(i,j,k)* & (1._r8 + zvir*dyn_in%tracer(i,j,k,1)) & - /dyn_in%pkz(i,j,k) + /dyn_in%pkz(i,j,k) enddo enddo enddo @@ -251,7 +261,15 @@ subroutine stepon_init(dyn_in, dyn_out) end if end do deallocate (delpdryxy) - + + end if + + ! get aerosol properties + aero_props_obj => aerosol_properties_object() + + if (associated(aero_props_obj)) then + ! determine if there are transported aerosol contistuents + aerosols_transported = aero_props_obj%number_transported()>0 end if end subroutine stepon_init @@ -265,7 +283,7 @@ subroutine stepon_run1( dtime_out, phys_state, phys_tend, pbuf2d, & use dp_coupling, only: d_p_coupling use dyn_comp, only: dyn_run - + use physics_buffer, only: physics_buffer_desc use advect_tend, only: compute_adv_tends_xyz @@ -279,7 +297,11 @@ subroutine stepon_run1( dtime_out, phys_state, phys_tend, pbuf2d, & type(T_FVDYCORE_STATE), pointer :: dyn_state - integer :: rc + integer :: rc + + integer :: c + class(aerosol_state), pointer :: aero_state_obj + nullify(aero_state_obj) dtime_out = dtime dyn_state => get_dyn_state() @@ -296,9 +318,9 @@ subroutine stepon_run1( dtime_out, phys_state, phys_tend, pbuf2d, & call t_stopf ('comp_adv_tends1') ! !-------------------------------------------------------------------------- - ! Perform finite-volume dynamics -- this dynamical core contains some + ! Perform finite-volume dynamics -- this dynamical core contains some ! yet to be published algorithms. Its use in the CAM is - ! for software development purposes only. + ! for software development purposes only. ! Please contact S.-J. Lin (Shian-Jiann.Lin@noaa.gov) ! if you plan to use this mudule for scientific purposes. Contact S.-J. Lin ! or Will Sawyer (sawyer@gmao.gsfc.nasa.gov) if you plan to modify the @@ -318,7 +340,7 @@ subroutine stepon_run1( dtime_out, phys_state, phys_tend, pbuf2d, & write(iulog,*) "STEPON_RUN: dyn_run returned bad error code", rc write(iulog,*) "Quitting." call endrun - endif + endif call t_stopf ('dyn_run') call t_startf ('comp_adv_tends2') @@ -333,12 +355,26 @@ subroutine stepon_run1( dtime_out, phys_state, phys_tend, pbuf2d, & call d_p_coupling(dyn_state%grid, phys_state, phys_tend, pbuf2d, dyn_out) call t_stopf('d_p_coupling') + !---------------------------------------------------------- + ! update aerosol state object from CAM physics state constituents + !---------------------------------------------------------- + if (aerosols_transported) then + + do c = begchunk,endchunk + aero_state_obj => aerosol_state_object(c) + ! pass number mass or number mixing ratios of aerosol constituents + ! to aerosol state object + call aero_state_obj%set_transported(phys_state(c)%q) + end do + + end if + !EOC end subroutine stepon_run1 !----------------------------------------------------------------------- -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- !BOP ! !ROUTINE: stepon_run2 -- second phase run method ! @@ -355,6 +391,10 @@ subroutine stepon_run2( phys_state, phys_tend, dyn_in, dyn_out ) type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container type (T_FVDYCORE_GRID), pointer :: grid + + integer :: c + class(aerosol_state), pointer :: aero_state_obj + ! ! !DESCRIPTION: ! @@ -366,6 +406,19 @@ subroutine stepon_run2( phys_state, phys_tend, dyn_in, dyn_out ) !----------------------------------------------------------------------- + !---------------------------------------------------------- + ! update physics state with aerosol constituents + !---------------------------------------------------------- + nullify(aero_state_obj) + + if (aerosols_transported) then + do c = begchunk,endchunk + aero_state_obj => aerosol_state_object(c) + ! get mass or number mixing ratios of aerosol constituents + call aero_state_obj%get_transported(phys_state(c)%q) + end do + end if + !---------------------------------------------------------- ! Update dynamics variables using phys_state & phys_tend. ! 2-D decomposition: Compute ptxy and q3xy; for ideal @@ -394,7 +447,7 @@ subroutine stepon_run3(dtime, cam_out, phys_state, & ! !USES: use time_manager, only: get_curr_date use fv_prints, only: fv_out - use camsrfexch, only: cam_out_t + use camsrfexch, only: cam_out_t ! ! !INPUT PARAMETERS: ! @@ -434,7 +487,7 @@ subroutine stepon_run3(dtime, cam_out, phys_state, & ! Monitor max/min/mean of selected fields ! ! SEE BELOW **** SEE BELOW **** SEE BELOW - + ! Beware that fv_out uses both dynamics and physics instantiations. ! However, I think that they are used independently, so that the ! answers are correct. Still, this violates the notion that the @@ -464,7 +517,7 @@ end subroutine stepon_run3 !----------------------------------------------------------------------- -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- !BOP ! !ROUTINE: stepon_final --- Dynamics finalization ! diff --git a/src/dynamics/fv/te_map.F90 b/src/dynamics/fv/te_map.F90 index 150ab9f2cf..1bde97eda7 100644 --- a/src/dynamics/fv/te_map.F90 +++ b/src/dynamics/fv/te_map.F90 @@ -33,7 +33,7 @@ subroutine te_map(grid, consv, convt, ps, omga, & use mod_comm, only : mp_send3d, mp_recv3d #endif use phys_control, only: waccmx_is !WACCM-X runtime switch - use physconst, only: physconst_calc_kappav + use cam_thermo, only: cam_thermo_calc_kappav use par_vecsum_mod,only: par_vecsum implicit none @@ -334,7 +334,7 @@ subroutine te_map(grid, consv, convt, ps, omga, & #endif if (high_alt) then - call physconst_calc_kappav( ifirst,ilast,jfirst,jlast,1,km, grid%ntotq, tracer, cap3v, cpv=cp3v) + call cam_thermo_calc_kappav( tracer, cap3v, cpv=cp3v ) endif !$omp parallel do & @@ -509,7 +509,7 @@ subroutine te_map(grid, consv, convt, ps, omga, & if (pe1(i,k)-pe1(i,k-1)shr_kind_r8 - - implicit none - private - - - !These are convenience variables for local use only, and are set to values in Atm% - integer, public :: npx, npy, ntiles - - integer, parameter, public :: nlev=PLEV - integer, parameter, public :: nlevp=nlev+1 - - ! - ! The variables below hold indices of water vapor and condensate loading tracers as well as - ! associated heat capacities (initialized in dyn_init): - ! - ! qsize_condensate_loading_idx = FV3 index of water tracers included in condensate loading according to FV3 dynamics - ! qsize_condensate_loading_idx_gll = CAM index of water tracers included in condensate loading terms given FV3 index - ! - integer, allocatable, public :: qsize_tracer_idx_cam2dyn(:) - character(len=16), allocatable, public :: cnst_name_ffsl(:) ! constituent names for FV3 tracers - character(len=128), allocatable, public :: cnst_longname_ffsl(:) ! long name of FV3 tracers - ! - !moist cp in energy conversion term - ! - ! .false.: force dycore to use cpd (cp dry) instead of moist cp - ! .true. : use moist cp in dycore - ! - logical , public :: fv3_lcp_moist = .false. - logical , public :: fv3_lcv_moist = .false. - logical , public :: fv3_scale_ttend = .false. - -end module dimensions_mod - diff --git a/src/dynamics/fv3/dp_coupling.F90 b/src/dynamics/fv3/dp_coupling.F90 deleted file mode 100644 index 947eea77b3..0000000000 --- a/src/dynamics/fv3/dp_coupling.F90 +++ /dev/null @@ -1,1086 +0,0 @@ -module dp_coupling - -!------------------------------------------------------------------------------- -! dynamics - physics coupling module -!------------------------------------------------------------------------------- - -use cam_abortutils, only: endrun -use cam_logfile, only: iulog -use constituents, only: pcnst -use dimensions_mod, only: npx,npy,nlev, & - cnst_name_ffsl, cnst_longname_ffsl,fv3_lcp_moist,fv3_lcv_moist, & - qsize_tracer_idx_cam2dyn,fv3_scale_ttend -use dyn_comp, only: dyn_export_t, dyn_import_t -use dyn_grid, only: get_gcol_block_d,mytile -use fv_grid_utils_mod, only: g_sum -use hycoef, only: hyam, hybm, hyai, hybi, ps0 -use mpp_domains_mod, only: mpp_update_domains, domain2D, DGRID_NE -use perf_mod, only: t_startf, t_stopf, t_barrierf -use physconst, only: cpair, gravit, rair, zvir, cappa, rairv -use phys_grid, only: get_ncols_p, get_gcol_all_p, block_to_chunk_send_pters, & - transpose_block_to_chunk, block_to_chunk_recv_pters, & - chunk_to_block_send_pters, transpose_chunk_to_block, & - chunk_to_block_recv_pters -use physics_types, only: physics_state, physics_tend -use ppgrid, only: begchunk, endchunk, pcols, pver, pverp -use shr_kind_mod, only: r8=>shr_kind_r8, i8 => shr_kind_i8 -use spmd_dyn, only: local_dp_map, block_buf_nrecs, chunk_buf_nrecs -use spmd_utils, only: mpicom, iam, npes,masterproc - -implicit none -private -public :: d_p_coupling, p_d_coupling - -!======================================================================= -contains -!======================================================================= - -subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) - - ! Convert the dynamics output state into the physics input state. - ! Note that all pressures and tracer mixing ratios coming from the FV3 dycore are based on - ! wet air mass. - - - use cam_abortutils, only: endrun - use fv_arrays_mod, only: fv_atmos_type - use fv_grid_utils_mod, only: cubed_to_latlon - use physics_buffer, only: physics_buffer_desc - - ! arguments - type (dyn_export_t), intent(inout) :: dyn_out ! dynamics export - type (physics_buffer_desc), pointer :: pbuf2d(:,:) - type (physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state - type (physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend - - ! LOCAL VARIABLES - - integer :: ib ! indices over elements - integer :: ioff - integer :: lchnk, icol, ilyr ! indices over chunks, columns, layers - integer :: m, m_ffsl, n, i, j, k - - integer :: cpter(pcols, 0:pver) ! offsets into chunk buffer for unpacking data - - integer :: pgcols(pcols), idmb1(1), idmb2(1), idmb3(1) - integer :: tsize ! amount of data per grid point passed to physics - type (fv_atmos_type), pointer :: Atm(:) - - integer :: is,ie,js,je - integer :: ncols - - ! LOCAL Allocatables - integer, allocatable, dimension(:,:) :: bpter !((ie-is+1)*(je-js+1),0:pver) ! packing data block buffer offset - real(r8), allocatable, dimension(:) :: bbuffer, cbuffer ! transpose buffers - real(r8), allocatable, dimension(:,:) :: phis_tmp !((ie-is+1)*(je-js+1), 1) ! temporary array to hold phis - real(r8), allocatable, dimension(:,:) :: ps_tmp !((ie-is+1)*(je-js+1), 1) ! temporary array to hold ps - real(r8), allocatable, dimension(:,:,:) :: T_tmp !((ie-is+1)*(je-js+1),pver,1) ! temporary array to hold T - real(r8), allocatable, dimension(:,:,:) :: omega_tmp!((ie-is+1)*(je-js+1),pver,1) ! temporary array to hold omega - real(r8), allocatable, dimension(:,:,:) :: pdel_tmp !((ie-is+1)*(je-js+1),pver,1) ! temporary array to hold pdel - real(r8), allocatable, dimension(:,:,:) :: u_tmp !((ie-is+1)*(je-js+1),pver,1) ! temp array to hold u - real(r8), allocatable, dimension(:,:,:) :: v_tmp !((ie-is+1)*(je-js+1),pver,1) ! temp array to hold v - real(r8), allocatable, dimension(:,:,:,:) :: q_tmp !((ie-is+1)*(je-js+1),pver,pcnst,1) ! temp to hold advected constituents - - !----------------------------------------------------------------------- - - Atm=>dyn_out%atm - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - ! Allocate temporary arrays to hold data for physics decomposition - allocate(ps_tmp ((ie-is+1)*(je-js+1), 1)) - allocate(phis_tmp ((ie-is+1)*(je-js+1), 1)) - allocate(T_tmp ((ie-is+1)*(je-js+1),pver, 1)) - allocate(u_tmp ((ie-is+1)*(je-js+1),pver, 1)) - allocate(v_tmp ((ie-is+1)*(je-js+1),pver, 1)) - allocate(omega_tmp((ie-is+1)*(je-js+1),pver, 1)) - allocate(pdel_tmp ((ie-is+1)*(je-js+1),pver, 1)) - allocate(Q_tmp ((ie-is+1)*(je-js+1),pver,pcnst, 1)) - - ps_tmp = 0._r8 - phis_tmp = 0._r8 - T_tmp = 0._r8 - u_tmp = 0._r8 - v_tmp = 0._r8 - omega_tmp= 0._r8 - pdel_tmp = 0._r8 - Q_tmp = 0._r8 - - n = 1 - do j = js, je - do i = is, ie - ps_tmp (n, 1) = Atm(mytile)%ps (i, j) - phis_tmp(n, 1) = Atm(mytile)%phis(i, j) - do k = 1, pver - T_tmp (n, k, 1) = Atm(mytile)%pt (i, j, k) - u_tmp (n, k, 1) = Atm(mytile)%ua (i, j, k) - v_tmp (n, k, 1) = Atm(mytile)%va (i, j, k) - omega_tmp(n, k, 1) = Atm(mytile)%omga(i, j, k) - pdel_tmp (n, k, 1) = Atm(mytile)%delp(i, j, k) - ! - ! The fv3 constituent array may be in a different order than the cam array, remap here. - ! - do m = 1, pcnst - m_ffsl=qsize_tracer_idx_cam2dyn(m) - Q_tmp(n, k, m, 1) = Atm(mytile)%q(i, j, k, m_ffsl) - end do - end do - n = n + 1 - end do - end do - - call t_startf('dpcopy') - if (local_dp_map) then - - !$omp parallel do private (lchnk, ncols, pgcols, icol, idmb1, idmb2, idmb3, ib, ioff, ilyr, m) - do lchnk = begchunk, endchunk - ncols = get_ncols_p(lchnk) - call get_gcol_all_p(lchnk, pcols, pgcols) - do icol = 1, ncols - call get_gcol_block_d(pgcols(icol), 1, idmb1, idmb2, idmb3) - ib = idmb3(1) - ioff = idmb2(1) - phys_state(lchnk)%ps(icol) = ps_tmp (ioff,ib) - phys_state(lchnk)%phis(icol) = phis_tmp(ioff,ib) - do ilyr = 1, pver - phys_state(lchnk)%t (icol,ilyr) = T_tmp (ioff,ilyr,ib) - phys_state(lchnk)%u (icol,ilyr) = u_tmp (ioff,ilyr,ib) - phys_state(lchnk)%v (icol,ilyr) = v_tmp (ioff,ilyr,ib) - phys_state(lchnk)%omega(icol,ilyr) = omega_tmp(ioff,ilyr,ib) - phys_state(lchnk)%pdel(icol,ilyr) = pdel_tmp (ioff,ilyr,ib) - do m = 1, pcnst - phys_state(lchnk)%q(icol,ilyr,m) = Q_tmp(ioff,ilyr,m,ib) - end do - end do - end do - - end do - - - else ! .not. local_dp_map - - tsize = 5 + pcnst - ib = 1 - - allocate(bbuffer(tsize*block_buf_nrecs)) - allocate(cbuffer(tsize*chunk_buf_nrecs)) - allocate(bpter((ie-is+1)*(je-js+1),0:pver)) - - if (iam < npes) then - call block_to_chunk_send_pters(iam+1, (ie-is+1)*(je-js+1), pver+1, tsize, bpter) - do icol = 1, (ie-is+1)*(je-js+1) - bbuffer(bpter(icol,0)+2:bpter(icol,0)+tsize-1) = 0.0_r8 - bbuffer(bpter(icol,0)) = ps_tmp (icol,ib) - bbuffer(bpter(icol,0)+1) = phis_tmp(icol,ib) - do ilyr = 1, pver - bbuffer(bpter(icol,ilyr)) = T_tmp(icol,ilyr,ib) - bbuffer(bpter(icol,ilyr)+1) = u_tmp(icol,ilyr,ib) - bbuffer(bpter(icol,ilyr)+2) = v_tmp(icol,ilyr,ib) - bbuffer(bpter(icol,ilyr)+3) = omega_tmp(icol,ilyr,ib) - bbuffer(bpter(icol,ilyr)+4) = pdel_tmp (icol,ilyr,ib) - do m = 1, pcnst - bbuffer(bpter(icol,ilyr)+tsize-pcnst-1+m) = Q_tmp(icol,ilyr,m,ib) - end do - end do - end do - else - bbuffer(:) = 0._r8 - end if - - call t_barrierf ('sync_blk_to_chk', mpicom) - call t_startf ('block_to_chunk') - call transpose_block_to_chunk(tsize, bbuffer, cbuffer) - call t_stopf ('block_to_chunk') - - do lchnk = begchunk,endchunk - ncols = phys_state(lchnk)%ncol - call block_to_chunk_recv_pters(lchnk, pcols, pver+1, tsize, cpter) - do icol = 1, ncols - phys_state(lchnk)%ps (icol) = cbuffer(cpter(icol,0)) - phys_state(lchnk)%phis (icol) = cbuffer(cpter(icol,0)+1) - do ilyr = 1, pver - phys_state(lchnk)%t (icol,ilyr) = cbuffer(cpter(icol,ilyr)) - phys_state(lchnk)%u (icol,ilyr) = cbuffer(cpter(icol,ilyr)+1) - phys_state(lchnk)%v (icol,ilyr) = cbuffer(cpter(icol,ilyr)+2) - phys_state(lchnk)%omega (icol,ilyr) = cbuffer(cpter(icol,ilyr)+3) - phys_state(lchnk)%pdel (icol,ilyr) = cbuffer(cpter(icol,ilyr)+4) - do m = 1, pcnst - phys_state(lchnk)%q (icol,ilyr,m) = cbuffer(cpter(icol,ilyr)+tsize-pcnst-1+m) - end do - end do - end do - end do - - deallocate( bbuffer ) - deallocate( cbuffer ) - deallocate( bpter ) - - end if - - deallocate(ps_tmp ) - deallocate(phis_tmp ) - deallocate(T_tmp ) - deallocate(u_tmp ) - deallocate(v_tmp ) - deallocate(omega_tmp) - deallocate(pdel_tmp ) - deallocate(Q_tmp ) - - call t_stopf('dpcopy') - - ! derive the physics state from the dynamics state converting to proper vapor loading - ! and setting dry mixing ratio variables based on cnst_type - no need to call wet_to_dry - ! since derived_phys_dry takes care of that. - - call t_startf('derived_phys_dry') - call derived_phys_dry(phys_state, phys_tend, pbuf2d) - call t_stopf('derived_phys_dry') - -end subroutine d_p_coupling - -!======================================================================= - -subroutine p_d_coupling(phys_state, phys_tend, dyn_in) - - ! Convert the physics output state into the dynamics input state. - - use cam_history, only: outfld - use constants_mod, only: cp_air, kappa - use dyn_comp, only: calc_tot_energy_dynamics - use fms_mod, only: set_domain - use fv_arrays_mod, only: fv_atmos_type - use fv_grid_utils_mod, only: cubed_to_latlon - use physconst, only: thermodynamic_active_species_num,thermodynamic_active_species_idx_dycore - use physconst, only: thermodynamic_active_species_cp,thermodynamic_active_species_cv,dry_air_species_num - use physics_types, only: set_state_pdry - use time_manager, only: get_step_size - - ! arguments - type (physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state - type (physics_tend), intent(inout), dimension(begchunk:endchunk) :: phys_tend - type (dyn_import_t), intent(inout) :: dyn_in - - ! LOCAL VARIABLES - - integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data - integer :: ib ! indices over elements - integer :: idim - integer :: ioff - integer :: is,isd,ie,ied,js,jsd,je,jed - integer :: lchnk, icol, ilyr ! indices over chunks, columns, layers - integer :: m, n, i, j, k,m_ffsl,nq - integer :: ncols - integer :: pgcols(pcols), idmb1(1), idmb2(1), idmb3(1) - integer :: tsize ! amount of data per grid point passed to physics - integer :: num_wet_species ! total number of wet species (first tracers in FV3 tracer array) - - integer, allocatable, dimension(:,:) :: bpter !((ie-is+1)*(je-js+1),0:pver) ! packing data block buffer offsets - real(r8), allocatable, dimension(:) :: bbuffer, cbuffer ! transpose buffers - - real (r8) :: dt - real (r8) :: fv3_totwatermass, fv3_airmass - real (r8) :: qall,cpfv3 - real (r8) :: tracermass(pcnst) - - type (fv_atmos_type), pointer :: Atm(:) - - real(r8), allocatable, dimension(:,:,:) :: delpdry ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: pdel_tmp ! temporary to hold - real(r8), allocatable, dimension(:,:,:) :: pdeldry_tmp ! temporary to hold - real(r8), allocatable, dimension(:,:,:) :: t_dt ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: t_dt_tmp ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: t_tendadj ! temporary array to temperature tendency adjustment - real(r8), allocatable, dimension(:,:,:) :: u_dt ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: u_dt_tmp ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: u_tmp ! temporary array to hold u and v - real(r8), allocatable, dimension(:,:,:) :: v_dt ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: v_dt_tmp ! temporary to hold tendencies - real(r8), allocatable, dimension(:,:,:) :: v_tmp ! temporary array to hold u and v - real(r8), allocatable, dimension(:,:,:,:) :: q_tmp ! temporary to hold - - !----------------------------------------------------------------------- - - Atm=>dyn_in%atm - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - isd = Atm(mytile)%bd%isd - ied = Atm(mytile)%bd%ied - jsd = Atm(mytile)%bd%jsd - jed = Atm(mytile)%bd%jed - - call set_domain ( Atm(mytile)%domain ) - - allocate(delpdry(isd:ied,jsd:jed,nlev)) - allocate(t_dt_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(u_dt_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(v_dt_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(pdel_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(pdeldry_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(U_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(V_tmp((ie-is+1)*(je-js+1),pver,1)) - allocate(Q_tmp((ie-is+1)*(je-js+1),pver,pcnst,1)) - allocate(u_dt(isd:ied,jsd:jed,nlev)) - allocate(v_dt(isd:ied,jsd:jed,nlev)) - allocate(t_dt(is:ie,js:je,nlev)) - allocate(t_tendadj(is:ie,js:je,nlev)) - - Atm=>dyn_in%atm - - if (local_dp_map) then -!$omp parallel do private (lchnk, ncols, pgcols, icol, idmb1, idmb2, idmb3, ib, ioff, ilyr, m) - do lchnk = begchunk, endchunk - ncols = get_ncols_p(lchnk) - call get_gcol_all_p(lchnk, pcols, pgcols) - call set_state_pdry(phys_state(lchnk)) ! First get dry pressure to use for this timestep - do icol = 1, ncols - call get_gcol_block_d(pgcols(icol), 1, idmb1, idmb2, idmb3) - ib = idmb3(1) - ioff = idmb2(1) - do ilyr = 1, pver - t_dt_tmp(ioff,ilyr,ib) = phys_tend(lchnk)%dtdt(icol,ilyr) - u_tmp(ioff,ilyr,ib) = phys_state(lchnk)%u(icol,ilyr) - v_tmp(ioff,ilyr,ib) = phys_state(lchnk)%v(icol,ilyr) - u_dt_tmp(ioff,ilyr,ib) = phys_tend(lchnk)%dudt(icol,ilyr) - v_dt_tmp(ioff,ilyr,ib) = phys_tend(lchnk)%dvdt(icol,ilyr) - pdel_tmp(ioff,ilyr,ib) = phys_state(lchnk)%pdel(icol,ilyr) - pdeldry_tmp(ioff,ilyr,ib) = phys_state(lchnk)%pdeldry(icol,ilyr) - do m=1, pcnst - Q_tmp(ioff,ilyr,m,ib) = phys_state(lchnk)%q(icol,ilyr,m) - end do - end do - end do - end do - - else - - tsize = 7 + pcnst - ib = 1 - - allocate(bbuffer(tsize*block_buf_nrecs)) - allocate(cbuffer(tsize*chunk_buf_nrecs)) - allocate(bpter((ie-is+1)*(je-js+1),0:pver)) ! offsets into block buffer for packing data - -!$omp parallel do private (lchnk, ncols, cpter, i, icol, ilyr, m) - do lchnk = begchunk, endchunk - - call set_state_pdry(phys_state(lchnk)) ! First get dry pressure to use for this timestep - ncols = get_ncols_p(lchnk) - - call chunk_to_block_send_pters(lchnk, pcols, pver+1, tsize, cpter) - - do i=1,ncols - cbuffer(cpter(i,0):cpter(i,0)+6+pcnst) = 0.0_r8 - end do - - do icol = 1, ncols - - do ilyr = 1, pver - cbuffer(cpter(icol,ilyr)) = phys_tend(lchnk)%dtdt(icol,ilyr) - cbuffer(cpter(icol,ilyr)+1) = phys_state(lchnk)%u(icol,ilyr) - cbuffer(cpter(icol,ilyr)+2) = phys_state(lchnk)%v(icol,ilyr) - cbuffer(cpter(icol,ilyr)+3) = phys_tend(lchnk)%dudt(icol,ilyr) - cbuffer(cpter(icol,ilyr)+4) = phys_tend(lchnk)%dvdt(icol,ilyr) - cbuffer(cpter(icol,ilyr)+5) = phys_state(lchnk)%pdel(icol,ilyr) - cbuffer(cpter(icol,ilyr)+6) = phys_state(lchnk)%pdeldry(icol,ilyr) - do m = 1, pcnst - cbuffer(cpter(icol,ilyr)+6+m) = phys_state(lchnk)%q(icol,ilyr,m) - end do - end do - - end do - - end do - - call t_barrierf('sync_chk_to_blk', mpicom) - call t_startf ('chunk_to_block') - call transpose_chunk_to_block(tsize, cbuffer, bbuffer) - call t_stopf ('chunk_to_block') - - if (iam < npes) then - - call chunk_to_block_recv_pters(iam+1, (ie-is+1)*(je-js+1), pver+1, tsize, bpter) - do icol = 1, (ie-is+1)*(je-js+1) - do ilyr = 1, pver - t_dt_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)) - u_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)+1) - v_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)+2) - u_dt_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)+3) - v_dt_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)+4) - pdel_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)+5) - pdeldry_tmp(icol,ilyr,ib) = bbuffer(bpter(icol,ilyr)+6) - do m = 1, pcnst - Q_tmp(icol,ilyr,m,ib) = bbuffer(bpter(icol,ilyr)+6+m) - end do - end do - end do - - end if - - deallocate(bbuffer) - deallocate(cbuffer) - deallocate(bpter) - - end if - - dt = get_step_size() - - idim=ie-is+1 - -! pt_dt is adjusted below. - n = 1 - do j = js, je - do i = is, ie - do k = 1, pver - t_dt(i, j, k) = t_dt_tmp (n, k, 1) - u_dt(i, j, k) = u_dt_tmp (n, k, 1) - v_dt(i, j, k) = v_dt_tmp (n, k, 1) - Atm(mytile)%ua(i, j, k) = Atm(mytile)%ua(i, j, k) + u_dt(i, j, k)*dt - Atm(mytile)%va(i, j, k) = Atm(mytile)%va(i, j, k) + v_dt(i, j, k)*dt - Atm(mytile)%delp(i, j, k) = pdel_tmp (n, k, 1) - delpdry(i, j, k) = pdeldry_tmp (n, k, 1) - do m = 1, pcnst - ! dynamics tracers may be in a different order from cam tracer array - m_ffsl=qsize_tracer_idx_cam2dyn(m) - Atm(mytile)%q(i, j, k, m_ffsl) = Q_tmp(n, k, m, 1) - end do - end do - n = n + 1 - end do - end do - - ! Update delp and mixing ratios to account for the difference between CAM and FV3 total air mass - ! CAM total air mass (pdel) = (dry + vapor) - ! FV3 total air mass (delp at beg of phys * mix ratio) = - ! drymass + (vapor + condensate [liq_wat,ice_wat,rainwat,snowwat,graupel])*mix ratio - ! FV3 tracer mixing ratios = tracer mass / FV3 total air mass - ! convert the (dry+vap) mixing ratios to be based off of FV3 condensate loaded airmass (dry+vap+cond). When - ! d_p_coupling/derive_phys_dry is called the mixing ratios are again parsed out into wet and - ! dry for physics. - num_wet_species=thermodynamic_active_species_num-dry_air_species_num - ! recalculate ps based on new delp - Atm(mytile)%ps(:,:)=hyai(1)*ps0 - do k=1,pver - do j = js,je - do i = is,ie - do m = 1,pcnst - tracermass(m)=Atm(mytile)%delp(i,j,k)*Atm(mytile)%q(i,j,k,m) - end do - fv3_totwatermass=sum(tracermass(thermodynamic_active_species_idx_dycore(1:num_wet_species))) - fv3_airmass = delpdry(i,j,k) + fv3_totwatermass - Atm(mytile)%delp(i,j,k) = fv3_airmass - Atm(mytile)%q(i,j,k,1:pcnst) = tracermass(1:pcnst)/fv3_airmass - Atm(mytile)%ps(i,j)=Atm(mytile)%ps(i,j)+Atm(mytile)%delp(i, j, k) - end do - end do - end do - - ! update dynamics temperature from physics tendency - ! if using fv3_lcv_moist adjust temperature tendency to conserve energy across phys/dynamics - ! interface accounting for differences in the moist/wet assumptions - - do k = 1, pver - do j = js, je - do i = is, ie - if (fv3_scale_ttend) then - qall=0._r8 - cpfv3=0._r8 - do nq=1,thermodynamic_active_species_num - m_ffsl = thermodynamic_active_species_idx_dycore(nq) - qall=qall+Atm(mytile)%q(i,j,k,m_ffsl) - if (fv3_lcp_moist) cpfv3 = cpfv3+thermodynamic_active_species_cp(nq)*Atm(mytile)%q(i,j,k,m_ffsl) - if (fv3_lcv_moist) cpfv3 = cpfv3+thermodynamic_active_species_cv(nq)*Atm(mytile)%q(i,j,k,m_ffsl) - end do - cpfv3=(1._r8-qall)*cp_air+cpfv3 - ! scale factor for t_dt so temperature tendency derived from CAM moist air (dry+vap - constant pressure) - ! can be applied to FV3 wet air (dry+vap+cond - constant volume) - - t_tendadj(i,j,k)=cp_air/cpfv3 - - if (.not.Atm(mytile)%flagstruct%hydrostatic) then - ! update to nonhydrostatic variable delz to account for phys temperature adjustment. - Atm(mytile)%delz(i, j, k) = Atm(mytile)%delz(i,j,k)/Atm(mytile)%pt(i, j, k) - Atm(mytile)%pt (i, j, k) = Atm(mytile)%pt (i, j, k) + t_dt(i, j, k)*dt*t_tendadj(i,j,k) - Atm(mytile)%delz(i, j, k) = Atm(mytile)%delz(i,j,k)*Atm(mytile)%pt (i, j, k) - else - Atm(mytile)%pt (i, j, k) = Atm(mytile)%pt (i, j, k) + t_dt(i, j, k)*dt*t_tendadj(i,j,k) - end if - else - Atm(mytile)%pt (i, j, k) = Atm(mytile)%pt (i, j, k) + t_dt(i, j, k)*dt - end if - end do - end do - end do - - !$omp parallel do private(i, j) - do j=js,je - do i=is,ie - Atm(mytile)%pe(i,1,j) = Atm(mytile)%ptop - Atm(mytile)%pk(i,j,1) = Atm(mytile)%ptop ** kappa - Atm(mytile)%peln(i,1,j) = log(Atm(mytile)%ptop ) - enddo - enddo - -!$omp parallel do private(i,j,k) - do j=js,je - do k=1,pver - do i=is,ie - Atm(mytile)%pe(i,k+1,j) = Atm(mytile)%pe(i,k,j) + Atm(mytile)%delp(i,j,k) - enddo - enddo - enddo - -!$omp parallel do private(i,j,k) - do j=js,je - do k=1,pver - do i=is,ie - Atm(mytile)%pk(i,j,k+1)= Atm(mytile)%pe(i,k+1,j) ** kappa - Atm(mytile)%peln(i,k+1,j) = log(Atm(mytile)%pe(i,k+1,j)) - Atm(mytile)%pkz(i,j,k) = (Atm(mytile)%pk(i,j,k+1)-Atm(mytile)%pk(i,j,k))/ & - (kappa*(Atm(mytile)%peln(i,k+1,j)-Atm(mytile)%peln(i,k,j))) - enddo - enddo - enddo - - do j = js, je - call outfld('FU', RESHAPE(u_dt(is:ie, j, :),(/idim,pver/)), idim, j) - call outfld('FV', RESHAPE(v_dt(is:ie, j, :),(/idim,pver/)), idim, j) - call outfld('FT', RESHAPE(t_dt(is:ie, j, :),(/idim,pver/)), idim, j) - end do - - call calc_tot_energy_dynamics(dyn_in%atm,'dAP') - - - !set the D-Grid winds from the physics A-grid winds/tendencies. - if ( Atm(mytile)%flagstruct%dwind_2d ) then - call endrun('dwind_2d update is not implemented') - else - call atend2dstate3d( u_dt, v_dt, Atm(mytile)%u ,Atm(mytile)%v, is, ie, js, je, & - isd, ied, jsd, jed, npx,npy, nlev, Atm(mytile)%gridstruct, Atm(mytile)%domain, dt) - endif - - ! Again we are rederiving the A winds from the Dwinds to give our energy dynamics a consistent wind. - call cubed_to_latlon(Atm(mytile)%u, Atm(mytile)%v, Atm(mytile)%ua, Atm(mytile)%va, Atm(mytile)%gridstruct, & - npx, npy, nlev, 1, Atm(mytile)%gridstruct%grid_type, Atm(mytile)%domain, & - Atm(mytile)%gridstruct%nested, Atm(mytile)%flagstruct%c2l_ord, Atm(mytile)%bd) - - !$omp parallel do private(i, j) - do j=js,je - do i=is,ie - Atm(mytile)%u_srf=Atm(mytile)%ua(i,j,pver) - Atm(mytile)%v_srf=Atm(mytile)%va(i,j,pver) - enddo - enddo - - ! update halo regions - call mpp_update_domains( Atm(mytile)%delp, Atm(mytile)%domain ) - call mpp_update_domains( Atm(mytile)%ps, Atm(mytile)%domain ) - call mpp_update_domains( Atm(mytile)%phis, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%ps, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%u,atm(mytile)%v, Atm(mytile)%domain, gridtype=DGRID_NE, complete=.true. ) - call mpp_update_domains( atm(mytile)%pt, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%q, Atm(mytile)%domain ) - - deallocate(delpdry) - deallocate(t_dt_tmp) - deallocate(u_dt_tmp) - deallocate(v_dt_tmp) - deallocate(pdel_tmp) - deallocate(pdeldry_tmp) - deallocate(U_tmp) - deallocate(V_tmp) - deallocate(Q_tmp) - deallocate(u_dt) - deallocate(v_dt) - deallocate(t_dt) - deallocate(t_tendadj) - -end subroutine p_d_coupling - -!======================================================================= - -subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) - - use check_energy, only: check_energy_timestep_init - use constituents, only: qmin - use geopotential, only: geopotential_t - use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk - use physics_types, only: set_wet_to_dry - use physconst, only: thermodynamic_active_species_num,thermodynamic_active_species_idx_dycore - use physconst, only: thermodynamic_active_species_idx,dry_air_species_num - use ppgrid, only: pver - use qneg_module, only: qneg3 - use shr_vmath_mod, only: shr_vmath_log - - ! arguments - type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state - type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - ! local variables - - integer :: num_wet_species ! total number of wet species (first tracers in FV3 tracer array) - integer :: lchnk - integer :: m, i, k, ncol - - real(r8) :: cam_totwatermass, cam_airmass - real(r8), dimension(pcnst) :: tracermass - real(r8), dimension(pcols,pver) :: zvirv ! Local zvir array pointer - - !---------------------------------------------------------------------------- - - type(physics_buffer_desc), pointer :: pbuf_chnk(:) - - ! - ! Evaluate derived quantities - ! - ! At this point the phys_state has been filled in from dynamics, rearranging tracers to match CAM tracer order. - ! pdel is consistent with tracer array. - ! All tracer mixing rations at this point are calculated using dry+vap+condensates - we need to convert - ! to cam physics wet mixing ration based off of dry+vap. - ! Following this loop call wet_to_dry to convert CAM's dry constituents to their dry mixing ratio. - -!!! omp parallel do private (lchnk, ncol, k, i, zvirv, pbuf_chnk,m,cam_airmass,cam_totwatermass) - num_wet_species=thermodynamic_active_species_num-dry_air_species_num - do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - do k=1,pver - do i=1,ncol - phys_state(lchnk)%pdeldry(i,k) = & - phys_state(lchnk)%pdel(i,k) * & - (1._r8-sum(phys_state(lchnk)%q(i,k,thermodynamic_active_species_idx(1:num_wet_species)))) - do m = 1,pcnst - tracermass(m)=phys_state(lchnk)%pdel(i,k)*phys_state(lchnk)%q(i,k,m) - end do - cam_totwatermass=tracermass(1) - cam_airmass = phys_state(lchnk)%pdeldry(i,k) + cam_totwatermass - phys_state(lchnk)%pdel(i,k) = cam_airmass - phys_state(lchnk)%q(i,k,1:pcnst) = tracermass(1:pcnst)/cam_airmass - end do - end do - -! Physics state now has CAM pdel (dry+vap) and pdeldry and all constituents are dry+vap -! Convert dry type constituents from moist to dry mixing ratio -! - call set_wet_to_dry(phys_state(lchnk)) ! Dynamics had moist, physics wants dry. - -! -! Derive the rest of the pressure variables using pdel and pdeldry -! - - do i = 1, ncol - phys_state(lchnk)%psdry(i) = hyai(1)*ps0 + sum(phys_state(lchnk)%pdeldry(i,:)) - end do - - do i = 1, ncol - phys_state(lchnk)%pintdry(i,1) = hyai(1)*ps0 - end do - call shr_vmath_log(phys_state(lchnk)%pintdry(1:ncol,1), & - phys_state(lchnk)%lnpintdry(1:ncol,1),ncol) - do k = 1, pver - do i = 1, ncol - phys_state(lchnk)%pintdry(i,k+1) = phys_state(lchnk)%pintdry(i,k) + & - phys_state(lchnk)%pdeldry(i,k) - end do - call shr_vmath_log(phys_state(lchnk)%pintdry(1:ncol,k+1),& - phys_state(lchnk)%lnpintdry(1:ncol,k+1),ncol) - end do - - do k=1,pver - do i=1,ncol - phys_state(lchnk)%rpdeldry(i,k) = 1._r8/phys_state(lchnk)%pdeldry(i,k) - phys_state(lchnk)%pmiddry (i,k) = 0.5_r8*(phys_state(lchnk)%pintdry(i,k+1) + & - phys_state(lchnk)%pintdry(i,k)) - end do - call shr_vmath_log(phys_state(lchnk)%pmiddry(1:ncol,k), & - phys_state(lchnk)%lnpmiddry(1:ncol,k),ncol) - end do - - ! initialize moist pressure variables - - do i=1,ncol - phys_state(lchnk)%ps(i) = phys_state(lchnk)%pintdry(i,1) - phys_state(lchnk)%pint(i,1) = phys_state(lchnk)%pintdry(i,1) - end do - do k = 1, pver - do i=1,ncol - phys_state(lchnk)%pint(i,k+1) = phys_state(lchnk)%pint(i,k)+phys_state(lchnk)%pdel(i,k) - phys_state(lchnk)%pmid(i,k) = (phys_state(lchnk)%pint(i,k+1)+phys_state(lchnk)%pint(i,k))/2._r8 - phys_state(lchnk)%ps (i) = phys_state(lchnk)%ps(i) + phys_state(lchnk)%pdel(i,k) - end do - call shr_vmath_log(phys_state(lchnk)%pint(1:ncol,k),phys_state(lchnk)%lnpint(1:ncol,k),ncol) - call shr_vmath_log(phys_state(lchnk)%pmid(1:ncol,k),phys_state(lchnk)%lnpmid(1:ncol,k),ncol) - end do - call shr_vmath_log(phys_state(lchnk)%pint(1:ncol,pverp),phys_state(lchnk)%lnpint(1:ncol,pverp),ncol) - - do k = 1, pver - do i = 1, ncol - phys_state(lchnk)%rpdel(i,k) = 1._r8/phys_state(lchnk)%pdel(i,k) - phys_state(lchnk)%exner (i,k) = (phys_state(lchnk)%pint(i,pver+1) & - / phys_state(lchnk)%pmid(i,k))**cappa - end do - end do - - ! fill zvirv 2D variables to be compatible with geopotential_t interface - zvirv(:,:) = zvir - - ! Compute initial geopotential heights - based on full pressure - call geopotential_t (phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint , & - phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & - phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,1), rairv(:,:,lchnk), gravit, zvirv , & - phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol ) - - ! Compute initial dry static energy, include surface geopotential - do k = 1, pver - do i = 1, ncol - phys_state(lchnk)%s(i,k) = cpair*phys_state(lchnk)%t(i,k) & - + gravit*phys_state(lchnk)%zm(i,k) + phys_state(lchnk)%phis(i) - end do - end do - ! Ensure tracers are all positive - call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & - 1, pcnst, qmin ,phys_state(lchnk)%q) - - ! Compute energy and water integrals of input state - pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) - call check_energy_timestep_init(phys_state(lchnk), phys_tend(lchnk), pbuf_chnk) - - end do ! lchnk - -end subroutine derived_phys_dry - -subroutine atend2dstate3d(u_dt, v_dt, u, v, is, ie, js, je, isd, ied, jsd, jed, npx,npy, nlev, gridstruct, domain, dt) -!---------------------------------------------------------------------------- -! This routine adds the a-grid wind tendencies returned by the physics to the d-state -! wind being sent to the dynamics. -!---------------------------------------------------------------------------- - - use fv_arrays_mod, only: fv_grid_type - use mpp_domains_mod, only: mpp_update_domains, DGRID_NE - - ! arguments - integer, intent(in) :: npx,npy, nlev - integer, intent(in) :: is, ie, js, je,& - isd, ied, jsd, jed - real(r8), intent(in) :: dt - real(r8), intent(inout), dimension(isd:ied,jsd:jed,nlev) :: u_dt, v_dt - real(r8), intent(inout), dimension(isd:ied, jsd:jed+1,nlev) :: u - real(r8), intent(inout), dimension(isd:ied+1,jsd:jed ,nlev) :: v - type(domain2d), intent(inout) :: domain - type(fv_grid_type), intent(in), target :: gridstruct - - ! local: - - integer i, j, k, im2, jm2 - real(r8) dt5 - real(r8), dimension(is-1:ie+1,js:je+1,3) :: ue ! 3D winds at edges - real(r8), dimension(is-1:ie+1,js-1:je+1,3) :: v3 - real(r8), dimension(is:ie+1,js-1:je+1, 3) :: ve ! 3D winds at edges - real(r8), dimension(is:ie) :: ut1, ut2, ut3 - real(r8), dimension(js:je) :: vt1, vt2, vt3 - real(r8), pointer, dimension(:) :: edge_vect_w, edge_vect_e, edge_vect_s, edge_vect_n - real(r8), pointer, dimension(:,:,:) :: vlon, vlat - real(r8), pointer, dimension(:,:,:,:) :: es, ew - - !---------------------------------------------------------------------------- - - es => gridstruct%es - ew => gridstruct%ew - vlon => gridstruct%vlon - vlat => gridstruct%vlat - - edge_vect_w => gridstruct%edge_vect_w - edge_vect_e => gridstruct%edge_vect_e - edge_vect_s => gridstruct%edge_vect_s - edge_vect_n => gridstruct%edge_vect_n - - call mpp_update_domains(u_dt, domain, complete=.false.) - call mpp_update_domains(v_dt, domain, complete=.true.) - - dt5 = 0.5_r8 * dt - im2 = (npx-1)/2 - jm2 = (npy-1)/2 - -!$OMP parallel do default(none) shared(is,ie,js,je,nlev,gridstruct,u,dt5,u_dt,v,v_dt, & -!$OMP vlon,vlat,jm2,edge_vect_w,npx,edge_vect_e,im2, & -!$OMP edge_vect_s,npy,edge_vect_n,es,ew) & -!$OMP private(ut1, ut2, ut3, vt1, vt2, vt3, ue, ve, v3) - do k=1, nlev - - ! Compute 3D wind/tendency on A grid - do j=js-1,je+1 - do i=is-1,ie+1 - v3(i,j,1) = u_dt(i,j,k)*vlon(i,j,1) + v_dt(i,j,k)*vlat(i,j,1) - v3(i,j,2) = u_dt(i,j,k)*vlon(i,j,2) + v_dt(i,j,k)*vlat(i,j,2) - v3(i,j,3) = u_dt(i,j,k)*vlon(i,j,3) + v_dt(i,j,k)*vlat(i,j,3) - enddo - enddo - - ! Interpolate to cell edges - do j=js,je+1 - do i=is-1,ie+1 - ue(i,j,1) = v3(i,j-1,1) + v3(i,j,1) - ue(i,j,2) = v3(i,j-1,2) + v3(i,j,2) - ue(i,j,3) = v3(i,j-1,3) + v3(i,j,3) - enddo - enddo - - do j=js-1,je+1 - do i=is,ie+1 - ve(i,j,1) = v3(i-1,j,1) + v3(i,j,1) - ve(i,j,2) = v3(i-1,j,2) + v3(i,j,2) - ve(i,j,3) = v3(i-1,j,3) + v3(i,j,3) - enddo - enddo - - ! --- E_W edges (for v-wind): - if (.not. gridstruct%nested) then - if ( is==1) then - i = 1 - do j=js,je - if ( j>jm2 ) then - vt1(j) = edge_vect_w(j)*ve(i,j-1,1)+(1._r8-edge_vect_w(j))*ve(i,j,1) - vt2(j) = edge_vect_w(j)*ve(i,j-1,2)+(1._r8-edge_vect_w(j))*ve(i,j,2) - vt3(j) = edge_vect_w(j)*ve(i,j-1,3)+(1._r8-edge_vect_w(j))*ve(i,j,3) - else - vt1(j) = edge_vect_w(j)*ve(i,j+1,1)+(1._r8-edge_vect_w(j))*ve(i,j,1) - vt2(j) = edge_vect_w(j)*ve(i,j+1,2)+(1._r8-edge_vect_w(j))*ve(i,j,2) - vt3(j) = edge_vect_w(j)*ve(i,j+1,3)+(1._r8-edge_vect_w(j))*ve(i,j,3) - endif - enddo - do j=js,je - ve(i,j,1) = vt1(j) - ve(i,j,2) = vt2(j) - ve(i,j,3) = vt3(j) - enddo - endif - - if ( (ie+1)==npx ) then - i = npx - do j=js,je - if ( j>jm2 ) then - vt1(j) = edge_vect_e(j)*ve(i,j-1,1)+(1._r8-edge_vect_e(j))*ve(i,j,1) - vt2(j) = edge_vect_e(j)*ve(i,j-1,2)+(1._r8-edge_vect_e(j))*ve(i,j,2) - vt3(j) = edge_vect_e(j)*ve(i,j-1,3)+(1._r8-edge_vect_e(j))*ve(i,j,3) - else - vt1(j) = edge_vect_e(j)*ve(i,j+1,1)+(1._r8-edge_vect_e(j))*ve(i,j,1) - vt2(j) = edge_vect_e(j)*ve(i,j+1,2)+(1._r8-edge_vect_e(j))*ve(i,j,2) - vt3(j) = edge_vect_e(j)*ve(i,j+1,3)+(1._r8-edge_vect_e(j))*ve(i,j,3) - endif - enddo - do j=js,je - ve(i,j,1) = vt1(j) - ve(i,j,2) = vt2(j) - ve(i,j,3) = vt3(j) - enddo - endif - ! N-S edges (for u-wind): - if ( js==1) then - j = 1 - do i=is,ie - if ( i>im2 ) then - ut1(i) = edge_vect_s(i)*ue(i-1,j,1)+(1._r8-edge_vect_s(i))*ue(i,j,1) - ut2(i) = edge_vect_s(i)*ue(i-1,j,2)+(1._r8-edge_vect_s(i))*ue(i,j,2) - ut3(i) = edge_vect_s(i)*ue(i-1,j,3)+(1._r8-edge_vect_s(i))*ue(i,j,3) - else - ut1(i) = edge_vect_s(i)*ue(i+1,j,1)+(1._r8-edge_vect_s(i))*ue(i,j,1) - ut2(i) = edge_vect_s(i)*ue(i+1,j,2)+(1._r8-edge_vect_s(i))*ue(i,j,2) - ut3(i) = edge_vect_s(i)*ue(i+1,j,3)+(1._r8-edge_vect_s(i))*ue(i,j,3) - endif - enddo - do i=is,ie - ue(i,j,1) = ut1(i) - ue(i,j,2) = ut2(i) - ue(i,j,3) = ut3(i) - enddo - endif - if ( (je+1)==npy ) then - j = npy - do i=is,ie - if ( i>im2 ) then - ut1(i) = edge_vect_n(i)*ue(i-1,j,1)+(1._r8-edge_vect_n(i))*ue(i,j,1) - ut2(i) = edge_vect_n(i)*ue(i-1,j,2)+(1._r8-edge_vect_n(i))*ue(i,j,2) - ut3(i) = edge_vect_n(i)*ue(i-1,j,3)+(1._r8-edge_vect_n(i))*ue(i,j,3) - else - ut1(i) = edge_vect_n(i)*ue(i+1,j,1)+(1._r8-edge_vect_n(i))*ue(i,j,1) - ut2(i) = edge_vect_n(i)*ue(i+1,j,2)+(1._r8-edge_vect_n(i))*ue(i,j,2) - ut3(i) = edge_vect_n(i)*ue(i+1,j,3)+(1._r8-edge_vect_n(i))*ue(i,j,3) - endif - enddo - do i=is,ie - ue(i,j,1) = ut1(i) - ue(i,j,2) = ut2(i) - ue(i,j,3) = ut3(i) - enddo - endif - - endif ! .not. nested - - do j=js,je+1 - do i=is,ie - u(i,j,k) = u(i,j,k) + dt5*( ue(i,j,1)*es(1,i,j,1) + & - ue(i,j,2)*es(2,i,j,1) + & - ue(i,j,3)*es(3,i,j,1) ) - enddo - enddo - do j=js,je - do i=is,ie+1 - v(i,j,k) = v(i,j,k) + dt5*( ve(i,j,1)*ew(1,i,j,2) + & - ve(i,j,2)*ew(2,i,j,2) + & - ve(i,j,3)*ew(3,i,j,2) ) - enddo - enddo - enddo ! k-loop - - call mpp_update_domains(u, v, domain, gridtype=DGRID_NE) - -end subroutine atend2dstate3d - - -subroutine fv3_tracer_diags(atm) - - ! Dry/Wet surface pressure diagnostics - - use constituents, only: pcnst - use dimensions_mod, only: nlev,cnst_name_ffsl - use dyn_grid, only: mytile - use fv_arrays_mod, only: fv_atmos_type - use physconst, only: thermodynamic_active_species_num,thermodynamic_active_species_idx_dycore, & - dry_air_species_num - - ! arguments - type (fv_atmos_type), intent(in), pointer :: Atm(:) - - ! Locals - integer :: i, j ,k, m,is,ie,js,je - integer :: num_wet_species ! total number of wet species - integer :: kstrat,ng - real(r8) :: global_ps,global_dryps - real(r8) :: qm_strat - real(r8) :: qtot(pcnst), psum - real(r8), allocatable, dimension(:,:,:) :: delpdry, psq - real(r8), allocatable, dimension(:,:) :: psdry, q_strat - - !---------------------------------------------------------------------------- - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - ng = Atm(mytile)%ng - - allocate(delpdry(is:ie,js:je,nlev)) - allocate(psdry(is:ie,js:je)) - allocate(psq(is:ie,js:je,pcnst)) - allocate(q_strat(is:ie,js:je)) - num_wet_species=thermodynamic_active_species_num-dry_air_species_num - do k=1,nlev - do j = js, je - do i = is, ie - delpdry(i,j,k) = Atm(mytile)%delp(i,j,k) * & - (1.0_r8-sum(Atm(mytile)%q(i,j,k,thermodynamic_active_species_idx_dycore(1:num_wet_species)))) - end do - end do - end do - ! - ! get psdry - ! - do j = js, je - do i = is, ie - psdry(i,j) = hyai(1)*ps0 + sum(delpdry(i,j,:)) - end do - end do - - global_ps = g_sum(Atm(mytile)%domain, Atm(mytile)%ps(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1) - global_dryps = g_sum(Atm(mytile)%domain, psdry(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1) -!------------------- -! Vertical mass sum for all tracers -!------------------- - psq(:,:,:) = 0._r8 - do m=1,pcnst - call z_sum(Atm,is,ie,js,je,nlev,Atm(mytile)%q(is:ie,js:je,1:nlev,m),psq(is:ie,js:je,m)) - end do -! Mean water vapor in the "stratosphere" (75 mb and above): - qm_strat = 0._r8 - if ( Atm(mytile)%idiag%phalf(2)< 75._r8 ) then - kstrat = 1 - do k=2,nlev - if ( Atm(mytile)%idiag%phalf(k+1) > 75._r8 ) exit - kstrat = k - enddo - call z_sum(Atm,is,ie,js,je, kstrat, Atm(mytile)%q(is:ie,js:je,1:kstrat,1 ), q_strat,psum) - qm_strat = g_sum(Atm(mytile)%domain, q_strat(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1) * 1.e6_r8 / psum - endif - - !------------------- - ! Get global mean mass for all tracers - !------------------- - do m=1,pcnst - qtot(m) = g_sum(Atm(mytile)%domain, psq(is,js,m), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1)/gravit - enddo - - if (masterproc) then - write(iulog,*)'Total Surface Pressure (mb) = ',global_ps/100.0_r8,"hPa" - write(iulog,*)'Mean Dry Surface Pressure (mb) = ',global_dryps/100.0_r8,"hPa" - write(iulog,*)'Mean specific humidity (mg/kg) above 75 mb = ',qm_strat - do m=1,pcnst - write(iulog,*)' Total '//cnst_name_ffsl(m)//' (kg/m**2) = ',qtot(m) - enddo - end if - - - deallocate(delpdry) - deallocate(psdry) - deallocate(psq) - deallocate(q_strat) -end subroutine fv3_tracer_diags - - -subroutine z_sum(atm,is,ie,js,je,km,q,msum,gpsum) - - ! vertical integral - - use fv_arrays_mod, only: fv_atmos_type - - ! arguments - - type (fv_atmos_type), intent(in), pointer :: Atm(:) - integer, intent(in) :: is, ie, js, je - integer, intent(in) :: km - real(r8), intent(in), dimension(is:ie, js:je, km) :: q - real(r8), intent(out), dimension(is:ie,js:je) :: msum - real(r8), intent(out), optional :: gpsum - - ! LOCAL VARIABLES - integer :: i,j,k - real(r8), dimension(is:ie,js:je) :: psum - !---------------------------------------------------------------------------- - msum=0._r8 - psum=0._r8 - do j=js,je - do i=is,ie - msum(i,j) = Atm(mytile)%delp(i,j,1)*q(i,j,1) - psum(i,j) = Atm(mytile)%delp(i,j,1) - enddo - do k=2,km - do i=is,ie - msum(i,j) = msum(i,j) + Atm(mytile)%delp(i,j,k)*q(i,j,k) - psum(i,j) = psum(i,j) + Atm(mytile)%delp(i,j,k) - enddo - enddo - enddo - if (present(gpsum)) then - gpsum = g_sum(Atm(mytile)%domain, psum, is, ie, js, je, Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1) - end if -end subroutine z_sum - -end module dp_coupling diff --git a/src/dynamics/fv3/dycore.F90 b/src/dynamics/fv3/dycore.F90 deleted file mode 100644 index eee3177587..0000000000 --- a/src/dynamics/fv3/dycore.F90 +++ /dev/null @@ -1,24 +0,0 @@ -module dycore - - implicit none - private - - public :: dycore_is - -!======================================================================= -contains -!======================================================================= - -logical function dycore_is(name) - - character(len=*) :: name - - dycore_is = .false. - if (name == 'unstructured' .or. name == 'UNSTRUCTURED' .or. name == 'fv3' .or. name == 'FV3') then - dycore_is = .true. - end if - - return -end function dycore_is - -end module dycore diff --git a/src/dynamics/fv3/dyn_comp.F90 b/src/dynamics/fv3/dyn_comp.F90 deleted file mode 100644 index 6703fd0d8b..0000000000 --- a/src/dynamics/fv3/dyn_comp.F90 +++ /dev/null @@ -1,2225 +0,0 @@ -module dyn_comp -! CAM interfaces to the GFDL FV3 Dynamical Core - -!----------------------------------------------------------------------- -! Five prognostic state variables for the fv3 dynamics -!----------------------------------------------------------------------- -! dyn_state: -! D-grid prognostatic variables: u, v, and delp (and other scalars) -! -! o--------u(i,j+1)----------o -! | | | -! | | | -! v(i,j)------scalar(i,j)----v(i+1,j) -! | | | -! | | | -! o--------u(i,j)------------o -! -! The C grid component is "diagnostic" in that it is predicted every time step -! from the D grid variables. -!---------------------------------------------------------------------- -! hydrostatic state: -!---------------------------------------------------------------------- -! u ! D grid zonal wind (m/s) -! v ! D grid meridional wind (m/s) -! p ! temperature (K) -! delp ! pressure thickness (pascal) -! q ! specific humidity and prognostic constituents -! qdiag ! diagnostic tracers -!---------------------------------------------------------------------- -! additional non-hydrostatic state: -!---------------------------------------------------------------------- -! w ! cell center vertical wind (m/s) -! delz ! layer thickness (meters) -! ze0 ! height at layer edges for remapping -! q_con ! total condensates -! -!---------------------------------------------------------------------- -!---------------------------------------------------------------------- - - - - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use constants_mod, only: cp_air, kappa, rvgas, rdgas - use constituents, only: pcnst, cnst_name, cnst_longname, tottnam - use dimensions_mod, only: npx, npy, nlev, & - cnst_name_ffsl,cnst_longname_ffsl, & - fv3_lcp_moist,fv3_lcv_moist,qsize_tracer_idx_cam2dyn,fv3_scale_ttend - use dyn_grid, only: mytile, ini_grid_name - use field_manager_mod, only: MODEL_ATMOS - use fms_io_mod, only: set_domain, nullify_domain - use fv_arrays_mod, only: fv_atmos_type, fv_grid_bounds_type - use fv_grid_utils_mod,only: cubed_to_latlon, g_sum - use fv_nesting_mod, only: twoway_nesting - use infnan, only: isnan - use mpp_domains_mod, only: mpp_update_domains, domain2D, DGRID_NE - use mpp_mod, only: mpp_set_current_pelist,mpp_pe - use physconst, only: gravit, cpair, rearth, omega, pi - use ppgrid, only: pver - use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4, i8 => shr_kind_i8 - use spmd_utils, only: masterproc, masterprocid, mpicom, npes,iam - use spmd_utils, only: mpi_integer, mpi_logical - use tracer_manager_mod, only: get_tracer_index - - implicit none - private - save - - public :: & - dyn_init, & - dyn_run, & - dyn_final, & - dyn_readnl, & - dyn_register, & - dyn_import_t, & - dyn_export_t - - public calc_tot_energy_dynamics - -type dyn_import_t - type (fv_atmos_type), pointer :: Atm(:) => null() - integer, pointer :: mygindex(:,:) => null() - integer, pointer :: mylindex(:,:) => null() -end type dyn_import_t - -type dyn_export_t - type (fv_atmos_type), pointer :: Atm(:) => null() -end type dyn_export_t - -! Private interfaces -interface read_dyn_var - module procedure read_dyn_field_2d - module procedure read_dyn_field_3d -end interface read_dyn_var - -real(r8), public, allocatable, dimension(:,:,:) :: u_dt, v_dt, t_dt - -!These are convenience variables for local use only, and are set to values in Atm% -real(r8) :: zvir, dt_atmos_real - -integer :: ldof_size - -real(r8), allocatable,dimension(:,:,:) :: se_dyn,ke_dyn,wv_dyn,wl_dyn,wi_dyn, & - wr_dyn,ws_dyn,wg_dyn,tt_dyn,mo_dyn,mr_dyn - -real(r8), parameter :: rad2deg = 180.0_r8 / pi -real(r8), parameter :: deg2rad = pi / 180.0_r8 - -!======================================================================= -contains -!======================================================================= -subroutine dyn_readnl(nlfilename) - - ! Read dynamics namelist group from atm_in and write to fv3 input.nml file - use namelist_utils, only: find_group_name - use constituents, only: pcnst - - ! args - character(len=*), intent(in) :: nlfilename - - ! Local variables - integer :: unitn,unito, ierr,i,ios - - ! FV3 Namelist variables - integer :: fv3_npes - - ! fv_core namelist variables - these namelist variables defined in fv3 library without fv3_ - - integer :: fv3_consv_te, fv3_dnats, fv3_fv_sg_adj, fv3_grid_type, & - fv3_hord_dp, fv3_hord_mt, fv3_hord_tm, fv3_hord_tr, fv3_hord_vt, & - fv3_io_layout(2), fv3_k_split, fv3_kord_mt, fv3_kord_tm, fv3_kord_tr, & - fv3_kord_wz, fv3_layout(2), fv3_n_split, fv3_n_sponge, fv3_na_init, & - fv3_ncnst, fv3_nord, fv3_npx, fv3_npy, fv3_npz, fv3_ntiles, & - fv3_nwat, fv3_print_freq - - real(r8) :: fv3_beta, fv3_d2_bg, fv3_d2_bg_k1, fv3_d2_bg_k2, fv3_d4_bg, & - fv3_d_con, fv3_d_ext, fv3_dddmp, fv3_delt_max, fv3_ke_bg, & - fv3_rf_cutoff, fv3_tau, fv3_vtdm4 - - logical :: fv3_adjust_dry_mass, fv3_consv_am, fv3_do_sat_adj, fv3_do_vort_damp, & - fv3_dwind_2d, fv3_fill, fv3_fv_debug, fv3_fv_diag, fv3_hydrostatic, & - fv3_make_nh, fv3_no_dycore, fv3_range_warn - - ! fms_nml namelist variables - these namelist variables defined in fv3 library without fv3_ - - character(len=256) :: fv3_clock_grain - integer :: fv3_domains_stack_size - integer :: fv3_stack_size - logical :: fv3_print_memory_usage - - character(len=256) :: inrec ! first 80 characters of input record - character(len=256) :: inrec2 ! left adjusted input record - - character(len = 20), dimension(5) :: group_names = (/ & - "main_nml ", & - "fv_core_nml ", & - "surf_map_nml ", & - "test_case_nml ", & - "fms_nml "/) - - namelist /fms_nml/ & - fv3_clock_grain, & - fv3_domains_stack_size, & - fv3_print_memory_usage, & - fv3_stack_size - - namelist /dyn_fv3_inparm/ & - fv3_scale_ttend, & - fv3_lcp_moist, & - fv3_lcv_moist, & - fv3_npes - - namelist /fv_core_nml/ & - fv3_adjust_dry_mass,fv3_beta,fv3_consv_am,fv3_consv_te,fv3_d2_bg, & - fv3_d2_bg_k1,fv3_d2_bg_k2,fv3_d4_bg,fv3_d_con,fv3_d_ext,fv3_dddmp, & - fv3_delt_max,fv3_dnats,fv3_do_sat_adj,fv3_do_vort_damp,fv3_dwind_2d, & - fv3_fill,fv3_fv_debug,fv3_fv_diag,fv3_fv_sg_adj,fv3_grid_type, & - fv3_hord_dp,fv3_hord_mt,fv3_hord_tm,fv3_hord_tr,fv3_hord_vt, & - fv3_hydrostatic,fv3_io_layout,fv3_k_split,fv3_ke_bg,fv3_kord_mt, & - fv3_kord_tm,fv3_kord_tr,fv3_kord_wz,fv3_layout,fv3_make_nh, & - fv3_n_split,fv3_n_sponge,fv3_na_init,fv3_ncnst,fv3_no_dycore, & - fv3_nord,fv3_npx,fv3_npy,fv3_npz,fv3_ntiles,fv3_nwat, & - fv3_print_freq,fv3_range_warn,fv3_rf_cutoff,fv3_tau, & - fv3_vtdm4 - !-------------------------------------------------------------------------- - - ! defaults for namelist variables not set by build-namelist - fv3_npes = npes - - if (masterproc) then - ! Read the namelist (dyn_fv3_inparm) - open( newunit=unitn, file=trim(NLFileName), status='old' ) - call find_group_name(unitn, 'dyn_fv3_inparm', status=ierr) - if (ierr == 0) then - read(unitn, dyn_fv3_inparm, iostat=ierr) - if (ierr /= 0) then - call endrun('dyn_readnl: ERROR reading dyn_fv3_inparm namelist') - end if - end if - close(unitn) - ! Read the namelist (fms_nml) - open( newunit=unitn, file=trim(NLFileName), status='old' ) - call find_group_name(unitn, 'fms_nml', status=ierr) - if (ierr == 0) then - read(unitn, fms_nml, iostat=ierr) - if (ierr /= 0) then - call endrun('dyn_readnl: ERROR reading fms_nml namelist') - end if - end if - close(unitn) - ! Read the namelist (fv_core_nml) - open( newunit=unitn, file=trim(NLFileName), status='old' ) - call find_group_name(unitn, 'fv_core_nml', status=ierr) - if (ierr == 0) then - read(unitn, fv_core_nml, iostat=ierr) - if (ierr /= 0) then - call endrun('dyn_readnl: ERROR reading fv_core_nml namelist') - end if - end if - close(unitn) - end if - - ! Broadcast namelist values to all PEs - call MPI_bcast(fv3_npes, 1, mpi_integer, masterprocid, mpicom, ierr) - call MPI_bcast(fv3_scale_ttend, 1, mpi_logical, masterprocid, mpicom, ierr) - call MPI_bcast(fv3_lcv_moist, 1, mpi_logical, masterprocid, mpicom, ierr) - call MPI_bcast(fv3_lcp_moist, 1, mpi_logical, masterprocid, mpicom, ierr) - - if ((fv3_lcp_moist.eqv.fv3_lcv_moist) .and. (fv3_lcv_moist.eqv..true.)) then - call endrun('dyn_readnl: fv3_lcp_moist and fv3_lcv_moist can not both be true') - endif - - if (fv3_npes <= 0) then - call endrun('dyn_readnl: ERROR: fv3_npes must be > 0') - end if - - ! - ! write fv3 dycore namelist options to log - ! - if (masterproc) then - write (iulog,*) 'FV3 dycore Options: ' - write (iulog,*) ' fv3_adjust_dry_mass = ',fv3_adjust_dry_mass - write (iulog,*) ' fv3_beta = ',fv3_beta - write (iulog,*) ' fv3_clock_grain = ',trim(fv3_clock_grain) - write (iulog,*) ' fv3_consv_am = ',fv3_consv_am - write (iulog,*) ' fv3_consv_te = ',fv3_consv_te - write (iulog,*) ' fv3_d2_bg = ',fv3_d2_bg - write (iulog,*) ' fv3_d2_bg_k1 = ',fv3_d2_bg_k1 - write (iulog,*) ' fv3_d2_bg_k2 = ',fv3_d2_bg_k2 - write (iulog,*) ' fv3_d4_bg = ',fv3_d4_bg - write (iulog,*) ' fv3_d_con = ',fv3_d_con - write (iulog,*) ' fv3_d_ext = ',fv3_d_ext - write (iulog,*) ' fv3_dddmp = ',fv3_dddmp - write (iulog,*) ' fv3_delt_max = ',fv3_delt_max - write (iulog,*) ' fv3_dnats = ',fv3_dnats - write (iulog,*) ' fv3_do_sat_adj = ',fv3_do_sat_adj - write (iulog,*) ' fv3_do_vort_damp = ',fv3_do_vort_damp - write (iulog,*) ' fv3_dwind_2d = ',fv3_dwind_2d - write (iulog,*) ' fv3_fill = ',fv3_fill - write (iulog,*) ' fv3_fv_debug = ',fv3_fv_debug - write (iulog,*) ' fv3_fv_diag = ',fv3_fv_diag - write (iulog,*) ' fv3_fv_sg_adj = ',fv3_fv_sg_adj - write (iulog,*) ' fv3_grid_type = ',fv3_grid_type - write (iulog,*) ' fv3_hord_dp = ',fv3_hord_dp - write (iulog,*) ' fv3_hord_mt = ',fv3_hord_mt - write (iulog,*) ' fv3_hord_tm = ',fv3_hord_tm - write (iulog,*) ' fv3_hord_tr = ',fv3_hord_tr - write (iulog,*) ' fv3_hord_vt = ',fv3_hord_vt - write (iulog,*) ' fv3_hydrostatic = ',fv3_hydrostatic - write (iulog,*) ' fv3_io_layout = ',fv3_io_layout - write (iulog,*) ' fv3_k_split = ',fv3_k_split - write (iulog,*) ' fv3_ke_bg = ',fv3_ke_bg - write (iulog,*) ' fv3_kord_mt = ',fv3_kord_mt - write (iulog,*) ' fv3_kord_tm = ',fv3_kord_tm - write (iulog,*) ' fv3_kord_tr = ',fv3_kord_tr - write (iulog,*) ' fv3_kord_wz = ',fv3_kord_wz - write (iulog,*) ' fv3_layout = ',fv3_layout - write (iulog,*) ' fv3_lcp_moist = ',fv3_lcp_moist - write (iulog,*) ' fv3_lcv_moist = ',fv3_lcv_moist - write (iulog,*) ' fv3_make_nh = ',fv3_make_nh - write (iulog,*) ' fv3_n_split = ',fv3_n_split - write (iulog,*) ' fv3_n_sponge = ',fv3_n_sponge - write (iulog,*) ' fv3_na_init = ',fv3_na_init - write (iulog,*) ' fv3_ncnst = ',fv3_ncnst - write (iulog,*) ' fv3_no_dycore = ',fv3_no_dycore - write (iulog,*) ' fv3_nord = ',fv3_nord - write (iulog,*) ' fv3_npx = ',fv3_npx - write (iulog,*) ' fv3_npy = ',fv3_npy - write (iulog,*) ' fv3_npz = ',fv3_npz - write (iulog,*) ' fv3_ntiles = ',fv3_ntiles - write (iulog,*) ' fv3_nwat = ',fv3_nwat - write (iulog,*) ' fv3_print_freq = ',fv3_print_freq - write (iulog,*) ' fv3_domains_stack_size = ',fv3_domains_stack_size - write (iulog,*) ' fv3_range_warn = ',fv3_range_warn - write (iulog,*) ' fv3_rf_cutoff = ',fv3_rf_cutoff - write (iulog,*) ' fv3_scale_ttend = ',fv3_scale_ttend - write (iulog,*) ' fv3_stack_size = ',fv3_stack_size - write (iulog,*) ' fv3_tau = ',fv3_tau - write (iulog,*) ' fv3_vtdm4 = ',fv3_vtdm4 - end if - - ! Create the input.nml namelist needed by the fv3dycore. - ! Read strings one at a time from the fv3 namelist groups, - ! strip off the leading 'fv3_' from the variable names and write to input.nml. - ! This could be replaced by also by writing to the internal namelist file - - if (masterproc) then - - write(iulog,*) 'Creating fv3 input.nml file from atm_in fv3_xxx namelist parameters' - ! Read the namelist (main_nml) - ! open the file input.nml - ! overwrite file if it exists. - open( newunit=unito, file='input.nml', status='replace' ) - - open( newunit=unitn, file=trim(NLFileName), status='old' ) - - do i=1,SIZE(group_names(:)) - rewind(unitn) - call find_group_name(unitn, trim(group_names(i)), status=ierr) - - if (ierr == 0) then ! Found it. Copy each line to input.nml until '/' is encountered. - - ! write group name to input.nml - read(unitn, '(a)', iostat=ios, end=100) inrec - if (ios /= 0) call endrun('ERROR: dyn_readnl - error reading fv3 namelist') - write(unito,'(a)') trim(inrec) - - ios = 0 - do while (ios <= 0) - - read(unitn, '(a)', iostat=ios, end=100) inrec - - if (ios <= 0) then ! ios < 0 indicates an end of record condition - - ! remove leading blanks and check for leading '/' - inrec2 = adjustl(inrec) - if (inrec2(1:4) == 'fv3_') then - inrec2(1:4) = ' ' - end if - write(unito,'(a)') trim(inrec2) - if (inrec2(1:1) == '/') exit - end if - end do - end if - end do - close(unitn) - close(unito) - end if - return -100 continue - call endrun('ERROR: dyn_readnl: End of file encountered while reading fv3 namelist groups') - -end subroutine dyn_readnl - -!============================================================================================= - -subroutine dyn_register() - - ! These fields are computed by the dycore and passed to the physics via the - ! physics buffer. - -end subroutine dyn_register - -!============================================================================================= - -subroutine dyn_init(dyn_in, dyn_out) - - ! DESCRIPTION: Initialize the FV dynamical core - - ! Initialize FV dynamical core state variables - - - use cam_control_mod, only: initial_run - use cam_history, only: addfld, horiz_only - use cam_history, only: register_vector_field - use cam_pio_utils, only: clean_iodesc_list - use dyn_grid, only: Atm,mygindex,mylindex - use fv_diagnostics_mod, only: fv_diag_init - use fv_mp_mod, only: fill_corners, YDir, switch_current_Atm - use infnan, only: inf, assignment(=) - use physconst, only: cpwv, cpliq, cpice - use physconst, only: thermodynamic_active_species_num, dry_air_species_num, thermodynamic_active_species_idx - use physconst, only: thermodynamic_active_species_idx_dycore, rair, cpair - use tracer_manager_mod, only: register_tracers - - ! arguments: - type (dyn_import_t), intent(out) :: dyn_in - type (dyn_export_t), intent(out) :: dyn_out - - ! Locals - character(len=*), parameter :: sub='dyn_init' - real(r8) :: alpha - - - real(r8), pointer, dimension(:,:) :: fC,f0 ! Coriolis parameters - real(r8), pointer, dimension(:,:,:) :: grid,agrid,delp - logical, pointer :: cubed_sphere - type(domain2d), pointer :: domain - integer :: i,j,m - - character(len=*), parameter :: subname = 'dyn_init' - - ! variables for initializing energy and axial angular momentum diagnostics - character (len = 3), dimension(8) :: stage = (/"dED","dAP","dBD","dAT","dAF","dAD","dAR","dBF"/) - character (len = 70),dimension(8) :: stage_txt = (/& - " end of previous dynamics ",& !dED - " after physics increment on A-grid ",& !dAP - " state after applying CAM forcing ",& !dBD - state after applyCAMforcing - " state after top of atmosphere damping (Rayleigh) ",& !dAT - " from previous remapping or state passed to dynamics",& !dAF - state in beginning of ksplit loop - " before vertical remapping ",& !dAD - state before vertical remapping - " after vertical remapping ",& !dAR - state at end of nsplit loop - " state passed to parameterizations " & !dBF - /) - character (len = 2) , dimension(11) :: vars = (/"WV","WL","WI","WR","WS","WG","SE","KE","MR","MO","TT"/) - character (len = 70), dimension(11) :: vars_descriptor = (/& - "Total column water vapor ",& - "Total column cloud water ",& - "Total column cloud ice ",& - "Total column rain ",& - "Total column snow ",& - "Total column graupel ",& - "Total column dry static energy ",& - "Total column kinetic energy ",& - "Total column wind axial angular momentum",& - "Total column mass axial angular momentum",& - "Total column test tracer "/) - character (len = 14), dimension(11) :: & - vars_unit = (/& - "kg/m2 ","kg/m2 ","kg/m2 ", & - "kg/m2 ","kg/m2 ","kg/m2 ","J/m2 ",& - "J/m2 ","kg*m2/s*rad2 ","kg*m2/s*rad2 ","kg/m2 "/) - - integer :: istage, ivars - character (len=108) :: str1, str2, str3 - integer :: is,isd,ie,ied,js,jsd,je,jed - integer :: fv3idx,idx - - integer :: unito - integer, parameter :: ndiag = 5 - integer :: ncnst, pnats, num_family, nt_prog - character(len=128) :: errmsg - logical :: wet_thermo_species - !----------------------------------------------------------------------- - - ! Setup the condensate loading arrays and fv3/cam tracer mapping and - ! finish initializing fv3 by allocating the tracer arrays in the fv3 atm structure - - allocate(qsize_tracer_idx_cam2dyn(pcnst)) - qsize_tracer_idx_cam2dyn(:)=-1 - allocate(cnst_name_ffsl(pcnst)) ! constituent names for ffsl tracers - allocate(cnst_longname_ffsl(pcnst)) ! long name of constituents for ffsl tracers - - - ! set up the condensate loading array - if (thermodynamic_active_species_num - dry_air_species_num > 6) then - call endrun(subname//': fv3_thermodynamic_active_species_num is limited to 6 wet condensates') - end if - - !For FV3 Q must be the first species in the fv3 tracer array followed by wet constituents - idx=1 - do m=1,pcnst - if ( trim(cnst_name(m)) == 'Q'.or.& - trim(cnst_name(m)) == 'CLDLIQ'.or.& - trim(cnst_name(m)) == 'CLDICE'.or.& - trim(cnst_name(m)) == 'RAINQM'.or.& - trim(cnst_name(m)) == 'SNOWQM'.or.& - trim(cnst_name(m)) == 'GRAUQM') then - idx=idx+1 - wet_thermo_species=any(thermodynamic_active_species_idx(dry_air_species_num+1:thermodynamic_active_species_num)==m) - select case ( trim(cnst_name(m)) ) - case ( 'Q' ) - idx=idx-1 - cnst_name_ffsl(1)='sphum' - cnst_longname_ffsl(1) = cnst_longname(m) - qsize_tracer_idx_cam2dyn(m) = 1 - if (wet_thermo_species) thermodynamic_active_species_idx_dycore(1)=1 - case ( 'CLDLIQ' ) - cnst_name_ffsl(idx)='liq_wat' - case ( 'CLDICE' ) - cnst_name_ffsl(idx)='ice_wat' - case ( 'RAINQM' ) - cnst_name_ffsl(idx)='rainwat' - case ( 'SNOWQM' ) - cnst_name_ffsl(idx)='snowwat' - case ( 'GRAUQM' ) - cnst_name_ffsl(idx)='graupel' - end select - - if (trim(cnst_name(m))/='Q') then - if (wet_thermo_species) thermodynamic_active_species_idx_dycore(idx)=idx - cnst_longname_ffsl(idx) = cnst_longname(m) - qsize_tracer_idx_cam2dyn(m) = idx - end if - end if - end do - - do m=1,pcnst - if ( trim(cnst_name(m)) /= 'Q'.and.& - trim(cnst_name(m)) /= 'CLDLIQ'.and.& - trim(cnst_name(m)) /= 'CLDICE'.and.& - trim(cnst_name(m)) /= 'RAINQM'.and.& - trim(cnst_name(m)) /= 'SNOWQM'.and.& - trim(cnst_name(m)) /= 'GRAUQM') then - idx=idx+1 - cnst_name_ffsl(idx)=cnst_name(m) - cnst_longname_ffsl(idx) = cnst_longname(m) - qsize_tracer_idx_cam2dyn(m) = idx - end if - end do - - if (masterproc) then - - write(iulog,*) 'Creating field_table file to load tracer fields into fv3' - ! overwrite file if it exists. - open( newunit=unito, file='field_table', status='replace' ) - do i=1,pcnst - write(unito, '(a,a,a)') '"tracer" "atmos_mod" "'//trim(cnst_name_ffsl(i))//'" /' - end do - close(unito) - end if - !---------must make sure the field_table file is written before reading across processors - call mpibarrier (mpicom) - call register_tracers (MODEL_ATMOS, ncnst, nt_prog, pnats, num_family) - if (ncnst /= pcnst) then - call endrun(subname//': ERROR: FMS tracer Manager has inconsistent tracer numbers') - endif - - do m=1,pcnst - ! just check condensate loading tracers as they are mapped above - if(qsize_tracer_idx_cam2dyn(m) <= thermodynamic_active_species_num-dry_air_species_num) then - fv3idx = get_tracer_index (MODEL_ATMOS, cnst_name_ffsl(qsize_tracer_idx_cam2dyn(m)) ) - if (fv3idx /= qsize_tracer_idx_cam2dyn(m)) then - write(errmsg,*) subname//': Physics index ',m,'and FV3 tracer index',fv3idx,' are inconsistent' - call endrun(errmsg) - end if - end if - end do - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - isd = Atm(mytile)%bd%isd - ied = Atm(mytile)%bd%ied - jsd = Atm(mytile)%bd%jsd - jed = Atm(mytile)%bd%jed - - ! Data initialization - dyn_in%Atm => Atm - dyn_in%mygindex => mygindex - dyn_in%mylindex => mylindex - dyn_out%Atm => Atm - - allocate(u_dt(isd:ied,jsd:jed,nlev)) - allocate(v_dt(isd:ied,jsd:jed,nlev)) - allocate(t_dt(isd:ied,jsd:jed,nlev)) - u_dt(:,:,:) = 0._r8 - v_dt(:,:,:) = 0._r8 - t_dt(:,:,:) = 0._r8 - - fC => atm(mytile)%gridstruct%fC - f0 => atm(mytile)%gridstruct%f0 - grid => atm(mytile)%gridstruct%grid_64 - agrid => atm(mytile)%gridstruct%agrid_64 - domain=> Atm(mytile)%domain - cubed_sphere => atm(mytile)%gridstruct%cubed_sphere - delp => Atm(mytile)%delp - - ! initialize Coriolis parameters which are used in sw_core. - f0(:,:) = inf - fC(:,:) = inf - alpha = 0._r8 - - do j=jsd,jed+1 - do i=isd,ied+1 - fC(i,j) = 2._r8*omega*( -1._r8*cos(grid(i,j,1))*cos(grid(i,j,2))*sin(alpha) + & - sin(grid(i,j,2))*cos(alpha) ) - enddo - enddo - do j=jsd,jed - do i=isd,ied - f0(i,j) = 2._r8*omega*( -1._r8*cos(agrid(i,j,1))*cos(agrid(i,j,2))*sin(alpha) + & - sin(agrid(i,j,2))*cos(alpha) ) - enddo - enddo - call mpp_update_domains( f0, domain ) - if (cubed_sphere) call fill_corners(f0, npx, npy, YDir) - - delp(isd:is-1,jsd:js-1,1:nlev)=0._r8 - delp(isd:is-1,je+1:jed,1:nlev)=0._r8 - delp(ie+1:ied,jsd:js-1,1:nlev)=0._r8 - delp(ie+1:ied,je+1:jed,1:nlev)=0._r8 - - if (initial_run) then - - ! Read in initial data - call read_inidat(dyn_in) - call clean_iodesc_list() - - end if - - call switch_current_Atm(Atm(mytile)) - call set_domain ( Atm(mytile)%domain ) - - ! Forcing from physics on the FFSL grid - call addfld ('FU', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind forcing term on FFSL grid', gridname='FFSLHIST') - call addfld ('FV', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind forcing term on FFSL grid',gridname='FFSLHIST') - call register_vector_field('FU', 'FV') - call addfld ('FT', (/ 'lev' /), 'A', 'K/s', 'Temperature forcing term on FFSL grid',gridname='FFSLHIST') - - do m = 1, pcnst - call addfld ('F'//trim(cnst_name_ffsl(m))//'_ffsl', (/ 'lev' /), 'I', 'kg/kg/s', & - trim(cnst_longname(m))//' mixing ratio forcing term (q_new-q_old) on FFSL grid', gridname='FFSLHIST') - call addfld(tottnam(m),(/ 'lev' /),'A','kg/kg/s', & - trim(cnst_name_ffsl(m))//' horz + vert + fixer tendency ', & - gridname='FFSLHIST') - end do - - ! Energy diagnostics and axial angular momentum diagnostics - do istage = 1,SIZE(stage) - do ivars=1,SIZE(vars) - write(str1,*) TRIM(ADJUSTL(vars(ivars))),TRIM(ADJUSTL("_")),TRIM(ADJUSTL(stage(istage))) - write(str2,*) TRIM(ADJUSTL(vars_descriptor(ivars))),& - TRIM(ADJUSTL(" ")),TRIM(ADJUSTL(stage_txt(istage))) - write(str3,*) TRIM(ADJUSTL(vars_unit(ivars))) - call addfld (TRIM(ADJUSTL(str1)),horiz_only,'A',TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - gridname='FFSLHIST') - end do - end do - - allocate(se_dyn(is:ie,js:je,ndiag)) - allocate(ke_dyn(is:ie,js:je,ndiag)) - allocate(wv_dyn(is:ie,js:je,ndiag)) - allocate(wl_dyn(is:ie,js:je,ndiag)) - allocate(wi_dyn(is:ie,js:je,ndiag)) - allocate(wr_dyn(is:ie,js:je,ndiag)) - allocate(ws_dyn(is:ie,js:je,ndiag)) - allocate(wg_dyn(is:ie,js:je,ndiag)) - allocate(tt_dyn(is:ie,js:je,ndiag)) - allocate(mr_dyn(is:ie,js:je,ndiag)) - allocate(mo_dyn(is:ie,js:je,ndiag)) - - -end subroutine dyn_init - -!======================================================================= - -subroutine dyn_run(dyn_state) - - ! DESCRIPTION: Driver for the NASA finite-volume dynamical core - - - use dimensions_mod, only: nlev - use dyn_grid, only: p_split,grids_on_this_pe - use fv_control_mod, only: ngrids - use fv_dynamics_mod, only: fv_dynamics - use fv_sg_mod, only: fv_subgrid_z - use physconst, only: thermodynamic_active_species_num, thermodynamic_active_species_idx_dycore, & - thermodynamic_active_species_cp,thermodynamic_active_species_cv,dry_air_species_num - use time_manager, only: get_step_size - use tracer_manager_mod, only: get_tracer_index, NO_TRACER - - ! Arguments - type (dyn_export_t), intent(inout) :: dyn_state - - ! Locals - integer :: psc,idim - integer :: w_diff, nt_dyn - type(fv_atmos_type), pointer :: Atm(:) - integer :: is,isc,isd,ie,iec,ied,js,jsc,jsd,je,jec,jed - - !---- Call FV dynamics ----- - - Atm => dyn_state%Atm - - !----------------------------------------------------------------------- - - call mpp_set_current_pelist(Atm(mytile)%pelist, no_sync=.TRUE.) - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - isc = Atm(mytile)%bd%isc - iec = Atm(mytile)%bd%iec - jsc = Atm(mytile)%bd%jsc - jec = Atm(mytile)%bd%jec - isd = Atm(mytile)%bd%isd - ied = Atm(mytile)%bd%ied - jsd = Atm(mytile)%bd%jsd - jed = Atm(mytile)%bd%jed - - idim=ie-is+1 - - dt_atmos_real=get_step_size() - - se_dyn = 0._r8 - ke_dyn = 0._r8 - wv_dyn = 0._r8 - wl_dyn = 0._r8 - wi_dyn = 0._r8 - wr_dyn = 0._r8 - ws_dyn = 0._r8 - wg_dyn = 0._r8 - tt_dyn = 0._r8 - mo_dyn = 0._r8 - mr_dyn = 0._r8 - - zvir = rvgas/rdgas - 1._r8 - - Atm(mytile)%parent_grid => Atm(mytile) - - do psc=1,abs(p_split) - - call fv_dynamics(npx, npy, nlev, pcnst, Atm(mytile)%ng, dt_atmos_real/real(abs(p_split), r8),& - Atm(mytile)%flagstruct%consv_te, Atm(mytile)%flagstruct%fill, & - Atm(mytile)%flagstruct%reproduce_sum, kappa, cp_air, zvir,& - Atm(mytile)%ptop, Atm(mytile)%ks, pcnst, & - Atm(mytile)%flagstruct%n_split, Atm(mytile)%flagstruct%q_split,& - Atm(mytile)%u, Atm(mytile)%v, Atm(mytile)%w, Atm(mytile)%delz, & - Atm(mytile)%flagstruct%hydrostatic, & - Atm(mytile)%pt, Atm(mytile)%delp, Atm(mytile)%q, Atm(mytile)%ps, & - Atm(mytile)%pe, Atm(mytile)%pk, Atm(mytile)%peln, & - Atm(mytile)%pkz, Atm(mytile)%phis, Atm(mytile)%q_con, & - Atm(mytile)%omga, Atm(mytile)%ua, Atm(mytile)%va, Atm(mytile)%uc, & - Atm(mytile)%vc, Atm(mytile)%ak, Atm(mytile)%bk, Atm(mytile)%mfx, & - Atm(mytile)%mfy, Atm(mytile)%cx, Atm(mytile)%cy, Atm(mytile)%ze0, & - Atm(mytile)%flagstruct%hybrid_z, & - Atm(mytile)%gridstruct, Atm(mytile)%flagstruct, & - Atm(mytile)%neststruct, Atm(mytile)%idiag, Atm(mytile)%bd, & - Atm(mytile)%parent_grid, Atm(mytile)%domain, & -#if ( defined CALC_ENERGY ) - Atm(mytile)%diss_est, & - pcnst,thermodynamic_active_species_num,dry_air_species_num, & - thermodynamic_active_species_idx_dycore, qsize_tracer_idx_cam2dyn, & - thermodynamic_active_species_cp,thermodynamic_active_species_cv, se_dyn, ke_dyn, wv_dyn,wl_dyn, & - wi_dyn,wr_dyn,ws_dyn,wg_dyn,tt_dyn,mo_dyn,mr_dyn,gravit,cpair,rearth,omega,fv3_lcp_moist,& - fv3_lcv_moist) -#else - Atm(mytile)%diss_est) -#endif - - if (ngrids > 1 .and. (psc < p_split .or. p_split < 0)) then - call twoway_nesting(Atm, ngrids, grids_on_this_pe, zvir) - endif - - end do !p_split -#if ( defined CALC_ENERGY ) - call write_dyn_var(se_dyn(is:ie,js:je,1),'SE_dAF',Atm(mytile)%bd) - call write_dyn_var(ke_dyn(is:ie,js:je,1),'KE_dAF',Atm(mytile)%bd) - call write_dyn_var(wv_dyn(is:ie,js:je,1),'WV_dAF',Atm(mytile)%bd) - call write_dyn_var(wl_dyn(is:ie,js:je,1),'WL_dAF',Atm(mytile)%bd) - call write_dyn_var(wi_dyn(is:ie,js:je,1),'WI_dAF',Atm(mytile)%bd) - call write_dyn_var(wr_dyn(is:ie,js:je,1),'WR_dAF',Atm(mytile)%bd) - call write_dyn_var(ws_dyn(is:ie,js:je,1),'WS_dAF',Atm(mytile)%bd) - call write_dyn_var(wg_dyn(is:ie,js:je,1),'WG_dAF',Atm(mytile)%bd) - call write_dyn_var(tt_dyn(is:ie,js:je,1),'TT_dAF',Atm(mytile)%bd) - call write_dyn_var(mo_dyn(is:ie,js:je,1),'MO_dAF',Atm(mytile)%bd) - call write_dyn_var(mr_dyn(is:ie,js:je,1),'MR_dAF',Atm(mytile)%bd) - - call write_dyn_var(se_dyn(is:ie,js:je,2),'SE_dAD',Atm(mytile)%bd) - call write_dyn_var(ke_dyn(is:ie,js:je,2),'KE_dAD',Atm(mytile)%bd) - call write_dyn_var(wv_dyn(is:ie,js:je,2),'WV_dAD',Atm(mytile)%bd) - call write_dyn_var(wl_dyn(is:ie,js:je,2),'WL_dAD',Atm(mytile)%bd) - call write_dyn_var(wi_dyn(is:ie,js:je,2),'WI_dAD',Atm(mytile)%bd) - call write_dyn_var(wr_dyn(is:ie,js:je,2),'WR_dAD',Atm(mytile)%bd) - call write_dyn_var(ws_dyn(is:ie,js:je,2),'WS_dAD',Atm(mytile)%bd) - call write_dyn_var(wg_dyn(is:ie,js:je,2),'WG_dAD',Atm(mytile)%bd) - call write_dyn_var(tt_dyn(is:ie,js:je,2),'TT_dAD',Atm(mytile)%bd) - call write_dyn_var(mo_dyn(is:ie,js:je,2),'MO_dAD',Atm(mytile)%bd) - call write_dyn_var(mr_dyn(is:ie,js:je,2),'MR_dAD',Atm(mytile)%bd) - - call write_dyn_var(se_dyn(is:ie,js:je,3),'SE_dAR',Atm(mytile)%bd) - call write_dyn_var(ke_dyn(is:ie,js:je,3),'KE_dAR',Atm(mytile)%bd) - call write_dyn_var(wv_dyn(is:ie,js:je,3),'WV_dAR',Atm(mytile)%bd) - call write_dyn_var(wl_dyn(is:ie,js:je,3),'WL_dAR',Atm(mytile)%bd) - call write_dyn_var(wi_dyn(is:ie,js:je,3),'WI_dAR',Atm(mytile)%bd) - call write_dyn_var(wr_dyn(is:ie,js:je,3),'WR_dAR',Atm(mytile)%bd) - call write_dyn_var(ws_dyn(is:ie,js:je,3),'WS_dAR',Atm(mytile)%bd) - call write_dyn_var(wg_dyn(is:ie,js:je,3),'WG_dAR',Atm(mytile)%bd) - call write_dyn_var(tt_dyn(is:ie,js:je,3),'TT_dAR',Atm(mytile)%bd) - call write_dyn_var(mo_dyn(is:ie,js:je,3),'MO_dAR',Atm(mytile)%bd) - call write_dyn_var(mr_dyn(is:ie,js:je,3),'MR_dAR',Atm(mytile)%bd) - - call write_dyn_var(se_dyn(is:ie,js:je,4),'SE_dAT',Atm(mytile)%bd) - call write_dyn_var(ke_dyn(is:ie,js:je,4),'KE_dAT',Atm(mytile)%bd) - call write_dyn_var(wv_dyn(is:ie,js:je,4),'WV_dAT',Atm(mytile)%bd) - call write_dyn_var(wl_dyn(is:ie,js:je,4),'WL_dAT',Atm(mytile)%bd) - call write_dyn_var(wi_dyn(is:ie,js:je,4),'WI_dAT',Atm(mytile)%bd) - call write_dyn_var(wr_dyn(is:ie,js:je,4),'WR_dAT',Atm(mytile)%bd) - call write_dyn_var(ws_dyn(is:ie,js:je,4),'WS_dAT',Atm(mytile)%bd) - call write_dyn_var(wg_dyn(is:ie,js:je,4),'WG_dAT',Atm(mytile)%bd) - call write_dyn_var(tt_dyn(is:ie,js:je,4),'TT_dAT',Atm(mytile)%bd) - call write_dyn_var(mo_dyn(is:ie,js:je,4),'MO_dAT',Atm(mytile)%bd) - call write_dyn_var(mr_dyn(is:ie,js:je,4),'MR_dAT',Atm(mytile)%bd) -#endif - - !----------------------------------------------------- - !--- COMPUTE SUBGRID Z - !----------------------------------------------------- - !--- zero out tendencies - u_dt(:,:,:) = 0._r8 - v_dt(:,:,:) = 0._r8 - t_dt(:,:,:) = 0._r8 - - w_diff = get_tracer_index (MODEL_ATMOS, 'w_diff' ) - - ! Perform grid-scale dry adjustment if fv_sg_adj > 0 - if ( Atm(mytile)%flagstruct%fv_sg_adj > 0 ) then - nt_dyn = pcnst - if ( w_diff /= NO_TRACER ) then - nt_dyn = pcnst - 1 - endif - call fv_subgrid_z(isd, ied, jsd, jed, isc, iec, jsc, jec, nlev, & - nt_dyn, dt_atmos_real, Atm(mytile)%flagstruct%fv_sg_adj, & - Atm(mytile)%flagstruct%nwat, Atm(mytile)%delp, Atm(mytile)%pe, & - Atm(mytile)%peln, Atm(mytile)%pkz, Atm(mytile)%pt, Atm(mytile)%q, & - Atm(mytile)%ua, Atm(mytile)%va, Atm(mytile)%flagstruct%hydrostatic,& - Atm(mytile)%w, Atm(mytile)%delz, u_dt, v_dt, t_dt, Atm(mytile)%flagstruct%n_sponge) - endif - -#if ( defined CALC_ENERGY ) - call calc_tot_energy_dynamics(atm,'dBF') -#endif - -end subroutine dyn_run - -!======================================================================= - -subroutine dyn_final(dyn_in, dyn_out, restart_file) - - ! Arguments - type (dyn_import_t), intent(inout) :: dyn_in - type (dyn_export_t), intent(inout) :: dyn_out - character(len=*),optional,intent(in) :: restart_file - - !---------------------------------------------------------------------------- - - deallocate( u_dt, v_dt, t_dt) - -end subroutine dyn_final - -!============================================================================================= -! Private routines -!============================================================================================= - -subroutine read_inidat(dyn_in) - - use cam_control_mod, only: simple_phys - use inic_analytic, only: analytic_ic_active, analytic_ic_set_ic - use dyn_tests_utils, only: vc_moist_pressure,vc_dry_pressure - use dimensions_mod, only: nlev - use constituents, only: pcnst, cnst_is_a_water_species - use physconst, only: thermodynamic_active_species_num, dry_air_species_num, thermodynamic_active_species_idx_dycore - use pio, only: file_desc_t, pio_seterrorhandling, pio_bcast_error - use ppgrid, only: pver - use cam_abortutils, only: endrun - use constituents, only: pcnst, cnst_name, cnst_read_iv,qmin, cnst_type - use const_init, only: cnst_init_default - use cam_initfiles, only: initial_file_get_id, topo_file_get_id, pertlim - use cam_grid_support, only: cam_grid_id, cam_grid_get_gcid, iMap, & - cam_grid_get_latvals, cam_grid_get_lonvals - use cam_history_support, only: max_fieldname_len - use hycoef, only: hyai, hybi, ps0 - - ! Arguments: - type (dyn_import_t), target, intent(inout) :: dyn_in ! dynamics import - - ! Locals: - logical :: found - - character(len = 40) :: fieldname,fieldname2 - - integer :: i, j, k, m, n - - type(file_desc_t), pointer :: fh_topo => null() - type(fv_atmos_type), pointer :: Atm(:) => null() - integer, pointer :: mylindex(:,:) => null() - integer, pointer :: mygindex(:,:) => null() - type(file_desc_t) :: fh_ini - - - character(len=*), parameter :: subname='READ_INIDAT' - - ! Variables for analytic initial conditions - integer, allocatable, dimension(:) :: glob_ind, m_ind,rndm_seed - integer :: is,ie,js,je,isd,ied,jsd,jed - integer :: blksize - integer :: indx - integer :: err_handling - integer :: m_cnst,m_cnst_ffsl - integer :: m_ffsl - integer :: ilen,jlen - integer :: num_wet_species! (wet species are first tracers in FV3 tracer array) - integer :: pio_errtype - integer :: rndm_seed_sz - integer :: vcoord - real(r8), pointer, dimension(:) :: latvals_deg(:) - real(r8), pointer, dimension(:) :: lonvals_deg(:) - real(r8), allocatable, dimension(:) :: latvals_rad, lonvals_rad - real(r8), allocatable, dimension(:,:) :: dbuf2 - real(r8), allocatable, dimension(:,:) :: pstmp - real(r8), allocatable, dimension(:,:) :: phis_tmp, var2d - real(r8), allocatable, dimension(:,:,:) :: dbuf3, var3d - real(r8), allocatable, dimension(:,:,:,:) :: dbuf4 - real(r8), pointer, dimension(:,:,:) :: agrid,grid - real(r8) :: pertval - real(r8) :: tracermass(pcnst),delpdry - real(r8) :: fv3_totwatermass, fv3_airmass - real(r8) :: initial_global_ave_dry_ps,reldif - logical :: inic_wet !initial condition is based on wet pressure and water species - - !----------------------------------------------------------------------- - - Atm => dyn_in%Atm - grid => Atm(mytile)%gridstruct%grid_64 - agrid => Atm(mytile)%gridstruct%agrid_64 - mylindex => dyn_in%mylindex - mygindex => dyn_in%mygindex - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - isd = Atm(mytile)%bd%isd - ied = Atm(mytile)%bd%ied - jsd = Atm(mytile)%bd%jsd - jed = Atm(mytile)%bd%jed - - fh_topo => topo_file_get_id() - fh_ini = initial_file_get_id() - - - ! Set mask to indicate which columns are active - ldof_size=(je-js+1)*(ie-is+1) - allocate(phis_tmp(ldof_size,1)) - phis_tmp(:,:)=0._r8 - - latvals_deg => cam_grid_get_latvals(cam_grid_id('FFSL')) - lonvals_deg => cam_grid_get_lonvals(cam_grid_id('FFSL')) - blksize=(ie-is+1)*(je-js+1) - - ! consistency check - if (blksize /= SIZE(latvals_deg)) then - call endrun(trim(subname)//': number of latitude values is inconsistent with dynamics block size.') - end if - - allocate(latvals_rad(blksize)) - allocate(lonvals_rad(blksize)) - latvals_rad(:) = latvals_deg(:)*deg2rad - lonvals_rad(:) = lonvals_deg(:)*deg2rad - - allocate(glob_ind(blksize)) - do j = js, je - do i = is, ie - n=mylindex(i,j) - glob_ind(n) = mygindex(i,j) - end do - end do - - ! Set ICs. Either from analytic expressions or read from file. - - if (analytic_ic_active()) then - vcoord = vc_moist_pressure - inic_wet = .true. - ! First, initialize all the variables, then assign - allocate(dbuf2(blksize,1)) - allocate(dbuf3(blksize,nlev,1)) - allocate(dbuf4(blksize,nlev, 1,pcnst)) - dbuf2 = 0.0_r8 - dbuf3 = 0.0_r8 - dbuf4 = 0.0_r8 - - allocate(m_ind(pcnst)) - do m_cnst = 1, pcnst - m_ind(m_cnst) = m_cnst - end do - - call analytic_ic_set_ic(vcoord, latvals_rad, lonvals_rad, glob_ind,PS=dbuf2) - do j = js, je - do i = is, ie - ! PS - n=mylindex(i,j) - atm(mytile)%ps(i,j) = dbuf2(n, 1) - end do - end do - - call analytic_ic_set_ic(vcoord, latvals_rad, lonvals_rad, glob_ind , & - PHIS_OUT=phis_tmp(:,:)) - - call analytic_ic_set_ic(vcoord, latvals_rad, lonvals_rad, glob_ind, & - T=dbuf3(:,:,:)) - - do j = js, je - do i = is, ie - ! T - n=mylindex(i,j) - atm(mytile)%pt(i,j,:) = dbuf3(n, :, 1) - end do - end do - - - dbuf3=0._r8 - call analytic_ic_set_ic(vcoord, latvals_rad, lonvals_rad, glob_ind, & - U=dbuf3(:,:,:)) - - do j = js, je - do i = is, ie - ! U a-grid - n=mylindex(i,j) - atm(mytile)%ua(i,j,:) = dbuf3(n, :, 1) - end do - end do - - dbuf3=0._r8 - call analytic_ic_set_ic(vcoord, latvals_rad, lonvals_rad, glob_ind, & - V=dbuf3(:,:,:)) - - do j = js, je - do i = is, ie - ! V a-grid - n=mylindex(i,j) - atm(mytile)%va(i,j,:) = dbuf3(n, :, 1) - end do - end do - - call analytic_ic_set_ic(vcoord, latvals_rad, lonvals_rad, glob_ind, & - Q=dbuf4(:,:,:,1:pcnst), m_cnst=m_ind) - - ! Tracers to be advected on FFSL grid. - do m_cnst = 1, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - Atm(mytile)%q(:,:,:,m_cnst_ffsl) = 0.0_r8 - do j = js, je - do i = is, ie - indx=mylindex(i,j) - Atm(mytile)%q(i,j,:,m_cnst_ffsl) = dbuf4(indx, :, 1, m_cnst) - end do - end do - end do - - !----------------------------------------------------------------------- - call a2d3djt(atm(mytile)%ua, atm(mytile)%va, atm(mytile)%u, atm(mytile)%v, is, ie, js, je, & - isd, ied, jsd, jed, npx,npy, nlev, atm(mytile)%gridstruct, atm(mytile)%domain) - - deallocate(dbuf2) - deallocate(dbuf3) - deallocate(dbuf4) - deallocate(m_ind) - - else - ! Read ICs from file. - - allocate(dbuf3(blksize,nlev,1)) - allocate(var2d(is:ie,js:je)) - allocate(var3d(is:ie,js:je,nlev)) - - call pio_seterrorhandling(fh_ini, pio_bcast_error, err_handling) - ! PSDRY is unambiguous so use that field first if it exists and reset mixing ratios to - ! wet for FV3. PS (inic_wet) is assumed to be DRY+All wet condensates but could also be - ! DRY+Q (CAM physics) - fieldname = 'PSDRY' - fieldname2 = 'PS' - if (dyn_field_exists(fh_ini, trim(fieldname), required=.false.)) then - inic_wet = .false. - call read_dyn_var(trim(fieldname), fh_ini, 'ncol', var2d) - elseif (dyn_field_exists(fh_ini, trim(fieldname2), required=.false.)) then - inic_wet = .true. - call read_dyn_var(trim(fieldname2), fh_ini, 'ncol', var2d) - else - call endrun(trim(subname)//': PS or PSDRY must be on ncdata') - end if - atm(mytile)%ps(is:ie,js:je) = var2d - - ilen = ie-is+1 - jlen = je-js+1 - - ! T - if (dyn_field_exists(fh_ini, 'T')) then - call read_dyn_var('T', fh_ini, 'ncol', var3d) - atm(mytile)%pt(is:ie,js:je,1:nlev)=var3d(is:ie,js:je,1:nlev) - else - call endrun(trim(subname)//': T not found') - end if - - if (pertlim /= 0.0_r8) then - if(masterproc) then - write(iulog,*) trim(subname), ': Adding random perturbation bounded', & - 'by +/- ', pertlim, ' to initial temperature field' - end if - - call random_seed(size=rndm_seed_sz) - allocate(rndm_seed(rndm_seed_sz)) - - do i=is,ie - do j=js,je - indx=mylindex(i,j) - rndm_seed = glob_ind(indx) - call random_seed(put=rndm_seed) - do k=1,nlev - call random_number(pertval) - pertval = 2.0_r8*pertlim*(0.5_r8 - pertval) - atm(mytile)%pt(i,j,k) = atm(mytile)%pt(i,j,k)*(1.0_r8 + pertval) - end do - end do - end do - deallocate(rndm_seed) - end if - - ! V - if (dyn_field_exists(fh_ini, 'V')) then - call read_dyn_var('V', fh_ini, 'ncol', var3d) - atm(mytile)%va(is:ie,js:je,1:nlev)=var3d(is:ie,js:je,1:nlev) - else - call endrun(trim(subname)//': V not found') - end if - - if (dyn_field_exists(fh_ini, 'U')) then - call read_dyn_var('U', fh_ini, 'ncol', var3d) - atm(mytile)%ua(is:ie,js:je,1:nlev) =var3d(is:ie,js:je,1:nlev) - else - call endrun(trim(subname)//': U not found') - end if - - m_cnst=1 - if (dyn_field_exists(fh_ini, 'Q')) then - call read_dyn_var('Q', fh_ini, 'ncol', var3d) - atm(mytile)%q(is:ie,js:je,1:nlev,m_cnst) = var3d(is:ie,js:je,1:nlev) - else - call endrun(trim(subname)//': Q not found') - end if - - ! Read in or cold-initialize all the tracer fields - ! Copy tracers defined on unstructured grid onto distributed FFSL grid - ! Make sure tracers have at least minimum value - - do m_cnst = 2, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - found = .false. - - if(cnst_read_iv(m_cnst)) then - found = dyn_field_exists(fh_ini, trim(cnst_name(m_cnst)), & - required=.false.) - end if - - if(found) then - call read_dyn_var(trim(cnst_name(m_cnst)), fh_ini, 'ncol', var3d) - atm(mytile)%q(is:ie,js:je,1:nlev,m_cnst_ffsl) = var3d(is:ie,js:je,1:nlev) - else - dbuf3=0._r8 - if (masterproc) write(iulog,*)'Missing ',trim(cnst_name(m_cnst)),' constituent number', & - m_cnst,size(latvals_rad),size(dbuf3) - if (masterproc) write(iulog,*)'Initializing ',trim(cnst_name(m_cnst)),'fv3 constituent number ',& - m_cnst_ffsl,' to default' - call cnst_init_default(m_cnst, latvals_rad, lonvals_rad, dbuf3) - do k=1, nlev - indx = 1 - do j = js, je - do i = is, ie - indx=mylindex(i,j) - atm(mytile)%q(i,j, k, m_cnst_ffsl) = max(qmin(m_cnst),dbuf3(indx,k,1)) - end do - end do - end do - end if - - end do ! pcnst - - call a2d3djt(atm(mytile)%ua, atm(mytile)%va, atm(mytile)%u, atm(mytile)%v, is, ie, js, je, & - isd, ied, jsd, jed, npx,npy, nlev, atm(mytile)%gridstruct, atm(mytile)%domain) - - ! Put the error handling back the way it was - call pio_seterrorhandling(fh_ini, err_handling) - - deallocate(dbuf3) - deallocate(var2d) - deallocate(var3d) - - end if ! analytic_ic_active - - deallocate(latvals_rad) - deallocate(lonvals_rad) - deallocate(glob_ind) - - ! If analytic ICs are being used, we allow constituents in an initial - ! file to overwrite mixing ratios set by the default constituent initialization - ! except for the water species. - - call pio_seterrorhandling(fh_ini, pio_bcast_error, err_handling) - allocate(var3d(is:ie,js:je,nlev)) - do m_cnst = 1, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - - if (analytic_ic_active() .and. cnst_is_a_water_species(cnst_name(m_cnst))) cycle - - found = .false. - - if(cnst_read_iv(m_cnst)) then - found = dyn_field_exists(fh_ini, trim(cnst_name(m_cnst)), & - required=.false.) - end if - - if(found) then - call read_dyn_var(trim(cnst_name(m_cnst)), fh_ini, 'ncol', var3d) - atm(mytile)%q(is:ie,js:je,1:nlev,m_cnst_ffsl) = var3d(is:ie,js:je,1:nlev) - end if - end do - deallocate(var3d) - ! Put the error handling back the way it was - call pio_seterrorhandling(fh_ini, err_handling) - - ! If a topo file is specified use it. This will overwrite the PHIS set by the - ! analytic IC option. - ! - ! If using the physics grid then the topo file will be on that grid since its - ! contents are primarily for the physics parameterizations, and the values of - ! PHIS should be consistent with the values of sub-grid variability (e.g., SGH) - ! which are computed on the physics grid. - if (associated(fh_topo)) then - - ! We need to be able to see the PIO return values - call pio_seterrorhandling(fh_topo, PIO_BCAST_ERROR, pio_errtype) - - fieldname = 'PHIS' - if (dyn_field_exists(fh_topo, trim(fieldname))) then - call read_dyn_var(trim(fieldname), fh_topo, 'ncol', phis_tmp) - else - call endrun(trim(subname)//': ERROR: Could not find PHIS field on input datafile') - end if - - ! Put the error handling back the way it was - call pio_seterrorhandling(fh_topo, pio_errtype) - end if - - ! Process phis_tmp - atm(mytile)%phis = 0.0_r8 - do j = js, je - do i = is, ie - indx = mylindex(i,j) - atm(mytile)%phis(i,j) = phis_tmp(indx,1) - end do - end do - ! - ! initialize delp (and possibly mixing ratios) from IC fields. - ! - if (inic_wet) then - ! - ! /delp/mix ratios/ps consistent with fv3 airmass (dry+all wet tracers) assuming IC is CAM phys airmass (dry+q only) - ! - allocate(pstmp(isd:ied,jsd:jed)) - pstmp(:,:) = atm(mytile)%ps(:,:) - atm(mytile)%ps(:,:)=hyai(1)*ps0 - num_wet_species=thermodynamic_active_species_num-dry_air_species_num - do k=1,pver - do j = js, je - do i = is, ie - ! this delp is (dry+vap) using the moist ps read in. - Atm(mytile)%delp(i, j, k) = (((hyai(k+1) - hyai(k))*ps0) + & - ((hybi(k+1) - hybi(k))*pstmp(i,j))) - delpdry=Atm(mytile)%delp(i,j,k)*(1.0_r8-Atm(mytile)%q(i,j,k,1)) - do m=1,pcnst - m_ffsl=qsize_tracer_idx_cam2dyn(m) - if (cnst_type(m) == 'wet') then - tracermass(m_ffsl)=Atm(mytile)%delp(i,j,k)*Atm(mytile)%q(i,j,k,m_ffsl) - else - tracermass(m_ffsl)=delpdry*Atm(mytile)%q(i,j,k,m_ffsl) - end if - end do - fv3_totwatermass=sum(tracermass(thermodynamic_active_species_idx_dycore(1:num_wet_species))) - fv3_airmass = delpdry + fv3_totwatermass - Atm(mytile)%delp(i,j,k) = fv3_airmass - Atm(mytile)%q(i,j,k,1:pcnst) = tracermass(1:pcnst)/fv3_airmass - Atm(mytile)%ps(i,j)=Atm(mytile)%ps(i,j)+Atm(mytile)%delp(i, j, k) - end do - end do - end do - deallocate(pstmp) - else - ! - ! Make delp/mix ratios/ps consistent with fv3 airmass (dry+all wet constituents) assuming IC based off dry airmass - ! - allocate(pstmp(isd:ied,jsd:jed)) - pstmp(:,:) = atm(mytile)%ps(:,:) - atm(mytile)%ps(:,:)=hyai(1)*ps0 - num_wet_species=thermodynamic_active_species_num-dry_air_species_num - do k=1,pver - do j = js, je - do i = is, ie - ! this delp is assumed dry. - delpdry = (((hyai(k+1) - hyai(k))*ps0) + & - ((hybi(k+1) - hybi(k))*pstmp(i,j))) - do m=1,pcnst - tracermass(m)=delpdry*Atm(mytile)%q(i,j,k,m) - end do - fv3_totwatermass=sum(tracermass(thermodynamic_active_species_idx_dycore(1:num_wet_species))) - fv3_airmass = delpdry + fv3_totwatermass - Atm(mytile)%delp(i,j,k) = fv3_airmass - Atm(mytile)%q(i,j,k,1:pcnst) = tracermass(1:pcnst)/fv3_airmass - Atm(mytile)%ps(i,j)=Atm(mytile)%ps(i,j)+Atm(mytile)%delp(i, j, k) - ! check new tracermass - do m=1,pcnst - m_ffsl=qsize_tracer_idx_cam2dyn(m) - reldif=(Atm(mytile)%delp(i,j,k)*Atm(mytile)%q(i,j,k,m_ffsl)-tracermass(m_ffsl))/ & - tracermass(m_ffsl) - if (reldif > abs(1.0e-15_r8)) & - write(iulog,*)'mass inconsistency new, old, relative error=',iam,cnst_name(m), & - Atm(mytile)%delp(i,j,k)*Atm(mytile)%q(i,j,k,m_ffsl),tracermass(m_ffsl),reldif - end do - end do - end do - end do - deallocate(pstmp) - end if - - ! - ! scale PS to achieve prescribed dry mass following FV dycore (dryairm.F90) - ! - initial_global_ave_dry_ps = 98288.0_r8 - if (.not. associated(fh_topo)) initial_global_ave_dry_ps = 101325._r8-245._r8 - if ( simple_phys ) initial_global_ave_dry_ps = 0 !do not scale psdry - call set_dry_mass(Atm, initial_global_ave_dry_ps) - - - !$omp parallel do private(i, j) - do j=js,je - do i=is,ie - Atm(mytile)%pe(i,1,j) = Atm(mytile)%ptop - Atm(mytile)%pk(i,j,1) = Atm(mytile)%ptop ** kappa - Atm(mytile)%peln(i,1,j) = log(Atm(mytile)%ptop ) - enddo - enddo - -!$omp parallel do private(i,j,k) - do j=js,je - do k=1,pver - do i=is,ie - Atm(mytile)%pe(i,k+1,j) = Atm(mytile)%pe(i,k,j) + Atm(mytile)%delp(i,j,k) - enddo - enddo - enddo - -!$omp parallel do private(i,j,k) - do j=js,je - do k=1,pver - do i=is,ie - Atm(mytile)%pk(i,j,k+1)= Atm(mytile)%pe(i,k+1,j) ** kappa - Atm(mytile)%peln(i,k+1,j) = log(Atm(mytile)%pe(i,k+1,j)) - Atm(mytile)%pkz(i,j,k) = (Atm(mytile)%pk(i,j,k+1)-Atm(mytile)%pk(i,j,k)) / & - (kappa*(Atm(mytile)%peln(i,k+1,j)-Atm(mytile)%peln(i,k,j))) - enddo - enddo - enddo -!! Initialize non hydrostatic variables if needed - if (.not. Atm(mytile)%flagstruct%hydrostatic) then - do k=1,nlev - do j=js,je - do i=is,ie - Atm(mytile)%w ( i,j,k ) = 0._r8 - Atm(mytile)%delz ( i,j,k ) = -rdgas/gravit*Atm(mytile)%pt( i,j,k ) * & - ( Atm(mytile)%peln( i,k+1,j ) - Atm(mytile)%peln( i,k,j ) ) - enddo - enddo - enddo - end if - - ! once we've read or initialized all the fields we call update_domains to - ! update the halo regions - - call mpp_update_domains( Atm(mytile)%phis, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%ps, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%u,atm(mytile)%v,Atm(mytile)%domain,gridtype=DGRID_NE,complete=.true. ) - call mpp_update_domains( atm(mytile)%pt, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%delp, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%q, Atm(mytile)%domain ) - - ! Cleanup - deallocate(phis_tmp) - -end subroutine read_inidat - -!======================================================================= - - subroutine calc_tot_energy_dynamics(atm,suffix) - use physconst, only: gravit, cpair, rearth,omega - use physconst, only: thermodynamic_active_species_num,thermodynamic_active_species_idx_dycore - use physconst, only: thermodynamic_active_species_cp,thermodynamic_active_species_cv,dry_air_species_num - use cam_history, only: outfld, hist_fld_active - use constituents, only: cnst_get_ind - use dimensions_mod, only: nlev - use fv_mp_mod, only: ng - !------------------------------Arguments-------------------------------- - - type(fv_atmos_type), pointer, intent(in) :: Atm(:) - character(len=*) , intent(in) :: suffix ! suffix for "outfld" names - - !---------------------------Local storage------------------------------- - - real(kind=r8), allocatable, dimension(:,:) :: se, &! Dry Static energy (J/m2) - ke, &! kinetic energy (J/m2) - ps_local ! ps temp based on CAM or FV3 airmass - real(kind=r8), allocatable, dimension(:,:) :: wv,wl,wi,wr,ws,wg ! col integ constiuents(kg/m2) - real(kind=r8), allocatable, dimension(:,:) :: tt ! column integrated test tracer (kg/m2) - real(kind=r8), allocatable, dimension(:,:,:) :: dp,delpograv - real(kind=r8) :: se_tmp, dpdry - real(kind=r8) :: ke_tmp - real(kind=r8) :: wv_tmp,wl_tmp,wi_tmp,wr_tmp,ws_tmp,wg_tmp - real(kind=r8) :: tt_tmp - - ! - ! global axial angular momentum (AAM) can be separated into one part (mr) - ! associated with the relative motion of the atmosphere with respect to the planet surface - ! (also known as wind AAM) and another part (mo) associated with the angular velocity OMEGA - ! (2*pi/d, where d is the length of the day) of the planet (also known as mass AAM) - ! - real(kind=r8), allocatable, dimension(:,:) :: mr ! wind AAM - real(kind=r8), allocatable, dimension(:,:) :: mo ! mass AAM - real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp - - real(kind=r8) :: se_glob, ke_glob, wv_glob, wl_glob, wi_glob, & - wr_glob, ws_glob, wg_glob, tt_glob, mr_glob, mo_glob - - integer :: i,j,k,nq,idim,m_cnst_ffsl - integer :: ixcldice, ixcldliq, ixtt,ixcldliq_ffsl,ixcldice_ffsl ! CLDICE, CLDLIQ and test tracer indices - integer :: ixrain, ixsnow, ixgraupel,ixrain_ffsl, ixsnow_ffsl, ixgraupel_ffsl - character(len=16) :: se_name,ke_name,wv_name,wl_name, & - wi_name,wr_name,ws_name,wg_name,tt_name,mo_name,mr_name - - integer :: is,ie,js,je,isd,ied,jsd,jed - logical :: printglobals = .false. - !----------------------------------------------------------------------- - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - isd = Atm(mytile)%bd%isd - ied = Atm(mytile)%bd%ied - jsd = Atm(mytile)%bd%jsd - jed = Atm(mytile)%bd%jed - - se_glob = 0._r8 - ke_glob = 0._r8 - wv_glob = 0._r8 - wl_glob = 0._r8 - wi_glob = 0._r8 - wr_glob = 0._r8 - ws_glob = 0._r8 - wg_glob = 0._r8 - tt_glob = 0._r8 - mr_glob = 0._r8 - mo_glob = 0._r8 - - allocate(se(is:ie,js:je)) - allocate(ke(is:ie,js:je)) - allocate(wv(is:ie,js:je)) - allocate(wl(is:ie,js:je)) - allocate(wi(is:ie,js:je)) - allocate(wr(is:ie,js:je)) - allocate(ws(is:ie,js:je)) - allocate(wg(is:ie,js:je)) - allocate(tt(is:ie,js:je)) - allocate(mr(is:ie,js:je)) - allocate(mo(is:ie,js:je)) - allocate(dp(is:ie,js:je,nlev)) - allocate(delpograv(is:ie,js:je,nlev)) - allocate(ps_local(is:ie,js:je)) - - se_name = 'SE_' //trim(suffix) - ke_name = 'KE_' //trim(suffix) - wv_name = 'WV_' //trim(suffix) - wl_name = 'WL_' //trim(suffix) - wi_name = 'WI_' //trim(suffix) - wr_name = 'WR_' //trim(suffix) - ws_name = 'WS_' //trim(suffix) - wg_name = 'WG_' //trim(suffix) - tt_name = 'TT_' //trim(suffix) - - - if ( hist_fld_active(se_name).or.hist_fld_active(ke_name).or. & - hist_fld_active(wv_name).or.hist_fld_active(wl_name).or. & - hist_fld_active(wi_name).or.hist_fld_active(wr_name).or. & - hist_fld_active(ws_name).or.hist_fld_active(wg_name).or. & - hist_fld_active(tt_name)) then - if (thermodynamic_active_species_num-dry_air_species_num > 1) then - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - call cnst_get_ind('RAINQM', ixrain, abort=.false.) - call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) - call cnst_get_ind('GRAUQM', ixgraupel, abort=.false.) - else - ixcldliq = -1 - ixcldice = -1 - ixrain = -1 - ixsnow = -1 - ixgraupel = -1 - end if - - call cnst_get_ind('TT_LW', ixtt, abort=.false.) - - ! - ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid - ! - - se = 0.0_r8 - ke = 0.0_r8 - wv = 0.0_r8 - wl = 0.0_r8 - wi = 0.0_r8 - wr = 0.0_r8 - ws = 0.0_r8 - wg = 0.0_r8 - tt = 0.0_r8 - - delpograv(is:ie,js:je,1:nlev) = Atm(mytile)%delp(is:ie,js:je,1:nlev)/gravit ! temporary - - ! - ! Calculate Energy, CAM or FV3 based on fv3_lcp_moist and fv3_lcv_moist - ! - - - do k = 1, nlev - do j=js,je - do i = is, ie - ! initialize dp with delp - dp(i,j,k) = Atm(mytile)%delp(i,j,k) - ! - ! if neither fv3_lcp_moist and fv3_lcv_moist is set then - ! use cam definition of internal energy - ! adjust dp to be consistent with CAM physics air mass (only water vapor and dry air in pressure) - if ((.not.fv3_lcp_moist).and.(.not.fv3_lcv_moist)) then - if (thermodynamic_active_species_num-dry_air_species_num > 1) then - ! adjust dp to include just dry + vap to use below - do nq=2,thermodynamic_active_species_num-dry_air_species_num - m_cnst_ffsl=thermodynamic_active_species_idx_dycore(nq) - dp(i,j,k) = dp(i,j,k) - & - Atm(mytile)%delp(i,j,k)*Atm(mytile)%q(i,j,k,m_cnst_ffsl) - end do - end if - se_tmp = cpair*Atm(mytile)%pt(i,j,k)*dp(i,j,k)/gravit - else - ! if either fv3_lcp_moist or fv3_lcv_moist is set then - ! use all condensates in calculation of energy and dp - ! Start with energy of dry air and add energy of condensates - dpdry = Atm(mytile)%delp(i,j,k) - do nq=1,thermodynamic_active_species_num-dry_air_species_num - m_cnst_ffsl=thermodynamic_active_species_idx_dycore(nq) - dpdry = dpdry - Atm(mytile)%delp(i,j,k)*Atm(mytile)%q(i,j,k,nq) - end do - se_tmp = cpair*dpdry - do nq=1,thermodynamic_active_species_num-dry_air_species_num - m_cnst_ffsl=thermodynamic_active_species_idx_dycore(nq) - if (fv3_lcp_moist) then - se_tmp = se_tmp + & - thermodynamic_active_species_cp(nq)*Atm(mytile)%q(i,j,k,m_cnst_ffsl) * & - Atm(mytile)%delp(i,j,k) - end if - if (fv3_lcv_moist) then - se_tmp = se_tmp + & - thermodynamic_active_species_cv(nq)*Atm(mytile)%q(i,j,k,m_cnst_ffsl) * & - Atm(mytile)%delp(i,j,k) - end if - end do - se_tmp = se_tmp*Atm(mytile)%pt(i,j,k)/gravit - end if - ke_tmp = 0.5_r8*(Atm(mytile)%va(i,j,k)**2+ Atm(mytile)%ua(i,j,k)**2)*dp(i,j,k)/gravit - wv_tmp = Atm(mytile)%q(i,j,k,1)*delpograv(i,j,k) - - se(i,j) = se(i,j) + se_tmp - ke(i,j) = ke(i,j) + ke_tmp - wv(i,j) = wv(i,j) + wv_tmp - end do - end do - end do - - do j=js,je - do i = is,ie - ps_local(i,j) = Atm(mytile)%ptop+sum(dp(i,j,:)) - end do - end do - - do j=js,je - do i = is,ie - se(i,j) = se(i,j) + Atm(mytile)%phis(i,j)*ps_local(i,j)/gravit - end do - end do - - ! Don't require cloud liq/ice to be present. Allows for adiabatic/ideal phys. - - if (ixcldliq > 1) then - ixcldliq_ffsl = qsize_tracer_idx_cam2dyn(ixcldliq) - do k = 1, nlev - do j = js, je - do i = is, ie - wl_tmp = Atm(mytile)%q(i,j,k,ixcldliq_ffsl)*delpograv(i,j,k) - wl (i,j) = wl(i,j) + wl_tmp - end do - end do - end do - end if - - if (ixcldice > 1) then - ixcldice_ffsl = qsize_tracer_idx_cam2dyn(ixcldice) - do k = 1, nlev - do j = js, je - do i = is, ie - wi_tmp = Atm(mytile)%q(i,j,k,ixcldice_ffsl)*delpograv(i,j,k) - wi(i,j) = wi(i,j) + wi_tmp - end do - end do - end do - end if - - if (ixrain > 1) then - ixrain_ffsl = qsize_tracer_idx_cam2dyn(ixrain) - do k = 1, nlev - do j = js, je - do i = is, ie - wr_tmp = Atm(mytile)%q(i,j,k,ixrain_ffsl)*delpograv(i,j,k) - wr (i,j) = wr(i,j) + wr_tmp - end do - end do - end do - end if - - if (ixsnow > 1) then - ixsnow_ffsl = qsize_tracer_idx_cam2dyn(ixsnow) - do k = 1, nlev - do j = js, je - do i = is, ie - ws_tmp = Atm(mytile)%q(i,j,k,ixsnow_ffsl)*delpograv(i,j,k) - ws(i,j) = ws(i,j) + ws_tmp - end do - end do - end do - end if - - if (ixgraupel > 1) then - ixgraupel_ffsl = qsize_tracer_idx_cam2dyn(ixgraupel) - do k = 1, nlev - do j = js, je - do i = is, ie - wg_tmp = Atm(mytile)%q(i,j,k,ixgraupel_ffsl)*delpograv(i,j,k) - wg(i,j) = wg(i,j) + wg_tmp - end do - end do - end do - end if - - - if (ixtt > 1) then - do k = 1, nlev - do j = js, je - do i = is, ie - tt_tmp = Atm(mytile)%q(i,j,k,ixtt)*delpograv(i,j,k) - tt (i,j) = tt(i,j) + tt_tmp - end do - end do - end do - end if - idim=ie-is+1 - do j=js,je - ! Output energy diagnostics - call outfld(se_name ,se(:,j) ,idim, j) - call outfld(ke_name ,ke(:,j) ,idim, j) - call outfld(wv_name ,wv(:,j) ,idim, j) - call outfld(wl_name ,wl(:,j) ,idim, j) - call outfld(wi_name ,wi(:,j) ,idim, j) - call outfld(wr_name ,wr(:,j) ,idim, j) - call outfld(ws_name ,ws(:,j) ,idim, j) - call outfld(wg_name ,wg(:,j) ,idim, j) - if (ixtt > 1) call outfld(tt_name ,tt(:,j) ,idim, j) - end do - - if (printglobals) then - se_glob=g_sum(Atm(mytile)%domain, se(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - ke_glob=g_sum(Atm(mytile)%domain, ke(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - wv_glob=g_sum(Atm(mytile)%domain, wv(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - wl_glob=g_sum(Atm(mytile)%domain, wl(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - wi_glob=g_sum(Atm(mytile)%domain, wi(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - wr_glob=g_sum(Atm(mytile)%domain, wr(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - ws_glob=g_sum(Atm(mytile)%domain, ws(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - wg_glob=g_sum(Atm(mytile)%domain, wg(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - if (ixtt > 1) & - tt_glob=g_sum(Atm(mytile)%domain, tt(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - if (masterproc) then - - write(iulog, '(a,e25.17)') 'static energy se_'//trim(suffix)//') = ',se_glob - write(iulog, '(a,e25.17)') 'kinetic energy ke_'//trim(suffix)//') = ',ke_glob - write(iulog, '(a,e25.17)') 'total energy se_plus_ke_'//trim(suffix)//') = ',(ke_glob+se_glob) - write(iulog, '(a,e25.17)') 'integrated vapor wv_'//trim(suffix)//' = ',wv_glob - write(iulog, '(a,e25.17)') 'integrated liquid wl_'//trim(suffix)//' = ',wl_glob - write(iulog, '(a,e25.17)') 'integrated ice wi_'//trim(suffix)//' = ',wi_glob - write(iulog, '(a,e25.17)') 'integrated liquid rain wr_'//trim(suffix)//' = ',wr_glob - write(iulog, '(a,e25.17)') 'integrated liquid snow ws_'//trim(suffix)//' = ',ws_glob - write(iulog, '(a,e25.17)') 'integrated graupel wg_'//trim(suffix)//' = ',wg_glob - if (ixtt > 1) write(iulog, '(a,e25.17)') & - 'global column integrated test tracer tt_'//trim(suffix)//' = ',tt_glob - end if - end if - end if - - ! - ! Axial angular momentum diagnostics - ! - ! Code follows - ! - ! Lauritzen et al., (2014): Held-Suarez simulations with the Community Atmosphere Model - ! Spectral Element (CAM-SE) dynamical core: A global axial angularmomentum analysis using Eulerian - ! and floating Lagrangian vertical coordinates. J. Adv. Model. Earth Syst. 6,129-140, - ! doi:10.1002/2013MS000268 - ! - ! MR is equation (6) without \Delta A and sum over areas (areas are in units of radians**2) - ! MO is equation (7) without \Delta A and sum over areas (areas are in units of radians**2) - ! - mr_name = 'MR_' //trim(suffix) - mo_name = 'MO_' //trim(suffix) - - if ( hist_fld_active(mr_name).or.hist_fld_active(mo_name)) then - - - - mr_cnst = rearth**3/gravit - mo_cnst = omega*rearth**4/gravit - mr = 0.0_r8 - mo = 0.0_r8 - do k = 1, nlev - do j=js,je - do i = is,ie - cos_lat = cos(Atm(mytile)%gridstruct%agrid_64(i,j,2)) - mr_tmp = mr_cnst*Atm(mytile)%ua(i,j,k)*Atm(mytile)%delp(i,j,k)*cos_lat - mo_tmp = mo_cnst*Atm(mytile)%delp(i,j,k)*cos_lat**2 - - mr (i,j) = mr(i,j) + mr_tmp - mo (i,j) = mo(i,j) + mo_tmp - end do - end do - end do - do j=js,je - call outfld(mr_name ,mr(is:ie,j) ,idim,j) - call outfld(mo_name ,mo(is:ie,j) ,idim,j) - end do - - if (printglobals) then - mr_glob=g_sum(Atm(mytile)%domain, mr(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - mo_glob=g_sum(Atm(mytile)%domain, mo(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - if (masterproc) then - write(iulog, '(a,e25.17)') 'integrated wind AAM '//trim(mr_name)//' = ',mr_glob - write(iulog, '(a,e25.17)') 'integrated mass AAM '//trim(mo_name)//' = ',mo_glob - end if - end if - end if - - deallocate(ps_local) - deallocate(dp) - deallocate(delpograv) - deallocate(se) - deallocate(ke) - deallocate(wv) - deallocate(wl) - deallocate(wi) - deallocate(wr) - deallocate(ws) - deallocate(wg) - deallocate(tt) - deallocate(mr) - deallocate(mo) - end subroutine calc_tot_energy_dynamics - -!======================================================================================== - -logical function dyn_field_exists(fh, fieldname, required) - - use pio, only: file_desc_t, var_desc_t, PIO_inq_varid - use pio, only: PIO_NOERR - - ! Arguments - type(file_desc_t), intent(in) :: fh - character(len=*), intent(in) :: fieldname - logical, optional, intent(in) :: required - - ! Local variables - logical :: found - logical :: field_required - integer :: ret - type(var_desc_t) :: varid - character(len=128) :: errormsg - !-------------------------------------------------------------------------- - - if (present(required)) then - field_required = required - else - field_required = .true. - end if - - ret = PIO_inq_varid(fh, trim(fieldname), varid) - found = (ret == PIO_NOERR) - if (.not. found) then - if (field_required) then - write(errormsg, *) trim(fieldname),' was not present in the input file.' - call endrun('DYN_FIELD_EXISTS: '//errormsg) - end if - end if - - dyn_field_exists = found - -end function dyn_field_exists - -!======================================================================================== - - subroutine read_dyn_field_2d(fieldname, fh, dimname, buffer) - use pio, only: file_desc_t - use ncdio_atm, only: infld - - ! Dummy arguments - character(len=*), intent(in) :: fieldname - type(file_desc_t), intent(inout) :: fh - character(len=*), intent(in) :: dimname - real(r8), intent(inout) :: buffer(:, :) - - ! Local variables - logical :: found - !-------------------------------------------------------------------------- - - buffer = 0.0_r8 - call infld(trim(fieldname), fh, dimname, 1, ldof_size, 1, 1, buffer, & - found, gridname=ini_grid_name) - if(.not. found) then - call endrun('READ_DYN_FIELD_2D: Could not find '//trim(fieldname)//' field on input datafile') - end if - - ! This code allows use of compiler option to set uninitialized values - ! to NaN. In that case infld can return NaNs where the element ini_grid_name points - ! are not "unique columns" - where (isnan(buffer)) buffer = 0.0_r8 - - end subroutine read_dyn_field_2d - -!======================================================================================== - - subroutine read_dyn_field_3d(fieldname, fh, dimname, buffer) - use pio, only: file_desc_t - use ncdio_atm, only: infld - - ! Dummy arguments - character(len=*), intent(in) :: fieldname - type(file_desc_t), intent(inout) :: fh - character(len=*), intent(in) :: dimname - real(r8), intent(inout) :: buffer(:,:,:) - - ! Local variables - logical :: found - !-------------------------------------------------------------------------- - - buffer = 0.0_r8 - call infld(fieldname, fh,dimname, 'lev', 1, ldof_size, 1, pver, & - 1, 1, buffer, found, gridname=ini_grid_name) - if(.not. found) then - call endrun('READ_DYN_FIELD_3D: Could not find '//trim(fieldname)//' field on input datafile') - end if - - ! This code allows use of compiler option to set uninitialized values - ! to NaN. In that case infld can return NaNs where the element ini_grid_name points - ! are not "unique columns" - where (isnan(buffer)) buffer = 0.0_r8 - - end subroutine read_dyn_field_3d - -!========================================================================================= - -subroutine write_dyn_var(field,outfld_name,bd) - - use cam_history, only: outfld - - ! Arguments - type(fv_grid_bounds_type), intent(in) :: bd - real(r8), intent(in) :: field(bd%is:bd%ie,bd%js:bd%je) - character(len=*) , intent(in) :: outfld_name ! suffix for "outfld" names - - ! local variables - integer :: idim, j - - !---------------------------------------------------------------------------- - idim=bd%ie-bd%is+1 - do j=bd%js,bd%je - ! Output energy diagnostics - call outfld(trim(outfld_name) ,field(bd%is:bd%ie,j) ,idim, j) - end do - -end subroutine write_dyn_var - -!========================================================================================= - -subroutine set_dry_mass(atm,fixed_global_ave_dry_ps) - - !---------------------------------------------------------------------------- - - use constituents, only: pcnst, qmin - use cam_logfile, only: iulog - use hycoef, only: hyai, hybi, ps0 - use dimensions_mod, only: nlev - use dyn_grid, only: mytile - use physconst, only: thermodynamic_active_species_num,thermodynamic_active_species_idx_dycore,dry_air_species_num - - ! Arguments - type (fv_atmos_type), intent(in), pointer :: Atm(:) - real (kind=r8), intent(in) :: fixed_global_ave_dry_ps - - ! local - real (kind=r8) :: global_ave_ps_inic,global_ave_dryps_inic,global_ave_dryps_scaled, & - global_ave_ps_new,global_ave_dryps_new - real (r8), allocatable, dimension(:,:) :: psdry, psdry_scaled, psdry_new - real (r8), allocatable, dimension(:,:,:) :: factor, delpwet, delpdry, newdelp - integer :: i, j ,k, m,is,ie,js,je - integer :: num_wet_species ! first tracers in FV3 tracer array - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - allocate(factor(is:ie,js:je,nlev)) - allocate(delpdry(is:ie,js:je,nlev)) - allocate(delpwet(is:ie,js:je,nlev)) - allocate(newdelp(is:ie,js:je,nlev)) - allocate(psdry(is:ie,js:je)) - allocate(psdry_scaled(is:ie,js:je)) - allocate(psdry_new(is:ie,js:je)) - - - if (fixed_global_ave_dry_ps == 0) return; - - ! get_global_ave_surface_pressure - must use bitwise sum (reproducable) - global_ave_ps_inic=g_sum(Atm(mytile)%domain, Atm(mytile)%ps(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - - num_wet_species=thermodynamic_active_species_num-dry_air_species_num - do k=1,pver - do j = js, je - do i = is, ie - delpdry(i,j,k)=Atm(mytile)%delp(i,j,k) * (1.0_r8 - & - sum(Atm(mytile)%q(i,j,k,thermodynamic_active_species_idx_dycore(1:num_wet_species)))) - delpwet(i,j,k)=Atm(mytile)%delp(i,j,k)-delpdry(i,j,k) - end do - end do - end do - ! - ! get psdry and scale it - ! - do j = js, je - do i = is, ie - psdry(i,j) = hyai(1)*ps0 + sum(delpdry(i,j,:)) - end do - end do - - global_ave_dryps_inic=g_sum(Atm(mytile)%domain, psdry(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - - psdry_scaled = psdry*(fixed_global_ave_dry_ps/global_ave_dryps_inic) - - global_ave_dryps_scaled=g_sum(Atm(mytile)%domain, psdry_scaled(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - - !use adjusted psdry to calculate new dp_dry throughout atmosphere - do k=1,pver - do j = js, je - do i = is, ie - delpdry(i,j,k)=(hyai(k+1)-hyai(k))*ps0+& - (hybi(k+1)-hybi(k))*psdry_scaled(i,j) - ! new dp is adjusted dp + total watermass - newdelp(i,j,k)=(delpdry(i,j,k)+delpwet(i,j,k)) - ! factor to conserve mass once using the new dp - factor(i,j,k)=Atm(mytile)%delp(i,j,k)/newdelp(i,j,k) - Atm(mytile)%delp(i,j,k)=newdelp(i,j,k) - end do - end do - end do - ! - ! all tracers wet in fv3 so conserve initial condition mass of 'wet' tracers (following se prim_set_dry) - ! - do m=1,pcnst - do k=1,pver - do j = js, je - do i = is, ie - Atm(mytile)%q(i,j,k,m)=Atm(mytile)%q(i,j,k,m)*factor(i,j,k) - Atm(mytile)%q(i,j,k,m)=max(qmin(m),Atm(mytile)%q(i,j,k,m)) - end do - end do - end do - end do - - do j = js, je - do i = is, ie - Atm(mytile)%ps(i,j)=hyai(1)*ps0+sum(Atm(mytile)%delp(i, j, :)) - psdry_new(i,j)=hyai(1)*ps0+sum(delpdry(i, j, :)) - end do - end do - global_ave_ps_new= g_sum(Atm(mytile)%domain, Atm(mytile)%ps(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - global_ave_dryps_new=g_sum(Atm(mytile)%domain, psdry_new(is:ie,js:je), is, ie, js, je, & - Atm(mytile)%ng, Atm(mytile)%gridstruct%area_64, 1, .true.) - - if (masterproc) then - write (iulog,*) "-------------------------- set_dry_mass---------------------------------------------" - write (iulog,*) "Scaling dry surface pressure to global average of = ",& - fixed_global_ave_dry_ps/100.0_r8,"hPa" - write (iulog,*) "Average surface pressure in initial condition = ", & - global_ave_ps_inic/100.0_r8,"hPa" - write (iulog,*) "Average dry surface pressure in initial condition = ",& - global_ave_dryps_inic/100.0_r8,"hPa" - write (iulog,*) "Average surface pressure after scaling = ",global_ave_ps_new/100.0_r8,"hPa" - write (iulog,*) "Average dry surface pressure after scaling = ",global_ave_dryps_new/100.0_r8,"hPa" - write (iulog,*) "Change in surface pressure = ",& - global_ave_ps_new-global_ave_ps_inic,"Pa" - write (iulog,*) "Change in dry surface pressure = ",& - global_ave_dryps_new-global_ave_dryps_inic,"Pa" - write (iulog,*) "Mixing ratios have been scaled so that total mass of tracer is conserved" - write (iulog,*) "Total precipitable water before scaling = ", & - (global_ave_ps_inic-global_ave_dryps_inic)/gravit, '(kg/m**2)' - write (iulog,*) "Total precipitable water after scaling = ", & - (global_ave_ps_new-global_ave_dryps_new)/gravit, '(kg/m**2)' - endif - - deallocate(factor) - deallocate(delpdry) - deallocate(delpwet) - deallocate(newdelp) - deallocate(psdry) - deallocate(psdry_scaled) - deallocate(psdry_new) - -end subroutine set_dry_mass -!========================================================================================= - -subroutine a2d3djt(ua, va, u, v, is, ie, js, je, isd, ied, jsd, jed, npx,npy, nlev, gridstruct, domain) - -! This routine interpolates cell centered a-grid winds to d-grid (cell edges) - - use mpp_domains_mod, only: mpp_update_domains, DGRID_NE - use fv_arrays_mod, only: fv_grid_type - - ! arguments - integer, intent(in) :: is, ie, js, je - integer, intent(in) :: isd, ied, jsd, jed - integer, intent(in) :: npx,npy, nlev - real(r8), intent(inout), dimension(isd:ied, jsd:jed+1,nlev) :: u - real(r8), intent(inout), dimension(isd:ied+1,jsd:jed ,nlev) :: v - real(r8), intent(inout), dimension(isd:ied,jsd:jed,nlev) :: ua, va - type(fv_grid_type), intent(in), target :: gridstruct - type(domain2d), intent(inout) :: domain - - ! local: - real(r8), dimension(is-1:ie+1,js-1:je+1,3) :: v3 - real(r8), dimension(is-1:ie+1,js:je+1,3) :: ue ! 3D winds at edges - real(r8), dimension(is:ie+1,js-1:je+1, 3) :: ve ! 3D winds at edges - real(r8), dimension(is:ie) :: ut1, ut2, ut3 - real(r8), dimension(js:je) :: vt1, vt2, vt3 - integer :: i, j, k, im2, jm2 - - real(r8), pointer, dimension(:,:,:) :: vlon, vlat - real(r8), pointer, dimension(:,:,:,:) :: es, ew - real(r8), pointer, dimension(:) :: edge_vect_w, edge_vect_e, edge_vect_s, edge_vect_n - - es => gridstruct%es - ew => gridstruct%ew - vlon => gridstruct%vlon - vlat => gridstruct%vlat - - edge_vect_w => gridstruct%edge_vect_w - edge_vect_e => gridstruct%edge_vect_e - edge_vect_s => gridstruct%edge_vect_s - edge_vect_n => gridstruct%edge_vect_n - - call mpp_update_domains(ua, domain, complete=.false.) - call mpp_update_domains(va, domain, complete=.true.) - - im2 = (npx-1)/2 - jm2 = (npy-1)/2 - -!$OMP parallel do default(none) shared(is,ie,js,je,nlev,gridstruct,u,ua,v,va, & -!$OMP vlon,vlat,jm2,edge_vect_w,npx,edge_vect_e,im2, & -!$OMP edge_vect_s,npy,edge_vect_n,es,ew) & -!$OMP private(i,j,k,ut1, ut2, ut3, vt1, vt2, vt3, ue, ve, v3) - do k=1, nlev - - ! Compute 3D wind/tendency on A grid - do j=js-1,je+1 - do i=is-1,ie+1 - v3(i,j,1) = ua(i,j,k)*vlon(i,j,1) + va(i,j,k)*vlat(i,j,1) - v3(i,j,2) = ua(i,j,k)*vlon(i,j,2) + va(i,j,k)*vlat(i,j,2) - v3(i,j,3) = ua(i,j,k)*vlon(i,j,3) + va(i,j,k)*vlat(i,j,3) - enddo - enddo - - ! Interpolate to cell edges - do j=js,je+1 - do i=is-1,ie+1 - ue(i,j,1) = 0.5_r8*(v3(i,j-1,1) + v3(i,j,1)) - ue(i,j,2) = 0.5_r8*(v3(i,j-1,2) + v3(i,j,2)) - ue(i,j,3) = 0.5_r8*(v3(i,j-1,3) + v3(i,j,3)) - enddo - enddo - - do j=js-1,je+1 - do i=is,ie+1 - ve(i,j,1) = 0.5_r8*(v3(i-1,j,1) + v3(i,j,1)) - ve(i,j,2) = 0.5_r8*(v3(i-1,j,2) + v3(i,j,2)) - ve(i,j,3) = 0.5_r8*(v3(i-1,j,3) + v3(i,j,3)) - enddo - enddo - - ! --- E_W edges (for v-wind): - if (.not. gridstruct%nested) then - if ( is==1) then - i = 1 - do j=js,je - if ( j>jm2 ) then - vt1(j) = edge_vect_w(j)*ve(i,j-1,1)+(1._r8-edge_vect_w(j))*ve(i,j,1) - vt2(j) = edge_vect_w(j)*ve(i,j-1,2)+(1._r8-edge_vect_w(j))*ve(i,j,2) - vt3(j) = edge_vect_w(j)*ve(i,j-1,3)+(1._r8-edge_vect_w(j))*ve(i,j,3) - else - vt1(j) = edge_vect_w(j)*ve(i,j+1,1)+(1._r8-edge_vect_w(j))*ve(i,j,1) - vt2(j) = edge_vect_w(j)*ve(i,j+1,2)+(1._r8-edge_vect_w(j))*ve(i,j,2) - vt3(j) = edge_vect_w(j)*ve(i,j+1,3)+(1._r8-edge_vect_w(j))*ve(i,j,3) - endif - enddo - do j=js,je - ve(i,j,1) = vt1(j) - ve(i,j,2) = vt2(j) - ve(i,j,3) = vt3(j) - enddo - endif - - if ( (ie+1)==npx ) then - i = npx - do j=js,je - if ( j>jm2 ) then - vt1(j) = edge_vect_e(j)*ve(i,j-1,1)+(1._r8-edge_vect_e(j))*ve(i,j,1) - vt2(j) = edge_vect_e(j)*ve(i,j-1,2)+(1._r8-edge_vect_e(j))*ve(i,j,2) - vt3(j) = edge_vect_e(j)*ve(i,j-1,3)+(1._r8-edge_vect_e(j))*ve(i,j,3) - else - vt1(j) = edge_vect_e(j)*ve(i,j+1,1)+(1._r8-edge_vect_e(j))*ve(i,j,1) - vt2(j) = edge_vect_e(j)*ve(i,j+1,2)+(1._r8-edge_vect_e(j))*ve(i,j,2) - vt3(j) = edge_vect_e(j)*ve(i,j+1,3)+(1._r8-edge_vect_e(j))*ve(i,j,3) - endif - enddo - do j=js,je - ve(i,j,1) = vt1(j) - ve(i,j,2) = vt2(j) - ve(i,j,3) = vt3(j) - enddo - endif - ! N-S edges (for u-wind): - if ( js==1) then - j = 1 - do i=is,ie - if ( i>im2 ) then - ut1(i) = edge_vect_s(i)*ue(i-1,j,1)+(1._r8-edge_vect_s(i))*ue(i,j,1) - ut2(i) = edge_vect_s(i)*ue(i-1,j,2)+(1._r8-edge_vect_s(i))*ue(i,j,2) - ut3(i) = edge_vect_s(i)*ue(i-1,j,3)+(1._r8-edge_vect_s(i))*ue(i,j,3) - else - ut1(i) = edge_vect_s(i)*ue(i+1,j,1)+(1._r8-edge_vect_s(i))*ue(i,j,1) - ut2(i) = edge_vect_s(i)*ue(i+1,j,2)+(1._r8-edge_vect_s(i))*ue(i,j,2) - ut3(i) = edge_vect_s(i)*ue(i+1,j,3)+(1._r8-edge_vect_s(i))*ue(i,j,3) - endif - enddo - do i=is,ie - ue(i,j,1) = ut1(i) - ue(i,j,2) = ut2(i) - ue(i,j,3) = ut3(i) - enddo - endif - if ( (je+1)==npy ) then - j = npy - do i=is,ie - if ( i>im2 ) then - ut1(i) = edge_vect_n(i)*ue(i-1,j,1)+(1._r8-edge_vect_n(i))*ue(i,j,1) - ut2(i) = edge_vect_n(i)*ue(i-1,j,2)+(1._r8-edge_vect_n(i))*ue(i,j,2) - ut3(i) = edge_vect_n(i)*ue(i-1,j,3)+(1._r8-edge_vect_n(i))*ue(i,j,3) - else - ut1(i) = edge_vect_n(i)*ue(i+1,j,1)+(1._r8-edge_vect_n(i))*ue(i,j,1) - ut2(i) = edge_vect_n(i)*ue(i+1,j,2)+(1._r8-edge_vect_n(i))*ue(i,j,2) - ut3(i) = edge_vect_n(i)*ue(i+1,j,3)+(1._r8-edge_vect_n(i))*ue(i,j,3) - endif - enddo - do i=is,ie - ue(i,j,1) = ut1(i) - ue(i,j,2) = ut2(i) - ue(i,j,3) = ut3(i) - enddo - endif - - endif ! .not. nested - - do j=js,je+1 - do i=is,ie - u(i,j,k) = ue(i,j,1)*es(1,i,j,1) + & - ue(i,j,2)*es(2,i,j,1) + & - ue(i,j,3)*es(3,i,j,1) - enddo - enddo - do j=js,je - do i=is,ie+1 - v(i,j,k) = ve(i,j,1)*ew(1,i,j,2) + & - ve(i,j,2)*ew(2,i,j,2) + & - ve(i,j,3)*ew(3,i,j,2) - enddo - enddo - enddo ! k-loop - - call mpp_update_domains(u, v, domain, gridtype=DGRID_NE) - -end subroutine a2d3djt - -end module dyn_comp diff --git a/src/dynamics/fv3/dyn_grid.F90 b/src/dynamics/fv3/dyn_grid.F90 deleted file mode 100644 index 263c04ac3b..0000000000 --- a/src/dynamics/fv3/dyn_grid.F90 +++ /dev/null @@ -1,1108 +0,0 @@ -module dyn_grid -!------------------------------------------------------------------------------- -! Define FV3 computational grids on the dynamics decomposition. -! -! The grid used by the FV3 dynamics is called the FSSL grid and is a -! gnomonic cubed sphere consisting of 6 tiled faces. Each tile consists -! of an array of cells whose coordinates are great circles. The grid -! nomenclature (C96, C384, etc.) describes the number of cells along -! the top and side of a tile face (square). All prognostic variables -! are 3-D cell-mean values (cell center), except for the horizontal winds, -! which are 2-D face-mean values located on the cell walls (D-Grid winds). -! Each tile can be decomposed into a number of subdomains (consisting of -! one or more cells) which correspond to "blocks" in the physics/dynamics -! coupler terminology. The namelist variable "layout" consists of 2 integers -! and determines the size/shape of the blocks by dividing the tile into a -! number of horizonal and vertical sections. The total number of blocks in -! the global domain is therefore layout(1)*layout(2)*ntiles. The decomposition -! and communication infrastructure is provided by the GFDL FMS library. -! -! Module responsibilities: -! -! . Provide the physics/dynamics coupler (in module phys_grid) with data for the -! physics grid on the dynamics decomposition. -! -! . Create CAM grid objects that are used by the I/O functionality to read -! data from an unstructured grid format to the dynamics data structures, and -! to write from the dynamics data structures to unstructured grid format. The -! global column ordering for the unstructured grid is determined by the FV3 dycore. -! -!------------------------------------------------------------------------------- - - use cam_abortutils, only: endrun - use cam_grid_support, only: iMap - use cam_logfile, only: iulog - use dimensions_mod, only: npx, npy, ntiles - use fms_mod, only: fms_init, write_version_number - use fv_arrays_mod, only: fv_atmos_type - use fv_control_mod, only: ngrids,fv_init - use fv_mp_mod, only: mp_bcst - use mpp_mod, only: mpp_pe, mpp_root_pe - use physconst, only: rearth,pi - use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: mpicom, masterproc - - implicit none - private - save - - ! The FV3 dynamics grids and initial file ncol grid - integer, parameter :: dyn_decomp = 101 - integer, parameter :: dyn_decomp_ew = 102 - integer, parameter :: dyn_decomp_ns = 103 - integer, parameter :: dyn_decomp_hist = 104 - integer, parameter :: dyn_decomp_hist_ew = 105 - integer, parameter :: dyn_decomp_hist_ns = 106 - integer, parameter :: ini_decomp = 107 - - character(len=3), protected :: ini_grid_name = 'INI' - - integer, parameter :: ptimelevels = 2 ! number of time levels in the dycore - - integer :: mytile = 1 - integer :: p_split = 1 - integer, allocatable :: pelist(:) - - real(r8), parameter :: rad2deg = 180._r8/pi - - logical, allocatable :: grids_on_this_pe(:) - type(fv_atmos_type), allocatable, target :: Atm(:) - - -public :: & - dyn_decomp, & - ini_grid_name, & - p_split, & - grids_on_this_pe, & - ptimelevels - -!----------------------------------------------------------------------- -! Calculate Global Index - -integer, allocatable, target, dimension(:,:) :: mygindex -integer, allocatable, target, dimension(:,:) :: mylindex -integer, allocatable, target, dimension(:,:) :: myblkidx -real(r8), allocatable, target, dimension(:,:,:) :: locidx_g -real(r8), allocatable, target, dimension(:,:,:) :: blkidx_g -real(r8), allocatable, target, dimension(:,:,:) :: gindex_g - -real(r8), allocatable :: block_extents_g(:,:) - -integer :: uniqpts_glob = 0 ! number of dynamics columns -integer :: uniqpts_glob_ew = 0 ! number of dynamics columns for D grid ew -integer :: uniqpts_glob_ns = 0 ! number of dynamics columns for D grid ns - -real(r8), pointer, dimension(:,:,:) :: grid_ew, grid_ns - -public :: mygindex -public :: mylindex -!----------------------------------------------------------------------- -public :: & - dyn_grid_init, & - get_block_bounds_d, & ! get first and last indices in global block ordering - get_block_gcol_d, & ! get column indices for given block - get_block_gcol_cnt_d, & ! get number of columns in given block - get_block_lvl_cnt_d, & ! get number of vertical levels in column - get_block_levels_d, & ! get vertical levels in column - get_block_owner_d, & ! get process "owning" given block - get_gcol_block_d, & ! get global block indices and local columns - ! index for given global column index - get_gcol_block_cnt_d, & ! get number of blocks containing data - ! from a given global column index - get_horiz_grid_dim_d, & - get_horiz_grid_d, & ! get horizontal grid coordinates - get_dyn_grid_parm, & - get_dyn_grid_parm_real1d, & - dyn_grid_get_elem_coords, & ! get coordinates of a specified block element - dyn_grid_get_colndx, & ! get element block/column and MPI process indices - ! corresponding to a specified global column index - physgrid_copy_attributes_d - -public Atm, mytile - -!======================================================================= -contains -!======================================================================= - -subroutine dyn_grid_init() - - ! Initialize FV grid, decomposition - - use block_control_mod, only: block_control_type, define_blocks_packed - use cam_initfiles, only: initial_file_get_id - use constants_mod, only: constants_init - use fv_mp_mod, only: switch_current_Atm,mp_gather, mp_bcst - use hycoef, only: hycoef_init, hyai, hybi, hypi, hypm, nprlev - use mpp_mod, only: mpp_init, mpp_npes, mpp_get_current_pelist,mpp_gather - use pmgrid, only: plev - use ref_pres, only: ref_pres_init - use time_manager, only: get_step_size - use pio, only: file_desc_t - - ! Local variables - - type(file_desc_t), pointer :: fh_ini - - character(len=*), parameter :: sub='dyn_grid_init' - character(len=128) :: version = '$Id$' - character(len=128) :: tagname = '$Name$' - - real(r8) :: dt_atmos_real = 0._r8 - - integer :: i, j, k, tile - integer :: is,ie,js,je,n,nx,ny - character(len=128) :: errmsg - - !----------------------------------------------------------------------- - ! from couple_main initialize atm structure - initializes fv3 grid - !----------------------------------------------------------------------- - - call fms_init(mpicom) - call mpp_init() - call constants_init - -!----------------------------------------------------------------------- -! initialize atmospheric model ----- - - allocate(pelist(mpp_npes())) - call mpp_get_current_pelist(pelist) - -!---- compute physics/atmos time step in seconds ---- - - dt_atmos_real = get_step_size() - -!----- initialize FV dynamical core ----- - - call fv_init( Atm, dt_atmos_real, grids_on_this_pe, p_split) ! allocates Atm components - - do n=1,ngrids - if (grids_on_this_pe(n)) mytile = n - enddo - -!----- write version and namelist to log file ----- - call write_version_number ( version, tagname ) - - call switch_current_Atm(Atm(mytile)) - -!! set up dimensions_mod convenience variables. - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - npx = Atm(mytile)%flagstruct%npx - npy = Atm(mytile)%flagstruct%npy - ntiles = Atm(mytile)%gridstruct%ntiles_g - tile = Atm(mytile)%tile - - if (Atm(mytile)%flagstruct%npz /= plev) then - write(errmsg,*) 'FV3 dycore levels (npz),',Atm(mytile)%flagstruct%npz,' do not match model levels (plev)',plev - call endrun(sub//':'//errmsg) - end if - - ! Get file handle for initial file - fh_ini => initial_file_get_id() - - ! Initialize hybrid coordinate arrays - call hycoef_init(fh_ini) - - ! Initialize reference pressures - call ref_pres_init(hypi, hypm, nprlev) - - ! Hybrid coordinate info for FV grid object - Atm(mytile)%ks = plev - do k = 1, plev+1 - Atm(mytile)%ak(k) = hyai(k) * 1.e5_r8 - Atm(mytile)%bk(k) = hybi(k) - if ( Atm(mytile)%bk(k) == 0._r8) Atm(mytile)%ks = k-1 - end do - Atm(mytile)%ptop = Atm(mytile)%ak(1) - - ! Define the CAM grids - call define_cam_grids(Atm) - - ! Define block index arrays that are part of dyn_in and - ! global array for mapping columns to block decompositions - - allocate(mygindex(is:ie,js:je)) - allocate(mylindex(is:ie,js:je)) - - nx=npx-1 - ny=npy-1 - - n = 1 - do j = js, je - do i = is, ie - mygindex(i,j)=((j-1)*(npx-1)+i)+((npx-1)*(npy-1)*(tile-1)) - mylindex(i,j)=n - n = n + 1 - end do - end do - - ! create globalID index on block decomp - allocate(gindex_g(nx,ny,ntiles)) - if (masterproc) write(iulog, *) 'INFO: Non-scalable action: Allocating global blocks in FV3 dycore.(gindex_g)' - gindex_g(is:ie,js:je,tile)=mygindex(is:ie,js:je) - call mp_gather(gindex_g, is, ie, js, je, nx, ny, ntiles) - call mp_bcst(gindex_g, nx, ny, ntiles) - - ! create global blockID index on block decomp - if (masterproc) write(iulog, *) 'INFO: Non-scalable action: Allocating global blocks in FV3 dycore.(blkidx_g)' - allocate(blkidx_g(nx,ny,ntiles)) - blkidx_g(is:ie,js:je,tile)= mpp_pe() + 1 - call mp_gather(blkidx_g, is, ie, js, je, nx ,ny, ntiles) - call mp_bcst(blkidx_g, nx, ny, ntiles) - - ! create global block index on block decomp - if (masterproc) write(iulog, *) 'INFO: Non-scalable action: Allocating global blocks in FV3 dycore.(locidx_g)' - allocate(locidx_g(nx,ny,ntiles)) - locidx_g(is:ie,js:je,tile)= mylindex(is:ie,js:je) - call mp_gather(locidx_g, is, ie, js, je, nx ,ny, ntiles) - call mp_bcst(locidx_g, nx, ny, ntiles) - -end subroutine dyn_grid_init - -!======================================================================= - -subroutine get_block_bounds_d(block_first, block_last) - - ! Return first and last indices used in global block ordering - - use spmd_utils, only : npes - - ! arguments - integer, intent(out) :: block_first ! first (global) index used for blocks - integer, intent(out) :: block_last ! last (global) index used for blocks - !---------------------------------------------------------------------------- - - block_first = 1 - block_last = npes - -end subroutine get_block_bounds_d - -!======================================================================= - -subroutine get_block_gcol_d(blockid, size, cdex) - - ! Return number of dynamics columns in indicated block - - use fv_mp_mod, only: mp_bcst - use mpp_mod, only: mpp_npes, mpp_gather - - ! arguments - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: size ! array size - integer, intent(out):: cdex(size) ! global column indices - - ! Local variables - integer, parameter :: be_arrlen = 5 - - real(r8),allocatable :: rtmp(:) - real(r8) :: block_extents(be_arrlen) - integer, allocatable :: be_size(:) - integer :: i, j, n,is,ie,js,je,tile,npes - !---------------------------------------------------------------------------- - !--- get block extents for each task/pe - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - if (.not. allocated(block_extents_g)) then - npes=mpp_npes() - allocate(block_extents_g(be_arrlen,npes)) - allocate(rtmp(be_arrlen*npes)) - allocate(be_size(npes)) - be_size(:)=be_arrlen - block_extents(1)=is - block_extents(2)=ie - block_extents(3)=js - block_extents(4)=je - block_extents(5)=Atm(mytile)%tile - - call mpp_gather(block_extents,be_arrlen,rtmp,be_size) - call mp_bcst(rtmp,be_arrlen*npes) - block_extents_g=reshape(rtmp,(/be_arrlen,npes/)) - - deallocate(rtmp) - deallocate(be_size) - end if - - is=block_extents_g(1,blockid) - ie=block_extents_g(2,blockid) - js=block_extents_g(3,blockid) - je=block_extents_g(4,blockid) - tile=block_extents_g(5,blockid) - - if (size .ne. (ie - is + 1) * (je - js + 1)) then - call endrun ('get_block_gcol_d: block sizes are not consistent.') - end if - ! the following algorithm for cdex calculates global ids for a block - ! given the tile,and i,j column locations on tile. - n=1 - do j = js, je - do i = is, ie - cdex(n)= ((j-1)*(npx-1)+i)+((npx-1)*(npy-1)*(tile-1)) - n=n+1 - end do - end do - -end subroutine get_block_gcol_d - -!======================================================================= - -integer function get_block_gcol_cnt_d(blockid) - - ! Return number of dynamics columns in indicated block - - ! arguments - integer, intent(in) :: blockid - !---------------------------------------------------------------------------- - - get_block_gcol_cnt_d=count(blkidx_g == blockid) - -end function get_block_gcol_cnt_d - -!======================================================================= - -integer function get_block_lvl_cnt_d(blockid, bcid) - - ! Return number of levels in indicated column. If column - ! includes surface fields, then it is defined to also - ! include level 0. - - use pmgrid, only: plevp - - ! arguments - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: bcid ! column index within block - !---------------------------------------------------------------------------- - - get_block_lvl_cnt_d = plevp - -end function get_block_lvl_cnt_d - -!======================================================================= - -subroutine get_block_levels_d(blockid, bcid, lvlsiz, levels) - - use pmgrid, only: plev - - ! Return level indices in indicated column. If column - ! includes surface fields, then it is defined to also - ! include level 0. - - ! arguments - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: bcid ! column index within block - integer, intent(in) :: lvlsiz ! dimension of levels array - integer, intent(out) :: levels(lvlsiz) ! levels indices for block - - ! local variables - integer :: k - character(len=128) :: errmsg - !--------------------------------------------------------------------------- - - if (lvlsiz < plev + 1) then - write(errmsg,*) 'levels array not large enough (', lvlsiz,' < ',plev + 1,')' - call endrun('GET_BLOCK_LEVELS_D: '//trim(errmsg)) - else - do k = 0, plev - levels(k+1) = k - enddo - do k = plev + 2, lvlsiz - levels(k) = -1 - enddo - end if - -end subroutine get_block_levels_d - -!======================================================================= - -integer function get_block_owner_d(blockid) - - ! Return id of processor that "owns" the indicated block - - ! arguments - integer, intent(in) :: blockid ! global block id - - get_block_owner_d = blockid - 1 - -end function get_block_owner_d - -!======================================================================= - -subroutine get_gcol_block_d(gcol, cnt, blockid, bcid, localblockid) - - ! Return global block index and local column index for given global column index. - ! - ! The FV3 dycore assigns each global column to a singe element. So cnt is assumed - ! to be 1. - - use dimensions_mod, only: npx, npy - use fv_mp_mod, only: mp_gather, mp_bcst - - ! arguments - integer, intent(in) :: gcol ! global column index - integer, intent(in) :: cnt ! size of blockid and bcid arrays - integer, intent(out) :: blockid(cnt) ! block index - integer, intent(out) :: bcid(cnt) ! column index within block - integer, intent(out), optional :: localblockid(cnt) - - ! local variables - integer :: tot - integer :: ijk(3) - !---------------------------------------------------------------------------- - - if (cnt /= 1) then - call endrun ('get_gcol_block_d: cnt is not equal to 1:.') - end if - tot=(npx-1)*(npy-1)*6 - if (gcol < 1.or.gcol > tot) then - call endrun ('get_gcol_block_d: global column number is out of bounds') - else - - ijk=maxloc(blkidx_g,mask=gindex_g == gcol) - blockid(1) = blkidx_g(ijk(1),ijk(2),ijk(3)) - - ijk=maxloc(locidx_g,mask=gindex_g == gcol) - bcid(1) = locidx_g(ijk(1),ijk(2),ijk(3)) - end if - - if (present(localblockid)) then - localblockid(cnt) = 1 - end if - -end subroutine get_gcol_block_d - -!======================================================================= - -integer function get_gcol_block_cnt_d(gcol) - - ! Return number of blocks containg data for the vertical column with the - ! given global column index. - - ! For FV3 dycore each column is contained in a single block, so this routine - ! always returns 1. - - ! arguments - integer, intent(in) :: gcol ! global column index - !---------------------------------------------------------------------------- - - get_gcol_block_cnt_d = 1 - -end function get_gcol_block_cnt_d - -!======================================================================= - -subroutine get_horiz_grid_d(nxy, clat_d_out, clon_d_out, area_d_out, wght_d_out, lat_d_out, lon_d_out) - - ! Return global arrays of latitude and longitude (in radians), column - ! surface area (in radians squared) and surface integration weights for - ! global column indices that will be passed to/from physics - - ! arguments - integer, intent(in) :: nxy ! array sizes - real(r8), intent(out), optional :: clat_d_out(:) ! column latitudes - real(r8), intent(out), optional :: clon_d_out(:) ! column longitudes - real(r8), intent(out), optional :: area_d_out(:) ! column surface area - real(r8), intent(out), optional :: wght_d_out(:) ! column integration - real(r8), intent(out), optional :: lat_d_out(:) ! column degree latitudes - real(r8), intent(out), optional :: lon_d_out(:) ! column degree longitudes - - ! local variables - character(len=*), parameter :: sub = 'get_horiz_grid_d' - real(r8), allocatable :: tmparr(:,:) - real(r8), pointer :: area(:,:) - real(r8), pointer :: agrid(:,:,:) - integer :: is,ie,js,je - !---------------------------------------------------------------------------- - - area => Atm(mytile)%gridstruct%area_64 - agrid => Atm(mytile)%gridstruct%agrid_64 - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - if (present(clon_d_out)) then - if (size(clon_d_out) /= nxy) call endrun(sub//': bad clon_d_out array size') - call create_global(is,ie,js,je,agrid(is:ie,js:je,1), clon_d_out) - end if - if (present(clat_d_out)) then - if (size(clat_d_out) /= nxy) call endrun(sub//': bad clat_d_out array size') - call create_global(is,ie,js,je,agrid(is:ie,js:je,2), clat_d_out) - end if - if (present(area_d_out).or.present(wght_d_out)) then - allocate(tmparr(is:ie,js:je)) - tmparr(is:ie,js:je) = area (is:ie,js:je) / (rearth * rearth) - if (present(area_d_out)) then - if (size(area_d_out) /= nxy) call endrun(sub//': bad area_d_out array size') - call create_global(is,ie,js,je,tmparr, area_d_out) - end if - if (present(wght_d_out)) then - if (size(wght_d_out) /= nxy) call endrun(sub//': bad wght_d_out array size') - call create_global(is,ie,js,je,tmparr, wght_d_out) - end if - deallocate(tmparr) - end if - if (present(lon_d_out)) then - if (size(lon_d_out) /= nxy) call endrun(sub//': bad clon_d_out array size') - call create_global(is,ie,js,je,agrid(is:ie,js:je,1), lon_d_out) - lon_d_out=lon_d_out*rad2deg - end if - if (present(lat_d_out)) then - if (size(lat_d_out) /= nxy) call endrun(sub//': bad clat_d_out array size') - call create_global(is,ie,js,je,agrid(is:ie,js:je,2), lat_d_out) - lat_d_out=lat_d_out*rad2deg - end if - - end subroutine get_horiz_grid_d - -!======================================================================= - -subroutine get_horiz_grid_dim_d(hdim1_d, hdim2_d) - - ! Returns declared horizontal dimensions of computational grid. - ! For non-lon/lat grids, declare grid to be one-dimensional, - - use dimensions_mod, only: npx,npy,ntiles - - ! arguments - integer, intent(out) :: hdim1_d ! first horizontal dimension - integer, intent(out), optional :: hdim2_d ! second horizontal dimension - !----------------------------------------------------------------------- - - hdim1_d = (npx-1)*(npy-1)*ntiles - if (present(hdim2_d)) hdim2_d = 1 - -end subroutine get_horiz_grid_dim_d - -!======================================================================= - -subroutine define_cam_grids(Atm) - - ! Create grid objects on the dynamics decomposition for grids used by - ! the dycore. The decomposed grid object contains data for the elements - ! in each task and information to map that data to the global grid. - ! - ! Notes on dynamic memory management: - ! - ! . Coordinate values and the map passed to the horiz_coord_create - ! method are copied to the object. The memory may be deallocated - ! after the object is created. - ! - ! . The area values passed to cam_grid_attribute_register are only pointed - ! to by the attribute object, so that memory cannot be deallocated. But the - ! map is copied. - ! - ! . The grid_map passed to cam_grid_register is just pointed to. - ! Cannot be deallocated. - - use cam_grid_support, only: horiz_coord_t, horiz_coord_create - use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register - use fv_grid_utils_mod, only: mid_pt_sphere - use mpp_mod, only: mpp_pe - use physconst, only: rearth - - ! arguments - type(fv_atmos_type), target, intent(in) :: Atm(:) - - ! local variables - type(horiz_coord_t), pointer :: lat_coord - type(horiz_coord_t), pointer :: lon_coord - - integer(iMap), pointer :: grid_map(:,:) - - integer, allocatable, target, dimension(:,:) :: mygid, mygid_ew,mygid_ns - integer :: mybindex - integer :: i, j, mapind,is,ie,js,je,isd,ied,jsd,jed,tile - real(r8), pointer, dimension(:,:,:) :: agrid - real(r8), pointer, dimension(:,:,:) :: grid - real(r8), pointer, dimension(:,:) :: area - real(r8), pointer :: area_ffsl(:) !fv3 cell centered grid area in sq radians - real(r8), pointer :: pelon_deg(:) - real(r8), pointer :: pelat_deg(:) - real(r8), pointer :: pelon_deg_ew(:) - real(r8), pointer :: pelat_deg_ew(:) - real(r8), pointer :: pelon_deg_ns(:) - real(r8), pointer :: pelat_deg_ns(:) - real(r8) :: lonrad,latrad - integer(iMap), pointer :: pemap(:) - integer(iMap), pointer :: pemap_ew(:) - integer(iMap), pointer :: pemap_ns(:) - integer :: iend, jend - - !----------------------------------------------------------------------- - - area => Atm(mytile)%gridstruct%area_64 - agrid => Atm(mytile)%gridstruct%agrid_64 - grid => Atm(mytile)%gridstruct%grid_64 - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - isd = Atm(mytile)%bd%isd - ied = Atm(mytile)%bd%ied - jsd = Atm(mytile)%bd%jsd - jed = Atm(mytile)%bd%jed - tile = Atm(mytile)%tile - - allocate(area_ffsl((ie-is+1)*(je-js+1))) - allocate(grid_ew(isd:ied+1,jsd:jed,2)) - allocate(grid_ns(isd:ied,jsd:jed+1,2)) - allocate(pelon_deg((ie-is+1)*(je-js+1))) - allocate(pelon_deg_ns((ie-is+1)*(je-js+2))) - allocate(pelon_deg_ew((ie-is+2)*(je-js+1))) - allocate(pelat_deg((ie-is+1)*(je-js+1))) - allocate(pelat_deg_ew((ie-is+2)*(je-js+1))) - allocate(pelat_deg_ns((ie-is+1)*(je-js+2))) - allocate(pemap((ie-is+1)*(je-js+1))) - allocate(pemap_ew((ie-is+2)*(je-js+1))) - allocate(pemap_ns((ie-is+1)*(je-js+2))) - - do j=jsd,jed - do i=isd,ied+1 - call mid_pt_sphere(grid(i, j,1:2), grid(i, j+1,1:2), grid_ew(i,j,:)) - end do - end do - - do j=jsd,jed+1 - do i=isd,ied - call mid_pt_sphere(grid(i,j ,1:2), grid(i+1,j ,1:2), grid_ns(i,j,:)) - end do - end do - - allocate(mygid(is:ie,js:je)) - allocate(mygid_ew(is:ie+1,js:je)) - allocate(mygid_ns(is:ie,js:je+1)) - - mygid=0 - - mybindex = mpp_pe() + 1 - - do j = js, je - do i = is, ie - mygid(i,j)=((j-1)*(npx-1)+i)+((npx-1)*(npy-1)*(tile-1)) - end do - end do - - ! calculate local portion of global NS index array - ! unique global indexing bottom left to top right of each tile consecutively. Dups reported as 0 - ! North tile edges of 2,4,6 are duplicates of south edge of 3,5,1 and are reported as 0 in mygid array - mygid_ns=0 - if (je+1 == npy) then - jend = je+mod(tile,2) - else - jend = je+1 - end if - do j = js, jend - do i = is, ie - mygid_ns(i,j)=(i-1)*(npy-(mod(tile-1,2))) + j + (int((tile-1)/2)*(npx-1)*(npy-1)) + (int(tile/2)*(npx-1)*(npy)) - end do - end do - ! appropriate tile boundaries already 0'd need to - ! zero inner tile je+1 boundaries (These are also repeated points between tasks in ns direction)) - if (je+1 /= npy) mygid_ns(is:ie,je+1)=0 - - ! calculate local portion of global EW index array - ! unique global indexing bottom left to top right of each tile consecutively. Dups reported as 0 - ! East tile edges of 1,3,5 are duplicates of west edge of 2,4,6 and are reported as 0 in mygid array - mygid_ew=0 - if (ie+1 == npx) then - iend=ie+mod(tile-1,2) - else - iend=ie+1 - end if - do j = js, je - do i = is, iend - mygid_ew(i,j)=(j-1)*(npx-(mod(tile,2))) + i + (int(tile/2)*(npx-1)*(npy-1)) + (int((tile-1)/2)*(npx)*(npy-1)) - end do - end do - - ! appropriate east tile boundaries already 0'd from above need to - ! zero inner tile ie+1 boundaries on appropriate processors - ! (These are also repeated points between tasks in ew direction) - if (ie+1 /= npx) mygid_ew(ie+1,js:je)=0 - - !----------------------- - ! Create FFSL grid object - !----------------------- - - ! Calculate the mapping between FFSL points and file order (tile1 thru tile6) - mapind = 1 - do j = js, je - do i = is, ie - pelon_deg(mapind) = agrid(i,j,1) * rad2deg - pelat_deg(mapind) = agrid(i,j,2) * rad2deg - area_ffsl(mapind) = area(i,j)/(rearth*rearth) - pemap(mapind) = mygid(i,j) - mapind = mapind + 1 - end do - end do - - mapind = 1 - do j = js, je - do i = is, ie+1 - lonrad=grid_ew(i,j,1) - latrad=grid_ew(i,j,2) - pelon_deg_ew(mapind) = lonrad * rad2deg - pelat_deg_ew(mapind) = latrad * rad2deg - pemap_ew(mapind) = mygid_ew(i,j) - mapind = mapind + 1 - end do - end do - - mapind = 1 - do j = js, je+1 - do i = is, ie - lonrad=grid_ns(i,j,1) - latrad=grid_ns(i,j,2) - pelon_deg_ns(mapind) = lonrad * rad2deg - pelat_deg_ns(mapind) = latrad * rad2deg - pemap_ns(mapind) = mygid_ns(i,j) - mapind = mapind + 1 - end do - end do - - allocate(grid_map(3, (ie-is+1)*(je-js+1))) - grid_map = 0 - mapind = 1 - do j = js, je - do i = is, ie - grid_map(1, mapind) = i - grid_map(2, mapind) = j - grid_map(3, mapind) = pemap(mapind) - mapind = mapind + 1 - end do - end do - - ! output local and global uniq points - uniqpts_glob=(npx-1)*(npy-1)*6 - - ! with FV3 if the initial file uses the horizontal dimension 'ncol' rather than - ! 'ncol_d' then we need a grid object with the names ncol,lat,lon to read it. - ! Create that grid object here. - - lat_coord => horiz_coord_create('lat', 'ncol', uniqpts_glob, 'latitude', & - 'degrees_north', 1, size(pelat_deg), pelat_deg, map=pemap) - lon_coord => horiz_coord_create('lon', 'ncol', uniqpts_glob, 'longitude', & - 'degrees_east', 1, size(pelon_deg), pelon_deg, map=pemap) - - ! register physics cell-center/A-grid - call cam_grid_register(ini_grid_name, ini_decomp, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.) - call cam_grid_attribute_register(ini_grid_name, 'cell', '', 1) - call cam_grid_attribute_register(ini_grid_name, 'area', 'cam cell center areas', & - 'ncol', area_ffsl, map=pemap) - nullify(lat_coord) - nullify(lon_coord) - - ! create and register dynamic A-grid, src_in(/1,2/) allows ilev,jlev,nlev ordering for restart IO - lat_coord => horiz_coord_create('lat_d', 'ncol_d', uniqpts_glob, 'latitude', & - 'degrees_north', 1, size(pelat_deg), pelat_deg, map=pemap) - lon_coord => horiz_coord_create('lon_d', 'ncol_d', uniqpts_glob, 'longitude', & - 'degrees_east', 1, size(pelon_deg), pelon_deg, map=pemap) - - call cam_grid_register('FFSL', dyn_decomp, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.,src_in=(/1,2/)) - call cam_grid_attribute_register('FFSL', 'cell', '', 1) - call cam_grid_attribute_register('FFSL', 'area_d', 'FFSL grid areas', & - 'ncol_d', area_ffsl, map=pemap) - - ! register grid for writing dynamics A-Grid fields in history files - call cam_grid_register('FFSLHIST', dyn_decomp_hist, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.) - call cam_grid_attribute_register('FFSLHIST', 'cell', '', 1) - call cam_grid_attribute_register('FFSLHIST', 'area_d', 'FFSLHIST grid areas', & - 'ncol_d', area_ffsl, map=pemap) - - ! grid_map cannot be deallocated as the cam_filemap_t object just points - ! to it. It can be nullified. - nullify(grid_map) - ! lat_coord and lon_coord belong to grid so can't be deleted. It can be nullified - nullify(lat_coord) - nullify(lon_coord) - ! area_ffsl cannot be deallocated as the attribute object is just pointing - ! to that memory. It can be nullified since the attribute object has - ! the reference. - nullify(area_ffsl) - - - ! global EW uniq points - uniqpts_glob_ew=((2*npx)-1)*(npy-1)*3 - - lat_coord => horiz_coord_create('lat_d_ew', 'ncol_d_ew', uniqpts_glob_ew, 'latitude', & - 'degrees_north', 1, size(pelat_deg_ew), pelat_deg_ew, map=pemap_ew) - lon_coord => horiz_coord_create('lon_d_ew', 'ncol_d_ew', uniqpts_glob_ew, 'longitude', & - 'degrees_east', 1, size(pelon_deg_ew), pelon_deg_ew, map=pemap_ew) - - allocate(grid_map(3, (ie-is+2)*(je-js+1))) - grid_map = 0 - mapind = 1 - do j = js, je - do i = is, ie+1 - grid_map(1, mapind) = i - grid_map(2, mapind) = j - grid_map(3, mapind) = pemap_ew(mapind) - mapind = mapind + 1 - end do - end do - - ! register dynamic D-grid, src_in(/1,2/) allows ilev,jlev,nlev ordering for restart IO - call cam_grid_register('FFSL_EW', dyn_decomp_ew, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.,src_in=(/1,2/)) - call cam_grid_attribute_register('FFSL_EW', 'cell', '', 1) - - ! register grid for writing dynamics D-Grid fields in history files - call cam_grid_register('FFSLHIST_EW', dyn_decomp_hist_ew, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.) - call cam_grid_attribute_register('FFSLHIST_EW', 'cell', '', 1) - - ! grid_map cannot be deallocated as the cam_filemap_t object just points - ! to it. It can be nullified. - nullify(grid_map) - ! lat_coord and lon_coord belong to grid so can't be deleted. It can be nullified - nullify(lat_coord) ! Belongs to grid - nullify(lon_coord) ! Belongs to grid - - - ! output local and global uniq points - uniqpts_glob_ns=((2*npy)-1)*(npx-1)*3 - - lat_coord => horiz_coord_create('lat_d_ns', 'ncol_d_ns', uniqpts_glob_ns, 'latitude', & - 'degrees_north', 1, size(pelat_deg_ns), pelat_deg_ns, map=pemap_ns) - lon_coord => horiz_coord_create('lon_d_ns', 'ncol_d_ns', uniqpts_glob_ns, 'longitude', & - 'degrees_east', 1, size(pelon_deg_ns), pelon_deg_ns, map=pemap_ns) - - allocate(grid_map(3, (ie-is+1)*(je-js+2))) - grid_map = 0 - mapind = 1 - do j = js, je+1 - do i = is, ie - grid_map(1, mapind) = i - grid_map(2, mapind) = j - grid_map(3, mapind) = pemap_ns(mapind) - mapind = mapind + 1 - end do - end do - - ! register dynamic D-grid, src_in(/1,2/) allows ilev,jlev,nlev ordering for restart IO - call cam_grid_register('FFSL_NS', dyn_decomp_ns, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.,src_in=(/1,2/)) - call cam_grid_attribute_register('FFSL_NS', 'cell', '', 1) - - ! register grid for writing dynamics D-Grid fields in history files - call cam_grid_register('FFSLHIST_NS', dyn_decomp_hist_ns, lat_coord, lon_coord, & - grid_map, block_indexed=.false., unstruct=.true.) - call cam_grid_attribute_register('FFSLHIST_NS', 'cell', '', 1) - - ! grid_map cannot be deallocated as the cam_filemap_t object just points - ! to it. It can be nullified. - nullify(grid_map) - ! lat_coord and lon_coord belong to grid so can't be deleted. It can be nullified - nullify(lat_coord) ! Belongs to grid - nullify(lon_coord) ! Belongs to grid - - deallocate(pelon_deg) - deallocate(pelat_deg) - deallocate(pelon_deg_ns) - deallocate(pelat_deg_ns) - deallocate(pelon_deg_ew) - deallocate(pelat_deg_ew) - deallocate(pemap) - deallocate(pemap_ew) - deallocate(pemap_ns) - deallocate(mygid) - deallocate(mygid_ew) - deallocate(mygid_ns) - -end subroutine define_cam_grids - -!========================================================================================= - -subroutine physgrid_copy_attributes_d(gridname, grid_attribute_names) - - ! create list of attributes for the physics grid that should be copied - ! from the corresponding grid object on the dynamics decomposition - - use cam_grid_support, only: max_hcoordname_len - - ! arguments - character(len=max_hcoordname_len), intent(out) :: gridname - character(len=max_hcoordname_len), pointer, intent(out) :: grid_attribute_names(:) - !----------------------------------------------------------------------- - - gridname = 'FFSL' - allocate(grid_attribute_names(1)) - ! For standard CAM-FV3, we need to copy the area attribute. - ! For physgrid, the physics grid will create area - grid_attribute_names(1) = 'cell' - -end subroutine physgrid_copy_attributes_d - -!======================================================================= - -integer function get_dyn_grid_parm(name) result(ival) - - ! This function is in the process of being deprecated, but is still needed - ! as a dummy interface to satisfy external references from some chemistry routines. - - use pmgrid, only: plon, plev, plat, plevp - - character(len=*), intent(in) :: name - integer is,ie,js,je - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - if (name == 'plat') then - ival = plat - else if (name == 'plon') then - ival = (je-js+1)*(ie-is+1) - else if (name == 'plev') then - ival = plev - else if (name == 'plevp') then - ival = plevp - else - call endrun('get_dyn_grid_parm: undefined name: '//adjustl(trim(name))) - end if - -end function get_dyn_grid_parm - -!======================================================================= - -function get_dyn_grid_parm_real1d(name) result(rval) - - ! This routine is not used for FV3, but still needed as a dummy interface to satisfy - ! references from mo_synoz.F90 and phys_gmean.F90 - - ! arguments - character(len=*), intent(in) :: name - real(r8), pointer :: rval(:) - !---------------------------------------------------------------------------- - - if(name == 'w') then - call endrun('get_dyn_grid_parm_real1d: w not defined') - else if(name == 'clat') then - call endrun('get_dyn_grid_parm_real1d: clat not supported, use get_horiz_grid_d') - else if(name == 'latdeg') then - call endrun('get_dyn_grid_parm_real1d: latdeg not defined') - else - nullify(rval) - end if - -end function get_dyn_grid_parm_real1d - -!========================================================================================= - -subroutine dyn_grid_get_colndx( igcol, ncols, owners, indx, jndx) - use spmd_utils, only: iam - - ! For each global column index return the owning task. If the column is owned - ! by this task, then also return the MPI process indicies for that column - - - ! arguments - integer, intent(in) :: ncols - integer, intent(in) :: igcol(ncols) - integer, intent(out) :: owners(ncols) - integer, intent(out) :: indx(ncols) - integer, intent(out) :: jndx(ncols) - - ! local variables - integer :: i,is,ie,js,je - integer :: blockid(1), bcid(1), lclblockid(1), ind(2) - !---------------------------------------------------------------------------- - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - do i = 1,ncols - - call get_gcol_block_d( igcol(i), 1, blockid, bcid, lclblockid ) - owners(i) = get_block_owner_d(blockid(1)) - - if ( iam == owners(i) ) then - if (minval(abs(bcid(1)-mylindex)) == 0) then - ind = minloc(abs(bcid(1)-mylindex)) - indx(i) = is+ind(1)-1 - jndx(i) = js+ind(2)-1 - end if - else - indx(i) = -1 - jndx(i) = -1 - endif - - end do - -end subroutine dyn_grid_get_colndx - -!======================================================================= - -subroutine dyn_grid_get_elem_coords(ie, rlon, rlat, cdex) - - ! Returns coordinates of a specified block element of the dyn grid - ! - - ! arguments - integer, intent(in) :: ie ! block element index - real(r8),optional, intent(out) :: rlon(:) ! longitudes of the columns in the element - real(r8),optional, intent(out) :: rlat(:) ! latitudes of the columns in the element - integer, optional, intent(out) :: cdex(:) ! global column index - !---------------------------------------------------------------------------- - - call endrun('dyn_grid_get_elem_coords: currently not avaliable.') - -end subroutine dyn_grid_get_elem_coords - -!========================================================================================= - -subroutine create_global(is,ie,js,je,arr_d, global_out) - - ! Gather global array of columns for the physics grid, - ! reorder to global column order, then broadcast it to all tasks. - - use fv_mp_mod, only: mp_gather, mp_bcst - - ! arguments - integer, intent(in) :: is, ie, js, je - real(r8), intent(in) :: arr_d(is:ie,js:je) ! input array - real(r8), intent(out) :: global_out(:) ! global output in block order - - ! local variables - integer :: i, j, k - integer :: tile - real(r8), allocatable :: globid(:,:,:) - real(r8), allocatable :: globarr_tmp(:,:,:) - !---------------------------------------------------------------------------- - - tile = Atm(mytile)%tile - - if (.not. allocated(globarr_tmp)) then - if (masterproc) write(iulog, *) 'INFO: Non-scalable action: Allocating global blocks in FV3 dycore.(globarr_tmp)' - allocate(globarr_tmp(npx-1, npy-1, ntiles)) - end if - - globarr_tmp(is:ie,js:je,tile)=arr_d(is:ie,js:je) - call mp_gather(globarr_tmp, is, ie, js, je, npx-1, npy-1, ntiles) - if (masterproc) then - do k = 1, ntiles - do j = 1, npy-1 - do i = 1, npx-1 - global_out(gindex_g(i,j,k)) = globarr_tmp(i,j,k) - end do - end do - end do - end if - call mp_bcst(global_out, (npx-1)*(npy-1)*ntiles) - deallocate(globarr_tmp) - -end subroutine create_global - -end module dyn_grid diff --git a/src/dynamics/fv3/interp_mod.F90 b/src/dynamics/fv3/interp_mod.F90 deleted file mode 100644 index e517031ea8..0000000000 --- a/src/dynamics/fv3/interp_mod.F90 +++ /dev/null @@ -1,67 +0,0 @@ -module interp_mod - ! inline interpolation routines not implemented yet - use shr_kind_mod, only : r8=>shr_kind_r8 - use cam_abortutils, only : endrun - - implicit none - private - save - - public :: setup_history_interpolation - public :: set_interp_hfile - public :: write_interpolated - - interface write_interpolated - module procedure write_interpolated_scalar - module procedure write_interpolated_vector - end interface - integer, parameter :: nlat=0, nlon=0 -contains - - subroutine setup_history_interpolation(interp_ok, mtapes, interp_output, & - interp_info) - use cam_history_support, only: interp_info_t - - ! Dummy arguments - logical, intent(inout) :: interp_ok - integer, intent(in) :: mtapes - logical, intent(in) :: interp_output(:) - type(interp_info_t), intent(inout) :: interp_info(:) - - interp_ok = .false. - - end subroutine setup_history_interpolation - - subroutine set_interp_hfile(hfilenum, interp_info) - use cam_history_support, only: interp_info_t - - ! Dummy arguments - integer, intent(in) :: hfilenum - type(interp_info_t), intent(inout) :: interp_info(:) - call endrun('ERROR:set_interp_hfile - This routine is a stub, you shouldnt get here') - end subroutine set_interp_hfile - - subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp_type) - use pio, only : file_desc_t, var_desc_t - use shr_kind_mod, only : r8=>shr_kind_r8 - - type(file_desc_t), intent(inout) :: File - type(var_desc_t), intent(inout) :: varid - real(r8), intent(in) :: fld(:,:,:) - integer, intent(in) :: numlev, data_type, decomp_type - call endrun('ERROR:write_interpolated_scalar - This routine is a stub, you shouldnt get here') - - end subroutine write_interpolated_scalar - - subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, data_type, decomp_type) - use pio, only : file_desc_t, var_desc_t - - type(file_desc_t), intent(inout) :: File - type(var_desc_t), intent(inout) :: varidu, varidv - real(r8), intent(in) :: fldu(:,:,:), fldv(:,:,:) - integer, intent(in) :: numlev, data_type, decomp_type - call endrun('ERROR:write_interpolated_vector - This routine is a stub, you shouldnt get here') - - end subroutine write_interpolated_vector - -end module interp_mod diff --git a/src/dynamics/fv3/microphys/gfdl_cloud_microphys.F90 b/src/dynamics/fv3/microphys/gfdl_cloud_microphys.F90 deleted file mode 100644 index 9a18204651..0000000000 --- a/src/dynamics/fv3/microphys/gfdl_cloud_microphys.F90 +++ /dev/null @@ -1,4975 +0,0 @@ -!*********************************************************************** -!* GNU Lesser General Public License -!* -!* This file is part of the GFDL Cloud Microphysics. -!* -!* The GFDL Cloud Microphysics is free software: you can -!* redistribute it and/or modify it under the terms of the -!* GNU Lesser General Public License as published by the -!* Free Software Foundation, either version 3 of the License, or -!* (at your option) any later version. -!* -!* The GFDL Cloud Microphysics is distributed in the hope it will be -!* useful, but WITHOUT ANYWARRANTY; without even the implied warranty -!* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -!* See the GNU General Public License for more details. -!* -!* You should have received a copy of the GNU Lesser General Public -!* License along with the GFDL Cloud Microphysics. -!* If not, see . -!*********************************************************************** - -!>@brief The module 'gfdl_cloud_microphys' contains the full GFDL cloud -!! microphysics (Chen and Lin 2013) \cite chen2013seasonal and (Zhou et al. 2019) \cite zhou2019toward. -!>@details The module is paired with 'fv_cmp', which performs the "fast" -!! processes -!>author Shian-Jiann Lin, Linjiong Zhou - -! ======================================================================= -! cloud micro - physics package for gfdl global cloud resolving model -! the algorithms are originally derived from lin et al 1983. most of the -! key elements have been simplified / improved. this code at this stage -! bears little to no similarity to the original lin mp in zetac. -! therefore, it is best to be called gfdl micro - physics (gfdl mp) . -! developer: Shian-Jiann lin, Linjiong Zhou -! ======================================================================= - -module gfdl_cloud_microphys_mod - USE module_mp_radar - ! use diag_manager_mod, only: register_diag_field, send_data - ! use time_manager_mod, only: time_type, get_time - ! use constants_mod, only: grav, rdgas, rvgas, cp_air, hlv, hlf, pi => pi_8 - ! use fms_mod, only: write_version_number, open_namelist_file, & - ! check_nml_error, file_exist, close_file - - implicit none - - private - - public gfdl_cloud_microphys_driver, gfdl_cloud_microphys_init, gfdl_cloud_microphys_end - public wqs1, wqs2, qs_blend, wqsat_moist, wqsat2_moist - public qsmith_init, qsmith, es2_table1d, es3_table1d, esw_table1d - public setup_con, wet_bulb - public cloud_diagnosis - - real :: missing_value = - 1.e10 - - logical :: module_is_initialized = .false. - logical :: qsmith_tables_initialized = .false. - - character (len = 17) :: mod_name = 'gfdl_cloud_microphys' - - real, parameter :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 - real, parameter :: rhos = 0.1e3, rhog = 0.4e3 - real, parameter :: grav = 9.80665 !< gfs: acceleration due to gravity - real, parameter :: rdgas = 287.05 !< gfs: gas constant for dry air - real, parameter :: rvgas = 461.50 !< gfs: gas constant for water vapor - real, parameter :: cp_air = 1004.6 !< gfs: heat capacity of dry air at constant pressure - real, parameter :: hlv = 2.5e6 !< gfs: latent heat of evaporation - real, parameter :: hlf = 3.3358e5 !< gfs: latent heat of fusion - real, parameter :: pi = 3.1415926535897931 !< gfs: ratio of circle circumference to diameter - - ! real, parameter :: rdgas = 287.04 ! gfdl: gas constant for dry air - - ! real, parameter :: cp_air = rdgas * 7. / 2. ! 1004.675, heat capacity of dry air at constant pressure - real, parameter :: cp_vap = 4.0 * rvgas !< 1846.0, heat capacity of water vapore at constnat pressure - ! real, parameter :: cv_air = 717.56 ! satoh value - real, parameter :: cv_air = cp_air - rdgas !< 717.55, heat capacity of dry air at constant volume - ! real, parameter :: cv_vap = 1410.0 ! emanuel value - real, parameter :: cv_vap = 3.0 * rvgas !< 1384.5, heat capacity of water vapor at constant volume - - ! the following two are from emanuel's book "atmospheric convection" - ! real, parameter :: c_ice = 2106.0 ! heat capacity of ice at 0 deg c: c = c_ice + 7.3 * (t - tice) - ! real, parameter :: c_liq = 4190.0 ! heat capacity of water at 0 deg c - - real, parameter :: c_ice = 1972.0 !< gfdl: heat capacity of ice at - 15 deg c - real, parameter :: c_liq = 4185.5 !< gfdl: heat capacity of water at 15 deg c - ! real, parameter :: c_liq = 4218.0 ! ifs: heat capacity of liquid at 0 deg c - - real, parameter :: eps = rdgas / rvgas ! 0.6219934995 - real, parameter :: zvir = rvgas / rdgas - 1. !< 0.6077338443 - - real, parameter :: t_ice = 273.16 !< freezing temperature - real, parameter :: table_ice = 273.16 !< freezing point for qs table - - ! real, parameter :: e00 = 610.71 ! gfdl: saturation vapor pressure at 0 deg c - real, parameter :: e00 = 611.21 !< ifs: saturation vapor pressure at 0 deg c - - real, parameter :: dc_vap = cp_vap - c_liq !< - 2339.5, isobaric heating / cooling - real, parameter :: dc_ice = c_liq - c_ice !< 2213.5, isobaric heating / colling - - real, parameter :: hlv0 = hlv !< gfs: evaporation latent heat coefficient at 0 deg c - ! real, parameter :: hlv0 = 2.501e6 ! emanuel appendix - 2 - real, parameter :: hlf0 = hlf !< gfs: fussion latent heat coefficient at 0 deg c - ! real, parameter :: hlf0 = 3.337e5 ! emanuel - - real, parameter :: lv0 = hlv0 - dc_vap * t_ice!< 3.13905782e6, evaporation latent heat coefficient at 0 deg k - real, parameter :: li00 = hlf0 - dc_ice * t_ice!< - 2.7105966e5, fusion latent heat coefficient at 0 deg k - - real, parameter :: d2ice = dc_vap + dc_ice !< - 126, isobaric heating / cooling - real, parameter :: li2 = lv0 + li00 !< 2.86799816e6, sublimation latent heat coefficient at 0 deg k - - real, parameter :: qrmin = 1.e-8 ! min value for ??? - real, parameter :: qvmin = 1.e-20 !< min value for water vapor (treated as zero) - real, parameter :: qcmin = 1.e-12 !< min value for cloud condensates - - real, parameter :: vr_min = 1.e-3 !< min fall speed for rain - real, parameter :: vf_min = 1.e-5 !< min fall speed for cloud ice, snow, graupel - - real, parameter :: dz_min = 1.e-2 ! use for correcting flipped height - - real, parameter :: sfcrho = 1.2 !< surface air density - real, parameter :: rhor = 1.e3 !< density of rain water, lin83 - - real :: cracs, csacr, cgacr, cgacs, csacw, craci, csaci, cgacw, cgaci, cracw !< constants for accretions - real :: acco (3, 4) !< constants for accretions - real :: cssub (5), cgsub (5), crevp (5), cgfr (2), csmlt (5), cgmlt (5) - - real :: es0, ces0 - real :: pie, rgrav, fac_rc - real :: c_air, c_vap - - real :: lati, latv, lats, lat2, lcp, icp, tcp !< used in bigg mechanism and wet bulk - - real :: d0_vap !< the same as dc_vap, except that cp_vap can be cp_vap or cv_vap - real :: lv00 !< the same as lv0, except that cp_vap can be cp_vap or cv_vap - - ! cloud microphysics switchers - - integer :: icloud_f = 0 !< cloud scheme - integer :: irain_f = 0 !< cloud water to rain auto conversion scheme - - logical :: de_ice = .false. !< to prevent excessive build - up of cloud ice from external sources - logical :: sedi_transport = .true. !< transport of momentum in sedimentation - logical :: do_sedi_w = .false. !< transport of vertical motion in sedimentation - logical :: do_sedi_heat = .true. !< transport of heat in sedimentation - logical :: prog_ccn = .false. !< do prognostic ccn (yi ming's method) - logical :: do_qa = .true. !< do inline cloud fraction - logical :: rad_snow = .true. !< consider snow in cloud fraciton calculation - logical :: rad_graupel = .true. !< consider graupel in cloud fraction calculation - logical :: rad_rain = .true. !< consider rain in cloud fraction calculation - logical :: fix_negative = .false. !< fix negative water species - logical :: do_setup = .true. !< setup constants and parameters - logical :: p_nonhydro = .false. !< perform hydrosatic adjustment on air density - - real, allocatable :: table (:), table2 (:), table3 (:), tablew (:) - real, allocatable :: des (:), des2 (:), des3 (:), desw (:) - - logical :: tables_are_initialized = .false. - - ! logical :: master - ! integer :: id_rh, id_vtr, id_vts, id_vtg, id_vti, id_rain, id_snow, id_graupel, & - ! id_ice, id_prec, id_cond, id_var, id_droplets - real, parameter :: dt_fr = 8. !< homogeneous freezing of all cloud water at t_wfr - dt_fr - ! minimum temperature water can exist (moore & molinero nov. 2011, nature) - ! dt_fr can be considered as the error bar - - real :: p_min = 100. !< minimum pressure (pascal) for mp to operate - - ! slj, the following parameters are for cloud - resolving resolution: 1 - 5 km - - ! qi0_crt = 0.8e-4 - ! qs0_crt = 0.6e-3 - ! c_psaci = 0.1 - ! c_pgacs = 0.1 - - ! ----------------------------------------------------------------------- - !> namelist parameters - ! ----------------------------------------------------------------------- - - real :: cld_min = 0.05 !< minimum cloud fraction - real :: tice = 273.16 !< set tice = 165. to trun off ice - phase phys (kessler emulator) - - real :: t_min = 178. !< min temp to freeze - dry all water vapor - real :: t_sub = 184. !< min temp for sublimation of cloud ice - real :: mp_time = 150. !< maximum micro - physics time step (sec) - - ! relative humidity increment - - real :: rh_inc = 0.25 !< rh increment for complete evaporation of cloud water and cloud ice - real :: rh_inr = 0.25 !< rh increment for minimum evaporation of rain - real :: rh_ins = 0.25 !< rh increment for sublimation of snow - - ! conversion time scale - - real :: tau_r2g = 900. !< rain freezing during fast_sat - real :: tau_smlt = 900. !< snow melting - real :: tau_g2r = 600. !< graupel melting to rain - real :: tau_imlt = 600. !< cloud ice melting - real :: tau_i2s = 1000. !< cloud ice to snow auto - conversion - real :: tau_l2r = 900. !< cloud water to rain auto - conversion - real :: tau_v2l = 150. !< water vapor to cloud water (condensation) - real :: tau_l2v = 300. !< cloud water to water vapor (evaporation) - real :: tau_g2v = 900. !< graupel sublimation - real :: tau_v2g = 21600. !< graupel deposition -- make it a slow process - - ! horizontal subgrid variability - - real :: dw_land = 0.20 !< base value for subgrid deviation / variability over land - real :: dw_ocean = 0.10 !< base value for ocean - - ! prescribed ccn - - real :: ccn_o = 90. !< ccn over ocean (cm^ - 3) - real :: ccn_l = 270. !< ccn over land (cm^ - 3) - - real :: rthresh = 10.0e-6 !< critical cloud drop radius (micro m) - - ! ----------------------------------------------------------------------- - ! wrf / wsm6 scheme: qi_gen = 4.92e-11 * (1.e3 * exp (0.1 * tmp)) ** 1.33 - ! optimized: qi_gen = 4.92e-11 * exp (1.33 * log (1.e3 * exp (0.1 * tmp))) - ! qi_gen ~ 4.808e-7 at 0 c; 1.818e-6 at - 10 c, 9.82679e-5 at - 40c - ! the following value is constructed such that qc_crt = 0 at zero c and @ - 10c matches - ! wrf / wsm6 ice initiation scheme; qi_crt = qi_gen * min (qi_lim, 0.1 * tmp) / den - ! ----------------------------------------------------------------------- - - real :: sat_adj0 = 0.90 !< adjustment factor (0: no, 1: full) during fast_sat_adj - - real :: qc_crt = 5.0e-8 !< mini condensate mixing ratio to allow partial cloudiness - - real :: qi_lim = 1. !< cloud ice limiter to prevent large ice build up - - real :: ql_mlt = 2.0e-3 !< max value of cloud water allowed from melted cloud ice - real :: qs_mlt = 1.0e-6 !< max cloud water due to snow melt - - real :: ql_gen = 1.0e-3 !< max cloud water generation during remapping step if fast_sat_adj = .t. - real :: qi_gen = 1.82e-6 !< max cloud ice generation during remapping step - - ! cloud condensate upper bounds: "safety valves" for ql & qi - - real :: ql0_max = 2.0e-3 !< max cloud water value (auto converted to rain) - real :: qi0_max = 1.0e-4 !< max cloud ice value (by other sources) - - real :: qi0_crt = 1.0e-4 !< cloud ice to snow autoconversion threshold (was 1.e-4) - !! qi0_crt is highly dependent on horizontal resolution - real :: qr0_crt = 1.0e-4 !< rain to snow or graupel / hail threshold - !! lfo used * mixing ratio * = 1.e-4 (hail in lfo) - real :: qs0_crt = 1.0e-3 !< snow to graupel density threshold (0.6e-3 in purdue lin scheme) - - real :: c_paut = 0.55 !< autoconversion cloud water to rain (use 0.5 to reduce autoconversion) - real :: c_psaci = 0.02 !< accretion: cloud ice to snow (was 0.1 in zetac) - real :: c_piacr = 5.0 !< accretion: rain to ice: - real :: c_cracw = 0.9 !< rain accretion efficiency - real :: c_pgacs = 2.0e-3 !< snow to graupel "accretion" eff. (was 0.1 in zetac) - - ! decreasing clin to reduce csacw (so as to reduce cloud water --- > snow) - - real :: alin = 842.0 !< "a" in lin1983 - real :: clin = 4.8 !< "c" in lin 1983, 4.8 -- > 6. (to ehance ql -- > qs) - - ! fall velocity tuning constants: - - logical :: const_vi = .false. !< if .t. the constants are specified by v * _fac - logical :: const_vs = .false. !< if .t. the constants are specified by v * _fac - logical :: const_vg = .false. !< if .t. the constants are specified by v * _fac - logical :: const_vr = .false. !< if .t. the constants are specified by v * _fac - - ! good values: - - real :: vi_fac = 1. !< if const_vi: 1 / 3 - real :: vs_fac = 1. !< if const_vs: 1. - real :: vg_fac = 1. !< if const_vg: 2. - real :: vr_fac = 1. !< if const_vr: 4. - - ! upper bounds of fall speed (with variable speed option) - - real :: vi_max = 0.5 !< max fall speed for ice - real :: vs_max = 5.0 !< max fall speed for snow - real :: vg_max = 8.0 !< max fall speed for graupel - real :: vr_max = 12. !< max fall speed for rain - - ! cloud microphysics switchers - - logical :: fast_sat_adj = .false. !< has fast saturation adjustments - logical :: z_slope_liq = .true. !< use linear mono slope for autocconversions - logical :: z_slope_ice = .false. !< use linear mono slope for autocconversions - logical :: use_ccn = .false. !< must be true when prog_ccn is false - logical :: use_ppm = .false. !< use ppm fall scheme - logical :: mono_prof = .true. !< perform terminal fall with mono ppm scheme - logical :: mp_print = .false. !< cloud microphysics debugging printout - - ! real :: global_area = - 1. - - real :: log_10, tice0, t_wfr - - integer :: reiflag = 1 - ! 1: Heymsfield and Mcfarquhar, 1996 - ! 2: Wyser, 1998 - - logical :: tintqs = .false. !< use temperature in the saturation mixing in PDF - - real :: rewmin = 5.0, rewmax = 10.0 - real :: reimin = 10.0, reimax = 150.0 - real :: rermin = 10.0, rermax = 10000.0 - real :: resmin = 150.0, resmax = 10000.0 - real :: regmin = 300.0, regmax = 10000.0 - - ! ----------------------------------------------------------------------- - ! namelist - ! ----------------------------------------------------------------------- - - namelist / gfdl_cloud_microphysics_nml / & - mp_time, t_min, t_sub, tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, & - vi_fac, vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vi_max, & - vs_max, vg_max, vr_max, qs_mlt, qs0_crt, qi_gen, ql0_max, qi0_max, & - qi0_crt, qr0_crt, fast_sat_adj, rh_inc, rh_ins, rh_inr, const_vi, & - const_vs, const_vg, const_vr, use_ccn, rthresh, ccn_l, ccn_o, qc_crt, & - tau_g2v, tau_v2g, sat_adj0, c_piacr, tau_imlt, tau_v2l, tau_l2v, & - tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, c_pgacs, & - z_slope_liq, z_slope_ice, prog_ccn, c_cracw, alin, clin, tice, & - rad_snow, rad_graupel, rad_rain, cld_min, use_ppm, mono_prof, & - do_sedi_heat, sedi_transport, do_sedi_w, de_ice, icloud_f, irain_f, & - mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, rermax, & - resmin, resmax, regmin, regmax, tintqs - - public & - mp_time, t_min, t_sub, tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, & - vi_fac, vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vi_max, & - vs_max, vg_max, vr_max, qs_mlt, qs0_crt, qi_gen, ql0_max, qi0_max, & - qi0_crt, qr0_crt, fast_sat_adj, rh_inc, rh_ins, rh_inr, const_vi, & - const_vs, const_vg, const_vr, use_ccn, rthresh, ccn_l, ccn_o, qc_crt, & - tau_g2v, tau_v2g, sat_adj0, c_piacr, tau_imlt, tau_v2l, tau_l2v, & - tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, c_pgacs, & - z_slope_liq, z_slope_ice, prog_ccn, c_cracw, alin, clin, tice, & - rad_snow, rad_graupel, rad_rain, cld_min, use_ppm, mono_prof, & - do_sedi_heat, sedi_transport, do_sedi_w, de_ice, icloud_f, irain_f, & - mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, rermax, & - resmin, resmax, regmin, regmax, tintqs - -contains - -! ----------------------------------------------------------------------- -! the driver of the gfdl cloud microphysics -! ----------------------------------------------------------------------- - -!>@brief The subroutine 'gfdl_cloud_microphys_driver' executes the full GFDL -!! cloud microphysics. -subroutine gfdl_cloud_microphys_driver (qv, ql, qr, qi, qs, qg, qa, qn, & - qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt, qa_dt, pt_dt, pt, w, & - uin, vin, udt, vdt, dz, delp, area, dt_in, land, rain, snow, ice, & - graupel, hydrostatic, phys_hydrostatic, iis, iie, jjs, jje, kks, & - kke, ktop, kbot, seconds,p,lradar,refl_10cm,reset) - implicit none - - logical, intent (in) :: hydrostatic, phys_hydrostatic,lradar - integer, intent (in) :: iis, iie, jjs, jje !< physics window - integer, intent (in) :: kks, kke !< vertical dimension - integer, intent (in) :: ktop, kbot !< vertical compute domain - integer, intent (in) :: seconds - logical, intent (in) :: reset - - real, intent (in) :: dt_in !< physics time step - - real, intent (in), dimension (:, :) :: area !< cell area - real, intent (in), dimension (:, :) :: land !< land fraction - - real, intent (in), dimension (:, :, :) :: delp, dz, uin, vin, p - real, intent (in), dimension (:, :, :) :: pt, qv, ql, qr, qg, qa, qn - - real, intent (inout), dimension (:, :, :) :: qi, qs - real, intent (inout), dimension (:, :, :) :: pt_dt, qa_dt, udt, vdt, w - real, intent (inout), dimension (:, :, :) :: qv_dt, ql_dt, qr_dt - real, intent (inout), dimension (:, :, :) :: qi_dt, qs_dt, qg_dt - - real, intent (out), dimension (:, :, :) :: refl_10cm - real, intent (out), dimension (:, :) :: rain, snow, ice, graupel - - logical :: melti = .false. - ! logical :: used - - real :: mpdt, rdt, dts, convt, tot_prec - - integer :: i, j, k - integer :: is, ie, js, je !< physics window - integer :: ks, ke !< vertical dimension - integer :: days, ntimes, kflip - - real, dimension (iie - iis + 1, jje - jjs + 1) :: prec_mp, prec1, cond, w_var, rh0 - - real, dimension (iie - iis + 1, jje - jjs + 1, kke - kks + 1) :: vt_r, vt_s, vt_g, vt_i, qn2 - - real, dimension (size (pt, 1), size (pt, 3)) :: m2_rain, m2_sol - - real :: allmax -!+---+-----------------------------------------------------------------+ -!For 3D reflectivity calculations - REAL, DIMENSION(ktop:kbot):: qv1d, t1d, p1d, qr1d, qs1d, qg1d, dBZ -!+---+-----------------------------------------------------------------+ - - is = 1 - js = 1 - ks = 1 - ie = iie - iis + 1 - je = jje - jjs + 1 - ke = kke - kks + 1 - ! call mpp_clock_begin (gfdl_mp_clock) - - ! ----------------------------------------------------------------------- - ! define heat capacity of dry air and water vapor based on hydrostatical property - ! ----------------------------------------------------------------------- - - if (phys_hydrostatic .or. hydrostatic) then - c_air = cp_air - c_vap = cp_vap - p_nonhydro = .false. - else - c_air = cv_air - c_vap = cv_vap - p_nonhydro = .true. - endif - d0_vap = c_vap - c_liq - lv00 = hlv0 - d0_vap * t_ice - - if (hydrostatic) do_sedi_w = .false. - - ! ----------------------------------------------------------------------- - ! define latent heat coefficient used in wet bulb and bigg mechanism - ! ----------------------------------------------------------------------- - - latv = hlv - lati = hlf - lats = latv + lati - lat2 = lats * lats - - lcp = latv / cp_air - icp = lati / cp_air - tcp = (latv + lati) / cp_air - - ! tendency zero out for am moist processes should be done outside the driver - - ! ----------------------------------------------------------------------- - ! define cloud microphysics sub time step - ! ----------------------------------------------------------------------- - - mpdt = min (dt_in, mp_time) - rdt = 1. / dt_in - ntimes = nint (dt_in / mpdt) - - ! small time step: - dts = dt_in / real (ntimes) - - ! call get_time (time, seconds, days) - - ! ----------------------------------------------------------------------- - ! initialize precipitation - ! ----------------------------------------------------------------------- - - do j = js, je - do i = is, ie - graupel (i, j) = 0. - rain (i, j) = 0. - snow (i, j) = 0. - ice (i, j) = 0. - cond (i, j) = 0. - enddo - enddo - - ! ----------------------------------------------------------------------- - ! major cloud microphysics - ! ----------------------------------------------------------------------- - - do j = js, je - call mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, qg,& - qa, qn, dz, is, ie, js, je, ks, ke, ktop, kbot, j, dt_in, ntimes, & - rain (:, j), snow (:, j), graupel (:, j), ice (:, j), m2_rain, & - m2_sol, cond (:, j), area (:, j), land (:, j), udt, vdt, pt_dt, & - qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt, qa_dt, w_var, vt_r, & - vt_s, vt_g, vt_i, qn2) - enddo - - ! ----------------------------------------------------------------------- - ! no clouds allowed above ktop - ! ----------------------------------------------------------------------- - - if (ks < ktop) then - do k = ks, ktop - if (do_qa) then - do j = js, je - do i = is, ie - qa_dt (i, j, k) = 0. - enddo - enddo - else - do j = js, je - do i = is, ie - ! qa_dt (i, j, k) = - qa (i, j, k) * rdt - qa_dt (i, j, k) = 0. ! gfs - enddo - enddo - endif - enddo - endif - - ! ----------------------------------------------------------------------- - ! diagnostic output - ! ----------------------------------------------------------------------- - - ! if (id_vtr > 0) then - ! used = send_data (id_vtr, vt_r, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_vts > 0) then - ! used = send_data (id_vts, vt_s, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_vtg > 0) then - ! used = send_data (id_vtg, vt_g, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_vti > 0) then - ! used = send_data (id_vti, vt_i, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_droplets > 0) then - ! used = send_data (id_droplets, qn2, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_var > 0) then - ! used = send_data (id_var, w_var, time, is_in = iis, js_in = jjs) - ! endif - - ! convert to mm / day - - convt = 86400. * rdt * rgrav - do j = js, je - do i = is, ie - rain (i, j) = rain (i, j) * convt - snow (i, j) = snow (i, j) * convt - ice (i, j) = ice (i, j) * convt - graupel (i, j) = graupel (i, j) * convt - prec_mp (i, j) = rain (i, j) + snow (i, j) + ice (i, j) + graupel (i, j) - enddo - enddo - - ! if (id_cond > 0) then - ! do j = js, je - ! do i = is, ie - ! cond (i, j) = cond (i, j) * rgrav - ! enddo - ! enddo - ! used = send_data (id_cond, cond, time, is_in = iis, js_in = jjs) - ! endif - - ! if (id_snow > 0) then - ! used = send_data (id_snow, snow, time, iis, jjs) - ! used = send_data (id_snow, snow, time, is_in = iis, js_in = jjs) - ! if (mp_print .and. seconds == 0) then - ! tot_prec = g_sum (snow, is, ie, js, je, area, 1) - ! if (master) write (*, *) 'mean snow = ', tot_prec - ! endif - ! endif - ! - ! if (id_graupel > 0) then - ! used = send_data (id_graupel, graupel, time, iis, jjs) - ! used = send_data (id_graupel, graupel, time, is_in = iis, js_in = jjs) - ! if (mp_print .and. seconds == 0) then - ! tot_prec = g_sum (graupel, is, ie, js, je, area, 1) - ! if (master) write (*, *) 'mean graupel = ', tot_prec - ! endif - ! endif - ! - ! if (id_ice > 0) then - ! used = send_data (id_ice, ice, time, iis, jjs) - ! used = send_data (id_ice, ice, time, is_in = iis, js_in = jjs) - ! if (mp_print .and. seconds == 0) then - ! tot_prec = g_sum (ice, is, ie, js, je, area, 1) - ! if (master) write (*, *) 'mean ice_mp = ', tot_prec - ! endif - ! endif - ! - ! if (id_rain > 0) then - ! used = send_data (id_rain, rain, time, iis, jjs) - ! used = send_data (id_rain, rain, time, is_in = iis, js_in = jjs) - ! if (mp_print .and. seconds == 0) then - ! tot_prec = g_sum (rain, is, ie, js, je, area, 1) - ! if (master) write (*, *) 'mean rain = ', tot_prec - ! endif - ! endif - ! - ! if (id_rh > 0) then !not used? - ! used = send_data (id_rh, rh0, time, iis, jjs) - ! used = send_data (id_rh, rh0, time, is_in = iis, js_in = jjs) - ! endif - ! - ! - ! if (id_prec > 0) then - ! used = send_data (id_prec, prec_mp, time, iis, jjs) - ! used = send_data (id_prec, prec_mp, time, is_in = iis, js_in = jjs) - ! endif - - ! if (mp_print) then - ! prec1 (:, :) = prec1 (:, :) + prec_mp (:, :) - ! if (seconds == 0) then - ! prec1 (:, :) = prec1 (:, :) * dt_in / 86400. - ! tot_prec = g_sum (prec1, is, ie, js, je, area, 1) - ! if (master) write (*, *) 'daily prec_mp = ', tot_prec - ! prec1 (:, :) = 0. - ! endif - ! endif - - ! call mpp_clock_end (gfdl_mp_clock) - if(lradar) then - ! Only set melti to true at the output times - if (reset) then - melti = .true. - else - melti = .false. - endif - do j = js, je - do i = is, ie - do k = ktop,kbot - kflip = kbot-ktop+1-k+1 - t1d(k) = pt(i,j,kflip) - p1d(k) = p(i,j,kflip) - qv1d(k) = qv(i,j,kflip)/(1-qv(i,j,kflip)) - qr1d(k) = qr(i,j,kflip) - qs1d(k) = qs(i,j,kflip) - qg1d(k) = qg(i,j,kflip) - enddo - call refl10cm_gfdl (qv1d, qr1d, qs1d, qg1d, & - t1d, p1d, dBZ, ktop, kbot, i,j, melti) - do k = ktop,kbot - kflip = kbot-ktop+1-k+1 - refl_10cm(i,j,kflip) = MAX(-35., dBZ(k)) - enddo - enddo - enddo - endif - - -end subroutine gfdl_cloud_microphys_driver - -! ----------------------------------------------------------------------- -!>@brief gfdl cloud microphysics, major program -!>@details lin et al., 1983, jam, 1065 - 1092, and -!! rutledge and hobbs, 1984, jas, 2949 - 2972 -!! terminal fall is handled lagrangianly by conservative fv algorithm -!>@param pt: temperature (k) -!>@param 6 water species: -!>@param 1) qv: water vapor (kg / kg) -!>@param 2) ql: cloud water (kg / kg) -!>@param 3) qr: rain (kg / kg) -!>@param 4) qi: cloud ice (kg / kg) -!>@param 5) qs: snow (kg / kg) -!>@param 6) qg: graupel (kg / kg) -! ----------------------------------------------------------------------- -subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & - qg, qa, qn, dz, is, ie, js, je, ks, ke, ktop, kbot, j, dt_in, ntimes, & - rain, snow, graupel, ice, m2_rain, m2_sol, cond, area1, land, & - u_dt, v_dt, pt_dt, qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt, qa_dt, & - w_var, vt_r, vt_s, vt_g, vt_i, qn2) - - implicit none - - logical, intent (in) :: hydrostatic - - integer, intent (in) :: j, is, ie, js, je, ks, ke - integer, intent (in) :: ntimes, ktop, kbot - - real, intent (in) :: dt_in - - real, intent (in), dimension (is:) :: area1, land - - real, intent (in), dimension (is:, js:, ks:) :: uin, vin, delp, pt, dz - real, intent (in), dimension (is:, js:, ks:) :: qv, ql, qr, qg, qa, qn - - real, intent (inout), dimension (is:, js:, ks:) :: qi, qs - real, intent (inout), dimension (is:, js:, ks:) :: u_dt, v_dt, w, pt_dt, qa_dt - real, intent (inout), dimension (is:, js:, ks:) :: qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt - - real, intent (inout), dimension (is:) :: rain, snow, ice, graupel, cond - - real, intent (out), dimension (is:, js:) :: w_var - - real, intent (out), dimension (is:, js:, ks:) :: vt_r, vt_s, vt_g, vt_i, qn2 - - real, intent (out), dimension (is:, ks:) :: m2_rain, m2_sol - - real, dimension (ktop:kbot) :: qvz, qlz, qrz, qiz, qsz, qgz, qaz - real, dimension (ktop:kbot) :: vtiz, vtsz, vtgz, vtrz - real, dimension (ktop:kbot) :: dp0, dp1, dz0, dz1 - real, dimension (ktop:kbot) :: qv0, ql0, qr0, qi0, qs0, qg0, qa0 - real, dimension (ktop:kbot) :: t0, den, den0, tz, p1, denfac - real, dimension (ktop:kbot) :: ccn, c_praut, m1_rain, m1_sol, m1 - real, dimension (ktop:kbot) :: u0, v0, u1, v1, w1 - - real :: cpaut, rh_adj, rh_rain - real :: r1, s1, i1, g1, rdt, ccn0 - real :: dt_rain, dts - real :: s_leng, t_land, t_ocean, h_var - real :: cvm, tmp, omq - real :: dqi, qio, qin - - integer :: i, k, n - - dts = dt_in / real (ntimes) - dt_rain = dts * 0.5 - rdt = 1. / dt_in - - ! ----------------------------------------------------------------------- - ! use local variables - ! ----------------------------------------------------------------------- - - do i = is, ie - - do k = ktop, kbot - qiz (k) = qi (i, j, k) - qsz (k) = qs (i, j, k) - enddo - - ! ----------------------------------------------------------------------- - ! this is to prevent excessive build - up of cloud ice from external sources - ! ----------------------------------------------------------------------- - - if (de_ice) then - do k = ktop, kbot - qio = qiz (k) - dt_in * qi_dt (i, j, k) ! original qi before phys - qin = max (qio, qi0_max) ! adjusted value - if (qiz (k) > qin) then - qsz (k) = qsz (k) + qiz (k) - qin - qiz (k) = qin - dqi = (qin - qio) * rdt ! modified qi tendency - qs_dt (i, j, k) = qs_dt (i, j, k) + qi_dt (i, j, k) - dqi - qi_dt (i, j, k) = dqi - qi (i, j, k) = qiz (k) - qs (i, j, k) = qsz (k) - endif - enddo - endif - - do k = ktop, kbot - - t0 (k) = pt (i, j, k) - tz (k) = t0 (k) - dp1 (k) = delp (i, j, k) - dp0 (k) = dp1 (k) ! moist air mass * grav - - ! ----------------------------------------------------------------------- - ! convert moist mixing ratios to dry mixing ratios - ! ----------------------------------------------------------------------- - - qvz (k) = qv (i, j, k) - qlz (k) = ql (i, j, k) - qrz (k) = qr (i, j, k) - qgz (k) = qg (i, j, k) - - ! dp1: dry air_mass - ! dp1 (k) = dp1 (k) * (1. - (qvz (k) + qlz (k) + qrz (k) + qiz (k) + qsz (k) + qgz (k))) - dp1 (k) = dp1 (k) * (1. - qvz (k)) ! gfs - omq = dp0 (k) / dp1 (k) - - qvz (k) = qvz (k) * omq - qlz (k) = qlz (k) * omq - qrz (k) = qrz (k) * omq - qiz (k) = qiz (k) * omq - qsz (k) = qsz (k) * omq - qgz (k) = qgz (k) * omq - - qa0 (k) = qa (i, j, k) - qaz (k) = 0. - dz0 (k) = dz (i, j, k) - - den0 (k) = - dp1 (k) / (grav * dz0 (k)) ! density of dry air - p1 (k) = den0 (k) * rdgas * t0 (k) ! dry air pressure - - ! ----------------------------------------------------------------------- - ! save a copy of old value for computing tendencies - ! ----------------------------------------------------------------------- - - qv0 (k) = qvz (k) - ql0 (k) = qlz (k) - qr0 (k) = qrz (k) - qi0 (k) = qiz (k) - qs0 (k) = qsz (k) - qg0 (k) = qgz (k) - - ! ----------------------------------------------------------------------- - ! for sedi_momentum - ! ----------------------------------------------------------------------- - - m1 (k) = 0. - u0 (k) = uin (i, j, k) - v0 (k) = vin (i, j, k) - u1 (k) = u0 (k) - v1 (k) = v0 (k) - - enddo - - if (do_sedi_w) then - do k = ktop, kbot - w1 (k) = w (i, j, k) - enddo - endif - - ! ----------------------------------------------------------------------- - ! calculate cloud condensation nuclei (ccn) - ! the following is based on klein eq. 15 - ! ----------------------------------------------------------------------- - - cpaut = c_paut * 0.104 * grav / 1.717e-5 - - if (prog_ccn) then - do k = ktop, kbot - ! convert # / cc to # / m^3 - ccn (k) = qn (i, j, k) * 1.e6 - c_praut (k) = cpaut * (ccn (k) * rhor) ** (- 1. / 3.) - enddo - use_ccn = .false. - else - ccn0 = (ccn_l * land (i) + ccn_o * (1. - land (i))) * 1.e6 - if (use_ccn) then - ! ----------------------------------------------------------------------- - ! ccn is formulted as ccn = ccn_surface * (den / den_surface) - ! ----------------------------------------------------------------------- - ccn0 = ccn0 * rdgas * tz (kbot) / p1 (kbot) - endif - tmp = cpaut * (ccn0 * rhor) ** (- 1. / 3.) - do k = ktop, kbot - c_praut (k) = tmp - ccn (k) = ccn0 - enddo - endif - - ! ----------------------------------------------------------------------- - ! calculate horizontal subgrid variability - ! total water subgrid deviation in horizontal direction - ! default area dependent form: use dx ~ 100 km as the base - ! ----------------------------------------------------------------------- - - s_leng = sqrt (sqrt (area1 (i) / 1.e10)) - t_land = dw_land * s_leng - t_ocean = dw_ocean * s_leng - h_var = t_land * land (i) + t_ocean * (1. - land (i)) - h_var = min (0.20, max (0.01, h_var)) - ! if (id_var > 0) w_var (i, j) = h_var - - ! ----------------------------------------------------------------------- - ! relative humidity increment - ! ----------------------------------------------------------------------- - - rh_adj = 1. - h_var - rh_inc - rh_rain = max (0.35, rh_adj - rh_inr) ! rh_inr = 0.25 - - ! ----------------------------------------------------------------------- - ! fix all negative water species - ! ----------------------------------------------------------------------- - - if (fix_negative) & - call neg_adj (ktop, kbot, tz, dp1, qvz, qlz, qrz, qiz, qsz, qgz) - - m2_rain (i, :) = 0. - m2_sol (i, :) = 0. - - do n = 1, ntimes - - ! ----------------------------------------------------------------------- - ! define air density based on hydrostatical property - ! ----------------------------------------------------------------------- - - if (p_nonhydro) then - do k = ktop, kbot - dz1 (k) = dz0 (k) - den (k) = den0 (k) ! dry air density remains the same - denfac (k) = sqrt (sfcrho / den (k)) - enddo - else - do k = ktop, kbot - dz1 (k) = dz0 (k) * tz (k) / t0 (k) ! hydrostatic balance - den (k) = den0 (k) * dz0 (k) / dz1 (k) - denfac (k) = sqrt (sfcrho / den (k)) - enddo - endif - - ! ----------------------------------------------------------------------- - ! time - split warm rain processes: 1st pass - ! ----------------------------------------------------------------------- - - call warm_rain (dt_rain, ktop, kbot, dp1, dz1, tz, qvz, qlz, qrz, qiz, qsz, & - qgz, den, denfac, ccn, c_praut, rh_rain, vtrz, r1, m1_rain, w1, h_var) - - rain (i) = rain (i) + r1 - - do k = ktop, kbot - m2_rain (i, k) = m2_rain (i, k) + m1_rain (k) - m1 (k) = m1 (k) + m1_rain (k) - enddo - - ! ----------------------------------------------------------------------- - ! sedimentation of cloud ice, snow, and graupel - ! ----------------------------------------------------------------------- - - call fall_speed (ktop, kbot, den, qsz, qiz, qgz, qlz, tz, vtsz, vtiz, vtgz) - - call terminal_fall (dts, ktop, kbot, tz, qvz, qlz, qrz, qgz, qsz, qiz, & - dz1, dp1, den, vtgz, vtsz, vtiz, r1, g1, s1, i1, m1_sol, w1) - - rain (i) = rain (i) + r1 ! from melted snow & ice that reached the ground - snow (i) = snow (i) + s1 - graupel (i) = graupel (i) + g1 - ice (i) = ice (i) + i1 - - ! ----------------------------------------------------------------------- - ! heat transportation during sedimentation - ! ----------------------------------------------------------------------- - - if (do_sedi_heat) & - call sedi_heat (ktop, kbot, dp1, m1_sol, dz1, tz, qvz, qlz, qrz, qiz, & - qsz, qgz, c_ice) - - ! ----------------------------------------------------------------------- - ! time - split warm rain processes: 2nd pass - ! ----------------------------------------------------------------------- - - call warm_rain (dt_rain, ktop, kbot, dp1, dz1, tz, qvz, qlz, qrz, qiz, qsz, & - qgz, den, denfac, ccn, c_praut, rh_rain, vtrz, r1, m1_rain, w1, h_var) - - rain (i) = rain (i) + r1 - - do k = ktop, kbot - m2_rain (i, k) = m2_rain (i, k) + m1_rain (k) - m2_sol (i, k) = m2_sol (i, k) + m1_sol (k) - m1 (k) = m1 (k) + m1_rain (k) + m1_sol (k) - enddo - - ! ----------------------------------------------------------------------- - ! ice - phase microphysics - ! ----------------------------------------------------------------------- - - call icloud (ktop, kbot, tz, p1, qvz, qlz, qrz, qiz, qsz, qgz, dp1, den, & - denfac, vtsz, vtgz, vtrz, qaz, rh_adj, rh_rain, dts, h_var) - - enddo - - ! convert units from Pa*kg/kg to kg/m^2/s - m2_rain (i, :) = m2_rain (i, :) * rdt * rgrav - m2_sol (i, :) = m2_sol (i, :) * rdt * rgrav - - ! ----------------------------------------------------------------------- - ! momentum transportation during sedimentation - ! note: dp1 is dry mass; dp0 is the old moist (total) mass - ! ----------------------------------------------------------------------- - - if (sedi_transport) then - do k = ktop + 1, kbot - u1 (k) = (dp0 (k) * u1 (k) + m1 (k - 1) * u1 (k - 1)) / (dp0 (k) + m1 (k - 1)) - v1 (k) = (dp0 (k) * v1 (k) + m1 (k - 1) * v1 (k - 1)) / (dp0 (k) + m1 (k - 1)) - u_dt (i, j, k) = u_dt (i, j, k) + (u1 (k) - u0 (k)) * rdt - v_dt (i, j, k) = v_dt (i, j, k) + (v1 (k) - v0 (k)) * rdt - enddo - endif - - if (do_sedi_w) then - do k = ktop, kbot - w (i, j, k) = w1 (k) - enddo - endif - - ! ----------------------------------------------------------------------- - ! update moist air mass (actually hydrostatic pressure) - ! convert to dry mixing ratios - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - omq = dp1 (k) / dp0 (k) - qv_dt (i, j, k) = qv_dt (i, j, k) + rdt * (qvz (k) - qv0 (k)) * omq - ql_dt (i, j, k) = ql_dt (i, j, k) + rdt * (qlz (k) - ql0 (k)) * omq - qr_dt (i, j, k) = qr_dt (i, j, k) + rdt * (qrz (k) - qr0 (k)) * omq - qi_dt (i, j, k) = qi_dt (i, j, k) + rdt * (qiz (k) - qi0 (k)) * omq - qs_dt (i, j, k) = qs_dt (i, j, k) + rdt * (qsz (k) - qs0 (k)) * omq - qg_dt (i, j, k) = qg_dt (i, j, k) + rdt * (qgz (k) - qg0 (k)) * omq - cvm = c_air + qvz (k) * c_vap + (qrz (k) + qlz (k)) * c_liq + (qiz (k) + qsz (k) + qgz (k)) * c_ice - pt_dt (i, j, k) = pt_dt (i, j, k) + rdt * (tz (k) - t0 (k)) * cvm / cp_air - enddo - - ! ----------------------------------------------------------------------- - ! update cloud fraction tendency - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - if (do_qa) then - qa_dt (i, j, k) = 0. - else - qa_dt (i, j, k) = qa_dt (i, j, k) + rdt * (qaz (k) / real (ntimes) - qa0 (k)) - endif - enddo - - ! ----------------------------------------------------------------------- - ! fms diagnostics: - ! ----------------------------------------------------------------------- - - ! if (id_cond > 0) then - ! do k = ktop, kbot ! total condensate - ! cond (i) = cond (i) + dp1 (k) * (qlz (k) + qrz (k) + qsz (k) + qiz (k) + qgz (k)) - ! enddo - ! endif - ! - ! if (id_vtr > 0) then - ! do k = ktop, kbot - ! vt_r (i, j, k) = vtrz (k) - ! enddo - ! endif - ! - ! if (id_vts > 0) then - ! do k = ktop, kbot - ! vt_s (i, j, k) = vtsz (k) - ! enddo - ! endif - ! - ! if (id_vtg > 0) then - ! do k = ktop, kbot - ! vt_g (i, j, k) = vtgz (k) - ! enddo - ! endif - ! - ! if (id_vts > 0) then - ! do k = ktop, kbot - ! vt_i (i, j, k) = vtiz (k) - ! enddo - ! endif - ! - ! if (id_droplets > 0) then - ! do k = ktop, kbot - ! qn2 (i, j, k) = ccn (k) - ! enddo - ! endif - - enddo - -end subroutine mpdrv - -! ----------------------------------------------------------------------- -!> sedimentation of heat -! ----------------------------------------------------------------------- - -subroutine sedi_heat (ktop, kbot, dm, m1, dz, tz, qv, ql, qr, qi, qs, qg, cw) - - implicit none - - ! input q fields are dry mixing ratios, and dm is dry air mass - - integer, intent (in) :: ktop, kbot - - real, intent (in), dimension (ktop:kbot) :: dm, m1, dz, qv, ql, qr, qi, qs, qg - - real, intent (inout), dimension (ktop:kbot) :: tz - - real, intent (in) :: cw ! heat capacity - - real, dimension (ktop:kbot) :: dgz, cvn - - real :: tmp - - integer :: k - - do k = ktop, kbot - dgz (k) = - 0.5 * grav * dz (k) ! > 0 - cvn (k) = dm (k) * (cv_air + qv (k) * cv_vap + (qr (k) + ql (k)) * & - c_liq + (qi (k) + qs (k) + qg (k)) * c_ice) - enddo - - ! ----------------------------------------------------------------------- - ! sjl, july 2014 - ! assumption: the ke in the falling condensates is negligible compared to the potential energy - ! that was unaccounted for. local thermal equilibrium is assumed, and the loss in pe is transformed - ! into internal energy (to heat the whole grid box) - ! backward time - implicit upwind transport scheme: - ! dm here is dry air mass - ! ----------------------------------------------------------------------- - - k = ktop - tmp = cvn (k) + m1 (k) * cw - tz (k) = (tmp * tz (k) + m1 (k) * dgz (k)) / tmp - - ! ----------------------------------------------------------------------- - ! implicit algorithm: can't be vectorized - ! needs an inner i - loop for vectorization - ! ----------------------------------------------------------------------- - - do k = ktop + 1, kbot - tz (k) = ((cvn (k) + cw * (m1 (k) - m1 (k - 1))) * tz (k) + m1 (k - 1) * & - cw * tz (k - 1) + dgz (k) * (m1 (k - 1) + m1 (k))) / (cvn (k) + cw * m1 (k)) - enddo - -end subroutine sedi_heat - -! ----------------------------------------------------------------------- -!> warm rain cloud microphysics -! ----------------------------------------------------------------------- - -subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & - den, denfac, ccn, c_praut, rh_rain, vtr, r1, m1_rain, w1, h_var) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in) :: dt !< time step (s) - real, intent (in) :: rh_rain, h_var - - real, intent (in), dimension (ktop:kbot) :: dp, dz, den - real, intent (in), dimension (ktop:kbot) :: denfac, ccn, c_praut - - real, intent (inout), dimension (ktop:kbot) :: tz, vtr - real, intent (inout), dimension (ktop:kbot) :: qv, ql, qr, qi, qs, qg - real, intent (inout), dimension (ktop:kbot) :: m1_rain, w1 - - real, intent (out) :: r1 - - real, parameter :: so3 = 7. / 3. - - real, dimension (ktop:kbot) :: dl, dm - real, dimension (ktop:kbot + 1) :: ze, zt - - real :: sink, dq, qc0, qc - real :: qden - real :: zs = 0. - real :: dt5 - - integer :: k - - ! fall velocity constants: - - real, parameter :: vconr = 2503.23638966667 - real, parameter :: normr = 25132741228.7183 - real, parameter :: thr = 1.e-8 - - logical :: no_fall - - dt5 = 0.5 * dt - - ! ----------------------------------------------------------------------- - ! terminal speed of rain - ! ----------------------------------------------------------------------- - - m1_rain (:) = 0. - - call check_column (ktop, kbot, qr, no_fall) - - if (no_fall) then - vtr (:) = vf_min - r1 = 0. - else - - ! ----------------------------------------------------------------------- - ! fall speed of rain - ! ----------------------------------------------------------------------- - - if (const_vr) then - vtr (:) = vr_fac ! ifs_2016: 4.0 - else - do k = ktop, kbot - qden = qr (k) * den (k) - if (qr (k) < thr) then - vtr (k) = vr_min - else - vtr (k) = vr_fac * vconr * sqrt (min (10., sfcrho / den (k))) * & - exp (0.2 * log (qden / normr)) - vtr (k) = min (vr_max, max (vr_min, vtr (k))) - endif - enddo - endif - - ze (kbot + 1) = zs - do k = kbot, ktop, - 1 - ze (k) = ze (k + 1) - dz (k) ! dz < 0 - enddo - - ! ----------------------------------------------------------------------- - ! evaporation and accretion of rain for the first 1 / 2 time step - ! ----------------------------------------------------------------------- - - ! if (.not. fast_sat_adj) & - call revap_racc (ktop, kbot, dt5, tz, qv, ql, qr, qi, qs, qg, den, denfac, rh_rain, h_var) - - if (do_sedi_w) then - do k = ktop, kbot - dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) - enddo - endif - - ! ----------------------------------------------------------------------- - ! mass flux induced by falling rain - ! ----------------------------------------------------------------------- - - if (use_ppm) then - zt (ktop) = ze (ktop) - do k = ktop + 1, kbot - zt (k) = ze (k) - dt5 * (vtr (k - 1) + vtr (k)) - enddo - zt (kbot + 1) = zs - dt * vtr (kbot) - - do k = ktop, kbot - if (zt (k + 1) >= zt (k)) zt (k + 1) = zt (k) - dz_min - enddo - call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qr, r1, m1_rain, mono_prof) - else - call implicit_fall (dt, ktop, kbot, ze, vtr, dp, qr, r1, m1_rain) - endif - - ! ----------------------------------------------------------------------- - ! vertical velocity transportation during sedimentation - ! ----------------------------------------------------------------------- - - if (do_sedi_w) then - w1 (ktop) = (dm (ktop) * w1 (ktop) + m1_rain (ktop) * vtr (ktop)) / (dm (ktop) - m1_rain (ktop)) - do k = ktop + 1, kbot - w1 (k) = (dm (k) * w1 (k) - m1_rain (k - 1) * vtr (k - 1) + m1_rain (k) * vtr (k)) & - / (dm (k) + m1_rain (k - 1) - m1_rain (k)) - enddo - endif - - ! ----------------------------------------------------------------------- - ! heat transportation during sedimentation - ! ----------------------------------------------------------------------- - - if (do_sedi_heat) & - call sedi_heat (ktop, kbot, dp, m1_rain, dz, tz, qv, ql, qr, qi, qs, qg, c_liq) - - ! ----------------------------------------------------------------------- - ! evaporation and accretion of rain for the remaing 1 / 2 time step - ! ----------------------------------------------------------------------- - - call revap_racc (ktop, kbot, dt5, tz, qv, ql, qr, qi, qs, qg, den, denfac, rh_rain, h_var) - - endif - - ! ----------------------------------------------------------------------- - ! auto - conversion - ! assuming linear subgrid vertical distribution of cloud water - ! following lin et al. 1994, mwr - ! ----------------------------------------------------------------------- - - if (irain_f /= 0) then - - ! ----------------------------------------------------------------------- - ! no subgrid varaibility - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - qc0 = fac_rc * ccn (k) - if (tz (k) > t_wfr) then - if (use_ccn) then - ! ----------------------------------------------------------------------- - ! ccn is formulted as ccn = ccn_surface * (den / den_surface) - ! ----------------------------------------------------------------------- - qc = qc0 - else - qc = qc0 / den (k) - endif - dq = ql (k) - qc - if (dq > 0.) then - sink = min (dq, dt * c_praut (k) * den (k) * exp (so3 * log (ql (k)))) - ql (k) = ql (k) - sink - qr (k) = qr (k) + sink - endif - endif - enddo - - else - - ! ----------------------------------------------------------------------- - ! with subgrid varaibility - ! ----------------------------------------------------------------------- - - call linear_prof (kbot - ktop + 1, ql (ktop), dl (ktop), z_slope_liq, h_var) - - do k = ktop, kbot - qc0 = fac_rc * ccn (k) - if (tz (k) > t_wfr + dt_fr) then - dl (k) = min (max (1.e-6, dl (k)), 0.5 * ql (k)) - ! -------------------------------------------------------------------- - ! as in klein's gfdl am2 stratiform scheme (with subgrid variations) - ! -------------------------------------------------------------------- - if (use_ccn) then - ! -------------------------------------------------------------------- - ! ccn is formulted as ccn = ccn_surface * (den / den_surface) - ! -------------------------------------------------------------------- - qc = qc0 - else - qc = qc0 / den (k) - endif - dq = 0.5 * (ql (k) + dl (k) - qc) - ! -------------------------------------------------------------------- - ! dq = dl if qc == q_minus = ql - dl - ! dq = 0 if qc == q_plus = ql + dl - ! -------------------------------------------------------------------- - if (dq > 0.) then ! q_plus > qc - ! -------------------------------------------------------------------- - ! revised continuous form: linearly decays (with subgrid dl) to zero at qc == ql + dl - ! -------------------------------------------------------------------- - sink = min (1., dq / dl (k)) * dt * c_praut (k) * den (k) * exp (so3 * log (ql (k))) - ql (k) = ql (k) - sink - qr (k) = qr (k) + sink - endif - endif - enddo - endif - -end subroutine warm_rain - -! ----------------------------------------------------------------------- -!> evaporation of rain -! ----------------------------------------------------------------------- - -subroutine revap_racc (ktop, kbot, dt, tz, qv, ql, qr, qi, qs, qg, den, denfac, rh_rain, h_var) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in) :: dt ! time step (s) - real, intent (in) :: rh_rain, h_var - - real, intent (in), dimension (ktop:kbot) :: den, denfac - - real, intent (inout), dimension (ktop:kbot) :: tz, qv, qr, ql, qi, qs, qg - - real, dimension (ktop:kbot) :: lhl, cvm, q_liq, q_sol, lcpk - - real :: dqv, qsat, dqsdt, evap, t2, qden, q_plus, q_minus, sink - real :: qpz, dq, dqh, tin - - integer :: k - - do k = ktop, kbot - - if (tz (k) > t_wfr .and. qr (k) > qrmin) then - - ! ----------------------------------------------------------------------- - ! define heat capacity and latent heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - q_liq (k) = ql (k) + qr (k) - q_sol (k) = qi (k) + qs (k) + qg (k) - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - lcpk (k) = lhl (k) / cvm (k) - - tin = tz (k) - lcpk (k) * ql (k) ! presence of clouds suppresses the rain evap - qpz = qv (k) + ql (k) - qsat = wqs2 (tin, den (k), dqsdt) - dqh = max (ql (k), h_var * max (qpz, qcmin)) - dqh = min (dqh, 0.2 * qpz) ! new limiter - dqv = qsat - qv (k) ! use this to prevent super - sat the gird box - q_minus = qpz - dqh - q_plus = qpz + dqh - - ! ----------------------------------------------------------------------- - ! qsat must be > q_minus to activate evaporation - ! qsat must be < q_plus to activate accretion - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! rain evaporation - ! ----------------------------------------------------------------------- - - if (dqv > qvmin .and. qsat > q_minus) then - if (qsat > q_plus) then - dq = qsat - qpz - else - ! ----------------------------------------------------------------------- - ! q_minus < qsat < q_plus - ! dq == dqh if qsat == q_minus - ! ----------------------------------------------------------------------- - dq = 0.25 * (q_minus - qsat) ** 2 / dqh - endif - qden = qr (k) * den (k) - t2 = tin * tin - evap = crevp (1) * t2 * dq * (crevp (2) * sqrt (qden) + crevp (3) * & - exp (0.725 * log (qden))) / (crevp (4) * t2 + crevp (5) * qsat * den (k)) - evap = min (qr (k), dt * evap, dqv / (1. + lcpk (k) * dqsdt)) - ! ----------------------------------------------------------------------- - ! alternative minimum evap in dry environmental air - ! sink = min (qr (k), dim (rh_rain * qsat, qv (k)) / (1. + lcpk (k) * dqsdt)) - ! evap = max (evap, sink) - ! ----------------------------------------------------------------------- - qr (k) = qr (k) - evap - qv (k) = qv (k) + evap - q_liq (k) = q_liq (k) - evap - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) - evap * lhl (k) / cvm (k) - endif - - ! ----------------------------------------------------------------------- - ! accretion: pracc - ! ----------------------------------------------------------------------- - - ! if (qr (k) > qrmin .and. ql (k) > 1.e-7 .and. qsat < q_plus) then - if (qr (k) > qrmin .and. ql (k) > 1.e-6 .and. qsat < q_minus) then - sink = dt * denfac (k) * cracw * exp (0.95 * log (qr (k) * den (k))) - sink = sink / (1. + sink) * ql (k) - ql (k) = ql (k) - sink - qr (k) = qr (k) + sink - endif - - endif ! warm - rain - enddo - -end subroutine revap_racc - -! ----------------------------------------------------------------------- -!> definition of vertical subgrid variability -!! used for cloud ice and cloud water autoconversion -!! qi -- > ql & ql -- > qr -!! edges: qe == qbar + / - dm -! ----------------------------------------------------------------------- - -subroutine linear_prof (km, q, dm, z_var, h_var) - - implicit none - - integer, intent (in) :: km - - real, intent (in) :: q (km), h_var - - real, intent (out) :: dm (km) - - logical, intent (in) :: z_var - - real :: dq (km) - - integer :: k - - if (z_var) then - do k = 2, km - dq (k) = 0.5 * (q (k) - q (k - 1)) - enddo - dm (1) = 0. - - ! ----------------------------------------------------------------------- - ! use twice the strength of the positive definiteness limiter (lin et al 1994) - ! ----------------------------------------------------------------------- - - do k = 2, km - 1 - dm (k) = 0.5 * min (abs (dq (k) + dq (k + 1)), 0.5 * q (k)) - if (dq (k) * dq (k + 1) <= 0.) then - if (dq (k) > 0.) then ! local max - dm (k) = min (dm (k), dq (k), - dq (k + 1)) - else - dm (k) = 0. - endif - endif - enddo - dm (km) = 0. - - ! ----------------------------------------------------------------------- - ! impose a presumed background horizontal variability that is proportional to the value itself - ! ----------------------------------------------------------------------- - - do k = 1, km - dm (k) = max (dm (k), qvmin, h_var * q (k)) - enddo - else - do k = 1, km - dm (k) = max (qvmin, h_var * q (k)) - enddo - endif - -end subroutine linear_prof - -! ======================================================================= -!> ice cloud microphysics processes -!! bulk cloud micro - physics; processes splitting -!! with some un - split sub - grouping -!! time implicit (when possible) accretion and autoconversion -!>@author: Shian-Jiann lin, gfdl -! ======================================================================= - -subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & - den, denfac, vts, vtg, vtr, qak, rh_adj, rh_rain, dts, h_var) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in), dimension (ktop:kbot) :: p1, dp1, den, denfac, vts, vtg, vtr - - real, intent (inout), dimension (ktop:kbot) :: tzk, qvk, qlk, qrk, qik, qsk, qgk, qak - - real, intent (in) :: rh_adj, rh_rain, dts, h_var - - real, dimension (ktop:kbot) :: lcpk, icpk, tcpk, di, lhl, lhi - real, dimension (ktop:kbot) :: cvm, q_liq, q_sol - - real :: rdts, fac_g2v, fac_v2g, fac_i2s, fac_imlt - real :: tz, qv, ql, qr, qi, qs, qg, melt - real :: pracs, psacw, pgacw, psacr, pgacr, pgaci, praci, psaci - real :: pgmlt, psmlt, pgfr, pgaut, psaut, pgsub - real :: tc, tsq, dqs0, qden, qim, qsm - real :: dt5, factor, sink, qi_crt - real :: tmp, qsw, qsi, dqsdt, dq - real :: dtmp, qc, q_plus, q_minus - - integer :: k - - dt5 = 0.5 * dts - - rdts = 1. / dts - - ! ----------------------------------------------------------------------- - ! define conversion scalar / factor - ! ----------------------------------------------------------------------- - - fac_i2s = 1. - exp (- dts / tau_i2s) - fac_g2v = 1. - exp (- dts / tau_g2v) - fac_v2g = 1. - exp (- dts / tau_v2g) - - fac_imlt = 1. - exp (- dt5 / tau_imlt) - - ! ----------------------------------------------------------------------- - ! define heat capacity and latend heat coefficient - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - lhi (k) = li00 + dc_ice * tzk (k) - q_liq (k) = qlk (k) + qrk (k) - q_sol (k) = qik (k) + qsk (k) + qgk (k) - cvm (k) = c_air + qvk (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - icpk (k) = lhi (k) / cvm (k) - enddo - - ! ----------------------------------------------------------------------- - ! sources of cloud ice: pihom, cold rain, and the sat_adj - ! (initiation plus deposition) - ! sources of snow: cold rain, auto conversion + accretion (from cloud ice) - ! sat_adj (deposition; requires pre - existing snow) ; initial snow comes from auto conversion - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - if (tzk (k) > tice .and. qik (k) > qcmin) then - - ! ----------------------------------------------------------------------- - ! pimlt: instant melting of cloud ice - ! ----------------------------------------------------------------------- - - melt = min (qik (k), fac_imlt * (tzk (k) - tice) / icpk (k)) - tmp = min (melt, dim (ql_mlt, qlk (k))) ! max ql amount - qlk (k) = qlk (k) + tmp - qrk (k) = qrk (k) + melt - tmp - qik (k) = qik (k) - melt - q_liq (k) = q_liq (k) + melt - q_sol (k) = q_sol (k) - melt - cvm (k) = c_air + qvk (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tzk (k) = tzk (k) - melt * lhi (k) / cvm (k) - - elseif (tzk (k) < t_wfr .and. qlk (k) > qcmin) then - - ! ----------------------------------------------------------------------- - ! pihom: homogeneous freezing of cloud water into cloud ice - ! this is the 1st occurance of liquid water freezing in the split mp process - ! ----------------------------------------------------------------------- - - dtmp = t_wfr - tzk (k) - factor = min (1., dtmp / dt_fr) - sink = min (qlk (k) * factor, dtmp / icpk (k)) - qi_crt = qi_gen * min (qi_lim, 0.1 * (tice - tzk (k))) / den (k) - tmp = min (sink, dim (qi_crt, qik (k))) - qlk (k) = qlk (k) - sink - qsk (k) = qsk (k) + sink - tmp - qik (k) = qik (k) + tmp - q_liq (k) = q_liq (k) - sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qvk (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tzk (k) = tzk (k) + sink * lhi (k) / cvm (k) - - endif - enddo - - ! ----------------------------------------------------------------------- - ! vertical subgrid variability - ! ----------------------------------------------------------------------- - - call linear_prof (kbot - ktop + 1, qik (ktop), di (ktop), z_slope_ice, h_var) - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - lhl (k) = lv00 + d0_vap * tzk (k) - lhi (k) = li00 + dc_ice * tzk (k) - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - tcpk (k) = lcpk (k) + icpk (k) - enddo - - do k = ktop, kbot - - ! ----------------------------------------------------------------------- - ! do nothing above p_min - ! ----------------------------------------------------------------------- - - if (p1 (k) < p_min) cycle - - tz = tzk (k) - qv = qvk (k) - ql = qlk (k) - qi = qik (k) - qr = qrk (k) - qs = qsk (k) - qg = qgk (k) - - pgacr = 0. - pgacw = 0. - tc = tz - tice - - if (tc .ge. 0.) then - - ! ----------------------------------------------------------------------- - ! melting of snow - ! ----------------------------------------------------------------------- - - dqs0 = ces0 / p1 (k) - qv - - if (qs > qcmin) then - - ! ----------------------------------------------------------------------- - ! psacw: accretion of cloud water by snow - ! only rate is used (for snow melt) since tc > 0. - ! ----------------------------------------------------------------------- - - if (ql > qrmin) then - factor = denfac (k) * csacw * exp (0.8125 * log (qs * den (k))) - psacw = factor / (1. + dts * factor) * ql ! rate - else - psacw = 0. - endif - - ! ----------------------------------------------------------------------- - ! psacr: accretion of rain by melted snow - ! pracs: accretion of snow by rain - ! ----------------------------------------------------------------------- - - if (qr > qrmin) then - psacr = min (acr3d (vts (k), vtr (k), qr, qs, csacr, acco (1, 2), & - den (k)), qr * rdts) - pracs = acr3d (vtr (k), vts (k), qs, qr, cracs, acco (1, 1), den (k)) - else - psacr = 0. - pracs = 0. - endif - - ! ----------------------------------------------------------------------- - ! total snow sink: - ! psmlt: snow melt (due to rain accretion) - ! ----------------------------------------------------------------------- - - psmlt = max (0., smlt (tc, dqs0, qs * den (k), psacw, psacr, csmlt, & - den (k), denfac (k))) - sink = min (qs, dts * (psmlt + pracs), tc / icpk (k)) - qs = qs - sink - ! sjl, 20170321: - tmp = min (sink, dim (qs_mlt, ql)) ! max ql due to snow melt - ql = ql + tmp - qr = qr + sink - tmp - ! qr = qr + sink - ! sjl, 20170321: - q_liq (k) = q_liq (k) + sink - q_sol (k) = q_sol (k) - sink - cvm (k) = c_air + qv * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz = tz - sink * lhi (k) / cvm (k) - tc = tz - tice - - endif - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhi (k) = li00 + dc_ice * tz - icpk (k) = lhi (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! melting of graupel - ! ----------------------------------------------------------------------- - - if (qg > qcmin .and. tc > 0.) then - - ! ----------------------------------------------------------------------- - ! pgacr: accretion of rain by graupel - ! ----------------------------------------------------------------------- - - if (qr > qrmin) & - pgacr = min (acr3d (vtg (k), vtr (k), qr, qg, cgacr, acco (1, 3), & - den (k)), rdts * qr) - - ! ----------------------------------------------------------------------- - ! pgacw: accretion of cloud water by graupel - ! ----------------------------------------------------------------------- - - qden = qg * den (k) - if (ql > qrmin) then - factor = cgacw * qden / sqrt (den (k) * sqrt (sqrt (qden))) - pgacw = factor / (1. + dts * factor) * ql ! rate - endif - - ! ----------------------------------------------------------------------- - ! pgmlt: graupel melt - ! ----------------------------------------------------------------------- - - pgmlt = dts * gmlt (tc, dqs0, qden, pgacw, pgacr, cgmlt, den (k)) - pgmlt = min (max (0., pgmlt), qg, tc / icpk (k)) - qg = qg - pgmlt - qr = qr + pgmlt - q_liq (k) = q_liq (k) + pgmlt - q_sol (k) = q_sol (k) - pgmlt - cvm (k) = c_air + qv * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz = tz - pgmlt * lhi (k) / cvm (k) - - endif - - else - - ! ----------------------------------------------------------------------- - ! cloud ice proc: - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! psaci: accretion of cloud ice by snow - ! ----------------------------------------------------------------------- - - if (qi > 3.e-7) then ! cloud ice sink terms - - if (qs > 1.e-7) then - ! ----------------------------------------------------------------------- - ! sjl added (following lin eq. 23) the temperature dependency - ! to reduce accretion, use esi = exp (0.05 * tc) as in hong et al 2004 - ! ----------------------------------------------------------------------- - factor = dts * denfac (k) * csaci * exp (0.05 * tc + 0.8125 * log (qs * den (k))) - psaci = factor / (1. + factor) * qi - else - psaci = 0. - endif - - ! ----------------------------------------------------------------------- - ! pasut: autoconversion: cloud ice -- > snow - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! similar to lfo 1983: eq. 21 solved implicitly - ! threshold from wsm6 scheme, hong et al 2004, eq (13) : qi0_crt ~0.8e-4 - ! ----------------------------------------------------------------------- - - qim = qi0_crt / den (k) - - ! ----------------------------------------------------------------------- - ! assuming linear subgrid vertical distribution of cloud ice - ! the mismatch computation following lin et al. 1994, mwr - ! ----------------------------------------------------------------------- - - if (const_vi) then - tmp = fac_i2s - else - tmp = fac_i2s * exp (0.025 * tc) - endif - - di (k) = max (di (k), qrmin) - q_plus = qi + di (k) - if (q_plus > (qim + qrmin)) then - if (qim > (qi - di (k))) then - dq = (0.25 * (q_plus - qim) ** 2) / di (k) - else - dq = qi - qim - endif - psaut = tmp * dq - else - psaut = 0. - endif - ! ----------------------------------------------------------------------- - ! sink is no greater than 75% of qi - ! ----------------------------------------------------------------------- - sink = min (0.75 * qi, psaci + psaut) - qi = qi - sink - qs = qs + sink - - ! ----------------------------------------------------------------------- - ! pgaci: accretion of cloud ice by graupel - ! ----------------------------------------------------------------------- - - if (qg > 1.e-6) then - ! ----------------------------------------------------------------------- - ! factor = dts * cgaci / sqrt (den (k)) * exp (0.05 * tc + 0.875 * log (qg * den (k))) - ! simplified form: remove temp dependency & set the exponent "0.875" -- > 1 - ! ----------------------------------------------------------------------- - factor = dts * cgaci * sqrt (den (k)) * qg - pgaci = factor / (1. + factor) * qi - qi = qi - pgaci - qg = qg + pgaci - endif - - endif - - ! ----------------------------------------------------------------------- - ! cold - rain proc: - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! rain to ice, snow, graupel processes: - ! ----------------------------------------------------------------------- - - tc = tz - tice - - if (qr > 1.e-7 .and. tc < 0.) then - - ! ----------------------------------------------------------------------- - ! * sink * terms to qr: psacr + pgfr - ! source terms to qs: psacr - ! source terms to qg: pgfr - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! psacr accretion of rain by snow - ! ----------------------------------------------------------------------- - - if (qs > 1.e-7) then ! if snow exists - psacr = dts * acr3d (vts (k), vtr (k), qr, qs, csacr, acco (1, 2), den (k)) - else - psacr = 0. - endif - - ! ----------------------------------------------------------------------- - ! pgfr: rain freezing -- > graupel - ! ----------------------------------------------------------------------- - - pgfr = dts * cgfr (1) / den (k) * (exp (- cgfr (2) * tc) - 1.) * & - exp (1.75 * log (qr * den (k))) - - ! ----------------------------------------------------------------------- - ! total sink to qr - ! ----------------------------------------------------------------------- - - sink = psacr + pgfr - factor = min (sink, qr, - tc / icpk (k)) / max (sink, qrmin) - - psacr = factor * psacr - pgfr = factor * pgfr - - sink = psacr + pgfr - qr = qr - sink - qs = qs + psacr - qg = qg + pgfr - q_liq (k) = q_liq (k) - sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qv * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz = tz + sink * lhi (k) / cvm (k) - - endif - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhi (k) = li00 + dc_ice * tz - icpk (k) = lhi (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! graupel production terms: - ! ----------------------------------------------------------------------- - - if (qs > 1.e-7) then - - ! ----------------------------------------------------------------------- - ! accretion: snow -- > graupel - ! ----------------------------------------------------------------------- - - if (qg > qrmin) then - sink = dts * acr3d (vtg (k), vts (k), qs, qg, cgacs, acco (1, 4), den (k)) - else - sink = 0. - endif - - ! ----------------------------------------------------------------------- - ! autoconversion snow -- > graupel - ! ----------------------------------------------------------------------- - - qsm = qs0_crt / den (k) - if (qs > qsm) then - factor = dts * 1.e-3 * exp (0.09 * (tz - tice)) - sink = sink + factor / (1. + factor) * (qs - qsm) - endif - sink = min (qs, sink) - qs = qs - sink - qg = qg + sink - - endif ! snow existed - - if (qg > 1.e-7 .and. tz < tice0) then - - ! ----------------------------------------------------------------------- - ! pgacw: accretion of cloud water by graupel - ! ----------------------------------------------------------------------- - - if (ql > 1.e-6) then - qden = qg * den (k) - factor = dts * cgacw * qden / sqrt (den (k) * sqrt (sqrt (qden))) - pgacw = factor / (1. + factor) * ql - else - pgacw = 0. - endif - - ! ----------------------------------------------------------------------- - ! pgacr: accretion of rain by graupel - ! ----------------------------------------------------------------------- - - if (qr > 1.e-6) then - pgacr = min (dts * acr3d (vtg (k), vtr (k), qr, qg, cgacr, acco (1, 3), & - den (k)), qr) - else - pgacr = 0. - endif - - sink = pgacr + pgacw - factor = min (sink, dim (tice, tz) / icpk (k)) / max (sink, qrmin) - pgacr = factor * pgacr - pgacw = factor * pgacw - - sink = pgacr + pgacw - qg = qg + sink - qr = qr - pgacr - ql = ql - pgacw - q_liq (k) = q_liq (k) - sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qv * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz = tz + sink * lhi (k) / cvm (k) - - endif - - endif - - tzk (k) = tz - qvk (k) = qv - qlk (k) = ql - qik (k) = qi - qrk (k) = qr - qsk (k) = qs - qgk (k) = qg - - enddo - - ! ----------------------------------------------------------------------- - ! subgrid cloud microphysics - ! ----------------------------------------------------------------------- - - call subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tzk, qvk, & - qlk, qrk, qik, qsk, qgk, qak, h_var, rh_rain) - -end subroutine icloud - -! ======================================================================= -!>temperature sentive high vertical resolution processes -! ======================================================================= - -subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & - ql, qr, qi, qs, qg, qa, h_var, rh_rain) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in), dimension (ktop:kbot) :: p1, den, denfac - - real, intent (in) :: dts, rh_adj, h_var, rh_rain - - real, intent (inout), dimension (ktop:kbot) :: tz, qv, ql, qr, qi, qs, qg, qa - - real, dimension (ktop:kbot) :: lcpk, icpk, tcpk, tcp3, lhl, lhi - real, dimension (ktop:kbot) :: cvm, q_liq, q_sol, q_cond - - real :: fac_v2l, fac_l2v - - real :: pidep, qi_crt - - ! ----------------------------------------------------------------------- - ! qstar over water may be accurate only down to - 80 deg c with ~10% uncertainty - ! must not be too large to allow psc - ! ----------------------------------------------------------------------- - - real :: rh, rqi, tin, qsw, qsi, qpz, qstar - real :: dqsdt, dwsdt, dq, dq0, factor, tmp - real :: q_plus, q_minus, dt_evap, dt_pisub - real :: evap, sink, tc, pisub, q_adj, dtmp - real :: pssub, pgsub, tsq, qden, fac_g2v, fac_v2g - - integer :: k - - if (fast_sat_adj) then - dt_evap = 0.5 * dts - else - dt_evap = dts - endif - - ! ----------------------------------------------------------------------- - ! define conversion scalar / factor - ! ----------------------------------------------------------------------- - - fac_v2l = 1. - exp (- dt_evap / tau_v2l) - fac_l2v = 1. - exp (- dt_evap / tau_l2v) - - fac_g2v = 1. - exp (- dts / tau_g2v) - fac_v2g = 1. - exp (- dts / tau_v2g) - - ! ----------------------------------------------------------------------- - ! define heat capacity and latend heat coefficient - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - lhl (k) = lv00 + d0_vap * tz (k) - lhi (k) = li00 + dc_ice * tz (k) - q_liq (k) = ql (k) + qr (k) - q_sol (k) = qi (k) + qs (k) + qg (k) - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - tcpk (k) = lcpk (k) + icpk (k) - tcp3 (k) = lcpk (k) + icpk (k) * min (1., dim (tice, tz (k)) / (tice - t_wfr)) - enddo - - do k = ktop, kbot - - if (p1 (k) < p_min) cycle - - ! ----------------------------------------------------------------------- - ! instant deposit all water vapor to cloud ice when temperature is super low - ! ----------------------------------------------------------------------- - - if (tz (k) < t_min) then - sink = dim (qv (k), 1.e-7) - qv (k) = qv (k) - sink - qi (k) = qi (k) + sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) + sink * (lhl (k) + lhi (k)) / cvm (k) - if (.not. do_qa) qa (k) = qa (k) + 1. ! air fully saturated; 100 % cloud cover - cycle - endif - - ! ----------------------------------------------------------------------- - ! update heat capacity and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - lhi (k) = li00 + dc_ice * tz (k) - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - tcpk (k) = lcpk (k) + icpk (k) - tcp3 (k) = lcpk (k) + icpk (k) * min (1., dim (tice, tz (k)) / (tice - t_wfr)) - - ! ----------------------------------------------------------------------- - ! instant evaporation / sublimation of all clouds if rh < rh_adj -- > cloud free - ! ----------------------------------------------------------------------- - - qpz = qv (k) + ql (k) + qi (k) - tin = tz (k) - (lhl (k) * (ql (k) + qi (k)) + lhi (k) * qi (k)) / (c_air + & - qpz * c_vap + qr (k) * c_liq + (qs (k) + qg (k)) * c_ice) - if (tin > t_sub + 6.) then - rh = qpz / iqs1 (tin, den (k)) - if (rh < rh_adj) then ! qpz / rh_adj < qs - tz (k) = tin - qv (k) = qpz - ql (k) = 0. - qi (k) = 0. - cycle ! cloud free - endif - endif - - ! ----------------------------------------------------------------------- - ! cloud water < -- > vapor adjustment: - ! ----------------------------------------------------------------------- - - qsw = wqs2 (tz (k), den (k), dwsdt) - dq0 = qsw - qv (k) - if (dq0 > 0.) then - ! SJL 20170703 added ql factor to prevent the situation of high ql and low RH - ! factor = min (1., fac_l2v * sqrt (max (0., ql (k)) / 1.e-5) * 10. * dq0 / qsw) - ! factor = fac_l2v - ! factor = 1 - factor = min (1., fac_l2v * (10. * dq0 / qsw)) ! the rh dependent factor = 1 at 90% - evap = min (ql (k), factor * dq0 / (1. + tcp3 (k) * dwsdt)) - else ! condensate all excess vapor into cloud water - ! ----------------------------------------------------------------------- - ! evap = fac_v2l * dq0 / (1. + tcp3 (k) * dwsdt) - ! sjl, 20161108 - ! ----------------------------------------------------------------------- - evap = dq0 / (1. + tcp3 (k) * dwsdt) - endif - qv (k) = qv (k) + evap - ql (k) = ql (k) - evap - q_liq (k) = q_liq (k) - evap - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) - evap * lhl (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! update heat capacity and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhi (k) = li00 + dc_ice * tz (k) - icpk (k) = lhi (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! enforce complete freezing below - 48 c - ! ----------------------------------------------------------------------- - - dtmp = t_wfr - tz (k) ! [ - 40, - 48] - if (dtmp > 0. .and. ql (k) > qcmin) then - sink = min (ql (k), ql (k) * dtmp * 0.125, dtmp / icpk (k)) - ql (k) = ql (k) - sink - qi (k) = qi (k) + sink - q_liq (k) = q_liq (k) - sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) + sink * lhi (k) / cvm (k) - endif - - ! ----------------------------------------------------------------------- - ! update heat capacity and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhi (k) = li00 + dc_ice * tz (k) - icpk (k) = lhi (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! bigg mechanism - ! ----------------------------------------------------------------------- - - if (fast_sat_adj) then - dt_pisub = 0.5 * dts - else - dt_pisub = dts - tc = tice - tz (k) - if (ql (k) > qrmin .and. tc > 0.) then - sink = 3.3333e-10 * dts * (exp (0.66 * tc) - 1.) * den (k) * ql (k) * ql (k) - sink = min (ql (k), tc / icpk (k), sink) - ql (k) = ql (k) - sink - qi (k) = qi (k) + sink - q_liq (k) = q_liq (k) - sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) + sink * lhi (k) / cvm (k) - endif ! significant ql existed - endif - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - lhi (k) = li00 + dc_ice * tz (k) - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - tcpk (k) = lcpk (k) + icpk (k) - - ! ----------------------------------------------------------------------- - ! sublimation / deposition of ice - ! ----------------------------------------------------------------------- - - if (tz (k) < tice) then - qsi = iqs2 (tz (k), den (k), dqsdt) - dq = qv (k) - qsi - sink = dq / (1. + tcpk (k) * dqsdt) - if (qi (k) > qrmin) then - ! eq 9, hong et al. 2004, mwr - ! for a and b, see dudhia 1989: page 3103 eq (b7) and (b8) - pidep = dt_pisub * dq * 349138.78 * exp (0.875 * log (qi (k) * den (k))) & - / (qsi * den (k) * lat2 / (0.0243 * rvgas * tz (k) ** 2) + 4.42478e4) - else - pidep = 0. - endif - if (dq > 0.) then ! vapor - > ice - tmp = tice - tz (k) - ! 20160912: the following should produce more ice at higher altitude - ! qi_crt = 4.92e-11 * exp (1.33 * log (1.e3 * exp (0.1 * tmp))) / den (k) - qi_crt = qi_gen * min (qi_lim, 0.1 * tmp) / den (k) - sink = min (sink, max (qi_crt - qi (k), pidep), tmp / tcpk (k)) - else ! ice -- > vapor - pidep = pidep * min (1., dim (tz (k), t_sub) * 0.2) - sink = max (pidep, sink, - qi (k)) - endif - qv (k) = qv (k) - sink - qi (k) = qi (k) + sink - q_sol (k) = q_sol (k) + sink - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) + sink * (lhl (k) + lhi (k)) / cvm (k) - endif - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - lhi (k) = li00 + dc_ice * tz (k) - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - tcpk (k) = lcpk (k) + icpk (k) - - ! ----------------------------------------------------------------------- - ! sublimation / deposition of snow - ! this process happens for all temp rage - ! ----------------------------------------------------------------------- - - if (qs (k) > qrmin) then - qsi = iqs2 (tz (k), den (k), dqsdt) - qden = qs (k) * den (k) - tmp = exp (0.65625 * log (qden)) - tsq = tz (k) * tz (k) - dq = (qsi - qv (k)) / (1. + tcpk (k) * dqsdt) - pssub = cssub (1) * tsq * (cssub (2) * sqrt (qden) + cssub (3) * tmp * & - sqrt (denfac (k))) / (cssub (4) * tsq + cssub (5) * qsi * den (k)) - pssub = (qsi - qv (k)) * dts * pssub - if (pssub > 0.) then ! qs -- > qv, sublimation - pssub = min (pssub * min (1., dim (tz (k), t_sub) * 0.2), qs (k)) - else - if (tz (k) > tice) then - pssub = 0. ! no deposition - else - pssub = max (pssub, dq, (tz (k) - tice) / tcpk (k)) - endif - endif - qs (k) = qs (k) - pssub - qv (k) = qv (k) + pssub - q_sol (k) = q_sol (k) - pssub - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) - pssub * (lhl (k) + lhi (k)) / cvm (k) - endif - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - lhi (k) = li00 + dc_ice * tz (k) - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - tcpk (k) = lcpk (k) + icpk (k) - - ! ----------------------------------------------------------------------- - ! simplified 2 - way grapuel sublimation - deposition mechanism - ! ----------------------------------------------------------------------- - - if (qg (k) > qrmin) then - qsi = iqs2 (tz (k), den (k), dqsdt) - dq = (qv (k) - qsi) / (1. + tcpk (k) * dqsdt) - pgsub = (qv (k) / qsi - 1.) * qg (k) - if (pgsub > 0.) then ! deposition - if (tz (k) > tice) then - pgsub = 0. ! no deposition - else - pgsub = min (fac_v2g * pgsub, 0.2 * dq, ql (k) + qr (k), & - (tice - tz (k)) / tcpk (k)) - endif - else ! submilation - pgsub = max (fac_g2v * pgsub, dq) * min (1., dim (tz (k), t_sub) * 0.1) - endif - qg (k) = qg (k) + pgsub - qv (k) = qv (k) - pgsub - q_sol (k) = q_sol (k) + pgsub - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) + pgsub * (lhl (k) + lhi (k)) / cvm (k) - endif - -#ifdef USE_MIN_EVAP - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - lcpk (k) = lhl (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! * minimum evap of rain in dry environmental air - ! ----------------------------------------------------------------------- - - if (qr (k) > qcmin) then - qsw = wqs2 (tz (k), den (k), dqsdt) - sink = min (qr (k), dim (rh_rain * qsw, qv (k)) / (1. + lcpk (k) * dqsdt)) - qv (k) = qv (k) + sink - qr (k) = qr (k) - sink - q_liq (k) = q_liq (k) - sink - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) - sink * lhl (k) / cvm (k) - endif -#endif - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - lhl (k) = lv00 + d0_vap * tz (k) - cvm (k) = c_air + (qv (k) + q_liq (k) + q_sol (k)) * c_vap - lcpk (k) = lhl (k) / cvm (k) - - ! ----------------------------------------------------------------------- - ! compute cloud fraction - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! combine water species - ! ----------------------------------------------------------------------- - - if (do_qa) cycle - - if (rad_snow) then - q_sol (k) = qi (k) + qs (k) - else - q_sol (k) = qi (k) - endif - if (rad_rain) then - q_liq (k) = ql (k) + qr (k) - else - q_liq (k) = ql (k) - endif - q_cond (k) = q_liq (k) + q_sol (k) - - qpz = qv (k) + q_cond (k) ! qpz is conserved - - ! ----------------------------------------------------------------------- - ! use the "liquid - frozen water temperature" (tin) to compute saturated specific humidity - ! ----------------------------------------------------------------------- - - tin = tz (k) - (lcpk (k) * q_cond (k) + icpk (k) * q_sol (k)) ! minimum temperature - ! tin = tz (k) - ((lv00 + d0_vap * tz (k)) * q_cond (k) + & - ! (li00 + dc_ice * tz (k)) * q_sol (k)) / (c_air + qpz * c_vap) - - ! ----------------------------------------------------------------------- - ! determine saturated specific humidity - ! ----------------------------------------------------------------------- - - if (tin <= t_wfr) then - ! ice phase: - qstar = iqs1 (tin, den (k)) - elseif (tin >= tice) then - ! liquid phase: - qstar = wqs1 (tin, den (k)) - else - ! mixed phase: - qsi = iqs1 (tin, den (k)) - qsw = wqs1 (tin, den (k)) - if (q_cond (k) > 3.e-6) then - rqi = q_sol (k) / q_cond (k) - else - ! ----------------------------------------------------------------------- - ! mostly liquid water q_cond (k) at initial cloud development stage - ! ----------------------------------------------------------------------- - rqi = (tice - tin) / (tice - t_wfr) - endif - qstar = rqi * qsi + (1. - rqi) * qsw - endif - - ! ----------------------------------------------------------------------- - ! assuming subgrid linear distribution in horizontal; this is effectively a smoother for the - ! binary cloud scheme - ! ----------------------------------------------------------------------- - - if (qpz > qrmin) then - ! partial cloudiness by pdf: - dq = max (qcmin, h_var * qpz) - q_plus = qpz + dq ! cloud free if qstar > q_plus - q_minus = qpz - dq - if (qstar < q_minus) then - qa (k) = qa (k) + 1. ! air fully saturated; 100 % cloud cover - elseif (qstar < q_plus .and. q_cond (k) > qc_crt) then - qa (k) = qa (k) + (q_plus - qstar) / (dq + dq) ! partial cloud cover - ! qa (k) = sqrt (qa (k) + (q_plus - qstar) / (dq + dq)) - endif - endif - - enddo - -end subroutine subgrid_z_proc - -! ======================================================================= -!> rain evaporation -! ======================================================================= - -subroutine revap_rac1 (hydrostatic, is, ie, dt, tz, qv, ql, qr, qi, qs, qg, den, hvar) - - implicit none - - logical, intent (in) :: hydrostatic - - integer, intent (in) :: is, ie - - real, intent (in) :: dt ! time step (s) - - real, intent (in), dimension (is:ie) :: den, hvar, qi, qs, qg - - real, intent (inout), dimension (is:ie) :: tz, qv, qr, ql - - real, dimension (is:ie) :: lcp2, denfac, q_liq, q_sol, cvm, lhl - - real :: dqv, qsat, dqsdt, evap, qden, q_plus, q_minus, sink - real :: tin, t2, qpz, dq, dqh - - integer :: i - - ! ----------------------------------------------------------------------- - ! define latend heat coefficient - ! ----------------------------------------------------------------------- - - do i = is, ie - lhl (i) = lv00 + d0_vap * tz (i) - q_liq (i) = ql (i) + qr (i) - q_sol (i) = qi (i) + qs (i) + qg (i) - cvm (i) = c_air + qv (i) * c_vap + q_liq (i) * c_liq + q_sol (i) * c_ice - lcp2 (i) = lhl (i) / cvm (i) - ! denfac (i) = sqrt (sfcrho / den (i)) - enddo - - do i = is, ie - if (qr (i) > qrmin .and. tz (i) > t_wfr) then - qpz = qv (i) + ql (i) - tin = tz (i) - lcp2 (i) * ql (i) ! presence of clouds suppresses the rain evap - qsat = wqs2 (tin, den (i), dqsdt) - dqh = max (ql (i), hvar (i) * max (qpz, qcmin)) - dqv = qsat - qv (i) - q_minus = qpz - dqh - q_plus = qpz + dqh - - ! ----------------------------------------------------------------------- - ! qsat must be > q_minus to activate evaporation - ! qsat must be < q_plus to activate accretion - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! rain evaporation - ! ----------------------------------------------------------------------- - - if (dqv > qvmin .and. qsat > q_minus) then - if (qsat > q_plus) then - dq = qsat - qpz - else - ! q_minus < qsat < q_plus - ! dq == dqh if qsat == q_minus - dq = 0.25 * (q_minus - qsat) ** 2 / dqh - endif - qden = qr (i) * den (i) - t2 = tin * tin - evap = crevp (1) * t2 * dq * (crevp (2) * sqrt (qden) + crevp (3) * exp (0.725 * log (qden))) & - / (crevp (4) * t2 + crevp (5) * qsat * den (i)) - evap = min (qr (i), dt * evap, dqv / (1. + lcp2 (i) * dqsdt)) - qr (i) = qr (i) - evap - qv (i) = qv (i) + evap - q_liq (i) = q_liq (i) - evap - cvm (i) = c_air + qv (i) * c_vap + q_liq (i) * c_liq + q_sol (i) * c_ice - tz (i) = tz (i) - evap * lhl (i) / cvm (i) - endif - - ! ----------------------------------------------------------------------- - ! accretion: pracc - ! ----------------------------------------------------------------------- - - if (qr (i) > qrmin .and. ql (i) > 1.e-8 .and. qsat < q_plus) then - denfac (i) = sqrt (sfcrho / den (i)) - sink = dt * denfac (i) * cracw * exp (0.95 * log (qr (i) * den (i))) - sink = sink / (1. + sink) * ql (i) - ql (i) = ql (i) - sink - qr (i) = qr (i) + sink - endif - endif - enddo - -end subroutine revap_rac1 - -! ======================================================================= -!>@brief The subroutine 'terminal_fall' computes terminal fall speed. -!>@details It considers cloud ice, snow, and graupel's melting during fall. -! ======================================================================= - -subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & - den, vtg, vts, vti, r1, g1, s1, i1, m1_sol, w1) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in) :: dtm ! time step (s) - - real, intent (in), dimension (ktop:kbot) :: vtg, vts, vti, den, dp, dz - - real, intent (inout), dimension (ktop:kbot) :: qv, ql, qr, qg, qs, qi, tz, m1_sol, w1 - - real, intent (out) :: r1, g1, s1, i1 - - real, dimension (ktop:kbot + 1) :: ze, zt - - real :: qsat, dqsdt, dt5, evap, dtime - real :: factor, frac - real :: tmp, precip, tc, sink - - real, dimension (ktop:kbot) :: lcpk, icpk, cvm, q_liq, q_sol, lhl, lhi - real, dimension (ktop:kbot) :: m1, dm - - real :: zs = 0. - real :: fac_imlt - - integer :: k, k0, m - - logical :: no_fall - - dt5 = 0.5 * dtm - fac_imlt = 1. - exp (- dt5 / tau_imlt) - - ! ----------------------------------------------------------------------- - ! define heat capacity and latend heat coefficient - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - m1_sol (k) = 0. - lhl (k) = lv00 + d0_vap * tz (k) - lhi (k) = li00 + dc_ice * tz (k) - q_liq (k) = ql (k) + qr (k) - q_sol (k) = qi (k) + qs (k) + qg (k) - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - lcpk (k) = lhl (k) / cvm (k) - icpk (k) = lhi (k) / cvm (k) - enddo - - ! ----------------------------------------------------------------------- - ! find significant melting level - ! ----------------------------------------------------------------------- - - k0 = kbot - do k = ktop, kbot - 1 - if (tz (k) > tice) then - k0 = k - exit - endif - enddo - - ! ----------------------------------------------------------------------- - ! melting of cloud_ice (before fall) : - ! ----------------------------------------------------------------------- - - do k = k0, kbot - tc = tz (k) - tice - if (qi (k) > qcmin .and. tc > 0.) then - sink = min (qi (k), fac_imlt * tc / icpk (k)) - tmp = min (sink, dim (ql_mlt, ql (k))) - ql (k) = ql (k) + tmp - qr (k) = qr (k) + sink - tmp - qi (k) = qi (k) - sink - q_liq (k) = q_liq (k) + sink - q_sol (k) = q_sol (k) - sink - cvm (k) = c_air + qv (k) * c_vap + q_liq (k) * c_liq + q_sol (k) * c_ice - tz (k) = tz (k) - sink * lhi (k) / cvm (k) - tc = tz (k) - tice - endif - enddo - - ! ----------------------------------------------------------------------- - ! turn off melting when cloud microphysics time step is small - ! ----------------------------------------------------------------------- - - if (dtm < 60.) k0 = kbot - - ! sjl, turn off melting of falling cloud ice, snow and graupel - k0 = kbot - ! sjl, turn off melting of falling cloud ice, snow and graupel - - ze (kbot + 1) = zs - do k = kbot, ktop, - 1 - ze (k) = ze (k + 1) - dz (k) ! dz < 0 - enddo - - zt (ktop) = ze (ktop) - - ! ----------------------------------------------------------------------- - ! update capacity heat and latend heat coefficient - ! ----------------------------------------------------------------------- - - do k = k0, kbot - lhi (k) = li00 + dc_ice * tz (k) - icpk (k) = lhi (k) / cvm (k) - enddo - - ! ----------------------------------------------------------------------- - ! melting of falling cloud ice into rain - ! ----------------------------------------------------------------------- - - call check_column (ktop, kbot, qi, no_fall) - - if (vi_fac < 1.e-5 .or. no_fall) then - i1 = 0. - else - - do k = ktop + 1, kbot - zt (k) = ze (k) - dt5 * (vti (k - 1) + vti (k)) - enddo - zt (kbot + 1) = zs - dtm * vti (kbot) - - do k = ktop, kbot - if (zt (k + 1) >= zt (k)) zt (k + 1) = zt (k) - dz_min - enddo - - if (k0 < kbot) then - do k = kbot - 1, k0, - 1 - if (qi (k) > qrmin) then - do m = k + 1, kbot - if (zt (k + 1) >= ze (m)) exit - if (zt (k) < ze (m + 1) .and. tz (m) > tice) then - dtime = min (1.0, (ze (m) - ze (m + 1)) / (max (vr_min, vti (k)) * tau_imlt)) - sink = min (qi (k) * dp (k) / dp (m), dtime * (tz (m) - tice) / icpk (m)) - tmp = min (sink, dim (ql_mlt, ql (m))) - ql (m) = ql (m) + tmp - qr (m) = qr (m) - tmp + sink - tz (m) = tz (m) - sink * icpk (m) - qi (k) = qi (k) - sink * dp (m) / dp (k) - endif - enddo - endif - enddo - endif - - if (do_sedi_w) then - do k = ktop, kbot - dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) - enddo - endif - - if (use_ppm) then - call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qi, i1, m1_sol, mono_prof) - else - call implicit_fall (dtm, ktop, kbot, ze, vti, dp, qi, i1, m1_sol) - endif - - if (do_sedi_w) then - w1 (ktop) = (dm (ktop) * w1 (ktop) + m1_sol (ktop) * vti (ktop)) / (dm (ktop) - m1_sol (ktop)) - do k = ktop + 1, kbot - w1 (k) = (dm (k) * w1 (k) - m1_sol (k - 1) * vti (k - 1) + m1_sol (k) * vti (k)) & - / (dm (k) + m1_sol (k - 1) - m1_sol (k)) - enddo - endif - - endif - - ! ----------------------------------------------------------------------- - ! melting of falling snow into rain - ! ----------------------------------------------------------------------- - - r1 = 0. - - call check_column (ktop, kbot, qs, no_fall) - - if (no_fall) then - s1 = 0. - else - - do k = ktop + 1, kbot - zt (k) = ze (k) - dt5 * (vts (k - 1) + vts (k)) - enddo - zt (kbot + 1) = zs - dtm * vts (kbot) - - do k = ktop, kbot - if (zt (k + 1) >= zt (k)) zt (k + 1) = zt (k) - dz_min - enddo - - if (k0 < kbot) then - do k = kbot - 1, k0, - 1 - if (qs (k) > qrmin) then - do m = k + 1, kbot - if (zt (k + 1) >= ze (m)) exit - dtime = min (dtm, (ze (m) - ze (m + 1)) / (vr_min + vts (k))) - if (zt (k) < ze (m + 1) .and. tz (m) > tice) then - dtime = min (1.0, dtime / tau_smlt) - sink = min (qs (k) * dp (k) / dp (m), dtime * (tz (m) - tice) / icpk (m)) - tz (m) = tz (m) - sink * icpk (m) - qs (k) = qs (k) - sink * dp (m) / dp (k) - if (zt (k) < zs) then - r1 = r1 + sink * dp (m) ! precip as rain - else - ! qr source here will fall next time step (therefore, can evap) - qr (m) = qr (m) + sink - endif - endif - if (qs (k) < qrmin) exit - enddo - endif - enddo - endif - - if (do_sedi_w) then - do k = ktop, kbot - dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) - enddo - endif - - if (use_ppm) then - call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qs, s1, m1, mono_prof) - else - call implicit_fall (dtm, ktop, kbot, ze, vts, dp, qs, s1, m1) - endif - - do k = ktop, kbot - m1_sol (k) = m1_sol (k) + m1 (k) - enddo - - if (do_sedi_w) then - w1 (ktop) = (dm (ktop) * w1 (ktop) + m1 (ktop) * vts (ktop)) / (dm (ktop) - m1 (ktop)) - do k = ktop + 1, kbot - w1 (k) = (dm (k) * w1 (k) - m1 (k - 1) * vts (k - 1) + m1 (k) * vts (k)) & - / (dm (k) + m1 (k - 1) - m1 (k)) - enddo - endif - - endif - - ! ---------------------------------------------- - ! melting of falling graupel into rain - ! ---------------------------------------------- - - call check_column (ktop, kbot, qg, no_fall) - - if (no_fall) then - g1 = 0. - else - - do k = ktop + 1, kbot - zt (k) = ze (k) - dt5 * (vtg (k - 1) + vtg (k)) - enddo - zt (kbot + 1) = zs - dtm * vtg (kbot) - - do k = ktop, kbot - if (zt (k + 1) >= zt (k)) zt (k + 1) = zt (k) - dz_min - enddo - - if (k0 < kbot) then - do k = kbot - 1, k0, - 1 - if (qg (k) > qrmin) then - do m = k + 1, kbot - if (zt (k + 1) >= ze (m)) exit - dtime = min (dtm, (ze (m) - ze (m + 1)) / vtg (k)) - if (zt (k) < ze (m + 1) .and. tz (m) > tice) then - dtime = min (1., dtime / tau_g2r) - sink = min (qg (k) * dp (k) / dp (m), dtime * (tz (m) - tice) / icpk (m)) - tz (m) = tz (m) - sink * icpk (m) - qg (k) = qg (k) - sink * dp (m) / dp (k) - if (zt (k) < zs) then - r1 = r1 + sink * dp (m) - else - qr (m) = qr (m) + sink - endif - endif - if (qg (k) < qrmin) exit - enddo - endif - enddo - endif - - if (do_sedi_w) then - do k = ktop, kbot - dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) - enddo - endif - - if (use_ppm) then - call lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, qg, g1, m1, mono_prof) - else - call implicit_fall (dtm, ktop, kbot, ze, vtg, dp, qg, g1, m1) - endif - - do k = ktop, kbot - m1_sol (k) = m1_sol (k) + m1 (k) - enddo - - if (do_sedi_w) then - w1 (ktop) = (dm (ktop) * w1 (ktop) + m1 (ktop) * vtg (ktop)) / (dm (ktop) - m1 (ktop)) - do k = ktop + 1, kbot - w1 (k) = (dm (k) * w1 (k) - m1 (k - 1) * vtg (k - 1) + m1 (k) * vtg (k)) & - / (dm (k) + m1 (k - 1) - m1 (k)) - enddo - endif - - endif - -end subroutine terminal_fall - -! ======================================================================= -!>@brief The subroutine 'check_column' checks -!! if the water species is large enough to fall. -! ======================================================================= - -subroutine check_column (ktop, kbot, q, no_fall) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in) :: q (ktop:kbot) - - logical, intent (out) :: no_fall - - integer :: k - - no_fall = .true. - - do k = ktop, kbot - if (q (k) > qrmin) then - no_fall = .false. - exit - endif - enddo - -end subroutine check_column - -! ======================================================================= -!>@brief The subroutine 'implicit_fall' computes the time-implicit monotonic -!! scheme. -!>@author Shian-Jiann Lin, 2016 -! ======================================================================= - -subroutine implicit_fall (dt, ktop, kbot, ze, vt, dp, q, precip, m1) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in) :: dt - - real, intent (in), dimension (ktop:kbot + 1) :: ze - - real, intent (in), dimension (ktop:kbot) :: vt, dp - - real, intent (inout), dimension (ktop:kbot) :: q - - real, intent (out), dimension (ktop:kbot) :: m1 - - real, intent (out) :: precip - - real, dimension (ktop:kbot) :: dz, qm, dd - - integer :: k - - do k = ktop, kbot - dz (k) = ze (k) - ze (k + 1) - dd (k) = dt * vt (k) - q (k) = q (k) * dp (k) - enddo - - ! ----------------------------------------------------------------------- - ! sedimentation: non - vectorizable loop - ! ----------------------------------------------------------------------- - - qm (ktop) = q (ktop) / (dz (ktop) + dd (ktop)) - do k = ktop + 1, kbot - qm (k) = (q (k) + dd (k - 1) * qm (k - 1)) / (dz (k) + dd (k)) - enddo - - ! ----------------------------------------------------------------------- - ! qm is density at this stage - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - qm (k) = qm (k) * dz (k) - enddo - - ! ----------------------------------------------------------------------- - ! output mass fluxes: non - vectorizable loop - ! ----------------------------------------------------------------------- - - m1 (ktop) = q (ktop) - qm (ktop) - do k = ktop + 1, kbot - m1 (k) = m1 (k - 1) + q (k) - qm (k) - enddo - precip = m1 (kbot) - - ! ----------------------------------------------------------------------- - ! update: - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - q (k) = qm (k) / dp (k) - enddo - -end subroutine implicit_fall - -! ======================================================================= -!> lagrangian scheme -! developed by sj lin, ???? -! ======================================================================= - -subroutine lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, q, precip, m1, mono) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in) :: zs - - logical, intent (in) :: mono - - real, intent (in), dimension (ktop:kbot + 1) :: ze, zt - - real, intent (in), dimension (ktop:kbot) :: dp - - ! m1: flux - real, intent (inout), dimension (ktop:kbot) :: q, m1 - - real, intent (out) :: precip - - real, dimension (ktop:kbot) :: qm, dz - - real :: a4 (4, ktop:kbot) - - real :: pl, pr, delz, esl - - integer :: k, k0, n, m - - real, parameter :: r3 = 1. / 3., r23 = 2. / 3. - - ! ----------------------------------------------------------------------- - ! density: - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - dz (k) = zt (k) - zt (k + 1) ! note: dz is positive - q (k) = q (k) * dp (k) - a4 (1, k) = q (k) / dz (k) - qm (k) = 0. - enddo - - ! ----------------------------------------------------------------------- - ! construct vertical profile with zt as coordinate - ! ----------------------------------------------------------------------- - - call cs_profile (a4 (1, ktop), dz (ktop), kbot - ktop + 1, mono) - - k0 = ktop - do k = ktop, kbot - do n = k0, kbot - if (ze (k) <= zt (n) .and. ze (k) >= zt (n + 1)) then - pl = (zt (n) - ze (k)) / dz (n) - if (zt (n + 1) <= ze (k + 1)) then - ! entire new grid is within the original grid - pr = (zt (n) - ze (k + 1)) / dz (n) - qm (k) = a4 (2, n) + 0.5 * (a4 (4, n) + a4 (3, n) - a4 (2, n)) * (pr + pl) - & - a4 (4, n) * r3 * (pr * (pr + pl) + pl ** 2) - qm (k) = qm (k) * (ze (k) - ze (k + 1)) - k0 = n - goto 555 - else - qm (k) = (ze (k) - zt (n + 1)) * (a4 (2, n) + 0.5 * (a4 (4, n) + & - a4 (3, n) - a4 (2, n)) * (1. + pl) - a4 (4, n) * (r3 * (1. + pl * (1. + pl)))) - if (n < kbot) then - do m = n + 1, kbot - ! locate the bottom edge: ze (k + 1) - if (ze (k + 1) < zt (m + 1)) then - qm (k) = qm (k) + q (m) - else - delz = zt (m) - ze (k + 1) - esl = delz / dz (m) - qm (k) = qm (k) + delz * (a4 (2, m) + 0.5 * esl * & - (a4 (3, m) - a4 (2, m) + a4 (4, m) * (1. - r23 * esl))) - k0 = m - goto 555 - endif - enddo - endif - goto 555 - endif - endif - enddo - 555 continue - enddo - - m1 (ktop) = q (ktop) - qm (ktop) - do k = ktop + 1, kbot - m1 (k) = m1 (k - 1) + q (k) - qm (k) - enddo - precip = m1 (kbot) - - ! convert back to * dry * mixing ratio: - ! dp must be dry air_mass (because moist air mass will be changed due to terminal fall) . - - do k = ktop, kbot - q (k) = qm (k) / dp (k) - enddo - -end subroutine lagrangian_fall_ppm - -subroutine cs_profile (a4, del, km, do_mono) - - implicit none - - integer, intent (in) :: km !< vertical dimension - - real, intent (in) :: del (km) - - logical, intent (in) :: do_mono - - real, intent (inout) :: a4 (4, km) - - real, parameter :: qp_min = 1.e-6 - - real :: gam (km) - real :: q (km + 1) - real :: d4, bet, a_bot, grat, pmp, lac - real :: pmp_1, lac_1, pmp_2, lac_2 - real :: da1, da2, a6da - - integer :: k - - logical extm (km) - - grat = del (2) / del (1) ! grid ratio - bet = grat * (grat + 0.5) - q (1) = (2. * grat * (grat + 1.) * a4 (1, 1) + a4 (1, 2)) / bet - gam (1) = (1. + grat * (grat + 1.5)) / bet - - do k = 2, km - d4 = del (k - 1) / del (k) - bet = 2. + 2. * d4 - gam (k - 1) - q (k) = (3. * (a4 (1, k - 1) + d4 * a4 (1, k)) - q (k - 1)) / bet - gam (k) = d4 / bet - enddo - - a_bot = 1. + d4 * (d4 + 1.5) - q (km + 1) = (2. * d4 * (d4 + 1.) * a4 (1, km) + a4 (1, km - 1) - a_bot * q (km)) & - / (d4 * (d4 + 0.5) - a_bot * gam (km)) - - do k = km, 1, - 1 - q (k) = q (k) - gam (k) * q (k + 1) - enddo - - ! ----------------------------------------------------------------------- - ! apply constraints - ! ----------------------------------------------------------------------- - - do k = 2, km - gam (k) = a4 (1, k) - a4 (1, k - 1) - enddo - - ! ----------------------------------------------------------------------- - ! apply large - scale constraints to all fields if not local max / min - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! top: - ! ----------------------------------------------------------------------- - - q (1) = max (q (1), 0.) - q (2) = min (q (2), max (a4 (1, 1), a4 (1, 2))) - q (2) = max (q (2), min (a4 (1, 1), a4 (1, 2)), 0.) - - ! ----------------------------------------------------------------------- - ! interior: - ! ----------------------------------------------------------------------- - - do k = 3, km - 1 - if (gam (k - 1) * gam (k + 1) > 0.) then - q (k) = min (q (k), max (a4 (1, k - 1), a4 (1, k))) - q (k) = max (q (k), min (a4 (1, k - 1), a4 (1, k))) - else - if (gam (k - 1) > 0.) then - ! there exists a local max - q (k) = max (q (k), min (a4 (1, k - 1), a4 (1, k))) - else - ! there exists a local min - q (k) = min (q (k), max (a4 (1, k - 1), a4 (1, k))) - q (k) = max (q (k), 0.0) - endif - endif - enddo - - ! ----------------------------------------------------------------------- - ! bottom : - ! ----------------------------------------------------------------------- - - q (km) = min (q (km), max (a4 (1, km - 1), a4 (1, km))) - q (km) = max (q (km), min (a4 (1, km - 1), a4 (1, km)), 0.) - ! q (km + 1) = max (q (km + 1), 0.) - - ! ----------------------------------------------------------------------- - ! f (s) = al + s * [ (ar - al) + a6 * (1 - s) ] (0 <= s <= 1) - ! ----------------------------------------------------------------------- - - do k = 1, km - 1 - a4 (2, k) = q (k) - a4 (3, k) = q (k + 1) - enddo - - do k = 2, km - 1 - if (gam (k) * gam (k + 1) > 0.0) then - extm (k) = .false. - else - extm (k) = .true. - endif - enddo - - if (do_mono) then - do k = 3, km - 2 - if (extm (k)) then - ! positive definite constraint only if true local extrema - if (a4 (1, k) < qp_min .or. extm (k - 1) .or. extm (k + 1)) then - a4 (2, k) = a4 (1, k) - a4 (3, k) = a4 (1, k) - endif - else - a4 (4, k) = 6. * a4 (1, k) - 3. * (a4 (2, k) + a4 (3, k)) - if (abs (a4 (4, k)) > abs (a4 (2, k) - a4 (3, k))) then - ! check within the smooth region if subgrid profile is non - monotonic - pmp_1 = a4 (1, k) - 2.0 * gam (k + 1) - lac_1 = pmp_1 + 1.5 * gam (k + 2) - a4 (2, k) = min (max (a4 (2, k), min (a4 (1, k), pmp_1, lac_1)), & - max (a4 (1, k), pmp_1, lac_1)) - pmp_2 = a4 (1, k) + 2.0 * gam (k) - lac_2 = pmp_2 - 1.5 * gam (k - 1) - a4 (3, k) = min (max (a4 (3, k), min (a4 (1, k), pmp_2, lac_2)), & - max (a4 (1, k), pmp_2, lac_2)) - endif - endif - enddo - else - do k = 3, km - 2 - if (extm (k)) then - if (a4 (1, k) < qp_min .or. extm (k - 1) .or. extm (k + 1)) then - a4 (2, k) = a4 (1, k) - a4 (3, k) = a4 (1, k) - endif - endif - enddo - endif - - do k = 1, km - 1 - a4 (4, k) = 6. * a4 (1, k) - 3. * (a4 (2, k) + a4 (3, k)) - enddo - - k = km - 1 - if (extm (k)) then - a4 (2, k) = a4 (1, k) - a4 (3, k) = a4 (1, k) - a4 (4, k) = 0. - else - da1 = a4 (3, k) - a4 (2, k) - da2 = da1 ** 2 - a6da = a4 (4, k) * da1 - if (a6da < - da2) then - a4 (4, k) = 3. * (a4 (2, k) - a4 (1, k)) - a4 (3, k) = a4 (2, k) - a4 (4, k) - elseif (a6da > da2) then - a4 (4, k) = 3. * (a4 (3, k) - a4 (1, k)) - a4 (2, k) = a4 (3, k) - a4 (4, k) - endif - endif - - call cs_limiters (km - 1, a4) - - ! ----------------------------------------------------------------------- - ! bottom layer: - ! ----------------------------------------------------------------------- - - a4 (2, km) = a4 (1, km) - a4 (3, km) = a4 (1, km) - a4 (4, km) = 0. - -end subroutine cs_profile - -subroutine cs_limiters (km, a4) - - implicit none - - integer, intent (in) :: km - - real, intent (inout) :: a4 (4, km) !< ppm array - - real, parameter :: r12 = 1. / 12. - - integer :: k - - ! ----------------------------------------------------------------------- - ! positive definite constraint - ! ----------------------------------------------------------------------- - - do k = 1, km - if (abs (a4 (3, k) - a4 (2, k)) < - a4 (4, k)) then - if ((a4 (1, k) + 0.25 * (a4 (3, k) - a4 (2, k)) ** 2 / a4 (4, k) + a4 (4, k) * r12) < 0.) then - if (a4 (1, k) < a4 (3, k) .and. a4 (1, k) < a4 (2, k)) then - a4 (3, k) = a4 (1, k) - a4 (2, k) = a4 (1, k) - a4 (4, k) = 0. - elseif (a4 (3, k) > a4 (2, k)) then - a4 (4, k) = 3. * (a4 (2, k) - a4 (1, k)) - a4 (3, k) = a4 (2, k) - a4 (4, k) - else - a4 (4, k) = 3. * (a4 (3, k) - a4 (1, k)) - a4 (2, k) = a4 (3, k) - a4 (4, k) - endif - endif - endif - enddo - -end subroutine cs_limiters - -! ======================================================================= -!>@brief The subroutine 'fall_speed' calculates vertical fall speed. -! ======================================================================= - -subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in), dimension (ktop:kbot) :: den, qs, qi, qg, ql, tk - real, intent (out), dimension (ktop:kbot) :: vts, vti, vtg - - ! fall velocity constants: - - real, parameter :: thi = 1.0e-8 !< cloud ice threshold for terminal fall - real, parameter :: thg = 1.0e-8 - real, parameter :: ths = 1.0e-8 - - real, parameter :: aa = - 4.14122e-5 - real, parameter :: bb = - 0.00538922 - real, parameter :: cc = - 0.0516344 - real, parameter :: dd = 0.00216078 - real, parameter :: ee = 1.9714 - - ! marshall - palmer constants - - real, parameter :: vcons = 6.6280504 - real, parameter :: vcong = 87.2382675 - real, parameter :: norms = 942477796.076938 - real, parameter :: normg = 5026548245.74367 - - real, dimension (ktop:kbot) :: qden, tc, rhof - - real :: vi0 - - integer :: k - - ! ----------------------------------------------------------------------- - ! marshall - palmer formula - ! ----------------------------------------------------------------------- - - ! ----------------------------------------------------------------------- - ! try the local air density -- for global model; the true value could be - ! much smaller than sfcrho over high mountains - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - rhof (k) = sqrt (min (10., sfcrho / den (k))) - enddo - - ! ----------------------------------------------------------------------- - ! ice: - ! ----------------------------------------------------------------------- - - if (const_vi) then - vti (:) = vi_fac - else - ! ----------------------------------------------------------------------- - ! use deng and mace (2008, grl), which gives smaller fall speed than hd90 formula - ! ----------------------------------------------------------------------- - vi0 = 0.01 * vi_fac - do k = ktop, kbot - if (qi (k) < thi) then ! this is needed as the fall - speed maybe problematic for small qi - vti (k) = vf_min - else - tc (k) = tk (k) - tice - vti (k) = (3. + log10 (qi (k) * den (k))) * (tc (k) * (aa * tc (k) + bb) + cc) + dd * tc (k) + ee - vti (k) = vi0 * exp (log_10 * vti (k)) * 0.8 - vti (k) = min (vi_max, max (vf_min, vti (k))) - endif - enddo - endif - - ! ----------------------------------------------------------------------- - ! snow: - ! ----------------------------------------------------------------------- - - if (const_vs) then - vts (:) = vs_fac ! 1. ifs_2016 - else - do k = ktop, kbot - if (qs (k) < ths) then - vts (k) = vf_min - else - vts (k) = vs_fac * vcons * rhof (k) * exp (0.0625 * log (qs (k) * den (k) / norms)) - vts (k) = min (vs_max, max (vf_min, vts (k))) - endif - enddo - endif - - ! ----------------------------------------------------------------------- - ! graupel: - ! ----------------------------------------------------------------------- - - if (const_vg) then - vtg (:) = vg_fac ! 2. - else - do k = ktop, kbot - if (qg (k) < thg) then - vtg (k) = vf_min - else - vtg (k) = vg_fac * vcong * rhof (k) * sqrt (sqrt (sqrt (qg (k) * den (k) / normg))) - vtg (k) = min (vg_max, max (vf_min, vtg (k))) - endif - enddo - endif - -end subroutine fall_speed - -! ======================================================================= -!>@brief The subroutine 'setup'm' sets up -!! gfdl cloud microphysics parameters. -! ======================================================================= - -subroutine setupm - - implicit none - - real :: gcon, cd, scm3, pisq, act (8) - real :: vdifu, tcond - real :: visk - real :: ch2o, hltf - real :: hlts, hltc, ri50 - - real, parameter :: gam263 = 1.456943, gam275 = 1.608355, gam290 = 1.827363, & - gam325 = 2.54925, gam350 = 3.323363, gam380 = 4.694155, & - gam425 = 8.285063, gam450 = 11.631769, gam480 = 17.837789, & - gam625 = 184.860962, gam680 = 496.604067 - - ! intercept parameters - - real, parameter :: rnzr = 8.0e6 ! lin83 - real, parameter :: rnzs = 3.0e6 ! lin83 - real, parameter :: rnzg = 4.0e6 ! rh84 - - ! density parameters - -! real, parameter :: rhos = 0.1e3 !< lin83 (snow density; 1 / 10 of water) -! real, parameter :: rhog = 0.4e3 !< rh84 (graupel density) - real, parameter :: acc (3) = (/ 5.0, 2.0, 0.5 /) - - real den_rc - - integer :: i, k - - pie = 4. * atan (1.0) - - ! s. klein's formular (eq 16) from am2 - - fac_rc = (4. / 3.) * pie * rhor * rthresh ** 3 - - if (prog_ccn) then - ! if (master) write (*, *) 'prog_ccn option is .t.' - else - den_rc = fac_rc * ccn_o * 1.e6 - ! if (master) write (*, *) 'mp: for ccn_o = ', ccn_o, 'ql_rc = ', den_rc - den_rc = fac_rc * ccn_l * 1.e6 - ! if (master) write (*, *) 'mp: for ccn_l = ', ccn_l, 'ql_rc = ', den_rc - endif - - vdifu = 2.11e-5 - tcond = 2.36e-2 - - visk = 1.259e-5 - hlts = 2.8336e6 - hltc = 2.5e6 - hltf = 3.336e5 - - ch2o = 4.1855e3 - ri50 = 1.e-4 - - pisq = pie * pie - scm3 = (visk / vdifu) ** (1. / 3.) - - cracs = pisq * rnzr * rnzs * rhos - csacr = pisq * rnzr * rnzs * rhor - cgacr = pisq * rnzr * rnzg * rhor - cgacs = pisq * rnzg * rnzs * rhos - cgacs = cgacs * c_pgacs - - ! act: 1 - 2:racs (s - r) ; 3 - 4:sacr (r - s) ; - ! 5 - 6:gacr (r - g) ; 7 - 8:gacs (s - g) - - act (1) = pie * rnzs * rhos - act (2) = pie * rnzr * rhor - act (6) = pie * rnzg * rhog - act (3) = act (2) - act (4) = act (1) - act (5) = act (2) - act (7) = act (1) - act (8) = act (6) - - do i = 1, 3 - do k = 1, 4 - acco (i, k) = acc (i) / (act (2 * k - 1) ** ((7 - i) * 0.25) * act (2 * k) ** (i * 0.25)) - enddo - enddo - - gcon = 40.74 * sqrt (sfcrho) ! 44.628 - - csacw = pie * rnzs * clin * gam325 / (4. * act (1) ** 0.8125) - ! decreasing csacw to reduce cloud water --- > snow - - craci = pie * rnzr * alin * gam380 / (4. * act (2) ** 0.95) - csaci = csacw * c_psaci - - cgacw = pie * rnzg * gam350 * gcon / (4. * act (6) ** 0.875) - ! cgaci = cgacw * 0.1 - - ! sjl, may 28, 2012 - cgaci = cgacw * 0.05 - ! sjl, may 28, 2012 - - cracw = craci ! cracw = 3.27206196043822 - cracw = c_cracw * cracw - - ! subl and revp: five constants for three separate processes - - cssub (1) = 2. * pie * vdifu * tcond * rvgas * rnzs - cgsub (1) = 2. * pie * vdifu * tcond * rvgas * rnzg - crevp (1) = 2. * pie * vdifu * tcond * rvgas * rnzr - cssub (2) = 0.78 / sqrt (act (1)) - cgsub (2) = 0.78 / sqrt (act (6)) - crevp (2) = 0.78 / sqrt (act (2)) - cssub (3) = 0.31 * scm3 * gam263 * sqrt (clin / visk) / act (1) ** 0.65625 - cgsub (3) = 0.31 * scm3 * gam275 * sqrt (gcon / visk) / act (6) ** 0.6875 - crevp (3) = 0.31 * scm3 * gam290 * sqrt (alin / visk) / act (2) ** 0.725 - cssub (4) = tcond * rvgas - cssub (5) = hlts ** 2 * vdifu - cgsub (4) = cssub (4) - crevp (4) = cssub (4) - cgsub (5) = cssub (5) - crevp (5) = hltc ** 2 * vdifu - - cgfr (1) = 20.e2 * pisq * rnzr * rhor / act (2) ** 1.75 - cgfr (2) = 0.66 - - ! smlt: five constants (lin et al. 1983) - - csmlt (1) = 2. * pie * tcond * rnzs / hltf - csmlt (2) = 2. * pie * vdifu * rnzs * hltc / hltf - csmlt (3) = cssub (2) - csmlt (4) = cssub (3) - csmlt (5) = ch2o / hltf - - ! gmlt: five constants - - cgmlt (1) = 2. * pie * tcond * rnzg / hltf - cgmlt (2) = 2. * pie * vdifu * rnzg * hltc / hltf - cgmlt (3) = cgsub (2) - cgmlt (4) = cgsub (3) - cgmlt (5) = ch2o / hltf - - es0 = 6.107799961e2 ! ~6.1 mb - ces0 = eps * es0 - -end subroutine setupm - -! ======================================================================= -! initialization of gfdl cloud microphysics -!>@brief The subroutine 'gfdl_cloud_microphys_init' initializes the GFDL -!! cloud microphysics. -! ======================================================================= - -subroutine gfdl_cloud_microphys_init (me, master, nlunit, input_nml_file, logunit, fn_nml) - - implicit none - - integer, intent (in) :: me - integer, intent (in) :: master - integer, intent (in) :: nlunit - integer, intent (in) :: logunit - - character (len = 64), intent (in) :: fn_nml - character (len = *), intent (in) :: input_nml_file(:) - - integer :: ios - logical :: exists - - ! integer, intent (in) :: id, jd, kd - ! integer, intent (in) :: axes (4) - ! type (time_type), intent (in) :: time - - ! integer :: unit, io, ierr, k, logunit - ! logical :: flag - ! real :: tmp, q1, q2 - - ! master = (mpp_pe () .eq.mpp_root_pe ()) - -#ifdef INTERNAL_FILE_NML - read (input_nml_file, nml = gfdl_cloud_microphysics_nml) -#else - inquire (file = trim (fn_nml), exist = exists) - if (.not. exists) then - write (6, *) 'gfdl - mp :: namelist file: ', trim (fn_nml), ' does not exist' - stop - else - open (unit = nlunit, file = fn_nml, readonly, status = 'old', iostat = ios) - endif - rewind (nlunit) - read (nlunit, nml = gfdl_cloud_microphysics_nml) - close (nlunit) -#endif - - ! write version number and namelist to log file - if (me == master) then - write (logunit, *) " ================================================================== " - write (logunit, *) "gfdl_cloud_microphys_mod" - write (logunit, nml = gfdl_cloud_microphysics_nml) - endif - - if (do_setup) then - call setup_con - call setupm - do_setup = .false. - endif - - log_10 = log (10.) - - tice0 = tice - 0.01 - t_wfr = tice - 40.0 ! supercooled water can exist down to - 48 c, which is the "absolute" - - ! if (master) write (logunit, nml = gfdl_cloud_microphys_nml) - ! - ! id_vtr = register_diag_field (mod_name, 'vt_r', axes (1:3), time, & - ! 'rain fall speed', 'm / s', missing_value = missing_value) - ! id_vts = register_diag_field (mod_name, 'vt_s', axes (1:3), time, & - ! 'snow fall speed', 'm / s', missing_value = missing_value) - ! id_vtg = register_diag_field (mod_name, 'vt_g', axes (1:3), time, & - ! 'graupel fall speed', 'm / s', missing_value = missing_value) - ! id_vti = register_diag_field (mod_name, 'vt_i', axes (1:3), time, & - ! 'ice fall speed', 'm / s', missing_value = missing_value) - - ! id_droplets = register_diag_field (mod_name, 'droplets', axes (1:3), time, & - ! 'droplet number concentration', '# / m3', missing_value = missing_value) - ! id_rh = register_diag_field (mod_name, 'rh_lin', axes (1:2), time, & - ! 'relative humidity', 'n / a', missing_value = missing_value) - - ! id_rain = register_diag_field (mod_name, 'rain_lin', axes (1:2), time, & - ! 'rain_lin', 'mm / day', missing_value = missing_value) - ! id_snow = register_diag_field (mod_name, 'snow_lin', axes (1:2), time, & - ! 'snow_lin', 'mm / day', missing_value = missing_value) - ! id_graupel = register_diag_field (mod_name, 'graupel_lin', axes (1:2), time, & - ! 'graupel_lin', 'mm / day', missing_value = missing_value) - ! id_ice = register_diag_field (mod_name, 'ice_lin', axes (1:2), time, & - ! 'ice_lin', 'mm / day', missing_value = missing_value) - ! id_prec = register_diag_field (mod_name, 'prec_lin', axes (1:2), time, & - ! 'prec_lin', 'mm / day', missing_value = missing_value) - - ! if (master) write (*, *) 'prec_lin diagnostics initialized.', id_prec - - ! id_cond = register_diag_field (mod_name, 'cond_lin', axes (1:2), time, & - ! 'total condensate', 'kg / m ** 2', missing_value = missing_value) - ! id_var = register_diag_field (mod_name, 'var_lin', axes (1:2), time, & - ! 'subgrid variance', 'n / a', missing_value = missing_value) - - ! call qsmith_init - - ! testing the water vapor tables - - ! if (mp_debug .and. master) then - ! write (*, *) 'testing water vapor tables in gfdl_cloud_microphys' - ! tmp = tice - 90. - ! do k = 1, 25 - ! q1 = wqsat_moist (tmp, 0., 1.e5) - ! q2 = qs1d_m (tmp, 0., 1.e5) - ! write (*, *) nint (tmp - tice), q1, q2, 'dq = ', q1 - q2 - ! tmp = tmp + 5. - ! enddo - ! endif - - ! if (master) write (*, *) 'gfdl_cloud_micrphys diagnostics initialized.' - - module_is_initialized = .true. - -!+---+-----------------------------------------------------------------+ -!..Set these variables needed for computing radar reflectivity. These -!.. get used within radar_init to create other variables used in the -!.. radar module. - - xam_r = pi*rhor/6. - xbm_r = 3. - xmu_r = 0. - xam_s = pi*rhos/6. - xbm_s = 3. - xmu_s = 0. - xam_g = pi*rhog/6. - xbm_g = 3. - xmu_g = 0. - - call radar_init - -end subroutine gfdl_cloud_microphys_init - -! ======================================================================= -! end of gfdl cloud microphysics -!>@brief The subroutine 'gfdl_cloud_microphys_init' terminates the GFDL -!! cloud microphysics. -! ======================================================================= - -subroutine gfdl_cloud_microphys_end - - implicit none - - deallocate (table) - deallocate (table2) - deallocate (table3) - deallocate (tablew) - deallocate (des) - deallocate (des2) - deallocate (des3) - deallocate (desw) - - tables_are_initialized = .false. - -end subroutine gfdl_cloud_microphys_end - -! ======================================================================= -! qsmith table initialization -!>@brief The subroutine 'setup_con' sets up constants and calls 'qsmith_init'. -! ======================================================================= - -subroutine setup_con - - implicit none - - ! master = (mpp_pe () .eq.mpp_root_pe ()) - - rgrav = 1. / grav - - if (.not. qsmith_tables_initialized) call qsmith_init - - qsmith_tables_initialized = .true. - -end subroutine setup_con - -! ======================================================================= -!>@brief The function 'acr3d' is an accretion function (lin et al. 1983) -! ======================================================================= - -real function acr3d (v1, v2, q1, q2, c, cac, rho) - - implicit none - - real, intent (in) :: v1, v2, c, rho - real, intent (in) :: q1, q2 ! mixing ratio!!! - real, intent (in) :: cac (3) - - real :: t1, s1, s2 - - ! integer :: k - ! - ! real :: a - ! - ! a = 0.0 - ! do k = 1, 3 - ! a = a + cac (k) * ((q1 * rho) ** ((7 - k) * 0.25) * (q2 * rho) ** (k * 0.25)) - ! enddo - ! acr3d = c * abs (v1 - v2) * a / rho - - ! optimized - - t1 = sqrt (q1 * rho) - s1 = sqrt (q2 * rho) - s2 = sqrt (s1) ! s1 = s2 ** 2 - acr3d = c * abs (v1 - v2) * q1 * s2 * (cac (1) * t1 + cac (2) * sqrt (t1) * s2 + cac (3) * s1) - -end function acr3d - -! ======================================================================= -!> melting of snow function (lin et al. 1983) -! note: psacw and psacr must be calc before smlt is called -! ======================================================================= - -real function smlt (tc, dqs, qsrho, psacw, psacr, c, rho, rhofac) - - implicit none - - real, intent (in) :: tc, dqs, qsrho, psacw, psacr, c (5), rho, rhofac - - smlt = (c (1) * tc / rho - c (2) * dqs) * (c (3) * sqrt (qsrho) + & - c (4) * qsrho ** 0.65625 * sqrt (rhofac)) + c (5) * tc * (psacw + psacr) - -end function smlt - -! ======================================================================= -!> melting of graupel function (lin et al. 1983) -! note: pgacw and pgacr must be calc before gmlt is called -! ======================================================================= - -real function gmlt (tc, dqs, qgrho, pgacw, pgacr, c, rho) - - implicit none - - real, intent (in) :: tc, dqs, qgrho, pgacw, pgacr, c (5), rho - - gmlt = (c (1) * tc / rho - c (2) * dqs) * (c (3) * sqrt (qgrho) + & - c (4) * qgrho ** 0.6875 / rho ** 0.25) + c (5) * tc * (pgacw + pgacr) - -end function gmlt - -! ======================================================================= -! initialization -! prepare saturation water vapor pressure tables -! ======================================================================= -!>@brief The subroutine 'qsmith_init' initializes lookup tables for saturation -!! water vapor pressure for the following utility routines that are designed -!! to return qs consistent with the assumptions in FV3. -!>@details The calculations are highly accurate values based on the Clausius-Clapeyron -!! equation. -! ======================================================================= -subroutine qsmith_init - - implicit none - - integer, parameter :: length = 2621 - - integer :: i - - if (.not. tables_are_initialized) then - - ! master = (mpp_pe () .eq. mpp_root_pe ()) - ! if (master) print *, ' gfdl mp: initializing qs tables' - - ! debug code - ! print *, mpp_pe (), allocated (table), allocated (table2), & - ! allocated (table3), allocated (tablew), allocated (des), & - ! allocated (des2), allocated (des3), allocated (desw) - ! end debug code - - ! generate es table (dt = 0.1 deg. c) - - allocate (table (length)) - allocate (table2 (length)) - allocate (table3 (length)) - allocate (tablew (length)) - allocate (des (length)) - allocate (des2 (length)) - allocate (des3 (length)) - allocate (desw (length)) - - call qs_table (length) - call qs_table2 (length) - call qs_table3 (length) - call qs_tablew (length) - - do i = 1, length - 1 - des (i) = max (0., table (i + 1) - table (i)) - des2 (i) = max (0., table2 (i + 1) - table2 (i)) - des3 (i) = max (0., table3 (i + 1) - table3 (i)) - desw (i) = max (0., tablew (i + 1) - tablew (i)) - enddo - des (length) = des (length - 1) - des2 (length) = des2 (length - 1) - des3 (length) = des3 (length - 1) - desw (length) = desw (length - 1) - - tables_are_initialized = .true. - - endif - -end subroutine qsmith_init - -! ======================================================================= -! compute the saturated specific humidity for table ii -!>@brief The function 'wqs1' returns the saturation vapor pressure over pure -!! liquid water for a given temperature and air density. -! ======================================================================= - -real function wqs1 (ta, den) - - implicit none - - !> pure water phase; universal dry / moist formular using air density - !> input "den" can be either dry or moist air density - - real, intent (in) :: ta, den - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = tablew (it) + (ap1 - it) * desw (it) - wqs1 = es / (rvgas * ta * den) - -end function wqs1 - -! ======================================================================= -! compute the gradient of saturated specific humidity for table ii -!>@brief The function 'wqs2' returns the saturation vapor pressure over pure -!! liquid water for a given temperature and air density, as well as the -!! analytic dqs/dT: rate of change of saturation vapor pressure WRT temperature. -! ======================================================================= - -real function wqs2 (ta, den, dqdt) - - implicit none - - !> pure water phase; universal dry / moist formular using air density - !> input "den" can be either dry or moist air density - - real, intent (in) :: ta, den - - real, intent (out) :: dqdt - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - - if (.not. tables_are_initialized) call qsmith_init - - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = tablew (it) + (ap1 - it) * desw (it) - wqs2 = es / (rvgas * ta * den) - it = ap1 - 0.5 - ! finite diff, del_t = 0.1: - dqdt = 10. * (desw (it) + (ap1 - it) * (desw (it + 1) - desw (it))) / (rvgas * ta * den) - -end function wqs2 - -! ======================================================================= -! compute wet buld temperature -!>@brief The function 'wet_bulb' uses 'wqs2' to compute the wet-bulb temperature -!! from the mixing ratio and the temperature. -! ======================================================================= - -real function wet_bulb (q, t, den) - - implicit none - - real, intent (in) :: t, q, den - - real :: qs, tp, dqdt - - wet_bulb = t - qs = wqs2 (wet_bulb, den, dqdt) - tp = 0.5 * (qs - q) / (1. + lcp * dqdt) * lcp - wet_bulb = wet_bulb - tp - - ! tp is negative if super - saturated - if (tp > 0.01) then - qs = wqs2 (wet_bulb, den, dqdt) - tp = (qs - q) / (1. + lcp * dqdt) * lcp - wet_bulb = wet_bulb - tp - endif - -end function wet_bulb - -! ======================================================================= -!>@brief The function 'iqs1' computes the saturated specific humidity -!! for table iii -! ======================================================================= - -real function iqs1 (ta, den) - - implicit none - - !> water - ice phase; universal dry / moist formular using air density - !> input "den" can be either dry or moist air density - - real, intent (in) :: ta, den - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = table2 (it) + (ap1 - it) * des2 (it) - iqs1 = es / (rvgas * ta * den) - -end function iqs1 - -! ======================================================================= -!>@brief The function 'iqs2' computes the gradient of saturated specific -!! humidity for table iii -! ======================================================================= - -real function iqs2 (ta, den, dqdt) - - implicit none - - !> water - ice phase; universal dry / moist formular using air density - !> input "den" can be either dry or moist air density - - real, intent (in) :: ta, den - - real, intent (out) :: dqdt - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = table2 (it) + (ap1 - it) * des2 (it) - iqs2 = es / (rvgas * ta * den) - it = ap1 - 0.5 - dqdt = 10. * (des2 (it) + (ap1 - it) * (des2 (it + 1) - des2 (it))) / (rvgas * ta * den) - -end function iqs2 - -! ======================================================================= -!>@brief The function 'qs1d_moist' computes the gradient of saturated -!! specific humidity for table iii. -! ======================================================================= - -real function qs1d_moist (ta, qv, pa, dqdt) - - implicit none - - real, intent (in) :: ta, pa, qv - - real, intent (out) :: dqdt - - real :: es, ap1, tmin, eps10 - - integer :: it - - tmin = table_ice - 160. - eps10 = 10. * eps - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = table2 (it) + (ap1 - it) * des2 (it) - qs1d_moist = eps * es * (1. + zvir * qv) / pa - it = ap1 - 0.5 - dqdt = eps10 * (des2 (it) + (ap1 - it) * (des2 (it + 1) - des2 (it))) * (1. + zvir * qv) / pa - -end function qs1d_moist - -! ======================================================================= -! compute the gradient of saturated specific humidity for table ii -!>@brief The function 'wqsat2_moist' computes the saturated specific humidity -!! for pure liquid water , as well as des/dT. -! ======================================================================= - -real function wqsat2_moist (ta, qv, pa, dqdt) - - implicit none - - real, intent (in) :: ta, pa, qv - - real, intent (out) :: dqdt - - real :: es, ap1, tmin, eps10 - - integer :: it - - tmin = table_ice - 160. - eps10 = 10. * eps - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = tablew (it) + (ap1 - it) * desw (it) - wqsat2_moist = eps * es * (1. + zvir * qv) / pa - it = ap1 - 0.5 - dqdt = eps10 * (desw (it) + (ap1 - it) * (desw (it + 1) - desw (it))) * (1. + zvir * qv) / pa - -end function wqsat2_moist - -! ======================================================================= -! compute the saturated specific humidity for table ii -!>@brief The function 'wqsat_moist' computes the saturated specific humidity -!! for pure liquid water. -! ======================================================================= - -real function wqsat_moist (ta, qv, pa) - - implicit none - - real, intent (in) :: ta, pa, qv - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = tablew (it) + (ap1 - it) * desw (it) - wqsat_moist = eps * es * (1. + zvir * qv) / pa - -end function wqsat_moist - -! ======================================================================= -!>@brief The function 'qs1d_m' computes the saturated specific humidity -!! for table iii -! ======================================================================= - -real function qs1d_m (ta, qv, pa) - - implicit none - - real, intent (in) :: ta, pa, qv - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = table2 (it) + (ap1 - it) * des2 (it) - qs1d_m = eps * es * (1. + zvir * qv) / pa - -end function qs1d_m - -! ======================================================================= -!>@brief The function 'd_sat' computes the difference in saturation -!! vapor * density * between water and ice -! ======================================================================= - -real function d_sat (ta, den) - - implicit none - - real, intent (in) :: ta, den - - real :: es_w, es_i, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es_w = tablew (it) + (ap1 - it) * desw (it) - es_i = table2 (it) + (ap1 - it) * des2 (it) - d_sat = dim (es_w, es_i) / (rvgas * ta * den) ! take positive difference - -end function d_sat - -! ======================================================================= -!>@brief The function 'esw_table' computes the saturated water vapor -!! pressure for table ii -! ======================================================================= - -real function esw_table (ta) - - implicit none - - real, intent (in) :: ta - - real :: ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - esw_table = tablew (it) + (ap1 - it) * desw (it) - -end function esw_table - -! ======================================================================= -!>@brief The function 'es2_table' computes the saturated water -!! vapor pressure for table iii -! ======================================================================= - -real function es2_table (ta) - - implicit none - - real, intent (in) :: ta - - real :: ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (ta, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es2_table = table2 (it) + (ap1 - it) * des2 (it) - -end function es2_table - -! ======================================================================= -!>@brief The subroutine 'esw_table1d' computes the saturated water vapor -!! pressure for table ii. -! ======================================================================= - -subroutine esw_table1d (ta, es, n) - - implicit none - - integer, intent (in) :: n - - real, intent (in) :: ta (n) - - real, intent (out) :: es (n) - - real :: ap1, tmin - - integer :: i, it - - tmin = table_ice - 160. - - do i = 1, n - ap1 = 10. * dim (ta (i), tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es (i) = tablew (it) + (ap1 - it) * desw (it) - enddo - -end subroutine esw_table1d - -! ======================================================================= -!>@brief The subroutine 'es3_table1d' computes the saturated water vapor -!! pressure for table iii. -! ======================================================================= - -subroutine es2_table1d (ta, es, n) - - implicit none - - integer, intent (in) :: n - - real, intent (in) :: ta (n) - - real, intent (out) :: es (n) - - real :: ap1, tmin - - integer :: i, it - - tmin = table_ice - 160. - - do i = 1, n - ap1 = 10. * dim (ta (i), tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es (i) = table2 (it) + (ap1 - it) * des2 (it) - enddo - -end subroutine es2_table1d - -! ======================================================================= -!>@brief The subroutine 'es3_table1d' computes the saturated water vapor -!! pressure for table iv. -! ======================================================================= - -subroutine es3_table1d (ta, es, n) - - implicit none - - integer, intent (in) :: n - - real, intent (in) :: ta (n) - - real, intent (out) :: es (n) - - real :: ap1, tmin - - integer :: i, it - - tmin = table_ice - 160. - - do i = 1, n - ap1 = 10. * dim (ta (i), tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es (i) = table3 (it) + (ap1 - it) * des3 (it) - enddo - -end subroutine es3_table1d - -! ======================================================================= -!>@brief saturation water vapor pressure table ii -! 1 - phase table -! ======================================================================= - -subroutine qs_tablew (n) - - implicit none - - integer, intent (in) :: n - - real :: delt = 0.1 - real :: tmin, tem, fac0, fac1, fac2 - - integer :: i - - tmin = table_ice - 160. - - ! ----------------------------------------------------------------------- - ! compute es over water - ! ----------------------------------------------------------------------- - - do i = 1, n - tem = tmin + delt * real (i - 1) - fac0 = (tem - t_ice) / (tem * t_ice) - fac1 = fac0 * lv0 - fac2 = (dc_vap * log (tem / t_ice) + fac1) / rvgas - tablew (i) = e00 * exp (fac2) - enddo - -end subroutine qs_tablew - -! ======================================================================= -!>@brief saturation water vapor pressure table iii -! 2 - phase table -! ======================================================================= - -subroutine qs_table2 (n) - - implicit none - - integer, intent (in) :: n - - real :: delt = 0.1 - real :: tmin, tem0, tem1, fac0, fac1, fac2 - - integer :: i, i0, i1 - - tmin = table_ice - 160. - - do i = 1, n - tem0 = tmin + delt * real (i - 1) - fac0 = (tem0 - t_ice) / (tem0 * t_ice) - if (i <= 1600) then - ! ----------------------------------------------------------------------- - ! compute es over ice between - 160 deg c and 0 deg c. - ! ----------------------------------------------------------------------- - fac1 = fac0 * li2 - fac2 = (d2ice * log (tem0 / t_ice) + fac1) / rvgas - else - ! ----------------------------------------------------------------------- - ! compute es over water between 0 deg c and 102 deg c. - ! ----------------------------------------------------------------------- - fac1 = fac0 * lv0 - fac2 = (dc_vap * log (tem0 / t_ice) + fac1) / rvgas - endif - table2 (i) = e00 * exp (fac2) - enddo - - ! ----------------------------------------------------------------------- - ! smoother around 0 deg c - ! ----------------------------------------------------------------------- - - i0 = 1600 - i1 = 1601 - tem0 = 0.25 * (table2 (i0 - 1) + 2. * table (i0) + table2 (i0 + 1)) - tem1 = 0.25 * (table2 (i1 - 1) + 2. * table (i1) + table2 (i1 + 1)) - table2 (i0) = tem0 - table2 (i1) = tem1 - -end subroutine qs_table2 - -! ======================================================================= -!>@brief saturation water vapor pressure table iv -! 2 - phase table with " - 2 c" as the transition point -! ======================================================================= - -subroutine qs_table3 (n) - - implicit none - - integer, intent (in) :: n - - real :: delt = 0.1 - real :: esbasw, tbasw, esbasi, tmin, tem, aa, b, c, d, e - real :: tem0, tem1 - - integer :: i, i0, i1 - - esbasw = 1013246.0 - tbasw = table_ice + 100. - esbasi = 6107.1 - tmin = table_ice - 160. - - do i = 1, n - tem = tmin + delt * real (i - 1) - ! if (i <= 1600) then - if (i <= 1580) then ! change to - 2 c - ! ----------------------------------------------------------------------- - ! compute es over ice between - 160 deg c and 0 deg c. - ! see smithsonian meteorological tables page 350. - ! ----------------------------------------------------------------------- - aa = - 9.09718 * (table_ice / tem - 1.) - b = - 3.56654 * alog10 (table_ice / tem) - c = 0.876793 * (1. - tem / table_ice) - e = alog10 (esbasi) - table3 (i) = 0.1 * 10 ** (aa + b + c + e) - else - ! ----------------------------------------------------------------------- - ! compute es over water between - 2 deg c and 102 deg c. - ! see smithsonian meteorological tables page 350. - ! ----------------------------------------------------------------------- - aa = - 7.90298 * (tbasw / tem - 1.) - b = 5.02808 * alog10 (tbasw / tem) - c = - 1.3816e-7 * (10 ** ((1. - tem / tbasw) * 11.344) - 1.) - d = 8.1328e-3 * (10 ** ((tbasw / tem - 1.) * (- 3.49149)) - 1.) - e = alog10 (esbasw) - table3 (i) = 0.1 * 10 ** (aa + b + c + d + e) - endif - enddo - - ! ----------------------------------------------------------------------- - ! smoother around - 2 deg c - ! ----------------------------------------------------------------------- - - i0 = 1580 - i1 = 1581 - tem0 = 0.25 * (table3 (i0 - 1) + 2. * table (i0) + table3 (i0 + 1)) - tem1 = 0.25 * (table3 (i1 - 1) + 2. * table (i1) + table3 (i1 + 1)) - table3 (i0) = tem0 - table3 (i1) = tem1 - -end subroutine qs_table3 - -! ======================================================================= -! compute the saturated specific humidity for table -! note: this routine is based on "moist" mixing ratio -!>@brief The function 'qs_blend' computes the saturated specific humidity -!! with a blend of water and ice depending on the temperature. -! ======================================================================= - -real function qs_blend (t, p, q) - - implicit none - - real, intent (in) :: t, p, q - - real :: es, ap1, tmin - - integer :: it - - tmin = table_ice - 160. - ap1 = 10. * dim (t, tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es = table (it) + (ap1 - it) * des (it) - qs_blend = eps * es * (1. + zvir * q) / p - -end function qs_blend - -! ======================================================================= -!>@brief saturation water vapor pressure table i -! 3 - phase table -! ======================================================================= - -subroutine qs_table (n) - - implicit none - - integer, intent (in) :: n - - real :: delt = 0.1 - real :: tmin, tem, esh20 - real :: wice, wh2o, fac0, fac1, fac2 - real :: esupc (200) - - integer :: i - - tmin = table_ice - 160. - - ! ----------------------------------------------------------------------- - ! compute es over ice between - 160 deg c and 0 deg c. - ! ----------------------------------------------------------------------- - - do i = 1, 1600 - tem = tmin + delt * real (i - 1) - fac0 = (tem - t_ice) / (tem * t_ice) - fac1 = fac0 * li2 - fac2 = (d2ice * log (tem / t_ice) + fac1) / rvgas - table (i) = e00 * exp (fac2) - enddo - - ! ----------------------------------------------------------------------- - ! compute es over water between - 20 deg c and 102 deg c. - ! ----------------------------------------------------------------------- - - do i = 1, 1221 - tem = 253.16 + delt * real (i - 1) - fac0 = (tem - t_ice) / (tem * t_ice) - fac1 = fac0 * lv0 - fac2 = (dc_vap * log (tem / t_ice) + fac1) / rvgas - esh20 = e00 * exp (fac2) - if (i <= 200) then - esupc (i) = esh20 - else - table (i + 1400) = esh20 - endif - enddo - - ! ----------------------------------------------------------------------- - ! derive blended es over ice and supercooled water between - 20 deg c and 0 deg c - ! ----------------------------------------------------------------------- - - do i = 1, 200 - tem = 253.16 + delt * real (i - 1) - wice = 0.05 * (table_ice - tem) - wh2o = 0.05 * (tem - 253.16) - table (i + 1400) = wice * table (i + 1400) + wh2o * esupc (i) - enddo - -end subroutine qs_table - -! ======================================================================= -! compute the saturated specific humidity and the gradient of saturated specific humidity -! input t in deg k, p in pa; p = rho rdry tv, moist pressure -!>@brief The function 'qsmith' computes the saturated specific humidity -!! with a blend of water and ice depending on the temperature in 3D. -!@details It als oincludes the option for computing des/dT. -! ======================================================================= - -subroutine qsmith (im, km, ks, t, p, q, qs, dqdt) - - implicit none - - integer, intent (in) :: im, km, ks - - real, intent (in), dimension (im, km) :: t, p, q - - real, intent (out), dimension (im, km) :: qs - - real, intent (out), dimension (im, km), optional :: dqdt - - real :: eps10, ap1, tmin - - real, dimension (im, km) :: es - - integer :: i, k, it - - tmin = table_ice - 160. - eps10 = 10. * eps - - if (.not. tables_are_initialized) then - call qsmith_init - endif - - do k = ks, km - do i = 1, im - ap1 = 10. * dim (t (i, k), tmin) + 1. - ap1 = min (2621., ap1) - it = ap1 - es (i, k) = table (it) + (ap1 - it) * des (it) - qs (i, k) = eps * es (i, k) * (1. + zvir * q (i, k)) / p (i, k) - enddo - enddo - - if (present (dqdt)) then - do k = ks, km - do i = 1, im - ap1 = 10. * dim (t (i, k), tmin) + 1. - ap1 = min (2621., ap1) - 0.5 - it = ap1 - dqdt (i, k) = eps10 * (des (it) + (ap1 - it) * (des (it + 1) - des (it))) * (1. + zvir * q (i, k)) / p (i, k) - enddo - enddo - endif - -end subroutine qsmith - -! ======================================================================= -!>@brief The subroutine 'neg_adj' fixes negative water species. -!>@details This is designed for 6-class micro-physics schemes. -! ======================================================================= - -subroutine neg_adj (ktop, kbot, pt, dp, qv, ql, qr, qi, qs, qg) - - implicit none - - integer, intent (in) :: ktop, kbot - - real, intent (in), dimension (ktop:kbot) :: dp - - real, intent (inout), dimension (ktop:kbot) :: pt, qv, ql, qr, qi, qs, qg - - real, dimension (ktop:kbot) :: lcpk, icpk - - real :: dq, cvm - - integer :: k - - ! ----------------------------------------------------------------------- - ! define heat capacity and latent heat coefficient - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - cvm = c_air + qv (k) * c_vap + (qr (k) + ql (k)) * c_liq + (qi (k) + qs (k) + qg (k)) * c_ice - lcpk (k) = (lv00 + d0_vap * pt (k)) / cvm - icpk (k) = (li00 + dc_ice * pt (k)) / cvm - enddo - - do k = ktop, kbot - - ! ----------------------------------------------------------------------- - ! ice phase: - ! ----------------------------------------------------------------------- - - ! if cloud ice < 0, borrow from snow - if (qi (k) < 0.) then - qs (k) = qs (k) + qi (k) - qi (k) = 0. - endif - ! if snow < 0, borrow from graupel - if (qs (k) < 0.) then - qg (k) = qg (k) + qs (k) - qs (k) = 0. - endif - ! if graupel < 0, borrow from rain - if (qg (k) < 0.) then - qr (k) = qr (k) + qg (k) - pt (k) = pt (k) - qg (k) * icpk (k) ! heating - qg (k) = 0. - endif - - ! ----------------------------------------------------------------------- - ! liquid phase: - ! ----------------------------------------------------------------------- - - ! if rain < 0, borrow from cloud water - if (qr (k) < 0.) then - ql (k) = ql (k) + qr (k) - qr (k) = 0. - endif - ! if cloud water < 0, borrow from water vapor - if (ql (k) < 0.) then - qv (k) = qv (k) + ql (k) - pt (k) = pt (k) - ql (k) * lcpk (k) ! heating - ql (k) = 0. - endif - - enddo - - ! ----------------------------------------------------------------------- - ! fix water vapor; borrow from below - ! ----------------------------------------------------------------------- - - do k = ktop, kbot - 1 - if (qv (k) < 0.) then - qv (k + 1) = qv (k + 1) + qv (k) * dp (k) / dp (k + 1) - qv (k) = 0. - endif - enddo - - ! ----------------------------------------------------------------------- - ! bottom layer; borrow from above - ! ----------------------------------------------------------------------- - - if (qv (kbot) < 0. .and. qv (kbot - 1) > 0.) then - dq = min (- qv (kbot) * dp (kbot), qv (kbot - 1) * dp (kbot - 1)) - qv (kbot - 1) = qv (kbot - 1) - dq / dp (kbot - 1) - qv (kbot) = qv (kbot) + dq / dp (kbot) - endif - -end subroutine neg_adj - -! ======================================================================= -! compute global sum -!>@brief quick local sum algorithm -! ======================================================================= - -!real function g_sum (p, ifirst, ilast, jfirst, jlast, area, mode) -! -! use mpp_mod, only: mpp_sum -! -! implicit none -! -! integer, intent (in) :: ifirst, ilast, jfirst, jlast -! integer, intent (in) :: mode ! if == 1 divided by area -! -! real, intent (in), dimension (ifirst:ilast, jfirst:jlast) :: p, area -! -! integer :: i, j -! -! real :: gsum -! -! if (global_area < 0.) then -! global_area = 0. -! do j = jfirst, jlast -! do i = ifirst, ilast -! global_area = global_area + area (i, j) -! enddo -! enddo -! call mpp_sum (global_area) -! endif -! -! gsum = 0. -! do j = jfirst, jlast -! do i = ifirst, ilast -! gsum = gsum + p (i, j) * area (i, j) -! enddo -! enddo -! call mpp_sum (gsum) -! -! if (mode == 1) then -! g_sum = gsum / global_area -! else -! g_sum = gsum -! endif -! -!end function g_sum - -! ========================================================================== -!>@brief The subroutine 'interpolate_z' interpolates to a prescribed height. -! ========================================================================== - -subroutine interpolate_z (is, ie, js, je, km, zl, hgt, a3, a2) - - implicit none - - integer, intent (in) :: is, ie, js, je, km - - real, intent (in), dimension (is:ie, js:je, km) :: a3 - - real, intent (in), dimension (is:ie, js:je, km + 1) :: hgt !< hgt (k) > hgt (k + 1) - - real, intent (in) :: zl - - real, intent (out), dimension (is:ie, js:je) :: a2 - - real, dimension (km) :: zm !< middle layer height - - integer :: i, j, k - - !$omp parallel do default (none) shared (is, ie, js, je, km, hgt, zl, a2, a3) private (zm) - - do j = js, je - do i = is, ie - do k = 1, km - zm (k) = 0.5 * (hgt (i, j, k) + hgt (i, j, k + 1)) - enddo - if (zl >= zm (1)) then - a2 (i, j) = a3 (i, j, 1) - elseif (zl <= zm (km)) then - a2 (i, j) = a3 (i, j, km) - else - do k = 1, km - 1 - if (zl <= zm (k) .and. zl >= zm (k + 1)) then - a2 (i, j) = a3 (i, j, k) + (a3 (i, j, k + 1) - a3 (i, j, k)) * (zm (k) - zl) / (zm (k) - zm (k + 1)) - exit - endif - enddo - endif - enddo - enddo - -end subroutine interpolate_z - -! ======================================================================= -!>@brief The subroutine 'cloud_diagnosis' diagnoses the radius of cloud -!! species. -!>author Linjiong Zhoum, Shian-Jiann Lin -! ======================================================================= - -subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, qmg, t, & - rew, rei, rer, res, reg) - - implicit none - - integer, intent (in) :: is, ie, ks, ke - integer, intent (in), dimension (is:ie) :: lsm ! land sea mask, 0: ocean, 1: land, 2: sea ice - - real, intent (in), dimension (is:ie, ks:ke) :: den, delp, t - real, intent (in), dimension (is:ie, ks:ke) :: qmw, qmi, qmr, qms, qmg !< units: kg / kg - - real, intent (out), dimension (is:ie, ks:ke) :: rew, rei, rer, res, reg !< units: micron - - real, dimension (is:ie, ks:ke) :: qcw, qci, qcr, qcs, qcg !< units: g / m^2 - - integer :: i, k - - real :: lambdar, lambdas, lambdag - real :: dpg, rei_fac, mask, ccn, bw - real, parameter :: rho_0 = 50.e-3 - - real :: rhow = 1.0e3, rhor = 1.0e3, rhos = 1.0e2, rhog = 4.0e2 - real :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 - real :: alphar = 0.8, alphas = 0.25, alphag = 0.5 - real :: gammar = 17.837789, gammas = 8.2850630, gammag = 11.631769 - real :: qmin = 1.0e-12, beta = 1.22 - - do k = ks, ke - do i = is, ie - - dpg = abs (delp (i, k)) / grav - mask = min (max (real(lsm (i)), 0.0), 2.0) - - ! ----------------------------------------------------------------------- - ! cloud water (Martin et al., 1994) - ! ----------------------------------------------------------------------- - - ccn = 0.80 * (- 1.15e-3 * (ccn_o ** 2) + 0.963 * ccn_o + 5.30) * abs (mask - 1.0) + & - 0.67 * (- 2.10e-4 * (ccn_l ** 2) + 0.568 * ccn_l - 27.9) * (1.0 - abs (mask - 1.0)) - - if (qmw (i, k) .gt. qmin) then - qcw (i, k) = dpg * qmw (i, k) * 1.0e3 - rew (i, k) = exp (1.0 / 3.0 * log ((3.0 * den (i, k) * qmw (i, k)) / (4.0 * pi * rhow * ccn))) * 1.0e4 - rew (i, k) = max (rewmin, min (rewmax, rew (i, k))) - else - qcw (i, k) = 0.0 - rew (i, k) = rewmin - endif - - if (reiflag .eq. 1) then - - ! ----------------------------------------------------------------------- - ! cloud ice (Heymsfield and Mcfarquhar, 1996) - ! ----------------------------------------------------------------------- - - if (qmi (i, k) .gt. qmin) then - qci (i, k) = dpg * qmi (i, k) * 1.0e3 - rei_fac = log (1.0e3 * qmi (i, k) * den (i, k)) - if (t (i, k) - tice .lt. - 50) then - rei (i, k) = beta / 9.917 * exp (0.109 * rei_fac) * 1.0e3 - elseif (t (i, k) - tice .lt. - 40) then - rei (i, k) = beta / 9.337 * exp (0.080 * rei_fac) * 1.0e3 - elseif (t (i, k) - tice .lt. - 30) then - rei (i, k) = beta / 9.208 * exp (0.055 * rei_fac) * 1.0e3 - else - rei (i, k) = beta / 9.387 * exp (0.031 * rei_fac) * 1.0e3 - endif - rei (i, k) = max (reimin, min (reimax, rei (i, k))) - else - qci (i, k) = 0.0 - rei (i, k) = reimin - endif - - endif - - if (reiflag .eq. 2) then - - ! ----------------------------------------------------------------------- - ! cloud ice (Wyser, 1998) - ! ----------------------------------------------------------------------- - - if (qmi (i, k) .gt. qmin) then - qci (i, k) = dpg * qmi (i, k) * 1.0e3 - bw = - 2. + 1.e-3 * log10 (den (i, k) * qmi (i, k) / rho_0) * max (0.0, tice - t (i, k)) ** 1.5 - rei (i, k) = 377.4 + bw * (203.3 + bw * (37.91 + 2.3696 * bw)) - rei (i, k) = max (reimin, min (reimax, rei (i, k))) - else - qci (i, k) = 0.0 - rei (i, k) = reimin - endif - - endif - - ! ----------------------------------------------------------------------- - ! rain (Lin et al., 1983) - ! ----------------------------------------------------------------------- - - if (qmr (i, k) .gt. qmin) then - qcr (i, k) = dpg * qmr (i, k) * 1.0e3 - lambdar = exp (0.25 * log (pi * rhor * n0r / qmr (i, k) / den (i, k))) - rer (i, k) = 0.5 * exp (log (gammar / 6) / alphar) / lambdar * 1.0e6 - rer (i, k) = max (rermin, min (rermax, rer (i, k))) - else - qcr (i, k) = 0.0 - rer (i, k) = rermin - endif - - ! ----------------------------------------------------------------------- - ! snow (Lin et al., 1983) - ! ----------------------------------------------------------------------- - - if (qms (i, k) .gt. qmin) then - qcs (i, k) = dpg * qms (i, k) * 1.0e3 - lambdas = exp (0.25 * log (pi * rhos * n0s / qms (i, k) / den (i, k))) - res (i, k) = 0.5 * exp (log (gammas / 6) / alphas) / lambdas * 1.0e6 - res (i, k) = max (resmin, min (resmax, res (i, k))) - else - qcs (i, k) = 0.0 - res (i, k) = resmin - endif - - ! ----------------------------------------------------------------------- - ! graupel (Lin et al., 1983) - ! ----------------------------------------------------------------------- - - if (qmg (i, k) .gt. qmin) then - qcg (i, k) = dpg * qmg (i, k) * 1.0e3 - lambdag = exp (0.25 * log (pi * rhog * n0g / qmg (i, k) / den (i, k))) - reg (i, k) = 0.5 * exp (log (gammag / 6) / alphag) / lambdag * 1.0e6 - reg (i, k) = max (regmin, min (regmax, reg (i, k))) - else - qcg (i, k) = 0.0 - reg (i, k) = regmin - endif - - enddo - enddo - -end subroutine cloud_diagnosis - -!+---+-----------------------------------------------------------------+ - - subroutine refl10cm_gfdl (qv1d, qr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, ii,jj, melti) - - IMPLICIT NONE - -!..Sub arguments - INTEGER, INTENT(IN):: kts, kte, ii,jj - REAL, DIMENSION(kts:kte), INTENT(IN):: & - qv1d, qr1d, qs1d, qg1d, t1d, p1d - REAL, DIMENSION(kts:kte), INTENT(INOUT):: dBZ - -!..Local variables - REAL, DIMENSION(kts:kte):: temp, pres, qv, rho - REAL, DIMENSION(kts:kte):: rr, rs, rg -! REAL:: temp_C - - DOUBLE PRECISION, DIMENSION(kts:kte):: ilamr, ilams, ilamg - DOUBLE PRECISION, DIMENSION(kts:kte):: N0_r, N0_s, N0_g - DOUBLE PRECISION:: lamr, lams, lamg - LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg - - REAL, DIMENSION(kts:kte):: ze_rain, ze_snow, ze_graupel - DOUBLE PRECISION:: fmelt_s, fmelt_g - - INTEGER:: i, k, k_0, kbot, n - LOGICAL, INTENT(IN):: melti - DOUBLE PRECISION:: cback, x, eta, f_d -!+---+ - - do k = kts, kte - dBZ(k) = -35.0 - enddo - -!+---+-----------------------------------------------------------------+ -!..Put column of data into local arrays. -!+---+-----------------------------------------------------------------+ - do k = kts, kte - temp(k) = t1d(k) -! temp_C = min(-0.001, temp(K)-273.15) - qv(k) = MAX(1.E-10, qv1d(k)) - pres(k) = p1d(k) - rho(k) = 0.622*pres(k)/(rdgas*temp(k)*(qv(k)+0.622)) - - if (qr1d(k) .gt. 1.E-9) then - rr(k) = qr1d(k)*rho(k) - N0_r(k) = n0r - lamr = (xam_r*xcrg(3)*N0_r(k)/rr(k))**(1./xcre(1)) - ilamr(k) = 1./lamr - L_qr(k) = .true. - else - rr(k) = 1.E-12 - L_qr(k) = .false. - endif - - if (qs1d(k) .gt. 1.E-9) then - rs(k) = qs1d(k)*rho(k) - N0_s(k) = n0s - lams = (xam_s*xcsg(3)*N0_s(k)/rs(k))**(1./xcse(1)) - ilams(k) = 1./lams - L_qs(k) = .true. - else - rs(k) = 1.E-12 - L_qs(k) = .false. - endif - - if (qg1d(k) .gt. 1.E-9) then - rg(k) = qg1d(k)*rho(k) - N0_g(k) = n0g - lamg = (xam_g*xcgg(3)*N0_g(k)/rg(k))**(1./xcge(1)) - ilamg(k) = 1./lamg - L_qg(k) = .true. - else - rg(k) = 1.E-12 - L_qg(k) = .false. - endif - enddo - -!+---+-----------------------------------------------------------------+ -!..Locate K-level of start of melting (k_0 is level above). -!+---+-----------------------------------------------------------------+ - k_0 = kts - K_LOOP:do k = kte-1, kts, -1 - if ( melti .and. (temp(k).gt.273.15) .and. L_qr(k) & - .and. (L_qs(k+1).or.L_qg(k+1)) ) then - k_0 = MAX(k+1, k_0) - EXIT K_LOOP - endif - enddo K_LOOP -!+---+-----------------------------------------------------------------+ -!..Assume Rayleigh approximation at 10 cm wavelength. Rain (all temps) -!.. and non-water-coated snow and graupel when below freezing are -!.. simple. Integrations of m(D)*m(D)*N(D)*dD. -!+---+-----------------------------------------------------------------+ - do k = kts, kte - ze_rain(k) = 1.e-22 - ze_snow(k) = 1.e-22 - ze_graupel(k) = 1.e-22 - if (L_qr(k)) ze_rain(k) = N0_r(k)*xcrg(4)*ilamr(k)**xcre(4) - if (L_qs(k)) ze_snow(k) = (0.176/0.93) * (6.0/PI)*(6.0/PI) & - * (xam_s/900.0)*(xam_s/900.0) & - * N0_s(k)*xcsg(4)*ilams(k)**xcse(4) - if (L_qg(k)) ze_graupel(k) = (0.176/0.93) * (6.0/PI)*(6.0/PI) & - * (xam_g/900.0)*(xam_g/900.0) & - * N0_g(k)*xcgg(4)*ilamg(k)**xcge(4) - enddo - - -!+---+-----------------------------------------------------------------+ -!..Special case of melting ice (snow/graupel) particles. Assume the -!.. ice is surrounded by the liquid water. Fraction of meltwater is -!.. extremely simple based on amount found above the melting level. -!.. Uses code from Uli Blahak (rayleigh_soak_wetgraupel and supporting -!.. routines). -!+---+-----------------------------------------------------------------+ - - if (melti .and. k_0.ge.kts+1) then - do k = k_0-1, kts, -1 - -!..Reflectivity contributed by melting snow - if (L_qs(k) .and. L_qs(k_0) ) then - fmelt_s = MAX(0.005d0, MIN(1.0d0-rs(k)/rs(k_0), 0.99d0)) - eta = 0.d0 - lams = 1./ilams(k) - do n = 1, nrbins - x = xam_s * xxDs(n)**xbm_s - call rayleigh_soak_wetgraupel (x,DBLE(xocms),DBLE(xobms), & - fmelt_s, melt_outside_s, m_w_0, m_i_0, lamda_radar, & - CBACK, mixingrulestring_s, matrixstring_s, & - inclusionstring_s, hoststring_s, & - hostmatrixstring_s, hostinclusionstring_s) - f_d = N0_s(k)*xxDs(n)**xmu_s * DEXP(-lams*xxDs(n)) - eta = eta + f_d * CBACK * simpson(n) * xdts(n) - enddo - ze_snow(k) = SNGL(lamda4 / (pi5 * K_w) * eta) - endif - - -!..Reflectivity contributed by melting graupel - - if (L_qg(k) .and. L_qg(k_0) ) then - fmelt_g = MAX(0.005d0, MIN(1.0d0-rg(k)/rg(k_0), 0.99d0)) - eta = 0.d0 - lamg = 1./ilamg(k) - do n = 1, nrbins - x = xam_g * xxDg(n)**xbm_g - call rayleigh_soak_wetgraupel (x,DBLE(xocmg),DBLE(xobmg), & - fmelt_g, melt_outside_g, m_w_0, m_i_0, lamda_radar, & - CBACK, mixingrulestring_g, matrixstring_g, & - inclusionstring_g, hoststring_g, & - hostmatrixstring_g, hostinclusionstring_g) - f_d = N0_g(k)*xxDg(n)**xmu_g * DEXP(-lamg*xxDg(n)) - eta = eta + f_d * CBACK * simpson(n) * xdtg(n) - enddo - ze_graupel(k) = SNGL(lamda4 / (pi5 * K_w) * eta) - endif - - enddo - endif - - do k = kte, kts, -1 - dBZ(k) = 10.*log10((ze_rain(k)+ze_snow(k)+ze_graupel(k))*1.d18) - enddo - - - end subroutine refl10cm_gfdl -!+---+-----------------------------------------------------------------+ - -end module gfdl_cloud_microphys_mod diff --git a/src/dynamics/fv3/microphys/module_mp_radar.F90 b/src/dynamics/fv3/microphys/module_mp_radar.F90 deleted file mode 100644 index 8a16c98260..0000000000 --- a/src/dynamics/fv3/microphys/module_mp_radar.F90 +++ /dev/null @@ -1,614 +0,0 @@ -!+---+-----------------------------------------------------------------+ -!..This set of routines facilitates computing radar reflectivity. -!.. This module is more library code whereas the individual microphysics -!.. schemes contains specific details needed for the final computation, -!.. so refer to location within each schemes calling the routine named -!.. rayleigh_soak_wetgraupel. -!.. The bulk of this code originated from Ulrich Blahak (Germany) and -!.. was adapted to WRF by G. Thompson. This version of code is only -!.. intended for use when Rayleigh scattering principles dominate and -!.. is not intended for wavelengths in which Mie scattering is a -!.. significant portion. Therefore, it is well-suited to use with -!.. 5 or 10 cm wavelength like USA NEXRAD radars. -!.. This code makes some rather simple assumptions about water -!.. coating on outside of frozen species (snow/graupel). Fraction of -!.. meltwater is simply the ratio of mixing ratio below melting level -!.. divided by mixing ratio at level just above highest T>0C. Also, -!.. immediately 90% of the melted water exists on the ice's surface -!.. and 10% is embedded within ice. No water is "shed" at all in these -!.. assumptions. The code is quite slow because it does the reflectivity -!.. calculations based on 50 individual size bins of the distributions. -!+---+-----------------------------------------------------------------+ - - MODULE module_mp_radar - - PUBLIC :: rayleigh_soak_wetgraupel - PUBLIC :: radar_init - PRIVATE :: m_complex_water_ray - PRIVATE :: m_complex_ice_maetzler - PRIVATE :: m_complex_maxwellgarnett - PRIVATE :: get_m_mix_nested - PRIVATE :: get_m_mix - PRIVATE :: WGAMMA - PRIVATE :: GAMMLN - - - INTEGER, PARAMETER, PUBLIC:: nrbins = 50 - DOUBLE PRECISION, DIMENSION(nrbins+1), PUBLIC:: xxDx - DOUBLE PRECISION, DIMENSION(nrbins), PUBLIC:: xxDs,xdts,xxDg,xdtg - DOUBLE PRECISION, PARAMETER, PUBLIC:: lamda_radar = 0.10 ! in meters - DOUBLE PRECISION, PUBLIC:: K_w, PI5, lamda4 - COMPLEX*16, PUBLIC:: m_w_0, m_i_0 - DOUBLE PRECISION, DIMENSION(nrbins+1), PUBLIC:: simpson - DOUBLE PRECISION, DIMENSION(3), PARAMETER, PUBLIC:: basis = & - (/1.d0/3.d0, 4.d0/3.d0, 1.d0/3.d0/) - REAL, DIMENSION(4), PUBLIC:: xcre, xcse, xcge, xcrg, xcsg, xcgg - REAL, PUBLIC:: xam_r, xbm_r, xmu_r, xobmr - REAL, PUBLIC:: xam_s, xbm_s, xmu_s, xoams, xobms, xocms - REAL, PUBLIC:: xam_g, xbm_g, xmu_g, xoamg, xobmg, xocmg - REAL, PUBLIC:: xorg2, xosg2, xogg2 - - INTEGER, PARAMETER, PUBLIC:: slen = 20 - CHARACTER(len=slen), PUBLIC:: & - mixingrulestring_s, matrixstring_s, inclusionstring_s, & - hoststring_s, hostmatrixstring_s, hostinclusionstring_s, & - mixingrulestring_g, matrixstring_g, inclusionstring_g, & - hoststring_g, hostmatrixstring_g, hostinclusionstring_g - -!..Single melting snow/graupel particle 90% meltwater on external sfc - DOUBLE PRECISION, PARAMETER:: melt_outside_s = 0.9d0 - DOUBLE PRECISION, PARAMETER:: melt_outside_g = 0.9d0 - - CHARACTER*256:: radar_debug - - CONTAINS - -!+---+-----------------------------------------------------------------+ -!+---+-----------------------------------------------------------------+ -!+---+-----------------------------------------------------------------+ - - subroutine radar_init - - IMPLICIT NONE - INTEGER:: n - PI5 = 3.14159*3.14159*3.14159*3.14159*3.14159 - lamda4 = lamda_radar*lamda_radar*lamda_radar*lamda_radar - m_w_0 = m_complex_water_ray (lamda_radar, 0.0d0) - m_i_0 = m_complex_ice_maetzler (lamda_radar, 0.0d0) - K_w = (ABS( (m_w_0*m_w_0 - 1.0) /(m_w_0*m_w_0 + 2.0) ))**2 - - do n = 1, nrbins+1 - simpson(n) = 0.0d0 - enddo - do n = 1, nrbins-1, 2 - simpson(n) = simpson(n) + basis(1) - simpson(n+1) = simpson(n+1) + basis(2) - simpson(n+2) = simpson(n+2) + basis(3) - enddo - - do n = 1, slen - mixingrulestring_s(n:n) = char(0) - matrixstring_s(n:n) = char(0) - inclusionstring_s(n:n) = char(0) - hoststring_s(n:n) = char(0) - hostmatrixstring_s(n:n) = char(0) - hostinclusionstring_s(n:n) = char(0) - mixingrulestring_g(n:n) = char(0) - matrixstring_g(n:n) = char(0) - inclusionstring_g(n:n) = char(0) - hoststring_g(n:n) = char(0) - hostmatrixstring_g(n:n) = char(0) - hostinclusionstring_g(n:n) = char(0) - enddo - - mixingrulestring_s = 'maxwellgarnett' - hoststring_s = 'air' - matrixstring_s = 'water' - inclusionstring_s = 'spheroidal' - hostmatrixstring_s = 'icewater' - hostinclusionstring_s = 'spheroidal' - - mixingrulestring_g = 'maxwellgarnett' - hoststring_g = 'air' - matrixstring_g = 'water' - inclusionstring_g = 'spheroidal' - hostmatrixstring_g = 'icewater' - hostinclusionstring_g = 'spheroidal' - -!..Create bins of snow (from 100 microns up to 2 cm). - xxDx(1) = 100.D-6 - xxDx(nrbins+1) = 0.02d0 - do n = 2, nrbins - xxDx(n) = DEXP(DFLOAT(n-1)/DFLOAT(nrbins) & - *DLOG(xxDx(nrbins+1)/xxDx(1)) +DLOG(xxDx(1))) - enddo - do n = 1, nrbins - xxDs(n) = DSQRT(xxDx(n)*xxDx(n+1)) - xdts(n) = xxDx(n+1) - xxDx(n) - enddo - -!..Create bins of graupel (from 100 microns up to 5 cm). - xxDx(1) = 100.D-6 - xxDx(nrbins+1) = 0.05d0 - do n = 2, nrbins - xxDx(n) = DEXP(DFLOAT(n-1)/DFLOAT(nrbins) & - *DLOG(xxDx(nrbins+1)/xxDx(1)) +DLOG(xxDx(1))) - enddo - do n = 1, nrbins - xxDg(n) = DSQRT(xxDx(n)*xxDx(n+1)) - xdtg(n) = xxDx(n+1) - xxDx(n) - enddo - - -!..The calling program must set the m(D) relations and gamma shape -!.. parameter mu for rain, snow, and graupel. Easily add other types -!.. based on the template here. For majority of schemes with simpler -!.. exponential number distribution, mu=0. - - xcre(1) = 1. + xbm_r - xcre(2) = 1. + xmu_r - xcre(3) = 1. + xbm_r + xmu_r - xcre(4) = 1. + 2.*xbm_r + xmu_r - do n = 1, 4 - xcrg(n) = WGAMMA(xcre(n)) - enddo - xorg2 = 1./xcrg(2) - - xcse(1) = 1. + xbm_s - xcse(2) = 1. + xmu_s - xcse(3) = 1. + xbm_s + xmu_s - xcse(4) = 1. + 2.*xbm_s + xmu_s - do n = 1, 4 - xcsg(n) = WGAMMA(xcse(n)) - enddo - xosg2 = 1./xcsg(2) - - xcge(1) = 1. + xbm_g - xcge(2) = 1. + xmu_g - xcge(3) = 1. + xbm_g + xmu_g - xcge(4) = 1. + 2.*xbm_g + xmu_g - do n = 1, 4 - xcgg(n) = WGAMMA(xcge(n)) - enddo - xogg2 = 1./xcgg(2) - - xobmr = 1./xbm_r - xoams = 1./xam_s - xobms = 1./xbm_s - xocms = xoams**xobms - xoamg = 1./xam_g - xobmg = 1./xbm_g - xocmg = xoamg**xobmg - - - end subroutine radar_init - -!+---+-----------------------------------------------------------------+ -!+---+-----------------------------------------------------------------+ - - COMPLEX*16 FUNCTION m_complex_water_ray(lambda,T) - -! Complex refractive Index of Water as function of Temperature T -! [deg C] and radar wavelength lambda [m]; valid for -! lambda in [0.001,1.0] m; T in [-10.0,30.0] deg C -! after Ray (1972) - - IMPLICIT NONE - DOUBLE PRECISION, INTENT(IN):: T,lambda - DOUBLE PRECISION:: epsinf,epss,epsr,epsi - DOUBLE PRECISION:: alpha,lambdas,sigma,nenner - COMPLEX*16, PARAMETER:: i = (0d0,1d0) - DOUBLE PRECISION, PARAMETER:: PIx=3.1415926535897932384626434d0 - - epsinf = 5.27137d0 + 0.02164740d0 * T - 0.00131198d0 * T*T - epss = 78.54d+0 * (1.0 - 4.579d-3 * (T - 25.0) & - + 1.190d-5 * (T - 25.0)*(T - 25.0) & - - 2.800d-8 * (T - 25.0)*(T - 25.0)*(T - 25.0)) - alpha = -16.8129d0/(T+273.16) + 0.0609265d0 - lambdas = 0.00033836d0 * exp(2513.98d0/(T+273.16)) * 1e-2 - - nenner = 1.d0+2.d0*(lambdas/lambda)**(1d0-alpha)*sin(alpha*PIx*0.5) & - + (lambdas/lambda)**(2d0-2d0*alpha) - epsr = epsinf + ((epss-epsinf) * ((lambdas/lambda)**(1d0-alpha) & - * sin(alpha*PIx*0.5)+1d0)) / nenner - epsi = ((epss-epsinf) * ((lambdas/lambda)**(1d0-alpha) & - * cos(alpha*PIx*0.5)+0d0)) / nenner & - + lambda*1.25664/1.88496 - - m_complex_water_ray = SQRT(CMPLX(epsr,-epsi)) - - END FUNCTION m_complex_water_ray - -!+---+-----------------------------------------------------------------+ - - COMPLEX*16 FUNCTION m_complex_ice_maetzler(lambda,T) - -! complex refractive index of ice as function of Temperature T -! [deg C] and radar wavelength lambda [m]; valid for -! lambda in [0.0001,30] m; T in [-250.0,0.0] C -! Original comment from the Matlab-routine of Prof. Maetzler: -! Function for calculating the relative permittivity of pure ice in -! the microwave region, according to C. Maetzler, "Microwave -! properties of ice and snow", in B. Schmitt et al. (eds.) Solar -! System Ices, Astrophys. and Space Sci. Library, Vol. 227, Kluwer -! Academic Publishers, Dordrecht, pp. 241-257 (1998). Input: -! TK = temperature (K), range 20 to 273.15 -! f = frequency in GHz, range 0.01 to 3000 - - IMPLICIT NONE - DOUBLE PRECISION, INTENT(IN):: T,lambda - DOUBLE PRECISION:: f,c,TK,B1,B2,b,deltabeta,betam,beta,theta,alfa - - c = 2.99d8 - TK = T + 273.16 - f = c / lambda * 1d-9 - - B1 = 0.0207 - B2 = 1.16d-11 - b = 335.0d0 - deltabeta = EXP(-10.02 + 0.0364*(TK-273.16)) - betam = (B1/TK) * ( EXP(b/TK) / ((EXP(b/TK)-1)**2) ) + B2*f*f - beta = betam + deltabeta - theta = 300. / TK - 1. - alfa = (0.00504d0 + 0.0062d0*theta) * EXP(-22.1d0*theta) - m_complex_ice_maetzler = 3.1884 + 9.1e-4*(TK-273.16) - m_complex_ice_maetzler = m_complex_ice_maetzler & - + CMPLX(0.0d0, (alfa/f + beta*f)) - m_complex_ice_maetzler = SQRT(CONJG(m_complex_ice_maetzler)) - - END FUNCTION m_complex_ice_maetzler - -!+---+-----------------------------------------------------------------+ - - subroutine rayleigh_soak_wetgraupel (x_g, a_geo, b_geo, fmelt, & - meltratio_outside, m_w, m_i, lambda, C_back, & - mixingrule,matrix,inclusion, & - host,hostmatrix,hostinclusion) - - IMPLICIT NONE - - DOUBLE PRECISION, INTENT(in):: x_g, a_geo, b_geo, fmelt, lambda, & - meltratio_outside - DOUBLE PRECISION, INTENT(out):: C_back - COMPLEX*16, INTENT(in):: m_w, m_i - CHARACTER(len=*), INTENT(in):: mixingrule, matrix, inclusion, & - host, hostmatrix, hostinclusion - - COMPLEX*16:: m_core, m_air - DOUBLE PRECISION:: D_large, D_g, rhog, x_w, xw_a, fm, fmgrenz, & - volg, vg, volair, volice, volwater, & - meltratio_outside_grenz, mra - INTEGER:: error - DOUBLE PRECISION, PARAMETER:: PIx=3.1415926535897932384626434d0 - -! refractive index of air: - m_air = (1.0d0,0.0d0) - -! Limiting the degree of melting --- for safety: - fm = DMAX1(DMIN1(fmelt, 1.0d0), 0.0d0) -! Limiting the ratio of (melting on outside)/(melting on inside): - mra = DMAX1(DMIN1(meltratio_outside, 1.0d0), 0.0d0) - -! ! The relative portion of meltwater melting at outside should increase -! ! from the given input value (between 0 and 1) -! ! to 1 as the degree of melting approaches 1, -! ! so that the melting particle "converges" to a water drop. -! ! Simplest assumption is linear: - mra = mra + (1.0d0-mra)*fm - - x_w = x_g * fm - - D_g = a_geo * x_g**b_geo - - if (D_g .ge. 1d-12) then - - vg = PIx/6. * D_g**3 - rhog = DMAX1(DMIN1(x_g / vg, 900.0d0), 10.0d0) - vg = x_g / rhog - - meltratio_outside_grenz = 1.0d0 - rhog / 1000. - - if (mra .le. meltratio_outside_grenz) then - !..In this case, it cannot happen that, during melting, all the - !.. air inclusions within the ice particle get filled with - !.. meltwater. This only happens at the end of all melting. - volg = vg * (1.0d0 - mra * fm) - - else - !..In this case, at some melting degree fm, all the air - !.. inclusions get filled with meltwater. - fmgrenz=(900.0-rhog)/(mra*900.0-rhog+900.0*rhog/1000.) - - if (fm .le. fmgrenz) then - !.. not all air pockets are filled: - volg = (1.0 - mra * fm) * vg - else - !..all air pockets are filled with meltwater, now the - !.. entire ice sceleton melts homogeneously: - volg = (x_g - x_w) / 900.0 + x_w / 1000. - endif - - endif - - D_large = (6.0 / PIx * volg) ** (1./3.) - volice = (x_g - x_w) / (volg * 900.0) - volwater = x_w / (1000. * volg) - volair = 1.0 - volice - volwater - - !..complex index of refraction for the ice-air-water mixture - !.. of the particle: - m_core = get_m_mix_nested (m_air, m_i, m_w, volair, volice, & - volwater, mixingrule, host, matrix, inclusion, & - hostmatrix, hostinclusion, error) - if (error .ne. 0) then - C_back = 0.0d0 - return - endif - - !..Rayleigh-backscattering coefficient of melting particle: - C_back = (ABS((m_core**2-1.0d0)/(m_core**2+2.0d0)))**2 & - * PI5 * D_large**6 / lamda4 - - else - C_back = 0.0d0 - endif - - end subroutine rayleigh_soak_wetgraupel - -!+---+-----------------------------------------------------------------+ - - complex*16 function get_m_mix_nested (m_a, m_i, m_w, volair, & - volice, volwater, mixingrule, host, matrix, & - inclusion, hostmatrix, hostinclusion, cumulerror) - - IMPLICIT NONE - - DOUBLE PRECISION, INTENT(in):: volice, volair, volwater - COMPLEX*16, INTENT(in):: m_a, m_i, m_w - CHARACTER(len=*), INTENT(in):: mixingrule, host, matrix, & - inclusion, hostmatrix, hostinclusion - INTEGER, INTENT(out):: cumulerror - - DOUBLE PRECISION:: vol1, vol2 - COMPLEX*16:: mtmp - INTEGER:: error - - !..Folded: ( (m1 + m2) + m3), where m1,m2,m3 could each be - !.. air, ice, or water - - cumulerror = 0 - get_m_mix_nested = CMPLX(1.0d0,0.0d0) - - if (host .eq. 'air') then - - if (matrix .eq. 'air') then - write(*,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix - cumulerror = cumulerror + 1 - else - vol1 = volice / MAX(volice+volwater,1d-10) - vol2 = 1.0d0 - vol1 - mtmp = get_m_mix (m_a, m_i, m_w, 0.0d0, vol1, vol2, & - mixingrule, matrix, inclusion, error) - cumulerror = cumulerror + error - - if (hostmatrix .eq. 'air') then - get_m_mix_nested = get_m_mix (m_a, mtmp, 2.0*m_a, & - volair, (1.0d0-volair), 0.0d0, mixingrule, & - hostmatrix, hostinclusion, error) - cumulerror = cumulerror + error - elseif (hostmatrix .eq. 'icewater') then - get_m_mix_nested = get_m_mix (m_a, mtmp, 2.0*m_a, & - volair, (1.0d0-volair), 0.0d0, mixingrule, & - 'ice', hostinclusion, error) - cumulerror = cumulerror + error - else - write(*,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', & - hostmatrix - cumulerror = cumulerror + 1 - endif - endif - - elseif (host .eq. 'ice') then - - if (matrix .eq. 'ice') then - write(radar_debug,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix - cumulerror = cumulerror + 1 - else - vol1 = volair / MAX(volair+volwater,1d-10) - vol2 = 1.0d0 - vol1 - mtmp = get_m_mix (m_a, m_i, m_w, vol1, 0.0d0, vol2, & - mixingrule, matrix, inclusion, error) - cumulerror = cumulerror + error - - if (hostmatrix .eq. 'ice') then - get_m_mix_nested = get_m_mix (mtmp, m_i, 2.0*m_a, & - (1.0d0-volice), volice, 0.0d0, mixingrule, & - hostmatrix, hostinclusion, error) - cumulerror = cumulerror + error - elseif (hostmatrix .eq. 'airwater') then - get_m_mix_nested = get_m_mix (mtmp, m_i, 2.0*m_a, & - (1.0d0-volice), volice, 0.0d0, mixingrule, & - 'air', hostinclusion, error) - cumulerror = cumulerror + error - else - write(*,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', & - hostmatrix - cumulerror = cumulerror + 1 - endif - endif - - elseif (host .eq. 'water') then - - if (matrix .eq. 'water') then - write(*,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix - cumulerror = cumulerror + 1 - else - vol1 = volair / MAX(volice+volair,1d-10) - vol2 = 1.0d0 - vol1 - mtmp = get_m_mix (m_a, m_i, m_w, vol1, vol2, 0.0d0, & - mixingrule, matrix, inclusion, error) - cumulerror = cumulerror + error - - if (hostmatrix .eq. 'water') then - get_m_mix_nested = get_m_mix (2*m_a, mtmp, m_w, & - 0.0d0, (1.0d0-volwater), volwater, mixingrule, & - hostmatrix, hostinclusion, error) - cumulerror = cumulerror + error - elseif (hostmatrix .eq. 'airice') then - get_m_mix_nested = get_m_mix (2*m_a, mtmp, m_w, & - 0.0d0, (1.0d0-volwater), volwater, mixingrule, & - 'ice', hostinclusion, error) - cumulerror = cumulerror + error - else - write(*,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', & - hostmatrix - cumulerror = cumulerror + 1 - endif - endif - - elseif (host .eq. 'none') then - - get_m_mix_nested = get_m_mix (m_a, m_i, m_w, & - volair, volice, volwater, mixingrule, & - matrix, inclusion, error) - cumulerror = cumulerror + error - - else - write(*,*) 'GET_M_MIX_NESTED: unknown matrix: ', host - cumulerror = cumulerror + 1 - endif - - IF (cumulerror .ne. 0) THEN - write(*,*) 'GET_M_MIX_NESTED: error encountered' - get_m_mix_nested = CMPLX(1.0d0,0.0d0) - endif - - end function get_m_mix_nested - -!+---+-----------------------------------------------------------------+ - - COMPLEX*16 FUNCTION get_m_mix (m_a, m_i, m_w, volair, volice, & - volwater, mixingrule, matrix, inclusion, error) - - IMPLICIT NONE - - DOUBLE PRECISION, INTENT(in):: volice, volair, volwater - COMPLEX*16, INTENT(in):: m_a, m_i, m_w - CHARACTER(len=*), INTENT(in):: mixingrule, matrix, inclusion - INTEGER, INTENT(out):: error - - error = 0 - get_m_mix = CMPLX(1.0d0,0.0d0) - - if (mixingrule .eq. 'maxwellgarnett') then - if (matrix .eq. 'ice') then - get_m_mix = m_complex_maxwellgarnett(volice, volair, volwater, & - m_i, m_a, m_w, inclusion, error) - elseif (matrix .eq. 'water') then - get_m_mix = m_complex_maxwellgarnett(volwater, volair, volice, & - m_w, m_a, m_i, inclusion, error) - elseif (matrix .eq. 'air') then - get_m_mix = m_complex_maxwellgarnett(volair, volwater, volice, & - m_a, m_w, m_i, inclusion, error) - else - write(*,*) 'GET_M_MIX: unknown matrix: ', matrix - error = 1 - endif - - else - write(*,*) 'GET_M_MIX: unknown mixingrule: ', mixingrule - error = 2 - endif - - if (error .ne. 0) then - write(*,*) 'GET_M_MIX: error encountered' - endif - - END FUNCTION get_m_mix - -!+---+-----------------------------------------------------------------+ - - COMPLEX*16 FUNCTION m_complex_maxwellgarnett(vol1, vol2, vol3, & - m1, m2, m3, inclusion, error) - - IMPLICIT NONE - - COMPLEX*16 :: m1, m2, m3 - DOUBLE PRECISION :: vol1, vol2, vol3 - CHARACTER(len=*) :: inclusion - - COMPLEX*16 :: beta2, beta3, m1t, m2t, m3t - INTEGER, INTENT(out) :: error - - error = 0 - - if (DABS(vol1+vol2+vol3-1.0d0) .gt. 1d-6) then - write(*,*) 'M_COMPLEX_MAXWELLGARNETT: sum of the ', & - 'partial volume fractions is not 1...ERROR' - m_complex_maxwellgarnett=CMPLX(-999.99d0,-999.99d0) - error = 1 - return - endif - - m1t = m1**2 - m2t = m2**2 - m3t = m3**2 - - if (inclusion .eq. 'spherical') then - beta2 = 3.0d0*m1t/(m2t+2.0d0*m1t) - beta3 = 3.0d0*m1t/(m3t+2.0d0*m1t) - elseif (inclusion .eq. 'spheroidal') then - beta2 = 2.0d0*m1t/(m2t-m1t) * (m2t/(m2t-m1t)*LOG(m2t/m1t)-1.0d0) - beta3 = 2.0d0*m1t/(m3t-m1t) * (m3t/(m3t-m1t)*LOG(m3t/m1t)-1.0d0) - else - write(*,*) 'M_COMPLEX_MAXWELLGARNETT: ', & - 'unknown inclusion: ', inclusion - m_complex_maxwellgarnett=DCMPLX(-999.99d0,-999.99d0) - error = 1 - return - endif - - m_complex_maxwellgarnett = & - SQRT(((1.0d0-vol2-vol3)*m1t + vol2*beta2*m2t + vol3*beta3*m3t) / & - (1.0d0-vol2-vol3+vol2*beta2+vol3*beta3)) - - END FUNCTION m_complex_maxwellgarnett - -!+---+-----------------------------------------------------------------+ - REAL FUNCTION GAMMLN(XX) -! --- RETURNS THE VALUE LN(GAMMA(XX)) FOR XX > 0. - IMPLICIT NONE - REAL, INTENT(IN):: XX - DOUBLE PRECISION, PARAMETER:: STP = 2.5066282746310005D0 - DOUBLE PRECISION, DIMENSION(6), PARAMETER:: & - COF = (/76.18009172947146D0, -86.50532032941677D0, & - 24.01409824083091D0, -1.231739572450155D0, & - .1208650973866179D-2, -.5395239384953D-5/) - DOUBLE PRECISION:: SER,TMP,X,Y - INTEGER:: J - - X=XX - Y=X - TMP=X+5.5D0 - TMP=(X+0.5D0)*LOG(TMP)-TMP - SER=1.000000000190015D0 - DO 11 J=1,6 - Y=Y+1.D0 - SER=SER+COF(J)/Y -11 CONTINUE - GAMMLN=TMP+LOG(STP*SER/X) - END FUNCTION GAMMLN -! (C) Copr. 1986-92 Numerical Recipes Software 2.02 -!+---+-----------------------------------------------------------------+ - REAL FUNCTION WGAMMA(y) - - IMPLICIT NONE - REAL, INTENT(IN):: y - - WGAMMA = EXP(GAMMLN(y)) - - END FUNCTION WGAMMA - -!+---+-----------------------------------------------------------------+ - END MODULE module_mp_radar -!+---+-----------------------------------------------------------------+ diff --git a/src/dynamics/fv3/pmgrid.F90 b/src/dynamics/fv3/pmgrid.F90 deleted file mode 100644 index fff3dbce18..0000000000 --- a/src/dynamics/fv3/pmgrid.F90 +++ /dev/null @@ -1,15 +0,0 @@ -module pmgrid - -! PLON and PLAT do not correspond to the number of latitudes and longitudes in -! this version of dynamics. - -implicit none -save - -integer, parameter :: plev = PLEV ! number of vertical levels -integer, parameter :: plevp = plev + 1 - -integer, parameter :: plon = 1 -integer, parameter :: plat = 1 - -end module pmgrid diff --git a/src/dynamics/fv3/restart_dynamics.F90 b/src/dynamics/fv3/restart_dynamics.F90 deleted file mode 100644 index 8679f30c95..0000000000 --- a/src/dynamics/fv3/restart_dynamics.F90 +++ /dev/null @@ -1,447 +0,0 @@ -module restart_dynamics - -! Write and read dynamics fields from the restart file. For exact restart -! it is necessary to write all element data, including duplicate columns, -! to the file. - - use cam_abortutils, only: endrun - use cam_grid_support, only: cam_grid_header_info_t, cam_grid_id, cam_grid_write_attr, & - cam_grid_write_var, cam_grid_get_decomp, cam_grid_dimensions, max_hcoordname_len - use cam_logfile, only: iulog - use cam_pio_utils, only: cam_pio_handle_error - use dyn_comp, only: dyn_import_t, dyn_export_t - use dyn_grid, only: mytile - use fv_arrays_mod, only: fv_atmos_type - use pio, only: file_desc_t, var_desc_t - use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 - use spmd_utils, only: masterproc - - implicit none - private - - public :: init_restart_dynamics, write_restart_dynamics, read_restart_dynamics - - type(var_desc_t) :: udesc, vdesc, tdesc, psdesc, phisdesc, usdesc,vsdesc,delpdesc,omegadesc - - integer :: ncol_d_dimid, ncol_d_ew_dimid, ncol_d_ns_dimid, nlev_dimid, nlevp_dimid - type(var_desc_t), allocatable :: qdesc(:) - integer :: is,ie,js,je - - -!======================================================================= -contains -!======================================================================= - -subroutine init_restart_dynamics(File, dyn_out) - - use constituents, only: cnst_name, pcnst - use hycoef, only: init_restart_hycoef - use pio, only: pio_unlimited, pio_double, pio_def_dim, & - pio_seterrorhandling, pio_bcast_error, & - pio_def_var, & - pio_inq_dimid - - ! arguments - type(file_desc_t), intent(inout) :: file - type(dyn_export_t), intent(in) :: dyn_out - - ! local variables - integer :: vdimids(2) - integer :: ierr, i, err_handling - integer :: time_dimid - integer :: is,ie,js,je - type (fv_atmos_type), pointer :: Atm(:) - - integer :: grid_id,grid_id_ns,grid_id_ew - type(cam_grid_header_info_t) :: info,info_ew,info_ns - - !--------------------------------------------------------------------------- - - Atm=>dyn_out%atm - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - call init_restart_hycoef(File, vdimids) - - call pio_seterrorhandling(File, pio_bcast_error, err_handling) - - ierr = PIO_Def_Dim(File, 'time', PIO_UNLIMITED, time_dimid) - - grid_id = cam_grid_id('FFSL') - call cam_grid_write_attr(File, grid_id, info) - ncol_d_dimid = info%get_hdimid(1) - - grid_id_ew = cam_grid_id('FFSL_EW') - call cam_grid_write_attr(File, grid_id_ew, info_ew) - ncol_d_ew_dimid = info_ew%get_hdimid(1) - - grid_id_ns = cam_grid_id('FFSL_NS') - call cam_grid_write_attr(File, grid_id_ns, info_ns) - ncol_d_ns_dimid = info_ns%get_hdimid(1) - - nlev_dimid = vdimids(1) - - ierr = PIO_Def_Var(File, 'U', pio_double, (/ncol_d_dimid, nlev_dimid/), Udesc) - ierr = PIO_Def_Var(File, 'V', pio_double, (/ncol_d_dimid, nlev_dimid/), Vdesc) - ierr = PIO_Def_Var(File, 'US', pio_double, (/ncol_d_ns_dimid, nlev_dimid/), USdesc) - ierr = PIO_Def_Var(File, 'VS', pio_double, (/ncol_d_ew_dimid, nlev_dimid/), VSdesc) - ierr = PIO_Def_Var(File, 'T', pio_double, (/ncol_d_dimid, nlev_dimid/), Tdesc) - ierr = PIO_Def_Var(File, 'OMEGA', pio_double, (/ncol_d_dimid, nlev_dimid/), omegadesc) - ierr = PIO_Def_Var(File, 'DELP', pio_double, (/ncol_d_dimid, nlev_dimid/), delpdesc) - ierr = PIO_Def_Var(File, 'PS', pio_double, (/ncol_d_dimid/), PSdesc) - ierr = PIO_Def_Var(File, 'PHIS', pio_double, (/ncol_d_dimid/), phisdesc) - - allocate(Qdesc(pcnst)) - - do i = 1, pcnst - ierr = PIO_Def_Var(File, cnst_name(i), pio_double, (/ncol_d_dimid, nlev_dimid/), Qdesc(i)) - end do - - call pio_seterrorhandling(File, err_handling) - -end subroutine init_restart_dynamics - -!======================================================================= - -subroutine write_restart_dynamics(File, dyn_out) - - use hycoef, only: write_restart_hycoef - use constituents, only: pcnst - use dimensions_mod, only: nlev - use pio, only: pio_offset_kind, io_desc_t, pio_double, pio_write_darray - use time_manager, only: get_curr_time, get_curr_date - - ! arguments - type(file_desc_t), intent(inout) :: File - type(dyn_export_t), intent(in) :: dyn_out - - ! local variables - integer(pio_offset_kind), parameter :: t_idx = 1 - type (fv_atmos_type), pointer :: Atm(:) - - type(io_desc_t),pointer :: iodesc3d,iodesc3d_ns,iodesc3d_ew,iodesc - integer :: m, ierr - integer :: array_lens_3d(3), array_lens_2d(2) - integer :: file_lens_2d(2), file_lens_1d(1) - integer :: grid_id,grid_id_ns,grid_id_ew - integer :: grid_dimlens(2),grid_dimlens_ew(2),grid_dimlens_ns(2) - integer :: ilen,jlen - - !--------------------------------------------------------------------------- - - call write_restart_hycoef(File) - - Atm=>dyn_out%atm - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - grid_id = cam_grid_id('FFSL') - grid_id_ew = cam_grid_id('FFSL_EW') - grid_id_ns = cam_grid_id('FFSL_NS') - - ! write coordinate variables for unstructured FFSL, NS and EW restart grid - ! (restart grids have tile based global indicies with duplicate edge points - ! being given uniq indicies. All duplicate point written out to restart file) - ! - io overhead = 6 tile edges are duplicated and read from the file - ! instead of mpi gathers to fill in duplicates. - - call cam_grid_write_var(File, grid_id) - call cam_grid_write_var(File, grid_id_ew) - call cam_grid_write_var(File, grid_id_ns) - - ! create map for distributed write - call cam_grid_dimensions(grid_id, grid_dimlens) - call cam_grid_dimensions(grid_id_ew, grid_dimlens_ew) - call cam_grid_dimensions(grid_id_ns, grid_dimlens_ns) - - ilen=ie-is+1 - jlen=je-js+1 - - ! create map for distributed write of 2D fields - array_lens_2d = (/ilen,jlen/) - file_lens_1d = (/grid_dimlens(1)/) - call cam_grid_get_decomp(grid_id, array_lens_2d, file_lens_1d, pio_double, iodesc) - ! Write PHIS - call PIO_Write_Darray(File, phisdesc, iodesc, Atm(mytile)%phis(is:ie,js:je), ierr) - ! Write PS - call PIO_Write_Darray(File, psdesc, iodesc, Atm(mytile)%ps(is:ie,js:je), ierr) - - array_lens_3d = (/ilen,jlen,nlev/) - file_lens_2d = (/grid_dimlens(1), nlev/) - call cam_grid_get_decomp(grid_id, array_lens_3d, file_lens_2d, pio_double, iodesc3d) - ! Write U a-grid - call PIO_Write_Darray(File, Udesc, iodesc3d, Atm(mytile)%ua(is:ie,js:je,1:nlev), ierr) - ! Write V a-grid - call PIO_Write_Darray(File, Vdesc, iodesc3d, Atm(mytile)%va(is:ie,js:je,1:nlev) , ierr) - ! Write OMEGA a-grid - call PIO_Write_Darray(File, Omegadesc, iodesc3d, Atm(mytile)%omga(is:ie,js:je,1:nlev), ierr) - ! Write DELP a-grid - call PIO_Write_Darray(File, delpdesc, iodesc3d, Atm(mytile)%delp(is:ie,js:je,1:nlev), ierr) - ! Write PT a-grid - call PIO_Write_Darray(File, Tdesc, iodesc3d, Atm(mytile)%pt(is:ie,js:je,1:nlev), ierr) - ! Write Tracers a-grid - do m = 1, pcnst - call PIO_Write_Darray(File, Qdesc(m), iodesc3d, Atm(mytile)%q(is:ie,js:je,1:nlev,m), ierr) - end do - - deallocate(qdesc) - - ! create map for distributed write of 3D NS fields - array_lens_3d = (/ilen ,(jlen+1), nlev/) - file_lens_2d = (/grid_dimlens_ns(1), nlev/) - call cam_grid_get_decomp(grid_id_ns, array_lens_3d, file_lens_2d, pio_double, iodesc3d_ns) - - !WRITE US - call PIO_Write_Darray(File, USdesc, iodesc3d_ns, Atm(mytile)%u(is:ie,js:je+1,1:nlev), ierr) - - ! create map for distributed write of 3D EW fields - array_lens_3d = (/(ilen+1), jlen, nlev /) - file_lens_2d = (/grid_dimlens_ew(1), nlev/) - call cam_grid_get_decomp(grid_id_ew, array_lens_3d, file_lens_2d, pio_double, iodesc3d_ew) - - !WRITE VS - call PIO_Write_Darray(File, VSdesc, iodesc3d_ew, Atm(mytile)%v(is:ie+1,js:je,1:nlev), ierr) - -end subroutine write_restart_dynamics - -!======================================================================= - -subroutine read_restart_dynamics(File, dyn_in, dyn_out) - - use cam_history_support, only: max_fieldname_len - use constituents, only: cnst_name, pcnst - use dimensions_mod,only: npy,npx,nlev - use dyn_comp, only: dyn_init - use dyn_grid, only: Atm - use mpp_domains_mod, only: mpp_update_domains, DGRID_NE, mpp_get_boundary - use pio, only: file_desc_t, pio_double, & - pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, & - pio_read_darray, file_desc_t, io_desc_t, pio_double,pio_offset_kind,& - pio_seterrorhandling, pio_bcast_error - - ! arguments - type(File_desc_t), intent(inout) :: File - type(dyn_import_t), intent(out) :: dyn_in - type(dyn_export_t), intent(out) :: dyn_out - - ! local variables - integer(pio_offset_kind), parameter :: t_idx = 1 - - integer :: tl - integer :: i, k, m, j - integer :: ierr, err_handling - integer :: fnlev - integer :: ncols_d_ns, ncols_d_ew, ncols_d - - integer :: ncol_d_dimid - integer :: ncol_d_ns_dimid - integer :: ncol_d_ew_dimid - - type(var_desc_t) :: omegadesc - type(var_desc_t) :: delpdesc - type(var_desc_t) :: udesc - type(var_desc_t) :: vdesc - type(var_desc_t) :: usdesc - type(var_desc_t) :: vsdesc - type(var_desc_t) :: tdesc - type(var_desc_t) :: psdesc - type(var_desc_t) :: phisdesc - type(var_desc_t), allocatable :: qdesc(:) - type(io_desc_t),pointer :: iodesc2d, iodesc3d,iodesc3d_ns,iodesc3d_ew - integer :: array_lens_3d(3), array_lens_2d(2) - integer :: file_lens_2d(2), file_lens_1d(1) - integer :: grid_id,grid_id_ns,grid_id_ew,ilen,jlen - integer :: grid_dimlens(2),grid_dimlens_ns(2),grid_dimlens_ew(2) - - real(r8), allocatable :: ebuffer(:,:) - real(r8), allocatable :: nbuffer(:,:) - - character(len=*), parameter :: sub = 'read_restart_dynamics' - character(len=256) :: errormsg - !---------------------------------------------------------------------------- - - ! Note1: the hybrid coefficients are read from the same location as for an - ! initial run (e.g., dyn_grid_init). - - ! Note2: the dyn_in and dyn_out objects are not associated with the Atm dynamics - ! object until dyn_init is called. Until the restart is better integrated - ! into dyn_init we just access Atm directly from the dyn_grid - ! module. FV3 dyn_init calls an fv3 diagnostic init routine that tries to access - ! surface pressure in the Atm structure and at the top of read_restart PS hasn't - ! been read in yet. - - tl = 1 - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - call pio_seterrorhandling(File, pio_bcast_error, err_handling) - - ierr = PIO_Inq_DimID(File, 'lev', nlev_dimid) - ierr = PIO_Inq_dimlen(File, nlev_dimid, fnlev) - if (nlev /= fnlev) then - write(errormsg, *) ': Restart file nlev dimension does not match model levels:',& - 'file nlev=',fnlev,', model nlev=',nlev - call endrun(sub//trim(errormsg)) - end if - - ! variable descriptors of required dynamics fields - ierr = PIO_Inq_varid(File, 'DELP', delpdesc) - call cam_pio_handle_error(ierr, sub//': cannot find DELP') - ierr = PIO_Inq_varid(File, 'OMEGA', omegadesc) - call cam_pio_handle_error(ierr, sub//': cannot find OMEGA') - ierr = PIO_Inq_varid(File, 'U', udesc) - call cam_pio_handle_error(ierr, sub//': cannot find UA') - ierr = PIO_Inq_varid(File, 'V', Vdesc) - call cam_pio_handle_error(ierr, sub//': cannot find VA') - ierr = PIO_Inq_varid(File, 'US', usdesc) - call cam_pio_handle_error(ierr, sub//': cannot find US') - ierr = PIO_Inq_varid(File, 'VS', Vsdesc) - call cam_pio_handle_error(ierr, sub//': cannot find VS') - ierr = PIO_Inq_varid(File, 'T', tdesc) - call cam_pio_handle_error(ierr, sub//': cannot find T') - ierr = PIO_Inq_varid(File, 'PS', psdesc) - call cam_pio_handle_error(ierr, sub//': cannot find PS') - ierr = PIO_Inq_varid(File, 'PHIS', phisdesc) - call cam_pio_handle_error(ierr, sub//': cannot find PHIS') - allocate(qdesc(pcnst)) - do m = 1, pcnst - ierr = PIO_Inq_varid(File, trim(cnst_name(m)), Qdesc(m)) - call cam_pio_handle_error(ierr, sub//': cannot find '//trim(cnst_name(m))) - end do - - ! check whether the restart fields on the GLL grid contain unique columns - ! or the fv3 task structure (ncol_d_ns = (ie-is+1)*(je-js+2)+npes columns) - ! or the fv3 task structure (ncol_d_ew = (ie-is+2)*(je-js+1)+npes columns) - - ierr = PIO_Inq_DimID(File, 'ncol_d', ncol_d_dimid) - call cam_pio_handle_error(ierr, sub//': cannot find ncol_d') - ierr = PIO_Inq_dimlen(File, ncol_d_dimid, ncols_d) - - ierr = PIO_Inq_DimID(File, 'ncol_d_ns', ncol_d_ns_dimid) - call cam_pio_handle_error(ierr, sub//': cannot find ncol_d_ns') - ierr = PIO_Inq_dimlen(File, ncol_d_ns_dimid, ncols_d_ns) - - ierr = PIO_Inq_DimID(File, 'ncol_d_ew', ncol_d_ew_dimid) - call cam_pio_handle_error(ierr, sub//': cannot find ncol_d_ew') - ierr = PIO_Inq_dimlen(File, ncol_d_ew_dimid, ncols_d_ew) - - grid_id = cam_grid_id('FFSL') - grid_id_ns = cam_grid_id('FFSL_NS') - grid_id_ew = cam_grid_id('FFSL_EW') - call cam_grid_dimensions(grid_id, grid_dimlens) - call cam_grid_dimensions(grid_id_ew, grid_dimlens_ew) - call cam_grid_dimensions(grid_id_ns, grid_dimlens_ns) - - if (ncols_d /= grid_dimlens(1)) then - write(errormsg, *) ':Restart file ncol_d dimension does not match number of model A-Grid columns',& - 'Restart ncols_d=',ncols_d,', A-Grid ncols=',grid_dimlens(1) - call endrun(sub//trim(errormsg)) - end if - - if (ncols_d_ns /= grid_dimlens_ns(1)) then - write(errormsg, *) ':Restart file ncol_d dimension does not match number of model D-Grid ns columns',& - 'Restart ncols_d_ns=',ncols_d_ns,', D-Grid ns ncols=',grid_dimlens_ns(1) - call endrun(sub//trim(errormsg)) - end if - - if (ncols_d_ew /= grid_dimlens_ew(1)) then - write(errormsg, *) ':Restart file ncol_d dimension does not match number of model D-Grid ew columns',& - 'Restart ncols_d_ew=',ncols_d_ew,', D-Grid ew ncols=',grid_dimlens_ew(1) - call endrun(sub//trim(errormsg)) - end if - - ilen = ie-is+1 - jlen = je-js+1 - ! create map for distributed write of 2D fields - array_lens_2d = (/ilen,jlen/) - file_lens_1d = (/grid_dimlens(1)/) - call cam_grid_get_decomp(grid_id, array_lens_2d, file_lens_1d, pio_double, iodesc2d) - - ! create map for distributed write of 3D fields - array_lens_3d = (/ilen, jlen,nlev/) - file_lens_2d = (/grid_dimlens(1), nlev/) - call cam_grid_get_decomp(grid_id, array_lens_3d, file_lens_2d, pio_double, iodesc3d) - - ! create map for distributed write of 3D NS fields - array_lens_3d = (/ilen, jlen+1, nlev/) - file_lens_2d = (/grid_dimlens_ns(1), nlev/) - call cam_grid_get_decomp(grid_id_ns, array_lens_3d, file_lens_2d, pio_double, iodesc3d_ns) - - ! create map for distributed write of 3D EW fields - array_lens_3d = (/ilen+1, jlen, nlev/) - file_lens_2d = (/grid_dimlens_ew(1), nlev/) - call cam_grid_get_decomp(grid_id_ew, array_lens_3d, file_lens_2d, pio_double, iodesc3d_ew) - - ! PS - call PIO_Read_Darray(File, psdesc, iodesc2d,atm(mytile)%ps(is:ie,js:je), ierr) - ! PHIS - call PIO_Read_Darray(File, phisdesc, iodesc2d, atm(mytile)%phis(is:ie,js:je), ierr) - ! OMEGA - call PIO_Read_Darray(File, omegadesc, iodesc3d,Atm(mytile)%omga(is:ie,js:je,1:nlev), ierr) - ! DELP - call PIO_Read_Darray(File, delpdesc, iodesc3d, atm(mytile)%delp(is:ie,js:je,1:nlev), ierr) - ! T - call PIO_Read_Darray(File, Tdesc, iodesc3d,atm(mytile)%pt(is:ie,js:je,1:nlev) , ierr) - ! V - call PIO_Read_Darray(File, Vdesc, iodesc3d, atm(mytile)%va(is:ie,js:je,1:nlev), ierr) - ! U - call PIO_Read_Darray(File, Udesc, iodesc3d, atm(mytile)%ua(is:ie,js:je,1:nlev), ierr) - ! tracers - do m = 1, pcnst - call PIO_Read_Darray(File, Qdesc(m), iodesc3d, atm(mytile)%q(is:ie,js:je,1:nlev,m), ierr) - end do - - deallocate(qdesc) - - ! US and VS After reading unique points on D grid call get_boundary routine to fill - ! missing points on the north and east block boundaries which are duplicated between - ! adjacent blocks. - - allocate(ebuffer(npy+2,nlev)) - allocate(nbuffer(npx+2,nlev)) - nbuffer = 0._r8 - ebuffer = 0._r8 - ! US - call PIO_Read_Darray(File, USdesc, iodesc3d_ns, atm(mytile)%u(is:ie,js:je+1,1:nlev), ierr) - ! VS - call PIO_Read_Darray(File, VSdesc, iodesc3d_ew, atm(mytile)%v(is:ie+1,js:je,1:nlev), ierr) - ! US/VS duplicates - call mpp_get_boundary(atm(mytile)%u, atm(mytile)%v, atm(mytile)%domain, ebuffery=ebuffer, & - nbufferx=nbuffer, gridtype=DGRID_NE ) - do k=1,nlev - do i=is,ie - atm(mytile)%u(i,je+1,k) = nbuffer(i-is+1,k) - enddo - do j=js,je - atm(mytile)%v(ie+1,j,k) = ebuffer(j-js+1,k) - enddo - enddo - deallocate(ebuffer) - deallocate(nbuffer) - - ! Update halo points on each processor - - call mpp_update_domains( Atm(mytile)%phis, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%ps, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%u,atm(mytile)%v, Atm(mytile)%domain, gridtype=DGRID_NE, complete=.true. ) - call mpp_update_domains( atm(mytile)%pt, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%delp, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%omga, Atm(mytile)%domain ) - call mpp_update_domains( atm(mytile)%q, Atm(mytile)%domain ) - - call dyn_init(dyn_in, dyn_out) - - call pio_seterrorhandling(File, err_handling) - - - end subroutine read_restart_dynamics - -end module restart_dynamics diff --git a/src/dynamics/fv3/spmd_dyn.F90 b/src/dynamics/fv3/spmd_dyn.F90 deleted file mode 100644 index d1634d7f9d..0000000000 --- a/src/dynamics/fv3/spmd_dyn.F90 +++ /dev/null @@ -1,18 +0,0 @@ -module spmd_dyn - - ! Purpose: SPMD implementation of CAM FV3 dynamics. - - implicit none - private - - ! These variables are not used locally, but are set and used in phys_grid. - ! They probably should be moved there. - logical, public :: local_dp_map=.true. ! flag indicates that mapping between dynamics - ! and physics decompositions does not require - ! interprocess communication - integer, public :: block_buf_nrecs ! number of local grid points (lon,lat,lev) - ! in dynamics decomposition (including level 0) - integer, public :: chunk_buf_nrecs ! number of local grid points (lon,lat,lev) - ! in physics decomposition (including level 0) - ! assigned in phys_grid.F90 -end module spmd_dyn diff --git a/src/dynamics/fv3/stepon.F90 b/src/dynamics/fv3/stepon.F90 deleted file mode 100644 index fef0978302..0000000000 --- a/src/dynamics/fv3/stepon.F90 +++ /dev/null @@ -1,286 +0,0 @@ -module stepon - - ! MODULE: stepon -- FV Dynamics specific time-stepping - - use shr_kind_mod, only: r8 => shr_kind_r8 - use physics_types, only: physics_state, physics_tend - use ppgrid, only: begchunk, endchunk - use perf_mod, only: t_startf, t_stopf, t_barrierf - use spmd_utils, only: iam, masterproc, mpicom - use dyn_comp, only: dyn_import_t, dyn_export_t - use dyn_grid, only: mytile - use time_manager, only: get_step_size - use dimensions_mod, only: qsize_tracer_idx_cam2dyn - - implicit none - private - - public stepon_init ! Initialization - public stepon_run1 ! run method phase 1 - public stepon_run2 ! run method phase 2 - public stepon_run3 ! run method phase 3 - public stepon_final ! Finalization - -!======================================================================= -contains -!======================================================================= - -subroutine stepon_init(dyn_in, dyn_out) - - ! ROUTINE: stepon_init -- Time stepping initialization - - use cam_history, only: addfld, add_default, horiz_only - use constituents, only: pcnst, cnst_name, cnst_longname - - type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container - type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container - - ! local variables - integer :: m_cnst,m_cnst_ffsl - !---------------------------------------------------------------------------- - ! These fields on dynamics grid are output before the call to d_p_coupling. - do m_cnst = 1, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - call addfld(trim(cnst_name(m_cnst))//'_ffsl', (/ 'lev' /), 'I', 'kg/kg', & - trim(cnst_longname(m_cnst)), gridname='FFSLHIST') - call addfld(trim(cnst_name(m_cnst))//'_mass_ffsl', (/ 'lev' /), 'I', 'kg/kg', & - trim(cnst_longname(m_cnst))//'*dp', gridname='FFSLHIST') - end do - call addfld('U_ffsl' ,(/ 'lev' /), 'I', 'm/s ','U wind on A grid after dynamics',gridname='FFSLHIST') - call addfld('V_ffsl' ,(/ 'lev' /), 'I', 'm/s ','V wind on A grid after dynamics',gridname='FFSLHIST') - call addfld('U_ffsl_ns' ,(/ 'lev' /), 'I', 'm/s ','U wind on NS grid after dynamics',gridname='FFSLHIST_NS') - call addfld('V_ffsl_ew' ,(/ 'lev' /), 'I', 'm/s ','V wind on EW grid after dynamics',gridname='FFSLHIST_EW') - call addfld('T_ffsl' ,(/ 'lev' /), 'I', 'K ' ,'T on A grid grid after dynamics' ,gridname='FFSLHIST') - call addfld('PS_ffsl', horiz_only, 'I', 'Pa', 'Surface pressure on A grid after dynamics',gridname='FFSLHIST') - call addfld('PHIS_ffsl', horiz_only, 'I', 'Pa', 'Geopotential height on A grid after dynamics',gridname='FFSLHIST') - - - ! Fields for initial condition files - call addfld('U&IC', (/ 'lev' /), 'I', 'm/s', 'Zonal wind', gridname='FFSLHIST' ) - call addfld('V&IC', (/ 'lev' /), 'I', 'm/s', 'Meridional wind',gridname='FFSLHIST' ) - ! Don't need to register U&IC V&IC as vector components since we don't interpolate IC files - call add_default('U&IC',0, 'I') - call add_default('V&IC',0, 'I') - - call addfld('PS&IC', horiz_only, 'I', 'Pa', 'Surface pressure',gridname='FFSLHIST') - call addfld('PHIS&IC', horiz_only, 'I', 'Pa', 'PHIS on ffsl grid',gridname='FFSLHIST') - call addfld('T&IC', (/ 'lev' /), 'I', 'K', 'Temperature', gridname='FFSLHIST') - call add_default('PS&IC',0, 'I') - call add_default('PHIS&IC',0, 'I') - call add_default('T&IC ',0, 'I') - - do m_cnst = 1,pcnst - call addfld(trim(cnst_name(m_cnst))//'&IC', (/ 'lev' /), 'I', 'kg/kg', & - trim(cnst_longname(m_cnst)), gridname='FFSLHIST') - call add_default(trim(cnst_name(m_cnst))//'&IC', 0, 'I') - end do - - -end subroutine stepon_init - -!======================================================================= - -subroutine stepon_run1(dtime_out, phys_state, phys_tend, pbuf2d, dyn_in, dyn_out) - - ! ROUTINE: stepon_run1 -- Phase 1 of dynamics run method. - - use physics_buffer, only: physics_buffer_desc - use dp_coupling, only: d_p_coupling - - real(r8), intent(out) :: dtime_out ! Time-step - type (physics_state), intent(inout) :: phys_state(begchunk:endchunk) - type (physics_tend), intent(inout) :: phys_tend(begchunk:endchunk) - type (physics_buffer_desc), pointer :: pbuf2d(:,:) - type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container - type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container - - dtime_out = get_step_size() - - call diag_dyn_out(dyn_out,'') - - !---------------------------------------------------------- - ! Move data into phys_state structure. - !---------------------------------------------------------- - - call t_barrierf('sync_d_p_coupling', mpicom) - call t_startf('d_p_coupling') - call d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) - call t_stopf('d_p_coupling') - -end subroutine stepon_run1 - -!======================================================================= - -subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out) - - ! ROUTINE: stepon_run2 -- second phase run method - - use dp_coupling, only: p_d_coupling - use dyn_comp, only: calc_tot_energy_dynamics - - type (physics_state), intent(inout) :: phys_state(begchunk:endchunk) - type (physics_tend), intent(inout) :: phys_tend(begchunk:endchunk) - type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container - type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container - - ! copy from phys structures -> dynamics structures - - call t_barrierf('sync_p_d_coupling', mpicom) -#if ( defined CALC_ENERGY ) - call calc_tot_energy_dynamics(dyn_in%atm, 'dED') -#endif - call t_startf('p_d_coupling') - call p_d_coupling(phys_state, phys_tend, dyn_in) - call t_stopf('p_d_coupling') - -#if ( defined CALC_ENERGY ) - call calc_tot_energy_dynamics(dyn_in%atm, 'dBD') -#endif -end subroutine stepon_run2 - -!======================================================================= - -subroutine stepon_run3(dtime, cam_out, phys_state, dyn_in, dyn_out) - - use camsrfexch, only: cam_out_t - use dyn_comp, only: dyn_run - - real(r8), intent(in) :: dtime ! Time-step - type (physics_state), intent(in):: phys_state(begchunk:endchunk) - type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container - type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container - type (cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) - - call t_barrierf('sync_dyn_run', mpicom) - call t_startf('dyn_run') - call dyn_run(dyn_out) - call t_stopf('dyn_run') - -end subroutine stepon_run3 - -!======================================================================= - -subroutine stepon_final(dyn_in, dyn_out) - - ! ROUTINE: stepon_final -- Dynamics finalization - - use dyn_comp, only: dyn_final - - type (dyn_import_t), intent(inout) :: dyn_in ! Dynamics import container - type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container - - call t_startf('dyn_final') - call dyn_final(dyn_in, dyn_out) - call t_stopf('dyn_final') - -end subroutine stepon_final - -!======================================================================= - -subroutine diag_dyn_out(dyn_in,suffx) - - use cam_history, only: write_inithist, outfld, hist_fld_active, fieldname_len - use constituents, only: cnst_name, pcnst - use dyn_grid, only: mytile - use fv_arrays_mod, only: fv_atmos_type - use dimensions_mod, only: nlev - - type (dyn_export_t), intent(in) :: dyn_in - character*(*) , intent(in) :: suffx ! suffix for "outfld" names - - - ! local variables - integer :: is,ie,js,je, j, m_cnst,m_cnst_ffsl - integer :: idim - character(len=fieldname_len) :: tfname - - type (fv_atmos_type), pointer :: Atm(:) - - !---------------------------------------------------------------------------- - - Atm=>dyn_in%atm - - is = Atm(mytile)%bd%is - ie = Atm(mytile)%bd%ie - js = Atm(mytile)%bd%js - je = Atm(mytile)%bd%je - - idim=ie-is+1 - ! Output tracer fields for analysis of advection schemes - do m_cnst = 1, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - tfname = trim(cnst_name(m_cnst))//'_ffsl'//trim(suffx) - if (hist_fld_active(tfname)) then - do j = js, je - call outfld(tfname, RESHAPE(Atm(mytile)%q(is:ie, j, :, m_cnst_ffsl),(/idim,nlev/)), idim, j) - end do - end if - end do - - ! Output tracer fields for analysis of advection schemes - do m_cnst = 1, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - tfname = trim(cnst_name(m_cnst))//'_mass_ffsl'//trim(suffx) - if (hist_fld_active(tfname)) then - do j = js, je - call outfld(tfname,RESHAPE((Atm(mytile)%q(is:ie,j,:,m_cnst_ffsl)*Atm(mytile)%delp(is:ie,j,:)),(/idim,nlev/)),idim, j) - end do - end if - end do - - if (hist_fld_active('U_ffsl'//trim(suffx)) .or. hist_fld_active('V_ffsl'//trim(suffx))) then - do j = js, je - call outfld('U_ffsl'//trim(suffx), RESHAPE(Atm(mytile)%ua(is:ie, j, :),(/idim,nlev/)), idim, j) - call outfld('V_ffsl'//trim(suffx), RESHAPE(Atm(mytile)%va(is:ie, j, :),(/idim,nlev/)), idim, j) - end do - end if - - if (hist_fld_active('U_ffsl_ns'//trim(suffx))) then - do j = js, je+1 - call outfld('U_ffsl_ns'//trim(suffx), RESHAPE(Atm(mytile)%u(is:ie, j, :),(/idim,nlev/)), idim, j) - end do - end if - - if (hist_fld_active('V_ffsl_ew'//trim(suffx))) then - do j = js, je - call outfld('V_ffsl_ew'//trim(suffx), RESHAPE(Atm(mytile)%v(is:ie+1, j, :),(/idim+1,nlev/)), idim+1, j) - end do - end if - - if (hist_fld_active('T_ffsl'//trim(suffx))) then - do j = js, je - call outfld('T_ffsl'//trim(suffx), RESHAPE(Atm(mytile)%pt(is:ie, j, :),(/idim,nlev/)), idim, j) - end do - end if - - if (hist_fld_active('PS_ffsl'//trim(suffx))) then - do j = js, je - call outfld('PS_ffsl'//trim(suffx), Atm(mytile)%ps(is:ie, j), idim, j) - end do - end if - - if (hist_fld_active('PHIS_ffsl'//trim(suffx))) then - do j = js, je - call outfld('PHIS_ffsl'//trim(suffx), Atm(mytile)%phis(is:ie, j), idim, j) - end do - end if - - if (write_inithist()) then - - do j = js, je - call outfld('T&IC', RESHAPE(Atm(mytile)%pt(is:ie, j, :),(/idim,nlev/)), idim, j) - call outfld('U&IC', RESHAPE(Atm(mytile)%ua(is:ie, j, :),(/idim,nlev/)), idim, j) - call outfld('V&IC', RESHAPE(Atm(mytile)%va(is:ie, j, :),(/idim,nlev/)), idim, j) - call outfld('PS&IC', Atm(mytile)%ps(is:ie, j), idim, j) - call outfld('PHIS&IC', Atm(mytile)%phis(is:ie, j), idim, j) - - do m_cnst = 1, pcnst - m_cnst_ffsl=qsize_tracer_idx_cam2dyn(m_cnst) - call outfld(trim(cnst_name(m_cnst))//'&IC', RESHAPE(Atm(mytile)%q(is:ie, j, :, m_cnst_ffsl),(/idim,nlev/)), idim, j) - end do - end do - end if ! if (write_inithist) - -end subroutine diag_dyn_out - -end module stepon diff --git a/src/dynamics/mpas/Makefile b/src/dynamics/mpas/Makefile index 9c1103cc74..f79b718aa0 100644 --- a/src/dynamics/mpas/Makefile +++ b/src/dynamics/mpas/Makefile @@ -1,7 +1,13 @@ -CPPFLAGS := -D_MPI -DMPAS_NATIVE_TIMERS -DMPAS_GIT_VERSION=unknown -DMPAS_NAMELIST_SUFFIX=atmosphere -DMPAS_CAM_DYCORE +GIT_VERSION=$(shell git -C "$(MPAS_SRC_ROOT)/dycore" describe --always --dirty --tags || echo "N/A" ) +CPPFLAGS := -D_MPI -DMPAS_NATIVE_TIMERS -DMPAS_CAM_DYCORE -DMPAS_PIO_SUPPORT -DMPAS_NO_ESMF_INIT -DMPAS_GIT_VERSION="$(GIT_VERSION)" -DMPAS_BUILD_TARGET="N/A" -DMPAS_NAMELIST_SUFFIX="atmosphere" ifdef PIODEF CPPFLAGS += $(PIODEF) endif +ifeq ($(strip $(COMP_INTERFACE)),nuopc) + CPPFLAGS += -DMPAS_EXTERNAL_ESMF_LIB +endif +# Uncomment next line to enable MPAS to use mpi_f08 module +#CPPFLAGS += -DMPAS_USE_MPI_F08 REGISTRY_FILE := $(MPAS_SRC_ROOT)/dycore/src/core_atmosphere/Registry.xml @@ -15,10 +21,12 @@ INTERFACE_OBJS = \ mpas_atm_core_interface.o \ mpas_atm_dimensions.o \ mpas_atm_threading.o \ + mpas_atm_halos.o \ cam_mpas_subdriver.o DYN_OBJS = \ mpas_atm_time_integration.o \ + mpas_atm_boundaries.o \ mpas_atm_iau.o DIAG_OBJS = \ @@ -27,10 +35,11 @@ DIAG_OBJS = \ DIAGNOSTICS = \ mpas_atm_diagnostic_template.o \ - isobaric_diagnostics.o \ - convective_diagnostics.o \ - pv_diagnostics.o \ - soundings.o + mpas_isobaric_diagnostics.o \ + mpas_cloud_diagnostics.o \ + mpas_convective_diagnostics.o \ + mpas_pv_diagnostics.o \ + mpas_soundings.o REG_OBJS = \ parse.o \ @@ -74,6 +83,8 @@ FRAME_OBJS = \ mpas_io_streams.o \ mpas_bootstrapping.o \ mpas_io_units.o \ + mpas_stream_inquiry.o \ + stream_inquiry.o \ mpas_stream_manager.o \ mpas_stream_list.o \ mpas_forcing.o \ @@ -86,8 +97,10 @@ FRAME_OBJS = \ mpas_pool_routines.o \ xml_stream_parser.o \ regex_matching.o \ - mpas_field_accessor.o \ - mpas_log.o + mpas_log.o \ + mpas_halo.o \ + mpas_string_utils.o + UTIL_OBJS = \ ezxml.o @@ -126,7 +139,8 @@ mpas_framework.o: mpas_dmpar.o \ mpas_io_units.o \ mpas_block_decomp.o \ mpas_stream_manager.o \ - mpas_c_interfacing.o + mpas_c_interfacing.o \ + mpas_halo.o mpas_abort.o: mpas_kind_types.o mpas_io_units.o mpas_threading.o @@ -152,7 +166,7 @@ mpas_dmpar.o: mpas_sort.o mpas_kind_types.o mpas_derived_types.o mpas_hash.o mpa mpas_sort.o: mpas_kind_types.o mpas_log.o -mpas_timekeeping.o: mpas_kind_types.o mpas_derived_types.o mpas_dmpar.o mpas_threading.o mpas_log.o +mpas_timekeeping.o: mpas_string_utils.o mpas_kind_types.o mpas_derived_types.o mpas_dmpar.o mpas_threading.o mpas_log.o mpas_timer.o: mpas_kind_types.o mpas_dmpar.o mpas_threading.o mpas_log.o @@ -170,14 +184,15 @@ mpas_io_units.o: mpas_kind_types.o mpas_threading.o: mpas_kind_types.o +mpas_stream_inquiry.o: mpas_derived_types.o mpas_log.o mpas_c_interfacing.o stream_inquiry.o + mpas_stream_list.o: mpas_derived_types.o mpas_kind_types.o mpas_io_streams.o mpas_timekeeping.o regex_matching.o mpas_log.o mpas_stream_manager.o: mpas_io_streams.o mpas_timekeeping.o mpas_derived_types.o mpas_kind_types.o mpas_c_interfacing.o mpas_stream_list.o mpas_dmpar.o mpas_io.o mpas_threading.o mpas_log.o mpas_forcing.o: mpas_derived_types.o mpas_timekeeping.o mpas_stream_manager.o mpas_log.o mpas_io_units.o -mpas_field_accessor.o: mpas_derived_types.o mpas_kind_types.o mpas_pool_routines.o mpas_log.o - +mpas_halo.o: mpas_derived_types.o mpas_pool_routines.o mpas_log.o # # Operator dependencies @@ -218,14 +233,14 @@ streams_gen: $(STREAMS_GEN_OBJS) ezxml.o # incs: $(REGISTRY_FILE) ( cpp -P -traditional $(CPPFLAGS) -I$(MPAS_SRC_ROOT)/dycore/src/core_atmosphere/diagnostics $(REGISTRY_FILE) > Registry_processed.xml ) - ( ./registry Registry_processed.xml ) + ( ./registry Registry_processed.xml $(CPPFLAGS) ) # # Dycore # dycore: $(DYN_OBJS) $(DIAGNOSTICS) $(DIAG_OBJS) $(INTERFACE_OBJS) -mpas_atm_time_integration.o: mpas_atm_iau.o mpas_atm_dimensions.o +mpas_atm_time_integration.o: mpas_atm_iau.o mpas_atm_dimensions.o mpas_atm_boundaries.o # @@ -233,9 +248,10 @@ mpas_atm_time_integration.o: mpas_atm_iau.o mpas_atm_dimensions.o # mpas_atm_diagnostics_manager.o: mpas_atm_diagnostics_utils.o $(DIAGNOSTICS) -convective_diagnostics.o: mpas_atm_diagnostics_utils.o -isobaric_diagnostics.o: mpas_atm_diagnostics_utils.o -pv_diagnostics.o: mpas_atm_diagnostics_utils.o +mpas_cloud_diagnostics.o: mpas_atm_diagnostics_utils.o +mpas_convective_diagnostics.o: mpas_atm_diagnostics_utils.o +mpas_isobaric_diagnostics.o: mpas_atm_diagnostics_utils.o +mpas_pv_diagnostics.o: mpas_atm_diagnostics_utils.o # @@ -243,7 +259,7 @@ pv_diagnostics.o: mpas_atm_diagnostics_utils.o # mpas_atm_core_interface.o: mpas_atm_core.o incs -mpas_atm_core.o: mpas_atm_threading.o mpas_atm_time_integration.o mpas_atm_diagnostics_manager.o +mpas_atm_core.o: mpas_atm_threading.o mpas_atm_time_integration.o mpas_atm_diagnostics_manager.o mpas_atm_halos.o cam_mpas_subdriver.o: mpas_atm_core_interface.o mpas_derived_types.o mpas_framework.o mpas_domain_routines.o mpas_pool_routines.o diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 12f6d01540..10d75b4b8c 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -8,29 +8,26 @@ module dp_coupling use pmgrid, only: plev use ppgrid, only: begchunk, endchunk, pcols, pver, pverp use constituents, only: pcnst, cnst_type -use physconst, only: gravit, cpairv, cappa, rairv, rh2o, zvir - -use spmd_dyn, only: local_dp_map, block_buf_nrecs, chunk_buf_nrecs -use spmd_utils, only: mpicom, iam, masterproc - -use dyn_grid, only: get_gcol_block_d +use physconst, only: gravit, cappa, zvir +use air_composition,only: cpairv +use air_composition,only: dry_air_species_num use dyn_comp, only: dyn_export_t, dyn_import_t - -use physics_types, only: physics_state, physics_tend -use phys_grid, only: get_ncols_p, get_gcol_all_p, block_to_chunk_send_pters, & - transpose_block_to_chunk, block_to_chunk_recv_pters, & - chunk_to_block_send_pters, transpose_chunk_to_block, & - chunk_to_block_recv_pters +use physics_types, only: physics_state, physics_tend, physics_cnst_limit +use phys_grid, only: get_dyn_col_p, get_chunk_info_p, get_ncols_p +use phys_grid, only: columns_on_task use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_get_field -use cam_logfile, only: iulog -use perf_mod, only: t_startf, t_stopf, t_barrierf +use perf_mod, only: t_startf, t_stopf use cam_abortutils, only: endrun +use air_composition,only: thermodynamic_active_species_num,thermodynamic_active_species_idx, & + thermodynamic_active_species_idx_dycore implicit none private save +logical :: compute_energy_diags=.false. +integer :: index_qv_phys = -1 public :: & d_p_coupling, & @@ -41,12 +38,16 @@ module dp_coupling !========================================================================================= subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) + use cam_mpas_subdriver, only: cam_mpas_update_halo ! Convert the dynamics output state into the physics input state. ! Note that all pressures and tracer mixing ratios coming from the dycore are based on ! dry air mass. - - use mpas_constants, only : Rv_over_Rd => rvord + use cam_history, only: hist_fld_active + use dyn_comp, only: frontgf_idx, frontga_idx + use mpas_constants, only: Rv_over_Rd => rvord + use phys_control, only: use_gw_front, use_gw_front_igw + use cam_budget, only : thermo_budget_history ! arguments type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) @@ -61,8 +62,7 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) integer :: index_qv integer, dimension(:), pointer :: cam_from_mpas_cnst - real(r8), pointer :: pmiddry(:,:) - real(r8), pointer :: pintdry(:,:) + real(r8), pointer :: exner(:,:) real(r8), pointer :: zint(:,:) real(r8), pointer :: zz(:,:) real(r8), pointer :: rho_zz(:,:) @@ -70,30 +70,58 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) real(r8), pointer :: uy(:,:) real(r8), pointer :: w(:,:) real(r8), pointer :: theta_m(:,:) - real(r8), pointer :: exner(:,:) real(r8), pointer :: tracers(:,:,:) + ! + ! mesh information and coefficients needed for + ! frontogenesis function calculation + ! + real(r8), pointer :: defc_a(:,:) + real(r8), pointer :: defc_b(:,:) + real(r8), pointer :: cell_gradient_coef_x(:,:) + real(r8), pointer :: cell_gradient_coef_y(:,:) + real(r8), pointer :: edgesOnCell_sign(:,:) + real(r8), pointer :: dvEdge(:) + real(r8), pointer :: areaCell(:) - integer :: lchnk, icol, k, kk ! indices over chunks, columns, layers - integer :: i, m, ncols, blockid - integer :: blk(1), bcid(1) + integer, pointer :: cellsOnEdge(:,:) + integer, pointer :: edgesOnCell(:,:) + integer, pointer :: nEdgesOnCell(:) - integer :: pgcols(pcols) - integer :: tsize ! amount of data per grid point passed to physics - integer, allocatable :: bpter(:,:) ! offsets into block buffer for packing data - integer, allocatable :: cpter(:,:) ! offsets into chunk buffer for unpacking data + real(r8), pointer :: uperp(:,:) + real(r8), pointer :: utangential(:,:) - real(r8), allocatable, dimension(:) :: bbuffer, cbuffer ! transpose buffers + ! + ! local storage for frontogenesis function and angle + ! + real(r8), pointer :: frontogenesisFunction(:,:) + real(r8), pointer :: frontogenesisAngle(:,:) + real(r8), pointer :: pbuf_frontgf(:,:) + real(r8), pointer :: pbuf_frontga(:,:) + real(r8), allocatable :: frontgf_phys(:,:,:) + real(r8), allocatable :: frontga_phys(:,:,:) + + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + + integer :: lchnk, icol, icol_p, k, kk ! indices over chunks, columns, physics columns and layers + integer :: i, m, ncols + integer :: block_index + integer, dimension(:), pointer :: block_offset + + real(r8), allocatable:: pmid(:,:) !mid-level hydrostatic pressure consistent with MPAS discrete state + real(r8), allocatable:: pintdry(:,:) !interface hydrostatic pressure consistent with MPAS discrete state + real(r8), allocatable:: pmiddry(:,:) !mid-level hydrostatic dry pressure consistent with MPAS discrete state + integer :: ierr character(len=*), parameter :: subname = 'd_p_coupling' !---------------------------------------------------------------------------- + compute_energy_diags=thermo_budget_history + nCellsSolve = dyn_out % nCellsSolve index_qv = dyn_out % index_qv cam_from_mpas_cnst => dyn_out % cam_from_mpas_cnst - pmiddry => dyn_out % pmiddry - pintdry => dyn_out % pintdry zint => dyn_out % zint zz => dyn_out % zz rho_zz => dyn_out % rho_zz @@ -104,134 +132,143 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) exner => dyn_out % exner tracers => dyn_out % tracers - ! diagnose pintdry, pmiddry - call dry_hydrostatic_pressure( & - nCellsSolve, plev, zz, zint, rho_zz, theta_m, pmiddry, pintdry) - - call t_startf('dpcopy') + if (compute_energy_diags) then + call tot_energy_dyn(nCellsSolve, plev,size(tracers, 1), index_qv, zz(:,1:nCellsSolve), zint(:,1:nCellsSolve), & + rho_zz(:,1:nCellsSolve), theta_m(:,1:nCellsSolve), tracers(:,:,1:nCellsSolve),& + ux(:,1:nCellsSolve),uy(:,1:nCellsSolve),'dBF') + end if + ! + ! diagnose pintdry, pmiddry, pmid + ! + allocate(pmid(plev, nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate pmid array') + + allocate(pmiddry(plev, nCellsSolve), stat=ierr)!note: .neq. dyn_out % pmiddry since it is non-hydrostatic + if( ierr /= 0 ) call endrun(subname//':failed to allocate pmiddry array') + + allocate(pintdry(plev+1, nCellsSolve), stat=ierr)!note: .neq. dyn_out % pintdry since it is non-hydrostatic + if( ierr /= 0 ) call endrun(subname//':failed to allocate pintdry array') + + call hydrostatic_pressure( & + nCellsSolve, plev, size(tracers, 1), index_qv, zz, zint, rho_zz, theta_m, exner, tracers,& + pmiddry, pintdry, pmid) + + if (use_gw_front .or. use_gw_front_igw) then + call cam_mpas_update_halo('scalars', endrun) ! scalars is the name of tracers in the MPAS state pool + nullify(pbuf_chnk) + nullify(pbuf_frontgf) + nullify(pbuf_frontga) + ! + ! compute frontogenesis function and angle for gravity wave scheme + ! + defc_a => dyn_out % defc_a + defc_b => dyn_out % defc_b + cell_gradient_coef_x => dyn_out % cell_gradient_coef_x + cell_gradient_coef_y => dyn_out % cell_gradient_coef_y + edgesOnCell_sign => dyn_out % edgesOnCell_sign + dvEdge => dyn_out % dvEdge + areaCell => dyn_out % areaCell + cellsOnEdge => dyn_out % cellsOnEdge + edgesOnCell => dyn_out % edgesOnCell + nEdgesOnCell => dyn_out % nEdgesOnCell + uperp => dyn_out % uperp + utangential => dyn_out % utangential + + allocate(frontogenesisFunction(plev, nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate frontogenesisFunction array') + allocate(frontogenesisAngle(plev, nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate frontogenesisAngle array') + + allocate(frontgf_phys(pcols, pver, begchunk:endchunk), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate frontgf_phys array') + allocate(frontga_phys(pcols, pver, begchunk:endchunk), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate frontga_phys array') + + + call calc_frontogenesis( frontogenesisFunction, frontogenesisAngle, & + theta_m, tracers(index_qv,:,:), & + uperp, utangential, defc_a, defc_b, & + cell_gradient_coef_x, cell_gradient_coef_y, & + areaCell, dvEdge, cellsOnEdge, edgesOnCell, & + nEdgesOnCell, edgesOnCell_sign, & + plev, nCellsSolve ) - if (local_dp_map) then + end if - !$omp parallel do private (lchnk, ncols, icol, i, k, kk, m, pgcols, blk, bcid) - do lchnk = begchunk, endchunk + call t_startf('dpcopy') - ncols = get_ncols_p(lchnk) ! number of columns in this chunk - call get_gcol_all_p(lchnk, pcols, pgcols) ! global column indices in chunk + ncols = columns_on_task - do icol = 1, ncols ! column index in physics chunk - call get_gcol_block_d(pgcols(icol), 1, blk, bcid) ! column index in dynamics block - i = bcid(1) + allocate(block_offset(0), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate block_offset array') - phys_state(lchnk)%psdry(icol) = pintdry(1,i) - phys_state(lchnk)%phis(icol) = zint(1,i) * gravit + do icol = 1, ncols + call get_dyn_col_p(icol, block_index, block_offset) ! Get the dynamic column (block_index) + call get_chunk_info_p(icol, lchnk, icol_p) ! Get the matching physics column (icol_p) + i = block_index - do k = 1, pver ! vertical index in physics chunk - kk = pver - k + 1 ! vertical index in dynamics block + phys_state(lchnk)%psdry(icol_p) = pintdry(1,i) + phys_state(lchnk)%phis(icol_p) = zint(1,i) * gravit - phys_state(lchnk)%t(icol,k) = theta_m(kk,i) / (1.0_r8 + & - Rv_over_Rd * tracers(index_qv,kk,i)) * exner(kk,i) - phys_state(lchnk)%u(icol,k) = ux(kk,i) - phys_state(lchnk)%v(icol,k) = uy(kk,i) - phys_state(lchnk)%omega(icol,k) = -rho_zz(kk,i)*zz(kk,i)*gravit*0.5_r8*(w(kk,i)+w(kk+1,i)) ! omega - phys_state(lchnk)%pmiddry(icol,k) = pmiddry(kk,i) - end do + do k = 1, pver ! vertical index in physics chunk + kk = pver - k + 1 ! vertical index in dynamics block - do k = 1, pverp - kk = pverp - k + 1 - phys_state(lchnk)%pintdry(icol,k) = pintdry(kk,i) - end do + phys_state(lchnk)%t(icol_p,k) = theta_m(kk,i) / (1.0_r8 + & + Rv_over_Rd * tracers(index_qv,kk,i)) * exner(kk,i) + phys_state(lchnk)%u(icol_p,k) = ux(kk,i) + phys_state(lchnk)%v(icol_p,k) = uy(kk,i) + phys_state(lchnk)%omega(icol_p,k) = -rho_zz(kk,i)*zz(kk,i)*gravit*0.5_r8*(w(kk,i)+w(kk+1,i)) ! omega + phys_state(lchnk)%pmiddry(icol_p,k) = pmiddry(kk,i) + phys_state(lchnk)%pmid(icol_p,k) = pmid(kk,i) - do m = 1, pcnst - do k = 1, pver - kk = pver - k + 1 - phys_state(lchnk)%q(icol,k,m) = tracers(cam_from_mpas_cnst(m),kk,i) - end do - end do - end do + if (use_gw_front .or. use_gw_front_igw) then + frontgf_phys(icol_p, k, lchnk) = frontogenesisFunction(kk, i) + frontga_phys(icol_p, k, lchnk) = frontogenesisAngle(kk, i) + end if end do - else ! .not. local_dp_map - - tsize = 6 + pcnst - allocate(bbuffer(tsize*block_buf_nrecs)) ! block buffer - bbuffer = 0.0_r8 - allocate(cbuffer(tsize*chunk_buf_nrecs)) ! chunk buffer - cbuffer = 0.0_r8 - - allocate( bpter(nCellsSolve,0:pver) ) - allocate( cpter(pcols,0:pver) ) - - blockid = iam + 1 ! global block index - call block_to_chunk_send_pters(blockid, nCellsSolve, pverp, tsize, bpter) - - do i = 1, nCellsSolve ! column index in block - - bbuffer(bpter(i,0)) = pintdry(1,i) ! psdry - bbuffer(bpter(i,0)+1) = zint(1,i) * gravit ! phis + do k = 1, pverp + kk = pverp - k + 1 + phys_state(lchnk)%pintdry(icol_p,k) = pintdry(kk,i) + end do + do m = 1, pcnst do k = 1, pver - bbuffer(bpter(i,k)) = theta_m(k,i) / (1.0_r8 + & - Rv_over_Rd * tracers(index_qv,k,i)) * exner(k,i) - bbuffer(bpter(i,k)+1) = ux(k,i) - bbuffer(bpter(i,k)+2) = uy(k,i) - bbuffer(bpter(i,k)+3) = -rho_zz(k,i) * zz(k,i) * gravit * 0.5_r8 * (w(k,i) + w(k+1,i)) ! omega - bbuffer(bpter(i,k)+4) = pmiddry(k,i) - do m=1,pcnst - bbuffer(bpter(i,k)+4+m) = tracers(cam_from_mpas_cnst(m),k,i) - end do - end do - - do k = 1, pverp - bbuffer(bpter(i,k-1)+5+pcnst) = pintdry(k,i) + kk = pver - k + 1 + phys_state(lchnk)%q(icol_p,k,m) = tracers(cam_from_mpas_cnst(m),kk,i) end do end do + end do - call t_barrierf ('sync_blk_to_chk', mpicom) - call t_startf ('block_to_chunk') - call transpose_block_to_chunk(tsize, bbuffer, cbuffer) - call t_stopf ('block_to_chunk') + if (use_gw_front .or. use_gw_front_igw) then - !$omp parallel do private (lchnk, ncols, icol, k, kk, m, cpter) + !$omp parallel do private (lchnk, ncols, icol, k, pbuf_chnk, pbuf_frontgf, pbuf_frontga) do lchnk = begchunk, endchunk - ncols = phys_state(lchnk)%ncol - - call block_to_chunk_recv_pters(lchnk, pcols, pverp, tsize, cpter) - - do icol = 1, ncols - - phys_state(lchnk)%psdry(icol) = cbuffer(cpter(icol,0)) - phys_state(lchnk)%phis(icol) = cbuffer(cpter(icol,0)+1) - - ! do the vertical reorder here when assigning to phys_state - do k = 1, pver - kk = pver - k + 1 - phys_state(lchnk)%t (icol,kk) = cbuffer(cpter(icol,k)) - phys_state(lchnk)%u (icol,kk) = cbuffer(cpter(icol,k)+1) - phys_state(lchnk)%v (icol,kk) = cbuffer(cpter(icol,k)+2) - phys_state(lchnk)%omega (icol,kk) = cbuffer(cpter(icol,k)+3) - phys_state(lchnk)%pmiddry(icol,kk) = cbuffer(cpter(icol,k)+4) - do m = 1, pcnst - phys_state(lchnk)%q (icol,kk,m) = cbuffer(cpter(icol,k)+4+m) - end do - end do - - do k = 0, pver - kk = pverp - k - phys_state(lchnk)%pintdry(icol,kk) = cbuffer(cpter(icol,k)+5+pcnst) + ncols = get_ncols_p(lchnk) + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + call pbuf_get_field(pbuf_chnk, frontgf_idx, pbuf_frontgf) + call pbuf_get_field(pbuf_chnk, frontga_idx, pbuf_frontga) + do k = 1, pver + do icol = 1, ncols + pbuf_frontgf(icol, k) = frontgf_phys(icol, k, lchnk) + pbuf_frontga(icol, k) = frontga_phys(icol, k, lchnk) end do end do end do - - deallocate( bbuffer, bpter ) - deallocate( cbuffer, cpter ) - + deallocate(frontgf_phys) + deallocate(frontga_phys) + deallocate(frontogenesisFunction) + deallocate(frontogenesisAngle) end if + call t_stopf('dpcopy') call t_startf('derived_phys') call derived_phys(phys_state, phys_tend, pbuf2d) call t_stopf('derived_phys') + deallocate(pmid,pintdry,pmiddry) + end subroutine d_p_coupling !========================================================================================= @@ -255,9 +292,10 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in) type(dyn_import_t), intent(inout) :: dyn_in ! Local variables - integer :: lchnk, icol, k, kk ! indices over chunks, columns, layers - integer :: i, m, ncols, blockid - integer :: blk(1), bcid(1) + integer :: lchnk, icol, icol_p, k, kk ! indices over chunks, columns, layers + integer :: i, m, ncols + integer :: block_index + integer, dimension(:), pointer :: block_offset real(r8) :: factor real(r8) :: dt_phys @@ -265,7 +303,6 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in) ! Variables from dynamics import container integer :: nCellsSolve integer :: nCells - integer :: nEdgesSolve integer :: index_qv integer, dimension(:), pointer :: mpas_from_cam_cnst @@ -273,21 +310,16 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in) ! CAM physics output redistributed to blocks. real(r8), allocatable :: t_tend(:,:) - real(r8), allocatable :: qv_tend(:,:) + real(r8), allocatable :: q_tend(:,:,:) real(r8), pointer :: u_tend(:,:) real(r8), pointer :: v_tend(:,:) - - integer :: pgcols(pcols) - integer :: tsize ! amount of data per grid point passed to dynamics - integer, allocatable :: bpter(:,:) ! offsets into block buffer for unpacking data - integer, allocatable :: cpter(:,:) ! offsets into chunk buffer for packing data - - real(r8), allocatable, dimension(:) :: bbuffer, cbuffer ! transpose buffers + integer :: idx_phys, idx_dycore type (mpas_pool_type), pointer :: tend_physics type (field2DReal), pointer :: tend_uzonal, tend_umerid + integer :: ierr character(len=*), parameter :: subname = 'dp_coupling::p_d_coupling' !---------------------------------------------------------------------------- @@ -298,8 +330,10 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in) tracers => dyn_in % tracers - allocate( t_tend(pver,nCellsSolve) ) - allocate( qv_tend(pver,nCellsSolve) ) + allocate( t_tend(pver,nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate t_tend array') + allocate( q_tend(thermodynamic_active_species_num-dry_air_species_num,pver,nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate q_tend array') nullify(tend_physics) call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'tend_physics', tend_physics) @@ -317,120 +351,54 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in) dt_phys = get_step_size() call t_startf('pd_copy') - if (local_dp_map) then - - !$omp parallel do private (lchnk, ncols, icol, i, k, kk, m, pgcols, blk, bcid) - do lchnk = begchunk, endchunk - ncols = get_ncols_p(lchnk) ! number of columns in this chunk - call get_gcol_all_p(lchnk, pcols, pgcols) ! global column indices - - do icol = 1, ncols ! column index in physics chunk - call get_gcol_block_d(pgcols(icol), 1, blk, bcid) ! column index in dynamics block - i = bcid(1) - - do k = 1, pver ! vertical index in physics chunk - kk = pver - k + 1 ! vertical index in dynamics block - - t_tend(kk,i) = phys_tend(lchnk)%dtdt(icol,k) - u_tend(kk,i) = phys_tend(lchnk)%dudt(icol,k) - v_tend(kk,i) = phys_tend(lchnk)%dvdt(icol,k) - - ! convert wet mixing ratios to dry - factor = phys_state(lchnk)%pdel(icol,k)/phys_state(lchnk)%pdeldry(icol,k) - do m = 1, pcnst - if (cnst_type(mpas_from_cam_cnst(m)) == 'wet') then - if (m == index_qv) then - qv_tend(kk,i) = (phys_state(lchnk)%q(icol,k,mpas_from_cam_cnst(m))*factor - tracers(index_qv,kk,i)) / dt_phys - end if - tracers(m,kk,i) = phys_state(lchnk)%q(icol,k,mpas_from_cam_cnst(m))*factor - else - if (m == index_qv) then - qv_tend(kk,i) = (phys_state(lchnk)%q(icol,k,mpas_from_cam_cnst(m)) - tracers(index_qv,kk,i)) / dt_phys - end if - tracers(m,kk,i) = phys_state(lchnk)%q(icol,k,mpas_from_cam_cnst(m)) - end if - end do - - end do + ncols = columns_on_task ! should this be nCellsSolve? + + allocate(block_offset(0), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate block_offset array') + do icol = 1, ncols ! column index in physics chunk + ! Get dynamics block + call get_chunk_info_p(icol, lchnk, icol_p) ! Get the matching physics column (icol_p) + call get_dyn_col_p(icol, block_index, block_offset) ! Get the dynamic column (block_index) + i = block_index + + do k = 1, pver ! vertical index in physics chunk + kk = pver - k + 1 ! vertical index in dynamics block + + t_tend(kk,i) = phys_tend(lchnk)%dtdt(icol_p,k) + u_tend(kk,i) = phys_tend(lchnk)%dudt(icol_p,k) + v_tend(kk,i) = phys_tend(lchnk)%dvdt(icol_p,k) + + ! convert wet mixing ratios to dry + factor = phys_state(lchnk)%pdel(icol_p,k)/phys_state(lchnk)%pdeldry(icol_p,k) + ! + ! compute tendencies for thermodynamic active species + ! + do m=dry_air_species_num + 1,thermodynamic_active_species_num + idx_phys = thermodynamic_active_species_idx(m) + idx_dycore = thermodynamic_active_species_idx_dycore(m) + if (idx_dycore==index_qv) index_qv_phys = m + if (cnst_type(idx_phys) == 'wet') then + q_tend(m,kk,i) = (phys_state(lchnk)%q(icol_p,k,idx_phys)*factor - tracers(idx_dycore,kk,i)) / dt_phys + else + q_tend(m,kk,i) = (phys_state(lchnk)%q(icol_p,k,idx_phys) - tracers(idx_dycore,kk,i)) / dt_phys + end if end do - end do - - else - - tsize = 3 + pcnst - allocate( bbuffer(tsize*block_buf_nrecs) ) - bbuffer = 0.0_r8 - allocate( cbuffer(tsize*chunk_buf_nrecs) ) - cbuffer = 0.0_r8 - - allocate( bpter(nCellsSolve,0:pver) ) - allocate( cpter(pcols,0:pver) ) - - !$omp parallel do private (lchnk, ncols, icol, k, m, cpter) - do lchnk = begchunk, endchunk - ncols = get_ncols_p(lchnk) - - call chunk_to_block_send_pters(lchnk, pcols, pverp, tsize, cpter) - - do icol = 1, ncols - - do k = 1, pver - cbuffer(cpter(icol,k)) = phys_tend(lchnk)%dtdt(icol,k) - cbuffer(cpter(icol,k)+1) = phys_tend(lchnk)%dudt(icol,k) - cbuffer(cpter(icol,k)+2) = phys_tend(lchnk)%dvdt(icol,k) - ! convert wet mixing ratios to dry - factor = phys_state(lchnk)%pdel(icol,k)/phys_state(lchnk)%pdeldry(icol,k) - do m = 1, pcnst - if (cnst_type(m) == 'wet') then - cbuffer(cpter(icol,k)+2+m) = phys_state(lchnk)%q(icol,k,m)*factor - else - cbuffer(cpter(icol,k)+2+m) = phys_state(lchnk)%q(icol,k,m) - end if - end do - - end do + do m = 1, pcnst + if (cnst_type(mpas_from_cam_cnst(m)) == 'wet') then + tracers(m,kk,i) = phys_state(lchnk)%q(icol_p,k,mpas_from_cam_cnst(m))*factor + else + tracers(m,kk,i) = phys_state(lchnk)%q(icol_p,k,mpas_from_cam_cnst(m)) + end if end do end do + end do - call t_barrierf('sync_chk_to_blk', mpicom) - call t_startf ('chunk_to_block') - call transpose_chunk_to_block(tsize, cbuffer, bbuffer) - call t_stopf ('chunk_to_block') - - blockid = iam + 1 ! global block index - - call chunk_to_block_recv_pters(blockid, nCellsSolve, pverp, tsize, bpter) - - do i = 1, nCellsSolve ! index in dynamics block - - ! flip vertical index here - do k = 1, pver ! vertical index in physics chunk - kk = pver - k + 1 ! vertical index in dynamics block - - t_tend(kk,i) = bbuffer(bpter(i,k)) - u_tend(kk,i) = bbuffer(bpter(i,k)+1) - v_tend(kk,i) = bbuffer(bpter(i,k)+2) - - do m = 1, pcnst - if (m == index_qv) then - qv_tend(kk,i) = (bbuffer(bpter(i,k)+2+mpas_from_cam_cnst(m)) - tracers(index_qv,kk,i)) / dt_phys - end if - tracers(m,kk,i) = bbuffer(bpter(i,k)+2+mpas_from_cam_cnst(m)) - end do - - end do - end do - - deallocate( bbuffer, bpter ) - deallocate( cbuffer, cpter ) - - end if call t_stopf('pd_copy') call t_startf('derived_tend') - call derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, qv_tend, dyn_in) + call derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn_in) call t_stopf('derived_tend') call mpas_deallocate_scratch_field(tend_uzonal) @@ -441,14 +409,19 @@ end subroutine p_d_coupling !========================================================================================= subroutine derived_phys(phys_state, phys_tend, pbuf2d) - ! Compute fields in the physics state object which are diagnosed from the ! MPAS prognostic fields. - use geopotential, only: geopotential_t - use check_energy, only: check_energy_timestep_init - use shr_vmath_mod, only: shr_vmath_log - + use geopotential, only: geopotential_t + use check_energy, only: check_energy_timestep_init + use shr_vmath_mod, only: shr_vmath_log + use phys_control, only: waccmx_is + use cam_thermo, only: cam_thermo_dry_air_update, cam_thermo_water_update + use air_composition, only: rairv, dry_air_species_num + use qneg_module, only: qneg3 + use shr_const_mod, only: shr_const_rwv + use constituents, only: qmin + use dyn_tests_utils, only: vcoord=>vc_height ! Arguments type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) type(physics_tend ), intent(inout) :: phys_tend(begchunk:endchunk) @@ -456,7 +429,7 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) ! Local variables - integer :: k, lchnk, m, ncol + integer :: k, lchnk, m, ncol, m_cnst real(r8) :: factor(pcols,pver) real(r8) :: zvirv(pcols,pver) @@ -466,7 +439,6 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) type(physics_buffer_desc), pointer :: pbuf_chnk(:) character(len=*), parameter :: subname = 'dp_coupling::derived_phys' - !---------------------------------------------------------------------------- !$omp parallel do private (lchnk, ncol, k, factor) do lchnk = begchunk,endchunk @@ -503,8 +475,13 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) do k = 1, pver ! To be consistent with total energy formula in physic's check_energy module only - ! include water vapor in moist pdel. - factor(:ncol,k) = 1._r8 + phys_state(lchnk)%q(:ncol,k,1) + ! include water vapor in moist pdel. + factor(:ncol,k) = 1.0_r8 + do m_cnst=dry_air_species_num + 1,thermodynamic_active_species_num + m = thermodynamic_active_species_idx(m_cnst) + ! at this point all q's are dry + factor(:ncol,k) = factor(:ncol,k)+phys_state(lchnk)%q(:ncol,k,m) + end do phys_state(lchnk)%pdel(:ncol,k) = phys_state(lchnk)%pdeldry(:ncol,k)*factor(:ncol,k) phys_state(lchnk)%rpdel(:ncol,k) = 1._r8 / phys_state(lchnk)%pdel(:ncol,k) end do @@ -523,9 +500,6 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) phys_state(lchnk)%ps(:ncol) = phys_state(lchnk)%pint(:ncol,pverp) do k = 1, pver - phys_state(lchnk)%pmid(:ncol,k) = (phys_state(lchnk)%pint(:ncol,k+1) + & - phys_state(lchnk)%pint(:ncol,k)) / 2._r8 - call shr_vmath_log(phys_state(lchnk)%pmid(:ncol,k), & phys_state(lchnk)%lnpmid(:ncol,k), ncol) end do @@ -534,6 +508,30 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) phys_state(lchnk)%exner(:ncol,k) = (pref / phys_state(lchnk)%pmid(:ncol,k))**cappa end do + + + + if (dry_air_species_num>0) then + !------------------------------------------------------------ + ! Apply limiters to mixing ratios of major species + !------------------------------------------------------------ + call physics_cnst_limit( phys_state(lchnk) ) + !----------------------------------------------------------------------------- + ! Call cam_thermo_update to compute cpairv, rairv, mbarv, and cappav as + ! constituent dependent variables. + ! Compute molecular viscosity(kmvis) and conductivity(kmcnd). + ! Fill local zvirv variable; calculated for WACCM-X. + !----------------------------------------------------------------------------- + call cam_thermo_dry_air_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol) + zvirv(:,:) = shr_const_rwv / rairv(:,:,lchnk) -1._r8 + else + zvirv(:,:) = zvir + endif + ! + ! update cp_dycore in module air_composition. + ! (note: at this point q is dry) + ! + call cam_thermo_water_update(phys_state(lchnk)%q(1:ncol,:,:), lchnk, ncol, vcoord) ! Tracers from MPAS are in dry mixing ratio units. CAM's physics package expects constituents ! which have been declared to be type 'wet' when they are registered to be represented by mixing ! ratios based on moist air mass (dry air + water vapor). Do appropriate conversion here. @@ -544,14 +542,13 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) end if end do - ! fill zvirv 2D variables to be compatible with geopotential_t interface - zvirv(:,:) = zvir - ! Compute geopotential height above surface - based on full pressure + ! Note that phys_state%zi(:,plev+1) = 0 whereas zint in MPAS is surface height + ! call geopotential_t( & phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid, phys_state(lchnk)%pint, & phys_state(lchnk)%pmid, phys_state(lchnk)%pdel, phys_state(lchnk)%rpdel, & - phys_state(lchnk)%t, phys_state(lchnk)%q(:,:,1), rairv(:,:,lchnk), gravit, zvirv, & + phys_state(lchnk)%t, phys_state(lchnk)%q(:,:,:), rairv(:,:,lchnk), gravit, zvirv, & phys_state(lchnk)%zi, phys_state(lchnk)%zm, ncol) ! Compute initial dry static energy, include surface geopotential @@ -560,6 +557,11 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) + gravit*phys_state(lchnk)%zm(:ncol,k) + phys_state(lchnk)%phis(:ncol) end do + ! Ensure tracers are all positive + call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & + 1, pcnst, qmin ,phys_state(lchnk)%q) + + ! Compute energy and water integrals of input state pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) call check_energy_timestep_init(phys_state(lchnk), phys_tend(lchnk), pbuf_chnk) @@ -570,26 +572,27 @@ end subroutine derived_phys !========================================================================================= -subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, qv_tend, dyn_in) +subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn_in) ! Derive the physics tendencies required by MPAS from the tendencies produced by ! CAM's physics package. - + use mpas_constants, only: p0,cv,rgas,cp use cam_mpas_subdriver, only : cam_mpas_cell_to_edge_winds, cam_mpas_update_halo - use mpas_constants, only : Rv_over_Rd => rvord - + use mpas_constants, only : Rv_over_Rd => rvord + use time_manager, only : get_step_size + use air_composition, only: get_R ! Arguments integer, intent(in) :: nCellsSolve integer, intent(in) :: nCells real(r8), intent(in) :: t_tend(pver,nCellsSolve) ! physics dtdt - real(r8), intent(in) :: qv_tend(pver,nCellsSolve) ! physics dqvdt + real(r8), intent(in) :: q_tend(thermodynamic_active_species_num,pver,nCellsSolve) ! physics dqvdt real(r8), intent(inout) :: u_tend(pver,nCells+1) ! physics dudt real(r8), intent(inout) :: v_tend(pver,nCells+1) ! physics dvdt type(dyn_import_t), intent(inout) :: dyn_in ! Local variables - + real(r8) :: dtime ! variables from dynamics import container integer :: nEdges real(r8), pointer :: ru_tend(:,:) @@ -601,12 +604,30 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, qv_tend, dy real(r8), pointer :: north(:,:) integer, pointer :: cellsOnEdge(:,:) - real(r8), pointer :: theta(:,:) - real(r8), pointer :: exner(:,:) real(r8), pointer :: rho_zz(:,:) real(r8), pointer :: tracers(:,:,:) - integer :: index_qv + integer :: index_qv,m,idx_dycore + real(r8) :: thetak,exnerk,rhodk,tknew,thetaknew + ! + ! variables for energy diagnostics + ! + real(r8), pointer :: zz(:,:) + real(r8), pointer :: theta_m(:,:) + real(r8), pointer :: zint(:,:) + real(r8), pointer :: ux(:,:) + real(r8), pointer :: uy(:,:) + real(r8) :: theta_m_new(pver,nCellsSolve) !modified potential temperature after various physics updates + real(r8) :: rtheta_param(pver,nCellsSolve)!tendency from temperature change only (for diagnostics) + real(r8) :: Rold(nCellsSolve,pver) + real(r8) :: Rnew(nCellsSolve,pver) + real(r8) :: qk (thermodynamic_active_species_num,pver,nCellsSolve) !water species before physics (diagnostics) + real(r8) :: qktmp (nCellsSolve,pver,thermodynamic_active_species_num) + integer :: idx_thermo (thermodynamic_active_species_num) + real(r8) :: qwv(pver,nCellsSolve) !water vapor before physics + real(r8) :: facnew, facold + + integer :: iCell,k character(len=*), parameter :: subname = 'dp_coupling:derived_tend' !---------------------------------------------------------------------------- @@ -621,17 +642,13 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, qv_tend, dy normal => dyn_in % normal cellsOnEdge => dyn_in % cellsOnEdge - theta => dyn_in % theta - exner => dyn_in % exner rho_zz => dyn_in % rho_zz tracers => dyn_in % tracers - index_qv = dyn_in % index_qv - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Momentum tendency - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! Couple u and v tendencies with rho_zz @@ -656,26 +673,121 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, qv_tend, dy ! call cam_mpas_update_halo('tend_ru_physics', endrun) - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Temperature tendency - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - + dtime = get_step_size() + + zz => dyn_in % zz + theta_m => dyn_in % theta_m + zint => dyn_in % zint + ux => dyn_in % ux + uy => dyn_in % uy + + if (compute_energy_diags) then + ! + ! Rnew and Rold are only needed for diagnostics purposes + ! + do m=dry_air_species_num+1,thermodynamic_active_species_num + idx_thermo(m) = m + idx_dycore = thermodynamic_active_species_idx_dycore(m) + do iCell = 1, nCellsSolve + do k = 1, pver + qktmp(iCell,k,m) = tracers(idx_dycore,k,iCell) + end do + end do + end do + call get_R(qktmp,idx_thermo,Rnew) + Rnew = Rnew*cv/Rgas + + do m=dry_air_species_num+1,thermodynamic_active_species_num + idx_dycore = thermodynamic_active_species_idx_dycore(m) + do iCell = 1, nCellsSolve + do k = 1, pver + qktmp(iCell,k,m) = tracers(idx_dycore,k,iCell)-dtime*q_tend(m,k,iCell) + end do + end do + end do + call get_R(qktmp,idx_thermo,Rold) + Rold=Rold*cv/Rgas + else + Rnew = 0.0_r8 + Rold = 1.0_r8 + end if ! - ! Convert temperature tendency to potential temperature tendency + ! Compute q not updated by physics ! - rtheta_tend(:,1:nCellsSolve) = t_tend(:,1:nCellsSolve) / exner(:,1:nCellsSolve) - + qwv = tracers(index_qv,:,1:nCellsSolve)-dtime*q_tend(index_qv_phys,:,1:nCellsSolve) ! - ! Couple theta tendency with rho_zz + ! for energy diagnostics compute state with physics tendency (no water change) first + ! and then add water changes (parameterizations + dme_adjust) ! - rtheta_tend(:,1:nCellsSolve) = rtheta_tend(:,1:nCellsSolve) * rho_zz(:,1:nCellsSolve) + do iCell = 1, nCellsSolve + do k = 1, pver + rhodk = zz(k,iCell) * rho_zz(k,iCell) + facold = 1.0_r8 + Rv_over_Rd *qwv(k,iCell) + thetak = theta_m(k,iCell)/facold + exnerk = (rgas*rhodk*theta_m(k,iCell)/p0)**(rgas/cv) + ! + ! for compute_energy_diags only + ! + tknew = exnerk*thetak+(cp/Rold(iCell,k))*(Rnew(iCell,k)/cp)*dtime*t_tend(k,icell)!for diags only + thetaknew = (tknew**(cv/cp))*((rgas*rhodk*facold)/p0)**(-rgas/cp) !for diags only + ! + ! calculate theta_m tendency due to parameterizations (but no water adjustment) + ! (for diagnostics only) + ! + rtheta_param(k,iCell) = (thetaknew-thetak)/dtime !for diags only + rtheta_param(k,iCell) = rtheta_param(k,iCell)*(1.0_r8 + Rv_over_Rd *qwv(k,iCell)) !for diags only + !convert to thetam + rtheta_param(k,iCell) = rtheta_param(k,iCell)*rho_zz(k,iCell) !for diags only + ! + ! include water change in theta_m + ! + facnew = 1.0_r8 + Rv_over_Rd *tracers(index_qv,k,iCell) + tknew = exnerk*thetak+dtime*t_tend(k,icell) + thetaknew = (tknew**(cv/cp))*((rgas*rhodk*facnew)/p0)**(-rgas/cp) + rtheta_tend(k,iCell) = (thetaknew*facnew-thetak*facold)/dtime + rtheta_tend(k,iCell) = rtheta_tend(k,iCell) * rho_zz(k,iCell) + end do + end do + + if (compute_energy_diags) then + ! + ! compute energy based on parameterization increment (excl. water change) + ! + theta_m_new = theta_m(:,1:nCellsSolve)+dtime*rtheta_param(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve) + ! + ! temporarily save thermodynamic active species (n+1) + ! + do m=dry_air_species_num+1,thermodynamic_active_species_num + idx_dycore = thermodynamic_active_species_idx_dycore(m) + qk(m,:,: ) = tracers(idx_dycore,:,1:nCellsSolve) + tracers(idx_dycore,:,1:nCellsSolve)= qk(m,:,: )-dtime*q_tend(m,:,1:nCellsSolve) + end do + + call tot_energy_dyn( & + nCellsSolve, plev, size(tracers, 1), index_qv, zz(:,1:nCellsSolve), zint(:,1:nCellsSolve), rho_zz(:,1:nCellsSolve), & + theta_m_new, tracers(:,:,1:nCellsSolve), & + ux(:,1:nCellsSolve)+dtime*u_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve), & + uy(:,1:nCellsSolve)+dtime*v_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve),'dAP') + ! revert + do m=dry_air_species_num+1,thermodynamic_active_species_num + idx_dycore = thermodynamic_active_species_idx_dycore(m) + tracers(idx_dycore,:,1:nCellsSolve)= qk(m,:,: ) + end do + ! + ! compute energy incl. water change + ! + theta_m_new = theta_m(:,1:nCellsSolve)+dtime*rtheta_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve) + call tot_energy_dyn( & + nCellsSolve, plev, size(tracers, 1), index_qv, zz(:,1:nCellsSolve), zint(:,1:nCellsSolve), & + rho_zz(:,1:nCellsSolve), theta_m_new, tracers(:,:,1:nCellsSolve), & + ux(:,1:nCellsSolve)+dtime*u_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve), & + uy(:,1:nCellsSolve)+dtime*v_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve),'dAM') + end if ! - ! Modify with moisture terms + ! compute energy based on parameterization increment (excl. water change) ! - rtheta_tend(:,1:nCellsSolve) = rtheta_tend(:,1:nCellsSolve) * (1.0_r8 + Rv_over_Rd * tracers(index_qv,:,1:nCellsSolve)) - rtheta_tend(:,1:nCellsSolve) = rtheta_tend(:,1:nCellsSolve) + Rv_over_Rd * theta(:,1:nCellsSolve) * qv_tend(:,1:nCellsSolve) + theta_m_new = theta_m(:,1:nCellsSolve)+dtime*rtheta_param(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve) ! ! Update halo for rtheta_m tendency @@ -683,18 +795,16 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, qv_tend, dy call cam_mpas_update_halo('tend_rtheta_physics', endrun) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Density tendency - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! rho_tend = 0.0_r8 - end subroutine derived_tend !========================================================================================= - -subroutine dry_hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, pmiddry, pintdry) - +subroutine hydrostatic_pressure(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, theta_m, & + exner, q, pmiddry, pintdry,pmid) ! Compute dry hydrostatic pressure at layer interfaces and midpoints ! ! Given arrays of zz, zgrid, rho_zz, and theta_m from the MPAS-A prognostic @@ -702,69 +812,283 @@ subroutine dry_hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, thet ! The vertical dimension for 3-d arrays is innermost, and k=1 represents ! the lowest layer or level in the fields. ! - ! IMPORTANT NOTE: At present, this routine is probably not correct when there - ! is moisture in the atmosphere. - - use mpas_constants, only : cp, rgas, cv, gravity, p0 + use mpas_constants, only: cp, rgas, cv, gravity, p0, Rv_over_Rd => rvord ! Arguments integer, intent(in) :: nCells integer, intent(in) :: nVertLevels - real(r8), dimension(nVertLevels, nCells), intent(in) :: zz ! d(zeta)/dz [-] - real(r8), dimension(nVertLevels+1, nCells), intent(in) :: zgrid ! geometric heights of layer interfaces [m] - real(r8), dimension(nVertLevels, nCells), intent(in) :: rho_zz ! dry density / zz [kg m^-3] - real(r8), dimension(nVertLevels, nCells), intent(in) :: theta_m ! potential temperature * (1 + Rv/Rd * qv) - real(r8), dimension(nVertLevels, nCells), intent(out) :: pmiddry ! layer midpoint dry hydrostatic pressure [Pa] - real(r8), dimension(nVertLevels+1, nCells), intent(out) :: pintdry ! layer interface dry hydrostatic pressure [Pa] + integer, intent(in) :: qsize + integer, intent(in) :: index_qv + real(r8), dimension(nVertLevels, nCells), intent(in) :: zz ! d(zeta)/dz [-] + real(r8), dimension(nVertLevels+1, nCells), intent(in) :: zgrid ! geometric heights of layer interfaces [m] + real(r8), dimension(nVertLevels, nCells), intent(in) :: rho_zz ! dry density / zz [kg m^-3] + real(r8), dimension(nVertLevels, nCells), intent(in) :: theta_m ! modified potential temperature + real(r8), dimension(nVertLevels, nCells), intent(in) :: exner ! Exner function + real(r8), dimension(qsize,nVertLevels, nCells), intent(in) :: q ! water vapor dry mixing ratio + real(r8), dimension(nVertLevels, nCells), intent(out):: pmiddry ! layer midpoint dry hydrostatic pressure [Pa] + real(r8), dimension(nVertLevels+1, nCells), intent(out):: pintdry ! layer interface dry hydrostatic pressure [Pa] + real(r8), dimension(nVertLevels, nCells), intent(out):: pmid ! layer midpoint hydrostatic pressure [Pa] ! Local variables - integer :: iCell, k - real(r8), dimension(nCells) :: ptop_int ! Extrapolated pressure at top of the model - real(r8), dimension(nCells) :: ptop_mid ! Full non-hydrostatic pressure at top layer midpoint - real(r8), dimension(nCells) :: ttop_mid ! Temperature at top layer midpoint - real(r8), dimension(nVertLevels) :: dz ! Geometric layer thickness in column - real(r8) :: pi, t - + integer :: iCell, k, idx + real(r8), dimension(nVertLevels) :: dz ! Geometric layer thickness in column + real(r8), dimension(nVertLevels) :: dp,dpdry ! Pressure thickness + real(r8), dimension(nVertLevels+1,nCells) :: pint ! hydrostatic pressure at interface + real(r8) :: sum_water + real(r8) :: pk,rhok,rhodryk,thetavk,kap1,kap2,tvk,tk ! - ! Compute full non-hydrostatic pressure and temperature at top layer midpoint + ! For each column, integrate downward from model top to compute dry hydrostatic pressure at layer + ! midpoints and interfaces. The pressure averaged to layer midpoints should be consistent with + ! the ideal gas law using the rho_zz and theta values prognosed by MPAS at layer midpoints. ! - ptop_mid(:) = p0 * (rgas * rho_zz(nVertLevels,:) * zz(nVertLevels,:) * theta_m(nVertLevels,:) / p0)**(cp/cv) - ttop_mid(:) = theta_m(nVertLevels,:) * & - (zz(nVertLevels,:) * rgas * rho_zz(nVertLevels,:) * theta_m(nVertLevels,:) / p0)**(rgas/(cp-rgas)) + do iCell = 1, nCells + dz(:) = zgrid(2:nVertLevels+1,iCell) - zgrid(1:nVertLevels,iCell) + do k = nVertLevels, 1, -1 + rhodryk = zz(k,iCell)* rho_zz(k,iCell) !full CAM physics density + rhok = 1.0_r8 + do idx=dry_air_species_num+1,thermodynamic_active_species_num + rhok = rhok+q(thermodynamic_active_species_idx_dycore(idx),k,iCell) + end do + rhok = rhok*rhodryk + dp(k) = gravit*dz(k)*rhok + dpdry(k) = gravit*dz(k)*rhodryk + end do + k = nVertLevels + sum_water = 1.0_r8 + do idx=dry_air_species_num+1,thermodynamic_active_species_num + sum_water = sum_water+q(thermodynamic_active_species_idx_dycore(idx),k,iCell) + end do + rhok = sum_water*zz(k,iCell) * rho_zz(k,iCell) + thetavk = theta_m(k,iCell)/sum_water + tvk = thetavk*exner(k,iCell) + pk = dp(k)*rgas*tvk/(gravit*dz(k)) + ! + ! model top pressure consistently diagnosed using the assumption that the mid level + ! is at height z(nVertLevels-1)+0.5*dz + ! + pintdry(nVertLevels+1,iCell) = pk-0.5_r8*dz(nVertLevels)*rhok*gravity !hydrostatic + pint (nVertLevels+1,iCell) = pintdry(nVertLevels+1,iCell) + do k = nVertLevels, 1, -1 + ! + ! compute hydrostatic dry interface pressure so that (pintdry(k+1)-pintdry(k))/g is pseudo density + ! + sum_water = 1.0_r8 + do idx=dry_air_species_num+1,thermodynamic_active_species_num + sum_water = sum_water+q(thermodynamic_active_species_idx_dycore(idx),k,iCell) + end do + thetavk = theta_m(k,iCell)/sum_water!convert modified theta to virtual theta + tvk = thetavk*exner(k,iCell) + tk = tvk*sum_water/(1.0_r8+Rv_over_Rd*q(index_qv,k,iCell)) + pint (k,iCell) = pint (k+1,iCell)+dp(k) + pintdry(k,iCell) = pintdry(k+1,iCell)+dpdry(k) + pmid(k,iCell) = dp(k) *rgas*tvk/(gravit*dz(k)) + pmiddry(k,iCell) = dpdry(k)*rgas*tk /(gravit*dz(k)) + end do + end do +end subroutine hydrostatic_pressure + +subroutine tot_energy_dyn(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, theta_m, q, ux,uy,outfld_name_suffix) + use physconst, only: rair, gravit + use mpas_constants, only: p0,cv,rv,rgas,cp + use cam_history, only: outfld, hist_fld_active + use mpas_constants, only: Rv_over_Rd => rvord + use air_composition, only: thermodynamic_active_species_ice_idx_dycore,thermodynamic_active_species_liq_idx_dycore + use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_liq_num + use air_composition, only: dry_air_species_num, thermodynamic_active_species_R + use cam_thermo, only: wvidx,wlidx,wiidx,seidx,poidx,keidx,teidx,thermo_budget_num_vars + use cam_thermo, only: get_hydrostatic_energy,thermo_budget_vars + use dyn_tests_utils, only: vcoord=>vc_height + use cam_history_support, only: max_fieldname_len + + ! Arguments + integer, intent(in) :: nCells + integer, intent(in) :: nVertLevels + integer, intent(in) :: qsize + integer, intent(in) :: index_qv + real(r8), dimension(nVertLevels, nCells), intent(in) :: zz ! d(zeta)/dz [-] + real(r8), dimension(nVertLevels+1, nCells), intent(in) :: zgrid ! geometric heights of layer interfaces [m] + real(r8), dimension(nVertLevels, nCells), intent(in) :: rho_zz ! dry density / zz [kg m^-3] + real(r8), dimension(nVertLevels, nCells), intent(in) :: theta_m ! modified potential temperature + real(r8), dimension(qsize,nVertLevels, nCells), intent(in) :: q ! tracer array + real(r8), dimension(nVertLevels, nCells), intent(in) :: ux ! A-grid zonal velocity component + real(r8), dimension(nVertLevels, nCells), intent(in) :: uy ! A-grid meridional velocity component + character*(*), intent(in) :: outfld_name_suffix ! suffix for "outfld" names + + ! Local variables + integer :: iCell, k, idx, idx_tmp + integer :: i + real(r8) :: rho_dz,theta,pk,ptop,exner,dz,rhod + real(r8), dimension(nCells,nVertLevels) :: temperature, pdeldry, cp_or_cv, zcell, u, v + real(r8), dimension(nCells) :: phis + real(r8), dimension(nCells,nVertLevels,qsize) :: tracers + real(r8), dimension(nCells) :: kinetic_energy,potential_energy,internal_energy,water_vapor + + real(r8), dimension(nCells) :: liq !total column integrated liquid + real(r8), dimension(nCells) :: ice !total column integrated ice + real(r8) :: sum_species + + character(len=max_fieldname_len) :: name_out(thermo_budget_num_vars) + + + do i=1,thermo_budget_num_vars + name_out(i)=trim(thermo_budget_vars(i))//'_'//trim(outfld_name_suffix) + end do + + kinetic_energy = 0.0_r8 + potential_energy = 0.0_r8 + internal_energy = 0.0_r8 + water_vapor = 0.0_r8 + tracers = 0.0_r8 + + do iCell = 1, nCells + do k = 1, nVertLevels + dz = zgrid(k+1,iCell) - zgrid(k,iCell) + zcell(iCell,k) = 0.5_r8*(zgrid(k,iCell)+zgrid(k+1,iCell))-zgrid(1,iCell) + rhod = zz(k,iCell) * rho_zz(k,iCell) + theta = theta_m(k,iCell)/(1.0_r8 + Rv_over_Rd *q(index_qv,k,iCell))!convert theta_m to theta + exner = (rgas*rhod*theta_m(k,iCell)/p0)**(rgas/cv) + + temperature(iCell,k) = exner*theta + pdeldry(iCell,k) = gravit*rhod*dz + ! + ! internal energy coefficient for MPAS + ! (equation 92 in Eldred et al. 2023; https://rmets.onlinelibrary.wiley.com/doi/epdf/10.1002/qj.4353) + ! + cp_or_cv(iCell,k) = rair + sum_species = 1.0_r8 + do idx=dry_air_species_num + 1,thermodynamic_active_species_num + idx_tmp = thermodynamic_active_species_idx_dycore(idx) + cp_or_cv(iCell,k) = cp_or_cv(iCell,k)+thermodynamic_active_species_R(idx)*q(idx_tmp,k,iCell) + sum_species = sum_species+q(idx_tmp,k,iCell) + end do + cp_or_cv(iCell,k) = cv*cp_or_cv(iCell,k)/(sum_species*rair) + u(iCell,k) = ux(k,iCell) + v(iCell,k) = uy(k,iCell) + phis(iCell) = zgrid(1,iCell)*gravit + do idx=dry_air_species_num+1,thermodynamic_active_species_num + idx_tmp = thermodynamic_active_species_idx_dycore(idx) + tracers(iCell,k,idx_tmp) = q(idx_tmp,k,iCell) + end do + end do + enddo + call get_hydrostatic_energy(tracers, .false., pdeldry, cp_or_cv, u, v, temperature, & + vcoord=vcoord, phis = phis, z_mid=zcell, dycore_idx=.true., & + se=internal_energy, po=potential_energy, ke=kinetic_energy, & + wv=water_vapor , liq=liq , ice=ice) + + call outfld(name_out(seidx),internal_energy ,ncells,1) + call outfld(name_out(poidx),potential_energy,ncells,1) + call outfld(name_out(keidx),kinetic_energy ,ncells,1) + call outfld(name_out(wvidx),water_vapor ,ncells,1) + call outfld(name_out(wlidx),liq ,ncells,1) + call outfld(name_out(wiidx),ice ,ncells,1) + call outfld(name_out(teidx),potential_energy+internal_energy+kinetic_energy,ncells,1) + +end subroutine tot_energy_dyn + + subroutine calc_frontogenesis( frontogenesisFunction, frontogenesisAngle, & + theta_m, qv, u,v, defc_a, defc_b, cell_gradient_coef_x, cell_gradient_coef_y, & + areaCell, dvEdge, cellsOnEdge, edgesOnCell, nEdgesOnCell, edgesOnCell_sign, & + nVertLevels, nCellsSolve ) + + use mpas_constants, only: rvord + + ! inputs + + integer, intent(in) :: nVertLevels, nCellsSolve + real(r8), dimension(:,:), intent(in) :: theta_m, qv + real(r8), dimension(:,:), intent(in) :: u, v + real(r8), dimension(:,:), intent(in) :: defc_a + real(r8), dimension(:,:), intent(in) :: defc_b + real(r8), dimension(:,:), intent(in) :: cell_gradient_coef_x + real(r8), dimension(:,:), intent(in) :: cell_gradient_coef_y + real(r8), dimension(:,:), intent(in) :: edgesOnCell_sign + real(r8), dimension(:), intent(in) :: dvEdge + real(r8), dimension(:), intent(in) :: areaCell + integer, dimension(:,:), intent(in) :: cellsOnEdge + integer, dimension(:,:), intent(in) :: edgesOnCell + integer, dimension(:), intent(in) :: nEdgesOnCell + + ! outputs + + real(r8), dimension(:,:), intent(out) :: frontogenesisFunction(:,:) + real(r8), dimension(:,:), intent(out) :: frontogenesisAngle(:,:) + + ! local storage + + integer :: iCell, iEdge, k, cell1, cell2 + real(r8), dimension(nVertLevels) :: d_diag, d_off_diag, divh, theta_x, theta_y + real(r8) :: edge_sign, thetaEdge ! - ! Extrapolate upward from top layer midpoint to top of the model - ! The formula used here results from combination of the hypsometric equation with the equation - ! for the layer mid-point pressure (i.e., (pint_top + pint_bot)/2 = pmid) + ! for each column, compute frontogenesis function and del(theta) angle ! - ! TODO: Should temperature here be virtual temperature? - ! - ptop_int(:) = 2.0_r8 * ptop_mid(:) & - / (1.0_r8 + exp( (zgrid(nVertLevels+1,:) - zgrid(nVertLevels,:)) * gravity / rgas / ttop_mid(:))) + do iCell = 1,nCellsSolve + + d_diag(1:nVertLevels) = 0.0_r8 + d_off_diag(1:nVertLevels) = 0.0_r8 + divh(1:nVertLevels) = 0.0_r8 + theta_x(1:nVertLevels) = 0.0_r8 + theta_y(1:nVertLevels) = 0.0_r8 + + ! + ! Integrate over edges to compute cell-averaged divergence, deformation, + ! d(theta)/dx, and d(theta)/dy. (x,y) are aligned with (lon,lat) at the + ! cell center in the 2D tangent-plane approximation used here. This alignment + ! is set in the initialization routine for the coefficients + ! defc_a, defc_b, cell_gradient_coef_x and cell_gradient_coef_y that is + ! part of the MPAS mesh initialization. The horizontal divergence is calculated + ! as it is in the MPAS solver, i.e. on the sphere as opposed to on the tangent plane. + ! + do iEdge=1,nEdgesOnCell(iCell) + + edge_sign = edgesOnCell_sign(iEdge,iCell) * dvEdge(edgesOnCell(iEdge,iCell)) / areaCell(iCell) + cell1 = cellsOnEdge(1,edgesOnCell(iEdge,iCell)) + cell2 = cellsOnEdge(2,edgesOnCell(iEdge,iCell)) + + do k=1,nVertLevels + + d_diag(k) = d_diag(k) + defc_a(iEdge,iCell)*u(k,EdgesOnCell(iEdge,iCell)) & + - defc_b(iEdge,iCell)*v(k,EdgesOnCell(iEdge,iCell)) + d_off_diag(k) = d_off_diag(k) + defc_b(iEdge,iCell)*u(k,EdgesOnCell(iEdge,iCell)) & + + defc_a(iEdge,iCell)*v(k,EdgesOnCell(iEdge,iCell)) + divh(k) = divh(k) + edge_sign * u(k,EdgesOnCell(iEdge,iCell)) + thetaEdge = 0.5_r8*( theta_m(k,cell1)/(1.0_r8 + rvord*qv(k,cell1)) & + +theta_m(k,cell2)/(1.0_r8 + rvord*qv(k,cell2)) ) + theta_x(k) = theta_x(k) + cell_gradient_coef_x(iEdge,iCell)*thetaEdge + theta_y(k) = theta_y(k) + cell_gradient_coef_y(iEdge,iCell)*thetaEdge - ! - ! For each column, integrate downward from model top to compute dry hydrostatic pressure at layer - ! midpoints and interfaces. The pressure averaged to layer midpoints should be consistent with - ! the ideal gas law using the rho_zz and theta_m values prognosed by MPAS at layer midpoints. - ! - ! TODO: Should temperature here be virtual temperature? - ! TODO: Is it problematic that the computed temperature is consistent with the non-hydrostatic pressure? - ! - do iCell = 1, nCells + end do - dz(:) = zgrid(2:nVertLevels+1,iCell) - zgrid(1:nVertLevels,iCell) + end do + + ! + ! compute the frontogenesis function: + ! 1/2 |del(theta)/dt)| = 1/2 ( + ! - Div * |del(theta)|^2 + ! - E (d(theta)/dx)^2 + ! - 2F (d(theta)/dx)*(d(theta)/dy) + ! + E (d(theta)/dy) ) + ! where + ! Div = u_x + v_y (horizontal velocity divergence) + ! E = u_x - v_y (stretching deformation) + ! F = v_x + u_y (shearing deformation) + ! + do k=1, nVertLevels + + frontogenesisFunction(k,iCell) = 0.5_r8*( & + -divh(k)*(theta_x(k)**2 + theta_y(k)**2) & + -d_diag(k)*theta_x(k)**2 & + -2.0_r8*d_off_diag(k)*theta_x(k)*theta_y(k) & + +d_diag(k)*theta_y(k)**2 ) + frontogenesisAngle(k,iCell) = atan2(theta_y(k),theta_x(k)) - pintdry(nVertLevels+1,iCell) = ptop_int(iCell) - do k = nVertLevels, 1, -1 - pintdry(k,iCell) = pintdry(k+1,iCell) + gravity * zz(k,iCell) * rho_zz(k,iCell) * dz(k) - pmiddry(k,iCell) = 0.5_r8 * (pintdry(k+1,iCell) + pintdry(k,iCell)) end do - end do -end subroutine dry_hydrostatic_pressure + end do -!========================================================================================= + end subroutine calc_frontogenesis end module dp_coupling diff --git a/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 b/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 index 9cfe90b0bb..f456967484 100644 --- a/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 +++ b/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 @@ -10,8 +10,9 @@ module cam_mpas_subdriver ! !------------------------------------------------------------------------------- - - use mpas_derived_types, only : core_type, dm_info, domain_type, MPAS_Clock_type + use cam_abortutils, only: endrun + use mpas_derived_types, only : core_type, domain_type, MPAS_Clock_type + use phys_control, only: use_gw_front, use_gw_front_igw implicit none @@ -32,7 +33,9 @@ module cam_mpas_subdriver cam_mpas_cell_to_edge_winds, & cam_mpas_run, & cam_mpas_finalize, & - cam_mpas_debug_stream + cam_mpas_debug_stream, & + cam_mpas_global_sum_real + public :: corelist, domain_ptr private @@ -46,10 +49,12 @@ module cam_mpas_subdriver ! This interface should be compatible with CAM's endrun routine ! abstract interface - subroutine halt_model(mesg, ierr) + subroutine halt_model(mesg, ierr, line, file) use shr_kind_mod, only : shr_kind_in character(len=*), intent(in), optional :: mesg integer(kind=shr_kind_in), intent(in), optional :: ierr + integer(kind=shr_kind_in), intent(in), optional :: line + character(len=*), intent(in), optional :: file end subroutine halt_model end interface @@ -70,14 +75,20 @@ end subroutine halt_model !----------------------------------------------------------------------- subroutine cam_mpas_init_phase1(mpicom, endrun, logUnits, realkind) +#ifdef MPAS_USE_MPI_F08 + use mpi_f08, only : mpi_comm_type => mpi_comm +#endif use mpas_domain_routines, only : mpas_allocate_domain use mpas_framework, only : mpas_framework_init_phase1 use atm_core_interface, only : atm_setup_core, atm_setup_domain - use mpas_pool_routines, only : mpas_pool_add_config use mpas_kind_types, only : RKIND ! Dummy argument +#ifdef MPAS_USE_MPI_F08 + type(mpi_comm_type), intent(in) :: mpicom +#else integer, intent(in) :: mpicom +#endif procedure(halt_model) :: endrun integer, dimension(2), intent(in) :: logUnits integer, intent(in) :: realkind @@ -88,22 +99,25 @@ subroutine cam_mpas_init_phase1(mpicom, endrun, logUnits, realkind) character(len=*), parameter :: subname = 'cam_mpas_subdriver::cam_mpas_init_phase1' - allocate(corelist) + allocate(corelist, stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate corelist array') nullify(corelist % next) - allocate(corelist % domainlist) + allocate(corelist % domainlist, stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate corelist%domainlist%next array') nullify(corelist % domainlist % next) domain_ptr => corelist % domainlist domain_ptr % core => corelist call mpas_allocate_domain(domain_ptr) + domain_ptr % domainID = 0 ! ! Initialize MPAS infrastructure (principally, the mpas_dmpar module) ! - call mpas_framework_init_phase1(domain_ptr % dminfo, mpi_comm=mpicom) + call mpas_framework_init_phase1(domain_ptr % dminfo, external_comm=mpicom) call atm_setup_core(corelist) call atm_setup_domain(domain_ptr) @@ -142,18 +156,18 @@ end subroutine cam_mpas_init_phase1 !----------------------------------------------------------------------- subroutine cam_mpas_init_phase2(pio_subsystem, endrun, cam_calendar) - use mpas_log, only : mpas_log_write use mpas_kind_types, only : ShortStrKIND use pio_types, only : iosystem_desc_t use mpas_framework, only : mpas_framework_init_phase2 + use mpas_timer, only : mpas_timer_start + use mpas_stream_inquiry, only : mpas_stream_inquiry_new_streaminfo type (iosystem_desc_t), pointer :: pio_subsystem procedure(halt_model) :: endrun character(len=*), intent(in) :: cam_calendar integer :: ierr - logical :: streamsExists character(len=ShortStrKIND) :: mpas_calendar @@ -175,12 +189,22 @@ subroutine cam_mpas_init_phase2(pio_subsystem, endrun, cam_calendar) ! 4) Continue with normal procedure from MPAS subdriver call mpas_framework_init_phase2(domain_ptr, io_system=pio_subsystem, calendar=trim(mpas_calendar)) + call mpas_timer_start('total time') + + ! Since MPAS is being used as a dycore and is not responsible for IO, it's enough to create this + ! object without running its init(). Any queries made to it will always return `.false.` + domain_ptr % streamInfo => mpas_stream_inquiry_new_streaminfo() + if (.not. associated(domain_ptr % streamInfo)) then + call endrun(subname//': FATAL: streamInfo instantiation failed for core '//trim(domain_ptr % core % coreName)) + end if + ierr = domain_ptr % core % define_packages(domain_ptr % packages) if ( ierr /= 0 ) then call endrun(subname//': FATAL: Package definition failed for core '//trim(domain_ptr % core % coreName)) end if - ierr = domain_ptr % core % setup_packages(domain_ptr % configs, domain_ptr % packages, domain_ptr % iocontext) + ierr = domain_ptr % core % setup_packages(domain_ptr % configs, domain_ptr % streamInfo, & + domain_ptr % packages, domain_ptr % iocontext) if ( ierr /= 0 ) then call endrun(subname//': FATAL: Package setup failed for core '//trim(domain_ptr % core % coreName)) end if @@ -213,52 +237,19 @@ end subroutine cam_mpas_init_phase2 !> the number of constituents. ! !----------------------------------------------------------------------- - subroutine cam_mpas_init_phase3(fh_ini, num_scalars, endrun) + subroutine cam_mpas_init_phase3(fh_ini, num_scalars) - use mpas_log, only : mpas_log_write use pio, only : file_desc_t - use iso_c_binding, only : c_int, c_char, c_ptr, c_loc - - use mpas_derived_types, only : MPAS_Time_type, MPAS_TimeInterval_type - use mpas_derived_types, only : MPAS_IO_PNETCDF, MPAS_IO_PNETCDF5, MPAS_IO_NETCDF, MPAS_IO_NETCDF4 - use mpas_derived_types, only : MPAS_START_TIME - use mpas_derived_types, only : MPAS_STREAM_MGR_NOERR - use mpas_timekeeping, only : mpas_get_clock_time, mpas_get_time, mpas_expand_string, mpas_set_time, & - mpas_set_timeInterval - use mpas_stream_manager, only : MPAS_stream_mgr_init, mpas_build_stream_filename, MPAS_stream_mgr_validate_streams - use mpas_kind_types, only : StrKIND - use mpas_c_interfacing, only : mpas_c_to_f_string, mpas_f_to_c_string + use mpas_derived_types, only : MPAS_IO_NETCDF + use mpas_kind_types, only : StrKIND use mpas_bootstrapping, only : mpas_bootstrap_framework_phase1, mpas_bootstrap_framework_phase2 use mpas_pool_routines, only : mpas_pool_add_config type (file_desc_t), intent(inout) :: fh_ini integer, intent(in) :: num_scalars - procedure(halt_model) :: endrun - integer :: ierr - character(kind=c_char), dimension(StrKIND+1) :: c_filename ! StrKIND+1 for C null-termination character - integer(kind=c_int) :: c_comm - integer(kind=c_int) :: c_ierr - type (c_ptr) :: mgr_p - character(len=StrKIND) :: mesh_stream character(len=StrKIND) :: mesh_filename - character(len=StrKIND) :: mesh_filename_temp - character(len=StrKIND) :: ref_time_temp - character(len=StrKIND) :: filename_interval_temp - character(kind=c_char), dimension(StrKIND+1) :: c_mesh_stream - character(kind=c_char), dimension(StrKIND+1) :: c_mesh_filename_temp - character(kind=c_char), dimension(StrKIND+1) :: c_ref_time_temp - character(kind=c_char), dimension(StrKIND+1) :: c_filename_interval_temp - character(kind=c_char), dimension(StrKIND+1) :: c_iotype - type (MPAS_Time_type) :: start_time - type (MPAS_Time_type) :: ref_time - type (MPAS_TimeInterval_type) :: filename_interval - character(len=StrKIND) :: start_timestamp - character(len=StrKIND) :: iotype - logical :: streamsExists integer :: mesh_iotype - integer :: blockID - character(len=StrKIND) :: timeStamp character(len=*), parameter :: subname = 'cam_mpas_subdriver::cam_mpas_init_phase3' @@ -305,14 +296,13 @@ subroutine cam_mpas_init_phase4(endrun) use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_dimension, mpas_pool_get_config, & mpas_pool_get_field, mpas_pool_get_array, mpas_pool_initialize_time_levels use atm_core, only : atm_mpas_init_block, core_clock => clock - use mpas_dmpar, only : mpas_dmpar_exch_halo_field + use mpas_atm_halos, only : atm_build_halo_groups, exchange_halo_group + use atm_time_integration, only : mpas_atm_dynamics_init procedure(halt_model) :: endrun real (kind=RKIND), pointer :: dt - character(len=StrKIND) :: timeStamp - integer :: i logical, pointer :: config_do_restart type (mpas_pool_type), pointer :: state @@ -355,6 +345,14 @@ subroutine cam_mpas_init_phase4(endrun) clock => domain_ptr % clock core_clock => domain_ptr % clock + ! + ! Build halo exchange groups and set method for exchanging halos in a group + ! + call atm_build_halo_groups(domain_ptr, ierr) + if (ierr /= 0) then + call endrun(subname//':failed to build MPAS-A halo exchange groups.') + end if + call mpas_pool_get_config(domain_ptr % blocklist % configs, 'config_do_restart', config_do_restart) call mpas_pool_get_config(domain_ptr % blocklist % configs, 'config_dt', dt) @@ -373,12 +371,10 @@ subroutine cam_mpas_init_phase4(endrun) if ( ierr /= 0 ) then call endrun(subname//': failed to get MPAS_START_TIME') end if - call mpas_get_time(startTime, dateTimeString=startTimeStamp) + call mpas_get_time(startTime, dateTimeString=startTimeStamp) - call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'state', state) - call mpas_pool_get_field(state, 'u', u_field, 1) - call mpas_dmpar_exch_halo_field(u_field) + call exchange_halo_group(domain_ptr, 'initialization:u') call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'mesh', mesh) call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'state', state) @@ -395,15 +391,12 @@ subroutine cam_mpas_init_phase4(endrun) call mpas_pool_get_array(state, 'initial_time', initial_time2, 2) initial_time2 = initial_time1 - call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'diag', diag) - call mpas_pool_get_field(diag, 'pv_edge', pv_edge_field) - call mpas_dmpar_exch_halo_field(pv_edge_field) - - call mpas_pool_get_field(diag, 'ru', ru_field) - call mpas_dmpar_exch_halo_field(ru_field) + call exchange_halo_group(domain_ptr, 'initialization:pv_edge,ru,rw') - call mpas_pool_get_field(diag, 'rw', rw_field) - call mpas_dmpar_exch_halo_field(rw_field) + ! + ! Prepare the dynamics for integration + ! + call mpas_atm_dynamics_init(domain_ptr) end subroutine cam_mpas_init_phase4 @@ -424,7 +417,7 @@ end subroutine cam_mpas_init_phase4 !> to reorder the constituents; to allow for mapping of indices between CAM !> physics and the MPAS-A dycore, this routine returns index mapping arrays !> mpas_from_cam_cnst and cam_from_mpas_cnst. - !> + !> ! !----------------------------------------------------------------------- subroutine cam_mpas_define_scalars(block, mpas_from_cam_cnst, cam_from_mpas_cnst, ierr) @@ -516,7 +509,8 @@ subroutine cam_mpas_define_scalars(block, mpas_from_cam_cnst, cam_from_mpas_cnst ! ! Determine which of the constituents are moisture species ! - allocate(mpas_from_cam_cnst(num_scalars)) + allocate(mpas_from_cam_cnst(num_scalars), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate mpas_from_cam_cnst array') mpas_from_cam_cnst(:) = 0 num_moist = 0 do i = 1, size(cnst_name) @@ -549,7 +543,8 @@ subroutine cam_mpas_define_scalars(block, mpas_from_cam_cnst, cam_from_mpas_cnst ! ! Create inverse map, cam_from_mpas_cnst ! - allocate(cam_from_mpas_cnst(num_scalars)) + allocate(cam_from_mpas_cnst(num_scalars), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate cam_from_mpas_cnst array') cam_from_mpas_cnst(:) = 0 do i = 1, size(cnst_name) @@ -680,7 +675,6 @@ subroutine cam_mpas_get_global_dims(nCellsGlobal, nEdgesGlobal, nVerticesGlobal, type (mpas_pool_type), pointer :: meshPool - call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'mesh', meshPool) call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve) @@ -720,7 +714,7 @@ subroutine cam_mpas_get_global_coords(latCellGlobal, lonCellGlobal, areaCellGlob use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_dimension, mpas_pool_get_array use mpas_derived_types, only : mpas_pool_type use mpas_kind_types, only : RKIND - use mpas_dmpar, only : mpas_dmpar_sum_int, mpas_dmpar_max_int, mpas_dmpar_max_real_array + use mpas_dmpar, only : mpas_dmpar_sum_int, mpas_dmpar_max_real_array real (kind=RKIND), dimension(:), intent(out) :: latCellGlobal real (kind=RKIND), dimension(:), intent(out) :: lonCellGlobal @@ -732,13 +726,15 @@ subroutine cam_mpas_get_global_coords(latCellGlobal, lonCellGlobal, areaCellGlob integer, dimension(:), pointer :: indexToCellID type (mpas_pool_type), pointer :: meshPool - integer :: nCellsGlobal + integer :: nCellsGlobal,ierr real (kind=RKIND), dimension(:), pointer :: latCell real (kind=RKIND), dimension(:), pointer :: lonCell real (kind=RKIND), dimension(:), pointer :: areaCell real (kind=RKIND), dimension(:), pointer :: temp + character(len=*), parameter :: subname = 'cam_mpas_subdriver::cam_mpas_get_global_coords' + call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'mesh', meshPool) call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) @@ -751,8 +747,9 @@ subroutine cam_mpas_get_global_coords(latCellGlobal, lonCellGlobal, areaCellGlob ! check: size(latCellGlobal) ?= nCellsGlobal - allocate(temp(nCellsGlobal)) - + allocate(temp(nCellsGlobal), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate temp array') + ! ! latCellGlobal ! @@ -813,6 +810,7 @@ subroutine cam_mpas_get_global_blocks(nCellsPerBlock, indexToCellIDBlock, indexT use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_dimension, mpas_pool_get_array use mpas_derived_types, only : mpas_pool_type use mpas_dmpar, only : mpas_dmpar_max_int_array + use string_utils, only: int2str integer, dimension(:), intent(out) :: nCellsPerBlock integer, dimension(:,:), intent(out) :: indexToCellIDBlock @@ -825,7 +823,8 @@ subroutine cam_mpas_get_global_blocks(nCellsPerBlock, indexToCellIDBlock, indexT integer, pointer :: nCellsSolve integer, dimension(:), pointer :: indexToCellID integer, dimension(:), pointer :: temp1d - + integer :: ierr + character(len=*), parameter :: subname = 'cam_mpas_subdriver::cam_mpas_get_global_blocks' call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'mesh', meshPool) call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) @@ -834,7 +833,8 @@ subroutine cam_mpas_get_global_blocks(nCellsPerBlock, indexToCellIDBlock, indexT ! ! nCellsPerBlock ! - allocate(temp1d(size(nCellsPerBlock))) + allocate(temp1d(size(nCellsPerBlock)), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate temp1d array at line:'//int2str(__LINE__)) temp1d(:) = 0 temp1d(domain_ptr % dminfo % my_proc_id + 1) = nCellsSolve @@ -845,7 +845,8 @@ subroutine cam_mpas_get_global_blocks(nCellsPerBlock, indexToCellIDBlock, indexT ! ! indexToBlockID ! - allocate(temp1d(size(indexToBlockID))) + allocate(temp1d(size(indexToBlockID)), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate temp1d array at line:'//int2str(__LINE__)) temp1d(:) = -1 do iCell=1,nCellsSolve temp1d(indexToCellID(iCell)) = domain_ptr % dminfo % my_proc_id + 1 ! 1-based block indices? @@ -858,7 +859,8 @@ subroutine cam_mpas_get_global_blocks(nCellsPerBlock, indexToCellIDBlock, indexT ! ! localCellIDBlock ! - allocate(temp1d(size(localCellIDBlock))) + allocate(temp1d(size(localCellIDBlock)), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate temp1d array at line:'//int2str(__LINE__)) temp1d(:) = 0 do iCell = 1, nCellsSolve temp1d(indexToCellID(iCell)) = iCell @@ -923,6 +925,7 @@ subroutine cam_mpas_read_static(fh_ini, endrun) integer :: ierr_total type (MPAS_pool_type), pointer :: meshPool type (MPAS_pool_type), pointer :: reindexPool + type (MPAS_pool_type), pointer :: allPackages, reindexPkgs type (field1DReal), pointer :: latCell, lonCell, xCell, yCell, zCell type (field1DReal), pointer :: latEdge, lonEdge, xEdge, yEdge, zEdge type (field1DReal), pointer :: latVertex, lonVertex, xVertex, yVertex, zVertex @@ -940,9 +943,12 @@ subroutine cam_mpas_read_static(fh_ini, endrun) type (field3DReal), pointer :: zb, zb3, deriv_two, cellTangentPlane, coeffs_reconstruct type (field2DReal), pointer :: edgeNormalVectors, localVerticalUnitVectors, defc_a, defc_b + type (field2DReal), pointer :: cell_gradient_coef_x, cell_gradient_coef_y type (MPAS_Stream_type) :: mesh_stream + nullify(cell_gradient_coef_x) + nullify(cell_gradient_coef_y) call MPAS_createStream(mesh_stream, domain_ptr % ioContext, 'not_used', MPAS_IO_NETCDF, MPAS_IO_READ, & pio_file_desc=fh_ini, ierr=ierr) @@ -1021,9 +1027,15 @@ subroutine cam_mpas_read_static(fh_ini, endrun) call mpas_pool_get_field(meshPool, 'edgeNormalVectors', edgeNormalVectors) call mpas_pool_get_field(meshPool, 'localVerticalUnitVectors', localVerticalUnitVectors) + call mpas_pool_get_field(meshPool, 'defc_a', defc_a) call mpas_pool_get_field(meshPool, 'defc_b', defc_b) + if (use_gw_front .or. use_gw_front_igw) then + call mpas_pool_get_field(meshPool, 'cell_gradient_coef_x', cell_gradient_coef_x) + call mpas_pool_get_field(meshPool, 'cell_gradient_coef_y', cell_gradient_coef_y) + endif + ierr_total = 0 call MPAS_streamAddField(mesh_stream, latCell, ierr=ierr) @@ -1155,6 +1167,12 @@ subroutine cam_mpas_read_static(fh_ini, endrun) if (ierr /= MPAS_STREAM_NOERR) ierr_total = ierr_total + 1 call MPAS_streamAddField(mesh_stream, defc_b, ierr=ierr) if (ierr /= MPAS_STREAM_NOERR) ierr_total = ierr_total + 1 + if (use_gw_front .or. use_gw_front_igw) then + call MPAS_streamAddField(mesh_stream, cell_gradient_coef_x, ierr=ierr) + if (ierr /= MPAS_STREAM_NOERR) ierr_total = ierr_total + 1 + call MPAS_streamAddField(mesh_stream, cell_gradient_coef_y, ierr=ierr) + if (ierr /= MPAS_STREAM_NOERR) ierr_total = ierr_total + 1 + endif if (ierr_total > 0) then write(errString, '(a,i0,a)') subname//': FATAL: Failed to add ', ierr_total, ' fields to static input stream.' @@ -1236,7 +1254,10 @@ subroutine cam_mpas_read_static(fh_ini, endrun) call MPAS_dmpar_exch_halo_field(localVerticalUnitVectors) call MPAS_dmpar_exch_halo_field(defc_a) call MPAS_dmpar_exch_halo_field(defc_b) - + if (use_gw_front .or. use_gw_front_igw) then + call MPAS_dmpar_exch_halo_field(cell_gradient_coef_x) + call MPAS_dmpar_exch_halo_field(cell_gradient_coef_y) + endif ! ! Re-index from global index space to local index space ! @@ -1251,9 +1272,15 @@ subroutine cam_mpas_read_static(fh_ini, endrun) call MPAS_pool_add_config(reindexPool, 'edgesOnVertex', 1) call MPAS_pool_add_config(reindexPool, 'cellsOnVertex', 1) - call postread_reindex(meshPool, reindexPool) + ! Use an empty package list for reindexPool + call MPAS_pool_create_pool(reindexPkgs) + + call postread_reindex(meshPool, domain_ptr % streamManager % allPackages, & + reindexPool, reindexPkgs) + call MPAS_pool_destroy_pool(reindexPool) + call MPAS_pool_destroy_pool(reindexPkgs) end subroutine cam_mpas_read_static @@ -1319,6 +1346,7 @@ subroutine cam_mpas_setup_restart(fh_rst, restart_stream, direction, endrun) type (field3DReal), pointer :: zb, zb3, deriv_two, cellTangentPlane, coeffs_reconstruct type (field2DReal), pointer :: edgeNormalVectors, localVerticalUnitVectors, defc_a, defc_b + type (field2DReal), pointer :: cell_gradient_coef_x, cell_gradient_coef_y type (field0DChar), pointer :: initial_time type (field0DChar), pointer :: xtime @@ -1358,10 +1386,8 @@ subroutine cam_mpas_setup_restart(fh_rst, restart_stream, direction, endrun) type (field1DReal), pointer :: u_init type (field1DReal), pointer :: qv_init - type (field2DReal), pointer :: tend_ru_physics - type (field2DReal), pointer :: tend_rtheta_physics - type (field2DReal), pointer :: tend_rho_physics - + nullify(cell_gradient_coef_x) + nullify(cell_gradient_coef_y) call MPAS_createStream(restart_stream, domain_ptr % ioContext, 'not_used', MPAS_IO_NETCDF, & direction, pio_file_desc=fh_rst, ierr=ierr) @@ -1442,7 +1468,10 @@ subroutine cam_mpas_setup_restart(fh_rst, restart_stream, direction, endrun) call mpas_pool_get_field(allFields, 'localVerticalUnitVectors', localVerticalUnitVectors) call mpas_pool_get_field(allFields, 'defc_a', defc_a) call mpas_pool_get_field(allFields, 'defc_b', defc_b) - + if (use_gw_front .or. use_gw_front_igw) then + call mpas_pool_get_field(allFields, 'cell_gradient_coef_x', cell_gradient_coef_x) + call mpas_pool_get_field(allFields, 'cell_gradient_coef_y', cell_gradient_coef_y) + endif call mpas_pool_get_field(allFields, 'initial_time', initial_time, timeLevel=1) call mpas_pool_get_field(allFields, 'xtime', xtime, timeLevel=1) call mpas_pool_get_field(allFields, 'u', u, timeLevel=1) @@ -1481,10 +1510,6 @@ subroutine cam_mpas_setup_restart(fh_rst, restart_stream, direction, endrun) call mpas_pool_get_field(allFields, 'u_init', u_init) call mpas_pool_get_field(allFields, 'qv_init', qv_init) - call mpas_pool_get_field(allFields, 'tend_ru_physics', tend_ru_physics) - call mpas_pool_get_field(allFields, 'tend_rtheta_physics', tend_rtheta_physics) - call mpas_pool_get_field(allFields, 'tend_rho_physics', tend_rho_physics) - ierr_total = 0 call MPAS_streamAddField(restart_stream, latCell, ierr=ierr) @@ -1616,7 +1641,12 @@ subroutine cam_mpas_setup_restart(fh_rst, restart_stream, direction, endrun) if (ierr /= MPAS_STREAM_NOERR) ierr_total = ierr_total + 1 call MPAS_streamAddField(restart_stream, defc_b, ierr=ierr) if (ierr /= MPAS_STREAM_NOERR) ierr_total = ierr_total + 1 - + if (use_gw_front .or. use_gw_front_igw) then + call MPAS_streamAddField(restart_stream, cell_gradient_coef_x, ierr=ierr) + if (ierr /= MPAS_STREAM_NOERR) ierr_total = ierr_total + 1 + call MPAS_streamAddField(restart_stream, cell_gradient_coef_y, ierr=ierr) + if (ierr /= MPAS_STREAM_NOERR) ierr_total = ierr_total + 1 + endif call MPAS_streamAddField(restart_stream, initial_time, ierr=ierr) if (ierr /= MPAS_STREAM_NOERR) ierr_total = ierr_total + 1 call MPAS_streamAddField(restart_stream, xtime, ierr=ierr) @@ -1690,13 +1720,6 @@ subroutine cam_mpas_setup_restart(fh_rst, restart_stream, direction, endrun) call MPAS_streamAddField(restart_stream, qv_init, ierr=ierr) if (ierr /= MPAS_STREAM_NOERR) ierr_total = ierr_total + 1 - call MPAS_streamAddField(restart_stream, tend_ru_physics, ierr=ierr) - if (ierr /= MPAS_STREAM_NOERR) ierr_total = ierr_total + 1 - call MPAS_streamAddField(restart_stream, tend_rtheta_physics, ierr=ierr) - if (ierr /= MPAS_STREAM_NOERR) ierr_total = ierr_total + 1 - call MPAS_streamAddField(restart_stream, tend_rho_physics, ierr=ierr) - if (ierr /= MPAS_STREAM_NOERR) ierr_total = ierr_total + 1 - if (ierr_total > 0) then write(errString, '(a,i0,a)') subname//': FATAL: Failed to add ', ierr_total, ' fields to restart stream.' call endrun(trim(errString)) @@ -1741,8 +1764,6 @@ end subroutine cam_mpas_setup_restart !----------------------------------------------------------------------- subroutine cam_mpas_read_restart(restart_stream, endrun) - use pio, only : file_desc_t - use mpas_io_streams, only : MPAS_readStream, MPAS_closeStream use mpas_derived_types, only : MPAS_Stream_type, MPAS_pool_type, MPAS_STREAM_NOERR use mpas_pool_routines, only : MPAS_pool_create_pool, MPAS_pool_destroy_pool, MPAS_pool_add_config @@ -1757,6 +1778,7 @@ subroutine cam_mpas_read_restart(restart_stream, endrun) integer :: ierr type (MPAS_pool_type), pointer :: reindexPool + type (MPAS_pool_type), pointer :: reindexPkgs call MPAS_readStream(restart_stream, 1, ierr=ierr) if (ierr /= MPAS_STREAM_NOERR) then @@ -1833,7 +1855,10 @@ subroutine cam_mpas_read_restart(restart_stream, endrun) call cam_mpas_update_halo('localVerticalUnitVectors', endrun) call cam_mpas_update_halo('defc_a', endrun) call cam_mpas_update_halo('defc_b', endrun) - + if (use_gw_front .or. use_gw_front_igw) then + call cam_mpas_update_halo('cell_gradient_coef_x', endrun) + call cam_mpas_update_halo('cell_gradient_coef_y', endrun) + endif call cam_mpas_update_halo('u', endrun) call cam_mpas_update_halo('w', endrun) call cam_mpas_update_halo('rho_zz', endrun) @@ -1867,10 +1892,6 @@ subroutine cam_mpas_read_restart(restart_stream, endrun) call cam_mpas_update_halo('surface_pressure', endrun) call cam_mpas_update_halo('t_init', endrun) - call cam_mpas_update_halo('tend_ru_physics', endrun) - call cam_mpas_update_halo('tend_rtheta_physics', endrun) - call cam_mpas_update_halo('tend_rho_physics', endrun) - ! ! Re-index from global index space to local index space ! @@ -1885,9 +1906,15 @@ subroutine cam_mpas_read_restart(restart_stream, endrun) call MPAS_pool_add_config(reindexPool, 'edgesOnVertex', 1) call MPAS_pool_add_config(reindexPool, 'cellsOnVertex', 1) - call postread_reindex(domain_ptr % blocklist % allFields, reindexPool) + ! Use an empty package list for reindexPool + call MPAS_pool_create_pool(reindexPkgs) + + call postread_reindex(domain_ptr % blocklist % allFields, & + domain_ptr % streamManager % allPackages, & + reindexPool, reindexPkgs) call MPAS_pool_destroy_pool(reindexPool) + call MPAS_pool_destroy_pool(reindexPkgs) end subroutine cam_mpas_read_restart @@ -1907,8 +1934,6 @@ end subroutine cam_mpas_read_restart !----------------------------------------------------------------------- subroutine cam_mpas_write_restart(restart_stream, endrun) - use pio, only : file_desc_t - use mpas_io_streams, only : MPAS_writeStream, MPAS_closeStream use mpas_derived_types, only : MPAS_Stream_type, MPAS_pool_type, MPAS_STREAM_NOERR use mpas_pool_routines, only : MPAS_pool_create_pool, MPAS_pool_destroy_pool, MPAS_pool_add_config @@ -1923,6 +1948,7 @@ subroutine cam_mpas_write_restart(restart_stream, endrun) integer :: ierr type (MPAS_pool_type), pointer :: reindexPool + type (MPAS_pool_type), pointer :: reindexPkgs ! ! Re-index from local index space to global index space @@ -1938,7 +1964,11 @@ subroutine cam_mpas_write_restart(restart_stream, endrun) call MPAS_pool_add_config(reindexPool, 'edgesOnVertex', 1) call MPAS_pool_add_config(reindexPool, 'cellsOnVertex', 1) - call prewrite_reindex(domain_ptr % blocklist % allFields, reindexPool) + call MPAS_pool_create_pool(reindexPkgs) + + call prewrite_reindex(domain_ptr % blocklist % allFields, & + domain_ptr % streamManager % allPackages, & + reindexPool, reindexPkgs) call MPAS_writeStream(restart_stream, 1, ierr=ierr) if (ierr /= MPAS_STREAM_NOERR) then @@ -1948,6 +1978,7 @@ subroutine cam_mpas_write_restart(restart_stream, endrun) call postwrite_reindex(domain_ptr % blocklist % allFields, reindexPool) call MPAS_pool_destroy_pool(reindexPool) + call MPAS_pool_destroy_pool(reindexPkgs) call MPAS_closeStream(restart_stream, ierr=ierr) if (ierr /= MPAS_STREAM_NOERR) then @@ -1986,6 +2017,8 @@ subroutine cam_mpas_compute_unit_vectors() integer, pointer :: nCells integer :: iCell + character(len=*), parameter :: subname = 'cam_mpas_subdriver::cam_mpas_compute_unit_vectors' + call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'mesh', meshPool) call mpas_pool_get_dimension(meshPool, 'nCells', nCells) call mpas_pool_get_array(meshPool, 'latCell', latCell) @@ -2158,6 +2191,7 @@ subroutine cam_mpas_cell_to_edge_winds(nEdges, uZonal, uMerid, east, north, edge integer :: iEdge, cell1, cell2 + character(len=*), parameter :: subname = 'cam_mpas_subdriver::cam_mpas_cell_to_edge_winds' do iEdge = 1, nEdges cell1 = cellsOnEdge(1,iEdge) @@ -2203,6 +2237,14 @@ subroutine cam_mpas_run(integrationLength) mpas_pool_get_subpool, mpas_pool_shift_time_levels use mpas_timekeeping, only : mpas_advance_clock, mpas_get_clock_time, mpas_get_time, MPAS_NOW, & operator(.lt.), operator(+) +#ifdef __NVCOMPILER + ! + ! Some versions of the nvfortran compiler complain about the illegal use + ! of an operator on a derived type if the following specific + ! implementations of the < and + operators are not explicitly imported + ! + use mpas_timekeeping, only : lt_t_t, add_t_ti +#endif use mpas_timer, only : mpas_timer_start, mpas_timer_stop use mpas_constants, only : Rv_over_Rd => rvord @@ -2224,6 +2266,7 @@ subroutine cam_mpas_run(integrationLength) real(kind=RKIND), dimension(:,:,:), pointer :: scalars integer, save :: itimestep = 1 + character(len=*), parameter :: subname = 'cam_mpas_subdriver::cam_mpas_run' ! Eventually, dt should be domain specific call mpas_pool_get_config(domain_ptr % blocklist % configs, 'config_dt', dt) @@ -2239,17 +2282,17 @@ subroutine cam_mpas_run(integrationLength) runUntilTime = currTime + integrationLength do while (currTime < runUntilTime) - call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr) + call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr) call mpas_log_write('Dynamics timestep beginning at '//trim(timeStamp)) call mpas_timer_start('time integration') call atm_do_timestep(domain_ptr, dt, itimestep) - call mpas_timer_stop('time integration') + call mpas_timer_stop('time integration') ! Move time level 2 fields back into time level 1 for next time step call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'state', state) call mpas_pool_shift_time_levels(state) - + ! Advance clock before writing output itimestep = itimestep + 1 call mpas_advance_clock(clock) @@ -2292,13 +2335,54 @@ subroutine cam_mpas_finalize() use mpas_decomp, only : mpas_decomp_destroy_decomp_list use mpas_timekeeping, only : mpas_destroy_clock use mpas_atm_threading, only : mpas_atm_threading_finalize + use mpas_timer, only : mpas_timer_write_header, mpas_timer_write, mpas_timer_finalize + use mpas_log, only : mpas_log_finalize + use mpas_timer, only : mpas_timer_stop + use mpas_framework, only : mpas_framework_finalize + use atm_time_integration, only : mpas_atm_dynamics_finalize + use mpas_atm_halos, only : atm_destroy_halo_groups + ! Local variables integer :: ierr + character(len=*), parameter :: subname = 'cam_mpas_subdriver::cam_mpas_finalize' + + + ! + ! Finalize the dynamics + ! + call mpas_atm_dynamics_finalize(domain_ptr) call mpas_destroy_clock(clock, ierr) call mpas_decomp_destroy_decomp_list(domain_ptr % decompositions) + + call atm_destroy_halo_groups(domain_ptr, ierr) + if (ierr /= 0) then + call endrun(subname//':failed to destroy MPAS-A halo exchange groups.') + end if + call mpas_atm_threading_finalize(domain_ptr % blocklist) + call mpas_timer_stop('total time') + + call mpas_timer_write_header() + call mpas_timer_write() + call mpas_timer_finalize(domain_ptr) + + ! + ! Finalize infrastructure + ! + deallocate(domain_ptr % streamInfo) ! created by mpas_stream_inquiry_new_streaminfo + + ! Print out log stats and close log file + ! (Do this after timer stats are printed and stream mgr finalized, + ! but before framework is finalized because domain is destroyed there.) + call mpas_log_finalize(ierr) + + call mpas_framework_finalize(domain_ptr % dminfo, domain_ptr) + + deallocate(corelist % domainlist) + deallocate(corelist) + end subroutine cam_mpas_finalize @@ -2308,11 +2392,10 @@ subroutine cam_mpas_debug_stream(domain, filename, timeLevel) use mpas_derived_types, only : MPAS_IO_WRITE, MPAS_IO_NETCDF, MPAS_STREAM_NOERR, MPAS_Stream_type, MPAS_pool_type, & field0DReal, field1DReal, field2DReal, field3DReal, field4DReal, field5DReal, & field1DInteger, field2DInteger, field3DInteger - use mpas_pool_routines, only : MPAS_pool_get_subpool, MPAS_pool_get_field, MPAS_pool_create_pool, MPAS_pool_destroy_pool, & - MPAS_pool_add_config + use mpas_pool_routines, only : MPAS_pool_get_field use mpas_derived_types, only : MPAS_Pool_iterator_type, MPAS_POOL_FIELD, MPAS_POOL_REAL, MPAS_POOL_INTEGER - use mpas_pool_routines, only : mpas_pool_begin_iteration, mpas_pool_get_next_member, mpas_pool_get_config + use mpas_pool_routines, only : mpas_pool_begin_iteration, mpas_pool_get_next_member type (domain_type), intent(inout) :: domain character(len=*), intent(in) :: filename @@ -2334,6 +2417,7 @@ subroutine cam_mpas_debug_stream(domain, filename, timeLevel) type (field3DInteger), pointer :: field_int3d type (MPAS_Stream_type) :: stream + character(len=*), parameter :: subname = 'cam_mpas_subdriver::cam_mpas_debug_stream' call MPAS_createStream(stream, domain % ioContext, trim(filename), MPAS_IO_NETCDF, MPAS_IO_WRITE, & @@ -2507,4 +2591,33 @@ subroutine cam_mpas_debug_stream(domain, filename, timeLevel) end subroutine cam_mpas_debug_stream + !----------------------------------------------------------------------- + ! routine cam_mpas_global_sum_real + ! + !> \brief Compute the global sum of real array + !> \author Miles Curry + !> \date 25 February 2021 + !> \details + !> This routine computes a global sum of a real array across all tasks + !> in a communicator and returns that sum to all tasks. + !> + ! + !----------------------------------------------------------------------- + function cam_mpas_global_sum_real(rarray) result(global_sum) + + use mpas_kind_types, only: RKIND + use mpas_dmpar, only: mpas_dmpar_sum_real + + ! Input variables + real (RKIND), dimension(:), intent(in) :: rarray + real (RKIND) :: global_sum + + real (RKIND) :: local_sum + + local_sum = sum(rarray) + call mpas_dmpar_sum_real(domain_ptr % dminfo, local_sum, global_sum) + + end function cam_mpas_global_sum_real + + end module cam_mpas_subdriver diff --git a/src/dynamics/mpas/dycore b/src/dynamics/mpas/dycore new file mode 160000 index 0000000000..b566fc8a95 --- /dev/null +++ b/src/dynamics/mpas/dycore @@ -0,0 +1 @@ +Subproject commit b566fc8a959390d838aba08fd03c81edae986f6a diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 new file mode 100644 index 0000000000..18dd0e1375 --- /dev/null +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -0,0 +1,407 @@ +module dycore_budget +use shr_kind_mod, only: r8=>shr_kind_r8 +implicit none + +public :: print_budget +real(r8), parameter :: eps = 1.0E-9_r8 +real(r8), parameter :: eps_mass = 1.0E-12_r8 +real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 +real(r8), save :: previous_dEdt_phys_dyn_coupl_err_Agrid = 0.0_r8 +!========================================================================================= +contains +!========================================================================================= + +subroutine print_budget(hstwr) + + use cam_budget, only: cam_budget_get_global, thermo_budget_histfile_num, thermo_budget_history + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + use cam_thermo, only: teidx, seidx, keidx, poidx + + ! arguments + logical, intent(in) :: hstwr(:) + + ! Local variables + character(len=*), parameter :: subname = 'dycore_budget:print_budgets:' + ! + ! physics energy tendencies + ! + integer :: idx(4) + real(r8) :: dEdt_param_physE(4) ! dE/dt CAM physics using physics E formula (phAP-phBP) + real(r8) :: dEdt_param_dynE(4) ! dE/dt CAM physics using dycore E (dyAP-dyBP) + + real(r8) :: dEdt_efix_physE(4) ! dE/dt energy fixer using physics E formula (phBP-phBF) + real(r8) :: dEdt_efix_dynE(4) ! dE/dt energy fixer using dycore E formula (dyBP-dyBF) + + real(r8) :: dEdt_dme_adjust_physE(4) ! dE/dt dry mass adjustment using physics E formula (phAM-phAP) + real(r8) :: dEdt_dme_adjust_dynE(4) ! dE/dt dry mass adjustment using dycore E (dyAM-dyAP) + + real(r8) :: dEdt_param_efix_physE(4) ! dE/dt CAM physics + energy fixer using physics E formula (phAP-phBF) + real(r8) :: dEdt_param_efix_dynE(4) ! dE/dt CAM physics + energy fixer using dycore E formula (dyAP-dyBF) + + real(r8) :: dEdt_phys_total_dynE(4) ! dE/dt physics total using dycore E (dyAM-dyBF) + ! physics total = parameterizations + efix + dry-mass adjustment + ! + ! dycore specific energy tendencies + ! + real(r8) :: dEdt_phys_total_in_dyn(4) ! dEdt of physics total in dynamical core + ! physics total = parameterizations + efix + dry-mass adjustment + real(r8) :: dEdt_param_efix_in_dyn(4) ! dEdt CAM physics + energy fixer in dynamical core + real(r8) :: dEdt_dme_adjust_in_dyn(4) ! dEdt of dme adjust in dynamical core + real(r8) :: dEdt_dycore_and_pdc_estimated_from_efix ! dEdt dycore and PDC errors (estimated in physics) + ! + ! mass budgets physics + ! + real(r8) :: dMdt_efix ! mass tendency energy fixer + real(r8) :: dMdt_parameterizations ! mass tendency physics paramterizations + real(r8) :: dMdt_dme_adjust ! mass tendency dry-mass adjustment + real(r8) :: dMdt_phys_total ! mass tendency physics total (energy fixer + parameterizations + dry-mass adjustment) + ! + ! mass budgets dynamics + ! + real(r8) :: dMdt_phys_total_in_dyn ! mass tendency physics total in dycore + real(r8) :: dMdt_PDC ! mass tendency physics-dynamics coupling + ! + ! physics-dynamics coupling variables + ! + real(r8) :: E_dBF(4) ! E of dynamics state at the end of dycore integration (on dycore deomposition) + real(r8) :: E_dyBF(4) ! E of physics state using dycore E + + + real(r8) :: diff, tmp ! dummy variables + integer :: m_cnst, i + character(LEN=*), parameter :: fmt = "(a40,a15,a1,F6.2,a1,F6.2,a1,E10.2,a5)" + character(LEN=*), parameter :: fmtf = "(a48,F8.4,a6)" + character(LEN=*), parameter :: fmtm = "(a48,E8.2,a9)" + character(LEN=15) :: str(4) + character(LEN=5) :: pf ! pass or fail identifier + !-------------------------------------------------------------------------------------- + + if (masterproc .and. thermo_budget_history .and. hstwr(thermo_budget_histfile_num)) then + idx(1) = teidx !total energy index + idx(2) = seidx !enthaly index + idx(3) = keidx !kinetic energy index + idx(4) = poidx !surface potential energy index + str(1) = "(total )" + str(2) = "(internal )" + str(3) = "(kinetic )" + str(4) = "(potential )" + do i=1,4 + ! + ! CAM physics energy tendencies + ! + call cam_budget_get_global('phAP-phBP',idx(i),dEdt_param_physE(i)) + call cam_budget_get_global('phBP-phBF',idx(i),dEdt_efix_physE(i)) + call cam_budget_get_global('phAM-phAP',idx(i),dEdt_dme_adjust_physE(i)) + call cam_budget_get_global('phAP-phBF',idx(i),dEdt_param_efix_physE(i)) + ! + ! CAM physics energy tendencies using dycore energy formula scaling + ! temperature tendencies for consistency with CAM physics + ! + call cam_budget_get_global('dyAP-dyBP',idx(i),dEdt_param_dynE(i)) + call cam_budget_get_global('dyBP-dyBF',idx(i),dEdt_efix_dynE(i)) + call cam_budget_get_global('dyAM-dyAP',idx(i),dEdt_dme_adjust_dynE(i)) + call cam_budget_get_global('dyAP-dyBF',idx(i),dEdt_param_efix_dynE(i)) + call cam_budget_get_global('dyAM-dyBF',idx(i),dEdt_phys_total_dynE(i)) + call cam_budget_get_global('dyBF' ,idx(i),E_dyBF(i))!state beginning physics + ! + ! CAM physics energy tendencies in dynamical core + ! + call cam_budget_get_global('dAP-dBF',teidx,dEdt_param_efix_in_dyn(i)) + call cam_budget_get_global('dAM-dAP',teidx,dEdt_dme_adjust_in_dyn(i)) + call cam_budget_get_global('dAM-dBF',teidx,dEdt_param_efix_in_dyn(i)) + + call cam_budget_get_global('dAM-dBF',idx(i),dEdt_phys_total_in_dyn(i)) + call cam_budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics + end do + write(iulog,*)" " + write(iulog,*)"======================================================================" + write(iulog,*)"Total energy diagnostics introduced in Lauritzen and Williamson (2019)" + write(iulog,*)"(DOI:10.1029/2018MS001549)" + write(iulog,*)"======================================================================" + write(iulog,*)" " + write(iulog,*)"Globally and vertically integrated total energy (E) diagnostics are" + write(iulog,*)"computed at various points in the physics and dynamics loops to compute" + write(iulog,*)"energy tendencies (dE/dt) and check for consistency (e.g., is E of" + write(iulog,*)"state passed to physics computed using dycore state variables the same" + write(iulog,*)"E of the state in the beginning of physics computed using the physics" + write(iulog,*)"representation of the state)" + write(iulog,*)" " + write(iulog,*)"Energy stages in physics:" + write(iulog,*)"-------------------------" + write(iulog,*)" " + write(iulog,*)" xxBF: state passed to parameterizations, before energy fixer" + write(iulog,*)" xxBP: after energy fixer, before parameterizations" + write(iulog,*)" xxAP: after last phys_update in parameterizations and state " + write(iulog,*)" saved for energy fixer" + write(iulog,*)" xxAM: after dry mass adjustment" + write(iulog,*)" history files saved off here" + write(iulog,*)" " + write(iulog,*)"where xx='ph','dy' " + write(iulog,*)" " + write(iulog,*)"Suffix ph is CAM physics total energy" + write(iulog,*)"(eq. 111 in Lauritzen et al. 2022; 10.1029/2022MS003117)" + write(iulog,*)" " + write(iulog,*)"Suffix dy is dycore energy computed in CAM physics using" + write(iulog,*)"CAM physics state variables" + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"Energy stages in dynamics" + write(iulog,*)"-------------------------" + write(iulog,*)" " + write(iulog,*)" dBF: dynamics state before physics (d_p_coupling)" + write(iulog,*)" dAP: dynamics state with T,u,V increment but not incl water changes" + write(iulog,*)" dAM: dynamics state with full physics increment (incl. water)" + write(iulog,*)" " + write(iulog,*)"Note that these energies are computed using the dynamical core" + write(iulog,*)"state variables which may be different from the physics prognostic" + write(iulog,*)"variables." + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"FYI : norm. diff = absolute normalized difference" + write(iulog,*)"FYI2: diff = difference (not normalized)" + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"Consistency check 0:" + write(iulog,*)"--------------------" + write(iulog,*)" " + write(iulog,*)"For energetic consistency we require that dE/dt [W/m^2] from energy " + write(iulog,*)"fixer and all parameterizations computed using physics E and" + write(iulog,*)"dycore in physics E are the same! Checking:" + write(iulog,*)" " + write(iulog,*) " xx=ph xx=dy norm. diff." + write(iulog,*) " ----- ----- -----------" + do i=1,4 + diff = abs_diff(dEdt_efix_physE(i),dEdt_efix_dynE(i),pf=pf) + write(iulog,fmt)"dE/dt energy fixer (xxBP-xxBF) ",str(i)," ",dEdt_efix_physE(i), " ",dEdt_efix_dynE(i)," ",diff,pf + diff = abs_diff(dEdt_param_physE(i),dEdt_param_dynE(i),pf=pf) + write(iulog,fmt)"dE/dt all parameterizations (xxAP-xxBP) ",str(i)," ",dEdt_param_physE(i)," ",dEdt_param_dynE(i)," ",diff,pf + write(iulog,*) " " + if (diff>eps) then + write(iulog,*)"FAIL" + call endrun(subname//"dE/dt's in physics inconsistent") + end if + end do + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"dE/dt from dry-mass adjustment will differ if dynamics and physics use" + write(iulog,*)"different energy definitions! Checking:" + write(iulog,*)" " + write(iulog,*) " xx=ph xx=dy diff" + write(iulog,*) " ----- ----- ----" + do i=1,4 + diff = dEdt_dme_adjust_physE(i)-dEdt_dme_adjust_dynE(i) + write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",dEdt_dme_adjust_physE(i), & + " ",dEdt_dme_adjust_dynE(i)," ",diff + end do + write(iulog,*)" " + write(iulog,*)"Compare to dry mass adjustment in dynamics (xx=d,dy):" + write(iulog,*) " xx=d xx=dy norm. diff" + write(iulog,*) " ----- ----- ----------" + do i=1,4 + diff = abs_diff(dEdt_dme_adjust_in_dyn(i),dEdt_dme_adjust_dynE(i),pf=pf) + write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",dEdt_dme_adjust_in_dyn(i),& + " ",dEdt_dme_adjust_dynE(i)," ",diff,pf + end do + write(iulog,*)" " + write(iulog,*)" " + ! + ! these diagnostics only make sense time-step to time-step + ! + write(iulog,*)" " + write(iulog,*)"Some energy budget observations:" + write(iulog,*)"--------------------------------" + write(iulog,*)" " + write(iulog,*)" Note that total energy fixer fixes:" + write(iulog,*)" " + write(iulog,*)" -dE/dt energy fixer(t=n) = dE/dt dry mass adjustment (t=n-1) +" + write(iulog,*)" dE/dt adiabatic dycore (t=n-1) +" + write(iulog,*)" dE/dt physics-dynamics coupling errors (t=n-1)" + write(iulog,*)" " + write(iulog,*)" (equation 23 in Lauritzen and Williamson (2019))" + write(iulog,*)" " + write(iulog,*)" Technically this equation is only valid with instantaneous time-step to" + write(iulog,*)" time-step output" + write(iulog,*) " " + write(iulog,*) " dE/dt energy fixer(t=n) = ",dEdt_efix_dynE(1) + write(iulog,*) " dE/dt dry mass adjustment (t=n-1) = ",previous_dEdt_dry_mass_adjust + write(iulog,*) " dE/dt adiabatic dycore (t=n-1) = unknown" + write(iulog,*) " dE/dt PDC errors (A-grid) (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err_Agrid + write(iulog,*) " dE/dt PDC errors (other ) (t=n-1) = unknown" + + dEdt_dycore_and_pdc_estimated_from_efix = -dEdt_efix_dynE(1) - & + previous_dEdt_phys_dyn_coupl_err_Agrid - & + previous_dEdt_dry_mass_adjust + write(iulog,*) " " + write(iulog,*) "Hence the dycore E dissipation and physics-dynamics coupling errors" + write(iulog,*) "associated with mapping wind tendencies to C-grid and dribbling " + write(iulog,*) "tendencies in the dycore (PDC other), estimated from energy fixer " + write(iulog,'(A39,F6.2,A6)') "based on previous time-step values is ",dEdt_dycore_and_pdc_estimated_from_efix," W/M^2" + write(iulog,*) " " + write(iulog,*) " " + write(iulog,*) "-------------------------------------------------------------------" + write(iulog,*) " Consistency check 1: state passed to physics same as end dynamics?" + write(iulog,*) "-------------------------------------------------------------------" + write(iulog,*) " " + write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" + write(iulog,*) "and beginning of physics (using dynamics in physics energy; dyBF) the same?" + write(iulog,*) "" + + if (abs(E_dyBF(1))>eps) then + diff = abs_diff(E_dBF(1),E_dyBF(1)) + if (abs(diff)eps) then + do i=1,4 + write(iulog,*) str(i),":" + write(iulog,*) "======" + diff = abs_diff(dEdt_phys_total_dynE(i),dEdt_phys_total_in_dyn(i),pf=pf) + write(iulog,*) "dE/dt physics-dynamics coupling errors (diff) ",diff + write(iulog,*) "dE/dt physics total in dynamics (dAM-dBF) ",dEdt_phys_total_in_dyn(i) + write(iulog,*) "dE/dt physics total in physics (pAM-pBF) ",dEdt_phys_total_dynE(i) + write(iulog,*) " " + write(iulog,*) " physics total = parameterizations + efix + dry-mass adjustment" + write(iulog,*) " " + end do + end if + write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" MPAS dycore energy tendencies" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + write(iulog,*)" Energy diagnostics have not been implemented in the MPAS" + write(iulog,*)" dynamical core so a detailed budget is not available." + write(iulog,*)" " + write(iulog,*)" dE/dt adiabatic dynamical core must therefore be estimated" + write(iulog,*)" from" + write(iulog,*)" " + write(iulog,*)" dE/dt adiabatic dycore (t=n-1) = " + write(iulog,*)" -dE/dt dry mass adjustment (t=n-1) +" + write(iulog,*)" -dE/dt energy fixer(t=n)" + write(iulog,*)" -dE/dt physics-dynamics coupling errors (t=n-1)" + write(iulog,*)" " + dEdt_dycore_and_pdc_estimated_from_efix = -dEdt_efix_dynE(1)-previous_dEdt_dry_mass_adjust + write(iulog,'(A34,F6.2,A6)') " = ",dEdt_dycore_and_pdc_estimated_from_efix," W/M^2" + write(iulog,*)" " + write(iulog,*)" assuming no physics-dynamics coupling errors, that is," + write(iulog,*)" dE/dt physics-dynamics coupling errors (t=n-1) = 0" + write(iulog,*)" " + write(iulog,*)" For MPAS the physics-dynamics coupling errors include:" + write(iulog,*)" - `dribbling' temperature and wind tendencies during the" + write(iulog,*)" dynamical core time-integration" + write(iulog,*)" - mapping wind tendencies from A to C grid" + write(iulog,*)" " + + write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)"Tracer mass budgets" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + write(iulog,*)"Below the physics-dynamics coupling error is computed as " + write(iulog,*)"dMASS/dt physics tendency in dycore (dBD-dAF) minus" + write(iulog,*)"dMASS/dt total physics (pAM-pBF)" + write(iulog,*)" " + write(iulog,*)" " + do m_cnst=1,thermo_budget_num_vars + if (thermo_budget_vars_massv(m_cnst)) then + write(iulog,*)thermo_budget_vars_descriptor(m_cnst) + write(iulog,*)"------------------------------" + call cam_budget_get_global('phBP-phBF',m_cnst,dMdt_efix) + call cam_budget_get_global('phAM-phAP',m_cnst,dMdt_dme_adjust) + call cam_budget_get_global('phAP-phBP',m_cnst,dMdt_parameterizations) + call cam_budget_get_global('phAM-phBF',m_cnst,dMdt_phys_total) + ! + ! total energy fixer should not affect mass - checking + ! + if (abs(dMdt_efix)>eps_mass) then + write(iulog,*) "dMASS/dt energy fixer (pBP-pBF) ",dMdt_efix," Pa/m^2/s" + write(iulog,*) "ERROR: Mass not conserved in energy fixer. ABORT" + call endrun(subname//"Mass not conserved in energy fixer. See atm.log") + endif + ! + ! dry-mass adjustmnt should not affect mass - checking + ! + if (abs(dMdt_dme_adjust)>eps_mass) then + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",dMdt_dme_adjust," Pa/m^2/s" + write(iulog,*) "ERROR: Mass not conserved in dry mass adjustment. ABORT" + call endrun(subname//"Mass not conserved in dry mass adjustment. See atm.log") + end if + ! + ! all of the mass-tendency should come from parameterization - checking + ! + if (abs(dMdt_parameterizations-dMdt_phys_total)>eps_mass) then + write(iulog,*) "Error: dMASS/dt parameterizations (pAP-pBP) /= dMASS/dt physics total (pAM-pBF)" + write(iulog,*) "dMASS/dt parameterizations (pAP-pBP) ",dMdt_parameterizations," Pa/m^2/s" + write(iulog,*) "dMASS/dt physics total (pAM-pBF) ",dMdt_phys_total," Pa/m^2/s" + call endrun(subname//"mass change not only due to parameterizations. See atm.log") + end if + write(iulog,*)" " + ! + ! check if mass change in physics is the same as dynamical core + ! + call cam_budget_get_global('dAM-dBF',m_cnst,dMdt_phys_total_in_dyn) + dMdt_PDC = dMdt_phys_total-dMdt_phys_total_in_dyn + write(iulog,fmtm)" Mass physics-dynamics coupling error ",dMdt_PDC," Pa/m^2/s" + write(iulog,*)" " + if (abs(dMdt_PDC)>eps_mass) then + write(iulog,fmtm)" dMASS/dt physics tendency in dycore (dAM-dBF) ",dMdt_phys_total_in_dyn," Pa/m^2/s" + write(iulog,fmtm)" dMASS/dt total physics ",dMdt_phys_total," Pa/m^2/s" + end if + end if + end do + ! + ! save dry-mass adjustment to avoid sampling error + ! + previous_dEdt_dry_mass_adjust = dEdt_dme_adjust_dynE(1) + end if + end subroutine print_budget + !========================================================================================= + function abs_diff(a,b,pf) + real(r8), intent(in) :: a,b + character(LEN=5), optional, intent(out):: pf + real(r8) :: abs_diff + if (abs(b)>eps) then + abs_diff = abs((b-a)/b) + else + abs_diff = abs(b-a) + end if + if (present(pf)) then + if (abs_diff>eps) then + pf = ' FAIL' + else + pf = ' PASS' + end if + end if + end function abs_diff +end module dycore_budget + diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index d04fc7be88..a82978f2cf 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -3,7 +3,7 @@ module dyn_comp ! CAM component interfaces to the MPAS Dynamical Core use shr_kind_mod, only: r8=>shr_kind_r8 -use spmd_utils, only: iam, masterproc, mpicom, npes +use spmd_utils, only: masterproc, mpicom, npes use physconst, only: pi, gravit, rair, cpair use pmgrid, only: plev, plevp @@ -11,25 +11,20 @@ module dyn_comp use const_init, only: cnst_init_default use cam_control_mod, only: initial_run -use cam_initfiles, only: initial_file_get_id, topo_file_get_id +use cam_initfiles, only: initial_file_get_id, topo_file_get_id, pertlim -use cam_grid_support, only: cam_grid_id, cam_grid_get_gcid, & - cam_grid_dimensions, cam_grid_get_dim_names, & - cam_grid_get_latvals, cam_grid_get_lonvals, & - max_hcoordname_len +use cam_grid_support, only: cam_grid_id, & + cam_grid_get_latvals, cam_grid_get_lonvals use cam_map_utils, only: iMap use inic_analytic, only: analytic_ic_active, dyn_set_inic_col use dyn_tests_utils, only: vcoord=>vc_height -use cam_history, only: addfld, add_default, horiz_only, register_vector_field, & - outfld, hist_fld_active -use cam_history_support, only: max_fieldname_len +use cam_history, only: addfld, horiz_only use string_utils, only: date2yyyymmdd, sec2hms, int2str use ncdio_atm, only: infld -use pio, only: file_desc_t, pio_seterrorhandling, PIO_BCAST_ERROR, & - pio_inq_dimid, pio_inq_dimlen, PIO_NOERR +use pio, only: file_desc_t use cam_pio_utils, only: clean_iodesc_list use time_manager, only: get_start_date, get_stop_date, get_run_duration, & @@ -39,6 +34,11 @@ module dyn_comp use cam_abortutils, only: endrun use mpas_timekeeping, only : MPAS_TimeInterval_type +use cam_mpas_subdriver, only: cam_mpas_global_sum_real +use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_register + + +use phys_control, only: use_gw_front, use_gw_front_igw implicit none private @@ -51,8 +51,7 @@ module dyn_comp dyn_register, & dyn_init, & dyn_run, & - dyn_final, & - swap_time_level_ptrs + dyn_final ! Note that the fields in the import and export states are pointers into the MPAS dycore internal ! data structures. These fields have the order of the vertical and horizontal dimensions swapped @@ -112,6 +111,11 @@ module dyn_comp ! interface [dimensionless] (nver) real(r8), dimension(:), pointer :: fzp ! Interp weight from k-1 layer midpoint to k ! layer interface [dimensionless] (nver) + ! + ! Invariant -- cell area + ! + real(r8), dimension(:), pointer :: areaCell ! cell area (m^2) + ! ! Invariant -- needed to compute edge-normal velocities @@ -190,7 +194,23 @@ module dyn_comp real(r8), dimension(:), pointer :: fzm ! Interp weight from k layer midpoint to k layer ! interface [dimensionless] (nver) real(r8), dimension(:), pointer :: fzp ! Interp weight from k-1 layer midpoint to k - ! layer interface [dimensionless] (nver) + ! + ! Invariant -- needed for computing the frontogenesis function + ! + real(r8), dimension(:,:), pointer :: defc_a + real(r8), dimension(:,:), pointer :: defc_b + real(r8), dimension(:,:), pointer :: cell_gradient_coef_x + real(r8), dimension(:,:), pointer :: cell_gradient_coef_y + real(r8), dimension(:,:), pointer :: edgesOnCell_sign + real(r8), dimension(:), pointer :: dvEdge + real(r8), dimension(:), pointer :: areaCell ! cell area (m^2) + + integer, dimension(:,:), pointer :: edgesOnCell + integer, dimension(:,:), pointer :: cellsOnEdge + integer, dimension(:), pointer :: nEdgesOnCell + + real(r8), dimension(:,:), pointer :: utangential ! velocity tangent to cell edge, + ! diagnosed by mpas ! ! State that may be directly derived from dycore prognostic state @@ -210,6 +230,10 @@ module dyn_comp ! (nver,ncol) end type dyn_export_t +! Frontogenesis indices +integer, public :: frontgf_idx = -1 +integer, public :: frontga_idx = -1 + real(r8), parameter :: rad2deg = 180.0_r8 / pi real(r8), parameter :: deg2rad = pi / 180.0_r8 @@ -219,7 +243,6 @@ module dyn_comp integer, allocatable :: glob_ind(:) type (MPAS_TimeInterval_type) :: integrationLength ! set to CAM's dynamics/physics coupling interval -logical :: swap_time_level_ptrs !========================================================================================= contains @@ -242,11 +265,9 @@ subroutine dyn_readnl(NLFileName) character(len=*), intent(in) :: NLFileName ! Local variables - integer :: ierr integer, dimension(2) :: logUnits ! stdout and stderr for MPAS logging integer :: yr, mon, day, tod, ndate, nday, nsec - character(len=10) :: date_str - character(len=8) :: tod_str + character(len=*), parameter :: subname = 'dyn_comp:dyn_readnl' !---------------------------------------------------------------------------- logUnits(1) = iulog @@ -274,6 +295,7 @@ subroutine dyn_readnl(NLFileName) call mpas_pool_add_config(domain_ptr % configs, 'config_restart_timestamp_name', 'restart_timestamp') call mpas_pool_add_config(domain_ptr % configs, 'config_IAU_option', 'off') call mpas_pool_add_config(domain_ptr % configs, 'config_do_DAcycling', .false.) + call mpas_pool_add_config(domain_ptr % configs, 'config_halo_exch_method', 'mpas_halo') call cam_mpas_init_phase2(pio_subsystem, endrun, timemgr_get_calendar_cf()) @@ -288,15 +310,27 @@ subroutine dyn_register() use physics_buffer, only: pbuf_add_field, dtype_r8 use ppgrid, only: pcols, pver + use phys_control, only: use_gw_front, use_gw_front_igw !---------------------------------------------------------------------------- + ! These fields are computed by the dycore and passed to the physics via the + ! physics buffer. + + if (use_gw_front .or. use_gw_front_igw) then + call pbuf_add_field("FRONTGF", "global", dtype_r8, (/pcols,pver/), frontgf_idx) + call pbuf_add_field("FRONTGA", "global", dtype_r8, (/pcols,pver/), frontga_idx) + end if end subroutine dyn_register !========================================================================================= subroutine dyn_init(dyn_in, dyn_out) - + use air_composition, only : thermodynamic_active_species_idx, thermodynamic_active_species_idx_dycore + use air_composition, only : thermodynamic_active_species_num + use air_composition, only : thermodynamic_active_species_liq_idx,thermodynamic_active_species_ice_idx + use air_composition, only : thermodynamic_active_species_liq_idx_dycore,thermodynamic_active_species_ice_idx_dycore + use air_composition, only : thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num use cam_mpas_subdriver, only : domain_ptr, cam_mpas_init_phase4 use cam_mpas_subdriver, only : cam_mpas_define_scalars use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_array, mpas_pool_get_dimension, & @@ -304,6 +338,8 @@ subroutine dyn_init(dyn_in, dyn_out) use mpas_timekeeping, only : MPAS_set_timeInterval use mpas_derived_types, only : mpas_pool_type use mpas_constants, only : mpas_constants_compute_derived + use dyn_tests_utils, only : vc_dycore, vc_height, string_vc, vc_str_lgth + use cam_budget, only : thermo_budget_history ! arguments: type(dyn_import_t), intent(inout) :: dyn_in @@ -334,6 +370,29 @@ subroutine dyn_init(dyn_in, dyn_out) character(len=128) :: errmsg character(len=*), parameter :: subname = 'dyn_comp::dyn_init' + + ! variables for initializing energy and axial angular momentum diagnostics + integer, parameter :: num_stages = 6 + character (len = 8), dimension(num_stages) :: stage = (/"dBF ","dAP ","dAM ","BD_dparm","BD_DMEA ","BD_phys "/) + character (len = 55),dimension(num_stages) :: stage_txt = (/& + " dynamics state before physics (d_p_coupling) ",& + " dynamics state with T,u,V increment but not q ",& + " dynamics state with full physics increment (incl.q)",& + "dE/dt params+efix in dycore (dparam)(dAP-dBF) ",& + "dE/dt dry mass adjustment in dycore (dAM-dAP)",& + "dE/dt physics total in dycore (phys) (dAM-dBF)" & + /) + + integer :: istage, ivars, m + character (len=108) :: str1, str2, str3 + character (len=vc_str_lgth) :: vc_str + !------------------------------------------------------- + + vc_dycore = vc_height + if (masterproc) then + call string_vc(vc_dycore,vc_str) + write(iulog,*)'vertical coordinate dycore : ',trim(vc_str) + end if !---------------------------------------------------------------------------- if (initial_run) then @@ -372,6 +431,9 @@ subroutine dyn_init(dyn_in, dyn_out) call mpas_pool_get_dimension(mesh_pool, 'nVerticesSolve', nVerticesSolve) dyn_in % nVerticesSolve = nVerticesSolve + ! In MPAS timeLevel=1 is the current state. So the fields input to the dycore should + ! be in timeLevel=1. + call mpas_pool_get_array(state_pool, 'u', dyn_in % uperp, timeLevel=1) call mpas_pool_get_array(state_pool, 'w', dyn_in % w, timeLevel=1) call mpas_pool_get_array(state_pool, 'theta_m', dyn_in % theta_m, timeLevel=1) @@ -388,6 +450,7 @@ subroutine dyn_init(dyn_in, dyn_out) call mpas_pool_get_array(mesh_pool, 'zz', dyn_in % zz) call mpas_pool_get_array(mesh_pool, 'fzm', dyn_in % fzm) call mpas_pool_get_array(mesh_pool, 'fzp', dyn_in % fzp) + call mpas_pool_get_array(mesh_pool, 'areaCell', dyn_in % areaCell) call mpas_pool_get_array(mesh_pool, 'east', dyn_in % east) call mpas_pool_get_array(mesh_pool, 'north', dyn_in % north) @@ -400,10 +463,6 @@ subroutine dyn_init(dyn_in, dyn_out) call mpas_pool_get_array(diag_pool, 'uReconstructZonal', dyn_in % ux) call mpas_pool_get_array(diag_pool, 'uReconstructMeridional', dyn_in % uy) - call mpas_pool_get_array(tend_physics_pool, 'tend_ru_physics', dyn_in % ru_tend) - call mpas_pool_get_array(tend_physics_pool, 'tend_rtheta_physics', dyn_in % rtheta_tend) - call mpas_pool_get_array(tend_physics_pool, 'tend_rho_physics', dyn_in % rho_tend) - ! Let dynamics export state point to memory managed by MPAS-Atmosphere ! Exception: pmiddry and pintdry are not managed by the MPAS infrastructure @@ -414,15 +473,19 @@ subroutine dyn_init(dyn_in, dyn_out) dyn_out % nCellsSolve = dyn_in % nCellsSolve dyn_out % nEdgesSolve = dyn_in % nEdgesSolve dyn_out % nVerticesSolve = dyn_in % nVerticesSolve + dyn_out % index_qv = dyn_in % index_qv - call mpas_pool_get_array(state_pool, 'u', dyn_out % uperp, timeLevel=2) - call mpas_pool_get_array(state_pool, 'w', dyn_out % w, timeLevel=2) - call mpas_pool_get_array(state_pool, 'theta_m', dyn_out % theta_m, timeLevel=2) - call mpas_pool_get_array(state_pool, 'rho_zz', dyn_out % rho_zz, timeLevel=2) - call mpas_pool_get_array(state_pool, 'scalars', dyn_out % tracers, timeLevel=2) - - dyn_out % index_qv = dyn_in % index_qv + ! MPAS swaps pointers internally so that after a dycore timestep, the updated state is + ! in timeLevel=1. Thus we want dyn_out to also point to timeLevel=1. Can just copy + ! the pointers from dyn_in. + dyn_out % uperp => dyn_in % uperp + dyn_out % w => dyn_in % w + dyn_out % theta_m => dyn_in % theta_m + dyn_out % rho_zz => dyn_in % rho_zz + dyn_out % tracers => dyn_in % tracers + + ! These components don't have a time level index. dyn_out % zint => dyn_in % zint dyn_out % zz => dyn_in % zz dyn_out % fzm => dyn_in % fzm @@ -434,14 +497,37 @@ subroutine dyn_init(dyn_in, dyn_out) dyn_out % ux => dyn_in % ux dyn_out % uy => dyn_in % uy - allocate(dyn_out % pmiddry(nVertLevels, nCells)) - allocate(dyn_out % pintdry(nVertLevels+1, nCells)) + ! for frontogenesis calc + + if (use_gw_front .or. use_gw_front_igw) then + dyn_out % areaCell => dyn_in % areaCell + dyn_out % cellsOnEdge => dyn_in % cellsOnEdge + call mpas_pool_get_array(mesh_pool, 'defc_a', dyn_out % defc_a) + call mpas_pool_get_array(mesh_pool, 'defc_b', dyn_out % defc_b) + call mpas_pool_get_array(mesh_pool, 'cell_gradient_coef_x', dyn_out % cell_gradient_coef_x) + call mpas_pool_get_array(mesh_pool, 'cell_gradient_coef_y', dyn_out % cell_gradient_coef_y) + call mpas_pool_get_array(mesh_pool, 'edgesOnCell_sign', dyn_out % edgesOnCell_sign) + call mpas_pool_get_array(mesh_pool, 'dvEdge', dyn_out % dvEdge) + call mpas_pool_get_array(mesh_pool, 'edgesOnCell', dyn_out % edgesOnCell) + call mpas_pool_get_array(mesh_pool, 'nEdgesOnCell', dyn_out % nEdgesOnCell) + call mpas_pool_get_array(diag_pool, 'v', dyn_out % utangential) + endif + + ! cam-required hydrostatic pressures + + allocate(dyn_out % pmiddry(nVertLevels, nCells), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%pmiddry array') + + allocate(dyn_out % pintdry(nVertLevels+1, nCells), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%pintdry array') call mpas_pool_get_array(diag_pool, 'vorticity', dyn_out % vorticity) call mpas_pool_get_array(diag_pool, 'divergence', dyn_out % divergence) call mpas_pool_get_array(mesh_pool, 'indexToCellID', indexToCellID) - allocate(glob_ind(nCellsSolve)) + allocate(glob_ind(nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate glob_ind array') + glob_ind = indexToCellID(1:nCellsSolve) call mpas_constants_compute_derived() @@ -453,17 +539,15 @@ subroutine dyn_init(dyn_in, dyn_out) end if - ! Initialize dyn_out from dyn_in since it is needed to run the physics package - ! as part of the CAM initialization before a dycore step is taken. This is only - ! needed for the fields that have 2 time levels in the MPAS state_pool. - dyn_out % uperp(:,:nEdgesSolve) = dyn_in % uperp(:,:nEdgesSolve) - dyn_out % w(:,:nCellsSolve) = dyn_in % w(:,:nCellsSolve) - dyn_out % theta_m(:,:nCellsSolve) = dyn_in % theta_m(:,:nCellsSolve) - dyn_out % rho_zz(:,:nCellsSolve) = dyn_in % rho_zz(:,:nCellsSolve) - dyn_out % tracers(:,:,:nCellsSolve) = dyn_in % tracers(:,:,:nCellsSolve) - call cam_mpas_init_phase4(endrun) + ! + ! Set pointers to tendency fields that are not allocated until the call to cam_mpas_init_phase4 + ! + call mpas_pool_get_array(tend_physics_pool, 'tend_ru_physics', dyn_in % ru_tend) + call mpas_pool_get_array(tend_physics_pool, 'tend_rtheta_physics', dyn_in % rtheta_tend) + call mpas_pool_get_array(tend_physics_pool, 'tend_rho_physics', dyn_in % rho_tend) + ! Check that CAM's timestep, i.e., the dynamics/physics coupling interval, is an integer multiple ! of the MPAS timestep. @@ -487,43 +571,105 @@ subroutine dyn_init(dyn_in, dyn_out) ! Set the interval over which the dycore should integrate during each call to dyn_run. call MPAS_set_timeInterval(integrationLength, S=nint(dtime), S_n=0, S_d=1) - ! MPAS updates the time level index in its state pool each dycore time step (mpas_dt). If - ! the CAM timestep is an odd multiple of mpas_dt, then the pointers in the dyn_in/dyn_out - ! objects need a corresponding update. Set the following logical variable to indicate - ! whether the pointer update is needed. - swap_time_level_ptrs = mod( nint(dt_ratio), 2) == 1 + ! + ! initialize history for MPAS energy budgets + + if (thermo_budget_history) then -end subroutine dyn_init + ! Define energy/mass snapshots using stage structure + do istage = 1, num_stages + call cam_budget_em_snapshot(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage)))) + end do + ! + ! initialize MPAS energy budgets + ! add budgets that are derived from stages + ! + call cam_budget_em_register('dEdt_param_efix_in_dyn','dAP','dBF',pkgtype='dyn',optype='dif', & + longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)") + call cam_budget_em_register('dEdt_dme_adjust_in_dyn','dAM','dAP',pkgtype='dyn',optype='dif', & + longname="dE/dt dry mass adjustment in dycore (dAM-dAP)") + call cam_budget_em_register('dEdt_phys_total_in_dyn','dAM','dBF',pkgtype='dyn',optype='dif', & + longname="dE/dt physics total in dycore (phys) (dAM-dBF)") + end if + + ! + ! initialize CAM thermodynamic infrastructure + ! + do m=1,thermodynamic_active_species_num + thermodynamic_active_species_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_idx(m)) + if (masterproc) then + write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_dycore: ", & + m,thermodynamic_active_species_idx_dycore(m) + end if + end do + do m=1,thermodynamic_active_species_liq_num + thermodynamic_active_species_liq_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_liq_idx(m)) + if (masterproc) then + write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_liq_dycore: ", & + m,thermodynamic_active_species_liq_idx_dycore(m) + end if + end do + do m=1,thermodynamic_active_species_ice_num + thermodynamic_active_species_ice_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_ice_idx(m)) + if (masterproc) then + write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_ice_dycore: ", & + m,thermodynamic_active_species_ice_idx_dycore(m) + end if + end do + + end subroutine dyn_init !========================================================================================= subroutine dyn_run(dyn_in, dyn_out) use cam_mpas_subdriver, only : cam_mpas_run + use cam_mpas_subdriver, only : domain_ptr + use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_array + use mpas_derived_types, only : mpas_pool_type ! Advances the dynamics state provided in dyn_in by one physics ! timestep to produce dynamics state held in dyn_out. type (dyn_import_t), intent(inout) :: dyn_in type (dyn_export_t), intent(inout) :: dyn_out + + ! Local variables + type(mpas_pool_type), pointer :: state_pool + character(len=*), parameter :: subname = 'dyn_comp:dyn_run' + real(r8) :: dtime + !---------------------------------------------------------------------------- ! Call the MPAS-A dycore call cam_mpas_run(integrationLength) + ! Update the dyn_in/dyn_out pointers to the current state of the prognostic fields. + call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'state', state_pool) + call mpas_pool_get_array(state_pool, 'u', dyn_in % uperp, timeLevel=1) + call mpas_pool_get_array(state_pool, 'w', dyn_in % w, timeLevel=1) + call mpas_pool_get_array(state_pool, 'theta_m', dyn_in % theta_m, timeLevel=1) + call mpas_pool_get_array(state_pool, 'rho_zz', dyn_in % rho_zz, timeLevel=1) + call mpas_pool_get_array(state_pool, 'scalars', dyn_in % tracers, timeLevel=1) + dyn_out % uperp => dyn_in % uperp + dyn_out % w => dyn_in % w + dyn_out % theta_m => dyn_in % theta_m + dyn_out % rho_zz => dyn_in % rho_zz + dyn_out % tracers => dyn_in % tracers + end subroutine dyn_run -!========================================================================================= subroutine dyn_final(dyn_in, dyn_out) - use cam_mpas_subdriver, only : cam_mpas_finalize + use cam_mpas_subdriver, only : cam_mpas_finalize ! Deallocates the dynamics import and export states, and finalizes ! the MPAS dycore. type (dyn_import_t), intent(inout) :: dyn_in type (dyn_export_t), intent(inout) :: dyn_out + character(len=*), parameter :: subname = 'dyn_comp:dyn_final' !---------------------------------------------------------------------------- ! @@ -606,11 +752,16 @@ subroutine read_inidat(dyn_in) ! Set initial conditions. Either from analytic expressions or read from file. use cam_mpas_subdriver, only : domain_ptr, cam_mpas_update_halo, cam_mpas_cell_to_edge_winds + use cam_initfiles, only : scale_dry_air_mass use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_array use mpas_derived_types, only : mpas_pool_type use mpas_vector_reconstruction, only : mpas_reconstruct use mpas_constants, only : Rv_over_Rd => rvord - + use mpas_constants, only : rgas + use mpas_constants, only : p0 + use mpas_constants, only : gravity + use string_utils, only : int2str + use shr_kind_mod, only : shr_kind_cx ! arguments type(dyn_import_t), target, intent(inout) :: dyn_in @@ -658,9 +809,17 @@ subroutine read_inidat(dyn_in) real(r8), allocatable :: pmid(:,:) ! midpoint pressures real(r8), allocatable :: mpas3d(:,:,:) - real(r8) :: dz, h + real(r8), allocatable :: qv(:), tm(:) + logical :: readvar + integer :: rndm_seed_sz + integer, allocatable :: rndm_seed(:) + real(r8) :: pertval + integer :: nc + + character(len=shr_kind_cx) :: str + type(mpas_pool_type), pointer :: mesh_pool type(mpas_pool_type), pointer :: diag_pool @@ -668,9 +827,9 @@ subroutine read_inidat(dyn_in) real(r8), pointer :: uReconstructY(:,:) real(r8), pointer :: uReconstructZ(:,:) - integer :: mpas_idx, cam_idx - character(len=16) :: trac_name - + integer :: mpas_idx, cam_idx, ierr + character(len=32) :: trac_name + character(len=*), parameter :: subname = 'dyn_comp:read_inidat' !-------------------------------------------------------------------------------------- @@ -682,7 +841,7 @@ subroutine read_inidat(dyn_in) ixqv = dyn_in % index_qv mpas_from_cam_cnst => dyn_in % mpas_from_cam_cnst - + uperp => dyn_in % uperp w => dyn_in % w theta_m => dyn_in % theta_m @@ -707,8 +866,11 @@ subroutine read_inidat(dyn_in) ! lat/lon needed in radians latvals_deg => cam_grid_get_latvals(cam_grid_id('mpas_cell')) lonvals_deg => cam_grid_get_lonvals(cam_grid_id('mpas_cell')) - allocate(latvals(nCellsSolve)) - allocate(lonvals(nCellsSolve)) + allocate(latvals(nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate latvals array') + + allocate(lonvals(nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate lonvals array') latvals(:) = latvals_deg(:)*deg2rad lonvals(:) = lonvals_deg(:)*deg2rad @@ -724,7 +886,8 @@ subroutine read_inidat(dyn_in) t(plev,nCellsSolve), & pintdry(plevp,nCellsSolve), & pmiddry(plev,nCellsSolve), & - pmid(plev,nCellsSolve) ) + pmid(plev,nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate tmp arrays using CAM and MPAS indexing') do k = 1, plevp kk = plevp - k + 1 @@ -732,21 +895,30 @@ subroutine read_inidat(dyn_in) end do ! If using a topo file check that PHIS is consistent with the surface z coordinate. - if (associated(fh_topo)) then + if (associated(fh_topo)) then - allocate(zsurf(nCellsSolve)) + allocate(zsurf(nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate zsurf array') call get_zsurf_from_topo(fh_topo, zsurf) do i = 1, nCellsSolve - if (abs(zi(i,plevp) - zsurf(i)) > 0.001_r8) then - write(iulog,*) subname//': ERROR: zi= ', zi(i,plevp), ' zsurf= ', zsurf(i) - call endrun(subname//': ERROR: PHIS not consistent with surface z coordinate') - end if + if (abs(zi(i,plevp) - zsurf(i)) > 0.001_r8) then + write(str,*) 'zi= ', zi(i,plevp), ' zsurf= ', zsurf(i),' i= ',i + write(iulog,*) subname//': ERROR: '//TRIM(str) + call endrun(subname//': ERROR: PHIS not consistent with surface z coordinate; '//TRIM(str)) + end if end do deallocate(zsurf) - + else + do i = 1, nCellsSolve + if (abs(zi(i,plevp)) > 1.0E-12_r8) then + write(str,*) 'zi= ', zi(i,plevp), ' but PHIS should be zero' + write(iulog,*) subname//': ERROR: '//TRIM(str) + call endrun(subname//': ERROR: PHIS not consistent with surface z coordinate; '//TRIM(str)) + end if + end do end if if (analytic_ic_active()) then @@ -781,7 +953,8 @@ subroutine read_inidat(dyn_in) ! Constituents - allocate(m_ind(pcnst)) + allocate(m_ind(pcnst), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate m_ind array') do m = 1, pcnst m_ind(m) = m end do @@ -812,26 +985,42 @@ subroutine read_inidat(dyn_in) do i = 1, nCellsSolve pintdry(1,i) = cam2d(i) end do - - ! Use Hypsometric eqn to set pressure profiles - do i = 1, nCellsSolve - do k = 2, plevp - dz = zint(k,i) - zint(k-1,i) - h = rair * t(k-1,i) / gravit - pintdry(k,i) = pintdry(k-1,i)*exp(-dz/h) - pmiddry(k-1,i) = 0.5_r8*(pintdry(k-1,i) + pintdry(k,i)) - ! for now assume dry atm - pmid(k-1,i) = pmiddry(k-1,i) - end do - end do + + allocate(qv(plev), tm(plev), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate qv and tm arrays') do i = 1, nCellsSolve do k = 1, plev - theta(k,i) = t(k,i) * (1.0e5_r8 / pmid(k,i))**(rair/cpair) - rho(k,i) = pmid(k,i) / (rair * t(k,i)) + ! convert specific humidity to mixing ratio relative to dry air + tracers(1,k,i) = tracers(1,k,i)/(1.0_r8 - tracers(1,k,i)) + qv(k) = tracers(1,k,i) + ! convert temperature to tm (we are using dry air density and Rd in state eqn) + tm(k) = t(k,i)*(1.0_r8+(Rv_over_Rd)*qv(k)) + end do + + ! integrate up from surface to first mid level. This is full mid-level pressure (i.e. accounts for vapor). + ! we are assuming that pintdry(1,i) is the full surface pressure here. + pmid(1,i) = pintdry(1,i)/(1.0_r8+0.5_r8*(zint(2,i)-zint(1,i))*(1.0_r8+qv(1))*gravity/(rgas*tm(1))) + + ! integrate up the column + do k=2,plev + ! this is full mid-level pressure (i.e. accounts for vapor) + pmid(k,i) = pmid(k-1,i)*(1.0_r8-0.5_r8*(zint(k ,i)-zint(k-1,i))*gravity*(1.0_r8+qv(k-1))/(rgas*tm(k-1)))/ & + (1.0_r8+0.5_r8*(zint(k+1,i)-zint(k ,i))*gravity*(1.0_r8+qv(k ))/(rgas*tm(k ))) end do + + do k=1,plev + ! Note: this is theta and not theta_m + theta(k,i) = tm(k) * ((p0/pmid(k,i))**(rair/cpair))/(1.0_r8+(Rv_over_Rd)*qv(k)) + ! Dry air density + rho(k,i) = pmid(k,i) / (rgas * tm(k)) + end do + end do + deallocate(qv) + deallocate(tm) + rho_zz(:,1:nCellsSolve) = rho(:,1:nCellsSolve) / zz(:,1:nCellsSolve) ! Set theta_base and rho_base @@ -840,7 +1029,9 @@ subroutine read_inidat(dyn_in) else ! read uperp - allocate( mpas3d(plev,nEdgesSolve,1) ) + allocate( mpas3d(plev,nEdgesSolve,1), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate mpas3d array at line:'//int2str(__LINE__)) + call infld('u', fh_ini, 'lev', 'nEdges', 1, plev, 1, nEdgesSolve, 1, 1, & mpas3d, readvar, gridname='mpas_edge') if (readvar) then @@ -874,7 +1065,8 @@ subroutine read_inidat(dyn_in) ux, uy) ! read w - allocate( mpas3d(plevp,nCellsSolve,1) ) + allocate( mpas3d(plevp,nCellsSolve,1), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate mpas3d array at line:'//int2str(__LINE__)) call infld('w', fh_ini, 'ilev', 'nCells', 1, plevp, 1, nCellsSolve, 1, 1, & mpas3d, readvar, gridname='mpas_cell') if (readvar) then @@ -884,7 +1076,8 @@ subroutine read_inidat(dyn_in) end if deallocate( mpas3d ) - allocate( mpas3d(plev,nCellsSolve,1) ) + allocate( mpas3d(plev,nCellsSolve,1), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate mpas3d array at line:'//int2str(__LINE__)) ! read theta call infld('theta', fh_ini, 'lev', 'nCells', 1, plev, 1, nCellsSolve, 1, 1, & @@ -895,6 +1088,29 @@ subroutine read_inidat(dyn_in) call endrun(subname//': failed to read theta from initial file') end if + ! optionally introduce random perturbations to theta values + if (pertlim.ne.0.0_r8) then + if (masterproc) then + write(iulog,*) trim(subname), ': Adding random perturbation bounded', & + 'by +/- ', pertlim, ' to initial theta field' + end if + + call random_seed(size=rndm_seed_sz) + allocate(rndm_seed(rndm_seed_sz)) + + do nc = 1,nCellsSolve + rndm_seed = glob_ind(nc) + call random_seed(put=rndm_seed) + do kk = 1,plev + call random_number(pertval) + pertval = 2.0_r8*pertlim*(0.5_r8 - pertval) + theta(kk,nc) = theta(kk,nc)*(1.0_r8 + pertval) + end do + end do + + deallocate(rndm_seed) + end if + ! read rho call infld('rho', fh_ini, 'lev', 'nCells', 1, plev, 1, nCellsSolve, 1, 1, & mpas3d, readvar, gridname='mpas_cell') @@ -934,7 +1150,8 @@ subroutine read_inidat(dyn_in) ! file to overwrite mixing ratios set by the default constituent initialization ! except for the water species. - allocate( mpas3d(plev,nCellsSolve,1) ) + allocate( mpas3d(plev,nCellsSolve,1), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate mpas3d array at line:'//int2str(__LINE__)) do mpas_idx = 1, pcnst @@ -950,7 +1167,7 @@ subroutine read_inidat(dyn_in) trac_name = cnst_name(cam_idx) if (mpas_idx == 1) trac_name = 'qv' - + readvar = .false. if (cnst_read_iv(cam_idx)) then @@ -978,6 +1195,12 @@ subroutine read_inidat(dyn_in) theta_m(:,1:nCellsSolve) = theta(:,1:nCellsSolve) * (1.0_r8 + Rv_over_Rd * tracers(ixqv,:,1:nCellsSolve)) + ! If scale_dry_air_mass > 0.0 then scale dry air mass to scale_dry_air_mass global average dry pressure + if (scale_dry_air_mass > 0.0_r8) then + call set_dry_mass(dyn_in, scale_dry_air_mass) + end if + + ! Update halos for initial state fields ! halo for 'u' updated in both branches of conditional above call cam_mpas_update_halo('w', endrun) @@ -1001,19 +1224,20 @@ subroutine get_zsurf_from_topo(fh_topo, zsurf) ! Arguments type(file_desc_t), pointer :: fh_topo - + real(r8), intent(out) :: zsurf(:) ! Local variables integer :: zsurf_len real(r8), allocatable :: phis(:,:) logical :: readvar - + integer :: ierr character(len=*), parameter :: subname = 'dyn_comp:get_zsurf_from_topo' !-------------------------------------------------------------------------------------- zsurf_len = size(zsurf) - allocate(phis(zsurf_len,1)) + allocate(phis(zsurf_len,1), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate phis array') ! read theta call infld('PHIS', fh_topo, 'ncol', 1, zsurf_len, 1, 1, & @@ -1047,6 +1271,9 @@ subroutine set_base_state(dyn_in) real(r8), dimension(:,:), pointer :: theta_base real(r8) :: zmid real(r8) :: pres + real(r8) :: pres_kp1 + logical, parameter :: discrete_hydrostatic_base = .true. + character(len=*), parameter :: subname = 'dyn_comp:get_zsurf_from_topo' !-------------------------------------------------------------------------------------- zint => dyn_in % zint @@ -1054,14 +1281,44 @@ subroutine set_base_state(dyn_in) rho_base => dyn_in % rho_base theta_base => dyn_in % theta_base - do iCell = 1, dyn_in % nCellsSolve - do klev = 1, dyn_in % nVertLevels - zmid = 0.5_r8 * (zint(klev,iCell) + zint(klev+1,iCell)) ! Layer midpoint geometric height - pres = p0 * exp(-gravity * zmid / (Rgas * t0b)) + ! reference state with discrete MPAS hydrostatic balance + + if (discrete_hydrostatic_base) then + + do iCell = 1, dyn_in % nCellsSolve + + klev = dyn_in % nVertLevels + ! reference pressure at the model top + pres_kp1 = p0*exp(-gravity*zint(klev+1,iCell)/(Rgas*t0b)) + + ! integrate down to first mid level, set referfence state + pres = pres_kp1/(1.0_r8-0.5_r8*(zint(klev+1,iCell) - zint(klev,iCell))*gravity/(Rgas*t0b)) theta_base(klev,iCell) = t0b / (pres / p0)**(Rgas/cp) rho_base(klev,iCell) = pres / ( Rgas * t0b * zz(klev,iCell)) + pres_kp1 = pres + + ! integrate down the column + do klev = dyn_in % nVertLevels-1, 1, -1 + pres = pres_kp1*(1.0_r8+0.5_r8*(zint(klev+2,iCell)-zint(klev+1,iCell))*gravity/(rgas*t0b))/ & + (1.0_r8-0.5_r8*(zint(klev+1,iCell)-zint(klev ,iCell))*gravity/(rgas*t0b)) + theta_base(klev,iCell) = t0b / (pres / p0)**(Rgas/cp) + rho_base(klev,iCell) = pres / ( Rgas * t0b * zz(klev,iCell)) + pres_kp1 = pres + end do end do - end do + + else + + do iCell = 1, dyn_in % nCellsSolve + do klev = 1, dyn_in % nVertLevels + zmid = 0.5_r8 * (zint(klev,iCell) + zint(klev+1,iCell)) ! Layer midpoint geometric height + pres = p0 * exp(-gravity * zmid / (Rgas * t0b)) + theta_base(klev,iCell) = t0b / (pres / p0)**(Rgas/cp) + rho_base(klev,iCell) = pres / ( Rgas * t0b * zz(klev,iCell)) + end do + end do + + end if end subroutine set_base_state @@ -1075,7 +1332,7 @@ subroutine cam_mpas_namelist_read(namelistFilename, configPool) ! if no errors were encountered, all MPI ranks have valid namelists in their configPool. use spmd_utils, only: mpicom, masterproc, masterprocid, & - mpi_integer, mpi_real8, mpi_logical, mpi_character, mpi_success + mpi_integer, mpi_real8, mpi_logical, mpi_character use namelist_utils, only: find_group_name use mpas_derived_types, only: mpas_pool_type @@ -1127,6 +1384,13 @@ subroutine cam_mpas_namelist_read(namelistFilename, configPool) logical :: mpas_h_ScaleWithMesh = .true. real(r8) :: mpas_zd = 22000.0_r8 real(r8) :: mpas_xnutr = 0.2_r8 + real(r8) :: mpas_cam_coef = 0.0_r8 + integer :: mpas_cam_damping_levels = 0 + logical :: mpas_rayleigh_damp_u = .true. + real(r8) :: mpas_rayleigh_damp_u_timescale_days = 5.0_r8 + integer :: mpas_number_rayleigh_damp_u_levels = 3 + logical :: mpas_apply_lbcs = .false. + logical :: mpas_jedi_da = .false. character (len=StrKIND) :: mpas_block_decomp_file_prefix = 'x1.40962.graph.info.part.' logical :: mpas_do_restart = .false. logical :: mpas_print_global_minmax_vel = .true. @@ -1170,7 +1434,18 @@ subroutine cam_mpas_namelist_read(namelistFilename, configPool) namelist /damping/ & mpas_zd, & - mpas_xnutr + mpas_xnutr, & + mpas_cam_coef, & + mpas_cam_damping_levels, & + mpas_rayleigh_damp_u, & + mpas_rayleigh_damp_u_timescale_days, & + mpas_number_rayleigh_damp_u_levels + + namelist /limited_area/ & + mpas_apply_lbcs + + namelist /assimilation/ & + mpas_jedi_da namelist /decomposition/ & mpas_block_decomp_file_prefix @@ -1294,14 +1569,60 @@ subroutine cam_mpas_namelist_read(namelistFilename, configPool) end if end if - call mpi_bcast(mpas_zd, 1, mpi_real8, masterprocid, mpicom, mpi_ierr) - call mpi_bcast(mpas_xnutr, 1, mpi_real8, masterprocid, mpicom, mpi_ierr) + call mpi_bcast(mpas_zd, 1, mpi_real8, masterprocid, mpicom, mpi_ierr) + call mpi_bcast(mpas_xnutr, 1, mpi_real8, masterprocid, mpicom, mpi_ierr) + call mpi_bcast(mpas_cam_coef, 1, mpi_real8, masterprocid, mpicom, mpi_ierr) + call mpi_bcast(mpas_cam_damping_levels, 1, mpi_integer, masterprocid, mpicom, mpi_ierr) + call mpi_bcast(mpas_rayleigh_damp_u, 1, mpi_logical, masterprocid, mpicom, mpi_ierr) + call mpi_bcast(mpas_rayleigh_damp_u_timescale_days, 1, mpi_real8, masterprocid, mpicom, mpi_ierr) + call mpi_bcast(mpas_number_rayleigh_damp_u_levels, 1, mpi_integer, masterprocid, mpicom, mpi_ierr) call mpas_pool_add_config(configPool, 'config_zd', mpas_zd) call mpas_pool_add_config(configPool, 'config_xnutr', mpas_xnutr) + call mpas_pool_add_config(configPool, 'config_mpas_cam_coef', mpas_cam_coef) + call mpas_pool_add_config(configPool, 'config_number_cam_damping_levels', mpas_cam_damping_levels) + call mpas_pool_add_config(configPool, 'config_rayleigh_damp_u', mpas_rayleigh_damp_u) + call mpas_pool_add_config(configPool, 'config_rayleigh_damp_u_timescale_days', mpas_rayleigh_damp_u_timescale_days) + call mpas_pool_add_config(configPool, 'config_number_rayleigh_damp_u_levels', mpas_number_rayleigh_damp_u_levels) - ! Read namelist group &decomposition + ! Read namelist group &limited_area if (masterproc) then + rewind(unitNumber) + call find_group_name(unitNumber, 'limited_area', status=ierr) + if (ierr == 0) then + read(unitNumber, limited_area, iostat=ierr2) + if (ierr2 /= 0) then + call endrun(subname // ':: Failed to read namelist group &limited_area') + end if + else + call endrun(subname // ':: Failed to find namelist group &limited_area') + end if + end if + + call mpi_bcast(mpas_apply_lbcs, 1, mpi_logical, masterprocid, mpicom, mpi_ierr) + + call mpas_pool_add_config(configPool, 'config_apply_lbcs', mpas_apply_lbcs) + + ! Read namelist group &assimilation + if (masterproc) then + rewind(unitNumber) + call find_group_name(unitNumber, 'assimilation', status=ierr) + if (ierr == 0) then + read(unitNumber, assimilation, iostat=ierr2) + if (ierr2 /= 0) then + call endrun(subname // ':: Failed to read namelist group &assimilation') + end if + else + call endrun(subname // ':: Failed to find namelist group &assimilation') + end if + end if + + call mpi_bcast(mpas_jedi_da, 1, mpi_logical, masterprocid, mpicom, mpi_ierr) + + call mpas_pool_add_config(configPool, 'config_jedi_da', mpas_jedi_da) + + ! Read namelist group &decomposition if npes > 1 + if (masterproc .and. npes > 1) then rewind(unitNumber) call find_group_name(unitNumber, 'decomposition', status=ierr) if (ierr == 0) then @@ -1310,7 +1631,7 @@ subroutine cam_mpas_namelist_read(namelistFilename, configPool) call endrun(subname // ':: Failed to read namelist group &decomposition') end if else - call endrun(subname // ':: Failed to find namelist group &decomposition') + call endrun(subname // ':: Failed to find namelist group &decomposition. Required for multiprocessor execution.') end if end if @@ -1409,6 +1730,13 @@ subroutine cam_mpas_namelist_read(namelistFilename, configPool) write(iulog,*) ' mpas_h_ScaleWithMesh = ', mpas_h_ScaleWithMesh write(iulog,*) ' mpas_zd = ', mpas_zd write(iulog,*) ' mpas_xnutr = ', mpas_xnutr + write(iulog,*) ' mpas_cam_coef = ', mpas_cam_coef + write(iulog,*) ' mpas_cam_damping_levels = ', mpas_cam_damping_levels + write(iulog,*) ' mpas_rayleigh_damp_u = ', mpas_rayleigh_damp_u + write(iulog,*) ' mpas_rayleigh_damp_u_timescale_days = ', mpas_rayleigh_damp_u_timescale_days + write(iulog,*) ' mpas_number_rayleigh_damp_u_levels = ', mpas_number_rayleigh_damp_u_levels + write(iulog,*) ' mpas_apply_lbcs = ', mpas_apply_lbcs + write(iulog,*) ' mpas_jedi_da = ', mpas_jedi_da write(iulog,*) ' mpas_block_decomp_file_prefix = ', trim(mpas_block_decomp_file_prefix) write(iulog,*) ' mpas_do_restart = ', mpas_do_restart write(iulog,*) ' mpas_print_global_minmax_vel = ', mpas_print_global_minmax_vel @@ -1418,4 +1746,132 @@ subroutine cam_mpas_namelist_read(namelistFilename, configPool) end subroutine cam_mpas_namelist_read +!----------------------------------------------------------------------- +! routine set_dry_mass +! +!> \brief Scale dry air mass +!> \author Bill Skamarock, Miles Curry +!> \date 25 April 2021 +!> \details Given a target dry air mass surface pressure, +!> target_avg_dry_surface_pressure, scale the current dry air mass so +!> that the average dry surface pressure equals +!> target_avg_dry_surface_pressure. Water vapor is scaled for mass- +!> conservation; all other tracer mixing ratios are unaltered +!> (i.e. tracer mass is not conserved but gradients are during the +!> dry mass scaling process) +! +!----------------------------------------------------------------------- +subroutine set_dry_mass(dyn_in, target_avg_dry_surface_pressure) + + use mpas_constants, only : rgas, gravity, p0, Rv_over_Rd => rvord + + type(dyn_import_t), intent(in) :: dyn_in + real(r8), intent(in) :: target_avg_dry_surface_pressure + + integer :: i, k + integer :: nCellsSolve + + real(r8), pointer :: theta_m(:,:) ! Moist potential temperature [K] (nver,ncol) + real(r8), pointer :: zint(:,:) ! Geometric height [m] + real(r8), pointer :: areaCell(:) ! cell area (m^2) + real(r8), pointer :: theta(:,:) ! Potential temperature [K] (nver,ncol) + real(r8), pointer :: rho(:,:) ! Dry density [kg/m^3] (nver,ncol) + real(r8), pointer :: rho_zz(:,:) ! Dry density [kg/m^3] + ! divided by d(zeta)/dz (nver,ncol) + real(r8), pointer :: tracers(:,:,:) ! Tracers [kg/kg dry air] (nq,nver,ncol) + real(r8), pointer :: zz(:,:) ! Vertical coordinate metric [dimensionless] + ! at layer midpoints (nver,ncol) + + real(r8), allocatable :: preliminary_dry_surface_pressure(:), p_top(:), pm(:) + real(r8) :: preliminary_avg_dry_surface_pressure, scaled_avg_dry_surface_pressure + real(r8) :: scaling_ratio + real(r8) :: sphere_surface_area + + integer :: ixqv,ierr + + character(len=*), parameter :: subname = 'dyn_comp:set_dry_mass' + + nCellsSolve = dyn_in % nCellsSolve + ixqv = dyn_in % index_qv + theta_m => dyn_in % theta_m + theta => dyn_in % theta + zint => dyn_in % zint + areaCell => dyn_in % areaCell + rho => dyn_in % rho + rho_zz => dyn_in % rho_zz + zz => dyn_in % zz + tracers => dyn_in % tracers + + allocate( p_top(nCellsSolve), preliminary_dry_surface_pressure(nCellsSolve), pm(plev), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate arrays preliminary_dry_surface_pressure and pm') + ! (1) calculate pressure at the lid + do i=1, nCellsSolve + p_top(i) = p0*(rgas*rho(plev,i)*theta_m(plev,i)/p0)**(cpair/(cpair-rgas)) + p_top(i) = p_top(i) - gravity*0.5_r8*(zint(plev+1,i)-zint(plev,i))*rho(plev,i)*(1.0_r8+tracers(ixqv,plev,i)) + end do + + ! (2) integrate dry mass in column + do i=1, nCellsSolve + preliminary_dry_surface_pressure(i) = 0.0_r8 + do k=1, plev + preliminary_dry_surface_pressure(i) = preliminary_dry_surface_pressure(i) + gravity*(zint(k+1,i)-zint(k,i))*rho(k,i) + end do + end do + + ! (3) compute average global dry surface pressure + preliminary_dry_surface_pressure(1:nCellsSolve) = preliminary_dry_surface_pressure(1:nCellsSolve)*areaCell(1:nCellsSolve) + sphere_surface_area = cam_mpas_global_sum_real(areaCell(1:nCellsSolve)) + preliminary_avg_dry_surface_pressure = cam_mpas_global_sum_real(preliminary_dry_surface_pressure(1:nCellsSolve)) & + /sphere_surface_area + + if (masterproc) then + write(iulog,*) '---------------------------- set_dry_mass ----------------------------' + write(iulog,*) 'Initial dry globally average surface pressure = ', preliminary_avg_dry_surface_pressure/100._r8, 'hPa' + write(iulog,*) 'target dry globally avg surface pressure = ', target_avg_dry_surface_pressure/100._r8, 'hPa' + end if + + ! (4) scale dry air density + scaling_ratio = target_avg_dry_surface_pressure / preliminary_avg_dry_surface_pressure + rho(:,:) = rho(:,:)*scaling_ratio + + ! (4a) recompute dry mass after scaling + do i = 1, nCellsSolve + preliminary_dry_surface_pressure(i) = 0.0_r8 + do k = 1, plev + preliminary_dry_surface_pressure(i) = preliminary_dry_surface_pressure(i) + gravity*(zint(k+1,i)-zint(k,i))*rho(k,i) + end do + end do + preliminary_dry_surface_pressure(1:nCellsSolve) = preliminary_dry_surface_pressure(1:nCellsSolve)*areaCell(1:nCellsSolve) + scaled_avg_dry_surface_pressure = cam_mpas_global_sum_real(preliminary_dry_surface_pressure(1:nCellsSolve)) & + / sphere_surface_area + + if (masterproc) then + write(iulog,*) 'Average dry global surface pressure after scaling = ', scaled_avg_dry_surface_pressure/100._r8, 'hPa' + write(iulog,*) 'Change in dry surface pressure = ', scaled_avg_dry_surface_pressure-preliminary_avg_dry_surface_pressure,'Pa' + end if + + ! (5) reset qv to conserve mass + tracers(ixqv,:,1:nCellsSolve) = tracers(ixqv,:,1:nCellsSolve)/scaling_ratio + + ! (6) integrate down the column to compute full pressure given the density and qv + do i=1,nCellsSolve + pm(plev) = p_top(i) + 0.5_r8*(zint(plev+1,i)-zint(plev,i))*gravity*rho(plev,i)*(1.0_r8+tracers(ixqv,plev,i)) + do k=plev-1,1,-1 + pm(k) = pm(k+1) + 0.5_r8*(zint(k+2,i)-zint(k+1,i))*gravity*rho(k+1,i)*(1.0_r8+tracers(ixqv,k+1,i)) & + + 0.5_r8*(zint(k+1,i)-zint(k ,i))*gravity*rho(k ,i)*(1.0_r8+tracers(ixqv,k ,i)) + end do + + ! (7) compute theta_m from the state equation, compute rho_zz and theta while we are here + + do k=1,plev + theta_m(k,i) = (pm(k)/p0)**((cpair-rgas)/cpair)*p0/rgas/rho(k,i) + theta(k,i) = theta_m(k,i)/(1.0_r8 + Rv_over_Rd * tracers(ixqv,k,i)) + rho_zz(k,i) = rho(k,i)/zz(k,i) + end do + end do + + deallocate( p_top, preliminary_dry_surface_pressure, pm ) + +end subroutine set_dry_mass + end module dyn_comp diff --git a/src/dynamics/mpas/dyn_grid.F90 b/src/dynamics/mpas/dyn_grid.F90 index 0976c3fbc4..3195e5ebbc 100644 --- a/src/dynamics/mpas/dyn_grid.F90 +++ b/src/dynamics/mpas/dyn_grid.F90 @@ -19,24 +19,20 @@ module dyn_grid ! !------------------------------------------------------------------------------- -use shr_kind_mod, only: r8 => shr_kind_r8 -use spmd_utils, only: iam, masterproc, mpicom, npes - -use pmgrid, only: plev, plevp -use physconst, only: pi - -use cam_logfile, only: iulog -use cam_abortutils, only: endrun - -use pio, only: file_desc_t, pio_global, pio_get_att - -use cam_mpas_subdriver, only: domain_ptr, cam_mpas_init_phase3, cam_mpas_get_global_dims, & - cam_mpas_get_global_coords, cam_mpas_get_global_blocks, & - cam_mpas_read_static, cam_mpas_compute_unit_vectors - -use mpas_pool_routines, only: mpas_pool_get_subpool, mpas_pool_get_dimension, mpas_pool_get_array -use mpas_derived_types, only: mpas_pool_type +use cam_abortutils, only: endrun +use cam_logfile, only: iulog +use cam_mpas_subdriver, only: domain_ptr, cam_mpas_init_phase3, cam_mpas_get_global_dims, & + cam_mpas_read_static, cam_mpas_compute_unit_vectors +use mpas_derived_types, only: mpas_pool_type +use mpas_pool_routines, only: mpas_pool_get_subpool, mpas_pool_get_dimension, mpas_pool_get_array +use physconst, only: pi +use physics_column_type, only: physics_column_t +use pio, only: file_desc_t, pio_global, pio_get_att +use pmgrid, only: plev, plevp +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: iam, masterproc, mpicom, npes +use string_utils, only: int2str implicit none private @@ -55,14 +51,7 @@ module dyn_grid dyn_decomp, & ptimelevels, & dyn_grid_init, & - get_block_bounds_d, & - get_block_gcol_cnt_d, & - get_block_gcol_d, & - get_block_lvl_cnt_d, & - get_block_levels_d, & - get_block_owner_d, & - get_gcol_block_d, & - get_gcol_block_cnt_d, & + get_dyn_grid_info, & get_horiz_grid_dim_d, & get_horiz_grid_d, & get_dyn_grid_parm, & @@ -72,7 +61,9 @@ module dyn_grid physgrid_copy_attributes_d ! vertical reference heights (m) in CAM top to bottom order. -real(r8) :: zw(plevp), zw_mid(plev) +! These arrays are targets of the real_values pointers in the hist_coords +! objects in the cam_history_support module. +real(r8), target :: zw(plevp), zw_mid(plev) integer :: & maxNCells, & ! maximum number of cells for any task (nCellsSolve <= maxNCells) @@ -103,10 +94,6 @@ module dyn_grid integer, allocatable :: global_blockid(:) ! block id for each global column integer, allocatable :: local_col_index(:) ! local column index (in block) for each global column -real(r8), dimension(:), pointer :: lonCell_g ! global cell longitudes -real(r8), dimension(:), pointer :: latCell_g ! global cell latitudes -real(r8), dimension(:), pointer :: areaCell_g ! global cell areas - !========================================================================================= contains !========================================================================================= @@ -118,6 +105,7 @@ subroutine dyn_grid_init() ! coupling code requires constructing global fields for the cell center ! grid which is used by the physics parameterizations. + use hycoef, only: ps0 use ref_pres, only: ref_pres_init use std_atm_profile, only: std_atm_pres use time_manager, only: get_step_size @@ -143,7 +131,7 @@ subroutine dyn_grid_init() ! MPAS-A always requires at least one scalar (qv). CAM has the same requirement ! and it is enforced by the configure script which sets the cpp macrop PCNST. - call cam_mpas_init_phase3(fh_ini, pcnst, endrun) + call cam_mpas_init_phase3(fh_ini, pcnst) ! Read or compute all time-invariant fields for the MPAS-A dycore ! Time-invariant fields are stored in the MPAS mesh pool. This call @@ -154,7 +142,7 @@ subroutine dyn_grid_init() ierr = pio_get_att(fh_ini, pio_global, 'sphere_radius', sphere_radius) ! Compute reference pressures from reference heights. - call std_atm_pres(zw, pref_edge) + call std_atm_pres(zw, pref_edge, user_specified_ps=ps0) pref_mid = (pref_edge(1:plev) + pref_edge(2:plevp)) * 0.5_r8 num_pr_lev = 0 @@ -182,206 +170,106 @@ subroutine dyn_grid_init() ! Query global grid dimensions from MPAS call cam_mpas_get_global_dims(nCells_g, nEdges_g, nVertices_g, maxEdges, nVertLevels, maxNCells) - ! Temporary global arrays needed by phys_grid_init - allocate(lonCell_g(nCells_g)) - allocate(latCell_g(nCells_g)) - allocate(areaCell_g(nCells_g)) - call cam_mpas_get_global_coords(latCell_g, lonCell_g, areaCell_g) - - allocate(num_col_per_block(npes)) - allocate(col_indices_in_block(maxNCells,npes)) - allocate(global_blockid(nCells_g)) - allocate(local_col_index(nCells_g)) - call cam_mpas_get_global_blocks(num_col_per_block, col_indices_in_block, global_blockID, local_col_index) - ! Define the dynamics grids on the dynamics decompostion. The cell ! centered grid is used by the physics parameterizations. The physics ! decomposition of the cell centered grid is defined in phys_grid_init. call define_cam_grids() - -end subroutine dyn_grid_init - -!========================================================================================= - -subroutine get_block_bounds_d(block_first, block_last) - - ! Return first and last indices used in global block ordering. - ! The indexing is 1-based. - - integer, intent(out) :: block_first ! first global index used for blocks - integer, intent(out) :: block_last ! last global index used for blocks - !---------------------------------------------------------------------------- - - ! MPAS assigns 1 block per task. - - block_first = 1 - block_last = npes - -end subroutine get_block_bounds_d - -!========================================================================================= - -integer function get_block_gcol_cnt_d(blockid) - - ! Return the number of dynamics columns in the block with the specified - ! global block ID. The blockid can be for a block owned by any MPI - ! task. - - integer, intent(in) :: blockid - !---------------------------------------------------------------------------- - - get_block_gcol_cnt_d = num_col_per_block(blockid) - -end function get_block_gcol_cnt_d - -!========================================================================================= - -subroutine get_block_gcol_d(blockid, asize, cdex) - - ! Return list of global dynamics column indices in the block with the - ! specified global block ID. The blockid can be for a block owned by - ! any MPI task. - - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: asize ! array size - - integer, intent(out):: cdex(asize) ! global column indices - - integer :: icol - - character(len=*), parameter :: subname = 'dyn_grid::get_block_gcol_d' - !---------------------------------------------------------------------------- - if (asize < num_col_per_block(blockid)) then - write(iulog,*) subname//': array size too small: asize, num_col_per_block=', & - asize, num_col_per_block(blockid) - call endrun(subname//': array size too small') - end if - - do icol = 1, num_col_per_block(blockid) - cdex(icol) = col_indices_in_block(icol, blockid) - end do - do icol = num_col_per_block(blockid)+1, asize - cdex(icol) = 0 - end do - -end subroutine get_block_gcol_d - -!========================================================================================= - -integer function get_block_lvl_cnt_d(blockid, bcid) - - ! Returns the number of levels in the specified column of the specified block. - ! If column includes surface fields, then it is defined to also - ! include level 0. - - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: bcid ! column index within block - !---------------------------------------------------------------------------- - - ! All blocks have the same number of levels. - get_block_lvl_cnt_d = plevp - -end function get_block_lvl_cnt_d +end subroutine dyn_grid_init !========================================================================================= -subroutine get_block_levels_d(blockid, bcid, lvlsiz, levels) - - ! Returns the level indices in the column of the specified global block. - ! For MPAS decomposition all columns in a block contain complete vertical grid. - - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: bcid ! column index within block - integer, intent(in) :: lvlsiz ! dimension of levels array - - integer, intent(out) :: levels(lvlsiz) ! level indices for block +subroutine get_dyn_grid_info(hdim1_d, hdim2_d, num_levels, index_model_top_layer, index_surface_layer, unstructured, dyn_columns) + !------------------------------------------------------------ + ! + ! get_dyn_grid_info return dynamics grid column information + ! + ! Return dynamic grid columns information and other dycore information. After + ! this function is called, dyn_columns will be allocated to size nCellsSolve + ! and each entry will represent a dynamics column (cell) of the MPAS dynamics. + ! + !------------------------------------------------------------ - integer :: k - character(len=128) :: errmsg + use shr_const_mod, only: SHR_CONST_PI ! TODO: Is this the correct PI constant to use? - character(len=*), parameter :: subname = 'dyn_grid::get_block_levels_d' - !---------------------------------------------------------------------------- + ! Input variables + integer, intent(out) :: hdim1_d ! Global Longitudes or global grid size (nCells_g) + integer, intent(out) :: hdim2_d ! Latitudes or 1 for unstructured grids + integer, intent(out) :: num_levels ! Number of levels + integer, intent(out) :: index_model_top_layer + integer, intent(out) :: index_surface_layer + logical, intent(out) :: unstructured + type (physics_column_t), allocatable, intent(out):: dyn_columns(:) - if ( lvlsiz < plev + 1 ) then - write(errmsg,*) ': levels array not large enough (', lvlsiz,' < ',plev + 1,')' - call endrun( subname // trim(errmsg) ) - else - do k = 0, plev - levels(k+1) = k - end do - do k = plev+2, lvlsiz - levels(k) = -1 - end do + ! Local variables + type(mpas_pool_type), pointer :: meshPool + integer, pointer :: nCellsSolve ! Cells owned by this task, excluding halo cells + integer, pointer :: nVertLevels ! number of vertical layers (midpoints) + integer, dimension(:), pointer :: indexToCellID ! global indices of cell centers + real(r8), dimension(:), pointer :: latCell ! cell center latitude (radians) + real(r8), dimension(:), pointer :: lonCell ! cell center longitudes (radians) + real(r8), dimension(:), pointer :: areaCell ! cell areas in m^2 + integer :: iCell + integer :: ierr + integer :: my_proc_id + character(len=*), parameter :: subname = 'get_dyn_grid_info' + + ! TODO: Is it possible we can guarantee that local_dyn_columns will never be allocated before this function? + if (allocated(dyn_columns)) then + call endrun(subname//': dyn_columns must be unallocated') end if -end subroutine get_block_levels_d - -!========================================================================================= - -integer function get_gcol_block_cnt_d(gcol) - - ! Return number of blocks containing data for the vertical column - ! with the specified global column index. - - integer, intent(in) :: gcol ! global column index - !---------------------------------------------------------------------------- - - ! Each global column is solved in just one block. The blocks where that column may - ! be in a halo cell are not counted. - get_gcol_block_cnt_d = 1 - -end function get_gcol_block_cnt_d - -!========================================================================================= - -subroutine get_gcol_block_d(gcol, cnt, blockid, bcid) - - ! Return global block index and local column index for a global column index. - ! This routine can be called for global columns that are not owned by - ! the calling task. - - integer, intent(in) :: gcol ! global column index - integer, intent(in) :: cnt ! size of blockid and bcid arrays + ! Retrieve MPAS grid dimensions and variables from the mesh pool + call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'mesh', meshPool) + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) + call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels) - integer, intent(out) :: blockid(cnt) ! block index - integer, intent(out) :: bcid(cnt) ! column index within block + call mpas_pool_get_array(meshPool, 'indexToCellID', indexToCellID) + call mpas_pool_get_array(meshPool, 'latCell', latCell) + call mpas_pool_get_array(meshPool, 'lonCell', lonCell) + call mpas_pool_get_array(meshPool, 'areaCell', areaCell) - integer :: j + allocate(dyn_columns(nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate dyn_columns array') - character(len=*), parameter :: subname = 'dyn_grid::get_gcol_block_d' - !---------------------------------------------------------------------------- + ! Fill out subroutine arguments + hdim1_d = nCells_g + hdim2_d = 1 + num_levels = nVertLevels + index_model_top_layer = nVertLevels + index_surface_layer = 1 + unstructured = .True. - if ( cnt < 1 ) then - write(iulog,*) subname//': arrays not large enough: cnt= ', cnt - call endrun( subname // ': arrays not large enough' ) - end if + my_proc_id = domain_ptr % dminfo % my_proc_id - ! Each global column is solved in just one block. - blockid(1) = global_blockid(gcol) - bcid(1) = local_col_index(gcol) + ! + ! Fill out physics_t_column information, one member per cell (column) + ! + do iCell = 1, nCellsSolve + ! Column information + dyn_columns(iCell) % lat_rad = latCell(iCell) + dyn_columns(iCell) % lon_rad = lonCell(iCell) + dyn_columns(iCell) % lat_deg = latCell(iCell) * rad2deg + dyn_columns(iCell) % lon_deg = lonCell(iCell) * rad2deg + ! Normalize cell areas and cell weights to a unit sphere + dyn_columns(iCell) % area = areaCell(iCell) / (sphere_radius**2) + dyn_columns(iCell) % weight = areaCell(iCell) / (sphere_radius**2) + + ! File information + dyn_columns(iCell) % global_col_num = indexToCellID(iCell) + + ! Dynamics decomposition + dyn_columns(iCell) % dyn_task = my_proc_id + dyn_columns(iCell) % local_dyn_block = iCell + dyn_columns(iCell) % global_dyn_block = indexToCellID(iCell) + + ! dyn_block_index is not used, but it needs to be allocate to a 0 size + allocate(dyn_columns(iCell) % dyn_block_index(0), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate dyn_columns%dyn_block_index array') - do j=2,cnt - blockid(j) = -1 - bcid(j) = -1 end do -end subroutine get_gcol_block_d - -!========================================================================================= - -integer function get_block_owner_d(blockid) - - ! Return the ID of the task that owns the indicated global block. - ! Assume that task IDs are 0-based as in MPI. - - integer, intent(in) :: blockid ! global block id - !---------------------------------------------------------------------------- - - ! MPAS assigns one block per task. - get_block_owner_d = (blockid - 1) - -end function get_block_owner_d +end subroutine get_dyn_grid_info !========================================================================================= @@ -422,35 +310,7 @@ subroutine get_horiz_grid_d(nxy, clat_d_out, clon_d_out, area_d_out, & character(len=*), parameter :: subname = 'dyn_grid::get_horiz_grid_d' !---------------------------------------------------------------------------- - if ( nxy /= nCells_g ) then - write(iulog,*) subname//': incorrect number of cells: nxy, nCells_g= ', & - nxy, nCells_g - call endrun(subname//': incorrect number of cells') - end if - - if ( present( clat_d_out ) ) then - clat_d_out(:) = latCell_g(:) - end if - - if ( present( clon_d_out ) ) then - clon_d_out(:) = lonCell_g(:) - end if - - if ( present( area_d_out ) ) then - area_d_out(:) = areaCell_g(:) / (sphere_radius**2) - end if - - if ( present( wght_d_out ) ) then - wght_d_out(:) = areaCell_g(:) / (sphere_radius**2) - end if - - if ( present( lat_d_out ) ) then - lat_d_out(:) = latCell_g(:) * rad2deg - end if - - if ( present( lon_d_out ) ) then - lon_d_out(:) = lonCell_g(:) * rad2deg - end if + call endrun(subname//': NOT SUPPORTED WITH WEAK SCALING FIX') end subroutine get_horiz_grid_d @@ -465,13 +325,17 @@ subroutine physgrid_copy_attributes_d(gridname, grid_attribute_names) character(len=max_hcoordname_len), intent(out) :: gridname character(len=max_hcoordname_len), pointer, intent(out) :: grid_attribute_names(:) + integer :: ierr + character(len=*), parameter :: subname = 'dyn_grid::physgrid_copy_attributes_d' !---------------------------------------------------------------------------- ! Do not let the physics grid copy the mpas_cell "area" attribute because ! it is using a different dimension name. gridname = 'mpas_cell' - allocate(grid_attribute_names(0)) + allocate(grid_attribute_names(0), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate grid_attribute_names array') + end subroutine physgrid_copy_attributes_d @@ -517,7 +381,7 @@ integer function get_dyn_grid_parm(name) result(ival) ival = nCells_g else if(name == 'plev') then ival = plev - else + else ival = -1 end if @@ -541,20 +405,7 @@ subroutine dyn_grid_get_colndx(igcol, ncols, owners, col, lbk ) integer :: blockid(1), bcid(1) !---------------------------------------------------------------------------- - do i = 1,ncols - - call get_gcol_block_d(igcol(i), 1, blockid, bcid) - owners(i) = get_block_owner_d(blockid(1)) - - if ( iam==owners(i) ) then - lbk(i) = 1 ! only 1 block per task - col(i) = bcid(1) - else - lbk(i) = -1 - col(i) = -1 - end if - - end do + call endrun('dyn_grid_get_colndx: not implemented for unstructured grids') end subroutine dyn_grid_get_colndx @@ -578,7 +429,7 @@ subroutine dyn_grid_get_elem_coords(ie, rlon, rlat, cdex ) ! for a field on a dynamics decomposition. The code in hbuf_accum_addlcltime appears ! to also assume that the field is on the physics grid since there is no argument ! passed to specify which dynamics grid the coordinates are for. - + call endrun(subname//': not implemented for the MPAS grids') end subroutine dyn_grid_get_elem_coords @@ -592,8 +443,9 @@ subroutine setup_time_invariant(fh_ini) ! Initialize all time-invariant fields needed by the MPAS-Atmosphere dycore, ! by reading these fields from the initial file. - use mpas_rbf_interpolation, only : mpas_rbf_interp_initialize + use mpas_rbf_interpolation, only : mpas_rbf_interp_initialize use mpas_vector_reconstruction, only : mpas_init_reconstruct + use string_utils, only: int2str ! Arguments type(file_desc_t), pointer :: fh_ini @@ -602,10 +454,13 @@ subroutine setup_time_invariant(fh_ini) type(mpas_pool_type), pointer :: meshPool real(r8), pointer :: rdzw(:) real(r8), allocatable :: dzw(:) + integer, pointer :: nCells + real(r8), dimension(:), pointer :: lonCell integer :: k, kk + integer :: ierr - character(len=*), parameter :: routine = 'dyn_grid::setup_time_invariant' + character(len=*), parameter :: subname = 'dyn_grid::setup_time_invariant' !---------------------------------------------------------------------------- ! Read time-invariant fields @@ -621,14 +476,27 @@ subroutine setup_time_invariant(fh_ini) call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve) call mpas_pool_get_dimension(meshPool, 'nVerticesSolve', nVerticesSolve) call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevelsSolve) ! MPAS always solves over the full column + call mpas_pool_get_dimension(meshPool, 'nCells', nCells) ! check that number of vertical layers matches MPAS grid data if (plev /= nVertLevelsSolve) then - write(iulog,*) routine//': ERROR: number of levels in IC file does not match plev: file, plev=', & + write(iulog,*) subname//': ERROR: number of levels in IC file does not match plev: file, plev=', & nVertLevelsSolve, plev - call endrun(routine//': ERROR: number of levels in IC file does not match plev.') + call endrun(subname//': ERROR: number of levels in IC file ('//int2str(nVertLevelsSolve)// & + ') does not match plev ('//int2str(nVertLevelsSolve)//').') end if + ! Ensure longitudes are within the [0,2*pi) range, and only remap values that + ! are outside the range. Some non-simple physics in CAM require this + ! longitude range, the MPAS-A dycore does not require any specific range for + ! lonCell + call mpas_pool_get_array(meshPool, 'lonCell', lonCell) + do k=1,nCells + if (lonCell(k) < 0._r8 .or. lonCell(k) >= (2._r8 * pi)) then + lonCell(k) = lonCell(k) - (2._r8 * pi) * floor(lonCell(k) / (2._r8 * pi)) + end if + end do + ! Initialize fields needed for reconstruction of cell-centered winds from edge-normal winds ! Note: This same pair of calls happens a second time later in the initialization of ! the MPAS-A dycore (in atm_mpas_init_block), but the redundant calls do no harm @@ -640,7 +508,9 @@ subroutine setup_time_invariant(fh_ini) ! in CAM coordinate objects. call mpas_pool_get_array(meshPool, 'rdzw', rdzw) - allocate(dzw(plev)) + allocate(dzw(plev), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate dzw array') + dzw = 1._r8 / rdzw zw(plev+1) = 0._r8 do k = plev, 1, -1 @@ -675,7 +545,8 @@ subroutine define_cam_grids() use cam_grid_support, only: horiz_coord_t, horiz_coord_create, iMap use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register - + use shr_const_mod, only: PI => SHR_CONST_PI + ! Local variables integer :: i, j @@ -690,6 +561,7 @@ subroutine define_cam_grids() real(r8), dimension(:), pointer :: latCell ! cell center latitude (radians) real(r8), dimension(:), pointer :: lonCell ! cell center longitude (radians) real(r8), dimension(:), pointer :: areaCell ! cell areas in m^2 + real(r8), dimension(:), pointer :: areaWeight! normalized cell areas weights integer, dimension(:), pointer :: indexToEdgeID ! global indices of edge nodes real(r8), dimension(:), pointer :: latEdge ! edge node latitude (radians) @@ -698,6 +570,15 @@ subroutine define_cam_grids() integer, dimension(:), pointer :: indexToVertexID ! global indices of vertex nodes real(r8), dimension(:), pointer :: latVertex ! vertex node latitude (radians) real(r8), dimension(:), pointer :: lonVertex ! vertex node longitude (radians) + integer :: ierr + character(len=*), parameter :: subname = 'dyn_grid::define_cam_grids' + integer :: hdim1_d ! Global Longitudes or global grid size (nCells_g) + integer :: hdim2_d ! Latitudes or 1 for unstructured grids + integer :: num_levels ! Number of levels + integer :: index_model_top_layer + integer :: index_surface_layer + logical :: unstructured + type (physics_column_t), allocatable :: dyn_cols(:) !---------------------------------------------------------------------------- call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'mesh', meshPool) @@ -711,25 +592,42 @@ subroutine define_cam_grids() call mpas_pool_get_array(meshPool, 'lonCell', lonCell) call mpas_pool_get_array(meshPool, 'areaCell', areaCell) - allocate(gidx(nCellsSolve)) + allocate(gidx(nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate gidx array at line:'//int2str(__LINE__)) + gidx = indexToCellID(1:nCellsSolve) lat_coord => horiz_coord_create('latCell', 'nCells', nCells_g, 'latitude', & 'degrees_north', 1, nCellsSolve, latCell(1:nCellsSolve)*rad2deg, map=gidx) lon_coord => horiz_coord_create('lonCell', 'nCells', nCells_g, 'longitude', & 'degrees_east', 1, nCellsSolve, lonCell(1:nCellsSolve)*rad2deg, map=gidx) - + + allocate(areaWeight(nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate area_weight :'//int2str(__LINE__)) + call get_dyn_grid_info(hdim1_d, hdim2_d, num_levels, index_model_top_layer, index_surface_layer, unstructured, dyn_cols) + + ! Map for cell centers grid - allocate(grid_map(3, nCellsSolve)) + allocate(grid_map(3, nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate grid_map array at line:'//int2str(__LINE__)) + do i = 1, nCellsSolve grid_map(1, i) = i grid_map(2, i) = 1 grid_map(3, i) = gidx(i) + areaWeight(i) = dyn_cols(i)%weight/(4.0_r8*PI) end do ! cell center grid for I/O using MPAS names call cam_grid_register('mpas_cell', dyn_decomp, lat_coord, lon_coord, & grid_map, block_indexed=.false., unstruct=.true.) + call cam_grid_attribute_register('mpas_cell', 'area_cell', 'mpas cell areas', & + 'nCells', areaCell, map=gidx) + call cam_grid_attribute_register('mpas_cell', 'area_weight_mpas', 'mpas area weight', & + 'nCells', areaWeight, map=gidx) + + nullify(areaWeight) ! areaWeight belongs to grid now + nullify(areaCell) ! areaCell belongs to grid now ! create new coordinates and grid using CAM names lat_coord => horiz_coord_create('lat', 'ncol', nCells_g, 'latitude', & @@ -742,6 +640,8 @@ subroutine define_cam_grids() ! gidx can be deallocated. Values are copied into the coordinate and attribute objects. deallocate(gidx) + deallocate(dyn_cols) + ! grid_map memory cannot be deallocated. The cam_filemap_t object just points ! to it. Pointer can be disassociated. nullify(grid_map) ! Map belongs to grid now @@ -759,16 +659,20 @@ subroutine define_cam_grids() call mpas_pool_get_array(meshPool, 'latEdge', latEdge) call mpas_pool_get_array(meshPool, 'lonEdge', lonEdge) - allocate(gidx(nEdgesSolve)) + allocate(gidx(nEdgesSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate gidx array at line:'//int2str(__LINE__)) + gidx = indexToEdgeID(1:nEdgesSolve) lat_coord => horiz_coord_create('latEdge', 'nEdges', nEdges_g, 'latitude', & 'degrees_north', 1, nEdgesSolve, latEdge(1:nEdgesSolve)*rad2deg, map=gidx) lon_coord => horiz_coord_create('lonEdge', 'nEdges', nEdges_g, 'longitude', & 'degrees_east', 1, nEdgesSolve, lonEdge(1:nEdgesSolve)*rad2deg, map=gidx) - + ! Map for edge node grid - allocate(grid_map(3, nEdgesSolve)) + allocate(grid_map(3, nEdgesSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate grid_map array at line:'//int2str(__LINE__)) + do i = 1, nEdgesSolve grid_map(1, i) = i grid_map(2, i) = 1 @@ -792,16 +696,20 @@ subroutine define_cam_grids() call mpas_pool_get_array(meshPool, 'latVertex', latVertex) call mpas_pool_get_array(meshPool, 'lonVertex', lonVertex) - allocate(gidx(nVerticesSolve)) + allocate(gidx(nVerticesSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate gidx array at line:'//int2str(__LINE__)) + gidx = indexToVertexID(1:nVerticesSolve) lat_coord => horiz_coord_create('latVertex', 'nVertices', nVertices_g, 'latitude', & 'degrees_north', 1, nVerticesSolve, latVertex(1:nVerticesSolve)*rad2deg, map=gidx) lon_coord => horiz_coord_create('lonVertex', 'nVertices', nVertices_g, 'longitude', & 'degrees_east', 1, nVerticesSolve, lonVertex(1:nVerticesSolve)*rad2deg, map=gidx) - + ! Map for vertex node grid - allocate(grid_map(3, nVerticesSolve)) + allocate(grid_map(3, nVerticesSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate grid_map array at line:'//int2str(__LINE__)) + do i = 1, nVerticesSolve grid_map(1, i) = i grid_map(2, i) = 1 @@ -816,7 +724,7 @@ subroutine define_cam_grids() nullify(grid_map) nullify(lat_coord) nullify(lon_coord) - + end subroutine define_cam_grids end module dyn_grid diff --git a/src/dynamics/mpas/stepon.F90 b/src/dynamics/mpas/stepon.F90 index 7fc0c196d2..6e83a3dc60 100644 --- a/src/dynamics/mpas/stepon.F90 +++ b/src/dynamics/mpas/stepon.F90 @@ -1,5 +1,6 @@ module stepon +use cam_abortutils, only: endrun use shr_kind_mod, only: r8 => shr_kind_r8 use spmd_utils, only: mpicom @@ -9,19 +10,22 @@ module stepon use physics_types, only: physics_state, physics_tend use physics_buffer, only: physics_buffer_desc -use dyn_comp, only: dyn_import_t, dyn_export_t, dyn_run, dyn_final, & - swap_time_level_ptrs +use dyn_comp, only: dyn_import_t, dyn_export_t, dyn_run, dyn_final use dp_coupling, only: d_p_coupling, p_d_coupling -use camsrfexch, only: cam_out_t +use camsrfexch, only: cam_out_t -use cam_history, only: addfld, outfld, hist_fld_active +use cam_history, only: addfld, outfld, hist_fld_active, write_inithist use time_manager, only: get_step_size, get_nstep, is_first_step, is_first_restart_step use perf_mod, only: t_startf, t_stopf, t_barrierf - + +use aerosol_properties_mod, only: aerosol_properties +use aerosol_state_mod, only: aerosol_state +use microp_aero, only: aerosol_state_object, aerosol_properties_object + implicit none private save @@ -33,6 +37,9 @@ module stepon stepon_run3, & stepon_final +class(aerosol_properties), pointer :: aero_props_obj => null() +logical :: aerosols_transported = .false. + !========================================================================================= contains !========================================================================================= @@ -67,6 +74,14 @@ subroutine stepon_init(dyn_in, dyn_out) call addfld ('rho_tend', (/ 'lev' /), 'A', 'kg/m^3/s', & 'physics tendency of dry air density', gridname='mpas_cell') + ! get aerosol properties + aero_props_obj => aerosol_properties_object() + + if (associated(aero_props_obj)) then + ! determine if there are transported aerosol contistuents + aerosols_transported = aero_props_obj%number_transported()>0 + end if + end subroutine stepon_init !========================================================================================= @@ -84,6 +99,11 @@ subroutine stepon_run1(dtime_out, phys_state, phys_tend, & ! local variables integer :: nstep + + integer :: c + class(aerosol_state), pointer :: aero_state_obj + nullify(aero_state_obj) + !---------------------------------------------------------------------------- nstep = get_nstep() @@ -92,26 +112,26 @@ subroutine stepon_run1(dtime_out, phys_state, phys_tend, & ! This call writes the dycore output (on the dynamics grids) to the ! history file. Note that when nstep=0, these fields will be the result ! of the dynamics initialization (done in dyn_init) since the dycore - ! does not run and dyn_in is simply copied to dyn_out for use in the cam - ! initialization sequence. On subsequent calls dyn_out will contain the - ! dycore output. + ! does not run and dyn_in points to the same memory as dyn_out. call write_dynvar(dyn_out) - + call t_barrierf('sync_d_p_coupling', mpicom) call t_startf('d_p_coupling') ! Move data into phys_state structure. call d_p_coupling (phys_state, phys_tend, pbuf2d, dyn_out) call t_stopf('d_p_coupling') - - ! Update pointers for prognostic fields if necessary. Note that this shift - ! should not take place the first time stepon_run1 is called which is during - ! the CAM initialization sequence before the dycore is called. Nor should it - ! occur for the first step of a restart run. - if (.not. is_first_step() .and. & - .not. is_first_restart_step() .and. & - swap_time_level_ptrs) then - call shift_time_levels(dyn_in, dyn_out) + !---------------------------------------------------------- + ! update aerosol state object from CAM physics state constituents + !---------------------------------------------------------- + if (aerosols_transported) then + + do c = begchunk,endchunk + aero_state_obj => aerosol_state_object(c) + ! pass number mass or number mixing ratios of aerosol constituents + ! to aerosol state object + call aero_state_obj%set_transported(phys_state(c)%q) + end do end if @@ -128,6 +148,22 @@ subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out) type (dyn_export_t), intent(inout) :: dyn_out !---------------------------------------------------------------------------- + integer :: c + class(aerosol_state), pointer :: aero_state_obj + + !---------------------------------------------------------- + ! update physics state with aerosol constituents + !---------------------------------------------------------- + nullify(aero_state_obj) + + if (aerosols_transported) then + do c = begchunk,endchunk + aero_state_obj => aerosol_state_object(c) + ! get mass or number mixing ratios of aerosol constituents + call aero_state_obj%get_transported(phys_state(c)%q) + end do + end if + call t_barrierf('sync_p_d_coupling', mpicom) call t_startf('p_d_coupling') ! copy from phys structures -> dynamics structures @@ -153,7 +189,7 @@ subroutine stepon_run3(dtime, cam_out, phys_state, dyn_in, dyn_out) call t_barrierf('sync_dyn_run', mpicom) call t_startf('dyn_run') - call dyn_run(dyn_in, dyn_out) + call dyn_run(dyn_in, dyn_out) call t_stopf('dyn_run') end subroutine stepon_run3 @@ -178,6 +214,9 @@ end subroutine stepon_final subroutine write_dynvar(dyn_out) ! Output from the internal MPAS data structures to CAM history files. + ! Make call to MPAS to write an initial file when requested. + + use string_utils, only: int2str ! agruments type(dyn_export_t), intent(in) :: dyn_out @@ -187,6 +226,8 @@ subroutine write_dynvar(dyn_out) integer :: nCellsSolve, nEdgesSolve, nVerticesSolve integer :: qv_idx real(r8), allocatable :: arr2d(:,:) + integer :: ierr + character(len=*), parameter :: subname = 'stepon::write_dynvar' !---------------------------------------------------------------------------- nCellsSolve = dyn_out%nCellsSolve @@ -195,7 +236,8 @@ subroutine write_dynvar(dyn_out) qv_idx = dyn_out%index_qv if (hist_fld_active('u')) then - allocate(arr2d(nEdgesSolve,plev)) + allocate(arr2d(nEdgesSolve,plev), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate arr2d array at line:'//int2str(__LINE__)) do k = 1, plev kk = plev - k + 1 do i = 1, nEdgesSolve @@ -207,7 +249,8 @@ subroutine write_dynvar(dyn_out) end if if (hist_fld_active('w')) then - allocate(arr2d(nCellsSolve,plevp)) + allocate(arr2d(nCellsSolve,plevp), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate arr2d array at line:'//int2str(__LINE__)) do k = 1, plevp kk = plevp - k + 1 do i = 1, nCellsSolve @@ -218,7 +261,8 @@ subroutine write_dynvar(dyn_out) deallocate(arr2d) end if - allocate(arr2d(nCellsSolve,plev)) + allocate(arr2d(nCellsSolve,plev), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate arr2d array at line:'//int2str(__LINE__)) if (hist_fld_active('theta')) then do k = 1, plev @@ -283,7 +327,8 @@ subroutine write_dynvar(dyn_out) deallocate(arr2d) if (hist_fld_active('vorticity')) then - allocate(arr2d(nVerticesSolve,plev)) + allocate(arr2d(nVerticesSolve,plev), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate arr2d array at line:'//int2str(__LINE__)) do k = 1, plev kk = plev - k + 1 do i = 1, nVerticesSolve @@ -294,6 +339,10 @@ subroutine write_dynvar(dyn_out) deallocate(arr2d) end if + if (write_inithist()) then + call write_initial_file() + end if + end subroutine write_dynvar !========================================================================================= @@ -302,6 +351,8 @@ subroutine write_forcings(dyn_in) ! Output from the internal MPAS data structures to CAM history files. + use string_utils, only: int2str + ! agruments type(dyn_import_t), intent(in) :: dyn_in @@ -309,6 +360,8 @@ subroutine write_forcings(dyn_in) integer :: i, k, kk integer :: nCellsSolve, nEdgesSolve real(r8), allocatable :: arr2d(:,:) + integer :: ierr + character(len=*), parameter :: subname = 'dyn_grid::write_forcings' !---------------------------------------------------------------------------- @@ -317,7 +370,8 @@ subroutine write_forcings(dyn_in) nEdgesSolve = dyn_in%nEdgesSolve if (hist_fld_active('ru_tend')) then - allocate(arr2d(nEdgesSolve,plev)) + allocate(arr2d(nEdgesSolve,plev), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate arr2d array at line:'//int2str(__LINE__)) do k = 1, plev kk = plev - k + 1 do i = 1, nEdgesSolve @@ -328,7 +382,8 @@ subroutine write_forcings(dyn_in) deallocate(arr2d) end if - allocate(arr2d(nCellsSolve,plev)) + allocate(arr2d(nCellsSolve,plev), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate arr2d array at line:'//int2str(__LINE__)) if (hist_fld_active('rtheta_tend')) then do k = 1, plev @@ -356,43 +411,65 @@ end subroutine write_forcings !======================================================================================== -subroutine shift_time_levels(dyn_in, dyn_out) +subroutine write_initial_file() - ! The MPAS dycore swaps the pool time indices after each timestep - ! (mpas_dt). If an odd number of these shifts occur during the CAM - ! timestep (i.e., the dynamics/physics coupling interval), then CAM - ! needs a corresponding update to the pointers in the dyn_in and dyn_out - ! objects. + ! Make use of the MPAS functionality for writting a restart file to + ! write an initial file. - ! arguments - type (dyn_import_t), intent(inout) :: dyn_in - type (dyn_export_t), intent(inout) :: dyn_out + use shr_kind_mod, only: cl=>shr_kind_cl + use cam_instance, only: inst_suffix + use time_manager, only: get_curr_date, get_stop_date, timemgr_datediff + use filenames, only: interpret_filename_spec + use pio, only: file_desc_t, pio_enddef, & + pio_seterrorhandling, PIO_BCAST_ERROR + use cam_pio_utils, only: cam_pio_createfile, cam_pio_closefile + use cam_abortutils, only: endrun - ! local variables - real(r8), dimension(:,:), pointer :: ptr2d - real(r8), dimension(:,:,:), pointer :: ptr3d - !-------------------------------------------------------------------------------------- + use mpas_derived_types, only: MPAS_Stream_type, MPAS_IO_WRITE + use cam_mpas_subdriver, only: cam_mpas_setup_restart, cam_mpas_write_restart + + ! Local variables + integer :: yr, mon, day, tod1, tod2, ymd1, ymd2 + real(r8) :: days + character(len=cl) :: filename_spec ! filename specifier + character(len=cl) :: fname ! initial filename + type(file_desc_t) :: fh + integer :: ierr - ptr2d => dyn_out % uperp - dyn_out % uperp => dyn_in % uperp - dyn_in % uperp => ptr2d + type (MPAS_Stream_type) :: initial_stream + !---------------------------------------------------------------------------- + + ! Check whether the current time is during the final partial timestep taken by + ! CAM. Don't write the initial file during that time. This avoids the problem + ! of having an initial file written with a timestamp that is after the stop date. + call get_curr_date(yr, mon, day, tod1) + ymd1 = 10000*yr + 100*mon + day + call get_stop_date(yr, mon, day, tod2) + ymd2 = 10000*yr + 100*mon + day + ! (ymd2,tod2) - (ymd1,tod1) + call timemgr_datediff(ymd1, tod1, ymd2, tod2, days) + if (days < 0._r8) return + + ! Set filename template for initial file based on instance suffix + ! (%c = caseid, %y = year, %m = month, %d = day, %s = seconds in day) + filename_spec = '%c.cam' // trim(inst_suffix) //'.i.%y-%m-%d-%s.nc' + + fname = interpret_filename_spec( filename_spec ) - ptr2d => dyn_out % w - dyn_out % w => dyn_in % w - dyn_in % w => ptr2d + call cam_pio_createfile(fh, trim(fname), 0) - ptr2d => dyn_out % theta_m - dyn_out % theta_m => dyn_in % theta_m - dyn_in % theta_m => ptr2d + call pio_seterrorhandling(fh, PIO_BCAST_ERROR) - ptr2d => dyn_out % rho_zz - dyn_out % rho_zz => dyn_in % rho_zz - dyn_in % rho_zz => ptr2d + call cam_mpas_setup_restart(fh, initial_stream, MPAS_IO_WRITE, endrun) - ptr3d => dyn_out % tracers - dyn_out % tracers => dyn_in % tracers - dyn_in % tracers => ptr3d + ierr = pio_enddef(fh) -end subroutine shift_time_levels + call cam_mpas_write_restart(initial_stream, endrun) + + call cam_pio_closefile(fh) + +end subroutine write_initial_file + +!======================================================================================== end module stepon diff --git a/src/dynamics/se/advect_tend.F90 b/src/dynamics/se/advect_tend.F90 index 856e3408a2..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,29 +28,29 @@ 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 dimensions_mod, only: nc,np,nlev,ntrac + 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 - if (ntrac>0) then + if (use_cslam) then nx=nc else nx=np endif allocate( ftmp(nx*nx,nlev) ) - + init = .false. if ( .not. allocated( adv_tendxyz ) ) then init = .true. @@ -52,7 +58,7 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) adv_tendxyz(:,:,:,:,:) = 0._r8 endif - if (ntrac>0) then + if (use_cslam) then do ie=nets,nete do ic=1,pcnst adv_tendxyz(:,:,:,ic,ie) = fvm(ie)%c(1:nc,1:nc,:,ic) - adv_tendxyz(:,:,:,ic,ie) @@ -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 40efae09a2..41e24f18f0 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -8,32 +8,28 @@ module dp_coupling use ppgrid, only: begchunk, endchunk, pcols, pver, pverp use constituents, only: pcnst, cnst_type -use spmd_dyn, only: local_dp_map, block_buf_nrecs, chunk_buf_nrecs -use spmd_utils, only: mpicom, iam -use dyn_grid, only: get_gcol_block_d, TimeLevel, edgebuf +use spmd_dyn, only: local_dp_map +use spmd_utils, only: iam +use dyn_grid, only: TimeLevel, edgebuf use dyn_comp, only: dyn_export_t, dyn_import_t -use physics_types, only: physics_state, physics_tend -use phys_grid, only: get_ncols_p, get_gcol_all_p, block_to_chunk_send_pters, & - transpose_block_to_chunk, block_to_chunk_recv_pters, & - chunk_to_block_send_pters, transpose_chunk_to_block, & - chunk_to_block_recv_pters +use physics_types, only: physics_state, physics_tend, 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, phys_columns_on_task use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_get_field use dp_mapping, only: nphys_pts -use cam_logfile, only: iulog -use perf_mod, only: t_startf, t_stopf, t_barrierf +use perf_mod, only: t_startf, t_stopf use cam_abortutils, only: endrun use parallel_mod, only: par use thread_mod, only: horz_num_threads, max_num_threads use hybrid_mod, only: config_thread_region, get_loop_ranges, hybrid_t -use dimensions_mod, only: np, npsq, nelemd, nlev, nc, qsize, ntrac, fv_nphys +use dimensions_mod, only: np, nelemd, nlev, qsize, ntrac, fv_nphys use dof_mod, only: UniquePoints, PutUniquePoints use element_mod, only: element_t -use fvm_control_volume_mod, only: fvm_struct implicit none private @@ -53,15 +49,15 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) ! Note that all pressures and tracer mixing ratios coming from the dycore are based on ! dry air mass. - use gravity_waves_sources, only: gws_src_fnct - use dyn_comp, only: frontgf_idx, frontga_idx - use phys_control, only: use_gw_front, use_gw_front_igw + use gravity_waves_sources, only: gws_src_fnct,gws_src_vort + use dyn_comp, only: frontgf_idx, frontga_idx, vort4gw_idx + use phys_control, only: use_gw_front, use_gw_front_igw, use_gw_movmtn_pbl use hycoef, only: hyai, ps0 use fvm_mapping, only: dyn2phys_vector, dyn2phys_all_vars - use time_mod, only: timelevel_qdp + use se_dyn_time_mod, only: timelevel_qdp use control_mod, only: qsplit use test_fvm_mapping, only: test_mapping_overwrite_dyn_state, test_mapping_output_phys_state - + use prim_advance_mod, only: tot_energy_dyn ! arguments type(dyn_export_t), intent(inout) :: dyn_out ! dynamics export type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -86,27 +82,34 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) ! Frontogenesis real (kind=r8), allocatable :: frontgf(:,:,:) ! temp arrays to hold frontogenesis real (kind=r8), allocatable :: frontga(:,:,:) ! function (frontgf) and angle (frontga) + real (kind=r8), allocatable :: frontgf_phys(:,:,:) + real (kind=r8), allocatable :: frontga_phys(:,:,:) + + ! Vorticity + real (kind=r8), allocatable :: vort4gw(:,:,:) ! temp arrays to hold vorticity + real (kind=r8), allocatable :: vort4gw_phys(:,:,:) + + ! Pointers to pbuf real (kind=r8), pointer :: pbuf_frontgf(:,:) real (kind=r8), pointer :: pbuf_frontga(:,:) + real (kind=r8), pointer :: pbuf_vort4gw(:,:) - integer :: ncols,i,j,ierr,k,iv - integer :: ioff, m, m_cnst - integer :: pgcols(pcols), idmb1(1), idmb2(1), idmb3(1) - integer :: tsize ! amount of data per grid point passed to physics - integer, allocatable :: bpter(:,:) ! offsets into block buffer for packing data - integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data + integer :: ncols, ierr + integer :: col_ind, blk_ind(1), m integer :: nphys - real (kind=r8), allocatable :: bbuffer(:), cbuffer(:) ! transpose buffers real (kind=r8), allocatable :: qgll(:,:,:,:) real (kind=r8) :: inv_dp3d(np,np,nlev) integer :: tl_f, tl_qdp_np0, tl_qdp_np1 - logical :: lmono type(physics_buffer_desc), pointer :: pbuf_chnk(:) !---------------------------------------------------------------------------- + if (.not. local_dp_map) then + call endrun('d_p_coupling: Weak scaling does not support load balancing') + end if + elem => dyn_out%elem tl_f = TimeLevel%n0 call TimeLevel_Qdp(TimeLevel, qsplit, tl_qdp_np0,tl_qdp_np1) @@ -114,6 +117,9 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) nullify(pbuf_chnk) nullify(pbuf_frontgf) nullify(pbuf_frontga) + nullify(pbuf_vort4gw) + + if (fv_nphys > 0) then nphys = fv_nphys @@ -132,17 +138,26 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) allocate(q_tmp(nphys_pts,pver,pcnst,nelemd)) allocate(omega_tmp(nphys_pts,pver,nelemd)) + call tot_energy_dyn(elem,dyn_out%fvm, 1, nelemd,tl_f , tl_qdp_np0,'dBF') + if (use_gw_front .or. use_gw_front_igw) then allocate(frontgf(nphys_pts,pver,nelemd), stat=ierr) if (ierr /= 0) call endrun("dp_coupling: Allocate of frontgf failed.") allocate(frontga(nphys_pts,pver,nelemd), stat=ierr) if (ierr /= 0) call endrun("dp_coupling: Allocate of frontga failed.") end if + if (use_gw_movmtn_pbl) then + allocate(vort4gw(nphys_pts,pver,nelemd), stat=ierr) + if (ierr /= 0) call endrun("dp_coupling: Allocate of vort4gw failed.") + end if if (iam < par%nprocs) then - if (use_gw_front .or. use_gw_front_igw) then + if (use_gw_front .or. use_gw_front_igw ) then call gws_src_fnct(elem, tl_f, tl_qdp_np0, frontgf, frontga, nphys) end if + if (use_gw_movmtn_pbl ) then + call gws_src_vort(elem, tl_f, tl_qdp_np0, vort4gw, nphys) + end if if (fv_nphys > 0) then call test_mapping_overwrite_dyn_state(elem,dyn_out%fvm) @@ -207,10 +222,15 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) frontgf(:,:,:) = 0._r8 frontga(:,:,:) = 0._r8 end if + if (use_gw_movmtn_pbl) then + vort4gw(:,:,:) = 0._r8 + end if endif ! iam < par%nprocs - if (fv_nphys<1) deallocate(qgll) + if (fv_nphys < 1) then + deallocate(qgll) + end if ! q_prev is for saving the tracer fields for calculating tendencies if (.not. allocated(q_prev)) then @@ -219,161 +239,73 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) q_prev = 0.0_R8 call t_startf('dpcopy') - if (local_dp_map) then - - !$omp parallel do num_threads(max_num_threads) private (lchnk, ncols, pgcols, icol, idmb1, idmb2, idmb3, ie, ioff, ilyr, m, pbuf_chnk, pbuf_frontgf, pbuf_frontga) - do lchnk = begchunk, endchunk - - ncols = get_ncols_p(lchnk) - call get_gcol_all_p(lchnk, pcols, pgcols) + if (use_gw_front .or. use_gw_front_igw) then + allocate(frontgf_phys(pcols, pver, begchunk:endchunk)) + allocate(frontga_phys(pcols, pver, begchunk:endchunk)) + end if + if (use_gw_movmtn_pbl) then + allocate(vort4gw_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, 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) + phys_state(lchnk)%phis(icol) = phis_tmp(blk_ind(1), ie) + do ilyr = 1, pver + phys_state(lchnk)%pdel(icol, ilyr) = dp3d_tmp(blk_ind(1), ilyr, ie) + phys_state(lchnk)%t(icol, ilyr) = T_tmp(blk_ind(1), ilyr, ie) + phys_state(lchnk)%u(icol, ilyr) = uv_tmp(blk_ind(1), 1, ilyr, ie) + phys_state(lchnk)%v(icol, ilyr) = uv_tmp(blk_ind(1), 2, ilyr, ie) + phys_state(lchnk)%omega(icol, ilyr) = omega_tmp(blk_ind(1), ilyr, ie) - pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) if (use_gw_front .or. use_gw_front_igw) then - call pbuf_get_field(pbuf_chnk, frontgf_idx, pbuf_frontgf) - call pbuf_get_field(pbuf_chnk, frontga_idx, pbuf_frontga) + frontgf_phys(icol, ilyr, lchnk) = frontgf(blk_ind(1), ilyr, ie) + frontga_phys(icol, ilyr, lchnk) = frontga(blk_ind(1), ilyr, ie) end if + if (use_gw_movmtn_pbl) then + vort4gw_phys(icol, ilyr, lchnk) = vort4gw(blk_ind(1), ilyr, ie) + end if + end do - do icol = 1, ncols - call get_gcol_block_d(pgcols(icol),1,idmb1,idmb2,idmb3) - ie = idmb3(1) - ioff = idmb2(1) - phys_state(lchnk)%ps(icol) = ps_tmp(ioff,ie) - phys_state(lchnk)%phis(icol) = phis_tmp(ioff,ie) - do ilyr=1,pver - phys_state(lchnk)%pdel(icol,ilyr) = dp3d_tmp(ioff,ilyr,ie) - phys_state(lchnk)%t(icol,ilyr) = T_tmp(ioff,ilyr,ie) - phys_state(lchnk)%u(icol,ilyr) = uv_tmp(ioff,1,ilyr,ie) - phys_state(lchnk)%v(icol,ilyr) = uv_tmp(ioff,2,ilyr,ie) - phys_state(lchnk)%omega(icol,ilyr) = omega_tmp(ioff,ilyr,ie) - - if (use_gw_front .or. use_gw_front_igw) then - pbuf_frontgf(icol,ilyr) = frontgf(ioff,ilyr,ie) - pbuf_frontga(icol,ilyr) = frontga(ioff,ilyr,ie) - endif - end do - - do m = 1, pcnst - do ilyr = 1, pver - phys_state(lchnk)%q(icol,ilyr,m) = Q_tmp(ioff,ilyr,m,ie) - end do - end do + do m = 1, pcnst + do ilyr = 1, pver + phys_state(lchnk)%q(icol, ilyr,m) = Q_tmp(blk_ind(1), ilyr,m, ie) end do end do - - else ! .not. local_dp_map - - tsize = 5 + pcnst - if (use_gw_front .or. use_gw_front_igw) tsize = tsize + 2 - - allocate(bbuffer(tsize*block_buf_nrecs)) - allocate(cbuffer(tsize*chunk_buf_nrecs)) - if (fv_nphys > 0) then - allocate(bpter(fv_nphys*fv_nphys,0:pver)) - else - allocate(bpter(npsq,0:pver)) - end if - - if (iam < par%nprocs) then - !$omp parallel do num_threads(max_num_threads) private (ie, bpter, icol, ilyr, m, ncols, ioff) - do ie = 1, nelemd - - if (fv_nphys > 0) then - call block_to_chunk_send_pters(elem(ie)%GlobalID, fv_nphys*fv_nphys, & - pver+1, tsize, bpter) - ncols = fv_nphys*fv_nphys - else - call block_to_chunk_send_pters(elem(ie)%GlobalID, npsq, & - pver+1, tsize, bpter) - ncols = elem(ie)%idxP%NumUniquePts - end if - - do icol=1,ncols - bbuffer(bpter(icol,0)+2:bpter(icol,0)+tsize-1) = 0.0_r8 - bbuffer(bpter(icol,0)) = ps_tmp(icol,ie) - bbuffer(bpter(icol,0)+1) = phis_tmp(icol,ie) - - do ilyr=1,pver - ioff = 0 - bbuffer(bpter(icol,ilyr)+ioff) = T_tmp(icol,ilyr,ie) - ioff = ioff + 1 - bbuffer(bpter(icol,ilyr)+ioff) = uv_tmp(icol,1,ilyr,ie) - ioff = ioff + 1 - bbuffer(bpter(icol,ilyr)+ioff) = uv_tmp(icol,2,ilyr,ie) - ioff = ioff + 1 - bbuffer(bpter(icol,ilyr)+ioff) = omega_tmp(icol,ilyr,ie) - ioff = ioff + 1 - bbuffer(bpter(icol,ilyr)+ioff) = dp3d_tmp(icol,ilyr,ie) - if (use_gw_front .or. use_gw_front_igw) then - ioff = ioff + 1 - bbuffer(bpter(icol,ilyr)+ioff) = frontgf(icol,ilyr,ie) - ioff = ioff + 1 - bbuffer(bpter(icol,ilyr)+ioff) = frontga(icol,ilyr,ie) - end if - - do m=1,pcnst - bbuffer(bpter(icol,ilyr)+tsize-pcnst-1+m) = Q_tmp(icol,ilyr,m,ie) - end do - end do + end do + if (use_gw_front .or. use_gw_front_igw) then + !$omp parallel do num_threads(max_num_threads) private (lchnk, ncols, icol, ilyr, pbuf_chnk, pbuf_frontgf, pbuf_frontga) + do lchnk = begchunk, endchunk + ncols = get_ncols_p(lchnk) + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + call pbuf_get_field(pbuf_chnk, frontgf_idx, pbuf_frontgf) + call pbuf_get_field(pbuf_chnk, frontga_idx, pbuf_frontga) + do icol = 1, ncols + do ilyr = 1, pver + pbuf_frontgf(icol, ilyr) = frontgf_phys(icol, ilyr, lchnk) + pbuf_frontga(icol, ilyr) = frontga_phys(icol, ilyr, lchnk) end do end do - - else - bbuffer(:) = 0._r8 - end if - - call t_barrierf ('sync_blk_to_chk', mpicom) - call t_startf ('block_to_chunk') - call transpose_block_to_chunk(tsize, bbuffer, cbuffer) - call t_stopf ('block_to_chunk') - - !$omp parallel do num_threads(max_num_threads) private (lchnk, ncols, cpter, icol, ilyr, m, pbuf_chnk, pbuf_frontgf, pbuf_frontga, ioff) + end do + deallocate(frontgf_phys) + deallocate(frontga_phys) + end if + if (use_gw_movmtn_pbl) then + !$omp parallel do num_threads(max_num_threads) private (lchnk, ncols, icol, ilyr, pbuf_chnk, pbuf_vort4gw) do lchnk = begchunk, endchunk - ncols = phys_state(lchnk)%ncol - + ncols = get_ncols_p(lchnk) pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) - - if (use_gw_front .or. use_gw_front_igw) then - call pbuf_get_field(pbuf_chnk, frontgf_idx, pbuf_frontgf) - call pbuf_get_field(pbuf_chnk, frontga_idx, pbuf_frontga) - end if - - call block_to_chunk_recv_pters(lchnk,pcols,pver+1,tsize,cpter) - + call pbuf_get_field(pbuf_chnk, vort4gw_idx, pbuf_vort4gw) do icol = 1, ncols - phys_state(lchnk)%ps(icol) = cbuffer(cpter(icol,0)) - phys_state(lchnk)%phis(icol) = cbuffer(cpter(icol,0)+1) - do ilyr = 1, pver - ioff = 0 - phys_state(lchnk)%t(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) - ioff = ioff + 1 - phys_state(lchnk)%u(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) - ioff = ioff + 1 - phys_state(lchnk)%v(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) - ioff = ioff + 1 - phys_state(lchnk)%omega(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) - ioff = ioff + 1 - phys_state(lchnk)%pdel(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) - - if (use_gw_front .or. use_gw_front_igw) then - ioff = ioff + 1 - pbuf_frontgf(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) - ioff = ioff + 1 - pbuf_frontga(icol,ilyr) = cbuffer(cpter(icol,ilyr)+ioff) - endif - - do m = 1, pcnst - phys_state(lchnk)%q (icol,ilyr,m) = cbuffer(cpter(icol,ilyr)+tsize-pcnst-1+m) - end do - + pbuf_vort4gw(icol, ilyr) = vort4gw_phys(icol, ilyr, lchnk) end do end do end do - - deallocate( bbuffer ) - deallocate( cbuffer ) - + deallocate(vort4gw_phys) end if + call t_stopf('dpcopy') ! Save the tracer fields input to physics package for calculating tendencies @@ -414,12 +346,13 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) ! Convert the physics output state into the dynamics input state. - use bndry_mod, only: bndry_exchange - use edge_mod, only: edgeVpack, edgeVunpack - use fvm_mapping, only: phys2dyn_forcings_fvm - use test_fvm_mapping, only: test_mapping_overwrite_tendencies - use test_fvm_mapping, only: test_mapping_output_mapped_tendencies - + use phys_grid, only: get_dyn_col_p, columns_on_task, get_chunk_info_p, phys_columns_on_task + use bndry_mod, only: bndry_exchange + use edge_mod, only: edgeVpack, edgeVunpack + use fvm_mapping, only: phys2dyn_forcings_fvm + use test_fvm_mapping, only: test_mapping_overwrite_tendencies + use test_fvm_mapping, only: test_mapping_output_mapped_tendencies + use dimensions_mod, only: use_cslam ! arguments type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state type(physics_tend), intent(inout), dimension(begchunk:endchunk) :: phys_tend @@ -428,29 +361,29 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) type(hybrid_t) :: hybrid ! LOCAL VARIABLES - integer :: ic , ncols ! index - type(element_t), pointer :: elem(:) ! pointer to dyn_in element array - integer :: ie, iep ! indices over elements - integer :: lchnk, icol, ilyr ! indices over chunks, columns, layers - - real (kind=r8), allocatable :: dp_phys(:,:,:) ! temp array to hold dp on physics grid - real (kind=r8), allocatable :: T_tmp(:,:,:) ! temp array to hold T - real (kind=r8), allocatable :: dq_tmp(:,:,:,:) ! temp array to hold q - real (kind=r8), allocatable :: uv_tmp(:,:,:,:) ! temp array to hold uv - integer :: ioff, m, i, j, k - integer :: pgcols(pcols), idmb1(1), idmb2(1), idmb3(1) - - integer :: tsize ! amount of data per grid point passed to physics - integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for packing data - integer, allocatable :: bpter(:,:) ! offsets into block buffer for unpacking data - - real (kind=r8), allocatable :: bbuffer(:), cbuffer(:) ! transpose buffers + integer :: ncols ! index + type(element_t), pointer :: elem(:) ! pointer to dyn_in element array + integer :: ie ! index for elements + integer :: col_ind ! index over columns + integer :: blk_ind(1) ! element offset + integer :: lchnk, icol, ilyr ! indices for chunk, column, layer + + real (kind=r8), allocatable :: dp_phys(:,:,:) ! temp array to hold dp on physics grid + real (kind=r8), allocatable :: T_tmp(:,:,:) ! temp array to hold T + real (kind=r8), allocatable :: dq_tmp(:,:,:,:) ! temp array to hold q + real (kind=r8), allocatable :: uv_tmp(:,:,:,:) ! temp array to hold uv + integer :: m, i, j, k real (kind=r8) :: factor integer :: num_trac integer :: nets, nete integer :: kptr, ii !---------------------------------------------------------------------------- + + if (.not. local_dp_map) then + call endrun('p_d_coupling: Weak scaling does not support load balancing') + end if + if (iam < par%nprocs) then elem => dyn_in%elem else @@ -484,127 +417,34 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) phys_state(lchnk)%q(icol,ilyr,m) = factor*phys_state(lchnk)%q(icol,ilyr,m) end if end do - end do - end do - call thermodynamic_consistency( & - phys_state(lchnk), phys_tend(lchnk), ncols, pver) - end do - - - call t_startf('pd_copy') - if (local_dp_map) then - - !$omp parallel do num_threads(max_num_threads) private (lchnk, ncols, pgcols, icol, idmb1, idmb2, idmb3, ie, ioff, ilyr, m) - do lchnk = begchunk, endchunk - ncols = get_ncols_p(lchnk) - call get_gcol_all_p(lchnk, pcols, pgcols) - - ! test code -- does nothing unless cpp macro debug_coupling is defined. - call test_mapping_overwrite_tendencies(phys_state(lchnk), phys_tend(lchnk), ncols, & - lchnk, q_prev(1:ncols,:,:,lchnk), dyn_in%fvm) - - do icol = 1, ncols - call get_gcol_block_d(pgcols(icol), 1, idmb1, idmb2, idmb3) - ie = idmb3(1) - ioff = idmb2(1) - - do ilyr = 1, pver - dp_phys(ioff,ilyr,ie) = phys_state(lchnk)%pdeldry(icol,ilyr) - T_tmp(ioff,ilyr,ie) = phys_tend(lchnk)%dtdt(icol,ilyr) - uv_tmp(ioff,1,ilyr,ie) = phys_tend(lchnk)%dudt(icol,ilyr) - uv_tmp(ioff,2,ilyr,ie) = phys_tend(lchnk)%dvdt(icol,ilyr) - do m = 1, pcnst - dq_tmp(ioff,ilyr,m,ie) = (phys_state(lchnk)%q(icol,ilyr,m) - & - q_prev(icol,ilyr,m,lchnk)) - end do - end do end do end do + end do - else ! not local map - - tsize = 4 + pcnst - - allocate(bbuffer(tsize*block_buf_nrecs)) - allocate(cbuffer(tsize*chunk_buf_nrecs)) - - !$omp parallel do num_threads(max_num_threads) private (lchnk, ncols, cpter, i, icol, ilyr, m) - do lchnk = begchunk, endchunk - ncols = get_ncols_p(lchnk) - - call test_mapping_overwrite_tendencies(phys_state(lchnk), phys_tend(lchnk), ncols, lchnk, & - q_prev(1:ncols,:,:,lchnk), dyn_in%fvm) - - call chunk_to_block_send_pters(lchnk, pcols, pver+1, tsize, cpter) - - do i = 1, ncols - cbuffer(cpter(i,0):cpter(i,0)+2+pcnst) = 0.0_r8 + 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, phys_columns_on_task + call get_dyn_col_p(col_ind, ie, blk_ind) + call get_chunk_info_p(col_ind, lchnk, icol) + + ! test code -- does nothing unless cpp macro debug_coupling is defined. + call test_mapping_overwrite_tendencies(phys_state(lchnk), & + phys_tend(lchnk), ncols, lchnk, q_prev(1:ncols,:,:,lchnk), & + dyn_in%fvm) + + do ilyr = 1, pver + dp_phys(blk_ind(1),ilyr,ie) = phys_state(lchnk)%pdeldry(icol,ilyr) + T_tmp(blk_ind(1),ilyr,ie) = phys_tend(lchnk)%dtdt(icol,ilyr) + uv_tmp(blk_ind(1),1,ilyr,ie) = phys_tend(lchnk)%dudt(icol,ilyr) + uv_tmp(blk_ind(1),2,ilyr,ie) = phys_tend(lchnk)%dvdt(icol,ilyr) + do m = 1, pcnst + dq_tmp(blk_ind(1),ilyr,m,ie) = & + (phys_state(lchnk)%q(icol,ilyr,m) - q_prev(icol,ilyr,m,lchnk)) end do - - do icol = 1, ncols - do ilyr = 1, pver - cbuffer(cpter(icol,ilyr)) = phys_tend(lchnk)%dtdt(icol,ilyr) - cbuffer(cpter(icol,ilyr)+1) = phys_tend(lchnk)%dudt(icol,ilyr) - cbuffer(cpter(icol,ilyr)+2) = phys_tend(lchnk)%dvdt(icol,ilyr) - cbuffer(cpter(icol,ilyr)+3) = phys_state(lchnk)%pdeldry(icol,ilyr) - do m = 1, pcnst - cbuffer(cpter(icol,ilyr)+3+m) = (phys_state(lchnk)%q(icol,ilyr,m) - & - q_prev(icol,ilyr,m,lchnk)) - end do - end do - end do end do - - call t_barrierf('sync_chk_to_blk', mpicom) - call t_startf ('chunk_to_block') - call transpose_chunk_to_block(tsize, cbuffer, bbuffer) - call t_stopf ('chunk_to_block') - - if (iam < par%nprocs) then - - if (fv_nphys > 0) then - allocate(bpter(fv_nphys*fv_nphys,0:pver)) - else - allocate(bpter(npsq,0:pver)) - end if - - !$omp parallel do num_threads(max_num_threads) private (ie, bpter, icol, ilyr, m, ncols) - do ie = 1, nelemd - - if (fv_nphys > 0) then - call chunk_to_block_recv_pters(elem(ie)%GlobalID, fv_nphys*fv_nphys, & - pver+1, tsize, bpter) - ncols = fv_nphys*fv_nphys - else - call chunk_to_block_recv_pters(elem(ie)%GlobalID, npsq, & - pver+1, tsize, bpter) - ncols = elem(ie)%idxP%NumUniquePts - end if - - do icol = 1, ncols - do ilyr = 1, pver - T_tmp (icol,ilyr,ie) = bbuffer(bpter(icol,ilyr)) - uv_tmp (icol,1,ilyr,ie) = bbuffer(bpter(icol,ilyr)+1) - uv_tmp (icol,2,ilyr,ie) = bbuffer(bpter(icol,ilyr)+2) - dp_phys (icol,ilyr,ie) = bbuffer(bpter(icol,ilyr)+3) - - do m = 1, pcnst - dq_tmp(icol,ilyr,m,ie) = bbuffer(bpter(icol,ilyr)+3+m) - end do - end do - end do - end do - deallocate(bpter) - - end if - - deallocate( bbuffer ) - deallocate( cbuffer ) - - end if + end do call t_stopf('pd_copy') - if (iam < par%nprocs) then if (fv_nphys > 0) then @@ -627,8 +467,9 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) !JMD hybrid = config_thread_region(par,'horizontal') hybrid = config_thread_region(par,'serial') call get_loop_ranges(hybrid,ibeg=nets,iend=nete) - - ! high-order mapping of ft and fm (and fq if no cslam) using fvm technology + ! + ! high-order mapping of ft and fm using fvm technology + ! call t_startf('phys2dyn') call phys2dyn_forcings_fvm(elem, dyn_in%fvm, hybrid,nets,nete,ntrac==0, tl_f, tl_qdp) call t_stopf('phys2dyn') @@ -674,19 +515,20 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) dyn_in%elem(ie)%derived%FT(:,:,k) = & dyn_in%elem(ie)%derived%FT(:,:,k) * & dyn_in%elem(ie)%spheremp(:,:) - do m = 1, qsize - dyn_in%elem(ie)%derived%FQ(:,:,k,m) = & - dyn_in%elem(ie)%derived%FQ(:,:,k,m) * & - dyn_in%elem(ie)%spheremp(:,:) - end do end do end if kptr = 0 call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FM(:,:,:,:), 2*nlev, kptr, ie) kptr = kptr + 2*nlev call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FT(:,:,:), nlev, kptr, ie) - kptr = kptr + nlev - call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + if (.not. use_cslam) then + ! + ! if using CSLAM qdp is being overwritten with CSLAM values in the dynamics + ! so no need to do boundary exchange of tracer tendency on GLL grid here + ! + kptr = kptr + nlev + call edgeVpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + end if end do if (iam < par%nprocs) then @@ -699,7 +541,9 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) kptr = kptr + 2*nlev call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FT(:,:,:), nlev, kptr, ie) kptr = kptr + nlev - call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + if (.not. use_cslam) then + call edgeVunpack(edgebuf, dyn_in%elem(ie)%derived%FQ(:,:,:,:), nlev*qsize, kptr, ie) + end if if (fv_nphys > 0) then do k = 1, nlev dyn_in%elem(ie)%derived%FM(:,:,1,k) = & @@ -711,11 +555,6 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) dyn_in%elem(ie)%derived%FT(:,:,k) = & dyn_in%elem(ie)%derived%FT(:,:,k) * & dyn_in%elem(ie)%rspheremp(:,:) - do m = 1, qsize - dyn_in%elem(ie)%derived%FQ(:,:,k,m) = & - dyn_in%elem(ie)%derived%FQ(:,:,k,m) * & - dyn_in%elem(ie)%rspheremp(:,:) - end do end do end if end do @@ -737,47 +576,39 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) ! mixing ratios are converted to a wet basis. Initialize geopotential heights. ! Finally compute energy and water column integrals of the physics input state. - use constituents, only: qmin - use physconst, only: cpair, gravit, zvir, cappa, rairv, physconst_update - use shr_const_mod, only: shr_const_rwv - use phys_control, only: waccmx_is - use geopotential, only: geopotential_t - use physics_types, only: set_state_pdry, set_wet_to_dry - use check_energy, only: check_energy_timestep_init - use hycoef, only: hyai, hybi, ps0 - use shr_vmath_mod, only: shr_vmath_log - use gmean_mod, only: gmean - use qneg_module, only: qneg3 - use dyn_comp, only: ixo, ixo2, ixh, ixh2 - + use constituents, only: qmin + use physconst, only: gravit, zvir + use cam_thermo, only: cam_thermo_dry_air_update, cam_thermo_water_update + use air_composition, only: thermodynamic_active_species_num + use air_composition, only: thermodynamic_active_species_idx + use air_composition, only: cpairv, rairv, cappav, dry_air_species_num + use shr_const_mod, only: shr_const_rwv + use phys_control, only: waccmx_is + use geopotential, only: geopotential_t + use static_energy, only: update_dry_static_energy_run + use check_energy, only: check_energy_timestep_init + use hycoef, only: hyai, ps0 + use shr_vmath_mod, only: shr_vmath_log + use qneg_module, only: qneg3 + use dyn_tests_utils, only: vc_dry_pressure + use shr_kind_mod, only: shr_kind_cx ! arguments type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend - type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) ! local variables integer :: lchnk - real(r8) :: qbot ! bottom level q before change - real(r8) :: qbotm1 ! bottom-1 level q before change - real(r8) :: dqreq ! q change at pver-1 required to remove q0) then + call physics_cnst_limit( phys_state(lchnk) ) + !----------------------------------------------------------------------------- + ! Call cam_thermo_dry_air_update to compute cpairv, rairv, mbarv, and cappav as + ! constituent dependent variables. + ! Compute molecular viscosity(kmvis) and conductivity(kmcnd). + ! Fill local zvirv variable; calculated for WACCM-X. + !----------------------------------------------------------------------------- + call cam_thermo_dry_air_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol) + zvirv(:,:) = shr_const_rwv / rairv(:,:,lchnk) -1._r8 + else + zvirv(:,:) = zvir + end if + ! + ! update cp_dycore in module air_composition. + ! (note: at this point q is dry) + ! + call cam_thermo_water_update(phys_state(lchnk)%q(1:ncol,:,:), lchnk, ncol, vc_dry_pressure) + do k = 1, nlev + do i = 1, ncol + phys_state(lchnk)%exner(i,k) = (phys_state(lchnk)%pint(i,pver+1) & + / phys_state(lchnk)%pmid(i,k))**cappav(i,k,lchnk) + end do + end do + ! + ! CAM physics: water tracers are moist; the rest dry + ! + factor_array(1:ncol,1:nlev) = 1._r8/factor_array(1:ncol,1:nlev) do m = 1,pcnst if (cnst_type(m) == 'wet') then do k = 1, nlev @@ -871,69 +729,22 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) end do end if end do - !------------------------------------------------------------ - ! Ensure O2 + O + H (N2) mmr greater than one. - ! Check for unusually large H2 values and set to lower value. - !------------------------------------------------------------ - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - - do i=1,ncol - do k=1,pver - - if (phys_state(lchnk)%q(i,k,ixo) < mmrMin) phys_state(lchnk)%q(i,k,ixo) = mmrMin - if (phys_state(lchnk)%q(i,k,ixo2) < mmrMin) phys_state(lchnk)%q(i,k,ixo2) = mmrMin - - mmrSum_O_O2_H = phys_state(lchnk)%q(i,k,ixo)+phys_state(lchnk)%q(i,k,ixo2)+phys_state(lchnk)%q(i,k,ixh) - - if ((1._r8-mmrMin-mmrSum_O_O2_H) < 0._r8) then - - phys_state(lchnk)%q(i,k,ixo) = phys_state(lchnk)%q(i,k,ixo) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H - - phys_state(lchnk)%q(i,k,ixo2) = phys_state(lchnk)%q(i,k,ixo2) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H - - phys_state(lchnk)%q(i,k,ixh) = phys_state(lchnk)%q(i,k,ixh) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H - - endif - - if(phys_state(lchnk)%q(i,k,ixh2) .gt. 6.e-5_r8) then - phys_state(lchnk)%q(i,k,ixh2) = 6.e-5_r8 - endif - - end do - end do - endif - - !----------------------------------------------------------------------------- - ! Call physconst_update to compute cpairv, rairv, mbarv, and cappav as - ! constituent dependent variables. - ! Compute molecular viscosity(kmvis) and conductivity(kmcnd). - ! Fill local zvirv variable; calculated for WACCM-X. - !----------------------------------------------------------------------------- - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - call physconst_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol) - zvirv(:,:) = shr_const_rwv / rairv(:,:,lchnk) -1._r8 - else - zvirv(:,:) = zvir - endif - - ! Compute initial geopotential heights - based on full pressure - call geopotential_t (phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint , & - phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & - phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,1), rairv(:,:,lchnk), gravit, zvirv , & - phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol ) - - ! Compute initial dry static energy, include surface geopotential - do k = 1, pver - do i = 1, ncol - phys_state(lchnk)%s(i,k) = cpair*phys_state(lchnk)%t(i,k) & - + gravit*phys_state(lchnk)%zm(i,k) + phys_state(lchnk)%phis(i) - end do - end do ! Ensure tracers are all positive call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , & 1, pcnst, qmin ,phys_state(lchnk)%q) + ! Compute initial geopotential heights - based on full pressure + call geopotential_t(phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint, & + phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & + phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,:), rairv(:,:,lchnk), gravit, zvirv , & + phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol) + ! Compute initial dry static energy, include surface geopotential + call update_dry_static_energy_run(pver, gravit, phys_state(lchnk)%t(1:ncol,:), & + phys_state(lchnk)%zm(1:ncol,:), & + phys_state(lchnk)%phis(1:ncol), & + phys_state(lchnk)%s(1:ncol,:), & + cpairv(1:ncol,:,lchnk), errflg, errmsg) ! Compute energy and water integrals of input state pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) call check_energy_timestep_init(phys_state(lchnk), phys_tend(lchnk), pbuf_chnk) @@ -942,40 +753,4 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) end do ! lchnk end subroutine derived_phys_dry - -!========================================================================================= - -subroutine thermodynamic_consistency(phys_state, phys_tend, ncols, pver) - ! - ! Adjust the physics temperature tendency for thermal energy consistency with the - ! dynamics. - ! Note: mixing ratios are assumed to be dry. - ! - use dimensions_mod, only: lcp_moist - use physconst, only: get_cp - use control_mod, only: phys_dyn_cp - use physconst, only: cpair - - type(physics_state), intent(in) :: phys_state - type(physics_tend ), intent(inout) :: phys_tend - integer, intent(in) :: ncols, pver - - real(r8):: inv_cp(ncols,pver) - !---------------------------------------------------------------------------- - - if (lcp_moist.and.phys_dyn_cp==1) then - ! - ! scale temperature tendency so that thermal energy increment from physics - ! matches SE (not taking into account dme adjust) - ! - ! note that if lcp_moist=.false. then there is thermal energy increment - ! consistency (not taking into account dme adjust) - ! - call get_cp(1,ncols,1,pver,1,1,pcnst,phys_state%q(1:ncols,1:pver,:),.true.,inv_cp) - phys_tend%dtdt(1:ncols,1:pver) = phys_tend%dtdt(1:ncols,1:pver)*cpair*inv_cp - end if -end subroutine thermodynamic_consistency - -!========================================================================================= - end module dp_coupling diff --git a/src/dynamics/se/dp_mapping.F90 b/src/dynamics/se/dp_mapping.F90 index e97efcd8a9..08ac67380e 100644 --- a/src/dynamics/se/dp_mapping.F90 +++ b/src/dynamics/se/dp_mapping.F90 @@ -12,8 +12,10 @@ module dp_mapping save public :: dp_init - public :: dp_reoorder + public :: dp_reorder public :: dp_write + public :: dp_allocate + public :: dp_deallocate ! Total number of physics points per spectral element ! no physgrid: nphys_pts = npsq (physics on GLL grid) @@ -43,14 +45,11 @@ module dp_mapping contains subroutine dp_init(elem,fvm) - use cam_abortutils, only: endrun - use dimensions_mod, only: nelemd,nc,irecons_tracer - use element_mod, only: element_t - use spmd_utils, only: masterproc - use cam_logfile, only: iulog - use thread_mod, only: horz_num_threads + use dimensions_mod, only: nelemd, nc, irecons_tracer + use element_mod, only: element_t + use spmd_utils, only: masterproc + use cam_logfile, only: iulog - implicit none type(element_t) , dimension(nelemd), intent(in) :: elem type (fvm_struct), dimension(nelemd), intent(in) :: fvm @@ -75,8 +74,6 @@ subroutine dp_init(elem,fvm) weights_all_phys2fvm,weights_eul_index_all_phys2fvm,weights_lgr_index_all_phys2fvm,& jall_fvm2phys,jall_phys2fvm) - call dp_replicated_init(elem) - if (masterproc) then write(iulog, *) 'dp_init: Initialized phys2fvm/fvm2phys mapping vars' end if @@ -84,40 +81,35 @@ subroutine dp_init(elem,fvm) end if end subroutine dp_init - subroutine dp_reoorder(before,after) + subroutine dp_reorder(before, after) use cam_abortutils, only: endrun use dimensions_mod, only: nelem - !XXgoldyXX use cam_logfile, only: iulog use spmd_utils, only: masterproc use shr_sys_mod, only: shr_sys_flush - !XXgoldyXX - implicit none + real(r8), dimension(fv_nphys*fv_nphys,*), intent(in) :: before real(r8), dimension(fv_nphys*fv_nphys,*), intent(out) :: after integer :: ie ! begin do ie = 1,nelem - !XXgoldyXX if (dp_gid(ie) < 0) then if (masterproc) then write(iulog,*) 'ie =',ie,', dp_gid(ie) =',dp_gid(ie) call shr_sys_flush(iulog) end if - call endrun('Bad element remap in dp_reoorder') + call endrun('Bad element remap in dp_reorder') end if - !XXgoldyXX after(:,dp_gid(ie)) = before(:,ie) end do - end subroutine dp_reoorder + end subroutine dp_reorder !!! - subroutine dp_replicated_init(elem) + subroutine dp_allocate(elem) use dimensions_mod, only: nelem, nelemd use element_mod, only: element_t - use cam_abortutils, only: endrun use spmd_utils, only: masterproc, masterprocid, npes use spmd_utils, only: mpicom, mpi_integer @@ -162,10 +154,14 @@ subroutine dp_replicated_init(elem) end if call mpi_bcast(dp_gid,nelem,mpi_integer,masterprocid,mpicom,ierror) call mpi_bcast(dp_owner,nelem,mpi_integer,masterprocid,mpicom,ierror) - end subroutine dp_replicated_init + end subroutine dp_allocate !!! + subroutine dp_deallocate() + deallocate(dp_gid) + deallocate(dp_owner) + end subroutine dp_deallocate !!! @@ -183,20 +179,18 @@ subroutine dp_write(elem, fvm, grid_format, filename_in) use shr_sys_mod, only: shr_sys_flush use dimensions_mod, only: ne use coordinate_systems_mod, only: cart2spherical - + ! Inputs type(element_t), intent(in) :: elem(:) type (fvm_struct), intent(in) :: fvm(:) character(len=*), intent(in) :: grid_format character(len=*), intent(in) :: filename_in - + real(r8), parameter :: rad2deg = 180._r8/pi - + ! Local variables integer :: i, ie, ierror, j, status, ivtx integer :: grid_corners_id, grid_rank_id, grid_size_id - character(len=256) :: errormsg - character(len=shr_kind_cl) :: filename integer :: ncid integer :: grid_dims_id, grid_area_id, grid_center_lat_id integer :: grid_center_lon_id, grid_corner_lat_id @@ -204,6 +198,8 @@ subroutine dp_write(elem, fvm, grid_format, filename_in) integer :: gridsize integer :: IOrootID logical :: IOroot + character(len=SHR_KIND_CL) :: errormsg + character(len=SHR_KIND_CL) :: filename integer,allocatable,dimension(:) :: displs,recvcount real(r8), dimension(fv_nphys, fv_nphys, nelemd, 4, 2) :: corners @@ -228,7 +224,7 @@ subroutine dp_write(elem, fvm, grid_format, filename_in) call endrun(errormsg) end if end if - + ! Create the NetCDF file if (len_trim(filename_in) == 0) then write(filename, '(3(a,i0),3a)') "ne", ne, "np", np, ".pg", fv_nphys, & @@ -240,11 +236,11 @@ subroutine dp_write(elem, fvm, grid_format, filename_in) if (status /= nf90_noerr) then call endrun("dp_write: "//trim(nf90_strerror(status))) end if - + ! PIO_put_var puts from its root node, find that (so we do our work there) IOrootID = masterprocid IOroot = masterproc - + ! Allocate workspace and calculate PE displacement information if (IOroot) then allocate(displs(npes)) @@ -416,8 +412,9 @@ subroutine dp_write(elem, fvm, grid_format, filename_in) end do call mpi_gatherv(lwork, size(lwork), mpi_real8, recvbuf, recvcount, & displs, mpi_real8, IOrootID, mpicom, ierror) + call dp_allocate(elem) if (IOroot) then - call dp_reoorder(recvbuf, gwork(1,:)) + call dp_reorder(recvbuf, gwork(1,:)) status = nf90_put_var(ncid, grid_area_id, gwork(1,:)) if (status /= nf90_noerr) then write(iulog, *) 'dp_write: Error writing variable grid_area' @@ -431,7 +428,7 @@ subroutine dp_write(elem, fvm, grid_format, filename_in) call mpi_gatherv(lwork, size(lwork), mpi_real8, recvbuf, recvcount, & displs, mpi_real8, IOrootID, mpicom, ierror) if (IOroot) then - call dp_reoorder(recvbuf, gwork(1,:)) + call dp_reorder(recvbuf, gwork(1,:)) status = nf90_put_var(ncid, grid_center_lat_id, gwork(1,:)) if (status /= nf90_noerr) then write(iulog, *) 'dp_write: Error writing variable grid_center_lat' @@ -446,7 +443,7 @@ subroutine dp_write(elem, fvm, grid_format, filename_in) call mpi_gatherv(lwork, size(lwork), mpi_real8, recvbuf, recvcount, & displs, mpi_real8, IOrootID, mpicom, ierror) if (IOroot) then - call dp_reoorder(recvbuf, gwork(1,:)) + call dp_reorder(recvbuf, gwork(1,:)) status = nf90_put_var(ncid, grid_center_lon_id, gwork(1,:)) if (status /= nf90_noerr) then write(iulog, *) 'dp_write: Error writing variable grid_center_lon' @@ -473,7 +470,7 @@ subroutine dp_write(elem, fvm, grid_format, filename_in) call mpi_gatherv(corners(:,:,:,ivtx,1), size(corners(:,:,:,ivtx,1)), mpi_real8, recvbuf, recvcount, & displs, mpi_real8, IOrootID, mpicom, ierror) if (IOroot) then - call dp_reoorder(recvbuf, gwork(ivtx,:)) + call dp_reorder(recvbuf, gwork(ivtx,:)) end if end do if (IOroot) then @@ -489,9 +486,10 @@ subroutine dp_write(elem, fvm, grid_format, filename_in) call mpi_gatherv(corners(:,:,:,ivtx,2), size(corners(:,:,:,ivtx,2)), mpi_real8, recvbuf, recvcount, & displs, mpi_real8, IOrootID, mpicom, ierror) if (IOroot) then - call dp_reoorder(recvbuf, gwork(ivtx,:)) + call dp_reorder(recvbuf, gwork(ivtx,:)) end if end do + call dp_deallocate() if (IOroot) then status = nf90_put_var(ncid, grid_corner_lon_id, gwork) if (status /= nf90_noerr) then @@ -565,25 +563,25 @@ subroutine fvm2phys_init(elem,fvm,fvm_nc,phys_nc,irecons,& integer , dimension(jmax_segments_cell,2) :: weights_eul_index_cell integer :: jcollect_cell,ie real(kind=r8), dimension(phys_nc,phys_nc) :: phys_area, factor - real(kind=r8), dimension(fvm_nc,fvm_nc) :: fvm_area, facfvm + real(kind=r8), dimension(fvm_nc,fvm_nc) :: fvm_area xgno_phys(0) = -1D20; xgno_phys(phys_nc+2) = 1D20 xgno_fvm(0) = -1D20; xgno_fvm(fvm_nc+2) = 1D20 - do ie=1,nelemd + do ie=1,nelemd dalpha = abs(elem(ie)%corners(1)%x-elem(ie)%corners(2)%x)/phys_nc !in alpha dbeta = abs(elem(ie)%corners(1)%y-elem(ie)%corners(4)%y)/phys_nc !in beta do i=1,phys_nc+1 xgno_phys(i) = tan(elem(ie)%corners(1)%x+(i-1)*dalpha) ygno_phys(i) = tan(elem(ie)%corners(1)%y+(i-1)*dbeta ) end do - + dalpha = abs(elem(ie)%corners(1)%x-elem(ie)%corners(2)%x)/fvm_nc !in alpha dbeta = abs(elem(ie)%corners(1)%y-elem(ie)%corners(4)%y)/fvm_nc !in beta do i=1,fvm_nc+1 xgno_fvm(i) = tan(elem(ie)%corners(1)%x+(i-1)*dalpha) ygno_fvm(i) = tan(elem(ie)%corners(1)%y+(i-1)*dbeta ) end do - + ! ! compute area using line-integrals ! @@ -600,9 +598,9 @@ subroutine fvm2phys_init(elem,fvm,fvm_nc,phys_nc,irecons,& ! I_00(xgno_fvm(i ),ygno_fvm(j )) - I_00(xgno_fvm(i+1),ygno_fvm(j ))) ! end do ! end do - + gauss_weights = 0.0D0; abscissae=0.0D0!not used since line-segments are parallel to coordinate - + jall_fvm2phys(ie)=1 do j=1,phys_nc do i=1,phys_nc @@ -610,17 +608,17 @@ subroutine fvm2phys_init(elem,fvm,fvm_nc,phys_nc,irecons,& xcell(2) = xgno_phys(i) ; ycell(2) = ygno_phys(j+1) xcell(3) = xgno_phys(i+1); ycell(3) = ygno_phys(j+1) xcell(4) = xgno_phys(i+1); ycell(4) = ygno_phys(j) - + call compute_weights_cell(nvertex,.true.,& xcell,ycell,i,j,irecons,xgno_fvm,ygno_fvm,0,fvm_nc+2,& 1,fvm_nc+1,1,fvm_nc+1,& ngpc,gauss_weights,abscissae,& weights_cell,weights_eul_index_cell,jcollect_cell,jmax_segments_cell) - + if (jcollect_cell>0) then weights_all_fvm2phys(jall_fvm2phys(ie):jall_fvm2phys(ie)+jcollect_cell-1,:,ie) = & - weights_cell(1:jcollect_cell,:)!/fvm(ie)%area_sphere_physgrid(i,j)!da_phys(i,j) - + weights_cell(1:jcollect_cell,:)!/fvm(ie)%area_sphere_physgrid(i,j)!da_phys(i,j) + weights_eul_index_all_fvm2phys(jall_fvm2phys(ie):jall_fvm2phys(ie)+jcollect_cell-1,:,ie) = & weights_eul_index_cell(1:jcollect_cell,:) weights_lgr_index_all_fvm2phys(jall_fvm2phys(ie):jall_fvm2phys(ie)+jcollect_cell-1,1,ie) = i @@ -643,7 +641,7 @@ subroutine fvm2phys_init(elem,fvm,fvm_nc,phys_nc,irecons,& i = weights_lgr_index_all_fvm2phys(h,1,ie); j = weights_lgr_index_all_fvm2phys(h,2,ie) weights_all_fvm2phys(h,1,ie) = weights_all_fvm2phys(h,1,ie)*factor(i,j) end do - + jall_phys2fvm(ie)=1 do j=1,fvm_nc do i=1,fvm_nc @@ -651,17 +649,17 @@ subroutine fvm2phys_init(elem,fvm,fvm_nc,phys_nc,irecons,& xcell(2) = xgno_fvm(i) ; ycell(2) = ygno_fvm(j+1) xcell(3) = xgno_fvm(i+1); ycell(3) = ygno_fvm(j+1) xcell(4) = xgno_fvm(i+1); ycell(4) = ygno_fvm(j) - + call compute_weights_cell(nvertex,.true.,& xcell,ycell,i,j,irecons,xgno_phys,ygno_phys,0,phys_nc+2,& 1,phys_nc+1,1,phys_nc+1,& ngpc,gauss_weights,abscissae,& weights_cell,weights_eul_index_cell,jcollect_cell,jmax_segments_cell) - + if (jcollect_cell>0) then weights_all_phys2fvm(jall_phys2fvm(ie):jall_phys2fvm(ie)+jcollect_cell-1,:,ie) & = weights_cell(1:jcollect_cell,:)!/fvm(ie)%area_sphere(i,j)!da_fvm(i,j) - + weights_eul_index_all_phys2fvm(jall_phys2fvm(ie):jall_phys2fvm(ie)+jcollect_cell-1,:,ie) = & weights_eul_index_cell(1:jcollect_cell,:) weights_lgr_index_all_phys2fvm(jall_phys2fvm(ie):jall_phys2fvm(ie)+jcollect_cell-1,1,ie) = i diff --git a/src/dynamics/se/dycore/control_mod.F90 b/src/dynamics/se/dycore/control_mod.F90 index d5fc4abe81..6d92e66d7d 100644 --- a/src/dynamics/se/dycore/control_mod.F90 +++ b/src/dynamics/se/dycore/control_mod.F90 @@ -16,6 +16,7 @@ module control_mod integer, public :: rk_stage_user = 0 ! number of RK stages to use integer, public :: ftype = 2 ! Forcing Type integer, public :: ftype_conserve = 1 !conserve momentum (dp*u) + integer, public :: dribble_in_rsplit_loop = 0 integer, public :: statediag_numtrac = 3 integer, public :: qsplit = 1 ! ratio of dynamics tsteps to tracer tsteps @@ -23,9 +24,6 @@ module control_mod ! every rsplit tracer timesteps logical, public :: variable_nsplit=.false. - integer, public :: phys_dyn_cp = 0 !=0; no thermal energy scaling of T increment - !=1; scale increment for cp consistency between dynamics and physics - logical, public :: refined_mesh integer, public :: vert_remap_q_alg = 10 @@ -63,10 +61,25 @@ module control_mod ! (only used for variable viscosity, recommend 1.9 in namelist) real (kind=r8), public :: nu = 7.0D5 ! viscosity (momentum equ) real (kind=r8), public :: nu_div = -1 ! viscsoity (momentum equ, div component) - real (kind=r8), public :: nu_s = -1 ! default = nu T equ. viscosity + real (kind=r8), public :: nu_t = -1 ! default = nu T equ. viscosity real (kind=r8), public :: nu_q = -1 ! default = nu tracer viscosity real (kind=r8), public :: nu_p = 0.0D5 ! default = 0 ps equ. viscosity real (kind=r8), public :: nu_top = 0.0D5 ! top-of-the-model viscosity + + ! + ! Del4 sponge layer diffusion + ! + ! Divergence damping hyperviscosity coefficient nu_div [m^4/s] for u,v is increased to + ! nu_div*sponge_del4_nu_div_fac following a hyperbolic tangent function + ! centered around pressure at vertical index sponge_del4_lev + ! + ! Similar for sponge_del4_nu_fac + ! + real(r8), public :: sponge_del4_nu_fac + real(r8), public :: sponge_del4_nu_div_fac + integer , public :: sponge_del4_lev + + integer, public :: hypervis_subcycle=1 ! number of subcycles for hyper viscsosity timestep integer, public :: hypervis_subcycle_sponge=1 ! number of subcycles for hyper viscsosity timestep in sponge integer, public :: hypervis_subcycle_q=1 ! number of subcycles for hyper viscsosity timestep on TRACERS @@ -106,17 +119,13 @@ module control_mod integer, public, parameter :: nwest = 7 integer, public, parameter :: neast = 8 - ! - ! parameters for sponge layer Rayleigh damping - ! - real(r8), public :: raytau0 - real(r8), public :: raykrange - integer, public :: rayk0 ! ! molecular diffusion ! real(r8), public :: molecular_diff = -1.0_r8 integer, public :: vert_remap_uvTq_alg, vert_remap_tracer_alg - + + + integer, public :: pgf_formulation = -1 !PGF formulation - see prim_advance_mod.F90 end module control_mod diff --git a/src/dynamics/se/dycore/dimensions_mod.F90 b/src/dynamics/se/dycore/dimensions_mod.F90 index a012c76148..eb1564600c 100644 --- a/src/dynamics/se/dycore/dimensions_mod.F90 +++ b/src/dynamics/se/dycore/dimensions_mod.F90 @@ -15,7 +15,6 @@ module dimensions_mod #else integer, parameter :: ntrac_d = 0 ! No fvm tracers if CSLAM is off #endif - ! ! The variables below hold indices of water vapor and condensate loading tracers as well as ! associated heat capacities (initialized in dyn_init): @@ -31,25 +30,15 @@ module dimensions_mod ! character(len=16), allocatable, public :: cnst_name_gll(:) ! constituent names for SE tracers character(len=128), allocatable, public :: cnst_longname_gll(:) ! long name of SE tracers - ! - !moist cp in energy conversion term - ! - ! .false.: force dycore to use cpd (cp dry) instead of moist cp - ! .true. : use moist cp in dycore - ! - logical , public :: lcp_moist = .true. - + integer, parameter, public :: np = NP integer, parameter, public :: nc = 3 !cslam resolution integer , public :: fv_nphys !physics-grid resolution - the "MAX" is so that the code compiles with NC=0 - integer :: ntrac = 0 !ntrac is set in dyn_comp - integer :: qsize = 0 !qsize is set in dyn_comp + integer :: ntrac = 0 !ntrac is set in dyn_comp + logical, public :: use_cslam = .false. !logical for CSLAM + integer :: qsize = 0 !qsize is set in dyn_comp ! - ! hyperviscosity is applied on approximate pressure levels - ! Similar to CAM-EUL; see CAM5 scietific documentation (Note TN-486), equation (3.09), page 58. - ! - logical, public :: hypervis_dynamic_ref_state = .false. ! fvm dimensions: logical, public :: lprint!for debugging integer, parameter, public :: ngpc=3 !number of Gausspoints for the fvm integral approximation !phl change from 4 @@ -73,8 +62,8 @@ module dimensions_mod integer, allocatable, public :: kord_tr(:), kord_tr_cslam(:) real(r8), public :: nu_scale_top(PLEV)! scaling of del2 viscosity in sopnge layer (initialized in dyn_comp) - real(r8), public :: nu_lev(PLEV) - real(r8), public :: otau(PLEV) + real(r8), public :: nu_lev(PLEV) ! level dependent del4 (u,v) damping + real(r8), public :: nu_t_lev(PLEV) ! level depedendet del4 T damping integer, public :: ksponge_end ! sponge is active k=1,ksponge_end real(r8), public :: nu_div_lev(PLEV) = 1.0_r8 ! scaling of viscosity in sponge layer ! (set in prim_state; if applicable) @@ -84,7 +73,6 @@ module dimensions_mod real(r8), public :: km_sponge_factor(PLEV) !scaling for molecular diffusion (when used as sponge) real(r8), public :: kmvisi_ref(PLEV+1) !reference profiles for molecular diffusion real(r8), public :: kmcndi_ref(PLEV+1) !reference profiles for molecular diffusion - real(r8), public :: rhoi_ref(PLEV+1) !reference profiles for rho integer, public :: nhc_phys diff --git a/src/dynamics/se/dycore/element_mod.F90 b/src/dynamics/se/dycore/element_mod.F90 index 422799b8ef..2e758727db 100644 --- a/src/dynamics/se/dycore/element_mod.F90 +++ b/src/dynamics/se/dycore/element_mod.F90 @@ -25,9 +25,8 @@ module element_mod real (kind=r8) :: T (np,np,nlev,timelevels) ! temperature real (kind=r8) :: dp3d (np,np,nlev,timelevels) ! dry delta p on levels real (kind=r8) :: psdry (np,np) ! dry surface pressure - real (kind=r8) :: phis (np,np) ! surface geopotential (prescribed) - real (kind=r8) :: Qdp (np,np,nlev,qsize_d,2) ! Tracer mass - + real (kind=r8) :: phis (np,np) ! surface geopotential (prescribed) + real (kind=r8), allocatable :: Qdp(:,:,:,:,:) ! Tracer mass end type elem_state_t !___________________________________________________________________ @@ -43,20 +42,16 @@ module element_mod real (kind=r8) :: phi(np,np,nlev) ! geopotential real (kind=r8) :: omega(np,np,nlev) ! vertical velocity - ! semi-implicit diagnostics: computed in explict-component, reused in Helmholtz-component. - real (kind=r8) :: zeta(np,np,nlev) ! relative vorticity - real (kind=r8) :: div(np,np,nlev,timelevels) ! divergence - ! tracer advection fields used for consistency and limiters real (kind=r8) :: dp(np,np,nlev) ! for dp_tracers at physics timestep - real (kind=r8) :: divdp(np,np,nlev) ! divergence of dp - real (kind=r8) :: divdp_proj(np,np,nlev) ! DSSed divdp + real (kind=r8), allocatable :: divdp(:,:,:) ! divergence of dp + real (kind=r8), allocatable :: divdp_proj(:,:,:) ! DSSed divdp real (kind=r8) :: mass(MAX(qsize_d,ntrac_d)+9) ! total tracer mass for diagnostics ! forcing terms for CAM - real (kind=r8) :: FQ(np,np,nlev,qsize_d) ! tracer forcing + real (kind=r8), allocatable :: FQ(:,:,:,:) ! tracer forcing real (kind=r8) :: FM(np,np,2,nlev) ! momentum forcing - real (kind=r8) :: FDP(np,np,nlev) ! save full updated dp right after physics + real (kind=r8), allocatable :: FDP(:,:,:) ! save full updated dp right after physics real (kind=r8) :: FT(np,np,nlev) ! temperature forcing real (kind=r8) :: etadot_prescribed(np,np,nlevp) ! prescribed vertical tendency real (kind=r8) :: u_met(np,np,nlev) ! zonal component of prescribed meteorology winds @@ -74,6 +69,9 @@ module element_mod real (kind=r8) :: pecnd(np,np,nlev) ! pressure perturbation from condensate + ! reference profiles + real (kind=r8) :: T_ref(np,np,nlev) ! reference temperature + real (kind=r8) :: dp_ref(np,np,nlev) ! reference pressure level thickness end type derived_state_t !___________________________________________________________________ diff --git a/src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 b/src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 index ede1f44059..5da18d76b8 100644 --- a/src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 +++ b/src/dynamics/se/dycore/fvm_consistent_se_cslam.F90 @@ -6,7 +6,7 @@ module fvm_consistent_se_cslam use cam_abortutils, only: endrun use cam_logfile, only: iulog - use time_mod, only: timelevel_t + use se_dyn_time_mod, only: timelevel_t use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use hybrid_mod, only: hybrid_t, config_thread_region, get_loop_ranges, threadOwnsVertLevel @@ -44,7 +44,7 @@ subroutine run_consistent_se_cslam(elem,fvm,hybrid,dt_fvm,tl,nets,nete,hvcoord,& use thread_mod , only: vert_num_threads, omp_set_nested implicit none type (element_t) , intent(inout) :: elem(:) - type (fvm_struct) , intent(inout) :: fvm(:) + type (fvm_struct), target , intent(inout) :: fvm(:) type (hybrid_t) , intent(in) :: hybrid ! distributed parallel structure (shared) type (TimeLevel_t) , intent(in) :: tl ! time level struct type (hvcoord_t) , intent(in) :: hvcoord @@ -71,7 +71,9 @@ subroutine run_consistent_se_cslam(elem,fvm,hybrid,dt_fvm,tl,nets,nete,hvcoord,& integer :: region_num_threads logical :: inJetCall logical :: ActiveJetThread - + + real(r8), pointer :: fcube(:,:,:,:) + real(r8), pointer :: spherecentroid(:,:,:) llimiter = .true. @@ -152,22 +154,26 @@ subroutine run_consistent_se_cslam(elem,fvm,hybrid,dt_fvm,tl,nets,nete,hvcoord,& !call t_stopf('fvm:orthogonal_swept_areas') do ie=nets,nete + ! Intel compiler version 2023.0.0 on derecho had significant slowdown on subroutine interface without + ! these pointers. + fcube => fvm(ie)%c(:,:,:,:) + spherecentroid => fvm(ie)%spherecentroid(:,1-nhe:nc+nhe,1-nhe:nc+nhe) do k=kmin,kmax - !call t_startf('fvm:tracers_reconstruct') - call reconstruction(fvm(ie)%c(:,:,:,:),nlev,k,& + !call t_startf('FVM:tracers_reconstruct') + call reconstruction(fcube,nlev,k,& ctracer(:,:,:,:),irecons_tracer,llimiter,ntrac,& nc,nhe,nhr,nhc,nht,ns,nhr+(nhe-1),& fvm(ie)%jx_min,fvm(ie)%jx_max,fvm(ie)%jy_min,fvm(ie)%jy_max,& fvm(ie)%cubeboundary,fvm(ie)%halo_interp_weight,fvm(ie)%ibase,& - fvm(ie)%spherecentroid(:,1-nhe:nc+nhe,1-nhe:nc+nhe),& + spherecentroid,& fvm(ie)%recons_metrics,fvm(ie)%recons_metrics_integral,& fvm(ie)%rot_matrix,fvm(ie)%centroid_stretch,& fvm(ie)%vertex_recons_weights,fvm(ie)%vtx_cart,& irecons_tracer_lev(k)) - !call t_stopf('fvm:tracers_reconstruct') - !call t_startf('fvm:swept_flux') - call swept_flux(elem(ie),fvm(ie),k,ctracer,irecons_tracer_lev(k),gsweights,gspts) - !call t_stopf('fvm:swept_flux') + !call t_stopf('FVM:tracers_reconstruct') + !call t_startf('fvm:swept_flux') + call swept_flux(elem(ie),fvm(ie),k,ctracer,irecons_tracer_lev(k),gsweights,gspts) + !call t_stopf('fvm:swept_flux') end do end do ! diff --git a/src/dynamics/se/dycore/fvm_control_volume_mod.F90 b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 index c1b3c6fc15..e3208c86cd 100644 --- a/src/dynamics/se/dycore/fvm_control_volume_mod.F90 +++ b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 @@ -128,7 +128,6 @@ module fvm_control_volume_mod ! !****************************************** ! - real (kind=r8) , allocatable :: phis_physgrid(:,:) real (kind=r8) , allocatable :: vtx_cart_physgrid(:,:,:,:) real (kind=r8) , allocatable :: flux_orient_physgrid(:,:,:) integer , allocatable :: ifct_physgrid(:,:) @@ -280,7 +279,6 @@ subroutine allocate_physgrid_vars(fvm,par) end if do ie=1,nelemd - allocate(fvm(ie)%phis_physgrid (fv_nphys,fv_nphys)) allocate(fvm(ie)%vtx_cart_physgrid (4,2,1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) allocate(fvm(ie)%flux_orient_physgrid (2,1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) allocate(fvm(ie)%ifct_physgrid (1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys)) diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index 9ff118198c..0f090ebe9e 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -1,14 +1,14 @@ ! ! pg3->GLL and GLL->pg3 mapping algorithm described in: ! -! Adam R. Herrington, Peter H. Lauritzen, Mark A. Taylor, Steve Goldhaber, Brian Eaton, Kevin A Reed and Paul A. Ullrich, 2018: -! Physics-dynamics coupling with element-based high-order Galerkin methods: quasi equal-area physics grid: +! Adam R. Herrington, Peter H. Lauritzen, Mark A. Taylor, Steve Goldhaber, Brian Eaton, Kevin A Reed and Paul A. Ullrich, 2018: +! Physics-dynamics coupling with element-based high-order Galerkin methods: quasi equal-area physics grid: ! Mon. Wea. Rev., DOI:MWR-D-18-0136.1 ! ! pg2->pg3 mapping algorithm described in: ! -! Adam R. Herrington, Peter H. Lauritzen, Kevin A Reed, Steve Goldhaber, and Brian Eaton, 2019: -! Exploring a lower resolution physics grid in CAM-SE-CSLAM. J. Adv. Model. Earth Syst. +! Adam R. Herrington, Peter H. Lauritzen, Kevin A Reed, Steve Goldhaber, and Brian Eaton, 2019: +! Exploring a lower resolution physics grid in CAM-SE-CSLAM. J. Adv. Model. Earth Syst. ! !#define PCoM !replace PPM with PCoM for mass variables for fvm2phys and phys2fvm !#define skip_high_order_fq_map !do mass and correlation preserving phys2fvm mapping but no high-order pre-mapping of fq @@ -18,13 +18,14 @@ module fvm_mapping use dimensions_mod, only: irecons_tracer use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct - use perf_mod, only: t_startf, t_stopf - + use perf_mod, only: t_startf, t_stopf + use cam_abortutils, only: endrun + use cam_logfile, only: iulog implicit none private public :: phys2dyn_forcings_fvm, dyn2phys, dyn2phys_vector, dyn2phys_all_vars,dyn2fvm_mass_vars - public :: phys2dyn,fvm2dyn,dyn2fvm + public :: phys2dyn,fvm2dyn,dyn2fvm,cslam2gll save integer :: save_max_overlap real(kind=r8), allocatable, dimension(:,:,:,:,:) :: save_air_mass_overlap @@ -34,6 +35,12 @@ module fvm_mapping real(kind=r8), allocatable, dimension(:,:,:,:) :: save_overlap_area integer , allocatable, dimension(:,:,:,:,:) :: save_overlap_idx integer , allocatable, dimension(:,:,:,:) :: save_num_overlap + + interface fvm2dyn + module procedure fvm2dynt1 + module procedure fvm2dyntn + end interface fvm2dyn + contains ! ! map all mass variables from gll to fvm @@ -42,18 +49,16 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ use dimensions_mod, only: np, nc,nlev use dimensions_mod, only: fv_nphys, nhc_phys,ntrac,nhc,ksponge_end, nu_scale_top use hybrid_mod, only: hybrid_t - use cam_abortutils, only: endrun - use physconst, only: thermodynamic_active_species_num, thermodynamic_active_species_idx + use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx type (element_t), intent(inout):: elem(:) type(fvm_struct), intent(inout):: fvm(:) - + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) logical, intent(in) :: no_cslam integer, intent(in) :: nets, nete, tl_f, tl_qdp integer :: ie,i,j,k,m_cnst,nq - real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_phys, fld_gll, fld_fvm - real (kind=r8), allocatable, dimension(:,:,:,:,:) :: qgll + real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_phys, fld_gll real (kind=r8) :: element_ave ! ! for tensor product Lagrange interpolation @@ -61,13 +66,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ integer :: nflds logical, allocatable :: llimiter(:) - allocate(qgll(np,np,nlev,thermodynamic_active_species_num,nets:nete)) - - do ie=nets,nete - do nq=1,thermodynamic_active_species_num - qgll(:,:,:,nq,ie) = elem(ie)%state%Qdp(:,:,:,nq,tl_qdp)/elem(ie)%state%dp3d(:,:,:,tl_f) - end do - end do + integer :: ierr if (no_cslam) then call endrun("phys2dyn_forcings_fvm: no cslam case: NOT SUPPORTED") @@ -81,13 +80,25 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ ! call t_startf('p2d-pg2:copying') nflds = 4+ntrac - allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete)) - allocate(fld_gll(np,np,nlev,3,nets:nete)) - allocate(llimiter(nflds)) + allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'phys2dyn_forcings_fvm: fld_phys allocation error = ',ierr + call endrun('phys2dyn_forcings_fvm: failed to allocate fld_phys array') + end if + allocate(fld_gll(np,np,nlev,3,nets:nete), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'phys2dyn_forcings_fvm: fld_gll allocation error = ',ierr + call endrun('phys2dyn_forcings_fvm: failed to allocate fld_gll array') + end if + allocate(llimiter(3), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'phys2dyn_forcings_fvm: llimiter allocation error = ',ierr + call endrun('phys2dyn_forcings_fvm: failed to allocate llimiter array') + end if fld_phys = -9.99E99_r8!xxx necessary? llimiter = .false. - + do ie=nets,nete ! ! pack fields that need to be interpolated @@ -107,7 +118,8 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ ! ! do mapping of fu,fv,ft ! - call phys2dyn(hybrid,elem,fld_phys(:,:,:,1:3,:),fld_gll(:,:,:,1:3,:),nets,nete,nlev,3,fvm,llimiter(1:3),2,.true.) + call phys2dyn(hybrid,elem,fld_phys(:,:,:,1:3,:),fld_gll,nets,nete,nlev,3,fvm,llimiter, & + istart_vector=2,halo_filled=.true.) do ie=nets,nete elem(ie)%derived%fT(:,:,:) = fld_gll(:,:,:,1,ie) elem(ie)%derived%fM(:,:,1,:) = fld_gll(:,:,:,2,ie) @@ -120,7 +132,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ ! map fq from phys to fvm ! call t_startf('p2d-pg2:phys2fvm') - + do ie=nets,nete do k=1,nlev call phys2fvm(ie,k,fvm(ie),& @@ -128,38 +140,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ end do end do call t_stopf('p2d-pg2:phys2fvm') - - ! - ! overwrite SE Q with cslam Q - ! - nflds = thermodynamic_active_species_num - allocate(fld_gll(np,np,nlev,nflds,nets:nete)) - allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,nflds,nets:nete)) - do ie=nets,nete - ! - ! compute cslam updated Q value - do m_cnst=1,thermodynamic_active_species_num - fld_fvm(1:nc,1:nc,:,m_cnst,ie) = fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_idx(m_cnst))+& - fvm(ie)%fc(1:nc,1:nc,:,thermodynamic_active_species_idx(m_cnst))/fvm(ie)%dp_fvm(1:nc,1:nc,:) - enddo - end do - call t_startf('p2d-pg2:fvm2dyn') - llimiter(1:nflds) = .false. - call fvm2dyn(fld_fvm,fld_gll(:,:,:,1:nflds,:),hybrid,nets,nete,nlev,nflds,fvm,llimiter(1:nflds)) - call t_stopf('p2d-pg2:fvm2dyn') - ! - ! fld_gll now holds q cslam value on gll grid - ! - ! convert fld_gll to increment (q_new-q_old) - ! - do ie=nets,nete - do m_cnst=1,thermodynamic_active_species_num - elem(ie)%derived%fq(:,:,:,m_cnst) =& - fld_gll(:,:,:,m_cnst,ie)-qgll(:,:,:,m_cnst,ie) - end do - end do - deallocate(fld_fvm) - !deallocate arrays allocated in dyn2phys_all_vars + !deallocate arrays allocated in dyn2phys_all_vars deallocate(save_air_mass_overlap,save_q_phys,save_q_overlap,& save_overlap_area,save_num_overlap,save_overlap_idx,save_dp_phys) else @@ -172,7 +153,7 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ !***************************************************************************************** ! ! nflds is ft, fu, fv, + thermo species - nflds = 3+thermodynamic_active_species_num + nflds = 3 allocate(fld_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev,nflds,nets:nete)) allocate(fld_gll(np,np,nlev,nflds,nets:nete)) allocate(llimiter(nflds)) @@ -184,18 +165,8 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ fld_phys(1:fv_nphys,1:fv_nphys,:,1,ie) = fvm(ie)%ft(1:fv_nphys,1:fv_nphys,:) fld_phys(1:fv_nphys,1:fv_nphys,:,2,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,1,:) fld_phys(1:fv_nphys,1:fv_nphys,:,3,ie) = fvm(ie)%fm(1:fv_nphys,1:fv_nphys,2,:) - ! - ! compute cslam mixing ratio with physics update - ! - do m_cnst=1,thermodynamic_active_species_num - do k=1,nlev - fld_phys(1:fv_nphys,1:fv_nphys,k,m_cnst+3,ie) = & - fvm(ie)%c(1:fv_nphys,1:fv_nphys,k,thermodynamic_active_species_idx(m_cnst))+& - fvm(ie)%fc_phys(1:fv_nphys,1:fv_nphys,k,thermodynamic_active_species_idx(m_cnst)) - end do - end do - end do - ! + end do + ! ! do mapping ! call phys2dyn(hybrid,elem,fld_phys,fld_gll,nets,nete,nlev,nflds,fvm,llimiter,2) @@ -204,23 +175,18 @@ subroutine phys2dyn_forcings_fvm(elem, fvm, hybrid,nets,nete,no_cslam, tl_f, tl_ elem(ie)%derived%fM(:,:,1,:) = fld_gll(:,:,:,2,ie) elem(ie)%derived%fM(:,:,2,:) = fld_gll(:,:,:,3,ie) end do + deallocate(fld_gll) do ie=nets,nete - do m_cnst=1,thermodynamic_active_species_num - ! - ! convert fq so that it will effectively overwrite SE q with CSLAM q - ! - elem(ie)%derived%fq(:,:,:,m_cnst) = fld_gll(:,:,:,m_cnst+3,ie)-& - qgll(:,:,:,m_cnst,ie) - end do do m_cnst = 1,ntrac fvm(ie)%fc(1:nc,1:nc,:,m_cnst) = fvm(ie)%fc_phys(1:nc,1:nc,:,m_cnst)*fvm(ie)%dp_fvm(1:nc,1:nc,:) end do end do end if - deallocate(fld_phys,llimiter,fld_gll,qgll) + deallocate(fld_phys,llimiter) end subroutine phys2dyn_forcings_fvm - subroutine fvm2dyn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter) + ! for multiple fields + subroutine fvm2dyntn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter,halo_filled) use dimensions_mod, only: np, nhc, nc use hybrid_mod , only: hybrid_t use bndry_mod , only: ghost_exchange @@ -233,7 +199,10 @@ subroutine fvm2dyn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter type (hybrid_t) , intent(in) :: hybrid type(fvm_struct) , intent(in) :: fvm(nets:nete) logical , intent(in) :: llimiter(num_flds) + logical, optional , intent(in) :: halo_filled !optional if boundary exchange for fld_fvm has already been called + integer :: ie, iwidth + logical :: fill_halo ! !********************************************* ! @@ -241,13 +210,20 @@ subroutine fvm2dyn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter ! !********************************************* ! - do ie=nets,nete - call ghostpack(ghostBufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) - end do - call ghost_exchange(hybrid,ghostbufQnhc_s,location='fvm2dyn') - do ie=nets,nete - call ghostunpack(ghostbufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) - end do + fill_halo = .true. + if (present(halo_filled)) then + fill_halo = .not. halo_filled + end if + + if (fill_halo) then + do ie=nets,nete + call ghostpack(ghostBufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) + end do + call ghost_exchange(hybrid,ghostbufQnhc_s,location='fvm2dyntn') + do ie=nets,nete + call ghostunpack(ghostbufQnhc_s, fld_fvm(:,:,:,:,ie),numlev*num_flds,0,ie) + end do + end if ! ! mapping ! @@ -257,8 +233,56 @@ subroutine fvm2dyn(fld_fvm,fld_gll,hybrid,nets,nete,numlev,num_flds,fvm,llimiter call tensor_lagrange_interp(fvm(ie)%cubeboundary,np,nc,nhc,numlev,num_flds,fld_fvm(:,:,:,:,ie),& fld_gll(:,:,:,:,ie),llimiter,iwidth,fvm(ie)%norm_elem_coord) end do - end subroutine fvm2dyn + end subroutine fvm2dyntn + + ! for single field + subroutine fvm2dynt1(fld_fvm,fld_gll,hybrid,nets,nete,numlev,fvm,llimiter,halo_filled) + use dimensions_mod, only: np, nhc, nc + use hybrid_mod , only: hybrid_t + use bndry_mod , only: ghost_exchange + use edge_mod , only: ghostpack,ghostunpack + use fvm_mod , only: ghostBufQnhc_t1 + ! + integer , intent(in) :: nets,nete,numlev + real (kind=r8), intent(inout) :: fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,numlev,1,nets:nete) + real (kind=r8), intent(out) :: fld_gll(np,np,numlev,1,nets:nete) + type (hybrid_t) , intent(in) :: hybrid + type(fvm_struct) , intent(in) :: fvm(nets:nete) + logical , intent(in) :: llimiter(1) + logical, optional , intent(in) :: halo_filled!optional if boundary exchange for fld_fvm has already been called + + integer :: ie, iwidth + logical :: fill_halo + ! + !********************************************* + ! + ! halo exchange + ! + !********************************************* + ! + fill_halo = .true. + if (present(halo_filled)) then + fill_halo = .not. halo_filled + end if + if (fill_halo) then + do ie=nets,nete + call ghostpack(ghostBufQnhc_t1, fld_fvm(:,:,:,1,ie),numlev,0,ie) + end do + call ghost_exchange(hybrid,ghostbufQnhc_t1,location='fvm2dynt1') + do ie=nets,nete + call ghostunpack(ghostbufQnhc_t1, fld_fvm(:,:,:,1,ie),numlev,0,ie) + end do + end if + ! + ! mapping + ! + iwidth=2 + do ie=nets,nete + call tensor_lagrange_interp(fvm(ie)%cubeboundary,np,nc,nhc,numlev,1,fld_fvm(:,:,:,:,ie),& + fld_gll(:,:,:,:,ie),llimiter,iwidth,fvm(ie)%norm_elem_coord) + end do + end subroutine fvm2dynt1 subroutine fill_halo_phys(fld_phys,hybrid,nets,nete,num_lev,num_flds) use dimensions_mod, only: nhc_phys, fv_nphys @@ -297,7 +321,7 @@ end subroutine fill_halo_phys ! must call fill_halo_phys before calling this subroutine ! subroutine phys2dyn(hybrid,elem,fld_phys,fld_gll,nets,nete,num_lev,num_flds,fvm,llimiter,istart_vector,halo_filled) - use dimensions_mod, only: np, nhc_phys, fv_nphys + use dimensions_mod, only: np, nhc_phys, fv_nphys use hybrid_mod, only : hybrid_t type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) integer , intent(in) :: nets,nete,num_flds,num_lev @@ -308,7 +332,7 @@ subroutine phys2dyn(hybrid,elem,fld_phys,fld_gll,nets,nete,num_lev,num_flds,fvm, type(fvm_struct) , intent(in) :: fvm(:) integer, optional , intent(in) :: istart_vector logical , intent(in) :: llimiter(num_flds) - logical, optional , intent(in) :: halo_filled + logical, optional , intent(in) :: halo_filled!optional if boundary exchange for fld_fvm has already been called integer :: i, j, ie, k, iwidth real (kind=r8) :: v1,v2 @@ -401,13 +425,13 @@ subroutine dyn2fvm_mass_vars(dp_gll,ps_gll,q_gll,& inv_darea_dp_fvm,q_gll(:,:,k,m_cnst)) end do end do - end subroutine dyn2fvm_mass_vars - + end subroutine dyn2fvm_mass_vars + ! ! this subroutine assumes that the fvm halo has already been filled ! (if nc/=fv_nphys) ! - + subroutine dyn2phys_all_vars(nets,nete,elem,fvm,& num_trac,ptop,tl,& dp3d_phys,ps_phys,q_phys,T_phys,omega_phys,phis_phys) @@ -433,7 +457,7 @@ subroutine dyn2phys_all_vars(nets,nete,elem,fvm,& integer :: k,m_cnst,ie - + !OMP BARRIER OMP MASTER needed if (nc.ne.fv_nphys) then save_max_overlap = 4 !max number of mass overlap areas between phys and fvm grids @@ -450,14 +474,13 @@ subroutine dyn2phys_all_vars(nets,nete,elem,fvm,& do ie=nets,nete tmp = 1.0_r8 inv_area = 1.0_r8/dyn2phys(tmp,elem(ie)%metdet(:,:)) - phis_phys(:,ie) = RESHAPE(fvm(ie)%phis_physgrid,SHAPE(phis_phys(:,ie))) - ps_phys(:,ie) = ptop + phis_phys(:,ie) = RESHAPE(dyn2phys(elem(ie)%state%phis(:,:),elem(ie)%metdet(:,:),inv_area),SHAPE(phis_phys(:,ie))) + ps_phys(:,ie) = ptop if (nc.ne.fv_nphys) then tmp = 1.0_r8 do k=1,nlev inv_darea_dp_fvm = dyn2fvm(elem(ie)%state%dp3d(:,:,k,tl),elem(ie)%metdet(:,:)) inv_darea_dp_fvm = 1.0_r8/inv_darea_dp_fvm - T_phys(:,k,ie) = RESHAPE(dyn2phys(elem(ie)%state%T(:,:,k,tl),elem(ie)%metdet(:,:),inv_area),SHAPE(T_phys(:,k,ie))) Omega_phys(:,k,ie) = RESHAPE(dyn2phys(elem(ie)%derived%omega(:,:,k),elem(ie)%metdet(:,:),inv_area), & SHAPE(Omega_phys(:,k,ie))) @@ -480,7 +503,7 @@ subroutine dyn2phys_all_vars(nets,nete,elem,fvm,& ! no mapping needed - just copy fields into physics structure ! dp3d_phys(:,k,ie) = RESHAPE(fvm(ie)%dp_fvm(1:nc,1:nc,k),SHAPE(dp3d_phys(:,k,ie))) - ps_phys(:,ie) = ps_phys(:,ie)+RESHAPE(fvm(ie)%dp_fvm(1:nc,1:nc,k),SHAPE(ps_phys(:,ie))) + ps_phys(:,ie) = ps_phys(:,ie)+RESHAPE(fvm(ie)%dp_fvm(1:nc,1:nc,k),SHAPE(ps_phys(:,ie))) do m_cnst=1,num_trac q_phys(:,k,m_cnst,ie) = RESHAPE(fvm(ie)%c(1:nc,1:nc,k,m_cnst),SHAPE(q_phys(:,k,m_cnst,ie))) end do @@ -513,7 +536,7 @@ function dyn2fvm(qdp_gll,metdet,inv_dp_darea_phys,q_gll) result(qdp_phys) real (kind=r8), intent(in), optional :: q_gll(np,np) real (kind=r8) :: qdp_phys(nc,nc), min_val, max_val integer :: i,j - + call subcell_integration(qdp_gll(:,:), np, nc, metdet,qdp_phys) if (present(inv_dp_darea_phys)) then ! @@ -918,7 +941,7 @@ subroutine fvm2phys(ie,k,fvm,q_fvm,q_phys,num_trac) end do end do call get_q_overlap_save(ie,k,fvm,q_fvm,num_trac,q_phys) - save_dp_phys(:,:,k,ie) = save_dp_phys(:,:,k,ie)/fvm%area_sphere_physgrid + save_dp_phys(:,:,k,ie) = save_dp_phys(:,:,k,ie)/fvm%area_sphere_physgrid end subroutine fvm2phys @@ -945,7 +968,7 @@ subroutine phys2fvm(ie,k,fvm,fq_phys,fqdp_fvm,num_trac) real(kind=r8), allocatable, dimension(:,:,:) :: dq_min_overlap,dq_max_overlap real(kind=r8), allocatable, dimension(:,:,:) :: dq_overlap real(kind=r8), allocatable, dimension(:,:,:) :: fq_phys_overlap - + allocate(dq_min_overlap (save_max_overlap,fv_nphys,fv_nphys)) allocate(dq_max_overlap (save_max_overlap,fv_nphys,fv_nphys)) allocate(dq_overlap (save_max_overlap,fv_nphys,fv_nphys)) @@ -958,13 +981,13 @@ subroutine phys2fvm(ie,k,fvm,fq_phys,fqdp_fvm,num_trac) fq_phys_overlap,1) mass_phys(1:fv_nphys,1:fv_nphys) = fq_phys(1:fv_nphys,1:fv_nphys,m_cnst)*& (save_dp_phys(1:fv_nphys,1:fv_nphys,k,ie)*fvm%area_sphere_physgrid) - + min_patch = MINVAL(fvm%c(0:nc+1,0:nc+1,k,m_cnst)) max_patch = MAXVAL(fvm%c(0:nc+1,0:nc+1,k,m_cnst)) do jy=1,fv_nphys do jx=1,fv_nphys num = save_num_overlap(jx,jy,k,ie) -#ifdef debug_coupling +#ifdef debug_coupling save_q_overlap(:,jx,jy,k,m_cnst,ie) = 0.0_r8 save_q_phys(jx,jy,k,m_cnst,ie) = 0.0_r8 tmp = save_q_phys(jx,jy,k,m_cnst,ie)+fq_phys(jx,jy,m_cnst) !updated physics grid mixing ratio @@ -973,26 +996,26 @@ subroutine phys2fvm(ie,k,fvm,fq_phys,fqdp_fvm,num_trac) #else tmp = save_q_phys(jx,jy,k,m_cnst,ie)+fq_phys(jx,jy,m_cnst) !updated physics grid mixing ratio phys_cdp_max(jx,jy)= MAX(MAX(MAXVAL(save_q_overlap(1:num,jx,jy,k,m_cnst,ie)),max_patch),tmp) - phys_cdp_min(jx,jy)= MIN(MIN(MINVAL(save_q_overlap(1:num,jx,jy,k,m_cnst,ie)),min_patch),tmp) -#endif + phys_cdp_min(jx,jy)= MIN(MIN(MINVAL(save_q_overlap(1:num,jx,jy,k,m_cnst,ie)),min_patch),tmp) +#endif ! ! add high-order fq change when it does not violate monotonicity ! mass_forcing_phys = 0.0_r8 do h=1,num jdx = save_overlap_idx(1,h,jx,jy,ie); jdy = save_overlap_idx(2,h,jx,jy,ie) - q_prev = save_q_overlap(h,jx,jy,k,m_cnst,ie) + q_prev = save_q_overlap(h,jx,jy,k,m_cnst,ie) #ifndef skip_high_order_fq_map save_q_overlap(h,jx,jy,k,m_cnst,ie) = save_q_overlap(h,jx,jy,k,m_cnst,ie)+fq_phys_overlap(h,jx,jy) save_q_overlap(h,jx,jy,k,m_cnst,ie) = MIN(save_q_overlap(h,jx,jy,k,m_cnst,ie),phys_cdp_max(jx,jy)) - save_q_overlap(h,jx,jy,k,m_cnst,ie) = MAX(save_q_overlap(h,jx,jy,k,m_cnst,ie),phys_cdp_min(jx,jy)) + save_q_overlap(h,jx,jy,k,m_cnst,ie) = MAX(save_q_overlap(h,jx,jy,k,m_cnst,ie),phys_cdp_min(jx,jy)) mass_forcing = (save_q_overlap(h,jx,jy,k,m_cnst,ie)-q_prev)*save_air_mass_overlap(h,jx,jy,k,ie) mass_forcing_phys = mass_forcing_phys + mass_forcing fqdp_fvm(jdx,jdy,m_cnst) = fqdp_fvm(jdx,jdy,m_cnst)+mass_forcing #endif ! ! prepare for mass fixing algorithm - ! + ! dq_min_overlap(h,jx,jy) = save_q_overlap(h,jx,jy,k,m_cnst,ie)-phys_cdp_min(jx,jy) dq_max_overlap (h,jx,jy) = save_q_overlap(h,jx,jy,k,m_cnst,ie)-phys_cdp_max(jx,jy) end do @@ -1009,7 +1032,7 @@ subroutine phys2fvm(ie,k,fvm,fq_phys,fqdp_fvm,num_trac) ! total mass change from physics on physics grid ! num = save_num_overlap(jx,jy,k,ie) - fq = mass_phys(jx,jy)/(fvm%area_sphere_physgrid(jx,jy)*save_dp_phys(jx,jy,k,ie)) + fq = mass_phys(jx,jy)/(fvm%area_sphere_physgrid(jx,jy)*save_dp_phys(jx,jy,k,ie)) if (fq<0.0_r8) then sum_dq_min = SUM(dq_min_overlap(1:num,jx,jy)*save_air_mass_overlap(1:num,jx,jy,k,ie)) if (sum_dq_min>1.0E-14_r8) then @@ -1021,7 +1044,7 @@ subroutine phys2fvm(ie,k,fvm,fq_phys,fqdp_fvm,num_trac) end do end if end if - + if (fq>0.0_r8) then sum_dq_max = SUM(dq_max_overlap(1:num,jx,jy)*save_air_mass_overlap(1:num,jx,jy,k,ie)) if (sum_dq_max<-1.0E-14_r8) then @@ -1035,11 +1058,11 @@ subroutine phys2fvm(ie,k,fvm,fq_phys,fqdp_fvm,num_trac) end if end do end do -#endif +#endif ! ! convert to mass per unit area ! - fqdp_fvm(:,:,m_cnst) = fqdp_fvm(:,:,m_cnst)*fvm%inv_area_sphere(:,:) + fqdp_fvm(:,:,m_cnst) = fqdp_fvm(:,:,m_cnst)*fvm%inv_area_sphere(:,:) end do deallocate(dq_min_overlap) deallocate(dq_max_overlap) @@ -1069,7 +1092,7 @@ subroutine get_dp_overlap_save(ie,k,fvm,recons) call get_fvm_recons(fvm,fvm%dp_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,k),recons,1,llimiter) do h=1,jall_fvm2phys(ie) - jx = weights_lgr_index_all_fvm2phys(h,1,ie); jy = weights_lgr_index_all_fvm2phys(h,2,ie) + jx = weights_lgr_index_all_fvm2phys(h,1,ie); jy = weights_lgr_index_all_fvm2phys(h,2,ie) jdx = weights_eul_index_all_fvm2phys(h,1,ie); jdy = weights_eul_index_all_fvm2phys(h,2,ie) save_num_overlap(jx,jy,k,ie) = save_num_overlap(jx,jy,k,ie)+1!could be pre-computed idx = save_num_overlap(jx,jy,k,ie) @@ -1090,7 +1113,7 @@ subroutine get_fq_overlap(ie,k,fvm,fq_phys,max_overlap,fq_phys_overlap,num_trac) use dp_mapping, only: weights_eul_index_all_fvm2phys use dp_mapping, only: weights_lgr_index_all_phys2fvm, weights_eul_index_all_phys2fvm,jall_phys2fvm use dp_mapping, only: weights_all_phys2fvm - + integer , intent(in) :: ie,k type(fvm_struct) , intent(in) :: fvm integer , intent(in) :: num_trac, max_overlap @@ -1123,7 +1146,7 @@ subroutine get_fq_overlap(ie,k,fvm,fq_phys,max_overlap,fq_phys_overlap,num_trac) end if end do end do - + llimiter_q=.false. call get_physgrid_recons(fvm,fq_phys,recons_q,num_trac,llimiter_q) ! @@ -1143,11 +1166,11 @@ subroutine get_fq_overlap(ie,k,fvm,fq_phys,max_overlap,fq_phys_overlap,num_trac) do m_cnst=1,num_trac fq_phys_overlap(idx,jx,jy,m_cnst) = & (fvm%dp_fvm(jdx,jdy,k)*SUM(weights_all_phys2fvm_local(h,:)*recons_q(:,jx,jy,m_cnst))+& - fq_phys(jx,jy,m_cnst)*dp_tmp)/save_air_mass_overlap(idx,jx,jy,k,ie) + fq_phys(jx,jy,m_cnst)*dp_tmp)/save_air_mass_overlap(idx,jx,jy,k,ie) end do end do end subroutine get_fq_overlap - + subroutine get_physgrid_recons(fvm,field_phys,recons_phys,num_trac,llimiter) use dimensions_mod, only: fv_nphys,nhr_phys,nhc_phys,ns_phys use fvm_reconstruction_mod, only: reconstruction @@ -1242,13 +1265,13 @@ subroutine get_q_overlap_save(ie,k,fvm,q_fvm,num_trac,q_phys) num_overlap(:,:) = 0 q_phys = 0.0_r8 do h=1,jall_fvm2phys(ie) - jx = weights_lgr_index_all_fvm2phys(h,1,ie); jy = weights_lgr_index_all_fvm2phys(h,2,ie) + jx = weights_lgr_index_all_fvm2phys(h,1,ie); jy = weights_lgr_index_all_fvm2phys(h,2,ie) jdx = weights_eul_index_all_fvm2phys(h,1,ie); jdy = weights_eul_index_all_fvm2phys(h,2,ie) num_overlap(jx,jy) = num_overlap(jx,jy)+1 idx = num_overlap(jx,jy) - dp_fvm_tmp = fvm%dp_fvm(jdx,jdy,k) + dp_fvm_tmp = fvm%dp_fvm(jdx,jdy,k) dp_tmp = save_air_mass_overlap(idx,jx,jy,k,ie)-dp_fvm_tmp*weights_all_fvm2phys(h,1,ie) #ifdef PCoM dp_tmp = save_air_mass_overlap(idx,jx,jy,k,ie) @@ -1271,6 +1294,87 @@ subroutine get_q_overlap_save(ie,k,fvm,q_fvm,num_trac,q_phys) save_q_phys(:,:,k,m_cnst,ie) = q_phys(:,:,m_cnst) end do end subroutine get_q_overlap_save - + ! + ! Routine to overwrite thermodynamic active tracers on the GLL grid with CSLAM values + ! by Lagrange interpolation from 3x3 CSLAM grid to GLL grid. + ! + subroutine cslam2gll(elem, fvm, hybrid,nets,nete, tl_f, tl_qdp) + use dimensions_mod, only: nc,nlev,np,nhc + use hybrid_mod, only: hybrid_t + use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx + use fvm_mod, only: ghostBuf_cslam2gll + use bndry_mod, only: ghost_exchange + use edge_mod, only: ghostpack,ghostunpack + + type (element_t), intent(inout):: elem(:) + type(fvm_struct), intent(inout):: fvm(:) + + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + integer, intent(in) :: nets, nete, tl_f, tl_qdp + + integer :: ie,i,j,k,m_cnst,nq,ierr + real (kind=r8), dimension(:,:,:,:,:) , allocatable :: fld_fvm, fld_gll + ! + ! for tensor product Lagrange interpolation + ! + integer :: nflds + logical, allocatable :: llimiter(:) + call t_startf('cslam2gll') + nflds = thermodynamic_active_species_num + + !Allocate variables + !------------------ + allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,nflds,nets:nete), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'cslam2gll: fld_fvm allocation error = ', ierr + call endrun('cslam2gll: failed to allocate fld_fvm array') + end if + + allocate(fld_gll(np,np,nlev,thermodynamic_active_species_num,nets:nete),stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'cslam2gll: fld_gll allocation error = ', ierr + call endrun('cslam2gll: failed to allocate fld_gll array') + end if + + allocate(llimiter(nflds), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'cslam2gll: llimiter allocation error = ', ierr + call endrun('cslam2gll: failed to allocate llimiter array') + end if + !------------------ + llimiter(1:nflds) = .false. + do ie=nets,nete + do m_cnst=1,thermodynamic_active_species_num + do k=1,nlev + fld_fvm(1:nc,1:nc,k,m_cnst,ie) = & + fvm(ie)%c(1:nc,1:nc,k,thermodynamic_active_species_idx(m_cnst)) + end do + end do + end do + call t_startf('fvm:fill_halo_cslam2gll') + do ie=nets,nete + call ghostpack(ghostBuf_cslam2gll, fld_fvm(:,:,:,:,ie),nlev*nflds,0,ie) + end do + + call ghost_exchange(hybrid,ghostBuf_cslam2gll,location='cslam2gll') + + do ie=nets,nete + call ghostunpack(ghostBuf_cslam2gll, fld_fvm(:,:,:,:,ie),nlev*nflds,0,ie) + end do + call t_stopf('fvm:fill_halo_cslam2gll') + ! + ! do mapping + ! + call fvm2dyn(fld_fvm,fld_gll,hybrid,nets,nete,nlev,nflds,fvm,llimiter,halo_filled=.true.) + + do ie=nets,nete + do m_cnst=1,thermodynamic_active_species_num + elem(ie)%state%qdp(:,:,:,m_cnst,tl_qdp) = fld_gll(:,:,:,m_cnst,ie)*& + elem(ie)%state%dp3d(:,:,:,tl_f) + end do + end do + deallocate(fld_fvm, fld_gll, llimiter) + call t_stopf('cslam2gll') + end subroutine cslam2gll end module fvm_mapping diff --git a/src/dynamics/se/dycore/fvm_mod.F90 b/src/dynamics/se/dycore/fvm_mod.F90 index b8426b7cbd..e2f311ee81 100644 --- a/src/dynamics/se/dycore/fvm_mod.F90 +++ b/src/dynamics/se/dycore/fvm_mod.F90 @@ -9,7 +9,7 @@ ! 7.Februar 2012: cslam_run and cslam_runair ! !-----------------------------------------------------------------------------! -module fvm_mod +module fvm_mod use shr_kind_mod, only: r8=>shr_kind_r8 use edge_mod, only: initghostbuffer, freeghostbuffer, ghostpack, ghostunpack use edgetype_mod, only: edgebuffer_t @@ -19,22 +19,24 @@ module fvm_mod use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use hybrid_mod, only: hybrid_t - + implicit none private save - + type (EdgeBuffer_t) :: edgeveloc type (EdgeBuffer_t), public :: ghostBufQnhc_s + type (EdgeBuffer_t), public :: ghostBufQnhc_t1 type (EdgeBuffer_t), public :: ghostBufQnhc_vh type (EdgeBuffer_t), public :: ghostBufQnhc_h type (EdgeBuffer_t), public :: ghostBufQ1_h - type (EdgeBuffer_t), public :: ghostBufQ1_vh + type (EdgeBuffer_t), public :: ghostBufQ1_vh ! type (EdgeBuffer_t), private :: ghostBufFlux_h type (EdgeBuffer_t), public :: ghostBufFlux_vh type (EdgeBuffer_t), public :: ghostBufQnhcJet_h type (EdgeBuffer_t), public :: ghostBufFluxJet_h type (EdgeBuffer_t), public :: ghostBufPG_s + type (EdgeBuffer_t), public :: ghostBuf_cslam2gll interface fill_halo_fvm module procedure fill_halo_fvm_noprealloc @@ -58,14 +60,14 @@ subroutine fill_halo_fvm_noprealloc(elem,fvm,hybrid,nets,nete,ndepth,kmin,kmax,k integer,intent(in) :: nets,nete integer,intent(in) :: ndepth ! depth of halo - integer,intent(in) :: kmin,kmax ! min and max vertical level - integer,intent(in) :: ksize ! the total number of vertical + integer,intent(in) :: kmin,kmax ! min and max vertical level + integer,intent(in) :: ksize ! the total number of vertical integer :: ie,i1,i2,kblk,kptr,q ! ! - - if(kmin .ne. 1 .or. kmax .ne. nlev) then + + if(kmin .ne. 1 .or. kmax .ne. nlev) then print *,'WARNING: fill_halo_fvm_noprealloc does not support the passing of non-contigous arrays' print *,'WARNING: incorrect answers are likely' endif @@ -88,7 +90,7 @@ subroutine fill_halo_fvm_noprealloc(elem,fvm,hybrid,nets,nete,ndepth,kmin,kmax,k if(FVM_TIMERS) call t_startf('FVM:Communication') call ghost_exchange(hybrid,cellghostbuf,location='fill_halo_fvm_noprealloc') if(FVM_TIMERS) call t_stopf('FVM:Communication') - !-----------------------------------------------------------------------------------! + !-----------------------------------------------------------------------------------! if(FVM_TIMERS) call t_startf('FVM:Unpack') do ie=nets,nete kptr = kmin-1 @@ -116,15 +118,15 @@ subroutine fill_halo_fvm_prealloc(cellghostbuf,elem,fvm,hybrid,nets,nete,ndepth, integer,intent(in) :: nets,nete integer,intent(in) :: ndepth ! depth of halo - integer,intent(in) :: kmin,kmax ! min and max vertical level - integer,intent(in) :: ksize ! the total number of vertical - logical, optional :: active ! indicates if te current thread is active + integer,intent(in) :: kmin,kmax ! min and max vertical level + integer,intent(in) :: ksize ! the total number of vertical + logical, optional :: active ! indicates if te current thread is active integer :: ie,i1,i2,kblk,q,kptr ! ! logical :: lactive - if(present(active)) then + if(present(active)) then lactive = active else lactive = .true. @@ -134,7 +136,7 @@ subroutine fill_halo_fvm_prealloc(cellghostbuf,elem,fvm,hybrid,nets,nete,ndepth, i2=nc+ndepth kblk = kmax-kmin+1 if(FVM_TIMERS) call t_startf('FVM:pack') - if(lactive) then + if(lactive) then do ie=nets,nete kptr = kmin-1 call ghostpack(cellghostbuf, fvm(ie)%dp_fvm(i1:i2,i1:i2,kmin:kmax),kblk, kptr,ie) @@ -148,9 +150,9 @@ subroutine fill_halo_fvm_prealloc(cellghostbuf,elem,fvm,hybrid,nets,nete,ndepth, if(FVM_TIMERS) call t_startf('FVM:Communication') call ghost_exchange(hybrid,cellghostbuf,location='fill_halo_fvm_prealloc') if(FVM_TIMERS) call t_stopf('FVM:Communication') - !-----------------------------------------------------------------------------------! + !-----------------------------------------------------------------------------------! if(FVM_TIMERS) call t_startf('FVM:Unpack') - if(lactive) then + if(lactive) then do ie=nets,nete kptr = kmin-1 call ghostunpack(cellghostbuf, fvm(ie)%dp_fvm(i1:i2,i1:i2,kmin:kmax),kblk, kptr,ie) @@ -172,12 +174,12 @@ subroutine PrintArray(i1,i2,array) sz = size(array,dim=1) - if (sz == 9) then + if (sz == 9) then do i=i2,i1,-1 write(6,9) array(-2,i),array(-1,i), array(0,i), & array( 1,i), array(2,i), array(3,i), & array( 4,i), array(5,i), array(6,i) - enddo + enddo endif 9 format('|',9(f10.1,'|')) @@ -207,7 +209,7 @@ subroutine fill_halo_and_extend_panel(elem,fvm,fld,hybrid,nets,nete,nphys,nhcc, integer :: ie,k,itr,nht_phys,nh_phys type (edgeBuffer_t) :: cellghostbuf - + if (lfill_halo) then ! !********************************************* @@ -281,7 +283,7 @@ subroutine fill_halo_and_extend_panel(elem,fvm,fld,hybrid,nets,nete,nphys,nhcc, end if end subroutine fill_halo_and_extend_panel - + ! initialize global buffers shared by all threads subroutine fvm_init1(par,elem) use parallel_mod, only: parallel_t @@ -290,23 +292,23 @@ subroutine fvm_init1(par,elem) use control_mod, only: rsplit use dimensions_mod, only: qsize, qsize_d use dimensions_mod, only: fvm_supercycling, fvm_supercycling_jet - use dimensions_mod, only: nc,nhe, nhc, nlev,ntrac, ntrac_d,ns, nhr + use dimensions_mod, only: nc,nhe, nhc, nlev,ntrac, ntrac_d,ns, nhr, use_cslam use dimensions_mod, only: large_Courant_incr use dimensions_mod, only: kmin_jet,kmax_jet - + type (parallel_t) :: par type (element_t),intent(inout) :: elem(:) ! - if (ntrac>0) then - if (par%masterproc) then + if (use_cslam) then + if (par%masterproc) then write(iulog,*) " " write(iulog,*) "|-----------------------------------------|" write(iulog,*) "| FVM tracer transport scheme information |" write(iulog,*) "|-----------------------------------------|" write(iulog,*) " " end if - if (ntrac>0) then - if (par%masterproc) then + if (use_cslam) then + if (par%masterproc) then write(iulog,*) "Running consistent SE-CSLAM, Lauritzen et al. (2017, MWR)." write(iulog,*) "CSLAM = Conservative Semi-LAgrangian Multi-tracer scheme" write(iulog,*) "Lauritzen et al., (2010), J. Comput. Phys." @@ -327,7 +329,7 @@ subroutine fvm_init1(par,elem) write(iulog,*)'with this choice of rsplit =',rsplit write(iulog,*)'rsplit must be a multiple of fvm_supercycling=',fvm_supercycling end if - call endrun("PARAMETER ERROR for fvm: mod(rsplit,fvm_supercycling)<>0") + call endrun("PARAMETER ERROR for fvm: mod(rsplit,fvm_supercycling)<>0") endif if (qsize>0.and.mod(rsplit,fvm_supercycling_jet).ne.0) then @@ -336,18 +338,18 @@ subroutine fvm_init1(par,elem) write(iulog,*)'with this choice of rsplit =',rsplit write(iulog,*)'rsplit must be a multiple of fvm_supercycling_jet=',fvm_supercycling_jet end if - call endrun("PARAMETER ERROR for fvm: mod(rsplit,fvm_supercycling_jet)<>0") + call endrun("PARAMETER ERROR for fvm: mod(rsplit,fvm_supercycling_jet)<>0") endif - + if (large_Courant_incr.and.(fvm_supercycling.ne.fvm_supercycling_jet)) then if (par%masterproc) then write(iulog,*)'Large Courant number increment requires no level dependent supercycling' write(iulog,*)'i.e. fvm_supercycling must be equal to fvm_supercycling_jet' end if - call endrun("PARAMETER ERROR for fvm: large_courant_incr requires fvm_supercycling=fvm_supercycling_jet") + call endrun("PARAMETER ERROR for fvm: large_courant_incr requires fvm_supercycling=fvm_supercycling_jet") endif - - if (par%masterproc) then + + if (par%masterproc) then write(iulog,*) " " write(iulog,*) "Done Tracer transport scheme information " write(iulog,*) " " @@ -355,16 +357,16 @@ subroutine fvm_init1(par,elem) if (par%masterproc) write(iulog,*) "fvm resolution is nc*nc in each element: nc = ",nc - if (par%masterproc) write(iulog,*)'ntrac,ntrac_d=',ntrac,ntrac_d - if (par%masterproc) write(iulog,*)'qsize,qsize_d=',qsize,qsize_d - + if (par%masterproc) write(iulog,*)'ntrac,ntrac_d=',ntrac,ntrac_d + if (par%masterproc) write(iulog,*)'qsize,qsize_d=',qsize,qsize_d + if (nc.ne.3) then - if (par%masterproc) then + if (par%masterproc) then write(iulog,*) "Only nc==3 is supported for CSLAM" endif call endrun("PARAMETER ERRROR for fvm: only nc=3 supported for CSLAM") end if - + if (par%masterproc) then write(iulog,*) " " if (ns==1) then @@ -374,7 +376,7 @@ subroutine fvm_init1(par,elem) write(iulog,*) "ns==2: using linear interpolation for mapping cell averages values across edges" write(iulog,*) "Note that ns=4 is default CSLAM setting used in Lauritzen et al. (2010)" write(iulog,*) "so this option is slightly less accurate (but the stencil is smaller near panel edges!)" - + else if (ns==3) then write(iulog,*) "ns==3: using quadratic interpolation for mapping cell averages values across edges" write(iulog,*) "Note that ns=4 is default CSLAM setting used in Lauritzen et al. (2010)" @@ -382,17 +384,17 @@ subroutine fvm_init1(par,elem) else if (ns==4) then write(iulog,*) "ns==4: using cubic interpolation for mapping cell averages values across edges" write(iulog,*) "This is default CSLAM setting used in Lauritzen et al. (2010)" - else + else write(iulog,*) "Not a tested value for ns but it should work! You choose ns = ",ns end if - + ! if (ns.NE.3) then ! write(*,*) "In fvm_reconstruction_mod function matmul_w has been hard-coded for ns=3 for performance" ! write(*,*) "Revert to general code - outcommented above" ! call endrun("stopping") ! end if end if - + if (MOD(ns,2)==0.and.nhr+(nhe-1)+ns/2>nc+nc) then write(iulog,*) "to run this combination of ns and nhr you need to increase nc to ",nhr+ns/2+nhe-1 write(iulog,*) "You choose (ns,nhr,nc,nhe)=",ns,nhr,nc,nhe @@ -403,7 +405,7 @@ subroutine fvm_init1(par,elem) write(iulog,*) "You choose (ns,nhr,nc,nhe)=",ns,nhr,nc,nhe call endrun("stopping") end if - + if (nc==3.and.ns.ne.3) then if (par%masterproc) then write(iulog,*) "Recommended setting for nc=3 is ns=3 (linear interpolation in halo)" @@ -414,7 +416,7 @@ subroutine fvm_init1(par,elem) call endrun("stopping") end if end if - + if (nc==4.and.ns.ne.4) then if (par%masterproc) then write(iulog,*) "Recommended setting for nc=4 is ns=4 (cubic interpolation in halo)" @@ -424,20 +426,20 @@ subroutine fvm_init1(par,elem) endif call endrun("stopping") end if - + if (nhe .ne. 1) then if (par%masterproc) then write(iulog,*) "PARAMETER ERROR for fvm: Number of halo zone for the extended" write(iulog,*) "element nhe has to be 1, only this is available now! STOP!" endif call endrun("stopping") - end if + end if end subroutine fvm_init1 - - - - - + + + + + ! initialization that can be done in threaded regions subroutine fvm_init2(elem,fvm,hybrid,nets,nete) use fvm_control_volume_mod, only: fvm_mesh,fvm_set_cubeboundary @@ -448,8 +450,8 @@ subroutine fvm_init2(elem,fvm,hybrid,nets,nete) use dimensions_mod, only: kmin_jet,kmax_jet use hycoef, only: hyai, hybi, ps0 use derivative_mod, only: subcell_integration - use physconst, only: thermodynamic_active_species_num - + use air_composition, only: thermodynamic_active_species_num + type (fvm_struct) :: fvm(:) type (element_t) :: elem(:) type (hybrid_t) :: hybrid @@ -467,13 +469,13 @@ subroutine fvm_init2(elem,fvm,hybrid,nets,nete) call compute_ghost_corner_orientation(hybrid,elem,nets,nete) ! run some tests: ! call test_ghost(hybrid,elem,nets,nete) - + do ie=nets,nete call fvm_set_cubeboundary(elem(ie),fvm(ie)) call fvm_mesh(elem(ie),fvm(ie)) fvm(ie)%inv_area_sphere = 1.0_r8/fvm(ie)%area_sphere ! - ! compute CSLAM areas consistent with SE area (at 1 degree they can be up to + ! compute CSLAM areas consistent with SE area (at 1 degree they can be up to ! 1E-6 different than the correct spherical areas used in CSLAM) ! call subcell_integration(one, np, nc, elem(ie)%metdet,fvm(ie)%inv_se_area_sphere) @@ -483,10 +485,11 @@ subroutine fvm_init2(elem,fvm,hybrid,nets,nete) fvm(ie)%fm(:,:,:,:) = 0.0_r8 fvm(ie)%ft(:,:,: ) = 0.0_r8 enddo - ! Need to allocate ghostBufQnhc after compute_ghost_corner_orientation because it + ! Need to allocate ghostBufQnhc after compute_ghost_corner_orientation because it ! changes the values for reverse call initghostbuffer(hybrid%par,ghostBufQnhc_s,elem,nlev*(ntrac+1),nhc,nc,nthreads=1) + call initghostbuffer(hybrid%par,ghostBufQnhc_t1,elem,nlev, nhc,nc,nthreads=1) call initghostbuffer(hybrid%par,ghostBufQnhc_h,elem,nlev*(ntrac+1),nhc,nc,nthreads=horz_num_threads) call initghostbuffer(hybrid%par,ghostBufQnhc_vh,elem,nlev*(ntrac+1),nhc,nc,nthreads=vert_num_threads*horz_num_threads) klev = kmax_jet-kmin_jet+1 @@ -494,15 +497,16 @@ subroutine fvm_init2(elem,fvm,hybrid,nets,nete) call initghostbuffer(hybrid%par,ghostBufQ1_vh,elem,klev*(ntrac+1),1,nc,nthreads=vert_num_threads*horz_num_threads) ! call initghostbuffer(hybrid%par,ghostBufFlux_h,elem,4*nlev,nhe,nc,nthreads=horz_num_threads) call initghostbuffer(hybrid%par,ghostBufFlux_vh,elem,4*nlev,nhe,nc,nthreads=vert_num_threads*horz_num_threads) + call initghostbuffer(hybrid%par,ghostBuf_cslam2gll,elem,nlev*thermodynamic_active_species_num,nhc,nc,nthreads=1) ! ! preallocate buffers for physics-dynamics coupling ! if (fv_nphys.ne.nc) then call initghostbuffer(hybrid%par,ghostBufPG_s,elem,nlev*(4+ntrac),nhc_phys,fv_nphys,nthreads=1) else - call initghostbuffer(hybrid%par,ghostBufPG_s,elem,nlev*(3+thermodynamic_active_species_num),nhc_phys,fv_nphys,nthreads=1) + call initghostbuffer(hybrid%par,ghostBufPG_s,elem,nlev*3,nhc_phys,fv_nphys,nthreads=1) end if - + if (fvm_supercycling.ne.fvm_supercycling_jet) then ! ! buffers for running different fvm time-steps in the jet region @@ -513,18 +517,18 @@ subroutine fvm_init2(elem,fvm,hybrid,nets,nete) end if end subroutine fvm_init2 - + subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) use control_mod , only: neast, nwest, seast, swest use fvm_analytic_mod, only: compute_reconstruct_matrix - use dimensions_mod , only: fv_nphys - use dimensions_mod, only: nlev, nc, nhe, nlev, ntrac, ntrac_d,nhc + use dimensions_mod , only: fv_nphys, use_cslam + use dimensions_mod, only: nlev, nc, nhe, nlev, nhc use coordinate_systems_mod, only: cartesian2D_t,cartesian3D_t use coordinate_systems_mod, only: cubedsphere2cart, cart2cubedsphere implicit none type (element_t) ,intent(inout) :: elem(:) - type (fvm_struct),intent(inout) :: fvm(:) - type (hybrid_t) ,intent(in) :: hybrid + type (fvm_struct),intent(inout) :: fvm(:) + type (hybrid_t) ,intent(in) :: hybrid integer ,intent(in) :: nets,nete,irecons ! type (edgeBuffer_t) :: cellghostbuf @@ -536,7 +540,7 @@ subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) type (cartesian2D_t) :: gnom type(cartesian3D_t) :: tmpcart3d - if (ntrac>0.and.nc.ne.fv_nphys) then + if (use_cslam.and.nc.ne.fv_nphys) then ! ! fill the fvm halo for mapping in d_p_coupling if ! physics grid resolution is different than fvm resolution @@ -557,7 +561,7 @@ subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) call ghostpack(cellghostbuf, fvm(ie)%norm_elem_coord(1,:,:),1,istart,ie) istart = istart+1 call ghostpack(cellghostbuf, fvm(ie)%norm_elem_coord(2,:,:),1,istart,ie) - istart = istart+1 + istart = istart+1 do ixy=1,2 do ivertex=1,4 call ghostpack(cellghostbuf, fvm(ie)%vtx_cart(ivertex,ixy,:,:) ,1,istart,ie) @@ -576,7 +580,7 @@ subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) call ghostunpack(cellghostbuf, fvm(ie)%norm_elem_coord(1,:,:),1,istart,ie) istart = istart+1 call ghostunpack(cellghostbuf, fvm(ie)%norm_elem_coord(2,:,:),1,istart,ie) - istart = istart+1 + istart = istart+1 do ixy=1,2 do ivertex=1,4 call ghostunpack(cellghostbuf, fvm(ie)%vtx_cart(ivertex,ixy,:,:) ,1,istart,ie) @@ -589,9 +593,9 @@ subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) call ghostunpack(cellghostbuf, fvm(ie)%spherecentroid(ixy,:,:) ,1,istart,ie) end do enddo - call freeghostbuffer(cellghostbuf) + call freeghostbuffer(cellghostbuf) ! - ! indicator for non-existing cells + ! indicator for non-existing cells ! set vtx_cart to corner value in non-existent cells ! do ie=nets,nete @@ -617,26 +621,26 @@ subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) fvm(ie)%vtx_cart(:,2,nc+1 :nc+nhc,1-nhc:0 ) = fvm(ie)%vtx_cart(2,2,nc,1) end if end do - + ! ! set vectors for perpendicular flux vector ! rot90_matrix(1,1) = 0; rot90_matrix(2,1) = 1 !counter-clockwise rotation matrix - rot90_matrix(1,2) =-1; rot90_matrix(2,2) = 0 !counter-clockwise rotation matrix - + rot90_matrix(1,2) =-1; rot90_matrix(2,2) = 0 !counter-clockwise rotation matrix + iside = 1 unit_vec(1,iside) = 0 !x-component of displacement vector for side 1 unit_vec(2,iside) = 1 !y-component of displacement vector for side 1 - + do iside=2,4 unit_vec(:,iside) = MATMUL(rot90_matrix(:,:),unit_vec(:,iside-1)) end do - + ! ! fill halo done ! !------------------------------- - + do ie=nets,nete fvm(ie)%displ_max = 0.0_r8 do j=imin,imax @@ -645,7 +649,7 @@ subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) ! rotate gnomonic coordinate vector ! ! fvm(ie)%norm_elem_coord(:,i,j) = MATMUL(fvm(ie)%rot_matrix(:,:,i,j),fvm(ie)%norm_elem_coord(:,i,j)) - ! + ! ishft = NINT(fvm(ie)%flux_orient(2,i,j)) do ixy=1,2 ! @@ -654,10 +658,10 @@ subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) fvm(ie)%vtx_cart(1:4,ixy,i,j) = cshift(fvm(ie)%vtx_cart(1:4,ixy,i,j),shift=ishft) fvm(ie)%flux_vec (ixy,i,j,1:4) = cshift(unit_vec (ixy,1:4 ),shift=ishft) ! - ! set flux vector to zero in non-existent cells (corner halo) + ! set flux vector to zero in non-existent cells (corner halo) ! fvm(ie)%flux_vec (ixy,i,j,1:4) = fvm(ie)%ifct(i,j)*fvm(ie)%flux_vec(ixy,i,j,1:4) - + iside=1 fvm(ie)%displ_max(i,j,iside) = fvm(ie)%displ_max(i,j,iside)+& ABS(fvm(ie)%vtx_cart(4,ixy,i,j)-fvm(ie)%vtx_cart(1,ixy,i,j)) @@ -677,7 +681,7 @@ subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) ! ! pre-compute derived metric terms used for integration, polynomial ! evaluation at fvm cell vertices, etc. - ! + ! do ie=nets,nete call compute_reconstruct_matrix(nc,nhe,nhc,irecons,fvm(ie)%dalpha,fvm(ie)%dbeta,& fvm(ie)%spherecentroid,fvm(ie)%vtx_cart,fvm(ie)%centroid_stretch,& @@ -685,7 +689,7 @@ subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) end do ! ! create a normalized element coordinate system with a halo - ! + ! do ie=nets,nete do j=1-nhc,nc+nhc do i=1-nhc,nc+nhc @@ -721,14 +725,13 @@ subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) end do end subroutine fvm_init3 - + subroutine fvm_pg_init(elem, fvm, hybrid, nets, nete,irecons) use coordinate_systems_mod, only : cartesian2D_t,cartesian3D_t use control_mod, only : neast, nwest, seast, swest use coordinate_systems_mod, only : cubedsphere2cart, cart2cubedsphere use dimensions_mod, only: fv_nphys, nhe_phys,nhc_phys - use dimensions_mod, only: ntrac_d use cube_mod ,only: dmap use control_mod ,only: cubed_sphere_map use fvm_analytic_mod, only: compute_reconstruct_matrix @@ -807,9 +810,9 @@ subroutine fvm_pg_init(elem, fvm, hybrid, nets, nete,irecons) call ghostunpack(cellghostbuf, fvm(ie)%spherecentroid_physgrid(ixy,:,:) ,1,istart,ie) end do enddo - call freeghostbuffer(cellghostbuf) + call freeghostbuffer(cellghostbuf) ! - ! indicator for non-existing cells + ! indicator for non-existing cells ! set vtx_cart to corner value in non-existent cells ! do ie=nets,nete @@ -843,32 +846,32 @@ subroutine fvm_pg_init(elem, fvm, hybrid, nets, nete,irecons) fvm(ie)%vtx_cart_physgrid(2,2,fv_nphys,1) end if end do - + ! ! set vectors for perpendicular flux vector ! rot90_matrix(1,1) = 0; rot90_matrix(2,1) = 1 !counter-clockwise rotation matrix - rot90_matrix(1,2) =-1; rot90_matrix(2,2) = 0 !counter-clockwise rotation matrix - + rot90_matrix(1,2) =-1; rot90_matrix(2,2) = 0 !counter-clockwise rotation matrix + iside = 1 unit_vec(1,iside) = 0 !x-component of displacement vector for side 1 unit_vec(2,iside) = 1 !y-component of displacement vector for side 1 - + do iside=2,4 unit_vec(:,iside) = MATMUL(rot90_matrix(:,:),unit_vec(:,iside-1)) end do - + ! ! fill halo done ! !------------------------------- - + do ie=nets,nete do j=imin,imax do i=imin,imax ! ! rotate gnomonic coordinate vector - ! + ! ishft = NINT(fvm(ie)%flux_orient_physgrid(2,i,j)) do ixy=1,2 ! @@ -882,18 +885,18 @@ subroutine fvm_pg_init(elem, fvm, hybrid, nets, nete,irecons) ! ! pre-compute derived metric terms used for integration, polynomial ! evaluation at fvm cell vertices, etc. - ! + ! do ie=nets,nete call compute_reconstruct_matrix(fv_nphys,nhe_phys,nhc_phys,irecons,fvm(ie)%dalpha_physgrid,fvm(ie)%dbeta_physgrid,& fvm(ie)%spherecentroid_physgrid,fvm(ie)%vtx_cart_physgrid,fvm(ie)%centroid_stretch_physgrid,& fvm(ie)%vertex_recons_weights_physgrid,fvm(ie)%recons_metrics_physgrid,fvm(ie)%recons_metrics_integral_physgrid) - end do + end do ! ! code specific for physgrid ! ! ! create a normalized element coordinate system with a halo - ! + ! do ie=nets,nete do j=1-nhc_phys,fv_nphys+nhc_phys do i=1-nhc_phys,fv_nphys+nhc_phys @@ -936,15 +939,15 @@ subroutine fvm_pg_init(elem, fvm, hybrid, nets, nete,irecons) x1 = fvm(ie)%norm_elem_coord_physgrid(1,i,j) x2 = fvm(ie)%norm_elem_coord_physgrid(2,i,j) call Dmap(D(i,j,:,:),x1,x2,elem(ie)%corners3D,cubed_sphere_map,elem(ie)%corners,elem(ie)%u2qmap,elem(ie)%facenum) - detD = D(i,j,1,1)*D(i,j,2,2) - D(i,j,1,2)*D(i,j,2,1) - + detD = D(i,j,1,1)*D(i,j,2,2) - D(i,j,1,2)*D(i,j,2,1) + fvm(ie)%Dinv_physgrid(i,j,1,1) = D(i,j,2,2)/detD fvm(ie)%Dinv_physgrid(i,j,1,2) = -D(i,j,1,2)/detD fvm(ie)%Dinv_physgrid(i,j,2,1) = -D(i,j,2,1)/detD fvm(ie)%Dinv_physgrid(i,j,2,2) = D(i,j,1,1)/detD end do end do - end do + end do end if end subroutine fvm_pg_init diff --git a/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 index b7310ad477..b4708dfd3b 100644 --- a/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 +++ b/src/dynamics/se/dycore/fvm_reconstruction_mod.F90 @@ -105,7 +105,6 @@ subroutine reconstruction(fcube,nlev_in,k_in,recons,irecons,llimiter,ntrac_in,& if(FVM_TIMERS) call t_startf('FVM:reconstruction:part#1') if (nhe>0) then do itr=1,ntrac_in - ! f=-9e9_r8 call extend_panel_interpolate(nc,nhc,nhr,nht,ns,nh,& fcube(:,:,k_in,itr),cubeboundary,halo_interp_weight,ibase,f(:,:,1),f(:,:,2:3)) call get_gradients(f(:,:,:),jx,jy,irecons,recons(:,:,:,itr),& @@ -113,8 +112,6 @@ subroutine reconstruction(fcube,nlev_in,k_in,recons,irecons,llimiter,ntrac_in,& end do else do itr=1,ntrac_in - ! f=-9e9_r8!to avoid floating point exception for uninitialized variables - ! !in non-existent cells (corners of cube) call extend_panel_interpolate(nc,nhc,nhr,nht,ns,nh,& fcube(:,:,k_in,itr),cubeboundary,halo_interp_weight,ibase,f(:,:,1)) call get_gradients(f(:,:,:),jx,jy,irecons,recons(:,:,:,itr),& diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 8f55f6391e..e4701c9d37 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -24,26 +24,27 @@ module global_norms_mod private :: global_maximum type (EdgeBuffer_t), private :: edgebuf + interface global_integral + module procedure global_integral_elem + module procedure global_integral_fvm + end interface global_integral + contains - subroutine global_integrals(elem, h,hybrid,npts,num_flds,nets,nete,I_sphere) + subroutine global_integrals(elem,fld,hybrid,npts,num_flds,nets,nete,I_sphere) use hybrid_mod, only: hybrid_t use element_mod, only: element_t - use dimensions_mod, only: np, nelemd + use dimensions_mod, only: np use physconst, only: pi use parallel_mod, only: global_shared_buf, global_shared_sum type(element_t) , intent(in) :: elem(:) integer , intent(in) :: npts,nets,nete,num_flds - real (kind=r8), intent(in) :: h(npts,npts,num_flds,nets:nete) + real (kind=r8), intent(in) :: fld(npts,npts,num_flds,nets:nete) type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: I_sphere(num_flds) - - real (kind=r8) :: I_priv - real (kind=r8) :: I_shared - common /gblintcom/I_shared ! ! Local variables ! @@ -57,13 +58,12 @@ subroutine global_integrals(elem, h,hybrid,npts,num_flds,nets,nete,I_sphere) ! J_tmp = 0.0_r8 -!JMD print *,'global_integral: before loop' do ie=nets,nete do q=1,num_flds do j=1,np do i=1,np da = elem(ie)%mp(i,j)*elem(ie)%metdet(i,j) - J_tmp(ie,q) = J_tmp(ie,q) + da*h(i,j,q,ie) + J_tmp(ie,q) = J_tmp(ie,q) + da*fld(i,j,q,ie) end do end do end do @@ -71,28 +71,21 @@ subroutine global_integrals(elem, h,hybrid,npts,num_flds,nets,nete,I_sphere) do ie=nets,nete global_shared_buf(ie,1:num_flds) = J_tmp(ie,:) enddo - !JMD print *,'global_integral: before wrap_repro_sum' call wrap_repro_sum(nvars=num_flds, comm=hybrid%par%comm) - !JMD print *,'global_integral: after wrap_repro_sum' I_sphere(:) =global_shared_sum(1:num_flds) /(4.0_r8*PI) end subroutine global_integrals - subroutine global_integrals_general(h,hybrid,npts,da,num_flds,nets,nete,I_sphere) + subroutine global_integrals_general(fld,hybrid,npts,da,num_flds,nets,nete,I_sphere) use hybrid_mod, only: hybrid_t - use dimensions_mod, only: nc, nelemd use physconst, only: pi use parallel_mod, only: global_shared_buf, global_shared_sum integer, intent(in) :: npts,nets,nete,num_flds - real (kind=r8), intent(in) :: h(npts,npts,num_flds,nets:nete) + real (kind=r8), intent(in) :: fld(npts,npts,num_flds,nets:nete) type (hybrid_t), intent(in) :: hybrid real (kind=r8), intent(in) :: da(npts,npts,nets:nete) real (kind=r8) :: I_sphere(num_flds) - - real (kind=r8) :: I_priv - real (kind=r8) :: I_shared - common /gblintcom/I_shared ! ! Local variables ! @@ -105,12 +98,11 @@ subroutine global_integrals_general(h,hybrid,npts,da,num_flds,nets,nete,I_sphere ! J_tmp = 0.0_r8 -!JMD print *,'global_integral: before loop' do ie=nets,nete do q=1,num_flds do j=1,npts do i=1,npts - J_tmp(ie,q) = J_tmp(ie,q) + da(i,j,ie)*h(i,j,q,ie) + J_tmp(ie,q) = J_tmp(ie,q) + da(i,j,ie)*fld(i,j,q,ie) end do end do end do @@ -118,9 +110,7 @@ subroutine global_integrals_general(h,hybrid,npts,da,num_flds,nets,nete,I_sphere do ie=nets,nete global_shared_buf(ie,1:num_flds) = J_tmp(ie,:) enddo - !JMD print *,'global_integral: before wrap_repro_sum' call wrap_repro_sum(nvars=num_flds, comm=hybrid%par%comm) - !JMD print *,'global_integral: after wrap_repro_sum' I_sphere(:) =global_shared_sum(1:num_flds) /(4.0_r8*PI) end subroutine global_integrals_general @@ -133,24 +123,20 @@ end subroutine global_integrals_general ! ! ================================ ! -------------------------- - function global_integral(elem, h,hybrid,npts,nets,nete) result(I_sphere) + function global_integral_elem(elem,fld,hybrid,npts,nets,nete) result(I_sphere) use hybrid_mod, only: hybrid_t use element_mod, only: element_t - use dimensions_mod, only: np, nelemd + use dimensions_mod, only: np use physconst, only: pi use parallel_mod, only: global_shared_buf, global_shared_sum type(element_t) , intent(in) :: elem(:) integer , intent(in) :: npts,nets,nete - real (kind=r8), intent(in) :: h(npts,npts,nets:nete) + real (kind=r8), intent(in) :: fld(npts,npts,nets:nete) type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: I_sphere - real (kind=r8) :: I_priv - real (kind=r8) :: I_shared - common /gblintcom/I_shared - ! Local variables integer :: ie,j,i @@ -159,31 +145,69 @@ function global_integral(elem, h,hybrid,npts,nets,nete) result(I_sphere) real (kind=r8) :: da real (kind=r8) :: J_tmp(nets:nete) ! -! This algorythm is independent of thread count and task count. +! This algorithm is independent of thread count and task count. ! This is a requirement of consistancy checking in cam. ! J_tmp = 0.0_r8 -!JMD print *,'global_integral: before loop' do ie=nets,nete do j=1,np do i=1,np da = elem(ie)%mp(i,j)*elem(ie)%metdet(i,j) - J_tmp(ie) = J_tmp(ie) + da*h(i,j,ie) + J_tmp(ie) = J_tmp(ie) + da*fld(i,j,ie) end do end do end do do ie=nets,nete global_shared_buf(ie,1) = J_tmp(ie) enddo -!JMD print *,'global_integral: before wrap_repro_sum' call wrap_repro_sum(nvars=1, comm=hybrid%par%comm) -!JMD print *,'global_integral: after wrap_repro_sum' I_tmp = global_shared_sum(1) -!JMD print *,'global_integral: after global_shared_sum' I_sphere = I_tmp(1)/(4.0_r8*PI) - end function global_integral + end function global_integral_elem + + function global_integral_fvm(fvm,fld,hybrid,npts,nets,nete) result(I_sphere) + use hybrid_mod, only: hybrid_t + use fvm_control_volume_mod, only: fvm_struct + use physconst, only: pi + use parallel_mod, only: global_shared_buf, global_shared_sum + + type (fvm_struct) , intent(in) :: fvm(:) + integer , intent(in) :: npts,nets,nete + real (kind=r8), intent(in) :: fld(npts,npts,nets:nete) + type (hybrid_t) , intent(in) :: hybrid + + real (kind=r8) :: I_sphere + + ! Local variables + + integer :: ie,j,i + real(kind=r8) :: I_tmp(1) + + real (kind=r8) :: da + real (kind=r8) :: J_tmp(nets:nete) +! +! This algorithm is independent of thread count and task count. +! This is a requirement of consistancy checking in cam. +! + J_tmp = 0.0_r8 + do ie=nets,nete + do j=1,npts + do i=1,npts + da = fvm(ie)%area_sphere(i,j) + J_tmp(ie) = J_tmp(ie) + da*fld(i,j,ie) + end do + end do + end do + do ie=nets,nete + global_shared_buf(ie,1) = J_tmp(ie) + enddo + call wrap_repro_sum(nvars=1, comm=hybrid%par%comm) + I_tmp = global_shared_sum(1) + I_sphere = I_tmp(1)/(4.0_r8*PI) + + end function global_integral_fvm !------------------------------------------------------------------------------------ @@ -205,26 +229,26 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! worse viscosity CFL (given by dtnu) is not violated by reducing ! viscosity coefficient in regions where CFL is violated ! - use hybrid_mod, only: hybrid_t, PrintHybrid + use hybrid_mod, only: hybrid_t use element_mod, only: element_t - use dimensions_mod, only: np,ne,nelem,nelemd,nc,nhe,qsize,ntrac,nlev,large_Courant_incr - use dimensions_mod, only: nu_scale_top,nu_div_lev,nu_lev + use dimensions_mod, only: np,ne,nelem,nc,nhe,use_cslam,nlev,large_Courant_incr + use dimensions_mod, only: nu_scale_top,nu_div_lev,nu_lev,nu_t_lev use quadrature_mod, only: gausslobatto, quadrature_t - + use reduction_mod, only: ParallelMin,ParallelMax use physconst, only: ra, rearth, pi - use control_mod, only: nu, nu_div, nu_q, nu_p, nu_s, nu_top, fine_ne, rk_stage_user, max_hypervis_courant + use control_mod, only: nu, nu_div, nu_q, nu_p, nu_t, nu_top, fine_ne, max_hypervis_courant use control_mod, only: tstep_type, hypervis_power, hypervis_scaling + use control_mod, only: sponge_del4_nu_div_fac, sponge_del4_nu_fac, sponge_del4_lev use cam_abortutils, only: endrun use parallel_mod, only: global_shared_buf, global_shared_sum use edge_mod, only: initedgebuffer, FreeEdgeBuffer, edgeVpack, edgeVunpack use bndry_mod, only: bndry_exchange - use time_mod, only: tstep use mesh_mod, only: MeshUseMeshFile use dimensions_mod, only: ksponge_end, kmvis_ref, kmcnd_ref,rho_ref use physconst, only: cpair - + use std_atm_profile,only: std_atm_height type(element_t) , intent(inout) :: elem(:) integer , intent(in) :: nets,nete type (hybrid_t) , intent(in) :: hybrid @@ -235,19 +259,19 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& real (kind=r8), intent(in) :: dt_remap_actual,dt_tracer_fvm_actual,dt_tracer_se_actual,& dt_dyn_actual,dt_dyn_visco_actual,dt_dyn_del2_actual, & dt_tracer_visco_actual, dt_phys - + ! Element statisics real (kind=r8) :: max_min_dx,min_min_dx,min_max_dx,max_unif_dx ! used for normalizing scalar HV real (kind=r8) :: max_normDinv, min_normDinv ! used for CFL real (kind=r8) :: min_area, max_area,max_ratio !min/max element area - real (kind=r8) :: avg_area, avg_min_dx + real (kind=r8) :: avg_area, avg_min_dx,tot_area,tot_area_rad real (kind=r8) :: min_hypervis, max_hypervis, avg_hypervis, stable_hv real (kind=r8) :: normDinv_hypervis real (kind=r8) :: x, y, noreast, nw, se, sw real (kind=r8), dimension(np,np,nets:nete) :: zeta real (kind=r8) :: lambda_max, lambda_vis, min_gw, lambda,umax, ugw - real (kind=r8) :: press,scale1,scale2,scale3, max_laplace - integer :: ie,corner, i, j, rowind, colind, k + real (kind=r8) :: scale1, max_laplace,z(nlev) + integer :: ie, i, j, rowind, colind, k type (quadrature_t) :: gp character(LEN=256) :: rk_str @@ -255,11 +279,12 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& real (kind=r8) :: dt_max_adv, dt_max_gw, dt_max_tracer_se, dt_max_tracer_fvm real (kind=r8) :: dt_max_hypervis, dt_max_hypervis_tracer, dt_max_laplacian_top - real(kind=r8) :: I_sphere - real(kind=r8) :: h(np,np,nets:nete) + real(kind=r8) :: I_sphere, nu_max, nu_div_max + real(kind=r8) :: fld(np,np,nets:nete) + logical :: top_000_032km, top_032_042km, top_042_090km, top_090_140km, top_140_600km ! model top location ranges + logical :: nu_set,div_set,lev_set - ! Eigenvalues calculated by folks at UMich (Paul U & Jared W) select case (np) case (2) @@ -287,7 +312,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& lambda_max = 0.0_r8 lambda_vis = 0.0_r8 end select - + if ((lambda_max.eq.0_r8).and.(hybrid%masterthread)) then print*, "lambda_max not calculated for NP = ",np print*, "Estimate of gravity wave timestep will be incorrect" @@ -296,11 +321,11 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& print*, "lambda_vis not calculated for NP = ",np print*, "Estimate of viscous CFLs will be incorrect" end if - + do ie=nets,nete elem(ie)%variable_hyperviscosity = 1.0_r8 end do - + gp=gausslobatto(np) min_gw = minval(gp%weights) ! @@ -310,11 +335,11 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! !****************************************************************************************** ! - h(:,:,nets:nete)=1.0_r8 + fld(:,:,nets:nete)=1.0_r8 ! Calculate surface area by integrating 1.0_r8 over sphere and dividing by 4*PI (Should be 1) - I_sphere = global_integral(elem, h(:,:,nets:nete),hybrid,np,nets,nete) - - min_normDinv = 1E99_r8 + I_sphere = global_integral(elem, fld(:,:,nets:nete),hybrid,np,nets,nete) + + min_normDinv = 1E99_r8 max_normDinv = 0 min_max_dx = 1E99_r8 min_min_dx = 1E99_r8 @@ -326,39 +351,43 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& max_normDinv = max(max_normDinv,elem(ie)%normDinv) min_normDinv = min(min_normDinv,elem(ie)%normDinv) min_min_dx = min(min_min_dx,elem(ie)%dx_short) - max_min_dx = max(max_min_dx,elem(ie)%dx_short) + max_min_dx = max(max_min_dx,elem(ie)%dx_short) min_max_dx = min(min_max_dx,elem(ie)%dx_long) - + elem(ie)%area = sum(elem(ie)%spheremp(:,:)) min_area = min(min_area,elem(ie)%area) max_area = max(max_area,elem(ie)%area) max_ratio = max(max_ratio,elem(ie)%dx_long/elem(ie)%dx_short) global_shared_buf(ie,1) = elem(ie)%area - global_shared_buf(ie,2) = elem(ie)%dx_short + global_shared_buf(ie,2) = elem(ie)%dx_short enddo call wrap_repro_sum(nvars=2, comm=hybrid%par%comm) avg_area = global_shared_sum(1)/dble(nelem) + tot_area_rad = global_shared_sum(1) avg_min_dx = global_shared_sum(2)/dble(nelem) - + min_area = ParallelMin(min_area,hybrid) max_area = ParallelMax(max_area,hybrid) - min_normDinv = ParallelMin(min_normDinv,hybrid) + min_normDinv = ParallelMin(min_normDinv,hybrid) max_normDinv = ParallelMax(max_normDinv,hybrid) - min_min_dx = ParallelMin(min_min_dx,hybrid) + min_min_dx = ParallelMin(min_min_dx,hybrid) max_min_dx = ParallelMax(max_min_dx,hybrid) - min_max_dx = ParallelMin(min_max_dx,hybrid) + min_max_dx = ParallelMin(min_max_dx,hybrid) max_ratio = ParallelMax(max_ratio,hybrid) - ! Physical units for area - min_area = min_area*rearth*rearth/1000000._r8 - max_area = max_area*rearth*rearth/1000000._r8 - avg_area = avg_area*rearth*rearth/1000000._r8 + ! Physical units for area (unit sphere to Earth sphere) + min_area = min_area*rearth*rearth/1000000._r8 !m2 (rearth is in units of km) + max_area = max_area*rearth*rearth/1000000._r8 !m2 (rearth is in units of km) + avg_area = avg_area*rearth*rearth/1000000._r8 !m2 (rearth is in units of km) + tot_area = tot_area_rad*rearth*rearth/1000000._r8!m2 (rearth is in units of km) if (hybrid%masterthread) then write(iulog,* )"" write(iulog,* )"Running Global Integral Diagnostic..." write(iulog,*)"Area of unit sphere is",I_sphere write(iulog,*)"Should be 1.0 to round off..." write(iulog,'(a,f9.3)') 'Element area: max/min',(max_area/min_area) + write(iulog,'(a,E23.15)') 'Total Grid area: ',(tot_area) + write(iulog,'(a,E23.15)') 'Total Grid area rad^2: ',(tot_area_rad) if (.not.MeshUseMeshFile) then write(iulog,'(a,f6.3,f8.2)') "Average equatorial node spacing (deg, km) = ", & dble(90)/dble(ne*(np-1)), PI*rearth/(2000.0_r8*dble(ne*(np-1))) @@ -369,8 +398,8 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& write(iulog,'(a,3f8.2)') "dx based on sqrt element area: ave,min,max = ", & sqrt(avg_area)/(np-1),sqrt(min_area)/(np-1),sqrt(max_area)/(np-1) end if - - + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! SCALAR, RESOLUTION-AWARE HYPERVISCOSITY ! this block of code initializes the variable_hyperviscsoity() array @@ -381,12 +410,12 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! Mike Levy !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (hypervis_power /= 0) then - + min_hypervis = 1d99 max_hypervis = 0 avg_hypervis = 0 - - + + max_unif_dx = min_max_dx ! use this for average resolution, unless: ! viscosity in namelist specified for smallest element: if (fine_ne>0) then @@ -395,7 +424,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& if (np /= 4 ) call endrun('ERROR: setting fine_ne only supported with NP=4') max_unif_dx = (111.28_r8*30)/dble(fine_ne) ! in km endif - + ! ! note: if L = eigenvalue of metinv, then associated length scale (km) is ! dx = 1.0_r8/( sqrt(L)*0.5_r8*dble(np-1)*ra*1000.0_r8) @@ -413,17 +442,17 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& normDinv_hypervis = 0 do ie=nets,nete ! variable viscosity based on map from ulatlon -> ucontra - + ! dx_long elem(ie)%variable_hyperviscosity = sqrt((elem(ie)%dx_long/max_unif_dx) ** hypervis_power) elem(ie)%hv_courant = dtnu*(elem(ie)%variable_hyperviscosity(1,1)**2) * & (lambda_vis**2) * ((ra*elem(ie)%normDinv)**4) - + ! Check to see if this is stable if (elem(ie)%hv_courant.gt.max_hypervis_courant) then stable_hv = sqrt( max_hypervis_courant / & ( dtnu * (lambda_vis)**2 * (ra*elem(ie)%normDinv)**4 ) ) - + #if 0 ! Useful print statements for debugging the adjustments to hypervis print*, "Adjusting hypervis on elem ", elem(ie)%GlobalId @@ -437,19 +466,19 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& elem(ie)%hv_courant = dtnu*(stable_hv**2) * (lambda_vis)**2 * (ra*elem(ie)%normDinv)**4 end if normDinv_hypervis = max(normDinv_hypervis, elem(ie)%hv_courant/dtnu) - + min_hypervis = min(min_hypervis, elem(ie)%variable_hyperviscosity(1,1)) max_hypervis = max(max_hypervis, elem(ie)%variable_hyperviscosity(1,1)) global_shared_buf(ie,1) = elem(ie)%variable_hyperviscosity(1,1) end do - + min_hypervis = ParallelMin(min_hypervis, hybrid) max_hypervis = ParallelMax(max_hypervis, hybrid) call wrap_repro_sum(nvars=1, comm=hybrid%par%comm) avg_hypervis = global_shared_sum(1)/dble(nelem) - + normDinv_hypervis = ParallelMax(normDinv_hypervis, hybrid) - + ! apply DSS (aka assembly procedure) to variable_hyperviscosity (makes continuous) call initEdgeBuffer(hybrid%par,edgebuf,elem,1) do ie=nets,nete @@ -462,7 +491,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& elem(ie)%variable_hyperviscosity(:,:) = zeta(:,:,ie)*elem(ie)%rspheremp(:,:) end do call FreeEdgeBuffer(edgebuf) - + ! replace hypervis w/ bilinear based on continuous corner values do ie=nets,nete noreast = elem(ie)%variable_hyperviscosity(np,np) @@ -492,7 +521,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! constant coefficient formula: normDinv_hypervis = (lambda_vis**2) * (ra*max_normDinv)**4 endif - + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! TENSOR, RESOLUTION-AWARE HYPERVISCOSITY ! The tensorVisc() array is computed in cube_mod.F90 @@ -501,7 +530,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! Oksana Guba !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (hypervis_scaling /= 0) then - + call initEdgeBuffer(hybrid%par,edgebuf,elem,1) do rowind=1,2 do colind=1,2 @@ -509,7 +538,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& zeta(:,:,ie) = elem(ie)%tensorVisc(:,:,rowind,colind)*elem(ie)%spheremp(:,:) call edgeVpack(edgebuf,zeta(1,1,ie),1,0,ie) end do - + call bndry_exchange(hybrid,edgebuf) do ie=nets,nete call edgeVunpack(edgebuf,zeta(1,1,ie),1,0,ie) @@ -518,9 +547,9 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& enddo !rowind enddo !colind call FreeEdgeBuffer(edgebuf) - + !IF BILINEAR MAP OF V NEEDED - + do rowind=1,2 do colind=1,2 ! replace hypervis w/ bilinear based on continuous corner values @@ -542,41 +571,146 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& end do end do enddo !rowind - enddo !colind + enddo !colind endif deallocate(gp%points) deallocate(gp%weights) call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu_p ,1.0_r8 ,'_p ') - call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu ,0.5_r8,' ') - if (ptop>100.0_r8) then + call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu ,1.0_r8,' ') + call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu_div,2.5_r8 ,'_div') + + if (nu_q<0) nu_q = nu_p ! necessary for consistency + if (nu_t<0) nu_t = nu_p ! temperature damping is always equal to nu_p + + nu_div_lev(:) = nu_div + nu_lev(:) = nu + nu_t_lev(:) = nu_p + + ! + ! sponge layer strength needed for stability depends on model top location + ! + top_000_032km = .false. + top_032_042km = .false. + top_042_090km = .false. + top_090_140km = .false. + top_140_600km = .false. + nu_set = sponge_del4_nu_fac < 0 + div_set = sponge_del4_nu_div_fac < 0 + lev_set = sponge_del4_lev < 0 + if (ptop>1000.0_r8) then + ! + ! low top; usually idealized test cases ! - ! CAM setting + top_000_032km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_000_032km" + else if (ptop>100.0_r8) then ! - call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu_div,2.5_r8 ,'_div') - nu_div_lev(:) = nu_div - nu_lev(:) = nu + ! CAM6 top (~225 Pa) or CAM7 low top + ! + top_032_042km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_032_042km" + else if (ptop>1e-1_r8) then + ! + ! CAM7 top (~4.35e-1 Pa) + ! + top_042_090km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_042_090km" + else if (ptop>1E-4_r8) then + ! + ! WACCM top (~4.5e-4 Pa) + ! + top_090_140km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_090_140km" else ! - ! WACCM setting + ! WACCM-x - geospace (~4e-7 Pa) ! - call automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu_div,2.5_r8 ,'_div') - if (hybrid%masterthread) write(iulog,*) ": sponge layer viscosity scaling factor" + top_140_600km = .true. + if (hybrid%masterthread) write(iulog,* )"Model top damping configuration: top_140_600km" + end if + ! + ! Logging text for sponge layer configuration + ! + if (hybrid%masterthread .and. (nu_set .or. div_set .or. lev_set)) then + write(iulog,* )"" + write(iulog,* )"Sponge layer del4 coefficient defaults based on model top location:" + end if + ! + ! if user or namelist is not specifying sponge del4 settings here are best guesses (empirically determined) + ! + if (top_042_090km) then + if (sponge_del4_lev <0) sponge_del4_lev = 4 + if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 3.375_r8 !max value without having to increase subcycling of div4 + if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 3.375_r8 !max value without having to increase subcycling of div4 + else if (top_090_140km.or.top_140_600km) then ! defaults for waccm(x) + if (sponge_del4_lev <0) sponge_del4_lev = 20 + if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 5.0_r8 + if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 10.0_r8 + else + if (sponge_del4_lev <0) sponge_del4_lev = 1 + if (sponge_del4_nu_fac <0) sponge_del4_nu_fac = 1.0_r8 + if (sponge_del4_nu_div_fac<0) sponge_del4_nu_div_fac = 1.0_r8 + end if + + ! set max wind speed for diagnostics + umax = 120.0_r8 + if (top_042_090km) then + umax = 240._r8 + else if (top_090_140km) then + umax = 300._r8 + else if (top_140_600km) then + umax = 800._r8 + end if + ! + ! Log sponge layer configuration + ! + if (hybrid%masterthread) then + if (nu_set) then + write(iulog, '(a,e9.2)') ' sponge_del4_nu_fac = ',sponge_del4_nu_fac + end if + + if (div_set) then + write(iulog, '(a,e9.2)') ' sponge_del4_nu_div_fac = ',sponge_del4_nu_div_fac + end if + + if (lev_set) then + write(iulog, '(a,i0)') ' sponge_del4_lev = ',sponge_del4_lev + end if + write(iulog,* )"" + end if + + nu_max = sponge_del4_nu_fac*nu_p + nu_div_max = sponge_del4_nu_div_fac*nu_p + do k=1,nlev + ! Vertical profile from FV dycore (see Lauritzen et al. 2012 DOI:10.1177/1094342011410088) + scale1 = 0.5_r8*(1.0_r8+tanh(2.0_r8*log(pmid(sponge_del4_lev)/pmid(k)))) + if (sponge_del4_nu_div_fac /= 1.0_r8) then + nu_div_lev(k) = (1.0_r8-scale1)*nu_div+scale1*nu_div_max + end if + if (sponge_del4_nu_fac /= 1.0_r8) then + nu_lev(k) = (1.0_r8-scale1)*nu +scale1*nu_max + nu_t_lev(k) = (1.0_r8-scale1)*nu_p +scale1*nu_max + end if + end do + + if (hybrid%masterthread)then + write(iulog,*) "z computed from barometric formula (using US std atmosphere)" + call std_atm_height(pmid(:),z(:)) + write(iulog,*) "k,pmid_ref,z,nu_lev,nu_t_lev,nu_div_lev" do k=1,nlev - press = pmid(k) - - scale1 = 0.5_r8*(1.0_r8+tanh(2.0_r8*log(100.0_r8/press))) - nu_div_lev(k) = (1.0_r8-scale1)*nu_div+scale1*2.0_r8*nu_div - nu_div_lev(k) = nu_div - nu_lev(k) = (1.0_r8-scale1)*nu +scale1*nu_p - nu_lev(k) = nu - if (hybrid%masterthread) write(iulog,*) "nu_lev=",k,nu_lev(k) - if (hybrid%masterthread) write(iulog,*) "nu_div_lev=",k,nu_div_lev(k) + write(iulog,'(i3,5e11.4)') k,pmid(k),z(k),nu_lev(k),nu_t_lev(k),nu_div_lev(k) end do - end if + if (nu_top>0) then + write(iulog,*) ": ksponge_end = ",ksponge_end + write(iulog,*) ": sponge layer Laplacian damping" + write(iulog,*) "k, p, z, nu_scale_top, nu (actual Laplacian damping coefficient)" - if (nu_q<0) nu_q = nu_p ! necessary for consistency - if (nu_s<0) nu_s = nu_p ! temperature damping is always equal to nu_p + do k=1,ksponge_end + write(iulog,'(i3,4e11.4)') k,pmid(k),z(k),nu_scale_top(k),nu_scale_top(k)*nu_top + end do + end if + end if !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! @@ -589,7 +723,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& if (tstep_type==1) then S_rk = 2.0_r8 rk_str = ' * RK2-SSP 3 stage (same as tracers)' - elseif (tstep_type==2) then + elseif (tstep_type==2) then S_rk = 2.0_r8 rk_str = ' * classic RK3' elseif (tstep_type==3) then @@ -599,35 +733,25 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& S_rk = 3.0_r8 rk_str = ' * Kinnmark&Gray RK3 5 stage (3rd order)' end if - if (hybrid%masterthread) then + if (hybrid%masterthread) then write(iulog,'(a,f12.8,a)') 'Model top is ',ptop,'Pa' write(iulog,'(a)') ' ' write(iulog,'(a)') 'Timestepping methods used in dynamical core:' - write(iulog,'(a)') + write(iulog,'(a)') write(iulog,*) rk_str write(iulog,'(a)') ' * Spectral-element advection uses SSP preservation RK3' write(iulog,'(a)') ' * Viscosity operators use forward Euler' - if (ntrac>0) then - write(iulog,'(a)') ' * CSLAM uses two time-levels backward trajectory method' - end if end if S_laplacian = 2.0_r8 !using forward Euler for sponge diffusion S_hypervis = 2.0_r8 !using forward Euler for hyperviscosity S_rk_tracer = 2.0_r8 - ! - ! estimate max winds - ! - if (ptop>100.0_r8) then - umax = 120.0_r8 - else - umax = 400.0_r8 - end if + ugw = 342.0_r8 !max gravity wave speed - + dt_max_adv = S_rk/(umax*max_normDinv*lambda_max*ra) dt_max_gw = S_rk/(ugw*max_normDinv*lambda_max*ra) dt_max_tracer_se = S_rk_tracer*min_gw/(umax*max_normDinv*ra) - if (ntrac>0) then + if (use_cslam) then if (large_Courant_incr) then dt_max_tracer_fvm = dble(nhe)*(4.0_r8*pi*Rearth/dble(4.0_r8*ne*nc))/umax else @@ -636,14 +760,15 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& else dt_max_tracer_fvm = -1.0_r8 end if - dt_max_hypervis = s_hypervis/(MAX(MAXVAL(nu_div_lev(:)),MAXVAL(nu_lev(:)))*normDinv_hypervis) + nu_max = MAX(MAXVAL(nu_div_lev(:)),MAXVAL(nu_lev(:)),MAXVAL(nu_t_lev(:))) + dt_max_hypervis = s_hypervis/(nu_max*normDinv_hypervis) dt_max_hypervis_tracer = s_hypervis/(nu_q*normDinv_hypervis) max_laplace = MAX(MAXVAL(nu_scale_top(:))*nu_top,MAXVAL(kmvis_ref(:)/rho_ref(:))) max_laplace = MAX(max_laplace,MAXVAL(kmcnd_ref(:)/(cpair*rho_ref(:)))) dt_max_laplacian_top = 1.0_r8/(max_laplace*((ra*max_normDinv)**2)*lambda_vis) - - if (hybrid%masterthread) then + + if (hybrid%masterthread) then write(iulog,'(a,f10.2,a)') ' ' write(iulog,'(a,f10.2,a)') 'Estimates for maximum stable and actual time-steps for different aspects of algorithm:' write(iulog,'(a,f12.8,a)') '(assume max wind is ',umax,'m/s)' @@ -652,18 +777,19 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_dyn (time-stepping dycore ; u,v,T,dM) < ',& MIN(dt_max_adv,dt_max_gw),'s ',dt_dyn_actual,'s' if (dt_dyn_actual>MIN(dt_max_adv,dt_max_gw)) write(iulog,*) 'WARNING: dt_dyn theoretically unstable' - + write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_dyn_vis (hyperviscosity) ; u,v,T,dM) < ',dt_max_hypervis,& 's ',dt_dyn_visco_actual,'s' if (dt_dyn_visco_actual>dt_max_hypervis) write(iulog,*) 'WARNING: dt_dyn_vis theoretically unstable' - write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_se (time-stepping tracers ; q ) < ',dt_max_tracer_se,'s ',& + if (.not.use_cslam) then + write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_se (time-stepping tracers ; q ) < ',dt_max_tracer_se,'s ',& dt_tracer_se_actual,'s' - if (dt_tracer_se_actual>dt_max_tracer_se) write(iulog,*) 'WARNING: dt_tracer_se theoretically unstable' - write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_vis (hyperviscosity tracers; q ) < ',dt_max_hypervis_tracer,'s',& - dt_tracer_visco_actual,'s' - if (dt_tracer_visco_actual>dt_max_hypervis_tracer) write(iulog,*) 'WARNING: dt_tracer_hypervis theoretically unstable' - - if (ntrac>0) then + if (dt_tracer_se_actual>dt_max_tracer_se) write(iulog,*) 'WARNING: dt_tracer_se theoretically unstable' + write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_vis (hyperviscosity tracers; q ) < ',dt_max_hypervis_tracer,'s',& + dt_tracer_visco_actual,'s' + if (dt_tracer_visco_actual>dt_max_hypervis_tracer) write(iulog,*) 'WARNING: dt_tracer_hypervis theoretically unstable' + end if + if (use_cslam) then write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_fvm (time-stepping tracers ; q ) < ',dt_max_tracer_fvm,& 's ',dt_tracer_fvm_actual if (dt_tracer_fvm_actual>dt_max_tracer_fvm) write(iulog,*) 'WARNING: dt_tracer_fvm theortically unstable' @@ -676,8 +802,14 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& write(iulog,'(a,f10.2,a,f10.2,a)') '* dt (del2 sponge ; u,v,T,dM) < ',& dt_max_laplacian_top,'s',dt_dyn_del2_actual,'s' - if (dt_dyn_del2_actual>dt_max_laplacian_top) & - write(iulog,*) 'WARNING: theoretically unstable in sponge; increase se_hypervis_subcycle_sponge' + if (dt_dyn_del2_actual>dt_max_laplacian_top) then + if (k==1) then + write(iulog,*) 'WARNING: theoretically unstable in sponge; increase se_hypervis_subcycle_sponge',& + ' (this WARNING can sometimes be ignored in level 1)' + else + write(iulog,*) 'WARNING: theoretically unstable in sponge; increase se_hypervis_subcycle_sponge' + endif + end if end do write(iulog,*) ' ' if (hypervis_power /= 0) then @@ -687,8 +819,8 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& write(iulog,*) 'tstep_type = ',tstep_type end if end subroutine print_cfl - - ! + + ! ! ============================ ! global_maximum: ! @@ -696,13 +828,13 @@ end subroutine print_cfl ! ! ================================ - function global_maximum(h,hybrid,npts,nets,nete) result(Max_sphere) + function global_maximum(fld,hybrid,npts,nets,nete) result(Max_sphere) use hybrid_mod, only : hybrid_t use reduction_mod, only : red_max, pmax_mt integer , intent(in) :: npts,nets,nete - real (kind=r8), intent(in) :: h(npts,npts,nets:nete) + real (kind=r8), intent(in) :: fld(npts,npts,nets:nete) type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: Max_sphere @@ -711,7 +843,7 @@ function global_maximum(h,hybrid,npts,nets,nete) result(Max_sphere) real (kind=r8) :: redp(1) - Max_sphere = MAXVAL(h(:,:,nets:nete)) + Max_sphere = MAXVAL(fld(:,:,nets:nete)) redp(1) = Max_sphere call pmax_mt(red_max,redp,1,hybrid) @@ -726,39 +858,39 @@ end function global_maximum ! for a scalar quantity ! =========================================================== - function l1_snorm(elem, h,ht,hybrid,npts,nets,nete) result(l1) + function l1_snorm(elem,fld,fld_exact,hybrid,npts,nets,nete) result(l1) use element_mod, only : element_t use hybrid_mod, only : hybrid_t type(element_t) , intent(in) :: elem(:) integer , intent(in) :: npts,nets,nete - real (kind=r8), intent(in) :: h(npts,npts,nets:nete) ! computed soln - real (kind=r8), intent(in) :: ht(npts,npts,nets:nete) ! true soln + real (kind=r8), intent(in) :: fld(npts,npts,nets:nete) ! computed soln + real (kind=r8), intent(in) :: fld_exact(npts,npts,nets:nete) ! true soln type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: l1 ! Local variables - real (kind=r8) :: dhabs(npts,npts,nets:nete) - real (kind=r8) :: htabs(npts,npts,nets:nete) - real (kind=r8) :: dhabs_int - real (kind=r8) :: htabs_int + real (kind=r8) :: dfld_abs(npts,npts,nets:nete) + real (kind=r8) :: fld_exact_abs(npts,npts,nets:nete) + real (kind=r8) :: dfld_abs_int + real (kind=r8) :: fld_exact_abs_int integer i,j,ie do ie=nets,nete do j=1,npts do i=1,npts - dhabs(i,j,ie) = ABS(h(i,j,ie)-ht(i,j,ie)) - htabs(i,j,ie) = ABS(ht(i,j,ie)) + dfld_abs(i,j,ie) = ABS(fld(i,j,ie)-fld_exact(i,j,ie)) + fld_exact_abs(i,j,ie) = ABS(fld_exact(i,j,ie)) end do end do end do - dhabs_int = global_integral(elem, dhabs(:,:,nets:nete),hybrid,npts,nets,nete) - htabs_int = global_integral(elem, htabs(:,:,nets:nete),hybrid,npts,nets,nete) + dfld_abs_int = global_integral(elem, dfld_abs(:,:,nets:nete),hybrid,npts,nets,nete) + fld_exact_abs_int = global_integral(elem, fld_exact_abs(:,:,nets:nete),hybrid,npts,nets,nete) - l1 = dhabs_int/htabs_int + l1 = dfld_abs_int/fld_exact_abs_int end function l1_snorm @@ -834,38 +966,38 @@ end function l1_vnorm ! ! =========================================================== - function l2_snorm(elem, h,ht,hybrid,npts,nets,nete) result(l2) + function l2_snorm(elem,fld,fld_exact,hybrid,npts,nets,nete) result(l2) use element_mod, only : element_t use hybrid_mod, only : hybrid_t type(element_t), intent(in) :: elem(:) integer , intent(in) :: npts,nets,nete - real (kind=r8), intent(in) :: h(npts,npts,nets:nete) ! computed soln - real (kind=r8), intent(in) :: ht(npts,npts,nets:nete) ! true soln + real (kind=r8), intent(in) :: fld(npts,npts,nets:nete) ! computed soln + real (kind=r8), intent(in) :: fld_exact(npts,npts,nets:nete) ! true soln type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: l2 ! Local variables real (kind=r8) :: dh2(npts,npts,nets:nete) - real (kind=r8) :: ht2(npts,npts,nets:nete) + real (kind=r8) :: fld_exact2(npts,npts,nets:nete) real (kind=r8) :: dh2_int - real (kind=r8) :: ht2_int + real (kind=r8) :: fld_exact2_int integer i,j,ie do ie=nets,nete do j=1,npts do i=1,npts - dh2(i,j,ie)=(h(i,j,ie)-ht(i,j,ie))**2 - ht2(i,j,ie)=ht(i,j,ie)**2 + dh2(i,j,ie)=(fld(i,j,ie)-fld_exact(i,j,ie))**2 + fld_exact2(i,j,ie)=fld_exact(i,j,ie)**2 end do end do end do dh2_int = global_integral(elem,dh2(:,:,nets:nete),hybrid,npts,nets,nete) - ht2_int = global_integral(elem,ht2(:,:,nets:nete),hybrid,npts,nets,nete) + fld_exact2_int = global_integral(elem,fld_exact2(:,:,nets:nete),hybrid,npts,nets,nete) - l2 = SQRT(dh2_int)/SQRT(ht2_int) + l2 = SQRT(dh2_int)/SQRT(fld_exact2_int) end function l2_snorm @@ -940,35 +1072,35 @@ end function l2_vnorm ! ! =========================================================== - function linf_snorm(h,ht,hybrid,npts,nets,nete) result(linf) + function linf_snorm(fld,fld_exact,hybrid,npts,nets,nete) result(linf) use hybrid_mod, only : hybrid_t integer , intent(in) :: npts,nets,nete - real (kind=r8), intent(in) :: h(npts,npts,nets:nete) ! computed soln - real (kind=r8), intent(in) :: ht(npts,npts,nets:nete) ! true soln + real (kind=r8), intent(in) :: fld(npts,npts,nets:nete) ! computed soln + real (kind=r8), intent(in) :: fld_exact(npts,npts,nets:nete) ! true soln type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: linf ! Local variables - real (kind=r8) :: dhabs(npts,npts,nets:nete) - real (kind=r8) :: htabs(npts,npts,nets:nete) - real (kind=r8) :: dhabs_max - real (kind=r8) :: htabs_max + real (kind=r8) :: dfld_abs(npts,npts,nets:nete) + real (kind=r8) :: fld_exact_abs(npts,npts,nets:nete) + real (kind=r8) :: dfld_abs_max + real (kind=r8) :: fld_exact_abs_max integer i,j,ie do ie=nets,nete do j=1,npts do i=1,npts - dhabs(i,j,ie)=ABS(h(i,j,ie)-ht(i,j,ie)) - htabs(i,j,ie)=ABS(ht(i,j,ie)) + dfld_abs(i,j,ie)=ABS(fld(i,j,ie)-fld_exact(i,j,ie)) + fld_exact_abs(i,j,ie)=ABS(fld_exact(i,j,ie)) end do end do end do - dhabs_max = global_maximum(dhabs(:,:,nets:nete),hybrid,npts,nets,nete) - htabs_max = global_maximum(htabs(:,:,nets:nete),hybrid,npts,nets,nete) + dfld_abs_max = global_maximum(dfld_abs(:,:,nets:nete),hybrid,npts,nets,nete) + fld_exact_abs_max = global_maximum(fld_exact_abs(:,:,nets:nete),hybrid,npts,nets,nete) - linf = dhabs_max/htabs_max + linf = dfld_abs_max/fld_exact_abs_max end function linf_snorm @@ -1066,7 +1198,7 @@ subroutine wrap_repro_sum (nvars, comm, nsize) !$OMP END MASTER !$OMP BARRIER - + end subroutine wrap_repro_sum subroutine automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min_dx,nu,factor,str) @@ -1080,7 +1212,7 @@ subroutine automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min real (kind=r8), intent(in) :: max_min_dx,min_min_dx,factor real (kind=r8), intent(inout) :: nu character(len=4), intent(in) :: str - + real(r8) :: uniform_res_hypervis_scaling,nu_fac real(kind=r8) :: nu_min, nu_max ! @@ -1094,7 +1226,7 @@ subroutine automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min ! - Boville, B. A., 1991: Sensitivity of simulated climate to ! model resolution. J. Climate, 4, 469-485. ! - ! - TAKAHASHI ET AL., 2006: GLOBAL SIMULATION OF MESOSCALE SPECTRUM + ! - TAKAHASHI ET AL., 2006: GLOBAL SIMULATION OF MESOSCALE SPECTRUM ! uniform_res_hypervis_scaling = 1.0_r8/log10(2.0_r8) ! @@ -1107,10 +1239,12 @@ subroutine automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min if (nu < 0) then if (ne <= 0) then - if (hypervis_scaling/=0) then + if (hypervis_power/=0) then + call endrun('ERROR: Automatic scaling of scalar viscosity not implemented') + else if (hypervis_scaling/=0) then nu_min = factor*nu_fac*(max_min_dx*1000.0_r8)**uniform_res_hypervis_scaling nu_max = factor*nu_fac*(min_min_dx*1000.0_r8)**uniform_res_hypervis_scaling - nu = factor*nu_min + nu = factor*nu_min if (hybrid%masterthread) then write(iulog,'(a,a)') "Automatically setting nu",TRIM(str) write(iulog,'(a,2e9.2,a,2f9.2)') "Value at min/max grid spacing: ",nu_min,nu_max,& @@ -1119,11 +1253,9 @@ subroutine automatically_set_viscosity_coefficients(hybrid,ne,max_min_dx,min_min nu = nu_min*(2.0_r8*rearth/(3.0_r8*max_min_dx*1000.0_r8))**hypervis_scaling/(rearth**4) if (hybrid%masterthread) & write(iulog,'(a,a,a,e9.3)') "Nu_tensor",TRIM(str)," = ",nu - else if (hypervis_power/=0) then - call endrun('ERROR: Automatic scaling of scalar viscosity not implemented') end if else - nu = factor*nu_fac*((30.0_r8/ne)*110000.0_r8)**uniform_res_hypervis_scaling + nu = factor*nu_fac*((30.0_r8/ne)*110000.0_r8)**uniform_res_hypervis_scaling if (hybrid%masterthread) then write(iulog,'(a,a,a,e9.2)') "Automatically setting nu",TRIM(str)," =",nu end if diff --git a/src/dynamics/se/dycore/hybrid_mod.F90 b/src/dynamics/se/dycore/hybrid_mod.F90 index 19f1043a92..5e7b4208ca 100644 --- a/src/dynamics/se/dycore/hybrid_mod.F90 +++ b/src/dynamics/se/dycore/hybrid_mod.F90 @@ -7,7 +7,7 @@ module hybrid_mod use parallel_mod , only : parallel_t, copy_par use thread_mod , only : omp_set_num_threads, omp_get_thread_num use thread_mod , only : horz_num_threads, vert_num_threads, tracer_num_threads -use dimensions_mod, only : nlev, qsize, ntrac +use dimensions_mod, only : nlev, qsize, ntrac, use_cslam implicit none private @@ -241,7 +241,7 @@ subroutine init_loop_ranges(nelemd) work_pool_trac(ith+1,2) = end_index end do - if(ntrac>0 .and. ntrac interp_p - else if (npts==np) then - call endrun('Error in interpolate_vector(): input must be on velocity grid') + else + call endrun('interpolate_vector2d: Error in interpolate_vector(): input must be on GLL grid') endif @@ -1670,8 +1643,7 @@ subroutine interpolate_vector2d(interpdata,elem,fld_cube,npts,fld,input_coords, fld(i,2)=interpol_bilinear(interpdata%interp_xy(i),fld_contra(:,:,2),interp%glp(:),1,np) end do else - write(iulog,*) itype - call endrun("wrong interpolation type") + call endrun("interpolate_vector2d: wrong interpolation type: "//int2str(itype)) endif do i=1,interpdata%n_interp ! convert fld from contra->latlon @@ -1743,8 +1715,8 @@ subroutine interpolate_vector3d(interpdata,elem,fld_cube,npts,nlev,fld,input_coo if (npts==np) then interp => interp_p - else if (npts==np) then - call endrun('Error in interpolate_vector(): input must be on velocity grid') + else + call endrun('interpolate_vector3d: Error in interpolate_vector(): input must be on GLL grid') endif @@ -1765,7 +1737,7 @@ subroutine interpolate_vector3d(interpdata,elem,fld_cube,npts,nlev,fld,input_coo end do end do else - call endrun("wrong interpolation type") + call endrun("interpolate_vector3d: wrong interpolation type: "//int2str(itype)) endif diff --git a/src/dynamics/se/dycore/namelist_mod.F90 b/src/dynamics/se/dycore/namelist_mod.F90 index 8db0b62799..7e375a097e 100644 --- a/src/dynamics/se/dycore/namelist_mod.F90 +++ b/src/dynamics/se/dycore/namelist_mod.F90 @@ -70,7 +70,7 @@ end subroutine homme_set_defaults subroutine homme_postprocess_namelist(mesh_file, par) use mesh_mod, only: MeshOpen - use dimensions_mod, only: ntrac + use dimensions_mod, only: use_cslam ! Dummy arguments character(len=*), intent(in) :: mesh_file type (parallel_t), intent(in) :: par @@ -120,7 +120,7 @@ subroutine homme_postprocess_namelist(mesh_file, par) end if end if - if ((cubed_sphere_map /= 0) .AND. ntrac>0) then + if ((cubed_sphere_map /= 0) .AND. use_cslam) then if (par%masterproc) then write(iulog, *) subname, 'fvm transport and require equi-angle gnomonic cube sphere mapping.' write(iulog, *) ' Set cubed_sphere_map = 0 or comment it out all together. ' diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index ca9c125395..018c281253 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -10,11 +10,10 @@ module prim_advance_mod private save - public :: prim_advance_exp, prim_advance_init, applyCAMforcing, calc_tot_energy_dynamics, compute_omega + public :: prim_advance_exp, prim_advance_init, applyCAMforcing, tot_energy_dyn, compute_omega type (EdgeBuffer_t) :: edge3,edgeOmega,edgeSponge real (kind=r8), allocatable :: ur_weights(:) - contains subroutine prim_advance_init(par, elem) @@ -28,7 +27,9 @@ subroutine prim_advance_init(par, elem) integer :: i call initEdgeBuffer(par,edge3 ,elem,4*nlev ,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) - call initEdgeBuffer(par,edgeSponge,elem,4*ksponge_end,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) + if (ksponge_end>0) then + call initEdgeBuffer(par,edgeSponge,elem,4*ksponge_end,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) + end if call initEdgeBuffer(par,edgeOmega ,elem,nlev ,bndry_type=HME_BNDRY_P2P, nthreads=horz_num_threads) if(.not. allocated(ur_weights)) allocate(ur_weights(qsplit)) @@ -53,18 +54,16 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net use element_mod, only: element_t use hybvcoord_mod, only: hvcoord_t use hybrid_mod, only: hybrid_t - use time_mod, only: TimeLevel_t, timelevel_qdp, tevolve - use dimensions_mod, only: lcp_moist + use se_dyn_time_mod, only: TimeLevel_t, timelevel_qdp, tevolve use fvm_control_volume_mod, only: fvm_struct - use control_mod, only: raytau0 - use physconst, only: get_cp, thermodynamic_active_species_num - use physconst, only: get_kappa_dry, dry_air_species_num - use physconst, only: thermodynamic_active_species_idx_dycore - use physconst, only: cpair, rair + use cam_thermo, only: get_kappa_dry + use air_composition, only: thermodynamic_active_species_num + use air_composition, only: thermodynamic_active_species_idx_dycore, get_cp + use physconst, only: cpair implicit none type (element_t), intent(inout), target :: elem(:) - type(fvm_struct) , intent(in) :: fvm(:) + type(fvm_struct) , intent(inout) :: fvm(:) type (derivative_t) , intent(in) :: deriv type (hvcoord_t) :: hvcoord type (hybrid_t) , intent(in) :: hybrid @@ -75,13 +74,12 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net ! Local real (kind=r8) :: dt_vis, eta_ave_w - real (kind=r8) :: dp(np,np) integer :: ie,nm1,n0,np1,k,qn0,m_cnst, nq real (kind=r8) :: inv_cp_full(np,np,nlev,nets:nete) real (kind=r8) :: qwater(np,np,nlev,thermodynamic_active_species_num,nets:nete) integer :: qidx(thermodynamic_active_species_num) real (kind=r8) :: kappa(np,np,nlev,nets:nete) - call t_startf('prim_advance_exp') + nm1 = tl%nm1 n0 = tl%n0 np1 = tl%np1 @@ -107,9 +105,6 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net ! (K&G 2nd order method has CFL=4. tiny CFL improvement not worth 2nd order) ! - if (dry_air_species_num > 0) & - call endrun('ERROR: SE dycore not ready for species dependent thermodynamics - ABORT') - call omp_set_nested(.true.) ! default weights for computing mean dynamics fluxes @@ -118,6 +113,7 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net ! ================================== ! Take timestep ! ================================== + call t_startf('prim_adv_prep') do nq=1,thermodynamic_active_species_num qidx(nq) = nq end do @@ -127,30 +123,23 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net ! ! make sure Q is updated ! - qwater(:,:,:,nq,ie) = elem(ie)%state%Qdp(:,:,:,m_cnst,qn0)/elem(ie)%state%dp3d(:,:,:,n0) + qwater(:,:,:,nq,ie) = elem(ie)%state%Qdp(:,:,:,m_cnst,qn0)/elem(ie)%state%dp3d(:,:,:,n0) end do end do ! - ! compute Cp and kappa=Rdry/cpdry here and not in RK-stages since Q stays constant => Cp and kappa also stays constant + ! compute Cp and kappa=Rdry/cpdry here and not in RK-stages since Q stays constant ! - if (lcp_moist) then - do ie=nets,nete - call get_cp(1,np,1,np,1,nlev,thermodynamic_active_species_num,qwater(:,:,:,:,ie),& - .true.,inv_cp_full(:,:,:,ie),active_species_idx_dycore=qidx) - end do - else - do ie=nets,nete - inv_cp_full(:,:,:,ie) = 1.0_r8/cpair - end do - end if do ie=nets,nete - call get_kappa_dry(1,np,1,np,1,nlev,nlev,thermodynamic_active_species_num,qwater(:,:,:,:,ie),qidx,kappa(:,:,:,ie)) + call get_cp(qwater(:,:,:,:,ie),.true.,& + inv_cp_full(:,:,:,ie), active_species_idx_dycore=qidx) end do - + do ie=nets,nete + call get_kappa_dry(qwater(:,:,:,:,ie), qidx, kappa(:,:,:,ie)) + end do + call t_stopf('prim_adv_prep') dt_vis = dt - if (raytau0>0) call rayleigh_friction(elem,n0,nets,nete,dt) if (tstep_type==1) then ! RK2-SSP 3 stage. matches tracer scheme. optimal SSP CFL, but ! not optimal for regular CFL @@ -270,16 +259,16 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net call omp_set_nested(.false.) - call t_stopf('prim_advance_exp') end subroutine prim_advance_exp subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsubstep) - use dimensions_mod, only: np, nc, nlev, qsize, ntrac + use dimensions_mod, only: np, nc, nlev, qsize, ntrac, use_cslam use element_mod, only: element_t use control_mod, only: ftype, ftype_conserve use fvm_control_volume_mod, only: fvm_struct - use physconst, only: get_dp, thermodynamic_active_species_idx_dycore + use air_composition, only: thermodynamic_active_species_idx_dycore + use cam_thermo, only: get_dp, MASS_MIXING_RATIO type (element_t) , intent(inout) :: elem(:) type(fvm_struct) , intent(inout) :: fvm(:) real (kind=r8), intent(in) :: dt_dribble, dt_phys @@ -293,8 +282,8 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu real (kind=r8) :: pdel(np,np,nlev) real (kind=r8), allocatable :: ftmp_fvm(:,:,:,:,:) !diagnostics - - if (ntrac>0) allocate(ftmp_fvm(nc,nc,nlev,ntrac,nets:nete)) + call t_startf('applyCAMforc') + if (use_cslam) allocate(ftmp_fvm(nc,nc,nlev,ntrac,nets:nete)) if (ftype==0) then ! @@ -326,7 +315,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu ! do state-update for tracers and "dribbling" forcing for u,v,T ! dt_local = dt_dribble - if (ntrac>0) then + if (use_cslam) then dt_local_tracer = dt_dribble dt_local_tracer_fvm = dt_phys if (nsubstep.ne.1) then @@ -346,7 +335,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu ! ! tracers ! - if (qsize>0.and.dt_local_tracer>0) then + if (.not.use_cslam.and.dt_local_tracer>0) then #if (defined COLUMN_OPENMP) !$omp parallel do num_threads(tracer_num_threads) private(q,k,i,j,v1) #endif @@ -375,7 +364,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu else ftmp(:,:,:,:,ie) = 0.0_r8 end if - if (ntrac>0.and.dt_local_tracer_fvm>0) then + if (use_cslam.and.dt_local_tracer_fvm>0) then ! ! Repeat for the fvm tracers: fc holds tendency (fc_new-fc_old)/dt_physics ! @@ -399,18 +388,16 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu end do end do else - if (ntrac>0) ftmp_fvm(:,:,:,:,ie) = 0.0_r8 + if (use_cslam) ftmp_fvm(:,:,:,:,ie) = 0.0_r8 end if - - if (ftype_conserve==1) then - call get_dp(1,np,1,np,1,nlev,qsize,elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp),2, & - thermodynamic_active_species_idx_dycore,elem(ie)%state%dp3d(:,:,:,np1),pdel) + if (ftype_conserve==1.and..not.use_cslam) then + call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp), MASS_MIXING_RATIO, & + thermodynamic_active_species_idx_dycore, elem(ie)%state%dp3d(:,:,:,np1), pdel) do k=1,nlev do j=1,np do i = 1,np pdel(i,j,k)=elem(ie)%derived%FDP(i,j,k)/pdel(i,j,k) - elem(ie)%state%T(i,j,k,np1) = elem(ie)%state%T(i,j,k,np1) + & dt_local*elem(ie)%derived%FT(i,j,k)*pdel(i,j,k) ! @@ -430,13 +417,14 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu dt_local*elem(ie)%derived%FM(:,:,:,:) end if end do - if (ntrac>0) then + if (use_cslam) then call output_qdp_var_dynamics(ftmp_fvm(:,:,:,:,:),nc,ntrac,nets,nete,'PDC') else call output_qdp_var_dynamics(ftmp(:,:,:,:,:),np,qsize,nets,nete,'PDC') end if - if (ftype==1.and.nsubstep==1) call calc_tot_energy_dynamics(elem,fvm,nets,nete,np1,np1_qdp,'p2d') - if (ntrac>0) deallocate(ftmp_fvm) + if (ftype==1.and.nsubstep==1) call tot_energy_dyn(elem,fvm,nets,nete,np1,np1_qdp,'p2d') + if (use_cslam) deallocate(ftmp_fvm) + call t_stopf('applyCAMforc') end subroutine applyCAMforcing @@ -444,19 +432,19 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, ! ! take one timestep of: ! u(:,:,:,np) = u(:,:,:,np) + dt2*nu*laplacian**order ( u ) - ! T(:,:,:,np) = T(:,:,:,np) + dt2*nu_s*laplacian**order ( T ) + ! T(:,:,:,np) = T(:,:,:,np) + dt2*nu_t*laplacian**order ( T ) ! ! ! For correct scaling, dt2 should be the same 'dt2' used in the leapfrog advace ! ! - use physconst, only: gravit, cappa, cpair, tref, lapse_rate, get_dp_ref - use dimensions_mod, only: np, nlev, nc, ntrac, npsq, qsize - use dimensions_mod, only: hypervis_dynamic_ref_state,ksponge_end + use physconst, only: cappa, cpair + use cam_thermo, only: get_molecular_diff_coef, get_rho_dry + use dimensions_mod, only: np, nlev, nc, use_cslam, npsq, qsize, ksponge_end use dimensions_mod, only: nu_scale_top,nu_lev,kmvis_ref,kmcnd_ref,rho_ref,km_sponge_factor - use dimensions_mod, only: kmvisi_ref,kmcndi_ref,rhoi_ref - use control_mod, only: nu, nu_s, hypervis_subcycle,hypervis_subcycle_sponge, nu_p, nu_top - use control_mod, only: molecular_diff + 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,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 @@ -467,13 +455,12 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, use viscosity_mod, only: biharmonic_wk_dp3d use hybvcoord_mod, only: hvcoord_t use fvm_control_volume_mod, only: fvm_struct - use physconst, only: thermodynamic_active_species_idx_dycore - use physconst, only: get_molecular_diff_coef,get_rho_dry + use air_composition, only: thermodynamic_active_species_idx_dycore use cam_history, only: outfld, hist_fld_active type (hybrid_t) , intent(in) :: hybrid type (element_t) , intent(inout), target :: elem(:) - type(fvm_struct) , intent(in) :: fvm(:) + type(fvm_struct) , intent(inout) :: fvm(:) type (EdgeBuffer_t), intent(inout):: edge3 type (derivative_t), intent(in ) :: deriv integer , intent(in) :: nets,nete, nt, qn0 @@ -486,8 +473,6 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, integer :: kbeg, kend, kblk real (kind=r8), dimension(np,np,2,nlev,nets:nete) :: vtens real (kind=r8), dimension(np,np,nlev,nets:nete) :: ttens, dptens - real (kind=r8), dimension(np,np,nlev,nets:nete) :: dp3d_ref, T_ref - real (kind=r8), dimension(np,np,nets:nete) :: ps_ref real (kind=r8), dimension(0:np+1,0:np+1,nlev) :: corners real (kind=r8), dimension(2,2,2) :: cflux real (kind=r8) :: temp (np,np,nlev) @@ -496,60 +481,19 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, type (EdgeDescriptor_t) :: desc real (kind=r8), dimension(np,np) :: lap_t,lap_dp - real (kind=r8), dimension(np,np) :: tmp, tmp2 real (kind=r8), dimension(np,np,ksponge_end,nets:nete):: kmvis,kmcnd,rho_dry - real (kind=r8), dimension(np,np,ksponge_end+1):: kmvisi,kmcndi - real (kind=r8), dimension(np,np,ksponge_end+1):: pint,rhoi_dry - real (kind=r8), dimension(np,np,ksponge_end ):: pmid real (kind=r8), dimension(np,np,nlev) :: tmp_kmvis,tmp_kmcnd real (kind=r8), dimension(np,np,2) :: lap_v - real (kind=r8) :: v1,v2,v1new,v2new,dt,heating,T0,T1 + real (kind=r8) :: v1,v2,v1new,v2new,dt,heating real (kind=r8) :: laplace_fluxes(nc,nc,4) real (kind=r8) :: rhypervis_subcycle real (kind=r8) :: nu_ratio1, ptop, inv_rho - real (kind=r8), dimension(ksponge_end) :: dtemp,du,dv real (kind=r8) :: nu_temp, nu_dp, nu_velo - if (nu_s == 0 .and. nu == 0 .and. nu_p==0 ) return; + if (nu_t == 0 .and. nu == 0 .and. nu_p==0 ) return; ptop = hvcoord%hyai(1)*hvcoord%ps0 - if (hypervis_dynamic_ref_state) then - ! - ! use dynamic reference pressure (P. Callaghan) - ! - call calc_dp3d_reference(elem,edge3,hybrid,nets,nete,nt,hvcoord,dp3d_ref) - do ie=nets,nete - ps_ref(:,:,ie) = ptop + sum(elem(ie)%state%dp3d(:,:,:,nt),3) - end do - else - ! - ! use static reference pressure (hydrostatic balance incl. effect of topography) - ! - do ie=nets,nete - call get_dp_ref(hvcoord%hyai, hvcoord%hybi, hvcoord%ps0,1,np,1,np,1,nlev,& - elem(ie)%state%phis(:,:),dp3d_ref(:,:,:,ie),ps_ref(:,:,ie)) - end do - endif - ! - ! reference temperature profile (Simmons and Jiabin, 1991, QJRMS, Section 2a) - ! - ! Tref = T0+T1*Exner - ! T1 = .0065*Tref*Cp/g ! = ~191 - ! T0 = Tref-T1 ! = ~97 - ! - T1 = lapse_rate*Tref*cpair/gravit - T0 = Tref-T1 - do ie=nets,nete - do k=1,nlev - dp3d_ref(:,:,k,ie) = ((hvcoord%hyai(k+1)-hvcoord%hyai(k))*hvcoord%ps0 + & - (hvcoord%hybi(k+1)-hvcoord%hybi(k))*ps_ref(:,:,ie)) - tmp = hvcoord%hyam(k)*hvcoord%ps0+hvcoord%hybm(k)*ps_ref(:,:,ie) - tmp2 = (tmp/hvcoord%ps0)**cappa - T_ref(:,:,k,ie) = (T0+T1*tmp2) - end do - end do - kbeg=1; kend=nlev kblk = kend - kbeg + 1 @@ -561,11 +505,10 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do ic=1,hypervis_subcycle - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBH') + 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,& - dp3d_ref,T_ref) + call biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend) do ie=nets,nete ! compute mean flux @@ -576,7 +519,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, do j=1,np do i=1,np elem(ie)%derived%dpdiss_ave(i,j,k)=elem(ie)%derived%dpdiss_ave(i,j,k)+& - rhypervis_subcycle*eta_ave_w*elem(ie)%state%dp3d(i,j,k,nt) + rhypervis_subcycle*eta_ave_w*(elem(ie)%state%dp3d(i,j,k,nt)-elem(ie)%derived%dp_ref(i,j,k)) elem(ie)%derived%dpdiss_biharmonic(i,j,k)=elem(ie)%derived%dpdiss_biharmonic(i,j,k)+& rhypervis_subcycle*eta_ave_w*dptens(i,j,k,ie) enddo @@ -593,14 +536,14 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, !DIR_VECTOR_ALIGNED do j=1,np do i=1,np - ttens(i,j,k,ie) = -nu_s*ttens(i,j,k,ie) + ttens(i,j,k,ie) = -nu_t_lev(k)*ttens(i,j,k,ie) dptens(i,j,k,ie) = -nu_p*dptens(i,j,k,ie) vtens(i,j,1,k,ie) = -nu_lev(k)*vtens(i,j,1,k,ie) vtens(i,j,2,k,ie) = -nu_lev(k)*vtens(i,j,2,k,ie) enddo enddo - if (ntrac>0) then + if (use_cslam) then !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,nc @@ -652,7 +595,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, kptr = kbeg - 1 + 2*nlev call edgeVunpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) - if (ntrac>0) then + if (use_cslam) then do k=kbeg,kend temp(:,:,k) = elem(ie)%state%dp3d(:,:,k,nt) / elem(ie)%spheremp ! STATE before DSS corners(0:np+1,0:np+1,k) = 0.0_r8 @@ -662,7 +605,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, kptr = kbeg - 1 + 3*nlev call edgeVunpack(edge3,elem(ie)%state%dp3d(:,:,kbeg:kend,nt),kblk,kptr,ie) - if (ntrac>0) then + if (use_cslam) then desc = elem(ie)%desc kptr = kbeg - 1 + 3*nlev @@ -722,10 +665,13 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, enddo end do - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dCH') + 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=kbeg,kend + do k=sponge_del4_lev+2,nlev + ! + ! only do "frictional heating" away from sponge + ! !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np @@ -742,7 +688,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, enddo enddo enddo - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAH') + call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dAH') end do ! @@ -752,85 +698,26 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, ! !*************************************************************** ! - ! - ! vertical diffusion - ! - call t_startf('vertical_molec_diff') - if (molecular_diff>1) then - do ie=nets,nete - call get_rho_dry(1,np,1,np,ksponge_end,nlev,qsize,elem(ie)%state%Qdp(:,:,:,1:qsize,qn0), & - elem(ie)%state%T(:,:,:,nt),ptop,elem(ie)%state%dp3d(:,:,:,nt),& - .true.,rhoi_dry=rhoi_dry(:,:,:), & - active_species_idx_dycore=thermodynamic_active_species_idx_dycore,& - pint_out=pint,pmid_out=pmid) - ! - ! constant coefficients - ! - do k=1,ksponge_end+1 - kmvisi(:,:,k) = kmvisi_ref(k)*rhoi_dry(:,:,k) - kmcndi(:,:,k) = kmcndi_ref(k)*rhoi_dry(:,:,k) - end do - ! - ! do vertical diffusion - ! - do j=1,np - do i=1,np - call solve_diffusion(dt2,np,nlev,i,j,ksponge_end,pmid,pint,kmcndi(:,:,:)/cpair,elem(ie)%state%T(:,:,:,nt),& - 0,dtemp) - call solve_diffusion(dt2,np,nlev,i,j,ksponge_end,pmid,pint,kmvisi(:,:,:),elem(ie)%state%v(:,:,1,:,nt),1,du) - call solve_diffusion(dt2,np,nlev,i,j,ksponge_end,pmid,pint,kmvisi(:,:,:),elem(ie)%state%v(:,:,2,:,nt),1,dv) - do k=1,ksponge_end - v1 = elem(ie)%state%v(i,j,1,k,nt) - v2 = elem(ie)%state%v(i,j,2,k,nt) - v1new = v1 + du(k) - v2new = v2 + dv(k) - ! - ! frictional heating - ! - heating = 0.5_r8*((v1new*v1new+v2new*v2new) - (v1*v1+v2*v2)) - elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & - -heating*inv_cp_full(i,j,k,ie)+dtemp(k) - elem(ie)%state%v(i,j,1,k,nt)=v1new - elem(ie)%state%v(i,j,2,k,nt)=v2new - end do - end do - end do - end do - end if - call t_stopf('vertical_molec_diff') call t_startf('sponge_diff') ! ! compute coefficients for horizontal diffusion ! - if (molecular_diff>0) then + if (molecular_diff==1) then do ie=nets,nete - call get_rho_dry(1,np,1,np,ksponge_end,nlev,qsize,elem(ie)%state%Qdp(:,:,:,1:qsize,qn0), & - elem(ie)%state%T(:,:,:,nt),ptop,elem(ie)%state%dp3d(:,:,:,nt),& - .true.,rho_dry=rho_dry(:,:,:,ie), & + call get_rho_dry(elem(ie)%state%Qdp(:,:,:,1:qsize,qn0), & + elem(ie)%state%T(:,:,:,nt), ptop, elem(ie)%state%dp3d(:,:,:,nt),& + .true., rho_dry=rho_dry(:,:,:,ie), & active_species_idx_dycore=thermodynamic_active_species_idx_dycore) end do - if (molecular_diff==1) then - do ie=nets,nete - ! - ! compute molecular diffusion and thermal conductivity coefficients at mid-levels - ! - call get_molecular_diff_coef(1,np,1,np,ksponge_end,nlev,& - elem(ie)%state%T(:,:,:,nt),0,km_sponge_factor(1:ksponge_end),kmvis(:,:,:,ie),kmcnd(:,:,:,ie),qsize,& - elem(ie)%state%Qdp(:,:,:,1:qsize,qn0),fact=1.0_r8/elem(ie)%state%dp3d(:,:,1:ksponge_end,nt),& - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - end do - else + do ie=nets,nete ! - ! constant coefficients + ! compute molecular diffusion and thermal conductivity coefficients at mid-levels ! - do ie=nets,nete - do k=1,ksponge_end - kmvis (:,:,k,ie) = kmvis_ref(k) - kmcnd (:,:,k,ie) = kmcnd_ref(k) - end do - end do - end if + call get_molecular_diff_coef(elem(ie)%state%T(:,:,:,nt), .false., km_sponge_factor(1:ksponge_end), kmvis(:,:,:,ie),& + kmcnd(:,:,:,ie), elem(ie)%state%Qdp(:,:,:,1:qsize,qn0), fact=1.0_r8/elem(ie)%state%dp3d(:,:,1:ksponge_end,nt),& + active_species_idx_dycore=thermodynamic_active_species_idx_dycore) + end do ! ! diagnostics ! @@ -876,7 +763,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, ! Horizontal Laplacian diffusion ! dt=dt2/hypervis_subcycle_sponge - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBS') + call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dBS') kblk = ksponge_end do ic=1,hypervis_subcycle_sponge rhypervis_subcycle=1.0_r8/real(hypervis_subcycle_sponge,kind=r8) @@ -933,7 +820,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, end do end if - if (ntrac>0.and.nu_dp>0) then + if (use_cslam.and.nu_dp>0) then ! ! mass flux for CSLAM due to sponge layer diffusion on dp ! @@ -981,7 +868,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, kptr = 2*ksponge_end call edgeVunpack(edgeSponge,vtens(:,:,2,1:ksponge_end,ie),kblk,kptr,ie) - if (ntrac>0.and.nu_dp>0.0_r8) then + if (use_cslam.and.nu_dp>0.0_r8) then do k=1,ksponge_end temp(:,:,k) = elem(ie)%state%dp3d(:,:,k,nt) / elem(ie)%spheremp ! STATE before DSS corners(0:np+1,0:np+1,k) = 0.0_r8 @@ -991,7 +878,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, kptr = 3*ksponge_end call edgeVunpack(edgeSponge,elem(ie)%state%dp3d(:,:,1:ksponge_end,nt),kblk,kptr,ie) - if (ntrac>0.and.nu_dp>0.0_r8) then + if (use_cslam.and.nu_dp>0.0_r8) then desc = elem(ie)%desc kptr = 3*ksponge_end @@ -1031,38 +918,40 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, vtens(i,j,2,k,ie)=dt*vtens(i,j,2,k,ie)*elem(ie)%rspheremp(i,j) ttens(i,j,k,ie)=dt*ttens(i,j,k,ie)*elem(ie)%rspheremp(i,j) elem(ie)%state%dp3d(i,j,k,nt)=elem(ie)%state%dp3d(i,j,k,nt)*elem(ie)%rspheremp(i,j) + ! update v first (gives better results than updating v after heating) + elem(ie)%state%v(i,j,:,k,nt)=elem(ie)%state%v(i,j,:,k,nt) + vtens(i,j,:,k,ie) + elem(ie)%state%T(i,j, k,nt)=elem(ie)%state%T(i,j, k,nt) + ttens(i,j, k,ie) enddo enddo enddo - !$omp parallel do num_threads(vert_num_threads) private(k,i,j,v1,v2,v1new,v2new) - do k=1,ksponge_end - !OMP_COLLAPSE_SIMD - !DIR_VECTOR_ALIGNED - do j=1,np - do i=1,np - ! update v first (gives better results than updating v after heating) - elem(ie)%state%v(i,j,:,k,nt)=elem(ie)%state%v(i,j,:,k,nt) + & - vtens(i,j,:,k,ie) - elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & - +ttens(i,j,k,ie) - - v1new=elem(ie)%state%v(i,j,1,k,nt) - v2new=elem(ie)%state%v(i,j,2,k,nt) - v1 =elem(ie)%state%v(i,j,1,k,nt)- vtens(i,j,1,k,ie) - v2 =elem(ie)%state%v(i,j,2,k,nt)- vtens(i,j,2,k,ie) - ! - ! frictional heating - ! - heating = 0.5_r8*(v1new*v1new+v2new*v2new-(v1*v1+v2*v2)) - elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & - -heating*inv_cp_full(i,j,k,ie) + if (molecular_diff>0) then + ! + ! no frictional heating for artificial sponge + ! + !$omp parallel do num_threads(vert_num_threads) private(k,i,j,v1,v2,v1new,v2new) + do k=1,ksponge_end + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + v1new=elem(ie)%state%v(i,j,1,k,nt) + v2new=elem(ie)%state%v(i,j,2,k,nt) + v1 =elem(ie)%state%v(i,j,1,k,nt)- vtens(i,j,1,k,ie) + v2 =elem(ie)%state%v(i,j,2,k,nt)- vtens(i,j,2,k,ie) + ! + ! frictional heating + ! + heating = 0.5_r8*(v1new*v1new+v2new*v2new-(v1*v1+v2*v2)) + elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & + -heating*inv_cp_full(i,j,k,ie) + enddo enddo enddo - enddo + end if end do end do call t_stopf('sponge_diff') - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAS') + call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dAS') end subroutine advance_hypervis_dp @@ -1088,7 +977,8 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& ! allows us to fuse these two loops for more cache reuse ! ! =================================== - use dimensions_mod, only: np, nc, nlev, ntrac, ksponge_end + use dimensions_mod, only: np, nc, nlev, use_cslam + use control_mod, only: pgf_formulation use hybrid_mod, only: hybrid_t use element_mod, only: element_t use derivative_mod, only: derivative_t, divergence_sphere, gradient_sphere, vorticity_sphere @@ -1097,11 +987,10 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& use edgetype_mod, only: edgedescriptor_t use bndry_mod, only: bndry_exchange use hybvcoord_mod, only: hvcoord_t - use physconst, only: epsilo, get_gz_given_dp_Tv_Rdry - use physconst, only: thermodynamic_active_species_num, get_virtual_temp, get_cp_dry - use physconst, only: thermodynamic_active_species_idx_dycore,get_R_dry - use physconst, only: dry_air_species_num,get_exner - use time_mod, only : tevolve + use cam_thermo, only: get_gz, get_virtual_temp + use air_composition, only: thermodynamic_active_species_num, dry_air_species_num + use air_composition, only: get_cp_dry, get_R_dry + use physconst, only: tref,cpair,rga,lapse_rate implicit none integer, intent(in) :: np1,nm1,n0,nets,nete @@ -1132,9 +1021,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& real (kind=r8), dimension(np,np) :: vgrad_T ! v.grad(T) real (kind=r8), dimension(np,np) :: Ephi ! kinetic energy + PHI term real (kind=r8), dimension(np,np,2,nlev) :: grad_p_full - real (kind=r8), dimension(np,np,2,nlev) :: grad_p_m_pmet! gradient(p - p_met) real (kind=r8), dimension(np,np,nlev) :: vort ! vorticity - real (kind=r8), dimension(np,np,nlev) :: p_dry ! pressure dry real (kind=r8), dimension(np,np,nlev) :: dp_dry ! delta pressure dry real (kind=r8), dimension(np,np,nlev) :: R_dry, cp_dry! real (kind=r8), dimension(np,np,nlev) :: p_full ! pressure @@ -1146,7 +1033,9 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& real (kind=r8) :: vtens1(np,np,nlev),vtens2(np,np,nlev),ttens(np,np,nlev) real (kind=r8) :: stashdp3d (np,np,nlev),tempdp3d(np,np), tempflux(nc,nc,4) real (kind=r8) :: ckk, term, T_v(np,np,nlev) - real (kind=r8), dimension(np,np,2) :: grad_exner + real (kind=r8), dimension(np,np,2) :: pgf_term + real (kind=r8), dimension(np,np,2) :: grad_exner,grad_logexner + real (kind=r8) :: T0,T1 real (kind=r8), dimension(np,np) :: theta_v type (EdgeDescriptor_t):: desc @@ -1154,7 +1043,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& real (kind=r8) :: sum_water(np,np,nlev), density_inv(np,np) real (kind=r8) :: E,v1,v2,glnps1,glnps2 integer :: i,j,k,kptr,ie - real (kind=r8) :: u_m_umet, v_m_vmet, t_m_tmet, ptop + real (kind=r8) :: ptop !JMD call t_barrierf('sync_compute_and_apply_rhs', hybrid%par%comm) call t_adj_detailf(+1) @@ -1164,19 +1053,16 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& ! ! compute virtual temperature and sum_water ! - call get_virtual_temp(1,np,1,np,1,nlev,thermodynamic_active_species_num,qwater(:,:,:,:,ie),& - t_v(:,:,:),temp=elem(ie)%state%T(:,:,:,n0),sum_q =sum_water(:,:,:),& - active_species_idx_dycore=qidx) - call get_R_dry(1,np,1,np,1,nlev,1,nlev,thermodynamic_active_species_num,& - qwater(:,:,:,:,ie),qidx,R_dry) - call get_cp_dry(1,np,1,np,1,nlev,1,nlev,thermodynamic_active_species_num,& - qwater(:,:,:,:,ie),qidx,cp_dry) + call get_virtual_temp(qwater(:,:,:,:,ie), t_v(:,:,:),temp=elem(ie)%state%T(:,:,:,n0),& + sum_q =sum_water(:,:,:), active_species_idx_dycore=qidx) + call get_R_dry(qwater(:,:,:,:,ie), qidx, R_dry) + call get_cp_dry(qwater(:,:,:,:,ie), qidx, cp_dry) do k=1,nlev dp_dry(:,:,k) = elem(ie)%state%dp3d(:,:,k,n0) dp_full(:,:,k) = sum_water(:,:,k)*dp_dry(:,:,k) end do - call get_gz_given_dp_Tv_Rdry(1,np,1,np,nlev,dp_full,T_v,R_dry,elem(ie)%state%phis,ptop,phi,pmid=p_full) + call get_gz(dp_full, T_v, R_dry, elem(ie)%state%phis, ptop, phi, pmid=p_full) do k=1,nlev ! vertically lagrangian code: we advect dp3d instead of ps ! we also need grad(p) at all levels (not just grad(ps)) @@ -1292,32 +1178,52 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& ! vtemp = gradient_sphere(Ephi(:,:),deriv,elem(ie)%Dinv) call gradient_sphere(Ephi(:,:),deriv,elem(ie)%Dinv,vtemp) density_inv(:,:) = R_dry(:,:,k)*T_v(:,:,k)/p_full(:,:,k) - - if (dry_air_species_num==0) then - exner(:,:)=(p_full(:,:,k)/hvcoord%ps0)**kappa(:,:,k,ie) - theta_v(:,:)=T_v(:,:,k)/exner(:,:) - call gradient_sphere(exner(:,:),deriv,elem(ie)%Dinv,grad_exner) - - grad_exner(:,:,1) = cp_dry(:,:,k)*theta_v(:,:)*grad_exner(:,:,1) - grad_exner(:,:,2) = cp_dry(:,:,k)*theta_v(:,:)*grad_exner(:,:,2) + if (pgf_formulation==1.or.(pgf_formulation==3.and.hvcoord%hybm(k)>0._r8)) then + if (dry_air_species_num==0) then + exner(:,:)=(p_full(:,:,k)/hvcoord%ps0)**kappa(:,:,k,ie) + theta_v(:,:)=T_v(:,:,k)/exner(:,:) + call gradient_sphere(exner(:,:),deriv,elem(ie)%Dinv,grad_exner) + pgf_term(:,:,1) = cp_dry(:,:,k)*theta_v(:,:)*grad_exner(:,:,1) + pgf_term(:,:,2) = cp_dry(:,:,k)*theta_v(:,:)*grad_exner(:,:,2) + else + exner(:,:)=(p_full(:,:,k)/hvcoord%ps0)**kappa(:,:,k,ie) + theta_v(:,:)=T_v(:,:,k)/exner(:,:) + call gradient_sphere(exner(:,:),deriv,elem(ie)%Dinv,grad_exner) + call gradient_sphere(kappa(:,:,k,ie),deriv,elem(ie)%Dinv,grad_kappa_term) + suml = exner(:,:)*LOG(p_full(:,:,k)/hvcoord%ps0) + grad_kappa_term(:,:,1)=-suml*grad_kappa_term(:,:,1) + grad_kappa_term(:,:,2)=-suml*grad_kappa_term(:,:,2) + pgf_term(:,:,1) = cp_dry(:,:,k)*theta_v(:,:)*(grad_exner(:,:,1)+grad_kappa_term(:,:,1)) + pgf_term(:,:,2) = cp_dry(:,:,k)*theta_v(:,:)*(grad_exner(:,:,2)+grad_kappa_term(:,:,2)) + end if + ! balanced ref profile correction: + ! reference temperature profile (Simmons and Jiabin, 1991, QJRMS, Section 2a) + ! + ! Tref = T0+T1*Exner + ! T1 = .0065*Tref*Cp/g ! = ~191 + ! T0 = Tref-T1 ! = ~97 + ! + T1 = lapse_rate*Tref*cpair*rga + T0 = Tref-T1 + if (hvcoord%hybm(k)>0) then + !only apply away from constant pressure levels + call gradient_sphere(log(exner(:,:)),deriv,elem(ie)%Dinv,grad_logexner) + pgf_term(:,:,1)=pgf_term(:,:,1) + & + cpair*T0*(grad_logexner(:,:,1)-grad_exner(:,:,1)/exner(:,:)) + pgf_term(:,:,2)=pgf_term(:,:,2) + & + cpair*T0*(grad_logexner(:,:,2)-grad_exner(:,:,2)/exner(:,:)) + end if + elseif (pgf_formulation==2.or.pgf_formulation==3) then + pgf_term(:,:,1) = density_inv(:,:)*grad_p_full(:,:,1,k) + pgf_term(:,:,2) = density_inv(:,:)*grad_p_full(:,:,2,k) else - exner(:,:)=(p_full(:,:,k)/hvcoord%ps0)**kappa(:,:,k,ie) - theta_v(:,:)=T_v(:,:,k)/exner(:,:) - call gradient_sphere(exner(:,:),deriv,elem(ie)%Dinv,grad_exner) - - call gradient_sphere(kappa(:,:,k,ie),deriv,elem(ie)%Dinv,grad_kappa_term) - suml = exner(:,:)*LOG(p_full(:,:,k)/hvcoord%ps0) - grad_kappa_term(:,:,1)=-suml*grad_kappa_term(:,:,1) - grad_kappa_term(:,:,2)=-suml*grad_kappa_term(:,:,2) - - grad_exner(:,:,1) = cp_dry(:,:,k)*theta_v(:,:)*(grad_exner(:,:,1)+grad_kappa_term(:,:,1)) - grad_exner(:,:,2) = cp_dry(:,:,k)*theta_v(:,:)*(grad_exner(:,:,2)+grad_kappa_term(:,:,2)) + call endrun('ERROR: bad choice of pgf_formulation (must be 1, 2, or 3)') end if do j=1,np do i=1,np - glnps1 = grad_exner(i,j,1) - glnps2 = grad_exner(i,j,2) + glnps1 = pgf_term(i,j,1) + glnps2 = pgf_term(i,j,2) v1 = elem(ie)%state%v(i,j,1,k,n0) v2 = elem(ie)%state%v(i,j,2,k,n0) @@ -1358,7 +1264,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& enddo - if (ntrac>0.and.eta_ave_w.ne.0._r8) then + if (use_cslam.and.eta_ave_w.ne.0._r8) then !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np @@ -1401,7 +1307,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& kptr=nlev call edgeVunpack(edge3, elem(ie)%state%v(:,:,:,:,np1), 2*nlev, kptr, ie) - if (ntrac>0.and.eta_ave_w.ne.0._r8) then + if (use_cslam.and.eta_ave_w.ne.0._r8) then do k=1,nlev stashdp3d(:,:,k) = elem(ie)%state%dp3d(:,:,k,np1)/elem(ie)%spheremp(:,:) end do @@ -1412,7 +1318,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& kptr=kptr+2*nlev call edgeVunpack(edge3, elem(ie)%state%dp3d(:,:,:,np1),nlev,kptr,ie) - if (ntrac>0.and.eta_ave_w.ne.0._r8) then + if (use_cslam.and.eta_ave_w.ne.0._r8) then desc = elem(ie)%desc call edgeDGVunpack(edge3, corners, nlev, kptr, ie) @@ -1531,35 +1437,50 @@ subroutine distribute_flux_at_corners(cflux, corners, getmapP) endif end subroutine distribute_flux_at_corners - subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) - use dimensions_mod, only: npsq,nlev,np,lcp_moist,nc,ntrac,qsize - use physconst, only: gravit, cpair, rearth,omega + subroutine tot_energy_dyn(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) + use dimensions_mod, only: npsq,nlev,np,nc,use_cslam,qsize + use physconst, only: rga, cpair, rearth, omega use element_mod, only: element_t - use cam_history, only: outfld, hist_fld_active + use cam_history, only: outfld + use cam_history_support, only: max_fieldname_len use constituents, only: cnst_get_ind use string_utils, only: strlist_get_ind use hycoef, only: hyai, ps0 use fvm_control_volume_mod, only: fvm_struct - use physconst, only: get_dp, get_cp - use physconst, only: thermodynamic_active_species_idx_dycore + use cam_thermo, only: get_dp, MASS_MIXING_RATIO,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx, & + poidx,thermo_budget_num_vars,thermo_budget_vars + use cam_thermo, only: get_hydrostatic_energy + use air_composition, only: thermodynamic_active_species_idx_dycore, get_cp + use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx_dycore + use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx + use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use dimensions_mod, only: cnst_name_gll + use dyn_tests_utils, only: vcoord=>vc_dry_pressure + use cam_budget, only: thermo_budget_history !------------------------------Arguments-------------------------------- - type (element_t) , intent(in) :: elem(:) - type(fvm_struct) , intent(in) :: fvm(:) + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct) , intent(inout) :: fvm(:) integer , intent(in) :: tl, tl_qdp,nets,nete character*(*) , intent(in) :: outfld_name_suffix ! suffix for "outfld" names !---------------------------Local storage------------------------------- - real(kind=r8) :: se(npsq) ! Dry Static energy (J/m2) - real(kind=r8) :: ke(npsq) ! kinetic energy (J/m2) + real(kind=r8) :: se(np,np) ! Enthalpy energy (J/m2) + real(kind=r8) :: ke(np,np) ! kinetic energy (J/m2) + real(kind=r8) :: po(np,np) ! PHIS term in energy equation (J/m2) + real(kind=r8) :: wv(np,np) ! water vapor + real(kind=r8) :: liq(np,np) ! liquid + real(kind=r8) :: ice(np,np) ! ice + real(kind=r8) :: q(np,nlev,qsize) + integer :: qidx(thermodynamic_active_species_num) real(kind=r8) :: cdp_fvm(nc,nc,nlev) - real(kind=r8) :: se_tmp - real(kind=r8) :: ke_tmp - real(kind=r8) :: ps(np,np) + real(kind=r8) :: cdp(np,np,nlev) + real(kind=r8) :: ptop(np,np) real(kind=r8) :: pdel(np,np,nlev) + real(kind=r8) :: cp(np,np,nlev) + ! ! global axial angular momentum (AAM) can be separated into one part (mr) associatedwith the relative motion ! of the atmosphere with respect to the planets surface (also known as wind AAM) and another part (mo) @@ -1569,25 +1490,19 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: mr(npsq) ! wind AAM real(kind=r8) :: mo(npsq) ! mass AAM real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp - real(kind=r8) :: cp(np,np,nlev) - integer :: ie,i,j,k + integer :: ie,i,j,k,m_cnst,nq,idx integer :: ixwv,ixcldice, ixcldliq, ixtt ! CLDICE, CLDLIQ and test tracer indices - character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 + character(len=max_fieldname_len) :: name_out(thermo_budget_num_vars) !----------------------------------------------------------------------- - name_out1 = 'SE_' //trim(outfld_name_suffix) - name_out2 = 'KE_' //trim(outfld_name_suffix) - name_out3 = 'WV_' //trim(outfld_name_suffix) - name_out4 = 'WL_' //trim(outfld_name_suffix) - name_out5 = 'WI_' //trim(outfld_name_suffix) - name_out6 = 'TT_' //trim(outfld_name_suffix) - - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& - hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then + if (thermo_budget_history) then + do i=1,thermo_budget_num_vars + name_out(i)=trim(thermo_budget_vars(i))//'_'//trim(outfld_name_suffix) + end do - if (ntrac>0) then + if (use_cslam) then ixwv = 1 call cnst_get_ind('CLDLIQ' , ixcldliq, abort=.false.) call cnst_get_ind('CLDICE' , ixcldice, abort=.false.) @@ -1603,79 +1518,104 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid ! + do nq=1,thermodynamic_active_species_num + qidx(nq) = nq + end do do ie=nets,nete - se = 0.0_r8 - ke = 0.0_r8 - call get_dp(1,np,1,np,1,nlev,qsize,elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp),2,thermodynamic_active_species_idx_dycore,& - elem(ie)%state%dp3d(:,:,:,tl),pdel,ps=ps,ptop=hyai(1)*ps0) - call get_cp(1,np,1,np,1,nlev,qsize,elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp),& - .false.,cp,dp_dry=elem(ie)%state%dp3d(:,:,:,tl),& + call get_cp(elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp),& + .false., cp, factor=1.0_r8/elem(ie)%state%dp3d(:,:,:,tl),& active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - do k = 1, nlev - do j=1,np - do i = 1, np - ! - ! kinetic energy - ! - ke_tmp = 0.5_r8*(elem(ie)%state%v(i,j,1,k,tl)**2+ elem(ie)%state%v(i,j,2,k,tl)**2)*pdel(i,j,k)/gravit - if (lcp_moist) then - se_tmp = cp(i,j,k)*elem(ie)%state%T(i,j,k,tl)*pdel(i,j,k)/gravit - else - ! - ! using CAM physics definition of internal energy - ! - se_tmp = cpair*elem(ie)%state%T(i,j,k,tl)*pdel(i,j,k)/gravit - end if - se (i+(j-1)*np) = se (i+(j-1)*np) + se_tmp - ke (i+(j-1)*np) = ke (i+(j-1)*np) + ke_tmp - end do - end do - end do - + ptop = hyai(1)*ps0 do j=1,np - do i = 1, np - se(i+(j-1)*np) = se(i+(j-1)*np) + elem(ie)%state%phis(i,j)*ps(i,j)/gravit + !get mixing ratio of thermodynamic active species only + !(other tracers not used in get_hydrostatic_energy) + do nq=1,thermodynamic_active_species_num + m_cnst = thermodynamic_active_species_idx_dycore(nq) + q(:,:,m_cnst) = elem(ie)%state%Qdp(:,j,:,m_cnst,tl_qdp)/& + elem(ie)%state%dp3d(:,j,:,tl) end do + call get_hydrostatic_energy(q, & + .false., elem(ie)%state%dp3d(:,j,:,tl), cp(:,j,:), elem(ie)%state%v(:,j,1,:,tl), & + elem(ie)%state%v(:,j,2,:,tl), elem(ie)%state%T(:,j,:,tl), vcoord, ptop=ptop(:,j),& + phis=elem(ie)%state%phis(:,j), dycore_idx=.true., & + se=se(:,j), po=po(:,j), ke=ke(:,j), wv=wv(:,j), liq=liq(:,j), ice=ice(:,j)) end do ! ! Output energy diagnostics on GLL grid ! - call outfld(name_out1 ,se ,npsq,ie) - call outfld(name_out2 ,ke ,npsq,ie) + call outfld(name_out(poidx) ,po ,npsq,ie) + call outfld(name_out(seidx) ,se ,npsq,ie) + call outfld(name_out(keidx) ,ke ,npsq,ie) + call outfld(name_out(teidx) ,ke+se+po ,npsq,ie) ! ! mass variables are output on CSLAM grid if using CSLAM else GLL grid ! - if (ntrac>0) then - if (ixwv>0) then - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixwv)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out3,ie) - end if - if (ixcldliq>0) then - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixcldliq)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out4,ie) - end if - if (ixcldice>0) then - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixcldice)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out5,ie) - end if - if (ixtt>0) then - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixtt)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out6,ie) - end if + if (use_cslam) then + if (ixwv>0) then + cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixwv)*fvm(ie)%dp_fvm(1:nc,1:nc,:) + call util_function(cdp_fvm,nc,nlev,name_out(wvidx),ie) + end if + ! + ! sum over liquid water + ! + if (thermodynamic_active_species_liq_num>0) then + cdp_fvm = 0.0_r8 + do nq = 1,thermodynamic_active_species_liq_num + cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_liq_idx(nq))& + *fvm(ie)%dp_fvm(1:nc,1:nc,:) + end do + call util_function(cdp_fvm,nc,nlev,name_out(wlidx),ie) + end if + ! + ! sum over ice water + ! + if (thermodynamic_active_species_ice_num>0) then + cdp_fvm = 0.0_r8 + do nq = 1,thermodynamic_active_species_ice_num + cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_ice_idx(nq))& + *fvm(ie)%dp_fvm(1:nc,1:nc,:) + end do + call util_function(cdp_fvm,nc,nlev,name_out(wiidx),ie) + end if + if (ixtt>0) then + cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixtt)*fvm(ie)%dp_fvm(1:nc,1:nc,:) + call util_function(cdp_fvm,nc,nlev,name_out(ttidx),ie) + end if else - call util_function(elem(ie)%state%qdp(:,:,:,1 ,tl_qdp),np,nlev,name_out3,ie) - if (ixcldliq>0) call util_function(elem(ie)%state%qdp(:,:,:,ixcldliq,tl_qdp),np,nlev,name_out4,ie) - if (ixcldice>0) call util_function(elem(ie)%state%qdp(:,:,:,ixcldice,tl_qdp),np,nlev,name_out5,ie) - if (ixtt>0 ) call util_function(elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp),np,nlev,name_out6,ie) + cdp = elem(ie)%state%qdp(:,:,:,1,tl_qdp) + call util_function(cdp,np,nlev,name_out(wvidx),ie) + ! + ! sum over liquid water + ! + if (thermodynamic_active_species_liq_num>0) then + cdp = 0.0_r8 + do idx = 1,thermodynamic_active_species_liq_num + cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_liq_idx(idx),tl_qdp) + end do + call util_function(cdp,np,nlev,name_out(wlidx),ie) + end if + ! + ! sum over ice water + ! + if (thermodynamic_active_species_ice_num>0) then + cdp = 0.0_r8 + do idx = 1,thermodynamic_active_species_ice_num + cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_ice_idx(idx),tl_qdp) + end do + call util_function(cdp,np,nlev,name_out(wiidx),ie) + end if + if (ixtt>0) then + cdp = elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp) + call util_function(cdp,np,nlev,name_out(ttidx),ie) + end if end if - end do - end if - ! - ! Axial angular momentum diagnostics - ! - ! Code follows - ! - ! Lauritzen et al., (2014): Held-Suarez simulations with the Community Atmosphere Model + end do + ! + ! Axial angular momentum diagnostics + ! + ! Code follows + ! + ! Lauritzen et al., (2014): Held-Suarez simulations with the Community Atmosphere Model ! Spectral Element (CAM-SE) dynamical core: A global axial angularmomentum analysis using Eulerian ! and floating Lagrangian vertical coordinates. J. Adv. Model. Earth Syst. 6,129-140, ! doi:10.1002/2013MS000268 @@ -1683,19 +1623,16 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! 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) ! - name_out1 = 'MR_' //trim(outfld_name_suffix) - name_out2 = 'MO_' //trim(outfld_name_suffix) - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then call strlist_get_ind(cnst_name_gll, 'CLDLIQ', ixcldliq, abort=.false.) call strlist_get_ind(cnst_name_gll, 'CLDICE', ixcldice, abort=.false.) - mr_cnst = rearth**3/gravit - mo_cnst = omega*rearth**4/gravit + mr_cnst = rga*rearth**3 + mo_cnst = rga*omega*rearth**4 do ie=nets,nete mr = 0.0_r8 mo = 0.0_r8 - call get_dp(1,np,1,np,1,nlev,qsize,elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp),2,thermodynamic_active_species_idx_dycore,& - elem(ie)%state%dp3d(:,:,:,tl),pdel,ps=ps,ptop=hyai(1)*ps0) + call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp), MASS_MIXING_RATIO, thermodynamic_active_species_idx_dycore,& + elem(ie)%state%dp3d(:,:,:,tl), pdel) do k = 1, nlev do j=1,np do i = 1, np @@ -1708,17 +1645,17 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf end do end do end do - call outfld(name_out1 ,mr ,npsq,ie) - call outfld(name_out2 ,mo ,npsq,ie) + call outfld(name_out(mridx) ,mr ,npsq,ie) + call outfld(name_out(moidx) ,mo ,npsq,ie) end do - end if + endif ! if thermo budget history + end subroutine tot_energy_dyn - end subroutine calc_tot_energy_dynamics subroutine output_qdp_var_dynamics(qdp,nx,num_trac,nets,nete,outfld_name) - use dimensions_mod, only: nlev,ntrac - use cam_history , only: outfld, hist_fld_active + use dimensions_mod, only: nlev + use cam_history , only: hist_fld_active use constituents , only: cnst_get_ind !------------------------------Arguments-------------------------------- @@ -1758,17 +1695,15 @@ end subroutine output_qdp_var_dynamics ! column integrate mass-variable and outfld ! subroutine util_function(f_in,nx,nz,name_out,ie) - use physconst, only: gravit + use physconst, only: rga use cam_history, only: outfld, hist_fld_active integer, intent(in) :: nx,nz,ie real(kind=r8), intent(in) :: f_in(nx,nx,nz) character(len=16), intent(in) :: name_out real(kind=r8) :: f_out(nx*nx) integer :: i,j,k - real(kind=r8) :: inv_g if (hist_fld_active(name_out)) then f_out = 0.0_r8 - inv_g = 1.0_r8/gravit do k = 1, nz do j = 1, nx do i = 1, nx @@ -1776,23 +1711,23 @@ subroutine util_function(f_in,nx,nz,name_out,ie) end do end do end do - f_out = f_out*inv_g + f_out = f_out*rga call outfld(name_out,f_out,nx*nx,ie) end if end subroutine util_function subroutine compute_omega(hybrid,n0,qn0,elem,deriv,nets,nete,dt,hvcoord) - use control_mod, only : nu_p, hypervis_subcycle - use dimensions_mod, only : np, nlev, qsize - use hybrid_mod, only : hybrid_t - use element_mod, only : element_t - use derivative_mod, only : divergence_sphere, derivative_t,gradient_sphere - use hybvcoord_mod, only : hvcoord_t - use edge_mod, only : edgevpack, edgevunpack - use bndry_mod, only : bndry_exchange + use control_mod, only: nu_p, hypervis_subcycle + use dimensions_mod, only: np, nlev, qsize + use hybrid_mod, only: hybrid_t + use element_mod, only: element_t + use derivative_mod, only: divergence_sphere, derivative_t,gradient_sphere + use hybvcoord_mod, only: hvcoord_t + use edge_mod, only: edgevpack, edgevunpack + use bndry_mod, only: bndry_exchange use viscosity_mod, only: biharmonic_wk_omega - use physconst, only: thermodynamic_active_species_num, get_dp - use physconst, only: thermodynamic_active_species_idx_dycore + use cam_thermo, only: get_dp, MASS_MIXING_RATIO + use air_composition,only: thermodynamic_active_species_idx_dycore implicit none type (hybrid_t) , intent(in) :: hybrid type (element_t) , intent(inout), target :: elem(:) @@ -1806,13 +1741,13 @@ subroutine compute_omega(hybrid,n0,qn0,elem,deriv,nets,nete,dt,hvcoord) real (kind=r8) :: dp_full(np,np,nlev) real (kind=r8) :: p_full(np,np,nlev),grad_p_full(np,np,2),vgrad_p_full(np,np,nlev) real (kind=r8) :: divdp_full(np,np,nlev),vdp_full(np,np,2) - real(kind=r8) :: Otens(np,np ,nlev,nets:nete), dt_hyper, sum_water(np,np,nlev) + real(kind=r8) :: Otens(np,np ,nlev,nets:nete), dt_hyper logical, parameter :: del4omega = .true. do ie=nets,nete - call get_dp(1,np,1,np,1,nlev,qsize,elem(ie)%state%Qdp(:,:,:,1:qsize,qn0),2,& - thermodynamic_active_species_idx_dycore,elem(ie)%state%dp3d(:,:,:,n0),dp_full) + call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,qn0), MASS_MIXING_RATIO,& + thermodynamic_active_species_idx_dycore, elem(ie)%state%dp3d(:,:,:,n0), dp_full) do k=1,nlev if (k==1) then p_full(:,:,k) = hvcoord%hyai(k)*hvcoord%ps0 + dp_full(:,:,k)/2 @@ -1893,367 +1828,4 @@ subroutine compute_omega(hybrid,n0,qn0,elem,deriv,nets,nete,dt,hvcoord) end if !call FreeEdgeBuffer(edgeOmega) end subroutine compute_omega - - - subroutine calc_dp3d_reference(elem,edge3,hybrid,nets,nete,nt,hvcoord,dp3d_ref) - ! - ! calc_dp3d_reference: When the del^4 horizontal damping is applied to dp3d - ! the values are implicitly affected by natural variations - ! due to surface topography. - ! - ! To account for these physicaly correct variations, use - ! the current state values to compute appropriate - ! reference values for the current (lagrangian) ETA-surfaces. - ! Damping should then be applied to values relative to - ! this reference. - !======================================================================= - use hybvcoord_mod ,only: hvcoord_t - use physconst ,only: rair,cappa - use element_mod, only: element_t - use dimensions_mod, only: np,nlev - use hybrid_mod, only: hybrid_t - use edge_mod, only: edgevpack, edgevunpack - use bndry_mod, only: bndry_exchange - ! - ! Passed variables - !------------------- - type(element_t ),target,intent(inout):: elem(:) - type(EdgeBuffer_t) ,intent(inout):: edge3 - type(hybrid_t ) ,intent(in ):: hybrid - integer ,intent(in ):: nets,nete - integer ,intent(in ):: nt - type(hvcoord_t ) ,intent(in ):: hvcoord - real(kind=r8) ,intent(out ):: dp3d_ref(np,np,nlev,nets:nete) - ! - ! Local Values - !-------------- - real(kind=r8):: Phis_avg(np,np, nets:nete) - real(kind=r8):: Phi_avg (np,np,nlev,nets:nete) - real(kind=r8):: RT_avg (np,np,nlev,nets:nete) - real(kind=r8):: P_val (np,np,nlev) - real(kind=r8):: Ps_val (np,np) - real(kind=r8):: Phi_val (np,np,nlev) - real(kind=r8):: Phi_ival(np,np) - real(kind=r8):: I_Phi (np,np,nlev+1) - real(kind=r8):: Alpha (np,np,nlev ) - real(kind=r8):: I_P (np,np,nlev+1) - real(kind=r8):: DP_avg (np,np,nlev) - real(kind=r8):: P_avg (np,np,nlev) - real(kind=r8):: Ps_avg (np,np) - real(kind=r8):: Ps_ref (np,np) - real(kind=r8):: RT_lapse(np,np) - real(kind=r8):: dlt_Ps (np,np) - real(kind=r8):: dPhi (np,np,nlev) - real(kind=r8):: dPhis (np,np) - real(kind=r8):: E_Awgt,E_phis,E_phi(nlev),E_T(nlev),Lapse0,Expon0 - integer :: ie,ii,jj,kk,kptr - - ! Loop over elements - !-------------------- - do ie=nets,nete - - ! Calculate Pressure values from dp3dp - !-------------------------------------- - P_val(:,:,1) = hvcoord%hyai(1)*hvcoord%ps0 + elem(ie)%state%dp3d(:,:,1,nt)*0.5_r8 - do kk=2,nlev - P_val(:,:,kk) = P_val(:,:,kk-1) & - + elem(ie)%state%dp3d(:,:,kk-1,nt)*0.5_r8 & - + elem(ie)%state%dp3d(:,:,kk ,nt)*0.5_r8 - end do - Ps_val(:,:) = P_val(:,:,nlev) + elem(ie)%state%dp3d(:,:,nlev,nt)*0.5_r8 - - ! Calculate (dry) geopotential values - !-------------------------------------- - dPhi (:,:,:) = 0.5_r8*(rair*elem(ie)%state%T (:,:,:,nt) & - *elem(ie)%state%dp3d(:,:,:,nt) & - /P_val(:,:,:) ) - Phi_val (:,:,nlev) = elem(ie)%state%phis(:,:) + dPhi(:,:,nlev) - Phi_ival(:,:) = elem(ie)%state%phis(:,:) + dPhi(:,:,nlev)*2._r8 - do kk=(nlev-1),1,-1 - Phi_val (:,:,kk) = Phi_ival(:,:) + dPhi(:,:,kk) - Phi_ival(:,:) = Phi_val (:,:,kk) + dPhi(:,:,kk) - end do - - ! Calculate Element averages - !---------------------------- - E_Awgt = 0.0_r8 - E_phis = 0.0_r8 - E_phi(:) = 0._r8 - E_T (:) = 0._r8 - do jj=1,np - do ii=1,np - E_Awgt = E_Awgt + elem(ie)%spheremp(ii,jj) - E_phis = E_phis + elem(ie)%spheremp(ii,jj)*elem(ie)%state%phis(ii,jj) - E_phi (:) = E_phi (:) + elem(ie)%spheremp(ii,jj)*Phi_val(ii,jj,:) - E_T (:) = E_T (:) + elem(ie)%spheremp(ii,jj)*elem(ie)%state%T(ii,jj,:,nt) - end do - end do - - Phis_avg(:,:,ie) = E_phis/E_Awgt - do kk=1,nlev - Phi_avg(:,:,kk,ie) = E_phi(kk) /E_Awgt - RT_avg (:,:,kk,ie) = E_T (kk)*rair/E_Awgt - end do - end do ! ie=nets,nete - - ! Boundary Exchange of average values - !------------------------------------- - do ie=nets,nete - Phis_avg(:,:,ie) = elem(ie)%spheremp(:,:)*Phis_avg(:,:,ie) - do kk=1,nlev - Phi_avg(:,:,kk,ie) = elem(ie)%spheremp(:,:)*Phi_avg(:,:,kk,ie) - RT_avg (:,:,kk,ie) = elem(ie)%spheremp(:,:)*RT_avg (:,:,kk,ie) - end do - kptr = 0 - call edgeVpack(edge3,Phi_avg(:,:,:,ie),nlev,kptr,ie) - kptr = nlev - call edgeVpack(edge3,RT_avg (:,:,:,ie),nlev,kptr,ie) - kptr = 2*nlev - call edgeVpack(edge3,Phis_avg (:,:,ie),1 ,kptr,ie) - end do ! ie=nets,nete - - call bndry_exchange(hybrid,edge3,location='calc_dp3d_reference') - - do ie=nets,nete - kptr = 0 - call edgeVunpack(edge3,Phi_avg(:,:,:,ie),nlev,kptr,ie) - kptr = nlev - call edgeVunpack(edge3,RT_avg (:,:,:,ie),nlev,kptr,ie) - kptr = 2*nlev - call edgeVunpack(edge3,Phis_avg (:,:,ie),1 ,kptr,ie) - Phis_avg(:,:,ie) = elem(ie)%rspheremp(:,:)*Phis_avg(:,:,ie) - do kk=1,nlev - Phi_avg(:,:,kk,ie) = elem(ie)%rspheremp(:,:)*Phi_avg(:,:,kk,ie) - RT_avg (:,:,kk,ie) = elem(ie)%rspheremp(:,:)*RT_avg (:,:,kk,ie) - end do - end do ! ie=nets,nete - - ! Loop over elements - !-------------------- - do ie=nets,nete - - ! Fill elements with uniformly varying average values - !----------------------------------------------------- - call fill_element(Phis_avg(1,1,ie)) - do kk=1,nlev - call fill_element(Phi_avg(1,1,kk,ie)) - call fill_element(RT_avg (1,1,kk,ie)) - end do - - ! Integrate upward to compute Alpha == (dp3d/P) - !---------------------------------------------- - I_Phi(:,:,nlev+1) = Phis_avg(:,:,ie) - do kk=nlev,1,-1 - I_Phi(:,:,kk) = 2._r8* Phi_avg(:,:,kk,ie) - I_Phi(:,:,kk+1) - Alpha(:,:,kk) = 2._r8*(Phi_avg(:,:,kk,ie) - I_Phi(:,:,kk+1))/RT_avg(:,:,kk,ie) - end do - - ! Integrate downward to compute corresponding average pressure values - !--------------------------------------------------------------------- - I_P(:,:,1) = hvcoord%hyai(1)*hvcoord%ps0 - do kk=1,nlev - DP_avg(:,:,kk ) = I_P(:,:,kk)*(2._r8 * Alpha(:,:,kk))/(2._r8 - Alpha(:,:,kk)) - P_avg (:,:,kk ) = I_P(:,:,kk)*(2._r8 )/(2._r8 - Alpha(:,:,kk)) - I_P (:,:,kk+1) = I_P(:,:,kk)*(2._r8 + Alpha(:,:,kk))/(2._r8 - Alpha(:,:,kk)) - end do - Ps_avg(:,:) = I_P(:,:,nlev+1) - - ! Determine an appropriate d/d lapse rate near the surface - ! OPTIONALLY: Use dry adiabatic lapse rate or environmental lapse rate. - !----------------------------------------------------------------------- - if(.FALSE.) then - ! DRY ADIABATIC laspe rate - !------------------------------ - RT_lapse(:,:) = -cappa - else - ! ENVIRONMENTAL (empirical) laspe rate - !-------------------------------------- - RT_lapse(:,:) = (RT_avg (:,:,nlev-1,ie)-RT_avg (:,:,nlev,ie)) & - /(Phi_avg(:,:,nlev-1,ie)-Phi_avg(:,:,nlev,ie)) - endif - - ! Calcualte reference surface pressure - !-------------------------------------- - dPhis(:,:) = elem(ie)%state%phis(:,:)-Phis_avg(:,:,ie) - do jj=1,np - do ii=1,np - if (abs(RT_lapse(ii,jj)) .gt. 1.e-3_r8) then - Lapse0 = RT_lapse(ii,jj)/RT_avg(ii,jj,nlev,ie) - Expon0 = (-1._r8/RT_lapse(ii,jj)) - Ps_ref(ii,jj) = Ps_avg(ii,jj)*((1._r8 + Lapse0*dPhis(ii,jj))**Expon0) - else - Ps_ref(ii,jj) = Ps_avg(ii,jj)*exp(-dPhis(ii,jj)/RT_avg(ii,jj,nlev,ie)) - endif - end do - end do - - ! Calculate reference dp3d values - !--------------------------------- - dlt_Ps(:,:) = Ps_ref(:,:) - Ps_avg(:,:) - do kk=1,nlev - dp3d_ref(:,:,kk,ie) = DP_avg(:,:,kk) + (hvcoord%hybi(kk+1) & - -hvcoord%hybi(kk ))*dlt_Ps(:,:) - end do - - end do ! ie=nets,nete - - ! End Routine - !------------ - return - end subroutine calc_dp3d_reference - !============================================================================= - - - !============================================================================= - subroutine fill_element(Eval) - ! - ! fill_element_bilin: Fill in element gridpoints using local bi-linear - ! interpolation of nearby average values. - ! - ! NOTE: This routine is hard coded for NP=4, if a - ! different value of NP is used... bad things - ! will happen. - !======================================================================= - use dimensions_mod,only: np - ! - ! Passed variables - !------------------- - real(kind=r8),intent(inout):: Eval(np,np) - ! - ! Local Values - !-------------- - real(kind=r8):: X0 - real(kind=r8):: S1,S2,S3,S4 - real(kind=r8):: C1,C2,C3,C4 - real(kind=r8):: E1,E2,E3,E4,E0 - - X0 = sqrt(1._r8/5._r8) - - ! Set the "known" values Eval - !---------------------------- - S1 = (Eval(1 ,2 )+Eval(1 ,3 ))/2._r8 - S2 = (Eval(2 ,np)+Eval(3 ,np))/2._r8 - S3 = (Eval(np,2 )+Eval(np,3 ))/2._r8 - S4 = (Eval(2 ,1 )+Eval(3 ,1 ))/2._r8 - C1 = Eval(1 ,1 ) - C2 = Eval(1 ,np) - C3 = Eval(np,np) - C4 = Eval(np,1 ) - - ! E0 OPTION: Element Center value: - !--------------------------------- - IF(.FALSE.) THEN - ! Use ELEMENT AVERAGE value contained in (2,2) - !---------------------------------------------- - E0 = Eval(2,2) - ELSE - ! Use AVG OF SIDE VALUES after boundary exchange of E0 (smooting option) - !----------------------------------------------------------------------- - E0 = (S1 + S2 + S3 + S4)/4._r8 - ENDIF - - ! Calc interior values along center axes - !---------------------------------------- - E1 = E0 + X0*(S1-E0) - E2 = E0 + X0*(S2-E0) - E3 = E0 + X0*(S3-E0) - E4 = E0 + X0*(S4-E0) - - ! Calculate Side Gridpoint Values for Eval - !------------------------------------------ - Eval(1 ,2 ) = S1 + X0*(C1-S1) - Eval(1 ,3 ) = S1 + X0*(C2-S1) - Eval(2 ,np) = S2 + X0*(C2-S2) - Eval(3 ,np) = S2 + X0*(C3-S2) - Eval(np,2 ) = S3 + X0*(C4-S3) - Eval(np,3 ) = S3 + X0*(C3-S3) - Eval(2 ,1 ) = S4 + X0*(C1-S4) - Eval(3 ,1 ) = S4 + X0*(C4-S4) - - ! Calculate interior values - !--------------------------- - Eval(2 ,2 ) = E1 + X0*(Eval(2 ,1 )-E1) - Eval(2 ,3 ) = E1 + X0*(Eval(2 ,np)-E1) - Eval(3 ,2 ) = E3 + X0*(Eval(3 ,1 )-E3) - Eval(3 ,3 ) = E3 + X0*(Eval(3 ,np)-E3) - - ! End Routine - !------------ - return - end subroutine fill_element - - subroutine rayleigh_friction(elem,nt,nets,nete,dt) - use dimensions_mod, only: nlev, otau - use hybrid_mod, only: hybrid_t!, get_loop_ranges - use element_mod, only: element_t - - type (element_t) , intent(inout), target :: elem(:) - integer , intent(in) :: nets,nete, nt - real(r8) :: dt - - real(r8) :: c1, c2 - integer :: k,ie - - do ie=nets,nete - do k=1,nlev - c2 = 1._r8 / (1._r8 + otau(k)*dt) - c1 = -otau(k) * c2 * dt - elem(ie)%state%v(:,:,:,k,nt) = elem(ie)%state%v(:,:,:,k,nt)+c1 * elem(ie)%state%v(:,:,:,k,nt) -! ptend%s(:ncol,k) = c3 * (state%u(:ncol,k)**2 + state%v(:ncol,k)**2) - enddo - end do - end subroutine rayleigh_friction - - - - subroutine solve_diffusion(dt,nx,nlev,i,j,nlay,pmid,pint,km,fld,boundary_condition,dfld) - use physconst, only: gravit - real(kind=r8), intent(in) :: dt - integer , intent(in) :: nlay, nlev,nx, i, j - real(kind=r8), intent(in) :: pmid(nx,nx,nlay),pint(nx,nx,nlay+1),km(nx,nx,nlay+1) - real(kind=r8), intent(in) :: fld(nx,nx,nlev) - real(kind=r8), intent(out) :: dfld(nlay) - integer :: boundary_condition - ! - real(kind=r8), dimension(nlay) :: current_guess,next_iterate - real(kind=r8) :: alp, alm, value_level0 - integer :: k,iter, niterations=4 - - ! Make the guess for the next time step equal to the initial value - current_guess(:)= fld(i,j,1:nlay) - do iter = 1, niterations - ! two formulations of the upper boundary condition - !next_iterate(1) = (initial_value(1) + alp * current_guess(i+1) + alm * current_guess(1)) /(1. + alp + alm) ! top BC, u'=0 - if (boundary_condition==0) then - next_iterate(1) = fld(i,j,1) ! u doesn't get prognosed by diffusion at top - else if (boundary_condition==1) then - value_level0 = 0.75_r8*fld(i,j,1) ! value above sponge - k=1 - alp = dt*(km(i,j,k+1)*gravit*gravit/(pmid(i,j,k)-pmid(i,j,k+1)))/(pint(i,j,k)-pint(i,j,k+1)) - alm = dt*(km(i,j,k )*gravit*gravit/(0.5_r8*(pmid(i,j,1)-pmid(i,j,2))))/(pint(i,j,k)-pint(i,j,k+1)) - next_iterate(k) = (fld(i,j,k) + alp * current_guess(k+1) + alm * value_level0)/(1._r8 + alp + alm) - else - ! - ! set fld'=0 at model top - ! - k=1 - alp = dt*(km(i,j,k+1)*gravit*gravit/(pmid(i,j,k)-pmid(i,j,k+1)))/(pint(i,j,k)-pint(i,j,k+1)) - alm = dt*(km(i,j,k )*gravit*gravit/(0.5_r8*(pmid(i,j,1)-pmid(i,j,2))))/(pint(i,j,k)-pint(i,j,k+1)) - next_iterate(k) = (fld(i,j,1) + alp * current_guess(2) + alm * current_guess(1))/(1._r8 + alp + alm) - end if - do k = 2, nlay-1 - alp = dt*(km(i,j,k+1)*gravit*gravit/(pmid(i,j,k )-pmid(i,j,k+1)))/(pint(i,j,k)-pint(i,j,k+1)) - alm = dt*(km(i,j,k )*gravit*gravit/(pmid(i,j,k-1)-pmid(i,j,k )))/(pint(i,j,k)-pint(i,j,k+1)) - next_iterate(k) = (fld(i,j,k) + alp * current_guess(k+1) + alm * current_guess(k-1))/(1._r8 + alp + alm) - end do - next_iterate(nlay) = (fld(i,j,nlay) + alp * fld(i,j,nlay) + alm * current_guess(nlay-1))/(1._r8 + alp + alm) ! bottom BC - - ! before the next iterate, make the current guess equal to the values of the last iteration - current_guess(:) = next_iterate(:) - end do - dfld(:) = next_iterate(:) - fld(i,j,1:nlay) - - end subroutine solve_diffusion - - end module prim_advance_mod diff --git a/src/dynamics/se/dycore/prim_advection_mod.F90 b/src/dynamics/se/dycore/prim_advection_mod.F90 index 41e15744df..6ee6d2586c 100644 --- a/src/dynamics/se/dycore/prim_advection_mod.F90 +++ b/src/dynamics/se/dycore/prim_advection_mod.F90 @@ -23,7 +23,7 @@ module prim_advection_mod use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use hybvcoord_mod, only: hvcoord_t - use time_mod, only: TimeLevel_t, TimeLevel_Qdp + use se_dyn_time_mod, only: TimeLevel_t, TimeLevel_Qdp use control_mod, only: nu_q, nu_p, limiter_option, hypervis_subcycle_q, rsplit use edge_mod, only: edgevpack, edgevunpack, initedgebuffer, initedgesbuffer @@ -45,7 +45,7 @@ module prim_advection_mod public :: prim_advec_tracers_fvm public :: vertical_remap - type (EdgeBuffer_t) :: edgeAdv, edgeAdvp1, edgeAdvQminmax, edgeAdv1, edgeveloc + type (EdgeBuffer_t) :: edgeAdv, edgeAdvp1, edgeAdvQminmax, edgeveloc integer,parameter :: DSSeta = 1 integer,parameter :: DSSomega = 2 @@ -63,8 +63,8 @@ module prim_advection_mod subroutine Prim_Advec_Init1(par, elem) - use dimensions_mod, only : nlev, qsize, nelemd,ntrac - use parallel_mod, only : parallel_t, boundaryCommMethod + use dimensions_mod, only: nlev, qsize, nelemd,ntrac,use_cslam + use parallel_mod, only: parallel_t, boundaryCommMethod type(parallel_t) :: par type (element_t) :: elem(:) ! @@ -74,13 +74,13 @@ subroutine Prim_Advec_Init1(par, elem) ! threads. But in this case we want shared pointers. real(kind=r8), pointer :: buf_ptr(:) => null() real(kind=r8), pointer :: receive_ptr(:) => null() - integer :: advec_remap_num_threads + integer :: advec_remap_num_threads ! ! Set the number of threads used in the subroutine Prim_Advec_tracers_remap() ! - if (ntrac>0) then + if (use_cslam) then advec_remap_num_threads = 1 else advec_remap_num_threads = tracer_num_threads @@ -89,17 +89,17 @@ subroutine Prim_Advec_Init1(par, elem) ! allocate largest one first ! Currently this is never freed. If it was, only this first one should ! be freed, as only it knows the true size of the buffer. - call initEdgeBuffer(par,edgeAdvp1,elem,qsize*nlev + nlev,bndry_type=boundaryCommMethod,& - nthreads=horz_num_threads*advec_remap_num_threads) - call initEdgeBuffer(par,edgeAdv,elem,qsize*nlev,bndry_type=boundaryCommMethod, & - nthreads=horz_num_threads*advec_remap_num_threads) - ! This is a different type of buffer pointer allocation - ! used for determine the minimum and maximum value from - ! neighboring elements - call initEdgeSBuffer(par,edgeAdvQminmax,elem,qsize*nlev*2,bndry_type=boundaryCommMethod, & - nthreads=horz_num_threads*advec_remap_num_threads) - - call initEdgeBuffer(par,edgeAdv1,elem,nlev,bndry_type=boundaryCommMethod) + if (.not.use_cslam) then + call initEdgeBuffer(par,edgeAdvp1,elem,qsize*nlev + nlev,bndry_type=boundaryCommMethod,& + nthreads=horz_num_threads*advec_remap_num_threads) + call initEdgeBuffer(par,edgeAdv,elem,qsize*nlev,bndry_type=boundaryCommMethod, & + nthreads=horz_num_threads*advec_remap_num_threads) + ! This is a different type of buffer pointer allocation + ! used for determine the minimum and maximum value from + ! neighboring elements + call initEdgeSBuffer(par,edgeAdvQminmax,elem,qsize*nlev*2,bndry_type=boundaryCommMethod, & + nthreads=horz_num_threads*advec_remap_num_threads) + end if call initEdgeBuffer(par,edgeveloc,elem,2*nlev,bndry_type=boundaryCommMethod) @@ -133,7 +133,7 @@ end subroutine Prim_Advec_Init2 subroutine Prim_Advec_Tracers_fvm(elem,fvm,hvcoord,hybrid,& dt,tl,nets,nete,ghostbufQnhc,ghostBufQ1, ghostBufFlux,kmin,kmax) use fvm_consistent_se_cslam, only: run_consistent_se_cslam - use edgetype_mod, only: edgebuffer_t + use edgetype_mod, only: edgebuffer_t implicit none type (element_t), intent(inout) :: elem(:) type (fvm_struct), intent(inout) :: fvm(:) @@ -224,9 +224,9 @@ end subroutine euler_step_driver !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- subroutine Prim_Advec_Tracers_remap_rk2( elem , deriv , hvcoord , hybrid , dt , tl , nets , nete ) - use derivative_mod, only : divergence_sphere - use control_mod , only : qsplit - use hybrid_mod , only : get_loop_ranges!, PrintHybrid + use derivative_mod, only: divergence_sphere + use control_mod , only: qsplit + use hybrid_mod , only: get_loop_ranges!, PrintHybrid ! use thread_mod , only : omp_set_num_threads, omp_get_thread_num type (element_t) , intent(inout) :: elem(:) @@ -314,7 +314,7 @@ subroutine qdp_time_avg( elem , rkstage , n0_qdp , np1_qdp , hybrid , nets , net use hybrid_mod, only : hybrid_t, get_loop_ranges implicit none type(element_t) , intent(inout) :: elem(:) - integer , intent(in ) :: rkstage , n0_qdp , np1_qdp , nets , nete + integer , intent(in ) :: rkstage , n0_qdp , np1_qdp , nets , nete type(hybrid_t) :: hybrid integer :: i,j,ie,q,k integer :: kbeg,kend,qbeg,qend @@ -326,7 +326,7 @@ subroutine qdp_time_avg( elem , rkstage , n0_qdp , np1_qdp , hybrid , nets , net do ie=nets,nete do q=qbeg,qend do k=kbeg,kend - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -355,14 +355,14 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , ! DSSopt = DSSeta or DSSomega: also DSS omega ! ! =================================== - use dimensions_mod , only : np, nlev - use hybrid_mod , only : hybrid_t!, PrintHybrid - use hybrid_mod , only : get_loop_ranges, threadOwnsTracer - use element_mod , only : element_t - use derivative_mod , only : derivative_t, divergence_sphere, limiter_optim_iter_full - use edge_mod , only : edgevpack, edgevunpack - use bndry_mod , only : bndry_exchange - use hybvcoord_mod , only : hvcoord_t + use dimensions_mod , only: np, nlev + use hybrid_mod , only: hybrid_t!, PrintHybrid + use hybrid_mod , only: get_loop_ranges, threadOwnsTracer + use element_mod , only: element_t + use derivative_mod , only: derivative_t, divergence_sphere, limiter_optim_iter_full + use edge_mod , only: edgevpack, edgevunpack + use bndry_mod , only: bndry_exchange + use hybvcoord_mod , only: hvcoord_t integer , intent(in ) :: np1_qdp, n0_qdp real (kind=r8), intent(in ) :: dt @@ -439,7 +439,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , do ie = nets, nete ! add hyperviscosity to RHS. apply to Q at timelevel n0, Qdp(n0)/dp do k = kbeg, kend - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -479,7 +479,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , if ( nu_p > 0 ) then do ie = nets, nete do k = kbeg, kend - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -490,7 +490,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , do q = qbeg,qend do k = kbeg, kend ! NOTE: divide by dp0 since we multiply by dp0 below - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -514,7 +514,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , do ie = nets, nete do q = qbeg, qend do k = kbeg, kend - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -536,7 +536,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , do ie = nets, nete do q = qbeg, qend do k = kbeg, kend - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -565,7 +565,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , do k = kbeg, kend ! derived variable divdp_proj() (DSS'd version of divdp) will only be correct on 2nd and 3rd stage ! but that's ok because rhs_multiplier=0 on the first stage: - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -579,7 +579,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , ! Note that the term dpdissk is independent of Q do k = kbeg, kend ! UN-DSS'ed dp at timelevel n0+1: - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -590,7 +590,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , ! add contribution from UN-DSS'ed PS dissipation ! dpdiss(:,:) = ( hvcoord%hybi(k+1) - hvcoord%hybi(k) ) * ! elem(ie)%derived%psdiss_biharmonic(:,:) - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -612,7 +612,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , do q = qbeg, qend do k = kbeg, kend ! div( U dp Q), - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -633,8 +633,8 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , enddo ! optionally add in hyperviscosity computed above: - if ( rhs_viss /= 0 ) then - !OMP_COLLAPSE_SIMD + if ( rhs_viss /= 0 ) then + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -655,7 +655,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , ! dont do this earlier, since we allow np1_qdp == n0_qdp ! and we dont want to overwrite n0_qdp until we are done using it do k = kbeg, kend - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -686,7 +686,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , if ( DSSopt == DSSdiv_vdp_ave ) DSSvar => elem(ie)%derived%divdp_proj(:,:,:) ! also DSS extra field do k = kbeg, kend - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -711,7 +711,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , kptr = qsize*nlev + kbeg -1 call edgeVunpack( edgeAdvp1 , DSSvar(:,:,kbeg:kend) , kblk , kptr , ie ) do k = kbeg, kend - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -725,7 +725,7 @@ subroutine euler_step( np1_qdp , n0_qdp , dt , elem , hvcoord , hybrid , deriv , kptr = nlev*(q-1) + kbeg - 1 call edgeVunpack( edgeAdvp1 , elem(ie)%state%Qdp(:,:,kbeg:kend,q,np1_qdp) , kblk , kptr , ie ) do k = kbeg, kend - !OMP_COLLAPSE_SIMD + !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np do i=1,np @@ -798,14 +798,14 @@ subroutine advance_hypervis_scalar( edgeAdv , elem , hvcoord , hybrid , deriv , ! Q(:,:,:,np) = Q(:,:,:,np) + dt2*nu*laplacian**order ( Q ) ! ! For correct scaling, dt2 should be the same 'dt2' used in the leapfrog advace - use dimensions_mod , only : np, nlev - use hybrid_mod , only : hybrid_t!, PrintHybrid - use hybrid_mod , only : get_loop_ranges - use element_mod , only : element_t - use derivative_mod , only : derivative_t - use edge_mod , only : edgevpack, edgevunpack - use edgetype_mod , only : EdgeBuffer_t - use bndry_mod , only : bndry_exchange + use dimensions_mod , only: np, nlev + use hybrid_mod , only: hybrid_t!, PrintHybrid + use hybrid_mod , only: get_loop_ranges + use element_mod , only: element_t + use derivative_mod , only: derivative_t + use edge_mod , only: edgevpack, edgevunpack + use edgetype_mod , only: EdgeBuffer_t + use bndry_mod , only: bndry_exchange implicit none type (EdgeBuffer_t) , intent(inout) :: edgeAdv @@ -941,61 +941,59 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) ! ! map tracers ! map velocity components - ! map temperature (either by mapping thermal energy or virtual temperature over log(p) + ! map temperature (either by mapping enthalpy or virtual temperature over log(p) ! (controlled by vert_remap_uvTq_alg > -20 or <= -20) ! - use hybvcoord_mod, only : hvcoord_t - use vertremap_mod, only : remap1 - use hybrid_mod , only : hybrid_t, config_thread_region,get_loop_ranges, PrintHybrid - use fvm_control_volume_mod, only : fvm_struct - use dimensions_mod , only : ntrac - use dimensions_mod, only : lcp_moist, kord_tr,kord_tr_cslam - use cam_logfile, only : iulog - use physconst, only : pi,get_thermal_energy,get_dp,get_virtual_temp - use physconst , only : thermodynamic_active_species_idx_dycore - use thread_mod , only : omp_set_nested - use control_mod, only: vert_remap_uvTq_alg + use hybvcoord_mod, only: hvcoord_t + use vertremap_mod, only: remap1 + use hybrid_mod, only: hybrid_t, config_thread_region,get_loop_ranges, PrintHybrid + use fvm_control_volume_mod, only: fvm_struct + use dimensions_mod, only: ntrac + use dimensions_mod, only: kord_tr,kord_tr_cslam + use cam_logfile, only: iulog + use physconst, only: pi + use air_composition, only: thermodynamic_active_species_idx_dycore + use cam_thermo, only: get_enthalpy, get_virtual_temp, get_dp, MASS_MIXING_RATIO + use thread_mod, only: omp_set_nested + use control_mod, only: vert_remap_uvTq_alg type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) type(fvm_struct), intent(inout) :: fvm(:) type (element_t), intent(inout) :: elem(:) ! real (kind=r8) :: dpc_star(nc,nc,nlev) !Lagrangian levels on CSLAM grid - + type (hvcoord_t) :: hvcoord integer :: ie,i,j,k,np1,nets,nete,np1_qdp,q, m_cnst real (kind=r8), dimension(np,np,nlev) :: dp_moist,dp_star_moist, dp_dry,dp_star_dry - real (kind=r8), dimension(np,np,nlev) :: internal_energy_star + real (kind=r8), dimension(np,np,nlev) :: enthalpy_star real (kind=r8), dimension(np,np,nlev,2):: ttmp real(r8), parameter :: rad2deg = 180.0_r8/pi integer :: region_num_threads,qbeg,qend,kord_uvT(1) - type (hybrid_t) :: hybridnew,hybridnew2 + type (hybrid_t) :: hybridnew,hybridnew2 real (kind=r8) :: ptop kord_uvT = vert_remap_uvTq_alg - + ptop = hvcoord%hyai(1)*hvcoord%ps0 do ie=nets,nete ! ! prepare for mapping of temperature ! - if (vert_remap_uvTq_alg>-20) then - if (lcp_moist) then - ! - ! compute internal energy on Lagrangian levels - ! (do it here since qdp is overwritten by remap1) - ! - call get_thermal_energy(1,np,1,np,1,nlev,qsize,elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & - elem(ie)%state%t(:,:,:,np1),elem(ie)%state%dp3d(:,:,:,np1),internal_energy_star, & - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - end if + if (vert_remap_uvTq_alg>-20) then + ! + ! compute enthalpy on Lagrangian levels + ! (do it here since qdp is overwritten by remap1) + ! + call get_enthalpy(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & + elem(ie)%state%t(:,:,:,np1), elem(ie)%state%dp3d(:,:,:,np1), enthalpy_star, & + active_species_idx_dycore=thermodynamic_active_species_idx_dycore) else ! ! map Tv over log(p) following FV and FV3 ! - call get_virtual_temp(1,np,1,np,1,nlev,qsize,elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & - internal_energy_star,dp_dry=elem(ie)%state%dp3d(:,:,:,np1), & - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - internal_energy_star = internal_energy_star*elem(ie)%state%t(:,:,:,np1) + call get_virtual_temp(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), enthalpy_star, & + dp_dry=elem(ie)%state%dp3d(:,:,:,np1), active_species_idx_dycore=thermodynamic_active_species_idx_dycore) + enthalpy_star = enthalpy_star*elem(ie)%state%t(:,:,:,np1) end if ! ! update final psdry @@ -1012,8 +1010,8 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) elem(ie)%state%dp3d(:,:,k,np1) = dp_dry(:,:,k) enddo ! - call get_dp(1,np,1,np,1,nlev,qsize,elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp),2,& - thermodynamic_active_species_idx_dycore,dp_star_dry,dp_star_moist(:,:,:)) + call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp), MASS_MIXING_RATIO,& + thermodynamic_active_species_idx_dycore, dp_star_dry, dp_star_moist(:,:,:)) ! ! Check if Lagrangian leves have crossed ! @@ -1027,7 +1025,7 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) elem(ie)%spherep(i,j)%lon*rad2deg,elem(ie)%spherep(i,j)%lat*rad2deg write(iulog,*) " " do k=1,nlev - write(iulog,'(A21,I5,A1,f12.8,3f8.2)') "k,dp_star_moist,u,v,T: ",k," ",dp_star_moist(i,j,k)/100.0_r8,& + write(iulog,'(A21,I5,A1,f16.12,3f10.2)') "k,dp_star_moist,u,v,T: ",k," ",dp_star_moist(i,j,k)/100.0_r8,& elem(ie)%state%v(i,j,1,k,np1),elem(ie)%state%v(i,j,2,k,np1),elem(ie)%state%T(i,j,k,np1) end do end if @@ -1040,43 +1038,36 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) ! ! compute moist reference pressure level thickness ! - call get_dp(1,np,1,np,1,nlev,qsize,elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp),2,& - thermodynamic_active_species_idx_dycore,dp_dry,dp_moist(:,:,:)) - + call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp), MASS_MIXING_RATIO,& + thermodynamic_active_species_idx_dycore, dp_dry, dp_moist(:,:,:)) + ! ! Remapping of temperature ! - if (vert_remap_uvTq_alg>-20) then + if (vert_remap_uvTq_alg>-20) then ! - ! remap internal energy and back out temperature - ! - if (lcp_moist) then - call remap1(internal_energy_star,np,1,1,1,dp_star_dry,dp_dry,ptop,1,.true.,kord_uvT) - ! - ! compute sum c^(l)_p*m^(l)*dp on arrival (Eulerian) grid - ! - ttmp(:,:,:,1) = 1.0_r8 - call get_thermal_energy(1,np,1,np,1,nlev,qsize,elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & - ttmp(:,:,:,1),dp_dry,ttmp(:,:,:,2), & - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - elem(ie)%state%t(:,:,:,np1)=internal_energy_star/ttmp(:,:,:,2) - else - internal_energy_star(:,:,:)=elem(ie)%state%t(:,:,:,np1)*dp_star_moist - call remap1(internal_energy_star,np,1,1,1,dp_star_moist,dp_moist,ptop,1,.true.,kord_uvT) - elem(ie)%state%t(:,:,:,np1)=internal_energy_star/dp_moist - end if + ! remap enthalpy energy and back out temperature + ! + call remap1(enthalpy_star,np,1,1,1,dp_star_dry,dp_dry,ptop,1,.true.,kord_uvT) + ! + ! compute sum c^(l)_p*m^(l)*dp on arrival (Eulerian) grid + ! + ttmp(:,:,:,1) = 1.0_r8 + call get_enthalpy(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & + ttmp(:,:,:,1), dp_dry,ttmp(:,:,:,2), & + active_species_idx_dycore=thermodynamic_active_species_idx_dycore) + elem(ie)%state%t(:,:,:,np1)=enthalpy_star/ttmp(:,:,:,2) else ! ! map Tv over log(p); following FV and FV3 ! - call remap1(internal_energy_star,np,1,1,1,dp_star_moist,dp_moist,ptop,1,.false.,kord_uvT) - call get_virtual_temp(1,np,1,np,1,nlev,qsize,elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & - ttmp(:,:,:,1),dp_dry=dp_dry, & - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) + call remap1(enthalpy_star,np,1,1,1,dp_star_moist,dp_moist,ptop,1,.false.,kord_uvT) + call get_virtual_temp(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), ttmp(:,:,:,1), & + dp_dry=dp_dry, active_species_idx_dycore=thermodynamic_active_species_idx_dycore) ! ! convert new Tv to T ! - elem(ie)%state%t(:,:,:,np1)=internal_energy_star/ttmp(:,:,:,1) + elem(ie)%state%t(:,:,:,np1)=enthalpy_star/ttmp(:,:,:,1) end if ! ! remap velocity components @@ -1084,13 +1075,13 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) call remap1(elem(ie)%state%v(:,:,1,:,np1),np,1,1,1,dp_star_moist,dp_moist,ptop,-1,.false.,kord_uvT) call remap1(elem(ie)%state%v(:,:,2,:,np1),np,1,1,1,dp_star_moist,dp_moist,ptop,-1,.false.,kord_uvT) enddo - + if (ntrac>0) then ! ! vertical remapping of CSLAM tracers ! do ie=nets,nete - dpc_star=fvm(ie)%dp_fvm(1:nc,1:nc,:) + dpc_star=fvm(ie)%dp_fvm(1:nc,1:nc,:) do k=1,nlev do j=1,nc do i=1,nc @@ -1102,14 +1093,14 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) end do end do end do - if(ntrac>tracer_num_threads) then + if(ntrac>tracer_num_threads) then call omp_set_nested(.true.) !$OMP PARALLEL NUM_THREADS(tracer_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew2,qbeg,qend) hybridnew2 = config_thread_region(hybrid,'ctracer') call get_loop_ranges(hybridnew2, qbeg=qbeg, qend=qend) call remap1(fvm(ie)%c(1:nc,1:nc,:,1:ntrac),nc,qbeg,qend,ntrac,dpc_star, & fvm(ie)%dp_fvm(1:nc,1:nc,:),ptop,0,.false.,kord_tr_cslam) - !$OMP END PARALLEL + !$OMP END PARALLEL call omp_set_nested(.false.) else call remap1(fvm(ie)%c(1:nc,1:nc,:,1:ntrac),nc,1,ntrac,ntrac,dpc_star, & diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index ffc010d1be..e2d470f616 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -19,17 +19,16 @@ module prim_driver_mod private public :: prim_init2, prim_run_subcycle, prim_finalize public :: prim_set_dry_mass - contains !=============================================================================! subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) use dimensions_mod, only: irecons_tracer, fvm_supercycling - use dimensions_mod, only: fv_nphys, ntrac, nc + use dimensions_mod, only: fv_nphys, nc use parallel_mod, only: syncmp - use time_mod, only: timelevel_t, tstep, phys_tscale, nsplit, TimeLevel_Qdp - use time_mod, only: nsplit_baseline,rsplit_baseline + use se_dyn_time_mod, only: timelevel_t, tstep, phys_tscale, nsplit, TimeLevel_Qdp + use se_dyn_time_mod, only: nsplit_baseline,rsplit_baseline use prim_state_mod, only: prim_printstate use control_mod, only: runtype, topology, rsplit, qsplit, rk_stage_user, & nu, nu_q, nu_div, hypervis_subcycle, hypervis_subcycle_q, & @@ -40,6 +39,9 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) use hybvcoord_mod, only: hvcoord_t use prim_advection_mod, only: prim_advec_init2,deriv use prim_advance_mod, only: compute_omega + use physconst, only: rga, cappa, cpair, tref, lapse_rate + use cam_thermo, only: get_dp_ref + use physconst, only: pstd type (element_t), intent(inout) :: elem(:) type (fvm_struct), intent(inout) :: fvm(:) @@ -58,11 +60,13 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) ! variables used to calculate CFL real (kind=r8) :: dtnu ! timestep*viscosity parameter - real (kind=r8) :: dt_dyn_vis ! viscosity timestep used in dynamics - real (kind=r8) :: dt_dyn_del2_sponge, dt_remap + real (kind=r8) :: dt_dyn_del2_sponge real (kind=r8) :: dt_tracer_vis ! viscosity timestep used in tracers + real (kind=r8) :: dt_dyn_vis ! viscosity timestep + real (kind=r8) :: dt_remap ! remapping timestep - real (kind=r8) :: dp + real (kind=r8) :: dp,dp0,T1,T0,pmid_ref(np,np) + real (kind=r8) :: ps_ref(np,np,nets:nete) integer :: i,j,k,ie,t,q integer :: n0,n0_qdp @@ -120,7 +124,7 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) ! so only now does HOMME learn the timstep. print them out: call print_cfl(elem,hybrid,nets,nete,dtnu,& !p top and p mid levels - hvcoord%hyai(1)*hvcoord%ps0,(hvcoord%hyam(:)+hvcoord%hybm(:))*hvcoord%ps0,& + hvcoord%hyai(1)*hvcoord%ps0,hvcoord%hyam(:)*hvcoord%ps0+hvcoord%hybm(:)*pstd,& !dt_remap,dt_tracer_fvm,dt_tracer_se tstep*qsplit*rsplit,tstep*qsplit*fvm_supercycling,tstep*qsplit,& !dt_dyn,dt_dyn_visco,dt_tracer_visco, dt_phys @@ -138,6 +142,39 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) n0=tl%n0 call TimeLevel_Qdp( tl, qsplit, n0_qdp) call compute_omega(hybrid,n0,n0_qdp,elem,deriv,nets,nete,dt_remap,hvcoord) + ! + ! pre-compute pressure-level thickness reference profile + ! + do ie=nets,nete + call get_dp_ref(hvcoord%hyai, hvcoord%hybi, hvcoord%ps0, elem(ie)%state%phis(:,:), & + elem(ie)%derived%dp_ref(:,:,:), ps_ref(:,:,ie)) + end do + ! + ! pre-compute reference temperature profile (Simmons and Jiabin, 1991, QJRMS, Section 2a + ! doi: https://doi.org/10.1002/qj.49711749703c) + ! + ! Tref = T0+T1*Exner + ! T1 = .0065*Tref*Cp/g ! = ~191 + ! T0 = Tref-T1 ! = ~97 + ! + T1 = lapse_rate*Tref*cpair*rga + T0 = Tref-T1 + do ie=nets,nete + 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 + if (hvcoord%hybm(k)>0) then + elem(ie)%derived%T_ref(:,:,k) = T0+T1*(pmid_ref/hvcoord%ps0)**cappa + ! + ! pel@ucar.edu: resolved noise issue over Antartica + ! + elem(ie)%derived%dp_ref(:,:,k) = elem(ie)%derived%dp_ref(:,:,k)-dp0 + else + elem(ie)%derived%T_ref(:,:,k) = 0.0_r8 + end if + end do + end do if (hybrid%masterthread) write(iulog,*) "initial state:" call prim_printstate(elem, tl, hybrid,nets,nete, fvm) @@ -147,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 ! @@ -181,17 +218,17 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! ! use hybvcoord_mod, only : hvcoord_t - use time_mod, only: TimeLevel_t, timelevel_update, timelevel_qdp, nsplit - use control_mod, only: statefreq,qsplit, rsplit, variable_nsplit + use se_dyn_time_mod, only: TimeLevel_t, timelevel_update, timelevel_qdp, nsplit + use control_mod, only: statefreq,qsplit, rsplit, variable_nsplit, dribble_in_rsplit_loop use prim_advance_mod, only: applycamforcing - use prim_advance_mod, only: calc_tot_energy_dynamics,compute_omega + use prim_advance_mod, only: tot_energy_dyn,compute_omega use prim_state_mod, only: prim_printstate, adjust_nsplit use prim_advection_mod, only: vertical_remap, deriv use thread_mod, only: omp_get_thread_num use perf_mod , only: t_startf, t_stopf use fvm_mod , only: fill_halo_fvm, ghostBufQnhc_h - use dimensions_mod, only: ntrac,fv_nphys, ksponge_end - + use dimensions_mod, only: use_cslam,fv_nphys + use fvm_mapping, only: cslam2gll type (element_t) , intent(inout) :: elem(:) type(fvm_struct), intent(inout) :: fvm(:) type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) @@ -201,14 +238,14 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep type (TimeLevel_t), intent(inout):: tl integer, intent(in) :: nsubstep ! nsubstep = 1 .. nsplit - real (kind=r8) , intent(inout):: omega_cn(2,nets:nete) !min and max of vertical Courant number + logical, intent(in) :: single_column + real (kind=r8) , intent(inout):: omega_cn(2,nets:nete) !min and max of vertical Courant number real(kind=r8) :: dt_q, dt_remap, dt_phys integer :: ie, q,k,n0_qdp,np1_qdp,r, nstep_end,region_num_threads,i,j real (kind=r8) :: dp_np1(np,np) real (kind=r8) :: dp_start(np,np,nlev+1,nets:nete),dp_end(np,np,nlev,nets:nete) logical :: compute_diagnostics - ! =================================== ! Main timestepping loop ! =================================== @@ -229,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 @@ -245,15 +282,42 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call TimeLevel_Qdp( tl, qsplit, n0_qdp) - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') - call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt_remap,dt_phys,nets,nete,nsubstep) - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + if (dribble_in_rsplit_loop==0) then + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') + call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt_remap,dt_phys,nets,nete,nsubstep) + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + end if do r=1,rsplit if (r.ne.1) call TimeLevel_update(tl,"leapfrog") - call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) + ! + ! if nsplit==1 and physics time-step is long then there will be noise in the + ! pressure field; hence "dripple" in tendencies + ! + if (dribble_in_rsplit_loop==1) then + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') + call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt,dt_phys,nets,nete,MAX(nsubstep,r)) + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + end if + ! + ! right after physics overwrite Qdp with CSLAM values + ! + if (use_cslam.and.nsubstep==1.and.r==1) then + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') + call cslam2gll(elem, fvm, hybrid,nets,nete, tl%n0, n0_qdp) + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + end if + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBL') + if (single_column) then + ! Single Column Case + ! Loop over rsplit vertically lagrangian timesteps + call prim_step_scm(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) + else + call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r,nsubstep==nsplit,dt_remap) + end if + call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,n0_qdp,'dAL') enddo - + ! defer final timelevel update until after remap and diagnostics call TimeLevel_Qdp( tl, qsplit, n0_qdp, np1_qdp) @@ -263,12 +327,12 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! always for tracers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call calc_tot_energy_dynamics(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 @@ -280,10 +344,10 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! time step is complete. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAR') + 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: @@ -326,7 +390,6 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst end do end do end do - if (nsubstep==nsplit.and.variable_nsplit) then call t_startf('adjust_nsplit') call adjust_nsplit(elem, tl, hybrid,nets,nete, fvm, omega_cn) @@ -341,7 +404,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call prim_printstate(elem, tl, hybrid,nets,nete, fvm, omega_cn) end if - if (ntrac>0.and.nsubstep==nsplit.and.nc.ne.fv_nphys) then + if (use_cslam.and.nsubstep==nsplit.and.nc.ne.fv_nphys) then ! ! fill the fvm halo for mapping in d_p_coupling if ! physics grid resolution is different than fvm resolution @@ -352,7 +415,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst end subroutine prim_run_subcycle - subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) + subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep, last_step,dt_remap) ! ! Take qsplit dynamics steps and one tracer step ! for vertically lagrangian option, this subroutine does only the horizontal step @@ -370,22 +433,23 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) ! tl%n0 time t + dt_q ! use hybvcoord_mod, only: hvcoord_t - use time_mod, only: TimeLevel_t, timelevel_update + use se_dyn_time_mod, only: TimeLevel_t, timelevel_update use control_mod, only: statefreq, qsplit, nu_p use thread_mod, only: omp_get_thread_num use prim_advance_mod, only: prim_advance_exp use prim_advection_mod, only: prim_advec_tracers_remap, prim_advec_tracers_fvm, deriv use derivative_mod, only: subcell_integration use hybrid_mod, only: set_region_num_threads, config_thread_region, get_loop_ranges - use dimensions_mod, only: ntrac,fvm_supercycling,fvm_supercycling_jet + use dimensions_mod, only: use_cslam,fvm_supercycling,fvm_supercycling_jet use dimensions_mod, only: kmin_jet, kmax_jet use fvm_mod, only: ghostBufQnhc_vh,ghostBufQ1_vh, ghostBufFlux_vh use fvm_mod, only: ghostBufQ1_h,ghostBufQnhcJet_h, ghostBufFluxJet_h - + use se_dyn_time_mod, only: timelevel_qdp + use fvm_mapping, only: cslam2gll #ifdef waccm_debug use cam_history, only: outfld -#endif - +#endif + type (element_t) , intent(inout) :: elem(:) type(fvm_struct), intent(inout) :: fvm(:) @@ -396,6 +460,8 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep type (TimeLevel_t), intent(inout) :: tl integer, intent(in) :: rstep ! vertical remap subcycling step + logical, intent(in) :: last_step! last step before d_p_coupling + real(kind=r8), intent(in) :: dt_remap type (hybrid_t):: hybridnew,hybridnew2 real(kind=r8) :: st, st1, dp, dt_q @@ -403,6 +469,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) integer :: ithr integer :: region_num_threads integer :: kbeg,kend + integer :: n0_qdp, np1_qdp real (kind=r8) :: tempdp3d(np,np), x real (kind=r8) :: tempmass(nc,nc) @@ -456,7 +523,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) ! defer final timelevel update until after Q update. enddo #ifdef HOMME_TEST_SUB_ELEMENT_MASS_FLUX - if (ntrac>0.and.rstep==1) then + if (use_cslam.and.rstep==1) then do ie=nets,nete do k=1,nlev tempdp3d = elem(ie)%state%dp3d(:,:,k,tl%np1) - & @@ -480,7 +547,6 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) end do end if #endif - ! current dynamics state variables: ! derived%dp = dp at start of timestep ! derived%vn0 = mean horiz. flux: U*dp @@ -500,36 +566,23 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) ! special case in CAM: if CSLAM tracers are turned on , qsize=1 but this tracer should ! not be advected. This will be cleaned up when the physgrid is merged into CAM trunk ! Currently advecting all species - if (qsize > 0) then - + if (.not.use_cslam) then call t_startf('prim_advec_tracers_remap') - if(ntrac>0) then - ! Deactivate threading in the tracer dimension if this is a CSLAM run - region_num_threads = 1 - else - region_num_threads=tracer_num_threads - endif + region_num_threads=tracer_num_threads call omp_set_nested(.true.) !$OMP PARALLEL NUM_THREADS(region_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew) - if(ntrac>0) then - ! Deactivate threading in the tracer dimension if this is a CSLAM run - hybridnew = config_thread_region(hybrid,'serial') - else - hybridnew = config_thread_region(hybrid,'tracer') - endif + hybridnew = config_thread_region(hybrid,'tracer') call Prim_Advec_Tracers_remap(elem, deriv,hvcoord,hybridnew,dt_q,tl,nets,nete) !$OMP END PARALLEL call omp_set_nested(.false.) call t_stopf('prim_advec_tracers_remap') - end if - ! - ! only run fvm transport every fvm_supercycling rstep - ! - if (ntrac>0) then + else + ! + ! only run fvm transport every fvm_supercycling rstep ! ! FVM transport ! - if ((mod(rstep,fvm_supercycling) == 0).and.(mod(rstep,fvm_supercycling_jet) == 0)) then + if ((mod(rstep,fvm_supercycling) == 0).and.(mod(rstep,fvm_supercycling_jet) == 0)) then ! call omp_set_nested(.true.) ! !$OMP PARALLEL NUM_THREADS(vert_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew2,kbeg,kend) @@ -557,14 +610,16 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) fvm(ie)%psc(i,j) = sum(fvm(ie)%dp_fvm(i,j,:)) + hvcoord%hyai(1)*hvcoord%ps0 end do end do - end do + end do + call TimeLevel_Qdp( tl, qsplit, n0_qdp, np1_qdp) + if (.not.last_step) call cslam2gll(elem, fvm, hybrid,nets,nete, tl%np1, np1_qdp) else if ((mod(rstep,fvm_supercycling_jet) == 0)) then ! ! shorter fvm time-step in jet region ! call Prim_Advec_Tracers_fvm(elem,fvm,hvcoord,hybrid,& dt_q,tl,nets,nete,ghostBufQnhcJet_h,ghostBufQ1_h, ghostBufFluxJet_h,kmin_jet,kmax_jet) - end if + end if #ifdef waccm_debug do ie=nets,nete @@ -572,11 +627,84 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) (/nc*nc,nlev/)), nc*nc, ie) end do #endif - endif + endif end subroutine prim_step + subroutine prim_step_scm(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) + ! + ! prim_step version for single column model (SCM) + ! Here we simply want to compute the floating level tendency + ! based on the prescribed large scale vertical velocity + ! Take qsplit dynamics steps and one tracer step + ! for vertically lagrangian option, this subroutine does only + ! the horizontal step + ! + ! input: + ! tl%nm1 not used + ! tl%n0 data at time t + ! tl%np1 new values at t+dt_q + ! + ! then we update timelevel pointers: + ! tl%nm1 = tl%n0 + ! tl%n0 = tl%np1 + ! so that: + ! tl%nm1 tracers: t dynamics: t+(qsplit-1)*dt + ! tl%n0 time t + dt_q + ! + use hybvcoord_mod, only: hvcoord_t + use se_dyn_time_mod, only: TimeLevel_t, timelevel_update + use control_mod, only: statefreq, qsplit, nu_p + use prim_advection_mod, only: deriv + use hybrid_mod, only: config_thread_region, get_loop_ranges + + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct), intent(inout) :: fvm(:) + type (hybrid_t), intent(in) :: hybrid ! distributed parallel structure (shared) + type (hvcoord_t), intent(in) :: hvcoord ! hybrid vertical coordinate struct + integer, intent(in) :: nets ! starting thread element number (private) + integer, intent(in) :: nete ! ending thread element number (private) + real(kind=r8), intent(in) :: dt ! "timestep dependent" timestep + type (TimeLevel_t), intent(inout) :: tl + integer, intent(in) :: rstep ! vertical remap subcycling step + + integer :: ie,n + + ! =============== + ! initialize mean flux accumulation variables and save some variables at n0 + ! for use by advection + ! =============== + do ie=nets,nete + elem(ie)%derived%vn0=0 ! mean horizontal mass flux + if (nu_p>0) then + elem(ie)%derived%dpdiss_ave=0 + elem(ie)%derived%dpdiss_biharmonic=0 + endif + elem(ie)%derived%dp(:,:,:)=elem(ie)%state%dp3d(:,:,:,tl%n0) + enddo + + ! =============== + ! Dynamical Step + ! =============== + call t_startf('set_prescribed_scm') + call set_prescribed_scm(elem, fvm, deriv, hvcoord, & + hybrid, dt, tl, nets, nete) + + call t_stopf('set_prescribed_scm') + + do n=2,qsplit + call TimeLevel_update(tl,"leapfrog") + + call t_startf('set_prescribed_scm') + + call set_prescribed_scm(elem, fvm, deriv, hvcoord, & + hybrid, dt, tl, nets, nete) + + call t_stopf('set_prescribed_scm') + enddo + + end subroutine prim_step_scm !=======================================================================================================! @@ -681,4 +809,62 @@ subroutine get_global_ave_surface_pressure(elem, global_ave_ps_inic) deallocate(tmp) end subroutine get_global_ave_surface_pressure + subroutine set_prescribed_scm(elem, fvm, deriv, hvcoord, & + hybrid, dt, tl, nets, nete) + use control_mod, only: tstep_type, qsplit + use derivative_mod, only: derivative_t + use dimensions_mod, only: np, nlev + use element_mod, only: element_t + use hybvcoord_mod, only: hvcoord_t + use hybrid_mod, only: hybrid_t + use se_dyn_time_mod, only: TimeLevel_t, timelevel_qdp + use fvm_control_volume_mod, only: fvm_struct + implicit none + + type (element_t), intent(inout), target :: elem(:) + type(fvm_struct) , intent(inout) :: fvm(:) + type (derivative_t) , intent(in) :: deriv + type (hvcoord_t) :: hvcoord + type (hybrid_t) , intent(in) :: hybrid + real (kind=r8), intent(in) :: dt + type (TimeLevel_t) , intent(in) :: tl + integer , intent(in) :: nets + integer , intent(in) :: nete + + ! Local + integer :: ie,nm1,n0,np1,k,qn0,qnp1,p + real(kind=r8) :: eta_dot_dpdn(np,np,nlev+1) + + + nm1 = tl%nm1 + n0 = tl%n0 + np1 = tl%np1 + + call TimeLevel_Qdp(tl, qsplit, qn0, qnp1) ! compute current Qdp() timelevel + + do ie=nets,nete + do k=1,nlev + eta_dot_dpdn(:,:,k)=elem(ie)%derived%omega(:,:,k) + enddo + eta_dot_dpdn(:,:,nlev+1) = eta_dot_dpdn(:,:,nlev) + + do k=1,nlev + elem(ie)%state%dp3d(:,:,k,np1) = elem(ie)%state%dp3d(:,:,k,n0) & + + dt*(eta_dot_dpdn(:,:,k+1) - eta_dot_dpdn(:,:,k)) + enddo + + do k=1,nlev + elem(ie)%state%T(:,:,k,np1) = elem(ie)%state%T(:,:,k,n0) + enddo + + do p=1,qsize + do k=1,nlev + elem(ie)%state%Qdp(:,:,k,p,qnp1) = elem(ie)%state%Qdp(:,:,k,p,qn0) & + + elem(ie)%state%Qdp(:,:,k,p,qn0)/elem(ie)%state%dp3d(:,:,k,n0) * & + dt*(eta_dot_dpdn(:,:,k+1) - eta_dot_dpdn(:,:,k)) + enddo + enddo + enddo + end subroutine set_prescribed_scm + end module prim_driver_mod diff --git a/src/dynamics/se/dycore/prim_init.F90 b/src/dynamics/se/dycore/prim_init.F90 index afbd94869e..930b887107 100644 --- a/src/dynamics/se/dycore/prim_init.F90 +++ b/src/dynamics/se/dycore/prim_init.F90 @@ -1,7 +1,7 @@ module prim_init use shr_kind_mod, only: r8=>shr_kind_r8 - use dimensions_mod, only: nc + use dimensions_mod, only: nc, use_cslam use reduction_mod, only: reductionbuffer_ordered_1d_t use quadrature_mod, only: quadrature_t, gausslobatto @@ -22,13 +22,13 @@ subroutine prim_init1(elem, fvm, par, Tl) use cam_logfile, only: iulog use shr_sys_mod, only: shr_sys_flush use thread_mod, only: max_num_threads - use dimensions_mod, only: np, nlev, nelem, nelemd, nelemdmax + use dimensions_mod, only: np, nlev, nelem, nelemd, nelemdmax, qsize_d use dimensions_mod, only: GlobalUniqueCols, fv_nphys,irecons_tracer use control_mod, only: topology, partmethod use element_mod, only: element_t, allocate_element_desc use fvm_mod, only: fvm_init1 use mesh_mod, only: MeshUseMeshFile - use time_mod, only: timelevel_init, timelevel_t + use se_dyn_time_mod, only: timelevel_init, timelevel_t use mass_matrix_mod, only: mass_matrix use derivative_mod, only: allocate_subcell_integration_matrix_cslam use derivative_mod, only: allocate_subcell_integration_matrix_physgrid @@ -56,6 +56,7 @@ subroutine prim_init1(elem, fvm, par, Tl) use shr_reprosum_mod, only: repro_sum => shr_reprosum_calc use fvm_analytic_mod, only: compute_basic_coordinate_vars use fvm_control_volume_mod, only: fvm_struct, allocate_physgrid_vars + use air_composition, only: thermodynamic_active_species_num type(element_t), pointer :: elem(:) type(fvm_struct), pointer :: fvm(:) @@ -70,7 +71,7 @@ subroutine prim_init1(elem, fvm, par, Tl) integer :: ie integer :: nets, nete integer :: nelem_edge - integer :: ierr, j + integer :: ierr=0, j logical, parameter :: Debug = .FALSE. real(r8), allocatable :: aratio(:,:) @@ -165,9 +166,49 @@ subroutine prim_init1(elem, fvm, par, Tl) end if call mpi_allreduce(nelemd, nelemdmax, 1, MPI_INTEGER, MPI_MAX, par%comm, ierr) + !Allocate elements: if (nelemd > 0) then - allocate(elem(nelemd)) - call allocate_element_desc(elem) + allocate(elem(nelemd)) + call allocate_element_desc(elem) + !Allocate Qdp and derived FQ arrays: + if(fv_nphys > 0) then !SE-CSLAM + do ie=1,nelemd + allocate(elem(ie)%state%Qdp(np,np,nlev,thermodynamic_active_species_num,1), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate Qdp array') + end if + allocate(elem(ie)%derived%FQ(np,np,nlev,thermodynamic_active_species_num), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate fq array') + end if + end do + else !Regular SE + do ie=1,nelemd + allocate(elem(ie)%state%Qdp(np,np,nlev,qsize_d,2), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate Qdp array') + end if + allocate(elem(ie)%derived%FQ(np,np,nlev,qsize_d), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate fq array') + end if + end do + end if + !Allocate remaining derived quantity arrays: + do ie=1,nelemd + allocate(elem(ie)%derived%FDP(np,np,nlev), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate fdp array') + end if + allocate(elem(ie)%derived%divdp(np,np,nlev), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate divdp array') + end if + allocate(elem(ie)%derived%divdp_proj(np,np,nlev), stat=ierr) + if( ierr /= 0 ) then + call endrun('prim_init1: failed to allocate divdp_proj array') + end if + end do end if if (fv_nphys > 0) then @@ -306,7 +347,7 @@ subroutine prim_init1(elem, fvm, par, Tl) elem(ie)%derived%FM=0.0_r8 elem(ie)%derived%FQ=0.0_r8 elem(ie)%derived%FT=0.0_r8 - elem(ie)%derived%FDP=0.0_r8 + elem(ie)%derived%FDP=0.0_r8 elem(ie)%derived%pecnd=0.0_r8 elem(ie)%derived%Omega=0 diff --git a/src/dynamics/se/dycore/prim_state_mod.F90 b/src/dynamics/se/dycore/prim_state_mod.F90 index 4c845ba0bf..3075c0e125 100644 --- a/src/dynamics/se/dycore/prim_state_mod.F90 +++ b/src/dynamics/se/dycore/prim_state_mod.F90 @@ -4,7 +4,7 @@ module prim_state_mod use dimensions_mod, only: nlev, np, nc, qsize_d, ntrac_d use parallel_mod, only: ordered use hybrid_mod, only: hybrid_t - use time_mod, only: timelevel_t, TimeLevel_Qdp, time_at + use se_dyn_time_mod, only: timelevel_t, TimeLevel_Qdp, time_at use control_mod, only: qsplit, statediag_numtrac use global_norms_mod, only: global_integrals_general use element_mod, only: element_t @@ -19,19 +19,19 @@ module prim_state_mod CONTAINS subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) - use dimensions_mod, only: ntrac + use dimensions_mod, only: use_cslam use constituents, only: cnst_name - use physconst, only: thermodynamic_active_species_idx_dycore, dry_air_species_num - use physconst, only: thermodynamic_active_species_num,thermodynamic_active_species_idx + use air_composition, only: thermodynamic_active_species_idx_dycore, dry_air_species_num + use air_composition, only: thermodynamic_active_species_num,thermodynamic_active_species_idx use cam_control_mod, only: initial_run - use time_mod, only: tstep + use se_dyn_time_mod, only: tstep use control_mod, only: rsplit, qsplit use perf_mod, only: t_startf, t_stopf type (element_t), intent(inout) :: elem(:) type (TimeLevel_t), target, intent(in) :: tl type (hybrid_t), intent(in) :: hybrid integer, intent(in) :: nets,nete - type(fvm_struct), intent(inout) :: fvm(:) + type(fvm_struct), intent(inout) :: fvm(:) real (kind=r8), optional, intent(in) :: omega_cn(2,nets:nete) ! Local variables... integer :: k,ie,m_cnst @@ -60,7 +60,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) n0=tl%n0 call TimeLevel_Qdp( tl, qsplit, n0_qdp) ! moist surface pressure - if (ntrac>0) then + if (use_cslam) then do ie=nets,nete moist_ps_fvm(:,:,ie)=SUM(fvm(ie)%dp_fvm(1:nc,1:nc,:),DIM=3) do q=dry_air_species_num+1,thermodynamic_active_species_num @@ -86,7 +86,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) do ie=nets,nete da_gll(:,:,ie) = elem(ie)%mp(:,:)*elem(ie)%metdet(:,:) enddo - if (ntrac>0) then + if (use_cslam) then do ie=nets,nete da_fvm(:,:,ie) = fvm(ie)%area_sphere(:,:) enddo @@ -103,7 +103,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) varname(3) = 'T ' varname(4) = 'OMEGA ' varname(5) = 'OMEGA CN ' - if (ntrac>0) then + if (use_cslam) then varname(6) = 'PSDRY(fvm)' varname(7) = 'PS(fvm) ' varname(8) = 'PSDRY(gll)' @@ -117,7 +117,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) nm2 = nm+statediag_numtrac!number of vars after tracers end if - do ie=nets,nete + do ie=nets,nete min_local(ie,1) = MINVAL(elem(ie)%state%v(:,:,1,:,n0)) max_local(ie,1) = MAXVAL(elem(ie)%state%v(:,:,1,:,n0)) min_local(ie,2) = MINVAL(elem(ie)%state%v(:,:,2,:,n0)) @@ -133,7 +133,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) min_local(ie,5) = 0.0_r8 max_local(ie,5) = 0.0_r8 end if - if (ntrac>0) then + if (use_cslam) then min_local(ie,6) = MINVAL(SUM(fvm(ie)%dp_fvm(1:nc,1:nc,:),DIM=3)) max_local(ie,6) = MAXVAL(SUM(fvm(ie)%dp_fvm(1:nc,1:nc,:),DIM=3)) min_local(ie,7) = MINVAL(moist_ps_fvm(:,:,ie)) @@ -141,7 +141,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) min_local(ie,8) = MINVAL(elem(ie)%state%psdry(:,:)) max_local(ie,8) = MAXVAL(elem(ie)%state%psdry(:,:)) min_local(ie,9) = MINVAL(moist_ps(:,:,ie)) - max_local(ie,9) = MAXVAL(moist_ps(:,:,ie)) + max_local(ie,9) = MAXVAL(moist_ps(:,:,ie)) do q=1,statediag_numtrac varname(nm+q) = TRIM(cnst_name(q)) min_local(ie,nm+q) = MINVAL(fvm(ie)%c(1:nc,1:nc,:,q)) @@ -151,7 +151,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) min_local(ie,6) = MINVAL(elem(ie)%state%psdry(:,:)) max_local(ie,6) = MAXVAL(elem(ie)%state%psdry(:,:)) min_local(ie,7) = MINVAL(moist_ps(:,:,ie)) - max_local(ie,7) = MAXVAL(moist_ps(:,:,ie)) + max_local(ie,7) = MAXVAL(moist_ps(:,:,ie)) do q=1,statediag_numtrac varname(nm+q) = TRIM(cnst_name(q)) tmp_q = elem(ie)%state%Qdp(:,:,:,q,n0_qdp)/elem(ie)%state%dp3d(:,:,:,n0) @@ -168,7 +168,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) max_local(ie,nm2+1) = MAXVAL(elem(ie)%derived%FT(:,:,:)) min_local(ie,nm2+2) = MINVAL(elem(ie)%derived%FM(:,:,:,:)) max_local(ie,nm2+2) = MAXVAL(elem(ie)%derived%FM(:,:,:,:)) - if (ntrac>0) then + if (use_cslam) then do q=1,statediag_numtrac varname(nm2+2+q) = TRIM('F'//TRIM(cnst_name(q))) min_local(ie,nm2+2+q) = MINVAL(fvm(ie)%fc(1:nc,1:nc,:,q)) @@ -201,7 +201,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) ! tracers ! mass = -1.0_r8 - if (ntrac>0) then + if (use_cslam) then do ie=nets,nete do q=1,statediag_numtrac tmp_fvm(:,:,q,ie) = SUM(fvm(ie)%c(1:nc,1:nc,:,q)*fvm(ie)%dp_fvm(1:nc,1:nc,:),DIM=3) @@ -243,7 +243,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) if (tl%nstep==0.or..not. initial_run) then mass_chg(:) = 0.0_R8 elem(nets)%derived%mass(nm+1:nm+statediag_numtrac) = mass(nm+1:nm+statediag_numtrac) - if (ntrac>0) then + if (use_cslam) then elem(nets)%derived%mass(6:9) = mass(6:9) else elem(nets)%derived%mass(6:7) = mass(6:7) @@ -286,14 +286,14 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) write(iulog,100) varname(k),min_p(k),max_p(k) end do end if - + 100 format (A12,4(E23.15)) 101 format (A12,A23,A23,A23,A23) #ifdef waccm_debug call prim_printstate_cslam_gamma(elem, tl,hybrid,nets,nete, fvm) #endif - call prim_printstate_U(elem, tl,hybrid,nets,nete, fvm) + call prim_printstate_U(elem, tl,hybrid,nets,nete, fvm) end subroutine prim_printstate @@ -345,20 +345,20 @@ end subroutine prim_printstate_cslam_gamma subroutine adjust_nsplit(elem, tl,hybrid,nets,nete, fvm, omega_cn) use dimensions_mod, only: ksponge_end use dimensions_mod, only: fvm_supercycling, fvm_supercycling_jet - use time_mod, only: tstep + use se_dyn_time_mod, only: tstep use control_mod, only: rsplit, qsplit use perf_mod, only: t_startf, t_stopf - use time_mod, only: nsplit, nsplit_baseline,rsplit_baseline + use se_dyn_time_mod, only: nsplit, nsplit_baseline,rsplit_baseline use control_mod, only: qsplit, rsplit use time_manager, only: get_step_size use cam_abortutils, only: endrun use control_mod, only: nu_top ! - type (element_t), intent(inout) :: elem(:) + type (element_t), intent(inout) :: elem(:) type (TimeLevel_t), target, intent(in) :: tl type (hybrid_t), intent(in) :: hybrid integer, intent(in) :: nets,nete - type(fvm_struct), intent(inout) :: fvm(:) + type(fvm_struct), intent(inout) :: fvm(:) real (kind=r8), intent(in) :: omega_cn(2,nets:nete) ! Local variables... integer :: k,ie @@ -393,7 +393,7 @@ subroutine adjust_nsplit(elem, tl,hybrid,nets,nete, fvm, omega_cn) nsplit=2*nsplit_baseline fvm_supercycling = rsplit fvm_supercycling_jet = rsplit - nu_top=2.0_r8*nu_top + nu_top=2.0_r8*nu_top ! ! write diagnostics to log file ! @@ -406,7 +406,7 @@ subroutine adjust_nsplit(elem, tl,hybrid,nets,nete, fvm, omega_cn) end if dtime = get_step_size() tstep = dtime / real(nsplit*qsplit*rsplit, r8) - + else if (nsplit.ne.nsplit_baseline.and.max_o(1)<0.4_r8*threshold) then ! ! should nsplit be reduced again? @@ -416,9 +416,9 @@ subroutine adjust_nsplit(elem, tl,hybrid,nets,nete, fvm, omega_cn) fvm_supercycling = rsplit fvm_supercycling_jet = rsplit nu_top=nu_top/2.0_r8 - + ! nu_div_scale_top(:) = 1.0_r8 - + dtime = get_step_size() tstep = dtime / real(nsplit*qsplit*rsplit, r8) if(hybrid%masterthread) then @@ -438,7 +438,7 @@ subroutine prim_printstate_U(elem, tl,hybrid,nets,nete, fvm) integer :: k,ie real (kind=r8), dimension(nets:nete,nlev) :: max_local - real (kind=r8), dimension(nets:nete,nlev) :: min_local + real (kind=r8), dimension(nets:nete,nlev) :: min_local real (kind=r8), dimension(nlev) :: max_p real (kind=r8), dimension(nlev) :: min_p integer :: n0, n0_qdp, q, nm, nm2 @@ -462,7 +462,7 @@ subroutine prim_printstate_U(elem, tl,hybrid,nets,nete, fvm) !JMD This is a Thread Safe Reduction do k = 1, nlev max_p(k) = Parallelmax(max_local(:,k),hybrid) - min_p(k) = Parallelmin(min_local(:,k),hybrid) + min_p(k) = Parallelmin(min_local(:,k),hybrid) end do if (hybrid%masterthread) then write(iulog,*) ' ' diff --git a/src/dynamics/se/dycore/se_dyn_time_mod.F90 b/src/dynamics/se/dycore/se_dyn_time_mod.F90 new file mode 100644 index 0000000000..cfe7ad2323 --- /dev/null +++ b/src/dynamics/se/dycore/se_dyn_time_mod.F90 @@ -0,0 +1,140 @@ +module se_dyn_time_mod + !------------------ + use shr_kind_mod, only: r8=>shr_kind_r8 + !------------------ + implicit none + integer,public :: nsplit=1 + integer,public :: nsplit_baseline=-1 + integer,public :: rsplit_baseline=-1 + integer,public :: nmax ! Max number of timesteps + integer,public :: nEndStep ! Number of End Step + integer,public :: ndays ! Max number of days + + real (kind=r8) , public :: tstep ! Dynamics timestep + real (kind=r8) , public :: tevolve ! time evolved since start of dynamics (end of physics) + real (kind=r8) , public :: phys_tscale=0 ! Physics time scale + real (kind=r8) , public :: dt_phys = -900! physics time-step (only used in standalone HOMME) + ! if negative no forcing (see prim_main) + + ! smooth now in namelist + integer, parameter :: ptimelevels = 3 ! number of time levels in the dycore + + type, public :: TimeLevel_t + integer nm1 ! relative time level n-1 + integer n0 ! relative time level n + integer np1 ! relative time level n+1 + integer nstep ! time level since simulation start + integer nstep0 ! timelevel of first complete leapfrog timestep + end type TimeLevel_t + + ! Methods + public :: Time_at + public :: TimeLevel_update + public :: TimeLevel_init + public :: TimeLevel_Qdp + + interface TimeLevel_init + module procedure TimeLevel_init_default + module procedure TimeLevel_init_specific + module procedure TimeLevel_init_copy + end interface + +contains + + function Time_at(nstep) result(tat) + integer, intent(in) :: nstep + real (kind=r8) :: tat + tat = nstep*tstep + end function Time_at + + subroutine TimeLevel_init_default(tl) + type (TimeLevel_t), intent(out) :: tl + tl%nm1 = 1 + tl%n0 = 2 + tl%np1 = 3 + tl%nstep = 0 + tl%nstep0 = 2 + end subroutine TimeLevel_init_default + + subroutine TimeLevel_init_copy(tl, tin) + type (TimeLevel_t), intent(in) :: tin + type (TimeLevel_t), intent(out) :: tl + tl%nm1 = tin%nm1 + tl%n0 = tin%n0 + tl%np1 = tin%np1 + tl%nstep = tin%nstep + tl%nstep0= tin%nstep0 + end subroutine TimeLevel_init_copy + + subroutine TimeLevel_init_specific(tl,n0,n1,n2,nstep) + type (TimeLevel_t) :: tl + integer, intent(in) :: n0,n1,n2,nstep + tl%nm1= n0 + tl%n0 = n1 + tl%np1= n2 + tl%nstep= nstep + end subroutine TimeLevel_init_specific + + + !this subroutine returns the proper + !locations for nm1 and n0 for Qdp - because + !it only has 2 levels for storage + subroutine TimeLevel_Qdp(tl, qsplit, n0, np1) + use dimensions_mod, only: use_cslam + type (TimeLevel_t) :: tl + integer, intent(in) :: qsplit + integer, intent(inout) :: n0 + integer, intent(inout), optional :: np1 + + integer :: i_temp + + if (use_cslam) then + n0 = 1 + if (present(np1)) np1 = 1 + else + + i_temp = tl%nstep/qsplit + + if (mod(i_temp,2) ==0) then + n0 = 1 + if (present(np1)) then + np1 = 2 + endif + else + n0 = 2 + if (present(np1)) then + np1 = 1 + end if + endif + !print * ,'nstep = ', tl%nstep, 'qsplit= ', qsplit, 'i_temp = ', i_temp, 'n0 = ', n0 + endif + end subroutine TimeLevel_Qdp + + subroutine TimeLevel_update(tl,uptype) + type (TimeLevel_t) :: tl + character(len=*) :: uptype + + ! Local Variable + + integer :: ntmp +!$OMP BARRIER +!$OMP MASTER + if (uptype == "leapfrog") then + ntmp = tl%np1 + tl%np1 = tl%nm1 + tl%nm1 = tl%n0 + tl%n0 = ntmp + else if (uptype == "forward") then + ntmp = tl%np1 + tl%np1 = tl%n0 + tl%n0 = ntmp + else + print *,'WARNING: TimeLevel_update called wint invalid uptype=',uptype + end if + + tl%nstep = tl%nstep+1 +!$OMP END MASTER +!$OMP BARRIER + end subroutine TimeLevel_update + +end module se_dyn_time_mod diff --git a/src/dynamics/se/dycore/time_mod.F90 b/src/dynamics/se/dycore/time_mod.F90 deleted file mode 100644 index fdd68af06a..0000000000 --- a/src/dynamics/se/dycore/time_mod.F90 +++ /dev/null @@ -1,135 +0,0 @@ -module time_mod - !------------------ - use shr_kind_mod, only: r8=>shr_kind_r8 - !------------------ - implicit none - integer,public :: nsplit=1 - integer,public :: nsplit_baseline=-1 - integer,public :: rsplit_baseline=-1 - integer,public :: nmax ! Max number of timesteps - integer,public :: nEndStep ! Number of End Step - integer,public :: ndays ! Max number of days - - real (kind=r8) , public :: tstep ! Dynamics timestep - real (kind=r8) , public :: tevolve ! time evolved since start of dynamics (end of physics) - real (kind=r8) , public :: phys_tscale=0 ! Physics time scale - real (kind=r8) , public :: dt_phys = -900! physics time-step (only used in standalone HOMME) - ! if negative no forcing (see prim_main) - - ! smooth now in namelist - integer, parameter :: ptimelevels = 3 ! number of time levels in the dycore - - type, public :: TimeLevel_t - integer nm1 ! relative time level n-1 - integer n0 ! relative time level n - integer np1 ! relative time level n+1 - integer nstep ! time level since simulation start - integer nstep0 ! timelevel of first complete leapfrog timestep - end type TimeLevel_t - - ! Methods - public :: Time_at - public :: TimeLevel_update - public :: TimeLevel_init - public :: TimeLevel_Qdp - - interface TimeLevel_init - module procedure TimeLevel_init_default - module procedure TimeLevel_init_specific - module procedure TimeLevel_init_copy - end interface - -contains - - function Time_at(nstep) result(tat) - integer, intent(in) :: nstep - real (kind=r8) :: tat - tat = nstep*tstep - end function Time_at - - subroutine TimeLevel_init_default(tl) - type (TimeLevel_t), intent(out) :: tl - tl%nm1 = 1 - tl%n0 = 2 - tl%np1 = 3 - tl%nstep = 0 - tl%nstep0 = 2 - end subroutine TimeLevel_init_default - - subroutine TimeLevel_init_copy(tl, tin) - type (TimeLevel_t), intent(in) :: tin - type (TimeLevel_t), intent(out) :: tl - tl%nm1 = tin%nm1 - tl%n0 = tin%n0 - tl%np1 = tin%np1 - tl%nstep = tin%nstep - tl%nstep0= tin%nstep0 - end subroutine TimeLevel_init_copy - - subroutine TimeLevel_init_specific(tl,n0,n1,n2,nstep) - type (TimeLevel_t) :: tl - integer, intent(in) :: n0,n1,n2,nstep - tl%nm1= n0 - tl%n0 = n1 - tl%np1= n2 - tl%nstep= nstep - end subroutine TimeLevel_init_specific - - - !this subroutine returns the proper - !locations for nm1 and n0 for Qdp - because - !it only has 2 levels for storage - subroutine TimeLevel_Qdp(tl, qsplit, n0, np1) - type (TimeLevel_t) :: tl - integer, intent(in) :: qsplit - integer, intent(inout) :: n0 - integer, intent(inout), optional :: np1 - - integer :: i_temp - - i_temp = tl%nstep/qsplit - - if (mod(i_temp,2) ==0) then - n0 = 1 - if (present(np1)) then - np1 = 2 - endif - else - n0 = 2 - if (present(np1)) then - np1 = 1 - end if - endif - - !print * ,'nstep = ', tl%nstep, 'qsplit= ', qsplit, 'i_temp = ', i_temp, 'n0 = ', n0 - - end subroutine TimeLevel_Qdp - - subroutine TimeLevel_update(tl,uptype) - type (TimeLevel_t) :: tl - character(len=*) :: uptype - - ! Local Variable - - integer :: ntmp -!$OMP BARRIER -!$OMP MASTER - if (uptype == "leapfrog") then - ntmp = tl%np1 - tl%np1 = tl%nm1 - tl%nm1 = tl%n0 - tl%n0 = ntmp - else if (uptype == "forward") then - ntmp = tl%np1 - tl%np1 = tl%n0 - tl%n0 = ntmp - else - print *,'WARNING: TimeLevel_update called wint invalid uptype=',uptype - end if - - tl%nstep = tl%nstep+1 -!$OMP END MASTER -!$OMP BARRIER - end subroutine TimeLevel_update - -end module time_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 b29e48a1fa..51bf63a3da 100644 --- a/src/dynamics/se/dycore/viscosity_mod.F90 +++ b/src/dynamics/se/dycore/viscosity_mod.F90 @@ -1,15 +1,15 @@ 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) ! ! use shr_kind_mod, only: r8=>shr_kind_r8 use thread_mod, only: max_num_threads, omp_get_num_threads - use dimensions_mod, only: np, nc, nlev,qsize,nelemd + use dimensions_mod, only: np, nc, nlev,nlevp, qsize,nelemd use hybrid_mod, only: hybrid_t, get_loop_ranges, config_thread_region use parallel_mod, only: parallel_t use element_mod, only: element_t @@ -50,11 +50,9 @@ module viscosity_mod CONTAINS -subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,& - dp3d_ref,T_ref) +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 : ntrac, nu_div_lev,nu_lev - + use dimensions_mod, only : use_cslam, nu_div_lev,nu_lev !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! compute weak biharmonic operator ! input: h,v (stored in elem()%, in lat-lon coordinates @@ -68,101 +66,96 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, real (kind=r8), intent(out), dimension(nc,nc,4,nlev,nets:nete) :: dpflux real (kind=r8), dimension(np,np,2,nlev,nets:nete) :: vtens real (kind=r8), dimension(np,np,nlev,nets:nete) :: ttens,dptens - real (kind=r8), dimension(np,np,nlev,nets:nete), optional :: dp3d_ref,T_ref type (EdgeBuffer_t) , intent(inout) :: edge3 type (derivative_t) , intent(in) :: deriv - ! 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) :: nu_ratio1, nu_ratio2 + + 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 (ntrac>0) dpflux = 0 - !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) + + if (use_cslam) dpflux = 0 + !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. - - - do ie=nets,nete + dp_thresh=.025_r8 ! tunable coefficient + do ie=nets,nete !$omp parallel do num_threads(vert_num_threads) private(k,tmp) do k=kbeg,kend - nu_ratio1=1 - nu_ratio2=1 - if (nu_div_lev(k)/=nu_lev(k)) then - if(hypervis_scaling /= 0) then - ! we have a problem with the tensor in that we cant seperate - ! div and curl components. So we do, with tensor V: - ! nu * (del V del ) * ( nu_ratio * grad(div) - curl(curl)) - nu_ratio1=nu_div_lev(k)/nu_lev(k) - nu_ratio2=1 - else - nu_ratio1=sqrt(nu_div_lev(k)/nu_lev(k)) - nu_ratio2=sqrt(nu_div_lev(k)/nu_lev(k)) - endif - endif - - if (present(T_ref)) then - tmp=elem(ie)%state%T(:,:,k,nt)-T_ref(:,:,k,ie) - else - tmp=elem(ie)%state%T(:,:,k,nt) - end if + nu_ratio1=1 + nu_ratio2=1 + if (nu_div_lev(k)/=nu_lev(k)) then + if(hypervis_scaling /= 0) then + ! we have a problem with the tensor in that we cant seperate + ! div and curl components. So we do, with tensor V: + ! nu * (del V del ) * ( nu_ratio * grad(div) - curl(curl)) + nu_ratio1=nu_div_lev(k)/nu_lev(k) + nu_ratio2=1 + else + nu_ratio1=sqrt(nu_div_lev(k)/nu_lev(k)) + nu_ratio2=sqrt(nu_div_lev(k)/nu_lev(k)) + endif + endif + + tmp=elem(ie)%state%T(:,:,k,nt)-elem(ie)%derived%T_ref(:,:,k) call laplace_sphere_wk(tmp,deriv,elem(ie),ttens(:,:,k,ie),var_coef=var_coef1) - if (present(dp3d_ref)) then - tmp=elem(ie)%state%dp3d(:,:,k,nt)-dp3d_ref(:,:,k,ie) - else - tmp=elem(ie)%state%dp3d(:,:,k,nt) - end if + + tmp=elem(ie)%state%dp3d(:,:,k,nt)-elem(ie)%derived%dp_ref(:,:,k) call laplace_sphere_wk(tmp,deriv,elem(ie),dptens(:,:,k,ie),var_coef=var_coef1) call vlaplace_sphere_wk(elem(ie)%state%v(:,:,:,k,nt),deriv,elem(ie),.true.,vtens(:,:,:,k,ie), & var_coef=var_coef1,nu_ratio=nu_ratio1) enddo - + 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 + + kptr = kbeg - 1 + 3*nlev call edgeVpack(edge3,dptens(:,:,kbeg:kend,ie),kblk,kptr,ie) enddo - + call bndry_exchange(hybrid,edge3,location='biharmonic_wk_dp3d') - + do ie=nets,nete !CLEAN rspheremv => elem(ie)%rspheremp(:,:) - + kptr = kbeg - 1 call edgeVunpack(edge3,ttens(:,:,kbeg:kend,ie),kblk,kptr,ie) - - kptr = kbeg - 1 + nlev + + kptr = kbeg - 1 + nlev call edgeVunpack(edge3,vtens(:,:,1,kbeg:kend,ie),kblk,kptr,ie) - - kptr = kbeg - 1 + 2*nlev + + kptr = kbeg - 1 + 2*nlev call edgeVunpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) - - kptr = kbeg - 1 + 3*nlev + + kptr = kbeg - 1 + 3*nlev call edgeVunpack(edge3,dptens(:,:,kbeg:kend,ie),kblk,kptr,ie) - - if (ntrac>0) then + + if (use_cslam) then do k=1,nlev -!CLEAN tmp(:,:)= rspheremv(:,:)*dptens(:,:,k,ie) - tmp(:,:)= elem(ie)%rspheremp(:,:)*dptens(:,:,k,ie) - call subcell_Laplace_fluxes(tmp, deriv, elem(ie), np, nc,dpflux(:,:,:,k,ie)) +!CLEAN tmp(:,:)= rspheremv(:,:)*dptens(:,:,k,ie) + tmp(:,:)= elem(ie)%rspheremp(:,:)*dptens(:,:,k,ie) + 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 @@ -179,7 +172,7 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, v(:,:,2)=elem(ie)%rspheremp(:,:)*vtens(:,:,2,k,ie) call vlaplace_sphere_wk(v(:,:,:),deriv,elem(ie),.true.,vtens(:,:,:,k,ie), & var_coef=.true.,nu_ratio=nu_ratio2) - + enddo enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -194,7 +187,7 @@ subroutine biharmonic_wk_omega(elem,ptens,deriv,edge3,hybrid,nets,nete,kbeg,kend real (kind=r8), dimension(np,np,nlev,nets:nete) :: ptens type (EdgeBuffer_t) , intent(inout) :: edge3 type (derivative_t) , intent(in) :: deriv - + ! local integer :: i,j,k,kptr,ie,kblk real (kind=r8), dimension(:,:), pointer :: rspheremv @@ -203,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 @@ -261,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. @@ -278,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) @@ -290,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 @@ -310,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 @@ -346,7 +339,7 @@ subroutine make_C0(zeta,elem,hybrid,nets,nete) enddo enddo -call FreeEdgeBuffer(edge1) +call FreeEdgeBuffer(edge1) end subroutine @@ -414,7 +407,7 @@ subroutine make_C0_vector(v,elem,hybrid,nets,nete) enddo enddo -call FreeEdgeBuffer(edge2) +call FreeEdgeBuffer(edge2) #endif end subroutine @@ -425,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(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -464,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(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -501,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 @@ -528,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(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -557,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(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -592,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(:,:,:,:) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -632,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 @@ -656,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 @@ -672,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) @@ -684,7 +677,7 @@ subroutine neighbor_minmax_start(hybrid,edgeMinMax,nets,nete,min_neigh,max_neigh integer :: kblk, qblk integer :: kbeg, kend, qbeg, qend - ! local + ! local integer :: ie,q, k,kptr call get_loop_ranges(hybrid,kbeg=kbeg,kend=kend,qbeg=qbeg,qend=qend) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 new file mode 100644 index 0000000000..14f1d65167 --- /dev/null +++ b/src/dynamics/se/dycore_budget.F90 @@ -0,0 +1,528 @@ +module dycore_budget +use shr_kind_mod, only: r8=>shr_kind_r8 +implicit none + +public :: print_budget +real(r8), parameter :: eps = 1.0E-7_r8 +real(r8), parameter :: eps_mass = 1.0E-12_r8 + +real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 +real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 +real(r8), save :: previous_dEdt_phys_dyn_coupl_err = 0.0_r8 +!========================================================================================= +contains +!========================================================================================= + +subroutine print_budget(hstwr) + + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use cam_budget, only: cam_budget_get_global, is_cam_budget, thermo_budget_histfile_num, thermo_budget_history + use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv, & + teidx, seidx, keidx, poidx + use dimensions_mod, only: use_cslam + use control_mod, only: ftype + + ! arguments + logical, intent(in) :: hstwr(:) + + ! Local variables + character(len=*), parameter :: subname = 'dycore_budget:print_budgets:' + ! + ! physics energy tendencies + ! + integer :: idx(4) + real(r8) :: dEdt_param_physE(4) ! dE/dt CAM physics using physics E formula (phAP-phBP) + real(r8) :: dEdt_param_dynE(4) ! dE/dt CAM physics using dycore E (dyAP-dyBP) + + real(r8) :: dEdt_efix_physE(4) ! dE/dt energy fixer using physics E formula (phBP-phBF) + real(r8) :: dEdt_efix_dynE(4) ! dE/dt energy fixer using dycore E formula (dyBP-dyBF) + + real(r8) :: dEdt_dme_adjust_physE(4) ! dE/dt dry mass adjustment using physics E formula (phAM-phAP) + real(r8) :: dEdt_dme_adjust_dynE(4) ! dE/dt dry mass adjustment using dycore E (dyAM-dyAP) + + real(r8) :: dEdt_param_efix_physE(4) ! dE/dt CAM physics + energy fixer using physics E formula (phAP-phBF) + real(r8) :: dEdt_param_efix_dynE(4) ! dE/dt CAM physics + energy fixer using dycore E formula (dyAP-dyBF) + + real(r8) :: dEdt_phys_total_dynE(4) ! dE/dt physics total using dycore E (dyAM-dyBF) + ! physics total = parameterizations + efix + dry-mass adjustment + ! + ! SE dycore specific energy tendencies + ! + real(r8) :: dEdt_phys_total_in_dyn(4) ! dEdt of physics total in dynamical core + ! physics total = parameterizations + efix + dry-mass adjustment + real(r8) :: dEdt_dycore_phys ! dEdt dycore (estimated in physics) + ! + ! mass budgets physics + ! + real(r8) :: dMdt_efix ! mass tendency energy fixer + real(r8) :: dMdt_parameterizations ! mass tendency physics paramterizations + real(r8) :: dMdt_dme_adjust ! mass tendency dry-mass adjustment + real(r8) :: dMdt_phys_total ! mass tendency physics total (energy fixer + parameterizations + dry-mass adjustment) + ! + ! mass budgets dynamics + ! + real(r8) :: dMdt_floating_dyn ! mass tendency floating dynamics (dAL-dBL) + real(r8) :: dMdt_vert_remap ! mass tendency vertical remapping (dAR-dAD) + real(r8) :: dMdt_del4_fric_heat ! mass tendency del4 frictional heating (dAH-dCH) + real(r8) :: dMdt_del4_tot ! mass tendency del4 + del4 frictional heating (dAH-dBH) + real(r8) :: dMdt_residual ! mass tendency residual (time truncation errors) + real(r8) :: dMdt_phys_total_in_dyn ! mass tendency physics total in dycore + real(r8) :: dMdt_PDC ! mass tendency physics-dynamics coupling + ! + ! energy budgets dynamics + ! + real(r8) :: dEdt_floating_dyn ! dE/dt floating dynamics (dAL-dBL) + real(r8) :: dEdt_vert_remap ! dE/dt vertical remapping (dAR-dAD) + real(r8) :: dEdt_del4 ! dE/dt del4 (dCH-dBH) + real(r8) :: dEdt_del4_fric_heat ! dE/dt del4 frictional heating (dAH-dCH) + real(r8) :: dEdt_del4_tot ! dE/dt del4 + del4 fricitional heating (dAH-dBH) + real(r8) :: dEdt_del2_sponge ! dE/dt del2 sponge (dAS-dBS) + real(r8) :: dEdt_del2_del4_tot ! dE/dt explicit diffusion total + real(r8) :: dEdt_residual ! dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot) + real(r8) :: dEdt_dycore_dyn ! dE/dt adiabatic dynamical core (calculated in dycore) + ! + ! physics-dynamics coupling variables + ! + real(r8) :: E_dBF(4) ! E of dynamics state at the end of dycore integration (on dycore deomposition) + real(r8) :: E_dyBF(4) ! E of physics state using dycore E + + + real(r8) :: diff, tmp ! dummy variables + integer :: m_cnst, i + character(LEN=*), parameter :: fmt = "(a40,a15,a1,F6.2,a1,F6.2,a1,E10.2,a5)" + character(LEN=*), parameter :: fmtf = "(a48,F8.4,a6)" + character(LEN=*), parameter :: fmtm = "(a48,E8.2,a9)" + character(LEN=15) :: str(4) + character(LEN=5) :: pf ! pass or fail identifier + !-------------------------------------------------------------------------------------- + + if (masterproc .and. thermo_budget_history .and. hstwr(thermo_budget_histfile_num)) then + idx(1) = teidx !total energy index + idx(2) = seidx !enthaly index + idx(3) = keidx !kinetic energy index + idx(4) = poidx !surface potential energy index + str(1) = "(total )" + str(2) = "(enthalpy )" + str(3) = "(kinetic )" + str(4) = "(srf potential)" + do i=1,4 + ! + ! CAM physics energy tendencies + ! + call cam_budget_get_global('phAP-phBP',idx(i),dEdt_param_physE(i)) + call cam_budget_get_global('phBP-phBF',idx(i),dEdt_efix_physE(i)) + call cam_budget_get_global('phAM-phAP',idx(i),dEdt_dme_adjust_physE(i)) + call cam_budget_get_global('phAP-phBF',idx(i),dEdt_param_efix_physE(i)) + ! + ! CAM physics energy tendencies using dycore energy formula scaling + ! temperature tendencies for consistency with CAM physics + ! + call cam_budget_get_global('dyAP-dyBP',idx(i),dEdt_param_dynE(i)) + call cam_budget_get_global('dyBP-dyBF',idx(i),dEdt_efix_dynE(i)) + call cam_budget_get_global('dyAM-dyAP',idx(i),dEdt_dme_adjust_dynE(i)) + call cam_budget_get_global('dyAP-dyBF',idx(i),dEdt_param_efix_dynE(i)) + call cam_budget_get_global('dyAM-dyBF',idx(i),dEdt_phys_total_dynE(i)) + call cam_budget_get_global('dyBF' ,idx(i),E_dyBF(i))!state beginning physics + ! + ! CAM physics energy tendencies in dynamical core + ! + call cam_budget_get_global('dBD-dAF',idx(i),dEdt_phys_total_in_dyn(i)) + call cam_budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics + end do + + call cam_budget_get_global('dAL-dBL',teidx,dEdt_floating_dyn) + call cam_budget_get_global('dAR-dAD',teidx,dEdt_vert_remap) + dEdt_dycore_dyn = dEdt_floating_dyn+dEdt_vert_remap + + call cam_budget_get_global('dCH-dBH',teidx,dEdt_del4) + call cam_budget_get_global('dAH-dCH',teidx,dEdt_del4_fric_heat) + call cam_budget_get_global('dAH-dBH',teidx,dEdt_del4_tot) + call cam_budget_get_global('dAS-dBS',teidx,dEdt_del2_sponge) + dEdt_del2_del4_tot = dEdt_del4_tot+dEdt_del2_sponge + dEdt_residual = dEdt_floating_dyn-dEdt_del2_del4_tot + + write(iulog,*)" " + write(iulog,*)"======================================================================" + write(iulog,*)"Total energy diagnostics introduced in Lauritzen and Williamson (2019)" + write(iulog,*)"(DOI:10.1029/2018MS001549)" + write(iulog,*)"======================================================================" + write(iulog,*)" " + write(iulog,*)"Globally and vertically integrated total energy (E) diagnostics are" + write(iulog,*)"computed at various points in the physics and dynamics loops to compute" + write(iulog,*)"energy tendencies (dE/dt) and check for consistency (e.g., is E of" + write(iulog,*)"state passed to physics computed using dycore state variables the same" + write(iulog,*)"E of the state in the beginning of physics computed using the physics" + write(iulog,*)"representation of the state)" + write(iulog,*)" " + write(iulog,*)"Energy stages in physics:" + write(iulog,*)"-------------------------" + write(iulog,*)" " + write(iulog,*)" xxBF: state passed to parameterizations, before energy fixer" + write(iulog,*)" xxBP: after energy fixer, before parameterizations" + write(iulog,*)" xxAP: after last phys_update in parameterizations and state " + write(iulog,*)" saved for energy fixer" + write(iulog,*)" xxAM: after dry mass adjustment" + write(iulog,*)" history files saved off here" + write(iulog,*)" " + write(iulog,*)"where xx='ph','dy' " + write(iulog,*)" " + write(iulog,*)"Suffix ph is CAM physics total energy" + write(iulog,*)"(eq. 111 in Lauritzen et al. 2022; 10.1029/2022MS003117)" + write(iulog,*)" " + write(iulog,*)"Suffix dy is dycore energy computed in CAM physics using" + write(iulog,*)"CAM physics state variables" + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"Energy stages in dynamics (specific to the SE dycore)" + write(iulog,*)"-----------------------------------------------------" + write(iulog,*)" " + write(iulog,*)"suffix (d)" + write(iulog,*)"dED: state from end of previous dynamics (= pBF + time sampling)" + write(iulog,*)" loop over vertical remapping and physics dribbling -------- (nsplit) -------" + write(iulog,*)" (dribbling and remapping always done together) |" + write(iulog,*)" dAF: state from previous remapping |" + write(iulog,*)" dBD: state after physics dribble, before dynamics |" + write(iulog,*)" loop over vertical Lagrangian dynamics --------rsplit------------- |" + write(iulog,*)" dynamics here | |" + write(iulog,*)" loop over hyperviscosity ----------hypervis_sub------------ | |" + write(iulog,*)" dBH state before hyperviscosity | | |" + write(iulog,*)" dCH state after hyperviscosity | | |" + write(iulog,*)" dAH state after hyperviscosity momentum heating | | |" + write(iulog,*)" end hyperviscosity loop ----------------------------------- | |" + write(iulog,*)" dBS state before del2 sponge | | |" + write(iulog,*)" dAS state after del2+mom heating sponge | | |" + write(iulog,*)" end of vertical Lagrangian dynamics loop ------------------------- |" + write(iulog,*)" dAD state after dynamics, before vertical remapping |" + write(iulog,*)" dAR state after vertical remapping |" + write(iulog,*)" end of remapping loop ------------------------------------------------------" + write(iulog,*)"dBF state passed to parameterizations = state after last remapping " + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"FYI: all difference (diff) below are absolute normalized differences" + write(iulog,*)" " + write(iulog,*)"Consistency check 0:" + write(iulog,*)"--------------------" + write(iulog,*)" " + write(iulog,*)"For energetic consistency we require that dE/dt [W/m^2] from energy " + write(iulog,*)"fixer and all parameterizations computed using physics E and" + write(iulog,*)"dycore in physics E are the same! Checking:" + write(iulog,*)" " + write(iulog,*) " xx=ph xx=dy norm. diff." + write(iulog,*) " ----- ----- -----------" + do i=1,4 + diff = abs_diff(dEdt_efix_physE(i),dEdt_efix_dynE(i),pf=pf) + write(iulog,fmt)"dE/dt energy fixer (xxBP-xxBF) ",str(i)," ",dEdt_efix_physE(i), " ", & + dEdt_efix_dynE(i)," ",diff,pf + diff = abs_diff(dEdt_param_physE(i),dEdt_param_dynE(i),pf=pf) + write(iulog,fmt)"dE/dt all parameterizations (xxAP-xxBP) ",str(i)," ",dEdt_param_physE(i)," ", & + dEdt_param_dynE(i)," ",diff,pf + write(iulog,*) " " + if (diff>eps) then + write(iulog,*)"FAIL" + call endrun(subname//"dE/dt's in physics inconsistent") + end if + end do + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"dE/dt from dry-mass adjustment will differ if dynamics and physics use" + write(iulog,*)"different energy definitions! Checking:" + write(iulog,*)" " + write(iulog,*) " xx=ph xx=dy diff" + write(iulog,*) " ----- ----- ----" + do i=1,4 + diff = dEdt_dme_adjust_physE(i)-dEdt_dme_adjust_dynE(i) + write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",dEdt_dme_adjust_physE(i)," ", & + dEdt_dme_adjust_dynE(i)," ",diff + end do + write(iulog,*)" " + write(iulog,*)" " + ! + ! these diagnostics only make sense time-step to time-step + ! + write(iulog,*)" " + write(iulog,*)"Some energy budget observations:" + write(iulog,*)"--------------------------------" + write(iulog,*)" " + write(iulog,*)"Note that total energy fixer fixes:" + write(iulog,*) " " + write(iulog,*) "-dE/dt energy fixer(t=n) = dE/dt dry mass adjustment (t=n-1) +" + write(iulog,*) " dE/dt adiabatic dycore (t=n-1) +" + write(iulog,*) " dE/dt physics-dynamics coupling errors (t=n-1)" + write(iulog,*) " " + write(iulog,*) "(equation 23 in Lauritzen and Williamson (2019))" + write(iulog,*) " " + + tmp = previous_dEdt_phys_dyn_coupl_err+previous_dEdt_adiabatic_dycore+previous_dEdt_dry_mass_adjust + diff = abs_diff(-dEdt_efix_dynE(1),tmp,pf) + if (.not.use_cslam) then + write(iulog,*) "Check if that is the case:", pf, diff + write(iulog,*) " " + if (abs(diff)>eps) then + write(iulog,*) "dE/dt energy fixer(t=n) = ",dEdt_efix_dynE(1) + write(iulog,*) "dE/dt dry mass adjustment (t=n-1) = ",previous_dEdt_dry_mass_adjust + write(iulog,*) "dE/dt adiabatic dycore (t=n-1) = ",previous_dEdt_adiabatic_dycore + write(iulog,*) "dE/dt physics-dynamics coupling errors (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err + end if + else + previous_dEdt_phys_dyn_coupl_err = dEdt_efix_dynE(1)+previous_dEdt_dry_mass_adjust+previous_dEdt_adiabatic_dycore + write(iulog,*) "dE/dt energy fixer(t=n) = ",dEdt_efix_dynE(1) + write(iulog,*) "dE/dt dry mass adjustment (t=n-1) = ",previous_dEdt_dry_mass_adjust + write(iulog,*) "dE/dt adiabatic dycore (t=n-1) = ",previous_dEdt_adiabatic_dycore + write(iulog,*) "dE/dt physics-dynamics coupling errors (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err + write(iulog,*) " " + write(iulog,*) "Note: when running CSLAM the physics-dynamics coupling error is diagnosed" + write(iulog,*) " (using equation above) rather than explicitly computed" + write(iulog,*) " " + write(iulog,*) " " + write(iulog,*) "Physics-dynamics coupling errors include: " + write(iulog,*) " " + write(iulog,*) " -dE/dt adiabatic dycore is computed on GLL grid;" + write(iulog,*) " error in mapping to physics grid" + write(iulog,*) " -dE/dt physics tendencies mapped to GLL grid" + write(iulog,*) " (tracer tendencies mapped non-conservatively!)" + write(iulog,*) " -dE/dt dynamics state mapped to GLL grid" + end if + write(iulog,*) "" + if (.not.use_cslam) then + dEdt_dycore_phys = -dEdt_efix_dynE(1)-previous_dEdt_phys_dyn_coupl_err-previous_dEdt_dry_mass_adjust + write(iulog,*) "Hence the dycore E dissipation estimated from energy fixer " + write(iulog,'(A39,F6.2,A6)') "based on previous time-step values is ",dEdt_dycore_phys," W/M^2" + write(iulog,*) " " + end if + write(iulog,*) " " + write(iulog,*) "-------------------------------------------------------------------" + write(iulog,*) " Consistency check 1: state passed to physics same as end dynamics?" + write(iulog,*) "-------------------------------------------------------------------" + write(iulog,*) " " + write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" + write(iulog,*) "and beginning of physics (using dynamics in physics energy; dyBF) the same?" + write(iulog,*) "" + if (.not.use_cslam) then + if (abs(E_dyBF(1))>eps) then + diff = abs_diff(E_dBF(1),E_dyBF(1)) + if (abs(diff)eps) then + ! + ! if errors print details + ! + if (ftype==1) then + write(iulog,*) "" + write(iulog,*) " You are using ftype==1 so physics-dynamics coupling errors should be round-off!" + write(iulog,*) "" + write(iulog,*) " Because of failure provide detailed diagnostics below:" + write(iulog,*) "" + else + write(iulog,*) "" + write(iulog,*) " Since ftype<>1 there are physics dynamics coupling errors" + write(iulog,*) "" + write(iulog,*) " Break-down below:" + write(iulog,*) "" + end if + + do i=1,4 + write(iulog,*) str(i),":" + write(iulog,*) "======" + diff = abs_diff(dEdt_phys_total_dynE(i),dEdt_phys_total_in_dyn(i),pf=pf) + write(iulog,*) "dE/dt physics-dynamics coupling errors (diff) ",diff + write(iulog,*) "dE/dt physics total in dynamics (dBD-dAF) ",dEdt_phys_total_in_dyn(i) + write(iulog,*) "dE/dt physics total in physics (dyAM-dyBF) ",dEdt_phys_total_dynE(i) + write(iulog,*) " " + write(iulog,*) " physics total = parameterizations + efix + dry-mass adjustment" + write(iulog,*) " " + end do +! Temporarily disable endrun until energy bias for consistancy check 2 is better understood. +! if (ftype==1) then +! call endrun(subname//"Physics-dynamics coupling error. See atm.log") +! end if + end if + else + write(iulog,'(a47,F6.2,a6)')" dE/dt physics tendency in dynamics (dBD-dAF) ",dEdt_phys_total_in_dyn(1)," W/M^2" + write(iulog,'(a47,F6.2,a6)')" dE/dt physics tendency in physics (dyAM-dyBF) ",dEdt_phys_total_dynE(1)," W/M^2" + write(iulog,*)" " + write(iulog,*) " When runnig with a physics grid this consistency check does not make sense" + write(iulog,*) " since it is computed on the GLL grid whereas we enforce energy conservation" + write(iulog,*) " on the physics grid. To assess the errors of running dynamics on GLL" + write(iulog,*) " grid, tracers on CSLAM grid and physics on physics grid we use the energy" + write(iulog,*) " fixer check from above:" + write(iulog,*) " " + write(iulog,*) " dE/dt physics-dynamics coupling errors (t=n-1) =",previous_dEdt_phys_dyn_coupl_err + write(iulog,*) "" + end if + write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" SE dycore energy tendencies" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + write(iulog,fmtf)" dE/dt dycore ",dEdt_dycore_dyn," W/M^2" + write(iulog,*)" " + write(iulog,*)"Adiabatic dynamics can be divided into quasi-horizontal and vertical remapping: " + write(iulog,*)" " + write(iulog,fmtf)" dE/dt floating dynamics (dAD-dBD) ",dEdt_floating_dyn," W/M^2" + write(iulog,fmtf)" dE/dt vertical remapping (dAR-dAD) ",dEdt_vert_remap," W/M^2" + + write(iulog,*) " " + write(iulog,*) "Breakdown of floating dynamics:" + write(iulog,*) " " + write(iulog,fmtf)" dE/dt hypervis del4 (dCH-dBH) ",dEdt_del4, " W/M^2" + write(iulog,fmtf)" dE/dt hypervis frictional heating (dAH-dCH) ",dEdt_del4_fric_heat," W/M^2" + write(iulog,fmtf)" dE/dt hypervis del4 total (dAH-dBH) ",dEdt_del4_tot, " W/M^2" + write(iulog,fmtf)" dE/dt hypervis sponge del2 (dAS-dBS) ",dEdt_del2_sponge, " W/M^2" + write(iulog,fmtf)" dE/dt explicit diffusion total ",dEdt_del2_del4_tot, " W/M^2" + write(iulog,*) " " + write(iulog,fmtf)" dE/dt residual (time-truncation errors,...) ",dEdt_residual, " W/M^2" + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)"Tracer mass budgets" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + write(iulog,*)"Below the physics-dynamics coupling error is computed as " + write(iulog,*)"dMASS/dt physics tendency in dycore (dBD-dAF) minus" + write(iulog,*)"dMASS/dt total physics (pAM-pBF)" + write(iulog,*)" " + write(iulog,*)" " + do m_cnst=1,thermo_budget_num_vars + if (thermo_budget_vars_massv(m_cnst)) then + write(iulog,*)thermo_budget_vars_descriptor(m_cnst) + write(iulog,*)"------------------------------" + call cam_budget_get_global('phBP-phBF',m_cnst,dMdt_efix) + call cam_budget_get_global('phAM-phAP',m_cnst,dMdt_dme_adjust) + call cam_budget_get_global('phAP-phBP',m_cnst,dMdt_parameterizations) + call cam_budget_get_global('phAM-phBF',m_cnst,dMdt_phys_total) + ! + ! total energy fixer should not affect mass - checking + ! + if (abs(dMdt_efix)>eps_mass) then + write(iulog,*) "dMASS/dt energy fixer (pBP-pBF) ",dMdt_efix," Pa/m^2/s" + write(iulog,*) "ERROR: Mass not conserved in energy fixer. ABORT" + call endrun(subname//"Mass not conserved in energy fixer. See atm.log") + endif + ! + ! dry-mass adjustmnt should not affect mass - checking + ! + if (abs(dMdt_dme_adjust)>eps_mass) then + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",dMdt_dme_adjust," Pa/m^2/s" + write(iulog,*) "ERROR: Mass not conserved in dry mass adjustment. ABORT" + call endrun(subname//"Mass not conserved in dry mass adjustment. See atm.log") + end if + ! + ! all of the mass-tendency should come from parameterization - checking + ! + if (abs(dMdt_parameterizations-dMdt_phys_total)>eps_mass) then + write(iulog,*) "Error: dMASS/dt parameterizations (pAP-pBP) .ne. dMASS/dt physics total (pAM-pBF)" + write(iulog,*) "dMASS/dt parameterizations (pAP-pBP) ",dMdt_parameterizations," Pa/m^2/s" + write(iulog,*) "dMASS/dt physics total (pAM-pBF) ",dMdt_phys_total," Pa/m^2/s" + call endrun(subname//"mass change not only due to parameterizations. See atm.log") + end if + write(iulog,*)" " + ! + ! detailed mass budget in dynamical core + ! + if (is_cam_budget('dAD').and.is_cam_budget('dBD').and.is_cam_budget('dAR').and.is_cam_budget('dCH')) then + call cam_budget_get_global('dAL-dBL',m_cnst,dMdt_floating_dyn) + call cam_budget_get_global('dAR-dAD',m_cnst,dMdt_vert_remap) + tmp = dMdt_floating_dyn+dMdt_vert_remap + diff = abs_diff(tmp,0.0_r8,pf=pf) + write(iulog,fmtm)" dMASS/dt total adiabatic dynamics ",diff,pf + ! + ! check for mass-conservation in the adiabatic dynamical core - + ! if not conserved provide detailed break-down + ! + if (abs(diff)>eps_mass) then + write(iulog,*) "Error: mass non-conservation in dynamical core" + write(iulog,*) "(detailed budget below)" + write(iulog,*) " " + write(iulog,*)"dMASS/dt 2D dynamics (dAL-dBL) ",dMdt_floating_dyn," Pa/m^2/s" + write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",dMdt_vert_remap + write(iulog,*)" " + write(iulog,*)"Breakdown of 2D dynamics:" + write(iulog,*)" " + call cam_budget_get_global('dAH-dCH',m_cnst,dMdt_del4_fric_heat) + call cam_budget_get_global('dAH-dBH',m_cnst,dMdt_del4_tot) + write(iulog,*)"dMASS/dt hypervis (dAH-dBH) ",dMdt_del4_tot," Pa/m^2/s" + write(iulog,*)"dMASS/dt frictional heating (dAH-dCH) ",dMdt_del4_fric_heat," Pa/m^2/s" + dMdt_residual = dMdt_floating_dyn-dMdt_del4_tot + write(iulog,*)"dMASS/dt residual (time truncation errors)",dMdt_residual," Pa/m^2/s" + end if + end if + if (is_cam_budget('dBD').and.is_cam_budget('dAF')) then + ! + ! check if mass change in physics is the same as dynamical core + ! + call cam_budget_get_global('dBD-dAF',m_cnst,dMdt_phys_total_in_dyn) + dMdt_PDC = dMdt_phys_total-dMdt_phys_total_in_dyn + write(iulog,fmtm)" Mass physics-dynamics coupling error ",dMdt_PDC," Pa/m^2/s" + write(iulog,*)" " + if (abs(dMdt_PDC)>eps_mass) then + write(iulog,fmtm)" dMASS/dt physics tendency in dycore (dBD-dAF) ",dMdt_phys_total_in_dyn," Pa/m^2/s" + write(iulog,fmtm)" dMASS/dt total physics ",dMdt_phys_total," Pa/m^2/s" + end if + end if + end if + end do + ! + ! save adiabatic dycore dE/dt and dry-mass adjustment to avoid samping error + ! + previous_dEdt_adiabatic_dycore = dEdt_dycore_dyn + previous_dEdt_dry_mass_adjust = dEdt_dme_adjust_dynE(1) + end if +end subroutine print_budget +!========================================================================================= +function abs_diff(a,b,pf) + real(r8), intent(in) :: a,b + character(LEN=5), optional, intent(out):: pf + real(r8) :: abs_diff + if (abs(b)>eps) then + abs_diff = abs((b-a)/b) + else + abs_diff = abs(b-a) + end if + If (present(pf)) then + if (abs_diff>eps) then + pf = ' FAIL' + else + pf = ' PASS' + end if + end if +end function abs_diff +end module dycore_budget diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index bb98e9692e..37aab5931a 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -8,13 +8,14 @@ module dyn_comp use constituents, only: pcnst, cnst_get_ind, cnst_name, cnst_longname, & cnst_read_iv, qmin, cnst_type, tottnam, & cnst_is_a_water_species -use cam_control_mod, only: initial_run, simple_phys +use cam_control_mod, only: initial_run use cam_initfiles, only: initial_file_get_id, topo_file_get_id, pertlim -use phys_control, only: use_gw_front, use_gw_front_igw, waccmx_is -use dyn_grid, only: ini_grid_name, timelevel, hvcoord, edgebuf +use phys_control, only: use_gw_front, use_gw_front_igw, use_gw_movmtn_pbl +use dyn_grid, only: ini_grid_name, timelevel, hvcoord, edgebuf, & + ini_grid_hdim_name use cam_grid_support, only: cam_grid_id, cam_grid_get_gcid, & - cam_grid_dimensions, cam_grid_get_dim_names, & + cam_grid_dimensions, & cam_grid_get_latvals, cam_grid_get_lonvals, & max_hcoordname_len use cam_map_utils, only: iMap @@ -37,14 +38,17 @@ module dyn_comp use parallel_mod, only: par use hybrid_mod, only: hybrid_t -use dimensions_mod, only: nelemd, nlev, np, npsq, ntrac, nc, fv_nphys, & - qsize +use dimensions_mod, only: nelemd, nlev, np, npsq, ntrac, nc, fv_nphys +use dimensions_mod, only: qsize, use_cslam use element_mod, only: element_t, elem_state_t use fvm_control_volume_mod, only: fvm_struct -use time_mod, only: nsplit +use se_dyn_time_mod, only: nsplit 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 @@ -75,13 +79,7 @@ module dyn_comp ! Frontogenesis indices integer, public :: frontgf_idx = -1 integer, public :: frontga_idx = -1 - -! constituent indices for waccm-x dry air properties -integer, public, protected :: & - ixo = -1, & - ixo2 = -1, & - ixh = -1, & - ixh2 = -1 +integer, public :: vort4gw_idx = -1 interface read_dyn_var module procedure read_dyn_field_2d @@ -90,13 +88,14 @@ module dyn_comp real(r8), parameter :: rad2deg = 180.0_r8 / pi real(r8), parameter :: deg2rad = pi / 180.0_r8 +real(r8), parameter :: rarea_sphere = 1.0_r8 / (4.0_r8*PI) !=============================================================================== contains !=============================================================================== subroutine dyn_readnl(NLFileName) - use physconst, only: thermodynamic_active_species_num + use air_composition,only: thermodynamic_active_species_num use namelist_utils, only: find_group_name use namelist_mod, only: homme_set_defaults, homme_postprocess_namelist use units, only: getunit, freeunit @@ -112,26 +111,24 @@ subroutine dyn_readnl(NLFileName) use control_mod, only: vert_remap_uvTq_alg, vert_remap_tracer_alg use control_mod, only: tstep_type, rk_stage_user use control_mod, only: ftype, limiter_option, partmethod - use control_mod, only: topology, phys_dyn_cp, variable_nsplit + use control_mod, only: topology, variable_nsplit use control_mod, only: fine_ne, hypervis_power, hypervis_scaling use control_mod, only: max_hypervis_courant, statediag_numtrac,refined_mesh - use control_mod, only: raytau0, raykrange, rayk0, molecular_diff + use control_mod, only: molecular_diff, pgf_formulation, dribble_in_rsplit_loop + use control_mod, only: sponge_del4_nu_div_fac, sponge_del4_nu_fac, sponge_del4_lev use dimensions_mod, only: ne, npart - use dimensions_mod, only: lcp_moist - use dimensions_mod, only: hypervis_dynamic_ref_state,large_Courant_incr + use dimensions_mod, only: large_Courant_incr use dimensions_mod, only: fvm_supercycling, fvm_supercycling_jet use dimensions_mod, only: kmin_jet, kmax_jet use params_mod, only: SFCURVE use parallel_mod, only: initmpi use thread_mod, only: initomp, max_num_threads use thread_mod, only: horz_num_threads, vert_num_threads, tracer_num_threads - use physconst, only: rearth ! Dummy argument character(len=*), intent(in) :: NLFileName ! Local variables integer :: unitn, ierr,k - real(r8) :: uniform_res_hypervis_scaling,nu_fac ! SE Namelist variables integer :: se_fine_ne @@ -153,6 +150,9 @@ subroutine dyn_readnl(NLFileName) real(r8) :: se_nu_div real(r8) :: se_nu_p real(r8) :: se_nu_top + real(r8) :: se_sponge_del4_nu_fac + real(r8) :: se_sponge_del4_nu_div_fac + integer :: se_sponge_del4_lev integer :: se_qsplit logical :: se_refined_mesh integer :: se_rsplit @@ -164,20 +164,15 @@ subroutine dyn_readnl(NLFileName) integer :: se_horz_num_threads integer :: se_vert_num_threads integer :: se_tracer_num_threads - logical :: se_hypervis_dynamic_ref_state - logical :: se_lcp_moist logical :: se_write_restart_unstruct logical :: se_large_Courant_incr integer :: se_fvm_supercycling integer :: se_fvm_supercycling_jet integer :: se_kmin_jet integer :: se_kmax_jet - integer :: se_phys_dyn_cp - real(r8) :: se_raytau0 - real(r8) :: se_raykrange - integer :: se_rayk0 real(r8) :: se_molecular_diff - + integer :: se_pgf_formulation + integer :: se_dribble_in_rsplit_loop namelist /dyn_se_inparm/ & se_fine_ne, & ! For refined meshes se_ftype, & ! forcing type @@ -198,6 +193,9 @@ subroutine dyn_readnl(NLFileName) se_nu_div, & se_nu_p, & se_nu_top, & + se_sponge_del4_nu_fac, & + se_sponge_del4_nu_div_fac, & + se_sponge_del4_lev, & se_qsplit, & se_refined_mesh, & se_rsplit, & @@ -212,20 +210,15 @@ subroutine dyn_readnl(NLFileName) se_horz_num_threads, & se_vert_num_threads, & se_tracer_num_threads, & - se_hypervis_dynamic_ref_state,& - se_lcp_moist, & se_write_restart_unstruct, & se_large_Courant_incr, & se_fvm_supercycling, & se_fvm_supercycling_jet, & se_kmin_jet, & se_kmax_jet, & - se_phys_dyn_cp, & - se_raytau0, & - se_raykrange, & - se_rayk0, & - se_molecular_diff - + se_molecular_diff, & + se_pgf_formulation, & + se_dribble_in_rsplit_loop !-------------------------------------------------------------------------- ! defaults for variables not set by build-namelist @@ -273,6 +266,9 @@ subroutine dyn_readnl(NLFileName) call MPI_bcast(se_nu_div, 1, mpi_real8, masterprocid, mpicom, ierr) call MPI_bcast(se_nu_p, 1, mpi_real8, masterprocid, mpicom, ierr) call MPI_bcast(se_nu_top, 1, mpi_real8, masterprocid, mpicom, ierr) + call MPI_bcast(se_sponge_del4_nu_fac, 1, mpi_real8, masterprocid, mpicom, ierr) + call MPI_bcast(se_sponge_del4_nu_div_fac, 1, mpi_real8, masterprocid, mpicom, ierr) + call MPI_bcast(se_sponge_del4_lev, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_qsplit, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_refined_mesh, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_rsplit, 1, mpi_integer, masterprocid, mpicom, ierr) @@ -288,20 +284,15 @@ subroutine dyn_readnl(NLFileName) call MPI_bcast(se_horz_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) call MPI_bcast(se_vert_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) call MPI_bcast(se_tracer_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) - call MPI_bcast(se_hypervis_dynamic_ref_state, 1, mpi_logical, masterprocid, mpicom, ierr) - call MPI_bcast(se_lcp_moist, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_write_restart_unstruct, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_large_Courant_incr, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_fvm_supercycling, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_fvm_supercycling_jet, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_kmin_jet, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_kmax_jet, 1, mpi_integer, masterprocid, mpicom, ierr) - call MPI_bcast(se_phys_dyn_cp, 1, mpi_integer, masterprocid, mpicom, ierr) - call MPI_bcast(se_rayk0 , 1, mpi_integer, masterprocid, mpicom, ierr) - call MPI_bcast(se_raykrange, 1, mpi_real8, masterprocid, mpicom, ierr) - call MPI_bcast(se_raytau0, 1, mpi_real8, masterprocid, mpicom, ierr) call MPI_bcast(se_molecular_diff, 1, mpi_real8, masterprocid, mpicom, ierr) - + call MPI_bcast(se_pgf_formulation, 1, mpi_integer, masterprocid, mpicom, ierr) + call MPI_bcast(se_dribble_in_rsplit_loop, 1, mpi_integer, masterprocid, mpicom, ierr) if (se_npes <= 0) then call endrun('dyn_readnl: ERROR: se_npes must be > 0') end if @@ -351,6 +342,9 @@ subroutine dyn_readnl(NLFileName) nu_p = se_nu_p nu_q = se_nu_p !for tracer-wind consistency nu_q must me equal to nu_p nu_top = se_nu_top + sponge_del4_nu_fac = se_sponge_del4_nu_fac + sponge_del4_nu_div_fac = se_sponge_del4_nu_div_fac + sponge_del4_lev = se_sponge_del4_lev qsplit = se_qsplit rsplit = se_rsplit statefreq = se_statefreq @@ -358,30 +352,27 @@ subroutine dyn_readnl(NLFileName) vert_remap_uvTq_alg = set_vert_remap(se_vert_remap_T, se_vert_remap_uvTq_alg) vert_remap_tracer_alg = set_vert_remap(se_vert_remap_T, se_vert_remap_tracer_alg) fv_nphys = se_fv_nphys - hypervis_dynamic_ref_state = se_hypervis_dynamic_ref_state - lcp_moist = se_lcp_moist large_Courant_incr = se_large_Courant_incr fvm_supercycling = se_fvm_supercycling fvm_supercycling_jet = se_fvm_supercycling_jet kmin_jet = se_kmin_jet kmax_jet = se_kmax_jet variable_nsplit = .false. - phys_dyn_cp = se_phys_dyn_cp - raytau0 = se_raytau0 - raykrange = se_raykrange - rayk0 = se_rayk0 molecular_diff = se_molecular_diff - + pgf_formulation = se_pgf_formulation + dribble_in_rsplit_loop = se_dribble_in_rsplit_loop if (fv_nphys > 0) then ! Use finite volume physics grid and CSLAM for tracer advection nphys_pts = fv_nphys*fv_nphys qsize = thermodynamic_active_species_num ! number tracers advected by GLL - ntrac = pcnst ! number tracers advected by CSLAM + ntrac = pcnst ! number tracers advected by CSLAM + use_cslam = .true. else ! Use GLL grid for physics and tracer advection nphys_pts = npsq qsize = pcnst ntrac = 0 + use_cslam = .false. end if if (rsplit < 1) then @@ -440,7 +431,6 @@ subroutine dyn_readnl(NLFileName) end if write(iulog, '(a,i0)') 'dyn_readnl: se_npes = ',se_npes write(iulog, '(a,i0)') 'dyn_readnl: se_nsplit = ',se_nsplit - write(iulog, '(a,i0)') 'dyn_readnl: se_phys_dyn_cp = ',se_phys_dyn_cp ! ! se_nu<0 then coefficients are set automatically in module global_norms_mod ! @@ -460,12 +450,18 @@ subroutine dyn_readnl(NLFileName) write(iulog, '(a,a)') 'dyn_readnl: se_vert_remap_T = ',trim(se_vert_remap_T) write(iulog, '(a,a)') 'dyn_readnl: se_vert_remap_uvTq_alg = ',trim(se_vert_remap_uvTq_alg) write(iulog, '(a,a)') 'dyn_readnl: se_vert_remap_tracer_alg = ',trim(se_vert_remap_tracer_alg) - write(iulog, '(a,l4)') 'dyn_readnl: se_hypervis_dynamic_ref_state = ',hypervis_dynamic_ref_state - write(iulog, '(a,l4)') 'dyn_readnl: lcp_moist = ',lcp_moist write(iulog, '(a,i0)') 'dyn_readnl: se_fvm_supercycling = ',fvm_supercycling write(iulog, '(a,i0)') 'dyn_readnl: se_fvm_supercycling_jet = ',fvm_supercycling_jet write(iulog, '(a,i0)') 'dyn_readnl: se_kmin_jet = ',kmin_jet write(iulog, '(a,i0)') 'dyn_readnl: se_kmax_jet = ',kmax_jet + + write(iulog, *) 'dyn_readnl: se_sponge_del4_nu_fac = ',se_sponge_del4_nu_fac + if (se_sponge_del4_nu_fac < 0) write(iulog, '(a)') ' (automatically set based on model top location)' + write(iulog, *) 'dyn_readnl: se_sponge_del4_nu_div_fac = ',se_sponge_del4_nu_div_fac + if (se_sponge_del4_nu_div_fac < 0) write(iulog, '(a)') ' (automatically set based on model top location)' + write(iulog, *) 'dyn_readnl: se_sponge_del4_lev = ',se_sponge_del4_lev + if (se_sponge_del4_lev < 0) write(iulog, '(a)') ' (automatically set based on model top location)' + if (se_refined_mesh) then write(iulog, '(a)') 'dyn_readnl: Refined mesh simulation' write(iulog, '(a)') 'dyn_readnl: se_mesh_file = ',trim(se_mesh_file) @@ -480,7 +476,7 @@ subroutine dyn_readnl(NLFileName) end if end if - if (fv_nphys > 0) then + if (use_cslam) then write(iulog, '(a)') 'dyn_readnl: physics will run on FVM points; advection by CSLAM' write(iulog,'(a,i0)') 'dyn_readnl: se_fv_nphys = ', fv_nphys else @@ -499,9 +495,6 @@ subroutine dyn_readnl(NLFileName) write(iulog,'(a,l1)') 'dyn_readnl: write restart data on unstructured grid = ', & se_write_restart_unstruct - write(iulog, '(a,e9.2)') 'dyn_readnl: se_raytau0 = ', raytau0 - write(iulog, '(a,e9.2)') 'dyn_readnl: se_raykrange = ', raykrange - write(iulog, '(a,i0)' ) 'dyn_readnl: se_rayk0 = ', rayk0 write(iulog, '(a,e9.2)') 'dyn_readnl: se_molecular_diff = ', molecular_diff end if @@ -580,6 +573,10 @@ subroutine dyn_register() call pbuf_add_field("FRONTGA", "global", dtype_r8, (/pcols,pver/), & frontga_idx) end if + if (use_gw_movmtn_pbl) then + call pbuf_add_field("VORT4GW", "global", dtype_r8, (/pcols,pver/), & + vort4gw_idx) + end if end subroutine dyn_register @@ -589,45 +586,54 @@ subroutine dyn_init(dyn_in, dyn_out) use prim_advance_mod, only: prim_advance_init use dyn_grid, only: elem, fvm use cam_pio_utils, only: clean_iodesc_list - use physconst, only: thermodynamic_active_species_num, thermodynamic_active_species_idx - use physconst, only: thermodynamic_active_species_idx_dycore, rair, cpair + use physconst, only: cpair, pstd + use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx + use air_composition, only: thermodynamic_active_species_idx_dycore + use air_composition, only: thermodynamic_active_species_liq_idx,thermodynamic_active_species_ice_idx + use air_composition, only: thermodynamic_active_species_liq_idx_dycore,thermodynamic_active_species_ice_idx_dycore + use air_composition, only: thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num use cam_history, only: addfld, add_default, horiz_only, register_vector_field use gravity_waves_sources, only: gws_init use thread_mod, only: horz_num_threads use hybrid_mod, only: get_loop_ranges, config_thread_region - use dimensions_mod, only: nu_scale_top, nu_lev, nu_div_lev + use dimensions_mod, only: nu_scale_top use dimensions_mod, only: ksponge_end, kmvis_ref, kmcnd_ref,rho_ref,km_sponge_factor - use dimensions_mod, only: kmvisi_ref, kmcndi_ref,rhoi_ref use dimensions_mod, only: cnst_name_gll, cnst_longname_gll - use dimensions_mod, only: irecons_tracer_lev, irecons_tracer, otau, kord_tr, kord_tr_cslam + use dimensions_mod, only: irecons_tracer_lev, irecons_tracer, kord_tr, kord_tr_cslam use prim_driver_mod, only: prim_init2 - use time_mod, only: time_at - use control_mod, only: runtype, raytau0, raykrange, rayk0, molecular_diff, nu_top + use control_mod, only: molecular_diff, nu_top use test_fvm_mapping, only: test_mapping_addfld use phys_control, only: phys_getopts - use physconst, only: get_molecular_diff_coef_reference + use cam_thermo, only: get_molecular_diff_coef_reference use control_mod, only: vert_remap_uvTq_alg, vert_remap_tracer_alg + use std_atm_profile, only: std_atm_height + use dyn_tests_utils, only: vc_dycore, vc_dry_pressure, string_vc, vc_str_lgth + use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_register, thermo_budget_history + ! Dummy arguments: type(dyn_import_t), intent(out) :: dyn_in type(dyn_export_t), intent(out) :: dyn_out ! Local variables - integer :: ithr, nets, nete, ie, k, kmol_end + integer :: nets, nete, ie, k, kmol_end, mfound real(r8), parameter :: Tinit = 300.0_r8 - real(r8) :: press, ptop, tref + real(r8) :: press(1), ptop, tref,z(1) type(hybrid_t) :: hybrid - integer :: ixcldice, ixcldliq, ixrain, ixsnow, ixgraupel + integer :: ixcldice, ixcldliq integer :: m_cnst, m ! variables for initializing energy and axial angular momentum diagnostics - character (len = 3), dimension(12) :: stage = (/"dED","dAF","dBD","dAD","dAR","dBF","dBH","dCH","dAH",'dBS','dAS','p2d'/) - character (len = 70),dimension(12) :: stage_txt = (/& + integer, parameter :: num_stages = 14 + character (len = 4), dimension(num_stages) :: stage = (/"dED","dAF","dBD","dBL","dAL","dAD","dAR","dBF","dBH","dCH","dAH","dBS","dAS","p2d"/) + character (len = 70),dimension(num_stages) :: stage_txt = (/& " end of previous dynamics ",& !dED " from previous remapping or state passed to dynamics",& !dAF - state in beginning of nsplit loop " state after applying CAM forcing ",& !dBD - state after applyCAMforcing + " before floating dynamics ",& !dBL + " after floating dynamics ",& !dAL " before vertical remapping ",& !dAD - state before vertical remapping " after vertical remapping ",& !dAR - state at end of nsplit loop " state passed to parameterizations ",& !dBF @@ -638,42 +644,29 @@ subroutine dyn_init(dyn_in, dyn_out) " state after sponge layer diffusion ",& !dAS - state after sponge del2 " phys2dyn mapping errors (requires ftype-1) " & !p2d - for assessing phys2dyn mapping errors /) - character (len = 2) , dimension(8) :: vars = (/"WV" ,"WL" ,"WI" ,"SE" ,"KE" ,"MR" ,"MO" ,"TT" /) - !if ntrac>0 then tracers should be output on fvm grid but not energy (SE+KE) and AAM diags - logical , dimension(8) :: massv = (/.true.,.true.,.true.,.false.,.false.,.false.,.false.,.false./) - character (len = 70) , dimension(8) :: vars_descriptor = (/& - "Total column water vapor ",& - "Total column cloud water ",& - "Total column cloud ice ",& - "Total column dry static energy ",& - "Total column kinetic energy ",& - "Total column wind axial angular momentum",& - "Total column mass axial angular momentum",& - "Total column test tracer "/) - character (len = 14), dimension(8) :: & - vars_unit = (/& - "kg/m2 ","kg/m2 ","kg/m2 ","J/m2 ",& - "J/m2 ","kg*m2/s*rad2 ","kg*m2/s*rad2 ","kg/m2 "/) - - integer :: istage, ivars - character (len=108) :: str1, str2, str3 - - logical :: history_budget ! output tendencies and state variables for budgets + + integer :: istage + character (len=vc_str_lgth) :: vc_str + + logical :: history_budget ! output tendencies and state variables for budgets integer :: budget_hfile_num - character(len=*), parameter :: subname = 'dyn_init' + character(len=*), parameter :: sub = 'dyn_init' - real(r8) :: tau0, krange, otau0, scale real(r8) :: km_sponge_factor_local(nlev+1) !---------------------------------------------------------------------------- - + vc_dycore = vc_dry_pressure + if (masterproc) then + call string_vc(vc_dycore,vc_str) + write(iulog,*) sub//': vertical coordinate dycore : ',trim(vc_str) + end if ! Now allocate and set condenstate vars allocate(cnst_name_gll(qsize)) ! constituent names for gll tracers allocate(cnst_longname_gll(qsize)) ! long name of constituents for gll tracers allocate(kord_tr(qsize)) kord_tr(:) = vert_remap_tracer_alg - if (ntrac>0) then + if (use_cslam) then allocate(kord_tr_cslam(ntrac)) kord_tr_cslam(:) = vert_remap_tracer_alg end if @@ -691,7 +684,7 @@ subroutine dyn_init(dyn_in, dyn_out) ! CSLAM tracers are always indexed as in physics ! of no CSLAM then SE tracers are always indexed as in physics ! - if (ntrac>0) then + if (use_cslam) then ! ! note that in this case qsize = thermodynamic_active_species_num ! @@ -711,11 +704,37 @@ subroutine dyn_init(dyn_in, dyn_out) end if cnst_name_gll (m) = cnst_name (m) cnst_longname_gll(m) = cnst_longname(m) - end if end do - + do m=1,thermodynamic_active_species_liq_num + if (use_cslam) then + do mfound=1,qsize + if (TRIM(cnst_name(thermodynamic_active_species_liq_idx(m)))==TRIM(cnst_name_gll(mfound))) then + thermodynamic_active_species_liq_idx_dycore(m) = mfound + end if + end do + else + thermodynamic_active_species_liq_idx_dycore(m) = thermodynamic_active_species_liq_idx(m) + end if + if (masterproc) then + write(iulog,*) sub//": m,thermodynamic_active_species_idx_liq_dycore: ",m,thermodynamic_active_species_liq_idx_dycore(m) + end if + end do + do m=1,thermodynamic_active_species_ice_num + if (use_cslam) then + do mfound=1,qsize + if (TRIM(cnst_name(thermodynamic_active_species_ice_idx(m)))==TRIM(cnst_name_gll(mfound))) then + thermodynamic_active_species_ice_idx_dycore(m) = mfound + end if + end do + else + thermodynamic_active_species_ice_idx_dycore(m) = thermodynamic_active_species_ice_idx(m) + end if + if (masterproc) then + write(iulog,*) sub//": m,thermodynamic_active_species_idx_ice_dycore: ",m,thermodynamic_active_species_ice_idx_dycore(m) + end if + end do ! ! Initialize the import/export objects @@ -736,29 +755,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() - end if - ! - ! initialize Rayleigh friction - ! - krange = raykrange - if (raykrange .eq. 0._r8) krange = (rayk0 - 1) / 2._r8 - tau0 = (86400._r8) * raytau0 ! convert to seconds - otau0 = 0._r8 - if (tau0 .ne. 0._r8) otau0 = 1._r8/tau0 - do k = 1, nlev - otau(k) = otau0 * (1.0_r8 + tanh((rayk0 - k) / krange)) / (2._r8) - enddo - if (masterproc) then - if (tau0 > 0._r8) then - write (iulog,*) 'SE dycore Rayleigh friction - krange = ', krange - write (iulog,*) 'SE dycore Rayleigh friction - otau0 = ', 1.0_r8/tau0 - write (iulog,*) 'SE dycore Rayleigh friction decay rate profile (only applied to (u,v))' - do k = 1, nlev - write (iulog,*) ' k = ', k, ' otau = ', otau(k) - enddo - end if + 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 @@ -768,28 +771,28 @@ subroutine dyn_init(dyn_in, dyn_out) ! ! molecular diffusion and thermal conductivity reference values ! - if (masterproc) write(iulog,*) subname//": initialize molecular diffusion reference profiles" + if (masterproc) write(iulog,*) sub//": initialize molecular diffusion reference profiles" tref = 1000._r8 !mean value at model top for solar max km_sponge_factor = molecular_diff km_sponge_factor_local = molecular_diff - call get_molecular_diff_coef_reference(1,nlev+1,tref,& - (hvcoord%hyai(:)+hvcoord%hybi(:))*hvcoord%ps0, km_sponge_factor_local,& - kmvisi_ref,kmcndi_ref,rhoi_ref) ! ! get rho, kmvis and kmcnd at mid-levels ! - call get_molecular_diff_coef_reference(1,nlev,tref,& + call get_molecular_diff_coef_reference(tref,& (hvcoord%hyam(:)+hvcoord%hybm(:))*hvcoord%ps0,km_sponge_factor,& kmvis_ref,kmcnd_ref,rho_ref) + if (masterproc) then + write(iulog,*) "Molecular viscosity and thermal conductivity reference profile" + write(iulog,*) "k, p, z, km_sponge_factor, kmvis_ref/rho_ref, kmcnd_ref/(cp*rho_ref):" + end if do k=1,nlev ! only apply molecular viscosity where viscosity is > 1000 m/s^2 if (MIN(kmvis_ref(k)/rho_ref(k),kmcnd_ref(k)/(cpair*rho_ref(k)))>1000.0_r8) then if (masterproc) then - write(iulog,'(a,i3,2e11.4)') "k, p, km_sponge_factor :",k, & - (hvcoord%hyam(k)+hvcoord%hybm(k))*hvcoord%ps0,km_sponge_factor(k) - write(iulog,'(a,2e11.4)') "kmvis_ref/rho_ref, kmcnd_ref/(cp*rho_ref): ", & - kmvis_ref(k)/rho_ref(k),kmcnd_ref(k)/(cpair*rho_ref(k)) + press = hvcoord%hyam(k)*hvcoord%ps0+hvcoord%hybm(k)*pstd + call std_atm_height(press,z) + write(iulog,'(i3,5e11.4)') k,press, z,km_sponge_factor(k),kmvis_ref(k)/rho_ref(k),kmcnd_ref(k)/(cpair*rho_ref(k)) end if kmol_end = k else @@ -811,26 +814,61 @@ subroutine dyn_init(dyn_in, dyn_out) ! nu_scale_top(:) = 0.0_r8 if (nu_top>0) then - if (masterproc) write(iulog,*) subname//": sponge layer viscosity scaling factor" - do k=1,nlev - press = (hvcoord%hyam(k)+hvcoord%hybm(k))*hvcoord%ps0 - ptop = hvcoord%hyai(1)*hvcoord%ps0 - nu_scale_top(k) = 8.0_r8*(1.0_r8+tanh(1.0_r8*log(ptop/press))) ! tau will be maximum 8 at model top - if (nu_scale_top(k).ge.0.15_r8) then - ksponge_end = k - else - nu_scale_top(k) = 0.0_r8 - end if - end do + ptop = hvcoord%hyai(1)*hvcoord%ps0 + if (ptop>300.0_r8) then + ! + ! for low tops the tanh formulae below makes the sponge excessively deep + ! + nu_scale_top(1) = 4.0_r8 + nu_scale_top(2) = 2.0_r8 + nu_scale_top(3) = 1.0_r8 + ksponge_end = 3 + else if (ptop>100.0_r8) then + ! + ! CAM6 top (~225 Pa) or CAM7 low top + ! + ! For backwards compatibility numbers below match tanh profile + ! used in FV + ! + nu_scale_top(1) = 4.4_r8 + nu_scale_top(2) = 1.3_r8 + nu_scale_top(3) = 3.9_r8 + ksponge_end = 3 + else if (ptop>1e-1_r8) then + ! + ! CAM7 FMT + ! + nu_scale_top(1) = 3.0_r8 + nu_scale_top(2) = 1.0_r8 + nu_scale_top(3) = 0.1_r8 + nu_scale_top(4) = 0.05_r8 + ksponge_end = 4 + else if (ptop>1e-4_r8) then + ! + ! WACCM and WACCM-x + ! + nu_scale_top(1) = 5.0_r8 + nu_scale_top(2) = 5.0_r8 + nu_scale_top(3) = 5.0_r8 + nu_scale_top(4) = 2.0_r8 + nu_scale_top(5) = 1.0_r8 + nu_scale_top(6) = 0.1_r8 + ksponge_end = 6 + end if else - ksponge_end = 0 + ksponge_end = 0 end if ksponge_end = MAX(MAX(ksponge_end,1),kmol_end) if (masterproc) then - write(iulog,*) subname//": ksponge_end = ",ksponge_end + write(iulog,*) sub//": ksponge_end = ",ksponge_end + write(iulog,*) sub//": sponge layer Laplacian damping" + write(iulog,*) "k, p, z, nu_scale_top, nu (actual Laplacian damping coefficient)" if (nu_top>0) then - do k=1,ksponge_end - write(iulog,'(a,i3,1e11.4)') subname//": nu_scale_top ",k,nu_scale_top(k) + do k=1,ksponge_end+1 + press = (hvcoord%hyam(k)+hvcoord%hybm(k))*hvcoord%ps0 + call std_atm_height(press,z) + write(iulog,'(i3,4e11.4)') k,press,z,& + nu_scale_top(k),nu_scale_top(k)*nu_top end do end if end if @@ -842,8 +880,7 @@ subroutine dyn_init(dyn_in, dyn_out) call get_loop_ranges(hybrid, ibeg=nets, iend=nete) call prim_init2(elem, fvm, hybrid, nets, nete, TimeLevel, hvcoord) !$OMP END PARALLEL - - if (use_gw_front .or. use_gw_front_igw) call gws_init(elem) + if (use_gw_front .or. use_gw_front_igw .or. use_gw_movmtn_pbl) call gws_init(elem) end if ! iam < par%nprocs call addfld ('nu_kmvis', (/ 'lev' /), 'A', '', 'Molecular viscosity Laplacian coefficient' , gridname='GLL') @@ -858,7 +895,7 @@ subroutine dyn_init(dyn_in, dyn_out) call addfld ('FT', (/ 'lev' /), 'A', 'K/s', 'Temperature forcing term on GLL grid',gridname='GLL') ! Tracer forcing on fvm (CSLAM) grid and internal CSLAM pressure fields - if (ntrac>0) then + if (use_cslam) then do m = 1, ntrac call addfld (trim(cnst_name(m))//'_fvm', (/ 'lev' /), 'I', 'kg/kg', & trim(cnst_longname(m)), gridname='FVM') @@ -874,13 +911,13 @@ subroutine dyn_init(dyn_in, dyn_out) do m_cnst = 1, qsize call addfld ('F'//trim(cnst_name_gll(m_cnst))//'_gll', (/ 'lev' /), 'I', 'kg/kg/s', & - trim(cnst_longname(m_cnst))//' mixing ratio forcing term (q_new-q_old) on GLL grid', gridname='GLL') + trim(cnst_longname_gll(m_cnst))//' mixing ratio forcing term (q_new-q_old) on GLL grid', gridname='GLL') end do ! Energy diagnostics and axial angular momentum diagnostics call addfld ('ABS_dPSdt', horiz_only, 'A', 'Pa/s', 'Absolute surface pressure tendency',gridname='GLL') - if (ntrac>0) then + if (use_cslam) then #ifdef waccm_debug call addfld ('CSLAM_gamma', (/ 'lev' /), 'A', '', 'Courant number from CSLAM', gridname='FVM') #endif @@ -895,24 +932,43 @@ subroutine dyn_init(dyn_in, dyn_out) call addfld ('TT_PDC', horiz_only, 'A', 'kg/m2','Total column test tracer lost in physics-dynamics coupling',gridname='GLL') end if - do istage = 1,SIZE(stage) - do ivars=1,SIZE(vars) - write(str1,*) TRIM(ADJUSTL(vars(ivars))),TRIM(ADJUSTL("_")),TRIM(ADJUSTL(stage(istage))) - write(str2,*) TRIM(ADJUSTL(vars_descriptor(ivars))),& - TRIM(ADJUSTL(" ")),TRIM(ADJUSTL(stage_txt(istage))) - write(str3,*) TRIM(ADJUSTL(vars_unit(ivars))) - if (ntrac>0.and.massv(ivars)) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') - else - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') - end if + if (thermo_budget_history) then + ! Register stages for budgets + do istage = 1, num_stages + call cam_budget_em_snapshot(TRIM(ADJUSTL(stage(istage))), 'dyn', & + longname=TRIM(ADJUSTL(stage_txt(istage)))) end do - end do - + ! + ! Register tendency (difference) budgets + ! + call cam_budget_em_register('dEdt_floating_dyn' ,'dAL','dBL','dyn','dif', & + longname="dE/dt floating dynamics (dAL-dBL)" ) + call cam_budget_em_register('dEdt_vert_remap' ,'dAR','dAD','dyn','dif', & + longname="dE/dt vertical remapping (dAR-dAD)" ) + call cam_budget_em_register('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif', & + longname="dE/dt physics tendency in dynamics (dBD-dAF)" ) + call cam_budget_em_register('dEdt_del4' ,'dCH','dBH','dyn','dif', & + longname="dE/dt del4 (dCH-dBH)" ) + call cam_budget_em_register('dEdt_del4_fric_heat','dAH','dCH','dyn','dif', & + longname="dE/dt del4 frictional heating (dAH-dCH)" ) + call cam_budget_em_register('dEdt_del4_tot' ,'dAH','dBH','dyn','dif', & + longname="dE/dt del4 + del4 frictional heating (dAH-dBH)" ) + call cam_budget_em_register('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif', & + longname="dE/dt del2 sponge (dAS-dBS)" ) + ! + ! Register derived budgets + ! + call cam_budget_em_register('dEdt_dycore' ,'dEdt_floating_dyn','dEdt_vert_remap' ,'dyn','sum', & + longname="dE/dt adiabatic dynamics" ) + call cam_budget_em_register('dEdt_del2_del4_tot' ,'dEdt_del4_tot' ,'dEdt_del2_sponge' ,'dyn','sum', & + longname="dE/dt explicit diffusion total" ) + call cam_budget_em_register('dEdt_residual' ,'dEdt_floating_dyn','dEdt_del2_del4_tot','dyn','dif',& + longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)" ) + end if ! ! add dynamical core tracer tendency output ! - if (ntrac>0) then + if (use_cslam) then do m = 1, pcnst call addfld(tottnam(m),(/ 'lev' /),'A','kg/kg/s',trim(cnst_name(m))//' horz + vert', & gridname='FVM') @@ -932,37 +988,29 @@ subroutine dyn_init(dyn_in, dyn_out) call add_default(tottnam(ixcldice), budget_hfile_num, ' ') end if - ! constituent indices for waccm-x - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - call cnst_get_ind('O', ixo) - call cnst_get_ind('O2', ixo2) - call cnst_get_ind('H', ixh) - call cnst_get_ind('H2', ixh2) - end if - call test_mapping_addfld end subroutine dyn_init !========================================================================================= subroutine dyn_run(dyn_state) - use physconst, only: thermodynamic_active_species_num, dry_air_species_num - use physconst, only: thermodynamic_active_species_idx_dycore - use prim_advance_mod, only: calc_tot_energy_dynamics + use air_composition, only: thermodynamic_active_species_num, dry_air_species_num + use air_composition, only: thermodynamic_active_species_idx_dycore use prim_driver_mod, only: prim_run_subcycle use dimensions_mod, only: cnst_name_gll - use time_mod, only: tstep, nsplit, timelevel_qdp + use se_dyn_time_mod, only: tstep, nsplit, timelevel_qdp, tevolve use hybrid_mod, only: config_thread_region, get_loop_ranges use control_mod, only: qsplit, rsplit, ftype_conserve use thread_mod, only: horz_num_threads - use time_mod, only: tevolve + use scamMod, only: single_column, use_3dfrc + use se_single_column_mod, only: apply_SC_forcing,ie_scm type(dyn_export_t), intent(inout) :: dyn_state type(hybrid_t) :: hybrid integer :: tl_f integer :: n - integer :: nets, nete, ithr + integer :: nets, nete integer :: i, ie, j, k, m, nq, m_cnst integer :: n0_qdp, nsplit_local logical :: ldiag @@ -974,6 +1022,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 @@ -985,6 +1034,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)) @@ -1030,24 +1080,23 @@ subroutine dyn_run(dyn_state) end if end do - - ! convert elem(ie)%derived%fq to mass tendency - do ie = nets, nete - do m = 1, qsize + if (.not.use_cslam) then + do ie = nets, nete + do m = 1, qsize do k = 1, nlev - do j = 1, np - do i = 1, np - dyn_state%elem(ie)%derived%FQ(i,j,k,m) = dyn_state%elem(ie)%derived%FQ(i,j,k,m)* & - rec2dt*dyn_state%elem(ie)%state%dp3d(i,j,k,tl_f) - end do - end do + do j = 1, np + do i = 1, np + dyn_state%elem(ie)%derived%FQ(i,j,k,m) = dyn_state%elem(ie)%derived%FQ(i,j,k,m)* & + rec2dt*dyn_state%elem(ie)%state%dp3d(i,j,k,tl_f) + end do + end do end do - end do - end do - + end do + end do + end if - if (ftype_conserve>0) then + if (ftype_conserve>0.and..not.use_cslam) then do ie = nets, nete do k=1,nlev do j=1,np @@ -1064,8 +1113,7 @@ subroutine dyn_run(dyn_state) end do end if - - if (ntrac > 0) then + if (use_cslam) then do ie = nets, nete do m = 1, ntrac do k = 1, nlev @@ -1093,8 +1141,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 @@ -1113,13 +1168,18 @@ subroutine dyn_run(dyn_state) end do end if - - call calc_tot_energy_dynamics(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp,'dBF') !$OMP END PARALLEL 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) @@ -1137,17 +1197,17 @@ end subroutine dyn_final !=============================================================================== subroutine read_inidat(dyn_in) - use physconst, only: thermodynamic_active_species_num, dry_air_species_num + use air_composition, only: thermodynamic_active_species_num, dry_air_species_num use shr_sys_mod, only: shr_sys_flush use hycoef, only: hyai, hybi, ps0 use const_init, only: cnst_init_default use element_mod, only: timelevels use fvm_mapping, only: dyn2fvm_mass_vars - use control_mod, only: runtype,initial_global_ave_dry_ps + use control_mod, only: runtype use prim_driver_mod, only: prim_set_dry_mass - use physconst, only: thermodynamic_active_species_idx - + use air_composition, only: thermodynamic_active_species_idx + use cam_initfiles, only: scale_dry_air_mass ! Arguments type (dyn_import_t), target, intent(inout) :: dyn_in ! dynamics import @@ -1167,8 +1227,8 @@ subroutine read_inidat(dyn_in) logical, allocatable :: pmask(:) ! (npsq*nelemd) unique grid vals character(len=max_hcoordname_len):: grid_name - real(r8), allocatable :: latvals(:),latvals_phys(:) - real(r8), allocatable :: lonvals(:),lonvals_phys(:) + real(r8), allocatable :: latvals(:) + real(r8), allocatable :: lonvals(:) real(r8), pointer :: latvals_deg(:) real(r8), pointer :: lonvals_deg(:) @@ -1180,9 +1240,6 @@ subroutine read_inidat(dyn_in) integer :: kptr, m_cnst type(EdgeBuffer_t) :: edge - character(len=max_fieldname_len) :: dimname, varname - integer :: ierr - integer :: rndm_seed_sz integer, allocatable :: rndm_seed(:) integer :: dims(2) @@ -1191,11 +1248,7 @@ subroutine read_inidat(dyn_in) integer :: i, j, indx, nq integer :: dyn_cols character(len=128) :: errmsg - character(len=*), parameter :: subname='READ_INIDAT' - - ! fvm vars - real(r8), allocatable :: inv_dp_darea_fvm(:,:,:) - real(r8) :: min_val, max_val + character(len=*), parameter :: sub='READ_INIDAT' real(r8) :: dp_tmp, pstmp(np,np) @@ -1330,25 +1383,26 @@ 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., dimname) - + if (.not. single_column) then + call check_file_layout(fh_ini, elem, dyn_cols, 'ncdata', .true.) + end if ! Read 2-D field fieldname = 'PS' fieldname2 = 'PSDRY' if (dyn_field_exists(fh_ini, trim(fieldname), required=.false.)) then inic_wet = .true. - call read_dyn_var(trim(fieldname), fh_ini, dimname, dbuf2) + call read_dyn_var(trim(fieldname), fh_ini, ini_grid_hdim_name, dbuf2) elseif (dyn_field_exists(fh_ini, trim(fieldname2), required=.false.)) then inic_wet = .false. - call read_dyn_var(trim(fieldname2), fh_ini, dimname, dbuf2) + call read_dyn_var(trim(fieldname2), fh_ini, ini_grid_hdim_name, dbuf2) else - call endrun(trim(subname)//': PS or PSDRY must be on GLL grid') + call endrun(trim(sub)//': PS or PSDRY must be on GLL grid') end if #ifndef planet_mars if (iam < par%nprocs) then if (minval(dbuf2, mask=reshape(pmask, (/npsq,nelemd/))) < 10000._r8) then - call endrun(trim(subname)//': Problem reading ps or psdry field -- bad values') + call endrun(trim(sub)//': Problem reading ps or psdry field -- bad values') end if end if #endif @@ -1365,9 +1419,9 @@ subroutine read_inidat(dyn_in) ! Read in 3-D fields if (dyn_field_exists(fh_ini, 'U')) then - call read_dyn_var('U', fh_ini, dimname, dbuf3) + call read_dyn_var('U', fh_ini, ini_grid_hdim_name, dbuf3) else - call endrun(trim(subname)//': U not found') + call endrun(trim(sub)//': U not found') end if do ie = 1, nelemd elem(ie)%state%v = 0.0_r8 @@ -1381,9 +1435,9 @@ subroutine read_inidat(dyn_in) end do if (dyn_field_exists(fh_ini, 'V')) then - call read_dyn_var('V', fh_ini, dimname, dbuf3) + call read_dyn_var('V', fh_ini, ini_grid_hdim_name, dbuf3) else - call endrun(trim(subname)//': V not found') + call endrun(trim(sub)//': V not found') end if do ie = 1, nelemd indx = 1 @@ -1396,9 +1450,9 @@ subroutine read_inidat(dyn_in) end do if (dyn_field_exists(fh_ini, 'T')) then - call read_dyn_var('T', fh_ini, dimname, dbuf3) + call read_dyn_var('T', fh_ini, ini_grid_hdim_name, dbuf3) else - call endrun(trim(subname)//': T not found') + call endrun(trim(sub)//': T not found') end if do ie=1,nelemd elem(ie)%state%T = 0.0_r8 @@ -1413,7 +1467,7 @@ subroutine read_inidat(dyn_in) if (pertlim .ne. 0.0_r8) then if (masterproc) then - write(iulog,*) trim(subname), ': Adding random perturbation bounded', & + write(iulog,*) trim(sub), ': Adding random perturbation bounded', & 'by +/- ', pertlim, ' to initial temperature field' end if @@ -1460,11 +1514,11 @@ subroutine read_inidat(dyn_in) if (ntrac < pcnst) then write(errmsg, '(a,3(i0,a))') ': ntrac (',ntrac,') > qsize (',qsize, & ') but < pcnst (',pcnst,')' - call endrun(trim(subname)//errmsg) + call endrun(trim(sub)//errmsg) end if else if (qsize < pcnst) then write(errmsg, '(a,2(i0,a))') ': qsize (',qsize,') < pcnst (',pcnst,')' - call endrun(trim(subname)//errmsg) + call endrun(trim(sub)//errmsg) end if ! If using analytic ICs the initial file only needs the horizonal grid @@ -1473,7 +1527,7 @@ subroutine read_inidat(dyn_in) do m_cnst = 1, pcnst if (cnst_read_iv(m_cnst) .and. .not. cnst_is_a_water_species(cnst_name(m_cnst))) then if (dyn_field_exists(fh_ini, trim(cnst_name(m_cnst)), required=.false.)) then - call check_file_layout(fh_ini, elem, dyn_cols, 'ncdata', .true., dimname) + call check_file_layout(fh_ini, elem, dyn_cols, 'ncdata', .true.) exit end if end if @@ -1491,7 +1545,7 @@ subroutine read_inidat(dyn_in) end if if (found) then - call read_dyn_var(trim(cnst_name(m_cnst)), fh_ini, dimname, dbuf3) + call read_dyn_var(trim(cnst_name(m_cnst)), fh_ini, ini_grid_hdim_name, dbuf3) else call cnst_init_default(m_cnst, latvals, lonvals, dbuf3, pmask) end if @@ -1673,28 +1727,22 @@ subroutine read_inidat(dyn_in) end do end if - ! scale PS to achieve prescribed dry mass following FV dycore (dryairm.F90) -#ifndef planet_mars + ! If scale_dry_air_mass > 0.0 then scale dry air mass to scale_dry_air_mass global average dry pressure if (runtype == 0) then - initial_global_ave_dry_ps = 98288.0_r8 - if (.not. associated(fh_topo)) then - initial_global_ave_dry_ps = 101325._r8 - 245._r8 - end if - if (simple_phys) then - initial_global_ave_dry_ps = 0 !do not scale psdry - end if - if (iam < par%nprocs) then - call prim_set_dry_mass(elem, hvcoord, initial_global_ave_dry_ps, qtmp) - end if - endif -#endif + if (scale_dry_air_mass > 0.0_r8) then + if (iam < par%nprocs) then + call prim_set_dry_mass(elem, hvcoord, scale_dry_air_mass, qtmp) + end if + end if + end if + ! store Q values: ! ! if CSLAM is NOT active then state%Qdp for all constituents ! if CSLAM active then we only advect water vapor and condensate ! loading tracers in state%qdp - if (ntrac > 0) then + if (use_cslam) then do ie = 1, nelemd do nq = 1, thermodynamic_active_species_num m_cnst = thermodynamic_active_species_idx(nq) @@ -1725,7 +1773,7 @@ subroutine read_inidat(dyn_in) ! interpolate fvm tracers and fvm pressure variables - if (ntrac > 0) then + if (use_cslam) then if (par%masterproc) then write(iulog,*) 'Initializing dp_fvm from spectral element dp' end if @@ -1747,7 +1795,7 @@ subroutine read_inidat(dyn_in) write(iulog,*) 'FVM tracers, FVM pressure variables and se_area_sphere initialized.' end if - end if ! (ntrac > 0) + end if ! (use_cslam) ! Cleanup deallocate(qtmp) @@ -1798,6 +1846,7 @@ subroutine set_phis(dyn_in) integer :: ierr, pio_errtype character(len=max_fieldname_len) :: fieldname + character(len=max_fieldname_len) :: fieldname_gll character(len=max_hcoordname_len):: grid_name integer :: dims(2) integer :: dyn_cols @@ -1817,7 +1866,7 @@ subroutine set_phis(dyn_in) real(r8), allocatable :: latvals_phys(:) real(r8), allocatable :: lonvals_phys(:) - character(len=*), parameter :: subname='set_phis' + character(len=*), parameter :: sub='set_phis' !---------------------------------------------------------------------------- fh_topo => topo_file_get_id() @@ -1831,7 +1880,7 @@ subroutine set_phis(dyn_in) allocate(phis_tmp(npsq,nelemd)) phis_tmp = 0.0_r8 - if (fv_nphys > 0) then + if (use_cslam) then allocate(phis_phys_tmp(fv_nphys**2,nelemd)) phis_phys_tmp = 0.0_r8 do ie=1,nelemd @@ -1856,10 +1905,14 @@ subroutine set_phis(dyn_in) ! Set name of grid object which will be used to read data from file ! into internal data structure via PIO. - if (fv_nphys == 0) then - grid_name = 'GLL' + if (single_column) then + grid_name = 'SCM' else - grid_name = 'physgrid_d' + if (fv_nphys == 0) then + grid_name = 'GLL' + else + grid_name = 'physgrid_d' + end if end if ! Get number of global columns from the grid object and check that @@ -1870,27 +1923,52 @@ subroutine set_phis(dyn_in) ! The dimension of the unstructured grid in the TOPO file is 'ncol'. ierr = pio_inq_dimid(fh_topo, 'ncol', ncol_did) if (ierr /= PIO_NOERR) then - call endrun(subname//': dimension ncol not found in bnd_topo file') + 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,*) subname//': ncol_size=', ncol_size, ' : dyn_cols=', dyn_cols + write(iulog,*) sub//': ncol_size=', ncol_size, ' : dyn_cols=', dyn_cols end if - call endrun(subname//': ncol size in bnd_topo file does not match grid definition') + call endrun(sub//': ncol size in bnd_topo file does not match grid definition') end if fieldname = 'PHIS' - if (dyn_field_exists(fh_topo, trim(fieldname))) then - if (fv_nphys == 0) then - call read_dyn_var(fieldname, fh_topo, 'ncol', phis_tmp) + fieldname_gll = 'PHIS_gll' + if (use_cslam.and.dyn_field_exists(fh_topo, trim(fieldname_gll),required=.false.)) then + ! + ! If physgrid it is recommended to read in PHIS on the GLL grid and then + ! map to the physgrid in d_p_coupling + ! + ! This requires a topo file with PHIS_gll on it ... + ! + if (masterproc) then + write(iulog, *) "Reading in PHIS on GLL grid (mapped to physgrid in d_p_coupling)" + end if + call read_dyn_var(fieldname_gll, fh_topo, 'ncol_gll', phis_tmp) + else if (dyn_field_exists(fh_topo, trim(fieldname))) then + if (.not.use_cslam) then + if (masterproc) then + write(iulog, *) "Reading in PHIS" + end if + call read_dyn_var(fieldname, fh_topo, 'ncol', phis_tmp) else - call read_phys_field_2d(fieldname, fh_topo, 'ncol', phis_phys_tmp) - call map_phis_from_physgrid_to_gll(dyn_in%fvm, elem, phis_phys_tmp, & - phis_tmp, pmask) + ! + ! For backwards compatibility we allow reading in PHIS on the physgrid + ! which is then mapped to the GLL grid and back to the physgrid in d_p_coupling + ! (the latter is to avoid noise in derived quantities such as PSL) + ! + if (masterproc) then + write(iulog, *) "Reading in PHIS on physgrid" + write(iulog, *) "Recommended to read in PHIS on GLL grid" + end if + call read_phys_field_2d(fieldname, fh_topo, 'ncol', phis_phys_tmp) + call map_phis_from_physgrid_to_gll(dyn_in%fvm, elem, phis_phys_tmp, & + phis_tmp, pmask) + deallocate(phis_phys_tmp) end if else - call endrun(subname//': Could not find PHIS field on input datafile') + call endrun(sub//': Could not find PHIS field on input datafile') end if ! Put the error handling back the way it was @@ -1919,44 +1997,6 @@ subroutine set_phis(dyn_in) PHIS_OUT=phis_tmp, mask=pmask(:)) deallocate(glob_ind) - if (fv_nphys > 0) then - - ! initialize PHIS on physgrid - allocate(latvals_phys(fv_nphys*fv_nphys*nelemd)) - allocate(lonvals_phys(fv_nphys*fv_nphys*nelemd)) - indx = 1 - do ie = 1, nelemd - do j = 1, fv_nphys - do i = 1, fv_nphys - latvals_phys(indx) = dyn_in%fvm(ie)%center_cart_physgrid(i,j)%lat - lonvals_phys(indx) = dyn_in%fvm(ie)%center_cart_physgrid(i,j)%lon - indx = indx + 1 - end do - end do - end do - - allocate(pmask_phys(fv_nphys*fv_nphys*nelemd)) - pmask_phys(:) = .true. - allocate(glob_ind(fv_nphys*fv_nphys*nelemd)) - - j = 1 - do ie = 1, nelemd - do i = 1, fv_nphys*fv_nphys - ! Create a global(ish) column index - glob_ind(j) = elem(ie)%GlobalId - j = j + 1 - end do - end do - - call analytic_ic_set_ic(vcoord, latvals_phys, lonvals_phys, glob_ind, & - PHIS_OUT=phis_phys_tmp, mask=pmask_phys) - - deallocate(latvals_phys) - deallocate(lonvals_phys) - deallocate(pmask_phys) - deallocate(glob_ind) - end if - end if deallocate(pmask) @@ -1972,16 +2012,7 @@ subroutine set_phis(dyn_in) end do end do end do - if (fv_nphys > 0) then - do ie = 1, nelemd - dyn_in%fvm(ie)%phis_physgrid = RESHAPE(phis_phys_tmp(:,ie),(/fv_nphys,fv_nphys/)) - end do - end if - deallocate(phis_tmp) - if (fv_nphys > 0) then - deallocate(phis_phys_tmp) - end if ! boundary exchange to update the redundent columns in the element objects do ie = 1, nelemd @@ -1989,7 +2020,7 @@ subroutine set_phis(dyn_in) call edgeVpack(edgebuf, elem(ie)%state%phis, 1, kptr, ie) end do if(iam < par%nprocs) then - call bndry_exchange(par, edgebuf, location=subname) + call bndry_exchange(par, edgebuf, location=sub) end if do ie = 1, nelemd kptr = 0 @@ -2000,7 +2031,7 @@ end subroutine set_phis !======================================================================================== -subroutine check_file_layout(file, elem, dyn_cols, file_desc, dyn_ok, dimname) +subroutine check_file_layout(file, elem, dyn_cols, file_desc, dyn_ok) ! This routine is only called when data will be read from the initial file. It is not ! called when the initial file is only supplying vertical coordinate info. @@ -2010,58 +2041,64 @@ subroutine check_file_layout(file, elem, dyn_cols, file_desc, dyn_ok, dimname) integer, intent(in) :: dyn_cols character(len=*), intent(in) :: file_desc logical, intent(in) :: dyn_ok ! .true. iff ncol_d is okay - character(len=*), intent(out) :: dimname integer :: ncol_did, ncol_size integer :: ierr integer :: ie, i, j - integer :: grid_id integer :: indx real(r8) :: dbuf2(npsq, nelemd) logical :: found - character(len=max_fieldname_len) :: dimname2, coordname + character(len=max_fieldname_len) :: coordname - character(len=*), parameter :: subname = 'check_file_layout' + character(len=*), parameter :: sub = 'check_file_layout' !---------------------------------------------------------------------------- ! Check that number of columns in IC file matches grid definition. + if (trim(ini_grid_hdim_name) == 'none') then + call endrun(sub//': ERROR: no horizontal dimension in initial data file. & + &Cannot read data from file') + end if - call cam_grid_get_dim_names(cam_grid_id(ini_grid_name), dimname, dimname2) - - ierr = pio_inq_dimid(file, trim(dimname), ncol_did) + ierr = pio_inq_dimid(file, trim(ini_grid_hdim_name), ncol_did) if (ierr /= PIO_NOERR) then - call endrun(subname//': ERROR: either ncol or ncol_d dimension not found in ' & + call endrun(sub//': ERROR: '//trim(ini_grid_hdim_name)//' dimension not found in ' & //trim(file_desc)//' file') end if ierr = pio_inq_dimlen(file, ncol_did, ncol_size) if (ncol_size /= dyn_cols) then if (masterproc) then - write(iulog, '(a,2(a,i0))') trim(subname), ': ncol_size=', ncol_size, & + write(iulog, '(a,2(a,i0))') trim(sub), ': ncol_size=', ncol_size, & ' : dyn_cols=', dyn_cols end if - call endrun(subname//': ERROR: dimension ncol size not same as in ncdata file') + call endrun(sub//': ERROR: dimension '//trim(ini_grid_hdim_name)//' size not same as in ncdata file') end if - ! Set coordinate name associated with dimname. - if (dimname == 'ncol') then + ! Set coordinate name associated with ini_grid_hdim_name. + if (trim(ini_grid_hdim_name) == 'ncol') then coordname = 'lat' else coordname = 'lat_d' end if !! Check to make sure file is in correct order - call read_dyn_var(coordname, file, dimname, dbuf2) + call read_dyn_var(coordname, file, ini_grid_hdim_name, dbuf2) found = .true. do ie = 1, nelemd indx = 1 do j = 1, np do i = 1, np - if ((abs(dbuf2(indx,ie)) > 1.e-12_r8) .and. & - (abs((elem(ie)%spherep(i,j)%lat*rad2deg - dbuf2(indx,ie))/dbuf2(indx,ie)) > 1.0e-10_r8)) then - write(6, *) 'XXG ',iam,') ',ie,i,j,elem(ie)%spherep(i,j)%lat,dbuf2(indx,ie)*deg2rad - call shr_sys_flush(6) - found = .false. + if (abs(dbuf2(indx,ie)) > 1.e-12_r8) then + if (abs((elem(ie)%spherep(i,j)%lat*rad2deg - dbuf2(indx,ie)) / & + dbuf2(indx,ie)) > 1.0e-10_r8) then + write(iulog, '(2a,4(i0,a),f11.5,a,f11.5)') & + "ncdata file latitudes not in correct column order", & + ' on task ', iam, ': elem(', ie, ')%spherep(', i, & + ', ', j, ')%lat = ', elem(ie)%spherep(i,j)%lat, & + ' /= ', dbuf2(indx, ie)*deg2rad + call shr_sys_flush(iulog) + found = .false. + end if end if indx = indx + 1 end do @@ -2071,22 +2108,28 @@ subroutine check_file_layout(file, elem, dyn_cols, file_desc, dyn_ok, dimname) call endrun("ncdata file latitudes not in correct column order") end if - if (dimname == 'ncol') then + if (trim(ini_grid_hdim_name) == 'ncol') then coordname = 'lon' else coordname = 'lon_d' end if - call read_dyn_var(coordname, file, dimname, dbuf2) + call read_dyn_var(coordname, file, ini_grid_hdim_name, dbuf2) do ie = 1, nelemd indx = 1 do j = 1, np do i = 1, np - if ((abs(dbuf2(indx,ie)) > 1.e-12_r8) .and. & - (abs((elem(ie)%spherep(i,j)%lon*rad2deg - dbuf2(indx,ie))/dbuf2(indx,ie)) > 1.0e-10_r8)) then - write(6, *) 'XXG ',iam,') ',ie,i,j,elem(ie)%spherep(i,j)%lon,dbuf2(indx,ie)*deg2rad - call shr_sys_flush(6) - found = .false. + if (abs(dbuf2(indx,ie)) > 1.e-12_r8) then + if (abs((elem(ie)%spherep(i,j)%lon*rad2deg - dbuf2(indx,ie)) / & + dbuf2(indx,ie)) > 1.0e-10_r8) then + write(iulog, '(2a,4(i0,a),f11.5,a,f11.5)') & + "ncdata file longitudes not in correct column order", & + ' on task ', iam, ': elem(', ie, ')%spherep(', i, & + ', ', j, ')%lon = ', elem(ie)%spherep(i,j)%lon, & + ' /= ', dbuf2(indx, ie)*deg2rad + call shr_sys_flush(iulog) + found = .false. + end if end if indx = indx + 1 end do @@ -2147,11 +2190,12 @@ subroutine read_dyn_field_2d(fieldname, fh, dimname, buffer) ! Local variables logical :: found + real(r8) :: fillvalue !---------------------------------------------------------------------------- buffer = 0.0_r8 call infld(trim(fieldname), fh, dimname, 1, npsq, 1, nelemd, buffer, & - found, gridname=ini_grid_name) + found, gridname=ini_grid_name, fillvalue=fillvalue) if(.not. found) then call endrun('READ_DYN_FIELD_2D: Could not find '//trim(fieldname)//' field on input datafile') end if @@ -2159,7 +2203,8 @@ subroutine read_dyn_field_2d(fieldname, fh, dimname, buffer) ! This code allows use of compiler option to set uninitialized values ! to NaN. In that case infld can return NaNs where the element GLL points ! are not "unique columns" - where (isnan(buffer)) buffer = 0.0_r8 + ! Set NaNs or fillvalue points to zero + where (isnan(buffer) .or. (buffer==fillvalue)) buffer = 0.0_r8 end subroutine read_dyn_field_2d @@ -2175,11 +2220,12 @@ subroutine read_dyn_field_3d(fieldname, fh, dimname, buffer) ! Local variables logical :: found + real(r8) :: fillvalue !---------------------------------------------------------------------------- buffer = 0.0_r8 - call infld(trim(fieldname), fh, dimname, 'lev', 1, npsq, 1, nlev, & - 1, nelemd, buffer, found, gridname=ini_grid_name) + call infld(trim(fieldname), fh, dimname, 'lev', 1, npsq, 1, nlev, & + 1, nelemd, buffer, found, gridname=ini_grid_name, fillvalue=fillvalue) if(.not. found) then call endrun('READ_DYN_FIELD_3D: Could not find '//trim(fieldname)//' field on input datafile') end if @@ -2187,7 +2233,8 @@ subroutine read_dyn_field_3d(fieldname, fh, dimname, buffer) ! This code allows use of compiler option to set uninitialized values ! to NaN. In that case infld can return NaNs where the element GLL points ! are not "unique columns" - where (isnan(buffer)) buffer = 0.0_r8 + ! Set NaNs or fillvalue points to zero + where (isnan(buffer) .or. (buffer == fillvalue)) buffer = 0.0_r8 end subroutine read_dyn_field_3d @@ -2276,7 +2323,7 @@ subroutine write_dyn_vars(dyn_out) integer :: ie, m !---------------------------------------------------------------------------- - if (ntrac > 0) then + if (use_cslam) then do ie = 1, nelemd call outfld('dp_fvm', RESHAPE(dyn_out%fvm(ie)%dp_fvm(1:nc,1:nc,:), & (/nc*nc,nlev/)), nc*nc, ie) diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 index 8423132a43..69d9bbc520 100644 --- a/src/dynamics/se/dyn_grid.F90 +++ b/src/dynamics/se/dyn_grid.F90 @@ -27,31 +27,28 @@ module dyn_grid !------------------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8, shr_kind_cl -use spmd_utils, only: masterproc, iam, mpicom, mstrid=>masterprocid, & - npes, mpi_integer, mpi_real8, mpi_success +use spmd_utils, only: masterproc, iam, mpicom, mstrid=>masterprocid +use spmd_utils, only: npes, mpi_integer, mpi_real8 use constituents, only: pcnst use physconst, only: pi use cam_initfiles, only: initial_file_get_id use cam_grid_support, only: iMap -use dp_mapping, only: dp_reoorder +use physics_column_type, only: physics_column_t use cam_logfile, only: iulog use cam_abortutils, only: endrun -use shr_sys_mod, only: shr_sys_flush -use pio, only: file_desc_t, pio_seterrorhandling, pio_bcast_error, & - pio_internal_error, pio_noerr, pio_inq_dimid, & - pio_inq_dimlen +use pio, only: file_desc_t -use dimensions_mod, only: globaluniquecols, nelem, nelemd, nelemdmax, & - ne, np, npsq, fv_nphys, nlev, nc, ntrac +use dimensions_mod, only: globaluniquecols, nelem, nelemd, nelemdmax +use dimensions_mod, only: ne, np, npsq, fv_nphys, nlev, use_cslam use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use hybvcoord_mod, only: hvcoord_t use prim_init, only: prim_init1 use edge_mod, only: initEdgeBuffer use edgetype_mod, only: EdgeBuffer_t -use time_mod, only: TimeLevel_t +use se_dyn_time_mod, only: TimeLevel_t use dof_mod, only: UniqueCoords, UniquePoints implicit none @@ -62,9 +59,12 @@ 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. +character(len=6), protected :: ini_grid_hdim_name = '' + integer, parameter :: ptimelevels = 2 type (TimeLevel_t) :: TimeLevel ! main time level struct (used by tracers) @@ -72,36 +72,30 @@ module dyn_grid type(element_t), pointer :: elem(:) => null() ! local GLL elements for this task type(fvm_struct), pointer :: fvm(:) => null() ! local FVM elements for this task -public :: & - dyn_decomp, & - ini_grid_name, & - ptimelevels, & - TimeLevel, & - hvcoord, & - elem, & - fvm, & - edgebuf - -public :: & - dyn_grid_init, & - get_block_bounds_d, & ! get first and last indices in global block ordering - get_block_gcol_d, & ! get column indices for given block - get_block_gcol_cnt_d, & ! get number of columns in given block - get_block_lvl_cnt_d, & ! get number of vertical levels in column - get_block_levels_d, & ! get vertical levels in column - get_block_owner_d, & ! get process "owning" given block - get_gcol_block_d, & ! get global block indices and local columns - ! index for given global column index - get_gcol_block_cnt_d, & ! get number of blocks containing data - ! from a given global column index - get_horiz_grid_dim_d, & - get_horiz_grid_d, & ! get horizontal grid coordinates - get_dyn_grid_parm, & - get_dyn_grid_parm_real1d, & - dyn_grid_get_elem_coords, & ! get coordinates of a specified block element - dyn_grid_get_colndx, & ! get element block/column and MPI process indices - ! corresponding to a specified global column index - physgrid_copy_attributes_d +public :: dyn_decomp +public :: ini_grid_name +public :: ini_grid_hdim_name +public :: ptimelevels +public :: TimeLevel +public :: hvcoord +public :: elem +public :: fvm +public :: edgebuf + +public :: dyn_grid_init ! Initialize the dynamics grid +public :: get_dyn_grid_info ! Return physics grid column information +public :: physgrid_copy_attributes_d ! Attributes to copy to physics grid + +!!XXgoldyXX: v These need to be removed to complete the weak scaling transition. +public :: get_horiz_grid_d +public :: get_horiz_grid_dim_d +public :: get_dyn_grid_parm +public :: get_dyn_grid_parm_real1d +!!XXgoldyXX: ^ These need to be removed to complete the weak scaling transition. +public :: dyn_grid_get_elem_coords ! get coords of a specified block element + +! Note: dyn_grid_get_colndx is not implemenented in SE +public :: dyn_grid_get_colndx ! get element block/column and MPI process indices ! Namelist variables controlling grid writing. ! Read in dyn_readnl from dyn_se_inparm group. @@ -109,18 +103,7 @@ module dyn_grid character(len=shr_kind_cl), public :: se_grid_filename = '' logical, public :: se_write_gll_corners = .false. -type block_global_data - integer :: UniquePtOffset ! global index of first column in element - integer :: NumUniqueP ! number of unique columns in element - integer :: LocalID ! local index of element in a task - integer :: Owner ! task id of element owner -end type block_global_data - -! Name of horizontal grid dimension in initial file. -character(len=6) :: ini_grid_hdim_name = ' ' - -! Only need this global data for the GLL grid if it is also the physics grid. -type(block_global_data), allocatable :: gblocks(:) +type(physics_column_t), allocatable, target :: local_dyn_columns(:) ! number of global dynamics columns. Set by SE dycore init. integer :: ngcols_d = 0 @@ -150,14 +133,13 @@ subroutine dyn_grid_init() use parallel_mod, only: par use hybrid_mod, only: hybrid_t, init_loop_ranges, & get_loop_ranges, config_thread_region - use thread_mod , only: horz_num_threads use control_mod, only: qsplit, rsplit - use time_mod, only: tstep, nsplit + use se_dyn_time_mod, only: tstep, nsplit use fvm_mod, only: fvm_init2, fvm_init3, fvm_pg_init use dimensions_mod, only: irecons_tracer use comp_gll_ctr_vol, only: gll_grid_write - use physconst, only: thermodynamic_active_species_num - + use air_composition, only: thermodynamic_active_species_num + ! Local variables type(file_desc_t), pointer :: fh_ini @@ -167,7 +149,6 @@ subroutine dyn_grid_init() type(hybrid_t) :: hybrid integer :: ierr - integer :: neltmp(3) integer :: dtime real(r8), allocatable ::clat(:), clon(:), areaa(:) @@ -197,12 +178,12 @@ subroutine dyn_grid_init() if (iam < par%nprocs) then call prim_init1(elem, fvm, par, TimeLevel) - if (fv_nphys > 0) then + if (use_cslam) then call dp_init(elem, fvm) end if if (fv_nphys > 0) then - qsize_local = thermodynamic_active_species_num + 3 + qsize_local = 3 else qsize_local = pcnst + 3 end if @@ -262,11 +243,6 @@ subroutine dyn_grid_init() call fvm_init3(elem, fvm, hybrid, nets, nete, irecons_tracer) end if - else - - ! construct global arrays needed when GLL grid used by physics - call gblocks_init() - end if ! write grid and mapping files @@ -286,7 +262,7 @@ subroutine dyn_grid_init() allocate(areaA(ngcols_d)) allocate(clat(ngcols_d),clon(ngcols_d)) - call get_horiz_grid_d(ngcols_d, clat_d_out=clat, clon_d_out=clon, area_d_out=areaA) + call get_horiz_grid_int(ngcols_d, clat_d_out=clat, clon_d_out=clon, area_d_out=areaA) ! Create mapping files using SE basis functions call create_native_mapping_files(par, elem, 'native', ngcols_d, clat, clon, areaa) @@ -299,304 +275,140 @@ subroutine dyn_grid_init() end subroutine dyn_grid_init -!========================================================================================= - -subroutine get_block_bounds_d(block_first, block_last) - - ! Return first and last indices used in global block ordering - - integer, intent(out) :: block_first ! first (global) index used for blocks - integer, intent(out) :: block_last ! last (global) index used for blocks - !---------------------------------------------------------------------------- - - block_first = 1 - block_last = nelem_d +!============================================================================== -end subroutine get_block_bounds_d - -!========================================================================================= - -subroutine get_block_gcol_d(blockid, asize, cdex) - - ! Return list of global column indices in given block - - !------------------------------Arguments-------------------------------- - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: asize ! array size - - integer, intent(out):: cdex(asize) ! global column indices - - integer :: ic - !---------------------------------------------------------------------------- - - if (fv_nphys > 0) then - cdex(1) = (blockid-1)*fv_nphys*fv_nphys + 1 - do ic = 2, asize - cdex(ic) = cdex(1) + ic - 1 - end do - else - - do ic = 1, asize - cdex(ic) = gblocks(blockid)%UniquePtOffset + ic - 1 - end do - end if - -end subroutine get_block_gcol_d - -!========================================================================================= - -integer function get_block_gcol_cnt_d(blockid) - - ! Return number of dynamics columns in indicated block - - integer, intent(in) :: blockid - - integer :: ie - !---------------------------------------------------------------------------- - - if (fv_nphys > 0) then - get_block_gcol_cnt_d = fv_nphys*fv_nphys - else - get_block_gcol_cnt_d = gblocks(blockid)%NumUniqueP - end if - -end function get_block_gcol_cnt_d - -!========================================================================================= - -integer function get_block_lvl_cnt_d(blockid, bcid) - - ! Return number of levels in indicated column. If column - ! includes surface fields, then it is defined to also - ! include level 0. - - use pmgrid, only: plevp - - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: bcid ! column index within block - !----------------------------------------------------------------------- - - get_block_lvl_cnt_d = plevp - -end function get_block_lvl_cnt_d - -!========================================================================================= - -subroutine get_block_levels_d(blockid, bcid, lvlsiz, levels) - - use pmgrid, only: plev - - ! Return level indices in indicated column. If column - ! includes surface fields, then it is defined to also - ! include level 0. - - ! arguments - integer, intent(in) :: blockid ! global block id - integer, intent(in) :: bcid ! column index within block - integer, intent(in) :: lvlsiz ! dimension of levels array - - integer, intent(out) :: levels(lvlsiz) ! levels indices for block - - ! local variables - integer :: k - character(len=128) :: errmsg - !--------------------------------------------------------------------------- - - if (lvlsiz < plev + 1) then - write(errmsg,*) 'levels array not large enough (', lvlsiz,' < ',plev + 1,')' - call endrun('GET_BLOCK_LEVELS_D: '//trim(errmsg)) +subroutine get_dyn_grid_info(hdim1_d, hdim2_d, num_lev, & + index_model_top_layer, index_surface_layer, unstructured, dyn_columns) + !------------------------------------------------------------ + ! + ! get_dyn_grid_info returns physics grid column information + ! + !------------------------------------------------------------ + use shr_const_mod, only: SHR_CONST_PI + use cam_abortutils, only: endrun + use spmd_utils, only: iam + use coordinate_systems_mod, only: spherical_polar_t + ! Dummy arguments + integer, intent(out) :: hdim1_d ! # longitudes or grid size + integer, intent(out) :: hdim2_d ! # latitudes or 1 + integer, intent(out) :: num_lev ! # levels + integer, intent(out) :: index_model_top_layer + integer, intent(out) :: index_surface_layer + logical, intent(out) :: unstructured + ! dyn_columns will contain a copy of the physics column info local to this + ! dynamics task + type(physics_column_t), allocatable, intent(out) :: dyn_columns(:) + ! Local variables + integer :: lindex + integer :: gindex + integer :: elem_ind, col_ind, ii, jj + integer :: num_local_cols + type(spherical_polar_t) :: coord + real(r8) :: dcoord + real(r8), parameter :: radtodeg = 180.0_r8 / SHR_CONST_PI + real(r8), parameter :: degtorad = SHR_CONST_PI / 180.0_r8 + character(len=*), parameter :: subname = 'get_dyn_grid_info' + + unstructured = .true. ! SE is an unstructured dycore + if (fv_nphys > 0) then ! physics uses an FVM grid + num_local_cols = nelemd * fv_nphys * fv_nphys else - do k = 0, plev - levels(k+1) = k - end do - do k = plev+2, lvlsiz - levels(k) = -1 + num_local_cols = 0 + do elem_ind = 1, nelemd + num_local_cols = num_local_cols + elem(elem_ind)%idxP%NumUniquePts end do end if - -end subroutine get_block_levels_d - -!========================================================================================= - -integer function get_gcol_block_cnt_d(gcol) - - ! Return number of blocks containg data for the vertical column with the - ! given global column index. - ! - ! For SE dycore each column is "owned" by a single element, so this routine - ! always returns 1. - - integer, intent(in) :: gcol ! global column index - !---------------------------------------------------------------------------- - - get_gcol_block_cnt_d = 1 - -end function get_gcol_block_cnt_d - -!========================================================================================= - -subroutine get_gcol_block_d(gcol, cnt, blockid, bcid, localblockid) - - use dp_mapping, only: dp_owner - - ! Return global block index and local column index for given global column index. - ! - ! The SE dycore assigns each global column to a singe element. So cnt is assumed - ! to be 1. - - ! arguments - integer, intent(in) :: gcol ! global column index - integer, intent(in) :: cnt ! size of blockid and bcid arrays - - integer, intent(out) :: blockid(cnt) ! block index - integer, intent(out) :: bcid(cnt) ! column index within block - integer, intent(out), optional :: localblockid(cnt) - - ! local variables - integer :: sb, eb, ie, high, low - logical :: found - integer, save :: iedex_save = 1 - character(len=*), parameter :: subname='get_gcol_block_d' - !---------------------------------------------------------------------------- - - if (fv_nphys > 0) then - - blockid(1) = 1 + ((gcol-1) / (fv_nphys*fv_nphys)) - bcid(1) = 1 + mod(gcol-1, fv_nphys*fv_nphys) - - if (present(localblockid)) then - localblockid = -1 - if (iam == dp_owner(blockid(1))) then - if (blockid(1) == elem(iedex_save)%globalid) then - localblockid = iedex_save - else - do ie = 1,nelemd - if (blockid(1) == elem(ie)%globalid) then - localblockid = ie - iedex_save = ie - exit - end if - end do - end if - end if + if (allocated(local_dyn_columns)) then + ! Check for correct number of columns + if (size(local_dyn_columns) /= num_local_cols) then + call endrun(subname//': called with inconsistent column numbers') end if - else - - found = .false. - low = 1 - high = nelem_d - - ! check whether previous found element is the same here - if (.not. found) then - ie = iedex_save - sb = gblocks(ie)%UniquePtOffset - if (gcol >= sb) then - eb = sb + gblocks(ie)%NumUniqueP - if (gcol < eb) then - found = .true. - else - low = ie - endif - else - high = ie - endif - endif - - ! check whether next element is the one wanted - if ((.not. found) .and. & - ((low .eq. iedex_save) .or. (iedex_save .eq. nelem_d))) then - ie = iedex_save + 1 - if (ie > nelem_d) ie = 1 - - sb = gblocks(ie)%UniquePtOffset - if (gcol >= sb) then - eb = sb + gblocks(ie)%NumUniqueP - if (gcol < eb) then - found = .true. - else - low = ie - endif + allocate(local_dyn_columns(num_local_cols)) + if (fv_nphys > 0) then ! physics uses an FVM grid + hdim1_d = nelem * fv_nphys * fv_nphys + else + hdim1_d = ngcols_d + end if + hdim2_d = 1 + num_lev = nlev + index_model_top_layer = 1 + index_surface_layer = nlev + lindex = 0 + do elem_ind = 1, nelemd + if (fv_nphys > 0) then ! physics uses an FVM grid + do col_ind = 0, (fv_nphys * fv_nphys) - 1 + lindex = lindex + 1 + ii = MOD(col_ind, fv_nphys) + 1 + jj = (col_ind / fv_nphys) + 1 + coord = fvm(elem_ind)%center_cart_physgrid(ii, jj) + local_dyn_columns(lindex)%lat_rad = coord%lat + dcoord = local_dyn_columns(lindex)%lat_rad * radtodeg + local_dyn_columns(lindex)%lat_deg = dcoord + local_dyn_columns(lindex)%lon_rad = coord%lon + dcoord = local_dyn_columns(lindex)%lon_rad * radtodeg + local_dyn_columns(lindex)%lon_deg = dcoord + local_dyn_columns(lindex)%area = & + fvm(elem_ind)%area_sphere_physgrid(ii,jj) + local_dyn_columns(lindex)%weight = & + local_dyn_columns(lindex)%area + ! File decomposition + gindex = ((elem(elem_ind)%GlobalId-1) * fv_nphys * fv_nphys) + & + col_ind + 1 + local_dyn_columns(lindex)%global_col_num = gindex + ! Note, coord_indices not used for unstructured dycores + ! Dynamics decomposition + local_dyn_columns(lindex)%dyn_task = iam + local_dyn_columns(lindex)%local_dyn_block = elem_ind + local_dyn_columns(lindex)%global_dyn_block = & + elem(elem_ind)%GlobalId + allocate(local_dyn_columns(lindex)%dyn_block_index(1)) + local_dyn_columns(lindex)%dyn_block_index(1) = col_ind + 1 + end do else - high = ie - endif - endif - - ! otherwise, use a binary search to find element - if (.not. found) then - ! (start with a sanity check) - ie = low - sb = gblocks(ie)%UniquePtOffset - - ie = high - eb = gblocks(ie)%UniquePtOffset + gblocks(ie)%NumUniqueP - - if ((gcol < sb) .or. (gcol >= eb)) then - do ie=1,nelemd - write(iulog,*) __LINE__,ie,elem(ie)%idxP%UniquePtOffset,elem(ie)%idxP%NumUniquePts + do col_ind = 1, elem(elem_ind)%idxP%NumUniquePts + lindex = lindex + 1 + ii = elem(elem_ind)%idxP%ia(col_ind) + jj = elem(elem_ind)%idxP%ja(col_ind) + + dcoord = elem(elem_ind)%spherep(ii,jj)%lat + local_dyn_columns(lindex)%lat_rad = dcoord + dcoord = local_dyn_columns(lindex)%lat_rad * radtodeg + local_dyn_columns(lindex)%lat_deg = dcoord + dcoord = elem(elem_ind)%spherep(ii,jj)%lon + local_dyn_columns(lindex)%lon_rad = dcoord + dcoord = local_dyn_columns(lindex)%lon_rad * radtodeg + local_dyn_columns(lindex)%lon_deg = dcoord + local_dyn_columns(lindex)%area = & + 1.0_r8 / elem(elem_ind)%rspheremp(ii,jj) + local_dyn_columns(lindex)%weight = local_dyn_columns(lindex)%area + ! File decomposition + gindex = elem(elem_ind)%idxP%UniquePtoffset + col_ind - 1 + local_dyn_columns(lindex)%global_col_num = gindex + ! Note, coord_indices not used for unstructured dycores + ! Dynamics decomposition + local_dyn_columns(lindex)%dyn_task = iam + local_dyn_columns(lindex)%local_dyn_block = elem_ind + local_dyn_columns(lindex)%global_dyn_block = & + elem(elem_ind)%GlobalId + allocate(local_dyn_columns(lindex)%dyn_block_index(1)) + local_dyn_columns(lindex)%dyn_block_index(1) = col_ind end do - call endrun(subname//': binary search to find element') end if - - do while (.not. found) - - ie = low + (high-low)/2; - sb = gblocks(ie)%UniquePtOffset - if (gcol >= sb) then - eb = sb + gblocks(ie)%NumUniqueP - if (gcol < eb) then - found = .true. - else - low = ie+1 - end if - else - high = ie-1 - end if - end do - end if - - blockid(1) = ie - bcid(1) = gcol - sb + 1 - iedex_save = ie - - if (present(localblockid)) localblockid(1) = gblocks(ie)%LocalID - + end do end if - -end subroutine get_gcol_block_d - -!========================================================================================= - -integer function get_block_owner_d(blockid) - - ! Return id of processor that "owns" the indicated block - - use dp_mapping, only: dp_owner - - integer, intent(in) :: blockid ! global block id - - character(len=*), parameter :: name = 'get_block_owner_d' - !---------------------------------------------------------------------------- - - if (fv_nphys > 0) then - if (dp_owner(blockid) > -1) then - get_block_owner_d = dp_owner(blockid) - else - call endrun(name//': Block owner not assigned in gblocks_init') - end if - - else - - if (gblocks(blockid)%Owner > -1) then - get_block_owner_d = gblocks(blockid)%Owner - else - call endrun(name//': Block owner not assigned in gblocks_init') - end if + ! Copy the information to the output array + if (allocated(dyn_columns)) then + deallocate(dyn_columns) end if + allocate(dyn_columns(lindex)) + do lindex = 1, num_local_cols + dyn_columns(lindex) = local_dyn_columns(lindex) + end do -end function get_block_owner_d + end subroutine get_dyn_grid_info -!========================================================================================= +!============================================================================== subroutine get_horiz_grid_dim_d(hdim1_d,hdim2_d) @@ -622,8 +434,8 @@ end subroutine get_horiz_grid_dim_d !========================================================================================= -subroutine get_horiz_grid_d(nxy, clat_d_out, clon_d_out, area_d_out, & - wght_d_out, lat_d_out, lon_d_out) +subroutine get_horiz_grid_int(nxy, clat_d_out, clon_d_out, area_d_out, & + wght_d_out, lat_d_out, lon_d_out) ! Return global arrays of latitude and longitude (in radians), column ! surface area (in radians squared) and surface integration weights for @@ -643,8 +455,8 @@ subroutine get_horiz_grid_d(nxy, clat_d_out, clon_d_out, area_d_out, & ! local variables real(r8), pointer :: area_d(:) real(r8), pointer :: temp(:) - character(len=256) :: errormsg - character(len=*), parameter :: sub = 'get_horiz_grid_d' + character(len=SHR_KIND_CL) :: errormsg + character(len=*), parameter :: sub = 'get_horiz_grid_int' !---------------------------------------------------------------------------- ! check that nxy is set to correct size for global arrays @@ -712,7 +524,7 @@ subroutine get_horiz_grid_d(nxy, clat_d_out, clon_d_out, area_d_out, & end if -end subroutine get_horiz_grid_d +end subroutine get_horiz_grid_int !========================================================================================= @@ -734,45 +546,21 @@ subroutine physgrid_copy_attributes_d(gridname, grid_attribute_names) grid_attribute_names(2) = 'ne' else gridname = 'GLL' - allocate(grid_attribute_names(3)) - ! For standard CAM-SE, we need to copy the area attribute. - ! For physgrid, the physics grid will create area (GLL has area_d) - grid_attribute_names(1) = 'area' - grid_attribute_names(2) = 'np' - grid_attribute_names(3) = 'ne' + allocate(grid_attribute_names(2)) + grid_attribute_names(1) = 'np' + grid_attribute_names(2) = 'ne' end if end subroutine physgrid_copy_attributes_d !========================================================================================= -function get_dyn_grid_parm_real1d(name) result(rval) - - ! This routine is not used for SE, but still needed as a dummy interface to satisfy - ! references from mo_synoz.F90 and phys_gmean.F90 - - character(len=*), intent(in) :: name - real(r8), pointer :: rval(:) - - if(name.eq.'w') then - call endrun('get_dyn_grid_parm_real1d: w not defined') - else if(name.eq.'clat') then - call endrun('get_dyn_grid_parm_real1d: clat not supported, use get_horiz_grid_d') - else if(name.eq.'latdeg') then - call endrun('get_dyn_grid_parm_real1d: latdeg not defined') - else - nullify(rval) - end if -end function get_dyn_grid_parm_real1d - -!========================================================================================= - integer function get_dyn_grid_parm(name) result(ival) ! This function is in the process of being deprecated, but is still needed ! as a dummy interface to satisfy external references from some chemistry routines. - use pmgrid, only: plat, plon, plev, plevp + use pmgrid, only: plat, plev character(len=*), intent(in) :: name !---------------------------------------------------------------------------- @@ -810,31 +598,12 @@ subroutine dyn_grid_get_colndx(igcol, ncols, owners, col, lbk) integer, intent(out) :: col(ncols) integer, intent(out) :: lbk(ncols) - integer :: i, j, k, ii - integer :: blockid(1), bcid(1), lclblockid(1) !---------------------------------------------------------------------------- - if (fv_nphys > 0) then - call endrun('dyn_grid_get_colndx: not implemented for the FVM physics grid') - end if - - do i = 1, ncols - - call get_gcol_block_d(igcol(i), 1, blockid, bcid, lclblockid) - owners(i) = get_block_owner_d(blockid(1)) - - if (owners(i) == iam) then - lbk(i) = lclblockid(1) - ii = igcol(i) - elem(lbk(i))%idxp%UniquePtoffset + 1 - k = elem(lbk(i))%idxp%ia(ii) - j = elem(lbk(i))%idxp%ja(ii) - col(i) = k + (j - 1)*np - else - lbk(i) = -1 - col(i) = -1 - end if - - end do + owners = (igcol * 0) -1 ! Kill compiler warnings + col = -1 ! Kill compiler warnings + lbk = -1 ! Kill compiler warnings + call endrun('dyn_grid_get_colndx: not implemented for unstructured grids') end subroutine dyn_grid_get_colndx @@ -890,16 +659,19 @@ end subroutine dyn_grid_get_elem_coords ! Private routines. !========================================================================================= -subroutine get_hdim_name(fh_ini, ini_grid_hdim_name) +subroutine get_hdim_name(fh_ptr, grid_hdim_name) + use pio, only: pio_inq_dimid, pio_seterrorhandling + use pio, only: PIO_BCAST_ERROR, PIO_NOERR - ! Determine whether the initial file uses 'ncol' or 'ncol_d' as the horizontal - ! dimension in the unstructured grid. It is also possible when using analytic - ! initial conditions that the initial file only contains vertical coordinates. + ! Determine whether the supplied file uses 'ncol' or 'ncol_d' horizontal + ! dimension in the unstructured grid. It is also possible when using + ! analytic initial conditions that the file only contains + ! vertical coordinates. ! Return 'none' if that is the case. - ! arguments - type(file_desc_t), pointer :: fh_ini - character(len=6), intent(out) :: ini_grid_hdim_name ! horizontal dimension name + ! Arguments + type(file_desc_t), pointer :: fh_ptr + character(len=6), intent(out) :: grid_hdim_name ! horizontal dimension name ! local variables integer :: ierr, pio_errtype @@ -909,38 +681,36 @@ subroutine get_hdim_name(fh_ini, ini_grid_hdim_name) !---------------------------------------------------------------------------- ! Set PIO to return error flags. - call pio_seterrorhandling(fh_ini, PIO_BCAST_ERROR, pio_errtype) + call pio_seterrorhandling(fh_ptr, PIO_BCAST_ERROR, pio_errtype) - ! Check for ncol_d first just in case the initial file also contains fields on + ! Check for ncol_d first just in case the file also contains fields on ! the physics grid. - ierr = pio_inq_dimid(fh_ini, 'ncol_d', ncol_did) + ierr = pio_inq_dimid(fh_ptr, 'ncol_d', ncol_did) if (ierr == PIO_NOERR) then - ini_grid_hdim_name = 'ncol_d' + grid_hdim_name = 'ncol_d' else ! if 'ncol_d' not in file, check for 'ncol' - ierr = pio_inq_dimid(fh_ini, 'ncol', ncol_did) + ierr = pio_inq_dimid(fh_ptr, 'ncol', ncol_did) if (ierr == PIO_NOERR) then - ini_grid_hdim_name = 'ncol' + grid_hdim_name = 'ncol' else - ini_grid_hdim_name = 'none' + grid_hdim_name = 'none' end if end if ! Return PIO to previous error handling. - call pio_seterrorhandling(fh_ini, pio_errtype) + call pio_seterrorhandling(fh_ptr, pio_errtype) end subroutine get_hdim_name -!========================================================================================= - subroutine define_cam_grids() ! Create grid objects on the dynamics decomposition for grids used by @@ -962,8 +732,9 @@ 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 spmd_utils, only: MPI_MAX, MPI_INTEGER, mpicom - + use dimensions_mod, only: nc + 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 @@ -971,25 +742,46 @@ 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) - real(r8), pointer :: pearea(:) => null() ! pe-local areas - real(r8) :: areaw(np,np) + real(r8), pointer :: pearea(:) ! pe-local areas + 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(:) real(r8), pointer :: fvm_area(:) + real(r8), pointer :: fvm_areawt(:) integer(iMap), pointer :: fvm_map(:) integer :: ncols_physgrid, ngcols_physgrid real(r8), allocatable :: physgrid_coord(:) real(r8), pointer :: physgrid_area(:) + real(r8), pointer :: physgrid_areawt(:) integer(iMap), pointer :: physgrid_map(:) + + real(r8), parameter :: rarea_unit_sphere = 1.0_r8 / (4.0_r8*PI) + !---------------------------------------------------------------------------- + !----------------------- + ! initialize pointers to null + !----------------------- + nullify(pearea_wt) + nullify(pearea) + nullify(fvm_area) + nullify(fvm_areawt) + nullify(fvm_map) + nullify(physgrid_area) + nullify(physgrid_areawt) + nullify(physgrid_map) + nullify(grid_map) + !----------------------- ! Create GLL grid object !----------------------- @@ -1007,16 +799,17 @@ subroutine define_cam_grids() allocate(pelat_deg(np*np*nelemd)) allocate(pelon_deg(np*np*nelemd)) allocate(pearea(np*np*nelemd)) + allocate(pearea_wt(np*np*nelemd)) allocate(pemap(np*np*nelemd)) pemap = 0_iMap ii = 1 do ie = 1, nelemd - areaw = 1.0_r8 / elem(ie)%rspheremp(:,:) - pearea(ii:ii+npsq-1) = reshape(areaw, (/ np*np /)) pemap(ii:ii+npsq-1) = fdofp_local(:,ie) do j = 1, np do i = 1, np + pearea(ii) = elem(ie)%mp(i,j)*elem(ie)%metdet(i,j) + pearea_wt(ii) = pearea(ii)*rarea_unit_sphere pelat_deg(ii) = elem(ie)%spherep(i,j)%lat * rad2deg pelon_deg(ii) = elem(ie)%spherep(i,j)%lon * rad2deg ii = ii + 1 @@ -1028,7 +821,7 @@ subroutine define_cam_grids() ! '_d' suffixes and the physics grid will use the unadorned names. ! This allows fields on both the GLL and physics grids to be written to history ! output files. - if (fv_nphys > 0) then + if (trim(ini_grid_hdim_name) == 'ncol_d') then latname = 'lat_d' lonname = 'lon_d' ncolname = 'ncol_d' @@ -1039,9 +832,9 @@ subroutine define_cam_grids() ncolname = 'ncol' areaname = 'area' end if - lat_coord => horiz_coord_create(trim(latname), trim(ncolname), ngcols_d, & + lat_coord => horiz_coord_create('lat_d', 'ncol_d', ngcols_d, & 'latitude', 'degrees_north', 1, size(pelat_deg), pelat_deg, map=pemap) - lon_coord => horiz_coord_create(trim(lonname), trim(ncolname), ngcols_d, & + lon_coord => horiz_coord_create('lon_d', 'ncol_d', ngcols_d, & 'longitude', 'degrees_east', 1, size(pelon_deg), pelon_deg, map=pemap) ! Map for GLL grid @@ -1060,23 +853,27 @@ subroutine define_cam_grids() ! The native SE GLL grid call cam_grid_register('GLL', dyn_decomp, lat_coord, lon_coord, & grid_map, block_indexed=.false., unstruct=.true.) - call cam_grid_attribute_register('GLL', trim(areaname), 'gll grid areas', & - trim(ncolname), pearea, map=pemap) + call cam_grid_attribute_register('GLL', 'area_d', 'gll grid areas', & + 'ncol_d', pearea, map=pemap) + call cam_grid_attribute_register('GLL', 'area_weight_gll', 'gll grid area weights', & + 'ncol_d', pearea_wt, map=pemap) call cam_grid_attribute_register('GLL', 'np', '', np) call cam_grid_attribute_register('GLL', 'ne', '', ne) - ! With CSLAM if the initial file uses the horizontal dimension 'ncol' rather than - ! 'ncol_d' then we need a grid object with the names ncol,lat,lon to read it. - ! Create that grid object here if it's needed. - if (fv_nphys > 0 .and. ini_grid_hdim_name == 'ncol') then - + ! 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, & 'longitude', 'degrees_east', 1, size(pelon_deg), pelon_deg, map=pemap) - call cam_grid_register('INI', ini_decomp, lat_coord, lon_coord, & + call cam_grid_register('INI', ini_decomp, lat_coord, lon_coord, & grid_map, block_indexed=.false., unstruct=.true.) + call cam_grid_attribute_register('INI', 'area', 'ini grid areas', & + 'ncol', pearea, map=pemap) + call cam_grid_attribute_register('INI', 'area_weight_ini', 'ini grid area weights', & + 'ncol', pearea_wt, map=pemap) ini_grid_name = 'INI' else @@ -1094,22 +891,60 @@ subroutine define_cam_grids() ! to that memory. It can be nullified since the attribute object has ! the reference. nullify(pearea) + nullify(pearea_wt) ! grid_map cannot be deallocated as the cam_filemap_t object just points ! 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 !--------------------------------- - if (ntrac > 0) then + if (use_cslam) then ncols_fvm = nc * nc * nelemd ngcols_fvm = nc * nc * nelem_d allocate(fvm_coord(ncols_fvm)) allocate(fvm_map(ncols_fvm)) allocate(fvm_area(ncols_fvm)) + allocate(fvm_areawt(ncols_fvm)) do ie = 1, nelemd k = 1 @@ -1119,6 +954,7 @@ subroutine define_cam_grids() fvm_coord(mapind) = fvm(ie)%center_cart(i,j)%lon*rad2deg fvm_map(mapind) = k + ((elem(ie)%GlobalId-1) * nc * nc) fvm_area(mapind) = fvm(ie)%area_sphere(i,j) + fvm_areawt(mapind) = fvm_area(mapind)*rarea_unit_sphere k = k + 1 end do end do @@ -1159,12 +995,15 @@ subroutine define_cam_grids() grid_map, block_indexed=.false., unstruct=.true.) call cam_grid_attribute_register('FVM', 'area_fvm', 'fvm grid areas', & 'ncol_fvm', fvm_area, map=fvm_map) + call cam_grid_attribute_register('FVM', 'area_weight_fvm', 'fvm grid area weights', & + 'ncol_fvm', fvm_areawt, map=fvm_map) call cam_grid_attribute_register('FVM', 'nc', '', nc) call cam_grid_attribute_register('FVM', 'ne', '', ne) deallocate(fvm_coord) deallocate(fvm_map) nullify(fvm_area) + nullify(fvm_areawt) nullify(grid_map) end if @@ -1180,6 +1019,7 @@ subroutine define_cam_grids() allocate(physgrid_coord(ncols_physgrid)) allocate(physgrid_map(ncols_physgrid)) allocate(physgrid_area(ncols_physgrid)) + allocate(physgrid_areawt(ncols_physgrid)) do ie = 1, nelemd k = 1 @@ -1189,6 +1029,7 @@ subroutine define_cam_grids() physgrid_coord(mapind) = fvm(ie)%center_cart_physgrid(i,j)%lon*rad2deg physgrid_map(mapind) = k + ((elem(ie)%GlobalId-1) * fv_nphys * fv_nphys) physgrid_area(mapind) = fvm(ie)%area_sphere_physgrid(i,j) + physgrid_areawt(mapind) = physgrid_area(mapind)*rarea_unit_sphere k = k + 1 end do end do @@ -1229,12 +1070,15 @@ subroutine define_cam_grids() grid_map, block_indexed=.false., unstruct=.true.) call cam_grid_attribute_register('physgrid_d', 'area_physgrid', 'physics grid areas', & 'ncol', physgrid_area, map=physgrid_map) + call cam_grid_attribute_register('physgrid_d', 'area_weight_physgrid', 'physics grid area weight', & + 'ncol', physgrid_areawt, map=physgrid_map) call cam_grid_attribute_register('physgrid_d', 'fv_nphys', '', fv_nphys) call cam_grid_attribute_register('physgrid_d', 'ne', '', ne) deallocate(physgrid_coord) deallocate(physgrid_map) nullify(physgrid_area) + nullify(physgrid_areawt) nullify(grid_map) end if @@ -1310,72 +1154,8 @@ end subroutine write_grid_mapping !========================================================================================= -subroutine gblocks_init() - - ! construct global array of type block_global_data objects for GLL grid - - integer :: ie, p - integer :: ibuf - integer :: ierr - integer :: rdispls(npes), recvcounts(npes), gid(npes), lid(npes) - !---------------------------------------------------------------------------- - - if (.not. allocated(gblocks)) then - if (masterproc) then - write(iulog, *) 'INFO: Non-scalable action: Allocating global blocks in SE dycore.' - end if - allocate(gblocks(nelem_d)) - do ie = 1, nelem_d - gblocks(ie)%Owner = -1 - gblocks(ie)%UniquePtOffset = -1 - gblocks(ie)%NumUniqueP = -1 - gblocks(ie)%LocalID = -1 - end do - end if - - ! nelemdmax is the maximum number of elements in a dynamics task - ! nelemd is the actual number of elements in a dynamics task - - do ie = 1, nelemdmax - - if (ie <= nelemd) then - rdispls(iam+1) = elem(ie)%idxP%UniquePtOffset - 1 - gid(iam+1) = elem(ie)%GlobalID - lid(iam+1) = ie - recvcounts(iam+1) = elem(ie)%idxP%NumUniquePts - else - rdispls(iam+1) = 0 - recvcounts(iam+1) = 0 - gid(iam+1) = 0 - endif - - ibuf = lid(iam+1) - call mpi_allgather(ibuf, 1, mpi_integer, lid, 1, mpi_integer, mpicom, ierr) - - ibuf = gid(iam+1) - call mpi_allgather(ibuf, 1, mpi_integer, gid, 1, mpi_integer, mpicom, ierr) - - ibuf = rdispls(iam+1) - call mpi_allgather(ibuf, 1, mpi_integer, rdispls, 1, mpi_integer, mpicom, ierr) - - ibuf = recvcounts(iam+1) - call mpi_allgather(ibuf, 1, mpi_integer, recvcounts, 1, mpi_integer, mpicom, ierr) - - do p = 1, npes - if (gid(p) > 0) then - gblocks(gid(p))%UniquePtOffset = rdispls(p) + 1 - gblocks(gid(p))%NumUniqueP = recvcounts(p) - gblocks(gid(p))%LocalID = lid(p) - gblocks(gid(p))%Owner = p - 1 - end if - end do - end do - -end subroutine gblocks_init - -!========================================================================================= - subroutine create_global_area(area_d) + use dp_mapping, only: dp_reorder, dp_allocate, dp_deallocate ! Gather global array of column areas for the physics grid, ! reorder to global column order, then broadcast it to all tasks. @@ -1401,7 +1181,7 @@ subroutine create_global_area(area_d) if (fv_nphys > 0) then ! physics uses an FVM grid ! first gather all data onto masterproc, in mpi task order (via - ! mpi_gatherv) then redorder into globalID order (via dp_reoorder) + ! mpi_gatherv) then redorder into globalID order (via dp_reorder) ncol = fv_nphys*fv_nphys*nelem_d allocate(rbuf(ncol)) allocate(dp_area(fv_nphys*fv_nphys,nelem_d)) @@ -1435,7 +1215,9 @@ subroutine create_global_area(area_d) recvcounts, rdispls, mpi_real8, mstrid, mpicom, ierr) ! Reorder to global order - if (masterproc) call dp_reoorder(rbuf, area_d) + call dp_allocate(elem) + if (masterproc) call dp_reorder(rbuf, area_d) + call dp_deallocate() ! Send everyone else the data call mpi_bcast(area_d, ncol, mpi_real8, mstrid, mpicom, ierr) @@ -1482,6 +1264,7 @@ end subroutine create_global_area !========================================================================================= subroutine create_global_coords(clat, clon, lat_out, lon_out) + use dp_mapping, only: dp_reorder, dp_allocate, dp_deallocate ! Gather global arrays of column coordinates for the physics grid, ! reorder to global column order, then broadcast to all tasks. @@ -1518,7 +1301,7 @@ subroutine create_global_coords(clat, clon, lat_out, lon_out) if (fv_nphys > 0) then ! physics uses an FVM grid ! first gather all data onto masterproc, in mpi task order (via - ! mpi_gatherv) then redorder into globalID order (via dp_reoorder) + ! mpi_gatherv) then redorder into globalID order (via dp_reorder) ncol = fv_nphys*fv_nphys*nelem_d allocate(rbuf(ncol)) @@ -1556,7 +1339,8 @@ subroutine create_global_coords(clat, clon, lat_out, lon_out) recvcounts, rdispls, mpi_real8, mstrid, mpicom, ierr) ! Reorder to global order - if (masterproc) call dp_reoorder(rbuf, clat) + call dp_allocate(elem) + if (masterproc) call dp_reorder(rbuf, clat) ! Send everyone else the data call mpi_bcast(clat, ncol, mpi_real8, mstrid, mpicom, ierr) @@ -1566,7 +1350,8 @@ subroutine create_global_coords(clat, clon, lat_out, lon_out) recvcounts, rdispls, mpi_real8, mstrid, mpicom, ierr) ! Reorder to global order - if (masterproc) call dp_reoorder(rbuf, clon) + if (masterproc) call dp_reorder(rbuf, clon) + call dp_deallocate() ! Send everyone else the data call mpi_bcast(clon, ncol, mpi_real8, mstrid, mpicom, ierr) @@ -1646,6 +1431,55 @@ subroutine create_global_coords(clat, clon, lat_out, lon_out) end subroutine create_global_coords -!========================================================================================= +!============================================================================= +!== +!!!!!! DUMMY INTERFACE TO TEST WEAK SCALING FIX, THIS SHOULD GO AWAY +!== +!============================================================================= + +subroutine get_horiz_grid_d(nxy, clat_d_out, clon_d_out, area_d_out, & + wght_d_out, lat_d_out, lon_d_out) + + ! Return global arrays of latitude and longitude (in radians), column + ! surface area (in radians squared) and surface integration weights for + ! global column indices that will be passed to/from physics + + ! arguments + integer, intent(in) :: nxy ! array sizes + + real(r8), intent(out), optional :: clat_d_out(:) ! column latitudes + real(r8), intent(out), optional :: clon_d_out(:) ! column longitudes + real(r8), intent(out), target, optional :: area_d_out(:) ! column surface + + real(r8), intent(out), target, optional :: wght_d_out(:) ! column integration weight + real(r8), intent(out), optional :: lat_d_out(:) ! column degree latitudes + real(r8), intent(out), optional :: lon_d_out(:) ! column degree longitudes + character(len=*), parameter :: subname = 'get_horiz_grid_d' + + call endrun(subname//': NOT SUPPORTED WITH WEAK SCALING FIX') +end subroutine get_horiz_grid_d + +!============================================================================== + +function get_dyn_grid_parm_real1d(name) result(rval) + + ! This routine is not used for SE, but still needed as a dummy interface to satisfy + ! references from mo_synoz.F90 + + character(len=*), intent(in) :: name + real(r8), pointer :: rval(:) + + if(name.eq.'w') then + call endrun('get_dyn_grid_parm_real1d: w not defined') + else if(name.eq.'clat') then + call endrun('get_dyn_grid_parm_real1d: clat not supported') + else if(name.eq.'latdeg') then + call endrun('get_dyn_grid_parm_real1d: latdeg not defined') + else + nullify(rval) + end if +end function get_dyn_grid_parm_real1d + +!============================================================================== end module dyn_grid diff --git a/src/dynamics/se/gravity_waves_sources.F90 b/src/dynamics/se/gravity_waves_sources.F90 index 8b0814e90f..abdbaf1315 100644 --- a/src/dynamics/se/gravity_waves_sources.F90 +++ b/src/dynamics/se/gravity_waves_sources.F90 @@ -16,10 +16,12 @@ module gravity_waves_sources !! for use by WACCM (via dp_coupling) public :: gws_src_fnct + public :: gws_src_vort public :: gws_init private :: compute_frontogenesis + private :: compute_vorticity_4gw - type (EdgeBuffer_t) :: edge3 + type (EdgeBuffer_t) :: edge3,edge1 type (derivative_t) :: deriv real(r8) :: psurf_ref @@ -40,42 +42,52 @@ subroutine gws_init(elem) ! Set up variables similar to dyn_comp and prim_driver_mod initializations call initEdgeBuffer(par, edge3, elem, 3*nlev,nthreads=1) + call initEdgeBuffer(par, edge1, elem, nlev,nthreads=1) psurf_ref = hypi(plev+1) end subroutine gws_init - subroutine gws_src_fnct(elem, tl, tlq, frontgf, frontga,nphys) + subroutine gws_src_fnct(elem, tl, tlq, frontgf, frontga, nphys) use derivative_mod, only : derivinit - use dimensions_mod, only : npsq, nelemd + use dimensions_mod, only : nelemd use dof_mod, only : UniquePoints use hybrid_mod, only : config_thread_region, get_loop_ranges use parallel_mod, only : par use ppgrid, only : pver use thread_mod, only : horz_num_threads use dimensions_mod, only : fv_nphys + use cam_abortutils, only : handle_allocate_error + implicit none type (element_t), intent(inout), dimension(:) :: elem integer, intent(in) :: tl, nphys, tlq real (kind=r8), intent(out) :: frontgf(nphys*nphys,pver,nelemd) real (kind=r8), intent(out) :: frontga(nphys*nphys,pver,nelemd) + ! Local variables type (hybrid_t) :: hybrid - integer :: nets, nete, ithr, ncols, ie + integer :: nets, nete, ithr, ncols, ie, ierr real(kind=r8), allocatable :: frontgf_thr(:,:,:,:) real(kind=r8), allocatable :: frontga_thr(:,:,:,:) + ! This does not need to be a thread private data-structure call derivinit(deriv) !!$OMP PARALLEL NUM_THREADS(horz_num_threads), DEFAULT(SHARED), PRIVATE(nets,nete,hybrid,ie,ncols,frontgf_thr,frontga_thr) -! hybrid = config_thread_region(par,'horizontal') hybrid = config_thread_region(par,'serial') 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(frontgf_thr(nphys,nphys,nlev,nets:nete), stat=ierr) + call handle_allocate_error(ierr, 'gws_src_fnct', 'frontgf_thr') + + allocate(frontga_thr(nphys,nphys,nlev,nets:nete), stat=ierr) + call handle_allocate_error(ierr, 'gws_src_fnct', 'frontga_thr') + + call compute_frontogenesis(frontgf_thr,frontga_thr,tl,tlq,elem,deriv,hybrid,nets,nete,nphys) + if (fv_nphys>0) then do ie=nets,nete frontgf(:,:,ie) = RESHAPE(frontgf_thr(:,:,:,ie),(/nphys*nphys,nlev/)) @@ -90,10 +102,137 @@ subroutine gws_src_fnct(elem, tl, tlq, frontgf, frontga,nphys) end if deallocate(frontga_thr) deallocate(frontgf_thr) + !!$OMP END PARALLEL end subroutine gws_src_fnct + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine gws_src_vort(elem, tl, tlq, vort4gw, nphys) + use derivative_mod, only : derivinit + use dimensions_mod, only : nelemd + use dof_mod, only : UniquePoints + use hybrid_mod, only : config_thread_region, get_loop_ranges + use parallel_mod, only : par + use ppgrid, only : pver + use thread_mod, only : horz_num_threads + use dimensions_mod, only : fv_nphys + use cam_abortutils, only : handle_allocate_error + + implicit none + type (element_t), intent(in), dimension(:) :: elem + integer, intent(in) :: tl, nphys, tlq + + ! + real (kind=r8), intent(out) :: vort4gw(nphys*nphys,pver,nelemd) + + ! Local variables + type (hybrid_t) :: hybrid + integer :: nets, nete, ithr, ncols, ie, ierr + + ! + real(kind=r8), allocatable :: vort4gw_thr(:,:,:,:) + + ! This does not need to be a thread private data-structure + call derivinit(deriv) + !!$OMP PARALLEL NUM_THREADS(horz_num_threads), DEFAULT(SHARED), PRIVATE(nets,nete,hybrid,ie,ncols,vort4gw_thr) + hybrid = config_thread_region(par,'serial') + call get_loop_ranges(hybrid,ibeg=nets,iend=nete) + + allocate(vort4gw_thr(nphys,nphys,nlev,nets:nete), stat=ierr) + call handle_allocate_error(ierr, 'gws_src_vort', 'vort4gw_thr') + + call compute_vorticity_4gw(vort4gw_thr,tl,tlq,elem,deriv,hybrid,nets,nete,nphys) + + if (fv_nphys>0) then + do ie=nets,nete + vort4gw(:,:,ie) = RESHAPE(vort4gw_thr(:,:,:,ie),(/nphys*nphys,nlev/)) + end do + else + do ie=nets,nete + ncols = elem(ie)%idxP%NumUniquePts + call UniquePoints(elem(ie)%idxP, nlev, vort4gw_thr(:,:,:,ie), vort4gw(1:ncols,:,ie)) + end do + end if + deallocate(vort4gw_thr) + + !!$OMP END PARALLEL + + end subroutine gws_src_vort + + subroutine compute_vorticity_4gw(vort4gw,tl,tlq,elem,ederiv,hybrid,nets,nete,nphys) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! compute vorticity for use in gw params + ! F = ( curl ) [U,V] + ! + ! Original by Peter Lauritzen, Julio Bacmeister*, Dec 2024 + ! Patterned on 'compute_frontogenesis' + ! + ! * corresponding/blame-able + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + use derivative_mod, only: vorticity_sphere + use edge_mod, only: edgevpack, edgevunpack + use bndry_mod, only: bndry_exchange + use dimensions_mod, only: fv_nphys + use fvm_mapping, only: dyn2phys + + type(hybrid_t), intent(in) :: hybrid + type(element_t), intent(in) :: elem(:) + type(derivative_t), intent(in) :: ederiv + integer, intent(in) :: nets,nete,nphys + integer, intent(in) :: tl,tlq + real(r8), intent(out) :: vort4gw(nphys,nphys,nlev,nets:nete) + + ! local + real(r8) :: area_inv(fv_nphys,fv_nphys), tmp(np,np) + real(r8) :: vort_gll(np,np,nlev,nets:nete) + integer :: k,kptr,i,j,ie,component,h,nq,m_cnst,n0 + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! First calculate vorticity on GLL grid + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! set timelevel=1 fro velocities + n0=tl + do ie=nets,nete + do k=1,nlev + call vorticity_sphere(elem(ie)%state%v(:,:,:,k,n0),ederiv,elem(ie),vort_gll(:,:,k,ie)) + end do + do k=1,nlev + vort_gll(:,:,k,ie) = vort_gll(:,:,k,ie)*elem(ie)%spheremp(:,:) + end do + ! pack + call edgeVpack(edge1, vort_gll(:,:,:,ie),nlev,0,ie) + enddo + call bndry_exchange(hybrid,edge1,location='compute_vorticity_4gw') + do ie=nets,nete + call edgeVunpack(edge1, vort_gll(:,:,:,ie),nlev,0,ie) + ! apply inverse mass matrix, + do k=1,nlev + vort_gll(:,:,k,ie) = vort_gll(:,:,k,ie)*elem(ie)%rspheremp(:,:) + end do + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Now regrid from GLL to PhysGrid if necessary + ! otherwise just return vorticity on GLL grid + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (fv_nphys>0) then + tmp = 1.0_r8 + area_inv = dyn2phys(tmp,elem(ie)%metdet) + area_inv = 1.0_r8/area_inv + do k=1,nlev + vort4gw(:,:,k,ie) = dyn2phys( vort_gll(:,:,k,ie) , elem(ie)%metdet , area_inv ) + end do + else + do k=1,nlev + vort4gw(:,:,k,ie) = vort_gll(:,:,k,ie) + end do + end if + enddo + + + end subroutine compute_vorticity_4gw + + subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets,nete,nphys) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! compute frontogenesis function F @@ -109,15 +248,16 @@ subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets, ! to prevent repeated allocation/initialization ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - use physconst, only: cappa, dry_air_species_num,thermodynamic_active_species_num - use physconst, only: thermodynamic_active_species_idx_dycore + 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 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 @@ -140,7 +280,7 @@ subroutine compute_frontogenesis(frontgf,frontga,tl,tlq,elem,ederiv,hybrid,nets, do ie=nets,nete ! pressure at model top - pint(:,:) = hvcoord%hyai(1) + pint(:,:) = hvcoord%hyai(1)*hvcoord%ps0 do k=1,nlev ! moist pressure at mid points sum_water(:,:) = 1.0_r8 @@ -156,16 +296,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) @@ -179,7 +319,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)) @@ -200,7 +340,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/interp_mod.F90 b/src/dynamics/se/interp_mod.F90 index c9d87c649f..3092e08e03 100644 --- a/src/dynamics/se/interp_mod.F90 +++ b/src/dynamics/se/interp_mod.F90 @@ -1,12 +1,11 @@ module interp_mod - use cam_logfile, only: iulog - use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4 use dimensions_mod, only: nelemd, np, ne use interpolate_mod, only: interpdata_t use interpolate_mod, only: interp_lat => lat, interp_lon => lon use interpolate_mod, only: interp_gweight => gweight use dyn_grid, only: elem,fvm - use spmd_utils, only: masterproc, iam + use spmd_utils, only: iam use cam_history_support, only: fillvalue use hybrid_mod, only: hybrid_t, config_thread_region use cam_abortutils, only: endrun @@ -53,7 +52,6 @@ subroutine setup_history_interpolation(interp_ok, mtapes, interp_output, & use interpolate_mod, only: get_interp_parameter, set_interp_parameter use interpolate_mod, only: get_interp_gweight, setup_latlon_interp use parallel_mod, only: par - use thread_mod, only: omp_get_thread_num ! Dummy arguments logical, intent(inout) :: interp_ok @@ -62,7 +60,7 @@ subroutine setup_history_interpolation(interp_ok, mtapes, interp_output, & type(interp_info_t), intent(inout) :: interp_info(:) ! Local variables - integer :: ithr, i, j + integer :: i real(r8), pointer :: w(:) integer(iMap), pointer :: grid_map(:,:) type(horiz_coord_t), pointer :: lat_coord @@ -77,8 +75,6 @@ subroutine setup_history_interpolation(interp_ok, mtapes, interp_output, & if (interp_ok) then hybrid = config_thread_region(par,'serial') -! ithr = omp_get_thread_num() -! hybrid = hybrid_create(par,ithr,1) if(any(interp_output)) then allocate(interpdata_set(mtapes)) @@ -195,14 +191,13 @@ subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp use pio, only: iosystem_desc_t use pio, only: pio_initdecomp, pio_freedecomp use pio, only: io_desc_t, pio_write_darray + use pio, only: pio_real use interpolate_mod, only: interpolate_scalar use cam_instance, only: atm_id - use spmd_dyn, only: local_dp_map, block_buf_nrecs, chunk_buf_nrecs - use ppgrid, only: begchunk, endchunk, pcols, pverp, pver - use phys_grid, only: get_gcol_all_p, get_ncols_p, chunk_to_block_send_pters, chunk_to_block_recv_pters, & - transpose_chunk_to_block - use dyn_grid, only: get_gcol_block_d - use dimensions_mod, only: npsq, fv_nphys,nc,nhc,nhc_phys + use spmd_dyn, only: local_dp_map + use ppgrid, only: begchunk + use phys_grid, only: get_dyn_col_p, columns_on_task, get_chunk_info_p + use dimensions_mod, only: fv_nphys, nc, nhc, nhc_phys use dof_mod, only: PutUniquePoints use interpolate_mod, only: get_interp_parameter use shr_pio_mod, only: shr_pio_getiosys @@ -212,8 +207,7 @@ subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp use parallel_mod, only: par use thread_mod, only: horz_num_threads use cam_grid_support, only: cam_grid_id - use hybrid_mod, only: hybrid_t,config_thread_region, get_loop_ranges - use fvm_mapping, only: fvm2dyn,phys2dyn + use hybrid_mod, only: hybrid_t, config_thread_region, get_loop_ranges use fvm_mod, only: fill_halo_and_extend_panel type(file_desc_t), intent(inout) :: File @@ -229,20 +223,20 @@ subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp type (EdgeBuffer_t) :: edgebuf ! edge buffer - integer :: lchnk, i, j, icol, ncols, pgcols(pcols), ierr - integer :: idmb1(1), idmb2(1), idmb3(1), nets, nete - integer, allocatable :: bpter(:,:)! offsets into block buffer for packing data - integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data - integer :: phys_decomp, fvm_decomp,gll_decomp + integer :: lchnk, i, col_index, icol, ncols, ierr + integer :: nets, nete + integer :: phys_decomp, fvm_decomp, gll_decomp real(r8), pointer :: dest(:,:,:,:) - real(r8), pointer :: bbuffer(:), cbuffer(:), fldout(:,:) + real(r8), pointer :: fldout(:,:) real(r8), allocatable :: fld_dyn(:,:,:), fld_tmp(:,:,:,:,:) - integer :: st, en, ie, ioff, ncnt_out, k + integer :: st, en ! Start and end temporaries + integer :: ie, blk_ind(1), ncnt_out, k integer, pointer :: idof(:) - integer :: nlon, nlat, ncol,nsize,nhalo,nhcc + integer :: nlon, nlat, ncol, nsize, nhalo, nhcc logical :: usefillvalues + character(len=*), parameter :: subname = 'write_interpolated_scalar' usefillvalues=.false. @@ -256,7 +250,10 @@ subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp ! else : data is on dynamics decomposition ! if (decomp_type==phys_decomp) then - if (fv_nphys>0) then + if(.not. local_dp_map) then + call endrun(subname//': weak scaling does not support load balancing') + end if + if (fv_nphys > 0) then ! ! note that even if fv_nphys<4 then SIZE(fld,DIM=1)=PCOLS ! @@ -268,21 +265,20 @@ subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp nhalo = 0!no halo needed (lat-lon point always surrounded by GLL points) nhcc = 0 end if - else if (decomp_type==fvm_decomp) then + else if (decomp_type == fvm_decomp) then ! ! CSLAM grid output ! nsize = nc nhalo = 1!for bilinear only a halo of 1 is needed nhcc = nhc - else if (decomp_type==gll_decomp) then + else if (decomp_type == gll_decomp) then nsize = np nhalo = 0!no halo needed (lat-lon point always surrounded by GLL points) nhcc = 0 else - call endrun('write_interpolated_scalar: unknown decomp_type') + call endrun(subname//': unknown decomp_type') end if - allocate(fld_dyn(nsize*nsize,numlev,nelemd)) allocate(fld_tmp(1-nhcc:nsize+nhcc,1-nhcc:nsize+nhcc,numlev,1,nelemd)) allocate(dest(1-nhalo:nsize+nhalo,1-nhalo:nsize+nhalo,numlev,nelemd)) @@ -290,93 +286,42 @@ subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp nlat=get_interp_parameter('nlat') pio_subsystem => shr_pio_getiosys(atm_id) - if(decomp_type==phys_decomp) then - fld_dyn = -999_R8 - if(local_dp_map) then - !!$omp parallel do num_threads(horz_num_threads) private (lchnk, ncols, pgcols, icol, idmb1, idmb2, idmb3, ie, ioff,k) - do lchnk=begchunk,endchunk - ncols=get_ncols_p(lchnk) - call get_gcol_all_p(lchnk,pcols,pgcols) - do icol=1,ncols - call get_gcol_block_d(pgcols(icol),1,idmb1,idmb2,idmb3) - ie = idmb3(1) - ioff=idmb2(1) - do k=1,numlev - fld_dyn(ioff,k,ie) = fld(icol, k, lchnk-begchunk+1) - end do - end do - end do - else - allocate( bbuffer(block_buf_nrecs*numlev) )!xxx Steve: this is different that dp_coupling? (no numlev in dp_coupling) - allocate( cbuffer(chunk_buf_nrecs*numlev) ) - - !!$omp parallel do num_threads(horz_num_threads) private (lchnk, ncols, cpter, i, k, icol) - do lchnk = begchunk,endchunk - ncols = get_ncols_p(lchnk) + if(decomp_type == phys_decomp) then - call chunk_to_block_send_pters(lchnk,pcols,pverp,1,cpter) - - do i=1,ncols - cbuffer(cpter(i,1):cpter(i,1)) = 0.0_r8 - end do - - do k=1,numlev - do icol=1,ncols - cbuffer(cpter(icol,k-1)) = fld(icol,k,lchnk-begchunk+1) - end do - end do - - end do - - call transpose_chunk_to_block(1, cbuffer, bbuffer) - if(iam < par%nprocs) then - if (fv_nphys>0) then - allocate(bpter(fv_nphys*fv_nphys,0:pver)) - else - allocate(bpter(npsq,0:pver)) - end if - !!$omp parallel do num_threads(horz_num_threads) private (ie, bpter, k, ncols, icol) - do ie=1,nelemd - if (fv_nphys>0) then - call chunk_to_block_recv_pters(elem(ie)%GlobalID,fv_nphys*fv_nphys,pverp,1,bpter) - ncols = fv_nphys*fv_nphys - else - call chunk_to_block_recv_pters(elem(ie)%GlobalID,npsq,pverp,1,bpter) - ncols = elem(ie)%idxp%NumUniquePts - end if - do k = 1, numlev - do icol=1,ncols - fld_dyn(icol,k,ie) = bbuffer(bpter(icol,k-1)) - end do - end do - end do - end if - deallocate( bbuffer ) - deallocate( cbuffer ) - deallocate( bpter ) + allocate(fld_dyn(nsize*nsize,numlev,nelemd)) + fld_dyn = -999_R8 + !!$omp parallel do num_threads(horz_num_threads) private (col_index, lchnk, icol, ie, blk_ind, k) + do col_index = 1, columns_on_task + call get_dyn_col_p(col_index, ie, blk_ind) + call get_chunk_info_p(col_index, lchnk, icol) + do k = 1, numlev + fld_dyn(blk_ind(1), k, ie) = fld(icol, k, lchnk-begchunk+1) + end do + end do - end if!local_dp_map - if (fv_nphys>0) then + if (fv_nphys > 0) then do ie = 1, nelemd fld_tmp(1:nsize,1:nsize,:,1,ie) = RESHAPE(fld_dyn(:,:,ie),(/nsize,nsize,numlev/)) end do else call initEdgeBuffer(par, edgebuf, elem, numlev,nthreads=1) - do ie=1,nelemd + do ie = 1, nelemd ncols = elem(ie)%idxp%NumUniquePts call putUniquePoints(elem(ie)%idxP, numlev, fld_dyn(1:ncols,1:numlev,ie), fld_tmp(:,:,1:numlev,1,ie)) call edgeVpack(edgebuf, fld_tmp(:,:,1:numlev,1,ie), numlev, 0, ie) end do if(iam < par%nprocs) then - call bndry_exchange(par, edgebuf,location='write_interpolated_scalar') + call bndry_exchange(par, edgebuf,location=subname) end if - do ie=1,nelemd + do ie = 1, nelemd call edgeVunpack(edgebuf, fld_tmp(:,:,1:numlev,1,ie), numlev, 0, ie) end do call freeEdgeBuffer(edgebuf) + !check if fill values are present: usefillvalues = any(fld_tmp == fillvalue) end if + deallocate(fld_dyn) else ! ! not physics decomposition @@ -384,8 +329,9 @@ subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp do ie = 1, nelemd fld_tmp(1:nsize,1:nsize,1:numlev,1,ie) = RESHAPE(fld(1:nsize*nsize,1:numlev,ie),(/nsize,nsize,numlev/)) end do + !check if fillvalues are present: + usefillvalues = any(fld_tmp == fillvalue) end if - deallocate(fld_dyn) ! ! code for non-GLL grids: need to fill halo and interpolate (if on panel edge/corner) for bilinear interpolation ! @@ -396,6 +342,9 @@ subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp call get_loop_ranges(hybrid,ibeg=nets,iend=nete) call fill_halo_and_extend_panel(elem(nets:nete),fvm(nets:nete),& fld_tmp(:,:,:,:,nets:nete),hybrid,nets,nete,nsize,nhcc,nhalo,numlev,1,.true.,.true.) + + !check if fill values are present: + usefillvalues = any(fld_tmp(:,:,:,:,nets:nete) == fillvalue) end if ! ! WARNING - 1:nelemd and nets:nete @@ -440,7 +389,12 @@ subroutine write_interpolated_scalar(File, varid, fld, numlev, data_type, decomp else call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat,numlev/), idof, iodesc) end if - call pio_write_darray(File, varid, iodesc, fldout, ierr) + + if(data_type == pio_real) then + call pio_write_darray(File, varid, iodesc, real(fldout, r4), ierr) + else + call pio_write_darray(File, varid, iodesc, fldout, ierr) + end if deallocate(dest) @@ -455,15 +409,13 @@ subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, d use pio, only: iosystem_desc_t use pio, only: pio_initdecomp, pio_freedecomp use pio, only: io_desc_t, pio_write_darray + use pio, only: pio_real use cam_instance, only: atm_id use interpolate_mod, only: interpolate_scalar, vec_latlon_to_contra,get_interp_parameter - use spmd_dyn, only: local_dp_map, block_buf_nrecs, chunk_buf_nrecs - use ppgrid, only: begchunk, endchunk, pcols, pverp, pver - use phys_grid, only: get_gcol_all_p, get_ncols_p, chunk_to_block_send_pters, chunk_to_block_recv_pters, & - transpose_chunk_to_block - use dyn_grid, only: get_gcol_block_d - use hybrid_mod, only: hybrid_t,config_thread_region, get_loop_ranges - use dimensions_mod, only: npsq, fv_nphys,nc,nhc,nhc_phys + use spmd_dyn, only: local_dp_map + use ppgrid, only: begchunk + use phys_grid, only: get_dyn_col_p, columns_on_task, get_chunk_info_p + use dimensions_mod, only: fv_nphys,nc,nhc,nhc_phys use dof_mod, only: PutUniquePoints use shr_pio_mod, only: shr_pio_getiosys use edge_mod, only: edgevpack, edgevunpack, initedgebuffer, freeedgebuffer @@ -472,11 +424,11 @@ subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, d use parallel_mod, only: par use thread_mod, only: horz_num_threads use cam_grid_support, only: cam_grid_id + use hybrid_mod, only: hybrid_t,config_thread_region, get_loop_ranges use fvm_mod, only: fill_halo_and_extend_panel use control_mod, only: cubed_sphere_map use cube_mod, only: dmap - implicit none type(file_desc_t), intent(inout) :: File type(var_desc_t), intent(inout) :: varidu, varidv real(r8), intent(in) :: fldu(:,:,:), fldv(:,:,:) @@ -487,22 +439,22 @@ subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, d type(iosystem_desc_t), pointer :: pio_subsystem type (EdgeBuffer_t) :: edgebuf ! edge buffer - integer :: lchnk, i, j, icol, ncols, pgcols(pcols), ierr, nets, nete - integer :: idmb1(1), idmb2(1), idmb3(1) - integer, allocatable :: bpter(:,:) ! offsets into block buffer for packing data - integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data + integer :: lchnk, i, col_index, icol, ncols, ierr + integer :: nets, nete real(r8), allocatable :: dest(:,:,:,:,:) - real(r8), pointer :: bbuffer(:), cbuffer(:), fldout(:,:,:) - real(r8), allocatable :: fld_dyn(:,:,:,:),fld_tmp(:,:,:,:,:) + real(r8), pointer :: fldout(:,:,:) + real(r8), allocatable :: fld_dyn(:,:,:,:), fld_tmp(:,:,:,:,:) - integer :: st, en, ie, ioff, ncnt_out, k + integer :: st, en ! Start and end temporaries + integer :: ie, blk_ind(1), ncnt_out, k integer, pointer :: idof(:) integer :: nlon, nlat, ncol,nsize,nhalo,nhcc logical :: usefillvalues integer :: phys_decomp, fvm_decomp,gll_decomp real (r8) :: D(2,2) ! derivative of gnomonic mapping real (r8) :: v1,v2 + character(len=*), parameter :: subname = 'write_interpolated_vector' usefillvalues=.false. @@ -516,7 +468,10 @@ subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, d ! else : data is on dynamics decomposition ! if (decomp_type==phys_decomp) then - if (fv_nphys>0) then + if(.not. local_dp_map) then + call endrun(subname//': weak scaling does not support load balancing') + end if + if (fv_nphys > 0) then ! ! note that even if fv_nphys<4 then SIZE(fld,DIM=1)=npsq ! @@ -528,126 +483,73 @@ subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, d nhalo = 0!no halo needed (lat-lon point always surrounded by GLL points) nhcc = 0 end if - else if (decomp_type==fvm_decomp) then + else if (decomp_type == fvm_decomp) then ! ! CSLAM grid output ! nsize = nc nhalo = 1!for bilinear only a halo of 1 is needed nhcc = nhc - else if (decomp_type==gll_decomp) then + else if (decomp_type == gll_decomp) then nsize = np nhalo = 0!no halo needed (lat-lon point always surrounded by GLL points) nhcc = 0 else - call endrun('write_interpolated_scalar: unknown decomp_type') + call endrun(subname//': unknown decomp_type') end if - allocate(fld_dyn(nsize*nsize,2,numlev,nelemd)) allocate(fld_tmp(1-nhcc:nsize+nhcc,1-nhcc:nsize+nhcc,2,numlev,nelemd)) allocate(dest(1-nhalo:nsize+nhalo,1-nhalo:nsize+nhalo,2,numlev,nelemd)) nlon=get_interp_parameter('nlon') nlat=get_interp_parameter('nlat') pio_subsystem => shr_pio_getiosys(atm_id) - fld_dyn = -999_R8 - if(decomp_type==phys_decomp) then - if(local_dp_map) then - !!$omp parallel do num_threads(horz_num_threads) private (lchnk, ncols, pgcols, icol, idmb1, idmb2, idmb3, ie, k, ioff) - do lchnk=begchunk,endchunk - ncols=get_ncols_p(lchnk) - call get_gcol_all_p(lchnk,pcols,pgcols) - do icol=1,ncols - call get_gcol_block_d(pgcols(icol),1,idmb1,idmb2,idmb3) - ie = idmb3(1) - ioff=idmb2(1) - do k=1,numlev - fld_dyn(ioff,1,k,ie) = fldu(icol, k, lchnk-begchunk+1) - fld_dyn(ioff,2,k,ie) = fldv(icol, k, lchnk-begchunk+1) - end do - end do - end do - else - allocate( bbuffer(2*block_buf_nrecs*numlev) ) - allocate( cbuffer(2*chunk_buf_nrecs*numlev) ) - !!$omp parallel do num_threads(horz_num_threads) private (lchnk, ncols, cpter, i, k, icol) - do lchnk = begchunk,endchunk - ncols = get_ncols_p(lchnk) - - call chunk_to_block_send_pters(lchnk,pcols,pverp,2,cpter) - - do i=1,ncols - cbuffer(cpter(i,1):cpter(i,1)) = 0.0_r8 - end do - - do icol=1,ncols - do k=1,numlev - cbuffer(cpter(icol,k-1)) = fldu(icol,k,lchnk-begchunk+1) - cbuffer(cpter(icol,k-1)+1) = fldv(icol,k,lchnk-begchunk+1) - end do - end do - end do - - call transpose_chunk_to_block(2, cbuffer, bbuffer) - if(iam < par%nprocs) then - if (fv_nphys>0) then - allocate(bpter(fv_nphys*fv_nphys,0:pver)) - else - allocate(bpter(npsq,0:pver)) - end if - !!$omp parallel do num_threads(horz_num_threads) private (ie, bpter, k, icol) - do ie=1,nelemd - if (fv_nphys>0) then - call chunk_to_block_recv_pters(elem(ie)%GlobalID,fv_nphys*fv_nphys,pverp,2,bpter) - ncols = fv_nphys*fv_nphys - else - call chunk_to_block_recv_pters(elem(ie)%GlobalID,npsq,pverp,2,bpter) - ncols = elem(ie)%idxp%NumUniquePts - end if - do icol=1,ncols - do k=1,numlev - fld_dyn(icol,1,k,ie) = bbuffer(bpter(icol,k-1)) - fld_dyn(icol,2,k,ie) = bbuffer(bpter(icol,k-1)+1) - enddo - end do - end do - end if - deallocate( bbuffer ) - deallocate( cbuffer ) - deallocate( bpter ) - end if!local_dp_map - if (fv_nphys>0) then + if(decomp_type == phys_decomp) then + allocate(fld_dyn(nsize*nsize,2,numlev,nelemd)) + fld_dyn = -999_R8 + !!$omp parallel do num_threads(horz_num_threads) private (col_index, lchnk, icol, ie, blk_ind, k) + do col_index = 1, columns_on_task + call get_dyn_col_p(col_index, ie, blk_ind) + call get_chunk_info_p(col_index, lchnk, icol) + do k = 1, numlev + fld_dyn(blk_ind(1), 1, k, ie) = fldu(icol, k, lchnk-begchunk+1) + fld_dyn(blk_ind(1), 2, k, ie) = fldv(icol, k, lchnk-begchunk+1) + end do + end do + if (fv_nphys > 0) then do ie = 1, nelemd fld_tmp(1:nsize,1:nsize,:,:,ie) = RESHAPE(fld_dyn(:,:,:,ie),(/nsize,nsize,2,numlev/)) end do else call initEdgeBuffer(par, edgebuf, elem, 2*numlev,nthreads=1) - do ie=1,nelemd + do ie = 1, nelemd ncols = elem(ie)%idxp%NumUniquePts call putUniquePoints(elem(ie)%idxP, 2, numlev, fld_dyn(1:ncols,:,1:numlev,ie), fld_tmp(:,:,:,1:numlev,ie)) call edgeVpack(edgebuf, fld_tmp(:,:,:,:,ie), 2*numlev, 0, ie) - enddo + end do if(iam < par%nprocs) then - call bndry_exchange(par, edgebuf,location='write_interpolated_vector') + call bndry_exchange(par, edgebuf,location=subname) end if - do ie=1,nelemd + do ie = 1, nelemd call edgeVunpack(edgebuf, fld_tmp(:,:,:,:,ie), 2*numlev, 0, ie) - enddo + end do call freeEdgeBuffer(edgebuf) + !check if fill values are present: usefillvalues = any(fld_tmp==fillvalue) end if + deallocate(fld_dyn) else ! ! not physics decomposition ! + !check if fill values are present: usefillvalues = (any(fldu(1:nsize:1,nsize,:)==fillvalue) .or. any(fldv(1:nsize:1,nsize,:)==fillvalue)) do ie = 1, nelemd fld_tmp(1:nsize,1:nsize,1,1:numlev,ie) = RESHAPE(fldu(1:nsize*nsize,1:numlev,ie),(/nsize,nsize,numlev/)) fld_tmp(1:nsize,1:nsize,2,1:numlev,ie) = RESHAPE(fldv(1:nsize*nsize,1:numlev,ie),(/nsize,nsize,numlev/)) end do endif - deallocate(fld_dyn) ! !*************************************************************************** ! @@ -676,6 +578,9 @@ subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, d end do call fill_halo_and_extend_panel(elem(nets:nete),fvm(nets:nete),& fld_tmp(:,:,:,:,nets:nete),hybrid,nets,nete,nsize,nhcc,nhalo,2,numlev,.false.,.true.) + + !check if fill values are present: + usefillvalues = any(fld_tmp(:,:,:,:,nets:nete) == fillvalue) else do ie=1,nelemd call vec_latlon_to_contra(elem(ie),nsize,nhcc,numlev,fld_tmp(:,:,:,:,ie)) @@ -742,8 +647,13 @@ subroutine write_interpolated_vector(File, varidu, varidv, fldu, fldv, numlev, d call pio_initdecomp(pio_subsystem, data_type, (/nlon,nlat,numlev/), idof, iodesc) end if - call pio_write_darray(File, varidu, iodesc, fldout(:,:,1), ierr) - call pio_write_darray(File, varidv, iodesc, fldout(:,:,2), ierr) + if(data_type == pio_real) then + call pio_write_darray(File, varidu, iodesc, real(fldout(:,:,1), r4), ierr) + call pio_write_darray(File, varidv, iodesc, real(fldout(:,:,2), r4), ierr) + else + call pio_write_darray(File, varidu, iodesc, fldout(:,:,1), ierr) + call pio_write_darray(File, varidv, iodesc, fldout(:,:,2), ierr) + end if deallocate(fldout) diff --git a/src/dynamics/se/restart_dynamics.F90 b/src/dynamics/se/restart_dynamics.F90 index aa0c8ab37f..0c630c9336 100644 --- a/src/dynamics/se/restart_dynamics.F90 +++ b/src/dynamics/se/restart_dynamics.F90 @@ -12,7 +12,7 @@ module restart_dynamics ! grid format may also be used for an initial run. use shr_kind_mod, only: r8 => shr_kind_r8 -use spmd_utils, only: iam +use spmd_utils, only: iam, masterproc use constituents, only: cnst_name use dyn_grid, only: timelevel, fvm, elem, edgebuf @@ -43,10 +43,10 @@ module restart_dynamics use parallel_mod, only: par use thread_mod, only: horz_num_threads -use dimensions_mod, only: np, npsq, ne, nlev, qsize, nelemd, nc, ntrac +use dimensions_mod, only: np, npsq, ne, nlev, qsize, nelemd, nc, ntrac, use_cslam use dof_mod, only: UniquePoints use element_mod, only: element_t -use time_mod, only: tstep, TimeLevel_Qdp +use se_dyn_time_mod, only: tstep, TimeLevel_Qdp use edge_mod, only: initEdgeBuffer, edgeVpack, edgeVunpack, FreeEdgeBuffer use edgetype_mod, only: EdgeBuffer_t @@ -148,7 +148,7 @@ subroutine init_restart_dynamics(file, dyn_out) ! CSLAM restart fields - if (ntrac > 0) then + if (use_cslam) then grid_id = cam_grid_id('FVM') call cam_grid_write_attr(File, grid_id, info) @@ -223,7 +223,7 @@ subroutine write_restart_dynamics(File, dyn_out) ! write CSLAM fields - if (ntrac > 0) then + if (use_cslam) then grid_id = cam_grid_id('FVM') @@ -621,7 +621,7 @@ subroutine read_restart_dynamics(File, dyn_in, dyn_out) ! read cslam fields - if (ntrac > 0) then + if (use_cslam) then ! Checks that file and model dimensions agree. @@ -726,9 +726,9 @@ subroutine read_elem() call PIO_InitDecomp(pio_subsystem, pio_double, (/ncol,nlev/), ldof, iodesc3d) deallocate(ldof) - allocate(var3d(ncol*nlev), var2d(ncol)) + allocate(var2d(nelemd*np*np), stat=ierr) + if (ierr/=0) call endrun( sub//': not able to allocate var2d' ) var2d = 0._r8 - var3d = 0._r8 call pio_setframe(File, psdry_desc, t_idx) call pio_read_darray(File, psdry_desc, iodesc2d, var2d, ierr) @@ -743,6 +743,11 @@ subroutine read_elem() end do end do + deallocate(var2d) + allocate(var3d(nelemd*np*np*nlev), stat=ierr) + if (ierr/=0) call endrun( sub//': not able to allocate var3d' ) + var3d = 0._r8 + call pio_setframe(File, udesc, t_idx) call pio_read_darray(File, udesc, iodesc3d, var3d, ierr) call cam_pio_handle_error(ierr, sub//': reading U') @@ -805,7 +810,9 @@ subroutine read_elem() end do end do - deallocate(var3d, var2d) + deallocate(var3d) + + if (masterproc) write(iulog,*) sub//': completed successfully' end subroutine read_elem 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 bd5577f765..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,7 +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 @@ -23,13 +34,16 @@ module stepon public stepon_run3 public stepon_final +class(aerosol_properties), pointer :: aero_props_obj => null() +logical :: aerosols_transported = .false. +logical :: iop_update_phase1 + !========================================================================================= contains !========================================================================================= 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 @@ -73,6 +87,14 @@ subroutine stepon_init(dyn_in, dyn_out ) call add_default(trim(cnst_name(m_cnst))//'&IC', 0, 'I') end do + ! get aerosol properties + aero_props_obj => aerosol_properties_object() + + if (associated(aero_props_obj)) then + ! determine if there are transported aerosol contistuents + aerosols_transported = aero_props_obj%number_transported()>0 + end if + end subroutine stepon_init !========================================================================================= @@ -80,11 +102,10 @@ 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 - use time_mod, only: tstep ! dynamics timestep + use se_dyn_time_mod,only: tstep ! dynamics timestep real(r8), intent(out) :: dtime_out ! Time-step type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) @@ -94,6 +115,10 @@ subroutine stepon_run1( dtime_out, phys_state, phys_tend, & type (physics_buffer_desc), pointer :: pbuf2d(:,:) !---------------------------------------------------------------------------- + integer :: c + class(aerosol_state), pointer :: aero_state_obj + nullify(aero_state_obj) + dtime_out = get_step_size() if (iam < par%nprocs) then @@ -104,12 +129,51 @@ 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. call d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out ) call t_stopf('d_p_coupling') + !---------------------------------------------------------- + ! update aerosol state object from CAM physics state constituents + !---------------------------------------------------------- + if (aerosols_transported) then + + do c = begchunk,endchunk + aero_state_obj => aerosol_state_object(c) + ! pass number mass or number mixing ratios of aerosol constituents + ! to aerosol state object + call aero_state_obj%set_transported(phys_state(c)%q) + end do + + end if + end subroutine stepon_run1 !========================================================================================= @@ -119,9 +183,9 @@ subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out) use dp_coupling, only: p_d_coupling use dyn_grid, only: TimeLevel - use time_mod, only: TimeLevel_Qdp + use se_dyn_time_mod, only: TimeLevel_Qdp use control_mod, only: qsplit - use prim_advance_mod, only: calc_tot_energy_dynamics + use prim_advance_mod, only: tot_energy_dyn ! arguments @@ -132,11 +196,28 @@ subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out) ! local variables integer :: tl_f, tl_fQdp + + integer :: c + class(aerosol_state), pointer :: aero_state_obj + !---------------------------------------------------------------------------- tl_f = TimeLevel%n0 ! timelevel which was adjusted by physics call TimeLevel_Qdp(TimeLevel, qsplit, tl_fQdp) + !---------------------------------------------------------- + ! update physics state with aerosol constituents + !---------------------------------------------------------- + nullify(aero_state_obj) + + if (aerosols_transported) then + do c = begchunk,endchunk + aero_state_obj => aerosol_state_object(c) + ! get mass or number mixing ratios of aerosol constituents + call aero_state_obj%get_transported(phys_state(c)%q) + end do + end if + call t_barrierf('sync_p_d_coupling', mpicom) call t_startf('p_d_coupling') ! copy from phys structures -> dynamics structures @@ -144,7 +225,7 @@ subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out) call t_stopf('p_d_coupling') if (iam < par%nprocs) then - call calc_tot_energy_dynamics(dyn_in%elem,dyn_in%fvm, 1, nelemd, tl_f, tl_fQdp,'dED') + call tot_energy_dyn(dyn_in%elem,dyn_in%fvm, 1, nelemd, tl_f, tl_fQdp,'dED') end if end subroutine stepon_run2 @@ -155,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 time_mod, only: TimeLevel_Qdp - use control_mod, only: qsplit + 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 @@ -168,23 +251,35 @@ 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) + 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) call t_startf('dyn_run') call dyn_run(dyn_out) call t_stopf('dyn_run') call t_startf('comp_adv_tends2') - tl_f = TimeLevel%n0 - call TimeLevel_Qdp(TimeLevel, qsplit, tl_fQdp) + 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) - call t_stopf('comp_adv_tends2') + 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 @@ -201,10 +296,9 @@ 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 time_mod, only: TimeLevel_Qdp ! dynamics typestep + use se_dyn_time_mod, only: TimeLevel_Qdp ! dynamics typestep use control_mod, only: qsplit use hybrid_mod, only: config_thread_region, get_loop_ranges use hybrid_mod, only: hybrid_t @@ -214,8 +308,9 @@ subroutine diag_dynvar_ic(elem, fvm) use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use fvm_mapping, only: fvm2dyn - use physconst, only: get_sum_species, get_ps,thermodynamic_active_species_idx - use physconst, only: thermodynamic_active_species_idx_dycore,get_dp_ref + use cam_thermo, only: get_sum_species, get_dp_ref, get_ps + use air_composition, only: thermodynamic_active_species_idx + use air_composition, only: thermodynamic_active_species_idx_dycore use hycoef, only: hyai, hybi, ps0 ! arguments type(element_t) , intent(in) :: elem(1:nelemd) @@ -231,9 +326,11 @@ subroutine diag_dynvar_ic(elem, fvm) real(r8), allocatable :: ftmp(:,:,:) real(r8), allocatable :: fld_fvm(:,:,:,:,:), fld_gll(:,:,:,:,:) real(r8), allocatable :: fld_2d(:,:) - logical, allocatable :: llimiter(:) + logical :: llimiter(1) real(r8) :: qtmp(np,np,nlev), dp_ref(np,np,nlev), ps_ref(np,np) real(r8), allocatable :: factor_array(:,:,:) + integer :: astat + character(len=*), parameter :: prefix = 'diag_dynvar_ic: ' !---------------------------------------------------------------------------- tl_f = timelevel%n0 @@ -298,8 +395,8 @@ subroutine diag_dynvar_ic(elem, fvm) end if if (hist_fld_active('dp_ref_gll')) then - do ie = 1, nelemd - call get_dp_ref(hyai,hybi,ps0,1,np,1,np,1,nlev,elem(ie)%state%phis(:,:),dp_ref(:,:,:),ps_ref(:,:)) + do ie = 1, nelemd + call get_dp_ref(hyai, hybi, ps0, elem(ie)%state%phis(:,:), dp_ref(:,:,:), ps_ref(:,:)) do j = 1, np do i = 1, np ftmp(i+(j-1)*np,:,1) = elem(ie)%state%dp3d(i,j,:,tl_f)/dp_ref(i,j,:) @@ -323,8 +420,8 @@ subroutine diag_dynvar_ic(elem, fvm) if (hist_fld_active('PS_gll')) then allocate(fld_2d(np,np)) do ie = 1, nelemd - call get_ps(1,np,1,np,1,nlev,qsize,elem(ie)%state%Qdp(:,:,:,:,tl_Qdp),& - thermodynamic_active_species_idx_dycore,elem(ie)%state%dp3d(:,:,:,tl_f),fld_2d,hyai(1)*ps0) + call get_ps(elem(ie)%state%Qdp(:,:,:,:,tl_Qdp), thermodynamic_active_species_idx_dycore,& + elem(ie)%state%dp3d(:,:,:,tl_f),fld_2d,hyai(1)*ps0) do j = 1, np do i = 1, np ftmp(i+(j-1)*np,1,1) = fld_2d(i,j) @@ -342,19 +439,28 @@ subroutine diag_dynvar_ic(elem, fvm) end if if (write_inithist()) then - allocate(fld_2d(np,np)) - do ie = 1, nelemd - call get_ps(1,np,1,np,1,nlev,qsize,elem(ie)%state%Qdp(:,:,:,:,tl_Qdp),& - thermodynamic_active_species_idx_dycore,elem(ie)%state%dp3d(:,:,:,tl_f),fld_2d,hyai(1)*ps0) - do j = 1, np - do i = 1, np - ftmp(i+(j-1)*np,1,1) = fld_2d(i,j) + allocate(fld_2d(np,np)) + do ie = 1, nelemd + call get_ps(elem(ie)%state%Qdp(:,:,:,:,tl_Qdp), thermodynamic_active_species_idx_dycore,& + elem(ie)%state%dp3d(:,:,:,tl_f),fld_2d,hyai(1)*ps0) + do j = 1, np + do i = 1, np + ftmp(i+(j-1)*np,1,1) = fld_2d(i,j) + end do end do - end do - call outfld('PS&IC', ftmp(:,1,1), npsq, ie) - end do - deallocate(fld_2d) - if (fv_nphys < 1) allocate(factor_array(np,np,nlev)) + call outfld('PS&IC', ftmp(:,1,1), npsq, ie) + end do + deallocate(fld_2d) + endif + + deallocate(ftmp) + + if (write_inithist()) then + + if (fv_nphys < 1) then + allocate(factor_array(np,np,nlev),stat=astat) + if (astat /= 0) call endrun(prefix//"Allocate factor_array failed") + endif do ie = 1, nelemd call outfld('T&IC', RESHAPE(elem(ie)%state%T(:,:,:,tl_f), (/npsq,nlev/)), npsq, ie) @@ -362,8 +468,8 @@ subroutine diag_dynvar_ic(elem, fvm) call outfld('V&IC', RESHAPE(elem(ie)%state%v(:,:,2,:,tl_f), (/npsq,nlev/)), npsq, ie) if (fv_nphys < 1) then - call get_sum_species(1,np,1,np,1,nlev,qsize,elem(ie)%state%Qdp(:,:,:,:,tl_qdp), & - thermodynamic_active_species_idx_dycore, factor_array,dp_dry=elem(ie)%state%dp3d(:,:,:,tl_f)) + call get_sum_species(elem(ie)%state%Qdp(:,:,:,:,tl_qdp), & + thermodynamic_active_species_idx_dycore, factor_array,dp_dry=elem(ie)%state%dp3d(:,:,:,tl_f)) factor_array(:,:,:) = 1.0_r8/factor_array(:,:,:) do m_cnst = 1, qsize if (cnst_type(m_cnst) == 'wet') then @@ -385,40 +491,43 @@ subroutine diag_dynvar_ic(elem, fvm) hybrid = config_thread_region(par,'serial') call get_loop_ranges(hybrid, ibeg=nets, iend=nete) - allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,ntrac,nets:nete)) - allocate(fld_gll(np,np,nlev,ntrac,nets:nete)) - allocate(llimiter(ntrac)) - allocate(factor_array(nc,nc,nlev)) + allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,1,nets:nete),stat=astat) + if (astat /= 0) call endrun(prefix//"Allocate fld_fvm failed") + allocate(fld_gll(np,np,nlev,1,nets:nete),stat=astat) + if (astat /= 0) call endrun(prefix//"Allocate fld_gll failed") + allocate(factor_array(nc,nc,nlev),stat=astat) + if (astat /= 0) call endrun(prefix//"Allocate factor_array failed") + llimiter = .true. - do ie = nets, nete - call get_sum_species(1,nc,1,nc,1,nlev,ntrac,fvm(ie)%c(1:nc,1:nc,:,:),thermodynamic_active_species_idx,factor_array) - factor_array(:,:,:) = 1.0_r8/factor_array(:,:,:) - do m_cnst = 1, ntrac - if (cnst_type(m_cnst) == 'wet') then - fld_fvm(1:nc,1:nc,:,m_cnst,ie) = fvm(ie)%c(1:nc,1:nc,:,m_cnst)*factor_array(:,:,:) - else - fld_fvm(1:nc,1:nc,:,m_cnst,ie) = fvm(ie)%c(1:nc,1:nc,:,m_cnst) - end if - end do - end do - call fvm2dyn(fld_fvm, fld_gll, hybrid, nets, nete, nlev, ntrac, fvm(nets:nete), llimiter) + do m_cnst = 1, ntrac + do ie = nets, nete + + call get_sum_species(fvm(ie)%c(1:nc,1:nc,:,:),thermodynamic_active_species_idx,factor_array) + factor_array(:,:,:) = 1.0_r8/factor_array(:,:,:) + + if (cnst_type(m_cnst) == 'wet') then + fld_fvm(1:nc,1:nc,:,1,ie) = fvm(ie)%c(1:nc,1:nc,:,m_cnst)*factor_array(:,:,:) + else + fld_fvm(1:nc,1:nc,:,1,ie) = fvm(ie)%c(1:nc,1:nc,:,m_cnst) + end if + end do + + call fvm2dyn(fld_fvm, fld_gll, hybrid, nets, nete, nlev, fvm(nets:nete), llimiter) - do ie = nets, nete - do m_cnst = 1, ntrac + do ie = nets, nete call outfld(trim(cnst_name(m_cnst))//'&IC', & - RESHAPE(fld_gll(:,:,:,m_cnst,ie), (/npsq,nlev/)), npsq, ie) + RESHAPE(fld_gll(:,:,:,:,ie), (/npsq,nlev/)), npsq, ie) end do end do deallocate(fld_fvm) deallocate(fld_gll) - deallocate(llimiter) end if + deallocate(factor_array) - end if ! if (write_inithist) - deallocate(ftmp) + end if ! if (write_inithist) end subroutine diag_dynvar_ic diff --git a/src/dynamics/se/test_fvm_mapping.F90 b/src/dynamics/se/test_fvm_mapping.F90 index ef0481b5e0..4a26484854 100644 --- a/src/dynamics/se/test_fvm_mapping.F90 +++ b/src/dynamics/se/test_fvm_mapping.F90 @@ -3,7 +3,7 @@ module test_fvm_mapping use fvm_control_volume_mod, only: fvm_struct use cam_history, only: outfld use physconst, only: pi - use dimensions_mod, only: np, nelemd, nlev, npsq, ntrac + use dimensions_mod, only: np, nelemd, nlev, npsq, ntrac, use_cslam use element_mod, only: element_t implicit none private @@ -147,10 +147,6 @@ subroutine test_mapping_overwrite_tendencies(phys_state,phys_tend,ncols,lchnk,q_ integer :: m_cnst, nq, ie q_prev(:,:,ntrac) = 0.0_r8 - do ie=1,nelemd -!xxx fvm(ie)%c(:,:,:,ntrac) = 0.0_r8 - end do - phys_state%pdel(1:ncols,:) = phys_state%pdeldry(1:ncols,:) !make sure there is no conversion from wet to dry do nq=ntrac,ntrac m_cnst = nq @@ -243,7 +239,7 @@ subroutine test_mapping_output_mapped_tendencies(fvm,elem,nets,nete,tl_f,tl_qdp) name = 'p2d_'//trim(cnst_name(m_cnst))//'_err_gll' call outfld(TRIM(name), RESHAPE(elem(ie)%derived%fq(:,:,:,nq),(/npsq,nlev/)), npsq, ie) end do - if (ntrac>0) then + if (use_cslam) then do nq=ntrac,ntrac m_cnst = nq name = 'p2f_'//trim(cnst_name(m_cnst))//'_fvm' @@ -356,7 +352,6 @@ subroutine test_mapping_overwrite_dyn_state(elem,fvm) end do end if end do -! call fill_halo_fvm_noprealloc(elem,fvm,hybrid,nets,nete,nhc,1,nlev)!xxx nhr chould be a function of interp_method #endif end subroutine test_mapping_overwrite_dyn_state @@ -370,15 +365,11 @@ subroutine test_mapping_output_phys_state(phys_state,fvm) integer :: lchnk, ncol,k,icol,m_cnst,nq,ie character(LEN=128) :: name - do ie=1,nelemd -!xxx fvm(ie)%c(:,:,:,ntrac) = 0.0_r8 - end do - do lchnk = begchunk, endchunk call outfld('d2p_scalar', phys_state(lchnk)%omega(1:pcols,1:pver), pcols, lchnk) call outfld('d2p_u', phys_state(lchnk)%U(1:pcols,1:pver), pcols, lchnk) call outfld('d2p_v', phys_state(lchnk)%V(1:pcols,1:pver), pcols, lchnk) - if (ntrac>0) then + if (use_cslam) then do nq=ntrac,ntrac m_cnst = nq name = 'f2p_'//trim(cnst_name(m_cnst)) diff --git a/src/dynamics/tests/dyn_tests_utils.F90 b/src/dynamics/tests/dyn_tests_utils.F90 index 3a3596b0d5..c6cf819470 100644 --- a/src/dynamics/tests/dyn_tests_utils.F90 +++ b/src/dynamics/tests/dyn_tests_utils.F90 @@ -18,6 +18,33 @@ module dyn_tests_utils integer, parameter :: vc_moist_pressure = 0 ! Moist pressure vertical coord integer, parameter :: vc_dry_pressure = 1 ! Dry pressure vertical coord integer, parameter :: vc_height = 2 ! Height vertical coord - public :: vc_moist_pressure, vc_dry_pressure, vc_height + integer, parameter :: vc_str_lgth = 108 ! Length of string in + + integer :: vc_dycore !vertical coordinate of dynamical core - set in dyn_comp.F90 + integer :: vc_physics !vertical coordinate of physics - set in physconst.F90 + + public :: vc_moist_pressure, vc_dry_pressure, vc_height, string_vc + public :: vc_dycore, vc_physics, vc_str_lgth + +contains + subroutine string_vc(vc,str) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use string_utils, only: int2str + integer, intent(in) :: vc + character (len=vc_str_lgth), intent(out) :: str + + select case (vc) + case(vc_moist_pressure) + str = 'Moist pressure/mass vertical coordinate' + case(vc_dry_pressure) + str = 'Dry pressure/mass vertical coordinate' + case(vc_height) + str = 'Height (z) vertical coordinate' + case default + write(iulog,*) 'string_vc: invalid vc= ',vc + call endrun('string_vc: invalid vc ='//trim(int2str(vc))) + end select + end subroutine string_vc end module dyn_tests_utils diff --git a/src/hemco b/src/hemco new file mode 160000 index 0000000000..7bd8358229 --- /dev/null +++ b/src/hemco @@ -0,0 +1 @@ +Subproject commit 7bd8358229eefd2cbb910ff30c46dfc97e34fb6f diff --git a/src/infrastructure/phys_grid.F90 b/src/infrastructure/phys_grid.F90 new file mode 100644 index 0000000000..8da2f0b461 --- /dev/null +++ b/src/infrastructure/phys_grid.F90 @@ -0,0 +1,1212 @@ +module phys_grid + +!------------------------------------------------------------------------------ +! +! The phys_grid module represents the CAM physics decomposition. +! +! phys_grid_init receives the physics column info (area, weight, centers) +! from the dycore. +! The routine then creates the physics decomposition which +! is the arrangement of columns across the atmosphere model's +! MPI tasks as well as the arrangement into groups to +! facilitate efficient threading. +! The routine then creates a grid object to allow for data +! to be read into and written from this decomposition. +! The phys_grid module also provides interfaces for retrieving information +! about the decomposition +! +! Note: This current implementation does not perform load balancing, +! physics columns ae always on the same task as the corresponding +! column received from the dycore. +! +!------------------------------------------------------------------------------ + use shr_kind_mod, only: r8 => shr_kind_r8 + 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 + + implicit none + private + save + +!!XXgoldyXX: v This needs to be removed to complete the weak scaling transition. + public :: SCATTER_FIELD_TO_CHUNK +!!XXgoldyXX: ^ This needs to be removed to complete the weak scaling transition. + + ! Physics grid management + public :: phys_grid_init ! initialize the physics grid + public :: phys_grid_readnl ! Read the phys_grid_nl namelist + public :: phys_grid_initialized + ! Local task interfaces + public :: get_nlcols_p ! Number of local columns + public :: get_area_p ! area of a physics column in radians squared + public :: get_wght_p ! weight of a physics column in radians squared + public :: get_rlat_p ! latitude of a physics column in radians + public :: get_rlon_p ! longitude of a physics column in radians + public :: get_rlat_all_p ! latitudes of physics cols in chunk (radians) + public :: get_rlon_all_p ! longitudes of physics cols in chunk (radians) + public :: get_lat_p ! latitude of a physics column in degrees + public :: get_lon_p ! longitude of a physics column in degrees + public :: get_lat_all_p ! latitudes of physics cols in chunk (degrees) + public :: get_lon_all_p ! longitudes of physics cols in chunk (degrees) + public :: get_area_all_p ! areas of physics cols in chunk + public :: get_wght_all_p ! weights of physics cols in chunk + public :: get_ncols_p ! number of columns in a chunk + public :: get_gcol_p ! global column index of a physics column + public :: get_gcol_all_p ! global col index of all phys cols in a chunk + public :: get_dyn_col_p ! dynamics local blk number and blk offset(s) + public :: get_chunk_info_p ! chunk index and col # of a physics column + public :: get_grid_dims ! return grid dimensions + ! Physics-dynamics coupling + public :: phys_decomp_to_dyn ! Transfer physics data to dynamics decomp + public :: dyn_decomp_to_phys ! Transfer dynamics data to physics decomp + + ! The identifier for the physics grid + integer, parameter, public :: phys_decomp = 100 + integer, parameter, public :: phys_decomp_scm = 200 + + !! PUBLIC TYPES + + ! Physics chunking (thread blocking) data + ! Note that chunks cover local data + type, public :: chunk + integer, private :: ncols = 1 ! # of grid columns in this chunk + integer, private :: chunk_index = -1 ! Local index of this chunk + integer, private, allocatable :: phys_cols(:) ! phys column indices + end type chunk + + !! PRIVATE DATA + + ! dynamics field grid information + ! hdim1_d and hdim2_d are dimensions of rectangular horizontal grid + ! data structure, If 1D data structure, then hdim2_d == 1. + integer :: hdim1_d, hdim2_d + + ! Physics decomposition information + type(physics_column_t), allocatable :: phys_columns(:) + + type(chunk), private, pointer :: chunks(:) => NULL() ! (begchunk:endchunk) + + logical :: phys_grid_set = .false. + + logical :: calc_memory_increase = .false. + + interface get_dyn_col_p + module procedure :: get_dyn_col_p_chunk + module procedure :: get_dyn_col_p_index + end interface get_dyn_col_p + + ! Private interfaces + private :: chunk_info_to_index_p + +!!XXgoldyXX: v temporary interface to allow old code to compile + interface get_lat_all_p + module procedure :: get_lat_all_p_r8 ! The new version + module procedure :: get_lat_all_p_int ! calls endun + end interface get_lat_all_p + + interface get_lon_all_p + module procedure :: get_lon_all_p_r8 ! The new version + module procedure :: get_lon_all_p_int ! calls endun + end interface get_lon_all_p +!!XXgoldyXX: ^ temporary interface to allow old code to compile + + 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 +!============================================================================== + + subroutine phys_grid_readnl(nlfile) + use cam_abortutils, only: endrun + use namelist_utils, only: find_group_name + use cam_logfile, only: iulog + use spmd_utils, only: mpicom, mstrid=>masterprocid, masterproc + use spmd_utils, only: mpi_integer + + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'phys_grid_readnl' + + integer :: phys_alltoall = -HUGE(1) + integer :: phys_loadbalance = -HUGE(1) + integer :: phys_twin_algorithm = -HUGE(1) + integer :: phys_chnk_per_thd = -HUGE(1) + + namelist /phys_grid_nl/ phys_alltoall, phys_loadbalance, & + phys_twin_algorithm, phys_chnk_per_thd + !------------------------------------------------------------------------ + + ! Read namelist + if (masterproc) then + open(newunit=unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'phys_grid_nl', status=ierr) + if (ierr == 0) then + read(unitn, phys_grid_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub//': FATAL: reading namelist') + end if + end if + close(unitn) + end if + + call mpi_bcast(phys_alltoall, 1, mpi_integer, mstrid, mpicom, ierr) + call mpi_bcast(phys_loadbalance, 1, mpi_integer, mstrid, mpicom, ierr) + call mpi_bcast(phys_twin_algorithm, 1, mpi_integer, mstrid, mpicom, ierr) + call mpi_bcast(phys_chnk_per_thd, 1, mpi_integer, mstrid, mpicom, ierr) + + if (masterproc) then + write(iulog,*) 'PHYS_GRID options:' + write(iulog,*) ' Using PCOLS =', pcols + write(iulog,*) ' phys_loadbalance = (not used)' + write(iulog,*) ' phys_twin_algorithm = (not used)' + write(iulog,*) ' phys_alltoall = (not used)' + write(iulog,*) ' chunks_per_thread = (not used)' + end if + + end subroutine phys_grid_readnl + + !======================================================================== + + subroutine phys_grid_init() + use mpi, only: MPI_INTEGER, MPI_REAL8, MPI_MIN, MPI_MAX + use shr_mem_mod, only: shr_mem_getusage + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use spmd_utils, only: npes, mpicom, masterprocid, masterproc, iam + 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 + integer :: col_index, phys_col + integer :: ichnk, icol, ncol, gcol + integer :: num_chunks + type(physics_column_t), allocatable :: dyn_columns(:) ! Dyn decomp + ! Maps and values for physics grid + real(r8), pointer :: lonvals(:) + 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 + real(r8), pointer :: area_d(:) + real(r8), pointer :: areawt_d(:) + real(r8) :: mem_hw_beg, mem_hw_end + real(r8) :: mem_beg, mem_end + logical :: unstructured + real(r8) :: temp ! For MPI + integer :: ierr ! For MPI + character(len=hclen), pointer :: copy_attributes(:) + 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) + nullify(areawt_d) + nullify(copy_attributes) + + if (calc_memory_increase) then + call shr_mem_getusage(mem_hw_beg, mem_beg) + end if + + call t_adj_detailf(-2) + call t_startf("phys_grid_init") + + ! Gather info from the dycore + 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 + !!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 + if (index_top_layer < index_bottom_layer) then + index_top_interface = index_top_layer + index_bottom_interface = index_bottom_layer + 1 + else + index_bottom_interface = index_bottom_layer + index_top_interface = index_top_layer + 1 + end if + + if (allocated(phys_columns)) then + deallocate(phys_columns) + end if + 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 + end if + begchunk = 1 + endchunk = begchunk + num_chunks - 1 + else + ! We do not support tasks with no physics columns + call endrun(subname//'No columns on task, use fewer tasks') + end if + allocate(chunks(begchunk:endchunk)) + col_index = 0 + ! Simple chunk assignment + do index = begchunk, endchunk + 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 + 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 + phys_columns(col_index)%phys_chunk_index = phys_col + chunks(index)%phys_cols(phys_col) = col_index + end do + end do + + deallocate(dyn_columns) + + ! Add physics-package grid to set of CAM grids + ! physgrid always uses 'lat' and 'lon' as coordinate names; If dynamics + ! grid is different, it will use different coordinate names + + ! First, create a map for the physics grid + ! It's structure will depend on whether or not the physics grid 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_iMap + if (single_column) grid_map_scm = 0_iMap + allocate(latvals(size(grid_map, 2))) + allocate(lonvals(size(grid_map, 2))) + + lonmin = 1000.0_r8 ! Out of longitude range + latmin = 1000.0_r8 ! Out of latitude range + index = 0 + do ichnk = begchunk, endchunk + ncol = chunks(ichnk)%ncols ! Too soon to call get_ncols_p + do icol = 1, pcols + index = index + 1 + if (icol <= ncol) then + col_index = chunks(ichnk)%phys_cols(icol) + latvals(index) = phys_columns(col_index)%lat_deg + if (latvals(index) < latmin) then + latmin = latvals(index) + end if + lonvals(index) = phys_columns(col_index)%lon_deg + if (lonvals(index) < lonmin) then + lonmin = lonvals(index) + end if + else + col_index = -1 + latvals(index) = 1000.0_r8 + lonvals(index) = 1000.0_r8 + 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) + 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 + end do + end do + + ! Note that if the dycore is using the same points as the physics grid, + ! it will have already set up 'lat' and 'lon' axes for + ! the physics grid + ! However, these will be in the dynamics decomposition + + if (unstructured) then + lon_coord => horiz_coord_create('lon', 'ncol', num_global_phys_cols, & + 'longitude', 'degrees_east', 1, size(lonvals), lonvals, & + map=grid_map(3,:)) + lat_coord => horiz_coord_create('lat', 'ncol', num_global_phys_cols, & + 'latitude', 'degrees_north', 1, size(latvals), latvals, & + map=grid_map(3,:)) + else + allocate(coord_map(size(grid_map, 2))) + ! We need a global minimum longitude and latitude + if (npes > 1) then + temp = lonmin + call MPI_allreduce(temp, lonmin, 1, MPI_INTEGER, MPI_MIN, & + mpicom, ierr) + temp = latmin + call MPI_allreduce(temp, latmin, 1, MPI_INTEGER, MPI_MIN, & + mpicom, ierr) + ! Create lon coord map which only writes from one of each unique lon + where(latvals == latmin) + coord_map(:) = grid_map(3, :) + elsewhere + coord_map(:) = 0_iMap + end where + lon_coord => horiz_coord_create('lon', 'lon', hdim1_d, & + 'longitude', 'degrees_east', 1, size(lonvals), lonvals, & + map=coord_map) + + ! Create lat coord map which only writes from one of each unique lat + where(lonvals == lonmin) + coord_map(:) = grid_map(4, :) + elsewhere + coord_map(:) = 0_iMap + end where + lat_coord => horiz_coord_create('lat', 'lat', hdim2_d, & + 'latitude', 'degrees_north', 1, size(latvals), latvals, & + map=coord_map) + deallocate(coord_map) + end if + 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) + do index = 1, size(copy_attributes) + call cam_grid_attribute_copy(copy_gridname, 'physgrid', & + copy_attributes(index)) + end do + + if (.not. cam_grid_attr_exists('physgrid', 'area')) then + ! Physgrid always needs an area attribute. + if (unstructured) then + ! If we did not inherit one from the dycore (i.e., physics and + ! dynamics are on different grids), create that attribute here + ! (Note, a separate physics grid is only supported for + ! unstructured grids). + allocate(area_d(size(grid_map, 2))) + 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', & + 'physics column areas', 'ncol', area_d, map=grid_map(3,:)) + nullify(area_d) ! Belongs to attribute now + + allocate(areawt_d(size(grid_map, 2))) + 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', & + 'physics column area weight', 'ncol', areawt_d, map=grid_map(3,:)) + nullify(areawt_d) ! Belongs to attribute now + else + call endrun(subname//"No 'area' attribute from dycore") + end if + end if + ! Cleanup pointers (they belong to the grid now) + ! 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. + + call t_stopf("phys_grid_init") + call t_adj_detailf(+2) + + if (calc_memory_increase) then + call shr_mem_getusage(mem_hw_end, mem_end) + temp = mem_end - mem_beg + call MPI_reduce(temp, mem_end, 1, MPI_REAL8, MPI_MAX, masterprocid, & + mpicom, ierr) + if (masterproc) then + write(iulog, *) 'phys_grid_init: Increase in memory usage = ', & + mem_end, ' (MB)' + end if + temp = mem_hw_end - mem_hw_beg + call MPI_reduce(temp, mem_hw_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, ierr) + if (masterproc) then + write(iulog, *) subname, 'Increase in memory highwater = ', & + mem_end, ' (MB)' + end if + end if + + end subroutine phys_grid_init + + !======================================================================== + + integer function chunk_info_to_index_p(lcid, col, subname_in) + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + ! Return the physics column index indicated by + ! (chunk) and (column). + + ! Dummy arguments + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: col ! Column index + character(len=*), optional, intent(in) :: subname_in + ! Local variables + character(len=128) :: errmsg + character(len=*), parameter :: subname = 'chunk_info_to_index_p: ' + + if (.not. phys_grid_initialized()) then + if (present(subname_in)) then + call endrun(trim(subname_in)//'physics grid not initialized') + else + call endrun(subname//'physics grid not initialized') + end if + else if ((lcid < begchunk) .or. (lcid > endchunk)) then + if (present(subname_in)) then + write(errmsg, '(a,3(a,i0))') trim(subname_in), 'lcid (', lcid, & + ') out of range (', begchunk, ' to ', endchunk + else + write(errmsg, '(a,3(a,i0))') subname, 'lcid (', lcid, & + ') out of range (', begchunk, ' to ', endchunk + end if + write(iulog, *) trim(errmsg) + call endrun(trim(errmsg)) + else if ((col < 1) .or. (col > get_ncols_p(lcid))) then + if (present(subname_in)) then + write(errmsg, '(a,2(a,i0))') trim(subname_in), 'col (', col, & + ') out of range (1 to ', get_ncols_p(lcid) + else + write(errmsg, '(a,2(a,i0))') subname, 'col (', col, & + ') out of range (1 to ', get_ncols_p(lcid) + end if + write(iulog, *) trim(errmsg) + call endrun(trim(errmsg)) + end if + chunk_info_to_index_p = chunks(lcid)%phys_cols(col) + end function chunk_info_to_index_p + + !======================================================================== + + logical function phys_grid_initialized() + ! Return .true. if the physics grid is initialized, otherwise .false. + phys_grid_initialized = phys_grid_set + end function phys_grid_initialized + + !======================================================================== + + integer function get_nlcols_p() + get_nlcols_p = phys_columns_on_task + end function get_nlcols_p + + !======================================================================== + + real(r8) function get_rlat_p(lcid, col) + !----------------------------------------------------------------------- + ! + ! get_rlat_p: latitude of a physics column in radians + ! + !----------------------------------------------------------------------- + + ! Dummy argument + integer, intent(in) :: lcid + integer, intent(in) :: col + ! Local variables + integer :: index + character(len=*), parameter :: subname = 'get_rlat_p' + + index = chunk_info_to_index_p(lcid, col, subname_in=subname) + get_rlat_p = phys_columns(index)%lat_rad + + end function get_rlat_p + + !======================================================================== + + real(r8) function get_rlon_p(lcid, col) + !----------------------------------------------------------------------- + ! + ! get_rlon_p: longitude of a physics column in radians + ! + !----------------------------------------------------------------------- + + ! Dummy argument + integer, intent(in) :: lcid + integer, intent(in) :: col + ! Local variables + integer :: index + character(len=*), parameter :: subname = 'get_rlon_p' + + index = chunk_info_to_index_p(lcid, col, subname_in=subname) + get_rlon_p = phys_columns(index)%lon_rad + + end function get_rlon_p + + !======================================================================== + + subroutine get_rlat_all_p(lcid, rlatdim, rlats) + use cam_abortutils, only: endrun + !----------------------------------------------------------------------- + ! + ! get_rlat_all_p: Return all latitudes (in radians) for chunk, + ! + !----------------------------------------------------------------------- + ! Dummy Arguments + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: rlatdim ! declared size of output array + real(r8), intent(out) :: rlats(rlatdim) ! array of latitudes + + ! Local variables + integer :: index ! loop index + integer :: phys_ind + character(len=*), parameter :: subname = 'get_rlat_all_p: ' + + !----------------------------------------------------------------------- + if ((lcid < begchunk) .or. (lcid > endchunk)) then + call endrun(subname//'chunk index out of range') + end if + do index = 1, MIN(get_ncols_p(lcid, subname_in=subname), rlatdim) + phys_ind = chunks(lcid)%phys_cols(index) + rlats(index) = phys_columns(phys_ind)%lat_rad + end do + + end subroutine get_rlat_all_p + + !======================================================================== + + subroutine get_rlon_all_p(lcid, rlondim, rlons) + use cam_abortutils, only: endrun + !----------------------------------------------------------------------- + ! + ! get_rlon_all_p:: Return all longitudes (in radians) for chunk, + ! + !----------------------------------------------------------------------- + ! Dummy Arguments + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: rlondim ! declared size of output array + real(r8), intent(out) :: rlons(rlondim) ! array of longitudes + + ! Local variables + integer :: index ! loop index + integer :: phys_ind + character(len=*), parameter :: subname = 'get_rlon_all_p: ' + + !----------------------------------------------------------------------- + if ((lcid < begchunk) .or. (lcid > endchunk)) then + call endrun(subname//'chunk index out of range') + end if + do index = 1, MIN(get_ncols_p(lcid, subname_in=subname), rlondim) + phys_ind = chunks(lcid)%phys_cols(index) + rlons(index) = phys_columns(phys_ind)%lon_rad + end do + + end subroutine get_rlon_all_p + + !======================================================================== + + real(r8) function get_lat_p(lcid, col) + !----------------------------------------------------------------------- + ! + ! get_lat_p: latitude of a physics column in degrees + ! + !----------------------------------------------------------------------- + + ! Dummy argument + integer, intent(in) :: lcid + integer, intent(in) :: col + ! Local variables + integer :: index + character(len=*), parameter :: subname = 'get_lat_p' + + index = chunk_info_to_index_p(lcid, col, subname_in=subname) + get_lat_p = phys_columns(index)%lat_deg + + end function get_lat_p + + !======================================================================== + + real(r8) function get_lon_p(lcid, col) + !----------------------------------------------------------------------- + ! + ! get_lon_p: longitude of a physics column in degrees + ! + !----------------------------------------------------------------------- + + ! Dummy argument + integer, intent(in) :: lcid + integer, intent(in) :: col + ! Local variables + integer :: index + character(len=*), parameter :: subname = 'get_lon_p' + + index = chunk_info_to_index_p(lcid, col, subname_in=subname) + get_lon_p = phys_columns(index)%lon_deg + + end function get_lon_p + + !======================================================================== + + subroutine get_lat_all_p_r8(lcid, latdim, lats) + use cam_abortutils, only: endrun + !----------------------------------------------------------------------- + ! + ! get_lat_all_p: Return all latitudes (in degrees) for chunk, + ! + !----------------------------------------------------------------------- + ! Dummy Arguments + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: latdim ! declared size of output array + real(r8), intent(out) :: lats(latdim) ! array of latitudes + + ! Local variables + integer :: index ! loop index + integer :: phys_ind + character(len=*), parameter :: subname = 'get_lat_all_p: ' + + !----------------------------------------------------------------------- + if ((lcid < begchunk) .or. (lcid > endchunk)) then + call endrun(subname//'chunk index out of range') + end if + do index = 1, MIN(get_ncols_p(lcid, subname_in=subname), latdim) + phys_ind = chunks(lcid)%phys_cols(index) + lats(index) = phys_columns(phys_ind)%lat_deg + end do + + end subroutine get_lat_all_p_r8 + + !======================================================================== + + subroutine get_lon_all_p_r8(lcid, londim, lons) + use cam_abortutils, only: endrun + !----------------------------------------------------------------------- + ! + ! get_lon_all_p:: Return all longitudes (in degrees) for chunk, + ! + !----------------------------------------------------------------------- + ! Dummy Arguments + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: londim ! declared size of output array + real(r8), intent(out) :: lons(londim) ! array of longitudes + + ! Local variables + integer :: index ! loop index + integer :: phys_ind + character(len=*), parameter :: subname = 'get_lon_all_p: ' + + !----------------------------------------------------------------------- + if ((lcid < begchunk) .or. (lcid > endchunk)) then + call endrun(subname//'chunk index out of range') + end if + do index = 1, MIN(get_ncols_p(lcid, subname_in=subname), londim) + phys_ind = chunks(lcid)%phys_cols(index) + lons(index) = phys_columns(phys_ind)%lon_deg + end do + + end subroutine get_lon_all_p_r8 + + !======================================================================== + + subroutine get_area_all_p(lcid, areadim, areas) + use cam_abortutils, only: endrun + !----------------------------------------------------------------------- + ! + ! get_area_all_p: Return all areas for chunk, + ! + !----------------------------------------------------------------------- + ! Dummy Arguments + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: areadim ! declared size of output array + real(r8), intent(out) :: areas(areadim) ! array of areas + + ! Local variables + integer :: index ! loop index + integer :: phys_ind + character(len=*), parameter :: subname = 'get_area_all_p: ' + + !----------------------------------------------------------------------- + if ((lcid < begchunk) .or. (lcid > endchunk)) then + call endrun(subname//'chunk index out of range') + end if + do index = 1, MIN(get_ncols_p(lcid, subname_in=subname), areadim) + phys_ind = chunks(lcid)%phys_cols(index) + areas(index) = phys_columns(phys_ind)%area + end do + + end subroutine get_area_all_p + + !======================================================================== + + subroutine get_wght_all_p(lcid, wghtdim, wghts) + use cam_abortutils, only: endrun + !----------------------------------------------------------------------- + ! + ! get_wght_all_p: Return all weights for chunk, + ! + !----------------------------------------------------------------------- + ! Dummy Arguments + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: wghtdim ! declared size of output array + real(r8), intent(out) :: wghts(wghtdim) ! array of weights + + ! Local variables + integer :: index ! loop index + integer :: phys_ind + character(len=*), parameter :: subname = 'get_wght_all_p: ' + + !----------------------------------------------------------------------- + if ((lcid < begchunk) .or. (lcid > endchunk)) then + call endrun(subname//'chunk index out of range') + end if + do index = 1, MIN(get_ncols_p(lcid, subname_in=subname), wghtdim) + phys_ind = chunks(lcid)%phys_cols(index) + wghts(index) = phys_columns(phys_ind)%weight + end do + + end subroutine get_wght_all_p + + !======================================================================== + + integer function get_ncols_p(lcid, subname_in) + use cam_abortutils, only: endrun + !----------------------------------------------------------------------- + ! + ! get_ncols_p: Return number of columns in chunk given the local chunk id. + ! + !----------------------------------------------------------------------- + ! Dummy arguments + integer, intent(in) :: lcid ! local chunk id + character(len=*), optional, intent(in) :: subname_in + + if (.not. phys_grid_initialized()) then + if (present(subname_in)) then + call endrun(trim(subname_in)//'physics grid not initialized') + else + call endrun('get_ncols_p: physics grid not initialized') + end if + else + get_ncols_p = chunks(lcid)%ncols + end if + + end function get_ncols_p + + !======================================================================== + + real(r8) function get_area_p(lcid, col) + ! area of a physics column in radians squared + + ! Dummy arguments + integer, intent(in) :: lcid ! Chunk number + integer, intent(in) :: col ! column + ! Local variables + integer :: index + character(len=*), parameter :: subname = 'get_area_p' + + index = chunk_info_to_index_p(lcid, col, subname_in=subname) + get_area_p = phys_columns(index)%area + + end function get_area_p + + !======================================================================== + + real(r8) function get_wght_p(lcid, col) + ! weight of a physics column in radians squared + + ! Dummy arguments + integer, intent(in) :: lcid ! Chunk number + integer, intent(in) :: col ! column + ! Local variables + integer :: index + character(len=*), parameter :: subname = 'get_wght_p' + + index = chunk_info_to_index_p(lcid, col, subname_in=subname) + get_wght_p = phys_columns(index)%weight + + end function get_wght_p + + !======================================================================== + + integer function get_gcol_p(lcid, col) + ! global column index of a physics column + + ! Dummy arguments + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: col ! column index + ! Local variables + integer :: index + character(len=*), parameter :: subname = 'get_gcol_p: ' + + index = chunk_info_to_index_p(lcid, col, subname_in=subname) + get_gcol_p = phys_columns(index)%global_col_num + + end function get_gcol_p + + !======================================================================== + + subroutine get_dyn_col_p_chunk(lcid, col, blk_num, blk_ind, caller) + use cam_abortutils, only: endrun + ! Return the dynamics local block number and block offset(s) for + ! the physics column indicated by (chunk) and (column). + + ! Dummy arguments + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: col ! Column index + integer, intent(out) :: blk_num ! Local dynamics block index + integer, intent(out) :: blk_ind(:) ! Local dynamics block offset(s) + character(len=*), optional, intent(in) :: caller ! Calling routine + ! Local variables + integer :: index + integer :: off_size + character(len=*), parameter :: subname = 'get_dyn_col_p_chunk: ' + + index = chunk_info_to_index_p(lcid, col) + off_size = SIZE(phys_columns(index)%dyn_block_index, 1) + if (SIZE(blk_ind, 1) < off_size) then + if (present(caller)) then + call endrun(trim(caller)//': blk_ind too small') + else + call endrun(subname//'blk_ind too small') + end if + end if + blk_num = phys_columns(index)%local_dyn_block + blk_ind(1:off_size) = phys_columns(index)%dyn_block_index(1:off_size) + if (SIZE(blk_ind, 1) > off_size) then + blk_ind(off_size+1:) = -1 + end if + + end subroutine get_dyn_col_p_chunk + + !======================================================================== + + subroutine get_dyn_col_p_index(index, blk_num, blk_ind) + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + ! Return the dynamics local block number and block offset(s) for + ! the physics column indicated by . + + ! Dummy arguments + integer, intent(in) :: index ! index of local physics column + integer, intent(out) :: blk_num ! Local dynamics block index + integer, intent(out) :: blk_ind(:) ! Local dynamics block offset(s) + ! Local variables + integer :: off_size + character(len=128) :: errmsg + character(len=*), parameter :: subname = 'get_dyn_col_p_index: ' + + if (.not. phys_grid_initialized()) then + call endrun(subname//'physics grid not initialized') + else if ((index < 1) .or. (index > columns_on_task)) then + write(errmsg, '(a,2(a,i0))') subname, 'index (', index, & + ') out of range (1 to ', columns_on_task + write(iulog, *) trim(errmsg) + call endrun(trim(errmsg)) + else + off_size = SIZE(phys_columns(index)%dyn_block_index, 1) + if (SIZE(blk_ind, 1) < off_size) then + call endrun(subname//'blk_ind too small') + end if + blk_num = phys_columns(index)%local_dyn_block + blk_ind(1:off_size) = phys_columns(index)%dyn_block_index(1:off_size) + if (SIZE(blk_ind, 1) > off_size) then + blk_ind(off_size+1:) = -1 + end if + end if + + end subroutine get_dyn_col_p_index + + !======================================================================== + + subroutine get_gcol_all_p(lcid, gdim, gcols) + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + ! collect global column indices of all physics columns in a chunk + + ! Dummy arguments + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: gdim ! gcols dimension + integer, intent(out) :: gcols(:) ! global column indices + ! Local variables + integer :: ncol, col_ind + character(len=128) :: errmsg + character(len=*), parameter :: subname = 'get_gcol_all_p: ' + + if (.not. phys_grid_initialized()) then + call endrun(subname//'physics grid not initialized') + else if ((lcid < begchunk) .or. (lcid > endchunk)) then + write(errmsg, '(a,3(a,i0))') subname, 'lcid (', lcid, & + ') out of range (', begchunk, ' to ', endchunk + write(iulog, *) trim(errmsg) + call endrun(trim(errmsg)) + else + ncol = chunks(lcid)%ncols + if (gdim < ncol) then + if (masterproc) then + write(iulog, '(2a,2(i0,a))') subname, 'WARNING: gdim (', gdim, & + ') < ncol (', ncol,'), not all indices will be filled.' + end if + gcols(gdim+1:ncol) = -1 + end if + do col_ind = 1, MIN(ncol, gdim) + gcols(col_ind) = get_gcol_p(lcid, col_ind) + end do + end if + + end subroutine get_gcol_all_p + + !======================================================================== + + subroutine get_chunk_info_p(index, lchnk, icol) + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + ! local chunk index and column number of a physics column + + ! Dummy arguments + integer, intent(in) :: index + integer, intent(out) :: lchnk + integer, intent(out) :: icol + ! Local variables + character(len=128) :: errmsg + character(len=*), parameter :: subname = 'get_chunk_info_p: ' + + if (.not. phys_grid_initialized()) then + call endrun(subname//': physics grid not initialized') + else if ((index < 1) .or. (index > columns_on_task)) then + write(errmsg, '(a,2(a,i0))') subname, 'index (', index, & + ') out of range (1 to ', columns_on_task + write(iulog, *) errmsg + call endrun(errmsg) + else + lchnk = phys_columns(index)%local_phys_chunk + icol = phys_columns(index)%phys_chunk_index + end if + + end subroutine get_chunk_info_p + + !======================================================================== + + subroutine get_grid_dims(hdim1_d_out, hdim2_d_out) + use cam_abortutils, only: endrun + ! retrieve dynamics field grid information + ! hdim1_d and hdim2_d are dimensions of rectangular horizontal grid + ! data structure, If 1D data structure, then hdim2_d == 1. + integer, intent(out) :: hdim1_d_out + integer, intent(out) :: hdim2_d_out + + if (.not. phys_grid_initialized()) then + call endrun('get_grid_dims: physics grid not initialized') + end if + hdim1_d_out = hdim1_d + hdim2_d_out = hdim2_d + + end subroutine get_grid_dims + + !======================================================================== + + ! Note: This routine is a stub for future load-balancing + subroutine phys_decomp_to_dyn() + !----------------------------------------------------------------------- + ! + ! phys_decomp_to_dyn: Transfer physics data to dynamics decomp + ! + !----------------------------------------------------------------------- + end subroutine phys_decomp_to_dyn + + !======================================================================== + + ! Note: This routine is a stub for future load-balancing + subroutine dyn_decomp_to_phys() + !----------------------------------------------------------------------- + ! + ! dyn_decomp_to_phys: Transfer dynamics data to physics decomp + ! + !----------------------------------------------------------------------- + + end subroutine dyn_decomp_to_phys + + !======================================================================== + + subroutine dump_grid_map(grid_map) + use spmd_utils, only: iam, npes, mpicom + use cam_grid_support, only: iMap + + integer(iMap), pointer :: grid_map(:,:) + + integer :: num_cols + integer :: penum, icol + logical :: unstruct + integer :: file + integer :: ierr + + unstruct = SIZE(grid_map, 1) == 3 + num_cols = SIZE(grid_map, 2) + if (iam == 0) then + open(newunit=file, file='physgrid_map.csv', status='replace') + if (unstruct) then + write(file, *) '"iam","col","block","map pos"' + else + write(file, *) '"iam","col","block","lon","lat"' + end if + close(unit=file) + end if + do penum = 0, npes - 1 + if (iam == penum) then + open(newunit=file, file='physgrid_map.csv', status='old', & + action='readwrite', position='append') + do icol = 1, num_cols + if (unstruct) then + write(file, '(3(i0,","),i0)') iam, int(grid_map(1,icol)), & + int(grid_map(2,icol)), int(grid_map(3,icol)) + else + write(file, '(4(i0,","),i0)') iam, int(grid_map(1,icol)), & + int(grid_map(2,icol)), int(grid_map(3,icol)), & + int(grid_map(4,icol)) + end if + end do + close(unit=file) + end if + call MPI_barrier(mpicom, ierr) + end do + end subroutine dump_grid_map + +!============================================================================= +!== +!!!!!! DUMMY INTERFACEs TO TEST WEAK SCALING INFRASTRUCTURE, SHOULD GO AWAY +!== +!============================================================================= + + subroutine scatter_field_to_chunk(fdim,mdim,ldim, & + hdim1d,globalfield,localchunks) + use cam_abortutils, only: endrun + !----------------------------------------------------------------------- + ! + ! Purpose: DUMMY FOR WEAK SCALING TESTS + ! + !------------------------------Arguments-------------------------------- + integer, intent(in) :: fdim ! declared length of first dimension + integer, intent(in) :: mdim ! declared length of middle dimension + integer, intent(in) :: ldim ! declared length of last dimension + integer, intent(in) :: hdim1d ! declared first horizontal index + real(r8), intent(in) :: globalfield(fdim,hdim1d,mdim,hdim2_d,ldim) + real(r8), intent(out):: localchunks(fdim,pcols,mdim, & + begchunk:endchunk,ldim) + + call endrun('scatter_field_to_chunk: NOT SUPPORTED WITH WEAK SCALING') + end subroutine scatter_field_to_chunk + + !======================================================================== + + subroutine get_lat_all_p_int(lcid, latdim, lats) + use cam_abortutils, only: endrun + !----------------------------------------------------------------------- + ! + ! get_lat_all_p: Return all latitudes (in degrees) for chunk, + ! + !----------------------------------------------------------------------- + ! Dummy Arguments + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: latdim ! declared size of output array + integer, intent(out) :: lats(latdim) ! array of latitudes + + call endrun('get_lat_all_p: deprecated interface') + + end subroutine get_lat_all_p_int + + !======================================================================== + + subroutine get_lon_all_p_int(lcid, londim, lons) + use cam_abortutils, only: endrun + !----------------------------------------------------------------------- + ! + ! get_lon_all_p:: Return all longitudes (in degrees) for chunk, + ! + !----------------------------------------------------------------------- + ! Dummy Arguments + integer, intent(in) :: lcid ! local chunk id + integer, intent(in) :: londim ! declared size of output array + integer, intent(out) :: lons(londim) ! array of longitudes + + call endrun('get_lon_all_p: deprecated interface') + + end subroutine get_lon_all_p_int + + !======================================================================== + +end module phys_grid diff --git a/src/infrastructure/physics_column_type.F90 b/src/infrastructure/physics_column_type.F90 new file mode 100644 index 0000000000..d025684021 --- /dev/null +++ b/src/infrastructure/physics_column_type.F90 @@ -0,0 +1,67 @@ +module physics_column_type + + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + private + save + + type, public :: physics_column_t + ! A type to hold all grid and task information for a single physics column + ! Column information + real(r8) :: lat_rad = -HUGE(1.0_r8) ! Latitude in radians + real(r8) :: lon_rad = -HUGE(1.0_r8) ! Longitude in radians + real(r8) :: lat_deg = -HUGE(1.0_r8) ! Latitude in degrees + real(r8) :: lon_deg = -HUGE(1.0_r8) ! Longitude in degrees + real(r8) :: area = -1.0_r8 ! Column area + real(r8) :: weight = -1.0_r8 ! Col integration weight + ! File decomposition + integer :: global_col_num = -1 ! Location on data file + integer :: coord_indices(2) = -1 ! Global lon/lat (if used) + ! Dynamics decomposition + integer :: dyn_task = -1 ! Dynamics MPI task + integer :: local_dyn_block = -1 ! Block num for this task + integer :: global_dyn_block = -1 ! Global dyn block number + ! If there is more than one block index, they are in the same order + ! as in the dynamics block structure + integer, allocatable :: dyn_block_index(:) ! Index(cies) into block + ! Physics decomposition + integer :: phys_task = -1 ! Physics MPI task + integer :: local_phys_chunk = -1 ! Local phys 'block' num + integer :: phys_chunk_index = -1 ! Index into physics chunk + contains + procedure :: copyColumn + generic :: assignment(=) => copyColumn + end type physics_column_t + +!============================================================================== +CONTAINS +!============================================================================== + + subroutine copyColumn(outCol, inCol) + ! Dummy arguments + class(physics_column_t), intent(inout) :: outCol + type(physics_column_t), intent(in) :: inCol + ! Local variables + integer :: nind ! # dynamics indices + + outCol%lat_rad = inCol%lat_rad + outCol%lon_rad = inCol%lon_rad + outCol%lat_deg = inCol%lat_deg + outCol%lon_deg = inCol%lon_deg + outCol%area = inCol%area + outCol%weight = inCol%weight + outCol%global_col_num = inCol%global_col_num + outCol%coord_indices(:) = inCol%coord_indices(2) + outCol%dyn_task = inCol%dyn_task + outCol%local_dyn_block = inCol%local_dyn_block + outCol%global_dyn_block = inCol%global_dyn_block + nind = SIZE(inCol%dyn_block_index) + allocate(outCol%dyn_block_index(nind)) + outCol%dyn_block_index(:) = inCol%dyn_block_index(:) + outCol%phys_task = inCol%phys_task + outCol%local_phys_chunk = inCol%local_phys_chunk + outCol%phys_chunk_index = inCol%phys_chunk_index + end subroutine copyColumn + +end module physics_column_type diff --git a/src/ionosphere/ionosphere_interface.F90 b/src/ionosphere/ionosphere_interface.F90 index bf12f4e37c..4b7802010c 100644 --- a/src/ionosphere/ionosphere_interface.F90 +++ b/src/ionosphere/ionosphere_interface.F90 @@ -28,7 +28,7 @@ end subroutine ionosphere_readnl !-------------------------------------------------------------------------------- !-------------------------------------------------------------------------------- subroutine ionosphere_init() - + end subroutine ionosphere_init !-------------------------------------------------------------------------------- @@ -42,17 +42,13 @@ end subroutine ionosphere_run1 !-------------------------------------------------------------------------------- !-------------------------------------------------------------------------------- - subroutine ionosphere_run2( phys_state, dyn_in, pbuf2d ) - + subroutine ionosphere_run2( phys_state, pbuf2d ) + use ppgrid, only: begchunk, endchunk use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc - use phys_grid, only: begchunk, endchunk - use dyn_comp, only: dyn_import_t ! args type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - type(dyn_import_t), intent(in) :: dyn_in ! dynamics import - type(physics_buffer_desc), pointer :: pbuf2d(:,:) end subroutine ionosphere_run2 diff --git a/src/ionosphere/waccmx/adotv_mod.F90 b/src/ionosphere/waccmx/adotv_mod.F90 new file mode 100644 index 0000000000..1c2f64ef2b --- /dev/null +++ b/src/ionosphere/waccmx/adotv_mod.F90 @@ -0,0 +1,104 @@ +module adotv_mod + use shr_kind_mod,only: r8 => shr_kind_r8 ! 8-byte reals + + implicit none + +contains + + subroutine calc_adotv(z, un, vn, wn, adotv1, adotv2, adota1, adota2, & + a1dta2, be3, sini, lev0, lev1, lon0, lon1, lat0, lat1) + ! + ! Calculate adotv1,2, adota1,2, a1dta2 and be3. + ! All fields should be on O+ grid + ! + use edyn_params, only: r0,h0 + use edyn_geogrid, only: jspole, jnpole + use getapex, only: & + zb, & ! downward component of magnetic field + bmod, & ! magnitude of magnetic field (gauss) + dvec, & ! (nlonp1,nlat,3,2) + dddarr, & ! (nlonp1,nlat) + be3arr, & ! (nlonp1,nlat) + alatm ! (nlonp1,0:nlatp1) + ! + ! Args: + integer,intent(in) :: lev0, lev1, lon0, lon1, lat0, lat1 + real(r8), dimension(lev0:lev1,lon0:lon1,lat0:lat1), intent(in) :: & + z, & ! geopotential height (cm) + un, & ! neutral zonal velocity (cm/s) + vn ! neutral meridional velocity (cm/s) + real(r8), dimension(lev0:lev1,lon0:lon1,lat0:lat1), intent(in) :: & + wn ! vertical velocity (cm/s) + + real(r8), dimension(lon0:lon1,lat0:lat1,lev0:lev1), intent(out) :: & + adotv1, adotv2 + real(r8), dimension(lon0:lon1,lat0:lat1), intent(out) :: & + adota1, adota2, a1dta2, be3, sini + ! + ! Local: + integer :: k, i, j + real(r8) :: r0or, rat, sinalat + real(r8) :: clm2(lon0:lon1,lat0:lat1) + ! + adotv1 = 0.0_r8 + adotv2 = 0.0_r8 + adota1 = 0.0_r8 + adota2 = 0.0_r8 + a1dta2 = 0.0_r8 + be3 = 0.0_r8 + sini = 0.0_r8 + + do j = lat0, lat1 + do i = lon0, lon1 + sinalat = sin(alatm(i,j)) ! sin(lam) + clm2(i,j) = 1._r8 - (sinalat * sinalat) ! cos^2(lam) + be3(i,j) = 1.e-9_r8*be3arr(i,j) ! be3 is in T (be3arr in nT) + sini(i,j) = zb(i,j)/bmod(i,j) ! sin(I_m) + + do k=lev0,lev1-1 + ! + ! d_1 = (R_0/R)^1.5 + r0or = r0/(r0 + 0.5_r8* (z(k,i,j) + z(k+1,i,j)) - h0) + rat = 1.e-2_r8*r0or**1.5_r8 ! 1/100 conversion in cm + ! + ! A_1 dot V = fac( d_1(1) u + d_1(2) v + d_1(3) w + adotv1(i,j,k) = rat*( & + dvec(i,j,1,1) * un(k,i,j) + & + dvec(i,j,2,1) * vn(k,i,j) + & + dvec(i,j,3,1) * wn(k,i,j)) + + ! + ! Note: clm2 is being used here to represent the squared cosine + ! of the quasi-dipole latitude, not of the M(90) latitude, + ! since the wind values are aligned vertically, + ! not along the field line. + ! + rat = rat * sqrt((4._r8 - (3._r8 * clm2(i,j))) / & + (4._r8 - (3._r8 * r0or * clm2(i,j)))) + ! + ! A_2 dot V = fac( d_2(1) u + d_2(2) v + d_2(3) w + adotv2(i,j,k) = rat * ( & + dvec(i,j,1,2) * un(k,i,j) + & + dvec(i,j,2,2) * vn(k,i,j) + & + dvec(i,j,3,2) * wn(k,i,j)) + end do ! k=lev0,lev1-1 + + ! + ! Calculation of adota(n) = d(n)**2/D + ! a1dta2 = (d(1) dot d(2)) /D + ! + adota1(i,j) = (dvec(i,j,1,1)**2 + dvec(i,j,2,1)**2 + & + dvec(i,j,3,1)**2) / dddarr(i,j) + adota2(i,j) = (dvec(i,j,1,2)**2 + dvec(i,j,2,2)**2 + & + dvec(i,j,3,2)**2) / dddarr(i,j) + a1dta2(i,j) = (dvec(i,j,1,1) * dvec(i,j,1,2) + & + dvec(i,j,2,1) * dvec(i,j,2,2) + & + dvec(i,j,3,1) * dvec(i,j,3,2)) / dddarr(i,j) + end do ! i=lon0,lon1 + + end do ! j=lat0,lat1 + + end subroutine calc_adotv + + +end module adotv_mod diff --git a/src/ionosphere/waccmx/amie.F90 b/src/ionosphere/waccmx/amie.F90 deleted file mode 100644 index 07d6a102ac..0000000000 --- a/src/ionosphere/waccmx/amie.F90 +++ /dev/null @@ -1,1088 +0,0 @@ -module amie_module - ! - ! Module used to read data from the AMIE outputs (POT,mean energy, - ! and energy flux). - ! - - use shr_kind_mod ,only: r8 => shr_kind_r8 - use cam_logfile ,only: iulog - use spmd_utils ,only: masterproc - use cam_abortutils ,only: endrun - use edyn_maggrid, only: nmlat,nmlonp1 - use edyn_mpi ,only: mlon0,mlon1,mlat0,mlat1, & - lon0,lon1,lat0,lat1 -#ifdef WACCMX_EDYN_ESMF - use edyn_params ,only: finit - use edyn_maggrid ,only: & - ylonm, & ! magnetic latitudes (nmlat) (radians) - ylatm ! magnetic longtitudes (nmlonp1) (radians) - use edyn_esmf ,only: mag_efx,mag_kev,geo_efx,geo_kev - use esmf ,only: ESMF_FIELD ! ESMF library module - use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile - use pio, only: pio_inq_dimid, pio_inquire_dimension, pio_inquire, pio_inq_varid - use pio, only: file_desc_t, pio_noerr, pio_nowrite, pio_get_var -#endif - implicit none - - private - public :: init_amie, getamie -#ifdef WACCMX_EDYN_ESMF - - ! Define parameters for AMIE input data file: - integer, parameter :: & - mxgdays = 10, & ! maximum number of days of AMIE data - mxtimes = 5881, & ! maximum number of times of AMIE data per day - ithtrns = 30, & ! corresponding to trans lat 40-deg - ithmx = 55, & ! maximum number of latitudes of AMIE data - jmxm = 2*ithmx-1, & ! maximum number of global latitudes - lonmx = 36 ! maximum number of longitudes of AMIE data - integer :: lonp1,latp1 - ! integer,dimension(mxtimes) :: year,month,day,jday - ! Define AMIE output fields - real(r8) :: & - tiepot(nmlonp1,nmlat),tieekv(nmlonp1,nmlat), & - tieefx(nmlonp1,nmlat) - ! defined output AMIE fields in TGCM geographic grid - ! real,dimension(nlonp4,nlat) :: - ! | potg_sech, ekvg_sech, efxg_sech - ! real,dimension(nmlonp1,-2:nlevp1) :: tiepot_sech - ! - ! Define fields for AMIE input data file: - ! electric potential in Volt - ! mean energy in KeV - ! energy flux in W/m^2 - ! amie_cusplat_nh(sh) and amie_cuspmlt_nh(sh) are - ! AMIE cusp latitude and MLT in NH and SH - ! amie_hpi_nh(sh) are AMIE hemi-integrated power - ! amie_pcp_nh(sh) are AMIE polar-cap potential drop - ! Saved AMIE outputs with suffix _amie - ! - real(r8),allocatable,dimension(:,:,:),save :: & ! (lonp1,latp1,ntimes) - amie_pot_nh, amie_pot_sh, amie_ekv_nh, amie_ekv_sh, & - amie_efx_nh, amie_efx_sh - real(r8),allocatable,dimension(:,:),save :: & ! (lonp1,latp1) - pot_nh_amie,pot_sh_amie, ekv_nh_amie,ekv_sh_amie, & - efx_nh_amie,efx_sh_amie - integer, allocatable,dimension(:),save :: & ! (ntimes) - year,month,day,jday - real(r8), allocatable,dimension(:),save :: & ! (ntimes) - amie_cusplat_nh, amie_cuspmlt_nh, amie_hpi_nh, & - amie_pcp_nh, amie_nh_ut, & - amie_cusplat_sh, amie_cuspmlt_sh, amie_hpi_sh, & - amie_pcp_sh, amie_sh_ut - real(r8) :: & - cusplat_nh_amie, cuspmlt_nh_amie, cusplat_sh_amie, & - cuspmlt_sh_amie, hpi_sh_amie, hpi_nh_amie, pcp_sh_amie, & - pcp_nh_amie - ! -#endif - -contains - !----------------------------------------------------------------------- - subroutine init_amie(amienh,amiesh) - ! - ! Called from tgcm.F - ! (this is not in init.F to avoid circular dependencies) - ! - character(len=*),intent(in) :: amienh, amiesh - -#ifdef WACCMX_EDYN_ESMF - ! read north hemisphere file: - if (len_trim(amienh) > 0) then - if (masterproc) write(iulog,"('Reading AMIENH file ',a)") trim(amienh) - call rdamie_nh(amienh) - end if - ! - ! Read south hemisphere file: - if (len_trim(amiesh) > 0) then - if (masterproc) write(iulog,"('Reading AMIESH file ',a)") trim(amiesh) - call rdamie_sh(amiesh) - end if -#else - call endrun('Cannot use AMIE without electro-dynamo active.') -#endif - end subroutine init_amie -#ifdef WACCMX_EDYN_ESMF - !----------------------------------------------------------------------- - subroutine rdamie_nh(amienh) - ! - ! Read AMIE data for the northern hemisphere from amienh - ! - ! Local: - - character(len=*),intent(in) :: amienh - integer :: istat,ntimes,ndims,nvars,ngatts,idunlim,ier - integer :: id_lon,id_lat,id_time, & - idv_year,idv_mon,idv_day,idv_jday, & - idv_ut,idv_pot,idv_ekv, & - idv_efx,idv_cusplat,idv_cuspmlt,idv_hpi,idv_pcp - type(file_desc_t) :: ncid - ! - if (masterproc) write(iulog,"(/,72('-'))") - if (masterproc) write(iulog,"('RDAMIE_NH: read AMIE data for northern hemisphere:')") - ! - ! Open netcdf file: - call cam_pio_openfile(ncid, amienh, pio_nowrite) - ! - ! Get AMIE grid dimension: - istat = pio_inq_dimid(ncid,'lon',id_lon) - istat = pio_inquire_dimension(ncid,id_lon,len=lonp1) - if (istat /= pio_noerr) call rpt_ncerr(istat, 'rdamie_nh: Error getting AMIE longitude dimension') - - istat = pio_inq_dimid(ncid,'lat',id_lat) - istat = pio_inquire_dimension(ncid,id_lat,len=latp1) - if (istat /= pio_noerr) call rpt_ncerr(istat, 'rdamie_nh: Error getting AMIE latitude dimension') - ! write(iulog,"('lonp1=',i3,' latp1=',i3)") lonp1,latp1 - ! - ! Get time dimension: - istat = pio_inquire(ncid,unlimiteddimid=id_time) - istat = pio_inquire_dimension(ncid,id_time,len=ntimes) - ! - ! Search for requested AMIE output fields - istat = pio_inquire(ncid,ndims,nvars,ngatts,idunlim) - ! - ! Get 1-D AMIE fields (ntimes) - if (.not. allocated(year)) allocate(year(ntimes),stat=ier) - istat = pio_inq_varid(ncid,'year',idv_year) - istat = pio_get_var(ncid,idv_year,year) - ! write(iulog,*)'rdamie_nh: year=', year(1:10) - if (.not. allocated(month)) allocate(month(ntimes),stat=ier) - istat = pio_inq_varid(ncid,'month',idv_mon) - istat = pio_get_var(ncid,idv_mon,month) - if (.not. allocated(day)) allocate(day(ntimes),stat=ier) - istat = pio_inq_varid(ncid,'day',idv_day) - istat = pio_get_var(ncid,idv_day,day) - ! write(iulog,*)'rdamie_nh: day=', day(1:10) - if (.not. allocated(jday)) allocate(jday(ntimes),stat=ier) - istat = pio_inq_varid(ncid,'jday',idv_jday) - istat = pio_get_var(ncid,idv_jday,jday) - ! - ! Allocate 1-d fields: - if (.not. allocated(amie_nh_ut)) & - allocate(amie_nh_ut(ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_nh: error allocating', & - ' amie_nh_ut: ntimes=',i3)")ntimes - if (.not. allocated(amie_cusplat_nh)) & - allocate(amie_cusplat_nh(ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_nh: error allocating', & - ' amie_cusplat_nh: ntimes=',i3)")ntimes - if (.not. allocated(amie_cuspmlt_nh)) & - allocate(amie_cuspmlt_nh(ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_nh: error allocating', & - ' amie_cuspmlt_nh: ntimes=',i3)")ntimes - if (.not. allocated(amie_hpi_nh)) & - allocate(amie_hpi_nh(ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_nh: error allocating', & - ' amie_hpi_nh: ntimes=',i3)")ntimes - if (.not. allocated(amie_pcp_nh)) & - allocate(amie_pcp_nh(ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_nh: error allocating', & - ' amie_pcp_nh: ntimes=',i3)")ntimes - ! - ! Get ut - istat = pio_inq_varid(ncid,'ut',idv_ut) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE UT id') - istat = pio_get_var(ncid,idv_ut,amie_nh_ut) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE variable ut') - ! - ! Get HPI - istat = pio_inq_varid(ncid,'hpi',idv_hpi) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE hpi id') - istat = pio_get_var(ncid,idv_hpi,amie_hpi_nh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE variable hpi') - ! - ! Get PCP - istat = pio_inq_varid(ncid,'pcp',idv_pcp) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE pcp id') - istat = pio_get_var(ncid,idv_pcp,amie_pcp_nh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE variable pcp') - ! - ! Get cusplat - istat = pio_inq_varid(ncid,'cusplat',idv_cusplat) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE cusplat id') - istat = pio_get_var(ncid,idv_cusplat,amie_cusplat_nh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE variable cusplat') - ! - ! Get cuspmlt - istat = pio_inq_varid(ncid,'cuspmlt',idv_cuspmlt) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE cusplat id') - istat = pio_get_var(ncid,idv_cuspmlt,amie_cuspmlt_nh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE variable cuspmlt') - ! - ! Allocate 2-d fields: - if (.not. allocated(pot_nh_amie)) & - allocate(pot_nh_amie(lonp1,latp1),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_nh: error allocating', & - ' pot_nh_amie: lonp1=',i3,' latp1=',i3)")lonp1,latp1 - if (.not. allocated(ekv_nh_amie)) & - allocate(ekv_nh_amie(lonp1,latp1),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_nh: error allocating', & - ' ekv_nh_amie: lonp1=',i3,' latp1=',i3)")lonp1,latp1 - if (.not. allocated(efx_nh_amie)) & - allocate(efx_nh_amie(lonp1,latp1),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_nh: error allocating', & - ' efx_nh_amie: lonp1=',i3,' latp1=',i3)")lonp1,latp1 - ! - ! Allocate 3-d fields: - if (.not. allocated(amie_pot_nh)) & - allocate(amie_pot_nh(lonp1,latp1,ntimes),stat=ier) - if (ier /= 0) WRITE(iulog,"('>>> rdamie_nh: error allocating', & - ' amie_pot_nh: lonp1=',i3,' latp1=',i3,' ntimes=',i3)") & - lonp1,latp1,ntimes - if (.not. allocated(amie_ekv_nh)) & - allocate(amie_ekv_nh(lonp1,latp1,ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_nh: error allocating', & - ' amie_ekv_nh: lonp1=',i3,' latp1=',i3,' ntimes=',i3)") & - lonp1,latp1,ntimes - if (.not. allocated(amie_efx_nh)) & - allocate(amie_efx_nh(lonp1,latp1,ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_nh: error allocating', & - ' amie_efx_nh: lonp1=',i3,' latp1=',i3,' ntimes=',i3)") & - lonp1,latp1,ntimes - ! - ! Get 3-D AMIE fields (lon,lat,ntimes) - ! - ! AMIE electric potential - istat = pio_inq_varid(ncid,'pot',idv_pot) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE electric potential id') - istat = pio_get_var(ncid,idv_pot,amie_pot_nh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE variable pot') - ! - ! AMIE mean energy - istat = pio_inq_varid(ncid,'ekv',idv_ekv) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE mean energy id') - istat = pio_get_var(ncid,idv_ekv,amie_ekv_nh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE variable ekv') - ! - ! AMIE energy flux - istat = pio_inq_varid(ncid,'efx',idv_efx) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE energy flux id') - istat = pio_get_var(ncid,idv_efx,amie_efx_nh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_nh: Error getting NH AMIE variable efx') - ! - ! Close the file: - call cam_pio_closefile(ncid) - if (masterproc) & - write(iulog,"('Completed read from NH AMIE data file ',a)") trim(amienh) - if (masterproc) write(iulog,"(72('-'),/)") - end subroutine rdamie_nh - !----------------------------------------------------------------------- - subroutine rdamie_sh(amiesh) - ! - ! Read AMIE data for the northern hemisphere from amiesh - ! - ! Local: - - character(len=*),intent(in) :: amiesh - integer :: istat,ntimes,ndims,nvars,ngatts,idunlim,ier - integer :: id_lon,id_lat,id_time, & - idv_year,idv_mon,idv_day,idv_jday, & - idv_ut,idv_pot,idv_ekv, & - idv_efx,idv_cusplat,idv_cuspmlt,idv_hpi,idv_pcp - type(file_desc_t) :: ncid - ! - if (masterproc) write(iulog,"(/,72('-'))") - if (masterproc) write(iulog,"('RDAMIE_SH: read AMIE data for northern hemisphere:')") - ! - ! Open netcdf file: - call cam_pio_openfile(ncid, amiesh, pio_nowrite) - ! - ! Get AMIE grid dimension: - istat = pio_inq_dimid(ncid,'lon',id_lon) - istat = pio_inquire_dimension(ncid,id_lon,len=lonp1) - if (istat /= pio_noerr) call rpt_ncerr(istat, 'rdamie_sh: Error getting AMIE longitude dimension') - - istat = pio_inq_dimid(ncid,'lat',id_lat) - istat = pio_inquire_dimension(ncid,id_lat,len=latp1) - if (istat /= pio_noerr) call rpt_ncerr(istat, 'rdamie_sh: Error getting AMIE latitude dimension') - ! write(iulog,"('lonp1=',i3,' latp1=',i3)") lonp1,latp1 - ! - ! Get time dimension: - istat = pio_inquire(ncid,unlimiteddimid=id_time) - istat = pio_inquire_dimension(ncid,id_time,len=ntimes) - ! - ! Search for requested AMIE output fields - istat = pio_inquire(ncid,ndims,nvars,ngatts,idunlim) - ! - ! Get 1-D AMIE fields (ntimes) - if (.not. allocated(year)) allocate(year(ntimes),stat=ier) - istat = pio_inq_varid(ncid,'year',idv_year) - istat = pio_get_var(ncid,idv_year,year) - ! write(iulog,*)'rdamie_sh: year=', year(1:10) - if (.not. allocated(month)) allocate(month(ntimes),stat=ier) - istat = pio_inq_varid(ncid,'month',idv_mon) - istat = pio_get_var(ncid,idv_mon,month) - if (.not. allocated(day)) allocate(day(ntimes),stat=ier) - istat = pio_inq_varid(ncid,'day',idv_day) - istat = pio_get_var(ncid,idv_day,day) - ! write(iulog,*)'rdamie_sh: day=', day(1:10) - if (.not. allocated(jday)) allocate(jday(ntimes),stat=ier) - istat = pio_inq_varid(ncid,'jday',idv_jday) - istat = pio_get_var(ncid,idv_jday,jday) - ! - ! Allocate 1-d fields: - if (.not. allocated(amie_sh_ut)) & - allocate(amie_sh_ut(ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_sh: error allocating', & - ' amie_sh_ut: ntimes=',i3)")ntimes - if (.not. allocated(amie_cusplat_sh)) & - allocate(amie_cusplat_sh(ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_sh: error allocating', & - ' amie_cusplat_sh: ntimes=',i3)")ntimes - if (.not. allocated(amie_cuspmlt_sh)) & - allocate(amie_cuspmlt_sh(ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_sh: error allocating', & - ' amie_cuspmlt_sh: ntimes=',i3)")ntimes - if (.not. allocated(amie_hpi_sh)) & - allocate(amie_hpi_sh(ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_sh: error allocating', & - ' amie_hpi_sh: ntimes=',i3)")ntimes - if (.not. allocated(amie_pcp_sh)) & - allocate(amie_pcp_sh(ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_sh: error allocating', & - ' amie_pcp_sh: ntimes=',i3)")ntimes - ! - ! Get ut - istat = pio_inq_varid(ncid,'ut',idv_ut) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE UT id') - istat = pio_get_var(ncid,idv_ut,amie_sh_ut) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE variable ut') - ! - ! Get HPI - istat = pio_inq_varid(ncid,'hpi',idv_hpi) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE hpi id') - istat = pio_get_var(ncid,idv_hpi,amie_hpi_sh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE variable hpi') - ! - ! Get PCP - istat = pio_inq_varid(ncid,'pcp',idv_pcp) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE pcp id') - istat = pio_get_var(ncid,idv_pcp,amie_pcp_sh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE variable pcp') - ! - ! Get cusplat - istat = pio_inq_varid(ncid,'cusplat',idv_cusplat) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE cusplat id') - istat = pio_get_var(ncid,idv_cusplat,amie_cusplat_sh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE variable cusplat') - ! - ! Get cuspmlt - istat = pio_inq_varid(ncid,'cuspmlt',idv_cuspmlt) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE cusplat id') - istat = pio_get_var(ncid,idv_cuspmlt,amie_cuspmlt_sh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE variable cuspmlt') - ! - ! Allocate 2-d fields: - if (.not. allocated(pot_sh_amie)) & - allocate(pot_sh_amie(lonp1,latp1),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_sh: error allocating', & - ' pot_sh_amie: lonp1=',i3,' latp1=',i3)")lonp1,latp1 - if (.not. allocated(ekv_sh_amie)) & - allocate(ekv_sh_amie(lonp1,latp1),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_sh: error allocating', & - ' ekv_sh_amie: lonp1=',i3,' latp1=',i3)")lonp1,latp1 - if (.not. allocated(efx_sh_amie)) & - allocate(efx_sh_amie(lonp1,latp1),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_sh: error allocating', & - ' efx_sh_amie: lonp1=',i3,' latp1=',i3)")lonp1,latp1 - ! - ! Allocate 3-d fields: - if (.not. allocated(amie_pot_sh)) & - allocate(amie_pot_sh(lonp1,latp1,ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_sh: error allocating', & - ' amie_pot_sh: lonp1=',i3,' latp1=',i3,' ntimes=',i3)") & - lonp1,latp1,ntimes - if (.not. allocated(amie_ekv_sh)) & - allocate(amie_ekv_sh(lonp1,latp1,ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_sh: error allocating', & - ' amie_ekv_sh: lonp1=',i3,' latp1=',i3,' ntimes=',i3)") & - lonp1,latp1,ntimes - if (.not. allocated(amie_efx_sh)) & - allocate(amie_efx_sh(lonp1,latp1,ntimes),stat=ier) - if (ier /= 0) write(iulog,"('>>> rdamie_sh: error allocating', & - ' amie_efx_sh: lonp1=',i3,' latp1=',i3,' ntimes=',i3)") & - lonp1,latp1,ntimes - ! - ! Get 3-D AMIE fields (lon,lat,ntimes) - ! - ! AMIE electric potential - istat = pio_inq_varid(ncid,'pot',idv_pot) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE electric potential id') - istat = pio_get_var(ncid,idv_pot,amie_pot_sh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE variable pot') - ! - ! AMIE mean energy - istat = pio_inq_varid(ncid,'ekv',idv_ekv) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE mean energy id') - istat = pio_get_var(ncid,idv_ekv,amie_ekv_sh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE variable ekv') - ! - ! AMIE energy flux - istat = pio_inq_varid(ncid,'efx',idv_efx) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE energy flux id') - istat = pio_get_var(ncid,idv_efx,amie_efx_sh) - if (istat /= pio_noerr) call rpt_ncerr(istat, & - 'rdamie_sh: Error getting SH AMIE variable efx') - ! - ! Close the file: - call cam_pio_closefile(ncid) - if (masterproc) & - write(iulog,"('Completed read from SH AMIE data file ',a)") trim(amiesh) - if (masterproc) write(iulog,"(72('-'),/)") - end subroutine rdamie_sh -#endif - !----------------------------------------------------------------------- - subroutine getamie(iyear,imo,iday,iutsec,sunlon,amie_ibkg,iprint, & - iamie,phihm,amie_efxm,amie_kevm,crad, efxg,kevg) - use cam_history_support, only: fillvalue - use rgrd_mod, only: rgrd2 - ! - ! Read AMIE outputs from amie_ncfile file, returning electric potential, - ! auroral mean energy and energy flux at current date and time, - ! and the data is linearly interpolated to the model time - ! gl - 12/07/2002 - ! - ! - ! Args: - - integer, intent(in) :: iyear - integer, intent(in) :: imo - integer, intent(in) :: iday - real(r8), intent(in) :: sunlon - integer, intent(in) :: iutsec - integer, intent(in) :: amie_ibkg - integer, intent(in) :: iprint - integer, intent(inout) :: iamie - real(r8), intent(out) :: phihm(nmlonp1,nmlat) - real(r8), intent(out) :: amie_efxm(nmlonp1,nmlat) ! on geomag grid - real(r8), intent(out) :: amie_kevm(nmlonp1,nmlat) ! on geomag grid - real(r8), intent(out) :: crad(2) - real(r8), intent(out) :: efxg(lon0:lon1,lat0:lat1) ! on geographic grid - real(r8), intent(out) :: kevg(lon0:lon1,lat0:lat1) ! on geographic grid -#ifdef WACCMX_EDYN_ESMF - - ! - ! Local: - real(r8) :: potm(lonp1,jmxm),efxm(lonp1,jmxm),ekvm(lonp1,jmxm), & - alat(jmxm),alon(lonp1),alatm(jmxm),alonm(lonp1) - integer :: ier,lw,liw,intpol(2) - integer, allocatable :: iw(:) - real(r8),allocatable :: w(:) - integer :: i,j - integer :: nn, iset, iset1, m, mp1, n - integer :: iboxcar - real(r8) :: model_ut, denoma, f1, f2 - real(r8) :: del,xmlt,dmlat,dlatm,dlonm,dmltm,rot,dtr,rtd - integer :: idate,bdate,edate - real(r8) :: pi - - pi = 4._r8*atan(1._r8) - dtr = pi/180._r8 ! degrees to radians - rtd = 180._r8/pi - ! - - phihm = fillvalue - amie_efxm = fillvalue - amie_kevm = fillvalue - efxg = fillvalue - kevg = fillvalue - crad = fillvalue - - ! - if (iprint > 0 .and. masterproc) then - write(iulog,"(/,72('-'))") - write(iulog,"('GETAMIE:')") - write(iulog,"('Initial requested iyear=',i4, & - ' iday=',i3,' iutsec=', i10)") iyear,iday,iutsec - end if - - ! - ! Check times: - ! - nn = size(amie_sh_ut) - bdate = year(1)*10000+month(1)*100+day(1) - edate = year(nn)*10000+month(nn)*100+day(nn) - idate = iyear*10000+imo*100+iday - - if (idateedate) then - if (masterproc) write(iulog, "('getamie: Model date beyond the AMIE last Data:',3I5)") & - year(nn),month(nn),day(nn) - iamie = 0 - return - endif - - if (iamie/=1) return - - model_ut = dble(iutsec)/3600._r8 - - ! - ! interpolate AMIE data to modeltime iutsec - ! amie_ibkg = 0 use real UT AMIE data - ! = 1 use the first AMIE volumne as the background - ! = 2 use the 24-hr average AMIE volumne as the background - pot_sh_amie(:,:) = 0._r8 - ekv_sh_amie(:,:) = 0._r8 - efx_sh_amie(:,:) = 0._r8 - cusplat_sh_amie = 0._r8 - cuspmlt_sh_amie = 0._r8 - hpi_sh_amie = 0._r8 - pcp_sh_amie = 0._r8 - ! - - iboxcar = 0 - - if (amie_ibkg == 0) then - - iset = nn - iset1 = nn - do i=1,nn - ! if (amie_sh_ut(i) < model_ut) iset = i - if (amie_sh_ut(i) < model_ut+(iday-day(i))*24._r8) iset = i - end do - ! write(iulog,"('getamie: AMIE SH Data nn,iset,day1,day2=',4i5)") - ! | nn,iset,jday(1),jday(nn) - iset1 = iset + 1 - if (iset == nn) iset1 = iset - - denoma = amie_sh_ut(iset1) - amie_sh_ut(iset) - if (denoma > 1._r8) then - write(iulog, "('getamie: Finding a gap in the AMIE Data set:', & - 'modelday, amieday =',2I5)") iday,day(n) - iamie = 2 - return - end if - if (denoma == 0._r8) then - f1 = 1._r8 - f2 = 0._r8 - else - ! f1 = (amie_sh_ut(iset1) - model_ut)/denoma - ! f2 = (model_ut - amie_sh_ut(iset))/denoma - f1 = (amie_sh_ut(iset1) - (model_ut+(iday- & - day(iset1))*24._r8))/denoma - f2 = (model_ut+(iday-day(iset1))*24._r8 - & - amie_sh_ut(iset))/denoma - end if - ! write(iulog,"('getamie: AMIE SH Data n,iset,modeltime,f1,f2 =', - ! | 4i5,2f5.2)")n,iset,iday,day(iset1),f1,f2 - ! write(iulog,"('getamie: AMIE SH Data model_day,model_ut,amie_day,', - ! | 'amie_ut,f1,f2,iset,iset1 =',i4,f7.1,i4,f7.1,2f5.2,2i3)") - ! | iday,model_ut,day(iset),amie_sh_ut(iset),f1,f2, - ! | iset,iset1 - cusplat_sh_amie = (f1*amie_cusplat_sh(iset1) + & - f2*amie_cusplat_sh(iset)) - cuspmlt_sh_amie = (f1*amie_cuspmlt_sh(iset1) + & - f2*amie_cuspmlt_sh(iset)) - hpi_sh_amie = (f1*amie_hpi_sh(iset1) + f2*amie_hpi_sh(iset)) - pcp_sh_amie = (f1*amie_pcp_sh(iset1) + f2*amie_pcp_sh(iset)) - if (iboxcar == 0) then - pot_sh_amie(:,:) = (f1*amie_pot_sh(:,:,iset1) + & - f2*amie_pot_sh(:,:,iset)) - ekv_sh_amie(:,:) = (f1*amie_ekv_sh(:,:,iset1) + & - f2*amie_ekv_sh(:,:,iset)) - efx_sh_amie(:,:) = (f1*amie_efx_sh(:,:,iset1) + & - f2*amie_efx_sh(:,:,iset)) - else - call boxcar_ave(amie_pot_sh,pot_sh_amie,lonp1,latp1, & - nn,iset,iboxcar) - call boxcar_ave(amie_efx_sh,efx_sh_amie,lonp1,latp1, & - nn,iset,iboxcar) - call boxcar_ave(amie_ekv_sh,ekv_sh_amie,lonp1,latp1, & - nn,iset,iboxcar) - end if - else - if (amie_ibkg == 1) then - pot_sh_amie(:,:) = amie_pot_sh(:,:,1) - ekv_sh_amie(:,:) = amie_ekv_sh(:,:,1) - efx_sh_amie(:,:) = amie_efx_sh(:,:,1) - cusplat_sh_amie = amie_cusplat_sh(1) - cuspmlt_sh_amie = amie_cuspmlt_sh(1) - hpi_sh_amie = amie_hpi_sh(1) - pcp_sh_amie = amie_pcp_sh(1) - else if (amie_ibkg == 3) then - pot_sh_amie(:,:) = amie_pot_sh(:,:,241) - ekv_sh_amie(:,:) = amie_ekv_sh(:,:,241) - efx_sh_amie(:,:) = amie_efx_sh(:,:,241) - cusplat_sh_amie = amie_cusplat_sh(241) - cuspmlt_sh_amie = amie_cuspmlt_sh(241) - hpi_sh_amie = amie_hpi_sh(241) - pcp_sh_amie = amie_pcp_sh(241) - else - do i=1,nn - pot_sh_amie(:,:) = pot_sh_amie(:,:) + amie_pot_sh(:,:,1) - ekv_sh_amie(:,:) = ekv_sh_amie(:,:) + amie_ekv_sh(:,:,1) - efx_sh_amie(:,:) = efx_sh_amie(:,:) + amie_efx_sh(:,:,1) - cusplat_sh_amie = cusplat_sh_amie + amie_cusplat_sh(1) - cuspmlt_sh_amie = cuspmlt_sh_amie + amie_cuspmlt_sh(1) - hpi_sh_amie = hpi_sh_amie + amie_hpi_sh(1) - pcp_sh_amie = pcp_sh_amie + amie_pcp_sh(1) - end do - pot_sh_amie(:,:) = pot_sh_amie(:,:)/nn - ekv_sh_amie(:,:) = ekv_sh_amie(:,:)/nn - efx_sh_amie(:,:) = efx_sh_amie(:,:)/nn - cusplat_sh_amie = cusplat_sh_amie/nn - cuspmlt_sh_amie = cuspmlt_sh_amie/nn - hpi_sh_amie = hpi_sh_amie/nn - pcp_sh_amie = pcp_sh_amie/nn - end if - end if - - ! - ! get NH AMIE data - pot_nh_amie(:,:) = 0._r8 - ekv_nh_amie(:,:) = 0._r8 - efx_nh_amie(:,:) = 0._r8 - cusplat_nh_amie = 0._r8 - cuspmlt_nh_amie = 0._r8 - hpi_nh_amie = 0._r8 - pcp_nh_amie = 0._r8 - - iboxcar = 0 - ! write(iulog,"('getamie: Interpolate AMIE NH Data nn=',i3)")nn - if (amie_ibkg == 0) then - iset = 0 - iset1 = nn - do i=1,nn - if (amie_nh_ut(i) < model_ut+(iday-day(i))*24._r8) iset = i - end do - iset1 = iset + 1 - if (iset == 0) iset = 1 - if (iset == nn) iset1 = iset - - denoma = amie_nh_ut(iset1) - amie_nh_ut(iset) - if (denoma > 1._r8) then - write(iulog, "('getamie: Finding a gap in the AMIE Data set:', & - 'modelday, amieday =',2I5)") iday,day(n) - iamie = 2 - return - end if - if (denoma == 0._r8) then - f1 = 1._r8 - f2 = 0._r8 - else - ! f1 = (amie_nh_ut(iset1) - model_ut)/denoma - ! f2 = (model_ut - amie_nh_ut(iset))/denoma - f1 = (amie_nh_ut(iset1) - (model_ut+(iday- & - day(iset1))*24._r8))/denoma - f2 = (model_ut+(iday-day(iset1))*24._r8 - & - amie_nh_ut(iset))/denoma - end if - ! write(iulog,"('getamie: AMIE NH Data model_day,model_ut,amie_day,', - ! | 'amie_ut,f1,f2,iset,iset1 =',i4,f7.1,i4,f7.1,2f5.2,2i3)") - ! | iday,model_ut,day(iset),amie_nh_ut(iset),f1,f2, - ! | iset,iset1 - ! - cusplat_nh_amie = (f1*amie_cusplat_nh(iset1) + & - f2*amie_cusplat_nh(iset)) - cuspmlt_nh_amie = (f1*amie_cuspmlt_nh(iset1) + & - f2*amie_cuspmlt_nh(iset)) - hpi_nh_amie = (f1*amie_hpi_nh(iset1) + f2*amie_hpi_nh(iset)) - pcp_nh_amie = (f1*amie_pcp_nh(iset1) + f2*amie_pcp_nh(iset)) - if (iboxcar == 0) then - pot_nh_amie(:,:) = (f1*amie_pot_nh(:,:,iset1) + & - f2*amie_pot_nh(:,:,iset)) - ekv_nh_amie(:,:) = (f1*amie_ekv_nh(:,:,iset1) + & - f2*amie_ekv_nh(:,:,iset)) - efx_nh_amie(:,:) = (f1*amie_efx_nh(:,:,iset1) + & - f2*amie_efx_nh(:,:,iset)) - ! write(iulog,"('ekv_nh_amie min, max = ',2e12.4)") - ! | minval(ekv_nh_amie),maxval(ekv_nh_amie) - else - call boxcar_ave(amie_pot_nh,pot_nh_amie,lonp1,latp1, & - nn,iset,iboxcar) - ! call fminmax(amie_pot_nh(:,:,iset),lonp1*latp1,fmin,fmax) - ! write(iulog,"('AMIE pot max,min = ',2f8.0)")fmax,fmin - ! call fminmax(pot_nh_amie(:,:),lonp1*latp1,fmin,fmax) - ! write(iulog,"('boxcar_ave AMIE pot max,min= ',2f8.0)")fmax,fmin - call boxcar_ave(amie_efx_nh,efx_nh_amie,lonp1,latp1, & - nn,iset,iboxcar) - ! call fminmax(amie_efx_nh(:,:,iset),lonp1*latp1,fmin,fmax) - ! write(iulog,"('AMIE efx max,min = ',2f8.0)")fmax,fmin - ! call fminmax(efx_nh_amie(:,:),lonp1*latp1,fmin,fmax) - ! write(iulog,"('boxcar_ave AMIE efx max,min= ',2f8.0)")fmax,fmin - call boxcar_ave(amie_ekv_nh,ekv_nh_amie,lonp1,latp1, & - nn,iset,iboxcar) - ! call fminmax(amie_ekv_nh(:,:,iset),lonp1*latp1,fmin,fmax) - ! write(iulog,"('AMIE ekv max,min = ',2f8.0)")fmax,fmin - ! call fminmax(ekv_nh_amie(:,:),lonp1*latp1,fmin,fmax) - ! write(iulog,"('boxcar_ave AMIE ekv max,min= ',2f8.0)")fmax,fmin - end if - else - if (amie_ibkg == 1) then - pot_nh_amie(:,:) = amie_pot_nh(:,:,1) - ekv_nh_amie(:,:) = amie_ekv_nh(:,:,1) - efx_nh_amie(:,:) = amie_efx_nh(:,:,1) - cusplat_nh_amie = amie_cusplat_nh(1) - cuspmlt_nh_amie = amie_cuspmlt_nh(1) - hpi_nh_amie = amie_hpi_nh(1) - pcp_nh_amie = amie_pcp_nh(1) - else if (amie_ibkg == 3) then - pot_nh_amie(:,:) = amie_pot_nh(:,:,241) - ekv_nh_amie(:,:) = amie_ekv_nh(:,:,241) - efx_nh_amie(:,:) = amie_efx_nh(:,:,241) - cusplat_nh_amie = amie_cusplat_nh(241) - cuspmlt_nh_amie = amie_cuspmlt_nh(241) - hpi_nh_amie = amie_hpi_nh(241) - pcp_nh_amie = amie_pcp_nh(241) - else - do i=1,nn - pot_nh_amie(:,:) = pot_nh_amie(:,:) + amie_pot_nh(:,:,1) - ekv_nh_amie(:,:) = ekv_nh_amie(:,:) + amie_ekv_nh(:,:,1) - efx_nh_amie(:,:) = efx_nh_amie(:,:) + amie_efx_nh(:,:,1) - cusplat_nh_amie = cusplat_nh_amie + amie_cusplat_nh(1) - cuspmlt_nh_amie = cuspmlt_nh_amie + amie_cuspmlt_nh(1) - hpi_nh_amie = hpi_nh_amie + amie_hpi_nh(1) - pcp_nh_amie = pcp_nh_amie + amie_pcp_nh(1) - end do - pot_nh_amie(:,:) = pot_nh_amie(:,:)/nn - ekv_nh_amie(:,:) = ekv_nh_amie(:,:)/nn - efx_nh_amie(:,:) = efx_nh_amie(:,:)/nn - cusplat_nh_amie = cusplat_nh_amie/nn - cuspmlt_nh_amie = cuspmlt_nh_amie/nn - hpi_nh_amie = hpi_nh_amie/nn - pcp_nh_amie = pcp_nh_amie/nn - end if - end if - ! - ! The OLTMAX latitude also defines the co-latitude theta0, which in - ! turn determines crit1(+2.5deg) and crit2(-12.5deg) which are used - ! in TIE-GCM as the boundaries of the polar cap and the region of - ! influence of the high-lat potential versus the low-lat dynamo potential - ! Define this latitude to be between 70 and 77.5 degrees - ! - ! if (cusplat_sh_amie > 65.0) then - ! cusplat_sh_amie = 65.0 - ! cuspmlt_sh_amie = 11. - ! endif - if (cusplat_sh_amie > 75.0_r8) then - cusplat_sh_amie = 75.0_r8 - cuspmlt_sh_amie = 11._r8 - end if - if (cusplat_sh_amie < 60.0_r8) then - cusplat_sh_amie = 60.0_r8 - cuspmlt_sh_amie = 11._r8 - end if - if (cusplat_nh_amie > 75.0_r8) then - cusplat_nh_amie = 75.0_r8 - cuspmlt_nh_amie = 11._r8 - end if - if (cusplat_nh_amie < 60.0_r8) then - cusplat_nh_amie = 60.0_r8 - cuspmlt_nh_amie = 11._r8 - end if - ! cusplat_nh_amie = amin1(65.0,cusplat_nh_amie) - if (cuspmlt_sh_amie > 12.5_r8) cuspmlt_sh_amie = 12.5_r8 - if (cuspmlt_sh_amie < 11.0_r8) cuspmlt_sh_amie = 11.0_r8 - if (cuspmlt_nh_amie > 12.5_r8) cuspmlt_nh_amie = 12.5_r8 - if (cuspmlt_nh_amie < 11.0_r8) cuspmlt_nh_amie = 11.0_r8 - crad(1) = (90._r8-cusplat_sh_amie)*pi/180._r8 - crad(2) = (90._r8-cusplat_nh_amie)*pi/180._r8 - - ! mlongitude starts from 180 degree - rot = sunlon*rtd - if(rot.lt.0) rot = rot + 360._r8 ! 0 to 360 degrees - rot = rot/15._r8 ! convert from degree to hrs - - dmltm = 24._r8/dble(lonmx) - do i=1,lonp1 - xmlt = dble(i-1)*dmltm - rot + 24._r8 - xmlt = MOD(xmlt,24._r8) - m = int(xmlt/dmltm + 1.01_r8) - mp1 = m + 1 - if (mp1 > lonp1) mp1 = 2 - del = xmlt - (m-1)*dmltm - ! Initialize arrays around equator - do j=latp1+1,ithmx - potm(i,j) = 0._r8 - potm(i,jmxm+1-j) = 0._r8 - ekvm(i,j) = (1._r8-del)*ekv_sh_amie(m,latp1) + & - del*ekv_sh_amie(mp1,latp1) - ekvm(i,jmxm+1-j) = (1._r8-del)*ekv_nh_amie(m,latp1) + & - del*ekv_nh_amie(mp1,latp1) - efxm(i,j) = 0._r8 - efxm(i,jmxm+1-j) = 0._r8 - end do - ! Put in AMIE arrays from pole to latp1 - do j=1,latp1 - potm(i,j) = (1._r8-del)*pot_sh_amie(m,j) + & - del*pot_sh_amie(mp1,j) - potm(i,jmxm+1-j) = (1._r8-del)*pot_nh_amie(m,j) + & - del*pot_nh_amie(mp1,j) - ekvm(i,j) = (1._r8-del)*ekv_sh_amie(m,j) + & - del*ekv_sh_amie(mp1,j) - ekvm(i,jmxm+1-j) = (1._r8-del)*ekv_nh_amie(m,j) + & - del*ekv_nh_amie(mp1,j) - efxm(i,j) = (1._r8-del)*efx_sh_amie(m,j) + & - del*efx_sh_amie(mp1,j) - efxm(i,jmxm+1-j) = (1._r8-del)*efx_nh_amie(m,j) + & - del*efx_nh_amie(mp1,j) - end do - - end do - - ! Set up coeffs to go between EPOTM(IMXMP,JMNH) and TIEPOT(IMAXM,JMAXMH) - - ! **** SET GRID SPACING DLATM, DLONG, DLONM - ! DMLAT=lat spacing in degrees of AMIE apex grid - dtr = pi/180._r8 - dmlat = 180._r8 / dble(jmxm-1) - dlatm = dmlat*dtr - dlonm = 2._r8*pi/dble(lonmx) - dmltm = 24._r8/dble(lonmx) - ! **** - ! **** SET ARRAY YLATM (LATITUDE VALUES FOR GEOMAGNETIC GRID - ! **** - alatm(1) = -pi/2._r8 - alat(1) = -90._r8 - alatm(jmxm) = pi/2._r8 - alat(jmxm) = 90._r8 - do i = 2,ithmx - alat(i) = alat(i-1)+dlatm/dtr - alat(jmxm+1-i) = alat(jmxm+2-i)-dlatm/dtr - alatm(i) = alatm(i-1)+dlatm - alatm(jmxm+1-i) = alatm(jmxm+2-i)-dlatm - end do - alon(1) = -pi/dtr - alonm(1) = -pi - do i=2,lonp1 - alon(i) = alon(i-1) + dlonm/dtr - alonm(i) = alonm(i-1) + dlonm - end do - - ! ylatm and ylonm are arrays of latitudes and longitudes of the - ! distored magnetic grids in radian - from consdyn.h - ! Convert from apex magnetic grid to distorted magnetic grid - ! - ! Allocate workspace for regrid routine rgrd2.f: - lw = nmlonp1+nmlat+2*nmlonp1 - if (.not. allocated(w)) allocate(w(lw),stat=ier) - IF (ier /= 0) WRITE(iulog,"('>>> horizontal_interp: error allocating', & - ' w(lw): lw=',i6,' ier=',i4)") lw,ier - liw = nmlonp1 + nmlat - if (.not. allocated(iw)) allocate(iw(liw),stat=ier) - if (ier /= 0) write(iulog,"('>>> horzontal_interp: error allocating', & - ' iw(liw): liw=',i6,' ier=',i4)") liw,ier - intpol(:) = 1 ! linear (not cubic) interp in both dimensions - if (alatm(1) > ylatm(1)) alatm(1) = ylatm(1) - if (alatm(jmxm) < ylatm(nmlat)) alatm(jmxm) = ylatm(nmlat) - if (alonm(1) > ylonm(1)) alonm(1) = ylonm(1) - if (alonm(lonp1) < ylonm(nmlonp1)) alonm(lonp1) = ylonm(nmlonp1) - ! write(iulog,"(' AMIE: ylatm =',/,(6e12.4))") ylatm - ! write(iulog,"(' AMIE: ylonm =',/,(6e12.4))") ylonm - ! write(iulog,"(' AMIE: potm(1,:) =',/,(6e12.4))") potm(1,:) - ! ylatm from -pi/2 to pi/2, and ylonm from -pi to pi - call rgrd2(lonp1,jmxm,alonm,alatm,potm,nmlonp1,nmlat, & - ylonm,ylatm,tiepot,intpol,w,lw,iw,liw,ier) - call rgrd2(lonp1,jmxm,alonm,alatm,ekvm,nmlonp1,nmlat, & - ylonm,ylatm,tieekv,intpol,w,lw,iw,liw,ier) - call rgrd2(lonp1,jmxm,alonm,alatm,efxm,nmlonp1,nmlat, & - ylonm,ylatm,tieefx,intpol,w,lw,iw,liw,ier) - ! write(iulog,"(' AMIE: tiepot(1,:) =',/,(6e12.4))") tiepot(1,:) - phihm(:,:) = tiepot(:,:) - amie_efxm(:,:) = tieefx(:,:) - amie_kevm(:,:) = tieekv(:,:) - - ! Convert from WACCM-X distorted magnetic grid to geographic one - ! call mag2geo(tiepot(1,1),potg(1,0),im(1,0),jm(1,0), - ! | dim(1,0),djm(1,0),nlonp1,nmlonp1,nlon,nlat+2,nmlon,nmlat) - ! call mag2geo(tieekv(1,1),ekvg(1,0),im(1,0),jm(1,0), - ! | dim(1,0),djm(1,0),nlonp1,nmlonp1,nlon,nlat+2,nmlon,nmlat) - ! call mag2geo(tieefx(1,1),efxg(1,0),im(1,0),jm(1,0), - ! | dim(1,0),djm(1,0),nlonp1,nmlonp1,nlon,nlat+2,nmlon,nmlat) - - call mag2geo_2d(amie_efxm(mlon0:mlon1,mlat0:mlat1), & - efxg, mag_efx,geo_efx,'MEFXAMIE') - call mag2geo_2d(amie_kevm(mlon0:mlon1,mlat0:mlat1), & - kevg, mag_kev,geo_kev,'MKEVAMIE') - - ! call mag2geo_2d(amie_kevm,amie_kevg,mag_kev,geo_kev,'KEVM') - if (iprint > 0 .and. masterproc) write(iulog,*) 'Max,min amie_efxm = ', & - maxval(amie_efxm),minval(amie_efxm) - if (iprint > 0 .and. masterproc) write(iulog,*) & - 'Max,min efxg = ',maxval(efxg),minval(efxg) - ! **** - ! **** INSERT PERIODIC POINTS - ! **** - ! DO j = 1,nlat - ! ekvg(nlonp1,j) = ekvg(1,j) - ! efxg(nlonp1,j) = efxg(1,j) - ! potg(nlonp1,j) = potg(1,j) - ! ENDDO - ! - if (iprint > 0 .and. masterproc) then - write(iulog, "('getamie: AMIE data interpolated to date and time')") - write(iulog,"('getamie: iyear,imo,iday,iutsec = ',3i6,i10)") & - iyear,imo,iday,iutsec - write(iulog,"('getamie: AMIE iset f1,f2,year,mon,day,ut = ', & - i6,2F9.5,3I6,f10.4)") & - iset,f1,f2,year(iset),month(iset),day(iset),amie_nh_ut(iset) - write(iulog,*)'getamie: max,min phihm= ', maxval(phihm),minval(phihm) - ! write(iulog,*)'getamie: max,min phihm,amie_efx,amie_kev = ', - ! | maxval(phihm),minval(tiepot),maxval(amie_efx), - ! | minval(amie_efx),maxval(amie_kev),minval(amie_kev) - end if -#else - call endrun('Cannot use AMIE without electro-dynamo active.') -#endif - end subroutine getamie -#ifdef WACCMX_EDYN_ESMF - !------------------------------------------------------------------- - subroutine boxcar_ave(x,y,lon,lat,mtime,itime,ibox) - ! - ! perform boxcar average - ! - ! Args: - integer, intent(in) :: lon - integer, intent(in) :: lat - integer, intent(in) :: mtime - integer, intent(in) :: itime - integer, intent(in) :: ibox - real(r8), intent(in) :: x(lon,lat,mtime) - real(r8), intent(out) :: y(lon,lat) - - ! Local: - integer :: i, iset, iset1 - ! - iset = itime - ibox/2 - if (iset < 1) iset = 1 - iset1 = iset + ibox - if (iset1 > mtime) then - iset1 = mtime - iset = iset1 - ibox - end if - ! write(iulog,"('boxcar_ave: mtime,itime,ibox',3i5)") - ! | mtime,itime,ibox - ! - y(:,:) = 0._r8 - do i=iset,iset1 - y(:,:) = y(:,:) + x(:,:,i) - end do - if (ibox > 0) y(:,:) = y(:,:)/ibox - ! - end subroutine boxcar_ave - !----------------------------------------------------------------------- - subroutine mag2geo(am,ag,im,jm,dim,djm,lg,lm,nlong,nlatg) - ! - ! Args: - integer, intent(in) :: lg - integer, intent(in) :: lm - real(r8), intent(in) :: am(lm,*) - real(r8), intent(out) :: ag(lg,*) - integer, intent(in) :: im(lg,*) - integer, intent(in) :: jm(lg,*) - real(r8), intent(in) :: dim(lg,*) - real(r8), intent(in) :: djm(lg,*) - integer, intent(in) :: nlong - integer, intent(in) :: nlatg - ! - ! Local: - integer :: ig,jg - ! - do jg=1,nlatg - do ig=1,nlong - ag(ig,jg) = & - am(im(ig,jg) ,jm(ig,jg)) *(1._r8-dim(ig,jg))*(1._r8-djm(ig,jg))+ & - am(im(ig,jg)+1,jm(ig,jg)) * dim(ig,jg) *(1._r8-djm(ig,jg))+ & - am(im(ig,jg) ,jm(ig,jg)+1)*(1._r8-dim(ig,jg))*djm(ig,jg)+ & - am(im(ig,jg)+1,jm(ig,jg)+1)* dim(ig,jg) *djm(ig,jg) - end do ! ig=1,nlong - end do ! jg=1,nlatg - end subroutine mag2geo - !----------------------------------------------------------------------- - subroutine mag2geo_2d(fmag,fgeo,ESMF_mag,ESMF_geo,fname) - ! - ! Convert field on geomagnetic grid fmag to geographic grid in fgeo. - ! - use edyn_esmf,only: edyn_esmf_set2d_mag,edyn_esmf_regrid, & - edyn_esmf_get_2dfield - ! - ! Args: - real(r8), intent(in) :: fmag(mlon0:mlon1,mlat0:mlat1) - real(r8), intent(out) :: fgeo(lon0:lon1,lat0:lat1) - type(ESMF_Field), intent(inout) :: ESMF_mag, ESMF_geo - character(len=*), intent(in) :: fname - ! - ! Local: - integer :: j - character (len=8) :: fnames(1) - type(ESMF_Field) :: magfields(1) - real(r8),pointer,dimension(:,:) :: fptr - - fgeo = finit - fnames(1) = fname - magfields(1) = ESMF_mag - ! - ! Put fmag into ESMF mag field on mag source grid: - call edyn_esmf_set2d_mag(magfields,fnames,fmag,1, & - mlon0,mlon1,mlat0,mlat1) - ! - ! Regrid to geographic destination grid, defining ESMF_geo: - call edyn_esmf_regrid(ESMF_mag,ESMF_geo,'mag2geo',2) - ! - ! Put regridded geo field into pointer: - call edyn_esmf_get_2dfield(ESMF_geo,fptr,fname) - ! write(iulog,*) 'mag2geo: Max,min fptr = ',maxval(fptr),minval(fptr) - ! - ! Transfer from pointer to output arg: - do j=lat0,lat1 - fgeo(:,j) = fptr(:,j) - end do - ! write(iulog,*) 'mag2geo: max,min fmag = ',maxval(fmag),minval(fmag) - ! write(iulog,*) 'mag2geo: max,min fgeo = ',maxval(fgeo),minval(fgeo) - end subroutine mag2geo_2d - !----------------------------------------------------------------------- - subroutine rpt_ncerr(istat,msg) - ! - ! Handle a netcdf lib error: - ! - integer, intent(in) :: istat - character(len=*),intent(in) :: msg - ! - write(iulog,"(/72('-'))") - write(iulog,"('>>> Error from netcdf library:')") - write(iulog,"(a)") trim(msg) - - write(iulog,"('istat=',i5)") istat - write(iulog,"(72('-')/)") - return - end subroutine rpt_ncerr - -#endif - -end module amie_module diff --git a/src/ionosphere/waccmx/amie_module.F90 b/src/ionosphere/waccmx/amie_module.F90 new file mode 100644 index 0000000000..bf0de8f237 --- /dev/null +++ b/src/ionosphere/waccmx/amie_module.F90 @@ -0,0 +1,832 @@ +module amie_module + ! + ! Module used to read data from the AMIE outputs (POT,mean energy, + ! and energy flux). + ! + + use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use edyn_maggrid, only: nmlat, nmlonp1 + use edyn_maggrid, only: ylonm ! magnetic latitudes (nmlat) (radians) + use edyn_maggrid, only: ylatm ! magnetic longtitudes (nmlonp1) (radians) + use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile + use pio, only: pio_inq_dimid, pio_inquire_dimension + use pio, only: pio_inquire, pio_inq_varid + use pio, only: file_desc_t, pio_noerr, pio_nowrite, pio_get_var + use utils_mod, only: check_ncerr, check_alloc, boxcar_ave + use edyn_mpi, only: ntask, mytid + use edyn_params, only: pi, dtr, rtd + use input_data_utils, only: time_coordinate + + implicit none + + private + public :: init_amie + public :: getamie + + ! Define parameters for AMIE input data file: + integer, parameter :: & + ithmx = 55, & ! maximum number of latitudes of AMIE data + jmxm = 2*ithmx-1, & ! maximum number of global latitudes + lonmx = 36 ! maximum number of longitudes of AMIE data + integer :: lonp1,latp1 + ! + ! Define fields for AMIE input data file: + ! electric potential in Volt + ! mean energy in KeV + ! energy flux in W/m^2 + ! cusplat_nh_input(sh) and cuspmlt_nh_input(sh) are + ! AMIE cusp latitude and MLT in NH and SH + ! hpi_nh(sh) are AMIE hemi-integrated power + ! pcp_nh(sh) are AMIE polar-cap potential drop + ! Time interpolated AMIE outputs with suffix _amie + ! + real(r8), allocatable, dimension(:,:,:), save :: & ! (lonp1,latp1,ntimes) + pot_nh_input, pot_sh_input, & + ekv_nh_input, ekv_sh_input, & + efx_nh_input, efx_sh_input + real(r8), allocatable, dimension(:,:), save :: & ! (lonp1,latp1) + pot_nh_amie, pot_sh_amie, ekv_nh_amie, ekv_sh_amie, & + efx_nh_amie, efx_sh_amie + integer, allocatable, dimension(:), save :: & ! (ntimes) + year, month, day, jday + real(r8), allocatable, dimension(:), save :: & ! (ntimes) + cusplat_nh_input, cuspmlt_nh_input, hpi_nh_input, & + pcp_nh_input, amie_nh_ut, & + cusplat_sh_input, cuspmlt_sh_input, hpi_sh_input, & + pcp_sh_input, amie_sh_ut + real(r8) :: & + cusplat_nh_amie, cuspmlt_nh_amie, cusplat_sh_amie, & + cuspmlt_sh_amie, hpi_sh_amie, hpi_nh_amie, pcp_sh_amie, & + pcp_nh_amie + ! + type(file_desc_t) :: ncid_nh + type(file_desc_t) :: ncid_sh + + character(len=cl), allocatable :: amienh_files(:) + character(len=cl), allocatable :: amiesh_files(:) + integer :: num_files, file_ndx + + type(time_coordinate) :: time_coord_nh + type(time_coordinate) :: time_coord_sh + +contains + + !----------------------------------------------------------------------- + subroutine init_amie(amienh_list,amiesh_list) + + character(len=*),intent(in) :: amienh_list(:) + character(len=*),intent(in) :: amiesh_list(:) + + integer :: n, nfiles + + nfiles = min( size(amienh_list), size(amiesh_list) ) + num_files = 0 + + count_files: do n = 1,nfiles + if (len_trim(amienh_list(n))<1 .or. len_trim(amiesh_list(n))<1 .or. & + trim(amienh_list(n))=='NONE' .or. trim(amiesh_list(n))=='NONE') then + exit count_files + else + num_files = num_files + 1 + end if + end do count_files + + allocate(amienh_files(num_files), amiesh_files(num_files)) + amienh_files(:num_files) = amienh_list(:num_files) + amiesh_files(:num_files) = amiesh_list(:num_files) + file_ndx = 1 + call open_files() + + end subroutine init_amie + + !----------------------------------------------------------------------- + subroutine rdamie_nh(amienh) + ! + ! Read AMIE data for the northern hemisphere from amienh + ! + + ! Dummy argument + character(len=*), intent(in) :: amienh + ! Local variables: + integer :: istat, ntimes, ndims, nvars, ngatts + integer :: idunlim, ier + integer :: id_lon, id_lat, id_time + integer :: idv_year, idv_mon, idv_day, idv_jday + integer :: idv_ut, idv_cusplat, idv_cuspmlt + integer :: idv_hpi, idv_pcp + character(len=*), parameter :: subname = 'rdamie_nh' + ! + if (masterproc) then + write(iulog, "(/,72('-'))") + write(iulog, "(a,': read AMIE data for northern hemisphere:')") subname + end if + ! + ! Open netcdf file: + call cam_pio_openfile(ncid_nh, amienh, pio_nowrite) + ! + ! Get AMIE grid dimension: + istat = pio_inq_dimid(ncid_nh, 'lon', id_lon) + istat = pio_inquire_dimension(ncid_nh, id_lon, len=lonp1) + call check_ncerr(istat, subname, 'AMIE longitude dimension') + + istat = pio_inq_dimid(ncid_nh, 'lat', id_lat) + istat = pio_inquire_dimension(ncid_nh, id_lat, len=latp1) + call check_ncerr(istat, subname, 'AMIE latitude dimension') + + call time_coord_nh%initialize( amienh, set_weights=.false. ) + + ! + ! Get time dimension: + istat = pio_inquire(ncid_nh, unlimiteddimid=id_time) + istat = pio_inquire_dimension(ncid_nh, id_time, len=ntimes) + call check_ncerr(istat, subname, 'AMIE time dimension') + ! + ! Search for requested AMIE output fields + istat = pio_inquire(ncid_nh, ndims, nvars, ngatts, idunlim) + ! + ! Get 1-D AMIE fields (ntimes) + if (.not. allocated(year)) then + allocate(year(ntimes), stat=ier) + call check_alloc(ier, subname, 'year', ntimes=ntimes) + end if + istat = pio_inq_varid(ncid_nh, 'year', idv_year) + call check_ncerr(istat, subname, 'AMIE year id') + istat = pio_get_var(ncid_nh, idv_year, year) + call check_ncerr(istat, subname, 'AMIE year') + + if (.not. allocated(month)) then + allocate(month(ntimes), stat=ier) + call check_alloc(ier, subname, 'month', ntimes=ntimes) + end if + istat = pio_inq_varid(ncid_nh, 'month', idv_mon) + call check_ncerr(istat, subname, 'AMIE month id') + istat = pio_get_var(ncid_nh, idv_mon, month) + call check_ncerr(istat, subname, 'AMIE month') + if (.not. allocated(day)) then + allocate(day(ntimes), stat=ier) + call check_alloc(ier, subname, 'day', ntimes=ntimes) + end if + istat = pio_inq_varid(ncid_nh, 'day', idv_day) + call check_ncerr(istat, subname, 'AMIE day id') + istat = pio_get_var(ncid_nh, idv_day, day) + call check_ncerr(istat, subname, 'AMIE day') + + if (.not. allocated(jday)) then + allocate(jday(ntimes), stat=ier) + call check_alloc(ier, subname, 'jday', ntimes=ntimes) + end if + istat = pio_inq_varid(ncid_nh, 'jday', idv_jday) + call check_ncerr(istat, subname, 'AMIE jday id') + istat = pio_get_var(ncid_nh, idv_jday, jday) + call check_ncerr(istat, subname, 'AMIE jday') + ! + ! Allocate 1-d fields: + if (.not. allocated(amie_nh_ut)) then + allocate(amie_nh_ut(ntimes), stat=ier) + call check_alloc(ier, subname, 'amie_nh_ut', ntimes=ntimes) + end if + if (.not. allocated(cusplat_nh_input)) then + allocate(cusplat_nh_input(ntimes), stat=ier) + call check_alloc(ier, subname, 'cusplat_nh_input', ntimes=ntimes) + end if + if (.not. allocated(cuspmlt_nh_input)) then + allocate(cuspmlt_nh_input(ntimes), stat=ier) + call check_alloc(ier, subname, 'cuspmlt_nh_input', ntimes=ntimes) + end if + if (.not. allocated(hpi_nh_input)) then + allocate(hpi_nh_input(ntimes), stat=ier) + call check_alloc(ier, subname, 'hpi_nh_input', ntimes=ntimes) + end if + if (.not. allocated(pcp_nh_input)) then + allocate(pcp_nh_input(ntimes), stat=ier) + call check_alloc(ier, subname, 'pcp_nh_input', ntimes=ntimes) + end if + ! + ! Get ut + istat = pio_inq_varid(ncid_nh, 'ut', idv_ut) + call check_ncerr(istat, subname, 'AMIE ut id') + istat = pio_get_var(ncid_nh, idv_ut, amie_nh_ut) + call check_ncerr(istat, subname, 'AMIE ut') + ! + ! Get HPI + istat = pio_inq_varid(ncid_nh, 'hpi', idv_hpi) + call check_ncerr(istat, subname, 'AMIE hpi id') + istat = pio_get_var(ncid_nh, idv_hpi, hpi_nh_input) + call check_ncerr(istat, subname, 'AMIE hpi') + ! + ! Get PCP + istat = pio_inq_varid(ncid_nh, 'pcp', idv_pcp) + call check_ncerr(istat, subname, 'AMIE pcp id') + istat = pio_get_var(ncid_nh, idv_pcp, pcp_nh_input) + call check_ncerr(istat, subname, 'AMIE pcp') + ! + ! Get cusplat + istat = pio_inq_varid(ncid_nh, 'cusplat', idv_cusplat) + call check_ncerr(istat, subname, 'AMIE cusplat id') + istat = pio_get_var(ncid_nh, idv_cusplat, cusplat_nh_input) + call check_ncerr(istat, subname, 'AMIE cusplat') + ! + ! Get cuspmlt + istat = pio_inq_varid(ncid_nh, 'cuspmlt', idv_cuspmlt) + call check_ncerr(istat, subname, 'AMIE cuspmlt id') + istat = pio_get_var(ncid_nh, idv_cuspmlt, cuspmlt_nh_input) + call check_ncerr(istat, subname, 'AMIE cuspmlt') + ! + ! Allocate 2-d fields: + if (.not. allocated(pot_nh_amie)) then + allocate(pot_nh_amie(lonp1, latp1), stat=ier) + call check_alloc(ier, subname, 'pot_nh_amie', lonp1=lonp1, latp1=latp1) + end if + if (.not. allocated(ekv_nh_amie)) then + allocate(ekv_nh_amie(lonp1, latp1), stat=ier) + call check_alloc(ier, subname, 'ekv_nh_amie', lonp1=lonp1, latp1=latp1) + end if + if (.not. allocated(efx_nh_amie)) then + allocate(efx_nh_amie(lonp1, latp1), stat=ier) + call check_alloc(ier, subname, 'efx_nh_amie', lonp1=lonp1, latp1=latp1) + end if + ! + ! Allocate 3-d fields: + if (.not. allocated(pot_nh_input)) then + allocate(pot_nh_input(lonp1, latp1, 2), stat=ier) + call check_alloc(ier, subname, 'pot_nh_input', & + lonp1=lonp1, latp1=latp1, ntimes=ntimes) + end if + if (.not. allocated(ekv_nh_input)) then + allocate(ekv_nh_input(lonp1, latp1, 2), stat=ier) + call check_alloc(ier, subname, 'ekv_nh_input', & + lonp1=lonp1, latp1=latp1, ntimes=ntimes) + end if + if (.not. allocated(efx_nh_input)) then + allocate(efx_nh_input(lonp1, latp1, 2), stat=ier) + call check_alloc(ier, subname, 'efx_nh_input', & + lonp1=lonp1, latp1=latp1, ntimes=ntimes) + end if + end subroutine rdamie_nh + + !----------------------------------------------------------------------- + subroutine rdamie_sh(amiesh) + ! + ! Read AMIE data for the southern hemisphere from amiesh + ! + + ! Dummy argument + character(len=*), intent(in) :: amiesh + ! Local variables: + integer :: istat, ntimes, ndims, nvars, ngatts, ier + integer :: idunlim + integer :: id_lon, id_lat, id_time + integer :: idv_year, idv_mon, idv_day, idv_jday + integer :: idv_ut + integer :: idv_cusplat, idv_cuspmlt, idv_hpi, idv_pcp + character(len=*), parameter :: subname = 'rdamie_sh' + ! + if (masterproc) then + write(iulog, "(/, 72('-'))") + write(iulog, "(a, ': read AMIE data for southern hemisphere:')") subname + end if + ! + ! Open netcdf file: + call cam_pio_openfile(ncid_sh, amiesh, pio_nowrite) + ! + ! Get AMIE grid dimension: + istat = pio_inq_dimid(ncid_sh, 'lon', id_lon) + istat = pio_inquire_dimension(ncid_sh, id_lon, len=lonp1) + call check_ncerr(istat, subname, 'AMIE longitude dimension') + + istat = pio_inq_dimid(ncid_sh, 'lat', id_lat) + istat = pio_inquire_dimension(ncid_sh, id_lat, len=latp1) + call check_ncerr(istat, subname, 'AMIE latitude dimension') + + call time_coord_sh%initialize( amiesh, set_weights=.false. ) + + ! + ! Get time dimension: + istat = pio_inquire(ncid_sh, unlimiteddimid=id_time) + istat = pio_inquire_dimension(ncid_sh, id_time, len=ntimes) + call check_ncerr(istat, subname, 'AMIE time dimension') + ! + ! Search for requested AMIE output fields + istat = pio_inquire(ncid_sh, ndims, nvars, ngatts, idunlim) + ! + ! Get 1-D AMIE fields (ntimes) + if (.not. allocated(year)) then + allocate(year(ntimes), stat=ier) + call check_alloc(ier, subname, 'year', ntimes=ntimes) + end if + istat = pio_inq_varid(ncid_sh, 'year', idv_year) + call check_ncerr(istat, subname, 'AMIE year id') + istat = pio_get_var(ncid_sh, idv_year, year) + call check_ncerr(istat, subname, 'AMIE year') + + if (.not. allocated(month)) then + allocate(month(ntimes), stat=ier) + call check_alloc(ier, subname, 'month', ntimes=ntimes) + end if + istat = pio_inq_varid(ncid_sh, 'month', idv_mon) + call check_ncerr(istat, subname, 'AMIE month id') + istat = pio_get_var(ncid_sh, idv_mon, month) + call check_ncerr(istat, subname, 'AMIE month') + if (.not. allocated(day)) then + allocate(day(ntimes), stat=ier) + call check_alloc(ier, subname, 'day', ntimes=ntimes) + end if + istat = pio_inq_varid(ncid_sh, 'day', idv_day) + call check_ncerr(istat, subname, 'AMIE day id') + istat = pio_get_var(ncid_sh, idv_day, day) + call check_ncerr(istat, subname, 'AMIE day') + + if (.not. allocated(jday)) then + allocate(jday(ntimes), stat=ier) + call check_alloc(ier, subname, 'jday', ntimes=ntimes) + end if + istat = pio_inq_varid(ncid_sh, 'jday', idv_jday) + call check_ncerr(istat, subname, 'AMIE jday id') + istat = pio_get_var(ncid_sh, idv_jday, jday) + call check_ncerr(istat, subname, 'AMIE jday') + ! + ! Allocate 1-d fields: + if (.not. allocated(amie_sh_ut)) then + allocate(amie_sh_ut(ntimes), stat=ier) + call check_alloc(ier, subname, 'amie_sh_ut', ntimes=ntimes) + end if + if (.not. allocated(cusplat_sh_input)) then + allocate(cusplat_sh_input(ntimes), stat=ier) + call check_alloc(ier, subname, 'cusplat_sh_input', ntimes=ntimes) + end if + if (.not. allocated(cuspmlt_sh_input)) then + allocate(cuspmlt_sh_input(ntimes), stat=ier) + call check_alloc(ier, subname, 'cuspmlt_sh_input', ntimes=ntimes) + end if + if (.not. allocated(hpi_sh_input)) then + allocate(hpi_sh_input(ntimes), stat=ier) + call check_alloc(ier, subname, 'hpi_sh_input', ntimes=ntimes) + end if + if (.not. allocated(pcp_sh_input)) then + allocate(pcp_sh_input(ntimes), stat=ier) + call check_alloc(ier, subname, 'pcp_sh_input', ntimes=ntimes) + end if + ! + ! Get ut + istat = pio_inq_varid(ncid_sh, 'ut', idv_ut) + call check_ncerr(istat, subname, 'AMIE ut id') + istat = pio_get_var(ncid_sh, idv_ut, amie_sh_ut) + call check_ncerr(istat, subname, 'AMIE ut') + ! + ! Get HPI + istat = pio_inq_varid(ncid_sh, 'hpi', idv_hpi) + call check_ncerr(istat, subname, 'AMIE hpi id') + istat = pio_get_var(ncid_sh, idv_hpi, hpi_sh_input) + call check_ncerr(istat, subname, 'AMIE hpi') + ! + ! Get PCP + istat = pio_inq_varid(ncid_sh, 'pcp', idv_pcp) + call check_ncerr(istat, subname, 'AMIE pcp id') + istat = pio_get_var(ncid_sh, idv_pcp, pcp_sh_input) + call check_ncerr(istat, subname, 'AMIE pcp') + ! + ! Get cusplat + istat = pio_inq_varid(ncid_sh, 'cusplat', idv_cusplat) + call check_ncerr(istat, subname, 'AMIE cusplat id') + istat = pio_get_var(ncid_sh, idv_cusplat, cusplat_sh_input) + call check_ncerr(istat, subname, 'AMIE cusplat') + ! + ! Get cuspmlt + istat = pio_inq_varid(ncid_sh, 'cuspmlt', idv_cuspmlt) + call check_ncerr(istat, subname, 'AMIE cuspmlt id') + istat = pio_get_var(ncid_sh, idv_cuspmlt, cuspmlt_sh_input) + call check_ncerr(istat, subname, 'AMIE cuspmlt') + ! + ! Allocate 2-d fields: + if (.not. allocated(pot_sh_amie)) then + allocate(pot_sh_amie(lonp1, latp1), stat=ier) + call check_alloc(ier, subname, 'pot_sh_amie', lonp1=lonp1, latp1=latp1) + end if + if (.not. allocated(ekv_sh_amie)) then + allocate(ekv_sh_amie(lonp1, latp1), stat=ier) + call check_alloc(ier, subname, 'ekv_sh_amie', lonp1=lonp1, latp1=latp1) + end if + if (.not. allocated(efx_sh_amie)) then + allocate(efx_sh_amie(lonp1, latp1), stat=ier) + call check_alloc(ier, subname, 'efx_sh_amie', lonp1=lonp1, latp1=latp1) + end if + ! + ! Allocate 3-d fields: + if (.not. allocated(pot_sh_input)) then + allocate(pot_sh_input(lonp1, latp1, 2), stat=ier) + call check_alloc(ier, subname, 'pot_sh_input', & + lonp1=lonp1, latp1=latp1, ntimes=ntimes) + end if + if (.not. allocated(ekv_sh_input)) then + allocate(ekv_sh_input(lonp1, latp1, 2), stat=ier) + call check_alloc(ier, subname, 'ekv_sh_input', & + lonp1=lonp1, latp1=latp1, ntimes=ntimes) + end if + if (.not. allocated(efx_sh_input)) then + allocate(efx_sh_input(lonp1, latp1, 2), stat=ier) + call check_alloc(ier, subname, 'efx_sh_input', & + lonp1=lonp1, latp1=latp1, ntimes=ntimes) + end if + end subroutine rdamie_sh + + !----------------------------------------------------------------------- + subroutine update_3d_fields( ncid, offset, kount, pot_3d,ekv_3d,efx_3d ) + + type(file_desc_t), intent(in) :: ncid + integer, intent(in) :: offset(:) + integer, intent(in) :: kount(:) + real(r8),intent(out) :: pot_3d(:,:,:) + real(r8),intent(out) :: ekv_3d(:,:,:) + real(r8),intent(out) :: efx_3d(:,:,:) + + + integer :: istat + integer :: idv_pot, idv_ekv, idv_efx + character(len=*), parameter :: subname = 'update_3d_fields' + + ! + ! Get 3-D fields (lon,lat,ntimes) + ! + ! electric potential + istat = pio_inq_varid(ncid, 'pot', idv_pot) + call check_ncerr(istat, subname, 'AMIE pot id') + istat = pio_get_var(ncid, idv_pot, offset, kount, pot_3d) + call check_ncerr(istat, subname, 'AMIE pot') + ! + ! mean energy + istat = pio_inq_varid(ncid, 'ekv', idv_ekv) + call check_ncerr(istat, subname, 'AMIE ekv id') + istat = pio_get_var(ncid, idv_ekv, offset, kount, ekv_3d) + call check_ncerr(istat, subname, 'AMIE ekv') + ! + ! energy flux + istat = pio_inq_varid(ncid, 'efx', idv_efx) + call check_ncerr(istat, subname, 'AMIE efx id') + istat = pio_get_var(ncid, idv_efx, offset, kount, efx_3d) + call check_ncerr(istat, subname, 'AMIE efx') + + end subroutine update_3d_fields + + !----------------------------------------------------------------------- + subroutine getamie(iyear, imo, iday, iutsec, sunlon, iprint, & + iamie, phihm, amie_efxm, amie_kevm, crad) + use cam_history_support, only: fillvalue + use rgrd_mod, only: rgrd2 + + ! + ! Read AMIE outputs from amie_ncfile file, returning electric potential, + ! auroral mean energy and energy flux at current date and time, + ! and the data is linearly interpolated to the model time + ! gl - 12/07/2002 + ! + ! + ! Args: + + integer, intent(in) :: iyear + integer, intent(in) :: imo + integer, intent(in) :: iday + real(r8), intent(in) :: sunlon + integer, intent(in) :: iutsec + integer, intent(in) :: iprint + integer, intent(out) :: iamie + real(r8), intent(out) :: phihm(nmlonp1,nmlat) + real(r8), intent(out) :: amie_efxm(nmlonp1,nmlat) ! on geomag grid + real(r8), intent(out) :: amie_kevm(nmlonp1,nmlat) ! on geomag grid + real(r8), intent(out) :: crad(2) + ! + ! + ! Local: + real(r8) :: potm(lonp1,jmxm) + real(r8) :: efxm(lonp1,jmxm), ekvm(lonp1,jmxm) + real(r8) :: alat(jmxm), alon(lonp1) + real(r8) :: alatm(jmxm), alonm(lonp1) + integer :: ier, lw, liw, intpol(2) + integer, allocatable :: iw(:) + real(r8), allocatable :: w(:) + integer :: i, j + integer :: nn, iset1, iset2, m, mp1, n + integer :: iboxcar + real(r8) :: f1, f2 + real(r8) :: del, xmlt, dmlat, dlatm, dlonm, dmltm, rot + integer :: offset(3), kount(3) + character(len=*), parameter :: subname = 'getamie' + + phihm = fillvalue + amie_efxm = fillvalue + amie_kevm = fillvalue + crad = fillvalue + + if (iprint > 0 .and. masterproc) then + write(iulog,"(/,72('-'))") + write(iulog,"(a,':')") subname + write(iulog,"(a,i4,', iday = ',i3,', iutsec = ',i10)") & + 'Initial requested iyear= ', iyear, iday, iutsec + end if + + nn = size(amie_sh_ut) + ! + ! Check times: + ! + + iamie = 1 - time_coord_sh%times_check() + check_loop: do while( iamie/=1 ) + if (iamie==2) then + if (masterproc) then + write(iulog, "(a,': Model date prior to AMIE first date:',3I5)") & + subname, year(1), month(1), day(1) + end if + return + end if + + if (iamie==0) then + if (masterproc) then + write(iulog, "(a,': Model date beyond the AMIE last Data:',3I5)") & + subname, year(nn), month(nn), day(nn) + end if + + if (file_ndx 75.0_r8) then + cusplat_sh_amie = 75.0_r8 + cuspmlt_sh_amie = 11._r8 + end if + if (cusplat_sh_amie < 60.0_r8) then + cusplat_sh_amie = 60.0_r8 + cuspmlt_sh_amie = 11._r8 + end if + if (cusplat_nh_amie > 75.0_r8) then + cusplat_nh_amie = 75.0_r8 + cuspmlt_nh_amie = 11._r8 + end if + if (cusplat_nh_amie < 60.0_r8) then + cusplat_nh_amie = 60.0_r8 + cuspmlt_nh_amie = 11._r8 + end if + ! cusplat_nh_amie = amin1(65.0,cusplat_nh_amie) + if (cuspmlt_sh_amie > 12.5_r8) cuspmlt_sh_amie = 12.5_r8 + if (cuspmlt_sh_amie < 11.0_r8) cuspmlt_sh_amie = 11.0_r8 + if (cuspmlt_nh_amie > 12.5_r8) cuspmlt_nh_amie = 12.5_r8 + if (cuspmlt_nh_amie < 11.0_r8) cuspmlt_nh_amie = 11.0_r8 + crad(1) = (90._r8-cusplat_sh_amie)*pi/180._r8 + crad(2) = (90._r8-cusplat_nh_amie)*pi/180._r8 + + active_task: if ( mytid lonp1) mp1 = 2 + del = xmlt - (m-1)*dmltm + ! Initialize arrays around equator + do j = latp1+1, ithmx + potm(i,j) = 0._r8 + potm(i,jmxm+1-j) = 0._r8 + ekvm(i,j) = (1._r8-del)*ekv_sh_amie(m,latp1) + & + del*ekv_sh_amie(mp1,latp1) + ekvm(i,jmxm+1-j) = (1._r8-del)*ekv_nh_amie(m,latp1) + & + del*ekv_nh_amie(mp1,latp1) + efxm(i,j) = 0._r8 + efxm(i,jmxm+1-j) = 0._r8 + end do + ! Put in AMIE arrays from pole to latp1 + do j = 1, latp1 + potm(i,j) = (1._r8-del)*pot_sh_amie(m,j) + & + del*pot_sh_amie(mp1,j) + potm(i,jmxm+1-j) = (1._r8-del)*pot_nh_amie(m,j) + & + del*pot_nh_amie(mp1,j) + ekvm(i,j) = (1._r8-del)*ekv_sh_amie(m,j) + & + del*ekv_sh_amie(mp1,j) + ekvm(i,jmxm+1-j) = (1._r8-del)*ekv_nh_amie(m,j) + & + del*ekv_nh_amie(mp1,j) + efxm(i,j) = (1._r8-del)*efx_sh_amie(m,j) + & + del*efx_sh_amie(mp1,j) + efxm(i,jmxm+1-j) = (1._r8-del)*efx_nh_amie(m,j) + & + del*efx_nh_amie(mp1,j) + end do + + end do + + ! Set up coeffs to go between EPOTM(IMXMP,JMNH) and TIEPOT(IMAXM,JMAXMH) + + ! **** SET GRID SPACING DLATM, DLONM + ! DMLAT=lat spacing in degrees of AMIE apex grid + dmlat = 180._r8 / real(jmxm-1, kind=r8) + dlatm = dmlat * dtr + dlonm = 2._r8 * pi / real(lonmx, kind=r8) + dmltm = 24._r8 / real(lonmx, kind=r8) + ! **** + ! **** SET ARRAY YLATM (LATITUDE VALUES FOR GEOMAGNETIC GRID + ! **** + alatm(1) = -pi / 2._r8 + alat(1) = -90._r8 + alatm(jmxm) = pi / 2._r8 + alat(jmxm) = 90._r8 + do i = 2, ithmx + alat(i) = alat(i-1)+dlatm*rtd + alat(jmxm+1-i) = alat(jmxm+2-i)-dlatm*rtd + alatm(i) = alatm(i-1)+dlatm + alatm(jmxm+1-i) = alatm(jmxm+2-i)-dlatm + end do + alon(1) = -pi*rtd + alonm(1) = -pi + do i = 2, lonp1 + alon(i) = alon(i-1) + dlonm*rtd + alonm(i) = alonm(i-1) + dlonm + end do + + ! ylatm and ylonm are arrays of latitudes and longitudes of the + ! distorted magnetic grids in radian - from consdyn.h + ! Convert from apex magnetic grid to distorted magnetic grid + ! + ! Allocate workspace for regrid routine rgrd_mod: + lw = nmlonp1+nmlat+2*nmlonp1 + if (.not. allocated(w)) then + allocate(w(lw), stat=ier) + call check_alloc(ier, 'getamie', 'w', lw=lw) + end if + liw = nmlonp1 + nmlat + if (.not. allocated(iw)) then + allocate(iw(liw), stat=ier) + call check_alloc(ier, 'getamie', 'iw', lw=liw) + end if + intpol(:) = 1 ! linear (not cubic) interp in both dimensions + if (alatm(1) > ylatm(1)) then + alatm(1) = ylatm(1) + end if + if (alatm(jmxm) < ylatm(nmlat)) then + alatm(jmxm) = ylatm(nmlat) + end if + if (alonm(1) > ylonm(1)) then + alonm(1) = ylonm(1) + end if + if (alonm(lonp1) < ylonm(nmlonp1)) then + alonm(lonp1) = ylonm(nmlonp1) + end if + + ! ylatm from -pi/2 to pi/2, and ylonm from -pi to pi + call rgrd2(lonp1, jmxm, alonm, alatm, potm, nmlonp1, nmlat, & + ylonm, ylatm, phihm, intpol, w, lw, iw, liw, ier) + call rgrd2(lonp1, jmxm, alonm, alatm, ekvm, nmlonp1, nmlat, & + ylonm, ylatm, amie_kevm, intpol, w, lw, iw, liw, ier) + call rgrd2(lonp1, jmxm, alonm, alatm, efxm, nmlonp1, nmlat, & + ylonm, ylatm, amie_efxm, intpol, w, lw, iw, liw, ier) + + if (iprint > 0 .and. masterproc) then + write(iulog, *) subname, ': Max, min amie_efxm = ', & + maxval(amie_efxm), minval(amie_efxm) + write(iulog, "(a,': AMIE data interpolated to date and time')") subname + write(iulog,"(a,': iyear,imo,iday,iutsec = ',3i6,i10)") subname, & + iyear, imo, iday, iutsec + write(iulog,"(2a,i6,2F9.5,3I6,f10.4)") & + subname, ': AMIE iset1 f1,f2,year,mon,day,ut = ', iset1, & + f1, f2, year(iset1), month(iset1), day(iset1), amie_nh_ut(iset1) + write(iulog,*) subname, ': max,min phihm= ', maxval(phihm), minval(phihm) + end if + end if active_task + + end subroutine getamie + + !----------------------------------------------------------------------- + subroutine close_files + + deallocate( year,month,day ) + deallocate( cusplat_nh_input, cuspmlt_nh_input, hpi_nh_input, & + pcp_nh_input, amie_nh_ut, & + cusplat_sh_input, cuspmlt_sh_input, hpi_sh_input, & + pcp_sh_input, amie_sh_ut ) + + call cam_pio_closefile(ncid_nh) + call cam_pio_closefile(ncid_sh) + + + end subroutine close_files + !----------------------------------------------------------------------- + subroutine open_files() + + call rdamie_nh(amienh_files(file_ndx)) + call rdamie_sh(amiesh_files(file_ndx)) + + end subroutine open_files + +end module amie_module diff --git a/src/ionosphere/waccmx/dpie_coupling.F90 b/src/ionosphere/waccmx/dpie_coupling.F90 index b7f6b2b1c4..fad558296b 100644 --- a/src/ionosphere/waccmx/dpie_coupling.F90 +++ b/src/ionosphere/waccmx/dpie_coupling.F90 @@ -1,24 +1,22 @@ module dpie_coupling -! -! Dynamics/Physics Ionosphere/Electrodynamics coupler. -! B. Foster, 2015. -! - use shr_kind_mod ,only: r8 => shr_kind_r8 - use cam_logfile ,only: iulog - use cam_history ,only: outfld - use cam_history ,only: addfld, horiz_only + ! + ! Dynamics/Physics Ionosphere/Electrodynamics coupler. + ! + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_logfile, only: iulog + use cam_history, only: hist_fld_active, outfld + use cam_history, only: addfld, horiz_only use cam_history_support, only: fillvalue - use cam_abortutils ,only: endrun - use spmd_utils ,only: masterproc - use savefield_waccm ,only: savefld_waccm - use edyn_mpi ,only: array_ptr_type - use perf_mod ,only: t_startf, t_stopf - use amie_module ,only: getamie - use edyn_solve ,only: phihm - use edyn_params ,only: dtr, rtd - use edyn_mpi, only: switch_model_format - use aurora_params, only: amie_period ! turns on overwrite of energy fields in aurora phys - + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc, mpi_logical, mpicom, masterprocid + use edyn_mpi, only: array_ptr_type + use perf_mod, only: t_startf, t_stopf + use amie_module, only: getamie + use ltr_module, only: getltr + use edyn_solve, only: phihm + use edyn_params, only: dtr, rtd + use aurora_params, only: prescribed_period ! turns on overwrite of energy fields in aurora phys + implicit none private @@ -26,22 +24,28 @@ module dpie_coupling public :: d_pie_epotent ! sets electric potential public :: d_pie_coupling ! handles coupling with edynamo and ion transport - logical :: ionos_edyn_active, ionos_oplus_xport ! if true, call oplus_xport for O+ transport - integer :: nspltop ! nsplit for oplus_xport + logical :: ionos_edyn_active ! if true, call oplus_xport for O+ transport + logical :: ionos_oplus_xport ! if true, call oplus_xport for O+ transport + integer :: nspltop ! nsplit for oplus_xport - logical :: debug = .false. + logical :: debug = .false. real(r8) :: crad(2), crit(2) - logical :: crit_user_set = .false. + logical :: crit_user_set = .false. real(r8), parameter :: amie_default_crit(2) = (/ 35._r8, 40._r8 /) - + + logical :: debug_hist + contains -!---------------------------------------------------------------------- - subroutine d_pie_init( edyn_active_in, oplus_xport_in, oplus_nsplit_in, crit_colats_deg ) + !---------------------------------------------------------------------- + subroutine d_pie_init( edyn_active_in, oplus_xport_in, oplus_nsplit_in, crit_colats_deg, ionos_debug_hist ) logical, intent(in) :: edyn_active_in, oplus_xport_in integer, intent(in) :: oplus_nsplit_in real(r8),intent(in) :: crit_colats_deg(:) + logical, intent(in) :: ionos_debug_hist + + debug_hist = ionos_debug_hist ionos_edyn_active = edyn_active_in ionos_oplus_xport = oplus_xport_in @@ -50,833 +54,794 @@ subroutine d_pie_init( edyn_active_in, oplus_xport_in, oplus_nsplit_in, crit_col crit_user_set = all( crit_colats_deg(:) > 0._r8 ) if (crit_user_set) then crit(:) = crit_colats_deg(:)*dtr + end if + + call addfld ('HMF2' , horiz_only , 'I', 'km' ,'Height of the F2 Layer' , gridname='physgrid') + call addfld ('NMF2' , horiz_only , 'I', 'cm-3','Peak Density of the F2 Layer', gridname='physgrid') + + call addfld ('OpDens' ,(/ 'lev' /), 'I', 'cm^-3','O+ Number Density' , gridname='physgrid') + call addfld ('EDens' ,(/ 'lev' /), 'I', 'cm^-3','e Number Density (sum of O2+,NO+,N2+,O+)', gridname='physgrid') + + call addfld ('prescr_efxp' , horiz_only, 'I','mW/m2','Prescribed energy flux on geo grid' ,gridname='physgrid') + call addfld ('prescr_kevp' , horiz_only, 'I','keV ','Prescribed mean energy on geo grid' ,gridname='physgrid') + + call addfld ('prescr_phihm' , horiz_only, 'I','VOLTS','Prescribed Electric Potential-mag grid' ,gridname='gmag_grid') + call addfld ('prescr_efxm' , horiz_only, 'I','mW/m2','Prescribed energy flux on mag grid' ,gridname='gmag_grid') + call addfld ('prescr_kevm' , horiz_only, 'I','keV ','Prescribed mean energy on mag grid' ,gridname='gmag_grid') + + if (debug_hist) then + ! Dynamo inputs (called from dpie_coupling. Fields are in waccm format, in CGS units): + call addfld ('DPIE_OMEGA',(/ 'lev' /), 'I', 'Pa/s ','OMEGA input to DPIE coupling', gridname='physgrid') + call addfld ('DPIE_MBAR' ,(/ 'lev' /), 'I', 'kg/kmole','MBAR Mean Mass from dpie_coupling', gridname='physgrid') + call addfld ('DPIE_TN ',(/ 'lev' /), 'I', 'deg K ','DPIE_TN' , gridname='physgrid') + call addfld ('DPIE_UN ',(/ 'lev' /), 'I', 'cm/s ','DPIE_UN' , gridname='physgrid') + call addfld ('DPIE_VN ',(/ 'lev' /), 'I', 'cm/s ','DPIE_VN' , gridname='physgrid') + call addfld ('DPIE_WN ',(/ 'lev' /), 'I', 'cm/s ','DPIE_WN' , gridname='physgrid') + call addfld ('DPIE_OM ',(/ 'lev' /), 'I', 's-1 ','DPIE_OM' , gridname='physgrid') + call addfld ('DPIE_ZHT ',(/ 'lev' /), 'I', 'cm ','DPIE_ZHT (geometric height,simple)', gridname='physgrid') + call addfld ('DPIE_ZGI ',(/ 'lev' /), 'I', 'cm ','DPIE_ZGI (geopotential height on interfaces)', gridname='physgrid') + call addfld ('DPIE_O2 ',(/ 'lev' /), 'I', 'mmr ','DPIE_O2' , gridname='physgrid') + call addfld ('DPIE_O ',(/ 'lev' /), 'I', 'mmr ','DPIE_O' , gridname='physgrid') + call addfld ('DPIE_N2 ',(/ 'lev' /), 'I', 'mmr ','DPIE_N2' , gridname='physgrid') + call addfld ('DPIE_TE ',(/ 'lev' /), 'I', 'deg K ','DPIE_TE' , gridname='physgrid') + call addfld ('DPIE_TI ',(/ 'lev' /), 'I', 'deg K ','DPIE_TI' , gridname='physgrid') + + call addfld ('PED_phys',(/ 'lev' /), 'I', 'S/m','Pedersen Conductivity' , gridname='physgrid') + call addfld ('HAL_phys',(/ 'lev' /), 'I', 'S/m','Hall Conductivity' , gridname='physgrid') + + call addfld ('DPIE_OPMMR' ,(/ 'lev' /), 'I', 'mmr' ,'DPIE_OPMMR' , gridname='physgrid') + call addfld ('DPIE_O2P',(/ 'lev' /), 'I', 'm^-3','DPIE_O2P(dpie input)', gridname='physgrid') + call addfld ('DPIE_NOP',(/ 'lev' /), 'I', 'm^-3','DPIE_NOP(dpie input)', gridname='physgrid') + call addfld ('DPIE_N2P',(/ 'lev' /), 'I', 'm^-3','DPIE_N2P(dpie input)', gridname='physgrid') + + call addfld ('WACCM_UI' ,(/ 'lev' /), 'I', 'm/s' ,'WACCM_UI (dpie output)', gridname='physgrid') + call addfld ('WACCM_VI' ,(/ 'lev' /), 'I', 'm/s' ,'WACCM_VI (dpie output)', gridname='physgrid') + call addfld ('WACCM_WI' ,(/ 'lev' /), 'I', 'm/s' ,'WACCM_WI (dpie output)', gridname='physgrid') + call addfld ('WACCM_OP' ,(/ 'lev' /), 'I', 'kg/kg' ,'WACCM_OP (dpie output)', gridname='physgrid') + + call addfld ('EDYN_ADOTV1 ', (/ 'lev' /), 'I', ' ','EDYN_ADOTV1' , gridname='geo_grid') + call addfld ('EDYN_ADOTV2 ', (/ 'lev' /), 'I', ' ','EDYN_ADOTV2' , gridname='geo_grid') + call addfld ('EDYN_ADOTA1 ', horiz_only , 'I', ' ','EDYN_ADOTA1' , gridname='geo_grid') + call addfld ('EDYN_ADOTA2 ', horiz_only , 'I', ' ','EDYN_ADOTA2' , gridname='geo_grid') + call addfld ('EDYN_A1DTA2 ', horiz_only , 'I', ' ','EDYN_A1DTA2' , gridname='geo_grid') + + call addfld ('EDYN_SINI ', horiz_only , 'I', ' ','EDYN_SINI' , gridname='geo_grid') + call addfld ('EDYN_BE3 ', horiz_only , 'I', ' ','EDYN_BE3' , gridname='geo_grid') + + call addfld ('ADOTA1_MAG', horiz_only , 'I', ' ','ADOTA1 in geo-mag coords' , gridname='gmag_grid') + call addfld ('SINI_MAG', horiz_only , 'I', ' ','sini in geo-mag coords' , gridname='gmag_grid') + + call addfld ('OPLUS', (/ 'lev' /), 'I', 'cm^3','O+ (oplus_xport output)', gridname='geo_grid') + call addfld ('OPtm1i',(/ 'lev' /), 'I', 'cm^3','O+ (oplus_xport output)', gridname='geo_grid') + call addfld ('OPtm1o',(/ 'lev' /), 'I', 'cm^3','O+ (oplus_xport output)', gridname='geo_grid') endif - - ! Dynamo inputs (called from dpie_coupling. Fields are in waccm format, in CGS units): - call addfld ('DPIE_OMEGA',(/ 'lev' /), 'I', 'Pa/s ','OMEGA input to DPIE coupling', gridname='fv_centers') - call addfld ('DPIE_MBAR' ,(/ 'lev' /), 'I', ' ','MBAR Mean Mass from dpie_coupling', gridname='fv_centers') - call addfld ('DPIE_TN ',(/ 'lev' /), 'I', 'deg K ','DPIE_TN' , gridname='fv_centers') - call addfld ('DPIE_UN ',(/ 'lev' /), 'I', 'cm/s ','DPIE_UN' , gridname='fv_centers') - call addfld ('DPIE_VN ',(/ 'lev' /), 'I', 'cm/s ','DPIE_VN' , gridname='fv_centers') - call addfld ('DPIE_WN ',(/ 'lev' /), 'I', 'cm/s ','DPIE_WN' , gridname='fv_centers') - call addfld ('DPIE_OM ',(/ 'lev' /), 'I', 's-1 ','DPIE_OM' , gridname='fv_centers') - call addfld ('DPIE_ZHT ',(/ 'lev' /), 'I', 'cm ','DPIE_ZHT (geometric height,simple)', gridname='fv_centers') - call addfld ('DPIE_ZGI ',(/ 'lev' /), 'I', 'cm ','DPIE_ZGI (geopotential height on interfaces)', gridname='fv_centers') - call addfld ('DPIE_BARM ',(/ 'lev' /), 'I', ' ','DPIE_BARM' , gridname='fv_centers') - call addfld ('DPIE_O2 ',(/ 'lev' /), 'I', 'mmr ','DPIE_O2' , gridname='fv_centers') - call addfld ('DPIE_O ',(/ 'lev' /), 'I', 'mmr ','DPIE_O' , gridname='fv_centers') - call addfld ('DPIE_N2 ',(/ 'lev' /), 'I', 'mmr ','DPIE_N2' , gridname='fv_centers') - call addfld ('DPIE_TE ',(/ 'lev' /), 'I', 'deg K ','DPIE_TE' , gridname='fv_centers') - call addfld ('DPIE_TI ',(/ 'lev' /), 'I', 'deg K ','DPIE_TI' , gridname='fv_centers') - - call addfld ('DPIE_OPMMR' ,(/ 'lev' /), 'I', 'mmr' ,'DPIE_OPMMR' , gridname='fv_centers') - call addfld ('DPIE_O2P',(/ 'lev' /), 'I', 'm^3','DPIE_O2P(dpie input)', gridname='fv_centers') - call addfld ('DPIE_NOP',(/ 'lev' /), 'I', 'm^3','DPIE_NOP(dpie input)', gridname='fv_centers') - call addfld ('DPIE_N2P',(/ 'lev' /), 'I', 'm^3','DPIE_N2P(dpie input)', gridname='fv_centers') - - call addfld ('OPLUS', (/ 'lev' /), 'I', 'cm^3','O+ (oplus_xport output)', gridname='fv_centers') - call addfld ('WACCM_UI' ,(/ 'lev' /), 'I', 'm/s' ,'WACCM_UI (dpie output)', gridname='fv_centers') - call addfld ('WACCM_VI' ,(/ 'lev' /), 'I', 'm/s' ,'WACCM_VI (dpie output)', gridname='fv_centers') - call addfld ('WACCM_WI' ,(/ 'lev' /), 'I', 'm/s' ,'WACCM_WI (dpie output)', gridname='fv_centers') - - call addfld ('HMF2' , horiz_only , 'I', 'km' ,'Height of the F2 Layer' , gridname='fv_centers') - call addfld ('NMF2' , horiz_only , 'I', 'cm-3','Peak Density of the F2 Layer', gridname='fv_centers') - - call addfld ('Z3GM' ,(/ 'lev' /), 'I', 'm' ,'Geometric height' , gridname='fv_centers') - call addfld ('Z3GMI ',(/ 'lev' /), 'I', 'm' ,'Geometric height (Interfaces)', gridname='fv_centers') - call addfld ('OpDens' ,(/ 'lev' /), 'I', 'cm^3','O+ Number Density' , gridname='fv_centers') - call addfld ('EDens' ,(/ 'lev' /), 'I', 'cm^3','e Number Density (sum of O2+,NO+,N2+,O+)', gridname='fv_centers') end subroutine d_pie_init -!----------------------------------------------------------------------- - subroutine d_pie_epotent( highlat_potential_model, crit_out, i0,i1,j0,j1, efxg, kevg ) - use edyn_solve, only: pfrac ! NH fraction of potential (nmlonp1,nmlat0) - use edyn_geogrid,only: nglblat=>nlat - use time_manager,only: get_curr_date - use heelis, only: heelis_model - use wei05sc, only: weimer05 ! driver for weimer high-lat convection model - use edyn_esmf, only: edyn_esmf_update - use solar_parms_data,only: solar_parms_advance - use solar_wind_data, only: solar_wind_advance - use solar_wind_data, only: bzimf=>solar_wind_bzimf, byimf=>solar_wind_byimf - use solar_wind_data, only: swvel=>solar_wind_swvel, swden=>solar_wind_swden - use edyn_mpi, only: mlat0,mlat1,mlon0,omlon1 - use edyn_maggrid ,only: nmlonp1,nmlat -! Args: -! - character(len=*),intent(in) :: highlat_potential_model - real(r8), intent(out):: crit_out(2) ! critical colatitudes (degrees) - integer,optional,intent(in) :: & - i0, & ! grid%ifirstxy - i1, & ! grid%ilastxy - j0, & ! grid%jfirstxy - j1 ! grid%jlastxy - real(r8),optional,intent(out) :: efxg(:,:) ! energy flux from AMIE - real(r8),optional,intent(out) :: kevg(:,:) ! characteristic mean energy from AMIE + !----------------------------------------------------------------------- + subroutine d_pie_epotent( highlat_potential_model, crit_out, cols, cole, efx_phys, kev_phys, amie_in, ltr_in ) + use edyn_solve, only: pfrac ! NH fraction of potential (nmlonp1,nmlat0) + use time_manager, only: get_curr_date + use heelis, only: heelis_model + use wei05sc, only: weimer05 ! driver for weimer high-lat convection model + use edyn_esmf, only: edyn_esmf_update + use solar_parms_data, only: solar_parms_advance + use solar_wind_data, only: solar_wind_advance + use solar_wind_data, only: bzimf=>solar_wind_bzimf + use solar_wind_data, only: byimf=>solar_wind_byimf + use solar_wind_data, only: swvel=>solar_wind_swvel + use solar_wind_data, only: swden=>solar_wind_swden + use edyn_mpi, only: mlat0, mlat1, mlon0, mlon1, omlon1, ntask, mytid + use edyn_maggrid, only: nmlonp1, nmlat + use regridder, only: regrid_mag2phys_2d + + ! Args: + ! + character(len=*), intent(in) :: highlat_potential_model + real(r8), intent(out) :: crit_out(2) ! critical colatitudes (degrees) + integer, optional, intent(in) :: cols, cole + logical, optional,intent(in) :: amie_in + logical, optional,intent(in) :: ltr_in + + ! Prescribed energy flux + real(r8), optional, intent(out) :: efx_phys(:) + ! Prescribed characteristic mean energy + real(r8), optional, intent(out) :: kev_phys(:) + ! ! local vars ! + logical :: amie_inputs, ltr_inputs - real(r8) :: secs ! time of day in seconds - integer :: iyear,imo,iday,tod ! tod is time-of-day in seconds - real(r8) :: sunlons(nglblat) + real(r8) :: secs ! time of day in seconds + integer :: iyear,imo,iday,tod ! tod is time-of-day in seconds + real(r8) :: sunlon - integer :: iprint,amie_ibkg - integer :: i, j, iamie - type(array_ptr_type) :: ptrs(2) + integer :: iprint + integer :: j, iamie, iltr, ierr ! ! AMIE fields (extra dimension added for longitude switch) ! - real(r8) :: amie_efxm(nmlonp1,nmlat), amie_kevm(nmlonp1,nmlat) ! auroral energy flux and - real(r8) :: amie_phihm(nmlonp1,nmlat) - real(r8),allocatable,target :: amie_efxg (:,:,:) ! AMIE energy flux - real(r8),allocatable,target :: amie_kevg (:,:,:) ! AMIE characteristic mean energy - + real(r8) :: prescr_efxm(nmlonp1,nmlat), prescr_kevm(nmlonp1,nmlat) + real(r8) :: prescr_phihm(nmlonp1,nmlat) + call edyn_esmf_update() - call get_curr_date(iyear,imo,iday,tod) ! tod is integer time-of-day in seconds - secs = tod ! should promote from int to real(r8) + call get_curr_date(iyear, imo,iday, tod) + ! tod is integer time-of-day in seconds + secs = real(tod, r8) ! update solar wind data (IMF, etc.) call solar_wind_advance() ! update kp -- phys timestep init happens later ... call solar_parms_advance() - - - ! - ! Get sun's longitude at latitudes (geographic): - ! - call sunloc(iday,secs,sunlons) ! sunlons(nglblat) is returned - ! - ! Get high-latitude convection from empirical model (heelis or weimer). - ! High-latitude potential phihm (edyn_solve) is defined for edynamo. - ! - if (trim(highlat_potential_model) == 'heelis') then - call heelis_model(sunlons) ! heelis.F90 - elseif (trim(highlat_potential_model) == 'weimer') then + if ( mytid>> iamie=',i2)") iamie - - call getamie(iyear,imo,iday,tod,sunlons(1),amie_ibkg,iprint,iamie, & - amie_phihm,amie_efxm,amie_kevm,crad,efxg,kevg) - - if (masterproc) write(iulog,"('After Calling getamie >>> iamie=',i2)") iamie - amie_period = iamie == 1 - - do j=mlat0,mlat1 - call outfld('amie_phihm',amie_phihm(mlon0:omlon1,j),omlon1-mlon0+1,j) - call outfld('amie_efxm',amie_efxm(mlon0:omlon1,j),omlon1-mlon0+1,j) - call outfld('amie_kevm',amie_kevm(mlon0:omlon1,j),omlon1-mlon0+1,j) - enddo + amie_inputs=.false. + ltr_inputs=.false. + if (present(amie_in)) amie_inputs=amie_in + if (present(ltr_in)) ltr_inputs= ltr_in - if (amie_period) then + prescribed_inputs: if (amie_inputs .or. ltr_inputs) then - phihm = amie_phihm + if (.not. (present(kev_phys).and.present(efx_phys)) ) then + call endrun('d_pie_epotent: kev_phys and efx_phys must be present') + end if - ! Load AMIE fields into pointers for TIE-GCM to WACCM longitude swap - ! - allocate(amie_efxg(1,i0:i1,j0:j1)) - allocate(amie_kevg(1,i0:i1,j0:j1)) + iprint = 1 + if (amie_inputs) then + if (masterproc) then + write(iulog,*) 'Calling getamie >>> ' + end if - do i=i0,i1 - do j=j0,j1 - amie_efxg(1,i,j) = efxg(i-i0+1,j-j0+1) - amie_kevg(1,i,j) = kevg(i-i0+1,j-j0+1) - enddo - enddo + call getamie(iyear, imo, iday, tod, sunlon, iprint, iamie, & + prescr_phihm, prescr_efxm, prescr_kevm, crad) - ptrs(1)%ptr => amie_efxg - ptrs(2)%ptr => amie_kevg - call switch_model_format(ptrs,1,1,i0,i1,j0,j1, 2) + if (masterproc) then + write(iulog,"('After Calling getamie >>> iamie = ', i2)") iamie + end if + prescribed_period = iamie == 1 + else + if (masterproc) then + write(iulog,*) 'Calling getltr >>> ' + end if - do i=i0,i1 - do j=j0,j1 - efxg(i-i0+1,j-j0+1) = amie_efxg(1,i,j) - kevg(i-i0+1,j-j0+1) = amie_kevg(1,i,j) - enddo - enddo + call getltr(iyear, imo, iday, tod,sunlon, iprint, iltr, & + prescr_phihm, prescr_efxm, prescr_kevm ) - deallocate(amie_efxg) - deallocate(amie_kevg) + if (masterproc) then + write(iulog,"('After Calling getltr >>> iltr = ', i2)") iltr + end if + prescribed_period = iltr == 1 + end if - endif + do j = mlat0, mlat1 + call outfld('prescr_phihm',prescr_phihm(mlon0:omlon1,j),omlon1-mlon0+1,j) + call outfld('prescr_efxm', prescr_efxm(mlon0:omlon1,j), omlon1-mlon0+1,j) + call outfld('prescr_kevm', prescr_kevm(mlon0:omlon1,j), omlon1-mlon0+1,j) + end do - call savefld_waccm(efxg,'amie_efxg',1,i0,i1,j0,j1) - call savefld_waccm(kevg,'amie_kevg',1,i0,i1,j0,j1) + if (prescribed_period) then + phihm = prescr_phihm + end if - endif - - call calc_pfrac(sunlons(1),pfrac) ! returns pfrac for dynamo (edyn_solve) + call mpi_bcast(prescribed_period, 1, mpi_logical, masterprocid, mpicom, ierr) - crit_out(:) = crit(:)*rtd ! degrees - end subroutine d_pie_epotent + call regrid_mag2phys_2d(prescr_kevm(mlon0:mlon1,mlat0:mlat1), kev_phys, cols, cole) + call regrid_mag2phys_2d(prescr_efxm(mlon0:mlon1,mlat0:mlat1), efx_phys, cols, cole) -!----------------------------------------------------------------------- - subroutine d_pie_coupling(omega,pe,zgi,zgpmid,u,v,tn, & - sigma_ped,sigma_hall,te,ti,o2mmr,o1mmr,h1mmr,o2pmmr, & - nopmmr,n2pmmr,opmmr,opmmrtm1,ui,vi,wi, & - rmassO2,rmassO1,rmassH,rmassN2,rmassO2p, rmassNOp,rmassN2p,rmassOp, & - i0,i1,j0,j1) -! -! Call dynamo to calculate electric potential, electric field, and ion drifts. -! Then call oplus_xport to transport O+, which is passed back to physics. -! -! This routine is called from p_d_coupling (dynamics/fv/dp_coupling.F90) when -! nstep > 0. -! - use edyn_geogrid, only: nlev, nilev - use shr_const_mod,only: & - grav => shr_const_g, & ! gravitational constant (m/s^2) - kboltz => shr_const_boltz ! Boltzmann constant (J/K/molecule) - use time_manager, only: get_nstep - use time_manager, only: get_curr_date - use edynamo, only: dynamo - use edyn_mpi, only: mp_geo_halos,mp_pole_halos - use oplus, only: oplus_xport - use ref_pres, only: pref_mid -! -! Args: -! - integer,intent(in) :: & - i0, & ! grid%ifirstxy - i1, & ! grid%ilastxy - j0, & ! grid%jfirstxy - j1 ! grid%jlastxy - - real(r8),intent(in) :: omega (i0:i1,j0:j1,nlev) ! pressure velocity on midpoints (Pa/s) (i,k,j) - real(r8),intent(in) :: pe (i0:i1,nilev,j0:j1) ! interface pressure (Pa) (note i,k,j dims) - real(r8),intent(in) :: zgi (i0:i1,j0:j1,nlev) ! geopotential height (on interfaces) (m) - real(r8),intent(in) :: zgpmid (i0:i1,j0:j1,nlev) ! geopotential height (on midpoints) (m) - real(r8),intent(in) :: u (i0:i1,j0:j1,nlev) ! U-wind (m/s) - real(r8),intent(in) :: v (i0:i1,j0:j1,nlev) ! V-wind (m/s) - real(r8),intent(in) :: tn (i0:i1,j0:j1,nlev) ! neutral temperature (K) - real(r8),intent(in) :: sigma_ped (i0:i1,j0:j1,nlev) ! Pedersen conductivity - real(r8),intent(in) :: sigma_hall(i0:i1,j0:j1,nlev) ! Hall conductivity - real(r8),intent(in) :: te(i0:i1,j0:j1,nlev) ! electron temperature - real(r8),intent(in) :: ti(i0:i1,j0:j1,nlev) ! ion temperature - real(r8),intent(in) :: o2mmr(i0:i1,j0:j1,nlev) ! O2 mass mixing ratio (for oplus) - real(r8),intent(in) :: o1mmr(i0:i1,j0:j1,nlev) ! O mass mixing ratio (for oplus) - real(r8),intent(in) :: h1mmr(i0:i1,j0:j1,nlev) ! H mass mixing ratio (for oplus) - real(r8),intent(in) :: o2pmmr(i0:i1,j0:j1,nlev) ! O2+ mass mixing ratio (for oplus) - real(r8),intent(in) :: nopmmr(i0:i1,j0:j1,nlev) ! NO+ mass mixing ratio (for oplus) - real(r8),intent(in) :: n2pmmr(i0:i1,j0:j1,nlev) ! N2+ mass mixing ratio (for oplus) - real(r8),intent(inout) :: opmmr(i0:i1,j0:j1,nlev) ! O+ mass mixing ratio (oplus_xport output) - real(r8),intent(inout) :: opmmrtm1(i0:i1,j0:j1,nlev) ! O+ previous time step (oplus_xport output) - real(r8),intent(inout) :: ui(i0:i1,j0:j1,nlev) ! zonal ion drift (edynamo or empirical) - real(r8),intent(inout) :: vi(i0:i1,j0:j1,nlev) ! meridional ion drift (edynamo or empirical) - real(r8),intent(inout) :: wi(i0:i1,j0:j1,nlev) ! vertical ion drift (edynamo or empirical) - real(r8),intent(in) :: rmassO2 ! O2 molecular weight kg/kmol - real(r8),intent(in) :: rmassO1 ! O atomic weight kg/kmol - real(r8),intent(in) :: rmassH ! H atomic weight kg/kmol - real(r8),intent(in) :: rmassN2 ! N2 molecular weight kg/kmol - real(r8),intent(in) :: rmassO2p ! O2+ molecular weight kg/kmol - real(r8),intent(in) :: rmassNOp ! NO+ molecular weight kg/kmol - real(r8),intent(in) :: rmassN2p ! N2+ molecular weight kg/kmol - real(r8),intent(in) :: rmassOp ! O+ molecular weight kg/kmol -! -! Local: -! - integer :: i,j,k - integer :: kx ! Vertical index at peak of F2 layer electron density - integer :: nstep - integer :: nfields ! Number of fields for multi-field calls - integer :: iyear,imo,iday,tod ! tod is time-of-day in seconds - integer :: isplit ! loop index - - real(r8) :: secs ! time of day in seconds - - real(r8), parameter :: n2min = 1.e-6_r8 ! lower limit of N2 mixing ratios - real(r8), parameter :: small = 1.e-25_r8 ! for fields not currently available - real(r8) :: zht (i0:i1,j0:j1,nlev) ! geometric height (m) (Simple method - interfaces) - real(r8) :: zhtmid(i0:i1,j0:j1,nlev)! geometric height (m) (Simple method - midpoints) - real(r8) :: wn (i0:i1,j0:j1,nlev) ! vertical velocity (from omega) - real(r8) :: mbar (i0:i1,j0:j1,nlev) ! mean molecular weight - real(r8) :: n2mmr(i0:i1,j0:j1,nlev) ! N2 mass mixing ratio (for oplus) - real(r8) :: pmid_inv(nlev) ! inverted reference pressure at midpoints (Pa) - real(r8) :: pmid(i0:i1,nlev,j0:j1) ! pressure at midpoints (Pa) (global i,j) - real(r8) :: re = 6.370e6_r8 ! earth radius (m) - - real(r8),dimension(i0:i1,j0:j1,nlev) :: & ! ion number densities (m^3) - o2p,nop,n2p,op,ne, optm1 - - real(r8),dimension(nlev,i0:i1,j0:j1) :: opmmr_kij -! -! Args for dynamo: - real(r8),target :: edyn_tn (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_un (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_vn (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_wn (nlev,i0:i1,j0:j1) ! vertical wind (cm/s) - real(r8),target :: edyn_zht (nlev,i0:i1,j0:j1) ! geometric height (cm) - real(r8),target :: edyn_mbar (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_ped (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_hall (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_ui (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_vi (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_wi (nlev,i0:i1,j0:j1) -! -! Additional fields needed by oplus_xport: - real(r8),target :: edyn_te (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_ti (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_o2 (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_o1 (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_n2 (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_op (nlev,i0:i1,j0:j1) - real(r8),target :: edyn_optm1(nlev,i0:i1,j0:j1) - real(r8),target :: edyn_om (nlev,i0:i1,j0:j1) ! omega vertical motion (1/s) - real(r8),target :: edyn_zgi (nlev,i0:i1,j0:j1) ! geopotential height (cm) (interfaces) - real(r8),target :: op_out (nlev,i0:i1,j0:j1) ! oplus_xport output - real(r8),target :: opnm_out (nlev,i0:i1,j0:j1) ! oplus_xport output at time n-1 - real(r8),target :: edyn_ne (nlev,i0:i1,j0:j1) ! electron density diagnostic - - real(r8),target :: halo_tn (nlev,i0-2:i1+2,j0-2:j1+2) ! neutral temperature (deg K) - real(r8),target :: halo_te (nlev,i0-2:i1+2,j0-2:j1+2) ! electron temperature (deg K) - real(r8),target :: halo_ti (nlev,i0-2:i1+2,j0-2:j1+2) ! ion temperature (deg K) - real(r8),target :: halo_un (nlev,i0-2:i1+2,j0-2:j1+2) ! neutral zonal wind (cm/s) - real(r8),target :: halo_vn (nlev,i0-2:i1+2,j0-2:j1+2) ! neutral meridional wind (cm/s) - real(r8),target :: halo_om (nlev,i0-2:i1+2,j0-2:j1+2) ! omega (1/s) - real(r8),target :: halo_o2 (nlev,i0-2:i1+2,j0-2:j1+2) ! o2 (mmr) - real(r8),target :: halo_o1 (nlev,i0-2:i1+2,j0-2:j1+2) ! o (mmr) - real(r8),target :: halo_n2 (nlev,i0-2:i1+2,j0-2:j1+2) ! n2 (mmr) - real(r8),target :: halo_mbar(nlev,i0-2:i1+2,j0-2:j1+2) ! mean molecular weight - real(r8), allocatable :: polesign(:) -! - real(r8) :: nmf2 (i0:i1,j0:j1) ! Electron number density at F2 peak (m-3 converted to cm-3) - real(r8) :: hmf2 (i0:i1,j0:j1) ! Height of electron number density F2 peak (m converted to km) - real(r8) :: & - height(3), & ! Surrounding heights when locating electron density F2 peak - nde(3) ! Surround densities when locating electron density F2 peak - real(r8) h12,h22,h32,deltx,atx,ax,btx,bx,ctx,cx ! Variables used for weighting when locating F2 peak -! - logical :: do_integrals -! -! Pointers for multiple-field calls: - type(array_ptr_type),allocatable :: ptrs(:) - - call t_startf('d_pie_coupling') + call outfld_phys1d( 'prescr_efxp', efx_phys ) + call outfld_phys1d( 'prescr_kevp', kev_phys ) - if (debug.and.masterproc) then + end if prescribed_inputs - nstep = get_nstep() - call get_curr_date(iyear,imo,iday,tod) ! tod is integer time-of-day in seconds - secs = tod ! integer to float + if ( mytid= ne(i,j,k-1) .and. ne(i,j,k) >= ne(i,j,k+1)) then - kx = k - exit kloop - endif - enddo kloop +! Pointers for multiple-field calls: + type(array_ptr_type),allocatable :: ptrs(:) - if (kx==0) then - hmf2(i,j) = fillvalue - nmf2(i,j) = fillvalue - exit iloop - endif + character(len=*), parameter :: subname = 'd_pie_coupling' + + real(r8), dimension(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1) :: & ! 3d fields on mag grid + ped_mag, & ! pedersen conductivity on magnetic grid + hal_mag, & ! hall conductivity on magnetic grid + zpot_mag ! geopotential on magnetic grid + + real(r8), dimension(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1) :: & ! 3d fields on mag grid + ped_mag_in, & ! pedersen conductivity on magnetic grid + hal_mag_in, & ! hall conductivity on magnetic grid + zpot_mag_in ! geopotential on magnetic grid + + real(r8), dimension(lon0:lon1,lat0:lat1,lev0:lev1) :: & ! 3d fields on geo grid + zpot_geo, & ! geopotential on magnetic grid + tn_geo, & + te_geo, & + ti_geo, & + un_geo, & + vn_geo, & + wn_geo, & + ui_geo, & + vi_geo, & + wi_geo, & + omega_geo, & + o2_geo, & + o_geo, & + n2_geo, & + op_geo, & + optm1_geo, & + pmid_geo, & + mbar_geo + + real(r8), dimension(lon0:lon1,lat0:lat1,lev0:lev1) :: & + adotv1_in, adotv2_in + real(r8), dimension(lon0:lon1,lat0:lat1) :: & + adota1_in, adota2_in, a1dta2_in, be3_in, sini_in + + real(r8), dimension(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1) :: & + adotv1_mag, adotv2_mag + real(r8), dimension(mlon0:mlon1,mlat0:mlat1) :: & + adota1_mag, adota2_mag, a1dta2_mag, be3_mag, sini_mag + + call t_startf(subname) + + if (debug .and. masterproc) then + + nstep = get_nstep() + call get_curr_date(iyear, imo, iday, tod) + secs = real(tod, r8) + + write(iulog,"(3a,i8,a,3i5,a,f6.2)") & + 'Enter ',subname,': nstep = ',nstep, ', iyear,imo,iday = ', & + iyear, imo, iday, ' ut (hrs) = ', secs/3600._r8 + + write(iulog,"(a,': nspltop = ',i3)") subname, nspltop + end if + + !--------------------------------------------------------------- + ! Calculate vertical neutral wind velocity wn(i,j,k). + ! (omega (Pa/s), tn (K), and mbar (kg/kmole) are inputs, grav is m/s^2) + !--------------------------------------------------------------- + call calc_wn(tn, omega, pmid, mbar, grav, wn, cols, cole, nlev) + + !--------------------------------------------------------------- + ! Convert from mmr to number densities (m^3): + !--------------------------------------------------------------- + do i = cols, cole + do k = 1, nlev + ! O2+, NO+, N2+, O+: + o2p(k, i) = o2pmmr(k, i) * mbar(k, i) / rmassO2p * & + pmid(k,i) / (kboltz * tn(k, i)) + nop(k, i) = nopmmr(k, i) * mbar(k, i) / rmassNOp * & + pmid(k,i) / (kboltz * tn(k, i)) + n2p(k, i) = n2pmmr(k, i) * mbar(k, i) / rmassN2p * & + pmid(k,i) / (kboltz * tn(k, i)) + op(k, i) = opmmr(k, i) * mbar(k, i) / rmassOp * & + pmid(k,i) / (kboltz * tn(k, i)) + optm1(k, i) = opmmrtm1(k, i) * mbar(k, i) / rmassOp * & + pmid(k,i) / (kboltz * tn(k, i)) + ne(k, i) = o2p(k,i)+nop(k,i)+n2p(k,i)+op(k,i) + end do + end do ! k=1,nlev + + if (debug_hist) then + call outfld_phys('DPIE_TN',tn) + call outfld_phys('DPIE_UN',u* 100._r8) + call outfld_phys('DPIE_VN',v* 100._r8) + call outfld_phys('DPIE_WN',wn* 100._r8) + call outfld_phys('DPIE_ZHT',zht* 100._r8) + call outfld_phys('DPIE_ZGI',zgi* 100._r8) + call outfld_phys('DPIE_MBAR',mbar) + + call outfld_phys('DPIE_N2',n2mmr) + call outfld_phys('DPIE_O2',o2mmr) + call outfld_phys('DPIE_O',o1mmr) + + call outfld_phys('DPIE_OMEGA',omega) + call outfld_phys('DPIE_OM',-omega/pmid) + + call outfld_phys('DPIE_TE',te) + call outfld_phys('DPIE_TI',ti) + + call outfld_phys('DPIE_O2P',o2p) + call outfld_phys('DPIE_NOP',nop) + call outfld_phys('DPIE_N2P',n2p) + endif + call outfld_phys('EDens',ne/1.E6_r8) + call outfld_phys('OpDens',op/1.E6_r8) + + !------------------------------------------------------------------------- + ! Derive diagnostics nmF2 and hmF2 for output based on TIE-GCM algorithm + !------------------------------------------------------------------------- + if (hist_fld_active('HMF2') .or. hist_fld_active('NMF2')) then + iloop: do i = cols, cole + kx = 0 + kloop: do k= 2, nlev + if (ne(k,i) >= ne(k-1,i) .and. ne(k,i) >= ne(k+1,i)) then + kx = k + exit kloop + end if + end do kloop + + if (kx==0) then + hmf2(i) = fillvalue + nmf2(i) = fillvalue + exit iloop + end if + + height = (/zht(kx+1,i),zht(kx,i),zht(kx-1,i)/) + nde = (/ne(kx+1,i),ne(kx,i),ne(kx-1,i)/) + + h12 = height(1)*height(1) + h22 = height(2)*height(2) + h32 = height(3)*height(3) + + deltx=h12*height(2)+h22*height(3)+h32*height(1)-h32*height(2)-h12*height(3)-h22*height(1) + + atx=nde(1)*height(2)+nde(2)*height(3)+nde(3)*height(1)-height(2)*nde(3)-height(3)*nde(1)-height(1)*nde(2) + ax=atx/deltx + + btx=h12*nde(2)+h22*nde(3)+h32*nde(1)-h32*nde(2)-h12*nde(3)-h22*nde(1) + bx=btx/deltx + ctx=h12*height(2)*nde(3)+h22*height(3)*nde(1)+h32*height(1)*nde(2)-h32*height(2)*nde(1)- & + h12*height(3)*nde(2)-h22*height(1)*nde(3) + cx=ctx/deltx + + hmf2(i)=-(bx/(2._r8*ax)) * 1.E-03_r8 + nmf2(i)=-((bx*bx-4._r8*ax*cx)/(4._r8*ax)) * 1.E-06_r8 + + end do iloop ! i=cols, cole + + call outfld_phys1d('HMF2',hmf2) + call outfld_phys1d('NMF2',nmf2) + end if + if (debug_hist) then + call outfld_phys('DPIE_OPMMR', opmmr) + call outfld_phys('PED_phys', sigma_ped ) + call outfld_phys('HAL_phys', sigma_hall ) + endif + if (ionos_edyn_active .or. ionos_oplus_xport) then + + call regrid_phys2geo_3d( zgi,zpot_geo, plev, cols, cole ) + call regrid_phys2geo_3d( u, un_geo, plev, cols, cole ) + call regrid_phys2geo_3d( v, vn_geo, plev, cols, cole ) + call regrid_phys2geo_3d( wn,wn_geo, plev, cols, cole ) + call regrid_phys2geo_3d( ui, ui_geo, plev, cols, cole ) + call regrid_phys2geo_3d( vi, vi_geo, plev, cols, cole ) + call regrid_phys2geo_3d( wi, wi_geo, plev, cols, cole ) + + do k = 1, nlev + kk = nlev-k+1 + do j = lat0, lat1 + do i = lon0, lon1 + zpot_in(kk,i,j) = zpot_geo(i,j,k) * 100._r8 ! m -> cm + halo_un(kk,i,j) = un_geo(i,j,k) * 100._r8 ! m/s -> cm/s + halo_vn(kk,i,j) = vn_geo(i,j,k) * 100._r8 ! m/s -> cm/s + wn_in(kk,i,j) = wn_geo(i,j,k) * 100._r8 ! m/s -> cm/s + ui_in(kk,i,j) = ui_geo(i,j,k) * 100._r8 ! zonal ion drift (m/s -> cm/s) + vi_in(kk,i,j) = vi_geo(i,j,k) * 100._r8 ! meridional ion drift (m/s -> cm/s) + wi_in(kk,i,j) = wi_geo(i,j,k) * 100._r8 ! vertical ion drift (m/s -> cm/s) + end do + end do + end do + + end if - height = (/zht(i,j,kx+1),zht(i,j,kx),zht(i,j,kx-1)/) - nde = (/ne(i,j,kx+1),ne(i,j,kx),ne(i,j,kx-1)/) + ! + ! + ! Call electrodynamo (edynamo.F90) + ! If using time3d conductances, tell dynamo to *not* do fieldline + ! integrations (i.e., do_integrals == false). In this case, edynamo + ! conductances zigmxx,rim1,2 from time3d will be set by subroutine + ! transform_glbin in time3d module. + ! + do_integrals = .true. + ! + ! If ionos_edyn_active=false, then empirical ion drifts were passed in from physics, + ! otherwise dynamo calculates them here, and they will be passed to physics. + ! + if (ionos_edyn_active) then - h12 = height(1)*height(1) - h22 = height(2)*height(2) - h32 = height(3)*height(3) + call t_startf('dpie_ionos_dynamo') - deltx=h12*height(2)+h22*height(3)+h32*height(1)-h32*height(2)-h12*height(3)-h22*height(1) - atx=nde(1)*height(2)+nde(2)*height(3)+nde(3)*height(1)-height(2)*nde(3)-height(3)*nde(1)-height(1)*nde(2) - ax=atx/deltx + call calc_adotv( zpot_in(lev0:lev1,lon0:lon1,lat0:lat1), & + halo_un(lev0:lev1,lon0:lon1,lat0:lat1), & + halo_vn(lev0:lev1,lon0:lon1,lat0:lat1), & + wn_in(lev0:lev1,lon0:lon1,lat0:lat1), & + adotv1_in, adotv2_in, adota1_in, adota2_in, & + a1dta2_in, be3_in, sini_in, lev0, lev1, lon0, lon1, lat0, lat1) + + call regrid_geo2mag_3d( adotv1_in, adotv1_mag ) + call regrid_geo2mag_3d( adotv2_in, adotv2_mag ) + if (debug_hist) then + call outfld_geo('EDYN_ADOTV1', adotv1_in(:,:,lev1:lev0:-1) ) + call outfld_geo('EDYN_ADOTV2', adotv2_in(:,:,lev1:lev0:-1) ) + + call outfld_geo2d( 'EDYN_ADOTA1', adota1_in ) + call outfld_geo2d( 'EDYN_ADOTA2', adota2_in ) + call outfld_geo2d( 'EDYN_A1DTA2', a1dta2_in ) + call outfld_geo2d( 'EDYN_BE3' , be3_in ) + call outfld_geo2d( 'EDYN_SINI', sini_in ) + endif + call regrid_geo2mag_2d( adota1_in, adota1_mag ) + call regrid_geo2mag_2d( adota2_in, adota2_mag ) + call regrid_geo2mag_2d( a1dta2_in, a1dta2_mag ) + call regrid_geo2mag_2d( be3_in, be3_mag ) + call regrid_geo2mag_2d( sini_in, sini_mag ) + if (debug_hist) then + call outfld_mag2d('ADOTA1_MAG', adota1_mag ) + call outfld_mag2d('SINI_MAG', sini_mag ) + endif + call regrid_phys2mag_3d( sigma_ped, ped_mag, plev, cols, cole ) + call regrid_phys2mag_3d( sigma_hall, hal_mag, plev, cols, cole ) + call regrid_phys2mag_3d( zgi, zpot_mag, plev, cols, cole ) + + if (mytid cm + ped_mag_in(:,:,mlev0:mlev1) = ped_mag(:,:,mlev1:mlev0:-1) + hal_mag_in(:,:,mlev0:mlev1) = hal_mag(:,:,mlev1:mlev0:-1) + + call dynamo( zpot_mag_in, ped_mag_in, hal_mag_in, adotv1_mag, adotv2_mag, adota1_mag, & + adota2_mag, a1dta2_mag, be3_mag, sini_mag, & + zpot_in, ui_in, vi_in, wi_in, & + lon0,lon1, lat0,lat1, lev0,lev1, do_integrals ) + endif - btx=h12*nde(2)+h22*nde(3)+h32*nde(1)-h32*nde(2)-h12*nde(3)-h22*nde(1) - bx=btx/deltx - ctx=h12*height(2)*nde(3)+h22*height(3)*nde(1)+h32*height(1)*nde(2)-h32*height(2)*nde(1)- & - h12*height(3)*nde(2)-h22*height(1)*nde(3) - cx=ctx/deltx + call t_stopf ('dpie_ionos_dynamo') - hmf2(i,j)=-(bx/(2._r8*ax)) * 1.E-03_r8 - nmf2(i,j)=-((bx*bx-4._r8*ax*cx)/(4._r8*ax)) * 1.E-06_r8 + else + if (debug .and. masterproc) then + write(iulog,"('dpie_coupling (dynamo NOT called): nstep=',i8)") nstep + write(iulog,"(' empirical ExB ui min,max (cm/s)=',2es12.4)") & + minval(ui),maxval(ui) + write(iulog,"(' empirical ExB vi min,max (cm/s)=',2es12.4)") & + minval(vi),maxval(vi) + write(iulog,"(' empirical ExB wi min,max (cm/s)=',2es12.4)") & + minval(wi),maxval(wi) + end if + end if - enddo iloop ! i=i0,i1 + ! + ! Call O+ transport routine. Now all inputs to oplus_xport should be in + ! tiegcm-format wrt longitude (-180->180), vertical (bot2top), and units (CGS). + ! (Composition is mmr, ne is cm^3, winds are cm/s) + ! Output op_out and opnm_out will be in cm^3, converted to mmr below. + ! + if (ionos_oplus_xport) then + pmid_inv(1:nlev) = pref_mid(nlev:1:-1) ! invert ref pressure (Pa) as in tiegcm - call outfld('HMF2',hmf2(i0:i1,j),i1-i0+1,j) - call outfld('NMF2',nmf2(i0:i1,j),i1-i0+1,j) - enddo jloop -! -! Save fields to waccm history: -! (must be transformed from (i,j,k) to (k,i,j)) -! - do j=j0,j1 - do i=i0,i1 - opmmr_kij(:,i,j) = opmmr(i,j,:) - enddo - enddo - call savefld_waccm(opmmr_kij,'DPIE_OPMMR',nlev,i0,i1,j0,j1) ! mmr -! -! Prepare inputs to edynamo and oplus_xport: -! - do k = 1,nlev - edyn_tn (k,i0:i1,j0:j1) = tn (i0:i1,j0:j1,k) - edyn_un (k,i0:i1,j0:j1) = u (i0:i1,j0:j1,k) * 100._r8 ! m/s -> cm/s - edyn_vn (k,i0:i1,j0:j1) = v (i0:i1,j0:j1,k) * 100._r8 ! m/s -> cm/s - edyn_wn (k,i0:i1,j0:j1) = wn (i0:i1,j0:j1,k) * 100._r8 ! m/s -> cm/s - edyn_zgi (k,i0:i1,j0:j1) = zgi (i0:i1,j0:j1,k) * 100._r8 ! m -> cm - edyn_zht (k,i0:i1,j0:j1) = zht (i0:i1,j0:j1,k) * 100._r8 ! m -> cm - edyn_mbar (k,i0:i1,j0:j1) = mbar (i0:i1,j0:j1,k) - edyn_ped (k,i0:i1,j0:j1) = sigma_ped (i0:i1,j0:j1,k) - edyn_hall (k,i0:i1,j0:j1) = sigma_hall(i0:i1,j0:j1,k) - edyn_ui (k,i0:i1,j0:j1) = ui (i0:i1,j0:j1,k) * 100._r8 ! zonal ion drift (m/s -> cm/s) - edyn_vi (k,i0:i1,j0:j1) = vi (i0:i1,j0:j1,k) * 100._r8 ! meridional ion drift (m/s -> cm/s) - edyn_wi (k,i0:i1,j0:j1) = wi (i0:i1,j0:j1,k) * 100._r8 ! vertical ion drift (m/s -> cm/s) -! -! Additional fields for oplus: -! - edyn_te (k,i0:i1,j0:j1) = te (i0:i1,j0:j1,k) - edyn_ti (k,i0:i1,j0:j1) = ti (i0:i1,j0:j1,k) - edyn_o2 (k,i0:i1,j0:j1) = o2mmr (i0:i1,j0:j1,k) - edyn_o1 (k,i0:i1,j0:j1) = o1mmr (i0:i1,j0:j1,k) - edyn_n2 (k,i0:i1,j0:j1) = n2mmr (i0:i1,j0:j1,k) - edyn_om (k,i0:i1,j0:j1) = -(omega(i0:i1,j0:j1,k) / pmid(i0:i1,k,j0:j1)) ! Pa/s -> 1/s - edyn_op (k,i0:i1,j0:j1) = op (i0:i1,j0:j1,k) / 1.e6_r8 ! m^3 -> cm^3 - edyn_optm1(k,i0:i1,j0:j1) = optm1 (i0:i1,j0:j1,k) / 1.e6_r8 ! m^3 -> cm^3 - enddo -! -! At first timestep, allocate optm1 module data, and initialize local -! edyn_optm1 to op from physics. This will be input to oplus_xport. -! After oplus_xport, optm1 will be updated from local oplus_xport output. -! After first timestep, simply update edyn_optm1 from optm1. -! optm1 is m^3 for waccm, whereas edyn_optm1 is cm^3 for oplus_xport. -! -! At this point, everything is in waccm format. The locals edyn_op and -! edyn_optm1 will be converted to tiegcm format for the call to oplus_xport, -! then oplus_xport output (opnm_out) will be converted back to waccm format -! before using it to update optm1 module data. -! -! if (nstep==1) then -! optm1 = 0._r8 -! do k=1,nlev -! edyn_optm1(k,i0:i1,j0:j1) = op(i0:i1,j0:j1,k) / 1.e6_r8 ! m^3 -> cm^3 -! enddo -! -! After the first step, edyn_optm1 input is updated from the module data -! (note edyn_optm1 will be converted to TIEGCM format before being -! passed in to oplus_xport) -! -! else ! nstep > 1 -! do k=1,nlev -! edyn_optm1(k,i0:i1,j0:j1) = optm1(i0:i1,j0:j1,k) / 1.e6_r8 ! m^3 -> cm^3 -! enddo -! endif -! -! These are in WACCM format, and most are in CGS units (see above): -! (units are specified in addfld calls, edyn_init.F90) -! - call savefld_waccm(edyn_tn ,'DPIE_TN' ,nlev,i0,i1,j0,j1) ! deg K - call savefld_waccm(edyn_un ,'DPIE_UN' ,nlev,i0,i1,j0,j1) ! cm/s - call savefld_waccm(edyn_vn ,'DPIE_VN' ,nlev,i0,i1,j0,j1) ! cm/s - call savefld_waccm(edyn_wn ,'DPIE_WN' ,nlev,i0,i1,j0,j1) ! cm/s - call savefld_waccm(edyn_om ,'DPIE_OM' ,nlev,i0,i1,j0,j1) ! omega on midpoints (1/s) - call savefld_waccm(edyn_zht ,'DPIE_ZHT' ,nlev,i0,i1,j0,j1) ! geometric height (cm) - call savefld_waccm(edyn_zgi ,'DPIE_ZGI' ,nlev,i0,i1,j0,j1) ! geopotential height on interfaces (cm) - call savefld_waccm(edyn_mbar ,'DPIE_BARM',nlev,i0,i1,j0,j1) ! mean mass - call savefld_waccm(edyn_o2 ,'DPIE_O2' ,nlev,i0,i1,j0,j1) ! cm^3 - call savefld_waccm(edyn_o1 ,'DPIE_O' ,nlev,i0,i1,j0,j1) ! cm^3 - call savefld_waccm(edyn_n2 ,'DPIE_N2' ,nlev,i0,i1,j0,j1) ! cm^3 - call savefld_waccm(edyn_te ,'DPIE_TE' ,nlev,i0,i1,j0,j1) - call savefld_waccm(edyn_ti ,'DPIE_TI' ,nlev,i0,i1,j0,j1) -! -! Save electron density to TIEGCM-format file (edynamo.nc): -! (ne(i,j,k) was calculated in m^3 above, save here in cm^3) -! - do j=j0,j1 - do i=i0,i1 - do k=1,nlev - edyn_ne(k,i,j) = ne(i,j,k)*1.e-6_r8 ! m^3 -> cm^3 - enddo - enddo - enddo -! -! Convert input fields from "WACCM format" to "TIEGCM format" -! (phase shift longitude data and invert the vertical dimension). -! - if (ionos_edyn_active) then - nfields = 21 - allocate(ptrs(nfields)) - ! - ! Fields needed for edynamo: - ptrs(1)%ptr => edyn_tn ; ptrs(2)%ptr => edyn_un ; ptrs(3)%ptr => edyn_vn - ptrs(4)%ptr => edyn_wn ; ptrs(5)%ptr => edyn_zht ; ptrs(6)%ptr => edyn_zgi - ptrs(7)%ptr => edyn_mbar ; ptrs(8)%ptr => edyn_ped ; ptrs(9)%ptr => edyn_hall ! - ! Additional fields needed for oplus (and Ne for diag): - ptrs(10)%ptr => edyn_te ; ptrs(11)%ptr => edyn_ti ; ptrs(12)%ptr => edyn_o2 - ptrs(13)%ptr => edyn_o1 ; ptrs(14)%ptr => edyn_n2 ; ptrs(15)%ptr => edyn_om - ptrs(16)%ptr => edyn_op ; ptrs(17)%ptr => edyn_optm1 ; ptrs(18)%ptr => edyn_ne - ptrs(19)%ptr => edyn_ui ; ptrs(20)%ptr => edyn_vi ; ptrs(21)%ptr => edyn_wi + ! Transport O+ (all args in 'TIEGCM format') + ! Subcycle oplus_xport nspltop times. ! - ! Convert from WACCM to TIEGCM format: - call switch_model_format(ptrs,1,nlev,i0,i1,j0,j1,nfields) - deallocate(ptrs) - endif -! -! Call electrodynamo (edynamo.F90) -! If using time3d conductances, tell dynamo to *not* do fieldline -! integrations (i.e., do_integrals == false). In this case, edynamo -! conductances zigmxx,rim1,2 from time3d will be set by subroutine -! transform_glbin in time3d module. -! - do_integrals = .true. -! -! If ionos_edyn_active=false, then empirical ion drifts were passed in from physics, -! otherwise dynamo calculates them here, and they will be passed to physics. -! - if (ionos_edyn_active) then + if (debug .and. masterproc) then + write(iulog,"(a,i8,a,i3)") & + 'dpie_coupling before subcycling oplus_xport: nstep = ', & + nstep, ' nspltop = ', nspltop + end if + + call regrid_phys2geo_3d( tn, tn_geo, plev, cols, cole ) + call regrid_phys2geo_3d( te, te_geo, plev, cols, cole ) + call regrid_phys2geo_3d( ti, ti_geo, plev, cols, cole ) + call regrid_phys2geo_3d( omega, omega_geo, plev, cols, cole ) + call regrid_phys2geo_3d( o2mmr, o2_geo, plev, cols, cole ) + call regrid_phys2geo_3d( n2mmr, n2_geo, plev, cols, cole ) + call regrid_phys2geo_3d( o1mmr, o_geo, plev, cols, cole ) + call regrid_phys2geo_3d( op, op_geo, plev, cols, cole ) + call regrid_phys2geo_3d( optm1, optm1_geo, plev, cols, cole ) + call regrid_phys2geo_3d( pmid, pmid_geo, plev, cols, cole ) + call regrid_phys2geo_3d( mbar, mbar_geo, plev, cols, cole ) + + if (mytid 1/s + halo_o2(kk,i,j) = o2_geo(i,j,k) + halo_o1(kk,i,j) = o_geo(i,j,k) + halo_n2(kk,i,j) = n2_geo(i,j,k) + halo_mbar(kk,i,j) = mbar_geo(i,j,k) + op_in(kk,i,j) = op_geo(i,j,k) / 1.e6_r8 ! m^3 -> cm^3 + optm1_in(kk,i,j) = optm1_geo(i,j,k) / 1.e6_r8 ! m^3 -> cm^3 + end do + end do + end do + ! + ! Define halo points on inputs: + ! WACCM has global longitude values at the poles (j=1,j=nlev) + ! (they are constant for most, except the winds.) + ! + ! Set two halo points in lat,lon: + ! + nfields = 10 + allocate(ptrs(nfields), polesign(nfields)) + ptrs(1)%ptr => halo_tn ; ptrs(2)%ptr => halo_te ; ptrs(3)%ptr => halo_ti + ptrs(4)%ptr => halo_un ; ptrs(5)%ptr => halo_vn ; ptrs(6)%ptr => halo_om + ptrs(7)%ptr => halo_o2 ; ptrs(8)%ptr => halo_o1 ; ptrs(9)%ptr => halo_n2 + ptrs(10)%ptr => halo_mbar - if (debug.and.masterproc) then - write(iulog,"('dpie_coupling call dynamo... nstep=',i8)") nstep - write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edyn_tn ', & - MINVAL(edyn_tn(:,i0:i1,j0:j1)), MAXVAL(edyn_tn(:,i0:i1,j0:j1)) - write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edyn_un ', & - MINVAL(edyn_un(:,i0:i1,j0:j1)), MAXVAL(edyn_un(:,i0:i1,j0:j1)) - write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edyn_vn ', & - MINVAL(edyn_un(:,i0:i1,j0:j1)), MAXVAL(edyn_vn(:,i0:i1,j0:j1)) - write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edyn_wn ', & - MINVAL(edyn_wn(:,i0:i1,j0:j1)), MAXVAL(edyn_wn(:,i0:i1,j0:j1)) - write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edynz_zgi ', & - MINVAL(edyn_zgi(:,i0:i1,j0:j1)), MAXVAL(edyn_zgi(:,i0:i1,j0:j1)) - write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edynz_ped ', & - MINVAL(edyn_ped(:,i0:i1,j0:j1)), MAXVAL(edyn_ped(:,i0:i1,j0:j1)) - write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edynz_hall ', & - MINVAL(edyn_hall(:,i0:i1,j0:j1)), MAXVAL(edyn_hall(:,i0:i1,j0:j1)) - write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edynz_op ', & - MINVAL(edyn_op(:,i0:i1,j0:j1)), MAXVAL(edyn_op(:,i0:i1,j0:j1)) - write(iulog,*) 'dpie_coupling: before dynamo MIN/MAX edynz_optm1 ', & - MINVAL(edyn_optm1(:,i0:i1,j0:j1)), MAXVAL(edyn_optm1(:,i0:i1,j0:j1)) - endif + polesign = 1._r8 + polesign(4:5) = -1._r8 ! un,vn - call t_startf('dpie_ionos_dynamo') - call dynamo(edyn_tn, edyn_un, edyn_vn, edyn_wn, edyn_zgi, & - edyn_ped, edyn_hall, edyn_ui, edyn_vi, edyn_wi, & - 1,nlev,i0,i1,j0,j1,do_integrals) - call t_stopf ('dpie_ionos_dynamo') + call mp_geo_halos(ptrs,1,nlev,lon0,lon1,lat0,lat1,nfields) + ! + ! Set latitude halo points over the poles (this does not change the poles). + ! (the 2nd halo over the poles will not actually be used (assuming lat loops + ! are lat=2,plat-1), because jp1,jm1 will be the pole itself, and jp2,jm2 + ! will be the first halo over the pole) + ! + call mp_pole_halos(ptrs,1,nlev,lon0,lon1,lat0,lat1,nfields,polesign) + deallocate(ptrs,polesign) + call t_stopf('dpie_halo') + if (debug_hist) then + call outfld_geokij( 'OPtm1i',optm1_in, lev0,lev1, lon0,lon1, lat0,lat1 ) + endif + call t_startf('dpie_oplus_xport') + do isplit = 1, nspltop + + if (isplit > 1) then + op_in = op_out + optm1_in = optm1_out + end if + + call oplus_xport(halo_tn, halo_te, halo_ti, halo_un, halo_vn, halo_om, & + zpot_in, halo_o2, halo_o1, halo_n2, op_in, optm1_in, & + halo_mbar, ui_in, vi_in, wi_in, pmid_inv, & + op_out, optm1_out, & + lon0, lon1, lat0, lat1, nspltop, isplit) + + end do ! isplit=1,nspltop + call t_stopf ('dpie_oplus_xport') + if (debug.and.masterproc) then + write(iulog,"('dpie_coupling after subcycling oplus_xport: nstep=',i8,' nspltop=',i3)") & + nstep,nspltop + write(iulog,"(' op_out min,max (cm^3)=',2es12.4)") minval(op_out) ,maxval(op_out) + write(iulog,"(' optm1_out min,max (cm^3)=',2es12.4)") minval(optm1_out),maxval(optm1_out) + end if + if (debug_hist) then + call outfld_geokij( 'OPLUS', op_out, lev0,lev1, lon0,lon1, lat0,lat1 ) + call outfld_geokij( 'OPtm1o',optm1_out, lev0,lev1, lon0,lon1, lat0,lat1 ) + endif + ! + ! Pass new O+ for current and previous time step back to physics (convert from cm^3 to m^3 and back to mmr). + ! + do k=1,nlev + kk = nlev-k+1 + do j = lat0,lat1 + do i = lon0,lon1 + op_geo(i,j,k) = op_out(kk,i,j)*1.e6_r8 * rmassOp / mbar_geo(i,j,k) * & + (kboltz * tn_geo(i,j,k)) / pmid_geo(i,j,k) + optm1_geo(i,j,k) = optm1_out(kk,i,j)*1.e6_r8 * rmassOp / mbar_geo(i,j,k) * & + (kboltz * tn_geo(i,j,k)) / pmid_geo(i,j,k) + ui_geo(i,j,k) = ui_in(kk,i,j)/100._r8 ! cm/s -> m/s + vi_geo(i,j,k) = vi_in(kk,i,j)/100._r8 ! cm/s -> m/s + wi_geo(i,j,k) = wi_in(kk,i,j)/100._r8 ! cm/s -> m/s + end do + end do + end do - if (debug.and.masterproc) then - write(iulog,"('dpie_coupling after dynamo: nstep=',i8)") nstep - write(iulog,"(' ui min,max (cm/s)=',2es12.4)") minval(edyn_ui),maxval(edyn_ui) - write(iulog,"(' vi min,max (cm/s)=',2es12.4)") minval(edyn_vi),maxval(edyn_vi) - write(iulog,"(' wi min,max (cm/s)=',2es12.4)") minval(edyn_wi),maxval(edyn_wi) - endif - else - if (debug.and.masterproc) then - write(iulog,"('dpie_coupling (dynamo NOT called): nstep=',i8)") nstep - write(iulog,"(' empirical ExB ui min,max (cm/s)=',2es12.4)") minval(ui),maxval(ui) - write(iulog,"(' empirical ExB vi min,max (cm/s)=',2es12.4)") minval(vi),maxval(vi) - write(iulog,"(' empirical ExB wi min,max (cm/s)=',2es12.4)") minval(wi),maxval(wi) endif - endif -! -! Call O+ transport routine. Now all inputs to oplus_xport should be in -! tiegcm-format wrt longitude (-180->180), vertical (bot2top), and units (CGS). -! (Composition is mmr, ne is cm^3, winds are cm/s) -! Output op_out and opnm_out will be in cm^3, converted to mmr below. -! - if (ionos_oplus_xport) then - pmid_inv(1:nlev) = pref_mid(nlev:1:-1) ! invert ref pressure (Pa) as in tiegcm + call regrid_geo2phys_3d( op_geo, opmmr, plev, cols, cole ) + call regrid_geo2phys_3d( optm1_geo, opmmrtm1, plev, cols, cole ) + call regrid_geo2phys_3d( ui_geo, ui, plev, cols, cole ) + call regrid_geo2phys_3d( vi_geo, vi, plev, cols, cole ) + call regrid_geo2phys_3d( wi_geo, wi, plev, cols, cole ) -! -! Transport O+ (all args in 'TIEGCM format') -! Subcycle oplus_xport nspltop times. -! - if (debug.and.masterproc) & - write(iulog,"('dpie_coupling before subcycling oplus_xport: nstep=',i8,' nspltop=',i3)") nstep,nspltop - - call t_startf('dpie_halo') -!$omp parallel do private(i, j, k) - do k=1,nlev - do j=j0,j1 - do i=i0,i1 - halo_tn(k,i,j) = edyn_tn(k,i,j) - halo_te(k,i,j) = edyn_te(k,i,j) - halo_ti(k,i,j) = edyn_ti(k,i,j) - halo_un(k,i,j) = edyn_un(k,i,j) - halo_vn(k,i,j) = edyn_vn(k,i,j) - halo_om(k,i,j) = edyn_om(k,i,j) - halo_o2(k,i,j) = edyn_o2(k,i,j) - halo_o1(k,i,j) = edyn_o1(k,i,j) - halo_n2(k,i,j) = edyn_n2(k,i,j) - halo_mbar(k,i,j) = edyn_mbar(k,i,j) - enddo - enddo - enddo - ! - ! Define halo points on inputs: - ! WACCM has global longitude values at the poles (j=1,j=nlev) - ! (they are constant for most, except the winds.) - ! - ! Set two halo points in lat,lon: - ! - nfields=10 - allocate(ptrs(nfields),polesign(nfields)) - ptrs(1)%ptr => halo_tn ; ptrs(2)%ptr => halo_te ; ptrs(3)%ptr => halo_ti - ptrs(4)%ptr => halo_un ; ptrs(5)%ptr => halo_vn ; ptrs(6)%ptr => halo_om - ptrs(7)%ptr => halo_o2 ; ptrs(8)%ptr => halo_o1 ; ptrs(9)%ptr => halo_n2 - ptrs(10)%ptr => halo_mbar - - polesign = 1._r8 - polesign(4:5) = -1._r8 ! un,vn - - call mp_geo_halos(ptrs,1,nlev,i0,i1,j0,j1,nfields) - ! - ! Set latitude halo points over the poles (this does not change the poles). - ! (the 2nd halo over the poles will not actually be used (assuming lat loops - ! are lat=2,plat-1), because jp1,jm1 will be the pole itself, and jp2,jm2 - ! will be the first halo over the pole) - ! - call mp_pole_halos(ptrs,1,nlev,i0,i1,j0,j1,nfields,polesign) - deallocate(ptrs,polesign) - call t_stopf('dpie_halo') - - call t_startf('dpie_oplus_xport') - do isplit=1,nspltop - - if (isplit > 1) then - edyn_op = op_out - edyn_optm1 = opnm_out - endif - - call oplus_xport(halo_tn,halo_te,halo_ti,halo_un,halo_vn,halo_om, & - edyn_zgi,halo_o2,halo_o1,halo_n2,edyn_op,edyn_optm1, & - halo_mbar,edyn_ui,edyn_vi,edyn_wi,pmid_inv, & - op_out,opnm_out, & - i0,i1,j0,j1,nspltop,isplit) - - enddo ! isplit=1,nspltop - call t_stopf ('dpie_oplus_xport') - - if (debug.and.masterproc) then - write(iulog,"('dpie_coupling after subcycling oplus_xport: nstep=',i8,' nspltop=',i3)") & - nstep,nspltop - write(iulog,"(' op_out min,max (cm^3)=',2es12.4)") minval(op_out) ,maxval(op_out) - write(iulog,"(' opnm_out min,max (cm^3)=',2es12.4)") minval(opnm_out),maxval(opnm_out) - endif - - endif ! ionos_oplus_xport -! -! Convert ion drifts and O+ output from TIEGCM to WACCM format: -! - if (ionos_edyn_active) then - nfields = 5 ! ui,vi,wi,op,opnm - allocate(ptrs(nfields)) - ptrs(1)%ptr => edyn_ui ; ptrs(2)%ptr => edyn_vi ; ptrs(3)%ptr => edyn_wi - ptrs(4)%ptr => op_out ; ptrs(5)%ptr => opnm_out - call switch_model_format(ptrs,1,nlev,i0,i1,j0,j1,nfields) - deallocate(ptrs) - endif -! - if (ionos_oplus_xport) then - call savefld_waccm(op_out,'OPLUS',nlev,i0,i1,j0,j1) ! cm^3 -! -! Pass new O+ for current and previous time step back to physics (convert from cm^3 to m^3 and back to mmr). -! - do k=1,nlev - do j=j0,j1 - do i=i0,i1 - opmmr(i,j,k) = op_out(k,i,j)*1.e6_r8 * rmassOp / mbar(i,j,k) * & - (kboltz * tn(i,j,k)) / pmid(i,k,j) - op_out(k,i,j) = opmmr(i,j,k) ! for save to waccm hist in mmr - opmmrtm1(i,j,k) = opnm_out(k,i,j)*1.e6_r8 * rmassOp / mbar(i,j,k) * & - (kboltz * tn(i,j,k)) / pmid(i,k,j) - enddo - enddo - enddo - - endif ! ionos_oplus_xport -! -! Convert ion drifts from cm/s to m/s for WACCM physics and history files. -! real(r8),intent(inout) :: ui(i0:i1,j0:j1,nlev) ! zonal ion drift (edynamo or empirical) -! - do k=1,nlev - do j=j0,j1 - do i=i0,i1 - ui(i,j,k) = edyn_ui(k,i,j)/100._r8 - vi(i,j,k) = edyn_vi(k,i,j)/100._r8 - wi(i,j,k) = edyn_wi(k,i,j)/100._r8 - enddo - enddo - enddo - call savefld_waccm(edyn_ui/100._r8,'WACCM_UI',nlev,i0,i1,j0,j1) - call savefld_waccm(edyn_vi/100._r8,'WACCM_VI',nlev,i0,i1,j0,j1) - call savefld_waccm(edyn_wi/100._r8,'WACCM_WI',nlev,i0,i1,j0,j1) + end if ! ionos_oplus_xport + if (debug_hist) then + call outfld_phys('WACCM_UI',ui) + call outfld_phys('WACCM_VI',vi) + call outfld_phys('WACCM_WI',wi) + call outfld_phys('WACCM_OP',opmmr) + endif call t_stopf('d_pie_coupling') end subroutine d_pie_coupling -!----------------------------------------------------------------------- - subroutine calc_wn(tn,omega,pmid,mbar,grav,wn,i0,i1,j0,j1,nlev) - use shr_const_mod,only : shr_const_rgas ! Universal gas constant -! -! Calculate neutral vertical wind on midpoints (m/s) -! -! Inputs: - integer,intent(in) :: i0,i1,j0,j1,nlev - real(r8),dimension(i0:i1,j0:j1,nlev),intent(in) :: & - tn, & ! neutral temperature (deg K) - omega,& ! pressure velocity (Pa/s) - mbar ! mean molecular weight - real(r8),dimension(i0:i1,nlev,j0:j1),intent(in) :: & - pmid ! pressure at midpoints (Pa) - real(r8),intent(in) :: grav ! m/s^2 -! -! Output: - real(r8),intent(out) :: wn(i0:i1,j0:j1,nlev) ! vertical velocity output (m/s) -! -! Local: - integer :: i,j,k - real(r8) :: scheight(i0:i1,j0:j1,nlev) ! dimensioned for vectorization - - do k=1,nlev - do j=j0,j1 - do i=i0,i1 - scheight(i,j,k) = shr_const_rgas*tn(i,j,k)/(mbar(i,j,k)*grav) - wn(i,j,k) = -omega(i,j,k)*scheight(i,j,k)/pmid(i,k,j) - enddo - enddo - enddo + !----------------------------------------------------------------------- + subroutine calc_wn(tn,omega,pmid,mbar,grav,wn,cols,cole,nlev) + use shr_const_mod,only : shr_const_rgas ! Universal gas constant + ! + ! Calculate neutral vertical wind on midpoints (m/s) + ! + ! Inputs: + integer,intent(in) :: cols, cole, nlev + real(r8),dimension(nlev, cols:cole),intent(in) :: & + tn, & ! neutral temperature (deg K) + omega,& ! pressure velocity (Pa/s) + mbar ! mean molecular weight + real(r8),dimension(nlev,cols:cole),intent(in) :: & + pmid ! pressure at midpoints (Pa) + real(r8),intent(in) :: grav ! m/s^2 + ! + ! Output: + real(r8),intent(out) :: wn(nlev, cols:cole) ! vertical velocity output (m/s) + ! + ! Local: + integer :: i,k + real(r8) :: scheight(nlev, cols:cole) ! dimensioned for vectorization + + do i = cols, cole + do k = 1, nlev + scheight(k,i) = shr_const_rgas*tn(k,i)/(mbar(k,i)*grav) + wn(k,i) = -omega(k,i)*scheight(k,i)/pmid(k,i) + end do + end do end subroutine calc_wn -!----------------------------------------------------------------------- + !----------------------------------------------------------------------- subroutine calc_pfrac(sunlon,pfrac) -! -! Calculate pfrac fractional presence of dynamo equation using critical -! convection colatitudes crit(2). -! + ! + ! Calculate pfrac fractional presence of dynamo equation using critical + ! convection colatitudes crit(2). + ! use edyn_maggrid ,only: nmlonp1,ylonm,ylatm use edyn_solve ,only: nmlat0 use aurora_params ,only: offc, dskofc, theta0, aurora_params_set implicit none -! -! Args: + ! + ! Args: real(r8),intent(in) :: sunlon ! Sun's longitude in dipole coordinates -! -! Output: fractional presence of dynamo equation using critical colatitudes -! + ! + ! Output: fractional presence of dynamo equation using critical colatitudes + ! real(r8),intent(out) :: pfrac(nmlonp1,nmlat0) ! NH fraction of potential -! -! Local: + ! + ! Local: integer :: j,i real(r8),dimension(nmlonp1,nmlat0) :: colatc real(r8) :: sinlat,coslat,aslonc,ofdc,cosofc,sinofc,crit1deg if (.not. crit_user_set) then - if (amie_period) then + if (prescribed_period) then crit(:) = amie_default_crit(:)*dtr else crit1deg = max(15._r8,0.5_r8*(theta0(1)+theta0(2))*rtd + 5._r8) @@ -885,108 +850,228 @@ subroutine calc_pfrac(sunlon,pfrac) ! Critical colatitudes: crit(1) = crit1deg*dtr crit(2) = crit(1) + 15._r8*dtr - endif - endif + end if + end if if (.not.aurora_params_set) then offc(:) = 1._r8*dtr dskofc(:) = 0._r8 - endif + end if -! -! offc(2), dskofc(2) are for northern hemisphere aurora -! - ofdc = sqrt(offc(2)**2+dskofc(2)**2) + ! + ! offc(2), dskofc(2) are for northern hemisphere aurora + ! + ofdc = sqrt(offc(2)**2 + dskofc(2)**2) cosofc = cos(ofdc) sinofc = sin(ofdc) aslonc = asin(dskofc(2)/ofdc) -! -! Define colatc with northern convection circle coordinates -! + ! + ! Define colatc with northern convection circle coordinates + ! do j=1,nmlat0 - sinlat = sin(abs(ylatm(j+nmlat0-1))) - coslat = cos( ylatm(j+nmlat0-1)) - do i=1,nmlonp1 - colatc(i,j) = cos(ylonm(i)-sunlon+aslonc) - colatc(i,j) = acos(cosofc*sinlat-sinofc*coslat*colatc(i,j)) - enddo ! i=1,nmlonp1 -! -! Calculate fractional presence of dynamo equation at each northern -! hemisphere geomagnetic grid point. Output in pfrac(nmlonp1,nmlat0) -! - do i=1,nmlonp1 - pfrac(i,j) = (colatc(i,j)-crit(1))/(crit(2)-crit(1)) - if (pfrac(i,j) < 0._r8) pfrac(i,j) = 0._r8 - if (pfrac(i,j) >= 1._r8) pfrac(i,j) = 1._r8 - enddo ! i=1,nmlonp1 - enddo ! j=1,nmlat0 -! + sinlat = sin(abs(ylatm(j+nmlat0-1))) + coslat = cos( ylatm(j+nmlat0-1)) + do i=1,nmlonp1 + colatc(i,j) = cos(ylonm(i)-sunlon+aslonc) + colatc(i,j) = acos(cosofc*sinlat-sinofc*coslat*colatc(i,j)) + end do ! i=1,nmlonp1 + ! + ! Calculate fractional presence of dynamo equation at each northern + ! hemisphere geomagnetic grid point. Output in pfrac(nmlonp1,nmlat0) + ! + do i = 1 , nmlonp1 + pfrac(i,j) = (colatc(i,j)-crit(1)) / (crit(2)-crit(1)) + if (pfrac(i,j) < 0._r8) then + pfrac(i,j) = 0._r8 + end if + if (pfrac(i,j) >= 1._r8) then + pfrac(i,j) = 1._r8 + end if + end do ! i=1,nmlonp1 + end do ! j=1,nmlat0 + ! end subroutine calc_pfrac -!----------------------------------------------------------------------- - subroutine sunloc(iday,secs,sunlons) -! -! Given day of year and ut, return sun's longitudes in dipole coordinates -! in sunlons(nlat) -! - use getapex ,only: alonm ! (nlonp1,0:nlatp1) - use edyn_geogrid ,only: nlon,nlat - use edyn_params ,only: pi -! -! Args: + !----------------------------------------------------------------------- + subroutine sunloc(iday, secs, sunlon) + ! + ! Given day of year and ut, return sun's longitude in dipole coordinates + ! in sunlon + ! + use getapex, only: alonm ! (nlonp1,0:nlatp1) + use edyn_geogrid, only: nlon, nlat, dphi, dlamda + use edyn_params, only: pi + ! + ! Args: integer,intent(in) :: iday ! day of year real(r8),intent(in) :: secs ! ut in seconds - real(r8),intent(out) :: sunlons(nlat) ! output -! -! Local: - integer :: j,i,ii,isun,jsun - real(r8) :: glats,glons,pisun,pjsun,sndlons,csdlons - real(r8) :: dphi,dlamda - real(r8) :: rlonm(nlon+4,nlat) ! (nlon+4,nlat) - real(r8) :: r8_nlat, r8_nlon + real(r8),intent(out) :: sunlon ! output + ! + ! Local: + integer :: j, i, ii, isun, jsun + real(r8) :: glats, glons, pisun, pjsun, sndlons, csdlons + real(r8) :: rlonm(nlon+4, nlat) ! (nlon+4,nlat) real(r8) :: r8_isun, r8_jsun -! -! Sun's geographic coordinates: - r8_nlat = dble(nlat) - r8_nlon = dble(nlon) - glats = asin(.398749_r8*sin(2._r8*pi*(iday-80)/365._r8)) - glons = pi*(1._r8-2._r8*secs/86400._r8) - dphi = pi/r8_nlat - dlamda = 2._r8*pi/r8_nlon - - do j=1,nlat - do i=1,nlon - ii = i+2 - rlonm(ii,j) = alonm(i,j) - enddo - do i=1,2 - rlonm(i,j) = rlonm(i+nlon,j) - rlonm(i+nlon+2,j) = rlonm(i+2,j) - enddo - enddo - - pisun = (glons+pi)/dlamda+1._r8 - pjsun = (glats+.5_r8*(pi-dphi))/dphi+1._r8 + ! + ! Sun's geographic coordinates: + glats = asin(.398749_r8*sin(2._r8 * pi * real(iday-80, r8) / 365._r8)) + glons = pi * (1._r8 - (2._r8 * secs / 86400._r8)) + + do j = 1, nlat + do i = 1, nlon + ii = i + 2 + rlonm(ii, j) = alonm(i, j) + end do + do i = 1, 2 + rlonm(i, j) = rlonm(i+nlon, j) + rlonm(i+nlon+2, j) = rlonm(i+2, j) + end do + end do + + pisun = ((glons + pi) / dlamda) + 1._r8 + pjsun = ((glats + (.5_r8 * (pi - dphi))) / dphi) + 1._r8 isun = int(pisun) jsun = int(pjsun) - r8_isun = dble(isun) - r8_jsun = dble(jsun) - pisun = pisun-r8_isun - pjsun = pjsun-r8_jsun - - sndlons = (1._r8-pisun)*(1._r8-pjsun)*sin(rlonm(isun+2,jsun))+ & - pisun*(1._r8-pjsun) *sin(rlonm(isun+3,jsun))+ & - pisun*pjsun *sin(rlonm(isun+3,jsun+1))+ & - (1._r8-pisun)*pjsun *sin(rlonm(isun+2,jsun+1)) - csdlons = (1._r8-pisun)*(1._r8-pjsun)*cos(rlonm(isun+2,jsun))+ & - pisun*(1._r8-pjsun) *cos(rlonm(isun+3,jsun))+ & - pisun*pjsun *cos(rlonm(isun+3,jsun+1))+ & - (1._r8-pisun)*pjsun *cos(rlonm(isun+2,jsun+1)) - sunlons(1) = atan2(sndlons,csdlons) - do j = 2,nlat - sunlons(j) = sunlons(1) - enddo + r8_isun = real(isun, r8) + r8_jsun = real(jsun, r8) + pisun = pisun - r8_isun + pjsun = pjsun - r8_jsun + + sndlons = (1._r8-pisun) * (1._r8-pjsun) * sin(rlonm(isun+2, jsun)) + & + pisun*(1._r8-pjsun) * sin(rlonm(isun+3,jsun)) + & + pisun*pjsun * sin(rlonm(isun+3,jsun+1)) + & + (1._r8-pisun)*pjsun * sin(rlonm(isun+2,jsun+1)) + csdlons = (1._r8-pisun) * (1._r8-pjsun) * cos(rlonm(isun+2,jsun)) + & + pisun*(1._r8-pjsun) * cos(rlonm(isun+3,jsun))+ & + pisun*pjsun * cos(rlonm(isun+3,jsun+1))+ & + (1._r8-pisun)*pjsun * cos(rlonm(isun+2,jsun+1)) + sunlon = atan2(sndlons, csdlons) end subroutine sunloc -!----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine outfld_phys1d( fldname, array ) + use ppgrid, only: pcols, begchunk, endchunk + use phys_grid,only: get_ncols_p + + character(len=*), intent(in) :: fldname + real(r8), intent(in) :: array(:) + + integer :: i,j, lchnk,ncol + real(r8) :: tmparr(pcols) + + if (hist_fld_active(fldname)) then + j = 0 + do lchnk = begchunk, endchunk + ncol = get_ncols_p(lchnk) + do i = 1, ncol + j = j + 1 + tmparr(i) = array(j) + enddo + call outfld(fldname,tmparr(:ncol),ncol,lchnk) + enddo + end if + + end subroutine outfld_phys1d + !----------------------------------------------------------------------- + subroutine outfld_phys( fldname, array ) + use ppgrid, only: pcols, pver, begchunk, endchunk + use phys_grid,only: get_ncols_p + + character(len=*), intent(in) :: fldname + real(r8), intent(in) :: array(:,:) + + integer :: i,j,k, lchnk,ncol + real(r8) :: tmparr(pcols, pver) + + if (hist_fld_active(fldname)) then + j = 0 + do lchnk = begchunk, endchunk + ncol = get_ncols_p(lchnk) + do i = 1, ncol + j = j + 1 + do k = 1, pver + tmparr(i,k) = array(k,j) + enddo + enddo + call outfld(fldname,tmparr(:ncol,:),ncol,lchnk) + enddo + end if + + end subroutine outfld_phys + !----------------------------------------------------------------------- + subroutine outfld_geokij( name, array, ilev0,ilev1, ilon0,ilon1, ilat0,ilat1 ) + + character(len=*), intent(in) :: name + integer, intent(in) :: ilev0,ilev1, ilon0,ilon1, ilat0,ilat1 + real(r8), intent(in) :: array(ilev0:ilev1, ilon0:ilon1, ilat0:ilat1) + + integer :: j,k + real(r8) :: tmpout(ilon0:ilon1,ilev0:ilev1) + + do j = ilat0,ilat1 + do k = ilev0,ilev1 + tmpout(ilon0:ilon1,k) = array(ilev1-k+1,ilon0:ilon1,j) + end do + call outfld( name, tmpout, ilon1-ilon0+1, j ) + end do + end subroutine outfld_geokij + !----------------------------------------------------------------------- + subroutine outfld_geo( fldname, array ) + use edyn_mpi, only: lon0, lon1, lat0, lat1, lev0, lev1 + + character(len=*), intent(in) :: fldname + real(r8), intent(in) :: array(lon0:lon1,lat0:lat1,lev0:lev1) + + integer :: j + + do j = lat0,lat1 + call outfld( fldname, array(lon0:lon1,j,lev0:lev1), lon1-lon0+1, j ) + end do + + end subroutine outfld_geo + !----------------------------------------------------------------------- + subroutine outfld_geo2d( fldname, array ) + use edyn_mpi, only: lon0, lon1, lat0, lat1 + + character(len=*), intent(in) :: fldname + real(r8), intent(in) :: array(lon0:lon1,lat0:lat1) + + integer :: j + + do j = lat0,lat1 + call outfld( fldname, array(lon0:lon1,j), lon1-lon0+1, j ) + end do + + end subroutine outfld_geo2d + !----------------------------------------------------------------------- + subroutine outfld_mag( fldname, array ) + use edyn_mpi, only: omlon1, mlon0, mlon1, mlat0, mlat1, mlev0, mlev1 + + character(len=*), intent(in) :: fldname + real(r8), intent(in) :: array(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1) + + integer :: j + + do j = mlat0,mlat1 + call outfld( fldname, array(mlon0:omlon1,j,mlev0:mlev1),omlon1-mlon0+1,j) + end do + + end subroutine outfld_mag + !----------------------------------------------------------------------- + subroutine outfld_mag2d( fldname, array ) + use edyn_mpi, only: mlon0, mlon1, mlat0, mlat1 + + character(len=*), intent(in) :: fldname + real(r8), intent(in) :: array(mlon0:mlon1,mlat0:mlat1) + + integer :: j + + do j = mlat0,mlat1 + call outfld( fldname, array(mlon0:mlon1,j), mlon1-mlon0+1, j ) + end do + + end subroutine outfld_mag2d + end module dpie_coupling diff --git a/src/ionosphere/waccmx/edyn_esmf.F90 b/src/ionosphere/waccmx/edyn_esmf.F90 index ae0f35d784..dfcde6a3bf 100644 --- a/src/ionosphere/waccmx/edyn_esmf.F90 +++ b/src/ionosphere/waccmx/edyn_esmf.F90 @@ -1,1140 +1,1288 @@ module edyn_esmf -#ifdef WACCMX_EDYN_ESMF - - use esmf ,only: ESMF_Grid, ESMF_Field, ESMF_RouteHandle, & ! ESMF library module - ESMF_SUCCESS, ESMF_KIND_R8, ESMF_KIND_I4, & - ESMF_FieldGet, ESMF_STAGGERLOC_CENTER, ESMF_FieldRegridStore, & - ESMF_REGRIDMETHOD_BILINEAR, ESMF_POLEMETHOD_ALLAVG, ESMF_FieldSMMStore, & - ESMF_GridCreate1PeriDim, ESMF_INDEX_GLOBAL, ESMF_GridAddCoord, ESMF_GridGetCoord, & - ESMF_TYPEKIND_R8, ESMF_FieldCreate, ESMF_Array, ESMF_ArraySpec, ESMF_DistGrid, & - ESMF_GridGet, ESMF_ArraySpecSet, ESMF_ArrayCreate, ESMF_FieldGet, ESMF_FieldSMM, & - ESMF_TERMORDER_SRCSEQ - use shr_kind_mod ,only: r8 => shr_kind_r8 - use cam_logfile ,only: iulog - use cam_abortutils ,only: endrun - use edyn_mpi ,only: ntask,ntaski,ntaskj,tasks,lon0,lon1,lat0,lat1,& - nmagtaski,nmagtaskj,mlon0,mlon1,mlat0,mlat1 - use getapex ,only: gdlatdeg,gdlondeg - use edyn_geogrid ,only: nlon,nlat,nlev,glon,glat,jspole,jnpole ! dynamically allocated geo grid - use edyn_maggrid ,only: nmlev,gmlat,gmlon - -#endif - - implicit none - save - private - - public :: edyn_esmf_update - -#ifdef WACCMX_EDYN_ESMF - - public :: nf_3dgeo,f_3dgeo - public :: edyn_esmf_update_flag - public :: edyn_esmf_init, edyn_esmf_final, edyn_esmf_update_step, edyn_esmf_regrid - public :: edyn_esmf_get_2dfield, edyn_esmf_set2d_geo, edyn_esmf_get_3dfield, edyn_esmf_set3d_mag, edyn_esmf_set3d_geo - public :: edyn_esmf_set2d_mag - - public :: mag_be3, mag_adota1,mag_adota2,mag_a1dta2,mag_sini,mag_adotv2,mag_adotv1,mag_scht - public :: mag_efx, mag_kev - public :: mag_zpot,mag_hal,mag_ped, mag_phi3d - public :: geo_be3,geo_adotv2,geo_a1dta2,geo_adota2,geo_adota1,geo_adotv1,geo_sini,geo_scht,geo_zpot - public :: geo_efx, geo_kev - public :: geo_hal, geo_ped, mag_des_grid, geo_src_grid, geo_phi3d, geo_emz3d, geo_elam3d, geo_ephi3d - public :: mag_emz3d, mag_elam3d, mag_ephi3d - - type(ESMF_Grid) :: & - geo_src_grid, mag_src_grid, & ! source grids (will not have periodic pts) - geo_des_grid, mag_des_grid ! destination grids (will have periodic pts) -! -! 3d (i,j,k) ESMF Fields on geographic subdomains: -! - type(ESMF_Field) :: & ! 3d ESMF fields on geographic grid - geo_ped, & ! pedersen conductivity - geo_hal, & ! hall conductivity - geo_zpot, & ! geopotential height (cm) - geo_scht, & ! scale height (cm) - geo_adotv1, & ! ue1 (m/s) - geo_adotv2 ! ue2 (m/s) - integer,parameter :: nf_3dgeo=6 ! number of 3d fields on geographic grid - type(ESMF_Field) :: f_3dgeo(nf_3dgeo) ! fields on 3d geo grid (could be bundled?) -! -! 2d (i,j) ESMF fields on geographic subdomains: -! - type(ESMF_Field) :: & ! 2d ESMF fields on geographic grid - geo_sini, & ! sin(I_m) - geo_adota1, & ! d(1)**2/D - geo_adota2, & ! d(2)**2/D - geo_a1dta2, & ! (d(1) dot d(2)) /D - geo_be3, & ! mag field strength (T) - geo_efx, geo_kev ! amie fields -! -! 3d (i,j,k) ESMF fields regridded to magnetic subdomains: -! - type(ESMF_Field) :: & ! 3d ESMF fields on geomagnetic grid - mag_ped, & ! pedersen conductivity - mag_hal, & ! hall conductivity - mag_zpot, & ! geopotential height (cm) - mag_scht, & ! scale height (cm) - mag_adotv1, & ! ue1 (m/s) - mag_adotv2 ! ue2 (m/s) -! -! 2d (i,j) ESMF fields on magnetic subdomains: -! - type(ESMF_Field) :: & ! 2d fields on geomagnetic grid - mag_sini, & ! sin(I_m) - mag_adota1, & ! d(1)**2/D - mag_adota2, & ! d(2)**2/D - mag_a1dta2, & ! (d(1) dot d(2)) /D - mag_be3, & ! mag field strength (T) - mag_efx, mag_kev ! amie fields -! -! 3d electric potential and electric field for mag to geo regridding: -! - type(ESMF_Field) :: mag_phi3d,mag_ephi3d,mag_elam3d,mag_emz3d - type(ESMF_Field) :: geo_phi3d,geo_ephi3d,geo_elam3d,geo_emz3d - - type(ESMF_RouteHandle) :: & ! ESMF route handles for regridding - routehandle_geo2mag, & ! for geo to mag regrid - routehandle_mag2geo, & ! for mag to geo regrid - routehandle_geo2mag_2d, & ! for 2d geo to mag - routehandle_mag2geo_2d ! for 2d mag to geo for AMIE fields -! - real(r8),allocatable :: unitv(:) -! - private routehandle_geo2mag, routehandle_mag2geo,& - routehandle_geo2mag_2d - - logical, protected :: edyn_esmf_update_step = .true. - logical :: debug=.false. ! set true for prints to stdout at each call -#endif - - contains -#ifdef WACCMX_EDYN_ESMF -!----------------------------------------------------------------------- - subroutine edyn_esmf_init( mpi_comm ) - - integer, intent(in) :: mpi_comm - - end subroutine edyn_esmf_init - -!----------------------------------------------------------------------- -!----------------------------------------------------------------------- - subroutine edyn_esmf_final - - end subroutine edyn_esmf_final - -#endif - -!----------------------------------------------------------------------- -!----------------------------------------------------------------------- - subroutine edyn_esmf_update - use getapex, only: get_apex,magfield, alonm - use mo_apex, only: geomag_year_updated - -#ifdef WACCMX_EDYN_ESMF -! Create ESMF grids for geographic and magnetic, and create ESMF fields -! as necessary on both grids. Define the 2d coordinates for each grid, -! and save an ESMF routehandles for geo2mag and mag2geo regridding. -! -! Local: - integer :: rc ! return code for ESMF calls - real(ESMF_KIND_R8),pointer :: fptr(:,:,:) - integer :: lbnd_destgeo(3),ubnd_destgeo(3) ! 3d bounds of destination geo grid - integer :: lbnd_destmag(3),ubnd_destmag(3) ! 3d bounds of destination mag grid - integer :: lbnd_srcgeo(3),ubnd_srcgeo(3) ! 3d bounds of source geo grid - integer :: lbnd_srcmag(3),ubnd_srcmag(3) ! 3d bounds of source mag grid - integer(ESMF_KIND_I4),pointer :: factorIndexList(:,:) - real(ESMF_KIND_R8),pointer :: factorList(:) - integer :: smm_srctermproc, smm_pipelinedep -#endif - - if (.not.geomag_year_updated .and. allocated(alonm)) return -! -! Get apex coordinates. -! - call get_apex( ) ! get apex coordinates - call magfield ! calculate magnetic field parameters - -#ifdef WACCMX_EDYN_ESMF - - smm_srctermproc = 0 - smm_pipelinedep = 16 -! -! Set unit vector (this routine called once per run unless crossing year boundary): -! Handle year boundary by checking if field is allocated -! - if (.not.allocated(unitv)) allocate(unitv(nlon)) - unitv(:) = 1._r8 -! -! Make magnetic and geographic grids for geo2mag regridding: -! - call create_geo_grid(geo_src_grid,'src') ! geo source grid - call create_mag_grid(mag_des_grid,'des') ! mag destination grid -! -! Make grids for mag2geo regridding: -! - call create_mag_grid(mag_src_grid,'src') - call create_geo_grid(geo_des_grid,'des') -! -! Create empty fields on geographic grid that will be transformed to -! the magnetic grid and passed as input to the dynamo. This does not -! assign any values. -! -! 3d fields on source geo grid (these exclude periodic points): -! - call edyn_esmf_create_geofield(geo_ped,geo_src_grid, 'PED ',nlev) - call edyn_esmf_create_geofield(geo_hal ,geo_src_grid, 'HAL ',nlev) - call edyn_esmf_create_geofield(geo_zpot,geo_src_grid, 'ZPOT ',nlev) - call edyn_esmf_create_geofield(geo_scht,geo_src_grid, 'SCHT ',nlev) - call edyn_esmf_create_geofield(geo_adotv1,geo_src_grid,'ADOTV1 ',nlev) - call edyn_esmf_create_geofield(geo_adotv2,geo_src_grid,'ADOTV2 ',nlev) -! -! Get 3d bounds of source geo field: -! - call ESMF_FieldGet(geo_ped,localDe=0,farrayPtr=fptr, & - computationalLBound=lbnd_srcgeo, & - computationalUBound=ubnd_srcgeo,rc=rc) - - if (debug) then - write(iulog,"('Bounds of source geo field: lbnd_srcgeo=',3i4,' ubnd_srcgeo=',3i4,' glon=',2f9.3)") & - lbnd_srcgeo,ubnd_srcgeo - endif -! -! 2d fields on source geo grid (these exclude periodic points): -! - call edyn_esmf_create_geofield(geo_sini ,geo_src_grid,'SINI ',0) - call edyn_esmf_create_geofield(geo_adota1,geo_src_grid,'ADOTA1 ',0) - call edyn_esmf_create_geofield(geo_adota2,geo_src_grid,'ADOTA2 ',0) - call edyn_esmf_create_geofield(geo_a1dta2,geo_src_grid,'A1DTA2 ',0) - call edyn_esmf_create_geofield(geo_be3 ,geo_src_grid,'BE3 ',0) -! -! 3d fields on destination mag grid (will include periodic point): -! - call edyn_esmf_create_magfield(mag_ped ,mag_des_grid, 'PED ',nmlev) - call edyn_esmf_create_magfield(mag_hal ,mag_des_grid, 'HAL ',nmlev) - call edyn_esmf_create_magfield(mag_zpot,mag_des_grid, 'ZPOT ',nmlev) - call edyn_esmf_create_magfield(mag_scht,mag_des_grid, 'SCHT ',nmlev) - call edyn_esmf_create_magfield(mag_adotv1,mag_des_grid,'ADOTV1 ',nmlev) - call edyn_esmf_create_magfield(mag_adotv2,mag_des_grid,'ADOTV2 ',nmlev) -! -! Get 3d bounds of destination mag field: -! - call ESMF_FieldGet(mag_ped,localDe=0,farrayPtr=fptr, & - computationalLBound=lbnd_destmag, & - computationalUBound=ubnd_destmag,rc=rc) - - if (debug) then - write(iulog,"('Bounds of destination mag field: lbnd_destmag=',3i4,' ubnd_destmag=',3i4,' gmlon=',2f9.3)") & - lbnd_destmag,ubnd_destmag - write(iulog,"('esmf_init: lon bnd_destmag =',2i4,' gmlon=',2f9.3)") & - lbnd_destmag(1),ubnd_destmag(1),gmlon(lbnd_destmag(1)),gmlon(ubnd_destmag(1)) - write(iulog,"('esmf_init: lat bnd_destmag =',2i4,' gmlat=',2f9.3)") & - lbnd_destmag(2),ubnd_destmag(2),gmlat(lbnd_destmag(2)),gmlat(ubnd_destmag(2)) - endif -! -! 2d fields on destination mag grid (will include periodic point): -! - call edyn_esmf_create_magfield(mag_sini ,mag_des_grid,'SINI ',0) - call edyn_esmf_create_magfield(mag_adota1,mag_des_grid,'ADOTA1 ',0) - call edyn_esmf_create_magfield(mag_adota2,mag_des_grid,'ADOTA2 ',0) - call edyn_esmf_create_magfield(mag_a1dta2,mag_des_grid,'A1DTA2 ',0) - call edyn_esmf_create_magfield(mag_be3 ,mag_des_grid,'BE3 ',0) -! -! 3d fields on source mag grid for mag2geo: -! - call edyn_esmf_create_magfield(mag_phi3d ,mag_src_grid,'PHIM3D ',nmlev) - call edyn_esmf_create_magfield(mag_ephi3d,mag_src_grid,'EPHI3D ',nmlev) - call edyn_esmf_create_magfield(mag_elam3d,mag_src_grid,'ELAM3D ',nmlev) - call edyn_esmf_create_magfield(mag_emz3d ,mag_src_grid,'EMZ3D ',nmlev) - call edyn_esmf_create_magfield(mag_efx ,mag_src_grid,'MEFXAMIE',0) - call edyn_esmf_create_magfield(mag_kev ,mag_src_grid,'MKEVAMIE',0) -! -! 3d fields on destination geo grid for mag2geo: -! - call edyn_esmf_create_geofield(geo_phi3d ,geo_des_grid,'PHIG3D ',nlev) - call edyn_esmf_create_geofield(geo_ephi3d,geo_des_grid,'EPHI3D ',nlev) - call edyn_esmf_create_geofield(geo_elam3d,geo_des_grid,'ELAM3D ',nlev) - call edyn_esmf_create_geofield(geo_emz3d ,geo_des_grid,'EMZ3D ',nlev) - call edyn_esmf_create_geofield(geo_efx ,geo_des_grid,'GEFXAMIE',0) - call edyn_esmf_create_geofield(geo_kev ,geo_des_grid,'GKEVAMIE',0) -! -! Get 3d bounds of source mag field: - call ESMF_FieldGet(mag_phi3d,localDe=0,farrayPtr=fptr,& - computationalLBound=lbnd_srcmag, & - computationalUBound=ubnd_srcmag,rc=rc) - - if (debug) then - write(iulog,"('esmf_init: lon bnd_srcmag =',2i4,' gmlon=',2f9.3)") & - lbnd_srcmag(1),ubnd_srcmag(1) - write(iulog,"('esmf_init: lat bnd_srcmag =',2i4,' gmlat=',2f9.3)") & - lbnd_srcmag(2),ubnd_srcmag(2) - endif -! -! Get 3d bounds of destination geo field: -! - call ESMF_FieldGet(geo_phi3d,localDe=0,farrayPtr=fptr,& - computationalLBound=lbnd_destgeo, & - computationalUBound=ubnd_destgeo,rc=rc) - - if (debug) then - write(iulog,"('esmf_init: lon bnd_destgeo=',2i4,' glon=',2f9.3)") & - lbnd_destgeo(1),ubnd_destgeo(1) - write(iulog,"('esmf_init: lat bnd_destgeo=',2i4,' glat=',2f9.3)") & - lbnd_destgeo(2),ubnd_destgeo(2) - endif -! -! Save route handles for grid transformations in both directions -! geo2mag and mag2geo. FieldRegridStore needs to be called only -! once for each transformation before the timestep loop (src and -! dest fields are still required, so just use ped here). Once inside -! the timestep loop, the same routehandle can be used for all fields -! that are regridded in the given direction. -! -! These calls will leave *.vtk info files in execdir: -! call ESMF_GridWriteVTK(geo_src_grid, & -! staggerloc=ESMF_STAGGERLOC_CENTER, filename="geoGrid",rc=rc) -! call ESMF_GridWriteVTK(mag_des_grid, & -! staggerloc=ESMF_STAGGERLOC_CENTER, filename="magGrid",rc=rc) -! -! Save route handle and get esmf indices and weights for geo2mag: -! - call ESMF_FieldRegridStore(srcField=geo_ped,dstField=mag_ped, & - regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & - polemethod=ESMF_POLEMETHOD_ALLAVG, & - routeHandle=routehandle_geo2mag,factorIndexList=factorIndexList, & - factorList=factorList,srcTermProcessing=smm_srctermproc,pipelineDepth=smm_pipelinedep,rc=rc) - - if (rc /= ESMF_SUCCESS) then - write(iulog,"(a,a,i4)") '>>> edyn_esmf_update: error return from ', & - 'ESMF_FieldRegridStore for 3d geo2mag: rc=',rc - call endrun('edyn_esmf_update: ESMF_FieldRegridStore ped') - endif -! -! Store route handle for geo2mag 3d fields. -! - call ESMF_FieldSMMStore(geo_ped,mag_ped,routehandle_geo2mag, & - factorList,factorIndexList,srcTermProcessing=smm_srctermproc,pipelineDepth=smm_pipelinedep,rc=rc) - - if (rc /= ESMF_SUCCESS) then - write(iulog,"(2a,i4)") '>>> edyn_esmf_update: error return from ESMF_FieldSMMStore for ',& - '3d geo2mag: rc=',rc - call endrun('edyn_esmf_update: ESMF_FieldSMMStore for 3d geo2mag ped') - endif -! -! Store route handle geo2mag 2d fields: -! - call ESMF_FieldSMMStore(geo_sini,mag_sini,routehandle_geo2mag_2d, & - factorList,factorIndexList,srcTermProcessing=smm_srctermproc,pipelineDepth=smm_pipelinedep,rc=rc) - - if (rc /= ESMF_SUCCESS) then - write(iulog,"(2a,i4)") '>>> edyn_esmf_update: error return from ESMF_FieldSMMStore',& - ' for 2d geo2mag: rc=',rc - call endrun('edyn_esmf_update: ESMF_FieldSMMStore for 2d geo2mag sini') - endif -! -! Save route handle and get esmf indices and weights for mag2geo: -! (this overwrites factorIndexList and factorList from geo2mag call above) -! -! These calls will leave *.vtk info files in execdir: -! call ESMF_GridWriteVTK(mag_src_grid, & -! staggerloc=ESMF_STAGGERLOC_CENTER, filename="magSrcGrid",rc=rc) -! call ESMF_GridWriteVTK(geo_des_grid, & -! staggerloc=ESMF_STAGGERLOC_CENTER, filename="geoDesGrid",rc=rc) - -! Save route handle and get esmf indices and weights for mag2geo: -! - call ESMF_FieldRegridStore(srcField=mag_phi3d,dstField=geo_phi3d, & - regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & - polemethod=ESMF_POLEMETHOD_ALLAVG, & - routeHandle=routehandle_mag2geo,factorIndexList=factorIndexList,& - factorList=factorList,srcTermProcessing=smm_srctermproc,pipelineDepth=smm_pipelinedep,rc=rc) - - if (rc /= ESMF_SUCCESS) then - write(iulog,"(2a,i4)") '>>> edyn_esmf_update: error return from ',& - 'ESMF_FieldRegridStore for 3d mag2geo: rc=',rc - call endrun('edyn_esmf_update: ESMF_FieldRegridStore for 3d mag2geo phi3d') - endif -! -! mag2geo 3d fields: -! - call ESMF_FieldSMMStore(mag_phi3d,geo_phi3d,routehandle_mag2geo,& - factorList,factorIndexList,srcTermProcessing=smm_srctermproc,pipelineDepth=smm_pipelinedep,rc=rc) - - if (rc /= ESMF_SUCCESS) then - write(iulog,"(2a,i4)") '>>> edyn_esmf_update: error return from ESMF_FieldSMMStore ',& - 'for 3d mag2geo: rc=',rc - call endrun('edyn_esmf_update: ESMF_FieldSMMStore for 3d geo2mag phi3d') - endif + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use infnan, only: nan, assignment(=) + + use ESMF, only: ESMF_Grid, ESMF_Mesh, ESMF_Field, ESMF_RouteHandle + use ESMF, only: ESMF_SUCCESS + use ESMF, only: ESMF_KIND_R8, ESMF_KIND_I4 + use ESMF, only: ESMF_FieldGet + use ESMF, only: ESMF_STAGGERLOC_CENTER, ESMF_FieldRegridStore, ESMF_FieldRegrid + use ESMF, only: ESMF_StaggerLoc + use ESMF, only: ESMF_REGRIDMETHOD_BILINEAR, ESMF_POLEMETHOD_ALLAVG + use ESMF, only: ESMF_GridCreate1PeriDim, ESMF_INDEX_GLOBAL + use ESMF, only: ESMF_GridAddCoord, ESMF_GridGetCoord + use ESMF, only: ESMF_TYPEKIND_R8, ESMF_FieldCreate, ESMF_Array + use ESMF, only: ESMF_ArraySpec, ESMF_DistGrid, ESMF_DELayout + use ESMF, only: ESMF_GridGet, ESMF_ArraySpecSet + use ESMF, only: ESMF_ArrayCreate + use ESMF, only: ESMF_GridComp, ESMF_TERMORDER_SRCSEQ + use ESMF, only: ESMF_EXTRAPMETHOD_NEAREST_IDAVG + use ESMF, only: ESMF_UNMAPPEDACTION_IGNORE + use ESMF, only: ESMF_GridDestroy, ESMF_FieldDestroy, ESMF_RouteHandleDestroy + use ESMF, only: ESMF_Mesh, ESMF_MeshIsCreated, ESMF_MeshDestroy + use ESMF, only: ESMF_MESHLOC_ELEMENT + use edyn_mpi, only: mytid, ntask, ntaski, ntaskj, tasks, lon0, lon1, lat0 + use edyn_mpi, only: lat1, nmagtaski, nmagtaskj, mlon0, mlon1 + use edyn_mpi, only: mlat0,mlat1 + use getapex, only: gdlatdeg, gdlondeg + ! dynamically allocated geo grid for Oplus transport model + use edyn_geogrid, only: nlon, nlev, glon, glat + use edyn_maggrid, only: gmlat, gmlon + use spmd_utils, only: masterproc + + implicit none + save + private + + public :: edyn_esmf_update + public :: edyn_esmf_final ! Clean up any edyn usage of ESMF + + public :: edyn_esmf_regrid_phys2geo + public :: edyn_esmf_regrid_geo2phys + public :: edyn_esmf_regrid_phys2mag + public :: edyn_esmf_regrid_mag2phys + public :: edyn_esmf_regrid_geo2mag + public :: edyn_esmf_regrid_mag2geo + + public :: edyn_esmf_get_1dfield + public :: edyn_esmf_get_2dfield ! Retrieve a pointer to 2D ESMF field data + public :: edyn_esmf_get_3dfield ! Retrieve a pointer to 3D ESMF field data + public :: edyn_esmf_get_2dphysfield + public :: edyn_esmf_set3d_geo ! Set ESMF field with 3D geo data + public :: edyn_esmf_set2d_geo ! Set ESMF field with 2D geo data + public :: edyn_esmf_set3d_mag ! Set ESMF field with 3D mag field data + public :: edyn_esmf_set2d_mag ! Set ESMF field with 2D mag field data + public :: edyn_esmf_set3d_phys ! Set ESMF field with 3D physics field data + public :: edyn_esmf_set2d_phys ! Set ESMF field with 2D physics field data + public :: edyn_esmf_update_phys_mesh + + public :: phys_3dfld, phys_2dfld + public :: geo_3dfld, geo_2dfld + public :: mag_des_3dfld, mag_des_2dfld + public :: mag_src_3dfld, mag_src_2dfld + + public :: edyn_esmf_chkerr + + type(ESMF_Grid) :: & + mag_src_grid, & ! source grid (will not have periodic pts) + mag_des_grid, & ! destination grid (will have periodic pts) + geo_grid ! geographic grid for Oplus transport + + ! phys_mesh: Mesh representation of physics decomposition + type(ESMF_Mesh), public, protected :: phys_mesh + + ! ESMF fields used for mapping between physics, oplus geographic, and geomagnetic grids + type(ESMF_Field) :: phys_3dfld, phys_2dfld + type(ESMF_Field) :: geo_3dfld, geo_2dfld + type(ESMF_Field) :: mag_des_3dfld, mag_des_2dfld + type(ESMF_Field) :: mag_src_3dfld, mag_src_2dfld + + + type(ESMF_RouteHandle) :: & ! ESMF route handles for regridding + routehandle_phys2geo, & ! for physics to geo 3-D regrid + routehandle_geo2phys, & ! for geo to physics 3-D regrid + routehandle_phys2mag, & ! for physics to mag 3-D regrid + routehandle_geo2mag, & ! for geo to mag 3-D regrid + routehandle_mag2geo, & ! for geo to mag 3-D regrid + routehandle_phys2mag_2d, & ! for 2d geo to phys + routehandle_mag2phys_2d, & ! for 2d phys to geo for AMIE fields + routehandle_geo2mag_2d ! for 2d geo to mag + + logical, parameter :: debug = .false. + + integer, allocatable :: petmap(:,:,:) + logical :: initialized=.false. + +contains + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine edyn_esmf_chkerr(subname, routine, rc) + use shr_kind_mod, only: shr_kind_cl + + character(len=*), intent(in) :: subname + character(len=*), intent(in) :: routine + integer, intent(in) :: rc + + character(len=shr_kind_cl) :: errmsg -! amie fields - call ESMF_FieldRegridStore(srcField=mag_efx,dstField=geo_efx, & - regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & - polemethod=ESMF_POLEMETHOD_ALLAVG, & - routeHandle=routehandle_mag2geo_2d,factorIndexList=factorIndexList,& - factorList=factorList,srcTermProcessing=smm_srctermproc,pipelineDepth=smm_pipelinedep,rc=rc) - - if (rc /= ESMF_SUCCESS) then - write(6,"(2a,i4)") '>>> esmf_init: error return from ',& - 'ESMF_FieldRegridStore for 2d mag2geo_2d: rc=',rc - call endrun - endif -! -! mag2geo 2d fields: -! - call ESMF_FieldSMMStore(mag_efx,geo_efx,routehandle_mag2geo_2d,& - factorList,factorIndexList,srcTermProcessing=smm_srctermproc,pipelineDepth=smm_pipelinedep,rc=rc) - - - edyn_esmf_update_step = .true. -#endif - end subroutine edyn_esmf_update - -#ifdef WACCMX_EDYN_ESMF -!----------------------------------------------------------------------- - real(r8) function select_wt_mag2geo(n,dimx,djmy) - integer,intent(in) :: n - real(r8),intent(in) :: dimx,djmy - - select_wt_mag2geo = 0._r8 - select case (n) - case(1) - select_wt_mag2geo = (1._r8-dimx)*(1._r8-djmy) - case(2) - select_wt_mag2geo = dimx*(1._r8-djmy) - case(3) - select_wt_mag2geo = dimx*djmy - case(4) - select_wt_mag2geo = (1._r8-dimx)*djmy - end select - end function select_wt_mag2geo -!----------------------------------------------------------------------- - subroutine create_mag_grid(grid_out,srcdes) -! -! Create ESMF geomagnetic grid, w/ lon,lat coordinates. -! This is called from esmf_init during model initialization. -! -! Args: - type(ESMF_Grid),intent(out) :: grid_out - character(len=*),intent(in) :: srcdes -! -! Local: - integer :: i,j,n,rc - real(ESMF_KIND_R8),pointer :: coordX(:,:),coordY(:,:) - integer :: lbnd(2),ubnd(2) - integer :: nmlons_task(ntaski) ! number of lons per task - integer :: nmlats_task(ntaskj) ! number of lats per task -! -! We are creating either a source grid or a destination grid: -! - if (srcdes /= 'src' .and. srcdes /= 'des') then - write(iulog,"(a)") '>>> create_mag_grid: srcdes = ''',srcdes, & - ''' but must be either ''src'' or ''des''' - call endrun('create_mag_grid: srcdes') - endif -! -! nmlons_task(nmagtaski) = number of mag lons per task in lon dim -! - do i=1,nmagtaski - loop: do n=0,ntask-1 - if (tasks(n)%magtidi==i-1) then - nmlons_task(i) = tasks(n)%nmaglons - exit loop - endif - enddo loop - enddo -! -! Exclude periodic points (1 point fewer for mpi tasks at east end) -! for source grids (this overwrites above for eastern-most tasks): -! - if (srcdes == 'src') then - do n=0,ntask-1 - if (tasks(n)%magtidi==nmagtaski-1) then ! east edge of proc matrix - nmlons_task(tasks(n)%magtidi+1) = tasks(n)%nmaglons-1 - endif - enddo - endif -! -! nmlats_task(nmagtaskj) = number of mag lats per task in lat dim -! - do j=1,nmagtaskj - loop1: do n=0,ntask-1 - if (tasks(n)%magtidj==j-1) then - nmlats_task(j) = tasks(n)%nmaglats - exit loop1 - endif - enddo loop1 - enddo -! -! Create curvilinear magnetic grid (both coords depend -! on both dimensions, i.e., lon(i,j),lat(i,j)): -! - grid_out = ESMF_GridCreate1PeriDim( & - countsPerDEDim1=nmlons_task, coordDep1=(/1,2/), & - countsPerDEDim2=nmlats_task, coordDep2=(/1,2/), & - indexflag=ESMF_INDEX_GLOBAL,rc=rc) - - if (rc /= ESMF_SUCCESS) then - write(iulog,"(2a,i4)") '>>> create_mag_grid: error return from ',& - 'ESMF_GridCreateShapeTile: rc=',rc - call endrun('create_mag_grid: ESMF_GridCreate1PeriDim') - endif -! -! Allocate coordinates: -! - call ESMF_GridAddCoord(grid_out,staggerloc=ESMF_STAGGERLOC_CENTER,rc=rc) - - if (rc /=ESMF_SUCCESS) then - write(iulog,"(2a,i4)") '>>> create_mag_grid: error return from ',& - 'ESMF_GridAddCoord: rc=',rc - call endrun('create_mag_grid: ESMF_GridAddCoord mag_grid') - endif -! -! Get pointer and set mag grid longitude coordinates: -! - call ESMF_GridGetCoord(grid_out, coordDim=1, localDE=0, & - computationalLBound=lbnd, computationalUBound=ubnd, & - farrayPtr=coordX, staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) - - if (rc /= ESMF_SUCCESS) then - write(iulog,"(i4)") '>>> create_mag_grid: error return from ', & - 'ESMF_GridGetCoord for longitude coords: rc=',rc - call endrun('create_mag_grid: ESMF_GridGetCoord mag grid longitude') - endif + if (rc /= ESMF_SUCCESS) then + write(errmsg, '(4a,i0)') trim(subname), ': Error return from ', trim(routine), ', rc = ', rc + if (masterproc) then + write(iulog, '(2a)') 'ERROR: ', trim(errmsg) + end if + call endrun(trim(errmsg)) + end if + end subroutine edyn_esmf_chkerr + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine edyn_esmf_final + + call edyn_esmf_destroy_mag_objs() + call edyn_esmf_destroy_nonmag_objs() + + end subroutine edyn_esmf_final + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine edyn_esmf_destroy_mag_objs + + integer :: rc ! return code for ESMF calls + character(len=*), parameter :: subname = 'edyn_esmf_destroy_mag_objs' + + call ESMF_RouteHandleDestroy(routehandle_phys2mag, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_RouteHandleDestroy routehandle_phys2mag', rc) + call ESMF_RouteHandleDestroy(routehandle_geo2mag, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_RouteHandleDestroy routehandle_geo2mag', rc) + call ESMF_RouteHandleDestroy(routehandle_mag2geo, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_RouteHandleDestroy routehandle_mag2geo', rc) + call ESMF_RouteHandleDestroy(routehandle_phys2mag_2d, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_RouteHandleDestroy routehandle_phys2mag_2d', rc) + call ESMF_RouteHandleDestroy(routehandle_mag2phys_2d, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_RouteHandleDestroy routehandle_mag2phys_2d', rc) + call ESMF_RouteHandleDestroy(routehandle_geo2mag_2d, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_RouteHandleDestroy routehandle_geo2mag_2d', rc) + + call ESMF_FieldDestroy(mag_des_3dfld, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_FieldDestroy mag_des_3dfld', rc) + call ESMF_FieldDestroy(mag_des_2dfld, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_FieldDestroy mag_des_2dfld', rc) + call ESMF_FieldDestroy(mag_src_3dfld, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_FieldDestroy mag_src_3dfld', rc) + call ESMF_FieldDestroy(mag_src_2dfld, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_FieldDestroy mag_src_2dfld', rc) + + call ESMF_GridDestroy(mag_src_grid, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_GridDestroy mag_src_grid', rc) + call ESMF_GridDestroy(mag_des_grid, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_GridDestroy mag_des_grid', rc) + + end subroutine edyn_esmf_destroy_mag_objs + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine edyn_esmf_destroy_nonmag_objs + + integer :: rc ! return code for ESMF calls + character(len=*), parameter :: subname = 'edyn_esmf_destroy_nonmag_objs' + + call ESMF_RouteHandleDestroy(routehandle_phys2geo, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_RouteHandleDestroy routehandle_phys2geo', rc) + call ESMF_RouteHandleDestroy(routehandle_geo2phys, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_RouteHandleDestroy routehandle_geo2phys', rc) + + call ESMF_FieldDestroy(phys_3dfld, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_FieldDestroy phys_3dfld', rc) + call ESMF_FieldDestroy(phys_2dfld, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_FieldDestroy phys_2dfld', rc) + call ESMF_FieldDestroy(geo_3dfld, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_FieldDestroy geo_3dfld', rc) + call ESMF_FieldDestroy(geo_2dfld, rc=rc ) + call edyn_esmf_chkerr(subname, 'ESMF_FieldDestroy geo_2dfld', rc) + + call ESMF_GridDestroy(geo_grid, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_GridDestroy geo_grid', rc) + call ESMF_MeshDestroy(phys_mesh, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_MeshDestroy phys_mesh', rc) + + end subroutine edyn_esmf_destroy_nonmag_objs + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine edyn_esmf_update + use getapex, only: get_apex, magfield, alonm + use mo_apex, only: geomag_year_updated + + ! Create ESMF grids for physics, geographic (ion transport), and + ! magnetic grids, and create ESMF fields as necessary on each grid. + ! Define the 2d coordinates for each grid, and save an ESMF + ! routehandles for regridding. + ! + ! Local: + integer :: rc ! return code for ESMF calls + integer :: lbnd_destgeo(3), ubnd_destgeo(3) ! 3d bounds of dest geo grid + integer :: lbnd_destmag(3), ubnd_destmag(3) ! 3d bounds of dest mag grid + integer :: lbnd_srcgeo(3), ubnd_srcgeo(3) ! 3d bounds of src geo grid + integer :: lbnd_srcmag(3), ubnd_srcmag(3) ! 3d bounds of src mag grid + real(ESMF_KIND_R8), pointer :: fptr(:,:,:) + integer(ESMF_KIND_I4), pointer :: factorIndexList(:,:) + real(ESMF_KIND_R8), pointer :: factorList(:) + integer :: smm_srctermproc, smm_pipelinedep + + character(len=*), parameter :: subname = 'edyn_esmf_update' + + if (.not.geomag_year_updated .and. initialized) then + return + end if + + if (mytid>> create_mag_grid: error return from ',& - 'ESMF_GridGetCoord for latitude coords: rc=',rc - call endrun('create_mag_grid: ESMF_GridGetCoord latitude') - endif + endif - do j=lbnd(2),ubnd(2) - do i=lbnd(1),ubnd(1) - coordY(i,j) = gdlatdeg(i,j) - enddo - enddo + smm_srctermproc = 0 + smm_pipelinedep = 16 - if (debug) then - write(iulog,"(4a,2i4,a,2i4,a,2i4,a,2i4)") 'Created ESMF ',srcdes,' mag grid: ', & - ' lbnd,ubnd_lon=',lbnd(1),ubnd(1),' mlon0,1=',mlon0,mlon1, & - ' lbnd,ubnd_lat=',lbnd(2),ubnd(2),' mlat0,1=',mlat0,mlat1 - endif + if (initialized) then + call edyn_esmf_destroy_mag_objs() + endif + if (.not.initialized) then + ! + ! Make geographic grid for phys2geo and geo2phys regridding: + ! + call create_geo_grid(geo_grid) ! geo (Oplus) grid + endif + ! + ! Make magnetic grid for phys2mag regridding: + ! + call create_mag_grid(mag_des_grid, 'des') ! mag destination grid + ! + ! Make grid for mag2phys regridding: + ! + call create_mag_grid(mag_src_grid, 'src') + ! + ! Create empty fields on geographic grid or phyiscs mesh that + ! will be transformed to the magnetic grid and passed as input + ! to the dynamo. This does not assign any values. + ! + ! 3d fields (inputs to edynamo) on physics mesh for phys2mag: + ! + if (.not.initialized) then + call edyn_esmf_create_physfield(phys_2dfld, phys_mesh, 'PHYS_2DFLD', 0) + call edyn_esmf_create_physfield(phys_3dfld, phys_mesh, 'PHYS_3DFLD', nlev) + + call edyn_esmf_create_geofield(geo_2dfld, geo_grid, 'GEO_2DFLD', 0) + call edyn_esmf_create_geofield(geo_3dfld, geo_grid, 'GEO_3DFLD', nlev) + endif - end subroutine create_mag_grid -!----------------------------------------------------------------------- - subroutine create_geo_grid(grid_out,srcdes) -! -! Args: - type(ESMF_Grid),intent(out) :: grid_out - character(len=*),intent(in) :: srcdes -! -! Local: - integer :: i,j,n,rc - integer :: lbnd_lat,ubnd_lat,lbnd_lon,ubnd_lon,lbnd(1),ubnd(1) - real(ESMF_KIND_R8),pointer :: coordX(:),coordY(:) - integer :: nlons_task(ntaski) ! number of lons per task - integer :: nlats_task(ntaskj) ! number of lats per task - logical :: has_poles -! -! We are creating either a source grid or a destination grid: -! - if (srcdes /= 'src' .and. srcdes /= 'des') then - write(iulog,"(a)") '>>> create_geo_grid: srcdes = ''',srcdes, & - ''' but must be either ''src'' or ''des''' - call endrun('create_geo_grid: srcdes') - endif -! -! nlons_task(ntaski) = number of geo lons per task. -! - do i=1,ntaski - loop: do n=0,ntask-1 - if (tasks(n)%mytidi==i-1) then - nlons_task(i) = tasks(n)%nlons - exit loop - endif - enddo loop - enddo -! -! Exclude periodic points (2 points fewer for procs at each end) -! for source grids only (east and west edges of task table). -! (TIMEGCM only) -! -! if (srcdes == 'src'.and.trim(model_name)=='TIMEGCM') then -! do n=0,ntask-1 -! east or west edge of task table: -! if (tasks(n)%mytidi==ntaski-1.or.tasks(n)%mytidi==0) & -! nlons_task(tasks(n)%mytidi+1) = tasks(n)%nlons-2 -! enddo -! endif -! -! nlats_task(ntaskj) = number of geo lats per task. -! - do j=1,ntaskj - loop1: do n=0,ntask-1 - if (tasks(n)%mytidj==j-1) then - nlats_task(j) = tasks(n)%nlats - exit loop1 - endif - enddo loop1 - enddo -! -! Check to see if global glat(nlat) has poles (WACCM does, TIMEGCM does not): - has_poles = .false. - do j=1,nlat - if (abs(glat(j))==90._r8) has_poles = .true. - enddo - - if (debug) write(iulog,"('create_geo_grid: srcdes=',a,' has_poles=',l1)") srcdes,has_poles -! -! If making destination grid and glat does not have poles, add extra points -! at north and south edges of task table: -! - if (.not.has_poles.and.srcdes=='des') then ! probably TIMEGCM - do n=0,ntask-1 -! north or south edge of task table: add 1 lat for pole - if (tasks(n)%mytidj==ntaskj-1.or.tasks(n)%mytidj==0) & - nlats_task(tasks(n)%mytidj+1) = tasks(n)%nlats+1 - enddo -! -! Create 2d geographic destination grid (minimum lat index is 0 to include poles): - grid_out = ESMF_GridCreate1PeriDim( & - countsPerDEDim1=nlons_task, coordDep1=(/1/), & - countsPerDEDim2=nlats_task, coordDep2=(/2/), & - indexflag=ESMF_INDEX_GLOBAL,minIndex=(/1,0/),rc=rc) - - elseif (has_poles) then ! geo source grid does not have poles -! -! Create 2d geographic source grid (without poles) - grid_out = ESMF_GridCreate1PeriDim( & - countsPerDEDim1=nlons_task, coordDep1=(/1/), & - countsPerDEDim2=nlats_task, coordDep2=(/2/), & - indexflag=ESMF_INDEX_GLOBAL,minIndex=(/1,1/),rc=rc) - else - write(iulog,*) 'No capability for ESMF to handle source grid without poles' - call endrun('create_geo_grid: No ESMF capability for source grid without poles') - endif + call edyn_esmf_create_magfield(mag_des_2dfld, mag_des_grid, 'MAG_DES_2DFLD', 0) + call edyn_esmf_create_magfield(mag_des_3dfld, mag_des_grid, 'MAG_DES_3DFLD', nlev) + + call edyn_esmf_create_magfield(mag_src_2dfld, mag_src_grid, 'MAG_SRC_2DFLD', 0) + call edyn_esmf_create_magfield(mag_src_3dfld, mag_src_grid, 'MAG_SRC_3DFLD', nlev) + + if (debug .and. masterproc) then + ! + ! Get 3d bounds of source geo field: + ! + call ESMF_FieldGet(geo_3dfld, localDe=0, farrayPtr=fptr, & + computationalLBound=lbnd_srcgeo, & + computationalUBound=ubnd_srcgeo, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldGet, geo_3dfld', rc) + + write(iulog,"(2a,i4,2(', ',i4),a,i4,2(', ',i4),a)") subname, & + ': Bounds of source geo field: lbnd_srcgeo = (', & + lbnd_srcgeo, '), ubnd_srcgeo = (', ubnd_srcgeo,')' + end if + + if (debug .and. masterproc) then + ! + ! Get 3d bounds of destination mag field: + ! + call ESMF_FieldGet(mag_des_3dfld, localDe=0, farrayPtr=fptr, & + computationalLBound=lbnd_destmag, & + computationalUBound=ubnd_destmag, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldGet, mag_des_3dfld', rc) + + write(iulog,"(2a,3i4,a,3i4,' gmlon=',2f9.3)") subname, & + ': Bounds of destination mag field: lbnd_destmag = ', & + lbnd_destmag, ' ubnd_destmag = ', ubnd_destmag + write(iulog,"(a,': lon bnd_destmag =',2i4,' gmlon = ',2f9.3)") & + subname, lbnd_destmag(1), ubnd_destmag(1), & + gmlon(lbnd_destmag(1)), gmlon(ubnd_destmag(1)) + write(iulog,"(a,': lat bnd_destmag = ',2i4,' gmlat = ',2f9.3)") & + subname, lbnd_destmag(2), ubnd_destmag(2), & + gmlat(lbnd_destmag(2)), gmlat(ubnd_destmag(2)) + ! + ! Get 3d bounds of source mag field: + ! + call ESMF_FieldGet(mag_src_3dfld, localDe=0, farrayPtr=fptr, & + computationalLBound=lbnd_srcmag, & + computationalUBound=ubnd_srcmag, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldGet, mag_src_3dfld', rc) + + write(iulog,"(a,2(a,i4),a)") subname, ': lon srcmag bounds = (', & + lbnd_srcmag(1), ', ', ubnd_srcmag(1), ')' + write(iulog,"(a,2(a,i4),a)") subname, ': lat srcmag bounds = (', & + lbnd_srcmag(2), ', ', ubnd_srcmag(2), ')' + ! + ! Get 3d bounds of destination geo field: + ! + call ESMF_FieldGet(geo_3dfld, localDe=0, farrayPtr=fptr, & + computationalLBound=lbnd_destgeo, & + computationalUBound=ubnd_destgeo, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldGet, geo_3dfld', rc) + + write(iulog,"(a,': lon bnd_destgeo=',2i4)") subname, & + lbnd_destgeo(1),ubnd_destgeo(1) + write(iulog,"(a,': lat bnd_destgeo=',2i4)") subname, & + lbnd_destgeo(2),ubnd_destgeo(2) + end if + + ! + ! Save route handles for grid transformations in both directions + ! phys2mag and mag2phys. FieldRegridStore needs to be called only + ! once for each transformation before the timestep loop (src and + ! dest fields are still required, so just use ped here). Once inside + ! the timestep loop, the same routehandle can be used for all fields + ! that are regridded in the given direction. + ! + + ! + ! Compute and store route handle for phys2mag 2d fields: + ! + call ESMF_FieldRegridStore(srcField=phys_2dfld, dstField=mag_des_2dfld, & + regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_IDAVG, & + routeHandle=routehandle_phys2mag_2d, & + factorIndexList=factorIndexList, & + factorList=factorList, srcTermProcessing=smm_srctermproc, & + pipelineDepth=smm_pipelinedep, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegridStore for 2D phys2mag', rc) + + ! + ! Compute and store route handle for phys2mag 3d fields: + ! + call ESMF_FieldRegridStore(srcField=phys_3dfld, dstField=mag_des_3dfld, & + regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_IDAVG, & + routeHandle=routehandle_phys2mag, factorIndexList=factorIndexList, & + factorList=factorList, srcTermProcessing=smm_srctermproc, & + pipelineDepth=smm_pipelinedep, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegridStore for 3D phys2mag', rc) + ! + ! Compute and store route handle for mag2phys 2d (amie) fields: + ! + call ESMF_FieldRegridStore(srcField=mag_src_2dfld, dstField=phys_2dfld,& + regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_IDAVG, & + routeHandle=routehandle_mag2phys_2d, & + factorIndexList=factorIndexList, & + factorList=factorList, srcTermProcessing=smm_srctermproc, & + pipelineDepth=smm_pipelinedep, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegridStore for 2D mag2phys', rc) + if (.not.initialized) then + ! + ! Compute and store route handle for phys2geo 3d fields: + ! + call ESMF_FieldRegridStore(srcField=phys_3dfld, dstField=geo_3dfld, & + regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_IDAVG, & + routeHandle=routehandle_phys2geo, factorIndexList=factorIndexList, & + factorList=factorList, srcTermProcessing=smm_srctermproc, & + pipelineDepth=smm_pipelinedep, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegridStore for 3D phys2geo', rc) + + ! + ! Compute and store route handle for geo2phys 3d fields: + ! + call ESMF_FieldRegridStore(srcField=geo_3dfld, dstField=phys_3dfld,& + regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_IDAVG, & + routeHandle=routehandle_geo2phys, factorIndexList=factorIndexList, & + factorList=factorList, srcTermProcessing=smm_srctermproc, & + pipelineDepth=smm_pipelinedep, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegridStore for 3D geo2phys', rc) + endif + ! + ! Compute and store route handle for geo2mag 3d fields: + ! + call ESMF_FieldRegridStore(srcField=geo_3dfld, dstField=mag_des_3dfld, & + regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + routeHandle=routehandle_geo2mag, factorIndexList=factorIndexList, & + factorList=factorList, srcTermProcessing=smm_srctermproc, & + pipelineDepth=smm_pipelinedep, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegridStore for 3D geo2mag', rc) + ! + ! Compute and store route handle for geo2mag 2d fields: + ! + call ESMF_FieldRegridStore(srcField=geo_2dfld, dstField=mag_des_2dfld, & + regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + routeHandle=routehandle_geo2mag_2d, & + factorIndexList=factorIndexList, & + factorList=factorList, srcTermProcessing=smm_srctermproc, & + pipelineDepth=smm_pipelinedep, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegridStore for 2D geo2mag', rc) + + ! + ! Compute and store route handle for mag2geo 3d fields: + ! + call ESMF_FieldRegridStore(srcField=mag_src_3dfld, dstField=geo_3dfld, & + regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + routeHandle=routehandle_mag2geo, factorIndexList=factorIndexList, & + factorList=factorList, srcTermProcessing=smm_srctermproc, & + pipelineDepth=smm_pipelinedep, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegridStore for 3D mag2geo', rc) + + initialized=.true. + + end subroutine edyn_esmf_update + + !----------------------------------------------------------------------- + subroutine create_mag_grid(grid_out, srcdes) + ! + ! Create ESMF geomagnetic grid, w/ lon,lat coordinates. + ! + ! Args: + type(ESMF_Grid), intent(out) :: grid_out + character(len=*), intent(in) :: srcdes + ! + ! Local: + integer :: i,j,n,rc + real(ESMF_KIND_R8), pointer :: coordX(:,:),coordY(:,:) + integer :: lbnd(2),ubnd(2) + integer :: nmlons_task(ntaski) ! number of lons per task + integer :: nmlats_task(ntaskj) ! number of lats per task + character(len=*), parameter :: subname = 'create_mag_grid' + + ! + ! We are creating either a source grid or a destination grid: + ! + if (srcdes /= 'src' .and. srcdes /= 'des') then + write(iulog,"(a)") '>>> create_mag_grid: srcdes = ''',srcdes, & + ''' but must be either ''src'' or ''des''' + call endrun('create_mag_grid: srcdes') + end if + ! + ! nmlons_task(nmagtaski) = number of mag lons per task in lon dim + ! + do i = 1, nmagtaski + loop: do n = 0, ntask - 1 + if (tasks(n)%magtidi == i-1) then + nmlons_task(i) = tasks(n)%nmaglons + exit loop + end if + end do loop + end do + ! + ! Exclude periodic points (1 point fewer for mpi tasks at east end) + ! for source grids (this overwrites above for eastern-most tasks): + ! + if (srcdes == 'src') then + do n = 0, ntask-1 + if (tasks(n)%magtidi == nmagtaski-1) then ! east edge of proc matrix + nmlons_task(tasks(n)%magtidi+1) = tasks(n)%nmaglons-1 + end if + end do + end if + ! + ! nmlats_task(nmagtaskj) = number of mag lats per task in lat dim + ! + do j = 1, nmagtaskj + loop1: do n = 0, ntask-1 + if (tasks(n)%magtidj == j-1) then + nmlats_task(j) = tasks(n)%nmaglats + exit loop1 + end if + end do loop1 + end do + ! + ! Create curvilinear magnetic grid (both coords depend + ! on both dimensions, i.e., lon(i,j),lat(i,j)): + ! + grid_out = ESMF_GridCreate1PeriDim( & + countsPerDEDim1=nmlons_task, coordDep1=(/1,2/), & + countsPerDEDim2=nmlats_task, coordDep2=(/1,2/), petmap=petmap, & + indexflag=ESMF_INDEX_GLOBAL,rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_GridCreate1PeriDim', rc) + ! + ! Allocate coordinates: + ! + call ESMF_GridAddCoord(grid_out,staggerloc=ESMF_STAGGERLOC_CENTER,rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_GridAddCoord', rc) + if (mytid 72 + end do + ! + ! Get pointer and set geo grid latitude coordinates, including poles: + ! + call ESMF_GridGetCoord(grid_out, coordDim=2, localDE=0, & + computationalLBound=lbnd, computationalUBound=ubnd, & + farrayPtr=coordY, staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_GridGetCoord for latitude coords', rc) + + lbnd_lat = lbnd(1) + ubnd_lat = ubnd(1) + do i = lbnd_lat, ubnd_lat + coordY(i) = glat(i) + end do + + if (debug .and. masterproc) then + write(iulog,"(2a,2i4,a,2i4,a,2i4,a,2i4)") 'Created ESMF geo_grid:', & + ' lbnd,ubnd_lon=', lbnd_lon, ubnd_lon, ' lon0,1=', lon0, lon1, & + ' lbnd,ubnd_lat=', lbnd_lat, ubnd_lat, ' lat0,1=', lat0, lat1 + write(iulog,"('coordX for geo grid = ',/,(8f10.4))") coordX + write(iulog,"('coordY for geo grid = ',/,(8f10.4))") coordY + end if + endif - if (rc /=ESMF_SUCCESS) then - write(iulog,"(/,2a,i4)") '>>> create_geo_grid: error return from ',& - 'ESMF_GridCreate1PeriDim: rc=',rc - call endrun('create_geo_grid: ESMF_GridCreate1PeriDim') - endif -! -! Allocate coordinates: -! - call ESMF_GridAddCoord(grid_out,staggerloc=ESMF_STAGGERLOC_CENTER,rc=rc) - - if (rc /=ESMF_SUCCESS) then - write(iulog,"(/,a)") '>>> create_geo_grid: error return from ESMF_GridAddCoord' - call endrun('create_geo_grid: ESMF_GridAddCoord') - endif -! -! Get pointer and set geo grid longitude coordinates: -! - call ESMF_GridGetCoord(grid_out, coordDim=1, localDE=0, & - computationalLBound=lbnd, computationalUBound=ubnd, & - farrayPtr=coordX, staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) - - if (rc /=ESMF_SUCCESS) then - write(iulog,"(/,2a)") '>>> create_geo_grid: error return from ',& - 'ESMF_GridGetCoord for longitude coords' - call endrun('create_geo_grid: ESMF_GridGetCoord longitude') - endif -! -! Note glon was shifted to +/-180 by sub set_geogrid (edyn_init.F90) -! - lbnd_lon = lbnd(1) ; ubnd_lon = ubnd(1) - do i=lbnd_lon,ubnd_lon - coordX(i) = glon(i) ! 1 -> 72 - enddo -! -! Get pointer and set geo grid latitude coordinates, including poles: -! - call ESMF_GridGetCoord(grid_out, coordDim=2, localDE=0, & - computationalLBound=lbnd, computationalUBound=ubnd, & - farrayPtr=coordY, staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) - - if (rc /=ESMF_SUCCESS) then - write(iulog,"(/,2a)") '>>> create_geo_grid: error return from ',& - 'ESMF_GridGetCoord for latitude coords' - call endrun('create_geo_grid: ESMF_GridGetCoord latitude') - endif + end subroutine create_geo_grid + + !----------------------------------------------------------------------- + subroutine edyn_esmf_create_physfield(field, mesh, name, nlev) + ! + ! Create ESMF field (2d or 3d) on physics mesh + ! If nlev == 0, field is 2d (i,j), otherwise field is 3d, + ! and 3rd dimension is ungridded + ! + ! Args: + integer, intent(in) :: nlev ! if nlev == 0, field is 2d (i,j) + type(ESMF_Mesh), intent(in) :: mesh + character(len=*), intent(in) :: name + type(ESMF_Field), intent(out) :: field + ! + ! Local: + integer :: rc + type(ESMF_ArraySpec) :: arrayspec + character(len=*), parameter :: subname = 'edyn_esmf_create_physfield' + + + ! Create 3d field (i,j,k), with non-distributed vertical dimension: + if (nlev > 0) then + call ESMF_ArraySpecSet(arrayspec, 2, ESMF_TYPEKIND_R8, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_ArraySpecSet 2D', rc) + field = ESMF_FieldCreate(mesh, arrayspec, & + gridToFieldMap=(/2/), meshloc=ESMF_MESHLOC_ELEMENT, & + ungriddedLBound=(/1/), ungriddedUBound=(/nlev/), rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldCreate 2D field', rc) + ! + ! Create 2d field (i,j): + else ! create 2d field + call ESMF_ArraySpecSet(arrayspec, 1, ESMF_TYPEKIND_R8, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_ArraySpecSet 2D', rc) + field = ESMF_FieldCreate(mesh, arrayspec, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldCreate 2D field', rc) + end if + + end subroutine edyn_esmf_create_physfield + !----------------------------------------------------------------------- + subroutine edyn_esmf_create_geofield(field, grid, name, nlev) + ! + ! Create ESMF field (2d or 3d) on geo grid (will exclude periodic points) + ! If nlev == 0, field is 2d (i,j), otherwise field is 3d, + ! and 3rd dimension is ungridded + ! + ! Args: + integer, intent(in) :: nlev ! if nlev == 0, field is 2d (i,j) + type(ESMF_Grid), intent(in) :: grid + character(len=*), intent(in) :: name + type(ESMF_Field), intent(out) :: field + ! + ! Local: + integer :: rc + type(ESMF_ArraySpec) :: arrayspec + character(len=*), parameter :: subname = 'edyn_esmf_create_geofield' + ! + ! Create 3d field (i,j,k), with non-distributed vertical dimension: + if (nlev > 0) then + call ESMF_ArraySpecSet(arrayspec,3,ESMF_TYPEKIND_R8,rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_ArraySpecSet 3D', rc) + field = ESMF_FieldCreate(grid, arrayspec,ungriddedLBound=(/1/), & + ungriddedUBound=(/nlev/),staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldCreate 3D field', rc) + ! + ! Create 2d field (i,j): + else ! create 2d field + call ESMF_ArraySpecSet(arrayspec, 2, ESMF_TYPEKIND_R8, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_ArraySpecSet 2D', rc) + field = ESMF_FieldCreate(grid, arrayspec,& + staggerloc=ESMF_STAGGERLOC_CENTER,rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldCreate 2D field', rc) + end if + end subroutine edyn_esmf_create_geofield + !----------------------------------------------------------------------- + subroutine edyn_esmf_create_magfield(field, grid, name, nlev) + ! + ! Create ESMF field (2d or 3d) on mag grid. This will include the + ! mag periodic point, which will be zero after regridding. + ! If nlev == 0, field is 2d (i,j), otherwise field is 3d, + ! and 3rd dimension is ungridded + ! + ! Args: + integer, intent(in) :: nlev ! if nlev == 0, field is 2d (i,j) + type(ESMF_Grid), intent(in) :: grid + character(len=*), intent(in) :: name + type(ESMF_Field), intent(out) :: field + ! + ! Local: + integer :: rc + type(ESMF_ArraySpec) :: arrayspec + type(ESMF_Array) :: array3d,array2d + type(ESMF_DistGrid) :: distgrid + character(len=*), parameter :: subname = 'edyn_esmf_create_magfield' + ! + ! Get necessary information from the mag grid: + call ESMF_GridGet(grid, staggerloc=ESMF_STAGGERLOC_CENTER, & + distgrid=distgrid,rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_GridGet', rc) + ! + ! Create 3d mag field (i,j,k), with non-distributed vertical dimension: + ! (add periodic point in longitude with computationalEdgeUWidth) + ! + if (nlev > 0) then + call ESMF_ArraySpecSet(arrayspec,3,ESMF_TYPEKIND_R8,rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_ArraySpecSet 3D field', rc) + + array3d = ESMF_ArrayCreate(arrayspec=arrayspec, & + distgrid=distgrid,computationalEdgeUWidth=(/1,0/), & + undistLBound=(/1/),undistUBound=(/nlev/), & + indexflag=ESMF_INDEX_GLOBAL,rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_ArrayCreate 3D field', rc) + + field = ESMF_FieldCreate(grid, array3d, & + ungriddedLBound=(/1/), ungriddedUBound=(/nlev/), & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldCreate 3D field', rc) + ! + ! Create 2d mag field (i,j): + ! (add periodic point in longitude with computationalEdgeUWidth) + ! + else ! create 2d field + call ESMF_ArraySpecSet(arrayspec,2,ESMF_TYPEKIND_R8,rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_ArraySpecSet 2D field', rc) + + array2d = ESMF_ArrayCreate(arrayspec=arrayspec, & + distgrid=distgrid,computationalEdgeUWidth=(/1,0/), & + indexflag=ESMF_INDEX_GLOBAL,rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_ArrayCreate 2D field', rc) + field = ESMF_FieldCreate(grid, array2d, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldCreate 2D field', rc) + end if + end subroutine edyn_esmf_create_magfield + + !----------------------------------------------------------------------- + subroutine edyn_esmf_set3d_geo(field, fdata, ilon0, ilon1, ilat0, ilat1, ilev0, ilev1 ) + ! + ! Set values of a 3d ESMF field on geographic source grid, prior to + ! geographic to physics grid transformation. + ! Periodic points are excluded, geographic poles are at + ! j==jspole and jnpole + ! Note dimension order changes from input (k,i,j) to output (i,j,k). + ! + ! Args: + type(ESMF_Field), intent(in) :: field ! esmf fields on geo grid + ! + ! field is input data on model subdomains (including periodic points) + ! (note esmf source field excludes periodic points) + ! + integer, intent(in) :: ilev0, ilev1, ilon0, ilon1, ilat0, ilat1 + real(r8), intent(in) :: fdata(ilon0:ilon1,ilat0:ilat1,ilev0:ilev1) + ! + ! Local: + integer :: i, j, k, rc + integer :: lbnd(3), ubnd(3) ! 3d field bounds + ! + ! fptr is esmf pointer (i,j,k) to 3d field, set by this subroutine + real(ESMF_KIND_R8), pointer :: fptr(:,:,:) + character(len=*), parameter :: subname = 'edyn_esmf_set3d_geo' + if (mytid 0) then - call ESMF_ArraySpecSet(arrayspec,3,ESMF_TYPEKIND_R8,rc=rc) - if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_geofield: ESMF_ArraySpecSet 3d field') - field = ESMF_FieldCreate(grid, arrayspec,ungriddedLBound=(/1/), & - ungriddedUBound=(/nlev/),staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_geofield: ESMF_FieldCreate 3d field') -! -! Create 2d field (i,j): - else ! create 2d field - call ESMF_ArraySpecSet(arrayspec,2,ESMF_TYPEKIND_R8,rc=rc) - if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_geofield: ESMF_ArraySpecSet 2d field') - field = ESMF_FieldCreate(grid, arrayspec,& - staggerloc=ESMF_STAGGERLOC_CENTER,rc=rc) - if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_geofield: ESMF_FieldCreate 2d field') - endif - end subroutine edyn_esmf_create_geofield -!----------------------------------------------------------------------- - subroutine edyn_esmf_create_magfield(field,grid,name,nlev) -! -! Create ESMF field (2d or 3d) on mag grid. This will include the -! mag periodic point, which will be zero after regridding. -! If nlev == 0, field is 2d (i,j), otherwise field is 3d, -! and 3rd dimension is ungridded -! -! Args: - integer,intent(in) :: nlev ! if nlev == 0, field is 2d (i,j) - type(ESMF_Grid),intent(in) :: grid - character(len=*),intent(in) :: name - type(ESMF_Field),intent(out) :: field -! -! Local: - integer :: rc - type(ESMF_ArraySpec) :: arrayspec - type(ESMF_Array) :: array3d,array2d - type(ESMF_DistGrid) :: distgrid -! -! Get necessary information from the mag grid: - call ESMF_GridGet(grid, staggerloc=ESMF_STAGGERLOC_CENTER,& - distgrid=distgrid,rc=rc) - if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_magfield: ESMF_GridGet') -! -! Create 3d mag field (i,j,k), with non-distributed vertical dimension: -! (add periodic point in longitude with computationalEdgeUWidth) -! - if (nlev > 0) then - call ESMF_ArraySpecSet(arrayspec,3,ESMF_TYPEKIND_R8,rc=rc) - if (rc /= ESMF_SUCCESS)call endrun('edyn_esmf_create_magfield: ESMF_ArraySpecSet 3d field') - - array3d = ESMF_ArrayCreate(arrayspec=arrayspec, & - distgrid=distgrid,computationalEdgeUWidth=(/1,0/), & - undistLBound=(/1/),undistUBound=(/nlev/), & - indexflag=ESMF_INDEX_GLOBAL,rc=rc) - if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_magfield: ESMF_ArrayCreate 3d field') - - field = ESMF_FieldCreate(grid, array3d, & - ungriddedLBound=(/1/), ungriddedUBound=(/nlev/), & - staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_magfield: ESMF_FieldCreate 3d field') -! -! Create 2d mag field (i,j): -! (add periodic point in longitude with computationalEdgeUWidth) -! - else ! create 2d field - call ESMF_ArraySpecSet(arrayspec,2,ESMF_TYPEKIND_R8,rc=rc) - if (rc /= ESMF_SUCCESS)call endrun('edyn_esmf_create_magfield: ESMF_ArraySpecSet 2d field') - - array2d = ESMF_ArrayCreate(arrayspec=arrayspec, & - distgrid=distgrid,computationalEdgeUWidth=(/1,0/), & - indexflag=ESMF_INDEX_GLOBAL,rc=rc) - if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_magfield: ESMF_ArrayCreate 2d field') - field = ESMF_FieldCreate(grid, array2d, & - staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (rc /= ESMF_SUCCESS) call endrun('edyn_esmf_create_magfield: ESMF_FieldCreate 2d field') + data(:,:,:) = fptr(:,:,:) endif - end subroutine edyn_esmf_create_magfield - -!----------------------------------------------------------------------- - subroutine edyn_esmf_set3d_geo(fields,fnames,f,nf,ilev0,ilev1,& - ilon0,ilon1,ilat0,ilat1) -! -! Set values of a 3d ESMF field on geographic source grid, prior to -! geographic to magnetic grid transformation. -! Periodic points are excluded, geographic poles are at j==jspole and jnpole -! Note dimension order changes from input (k,i,j) to output (i,j,k). -! -! Args: - integer,intent(in) :: nf - type(ESMF_Field) ,intent(in) :: fields(nf) ! esmf fields on geo grid - character(len=*) ,intent(in) :: fnames(nf) ! field names -! -! f is input data on model subdomains (including periodic points) -! (note esmf source field excludes periodic points) -! - integer,intent(in) :: ilev0,ilev1,ilon0,ilon1,ilat0,ilat1 - real(r8),intent(in) :: f(ilev0:ilev1,ilon0:ilon1,ilat0:ilat1,nf) -! -! Local: - integer :: i,ii,j,k,rc,n,istat - integer,parameter :: mxf=8 ! for call by dynamo_inputs - integer :: lbnd(3),ubnd(3) ! lower,upper bounds of 3d field -! -! fptr is esmf pointer (i,j,k) to 3d field, set by this subroutine - real(ESMF_KIND_R8),pointer :: fptr(:,:,:) - real(r8),allocatable :: ftmp(:,:,:,:) ! esmf bounds, plus nf - - if (nf > mxf) then - write(iulog,"('>>> esmf_set3d_geo: nf cannot be greater than mxf: nf=',i4,' mxf=',i4)") & - nf,mxf - call endrun('edyn_esmf_set3d_geo: nf > mxf') + + end subroutine edyn_esmf_get_3dfield + !----------------------------------------------------------------------- + subroutine edyn_esmf_get_2dfield(field, data, i0,i1,j0,j1 ) + ! + ! Get pointer to 2d esmf field (i,j): + ! + ! Args: + integer, intent(in) :: i0,i1,j0,j1 + type(ESMF_field), intent(in) :: field + real(r8), intent(out) :: data(i0:i1,j0:j1) + ! + ! Local: + real(r8), pointer :: fptr(:,:) + integer :: rc, lbnd(2), ubnd(2) + character(len=*), parameter :: subname = 'edyn_esmf_get_2dfield' + if (mytid>> esmf_set3d_geo: error from ESMF_FieldGet: rc=',i4)") rc - call endrun('edyn_esmf_set3d_geo: ESMF_FieldGet field 1') + if (i0/=lbnd(1).or.i1/=ubnd(1).or.j0/=lbnd(2).or.j1/=ubnd(2)) then + call endrun(subname//' array bnds do not match') endif -! -! Do the allocation: - allocate(ftmp(lbnd(1):ubnd(1),lbnd(2):ubnd(2),lbnd(3):ubnd(3),mxf),stat=istat) - if (istat /= 0) then - write(iulog,"('>>> esmf_set3d_geo: error allocating ftmp')") - call endrun('edyn_esmf_set3d_geo: allocating ftmp') + + data(:,:) = fptr(:,:) + + end subroutine edyn_esmf_get_2dphysfield + !----------------------------------------------------------------------- + subroutine edyn_esmf_get_1dfield(field, data, i0,i1 ) + ! + ! Get pointer to 2d esmf field (i,j): + ! + ! Args: + integer, intent(in) :: i0,i1 + type(ESMF_field), intent(in) :: field + real(r8), intent(out) :: data(i0:i1) + ! + ! Local: + real(r8), pointer :: fptr(:) + integer :: rc, lbnd(1), ubnd(1) + character(len=*), parameter :: subname = 'edyn_esmf_get_1dfield' + + call ESMF_FieldGet(field, localDe=0, farrayPtr=fptr, & + computationalLBound=lbnd, computationalUBound=ubnd, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldGet', rc) + + if (i0/=lbnd(1).or.i1/=ubnd(1)) then + call endrun(subname//' array bnds do not match') endif -! -! Fields loop: - do n=1,nf - ftmp(:,:,:,n) = 0._r8 -! -! Set interior latitudes (ftmp(i,j,k,n) <- f(k,i,j,n)) -! ftmp excludes periodic points. -! - do j=lbnd(2),ubnd(2) ! lat - if (j /= jspole .and. j /= jnpole) then ! interior latitudes (not poles) - do i=lbnd(1),ubnd(1) ! lon - ii = i - do k=lbnd(3),ubnd(3) ! lev - ftmp(i,j,k,n) = f(k,ii,j,n) - enddo ! lev - enddo ! lon - endif ! poles or interior - enddo ! lat - enddo ! n=1,nf -! -! Get and set pointer to the field: - do n=1,nf - call ESMF_FieldGet(fields(n),localDe=0,farrayPtr=fptr, & - computationalLBound=lbnd,computationalUBound=ubnd,rc=rc) - if (rc /= ESMF_SUCCESS) then - write(iulog,"(a,i4)") '>>> esmf_set3d_geo: error from ESMF_FieldGet: rc=',rc - call endrun('edyn_esmf_set3d_geo: ESMF_FieldGet field') + + data(:) = fptr(:) + + end subroutine edyn_esmf_get_1dfield + !----------------------------------------------------------------------- + subroutine edyn_esmf_regrid_phys2mag(srcfield, dstfield, ndim) + ! + ! Args: + integer :: ndim + type(ESMF_Field), intent(inout) :: srcfield, dstfield + ! + ! Local: + integer :: rc + character(len=*), parameter :: subname = 'edyn_esmf_regrid_phys2mag' + ! + if (ndim == 2) then + ! + ! Do sparse matrix multiply for 2d phys2mag. + ! + call ESMF_FieldRegrid(srcfield, dstfield, routehandle_phys2mag_2d, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegrid phys2mag 2D', rc) + else ! 3d geo2mag + ! + ! Do sparse matrix multiply for 3d geo2mag. + ! + call ESMF_FieldRegrid(srcfield, dstfield, routehandle_phys2mag, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegrid phys2mag 3D', rc) + end if + end subroutine edyn_esmf_regrid_phys2mag + !----------------------------------------------------------------------- + subroutine edyn_esmf_regrid_mag2phys(srcfield, dstfield, ndim) + ! + ! Args: + type(ESMF_Field), intent(inout) :: srcfield, dstfield + integer :: ndim + ! + ! Local: + integer :: rc + character(len=*), parameter :: subname = 'edyn_esmf_regrid_mag2phys' + ! + if (ndim == 2) then + call ESMF_FieldRegrid(srcfield, dstfield, routehandle_mag2phys_2d, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegrid mag2phys 2D', rc) + else + ! call ESMF_FieldRegrid(srcfield, dstfield, routehandle_mag2phys, & + ! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + ! call edyn_esmf_chkerr(subname, 'ESMF_FieldRegrid mag2phys 3D', rc) + call endrun(subname//': routehandle_mag2phys not implemented') + end if + end subroutine edyn_esmf_regrid_mag2phys + !----------------------------------------------------------------------- + subroutine edyn_esmf_regrid_phys2geo(srcfield, dstfield, ndim) + ! + ! Args: + integer :: ndim + type(ESMF_Field), intent(inout) :: srcfield, dstfield + ! + ! Local: + integer :: rc + character(len=*), parameter :: subname = 'edyn_esmf_regrid_phys2geo' + ! + if (ndim == 2) then + ! call ESMF_FieldRegrid( srcfield, dstfield, routehandle_phys2geo_2d, & + ! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + ! call edyn_esmf_chkerr(subname, 'ESMF_FieldRegrid phys2geo 2D', rc) + call endrun(subname//': routehandle_phys2geo_2d not implemented') + else ! 3d phys2geo + ! + ! Do sparse matrix multiply for 3d phys2geo. + ! + call ESMF_FieldRegrid( srcfield, dstfield, routehandle_phys2geo, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegrid phys2geo 3D', rc) + end if + end subroutine edyn_esmf_regrid_phys2geo + !----------------------------------------------------------------------- + subroutine edyn_esmf_regrid_geo2phys(srcfield, dstfield, ndim) + ! + ! Args: + integer :: ndim + type(ESMF_Field), intent(inout) :: srcfield, dstfield + ! + ! Local: + integer :: rc + character(len=*), parameter :: subname = 'edyn_esmf_regrid_geo2phys' + ! + if (ndim == 2) then + ! call ESMF_FieldRegrid(srcfield, dstfield, routehandle_geo2phys_2d, & + ! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + ! call edyn_esmf_chkerr(subname, 'ESMF_FieldRegrid geo2phys 2D', rc) + call endrun(subname//': routehandle_geo2phys_2d not implemented') + else + call ESMF_FieldRegrid( srcfield, dstfield, routehandle_geo2phys, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegrid geo2phys 3D', rc) + end if + end subroutine edyn_esmf_regrid_geo2phys + !----------------------------------------------------------------------- + subroutine edyn_esmf_regrid_geo2mag(srcfield, dstfield, ndim) + ! + ! Args: + integer :: ndim + type(ESMF_Field), intent(inout) :: srcfield, dstfield + ! + ! Local: + integer :: rc + character(len=*), parameter :: subname = 'edyn_esmf_regrid_geo2mag' + ! + if (ndim == 2) then + ! + ! Do sparse matrix multiply for 2d geo2mag. + ! + call ESMF_FieldRegrid(srcfield, dstfield, routehandle_geo2mag_2d, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegrid geo2mag 2D', rc) + else ! 3d geo2mag + ! + ! Do sparse matrix multiply for 3d geo2mag. + ! + call ESMF_FieldRegrid(srcfield, dstfield, routehandle_geo2mag, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegrid geo2mag 3D', rc) + end if + end subroutine edyn_esmf_regrid_geo2mag + !----------------------------------------------------------------------- + + subroutine edyn_esmf_regrid_mag2geo(srcfield, dstfield, ndim) + ! + ! Args: + integer :: ndim + type(ESMF_Field), intent(inout) :: srcfield, dstfield + ! + ! Local: + integer :: rc + character(len=*), parameter :: subname = 'edyn_esmf_regrid_mag2geo' + ! + if (ndim == 2) then + ! call ESMF_FieldRegrid(srcfield, dstfield, routehandle_mag2geo_2d, & + ! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + ! call edyn_esmf_chkerr(subname, 'ESMF_FieldRegrid geo2mag 2D', rc) + call endrun(subname//': routehandle_mag2geo_2d not implemented') + else ! 3d geo2mag + ! + ! Do sparse matrix multiply for 3d geo2mag. + ! + call ESMF_FieldRegrid(srcfield, dstfield, routehandle_mag2geo, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + call edyn_esmf_chkerr(subname, 'ESMF_FieldRegrid geo2mag 3D', rc) + end if + end subroutine edyn_esmf_regrid_mag2geo + + + !----------------------------------------------------------------------- + + subroutine edyn_esmf_update_phys_mesh(new_phys_mesh) + + ! Dummy argument + type(ESMF_Mesh), intent(in) :: new_phys_mesh + + integer :: petcnt, i,j + + ! Ignore return code here as all we need is an attempt to reclaim memory + if (ESMF_MeshIsCreated(phys_mesh)) then + call ESMF_MeshDestroy(phys_mesh) + end if + + phys_mesh = new_phys_mesh + + if (.not. allocated(petmap)) then + allocate(petmap(ntaski,ntaskj,1)) endif - fptr(:,:,:) = ftmp(:,:,:,n) - enddo ! n=1,nf - - deallocate(ftmp) - - end subroutine edyn_esmf_set3d_geo -!----------------------------------------------------------------------- - subroutine edyn_esmf_set2d_geo(field,grid,fname,f,ilon0,ilon1,ilat0,ilat1) -! -! Set values of a 2d ESMF field on geographic source grid, prior to -! geographic to magnetic grid transformation. (Essentially the same -! as esmf_set3d_geo, except for 2d fields instead of 3d) -! Periodic points are excluded, geographic poles are at j==jspole and jnpole -! -! Args: - type(ESMF_Field) ,intent(in) :: field - type(ESMF_Grid) ,intent(in) :: grid - character(len=*) ,intent(in) :: fname ! field name - integer ,intent(in) :: ilon0,ilon1,ilat0,ilat1 - real(r8) ,intent(in) :: f(ilon0:ilon1,ilat0:ilat1) -! -! Local: - integer :: i,ii,j,rc - real(ESMF_KIND_R8),pointer :: fptr(:,:) ! i,j - integer :: lbnd(2),ubnd(2) -! -! Get pointer to the field: - call ESMF_FieldGet(field,localDe=0,farrayPtr=fptr,& - computationalLBound=lbnd,computationalUBound=ubnd,rc=rc) - if (rc /= ESMF_SUCCESS) then - write(iulog,"(a,i4)") '>>> esmf_set2d_geo: error from ESMF_FieldGet: rc=',rc - call endrun('edyn_esmf_set2d_geo: ESMF_FieldGet') - endif -! - fptr(:,:) = 0._r8 ! init -! -! Set interior latitudes (excluding poles): - do j=lbnd(2),ubnd(2) - if (j /= jspole .and. j /= jnpole) then - do i=lbnd(1),ubnd(1) - ii = i - fptr(i,j) = f(ii,j) - enddo - endif ! interior latitudes only - enddo - - if (debug) & - write(iulog,"('esmf_set2d_geo field ',a,': lon bnds=',2i4, & - ' lat bnds=',2i4,' 2d mnmx=',2e12.4)") & - fname,lbnd(1),ubnd(1),lbnd(2),ubnd(2), & - minval(fptr(:,:)),maxval(fptr(:,:)) - - end subroutine edyn_esmf_set2d_geo -!----------------------------------------------------------------------- - subroutine edyn_esmf_set3d_mag(fields,fnames,f,nf,ilev0,ilev1,ilon0,ilon1,ilat0,ilat1) -! -! Set values of a 3d ESMF field on magnetic grid, prior to magnetic to -! geographic grid transformation. -! -! Args: - integer,intent(in) :: nf - type(ESMF_Field) ,intent(in) :: fields(nf) ! esmf fields on mag grid - character(len=*) ,intent(in) :: fnames(nf) ! field names -! -! f is input data on model subdomains: -! - integer,intent(in) :: ilev0,ilev1,ilon0,ilon1,ilat0,ilat1 - real(r8),intent(in) :: f(ilon0:ilon1,ilat0:ilat1,ilev0:ilev1,nf) -! -! Local: - integer :: i,j,k,rc,n - integer :: lbnd(3),ubnd(3) ! lower,upper bounds of 3d field -! -! fptr is esmf pointer (i,j,k) to 3d field, set by this subroutine - real(ESMF_KIND_R8),pointer :: fptr(:,:,:) -! -! Fields loop: - do n=1,nf - call ESMF_FieldGet(fields(n),localDe=0,farrayPtr=fptr,& - computationalLBound=lbnd,computationalUBound=ubnd,rc=rc) - if (rc /= ESMF_SUCCESS) then - write(iulog,"(a,i4)") '>>> esmf_set3d_mag: error from ESMF_FieldGet: rc=',rc - call endrun('edyn_esmf_set3d_mag: ESMF_FieldGet') - endif -! - fptr(:,:,:) = 0._r8 -! -! Set ESMF pointer: -! - do j=lbnd(2),ubnd(2) ! lat - do i=lbnd(1),ubnd(1) ! lon - do k=lbnd(3),ubnd(3) ! lev - fptr(i,j,k) = f(i,j,k,n) - enddo ! mlev - enddo ! mlon - enddo ! mlat - enddo ! n=1,nf - end subroutine edyn_esmf_set3d_mag -!----------------------------------------------------------------------- -! - subroutine edyn_esmf_set2d_mag(fields,fnames,f,nf,ilon0,ilon1,ilat0,ilat1) -! -! Set values of a 2d ESMF field on magnetic grid, prior to magnetic to -! geographic grid transformation. -! -! Args: - integer,intent(in) :: nf - type(ESMF_Field) ,intent(in) :: fields(nf) ! esmf fields on mag grid - character(len=*) ,intent(in) :: fnames(nf) ! field names -! -! f is input data on model subdomains: -! - integer,intent(in) :: ilon0,ilon1,ilat0,ilat1 - real(r8),intent(in) :: f(ilon0:ilon1,ilat0:ilat1,nf) -! -! Local: - integer :: i,j,rc,n - integer :: lbnd(2),ubnd(2) ! lower,upper bounds of 2d field -! -! fptr is esmf pointer (i,j,k) to 2d field, set by this subroutine - real(ESMF_KIND_R8),pointer :: fptr(:,:) -! -! Fields loop: - do n=1,nf - call ESMF_FieldGet(fields(n),localDe=0,farrayPtr=fptr,& - computationalLBound=lbnd,computationalUBound=ubnd,rc=rc) - if (rc /= ESMF_SUCCESS) then - write(iulog,"(a,i4)") '>>> esmf_set2d_mag: error from ESMF_FieldGet: rc=',rc - call endrun('edyn_esmf_set2d_mag: ESMF_FieldGet') - endif -! - fptr(:,:) = 0._r8 -! -! Set ESMF pointer: -! - do j=lbnd(2),ubnd(2) ! lat - do i=lbnd(1),ubnd(1) ! lon - fptr(i,j) = f(i,j,n) - enddo ! mlon - enddo ! mlat - enddo ! n=1,nf -! - end subroutine edyn_esmf_set2d_mag -!----------------------------------------------------------------------- - subroutine edyn_esmf_get_3dfield(field, fptr, name) -! -! Get pointer to 3d esmf field (i,j,k): -! -! Args: - type(ESMF_field),intent(in) :: field - real(r8),pointer,dimension(:,:,:),intent(out) :: fptr - character(len=*),intent(in) :: name -! -! Local: - integer :: rc,lbnd(3),ubnd(3) - character(len=80) :: errmsg - - call ESMF_FieldGet(field,localDe=0,farrayPtr=fptr, & - computationalLBound=lbnd,computationalUBound=ubnd,rc=rc) - if (rc /= ESMF_SUCCESS) then - write(errmsg,"('esmf_get_field 3d field ',a)") trim(name) - call endrun('edyn_esmf_get_3dfield: ESMF_FieldGet') - endif - end subroutine edyn_esmf_get_3dfield -!----------------------------------------------------------------------- - subroutine edyn_esmf_get_2dfield(field, fptr, name) -! -! Get pointer to 2d esmf field (i,j): -! -! Args: - type(ESMF_field),intent(in) :: field - real(r8),pointer,dimension(:,:),intent(out) :: fptr - character(len=*),intent(in) :: name -! -! Local: - integer :: rc - character(len=80) :: errmsg - - call ESMF_FieldGet(field,localDe=0,farrayPtr=fptr,rc=rc) - if (rc /= ESMF_SUCCESS) then - write(errmsg,"('edyn_esmf_get_2dfield ',a)") trim(name) - call endrun('edyn_esmf_get_2dfield: ESMF_FieldGet') - endif - end subroutine edyn_esmf_get_2dfield -!----------------------------------------------------------------------- - subroutine edyn_esmf_regrid(srcfield,dstfield,direction,ndim) -! -! Args: - integer :: ndim - type(ESMF_Field),intent(inout) :: srcfield,dstfield - character(len=*),intent(in) :: direction -! -! Local: - integer :: rc - type(ESMF_RouteHandle) :: routehandle -! -! Direction is either geo2mag or mag2geo. -! Use corresponding route handle (module data) -! - select case(trim(direction)) - case ('geo2mag') - routehandle = routehandle_geo2mag - if (ndim==2) then -! -! Do sparse matrix multiply for 2d geo2mag. -! - routehandle = routehandle_geo2mag_2d - call ESMF_FieldSMM(srcfield,dstfield,routehandle,termorderflag=ESMF_TERMORDER_SRCSEQ,rc=rc) - - if (rc /= ESMF_SUCCESS) then - write(iulog,"(/,4a,i4)") '>>> edyn_esmf_regrid: error return from ',& - 'ESMF_FieldSMM for 2d ',trim(direction),': rc=',rc - call endrun('edyn_esmf_regrid: ESMF_FieldSMM 2d') - endif - else ! 3d geo2mag -! -! Do sparse matrix multiply for 3d geo2mag. -! - routehandle = routehandle_geo2mag - call ESMF_FieldSMM(srcfield,dstfield,routehandle,termorderflag=ESMF_TERMORDER_SRCSEQ,rc=rc) - if (rc /= ESMF_SUCCESS) then - write(iulog,"(/,4a,i4)") '>>> edyn_esmf_regrid: error return from ',& - 'ESMF_FieldSMM for 3d ',trim(direction),': rc=',rc - call endrun('edyn_esmf_regrid: ESMF_FieldSMM 3d') - endif - endif -! -! Do sparse matrix multiply for 3d mag2geo. -! btf 6/18/14: mag2geo is not working due to error return rc=51 from the -! below call. Calls to mag2geo_3d at end of sub pefield (edynamo.F90) -! are commented out (mag2geo_3d calls this routine with direction='mag2geo'). -! - case ('mag2geo') - if (ndim==2) then - routehandle = routehandle_mag2geo_2d - else - routehandle = routehandle_mag2geo - endif - call ESMF_FieldSMM(srcfield,dstfield,routehandle,termorderflag=ESMF_TERMORDER_SRCSEQ,checkflag=.true.,rc=rc) - if (rc /= ESMF_SUCCESS) then - write(iulog,"(/,4a,i4)") '>>> edyn_esmf_regrid: error return from ',& - 'ESMF_FieldSMM for 3d ',trim(direction),': rc=',rc - call endrun('edyn_esmf_regrid: ESMF_FieldSMM magtogeo') - endif - case default - write(iulog,"('>>> edyn_esmf_regrid: bad direction=',a)") trim(direction) - call endrun - end select - end subroutine edyn_esmf_regrid -!----------------------------------------------------------------------- - - subroutine edyn_esmf_update_flag( flag ) - logical, intent(in) :: flag - edyn_esmf_update_step=flag - end subroutine edyn_esmf_update_flag - -#endif + petcnt = 0 + do j = 1,ntaskj + do i = 1,ntaski + petmap(i,j,1) = petcnt + petcnt = petcnt+1 + end do + end do + + end subroutine edyn_esmf_update_phys_mesh + end module edyn_esmf diff --git a/src/ionosphere/waccmx/edyn_geogrid.F90 b/src/ionosphere/waccmx/edyn_geogrid.F90 index cacff0d7e8..88406e6a32 100644 --- a/src/ionosphere/waccmx/edyn_geogrid.F90 +++ b/src/ionosphere/waccmx/edyn_geogrid.F90 @@ -1,73 +1,236 @@ module edyn_geogrid ! -! Global geographic grid. +! Global geographic grid. ! See sub set_geogrid (edyn_init.F90) ! - use shr_kind_mod, only : r8 => shr_kind_r8 ! 8-byte reals + use shr_kind_mod, only: r8 => shr_kind_r8 ! 8-byte reals + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + implicit none + private save - integer :: & ! dimensions + integer, public, protected :: & ! dimensions nlat, & ! number of latitudes nlon, & ! number of longitudes nlev, & ! number of midpoint levels - nilev, & ! number of interface latitudes - ntime ! number of times on input file + nilev, & ! number of interface levels + npes ! number of PEs in geogrid - real(r8),allocatable,dimension(:) :: & ! coordinate vars + real(r8), public, protected, allocatable , dimension(:) :: & ! coordinate vars glat, & ! latitude coordinates (degrees) glon, & ! longitude coordinates (degrees) ylatg, & ! latitudes (radians) ylong, & ! longitudes (radians) zlev, & ! midpoint vertical coordinates - zilev, & ! interface vertical coordinates - time ! times (histories) on input file + zilev ! interface vertical coordinates - real(r8),allocatable,dimension(:) :: & - cs, & ! cos(phi) (0:nlat+1) - zp, & ! log pressure (as in tiegcm lev(nlev)) - expz ! exp(-zp) + real(r8), public, allocatable, protected :: cs(:) ! cos(phi) (0:nlat+1) - integer :: & ! model independent (set by sub get_geogrid) + integer, public, protected :: & ! model independent (set by sub get_geogrid) nlonp1, & ! nlon+1 nlonp2, & ! nlon+2 nlatp1 ! nlat+1 - real(r8) :: dlatg,dlong - real(r8) :: dphi,dlamda + real(r8), public, protected :: dphi + real(r8), public, protected :: dlamda ! ! Using p0 in microbars, as in TIEGCM. - real(r8),parameter :: p0 = 5.0e-4_r8 ! standard pressure (microbars) + real(r8), parameter, public :: p0 = 5.0e-4_r8 ! standard pressure (microbars) - integer :: & ! model dependent (set by subs read_tgcm, read_waccm) + integer, public, protected :: & ! model dependent (set by subs read_tgcm, read_waccm) jspole, & ! latitude index to geographic south pole jnpole ! latitude index to geographic north pole -! -! lev_sequence is a string indicating ordering of the vertical -! coordinates lev and ilev, and of the field arrays along the -! vertical dimension. lev_sequence can have 1 of 2 values: -! -! 'bottom2top' means lev(1) is the bottom boundary, lev(nlev) is the top boundary -! 'top2bottom' means lev(1) is the top boundary, lev(nlev) is the bottom boundary -! -! For example, TIMEGCM history files are bottom2top, whereas -! WACCM files are top2bottom. The edynamo code assumes bottom2top, -! so WACCM input fields are reversed to be bottom2top for the edynamo -! calculations, then reversed back to the native WACCM sequence -! (top2bottom) before writing to the edynamo output file. -! - character(len=10) :: lev_sequence -! -! lon_sequence is a string indicating ordering of the longitude -! coordinate lon, and of the field arrays along this dimension. -! lon_sequece can have 1 of 2 values: -! -! '-180to180' means lon(1) is -180 deg west longitude, lon(nlon) is +180 east -! 'zeroto360' means lon(1) is 0 deg west longitude, lon(nlon) is 360 deg east -! -! Note that TIMEGCM convention is '-180to180' and WACCM convention is 'zeroto360' -! (this is treating similarly to lev_sequence above) -! - character(len=9) :: lon_sequence + + ! set_geogrid sets up a distributed finite-volume lat/lon grid + public :: set_geogrid + + logical :: debug = .false. ! set true for prints to stdout at each call + +contains + + !----------------------------------------------------------------------- + subroutine set_geogrid(nlon_g, nlat_g, nlev_in, npes_in, iam, pres_mid_in, pres_edge_in, min_lat_pe_in) + use shr_const_mod, only: pi => shr_const_pi + use edyn_params, only: kbotdyn, pbotdyn + use edyn_mpi, only: mp_distribute_geo + use spmd_utils, only: masterproc + use edyn_maggrid, only: nmlat + + ! Dummy Args + integer, intent(in) :: nlon_g ! Global num longitudes + integer, intent(in) :: nlat_g ! Global num latitudes + integer, intent(in) :: nlev_in ! Num levels + integer, intent(in) :: npes_in + integer, intent(in) :: iam + real(r8), intent(in) :: pres_mid_in(:) + real(r8), intent(in) :: pres_edge_in(:) + integer, optional, intent(in) :: min_lat_pe_in ! Min # lats / PE + ! + ! Local: + integer :: latind, lonind, js, k + integer :: lon_beg, lon_end, lat_beg, lat_end + integer :: lons_per_task, lats_per_task + integer :: lons_overflow, lats_overflow + integer :: ntasks_lat, ntasks_lon + integer :: task_cnt, i,j + integer :: minlats_per_pe + integer :: ierr + real(r8) :: phi + real(r8) :: delta ! Coordinate spacing + real(r8), parameter :: eps = 1.e-6_r8 + + real(r8) :: pmid(nlev_in) + + nlon = nlon_g + nlat = nlat_g + nlev = nlev_in + npes = npes_in + + nilev = nlev+1 + + nlonp1 = nlon + 1 + nlonp2 = nlon + 2 + nlatp1 = nlat + 1 + + jspole = 1 + jnpole = nlat + + if (present(min_lat_pe_in)) then + minlats_per_pe = min_lat_pe_in + else + minlats_per_pe = 2 + end if + + dphi = pi / real(nlat,r8) + dlamda = 2._r8*pi / real(nlon,r8) + + ! + ! Allocate coordinate variables: + ! + allocate(glon(nlon)) + allocate(glat(nlat)) + ! + ! Create a finite-volume coordinate grid (in degrees) + ! + delta = 360.0_r8 / real(nlon, r8) + do lonind = 1, nlon + glon(lonind) = -180.0_r8 + ((lonind - 1) * delta) + end do + delta = 180.0_r8 / real((nlat - 1), r8) + ! Set the poles exactly (they might be checked later) + glat(1) = -90.0_r8 + glat(nlat) = 90.0_r8 + do latind = 2, nlat - 1 + glat(latind) = -90.0_r8 + ((latind - 1) * delta) + end do + + if (masterproc.and.debug) then + write(iulog,*) 'set_geogrid glon : ',glon(:) + write(iulog,*) 'set_geogrid glat : ',glat(:) + end if + + allocate(zlev(nlev)) + allocate(zilev(nilev)) + ! + ! Hybrid-sigma levels from ref_pres module: + ! + zlev(:nlev) = pres_mid_in(:) ! midpoints vertical coord (top down) + zilev(:nilev) = pres_edge_in(:nilev) ! interfaces vertical coord + + ! do bottom up search for kbotdyn + pmid(:nlev) = zlev(nlev:1:-1) + kloop: do k = 1, nlev + if ( pmid(k) <= pbotdyn) then + kbotdyn = k + exit kloop + end if + end do kloop + if ( kbotdyn < 1 ) then + call endrun('set_geogrid: kbotdyn is not set') + endif + if (debug) then + write(iulog,"('set_geogrid: kbotdyn=',i4,' pmid(kbotdyn)=',es12.4)") kbotdyn,pmid(kbotdyn) + endif + + ! + ! Setup a decomposition for the geogrid + ! + ! First, try using a 1-D latitude decomposition + + do ntasks_lon = 1,nlon_g + ntasks_lat = npes/ntasks_lon + if ( minlats_per_pe*ntasks_latiam) exit jloop + end do + enddo jloop + endif + + call mp_distribute_geo(lon_beg, lon_end, lat_beg, lat_end, 1, nlev, ntasks_lon, ntasks_lat) + + ! + ! Set horizontal geographic grid in radians (for apex code): + ! + allocate(ylatg(nlat)) ! waccm grid includes poles + allocate(ylong(nlonp1)) ! single periodic point + ylatg(1) = -pi/2._r8+eps ! south pole + ylatg(nlat) = pi/2._r8-eps ! north pole + do latind = 2, nlat-1 + ylatg(latind) = -0.5_r8*(pi-dphi)+real(latind-1,r8)*dphi + end do + do lonind = 1, nlonp1 + ylong(lonind) = -pi+real(lonind-1,r8)*dlamda + end do + ! + ! Calculate cosine of latitude + ! + allocate(cs(0:nlat+1)) + js = -(nlat/2) + do latind = 1, nlat + phi = (latind + js - .5_r8) * dphi + cs(latind) = cos(phi) + end do + cs(0) = -cs(1) + cs(nlat+1) = -cs(nlat) + + end subroutine set_geogrid end module edyn_geogrid diff --git a/src/ionosphere/waccmx/edyn_init.F90 b/src/ionosphere/waccmx/edyn_init.F90 index e2a1b22b9c..84750fbd59 100644 --- a/src/ionosphere/waccmx/edyn_init.F90 +++ b/src/ionosphere/waccmx/edyn_init.F90 @@ -1,398 +1,257 @@ - module edyn_init +module edyn_init ! -! Initialize edynamo +! Initialize edynamo ! - use shr_kind_mod ,only: r8 => shr_kind_r8 ! 8-byte reals - use shr_const_mod, only: pi => shr_const_pi - use cam_logfile ,only: iulog - use cam_abortutils ,only: endrun - use spmd_utils, only: masterproc - use infnan, only: nan, assignment(=) + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + use edynamo, only: alloc_edyn, debug_hist - use edyn_geogrid ,only: nlon,nlat,nlev,nilev,glon,glat,zlev,zilev,& - nlonp1,nlonp2,nlatp1,jspole,jnpole,dlatg,dlong,& - ylatg,ylong,dphi,dlamda,cs,expz,zp - use edyn_params ,only: kbotdyn, pbotdyn + implicit none - implicit none + private + public :: edynamo_init - private - public :: edynamo_init, lonshift_global +contains +!----------------------------------------------------------------------- + subroutine edynamo_init(mpicomm,ionos_debug_hist) + + ! + ! One-time initialization, called from ionosphere_init + ! before dyn_init and phys_init + ! + 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_phys_grid, only: edyn_phys_grid_init + use edyn_solve, only: edyn_solve_init + + ! + ! Args: + integer, intent(in) :: mpicomm + logical, intent(in) :: ionos_debug_hist + + debug_hist = ionos_debug_hist + + if (masterproc) then + write(iulog,"('Enter edynamo_init:')") + endif - logical :: debug=.false. ! set true for prints to stdout at each call + call set_maggrid () ! set parameter-based global magnetic grid - contains -!----------------------------------------------------------------------- - subroutine edynamo_init(mpicomm, nlon_in,nlat_in,nlev_in, lonndx0,lonndx1,latndx0,latndx1,levndx0,levndx1, ntaski,ntaskj, & - glon_in, glat_in, pres_in, pres_edge_in ) -! -! One-time initialization, called from inital.F90 after dyn_init and initcom. -! - use edyn_maggrid ,only: set_maggrid - use edyn_mpi ,only: mp_init,mp_distribute_geo,mp_distribute_mag,& - mp_exchange_tasks -#ifdef WACCMX_EDYN_ESMF - use edynamo ,only: alloc_edyn - use edyn_esmf ,only: edyn_esmf_init ! initialize ESMF -#endif -! -! Args: - integer, intent(in) :: mpicomm - integer, intent(in) :: nlon_in,nlat_in,nlev_in - integer, intent(in) :: lonndx0,lonndx1,latndx0,latndx1,levndx0,levndx1, ntaski,ntaskj - real(r8),intent(in) :: glon_in(:), glat_in(:) - real(r8),intent(in) :: pres_in(:), pres_edge_in(:) - - if (masterproc) then - write(iulog,"('Enter edynamo_init:')") - endif - - call mp_init(mpicomm) ! get ntask,mytid - call set_geogrid(nlon_in,nlat_in,nlev_in, glon_in, glat_in, pres_in, pres_edge_in) ! set global geographic grid - call set_maggrid () ! set parameter-based global magnetic grid - - call mp_distribute_geo(lonndx0,lonndx1,latndx0,latndx1,levndx0,levndx1, ntaski,ntaskj) - call mp_distribute_mag - call register_maggrid - call mp_exchange_tasks(0) ! single arg is iprint - -#ifdef WACCMX_EDYN_ESMF - call alloc_edyn ! allocate dynamo arrays - call edyn_esmf_init(mpicomm) ! initialize ESMF -#endif - - call add_fields ! add fields to WACCM history master list - - end subroutine edynamo_init -!----------------------------------------------------------------------- - subroutine set_geogrid( nlon_in,nlat_in,nlev_in, glon_in, glat_in, pres_in, pres_edge_in ) + call edyn_solve_init - ! Args - integer, intent(in) :: nlon_in,nlat_in,nlev_in - real(r8),intent(in) :: glon_in(:), glat_in(:) - real(r8),intent(in) :: pres_in(:), pres_edge_in(:) -! -! Local: - integer :: i,j,js, k - real(r8) :: real8,phi - real(r8),parameter :: eps = 1.e-6_r8 + call mp_distribute_mag(nmlonp1, nmlat, nmlath, nmlev) - real(r8) :: pmid(nlev_in) + call register_grids() + call mp_exchange_tasks(mpicomm, 0, gmlat) ! single arg is iprint - nlon = nlon_in - nlat = nlat_in - nlev = nlev_in + call alloc_edyn() ! allocate dynamo arrays - nilev = nlev+1 + call edyn_phys_grid_init() - nlonp1 = nlon+1 - nlonp2 = nlon+2 - nlatp1 = nlat+1 + call add_fields() ! add fields to WACCM history master list - jspole = 1 - jnpole = nlat + end subroutine edynamo_init - dphi = pi/dble(nlat) - dlamda = 2._r8*pi/dble(nlon) + !----------------------------------------------------------------------- + subroutine add_fields + use cam_history, only: addfld, horiz_only, add_default + use phys_control, only: phys_getopts !Method used to get flag for waccmx ionosphere output variables -! -! Allocate coordinate variables: -! - allocate(glon(nlon)) - glon(:nlon) = glon_in(:nlon) + logical :: history_waccmx - allocate(glat(nlat)) - glat(:nlat) = glat_in(:nlat) + call addfld ('PED_MAG' ,(/ 'lev' /), 'I', 'S/m ','Pedersen Conductivity' ,gridname='gmag_grid') + call addfld ('HAL_MAG' ,(/ 'lev' /), 'I', 'S/m ','Hall Conductivity' ,gridname='gmag_grid') + call addfld ('PHIHM' , horiz_only, 'I', 'VOLTS','High Latitude Electric Potential' ,gridname='gmag_grid') + call addfld ('PHIM2D' , horiz_only, 'I', 'VOLTS','PHIM2D: Electric Potential' ,gridname='gmag_grid') + call addfld ('ED1' , horiz_only, 'I', 'V/m ','ED1: Eastward Electric Field' ,gridname='gmag_grid') + call addfld ('ED2' , horiz_only, 'I', 'V/m ','ED2: Equatorward Electric Field' ,gridname='gmag_grid') + call addfld ('PHIM3D' ,(/ 'lev' /), 'I', 'VOLTS','PHIM3D: 3d Electric Potential' ,gridname='gmag_grid') + call addfld ('ED13D' ,(/ 'lev' /), 'I', 'V/m ','ED13D: Eastward Electric Field' ,gridname='gmag_grid') + call addfld ('ED23D' ,(/ 'lev' /), 'I', 'V/m ','ED23D: Equatorward Electric Field',gridname='gmag_grid') + call addfld ('ZPOT_MAG' ,(/ 'lev' /), 'I', 'cm ','Geopotential on mag grid (h0 min)',gridname='gmag_grid') - allocate(zlev(nlev)) - allocate(zilev(nilev)) -! -! zp and expz are not set until oplus is called from dpie_coupling. - allocate(zp(nlev)) ! log pressure (as in TIEGCM) - allocate(expz(nlev)) ! exp(-zp) - zp = nan - expz = nan -! -! - call lonshift_global(glon,nlon,'-180to180',.true.) ! shift to +/-180 -! -! Hybrid-sigma levels from ref_pres module: -! - zlev(:nlev) = pres_in(:) ! midpoints vertical coord (top down) - zilev(:nilev) = pres_edge_in(:nilev) ! interfaces vertical coord - - ! do bottom up search for kbotdyn - pmid(:nlev) = zlev(nlev:1:-1) - kloop: do k=1,nlev - if ( pmid(k) <= pbotdyn) then - kbotdyn = k - exit kloop - end if - enddo kloop - if ( kbotdyn < 1 ) then - call endrun('set_geogrid: kbotdyn is not set') - endif - if (debug) then - write(iulog,"('set_geogrid: kbotdyn=',i4,' pmid(kbotdyn)=',es12.4)") kbotdyn,pmid(kbotdyn) - endif + call addfld ('HALL_CONDUCTANCE',horiz_only, 'I', 'S','Hall Conductance', gridname='gmag_grid') + call addfld ('PED_CONDUCTANCE', horiz_only, 'I', 'S','Pedersen Conductance',gridname='gmag_grid') -! -! Set horizontal geographic grid in radians (for apex code): -! - allocate(ylatg(nlat)) ! waccm grid includes poles - allocate(ylong(nlonp1)) ! single periodic point - real8 = dble(nlat) ; dlatg = pi/real8 - real8 = dble(nlon) ; dlong = 2._r8*pi/real8 - ylatg(1) = -pi/2._r8+eps ! south pole - ylatg(nlat) = pi/2._r8-eps ! north pole - do j=2,nlat-1 - real8 = dble(j-1) - ylatg(j) = -0.5_r8*(pi-dlatg)+real8*dlatg - enddo - do i=1,nlonp1 - real8 = dble(i-1) - ylong(i) = -pi+real8*dlong - enddo -! -! Calculate cosine of latitude -! - allocate(cs(0:nlat+1)) - js = -(nlat/2) - do j=1,nlat - phi = (j+js-.5_r8)*dphi - cs(j) = cos(phi) - enddo - cs(0) = -cs(1) - cs(nlat+1) = -cs(nlat) - - end subroutine set_geogrid -!----------------------------------------------------------------------- - subroutine lonshift_global(f,nlon,lonseq,iscoord) -! -! Shift longitude vector f(nlon) forward 180 degrees according to input -! string lonseq. Input f can be either arbitrary field values or -! the coordinate array itself. Shift f in the 'lonseq' manner, as follows: -! -! If lonseq='-180to180', then shift from 0->360 to -180->+180 -! If lonseq='zeroto360', then shift from -180->+180 to 0->360 -! -! WARNING: This routine works with WACCM-X history files, where nlon=144, 72, or 80 -! It has not been tested with other models or resolutions. -! (e.g., there is no test for center point, its assumed to be nlon/2) -! -! Args: - integer,intent(in) :: nlon - real(r8),intent(inout) :: f(nlon) - character(len=*),intent(in) :: lonseq - logical,intent(in) :: iscoord ! if true, f is a coordinate, otherwise it is data -! -! Local: - character(len=80) :: msg - integer :: ihalf,i - - if (lonseq /= '-180to180'.and.lonseq /= 'zeroto360') then - write(msg,"('shift_lon: bad lonseq=',a,' must be either ''-180to180'' or ''zeroto360''')") & - lonseq - call endrun - endif - - ihalf = nlon/2 - if (lonseq == '-180to180') then ! shift to -180 -> +180 - f = cshift(f,ihalf) ! cshift is circular shift intrinsic - if (iscoord) then - do i=1,ihalf - f(i) = f(i)-360._r8 - enddo - endif - else ! shift to 0 -> 360 - f = cshift(f,ihalf) ! cshift is circular shift intrinsic - if (iscoord) then - do i=ihalf+1,nlon - f(i) = f(i)+360._r8 - enddo + call addfld ('POTEN',(/ 'lev' /), 'I', 'Volts','POTEN: Electric Potential', gridname='geo_grid') + + call addfld ('EX',(/'lev'/),'I','V/m','Geographic zonal component of Electric Field', gridname='geo_grid') + call addfld ('EY',(/'lev'/),'I','V/m','Geographic meridional component of Electric Field', gridname='geo_grid') + call addfld ('EZ',(/'lev'/),'I','V/m','Vertical component of Electric Field', gridname='geo_grid') + + call addfld ('BMOD', horiz_only, 'I', 'gauss','magnitude of magnetic field',gridname='geo_grid') + call addfld ('XB', horiz_only, 'I', 'gauss','northward component of magnetic field',gridname='geo_grid') + call addfld ('YB', horiz_only, 'I', 'gauss','eastward component of magnetic field',gridname='geo_grid') + call addfld ('ZB', horiz_only, 'I', 'gauss','downward component of magnetic field',gridname='geo_grid') + + if (debug_hist) then + call addfld ('EPHI3D' ,(/ 'lev' /), 'I', ' ','EPHI3D' ,gridname='gmag_grid') + call addfld ('ELAM3D' ,(/ 'lev' /), 'I', ' ','ELAM3D' ,gridname='gmag_grid') + call addfld ('EMZ3D' ,(/ 'lev' /), 'I', ' ','EMZ3D' ,gridname='gmag_grid') + + call addfld ('ADOTV1_MAG',(/ 'lev' /), 'I', ' ','ADOTV1 on mag grid' ,gridname='gmag_grid') + call addfld ('ADOTV2_MAG',(/ 'lev' /), 'I', ' ','ADOTV2 on mag grid' ,gridname='gmag_grid') + call addfld ('adota1_mag_a', horiz_only, 'I', ' ','adota1_mag_a',gridname='gmag_grid') + call addfld ('ZIGM11_a', horiz_only, 'I', ' ','ZIGM11_a',gridname='gmag_grid') + call addfld ('EDYN_ZIGM11_0', horiz_only, 'I', ' ','EDYN_ZIGM11_0',gridname='gmag_grid') + call addfld ('EDYN_ZIGM11', horiz_only, 'I', ' ','EDYN_ZIGM11',gridname='gmag_grid') + call addfld ('EDYN_ZIGM22', horiz_only, 'I', ' ','EDYN_ZIGM22',gridname='gmag_grid') + call addfld ('EDYN_ZIGMC' , horiz_only, 'I', ' ','EDYN_ZIGMC' ,gridname='gmag_grid') + call addfld ('EDYN_ZIGM2' , horiz_only, 'I', ' ','EDYN_ZIGM2' ,gridname='gmag_grid') + call addfld ('EDYN_RIM1' , horiz_only, 'I', ' ','EDYN_RIM1' ,gridname='gmag_grid') + call addfld ('EDYN_RIM2' , horiz_only, 'I', ' ','EDYN_RIM2' ,gridname='gmag_grid') + + ! rjac: scaled derivatives of geomagnetic coords wrt geographic coordinates. + call addfld ('RJAC11',(/'lev'/), 'I', '1','cos(thetas)/cos(theta)*d(lamdas)/d(lamda)' ,gridname='geo_grid') + call addfld ('RJAC12',(/'lev'/), 'I', '1','cos(thetas)*d(lamdas)/d(theta)' ,gridname='geo_grid') + call addfld ('RJAC21',(/'lev'/), 'I', '1','1./cos(theta)*d(thetas)/d(lamda)' ,gridname='geo_grid') + call addfld ('RJAC22',(/'lev'/), 'I', '1','d(thetas)/d(theta)' ,gridname='geo_grid') endif - endif - end subroutine lonshift_global -!----------------------------------------------------------------------- - subroutine add_fields - use cam_history, only: addfld, horiz_only, add_default - use phys_control, only: phys_getopts !Method used to get flag for waccmx ionosphere output variables - - logical :: history_waccmx - -! Geomagnetic fields are in waccm format, in CGS units): - call addfld ('PED_MAG' ,(/ 'lev' /), 'I', 'S/m ','Pedersen Conductivity' ,gridname='gmag_grid') - call addfld ('HAL_MAG' ,(/ 'lev' /), 'I', 'S/m ','Hall Conductivity' ,gridname='gmag_grid') - call addfld ('ZMAG' ,(/ 'lev' /), 'I', 'cm ','ZMAG: Geopotential' ,gridname='gmag_grid') - call addfld ('PHIM2D' , horiz_only, 'I', 'VOLTS','PHIM2D: Electric Potential' ,gridname='gmag_grid') - call addfld ('ED1' , horiz_only, 'I', 'V/m ','ED1: Eastward Electric Field' ,gridname='gmag_grid') - call addfld ('ED2' , horiz_only, 'I', 'V/m ','ED2: Equatorward Electric Field' ,gridname='gmag_grid') - call addfld ('PHIM3D' ,(/ 'lev' /), 'I', 'VOLTS','PHIM3D: 3d Electric Potential' ,gridname='gmag_grid') - - call addfld ('EPHI3D' ,(/ 'lev' /), 'I', ' ','EPHI3D' ,gridname='gmag_grid') - call addfld ('ELAM3D' ,(/ 'lev' /), 'I', ' ','ELAM3D' ,gridname='gmag_grid') - call addfld ('EMZ3D' ,(/ 'lev' /), 'I', ' ','EMZ3D' ,gridname='gmag_grid') - - call addfld ('ED13D' ,(/ 'lev' /), 'I', 'V/m ','ED13D: Eastward Electric Field' ,gridname='gmag_grid') - call addfld ('ED23D' ,(/ 'lev' /), 'I', 'V/m ','ED23D: Equatorward Electric Field',gridname='gmag_grid') - call addfld ('ZPOT_MAG' ,(/ 'lev' /), 'I', 'cm ','Geopotential on mag grid (h0 min)',gridname='gmag_grid') - call addfld ('ADOTV1_MAG',(/ 'lev' /), 'I', ' ','ADOTV1 on mag grid' ,gridname='gmag_grid') - call addfld ('ADOTV2_MAG',(/ 'lev' /), 'I', ' ','ADOTV2 on mag grid' ,gridname='gmag_grid') -! - call addfld ('amie_phihm' , horiz_only, 'I','VOLTS','AMIE Electric Potential-mag grid' ,gridname='gmag_grid') - call addfld ('amie_efxm' , horiz_only, 'I','mW/m2','AMIE energy flux on mag grid' ,gridname='gmag_grid') - call addfld ('amie_kevm' , horiz_only, 'I','keV ','AMIE mean energy on mag grid' ,gridname='gmag_grid') - call addfld ('amie_efxg' , horiz_only, 'I','mW/m2','AMIE energy flux on geo grid' ,gridname='fv_centers') - call addfld ('amie_kevg' , horiz_only, 'I','keV ','AMIE mean energy on geo grid' ,gridname='fv_centers') + !------------------------------------------------------------------------------- + ! Set default values for ionosphere history variables + !------------------------------------------------------------------------------- + call phys_getopts(history_waccmx_out=history_waccmx) + + if (history_waccmx) then + call add_default ('PED_CONDUCTANCE', 1, ' ') + call add_default ('HALL_CONDUCTANCE' , 1, ' ') + end if + + end subroutine add_fields + !----------------------------------------------------------------------- + + subroutine register_grids() + + use cam_grid_support, only: horiz_coord_t, horiz_coord_create, iMap + use cam_grid_support, only: cam_grid_register + use edyn_mpi, only: mlat0, mlat1, mlon0, omlon1, ntask, mytid + use edyn_mpi, only: lat0, lat1, lon0, lon1 + use edyn_maggrid, only: gmlat, gmlon, nmlat, nmlon + use edyn_geogrid, only: glat, glon, nlat, nlon + + integer, parameter :: mag_decomp = 111 ! Must be unique within CAM + integer, parameter :: geo_decomp = 112 ! Must be unique within CAM + + type(horiz_coord_t), pointer :: lat_coord => null() + type(horiz_coord_t), pointer :: lon_coord => null() + integer(iMap), pointer :: grid_map(:,:) => null() + integer(iMap), pointer :: coord_map(:) => null() + integer :: i, j, ind + + if (mytid>=ntask) then + + if (mlon0/=1) then + call endrun('register_grids: mlon0 needs to be 1 on inactive PEs') + end if + if (omlon1/=0) then + call endrun('register_grids: omlon1 needs to be 0 on inactive PEs') + end if + if (mlat0/=1) then + call endrun('register_grids: mlat0 needs to be 1 on inactive PEs') + end if + if (mlat1/=0) then + call endrun('register_grids: mlat1 needs to be 0 on inactive PEs') + end if + + if (lon0/=1) then + call endrun('register_grids: lon0 needs to be 1 on inactive PEs') + end if + if (lon1/=0) then + call endrun('register_grids: lon1 needs to be 0 on inactive PEs') + end if + if (lat0/=1) then + call endrun('register_grids: lat0 needs to be 1 on inactive PEs') + end if + if (lat1/=0) then + call endrun('register_grids: lat1 needs to be 0 on inactive PEs') + end if -! -! Dynamo inputs from sub dynamo_input (edynamo.F90): - call addfld ('EDYN_TN ',(/ 'lev' /), 'I', 'deg K ','EDYN_TN' , gridname='fv_centers') - call addfld ('EDYN_UN ',(/ 'lev' /), 'I', 'cm/s ','EDYN_UN' , gridname='fv_centers') - call addfld ('EDYN_VN ',(/ 'lev' /), 'I', 'cm/s ','EDYN_VN' , gridname='fv_centers') - call addfld ('EDYN_OMG ',(/ 'lev' /), 'I', 's-1 ','EDYN_OMG' , gridname='fv_centers') - call addfld ('EDYN_Z ',(/ 'lev' /), 'I', 'cm ','EDYN_ZHT' , gridname='fv_centers') - call addfld ('EDYN_BARM ',(/ 'lev' /), 'I', ' ','EDYN_MBAR' , gridname='fv_centers') - call addfld ('EDYN_PED ',(/ 'lev' /), 'I', 'S/m ','EDYN_PED' , gridname='fv_centers') - call addfld ('EDYN_HALL ',(/ 'lev' /), 'I', 'S/m ','EDYN_HALL' , gridname='fv_centers') - -! call addfld ('EDYN_SCHT ',(/ 'lev' /), 'I', ' ','EDYN_SCHT ' , gridname='fv_centers') - call addfld ('EDYN_WN ',(/ 'lev' /), 'I', 'm/s ','EDYN_WN ' , gridname='fv_centers') - call addfld ('EDYN_ADOTV1 ',(/ 'lev' /), 'I', ' ','EDYN_ADOTV1' , gridname='fv_centers') - call addfld ('EDYN_ADOTV2 ',(/ 'lev' /), 'I', ' ','EDYN_ADOTV2' , gridname='fv_centers') -! -! 2d dynamo input fields on geo grid (edynamo.F90): - call addfld ('EDYN_SINI ', horiz_only , 'I', ' ','EDYN_SINI' , gridname='fv_centers') - call addfld ('EDYN_ADOTA1 ', horiz_only , 'I', ' ','EDYN_ADOTA1' , gridname='fv_centers') - call addfld ('EDYN_ADOTA2 ', horiz_only , 'I', ' ','EDYN_ADOTA2' , gridname='fv_centers') - call addfld ('EDYN_A1DTA2 ', horiz_only , 'I', ' ','EDYN_A1DTA2' , gridname='fv_centers') - call addfld ('EDYN_BE3 ', horiz_only , 'I', ' ','EDYN_BE3' , gridname='fv_centers') - - - call addfld ('ADOTA1', horiz_only , 'I', ' ','ADOTA1' , gridname='fv_centers') - call addfld ('ADOTA1_MAG', horiz_only , 'I', ' ','ADOTA1 in geo-mag coords' , gridname='fv_centers') - -! 3d ion drifts and 2d conductances at end of dpie_coupling -! (from either edynamo or time3d): -! -! call addfld ('TIME3D_ZIGM11',horiz_only,'I',' ','TIME3D_ZIGM11',gridname='gmag_grid) -! call addfld ('TIME3D_ZIGM22',horiz_only,'I',' ','TIME3D_ZIGM22',gridname='gmag_grid) -! call addfld ('TIME3D_ZIGMC' ,horiz_only,'I',' ','TIME3D_ZIGMC' ,gridname='gmag_grid) -! call addfld ('TIME3D_ZIGM2' ,horiz_only,'I',' ','TIME3D_ZIGM2' ,gridname='gmag_grid) -! call addfld ('TIME3D_RIM1' ,horiz_only,'I',' ','TIME3D_RIM1' ,gridname='gmag_grid) -! call addfld ('TIME3D_RIM2' ,horiz_only,'I',' ','TIME3D_RIM2' ,gridname='gmag_grid) - -! call addfld ('TIME3D_UI',(/ 'lev' /),'I',' ','TIME3D_UI') -! call addfld ('TIME3D_VI',(/ 'lev' /),'I',' ','TIME3D_VI') -! call addfld ('TIME3D_WI',(/ 'lev' /),'I',' ','TIME3D_WI') - -! call addfld ('T3D_OP_2WACCM',(/ 'lev' /),'I',' ','T3D_OP_2WACCM') -! call addfld ('DPIE_OP',(/ 'lev' /),'I',' ','DPIE_OP') ! this is also below - - call addfld ('QEP',(/ 'lev' /), 'I', 'm^3/s' ,'Photo-Electron Production', gridname='fv_centers') - call addfld ('QOP',(/ 'lev' /), 'I', 'm^3/s' ,'O+ Production Rate' , gridname='fv_centers') - call addfld ('OpO2',(/ 'lev' /), 'I', 'cm^3/s' ,'Op+O2 Loss Rate' , gridname='fv_centers') - call addfld ('OpN2',(/ 'lev' /), 'I', 'cm^3/s' ,'Op+N2 Loss Rate' , gridname='fv_centers') - call addfld ('LOP',(/ 'lev' /), 'I', 'cm^3/s' ,'O+ Loss Rate' , gridname='fv_centers') - call addfld ('SIGMA_PED' ,(/ 'lev' /), 'I', ' ','Pederson Conductivity' , gridname='fv_centers') - call addfld ('SIGMA_HALL',(/ 'lev' /), 'I', ' ','Hall Conductivity' , gridname='fv_centers') - - call addfld ('adota1_mag_a', horiz_only, 'I', ' ','EDYN_ZIGM11',gridname='gmag_grid') - call addfld ('ZIGM11_a', horiz_only, 'I', ' ','EDYN_ZIGM11',gridname='gmag_grid') - call addfld ('EDYN_ZIGM11_0', horiz_only, 'I', ' ','EDYN_ZIGM11',gridname='gmag_grid') - call addfld ('EDYN_ZIGM11', horiz_only, 'I', ' ','EDYN_ZIGM11',gridname='gmag_grid') - call addfld ('EDYN_ZIGM11_PED', horiz_only, 'I', 'S','Pedersen Conductance',gridname='gmag_grid') - call addfld ('EDYN_ZIGM22', horiz_only, 'I', ' ','EDYN_ZIGM22',gridname='gmag_grid') - call addfld ('EDYN_ZIGMC' , horiz_only, 'I', ' ','EDYN_ZIGMC' ,gridname='gmag_grid') - call addfld ('EDYN_ZIGM2' , horiz_only, 'I', ' ','EDYN_ZIGM2' ,gridname='gmag_grid') - call addfld ('EDYN_ZIGM2_HAL' , horiz_only, 'I', 'S','Hall Conductance' ,gridname='gmag_grid') - call addfld ('EDYN_RIM1' , horiz_only, 'I', ' ','EDYN_RIM1' ,gridname='gmag_grid') - call addfld ('EDYN_RIM2' , horiz_only, 'I', ' ','EDYN_RIM2' ,gridname='gmag_grid') - - call addfld ('EDYN_UI',(/ 'lev' /), 'I', 'cm/s','EDYN_UI', gridname='fv_centers') - call addfld ('EDYN_VI',(/ 'lev' /), 'I', 'cm/s','EDYN_VI', gridname='fv_centers') - call addfld ('EDYN_WI',(/ 'lev' /), 'I', 'cm/s','EDYN_WI', gridname='fv_centers') - - call addfld ('POTEN' ,(/ 'lev' /), 'I', 'Volts','POTEN: Electric Potential',& - gridname='fv_centers') - call addfld ('EX' ,(/ 'lev' /), 'I', 'V/m' ,'EX: Zonal component of Electric Field',& - gridname='fv_centers') - call addfld ('EY' ,(/ 'lev' /), 'I', 'V/m' ,'EY: Meridional component of Electric Field',& - gridname='fv_centers') - call addfld ('EZ' ,(/ 'lev' /), 'I', 'V/m' ,'EZ: Vertical component of Electric Field',& - gridname='fv_centers') - - call addfld ('ZEDYN360 ' ,(/ 'lev' /), 'I', 'm ','Geopotential 0 to 360 lon grid', gridname='fv_centers') - call addfld ('ZEDYN180 ',(/ 'lev' /), 'I', 'm ','Geopotential -180 to 180 lon grid', gridname='fv_centers') - - call addfld ('BMOD' , horiz_only, 'I', ' ',' ' ,gridname='fv_centers') - call addfld ('XB' , horiz_only, 'I', ' ',' ' ,gridname='fv_centers') - call addfld ('YB' , horiz_only, 'I', ' ',' ' ,gridname='fv_centers') - call addfld ('ZB' , horiz_only, 'I', ' ',' ' ,gridname='fv_centers') - - call addfld ('RJAC11' ,(/'lev'/), 'I', ' ',' ' ,gridname='fv_centers') - call addfld ('RJAC12' ,(/'lev'/), 'I', ' ',' ' ,gridname='fv_centers') - call addfld ('RJAC21' ,(/'lev'/), 'I', ' ',' ' ,gridname='fv_centers') - call addfld ('RJAC22' ,(/'lev'/), 'I', ' ',' ' ,gridname='fv_centers') - - !------------------------------------------------------------------------------- - ! Set default values for ionosphere history variables - !------------------------------------------------------------------------------- - call phys_getopts(history_waccmx_out=history_waccmx) - - if (history_waccmx) then - call add_default ('EDYN_ZIGM11_PED' , 1, ' ') - call add_default ('EDYN_ZIGM2_HAL' , 1, ' ') - end if - - end subroutine add_fields -!----------------------------------------------------------------------- + endif - subroutine register_maggrid - - use cam_grid_support, only: horiz_coord_t, horiz_coord_create, iMap, cam_grid_register - use edyn_mpi, only: mlat0,mlat1,mlon0,omlon1 - use edyn_maggrid, only: gmlat, gmlon, nmlat, nmlon - integer, parameter :: mag_decomp = 111 !arbitrary value - - type(horiz_coord_t), pointer :: lat_coord - type(horiz_coord_t), pointer :: lon_coord - integer(iMap), pointer :: grid_map(:,:) - integer(iMap), pointer :: coord_map(:) - integer :: i,j,ind - - allocate(grid_map(4, ((omlon1 - mlon0 + 1) * (mlat1 - mlat0 + 1)))) - ind = 0 - do i = mlat0, mlat1 - do j = mlon0, omlon1 - ind = ind + 1 - grid_map(1, ind) = j - grid_map(2, ind) = i - grid_map(3, ind) = j - grid_map(4, ind) = i - end do - end do - - allocate(coord_map(mlat1 - mlat0 + 1)) - coord_map = (/ (i, i = mlat0, mlat1) /) - lat_coord => horiz_coord_create('mlat', '', nmlat, 'latitude', & - 'degrees_north', mlat0, mlat1, gmlat(mlat0:mlat1), & - map=coord_map) - nullify(coord_map) - - allocate(coord_map(omlon1 - mlon0 + 1)) - coord_map = (/ (i, i = mlon0, omlon1) /) - lon_coord => horiz_coord_create('mlon', '', nmlon, 'longitude', & - 'degrees_east', mlon0, omlon1, gmlon(mlon0:omlon1), & - map=coord_map) - deallocate(coord_map) - nullify(coord_map) - - call cam_grid_register('gmag_grid', mag_decomp, lat_coord, lon_coord, & - grid_map, unstruct=.false.) - nullify(grid_map) - - end subroutine register_maggrid + allocate(grid_map(4, ((omlon1 - mlon0 + 1) * (mlat1 - mlat0 + 1)))) + ind = 0 + do i = mlat0, mlat1 + do j = mlon0, omlon1 + ind = ind + 1 + grid_map(1, ind) = j + grid_map(2, ind) = i + grid_map(3, ind) = j + grid_map(4, ind) = i + end do + end do + + allocate(coord_map(mlat1 - mlat0 + 1)) + if (mlon0==1) then + coord_map = (/ (i, i = mlat0, mlat1) /) + else + coord_map = 0 + end if + lat_coord => horiz_coord_create('mlat', '', nmlat, 'latitude', & + 'degrees_north', mlat0, mlat1, gmlat(mlat0:mlat1), & + map=coord_map) + nullify(coord_map) + + allocate(coord_map(omlon1 - mlon0 + 1)) + if (mlat0==1) then + coord_map = (/ (i, i = mlon0, omlon1) /) + else + coord_map = 0 + end if + lon_coord => horiz_coord_create('mlon', '', nmlon, 'longitude', & + 'degrees_east', mlon0, omlon1, gmlon(mlon0:omlon1), & + map=coord_map) + deallocate(coord_map) + nullify(coord_map) + + call cam_grid_register('gmag_grid', mag_decomp, lat_coord, lon_coord, & + grid_map, unstruct=.false.) + nullify(grid_map) + + + ! for the Oplus geo grid + allocate(grid_map(4, ((lon1 - lon0 + 1) * (lat1 - lat0 + 1)))) + ind = 0 + do i = lat0, lat1 + do j = lon0, lon1 + ind = ind + 1 + grid_map(1, ind) = j + grid_map(2, ind) = i + grid_map(3, ind) = j + grid_map(4, ind) = i + end do + end do + + allocate(coord_map(lat1 - lat0 + 1)) + if (lon0==1) then + coord_map = (/ (i, i = lat0, lat1) /) + else + coord_map = 0 + end if + lat_coord => horiz_coord_create('glat', '', nlat, 'latitude', & + 'degrees_north', lat0, lat1, glat(lat0:lat1), & + map=coord_map) + nullify(coord_map) + + allocate(coord_map(lon1 - lon0 + 1)) + if (lat0==1) then + coord_map = (/ (i, i = lon0, lon1) /) + else + coord_map = 0 + end if + + lon_coord => horiz_coord_create('glon', '', nlon, 'longitude', & + 'degrees_east', lon0, lon1, glon(lon0:lon1), & + map=coord_map) + deallocate(coord_map) + nullify(coord_map) + + call cam_grid_register('geo_grid', geo_decomp, lat_coord, lon_coord, & + grid_map, unstruct=.false.) + nullify(grid_map) + + end subroutine register_grids !----------------------------------------------------------------------- end module edyn_init diff --git a/src/ionosphere/waccmx/edyn_maggrid.F90 b/src/ionosphere/waccmx/edyn_maggrid.F90 index e5935ff4d5..c3d455c559 100644 --- a/src/ionosphere/waccmx/edyn_maggrid.F90 +++ b/src/ionosphere/waccmx/edyn_maggrid.F90 @@ -1,150 +1,182 @@ module edyn_maggrid - use shr_kind_mod, only : r8 => shr_kind_r8 ! 8-byte reals - use cam_logfile, only: iulog - implicit none - save - -! -! Global geomagnetic grid: -! - integer, parameter :: & - nmlat = 97, & ! number of mag latitudes - nmlath = (nmlat+1)/2, & ! index of magnetic equator - nmlon = 80, & ! number of mag longitudes - nmlonp1 = nmlon+1 ! number of longitudes plus periodic point -! -! Mag grid coordinates: -! - real(r8) :: & - ylatm(nmlat), & ! magnetic latitudes (radians) - ylonm(nmlonp1), & ! magnetic longitudes (radians) - gmlat(nmlat), & ! magnetic latitudes (degrees) - gmlon(nmlonp1), & ! magnetic longitudes (degrees) - dlonm,dlatm -! -! Level coordinates will be same as geographic levels: -! - integer :: nmlev ! number of levels (same as nlev in geographic) - - real(r8) :: & - rcos0s(nmlat), & ! cos(theta0)/cos(thetas) - dt0dts(nmlat), & ! d(theta0)/d(thetas) - dt1dts(nmlat) ! dt0dts/abs(sinim) (non-zero at equator) - - real(r8) :: table(91,2) - - logical :: debug=.false. ! set true for prints to stdout at each call - - contains -!----------------------------------------------------------------------- - subroutine set_maggrid - use edyn_params ,only: pi,pi_dyn,rtd,r0 - use edyn_geogrid,only: nlev -! -! Local: - integer :: i,j,n - real(r8) :: tanths2,dtheta,real8 - real(r8) :: & - tanth0(nmlat), & - tanths(nmlat), & - theta0(nmlat), & - hamh0(nmlat) - - real(r8),parameter :: & - e=1.e-6_r8, & - r1=1.06e7_r8, & - alfa=1.668_r8 - - real(r8) :: table2(91,3:5) - - real8 = dble(nmlat-1) - dlatm = pi_dyn/real8 - real8 = dble(nmlon) - dlonm = 2._r8*pi_dyn/real8 -! -! ylatm is equally spaced in theta0, but holds corresponding value of thetas. -! - do j=1,nmlat - real8 = dble(j-1) - theta0(j) = -pi_dyn/2._r8+real8*dlatm ! note use of pi_dyn - enddo ! j=1,nmlat - do j=2,nmlat-1 - tanth0(j) = abs(tan(theta0(j))) - hamh0(j) = r1*tanth0(j)+r0*tanth0(j)**(2._r8+2._r8*alfa)/ & - (1._r8+tanth0(j)**2)**alfa - tanths(j) = sqrt(hamh0(j)/r0) - ylatm(j) = sign(atan(tanths(j)),theta0(j)) - rcos0s(j) = sqrt((1._r8+tanths(j)**2)/(1._r8+tanth0(j)**2)) -! -! Timegcm has an alternate calculation for dt1dts and dt0dts if dynamo -! is not called. -! - tanths2 = tanths(j)**2 - dt1dts(j) = & - (r0*sqrt(1._r8+4._r8*tanths2)*(1._r8+tanths2))/ & - (r1*(1._r8+tanth0(j)**2)+2._r8*r0*tanth0(j)**(2._r8*alfa+1._r8)* & - (1._r8+alfa+tanth0(j)**2)/(1._r8+tanth0(j)**2)**alfa) - dt0dts(j) = dt1dts(j)*2._r8*tanths(j)/sqrt(1._r8+4._r8*tanths2) - enddo ! j=2,nmlat-1 -! -! Magnetic poles: -! - ylatm(1) = theta0(1) - ylatm(nmlat) = theta0(nmlat) - rcos0s(1) = 1._r8 - rcos0s(nmlat) = 1._r8 - dt0dts(1) = 1._r8 - dt0dts(nmlat) = 1._r8 -! -! Magnetic longitudes: -! - do i=1,nmlonp1 - real8 = dble(i-1) - ylonm(i) = -pi+real8*dlonm -! ylonm(i) = real8*dlonm - enddo ! i=1,nmlonp1 -! -! Define mag grid in degrees, and mag levels: -! - gmlat(:) = ylatm(:)*rtd - gmlon(:) = ylonm(:)*rtd -! -! Magnetic levels are same as midpoint geographic levels: -! - nmlev = nlev - -! -! Calculate table: -! - table(1,1) = 0._r8 - table(1,2) = 0._r8 - dtheta = pi/180._r8 - do i=2,91 - table(i,1) = table(i-1,1)+dtheta - enddo - do i=2,90 - table2(i,4) = tan(table(i,1)) - table(i,2) = table(i,1) - enddo ! i=2,90 - table(91,2) = table(91,1) - do n=1,7 + use shr_kind_mod, only : r8 => shr_kind_r8 ! 8-byte reals + use cam_logfile, only: iulog + use edyn_params, only: finit + + implicit none + + ! + ! Global geomagnetic grid: + ! + integer, protected :: & + nmlat, & ! number of mag latitudes + nmlath, & ! index of magnetic equator + nmlon, & ! number of mag longitudes + nmlonp1 ! number of longitudes plus periodic point + + ! + ! geomagnetic grid resolution parameters: + ! + integer, protected :: res_nlev + integer, protected :: res_ngrid + + ! + ! Mag grid coordinates: + ! + real(r8), allocatable, protected :: & + ylatm(:), & ! magnetic latitudes (radians) + ylonm(:), & ! magnetic longitudes (radians) + gmlat(:), & ! magnetic latitudes (degrees) + gmlon(:) ! magnetic longitudes (degrees) + real(r8), protected :: dlonm,dlatm + ! + ! Level coordinates will be same as geographic levels: + ! + integer, protected :: nmlev ! number of levels (same as nlev in geographic) + + real(r8), allocatable, protected :: & + rcos0s(:), & ! cos(theta0)/cos(thetas) + dt0dts(:), & ! d(theta0)/d(thetas) + dt1dts(:) ! dt0dts/abs(sinim) (non-zero at equator) + + + real(r8), protected :: table(91,2) = finit + + logical, private :: debug = .false. ! set true for prints to stdout at each call + + contains + + !----------------------------------------------------------------------- + subroutine alloc_maggrid( mag_nlon, mag_nlat, mag_nlev, mag_ngrid ) + + integer, intent(in) :: mag_nlon, mag_nlat, mag_nlev, mag_ngrid + + res_nlev = mag_nlev + res_ngrid = mag_ngrid + + nmlat = mag_nlat ! number of mag latitudes + nmlath = (nmlat+1)/2 ! index of magnetic equator + nmlon = mag_nlon ! number of mag longitudes + nmlonp1 = nmlon+1 ! number of longitudes plus periodic point + + allocate(ylatm(nmlat)) + allocate(ylonm(nmlonp1)) + allocate(gmlat(nmlat)) + allocate(gmlon(nmlonp1)) + allocate(rcos0s(nmlat)) + allocate(dt0dts(nmlat)) + allocate(dt1dts(nmlat)) + + end subroutine alloc_maggrid + + !----------------------------------------------------------------------- + subroutine set_maggrid() + use edyn_params, only: pi, pi_dyn, rtd, r0 + use edyn_mpi, only: nlev => nlev_geo + ! + ! Local: + integer :: i, j, n + real(r8) :: tanths2, dtheta, real8 + real(r8) :: tanth0(nmlat) + real(r8) :: tanths(nmlat) + real(r8) :: theta0(nmlat) + real(r8) :: hamh0(nmlat) + + real(r8), parameter :: e = 1.e-6_r8 + real(r8), parameter :: r1 = 1.06e7_r8 + real(r8), parameter :: alfa = 1.668_r8 + + real(r8) :: table2(91, 3:5) + + real8 = real(nmlat-1, r8) + dlatm = pi_dyn / real8 + real8 = real(nmlon, r8) + dlonm = 2._r8 * pi_dyn / real8 + ! + ! ylatm is equally spaced in theta0, but holds the corresponding + ! value of thetas. + ! + do j = 1, nmlat + real8 = real(j-1, r8) + theta0(j) = -pi_dyn/2._r8+real8*dlatm ! note use of pi_dyn + end do ! j=1,nmlat + do j=2,nmlat-1 + tanth0(j) = abs(tan(theta0(j))) + hamh0(j) = r1*tanth0(j)+r0*tanth0(j)**(2._r8+2._r8*alfa)/ & + (1._r8+tanth0(j)**2)**alfa + tanths(j) = sqrt(hamh0(j)/r0) + ylatm(j) = sign(atan(tanths(j)),theta0(j)) + rcos0s(j) = sqrt((1._r8+tanths(j)**2)/(1._r8+tanth0(j)**2)) + ! + ! Timegcm has an alternate calculation for dt1dts and dt0dts if dynamo + ! is not called. + ! + tanths2 = tanths(j)**2 + dt1dts(j) = & + (r0*sqrt(1._r8+4._r8*tanths2)*(1._r8+tanths2))/ & + (r1*(1._r8+tanth0(j)**2)+2._r8*r0*tanth0(j)**(2._r8*alfa+1._r8)* & + (1._r8+alfa+tanth0(j)**2)/(1._r8+tanth0(j)**2)**alfa) + dt0dts(j) = dt1dts(j)*2._r8*tanths(j)/sqrt(1._r8+4._r8*tanths2) + end do ! j=2,nmlat-1 + ! + ! Magnetic poles: + ! + ylatm(1) = theta0(1) + ylatm(nmlat) = theta0(nmlat) + rcos0s(1) = 1._r8 + rcos0s(nmlat) = 1._r8 + dt0dts(1) = 1._r8 + dt0dts(nmlat) = 1._r8 + ! + ! Magnetic longitudes: + ! + do i=1,nmlonp1 + real8 = real(i-1, r8) + ylonm(i) = -pi+real8*dlonm + ! ylonm(i) = real8*dlonm + end do ! i=1,nmlonp1 + ! + ! Define mag grid in degrees, and mag levels: + ! + gmlat(:) = ylatm(:)*rtd + gmlon(:) = ylonm(:)*rtd + ! + ! Magnetic levels are same as midpoint geographic levels: + ! + nmlev = nlev + + ! + ! Calculate table: + ! + table(1,1) = 0._r8 + table(1,2) = 0._r8 + dtheta = pi / 180._r8 + do i = 2, 91 + table(i,1) = table(i-1,1)+dtheta + end do do i=2,90 - table2(i,3) = table(i,2) - table(i,2) = tan(table2(i,3)) - table2(i,5) = sqrt(r1/r0*table(i,2)+table(i,2)**(2._r8*(1._r8+alfa))/ & - (1._r8+table(i,2)**2)**alfa) - table(i,2) = table2(i,3)-(table2(i,5)-table2(i,4))*2._r8* & - table2(i,5)/(r1/r0*(1._r8+table(i,2)**2)+2._r8*table(i,2)** & - (2._r8*alfa+1._r8)*(1._r8+alfa+table(i,2)**2)/ & - (1._r8+table(i,2)**2)**alfa) - enddo ! i=2,90 - enddo ! n=1,7 - - if (debug) then - write(iulog,"('set_maggrid: table= ',/,(6e12.4))") table - write(iulog,"('set_maggrid: table2=',/,(6e12.4))") table2 - endif - - end subroutine set_maggrid -!----------------------------------------------------------------------- + table2(i,4) = tan(table(i,1)) + table(i,2) = table(i,1) + end do ! i=2,90 + table(91,2) = table(91,1) + do n=1,7 + do i=2,90 + table2(i,3) = table(i,2) + table(i,2) = tan(table2(i,3)) + table2(i,5) = sqrt(r1/r0*table(i,2)+table(i,2)**(2._r8*(1._r8+alfa))/ & + (1._r8+table(i,2)**2)**alfa) + table(i,2) = table2(i,3)-(table2(i,5)-table2(i,4))*2._r8* & + table2(i,5)/(r1/r0*(1._r8+table(i,2)**2)+2._r8*table(i,2)** & + (2._r8*alfa+1._r8)*(1._r8+alfa+table(i,2)**2)/ & + (1._r8+table(i,2)**2)**alfa) + end do ! i=2,90 + end do ! n=1,7 + + if (debug) then + write(iulog,"('set_maggrid: table= ',/,(6e12.4))") table + write(iulog,"('set_maggrid: table2=',/,(6e12.4))") table2 + end if + + end subroutine set_maggrid + !----------------------------------------------------------------------- end module edyn_maggrid diff --git a/src/ionosphere/waccmx/edyn_mpi.F90 b/src/ionosphere/waccmx/edyn_mpi.F90 index 691b1051a6..c5eed873dd 100644 --- a/src/ionosphere/waccmx/edyn_mpi.F90 +++ b/src/ionosphere/waccmx/edyn_mpi.F90 @@ -1,2081 +1,2101 @@ module edyn_mpi - use shr_kind_mod ,only: r8 => shr_kind_r8 - use cam_logfile ,only: iulog - use cam_abortutils,only: endrun - - use edyn_geogrid ,only: nlon,nlat - use edyn_maggrid ,only: nmlonp1,nmlat,nmlath,nmlev ! note nmlev is not a parameter - use spmd_utils ,only: masterproc - use mpi ,only: mpi_comm_size, mpi_comm_rank, MPI_PROC_NULL, mpi_comm_split, & - MPI_INTEGER, MPI_STATUS_SIZE, mpi_wait, & - MPI_REAL8, MPI_SUCCESS, MPI_SUM, & - MPI_Comm_rank - - implicit none - private - - public :: array_ptr_type,switch_model_format,mp_geo_halos,mp_pole_halos,mlon0,mlon1,omlon1, & - mlat0,mlat1,mlev0,mlev1,mytid,lon0,lon1,lat0,lat1,lev0,lev1,mp_mag_halos,mp_scatter_phim, & - mp_mageq,mp_mageq_jpm1,mp_magpole_2d,mp_mag_foldhem,mp_mag_periodic_f2d,mp_gather_edyn, & - mp_mageq_jpm3,mp_mag_jslot,mp_magpoles,ixfind,mp_magpole_3d,ntask,ntaski,ntaskj,tasks, & - nmagtaski,nmagtaskj,setpoles, mp_gatherlons_f3d, mytidi, mp_scatterlons_f3d, mp_exchange_tasks, & - mp_distribute_mag, mp_distribute_geo, mp_init - - - -! -! Number of MPI tasks and current task id (geo or mag): -! - integer :: & - ntask, & ! number of mpi tasks - mytid ! my task id -! -! Geographic subdomains for current task: -! - integer :: & - ntaski, & ! number of tasks in lon dimension - ntaskj, & ! number of tasks in lat dimension - mytidi, & ! i coord for current task in task table - mytidj, & ! j coord for current task in task table - lat0,lat1, & ! first and last lats for each task - lon0,lon1, & ! first and last lons for each task - lev0,lev1, & ! first and last levs for each task (not distributed) - mxlon,mxlat ! max number of subdomain lon,lat points among all tasks -! -! Magnetic subdomains for current task: -! - integer :: & - nmagtaski, & ! number of tasks in mag lon dimension - nmagtaskj, & ! number of tasks in mag lat dimension - magtidi, & ! i coord for current task in task table - magtidj, & ! j coord for current task in task table - mlat0,mlat1, & ! first and last mag lats for each task - mlon0,mlon1, & ! first and last mag lons for each task - omlon1, & ! last mag lons for each task to remove periodic point from outputs - mlev0,mlev1, & ! first and last mag levs (not distributed) - mxmaglon, & ! max number of mag subdomain lon points among all tasks - mxmaglat ! max number of mag subdomain lat points among all tasks - - integer,allocatable,save :: & - itask_table_geo(:,:), & ! 2d table of tasks on geographic grid (i,j) - itask_table_mag(:,:) ! 2d table of tasks on mag grid (i,j) - - integer :: cols_comm ! communicators for each task column - integer :: rows_comm ! communicators for each task row -! -! Task type: subdomain information for all tasks, known by all tasks: -! - type task - integer :: mytid ! task id -! -! Geographic subdomains in task structure: - integer :: mytidi ! task coord in longitude dimension of task table - integer :: mytidj ! task coord in latitude dimension of task table - integer :: nlats ! number of latitudes calculated by this task - integer :: nlons ! number of longitudes calculated by this task - integer :: lat0,lat1 ! first and last latitude indices - integer :: lon0,lon1 ! first and last longitude indices -! -! Magnetic subdomains in task structure: - integer :: magtidi ! task coord in mag longitude dimension of task table - integer :: magtidj ! task coord in mag latitude dimension of task table - integer :: nmaglats ! number of mag latitudes calculated by this task - integer :: nmaglons ! number of mag longitudes calculated by this task - integer :: mlat0,mlat1 ! first and last latitude indices - integer :: mlon0,mlon1 ! first and last longitude indices - end type task -! -! type(task) :: tasks(ntask) will be made available to all tasks -! (so each task has information about all tasks) -! - type(task),allocatable,save :: tasks(:) -! -! Conjugate points in mag subdomains, for mp_mag_foldhem -! - integer,allocatable,dimension(:),save :: & ! (ntask) - nsend_south, & ! number of south lats to send to north (each task) - nrecv_north ! number of north lats to send to south (each task) - integer,allocatable,dimension(:,:),save :: & ! (mxlats,ntask) - send_south_coords, & ! south j lats to send to north - recv_north_coords ! north j lats to recv from south - - type array_ptr_type - real(r8),pointer :: ptr(:,:,:) ! (k,i,j) - end type array_ptr_type - - integer, protected :: mpi_comm_edyn = -9999 - - logical, parameter :: debug = .false. - - contains -!----------------------------------------------------------------------- - subroutine mp_init( mpi_comm ) -! -! Initialize MPI, and allocate task table. -! - integer, intent(in) :: mpi_comm - - integer :: ier - - mpi_comm_edyn = mpi_comm - - call mpi_comm_size(mpi_comm_edyn,ntask,ier) - call mpi_comm_rank(mpi_comm_edyn,mytid,ier) -! -! Allocate array of task structures: -! - allocate(tasks(0:ntask-1),stat=ier) - if (ier /= 0) then - write(iulog,"('>>> mp_init: error allocating tasks(',i3,')')") ntask - call endrun('edyn_mpi mp_init') - endif - end subroutine mp_init -!----------------------------------------------------------------------- - subroutine mp_distribute_geo(lonndx0,lonndx1,latndx0,latndx1,levndx0,levndx1, ntaski_in,ntaskj_in) -! -! Args: - integer, intent(in) :: lonndx0,lonndx1,latndx0,latndx1,levndx0,levndx1, ntaski_in,ntaskj_in -! -! Local: - integer :: i,j,n,irank,ier,tidrow,nj,ni -! -! Define all task structures with current task values -! (redundant for alltoall): -! Use WACCM subdomains: -! - lon0 = lonndx0 ; lon1 = lonndx1 - lat0 = latndx0 ; lat1 = latndx1 - lev0 = levndx0 ; lev1 = levndx1 - - ntaski = ntaski_in - ntaskj = ntaskj_in -! -! Allocate and set 2d table of tasks: -! - allocate(itask_table_geo(-1:ntaski,-1:ntaskj),stat=ier) - if (ier /= 0) then - write(iulog,"('>>> Error allocating itable: ntaski,j=',2i4)") ntaski,ntaskj - call endrun('itask_table_geo') - endif - itask_table_geo(:,:) = MPI_PROC_NULL - - irank = 0 - do j = 0,ntaskj-1 - do i = 0,ntaski-1 - itask_table_geo(i,j) = irank - if (mytid == irank) then - mytidi = i - mytidj = j - endif - irank = irank+1 - enddo -! -! Tasks are periodic in longitude: -! (this is not done in tiegcm, but here sub mp_geo_halos depends on it) -! - itask_table_geo(-1,j) = itask_table_geo(ntaski-1,j) - itask_table_geo(ntaski,j) = itask_table_geo(0,j) - - enddo ! j=0,ntaskj-1 - - if (debug.and.masterproc) then - write(iulog,"('mp_distribute_geo: mytid=',i4,' ntaski,j=',2i4,' mytidi,j=',2i4,& - ' lon0,1=',2i4,' lat0,1=',2i4,' lev0,1=',2i4)") & - mytid,ntaski,ntaskj,mytidi,mytidj,lon0,lon1,lat0,lat1,lev0,lev1 -! -! Print table to stdout, including -1,ntaski: -! - write(iulog,"(/,'ntask=',i3,' ntaski=',i2,' ntaskj=',i2,' Geo Task Table:')") & - ntask,ntaski,ntaskj - do j=-1,ntaskj - write(iulog,"('j=',i3,' itask_table_geo(:,j)=',100i3)") j,itask_table_geo(:,j) - enddo - endif -! -! Calculate start and end indices in lon,lat dimensions for each task: -! For WACCM: do not call distribute_1d - lon0,1, lat0,1 are set from -! waccm grid above. -! -! call distribute_1d(1,nlon,ntaski,mytidi,lon0,lon1) -! call distribute_1d(1,nlat,ntaskj,mytidj,lat0,lat1) + use shr_kind_mod, only: r8 => shr_kind_r8, cl=>shr_kind_cl + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + + use spmd_utils, only: masterproc + use mpi, only: mpi_comm_size, mpi_comm_rank, mpi_comm_split + use mpi, only: MPI_PROC_NULL, mpi_wait, MPI_STATUS_SIZE + use mpi, only: MPI_INTEGER, MPI_REAL8, MPI_SUCCESS, MPI_SUM + + implicit none + private + save + + ! Public data + public :: mlon0, mlon1 + public :: omlon1 + public :: mlat0, mlat1 + public :: mlev0, mlev1 + public :: mytid + public :: lon0, lon1 + public :: lat0, lat1 + public :: lev0, lev1 + public :: nlev_geo + public :: ntask + public :: ntaski + public :: ntaskj + public :: tasks + public :: nmagtaski + public :: nmagtaskj + public :: mytidi + ! Public type + public :: array_ptr_type + ! Public interfaces + public :: mp_init + public :: mp_geo_halos + public :: mp_pole_halos + public :: mp_mag_halos + public :: mp_scatter_phim + public :: mp_mageq + public :: mp_mageq_jpm1 + public :: mp_magpole_2d + public :: mp_mag_foldhem + public :: mp_mag_periodic_f2d + public :: mp_gather_edyn + public :: mp_mageq_jpm3 + public :: mp_mag_jslot + public :: mp_magpoles + public :: ixfind + public :: mp_magpole_3d + public :: setpoles + public :: mp_gatherlons_f3d + public :: mp_scatterlons_f3d + public :: mp_exchange_tasks + public :: mp_distribute_mag + public :: mp_distribute_geo + + ! + ! Number of MPI tasks and current task id (geo or mag): + ! + integer :: & + ntask, & ! number of mpi tasks + mytid ! my task id + ! + ! Geographic subdomains for current task: + ! + + integer, protected :: & + nlev_geo, & ! + lon0=1, lon1=0, & ! first and last lons for each task + lat0=1, lat1=0, & ! first and last lats for each task + lev0, lev1, & ! first and last levs for each task (not distributed) + ntaski, & ! number of tasks in lon dimension + ntaskj, & ! number of tasks in lat dimension + mytidi ! i coord for current task in task table + integer :: & + nlon_geo, & ! size of geo lon dimension + nlat_geo, & ! size of geo lat dimension + mxlon, & ! max number of subdomain lon points among all tasks + mxlat, & ! max number of subdomain lat points among all tasks + mytidj ! j coord for current task in task table + ! + ! Magnetic subdomains for current task: + ! + integer, protected :: & + nmagtaski, & ! number of tasks in mag lon dimension + nmagtaskj, & ! number of tasks in mag lat dimension + magtidi, & ! i coord for current task in task table + magtidj, & ! j coord for current task in task table + mlat0=1,mlat1=0, & ! first and last mag lats for each task + mlon0=1,mlon1=0, & ! first and last mag lons for each task + omlon1=0, & ! last mag lons for each task to remove periodic point from outputs + mlev0,mlev1 ! first and last mag levs (not distributed) + + integer :: & + mxmaglon, & ! max number of mag subdomain lon points among all tasks + mxmaglat ! max number of mag subdomain lat points among all tasks + + integer, allocatable :: & + itask_table_geo(:,:), & ! 2d table of tasks on geographic grid (i,j) + itask_table_mag(:,:) ! 2d table of tasks on mag grid (i,j) + + integer :: cols_comm ! communicators for each task column + integer :: rows_comm ! communicators for each task row + ! + ! Task type: subdomain information for all tasks, known by all tasks: + ! + type task + integer :: mytid ! task id + ! + ! Geographic subdomains in task structure: + integer :: mytidi = -1 ! task coord in longitude dimension of task table + integer :: mytidj = -1 ! task coord in latitude dimension of task table + integer :: nlats = 0 ! number of latitudes calculated by this task + integer :: nlons = 0 ! number of longitudes calculated by this task + integer :: lat0 = 1, lat1 = 0 ! first and last latitude indices + integer :: lon0 = 1, lon1 = 0 ! first and last longitude indices + ! + ! Magnetic subdomains in task structure: + integer :: magtidi = -1 ! task coord in mag longitude dimension of task table + integer :: magtidj = -1 ! task coord in mag latitude dimension of task table + integer :: nmaglats = 0 ! number of mag latitudes calculated by this task + integer :: nmaglons = 0 ! number of mag longitudes calculated by this task + integer :: mlat0 = 1,mlat1 = 0 ! first and last latitude indices + integer :: mlon0 = 1,mlon1 = 0 ! first and last longitude indices + end type task + ! + ! type(task) :: tasks(ntask) will be made available to all tasks + ! (so each task has information about all tasks) + ! + type(task), allocatable :: tasks(:) + ! + ! Conjugate points in mag subdomains, for mp_mag_foldhem + ! + integer,allocatable,dimension(:) :: & ! (ntask) + nsend_south, & ! number of south lats to send to north (each task) + nrecv_north ! number of north lats to send to south (each task) + integer,allocatable,dimension(:,:) :: & ! (mxlats,ntask) + send_south_coords, & ! south j lats to send to north + recv_north_coords ! north j lats to recv from south + + ! + ! Magnetic grid parameters + ! + integer :: nmlat ! number of mag latitudes + integer :: nmlath ! index of magnetic equator + integer :: nmlonp1 ! number of longitudes plus periodic point + integer :: nmlev ! number of levels (= nlev in geo grid) + + type array_ptr_type + real(r8),pointer :: ptr(:,:,:) ! (k,i,j) + end type array_ptr_type + + integer, protected :: mpi_comm_edyn = -9999 + + logical, parameter :: debug = .false. + +contains + !----------------------------------------------------------------------- + subroutine mp_init(mpi_comm, ionos_npes, nlon_geo_in, nlat_geo_in, nlev_geo_in) + ! + ! Initialize MPI, and allocate task table. + ! + integer, intent(in) :: mpi_comm + integer, intent(in) :: ionos_npes + integer, intent(in) :: nlon_geo_in + integer, intent(in) :: nlat_geo_in + integer, intent(in) :: nlev_geo_in + + integer :: ierr + integer :: color, npes + character(len=cl) :: errmsg + + nlon_geo = nlon_geo_in + nlat_geo = nlat_geo_in + nlev_geo = nlev_geo_in + ntask = ionos_npes + + call mpi_comm_size(mpi_comm, npes, ierr) + call mpi_comm_rank(mpi_comm, mytid, ierr) + color = mytid/ionos_npes + call mpi_comm_split(mpi_comm, color, mytid, mpi_comm_edyn, ierr) + + ! + ! Allocate array of task structures: + ! + allocate(tasks(0:npes-1), stat=ierr) + if (ierr /= 0) then + write(errmsg,"('>>> mp_init: error allocating tasks(',i3,')')") ntask + write(iulog,*) trim(errmsg) + call endrun(errmsg) + endif + end subroutine mp_init + !----------------------------------------------------------------------- + subroutine mp_distribute_geo(lonndx0, lonndx1, latndx0, latndx1, levndx0, levndx1, ntaski_in, ntaskj_in) + ! + ! Args: + integer, intent(in) :: lonndx0 + integer, intent(in) :: lonndx1 + integer, intent(in) :: latndx0 + integer, intent(in) :: latndx1 + integer, intent(in) :: levndx0 + integer, intent(in) :: levndx1 + integer, intent(in) :: ntaski_in + integer, intent(in) :: ntaskj_in + ! + ! Local: + integer :: i, j, n, irank, ier, tidrow, nj, ni + + ! + ! Define all task structures with current task values + ! (redundant for alltoall): + ! Use WACCM subdomains: + ! + lon0 = lonndx0 ; lon1 = lonndx1 + lat0 = latndx0 ; lat1 = latndx1 + lev0 = levndx0 ; lev1 = levndx1 + + ntaski = ntaski_in + ntaskj = ntaskj_in + ! + ! Allocate and set 2d table of tasks: + ! + allocate(itask_table_geo(-1:ntaski,-1:ntaskj),stat=ier) + if (ier /= 0) then + write(iulog,"('>>> Error allocating itable: ntaski,j=',2i4)") ntaski,ntaskj + call endrun('itask_table_geo') + endif + itask_table_geo(:,:) = MPI_PROC_NULL + + irank = 0 + mytidi = -1 + mytidj = -1 + do j = 0, ntaskj-1 + do i = 0, ntaski-1 + itask_table_geo(i,j) = irank + if (mytid == irank) then + mytidi = i + mytidj = j + end if + irank = irank+1 + end do + ! + ! Tasks are periodic in longitude: + ! (this is not done in tiegcm, but here sub mp_geo_halos depends on it) + ! + itask_table_geo(-1,j) = itask_table_geo(ntaski-1,j) + itask_table_geo(ntaski,j) = itask_table_geo(0,j) + + end do ! j=0,ntaskj-1 + + if (debug ) then + write(6,"('mp_distribute_geo: mytid=',i4,' ntaski,j=',2i4,' mytidi,j=',2i4,& + ' lon0,1=',2i4,' lat0,1=',2i4,' lev0,1=',2i4)") & + mytid,ntaski,ntaskj,mytidi,mytidj,lon0,lon1,lat0,lat1,lev0,lev1 + ! + ! Print table to stdout, including -1,ntaski: + ! + write(6,"(/,'ntask=',i3,' ntaski=',i2,' ntaskj=',i2,' Geo Task Table:')") & + ntask,ntaski,ntaskj + do j=-1,ntaskj + write(iulog,"('j=',i3,' itask_table_geo(:,j)=',100i3)") j,itask_table_geo(:,j) + enddo + endif + ! + ! Calculate start and end indices in lon,lat dimensions for each task: + ! For WACCM: do not call distribute_1d - lon0,1, lat0,1 are set from + ! waccm grid above. + ! + ! call distribute_1d(1,nlon,ntaski,mytidi,lon0,lon1) + ! call distribute_1d(1,nlat,ntaskj,mytidj,lat0,lat1) nj = lat1-lat0+1 ! number of latitudes for this task ni = lon1-lon0+1 ! number of longitudes for this task -! -! Report my stats to stdout: -! write(iulog,"(/,'mytid=',i3,' mytidi,j=',2i3,' lat0,1=',2i3,' (',i2,') lon0,1=',2i3,' (',i2,') ncells=',i4)") & -! mytid,mytidi,mytidj,lat0,lat1,nj,lon0,lon1,ni -! -! Define all task structures with current task values -! (redundant for alltoall): -! - do n=0,ntask-1 - tasks(n)%mytid = mytid - tasks(n)%mytidi = mytidi - tasks(n)%mytidj = mytidj - tasks(n)%nlats = nj - tasks(n)%nlons = ni - tasks(n)%lat0 = lat0 - tasks(n)%lat1 = lat1 - tasks(n)%lon0 = lon0 - tasks(n)%lon1 = lon1 - enddo -! -! All tasks must have at least 4 longitudes: -! - do n=0,ntask-1 - - if (debug.and.masterproc) then - write(iulog,"('mp_distribute_geo: n=',i3,' tasks(n)%nlons=',i3,' tasks(n)%nlats=',i3)") & - n,tasks(n)%nlons,tasks(n)%nlats - endif - - if (tasks(n)%nlons < 4) then - write(iulog,"('>>> mp_distribute_geo: each task must carry at least 4 longitudes. task=',i4,' nlons=',i4)") & - n,tasks(n)%nlons - call endrun('edyn_mpi: nlons per task') + ! + ! Report my stats to stdout: + if (debug ) then + write(6,"(/,'mytid=',i3,' mytidi,j=',2i3,' lat0,1=',2i3,' (',i2,') lon0,1=',2i3,' (',i2,') ncells=',i4)") & + mytid,mytidi,mytidj,lat0,lat1,nj,lon0,lon1,ni endif - enddo -! -! Create sub-communicators for each task row (used by mp_geopole_3d): -! -! call mpi_comm_split(mpi_comm_edyn,mod(mytid,ntaskj),mytid,rows_comm,ier) -! call MPI_Comm_rank(rows_comm,tidrow,ier) - - call mpi_comm_split(mpi_comm_edyn,mytidj,mytid,rows_comm,ier) - call MPI_Comm_rank(rows_comm,tidrow,ier) - - if (debug.and.masterproc) then - write(iulog,"('mp_distribute_geo: ntaskj=',i3,' tidrow=',i3)") & - ntaskj,tidrow - endif - - end subroutine mp_distribute_geo -!----------------------------------------------------------------------- - subroutine mp_distribute_mag -! -! Local: - integer :: i,j,n,irank,ier,tidcol,nj,ni,ncells -! -! Number of tasks in mag lon,lat same as geo grid: -! Also true for WACCM processor distribution. -! - nmagtaski = ntaski - nmagtaskj = ntaskj -! -! Vertical dimension is not distributed: - mlev0 = 1 - mlev1 = nmlev -! -! Allocate and set 2d table of tasks: - allocate(itask_table_mag(-1:nmagtaski,-1:nmagtaskj),stat=ier) - if (ier /= 0) then - write(iulog,"('>>> Error allocating itable: nmagtaski,j=',2i3)") & - nmagtaski,nmagtaskj - call endrun('itask_table_mag') - endif - itask_table_mag(:,:) = MPI_PROC_NULL - irank = 0 - do j = 0,nmagtaskj-1 - do i = 0,nmagtaski-1 - itask_table_mag(i,j) = irank - if (mytid == irank) then - magtidi = i - magtidj = j - endif - irank = irank+1 - enddo -! -! Tasks are periodic in longitude: -! - itask_table_mag(-1,j) = itask_table_mag(nmagtaski-1,j) - itask_table_mag(nmagtaski,j) = itask_table_mag(0,j) - enddo - - if (debug.and.masterproc) then -! -! Print table to stdout: - write(iulog,"(/,'ntask=',i3,' nmagtaski=',i2,' nmagtaskj=',i2,' Mag Task Table:')") & - ntask,nmagtaski,nmagtaskj - do j=-1,nmagtaskj - write(iulog,"('j=',i3,' itask_table_mag(:,j)=',100i3)") j,itask_table_mag(:,j) + ! + ! Define all task structures with current task values + ! (redundant for alltoall): + ! + do n=0,ntask-1 + tasks(n)%mytid = mytid + tasks(n)%mytidi = mytidi + tasks(n)%mytidj = mytidj + tasks(n)%nlats = nj + tasks(n)%nlons = ni + tasks(n)%lat0 = lat0 + tasks(n)%lat1 = lat1 + tasks(n)%lon0 = lon0 + tasks(n)%lon1 = lon1 enddo - endif -! -! Calculate start and end indices in mag lon,lat dimensions for each task: -! - call distribute_1d(1,nmlonp1,nmagtaski,magtidi,mlon0,mlon1) - call distribute_1d(1,nmlat ,nmagtaskj,magtidj,mlat0,mlat1) - - omlon1=mlon1 - if (omlon1 == nmlonp1) omlon1=omlon1-1 - - nj = mlat1-mlat0+1 ! number of mag latitudes for this task - ni = mlon1-mlon0+1 ! number of mag longitudes for this task - ncells = nj*ni ! total number of grid cells for this task - - if (debug.and.masterproc) then -! -! Report my stats to stdout: - write(iulog,"(/,'mytid=',i3,' magtidi,j=',2i3,' mlat0,1=',2i3,' (',i2,') mlon0,1=',2i3,' (',i2,') ncells=',i4)") & - mytid,magtidi,magtidj,mlat0,mlat1,nj,mlon0,mlon1,ni,ncells - endif -! -! Define all task structures with current task values -! (redundant for alltoall): -! - do n=0,ntask-1 - tasks(n)%magtidi = magtidi - tasks(n)%magtidj = magtidj - tasks(n)%nmaglats = nj - tasks(n)%nmaglons = ni - tasks(n)%mlat0 = mlat0 - tasks(n)%mlat1 = mlat1 - tasks(n)%mlon0 = mlon0 - tasks(n)%mlon1 = mlon1 - enddo -! -! All tasks must have at least 4 longitudes: - do n=0,ntask-1 - if (tasks(n)%nmaglons < 4) then - write(iulog,"('>>> mp_distribute_mag: each task must carry at least 4 longitudes. task=',i4,' nmaglons=',i4)") & - n,tasks(n)%nmaglons - call endrun('edyn_mpi: nmaglons per task') + ! + ! All tasks must have at least 4 longitudes: + ! + if (mytid < ntask) then + do n=0,ntask-1 + + if (debug) then + write(6,"('mp_distribute_geo: n=',i3,' tasks(n)%nlons=',i3,' tasks(n)%nlats=',i3)") & + n,tasks(n)%nlons,tasks(n)%nlats + endif + + if (tasks(n)%nlons < 4) then + write(iulog,"('>>> mp_distribute_geo: each task must carry at least 4 longitudes. task=',i4,' nlons=',i4)") & + n,tasks(n)%nlons + call endrun('edyn_mpi: nlons per task') + endif + enddo endif - enddo -! -! Create subgroup communicators for each task column: -! These communicators will be used by sub mp_mag_jslot (mpi.F). -! - call mpi_comm_split(mpi_comm_edyn,mod(mytid,nmagtaski),mytid,cols_comm,ier) - call MPI_Comm_rank(cols_comm,tidcol,ier) - - if (debug.and.masterproc) then - write(iulog,"('mp_distribute_mag: nmagtaski=',i3,' mod(mytid,nmagtaski)=',i3,' tidcol=',i3)") & - nmagtaski,mod(mytid,nmagtaski),tidcol - endif - - end subroutine mp_distribute_mag -!----------------------------------------------------------------------- - subroutine distribute_1d(n1,n2,nprocs,myrank,istart,iend) -! -! Distribute work across a 1d vector(n1->n2) to nprocs. -! Return start and end indices for proc myrank. -! -! Args: - integer,intent(in) :: n1,n2,nprocs,myrank - integer,intent(out) :: istart,iend -! -! Local: - integer :: lenproc,iremain,n -! - n = n2-n1+1 - lenproc = n/nprocs - iremain = mod(n,nprocs) - istart = n1 + myrank*lenproc + min(myrank,iremain) - iend = istart+lenproc-1 - if (iremain > myrank) iend = iend+1 - end subroutine distribute_1d -!----------------------------------------------------------------------- - subroutine mp_exchange_tasks(iprint) -! -! Args: - integer,intent(in) :: iprint -! -! Local: -! itasks_send(len_task_type,ntask) will be used to send tasks(:) info -! to all tasks (directly passing mpi derived data types is reportedly -! not stable, or not available until MPI 2.x). -! - integer :: n,ier - integer,parameter :: len_task_type = 17 ! see type task above - integer,allocatable,save :: & - itasks_send(:,:), & ! send buffer - itasks_recv(:,:) ! send buffer -! -! Pack tasks(mytid) into itasks_send: - allocate(itasks_send(len_task_type,0:ntask-1),stat=ier) - if (ier /= 0) then - write(iulog,"(i4,i4)") '>>> Error allocating itasks_send: len_task_type=',& - len_task_type,' ntask=',ntask - endif - allocate(itasks_recv(len_task_type,0:ntask-1),stat=ier) - if (ier /= 0) then - write(iulog,"(i4,i4)") '>>> Error allocating itasks_recv: len_task_type=',& - len_task_type,' ntask=',ntask - endif - do n=0,ntask-1 - itasks_send(1,n) = tasks(mytid)%mytid - - itasks_send(2,n) = tasks(mytid)%mytidi - itasks_send(3,n) = tasks(mytid)%mytidj - itasks_send(4,n) = tasks(mytid)%nlats - itasks_send(5,n) = tasks(mytid)%nlons - itasks_send(6,n) = tasks(mytid)%lat0 - itasks_send(7,n) = tasks(mytid)%lat1 - itasks_send(8,n) = tasks(mytid)%lon0 - itasks_send(9,n) = tasks(mytid)%lon1 - - itasks_send(10,n) = tasks(mytid)%magtidi - itasks_send(11,n) = tasks(mytid)%magtidj - itasks_send(12,n) = tasks(mytid)%nmaglats - itasks_send(13,n) = tasks(mytid)%nmaglons - itasks_send(14,n) = tasks(mytid)%mlat0 - itasks_send(15,n) = tasks(mytid)%mlat1 - itasks_send(16,n) = tasks(mytid)%mlon0 - itasks_send(17,n) = tasks(mytid)%mlon1 - enddo -! -! Send itasks_send and receive itasks_recv: - call mpi_alltoall(itasks_send,len_task_type,MPI_INTEGER,& - itasks_recv,len_task_type,MPI_INTEGER,& - mpi_comm_edyn,ier) - if (ier /= 0) & - call handle_mpi_err(ier,'edyn_mpi: mpi_alltoall to send/recv itasks') -! -! Unpack itasks_recv into tasks(n) -! - do n=0,ntask-1 - tasks(n)%mytid = itasks_recv(1,n) - - tasks(n)%mytidi = itasks_recv(2,n) - tasks(n)%mytidj = itasks_recv(3,n) - tasks(n)%nlats = itasks_recv(4,n) - tasks(n)%nlons = itasks_recv(5,n) - tasks(n)%lat0 = itasks_recv(6,n) - tasks(n)%lat1 = itasks_recv(7,n) - tasks(n)%lon0 = itasks_recv(8,n) - tasks(n)%lon1 = itasks_recv(9,n) - - tasks(n)%magtidi = itasks_recv(10,n) - tasks(n)%magtidj = itasks_recv(11,n) - tasks(n)%nmaglats = itasks_recv(12,n) - tasks(n)%nmaglons = itasks_recv(13,n) - tasks(n)%mlat0 = itasks_recv(14,n) - tasks(n)%mlat1 = itasks_recv(15,n) - tasks(n)%mlon0 = itasks_recv(16,n) - tasks(n)%mlon1 = itasks_recv(17,n) -! -! Report to stdout: -! - if (n==mytid.and.iprint > 0) then - write(iulog,"(/,'Task ',i3,':')") n - write(iulog,"(/,'Subdomain on geographic grid:')") - write(iulog,"('tasks(',i3,')%mytid =',i3)") n,tasks(n)%mytid - write(iulog,"('tasks(',i3,')%mytidi=',i3)") n,tasks(n)%mytidi - write(iulog,"('tasks(',i3,')%mytidj=',i3)") n,tasks(n)%mytidj - write(iulog,"('tasks(',i3,')%nlats =',i3)") n,tasks(n)%nlats - write(iulog,"('tasks(',i3,')%nlons =',i3)") n,tasks(n)%nlons - write(iulog,"('tasks(',i3,')%lat0 =',i3)") n,tasks(n)%lat0 - write(iulog,"('tasks(',i3,')%lat1 =',i3)") n,tasks(n)%lat1 - write(iulog,"('tasks(',i3,')%lon0 =',i3)") n,tasks(n)%lon0 - write(iulog,"('tasks(',i3,')%lon1 =',i3)") n,tasks(n)%lon1 - write(iulog,"('Number of geo subdomain grid points = ',i6)") & - tasks(n)%nlons * tasks(n)%nlats - write(iulog,"(/,'Subdomain on geomagnetic grid:')") - write(iulog,"('tasks(',i3,')%magtidi=',i3)") n,tasks(n)%magtidi - write(iulog,"('tasks(',i3,')%magtidj=',i3)") n,tasks(n)%magtidj - write(iulog,"('tasks(',i3,')%nmaglats =',i3)") n,tasks(n)%nmaglats - write(iulog,"('tasks(',i3,')%nmaglons =',i3)") n,tasks(n)%nmaglons - write(iulog,"('tasks(',i3,')%mlat0 =',i3)") n,tasks(n)%mlat0 - write(iulog,"('tasks(',i3,')%mlat1 =',i3)") n,tasks(n)%mlat1 - write(iulog,"('tasks(',i3,')%mlon0 =',i3)") n,tasks(n)%mlon0 - write(iulog,"('tasks(',i3,')%mlon1 =',i3)") n,tasks(n)%mlon1 - write(iulog,"('Number of mag subdomain grid points = ',i6)") & - tasks(n)%nmaglons * tasks(n)%nmaglats + + ! + ! Create sub-communicators for each task row (used by mp_geopole_3d): + ! + ! call mpi_comm_split(mpi_comm_edyn,mod(mytid,ntaskj),mytid,rows_comm,ier) + ! call MPI_Comm_rank(rows_comm,tidrow,ier) + + call mpi_comm_split(mpi_comm_edyn,mytidj,mytid,rows_comm,ier) + call MPI_Comm_rank(rows_comm,tidrow,ier) + + if (debug.and.masterproc) then + write(iulog,"('mp_distribute_geo: ntaskj=',i3,' tidrow=',i3)") & + ntaskj,tidrow endif - enddo -! -! Release locally allocated space: - deallocate(itasks_send) - deallocate(itasks_recv) -! -! mxlon,mxlat are maximum number of lons,lats owned by all tasks: - mxlon = -9999 - do n=0,ntask-1 - if (tasks(n)%nlons > mxlon) mxlon = tasks(n)%nlons - enddo - mxlat = -9999 - do n=0,ntask-1 - if (tasks(n)%nlats > mxlat) mxlat = tasks(n)%nlats - enddo -! -! mxmaglon,mxmaglat are maximum number of mag lons,lats owned by all tasks: - mxmaglon = -9999 - do n=0,ntask-1 - if (tasks(n)%nmaglons > mxmaglon) mxmaglon = tasks(n)%nmaglons - enddo - mxmaglat = -9999 - do n=0,ntask-1 - if (tasks(n)%nmaglats > mxmaglat) mxmaglat = tasks(n)%nmaglats - enddo -! -! Find conjugate points for folding hemispheres: - call conjugate_points - - end subroutine mp_exchange_tasks -!----------------------------------------------------------------------- - subroutine mp_mageq(fin,fout,nf,mlon0,mlon1,mlat0,mlat1,nmlev) -! -! Each task needs values of conductivities and adotv1,2 fields at the -! at the mag equator for its longitude subdomain (and all levels), for -! the fieldline integrations. -! -! On input, fin is ped_mag, hal_mag, adotv1_mag, adotv2_mag -! on (i,j,k) magnetic subdomain. -! On output, fout(mlon0:mlon1,nmlev,nf) is ped_meq, hal_meq, adotv1_meq, -! adotv2_meq at mag equator at longitude subdomain and all levels. -! -! Args: - integer :: mlon0,mlon1,mlat0,mlat1,nmlev,nf - real(r8),intent(in) :: fin (mlon0:mlon1,mlat0:mlat1,nmlev,nf) - real(r8),intent(out) :: fout(mlon0:mlon1,nmlev,nf) -! -! Local: - real(r8) :: & ! mpi buffers - sndbuf(mxmaglon,nmlev,nf), & ! mxmaglon,nmlev,nf - rcvbuf(mxmaglon,nmlev,nf) ! mxmaglon,nmlev,nf - integer :: i,j,n,itask,ier,len,jlateq,ireqsend,ireqrecv - integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status - logical :: have_eq - - sndbuf = 0._r8 - rcvbuf = 0._r8 - len = mxmaglon*nmlev*nf -! -! If mag equator is in current subdomain, load it into sndbuf -! and send to other tasks in my task column (mytidi) -! - jlateq = (nmlat+1)/2 ! lat index of mag equator (49) - have_eq = .false. - do j=mlat0,mlat1 - if (j == jlateq) then ! load send buffer w/ data at equator - have_eq = .true. - do i=mlon0,mlon1 - sndbuf(i-mlon0+1,:,:) = fin(i,j,:,:) - enddo -! -! Send mag equator data to other tasks in my task column (mytidi): - do itask=0,ntask-1 - if (itask /= mytid.and.tasks(itask)%mytidi==mytidi) then - call mpi_isend(sndbuf,len,MPI_REAL8,itask,1, & - mpi_comm_edyn,ireqsend,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mageq isend') - call mpi_wait(ireqsend,irstat,ier) - endif ! another task in mytidi - enddo ! itask=0,ntask-1 - endif ! j==jlateq - enddo ! j=mlat0,mlat1 -! -! Receive by other tasks in the sending task's column: - fout = 0._r8 - if (.not.have_eq) then ! find task to receive from - do itask=0,ntask-1 - do j=tasks(itask)%mlat0,tasks(itask)%mlat1 - if (j == jlateq.and.tasks(itask)%mytidi==mytidi) then - call mpi_irecv(rcvbuf,len,MPI_REAL8,itask,1, & - mpi_comm_edyn,ireqrecv,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mageq irecv') - call mpi_wait(ireqrecv,irstat,ier) - do n=1,nf - do i=mlon0,mlon1 - fout(i,:,n) = rcvbuf(i-mlon0+1,:,n) - enddo - enddo - endif ! itask has mag eq and is in my column (sending task) - enddo ! scan itask latitudes - enddo ! task table search -! -! If I am the sending task, set fout to equator values of input array: - else - do n=1,nf - do i=mlon0,mlon1 - fout(i,:,n) = fin(i,jlateq,:,n) - enddo - enddo - endif ! I am receiving or sending task - end subroutine mp_mageq -!----------------------------------------------------------------------- - subroutine mp_mageq_jpm1(f,mlon0,mlon1,mlat0,mlat1,nmlonp1,feq_jpm1,nf) -! -! All tasks need data at mag latitudes equator-1, equator+1 at global -! longitudes. -! On input: f is 6 fields on mag subdomains: zigm11,zigm22,zigmc,zigm2,rim1,rim2 -! On output: feq_jpm1(nmlonp1,2,nf) -! -! Args: - integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nmlonp1,nf - real(r8),intent(in) :: f(mlon0:mlon1,mlat0:mlat1,nf) - real(r8),intent(out) :: feq_jpm1(nmlonp1,2,nf) ! eq-1,eq+1 -! -! Local: - integer :: j,ier,len,jlateq - real(r8) :: sndbuf(nmlonp1,2,nf) - - sndbuf = 0._r8 - feq_jpm1 = 0._r8 - len = nmlonp1*2*nf -! -! Load send buffer w/ eq +/- 1 for current subdomain -! (redundant to all tasks for alltoall) -! - jlateq = (nmlat+1)/2 - do j=mlat0,mlat1 - if (j == jlateq+1) then ! equator+1 - sndbuf(mlon0:mlon1,1,:) = f(mlon0:mlon1,j,:) - elseif (j == jlateq-1) then ! equator-1 - sndbuf(mlon0:mlon1,2,:) = f(mlon0:mlon1,j,:) - endif ! j==jlateq - enddo ! j=mlat0,mlat1 -! -! Do the exchange: -! - call mpi_allreduce( sndbuf(:,:,1:nf), feq_jpm1(:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) - if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_mageq_jpm1 call mpi_allreduce') - -! -! Periodic point: - feq_jpm1(nmlonp1,:,:) = feq_jpm1(1,:,:) - - end subroutine mp_mageq_jpm1 -!----------------------------------------------------------------------- - subroutine mp_mageq_jpm3(f,mlon0,mlon1,mlat0,mlat1,nmlonp1,feq_jpm3,nf) -! -! All tasks need global longitudes at mag latitudes equator, -! and equator +/- 1,2,3 -! On input: f is nf fields on mag subdomains -! On output: feq_jpm3(nmlonp1,-3:3,nf) has global lons at eq, eq +/- 1,2,3 -! 2nd dimension of feq_jpm3 (and send/recv buffers) is as follows: -! +3: eq+3 -! +2: eq+2 -! +1: eq+1 -! 0: eq -! -1: eq-1 -! -2: eq-2 -! -3: eq-3 -! -! Args: - integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nmlonp1,nf - real(r8),intent(in) :: f(mlon0:mlon1,mlat0:mlat1,nf) - real(r8),intent(out) :: feq_jpm3(nmlonp1,-3:3,nf) -! -! Local: - integer :: j,ier,len,jlateq - integer,parameter :: mxnf=6 - - real(r8) :: sndbuf(nmlonp1,-3:3,mxnf) - - if (nf > mxnf) then - write(iulog,"('>>> mp_mageq_jpm3: nf=',i4,' but cannot be called with greater than mxnf=',i4)") & - nf,mxnf - call endrun('mp_mageq_jpm3') - endif - - sndbuf = 0._r8 - feq_jpm3 = 0._r8 - len = nmlonp1*7*nf -! -! Load send buffer w/ eq +/- 3 for current subdomain -! - jlateq = (nmlat+1)/2 - do j=mlat0,mlat1 - if (j == jlateq-3) then ! equator-3 - sndbuf(mlon0:mlon1,-3,1:nf) = f(mlon0:mlon1,j,:) - elseif (j == jlateq-2) then ! equator-2 - sndbuf(mlon0:mlon1,-2,1:nf) = f(mlon0:mlon1,j,:) - elseif (j == jlateq-1) then ! equator-1 - sndbuf(mlon0:mlon1,-1,1:nf) = f(mlon0:mlon1,j,:) - elseif (j == jlateq) then ! equator - sndbuf(mlon0:mlon1,0,1:nf) = f(mlon0:mlon1,j,:) - elseif (j == jlateq+1) then ! equator+1 - sndbuf(mlon0:mlon1,1,1:nf) = f(mlon0:mlon1,j,:) - elseif (j == jlateq+2) then ! equator+2 - sndbuf(mlon0:mlon1,2,1:nf) = f(mlon0:mlon1,j,:) - elseif (j == jlateq+3) then ! equator+3 - sndbuf(mlon0:mlon1,3,1:nf) = f(mlon0:mlon1,j,:) - endif ! j==jlateq - enddo ! j=mlat0,mlat1 -! -! Do the exchange: -! - call mpi_allreduce( sndbuf(:,:,1:nf), feq_jpm3(:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) - if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_mageq_jpm3 call mpi_allreduce') - -! -! Periodic point: - feq_jpm3(nmlonp1,:,:) = feq_jpm3(1,:,:) - - end subroutine mp_mageq_jpm3 -!----------------------------------------------------------------------- - subroutine mp_magpole_2d(f,ilon0,ilon1,ilat0,ilat1, & - nglblon,jspole,jnpole,fpole_jpm2,nf) -! -! Return fpole_jpm2(nglblon,1->4,nf) as: -! 1: j = jspole+1 (spole+1) -! 2: j = jspole+2 (spole+2) -! 3: j = jnpole-1 (npole-1) -! 4: j = jnpole-2 (npole-2) -! This can be called with different number of fields nf, but cannot -! be called w/ > mxnf fields. -! -! Args: - integer,intent(in) :: ilon0,ilon1,ilat0,ilat1,nglblon,jspole,jnpole,nf - real(r8),intent(in) :: f(ilon0:ilon1,ilat0:ilat1,nf) - real(r8),intent(out) :: fpole_jpm2(nglblon,4,nf) -! -! Local: - integer :: j,ier,len - integer,parameter :: mxnf=6 - real(r8) :: sndbuf(nglblon,4,mxnf) - - if (nf > mxnf) then - write(iulog,"('>>> mp_magpole_2d: nf=',i4,' but cannot be called with greater than mxnf=',i4)") & - nf,mxnf - call endrun('mp_magpole_2d') - endif - - sndbuf = 0._r8 - fpole_jpm2 = 0._r8 - len = nglblon*4*nf -! -! Load send buffer with values at poles +/- 2 for current subdomain -! - do j=ilat0,ilat1 - if (j==jspole+1) then ! south pole +1 - sndbuf(ilon0:ilon1,1,1:nf) = f(ilon0:ilon1,j,:) - elseif (j==jspole+2) then ! south pole +2 - sndbuf(ilon0:ilon1,2,1:nf) = f(ilon0:ilon1,j,:) - elseif (j==jnpole-1) then ! north pole -1 - sndbuf(ilon0:ilon1,3,1:nf) = f(ilon0:ilon1,j,:) - elseif (j==jnpole-2) then ! north pole -2 - sndbuf(ilon0:ilon1,4,1:nf) = f(ilon0:ilon1,j,:) - endif - enddo - -! -! Do the exchange: -! - call mpi_allreduce( sndbuf(:,:,1:nf), fpole_jpm2(:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) - if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_magpole_2d call mpi_allreduce') - - end subroutine mp_magpole_2d -!----------------------------------------------------------------------- - subroutine mp_magpole_3d(f,ilon0,ilon1,ilat0,ilat1,nlev, nglblon,jspole,jnpole,fpole_jpm2,nf) -! -! Return fpole_jpm2(nglblon,1->4,nlev,nf) as: -! 1: j = jspole+1 (spole+1) -! 2: j = jspole+2 (spole+2) -! 3: j = jnpole-1 (npole-1) -! 4: j = jnpole-2 (npole-2) -! This can be called with different number of fields nf, but cannot -! be called w/ > mxnf fields. -! -! Args: - integer,intent(in) :: ilon0,ilon1,ilat0,ilat1,nglblon,& - jspole,jnpole,nf,nlev - real(r8),intent(in) :: f(ilon0:ilon1,ilat0:ilat1,nlev,nf) - real(r8),intent(out) :: fpole_jpm2(nglblon,4,nlev,nf) -! -! Local: - integer :: j,k,ier,len - integer,parameter :: mxnf=6 - real(r8) :: sndbuf(nglblon,4,nlev,mxnf) - - if (nf > mxnf) then - write(iulog,"('>>> mp_magpole_3d: nf=',i4,' but cannot be called with greater than mxnf=',i4)") & - nf,mxnf - call endrun('mp_magpole_3d') - endif - - sndbuf = 0._r8 - fpole_jpm2 = 0._r8 - len = nglblon*4*nlev*nf -! -! Load send buffer with values at poles +/- 2 for current subdomain -! - do j=ilat0,ilat1 - do k=1,nlev - if (j==jspole+1) then ! south pole +1 - sndbuf(ilon0:ilon1,1,k,1:nf) = f(ilon0:ilon1,j,k,:) - elseif (j==jspole+2) then ! south pole +2 - sndbuf(ilon0:ilon1,2,k,1:nf) = f(ilon0:ilon1,j,k,:) - elseif (j==jnpole-1) then ! north pole -1 - sndbuf(ilon0:ilon1,3,k,1:nf) = f(ilon0:ilon1,j,k,:) - elseif (j==jnpole-2) then ! north pole -2 - sndbuf(ilon0:ilon1,4,k,1:nf) = f(ilon0:ilon1,j,k,:) - endif - enddo - enddo - -! -! Do the exchange: -! - call mpi_allreduce( sndbuf(:,:,:,1:nf), fpole_jpm2(:,:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) - if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_magpole_3d call mpi_allreduce') - - end subroutine mp_magpole_3d -!----------------------------------------------------------------------- - subroutine mp_magpoles(f,ilon0,ilon1,ilat0,ilat1,nglblon, jspole,jnpole,fpoles,nf) -! -! Similiar to mp_magpole_2d, but returns global longitudes for -! j==1 and j==nmlat (not for poles +/- 2) -! Return fpoles(nglblon,2,nf) as: -! 1: j = jspole (spole) -! 2: j = jnpole (npole) -! This can be called with different number of fields nf, but cannot -! be called w/ > mxnf fields. -! -! Args: - integer,intent(in) :: ilon0,ilon1,ilat0,ilat1,nglblon, jspole,jnpole,nf - real(r8),intent(in) :: f(ilon0:ilon1,ilat0:ilat1,nf) - real(r8),intent(out) :: fpoles(nglblon,2,nf) -! -! Local: - integer :: j,ier,len - real(r8) :: sndbuf(nglblon,2,nf) - - sndbuf = 0._r8 - fpoles = 0._r8 - len = nglblon*2*nf -! -! Load send buffer with values at poles +/- 2 for current subdomain -! - do j=ilat0,ilat1 - if (j==jspole) then ! south pole - sndbuf(ilon0:ilon1,1,1:nf) = f(ilon0:ilon1,j,:) - elseif (j==jnpole) then ! npole pole - sndbuf(ilon0:ilon1,2,1:nf) = f(ilon0:ilon1,j,:) - endif - enddo - -! -! Do the exchange: -! - call mpi_allreduce( sndbuf(:,:,1:nf), fpoles(:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) - if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_magpoles call mpi_allreduce') - - end subroutine mp_magpoles -!----------------------------------------------------------------------- - integer function getpe(ix,jx) - integer,intent(in) :: ix,jx - integer :: it - - getpe = -1 - do it=0,ntask-1 - if ((tasks(it)%lon0 <= ix .and. tasks(it)%lon1 >= ix).and.& - (tasks(it)%lat0 <= jx .and. tasks(it)%lat1 >= jx)) then - getpe = it - exit + + end subroutine mp_distribute_geo + !----------------------------------------------------------------------- + subroutine mp_distribute_mag(nmlonp1_in, nmlat_in, nmlath_in, nmlev_in) + ! + ! Args: + integer, intent(in) :: nmlat_in ! number of mag latitudes + integer, intent(in) :: nmlath_in ! index of magnetic equator + integer, intent(in) :: nmlonp1_in ! number of longitudes plus periodic point + integer, intent(in) :: nmlev_in ! number of levels (= nlev in geo grid) + ! + ! Local: + integer :: i, j, n, irank, ier, tidcol, nj, ni, ncells + character(len=cl) :: errmsg + character(len=*), parameter :: subname = 'mp_distribute_mag' + ! + ! Number of tasks in mag lon,lat same as geo grid: + ! + nmagtaski = ntaski + nmagtaskj = ntaskj + ! + ! Store magetic grid parameters + nmlat = nmlat_in + nmlath = nmlath_in + nmlonp1 = nmlonp1_in + nmlev = nmlev_in + if (mytid>> Error allocating itable: nmagtaski = ', nmagtaski, & + ', j = ', nmagtaskj + if (masterproc) then + write(iulog, errmsg) + end if + call endrun(errmsg) + endif + itask_table_mag(:,:) = MPI_PROC_NULL + irank = 0 + do j = 0, nmagtaskj-1 + do i = 0, nmagtaski-1 + itask_table_mag(i,j) = irank + if (mytid == irank) then + magtidi = i + magtidj = j + endif + irank = irank + 1 + end do + ! + ! Tasks are periodic in longitude: + ! + itask_table_mag(-1,j) = itask_table_mag(nmagtaski-1,j) + itask_table_mag(nmagtaski,j) = itask_table_mag(0,j) + end do + + if (debug .and. masterproc) then + ! + ! Print table to stdout: + write(iulog,"(/,a,/a,i3,a,i2,a,i2,' Mag Task Table:')") subname, & + 'ntask=',ntask,' nmagtaski=',nmagtaski,' nmagtaskj=',nmagtaskj + do j = -1, nmagtaskj + write(iulog,"('j = ',i3,', itask_table_mag(:,j) = ',100i3)") & + j, itask_table_mag(:,j) + end do + end if + ! + ! Calculate start and end indices in mag lon,lat dimensions for each task: + ! + call distribute_1d(1, nmlonp1, nmagtaski, magtidi, mlon0, mlon1) + call distribute_1d(1, nmlat, nmagtaskj, magtidj, mlat0, mlat1) + + omlon1 = mlon1 + if (omlon1 == nmlonp1) then + omlon1 = omlon1-1 + end if + + nj = mlat1 - mlat0 + 1 ! number of mag latitudes for this task + ni = mlon1 - mlon0 + 1 ! number of mag longitudes for this task + ncells = nj * ni ! total number of grid cells for this task + + if (debug) then + ! + ! Report my stats to stdout: + write(6,"(/,a,i3,a,2i3,a,2i3,a,i2,2a,2i3,a,i2,a,i4)") & + 'mytid = ',mytid, ', magtidi,j = ', magtidi, magtidj, & + ', mlat0,1 = ', mlat0, mlat1, ' (', nj, ')', & + ', mlon0,1 = ', mlon0, mlon1, ' (', ni, ') ncells = ', ncells + end if + ! + ! Define all task structures with current task values + ! (redundant for alltoall): + ! + do n=0,ntask-1 + tasks(n)%magtidi = magtidi + tasks(n)%magtidj = magtidj + tasks(n)%nmaglats = nj + tasks(n)%nmaglons = ni + tasks(n)%mlat0 = mlat0 + tasks(n)%mlat1 = mlat1 + tasks(n)%mlon0 = mlon0 + tasks(n)%mlon1 = mlon1 + enddo + ! + ! All tasks must have at least 4 longitudes: + do n = 0, ntask-1 + if (tasks(n)%nmaglons < 4) then + write(errmsg, "(3a,i0,', nmaglons = ',i4)") '>>> ', subname, & + ': each task must carry at least 4 longitudes. task = ', & + n, tasks(n)%nmaglons + if (masterproc) then + write(iulog, errmsg) + end if + call endrun(errmsg) + end if + end do + ! + ! Create subgroup communicators for each task column: + ! These communicators will be used by sub mp_mag_jslot (mpi.F). + ! + call mpi_comm_split(mpi_comm_edyn, mod(mytid,nmagtaski), mytid, & + cols_comm, ier) + call MPI_Comm_rank(cols_comm,tidcol,ier) + + if (debug .and. masterproc) then + write(iulog,"(2a,i3,' mod(mytid,nmagtaski)=',i3,' tidcol=',i3)") & + subname, ': nmagtaski = ', nmagtaski, mod(mytid,nmagtaski), tidcol + end if + end if + + end subroutine mp_distribute_mag + !----------------------------------------------------------------------- + subroutine distribute_1d(n1,n2,nprocs,myrank,istart,iend) + ! + ! Distribute work across a 1d vector(n1->n2) to nprocs. + ! Return start and end indices for proc myrank. + ! + ! Args: + integer,intent(in) :: n1,n2,nprocs,myrank + integer,intent(out) :: istart,iend + ! + ! Local: + integer :: lenproc,iremain,n + ! + n = n2-n1+1 + lenproc = n/nprocs + iremain = mod(n,nprocs) + istart = n1 + myrank*lenproc + min(myrank,iremain) + iend = istart+lenproc-1 + if (iremain > myrank) iend = iend+1 + end subroutine distribute_1d + !----------------------------------------------------------------------- + subroutine mp_exchange_tasks(mpi_comm, iprint, gmlat) + ! + ! Args: + integer, intent(in) :: mpi_comm + integer, intent(in) :: iprint + real(r8), intent(in) :: gmlat(:) + ! + ! Local: + ! itasks_send(len_task_type,ntask) will be used to send tasks(:) info + ! to all tasks (directly passing mpi derived data types is reportedly + ! not stable, or not available until MPI 2.x). + ! + integer :: n, ier + integer, parameter :: len_task_type = 17 ! see type task above + integer, allocatable :: & + itasks_send(:,:), & ! send buffer + itasks_recv(:,:) ! send buffer + integer :: npes + + call mpi_comm_size(mpi_comm, npes, ier) + + ! + ! Pack tasks(mytid) into itasks_send: + allocate(itasks_send(len_task_type,0:npes-1),stat=ier) + if (ier /= 0) then + write(iulog,"(i4,i4)") '>>> Error allocating itasks_send: len_task_type=',& + len_task_type,' npes=',npes + call endrun('mp_exchange_tasks: unable to allocate itasks_send') + endif + allocate(itasks_recv(len_task_type,0:npes-1),stat=ier) + if (ier /= 0) then + write(iulog,"(i4,i4)") '>>> Error allocating itasks_recv: len_task_type=',& + len_task_type,' npes=',npes + call endrun('mp_exchange_tasks: unable to allocate itasks_recv') endif - enddo - if (getpe < 0) then - write(iulog,"('getpe: pe with ix=',i4,' not found.')") ix - call endrun('getpe') - endif - end function getpe -!----------------------------------------------------------------------- - subroutine mp_pole_halos(f,lev0,lev1,lon0,lon1,lat0,lat1,nf,polesign) -! -! Set latitude halo points over the poles. -! -! Args: - integer,intent(in) :: lev0,lev1,lon0,lon1,lat0,lat1,nf - real(r8),intent(in) :: polesign(nf) - type(array_ptr_type) :: f(nf) ! (plev,i0-2:i1+2,j0-2:j1+2) -! -! Local: - integer :: if,i,j,k,ihalo,it,i0,i1,j0,j1,itask - -! real(r8) :: fglblon(lev0:lev1,nlon,lat0-2:lat1+2,nf) - type(array_ptr_type) :: pglblon(nf) ! (lev0:lev1,nlon,lat0-2:lat1+2) - - if (mytidj /= 0 .and. mytidj /= ntaskj-1) return - -! fglblon = 0._r8 ! init -! -! Allocate local fields with global longitudes: - do if=1,nf - allocate(pglblon(if)%ptr(lev0:lev1,nlon,lat0-2:lat1+2)) - enddo -! -! Define my subdomain in local fglblon, which has global lon dimension: -! - do if=1,nf - do j=lat0-2,lat1+2 - do i=lon0,lon1 - pglblon(if)%ptr(lev0:lev1,i,j) = f(if)%ptr(lev0:lev1,i,j) - enddo + do n=0,npes-1 + itasks_send(1,n) = tasks(mytid)%mytid + + itasks_send(2,n) = tasks(mytid)%mytidi + itasks_send(3,n) = tasks(mytid)%mytidj + itasks_send(4,n) = tasks(mytid)%nlats + itasks_send(5,n) = tasks(mytid)%nlons + itasks_send(6,n) = tasks(mytid)%lat0 + itasks_send(7,n) = tasks(mytid)%lat1 + itasks_send(8,n) = tasks(mytid)%lon0 + itasks_send(9,n) = tasks(mytid)%lon1 + + itasks_send(10,n) = tasks(mytid)%magtidi + itasks_send(11,n) = tasks(mytid)%magtidj + itasks_send(12,n) = tasks(mytid)%nmaglats + itasks_send(13,n) = tasks(mytid)%nmaglons + itasks_send(14,n) = tasks(mytid)%mlat0 + itasks_send(15,n) = tasks(mytid)%mlat1 + itasks_send(16,n) = tasks(mytid)%mlon0 + itasks_send(17,n) = tasks(mytid)%mlon1 enddo - enddo -! -! Gather longitude data to westernmost processors (far north and south): -! - call mp_gatherlons_f3d(pglblon,lev0,lev1,lon0,lon1,lat0-2,lat1+2,nf) -! -! Loop over tasks in my latitude row (far north or far south), -! including myself, and set halo points over the poles. -! - if (mytidi==0) then - do it=0,ntaski-1 - itask = tasks(itask_table_geo(it,mytidj))%mytid - i0 = tasks(itask)%lon0 - i1 = tasks(itask)%lon1 - j0 = tasks(itask)%lat0 - j1 = tasks(itask)%lat1 - do if=1,nf - if (j0==1) then ! south - do i=i0,i1 - ihalo = 1+mod(i-1+nlon/2,nlon) - pglblon(if)%ptr(lev0:lev1,i,j0-2) = pglblon(if)%ptr(lev0:lev1,ihalo,j0+2) ! get lat -1 from lat 3 - pglblon(if)%ptr(lev0:lev1,i,j0-1) = pglblon(if)%ptr(lev0:lev1,ihalo,j0+1) ! get lat 0 from lat 2 + ! + ! Send itasks_send and receive itasks_recv: + call mpi_alltoall(itasks_send,len_task_type,MPI_INTEGER,& + itasks_recv,len_task_type,MPI_INTEGER,& + mpi_comm,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'edyn_mpi: mpi_alltoall to send/recv itasks') + ! + ! Unpack itasks_recv into tasks(n) + ! + do n=0,npes-1 + tasks(n)%mytid = itasks_recv(1,n) + + tasks(n)%mytidi = itasks_recv(2,n) + tasks(n)%mytidj = itasks_recv(3,n) + tasks(n)%nlats = itasks_recv(4,n) + tasks(n)%nlons = itasks_recv(5,n) + tasks(n)%lat0 = itasks_recv(6,n) + tasks(n)%lat1 = itasks_recv(7,n) + tasks(n)%lon0 = itasks_recv(8,n) + tasks(n)%lon1 = itasks_recv(9,n) + + tasks(n)%magtidi = itasks_recv(10,n) + tasks(n)%magtidj = itasks_recv(11,n) + tasks(n)%nmaglats = itasks_recv(12,n) + tasks(n)%nmaglons = itasks_recv(13,n) + tasks(n)%mlat0 = itasks_recv(14,n) + tasks(n)%mlat1 = itasks_recv(15,n) + tasks(n)%mlon0 = itasks_recv(16,n) + tasks(n)%mlon1 = itasks_recv(17,n) + ! + ! Report to stdout: + ! + if (n==mytid.and.iprint > 0) then + write(iulog,"(/,'Task ',i3,':')") n + write(iulog,"(/,'Subdomain on geographic grid:')") + write(iulog,"('tasks(',i3,')%mytid =',i3)") n,tasks(n)%mytid + write(iulog,"('tasks(',i3,')%mytidi=',i3)") n,tasks(n)%mytidi + write(iulog,"('tasks(',i3,')%mytidj=',i3)") n,tasks(n)%mytidj + write(iulog,"('tasks(',i3,')%nlats =',i3)") n,tasks(n)%nlats + write(iulog,"('tasks(',i3,')%nlons =',i3)") n,tasks(n)%nlons + write(iulog,"('tasks(',i3,')%lat0 =',i3)") n,tasks(n)%lat0 + write(iulog,"('tasks(',i3,')%lat1 =',i3)") n,tasks(n)%lat1 + write(iulog,"('tasks(',i3,')%lon0 =',i3)") n,tasks(n)%lon0 + write(iulog,"('tasks(',i3,')%lon1 =',i3)") n,tasks(n)%lon1 + write(iulog,"('Number of geo subdomain grid points = ',i6)") & + tasks(n)%nlons * tasks(n)%nlats + write(iulog,"(/,'Subdomain on geomagnetic grid:')") + write(iulog,"('tasks(',i3,')%magtidi=',i3)") n,tasks(n)%magtidi + write(iulog,"('tasks(',i3,')%magtidj=',i3)") n,tasks(n)%magtidj + write(iulog,"('tasks(',i3,')%nmaglats =',i3)") n,tasks(n)%nmaglats + write(iulog,"('tasks(',i3,')%nmaglons =',i3)") n,tasks(n)%nmaglons + write(iulog,"('tasks(',i3,')%mlat0 =',i3)") n,tasks(n)%mlat0 + write(iulog,"('tasks(',i3,')%mlat1 =',i3)") n,tasks(n)%mlat1 + write(iulog,"('tasks(',i3,')%mlon0 =',i3)") n,tasks(n)%mlon0 + write(iulog,"('tasks(',i3,')%mlon1 =',i3)") n,tasks(n)%mlon1 + write(iulog,"('Number of mag subdomain grid points = ',i6)") & + tasks(n)%nmaglons * tasks(n)%nmaglats + endif + enddo + ! + ! Release locally allocated space: + deallocate(itasks_send) + deallocate(itasks_recv) + ! + ! mxlon / mxlat is the maximum number of lons / lats owned by any task: + mxlon = -9999 + do n= 0, npes-1 + if (tasks(n)%nlons > mxlon) then + mxlon = tasks(n)%nlons + end if + end do + mxlat = -9999 + do n = 0, npes-1 + if (tasks(n)%nlats > mxlat) then + mxlat = tasks(n)%nlats + end if + end do + ! + ! mxmaglon / mxmaglat is max number of mag lons / lats owned by any task: + mxmaglon = -9999 + do n = 0, npes-1 + if (tasks(n)%nmaglons > mxmaglon) then + mxmaglon = tasks(n)%nmaglons + end if + end do + mxmaglat = -9999 + do n = 0, npes-1 + if (tasks(n)%nmaglats > mxmaglat) then + mxmaglat = tasks(n)%nmaglats + end if + end do + ! + ! Find conjugate points for folding hemispheres: + call conjugate_points(gmlat) + + end subroutine mp_exchange_tasks + !----------------------------------------------------------------------- + subroutine mp_mageq(fin,fout,nf,mlon0,mlon1,mlat0,mlat1,nmlev) + ! + ! Each task needs values of conductivities and adotv1,2 fields at the + ! at the mag equator for its longitude subdomain (and all levels), for + ! the fieldline integrations. + ! + ! On input, fin is ped_mag, hal_mag, adotv1_mag, adotv2_mag + ! on (i,j,k) magnetic subdomain. + ! On output, fout(mlon0:mlon1,nmlev,nf) is ped_meq, hal_meq, adotv1_meq, + ! adotv2_meq at mag equator at longitude subdomain and all levels. + ! + ! Args: + integer :: mlon0,mlon1,mlat0,mlat1,nmlev,nf + real(r8),intent(in) :: fin (mlon0:mlon1,mlat0:mlat1,nmlev,nf) + real(r8),intent(out) :: fout(mlon0:mlon1,nmlev,nf) + ! + ! Local: + real(r8) :: & ! mpi buffers + sndbuf(mxmaglon,nmlev,nf), & ! mxmaglon,nmlev,nf + rcvbuf(mxmaglon,nmlev,nf) ! mxmaglon,nmlev,nf + integer :: i,j,n,itask,ier,len,jlateq,ireqsend,ireqrecv + integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status + logical :: have_eq + + sndbuf = 0._r8 + rcvbuf = 0._r8 + len = mxmaglon*nmlev*nf + ! + ! If mag equator is in current subdomain, load it into sndbuf + ! and send to other tasks in my task column (mytidi) + ! + jlateq = (nmlat+1)/2 ! lat index of mag equator (49) + have_eq = .false. + do j=mlat0,mlat1 + if (j == jlateq) then ! load send buffer w/ data at equator + have_eq = .true. + do i=mlon0,mlon1 + sndbuf(i-mlon0+1,:,:) = fin(i,j,:,:) enddo - else ! north - do i=i0,i1 - ihalo = 1+mod(i-1+nlon/2,nlon) - pglblon(if)%ptr(lev0:lev1,i,j1+1) = pglblon(if)%ptr(lev0:lev1,ihalo,j1-1) ! get lat plat+1 from plat-1 - pglblon(if)%ptr(lev0:lev1,i,j1+2) = pglblon(if)%ptr(lev0:lev1,ihalo,j1-2) ! get lat plat+2 from plat-2 + ! + ! Send mag equator data to other tasks in my task column (mytidi): + do itask=0,ntask-1 + if (itask /= mytid.and.tasks(itask)%mytidi==mytidi) then + call mpi_isend(sndbuf,len,MPI_REAL8,itask,1, & + mpi_comm_edyn,ireqsend,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mageq isend') + call mpi_wait(ireqsend,irstat,ier) + endif ! another task in mytidi + enddo ! itask=0,ntask-1 + endif ! j==jlateq + enddo ! j=mlat0,mlat1 + ! + ! Receive by other tasks in the sending task's column: + fout = 0._r8 + if (.not.have_eq) then ! find task to receive from + do itask=0,ntask-1 + do j=tasks(itask)%mlat0,tasks(itask)%mlat1 + if (j == jlateq.and.tasks(itask)%mytidi==mytidi) then + call mpi_irecv(rcvbuf,len,MPI_REAL8,itask,1, & + mpi_comm_edyn,ireqrecv,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mageq irecv') + call mpi_wait(ireqrecv,irstat,ier) + do n=1,nf + do i=mlon0,mlon1 + fout(i,:,n) = rcvbuf(i-mlon0+1,:,n) + enddo + enddo + endif ! itask has mag eq and is in my column (sending task) + enddo ! scan itask latitudes + enddo ! task table search + ! + ! If I am the sending task, set fout to equator values of input array: + else + do n=1,nf + do i=mlon0,mlon1 + fout(i,:,n) = fin(i,jlateq,:,n) enddo - endif - enddo ! if=1,nf - enddo ! it=0,ntaski-1 - endif ! mytidi==0 -! -! Scatter data back out to processors in my latitude row: -! - call mp_scatterlons_f3d(pglblon,lev0,lev1,lon0,lon1,lat0-2,lat1+2,nf) -! -! Finally, define halo points in data arrays from local global lon array, -! changing sign if necessary (winds): -! - if (lat0==1) then ! south + enddo + endif ! I am receiving or sending task + end subroutine mp_mageq + !----------------------------------------------------------------------- + subroutine mp_mageq_jpm1(f,mlon0,mlon1,mlat0,mlat1,nmlonp1,feq_jpm1,nf) + ! + ! All tasks need data at mag latitudes equator-1, equator+1 at global + ! longitudes. + ! On input: f is 6 fields on mag subdomains: zigm11,zigm22,zigmc,zigm2,rim1,rim2 + ! On output: feq_jpm1(nmlonp1,2,nf) + ! + ! Args: + integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nmlonp1,nf + real(r8),intent(in) :: f(mlon0:mlon1,mlat0:mlat1,nf) + real(r8),intent(out) :: feq_jpm1(nmlonp1,2,nf) ! eq-1,eq+1 + ! + ! Local: + integer :: j,ier,len,jlateq + real(r8) :: sndbuf(nmlonp1,2,nf) + + sndbuf = 0._r8 + feq_jpm1 = 0._r8 + len = nmlonp1*2*nf + ! + ! Load send buffer w/ eq +/- 1 for current subdomain + ! (redundant to all tasks for alltoall) + ! + jlateq = (nmlat+1)/2 + do j=mlat0,mlat1 + if (j == jlateq+1) then ! equator+1 + sndbuf(mlon0:mlon1,1,:) = f(mlon0:mlon1,j,:) + elseif (j == jlateq-1) then ! equator-1 + sndbuf(mlon0:mlon1,2,:) = f(mlon0:mlon1,j,:) + endif ! j==jlateq + enddo ! j=mlat0,mlat1 + ! + ! Do the exchange: + ! + call mpi_allreduce( sndbuf(:,:,1:nf), feq_jpm1(:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) + if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_mageq_jpm1 call mpi_allreduce') + + ! + ! Periodic point: + feq_jpm1(nmlonp1,:,:) = feq_jpm1(1,:,:) + + end subroutine mp_mageq_jpm1 + !----------------------------------------------------------------------- + subroutine mp_mageq_jpm3(f,mlon0,mlon1,mlat0,mlat1,nmlonp1,feq_jpm3,nf) + ! + ! All tasks need global longitudes at mag latitudes equator, + ! and equator +/- 1,2,3 + ! On input: f is nf fields on mag subdomains + ! On output: feq_jpm3(nmlonp1,-3:3,nf) has global lons at eq, eq +/- 1,2,3 + ! 2nd dimension of feq_jpm3 (and send/recv buffers) is as follows: + ! +3: eq+3 + ! +2: eq+2 + ! +1: eq+1 + ! 0: eq + ! -1: eq-1 + ! -2: eq-2 + ! -3: eq-3 + ! + ! Args: + integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nmlonp1,nf + real(r8),intent(in) :: f(mlon0:mlon1,mlat0:mlat1,nf) + real(r8),intent(out) :: feq_jpm3(nmlonp1,-3:3,nf) + ! + ! Local: + integer :: j,ier,len,jlateq + integer,parameter :: mxnf=6 + + real(r8) :: sndbuf(nmlonp1,-3:3,mxnf) + + if (nf > mxnf) then + write(iulog,"('>>> mp_mageq_jpm3: nf=',i4,' but cannot be called with greater than mxnf=',i4)") & + nf,mxnf + call endrun('mp_mageq_jpm3') + endif + + sndbuf = 0._r8 + feq_jpm3 = 0._r8 + len = nmlonp1*7*nf + ! + ! Load send buffer w/ eq +/- 3 for current subdomain + ! + jlateq = (nmlat+1)/2 + do j=mlat0,mlat1 + if (j == jlateq-3) then ! equator-3 + sndbuf(mlon0:mlon1,-3,1:nf) = f(mlon0:mlon1,j,:) + elseif (j == jlateq-2) then ! equator-2 + sndbuf(mlon0:mlon1,-2,1:nf) = f(mlon0:mlon1,j,:) + elseif (j == jlateq-1) then ! equator-1 + sndbuf(mlon0:mlon1,-1,1:nf) = f(mlon0:mlon1,j,:) + elseif (j == jlateq) then ! equator + sndbuf(mlon0:mlon1,0,1:nf) = f(mlon0:mlon1,j,:) + elseif (j == jlateq+1) then ! equator+1 + sndbuf(mlon0:mlon1,1,1:nf) = f(mlon0:mlon1,j,:) + elseif (j == jlateq+2) then ! equator+2 + sndbuf(mlon0:mlon1,2,1:nf) = f(mlon0:mlon1,j,:) + elseif (j == jlateq+3) then ! equator+3 + sndbuf(mlon0:mlon1,3,1:nf) = f(mlon0:mlon1,j,:) + endif ! j==jlateq + enddo ! j=mlat0,mlat1 + ! + ! Do the exchange: + ! + call mpi_allreduce( sndbuf(:,:,1:nf), feq_jpm3(:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) + if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_mageq_jpm3 call mpi_allreduce') + + ! + ! Periodic point: + feq_jpm3(nmlonp1,:,:) = feq_jpm3(1,:,:) + + end subroutine mp_mageq_jpm3 + !----------------------------------------------------------------------- + subroutine mp_magpole_2d(f,ilon0,ilon1,ilat0,ilat1, & + nglblon,jspole,jnpole,fpole_jpm2,nf) + ! + ! Return fpole_jpm2(nglblon,1->4,nf) as: + ! 1: j = jspole+1 (spole+1) + ! 2: j = jspole+2 (spole+2) + ! 3: j = jnpole-1 (npole-1) + ! 4: j = jnpole-2 (npole-2) + ! This can be called with different number of fields nf, but cannot + ! be called w/ > mxnf fields. + ! + ! Args: + integer,intent(in) :: ilon0,ilon1,ilat0,ilat1,nglblon,jspole,jnpole,nf + real(r8),intent(in) :: f(ilon0:ilon1,ilat0:ilat1,nf) + real(r8),intent(out) :: fpole_jpm2(nglblon,4,nf) + ! + ! Local: + integer :: j,ier,len + integer,parameter :: mxnf=7 + real(r8) :: sndbuf(nglblon,4,mxnf) + + if (nf > mxnf) then + write(iulog,"('>>> mp_magpole_2d: nf=',i4,' but cannot be called with greater than mxnf=',i4)") & + nf,mxnf + call endrun('mp_magpole_2d') + endif + + sndbuf = 0._r8 + fpole_jpm2 = 0._r8 + len = nglblon*4*nf + ! + ! Load send buffer with values at poles +/- 2 for current subdomain + ! + do j=ilat0,ilat1 + if (j==jspole+1) then ! south pole +1 + sndbuf(ilon0:ilon1,1,1:nf) = f(ilon0:ilon1,j,:) + elseif (j==jspole+2) then ! south pole +2 + sndbuf(ilon0:ilon1,2,1:nf) = f(ilon0:ilon1,j,:) + elseif (j==jnpole-1) then ! north pole -1 + sndbuf(ilon0:ilon1,3,1:nf) = f(ilon0:ilon1,j,:) + elseif (j==jnpole-2) then ! north pole -2 + sndbuf(ilon0:ilon1,4,1:nf) = f(ilon0:ilon1,j,:) + endif + enddo + + ! + ! Do the exchange: + ! + call mpi_allreduce( sndbuf(:,:,1:nf), fpole_jpm2(:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) + if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_magpole_2d call mpi_allreduce') + + end subroutine mp_magpole_2d + !----------------------------------------------------------------------- + subroutine mp_magpole_3d(f,ilon0,ilon1,ilat0,ilat1,nlev, nglblon,jspole,jnpole,fpole_jpm2,nf) + ! + ! Return fpole_jpm2(nglblon,1->4,nlev,nf) as: + ! 1: j = jspole+1 (spole+1) + ! 2: j = jspole+2 (spole+2) + ! 3: j = jnpole-1 (npole-1) + ! 4: j = jnpole-2 (npole-2) + ! This can be called with different number of fields nf, but cannot + ! be called w/ > mxnf fields. + ! + ! Args: + integer,intent(in) :: ilon0,ilon1,ilat0,ilat1,nglblon,& + jspole,jnpole,nf,nlev + real(r8),intent(in) :: f(ilon0:ilon1,ilat0:ilat1,nlev,nf) + real(r8),intent(out) :: fpole_jpm2(nglblon,4,nlev,nf) + ! + ! Local: + integer :: j,k,ier,len + integer,parameter :: mxnf=6 + real(r8) :: sndbuf(nglblon,4,nlev,mxnf) + + if (nf > mxnf) then + write(iulog,"('>>> mp_magpole_3d: nf=',i4,' but cannot be called with greater than mxnf=',i4)") & + nf,mxnf + call endrun('mp_magpole_3d') + endif + + sndbuf = 0._r8 + fpole_jpm2 = 0._r8 + len = nglblon*4*nlev*nf + ! + ! Load send buffer with values at poles +/- 2 for current subdomain + ! + do j=ilat0,ilat1 + do k=1,nlev + if (j==jspole+1) then ! south pole +1 + sndbuf(ilon0:ilon1,1,k,1:nf) = f(ilon0:ilon1,j,k,:) + elseif (j==jspole+2) then ! south pole +2 + sndbuf(ilon0:ilon1,2,k,1:nf) = f(ilon0:ilon1,j,k,:) + elseif (j==jnpole-1) then ! north pole -1 + sndbuf(ilon0:ilon1,3,k,1:nf) = f(ilon0:ilon1,j,k,:) + elseif (j==jnpole-2) then ! north pole -2 + sndbuf(ilon0:ilon1,4,k,1:nf) = f(ilon0:ilon1,j,k,:) + endif + enddo + enddo + + ! + ! Do the exchange: + ! + call mpi_allreduce( sndbuf(:,:,:,1:nf), fpole_jpm2(:,:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) + if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_magpole_3d call mpi_allreduce') + + end subroutine mp_magpole_3d + !----------------------------------------------------------------------- + subroutine mp_magpoles(f,ilon0,ilon1,ilat0,ilat1,nglblon, jspole,jnpole,fpoles,nf) + ! + ! Similiar to mp_magpole_2d, but returns global longitudes for + ! j==1 and j==nmlat (not for poles +/- 2) + ! Return fpoles(nglblon,2,nf) as: + ! 1: j = jspole (spole) + ! 2: j = jnpole (npole) + ! This can be called with different number of fields nf, but cannot + ! be called w/ > mxnf fields. + ! + ! Args: + integer,intent(in) :: ilon0,ilon1,ilat0,ilat1,nglblon, jspole,jnpole,nf + real(r8),intent(in) :: f(ilon0:ilon1,ilat0:ilat1,nf) + real(r8),intent(out) :: fpoles(nglblon,2,nf) + ! + ! Local: + integer :: j,ier,len + real(r8) :: sndbuf(nglblon,2,nf) + + sndbuf = 0._r8 + fpoles = 0._r8 + len = nglblon*2*nf + ! + ! Load send buffer with values at poles +/- 2 for current subdomain + ! + do j=ilat0,ilat1 + if (j==jspole) then ! south pole + sndbuf(ilon0:ilon1,1,1:nf) = f(ilon0:ilon1,j,:) + elseif (j==jnpole) then ! npole pole + sndbuf(ilon0:ilon1,2,1:nf) = f(ilon0:ilon1,j,:) + endif + enddo + + ! + ! Do the exchange: + ! + call mpi_allreduce( sndbuf(:,:,1:nf), fpoles(:,:,1:nf), len, MPI_REAL8, MPI_SUM, mpi_comm_edyn, ier ) + if ( ier .ne. MPI_SUCCESS ) call handle_mpi_err(ier,'mp_magpoles call mpi_allreduce') + + end subroutine mp_magpoles + !----------------------------------------------------------------------- + integer function getpe(ix,jx) + integer,intent(in) :: ix,jx + integer :: it + + getpe = -1 + do it=0,ntask-1 + if ((tasks(it)%lon0 <= ix .and. tasks(it)%lon1 >= ix).and.& + (tasks(it)%lat0 <= jx .and. tasks(it)%lat1 >= jx)) then + getpe = it + exit + endif + enddo + if (getpe < 0) then + write(iulog,"('getpe: pe with ix=',i4,' not found.')") ix + call endrun('getpe') + endif + end function getpe + !----------------------------------------------------------------------- + subroutine mp_pole_halos(f,lev0,lev1,lon0,lon1,lat0,lat1,nf,polesign) + ! + ! Set latitude halo points over the poles. + ! + ! Args: + integer,intent(in) :: lev0,lev1,lon0,lon1,lat0,lat1,nf + real(r8),intent(in) :: polesign(nf) + type(array_ptr_type) :: f(nf) ! (plev,i0-2:i1+2,j0-2:j1+2) + ! + ! Local: + integer :: if,i,j,k,ihalo,it,i0,i1,j0,j1,itask + + ! real(r8) :: fglblon(lev0:lev1,nlon,lat0-2:lat1+2,nf) + type(array_ptr_type) :: pglblon(nf) ! (lev0:lev1,nlon,lat0-2:lat1+2) + + if (mytidj /= 0 .and. mytidj /= ntaskj-1) return + + ! fglblon = 0._r8 ! init + ! + ! Allocate local fields with global longitudes: do if=1,nf - do j=lat0-2,lat0-1 - do k=lev0,lev1 - f(if)%ptr(k,lon0:lon1,j) = pglblon(if)%ptr(k,lon0:lon1,j)*polesign(if) - enddo - enddo + allocate(pglblon(if)%ptr(lev0:lev1,nlon_geo,lat0-2:lat1+2)) enddo - else ! north + ! + ! Define my subdomain in local fglblon, which has global lon dimension: + ! do if=1,nf - do j=lat1+1,lat1+2 - do k=lev0,lev1 - f(if)%ptr(k,lon0:lon1,j) = pglblon(if)%ptr(k,lon0:lon1,j)*polesign(if) - enddo - enddo + do j=lat0-2,lat1+2 + do i=lon0,lon1 + pglblon(if)%ptr(lev0:lev1,i,j) = f(if)%ptr(lev0:lev1,i,j) + enddo + enddo enddo - endif - - do if=1,nf - deallocate(pglblon(if)%ptr) - enddo - end subroutine mp_pole_halos -!----------------------------------------------------------------------- - subroutine conjugate_points - use edyn_maggrid,only: gmlat -! -! Local: - integer :: ier,j,js,jn,itask,jj -! -! nsend_south(ntask): number of lats in south to send north -! nrecv_north(ntask): number of lats in north to recv from south -! - allocate(nsend_south(0:ntask-1),stat=ier) - allocate(nrecv_north(0:ntask-1),stat=ier) -! -! send_south_coords: south j lats to send north -! recv_north_coords: north j lats to recv from south -! - allocate(send_south_coords(mxmaglat,0:ntask-1),stat=ier) - allocate(recv_north_coords(mxmaglat,0:ntask-1),stat=ier) - - nsend_south(:) = 0 - nrecv_north(:) = 0 - send_south_coords(:,:) = 0 - recv_north_coords(:,:) = 0 - - magloop: do j=mlat0,mlat1 -! -! In north hem: find tasks w/ conjugate points in south to recv: -! (nmlath is in params module) - if (gmlat(j) > 0._r8) then ! in north hem of current task - js = nmlath-(j-nmlath) ! j index to south conjugate point (should be -j) - do itask=0,ntask-1 - do jj = tasks(itask)%mlat0,tasks(itask)%mlat1 -! -! Receive these north coords from the south: - if (jj==js.and.mlon0==tasks(itask)%mlon0.and. & - mlon1==tasks(itask)%mlon1) then - nrecv_north(itask) = nrecv_north(itask)+1 - recv_north_coords(nrecv_north(itask),itask) = j - endif - enddo ! jj of remote task - enddo ! itask=0,ntask-1 - if (all(nrecv_north==0)) & - write(iulog,"(2a,i4,a,f8.2)") '>>> WARNING: could not find north conjugate',& - ' points corresponding to south latitude js=',js,' gmlat(js)=',gmlat(js) -! -! In south hem: find tasks w/ conjugate points in north to send: - elseif (gmlat(j) < 0._r8.and.j /= nmlath) then ! in south hem - jn = nmlath+(nmlath-j) ! j index of north conjugate point - do itask=0,ntask-1 - do jj = tasks(itask)%mlat0,tasks(itask)%mlat1 - if (jj==jn.and.mlon0==tasks(itask)%mlon0.and. & - mlon1==tasks(itask)%mlon1) then - nsend_south(itask) = nsend_south(itask)+1 -! Send these south coords to the north: - send_south_coords(nsend_south(itask),itask) = j - endif - enddo ! jj of remote task - enddo ! itask=0,ntask-1 - if (all(nsend_south==0)) & - write(iulog,"(2a,i4,a,f8.2)") '>>> WARNING: could not find south conjugate',& - ' points corresponding to north latitude jn=',jn,' gmlat(jn)=',gmlat(jn) - endif ! in north or south hem - enddo magloop ! j=mlat0,mlat1 - end subroutine conjugate_points -!----------------------------------------------------------------------- - subroutine mp_mag_foldhem(f,mlon0,mlon1,mlat0,mlat1,nf) -! -! For each point in northern hemisphere (if any) of the current task -! subdomain, receive data from conjugate point in the south (from the -! south task that owns it), and sum it to the north point data. -! Do this for nf fields. Conjugate point indices to send/recv to/from -! each task were determined by sub conjugate_points (this module). -! nsend_south, ! number of south lats to send to north (each task) -! nrecv_north ! number of north lats to send to south (each task) -! -! This routine is called from edynamo at every timestep. -! Sub conjugate_points is called once per run, from mp_distribute. -! -! Args: - integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nf - real(r8),intent(inout) :: f(mlon0:mlon1,mlat0:mlat1,nf) -! -! Local: - integer :: j,n,len,itask,ifld,ier,nmlons - real(r8) :: sndbuf(mxmaglon,mxmaglat,nf,0:ntask-1) - real(r8) :: rcvbuf(mxmaglon,mxmaglat,nf,0:ntask-1) - integer :: jsend(0:ntask-1),jrecv(0:ntask-1) - integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status - -! - sndbuf = 0._r8 ; rcvbuf = 0._r8 - jsend = 0 ; jrecv = 0 - len = mxmaglon*mxmaglat*nf - nmlons = mlon1-mlon0+1 -! -! Send south data to north itask: -! (To avoid deadlock, do not send if north task is also myself. This will -! happen when there is an odd number of tasks in the latitude dimension, -! e.g., ntask == 12, 30, etc) -! - do itask=0,ntask-1 - -! Attempt to fetch from allocatable variable NSEND_SOUTH when it is not allocated - - if (nsend_south(itask) > 0 .and. itask /= mytid) then - do ifld = 1,nf - do n=1,nsend_south(itask) - sndbuf(1:nmlons,n,ifld,itask) = & - f(:,send_south_coords(n,itask),ifld) - enddo - enddo ! ifld=1,nf - call mpi_isend(sndbuf(1,1,1,itask),len,MPI_REAL8, & - itask,1,mpi_comm_edyn,jsend(itask),ier) - call mpi_wait(jsend(itask),irstat,ier) - endif ! nsend_south(itask) > 0 - enddo ! itask=0,ntask-1 -! -! Receive north data from south itask and add to north, -! i.e., north = north+south. (do not receive if south task is -! also myself, but do add south data to my north points, see below) -! - do itask=0,ntask-1 - if (nrecv_north(itask) > 0 .and. itask /= mytid) then - call mpi_irecv(rcvbuf(1,1,1,itask),len,MPI_REAL8, & - itask,1,mpi_comm_edyn,jrecv(itask),ier) - call mpi_wait(jrecv(itask),irstat,ier) - do ifld=1,nf - do n=1,nrecv_north(itask) -! -! Receive lats in reverse order: - f(mlon0:mlon1, & - recv_north_coords(nrecv_north(itask)-n+1,itask),ifld) = & - f(mlon0:mlon1, & - recv_north_coords(nrecv_north(itask)-n+1,itask),ifld) + & - rcvbuf(1:nmlons,n,ifld,itask) - enddo ! n=1,nrecv_north(itask) - enddo ! ifld=1,nf -! -! If I am send *and* receive task, simply add my south data to my north points: - elseif (nrecv_north(itask) > 0 .and. itask == mytid) then - do ifld=1,nf - do n=1,nrecv_north(itask) - f(mlon0:mlon1, & - recv_north_coords(nrecv_north(itask)-n+1,itask),ifld) = & - f(mlon0:mlon1, & - recv_north_coords(nrecv_north(itask)-n+1,itask),ifld) + & - f(mlon0:mlon1,send_south_coords(n,itask),ifld) - enddo ! n=1,nrecv_north(itask) - enddo ! ifld=1,nf - endif ! nrecv_north(itask) > 0 - enddo ! itask=0,ntask-1 -! -! Mag equator is also "folded", but not included in conjugate points, -! so double it here: - do j=mlat0,mlat1 - if (j==nmlath) then - do ifld=1,nf - f(:,j,ifld) = f(:,j,ifld)+f(:,j,ifld) - enddo - endif - enddo - - end subroutine mp_mag_foldhem -!----------------------------------------------------------------------- - subroutine mp_mag_periodic_f2d(f,mlon0,mlon1,mlat0,mlat1,nf) -! -! Args: - integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nf - real(r8),intent(inout) :: f(mlon0:mlon1,mlat0:mlat1,nf) -! -! Local: - integer :: j,ier,idest,isrc,len,ireqsend,ireqrecv,msgtag - real(r8) :: sndbuf(mxmaglat,nf),rcvbuf(mxmaglat,nf) - integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status - - if (ntaski>1) then - len = mxmaglat*nf - ! - ! I am a western-most task. Send lon 1 to eastern-most tasks: - if (mytidi==0) then - idest = itask_table_mag(ntaski-1,mytidj) - do j=mlat0,mlat1 - sndbuf(j-mlat0+1,:) = f(1,j,:) - enddo - msgtag = mytid - call mpi_isend(sndbuf,len,MPI_REAL8,idest,msgtag,mpi_comm_edyn, ireqsend,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_periodic_f2d send to idest') - call mpi_wait(ireqsend,irstat,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_periodic_f2d wait for send') - ! - ! I am eastern-most task. Receive lon 1 from western-most tasks, - ! and assign to nmlonp1: - elseif (mytidi==ntaski-1) then - isrc = itask_table_mag(0,mytidj) - msgtag = isrc - call mpi_irecv(rcvbuf,len,MPI_REAL8,isrc,msgtag,mpi_comm_edyn, ireqrecv,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_periodic_f2d recv from isrc') - call mpi_wait(ireqrecv,irstat,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_periodic_f2d wait for recv') - - do j=mlat0,mlat1 - f(nmlonp1,j,:) = rcvbuf(j-mlat0+1,:) - enddo - endif ! mytidi == 0 or ntaski-1 - else - do j=mlat0,mlat1 - f(nmlonp1,j,:) = f(1,j,:) - enddo - endif - - end subroutine mp_mag_periodic_f2d -!----------------------------------------------------------------------- - subroutine mp_mag_halos(fmsub,mlon0,mlon1,mlat0,mlat1,nf) -! -! Exchange halo/ghost points between magnetic grid subdomains for nf fields. -! Only a single halo point is required in both lon and lat dimensions. -! Note that all tasks in any row of the task matrix have the same -! mlat0,mlat1, and that all tasks in any column of the task matrix -! have the same mlon0,mlon1. -! Longitude halos are done first, exchanging mlat0:mlat1, then latitude -! halos are done, exchanging mlon0-1:mlon1+1 (i.e., including the -! longitude halos that were defined first). -! -! Args: - integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nf - real(r8),intent(inout) :: fmsub(mlon0-1:mlon1+1,mlat0-1:mlat1+1,nf) -! -! Local: - integer :: ifld,west,east,north,south,len,isend0,isend1, & - irecv0,irecv1,ier,nmlats,istat(MPI_STATUS_SIZE,4),ireq(4),nmlons - real(r8),dimension(mlat1-mlat0+1,nf)::sndlon0,sndlon1,rcvlon0,rcvlon1 - real(r8),dimension((mlon1+1)-(mlon0-1)+1,nf) :: & - sndlat0,sndlat1,rcvlat0,rcvlat1 - -! -! Init send/recv buffers for lon halos: - sndlon0 = 0._r8 ; rcvlon0 = 0._r8 - sndlon1 = 0._r8 ; rcvlon1 = 0._r8 -! -! Identify east and west neightbors: - west = itask_table_mag(mytidi-1,mytidj) - east = itask_table_mag(mytidi+1,mytidj) -! -! Exchange mlat0:mlat1 (lat halos are not yet defined): - nmlats = mlat1-mlat0+1 - len = nmlats*nf -! -! Send mlon0 to the west neighbor, and mlon1 to the east. -! However, tasks are periodic in longitude (see itask_table_mag), -! and far west tasks send mlon0+1, and far east tasks send mlon1-1 -! - do ifld=1,nf -! Far west tasks send mlon0+1 to far east (periodic) tasks: + ! + ! Gather longitude data to westernmost processors (far north and south): + ! + call mp_gatherlons_f3d(pglblon,lev0,lev1,lon0,lon1,lat0-2,lat1+2,nf) + ! + ! Loop over tasks in my latitude row (far north or far south), + ! including myself, and set halo points over the poles. + ! if (mytidi==0) then - sndlon0(:,ifld) = fmsub(mlon0+1,mlat0:mlat1,ifld) -! Interior tasks send mlon0 to west neighbor: - else - sndlon0(:,ifld) = fmsub(mlon0,mlat0:mlat1,ifld) + do it=0,ntaski-1 + itask = tasks(itask_table_geo(it,mytidj))%mytid + i0 = tasks(itask)%lon0 + i1 = tasks(itask)%lon1 + j0 = tasks(itask)%lat0 + j1 = tasks(itask)%lat1 + do if=1,nf + if (j0==1) then ! south + do i=i0,i1 + ihalo = 1+mod(i-1+nlon_geo/2,nlon_geo) + pglblon(if)%ptr(lev0:lev1,i,j0-2) = pglblon(if)%ptr(lev0:lev1,ihalo,j0+2) ! get lat -1 from lat 3 + pglblon(if)%ptr(lev0:lev1,i,j0-1) = pglblon(if)%ptr(lev0:lev1,ihalo,j0+1) ! get lat 0 from lat 2 + enddo + else ! north + do i=i0,i1 + ihalo = 1+mod(i-1+nlon_geo/2,nlon_geo) + pglblon(if)%ptr(lev0:lev1,i,j1+1) = pglblon(if)%ptr(lev0:lev1,ihalo,j1-1) ! get lat plat+1 from plat-1 + pglblon(if)%ptr(lev0:lev1,i,j1+2) = pglblon(if)%ptr(lev0:lev1,ihalo,j1-2) ! get lat plat+2 from plat-2 + enddo + endif + enddo ! if=1,nf + enddo ! it=0,ntaski-1 + endif ! mytidi==0 + ! + ! Scatter data back out to processors in my latitude row: + ! + call mp_scatterlons_f3d(pglblon,lev0,lev1,lon0,lon1,lat0-2,lat1+2,nf) + ! + ! Finally, define halo points in data arrays from local global lon array, + ! changing sign if necessary (winds): + ! + if (lat0==1) then ! south + do if=1,nf + do j=lat0-2,lat0-1 + do k=lev0,lev1 + f(if)%ptr(k,lon0:lon1,j) = pglblon(if)%ptr(k,lon0:lon1,j)*polesign(if) + enddo + enddo + enddo + else ! north + do if=1,nf + do j=lat1+1,lat1+2 + do k=lev0,lev1 + f(if)%ptr(k,lon0:lon1,j) = pglblon(if)%ptr(k,lon0:lon1,j)*polesign(if) + enddo + enddo + enddo endif -! Far east tasks send mlon1-1 to far west (periodic) tasks: - if (mytidi==nmagtaski-1) then - sndlon1(:,ifld) = fmsub(mlon1-1,mlat0:mlat1,ifld) -! Interior tasks send mlon1 to east neighbor: + do if=1,nf + deallocate(pglblon(if)%ptr) + enddo + end subroutine mp_pole_halos + !----------------------------------------------------------------------- + subroutine conjugate_points(gmlat) + + real(r8), intent(in) :: gmlat(:) + ! + ! Local: + integer :: ier,j,js,jn,itask,jj + ! + ! nsend_south(ntask): number of lats in south to send north + ! nrecv_north(ntask): number of lats in north to recv from south + ! + allocate(nsend_south(0:ntask-1),stat=ier) + allocate(nrecv_north(0:ntask-1),stat=ier) + ! + ! send_south_coords: south j lats to send north + ! recv_north_coords: north j lats to recv from south + ! + allocate(send_south_coords(mxmaglat,0:ntask-1),stat=ier) + allocate(recv_north_coords(mxmaglat,0:ntask-1),stat=ier) + + nsend_south(:) = 0 + nrecv_north(:) = 0 + send_south_coords(:,:) = 0 + recv_north_coords(:,:) = 0 + + magloop: do j=mlat0,mlat1 + ! + ! In north hem: find tasks w/ conjugate points in south to recv: + ! (nmlath is in params module) + if (gmlat(j) > 0._r8) then ! in north hem of current task + js = nmlath-(j-nmlath) ! j index to south conjugate point (should be -j) + do itask=0,ntask-1 + do jj = tasks(itask)%mlat0,tasks(itask)%mlat1 + ! + ! Receive these north coords from the south: + if (jj==js.and.mlon0==tasks(itask)%mlon0.and. & + mlon1==tasks(itask)%mlon1) then + nrecv_north(itask) = nrecv_north(itask)+1 + recv_north_coords(nrecv_north(itask),itask) = j + endif + enddo ! jj of remote task + enddo ! itask=0,ntask-1 + if (all(nrecv_north==0)) & + write(iulog,"(2a,i4,a,f8.2)") '>>> WARNING: could not find north conjugate',& + ' points corresponding to south latitude js=',js,' gmlat(js)=',gmlat(js) + ! + ! In south hem: find tasks w/ conjugate points in north to send: + elseif (gmlat(j) < 0._r8.and.j /= nmlath) then ! in south hem + jn = nmlath+(nmlath-j) ! j index of north conjugate point + do itask=0,ntask-1 + do jj = tasks(itask)%mlat0,tasks(itask)%mlat1 + if (jj==jn.and.mlon0==tasks(itask)%mlon0.and. & + mlon1==tasks(itask)%mlon1) then + nsend_south(itask) = nsend_south(itask)+1 + ! Send these south coords to the north: + send_south_coords(nsend_south(itask),itask) = j + endif + enddo ! jj of remote task + enddo ! itask=0,ntask-1 + if (all(nsend_south==0)) & + write(iulog,"(2a,i4,a,f8.2)") '>>> WARNING: could not find south conjugate',& + ' points corresponding to north latitude jn=',jn,' gmlat(jn)=',gmlat(jn) + endif ! in north or south hem + enddo magloop ! j=mlat0,mlat1 + end subroutine conjugate_points + !----------------------------------------------------------------------- + subroutine mp_mag_foldhem(f,mlon0,mlon1,mlat0,mlat1,nf) + ! + ! For each point in northern hemisphere (if any) of the current task + ! subdomain, receive data from conjugate point in the south (from the + ! south task that owns it), and sum it to the north point data. + ! Do this for nf fields. Conjugate point indices to send/recv to/from + ! each task were determined by sub conjugate_points (this module). + ! nsend_south, ! number of south lats to send to north (each task) + ! nrecv_north ! number of north lats to send to south (each task) + ! + ! This routine is called from edynamo at every timestep. + ! Sub conjugate_points is called once per run, from mp_distribute. + ! + ! Args: + integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nf + real(r8),intent(inout) :: f(mlon0:mlon1,mlat0:mlat1,nf) + ! + ! Local: + integer :: j,n,len,itask,ifld,ier,nmlons + real(r8) :: sndbuf(mxmaglon,mxmaglat,nf,0:ntask-1) + real(r8) :: rcvbuf(mxmaglon,mxmaglat,nf,0:ntask-1) + integer :: jsend(0:ntask-1),jrecv(0:ntask-1) + integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status + + ! + sndbuf = 0._r8 ; rcvbuf = 0._r8 + jsend = 0 ; jrecv = 0 + len = mxmaglon*mxmaglat*nf + nmlons = mlon1-mlon0+1 + ! + ! Send south data to north itask: + ! (To avoid deadlock, do not send if north task is also myself. This will + ! happen when there is an odd number of tasks in the latitude dimension, + ! e.g., ntask == 12, 30, etc) + ! + do itask=0,ntask-1 + + ! Attempt to fetch from allocatable variable NSEND_SOUTH when it is not allocated + + if (nsend_south(itask) > 0 .and. itask /= mytid) then + do ifld = 1,nf + do n=1,nsend_south(itask) + sndbuf(1:nmlons,n,ifld,itask) = & + f(:,send_south_coords(n,itask),ifld) + enddo + enddo ! ifld=1,nf + call mpi_isend(sndbuf(1,1,1,itask),len,MPI_REAL8, & + itask,1,mpi_comm_edyn,jsend(itask),ier) + call mpi_wait(jsend(itask),irstat,ier) + endif ! nsend_south(itask) > 0 + enddo ! itask=0,ntask-1 + ! + ! Receive north data from south itask and add to north, + ! i.e., north = north+south. (do not receive if south task is + ! also myself, but do add south data to my north points, see below) + ! + do itask=0,ntask-1 + if (nrecv_north(itask) > 0 .and. itask /= mytid) then + call mpi_irecv(rcvbuf(1,1,1,itask),len,MPI_REAL8, & + itask,1,mpi_comm_edyn,jrecv(itask),ier) + call mpi_wait(jrecv(itask),irstat,ier) + do ifld=1,nf + do n=1,nrecv_north(itask) + ! + ! Receive lats in reverse order: + f(mlon0:mlon1, & + recv_north_coords(nrecv_north(itask)-n+1,itask),ifld) = & + f(mlon0:mlon1, & + recv_north_coords(nrecv_north(itask)-n+1,itask),ifld) + & + rcvbuf(1:nmlons,n,ifld,itask) + enddo ! n=1,nrecv_north(itask) + enddo ! ifld=1,nf + ! + ! If I am send *and* receive task, simply add my south data to my north points: + elseif (nrecv_north(itask) > 0 .and. itask == mytid) then + do ifld=1,nf + do n=1,nrecv_north(itask) + f(mlon0:mlon1, & + recv_north_coords(nrecv_north(itask)-n+1,itask),ifld) = & + f(mlon0:mlon1, & + recv_north_coords(nrecv_north(itask)-n+1,itask),ifld) + & + f(mlon0:mlon1,send_south_coords(n,itask),ifld) + enddo ! n=1,nrecv_north(itask) + enddo ! ifld=1,nf + endif ! nrecv_north(itask) > 0 + enddo ! itask=0,ntask-1 + ! + ! Mag equator is also "folded", but not included in conjugate points, + ! so double it here: + do j=mlat0,mlat1 + if (j==nmlath) then + do ifld=1,nf + f(:,j,ifld) = f(:,j,ifld)+f(:,j,ifld) + enddo + endif + enddo + + end subroutine mp_mag_foldhem + !----------------------------------------------------------------------- + subroutine mp_mag_periodic_f2d(f,mlon0,mlon1,mlat0,mlat1,nf) + ! + ! Args: + integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nf + real(r8),intent(inout) :: f(mlon0:mlon1,mlat0:mlat1,nf) + ! + ! Local: + integer :: j,ier,idest,isrc,len,ireqsend,ireqrecv,msgtag + real(r8) :: sndbuf(mxmaglat,nf),rcvbuf(mxmaglat,nf) + integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status + + if (ntaski>1) then + len = mxmaglat*nf + ! + ! I am a western-most task. Send lon 1 to eastern-most tasks: + if (mytidi==0) then + idest = itask_table_mag(ntaski-1,mytidj) + do j=mlat0,mlat1 + sndbuf(j-mlat0+1,:) = f(1,j,:) + enddo + msgtag = mytid + call mpi_isend(sndbuf,len,MPI_REAL8,idest,msgtag,mpi_comm_edyn, ireqsend,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_periodic_f2d send to idest') + call mpi_wait(ireqsend,irstat,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_periodic_f2d wait for send') + ! + ! I am eastern-most task. Receive lon 1 from western-most tasks, + ! and assign to nmlonp1: + elseif (mytidi==ntaski-1) then + isrc = itask_table_mag(0,mytidj) + msgtag = isrc + call mpi_irecv(rcvbuf,len,MPI_REAL8,isrc,msgtag,mpi_comm_edyn, ireqrecv,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_periodic_f2d recv from isrc') + call mpi_wait(ireqrecv,irstat,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_periodic_f2d wait for recv') + + do j=mlat0,mlat1 + f(nmlonp1,j,:) = rcvbuf(j-mlat0+1,:) + enddo + endif ! mytidi == 0 or ntaski-1 else - sndlon1(:,ifld) = fmsub(mlon1,mlat0:mlat1,ifld) + do j=mlat0,mlat1 + f(nmlonp1,j,:) = f(1,j,:) + enddo endif - enddo ! ifld=1,nf -! -! Send mlon0 to the west: - call mpi_isend(sndlon0,len,MPI_REAL8,west,1,mpi_comm_edyn,isend0,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos send mlon0 to west') -! -! Send mlon1 to the east: - call mpi_isend(sndlon1,len,MPI_REAL8,east,1,mpi_comm_edyn,isend1,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos send mlon1 to east') -! -! Recv mlon0-1 from west: - call mpi_irecv(rcvlon0,len,MPI_REAL8,west,1,mpi_comm_edyn,irecv0,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos recv mlon0 from west') -! -! Recv mlon1+1 from east: - call mpi_irecv(rcvlon1,len,MPI_REAL8,east,1,mpi_comm_edyn,irecv1,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos recv mlon1 from east') -! -! Wait for completions: - ireq = (/isend0,isend1,irecv0,irecv1/) - istat = 0 - call mpi_waitall(4,ireq,istat,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos waitall for lons') -! -! Copy mlon0-1 from rcvlon0, and mlon1+1 from rcvlon1: - do ifld=1,nf - fmsub(mlon0-1,mlat0:mlat1,ifld) = rcvlon0(:,ifld) - fmsub(mlon1+1,mlat0:mlat1,ifld) = rcvlon1(:,ifld) -! -! Fix special case of 2 tasks in longitude dimension: - if (east == west) then - fmsub(mlon0-1,mlat0:mlat1,ifld) = rcvlon1(:,ifld) - fmsub(mlon1+1,mlat0:mlat1,ifld) = rcvlon0(:,ifld) - endif - enddo ! ifld=1,nf -! -! Now exchange latitudes: - sndlat0 = 0._r8 ; rcvlat0 = 0._r8 - sndlat1 = 0._r8 ; rcvlat1 = 0._r8 - - south = itask_table_mag(mytidi,mytidj-1) ! neighbor to south - north = itask_table_mag(mytidi,mytidj+1) ! neighbor to north -! -! Include halo longitudes that were defined by the exchanges above: - nmlons = (mlon1+1)-(mlon0-1)+1 - len = nmlons*nf -! -! Send mlat0 to south neighbor, and mlat1 to north: - do ifld=1,nf - sndlat0(:,ifld) = fmsub(:,mlat0,ifld) - sndlat1(:,ifld) = fmsub(:,mlat1,ifld) - enddo -! -! Send mlat0 to south: - call mpi_isend(sndlat0,len,MPI_REAL8,south,1,mpi_comm_edyn,isend0,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos send mlat0 to south') -! -! Send mlat1 to north: - call mpi_isend(sndlat1,len,MPI_REAL8,north,1,mpi_comm_edyn,isend1,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos send mlat1 to north') -! -! Recv mlat0-1 from south: - call mpi_irecv(rcvlat0,len,MPI_REAL8,south,1,mpi_comm_edyn,irecv0,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos recv mlat0-1 from south') -! -! Recv mlat1+1 from north: - call mpi_irecv(rcvlat1,len,MPI_REAL8,north,1,mpi_comm_edyn,irecv1,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos recv mlat1+1 from north') -! -! Wait for completions: - ireq = (/isend0,isend1,irecv0,irecv1/) - istat = 0 - call mpi_waitall(4,ireq,istat,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos waitall for lats') -! -! Copy mlat0-1 from rcvlat0, and mlat1+1 from rcvlat1: - do ifld=1,nf - fmsub(:,mlat0-1,ifld) = rcvlat0(:,ifld) - fmsub(:,mlat1+1,ifld) = rcvlat1(:,ifld) - enddo ! ifld=1,nf - - end subroutine mp_mag_halos -!----------------------------------------------------------------------- - subroutine mp_geo_halos(fmsub,lev0,lev1,lon0,lon1,lat0,lat1,nf) -! -! Exchange halo/ghost points between geographic grid subdomains for nf fields. -! Two halo points are set in both lon and lat dimensions. -! Longitude halos are done first, then latitude halos are done, including -! longitude halos that were defined first). -! -! Args: + + end subroutine mp_mag_periodic_f2d + !----------------------------------------------------------------------- + subroutine mp_mag_halos(fmsub,mlon0,mlon1,mlat0,mlat1,nf) + ! + ! Exchange halo/ghost points between magnetic grid subdomains for nf fields. + ! Only a single halo point is required in both lon and lat dimensions. + ! Note that all tasks in any row of the task matrix have the same + ! mlat0,mlat1, and that all tasks in any column of the task matrix + ! have the same mlon0,mlon1. + ! Longitude halos are done first, exchanging mlat0:mlat1, then latitude + ! halos are done, exchanging mlon0-1:mlon1+1 (i.e., including the + ! longitude halos that were defined first). + ! + ! Args: + integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nf + real(r8),intent(inout) :: fmsub(mlon0-1:mlon1+1,mlat0-1:mlat1+1,nf) + ! + ! Local: + integer :: ifld,west,east,north,south,len,isend0,isend1, & + irecv0,irecv1,ier,nmlats,istat(MPI_STATUS_SIZE,4),ireq(4),nmlons + real(r8),dimension(mlat1-mlat0+1,nf)::sndlon0,sndlon1,rcvlon0,rcvlon1 + real(r8),dimension((mlon1+1)-(mlon0-1)+1,nf) :: & + sndlat0,sndlat1,rcvlat0,rcvlat1 + + ! + ! Init send/recv buffers for lon halos: + sndlon0 = 0._r8 ; rcvlon0 = 0._r8 + sndlon1 = 0._r8 ; rcvlon1 = 0._r8 + ! + ! Identify east and west neightbors: + west = itask_table_mag(mytidi-1,mytidj) + east = itask_table_mag(mytidi+1,mytidj) + ! + ! Exchange mlat0:mlat1 (lat halos are not yet defined): + nmlats = mlat1-mlat0+1 + len = nmlats*nf + ! + ! Send mlon0 to the west neighbor, and mlon1 to the east. + ! However, tasks are periodic in longitude (see itask_table_mag), + ! and far west tasks send mlon0+1, and far east tasks send mlon1-1 + ! + do ifld=1,nf + ! Far west tasks send mlon0+1 to far east (periodic) tasks: + if (mytidi==0) then + sndlon0(:,ifld) = fmsub(mlon0+1,mlat0:mlat1,ifld) + ! Interior tasks send mlon0 to west neighbor: + else + sndlon0(:,ifld) = fmsub(mlon0,mlat0:mlat1,ifld) + endif + + ! Far east tasks send mlon1-1 to far west (periodic) tasks: + if (mytidi==nmagtaski-1) then + sndlon1(:,ifld) = fmsub(mlon1-1,mlat0:mlat1,ifld) + ! Interior tasks send mlon1 to east neighbor: + else + sndlon1(:,ifld) = fmsub(mlon1,mlat0:mlat1,ifld) + endif + enddo ! ifld=1,nf + ! + ! Send mlon0 to the west: + call mpi_isend(sndlon0,len,MPI_REAL8,west,1,mpi_comm_edyn,isend0,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos send mlon0 to west') + ! + ! Send mlon1 to the east: + call mpi_isend(sndlon1,len,MPI_REAL8,east,1,mpi_comm_edyn,isend1,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos send mlon1 to east') + ! + ! Recv mlon0-1 from west: + call mpi_irecv(rcvlon0,len,MPI_REAL8,west,1,mpi_comm_edyn,irecv0,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos recv mlon0 from west') + ! + ! Recv mlon1+1 from east: + call mpi_irecv(rcvlon1,len,MPI_REAL8,east,1,mpi_comm_edyn,irecv1,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos recv mlon1 from east') + ! + ! Wait for completions: + ireq = (/isend0,isend1,irecv0,irecv1/) + istat = 0 + call mpi_waitall(4,ireq,istat,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos waitall for lons') + ! + ! Copy mlon0-1 from rcvlon0, and mlon1+1 from rcvlon1: + do ifld=1,nf + fmsub(mlon0-1,mlat0:mlat1,ifld) = rcvlon0(:,ifld) + fmsub(mlon1+1,mlat0:mlat1,ifld) = rcvlon1(:,ifld) + ! + ! Fix special case of 2 tasks in longitude dimension: + if (east == west) then + fmsub(mlon0-1,mlat0:mlat1,ifld) = rcvlon1(:,ifld) + fmsub(mlon1+1,mlat0:mlat1,ifld) = rcvlon0(:,ifld) + endif + enddo ! ifld=1,nf + ! + ! Now exchange latitudes: + sndlat0 = 0._r8 ; rcvlat0 = 0._r8 + sndlat1 = 0._r8 ; rcvlat1 = 0._r8 + + south = itask_table_mag(mytidi,mytidj-1) ! neighbor to south + north = itask_table_mag(mytidi,mytidj+1) ! neighbor to north + ! + ! Include halo longitudes that were defined by the exchanges above: + nmlons = (mlon1+1)-(mlon0-1)+1 + len = nmlons*nf + ! + ! Send mlat0 to south neighbor, and mlat1 to north: + do ifld=1,nf + sndlat0(:,ifld) = fmsub(:,mlat0,ifld) + sndlat1(:,ifld) = fmsub(:,mlat1,ifld) + enddo + ! + ! Send mlat0 to south: + call mpi_isend(sndlat0,len,MPI_REAL8,south,1,mpi_comm_edyn,isend0,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos send mlat0 to south') + ! + ! Send mlat1 to north: + call mpi_isend(sndlat1,len,MPI_REAL8,north,1,mpi_comm_edyn,isend1,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos send mlat1 to north') + ! + ! Recv mlat0-1 from south: + call mpi_irecv(rcvlat0,len,MPI_REAL8,south,1,mpi_comm_edyn,irecv0,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos recv mlat0-1 from south') + ! + ! Recv mlat1+1 from north: + call mpi_irecv(rcvlat1,len,MPI_REAL8,north,1,mpi_comm_edyn,irecv1,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos recv mlat1+1 from north') + ! + ! Wait for completions: + ireq = (/isend0,isend1,irecv0,irecv1/) + istat = 0 + call mpi_waitall(4,ireq,istat,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_mag_halos waitall for lats') + ! + ! Copy mlat0-1 from rcvlat0, and mlat1+1 from rcvlat1: + do ifld=1,nf + fmsub(:,mlat0-1,ifld) = rcvlat0(:,ifld) + fmsub(:,mlat1+1,ifld) = rcvlat1(:,ifld) + enddo ! ifld=1,nf + + end subroutine mp_mag_halos + !----------------------------------------------------------------------- + subroutine mp_geo_halos(fmsub,lev0,lev1,lon0,lon1,lat0,lat1,nf) + ! + ! Exchange halo/ghost points between geographic grid subdomains for nf fields. + ! Two halo points are set in both lon and lat dimensions. + ! Longitude halos are done first, then latitude halos are done, including + ! longitude halos that were defined first). + ! + ! Args: integer,intent(in) :: lev0,lev1,lon0,lon1,lat0,lat1,nf type(array_ptr_type) :: fmsub(nf) ! (lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2) -! -! Local: + ! + ! Local: integer :: k,i,ifld,west,east,north,south,len,isend0,isend1, & - irecv0,irecv1,ier,nlats,istat(MPI_STATUS_SIZE,4),ireq(4),nlons + irecv0,irecv1,ier,nlats,istat(MPI_STATUS_SIZE,4),ireq(4),nlons real(r8),dimension(lev0:lev1,2,lat1-lat0+1,nf) :: & - sndlon0,sndlon1,rcvlon0,rcvlon1 + sndlon0,sndlon1,rcvlon0,rcvlon1 real(r8),dimension(lev0:lev1,2,(lon1+2)-(lon0-2)+1,nf) :: & - sndlat0,sndlat1,rcvlat0,rcvlat1 + sndlat0,sndlat1,rcvlat0,rcvlat1 -! if (mpi_timing) starttime = mpi_wtime() -! -! Init send/recv buffers for lon halos: + ! if (mpi_timing) starttime = mpi_wtime() + ! + ! Init send/recv buffers for lon halos: sndlon0 = 0._r8 ; rcvlon0 = 0._r8 sndlon1 = 0._r8 ; rcvlon1 = 0._r8 -! -! Identify east and west neighbors: + ! + ! Identify east and west neighbors: west = itask_table_geo(mytidi-1,mytidj) east = itask_table_geo(mytidi+1,mytidj) -! -! Exchange lat0:lat1 (lat halos are not yet defined): + ! + ! Exchange lat0:lat1 (lat halos are not yet defined): nlats = lat1-lat0+1 len = (lev1-lev0+1)*2*nlats*nf -! -! Send lon0:lon0+1 to the west neighbor, and lon1-1:lon1 to the east. -! + ! + ! Send lon0:lon0+1 to the west neighbor, and lon1-1:lon1 to the east. + ! do ifld=1,nf - do i=1,2 - do k=lev0,lev1 - sndlon0(k,i,:,ifld) = fmsub(ifld)%ptr(k,lon0+i-1,lat0:lat1) ! lon0, lon0+1 - sndlon1(k,i,:,ifld) = fmsub(ifld)%ptr(k,lon1+i-2,lat0:lat1) ! lon1-1, lon1 - enddo - enddo + do i=1,2 + do k=lev0,lev1 + sndlon0(k,i,:,ifld) = fmsub(ifld)%ptr(k,lon0+i-1,lat0:lat1) ! lon0, lon0+1 + sndlon1(k,i,:,ifld) = fmsub(ifld)%ptr(k,lon1+i-2,lat0:lat1) ! lon1-1, lon1 + enddo + enddo enddo ! ifld=1,nf -! -! Send lon0:lon0+1 to the west: + ! + ! Send lon0:lon0+1 to the west: call mpi_isend(sndlon0,len,MPI_REAL8,west,1,mpi_comm_edyn,isend0,ier) if (ier /= 0) call handle_mpi_err(ier, & - 'mp_geo_halos send lon0:lon0+1 to west') -! -! Send lon1-1:lon1 to the east: + 'mp_geo_halos send lon0:lon0+1 to west') + ! + ! Send lon1-1:lon1 to the east: call mpi_isend(sndlon1,len,MPI_REAL8,east,1,mpi_comm_edyn,isend1,ier) if (ier /= 0) call handle_mpi_err(ier, & - 'mp_geo_halos send lon1-1:lon1 to east') -! -! Recv lon0-2:lon0-1 from west: + 'mp_geo_halos send lon1-1:lon1 to east') + ! + ! Recv lon0-2:lon0-1 from west: call mpi_irecv(rcvlon0,len,MPI_REAL8,west,1,mpi_comm_edyn,irecv0,ier) if (ier /= 0) call handle_mpi_err(ier, & - 'mp_geo_halos recv lon0-2:lon0-1 from west') -! -! Recv lon1+1:lon1+2 from east: + 'mp_geo_halos recv lon0-2:lon0-1 from west') + ! + ! Recv lon1+1:lon1+2 from east: call mpi_irecv(rcvlon1,len,MPI_REAL8,east,1,mpi_comm_edyn,irecv1,ier) if (ier /= 0) call handle_mpi_err(ier, & - 'mp_geo_halos recv lon1+1:lon1+2 from east') -! -! Wait for completions: + 'mp_geo_halos recv lon1+1:lon1+2 from east') + ! + ! Wait for completions: ireq = (/isend0,isend1,irecv0,irecv1/) istat = 0 call mpi_waitall(4,ireq,istat,ier) if (ier /= 0) call handle_mpi_err(ier, & - 'mp_geo_halos waitall for lons') -! -! Copy lon0-2:lon0-1 from rcvlon0, and lon1+1:lon1+2 from rcvlon1: + 'mp_geo_halos waitall for lons') + ! + ! Copy lon0-2:lon0-1 from rcvlon0, and lon1+1:lon1+2 from rcvlon1: do ifld=1,nf - if (east /= west) then - do i=1,2 - do k=lev0,lev1 - fmsub(ifld)%ptr(k,lon0-3+i,lat0:lat1) = rcvlon0(k,i,:,ifld) ! lon0-2, lon0-1 - fmsub(ifld)%ptr(k,lon1+i ,lat0:lat1) = rcvlon1(k,i,:,ifld) ! lon1+1, lon1+2 - enddo - enddo ! i=1,2 -! -! Fix special case of 2 tasks in longitude dimension: - else ! east==west - do i=1,2 - do k=lev0,lev1 - fmsub(ifld)%ptr(k,lon0-3+i,lat0:lat1) = rcvlon1(k,i,:,ifld) ! lon0-2, lon0-1 - fmsub(ifld)%ptr(k,lon1+i ,lat0:lat1) = rcvlon0(k,i,:,ifld) ! lon1+1, lon1+2 + if (east /= west) then + do i=1,2 + do k=lev0,lev1 + fmsub(ifld)%ptr(k,lon0-3+i,lat0:lat1) = rcvlon0(k,i,:,ifld) ! lon0-2, lon0-1 + fmsub(ifld)%ptr(k,lon1+i ,lat0:lat1) = rcvlon1(k,i,:,ifld) ! lon1+1, lon1+2 + enddo + enddo ! i=1,2 + ! + ! Fix special case of 2 tasks in longitude dimension: + else ! east==west + do i=1,2 + do k=lev0,lev1 + fmsub(ifld)%ptr(k,lon0-3+i,lat0:lat1) = rcvlon1(k,i,:,ifld) ! lon0-2, lon0-1 + fmsub(ifld)%ptr(k,lon1+i ,lat0:lat1) = rcvlon0(k,i,:,ifld) ! lon1+1, lon1+2 + enddo enddo - enddo - endif ! east==west + endif ! east==west enddo ! ifld=1,nf -! -! Now exchange latitudes: + ! + ! Now exchange latitudes: sndlat0 = 0._r8 ; rcvlat0 = 0._r8 sndlat1 = 0._r8 ; rcvlat1 = 0._r8 south = itask_table_geo(mytidi,mytidj-1) ! neighbor to south north = itask_table_geo(mytidi,mytidj+1) ! neighbor to north -! -! Include halo longitudes that were defined by the exchanges above: - nlons = (lon1+2)-(lon0-2)+1 + ! + ! Include halo longitudes that were defined by the exchanges above: + nlons = (lon1+2)-(lon0-2)+1 len = (lev1-lev0+1)*2*nlons*nf -! -! Send lat0:lat0+1 to south neighbor, and lat1-1:lat1 to north: + ! + ! Send lat0:lat0+1 to south neighbor, and lat1-1:lat1 to north: do ifld=1,nf - do k=lev0,lev1 - sndlat0(k,1,:,ifld) = fmsub(ifld)%ptr(k,:,lat0 ) ! send lat0 to south - sndlat0(k,2,:,ifld) = fmsub(ifld)%ptr(k,:,lat0+1) ! send lat0+1 to south + do k=lev0,lev1 + sndlat0(k,1,:,ifld) = fmsub(ifld)%ptr(k,:,lat0 ) ! send lat0 to south + sndlat0(k,2,:,ifld) = fmsub(ifld)%ptr(k,:,lat0+1) ! send lat0+1 to south - sndlat1(k,1,:,ifld) = fmsub(ifld)%ptr(k,:,lat1 ) ! send lat1 to north - sndlat1(k,2,:,ifld) = fmsub(ifld)%ptr(k,:,lat1-1) ! send lat1-1 to north - enddo + sndlat1(k,1,:,ifld) = fmsub(ifld)%ptr(k,:,lat1 ) ! send lat1 to north + sndlat1(k,2,:,ifld) = fmsub(ifld)%ptr(k,:,lat1-1) ! send lat1-1 to north + enddo enddo -! -! Send lat0:lat0+1 to south (matching recv is lat1+1:lat1+2): + ! + ! Send lat0:lat0+1 to south (matching recv is lat1+1:lat1+2): call mpi_isend(sndlat0,len,MPI_REAL8,south,100,mpi_comm_edyn,isend0,ier) if (ier /= 0) call handle_mpi_err(ier, & - 'mp_geo_halos send lat0:lat0+1 to south') -! -! Send lat1-1:lat1 to north (matching recv is lat0-2:lat0-1): + 'mp_geo_halos send lat0:lat0+1 to south') + ! + ! Send lat1-1:lat1 to north (matching recv is lat0-2:lat0-1): call mpi_isend(sndlat1,len,MPI_REAL8,north,101,mpi_comm_edyn,isend1,ier) if (ier /= 0) call handle_mpi_err(ier, & - 'mp_geo_halos send lat1-1:lat1 to north') -! -! Recv lat0-2:lat0-1 from south: + 'mp_geo_halos send lat1-1:lat1 to north') + ! + ! Recv lat0-2:lat0-1 from south: call mpi_irecv(rcvlat0,len,MPI_REAL8,south,101,mpi_comm_edyn,irecv0,ier) if (ier /= 0) call handle_mpi_err(ier, & - 'mp_geo_halos recv lat0-2:lat0-1 from south') -! -! Recv lat1+1:lat1+2 from north: + 'mp_geo_halos recv lat0-2:lat0-1 from south') + ! + ! Recv lat1+1:lat1+2 from north: call mpi_irecv(rcvlat1,len,MPI_REAL8,north,100,mpi_comm_edyn,irecv1,ier) if (ier /= 0) call handle_mpi_err(ier, & - 'mp_geo_halos recv lat1+1:lat1+2 from north') -! -! Wait for completions: + 'mp_geo_halos recv lat1+1:lat1+2 from north') + ! + ! Wait for completions: ireq = (/isend0,isend1,irecv0,irecv1/) istat = 0 call mpi_waitall(4,ireq,istat,ier) if (ier /= 0) call handle_mpi_err(ier, & - 'mp_geo_halos waitall for lats') -! -! Copy lat0-2:lat0-1 from rcvlat0, and lat1+1:lat1+2 from rcvlat1: + 'mp_geo_halos waitall for lats') + ! + ! Copy lat0-2:lat0-1 from rcvlat0, and lat1+1:lat1+2 from rcvlat1: do ifld=1,nf - do k=lev0,lev1 - fmsub(ifld)%ptr(k,:,lat0-1) = rcvlat0(k,1,:,ifld) ! recv lat0-1 from south - fmsub(ifld)%ptr(k,:,lat0-2) = rcvlat0(k,2,:,ifld) ! recv lat0-2 from south - - fmsub(ifld)%ptr(k,:,lat1+1) = rcvlat1(k,1,:,ifld) ! recv lat1+1 from north - fmsub(ifld)%ptr(k,:,lat1+2) = rcvlat1(k,2,:,ifld) ! recv lat1+2 from north - enddo -! -! Fix special case of 2 tasks in latitude dimension: -! Not sure if this will happen in WACCM: -! - if (north == south) then - call endrun('mp_geo_halos: north==south') - endif + do k=lev0,lev1 + fmsub(ifld)%ptr(k,:,lat0-1) = rcvlat0(k,1,:,ifld) ! recv lat0-1 from south + fmsub(ifld)%ptr(k,:,lat0-2) = rcvlat0(k,2,:,ifld) ! recv lat0-2 from south + + fmsub(ifld)%ptr(k,:,lat1+1) = rcvlat1(k,1,:,ifld) ! recv lat1+1 from north + fmsub(ifld)%ptr(k,:,lat1+2) = rcvlat1(k,2,:,ifld) ! recv lat1+2 from north + enddo + ! + ! Fix special case of 2 tasks in latitude dimension: + ! Not sure if this will happen in WACCM: + ! + if (north == south) then + call endrun('mp_geo_halos: north==south') + endif enddo ! ifld=1,nf - end subroutine mp_geo_halos -!----------------------------------------------------------------------- - subroutine mp_gather_edyn(fmsub,mlon0,mlon1,mlat0,mlat1,fmglb,nmlonp1,nmlat,nf) -! -! Gather fields on mag subdomains to root task, so root task can -! complete non-parallel portion of dynamo (starting after rhspde) -! -! Args: - integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nmlonp1,nmlat,nf - real(r8),intent(in) :: fmsub(mlon0:mlon1,mlat0:mlat1,nf) - real(r8),intent(out) :: fmglb(nmlonp1,nmlat,nf) -! -! Local: - integer :: len,i,j,ifld,ier - real(r8),dimension(nmlonp1,nmlat,nf) :: sndbuf - - sndbuf = 0._r8 - fmglb = 0._r8 - - len = nmlonp1*nmlat*nf -! -! Load send buffer with my subdomain: - do ifld=1,nf - do j=mlat0,mlat1 - do i=mlon0, mlon1 - sndbuf(i,j,ifld) = fmsub(i,j,ifld) - enddo - enddo - enddo - -! -! Gather to root by using scalable reduce method: - - call mpi_reduce(sndbuf, fmglb, len, MPI_REAL8, MPI_SUM, 0, mpi_comm_edyn, ier ) - if (ier /= 0) call handle_mpi_err(ier,'mp_gather_edyn: mpi_gather to root') - - end subroutine mp_gather_edyn -!----------------------------------------------------------------------- - subroutine mp_scatter_phim(phim_glb,phim) - real(r8),intent(in) :: phim_glb(nmlonp1,nmlat) - real(r8),intent(out) :: phim(mlon0:mlon1,mlat0:mlat1) -! -! Local: - integer :: ier,len,i,j - -! if (mpi_timing) starttime = mpi_wtime() -! -! Broadcast global phim (from pdynamo phim(nmlonp1,nmlat)): - len = nmlat*nmlonp1 - call mpi_bcast(phim_glb,len,MPI_REAL8,0,mpi_comm_edyn,ier) - if (ier /= 0) & - call handle_mpi_err(ier,'mp_scatter_phim: bcast global phim') -! -! Define subdomains: - do j=mlat0,mlat1 - do i=mlon0,mlon1 - phim(i,j) = phim_glb(i,j) + end subroutine mp_geo_halos + !----------------------------------------------------------------------- + subroutine mp_gather_edyn(fmsub,mlon0,mlon1,mlat0,mlat1,fmglb,nmlonp1,nmlat,nf) + ! + ! Gather fields on mag subdomains to root task, so root task can + ! complete non-parallel portion of dynamo (starting after rhspde) + ! + ! Args: + integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nmlonp1,nmlat,nf + real(r8),intent(in) :: fmsub(mlon0:mlon1,mlat0:mlat1,nf) + real(r8),intent(out) :: fmglb(nmlonp1,nmlat,nf) + ! + ! Local: + integer :: len,i,j,ifld,ier + real(r8),dimension(nmlonp1,nmlat,nf) :: sndbuf + + sndbuf = 0._r8 + fmglb = 0._r8 + + len = nmlonp1*nmlat*nf + ! + ! Load send buffer with my subdomain: + do ifld=1,nf + do j=mlat0,mlat1 + do i=mlon0, mlon1 + sndbuf(i,j,ifld) = fmsub(i,j,ifld) + enddo + enddo + enddo + + ! + ! Gather to root by using scalable reduce method: + + call mpi_reduce(sndbuf, fmglb, len, MPI_REAL8, MPI_SUM, 0, mpi_comm_edyn, ier ) + if (ier /= 0) call handle_mpi_err(ier,'mp_gather_edyn: mpi_gather to root') + + end subroutine mp_gather_edyn + !----------------------------------------------------------------------- + subroutine mp_scatter_phim(phim_glb,phim) + real(r8),intent(in) :: phim_glb(nmlonp1,nmlat) + real(r8),intent(out) :: phim(mlon0:mlon1,mlat0:mlat1) + ! + ! Local: + integer :: ier,len,i,j + + ! if (mpi_timing) starttime = mpi_wtime() + ! + ! Broadcast global phim (from pdynamo phim(nmlonp1,nmlat)): + len = nmlat*nmlonp1 + call mpi_bcast(phim_glb,len,MPI_REAL8,0,mpi_comm_edyn,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_scatter_phim: bcast global phim') + ! + ! Define subdomains: + do j=mlat0,mlat1 + do i=mlon0,mlon1 + phim(i,j) = phim_glb(i,j) + enddo enddo - enddo - - end subroutine mp_scatter_phim -!----------------------------------------------------------------------- - subroutine mp_mag_jslot(fin,mlon00,mlon11,mlat00,mlat11, & - fout,jneed,mxneed,nf) -! -! Current task needs to receive (from other tasks) field f at (non-zero) -! latitude indices in jneed, at all longitudes in the current subdomain. -! Note subdomains include halo points mlon0-1 and mlat1+1. Data in f also -! includes halo points (will need the lat data at halo-longitudes) -! -! Args: - integer,intent(in) :: mlon00,mlon11,mlat00,mlat11 ! subdomains w/ halos - integer,intent(in) :: nf ! number of fields - integer,intent(in) :: mxneed ! max number of needed lats (nmlat+2) - integer,intent(in) :: jneed(mxneed) ! j-indices of needed lats (where /= -1) - real(r8),intent(in) :: fin(mlon00:mlon11,mlat00:mlat11,nf) ! data at current subdomain - real(r8),intent(out) :: fout(mlon00:mlon11,mxneed,nf) ! returned data at needed lats - ! - ! Local: - integer,parameter :: sndbuf_cntr_max = 20 ! Maximum number of ibsend from one mpi task - integer :: ier,njneed,i,j,n,nj,idest, & - icount,len,nlons,isrc,msgid,ifld,sndbuf_cntr - integer :: tij ! rank in cols_comm (0 to nmagtaskj-1) - integer :: jhave(mxneed),njhave,wid - integer :: peersneed(mxneed,0:nmagtaskj-1) - integer :: jneedall (mxneed,0:nmagtaskj-1) - real(r8) :: sndbuf(mxmaglon+2,mxneed,nf,sndbuf_cntr_max) - real(r8) :: rcvbuf(mxmaglon+2,mxneed,nf) - real(r8) :: buffer((mxmaglon+2)*mxneed*nf*sndbuf_cntr_max) - integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status - integer :: isstat(MPI_STATUS_SIZE,sndbuf_cntr_max) !mpi_ibsend wait status - integer :: ibsend_requests(sndbuf_cntr_max) !array of ibsend requests - - sndbuf = 0._r8 - rcvbuf = 0._r8 - njneed = 0 - ibsend_requests = 0 - sndbuf_cntr = 0 - do j=1,mxneed - if (jneed(j) /= -1) njneed=njneed+1 - enddo - if (any(jneed(1:njneed)==-1)) call endrun('mp_mag_jslot jneed') - ! - call MPI_Comm_rank(cols_comm,tij,ier) - call MPI_buffer_attach(buffer,(mxmaglon+2)*mxneed*nf*sndbuf_cntr_max,ier) - if (ier /= 0) & - call handle_mpi_err(ier,'mp_mag_jslot call mpi_buffer_attach') - - ! - ! Send needed lat indices to all tasks in my column: - ! (redundant for alltoall) - do n=0,nmagtaskj-1 - jneedall(:,n) = jneed(:) - enddo - - call mpi_alltoall(jneedall,mxneed,MPI_INTEGER, & - peersneed,mxneed,MPI_INTEGER,cols_comm,ier) - if (ier /= 0) & - call handle_mpi_err(ier,'mp_mag_jslot call mpi_alltoall') - ! - ! Check if I have any needed lats, and who to send to: - do n=0,nmagtaskj-1 - if (n==tij) cycle - njhave = 0 + + end subroutine mp_scatter_phim + !----------------------------------------------------------------------- + subroutine mp_mag_jslot(fin,mlon00,mlon11,mlat00,mlat11, & + fout,jneed,mxneed,nf) + ! + ! Current task needs to receive (from other tasks) field f at (non-zero) + ! latitude indices in jneed, at all longitudes in the current subdomain. + ! Note subdomains include halo points mlon0-1 and mlat1+1. Data in f also + ! includes halo points (will need the lat data at halo-longitudes) + ! + ! Args: + integer,intent(in) :: mlon00,mlon11,mlat00,mlat11 ! subdomains w/ halos + integer,intent(in) :: nf ! number of fields + integer,intent(in) :: mxneed ! max number of needed lats (nmlat+2) + integer,intent(in) :: jneed(mxneed) ! j-indices of needed lats (where /= -1) + real(r8),intent(in) :: fin(mlon00:mlon11,mlat00:mlat11,nf) ! data at current subdomain + real(r8),intent(out) :: fout(mlon00:mlon11,mxneed,nf) ! returned data at needed lats + ! + ! Local: + integer,parameter :: sndbuf_cntr_max = 40 ! Maximum number of ibsend from one mpi task + integer :: ier,njneed,i,j,n,nj,idest, & + icount,len,nlons,isrc,msgid,ifld,sndbuf_cntr + integer :: tij ! rank in cols_comm (0 to nmagtaskj-1) + integer :: jhave(mxneed),njhave,wid + integer :: peersneed(mxneed,0:nmagtaskj-1) + integer :: jneedall (mxneed,0:nmagtaskj-1) + real(r8) :: sndbuf(mxmaglon+2,mxneed,nf,sndbuf_cntr_max) + real(r8) :: rcvbuf(mxmaglon+2,mxneed,nf) + real(r8) :: buffer((mxmaglon+2)*mxneed*nf*sndbuf_cntr_max) + integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status + integer :: isstat(MPI_STATUS_SIZE,sndbuf_cntr_max) !mpi_ibsend wait status + integer :: ibsend_requests(sndbuf_cntr_max) !array of ibsend requests + + sndbuf = 0._r8 + rcvbuf = 0._r8 + njneed = 0 + ibsend_requests = 0 + sndbuf_cntr = 0 do j=1,mxneed - if (peersneed(j,n) >= mlat00.and.peersneed(j,n) <= mlat11)then - njhave = njhave+1 - jhave(njhave) = peersneed(j,n) - idest = n - wid = itask_table_geo(mytidi,idest) - endif + if (jneed(j) /= -1) njneed=njneed+1 enddo - if (njhave > 0) then - - sndbuf_cntr = sndbuf_cntr + 1 - if (sndbuf_cntr > sndbuf_cntr_max) call endrun('sndbuf_cntr exceeded sndbuf_cntr_max') - - ! - ! Load send buffer: - nlons = mlon11-mlon00+1 - do ifld=1,nf - do j=1,njhave - do i=mlon00,mlon11 - sndbuf(i-mlon00+1,j,ifld,sndbuf_cntr) = fin(i,jhave(j),ifld) - enddo - enddo - enddo - len = nlons*njhave*nf - msgid = mytid+wid*10000 - call mpi_ibsend(sndbuf(1:nlons,1:njhave,:,sndbuf_cntr),len,MPI_REAL8, & - idest,msgid,cols_comm,ibsend_requests(sndbuf_cntr),ier) - if (ier /= 0) & - call handle_mpi_err(ier,'mp_mag_jslot call mpi_ibsend') - endif - enddo ! n=0,nmagtaskj-1 - - call MPI_waitall(sndbuf_cntr,ibsend_requests,isstat,ier) - if (ier /= 0) & - call handle_mpi_err(ier,'mp_mag_jslot call mpi_waitall') - call MPI_buffer_detach(buffer,(mxmaglon+2)*mxneed*nf*sndbuf_cntr_max,ier) - if (ier /= 0) & - call handle_mpi_err(ier,'mp_mag_jslot call mpi_buffer_detach') - - ! - ! Determine which tasks to receive which lats from. Task to - ! receive from must be in same task column magtidi as I am. - if (njneed > 0) then - njhave = 0 - jhave(:) = -1 - do n=0,ntask-1 - njhave = 0 - do j=1,njneed - if (jneed(j) >= tasks(n)%mlat0-1 .and. & - jneed(j) <= tasks(n)%mlat1+1) then - njhave = njhave+1 - jhave(njhave) = jneed(j) - endif - enddo - if (njhave > 0 .and. tasks(n)%magtidi==magtidi) then - isrc = tasks(n)%magtidj ! task id in cols_comm to recv from - nlons = mlon11-mlon00+1 - len = nlons*njhave*nf - msgid = mytid*10000+n - rcvbuf = 0._r8 - call mpi_recv(rcvbuf(1:nlons,1:njhave,:),len,MPI_REAL8, & - isrc,msgid,cols_comm,irstat,ier) - if (ier /= 0) & - call handle_mpi_err(ier,'mp_mag_jslot call mpi_recv') - ! - ! Get data from receive buffer: - ! real,intent(out) :: fout(mlon00:mlon11,mxneed) ! returned data at needed lats - do ifld=1,nf - do j=1,njhave - nj = ixfind(jneed,mxneed,jhave(j),icount) - if (nj==0) call endrun('jhave(j) not in jneed') - do i=mlon00,mlon11 - fout(i,nj,ifld) = rcvbuf(i-mlon00+1,j,ifld) - enddo - enddo ! j=1,njhave - enddo ! ifld=1,nf - endif ! jhave > 0 - enddo ! n=0,ntask-1 - endif ! njneed > 0 - - end subroutine mp_mag_jslot -!----------------------------------------------------------------------- - subroutine mp_gatherlons_f3d(f,k0,k1,i0,i1,j0,j1,nflds) -! -! Gather longitude data in a row of tasks to leftmost task in the row. -! On entry f(k0:k1,i0:i1,j0:j1,nflds) is defined for current task. -! On exit f(k0:k1,nlonp4,j0:j1,nflds) is defined for task with mytidi==0. -! - -! -! Args: -! - integer,intent(in) :: k0,k1,i0,i1,j0,j1,nflds -! real(r8),intent(inout) :: f(k0:k1,nlon,j0:j1,nflds) - type(array_ptr_type) :: f(nflds) ! f(n)%ptr(k0:k1,nlon,j0:j1) -! -! Local: -! - integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status - integer :: j,n,nlons,nlonrecv,nlevs,len,idest,isrc,ier, & - isend,irecv,itask,lonrecv0,lonrecv1,mtag - real(r8) :: & - sndbuf(k0:k1,mxlon,mxlat+4,nflds), & ! send buffer - rcvbuf(k0:k1,mxlon,mxlat+4,nflds) ! recv buffer -! -! Exec: -! - nlons = i1-i0+1 - nlevs = k1-k0+1 - - sndbuf = 0._r8 - rcvbuf = 0._r8 - len = nlevs*mxlon*(mxlat+4)*nflds ! +4 is for when this is called from mp_pole_halos -! -! If mytidi==0, receive from other tasks in my row (mytidi>0,mytidj): - if (mytidi == 0) then - do itask=1,ntaski-1 - isrc = itask_table_geo(itask,mytidj) - mtag = isrc+mytid - call mpi_irecv(rcvbuf,len,MPI_REAL8,isrc,mtag,mpi_comm_edyn,irecv,ier) - if (ier /= 0) & - call handle_mpi_err(ier,'mp_gatherlons_f3d recv fm isrc') - call mpi_wait(irecv,irstat,ier) - if (ier /= 0) & - call handle_mpi_err(ier,'mp_gatherlons_f3d wait for recv0') -! -! Copy data from receive buffer: - lonrecv0 = tasks(isrc)%lon0 - lonrecv1 = tasks(isrc)%lon1 - nlonrecv = lonrecv1-lonrecv0+1 - do n=1,nflds - do j=j0,j1 - f(n)%ptr(k0:k1,lonrecv0:lonrecv1,j) = rcvbuf(k0:k1,1:nlonrecv,j-j0+1,n) - enddo ! j=j0,j1 - enddo ! n=1,nflds - enddo ! itask=1,ntaski-1 -! -! If mytidi > 0, load send buffer, and send to task (0,mytidj): - else ! mytidi /= 0 - idest = itask_table_geo(0,mytidj) - do n=1,nflds - do j=j0,j1 - sndbuf(:,1:nlons,j-j0+1,n) = f(n)%ptr(k0:k1,i0:i1,j) - enddo ! j=j0,j1 - enddo ! n=1,nflds - mtag = idest+mytid - call mpi_isend(sndbuf,len,MPI_REAL8,idest,mtag,mpi_comm_edyn,isend,ier) + if (any(jneed(1:njneed)==-1)) call endrun('mp_mag_jslot jneed') + ! + call MPI_Comm_rank(cols_comm,tij,ier) + call MPI_buffer_attach(buffer,(mxmaglon+2)*mxneed*nf*sndbuf_cntr_max,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_mag_jslot call mpi_buffer_attach') + + ! + ! Send needed lat indices to all tasks in my column: + ! (redundant for alltoall) + do n=0,nmagtaskj-1 + jneedall(:,n) = jneed(:) + enddo + + call mpi_alltoall(jneedall,mxneed,MPI_INTEGER, & + peersneed,mxneed,MPI_INTEGER,cols_comm,ier) if (ier /= 0) & - call handle_mpi_err(ier,'mp_gatherlons_f3d send0 to idest') - call mpi_wait(isend,irstat,ier) + call handle_mpi_err(ier,'mp_mag_jslot call mpi_alltoall') + ! + ! Check if I have any needed lats, and who to send to: + do n=0,nmagtaskj-1 + if (n==tij) cycle + njhave = 0 + do j=1,mxneed + if (peersneed(j,n) >= mlat00.and.peersneed(j,n) <= mlat11)then + njhave = njhave+1 + jhave(njhave) = peersneed(j,n) + idest = n + wid = itask_table_geo(mytidi,idest) + endif + enddo + if (njhave > 0) then + + sndbuf_cntr = sndbuf_cntr + 1 + if (sndbuf_cntr > sndbuf_cntr_max) call endrun('sndbuf_cntr exceeded sndbuf_cntr_max') + + ! + ! Load send buffer: + nlons = mlon11-mlon00+1 + do ifld=1,nf + do j=1,njhave + do i=mlon00,mlon11 + sndbuf(i-mlon00+1,j,ifld,sndbuf_cntr) = fin(i,jhave(j),ifld) + enddo + enddo + enddo + len = nlons*njhave*nf + msgid = mytid+wid*10000 + call mpi_ibsend(sndbuf(1:nlons,1:njhave,:,sndbuf_cntr),len,MPI_REAL8, & + idest,msgid,cols_comm,ibsend_requests(sndbuf_cntr),ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_mag_jslot call mpi_ibsend') + endif + enddo ! n=0,nmagtaskj-1 + + call MPI_waitall(sndbuf_cntr,ibsend_requests,isstat,ier) if (ier /= 0) & - call handle_mpi_err(ier,'mp_gatherlons_f3d wait for send0') - endif ! mytidi==0 - end subroutine mp_gatherlons_f3d -!----------------------------------------------------------------------- - subroutine mp_scatterlons_f3d(f,k0,k1,i0,i1,j0,j1,nflds) -! -! Redistribute longitudes from left most task in j-row to other tasks -! in the row. -! On input, f(:,nlonp4,j0:j1,nflds) is defined for tasks with mytidi==0. -! On output, f(:,i0:i1,j0:j1,nflds) is defined for all tasks. -! -! Args: -! - integer,intent(in) :: k0,k1,i0,i1,j0,j1,nflds - type(array_ptr_type) :: f(nflds) ! f(n)%ptr(k0:k1,nlon,j0:j1) -! -! Local: -! - integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status - integer :: j,n,nlevs,nlons,nlonsend,len,idest,isrc,ier, & - isend,irecv,itask,lonsend0,lonsend1,mtag - real(r8) :: & - sndbuf(k0:k1,mxlon,mxlat+4,nflds), & ! send buffer - rcvbuf(k0:k1,mxlon,mxlat+4,nflds) ! recv buffer -! -! Exec: -! - nlons = i1-i0+1 - nlevs = k1-k0+1 - - sndbuf = 0._r8 ; rcvbuf = 0._r8 - len = nlevs*mxlon*(mxlat+4)*nflds ! +4 is for when this is called from mp_pole_halos -! -! If mytidi==0, send to other tasks in my row (mytidi>0,mytidj): - if (mytidi == 0) then - do itask=1,ntaski-1 - idest = itask_table_geo(itask,mytidj) - lonsend0 = tasks(idest)%lon0 - lonsend1 = tasks(idest)%lon1 - nlonsend = lonsend1-lonsend0+1 - mtag = idest+mytid - do n=1,nflds - do j=j0,j1 - sndbuf(:,1:nlonsend,j-j0+1,n) = f(n)%ptr(:,lonsend0:lonsend1,j) - enddo ! j=j0,j1 - enddo ! n=1,nflds - mtag = idest+mytid - call mpi_isend(sndbuf,len,MPI_REAL8,idest,mtag,mpi_comm_edyn,isend,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_scatterlons_f3d send to idest') - call mpi_wait(isend,irstat,ier) - if (ier /= 0) call handle_mpi_err(ier,'mp_scatterlons_f3d wait for send') - enddo ! itask=1,ntaski-1 -! -! If mytidi > 0, receive from task (0,mytidj): - else - isrc = itask_table_geo(0,mytidj) - mtag = isrc+mytid - call mpi_irecv(rcvbuf,len,MPI_REAL8,isrc,mtag,mpi_comm_edyn,irecv,ier) + call handle_mpi_err(ier,'mp_mag_jslot call mpi_waitall') + call MPI_buffer_detach(buffer,(mxmaglon+2)*mxneed*nf*sndbuf_cntr_max,ier) if (ier /= 0) & - call handle_mpi_err(ier,'mp_scatterlons_f3d recv fm isrc') - call mpi_wait(irecv,irstat,ier) - if (ier /= 0) & - call handle_mpi_err(ier,'mp_scatterlons_f3d wait for recv') - do n=1,nflds - do j=j0,j1 - f(n)%ptr(:,i0:i1,j) = rcvbuf(:,1:nlons,j-j0+1,n) - enddo ! j=j0,j1 - enddo ! n=1,nflds - endif - end subroutine mp_scatterlons_f3d -!----------------------------------------------------------------------- - subroutine handle_mpi_err(ierrcode,string) -! -! Args: - integer,intent(in) :: ierrcode - character(len=*) :: string -! -! Local: - character(len=80) :: errstring - integer :: len_errstring, ierr -! - call mpi_error_string(ierrcode,errstring,len_errstring, ierr) - write(iulog,"(/,'>>> mpi error: ',a)") trim(string) - write(iulog,"(' ierrcode=',i3,': ',a)") trim(errstring) - end subroutine handle_mpi_err -!----------------------------------------------------------------------- - integer function ixfind(iarray,idim,itarget,icount) -! -! Search iarray(idim) for itarget, returning first index in iarray -! where iarray(idim)==target. Also return number of elements of -! iarray that == itarget in icount. -! -! Args: - integer,intent(in) :: idim,itarget - integer,intent(in) :: iarray(idim) - integer,intent(out) :: icount -! -! Local: - integer :: i -! - ixfind = 0 - icount = 0 - if (.not.any(iarray==itarget)) return - icount = count(iarray==itarget) - do i=1,idim - if (iarray(i)==itarget) then - ixfind = i - exit + call handle_mpi_err(ier,'mp_mag_jslot call mpi_buffer_detach') + + ! + ! Determine which tasks to receive which lats from. Task to + ! receive from must be in same task column magtidi as I am. + if (njneed > 0) then + njhave = 0 + jhave(:) = -1 + do n=0,ntask-1 + njhave = 0 + do j=1,njneed + if (jneed(j) >= tasks(n)%mlat0-1 .and. & + jneed(j) <= tasks(n)%mlat1+1) then + njhave = njhave+1 + jhave(njhave) = jneed(j) + endif + enddo + if (njhave > 0 .and. tasks(n)%magtidi==magtidi) then + isrc = tasks(n)%magtidj ! task id in cols_comm to recv from + nlons = mlon11-mlon00+1 + len = nlons*njhave*nf + msgid = mytid*10000+n + rcvbuf = 0._r8 + call mpi_recv(rcvbuf(1:nlons,1:njhave,:),len,MPI_REAL8, & + isrc,msgid,cols_comm,irstat,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_mag_jslot call mpi_recv') + ! + ! Get data from receive buffer: + ! real,intent(out) :: fout(mlon00:mlon11,mxneed) ! returned data at needed lats + do ifld=1,nf + do j=1,njhave + nj = ixfind(jneed,mxneed,jhave(j),icount) + if (nj==0) call endrun('jhave(j) not in jneed') + do i=mlon00,mlon11 + fout(i,nj,ifld) = rcvbuf(i-mlon00+1,j,ifld) + enddo + enddo ! j=1,njhave + enddo ! ifld=1,nf + endif ! jhave > 0 + enddo ! n=0,ntask-1 + endif ! njneed > 0 + + end subroutine mp_mag_jslot + !----------------------------------------------------------------------- + subroutine mp_gatherlons_f3d(f,k0,k1,i0,i1,j0,j1,nflds) + ! + ! Gather longitude data in a row of tasks to leftmost task in the row. + ! On entry f(k0:k1,i0:i1,j0:j1,nflds) is defined for current task. + ! On exit f(k0:k1,nlonp4,j0:j1,nflds) is defined for task with mytidi==0. + ! + + ! + ! Args: + ! + integer,intent(in) :: k0,k1,i0,i1,j0,j1,nflds + ! real(r8),intent(inout) :: f(k0:k1,nlon,j0:j1,nflds) + type(array_ptr_type) :: f(nflds) ! f(n)%ptr(k0:k1,nlon,j0:j1) + ! + ! Local: + ! + integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status + integer :: j,n,nlons,nlonrecv,nlevs,len,idest,isrc,ier, & + isend,irecv,itask,lonrecv0,lonrecv1,mtag + real(r8) :: & + sndbuf(k0:k1,mxlon,mxlat+4,nflds), & ! send buffer + rcvbuf(k0:k1,mxlon,mxlat+4,nflds) ! recv buffer + ! + ! Exec: + ! + nlons = i1-i0+1 + nlevs = k1-k0+1 + + sndbuf = 0._r8 + rcvbuf = 0._r8 + len = nlevs*mxlon*(mxlat+4)*nflds ! +4 is for when this is called from mp_pole_halos + ! + ! If mytidi==0, receive from other tasks in my row (mytidi>0,mytidj): + if (mytidi == 0) then + do itask=1,ntaski-1 + isrc = itask_table_geo(itask,mytidj) + mtag = isrc+mytid + call mpi_irecv(rcvbuf,len,MPI_REAL8,isrc,mtag,mpi_comm_edyn,irecv,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_gatherlons_f3d recv fm isrc') + call mpi_wait(irecv,irstat,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_gatherlons_f3d wait for recv0') + ! + ! Copy data from receive buffer: + lonrecv0 = tasks(isrc)%lon0 + lonrecv1 = tasks(isrc)%lon1 + nlonrecv = lonrecv1-lonrecv0+1 + do n=1,nflds + do j=j0,j1 + f(n)%ptr(k0:k1,lonrecv0:lonrecv1,j) = rcvbuf(k0:k1,1:nlonrecv,j-j0+1,n) + enddo ! j=j0,j1 + enddo ! n=1,nflds + enddo ! itask=1,ntaski-1 + ! + ! If mytidi > 0, load send buffer, and send to task (0,mytidj): + else ! mytidi /= 0 + idest = itask_table_geo(0,mytidj) + do n=1,nflds + do j=j0,j1 + sndbuf(:,1:nlons,j-j0+1,n) = f(n)%ptr(k0:k1,i0:i1,j) + enddo ! j=j0,j1 + enddo ! n=1,nflds + mtag = idest+mytid + call mpi_isend(sndbuf,len,MPI_REAL8,idest,mtag,mpi_comm_edyn,isend,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_gatherlons_f3d send0 to idest') + call mpi_wait(isend,irstat,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_gatherlons_f3d wait for send0') + endif ! mytidi==0 + end subroutine mp_gatherlons_f3d + !----------------------------------------------------------------------- + subroutine mp_scatterlons_f3d(f,k0,k1,i0,i1,j0,j1,nflds) + ! + ! Redistribute longitudes from left most task in j-row to other tasks + ! in the row. + ! On input, f(:,nlonp4,j0:j1,nflds) is defined for tasks with mytidi==0. + ! On output, f(:,i0:i1,j0:j1,nflds) is defined for all tasks. + ! + ! Args: + ! + integer,intent(in) :: k0,k1,i0,i1,j0,j1,nflds + type(array_ptr_type) :: f(nflds) ! f(n)%ptr(k0:k1,nlon,j0:j1) + ! + ! Local: + ! + integer :: irstat(MPI_STATUS_SIZE) ! mpi receive status + integer :: j,n,nlevs,nlons,nlonsend,len,idest,isrc,ier, & + isend,irecv,itask,lonsend0,lonsend1,mtag + real(r8) :: & + sndbuf(k0:k1,mxlon,mxlat+4,nflds), & ! send buffer + rcvbuf(k0:k1,mxlon,mxlat+4,nflds) ! recv buffer + ! + ! Exec: + ! + nlons = i1-i0+1 + nlevs = k1-k0+1 + + sndbuf = 0._r8 ; rcvbuf = 0._r8 + len = nlevs*mxlon*(mxlat+4)*nflds ! +4 is for when this is called from mp_pole_halos + ! + ! If mytidi==0, send to other tasks in my row (mytidi>0,mytidj): + if (mytidi == 0) then + do itask=1,ntaski-1 + idest = itask_table_geo(itask,mytidj) + lonsend0 = tasks(idest)%lon0 + lonsend1 = tasks(idest)%lon1 + nlonsend = lonsend1-lonsend0+1 + mtag = idest+mytid + do n=1,nflds + do j=j0,j1 + sndbuf(:,1:nlonsend,j-j0+1,n) = f(n)%ptr(:,lonsend0:lonsend1,j) + enddo ! j=j0,j1 + enddo ! n=1,nflds + mtag = idest+mytid + call mpi_isend(sndbuf,len,MPI_REAL8,idest,mtag,mpi_comm_edyn,isend,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_scatterlons_f3d send to idest') + call mpi_wait(isend,irstat,ier) + if (ier /= 0) call handle_mpi_err(ier,'mp_scatterlons_f3d wait for send') + enddo ! itask=1,ntaski-1 + ! + ! If mytidi > 0, receive from task (0,mytidj): + else + isrc = itask_table_geo(0,mytidj) + mtag = isrc+mytid + call mpi_irecv(rcvbuf,len,MPI_REAL8,isrc,mtag,mpi_comm_edyn,irecv,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_scatterlons_f3d recv fm isrc') + call mpi_wait(irecv,irstat,ier) + if (ier /= 0) & + call handle_mpi_err(ier,'mp_scatterlons_f3d wait for recv') + do n=1,nflds + do j=j0,j1 + f(n)%ptr(:,i0:i1,j) = rcvbuf(:,1:nlons,j-j0+1,n) + enddo ! j=j0,j1 + enddo ! n=1,nflds endif - enddo - end function ixfind - -!----------------------------------------------------------------------- - subroutine setpoles(f,k0,k1,i0,i1,j0,j1) -! -! Args: - integer,intent(in) :: k0,k1,i0,i1,j0,j1 - real(r8),intent(inout) :: f(k0:k1,i0:i1,j0:j1) -! -! Local: - integer :: i,j,k,lon0,lon1,it,itask - type(array_ptr_type) :: ptr(1) - real(r8) :: fave(k0:k1) - real(r8) :: rnlon - - if (j0 /= 1 .and. j1 /= nlat) return ! subdomain does not include poles - - rnlon = dble(nlon) - allocate(ptr(1)%ptr(k0:k1,nlon,j0:j1)) -! -! Define subdomains in global longitude dimension of ptmp: -! - do j=j0,j1 - do i=i0,i1 - ptr(1)%ptr(k0:k1,i,j) = f(k0:k1,i,j) - enddo - enddo -! -! Get values for global longitudes at the latitude below each pole, -! average them at each level, and assign the average redundantly -! to all lons at each pole. -! - call mp_gatherlons_f3d(ptr,k0,k1,i0,i1,j0,j1,1) -! - if (mytidi==0) then ! only westernmost tasks have global longitudes - - if (j0 == 1) then ! subdomain includes south pole - fave(:) = 0._r8 -! -! Find average of all lons at each level, at first lat equatorward of south pole. -! - do k=k0,k1 - do i=1,nlon - fave(k) = fave(k)+ptr(1)%ptr(k,i,j0+1) - enddo - fave(k) = fave(k) / rnlon - enddo - if (debug.and.masterproc) write(iulog,"('setpoles: spole ave(k0:k1)=',/,(8es12.4))") fave -! -! Define south pole in ptmp on subdomains for each tasks in my latitude row -! (I am SW corner task): -! - do it=0,ntaski-1 - itask = tasks(itask_table_geo(it,mytidj))%mytid - lon0 = tasks(itask)%lon0 - lon1 = tasks(itask)%lon1 - do k=k0,k1 - ptr(1)%ptr(k,lon0:lon1,j0) = fave(k) ! all lons get the average - enddo - enddo - endif ! south pole - - if (j1 == nlat) then ! subdomain includes north pole - fave(:) = 0._r8 -! -! Find average of all lons at each level, at first lat equatorward of north pole. -! - do k=k0,k1 - do i=1,nlon - fave(k) = fave(k)+ptr(1)%ptr(k,i,j1-1) - enddo - fave(k) = fave(k) / rnlon - enddo - if (debug.and.masterproc) write(iulog,"('setpoles: npole fave(k0:k1)=',/,(8es12.4))") fave -! -! Define north pole in ptmp on subdomains for each tasks in my latitude row -! (I am NW corner task): -! - do it=0,ntaski-1 - itask = tasks(itask_table_geo(it,mytidj))%mytid - lon0 = tasks(itask)%lon0 - lon1 = tasks(itask)%lon1 - do k=k0,k1 - ptr(1)%ptr(k,lon0:lon1,j1) = fave(k) - enddo - enddo - endif ! north pole - endif ! mytidj==0 -! -! Scatter to tasks in my latitude row: -! - call mp_scatterlons_f3d(ptr,k0,k1,i0,i1,j0,j1,1) -! -! Define poles on current subdomain inout arg array: -! - if (j0==1) then - do i=i0,i1 - do k=k0,k1 - f(k,i,j0) = ptr(1)%ptr(k,i,j0) - enddo - enddo - endif - if (j1==nlat) then - do i=i0,i1 - do k=k0,k1 - f(k,i,j1) = ptr(1)%ptr(k,i,j1) - enddo - enddo - endif - deallocate(ptr(1)%ptr) - end subroutine setpoles -!----------------------------------------------------------------------- - subroutine lonshift_blocks(f,k0,k1,i0,i1,j0,j1,nfields) -! -! On input, field(s) f are in subdomains -! On output, field(s) f subdomain longitudes are shifted by 180 degrees -! (either 0->360 to -180->+180, or the reverse) -! - use edyn_geogrid ,only: nlon -! -! Args: - integer :: k0,k1,i0,i1,j0,j1,nfields - type(array_ptr_type) :: f(nfields) ! f(n)%ptr(k0:k1,i0:i1,j0:j1) -! -! Local variables -! - integer :: i,j,k,ifield - integer :: midpoint ! middle point of longitude dimension - real(r8) :: flons(nlon) ! fields at global longitudes - type(array_ptr_type) :: pglblon(nfields) ! pglblon(n)%ptr(k0:k1,nlon,j0:j1) -! -! Shift longitude grid from 0 to 360 to -180 to 180 for edynamo -! Check for compatible geographic longitude dimension and quit if not compatible -! - if (nlon /= 576 .and. nlon /= 288 .and. nlon /= 144 .and. nlon /= 80 .and. nlon /= 72 .and. nlon /= 24) then - write(iulog,"('ERROR lonshift_blocks: incompatible nlon = ',i5,' i0,i1=',2i4)") nlon,i0,i1 - call endrun - end if -! -! Load subdomains into local global longitude pointer: - do ifield=1,nfields - allocate(pglblon(ifield)%ptr(k0:k1,nlon,j0:j1)) - do j=j0,j1 - do i=i0,i1 - pglblon(ifield)%ptr(k0:k1,i,j) = f(ifield)%ptr(k0:k1,i,j) - enddo + end subroutine mp_scatterlons_f3d + !----------------------------------------------------------------------- + subroutine handle_mpi_err(ierrcode,string) + ! + ! Args: + integer,intent(in) :: ierrcode + character(len=*) :: string + ! + ! Local: + character(len=80) :: errstring + integer :: len_errstring, ierr + ! + call mpi_error_string(ierrcode,errstring,len_errstring, ierr) + write(iulog,"(/,'>>> mpi error: ',a)") trim(string) + write(iulog,"(' ierrcode=',i3,': ',a)") trim(errstring) + end subroutine handle_mpi_err + !----------------------------------------------------------------------- + integer function ixfind(iarray,idim,itarget,icount) + ! + ! Search iarray(idim) for itarget, returning first index in iarray + ! where iarray(idim)==target. Also return number of elements of + ! iarray that == itarget in icount. + ! + ! Args: + integer,intent(in) :: idim,itarget + integer,intent(in) :: iarray(idim) + integer,intent(out) :: icount + ! + ! Local: + integer :: i + ! + ixfind = 0 + icount = 0 + if (.not.any(iarray==itarget)) return + icount = count(iarray==itarget) + do i=1,idim + if (iarray(i)==itarget) then + ixfind = i + exit + endif enddo - enddo - - call mp_gatherlons_f3d(pglblon,k0,k1,i0,i1,j0,j1,nfields) -! -! Only leftmost tasks (mytidi=0) at each latitude does the longitude shift for that latitude -! - if (mytidi==0) then + end function ixfind + + !----------------------------------------------------------------------- + subroutine setpoles(f,k0,k1,i0,i1,j0,j1) + ! + ! Args: + integer,intent(in) :: k0,k1,i0,i1,j0,j1 + real(r8),intent(inout) :: f(k0:k1,i0:i1,j0:j1) + ! + ! Local: + integer :: i,j,k,lon0,lon1,it,itask + type(array_ptr_type) :: ptr(1) + real(r8) :: fave(k0:k1) + real(r8) :: rnlon + + if (j0 /= 1 .and. j1 /= nlat_geo) then + return ! subdomain does not include poles + end if + + rnlon = real(nlon_geo,kind=r8) + allocate(ptr(1)%ptr(k0:k1,nlon_geo,j0:j1)) + ! + ! Define subdomains in global longitude dimension of ptmp: + ! do j=j0,j1 - midpoint = nlon/2 - do ifield = 1,nfields - do k = k0,k1 - flons(:) = pglblon(ifield)%ptr(k,1:nlon,j) - flons = cshift(flons,midpoint) - pglblon(ifield)%ptr(k,1:nlon,j) = flons(:) - enddo ! k0,k1 - enddo ! nfields - enddo ! j=j0,j1 - endif ! mytidi==0 -! -! Now leftmost task at each j-row must redistribute filtered data -! back to other tasks in the j-row (mytidi>0,mytidj) (includes latitude): -! - call mp_scatterlons_f3d(pglblon,k0,k1,i0,i1,j0,j1,nfields) -! -! Update fields argument: - do ifield=1,nfields - do j=j0,j1 - do i=i0,i1 - f(ifield)%ptr(k0:k1,i,j) = pglblon(ifield)%ptr(k0:k1,i,j) - enddo + do i=i0,i1 + ptr(1)%ptr(k0:k1,i,j) = f(k0:k1,i,j) + enddo enddo - enddo - - do ifield=1,nfields - deallocate(pglblon(ifield)%ptr) - enddo - end subroutine lonshift_blocks -!----------------------------------------------------------------------- - subroutine switch_model_format(fptr,k0,k1,i0,i1,j0,j1,nfields) -! -! fptr is array of pointer structures to nfields fields. Convert these -! fields in "model format", i.e., phase shift longitude data by 180 degrees, -! and invert the vertical dimension. This may be converting from WACCM to -! TIEGCM, or the reverse. It is up to the calling routine to keep track of -! which model format the data is being converted from/to. -! (This routine does not do unit conversion on the fields) -! -! Args: - integer,intent(in) :: k0,k1,i0,i1,j0,j1,nfields -! -! Pointer structures to each field: - type(array_ptr_type) :: fptr(nfields) ! (fptr(n)%ptr(k0:k1,i0:i1,j0:j1)) -! -! Local: - integer :: ifield -! -! Phase shift longitudes by 180 degrees: -! - call lonshift_blocks(fptr,k0,k1,i0,i1,j0,j1,nfields) -! -! Invert vertical dimension: -! - do ifield=1,nfields - fptr(ifield)%ptr(k0:k1,i0:i1,j0:j1) = fptr(ifield)%ptr(k1:k0:-1,i0:i1,j0:j1) - enddo - end subroutine switch_model_format -!----------------------------------------------------------------------- + ! + ! Get values for global longitudes at the latitude below each pole, + ! average them at each level, and assign the average redundantly + ! to all lons at each pole. + ! + call mp_gatherlons_f3d(ptr,k0,k1,i0,i1,j0,j1,1) + ! + if (mytidi==0) then ! only westernmost tasks have global longitudes + + if (j0 == 1) then ! subdomain includes south pole + fave(:) = 0._r8 + ! + ! Find average of all lons at each level, at first lat equatorward of south pole. + ! + do k=k0,k1 + do i=1,nlon_geo + fave(k) = fave(k)+ptr(1)%ptr(k,i,j0+1) + enddo + fave(k) = fave(k) / rnlon + enddo + ! + ! Define south pole in ptmp on subdomains for each tasks in my latitude row + ! (I am SW corner task): + ! + do it=0,ntaski-1 + itask = tasks(itask_table_geo(it,mytidj))%mytid + lon0 = tasks(itask)%lon0 + lon1 = tasks(itask)%lon1 + do k=k0,k1 + ptr(1)%ptr(k,lon0:lon1,j0) = fave(k) ! all lons get the average + enddo + enddo + endif ! south pole + + if (j1 == nlat_geo) then ! subdomain includes north pole + fave(:) = 0._r8 + ! + ! Find average of all lons at each level, at first lat equatorward of north pole. + ! + do k=k0,k1 + do i=1,nlon_geo + fave(k) = fave(k)+ptr(1)%ptr(k,i,j1-1) + enddo + fave(k) = fave(k) / rnlon + enddo + if (debug.and.masterproc) write(iulog,"('setpoles: npole fave(k0:k1)=',/,(8es12.4))") fave + ! + ! Define north pole in ptmp on subdomains for each tasks in my latitude row + ! (I am NW corner task): + ! + do it=0,ntaski-1 + itask = tasks(itask_table_geo(it,mytidj))%mytid + lon0 = tasks(itask)%lon0 + lon1 = tasks(itask)%lon1 + do k=k0,k1 + ptr(1)%ptr(k,lon0:lon1,j1) = fave(k) + enddo + enddo + endif ! north pole + endif ! mytidj==0 + ! + ! Scatter to tasks in my latitude row: + ! + call mp_scatterlons_f3d(ptr,k0,k1,i0,i1,j0,j1,1) + ! + ! Define poles on current subdomain inout arg array: + ! + if (j0==1) then + do i=i0,i1 + do k=k0,k1 + f(k,i,j0) = ptr(1)%ptr(k,i,j0) + enddo + enddo + endif + if (j1==nlat_geo) then + do i=i0,i1 + do k=k0,k1 + f(k,i,j1) = ptr(1)%ptr(k,i,j1) + enddo + enddo + endif + deallocate(ptr(1)%ptr) + end subroutine setpoles end module edyn_mpi diff --git a/src/ionosphere/waccmx/edyn_mud.F90 b/src/ionosphere/waccmx/edyn_mud.F90 index 614fd52b9a..44c8416cbf 100644 --- a/src/ionosphere/waccmx/edyn_mud.F90 +++ b/src/ionosphere/waccmx/edyn_mud.F90 @@ -1,159 +1,20 @@ -!----------------------------------------------------------------------- - subroutine mud(pe,jntl,isolve) - use shr_kind_mod ,only: r8 => shr_kind_r8 - use cam_abortutils ,only: endrun - use edyn_solve,only: nc,ncee,cee -! - implicit none - integer,intent(in) :: isolve - integer jntl -! -! set grid size params -! - integer,parameter :: iixp = 5 , jjyq = 3, iiex = 5, jjey = 5 - integer,parameter :: nnx=iixp*2**(iiex-1)+1, nny=jjyq*2**(jjey-1)+1 -! -! estimate work space for point relaxation (see mud2cr.d) -! - integer,parameter :: llwork=(7*(nnx+2)*(nny+2)+76*nnx*nny)/3 - real(r8) :: phi(nnx,nny),rhs(nnx,nny),work(llwork) - real(r8) :: time0,time1 -! -! put integer and floating point argument names in contiguous -! storage for labelling in vectors iprm,fprm -! -! btf 1/21/14: dimension iprm(17) to match iprm in edyn_muh2cr.F90 -! integer iprm(16),mgopt(4) - integer iprm(17),mgopt(4) - real(r8) :: fprm(6) - integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nx,ny, & - iguess,maxcy,method,nwork,lwrkqd,itero - common/itmud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nx,ny, & - iguess,maxcy,method,nwork,lwrkqd,itero - real(r8) :: xa,xb,yc,yd,tolmax,relmax - common/ftmud2cr/xa,xb,yc,yd,tolmax,relmax - equivalence(intl,iprm) - equivalence(xa,fprm) - integer i,j,ierror - real(r8) :: PE(NNX,1) - integer maxcya - DATA MAXCYA/150/ - integer mm,nn,jj,jjj - real(r8) :: pi -! -! set input integer arguments -! - MM = NNX - NN = NNY - PI = 4._r8*ATAN(1._r8) -! -! SET INPUT INTEGER PARAMETERS -! - INTL = JNTL -! -! set boundary condition flags -! - nxa = 0 - nxb = 0 - nyc = 2 - nyd = 1 -! -! set grid sizes from parameter statements -! - ixp = iixp - jyq = jjyq - iex = iiex - jey = jjey - nx = nnx - ny = nny -! -! set multigrid arguments (w(2,1) cycling with fully weighted -! residual restriction and cubic prolongation) -! - mgopt(1) = 2 - mgopt(2) = 2 - mgopt(3) = 1 - mgopt(4) = 3 -! -! set for one cycle -! - maxcy = maxcya -! -! set no initial guess forcing full multigrid cycling -! - iguess = 0 -! -! set work space length approximation from parameter statement -! - nwork = llwork -! -! set line z relaxation -! - method = 3 -! -! set end points of solution rectangle in (x,y) space -! - xa = -pi - xb = pi - yc = 0.0_r8 - yd = 0.5_r8*pi -! -! set error control flag -! - tolmax = 0.01_r8 -! -! set right hand side in rhs -! initialize phi to zero -! - if (isolve >= 0) then ! called from dynamo - do i=1,nx - do j=1,ny - RHS(I,J) = CEE(I+(J-1)*NX+9*NX*NY) - phi(i,j) = 0.0_r8 - end do - end do -! -! set specified boundaries in phi -! - DO I=1,NX - PHI(I,NY) = RHS(I,NY)/CEE(I+(NY-1)*NX+8*NX*NY) - END DO -! -! set specified boundaries in phi -! - endif ! isolve -! -! intialization call -! - call mud2cr(iprm,fprm,work,rhs,phi,mgopt,ierror,isolve) - if (ierror.gt.0) call endrun('mud call init mud2cr') -! -! attempt solution -! - intl = 1 - call mud2cr(iprm,fprm,work,rhs,phi,mgopt,ierror,isolve) - if (ierror.gt.0) call endrun('mud call solve mud2cr') -! -! COPY PHI TO PE -! - DO J = 1,NY - JJ = NY+J-1 - JJJ = NY+1-J - DO I = 1,NX - PE(I,JJ) = PHI(I,J) - PE(I,JJJ) = PHI(I,J) - END DO - END DO -! ITRANS = 0 -! CALL EZCNTR(PE(1,JMX0),IMX0,JMX0) -! ITRANS = 1 -! CALL SET(.05,.95,.05,.95,-1.,1.,-1.,1.,1) -! CALL CONREC(PE(1,JMX0),IMX0,IMX0,JMX0,0.,0.,0.,1,0,-1430B) -! CALL FRAME -! ITRANS = 0 -! CALL EZCNTR(PE(1,JMX0),IMX0,JMX0) -! ITRANS = 1 - end subroutine mud +module edyn_mud + use shr_kind_mod,only: r8 => shr_kind_r8 + use cam_abortutils,only: endrun + use edyn_mudcom, only: cor2, res2, factri, factrp, prolon2, trsfc2, swk2 + + implicit none + + private + + public :: mud2cr1 + public :: dismd2cr + public :: adjmd2cr + public :: kcymd2cr + public :: relmd2cr + public :: resmd2cr + + contains !----------------------------------------------------------------------- ! ! file mud2cr.f (version 4.0 modified for Cicley 2/99) @@ -167,7 +28,7 @@ end subroutine mud ! ... For MUDPACK information, visit the website: ! (https://www2.cisl.ucar.edu/resources/legacy/mudpack) ! -! ... purpose +! ... purpose ! ! mud2cr attempts to produce a second order finite difference ! approximation to the two dimensional nonseparable elliptic @@ -180,7 +41,7 @@ end subroutine mud ! ... documentation ! ! see the documentation on above website for a complete discussion -! of how to use subroutine mud2cr. +! of how to use subroutine mud2cr. ! ! ... required MUDPACK files ! @@ -190,8 +51,7 @@ end subroutine mud ! subroutine mud2cr(iparm,fparm,work,rhs,phi,mgopt, & ierror,isolve) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none + integer,intent(in) :: isolve integer iparm,mgopt,ierror integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & @@ -353,8 +213,7 @@ subroutine mud2cr(iparm,fparm,work,rhs,phi,mgopt, & end subroutine mud2cr !----------------------------------------------------------------------- subroutine mud2cr1(nx,ny,rhsf,phif,wk) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none + integer nx,ny real(r8) :: phif(nx,ny),rhsf(nx,ny),wk(*) integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& @@ -484,12 +343,10 @@ subroutine mud2cr1(nx,ny,rhsf,phif,wk) end subroutine mud2cr1 !----------------------------------------------------------------------- subroutine kcymd2cr(wk) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! execute multigrid k cycle from kcur grid level ! kcycle=1 for v cycles, kcycle=2 for w cycles ! - implicit none real(r8) :: wk(*) integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& @@ -646,13 +503,11 @@ subroutine kcymd2cr(wk) end subroutine kcymd2cr !----------------------------------------------------------------------- subroutine dismd2cr(nx,ny,cf,tx,ty,wk,ier,isolve) - use edyn_solve,only: nc,ncee,cee,ceee - use shr_kind_mod ,only: r8 => shr_kind_r8 - use cam_abortutils ,only: endrun + use edyn_solver_coefs,only: nc,cee,ceee + use edyn_maggrid, only: res_nlev ! ! discretize elliptic pde for mud2cr, set nonfatal errors ! - implicit none integer,intent(in) :: isolve integer nx,ny,i,j,l,im1,jm1,ier,nnx,nny real(r8) :: cf(nx,ny,10),tx(nx,ny,*),ty(ny,nx,*) @@ -675,7 +530,7 @@ subroutine dismd2cr(nx,ny,cf,tx,ty,wk,ier,isolve) call endrun('dismd2cr in mud') ENDIF if (isolve >= 0) then - call ceee(cee(nc(6-klevel)),nx,ny,cf) + call ceee(cee(nc(res_nlev+1-klevel)),nx,ny,cf) endif ! ! set coefficient for specified boundaries @@ -792,11 +647,9 @@ subroutine dismd2cr(nx,ny,cf,tx,ty,wk,ier,isolve) end subroutine dismd2cr !----------------------------------------------------------------------- subroutine adjmd2cr(nx,ny,phi,cf) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! adjust righthand side in cf(i,j,10) for boundary conditions ! - implicit none integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& kcycle,iprer,ipost,intpol,kps @@ -838,12 +691,10 @@ subroutine adjmd2cr(nx,ny,phi,cf) end subroutine adjmd2cr !----------------------------------------------------------------------- subroutine resmd2cr(nx,ny,phi,ncx,ncy,phic,rhsc,cof,resf) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! restrict residual from fine to coarse mesh using fully weighted ! residual restriction ! - implicit none integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& kcycle,iprer,ipost,intpol,kps @@ -887,11 +738,9 @@ subroutine resmd2cr(nx,ny,phi,ncx,ncy,phic,rhsc,cof,resf) end subroutine resmd2cr !----------------------------------------------------------------------- subroutine relmd2cr(nx,ny,phi,cof,tx,ty,sum) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! relaxation for mud2 ! - implicit none integer nx,ny real(r8) :: phi(*),cof(*),tx(*),ty(*),sum(*) integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& @@ -914,11 +763,9 @@ subroutine relmd2cr(nx,ny,phi,cof,tx,ty,sum) end subroutine relmd2cr !----------------------------------------------------------------------- subroutine relmd2crp(nx,ny,phi,cof) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! gauss-seidel four color point relaxation ! - implicit none integer nx,ny,i,j,lcolor,i1,i2,i3,i4,it integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& @@ -1019,13 +866,11 @@ subroutine relmd2crp(nx,ny,phi,cof) end subroutine relmd2crp !----------------------------------------------------------------------- subroutine slxmd2cr(nx,ny,phi,cof,tx,sum) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! line relaxation in the x direction (periodic or nonperiodic) ! - implicit none - integer nx,ny,i,ib,j,ii + integer nx,ny,i,ib,j integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess,& maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& kcycle,iprer,ipost,intpol,kps @@ -1033,7 +878,6 @@ subroutine slxmd2cr(nx,ny,phi,cof,tx,sum) iguess, maxcy,method,nwork,lwork,itero,ngrid,& klevel,kcur,kcycle,iprer,ipost,intpol,kps real(r8) :: phi(0:nx+1,0:ny+1),cof(nx,ny,10),tx(nx,ny,*),sum(ny) - real(r8) :: starttime,endtime ! ! replace line x with point gauss-seidel if ! x direction is periodic and nx = 3 (coarsest) @@ -1212,8 +1056,6 @@ subroutine slxmd2cr(nx,ny,phi,cof,tx,sum) end subroutine slxmd2cr !----------------------------------------------------------------------- subroutine slymd2cr(nx,ny,phi,cof,ty,sum) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none integer nx,ny,i,j,jb integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & @@ -1223,7 +1065,6 @@ subroutine slymd2cr(nx,ny,phi,cof,ty,sum) iguess, maxcy,method,nwork,lwork,itero,ngrid, & klevel,kcur,kcycle,iprer,ipost,intpol,kps real(r8) :: phi(0:nx+1,0:ny+1),cof(nx,ny,10),ty(ny,nx,*),sum(nx) - real(r8) :: starttime,endtime ! ! replace line y with point gauss-seidel if ! y direction is periodic and ny = 3 @@ -1401,3 +1242,4 @@ subroutine slymd2cr(nx,ny,phi,cof,ty,sum) return end subroutine slymd2cr !----------------------------------------------------------------------- +end module edyn_mud diff --git a/src/ionosphere/waccmx/edyn_mudcom.F90 b/src/ionosphere/waccmx/edyn_mudcom.F90 index bf840a4b8f..cd3e8df7a4 100644 --- a/src/ionosphere/waccmx/edyn_mudcom.F90 +++ b/src/ionosphere/waccmx/edyn_mudcom.F90 @@ -1,9 +1,23 @@ -!module mudcom -! use shr_kind_mod ,only: r8 => shr_kind_r8 -! use cam_logfile ,only: iulog -! use cam_abortutils ,only: endrun +module edyn_mudcom + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + private + + public :: cor2 + public :: factri + public :: factrp + public :: swk2 + public :: trsfc2 + public :: prolon2 + public :: res2 + public :: sgfa + public :: sgsl + public :: transp + !----------------------------------------------------------------------- -! contains + contains !----------------------------------------------------------------------- ! ! file mudcom.f @@ -28,12 +42,10 @@ ! !----------------------------------------------------------------------- subroutine swk2(nfx,nfy,phif,rhsf,phi,rhs) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! set phif,rhsf input in arrays which include ! virtual boundaries for phi (for all 2-d real codes) ! - implicit none integer nfx,nfy,i,j real(r8) :: phif(nfx,nfy),rhsf(nfx,nfy) real(r8) :: phi(0:nfx+1,0:nfy+1),rhs(nfx,nfy) @@ -58,11 +70,9 @@ subroutine swk2(nfx,nfy,phif,rhsf,phi,rhs) end subroutine swk2 !----------------------------------------------------------------------- subroutine trsfc2(nx,ny,phi,rhs,ncx,ncy,phic,rhsc) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! transfer fine grid to coarse grid ! - implicit none integer nx,ny,ncx,ncy,i,j,ic,jc real(r8) :: phi(0:nx+1,0:ny+1),rhs(nx,ny) real(r8) :: phic(0:ncx+1,0:ncy+1),rhsc(ncx,ncy) @@ -118,8 +128,7 @@ subroutine trsfc2(nx,ny,phi,rhs,ncx,ncy,phic,rhsc) end subroutine trsfc2 !----------------------------------------------------------------------- subroutine res2(nx,ny,resf,ncx,ncy,rhsc,nxa,nxb,nyc,nyd) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none + integer nx,ny,ncx,ncy,nxa,nxb,nyc,nyd integer i,j,ic,jc,im1,ip1,jm1,jp1,ix,jy ! @@ -258,8 +267,7 @@ end subroutine res2 ! prolon2 modified from rgrd2u 11/20/97 ! subroutine prolon2(ncx,ncy,p,nx,ny,q,nxa,nxb,nyc,nyd,intpol) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none + integer ncx,ncy,nx,ny,intpol,nxa,nxb,nyc,nyd real(r8) :: p(0:ncx+1,0:ncy+1),q(0:nx+1,0:ny+1) integer i,j,jc,ist,ifn,jst,jfn,joddst,joddfn @@ -402,8 +410,7 @@ end subroutine prolon2 ! 11/20/97 modification of rgrd1u.f for mudpack ! subroutine prolon1(ncx,p,nx,q,nxa,nxb,intpol) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none + integer intpol,nxa,nxb,ncx,nx,i,ic,ist,ifn,ioddst,ioddfn real(r8) :: p(0:ncx+1),q(0:nx+1) ist = 1 @@ -500,12 +507,10 @@ subroutine prolon1(ncx,p,nx,q,nxa,nxb,intpol) end subroutine prolon1 !----------------------------------------------------------------------- subroutine cor2(nx,ny,phif,ncx,ncy,phic,nxa,nxb,nyc,nyd,intpol,phcor) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! add coarse grid correction in phic to fine grid approximation ! in phif using linear or cubic interpolation ! - implicit none integer i,j,nx,ny,ncx,ncy,nxa,nxb,nyc,nyd,intpol,ist,ifn,jst,jfn real(r8) :: phif(0:nx+1,0:ny+1),phic(0:ncx+1,0:ncy+1) real(r8) :: phcor(0:nx+1,0:ny+1) @@ -550,1391 +555,6 @@ subroutine cor2(nx,ny,phif,ncx,ncy,phic,nxa,nxb,nyc,nyd,intpol,phcor) end do end if end subroutine cor2 -!----------------------------------------------------------------------- - subroutine pde2(nx,ny,u,i,j,ux3,ux4,uy3,uy4,nxa,nyc) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none - integer nx,ny,i,j,nxa,nyc - real(r8) :: u(nx,ny),dlx,dly,dlxx,dlyy,tdlx3,tdly3,dlx4,dly4 - common/pde2com/dlx,dly,dlxx,dlyy,tdlx3,tdly3,dlx4,dly4 - real(r8) :: ux3,ux4,uy3,uy4 -! -! use second order approximation in u to estimate (second order) -! third and fourth partial derivatives in the x and y direction -! non-symmetric difference formula (derived from the routine -! finpdf,findif) are used at and one point in from mixed boundaries. -! - if (nxa.ne.0) then -! -! nonperiodic in x -! - if(i.gt.2 .and. i.lt.nx-1) then - ux3 = (-u(i-2,j)+2.0_r8*u(i-1,j)-2.0_r8*u(i+1,j)+u(i+2,j))/tdlx3 - ux4 = (u(i-2,j)-4.0_r8*u(i-1,j)+6.0_r8*u(i,j)-4.0_r8*u(i+1,j)+u(i+2,j)) & - /dlx4 - else if (i.eq.1) then - ux3 = (-5.0_r8*u(1,j)+18.0_r8*u(2,j)-24.0_r8*u(3,j)+14.0_r8*u(4,j)- & - 3.0_r8*u(5,j))/tdlx3 - ux4 = (3.0_r8*u(1,j)-14.0_r8*u(2,j)+26.0_r8*u(3,j)-24.0_r8*u(4,j)+ & - 11.0_r8*u(5,j)-2.0_r8*u(6,j))/dlx4 - else if (i.eq.2) then - ux3 = (-3.0_r8*u(1,j)+10.0_r8*u(2,j)-12.0_r8*u(3,j)+6.0_r8*u(4,j)-u(5,j)) & - /tdlx3 - ux4 = (2.0_r8*u(1,j)-9.0_r8*u(2,j)+16.0_r8*u(3,j)-14.0_r8*u(4,j)+ & - 6.0_r8*u(5,j)-u(6,j))/dlx4 - else if (i.eq.nx-1) then - ux3 = (u(nx-4,j)-6.0_r8*u(nx-3,j)+12.0_r8*u(nx-2,j)-10.0_r8*u(nx-1,j)+ & - 3.0_r8*u(nx,j))/tdlx3 - ux4 = (-u(nx-5,j)+6.0_r8*u(nx-4,j)-14.0_r8*u(nx-3,j)+16.0_r8*u(nx-2,j)- & - 9.0_r8*u(nx-1,j)+2.0_r8*u(nx,j))/dlx4 - else if (i.eq.nx) then - ux3 = (3.0_r8*u(nx-4,j)-14.0_r8*u(nx-3,j)+24.0_r8*u(nx-2,j)- & - 18.0_r8*u(nx-1,j)+5.0_r8*u(nx,j))/tdlx3 - ux4 = (-2.0_r8*u(nx-5,j)+11.0_r8*u(nx-4,j)-24.0_r8*u(nx-3,j)+ & - 26.0_r8*u(nx-2,j)-14.0_r8*u(nx-1,j)+3.0_r8*u(nx,j))/dlx4 - end if - else -! -! periodic in x -! - if(i.gt.2 .and. i.lt.nx-1) then - ux3 = (-u(i-2,j)+2.0_r8*u(i-1,j)-2.0_r8*u(i+1,j)+u(i+2,j))/tdlx3 - ux4 = (u(i-2,j)-4.0_r8*u(i-1,j)+6.0_r8*u(i,j)-4.0_r8*u(i+1,j)+u(i+2,j)) & - /dlx4 - else if (i.eq.1) then - ux3 = (-u(nx-2,j)+2.0_r8*u(nx-1,j)-2.0_r8*u(2,j)+u(3,j))/tdlx3 - ux4 = (u(nx-2,j)-4.0_r8*u(nx-1,j)+6.0_r8*u(1,j)-4.0_r8*u(2,j)+u(3,j)) & - /dlx4 - else if (i.eq.2) then - ux3 = (-u(nx-1,j)+2.0_r8*u(1,j)-2.0_r8*u(3,j)+u(4,j))/(tdlx3) - ux4 = (u(nx-1,j)-4.0_r8*u(1,j)+6.0_r8*u(2,j)-4.0_r8*u(3,j)+u(4,j))/dlx4 - else if (i.eq.nx-1) then - ux3 = (-u(nx-3,j)+2.0_r8*u(nx-2,j)-2.0_r8*u(1,j)+u(2,j))/tdlx3 - ux4 = (u(nx-3,j)-4.0_r8*u(nx-2,j)+6.0_r8*u(nx-1,j)-4.0_r8*u(1,j)+ & - u(2,j))/dlx4 - else if (i.eq.nx) then - ux3 = (-u(nx-2,j)+2.0_r8*u(nx-1,j)-2.0_r8*u(2,j)+u(3,j))/tdlx3 - ux4 = (u(nx-2,j)-4.0_r8*u(nx-1,j)+6.0_r8*u(nx,j)-4.0_r8*u(2,j)+u(3,j)) & - /dlx4 - end if - end if -! -! y partial derivatives -! - if (nyc.ne.0) then -! -! not periodic in y -! - if (j.gt.2 .and. j.lt.ny-1) then - uy3 = (-u(i,j-2)+2.0_r8*u(i,j-1)-2.0_r8*u(i,j+1)+u(i,j+2))/tdly3 - uy4 = (u(i,j-2)-4.0_r8*u(i,j-1)+6.0_r8*u(i,j)-4.0_r8*u(i,j+1)+u(i,j+2)) & - /dly4 - else if (j.eq.1) then - uy3 = (-5.0_r8*u(i,1)+18.0_r8*u(i,2)-24.0_r8*u(i,3)+14.0_r8*u(i,4)- & - 3.0_r8*u(i,5))/tdly3 - uy4 = (3.0_r8*u(i,1)-14.0_r8*u(i,2)+26.0_r8*u(i,3)-24.0_r8*u(i,4)+ & - 11.0_r8*u(i,5)-2.0_r8*u(i,6))/dly4 - else if (j.eq.2) then - uy3 = (-3.0_r8*u(i,1)+10.0_r8*u(i,2)-12.0_r8*u(i,3)+6.0_r8*u(i,4)-u(i,5)) & - /tdly3 - uy4 = (2.0_r8*u(i,1)-9.0_r8*u(i,2)+16.0_r8*u(i,3)-14.0_r8*u(i,4)+ & - 6.0_r8*u(i,5)-u(i,6))/dly4 - else if (j.eq.ny-1) then - uy3 = (u(i,ny-4)-6.0_r8*u(i,ny-3)+12.0_r8*u(i,ny-2)-10.0_r8*u(i,ny-1)+ & - 3.0_r8*u(i,ny))/tdly3 - uy4 = (-u(i,ny-5)+6.0_r8*u(i,ny-4)-14.0_r8*u(i,ny-3)+16.0_r8*u(i,ny-2)- & - 9.0_r8*u(i,ny-1)+2.0_r8*u(i,ny))/dly4 - else if (j.eq.ny) then - uy3 = (3.0_r8*u(i,ny-4)-14.0_r8*u(i,ny-3)+24.0_r8*u(i,ny-2)- & - 18.0_r8*u(i,ny-1)+5.0_r8*u(i,ny))/tdly3 - uy4 = (-2.0_r8*u(i,ny-5)+11.0_r8*u(i,ny-4)-24.0_r8*u(i,ny-3)+ & - 26.0_r8*u(i,ny-2)-14.0_r8*u(i,ny-1)+3.0_r8*u(i,ny))/dly4 - end if - else -! -! periodic in y -! - if (j.gt.2 .and. j.lt.ny-1) then - uy3 = (-u(i,j-2)+2.0_r8*u(i,j-1)-2.0_r8*u(i,j+1)+u(i,j+2))/tdly3 - uy4 = (u(i,j-2)-4.0_r8*u(i,j-1)+6.0_r8*u(i,j)-4.0_r8*u(i,j+1)+u(i,j+2)) & - /dly4 - else if (j.eq.1) then - uy3 = (-u(i,ny-2)+2.0_r8*u(i,ny-1)-2.0_r8*u(i,2)+u(i,3))/tdly3 - uy4 = (u(i,ny-2)-4.0_r8*u(i,ny-1)+6.0_r8*u(i,1)-4.0_r8*u(i,2)+u(i,3)) & - /dly4 - else if (j.eq.2) then - uy3 = (-u(i,ny-1)+2.0_r8*u(i,1)-2.0_r8*u(i,3)+u(i,4))/(tdly3) - uy4 = (u(i,ny-1)-4.0_r8*u(i,1)+6.0_r8*u(i,2)-4.0_r8*u(i,3)+u(i,4))/dly4 - else if (j.eq.ny-1) then - uy3 = (-u(i,ny-3)+2.0_r8*u(i,ny-2)-2.0_r8*u(i,1)+u(i,2))/tdly3 - uy4 = (u(i,ny-3)-4.0_r8*u(i,ny-2)+6.0_r8*u(i,ny-1)-4.0_r8*u(i,1)+ & - u(i,2))/dly4 - else if (j.eq.ny) then - uy3 = (-u(i,ny-2)+2.0_r8*u(i,ny-1)-2.0_r8*u(i,2)+u(i,3))/tdly3 - uy4 = (u(i,ny-2)-4.0_r8*u(i,ny-1)+6.0_r8*u(i,ny)-4.0_r8*u(i,2)+u(i,3)) & - /dly4 - end if - end if - return - end subroutine pde2 -!----------------------------------------------------------------------- - subroutine swk3(nfx,nfy,nfz,phif,rhsf,phi,rhs) - use shr_kind_mod ,only: r8 => shr_kind_r8 -! -! set phif,rhsf input in arrays which include -! virtual boundaries for phi (for all 2-d real codes) -! - implicit none - integer nfx,nfy,nfz,i,j,k - real(r8) :: phif(nfx,nfy,nfz),rhsf(nfx,nfy,nfz) - real(r8) :: phi(0:nfx+1,0:nfy+1,0:nfz+1),rhs(nfx,nfy,nfz) - do k=1,nfz - do j=1,nfy - do i=1,nfx - phi(i,j,k) = phif(i,j,k) - rhs(i,j,k) = rhsf(i,j,k) - end do - end do - end do -! -! set virtual boundaries in phi to zero -! - do k=0,nfz+1 - do j=0,nfy+1 - phi(0,j,k) = 0.0_r8 - phi(nfx+1,j,k) = 0.0_r8 - end do - end do - do k=0,nfz+1 - do i=0,nfx+1 - phi(i,0,k) = 0.0_r8 - phi(i,nfy+1,k) = 0.0_r8 - end do - end do - do j=0,nfy+1 - do i=0,nfx+1 - phi(i,j,0) = 0.0_r8 - phi(i,j,nfz+1) = 0.0_r8 - end do - end do - return - end subroutine swk3 -!----------------------------------------------------------------------- - subroutine trsfc3(nx,ny,nz,phi,rhs,ncx,ncy,ncz,phic,rhsc) - use shr_kind_mod ,only: r8 => shr_kind_r8 -! -! transfer fine grid to coarse grid -! - implicit none - integer nx,ny,nz,ncx,ncy,ncz,i,j,k,ic,jc,kc,ix,jy,kz - real(r8) :: phi(0:nx+1,0:ny+1,0:nz+1),rhs(nx,ny,nz) - real(r8) :: phic(0:ncx+1,0:ncy+1,0:ncz+1),rhsc(ncx,ncy,ncz) -! -! set virtual boundaries in phic to zero -! - do kc=0,ncz+1 - do jc=0,ncy+1 - phic(0,jc,kc) = 0.0_r8 - phic(ncx+1,jc,kc) = 0.0_r8 - end do - end do - do kc=0,ncz+1 - do ic=0,ncx+1 - phic(ic,0,kc) = 0.0_r8 - phic(ic,ncy+1,kc) = 0.0_r8 - end do - end do - do jc=0,ncy+1 - do ic=0,ncx+1 - phic(ic,jc,0) = 0.0_r8 - phic(ic,jc,ncz+1) = 0.0_r8 - end do - end do - if (ncx.lt.nx .and. ncy.lt.ny .and. ncz.lt.nz) then -! -! coarsening in x,y,z (usually the case?) -! - do kc=1,ncz - k = kc+kc-1 - do jc=1,ncy - j = jc+jc-1 - do ic=1,ncx - i = ic+ic-1 - phic(ic,jc,kc) = phi(i,j,k) - rhsc(ic,jc,kc) = rhs(i,j,k) - end do - end do - end do - else -! -! no coarsening in at least one dimension -! - ix = 1 - if (ncx.eq.nx) ix = 0 - jy = 1 - if (ncy.eq.ny) jy = 0 - kz = 1 - if (ncz.eq.nz) kz = 0 - - do kc=1,ncz - k = kc+kz*(kc-1) - do jc=1,ncy - j = jc+jy*(jc-1) - do ic=1,ncx - i = ic+ix*(ic-1) - phic(ic,jc,kc) = phi(i,j,k) - rhsc(ic,jc,kc) = rhs(i,j,k) - end do - end do - end do - end if - return - end subroutine trsfc3 -!----------------------------------------------------------------------- - subroutine res3(nx,ny,nz,resf,ncx,ncy,ncz,rhsc, & - nxa,nxb,nyc,nyd,nze,nzf) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none - integer nx,ny,nz,ncx,ncy,ncz,nxa,nxb,nyc,nyd,nze,nzf - integer ix,jy,kz,i,j,k,ic,jc,kc,im1,ip1,jm1,jp1,km1,kp1 - real(r8) :: rm,rk,rp -! -! restrict fine grid residual in resf to coarse grid in rhsc -! using full weighting -! - real(r8) :: resf(nx,ny,nz),rhsc(ncx,ncy,ncz) -! -! set x,y,z coarsening integer subscript scales -! - ix = 1 - if (ncx.eq.nx) ix = 0 - jy = 1 - if (ncy.eq.ny) jy = 0 - kz = 1 - if (ncz.eq.nz) kz = 0 -! -! restrict on interior -! - if (ncz.lt.nz .and. ncy.lt.ny .and. ncx.lt.nx) then -! -! coarsening in x,y,z -! - do kc=2,ncz-1 - k = kc+kc-1 - do jc=2,ncy-1 - j = jc+jc-1 - do ic=2,ncx-1 - i = ic+ic-1 -! -! weight on k-1,k,k+1 z planes in rm,rk,rp -! - rm=(resf(i-1,j-1,k-1)+resf(i+1,j-1,k-1)+resf(i-1,j+1,k-1)+ & - resf(i+1,j+1,k-1)+2._r8*(resf(i-1,j,k-1)+resf(i+1,j,k-1)+ & - resf(i,j-1,k-1)+resf(i,j+1,k-1))+4._r8*resf(i,j,k-1))*.0625_r8 - - rk=(resf(i-1,j-1,k)+resf(i+1,j-1,k)+resf(i-1,j+1,k)+ & - resf(i+1,j+1,k)+2._r8*(resf(i-1,j,k)+resf(i+1,j,k)+ & - resf(i,j-1,k)+resf(i,j+1,k))+4._r8*resf(i,j,k))*.0625_r8 - - rp=(resf(i-1,j-1,k+1)+resf(i+1,j-1,k+1)+resf(i-1,j+1,k+1)+ & - resf(i+1,j+1,k+1)+2._r8*(resf(i-1,j,k+1)+resf(i+1,j,k+1)+ & - resf(i,j-1,k+1)+resf(i,j+1,k+1))+4._r8*resf(i,j,k+1))*.0625_r8 -! -! weight in z direction for final result -! - rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) - end do - end do - end do - else -! -! allow for noncoarsening in any of x,y,z -! - do kc=2,ncz-1 - k = kc+kz*(kc-1) - do jc=2,ncy-1 - j = jc+jy*(jc-1) - do ic=2,ncx-1 - i = ic+ix*(ic-1) -! -! weight on k-1,k,k+1 z planes in rm,rk,rp -! - rm=(resf(i-1,j-1,k-1)+resf(i+1,j-1,k-1)+resf(i-1,j+1,k-1)+ & - resf(i+1,j+1,k-1)+2._r8*(resf(i-1,j,k-1)+resf(i+1,j,k-1)+ & - resf(i,j-1,k-1)+resf(i,j+1,k-1))+4._r8*resf(i,j,k-1))*.0625_r8 - - rk=(resf(i-1,j-1,k)+resf(i+1,j-1,k)+resf(i-1,j+1,k)+ & - resf(i+1,j+1,k)+2._r8*(resf(i-1,j,k)+resf(i+1,j,k)+ & - resf(i,j-1,k)+resf(i,j+1,k))+4._r8*resf(i,j,k))*.0625_r8 - - rp=(resf(i-1,j-1,k+1)+resf(i+1,j-1,k+1)+resf(i-1,j+1,k+1)+ & - resf(i+1,j+1,k+1)+2._r8*(resf(i-1,j,k+1)+resf(i+1,j,k+1)+ & - resf(i,j-1,k+1)+resf(i,j+1,k+1))+4._r8*resf(i,j,k+1))*.0625_r8 -! -! weight in z direction for final result -! - rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) - end do - end do - end do - end if -! -! set residual on boundaries -! - do ic=1,ncx,ncx-1 -! -! x=xa and x=xb -! - i = ic+ix*(ic-1) - im1 = max0(i-1,2) - ip1 = min0(i+1,nx-1) - if (i.eq.1 .and. nxa.eq.0) im1 = nx-1 - if (i.eq.nx .and. nxb.eq.0) ip1 = 2 -! -! (y,z) interior -! - do kc=2,ncz-1 - k = kc+kz*(kc-1) - do jc=2,ncy-1 - j = jc+jy*(jc-1) - rm=(resf(im1,j-1,k-1)+resf(ip1,j-1,k-1)+resf(im1,j+1,k-1)+ & - resf(ip1,j+1,k-1)+2._r8*(resf(im1,j,k-1)+resf(ip1,j,k-1)+ & - resf(i,j-1,k-1)+resf(i,j+1,k-1))+4._r8*resf(i,j,k-1))*.0625_r8 - - rk=(resf(im1,j-1,k)+resf(ip1,j-1,k)+resf(im1,j+1,k)+ & - resf(ip1,j+1,k)+2._r8*(resf(im1,j,k)+resf(ip1,j,k)+ & - resf(i,j-1,k)+resf(i,j+1,k))+4._r8*resf(i,j,k))*.0625_r8 - - rp=(resf(im1,j-1,k+1)+resf(ip1,j-1,k+1)+resf(im1,j+1,k+1)+ & - resf(ip1,j+1,k+1)+2._r8*(resf(im1,j,k+1)+resf(ip1,j,k+1)+ & - resf(i,j-1,k+1)+resf(i,j+1,k+1))+4._r8*resf(i,j,k+1))*.0625_r8 - - rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) - end do - end do -! -! x=xa,xb and y=yc,yd interior edges -! - do jc=1,ncy,ncy-1 - j = jc+jy*(jc-1) - jm1 = max0(j-1,2) - jp1 = min0(j+1,ny-1) - if (j.eq.1 .and. nyc.eq.0) jm1 = ny-1 - if (j.eq.ny .and. nyc.eq.0) jp1 = 2 - do kc=2,ncz-1 - k = kc+kz*(kc-1) - rm=(resf(im1,jm1,k-1)+resf(ip1,jm1,k-1)+resf(im1,jp1,k-1)+ & - resf(ip1,jp1,k-1)+2._r8*(resf(im1,j,k-1)+resf(ip1,j,k-1)+ & - resf(i,jm1,k-1)+resf(i,jp1,k-1))+4._r8*resf(i,j,k-1))*.0625_r8 - - rk=(resf(im1,jm1,k)+resf(ip1,jm1,k)+resf(im1,jp1,k)+ & - resf(ip1,jp1,k)+2._r8*(resf(im1,j,k)+resf(ip1,j,k)+ & - resf(i,jm1,k)+resf(i,jp1,k))+4._r8*resf(i,j,k))*.0625_r8 - - rp=(resf(im1,jm1,k+1)+resf(ip1,jm1,k+1)+resf(im1,jp1,k+1)+ & - resf(ip1,jp1,k+1)+2._r8*(resf(im1,j,k+1)+resf(ip1,j,k+1)+ & - resf(i,jm1,k+1)+resf(i,jp1,k+1))+4._r8*resf(i,j,k+1))*.0625_r8 - - rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) - end do -! x=xa,xb; y=yc,yd; z=ze,zf cornors - do kc=1,ncz,ncz-1 - k = kc+kz*(kc-1) - km1 = max0(k-1,2) - kp1 = min0(k+1,nz-1) - if (k.eq.1 .and. nze.eq.0) km1 = nz-1 - if (k.eq.nz .and. nzf.eq.0) kp1 = 2 - rm=(resf(im1,jm1,km1)+resf(ip1,jm1,km1)+resf(im1,jp1,km1)+ & - resf(ip1,jp1,km1)+2._r8*(resf(im1,j,km1)+resf(ip1,j,km1)+ & - resf(i,jm1,km1)+resf(i,jp1,km1))+4._r8*resf(i,j,km1))*.0625_r8 - - rk=(resf(im1,jm1,k)+resf(ip1,jm1,k)+resf(im1,jp1,k)+ & - resf(ip1,jp1,k)+2._r8*(resf(im1,j,k)+resf(ip1,j,k)+ & - resf(i,jm1,k)+resf(i,jp1,k))+4._r8*resf(i,j,k))*.0625_r8 - - rp=(resf(im1,jm1,kp1)+resf(ip1,jm1,kp1)+resf(im1,jp1,kp1)+ & - resf(ip1,jp1,kp1)+2._r8*(resf(im1,j,kp1)+resf(ip1,j,kp1)+ & - resf(i,jm1,kp1)+resf(i,jp1,kp1))+4._r8*resf(i,j,kp1))*.0625_r8 - - rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) - end do - end do -! -! x=xa,xb and z=ze,zf edges -! - do kc=1,ncz,ncz-1 - k = kc+kz*(kc-1) - km1 = max0(k-1,2) - kp1 = min0(k+1,nz-1) - if (k.eq.1 .and. nze.eq.0) km1 = nz-1 - if (k.eq.nz .and. nzf.eq.0) kp1 = 2 - do jc=2,ncy-1 - j = jc+jy*(jc-1) - rm=(resf(im1,j-1,km1)+resf(ip1,j-1,km1)+resf(im1,j+1,km1)+ & - resf(ip1,j+1,km1)+2._r8*(resf(im1,j,km1)+resf(ip1,j,km1)+ & - resf(i,j-1,km1)+resf(i,j+1,km1))+4._r8*resf(i,j,km1))*.0625_r8 - - rk=(resf(im1,j-1,k)+resf(ip1,j-1,k)+resf(im1,j+1,k)+ & - resf(ip1,j+1,k)+2._r8*(resf(im1,j,k)+resf(ip1,j,k)+ & - resf(i,j-1,k)+resf(i,j+1,k))+4._r8*resf(i,j,k))*.0625_r8 - - rp=(resf(im1,j-1,kp1)+resf(ip1,j-1,kp1)+resf(im1,j+1,kp1)+ & - resf(ip1,j+1,kp1)+2._r8*(resf(im1,j,kp1)+resf(ip1,j,kp1)+ & - resf(i,j-1,kp1)+resf(i,j+1,kp1))+4._r8*resf(i,j,kp1))*.0625_r8 - - rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) - end do - end do - end do -! -! y boundaries y=yc and y=yd -! - do jc=1,ncy,ncy-1 - j = jc+jy*(jc-1) - jm1 = max0(j-1,2) - jp1 = min0(j+1,ny-1) - if (j.eq.1 .and. nyc.eq.0) jm1 = ny-1 - if (j.eq.ny .and. nyd.eq.0) jp1 = 2 -! -! (x,z) interior -! - do kc=2,ncz-1 - k = kc+kz*(kc-1) - do ic=2,ncx-1 - i = ic+ix*(ic-1) - rm=(resf(i-1,jm1,k-1)+resf(i+1,jm1,k-1)+resf(i-1,jp1,k-1)+ & - resf(i+1,jp1,k-1)+2._r8*(resf(i-1,j,k-1)+resf(i+1,j,k-1)+ & - resf(i,jm1,k-1)+resf(i,jp1,k-1))+4._r8*resf(i,j,k-1))*.0625_r8 - - rk=(resf(i-1,jm1,k)+resf(i+1,jm1,k)+resf(i-1,jp1,k)+ & - resf(i+1,jp1,k)+2._r8*(resf(i-1,j,k)+resf(i+1,j,k)+ & - resf(i,jm1,k)+resf(i,jp1,k))+4._r8*resf(i,j,k))*.0625_r8 - - rp=(resf(i-1,jm1,k+1)+resf(i+1,jm1,k+1)+resf(i-1,jp1,k+1)+ & - resf(i+1,jp1,k+1)+2._r8*(resf(i-1,j,k+1)+resf(i+1,j,k+1)+ & - resf(i,jm1,k+1)+resf(i,jp1,k+1))+4._r8*resf(i,j,k+1))*.0625_r8 - - rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) - end do - end do -! -! y=yc,yd and z=ze,zf edges -! - do kc=1,ncz,ncz-1 - k = kc+kz*(kc-1) - km1 = max0(k-1,2) - kp1 = min0(k+1,nz-1) - if (k.eq.1 .and. nze.eq.0) km1 = nz-1 - if (k.eq.nz .and. nzf.eq.0) kp1 = 2 -! -! interior in x -! - do ic=2,ncx-1 - i = ic+ix*(ic-1) - rm=(resf(i-1,jm1,km1)+resf(i+1,jm1,km1)+resf(i-1,jp1,km1)+ & - resf(i+1,jp1,km1)+2._r8*(resf(i-1,j,km1)+resf(i+1,j,km1)+ & - resf(i,jm1,km1)+resf(i,jp1,km1))+4._r8*resf(i,j,km1))*.0625_r8 - - rk=(resf(i-1,jm1,k)+resf(i+1,jm1,k)+resf(i-1,jp1,k)+ & - resf(i+1,jp1,k)+2._r8*(resf(i-1,j,k)+resf(i+1,j,k)+ & - resf(i,jm1,k)+resf(i,jp1,k))+4._r8*resf(i,j,k))*.0625_r8 - - rp=(resf(i-1,jm1,kp1)+resf(i+1,jm1,kp1)+resf(i-1,jp1,kp1)+ & - resf(i+1,jp1,kp1)+2._r8*(resf(i-1,j,kp1)+resf(i+1,j,kp1)+ & - resf(i,jm1,kp1)+resf(i,jp1,kp1))+4._r8*resf(i,j,kp1))*.0625_r8 - - rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) - end do - end do - end do -! -! z=ze,zf boundaries -! - do kc=1,ncz,ncz-1 - k = kc+kz*(kc-1) - km1 = max0(k-1,2) - kp1 = min0(k+1,nz-1) - if (k.eq.1 .and. nze.eq.0) km1 = nz-1 - if (k.eq.nz .and. nzf.eq.0) kp1 = 2 -! -! (x,y) interior -! - do jc=2,ncy-1 - j = jc+jy*(jc-1) - do ic=2,ncx-1 - i = ic+ix*(ic-1) - rm=(resf(i-1,j-1,km1)+resf(i+1,j-1,km1)+resf(i-1,j+1,km1)+ & - resf(i+1,j+1,km1)+2._r8*(resf(i-1,j,km1)+resf(i+1,j,km1)+ & - resf(i,j-1,km1)+resf(i,j+1,km1))+4._r8*resf(i,j,km1))*.0625_r8 - - rk=(resf(i-1,j-1,k)+resf(i+1,j-1,k)+resf(i-1,j+1,k)+ & - resf(i+1,j+1,k)+2._r8*(resf(i-1,j,k)+resf(i+1,j,k)+ & - resf(i,j-1,k)+resf(i,j+1,k))+4._r8*resf(i,j,k))*.0625_r8 - - rp=(resf(i-1,j-1,kp1)+resf(i+1,j-1,kp1)+resf(i-1,j+1,kp1)+ & - resf(i+1,j+1,kp1)+2._r8*(resf(i-1,j,kp1)+resf(i+1,j,kp1)+ & - resf(i,j-1,kp1)+resf(i,j+1,kp1))+4._r8*resf(i,j,kp1))*.0625_r8 - - rhsc(ic,jc,kc) = 0.25_r8*(rm+2._r8*rk+rp) - end do - end do - end do -! -! set coarse grid residual to zero at specified boundaries -! - if (nxa.eq.1) then - ic = 1 - do kc=1,ncz - do jc=1,ncy - rhsc(ic,jc,kc) = 0.0_r8 - end do - end do - end if - if (nxb.eq.1) then - ic = ncx - do kc=1,ncz - do jc=1,ncy - rhsc(ic,jc,kc) = 0.0_r8 - end do - end do - end if - if (nyc.eq.1) then - jc = 1 - do kc=1,ncz - do ic=1,ncx - rhsc(ic,jc,kc) = 0.0_r8 - end do - end do - end if - if (nyd.eq.1) then - jc = ncy - do kc=1,ncz - do ic=1,ncx - rhsc(ic,jc,kc) = 0.0_r8 - end do - end do - end if - if (nze.eq.1) then - kc = 1 - do jc=1,ncy - do ic=1,ncx - rhsc(ic,jc,kc) = 0.0_r8 - end do - end do - end if - if (nzf.eq.1) then - kc = ncz - do jc=1,ncy - do ic=1,ncx - rhsc(ic,jc,kc) = 0.0_r8 - end do - end do - end if - return - end subroutine res3 -!----------------------------------------------------------------------- -! -! prolon3 modified from prolon2 11/25/97 -! - subroutine prolon3(ncx,ncy,ncz,p,nx,ny,nz,q,nxa,nxb,nyc,nyd, & - nze,nzf,intpol) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none - integer ncx,ncy,ncz,nx,ny,nz,intpol,nxa,nxb,nyc,nyd,nze,nzf - real(r8) :: p(0:ncx+1,0:ncy+1,0:ncz+1),q(0:nx+1,0:ny+1,0:nz+1) - integer i,j,k,kc,ist,ifn,jst,jfn,kst,kfn,koddst,koddfn - ist = 1 - ifn = nx - jst = 1 - jfn = ny - kst = 1 - kfn = nz - koddst = 1 - koddfn = nz - if (nxa.eq.1) then - ist = 2 - end if - if (nxb.eq.1) then - ifn = nx-1 - end if - if (nyc.eq.1) then - jst = 2 - end if - if (nyd.eq.1) then - jfn = ny-1 - end if - if (nze.eq.1) then - kst = 2 - koddst = 3 - end if - if (nzf.eq.1) then - kfn = nz-1 - koddfn = nz-2 - end if - if (intpol.eq.1 .or. ncz.lt.4) then -! -! linearly interpolate in z -! - if (ncz .lt. nz) then -! -! ncz grid is an every other point subset of nz grid -! set odd k planes interpolating in x&y and then set even -! k planes by averaging odd k planes -! - do k=koddst,koddfn,2 - kc = k/2+1 - call prolon2(ncx,ncy,p(0,0,kc),nx,ny,q(0,0,k),nxa,nxb,nyc, & - nyd,intpol) - end do - do k=2,kfn,2 - do j=jst,jfn - do i=ist,ifn - q(i,j,k) = 0.5_r8*(q(i,j,k-1)+q(i,j,k+1)) - end do - end do - end do -! -! set periodic virtual boundaries if necessary -! - if (nze.eq.0) then - do j=jst,jfn - do i=ist,ifn - q(i,j,0) = q(i,j,nz-1) - q(i,j,nz+1) = q(i,j,2) - end do - end do - end if - return - else -! -! ncz grid is equals nz grid so interpolate in x&y only -! - do k=kst,kfn - kc = k - call prolon2(ncx,ncy,p(0,0,kc),nx,ny,q(0,0,k),nxa,nxb,nyc, & - nyd,intpol) - end do -! -! set periodic virtual boundaries if necessary -! - if (nze.eq.0) then - do j=jst,jfn - do i=ist,ifn - q(i,j,0) = q(i,j,nz-1) - q(i,j,nz+1) = q(i,j,2) - end do - end do - end if - return - end if - else -! -! cubically interpolate in z -! - if (ncz .lt. nz) then -! -! set every other point of nz grid by interpolating in x&y -! - do k=koddst,koddfn,2 - kc = k/2+1 - call prolon2(ncx,ncy,p(0,0,kc),nx,ny,q(0,0,k),nxa,nxb,nyc, & - nyd,intpol) - end do -! -! set deep interior of nz grid using values just -! generated and symmetric cubic interpolation in z -! - do k=4,nz-3,2 - do j=jst,jfn - do i=ist,ifn - q(i,j,k)=(-q(i,j,k-3)+9._r8*(q(i,j,k-1)+q(i,j,k+1))-q(i,j,k+3)) & - *.0625_r8 - end do - end do - end do -! -! interpolate from q at k=2 and k=nz-1 -! - if (nze.ne.0) then -! -! asymmetric formula near nonperiodic z boundaries -! - do j=jst,jfn - do i=ist,ifn - q(i,j,2)=(5._r8*q(i,j,1)+15._r8*q(i,j,3)-5._r8*q(i,j,5)+q(i,j,7)) & - *.0625_r8 - q(i,j,nz-1)=(5._r8*q(i,j,nz)+15._r8*q(i,j,nz-2)-5._r8*q(i,j,nz-4)+ & - q(i,j,nz-6))*.0625_r8 - end do - end do - else -! -! periodicity in y alows symmetric formula near bndys -! - do j=jst,jfn - do i=ist,ifn - q(i,j,2) = (-q(i,j,nz-2)+9._r8*(q(i,j,1)+q(i,j,3))-q(i,j,5)) & - *.0625_r8 - q(i,j,nz-1)=(-q(i,j,nz-4)+9._r8*(q(i,j,nz-2)+q(i,j,nz))- & - q(i,j,3))*.0625_r8 - q(i,j,nz+1) = q(i,j,2) - q(i,j,0) = q(i,j,nz-1) - end do - end do - end if - return - else -! -! ncz grid is equals nx grid so interpolate in x&y only -! - do k=kst,kfn - kc = k - call prolon2(ncx,ncy,p(0,0,kc),nx,ny,q(0,0,k),nxa,nxb,nyc, & - nyd,intpol) - end do -! -! set periodic virtual boundaries if necessary -! - if (nze.eq.0) then - do j=jst,jfn - do i=ist,ifn - q(i,j,0) = q(i,j,nz-1) - q(i,j,nz+1) = q(i,j,2) - end do - end do - end if - return - end if - end if - end subroutine prolon3 -!----------------------------------------------------------------------- - subroutine cor3(nx,ny,nz,phif,ncx,ncy,ncz,phic,nxa,nxb,nyc,nyd, & - nze,nzf,intpol,phcor) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none - integer nx,ny,nz,ncx,ncy,ncz,nxa,nxb,nyc,nyd,nze,nzf,intpol - integer i,j,k,ist,ifn,jst,jfn,kst,kfn -! -! add coarse grid correction in phic to fine grid approximation -! in phif using linear or cubic interpolation -! - real(r8) :: phif(0:nx+1,0:ny+1,0:nz+1),phic(0:ncx+1,0:ncy+1,0:ncz+1) - real(r8) :: phcor(0:nx+1,0:ny+1,0:nz+1) - do k=0,nz+1 - do j=0,ny+1 - do i=0,nx+1 - phcor(i,j,k) = 0.0_r8 - end do - end do - end do -! -! lift correction in phic to fine grid in phcor -! - call prolon3(ncx,ncy,ncz,phic,nx,ny,nz,phcor,nxa,nxb,nyc,nyd, & - nze,nzf,intpol) -! -! add correction in phcor to phif on nonspecified boundaries -! - ist = 1 - ifn = nx - jst = 1 - jfn = ny - kst = 1 - kfn = nz - if (nxa.eq.1) ist = 2 - if (nxb.eq.1) ifn = nx-1 - if (nyc.eq.1) jst = 2 - if (nyd.eq.1) jfn = ny-1 - if (nze.eq.1) kst = 2 - if (nzf.eq.1) kfn = nz-1 - do k=kst,kfn - do j=jst,jfn - do i=ist,ifn - phif(i,j,k) = phif(i,j,k) + phcor(i,j,k) - end do - end do - end do -! -! add periodic points if necessary -! - if (nze.eq.0) then - do j=jst,jfn - do i=ist,ifn - phif(i,j,0) = phif(i,j,nz-1) - phif(i,j,nz+1) = phif(i,j,2) - end do - end do - end if - if (nyc.eq.0) then - do k=kst,kfn - do i=ist,ifn - phif(i,0,k) = phif(i,ny-1,k) - phif(i,ny+1,k) = phif(i,2,k) - end do - end do - end if - if (nxa.eq.0) then - do k=kst,kfn - do j=jst,jfn - phif(0,j,k) = phif(nx-1,j,k) - phif(nx+1,j,k) = phif(2,j,k) - end do - end do - end if - end subroutine cor3 -!----------------------------------------------------------------------- - subroutine per3vb(nx,ny,nz,phi,nxa,nyc,nze) - use shr_kind_mod ,only: r8 => shr_kind_r8 -! -! set virtual periodic boundaries from interior values -! in three dimensions (for all 3-d solvers) -! - implicit none - integer nx,ny,nz,nxa,nyc,nze,j,k,i - real(r8) :: phi(0:nx+1,0:ny+1,0:nz+1) - if (nxa.eq.0) then - do k=1,nz - do j=1,ny - phi(0,j,k) = phi(nx-1,j,k) - phi(nx,j,k) = phi(1,j,k) - phi(nx+1,j,k) = phi(2,j,k) - end do - end do - end if - if (nyc.eq.0) then - do k=1,nz - do i=1,nx - phi(i,0,k) = phi(i,ny-1,k) - phi(i,ny,k) = phi(i,1,k) - phi(i,ny+1,k) = phi(i,2,k) - end do - end do - end if - if (nze.eq.0) then - do j=1,ny - do i=1,nx - phi(i,j,0) = phi(i,j,nz-1) - phi(i,j,nz) = phi(i,j,1) - phi(i,j,nz+1) = phi(i,j,2) - end do - end do - end if - return - end subroutine per3vb -!----------------------------------------------------------------------- - subroutine pde2cr(nx,ny,u,i,j,ux3y,uxy3,ux2y2) - use shr_kind_mod ,only: r8 => shr_kind_r8 -! -! compute mixed partial derivative approximations -! - implicit none - integer nx,ny,i,j,n1,n2,n3,n4,m1,m2,m3,m4 - real(r8) :: u(nx,ny),ux3y,uxy3,ux2y2 - integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & - maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & - kcycle,iprer,ipost,intpol,kps - real(r8) :: xa,xb,yc,yd,tolmax,relmax - common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & - iguess, maxcy,method,nwork,lwork,itero,ngrid, & - klevel,kcur,kcycle,iprer,ipost,intpol,kps - common/fmud2cr/xa,xb,yc,yd,tolmax,relmax - real(r8) :: dlx,dly,dyox,dxoy,dlx2,dly2,dlxx,dlxy,dlyy,dlxy2, & - dlxy4,dxxxy4,dxyyy4,dxxyy,tdlx3,tdly3,dlx4,dly4, & - dlxxx,dlyyy - common/com2dcr/dyox,dxoy,dlx2,dly2,dlxy,dlxy2,dlxy4, & - dxxxy4,dxyyy4,dxxyy,dlxxx,dlyyy - common/pde2com/dlx,dly,dlxx,dlyy,tdlx3,tdly3,dlx4,dly4 - n1=ny-1 - n2=ny-2 - n3=ny-3 - n4=ny-4 - m1=nx-1 - m2=nx-2 - m3=nx-3 - m4=nx-4 - - if (i.eq.1) then - - if ((j.gt.2.and.j.lt.ny-1)) then -! x=xa, yinterior - ux3y=(5*u(1,j-1)-18*u(2,j-1)+24*u(3,j-1)-14*u(4,j-1)+3*u(5,j-1) & - -5*u(1,j+1)+18*u(2,j+1)-24*u(3,j+1)+14*u(4,j+1)-3*u(5,j+1)) & - /dxxxy4 - uxy3=(3*u(1,j-2)-4*u(2,j-2)+u(3,j-2) & - -6*u(1,j-1)+8*u(2,j-1)-2*u(3,j-1) & - +6*u(1,j+1)-8*u(2,j+1)+2*u(3,j+1) & - -3*u(1,j+2)+4*u(2,j+2)-u(3,j+2))/dxyyy4 - else if (j.eq.1) then -! (xa,yc) - ux3y=(15*u(1,1)-54*u(2,1)+72*u(3,1)-42*u(4,1)+9*u(5,1) & - -20*u(1,2)+72*u(2,2)-96*u(3,2)+56*u(4,2)-12*u(5,2) & - +5*u(1,3)-18*u(2,3)+24*u(3,3)-14*u(4,3)+3*u(5,3)) & - /dxxxy4 - uxy3=(15*u(1,1)-20*u(2,1)+5*u(3,1) & - -54*u(1,2)+72*u(2,2)-18*u(3,2) & - +72*u(1,3)-96*u(2,3)+24*u(3,3) & - -42*u(1,4)+56*u(2,4)-14*u(3,4) & - +9*u(1,5)-12*u(2,5)+3*u(3,5)) & - /dxyyy4 - ux2y2=(4*u(1,1)-10*u(2,1)+8*u(3,1)-2*u(4,1) & - -10*u(1,2)+25*u(2,2)-20*u(3,2)+5*u(4,2) & - +8*u(1,3)-20*u(2,3)+16*u(3,3)-4*u(4,3) & - -2*u(1,4)+5*u(2,4)-4*u(3,4)+u(4,4)) & - /dxxyy - else if (j.eq.2) then -! (xa,yc+dly) - ux3y=(5*u(1,1)-18*u(2,1)+24*u(3,1)-14*u(4,1)+3*u(5,1) & - -5*u(1,3)+18*u(2,3)-24*u(3,3)+14*u(4,3)-3*u(5,3)) & - /dxxxy4 - uxy3=(9*u(1,1)-12*u(2,1)+3*u(3,1) & - -30*u(1,2)+40*u(2,2)-10*u(3,2) & - +36*u(1,3)-48*u(2,3)+12*u(3,3) & - -18*u(1,4)+24*u(2,4)-6*u(3,4) & - +3*u(1,5)-4*u(2,5)+u(3,5)) & - /dxyyy4 - else if (j.eq.ny-1) then -! x=xa,y=yd-dly - ux3y=(5*u(1,j-1)-18*u(2,j-1)+24*u(3,j-1)-14*u(4,j-1)+3*u(5,j-1) & - -5*u(1,j+1)+18*u(2,j+1)-24*u(3,j+1)+14*u(4,j+1)-3*u(5,j+1)) - uxy3=(5*u(1,n2)-18*u(2,n2)+24*u(3,n2)-14*u(4,n2)+3*u(5,n2) & - -5*u(1,ny)+18*u(2,ny)-24*u(3,ny)+14*u(4,ny)-3*u(5,ny)) & - /dxyyy4 - else if (j.eq.ny) then -! x=xa, y=yd - ux3y=(-5*u(1,n2)+18*u(2,n2)-24*u(3,n2)+14*u(4,n2)-3*u(5,n2) & - +20*u(1,n1)-72*u(2,n1)+96*u(3,n1)-56*u(4,n1)+12*u(5,n1) & - -15*u(1,ny)+54*u(2,ny)-72*u(3,ny)+42*u(4,ny)-9*u(5,ny)) & - /dxxxy4 - uxy3=(-9*u(1,n4)+12*u(2,n4)-3*u(3,n4) & - +42*u(1,n3)-56*u(2,n3)+14*u(3,n3) & - -72*u(1,n2)+96*u(2,n2)-24*u(3,n2) & - +54*u(1,n1)-72*u(2,n1)+18*u(3,n1) & - -15*u(1,ny)+20*u(2,ny)-5*u(3,ny)) & - /dxyyy4 - ux2y2=(-2*u(1,n3)+5*u(2,n3)-4*u(3,n3)+u(4,n3) & - +8*u(1,n2)-20*u(2,n2)+16*u(3,n2)-4*u(4,n2) & - -10*u(1,n1)+25*u(2,n1)-20*u(3,n1)+5*u(4,n1) & - +4*u(1,ny)-10*u(2,ny)+8*u(3,ny)-2*u(4,ny)) & - /dxxyy - end if - - else if (i.eq.2) then - - if ((j.gt.2.and.j.lt.ny-1)) then -! x=xa+dlx, y interior - ux3y=(3*u(1,j-1)-10*u(2,j-1)+12*u(3,j-1)-6*u(4,j-1)+u(5,j-1) & - -3*u(1,j+1)+10*u(2,j+1)-12*u(3,j+1)+6*u(4,j+1)-u(5,j+1))/dxxxy4 - uxy3=(u(1,j-2)-u(3,j-2)-2*u(1,j-1)+2*u(3,j-1) & - +2*u(1,j+1)-2*u(3,j+1)-u(1,j+2)+u(3,j+2))/dxyyy4 - else if (j.eq.1) then -! x=xa+dlx, y=yc - ux3y=(9*u(1,1)-30*u(2,1)+36*u(3,1)-18*u(4,1)+3*u(5,1) & - -12*u(1,2)+40*u(2,2)-48*u(3,2)+24*u(4,2)-4*u(5,2) & - +3*u(1,3)-10*u(2,3)+12*u(3,3)-6*u(4,3)+u(5,3)) & - /dxxxy4 - uxy3=(5*u(1,1)-5*u(3,1)-18*u(1,2)+18*u(3,2) & - +24*u(1,3)-24*u(3,3)-14*u(1,4) & - +14*u(3,4)+3*u(1,5)-3*u(3,5)) & - /dxyyy4 - else if (j.eq.2) then -! at x=xa+dlx,y=yc+dly - ux3y=(3*u(1,1)-10*u(2,1)+12*u(3,1)-6*u(4,1)+u(5,1) & - -3*u(1,3)+10*u(2,3)-12*u(3,3)+6*u(4,3)-u(5,3)) & - /dxxxy4 - uxy3=(3*u(1,1)-3*u(3,1)-10*u(1,2)+10*u(3,2) & - +12*u(1,3)-12*u(3,3)-6*u(1,4)+6*u(3,4) & - +u(1,5)-u(3,5)) & - /dxyyy4 - else if (j.eq.ny-1) then -! x=xa+dlx,y=yd-dly - ux3y=(3*u(1,n2)-10*u(2,n2)+12*u(3,n2)-6*u(4,n2)+u(5,n2) & - -3*u(1,ny)+10*u(2,ny)-12*u(3,ny)+6*u(4,ny)-u(5,ny)) & - /dxxxy4 - uxy3=(-u(1,n4)+u(3,n4)+6*u(1,n3)-6*u(3,n3) & - -12*u(1,n2)+12*u(3,n2)+10*u(1,n1)-10*u(3,n1) & - -3*u(1,ny)+3*u(3,ny)) & - /dxyyy4 - else if (j.eq.ny) then -! at x=xa+dlx,y=yd - ux3y=(-3*u(1,n2)+10*u(2,n2)-12*u(3,n2)+6*u(4,n2)-u(5,n2) & - +12*u(1,n1)-40*u(2,n1)+48*u(3,n1)-24*u(4,n1)+4*u(5,n1) & - -9*u(1,ny)+30*u(2,ny)-36*u(3,ny)+18*u(4,ny)-3*u(5,ny)) & - /dxxxy4 - uxy3=(-3*u(1,n4)+3*u(3,n4)+14*u(1,n3)-14*u(3,n3) & - -24*u(1,n2)+24*u(3,n2)+18*u(1,n1)-18*u(3,n1) & - -5*u(1,ny)+5*u(3,ny)) & - /dxyyy4 - end if - - else if (i.gt.2 .and. i.lt.nx-1) then - - if (j.eq.1) then -! y=yc,x interior - ux3y=(3.0_r8*u(i-2,1)-6.0_r8*u(i-1,1)+6.0_r8*u(i+1,1)-3.0_r8*u(i+2,1) & - -4.0_r8*u(i-2,2)+8.0_r8*u(i-1,2)-8.0_r8*u(i+1,2)+4.0_r8*u(i+2,2) & - +u(i-2,3)-2.0_r8*u(i-1,3)+2.0_r8*u(i+1,3)-u(i+2,3)) & - /dxxxy4 - uxy3=(5.0_r8*u(i-1,1)-5.0_r8*u(i+1,1)-18.0_r8*u(i-1,2)+18.0_r8*u(i+1,2) & - +24.0_r8*u(i-1,3)-24.0_r8*u(i+1,3)-14.0_r8*u(i-1,4)+14.0_r8*u(i+1,4) & - +3.0_r8*u(i-1,5)-3.0_r8*u(i+1,5)) & - /dxyyy4 - else if (j.eq.2) then -! y=yc+dly,x interior - ux3y=(u(i-2,1)-2.0_r8*u(i-1,1)+2.0_r8*u(i+1,1)-u(i+2,1) & - -u(i-2,3)+2.0_r8*u(i-1,3)-2.0_r8*u(i+1,3)+u(i+2,3)) & - /dxxxy4 - uxy3=(u(i-1,1)-u(i+1,1)-2.0_r8*u(i-1,2)+2.0_r8*u(i+1,2) & - +2.0_r8*u(i-1,4)-2.0_r8*u(i+1,4)-u(i-1,5)+u(i+1,5)) & - /dxyyy4 - else if (j.eq.ny-1) then -! y=yd-dly, x interior - ux3y=(u(i-2,n2)-2.0_r8*u(i-1,n2)+2.0_r8*u(i+1,n2)-u(i+2,n2) & - -u(i-2,ny)+2.0_r8*u(i-1,ny)-2.0_r8*u(i+1,ny)+u(i+2,ny)) & - /dxxxy4 - uxy3=(-u(i-1,n4)+u(i+1,n4)+6.0_r8*u(i-1,n3)-6.0_r8*u(i+1,n3) & - -12.0_r8*u(i-1,n2)+12.0_r8*u(i+1,n2)+10.0_r8*u(i-1,n1)-10.0_r8*u(i+1,n1) & - -3.0_r8*u(i-1,ny)+3.0_r8*u(i+1,ny)) & - /dxyyy4 - else if (j.eq.ny) then -! at y=yd, x interior - ux3y=(-u(i-2,n2)+2.0_r8*u(i-1,n2)-2.0_r8*u(i+1,n2)+u(i+2,n2) & - +4.0_r8*u(i-2,n1)-8.0_r8*u(i-1,n1)+8.0_r8*u(i+1,n1)-4.0_r8*u(i+2,n1) & - -3.0_r8*u(i-2,ny)+6.0_r8*u(i-1,ny)-6.0_r8*u(i+1,ny)+3.0_r8*u(i+2,ny)) & - /dxxxy4 - uxy3=(-3.0_r8*u(i-1,n4)+3.0_r8*u(i+1,n4)+14.0_r8*u(i-1,n3)-14.0_r8*u(i+1,n3) & - -24.0_r8*u(i-1,n2) +24.0_r8*u(i+1,n2)+18.0_r8*u(i-1,n1)-18.0_r8*u(i+1,n1) & - -5.0_r8*u(i-1,ny)+5.0_r8*u(i+1,ny)) & - /dxyyy4 - end if - - else if (i.eq.nx-1) then - - if ((j.gt.2.and.j.lt.ny-1)) then -! x=xb-dlx,y interior - ux3y=(-u(m4,j-1)+6._r8*u(m3,j-1)-12._r8*u(m2,j-1)+10._r8*u(m1,j-1)-3._r8*u(nx & - ,j-1)+u(m4,j+1)-6._r8*u(m3,j+1)+12._r8*u(m2,j+1)-10._r8*u(m1,j+1)+3._r8*u(nx,j & - +1)) /dxxxy4 - uxy3=(u(m2,j-2)-u(nx,j-2)-2._r8*u(m2,j-1)+2._r8*u(nx,j-1) & - +2._r8*u(m2,j+1)-2._r8*u(nx,j+1)-u(m2,j+2)+u(nx,j+2)) /dxyyy4 - else if (j.eq.1) then -! at x=xb-dlx, y=yc - ux3y=(-3.0_r8*u(m4,1)+18.0_r8*u(m3,1)-36.0_r8*u(m2,1)+30.0_r8*u(m1,1)-9.0_r8*u( & - nx,1)+4.0_r8*u(m4,2)-24.0_r8*u(m3,2)+48.0_r8*u(m2,2)-40.0_r8*u(m1,2)+12.0_r8*u(nx & - ,2)-u(m4,3)+6.0_r8*u(m3,3)-12.0_r8*u(m2,3)+10.0_r8*u(m1,3)-3.0_r8*u(nx,3)) & - /dxxxy4 - uxy3=(5.0_r8*u(m2,1)-5.0_r8*u(nx,1)-18.0_r8*u(m2,2)+18.0_r8*u(nx,2) & - +24.0_r8*u(m2,3)-24.0_r8*u(nx,3)-14.0_r8*u(m2,4)+14.0_r8*u(nx,4) & - +3.0_r8*u(m2,5)-3.0_r8*u(nx,5)) & - /dxyyy4 - else if (j.eq.2) then -! x=xb-dlx,y=yc+dly - ux3y=(-u(m4,1)+6.0_r8*u(m3,1)-12.0_r8*u(m2,1)+10._r8*u(m1,1)-3._r8*u(nx,1) & - +u(m4,3)-6.0_r8*u(m3,3)+12.0_r8*u(m2,3)-10._r8*u(m1,3)+3._r8*u(nx,3)) & - /dxxxy4 - uxy3=(3.0_r8*u(m2,1)-3._r8*u(nx,1)-10._r8*u(m2,2)+10._r8*u(nx,2) & - +12._r8*u(m2,3)-12._r8*u(nx,3)-6._r8*u(m2,4)+6._r8*u(nx,4) & - +u(m2,5)-u(nx,5)) / dxyyy4 - else if (j.eq.ny-1) then -! at x=xb-dlx,y=yd-dly - ux3y=(-u(m4,n2)+6._r8*u(m3,n2)-12._r8*u(m2,n2)+10._r8*u(m1,n2)-3._r8*u(nx,n2) & - +u(m4,ny)-6._r8*u(m3,ny)+12._r8*u(m2,ny)-10._r8*u(m1,ny)+3._r8*u(nx,ny)) & - /dxxxy4 - uxy3=(-u(m2,n4)+u(nx,n4)+6*u(m2,n3)-6._r8*u(nx,n3) & - -12._r8*u(m2,n2)+12._r8*u(nx,n2)+10._r8*u(m2,n1)-10._r8*u(nx,n1) & - -3._r8*u(m2,ny)+3._r8*u(nx,ny)) / dxyyy4 - else if (j.eq.ny) then -! at x=xb.dlx,y=yd - ux3y=(u(m4,n2)-6._r8*u(m3,n2)+12._r8*u(m2,n2)-10._r8*u(m1,n2)+3._r8*u(nx,n2) & - -4._r8*u(m4,n1)+24._r8*u(m3,n1)-48._r8*u(m2,n1)+40._r8*u(m1,n1)-12._r8*u(nx,n1) & - +3._r8*u(m4,ny)-18._r8*u(m3,ny)+36._r8*u(m2,ny)-30._r8*u(m1,ny)+9._r8*u(nx,ny)) & - / dxxxy4 - uxy3=(-3._r8*u(m2,n4)+3._r8*u(nx,n4)+14._r8*u(m2,n3)-14._r8*u(nx,n3) & - -24._r8*u(m2,n2)+24._r8*u(nx,n2)+18._r8*u(m2,n1)-18._r8*u(nx,n1) & - -5._r8*u(m2,ny)+5._r8*u(nx,ny)) / dxyyy4 - end if - - else if (i.eq.nx) then - - if ((j.gt.2.and.j.lt.ny-1)) then -! x=xb,y interior - ux3y=(-3._r8*u(m4,j-1)+14._r8*u(m3,j-1)-24._r8*u(m2,j-1)+18._r8*u(m1,j-1)-5._r8* & - u(nx,j-1)+3._r8*u(m4,j+1)-14._r8*u(m3,j+1)+24._r8*u(m2,j+1)-18._r8*u(m1,j+1)+5._r8* & - u(nx,j+1)) / dxxxy4 - uxy3=(-u(m2,j-2)+4._r8*u(m1,j-2)-3._r8*u(nx,j-2) & - +2._r8*u(m2,j-1)-8._r8*u(m1,j-1)+6._r8*u(nx,j-1) & - -2._r8*u(m2,j+1)+8._r8*u(m1,j+1)-6._r8*u(nx,j+1) & - +u(m2,j+2)-4._r8*u(m1,j+2)+3._r8*u(nx,j+2)) / dxyyy4 - else if (j.eq.1) then -! x=xb,y=yc - ux3y=(-9._r8*u(m4,1)+42._r8*u(m3,1)-72._r8*u(m2,1)+54._r8*u(m1,1)-15._r8*u(nx,1) & - +12._r8*u(m4,2)-56._r8*u(m3,2)+96._r8*u(m2,2)-72._r8*u(m1,2)+20._r8*u(nx,2) & - -3._r8*u(m4,3)+14._r8*u(m3,3)-24._r8*u(m2,3)+18._r8*u(m1,3)-5._r8*u(nx,3)) & - /dxxxy4 - uxy3=(-5._r8*u(m2,1)+20._r8*u(m1,1)-15._r8*u(nx,1) & - +18._r8*u(m2,2)-72._r8*u(m1,2)+54._r8*u(nx,2) & - -24._r8*u(m2,3)+96._r8*u(m1,3)-72._r8*u(nx,3) & - +14._r8*u(m2,4)-56._r8*u(m1,4)+42._r8*u(nx,4) & - -3._r8*u(m2,5)+12._r8*u(m1,5)-9._r8*u(nx,5)) / dxyyy4 - ux2y2=(-2._r8*u(m3,1)+8._r8*u(m2,1)-10._r8*u(m1,1)+4._r8*u(nx,1) & - +5._r8*u(m3,2)-20._r8*u(m2,2)+25._r8*u(m1,2)-10._r8*u(nx,2) & - -4._r8*u(m3,3)+16._r8*u(m2,3)-20._r8*u(m1,3)+8._r8*u(nx,3) & - +u(m3,4)-4._r8*u(m2,4)+5._r8*u(m1,4)-2._r8*u(nx,4)) / dxxyy - else if (j.eq.2) then -! x=xb,y=yc+dly - ux3y=(-3._r8*u(m4,1)+14._r8*u(m3,1)-24._r8*u(m2,1)+18._r8*u(m1,1)-5._r8*u(nx,1) & - +3._r8*u(m4,3)-14._r8*u(m3,3)+24._r8*u(m2,3)-18._r8*u(m1,3)+5._r8*u(nx,3)) & - / dxxxy4 - uxy3=(-3._r8*u(m2,1)+12._r8*u(m1,1)-9._r8*u(nx,1) & - +10._r8*u(m2,2)-40._r8*u(m1,2)+30._r8*u(nx,2) & - -12._r8*u(m2,3)+48._r8*u(m1,3)-36._r8*u(nx,3) & - +6._r8*u(m2,4)-24._r8*u(m1,4)+18._r8*u(nx,4) & - -u(m2,5)+4._r8*u(m1,5)-3._r8*u(nx,5)) / dxyyy4 - else if (j.eq.ny-1) then -! x=xb,y=yd-dly - ux3y=(-3._r8*u(m4,n2)+14._r8*u(m3,n2)-24._r8*u(m2,n2)+18._r8*u(m1,n2)-5._r8*u(nx & - ,n2)+3._r8*u(m4,ny)-14._r8*u(m3,ny)+24._r8*u(m2,ny)-18._r8*u(m1,ny)+5._r8*u(nx,ny & - )) / dxxxy4 - uxy3=(u(m2,n4)-4._r8*u(m1,n4)+3._r8*u(nx,n4) & - -6._r8*u(m2,n3)+24._r8*u(m1,n3)-18._r8*u(nx,n3) & - +12._r8*u(m2,n2)-48._r8*u(m1,n2)+36._r8*u(nx,n2) & - -10._r8*u(m2,n1)+40._r8*u(m1,n1)-30._r8*u(nx,n1) & - +3._r8*u(m2,ny)-12._r8*u(m1,ny)+9._r8*u(nx,ny)) / dxyyy4 - else if (j.eq.ny) then -! x=xb,y=yd - ux3y=(3._r8*u(m4,n2)-14._r8*u(m3,n2)+24._r8*u(m2,n2)-18._r8*u(m1,n2)+5._r8*u(nx, & - n2)-12._r8*u(m4,n1)+56._r8*u(m3,n1)-96._r8*u(m2,n1)+72._r8*u(m1,n1)-20._r8*u(nx, & - n1)+9._r8*u(m4,ny)-42._r8*u(m3,ny)+72._r8*u(m2,ny)-54._r8*u(m1,ny)+15._r8*u(nx,ny & - )) / dxxxy4 - uxy3=(3._r8*u(m2,n4)-12._r8*u(m1,n4)+9._r8*u(nx,n4) & - -14._r8*u(m2,n3)+56._r8*u(m1,n3)-42._r8*u(nx,n3) & - +24._r8*u(m2,n2)-96._r8*u(m1,n2)+72._r8*u(nx,n2) & - -18._r8*u(m2,n1)+72._r8*u(m1,n1)-54._r8*u(nx,n1) & - +5._r8*u(m2,ny)-20._r8*u(m1,ny)+15._r8*u(nx,ny)) / dxyyy4 - ux2y2=(u(m3,n3)-4._r8*u(m2,n3)+5._r8*u(m1,n3)-2._r8*u(nx,n3) & - -4._r8*u(m3,n2)+16._r8*u(m2,n2)-20._r8*u(m1,n2)+8._r8*u(nx,n2) & - +5.0_r8*u(m3,n1)-20._r8*u(m2,n1)+25._r8*u(m1,n1)-10._r8*u(nx,n1) & - -2._r8*u(m3,ny)+8._r8*u(m2,ny)-10._r8*u(m1,ny)+4._r8*u(nx,ny)) & - / dxxyy - end if - - end if - - return - end subroutine pde2cr -!----------------------------------------------------------------------- - subroutine pde3(nx,ny,nz,u,i,j,k,ux3,ux4,uy3,uy4,uz3,uz4, & - nxa,nyc,nze) - use shr_kind_mod ,only: r8 => shr_kind_r8 -! -! estimate third and fourth partial derivatives in x,y,z -! - implicit none - integer nx,ny,nz,i,j,k,nxa,nyc,nze - real(r8) :: u(nx,ny,nz) - real(r8) :: dlx,dly,dlz,dlxx,dlyy,dlzz,tdlx3,tdly3,tdlz3,dlx4,dly4,dlz4 - common/pde3com/dlx,dly,dlz,dlxx,dlyy,dlzz,tdlx3,tdly3,tdlz3, & - dlx4,dly4,dlz4 - real(r8) :: ux3,ux4,uy3,uy4,uz3,uz4 -! -! x,y partial derivatives -! - call p3de2(nx,ny,u(1,1,k),i,j,ux3,ux4,uy3,uy4,nxa,nyc) -! -! z partial derivatives -! - if (nze.ne.0) then -! -! nonperiodic in z -! - if(k.gt.2 .and. k.lt.nz-1) then - uz3=(-u(i,j,k-2)+2.0_r8*u(i,j,k-1)-2.0_r8*u(i,j,k+1)+u(i,j,k+2))/tdlz3 - uz4=(u(i,j,k-2)-4.0_r8*u(i,j,k-1)+6.0_r8*u(i,j,k)-4.0_r8*u(i,j,k+1)+ & - u(i,j,k+2))/dlz4 - else if (k.eq.1) then - uz3=(-5.0_r8*u(i,j,1)+18.0_r8*u(i,j,2)-24.0_r8*u(i,j,3)+14.0_r8*u(i,j,4)- & - 3.0_r8*u(i,j,5))/tdlz3 - uz4 = (3.0_r8*u(i,j,1)-14.0_r8*u(i,j,2)+26.0_r8*u(i,j,3)-24.0_r8*u(i,j,4)+ & - 11.0_r8*u(i,j,5)-2.0_r8*u(i,j,6))/dlz4 - else if (k.eq.2) then - uz3 = (-3.0_r8*u(i,j,1)+10.0_r8*u(i,j,2)-12.0_r8*u(i,j,3)+6.0_r8*u(i,j,4)- & - u(i,j,5))/tdlz3 - uz4 = (2.0_r8*u(i,j,1)-9.0_r8*u(i,j,2)+16.0_r8*u(i,j,3)-14.0_r8*u(i,j,4)+6.0_r8* & - u(i,j,5)-u(i,j,6))/dlz4 - else if (k.eq.nz-1) then - uz3 = (u(i,j,nz-4)-6.0_r8*u(i,j,nz-3)+12.0_r8*u(i,j,nz-2)-10.0_r8* & - u(i,j,nz-1)+3.0_r8*u(i,j,nz))/tdlz3 - uz4 = (-u(i,j,nz-5)+6.0_r8*u(i,j,nz-4)-14.0_r8*u(i,j,nz-3)+16.0_r8* & - u(i,j,nz-2)-9.0_r8*u(i,j,nz-1)+2.0_r8*u(i,j,nz))/dlz4 - else if (k.eq.nz) then - uz3 = (3.0_r8*u(i,j,nz-4)-14.0_r8*u(i,j,nz-3)+24.0_r8*u(i,j,nz-2)-18.0_r8* & - u(i,j,nz-1)+5.0_r8*u(i,j,nz))/tdlz3 - uz4 = (-2.0_r8*u(i,j,nz-5)+11.0_r8*u(i,j,nz-4)-24.0_r8*u(i,j,nz-3)+26.0_r8* & - u(i,j,nz-2)-14.0_r8*u(i,j,nz-1)+3.0_r8*u(i,j,nz))/dlz4 - end if - else -! -! periodic in z so use symmetric formula even "near" z boundaies -! - if(k.gt.2 .and. k.lt.nz-1) then - uz3=(-u(i,j,k-2)+2.0_r8*u(i,j,k-1)-2.0_r8*u(i,j,k+1)+u(i,j,k+2))/tdlz3 - uz4=(u(i,j,k-2)-4.0_r8*u(i,j,k-1)+6.0_r8*u(i,j,k)-4.0_r8*u(i,j,k+1)+ & - u(i,j,k+2))/dlz4 - else if (k.eq.1) then - uz3 = (-u(i,j,nz-2)+2.0_r8*u(i,j,nz-1)-2.0_r8*u(i,j,2)+u(i,j,3))/tdlz3 - uz4 = (u(i,j,nz-2)-4.0_r8*u(i,j,nz-1)+6.0_r8*u(i,j,1)-4.0_r8*u(i,j,2)+ & - u(i,j,3))/dlz4 - else if (k.eq.2) then - uz3 = (-u(i,j,nz-1)+2.0_r8*u(i,j,1)-2.0_r8*u(i,j,3)+u(i,j,4))/(tdlz3) - uz4 = (u(i,j,nz-1)-4.0_r8*u(i,j,1)+6.0_r8*u(i,j,2)-4.0_r8*u(i,j,3)+ & - u(i,j,4))/dlz4 - else if (k.eq.nz-1) then - uz3 = (-u(i,j,nz-3)+2.0_r8*u(i,j,nz-2)-2.0_r8*u(i,j,1)+u(i,j,2))/tdlz3 - uz4 = (u(i,j,nz-3)-4.0_r8*u(i,j,nz-2)+6.0_r8*u(i,j,nz-1)-4.0_r8*u(i,j,1)+ & - u(i,j,2))/ dlz4 - else if (k.eq.nz) then - uz3 = (-u(i,j,nz-2)+2.0_r8*u(i,j,nz-1)-2.0_r8*u(i,j,2)+u(i,j,3))/tdlz3 - uz4 = (u(i,j,nz-2)-4.0_r8*u(i,j,nz-1)+6.0_r8*u(i,j,nz)-4.0_r8*u(i,j,2)+ & - u(i,j,3))/dlz4 - end if - end if - return - end subroutine pde3 -!----------------------------------------------------------------------- - subroutine p3de2(nx,ny,u,i,j,ux3,ux4,uy3,uy4,nxa,nyc) - use shr_kind_mod ,only: r8 => shr_kind_r8 -! -! third and fourth partial derivatives in x and y -! - implicit none - integer nx,ny,i,j,nxa,nyc,l - real(r8) :: u(nx,ny) - real(r8) :: dlx,dly,dlz,dlxx,dlyy,dlzz,tdlx3,tdly3,tdlz3,dlx4,dly4,dlz4 - common/pde3com/dlx,dly,dlz,dlxx,dlyy,dlzz,tdlx3,tdly3,tdlz3, & - dlx4,dly4,dlz4 - real(r8) :: ux3,ux4,uy3,uy4 - l=ny -! -! x partial derivatives -! - call p3de1(nx,u(1,j),i,ux3,ux4,nxa) -! -! y partial derivatives -! - if (nyc.ne.0) then -! -! not periodic in y -! - if (j.gt.2 .and. j.lt.ny-1) then - uy3 = (-u(i,j-2)+2.0_r8*u(i,j-1)-2.0_r8*u(i,j+1)+u(i,j+2))/tdly3 - uy4 = (u(i,j-2)-4.0_r8*u(i,j-1)+6.0_r8*u(i,j)-4.0_r8*u(i,j+1)+u(i,j+2))/ & - dly4 - else if (j.eq.1) then - uy3 = (-5.0_r8*u(i,1)+18.0_r8*u(i,2)-24.0_r8*u(i,3)+14.0_r8*u(i,4)- & - 3.0_r8*u(i,5))/tdly3 - uy4 = (3.0_r8*u(i,1)-14.0_r8*u(i,2)+26.0_r8*u(i,3)-24.0_r8*u(i,4)+ & - 11.0_r8*u(i,5)-2.0_r8*u(i,6))/dly4 - else if (j.eq.2) then - uy3 = (-3.0_r8*u(i,1)+10.0_r8*u(i,2)-12.0_r8*u(i,3)+6.0_r8*u(i,4)-u(i,5))/ & - tdly3 - uy4 = (2.0_r8*u(i,1)-9.0_r8*u(i,2)+16.0_r8*u(i,3)-14.0_r8*u(i,4)+6.0_r8*u(i,5)- & - u(i,6))/dly4 - else if (j.eq.ny-1) then - uy3 = (u(i,l-4)-6.0_r8*u(i,l-3)+12.0_r8*u(i,l-2)-10.0_r8*u(i,l-1)+ & - 3.0_r8*u(i,l))/tdly3 - uy4 = (-u(i,l-5)+6.0_r8*u(i,l-4)-14.0_r8*u(i,l-3)+16.0_r8*u(i,l-2)- & - 9.0_r8*u(i,l-1)+2.0_r8*u(i,l))/dly4 - else if (j.eq.ny) then - uy3 = (3.0_r8*u(i,l-4)-14.0_r8*u(i,l-3)+24.0_r8*u(i,l-2)-18.0_r8*u(i,l-1)+ & - 5.0_r8*u(i,l))/tdly3 - uy4 = (-2.0_r8*u(i,l-5)+11.0_r8*u(i,l-4)-24.0_r8*u(i,l-3)+26.0_r8*u(i,l-2)- & - 14.0_r8*u(i,l-1)+3.0_r8*u(i,l))/dly4 - end if - else -! -! periodic in y -! - if (j.gt.2 .and. j.lt.ny-1) then - uy3 = (-u(i,j-2)+2.0_r8*u(i,j-1)-2.0_r8*u(i,j+1)+u(i,j+2))/tdly3 - uy4 = (u(i,j-2)-4.0_r8*u(i,j-1)+6.0_r8*u(i,j)-4.0_r8*u(i,j+1)+u(i,j+2))/ & - dly4 - else if (j.eq.1) then - uy3 = (-u(i,l-2)+2.0_r8*u(i,l-1)-2.0_r8*u(i,2)+u(i,3))/tdly3 - uy4 = (u(i,l-2)-4.0_r8*u(i,l-1)+6.0_r8*u(i,1)-4.0_r8*u(i,2)+u(i,3))/dly4 - else if (j.eq.2) then - uy3 = (-u(i,l-1)+2.0_r8*u(i,1)-2.0_r8*u(i,3)+u(i,4))/(tdly3) - uy4 = (u(i,l-1)-4.0_r8*u(i,1)+6.0_r8*u(i,2)-4.0_r8*u(i,3)+u(i,4))/dly4 - else if (j.eq.ny-1) then - uy3 = (-u(i,l-3)+2.0_r8*u(i,l-2)-2.0_r8*u(i,1)+u(i,2))/tdly3 - uy4 = (u(i,l-3)-4.0_r8*u(i,l-2)+6.0_r8*u(i,l-1)-4.0_r8*u(i,1)+u(i,2))/ & - dly4 - else if (j.eq.ny) then - uy3 = (-u(i,l-2)+2.0_r8*u(i,l-1)-2.0_r8*u(i,2)+u(i,3))/tdly3 - uy4 = (u(i,l-2)-4.0_r8*u(i,l-1)+6.0_r8*u(i,l)-4.0_r8*u(i,2)+u(i,3))/dly4 - end if - end if - return - end subroutine p3de2 -!----------------------------------------------------------------------- - subroutine p3de1(nx,u,i,ux3,ux4,nxa) - use shr_kind_mod ,only: r8 => shr_kind_r8 -! -! third and fourth derivatives in x -! - implicit none - integer nx,i,nxa,k - real(r8) :: u(nx) - real(r8) :: dlx,dly,dlz,dlxx,dlyy,dlzz,tdlx3,tdly3,tdlz3,dlx4,dly4,dlz4 - common/pde3com/dlx,dly,dlz,dlxx,dlyy,dlzz,tdlx3,tdly3,tdlz3, & - dlx4,dly4,dlz4 - real(r8) :: ux3,ux4 - k = nx - if (nxa.ne.0) then -! -! nonperiodic in x -! - if(i.gt.2 .and. i.lt.nx-1) then - ux3 = (-u(i-2)+2.0_r8*u(i-1)-2.0_r8*u(i+1)+u(i+2))/tdlx3 - ux4 = (u(i-2)-4.0_r8*u(i-1)+6.0_r8*u(i)-4.0_r8*u(i+1)+u(i+2))/dlx4 - else if (i.eq.1) then - ux3 = (-5.0_r8*u(1)+18.0_r8*u(2)-24.0_r8*u(3)+14.0_r8*u(4)-3.0_r8*u(5))/tdlx3 - ux4 = (3.0_r8*u(1)-14.0_r8*u(2)+26.0_r8*u(3)-24.0_r8*u(4)+11.0_r8*u(5)-2.0_r8*u(6)) & - /dlx4 - else if (i.eq.2) then - ux3 = (-3.0_r8*u(1)+10.0_r8*u(2)-12.0_r8*u(3)+6.0_r8*u(4)-u(5))/tdlx3 - ux4 = (2.0_r8*u(1)-9.0_r8*u(2)+16.0_r8*u(3)-14.0_r8*u(4)+6.0_r8*u(5)-u(6))/dlx4 - else if (i.eq.nx-1) then - ux3 = (u(k-4)-6.0_r8*u(k-3)+12.0_r8*u(k-2)-10.0_r8*u(k-1)+3.0_r8*u(k))/tdlx3 - ux4 = (-u(k-5)+6.0_r8*u(k-4)-14.0_r8*u(k-3)+16.0_r8*u(k-2)-9.0_r8*u(k-1)+ & - 2.0_r8*u(k))/dlx4 - else if (i.eq.nx) then - ux3 = (3.0_r8*u(k-4)-14.0_r8*u(k-3)+24.0_r8*u(k-2)-18.0_r8*u(k-1)+5.0_r8*u(k))/ & - tdlx3 - ux4 = (-2.0_r8*u(k-5)+11.0_r8*u(k-4)-24.0_r8*u(k-3)+26.0_r8*u(k-2)- & - 14.0_r8*u(k-1)+3.0_r8*u(k))/dlx4 - end if - else -! -! periodic in x -! - if(i.gt.2 .and. i.lt.nx-1) then - ux3 = (-u(i-2)+2.0_r8*u(i-1)-2.0_r8*u(i+1)+u(i+2))/tdlx3 - ux4 = (u(i-2)-4.0_r8*u(i-1)+6.0_r8*u(i)-4.0_r8*u(i+1)+u(i+2))/dlx4 - else if (i.eq.1) then - ux3 = (-u(k-2)+2.0_r8*u(k-1)-2.0_r8*u(2)+u(3))/tdlx3 - ux4 = (u(k-2)-4.0_r8*u(k-1)+6.0_r8*u(1)-4.0_r8*u(2)+u(3))/dlx4 - else if (i.eq.2) then - ux3 = (-u(k-1)+2.0_r8*u(1)-2.0_r8*u(3)+u(4))/(tdlx3) - ux4 = (u(k-1)-4.0_r8*u(1)+6.0_r8*u(2)-4.0_r8*u(3)+u(4))/dlx4 - else if (i.eq.nx-1) then - ux3 = (-u(k-3)+2.0_r8*u(k-2)-2.0_r8*u(1)+u(2))/tdlx3 - ux4 = (u(k-3)-4.0_r8*u(k-2)+6.0_r8*u(k-1)-4.0_r8*u(1)+u(2))/dlx4 - else if (i.eq.nx) then - ux3 = (-u(k-2)+2.0_r8*u(k-1)-2.0_r8*u(2)+u(3))/tdlx3 - ux4 = (u(k-2)-4.0_r8*u(k-1)+6.0_r8*u(k)-4.0_r8*u(2)+u(3))/dlx4 - end if - end if - return - end subroutine p3de1 !----------------------------------------------------------------------- ! ! factri and factrip are: @@ -1944,11 +564,9 @@ end subroutine p3de1 ! of order n arising from nonperiodic or periodic discretizations ! subroutine factri(m,n,a,b,c) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! factor the m simultaneous tridiagonal systems of order n ! - implicit none integer m,n,i,j real(r8) :: a(n,m),b(n,m),c(n,m) do i=2,n @@ -1961,13 +579,11 @@ subroutine factri(m,n,a,b,c) end subroutine factri !----------------------------------------------------------------------- subroutine factrp(m,n,a,b,c,d,e,sum) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! factor the m simultaneous "tridiagonal" systems of order n ! from discretized periodic system (leave out periodic n point) ! (so sweeps below only go from i=1,2,...,n-1) n > 3 is necessary ! - implicit none integer m,n,i,j real(r8) :: a(n,m),b(n,m),c(n,m),d(n,m),e(n,m),sum(m) do j=1,m @@ -2018,11 +634,9 @@ subroutine factrp(m,n,a,b,c,d,e,sum) end subroutine factrp !----------------------------------------------------------------------- subroutine transp(n,amat) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! transpose n by n real matrix ! - implicit none integer n,i,j real(r8) :: amat(n,n),temp do i=1,n-1 @@ -2036,225 +650,217 @@ subroutine transp(n,amat) end subroutine transp !----------------------------------------------------------------------- subroutine sgfa (a,lda,n,ipvt,info) - use shr_kind_mod ,only: r8 => shr_kind_r8 - integer lda,n,ipvt(1),info - real(r8) :: a(lda,1) - real(r8) :: t - integer isfmax,j,k,kp1,l,nm1 - info = 0 - nm1 = n - 1 - if (nm1 .lt. 1) go to 70 - do 60 k = 1, nm1 - kp1 = k + 1 + integer lda,n,ipvt(*),info + real(r8) :: a(lda,*) + real(r8) :: t + integer :: j,k,kp1,l,nm1 + info = 0 + nm1 = n - 1 + if (nm1 .lt. 1) go to 70 + do 60 k = 1, nm1 + kp1 = k + 1 l = isfmax(n-k+1,a(k,k),1) + k - 1 - ipvt(k) = l - if (a(l,k) .eq. 0.0e0_r8) go to 40 - if (l .eq. k) go to 10 - t = a(l,k) - a(l,k) = a(k,k) - a(k,k) = t - 10 continue - t = -1.0e0_r8/a(k,k) + ipvt(k) = l + if (a(l,k) .eq. 0.0e0_r8) go to 40 + if (l .eq. k) go to 10 + t = a(l,k) + a(l,k) = a(k,k) + a(k,k) = t + 10 continue + t = -1.0e0_r8/a(k,k) call sscl(n-k,t,a(k+1,k),1) - do 30 j = kp1, n - t = a(l,j) - if (l .eq. k) go to 20 - a(l,j) = a(k,j) - a(k,j) = t - 20 continue + do 30 j = kp1, n + t = a(l,j) + if (l .eq. k) go to 20 + a(l,j) = a(k,j) + a(k,j) = t + 20 continue call sxpy(n-k,t,a(k+1,k),1,a(k+1,j),1) - 30 continue - go to 50 - 40 continue - info = k - 50 continue - 60 continue - 70 continue - ipvt(n) = n - if (a(n,n) .eq. 0.0e0_r8) info = n - return + 30 continue + go to 50 + 40 continue + info = k + 50 continue + 60 continue + 70 continue + ipvt(n) = n + if (a(n,n) .eq. 0.0e0_r8) info = n + return end subroutine sgfa !----------------------------------------------------------------------- subroutine sgsl (a,lda,n,ipvt,b,job) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none - integer lda,n,ipvt(1),job - real(r8) :: a(lda,1),b(1) - real(r8) :: sdt,t - integer k,kb,l,nm1 - nm1 = n - 1 - if (job .ne. 0) go to 50 - if (nm1 .lt. 1) go to 30 - do 20 k = 1, nm1 - l = ipvt(k) - t = b(l) - if (l .eq. k) go to 10 - b(l) = b(k) - b(k) = t - 10 continue + + integer lda,n,ipvt(*),job + real(r8) :: a(lda,*),b(*) + real(r8) :: t + integer k,kb,l,nm1 + nm1 = n - 1 + if (job .ne. 0) go to 50 + if (nm1 .lt. 1) go to 30 + do 20 k = 1, nm1 + l = ipvt(k) + t = b(l) + if (l .eq. k) go to 10 + b(l) = b(k) + b(k) = t + 10 continue call sxpy(n-k,t,a(k+1,k),1,b(k+1),1) - 20 continue - 30 continue - do 40 kb = 1, n - k = n + 1 - kb - b(k) = b(k)/a(k,k) - t = -b(k) + 20 continue + 30 continue + do 40 kb = 1, n + k = n + 1 - kb + b(k) = b(k)/a(k,k) + t = -b(k) call sxpy(k-1,t,a(1,k),1,b(1),1) - 40 continue - go to 100 - 50 continue - do 60 k = 1, n + 40 continue + go to 100 + 50 continue + do 60 k = 1, n t = sdt(k-1,a(1,k),1,b(1),1) - b(k) = (b(k) - t)/a(k,k) - 60 continue - if (nm1 .lt. 1) go to 90 - do 80 kb = 1, nm1 - k = n - kb + b(k) = (b(k) - t)/a(k,k) + 60 continue + if (nm1 .lt. 1) go to 90 + do 80 kb = 1, nm1 + k = n - kb b(k) = b(k) + sdt(n-k,a(k+1,k),1,b(k+1),1) - l = ipvt(k) - if (l .eq. k) go to 70 - t = b(l) - b(l) = b(k) - b(k) = t - 70 continue - 80 continue - 90 continue - 100 continue - return + l = ipvt(k) + if (l .eq. k) go to 70 + t = b(l) + b(l) = b(k) + b(k) = t + 70 continue + 80 continue + 90 continue + 100 continue + return end subroutine sgsl !----------------------------------------------------------------------- function sdt(n,sx,incx,sy,incy) result(sdtx) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none - - real(r8), intent(in) :: sx(1),sy(1) + real(r8), intent(in) :: sx(*),sy(*) integer, intent(in) :: n, incx, incy integer :: i,ix,iy,m,mp1 real(r8) :: sdtx real(r8) :: stemp - - stemp = 0.0e0_r8 + + stemp = 0.0e0_r8 sdtx = 0.0e0_r8 - if(n.le.0)return - if(incx.eq.1.and.incy.eq.1)go to 20 - ix = 1 - iy = 1 - if(incx.lt.0)ix = (-n+1)*incx + 1 - if(incy.lt.0)iy = (-n+1)*incy + 1 - do 10 i = 1,n - stemp = stemp + sx(ix)*sy(iy) - ix = ix + incx - iy = iy + incy - 10 continue + if(n.le.0)return + if(incx.eq.1.and.incy.eq.1)go to 20 + ix = 1 + iy = 1 + if(incx.lt.0)ix = (-n+1)*incx + 1 + if(incy.lt.0)iy = (-n+1)*incy + 1 + do 10 i = 1,n + stemp = stemp + sx(ix)*sy(iy) + ix = ix + incx + iy = iy + incy + 10 continue sdtx = stemp - return - 20 m = mod(n,5) - if( m .eq. 0 ) go to 40 - do 30 i = 1,m - stemp = stemp + sx(i)*sy(i) - 30 continue - if( n .lt. 5 ) go to 60 - 40 mp1 = m + 1 - do 50 i = mp1,n,5 - stemp = stemp + sx(i)*sy(i) + sx(i + 1)*sy(i + 1) + & - sx(i + 2)*sy(i + 2) + sx(i + 3)*sy(i + 3) + sx(i + 4)*sy(i + 4) - 50 continue + return + 20 m = mod(n,5) + if( m .eq. 0 ) go to 40 + do 30 i = 1,m + stemp = stemp + sx(i)*sy(i) + 30 continue + if( n .lt. 5 ) go to 60 + 40 mp1 = m + 1 + do 50 i = mp1,n,5 + stemp = stemp + sx(i)*sy(i) + sx(i + 1)*sy(i + 1) + & + sx(i + 2)*sy(i + 2) + sx(i + 3)*sy(i + 3) + sx(i + 4)*sy(i + 4) + 50 continue 60 sdtx = stemp - return + return end function sdt !----------------------------------------------------------------------- integer function isfmax(n,sx,incx) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none - real(r8) :: sx(1),smax - integer i,incx,ix,n + + real(r8) :: sx(*),smax + integer i,incx,ix,n isfmax = 0 - if( n .lt. 1 ) return + if( n .lt. 1 ) return isfmax = 1 - if(n.eq.1)return - if(incx.eq.1)go to 20 - ix = 1 - smax = abs(sx(1)) - ix = ix + incx - do 10 i = 2,n - if(abs(sx(ix)).le.smax) go to 5 + if(n.eq.1)return + if(incx.eq.1)go to 20 + ix = 1 + smax = abs(sx(1)) + ix = ix + incx + do 10 i = 2,n + if(abs(sx(ix)).le.smax) go to 5 isfmax = i - smax = abs(sx(ix)) - 5 ix = ix + incx - 10 continue - return - 20 smax = abs(sx(1)) - do 30 i = 2,n - if(abs(sx(i)).le.smax) go to 30 + smax = abs(sx(ix)) + 5 ix = ix + incx + 10 continue + return + 20 smax = abs(sx(1)) + do 30 i = 2,n + if(abs(sx(i)).le.smax) go to 30 isfmax = i - smax = abs(sx(i)) - 30 continue - return + smax = abs(sx(i)) + 30 continue + return end function isfmax !----------------------------------------------------------------------- subroutine sxpy(n,sa,sx,incx,sy,incy) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none - real(r8) :: sx(1),sy(1),sa - integer i,incx,incy,ix,iy,m,mp1,n - if(n.le.0)return - if (sa .eq. 0.0_r8) return - if(incx.eq.1.and.incy.eq.1)go to 20 - ix = 1 - iy = 1 - if(incx.lt.0)ix = (-n+1)*incx + 1 - if(incy.lt.0)iy = (-n+1)*incy + 1 - do 10 i = 1,n - sy(iy) = sy(iy) + sa*sx(ix) - ix = ix + incx - iy = iy + incy - 10 continue - return - 20 m = mod(n,4) - if( m .eq. 0 ) go to 40 - do 30 i = 1,m - sy(i) = sy(i) + sa*sx(i) - 30 continue - if( n .lt. 4 ) return - 40 mp1 = m + 1 - do 50 i = mp1,n,4 - sy(i) = sy(i) + sa*sx(i) - sy(i + 1) = sy(i + 1) + sa*sx(i + 1) - sy(i + 2) = sy(i + 2) + sa*sx(i + 2) - sy(i + 3) = sy(i + 3) + sa*sx(i + 3) - 50 continue - return + + real(r8) :: sx(*),sy(*),sa + integer i,incx,incy,ix,iy,m,mp1,n + if(n.le.0)return + if (sa .eq. 0.0_r8) return + if(incx.eq.1.and.incy.eq.1)go to 20 + ix = 1 + iy = 1 + if(incx.lt.0)ix = (-n+1)*incx + 1 + if(incy.lt.0)iy = (-n+1)*incy + 1 + do 10 i = 1,n + sy(iy) = sy(iy) + sa*sx(ix) + ix = ix + incx + iy = iy + incy + 10 continue + return + 20 m = mod(n,4) + if( m .eq. 0 ) go to 40 + do 30 i = 1,m + sy(i) = sy(i) + sa*sx(i) + 30 continue + if( n .lt. 4 ) return + 40 mp1 = m + 1 + do 50 i = mp1,n,4 + sy(i) = sy(i) + sa*sx(i) + sy(i + 1) = sy(i + 1) + sa*sx(i + 1) + sy(i + 2) = sy(i + 2) + sa*sx(i + 2) + sy(i + 3) = sy(i + 3) + sa*sx(i + 3) + 50 continue + return end subroutine sxpy !----------------------------------------------------------------------- subroutine sscl(n,sa,sx,incx) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none - real(r8) :: sa,sx(1) - integer i,incx,m,mp1,n,nincx - if(n.le.0)return - if(incx.eq.1)go to 20 - nincx = n*incx - do 10 i = 1,nincx,incx - sx(i) = sa*sx(i) - 10 continue - return - 20 m = mod(n,5) - if( m .eq. 0 ) go to 40 - do 30 i = 1,m - sx(i) = sa*sx(i) - 30 continue - if( n .lt. 5 ) return - 40 mp1 = m + 1 - do 50 i = mp1,n,5 - sx(i) = sa*sx(i) - sx(i + 1) = sa*sx(i + 1) - sx(i + 2) = sa*sx(i + 2) - sx(i + 3) = sa*sx(i + 3) - sx(i + 4) = sa*sx(i + 4) - 50 continue - return + + real(r8) :: sa,sx(*) + integer i,incx,m,mp1,n,nincx + if(n.le.0)return + if(incx.eq.1)go to 20 + nincx = n*incx + do 10 i = 1,nincx,incx + sx(i) = sa*sx(i) + 10 continue + return + 20 m = mod(n,5) + if( m .eq. 0 ) go to 40 + do 30 i = 1,m + sx(i) = sa*sx(i) + 30 continue + if( n .lt. 5 ) return + 40 mp1 = m + 1 + do 50 i = mp1,n,5 + sx(i) = sa*sx(i) + sx(i + 1) = sa*sx(i + 1) + sx(i + 2) = sa*sx(i + 2) + sx(i + 3) = sa*sx(i + 3) + sx(i + 4) = sa*sx(i + 4) + 50 continue + return end subroutine sscl !----------------------------------------------------------------------- -!end module mudcom +end module edyn_mudcom diff --git a/src/ionosphere/waccmx/edyn_mudmod.F90 b/src/ionosphere/waccmx/edyn_mudmod.F90 index 7fb68acbc0..24d88db476 100644 --- a/src/ionosphere/waccmx/edyn_mudmod.F90 +++ b/src/ionosphere/waccmx/edyn_mudmod.F90 @@ -1,27 +1,33 @@ -!----------------------------------------------------------------------- - subroutine mudmod(pe,phi_out,jntl,isolve,ier) - use shr_kind_mod ,only: r8 => shr_kind_r8 - use cam_abortutils ,only: endrun - use edyn_solve ,only: cee - use cam_logfile ,only: iulog +module edyn_mudmod + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_logfile, only: iulog + use edyn_mud, only: dismd2cr, mud2cr1, adjmd2cr, kcymd2cr, relmd2cr, resmd2cr + use edyn_mudcom, only: swk2, trsfc2, prolon2, cor2, res2 - implicit none + implicit none - integer jntl,ier ! output: not converged ier < 0 - integer,intent(in) :: isolve + private + + public :: mudmod + +contains +!----------------------------------------------------------------------- + subroutine mudmod(pe,phi_out,jntl,isolve,nlev,ier) + use edyn_solver_coefs,only: cee + use edyn_params, only: pi + + integer,intent(in) :: jntl, isolve, nlev + integer,intent(out) :: ier ! output: not converged ier < 0 ! ! set grid size params ! integer iixp,jjyq,iiex,jjey,nnx,nny,llwork - parameter (iixp = 5 , jjyq = 3, iiex = 5, jjey = 5 ) - parameter (nnx=iixp*2**(iiex-1)+1, nny=jjyq*2**(jjey-1)+1) + parameter (iixp = 5 , jjyq = 3) ! ! estimate work space for point relaxation (see mud2cr.d) ! - parameter (llwork=(7*(nnx+2)*(nny+2)+76*nnx*nny)/3 ) - real(r8) :: phi(nnx,nny),rhs(nnx,nny),work(llwork) - real(r8) :: phi_out(0:nnx+1,0:nny+1) - real(r8) :: time0,time1 + real(r8) :: phi_out(0:iixp*2**(nlev-1)+1+1,0:jjyq*2**(nlev-1)+1+1) + real(r8),allocatable :: phi(:,:),rhs(:,:),work(:) ! ! put integer and floating point argument names in contiguous ! storage for labelling in vectors iprm,fprm @@ -37,17 +43,17 @@ subroutine mudmod(pe,phi_out,jntl,isolve,ier) equivalence(intl,iprm) equivalence(xa,fprm) integer i,j,ierror - real(r8) :: PE(NNX,*) - integer maxcya - DATA MAXCYA/50/ - integer mm,nn,jj,jjj,ij - real(r8) :: pi -! -! set input integer arguments -! - MM = NNX - NN = NNY - PI = 4._r8*ATAN(1._r8) + real(r8) :: PE(iixp*2**(nlev-1)+1,*) + integer, parameter :: maxcya=50 + integer jj,jjj,ij + + iiex = nlev + jjey = nlev + nnx=iixp*2**(iiex-1)+1 + nny=jjyq*2**(jjey-1)+1 + llwork=(7*(nnx+2)*(nny+2)+76*nnx*nny)/3 + + allocate(phi(nnx,nny),rhs(nnx,nny),work(llwork)) ! ! SET INPUT INTEGER PARAMETERS ! @@ -119,52 +125,17 @@ subroutine mudmod(pe,phi_out,jntl,isolve,ier) do i=1,nx phi(i,ny) = rhs(i,ny)/cee(i+(ny-1)*nx+8*nx*ny) end do - -! write(iulog,100) -! 100 format(//' mud2cr test ') -! write (iulog,101) (iprm(i),i=1,15) -! 101 format(/,' integer input arguments ',/, -! | ' intl = ',i2,/,' nxa = ',i2,' nxb = ',i2,' nyc = ',i2, -! | ' nyd = ',i2,/,' ixp = ',i2,' jyq = ',i2,' iex = ',i2, -! | ' jey = ',i2,/,' nx = ',i3,' ny = ',i3,' iguess = ',i2, -! | ' maxcy = ',i3,/,' method = ',i2, ' work space estimate = ',i7) -! write (iulog,102) (mgopt(i),i=1,4) -! 102 format(/' multigrid option arguments ', -! | /,' kcycle = ',i2, -! | /,' iprer = ',i2, -! | /,' ipost = ',i2 -! | /,' intpol = ',i2) -! write(iulog,103) xa,xb,yc,yd,tolmax -! 103 format(/' floating point input parameters ', -! | /,' xa = ',f6.3,' xb = ',f6.3,' yc = ',f6.3,' yd = ',f6.3, -! | /,' tolerance (error control) = ',e10.3) -! write(iulog,"('fprm(1-5) (xa,xb,yc,yd,tolmax=',6f8.3)") fprm(1:5) -! -! intialization call -! -! write(iulog,104) intl -! 104 format(/' discretization call to mud2cr', ' intl = ', i2) call mud2cm(iprm,fprm,work,rhs,phi,mgopt,ierror,isolve) -! write (iulog,200) ierror,iprm(16) -! 200 format(' ierror = ',i2, ' minimum work space = ',i7) -! if (ierror.gt.0) call exit(0) ! ! attempt solution ! intl = 1 -! write(iulog,106) intl,method,iguess -! 106 format(/' approximation call to mud2cr', -! +/' intl = ',i2, ' method = ',i2,' iguess = ',i2) - + call mud2cm(iprm,fprm,work,rhs,phi,mgopt,ierror,isolve) ier = ierror ! ier < 0 not converged if(ier < 0 ) goto 108 - -! write (iulog,107) ierror -! 107 format(' ierror = ',i2) - if (ierror.gt.0) call endrun('mudmod call mud2cm') ! ! COPY PHI TO PE ! @@ -179,7 +150,7 @@ subroutine mudmod(pe,phi_out,jntl,isolve,ier) ! am 8/10 for calculating residual: convert work array (solution) into array ! sized as coefficient stencil (c0, cofum) including values at index 0, nmlon0+1 -! and nmlat0+1 +! and nmlat0+1 do j=0,ny+1 jj = j*(nx+2) @@ -188,14 +159,15 @@ subroutine mudmod(pe,phi_out,jntl,isolve,ier) phi_out(i,j) = work(ij) end do end do - - 108 continue + + 108 continue + + deallocate(phi,rhs,work) + end subroutine mudmod !------------------------------------------------------------------- subroutine mud2cm(iparm,fparm,work,rhs,phi,mgopt,ierror,isolve) - use shr_kind_mod ,only: r8 => shr_kind_r8 - use cam_logfile ,only: iulog - implicit none + integer,intent(in) :: isolve integer iparm,mgopt,ierror integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & @@ -212,7 +184,7 @@ subroutine mud2cm(iparm,fparm,work,rhs,phi,mgopt,ierror,isolve) common/fmud2cr/xa,xb,yc,yd,tolmax,relmax common/mud2crc/kpbgn(50),kcbgn(50),ktxbgn(50),ktybgn(50), & nxk(50),nyk(50),isx,jsy - + data int / 0 / save int @@ -353,29 +325,28 @@ subroutine mud2cm(iparm,fparm,work,rhs,phi,mgopt,ierror,isolve) if (tolmax.gt.0.0_r8) then ! check for convergence fparm(6) = relmax if (relmax.gt.tolmax) then - + ! ierror = -1 ! flag convergenc failure write(iulog,*) "no convergence with mudmod" -! - iguess = 1 - iparm(12)= iguess +! + iguess = 1 + iparm(12)= iguess call mud2cr1(nx,ny,rhs,phi,work) ! solve with modified stencils - + fparm(6) = relmax if (relmax.gt.tolmax) then write(iulog,*) "no convergence with mud" ierror = -1 ! flag convergenc failure end if - + end if end if - + return end subroutine mud2cm -!------------------------------------------------------------------------ +!------------------------------------------------------------------------ subroutine mud2c1m(nx,ny,rhsf,phif,wk) - use shr_kind_mod ,only: r8 => shr_kind_r8 - implicit none + integer nx,ny real(r8) :: phif(nx,ny),rhsf(nx,ny),wk(*) integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & @@ -385,7 +356,7 @@ subroutine mud2c1m(nx,ny,rhsf,phif,wk) integer kpbgn,kcbgn,ktxbgn,ktybgn,nxk,nyk,isx,jsy integer k,kb,ip,ic,ir,ipc,irc,icc integer ncx,ncy,jj,ij,i,j,iter - integer iw,itx,ity,ierror + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & iguess, maxcy,method,nwork,lwork,itero,ngrid, & klevel,kcur,kcycle,iprer,ipost,intpol,kps @@ -473,14 +444,14 @@ subroutine mud2c1m(nx,ny,rhsf,phif,wk) ! relmax = 0.0_r8 phmax = 0.0_r8 - + do j=1,nfy jj = j*(nfx+2) do i=1,nfx ij = jj+i+1 phmax = max(phmax,abs(wk(ij))) relmax = max(relmax,abs(wk(ij)-phif(i,j))) - + phif(i,j) = wk(ij) end do end do @@ -506,13 +477,11 @@ end subroutine mud2c1m !------------------------------------------------------------------------ subroutine kcym2cm(wk) - use shr_kind_mod ,only: r8 => shr_kind_r8 - use edyn_solve,only: cofum + use edyn_solver_coefs,only: cofum ! ! execute multigrid k cycle from kcur grid level ! kcycle=1 for v cycles, kcycle=2 for w cycles ! - implicit none real(r8) :: wk(*) integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & @@ -528,8 +497,8 @@ subroutine kcym2cm(wk) nxk(50),nyk(50),isx,jsy integer kount(50) ! real(r8) :: :: cofum -! common/mudmd/cofum(1) - +! common/mudmd/cofum(1) + klevel = kcur nx = nxk(klevel) ny = nyk(klevel) @@ -673,14 +642,12 @@ subroutine kcym2cm(wk) end do return end subroutine kcym2cm -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- subroutine resm2cm(nx,ny,phi,ncx,ncy,phic,rhsc,cof,resf,cofum) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! restrict residual from fine to coarse mesh using fully weighted ! residual restriction ! - implicit none integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & kcycle,iprer,ipost,intpol,kps @@ -700,12 +667,12 @@ subroutine resm2cm(nx,ny,phi,ncx,ncy,phic,rhsc,cof,resf,cofum) phic(ic,jc) = 0.0_r8 end do end do - + call bnd2cm(nx,ny,cofum) ! ! compute residual on fine mesh in resf ! - l2norm = 0._r8 + l2norm = 0._r8 !$OMP PARALLEL DO SHARED(resf,cof,phi,nx,ny) PRIVATE(i,j) do j=1,ny do i=1,nx @@ -719,7 +686,7 @@ subroutine resm2cm(nx,ny,phi,ncx,ncy,phic,rhsc,cof,resf,cofum) cofum(i,j,7)*phi(i,j-1)+ & cofum(i,j,8)*phi(i+1,j-1)+ & cofum(i,j,9)*phi(i,j)) - + l2norm = l2norm + resf(i,j)*resf(i,j) end do end do @@ -732,23 +699,20 @@ end subroutine resm2cm !----------------------------------------------------------------------- subroutine bnd2cm(nx,ny,cf) - use shr_kind_mod ,only: r8 => shr_kind_r8 ! ! set stencil & boundary condition for finest stencil ! - implicit none integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & kcycle,iprer,ipost,intpol,kps real(r8) :: xa,xb,yc,yd,tolmax,relmax - integer nx,ny,i,j,kbdy,l,im1,jm1,ier,jc,nnx,nny + integer nx,ny,i,j,l real(r8) :: cf(nx,ny,*) - real(r8) :: dlx,dlx2,dlxx,dly,dly2,dlyy,cmin,alfmax,cemax common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & iguess, maxcy,method,nwork,lwork,itero,ngrid, & klevel,kcur,kcycle,iprer,ipost,intpol,kps common/fmud2cr/xa,xb,yc,yd,tolmax,relmax - + ! ! set coefficient for specified boundaries ! @@ -792,3 +756,4 @@ subroutine bnd2cm(nx,ny,cf) return end subroutine bnd2cm !----------------------------------------------------------------------- +end module edyn_mudmod diff --git a/src/ionosphere/waccmx/edyn_muh2cr.F90 b/src/ionosphere/waccmx/edyn_muh2cr.F90 index 78a31e0fdd..d58bd0132b 100644 --- a/src/ionosphere/waccmx/edyn_muh2cr.F90 +++ b/src/ionosphere/waccmx/edyn_muh2cr.F90 @@ -1,32 +1,45 @@ +module edyn_muh2cr + use shr_kind_mod , only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use edyn_mudcom, only: prolon2, trsfc2, factri,factrp, sgfa, sgsl, transp + use edyn_mudcom, only: swk2, cor2, transp, res2 + + implicit none + + private + + public :: muh + +contains !----------------------------------------------------------------------- - subroutine muh(pe,jntl) - use shr_kind_mod ,only: r8 => shr_kind_r8 - use cam_abortutils ,only: endrun - use edyn_solve,only: nc,ncee,cee - use cam_logfile ,only: iulog + subroutine muh(pe,nlon,nlat,nlev,jntl) + use edyn_solver_coefs, only: cee + use edyn_params, only: pi implicit none - integer jntl + + integer,intent(in) :: nlon, nlat, nlev, jntl + real(r8),intent(out) :: PE(nlon+1,*) ! ! set grid size params ! - integer,parameter :: iixp = 80 , jjyq = 48,iiex = 1, jjey = 1 - integer,parameter :: nnx=iixp*2**(iiex-1)+1, nny=jjyq*2**(jjey-1)+1 + integer :: iixp, jjyq + integer,parameter :: iiex = 1, jjey = 1 + integer :: nnx, nny ! ! estimate work space for point relaxation (see muh2cr.d) ! - integer,parameter :: llwork=(5*((nnx+2)*(nny+2)+18*nnx*nny)/3+ & - (nnx+2)*(nny+2)+ (iixp+1)*(jjyq+1)*(2*iixp+3)) - integer,parameter :: iiwork=(iixp+1)*(jjyq+1) - real(r8) :: phi(nnx,nny),rhs(nnx,nny),work(llwork) - integer iwork(iiwork) + integer :: llwork + integer :: iiwork + real(r8), allocatable :: phi(:,:),rhs(:,:),work(:) + integer, allocatable :: iwork(:) ! ! put integer and floating point argument names in contiguous ! storage for labelling in vectors iprm,fprm ! - integer iprm(17),mgopt(4) + integer :: iprm(17),mgopt(4) real(r8) :: fprm(6) - integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nx,ny,& + integer :: intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nx,ny,& iguess,maxcy,method,nwork,lwrkqd,itero common/itmud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nx,ny,& iguess,maxcy,method,nwork,lwrkqd,itero @@ -34,19 +47,21 @@ subroutine muh(pe,jntl) common/ftmud2cr/xa,xb,yc,yd,tolmax,relmax equivalence(intl,iprm) equivalence(xa,fprm) - integer i,j,ierror - real(r8) :: PE(NNX,1) - integer maxcya -! DATA MAXCYA/20/ - DATA MAXCYA/1/ - integer mm,nn,jj,jjj - real(r8) :: pi -! -! set input integer arguments -! - MM = NNX - NN = NNY - PI = 4._r8*ATAN(1._r8) + integer :: i,j,ierror + integer, parameter :: maxcya = 1 + integer jj,jjj + + iixp = nlon + jjyq = (nlat-1)/2 + nnx=iixp*2**(iiex-1)+1 + nny=jjyq*2**(jjey-1)+1 + llwork=(5*((nnx+2)*(nny+2)+18*nnx*nny)/3+ & + (nnx+2)*(nny+2)+ (iixp+1)*(jjyq+1)*(2*iixp+3)) + iiwork=(iixp+1)*(jjyq+1) + + allocate(phi(nnx,nny),rhs(nnx,nny),work(llwork)) + allocate(iwork(iiwork)) + ! ! SET INPUT INTEGER PARAMETERS ! @@ -74,7 +89,12 @@ subroutine muh(pe,jntl) mgopt(1) = 2 mgopt(2) = 2 mgopt(3) = 2 - mgopt(4) = 3 + if (nlat<=97) then + mgopt(4) = 3 + else + ! 1 deg, changed to mgopt(4) = 1 per Astrid's suggestion + mgopt(4) = 1 + end if ! ! set for one cycle ! @@ -101,7 +121,13 @@ subroutine muh(pe,jntl) ! ! set error control flag ! - tolmax = 0.01_r8 + if (nlev>6) then + tolmax = 0.05_r8 + else if (nlev>5) then + tolmax = 0.03_r8 + else + tolmax = 0.01_r8 + end if ! ! set right hand side in rhs ! initialize phi to zero @@ -124,45 +150,17 @@ subroutine muh(pe,jntl) DO I=1,NX PHI(I,NY) = RHS(I,NY)/CEE(I+(NY-1)*NX+8*NX*NY) END DO - -! write(iulog,100) - 100 format(//' mud2cr test ') -! write (iulog,101) (iprm(i),i=1,15) -! 101 format(/,' integer input arguments ',/, -! | ' intl = ',i2,/,' nxa = ',i2,' nxb = ',i2,' nyc = ',i2, -! | ' nyd = ',i2,/,' ixp = ',i2,' jyq = ',i2,' iex = ',i2, -! | ' jey = ',i2,/,' nx = ',i3,' ny = ',i3,' iguess = ',i2, -! | ' maxcy = ',i3,/,' method = ',i2, ' work space estimate = ',i7) -! write (iulog,102) (mgopt(i),i=1,4) -! 102 format(/' multigrid option arguments ', -! | /,' kcycle = ',i2, -! | /,' iprer = ',i2, -! | /,' ipost = ',i2 -! | /,' intpol = ',i2) -! write(iulog,103) xa,xb,yc,yd,tolmax -! 103 format(/' floating point input parameters ', -! | /,' xa = ',f6.3,' xb = ',f6.3,' yc = ',f6.3,' yd = ',f6.3, -! | /,' tolerance (error control) = ',e10.3) -! write(iulog,"('fprm(1-5) (xa,xb,yc,yd,tolmax=',6f8.3)") fprm(1:5) + ! ! intialization call ! -! write(iulog,104) intl - 104 format(/' discretization call to muh2cr', ' intl = ', i2) call muh2cr(iprm,fprm,work,iwork,rhs,phi,mgopt,ierror) -! write (iulog,200) ierror,iprm(16) -! 200 format(' ierror = ',i2, ' minimum work space = ',i7) if (ierror.gt.0) call endrun('muh call init muh2cr') ! ! attempt solution ! intl = 1 -! write(iulog,106) intl,method,iguess -! 106 format(/' approximation call to muh2cr', -! +/' intl = ',i2, ' method = ',i2,' iguess = ',i2) call muh2cr(iprm,fprm,work,iwork,rhs,phi,mgopt,ierror) -! write (iulog,107) ierror - 107 format(' ierror = ',i2) if (ierror.gt.0) call endrun('muh call solve muh2cr') ! ! COPY PHI TO PE @@ -175,8 +173,11 @@ subroutine muh(pe,jntl) PE(I,JJJ) = PHI(I,J) END DO END DO + + deallocate( phi, rhs, work, iwork) + end subroutine muh -!----------------------------------------------------------------------- +!----------------------------------------------------------------------- subroutine muh2cr(iparm,fparm,wk,iwk,rhs,phi,mgopt,ierror) use shr_kind_mod ,only: r8 => shr_kind_r8 implicit none @@ -338,7 +339,7 @@ subroutine muh2cr(iparm,fparm,wk,iwk,rhs,phi,mgopt,ierror) itx = ktxbgn(k) ity = ktybgn(k) klevel = k - call dismh2cr(nx,ny,wk(ic),wk(itx),wk(ity),wk,iwk,ierror) + call dismh2cr(nx,ny,wk(ic),wk(itx),wk(ity),wk,iwk) end do return end if ! end of intl=0 initialization call block @@ -460,7 +461,7 @@ subroutine muh2cr1(nx,ny,rhsf,phif,wk,iwk) ij = jj+i+1 phmax = max(phmax,abs(wk(ij))) relmax = max(relmax,abs(wk(ij)-phif(i,j))) - + phif(i,j) = wk(ij) end do end do @@ -468,7 +469,7 @@ subroutine muh2cr1(nx,ny,rhsf,phif,wk,iwk) ! set maximum relative difference and check for convergence ! if (phmax.gt.0.0_r8) relmax = relmax/phmax - + if (relmax.le.tolmax) return end if end do @@ -684,11 +685,10 @@ subroutine kcymh2cr(wk,iwk) return end subroutine kcymh2cr !----------------------------------------------------------------------- - subroutine dismh2cr(nx,ny,cf,tx,ty,wk,iwk,ier) + subroutine dismh2cr(nx,ny,cf,tx,ty,wk,iwk) use shr_kind_mod ,only: r8 => shr_kind_r8 use cam_abortutils ,only: endrun - use edyn_solve,only: nc,ncee,cee,ceee - use cam_logfile ,only: iulog + use edyn_solver_coefs,only: nc,cee,ceee ! ! discretize elliptic pde for muh2cr, set nonfatal errors ! @@ -697,7 +697,7 @@ subroutine dismh2cr(nx,ny,cf,tx,ty,wk,iwk,ier) maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur,& kcycle,iprer,ipost,intpol,kps real(r8) :: xa,xb,yc,yd,tolmax,relmax - integer nx,ny,iwk(*),i,j,kbdy,l,im1,jm1,ier,jc + integer nx,ny,iwk(*),i,j,l,im1,jm1 real(r8) :: cf(nx,ny,10),tx(nx,ny,*),ty(ny,nx,*) real(r8) :: wk(*) common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,& @@ -962,7 +962,7 @@ subroutine for2cr(nx,ny,phi,frhs,alfa) phi(i,j)=phi(i,j)-sum end do end do - return + return end subroutine for2cr !----------------------------------------------------------------------- subroutine bkw2cr(nx,ny,phi,cof,beta,index,nxa) @@ -992,7 +992,7 @@ subroutine bkw2cr(nx,ny,phi,cof,beta,index,nxa) end if call sgsl(beta(1,1,jcur),nx ,nx ,index(1,jcur),phi(1,jcur),iz) end do - return + return end subroutine bkw2cr !----------------------------------------------------------------------- subroutine lud2crp(nx,ny,cof,beta,alfa,zmat,dmat,index,nxa) @@ -1384,11 +1384,11 @@ subroutine setbcr(nx,ny,cof,beta,jcur,nxa) do i=1,nx-1 beta(i,i+1,jcur) = cof(i,jcur,1) end do - if (nxa.eq.0) then + if (nxa.eq.0) then beta(1,nx-1,jcur) = cof(1,jcur,5) beta(nx,2,jcur) = cof(nx,jcur,1) - end if - return + end if + return end subroutine setbcr !----------------------------------------------------------------------- subroutine setacr(nx,ny,cof,alfa,jcur,nxa) @@ -1424,26 +1424,18 @@ subroutine adjmh2cr(nx,ny,phi,cf) ! adjust righthand side in cf(i,j,10) for boundary conditions ! implicit none - integer intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & + integer :: intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy,iguess, & maxcy,method,nwork,lwork,itero,ngrid,klevel,kcur, & kcycle,iprer,ipost,intpol,kps real(r8) :: xa,xb,yc,yd,tolmax,relmax - integer nx,ny,i,j,kbdy + integer :: nx,ny,i,j real(r8) :: cf(nx,ny,10),phi(0:nx+1,0:ny+1) - real(r8) :: dlx,dlx2,dlxx,dly,dly2,dlyy,dlxy,dlxy2,dlxy4,dxoy,dyox - real(r8) :: x,y,cxx,cxy,cyy,cx,cy,ce,c1,c2,c3,c4,c5 - real(r8) :: c6,c7,c8 - real(r8) :: alfaa,alfab,alfac,alfad,betaa,betab,betac,betad,det - real(r8) :: gamaa,gamab,gamac,gamad - real(r8) :: alfim1,alfi,alfip1,betim1,beti,betip1,gamim1,gami,gamip1 - real(r8) :: alfjm1,alfj,alfjp1,betjm1,betj,betjp1,gamjm1,gamj,gamjp1 - real(r8) :: gbdim1,gbdi,gbdip1,gbdj,gbdjm1,gbdjp1 - real(r8) :: gbdya,gbdyb,gbdyc,gbdyd + common/imud2cr/intl,nxa,nxb,nyc,nyd,ixp,jyq,iex,jey,nfx,nfy, & iguess, maxcy,method,nwork,lwork,itero,ngrid, & klevel,kcur,kcycle,iprer,ipost,intpol,kps common/fmud2cr/xa,xb,yc,yd,tolmax,relmax - + ! ! set specified boundaries in rhs from phi @@ -2022,3 +2014,4 @@ subroutine slymh2cr(nx,ny,phi,cof,ty,sum) return end subroutine slymh2cr !----------------------------------------------------------------------- +end module edyn_muh2cr diff --git a/src/ionosphere/waccmx/edyn_params.F90 b/src/ionosphere/waccmx/edyn_params.F90 index ad2fefc93a..ddfff65cde 100644 --- a/src/ionosphere/waccmx/edyn_params.F90 +++ b/src/ionosphere/waccmx/edyn_params.F90 @@ -1,44 +1,45 @@ module edyn_params -! -! Constants for edynamo. -! - use shr_kind_mod, only: r8 => shr_kind_r8 ! 8-byte reals - use physconst, only: pi + ! + ! Constants for edynamo. + ! + use shr_kind_mod, only: r8 => shr_kind_r8 ! 8-byte reals + use shr_const_mod, only: rearth_m => SHR_CONST_REARTH ! meters + use physconst, only: pi - implicit none - save + implicit none + save - private + private - public :: pi, pi_dyn, re_dyn, r0, re, rtd, dtr, finit, h0, hs - public :: kbotdyn, pbotdyn, cm2km + public :: pi, pi_dyn, re_dyn, r0, Rearth, rtd, dtr, finit, h0, hs + public :: kbotdyn, pbotdyn, cm2km - real(r8),parameter :: & - finit = 0._r8, & ! initialization value - re = 6.37122e8_r8, & ! earth radius (cm) - h0 = 9.7e6_r8, & ! minimum height (cm) - r0 = re+h0, & ! min height from earth center - hs = 1.3e7_r8, & - cm2km = 1.e-5_r8 ! cm to km conversion -! -! Special pi for mag field calculations. If pi=4.*atan(1.) and code is -! linked with -lmass lib, then the last 2 digits (16th and 17th) of pi -! are different (56 instead of 12), resulting in theta0(j=49)==0., which -! is wrong (should be .1110e-15). -! - real(r8),parameter :: pi_dyn = 3.14159265358979312_r8 ! pi for dynamo - real(r8),parameter :: re_dyn = 6.378165e8_r8 ! earth radius (cm) for dynamo -! - real(r8),parameter :: dtr = pi/180._r8 ! degrees to radians - real(r8),parameter :: rtd = 180._r8/pi ! radians to degrees -! -! kbotdyn is the column index at which upward dynamo integrals begin. -! This should correspond to about 85 km (zbotdyn). The index is determined -! by function find_kbotdyn (edynamo.F90) at every step (called by sub -! dynamo_input). The function insures that all processors use the same -! (minimum) kbotdyn. -! - real(r8),parameter :: pbotdyn = 1.0_r8 ! Pa pressure (~80 km) at which to set kbotdyn - integer :: kbotdyn = -1 + real(r8), parameter :: & + finit = 0._r8, & ! initialization value + Rearth = rearth_m*100._r8, & ! earth radius (cm) + h0 = 9.7e6_r8, & ! minimum height (cm) + r0 = Rearth + h0, & ! min height from earth center + hs = 1.3e7_r8, & ! apex reference altitude (cm) (XXgoldyXX:modified?) + cm2km = 1.e-5_r8 ! cm to km conversion + ! + ! Special pi for mag field calculations. If pi=4.*atan(1.) and code is + ! linked with -lmass lib, then the last 2 digits (16th and 17th) of pi + ! are different (56 instead of 12), resulting in theta0(j=49)==0., which + ! is wrong (should be .1110e-15). + ! + real(r8),parameter :: pi_dyn = 3.14159265358979312_r8 ! pi for dynamo + real(r8),parameter :: re_dyn = 6.378165e8_r8 ! earth radius (cm) for dynamo + ! + real(r8),parameter :: dtr = pi/180._r8 ! degrees to radians + real(r8),parameter :: rtd = 180._r8/pi ! radians to degrees + ! + ! kbotdyn is the column index at which upward dynamo integrals begin. + ! This should correspond to about 85 km (zbotdyn). The index is determined + ! by function find_kbotdyn (edynamo.F90) at every step (called by sub + ! dynamo_input). The function insures that all processors use the same + ! (minimum) kbotdyn. + ! + real(r8), parameter :: pbotdyn = 1.0_r8 ! Pa pressure (~80 km) at which to set kbotdyn + integer :: kbotdyn = -1 end module edyn_params 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/edyn_solve.F90 b/src/ionosphere/waccmx/edyn_solve.F90 index d570a004e8..721bbc09af 100644 --- a/src/ionosphere/waccmx/edyn_solve.F90 +++ b/src/ionosphere/waccmx/edyn_solve.F90 @@ -1,103 +1,156 @@ module edyn_solve ! -! Prepare stencils and call mudpack PDE solver. This is executed +! Prepare stencils and call mudpack PDE solver. This is executed ! by the root task only, following the gather_edyn call in edynamo.F90. ! use shr_kind_mod ,only: r8 => shr_kind_r8 ! 8-byte reals use cam_logfile ,only: iulog use edyn_params ,only: finit - use edyn_maggrid ,only: nmlon,nmlonp1,nmlat,nmlath,nmlev + use edyn_maggrid ,only: nmlon,nmlonp1,nmlat,nmlath + use edyn_maggrid ,only: res_nlev, res_ngrid + use spmd_utils, only: masterproc + use edyn_solver_coefs, only: nc, cee, cofum implicit none - save + private + + public :: edyn_solve_init + public :: solve_edyn + ! ! Global 2d fields for root task to complete serial part of dynamo. -! The zigmxxx, rhs and rims are gathered from subdomains by in sub +! The zigmxxx, rhs and rims are gathered from subdomains by in sub ! gather_edyn (edynamo.F90). ! - real(r8),dimension(nmlonp1,nmlat) :: & + real(r8),allocatable, dimension(:,:), public :: & zigm11_glb ,& zigm22_glb ,& zigmc_glb ,& zigm2_glb ,& rhs_glb - real(r8),dimension(nmlonp1,nmlat,2) :: & + real(r8),allocatable, dimension(:,:,:), public :: & rim_glb ! pde solver output - real(r8),dimension(0:nmlonp1,0:nmlat+1) :: & + real(r8),allocatable, dimension(:,:) :: & phisolv ! -! Dimensions of the 5 grid resolutions for the multi-grid PDE: - integer,parameter :: & - nmlon0=nmlon+1, & - nmlat0=(nmlat +1)/2, & - nmlon1=(nmlon0+1)/2, & - nmlat1=(nmlat0+1)/2, & - nmlon2=(nmlon1+1)/2, & - nmlat2=(nmlat1+1)/2, & - nmlon3=(nmlon2+1)/2, & - nmlat3=(nmlat2+1)/2, & - nmlon4=(nmlon3+1)/2, & - nmlat4=(nmlat3+1)/2 -! -! Unmodified coefficients for using modified mudpack: - real(r8),dimension(nmlon0,nmlat0,9) :: cofum -! -! Space needed for descretized coefficients of of dynamo pde at all -! 5 levels of resolution: -! - integer,parameter :: & - ncee=10*nmlon0*nmlat0+9*(nmlon1*nmlat1+nmlon2*nmlat2+nmlon3* & - nmlat3+nmlon4*nmlat4) -! -! Coefficients are stored in 1-d array cee(ncee) -! cee transmits descretized dynamo PDE coefficients to the multi-grid -! mudpack solver. (cee was formerly in ceee.h) -! The common block /cee_com/ is retained from earlier versions because -! of the equivalencing below of coefficient arrays c0, c1, etc. -! - real(r8) :: cee(ncee) - common/cee_com/ cee +! Dimensions of the grid resolutions for the multi-grid PDE: + integer, public, protected :: & + nmlon0, & + nmlat0, & + nmlon1, & + nmlat1, & + nmlon2, & + nmlat2, & + nmlon3, & + nmlat3, & + nmlon4, & + nmlat4, & + nmlon5, & + nmlat5, & + nmlon6, & + nmlat6, & + nmlon7, & + nmlat7 +! +! Space needed for descretized coefficients of of dynamo pde at all levels: +! + integer :: ncee ! ! The following parameters nc0,nc1,... are pointers to the beginning of ! the coefficients for each level of resolution. ! - integer,parameter :: & - nc0=1, & - nc1=nc0+10*nmlon0*nmlat0, & - nc2=nc1+9 *nmlon1*nmlat1, & - nc3=nc2+9 *nmlon2*nmlat2, & - nc4=nc3+9 *nmlon3*nmlat3 -! -! nc(1:6) are pointers to beginning of coefficient blocks at each of -! 5 levels of resolution: -! nc(1) = nc0, pointer to coefficients for highest resolution. -! nc(2) = nc1, pointer to coefficients at half the resolution of nc0, -! and so on for nc(3), nc(4), nc(5), etc. -! nc(6) = ncee, the dimension of the entire cee array, containing -! coefficients for all 5 levels of resolution. + integer :: & + nc0, & + nc1, & + nc2, & + nc3, & + nc4, & + nc5, & + nc6, & + nc7 + + real(r8), private, pointer :: & + c0(:), & + c1(:), & + c2(:), & + c3(:), & + c4(:), & + c5(:), & + c6(:), & + c7(:) + +! phihm is high-latitude potential, set by the high-latitude potential model (e.g. Heelis) +! or is prescribed (e.g. AMIE) ! - integer :: nc(6) + real(r8), allocatable, public :: phihm(:,:) ! high-latitude potential + real(r8), allocatable, public :: pfrac(:,:) ! NH fraction of potential - real(r8) :: & - c0(nmlon0,nmlat0,10), & - c1(nmlon1,nmlat1,9), & - c2(nmlon2,nmlat2,9), & - c3(nmlon3,nmlat3,9), & - c4(nmlon4,nmlat4,9) - equivalence & - (cee,c0), & - (cee(nc1),c1), & - (cee(nc2),c2), & - (cee(nc3),c3), & - (cee(nc4),c4) -! -! phihm is high-latitude potential, obtained from the Heelis model -! (heelis.F90): -! - real(r8) :: phihm(nmlonp1,nmlat) ! high-latitude potential - real(r8) :: pfrac(nmlonp1,nmlat0) ! NH fraction of potential - contains + +!----------------------------------------------------------------------- + subroutine edyn_solve_init + use infnan, only: nan, assignment(=) + + allocate(zigm11_glb(nmlonp1,nmlat)) + allocate(zigm22_glb(nmlonp1,nmlat)) + allocate(zigmc_glb(nmlonp1,nmlat)) + allocate(zigm2_glb(nmlonp1,nmlat)) + allocate(rhs_glb(nmlonp1,nmlat)) + allocate(rim_glb(nmlonp1,nmlat,2)) + allocate(phisolv(0:nmlonp1,0:nmlat+1)) + + phisolv(:,:) = 0._r8 + + nmlon0=nmlon+1 + nmlat0=(nmlat +1)/2 + nmlon1=(nmlon0+1)/2 + nmlat1=(nmlat0+1)/2 + nmlon2=(nmlon1+1)/2 + nmlat2=(nmlat1+1)/2 + nmlon3=(nmlon2+1)/2 + nmlat3=(nmlat2+1)/2 + nmlon4=(nmlon3+1)/2 + nmlat4=(nmlat3+1)/2 + nmlon5=(nmlon4+1)/2 + nmlat5=(nmlat4+1)/2 + nmlon6=(nmlon5+1)/2 + nmlat6=(nmlat5+1)/2 + nmlon7=(nmlon6+1)/2 + nmlat7=(nmlat6+1)/2 + + allocate(cofum(nmlon0,nmlat0,9)) + + ncee=10*nmlon0*nmlat0+9*(nmlon1*nmlat1+nmlon2*nmlat2+nmlon3* & + nmlat3+nmlon4*nmlat4+nmlon5*nmlat5+nmlon6*nmlat6+nmlon7*nmlat7) + + allocate(cee(ncee)) + + nc0=1 + nc1=nc0+10*nmlon0*nmlat0 + nc2=nc1+9 *nmlon1*nmlat1 + nc3=nc2+9 *nmlon2*nmlat2 + nc4=nc3+9 *nmlon3*nmlat3 + nc5=nc4+9 *nmlon4*nmlat4 + nc6=nc5+9 *nmlon5*nmlat5 + nc7=nc6+9 *nmlon6*nmlat6 + + c0 => cee + c1 => cee(nc1:) + c2 => cee(nc2:) + c3 => cee(nc3:) + c4 => cee(nc4:) + c5 => cee(nc5:) + c6 => cee(nc6:) + c7 => cee(nc7:) + + allocate(phihm(nmlonp1,nmlat)) + allocate(pfrac(nmlonp1,nmlat0)) + + phihm = nan + pfrac = nan + + end subroutine edyn_solve_init + !----------------------------------------------------------------------- subroutine solve_edyn ! @@ -116,7 +169,7 @@ subroutine stencils use edyn_maggrid,only: dlatm,dlonm ! ! Locals: - integer :: i,j,jj,jjj,j0,n,ncc,nmaglon,nmaglat + integer :: i,j,jj,jjj,j0,n,ncc,nmaglon,nmaglat, ndx1,ndx2 real(r8) :: sym real(r8) :: cs(nmlat0) @@ -128,7 +181,10 @@ subroutine stencils nc(3) = nc2 nc(4) = nc3 nc(5) = nc4 - nc(6) = ncee + nc(6) = nc5 + nc(7) = nc6 + nc(8) = nc7 + nc(9) = ncee do j=1,nmlat0 cs(j) = cos(pi_dyn/2._r8-(nmlat0-j)*dlatm) @@ -190,28 +246,31 @@ subroutine stencils ! ! Sigma_(phi phi)/( cos(lam_m)*dt0dts*(Delta lon)^2 ) sym = 1._r8 - call stencmd(zigm11_glb,cs,nmlon0,nmlat0,sym,cee,1) + call stencmd(zigm11_glb,nmlon0,nmlat0,sym,cee,1) ! ! Sigma_(lam lam)*cos(lam_m)*dt0dts/(Delta lam)^2 sym = 1._r8 - call stencmd(zigm22_glb,cs,nmlon0,nmlat0,sym,cee,4) + call stencmd(zigm22_glb,nmlon0,nmlat0,sym,cee,4) ! ! Sigma_(phi lam)/( 4*Delta lam* Delta lon ) sym = -1._r8 - call stencmd(zigmc_glb,cs,nmlon0,nmlat0,sym,cee,2) + call stencmd(zigmc_glb,nmlon0,nmlat0,sym,cee,2) ! ! Sigma_(lam phi)/( 4*Delta lam* Delta lon ) sym = -1._r8 - call stencmd(zigm2_glb,cs,nmlon0,nmlat0,sym,cee,3) + call stencmd(zigm2_glb,nmlon0,nmlat0,sym,cee,3) ! ! Insert RHS in finest stencil: do j = 1,nmlat0 jj = nmlath-nmlat0+j do i = 1,nmlon0 - c0(i,j,10) = rhs_glb(i,jj) + ndx1 = 9*nmlat0*nmlon0 + (j-1)*nmlon0 + i + c0(ndx1) = rhs_glb(i,jj) enddo ! i = 1,nmlon0 enddo ! j = 1,nmlat0 - c0(nmlonp1,1,10) = c0(1,1,10) + ndx1 = 9*nmlat0*nmlon0 + nmlonp1 + ndx2 = 9*nmlat0*nmlon0 + 1 + c0(ndx1) = c0(ndx2) ! ! Set boundary condition at the pole: call edges(c0,nmlon0,nmlat0) @@ -219,19 +278,38 @@ subroutine stencils call edges(c2,nmlon2,nmlat2) call edges(c3,nmlon3,nmlat3) call edges(c4,nmlon4,nmlat4) + if ( res_nlev > 5 ) then + call edges(c5,nmlon5,nmlat5) + endif + if ( res_nlev > 6 ) then + call edges(c6,nmlon6,nmlat6) + endif + if ( res_nlev > 7 ) then + call edges(c7,nmlon7,nmlat7) + endif call edges(cofum,nmlon0,nmlat0) ! ! Divide stencils by cos(lam_0) (not rhs): - call divide(c0,nmlon0,nmlat0,nmlon0,nmlat0,cs,1) - call divide(c1,nmlon1,nmlat1,nmlon0,nmlat0,cs,1) - call divide(c2,nmlon2,nmlat2,nmlon0,nmlat0,cs,1) - call divide(c3,nmlon3,nmlat3,nmlon0,nmlat0,cs,1) - call divide(c4,nmlon4,nmlat4,nmlon0,nmlat0,cs,1) - call divide(cofum,nmlon0,nmlat0,nmlon0,nmlat0,cs,0) + call divide(c0,nmlon0,nmlat0,nmlon0,cs,1) + call divide(c1,nmlon1,nmlat1,nmlon0,cs,1) + call divide(c2,nmlon2,nmlat2,nmlon0,cs,1) + call divide(c3,nmlon3,nmlat3,nmlon0,cs,1) + call divide(c4,nmlon4,nmlat4,nmlon0,cs,1) + if ( res_nlev > 5 ) then + call divide(c5,nmlon5,nmlat5,nmlon0,cs,1) + endif + if ( res_nlev > 6 ) then + call divide(c6,nmlon6,nmlat6,nmlon0,cs,1) + endif + if ( res_nlev > 7 ) then + call divide(c7,nmlon7,nmlat7,nmlon0,cs,1) + endif + call divide(cofum,nmlon0,nmlat0,nmlon0,cs,0) ! ! Set value of solution to 1. at pole: do i=1,nmlon0 - c0(i,nmlat0,10) = 1._r8 + ndx1 = 9*nmlat0*nmlon0 + (nmlat0-1)*nmlon0 + i + c0(ndx1) = 1._r8 enddo ! ! Modify stencils and RHS so that the NH high lat potential is inserted at @@ -248,13 +326,13 @@ subroutine stencils ncc = 1 nmaglon = nmlon0 nmaglat = nmlat0 - do n=1,5 + do n=1,res_nlev ! resolution levels call stenmd(nmaglon,nmaglat,cee(ncc),phihm(1,nmlat0),pfrac) ncc = ncc+9*nmaglon*nmaglat if (n==1) ncc = ncc+nmaglon*nmaglat ! rhs is in 10th slot nmaglon = (nmaglon+1)/2 nmaglat = (nmaglat+1)/2 - enddo ! n=1,5 + enddo end subroutine stencils !----------------------------------------------------------------------- @@ -276,11 +354,11 @@ subroutine clearcee(cee,nlon0,nlat0) nlon = nlon0 nlat = nlat0 n = 0 - do m=1,5 ! 5 resolution levels + do m=1,res_nlev ! resolution levels n = n+nlon*nlat nlon = (nlon+1)/2 nlat = (nlat+1)/2 - enddo ! m=1,5 (5 resolution levels) + enddo n = 9*n+nlon0*nlat0 ! ! Clear cee: @@ -289,7 +367,7 @@ subroutine clearcee(cee,nlon0,nlat0) enddo end subroutine clearcee !----------------------------------------------------------------------- - subroutine stencmd(zigm,cs,nlon0,nlat0,sym,cee,ncoef) + subroutine stencmd(zigm,nlon0,nlat0,sym,cee,ncoef) ! ! Calculate contribution fo 3 by 3 stencil from coefficient zigm ! at each grid point and level. @@ -301,14 +379,13 @@ subroutine stencmd(zigm,cs,nlon0,nlat0,sym,cee,ncoef) ncoef ! integer identifier of coefficient real(r8),intent(in) :: & zigm(nlon0,nlat0), & ! coefficients (nlon0+1/2,(nlat0+1)/2) - sym, & ! 1. if zigm symmetric w.r.t. equator, -1 otherwise - cs(nlat0) + sym ! 1. if zigm symmetric w.r.t. equator, -1 otherwise real(r8),intent(inout) :: & ! output stencil array consisting of c0,c1,c2,c3,c4 - cee(*) + cee(*) ! ! Local: integer :: nc,nlon,nlat,n - real(r8) :: wkarray(-15:nmlon0+16,nmlat0) + real(r8) :: wkarray(-res_ngrid+1:nmlon0+res_ngrid,nmlat0) ! ! Perform half-way interpolation and extend zigm in wkarray: ! @@ -322,15 +399,15 @@ subroutine stencmd(zigm,cs,nlon0,nlat0,sym,cee,ncoef) ! ! Calculate modified and unmodified stencil on finest grid ! - call cnmmod(nlon0,nlat0,nlon,nlat,cee(nc),ncoef,wkarray,cofum) + call cnmmod(nlon0,nlon,nlat,cee(nc),ncoef,wkarray,cofum) ! ! Stencils on other grid levels remain the same. nc = nc+10*nlon*nlat nlon = (nlon+1)/2 nlat = (nlat+1)/2 ! - do n=2,5 - call cnm(nlon0,nlat0,nlon,nlat,cee(nc),ncoef,wkarray) + do n=2,res_nlev + call cnm(nlon0,nlon,nlat,cee(nc),ncoef,wkarray) nc = nc+9*nlon*nlat if (n==1) nc = nc+nlon*nlat nlon = (nlon+1)/2 @@ -346,7 +423,7 @@ subroutine htrpex(coeff,nmlon0,nmlat0,sym,wkarray) ! Args: integer,intent(in) :: nmlon0,nmlat0 real(r8),intent(in) :: coeff(nmlon0,nmlat0),sym - real(r8),intent(out) :: wkarray(-15:nmlon0+16,nmlat0) + real(r8),intent(out) :: wkarray(-res_ngrid+1:nmlon0+res_ngrid,nmlat0) ! ! Local: integer :: i,j,jj @@ -359,25 +436,25 @@ subroutine htrpex(coeff,nmlon0,nmlat0,sym,wkarray) enddo ! i=1,nmlon0 enddo ! j=1,nmlat0 ! -! Extend over 32 grid spaces to allow for a total of 5 grid levels: - do i=1,16 +! Extend over 2*res_ngrid grid spaces to allow for a total of res_nlev grid levels: + do i=1,res_ngrid do j=1,nmlat0 wkarray(1-i,j) = wkarray(nmlon0-i,j) wkarray(nmlon0+i,j) = wkarray(1+i,j) enddo ! j=1,nmlat0 - enddo ! i=1,16 + enddo ! i=1,res_ngrid end subroutine htrpex !----------------------------------------------------------------------- - subroutine cnm(nlon0,nlat0,nlon,nlat,c,ncoef,wkarray) -! + subroutine cnm(nlon0,nlon,nlat,c,ncoef,wkarray) +! ! Compute contribution to stencil from zigm(ncoef) on grid nlon by nlat, -! Finest grid is nlon0 by nlat0. +! Finest grid is nlon0. ! ! Args: integer,intent(in) :: & - nlon0,nlat0, & ! finest grid dimensions + nlon0, & ! finest grid dimensions nlon,nlat ! output grid dimensions - real(r8),intent(in) :: wkarray(-15:nmlon0+16,nmlat0) + real(r8),intent(in) :: wkarray(-res_ngrid+1:nmlon0+res_ngrid,nmlat0) ! ! ncoef: integer id of coefficient: ! ncoef = 1 for zigm11 @@ -392,11 +469,11 @@ subroutine cnm(nlon0,nlat0,nlon,nlat,c,ncoef,wkarray) ! Local: integer :: i,j,nint,i0,j0 ! For now, retain this pi to insure bit compatability w/ old code - real(r8),parameter :: pi=3.141592654_r8 + real(r8),parameter :: pi=3.141592654_r8 real(r8) :: wk(nlon0,3) -! +! ! Compute separation of grid points of resolution nlon x nlat within -! grid of resolution nlon0,nlat0. Evaluate dlon and dlat, grid spacing +! grid of resolution nlon0. Evaluate dlon and dlat, grid spacing ! of nlon x nlat. ! nint = (nlon0-1)/(nlon-1) @@ -405,12 +482,12 @@ subroutine cnm(nlon0,nlat0,nlon,nlat,c,ncoef,wkarray) ! from zigm(ncoef) i0 = 1-nint j0 = 1-nint -! -! zigm11: +! +! zigm11: ! am 2001-6-27 include boundary condition at equator - if (ncoef==1) then + if (ncoef==1) then do j = 1,nlat-1 - do i = 1,nlon + do i = 1,nlon c(i,j,1) = c(i,j,1)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & wkarray(i0+(i+1)*nint,j0+j*nint)) c(i,j,5) = c(i,j,5)+0.5_r8*(wkarray(i0+i*nint,j0+j*nint)+ & @@ -508,20 +585,20 @@ subroutine cnm(nlon0,nlat0,nlon,nlat,c,ncoef,wkarray) endif ! ncoef end subroutine cnm !----------------------------------------------------------------------- - subroutine cnmmod(nlon0,nlat0,nlon,nlat,c,ncoef,wkarray,cofum) + subroutine cnmmod(nlon0,nlon,nlat,c,ncoef,wkarray,cofum) ! ! Compute contribution to stencil from zigm(ncoef) on grid nlon by nlat, -! Finest grid is nlon0 by nlat0. -! +! Finest grid is nlon0. +! ! Args: integer,intent(in) :: & - nlon0,nlat0, & ! finest grid dimensions + nlon0, & ! finest grid dimensions nlon,nlat ! output grid dimensions - real(r8),intent(in) :: wkarray(-15:nmlon0+16,nmlat0) + real(r8),intent(in) :: wkarray(-res_ngrid+1:nmlon0+res_ngrid,nmlat0) real(r8),dimension(nmlon0,nmlat0,9),intent(inout) :: cofum -! +! ! ncoef: integer id of coefficient: -! ncoef = 1 for zigm11 +! ncoef = 1 for zigm11 ! ncoef = 2 for zigm12 (=zigmc+zigm2) ! ncoef = 3 for zigm21 (=zigmc-zigm2) ! ncoef = 4 for zigm22 @@ -529,24 +606,24 @@ subroutine cnmmod(nlon0,nlat0,nlon,nlat,c,ncoef,wkarray,cofum) integer,intent(in) :: ncoef real(r8),intent(inout) :: & c(nlon,nlat,*) ! output array for grid point stencils at resolution nlon x nlat -! +! ! Local: integer :: i,j,nint,i0,j0 ! For now, retain this pi to insure bit compatability w/ old code real(r8),parameter :: pi=3.141592654_r8 real(r8) :: wk(nlon0,3) -! +! ! Compute separation of grid points of resolution nlon x nlat within -! grid of resolution nlon0,nlat0. Evaluate dlon and dlat, grid spacing +! grid of resolution nlon0. Evaluate dlon and dlat, grid spacing ! of nlon x nlat. ! nint = (nlon0-1)/(nlon-1) -! +! ! Scan wkarray nlon x nlat calculating and adding contributions to stencil ! from zigm(ncoef) i0 = 1-nint j0 = 1-nint -! +! ! zigm11: ! am 2001-6-27 include boundary condition at equator if (ncoef==1) then @@ -616,7 +693,7 @@ subroutine cnmmod(nlon0,nlat0,nlon,nlat,c,ncoef,wkarray,cofum) wkarray(i0+i*nint,j0+(j-1)*nint)) wk(i,1) = 0.5_r8*(wkarray(i0+i*nint,j0+(j+1)*nint)- & wkarray(i0+i*nint,j0+(j-1)*nint)) -! +! ! Unmodified: cofum(i,j,2) = c(i,j,2) cofum(i,j,4) = c(i,j,4) @@ -633,7 +710,7 @@ subroutine cnmmod(nlon0,nlat0,nlon,nlat,c,ncoef,wkarray,cofum) c(i,j,9) = c(i,j,9)-2._r8*wk(i,3) enddo ! i = 1,nlon enddo ! j = 2,nlat-1 -! +! ! Low latitude boundary condition: j = 1 do i=1,nlon @@ -692,28 +769,6 @@ subroutine cnmmod(nlon0,nlat0,nlon,nlat,c,ncoef,wkarray,cofum) enddo ! i=1,nlon endif ! ncoef end subroutine cnmmod -!----------------------------------------------------------------------- - subroutine ceee(cee,nx,ny,cf) - -! -! Called from mudpack solvers to transfer coefficients. -! -! Args: - integer,intent(in) :: nx,ny - real(r8),intent(in) :: cee(nx,ny,*) - real(r8),intent(out) :: cf(nx,ny,*) -! -! Local: - integer :: i,j,n - - do n = 1,9 - do j = 1,ny - do i = 1,nx - cf(i,j,n) = cee(i,j,n) - enddo - enddo - enddo - end subroutine ceee !-------------------------------------------------------------------- subroutine edges(c,nlon,nlat) ! @@ -721,46 +776,50 @@ subroutine edges(c,nlon,nlat) ! ! Args: integer,intent(in) :: nlon,nlat - real(r8),intent(out) :: c(nlon,nlat,*) + real(r8),intent(out) :: c(*) ! ! Local: - integer :: n,i + integer :: n,i, ndx do n=1,8 - do i=1,nlon - c(i,nlat,n) = 0._r8 + do i=1,nlon + ndx = (n-1)*nlat*nlon + (nlat-1)*nlon + i + c(ndx) = 0._r8 enddo enddo do i=1,nlon - c(i,nlat,9) = 1._r8 + ndx = 8*nlat*nlon + (nlat-1)*nlon + i + c(ndx) = 1._r8 enddo end subroutine edges !-------------------------------------------------------------------- - subroutine divide(c,nlon,nlat,nlon0,nlat0,cs,igrid) + subroutine divide(c,nlon,nlat,nlon0,cs,igrid) ! ! Divide stencil C by cos(theta(i,j)) ! ! Args: - integer,intent(in) :: nlon,nlat,nlon0,nlat0,igrid - real(r8),intent(in) :: cs(*) - real(r8),intent(out) :: c(nlon,nlat,*) + integer,intent(in) :: nlon,nlat,nlon0,igrid + real(r8),intent(in) :: cs(:) + real(r8),intent(out) :: c(*) ! ! Local: - integer :: nint,j0,n,j,i + integer :: nint,j0,n,j,i, ndx ! nint = (nlon0-1)/(nlon-1) j0 = 1-nint do n = 1,9 do j = 1,nlat-1 do i = 1,nlon - c(i,j,n) = c(i,j,n)/(cs(j0+j*nint)*nint**2) + ndx = (n-1)*nlat*nlon + (j-1)*nlon + i + c(ndx) = c(ndx)/(cs(j0+j*nint)*nint**2) enddo ! i = 1,nlon enddo ! j = 1,nlat-1 enddo ! n = 1,9 ! if (nint==1.and.igrid > 0) then do i = 1,nlon - c(i,1,10) = c(i,1,10)/cs(1) + ndx = 9*nlat*nlon + i + c(ndx) = c(ndx)/cs(1) enddo ! i = 1,nlon endif end subroutine divide @@ -838,8 +897,8 @@ subroutine stenmd(inlon,inlat,c,phihm,pfrac) end subroutine stenmd !-------------------------------------------------------------------- subroutine solver(cofum,c0) -! use edyn_mudmod, only: mudmod -! use edyn_muh2cr, only: muh + use edyn_mudmod, only: mudmod + use edyn_muh2cr, only: muh ! ! Call mudpack to solve PDE. Solution is returned in rim: ! real,dimension(nmlonp1,nmlat,2) :: rim @@ -867,30 +926,30 @@ subroutine solver(cofum,c0) jntl = 0 ier = 0 isolve = 2 - call mudmod(rim_glb,phisolv,jntl,isolve,ier)! solver in mudmod.F + call mudmod(rim_glb,phisolv,jntl,isolve,res_nlev,ier) if (ier < 0 ) then ! not converged - write(iulog,*) 'muh: use direct solver' - call muh(rim_glb,jntl) ! solver in mud.F + if (masterproc) write(iulog,*) 'solver: use muh direct solver' + call muh(rim_glb,nmlon,nmlat,res_nlev,jntl) endif l2norm=0._r8 ressolv = 0.0_r8 do j = 1,nmlat0 do i = 1,nmlon0-1 - cofum_solv(i,j,:)= cofum(i,j,:) + cofum_solv(i,j,:) = cofum(i,j,:) ! ! fields: phisolv(0:nmlonp1,0:nmlat+1) ! 2d solution/ electric potential ! ressolv(i,j) = ( & - cofum_solv(i,j,1)*phisolv(i+1,j)+ & - cofum_solv(i,j,2)*phisolv(i+1,j+1)+ & - cofum_solv(i,j,3)*phisolv(i,j+1)+ & - cofum_solv(i,j,4)*phisolv(i-1,j+1)+ & - cofum_solv(i,j,5)*phisolv(i-1,j)+ & - cofum_solv(i,j,6)*phisolv(i-1,j-1)+ & - cofum_solv(i,j,7)*phisolv(i,j-1)+ & - cofum_solv(i,j,8)*phisolv(i+1,j-1)+ & - cofum_solv(i,j,9)*phisolv(i,j)) + cofum_solv(i,j,1)*phisolv(i+1,j)+ & + cofum_solv(i,j,2)*phisolv(i+1,j+1)+ & + cofum_solv(i,j,3)*phisolv(i,j+1)+ & + cofum_solv(i,j,4)*phisolv(i-1,j+1)+ & + cofum_solv(i,j,5)*phisolv(i-1,j)+ & + cofum_solv(i,j,6)*phisolv(i-1,j-1)+ & + cofum_solv(i,j,7)*phisolv(i,j-1)+ & + cofum_solv(i,j,8)*phisolv(i+1,j-1)+ & + cofum_solv(i,j,9)*phisolv(i,j)) ressolv(i,j) = c0(i,j,10)-ressolv(i,j) l2norm = l2norm + ressolv(i,j)*ressolv(i,j) diff --git a/src/ionosphere/waccmx/edyn_solver_coefs.F90 b/src/ionosphere/waccmx/edyn_solver_coefs.F90 new file mode 100644 index 0000000000..3f149e53a3 --- /dev/null +++ b/src/ionosphere/waccmx/edyn_solver_coefs.F90 @@ -0,0 +1,51 @@ +module edyn_solver_coefs + + use shr_kind_mod ,only: r8 => shr_kind_r8 ! 8-byte reals + +! +! nc(1:9) are pointers to beginning of coefficient blocks at each of +! levels of resolution: +! nc(1) = nc0, pointer to coefficients for highest resolution. +! nc(2) = nc1, pointer to coefficients at half the resolution of nc0, +! and so on for nc(3), nc(4), nc(5), etc. +! nc(9) = ncee, the dimension of the entire cee array, containing +! coefficients for all levels. +! + integer :: nc(9) + +! +! Coefficients are stored in 1-d array cee(ncee) +! cee transmits descretized dynamo PDE coefficients to the multi-grid +! mudpack solver. (cee was formerly in ceee.h) +! + real(r8), target, allocatable :: cee(:) +! +! Unmodified coefficients for using modified mudpack: + real(r8), allocatable :: cofum(:,:,:) + +contains + +!----------------------------------------------------------------------- + subroutine ceee(cee,nx,ny,cf) + +! +! Called from mudpack solvers to transfer coefficients. +! +! Args: + integer,intent(in) :: nx,ny + real(r8),intent(in) :: cee(nx,ny,*) + real(r8),intent(out) :: cf(nx,ny,*) +! +! Local: + integer :: i,j,n + + do n = 1,9 + do j = 1,ny + do i = 1,nx + cf(i,j,n) = cee(i,j,n) + enddo + enddo + enddo + end subroutine ceee + +end module edyn_solver_coefs diff --git a/src/ionosphere/waccmx/edynamo.F90 b/src/ionosphere/waccmx/edynamo.F90 index 677be28f85..be99c7dff9 100644 --- a/src/ionosphere/waccmx/edynamo.F90 +++ b/src/ionosphere/waccmx/edynamo.F90 @@ -5,58 +5,34 @@ module edynamo ! Electro-dynamo module !----------------------------------------------------------------------- ! - use shr_kind_mod ,only: r8 => shr_kind_r8 ! 8-byte reals - use cam_logfile ,only: iulog - use cam_abortutils,only: endrun - use spmd_utils ,only: masterproc -#ifdef WACCMX_EDYN_ESMF - use edyn_params ,only: finit ! initialization value - use edyn_maggrid ,only: nmlon,nmlonp1,nmlat,nmlath,nmlev - use edyn_mpi ,only: mlon0,mlon1,omlon1,mlat0,mlat1,mlev0,mlev1,mytid,& - lon0,lon1,lat0,lat1,lev0,lev1 - use edyn_solve ,only: solve_edyn - use time_manager, only: get_nstep ! for debug - use cam_history, only : outfld, hist_fld_active - use savefield_waccm,only: savefld_waccm_switch - use esmf, only : ESMF_KIND_R8, ESMF_Field ! ESMF library module -#endif + use shr_kind_mod, only: r8 => shr_kind_r8 ! 8-byte reals + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + use edyn_params, only: finit ! initialization value + use edyn_maggrid, only: nmlon, nmlonp1, nmlat, nmlath, nmlev + use edyn_mpi, only: mlon0, mlon1, omlon1, mytid, mlat0, mlat1 + use edyn_mpi, only: mlev0, mlev1, lon0, lon1, lat0, lat1 + use edyn_solve, only: solve_edyn + use time_manager, only: get_nstep ! for debug + use cam_history, only: outfld, hist_fld_active + use savefield_waccm, only: savefld_waccm implicit none save private -#ifdef WACCMX_EDYN_ESMF integer :: nstep ! -! 3d pointers to fields regridded to magnetic subdomains (i,j,k): -! (mlon0:mlon1,mlat0:mlat1,nmlev) -! - real(ESMF_KIND_R8),pointer,dimension(:,:,:) :: & ! 3d fields on mag grid - ped_mag, & ! pedersen conductivity on magnetic grid - hal_mag, & ! hall conductivity on magnetic grid - zpot_mag, & ! geopotential on magnetic grid - scht_mag, & ! scale height on magnetic grid - adotv1_mag, & ! ue1 (m/s) - adotv2_mag ! ue2 (m/s) -! -! 2d pointers to fields on magnetic subdomains (i,j): -! (mlon0:mlon1,mlat0:mlat1) -! - real(ESMF_KIND_R8),pointer,dimension(:,:) :: & - sini_mag, & ! sin(I_m) - adota1_mag, & ! d(1)**2/D - adota2_mag, & ! d(2)**2/D - a1dta2_mag, & ! (d(1) dot d(2)) /D - be3_mag ! mag field strength (T) -! ! 2d coefficients and RHS terms for PDE on magnetic subdomains ! (including halo points). ! If use_time3d_integ==.true., these will be input from time3d ! (see use-association in time3d.F90) ! - real(r8),allocatable,dimension(:,:) :: & + real(r8), allocatable, dimension(:,:) :: & zigm11, & ! sigma11*cos(theta0) zigmc, & ! sigmac + zigm1, & ! for Hall conductance diagnostic zigm2, & ! sigma2 zigm22, & ! sigma22/cos(theta0) rim1,rim2, & ! see description in comment below @@ -66,121 +42,135 @@ module edynamo ! ! 3d potential and electric field on mag subdomains (see sub pthreed): ! (mlon0:mlon1,mlat0:mlat1,mlev0:mlev1) -! Electric potential and field components are output fields of edynamo +! Electric potential and field components are output fields of edynamo ! (later, these can be output arguments of the main driver, sub dynamo) ! - real(r8),allocatable,dimension(:,:,:) :: & + real(r8), allocatable, dimension(:,:,:) :: & phim3d, & ! 3d electric potential ed13d,ed23d, & ! 3d electric field for current calculations ephi3d, & ! 3d eastward electric field elam3d, & ! 3d equatorward electric field emz3d, & ! 3d upward electric field + zpot_mag, & zpotm3d ! 3d geopotential (values at all levels) ! ! 3d ion drift velocities on geographic grid (output): ! -! real(r8),allocatable,dimension(:,:,:),save,target :: & ! (nlev,lon0:lon1,lat0:lat1) +! real(r8), allocatable, dimension(:,:,:),save,target :: & ! (nlev,lon0:lon1,lat0:lat1) ! ui, & ! zonal ion drift ! vi, & ! meridional ion drift ! wi ! vertical ion drift ! ! 3d electric field on geographic subdomains (see sub pefield): ! (nlev,lon0-2,lon1+2,lat0:lat1) - real(r8),allocatable,dimension(:,:,:) :: ex,ey,ez + real(r8), allocatable, dimension(:,:,:) :: ex,ey,ez ! ! 3d electric potential on geographic subdomains (lon0:lon1,lat0:lat1,nlevp1) ! This will be regridded from phim3d for output to history files. - real(r8),allocatable,dimension(:,:,:) :: phig3d ! (lon0:lon1,lat0:lat1,nlevp1) - real(r8),allocatable,dimension(:,:,:) :: poten ! (nlevp1,lon0:lon1,lat0:lat1) + real(r8), allocatable, dimension(:,:,:) :: phig3d ! (lon0:lon1,lat0:lat1,nlevp1) + real(r8), allocatable, dimension(:,:,:) :: poten ! (nlevp1,lon0:lon1,lat0:lat1) ! ! Fields at mag equator: ! - real(r8),allocatable,dimension(:,:) :: & ! (mlon0:mlon1,nmlev) - ped_meq, hal_meq, adotv1_meq, adotv2_meq, zpot_meq - real(r8),allocatable,dimension(:,:,:) :: & ! (mlon0:mlon1,nmlev,4) - fmeq_out - real(r8),allocatable,dimension(:,:,:,:) :: & ! (mlon0:mlon1,mlat0:mlat1,nmlev,4) - fmeq_in -! + real(r8), allocatable, dimension(:,:) :: & ! (mlon0:mlon1,nmlev) + ped_meq, hal_meq, adotv1_meq, adotv2_meq + real(r8), allocatable, dimension(:,:,:) :: & ! (mlon0:mlon1,nmlev,4) + fmeq_out + real(r8), allocatable, dimension(:,:,:,:) :: & ! (mlon0:mlon1,mlat0:mlat1,nmlev,4) + fmeq_in +! ! Global longitude values near mag equator and poles for complete_integrals and rhs. -! These are declared in module data because they are used by subs complete_integrals -! and rhspde. The nf2d 6 fields are: zigm11,zigm22,zigmc,zigm2,rim1,rim2, +! These are declared in module data because they are used by subs complete_integrals +! and rhspde. The nf2d 7 fields are: zigm11,zigm22,zigmc,zigm1,zigm2,rim1,rim2, ! order is important (see feq_jpm1 and fpole_jpm2)! ! - integer,parameter :: nf2d=6 ! 6 2d fields - real(r8) :: feq_jpm1(nmlonp1,2,nf2d) ! 6 fields at 2 lats (eq-1, eq+1) - real(r8) :: fpole_jpm2(nmlonp1,4,nf2d) ! fields at S pole+1,2 and N pole-1,2 + integer, parameter :: nf2d=7 ! 7 2d fields + real(r8), allocatable :: feq_jpm1(:,:,:) ! 7 fields at 2 lats (eq-1, eq+1) + real(r8), allocatable :: fpole_jpm2(:,:,:) ! fields at S pole+1,2 and N pole-1,2 - real(r8),parameter :: unitvm(nmlon)=1._r8 + real(r8), allocatable :: unitvm(:) ! ! ed1,ed2: 2d electric field output on mag grid: ! (use-associated by dpie_coupling) ! - real(r8),allocatable,dimension(:,:) :: ed1,ed2 ! (mlon0-1:mlon1+1,mlat0-1:mlat1+1) + real(r8), allocatable, dimension(:,:) :: ed1, ed2 ! (mlon0-1:mlon1+1,mlat0-1:mlat1+1) ! -! Global inputs to time3d: Note dimension order switch: +! Global inputs to time3d: Note dimension order switch: ! edynamo has subdomains (mlon,mlat), whereas time3d has global (nmlat,nmlonp1) ! These are use-associated by time3d, and are init to zero in edyn_init. ! - real(r8),dimension(nmlat,nmlonp1) :: ed1_glb,ed2_glb - logical :: do_integ ! from input arg do_integrals - logical :: debug=.false. ! set true for prints to stdout at each call + real(r8), allocatable, dimension(:,:) :: ed1_glb, ed2_glb + logical :: debug = .false. ! set true for prints to stdout at each call + + logical, public :: debug_hist = .false. - public alloc_edyn,ed1,ed2,ed1_glb,ed2_glb - public zigm11,zigmc,zigm2,zigm22,rim1,rim2 -#endif + public :: alloc_edyn, ed1, ed2, ed1_glb, ed2_glb + public :: zigm11, zigmc, zigm2, zigm22, rim1, rim2 public :: dynamo - contains +contains !----------------------------------------------------------------------- - subroutine dynamo(tn,un,vn,wn,zpot,ped,hall,ui,vi,wi, & - lev0,lev1,lon0,lon1,lat0,lat1,do_integrals) - use edyn_mpi,only: & - mp_mag_halos, & ! set magnetic halo points - mp_scatter_phim ! scatter solution to slave tasks - use edyn_solve,only: rim_glb ! pde solver output (nmlonp1,nmlat,2) + subroutine dynamo( zpot_mag_in, ped_mag, hall_mag, adotv1_mag, adotv2_mag, adota1_mag, & + adota2_mag, a1dta2_mag,be3_mag, sini_mag, zpot, & + ui, vi, wi, lon0,lon1, lat0,lat1, lev0,lev1, do_integrals ) + use edyn_mpi, only: & + mp_mag_halos, & ! set magnetic halo points + mp_scatter_phim ! scatter solution to slave tasks + use edyn_solve, only: rim_glb ! pde solver output (nmlonp1,nmlat,2) ! ! Main driver for edynamo. ! Note alloc_edyn and esmf_init are called from edyn_init. ! ! Args: integer,intent(in) :: & ! geographic subdomain - lev0,lev1, & ! first,last level indices (not distributed) - lon0,lon1, & ! first,last longitude indices of geographic subdomain - lat0,lat1 ! first,last latitude indices of geographic subdomain + lon0, lon1, & ! first,last longitude indices of geographic subdomain + lat0, lat1, & ! first,last latitude indices of geographic subdomain + lev0, lev1 ! first,last level indices (not distributed) +! +! Inputs : +! + real(r8), dimension(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1), intent(in) :: & + zpot_mag_in, & ! geopotential (cm) + ped_mag, & ! pedersen conductivity (S/m) + hall_mag, & ! hall conductivity (S/m) + adotv1_mag,& ! ue1 (m/s) + adotv2_mag ! ue2 (m/s) + real(r8), dimension(mlon0:mlon1,mlat0:mlat1), intent(in) :: & + adota1_mag, & + adota2_mag, & + a1dta2_mag, & + be3_mag, & + sini_mag + + ! inputs on geographic (oplus) grid + real(r8), dimension(lev0:lev1,lon0:lon1,lat0:lat1), intent(in) :: & + zpot ! geopotential (cm) + + real(r8), dimension(lev0:lev1,lon0:lon1,lat0:lat1), intent(out) :: & + ui, & ! zonal ion drift (cm/s) + vi, & ! meridional ion drift (cm/s) + wi ! vertical ion drift (cm/s) + logical,intent(in) :: do_integrals -! -! Inputs from neutral atmosphere (on geographic subdomain): -! (intent(inout) because they are passed to sub dynamo_input) -! - real(r8),intent(inout),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: & - tn, & ! neutral temperature (deg K) - un, & ! neutral zonal wind velocity (cm/s) - vn, & ! neutral meridional wind velocity (cm/s) - wn, & ! neutral vertical wind velocity (cm/s) - zpot, & ! geopotential height (cm) - ped, & ! pedersen conductivity (S/m) - hall, & ! hall conductivity (S/m) - ui, & ! zonal ion drift (cm/s) - vi, & ! meridional ion drift (cm/s) - wi ! vertical ion drift (cm/s) -#ifdef WACCMX_EDYN_ESMF + if (debug) then nstep = get_nstep() - write(iulog,"('Enter dynamo: nstep=',i5,' do_integrals=',l1)") nstep,do_integrals - endif + write(iulog,"(a,i5,a,l1)") 'Enter dynamo: nstep=', nstep, & + ', do_integrals=', do_integrals + end if - do_integ = do_integrals ! do_integ is module data ! -! Regrid input fields from geographic to magnetic, and calculate +! Regrid input fields from geographic to magnetic, and calculate ! some additional fields. If conductances are passed in from ! time3d (.not.do_integrals), then we do not need these inputs. ! if (do_integrals) then - call dynamo_input(tn,un,vn,wn,zpot,ped,hall,& - lev0,lev1,lon0,lon1,lat0,lat1) - if (debug) write(iulog,"('edynamo debug: after dynamo_input')") - endif + call dynamo_set_data( zpot_mag_in, ped_mag, hall_mag, adotv1_mag, adotv2_mag ) + if (debug) then + write(iulog,"('edynamo debug: after dynamo_input')") + end if + end if + ! ! Fieldline integration: ! @@ -189,33 +179,44 @@ subroutine dynamo(tn,un,vn,wn,zpot,ped,hall,ui,vi,wi, & ! (nmlat,nmlonp1) to (nmlonp1,nmlat), defining zigmxx and rim1,2 ! for the solver. ! - if (do_integrals) call fieldline_integrals + if (do_integrals) then + call fieldline_integrals(ped_mag, hall_mag, adotv1_mag, adotv2_mag, & + adota1_mag, adota2_mag, a1dta2_mag, be3_mag, sini_mag) + end if ! ! Equatorial and polar values, hemisphere folding: ! (these will be time3d integrations if do_integrals==.false.) ! - call complete_integrals - if (debug) write(iulog,"('edynamo debug: after complete_integrals')") + call complete_integrals() + if (debug) then + write(iulog,"('edynamo debug: after complete_integrals')") + end if ! ! Calculate right-hand side on mag subdomains: ! (mag halos are needed in rim1,2 for rhs calculation) ! - call mp_mag_halos(rim1,mlon0,mlon1,mlat0,mlat1,1) + call mp_mag_halos(rim1,mlon0,mlon1,mlat0,mlat1,1) call mp_mag_halos(rim2,mlon0,mlon1,mlat0,mlat1,1) call rhspde - if (debug) write(iulog,"('edynamo debug: after rhspde')") + if (debug) then + write(iulog,"('edynamo debug: after rhspde')") + end if ! ! Gather needed arrays to root task for the serial solver: ! - call gather_edyn - if (debug) write(iulog,"('edynamo debug: after gather_edyn')") + call gather_edyn() + if (debug) then + write(iulog,"('edynamo debug: after gather_edyn')") + end if ! -! Root task now sets up stencils and calls the PDE solver: +! Root task now sets up stencils and calls the PDE solver: ! - if (debug) write(iulog,"('edynamo debug: call solve_edyn (master only)')") - if (mytid==0) then - call solve_edyn - endif + if (debug) then + write(iulog,"('edynamo debug: call solve_edyn (master only)')") + end if + if (mytid == 0) then + call solve_edyn() + end if if (debug) write(iulog,"('edynamo debug: after solve_edyn (master only)')") ! ! rim1 after solver is needed for highlat_poten. rim_glb is distributed @@ -223,300 +224,97 @@ subroutine dynamo(tn,un,vn,wn,zpot,ped,hall,ui,vi,wi, & ! fieldline_integrals, complete_integrals, etc. ! call mp_scatter_phim(rim_glb(:,:,1),rim1(mlon0:mlon1,mlat0:mlat1)) - if (debug) write(iulog,"('edynamo debug: after mp_scatter_phim')") + if (debug) then + write(iulog,"('edynamo debug: after mp_scatter_phim')") + end if call mp_mag_halos(rim1,mlon0,mlon1,mlat0,mlat1,1) - if (debug) write(iulog,"('edynamo debug: after mp_mag_halos')") -! + if (debug) then + write(iulog,"('edynamo debug: after mp_mag_halos')") + end if +! ! Add high latitude potential from empirical model (heelis or weimer) ! to solution rim1, defining phim2d on mag subdomains. ! - call highlat_poten - if (debug) write(iulog,"('edynamo debug: after highlat_poten')") + call highlat_poten() + if (debug) then + write(iulog,"('edynamo debug: after highlat_poten')") + end if ! ! Expand phim2d to phim3d, first setting mag halos in phim2d from ! hightlat_poten. phim3d will then be the final potential from pdynamo. ! call mp_mag_halos(phim2d,mlon0,mlon1,mlat0,mlat1,1) - call pthreed - if (debug) write(iulog,"('edynamo debug: after pthreed')") + call pthreed() + if (debug) then + write(iulog,"('edynamo debug: after pthreed')") + end if ! ! Convert electric field to geographic grid: - call pefield - if (debug) write(iulog,"('edynamo debug: after pefield')") + call pefield() + if (debug) then + write(iulog,"('edynamo debug: after pefield')") + end if ! ! Calculate ion drift velocities: ! - call ionvel(zpot,ui,vi,wi) - if (debug) write(iulog,"('edynamo debug: after ionvel')") -#else - call endrun('ERROR: To use edymamo must build with cppdef WACCMX_EDYN_ESMF') -#endif + call ionvel(zpot,ui,vi,wi, lon0,lon1, lat0,lat1, lev0,lev1) + if (debug) then + write(iulog,"('edynamo debug: after ionvel')") + end if + end subroutine dynamo !----------------------------------------------------------------------- -#ifdef WACCMX_EDYN_ESMF - subroutine dynamo_input(tn,un,vn,wn,zpot,ped,hall,& - lev0,lev1,lon0,lon1,lat0,lat1) -! -! Input fields are in "TIEGCM format" and CGS units. -! Provide needed inputs to the dynamo by regridding the fields -! from geographic to magnetic. -! - use edyn_params ,only: h0,kbotdyn - use getapex ,only: & ! (nlonp1,0:nlatp1) - zb, & ! downward component of magnetic field - bmod ! magnitude of magnetic field (gauss?) - use edyn_geogrid,only: nlev - - use edyn_mpi,only: & -! mp_periodic_f2d, & ! set 2d periodic points -! mp_periodic_f3d, & ! set 3d periodic points - mp_mageq ! get global values at mag equator - - use edyn_esmf,only: & ! use-associate grid definitions and subroutines - geo_src_grid, & ! geographic source grid (ESMF_Grid type) - edyn_esmf_regrid, & ! subroutine that calls ESMF to regrid a field - edyn_esmf_set2d_geo, & ! set values of a 2d ESMF field on geographic grid - edyn_esmf_set3d_geo, & ! set values of a 3d ESMF field on geographic grid - edyn_esmf_get_3dfield, & ! retrieve values of a 3d ESMF field - edyn_esmf_get_2dfield ! retrieve values of a 2d ESMF field - - use edyn_esmf,only: & ! 3d ESMF fields on geographic grid - geo_ped, & ! pedersen conductivity - geo_hal, & ! hall conductivity - geo_zpot, & ! geopotential height - geo_scht, & ! scale height - geo_adotv1, & ! ue1 (m/s) - geo_adotv2 ! ue2 (m/s) - - use edyn_esmf,only: & ! 2d ESMF fields on geographic grid - geo_sini, & ! sin(I_m) - geo_adota1, & ! d(1)**2/D - geo_adota2, & ! d(2)**2/D - geo_a1dta2, & ! (d(1) dot d(2)) /D - geo_be3 ! mag field strength (T) - - use edyn_esmf,only: & ! 3d ESMF fields on geomagnetic grid - mag_ped, & ! pedersen conductivity - mag_hal, & ! hall conductivity - mag_zpot, & ! geopotential height - mag_scht, & ! scale height - mag_adotv1, & ! ue1 (m/s) - mag_adotv2 ! ue2 (m/s) - - use edyn_esmf,only: & ! 3d fields on geographic grid (bundled?) - nf_3dgeo, & ! number of 3d geo fields - f_3dgeo ! array of nf_3dgeo pointers to 3d geo fields - - use edyn_esmf,only: & ! 2d ESMF fields on geomagnetic grid - mag_sini, & ! sin(I_m) - mag_adota1, & ! d(1)**2/D - mag_adota2, & ! d(2)**2/D - mag_a1dta2, & ! (d(1) dot d(2)) /D - mag_be3 ! mag field strength (T) - - use edyn_esmf,only: edyn_esmf_update_step ! indicates ESMF updated the current time step with updated geo-mag coordinates - use edyn_esmf,only: edyn_esmf_update_flag -! -! Args: Input fields on geographic grid: -! - integer,intent(in) :: lev0,lev1,lon0,lon1,lat0,lat1 - real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1),intent(in) :: & - tn, & ! neutral temperature (deg K) - un, & ! neutral zonal velocity (cm/s) - vn, & ! neutral meridional velocity (cm/s) - wn ! neutral vertical velocity (cm/s) - - real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1),intent(inout) :: & - zpot, & ! geopotential height (cm) - ped, & ! pedersen conductivity (S/m) - hall ! hall conductivity (S/m) + subroutine dynamo_set_data( zpot_mag_in, ped_mag, hall_mag, adotv1_mag, adotv2_mag ) ! -! Local: ! - integer :: j,i,k - real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: & - scheight, & ! scale height (no longer necessary since wn calculated outside) - adotv1, & ! ue1 (m/s) - adotv2 ! ue2 (m/s) - real(r8),dimension(lon0:lon1,lat0:lat1) :: & - sini, & ! sin(I_m) - adota1, & ! d(1)**2/D - adota2, & ! d(2)**2/D - a1dta2, & ! (d(1) dot d(2)) /D - be3 ! mag field strength (T) + use edyn_params, only: h0, kbotdyn + use edyn_mpi, only: mp_mageq ! get global values at mag equator ! -! See nf_3dgeo above: - real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1,nf_3dgeo) :: f3d - character(len=8) :: fnames(nf_3dgeo) -! -! For wc timing: -! real(r8) :: starttime,endtime - - scheight = 0._r8 - -! starttime = mpi_wtime() - - if (debug) write(iulog,"('Enter dynamo_input')") -! -! Save 3d input fields on geo grid to WACCM history: - call savefld_waccm_switch(tn ,'EDYN_TN' ,nlev,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(un ,'EDYN_UN' ,nlev,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(vn ,'EDYN_VN' ,nlev,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(wn ,'EDYN_WN' ,nlev,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(zpot ,'EDYN_Z' ,nlev,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(ped ,'EDYN_PED' ,nlev,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(hall ,'EDYN_HALL',nlev,lon0,lon1,lat0,lat1) - +! Args: Input fields on geographic grid: ! - if (debug) write(iulog,"('dynamo_input after savefld_waccm calls')") - if (debug) write(iulog,"('dynamo_input: kbotdyn=',i4)") kbotdyn + real(r8), dimension(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),intent(in) :: & + zpot_mag_in,&! cm + ped_mag, & ! pedersen conductivity (S/m) + hall_mag, & ! hall conductivity (S/m) + adotv1_mag,& ! ue1 (m/s) + adotv2_mag ! ue2 (m/s) ! -! Calculate some 2d and 3d fields: - call calc_adotv(zpot,un,vn,wn,adotv1,adotv2,adota1,adota2, & - a1dta2,be3,lev0,lev1,lon0,lon1,lat0,lat1) - if (debug) write(iulog,"('dynamo_input after calc_adotv')") - - call savefld_waccm_switch(adotv1 ,'EDYN_ADOTV1',nlev,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(adotv2 ,'EDYN_ADOTV2',nlev,lon0,lon1,lat0,lat1) -! -! Calculate sini sin(I_m) (zb and bmod are from apex) +! Local: ! - do j=lat0,lat1 - do i=lon0,lon1 - sini(i,j) = zb(i,j)/bmod(i,j) ! sin(I_m) - enddo - enddo + integer :: j, i, k ! -! Set 3d field values on geographic source grid, including -! separate calculations at the poles. This is consolidated -! into a single call, so mp_geopole_3d can be called by -! esmf_set3d_geo once for all fields. -! - fnames = (/'PED ','HAL ','ZPOT ','SCHT ',& - 'ADOTV1 ','ADOTV2 '/) - - f3d(:,:,:,1) = ped - f3d(:,:,:,2) = hall - f3d(:,:,:,3) = zpot - f3d(:,:,:,4) = scheight - f3d(:,:,:,5) = adotv1 - f3d(:,:,:,6) = adotv2 - - f_3dgeo(1) = geo_ped - f_3dgeo(2) = geo_hal - f_3dgeo(3) = geo_zpot - f_3dgeo(4) = geo_scht - f_3dgeo(5) = geo_adotv1 - f_3dgeo(6) = geo_adotv2 - - call edyn_esmf_set3d_geo(f_3dgeo,fnames,f3d,nf_3dgeo, & - lev0,lev1,lon0,lon1,lat0,lat1) - - geo_ped = f_3dgeo(1) - geo_hal = f_3dgeo(2) - geo_zpot = f_3dgeo(3) - geo_scht = f_3dgeo(4) - geo_adotv1 = f_3dgeo(5) - geo_adotv2 = f_3dgeo(6) - - ped = f3d(:,:,:,1) - hall = f3d(:,:,:,2) - zpot = f3d(:,:,:,3) - scheight= f3d(:,:,:,4) - adotv1 = f3d(:,:,:,5) - adotv2 = f3d(:,:,:,6) - - if (debug) write(iulog,"('dynamo_input after edyn_esmf_set3d_geo')") -! -! 2d fields need only be calculated in first timestep: - if (edyn_esmf_update_step) then -! -! Set 2d field values on geographic grid: -! (esmf fields on source grid exclude periodic points) -! - call edyn_esmf_set2d_geo(geo_sini, geo_src_grid,'SINI ',& - sini, lon0,lon1,lat0,lat1) - call edyn_esmf_set2d_geo(geo_adota1,geo_src_grid,'ADOTA1 ',& - adota1,lon0,lon1,lat0,lat1) - call edyn_esmf_set2d_geo(geo_adota2,geo_src_grid,'ADOTA2 ',& - adota2,lon0,lon1,lat0,lat1) - call edyn_esmf_set2d_geo(geo_a1dta2,geo_src_grid,'A1DTA2 ',& - a1dta2,lon0,lon1,lat0,lat1) - call edyn_esmf_set2d_geo(geo_be3, geo_src_grid,'BE3 ',& - be3, lon0,lon1,lat0,lat1) - if (debug) write(iulog,"('dynamo_input after edyn_esmf_set2d_geo')") - endif - -! -! Regrid 3d geo fields to mag grid: - call edyn_esmf_regrid(geo_ped ,mag_ped, 'geo2mag',3) - call edyn_esmf_regrid(geo_hal ,mag_hal, 'geo2mag',3) - call edyn_esmf_regrid(geo_zpot ,mag_zpot, 'geo2mag',3) - call edyn_esmf_regrid(geo_scht ,mag_scht, 'geo2mag',3) - call edyn_esmf_regrid(geo_adotv1 ,mag_adotv1, 'geo2mag',3) - call edyn_esmf_regrid(geo_adotv2 ,mag_adotv2, 'geo2mag',3) - if (debug) write(iulog,"('dynamo_input after edyn_esmf_regrid')") -! -! Regrid time-independent 2d geo fields to mag grid: - if (edyn_esmf_update_step) then - call edyn_esmf_regrid(geo_sini ,mag_sini , 'geo2mag',2) - call edyn_esmf_regrid(geo_adota1 ,mag_adota1, 'geo2mag',2) - call edyn_esmf_regrid(geo_adota2 ,mag_adota2, 'geo2mag',2) - call edyn_esmf_regrid(geo_a1dta2 ,mag_a1dta2, 'geo2mag',2) - call edyn_esmf_regrid(geo_be3 ,mag_be3 , 'geo2mag',2) - endif -! -! Define edynamo module data pointers to the regridded mag fields. -! First arg of esmf_get_field is input esmf field (my_esmf module), -! second arg is output data pointer (edynamo module) -! (These destination grid fields have periodic points allocated and set) -! -! Get regridded 3d mag fields: -! - call edyn_esmf_get_3dfield(mag_ped ,ped_mag, "PED ") - call edyn_esmf_get_3dfield(mag_hal ,hal_mag, "HAL ") - call edyn_esmf_get_3dfield(mag_zpot ,zpot_mag, "ZPOT ") - call edyn_esmf_get_3dfield(mag_scht ,scht_mag, "SCHT ") - call edyn_esmf_get_3dfield(mag_adotv1,adotv1_mag,"ADOTV1 ") - call edyn_esmf_get_3dfield(mag_adotv2,adotv2_mag,"ADOTV2 ") -! -! Get regridded 2d mag fields (time-independent): -! First arg is input ESMF field, second is output pointer: -! - if (edyn_esmf_update_step) then - call edyn_esmf_get_2dfield(mag_sini ,sini_mag , "SINI ") - call edyn_esmf_get_2dfield(mag_adota1,adota1_mag, "ADOTA1 ") - call edyn_esmf_get_2dfield(mag_adota2,adota2_mag, "ADOTA2 ") - call edyn_esmf_get_2dfield(mag_a1dta2,a1dta2_mag, "A1A2M ") - call edyn_esmf_get_2dfield(mag_be3 ,be3_mag , "BE3 ") - call edyn_esmf_update_flag(.false.) - endif + if (debug .and. masterproc) then + write(iulog,"('dynamo_input after savefld_waccm calls')") + write(iulog,"('dynamo_input: kbotdyn=',i4)") kbotdyn + end if ! ! fmeq_in are input fields on 3d mag subdomains. ! allocate(fmeq_in(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1,4) ! - fmeq_in(:,:,:,1) = ped_mag(:,:,:) - fmeq_in(:,:,:,2) = hal_mag(:,:,:) - fmeq_in(:,:,:,3) = adotv1_mag(:,:,:) - fmeq_in(:,:,:,4) = adotv2_mag(:,:,:) + fmeq_in(:,:,:,1) = ped_mag(:,:,:) + fmeq_in(:,:,:,2) = hall_mag(:,:,:) + fmeq_in(:,:,:,3) = adotv1_mag(:,:,:) + fmeq_in(:,:,:,4) = adotv2_mag(:,:,:) ! ! Tasks w/ mag equator send eq data(i,k) to other tasks in their tidi: ! - call mp_mageq(fmeq_in,fmeq_out,4,mlon0,mlon1,mlat0,mlat1,nmlev) + call mp_mageq(fmeq_in, fmeq_out, 4, mlon0, mlon1, mlat0, mlat1, nmlev) ! ! Output arrays now have mag equator data on longitude subdomain ! and full column (mlon0:mlon1,nmlev) ! These will be used in fieldline_integrals. ! - ped_meq(:,:) = fmeq_out(:,:,1) - hal_meq(:,:) = fmeq_out(:,:,2) - adotv1_meq(:,:) = fmeq_out(:,:,3) - adotv2_meq(:,:) = fmeq_out(:,:,4) + ped_meq(:,:) = fmeq_out(:,:,1) + hal_meq(:,:) = fmeq_out(:,:,2) + adotv1_meq(:,:) = fmeq_out(:,:,3) + adotv2_meq(:,:) = fmeq_out(:,:,4) + + zpot_mag(:,:,:) = zpot_mag_in(:,:,:) ! ! Save geopotential on magnetic grid in zpotm3d, then ! limit max zpot_mag to h0 for use in fieldline integrals @@ -524,147 +322,30 @@ subroutine dynamo_input(tn,un,vn,wn,zpot,ped,hall,& ! below kbotdyn. It is not necessary to set poles of zpotm3d ! since sub pthreed does not reference the poles of zpotm3d. ! - do k=mlev0,mlev1 - do j=mlat0,mlat1 - do i=mlon0,mlon1 - zpotm3d(i,j,k) = zpot_mag(i,j,k) - if (zpot_mag(i,j,k) < h0) zpot_mag(i,j,k)=h0 - enddo - enddo - enddo -! -! Set 3d mag fields to zero below kbotdyn: -! -! ped_mag(:,:,1:kbotdyn-1) = finit -! hal_mag(:,:,1:kbotdyn-1) = finit -! adotv1_mag(:,:,1:kbotdyn-1) = finit -! adotv2_mag(:,:,1:kbotdyn-1) = finit - -! call savefld_waccm_switch(adota1_mag(mlon0:mlon1,mlat0:mlat1) ,'ADOTA1_MAG' ,1,mlon0,mlon1,mlat0,mlat1) - - do j=mlat0,mlat1 - call outfld('PED_MAG',ped_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) - call outfld('HAL_MAG',hal_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) - call outfld('ZPOT_MAG',zpot_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) - call outfld('ADOTV1_MAG',adotv1_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) - call outfld('ADOTV2_MAG',adotv2_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) - enddo -! -! Save 3d input fields on geo grid to waccm files (switch to "waccm format"): -! call savefld_waccm_switch(tn ,'EDYN_TN' ,nlev,lon0,lon1,lat0,lat1) -! call savefld_waccm_switch(un ,'EDYN_UN' ,nlev,lon0,lon1,lat0,lat1) -! call savefld_waccm_switch(vn ,'EDYN_VN' ,nlev,lon0,lon1,lat0,lat1) -! call savefld_waccm_switch(wn ,'EDYN_WN' ,nlev,lon0,lon1,lat0,lat1) -! call savefld_waccm_switch(zpot ,'EDYN_Z' ,nlev,lon0,lon1,lat0,lat1) -! call savefld_waccm_switch(ped ,'EDYN_PED' ,nlev,lon0,lon1,lat0,lat1) -! call savefld_waccm_switch(hall ,'EDYN_HALL',nlev,lon0,lon1,lat0,lat1) - -! call savefld_waccm_switch(scheight,'EDYN_SCHT' ,nlev,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(adotv1 ,'EDYN_ADOTV1',nlev,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(adotv2 ,'EDYN_ADOTV2',nlev,lon0,lon1,lat0,lat1) -! -! Save 2d geo fields (lon0:lon1,lat0:lat1): - call savefld_waccm_switch(sini ,'EDYN_SINI' ,1,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(adota1,'EDYN_ADOTA1',1,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(adota2,'EDYN_ADOTA2',1,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(a1dta2,'EDYN_A1DTA2',1,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(be3 ,'EDYN_BE3' ,1,lon0,lon1,lat0,lat1) - -! endtime = mpi_wtime() -! time_dynamo_input=time_dynamo_input+(endtime-starttime) - end subroutine dynamo_input + do k = mlev0, mlev1 + do j = mlat0, mlat1 + do i=mlon0,mlon1 + zpotm3d(i,j,k) = zpot_mag(i,j,k) + if (zpot_mag(i,j,k) < h0) then + zpot_mag(i,j,k) = h0 + end if + end do + end do + end do + do j = mlat0, mlat1 + call outfld('PED_MAG',ped_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('HAL_MAG',hall_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('ZPOT_MAG',zpot_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + if (debug_hist) then + call outfld('ADOTV1_MAG',adotv1_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('ADOTV2_MAG',adotv2_mag(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + endif + end do + end subroutine dynamo_set_data !----------------------------------------------------------------------- - subroutine calc_adotv(z,un,vn,wn,adotv1,adotv2,adota1,adota2,& - a1dta2,be3,lev0,lev1,lon0,lon1,lat0,lat1) -! -! Calculate adotv1,2, adota1,2, a1dta2 and be3. -! - use edyn_params ,only: r0,h0 - use edyn_geogrid,only: jspole,jnpole - use getapex, only: & - dvec, & ! (nlonp1,nlat,3,2) - dddarr, & ! (nlonp1,nlat) - be3arr, & ! (nlonp1,nlat) - alatm ! (nlonp1,0:nlatp1) -! -! Args: - integer,intent(in) :: lev0,lev1,lon0,lon1,lat0,lat1 - real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1),intent(in) :: & - z, & ! geopotential height (cm) - un, & ! neutral zonal velocity (cm/s) - vn ! neutral meridional velocity (cm/s) - real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1),intent(in) :: & - wn ! vertical velocity (cm/s) - real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1),intent(out) :: & - adotv1, adotv2 - real(r8),dimension(lon0:lon1,lat0:lat1),intent(out) :: & - adota1, adota2, a1dta2, be3 -! -! Local: - integer :: k,i,j - real(r8) :: r0or,rat,sinalat - real(r8) :: clm2(lon0:lon1,lat0:lat1) -! - adotv1 = finit - adotv2 = finit - adota1 = finit - adota2 = finit - a1dta2 = finit - be3 = finit - - do j=lat0,lat1 - if (j==jspole.or.j==jnpole) cycle - do i=lon0,lon1 - sinalat = sin(alatm(i,j)) ! sin(lam) - clm2(i,j) = 1._r8-sinalat*sinalat ! cos^2(lam) - be3(i,j) = 1.e-9_r8*be3arr(i,j) ! be3 is in T (be3arr in nT) - - do k=lev0,lev1-1 -! -! d_1 = (R_0/R)^1.5 - r0or = r0/(r0 + 0.5_r8*(z(k,i,j)+z(k+1,i,j))-h0) - rat = 1.e-2_r8*r0or**1.5_r8 ! 1/100 conversion in cm -! -! A_1 dot V = fac( d_1(1) u + d_1(2) v + d_1(3) w - adotv1(k,i,j) = rat*( & - dvec(i,j,1,1)*un(k,i,j)+ & - dvec(i,j,2,1)*vn(k,i,j)+ & - dvec(i,j,3,1)*wn(k,i,j)) - -! -! Note: clm2 is being used here to represent the squared cosine of the -! quasi-dipole latitude, not of the M(90) latitude, since the wind -! values are aligned vertically, not along the field line. -! - rat = rat*sqrt((4._r8-3._r8*clm2(i,j))/(4._r8-3._r8*r0or*clm2(i,j))) -! -! A_2 dot V = fac( d_2(1) u + d_2(2) v + d_2(3) w - adotv2(k,i,j) = rat*( & - dvec(i,j,1,2)*un(k,i,j)+ & - dvec(i,j,2,2)*vn(k,i,j)+ & - dvec(i,j,3,2)*wn(k,i,j)) - enddo ! k=lev0,lev1-1 -! -! Calculation of adota(n) = d(n)**2/D -! a1dta2 = (d(1) dot d(2)) /D -! - adota1(i,j) = (dvec(i,j,1,1)**2 + dvec(i,j,2,1)**2 + & - dvec(i,j,3,1)**2)/dddarr(i,j) - adota2(i,j) = (dvec(i,j,1,2)**2 + dvec(i,j,2,2)**2 + & - dvec(i,j,3,2)**2)/dddarr(i,j) - a1dta2(i,j) = (dvec(i,j,1,1)*dvec(i,j,1,2) + & - dvec(i,j,2,1)*dvec(i,j,2,2) + & - dvec(i,j,3,1)*dvec(i,j,3,2))/dddarr(i,j) - enddo ! i=lon0,lon1 - - enddo ! j=lat0,lat1 - - call savefld_waccm_switch(adota1 ,'ADOTA1' ,1,lon0,lon1,lat0,lat1) - - end subroutine calc_adotv !----------------------------------------------------------------------- subroutine alloc_edyn - use edyn_geogrid,only: nlev + use edyn_geogrid, only: nlev ! ! Allocate and initialize arrays for parallel dynamo (module data) ! (called once per run) @@ -684,6 +365,9 @@ subroutine alloc_edyn allocate(zigmc(mlon00:mlon11,mlat00:mlat11) ,stat=istat) if (istat /= 0) call endrun('alloc_edyn: zigmc') zigmc = finit + allocate(zigm1(mlon00:mlon11,mlat00:mlat11) ,stat=istat) + if (istat /= 0) call endrun('alloc_edyn: zigm1') + zigm1 = finit allocate(zigm2(mlon00:mlon11,mlat00:mlat11) ,stat=istat) if (istat /= 0) call endrun('alloc_edyn: zigm2') zigm2 = finit @@ -712,13 +396,13 @@ subroutine alloc_edyn phim3d = finit allocate(ed13d(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),stat=istat) if (istat /= 0) call endrun('alloc_edyn: ed13d') - ed13d = finit + ed13d = finit allocate(ed23d(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),stat=istat) if (istat /= 0) call endrun('alloc_edyn: ed23d') ed23d = finit allocate(ephi3d(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),stat=istat) if (istat /= 0) call endrun('alloc_edyn: ephi3d') - ephi3d = finit + ephi3d = finit allocate(elam3d(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),stat=istat) if (istat /= 0) call endrun('alloc_edyn: elam3d') elam3d = finit @@ -728,6 +412,9 @@ subroutine alloc_edyn allocate(zpotm3d(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),stat=istat) if (istat /= 0) call endrun('alloc_edyn: zpotm3d') zpotm3d = finit + allocate(zpot_mag(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1),stat=istat) + if (istat /= 0) call endrun('alloc_edyn: zpot_mag') + zpot_mag = finit ! ! Fields at mag equator (subdomain longitudes and full column): ! @@ -743,9 +430,6 @@ subroutine alloc_edyn allocate(adotv2_meq(mlon0:mlon1,mlev0:mlev1),stat=istat) if (istat /= 0) call endrun('alloc_edyn: adotv2_meq') adotv2_meq = finit - allocate(zpot_meq(mlon0:mlon1,mlev0:mlev1),stat=istat) - if (istat /= 0) call endrun('alloc_edyn: zpot_meq') - zpot_meq = finit ! ! Fields input to mp_mageq (4 fields at full mag subdomain i,j,k): ! @@ -780,7 +464,7 @@ subroutine alloc_edyn phig3d = finit ! ! 2d electric field components on mag grid (these may be input to time3d): -! real(r8),dimension(:,:) :: ed1,ed2 ! (mlon0-1:mlon1+1,mlat0-1:mlat1+1) +! real(r8), dimension(:,:) :: ed1,ed2 ! (mlon0-1:mlon1+1,mlat0-1:mlat1+1) ! allocate(ed1(mlon0-1:mlon1+1,mlat0-1:mlat1+1),stat=istat) if (istat /= 0) call endrun('alloc_edyn: ed1') @@ -790,15 +474,38 @@ subroutine alloc_edyn if (istat /= 0) call endrun('alloc_edyn: ed2') ed2 = finit + allocate(unitvm(nmlon)) + unitvm = 1._r8 + + allocate(feq_jpm1(nmlonp1,2,nf2d)) + allocate(fpole_jpm2(nmlonp1,4,nf2d)) + allocate(ed1_glb(nmlat,nmlonp1), ed2_glb(nmlat,nmlonp1)) + end subroutine alloc_edyn !----------------------------------------------------------------------- - subroutine fieldline_integrals + subroutine fieldline_integrals( ped_mag, hal_mag, adotv1_mag, adotv2_mag, & + adota1_mag, adota2_mag, a1dta2_mag, be3_mag, sini_mag ) ! ! Integrate along magnetic field lines, saving conductances and rims. ! use edyn_params, only: r0,h0,finit,kbotdyn use edyn_maggrid, only: ylatm ! +! Args: + real(r8), dimension(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1), intent(in) :: & + ped_mag, & ! pedersen conductivity (S/m) + hal_mag, & ! hall conductivity (S/m) + adotv1_mag,& ! ue1 (m/s) + adotv2_mag ! ue2 (m/s) + + real(r8), dimension(mlon0:mlon1,mlat0:mlat1), intent(in) :: & + adota1_mag, & + adota2_mag, & + a1dta2_mag, & + be3_mag, & + sini_mag + +! ! Local: integer :: i,j,k real(r8) :: & @@ -811,14 +518,16 @@ subroutine fieldline_integrals htfac ! sqrt(R_A -3/4*R_0) real(r8) :: rora,del,omdel,sig1,sig2,ue1,ue2 - real(r8),dimension(mlon0:mlon1) :: aam - real(r8),dimension(mlon0:mlon1,mlev0:mlev1) :: rrm, & + real(r8), dimension(mlon0:mlon1) :: aam + real(r8), dimension(mlon0:mlon1,mlev0:mlev1) :: rrm, & rtramrm, htfunc, htfunc2 + ! ! Initialize coefficients: ! zigm11 = finit zigm22 = finit + zigm1 = finit zigm2 = finit zigmc = finit rim1 = finit @@ -902,12 +611,16 @@ subroutine fieldline_integrals ! zigm11(i,j) = zigm11(i,j) + sig1*rtramrm(i,k) zigm22(i,j) = zigm22(i,j) + sig1*rtramrm(i,k)*htfunc2(i,k) + ! ! zigmc: int (sigma_p*d_1*d_2/D) ds ! zigm2: int (sigma_h) ds ! zigmc(i,j) = zigmc(i,j) + sig1*rtramrm(i,k)*htfunc(i,k) zigm2(i,j) = zigm2(i,j) + sig2*rtramrm(i,k)*htfunc(i,k) + +! zigm1: int(sigma_p) ds + zigm1(i,j) = zigm1(i,j) + sig1*rtramrm(i,k)*htfunc(i,k) ! ! rim1: int [sigma_p*d_1^2/D u_e2+(sigma_h-(sigma_p*d_1*d_2)/D) u_e1] ds ! rim2: int [(sigma_h+sigma_p*d_1*d_2/D) u_e2-sigma_p*d_2^2/D u_e1 ] ds @@ -940,21 +653,23 @@ subroutine fieldline_integrals zigm22(i,j) = 1.e-2_r8*zigm22(i,j)*aam(i)*adota2_mag(i,j) zigmc(i,j) = 1.e-2_r8*zigmc (i,j)*aam(i)*a1dta2_mag(i,j) zigm2(i,j) = 1.e-2_r8*zigm2 (i,j)*aam(i) + zigm1(i,j) = 1.e-2_r8*zigm1 (i,j)*aam(i) rim1(i,j) = 1.e-2_r8*rim1(i,j)*aam(i)*be3_mag(i,j) rim2(i,j) = 1.e-2_r8*rim2(i,j)*aam(i)*be3_mag(i,j) enddo ! i = 1,nmlon - enddo ! j=mlat0,mlat1 (without poles) - -! call savefld_waccm_switch(adota1_mag(mlon0:mlon1,mlat0:mlat1) ,'adota1_mag_a' ,1,mlon0,mlon1,mlat0,mlat1) + enddo ! j=mlat0,mlat1 (without poles) -! call savefld_waccm_switch(zigm11(mlon0:mlon1,mlat0:mlat1) ,'ZIGM11_a' ,1,mlon0,mlon1,mlat0,mlat1) + if (debug_hist) then + call savefld_waccm(adota1_mag(mlon0:mlon1,mlat0:mlat1) ,'adota1_mag_a' ,1,mlon0,mlon1,mlat0,mlat1) + call savefld_waccm(zigm11(mlon0:mlon1,mlat0:mlat1) ,'ZIGM11_a' ,1,mlon0,mlon1,mlat0,mlat1) + endif end subroutine fieldline_integrals !----------------------------------------------------------------------- subroutine complete_integrals - use edyn_mpi,only: mlat0,mlat1,mlon0,mlon1,mp_mageq_jpm1,mp_magpole_2d,& - mp_mag_foldhem,mp_mag_periodic_f2d - use edyn_maggrid,only: rcos0s,dt1dts + use edyn_mpi, only: mlat0, mlat1, mlon0, mlon1, mp_mageq_jpm1 + use edyn_mpi, only: mp_magpole_2d, mp_mag_foldhem, mp_mag_periodic_f2d + use edyn_maggrid, only: rcos0s,dt1dts ! ! Field line integrals for each hemisphere have been calculated in ! mag subdomains. Now, complete these arrays with equator and polar @@ -968,17 +683,12 @@ subroutine complete_integrals integer :: i,j,ii,lonend real(r8) :: fmsub(mlon0:mlon1,mlat0:mlat1,nf2d) real(r8) :: corfac - real(r8),parameter :: r8_nmlon = dble(nmlon) + real(r8) :: r8_nmlon + r8_nmlon = real(nmlon, r8) ! -! If do_integ==.false. (meaning use_time3d_integ=.true.), then these were passed in -! from time3d (in this case, dynamo did not call fieldline_integrals). Otherwise, -! they were calculated by this module, in sub fieldline_integrals and this routine. -! - -! ! For equatorial values, we need latitudes eq+1 and eq-1: ! Local feq_jpm1(nmlonp1,2,6) is returned by mp_mageq_jpm1, -! where the 2 dim contains lats nmlath-1, nmlath+1. These +! where the 2 dim contains lats nmlath-1, nmlath+1. These ! are global in lon, even tho each subd uses only its own i's. ! These mag equator values do not show up on plots because ! of the small factor .06 and .125. @@ -993,6 +703,7 @@ subroutine complete_integrals fmsub(:,:,4) = zigm2 (mlon0:mlon1,mlat0:mlat1) fmsub(:,:,5) = rim1 (mlon0:mlon1,mlat0:mlat1) fmsub(:,:,6) = rim2 (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,7) = zigm1 (mlon0:mlon1,mlat0:mlat1) call mp_mageq_jpm1(fmsub,mlon0,mlon1,mlat0,mlat1,nmlonp1,feq_jpm1,nf2d) ! @@ -1033,6 +744,8 @@ subroutine complete_integrals feq_jpm1(mlon0:mlon1,2,5)) rim2 (mlon0:mlon1,j) = .060_r8*(feq_jpm1(mlon0:mlon1,1,6)+ & feq_jpm1(mlon0:mlon1,2,6)) + zigm1 (mlon0:mlon1,j) = .060_r8*(feq_jpm1(mlon0:mlon1,1,7)+ & + feq_jpm1(mlon0:mlon1,2,7)) ! ! Include the boundary condition at the equator eq.(5.30) in ! Richmond (1995) Ionospheric Electrodynamics use. Mag. Apex Coord. @@ -1050,12 +763,6 @@ subroutine complete_integrals enddo ! i=mlon0,mlon1 endif ! j at equator enddo ! j=mlat0,mlat1 -! - do j=mlat0,mlat1 - call outfld('EDYN_ZIGM11_PED',zigm11(mlon0:omlon1,j),omlon1-mlon0+1,j) - call outfld('EDYN_ZIGM2_HAL',zigm2(mlon0:omlon1,j),omlon1-mlon0+1,j) - enddo - ! ! Using notation of Richmond (1995) on right-hand side below: ! Sigma_(phi phi) = zigm11*abs(sin I_m) @@ -1091,20 +798,21 @@ subroutine complete_integrals rim2(i,j) = rim2(i,j)/rcos0s(j) enddo enddo -! +! ! For polar values, we need south pole plus 1 and 2 (j==2,3), -! and north pole minus 1 and 2 (j==nmlat-1,nmlat-2). These +! and north pole minus 1 and 2 (j==nmlat-1,nmlat-2). These ! are returned by sub mp_magpole_jpm2 (mpi.F): ! Must specify (mlon0:mlon1,mlat0:mlat1) because zigmxx and rims -! are allocated to include halo cells. -! +! are allocated to include halo cells. +! fmsub(:,:,1) = zigm11(mlon0:mlon1,mlat0:mlat1) fmsub(:,:,2) = zigm22(mlon0:mlon1,mlat0:mlat1) fmsub(:,:,3) = zigmc (mlon0:mlon1,mlat0:mlat1) fmsub(:,:,4) = zigm2 (mlon0:mlon1,mlat0:mlat1) fmsub(:,:,5) = rim1 (mlon0:mlon1,mlat0:mlat1) fmsub(:,:,6) = rim2 (mlon0:mlon1,mlat0:mlat1) -! + fmsub(:,:,7) = zigm1 (mlon0:mlon1,mlat0:mlat1) +! ! mp_magpole_2d returns fpole_jpm2(nmlonp1,1->4,nf) as: ! 1: j = 2 (spole+1) ! 2: j = 3 (spole+2) @@ -1144,6 +852,10 @@ subroutine complete_integrals dot_product(unitvm,fpole_jpm2(1:nmlon,1,4))- & dot_product(unitvm,fpole_jpm2(1:nmlon,2,4)))/ & (3._r8*r8_nmlon) + zigm1(mlon0,j) = (4._r8* & + dot_product(unitvm,fpole_jpm2(1:nmlon,1,7))- & + dot_product(unitvm,fpole_jpm2(1:nmlon,2,7)))/ & + (3._r8*r8_nmlon) ! ! Extend south pole over longitude: do i=mlon0+1,mlon1 @@ -1151,8 +863,9 @@ subroutine complete_integrals zigm22(i,j) = zigm22(mlon0,j) zigmc (i,j) = zigmc (mlon0,j) zigm2 (i,j) = zigm2 (mlon0,j) + zigm1 (i,j) = zigm1 (mlon0,j) enddo ! i=mlon0,mlon1 -! +! ! RHS vector (I_1,I_2): average over south pole: ! (use fpole_jpm2(i,1,nf), i.e. j==2, and lons across the pole) lonend = mlon1 @@ -1162,7 +875,7 @@ subroutine complete_integrals rim1(i,j) = 0.5_r8*(fpole_jpm2(i,1,5)-fpole_jpm2(ii,1,5)) rim2(i,j) = 0.5_r8*(fpole_jpm2(i,1,6)-fpole_jpm2(ii,1,6)) enddo -! +! ! North pole: elseif (j==nmlat) then ! north pole (use fpole_jpm2(nmlon,3->4,1,nf) zigm11(mlon0,j)=(4._r8* & @@ -1181,15 +894,20 @@ subroutine complete_integrals dot_product(unitvm,fpole_jpm2(1:nmlon,3,4))- & dot_product(unitvm,fpole_jpm2(1:nmlon,4,4)))/ & (3._r8*r8_nmlon) -! + zigm1(mlon0,j) = (4._r8* & + dot_product(unitvm,fpole_jpm2(1:nmlon,3,7))- & + dot_product(unitvm,fpole_jpm2(1:nmlon,4,7)))/ & + (3._r8*r8_nmlon) +! ! Extend north pole over longitude: do i=mlon0+1,mlon1 zigm11(i,j) = zigm11(mlon0,j) zigm22(i,j) = zigm22(mlon0,j) zigmc (i,j) = zigmc (mlon0,j) zigm2 (i,j) = zigm2 (mlon0,j) + zigm1 (i,j) = zigm1 (mlon0,j) enddo ! i=mlon0,mlon1 -! +! ! RHS vector (I_1,I_2): average over north pole: ! (use fpole_jpm2(i,3,nf), i.e. j==nmlat-1, and lons across the pole) lonend = mlon1 @@ -1209,6 +927,7 @@ subroutine complete_integrals fmsub(:,:,4) = zigm2 (mlon0:mlon1,mlat0:mlat1) fmsub(:,:,5) = rim1 (mlon0:mlon1,mlat0:mlat1) fmsub(:,:,6) = rim2 (mlon0:mlon1,mlat0:mlat1) + fmsub(:,:,7) = zigm1 (mlon0:mlon1,mlat0:mlat1) call mp_mag_foldhem(fmsub,mlon0,mlon1,mlat0,mlat1,nf2d) call mp_mag_periodic_f2d(fmsub,mlon0,mlon1,mlat0,mlat1,nf2d) @@ -1219,17 +938,22 @@ subroutine complete_integrals zigm2 (mlon0:mlon1,mlat0:mlat1) = fmsub(:,:,4) rim1 (mlon0:mlon1,mlat0:mlat1) = fmsub(:,:,5) rim2 (mlon0:mlon1,mlat0:mlat1) = fmsub(:,:,6) + zigm1 (mlon0:mlon1,mlat0:mlat1) = fmsub(:,:,7) ! ! Reverse sign of zigmc in northern hemisphere. do j=mlat0,mlat1 - if (j >= nmlath) then - zigmc(mlon0:mlon1,j) = -zigmc(mlon0:mlon1,j) - endif - call outfld('EDYN_RIM1',rim1(mlon0:omlon1,j),omlon1-mlon0+1,j) - call outfld('EDYN_RIM2',rim2(mlon0:omlon1,j),omlon1-mlon0+1,j) + if (j >= nmlath) then + zigmc(mlon0:mlon1,j) = -zigmc(mlon0:mlon1,j) + endif + if (debug_hist) then + call outfld('EDYN_RIM1',rim1(mlon0:omlon1,j),omlon1-mlon0+1,j) + call outfld('EDYN_RIM2',rim2(mlon0:omlon1,j),omlon1-mlon0+1,j) + endif + call outfld('PED_CONDUCTANCE', zigm2(mlon0:omlon1,j),omlon1-mlon0+1,j) + call outfld('HALL_CONDUCTANCE',zigm1(mlon0:omlon1,j),omlon1-mlon0+1,j) enddo - if (debug.and.masterproc) then + if (debug.and.masterproc) then write(iulog,"('complete_integrals: nstep=',i4)") nstep write(iulog,"(' zigm11 min,max=',2e12.4)") & minval(zigm11(mlon0:mlon1,mlat0:mlat1)),maxval(zigm11(mlon0:mlon1,mlat0:mlat1)) @@ -1245,18 +969,20 @@ subroutine complete_integrals minval(rim2 (mlon0:mlon1,mlat0:mlat1)),maxval(rim2 (mlon0:mlon1,mlat0:mlat1)) endif - call savefld_waccm_switch(zigm11(mlon0:mlon1,mlat0:mlat1) ,'EDYN_ZIGM11' ,1,mlon0,mlon1,mlat0,mlat1) - call savefld_waccm_switch(zigm22(mlon0:mlon1,mlat0:mlat1) ,'EDYN_ZIGM22' ,1,mlon0,mlon1,mlat0,mlat1) - call savefld_waccm_switch(zigmc (mlon0:mlon1,mlat0:mlat1) ,'EDYN_ZIGMC' ,1,mlon0,mlon1,mlat0,mlat1) - call savefld_waccm_switch(zigm2 (mlon0:mlon1,mlat0:mlat1) ,'EDYN_ZIGM2' ,1,mlon0,mlon1,mlat0,mlat1) - call savefld_waccm_switch(rim1 (mlon0:mlon1,mlat0:mlat1) ,'EDYN_RIM1' ,1,mlon0,mlon1,mlat0,mlat1) - call savefld_waccm_switch(rim2 (mlon0:mlon1,mlat0:mlat1) ,'EDYN_RIM2' ,1,mlon0,mlon1,mlat0,mlat1) + if (debug_hist) then + call savefld_waccm(zigm11(mlon0:mlon1,mlat0:mlat1) ,'EDYN_ZIGM11' ,1,mlon0,mlon1,mlat0,mlat1) + call savefld_waccm(zigm22(mlon0:mlon1,mlat0:mlat1) ,'EDYN_ZIGM22' ,1,mlon0,mlon1,mlat0,mlat1) + call savefld_waccm(zigmc (mlon0:mlon1,mlat0:mlat1) ,'EDYN_ZIGMC' ,1,mlon0,mlon1,mlat0,mlat1) + call savefld_waccm(zigm2 (mlon0:mlon1,mlat0:mlat1) ,'EDYN_ZIGM2' ,1,mlon0,mlon1,mlat0,mlat1) + call savefld_waccm(rim1 (mlon0:mlon1,mlat0:mlat1) ,'EDYN_RIM1' ,1,mlon0,mlon1,mlat0,mlat1) + call savefld_waccm(rim2 (mlon0:mlon1,mlat0:mlat1) ,'EDYN_RIM2' ,1,mlon0,mlon1,mlat0,mlat1) + endif end subroutine complete_integrals !----------------------------------------------------------------------- - subroutine rhspde - use edyn_params ,only: pi_dyn,r0 - use edyn_maggrid ,only: dlatm,dlonm,rcos0s,dt1dts + subroutine rhspde() + use edyn_params, only: pi_dyn, r0 + use edyn_maggrid, only: dlatm, dlonm, rcos0s, dt1dts ! ! Calculate right-hand side from rim1,2 on mag subdomains. ! Use global longitude arrays for poles and equator obtained @@ -1264,7 +990,7 @@ subroutine rhspde ! ! Local: integer :: j,i - real(r8),dimension(nmlat) :: tint1 + real(r8), dimension(nmlat) :: tint1 real(r8) :: & rim2_npm1(nmlonp1), & ! global rim2 at nmlat-1 rim2_eqp1(nmlonp1), & ! global rim2 at meq+1 @@ -1274,7 +1000,8 @@ subroutine rhspde zigm2_meq(nmlonp1), & ! needed for rim1_meq zigmc_meq(nmlonp1), & ! needed for rim1_meq zigm22_meq(nmlonp1) ! needed for rim1_meq - real(r8),parameter :: r8_nmlon = dble(nmlon) + real(r8) :: r8_nmlon + r8_nmlon = real(nmlon, r8) do j=1,nmlat tint1(j) = cos(-pi_dyn/2._r8+(j-1)*dlatm) @@ -1382,24 +1109,24 @@ subroutine rhspde end subroutine rhspde !----------------------------------------------------------------------- - subroutine gather_edyn + subroutine gather_edyn() ! ! Gather needed global arrays to root task, so it can finish non-parallel ! part of dynamo (beginning after sub rhspde) as in original code ! - use edyn_mpi, only: mp_gather_edyn - use edyn_solve,only: & ! (nmlonp1,nmlat) - zigm11_glb ,& - zigm22_glb ,& - zigmc_glb ,& - zigm2_glb ,& - rhs_glb - use edyn_solve ,only: rim_glb ! pde solver output (nmlonp1,nmlat,2) + use edyn_mpi, only: mp_gather_edyn + use edyn_solve, only: & ! (nmlonp1,nmlat) + zigm11_glb, & + zigm22_glb, & + zigmc_glb, & + zigm2_glb, & + rhs_glb + use edyn_solve, only: rim_glb ! pde solver output (nmlonp1,nmlat,2) ! ! Local: ! 7 fields to gather: zigm11,zigm22,zigmc,zigm2,rim1,rim2,rhs ! - integer,parameter :: nf = 7 + integer, parameter :: nf = 7 real(r8) :: fmsub(mlon0:mlon1,mlat0:mlat1,nf) real(r8) :: fmglb(nmlonp1,nmlat,nf) real(r8) :: rhs_nhem(nmlonp1,nmlat) @@ -1457,10 +1184,10 @@ subroutine gather_edyn endif ! mytid==0 end subroutine gather_edyn !----------------------------------------------------------------------- - subroutine highlat_poten - use edyn_solve,only: & - phihm ,& ! high-latitude potential (nmlonp1,nmlat) - pfrac ! NH fraction of potential (nmlonp1,nmlat0) + subroutine highlat_poten() + use edyn_solve, only: & + phihm, & ! high-latitude potential (nmlonp1,nmlat) + pfrac ! NH fraction of potential (nmlonp1,nmlat0) ! ! Global PDE solution rim_glb(:,:,1) has been scattered to mag subdomains ! in rim1, and halos set (this overwrites previous rim1 from fieldline @@ -1478,7 +1205,7 @@ subroutine highlat_poten ! phihm is on 2d global mag grid, pfrac is in north hemisphere only ! ! Local: - logical,parameter :: mod_heelis = .false. ! true == modified + logical, parameter :: mod_heelis = .false. ! true == modified integer :: i,j,jn,js real(r8) :: fac ! @@ -1504,57 +1231,58 @@ subroutine highlat_poten enddo do j=mlat0,mlat1 + call outfld('PHIHM',phihm(mlon0:omlon1,j),omlon1-mlon0+1,j) call outfld('PHIM2D',phim2d(mlon0:omlon1,j),omlon1-mlon0+1,j) enddo end subroutine highlat_poten !----------------------------------------------------------------------- - subroutine pthreed + subroutine pthreed() ! ! phim2d is now 2d electric potential solution on mag subdomains, ! with high-latitude potential added from empirical model (see subs -! heelis and highlat_poten), and mag halos set. Now expand phim2d in -! vertical, defining phim3d. Also calculate electric field ed13d, ed23d +! heelis and highlat_poten), and mag halos set. Now expand phim2d in +! vertical, defining phim3d. Also calculate electric field ed13d, ed23d ! for later current calculations, and ephi3d, elam3d and emz3d for conversion -! to geographic grid (sub pefield), and subsequent calculation of ion drifts +! to geographic grid (sub pefield), and subsequent calculation of ion drifts ! by sub ionvel (not in edynamo). ! - use edyn_params ,only: re,pi_dyn,r0,kbotdyn - use edyn_maggrid,only: ylatm,dlatm,dlonm,rcos0s,dt1dts,dt0dts,table - use edyn_mpi ,only: & - mp_mag_halos ,& - mp_magpole_2d ,& - mp_mageq_jpm3 ,& - mp_mag_jslot ,& - mp_magpoles ,& - mp_mag_periodic_f2d ,& + use edyn_params, only: Rearth, pi_dyn, r0, kbotdyn + use edyn_maggrid, only: ylatm, dlatm, dlonm, rcos0s, dt1dts, dt0dts, table + use edyn_mpi, only: & + mp_mag_halos, & + mp_magpole_2d, & + mp_mageq_jpm3, & + mp_mag_jslot, & + mp_magpoles, & + mp_mag_periodic_f2d, & ixfind ! ! Local: - real(r8),parameter :: eps = 1.e-10_r8, unitvm(nmlon)=1._r8 - integer,parameter :: mxneed=nmlat+2 - integer :: i,j,k,n,mlon00,mlon11,mlat00,mlat11 - real(r8) :: csth0,cosltm,sym,pi,phims,phimn,real8 - real(r8),dimension(nmlonp1) :: thetam,pslot,qslot - integer,dimension(nmlonp1) :: islot,jslot,ip1f,ip2f,ip3f + real(r8), parameter :: eps = 1.e-10_r8 + integer :: mxneed + integer :: i,j,k,n,mlon00,mlon11,mlat00,mlat11 + real(r8) :: csth0, cosltm, sym, pi, phims, phimn, rind + real(r8), dimension(nmlonp1) :: thetam,pslot,qslot + integer, dimension(nmlonp1) :: islot,jslot,ip1f,ip2f,ip3f -! real(r8),dimension(mlon0-1:mlon1+1,mlat0-1:mlat1+1) :: ed1,ed2 +! real(r8), dimension(mlon0-1:mlon1+1,mlat0-1:mlat1+1) :: ed1,ed2 - real(r8),dimension(mlon0-1:mlon1+1,mlat0-1:mlat1+1) :: ephi,elam + real(r8), dimension(mlon0-1:mlon1+1,mlat0-1:mlat1+1) :: ephi,elam real(r8) :: fpole2d_jpm2(nmlonp1,4,4) ! global lons at S pole+1,2 and N pole-1,2 real(r8) :: fpoles(nmlonp1,2,1) ! global lons at poles (1 field only) real(r8) :: fmsub(mlon0:mlon1,mlat0:mlat1,4) real(r8) :: fmsub1(mlon0-1:mlon1+1,mlat0-1:mlat1+1,5) real(r8) :: feq_jpm3(nmlonp1,-3:3,1) ! global lons at equator +/- 3 - integer :: jneed(mxneed) ! lats needed from other tasks for interp + integer :: jneed(nmlat+2) ! lats needed from other tasks for interp integer :: njneed,icount - real(r8),dimension(mlon0-1:mlon1+1,mxneed) :: & + real(r8), dimension(mlon0-1:mlon1+1,nmlat+2) :: & phineed, & ! phim2d at needed latitudes ed1need, & ! ed1 at needed latitudes ed2need, & ! ed2 at needed latitudes ephineed, & ! ephi at needed latitudes elamneed ! elam at needed latitudes - real(r8),dimension(mlon0-1:mlon1+1,mxneed,5) :: fmneed + real(r8), dimension(mlon0-1:mlon1+1,nmlat+2,5) :: fmneed real(r8) :: phi0j0,phi1j0,phi0j1,phi1j1 real(r8) :: ed1i0j0,ed1i1j0,ed1i0j1,ed1i1j1 real(r8) :: ed2i0j0,ed2i1j0,ed2i0j1,ed2i1j1 @@ -1562,6 +1290,7 @@ subroutine pthreed real(r8) :: elam0j0,elam1j0,elam0j1,elam1j1 real(r8) :: fac_elam ! + mxneed=nmlat+2 pi = pi_dyn mlon00=mlon0-1 ; mlon11=mlon1+1 mlat00=mlat0-1 ; mlat11=mlat1+1 @@ -1708,7 +1437,7 @@ subroutine pthreed ! outside a task's latitudinal subdomain: ! if (debug) write(iulog,*) "pthreed: kbotdyn ", kbotdyn - + njneed = 0 ! number of unique latitudes needed jneed(:) = -1 ! j-indices of needed latitudes do k=kbotdyn,nmlev @@ -1720,13 +1449,13 @@ subroutine pthreed do i=mlon0,mlon1 if (i==nmlonp1) cycle - thetam(i)=(re+zpotm3d(i,j,kbotdyn))/(re+zpotm3d(i,j,k)) + thetam(i)=(Rearth+zpotm3d(i,j,kbotdyn))/(Rearth+zpotm3d(i,j,k)) thetam(i) = acos(sqrt(thetam(i))*cosltm*(1._r8-eps)) pslot(i) = thetam(i)*180._r8/pi+1._r8 islot(i) = pslot(i) - real8 = dble(islot(i)) - pslot(i) = pslot(i)-real8 + rind = real(islot(i), kind=r8) + pslot(i) = pslot(i)-rind thetam(i) = ((1._r8-pslot(i))*table(islot(i),2)+pslot(i)* & table(islot(i)+1,2))*sym ! thetam negative for south hem @@ -1735,8 +1464,8 @@ subroutine pthreed pslot(i) = 0._r8 qslot(i) = (thetam(i)+pi/2._r8)/dlatm+1._r8 jslot(i) = qslot(i) - real8 = dble(jslot(i)) - qslot(i) = qslot(i)-real8 + rind = real(jslot(i), kind=r8) + qslot(i) = qslot(i)-rind ! Save j index if outside subdomain w/ halos: if ((jslot(i) < mlat00 .or. jslot(i) > mlat11).and. & @@ -1756,7 +1485,7 @@ subroutine pthreed enddo ! i=mlon0,mlon1 enddo ! j=mlat0,mlat1 enddo ! k=kbotdyn,nmlev -! +! ! Get phim2 at needed latitudes (note inclusion of phim2d halos). ! real,intent(in) :: fin(mlon00:mlon11,mlat00:mlat11,nf) ! data at current subdomain ! real,intent(out) :: fout(mlon00:mlon11,mxneed,nf) ! returned data at needed lats @@ -1785,14 +1514,14 @@ subroutine pthreed do i=mlon0,mlon1 if (i==nmlonp1) cycle - thetam(i)=(re+zpotm3d(i,j,kbotdyn))/(re+zpotm3d(i,j,k)) + thetam(i)=(Rearth+zpotm3d(i,j,kbotdyn))/(Rearth+zpotm3d(i,j,k)) thetam(i) = acos(sqrt(thetam(i))*cosltm*(1._r8-eps)) fac_elam = tan(ylatm(j))/tan(thetam(i)*sym) ! tan(lambda_q)/tan(lambda_m) pslot(i) = thetam(i)*180._r8/pi+1._r8 islot(i) = pslot(i) - real8 = dble(islot(i)) - pslot(i) = pslot(i)-real8 + rind = real(islot(i), kind=r8) + pslot(i) = pslot(i)-rind thetam(i) = ((1._r8-pslot(i))*table(islot(i),2)+pslot(i)* & table(islot(i)+1,2))*sym ! thetam negative for south hem @@ -1801,8 +1530,8 @@ subroutine pthreed pslot(i) = 0._r8 qslot(i) = (thetam(i)+pi/2._r8)/dlatm+1._r8 jslot(i) = qslot(i) - real8 = dble(jslot(i)) - qslot(i) = qslot(i)-real8 + rind = real(jslot(i), kind=r8) + qslot(i) = qslot(i)-rind ! ! Check for jslot in subdomain: if (jslot(i) >= mlat00.and.jslot(i) <= mlat11) then ! within subdomain @@ -1892,15 +1621,15 @@ subroutine pthreed enddo ! k=kbotdyn,nmlev ! -! Mag poles for phim: +! Mag poles for phim: ! mp_magpoles returns global longitudes at S,N poles in fpoles(nglblon,2,nf) ! call mp_magpoles(phim2d(mlon0:mlon1,mlat0:mlat1), & mlon0,mlon1,mlat0,mlat1,nmlonp1,1,nmlat,fpoles,1) - real8 = dble(nmlon) - phims=dot_product(unitvm,fpoles(1:nmlon,1,1))/real8 - phimn=dot_product(unitvm,fpoles(1:nmlon,2,1))/real8 + rind = real(nmlon, kind=r8) + phims=dot_product(unitvm,fpoles(1:nmlon,1,1))/rind + phimn=dot_product(unitvm,fpoles(1:nmlon,2,1))/rind do k=kbotdyn,nmlev do j=mlat0,mlat1 @@ -1915,7 +1644,7 @@ subroutine pthreed elseif (j==nmlat) then do i=mlon0,mlon1 phim3d(i,j,k) = phimn - ed13d(i,j,k) = ed1(i,j) + ed13d(i,j,k) = ed1(i,j) ed23d(i,j,k) = ed2(i,j) ephi3d(i,j,k) = ephi(i,j) elam3d(i,j,k) = -ed2(i,j)*(r0*1.e-2_r8) @@ -1939,46 +1668,51 @@ subroutine pthreed enddo enddo enddo -! +! do k=mlev0,mlev1 call mp_mag_periodic_f2d(phim3d(:,:,k),mlon0,mlon1,mlat0,mlat1,1) enddo ! - do j=mlat0,mlat1 - call outfld('EPHI3D',ephi3d(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) - call outfld('ELAM3D',elam3d(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) - call outfld('EMZ3D', emz3d(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + if (debug_hist) then + do j=mlat0,mlat1 + call outfld('EPHI3D',ephi3d(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('ELAM3D',elam3d(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('EMZ3D', emz3d(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + enddo + endif - call outfld('PHIM3D',phim3d(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) - call outfld('ED13D' ,ed13d (mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) - call outfld('ED23D' ,ed23d (mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + do j=mlat0,mlat1 + call outfld('PHIM3D',phim3d(mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('ED13D' ,ed13d (mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) + call outfld('ED23D' ,ed23d (mlon0:omlon1,j,mlev1:mlev0:-1),omlon1-mlon0+1,j) enddo + end subroutine pthreed !----------------------------------------------------------------------- - subroutine pefield - use edyn_params ,only: pi - use edyn_maggrid,only: dt0dts,dlatm,dlonm,rcos0s - use edyn_geogrid,only: nlev - use edyn_mpi ,only: mp_magpole_3d,mp_mag_halos,mp_magpoles - use edyn_esmf ,only: mag_ephi3d,mag_elam3d,mag_emz3d,mag_phi3d,& - geo_ephi3d,geo_elam3d,geo_emz3d,geo_phi3d + subroutine pefield() + use edyn_params, only: pi + use edyn_maggrid, only: dt0dts, dlatm, dlonm, rcos0s + use edyn_geogrid, only: nlev + use edyn_mpi, only: mp_magpole_3d, mp_mag_halos, mp_magpoles + use regridder, only: regrid_mag2geo_3d ! ! Local: - integer :: i,ii,j,k - real(r8) :: & - phi3d(mlon0-1:mlon1+1,mlat0-1:mlat1+1,nmlev), & ! local phi w/ halos - fpole3d_jpm2(nmlonp1,4,nmlev,1) ! global lons at S pole+1,2 and N pole-1,2 - real(r8) :: csth0,real8 - real(r8) :: fpoles(nmlonp1,2,nmlev) ! global lons at poles - real(r8),dimension(lon0:lon1,lat0:lat1,nlev) :: exgeo,eygeo,ezgeo + integer :: i, ii, j, k + real(r8) :: & + phi3d(mlon0-1:mlon1+1,mlat0-1:mlat1+1,nmlev), & ! local phi w/ halos + fpole3d_jpm2(nmlonp1,4,nmlev,1) ! global lons at S pole+1,2 and N pole-1,2 + real(r8) :: csth0 + real(r8) :: fpoles(nmlonp1,2,nmlev) ! global lons at poles + real(r8), dimension(lon0:lon1,lat0:lat1,nlev) :: exgeo, eygeo, ezgeo + ! ! Copy phim3d to local phi3d, and set halo points: - do j=mlat0,mlat1 - do i=mlon0,mlon1 - phi3d(i,j,:) = phim3d(i,j,:) - enddo - enddo - call mp_mag_halos(phi3d,mlon0,mlon1,mlat0,mlat1,nmlev) + do j = mlat0, mlat1 + do i = mlon0, mlon1 + phi3d(i,j,:) = phim3d(i,j,:) + end do + end do + call mp_mag_halos(phi3d, mlon0, mlon1, mlat0, mlat1, nmlev) ! ! Return fpole3d_jpm2(nglblon,1->4,nlev,nf) as: ! 1: j = jspole+1 (spole+1) @@ -1986,271 +1720,214 @@ subroutine pefield ! 3: j = jnpole-1 (npole-1) ! 4: j = jnpole-2 (npole-2) not used here ! - call mp_magpole_3d(phim3d(mlon0:mlon1,mlat0:mlat1,:),mlon0,& - mlon1,mlat0,mlat1,nmlev,nmlonp1,1,nmlat,fpole3d_jpm2,1) + call mp_magpole_3d(phim3d(mlon0:mlon1,mlat0:mlat1,:), mlon0, & + mlon1, mlat0, mlat1, nmlev, nmlonp1, 1, nmlat, fpole3d_jpm2, 1) ! ! Set j=0 and j=nmlat+1 of local phi3d. This overwrites the far ! north and south halo points set by mp_mag_halos above. - do j=mlat0,mlat1 - if (j==1) then - do i=mlon0,mlon1 - ii = 1+mod(i-1+nmlon/2,nmlon) ! over the south pole - phi3d(i,j-1,:) = fpole3d_jpm2(ii,1,:,1) - enddo - elseif (j==nmlat) then - do i=mlon0,mlon1 - ii = 1+mod(i-1+nmlon/2,nmlon) ! over the north pole - phi3d(i,j+1,:) = fpole3d_jpm2(ii,3,:,1) - enddo - endif ! poles or not - enddo ! j=mlat0,mlat1 + do j = mlat0, mlat1 + if (j==1) then + do i = mlon0, mlon1 + ii = 1 + mod(i-1+nmlon/2,nmlon) ! over the south pole + phi3d(i,j-1,:) = fpole3d_jpm2(ii,1,:,1) + end do + else if (j == nmlat) then + do i = mlon0, mlon1 + ii = 1 + mod(i-1+nmlon/2,nmlon) ! over the north pole + phi3d(i,j+1,:) = fpole3d_jpm2(ii,3,:,1) + end do + end if ! poles or not + end do ! j=mlat0,mlat1 ! ! Meridional component of electric field: - do j=mlat0,mlat1 - do i=mlon0,mlon1 - elam3d(i,j,:) = -(phi3d(i,j+1,:)-phi3d(i,j-1,:))/ & - (2._r8*dlatm)*dt0dts(j) - enddo - enddo + do j = mlat0, mlat1 + do i = mlon0, mlon1 + elam3d(i,j,:) = -(phi3d(i,j+1,:)-phi3d(i,j-1,:)) / & + (2._r8*dlatm)*dt0dts(j) + end do + end do ! ! Zonal component of electric field: - do j=mlat0,mlat1 - if (j==1.or.j==nmlat) cycle - real8 = dble(j-1) - csth0 = cos(-pi/2._r8+real8*dlatm) - do i=mlon0,mlon1 - ephi3d(i,j,:) = -(phi3d(i+1,j,:)-phi3d(i-1,j,:))/ & - (2._r8*dlonm*csth0)*rcos0s(j) - enddo - enddo -! -! Polar values for ephi3d (need global lons at poles of elam3d): - call mp_magpoles(elam3d,mlon0,mlon1,mlat0,mlat1,nmlonp1,1,nmlat,fpoles,nmlev) - do j=mlat0,mlat1 - if (j==1) then ! south pole - do i=mlon0,mlon1 - ii = 1+mod(i-1+(nmlon/4),nmlon) ! over the south pole - ephi3d(i,j,:) = fpoles(ii,1,:) - enddo - elseif (j==nmlat) then ! north pole - do i=mlon0,mlon1 - ii = 1+mod(i-1+((3*nmlon)/4),nmlon) ! over the north pole - ephi3d(i,j,:) = fpoles(ii,2,:) - enddo - endif ! poles or not - enddo ! j=mlat0,mlat1 -! -! emz = d(phi)/dz - do k=2,nmlev-1 - do j=mlat0,mlat1 - do i=mlon0,mlon1 - emz3d(i,j,k) = -(phim3d(i,j,k+1)-phi3d(i,j,k-1)) - enddo - enddo - enddo ! k=2,nmlev-1 + do j = mlat0, mlat1 + if (j==1 .or. j==nmlat) cycle + csth0 = cos((-pi / 2._r8) + (real(j-1,kind=r8) * dlatm)) + do i = mlon0, mlon1 + ephi3d(i,j,:) = -(phi3d(i+1,j,:) - phi3d(i-1,j,:)) / & + (2._r8 * dlonm * csth0) * rcos0s(j) + end do + end do ! -! btf 6/18/14: mag2geo is not working due to error return rc=51 from -! ESMF_FieldSMM for 3d mag2geo (see sub esmf_regrid in edyn_esmf.F90) -! (this is the call to do the data regridding, not the init call) +! Polar values for ephi3d (need global lons at poles of elam3d): + call mp_magpoles(elam3d,mlon0,mlon1,mlat0,mlat1,nmlonp1,1,nmlat,fpoles,nmlev) + do j = mlat0, mlat1 + if (j == 1) then ! south pole + do i = mlon0, mlon1 + ii = 1 + mod(i-1+(nmlon/4),nmlon) ! over the south pole + ephi3d(i,j,:) = fpoles(ii,1,:) + end do + else if (j == nmlat) then ! north pole + do i = mlon0, mlon1 + ii = 1+mod(i-1+((3*nmlon)/4),nmlon) ! over the north pole + ephi3d(i,j,:) = fpoles(ii,2,:) + end do + end if ! poles or not + end do ! j=mlat0,mlat1 ! -! Use ESMF to regrid the electric field to the geographic grid: - call mag2geo_3d(ephi3d,exgeo ,mag_ephi3d,geo_ephi3d,'EPHI3D ') - call mag2geo_3d(elam3d,eygeo ,mag_elam3d,geo_elam3d,'ELAM3D ') - call mag2geo_3d(emz3d ,ezgeo ,mag_emz3d ,geo_emz3d ,'EMZ3D ') - call mag2geo_3d(phim3d,phig3d,mag_phi3d ,geo_phi3d ,'PHIM3D ') +! emz = d(phi)/dz + do k = 2, nmlev-1 + do j = mlat0, mlat1 + do i = mlon0, mlon1 + emz3d(i,j,k) = -(phim3d(i,j,k+1)-phi3d(i,j,k-1)) + end do + end do + end do ! k=2,nmlev-1 + +! regrid from mag grid to geo grid + call regrid_mag2geo_3d( ephi3d, exgeo ) + call regrid_mag2geo_3d( elam3d, eygeo ) + call regrid_mag2geo_3d( emz3d, ezgeo ) + call regrid_mag2geo_3d( phim3d, phig3d ) ! ! Define ex,ey,ez on geographic subdomains for ionvel: - do j=lat0,lat1 - do i=lon0,lon1 - ex(:,i,j) = exgeo(i,j,:) - ey(:,i,j) = eygeo(i,j,:) - ez(:,i,j) = ezgeo(i,j,:) - poten(:,i,j) = phig3d(i,j,:) - enddo - enddo + do j = lat0, lat1 + do i = lon0, lon1 + ex(:,i,j) = exgeo(i,j,:) + ey(:,i,j) = eygeo(i,j,:) + ez(:,i,j) = ezgeo(i,j,:) + poten(:,i,j) = phig3d(i,j,:) + end do + end do ! ex,ey,ez(nlev,lon0-2,lon1+2,lat0:lat1) - if (debug) then - write(iulog,"('pefield after mag2geo: ex=',2e12.4,' ey=',2e12.4,' ez=',2e12.4)") & - minval(ex(:,lon0:lon1,:)),maxval(ex(:,lon0:lon1,:)), & - minval(ey(:,lon0:lon1,:)),maxval(ey(:,lon0:lon1,:)), & - minval(ez(:,lon0:lon1,:)),maxval(ez(:,lon0:lon1,:)) - endif + if (debug) then + write(iulog,"(a,2e12.4,' ey=',2e12.4,' ez=',2e12.4)") & + 'pefield after mag2phys: ex=', & + minval(ex(:,lon0:lon1,:)),maxval(ex(:,lon0:lon1,:)), & + minval(ey(:,lon0:lon1,:)),maxval(ey(:,lon0:lon1,:)), & + minval(ez(:,lon0:lon1,:)),maxval(ez(:,lon0:lon1,:)) + end if - call savefld_waccm_switch(poten(1:nlev,lon0:lon1,lat0:lat1),'POTEN',& - nlev,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(ex(1:nlev,lon0:lon1,lat0:lat1),'EX',& - nlev,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(ey(1:nlev,lon0:lon1,lat0:lat1),'EY',& - nlev,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(ez(1:nlev,lon0:lon1,lat0:lat1),'EZ',& - nlev,lon0,lon1,lat0,lat1) + call savefld_waccm(poten(1:nlev,lon0:lon1,lat0:lat1),'POTEN', & + nlev,lon0,lon1,lat0,lat1) end subroutine pefield -!----------------------------------------------------------------------- - subroutine ionvel(z,ui,vi,wi) + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + + subroutine ionvel(z,ui,vi,wi,lon0,lon1, lat0,lat1, lev0,lev1) ! ! Calculate 3d ExB ion drifts from electric field (sub pefield) ! on geographic grid. ! - use edyn_params ,only: re - use edyn_geogrid ,only: nlev - use getapex ,only: & - rjac ,& ! (nlon+1,jspole:jnpole,2,2) - bmod ,& ! magnitude of magnetic field (nlon+1,jspole:jnpole) - xb,yb,zb ! north,east,down magnetic field (nlon+1,jspole:jnpole) + use edyn_params, only: Rearth + use edyn_geogrid, only: nlev + use getapex, only: rjac ! (nlon+1,jspole:jnpole,2,2) + use getapex, only: bmod ! magnitude of mag field (nlon+1,jspole:jnpole) + use getapex, only: xb,yb,zb ! north,east,down mag field (nlon+1,jspole:jnpole) ! ! Args: - real(r8),intent(in),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: & + integer,intent(in) :: & ! geographic subdomain + lon0, lon1, & ! first,last longitude indices of geographic subdomain + lat0, lat1, & ! first,last latitude indices of geographic subdomain + lev0, lev1 ! first,last level indices (not distributed) + real(r8),intent(in), dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: & z ! geopotential from input (cm) - real(r8),intent(out),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: & + real(r8),intent(out), dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: & ui,vi,wi ! ! Local: - integer :: i,ii,k,j - real(r8),dimension(lev0:lev1,lon0:lon1) :: eex,eey,eez - real(r8),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: rjac_out + integer :: i,k,j + real(r8), dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: eex,eey,eez + real(r8), dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: rjac_out ! mag field diagnostics - call savefld_waccm_switch(bmod(lon0:lon1,lat0:lat1),'BMOD',1,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(xb(lon0:lon1,lat0:lat1),'XB',1,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(yb(lon0:lon1,lat0:lat1),'YB',1,lon0,lon1,lat0,lat1) - call savefld_waccm_switch(zb(lon0:lon1,lat0:lat1),'ZB',1,lon0,lon1,lat0,lat1) + call savefld_waccm(bmod(lon0:lon1,lat0:lat1),'BMOD',1,lon0,lon1,lat0,lat1) + call savefld_waccm(xb(lon0:lon1,lat0:lat1),'XB',1,lon0,lon1,lat0,lat1) + call savefld_waccm(yb(lon0:lon1,lat0:lat1),'YB',1,lon0,lon1,lat0,lat1) + call savefld_waccm(zb(lon0:lon1,lat0:lat1),'ZB',1,lon0,lon1,lat0,lat1) ! ! Scan geographic latitude subdomain: ! do j=lat0,lat1 - do i=lon0,lon1 - ii = i - do k=lev0,lev1 - eex(k,i) = (rjac(ii,j,1,1)*ex(k,i,j)+ & - rjac(ii,j,2,1)*ey(k,i,j))/(re+z(k,i,j)) - eey(k,i) = (rjac(ii,j,1,2)*ex(k,i,j)+ & - rjac(ii,j,2,2)*ey(k,i,j))/(re+z(k,i,j)) - enddo ! k=lev0,lev1 - enddo -! - do i=lon0,lon1 - do k=lev0+1,lev1-1 - eez(k,i) = ez(k,i,j)/(z(k+1,i,j)-z(k-1,i,j)) - enddo ! k=lev0+1,lev1-1 - enddo + do i=lon0,lon1 + do k=lev0,lev1 + eex(k,i,j) = (rjac(i,j,1,1)*ex(k,i,j)+rjac(i,j,2,1)*ey(k,i,j))/(Rearth+z(k,i,j)) ! V/cm + eey(k,i,j) = (rjac(i,j,1,2)*ex(k,i,j)+rjac(i,j,2,2)*ey(k,i,j))/(Rearth+z(k,i,j)) + enddo + enddo + + do i=lon0,lon1 + do k=lev0+1,lev1-1 + eez(k,i,j) = ez(k,i,j)/(z(k+1,i,j)-z(k-1,i,j)) + enddo + enddo ! ! Extrapolate for lower and upper boundaries: - do i=lon0,lon1 - eez(lev0,i) = 2._r8*eez(2,i)-eez(3,i) - eez(lev1,i) = 2._r8*eez(lev1-1,i)-eez(lev1-2,i) - enddo - - if (debug.and.masterproc) then - write(iulog,"('ionvel: j=',i4,' eex=',2e12.4,' eey=',2e12.4,' eez=',2e12.4)") & - j,minval(eex),maxval(eex),minval(eey),maxval(eey),minval(eez),maxval(eez) - endif - -! + do i=lon0,lon1 + eez(lev0,i,j) = 2._r8*eez(2,i,j)-eez(3,i,j) + eez(lev1,i,j) = 2._r8*eez(lev1-1,i,j)-eez(lev1-2,i,j) + enddo +! ! ion velocities = (e x b/b**2) (x 1.e6 for m/sec) ! ui = zonal, vi = meridional, wi = vertical ! - do k=lev0,lev1 - do i=lon0,lon1 - ii = i - ui(k,i,j) = -(eey(k,i)*zb(ii,j)+eez(k,i)*xb(ii,j))* & - 1.e6_r8/bmod(ii,j)**2 - vi(k,i,j) = (eez(k,i)*yb(ii,j)+eex(k,i)*zb(ii,j))* & - 1.e6_r8/bmod(ii,j)**2 - wi(k,i,j) = (eex(k,i)*xb(ii,j)-eey(k,i)*yb(ii,j))* & - 1.e6_r8/bmod(ii,j)**2 - enddo ! i=lon0,lon1 - enddo ! k=lev0,lev1 - - if (debug.and.masterproc) then - write(iulog,"('ionvel: j=',i4,' ui=',2e12.4,' vi=',2e12.4,' wi=',2e12.4)") & - j,minval(ui),maxval(ui),minval(vi),maxval(vi),minval(wi),maxval(wi) - endif + do i=lon0,lon1 + do k=lev0,lev1 + ui(k,i,j) = -(eey(k,i,j)*zb(i,j)+eez(k,i,j)*xb(i,j))*1.e6_r8/(bmod(i,j)**2) + vi(k,i,j) = (eez(k,i,j)*yb(i,j)+eex(k,i,j)*zb(i,j))*1.e6_r8/(bmod(i,j)**2) + wi(k,i,j) = (eex(k,i,j)*xb(i,j)-eey(k,i,j)*yb(i,j))*1.e6_r8/(bmod(i,j)**2) + enddo + enddo ! ! Output ion drifts in cm/s for oplus_xport call from dpie_coupling: - do i=lon0,lon1 - ui(:,i,j) = ui(:,i,j)*100._r8 - vi(:,i,j) = vi(:,i,j)*100._r8 - wi(:,i,j) = wi(:,i,j)*100._r8 - enddo - enddo ! j=lat0,lat1 - - if (debug.and.masterproc) then - write(iulog,"('ionvel: ion drifts on geo grid: ui=',2e12.4,' vi=',2e12.4,' wi=',2e12.4)") & - minval(ui),maxval(ui), minval(vi),maxval(vi), minval(wi),maxval(wi) - endif + do i=lon0,lon1 + ui(:,i,j) = ui(:,i,j)*100._r8 + vi(:,i,j) = vi(:,i,j)*100._r8 + wi(:,i,j) = wi(:,i,j)*100._r8 + enddo + enddo ! j=lat0,lat1 - if (hist_fld_active('RJAC11')) then - do i=1,nlev - rjac_out(i,lon0:lon1,lat0:lat1) = rjac(lon0:lon1,lat0:lat1,1,1) - end do - call savefld_waccm_switch(rjac_out,'RJAC11',nlev,lon0,lon1,lat0,lat1) - endif - - if (hist_fld_active('RJAC12')) then - do i=1,nlev - rjac_out(i,lon0:lon1,lat0:lat1) = rjac(lon0:lon1,lat0:lat1,1,2) - end do - call savefld_waccm_switch(rjac_out,'RJAC12',nlev,lon0,lon1,lat0,lat1) - endif + call savefld_waccm(eex*100._r8,'EX',nlev,lon0,lon1,lat0,lat1) ! V/m + call savefld_waccm(eey*100._r8,'EY',nlev,lon0,lon1,lat0,lat1) + call savefld_waccm(eez*100._r8,'EZ',nlev,lon0,lon1,lat0,lat1) - if (hist_fld_active('RJAC21')) then - do i=1,nlev - rjac_out(i,lon0:lon1,lat0:lat1) = rjac(lon0:lon1,lat0:lat1,2,1) - end do - call savefld_waccm_switch(rjac_out,'RJAC21',nlev,lon0,lon1,lat0,lat1) + if (debug.and.masterproc) then + write(iulog,"('ionvel: ion drifts on geo grid: ui=',2e12.4,' vi=',2e12.4,' wi=',2e12.4)") & + minval(ui),maxval(ui), minval(vi),maxval(vi), minval(wi),maxval(wi) endif - if (hist_fld_active('RJAC22')) then - do i=1,nlev - rjac_out(i,lon0:lon1,lat0:lat1) = rjac(lon0:lon1,lat0:lat1,2,2) - end do - call savefld_waccm_switch(rjac_out,'RJAC22',nlev,lon0,lon1,lat0,lat1) + if (debug_hist) then + if (hist_fld_active('RJAC11')) then + do i=1,nlev + rjac_out(i,lon0:lon1,lat0:lat1) = rjac(lon0:lon1,lat0:lat1,1,1) + end do + call savefld_waccm(rjac_out,'RJAC11',nlev,lon0,lon1,lat0,lat1) + endif + + if (hist_fld_active('RJAC12')) then + do i=1,nlev + rjac_out(i,lon0:lon1,lat0:lat1) = rjac(lon0:lon1,lat0:lat1,1,2) + end do + call savefld_waccm(rjac_out,'RJAC12',nlev,lon0,lon1,lat0,lat1) + endif + + if (hist_fld_active('RJAC21')) then + do i=1,nlev + rjac_out(i,lon0:lon1,lat0:lat1) = rjac(lon0:lon1,lat0:lat1,2,1) + end do + call savefld_waccm(rjac_out,'RJAC21',nlev,lon0,lon1,lat0,lat1) + endif + + if (hist_fld_active('RJAC22')) then + do i=1,nlev + rjac_out(i,lon0:lon1,lat0:lat1) = rjac(lon0:lon1,lat0:lat1,2,2) + end do + call savefld_waccm(rjac_out,'RJAC22',nlev,lon0,lon1,lat0,lat1) + endif endif end subroutine ionvel -!----------------------------------------------------------------------- - subroutine mag2geo_3d(fmag,fgeo,ESMF_mag,ESMF_geo,fname) -! -! Convert field on geomagnetic grid fmag to geographic grid in fgeo. -! - use edyn_esmf,only: edyn_esmf_set3d_mag,edyn_esmf_regrid,edyn_esmf_get_3dfield - use edyn_geogrid,only: nlev -! -! Args: -! integer,intent(in) :: mlon0,mlon1,mlat0,mlat1,nmlev,lon0,lon1,lat0,lat1,nlev - character(len=*) :: fname - type(ESMF_Field),intent(inout) :: ESMF_mag, ESMF_geo - real(r8),intent(in) :: fmag(mlon0:mlon1,mlat0:mlat1,nmlev) - real(r8),intent(out) :: fgeo(lon0:lon1,lat0:lat1,nlev) -! -! Local: - integer :: j - character(len=8) :: fnames(1) - type(ESMF_Field) :: magfields(1) - real(r8),pointer,dimension(:,:,:) :: fptr - - fgeo = finit - fnames(1) = fname - magfields(1) = ESMF_mag -! -! Put fmag into ESMF mag field on mag source grid: - call edyn_esmf_set3d_mag(magfields,fnames,fmag,1,1,nmlev,mlon0,mlon1,mlat0,mlat1) -! -! Regrid to geographic destination grid, defining ESMF_geo: - call edyn_esmf_regrid(ESMF_mag,ESMF_geo,'mag2geo',3) -! -! Put regridded geo field into pointer: - call edyn_esmf_get_3dfield(ESMF_geo,fptr,fname) -! -! Transfer from pointer to output arg: - do j=lat0,lat1 - fgeo(:,j,:) = fptr(:,j,:) - enddo - end subroutine mag2geo_3d -#endif !----------------------------------------------------------------------- end module edynamo diff --git a/src/ionosphere/waccmx/getapex.F90 b/src/ionosphere/waccmx/getapex.F90 index a67a7463a0..9b09c6ff08 100644 --- a/src/ionosphere/waccmx/getapex.F90 +++ b/src/ionosphere/waccmx/getapex.F90 @@ -1,61 +1,50 @@ module getapex ! -! Calculate quantities needed to transform scalar fields between geographic -! and geomagnetic coordinate systems. -! - use shr_kind_mod ,only : r8 => shr_kind_r8 - use cam_logfile ,only: iulog - use cam_abortutils ,only: endrun - use edyn_geogrid ,only: nlon,nlonp1,ylatg,ylong,dlong,& - jspole,jnpole - use edyn_maggrid ,only: nmlon,nmlonp1,nmlat,ylatm,ylonm,dlonm - - implicit none - save +! Calculate quantities needed to transform scalar fields between geographic +! and geomagnetic coordinate systems. +! + use shr_kind_mod, only : r8 => shr_kind_r8 + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use edyn_geogrid, only: nlon,nlonp1,jspole,jnpole + use edyn_maggrid, only: nmlonp1,nmlat,ylatm,ylonm + use infnan, only: nan, assignment(=) - private + implicit none + save - public :: get_apex - public :: magfield, bx, by, bz, bmod2, bmod, xb, yb, zb, be3arr, dddarr, dvec - public :: alatm, alonm, gdlondeg, gdlatdeg - public :: rjac + private - integer :: & - ig(nmlonp1,nmlat), & ! geog lon grid containing each geomag point - jg(nmlonp1,nmlat) ! geog lat grid containing each geomag point + public :: get_apex ! Allocate and initialize apex data + public :: magfield, bx, by, bz + public :: bmod2, bmod + public :: xb, yb, zb + public :: be3arr, dddarr, dvec + public :: alatm, alonm + public :: gdlatdeg, gdlondeg + public :: rjac - real(r8) :: & - wt(4,nmlonp1,nmlat) ! interpolation weights for geo2mag - - real(r8),dimension(nmlonp1,nmlat) :: & ! geo lat,lon coords on mag grid - gdlatdeg, & ! geographic latitude of each magnetic grid point (deg) - gdlondeg ! geographic longitude of each magnetic grid point (deg) + real(r8),dimension(:,:), allocatable :: & ! geo lat,lon coords on mag grid + gdlatdeg, & ! geographic latitude of each magnetic grid point (deg) + gdlondeg ! geographic longitude of each magnetic grid point (deg) ! ! Variables on geographic grid needed by other modules must ! be allocated dynamically to be grid-independent (sub alloc_apex): ! - integer,allocatable :: & ! (nlonp1,jspole:jnpole)) - im(:,:), & ! geomag lon grid containing each geog point - jm(:,:) ! geomag lat grid containing each geog point - - real(r8),allocatable :: & ! (nlonp1,jspole:jnpole) - dim(:,:), & ! fraction in lon for grid interp - djm(:,:) ! fraction in lat for grid interp - - real(r8),allocatable :: & ! (nlonp1,jspole:jnpole,3,2) - dvec(:,:,:,:) ! vectors from apxmall + real(r8),allocatable :: & ! (nlonp1,jspole:jnpole,3,2) + dvec(:,:,:,:) ! vectors from apxmall - real(r8),allocatable :: & ! (nlonp1,jspole:jnpole) - dddarr(:,:), & ! from apxmall - be3arr(:,:) ! from apxmall + real(r8),allocatable :: & ! (nlonp1,jspole:jnpole) + dddarr(:,:), & ! from apxmall + be3arr(:,:) ! from apxmall - real(r8),allocatable :: & ! (nlonp1,jspole:jnpole) - alatm(:,:), & ! geomagnetic latitude at each geographic grid point (radians) - alonm(:,:), & ! geomagnetic longitude at each geographic grid point (radians) - xb(:,:), & ! northward component of magnetic field - yb(:,:), & ! eastward component of magnetic field - zb(:,:), & ! downward component of magnetic field (gauss) - bmod(:,:) ! magnitude of magnetic field (gauss) + real(r8),allocatable :: & ! (nlonp1,jspole:jnpole) + alatm(:,:), & ! geomagnetic latitude at each geographic grid point (radians) + alonm(:,:), & ! geomagnetic longitude at each geographic grid point (radians) + xb(:,:), & ! northward component of magnetic field + yb(:,:), & ! eastward component of magnetic field + zb(:,:), & ! downward component of magnetic field (gauss) + bmod(:,:) ! magnitude of magnetic field (gauss) ! ! rjac: scaled derivatives of geomagnetic coords wrt geographic coordinates. ! rjac(1,1) = cos(thetas)/cos(theta)*d(lamdas)/d(lamda) @@ -65,169 +54,128 @@ module getapex ! where (lamda,theta) are geographic coordinates ! (lamdas,thetas) are geomagnetic coordinates ! - real(r8),allocatable :: & - rjac(:,:,:,:) ! (nlon+1,jspole:jnpole,2,2) + real(r8),allocatable :: & + rjac(:,:,:,:) ! (nlon+1,jspole:jnpole,2,2) ! ! Parameters defined by sub magfield (allocated in alloc_magfield): ! - real(r8),allocatable,dimension(:,:) :: & ! (0:nlon+1,jspole-1:jnpole+1) - bx,by,bz,bmod2 + real(r8),allocatable,dimension(:,:) :: & ! (0:nlon+1,jspole-1:jnpole+1) + bx,by,bz,bmod2 - contains +contains !----------------------------------------------------------------------- - subroutine get_apex( ) -! -! This is called once per run from main. -! - use edyn_params,only: re_dyn,h0,hs,dtr,rtd - use apex, only: apex_mall,apex_q2g - use edyn_geogrid,only: glat_edyn_geo => glat, glon_edyn_geo => glon - -! -! Local: - integer :: i,j,ier,jjm,jjg - integer,parameter :: nalt=2 - real(r8) :: real8 + subroutine get_apex( ) + ! + ! This is called once per run from main. + ! + use edyn_params, only: re_dyn, h0, hs, dtr, rtd, cm2km + use apex, only: apex_mall, apex_q2g + use edyn_geogrid, only: glat_edyn_geo=>glat, glon_edyn_geo=>glon - real(r8) :: rekm,h0km,alt,hr,ror03,glat,glon,& - xlonmi,qdlon,qdlat,gdlon,gdlat,xlongi,frki,frkj + ! + ! Local: + integer :: i, j, ier + real(r8) :: rekm, h0km, alt, hr, ror03, glat, glon + real(r8) :: qdlon, qdlat, gdlon, gdlat + integer, parameter :: nalt=2 -! -! Non-scalar arguments returned by apxmall: - real(r8) :: & - b(3),bhat(3), & - d1(3),d2(3),d3(3), & - e1(3),e2(3),e3(3), & - f1(2),f2(2) - real(r8) :: bmag,alon,xlatm,vmp,w,d,be3,si,sim,xlatqd,f + ! + ! Non-scalar arguments returned by apxmall: + real(r8) :: & + b(3), bhat(3), & + d1(3), d2(3),d3(3), & + e1(3), e2(3),e3(3), & + f1(2), f2(2) + real(r8) :: bmag, alon, xlatm, vmp, w, d, be3, si, sim, xlatqd, f -! -! Allocate arrays that are needed by other modules: - call alloc_apex - call alloc_magfield + ! + ! Allocate arrays that are needed by other modules: + call alloc_apex + call alloc_magfield - rekm = re_dyn*1.e-5_r8 ! earth radius (km) - h0km = h0*1.e-5_r8 - alt = hs*1.e-5_r8 ! modified apex reference altitude (km) - hr = alt - ror03= ((rekm + alt)/(rekm + h0km))**3 -! -! Loop over 2d geographic grid: -! - do j=jspole,jnpole - glat = glat_edyn_geo(j) - do i=1,nlonp1 - if (i.eq.nlonp1) then - glon = glon_edyn_geo(1) - else - glon = glon_edyn_geo(i) - endif + dddarr = nan + dvec = nan + rekm = re_dyn*cm2km ! earth radius (km) + h0km = h0*cm2km + alt = hs*cm2km ! modified apex reference altitude (km) + hr = alt + ror03= ((rekm + alt)/(rekm + h0km))**3 + ! + ! Loop over 2d geographic grid: + ! + do j = jspole, jnpole + glat = glat_edyn_geo(j) + do i = 1, nlonp1 + if (i == nlonp1) then + glon = glon_edyn_geo(1) + else + glon = glon_edyn_geo(i) + end if - call apex_mall ( & - glat,glon,alt,hr, & !Inputs - b,bhat,bmag,si, & !Mag Fld - alon, & !Apx Lon - xlatm,vmp,w,d,be3,sim,d1,d2,d3,e1,e2,e3, & !Mod Apx - xlatqd,f,f1,f2 , ier) !Qsi-Dpl + call apex_mall ( & + glat,glon,alt,hr, & !Inputs + b,bhat,bmag,si, & !Mag Fld + alon, & !Apx Lon + xlatm,vmp,w,d,be3,sim,d1,d2,d3,e1,e2,e3, & !Mod Apx + xlatqd,f,f1,f2, ier) !Qsi-Dpl - if (ier /= 0) call endrun('get_apex: apxmall error') + if (ier /= 0) then + call endrun('get_apex: apxmall error') + end if - alatm(i,j) = xlatm*dtr - alonm(i,j) = alon *dtr - xb (i,j) = b(2)*1.e-5_r8 ! nT -> gauss - yb (i,j) = b(1)*1.e-5_r8 ! nT -> gauss - zb (i,j) = -b(3)*1.e-5_r8 ! nT -> gauss - bmod (i,j) = bmag*1.e-5_r8 ! nT -> gauss + alatm(i,j) = xlatm*dtr + alonm(i,j) = alon *dtr + xb (i,j) = b(2)*1.e-5_r8 ! nT -> gauss + yb (i,j) = b(1)*1.e-5_r8 ! nT -> gauss + zb (i,j) = -b(3)*1.e-5_r8 ! nT -> gauss + bmod (i,j) = bmag*1.e-5_r8 ! nT -> gauss - rjac (i,j,1,1) = f2(2) - rjac (i,j,1,2) = -f2(1) - rjac (i,j,2,1) = -f1(2) - rjac (i,j,2,2) = f1(1) -! -! Set up parameters for magnetic to geographic interpolation. -! - xlonmi = (alonm(i,j) - ylonm(1))/dlonm - real8 = dble(nmlon) - if (xlonmi < 0._r8) xlonmi = xlonmi + real8 - im(i,j) = xlonmi - real8 = dble(im(i,j)) - dim(i,j) = xlonmi - real8 - im(i,j) = im(i,j) + 1 - if (im(i,j) >= nmlonp1) im(i,j) = im(i,j) - nmlon - alatm(i,j) = min(alatm(i,j),ylatm(nmlat)) - do jjm=2,nmlat - if (alatm(i,j) > ylatm(jjm)) cycle - jm(i,j) = jjm - 1 - djm(i,j) = (alatm(i,j) - ylatm(jm(i,j)))/ & - (ylatm(jjm) - ylatm(jm(i,j))) - exit - enddo - if (j /= jspole .and. j /= jnpole) then - dvec(i,j,1,1) = d1(1) - dvec(i,j,2,1) = d1(2) - dvec(i,j,3,1) = d1(3) - dvec(i,j,1,2) = d2(1) - dvec(i,j,2,2) = d2(2) - dvec(i,j,3,2) = d2(3) - dddarr(i,j) = d -! -! Scale be3 from 130 km to a reference height of 90 km. - be3arr(i,j) = be3*ror03 - endif - enddo ! i=1,nlonp1 - enddo ! j=jspole,jnpole -! -! Set up parameters for geographic to magnetic interpolation - do i=1,nmlonp1 - qdlon = ylonm(i)*rtd - do j=1,nmlat - qdlat = ylatm(j)*rtd -! -! Convert from Quasi-Dipole to geographic coordinates. -! gdlat,gdlon are returned by apxq2g. -! - call apex_q2g(qdlat,qdlon,alt,gdlat,gdlon,ier) - if (ier /= 0) then - write(iulog,"(i3,i3,i3)") '>>> Error from apex_q2g: ier=',ier, & - ' i=',i,' j=',j - call endrun('get_apex: apex_q2g ier') - endif - gdlat = gdlat*dtr - gdlon = gdlon*dtr - xlongi = (gdlon - ylong(1))/dlong - real8 = dble(nlon) - if (xlongi < 0._r8) xlongi = xlongi + real8 - ig(i,j) = xlongi - real8 = dble(ig(i,j)) - frki = xlongi - real8 - ig(i,j) = ig(i,j) + 1 - if (ig(i,j) >= nlonp1) ig(i,j) = ig(i,j) - nlon - gdlat = min(gdlat,ylatg(jnpole)) - do jjg=1,jnpole - if (gdlat > ylatg(jjg)) cycle - jg(i,j) = jjg - 1 - frkj = (gdlat - ylatg(jg(i,j)))/(ylatg(jjg) - ylatg(jg(i,j))) -! -! 99/2/25b Add one to JG to account for the fact that AG in geo2mag has -! a second (J) index starting at 1, while the second index of the -! array in the calling arguments begins at 0. -! - jg(i,j) = jg(i,j) + 1 - exit - enddo - wt(1,i,j) = (1._r8 - frki)*(1._r8 - frkj) - wt(2,i,j) = frki *(1._r8 - frkj) - wt(3,i,j) = frki *frkj - wt(4,i,j) = (1._r8 - frki)*frkj -! -! gdlatdeg,gdlondeg will be coordY,coordX of the mag grid for ESMF -! regridding (see edyn_esmf.F) -! - gdlatdeg(i,j) = gdlat*rtd - gdlondeg(i,j) = gdlon*rtd - enddo ! j=1,nmlat - enddo ! i=1,nmlonp1 - end subroutine get_apex + rjac (i,j,1,1) = f2(2) + rjac (i,j,1,2) = -f2(1) + rjac (i,j,2,1) = -f1(2) + rjac (i,j,2,2) = f1(1) + ! + ! Set up parameters for magnetic to geographic interpolation. + ! + dvec(i,j,1,1) = d1(1) + dvec(i,j,2,1) = d1(2) + dvec(i,j,3,1) = d1(3) + dvec(i,j,1,2) = d2(1) + dvec(i,j,2,2) = d2(2) + dvec(i,j,3,2) = d2(3) + dddarr(i,j) = d + ! + ! Scale be3 from 130 km to a reference height of 90 km. + be3arr(i,j) = be3 * ror03 + end do ! i=1,nlonp1 + end do ! j=jspole,jnpole + ! + ! Set up parameters for geographic to magnetic interpolation + do i = 1, nmlonp1 + qdlon = ylonm(i)*rtd + do j = 1, nmlat + qdlat = ylatm(j)*rtd + ! + ! Convert from Quasi-Dipole to geographic coordinates. + ! gdlat,gdlon are returned by apxq2g. + ! + call apex_q2g(qdlat, qdlon, alt, gdlat, gdlon, ier) + if (ier /= 0) then + write(iulog,"(i3,i3,i3)") '>>> Error from apex_q2g: ier=',ier, & + ' i=',i,' j=',j + call endrun('get_apex: apex_q2g ier') + end if + gdlat = gdlat * dtr + gdlon = gdlon * dtr + ! + ! gdlatdeg,gdlondeg will be coordY,coordX of the mag grid for ESMF + ! regridding (see edyn_esmf.F) + ! + gdlatdeg(i,j) = gdlat*rtd + gdlondeg(i,j) = gdlon*rtd + enddo ! j=1,nmlat + enddo ! i=1,nmlonp1 + end subroutine get_apex !----------------------------------------------------------------------- subroutine magfield ! @@ -312,16 +260,12 @@ subroutine alloc_magfield end subroutine alloc_magfield !----------------------------------------------------------------------- - + subroutine alloc_apex !------------------------------------------------------------------------------------------ ! Do allocations, checking if previously allocated in case of year boundary crossing !------------------------------------------------------------------------------------------ - if (.not.allocated(im)) allocate(im (nlonp1,jspole:jnpole)) - if (.not.allocated(jm)) allocate(jm (nlonp1,jspole:jnpole)) - if (.not.allocated(dim)) allocate(dim(nlonp1,jspole:jnpole)) - if (.not.allocated(djm)) allocate(djm(nlonp1,jspole:jnpole)) if (.not.allocated(xb)) allocate(xb (nlonp1,jspole:jnpole)) if (.not.allocated(yb)) allocate(yb (nlonp1,jspole:jnpole)) @@ -336,6 +280,9 @@ subroutine alloc_apex if (.not.allocated(rjac)) allocate(rjac(nlon+1,jspole:jnpole,2,2)) + if (.not.allocated(gdlatdeg)) allocate(gdlatdeg(nmlonp1,nmlat)) + if (.not.allocated(gdlondeg)) allocate(gdlondeg(nmlonp1,nmlat)) + end subroutine alloc_apex !----------------------------------------------------------------------- end module getapex diff --git a/src/ionosphere/waccmx/heelis.F90 b/src/ionosphere/waccmx/heelis.F90 index 7b07177865..50f397ec6e 100644 --- a/src/ionosphere/waccmx/heelis.F90 +++ b/src/ionosphere/waccmx/heelis.F90 @@ -1,7 +1,6 @@ module heelis use shr_kind_mod ,only: r8 => shr_kind_r8 ! 8-byte reals use edyn_maggrid ,only: nmlon,nmlonp1,nmlat,ylonm,ylatm - use edyn_geogrid ,only: nlat use heelis_mod ,only: heelis_update, heelis_flwv32 ! ! phihm and pfrac are output of this module: @@ -20,13 +19,13 @@ module heelis contains !----------------------------------------------------------------------- - subroutine heelis_model(sunlons) + subroutine heelis_model(sunlon) use aurora_params, only: aurora_params_set ! Driver for Heelis empirical model to calculate high-latitude potential. ! ! Args: - real(r8),intent(in) :: sunlons(nlat) ! sun's location + real(r8),intent(in) :: sunlon ! sun's location ! ! Set auroral parameters: @@ -38,18 +37,18 @@ subroutine heelis_model(sunlons) ! Calculate the heelis potential phihm in geomagnetic coordinates: ! (potm calls sub flwv32) ! - call potm(sunlons) + call potm(sunlon) end subroutine heelis_model !----------------------------------------------------------------------- - subroutine potm(sunlons) + subroutine potm(sunlon) use edyn_params, only: pi_dyn ! pi used in dynamo calculations ! ! Calculate heelis potential in geomagnetic coordinates. ! ! Args: - real(r8),intent(in) :: sunlons(nlat) + real(r8),intent(in) :: sunlon ! ! Local: integer :: j @@ -60,7 +59,7 @@ subroutine potm(sunlons) do j=1,nmlat iflag(:) = 1 ! must be updated at each j dlat(:) = ylatm(j) - dlon(:) = ylonm(1:nmlon)-sunlons(1) + dlon(:) = ylonm(1:nmlon)-sunlon ! ! flwv32 returns single-level Heelis potential in geomag coords: ! diff --git a/src/ionosphere/waccmx/ionosphere_interface.F90 b/src/ionosphere/waccmx/ionosphere_interface.F90 index f6b3463e28..fa5752f024 100644 --- a/src/ionosphere/waccmx/ionosphere_interface.F90 +++ b/src/ionosphere/waccmx/ionosphere_interface.F90 @@ -1,1258 +1,1187 @@ module ionosphere_interface - use shr_kind_mod, only: r8 => shr_kind_r8 - use phys_grid, only: begchunk, endchunk, get_ncols_p - use pmgrid, only: plat, plon, plev - use ppgrid, only: pcols, pver - - 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 - use mo_chem_utls, only: get_spc_ndx ! Routine to get index of adv_mass array for short lived species - use physics_buffer, only: pbuf_get_chunk, pbuf_get_field, pbuf_get_index - - use cam_abortutils, only: endrun - use constituents, only: cnst_get_ind, cnst_mw !Needed to access constituent molecular weights - use phys_grid, only: get_lon_all_p, get_lat_all_p, transpose_block_to_chunk, transpose_chunk_to_block - use phys_grid, only: chunk_to_block_send_pters, chunk_to_block_recv_pters, block_to_chunk_send_pters, & - block_to_chunk_recv_pters - use physconst, only: gravit - use oplus, only: oplus_init - use edyn_init, only: edynamo_init - use pio, only: var_desc_t - use spmd_dyn, only: local_dp_map, block_buf_nrecs, chunk_buf_nrecs - use dyn_internal_state, only: get_dyn_state_grid - use dynamics_vars, only: t_fvdycore_grid - use perf_mod - use epotential_params, only: epot_active, epot_crit_colats - implicit none - - private - - public :: ionosphere_readnl - public :: ionosphere_init - public :: ionosphere_run1 - public :: ionosphere_run2 - public :: ionosphere_init_restart - public :: ionosphere_write_restart - public :: ionosphere_read_restart - public :: ionosphere_final - - ! private data - - ! this needs to persist from time-step to time-step and across restarts - real(r8), allocatable :: opmmrtm1_blck(:,:,:) ! O+ at previous time step(blocks) - - type(var_desc_t) :: Optm1_vdesc - integer :: index_ped, index_hall, index_te, index_ti - integer :: index_ui, index_vi, index_wi - - integer :: ixo2=-1, ixo=-1, ixh=-1 - integer :: ixo2p=-1, ixnop=-1, ixn2p=-1, ixop=-1 - - ! indices for accessing ions in pbuf when non-advected - integer :: sIndxOp=-1, sIndxO2p=-1, sIndxNOp=-1, sIndxN2p=-1 - - real(r8) :: rmassO2 ! O2 molecular weight kg/kmol - real(r8) :: rmassO1 ! O atomic weight kg/kmol - real(r8) :: rmassH ! H atomic weight kg/kmol - real(r8) :: rmassN2 ! N2 molecular weight kg/kmol - real(r8) :: rmassO2p ! O2+ molecular weight kg/kmol - real(r8) :: rmassNOp ! NO+ molecular weight kg/kmol - real(r8) :: rmassN2p ! N2+ molecular weight kg/kmol - real(r8) :: rmassOp ! O+ molecular weight kg/kmol - - logical, public, protected :: ionos_edyn_active = .true. ! if true, edynamo will generate ion drifts - logical, public, protected :: ionos_xport_active = .true. ! if true, call d_pie_coupling from dp_coupling - ! - ! ionos_edyn_active = .true. will activate the edynamo which will generate ion drift velocities - ! used in oplus transport, otherwise empirical ion drifts calculated in exbdrift (physics) will be used. - ! - logical, public, protected :: ionos_oplus_xport = .true. ! if true, call sub oplus (based on tiegcm oplus.F) - integer, public, protected :: ionos_xport_nsplit = 5 ! number of substeps for O+ transport per model time step - - real(r8), public, protected :: oplus_adiff_limiter = 1.5e+8_r8 ! limiter for ambipolar diffusion coefficient - real(r8), public, protected :: oplus_shapiro_const = 0.03_r8 ! shapiro constant for spatial smoother - logical, public, protected :: oplus_enforce_floor = .true. ! switch to apply Stan's floor - logical, public, protected :: oplus_ring_polar_filter = .false. ! switch to apply ring polar filter - - character(len=256) :: wei05_coefs_file = 'NONE' !'wei05sc.nc' - character(len=256) :: amienh_file = 'NONE' - character(len=256) :: amiesh_file = 'NONE' - - character(len=16), public, protected :: ionos_epotential_model = 'none' - logical, public, protected :: ionos_epotential_amie = .false. - integer :: indxAMIEefxg=-1, indxAMIEkevg=-1 - -contains - - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - subroutine ionosphere_readnl( nlfile ) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: mpicom, masterprocid, mpi_real8, mpi_logical, mpi_integer, mpi_character - use cam_logfile, only: iulog - use spmd_utils, only: masterproc - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'ionosphere_readnl' - - namelist /ionosphere_nl/ ionos_xport_active, ionos_edyn_active, ionos_oplus_xport, ionos_xport_nsplit - namelist /ionosphere_nl/ oplus_adiff_limiter, oplus_shapiro_const, oplus_enforce_floor, oplus_ring_polar_filter - namelist /ionosphere_nl/ ionos_epotential_model, ionos_epotential_amie, wei05_coefs_file - namelist /ionosphere_nl/ amienh_file, amiesh_file, wei05_coefs_file - namelist /ionosphere_nl/ epot_crit_colats - - ! Read namelist - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'ionosphere_nl', status=ierr) - if (ierr == 0) then - read(unitn, ionosphere_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - - ! Broadcast namelist variables - call mpi_bcast(ionos_xport_active, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(ionos_edyn_active, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(ionos_oplus_xport, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(ionos_xport_nsplit, 1, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(oplus_adiff_limiter, 1, mpi_real8, masterprocid, mpicom, ierr) - call mpi_bcast(ionos_epotential_model, len(ionos_epotential_model), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(ionos_epotential_amie,1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(wei05_coefs_file, len(wei05_coefs_file), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(amienh_file, len(amienh_file), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(amiesh_file, len(amiesh_file), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(oplus_shapiro_const, 1, mpi_real8, masterprocid, mpicom, ierr) - call mpi_bcast(oplus_enforce_floor, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(oplus_ring_polar_filter,1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(epot_crit_colats, 2, mpi_real8, masterprocid, mpicom, ierr) - - ! log the user settings - if (masterproc) then - write(iulog,*) 'ionosphere_readnl: ionos_xport_active = ', ionos_xport_active - write(iulog,*) 'ionosphere_readnl: ionos_edyn_active = ', ionos_edyn_active - write(iulog,*) 'ionosphere_readnl: ionos_oplus_xport = ', ionos_oplus_xport - write(iulog,*) 'ionosphere_readnl: ionos_xport_nsplit = ', ionos_xport_nsplit - write(iulog,*) 'ionosphere_readnl: ionos_epotential_model = ', trim(ionos_epotential_model) - write(iulog,*) 'ionosphere_readnl: ionos_epotential_amie = ', ionos_epotential_amie - write(iulog,'(a,2(g12.4))') & - ' ionosphere_readnl: epot_crit_colats = ', epot_crit_colats - write(iulog,*) 'ionosphere_readnl: oplus_adiff_limiter = ', oplus_adiff_limiter - write(iulog,*) 'ionosphere_readnl: oplus_shapiro_const = ', oplus_shapiro_const - write(iulog,*) 'ionosphere_readnl: oplus_enforce_floor = ', oplus_enforce_floor - write(iulog,*) 'ionosphere_readnl: oplus_ring_polar_filter= ', oplus_ring_polar_filter - endif - epot_active = .true. - - end subroutine ionosphere_readnl - - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - subroutine ionosphere_init() - use physics_buffer, only: pbuf_add_field, dtype_r8 - use cam_history, only: addfld, add_default, horiz_only - use mo_apex, only: mo_apex_init1 - use cam_control_mod,only: initial_run - use dyn_grid, only: get_horiz_grid_d - use ref_pres, only : & ! Hybrid level definitions: - pref_mid, & ! target alev(plev) midpoint levels coord - pref_edge ! target ailev(plevp) interface levels coord - use amie_module, only: init_amie - use wei05sc, only: weimer05_init - - ! local variables: - type (t_fvdycore_grid), pointer :: grid - integer :: sIndx - - integer :: mpicomm ! MPI communicator - integer :: ntaski, ntaskj ! number of MPI tasks in lon,lat dimensions - integer :: lat0,lat1 ! first and last latitude indices - integer :: lon0,lon1 ! first and last longitude indices - integer :: lev0,lev1 ! first and last pressure indices - real(r8), allocatable :: glon(:) ! global geo-graphic longitudes (degrees) - real(r8), allocatable :: glat(:) ! global geo-graphic latitudes (degrees) - - if ( ionos_epotential_amie ) then - call pbuf_add_field('AMIE_efxg', 'global', dtype_r8, (/pcols/), indxAMIEefxg) ! Energy flux from AMIE - call pbuf_add_field('AMIE_kevg', 'global', dtype_r8, (/pcols/), indxAMIEkevg) ! Mean energy from AMIE - endif - if (initial_run) then - call ionosphere_read_ic() - endif - - call mo_apex_init1() - - op_transport: if (ionos_xport_active) then - - grid => get_dyn_state_grid() - - index_ped = pbuf_get_index('PedConduct') - index_hall = pbuf_get_index('HallConduct') - - index_te = pbuf_get_index('TElec') - index_ti = pbuf_get_index('TIon') - ! - ! pbuf indices to empirical ion drifts, to be passed to oplus_xport, - ! if ionos_edyn_active is false. - ! - index_ui = pbuf_get_index('UI') - index_vi = pbuf_get_index('VI') - index_wi = pbuf_get_index('WI') - - !----------------------------------------------------------------------- - ! Get indices for neutrals to get mixing ratios from state%q and masses - !----------------------------------------------------------------------- - call cnst_get_ind('O2' ,ixo2 ) - call cnst_get_ind('O' ,ixo ) - call cnst_get_ind('H' ,ixh ) - !------------------------------------ - ! Get neutral molecular weights - !------------------------------------ - rmassO2 = cnst_mw(ixo2) - rmassO1 = cnst_mw(ixo) - rmassH = cnst_mw(ixh) - rmassN2 = 28._r8 - - call cnst_get_ind('Op',ixop, abort=.false.) - if (ixop > 0) then - rMassOp = cnst_mw(ixop) - else - sIndxOp = slvd_index( 'Op' ) - if (sIndxOp > 0) then - sIndx = get_spc_ndx( 'Op' ) - rmassOp = adv_mass(sIndx) - else - call endrun('ionosphere_init: Cannot find state or pbuf index for Op') - endif - endif - - call cnst_get_ind('O2p',ixo2p, abort=.false.) - if (ixo2p > 0) then - rMassO2p = cnst_mw(ixo2p) - else - sIndxO2p = slvd_index( 'O2p' ) - if (sIndxO2p > 0) then - sIndx = get_spc_ndx( 'O2p' ) - rmassO2p = adv_mass(sIndx) - else - call endrun('ionosphere_init: Cannot find state or pbuf index for O2p') - endif - endif - - call cnst_get_ind('NOp',ixnop, abort=.false.) - if (ixnop > 0) then - rMassNOp = cnst_mw(ixnop) - else - sIndxNOp = slvd_index( 'NOp' ) - if (sIndxNOp > 0) then - sIndx = get_spc_ndx( 'NOp' ) - rmassNOp = adv_mass(sIndx) - else - call endrun('ionosphere_init: Cannot find state or pbuf index for NOp') - endif - endif - - call cnst_get_ind('N2p',ixn2p, abort=.false.) - if (ixn2p > 0) then - rMassN2p = cnst_mw(ixn2p) - else - sIndxN2p = slvd_index( 'N2p' ) - if (sIndxN2p > 0) then - sIndx = get_spc_ndx( 'N2p' ) - rmassN2p = adv_mass(sIndx) - else - call endrun('ionosphere_init: Cannot find state or pbuf index for N2p') - endif - endif - - call d_pie_init( ionos_edyn_active, ionos_oplus_xport, ionos_xport_nsplit, epot_crit_colats ) - - if ( grid%iam < grid%npes_xy ) then - - allocate(glon(plon)) - allocate(glat(plat)) - call get_horiz_grid_d( plon, lon_d_out=glon ) - call get_horiz_grid_d( plat, lat_d_out=glat ) - - mpicomm = grid%commxy - lon0 = grid%ifirstxy ; lon1 = grid%ilastxy - lat0 = grid%jfirstxy ; lat1 = grid%jlastxy - lev0 = 1 ; lev1 = grid%km - ntaski = grid%nprxy_x - ntaskj = grid%nprxy_y - - call edynamo_init( mpicomm, plon, plat, plev, lon0,lon1,lat0,lat1,lev0,lev1, ntaski,ntaskj, & - glon, glat, pref_mid,pref_edge ) - call ionosphere_alloc() - call oplus_init( oplus_adiff_limiter, oplus_shapiro_const, oplus_enforce_floor, oplus_ring_polar_filter ) - - deallocate(glon,glat) - endif - - call addfld ('OpTM1&IC', (/ 'lev' /),'I','kg/kg','O+ at time step minus 1',gridname='fv_centers') - call add_default ('OpTM1&IC',0, 'I') - - endif op_transport - - if (ionos_edyn_active) then - call addfld ('UI',(/ 'lev' /),'I','m/s', 'UI Zonal ion drift from edynamo') - call addfld ('VI',(/ 'lev' /),'I','m/s', 'VI Meridional ion drift from edynamo') - call addfld ('WI',(/ 'lev' /),'I','m/s', 'WI Vertical ion drift from edynamo') - call addfld ('UI&IC', (/ 'lev' /), 'I','m/s', 'Zonal ion drift velocity') - call addfld ('VI&IC', (/ 'lev' /), 'I','m/s', 'Meridional ion drift velocity') - call addfld ('WI&IC', (/ 'lev' /), 'I','m/s', 'Vertical ion drift velocity') - call add_default ('UI&IC', 0, ' ') - call add_default ('VI&IC', 0, ' ') - call add_default ('WI&IC', 0, ' ') - endif - if ( ionos_epotential_amie ) then - call init_amie(amienh_file,amiesh_file) - call addfld ('amie_efx_phys',horiz_only,'I','mW/m2', 'AMIE energy flux') - call addfld ('amie_kev_phys',horiz_only,'I','keV' , 'AMIE mean energy') - end if - if ( trim(ionos_epotential_model) == 'weimer' ) then - call weimer05_init(wei05_coefs_file) - endif - - end subroutine ionosphere_init - - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - subroutine ionosphere_run1(pbuf2d) - use physics_buffer, only: physics_buffer_desc - use cam_history, only: outfld, write_inithist - use phys_grid, only: get_ncols_p - - ! args - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - ! local vars - integer :: i, j, k, lchnk ! indices - integer :: ifirstxy, ilastxy, jfirstxy, jlastxy, km, idim - real(r8), allocatable :: tmp(:,:) - type(physics_buffer_desc), pointer :: pbuf_chnk(:) - - type(t_fvdycore_grid), pointer :: grid - - real(r8), pointer :: pbuf_amie_efxg(:) ! Pointer to access AMIE energy flux in pbuf - real(r8), pointer :: pbuf_amie_kevg(:) ! Pointer to access AMIE mean energy in pbuf - - integer :: lats(pcols) ! array of latitude indices - integer :: lons(pcols) ! array of longitude in - integer :: blksiz ! number of columns in 2D block - integer :: tsize ! amount of data per grid point passed to physics - integer :: iam, astat - integer :: ib, ic, jc,ncol - integer, allocatable, dimension(:,:) :: bpter - ! offsets into block buffer for packing data - integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data - real(r8), allocatable, dimension(:) :: bbuffer, cbuffer - real(r8), allocatable :: amie_efxg(:,:) ! energy flux from AMIE - real(r8), allocatable :: amie_kevg(:,:) ! characteristic mean energy from AMIE - - grid => get_dyn_state_grid() - iam = grid%iam - - ifirstxy = grid%ifirstxy - ilastxy = grid%ilastxy - jfirstxy = grid%jfirstxy - jlastxy = grid%jlastxy - km = grid%km - - if( write_inithist() .and. ionos_xport_active ) then - - allocate( tmp(ifirstxy:ilastxy,km) ) - - idim = ilastxy - ifirstxy + 1 - do j = jfirstxy, jlastxy - do k = 1, km - do i = ifirstxy, ilastxy - tmp(i,k) = opmmrtm1_blck(i,j,k) - enddo - enddo - call outfld ('OpTM1&IC', tmp, idim, j) - enddo - - deallocate( tmp ) - - endif - - amie_active: if ( ionos_epotential_amie ) then - allocate(amie_efxg(ifirstxy:ilastxy,jfirstxy:jlastxy)) - allocate(amie_kevg(ifirstxy:ilastxy,jfirstxy:jlastxy)) - - ! data assimilated potential - call d_pie_epotent( ionos_epotential_model, epot_crit_colats, & - i0=ifirstxy,i1=ilastxy,j0=jfirstxy,j1=jlastxy, & - efxg=amie_efxg,kevg=amie_kevg ) - - ! transform to physics grid for aurora... - - ! blocks --> physics chunks - - blcks2phys_local: if (local_dp_map) then - - chnk_loop1 : do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - call get_lon_all_p(lchnk, ncol, lons) - call get_lat_all_p(lchnk, ncol, lats) - - pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) - call pbuf_get_field(pbuf_chnk, indxAMIEefxg, pbuf_amie_efxg) - call pbuf_get_field(pbuf_chnk, indxAMIEkevg, pbuf_amie_kevg) - - do i=1,ncol - ic = lons(i) - jc = lats(i) - pbuf_amie_efxg(i) = amie_efxg(ic,jc) - pbuf_amie_kevg(i) = amie_kevg(ic,jc) - end do - call outfld ( 'amie_efx_phys', pbuf_amie_efxg, pcols, lchnk ) - call outfld ( 'amie_kev_phys', pbuf_amie_kevg, pcols, lchnk ) - end do chnk_loop1 - - else ! blcks2phys_local - - tsize = 2 - blksiz = (jlastxy-jfirstxy+1)*(ilastxy-ifirstxy+1) - allocate( bpter(blksiz,0:km),stat=astat ) - allocate( bbuffer(tsize*block_buf_nrecs),stat=astat ) - allocate( cbuffer(tsize*chunk_buf_nrecs),stat=astat ) - - if (iam < grid%npes_xy) then - call block_to_chunk_send_pters(iam+1,blksiz,pver+1,tsize,bpter) - endif - - do j=jfirstxy,jlastxy - do i=ifirstxy,ilastxy - ib = (j-jfirstxy)*(ilastxy-ifirstxy+1) + (i-ifirstxy+1) - bbuffer(bpter(ib,0)+0) = amie_efxg(i,j) - bbuffer(bpter(ib,0)+1) = amie_kevg(i,j) - end do - end do - - call transpose_block_to_chunk(tsize, bbuffer, cbuffer) - - chnk_loop2: do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - - pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) - call pbuf_get_field(pbuf_chnk, indxAMIEefxg, pbuf_amie_efxg) - call pbuf_get_field(pbuf_chnk, indxAMIEkevg, pbuf_amie_kevg) - call block_to_chunk_recv_pters(lchnk,pcols,pver+1,tsize,cpter) - do i=1,ncol - pbuf_amie_efxg(i) = cbuffer(cpter(i,0)+0) - pbuf_amie_kevg(i) = cbuffer(cpter(i,0)+1) - end do - call outfld ( 'amie_efx_phys', pbuf_amie_efxg, pcols, lchnk ) - call outfld ( 'amie_kev_phys', pbuf_amie_kevg, pcols, lchnk ) - end do chnk_loop2 - - deallocate(bpter) - deallocate(bbuffer) - deallocate(cbuffer) - - - end if blcks2phys_local - - deallocate(amie_efxg,amie_kevg) - - else - - ! set cross tail potential before physics -- aurora uses weimer derived potential - call d_pie_epotent( ionos_epotential_model, epot_crit_colats ) - - end if amie_active - - end subroutine ionosphere_run1 - - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - subroutine ionosphere_run2( phys_state, dyn_in, pbuf2d ) - - use physics_types, only: physics_state - use physics_buffer, only: physics_buffer_desc - use dyn_comp, only: dyn_import_t - use cam_history, only: outfld, write_inithist - - ! - pull some fields from pbuf and dyn_in - ! - invoke ionosphere/electro-dynamics coupling - ! - push some fields back to physics via pbuf... - - ! args - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - type(dyn_import_t), intent(inout) :: dyn_in ! dynamics inputs - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - ! local vars - integer :: i,j,k, lchnk - integer :: astat - - integer, allocatable, dimension(:,:) :: bpter - ! offsets into block buffer for packing data - integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data - real(r8), allocatable, dimension(:) :: bbuffer, cbuffer - - type(physics_buffer_desc), pointer :: pbuf_chnk(:) - - real(r8), pointer :: sigma_ped_phys(:,:) ! physics pointer to Pedersen Conductivity - real(r8), pointer :: sigma_hall_phys(:,:) ! physics pointer fo Hall Conductivity - real(r8), pointer :: te_phys(:,:) ! te from pbuf - real(r8), pointer :: ti_phys(:,:) ! ti from pbuf - real(r8), pointer :: mmrPO2p_phys(:,:) ! Pointer to access O2+ in pbuf - real(r8), pointer :: mmrPNOp_phys(:,:) ! Pointer to access NO+ in pbuf - real(r8), pointer :: mmrPN2p_phys(:,:) ! Pointer to access N2+ in pbuf - real(r8), pointer :: mmrPOp_phys(:,:) ! Pointer to access O+ in pbuf -! -! Empirical ion drifts from exbdrift (to be converted to blocked for dpie_coupling): - real(r8), pointer :: ui_phys(:,:) ! zonal ion drift from pbuf - real(r8), pointer :: vi_phys(:,:) ! meridional ion drift from pbuf - real(r8), pointer :: wi_phys(:,:) ! vertical ion drift from pbuf - - real(r8), pointer :: o2pmmr_blck(:,:,:) => null() ! O2+ (blocks) - real(r8), pointer :: nopmmr_blck(:,:,:) => null() ! NO+ (blocks) - real(r8), pointer :: n2pmmr_blck(:,:,:) => null() ! N2+ (blocks) - real(r8), pointer :: opmmr_blck(:,:,:) => null() ! O+ (blocks) - - real(r8), pointer :: tracer(:,:,:,:) - real(r8), pointer :: u3s(:,:,:) - real(r8), pointer :: v3s(:,:,:) - real(r8), pointer :: pexy(:,:,:) - - real(r8), pointer :: phis(:,:) ! surface geopotential - - real(r8), pointer :: o2mmr_blck(:,:,:) - real(r8), pointer :: o1mmr_blck(:,:,:) - real(r8), pointer :: h1mmr_blck(:,:,:) - - integer :: ib, ic, jc, ifirstxy, ilastxy, jfirstxy, jlastxy, km, ncol - - integer :: lats(pcols) ! array of latitude indices - integer :: lons(pcols) ! array of longitude indices - integer :: nSIons ! number of ions set to non-advected - integer :: ibuffOp,ibuffO2p,ibuffNOp, ibuffN2p ! Buffer indices for non-advected ions - - integer :: blksiz ! number of columns in 2D block - integer :: tsize ! amount of data per grid point passed to physics - integer :: iam - - real(r8), allocatable :: wuxy(:,:,:) - real(r8), allocatable :: wvxy(:,:,:) - real(r8), allocatable :: sigma_ped_blck (:,:,:) - real(r8), allocatable :: sigma_hall_blck(:,:,:) - real(r8), allocatable :: ti_blck(:,:,:) - real(r8), allocatable :: te_blck(:,:,:) - real(r8), allocatable :: zi_blck(:,:,:) - real(r8), allocatable :: zm_blck(:,:,:) - real(r8), allocatable :: ui_blck(:,:,:) - real(r8), allocatable :: vi_blck(:,:,:) - real(r8), allocatable :: wi_blck(:,:,:) - real(r8), allocatable :: omega_blck(:,:,:) - real(r8), allocatable :: tn_blck(:,:,:) - - type (t_fvdycore_grid), pointer :: grid - - ionos_cpl: if (ionos_xport_active) then - - grid => get_dyn_state_grid() - iam = grid%iam - - allocate( wuxy(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) - allocate( wvxy(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) - allocate( sigma_ped_blck (grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) - allocate( sigma_hall_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) - allocate( ti_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) - allocate( te_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) - allocate( zi_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) - allocate( zm_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) - allocate( ui_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) - allocate( vi_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) - allocate( wi_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) - allocate( omega_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) - allocate( tn_blck(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, grid%km) ) - - ifirstxy = grid%ifirstxy - ilastxy = grid%ilastxy - jfirstxy = grid%jfirstxy - jlastxy = grid%jlastxy - km = grid%km - - phis => dyn_in%phis - - tracer => dyn_in%tracer - pexy => dyn_in%pe - - u3s => dyn_in%u3s - v3s => dyn_in%v3s - - if (iam < grid%npes_xy) then - call d2a3dijk( grid, u3s, v3s, wuxy, wvxy ) - endif - - if (sIndxOp>0) then - allocate(opmmr_blck(ifirstxy:ilastxy,jfirstxy:jlastxy,km),stat=astat) - if (astat /= 0) call endrun('ionos_intr_d_p_cplng: failed to allocate opmmr_blck') - endif - if (sIndxO2p>0) then - allocate(o2pmmr_blck(ifirstxy:ilastxy,jfirstxy:jlastxy,km),stat=astat) - if (astat /= 0) call endrun('ionos_intr_d_p_cplng: failed to allocate o2pmmr_blck') - endif - if (sIndxNOp>0) then - allocate(nopmmr_blck(ifirstxy:ilastxy,jfirstxy:jlastxy,km),stat=astat) - if (astat /= 0) call endrun('ionos_intr_d_p_cplng: failed to allocate nopmmr_blck') - endif - if (sIndxN2p>0) then - allocate(n2pmmr_blck(ifirstxy:ilastxy,jfirstxy:jlastxy,km),stat=astat) - if (astat /= 0) call endrun('ionos_intr_d_p_cplng: failed to allocate n2pmmr_blck') - endif - - phys2blcks_local: if (local_dp_map) then - - do lchnk = begchunk,endchunk - - ncol = get_ncols_p(lchnk) - call get_lon_all_p(lchnk, ncol, lons) - call get_lat_all_p(lchnk, ncol, lats) - pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) - - ! Get Pedersen and Hall conductivities: - call pbuf_get_field(pbuf_chnk, index_ped, sigma_ped_phys) - call pbuf_get_field(pbuf_chnk, index_hall, sigma_hall_phys) - do k=1,km - do i=1,ncol - sigma_ped_blck(lons(i),lats(i),k) = sigma_ped_phys(i,k) - sigma_hall_blck(lons(i),lats(i),k) = sigma_hall_phys(i,k) - end do - enddo - - ! Get ion and electron temperatures - call pbuf_get_field(pbuf_chnk, index_te, te_phys) - call pbuf_get_field(pbuf_chnk, index_ti, ti_phys) - do k=1,km - do i=1,ncol - te_blck(lons(i),lats(i),k) = te_phys(i,k) - ti_blck(lons(i),lats(i),k) = ti_phys(i,k) - end do - enddo - - ! Get components of ion drift velocities - call pbuf_get_field(pbuf_chnk, index_ui, ui_phys) - call pbuf_get_field(pbuf_chnk, index_vi, vi_phys) - call pbuf_get_field(pbuf_chnk, index_wi, wi_phys) - do k=1,km - do i=1,ncol - ui_blck(lons(i),lats(i),k) = ui_phys(i,k) - vi_blck(lons(i),lats(i),k) = vi_phys(i,k) - wi_blck(lons(i),lats(i),k) = wi_phys(i,k) - zi_blck(lons(i),lats(i),k) = phys_state(lchnk)%zi(i,k) - zm_blck(lons(i),lats(i),k) = phys_state(lchnk)%zm(i,k) - omega_blck(lons(i),lats(i),k) = phys_state(lchnk)%omega(i,k) - tn_blck(lons(i),lats(i),k) = phys_state(lchnk)%t(i,k) - enddo - enddo - - !-------------------------------------------------------- - ! Get ions from physics buffer if non-transported - !-------------------------------------------------------- - if (sIndxO2p > 0) then - call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPO2p_phys, & - start=(/1,1,sIndxO2p/), kount=(/pcols,pver,1/) ) - do k=1,km - do i=1,ncol - o2pmmr_blck(lons(i),lats(i),k) = mmrPO2p_phys(i,k) - end do - enddo - endif - if (sIndxNOp > 0) then - call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPNOp_phys, & - start=(/1,1,sIndxNOp/), kount=(/pcols,pver,1/) ) - do k=1,km - do i=1,ncol - nopmmr_blck(lons(i),lats(i),k) = mmrPNOp_phys(i,k) - end do - enddo - endif - if (sIndxN2p > 0) then - call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPN2p_phys, & - start=(/1,1,sIndxN2p/), kount=(/pcols,pver,1/) ) - do k=1,km - do i=1,ncol - n2pmmr_blck(lons(i),lats(i),k) = mmrPN2p_phys(i,k) - end do - enddo - endif - if (sIndxOp > 0) then - call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPOp_phys, & - start=(/1,1,sIndxOp/), kount=(/pcols,pver,1/) ) - do k=1,km - do i=1,ncol - opmmr_blck(lons(i),lats(i),k) = mmrPOp_phys(i,k) - end do - enddo - endif - - enddo ! do lchnk = begchunk,endchunk - - else ! phys2blcks_local - - tsize = 11 - - nSIons = 0 - if (sIndxOp > 0) then - ibuffOp = tsize + nSIons - nSIons = nSIons + 1 - endif - if (sIndxO2p > 0) then - ibuffO2p = tsize + nSIons - nSIons = nSIons + 1 - endif - if (sIndxNOp > 0) then - ibuffNOp = tsize + nSIons - nSIons = nSIons + 1 - endif - if (sIndxN2p > 0) then - ibuffN2p = tsize + nSIons - nSIons = nSIons + 1 - endif - tsize = tsize + nSIons - - blksiz = (jlastxy-jfirstxy+1)*(ilastxy-ifirstxy+1) - allocate(bpter(blksiz,0:km)) - allocate(bbuffer(tsize*block_buf_nrecs)) - allocate(cbuffer(tsize*chunk_buf_nrecs)) - - do lchnk = begchunk,endchunk - ncol = get_ncols_p(lchnk) - - pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) - - ! Get Pedersen and Hall conductivities: - call pbuf_get_field(pbuf_chnk, index_ped, sigma_ped_phys) - call pbuf_get_field(pbuf_chnk, index_hall, sigma_hall_phys) - - ! Get ion and electron temperatures - call pbuf_get_field(pbuf_chnk, index_te, te_phys) - call pbuf_get_field(pbuf_chnk, index_ti, ti_phys) - - ! Get components of ion drift velocities - call pbuf_get_field(pbuf_chnk, index_ui, ui_phys) - call pbuf_get_field(pbuf_chnk, index_vi, vi_phys) - call pbuf_get_field(pbuf_chnk, index_wi, wi_phys) - - !-------------------------------------------------------- - ! Get ions from physics buffer if non-transported - !-------------------------------------------------------- - - if (sIndxOp > 0) call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPOp_phys, & - start=(/1,1,sIndxOp/), kount=(/pcols,pver,1/) ) - if (sIndxO2p > 0) call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPO2p_phys, & - start=(/1,1,sIndxO2p/), kount=(/pcols,pver,1/) ) - if (sIndxNOp > 0) call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPNOp_phys, & - start=(/1,1,sIndxNOp/), kount=(/pcols,pver,1/) ) - if (sIndxN2p > 0) call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPN2p_phys, & - start=(/1,1,sIndxN2p/), kount=(/pcols,pver,1/) ) - - call chunk_to_block_send_pters(lchnk,pcols,pver+1,tsize,cpter) - - do i=1,ncol - cbuffer(cpter(i,0):cpter(i,0)+tsize-1) = 0.0_r8 - end do - - do k=1,km - do i=1,ncol - - cbuffer(cpter(i,k)+0) = sigma_ped_phys(i,k) - cbuffer(cpter(i,k)+1) = sigma_hall_phys(i,k) - cbuffer(cpter(i,k)+2) = te_phys(i,k) - cbuffer(cpter(i,k)+3) = ti_phys(i,k) - cbuffer(cpter(i,k)+4) = phys_state(lchnk)%zi(i,k) - cbuffer(cpter(i,k)+5) = phys_state(lchnk)%zm(i,k) - cbuffer(cpter(i,k)+6) = ui_phys(i,k) - cbuffer(cpter(i,k)+7) = vi_phys(i,k) - cbuffer(cpter(i,k)+8) = wi_phys(i,k) - cbuffer(cpter(i,k)+9) = phys_state(lchnk)%omega(i,k) - cbuffer(cpter(i,k)+10) = phys_state(lchnk)%t(i,k) - - if (sIndxO2p > 0)cbuffer(cpter(i,k)+ibuffO2p) = mmrPO2p_phys(i,k) - if (sIndxNOp > 0)cbuffer(cpter(i,k)+ibuffNOp) = mmrPNOp_phys(i,k) - if (sIndxN2p > 0)cbuffer(cpter(i,k)+ibuffN2p) = mmrPN2p_phys(i,k) - if (sIndxOp > 0) cbuffer(cpter(i,k)+ibuffOp) = mmrPOp_phys(i,k) - - end do - - end do - - end do - - call t_barrierf('sync_chk_to_blk', grid%commxy) - call t_startf ('chunk_to_block') - call transpose_chunk_to_block(tsize, cbuffer, bbuffer) - call t_stopf ('chunk_to_block') - - if (iam < grid%npes_xy) then - call chunk_to_block_recv_pters(iam+1,blksiz,pver+1,tsize,bpter) - endif - - do j=jfirstxy,jlastxy - do k=1,km - do i=ifirstxy,ilastxy - ib = (j-jfirstxy)*(ilastxy-ifirstxy+1) + (i-ifirstxy+1) - - sigma_ped_blck(i,j,k) = bbuffer(bpter(ib,k)+0) - sigma_hall_blck(i,j,k) = bbuffer(bpter(ib,k)+1) - te_blck(i,j,k) = bbuffer(bpter(ib,k)+2) - ti_blck(i,j,k) = bbuffer(bpter(ib,k)+3) - zi_blck(i,j,k) = bbuffer(bpter(ib,k)+4) - zm_blck(i,j,k) = bbuffer(bpter(ib,k)+5) - ui_blck(i,j,k) = bbuffer(bpter(ib,k)+6) - vi_blck(i,j,k) = bbuffer(bpter(ib,k)+7) - wi_blck(i,j,k) = bbuffer(bpter(ib,k)+8) - omega_blck(i,j,k) = bbuffer(bpter(ib,k)+9) - tn_blck(i,j,k) = bbuffer(bpter(ib,k)+10) - - if (sIndxO2p > 0) o2pmmr_blck(i,j,k) = bbuffer(bpter(ib,k)+ibuffO2p) - if (sIndxNOp > 0) nopmmr_blck(i,j,k) = bbuffer(bpter(ib,k)+ibuffNOp) - if (sIndxN2p > 0) n2pmmr_blck(i,j,k) = bbuffer(bpter(ib,k)+ibuffN2p) - if (sIndxOp > 0) opmmr_blck(i,j,k) = bbuffer(bpter(ib,k)+ibuffOp) - - enddo - enddo - enddo - - deallocate(bpter) - deallocate(bbuffer) - deallocate(cbuffer) - - endif phys2blcks_local - - !------------------------------------------------------------------------------------------- - ! Set dpie_coupling input ions if they are advected ... - !------------------------------------------------------------------------------------------- - if (ixo2p > 0) then - o2pmmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixo2p) - endif - if (ixnop > 0) then - nopmmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixnop) - endif - if (ixn2p > 0) then - n2pmmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixn2p) - endif - if (ixop > 0) then - opmmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixop) - endif - - !------------------------------------ - ! Get neutrals from advected tracers array - !------------------------------------ - - o2mmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixo2) - o1mmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixo) - h1mmr_blck => tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixh) - - ! - ! Make geopotential height (m) for d_pie_coupling. - ! - do k=1,km - do j=jfirstxy,jlastxy - do i=ifirstxy,ilastxy - zi_blck(i,j,k) = zi_blck(i,j,k)+phis(i,j)/gravit ! phis is redundant in k - zm_blck(i,j,k) = zm_blck(i,j,k)+phis(i,j)/gravit ! phis is redundant in k - enddo - enddo - enddo - - call t_startf('d_pie_coupling') - - if (iam < grid%npes_xy) then - ! waccmx ionosphere electro-dynamics -- transports O+ and provides updates to ion drift velocities - call d_pie_coupling(omega_blck,pexy,zi_blck,zm_blck,wuxy,wvxy,tn_blck, & - sigma_ped_blck,sigma_hall_blck,te_blck,ti_blck, & - o2mmr_blck,o1mmr_blck,h1mmr_blck,o2pmmr_blck,nopmmr_blck,n2pmmr_blck, & - opmmr_blck,opmmrtm1_blck,ui_blck,vi_blck,wi_blck, & - rmassO2,rmassO1,rmassH,rmassN2,rmassO2p,rmassNOp,rmassN2p, rmassOp, & - ifirstxy,ilastxy, jfirstxy,jlastxy) - endif - - call t_stopf ('d_pie_coupling') - - ! - !---------------------------------------- - ! Put data back in to state%q or pbuf - !---------------------------------------- - if (ixop > 0) then - tracer(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km,ixop) = opmmr_blck(ifirstxy:ilastxy,jfirstxy:jlastxy,1:km) - endif - - ! blocks --> physics chunks - - blcks2phys_local: if (local_dp_map) then - - chnk_loop1 : do lchnk = begchunk,endchunk - ncol = phys_state(lchnk)%ncol - call get_lon_all_p(lchnk, ncol, lons) - call get_lat_all_p(lchnk, ncol, lats) - - pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) - - call pbuf_get_field(pbuf_chnk, index_ui, ui_phys) - call pbuf_get_field(pbuf_chnk, index_vi, vi_phys) - call pbuf_get_field(pbuf_chnk, index_wi, wi_phys) - if (sIndxOp > 0) then - call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPOp_phys, & - start=(/1,1,sIndxOp/), kount=(/pcols,pver,1/) ) - endif - do k=1,km - do i=1,ncol - ic = lons(i) - jc = lats(i) - ui_phys(i,k) = ui_blck(ic,jc,k) - vi_phys(i,k) = vi_blck(ic,jc,k) - wi_phys(i,k) = wi_blck(ic,jc,k) - if (sIndxOp > 0) mmrPOp_phys(i,k) = opmmr_blck(ic,jc,k) - end do - end do - - if (ionos_edyn_active) then - call outfld ( 'UI', ui_phys, pcols, lchnk ) - call outfld ( 'VI', vi_phys, pcols, lchnk ) - call outfld ( 'WI', wi_phys, pcols, lchnk ) - if (write_inithist()) then - call outfld ( 'UI&IC', ui_phys, pcols, lchnk ) - call outfld ( 'VI&IC', vi_phys, pcols, lchnk ) - call outfld ( 'WI&IC', wi_phys, pcols, lchnk ) - endif - endif - - end do chnk_loop1 - - else ! blcks2phys_local - - if (sIndxOp > 0) then - tsize = 4 ! for ui,vi,wi,op - else - tsize = 3 ! for ui,vi,wi - endif - tsize=tsize+1 - - blksiz = (jlastxy-jfirstxy+1)*(ilastxy-ifirstxy+1) - allocate( bpter(blksiz,0:km),stat=astat ) - allocate( bbuffer(tsize*block_buf_nrecs),stat=astat ) - allocate( cbuffer(tsize*chunk_buf_nrecs),stat=astat ) - - if (iam < grid%npes_xy) then - call block_to_chunk_send_pters(iam+1,blksiz,km+1,tsize,bpter) - endif - - do j=jfirstxy,jlastxy - do i=ifirstxy,ilastxy - ib = (j-jfirstxy)*(ilastxy-ifirstxy+1) + (i-ifirstxy+1) - - do k=1,km - - bbuffer(bpter(ib,k)) = ui_blck(i,j,k) - bbuffer(bpter(ib,k)+1) = vi_blck(i,j,k) - bbuffer(bpter(ib,k)+2) = wi_blck(i,j,k) - if (sIndxOp > 0) bbuffer(bpter(ib,k)+3) = opmmr_blck(i,j,k) - - end do - end do - end do - - call t_barrierf('sync_ionos_blk_to_chk', grid%commxy) - call t_startf ('ionos_block_to_chunk') - call transpose_block_to_chunk(tsize, bbuffer, cbuffer) - call t_stopf ('ionos_block_to_chunk') - - chnk_loop2: do lchnk = begchunk,endchunk - ncol = phys_state(lchnk)%ncol - - pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) - - call pbuf_get_field(pbuf_chnk, index_ui, ui_phys) - call pbuf_get_field(pbuf_chnk, index_vi, vi_phys) - call pbuf_get_field(pbuf_chnk, index_wi, wi_phys) - if (sIndxOp > 0) then - call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPOp_phys, & - start=(/1,1,sIndxOp/), kount=(/pcols,pver,1/) ) - endif - - call block_to_chunk_recv_pters(lchnk,pcols,pver+1,tsize,cpter) - - do i=1,ncol - - do k=1,km - ui_phys(i,k) = cbuffer(cpter(i,k)) - vi_phys(i,k) = cbuffer(cpter(i,k)+1) - wi_phys(i,k) = cbuffer(cpter(i,k)+2) - if (sIndxOp > 0) then - mmrPOp_phys(i,k) = cbuffer(cpter(i,k)+3) - endif - end do ! k=1,km - end do ! i=1,ncol - - if (ionos_edyn_active) then - call outfld ( 'UI', ui_phys, pcols, lchnk ) - call outfld ( 'VI', vi_phys, pcols, lchnk ) - call outfld ( 'WI', wi_phys, pcols, lchnk ) - if (write_inithist()) then - call outfld ( 'UI&IC', ui_phys, pcols, lchnk ) - call outfld ( 'VI&IC', vi_phys, pcols, lchnk ) - call outfld ( 'WI&IC', wi_phys, pcols, lchnk ) - endif - endif - - end do chnk_loop2 - - deallocate(bpter) - deallocate(bbuffer) - deallocate(cbuffer) - - endif blcks2phys_local - - if (sIndxOp>0) then - deallocate(opmmr_blck) - nullify(opmmr_blck) - endif - if (sIndxO2p>0) then - deallocate(o2pmmr_blck) - nullify(o2pmmr_blck) - endif - if (sIndxNOp>0) then - deallocate(nopmmr_blck) - nullify(nopmmr_blck) - endif - if (sIndxN2p>0) then - deallocate(n2pmmr_blck) - nullify(n2pmmr_blck) - endif - - deallocate( wuxy ) - deallocate( wvxy ) - deallocate( sigma_ped_blck ) - deallocate( sigma_hall_blck ) - deallocate( ti_blck ) - deallocate( te_blck ) - deallocate( zi_blck ) - deallocate( ui_blck ) - deallocate( vi_blck ) - deallocate( wi_blck ) - deallocate( omega_blck ) - deallocate( tn_blck ) - - endif ionos_cpl - - end subroutine ionosphere_run2 - - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - subroutine ionosphere_init_restart(File) - use pio, only: file_desc_t, pio_double, pio_def_var - use cam_pio_utils, only: cam_pio_def_dim - use dyn_grid, only: get_horiz_grid_dim_d - - type(File_desc_t), intent(inout) :: File - - integer :: ierr,hdim1,hdim2, dimids(3) - - call get_horiz_grid_dim_d(hdim1, hdim2) - - call cam_pio_def_dim(File, 'lon', hdim1, dimids(1), existOK=.true.) - call cam_pio_def_dim(File, 'lat', hdim2, dimids(2), existOK=.true.) - call cam_pio_def_dim(File, 'lev', pver, dimids(3), existOK=.true.) - - if (ionos_xport_active) then - ierr = PIO_Def_Var(File, 'Optm1', pio_double, dimids, Optm1_vdesc) - endif - end subroutine ionosphere_init_restart - - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - subroutine ionosphere_write_restart(File) - use pio, only: io_desc_t, file_desc_t, pio_write_darray, pio_initdecomp, pio_double - use cam_pio_utils, only: pio_subsystem - use dyn_grid, only: get_horiz_grid_dim_d - - type(File_desc_t), intent(inout) :: File - - type(io_desc_t) :: iodesc3d - integer :: hdim1, hdim2 - integer, pointer :: ldof(:) - integer :: ierr - - if (ionos_xport_active) then - call get_horiz_grid_dim_d(hdim1, hdim2) - ldof => get_restart_decomp(hdim1, hdim2, pver) - call pio_initdecomp(pio_subsystem, pio_double, (/hdim1, hdim2, pver/), ldof, iodesc3d) - deallocate(ldof) - - call pio_write_darray(File, Optm1_vdesc, iodesc3d, opmmrtm1_blck, ierr) - endif - - end subroutine ionosphere_write_restart - - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - subroutine ionosphere_read_restart(File) - use pio, only: io_desc_t, file_desc_t, pio_inq_varid, pio_read_darray, pio_initdecomp, pio_double - use cam_pio_utils, only: pio_subsystem - use dyn_grid, only: get_horiz_grid_dim_d - - type(file_desc_t), intent(inout) :: File - - integer :: ierr - type(io_desc_t) :: iodesc3d - integer :: hdim1, hdim2 - integer, pointer :: ldof(:) - - if (ionos_xport_active) then - call ionosphere_alloc - - call get_horiz_grid_dim_d(hdim1, hdim2) - ldof => get_restart_decomp(hdim1, hdim2, pver) - call pio_initdecomp(pio_subsystem, pio_double, (/hdim1, hdim2, pver/), ldof, iodesc3d) - deallocate(ldof) - - ierr = pio_inq_varid(File, 'Optm1', Optm1_vdesc) - call pio_read_darray(File, Optm1_vdesc, iodesc3d, opmmrtm1_blck, ierr) - endif - - end subroutine ionosphere_read_restart - - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - subroutine ionosphere_final + use shr_kind_mod, only: r8 => shr_kind_r8, cl=>shr_kind_cl + use cam_abortutils, only: endrun + use ppgrid, only: begchunk, endchunk, pcols, pver + 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 + use mo_chem_utls, only: get_spc_ndx ! Routine to get index of adv_mass array for short lived species + use physics_buffer, only: pbuf_get_chunk, pbuf_get_field + use physics_buffer, only: pbuf_get_index + + use constituents, only: cnst_get_ind, cnst_mw + use physconst, only: rga + use oplus, only: oplus_init + use edyn_init, only: edynamo_init + use pio, only: var_desc_t + use perf_mod, only: t_startf, t_stopf + use epotential_params, only: epot_active, epot_crit_colats + use shr_const_mod, only: SHR_CONST_REARTH ! meters + + implicit none + + private + + public :: ionosphere_readnl + public :: ionosphere_init + public :: ionosphere_run1 + public :: ionosphere_run2 + public :: ionosphere_init_restart + public :: ionosphere_write_restart + public :: ionosphere_read_restart + public :: ionosphere_final + + ! private data + + ! opmmrtm1_phys is O+ at previous time step (phys grid decomposed) + ! It needs to persist from time-step to time-step and across restarts + ! On physics grid + real(r8), allocatable :: opmmrtm1_phys(:,:,:) + type(var_desc_t) :: Optm1_vdesc + logical :: opmmrtm1_initialized + + integer :: index_ped, index_hall, index_te, index_ti + integer :: index_ui, index_vi, index_wi + + integer :: ixo2=-1, ixo=-1, ixh=-1 + integer :: ixo2p=-1, ixnop=-1, ixn2p=-1, ixop=-1 + + ! indices for accessing ions in pbuf when non-advected + integer :: sIndxOp=-1, sIndxO2p=-1, sIndxNOp=-1, sIndxN2p=-1 + + real(r8) :: rmassO2 ! O2 molecular weight kg/kmol + real(r8) :: rmassO1 ! O atomic weight kg/kmol + real(r8) :: rmassH ! H atomic weight kg/kmol + real(r8) :: rmassN2 ! N2 molecular weight kg/kmol + real(r8) :: rmassO2p ! O2+ molecular weight kg/kmol + real(r8) :: rmassNOp ! NO+ molecular weight kg/kmol + real(r8) :: rmassN2p ! N2+ molecular weight kg/kmol + real(r8) :: rmassOp ! O+ molecular weight kg/kmol + + ! ionos_edyn_active == .true. will activate the edynamo which will + ! generate ion drift velocities used in oplus transport, otherwise + ! empirical ion drifts calculated in exbdrift (physics) will be used. + logical, public, protected :: ionos_edyn_active = .true. + logical, protected :: ionos_xport_active = .true. ! if true, call d_pie_coupling + ! + logical, public, protected :: ionos_oplus_xport = .true. ! if true, call sub oplus (based on tiegcm oplus.F) + integer, public, protected :: ionos_xport_nsplit = 5 ! number of substeps for O+ transport per model time step + logical, public, protected :: oplus_ring_polar_filter = .false. ! switch to apply ring polar filter + + real(r8) :: oplus_adiff_limiter = 1.5e+8_r8 ! limiter for ambipolar diffusion coefficient + real(r8) :: oplus_shapiro_const = 0.03_r8 ! shapiro constant for spatial smoother + logical :: oplus_enforce_floor = .true. ! switch to apply Stan's floor + + integer, parameter :: max_num_files = 20 + character(len=cl) :: wei05_coefs_file = 'NONE' !'wei05sc.nc' + character(len=cl) :: amienh_files(max_num_files) = 'NONE' + character(len=cl) :: amiesh_files(max_num_files) = 'NONE' + character(len=cl) :: ltr_files(max_num_files) = 'NONE' + + + character(len=16) :: ionos_epotential_model = 'none' + logical :: ionos_epotential_amie = .false. + logical :: ionos_epotential_ltr = .false. + integer :: indxefx=-1, indxkev=-1 + + integer :: oplus_nlon, oplus_nlat ! Oplus grid + integer :: ionos_npes = -1 + + logical :: state_debug_checks = .false. + logical :: ionos_debug_hist = .false. + + integer :: mag_nlon=0, mag_nlat=0, mag_nlev=0, mag_ngrid=0 + + real(r8), parameter :: rearth_inv = 1._r8/SHR_CONST_REARTH ! /meters + + contains + + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + subroutine ionosphere_readnl( nlfile ) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: masterproc, mpicom, masterprocid + use spmd_utils, only: mpi_real8, mpi_logical, mpi_integer, mpi_character + use cam_logfile, only: iulog + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr, ipos + integer :: oplus_grid(2) + character(len=8) :: edyn_grid + integer :: total_pes + character(len=*), parameter :: subname = 'ionosphere_readnl' + + namelist /ionosphere_nl/ ionos_xport_active, ionos_edyn_active, ionos_oplus_xport, ionos_xport_nsplit + namelist /ionosphere_nl/ oplus_adiff_limiter, oplus_shapiro_const, oplus_enforce_floor, oplus_ring_polar_filter + namelist /ionosphere_nl/ ionos_epotential_model, ionos_epotential_amie, ionos_epotential_ltr, wei05_coefs_file + namelist /ionosphere_nl/ amienh_files, amiesh_files, wei05_coefs_file, ltr_files + namelist /ionosphere_nl/ epot_crit_colats + namelist /ionosphere_nl/ ionos_npes + namelist /ionosphere_nl/ oplus_grid, edyn_grid + namelist /ionosphere_nl/ ionos_debug_hist + + oplus_grid = 0 + + ! Read namelist + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'ionosphere_nl', status=ierr) + if (ierr == 0) then + read(unitn, ionosphere_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(ionos_xport_active, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(ionos_edyn_active, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(ionos_oplus_xport, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(ionos_xport_nsplit, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(oplus_adiff_limiter, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(ionos_epotential_model, len(ionos_epotential_model), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(ionos_epotential_amie,1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(ionos_epotential_ltr,1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(wei05_coefs_file, len(wei05_coefs_file), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(amienh_files, max_num_files*len(amienh_files(1)), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(amiesh_files, max_num_files*len(amiesh_files(1)), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(ltr_files, max_num_files*len(ltr_files(1)), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(oplus_shapiro_const, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(oplus_enforce_floor, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(oplus_ring_polar_filter,1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(epot_crit_colats, 2, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(ionos_npes, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(oplus_grid, 2, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(edyn_grid, 8, mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(ionos_debug_hist, 1, mpi_logical, masterprocid, mpicom, ierr) + + ! Extract grid settings + oplus_nlon = oplus_grid(1) + oplus_nlat = oplus_grid(2) + + ipos = scan(edyn_grid,'x') + read(edyn_grid(:ipos-1),*) mag_nlon + read(edyn_grid(ipos+1:),*) mag_nlat + + mag_nlev = 5 + int(log(real(mag_nlon,r8)/80._r8)/log(2._r8)) + mag_ngrid = (mag_nlon/10)*2 + + ! Set npes in case of default settings + call mpi_comm_size(mpicom, total_pes, ierr) + if (ionos_npes<1) then + ionos_npes = total_pes + else if (ionos_npes>total_pes) then + call endrun('ionosphere_readnl: ionos_npes > total_pes') + end if + + ! log the user settings + if (masterproc) then + write(iulog,*) 'ionosphere_readnl: ionos_xport_active = ', ionos_xport_active + write(iulog,*) 'ionosphere_readnl: ionos_edyn_active = ', ionos_edyn_active + write(iulog,*) 'ionosphere_readnl: ionos_oplus_xport = ', ionos_oplus_xport + write(iulog,*) 'ionosphere_readnl: ionos_xport_nsplit = ', ionos_xport_nsplit + write(iulog,*) 'ionosphere_readnl: ionos_epotential_model = ', trim(ionos_epotential_model) + write(iulog,*) 'ionosphere_readnl: ionos_epotential_amie = ', ionos_epotential_amie + write(iulog,*) 'ionosphere_readnl: ionos_epotential_ltr = ', ionos_epotential_ltr + write(iulog,'(a,2(g12.4))') & + 'ionosphere_readnl: epot_crit_colats = ', epot_crit_colats + write(iulog,'(a,i0)') 'ionosphere_readnl: ionos_npes = ',ionos_npes + write(iulog,*) 'ionosphere_readnl: oplus_adiff_limiter = ', oplus_adiff_limiter + write(iulog,*) 'ionosphere_readnl: oplus_shapiro_const = ', oplus_shapiro_const + write(iulog,*) 'ionosphere_readnl: oplus_enforce_floor = ', oplus_enforce_floor + write(iulog,*) 'ionosphere_readnl: oplus_ring_polar_filter= ', oplus_ring_polar_filter + if (ionos_xport_active) then + write(iulog,'(a,i0)') 'ionosphere_readnl: oplus_nlon = ',oplus_nlon + write(iulog,'(a,i0)') 'ionosphere_readnl: oplus_nlat = ',oplus_nlat + write(iulog,'(a,i0)') 'ionosphere_readnl: edyn_grid = '//edyn_grid + write(iulog,'(a,i0)') 'ionosphere_readnl: mag_nlon = ',mag_nlon + write(iulog,'(a,i0)') 'ionosphere_readnl: mag_nlat = ',mag_nlat + write(iulog,'(a,i0)') 'ionosphere_readnl: mag_nlev = ',mag_nlev + write(iulog,'(a,i0)') 'ionosphere_readnl: mag_ngrid = ',mag_ngrid + end if + end if + epot_active = .true. + + end subroutine ionosphere_readnl + + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + subroutine ionosphere_init() + use spmd_utils, only: mpicom, iam + use physics_buffer, only: pbuf_add_field, dtype_r8 + use cam_control_mod, only: initial_run + use cam_history, only: addfld, add_default, horiz_only + use edyn_mpi, only: mp_init + use edyn_geogrid, only: set_geogrid + use edyn_maggrid, only: alloc_maggrid + use mo_apex, only: mo_apex_init1 + ! Hybrid level definitions: + use ref_pres, only: pref_mid ! target alev(pver) midpoint levels + use ref_pres, only: pref_edge ! target ailev(pverp) interface levels + use amie_module, only: init_amie + use ltr_module, only: init_ltr + use wei05sc, only: weimer05_init + use phys_control, only: phys_getopts + + ! local variables: + integer :: sIndx + character(len=*), parameter :: subname = 'ionosphere_init' + + call phys_getopts(state_debug_checks_out=state_debug_checks) + + if ( ionos_epotential_amie .or. ionos_epotential_ltr) then + call pbuf_add_field('AUREFX', 'global', dtype_r8, (/pcols/), indxefx) ! Prescribed Energy flux + call pbuf_add_field('AURKEV', 'global', dtype_r8, (/pcols/), indxkev) ! Prescribed Mean energy + end if + if (initial_run) then + ! Read initial conditions (O+) on physics grid + call ionosphere_read_ic() + end if + + op_transport: if (ionos_xport_active) then + + index_ped = pbuf_get_index('PedConduct') + index_hall = pbuf_get_index('HallConduct') + + index_te = pbuf_get_index('TElec') + index_ti = pbuf_get_index('TIon') + ! + ! pbuf indices to empirical ion drifts, to be passed to oplus_xport, + ! if ionos_edyn_active is false. + ! + index_ui = pbuf_get_index('UI') + index_vi = pbuf_get_index('VI') + index_wi = pbuf_get_index('WI') + + !--------------------------------------------------------------------- + ! Get indices for neutrals to get mixing ratios from state%q and masses + !--------------------------------------------------------------------- + call cnst_get_ind('O2' ,ixo2 ) + call cnst_get_ind('O' ,ixo ) + call cnst_get_ind('H' ,ixh ) + !------------------------------------ + ! Get neutral molecular weights + !------------------------------------ + rmassO2 = cnst_mw(ixo2) + rmassO1 = cnst_mw(ixo) + rmassH = cnst_mw(ixh) + rmassN2 = 28._r8 + + call cnst_get_ind('Op',ixop, abort=.false.) + if (ixop > 0) then + rMassOp = cnst_mw(ixop) + else + sIndxOp = slvd_index( 'Op' ) + if (sIndxOp > 0) then + sIndx = get_spc_ndx( 'Op' ) + rmassOp = adv_mass(sIndx) + else + call endrun(subname//': Cannot find state or pbuf index for Op') + end if + end if + + call cnst_get_ind('O2p',ixo2p, abort=.false.) + if (ixo2p > 0) then + rMassO2p = cnst_mw(ixo2p) + else + sIndxO2p = slvd_index( 'O2p' ) + if (sIndxO2p > 0) then + sIndx = get_spc_ndx( 'O2p' ) + rmassO2p = adv_mass(sIndx) + else + call endrun(subname//': Cannot find state or pbuf index for O2p') + end if + end if + + call cnst_get_ind('NOp',ixnop, abort=.false.) + if (ixnop > 0) then + rMassNOp = cnst_mw(ixnop) + else + sIndxNOp = slvd_index( 'NOp' ) + if (sIndxNOp > 0) then + sIndx = get_spc_ndx( 'NOp' ) + rmassNOp = adv_mass(sIndx) + else + call endrun(subname//': Cannot find state or pbuf index for NOp') + end if + end if + + call cnst_get_ind('N2p',ixn2p, abort=.false.) + if (ixn2p > 0) then + rMassN2p = cnst_mw(ixn2p) + else + sIndxN2p = slvd_index( 'N2p' ) + if (sIndxN2p > 0) then + sIndx = get_spc_ndx( 'N2p' ) + rmassN2p = adv_mass(sIndx) + else + call endrun(subname//': Cannot find state or pbuf index for N2p') + end if + end if + + call alloc_maggrid( mag_nlon, mag_nlat, mag_nlev, mag_ngrid ) + + call mp_init(mpicom, ionos_npes, oplus_nlon, oplus_nlat, pver) ! set ntask,mytid + + ! set global geographic grid (sets coordinate distribution) + ! lon0, lon1, etc. are set here + call set_geogrid(oplus_nlon, oplus_nlat, pver, ionos_npes, iam, pref_mid, pref_edge) + + call edynamo_init(mpicom, ionos_debug_hist) + + call d_pie_init(ionos_edyn_active, ionos_oplus_xport, ionos_xport_nsplit, epot_crit_colats, & + ionos_debug_hist) + + call ionosphere_alloc() + + call oplus_init(oplus_adiff_limiter, oplus_shapiro_const, oplus_enforce_floor, & + oplus_ring_polar_filter, ionos_debug_hist) + + call addfld('OpTM1&IC', (/ 'lev' /), 'I', 'kg/kg', 'O+ at time step minus 1', gridname='physgrid') + call add_default ('OpTM1&IC',0, 'I') + + end if op_transport + + ! This has to be after edynamo_init (where maggrid is initialized) + call mo_apex_init1() + + if (ionos_edyn_active) then + call addfld ('UI',(/ 'lev' /),'I','m/s', 'UI Zonal ion drift from edynamo') + call addfld ('VI',(/ 'lev' /),'I','m/s', 'VI Meridional ion drift from edynamo') + call addfld ('WI',(/ 'lev' /),'I','m/s', 'WI Vertical ion drift from edynamo') + call addfld ('UI&IC', (/ 'lev' /), 'I','m/s', 'Zonal ion drift velocity') + call addfld ('VI&IC', (/ 'lev' /), 'I','m/s', 'Meridional ion drift velocity') + call addfld ('WI&IC', (/ 'lev' /), 'I','m/s', 'Vertical ion drift velocity') + call add_default ('UI&IC', 0, ' ') + call add_default ('VI&IC', 0, ' ') + call add_default ('WI&IC', 0, ' ') + end if + if ( ionos_epotential_amie ) then + call init_amie(amienh_files,amiesh_files) + call addfld ('amie_efx_phys', horiz_only, 'I', 'mW/m2', 'AMIE energy flux') + call addfld ('amie_kev_phys', horiz_only, 'I', 'keV', 'AMIE mean energy') + end if + if ( ionos_epotential_ltr ) then + call init_ltr(ltr_files) + call addfld ('ltr_efx_phys', horiz_only, 'I', 'mW/m2', 'LTR energy flux') + call addfld ('ltr_kev_phys', horiz_only, 'I', 'keV', 'LTR mean energy') + end if + if ( trim(ionos_epotential_model) == 'weimer' ) then + call weimer05_init(wei05_coefs_file) + end if + + ! d_pie_coupling diagnostics + call addfld ('Z3GM', (/ 'lev' /), 'I', 'm', & + 'Geometric height', gridname='physgrid') + call addfld ('Z3GMI', (/ 'lev' /), 'I', 'm', & + 'Geometric height (Interfaces)', gridname='physgrid') + + end subroutine ionosphere_init -#ifdef WACCMX_EDYN_ESMF - use edyn_esmf, only: edyn_esmf_final - - call edyn_esmf_final() -#endif - - if (allocated(opmmrtm1_blck)) deallocate(opmmrtm1_blck) - - end subroutine ionosphere_final - -!========================================================================================= - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - subroutine ionosphere_read_ic() - - use pio, only: file_desc_t - use ncdio_atm, only: infld - use cam_initfiles, only: initial_file_get_id - - type(file_desc_t), pointer :: fh_ini ! PIO filehandle - - type (t_fvdycore_grid), pointer :: grid - integer :: ifirstxy,ilastxy,jfirstxy,jlastxy,km - logical :: readvar - - if ( ionos_xport_active ) then - call ionosphere_alloc() - - fh_ini => initial_file_get_id() - grid => get_dyn_state_grid() - ifirstxy = grid%ifirstxy - ilastxy = grid%ilastxy - jfirstxy = grid%jfirstxy - jlastxy = grid%jlastxy - km = grid%km - - ! try reading in OpTM1 from the IC file - call infld('OpTM1', fh_ini, 'lon', 'lat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, & - 1, km, opmmrtm1_blck, readvar, gridname='fv_centers') - - if (.not.readvar) then - ! if OpTM1 is not included in the IC file then try using O+ - call infld('Op', fh_ini, 'lon', 'lat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, & - 1, km, opmmrtm1_blck, readvar, gridname='fv_centers') - endif - endif - - end subroutine ionosphere_read_ic - - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - subroutine ionosphere_alloc - - type(T_FVDYCORE_GRID),pointer :: grid ! FV Dynamics grid - integer :: ifirstxy, ilastxy, jfirstxy, jlastxy, km - integer :: astat - - if (.not. allocated(opmmrtm1_blck)) then - - grid => get_dyn_state_grid() - ifirstxy = grid%ifirstxy - ilastxy = grid%ilastxy - jfirstxy = grid%jfirstxy - jlastxy = grid%jlastxy - km = grid%km - - allocate(opmmrtm1_blck(ifirstxy:ilastxy,jfirstxy:jlastxy,km),stat=astat) - if (astat /= 0) call endrun('ionosphere_init: failed to allocate opmmrtm1_blck') - opmmrtm1_blck = 0._r8 - - endif + !---------------------------------------------------------------------------- + !---------------------------------------------------------------------------- + subroutine ionosphere_run1(pbuf2d) + use physics_buffer, only: physics_buffer_desc + use cam_history, only: outfld, write_inithist - end subroutine ionosphere_alloc + ! args + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + ! local vars + integer :: i, j, lchnk, blksize ! indices + type(physics_buffer_desc), pointer :: pbuf_chnk(:) - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- -function get_restart_decomp(hdim1, hdim2, nlev) result(ldof) - use dyn_grid, only: get_dyn_grid_parm + real(r8), pointer :: pbuf_efx(:) ! Pointer to prescribed energy flux in pbuf + real(r8), pointer :: pbuf_kev(:) ! Pointer to prescribed mean energy in pbuf - ! Get the integer mapping of a variable in the dynamics decomp in memory. - ! The canonical ordering is as on the file. A 0 value indicates that the - ! variable is not on the file (eg halo or boundary values) + integer :: ncol + real(r8), pointer :: prescr_efx(:) ! prescribed energy flux + real(r8), pointer :: prescr_kev(:) ! prescribed characteristic mean energy - ! arguments - integer, intent(in) :: hdim1, hdim2, nlev - integer, pointer :: ldof(:) + if( write_inithist() .and. ionos_xport_active ) then + do lchnk = begchunk, endchunk + call outfld ('OpTM1&IC', opmmrtm1_phys(:,:,lchnk), pcols, lchnk) + end do + end if + + nullify(prescr_efx) + nullify(prescr_kev) + prescribed_epot: if ( ionos_epotential_amie .or. ionos_epotential_ltr ) then + blksize = 0 + do lchnk = begchunk, endchunk + blksize = blksize + get_ncols_p(lchnk) + end do - ! local variables - integer :: i, k, j - integer :: lcnt - integer :: beglatxy, beglonxy, endlatxy, endlonxy - !---------------------------------------------------------------------------- + allocate(prescr_efx(blksize)) + allocate(prescr_kev(blksize)) + + ! data assimilated potential + 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 ) + + ! transform to pbuf for aurora... + + j = 0 + chnk_loop1: do lchnk = begchunk, endchunk + ncol = get_ncols_p(lchnk) + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + call pbuf_get_field(pbuf_chnk, indxefx, pbuf_efx) + call pbuf_get_field(pbuf_chnk, indxkev, pbuf_kev) + + do i = 1, ncol + j = j + 1 + pbuf_efx(i) = prescr_efx(j) + pbuf_kev(i) = prescr_kev(j) + end do + + if ( ionos_epotential_amie ) then + call outfld('amie_efx_phys', pbuf_efx, pcols, lchnk) + call outfld('amie_kev_phys', pbuf_kev, pcols, lchnk) + endif + if ( ionos_epotential_ltr) then + call outfld('ltr_efx_phys', pbuf_efx, pcols, lchnk ) + call outfld('ltr_kev_phys', pbuf_kev, pcols, lchnk ) + end if + end do chnk_loop1 + + deallocate(prescr_efx, prescr_kev) + nullify(prescr_efx) + nullify(prescr_kev) + + else + + ! set cross tail potential before physics -- + ! aurora uses weimer derived potential + call d_pie_epotent( ionos_epotential_model, epot_crit_colats ) + + end if prescribed_epot + + end subroutine ionosphere_run1 + + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + 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 + use shr_assert_mod, only: shr_assert_in_domain + + ! - pull some fields from pbuf and dyn_in + ! - invoke ionosphere/electro-dynamics coupling + ! - push some fields back to physics via pbuf... + + ! args + type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! local vars + integer :: i,j,k, lchnk + integer :: astat + + type(physics_buffer_desc), pointer :: pbuf_chnk(:) + + real(r8), pointer :: sigma_ped_phys(:,:) ! Pedersen Conductivity from pbuf + real(r8), pointer :: sigma_hall_phys(:,:) ! Hall Conductivity from pbuf + real(r8), pointer :: te_phys(:,:) ! te from pbuf + real(r8), pointer :: ti_phys(:,:) ! ti from pbuf + real(r8), pointer :: mmrPO2p_phys(:,:) ! O2+ from pbuf + real(r8), pointer :: mmrPNOp_phys(:,:) ! NO+ from pbuf + real(r8), pointer :: mmrPN2p_phys(:,:) ! N2+ from pbuf + real(r8), pointer :: mmrPOp_phys(:,:) ! O+ from pbuf + ! + ! Empirical ion drifts from exbdrift (to be converted to blocked for dpie_coupling): + real(r8), pointer :: ui_phys(:,:) ! zonal ion drift from pbuf + real(r8), pointer :: vi_phys(:,:) ! meridional ion drift from pbuf + real(r8), pointer :: wi_phys(:,:) ! vertical ion drift from pbuf + + integer :: ncol + + integer :: blksize ! number of columns in 2D block + + real(r8), pointer :: sigma_ped_blck (:,:) + real(r8), pointer :: sigma_hall_blck(:,:) + real(r8), pointer :: ti_blck(:,:) + real(r8), pointer :: te_blck(:,:) + real(r8), pointer :: zi_blck(:,:) ! Geopotential on interfaces + real(r8), pointer :: hi_blck(:,:) ! Geometric height on interfaces + real(r8), pointer :: ui_blck(:,:) + real(r8), pointer :: vi_blck(:,:) + real(r8), pointer :: wi_blck(:,:) + real(r8), pointer :: omega_blck(:,:) + real(r8), pointer :: tn_blck(:,:) + + ! From physics state + real(r8), pointer :: u_blck(:,:) + real(r8), pointer :: v_blck(:,:) + real(r8), pointer :: pmid_blck(:,:) + real(r8), pointer :: phis(:) ! surface geopotential + ! Constituents + real(r8), pointer :: n2mmr_blck(:,:) + real(r8), pointer :: o2mmr_blck(:,:) + real(r8), pointer :: o1mmr_blck(:,:) + real(r8), pointer :: h1mmr_blck(:,:) + real(r8), pointer :: o2pmmr_blck(:,:) ! O2+ (blocks) + real(r8), pointer :: nopmmr_blck(:,:) ! NO+ (blocks) + real(r8), pointer :: n2pmmr_blck(:,:) ! N2+ (blocks) + real(r8), pointer :: opmmr_blck(:,:) ! O+ (blocks) + real(r8), pointer :: opmmrtm1_blck(:,:) ! O+ previous time step (blocks) + real(r8), pointer :: mbar_blck(:,:) ! mean molecular weight + ! Temp fields for outfld + real(r8) :: r8tmp + real(r8), pointer :: tempm(:,:) => null() ! Temp midpoint field for outfld + real(r8), pointer :: tempi(:,:) => null() ! Temp interface field for outfld + real(r8), parameter :: n2min = 1.e-6_r8 ! lower limit of N2 mixing ratios + + character(len=*), parameter :: subname = 'ionosphere_run2' + + ionos_cpl: if (ionos_xport_active) then + + blksize = 0 + do lchnk = begchunk, endchunk + blksize = blksize + get_ncols_p(lchnk) + end do - beglonxy = get_dyn_grid_parm('beglonxy') - endlonxy = get_dyn_grid_parm('endlonxy') - beglatxy = get_dyn_grid_parm('beglatxy') - endlatxy = get_dyn_grid_parm('endlatxy') - - lcnt = (endlatxy-beglatxy+1)*nlev*(endlonxy-beglonxy+1) - allocate(ldof(lcnt)) - ldof(:) = 0 - - lcnt = 0 - do k = 1, nlev - do j = beglatxy, endlatxy - do i = beglonxy, endlonxy - lcnt = lcnt + 1 - ldof(lcnt) = i + (j-(plat-hdim2+1))*hdim1+(k-1)*hdim1*hdim2 + allocate(phis(pcols), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate phis') + end if + allocate(u_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate u_blck') + end if + allocate(v_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate v_blck') + end if + allocate(sigma_ped_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate sigma_ped_blck') + end if + allocate(sigma_hall_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate sigma_hall_blck') + end if + allocate(ti_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate ti_blck') + end if + allocate(hi_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate hi_blck') + end if + allocate(te_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate te_blck') + end if + allocate(zi_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate zi_blck') + end if + allocate(ui_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate ui_blck') + end if + allocate(vi_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate vi_blck') + end if + allocate(wi_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate wi_blck') + end if + allocate(omega_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate omega_blck') + end if + allocate(tn_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate tn_blck') + end if + allocate(n2mmr_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate n2mmr_blck') + end if + allocate(o2mmr_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate o2mmr_blck') + end if + allocate(o1mmr_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate o1mmr_blck') + end if + allocate(h1mmr_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate h1mmr_blck') + end if + allocate(mbar_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate mbar_blck') + end if + allocate(pmid_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate pmid_blck') + end if + + allocate(opmmrtm1_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate opmmrtm1_blck') + end if + + if (sIndxOp > 0) then + allocate(opmmr_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate opmmr_blck') + end if + end if + if (sIndxO2p > 0) then + allocate(o2pmmr_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate o2pmmr_blck') + end if + end if + if (sIndxNOp > 0) then + allocate(nopmmr_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate nopmmr_blck') + end if + end if + if (sIndxN2p > 0) then + allocate(n2pmmr_blck(pver, blksize), stat=astat) + if (astat /= 0) then + call endrun(subname//': failed to allocate n2pmmr_blck') + end if + end if + + if (hist_fld_active('Z3GM')) then + allocate(tempm(pcols, pver)) + end if + + if (hist_fld_active('Z3GMI')) then + allocate(tempi(pcols, pver)) + end if + + if (.not.opmmrtm1_initialized) then + do lchnk = begchunk, endchunk + ncol = get_ncols_p(lchnk) + + if (sIndxOp > 0) then + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPOp_phys, start=(/1,1,sIndxOp/), kount=(/pcols,pver,1/) ) + opmmrtm1_phys(:ncol,:pver,lchnk) = mmrPOp_phys(:ncol,:pver) + else + opmmrtm1_phys(:ncol,:pver,lchnk) = phys_state(lchnk)%q(:ncol,:pver, ixop) + endif + enddo + opmmrtm1_initialized=.true. + endif + + j = 0 + do lchnk = begchunk, endchunk + ncol = get_ncols_p(lchnk) + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + + ! Gather data stored in pbuf and collect into blocked arrays + ! Get Pedersen and Hall conductivities: + call pbuf_get_field(pbuf_chnk, index_ped, sigma_ped_phys) + call pbuf_get_field(pbuf_chnk, index_hall, sigma_hall_phys) + ! Get ion and electron temperatures + call pbuf_get_field(pbuf_chnk, index_te, te_phys) + call pbuf_get_field(pbuf_chnk, index_ti, ti_phys) + ! Get components of ion drift velocities + call pbuf_get_field(pbuf_chnk, index_ui, ui_phys) + call pbuf_get_field(pbuf_chnk, index_vi, vi_phys) + call pbuf_get_field(pbuf_chnk, index_wi, wi_phys) + !-------------------------------------------------------- + ! Get ions from physics buffer if non-transported + !-------------------------------------------------------- + if (sIndxO2p > 0) then + call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPO2p_phys, & + start=(/1,1,sIndxO2p/), kount=(/pcols,pver,1/) ) + end if + if (sIndxNOp > 0) then + call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPNOp_phys, & + start=(/1,1,sIndxNOp/), kount=(/pcols,pver,1/) ) + end if + if (sIndxN2p > 0) then + call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPN2p_phys, & + start=(/1,1,sIndxN2p/), kount=(/pcols,pver,1/) ) + end if + if (sIndxOp > 0) then + call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPOp_phys, & + start=(/1,1,sIndxOp/), kount=(/pcols,pver,1/) ) + end if + + ! PHIS is from physics state + phis(:ncol) = phys_state(lchnk)%phis(:ncol) + do i = 1, ncol + j = j + 1 + do k = 1, pver + ! physics state fields on levels + u_blck(k, j) = phys_state(lchnk)%u(i, k) + v_blck(k, j) = phys_state(lchnk)%v(i, k) + !------------------------------------------------------------ + ! Might need geometric height on midpoints for output + !------------------------------------------------------------ + if (hist_fld_active('Z3GM')) then + ! geometric altitude (meters above sea level) + tempm(i,k) = geometric_hgt(zgp=phys_state(lchnk)%zm(i,k), zsf=phis(i)*rga) + end if + ! physics state fields on interfaces (but only to pver) + zi_blck(k, j) = phys_state(lchnk)%zi(i, k) + phis(i)*rga + !------------------------------------------------------------ + ! Convert geopotential to geometric height at interfaces: + !------------------------------------------------------------ + ! Note: zht is pver instead of pverp because dynamo does not + ! use bottom interface + hi_blck(k,j) = geometric_hgt(zgp=phys_state(lchnk)%zi(i,k), zsf=phis(i)*rga) + if (hist_fld_active('Z3GMI')) then + tempi(i,k) = hi_blck(k, j) + end if + omega_blck(k, j) = phys_state(lchnk)%omega(i, k) + tn_blck(k, j) = phys_state(lchnk)%t(i, k) + pmid_blck(k, j) = phys_state(lchnk)%pmid(i, k) + ! Pedersen and Hall conductivities: + sigma_ped_blck(k, j) = sigma_ped_phys(i, k) + sigma_hall_blck(k, j) = sigma_hall_phys(i, k) + ! ion and electron temperatures + te_blck(k, j) = te_phys(i, k) + ti_blck(k, j) = ti_phys(i, k) + ! components of ion drift velocities + ui_blck(k, j) = ui_phys(i, k) + vi_blck(k, j) = vi_phys(i, k) + wi_blck(k, j) = wi_phys(i, k) + !------------------------------------------------------------ + ! ions from physics state if transported, otherwise from pbuf + !------------------------------------------------------------ + if (ixo2p > 0) then + o2pmmr_blck(k, j) = phys_state(lchnk)%q(i, k, ixo2p) + else if (sIndxO2p > 0) then + o2pmmr_blck(k, j) = mmrPO2p_phys(i, k) + else + call endrun(subname//': No source for O2p') + end if + if (ixnop > 0) then + nopmmr_blck(k, j) = phys_state(lchnk)%q(i, k, ixnop) + else if (sIndxNOp > 0) then + nopmmr_blck(k, j) = mmrPNOp_phys(i, k) + else + call endrun(subname//': No source for NOp') + end if + if (ixn2p > 0) then + n2pmmr_blck(k, j) = phys_state(lchnk)%q(i, k, ixn2p) + else if (sIndxN2p > 0) then + n2pmmr_blck(k, j) = mmrPN2p_phys(i, k) + else + call endrun(subname//': No source for N2p') + end if + if (ixop > 0) then + opmmr_blck(k, j) = phys_state(lchnk)%q(i, k, ixop) + else if (sIndxOp > 0) then + opmmr_blck(k, j) = mmrPOp_phys(i, k) + else + call endrun(subname//': No source for Op') + end if + opmmrtm1_blck(k, j) = opmmrtm1_phys(i, k, lchnk) + !------------------------------------ + ! neutrals from advected tracers array + !------------------------------------ + o2mmr_blck(k, j) = phys_state(lchnk)%q(i, k, ixo2) + o1mmr_blck(k, j) = phys_state(lchnk)%q(i, k, ixo) + h1mmr_blck(k, j) = phys_state(lchnk)%q(i, k, ixh) + end do + end do ! do i = 1, ncol + + !------------------------------------------------------------------ + ! Save OMEGA and analytically derived geometric height + !------------------------------------------------------------------ + if (hist_fld_active('Z3GM')) then + tempm(ncol+1:, :) = 0.0_r8 + call outfld('Z3GM', tempm, pcols, lchnk) + end if + if (hist_fld_active('Z3GMI')) then + tempi(ncol+1:, :) = 0.0_r8 + call outfld('Z3GMI', tempi, pcols, lchnk) + end if + end do ! do lchnk = begchunk, endchunk + + !--------------------------------------------------------------------- + ! Compute and save mean molecular weight: + !--------------------------------------------------------------------- + j = 0 + do lchnk = begchunk, endchunk + ncol = get_ncols_p(lchnk) + do i = 1, ncol + j = j + 1 + do k = 1, pver + r8tmp = o1mmr_blck(k,j) + o2mmr_blck(k,j) + h1mmr_blck(k,j) + n2mmr_blck(k, j) = max(1.0_r8 - r8tmp, n2min) + r8tmp = o1mmr_blck(k, j) / rmassO1 + r8tmp = r8tmp + (o2mmr_blck(k, j) / rmassO2) + r8tmp = r8tmp + (h1mmr_blck(k, j) / rmassH) + r8tmp = r8tmp + (n2mmr_blck(k, j) / rmassN2) + mbar_blck(k, j) = 1.0_r8 / r8tmp + end do + end do end do - end do - end do -end function get_restart_decomp + call t_startf('d_pie_coupling') + + ! 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 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, 1, blksize, pver) + + call t_stopf ('d_pie_coupling') + + if (state_debug_checks) then + call shr_assert_in_domain(ui_blck, is_nan=.false., varname="ui_blck", msg="NaN found in ionosphere_run2") + call shr_assert_in_domain(vi_blck, is_nan=.false., varname="vi_blck", msg="NaN found in ionosphere_run2") + call shr_assert_in_domain(wi_blck, is_nan=.false., varname="wi_blck", msg="NaN found in ionosphere_run2") + call shr_assert_in_domain(opmmr_blck, is_nan=.false., varname="opmmr_blck", msg="NaN found in ionosphere_run2") + end if + + ! + !---------------------------------------- + ! Put data back in to state or pbuf + !---------------------------------------- + ! blocks --> physics chunks + + j = 0 + do lchnk = begchunk, endchunk + ncol = phys_state(lchnk)%ncol + pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk) + + call pbuf_get_field(pbuf_chnk, index_ui, ui_phys) + call pbuf_get_field(pbuf_chnk, index_vi, vi_phys) + call pbuf_get_field(pbuf_chnk, index_wi, wi_phys) + if (sIndxOp > 0) then + call pbuf_get_field(pbuf_chnk, slvd_pbf_ndx, mmrPOp_phys, & + start=(/1,1,sIndxOp/), kount=(/pcols,pver,1/)) + end if + do i = 1, ncol + j = j + 1 + do k = 1, pver + ui_phys(i, k) = ui_blck(k, j) + vi_phys(i, k) = vi_blck(k, j) + wi_phys(i, k) = wi_blck(k, j) + if (ixop > 0) then + phys_state(lchnk)%q(i, k, ixop) = opmmr_blck(k, j) + else if (sIndxOp > 0) then + mmrPOp_phys(i, k) = opmmr_blck(k, j) + else + call endrun(subname//': No destination for Op') + end if + opmmrtm1_phys(i,k,lchnk) = opmmrtm1_blck(k,j) + end do + end do + + if (ionos_edyn_active) then + call outfld('UI', ui_phys, pcols, lchnk) + call outfld('VI', vi_phys, pcols, lchnk) + call outfld('WI', wi_phys, pcols, lchnk) + if (write_inithist()) then + call outfld('UI&IC', ui_phys, pcols, lchnk) + call outfld('VI&IC', vi_phys, pcols, lchnk) + call outfld('WI&IC', wi_phys, pcols, lchnk) + end if + end if + end do -!========================================================================================= + if (associated(opmmr_blck)) then + deallocate(opmmr_blck) + nullify(opmmr_blck) + end if + if (associated(o2pmmr_blck)) then + deallocate(o2pmmr_blck) + nullify(o2pmmr_blck) + end if + if (associated(nopmmr_blck)) then + deallocate(nopmmr_blck) + nullify(nopmmr_blck) + end if + if (associated(n2pmmr_blck)) then + deallocate(n2pmmr_blck) + nullify(n2pmmr_blck) + end if + if (associated(tempi)) then + deallocate(tempi) + nullify(tempi) + end if + if (associated(tempm)) then + deallocate(tempm) + nullify(tempm) + end if + deallocate(opmmrtm1_blck) + nullify(opmmrtm1_blck) + deallocate(phis) + nullify(phis) + deallocate(u_blck) + nullify(u_blck) + deallocate(v_blck) + nullify(v_blck) + deallocate(sigma_ped_blck) + nullify(sigma_ped_blck) + deallocate(sigma_hall_blck) + nullify(sigma_hall_blck) + deallocate(ti_blck) + nullify(ti_blck) + deallocate(hi_blck) + nullify(hi_blck) + deallocate(te_blck) + nullify(te_blck) + deallocate(zi_blck) + nullify(zi_blck) + deallocate(ui_blck) + nullify(ui_blck) + deallocate(vi_blck) + nullify(vi_blck) + deallocate(wi_blck) + nullify(wi_blck) + deallocate(omega_blck) + nullify(omega_blck) + deallocate(tn_blck) + nullify(tn_blck) + deallocate(n2mmr_blck) + nullify(n2mmr_blck) + deallocate(o2mmr_blck) + nullify(o2mmr_blck) + deallocate(o1mmr_blck) + nullify(o1mmr_blck) + deallocate(h1mmr_blck) + nullify(h1mmr_blck) + deallocate(mbar_blck) + nullify(mbar_blck) + deallocate(pmid_blck) + nullify(pmid_blck) + + end if ionos_cpl + + end subroutine ionosphere_run2 + + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + subroutine ionosphere_init_restart(File) + use pio, only: file_desc_t, pio_double, pio_def_var + use cam_pio_utils, only: cam_pio_def_dim + use cam_grid_support, only: cam_grid_id, cam_grid_write_attr + use cam_grid_support, only: cam_grid_header_info_t + + type(File_desc_t), intent(inout) :: File + + integer :: grid_id + integer :: hdimcnt, ierr, i + integer :: dimids(3), ndims + type(cam_grid_header_info_t) :: info + + if (ionos_xport_active) then + grid_id = cam_grid_id('physgrid') + call cam_grid_write_attr(File, grid_id, info) + hdimcnt = info%num_hdims() + do i = 1, hdimcnt + dimids(i) = info%get_hdimid(i) + end do + ndims = hdimcnt + 1 + + call cam_pio_def_dim(File, 'lev', pver, dimids(ndims), & + existOK=.true.) + + ierr = pio_def_var(File, 'Optm1', pio_double, dimids(1:ndims), & + Optm1_vdesc) + end if + end subroutine ionosphere_init_restart + + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + subroutine ionosphere_write_restart(File) + use pio, only: io_desc_t, file_desc_t, pio_write_darray + use pio, only: pio_double + use cam_grid_support, only: cam_grid_id, cam_grid_write_var + use cam_grid_support, only: cam_grid_get_decomp, cam_grid_dimensions + use phys_grid, only: phys_decomp + + type(file_desc_t), intent(inout) :: File + + integer :: ierr + integer :: physgrid + integer :: dims(3), gdims(3) + integer :: nhdims + type(io_desc_t), pointer :: iodesc3d + + if (ionos_xport_active) then + + ! Write grid vars + call cam_grid_write_var(File, phys_decomp) + + physgrid = cam_grid_id('physgrid') + call cam_grid_dimensions(physgrid, gdims(1:2), nhdims) + nhdims = nhdims + 1 + gdims(nhdims) = pver + dims(1) = pcols + dims(2) = pver + dims(3) = endchunk - begchunk + 1 + call cam_grid_get_decomp(physgrid, dims(1:3), gdims(1:nhdims), & + pio_double, iodesc3d) + + call pio_write_darray(File, Optm1_vdesc, iodesc3d, opmmrtm1_phys, ierr) + end if + + end subroutine ionosphere_write_restart + + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + subroutine ionosphere_read_restart(File) + use pio, only: io_desc_t, file_desc_t, pio_inq_varid + use pio, only: pio_read_darray, pio_double + use cam_grid_support, only: cam_grid_id + use cam_grid_support, only: cam_grid_get_decomp, cam_grid_dimensions + + type(file_desc_t), intent(inout) :: File + + integer :: ierr + integer :: physgrid + integer :: dims(3), gdims(3) + integer :: nhdims + type(io_desc_t), pointer :: iodesc3d + + if (ionos_xport_active) then + call ionosphere_alloc() + + physgrid = cam_grid_id('physgrid') + call cam_grid_dimensions(physgrid, gdims(1:2), nhdims) + nhdims = nhdims + 1 + gdims(nhdims) = pver + dims(1) = pcols + dims(2) = pver + dims(3) = endchunk - begchunk + 1 + call cam_grid_get_decomp(physgrid, dims(1:3), gdims(1:nhdims), & + pio_double, iodesc3d) + + ierr = pio_inq_varid(File, 'Optm1', Optm1_vdesc) + call pio_read_darray(File, Optm1_vdesc, iodesc3d, opmmrtm1_phys, ierr) + opmmrtm1_initialized = .true. + end if + + end subroutine ionosphere_read_restart + + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + subroutine ionosphere_final + + use edyn_esmf, only: edyn_esmf_final + + call edyn_esmf_final() + + if (allocated(opmmrtm1_phys)) then + deallocate(opmmrtm1_phys) + end if + + end subroutine ionosphere_final + + !=========================================================================== + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + subroutine ionosphere_read_ic() + + use pio, only: file_desc_t + use ncdio_atm, only: infld + use cam_initfiles, only: initial_file_get_id + use cam_grid_support, only: cam_grid_check, cam_grid_id + use cam_grid_support, only: cam_grid_get_dim_names + + type(file_desc_t), pointer :: fh_ini ! PIO filehandle + + integer :: grid_id ! grid ID for data mapping + character(len=8) :: dim1name, dim2name + logical :: readvar + character(len=*), parameter :: subname = 'ionosphere_read_ic' + + if ( ionos_xport_active ) then + call ionosphere_alloc() + + fh_ini => initial_file_get_id() + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(trim(subname)//': Internal error, no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + + ! try reading in OpTM1 from the IC file + call infld('OpTM1', fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, & + begchunk, endchunk, opmmrtm1_phys, readvar, gridname='physgrid') + if (.not. readvar) then + ! if OpTM1 is not included in the IC file then try using O+ + call infld('Op', fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, & + begchunk, endchunk, opmmrtm1_phys, readvar, gridname='physgrid') + end if + opmmrtm1_initialized = readvar + end if + + end subroutine ionosphere_read_ic + + !--------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + subroutine ionosphere_alloc() + use infnan, only: nan, assignment(=) + integer :: astat + + if (.not. allocated(opmmrtm1_phys)) then + allocate(opmmrtm1_phys(pcols, pver, begchunk:endchunk), stat=astat) + if (astat /= 0) then + call endrun('ionosphere_alloc: failed to allocate opmmrtm1_phys') + end if + opmmrtm1_phys = nan + opmmrtm1_initialized = .false. + end if + + end subroutine ionosphere_alloc + + !========================================================================== + + ! calculates geometric height (meters above sea level) + pure function geometric_hgt( zgp, zsf ) result(zgm) + + real(r8), intent(in) :: zgp ! geopotential height (m) + real(r8), intent(in) :: zsf ! surface height above sea level (m) + real(r8) :: zgm ! geometric height above sea level (m) + + real(r8) :: tmp + + ! Hanli's formulation: + ! Z_gm = 1/(1 - (1+Zs/r) * Z_gp/r) * (Zs + (1+Zs/r) * Z_gp) + ! Z_gm: geometric height + ! Zs: Surface height + ! Z_gp: model calculated geopotential height (zm and zi in the model) + + tmp = 1._r8+zsf*rearth_inv + zgm = (zsf + tmp*zgp) / (1._r8 - tmp*zgp*rearth_inv) + end function geometric_hgt end module ionosphere_interface diff --git a/src/ionosphere/waccmx/ltr_module.F90 b/src/ionosphere/waccmx/ltr_module.F90 new file mode 100644 index 0000000000..ccd2f1a7c5 --- /dev/null +++ b/src/ionosphere/waccmx/ltr_module.F90 @@ -0,0 +1,506 @@ +module ltr_module + ! + ! Module used to read data from the LFM/LTR outputs (POT,mean energy, + ! and energy flux). + ! + + use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use edyn_maggrid, only: nmlat, nmlonp1 + use edyn_maggrid, only: ylonm ! magnetic latitudes (nmlat) (radians) + use edyn_maggrid, only: ylatm ! magnetic longtitudes (nmlonp1) (radians) + use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile + use pio, only: pio_inq_dimid, pio_inquire_dimension + use pio, only: pio_inquire, pio_inq_varid + use pio, only: file_desc_t, pio_noerr, pio_nowrite, pio_get_var + use utils_mod, only: check_ncerr, check_alloc + use edyn_mpi, only: ntask, mytid + use edyn_params, only: pi, dtr, rtd + use input_data_utils, only: time_coordinate + + implicit none + + private + public :: init_ltr + public :: getltr + + ! Grid dimension sizes for LTR input data file: + integer :: lonp1,latp1 + ! + ! Define fields for LTR input data file: + ! electric potential in Volt + ! mean energy in KeV + ! energy flux in W/m^2 + ! Time interpolated LTR outputs with suffix _ltr + ! + real(r8),allocatable,dimension(:,:,:) :: & ! (lonp1,latp1,ntimes) + pot_input, ekv_input, efx_input + real(r8),allocatable,dimension(:,:) :: & ! (lonp1,latp1) + pot_ltr, ekv_ltr, efx_ltr + integer, allocatable,dimension(:) :: & ! (ntimes) + year,month,day,jday + real(r8), allocatable,dimension(:) :: & ! (ntimes) + hpi_input, pcp_input, ltr_ut + real(r8) :: hpi_ltr, pcp_ltr + ! + type(file_desc_t) :: ncid + + character(len=cl), allocatable :: ltr_files(:) + integer :: num_files, file_ndx + + type(time_coordinate) :: time_coord + +contains + + !----------------------------------------------------------------------- + subroutine init_ltr(ltr_list) + + character(len=*),intent(in) :: ltr_list(:) + + integer :: n, nfiles + + nfiles = size(ltr_list) + num_files = 0 + + count_files: do n = 1,nfiles + if (len_trim(ltr_list(n))<1 .or. & + trim(ltr_list(n))=='NONE') then + exit count_files + else + num_files = num_files + 1 + end if + end do count_files + + allocate(ltr_files(num_files)) + ltr_files(:num_files) = ltr_list(:num_files) + file_ndx = 1 + call open_files() + + end subroutine init_ltr + + !----------------------------------------------------------------------- + subroutine rdltr(ltrfile) + ! + ! Read LTR data + ! + character(len=*), intent(in) :: ltrfile + ! Local: + integer :: istat, ntimes, ndims, nvars, ngatts, ier + integer :: idunlim + integer :: id_lon, id_lat, id_time + integer :: idv_year, idv_mon, idv_day, idv_jday + integer :: idv_ut, idv_hpi, idv_pcp + character(len=*), parameter :: subname = 'rdltr' + + ! + ! + if (masterproc) then + write(iulog, "(/, 72('-'))") + write(iulog, "(a, ': read LTR data:')") subname + end if + ! + ! Open netcdf file: + call cam_pio_openfile(ncid, ltrfile, pio_nowrite) + ! + ! Get LTR grid dimension: + istat = pio_inq_dimid(ncid, 'lon', id_lon) + istat = pio_inquire_dimension(ncid, id_lon, len=lonp1) + call check_ncerr(istat, subname, 'LTR longitude dimension') + + istat = pio_inq_dimid(ncid, 'lat', id_lat) + istat = pio_inquire_dimension(ncid, id_lat, len=latp1) + call check_ncerr(istat, subname, 'LTR latitude dimension') + + call time_coord%initialize( ltrfile, set_weights=.false. ) + ! + ! Get time dimension: + istat = pio_inquire(ncid, unlimiteddimid=id_time) + istat = pio_inquire_dimension(ncid, id_time, len=ntimes) + call check_ncerr(istat, subname, 'LTR time dimension') + ! + ! Search for requested LTR output fields + istat = pio_inquire(ncid,ndims,nvars,ngatts,idunlim) + ! + ! Get 1-D LTR fields (ntimes) + if (.not. allocated(year)) then + allocate(year(ntimes), stat=ier) + call check_alloc(ier, subname, 'year', ntimes=ntimes) + end if + istat = pio_inq_varid(ncid, 'year', idv_year) + call check_ncerr(istat, subname, 'LTR year id') + istat = pio_get_var(ncid, idv_year, year) + call check_ncerr(istat, subname, 'LTR year') + + if (.not. allocated(month)) then + allocate(month(ntimes), stat=ier) + call check_alloc(ier, subname, 'month', ntimes=ntimes) + end if + istat = pio_inq_varid(ncid, 'month', idv_mon) + call check_ncerr(istat, subname, 'LTR month id') + istat = pio_get_var(ncid, idv_mon, month) + call check_ncerr(istat, subname, 'LTR month') + if (.not. allocated(day)) then + allocate(day(ntimes), stat=ier) + call check_alloc(ier, subname, 'day', ntimes=ntimes) + end if + istat = pio_inq_varid(ncid, 'day', idv_day) + call check_ncerr(istat, subname, 'LTR day id') + istat = pio_get_var(ncid, idv_day, day) + call check_ncerr(istat, subname, 'LTR day') + + if (.not. allocated(jday)) then + allocate(jday(ntimes), stat=ier) + call check_alloc(ier, subname, 'jday', ntimes=ntimes) + end if + istat = pio_inq_varid(ncid, 'jday', idv_jday) + call check_ncerr(istat, subname, 'LTR jday id') + istat = pio_get_var(ncid, idv_jday, jday) + call check_ncerr(istat, subname, 'LTR jday') + ! + ! Allocate 1-d fields: + if (.not. allocated(ltr_ut)) then + allocate(ltr_ut(ntimes), stat=ier) + call check_alloc(ier, subname, 'ltr_ut', ntimes=ntimes) + end if + if (.not. allocated(hpi_input)) then + allocate(hpi_input(ntimes), stat=ier) + call check_alloc(ier, subname, 'hpi_input', ntimes=ntimes) + end if + if (.not. allocated(pcp_input)) then + allocate(pcp_input(ntimes), stat=ier) + call check_alloc(ier, subname, 'pcp_input', ntimes=ntimes) + end if + ! + ! Get ut + istat = pio_inq_varid(ncid, 'ut', idv_ut) + call check_ncerr(istat, subname, 'LTR ut id') + istat = pio_get_var(ncid, idv_ut, ltr_ut) + call check_ncerr(istat, subname, 'LTR ut') + ! + ! Get HPI + istat = pio_inq_varid(ncid, 'hpiN', idv_hpi) + call check_ncerr(istat, subname, 'LTR hpi id') + istat = pio_get_var(ncid, idv_hpi, hpi_input) + call check_ncerr(istat, subname, 'LTR hpi') + ! + ! Get PCP + istat = pio_inq_varid(ncid, 'pcpN', idv_pcp) + call check_ncerr(istat, subname, 'LTR pcp id') + istat = pio_get_var(ncid, idv_pcp, pcp_input) + call check_ncerr(istat, subname, 'LTR pcp') + ! + ! Allocate 2-d fields: + if (.not. allocated(pot_ltr)) then + allocate(pot_ltr(lonp1, latp1), stat=ier) + call check_alloc(ier, subname, 'pot_ltr', lonp1=lonp1, latp1=latp1) + end if + if (.not. allocated(ekv_ltr)) then + allocate(ekv_ltr(lonp1, latp1), stat=ier) + call check_alloc(ier, subname, 'ekv_ltr', lonp1=lonp1, latp1=latp1) + end if + if (.not. allocated(efx_ltr)) then + allocate(efx_ltr(lonp1, latp1), stat=ier) + call check_alloc(ier, subname, 'efx_ltr', lonp1=lonp1, latp1=latp1) + end if + ! + ! Allocate 3-d fields: + if (.not. allocated(pot_input)) then + allocate(pot_input(lonp1, latp1, 2), stat=ier) + call check_alloc(ier, subname, 'pot_input', & + lonp1=lonp1, latp1=latp1, ntimes=ntimes) + end if + if (.not. allocated(ekv_input)) then + allocate(ekv_input(lonp1, latp1, 2), stat=ier) + call check_alloc(ier, subname, 'ekv_input', & + lonp1=lonp1, latp1=latp1, ntimes=ntimes) + end if + if (.not. allocated(efx_input)) then + allocate(efx_input(lonp1, latp1, 2), stat=ier) + call check_alloc(ier, subname, 'efx_input', & + lonp1=lonp1, latp1=latp1, ntimes=ntimes) + end if + end subroutine rdltr + + !----------------------------------------------------------------------- + subroutine update_3d_fields( ncid, offset, kount, pot_3d,ekv_3d,efx_3d ) + + type(file_desc_t), intent(in) :: ncid + integer, intent(in) :: offset(:) + integer, intent(in) :: kount(:) + real(r8),intent(out) :: pot_3d(:,:,:) + real(r8),intent(out) :: ekv_3d(:,:,:) + real(r8),intent(out) :: efx_3d(:,:,:) + + + integer :: istat + integer :: idv_pot,idv_ekv, idv_efx + character(len=*), parameter :: subname = 'update_3d_fields' + + ! + ! Get 3-D fields (lon,lat,ntimes) + ! + ! electric potential + istat = pio_inq_varid(ncid, 'pot', idv_pot) + call check_ncerr(istat, subname, 'LTR pot id') + istat = pio_get_var(ncid, idv_pot, offset, kount, pot_3d) + call check_ncerr(istat, subname, 'LTR pot') + ! + ! mean energy + istat = pio_inq_varid(ncid, 'ekv', idv_ekv) + call check_ncerr(istat, subname, 'LTR ekv id') + istat = pio_get_var(ncid, idv_ekv, offset, kount, ekv_3d) + call check_ncerr(istat, subname, 'LTR ekv') + ! + ! energy flux + istat = pio_inq_varid(ncid, 'efx', idv_efx) + call check_ncerr(istat, subname, 'LTR efx id') + istat = pio_get_var(ncid, idv_efx, offset, kount, efx_3d) + call check_ncerr(istat, subname, 'LTR efx') + + end subroutine update_3d_fields + + !----------------------------------------------------------------------- + subroutine getltr(iyear, imo, iday, iutsec, sunlon, iprint, & + iltr, phihm, ltr_efxm, ltr_kevm) + use cam_history_support, only: fillvalue + use rgrd_mod, only: rgrd2 + ! + ! Read LTR outputs from ltr_ncfile file, returning electric potential, + ! auroral mean energy and energy flux at current date and time, + ! and the data is linearly interpolated to the model time + ! + ! + ! Args: + + integer, intent(in) :: iyear + integer, intent(in) :: imo + integer, intent(in) :: iday + real(r8), intent(in) :: sunlon + integer, intent(in) :: iutsec + integer, intent(in) :: iprint + integer, intent(out) :: iltr + real(r8), intent(out) :: phihm(nmlonp1,nmlat) + real(r8), intent(out) :: ltr_efxm(nmlonp1,nmlat) ! on geomag grid + real(r8), intent(out) :: ltr_kevm(nmlonp1,nmlat) ! on geomag grid + ! + ! + ! Local: + real(r8) :: potm(lonp1,latp1) + real(r8) :: efxm(lonp1,latp1), ekvm(lonp1,latp1) + real(r8) :: alat(latp1), alon(lonp1) + real(r8) :: alatm(latp1), alonm(lonp1) + integer :: ier, lw, liw, intpol(2) + integer, allocatable :: iw(:) + real(r8), allocatable :: w(:) + integer :: i, j, ithmx + integer :: nn, iset2, iset1, m, mp1, n + real(r8) :: f1, f2 + real(r8) :: del, xmlt, dmlat, dlatm, dlonm, dmltm, rot + integer :: offset(3), kount(3) + character(len=*), parameter :: subname = 'getltr' + + phihm = fillvalue + ltr_efxm = fillvalue + ltr_kevm = fillvalue + + if (iprint > 0 .and. masterproc) then + write(iulog,"(/,72('-'))") + write(iulog,"(a,':')") subname + write(iulog,"(a,i4,', iday = ',i3,', iutsec = ',i10)") & + 'Initial requested iyear= ', iyear, iday, iutsec + end if + + nn = size(ltr_ut) + + ! + ! Check times: + ! + iltr = 1 - time_coord%times_check() + + check_loop: do while( iltr/=1 ) + + if (masterproc) write(iulog,*) 'file_ndx = ',file_ndx + + if (iltr==2) then + if (masterproc) then + write(iulog, "(a,': Model date prior to LTR first date:',3I5)") & + subname, year(1), month(1), day(1) + end if + return + endif + + if (iltr==0) then + if (masterproc) then + write(iulog, "(a,': Model date beyond the LTR last Data:',3I5)") & + subname, year(nn), month(nn), day(nn) + end if + + if (file_ndx lonp1) mp1 = 2 + del = xmlt - (m-1)*dmltm + ! Put in LTR arrays from south pole to north pole + do j=1,latp1 + potm(i,j) = (1._r8-del)*pot_ltr(m,j) + & + del*pot_ltr(mp1,j) + ekvm(i,j) = (1._r8-del)*ekv_ltr(m,j) + & + del*ekv_ltr(mp1,j) + if (ekvm(i,j) == 0._r8) ekvm(i,j)=1._r8 + efxm(i,j) = (1._r8-del)*efx_ltr(m,j) + & + del*efx_ltr(mp1,j) + end do + + end do + + ! Set up coeffs to go between EPOTM(IMXMP,JMNH) and TIEPOT(IMAXM,JMAXMH) + + ! **** SET GRID SPACING DLATM, DLONG, DLONM + ! DMLAT=lat spacing in degrees of LTR apex grid + dmlat = 180._r8 / real(latp1-1, kind=r8) + dlatm = dmlat * dtr + dlonm = 2._r8 * pi / real(lonp1, kind=r8) + dmltm = 24._r8 / real(lonp1, kind=r8) + ! **** + ! **** SET ARRAY YLATM (LATITUDE VALUES FOR GEOMAGNETIC GRID + ! **** + alatm(1) = -pi / 2._r8 + alat(1) = -90._r8 + alatm(latp1) = pi / 2._r8 + alat(latp1) = 90._r8 + ithmx = (latp1+1)/2 + do i = 2, ithmx + alat(i) = alat(i-1)+dlatm*rtd + alat(latp1+1-i) = alat(latp1+2-i)-dlatm*rtd + alatm(i) = alatm(i-1)+dlatm + alatm(latp1+1-i) = alatm(latp1+2-i)-dlatm + end do + alon(1) = -pi*rtd + alonm(1) = -pi + do i = 2, lonp1 + alon(i) = alon(i-1) + dlonm*rtd + alonm(i) = alonm(i-1) + dlonm + end do + + ! ylatm and ylonm are arrays of latitudes and longitudes of the + ! distorted magnetic grids in radian - from consdyn.h + ! Convert from apex magnetic grid to distorted magnetic grid + ! + ! Allocate workspace for regrid routine rgrd_mod: + lw = nmlonp1+nmlat+2*nmlonp1 + if (.not. allocated(w)) then + allocate(w(lw), stat=ier) + call check_alloc(ier, 'getltr', 'w', lw=lw) + end if + liw = nmlonp1 + nmlat + if (.not. allocated(iw)) then + allocate(iw(liw), stat=ier) + call check_alloc(ier, 'getltr', 'iw', lw=liw) + end if + intpol(:) = 1 ! linear (not cubic) interp in both dimensions + if (alatm(1) > ylatm(1)) then + alatm(1) = ylatm(1) + end if + if (alatm(latp1) < ylatm(nmlat)) then + alatm(latp1) = ylatm(nmlat) + end if + if (alonm(1) > ylonm(1)) then + alonm(1) = ylonm(1) + end if + if (alonm(lonp1) < ylonm(nmlonp1)) then + alonm(lonp1) = ylonm(nmlonp1) + end if + + ! ylatm from -pi/2 to pi/2, and ylonm from -pi to pi + call rgrd2(lonp1, latp1, alonm, alatm, potm, nmlonp1, nmlat, & + ylonm, ylatm, phihm, intpol, w, lw, iw, liw, ier) + call rgrd2(lonp1, latp1, alonm, alatm, ekvm, nmlonp1, nmlat, & + ylonm, ylatm, ltr_kevm, intpol, w, lw, iw, liw, ier) + call rgrd2(lonp1, latp1, alonm, alatm, efxm, nmlonp1, nmlat, & + ylonm, ylatm, ltr_efxm, intpol, w, lw, iw, liw, ier) + + if (iprint > 0 .and. masterproc) then + write(iulog, *) subname, ': Max, min ltr_efxm = ', & + maxval(ltr_efxm), minval(ltr_efxm) + write(iulog, "('getltr: LTR data interpolated to date and time')") + write(iulog,"('getltr: iyear,imo,iday,iutsec = ',3i6,i10)") & + iyear,imo,iday,iutsec + write(iulog,"('getltr: LTR iset1 f1,f2,year,mon,day,ut = ', & + i6,2F9.5,3I6,f10.4)") & + iset1,f1,f2,year(iset1),month(iset1),day(iset1),ltr_ut(iset1) + write(iulog,*)'getltr: max,min phihm= ', maxval(phihm),minval(phihm) + end if + + end if active_task + + end subroutine getltr + !------------------------------------------------------------------- + + subroutine close_files + + deallocate( year,month,day ) + deallocate( hpi_input, pcp_input, ltr_ut ) + + call cam_pio_closefile(ncid) + + end subroutine close_files + !----------------------------------------------------------------------- + subroutine open_files() + + call rdltr(ltr_files(file_ndx)) + + end subroutine open_files + +end module ltr_module diff --git a/src/ionosphere/waccmx/oplus.F90 b/src/ionosphere/waccmx/oplus.F90 index 5a50c7d456..6213bc129b 100644 --- a/src/ionosphere/waccmx/oplus.F90 +++ b/src/ionosphere/waccmx/oplus.F90 @@ -1,29 +1,31 @@ module oplus ! -! Horizontally transport the O+ ion, adapted for WACCM-X from TIEGCM. -! Input O+ is received from WACCM physics/chemistry, transported O+ +! Horizontally transport the O+ ion, adapted for WACCM-X from TIEGCM. +! Input O+ is received from WACCM physics/chemistry, transported O+ ! (op_out and opnm_out) are passed back to chemistry. ! ! B. Foster (foster@ucar.edu), May, 2015. ! - use shr_kind_mod ,only: r8 => shr_kind_r8 - use cam_abortutils ,only: endrun - use cam_logfile ,only: iulog - use savefield_waccm,only: savefld_waccm, savefld_waccm_switch ! save field to waccm history - use edyn_geogrid ,only: dphi,dlamda,cs,zp,expz,p0 !, nlon, nlat, nlev - use getapex ,only: bx,by,bz,bmod2 ! (0:nlonp1,jspole-1:jnpole+1) - use edyn_params ,only: re - use time_manager ,only: get_step_size,is_first_step,is_first_restart_step - use edyn_mpi ,only: array_ptr_type - use shr_const_mod ,only: shr_const_g ! gravitational constant (m/s^2) - use spmd_utils ,only: masterproc + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_const_mod, only: shr_const_g ! gravitational constant (m/s^2) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use savefield_waccm, only: savefld_waccm ! save field to waccm history + use edyn_geogrid, only: dphi, dlamda, cs, p0 + use getapex, only: bx, by, bz, bmod2 ! (0:nlonp1,jspole-1:jnpole+1) + use edyn_params, only: Rearth ! Radius of Earth (cm) + use time_manager, only: get_step_size, is_first_step, is_first_restart_step + use edyn_mpi, only: array_ptr_type + use infnan, only: nan, assignment(=) implicit none private + public :: oplus_xport, oplus_init public :: kbot - real(r8) :: pi,rtd + real(r8) :: pi, rtd ! ! Constants in CGS: ! @@ -50,132 +52,149 @@ module oplus ! The shapiro constant .03 is used for spatial smoothing of oplus, ! (shapiro is tuneable, and maybe should be a function of timestep size). ! dtsmooth and dtsmooth_div2 are used in the time smoothing. -! To turn off all smoothing here, set shapiro=0. and dtsmooth = 1. +! To turn off all smoothing here, set shapiro=0. and dtsmooth = 1. ! - real(r8),parameter :: & + real(r8),parameter :: & dtsmooth = 0.95_r8, & ! for time smoother dtsmooth_div2 = 0.5_r8*(1._r8-dtsmooth) - + real(r8) :: adiff_limiter real(r8) :: shapiro_const logical :: enforce_floor logical :: ring_polar_filter = .false. logical, parameter :: debug = .false. - + + real(r8), allocatable :: expz(:) ! exp(-zp) + real(r8), allocatable :: zp(:) ! log pressure (as in tiegcm lev(nlev)) + + logical :: debug_hist + contains !----------------------------------------------------------------------- - subroutine oplus_init( adiff_limiter_in, shapiro_const_in, enforce_floor_in, ring_polar_filter_in ) + subroutine oplus_init( adiff_limiter_in, shapiro_const_in, enforce_floor_in, ring_polar_filter_in, ionos_debug_hist ) use cam_history, only : addfld, horiz_only use filter_module,only : filter_init - use edyn_geogrid ,only : nlon + use edyn_geogrid, only : nlev real(r8), intent(in) :: adiff_limiter_in real(r8), intent(in) :: shapiro_const_in logical , intent(in) :: enforce_floor_in logical , intent(in) :: ring_polar_filter_in - + logical , intent(in) :: ionos_debug_hist + + debug_hist = ionos_debug_hist + shapiro_const = shapiro_const_in enforce_floor = enforce_floor_in adiff_limiter = adiff_limiter_in ring_polar_filter = ring_polar_filter_in - + call filter_init( ring_polar_filter ) - ! - ! Save fields from oplus module: - ! - call addfld ('OPLUS_Z' ,(/ 'lev' /), 'I', 'cm ','OPLUS_Z' , gridname='fv_centers') - call addfld ('OPLUS_TN' ,(/ 'lev' /), 'I', 'deg K','OPLUS_TN' , gridname='fv_centers') - call addfld ('OPLUS_TE' ,(/ 'lev' /), 'I', 'deg K','OPLUS_TE' , gridname='fv_centers') - call addfld ('OPLUS_TI' ,(/ 'lev' /), 'I', 'deg K','OPLUS_TI' , gridname='fv_centers') - call addfld ('OPLUS_UN' ,(/ 'lev' /), 'I', 'cm/s' ,'OPLUS_UN' , gridname='fv_centers') - call addfld ('OPLUS_VN' ,(/ 'lev' /), 'I', 'cm/s' ,'OPLUS_VN' , gridname='fv_centers') - call addfld ('OPLUS_OM' ,(/ 'lev' /), 'I', 'Pa/s' ,'OPLUS_OM' , gridname='fv_centers') - call addfld ('OPLUS_O2' ,(/ 'lev' /), 'I', 'mmr' ,'OPLUS_O2' , gridname='fv_centers') - call addfld ('OPLUS_O1' ,(/ 'lev' /), 'I', 'mmr' ,'OPLUS_O1' , gridname='fv_centers') - - call addfld ('OPLUS_N2' ,(/ 'lev' /), 'I', 'mmr' ,'OPLUS_N2' , gridname='fv_centers') - call addfld ('OPLUS_OP' ,(/ 'lev' /), 'I', 'cm^3' ,'OPLUS_OP' , gridname='fv_centers') - call addfld ('OPLUS_UI' ,(/ 'lev' /), 'I', 'm/s' ,'OPLUS_UI' , gridname='fv_centers') - call addfld ('OPLUS_VI' ,(/ 'lev' /), 'I', 'm/s' ,'OPLUS_VI' , gridname='fv_centers') - call addfld ('OPLUS_WI' ,(/ 'lev' /), 'I', 'm/s' ,'OPLUS_WI' , gridname='fv_centers') - call addfld ('OPLUS_MBAR' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_MBAR' , gridname='fv_centers') - call addfld ('OPLUS_TR' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_TR' , gridname='fv_centers') - call addfld ('OPLUS_TP0' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_TP0' , gridname='fv_centers') - call addfld ('OPLUS_TP1' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_TP1' , gridname='fv_centers') - ! call addfld ('OPLUS_TP2' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_TP2' , gridname='fv_centers') - call addfld ('OPLUS_DJ' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_DJ' , gridname='fv_centers') - call addfld ('OPLUS_HJ' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_HJ' , gridname='fv_centers') - call addfld ('OPLUS_BVEL' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_BVEL' , gridname='fv_centers') - call addfld ('OPLUS_DIFFJ',(/ 'lev' /), 'I', ' ' ,'OPLUS_DIFFJ' , gridname='fv_centers') - call addfld ('OPLUS_OPNM' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_OPNM' , gridname='fv_centers') - call addfld ('OPNM_SMOOTH',(/ 'lev' /), 'I', ' ' ,'OPNM_SMOOTH' , gridname='fv_centers') - call addfld ('BDOTDH_OP' ,(/ 'lev' /), 'I', ' ' ,'BDOTDH_OP' , gridname='fv_centers') - call addfld ('BDOTDH_OPJ' ,(/ 'lev' /), 'I', ' ' ,'BDOTDH_OPJ' , gridname='fv_centers') - call addfld ('BDOTDH_DIFF',(/ 'lev' /), 'I', ' ' ,'BDOTDH_DIFF' , gridname='fv_centers') - call addfld ('BDZDVB_OP' ,(/ 'lev' /), 'I', ' ' ,'BDZDVB_OP' , gridname='fv_centers') - call addfld ('EXPLICIT0' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT0' , gridname='fv_centers') - - call addfld ('EXPLICITa' ,(/ 'lev' /), 'I', ' ' ,'EXPLICITa' , gridname='fv_centers') ! part a - call addfld ('EXPLICITb' ,(/ 'lev' /), 'I', ' ' ,'EXPLICITb' , gridname='fv_centers') ! part b - call addfld ('EXPLICIT1' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT1' , gridname='fv_centers') ! complete - call addfld ('EXPLICIT' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT' , gridname='fv_centers') ! final w/ poles - - call addfld ('EXPLICIT2' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT2' , gridname='fv_centers') - call addfld ('EXPLICIT3' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT3' , gridname='fv_centers') - call addfld ('TPHDZ0' ,(/ 'lev' /), 'I', ' ' ,'TPHDZ0' , gridname='fv_centers') - call addfld ('TPHDZ1' ,(/ 'lev' /), 'I', ' ' ,'TPHDZ1' , gridname='fv_centers') - call addfld ('DIVBZ' ,(/ 'lev' /), 'I', ' ' ,'DIVBZ' , gridname='fv_centers') - call addfld ('HDZMBZ' ,(/ 'lev' /), 'I', ' ' ,'HDZMBZ' , gridname='fv_centers') - call addfld ('HDZPBZ' ,(/ 'lev' /), 'I', ' ' ,'HDZPBZ' , gridname='fv_centers') - call addfld ('P_COEFF0' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF0' , gridname='fv_centers') - call addfld ('Q_COEFF0' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF0' , gridname='fv_centers') - call addfld ('R_COEFF0' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF0' , gridname='fv_centers') - call addfld ('P_COEFF0a' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF0a' , gridname='fv_centers') - call addfld ('Q_COEFF0a' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF0a' , gridname='fv_centers') - call addfld ('DJINT' ,(/ 'lev' /), 'I', ' ' ,'DJINT' , gridname='fv_centers') - call addfld ('BDOTU' ,(/ 'lev' /), 'I', ' ' ,'BDOTU' , gridname='fv_centers') - call addfld ('R_COEFF0a' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF0a' , gridname='fv_centers') - call addfld ('P_COEFF1' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF1' , gridname='fv_centers') - call addfld ('Q_COEFF1' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF1' , gridname='fv_centers') - call addfld ('R_COEFF1' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF1' , gridname='fv_centers') - call addfld ('P_COEFF2' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF2' , gridname='fv_centers') - call addfld ('Q_COEFF2' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF2' , gridname='fv_centers') - call addfld ('R_COEFF2' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF2' , gridname='fv_centers') - - call addfld ('P_COEFF' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF' , gridname='fv_centers') ! final w/ poles - call addfld ('Q_COEFF' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF' , gridname='fv_centers') ! final w/ poles - call addfld ('R_COEFF' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF' , gridname='fv_centers') ! final w/ poles - - call addfld ('OP_SOLVE' ,(/ 'lev' /), 'I', ' ' ,'OP_SOLVE' , gridname='fv_centers') - - call addfld ('OP_OUT' ,(/ 'lev' /), 'I', 'cm^3' ,'OPLUS (oplus_xport output)', gridname='fv_centers') - call addfld ('OPNM_OUT' ,(/ 'lev' /), 'I', 'cm^3' ,'OPNM_OUT' , gridname='fv_centers') - call addfld ('BMOD2' ,(/ 'lev' /), 'I', ' ' ,'BMOD2' , gridname='fv_centers') - - call addfld ('OPLUS_FLUX', horiz_only , 'I', ' ','OPLUS_FLUX', gridname='fv_centers') - call addfld ('OPLUS_DIVB', horiz_only , 'I', ' ','OPLUS_DIVB', gridname='fv_centers') - call addfld ('OPLUS_BX' , horiz_only , 'I', ' ','OPLUS_BX' , gridname='fv_centers') - call addfld ('OPLUS_BY' , horiz_only , 'I', ' ','OPLUS_BY' , gridname='fv_centers') - call addfld ('OPLUS_BZ' , horiz_only , 'I', ' ','OPLUS_BZ' , gridname='fv_centers') - call addfld ('OPLUS_BMAG', horiz_only , 'I', ' ','OPLUS_BMAG', gridname='fv_centers') + call addfld ('op_dt' , (/ 'lev' /), 'I', ' ' ,'op_dt' , gridname='geo_grid') + call addfld ('amb_diff' , (/ 'lev' /), 'I', ' ' ,'amb_diff' , gridname='geo_grid') + call addfld ('dfield' , (/ 'lev' /), 'I', ' ' ,'dfield' , gridname='geo_grid') + call addfld ('dwind' , (/ 'lev' /), 'I', ' ' ,'dwind' , gridname='geo_grid') + + if (debug_hist) then + ! + ! Save fields from oplus module: + ! + call addfld ('OPLUS_Z' ,(/ 'lev' /), 'I', 'cm ','OPLUS_Z' , gridname='geo_grid') + call addfld ('OPLUS_TN' ,(/ 'lev' /), 'I', 'deg K','OPLUS_TN' , gridname='geo_grid') + call addfld ('OPLUS_TE' ,(/ 'lev' /), 'I', 'deg K','OPLUS_TE' , gridname='geo_grid') + call addfld ('OPLUS_TI' ,(/ 'lev' /), 'I', 'deg K','OPLUS_TI' , gridname='geo_grid') + call addfld ('OPLUS_UN' ,(/ 'lev' /), 'I', 'cm/s' ,'OPLUS_UN' , gridname='geo_grid') + call addfld ('OPLUS_VN' ,(/ 'lev' /), 'I', 'cm/s' ,'OPLUS_VN' , gridname='geo_grid') + call addfld ('OPLUS_OM' ,(/ 'lev' /), 'I', 'Pa/s' ,'OPLUS_OM' , gridname='geo_grid') + call addfld ('OPLUS_O2' ,(/ 'lev' /), 'I', 'mmr' ,'OPLUS_O2' , gridname='geo_grid') + call addfld ('OPLUS_O1' ,(/ 'lev' /), 'I', 'mmr' ,'OPLUS_O1' , gridname='geo_grid') + + call addfld ('OPLUS_N2' ,(/ 'lev' /), 'I', 'mmr' ,'OPLUS_N2' , gridname='geo_grid') + call addfld ('OPLUS_OP' ,(/ 'lev' /), 'I', 'cm^3' ,'OPLUS_OP' , gridname='geo_grid') + call addfld ('OPLUS_UI' ,(/ 'lev' /), 'I', 'm/s' ,'OPLUS_UI' , gridname='geo_grid') + call addfld ('OPLUS_VI' ,(/ 'lev' /), 'I', 'm/s' ,'OPLUS_VI' , gridname='geo_grid') + call addfld ('OPLUS_WI' ,(/ 'lev' /), 'I', 'm/s' ,'OPLUS_WI' , gridname='geo_grid') + call addfld ('OPLUS_MBAR' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_MBAR' , gridname='geo_grid') + call addfld ('OPLUS_TR' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_TR' , gridname='geo_grid') + call addfld ('OPLUS_TP0' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_TP0' , gridname='geo_grid') + call addfld ('OPLUS_TP1' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_TP1' , gridname='geo_grid') + call addfld ('OPLUS_DJ' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_DJ' , gridname='geo_grid') + call addfld ('OPLUS_HJ' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_HJ' , gridname='geo_grid') + call addfld ('OPLUS_BVEL' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_BVEL' , gridname='geo_grid') + call addfld ('OPLUS_DIFFJ',(/ 'lev' /), 'I', ' ' ,'OPLUS_DIFFJ' , gridname='geo_grid') + call addfld ('OPLUS_OPNM' ,(/ 'lev' /), 'I', ' ' ,'OPLUS_OPNM' , gridname='geo_grid') + call addfld ('OPNM_SMOOTH',(/ 'lev' /), 'I', ' ' ,'OPNM_SMOOTH' , gridname='geo_grid') + call addfld ('BDOTDH_OP' ,(/ 'lev' /), 'I', ' ' ,'BDOTDH_OP' , gridname='geo_grid') + call addfld ('BDOTDH_OPJ' ,(/ 'lev' /), 'I', ' ' ,'BDOTDH_OPJ' , gridname='geo_grid') + call addfld ('BDOTDH_DIFF',(/ 'lev' /), 'I', ' ' ,'BDOTDH_DIFF' , gridname='geo_grid') + call addfld ('BDZDVB_OP' ,(/ 'lev' /), 'I', ' ' ,'BDZDVB_OP' , gridname='geo_grid') + call addfld ('EXPLICIT0' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT0' , gridname='geo_grid') + + call addfld ('EXPLICITa' ,(/ 'lev' /), 'I', ' ' ,'EXPLICITa' , gridname='geo_grid') ! part a + call addfld ('EXPLICITb' ,(/ 'lev' /), 'I', ' ' ,'EXPLICITb' , gridname='geo_grid') ! part b + call addfld ('EXPLICIT1' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT1' , gridname='geo_grid') ! complete + call addfld ('EXPLICIT' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT' , gridname='geo_grid') ! final w/ poles + + call addfld ('EXPLICIT2' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT2' , gridname='geo_grid') + call addfld ('EXPLICIT3' ,(/ 'lev' /), 'I', ' ' ,'EXPLICIT3' , gridname='geo_grid') + call addfld ('TPHDZ0' ,(/ 'lev' /), 'I', ' ' ,'TPHDZ0' , gridname='geo_grid') + call addfld ('TPHDZ1' ,(/ 'lev' /), 'I', ' ' ,'TPHDZ1' , gridname='geo_grid') + call addfld ('DIVBZ' ,(/ 'lev' /), 'I', ' ' ,'DIVBZ' , gridname='geo_grid') + call addfld ('HDZMBZ' ,(/ 'lev' /), 'I', ' ' ,'HDZMBZ' , gridname='geo_grid') + call addfld ('HDZPBZ' ,(/ 'lev' /), 'I', ' ' ,'HDZPBZ' , gridname='geo_grid') + call addfld ('P_COEFF0' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF0' , gridname='geo_grid') + call addfld ('Q_COEFF0' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF0' , gridname='geo_grid') + call addfld ('R_COEFF0' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF0' , gridname='geo_grid') + call addfld ('P_COEFF0a' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF0a' , gridname='geo_grid') + call addfld ('Q_COEFF0a' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF0a' , gridname='geo_grid') + call addfld ('DJINT' ,(/ 'lev' /), 'I', ' ' ,'DJINT' , gridname='geo_grid') + call addfld ('BDOTU' ,(/ 'lev' /), 'I', ' ' ,'BDOTU' , gridname='geo_grid') + call addfld ('R_COEFF0a' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF0a' , gridname='geo_grid') + call addfld ('P_COEFF1' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF1' , gridname='geo_grid') + call addfld ('Q_COEFF1' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF1' , gridname='geo_grid') + call addfld ('R_COEFF1' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF1' , gridname='geo_grid') + call addfld ('P_COEFF2' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF2' , gridname='geo_grid') + call addfld ('Q_COEFF2' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF2' , gridname='geo_grid') + call addfld ('R_COEFF2' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF2' , gridname='geo_grid') + + call addfld ('P_COEFF' ,(/ 'lev' /), 'I', ' ' ,'P_COEFF' , gridname='geo_grid') ! final w/ poles + call addfld ('Q_COEFF' ,(/ 'lev' /), 'I', ' ' ,'Q_COEFF' , gridname='geo_grid') ! final w/ poles + call addfld ('R_COEFF' ,(/ 'lev' /), 'I', ' ' ,'R_COEFF' , gridname='geo_grid') ! final w/ poles + + call addfld ('OP_SOLVE' ,(/ 'lev' /), 'I', ' ' ,'OP_SOLVE' , gridname='geo_grid') + call addfld ('OP_OUT' ,(/ 'lev' /), 'I', 'cm^3' ,'OPLUS (oplus_xport output)', gridname='geo_grid') + call addfld ('OPNM_OUT' ,(/ 'lev' /), 'I', 'cm^3' ,'OPNM_OUT' , gridname='geo_grid') + call addfld ('BMOD2' ,(/ 'lev' /), 'I', ' ' ,'BMOD2' , gridname='geo_grid') + + call addfld ('OPLUS_FLUX', horiz_only , 'I', ' ','OPLUS_FLUX', gridname='geo_grid') + call addfld ('OPLUS_DIVB', horiz_only , 'I', ' ','OPLUS_DIVB', gridname='geo_grid') + call addfld ('OPLUS_BX' , horiz_only , 'I', ' ','OPLUS_BX' , gridname='geo_grid') + call addfld ('OPLUS_BY' , horiz_only , 'I', ' ','OPLUS_BY' , gridname='geo_grid') + call addfld ('OPLUS_BZ' , horiz_only , 'I', ' ','OPLUS_BZ' , gridname='geo_grid') + call addfld ('OPLUS_BMAG', horiz_only , 'I', ' ','OPLUS_BMAG', gridname='geo_grid') + endif + allocate(zp(nlev)) ! log pressure (as in TIEGCM) + allocate(expz(nlev)) ! exp(-zp) + zp = nan + expz = nan end subroutine oplus_init !----------------------------------------------------------------------- - subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & - mbar,ui,vi,wi,pmid,op_out,opnm_out, & - i0,i1,j0,j1,nspltop,ispltop ) + subroutine oplus_xport(tn, te, ti, un, vn, om, zg, o2, o1, n2, op_in, & + opnm_in, mbar, ui, vi, wi, pmid, op_out, opnm_out, & + i0, i1, j0, j1, nspltop, ispltop) ! -! All input fields from dpie_coupling are in "TIEGCM" format, i.e., +! All input fields from dpie_coupling are in "TIEGCM" format, i.e., ! longitude (-180->180), vertical (bot2top), and units (CGS). ! - use edyn_mpi,only: mp_geo_halos,mp_pole_halos,setpoles - use edyn_geogrid,only : glat, nlat, nlev - use trsolv_mod, only : trsolv + use edyn_mpi, only: mp_geo_halos,mp_pole_halos,setpoles + use edyn_geogrid, only: glat, nlat, nlev + use trsolv_mod, only: trsolv ! ! Transport O+ ion. ! March-May, 2015 B.Foster: Adapted from TIEGCM (oplus.F) for WACCM-X. @@ -218,66 +237,73 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & ! ! Output: ! - real(r8),intent(out) :: & - op_out (nlev,i0:i1,j0:j1), & ! O+ output + real(r8),intent(out) :: & + op_out (nlev,i0:i1,j0:j1), & ! O+ output opnm_out(nlev,i0:i1,j0:j1) ! O+ output at time n-1 ! ! Local: ! - integer :: i,j,k,lat,jm1,jp1,jm2,jp2,lat0,lat1 - real(r8),dimension(i0:i1,j0:j1) :: & - opflux, & ! upward number flux of O+ (returned by sub oplus_flux) - dvb ! divergence of B-field + integer :: i, j, k, lat, jm1, jp1, jm2, jp2, lat0, lat1 + real(r8), dimension(i0:i1,j0:j1) :: & + opflux, & ! upward number flux of O+ (returned by sub oplus_flux) + dvb ! divergence of B-field ! ! Local inputs with added halo points in lat,lon: -! +! real(r8),dimension(nlev,i0-2:i1+2,j0-2:j1+2),target :: op, opnm - real(r8),dimension(nlev,i0-2:i1+2,j0-2:j1+2),target :: & - tr ,& ! Reduced temperature (.5*(tn+ti)) - tp ,& ! Plasma temperature N(O+)*(te+ti) - dj ,& ! diffusion coefficients - bvel ,& ! bvel @ j = (B.U)*N(O+) - diffj ,& ! (D/(H*DZ)*2.*TP+M*G/R)*N(O+) - bdotdh_op ,& ! (b(h)*del(h))*phi - bdotdh_opj ,& ! (b(h)*del(h))*phi - bdotdh_diff ,& ! (b(h)*del(h))*phi - opnm_smooth ! O+ at time-1, smoothed - - real(r8),dimension(nlev,i0:i1,j0:j1) :: & ! for saving to histories - diag0,diag1,diag2,diag3,diag4,diag5,diag6,diag7,diag8,diag9,& - diag10,diag11,diag12,diag13,diag14,diag15,diag16,diag17,& - diag18,diag19,diag20,diag21,diag22,diag23,diag24,diag25,& - diag26,diag27 - real(r8),dimension(nlev,i0:i1,j0-1:j1+1) :: hj ! scale height + real(r8),dimension(nlev,i0-2:i1+2,j0-2:j1+2),target :: & + tr ,& ! Reduced temperature (.5*(tn+ti)) + tp ,& ! Plasma temperature N(O+)*(te+ti) + dj ,& ! diffusion coefficients + bvel ,& ! bvel @ j = (B.U)*N(O+) + diffj ,& ! (D/(H*DZ)*2.*TP+M*G/R)*N(O+) + bdotdh_op ,& ! (b(h)*del(h))*phi + bdotdh_opj ,& ! (b(h)*del(h))*phi + bdotdh_diff ,& ! (b(h)*del(h))*phi + opnm_smooth ! O+ at time-1, smoothed + + real(r8), dimension(nlev,i0:i1,j0:j1) :: & ! for saving to histories + diag0, diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, & + diag10, diag11, diag12, diag13, diag14, diag15, diag16, diag17, & + diag18, diag19, diag20, diag21, diag22, diag23, diag24, diag25, & + diag26, diag27 + real(r8), dimension(nlev,i0:i1,j0-1:j1+1) :: hj ! scale height real(r8) :: gmr,dtime,dtx2,dtx2inv - real(r8),dimension(nlev,i0:i1) :: & + real(r8), dimension(nlev,i0:i1) :: & bdzdvb_op, & - hdz, & tp1, & + divbz + real(r8),dimension(nlev,i0:i1,j0:j1) :: & + hdz, & tphdz0, & tphdz1, & djint, & - divbz, & hdzmbz, & hdzpbz, & bdotu +! for term analysis, lei, 07 + real(r8),dimension(nlev,i0:i1,j0:j1) :: & + op_dt, & ! dn/dt + amb_diff,& ! ambipole diffion + dwind, & ! neutral wind transport + dfield ! electric field transport ! ! Arguments for tridiagonal solver trsolv (no halos): - real(r8),dimension(nlev,i0:i1,j0:j1) :: & - explicit,explicit_a,explicit_b,p_coeff,q_coeff,r_coeff + real(r8), dimension(nlev,i0:i1,j0:j1) :: & + explicit, explicit_a, explicit_b, p_coeff, q_coeff, r_coeff - real(r8),dimension(i0:i1) :: ubca, ubcb ! O+ upper boundary - real(r8),parameter :: one=1._r8 - logical :: calltrsolv + real(r8), dimension(i0:i1) :: ubca, ubcb ! O+ upper boundary + real(r8), parameter :: one=1._r8 + logical :: calltrsolv ! ! Pointers for multiple-field calls (e.g., mp_geo_halos) - integer :: nfields - real(r8),allocatable :: polesign(:) - type(array_ptr_type),allocatable :: ptrs(:) + integer :: nfields + real(r8), allocatable :: polesign(:) + type(array_ptr_type), allocatable :: ptrs(:) - real(r8) :: zpmid(nlev), opfloor - real(r8),parameter :: opmin=3000.0_r8 + real(r8) :: zpmid(nlev), opfloor + real(r8), parameter :: opmin=3000.0_r8 ! ! Execute: ! @@ -286,19 +312,22 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & dtx2 = 2._r8*dtime dtx2inv = 1._r8/dtx2 - if ((is_first_step().or.is_first_restart_step()).and.ispltop==1) then - if (masterproc) write(iulog,"('oplus: shapiro=',es12.4,' dtsmooth=',es12.4,' dtsmooth_div2=',es12.4)") & - shapiro_const,dtsmooth,dtsmooth_div2 - if (masterproc) write(iulog,"('oplus: shr_const_g=',f8.3)") shr_const_g - endif + if ((is_first_step() .or. is_first_restart_step()) .and. ispltop==1) then + if (masterproc) then + write(iulog,"(a,es12.4,a,es12.4,a,es12.4)") & + 'oplus: shapiro=', shapiro_const, ', dtsmooth=', dtsmooth, & + ', dtsmooth_div2=', dtsmooth_div2 + write(iulog,"('oplus: shr_const_g=',f8.3)") shr_const_g + end if + end if ! - ! zp,expz are declared in edyn_geogrid.F90, and allocated in sub + ! zp,expz are declared in edyn_geogrid.F90, and allocated in sub ! set_geogrid (edyn_init.F90). pmid was passed in here (bot2top) ! from dpie_coupling. ! ! kbot is the k-index at the bottom of O+ transport calculations, - ! corresponding to pressure pbot. + ! corresponding to pressure pbot. ! if ((is_first_step().or.is_first_restart_step()).and.ispltop==1) then kloop: do k=1,nlev @@ -312,34 +341,35 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & expz(k) = exp(-zp(k)) enddo if (debug.and.masterproc) then - write(iulog,"('oplus: kbot=',i4,' pmid(kbot)=',es12.4,' zp(kbot)=',es12.4)") & - kbot,pmid(kbot),zp(kbot) - endif - endif + write(iulog,"(a,i4,a,es12.4,a,es12.4)") & + 'oplus: kbot=', kbot, ', pmid(kbot)=', pmid(kbot), & + ', zp(kbot)=', zp(kbot) + end if + end if if (kbot < 1) then call endrun('oplus_xport: kbot is not set') endif - dzp = zp(nlev)-zp(nlev-1) ! use top 2 levels (typically dzp=0.5) + dzp = zp(nlev) - zp(nlev-1) ! use top 2 levels (typically dzp=0.5) - if (debug.and.masterproc) then - write(iulog,"('oplus: nlev=',i3,' zp (bot2top) =',/,(6es12.3))") nlev,zp - write(iulog,"('oplus: nlev=',i3,' expz (bot2top) =',/,(6es12.3))") nlev,expz - write(iulog,"('oplus: nlev=',i3,' dzp =',/,(6es12.3))") nlev,dzp - endif + if (debug .and. masterproc) then + write(iulog,"('oplus: nlev=',i3,' zp (bot2top) =',/,(6es12.3))") nlev, zp + write(iulog,"('oplus: nlev=',i3,' expz (bot2top) =',/,(6es12.3))") nlev, expz + write(iulog,"('oplus: nlev=',i3,' dzp =',/,(6es12.3))") nlev, dzp + end if ! ! Set subdomain blocks from input (composition is in mmr): ! !$omp parallel do private(i, j, k) - do k=1,nlev - do j=j0,j1 - do i=i0,i1 + do k = 1, nlev + do j = j0, j1 + do i = i0, i1 op(k,i,j) = op_in(k,i,j) opnm(k,i,j) = opnm_in(k,i,j) - enddo - enddo - enddo + end do + end do + end do ! ! Define halo points on inputs: @@ -362,7 +392,7 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & ! ! Set latitude halo points over the poles (this does not change the poles). ! (the 2nd halo over the poles will not actually be used (assuming lat loops -! are lat=2,nlat-1), because jp1,jm1 will be the pole itself, and jp2,jm2 +! are lat=2,nlat-1), because jp1,jm1 will be the pole itself, and jp2,jm2 ! will be the first halo over the pole) ! ! mp_pole_halos first arg: @@ -382,29 +412,31 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & ! Save input fields to WACCM histories. Sub savefld_waccm_switch converts ! fields from tiegcm-format to waccm-format before saving to waccm histories. ! - call savefld_waccm_switch(tn(:,i0:i1,j0:j1),'OPLUS_TN',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(te(:,i0:i1,j0:j1),'OPLUS_TE',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(ti(:,i0:i1,j0:j1),'OPLUS_TI',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(un(:,i0:i1,j0:j1),'OPLUS_UN',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(vn(:,i0:i1,j0:j1),'OPLUS_VN',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(om(:,i0:i1,j0:j1),'OPLUS_OM',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(zg(:,i0:i1,j0:j1),'OPLUS_Z' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(o2(:,i0:i1,j0:j1),'OPLUS_O2',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(o1(:,i0:i1,j0:j1),'OPLUS_O1',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(n2(:,i0:i1,j0:j1),'OPLUS_N2',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(op(:,i0:i1,j0:j1),'OPLUS_OP',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(ui(:,i0:i1,j0:j1),'OPLUS_UI',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(vi(:,i0:i1,j0:j1),'OPLUS_VI',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(wi(:,i0:i1,j0:j1),'OPLUS_WI',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(mbar(:,i0:i1,j0:j1),'OPLUS_MBAR',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(opnm(:,i0:i1,j0:j1),'OPLUS_OPNM',nlev,i0,i1,j0,j1) -! -! Initialize output op_out with input op at 1:kbot-1, to retain values from -! bottom of column up to kbot. This routine will change (transport) these + if (debug_hist) then + call savefld_waccm(tn(:,i0:i1,j0:j1),'OPLUS_TN',nlev,i0,i1,j0,j1) + call savefld_waccm(te(:,i0:i1,j0:j1),'OPLUS_TE',nlev,i0,i1,j0,j1) + call savefld_waccm(ti(:,i0:i1,j0:j1),'OPLUS_TI',nlev,i0,i1,j0,j1) + call savefld_waccm(un(:,i0:i1,j0:j1),'OPLUS_UN',nlev,i0,i1,j0,j1) + call savefld_waccm(vn(:,i0:i1,j0:j1),'OPLUS_VN',nlev,i0,i1,j0,j1) + call savefld_waccm(om(:,i0:i1,j0:j1),'OPLUS_OM',nlev,i0,i1,j0,j1) + call savefld_waccm(zg(:,i0:i1,j0:j1),'OPLUS_Z' ,nlev,i0,i1,j0,j1) + call savefld_waccm(o2(:,i0:i1,j0:j1),'OPLUS_O2',nlev,i0,i1,j0,j1) + call savefld_waccm(o1(:,i0:i1,j0:j1),'OPLUS_O1',nlev,i0,i1,j0,j1) + call savefld_waccm(n2(:,i0:i1,j0:j1),'OPLUS_N2',nlev,i0,i1,j0,j1) + call savefld_waccm(op(:,i0:i1,j0:j1),'OPLUS_OP',nlev,i0,i1,j0,j1) + call savefld_waccm(ui(:,i0:i1,j0:j1),'OPLUS_UI',nlev,i0,i1,j0,j1) + call savefld_waccm(vi(:,i0:i1,j0:j1),'OPLUS_VI',nlev,i0,i1,j0,j1) + call savefld_waccm(wi(:,i0:i1,j0:j1),'OPLUS_WI',nlev,i0,i1,j0,j1) + call savefld_waccm(mbar(:,i0:i1,j0:j1),'OPLUS_MBAR',nlev,i0,i1,j0,j1) + call savefld_waccm(opnm(:,i0:i1,j0:j1),'OPLUS_OPNM',nlev,i0,i1,j0,j1) + endif +! +! Initialize output op_out with input op at 1:kbot-1, to retain values from +! bottom of column up to kbot. This routine will change (transport) these ! outputs only from kbot to the top (nlev). ! - op_out = 0._r8 - opnm_out = 0._r8 + op_out = 0._r8 + opnm_out = 0._r8 op_out (1:kbot-1,i0:i1,j0:j1) = op (1:kbot-1,i0:i1,j0:j1) opnm_out(1:kbot-1,i0:i1,j0:j1) = opnm(1:kbot-1,i0:i1,j0:j1) ! @@ -412,16 +444,20 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & ! Output opflux(i,j) is 2d lon x lat subdomain: ! call oplus_flux(opflux,i0,i1,j0,j1) - call savefld_waccm(opflux(i0:i1,j0:j1),'OPLUS_FLUX',1,i0,i1,j0,j1) + if (debug_hist) then + call savefld_waccm(opflux(i0:i1,j0:j1),'OPLUS_FLUX',1,i0,i1,j0,j1) + endif ! ! Divergence of B (mag field) is returned by divb in dvb(i0:i1,j0:j1) ! call divb(dvb,i0,i1,j0,j1) - call savefld_waccm(dvb(i0:i1,j0:j1),'OPLUS_DIVB',1,i0,i1,j0,j1) + if (debug_hist) then + call savefld_waccm(dvb(i0:i1,j0:j1),'OPLUS_DIVB',1,i0,i1,j0,j1) + endif ! ! The solver will be called only if calltrsolv=true. It is sometimes ! set false when skipping parts of the code for debug purposes. -! +! calltrsolv = .true. tr = 0._r8 @@ -442,13 +478,13 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & jp2 = lat+2 ! ! as of April, 2015, TIEGCM incorrectly uses te+ti instead of tn+ti -! This has not been fixed in TIEGCM, because fixing it causes a tuning +! This has not been fixed in TIEGCM, because fixing it causes a tuning ! problem (ask Hanli and Wenbin). For WACCM, it is correct as below. ! (see also tp) ! !$omp parallel do private(i,k) do i=i0,i1 -! +! ! Reduced temperature (tpj in tiegcm): ! 'OPLUS_TR' (has constants at poles) ! @@ -574,21 +610,23 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & !------------------------- End first latitude scan --------------------- ! ! Set pole values for opnm_smooth. Do this before savefld calls, so plots will -! include the poles. All other fields in 1st lat scan got values at the poles +! include the poles. All other fields in 1st lat scan got values at the poles ! via jm1,jp1 above. ! call setpoles(opnm_smooth(kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) ! ! Save to history file (exclude halo points) ! - call savefld_waccm_switch(tr (:,i0:i1,j0:j1),'OPLUS_TR' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(dj (:,i0:i1,j0:j1),'OPLUS_DJ' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(hj (:,i0:i1,j0:j1),'OPLUS_HJ' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(bvel (:,i0:i1,j0:j1),'OPLUS_BVEL' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diffj(:,i0:i1,j0:j1),'OPLUS_DIFFJ',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag0(:,i0:i1,j0:j1),'OPLUS_TP0' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(tp (:,i0:i1,j0:j1),'OPLUS_TP1' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(opnm_smooth(:,i0:i1,j0:j1),'OPNM_SMOOTH',nlev,i0,i1,j0,j1) + if (debug_hist) then + call savefld_waccm(tr (:,i0:i1,j0:j1),'OPLUS_TR' ,nlev,i0,i1,j0,j1) + call savefld_waccm(dj (:,i0:i1,j0:j1),'OPLUS_DJ' ,nlev,i0,i1,j0,j1) + call savefld_waccm(hj (:,i0:i1,j0:j1),'OPLUS_HJ' ,nlev,i0,i1,j0,j1) + call savefld_waccm(bvel (:,i0:i1,j0:j1),'OPLUS_BVEL' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diffj(:,i0:i1,j0:j1),'OPLUS_DIFFJ',nlev,i0,i1,j0,j1) + call savefld_waccm(diag0(:,i0:i1,j0:j1),'OPLUS_TP0' ,nlev,i0,i1,j0,j1) + call savefld_waccm(tp (:,i0:i1,j0:j1),'OPLUS_TP1' ,nlev,i0,i1,j0,j1) + call savefld_waccm(opnm_smooth(:,i0:i1,j0:j1),'OPNM_SMOOTH',nlev,i0,i1,j0,j1) + endif ! ! Set halo points where needed. ! @@ -668,11 +706,13 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & ! bdotdh_opj already has non-constant polar values, but bdotdh_op poles are zero. ! Sub setpoles will set poles to the zonal average of the latitude below each pole. ! -! This may not be necessary, but do it for plotting: +! This may not be necessary, but do it for plotting: call setpoles(bdotdh_op(kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(bdotdh_op (:,i0:i1,j0:j1),'BDOTDH_OP' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(bdotdh_opj(:,i0:i1,j0:j1),'BDOTDH_OPJ',nlev,i0,i1,j0,j1) + if (debug_hist) then + call savefld_waccm(bdotdh_op (:,i0:i1,j0:j1),'BDOTDH_OP' ,nlev,i0,i1,j0,j1) + call savefld_waccm(bdotdh_opj(:,i0:i1,j0:j1),'BDOTDH_OPJ',nlev,i0,i1,j0,j1) + endif ! ! Note mp_geo_halos will overwrite jm1,jp1 that was set above. ! bdotdh_opj needs longitude halos for the bdotdh call below. @@ -701,11 +741,15 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & q_coeff(1:nlev,i0:i1,j0:j1) = 0._r8 r_coeff(1:nlev,i0:i1,j0:j1) = 0._r8 bdotu = 0._r8 + op_dt = 0._r8 + amb_diff = 0._r8 + dwind = 0._r8 + dfield = 0._r8 diag1 = 0._r8 ; diag2 = 0._r8 ; diag3 = 0._r8 ; diag4 = 0._r8 ; diag5 = 0._r8 - diag6 = 0._r8 ; diag7 = 0._r8 ; diag8 = 0._r8 ; diag9 = 0._r8 ; diag10= 0._r8 - diag11 = 0._r8 ; diag12= 0._r8 ; diag13= 0._r8 ; diag14= 0._r8 ; diag15= 0._r8 - diag16 = 0._r8 ; diag17= 0._r8 ; diag18= 0._r8 ; diag19= 0._r8 ; diag20= 0._r8 + diag6 = 0._r8 ; diag7 = 0._r8 ; diag8 = 0._r8 ; diag9 = 0._r8 ; diag10= 0._r8 + diag11 = 0._r8 ; diag12= 0._r8 ; diag13= 0._r8 ; diag14= 0._r8 ; diag15= 0._r8 + diag16 = 0._r8 ; diag17= 0._r8 ; diag18= 0._r8 ; diag19= 0._r8 ; diag20= 0._r8 diag21 = 0._r8 ; diag22= 0._r8 ; diag23= 0._r8 ; diag24= 0._r8 ; diag25= 0._r8 diag26 = 0._r8 ; diag27= 0._r8 @@ -752,13 +796,13 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & ! Collect explicit terms: ! 'EXPLICIT0' (this will have poles set after third lat scan, before ! plotting. The poles will be constant in longitude, and -! may differ structurally from adjacent latitudes. +! may differ structurally from adjacent latitudes. ! !$omp parallel do private( i, k ) do i=i0,i1 do k=kbot,nlev - explicit(k,i,lat) = -one*(bdzdvb_op(k,i)+bdotdh_diff(k,i,lat)+ & - bdotdh_op(k,i,lat)) + explicit(k,i,lat) = -one*(bdzdvb_op(k,i)+bdotdh_diff(k,i,lat)+bdotdh_op(k,i,lat)) + amb_diff(k,i,lat) = -explicit(k,i,lat) enddo ! k=kbot,nlev enddo ! i=i0,i1 diag2(:,i0:i1,lat) = explicit(:,i0:i1,lat) ! EXPLICIT0 @@ -783,7 +827,7 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & do k=kbot,nlev-1 ! ! Original TIEGCM statement: -! explicit(k,i) = explicit(k,i)+1._r8/(2._r8*re)* & +! explicit(k,i) = explicit(k,i)+1._r8/(2._r8*Rearth)* & ! (1._r8/(cs(lat)*dlamda)*(bx(i,lat)* & ! (bvel(k,i+1,lat)-bvel(k,i-1,lat))+ & ! 0.5_r8*(ui(k,i,lat)+ui(k+1,i,lat))*bmod2(i,lat)**2* & @@ -802,7 +846,7 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & (bvel(k,i+1,lat)-bvel(k,i-1,lat))+ & 0.5_r8*(ui(k,i,lat)+ui(k+1,i,lat))*bmod2(i,lat)**2* & (op(k,i+1,lat)/bmod2(i+1,lat)**2- & - op(k,i-1,lat)/bmod2(i-1,lat)**2)) + op(k,i-1,lat)/bmod2(i-1,lat)**2)) ! ! 'EXPLICITb' ! @@ -815,10 +859,11 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & ! 'EXPLICIT1' ! explicit will receive polar values after this latitude scan. ! - explicit(k,i,lat) = explicit(k,i,lat)+1._r8/(2._r8*re)* & - (1._r8/(cs(lat)*dlamda)*explicit_a(k,i,lat)+ & + explicit(k,i,lat) = explicit(k,i,lat)+1._r8/(2._r8*Rearth)* & + (1._r8/(cs(lat)*dlamda)*explicit_a(k,i,lat)+ & 1._r8/dphi*explicit_b(k,i,lat)) + dfield(k,i,lat) = -(explicit(k,i,lat)+amb_diff(k,i,lat)) ! ! explicit is bad at i=1,72,73,144 near south pole (npole appears to be ok) ! This does not appear to adversely affect the final O+ output, and TIEGCM @@ -858,11 +903,11 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & do i=i0,i1 dvb(i,lat) = dvb(i,lat)/bz(i,lat) enddo ! i=i0,i1 - + !$omp parallel do private( i, k ) do i=i0,i1 do k=kbot,nlev - hdz(k,i) = 1._r8/(hj(k,i,lat)*dzp) + hdz(k,i,lat) = 1._r8/(hj(k,i,lat)*dzp) tp1(k,i) = 0.5_r8*(ti(k,i,lat)+te(k,i,lat)) enddo ! k=kbot,nlev enddo ! i=i0,i1 @@ -870,8 +915,8 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & !$omp parallel do private( i, k ) do i=i0,i1 do k=kbot,nlev-1 - tphdz1(k+1,i) = 2._r8*tp1(k+1,i)*(0.5_r8*(hdz(k,i)+hdz(k+1,i)))+gmr - tphdz0(k+1,i) = 2._r8*tp1(k ,i)*(0.5_r8*(hdz(k,i)+hdz(k+1,i)))-gmr + tphdz1(k+1,i,lat) = 2._r8*tp1(k+1,i)*(0.5_r8*(hdz(k,i,lat)+hdz(k+1,i,lat)))+gmr + tphdz0(k+1,i,lat) = 2._r8*tp1(k ,i)*(0.5_r8*(hdz(k,i,lat)+hdz(k+1,i,lat)))-gmr enddo ! k=kbot,nlev-1 enddo ! i=lon0,lon1 ! @@ -882,17 +927,17 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & ! !$omp parallel do private( i ) do i=i0,i1 - tphdz1(kbot,i) = 2._r8*tp1(kbot,i)* & - (1.5_r8*hdz(kbot,i)-0.5_r8*hdz(kbot+1,i))+gmr - tphdz1(nlev,i) = 2._r8*(2._r8*tp1(nlev-1,i)-tp1(nlev-2,i))* & - (1.5_r8*hdz(nlev-1,i)-0.5_r8*hdz(nlev-2,i))+gmr - tphdz0(kbot,i) = 2._r8*(2._r8*tp1(kbot,i)-tp1(kbot+1,i))* & - (1.5_r8*hdz(kbot,i)-0.5_r8*hdz(kbot+1,i))-gmr - tphdz0(nlev,i) = 2._r8*tp1(nlev-1,i)* & - (1.5_r8*hdz(nlev-1,i)-0.5_r8*hdz(nlev-2,i))-gmr + tphdz1(kbot,i,lat) = 2._r8*tp1(kbot,i)* & + (1.5_r8*hdz(kbot,i,lat)-0.5_r8*hdz(kbot+1,i,lat))+gmr + tphdz1(nlev,i,lat) = 2._r8*(2._r8*tp1(nlev-1,i)-tp1(nlev-2,i))* & + (1.5_r8*hdz(nlev-1,i,lat)-0.5_r8*hdz(nlev-2,i,lat))+gmr + tphdz0(kbot,i,lat) = 2._r8*(2._r8*tp1(kbot,i)-tp1(kbot+1,i))* & + (1.5_r8*hdz(kbot,i,lat)-0.5_r8*hdz(kbot+1,i,lat))-gmr + tphdz0(nlev,i,lat) = 2._r8*tp1(nlev-1,i)* & + (1.5_r8*hdz(nlev-1,i,lat)-0.5_r8*hdz(nlev-2,i,lat))-gmr enddo ! i=i0,i1 - diag4(:,i0:i1,lat) = tphdz0(:,i0:i1) ! TPHDZ0 - diag5(:,i0:i1,lat) = tphdz1(:,i0:i1) ! TPHDZ1 + diag4(:,i0:i1,lat) = tphdz0(:,i0:i1,lat) ! TPHDZ0 + diag5(:,i0:i1,lat) = tphdz1(:,i0:i1,lat) ! TPHDZ1 ! ! djint = dj diffusion at interfaces: ! 'DJINT' (zero at the poles - messes up the plots - may give @@ -901,12 +946,12 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & !$omp parallel do private( i, k ) do i=i0,i1 do k=kbot,nlev-1 - djint(k+1,i) = 0.5_r8*(dj(k,i,lat)+dj(k+1,i,lat)) - enddo - djint(kbot,i) = (1.5_r8*dj(kbot ,i,lat)-0.5_r8*dj(kbot+1,i,lat)) - djint(nlev,i) = (1.5_r8*dj(nlev-1,i,lat)-0.5_r8*dj(nlev-2,i,lat)) + djint(k+1,i,lat) = 0.5_r8*(dj(k,i,lat)+dj(k+1,i,lat)) + enddo + djint(kbot,i,lat) = (1.5_r8*dj(kbot ,i,lat)-0.5_r8*dj(kbot+1,i,lat)) + djint(nlev,i,lat) = (1.5_r8*dj(nlev-1,i,lat)-0.5_r8*dj(nlev-2,i,lat)) enddo ! i=i0,i1 - diag6(:,i0:i1,lat) = djint(:,i0:i1) ! DJINT + diag6(:,i0:i1,lat) = djint(:,i0:i1,lat) ! DJINT ! ! divbz = (DIV(B)+(DH*D*BZ)/(D*BZ) ! 'DIVBZ' Field appears as a line following mins along magnetic equator (zero at poles) @@ -915,10 +960,10 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & !$omp parallel do private( i, k ) do i=i0,i1 do k=kbot,nlev - divbz(k,i) = & - dvb(i,lat)+1._r8/(re*dj(k,i,lat)*bz(i,lat)**2)*(bx(i,lat)/ & - cs(lat)*(dj(k,i+1,lat)*bz(i+1,lat)-dj(k,i-1,lat)* & - bz(i-1,lat))/(2._r8*dlamda)+by(i,lat)*(dj(k,i,jp1)* & + divbz(k,i) = & + dvb(i,lat)+1._r8/(Rearth*dj(k,i,lat)*bz(i,lat)**2)*(bx(i,lat)/ & + cs(lat)*(dj(k,i+1,lat)*bz(i+1,lat)-dj(k,i-1,lat)* & + bz(i-1,lat))/(2._r8*dlamda)+by(i,lat)*(dj(k,i,jp1)* & bz(i,jp1)-dj(k,i,jm1)*bz(i,jm1))/(2._r8*dphi)) enddo ! k=kbot,nlev enddo ! i=i0,i1 @@ -931,12 +976,12 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & !$omp parallel do private( i, k ) do i=i0,i1 do k=kbot,nlev - hdzmbz(k,i) = (hdz(k,i)-0.5_r8*divbz(k,i))*bz(i,lat)**2 - hdzpbz(k,i) = (hdz(k,i)+0.5_r8*divbz(k,i))*bz(i,lat)**2 + hdzmbz(k,i,lat) = (hdz(k,i,lat)-0.5_r8*divbz(k,i))*bz(i,lat)**2 + hdzpbz(k,i,lat) = (hdz(k,i,lat)+0.5_r8*divbz(k,i))*bz(i,lat)**2 enddo ! k=kbot,nlev enddo ! i=i0,i1 - diag8(:,i0:i1,lat) = hdzmbz(:,i0:i1) ! HDZMBZ - diag9(:,i0:i1,lat) = hdzpbz(:,i0:i1) ! HDZPBZ + diag8(:,i0:i1,lat) = hdzmbz(:,i0:i1,lat) ! HDZMBZ + diag9(:,i0:i1,lat) = hdzpbz(:,i0:i1,lat) ! HDZPBZ ! ! Sum O+ at time n-1 to explicit terms: N(O+)/(2*DT) (N-1) ! 'EXPLICIT2' (zero at the poles) @@ -948,6 +993,10 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & (opnm_smooth(k,i+2,lat)+opnm_smooth(k,i-2,lat)-4._r8* & (opnm_smooth(k,i+1,lat)+opnm_smooth(k,i-1,lat))+6._r8* & opnm_smooth(k,i,lat)))*dtx2inv + op_dt(k,i,lat) = -(opnm_smooth(k,i,lat)-shapiro_const* & + (opnm_smooth(k,i+2,lat)+opnm_smooth(k,i-2,lat)-4._r8* & + (opnm_smooth(k,i+1,lat)+opnm_smooth(k,i-1,lat))+6._r8* & + opnm_smooth(k,i,lat)))*dtx2inv enddo ! k=kbot,nlev enddo ! i=i0,i1 diag10(:,i0:i1,lat) = explicit(:,i0:i1,lat) ! EXPLICIT2 @@ -957,10 +1006,10 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & !$omp parallel do private( i, k ) do i=i0,i1 do k=kbot,nlev-1 - p_coeff(k,i,lat) = hdzmbz(k,i)*djint(k ,i)*tphdz0(k ,i) - q_coeff(k,i,lat) = -(hdzpbz(k,i)*djint(k+1,i)*tphdz0(k+1,i)+ & - hdzmbz(k,i)*djint(k ,i)*tphdz1(k ,i)) - r_coeff(k,i,lat) = hdzpbz(k,i)*djint(k+1,i)*tphdz1(k+1,i) + p_coeff(k,i,lat) = hdzmbz(k,i,lat)*djint(k ,i,lat)*tphdz0(k ,i,lat) + q_coeff(k,i,lat) = -(hdzpbz(k,i,lat)*djint(k+1,i,lat)*tphdz0(k+1,i,lat)+ & + hdzmbz(k,i,lat)*djint(k ,i,lat)*tphdz1(k ,i,lat)) + r_coeff(k,i,lat) = hdzpbz(k,i,lat)*djint(k+1,i,lat)*tphdz1(k+1,i,lat) enddo ! k=kbot,nlev-1 enddo ! i=i0,i1 @@ -976,11 +1025,11 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & !$omp parallel do private( i, k ) do i=i0,i1 do k=kbot,nlev - bdotu(k,i) = bx(i,lat)*un(k,i,lat)+by(i,lat)*vn(k,i,lat)+ & + bdotu(k,i,lat) = bx(i,lat)*un(k,i,lat)+by(i,lat)*vn(k,i,lat)+ & hj(k,i,lat)*bz(i,lat)*om(k,i,lat) enddo ! k=kbot,nlev enddo ! i=i0,i1 - diag14(:,i0:i1,lat) = bdotu(:,i0:i1) ! BDOTU + diag14(:,i0:i1,lat) = bdotu(:,i0:i1,lat) ! BDOTU ! ! Continue coefficients with vertical ion drift: ! wi is converted from interfaces to midpoints (first use of wi). @@ -990,13 +1039,13 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & do i=i0,i1 do k=kbot,nlev-2 - p_coeff(k+1,i,lat) = p_coeff(k+1,i,lat)+(bz(i,lat)*bdotu(k,i)+ & - 0.5_r8*(wi(k+1,i,lat)+wi(k+2,i,lat)))*0.5_r8*hdz(k+1,i) + p_coeff(k+1,i,lat) = p_coeff(k+1,i,lat)+(bz(i,lat)*bdotu(k,i,lat)+ & + 0.5_r8*(wi(k+1,i,lat)+wi(k+2,i,lat)))*0.5_r8*hdz(k+1,i,lat) - q_coeff(k,i,lat) = q_coeff(k,i,lat)-0.5_r8*(wi(k,i,lat)+wi(k+1,i,lat))*6._r8/re + q_coeff(k,i,lat) = q_coeff(k,i,lat)-0.5_r8*(wi(k,i,lat)+wi(k+1,i,lat))*6._r8/Rearth - r_coeff(k,i,lat) = r_coeff(k,i,lat)-(bz(i,lat)*bdotu(k+1,i)+ & - 0.5_r8*(wi(k,i,lat)+wi(k+1,i,lat)))*0.5_r8*hdz(k,i) + r_coeff(k,i,lat) = r_coeff(k,i,lat)-(bz(i,lat)*bdotu(k+1,i,lat)+ & + 0.5_r8*(wi(k,i,lat)+wi(k+1,i,lat)))*0.5_r8*hdz(k,i,lat) enddo ! k=kbot,nlev-1 enddo ! i=i0,i1 @@ -1013,16 +1062,16 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & ! !$omp parallel do private( i ) do i=i0,i1 - p_coeff(kbot,i,lat) = p_coeff(kbot,i,lat)+(bz(i,lat)* & ! reset p_coeff lbc - (2._r8*bdotu(kbot,i)-bdotu(kbot+1,i))+ & - 0.5_r8*(wi(kbot,i,lat)+wi(kbot+1,i,lat)))*0.5_r8*hdz(kbot,i) + p_coeff(kbot,i,lat) = p_coeff(kbot,i,lat)+(bz(i,lat)* & ! reset p_coeff lbc + (2._r8*bdotu(kbot,i,lat)-bdotu(kbot+1,i,lat))+ & + 0.5_r8*(wi(kbot,i,lat)+wi(kbot+1,i,lat)))*0.5_r8*hdz(kbot,i,lat) - q_coeff(nlev-1,i,lat) = q_coeff(nlev-1,i,lat)- & - 0.5_r8*(wi(nlev,i,lat)+wi(nlev-1,i,lat))*6._r8/re + q_coeff(nlev-1,i,lat) = q_coeff(nlev-1,i,lat)- & + 0.5_r8*(wi(nlev,i,lat)+wi(nlev-1,i,lat))*6._r8/Rearth - r_coeff(nlev-1,i,lat) = r_coeff(nlev-1,i,lat)-(bz(i,lat)* & - (2._r8*bdotu(nlev-1,i)-bdotu(nlev-2,i))+ & - 0.5_r8*(wi(nlev,i,lat)+wi(nlev-1,i,lat)))*0.5_r8*hdz(nlev-1,i) + r_coeff(nlev-1,i,lat) = r_coeff(nlev-1,i,lat)-(bz(i,lat)* & + (2._r8*bdotu(nlev-1,i,lat)-bdotu(nlev-2,i,lat))+ & + 0.5_r8*(wi(nlev,i,lat)+wi(nlev-1,i,lat)))*0.5_r8*hdz(nlev-1,i,lat) enddo ! i=i0,i1 ! ! Extrapolate to top level (tiegcm does not do this): @@ -1042,7 +1091,7 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & !$omp parallel do private( i, k ) do i=i0,i1 do k=kbot,nlev - q_coeff(k,i,lat) = q_coeff(k,i,lat)-bdotu(k,i)*dvb(i,lat)*bz(i,lat)-dtx2inv + q_coeff(k,i,lat) = q_coeff(k,i,lat)-bdotu(k,i,lat)*dvb(i,lat)*bz(i,lat)-dtx2inv enddo ! k=kbot,nlev-1 enddo ! i=i0,i1 ! @@ -1053,8 +1102,8 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & !$omp parallel do private( i ) do i=i0,i1 ubca(i) = 0._r8 - ubcb(i) = -bz(i,lat)**2*djint(nlev,i)*tphdz0(nlev,i)-ubca(i) - ubca(i) = -bz(i,lat)**2*djint(nlev,i)*tphdz1(nlev,i)+ubca(i) + ubcb(i) = -bz(i,lat)**2*djint(nlev,i,lat)*tphdz0(nlev,i,lat)-ubca(i) + ubca(i) = -bz(i,lat)**2*djint(nlev,i,lat)*tphdz1(nlev,i,lat)+ubca(i) ! ! Q = Q+B/A*R q_coeff(nlev,i,lat) = q_coeff(nlev,i,lat)+ubcb(i)/ubca(i)* & @@ -1094,7 +1143,7 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & call setpoles(diag6 (kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) ! DJINT ! ! All tasks have global 2d bmod2. -! bmod2 was set by sub magfield (getapex.F90) +! bmod2 was set by sub magfield (getapex.F90) ! allocate(bmod2(0:nlonp1,jspole-1:jnpole+1)) ! Copy bmod2 poles to diagnostic array. ! @@ -1105,7 +1154,9 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & diag25(k,i,j1) = bmod2(i,j1) enddo enddo - call savefld_waccm_switch(diag25,'BMOD2' ,nlev,i0,i1,j0,j1) + if (debug_hist) then + call savefld_waccm(diag25,'BMOD2' ,nlev,i0,i1,j0,j1) + endif ! ! Assign polar values to coefficients for trsolv. ! @@ -1117,7 +1168,7 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & ! Call solver, defining O+ output op_out: ! ! Its best not to call this unless the coefficients and explicit terms -! have been properly set in the third latitude scan above (e.g., during +! have been properly set in the third latitude scan above (e.g., during ! "goto 300" debugging above, where the coeffs may not have been calculated). ! if (calltrsolv) then @@ -1132,9 +1183,57 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & op_out (kbot:nlev,i0:i1,lat), & kbot,nlev,kbot,nlev,i0,i1 ) + + + +! for term analysis + do k=kbot,nlev-1 +! diffusion + amb_diff(k,i0:i1,lat) = amb_diff(k,i0:i1,lat) + & + hdzmbz(k,i0:i1,lat)*djint(k, i0:i1,lat)*tphdz0(k, i0:i1,lat)* op_out(k-1,i0:i1,lat) & + -(hdzpbz(k,i0:i1,lat)*djint(k+1,i0:i1,lat)*tphdz0(k+1,i0:i1,lat)+ & + hdzmbz(k,i0:i1,lat)*djint(k ,i0:i1,lat)*tphdz1(k ,i0:i1,lat))* op_out(k,i0:i1,lat) & + +hdzpbz(k,i0:i1,lat)*djint(k+1,i0:i1,lat)*tphdz1(k+1,i0:i1,lat)* op_out(k+1,i0:i1,lat) + +! electric field transport + if (k <= nlev-2) then + dfield(k,i0:i1,lat) = dfield(k,i0:i1,lat)+ & + (0.5_r8*(wi(k+1,i0:i1,lat)+wi(k+2,i0:i1,lat)))* & + 0.5_r8*hdz(k+1,i0:i1,lat)* op_out(k-1,i0:i1,lat) & + -0.5_r8*(wi(k,i0:i1,lat)+wi(k+1,i0:i1,lat))* & + 6._r8/Rearth* op_out(k,i0:i1,lat) & + -(0.5_r8*(wi(k,i0:i1,lat)+wi(k+1,i0:i1,lat)))*0.5_r8*hdz(k,i0:i1,lat) & + * op_out(k+1,i0:i1,lat) + else + dfield(k,i0:i1,lat) = dfield(k,i0:i1,lat)+ & + (1*(wi(k+1,i0:i1,lat)))* & + 0.5_r8*hdz(k+1,i0:i1,lat)* op_out(k-1,i0:i1,lat) & + -0.5_r8*(wi(k,i0:i1,lat)+wi(k+1,i0:i1,lat))* & + 6._r8/Rearth* op_out(k,i0:i1,lat) & + -(0.5_r8*(wi(k,i0:i1,lat)+wi(k+1,i0:i1,lat)))*0.5_r8*hdz(k,i0:i1,lat) & + * op_out(k+1,i0:i1,lat) + endif +! wind transport + dwind(k,i0:i1,lat)= & + (bz(i0:i1,lat)*bdotu(k,i0:i1,lat))* 0.5_r8*hdz(k+1,i0:i1,lat) * op_out(k-1,i0:i1,lat) & + -bdotu(k,i0:i1,lat)*dvb(i0:i1,lat)*bz(i0:i1,lat)* op_out(k,i0:i1,lat) & + -(bz(i0:i1,lat)*bdotu(k+1,i0:i1,lat))*0.5_r8*hdz(k,i0:i1,lat)* op_out(k+1,i0:i1,lat) + +! dO+/dt + op_dt(k,i0:i1,lat)= dtx2inv* op_out(k,i0:i1,lat) + op_dt(k,i0:i1,lat) +! + enddo ! k=lev0+1,lev1-1 + enddo - call savefld_waccm_switch(op_out,'OP_SOLVE',nlev,i0,i1,j0,j1) + call savefld_waccm(op_dt,'op_dt',nlev,i0,i1,j0,j1) + call savefld_waccm(amb_diff,'amb_diff',nlev,i0,i1,j0,j1) + call savefld_waccm(dfield,'dfield',nlev,i0,i1,j0,j1) + call savefld_waccm(dwind,'dwind',nlev,i0,i1,j0,j1) + + if (debug_hist) then + call savefld_waccm(op_out,'OP_SOLVE',nlev,i0,i1,j0,j1) + endif else ! trsolv not called (debug only) op_out (kbot:nlev,i0:i1,j0:j1) = op (kbot:nlev,i0:i1,j0:j1) @@ -1143,38 +1242,40 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & ! ! Write fields from third latitude scan to waccm history: ! - call savefld_waccm_switch(explicit,'EXPLICIT',nlev,i0,i1,j0,j1) ! non-zero at ubc - call savefld_waccm_switch(p_coeff ,'P_COEFF' ,nlev,i0,i1,j0,j1) ! zero at ubc? - call savefld_waccm_switch(q_coeff ,'Q_COEFF' ,nlev,i0,i1,j0,j1) ! non-zero at ubc - call savefld_waccm_switch(r_coeff ,'R_COEFF' ,nlev,i0,i1,j0,j1) ! is set zero at ubc - - call savefld_waccm_switch(bdotdh_diff(:,i0:i1,j0:j1), 'BDOTDH_DIFF',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag1 ,'BDZDVB_OP',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag2 ,'EXPLICIT0',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag26,'EXPLICITa',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag27,'EXPLICITb',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag3 ,'EXPLICIT1',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag4 ,'TPHDZ0' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag5 ,'TPHDZ1' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag6 ,'DJINT' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag7 ,'DIVBZ' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag8 ,'HDZMBZ' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag9 ,'HDZPBZ' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag10,'EXPLICIT2',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag11,'P_COEFF0' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag12,'Q_COEFF0' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag13,'R_COEFF0' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag14,'BDOTU' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag15,'P_COEFF1' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag16,'Q_COEFF1' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag17,'R_COEFF1' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag18,'EXPLICIT3',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag19,'P_COEFF2' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag20,'Q_COEFF2' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag21,'R_COEFF2' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag22,'P_COEFF0a',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag23,'Q_COEFF0a',nlev,i0,i1,j0,j1) - call savefld_waccm_switch(diag24,'R_COEFF0a',nlev,i0,i1,j0,j1) + if (debug_hist) then + call savefld_waccm(explicit,'EXPLICIT',nlev,i0,i1,j0,j1) ! non-zero at ubc + call savefld_waccm(p_coeff ,'P_COEFF' ,nlev,i0,i1,j0,j1) ! zero at ubc? + call savefld_waccm(q_coeff ,'Q_COEFF' ,nlev,i0,i1,j0,j1) ! non-zero at ubc + call savefld_waccm(r_coeff ,'R_COEFF' ,nlev,i0,i1,j0,j1) ! is set zero at ubc + + call savefld_waccm(bdotdh_diff(:,i0:i1,j0:j1), 'BDOTDH_DIFF',nlev,i0,i1,j0,j1) + call savefld_waccm(diag1 ,'BDZDVB_OP',nlev,i0,i1,j0,j1) + call savefld_waccm(diag2 ,'EXPLICIT0',nlev,i0,i1,j0,j1) + call savefld_waccm(diag26,'EXPLICITa',nlev,i0,i1,j0,j1) + call savefld_waccm(diag27,'EXPLICITb',nlev,i0,i1,j0,j1) + call savefld_waccm(diag3 ,'EXPLICIT1',nlev,i0,i1,j0,j1) + call savefld_waccm(diag4 ,'TPHDZ0' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag5 ,'TPHDZ1' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag6 ,'DJINT' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag7 ,'DIVBZ' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag8 ,'HDZMBZ' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag9 ,'HDZPBZ' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag10,'EXPLICIT2',nlev,i0,i1,j0,j1) + call savefld_waccm(diag11,'P_COEFF0' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag12,'Q_COEFF0' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag13,'R_COEFF0' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag14,'BDOTU' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag15,'P_COEFF1' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag16,'Q_COEFF1' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag17,'R_COEFF1' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag18,'EXPLICIT3',nlev,i0,i1,j0,j1) + call savefld_waccm(diag19,'P_COEFF2' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag20,'Q_COEFF2' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag21,'R_COEFF2' ,nlev,i0,i1,j0,j1) + call savefld_waccm(diag22,'P_COEFF0a',nlev,i0,i1,j0,j1) + call savefld_waccm(diag23,'Q_COEFF0a',nlev,i0,i1,j0,j1) + call savefld_waccm(diag24,'R_COEFF0a',nlev,i0,i1,j0,j1) + endif ! !------------------------------------------------------------------------ ! @@ -1185,10 +1286,9 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & ! if (ring_polar_filter) then call ringfilter_op(op_out(kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) - else + else call filter2_op(op_out(kbot:nlev,i0:i1,j0:j1),kbot,nlev,i0,i1,j0,j1) endif - ! !----------------------- Begin fourth latitude scan --------------------- ! @@ -1210,7 +1310,7 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & enddo ! i=lon0,lon1 ! ! Enforce O+ minimum if enforce_opfloor is true. -! Opfloor is Stan's "smooth floor" (product of two Gaussians, +! Opfloor is Stan's "smooth floor" (product of two Gaussians, ! dependent on latitude and pressure level) (opmin=3000.0): ! if (enforce_floor) then @@ -1230,8 +1330,10 @@ subroutine oplus_xport(tn,te,ti,un,vn,om,zg,o2,o1,n2,op_in,opnm_in, & ! ! Save O+ output to WACCM history (cm^3): - call savefld_waccm_switch(op_out (:,i0:i1,j0:j1),'OP_OUT' ,nlev,i0,i1,j0,j1) - call savefld_waccm_switch(opnm_out(:,i0:i1,j0:j1),'OPNM_OUT',nlev,i0,i1,j0,j1) + if (debug_hist) then + call savefld_waccm(op_out (:,i0:i1,j0:j1),'OP_OUT' ,nlev,i0,i1,j0,j1) + call savefld_waccm(opnm_out(:,i0:i1,j0:j1),'OPNM_OUT',nlev,i0,i1,j0,j1) + endif end subroutine oplus_xport !----------------------------------------------------------------------- subroutine oplus_flux(opflux,lon0,lon1,lat0,lat1) @@ -1254,9 +1356,9 @@ subroutine oplus_flux(opflux,lon0,lon1,lat0,lat1) phin = -2.0e8_r8, & ! phin = 0._r8, & ppolar = 0._r8 - real(r8) :: a(lon0:lon1) - real(r8) :: fed(lon0:lon1) - real(r8) :: fen(lon0:lon1) + real(r8) :: a(lon0:lon1) + real(r8) :: fed(lon0:lon1) + real(r8) :: fen(lon0:lon1) ! ! Set some paramaters: pi = 4._r8*atan(1._r8) @@ -1324,7 +1426,7 @@ subroutine get_zenith(chi,i0,i1,j0,j1) do i=i0,i1 call zenith(calday,(/dtr*glat(j)/),(/dtr*glon(i)/),cosZenAngR,1) chi(i,j) = acos(cosZenAngR(1)) - enddo + enddo enddo end subroutine get_zenith !----------------------------------------------------------------------- @@ -1335,20 +1437,21 @@ subroutine divb(dvb,i0,i1,j0,j1) ! ! Args: integer,intent(in) :: i0,i1,j0,j1 - real(r8),intent(out) :: dvb(i0:i1,j0:j1) + real(r8),intent(out) :: dvb(i0:i1,j0:j1) ! ! Local: integer :: i,j,jm1,jp1 - real(r8),parameter :: re = 6.37122e8_r8 ! earth radius (cm) dvb = 0._r8 - call savefld_waccm(bx(i0:i1,j0:j1),'OPLUS_BX',1,i0,i1,j0,j1) - call savefld_waccm(by(i0:i1,j0:j1),'OPLUS_BY',1,i0,i1,j0,j1) - call savefld_waccm(bz(i0:i1,j0:j1),'OPLUS_BZ',1,i0,i1,j0,j1) - call savefld_waccm(bmod2(i0:i1,j0:j1),'OPLUS_BMAG',1,i0,i1,j0,j1) + if (debug_hist) then + call savefld_waccm(bx(i0:i1,j0:j1),'OPLUS_BX',1,i0,i1,j0,j1) + call savefld_waccm(by(i0:i1,j0:j1),'OPLUS_BY',1,i0,i1,j0,j1) + call savefld_waccm(bz(i0:i1,j0:j1),'OPLUS_BZ',1,i0,i1,j0,j1) + call savefld_waccm(bmod2(i0:i1,j0:j1),'OPLUS_BMAG',1,i0,i1,j0,j1) + endif ! -! Note re is in cm. +! Note Rearth is in cm. ! (bx,by,bz are set by sub magfield (getapex.F90)) ! (dphi,dlamda, and cs are set by sub set_geogrid (edyn_init.F90)) ! @@ -1358,7 +1461,7 @@ subroutine divb(dvb,i0,i1,j0,j1) do i=i0,i1 dvb(i,j) = (((bx(i+1,j)-bx(i-1,j))/(2._r8*dlamda)+ & (cs(jp1)*by(i,jp1)-cs(jm1)*by(i,jm1))/(2._r8*dphi))/ & - cs(j)+2._r8*bz(i,j))/re + cs(j)+2._r8*bz(i,j))/Rearth enddo ! i=i0,i1 enddo ! j=j0,j1 end subroutine divb @@ -1380,7 +1483,7 @@ subroutine rrk(t,rms,ps1,ps2,n2,tr,ans,lon0,lon1,lev0,lev1) !$omp parallel do private(i,k) do i=lon0,lon1 do k=lev0,lev1-1 - + ans(k,i) = 1.42e17_r8*boltz*t(k,i)/(p0*expz(k)*.5_r8*(rms(k,i)+ & rms(k+1,i))*(ps2(k,i)*rmassinv_o1*sqrt(tr(k,i))*(1._r8-0.064_r8* & log10(tr(k,i)))**2*colfac+18.6_r8*n2(k,i)*rmassinv_n2+18.1_r8* & @@ -1390,9 +1493,9 @@ subroutine rrk(t,rms,ps1,ps2,n2,tr,ans,lon0,lon1,lev0,lev1) ans(lev1,i) = ans(lev1-1,i) ! should not need to do this enddo ! i=lon0,lon1 -! +! ! Cap ambipolar diffusion coefficient in ans. -! +! ! acceptable range for limiter 1.e8 to 1.e9 ... where( ans(:,:) > adiff_limiter ) ans(:,:) = adiff_limiter @@ -1404,7 +1507,7 @@ subroutine diffus(tp,en,hj,ans,i0,i1,lev0,lev1,lat) ! kbot,nlev ! Evaluates ans = (d/(h*dz)*tp+m*g/r)*en ! Remember: "bot2top": lev0=kbot=bottom, lev1=nlev=top -! +! ! Args: integer :: i0,i1,lev0,lev1,lat real(r8),dimension(lev0:lev1,i0:i1),intent(in) :: tp,en,hj @@ -1463,8 +1566,8 @@ subroutine bdotdh(phijm1,phij,phijp1,ans,lon0,lon1,lev0,lev1,lat) !$omp parallel do private( i, k ) do i=lon0,lon1 do k=lev0,lev1 - ans(k,i) = 1._r8/re*(bx(i,lat)/(cs(lat)*2._r8*dlamda)* & - (phij(k,i+1)-phij(k,i-1))+by(i,lat)* & + ans(k,i) = 1._r8/Rearth*(bx(i,lat)/(cs(lat)*2._r8*dlamda)* & + (phij(k,i+1)-phij(k,i-1))+by(i,lat)* & (phijp1(k,i)-phijm1(k,i))/(2._r8*dphi)) enddo ! k=lev0,lev1 enddo ! i=lon0,lon1 @@ -1571,7 +1674,7 @@ subroutine filter1_op(f,k0,k1,i0,i1,j0,j1) do k=k0,k1 fik(i,k-k0+1) = fkij(1)%ptr(k-k0+1,i,j) enddo - enddo + enddo ! ! Remove wave numbers > kut(lat): ! @@ -1650,7 +1753,7 @@ subroutine filter2_op(f,k0,k1,i0,i1,j0,j1) do k=k0,k1 fik(i,k-k0+1) = fkij(1)%ptr(k-k0+1,i,j) enddo - enddo + enddo ! ! Remove wave numbers > kut(lat): ! @@ -1681,6 +1784,7 @@ subroutine filter2_op(f,k0,k1,i0,i1,j0,j1) enddo deallocate(fkij(1)%ptr) end subroutine filter2_op +!----------------------------------------------------------------------- !----------------------------------------------------------------------- subroutine ringfilter_op(f,k0,k1,i0,i1,j0,j1) use filter_module,only: ringfilter @@ -1728,7 +1832,7 @@ subroutine ringfilter_op(f,k0,k1,i0,i1,j0,j1) do k=k0,k1 fik(i,k-k0+1) = fkij(1)%ptr(k-k0+1,i,j) enddo - enddo + enddo ! ! Remove wave numbers > kut(lat): ! diff --git a/src/ionosphere/waccmx/regridder.F90 b/src/ionosphere/waccmx/regridder.F90 new file mode 100644 index 0000000000..011685ae36 --- /dev/null +++ b/src/ionosphere/waccmx/regridder.F90 @@ -0,0 +1,137 @@ +!------------------------------------------------------------------------------- +! Utility module for mapping fields between CAM physics, oplus transport, and +! geomagnetic grids +!------------------------------------------------------------------------------- +module regridder + use shr_kind_mod,only: r8 => shr_kind_r8 ! 8-byte reals + use cam_abortutils, only: endrun + + use edyn_mpi, only: mlon0, mlon1, mlat0, mlat1, mlev0, mlev1 + use edyn_mpi, only: lon0, lon1, lat0, lat1, lev0, lev1 + + use edyn_esmf, only: edyn_esmf_set3d_phys, edyn_esmf_regrid_phys2mag + use edyn_esmf, only: edyn_esmf_regrid_phys2geo, edyn_esmf_get_3dfield + use edyn_esmf, only: edyn_esmf_set2d_phys, edyn_esmf_get_2dfield, edyn_esmf_get_2dphysfield, edyn_esmf_set3d_geo + use edyn_esmf, only: edyn_esmf_regrid_geo2mag, edyn_esmf_regrid_geo2phys + use edyn_esmf, only: edyn_esmf_set2d_geo, edyn_esmf_set3d_mag, edyn_esmf_regrid_mag2geo + use edyn_esmf, only: phys_3dfld, phys_2dfld + use edyn_esmf, only: geo_3dfld, geo_2dfld + use edyn_esmf, only: mag_des_3dfld, mag_des_2dfld + use edyn_esmf, only: mag_src_3dfld, mag_src_2dfld + use edyn_esmf, only: edyn_esmf_set2d_mag, edyn_esmf_regrid_mag2phys, edyn_esmf_get_1dfield + + implicit none + +contains + + !----------------------------------------------------------------------------- + ! map horizontal 2D fields from magnetic grid to physcis grid + !----------------------------------------------------------------------------- + subroutine regrid_mag2phys_2d(magfld, physfld, cols, cole) + integer, intent(in) :: cols, cole + real(r8), intent(in) :: magfld(mlon0:mlon1,mlat0:mlat1) + real(r8), intent(out) :: physfld(cols:cole) + + call edyn_esmf_set2d_mag( mag_src_2dfld, magfld, mlon0, mlon1, mlat0, mlat1 ) + call edyn_esmf_regrid_mag2phys( mag_src_2dfld, phys_2dfld, 2) + call edyn_esmf_get_1dfield(phys_2dfld, physfld, cols, cole ) + + end subroutine regrid_mag2phys_2d + + !----------------------------------------------------------------------------- + ! map 3D feilds from magnetic grid to oplus grid + !----------------------------------------------------------------------------- + subroutine regrid_mag2geo_3d(magfld,geofld) + real(r8), intent(in) :: magfld(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1) + real(r8), intent(out) :: geofld(lon0:lon1,lat0:lat1,lev0:lev1) + + call edyn_esmf_set3d_mag( mag_src_3dfld, magfld, mlon0, mlon1, mlat0, mlat1, mlev0, mlev1 ) + call edyn_esmf_regrid_mag2geo(mag_src_3dfld, geo_3dfld, 3) + call edyn_esmf_get_3dfield(geo_3dfld, geofld, lon0, lon1, lat0, lat1, lev0, lev1) + + end subroutine regrid_mag2geo_3d + + !----------------------------------------------------------------------------- + ! map horizontal 2D fields from physcis grid to oplus grid + !----------------------------------------------------------------------------- + subroutine regrid_phys2geo_2d( physfld, geofld, cols, cole ) + integer, intent(in) :: cols, cole + real(r8), intent(in) :: physfld(cols:cole) + real(r8), intent(out) :: geofld(lon0:lon1,lat0:lat1) + + call edyn_esmf_set2d_phys( phys_2dfld , physfld, cols, cole) + call edyn_esmf_regrid_phys2geo(phys_2dfld, geo_2dfld, 2) + call edyn_esmf_get_2dfield(geo_2dfld, geofld, lon0, lon1, lat0, lat1 ) + + end subroutine regrid_phys2geo_2d + + !----------------------------------------------------------------------------- + ! map 3D fields from physcis grid to oplus grid + !----------------------------------------------------------------------------- + subroutine regrid_phys2geo_3d( physfld, geofld, plev, cols, cole ) + integer, intent(in) :: plev, cols, cole + real(r8), intent(in) :: physfld(1:plev,cols:cole) + real(r8), intent(out) :: geofld(lon0:lon1,lat0:lat1,lev0:lev1) + + call edyn_esmf_set3d_phys( phys_3dfld, physfld, 1, plev, cols, cole) + call edyn_esmf_regrid_phys2geo(phys_3dfld, geo_3dfld, 3) + call edyn_esmf_get_3dfield(geo_3dfld, geofld, lon0, lon1, lat0, lat1, lev0, lev1 ) + + end subroutine regrid_phys2geo_3d + + !----------------------------------------------------------------------------- + ! map 3D fields from oplus grid to magnetic grid + !----------------------------------------------------------------------------- + subroutine regrid_geo2mag_3d( geofld, magfld ) + real(r8), intent(in) :: geofld(lon0:lon1,lat0:lat1,lev0:lev1) + real(r8), intent(out) :: magfld(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1) + + call edyn_esmf_set3d_geo( geo_3dfld, geofld, lon0, lon1, lat0, lat1, lev0, lev1 ) + call edyn_esmf_regrid_geo2mag(geo_3dfld, mag_des_3dfld, 3) + call edyn_esmf_get_3dfield(mag_des_3dfld, magfld, mlon0, mlon1, mlat0, mlat1, mlev0, mlev1 ) + + end subroutine regrid_geo2mag_3d + + !----------------------------------------------------------------------------- + ! map horizontal 2D fields from oplus grid to magnetic grid + !----------------------------------------------------------------------------- + subroutine regrid_geo2mag_2d( geofld, magfld ) + real(r8), intent(in) :: geofld(lon0:lon1,lat0:lat1) + real(r8), intent(out) :: magfld(mlon0:mlon1,mlat0:mlat1) + + call edyn_esmf_set2d_geo( geo_2dfld, geofld, lon0, lon1, lat0, lat1 ) + call edyn_esmf_regrid_geo2mag(geo_2dfld, mag_des_2dfld, 2) + call edyn_esmf_get_2dfield(mag_des_2dfld, magfld, mlon0, mlon1, mlat0, mlat1 ) + + end subroutine regrid_geo2mag_2d + + !----------------------------------------------------------------------------- + ! map 3D fields from oplus grid to physics grid + !----------------------------------------------------------------------------- + subroutine regrid_geo2phys_3d( geofld, physfld, plev, cols, cole ) + integer, intent(in) :: plev, cols, cole + real(r8), intent(in) :: geofld(lon0:lon1,lat0:lat1,lev0:lev1) + real(r8), intent(out) :: physfld(1:plev,cols:cole) + + + call edyn_esmf_set3d_geo( geo_3dfld, geofld, lon0, lon1, lat0, lat1, lev0, lev1 ) + call edyn_esmf_regrid_geo2phys(geo_3dfld, phys_3dfld, 3) + call edyn_esmf_get_2dphysfield(phys_3dfld, physfld, 1, plev, cols, cole ) + + end subroutine regrid_geo2phys_3d + + !----------------------------------------------------------------------------- + ! map 3D fields from physics grid to magnetic + !----------------------------------------------------------------------------- + subroutine regrid_phys2mag_3d( physfld, magfld, plev, cols, cole ) + integer, intent(in) :: plev, cols, cole + real(r8), intent(in) :: physfld(1:plev,cols:cole) + real(r8), intent(out) :: magfld(mlon0:mlon1,mlat0:mlat1,mlev0:mlev1) + + call edyn_esmf_set3d_phys( phys_3dfld, physfld, 1, plev, cols, cole) + call edyn_esmf_regrid_phys2mag(phys_3dfld, mag_des_3dfld, 3) + call edyn_esmf_get_3dfield(mag_des_3dfld, magfld, mlon0, mlon1, mlat0, mlat1, mlev0, mlev1 ) + + end subroutine regrid_phys2mag_3d + +end module regridder diff --git a/src/ionosphere/waccmx/savefield_waccm.F90 b/src/ionosphere/waccmx/savefield_waccm.F90 index f968700f1c..e6d6f4877d 100644 --- a/src/ionosphere/waccmx/savefield_waccm.F90 +++ b/src/ionosphere/waccmx/savefield_waccm.F90 @@ -1,15 +1,14 @@ module savefield_waccm use shr_kind_mod,only: r8 => shr_kind_r8 ! 8-byte reals use cam_history ,only: hist_fld_active,outfld ! Routine to output fields to history files - use edyn_mpi ,only: array_ptr_type ! ! Save fields to WACCM output history file. ! implicit none - save private - public savefld_waccm,savefld_waccm_switch - contains + public :: savefld_waccm + +contains !----------------------------------------------------------------------- subroutine savefld_waccm(f,name,nlev,i0,i1,j0,j1) ! @@ -32,7 +31,7 @@ subroutine savefld_waccm(f,name,nlev,i0,i1,j0,j1) do j=j0,j1 do i=i0,i1 do k=1,nlev - diag_ik(i,k) = f(k,i,j) + diag_ik(i,k) = f(nlev-k+1,i,j) enddo enddo call outfld(name,diag_ik,i1-i0+1,j) @@ -46,53 +45,5 @@ subroutine savefld_waccm(f,name,nlev,i0,i1,j0,j1) enddo endif end subroutine savefld_waccm -!----------------------------------------------------------------------- - subroutine savefld_waccm_switch(f,name,plev,i0,i1,j0,j1) -! -! Copy input array to a local array, associate a pointer to the local array, -! switch the "model format" of the pointer (shift longitude and invert vertical), -! (TIEGCM to WACCM in this case), and save the local array to WACCM history. -! (Input array is unchanged) -! - use edyn_mpi ,only: switch_model_format -! -! Args: - integer,intent(in) :: plev,i0,i1,j0,j1 - real(r8),intent(in) :: f(plev,i0:i1,j0:j1) - character(len=*),intent(in) :: name -! -! Local: - integer :: i,j - real(r8),target :: ftmp(plev,i0:i1,j0:j1) - type(array_ptr_type) :: ptr(1) - - if (.not.hist_fld_active(name)) return -! -! Copy input to local array: - do j=j0,j1 - do i=i0,i1 - ftmp(:,i,j) = f(:,i,j) - enddo - enddo -! -! Associate local pointer (lonshift_blocks expects an array_ptr_type) - ptr(1)%ptr => ftmp -! -! Switch from TIEGCM format to WACCM format: -! - call switch_model_format(ptr,1,plev,i0,i1,j0,j1,1) -! -! Return data to local array, and save on WACCM history: -! - do j=j0,j1 - do i=i0,i1 - ftmp(1:plev,i,j) = ptr(1)%ptr(1:plev,i,j) - enddo - enddo - - call savefld_waccm(ftmp(:,i0:i1,j0:j1),trim(name),plev,i0,i1,j0,j1) - - end subroutine savefld_waccm_switch -!----------------------------------------------------------------------- end module savefield_waccm diff --git a/src/ionosphere/waccmx/utils_mod.F90 b/src/ionosphere/waccmx/utils_mod.F90 new file mode 100644 index 0000000000..0158ccdc07 --- /dev/null +++ b/src/ionosphere/waccmx/utils_mod.F90 @@ -0,0 +1,116 @@ +module utils_mod + use shr_kind_mod ,only: r8 => shr_kind_r8, cl=>shr_kind_cl + use cam_logfile ,only: iulog + use cam_abortutils ,only: endrun + use esmf ,only: ESMF_FIELD + use edyn_mpi ,only: mlon0,mlon1,mlat0,mlat1, lon0,lon1,lat0,lat1 + use edyn_params ,only: finit + + implicit none + private + + public :: boxcar_ave + public :: check_ncerr + public :: check_alloc + +contains + + !----------------------------------------------------------------------- + subroutine boxcar_ave(x,y,lon,lat,mtime,itime,ibox) + ! + ! perform boxcar average + ! + ! Args: + integer, intent(in) :: lon + integer, intent(in) :: lat + integer, intent(in) :: mtime + integer, intent(in) :: itime + integer, intent(in) :: ibox + real(r8), intent(in) :: x(lon,lat,mtime) + real(r8), intent(out) :: y(lon,lat) + + ! Local: + integer :: i, iset, iset1 + + if (ibox > mtime) then + call endrun('boxcar_ave: ibox > mtime') + endif + ! + iset = itime - ibox/2 + if (iset < 1) iset = 1 + iset1 = iset + ibox + if (iset1 > mtime) then + iset1 = mtime + iset = iset1 - ibox + end if + y(:,:) = 0._r8 + do i=iset,iset1 + y(:,:) = y(:,:) + x(:,:,i) + end do + if (ibox > 0) y(:,:) = y(:,:)/ibox + ! + end subroutine boxcar_ave + + !----------------------------------------------------------------------- + subroutine check_alloc(ierror, subname, varname, lonp1, latp1, ntimes, lw) + use spmd_utils, only: masterproc + integer, intent(in) :: ierror + character(len=*), intent(in) :: subname + character(len=*), intent(in) :: varname + integer, optional, intent(in) :: lonp1 + integer, optional, intent(in) :: latp1 + integer, optional, intent(in) :: ntimes + integer, optional, intent(in) :: lw + ! Local variable + character(len=cl) :: errmsg + + if (ierror /= 0) then + write(errmsg, '(">>> ",a,": error allocating ",a)') & + trim(subname), trim(varname) + if (present(lonp1)) then + write(errmsg(len_trim(errmsg)+1:), '(", lonp1 = ",i0)') lonp1 + end if + if (present(latp1)) then + write(errmsg(len_trim(errmsg)+1:), '(", latp1 = ",i0)') latp1 + end if + if (present(ntimes)) then + write(errmsg(len_trim(errmsg)+1:), '(", ntimes = ",i0)') ntimes + end if + if (present(lw)) then + write(errmsg(len_trim(errmsg)+1:), '(", lw = ",i0)') lw + end if + if (masterproc) then + write(iulog, *) trim(errmsg) + end if + call endrun(trim(errmsg)) + end if + + end subroutine check_alloc + + !----------------------------------------------------------------------- + subroutine check_ncerr(istat, subname, msg) + use pio, only: pio_noerr + ! + ! Handle a netcdf lib error: + ! + integer, intent(in) :: istat + character(len=*), intent(in) :: subname + character(len=*), intent(in) :: msg + ! + ! Local variable + character(len=cl) :: errmsg + ! + if (istat /= pio_noerr) then + write(iulog,"(/72('-'))") + write(iulog,"('>>> Error from netcdf library:')") + write(iulog,"(a,': Error getting ',a)") trim(subname), trim(msg) + + write(iulog,"('istat=',i5)") istat + write(iulog,"(72('-')/)") + write(errmsg, '("NetCDF Error in ",a,": ",2a,", istat = ",i0)') & + trim(subname), 'Error getting ', trim(msg), istat + call endrun(trim(errmsg)) + end if + end subroutine check_ncerr + +end module utils_mod diff --git a/src/ionosphere/waccmx/wei05sc.F90 b/src/ionosphere/waccmx/wei05sc.F90 index 52b9c7bc07..afc56440ed 100644 --- a/src/ionosphere/waccmx/wei05sc.F90 +++ b/src/ionosphere/waccmx/wei05sc.F90 @@ -1,8 +1,8 @@ module wei05sc ! -! The Weimer model of high-latitude potential created by Daniel Weimer and -! if extracted, distributed, or used for any purpose other than as implemented -! in the NCAR TIEGCM and CESM/WACCM models, please contact Dan Weimer for +! The Weimer model of high-latitude potential created by Daniel Weimer and +! if extracted, distributed, or used for any purpose other than as implemented +! in the NCAR TIEGCM and CESM/WACCM models, please contact Dan Weimer for ! further information and discussion. ! ! 2005 Version of the electric and magnetic potential (FAC) models @@ -30,42 +30,41 @@ module wei05sc ! September, 2015 btf: ! Modified for free-format fortran, and for CESM/WACCM (r8, etc). ! - use shr_kind_mod ,only: r8 => shr_kind_r8 - use shr_kind_mod ,only: shr_kind_cl - use spmd_utils ,only: masterproc -#ifdef WACCMX_IONOS - use cam_logfile ,only: iulog - use cam_abortutils,only: endrun - use time_manager ,only: get_curr_date - use edyn_maggrid ,only: nmlat,nmlon,nmlonp1 -#endif - - use edyn_maggrid,only: & + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_kind_mod, only: shr_kind_cl + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use time_manager, only: get_curr_date + use edyn_maggrid, only: nmlat,nmlon,nmlonp1 + + use edyn_maggrid, only: & ylonm, & ! magnetic latitudes (nmlat) (radians) ylatm ! magnetic longtitudes (nmlonp1) (radians) - use edyn_solve,only: & + use edyn_solve, only: & nmlat0, & ! (nmlat+1)/2 phihm ! output: high-latitude potential (nmlonp1,nmlat) - use physconst, only: pi - use aurora_params, only: aurora_params_set, hpower, ctpoten, theta0 - use aurora_params, only: offa, dskofa, dskofc, phid, rrad, offc, phin + use physconst, only: pi + use aurora_params, only: aurora_params_set, hpower, ctpoten, theta0 + use aurora_params, only: offa, dskofa, dskofc, phid, rrad, offc, phin implicit none private -#ifdef WACCMX_IONOS ! ! Coefficients read from netcdf data file wei05sc.nc: ! - integer,parameter :: & - na=6, nb=7, nex=2, n1_scha=19, n2_scha=7, n3_scha=68, & + integer,parameter :: & + na=6, nb=7, nex=2, n1_scha=19, n2_scha=7, n3_scha=68, & csize=28, n_schfits=15, n_alschfits=18 - integer :: maxk_scha, maxm_scha, maxl_pot, maxm_pot + integer :: maxk_scha, maxm_scha, maxl_pot, maxm_pot real(r8) :: bndya(na), bndyb(nb), ex_bndy(nex), ex_epot(nex),ex_bpot(nex) real(r8) :: th0s(n3_scha), allnkm(n1_scha,n2_scha,n3_scha) - integer :: ab(csize), ls(csize), ms(csize) - real(r8) :: epot_alschfits(n_alschfits,csize), bpot_alschfits(n_alschfits,csize) - real(r8) :: bpot_schfits(n_schfits,csize),epot_schfits(n_schfits,csize) + integer :: ab(csize), ls(csize), ms(csize) + real(r8) :: epot_alschfits(n_alschfits,csize) + real(r8) :: bpot_alschfits(n_alschfits,csize) + real(r8) :: epot_schfits(n_schfits,csize) + real(r8) :: bpot_schfits(n_schfits,csize) ! ! Intermediate calculations: ! @@ -73,16 +72,14 @@ module wei05sc real(r8) :: rad2deg,deg2rad ! set by setmodel real(r8) :: bndyfitr ! calculated by setboundary real(r8) :: esphc(csize),bsphc(csize) ! calculated by setmodel - real(r8) :: tmat(3,3) !,ttmat(3,3) ! from setboundary + real(r8) :: tmat(3,3) ! from setboundary real(r8) :: plmtable(mxtablesize,csize),colattable(mxtablesize) real(r8) :: nlms(csize) - real(r8) :: wei05sc_fac(nmlonp1,nmlat) ! field-aligned current output + real(r8),allocatable :: wei05sc_fac(:,:) ! field-aligned current output ! 05/08 bae: Have ctpoten from both hemispheres from Weimer real(r8) :: weictpoten(2),phimin,phimax - real(r8) :: real8,real8a ! for type conversion to 8-byte real - ! ! Several items in the public list are for efield.F90 (chemistry/mozart) ! (dpie_coupling calls the weimer05 driver, but efield calls the individual @@ -91,537 +88,568 @@ module wei05sc public :: weimer05 public :: weimer05_init -#endif - real(r8), parameter :: r2d = 180._r8/pi ! radians to degrees real(r8), parameter :: d2r = pi/180._r8 ! degrees to radians - contains + logical :: debug = .false. -!----------------------------------------------------------------------- - subroutine weimer05_init(wei05_ncfile) - use infnan, only: nan, assignment(=) - - character(len=*),intent(in) :: wei05_ncfile - - hpower = nan - ctpoten = nan - phin = nan - phid = nan - theta0 = nan - offa = nan - dskofa = nan - rrad = nan - offc = nan - dskofc = nan - - bndya = nan - bndyb = nan - ex_bndy = nan - ex_bpot = nan - th0s = nan - allnkm = nan - bpot_schfits = nan - bpot_alschfits = nan - - if (wei05_ncfile.ne.'NONE') then - call read_wei05_ncfile(wei05_ncfile) - aurora_params_set = .true. - endif - - end subroutine weimer05_init +contains !----------------------------------------------------------------------- - subroutine weimer05(by,bz_in,swvel,swden,sunlons) -! -! 9/16/15 btf: Driver to call Weimer 2005 model for waccm[x]. -! + subroutine weimer05_init(wei05_ncfile) + use infnan, only: nan, assignment(=) - implicit none -! -! Args: - real(r8),intent(in) :: bz_in,by,swvel,swden - real(r8),intent(in) :: sunlons(:) + character(len=*),intent(in) :: wei05_ncfile -#ifdef WACCMX_IONOS -! -! Local: + allocate(wei05sc_fac(nmlonp1,nmlat)) - real(r8) :: angl,angle,bt - integer :: i,j - real(r8) :: rmlt,mlat,tilt,htilt,hem,ut,secs - real(r8),parameter :: fill=0._r8 - integer :: iyear,imon,iday,isecs - logical :: debug = .false. - real(r8) :: bz + hpower = nan + ctpoten = nan + phin = nan + phid = nan + theta0 = nan + offa = nan + dskofa = nan + rrad = nan + offc = nan + dskofc = nan - bz = bz_in + bndya = nan + bndyb = nan + ex_bndy = nan + ex_bpot = nan + th0s = nan + allnkm = nan + bpot_schfits = nan + bpot_alschfits = nan - hpower = hp_from_bz_swvel(bz,swvel) -! -! Get current date and time: -! - call get_curr_date(iyear,imon,iday,isecs) -! -! Get sun's location (longitude at all latitudes): -! - real8 = dble(isecs) - secs = real8 + if (wei05_ncfile.ne.'NONE') then + call read_wei05_ncfile(wei05_ncfile) + aurora_params_set = .true. + endif -! -! At least one of by,bz must be non-zero: - if (by==0._r8.and.bz==0._r8) then - if (masterproc) then - write(iulog,"(/,'>>> WARNING: by and bz cannot both be zero',& - ' when calling the Weimer model: am setting bz=0.01')") - endif - bz = 0.01_r8 - endif -! - bt = sqrt(by**2+bz**2) - angl = atan2(by,bz)*r2d -! -! Convert from day-of-year to month,day and get tilt from date and ut: -! - ut = secs/3600._r8 ! decimal hours -! -! Given year and day-of-year, cvt2md returns month and day of month. -! We do not need this, since get_curr_date returns month and day of month. -! call cvt2md(iulog,iyear,idoy,imon,iday) ! given iyear,idoy, return imo,ida -! - if (debug) write(iulog,"('weimer05: iyear,imon,iday=',3i5,' ut=',f8.2)") & - iyear,imon,iday,ut - tilt = get_tilt(iyear,imon,iday,ut) - if (debug) write(iulog,"('weimer05: tilt=',e12.4)") tilt - - phihm = 0._r8 ! whole-array init (nmlonp1,nmlat) -! -! Call Weimer model for southern hemisphere electric potential: -! - hem = -1._r8 - htilt = hem * tilt - angle = hem * angl - if (debug) write(iulog,"('weimer05 call setmodel for SH potential')") - call setmodel(angle,bt,htilt,swvel,swden,'epot') - if (debug) write(iulog,"('weimer05 after setmodel for SH potential')") - do j=1,nmlat0 ! Spole to equator - do i=1,nmlon -! -! sunlons(nlat): sun's longitude in dipole coordinates (see sub sunloc) in rad -! - rmlt = (ylonm(i)-sunlons(1)) * r2d / 15._r8 + 12._r8 - mlat = abs(ylatm(j))*r2d -! -! Obtain electric potential and convert from kV to V -! - call epotval(mlat,rmlt,fill,phihm(i,j)) - phihm(i,j) = phihm(i,j)*1000._r8 - enddo ! i=1,nmlon - enddo ! j=1,nmlat0 - if (debug) write(iulog,"('weimer05: SH phihm min,max=',2es12.4)") & - minval(phihm(1:nmlon,1:nmlat0)),maxval(phihm(1:nmlon,1:nmlat0)) -! -! Re-calculate SH values of offa, dskofa, arad, and phid and phin from -! Weimer 2005 setboundary values of offc, dskofc, and theta0 -! - call wei05loc (1, by, hpower, sunlons) -! -! Call Weimer model for southern hemisphere fac: -! - if (debug) write(iulog,"('weimer05 call setmodel for SH fac')") - call setmodel(angle,bt,htilt,swvel,swden,'bpot') - if (debug) write(iulog,"('weimer05 after setmodel for SH fac')") - do j=1,nmlat0 - do i=1,nmlon - rmlt = (ylonm(i)-sunlons(1)) * r2d / 15._r8 + 12._r8 - mlat = abs(ylatm(j))*r2d - call mpfac(mlat,rmlt,fill,wei05sc_fac(i,j)) - enddo ! i=1,nmlon - enddo ! j=1,nmlat0 -! -! Call Weimer model for northern hemisphere epot: -! - hem = 1._r8 - htilt = hem * tilt - angle = hem * angl - if (debug) write(iulog,"('weimer05 call setmodel for NH potential')") - call setmodel(angle,bt,htilt,swvel,swden,'epot') - if (debug) write(iulog,"('weimer05 after setmodel for NH potential')") - do j=nmlat0+1,nmlat - do i=1,nmlon -! -! sunlons(nlat): sun's longitude in dipole coordinates (see sub sunloc) in rad - rmlt = (ylonm(i)-sunlons(1)) * r2d / 15._r8 + 12._r8 - mlat = abs(ylatm(j))*r2d -! -! Obtain electric potential and convert from kV to V - call epotval(mlat,rmlt,fill,phihm(i,j)) - phihm(i,j) = phihm(i,j)*1000._r8 - enddo ! i=1,nmlon - enddo ! j=1,nmlat0+1,nmlat - if (debug) write(iulog,"('weimer05: NH phihm min,max=',2es12.4)") & - minval(phihm(1:nmlon,nmlat0+1:nmlat)),maxval(phihm(1:nmlon,nmlat0+1:nmlat)) -! -! Re-calculate NH values of offa, dskofa, arad, and Heelis phid and phin from -! Weimer 2005 setboundary values of offc, dskofc, and theta0 -! - call wei05loc (2, by, hpower, sunlons) -! -! Call Weimer model for northern hemisphere fac: - if (debug) write(iulog,"('weimer05 call setmodel for NH fac')") - call setmodel(angle,bt,htilt,swvel,swden,'bpot') - if (debug) write(iulog,"('weimer05 after setmodel for NH fac')") - do j=nmlat0+1,nmlat - do i=1,nmlon - rmlt = (ylonm(i)-sunlons(1)) * r2d / 15._r8 + 12._r8 - mlat = abs(ylatm(j))*r2d - call mpfac(mlat,rmlt,fill,wei05sc_fac(i,j)) - enddo ! i=1,nmlon - enddo ! j=1,nmlat0 -! -! Periodic points: - do j=1,nmlat - phihm(nmlonp1,j) = phihm(1,j) - wei05sc_fac(nmlonp1,j) = wei05sc_fac(1,j) - enddo ! j=1,nmlat -! -! Calculate ctpoten for each hemisphere: -! South: -! - phimax = -1.e36_r8 - phimin = 1.e36_r8 - do j=1,nmlat0 ! SH - do i=1,nmlon - if (phihm(i,j) > phimax) phimax = phihm(i,j) - if (phihm(i,j) < phimin) phimin = phihm(i,j) - enddo - enddo - weictpoten(1) = 0.001_r8 * (phimax - phimin) -! -! North: -! - phimax = -1.e36_r8 - phimin = 1.e36_r8 - do j=nmlat0+1,nmlat ! NH - do i=1,nmlon - if (phihm(i,j) > phimax) phimax = phihm(i,j) - if (phihm(i,j) < phimin) phimin = phihm(i,j) - enddo - enddo - weictpoten(2) = 0.001_r8 * (phimax - phimin) -! -! average of the SH and NH in ctpoten - ctpoten = 0.5_r8*(weictpoten(1)+weictpoten(2)) - - if (masterproc) then - write(iulog,"('weimer05: ctpoten=',f8.2,' phihm min,max=',2es12.4)") ctpoten,minval(phihm),maxval(phihm) - endif -! - -#endif - end subroutine weimer05 -!----------------------------------------------------------------------- - subroutine read_wei05_ncfile(file) + end subroutine weimer05_init - use ioFileMod, only: getfil - use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile - use pio, only: file_desc_t, pio_nowrite, pio_inq_dimid, pio_inquire_dimension, & - pio_inq_varid, pio_get_var -! -! Read coefficients and other data from netcdf data file. -! - implicit none -! -! Arg: - character(len=*),intent(in) :: file -#ifdef WACCMX_IONOS -! -! Local: - integer :: istat - integer :: rd_na,rd_nb,rd_nex,rd_n1_scha,rd_n2_scha,rd_n3_scha,& - rd_csize,rd_n_schfits,rd_n_alschfits - integer :: id - character(len=shr_kind_cl) :: filen - type(file_desc_t) :: ncid -! -! Open netcdf file for reading: -! - call getfil( file, filen, 0 ) - call cam_pio_openfile(ncid, filen, PIO_NOWRITE) - - write(iulog,"('wei05sc: opened netcdf data file',a)") trim(filen) -! -! Read and check dimensions: -! -! na=6 - istat = pio_inq_dimid(ncid,'na',id) - istat = pio_inquire_dimension(ncid,id,len=rd_na) - if (rd_na /= na) then - write(iulog,"(/,'>>> wei05sc: rd_na /= na: rd_na=',i4,' na=',i4)") rd_na,na - call endrun('wei05sc: rd_na /= na') - endif -! -! nb=7 -! - istat = pio_inq_dimid(ncid,'nb',id) - istat = pio_inquire_dimension(ncid,id,len=rd_nb) - if (rd_na /= na) then - write(iulog,"(/,'>>> wei05sc: rd_nb /= nb: rd_nb=',i4,' nb=',i4)") rd_nb,nb - call endrun('wei05sc: rd_nb /= nb: rd_nb') - endif -! -! nex=2 -! - istat = pio_inq_dimid(ncid,'nex',id) - istat = pio_inquire_dimension(ncid,id,len=rd_nex) - if (rd_nex /= nex) then - write(iulog,"(/,'>>> wei05sc: rd_nex /= nex: rd_nex=',i4,' nex=',i4)") & - rd_nex,nex - call endrun('wei05sc') - endif -! -! n1_scha=19 -! - istat = pio_inq_dimid(ncid,'n1_scha',id) - istat = pio_inquire_dimension(ncid,id,len=rd_n1_scha) - if (rd_n1_scha /= n1_scha) then - write(iulog,"(/,'>>> wei05sc: rd_n1_scha /= n1_scha: rd_n1_scha=',i4,' n1_scha=',i4)") & - rd_n1_scha,n1_scha - call endrun('wei05sc') - endif -! -! n2_scha=7 -! - istat = pio_inq_dimid(ncid,'n2_scha',id) - istat = pio_inquire_dimension(ncid,id,len=rd_n2_scha) - if (rd_n2_scha /= n2_scha) then - write(iulog,"(/,'>>> wei05sc: rd_n2_scha /= n2_scha: rd_n2_scha=',i4,' n2_scha=',i4)") & - rd_n2_scha,n2_scha - call endrun('wei05sc') - endif -! -! n3_scha=68 -! - istat = pio_inq_dimid(ncid,'n3_scha',id) - istat = pio_inquire_dimension(ncid,id,len=rd_n3_scha) - if (rd_n3_scha /= n3_scha) then - write(6,"(/,'>>> wei05sc: rd_n3_scha /= n3_scha: rd_n3_scha=',i4,' n3_scha=',i4)") & - rd_n3_scha,n3_scha - call endrun('wei05sc') - endif -! -! csize=28 -! - istat = pio_inq_dimid(ncid,'csize',id) - istat = pio_inquire_dimension(ncid,id,len=rd_csize) - if (rd_csize /= csize) then - write(iulog,"(/,'>>> wei05sc: rd_csize /= csize: rd_csize=',i4,' csize=',i4)") & - rd_csize,csize - call endrun('wei05sc') - endif -! -! n_schfits=15 -! - istat = pio_inq_dimid(ncid,'n_schfits',id) - istat = pio_inquire_dimension(ncid,id,len=rd_n_schfits) - if (rd_n_schfits /= n_schfits) then - write(iulog,"(/,'>>> wei05sc: rd_n_schfits /= n_schfits: rd_n_schfits=',i4,' n_schfits=',i4)") & - rd_n_schfits,n_schfits - call endrun('wei05sc') - endif -! -! n_alschfits=18 -! - istat = pio_inq_dimid(ncid,'n_alschfits',id) - istat = pio_inquire_dimension(ncid,id,len=rd_n_alschfits) - if (rd_n_alschfits /= n_alschfits) then - write(iulog,"(/,'>>> wei05sc: rd_n_alschfits /= n_alschfits: rd_n_alschfits=',i4,' n_alschfits=',i4)") & - rd_n_alschfits,n_alschfits - call endrun('wei05sc') - endif -! -! integer :: maxk_scha, maxm_scha, maxl_pot, maxm_pot -! maxk_scha = 18 ; -! maxm_scha = 6 ; -! maxl_pot = 12 ; -! maxm_pot = 2 ; -! - istat = pio_inq_dimid(ncid,"maxk_scha",id) - istat = pio_inquire_dimension(ncid,id,len=maxk_scha) - istat = pio_inq_dimid(ncid,"maxm_scha",id) - istat = pio_inquire_dimension(ncid,id,len=maxm_scha) - istat = pio_inq_dimid(ncid,"maxl_pot",id) - istat = pio_inquire_dimension(ncid,id,len=maxl_pot) - istat = pio_inq_dimid(ncid,"maxm_pot",id) - istat = pio_inquire_dimension(ncid,id,len=maxm_pot) - -! write(iulog,"('wei05sc: maxk_scha=',i3,' maxm_scha=',i3)") & -! maxk_scha,maxm_scha -! write(iulog,"('wei05sc: maxl_pot=',i3,' maxm_pot=',i3)") & -! maxl_pot,maxm_pot -! -! Read variables: -! -! double bndya(na): - istat = pio_inq_varid(ncid,'bndya',id) - istat = pio_get_var(ncid,id,bndya) -! write(iulog,"('wei05sc: bndya=',/,(8f8.3))") bndya -! -! double bndyb(nb): - istat = pio_inq_varid(ncid,'bndyb',id) - istat = pio_get_var(ncid,id,bndyb) -! write(iulog,"('wei05sc: bndyb=',/,(8f8.3))") bndyb -! -! double ex_bndy(nex): - istat = pio_inq_varid(ncid,'ex_bndy',id) - istat = pio_get_var(ncid,id,ex_bndy) -! write(iulog,"('wei05sc: ex_bndy=',/,(8f8.3))") ex_bndy -! -! double th0s(n3_scha): - istat = pio_inq_varid(ncid,'th0s',id) - istat = pio_get_var(ncid,id,th0s) -! write(iulog,"('wei05sc: th0s=',/,(8f8.3))") th0s -! -! double allnkm(n1_scha,n2_scha,n3_scha): - istat = pio_inq_varid(ncid,'allnkm',id) - istat = pio_get_var(ncid,id,allnkm) -! write(iulog,"('wei05sc: allnkm min,max=',2e12.4)") minval(allnkm),maxval(allnkm) -! -! int ab(csize): - istat = pio_inq_varid(ncid,'ab',id) - istat = pio_get_var(ncid,id,ab) -! write(iulog,"('wei05sc: ab=',/,(10i4))") ab -! -! int ls(csize): - istat = pio_inq_varid(ncid,'ls',id) - istat = pio_get_var(ncid,id,ls) -! write(iulog,"('wei05sc: ls=',/,(10i4))") ls -! -! int ms(csize): - istat = pio_inq_varid(ncid,'ms',id) - istat = pio_get_var(ncid,id,ms) -! write(iulog,"('wei05sc: ms=',/,(10i4))") ms -! -! double ex_epot(nex): - istat = pio_inq_varid(ncid,'ex_epot',id) - istat = pio_get_var(ncid,id,ex_epot) -! write(iulog,"('wei05sc: ex_epot=',/,(8f8.3))") ex_epot -! -! double ex_bpot(nex): - istat = pio_inq_varid(ncid,'ex_bpot',id) - istat = pio_get_var(ncid,id,ex_bpot) -! write(iulog,"('wei05sc: ex_bpot=',/,(8f8.3))") ex_bpot -! -! double epot_schfits(csize,n_schfits): - istat = pio_inq_varid(ncid,'epot_schfits',id) - istat = pio_get_var(ncid,id,epot_schfits) -! write(iulog,"('wei05sc: epot_schfits min,max=',2e12.4)") & -! minval(epot_schfits),maxval(epot_schfits) -! -! double bpot_schfits(csize,n_schfits): - istat = pio_inq_varid(ncid,'bpot_schfits',id) - istat = pio_get_var(ncid,id,bpot_schfits) -! write(iulog,"('wei05sc: bpot_schfits min,max=',2e12.4)") & -! minval(bpot_schfits),maxval(bpot_schfits) -! -! double epot_alschfits(csize,n_alschfits): - istat = pio_inq_varid(ncid,'epot_alschfits',id) - istat = pio_get_var(ncid,id,epot_alschfits) -! write(iulog,"('wei05sc: epot_alschfits min,max=',2e12.4)") & -! minval(epot_alschfits),maxval(epot_alschfits) -! -! double bpot_alschfits(csize,n_alschfits): - istat = pio_inq_varid(ncid,'bpot_alschfits',id) - istat = pio_get_var(ncid,id,bpot_alschfits) -! write(iulog,"('wei05sc: bpot_alschfits min,max=',2e12.4)") & -! minval(bpot_alschfits),maxval(bpot_alschfits) -! -! Close file: - call cam_pio_closefile(ncid) - if(masterproc) write(iulog,"('wei05sc: completed read of file ',a)") trim(file) -#endif - end subroutine read_wei05_ncfile -#ifdef WACCMX_IONOS !----------------------------------------------------------------------- - subroutine setmodel(angle,bt,tilt,swvel,swden,model) -! -! Calculate the complete set of the models' SCHA coeficients, -! given an aribitrary IMF angle (degrees from northward toward +Y), -! given byimf, bzimf, solar wind velocity (km/sec), and density. -! - implicit none -! -! Args: - real(r8),intent(in) :: angle,bt,tilt,swvel,swden - character(len=*),intent(in) :: model -! -! Local: - integer :: i,j - real(r8) :: pi,stilt,stilt2,sw,swp,swe,c0,rang,cosa,sina,cos2a,sin2a - real(r8) :: a(n_schfits) -! - if (trim(model) /= 'epot'.and.trim(model) /= 'bpot') then - write(iulog,"('>>> model=',a)") trim(model) - write(iulog,"('>>> setmodel: model must be either','''epot'' or ''bpot''')") - call endrun('setmodel') - endif -! - pi = 4._r8*atan(1._r8) - rad2deg = 180._r8/pi - deg2rad = pi/180._r8 -! -! write(iulog,"('setmodel call setboundary: model=',a,' swvel=',e12.4)") & -! model, swvel + subroutine weimer05(by, bz_in, swvel, swden, sunlon) + ! + ! 9/16/15 btf: Driver to call Weimer 2005 model for waccm[x]. + ! - call setboundary(angle,bt,swvel,swden) -! - stilt = sin(tilt*deg2rad) - stilt2 = stilt**2 - sw = bt*swvel/1000._r8 - if (trim(model) == 'epot') then - swe = (1._r8-exp(-sw*ex_epot(2)))*sw**ex_epot(1) - else - swe = (1._r8-exp(-sw*ex_bpot(2)))*sw**ex_bpot(1) - endif - c0 = 1._r8 - swp = swvel**2 * swden*1.6726e-6_r8 - rang = angle*deg2rad - cosa = cos(rang) - sina = sin(rang) - cos2a = cos(2._r8*rang) - sin2a = sin(2._r8*rang) - if (bt < 1._r8) then ! remove angle dependency for IMF under 1 nT - cosa = -1._r8+bt*(cosa+1._r8) - cos2a = 1._r8+bt*(cos2a-1._r8) - sina = bt*sina - sin2a = bt*sin2a - endif - a = (/c0 , swe , stilt , stilt2 , swp, & - swe*cosa, stilt*cosa, stilt2*cosa, swp*cosa, & - swe*sina, stilt*sina, stilt2*sina, swp*sina, & - swe*cos2a,swe*sin2a/) - if (trim(model) == 'epot') then - esphc(:) = 0._r8 - do j=1,csize - do i=1,n_schfits - esphc(j) = esphc(j)+epot_schfits(i,j)*a(i) - enddo - enddo -! write(iulog,"('setmodel: esphc=',/,(6e12.4))") esphc - else - bsphc(:) = 0._r8 - do j=1,csize - do i=1,n_schfits - bsphc(j) = bsphc(j)+bpot_schfits(i,j)*a(i) - enddo - enddo -! write(iulog,"('setmodel: bsphc=',/,(6e12.4))") bsphc - endif - end subroutine setmodel + implicit none + ! + ! Args: + real(r8), intent(in) :: bz_in, by, swvel, swden + real(r8), intent(in) :: sunlon -!----------------------------------------------------------------------- -!----------------------------------------------------------------------- - subroutine wei05loc (ih, byimf, power, sunlons) + ! + ! Local: + + real(r8) :: angl, angle, bt + integer :: i, j + real(r8) :: rmlt, mlat, tilt, htilt, hem, ut, secs + real(r8), parameter :: fill = 0._r8 + integer :: iyear, imon, iday, isecs + real(r8) :: bz + + bz = bz_in + + hpower = hp_from_bz_swvel(bz,swvel) + ! + ! Get current date and time: + ! + call get_curr_date(iyear,imon,iday,isecs) + ! + ! Get sun's location (longitude at all latitudes): + ! + secs = real(isecs, r8) + + ! + ! At least one of by,bz must be non-zero: + if (by==0._r8 .and. bz==0._r8) then + if (masterproc) then + write(iulog,"(/,'>>> WARNING: by and bz cannot both be zero',& + ' when calling the Weimer model: am setting bz=0.01')") + end if + bz = 0.01_r8 + end if + ! + bt = sqrt(by**2 + bz**2) + angl = atan2(by,bz) * r2d + ! + ! Convert from day-of-year to month,day and get tilt from date and ut: + ! + ut = secs / 3600._r8 ! decimal hours + ! + ! Given year and day-of-year, cvt2md returns month and day of month. + ! We do not need this, since get_curr_date returns month and day of month. + ! call cvt2md(iulog,iyear,idoy,imon,iday) ! given iyear,idoy, return imo,ida + ! + if (debug .and. masterproc) then + write(iulog,"('weimer05: iyear,imon,iday=',3i5,' ut=',f8.2)") & + iyear,imon,iday,ut + end if + tilt = get_tilt(iyear,imon,iday,ut) + if (debug .and. masterproc) then + write(iulog,"('weimer05: tilt=',e12.4)") tilt + end if + + phihm = 0._r8 ! whole-array init (nmlonp1,nmlat) + ! + ! Call Weimer model for southern hemisphere electric potential: + ! + hem = -1._r8 + htilt = hem * tilt + angle = hem * angl + if (debug .and. masterproc) then + write(iulog,"('weimer05 call setmodel for SH potential')") + end if + call setmodel(angle, bt, htilt, swvel, swden, 'epot') + if (debug .and. masterproc) then + write(iulog,"('weimer05 after setmodel for SH potential')") + end if + do j = 1, nmlat0 ! Spole to equator + do i = 1, nmlon + ! + ! sunlon: sun's longitude in dipole coordinates + ! + rmlt = (ylonm(i)-sunlon) * r2d / 15._r8 + 12._r8 + mlat = abs(ylatm(j))*r2d + ! + ! Obtain electric potential and convert from kV to V + ! + call epotval(mlat,rmlt,fill,phihm(i,j)) + phihm(i,j) = phihm(i,j)*1000._r8 + end do ! i=1,nmlon + end do ! j=1,nmlat0 + if (debug) write(iulog,"('weimer05: SH phihm min,max=',2es12.4)") & + minval(phihm(1:nmlon,1:nmlat0)),maxval(phihm(1:nmlon,1:nmlat0)) + ! + ! Re-calculate SH values of offa, dskofa, arad, and phid and phin from + ! Weimer 2005 setboundary values of offc, dskofc, and theta0 + ! + call wei05loc (1, by, hpower, sunlon) + ! + ! Call Weimer model for southern hemisphere fac: + ! + if (debug .and. masterproc) then + write(iulog,"('weimer05 call setmodel for SH fac')") + end if + call setmodel(angle,bt,htilt,swvel,swden,'bpot') + if (debug .and. masterproc) then + write(iulog,"('weimer05 after setmodel for SH fac')") + end if + do j = 1, nmlat0 + do i = 1, nmlon + rmlt = (ylonm(i)-sunlon) * r2d / 15._r8 + 12._r8 + mlat = abs(ylatm(j))*r2d + call mpfac(mlat,rmlt,fill,wei05sc_fac(i,j)) + end do ! i=1,nmlon + end do ! j=1,nmlat0 + ! + ! Call Weimer model for northern hemisphere epot: + ! + hem = 1._r8 + htilt = hem * tilt + angle = hem * angl + if (debug .and. masterproc) then + write(iulog,"('weimer05 call setmodel for NH potential')") + end if + call setmodel(angle,bt,htilt,swvel,swden,'epot') + if (debug .and. masterproc) then + write(iulog,"('weimer05 after setmodel for NH potential')") + end if + do j = nmlat0+1, nmlat + do i = 1, nmlon + ! + ! sunlon: sun's longitude in dipole coordinates + rmlt = ((ylonm(i) - sunlon) * r2d / 15._r8) + 12._r8 + mlat = abs(ylatm(j)) * r2d + ! + ! Obtain electric potential and convert from kV to V + call epotval(mlat, rmlt, fill, phihm(i,j)) + phihm(i,j) = phihm(i,j) * 1000._r8 + end do ! i=1,nmlon + end do ! j=1,nmlat0+1,nmlat + if (debug .and. masterproc) then + write(iulog,"('weimer05: NH phihm min,max=',2es12.4)") & + minval(phihm(1:nmlon,nmlat0+1:nmlat)), & + maxval(phihm(1:nmlon,nmlat0+1:nmlat)) + end if + ! + ! Re-calculate NH values of offa, dskofa, arad, and Heelis phid and phin + ! from Weimer 2005 setboundary values of offc, dskofc, and theta0 + ! + call wei05loc (2, by, hpower, sunlon) + ! + ! Call Weimer model for northern hemisphere fac: + if (debug .and. masterproc) then + write(iulog,"('weimer05 call setmodel for NH fac')") + end if + call setmodel(angle,bt,htilt,swvel,swden,'bpot') + if (debug .and. masterproc) then + write(iulog,"('weimer05 after setmodel for NH fac')") + end if + do j = nmlat0+1, nmlat + do i = 1, nmlon + rmlt = ((ylonm(i)-sunlon) * r2d / 15._r8) + 12._r8 + mlat = abs(ylatm(j))*r2d + call mpfac(mlat,rmlt,fill,wei05sc_fac(i,j)) + end do ! i=1,nmlon + end do ! j=1,nmlat0 + ! + ! Periodic points: + do j = 1, nmlat + phihm(nmlonp1,j) = phihm(1,j) + wei05sc_fac(nmlonp1,j) = wei05sc_fac(1,j) + end do ! j=1,nmlat + ! + ! Calculate ctpoten for each hemisphere: + ! South: + ! + phimax = -1.e36_r8 + phimin = 1.e36_r8 + do j = 1, nmlat0 ! SH + do i = 1, nmlon + if (phihm(i,j) > phimax) phimax = phihm(i,j) + if (phihm(i,j) < phimin) phimin = phihm(i,j) + end do + end do + weictpoten(1) = 0.001_r8 * (phimax - phimin) + ! + ! North: + ! + phimax = -1.e36_r8 + phimin = 1.e36_r8 + do j = nmlat0+1, nmlat ! NH + do i = 1, nmlon + if (phihm(i,j) > phimax) phimax = phihm(i,j) + if (phihm(i,j) < phimin) phimin = phihm(i,j) + end do + end do + weictpoten(2) = 0.001_r8 * (phimax - phimin) + ! + ! average of the SH and NH in ctpoten + ctpoten = 0.5_r8*(weictpoten(1)+weictpoten(2)) + + if (masterproc) then + write(iulog,"(a,f8.2,a,2es12.4)") & + 'weimer05: ctpoten=', ctpoten, ', phihm min,max=', & + minval(phihm), maxval(phihm) + end if + ! + + end subroutine weimer05 + !----------------------------------------------------------------------- + subroutine read_wei05_ncfile(file) + + use ioFileMod, only: getfil + use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile + use pio, only: file_desc_t, pio_nowrite, pio_inq_dimid + use pio, only: pio_inquire_dimension, pio_inq_varid, pio_get_var + ! + ! Read coefficients and other data from netcdf data file. + ! + ! Arg: + character(len=*), intent(in) :: file + ! + ! Local: + integer :: istat + integer :: rd_na, rd_nb, rd_nex, rd_n1_scha, rd_n2_scha, rd_n3_scha + integer :: rd_csize, rd_n_schfits, rd_n_alschfits + integer :: id + character(len=shr_kind_cl) :: filen + character(len=shr_kind_cl) :: errmsg + character(len=*), parameter :: prefix = 'read_wei05_ncfile: ' + type(file_desc_t) :: ncid + ! + ! Open netcdf file for reading: + ! + call getfil( file, filen, 0 ) + call cam_pio_openfile(ncid, filen, PIO_NOWRITE) + + if (masterproc) then + write(iulog,"('wei05sc: opened netcdf data file',a)") trim(filen) + end if + ! + ! Read and check dimensions: + ! + ! na=6 + istat = pio_inq_dimid(ncid, 'na', id) + istat = pio_inquire_dimension(ncid, id, len=rd_na) + if (rd_na /= na) then + write(errmsg,"(a,i4,a,i4)") prefix//'rd_na /= na: rd_na = ', rd_na,' na = ', na + write(iulog,*) trim(errmsg) + call endrun(errmsg) + end if + ! + ! nb=7 + ! + istat = pio_inq_dimid(ncid, 'nb', id) + istat = pio_inquire_dimension(ncid, id, len=rd_nb) + if (rd_nb /= nb) then + write(errmsg,"(a,i4,a,i4)") prefix//'rd_nb /= nb: rd_nb = ', rd_nb,' nb = ', nb + write(iulog,*) trim(errmsg) + call endrun(errmsg) + end if + ! + ! nex=2 + ! + istat = pio_inq_dimid(ncid, 'nex', id) + istat = pio_inquire_dimension(ncid, id, len=rd_nex) + if (rd_nex /= nex) then + write(errmsg,"(a,i4,a,i4)") prefix//'rd_nex /= nex rd_nex = ', rd_nex,' nex = ', nex + write(iulog,*) trim(errmsg) + call endrun(errmsg) + end if + ! + ! n1_scha=19 + ! + istat = pio_inq_dimid(ncid, 'n1_scha', id) + istat = pio_inquire_dimension(ncid, id, len=rd_n1_scha) + if (rd_n1_scha /= n1_scha) then + write(errmsg,"(a,i4,a,i4)") prefix//'rd_n1_scha /= n1_scha rd_n1_scha = ', rd_n1_scha,' n1_scha = ', n1_scha + write(iulog,*) trim(errmsg) + call endrun(errmsg) + end if + ! + ! n2_scha=7 + ! + istat = pio_inq_dimid(ncid, 'n2_scha', id) + istat = pio_inquire_dimension(ncid, id, len=rd_n2_scha) + if (rd_n2_scha /= n2_scha) then + write(errmsg,"(a,i4,a,i4)") prefix//'rd_n2_scha /= n2_scha rd_n2_scha = ', rd_n2_scha,' n2_scha = ', n2_scha + write(iulog,*) trim(errmsg) + call endrun(errmsg) + end if + ! + ! n3_scha=68 + ! + istat = pio_inq_dimid(ncid, 'n3_scha', id) + istat = pio_inquire_dimension(ncid, id, len=rd_n3_scha) + if (rd_n3_scha /= n3_scha) then + write(errmsg,"(a,i4,a,i4)") prefix//'rd_n3_scha /= n3_scha rd_n3_scha = ', rd_n3_scha,' n3_scha = ', n3_scha + write(iulog,*) trim(errmsg) + call endrun(errmsg) + end if + ! + ! csize=28 + ! + istat = pio_inq_dimid(ncid, 'csize', id) + istat = pio_inquire_dimension(ncid, id, len=rd_csize) + if (rd_csize /= csize) then + write(errmsg,"(a,i4,a,i4)") prefix//'rd_csize /= csize rd_csize = ', rd_csize,' csize = ', csize + write(iulog,*) trim(errmsg) + call endrun(errmsg) + end if + ! + ! n_schfits=15 + ! + istat = pio_inq_dimid(ncid, 'n_schfits', id) + istat = pio_inquire_dimension(ncid, id, len=rd_n_schfits) + if (rd_n_schfits /= n_schfits) then + write(errmsg,"(a,i4,a,i4)") prefix//'rd_n_schfits /= n_schfits rd_n_schfits = ', & + rd_n_schfits,' n_schfits = ', n_schfits + write(iulog,*) trim(errmsg) + call endrun(errmsg) + end if + ! + ! n_alschfits=18 + ! + istat = pio_inq_dimid(ncid, 'n_alschfits', id) + istat = pio_inquire_dimension(ncid, id, len=rd_n_alschfits) + if (rd_n_alschfits /= n_alschfits) then + write(errmsg,"(a,i4,a,i4)") prefix//'rd_n_alschfits /= n_alschfits rd_n_alschfits = ',& + rd_n_alschfits,' n_alschfits = ', n_alschfits + write(iulog,*) trim(errmsg) + call endrun(errmsg) + end if + ! + ! integer :: maxk_scha, maxm_scha, maxl_pot, maxm_pot + ! maxk_scha = 18 ; + ! maxm_scha = 6 ; + ! maxl_pot = 12 ; + ! maxm_pot = 2 ; + ! + istat = pio_inq_dimid(ncid,"maxk_scha", id) + istat = pio_inquire_dimension(ncid, id, len=maxk_scha) + istat = pio_inq_dimid(ncid,"maxm_scha", id) + istat = pio_inquire_dimension(ncid, id, len=maxm_scha) + istat = pio_inq_dimid(ncid,"maxl_pot", id) + istat = pio_inquire_dimension(ncid, id, len=maxl_pot) + istat = pio_inq_dimid(ncid,"maxm_pot", id) + istat = pio_inquire_dimension(ncid, id, len=maxm_pot) + + ! write(iulog,"('wei05sc: maxk_scha=',i3,' maxm_scha=',i3)") & + ! maxk_scha,maxm_scha + ! write(iulog,"('wei05sc: maxl_pot=',i3,' maxm_pot=',i3)") & + ! maxl_pot,maxm_pot + ! + ! Read variables: + ! + ! double bndya(na): + istat = pio_inq_varid(ncid, 'bndya', id) + istat = pio_get_var(ncid, id,bndya) + ! write(iulog,"('wei05sc: bndya=',/,(8f8.3))") bndya + ! + ! double bndyb(nb): + istat = pio_inq_varid(ncid, 'bndyb', id) + istat = pio_get_var(ncid, id,bndyb) + ! write(iulog,"('wei05sc: bndyb=',/,(8f8.3))") bndyb + ! + ! double ex_bndy(nex): + istat = pio_inq_varid(ncid, 'ex_bndy', id) + istat = pio_get_var(ncid, id,ex_bndy) + ! write(iulog,"('wei05sc: ex_bndy=',/,(8f8.3))") ex_bndy + ! + ! double th0s(n3_scha): + istat = pio_inq_varid(ncid, 'th0s', id) + istat = pio_get_var(ncid, id,th0s) + ! write(iulog,"('wei05sc: th0s=',/,(8f8.3))") th0s + ! + ! double allnkm(n1_scha,n2_scha,n3_scha): + istat = pio_inq_varid(ncid, 'allnkm', id) + istat = pio_get_var(ncid, id,allnkm) + ! write(iulog,"('wei05sc: allnkm min,max=',2e12.4)") minval(allnkm),maxval(allnkm) + ! + ! int ab(csize): + istat = pio_inq_varid(ncid, 'ab', id) + istat = pio_get_var(ncid, id,ab) + ! write(iulog,"('wei05sc: ab=',/,(10i4))") ab + ! + ! int ls(csize): + istat = pio_inq_varid(ncid, 'ls', id) + istat = pio_get_var(ncid, id,ls) + ! write(iulog,"('wei05sc: ls=',/,(10i4))") ls + ! + ! int ms(csize): + istat = pio_inq_varid(ncid, 'ms', id) + istat = pio_get_var(ncid, id,ms) + ! write(iulog,"('wei05sc: ms=',/,(10i4))") ms + ! + ! double ex_epot(nex): + istat = pio_inq_varid(ncid, 'ex_epot', id) + istat = pio_get_var(ncid, id,ex_epot) + ! write(iulog,"('wei05sc: ex_epot=',/,(8f8.3))") ex_epot + ! + ! double ex_bpot(nex): + istat = pio_inq_varid(ncid, 'ex_bpot', id) + istat = pio_get_var(ncid, id,ex_bpot) + ! write(iulog,"('wei05sc: ex_bpot=',/,(8f8.3))") ex_bpot + ! + ! double epot_schfits(csize,n_schfits): + istat = pio_inq_varid(ncid, 'epot_schfits', id) + istat = pio_get_var(ncid, id,epot_schfits) + ! write(iulog,"('wei05sc: epot_schfits min,max=',2e12.4)") & + ! minval(epot_schfits),maxval(epot_schfits) + ! + ! double bpot_schfits(csize,n_schfits): + istat = pio_inq_varid(ncid, 'bpot_schfits', id) + istat = pio_get_var(ncid, id,bpot_schfits) + ! write(iulog,"('wei05sc: bpot_schfits min,max=',2e12.4)") & + ! minval(bpot_schfits),maxval(bpot_schfits) + ! + ! double epot_alschfits(csize,n_alschfits): + istat = pio_inq_varid(ncid, 'epot_alschfits', id) + istat = pio_get_var(ncid, id,epot_alschfits) + ! write(iulog,"('wei05sc: epot_alschfits min,max=',2e12.4)") & + ! minval(epot_alschfits),maxval(epot_alschfits) + ! + ! double bpot_alschfits(csize,n_alschfits): + istat = pio_inq_varid(ncid, 'bpot_alschfits', id) + istat = pio_get_var(ncid, id,bpot_alschfits) + ! write(iulog,"('wei05sc: bpot_alschfits min,max=',2e12.4)") & + ! minval(bpot_alschfits),maxval(bpot_alschfits) + ! + ! Close file: + call cam_pio_closefile(ncid) + if(masterproc) then + write(iulog,"('wei05sc: completed read of file ',a)") trim(file) + end if + + end subroutine read_wei05_ncfile + + !----------------------------------------------------------------------- + subroutine setmodel(angle,bt,tilt,swvel,swden,model) + ! + ! Calculate the complete set of the models' SCHA coeficients, + ! given an aribitrary IMF angle (degrees from northward toward +Y), + ! given byimf, bzimf, solar wind velocity (km/sec), and density. + ! + ! Args: + real(r8), intent(in) :: angle, bt, tilt, swvel, swden + character(len=*), intent(in) :: model + ! + ! Local: + integer :: i, j + real(r8) :: pi,stilt,stilt2,sw,swp,swe,c0,rang,cosa,sina,cos2a,sin2a + real(r8) :: a(n_schfits) + ! + if (trim(model) /= 'epot'.and.trim(model) /= 'bpot') then + if (masterproc) then + write(iulog, "('>>> model=',a)") trim(model) + write(iulog, "(a)") & + '>>> setmodel: model must be either ''epot'' or ''bpot''' + end if + call endrun("setmodel: model must be either 'epot' or 'bpot'") + end if + ! + pi = 4._r8 * atan(1._r8) + rad2deg = 180._r8 / pi + deg2rad = pi / 180._r8 + ! + ! write(iulog,"('setmodel call setboundary: model=',a,' swvel=',e12.4)") & + ! model, swvel + + call setboundary(angle, bt, swvel, swden) + ! + stilt = sin(tilt * deg2rad) + stilt2 = stilt**2 + sw = bt * swvel/ 1000._r8 + if (trim(model) == 'epot') then + swe = (1._r8-exp(-sw*ex_epot(2)))*sw**ex_epot(1) + else + swe = (1._r8-exp(-sw*ex_bpot(2)))*sw**ex_bpot(1) + end if + c0 = 1._r8 + swp = swvel**2 * swden*1.6726e-6_r8 + rang = angle*deg2rad + cosa = cos(rang) + sina = sin(rang) + cos2a = cos(2._r8*rang) + sin2a = sin(2._r8*rang) + if (bt < 1._r8) then ! remove angle dependency for IMF under 1 nT + cosa = -1._r8+bt*(cosa+1._r8) + cos2a = 1._r8+bt*(cos2a-1._r8) + sina = bt*sina + sin2a = bt*sin2a + end if + a = (/c0, swe, stilt, stilt2, swp, & + swe*cosa, stilt*cosa, stilt2*cosa, swp*cosa, & + swe*sina, stilt*sina, stilt2*sina, swp*sina, & + swe*cos2a, swe*sin2a/) + if (trim(model) == 'epot') then + esphc(:) = 0._r8 + do j=1,csize + do i=1,n_schfits + esphc(j) = esphc(j)+epot_schfits(i,j)*a(i) + end do + end do + ! write(iulog,"('setmodel: esphc=',/,(6e12.4))") esphc + else + bsphc(:) = 0._r8 + do j=1,csize + do i=1,n_schfits + bsphc(j) = bsphc(j)+bpot_schfits(i,j)*a(i) + end do + end do + ! write(iulog,"('setmodel: bsphc=',/,(6e12.4))") bsphc + end if + end subroutine setmodel + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine wei05loc (ih, byimf, power, sunlon) ! ih=1,2 for SH,NH called from weimer05 ! ! (dimension 2 is for south, north hemispheres) @@ -646,134 +674,139 @@ subroutine wei05loc (ih, byimf, power, sunlons) ! rrad(2), ! radius of auroral circle in radians ! offc(2), ! offset of convection towards 0 MLT relative to mag pole (rad) ! dskofc(2) ! offset of convection in radians towards 18 MLT (f(By)) -! sunlons(nlat): sun's longitude in dipole coordinates (see sub sunloc) +! sunlon: sun's longitude in dipole coordinates (see sub sunloc) ! - -! -! Args: + ! + ! Args: integer,intent(in) :: ih real(r8),intent(in) :: byimf real(r8),intent(in) :: power - real(r8),intent(in) :: sunlons(:) -! -! Local: - real(r8) :: rccp,racp,rahp,ramx,diffrac,plevel,tmltmin,tmltmax + real(r8),intent(in) :: sunlon + ! + ! Local: + real(r8) :: rccp, racp, rahp, ramx, diffrac, plevel, tmltmin, tmltmax real(r8) :: offcdegp(2) - integer :: i,j,j1,j2 - real(r8) :: vnx(2,2),hem,mltd,mltn + integer :: i, j, j1, j2 + real(r8) :: vnx(2,2), hem, mltd, mltn integer :: inx(2,2) - real(r8) :: offcdeg,dskof,arad,crad + real(r8) :: offcdeg, dskof, arad, crad real(r8) :: byloc - -! Limit size of byimf in phin and phid calculations (as in aurora.F) -! NOTE: This byloc is assymetric in hemisphere, which is probably not correct + + ! Limit size of byimf in phin and phid calculations (as in aurora.F) + ! NOTE: This byloc is assymetric in hemisphere, which is probably not correct byloc = byimf if (byloc .gt. 7._r8) byloc = 7._r8 if (byloc .lt. -11._r8) byloc = -11._r8 -! -! ih=1 is SH, ih=2 is NH - if (ih .eq. 1) then - j1 = 1 - j2 = nmlat0 - hem = -1._r8 - else - j1 = nmlat0 + 1 - j2 = nmlat - hem = 1._r8 - endif -! Print out un-revised values: -! write (6,"(1x,'Original convection/oval params (hem,By,off,dsk', -! | ',rad,phid,n=',10f9.4)") hem,byimf,offc(ih)*rtd,offa(ih)*rtd, -! | dskofc(ih)*rtd,dskofa(ih)*rtd,theta0(ih)*rtd,rrad(ih)*rtd, -! | phid(ih)*rtd/15.+12.,phin(ih)*rtd/15.+12. -! Find min/max - vnx(ih,1) = 0._r8 - vnx(ih,2) = 0._r8 - do j=j1,j2 - do i=1,nmlonp1-1 - if (phihm(i,j) .gt. vnx(ih,2)) then - vnx(ih,2) = phihm(i,j) - inx(ih,2) = i - endif - if (phihm(i,j) .lt. vnx(ih,1)) then - vnx(ih,1) = phihm(i,j) - inx(ih,1) = i - endif - enddo ! i=1,nmlonp1-1 - enddo ! j=j1,j2 -! 05/08: Calculate weictpoten in kV from Weimer model min/max in V - weictpoten(ih) = 0.001_r8 * (vnx(ih,2) - vnx(ih,1)) - tmltmin = (ylonm(inx(ih,1))-sunlons(1)) * r2d/15._r8 + 12._r8 - if (tmltmin .gt. 24._r8) tmltmin = tmltmin - 24._r8 - tmltmax = (ylonm(inx(ih,2))-sunlons(1)) * r2d/15._r8 + 12._r8 - if (tmltmax .gt. 24._r8) tmltmax = tmltmax - 24._r8 -! write (6,"('ih Bz By Hp ctpoten,wei min/max potV,lat,mlt=',i2, -! | 5f8.2,2x,e12.4,2f8.2,2x,e12.4,2f8.2))") ih,bzimf,byimf,power, -! | ctpoten,weictpoten(ih), -! | vnx(ih,1),ylatm(jnx(ih,1))*rtd,tmltmin, -! | vnx(ih,2),ylatm(jnx(ih,2))*rtd,tmltmax -! 05/08: From aurora_cons, calculate convection and aurora radii using IMF convection -! and power (plevel); racp (DMSP/NOAA) - rccp (AMIE) = 5.32 (Bz>0) to 6.62 (Bz<0) deg -! Heelis et al [1980, JGR, 85, pp 3315-3324] Fig 8: ra=rc+2deg, and is 2.5 deg to dusk - rccp = -3.80_r8+8.48_r8*(weictpoten(ih)**0.1875_r8) - racp = -0.43_r8+9.69_r8*(weictpoten(ih)**0.1875_r8) - plevel = 0._r8 - if (power >=1.00_r8) plevel = 2.09_r8*log(power) - rahp = 14.20_r8 + 0.96_r8*plevel - ramx = max(racp,rahp) - diffrac = ramx - rccp - -! Set default values -! Use parameterization defaults for phid (phid(MLT)=9.39 +/- 0.21By - 12) -! and phin (phin(MLT)=23.50 +/- 0.15By - 12) - mltd = 9.39_r8 - hem*0.21_r8*byloc - mltn = 23.50_r8 - hem*0.15_r8*byloc - phid(ih) = (mltd-12._r8) * 15._r8 *d2r - phin(ih) = (mltn-12._r8) * 15._r8 *d2r -! 05/18/08: Note that phid,phin are only for Heelis and are irrelevant for Weimer -! write (6,"(1x,'mltd mltn phid,n =',4f8.2)") -! | mltd,mltn,phid(ih)*rtd/15.,phin(ih)*rtd/15. -! Use default constant value of offcdegp from setboundary in Weimer 2005 - offcdeg = 4.2_r8 - offcdegp(ih) = offcdeg - offc(ih) = offcdegp(ih) *d2r - offa(ih) = offcdegp(ih) *d2r -! write (6,"(1x,'offcdeg,rad =',2e12.4)") offcdeg,offc(ih) - dskof = 0._r8 - dskofc(ih) = dskof *d2r -! oval offset is 2.5 deg towards dawn (more neg dskof) - dskofa(ih) = (dskof-2.5_r8) *d2r -! write (6,"(1x,'dskof,c,a=',3f8.2)") -! | dskof,dskofc(ih)*rtd,dskofa(ih)*rtd -! Set crad from bndyfitr/2 of setboundary of Weimer 2005 - crad = bndyfitr/2._r8 -! write (6,"(1x,'wei05loc: ih,bz,y,crad =',i2,3f8.2)") -! | ih,bzimf,byimf,crad -! Fig 8 Heelis et al [1980]: ra=rc+2deg, and shifted 2.5 deg to dusk - arad = crad + 2._r8 -! 05/08: Make ra=rc+diffrac(=ramx-rccp) - same difference as in aurora.F -! Choose to have arad=crad(Weimer) + diffrac(same diff as in aurora.F) - arad = crad + diffrac -! 08/08: OR make ra=ramx=max(racp,rahp) so diffrac=arad-crad -! diffrac2 = ramx - crad -! Choose to have arad=ramx (same as in aurora.F as determined by P/CP) -! arad = ramx - theta0(ih) = crad *d2r - rrad(ih) = arad *d2r -! write (6,"(1x,'radius: crad,rccp,racp,rahp diffa-c', -! | '(aurF,ramx-Weic) ramx,Weic+d,arad deg=',9f8.2)") crad,rccp, -! | racp,rahp,diffrac,diffrac2,ramx,crad+diffrac,arad - -! Print out revised values (revised 05/08): -! write (6,"(1x,'Revised convection/oval params (off,dsk,', -! | 'rad,phid,n=',8f9.4)")offc(ih)*rtd,offa(ih)*rtd, -! | dskofc(ih)*rtd,dskofa(ih)*rtd,theta0(ih)*rtd,rrad(ih)*rtd, -! | phid(ih)*rtd/15.+12.,phin(ih)*rtd/15.+12. - - end subroutine wei05loc + ! + ! ih=1 is SH, ih=2 is NH + if (ih .eq. 1) then + j1 = 1 + j2 = nmlat0 + hem = -1._r8 + else + j1 = nmlat0 + 1 + j2 = nmlat + hem = 1._r8 + end if + ! Print out un-revised values: + ! write (6,"(1x,'Original convection/oval params (hem,By,off,dsk', + ! | ',rad,phid,n=',10f9.4)") hem,byimf,offc(ih)*rtd,offa(ih)*rtd, + ! | dskofc(ih)*rtd,dskofa(ih)*rtd,theta0(ih)*rtd,rrad(ih)*rtd, + ! | phid(ih)*rtd/15.+12.,phin(ih)*rtd/15.+12. + ! Find min/max + vnx(ih,1) = 0._r8 + vnx(ih,2) = 0._r8 + do j=j1,j2 + do i=1,nmlonp1-1 + if (phihm(i,j) .gt. vnx(ih,2)) then + vnx(ih,2) = phihm(i,j) + inx(ih,2) = i + end if + if (phihm(i,j) .lt. vnx(ih,1)) then + vnx(ih,1) = phihm(i,j) + inx(ih,1) = i + end if + end do ! i=1,nmlonp1-1 + end do ! j=j1,j2 + ! 05/08: Calculate weictpoten in kV from Weimer model min/max in V + weictpoten(ih) = 0.001_r8 * (vnx(ih,2) - vnx(ih,1)) + tmltmin = (ylonm(inx(ih,1))-sunlon) * r2d/15._r8 + 12._r8 + if (tmltmin > 24._r8) then + tmltmin = tmltmin - 24._r8 + end if + tmltmax = (ylonm(inx(ih,2))-sunlon) * r2d/15._r8 + 12._r8 + if (tmltmax > 24._r8) then + tmltmax = tmltmax - 24._r8 + end if + ! write (6,"('ih Bz By Hp ctpoten,wei min/max potV,lat,mlt=',i2, + ! | 5f8.2,2x,e12.4,2f8.2,2x,e12.4,2f8.2))") ih,bzimf,byimf,power, + ! | ctpoten,weictpoten(ih), + ! | vnx(ih,1),ylatm(jnx(ih,1))*rtd,tmltmin, + ! | vnx(ih,2),ylatm(jnx(ih,2))*rtd,tmltmax + ! 05/08: From aurora_cons, calculate convection and aurora radii using IMF convection + ! and power (plevel); racp (DMSP/NOAA) - rccp (AMIE) = 5.32 (Bz>0) to 6.62 (Bz<0) deg + ! Heelis et al [1980, JGR, 85, pp 3315-3324] Fig 8: ra=rc+2deg, and is 2.5 deg to dusk + rccp = -3.80_r8 + (8.48_r8*(weictpoten(ih)**0.1875_r8)) + racp = -0.43_r8 + (9.69_r8*(weictpoten(ih)**0.1875_r8)) + plevel = 0._r8 + if (power >= 1.00_r8) then + plevel = 2.09_r8*log(power) + end if + rahp = 14.20_r8 + 0.96_r8*plevel + ramx = max(racp, rahp) + diffrac = ramx - rccp + + ! Set default values + ! Use parameterization defaults for phid (phid(MLT)=9.39 +/- 0.21By - 12) + ! and phin (phin(MLT)=23.50 +/- 0.15By - 12) + mltd = 9.39_r8 - hem*0.21_r8*byloc + mltn = 23.50_r8 - hem*0.15_r8*byloc + phid(ih) = (mltd-12._r8) * 15._r8 *d2r + phin(ih) = (mltn-12._r8) * 15._r8 *d2r + ! 05/18/08: Note that phid,phin are only for Heelis and are irrelevant for Weimer + ! write (6,"(1x,'mltd mltn phid,n =',4f8.2)") + ! | mltd,mltn,phid(ih)*rtd/15.,phin(ih)*rtd/15. + ! Use default constant value of offcdegp from setboundary in Weimer 2005 + offcdeg = 4.2_r8 + offcdegp(ih) = offcdeg + offc(ih) = offcdegp(ih) *d2r + offa(ih) = offcdegp(ih) *d2r + ! write (6,"(1x,'offcdeg,rad =',2e12.4)") offcdeg,offc(ih) + dskof = 0._r8 + dskofc(ih) = dskof *d2r + ! oval offset is 2.5 deg towards dawn (more neg dskof) + dskofa(ih) = (dskof-2.5_r8) *d2r + ! write (6,"(1x,'dskof,c,a=',3f8.2)") + ! | dskof,dskofc(ih)*rtd,dskofa(ih)*rtd + ! Set crad from bndyfitr/2 of setboundary of Weimer 2005 + crad = bndyfitr/2._r8 + ! write (6,"(1x,'wei05loc: ih,bz,y,crad =',i2,3f8.2)") + ! | ih,bzimf,byimf,crad + ! Fig 8 Heelis et al [1980]: ra=rc+2deg, and shifted 2.5 deg to dusk + arad = crad + 2._r8 + ! 05/08: Make ra=rc+diffrac(=ramx-rccp) - same difference as in aurora.F + ! Choose to have arad=crad(Weimer) + diffrac(same diff as in aurora.F) + arad = crad + diffrac + ! 08/08: OR make ra=ramx=max(racp,rahp) so diffrac=arad-crad + ! diffrac2 = ramx - crad + ! Choose to have arad=ramx (same as in aurora.F as determined by P/CP) + ! arad = ramx + theta0(ih) = crad *d2r + rrad(ih) = arad *d2r + ! write (6,"(1x,'radius: crad,rccp,racp,rahp diffa-c', + ! | '(aurF,ramx-Weic) ramx,Weic+d,arad deg=',9f8.2)") crad,rccp, + ! | racp,rahp,diffrac,diffrac2,ramx,crad+diffrac,arad + + ! Print out revised values (revised 05/08): + ! write (6,"(1x,'Revised convection/oval params (off,dsk,', + ! | 'rad,phid,n=',8f9.4)")offc(ih)*rtd,offa(ih)*rtd, + ! | dskofc(ih)*rtd,dskofa(ih)*rtd,theta0(ih)*rtd,rrad(ih)*rtd, + ! | phid(ih)*rtd/15.+12.,phin(ih)*rtd/15.+12. + + end subroutine wei05loc !----------------------------------------------------------------------- -! for now this is here ... might need to move to a gen util module +! for now this is here ... might need to move to a gen util module !----------------------------------------------------------------------- function hp_from_bz_swvel(bz,swvel) result(hp) ! @@ -792,7 +825,7 @@ function hp_from_bz_swvel(bz,swvel) result(hp) hp = 6.0_r8 + 3.3_r8*abs(bz) + (0.05_r8 + 0.003_r8*abs(bz))* (min(swvel,700._r8)-300._r8) else hp = 5.0_r8 + 0.05_r8 * (min(swvel,700._r8)-300._r8) - endif + end if hp = max(2.5_r8,hp)*fac end function hp_from_bz_swvel @@ -820,8 +853,8 @@ subroutine setboundary(angle,bt,swvel,swden) ct = cos(theta) st = sin(theta) ! - tmat(1,:) = (/ ct, 0._r8, st/) - tmat(2,:) = (/ 0._r8, 1._r8, 0._r8/) + tmat(1,:) = (/ ct, 0._r8, st/) + tmat(2,:) = (/ 0._r8, 1._r8, 0._r8/) tmat(3,:) = (/-st, 0._r8, ct/) ! ! ttmat(1,:) = (/ct, 0._r8,-st/) @@ -835,7 +868,7 @@ subroutine setboundary(angle,bt,swvel,swden) btx = btx*bt**ex_bndy(2) else cosa = 1._r8+bt*(cosa-1._r8) ! remove angle dependency for IMF under 1 nT - endif + end if x = (/1._r8, cosa, btx, btx*cosa, swvel, swp/) c = bndya bndyfitr = 0._r8 @@ -844,15 +877,15 @@ subroutine setboundary(angle,bt,swvel,swden) ! write(iulog,"('setboundry: i=',i3,' bndyfitr=',e12.4)") i,bndyfitr - enddo + end do end subroutine setboundary !----------------------------------------------------------------------- subroutine epotval(lat,mlt,fill,epot) ! -! Return the Potential (in kV) at given combination of def. latitude -! (lat) and MLT, in geomagnetic apex coordinates (practically identical -! to AACGM). -! If the location is outside of the model's low-latitude boundary, then +! Return the Potential (in kV) at given combination of def. latitude +! (lat) and MLT, in geomagnetic apex coordinates (practically identical +! to AACGM). +! If the location is outside of the model's low-latitude boundary, then ! the value "fill" is returned. ! implicit none @@ -873,14 +906,14 @@ subroutine epotval(lat,mlt,fill,epot) if (inside == 0) then epot = fill return - endif + end if ! -! IDL code: +! IDL code: ! phim=phir # replicate(1,maxm) * ((indgen(maxm)+1) ## replicate(1,n_elements(phir))) ! where the '#' operator multiplies columns of first array by rows of second array, ! and the '##' operator multiplies rows of first array by columns of second array. -! Here, maxm == maxm_pot == 2, and phir is a scalar. The above IDL statement then -! becomes: phim = ([phir] # [1,1]) * ([1,2] ## [phir]) where phim will be +! Here, maxm == maxm_pot == 2, and phir is a scalar. The above IDL statement then +! becomes: phim = ([phir] # [1,1]) * ([1,2] ## [phir]) where phim will be ! dimensioned [1,2] ! phim(1) = phir @@ -894,7 +927,7 @@ subroutine epotval(lat,mlt,fill,epot) if (skip == 1) then skip = 0 cycle - endif + end if m = ms(j) if (ab(j)==1) then plm = scplm(j,colat,nlm) ! scplm function is in this module @@ -904,10 +937,10 @@ subroutine epotval(lat,mlt,fill,epot) else z = z+plm*(esphc(j)*cospm(m)+esphc(j+1)*sinpm(m)) skip = 1 - endif - endif ! ab(j) - enddo - epot = z + end if + end if ! ab(j) + end do + epot = z end subroutine epotval !----------------------------------------------------------------------- subroutine mpfac(lat,mlt,fill,fac) @@ -931,7 +964,7 @@ subroutine mpfac(lat,mlt,fill,fac) if (inside == 0) then fac = fill return - endif + end if ! phim(1) = phir phim(2) = phir*2._r8 @@ -944,7 +977,7 @@ subroutine mpfac(lat,mlt,fill,fac) if (skip == 1) then skip = 0 cycle - endif + end if if (ls(j) >= 11) exit jloop m = ms(j) if (ab(j) == 1) then @@ -957,9 +990,9 @@ subroutine mpfac(lat,mlt,fill,fac) else z = z-(plm*(bsphc(j)*cospm(m)+bsphc(j+1)*sinpm(m))) skip = 1 - endif - endif - enddo jloop ! j=1,csize + end if + end if + end do jloop ! j=1,csize pi = 4._r8*atan(1._r8) cfactor = -1.e5_r8/(4._r8*pi*re**2) ! convert to uA/m2 z = z*cfactor @@ -969,7 +1002,7 @@ end subroutine mpfac !----------------------------------------------------------------------- real(r8) function scplm(index,colat,nlm) ! -! Return Spherical Cap Harmonic Associated Legendre values, given colat +! Return Spherical Cap Harmonic Associated Legendre values, given colat ! values and index i into array of L and M values. ! implicit none @@ -985,30 +1018,30 @@ real(r8) function scplm(index,colat,nlm) real(r8) :: cth(mxtablesize) real(r8),save :: prevth0=1.e36_r8 integer,save :: tablesize + character(len=shr_kind_cl) :: errmsg ! scplm = 0._r8 skip = 0 ! Added by B.Foster, 4/23/14 th0 = bndyfitr if (prevth0 /= th0) then tablesize = 3*nint(th0) - if (tablesize > mxtablesize) then - write(iulog,"('>>> tablesize > mxtablesize: tablesize=',i8,' mxtablesize=',i8,' th0=',e12.4)") & - tablesize,mxtablesize,th0 - call endrun('tablesize') - endif + if (tablesize > mxtablesize) then + write(errmsg,"('>>> tablesize > mxtablesize: tablesize=',i8,' mxtablesize=',i8,' th0=',e12.4)") & + tablesize,mxtablesize,th0 + write(iulog,*) trim(errmsg) + call endrun(errmsg) + end if do i=1,tablesize - real8 = dble(i-1) - real8a = dble(tablesize-1) - colattable(i) = real8*(th0/real8a) - cth(i) = cos(colattable(i)*deg2rad) - enddo + colattable(i) = real(i-1, r8) * (th0 / real(tablesize-1, r8)) + cth(i) = cos(colattable(i) * deg2rad) + end do prevth0 = th0 - nlms = 0._r8 ! whole array init + nlms = 0._r8 ! whole array init do j=1,csize if (skip == 1) then skip = 0 cycle - endif + end if l = ls(j) m = ms(j) nlms(j) = nkmlookup(l,m,th0) ! nkmlookup in this module @@ -1020,9 +1053,9 @@ real(r8) function scplm(index,colat,nlm) plmtable(1,j+1) = plmtable(1,j) nlms(j+1) = nlms(j) skip = 1 - endif - enddo ! j=1,csize - endif ! prevth0 + end if + end do ! j=1,csize + end if ! prevth0 nlm = nlms(index) colata(1) = colat call interpol_quad(plmtable(1:tablesize,index), & @@ -1031,147 +1064,138 @@ real(r8) function scplm(index,colat,nlm) end function scplm !----------------------------------------------------------------------- subroutine pm_n(m,r,cth,plmtable,tablesize) -! -! Another SCHA function, returns the SCHA version of the associated -! Legendre Polynomial, Pmn -! - implicit none -! -! Args: - integer,intent(in) :: m,tablesize - real(r8),intent(in) :: r - real(r8),intent(in) :: cth(tablesize) - real(r8),intent(out) :: plmtable(tablesize) -! -! Local: - integer :: i,k - real(r8) :: rm,rk,div,ans,xn - real(r8),dimension(tablesize) :: a,x,tmp,table -! - if (m == 0) then - a = 1._r8 ! whole array op - else - do i=1,tablesize - a(i) = sqrt(1._r8-cth(i)**2)**m - enddo - endif - xn = r*(r+1._r8) - x(:) = (1._r8-cth(:))/2._r8 - table = a ! whole array init - k = 1 - pmn_loop: do ! repeat-until loop in idl code - do i=1,tablesize - real8 = dble(m) - rm = real8 - real8 = dble(k) - rk = real8 - a(i) = a(i)*(x(i)*((rk+rm-1._r8)*(rk+rm)-xn)/(rk*(rk+rm))) - table(i) = table(i)+a(i) ! "result" in idl code - enddo - k = k+1 - do i=1,tablesize - div = abs(table(i)) - if (div <= 1.e-6_r8) div = 1.e-6_r8 - tmp(i) = abs(a(i)) / div - enddo - if (maxval(tmp) < 1.e-6_r8) exit pmn_loop - enddo pmn_loop - ans = km_n(m,r) - - plmtable(:) = table(:)*ans + ! + ! Another SCHA function, returns the SCHA version of the associated + ! Legendre Polynomial, Pmn + ! + ! Args: + integer,intent(in) :: m,tablesize + real(r8),intent(in) :: r + real(r8),intent(in) :: cth(tablesize) + real(r8),intent(out) :: plmtable(tablesize) + ! + ! Local: + integer :: i,k + real(r8) :: rm,rk,div,ans,xn + real(r8),dimension(tablesize) :: a,x,tmp,table + ! + if (m == 0) then + a = 1._r8 ! whole array op + else + do i=1,tablesize + a(i) = sqrt(1._r8-cth(i)**2)**m + end do + end if + xn = r*(r+1._r8) + x(:) = (1._r8-cth(:))/2._r8 + table = a ! whole array init + k = 1 + pmn_loop: do ! repeat-until loop in idl code + do i=1,tablesize + rm = real(m, r8) + rk = real(k, r8) + a(i) = a(i)*(x(i)*((rk+rm-1._r8)*(rk+rm)-xn)/(rk*(rk+rm))) + table(i) = table(i)+a(i) ! "result" in idl code + end do + k = k+1 + do i=1,tablesize + div = abs(table(i)) + if (div <= 1.e-6_r8) div = 1.e-6_r8 + tmp(i) = abs(a(i)) / div + end do + if (maxval(tmp) < 1.e-6_r8) exit pmn_loop + end do pmn_loop + ans = km_n(m,r) + + plmtable(:) = table(:)*ans end subroutine pm_n !----------------------------------------------------------------------- real(r8) function km_n(m,rn) -! -! A normalization function used by the SCHA routines. See Haines. -! - implicit none -! -! Args: - integer,intent(in) :: m - real(r8),intent(in) :: rn -! -! Local: - real(r8) :: rm -! - if (m == 0) then - km_n = 1._r8 - return - endif - real8 = dble(m) - rm = real8 - km_n = sqrt(2._r8*exp(lngamma(rn+rm+1._r8)-lngamma(rn-rm+1._r8))) / & - (2._r8**m*factorial(m)) + ! + ! A normalization function used by the SCHA routines. See Haines. + ! + ! Args: + integer,intent(in) :: m + real(r8),intent(in) :: rn + ! + ! Local: + real(r8) :: rm + ! + if (m == 0) then + km_n = 1._r8 + return + end if + rm = real(m, 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 !----------------------------------------------------------------------- - real(r8) function nkmlookup(k,m,th0) -! -! Given the size of a spherical cap, defined by the polar cap angle, th0, -! and also the values of integers k and m, returns the value of n, a -! real number (see Haines). -! It uses interpolation from a lookup table that had been precomputed, -! in order to reduce the computation time. -! - implicit none -! -! Args: - integer,intent(in) :: k,m - real(r8),intent(in) :: th0 -! -! Local: - integer :: kk,mm - real(r8) :: th0a(1),out(1) + real(r8) function nkmlookup(k, m, th0) + ! + ! Given the size of a spherical cap, defined by the polar cap angle, th0, + ! and also the values of integers k and m, returns the value of n, a + ! real number (see Haines). + ! It uses interpolation from a lookup table that had been precomputed, + ! in order to reduce the computation time. + ! + ! Args: + integer,intent(in) :: k,m + real(r8),intent(in) :: th0 + ! + ! Local: + integer :: kk,mm + real(r8) :: th0a(1),out(1) - if (th0 == 90._r8) then - real8 = dble(k) - nkmlookup = real8 - return - endif - th0a(1) = th0 - kk = k+1 - mm = m+1 - if (kk > maxk_scha) then - call interpol_quad(allnkm(maxk_scha,mm,:),th0s,th0a,out) - endif - if (mm > maxm_scha) then - call interpol_quad(allnkm(kk,maxm_scha,:),th0s,th0a,out) - endif - if (th0 < th0s(1)) then - write(iulog,"('>>> nkmlookup: th0 < th0s(1): th0=',e12.4,' th0s(1)=',e12.4)") & - th0,th0s(1) - endif - call interpol_quad(allnkm(kk,mm,:),th0s,th0a,out) - nkmlookup = out(1) + if (th0 == 90._r8) then + nkmlookup = real(k, r8) + return + end if + th0a(1) = th0 + kk = k+1 + mm = m+1 + if (kk > maxk_scha) then + call interpol_quad(allnkm(maxk_scha,mm,:),th0s,th0a,out) + end if + if (mm > maxm_scha) then + call interpol_quad(allnkm(kk,maxm_scha,:),th0s,th0a,out) + end if + if (th0 < th0s(1)) then + write(iulog,"(a,e12.4,', th0s(1) = ',e12.4)") & + '>>> nkmlookup: th0 < th0s(1): th0 = ', th0, th0s(1) + end if + call interpol_quad(allnkm(kk,mm,:), th0s, th0a, out) + nkmlookup = out(1) end function nkmlookup !----------------------------------------------------------------------- subroutine checkinputs(lat,mlt,inside,phir,colat) - implicit none -! -! Args: - real(r8),intent(in) :: lat,mlt - integer,intent(out) :: inside - real(r8),intent(out) :: phir,colat -! -! Local: - real(r8) :: lon,tlat,tlon,radii -! - lon = mlt*15._r8 - call dorotation(lat,lon,tlat,tlon) - radii = 90._r8-tlat - inside = 0 - if (radii <= bndyfitr) inside = 1 ! bndyfitr from setboundary - phir = tlon*deg2rad - colat = radii + ! + ! Args: + real(r8), intent(in) :: lat,mlt + integer, intent(out) :: inside + real(r8), intent(out) :: phir,colat + ! + ! Local: + real(r8) :: lon, tlat, tlon, radii + ! + lon = mlt*15._r8 + call dorotation(lat,lon,tlat,tlon) + radii = 90._r8-tlat + inside = 0 + if (radii <= bndyfitr) then + inside = 1 ! bndyfitr from setboundary + end if + phir = tlon*deg2rad + colat = radii end subroutine checkinputs !----------------------------------------------------------------------- subroutine dorotation(latin,lonin,latout,lonout) ! ! Uses transformation matrices tmat and ttmat, to convert between -! the given geomagnetic latatud/longitude, and the coordinate +! the given geomagnetic latatud/longitude, and the coordinate ! system that is used within the model,that is offset from the pole. ! -! Rotate Lat/Lon spherical coordinates with the transformation given -! by saved matrix. The coordinates are assumed to be on a sphere of +! Rotate Lat/Lon spherical coordinates with the transformation given +! by saved matrix. The coordinates are assumed to be on a sphere of ! Radius=1. Uses cartesian coordinates as an intermediate step. ! implicit none @@ -1201,124 +1225,93 @@ subroutine dorotation(latin,lonin,latout,lonout) ! do i=1,3 pos(i) = tmat(1,i)*a + tmat(2,i)*b + tmat(3,i)*stc - enddo + end do latout = asin(pos(3))*rad2deg lonout = atan2(pos(2),pos(1))*rad2deg end subroutine dorotation !----------------------------------------------------------------------- subroutine interpol_quad(v,x,u,p) -! -! f90 translation of IDL function interpol(v,x,u,/quadratic) -! - implicit none -! -! Args: - real(r8),intent(in) :: v(:),x(:),u(:) - real(r8),intent(out) :: p(:) -! -! Local: - integer :: nv,nx,nu,i,ix - real(r8) :: x0,x1,x2 -! - nv = size(v) - nx = size(x) - nu = size(u) - if (nx /= nv) then - p(:) = 0._r8 - return - endif - do i=1,nu - ix = value_locate(x,u(i)) -! 01/14 bae: interpol_quad in wei05sc.F is called when inside=1 or radii=nx assures epot is non-zero near -! the pole (85.8mlat,0MLT) and the boundary (bndryfit). - if (ix <=1) ix = 2 ! bug fix by bae 01/28/14 - if (ix >=nx) ix = nx-1 ! bug fix by bae 01/29/14 -! if (ix <= 1.or.ix >= nx) then ! bug fix by btf 12/23/09 -! p(i) = 0._r8 -! cycle ! bug fix by btf 12/23/09 -! endif - x1 = x(ix) - x0 = x(ix-1) - x2 = x(ix+1) - p(i) = v(ix-1) * (u(i)-x1) * (u(i)-x2) / ((x0-x1) * (x0-x2)) + & - v(ix) * (u(i)-x0) * (u(i)-x2) / ((x1-x0) * (x1-x2)) + & - v(ix+1) * (u(i)-x0) * (u(i)-x1) / ((x2-x0) * (x2-x1)) - enddo + ! + ! f90 translation of IDL function interpol(v,x,u,/quadratic) + ! + ! Args: + real(r8),intent(in) :: v(:),x(:),u(:) + real(r8),intent(out) :: p(:) + ! + ! Local: + integer :: nv,nx,nu,i,ix + real(r8) :: x0,x1,x2 + ! + nv = size(v) + nx = size(x) + nu = size(u) + if (nx /= nv) then + p(:) = 0._r8 + return + end if + do i = 1, nu + ix = value_locate(x,u(i)) + ! 01/14 bae: interpol_quad in wei05sc.F is called when inside=1 or + ! radii=nx + ! assures epot is non-zero near the pole (85.8mlat,0MLT) and + ! the boundary (bndryfit). + if (ix <=1) ix = 2 + if (ix >=nx) ix = nx-1 + x1 = x(ix) + x0 = x(ix-1) + x2 = x(ix+1) + p(i) = v(ix-1) * (u(i)-x1) * (u(i)-x2) / ((x0-x1) * (x0-x2)) + & + v(ix) * (u(i)-x0) * (u(i)-x2) / ((x1-x0) * (x1-x2)) + & + v(ix+1) * (u(i)-x0) * (u(i)-x1) / ((x2-x0) * (x2-x1)) + end do end subroutine interpol_quad !----------------------------------------------------------------------- integer function value_locate(vec,val) -! -! f90 translation of IDL function value_locate -! Return index i into vec for which vec(i) <= val >= vec(i+1) -! Input vec must be monotonically increasing -! - implicit none -! -! Args: - real(r8),intent(in) :: vec(:),val -! -! Local: - integer :: n,i -! - value_locate = 0 - n = size(vec) - if (val < vec(1)) return - if (val > vec(n)) then - value_locate = n - return - endif - do i=1,n-1 - if (val >= vec(i) .and. val <= vec(i+1)) then - value_locate = i - return - endif - enddo + ! + ! f90 translation of IDL function value_locate + ! Return index i into vec for which vec(i) <= val >= vec(i+1) + ! Input vec must be monotonically increasing + ! + implicit none + ! + ! Args: + real(r8),intent(in) :: vec(:),val + ! + ! Local: + integer :: n,i + ! + value_locate = 0 + n = size(vec) + if (val < vec(1)) then + return + end if + if (val > vec(n)) then + value_locate = n + return + end if + do i = 1, n-1 + if (val >= vec(i) .and. val <= vec(i+1)) then + value_locate = i + return + end if + end do end function value_locate -!----------------------------------------------------------------------- - real(r8) function lngamma(xx) -! -! This is an f90 translation from C code copied from -! www.fizyka.umk.pl/nrbook/c6-1.pdf (numerical recipes gammln) -! - implicit none - 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 - enddo - lngamma = -tmp+log(2.5066282746310005_r8*ser/x) - end function lngamma !----------------------------------------------------------------------- real(r8) function factorial(n) - implicit none - integer,intent(in) :: n - integer :: m - if (n <= 0) then - factorial = 0._r8 - return - endif - if (n == 1) then - factorial = 1._r8 - return - endif - real8 = dble(n) - factorial = real8 - do m = n-1,1,-1 - real8 = dble(m) - factorial = factorial * real8 - enddo + integer,intent(in) :: n + integer :: m + if (n <= 0) then + factorial = 0._r8 + return + end if + if (n == 1) then + factorial = 1._r8 + return + end if + factorial = real(n, r8) + do m = n-1,1,-1 + factorial = factorial * real(m, r8) + end do end function factorial !----------------------------------------------------------------------- !*********************** Copyright 1996,2001 Dan Weimer/MRC *********************** @@ -1336,7 +1329,7 @@ real(r8) FUNCTION GET_TILT (YEAR,MONTH,DAY,HOUR) INTEGER YEAR,MONTH,DAY,IDBUG real(r8) :: HOUR -! +! ! THIS SUBROUTINE DERIVES THE ROTATION MATRICES AM(I,J,K) FOR 11 ! TRANSFORMATIONS, IDENTIFIED BY K. ! K=1 TRANSFORMS GSE to GEO @@ -1347,13 +1340,13 @@ real(r8) FUNCTION GET_TILT (YEAR,MONTH,DAY,HOUR) ! K=6 " GSM to MAG ! K=7 " GSE to GEI ! K=8 " GEI to GEO -! K=9 " GSM to SM -! K=10 " GEO to SM -! K=11 " MAG to SM +! K=9 " GSM to SM +! K=10 " GEO to SM +! K=11 " MAG to SM ! ! IF IDBUG IS NOT 0, THEN OUTPUTS DIAGNOSTIC INFORMATION TO ! FILE UNIT=IDBUG -! +! INTEGER GSEGEO,GEOGSE,GEOMAG,MAGGEO INTEGER GSEMAG,MAGGSE,GSEGSM,GSMGSE INTEGER GEOGSM,GSMGEO,GSMMAG,MAGGSM @@ -1373,14 +1366,14 @@ real(r8) FUNCTION GET_TILT (YEAR,MONTH,DAY,HOUR) ! MAG - Geomagnetic ! GSM - Geocentric Solar Magnetospheric ! SM - Solar Magnetic -! +! ! THE ARRAY CX(I) ENCODES VARIOUS ANGLES, STORED IN DEGREES -! ST(I) AND CT(I) ARE SINES & COSINES. +! ST(I) AND CT(I) ARE SINES & COSINES. ! ! Program author: D. R. Weimer ! ! Some of this code has been copied from subroutines which had been -! obtained from D. Stern, NASA/GSFC. Other formulas are from "Space +! obtained from D. Stern, NASA/GSFC. Other formulas are from "Space ! Physics Coordinate Transformations: A User Guide" by M. Hapgood (1991). ! ! The formulas for the calculation of Greenwich mean sidereal time (GMST) @@ -1397,10 +1390,10 @@ real(r8) FUNCTION GET_TILT (YEAR,MONTH,DAY,HOUR) ! the DATA statement for assignments (not block_data) ! COMMON/MFIELD/EPOCH,TH0,PH0,DIPOLE ! COMMON/TRANSDAT/CX(9),ST(6),CT(6),AM(3,3,11) -! +! real(r8) TH0,PH0 !,DIPOLE real(r8) CX(9),ST(6),CT(6),AM(3,3,11) -! +! ! TH0 = geog co-lat of NH magnetic pole ! PH0 = geog longitude of NH magnetic pole ! DIPOLE = magnitude of the B field in gauss at the equator @@ -1418,12 +1411,11 @@ real(r8) FUNCTION GET_TILT (YEAR,MONTH,DAY,HOUR) IYR=1900+YEAR ELSE IYR=YEAR - ENDIF + END IF UT=HOUR JD=JULDAY(MONTH,DAY,IYR) MJD=JD-2400001 - real8 = dble(MJD) - T0=(real8-51544.5_r8)/36525.0_r8 + T0=(real(MJD, r8) - 51544.5_r8) / 36525.0_r8 GMSTD=100.4606184_r8 + 36000.770_r8*T0 + 3.87933E-4_r8*T0*T0 + & 15.0410686_r8*UT CALL ADJUST(GMSTD) @@ -1444,7 +1436,7 @@ real(r8) FUNCTION GET_TILT (YEAR,MONTH,DAY,HOUR) WRITE(IDBUG,*) 'MEAN ANOMALY=',MA WRITE(IDBUG,*) 'MEAN LONGITUDE=',LAMD WRITE(IDBUG,*) 'TRUE LONGITUDE=',SUNLON - ENDIF + END IF CX(1)= GMSTD CX(2) = ECLIP @@ -1452,7 +1444,7 @@ real(r8) FUNCTION GET_TILT (YEAR,MONTH,DAY,HOUR) CX(4) = TH0 CX(5) = PH0 ! Derived later: -! CX(6) = Dipole tilt angle +! CX(6) = Dipole tilt angle ! CX(7) = Angle between sun and magnetic pole ! CX(8) = Subsolar point latitude ! CX(9) = Subsolar point longitude @@ -1460,8 +1452,8 @@ real(r8) FUNCTION GET_TILT (YEAR,MONTH,DAY,HOUR) DO I=1,5 ST(I) = SIND(CX(I)) CT(I) = COSD(CX(I)) - ENDDO -! + END DO +! AM(1,1,GSEGEI) = CT(3) AM(1,2,GSEGEI) = -ST(3) AM(1,3,GSEGEI) = 0._r8 @@ -1470,74 +1462,74 @@ real(r8) FUNCTION GET_TILT (YEAR,MONTH,DAY,HOUR) AM(2,3,GSEGEI) = -ST(2) AM(3,1,GSEGEI) = ST(3)*ST(2) AM(3,2,GSEGEI) = CT(3)*ST(2) - AM(3,3,GSEGEI) = CT(2) -! - AM(1,1,GEIGEO) = CT(1) - AM(1,2,GEIGEO) = ST(1) - AM(1,3,GEIGEO) = 0._r8 - AM(2,1,GEIGEO) = -ST(1) - AM(2,2,GEIGEO) = CT(1) - AM(2,3,GEIGEO) = 0._r8 - AM(3,1,GEIGEO) = 0._r8 - AM(3,2,GEIGEO) = 0._r8 - AM(3,3,GEIGEO) = 1._r8 -! - DO I=1,3 - DO J=1,3 + AM(3,3,GSEGEI) = CT(2) +! + AM(1,1,GEIGEO) = CT(1) + AM(1,2,GEIGEO) = ST(1) + AM(1,3,GEIGEO) = 0._r8 + AM(2,1,GEIGEO) = -ST(1) + AM(2,2,GEIGEO) = CT(1) + AM(2,3,GEIGEO) = 0._r8 + AM(3,1,GEIGEO) = 0._r8 + AM(3,2,GEIGEO) = 0._r8 + AM(3,3,GEIGEO) = 1._r8 +! + DO I=1,3 + DO J=1,3 AM(I,J,GSEGEO) = AM(I,1,GEIGEO)*AM(1,J,GSEGEI) + & AM(I,2,GEIGEO)*AM(2,J,GSEGEI) + AM(I,3,GEIGEO)*AM(3,J,GSEGEI) - ENDDO - ENDDO -! - AM(1,1,GEOMAG) = CT(4)*CT(5) - AM(1,2,GEOMAG) = CT(4)*ST(5) - AM(1,3,GEOMAG) =-ST(4) - AM(2,1,GEOMAG) =-ST(5) - AM(2,2,GEOMAG) = CT(5) + END DO + END DO +! + AM(1,1,GEOMAG) = CT(4)*CT(5) + AM(1,2,GEOMAG) = CT(4)*ST(5) + AM(1,3,GEOMAG) =-ST(4) + AM(2,1,GEOMAG) =-ST(5) + AM(2,2,GEOMAG) = CT(5) AM(2,3,GEOMAG) = 0._r8 - AM(3,1,GEOMAG) = ST(4)*CT(5) - AM(3,2,GEOMAG) = ST(4)*ST(5) - AM(3,3,GEOMAG) = CT(4) -! - DO I=1,3 - DO J=1,3 + AM(3,1,GEOMAG) = ST(4)*CT(5) + AM(3,2,GEOMAG) = ST(4)*ST(5) + AM(3,3,GEOMAG) = CT(4) +! + DO I=1,3 + DO J=1,3 AM(I,J,GSEMAG) = AM(I,1,GEOMAG)*AM(1,J,GSEGEO) + & AM(I,2,GEOMAG)*AM(2,J,GSEGEO) + AM(I,3,GEOMAG)*AM(3,J,GSEGEO) - ENDDO - ENDDO -! - B32 = AM(3,2,GSEMAG) - B33 = AM(3,3,GSEMAG) - B3 = SQRT(B32*B32+B33*B33) - IF (B33.LE.0._r8) B3 = -B3 -! - AM(2,2,GSEGSM) = B33/B3 - AM(3,3,GSEGSM) = AM(2,2,GSEGSM) - AM(3,2,GSEGSM) = B32/B3 - AM(2,3,GSEGSM) =-AM(3,2,GSEGSM) + END DO + END DO +! + B32 = AM(3,2,GSEMAG) + B33 = AM(3,3,GSEMAG) + B3 = SQRT(B32*B32+B33*B33) + IF (B33.LE.0._r8) B3 = -B3 +! + AM(2,2,GSEGSM) = B33/B3 + AM(3,3,GSEGSM) = AM(2,2,GSEGSM) + AM(3,2,GSEGSM) = B32/B3 + AM(2,3,GSEGSM) =-AM(3,2,GSEGSM) AM(1,1,GSEGSM) = 1._r8 AM(1,2,GSEGSM) = 0._r8 AM(1,3,GSEGSM) = 0._r8 AM(2,1,GSEGSM) = 0._r8 AM(3,1,GSEGSM) = 0._r8 -! - DO I=1,3 - DO J=1,3 +! + DO I=1,3 + DO J=1,3 AM(I,J,GEOGSM) = AM(I,1,GSEGSM)*AM(J,1,GSEGEO) + & AM(I,2,GSEGSM)*AM(J,2,GSEGEO) + AM(I,3,GSEGSM)*AM(J,3,GSEGEO) - ENDDO - ENDDO -! - DO I=1,3 - DO J=1,3 + END DO + END DO +! + DO I=1,3 + DO J=1,3 AM(I,J,GSMMAG) = AM(I,1,GEOMAG)*AM(J,1,GEOGSM) + & AM(I,2,GEOMAG)*AM(J,2,GEOGSM) + AM(I,3,GEOMAG)*AM(J,3,GEOGSM) - ENDDO - ENDDO + END DO + END DO ! - ST(6) = AM(3,1,GSEMAG) - CT(6) = SQRT(1._r8-ST(6)*ST(6)) - CX(6) = ASIND(ST(6)) + ST(6) = AM(3,1,GSEMAG) + CT(6) = SQRT(1._r8-ST(6)*ST(6)) + CX(6) = ASIND(ST(6)) AM(1,1,GSMSM) = CT(6) AM(1,2,GSMSM) = 0._r8 @@ -1548,20 +1540,20 @@ real(r8) FUNCTION GET_TILT (YEAR,MONTH,DAY,HOUR) AM(3,1,GSMSM) = ST(6) AM(3,2,GSMSM) = 0._r8 AM(3,3,GSMSM) = CT(6) -! - DO I=1,3 - DO J=1,3 +! + DO I=1,3 + DO J=1,3 AM(I,J,GEOSM) = AM(I,1,GSMSM)*AM(1,J,GEOGSM) + & AM(I,2,GSMSM)*AM(2,J,GEOGSM) + AM(I,3,GSMSM)*AM(3,J,GEOGSM) - ENDDO - ENDDO -! - DO I=1,3 - DO J=1,3 + END DO + END DO +! + DO I=1,3 + DO J=1,3 AM(I,J,MAGSM) = AM(I,1,GSMSM)*AM(J,1,GSMMAG) + & AM(I,2,GSMSM)*AM(J,2,GSMMAG) + AM(I,3,GSMSM)*AM(J,3,GSMMAG) - ENDDO - ENDDO + END DO + END DO ! CX(7)=ATAN2D( AM(2,1,11) , AM(1,1,11) ) CX(8)=ASIND( AM(3,1,1) ) @@ -1577,11 +1569,11 @@ real(r8) FUNCTION GET_TILT (YEAR,MONTH,DAY,HOUR) WRITE(IDBUG,1001) K DO I=1,3 WRITE(IDBUG,1002) (AM(I,J,K),J=1,3) - ENDDO - ENDDO + END DO + END DO 1001 FORMAT(' ROTATION MATRIX ',I2) 1002 FORMAT(3F9.5) - ENDIF + END IF !NCAR Mar 96: return the dipole tilt from this function call. GET_TILT = CX(6) @@ -1602,12 +1594,12 @@ SUBROUTINE ADJUST(ANGLE) IF(ANGLE.LT.0._r8)THEN ANGLE=ANGLE+360._r8 GOTO 10 - ENDIF + END IF 20 CONTINUE IF(ANGLE.GE.360._r8)THEN ANGLE=ANGLE-360._r8 GOTO 20 - ENDIF + END IF end subroutine adjust !----------------------------------------------------------------------- integer FUNCTION JULDAY(MM,ID,IYYY) @@ -1622,12 +1614,12 @@ integer FUNCTION JULDAY(MM,ID,IYYY) ELSE JY=IYYY-1 JM=MM+13 - ENDIF + END IF JULDAY=INT(365.25_r8*JY)+INT(30.6001_r8*JM)+ID+1720995 IF (ID+31*(MM+12*IYYY).GE.IGREG) THEN JA=INT(0.01_r8*JY) JULDAY=JULDAY+2-JA+INT(0.25_r8*JA) - ENDIF + END IF end function julday !----------------------------------------------------------------------- SUBROUTINE CVT2MD(iulog,IYEAR,NDA,MON,DAY) @@ -1640,10 +1632,10 @@ SUBROUTINE CVT2MD(iulog,IYEAR,NDA,MON,DAY) PARAMETER (MISS=-32767) SAVE LMON DATA LMON/31,28,31,30,31,30,31,31,30,31,30,31/ - + LMON(2)=28 IF(MOD(IYEAR,4) .EQ. 0)LMON(2)=29 - + NUMD=0 DO 100 I=1,12 IF(NDA.GT.NUMD .AND. NDA.LE.NUMD+LMON(I))GO TO 200 @@ -1694,6 +1686,5 @@ FUNCTION ATAN2D (RNUM1,RNUM2) R2D = 57.2957795130823208767981548147_r8) ATAN2D = R2D * ATAN2 (RNUM1,RNUM2) end function atan2d -#endif !----------------------------------------------------------------------- end module wei05sc diff --git a/src/physics/.clubb_sparse_checkout b/src/physics/.clubb_sparse_checkout new file mode 100644 index 0000000000..1299233a5e --- /dev/null +++ b/src/physics/.clubb_sparse_checkout @@ -0,0 +1,2 @@ +src/CLUBB_core +src/SILHS diff --git a/src/physics/ali_arms b/src/physics/ali_arms new file mode 160000 index 0000000000..825e7f20e2 --- /dev/null +++ b/src/physics/ali_arms @@ -0,0 +1 @@ +Subproject commit 825e7f20e2dd368b95b1e3cb2562ab571318bb4d diff --git a/src/physics/cam/aer_rad_props.F90 b/src/physics/cam/aer_rad_props.F90 index d6c46532ae..d83ca10f50 100644 --- a/src/physics/cam/aer_rad_props.F90 +++ b/src/physics/cam/aer_rad_props.F90 @@ -2,7 +2,7 @@ module aer_rad_props !------------------------------------------------------------------------------------------------ ! Converts aerosol masses to bulk optical properties for sw and lw radiation -! computations. +! computations. !------------------------------------------------------------------------------------------------ use shr_kind_mod, only: r8 => shr_kind_r8 @@ -11,11 +11,12 @@ module aer_rad_props use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc -use radconstants, only: nrh, nswbands, nlwbands, idx_sw_diag, ot_length +use radconstants, only: nswbands, nlwbands, idx_sw_diag +use phys_prop, only: nrh, ot_length use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, & rad_cnst_get_aer_props use wv_saturation, only: qsat -use modal_aer_opt, only: modal_aero_sw, modal_aero_lw +use aerosol_optics_cam,only: aerosol_optics_cam_init, aerosol_optics_cam_sw, aerosol_optics_cam_lw use cam_history, only: fieldname_len, addfld, outfld, add_default, horiz_only use cam_history_support, only : fillvalue ! Placed here due to PGI bug. @@ -53,6 +54,7 @@ subroutine aer_rad_props_init() logical :: history_aero_optics ! Output aerosol optics diagnostics logical :: history_dust ! Output dust diagnostics logical :: prog_modal_aero ! Prognostic modal aerosols present + integer :: nmodes ! number of aerosol modes !---------------------------------------------------------------------------- @@ -77,7 +79,7 @@ subroutine aer_rad_props_init() ! get names of bulk aerosols allocate(aernames(numaerosols)) - call rad_cnst_get_info(0, aernames=aernames) + call rad_cnst_get_info(0, aernames=aernames, nmodes=nmodes) ! diagnostic output for bulk aerosols ! create outfld names for visible OD @@ -89,11 +91,11 @@ subroutine aer_rad_props_init() end do ! Determine default fields - if (history_amwg .or. history_dust ) then + if (history_amwg .or. history_dust ) then call add_default ('AEROD_v', 1, ' ') - endif - - if ( history_aero_optics ) then + endif + + if ( history_aero_optics ) then call add_default ('AEROD_v', 1, ' ') do i = 1, numaerosols odv_names(i) = 'ODV_'//trim(aernames(i)) @@ -101,6 +103,9 @@ subroutine aer_rad_props_init() end do endif + if (nmodes > 0) then + call aerosol_optics_cam_init() + end if deallocate(aernames) @@ -114,18 +119,18 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & ! Return bulk layer tau, omega, g, f for all spectral intervals. use physics_buffer, only : physics_buffer_desc - use tropopause, only : tropopause_find + use tropopause, only : tropopause_find_cam ! Arguments integer, intent(in) :: list_idx ! index of the climate or a diagnostic list type(physics_state), intent(in), target :: state - + type(physics_buffer_desc), pointer :: pbuf(:) integer, intent(in) :: nnite ! number of night columns integer, intent(in) :: idxnite(:) ! local column indices of night columns real(r8), intent(out) :: tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth real(r8), intent(out) :: tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau - real(r8), intent(out) :: tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * tau * w + real(r8), intent(out) :: tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * tau * w real(r8), intent(out) :: tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * tau * w ! Local variables @@ -170,7 +175,7 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & real(r8) :: rhtrunc(pcols,pver) real(r8) :: wrh(pcols,pver) integer :: krh(pcols,pver) - + integer :: numaerosols ! number of bulk aerosols in climate/diagnostic list integer :: nmodes ! number of aerosol modes in climate/diagnostic list integer :: iaerosol ! index into bulk aerosol list @@ -201,8 +206,9 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & tau_w_f(1:ncol,:,:) = 0._r8 ! calculate relative humidity for table lookup into rh grid - call qsat(state%t(1:ncol,1:pver), state%pmid(1:ncol,1:pver), & - es(1:ncol,1:pver), qs(1:ncol,1:pver)) + do k = 1, pver + call qsat(state%t(1:ncol,k), state%pmid(1:ncol,k), es(1:ncol,k), qs(1:ncol,k), ncol) + end do rh(1:ncol,1:pver) = state%q(1:ncol,1:pver,1) / qs(1:ncol,1:pver) rhtrunc(1:ncol,1:pver) = min(rh(1:ncol,1:pver),1._r8) @@ -214,16 +220,19 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, & ! Contributions from modal aerosols. if (nmodes > 0) then - call modal_aero_sw(list_idx, state, pbuf, nnite, idxnite, & - tau, tau_w, tau_w_g, tau_w_f) + call aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, & + tau, tau_w, tau_w_g, tau_w_f) else tau (1:ncol,:,:) = 0._r8 tau_w (1:ncol,:,:) = 0._r8 tau_w_g(1:ncol,:,:) = 0._r8 tau_w_f(1:ncol,:,:) = 0._r8 end if - - call tropopause_find(state, troplev) + + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + troplev = 0 + !REMOVECAM_END + call tropopause_find_cam(state, troplev) ! Contributions from bulk aerosols. do iaerosol = 1, numaerosols @@ -303,20 +312,19 @@ end subroutine aer_rad_props_sw subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) - use radconstants, only: ot_length - - use physics_buffer, only : pbuf_get_field, pbuf_get_index, physics_buffer_desc ! Purpose: Compute aerosol transmissions needed in absorptivity/ ! emissivity calculations - ! lw extinction is the same representation for all + ! lw extinction is the same representation for all ! species. If this changes, this routine will need to do something ! similar to the sw with routines like get_hygro_lw_abs + use physics_buffer, only : pbuf_get_field, pbuf_get_index, physics_buffer_desc + ! Arguments integer, intent(in) :: list_idx ! index of the climate or a diagnostic list type(physics_state), intent(in), target :: state - + type(physics_buffer_desc), pointer :: pbuf(:) real(r8), intent(out) :: odap_aer(pcols,pver,nlwbands) ! [fraction] absorption optical depth, per layer @@ -335,7 +343,7 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) real(r8), pointer :: lw_abs(:) real(r8), pointer :: lw_hygro_abs(:,:) real(r8), pointer :: geometric_radius(:,:) - + ! volcanic lookup table real(r8), pointer :: r_lw_abs(:,:) ! radius dependent mass-specific absorption coefficient real(r8), pointer :: r_mu(:) ! log(geometric_mean_radius) domain samples of r_lw_abs(:,:) @@ -368,7 +376,7 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ! Contributions from modal aerosols. if (nmodes > 0) then - call modal_aero_lw(list_idx, state, pbuf, odap_aer) + call aerosol_optics_cam_lw(list_idx, state, pbuf, odap_aer) else odap_aer = 0._r8 end if @@ -382,8 +390,9 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) end do ! calculate relative humidity for table lookup into rh grid - call qsat(state%t(1:ncol,1:pver), state%pmid(1:ncol,1:pver), & - es(1:ncol,1:pver), qs(1:ncol,1:pver)) + do k = 1, pver + call qsat(state%t(1:ncol,k), state%pmid(1:ncol,k), es(1:ncol,k), qs(1:ncol,k), ncol) + end do rh(1:ncol,1:pver) = state%q(1:ncol,1:pver,1) / qs(1:ncol,1:pver) rhtrunc(1:ncol,1:pver) = min(rh(1:ncol,1:pver),1._r8) @@ -420,13 +429,13 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ! get optical properties for hygroscopic aerosols call rad_cnst_get_aer_props(list_idx, iaerosol, lw_ext=lw_abs) do bnd_idx = 1, nlwbands - do k = 1, pver + do k = 1, pver do i = 1, ncol odap_aer(i,k,bnd_idx) = odap_aer(i,k,bnd_idx) + lw_abs(bnd_idx)*aermass(i,k) end do end do end do - + case('volcanic_radius','volcanic_radius1','volcanic_radius2','volcanic_radius3') pbuf_fld = 'VOLC_RAD_GEOM ' if (len_trim(opticstype)>15) then @@ -438,7 +447,7 @@ subroutine aer_rad_props_lw(list_idx, state, pbuf, odap_aer) ! get microphysical properties for volcanic aerosols idx = pbuf_get_index(pbuf_fld) call pbuf_get_field(pbuf, idx, geometric_radius ) - + ! interpolate in radius ! caution: clip the table with no warning when outside bounds nmu = size(r_mu) @@ -507,7 +516,7 @@ subroutine get_hygro_rad_props(ncol, krh, wrh, mass, ext, ssa, asm, & - wrh(icol,ilev) * ssa(krh(icol,ilev), iswband) asm1 = (1 + wrh(icol,ilev)) * asm(krh(icol,ilev)+1,iswband) & - wrh(icol,ilev) * asm(krh(icol,ilev), iswband) - + tau (icol, ilev, iswband) = mass(icol, ilev) * ext1 tau_w (icol, ilev, iswband) = mass(icol, ilev) * ext1 * ssa1 tau_w_g(icol, ilev, iswband) = mass(icol, ilev) * ext1 * ssa1 * asm1 @@ -516,10 +525,10 @@ subroutine get_hygro_rad_props(ncol, krh, wrh, mass, ext, ssa, asm, & enddo enddo -end subroutine get_hygro_rad_props +end subroutine get_hygro_rad_props !============================================================================== - + subroutine get_nonhygro_rad_props(ncol, mass, ext, ssa, asm, & tau, tau_w, tau_w_g, tau_w_f) @@ -533,13 +542,13 @@ subroutine get_nonhygro_rad_props(ncol, mass, ext, ssa, asm, & real(r8), intent(out) :: tau (pcols, pver, nswbands) real(r8), intent(out) :: tau_w (pcols, pver, nswbands) real(r8), intent(out) :: tau_w_g(pcols, pver, nswbands) - real(r8), intent(out) :: tau_w_f(pcols, pver, nswbands) + real(r8), intent(out) :: tau_w_f(pcols, pver, nswbands) ! Local variables integer :: iswband real(r8) :: ext1, ssa1, asm1 !----------------------------------------------------------------------------- - + do iswband = 1, nswbands ext1 = ext(iswband) ssa1 = ssa(iswband) @@ -553,11 +562,11 @@ subroutine get_nonhygro_rad_props(ncol, mass, ext, ssa, asm, & end subroutine get_nonhygro_rad_props !============================================================================== - + subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ext, r_scat, r_ascat, r_mu, & tau, tau_w, tau_w_g, tau_w_f) - + use physics_buffer, only : pbuf_get_field, pbuf_get_index ! Arguments @@ -573,7 +582,7 @@ subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ real(r8), intent(out) :: tau (pcols, pver, nswbands) real(r8), intent(out) :: tau_w (pcols, pver, nswbands) real(r8), intent(out) :: tau_w_g(pcols, pver, nswbands) - real(r8), intent(out) :: tau_w_f(pcols, pver, nswbands) + real(r8), intent(out) :: tau_w_f(pcols, pver, nswbands) ! Local variables integer :: iswband @@ -584,7 +593,7 @@ subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ real(r8) :: mu(pcols,pver) ! log(geometric mean radius of volcanic aerosol) integer :: kmu, nmu real(r8) :: wmu, mutrunc, r_mu_max, r_mu_min - + ! interpolated values from table real(r8) :: ext(nswbands) real(r8) :: scat(nswbands) @@ -593,10 +602,10 @@ subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ integer :: i, k ! column level iterator !----------------------------------------------------------------------------- - tau =0._r8 - tau_w =0._r8 - tau_w_g=0._r8 - tau_w_f=0._r8 + tau =0._r8 + tau_w =0._r8 + tau_w_g=0._r8 + tau_w_f=0._r8 ! get microphysical properties for volcanic aerosols idx = pbuf_get_index(pbuf_radius_name) @@ -632,10 +641,10 @@ subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ else g=0._r8 endif - tau (i,k,iswband) = mass(i,k) * ext(iswband) - tau_w (i,k,iswband) = mass(i,k) * scat(iswband) - tau_w_g(i,k,iswband) = mass(i,k) * ascat(iswband) - tau_w_f(i,k,iswband) = mass(i,k) * g * ascat(iswband) + tau (i,k,iswband) = mass(i,k) * ext(iswband) + tau_w (i,k,iswband) = mass(i,k) * scat(iswband) + tau_w_g(i,k,iswband) = mass(i,k) * ascat(iswband) + tau_w_f(i,k,iswband) = mass(i,k) * g * ascat(iswband) end do enddo enddo @@ -643,7 +652,7 @@ subroutine get_volcanic_radius_rad_props(ncol, mass, pbuf_radius_name, pbuf, r_ end subroutine get_volcanic_radius_rad_props !============================================================================== - + subroutine get_volcanic_rad_props(ncol, mass, ext, scat, ascat, & tau, tau_w, tau_w_g, tau_w_f) @@ -657,23 +666,23 @@ subroutine get_volcanic_rad_props(ncol, mass, ext, scat, ascat, & real(r8), intent(out) :: tau (pcols, pver, nswbands) real(r8), intent(out) :: tau_w (pcols, pver, nswbands) real(r8), intent(out) :: tau_w_g(pcols, pver, nswbands) - real(r8), intent(out) :: tau_w_f(pcols, pver, nswbands) + real(r8), intent(out) :: tau_w_f(pcols, pver, nswbands) ! Local variables integer :: iswband real(r8) :: g !----------------------------------------------------------------------------- - + do iswband = 1, nswbands if (scat(iswband).gt.0._r8) then g = ascat(iswband)/scat(iswband) else g=0._r8 endif - tau (1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ext(iswband) - tau_w (1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * scat(iswband) - tau_w_g(1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ascat(iswband) - tau_w_f(1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * g * ascat(iswband) + tau (1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ext(iswband) + tau_w (1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * scat(iswband) + tau_w_g(1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * ascat(iswband) + tau_w_f(1:ncol,1:pver,iswband) = mass(1:ncol,1:pver) * g * ascat(iswband) enddo end subroutine get_volcanic_rad_props @@ -693,7 +702,7 @@ subroutine aer_vis_diag_out(lchnk, ncol, nnite, idxnite, iaer, tau, diag_idx, tr integer, intent(in) :: diag_idx ! identifies whether the aerosol optics ! is for the climate calc or a diagnostic calc integer, intent(in) :: troplev(:) ! tropopause level - + ! Local variables integer :: i real(r8) :: tmp(pcols), tmp2(pcols) @@ -716,7 +725,7 @@ subroutine aer_vis_diag_out(lchnk, ncol, nnite, idxnite, iaer, tau, diag_idx, tr do i = 1, ncol tmp2(i) = sum(tau(i,:troplev(i))) end do - call outfld('AODvstrt', tmp2, pcols, lchnk) + call outfld('AODvstrt', tmp2, pcols, lchnk) end if end subroutine aer_vis_diag_out diff --git a/src/physics/cam/aerosol_optics_cam.F90 b/src/physics/cam/aerosol_optics_cam.F90 new file mode 100644 index 0000000000..3fb18c7a9c --- /dev/null +++ b/src/physics/cam/aerosol_optics_cam.F90 @@ -0,0 +1,1343 @@ +module aerosol_optics_cam + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_kind_mod, only: cl => shr_kind_cl + use cam_logfile, only: iulog + use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_uv_diag, idx_nir_diag + use radconstants, only: get_lw_spectral_boundaries + use phys_prop, only: ot_length + use physics_types,only: physics_state + use physics_buffer,only: physics_buffer_desc + use ppgrid, only: pcols, pver + use physconst, only: rga, rair + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + use rad_constituents, only: n_diag, rad_cnst_get_call_list + use cam_history, only: addfld, add_default, outfld, horiz_only, fieldname_len + use cam_history_support, only: fillvalue + + use tropopause, only : tropopause_findChemTrop + + use aerosol_properties_mod, only: aerosol_properties + use modal_aerosol_properties_mod, only: modal_aerosol_properties + + use aerosol_state_mod, only: aerosol_state + use modal_aerosol_state_mod,only: modal_aerosol_state + + use aerosol_optics_mod, only: aerosol_optics + use refractive_aerosol_optics_mod, only: refractive_aerosol_optics + + implicit none + + private + + public :: aerosol_optics_cam_readnl + public :: aerosol_optics_cam_init + public :: aerosol_optics_cam_final + public :: aerosol_optics_cam_sw + public :: aerosol_optics_cam_lw + + type aero_props_t + class(aerosol_properties), pointer :: obj => null() + end type aero_props_t + type aero_state_t + class(aerosol_state), pointer :: obj => null() + end type aero_state_t + + type(aero_props_t), allocatable :: aero_props(:) ! array of aerosol properties objects to allow for + ! multiple aerosol representations in the same sim + ! such as MAM and CARMA + + ! refractive index for water read in read_water_refindex + complex(r8) :: crefwsw(nswbands) = -huge(1._r8) ! complex refractive index for water visible + complex(r8) :: crefwlw(nlwbands) = -huge(1._r8) ! complex refractive index for water infrared + character(len=cl) :: water_refindex_file = 'NONE' ! full pathname for water refractive index dataset + + logical :: modal_active = .false. + integer :: num_aero_models = 0 + integer :: lw10um_indx = -1 ! wavelength index corresponding to 10 microns + real(r8), parameter :: lw10um = 10._r8 ! microns + + character(len=4) :: diag(0:n_diag) = (/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ', '_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) + + type out_name + character(len=fieldname_len), allocatable :: name(:) ! nbins + end type out_name + + type(out_name), allocatable :: burden_fields(:) ! num_aero_models + type(out_name), allocatable :: aodbin_fields(:) + type(out_name), allocatable :: aoddust_fields(:) + type(out_name), allocatable :: burdendn_fields(:) ! num_aero_models + type(out_name), allocatable :: aodbindn_fields(:) + type(out_name), allocatable :: aoddustdn_fields(:) + +contains + + !=============================================================================== + subroutine aerosol_optics_cam_readnl(nlfile) + use namelist_utils, only : find_group_name + use spmd_utils, only : mpicom, masterprocid, mpi_character, mpi_success + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + integer :: unitn, ierr + character(len=cl) :: errmsg + character(len=*), parameter :: subname = 'aerosol_optics_cam_readnl' + + ! =================== + ! Namelist definition + ! =================== + namelist /aerosol_optics_nl/ water_refindex_file + + ! ============= + ! Read namelist + ! ============= + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'aerosol_optics_nl', status=ierr) + if (ierr == 0) then + read(unitn, aerosol_optics_nl, iostat=ierr) + if (ierr /= 0) then + write(errmsg,'(2a,i10)') subname,':: ERROR reading namelist, error code: ',ierr + call endrun(errmsg) + end if + end if + close(unitn) + end if + + ! ============================ + ! Broadcast namelist variables + ! ============================ + call mpi_bcast(water_refindex_file, len(water_refindex_file), mpi_character, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname // ':: ERROR mpi_bcast '//trim(water_refindex_file)) + end if + + if (masterproc) then + write(iulog,*) subname,': water_refindex_file = ',trim(water_refindex_file) + end if + + end subroutine aerosol_optics_cam_readnl + + !=============================================================================== + subroutine aerosol_optics_cam_init + use rad_constituents, only: rad_cnst_get_info + use phys_control, only: phys_getopts + use ioFileMod, only: getfil + + character(len=*), parameter :: prefix = 'aerosol_optics_cam_init: ' + integer :: nmodes=0, iaermod, istat, ilist, i + + logical :: call_list(0:n_diag) + real(r8) :: lwavlen_lo(nlwbands), lwavlen_hi(nlwbands) + integer :: m, n + + character(len=fieldname_len) :: fldname + character(len=128) :: lngname + logical :: history_aero_optics ! output aerosol optics diagnostics + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: history_dust ! output dust diagnostics + + character(len=cl) :: locfile + + call phys_getopts(history_amwg_out = history_amwg, & + history_aero_optics_out = history_aero_optics, & + history_dust_out = history_dust ) + + num_aero_models = 0 + + call rad_cnst_get_info(0, nmodes=nmodes) + modal_active = nmodes>0 + + if (modal_active) then + num_aero_models = num_aero_models+1 ! count aerosol models + end if + + if (num_aero_models>0) then + allocate(aero_props(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aero_props') + end if + end if + + iaermod = 0 + + if (modal_active) then + iaermod = iaermod+1 + aero_props(iaermod)%obj => modal_aerosol_properties() + end if + + if (water_refindex_file=='NONE') then + call endrun(prefix//'water_refindex_file must be specified') + else + call getfil(water_refindex_file, locfile) + call read_water_refindex(locfile) + end if + + call get_lw_spectral_boundaries(lwavlen_lo, lwavlen_hi, units='um') + do i = 1,nlwbands + if ((lwavlen_lo(i)<=lw10um) .and. (lwavlen_hi(i)>=lw10um)) then + lw10um_indx = i ! index corresponding to 10 microns + end if + end do + call rad_cnst_get_call_list(call_list) + + do ilist = 0, n_diag + if (call_list(ilist)) then + call addfld ('EXTINCT'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol extinction 550 nm, day only', flag_xyfill=.true.) + call addfld ('EXTINCTUV'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol extinction 350 nm, day only', flag_xyfill=.true.) + call addfld ('EXTINCTNIR'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol extinction 1020 nm, day only', flag_xyfill=.true.) + call addfld ('ABSORB'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol absorption, day only', flag_xyfill=.true.) + call addfld ('AODVIS'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 550 nm', flag_xyfill=.true.) + call addfld ('AODVISst'//diag(ilist), horiz_only, 'A',' ', & + 'Stratospheric aerosol optical depth 550 nm, day only', flag_xyfill=.true.) + call addfld ('AODNIRst'//diag(ilist), horiz_only, 'A',' ', & + 'Stratospheric aerosol optical depth 1020 nm, day only',flag_xyfill=.true.) + call addfld ('AODUVst'//diag(ilist), horiz_only, 'A',' ', & + 'Stratospheric aerosol optical depth 350 nm, day only', flag_xyfill=.true.) + call addfld ('AODUV'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 350 nm, day only', flag_xyfill=.true.) + call addfld ('AODNIR'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 1020 nm, day only',flag_xyfill=.true.) + call addfld ('AODABS'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol absorption optical depth 550 nm, day only', flag_xyfill=.true.) + call addfld ('AODxASYM'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 550 * asymmetry factor, day only', flag_xyfill=.true.) + call addfld ('EXTxASYM'//diag(ilist), (/ 'lev' /), 'A',' ', & + 'extinction 550 nm * asymmetry factor, day only', flag_xyfill=.true.) + call addfld ('AODTOT'//diag(ilist), horiz_only, 'A','1',& + 'Aerosol optical depth summed over all sw wavelengths', flag_xyfill=.true.) + + call addfld ('EXTINCTdn'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol extinction 550 nm, day only', flag_xyfill=.true.) + call addfld ('EXTINCTUVdn'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol extinction 350 nm, day only', flag_xyfill=.true.) + call addfld ('EXTINCTNIRdn'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol extinction 1020 nm, day only', flag_xyfill=.true.) + call addfld ('ABSORBdn'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol absorption, day only', flag_xyfill=.true.) + call addfld ('AODVISdn'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 550 nm', flag_xyfill=.true.) + call addfld ('AODVISstdn'//diag(ilist), horiz_only, 'A',' ', & + 'Stratospheric aerosol optical depth 550 nm, day only', flag_xyfill=.true.) + call addfld ('AODNIRstdn'//diag(ilist), horiz_only, 'A',' ', & + 'Stratospheric aerosol optical depth 1020 nm, day only', flag_xyfill=.true.) + call addfld ('AODUVstdn'//diag(ilist), horiz_only, 'A',' ', & + 'Stratospheric aerosol optical depth 350 nm, day only', flag_xyfill=.true.) + call addfld ('AODUVdn'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 350 nm, day only', flag_xyfill=.true.) + call addfld ('AODNIRdn'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 1020 nm, day only', flag_xyfill=.true.) + call addfld ('AODABSdn'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol absorption optical depth 550 nm, day only', flag_xyfill=.true.) + call addfld ('AODxASYMdn'//diag(ilist), horiz_only, 'A',' ', & + 'Aerosol optical depth 550 * asymmetry factor, day only', flag_xyfill=.true.) + call addfld ('EXTxASYMdn'//diag(ilist), (/ 'lev' /), 'A',' ', & + 'extinction 550 nm * asymmetry factor, day only', flag_xyfill=.true.) + call addfld ('AODTOTdn'//diag(ilist), horiz_only, 'A','1',& + 'Aerosol optical depth summed over all sw wavelengths, day only') + + if (lw10um_indx>0) then + call addfld('AODABSLW'//diag(ilist), (/ 'lev' /), 'A','/m',& + 'Aerosol long-wave absorption optical depth at 10 microns') + end if + call addfld ('TOTABSLW'//diag(ilist), (/ 'lev' /), 'A',' ', & + 'LW Aero total abs') + + if (ilist>0 .and. history_aero_optics) then + call add_default ('EXTINCT'//diag(ilist), 1, ' ') + call add_default ('ABSORB'//diag(ilist), 1, ' ') + call add_default ('AODVIS'//diag(ilist), 1, ' ') + call add_default ('AODVISst'//diag(ilist), 1, ' ') + call add_default ('AODABS'//diag(ilist), 1, ' ') + end if + + end if + end do + + if (num_aero_models>0) then + + allocate(burden_fields(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: burden_fields') + end if + allocate(aodbin_fields(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aodbin_fields') + end if + allocate(aoddust_fields(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aoddust_fields') + end if + + allocate(burdendn_fields(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: burdendn_fields') + end if + allocate(aodbindn_fields(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aodbindn_fields') + end if + allocate(aoddustdn_fields(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aoddustdn_fields') + end if + + do n = 1,num_aero_models + + allocate(burden_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: burden_fields(n)%name') + end if + allocate(aodbin_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aodbin_fields(n)%name') + end if + allocate(aoddust_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aoddust_fields(n)%name') + end if + + allocate(burdendn_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: burdendn_fields(n)%name') + end if + allocate(aodbindn_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aodbindn_fields(n)%name') + end if + allocate(aoddustdn_fields(n)%name(aero_props(n)%obj%nbins()), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aoddustdn_fields(n)%name') + end if + + do m = 1, aero_props(n)%obj%nbins() + + write(fldname,'(a,i2.2)') 'BURDEN', m + burden_fields(n)%name(m) = fldname + write(lngname,'(a,i2.2)') 'Aerosol burden bin ', m + call addfld (fldname, horiz_only, 'A', 'kg/m2', lngname, flag_xyfill=.true.) + if (history_aero_optics) then + call add_default (fldname, 1, ' ') + end if + + fldname = 'AOD_'//trim(aero_props(n)%obj%bin_name(0,m)) + aodbin_fields(n)%name(m) = fldname + lngname = 'Aerosol optical depth, day only, 550 nm, '//trim(aero_props(n)%obj%bin_name(0,m)) + call addfld (aodbin_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) + if (history_aero_optics) then + call add_default (fldname, 1, ' ') + end if + + write(fldname,'(a,i2.2)') 'AODDUST', m + aoddust_fields(n)%name(m) = fldname + write(lngname,'(a,i2,a)') 'Aerosol optical depth, day only, 550 nm mode ',m,' from dust' + call addfld (aoddust_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) + if (history_aero_optics) then + call add_default (fldname, 1, ' ') + end if + + write(fldname,'(a,i2.2)') 'BURDENdn', m + burdendn_fields(n)%name(m) = fldname + write(lngname,'(a,i2)') 'Aerosol burden, day night, bin ', m + call addfld (burdendn_fields(n)%name(m), horiz_only, 'A', 'kg/m2', lngname, flag_xyfill=.true.) + if (history_aero_optics) then + call add_default (fldname, 1, ' ') + end if + + fldname = 'AODdn_'//trim(aero_props(n)%obj%bin_name(0,m)) + aodbindn_fields(n)%name(m) = fldname + lngname = 'Aerosol optical depth 550 nm, day night, '//trim(aero_props(n)%obj%bin_name(0,m)) + call addfld (aodbindn_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) + if (history_aero_optics) then + call add_default (fldname, 1, ' ') + end if + + write(fldname,'(a,i2.2)') 'AODdnDUST', m + aoddustdn_fields(n)%name(m) = fldname + write(lngname,'(a,i2,a)') 'Aerosol optical depth 550 nm, day night, bin ',m,' from dust' + call addfld (aoddustdn_fields(n)%name(m), horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) + if (history_aero_optics) then + call add_default (fldname, 1, ' ') + end if + + end do + + end do + + end if + + call addfld ('AODDUST', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from dust, day only', & + flag_xyfill=.true.) + call addfld ('AODSO4', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SO4, day only', & + flag_xyfill=.true.) + call addfld ('AODPOM', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from POM, day only', & + flag_xyfill=.true.) + call addfld ('AODSOA', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SOA, day only', & + flag_xyfill=.true.) + call addfld ('AODBC', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from BC, day only', & + flag_xyfill=.true.) + call addfld ('AODSS', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from seasalt, day only', & + flag_xyfill=.true.) + call addfld ('AODABSBC', horiz_only, 'A',' ', 'Aerosol absorption optical depth 550 nm from BC, day only',& + flag_xyfill=.true.) + call addfld ('BURDENDUST', horiz_only, 'A','kg/m2', 'Dust aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('BURDENSO4', horiz_only, 'A','kg/m2', 'Sulfate aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('BURDENPOM', horiz_only, 'A','kg/m2', 'POM aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('BURDENSOA', horiz_only, 'A','kg/m2', 'SOA aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('BURDENBC', horiz_only, 'A','kg/m2', 'Black carbon aerosol burden, day only', & + flag_xyfill=.true.) + call addfld ('BURDENSEASALT', horiz_only, 'A','kg/m2', 'Seasalt aerosol burden, day only' , & + flag_xyfill=.true.) + call addfld ('SSAVIS', horiz_only, 'A',' ', 'Aerosol single-scatter albedo, day only', & + flag_xyfill=.true.) + + call addfld ('AODDUSTdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from dust, day night', & + flag_xyfill=.true.) + call addfld ('AODSO4dn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SO4, day night', & + flag_xyfill=.true.) + call addfld ('AODPOMdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from POM, day night', & + flag_xyfill=.true.) + call addfld ('AODSOAdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SOA, day night', & + flag_xyfill=.true.) + call addfld ('AODBCdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from BC, day night', & + flag_xyfill=.true.) + call addfld ('AODSSdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from seasalt, day night', & + flag_xyfill=.true.) + call addfld ('AODABSBCdn', horiz_only, 'A',' ', 'Aerosol absorption optical depth 550 nm from BC, day night',& + flag_xyfill=.true.) + call addfld ('BURDENDUSTdn', horiz_only, 'A','kg/m2', 'Dust aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('BURDENSO4dn', horiz_only, 'A','kg/m2', 'Sulfate aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('BURDENPOMdn', horiz_only, 'A','kg/m2', 'POM aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('BURDENSOAdn', horiz_only, 'A','kg/m2', 'SOA aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('BURDENBCdn', horiz_only, 'A','kg/m2', 'Black carbon aerosol burden, day night', & + flag_xyfill=.true.) + call addfld ('BURDENSEASALTdn', horiz_only, 'A','kg/m2', 'Seasalt aerosol burden, day night' , & + flag_xyfill=.true.) + call addfld ('SSAVISdn', horiz_only, 'A',' ', 'Aerosol single-scatter albedo, day night', & + flag_xyfill=.true.) + + if (history_amwg) then + call add_default ('AODDUST01' , 1, ' ') + call add_default ('AODDUST03' , 1, ' ') + call add_default ('AODDUST' , 1, ' ') + call add_default ('AODVIS' , 1, ' ') + end if + + if (history_dust) then + call add_default ('AODDUST01' , 1, ' ') + call add_default ('AODDUST02' , 1, ' ') + call add_default ('AODDUST03' , 1, ' ') + end if + + if (history_aero_optics) then + call add_default ('AODDUST01' , 1, ' ') + call add_default ('AODDUST03' , 1, ' ') + call add_default ('ABSORB' , 1, ' ') + call add_default ('AODVIS' , 1, ' ') + call add_default ('AODUV' , 1, ' ') + call add_default ('AODNIR' , 1, ' ') + call add_default ('AODABS' , 1, ' ') + call add_default ('AODABSBC' , 1, ' ') + call add_default ('AODDUST' , 1, ' ') + call add_default ('AODSO4' , 1, ' ') + call add_default ('AODPOM' , 1, ' ') + call add_default ('AODSOA' , 1, ' ') + call add_default ('AODBC' , 1, ' ') + call add_default ('AODSS' , 1, ' ') + call add_default ('BURDEN01' , 1, ' ') + call add_default ('BURDEN02' , 1, ' ') + call add_default ('BURDEN03' , 1, ' ') + call add_default ('BURDENDUST' , 1, ' ') + call add_default ('BURDENSO4' , 1, ' ') + call add_default ('BURDENPOM' , 1, ' ') + call add_default ('BURDENSOA' , 1, ' ') + call add_default ('BURDENBC' , 1, ' ') + call add_default ('BURDENSEASALT', 1, ' ') + call add_default ('SSAVIS' , 1, ' ') + call add_default ('EXTINCT' , 1, ' ') + call add_default ('AODxASYM' , 1, ' ') + call add_default ('EXTxASYM' , 1, ' ') + + call add_default ('AODdnDUST01' , 1, ' ') + call add_default ('AODdnDUST03' , 1, ' ') + call add_default ('ABSORBdn' , 1, ' ') + call add_default ('AODVISdn' , 1, ' ') + call add_default ('AODUVdn' , 1, ' ') + call add_default ('AODNIRdn' , 1, ' ') + call add_default ('AODABSdn' , 1, ' ') + call add_default ('AODABSBCdn' , 1, ' ') + call add_default ('AODDUSTdn' , 1, ' ') + call add_default ('AODSO4dn' , 1, ' ') + call add_default ('AODPOMdn' , 1, ' ') + call add_default ('AODSOAdn' , 1, ' ') + call add_default ('AODBCdn' , 1, ' ') + call add_default ('AODSSdn' , 1, ' ') + call add_default ('BURDENdn01' , 1, ' ') + call add_default ('BURDENdn02' , 1, ' ') + call add_default ('BURDENdn03' , 1, ' ') + call add_default ('BURDENDUSTdn' , 1, ' ') + call add_default ('BURDENSO4dn' , 1, ' ') + call add_default ('BURDENPOMdn' , 1, ' ') + call add_default ('BURDENSOAdn' , 1, ' ') + call add_default ('BURDENBCdn' , 1, ' ') + call add_default ('BURDENSEASALTdn', 1, ' ') + call add_default ('SSAVISdn' , 1, ' ') + call add_default ('EXTINCTdn' , 1, ' ') + call add_default ('AODxASYMdn' , 1, ' ') + call add_default ('EXTxASYMdn' , 1, ' ') + end if + + end subroutine aerosol_optics_cam_init + + !=============================================================================== + subroutine aerosol_optics_cam_final + + integer :: iaermod + + do iaermod = 1,num_aero_models + if (associated(aero_props(iaermod)%obj)) then + deallocate(aero_props(iaermod)%obj) + nullify(aero_props(iaermod)%obj) + end if + end do + + if (allocated(aero_props)) then + deallocate(aero_props) + endif + + end subroutine aerosol_optics_cam_final + + !=============================================================================== + subroutine aerosol_optics_cam_sw(list_idx, state, pbuf, nnite, idxnite, tauxar, wa, ga, fa) + + ! calculates aerosol sw radiative properties + + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + type(physics_state), intent(in), target :: state ! state variables + + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nnite ! number of night columns + integer, intent(in) :: idxnite(nnite) ! local column indices of night columns + + real(r8), intent(inout) :: tauxar(pcols,0:pver,nswbands) ! layer extinction optical depth + real(r8), intent(inout) :: wa(pcols,0:pver,nswbands) ! layer single-scatter albedo + real(r8), intent(inout) :: ga(pcols,0:pver,nswbands) ! asymmetry factor + real(r8), intent(inout) :: fa(pcols,0:pver,nswbands) ! forward scattered fraction + + character(len=*), parameter :: prefix = 'aerosol_optics_cam_sw: ' + + integer :: ibin, nbins + integer :: iwav, ilev + integer :: icol, istat + integer :: lchnk, ncol + + type(aero_state_t), allocatable :: aero_state(:) ! array of aerosol state objects to allow for + ! multiple aerosol representations in the same sim + ! such as MAM and CARMA + + class(aerosol_optics), pointer :: aero_optics + + real(r8) :: dopaer(pcols) + real(r8) :: mass(pcols,pver) + real(r8) :: air_density(pcols,pver) + + real(r8), allocatable :: pext(:) ! parameterized specific extinction (m2/kg) + real(r8), allocatable :: pabs(:) ! parameterized specific absorption (m2/kg) + real(r8), allocatable :: palb(:) ! parameterized single scattering albedo + real(r8), allocatable :: pasm(:) ! parameterized asymmetry factor + + character(len=ot_length) :: opticstype + integer :: iaermod + + real(r8) :: aodvis(pcols) ! extinction optical depth in vis + real(r8) :: aoduv(pcols) ! extinction optical depth in uv + real(r8) :: aodnir(pcols) ! extinction optical depth in nir + real(r8) :: absorb(pcols,pver) + real(r8) :: aodabs(pcols) ! absorption optical depth + + real(r8) :: aodabsbc(pcols) ! absorption optical depth of BC + + real(r8) :: aodtot(pcols) + + real(r8) :: extinct(pcols,pver) + real(r8) :: extinctnir(pcols,pver) + real(r8) :: extinctuv(pcols,pver) + + real(r8) :: asymvis(pcols) ! asymmetry factor * optical depth + real(r8) :: asymext(pcols,pver) ! asymmetry factor * extinction + + real(r8) :: wetvol(pcols,pver) + real(r8) :: watervol(pcols,pver) + + real(r8) :: vol(pcols) + real(r8) :: dustvol(pcols) + + real(r8) :: scatdust(pcols) + real(r8) :: absdust(pcols) + real(r8) :: dustaodbin(pcols) + + real(r8) :: scatbc(pcols) + real(r8) :: absbc(pcols) + + real(r8) :: scatpom(pcols) + real(r8) :: abspom(pcols) + + real(r8) :: scatsslt(pcols) + real(r8) :: abssslt(pcols) + + real(r8) :: scatsoa(pcols) + real(r8) :: abssoa(pcols) + + real(r8) :: scatsulf(pcols) + real(r8) :: abssulf(pcols) + + real(r8) :: burden(pcols) + real(r8) :: burdendust(pcols), burdenso4(pcols), burdenbc(pcols), & + burdenpom(pcols), burdensoa(pcols), burdenseasalt(pcols) + + real(r8) :: hygrodust(pcols), hygrosulf(pcols), hygrobc(pcols), & + hygropom(pcols), hygrosoa(pcols), hygrosslt(pcols) + + real(r8) :: aodbin(pcols) + + complex(r8), pointer :: specrefindex(:) ! species refractive index + + class(aerosol_state), pointer :: aerostate + class(aerosol_properties), pointer :: aeroprops + + real(r8) :: specdens + character(len=32) :: spectype ! species type + real(r8), pointer :: specmmr(:,:) + real(r8) :: hygro_aer ! + + real(r8) :: scath2o, absh2o, sumscat, sumabs, sumhygro + + real(r8) :: aodc ! aod of component + + ! total species AOD + real(r8) :: dustaod(pcols), sulfaod(pcols), bcaod(pcols), & + pomaod(pcols), soaaod(pcols), ssltaod(pcols) + + real(r8) :: aodvisst(pcols) ! stratospheric extinction optical depth + real(r8) :: aoduvst(pcols) ! stratospheric extinction optical depth in uv + real(r8) :: aodnirst(pcols) ! stratospheric extinction optical depth in nir + real(r8) :: ssavis(pcols) + integer :: troplev(pcols) + + nullify(aero_optics) + + lchnk = state%lchnk + ncol = state%ncol + + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + troplev(:) = 0 + !REMOVECAM_END + call tropopause_findChemTrop(state, troplev) + + mass(:ncol,:) = state%pdeldry(:ncol,:)*rga + air_density(:ncol,:) = state%pmid(:ncol,:)/(rair*state%t(:ncol,:)) + + aodvis = 0._r8 + aodnir = 0._r8 + aoduv = 0._r8 + aodabs = 0._r8 + absorb = 0._r8 + aodtot = 0._r8 + tauxar = 0._r8 + extinct = 0._r8 + extinctnir = 0._r8 + extinctuv = 0._r8 + asymvis = 0.0_r8 + asymext = 0.0_r8 + ssavis = 0.0_r8 + aodvisst = 0.0_r8 + aoduvst = 0.0_r8 + aodnirst = 0.0_r8 + + burdendust = 0.0_r8 + burdenso4 = 0.0_r8 + burdenbc = 0.0_r8 + burdenpom = 0.0_r8 + burdensoa = 0.0_r8 + burdenseasalt = 0.0_r8 + + aodabsbc = 0.0_r8 + dustaod = 0.0_r8 + sulfaod = 0.0_r8 + pomaod = 0.0_r8 + soaaod = 0.0_r8 + bcaod = 0.0_r8 + ssltaod = 0.0_r8 + + if (num_aero_models<1) return + + allocate(aero_state(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aero_state') + end if + + iaermod = 0 + if (modal_active) then + iaermod = iaermod+1 + aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) + end if + + allocate(pext(ncol), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: pext') + end if + allocate(pabs(ncol), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: pabs') + end if + allocate(palb(ncol), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: palb') + end if + allocate(pasm(ncol), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: pasm') + end if + + aeromodel: do iaermod = 1,num_aero_models + + aeroprops => aero_props(iaermod)%obj + aerostate => aero_state(iaermod)%obj + + nbins=aeroprops%nbins(list_idx) + + binloop: do ibin = 1, nbins + + dustaodbin(:) = 0._r8 + burden(:) = 0._r8 + aodbin(:) = 0.0_r8 + + call aeroprops%optics_params(list_idx, ibin, opticstype=opticstype) + + select case (trim(opticstype)) + case('modal') ! refractive method + aero_optics=>refractive_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & + ncol, pver, nswbands, nlwbands, crefwsw, crefwlw) + case default + call endrun(prefix//'optics method not recognized') + end select + + if (associated(aero_optics)) then + + wetvol(:ncol,:pver) = aerostate%wet_volume(aeroprops, list_idx, ibin, ncol, pver) + watervol(:ncol,:pver) = aerostate%water_volume(aeroprops, list_idx, ibin, ncol, pver) + + wavelength: do iwav = 1, nswbands + + vertical: do ilev = 1, pver + + call aero_optics%sw_props(ncol, ilev, iwav, pext, pabs, palb, pasm ) + + call init_diags + + column: do icol = 1,ncol + dopaer(icol) = pext(icol)*mass(icol,ilev) + tauxar(icol,ilev,iwav) = tauxar(icol,ilev,iwav) + dopaer(icol) + wa(icol,ilev,iwav) = wa(icol,ilev,iwav) + dopaer(icol)*palb(icol) + ga(icol,ilev,iwav) = ga(icol,ilev,iwav) + dopaer(icol)*palb(icol)*pasm(icol) + fa(icol,ilev,iwav) = fa(icol,ilev,iwav) + dopaer(icol)*palb(icol)*pasm(icol)*pasm(icol) + + call update_diags + + end do column + + end do vertical + end do wavelength + + else + call endrun(prefix//'aero_optics object pointer not associated') + end if + + deallocate(aero_optics) + nullify(aero_optics) + + call output_bin_diags + + end do binloop + end do aeromodel + + call output_tot_diags + + deallocate(pext) + deallocate(pabs) + deallocate(palb) + deallocate(pasm) + + do iaermod = 1,num_aero_models + deallocate(aero_state(iaermod)%obj) + nullify(aero_state(iaermod)%obj) + end do + + deallocate(aero_state) + + contains + + !=============================================================================== + subroutine init_diags + dustvol(:ncol) = 0._r8 + scatdust(:ncol) = 0._r8 + absdust(:ncol) = 0._r8 + hygrodust(:ncol) = 0._r8 + scatsulf(:ncol) = 0._r8 + abssulf(:ncol) = 0._r8 + hygrosulf(:ncol) = 0._r8 + scatbc(:ncol) = 0._r8 + absbc(:ncol) = 0._r8 + hygrobc(:ncol) = 0._r8 + scatpom(:ncol) = 0._r8 + abspom(:ncol) = 0._r8 + hygropom(:ncol) = 0._r8 + scatsoa(:ncol) = 0._r8 + abssoa(:ncol) = 0._r8 + hygrosoa(:ncol) = 0._r8 + scatsslt(:ncol) = 0._r8 + abssslt(:ncol) = 0._r8 + hygrosslt(:ncol) = 0._r8 + end subroutine init_diags + + !=============================================================================== + subroutine update_diags + + integer :: ispec + + if (iwav==idx_uv_diag) then + aoduv(icol) = aoduv(icol) + dopaer(icol) + extinctuv(icol,ilev) = extinctuv(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) + if (ilev<=troplev(icol)) then + aoduvst(icol) = aoduvst(icol) + dopaer(icol) + end if + + else if (iwav==idx_sw_diag) then ! vis + aodvis(icol) = aodvis(icol) + dopaer(icol) + aodabs(icol) = aodabs(icol) + pabs(icol)*mass(icol,ilev) + extinct(icol,ilev) = extinct(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) + absorb(icol,ilev) = absorb(icol,ilev) + pabs(icol)*air_density(icol,ilev) + ssavis(icol) = ssavis(icol) + dopaer(icol)*palb(icol) + asymvis(icol) = asymvis(icol) + dopaer(icol)*pasm(icol) + asymext(icol,ilev) = asymext(icol,ilev) + dopaer(icol)*pasm(icol)*air_density(icol,ilev)/mass(icol,ilev) + + aodbin(icol) = aodbin(icol) + dopaer(icol) + + if (ilev<=troplev(icol)) then + aodvisst(icol) = aodvisst(icol) + dopaer(icol) + end if + + ! loop over species ... + + do ispec = 1, aeroprops%nspecies(list_idx,ibin) + call aeroprops%get(ibin, ispec, list_ndx=list_idx, density=specdens, & + spectype=spectype, refindex_sw=specrefindex, hygro=hygro_aer) + call aerostate%get_ambient_mmr(list_idx, ispec, ibin, specmmr) + + burden(icol) = burden(icol) + specmmr(icol,ilev)*mass(icol,ilev) + + vol(icol) = specmmr(icol,ilev)/specdens + + select case ( trim(spectype) ) + case('dust') + dustvol(icol) = vol(icol) + burdendust(icol) = burdendust(icol) + specmmr(icol,ilev)*mass(icol,ilev) + scatdust(icol) = vol(icol) * specrefindex(iwav)%re + absdust(icol) =-vol(icol) * specrefindex(iwav)%im + hygrodust(icol)= vol(icol)*hygro_aer + case('black-c') + burdenbc(icol) = burdenbc(icol) + specmmr(icol,ilev)*mass(icol,ilev) + scatbc(icol) = vol(icol) * specrefindex(iwav)%re + absbc(icol) =-vol(icol) * specrefindex(iwav)%im + hygrobc(icol)= vol(icol)*hygro_aer + case('sulfate') + burdenso4(icol) = burdenso4(icol) + specmmr(icol,ilev)*mass(icol,ilev) + scatsulf(icol) = vol(icol) * specrefindex(iwav)%re + abssulf(icol) =-vol(icol) * specrefindex(iwav)%im + hygrosulf(icol)= vol(icol)*hygro_aer + case('p-organic') + burdenpom(icol) = burdenpom(icol) + specmmr(icol,ilev)*mass(icol,ilev) + scatpom(icol) = vol(icol) * specrefindex(iwav)%re + abspom(icol) =-vol(icol) * specrefindex(iwav)%im + hygropom(icol)= vol(icol)*hygro_aer + case('s-organic') + burdensoa(icol) = burdensoa(icol) + specmmr(icol,ilev)*mass(icol,ilev) + scatsoa(icol) = vol(icol) * specrefindex(iwav)%re + abssoa(icol) = -vol(icol) * specrefindex(iwav)%im + hygrosoa(icol)= vol(icol)*hygro_aer + case('seasalt') + burdenseasalt(icol) = burdenseasalt(icol) + specmmr(icol,ilev)*mass(icol,ilev) + scatsslt(icol) = vol(icol) * specrefindex(iwav)%re + abssslt(icol) = -vol(icol) * specrefindex(iwav)%im + hygrosslt(icol)= vol(icol)*hygro_aer + end select + end do + + if (wetvol(icol,ilev)>1.e-40_r8 .and. vol(icol)>0._r8) then + + dustaodbin(icol) = dustaodbin(icol) + dopaer(icol)*dustvol(icol)/wetvol(icol,ilev) + + ! partition optical depth into contributions from each constituent + ! assume contribution is proportional to refractive index X volume + + scath2o = watervol(icol,ilev)*crefwsw(iwav)%re + absh2o = -watervol(icol,ilev)*crefwsw(iwav)%im + sumscat = scatsulf(icol) + scatpom(icol) + scatsoa(icol) + scatbc(icol) + & + scatdust(icol) + scatsslt(icol) + scath2o + sumabs = abssulf(icol) + abspom(icol) + abssoa(icol) + absbc(icol) + & + absdust(icol) + abssslt(icol) + absh2o + sumhygro = hygrosulf(icol) + hygropom(icol) + hygrosoa(icol) + hygrobc(icol) + & + hygrodust(icol) + hygrosslt(icol) + + scatdust(icol) = (scatdust(icol) + scath2o*hygrodust(icol)/sumhygro)/sumscat + absdust(icol) = (absdust(icol) + absh2o*hygrodust(icol)/sumhygro)/sumabs + + scatsulf(icol) = (scatsulf(icol) + scath2o*hygrosulf(icol)/sumhygro)/sumscat + abssulf(icol) = (abssulf(icol) + absh2o*hygrosulf(icol)/sumhygro)/sumabs + + scatpom(icol) = (scatpom(icol) + scath2o*hygropom(icol)/sumhygro)/sumscat + abspom(icol) = (abspom(icol) + absh2o*hygropom(icol)/sumhygro)/sumabs + + scatsoa(icol) = (scatsoa(icol) + scath2o*hygrosoa(icol)/sumhygro)/sumscat + abssoa(icol) = (abssoa(icol) + absh2o*hygrosoa(icol)/sumhygro)/sumabs + + scatbc(icol)= (scatbc(icol) + scath2o*hygrobc(icol)/sumhygro)/sumscat + absbc(icol) = (absbc(icol) + absh2o*hygrobc(icol)/sumhygro)/sumabs + + scatsslt(icol) = (scatsslt(icol) + scath2o*hygrosslt(icol)/sumhygro)/sumscat + abssslt(icol) = (abssslt(icol) + absh2o*hygrosslt(icol)/sumhygro)/sumabs + + + aodabsbc(icol) = aodabsbc(icol) + absbc(icol)*dopaer(icol)*(1.0_r8-palb(icol)) + + + + aodc = (absdust(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatdust(icol))*dopaer(icol) + dustaod(icol) = dustaod(icol) + aodc + + aodc = (abssulf(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatsulf(icol))*dopaer(icol) + sulfaod(icol) = sulfaod(icol) + aodc + + aodc = (abspom(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatpom(icol))*dopaer(icol) + pomaod(icol) = pomaod(icol) + aodc + + aodc = (abssoa(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatsoa(icol))*dopaer(icol) + soaaod(icol) = soaaod(icol) + aodc + + aodc = (absbc(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatbc(icol))*dopaer(icol) + bcaod(icol) = bcaod(icol) + aodc + + aodc = (abssslt(icol)*(1.0_r8 - palb(icol)) + palb(icol)*scatsslt(icol))*dopaer(icol) + ssltaod(icol) = ssltaod(icol) + aodc + + end if + else if (iwav==idx_nir_diag) then + aodnir(icol) = aodnir(icol) + dopaer(icol) + extinctnir(icol,ilev) = extinctnir(icol,ilev) + dopaer(icol)*air_density(icol,ilev)/mass(icol,ilev) + + if (ilev<=troplev(icol)) then + aodnirst(icol) = aodnirst(icol) + dopaer(icol) + end if + + end if + + aodtot(icol) = aodtot(icol) + dopaer(icol) + + end subroutine update_diags + + !=============================================================================== + subroutine output_bin_diags + + integer :: icol + + if (list_idx == 0) then + + call outfld(burdendn_fields(iaermod)%name(ibin), burden, pcols, lchnk) + call outfld(aoddustdn_fields(iaermod)%name(ibin), dustaodbin, pcols, lchnk) + call outfld(aodbindn_fields(iaermod)%name(ibin), aodbin, pcols, lchnk) + + do icol = 1, nnite + burden(idxnite(icol)) = fillvalue + aodbin(idxnite(icol)) = fillvalue + dustaodbin(idxnite(icol)) = fillvalue + end do + + call outfld(burden_fields(iaermod)%name(ibin), burden, pcols, lchnk) + call outfld(aoddust_fields(iaermod)%name(ibin), dustaodbin, pcols, lchnk) + call outfld(aodbin_fields(iaermod)%name(ibin), aodbin, pcols, lchnk) + + endif + + end subroutine output_bin_diags + + !=============================================================================== + subroutine output_tot_diags + + integer :: icol + + call outfld('AODUVdn'//diag(list_idx), aoduv, pcols, lchnk) + call outfld('AODVISdn'//diag(list_idx), aodvis, pcols, lchnk) + call outfld('AODABSdn'//diag(list_idx), aodabs, pcols, lchnk) + call outfld('AODNIRdn'//diag(list_idx), aodnir, pcols, lchnk) + call outfld('AODTOTdn'//diag(list_idx), aodtot, pcols, lchnk) + call outfld('EXTINCTUVdn'//diag(list_idx), extinctuv, pcols, lchnk) + call outfld('EXTINCTNIRdn'//diag(list_idx), extinctnir, pcols, lchnk) + call outfld('EXTINCTdn'//diag(list_idx), extinct, pcols, lchnk) + call outfld('ABSORBdn'//diag(list_idx), absorb, pcols, lchnk) + call outfld('EXTxASYMdn'//diag(list_idx), asymext, pcols, lchnk) + call outfld('AODxASYMdn'//diag(list_idx), asymvis, pcols, lchnk) + + call outfld('AODVISstdn'//diag(list_idx), aodvisst,pcols, lchnk) + call outfld('AODUVstdn'//diag(list_idx), aoduvst, pcols, lchnk) + call outfld('AODNIRstdn'//diag(list_idx), aodnirst,pcols, lchnk) + + do icol = 1, nnite + aodvis(idxnite(icol)) = fillvalue + aodnir(idxnite(icol)) = fillvalue + aoduv(idxnite(icol)) = fillvalue + aodabs(idxnite(icol)) = fillvalue + aodtot(idxnite(icol)) = fillvalue + extinct(idxnite(icol),:) = fillvalue + extinctnir(idxnite(icol),:) = fillvalue + extinctuv(idxnite(icol),:) = fillvalue + absorb(idxnite(icol),:) = fillvalue + asymext(idxnite(icol),:) = fillvalue + asymvis(idxnite(icol)) = fillvalue + aodabs(idxnite(icol)) = fillvalue + aodvisst(idxnite(icol)) = fillvalue + aoduvst(idxnite(icol)) = fillvalue + aodnirst(idxnite(icol)) = fillvalue + end do + + call outfld('AODUV'//diag(list_idx), aoduv, pcols, lchnk) + call outfld('AODVIS'//diag(list_idx), aodvis, pcols, lchnk) + call outfld('AODABS'//diag(list_idx), aodabs, pcols, lchnk) + call outfld('AODNIR'//diag(list_idx), aodnir, pcols, lchnk) + call outfld('AODTOT'//diag(list_idx), aodtot, pcols, lchnk) + call outfld('EXTINCTUV'//diag(list_idx), extinctuv, pcols, lchnk) + call outfld('EXTINCTNIR'//diag(list_idx), extinctnir, pcols, lchnk) + call outfld('EXTINCT'//diag(list_idx), extinct, pcols, lchnk) + call outfld('ABSORB'//diag(list_idx), absorb, pcols, lchnk) + call outfld('EXTxASYM'//diag(list_idx), asymext, pcols, lchnk) + call outfld('AODxASYM'//diag(list_idx), asymvis, pcols, lchnk) + call outfld('AODVISst'//diag(list_idx), aodvisst,pcols, lchnk) + call outfld('AODUVst'//diag(list_idx), aoduvst, pcols, lchnk) + call outfld('AODNIRst'//diag(list_idx), aodnirst,pcols, lchnk) + + ! These diagnostics are output only for climate list + if (list_idx == 0) then + do icol = 1, ncol + if (aodvis(icol) > 1.e-10_r8) then + ssavis(icol) = ssavis(icol)/aodvis(icol) + else + ssavis(icol) = 0.925_r8 + endif + end do + call outfld('SSAVISdn', ssavis, pcols, lchnk) + + call outfld('BURDENDUSTdn', burdendust, pcols, lchnk) + call outfld('BURDENSO4dn' , burdenso4, pcols, lchnk) + call outfld('BURDENPOMdn' , burdenpom, pcols, lchnk) + call outfld('BURDENSOAdn' , burdensoa, pcols, lchnk) + call outfld('BURDENBCdn' , burdenbc, pcols, lchnk) + call outfld('BURDENSEASALTdn', burdenseasalt, pcols, lchnk) + + call outfld('AODABSBCdn', aodabsbc, pcols, lchnk) + + call outfld('AODDUSTdn', dustaod, pcols, lchnk) + call outfld('AODSO4dn', sulfaod, pcols, lchnk) + call outfld('AODPOMdn', pomaod, pcols, lchnk) + call outfld('AODSOAdn', soaaod, pcols, lchnk) + call outfld('AODBCdn', bcaod, pcols, lchnk) + call outfld('AODSSdn', ssltaod, pcols, lchnk) + + + do icol = 1, nnite + + ssavis(idxnite(icol)) = fillvalue + asymvis(idxnite(icol)) = fillvalue + + burdendust(idxnite(icol)) = fillvalue + burdenso4(idxnite(icol)) = fillvalue + burdenpom(idxnite(icol)) = fillvalue + burdensoa(idxnite(icol)) = fillvalue + burdenbc(idxnite(icol)) = fillvalue + burdenseasalt(idxnite(icol)) = fillvalue + aodabsbc(idxnite(icol)) = fillvalue + + dustaod(idxnite(icol)) = fillvalue + sulfaod(idxnite(icol)) = fillvalue + pomaod(idxnite(icol)) = fillvalue + soaaod(idxnite(icol)) = fillvalue + bcaod(idxnite(icol)) = fillvalue + ssltaod(idxnite(icol)) = fillvalue + + end do + + call outfld('SSAVIS', ssavis, pcols, lchnk) + call outfld('AODxASYM', asymvis, pcols, lchnk) + call outfld('BURDENDUST', burdendust, pcols, lchnk) + call outfld('BURDENSO4' , burdenso4, pcols, lchnk) + call outfld('BURDENPOM' , burdenpom, pcols, lchnk) + call outfld('BURDENSOA' , burdensoa, pcols, lchnk) + call outfld('BURDENBC' , burdenbc, pcols, lchnk) + call outfld('BURDENSEASALT', burdenseasalt, pcols, lchnk) + call outfld('AODABSBC', aodabsbc, pcols, lchnk) + call outfld('AODDUST', dustaod, pcols, lchnk) + call outfld('AODSO4', sulfaod, pcols, lchnk) + call outfld('AODPOM', pomaod, pcols, lchnk) + call outfld('AODSOA', soaaod, pcols, lchnk) + call outfld('AODBC', bcaod, pcols, lchnk) + call outfld('AODSS', ssltaod, pcols, lchnk) + + end if + + end subroutine output_tot_diags + + end subroutine aerosol_optics_cam_sw + + !=============================================================================== + subroutine aerosol_optics_cam_lw(list_idx, state, pbuf, tauxar) + + ! calculates aerosol lw radiative properties + + integer, intent(in) :: list_idx ! index of the climate or a diagnostic list + type(physics_state), intent(in), target :: state ! state variables + + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(inout) :: tauxar(pcols,pver,nlwbands) ! layer absorption optical depth + + + real(r8) :: dopaer(pcols) + real(r8) :: mass(pcols,pver) + + character(len=*), parameter :: prefix = 'aerosol_optics_cam_lw: ' + + integer :: ibin, nbins + integer :: iwav, ilev + integer :: ncol, icol, istat + + type(aero_state_t), allocatable :: aero_state(:) ! array of aerosol state objects to allow for + ! multiple aerosol representations in the same sim + ! such as MAM and CARMA + + class(aerosol_optics), pointer :: aero_optics + class(aerosol_state), pointer :: aerostate + class(aerosol_properties), pointer :: aeroprops + + real(r8), allocatable :: pabs(:) + + character(len=32) :: opticstype + integer :: iaermod + + real(r8) :: lwabs(pcols,pver) + lwabs = 0._r8 + tauxar = 0._r8 + + nullify(aero_optics) + + allocate(aero_state(num_aero_models), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: aero_state') + end if + + iaermod = 0 + if (modal_active) then + iaermod = iaermod+1 + aero_state(iaermod)%obj => modal_aerosol_state( state, pbuf ) + end if + + ncol = state%ncol + + mass(:ncol,:) = state%pdeldry(:ncol,:)*rga + + allocate(pabs(ncol), stat=istat) + if (istat/=0) then + call endrun(prefix//'array allocation error: pabs') + end if + + aeromodel: do iaermod = 1,num_aero_models + + aeroprops => aero_props(iaermod)%obj + aerostate => aero_state(iaermod)%obj + + nbins=aero_props(iaermod)%obj%nbins(list_idx) + + binloop: do ibin = 1, nbins + + call aeroprops%optics_params(list_idx, ibin, opticstype=opticstype) + + select case (trim(opticstype)) + case('modal') ! refractive method + aero_optics=>refractive_aerosol_optics(aeroprops, aerostate, list_idx, ibin, & + ncol, pver, nswbands, nlwbands, crefwsw, crefwlw) + case default + call endrun(prefix//'optics method not recognized') + end select + + if (associated(aero_optics)) then + + wavelength: do iwav = 1, nlwbands + + vertical: do ilev = 1, pver + call aero_optics%lw_props(ncol, ilev, iwav, pabs ) + + column: do icol = 1, ncol + dopaer(icol) = pabs(icol)*mass(icol,ilev) + tauxar(icol,ilev,iwav) = tauxar(icol,ilev,iwav) + dopaer(icol) + lwabs(icol,ilev) = lwabs(icol,ilev) + pabs(icol) + end do column + + end do vertical + + end do wavelength + + else + call endrun(prefix//'aero_optics object pointer not associated') + end if + + deallocate(aero_optics) + nullify(aero_optics) + + end do binloop + end do aeromodel + + call outfld('TOTABSLW'//diag(list_idx), lwabs(:,:), pcols, state%lchnk) + + if (lw10um_indx>0) then + call outfld('AODABSLW'//diag(list_idx), tauxar(:,:,lw10um_indx), pcols, state%lchnk) + end if + + deallocate(pabs) + + do iaermod = 1,num_aero_models + deallocate(aero_state(iaermod)%obj) + nullify(aero_state(iaermod)%obj) + end do + + deallocate(aero_state) + + end subroutine aerosol_optics_cam_lw + + !=============================================================================== + ! Private routines + !=============================================================================== + + subroutine read_water_refindex(infilename) + use cam_pio_utils, only: cam_pio_openfile + use pio, only: file_desc_t, var_desc_t, pio_inq_dimlen, pio_inq_dimid, pio_inq_varid, & + pio_get_var, PIO_NOWRITE, pio_closefile, pio_noerr + + + ! read water refractive index file and set module data + + character*(*), intent(in) :: infilename ! modal optics filename + + ! Local variables + + integer :: i, ierr + type(file_desc_t) :: ncid ! pio file handle + integer :: did ! dimension ids + integer :: dimlen ! dimension lengths + type(var_desc_t) :: vid ! variable ids + real(r8) :: refrwsw(nswbands), refiwsw(nswbands) ! real, imaginary ref index for water visible + real(r8) :: refrwlw(nlwbands), refiwlw(nlwbands) ! real, imaginary ref index for water infrared + + character(len=*), parameter :: prefix = 'read_water_refindex: ' + !---------------------------------------------------------------------------- + + ! open file + call cam_pio_openfile(ncid, infilename, PIO_NOWRITE) + + ! inquire dimensions. Check that file values match parameter values. + + ierr = pio_inq_dimid(ncid, 'lw_band', did) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_dimid lw_band') + end if + ierr = pio_inq_dimlen(ncid, did, dimlen) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_dimlen lw_band') + end if + if (dimlen /= nlwbands) then + write(iulog,*) 'lw_band len=', dimlen, ' from ', infilename, ' ne nlwbands=', nlwbands + call endrun(prefix//'bad lw_band value') + endif + + ierr = pio_inq_dimid(ncid, 'sw_band', did) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_dimid sw_band') + end if + ierr = pio_inq_dimlen(ncid, did, dimlen) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_dimlen sw_band') + end if + if (dimlen /= nswbands) then + write(iulog,*) 'sw_band len=', dimlen, ' from ', infilename, ' ne nswbands=', nswbands + call endrun(prefix//'bad sw_band value') + endif + + ! read variables + ierr = pio_inq_varid(ncid, 'refindex_real_water_sw', vid) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_varid refindex_real_water_sw') + end if + ierr = pio_get_var(ncid, vid, refrwsw) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_get_var refrwsw') + end if + + ierr = pio_inq_varid(ncid, 'refindex_im_water_sw', vid) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_varid refindex_im_water_sw') + end if + ierr = pio_get_var(ncid, vid, refiwsw) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_get_var refiwsw') + end if + + ierr = pio_inq_varid(ncid, 'refindex_real_water_lw', vid) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_varid refindex_real_water_lw') + end if + ierr = pio_get_var(ncid, vid, refrwlw) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_get_var refrwlw') + end if + + ierr = pio_inq_varid(ncid, 'refindex_im_water_lw', vid) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_inq_varid refindex_im_water_lw') + end if + ierr = pio_get_var(ncid, vid, refiwlw) + if (ierr /= pio_noerr ) then + call endrun(prefix//'pio_get_var refiwlw') + end if + + ! set complex representation of refractive indices as module data + do i = 1, nswbands + crefwsw(i) = cmplx(refrwsw(i), abs(refiwsw(i)), kind=r8) + end do + do i = 1, nlwbands + crefwlw(i) = cmplx(refrwlw(i), abs(refiwlw(i)), kind=r8) + end do + + call pio_closefile(ncid) + + end subroutine read_water_refindex + +end module aerosol_optics_cam diff --git a/src/physics/cam/aoa_tracers.F90 b/src/physics/cam/aoa_tracers.F90 index f13660b327..2d42853756 100644 --- a/src/physics/cam/aoa_tracers.F90 +++ b/src/physics/cam/aoa_tracers.F90 @@ -11,10 +11,11 @@ module aoa_tracers use constituents, only: pcnst, cnst_add, cnst_name, cnst_longname use cam_logfile, only: iulog use ref_pres, only: pref_mid_norm + use time_manager, only: get_curr_date, get_start_date + use time_manager, only: is_leapyear, timemgr_get_calendar_cf, get_calday implicit none private - save ! Public interfaces public :: aoa_tracers_register ! register constituents @@ -27,19 +28,18 @@ module aoa_tracers ! Private module data - integer, parameter :: ncnst=4 ! number of constituents implemented by this module + integer, parameter :: ncnst=3 ! number of constituents implemented by this module ! constituent names - character(len=8), parameter :: c_names(ncnst) = (/'AOA1', 'AOA2', 'HORZ', 'VERT'/) + character(len=4), parameter :: c_names(ncnst) = (/'AOA1', 'HORZ', 'VERT'/) ! constituent source/sink names - character(len=8), parameter :: src_names(ncnst) = (/'AOA1SRC', 'AOA2SRC', 'HORZSRC', 'VERTSRC'/) + character(len=7), parameter :: src_names(ncnst) = (/'AOA1SRC', 'HORZSRC', 'VERTSRC'/) - integer :: ifirst ! global index of first constituent - integer :: ixaoa1 ! global index for AOA1 tracer - integer :: ixaoa2 ! global index for AOA2 tracer - integer :: ixht ! global index for HORZ tracer - integer :: ixvt ! global index for VERT tracer + integer :: ifirst = -1 ! global index of first constituent + integer :: ixaoa = -1 ! global index for AOA1SRC tracer + integer :: ixht = -1 ! global index for HORZ tracer + integer :: ixvt = -1 ! global index for VERT tracer ! Data from namelist variables logical :: aoa_tracers_flag = .false. ! true => turn on test tracer code, namelist variable @@ -66,7 +66,11 @@ module aoa_tracers ! Troposphere and Stratosphere. J. Atmos. Sci., 57, 673-699. ! doi: http://dx.doi.org/10.1175/1520-0469(2000)057<0673:TDOGAI>2.0.CO;2 - real(r8) :: qrel_vert(pver) ! = -7._r8*log(pref_mid_norm(k)) + vert_offset + real(r8) :: qrel_vert(pver) = -huge(1._r8) ! = -7._r8*log(pref_mid_norm(k)) + vert_offset + + integer :: yr0 = -huge(1) + real(r8) :: calday0 = -huge(1._r8) + real(r8) :: years = -huge(1._r8) !=============================================================================== contains @@ -75,12 +79,9 @@ module aoa_tracers !================================================================================ subroutine aoa_tracers_readnl(nlfile) - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand - use cam_abortutils, only: endrun - - implicit none + use namelist_utils, only: find_group_name + use cam_abortutils, only: endrun + use spmd_utils, only: mpicom, masterprocid, mpi_logical, mpi_success character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -88,14 +89,12 @@ subroutine aoa_tracers_readnl(nlfile) integer :: unitn, ierr character(len=*), parameter :: subname = 'aoa_tracers_readnl' - namelist /aoa_tracers_nl/ aoa_tracers_flag, aoa_read_from_ic_file !----------------------------------------------------------------------------- if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'aoa_tracers_nl', status=ierr) if (ierr == 0) then read(unitn, aoa_tracers_nl, iostat=ierr) @@ -104,13 +103,16 @@ subroutine aoa_tracers_readnl(nlfile) end if end if close(unitn) - call freeunit(unitn) end if -#ifdef SPMD - call mpibcast(aoa_tracers_flag, 1, mpilog, 0, mpicom) - call mpibcast(aoa_read_from_ic_file, 1, mpilog, 0, mpicom) -#endif + call mpi_bcast(aoa_tracers_flag, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: aoa_tracers_flag') + end if + call mpi_bcast(aoa_read_from_ic_file, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: aoa_read_from_ic_file') + end if endsubroutine aoa_tracers_readnl @@ -125,17 +127,23 @@ subroutine aoa_tracers_register use physconst, only: cpair, mwdry !----------------------------------------------------------------------- + integer :: k + if (.not. aoa_tracers_flag) return - call cnst_add(c_names(1), mwdry, cpair, 0._r8, ixaoa1, readiv=aoa_read_from_ic_file, & - longname='Age-of_air tracer 1') - ifirst = ixaoa1 - call cnst_add(c_names(2), mwdry, cpair, 0._r8, ixaoa2, readiv=aoa_read_from_ic_file, & - longname='Age-of_air tracer 2') - call cnst_add(c_names(3), mwdry, cpair, 1._r8, ixht, readiv=aoa_read_from_ic_file, & - longname='horizontal tracer') - call cnst_add(c_names(4), mwdry, cpair, 0._r8, ixvt, readiv=aoa_read_from_ic_file, & - longname='vertical tracer') + call cnst_add(c_names(1), mwdry, cpair, 0._r8, ixaoa, readiv=aoa_read_from_ic_file, & + longname='mixing ratio LB tracer', cam_outfld=.false.) + + call cnst_add(c_names(2), mwdry, cpair, 1._r8, ixht, readiv=aoa_read_from_ic_file, & + longname='horizontal tracer', cam_outfld=.false.) + call cnst_add(c_names(3), mwdry, cpair, 0._r8, ixvt, readiv=aoa_read_from_ic_file, & + longname='vertical tracer', cam_outfld=.false.) + + ifirst = ixaoa + + do k = 1,pver + qrel_vert(k) = -7._r8*log(pref_mid_norm(k)) + vert_offset + enddo end subroutine aoa_tracers_register @@ -211,7 +219,9 @@ subroutine aoa_tracers_init use cam_history, only: addfld, add_default - integer :: m, mm, k + integer :: m, mm + integer :: yr, mon, day, sec, ymd + !----------------------------------------------------------------------- if (.not. aoa_tracers_flag) return @@ -227,9 +237,12 @@ subroutine aoa_tracers_init call add_default (src_names(m), 1, ' ') end do - do k = 1,pver - qrel_vert(k) = -7._r8*log(pref_mid_norm(k)) + vert_offset - enddo + call get_start_date(yr, mon, day, sec) + + ymd = yr*10000 + mon*100 + day + + yr0 = yr + calday0 = get_calday(ymd, sec) end subroutine aoa_tracers_init @@ -240,15 +253,14 @@ subroutine aoa_tracers_timestep_init( phys_state ) ! Provides a place to reinitialize diagnostic constituents HORZ and VERT !----------------------------------------------------------------------- - use time_manager, only: get_curr_date use ppgrid, only: begchunk, endchunk use physics_types, only: physics_state type(physics_state), intent(inout), dimension(begchunk:endchunk), optional :: phys_state - integer c, i, k, ncol - integer yr, mon, day, tod + integer yr, mon, day, tod, ymd + real(r8) :: calday, dpy !-------------------------------------------------------------------------- if (.not. aoa_tracers_flag) return @@ -272,29 +284,34 @@ subroutine aoa_tracers_timestep_init( phys_state ) end if + ymd = yr*10000 + mon*100 + day + calday = get_calday(ymd, tod) + + dpy = 365._r8 + if (timemgr_get_calendar_cf() == 'gregorian' .and. is_leapyear(yr)) then + dpy = 366._r8 + end if + years = (yr-yr0) + (calday-calday0)/dpy + end subroutine aoa_tracers_timestep_init !=============================================================================== - subroutine aoa_tracers_timestep_tend(state, ptend, cflx, landfrac, dt) + subroutine aoa_tracers_timestep_tend(state, ptend, dt) use physics_types, only: physics_state, physics_ptend, physics_ptend_init use cam_history, only: outfld - use time_manager, only: get_nstep ! Arguments type(physics_state), intent(in) :: state ! state variables type(physics_ptend), intent(out) :: ptend ! package tendencies - real(r8), intent(inout) :: cflx(pcols,pcnst) ! Surface constituent flux (kg/m^2/s) - real(r8), intent(in) :: landfrac(pcols) ! Land fraction - real(r8), intent(in) :: dt ! timestep + real(r8), intent(in) :: dt ! timestep size (sec) !----------------- Local workspace------------------------------- integer :: i, k integer :: lchnk ! chunk identifier integer :: ncol ! no. of column in chunk - integer :: nstep ! current timestep number real(r8) :: qrel ! value to be relaxed to real(r8) :: xhorz ! updated value of HORZ real(r8) :: xvert ! updated value of VERT @@ -302,6 +319,13 @@ subroutine aoa_tracers_timestep_tend(state, ptend, cflx, landfrac, dt) real(r8) :: teul ! relaxation in 1/sec*dt/2 = k*dt/2 real(r8) :: wimp ! 1./(1.+ k*dt/2) real(r8) :: wsrc ! teul*wimp + + real(r8) :: xmmr + real(r8), parameter :: mmr0 = 1.0e-6_r8 ! initial lower boundary mmr + real(r8), parameter :: per_yr = 0.02_r8 ! fractional increase per year + + real(r8) :: mmr_out(pcols,pver,ncnst) + !------------------------------------------------------------------ teul = .5_r8*dt/(86400._r8 * treldays) ! 1/2 for the semi-implicit scheme if dt=time step @@ -313,26 +337,23 @@ subroutine aoa_tracers_timestep_tend(state, ptend, cflx, landfrac, dt) return end if - lq(:) = .FALSE. - lq(ixaoa1) = .TRUE. - lq(ixaoa2) = .TRUE. - lq(ixht) = .TRUE. - lq(ixvt) = .TRUE. + lq(:) = .FALSE. + lq(ixaoa) = .TRUE. + lq(ixht) = .TRUE. + lq(ixvt) = .TRUE. + call physics_ptend_init(ptend,state%psetcols, 'aoa_tracers', lq=lq) - nstep = get_nstep() lchnk = state%lchnk ncol = state%ncol + ! AOA1 + xmmr = mmr0*(1._r8 + per_yr*years) + ptend%q(1:ncol,pver,ixaoa) = (xmmr - state%q(1:ncol,pver,ixaoa)) / dt + do k = 1, pver do i = 1, ncol - ! AOA1 - ptend%q(i,k,ixaoa1) = 0.0_r8 - - ! AOA2 - ptend%q(i,k,ixaoa2) = 0.0_r8 - ! HORZ qrel = 2._r8 + sin(state%lat(i)) ! qrel should zonal mean xhorz = state%q(i,k,ixht)*wimp + wsrc*qrel ! Xnew = weight*3D-tracer + (1.-weight)*1D-tracer @@ -344,34 +365,22 @@ subroutine aoa_tracers_timestep_tend(state, ptend, cflx, landfrac, dt) ptend%q(i,k,ixvt) = (xvert - state%q(i,k,ixvt)) / dt end do + end do ! record tendencies on history files - call outfld (src_names(1), ptend%q(:,:,ixaoa1), pcols, lchnk) - call outfld (src_names(2), ptend%q(:,:,ixaoa2), pcols, lchnk) - call outfld (src_names(3), ptend%q(:,:,ixht), pcols, lchnk) - call outfld (src_names(4), ptend%q(:,:,ixvt), pcols, lchnk) - - ! Set tracer fluxes - do i = 1, ncol - - ! AOA1 - cflx(i,ixaoa1) = 1.e-6_r8 + call outfld (src_names(1), ptend%q(:,:,ixaoa), pcols, lchnk) + call outfld (src_names(2), ptend%q(:,:,ixht), pcols, lchnk) + call outfld (src_names(3), ptend%q(:,:,ixvt), pcols, lchnk) - ! AOA2 - if (landfrac(i) .eq. 1._r8 .and. state%lat(i) .gt. 0.35_r8) then - cflx(i,ixaoa2) = 1.e-6_r8 + 1e-6_r8*0.0434_r8*real(nstep,r8)*dt/(86400._r8*365._r8) - else - cflx(i,ixaoa2) = 0._r8 - endif + ! output mixing ratios to history + mmr_out(:ncol,:,1) = state%q(:ncol,:,ixaoa) + dt*ptend%q(1:ncol,:,ixaoa) + mmr_out(:ncol,:,2) = state%q(:ncol,:,ixht) + dt*ptend%q(1:ncol,:,ixht) + mmr_out(:ncol,:,3) = state%q(:ncol,:,ixvt) + dt*ptend%q(1:ncol,:,ixvt) - ! HORZ - cflx(i,ixht) = 0._r8 - - ! VERT - cflx(i,ixvt) = 0._r8 - - end do + call outfld (c_names(1), mmr_out(:,:,1), pcols, lchnk) + call outfld (c_names(2), mmr_out(:,:,2), pcols, lchnk) + call outfld (c_names(3), mmr_out(:,:,3), pcols, lchnk) end subroutine aoa_tracers_timestep_tend @@ -389,19 +398,17 @@ subroutine init_cnst_3d(m, latvals, lonvals, mask, q) !----------------------------------------------------------------------- if (masterproc) then - write(iulog,*) 'AGE-OF-AIR CONSTITUENTS: INITIALIZING ',cnst_name(m),m + write(iulog,*) 'AGE-OF-AIR CONSTITUENTS: INITIALIZING ',cnst_name(m),m end if - if (m == ixaoa1) then - - q(:,:) = 0.0_r8 - - else if (m == ixaoa2) then + if (m == ixaoa) then + ! AOA1 q(:,:) = 0.0_r8 else if (m == ixht) then + ! HORZ gsize = size(q, 1) do j = 1, gsize q(j,:) = 2._r8 + sin(latvals(j)) @@ -409,6 +416,7 @@ subroutine init_cnst_3d(m, latvals, lonvals, mask, q) else if (m == ixvt) then + ! VERT do k = 1, pver do j = 1, size(q,1) q(j,k) = qrel_vert(k) @@ -421,5 +429,4 @@ end subroutine init_cnst_3d !===================================================================== - end module aoa_tracers diff --git a/src/physics/cam/boundarydata.F90 b/src/physics/cam/boundarydata.F90 index 59409b9a88..20ccc16037 100644 --- a/src/physics/cam/boundarydata.F90 +++ b/src/physics/cam/boundarydata.F90 @@ -52,15 +52,15 @@ module boundarydata contains subroutine boundarydata_init(bndyfilename,phys_state,fieldnames,fieldcnt,bndydata,vertextrap) - implicit none + implicit none character(len=*),intent(in) :: bndyfilename type(physics_state), intent(in):: phys_state(begchunk:endchunk) integer,intent(in) :: fieldcnt character(len=*), intent(in) :: fieldnames(fieldcnt) - type(boundarydata_type),intent(out) :: bndydata + type(boundarydata_type),intent(out) :: bndydata integer,intent(in), optional :: vertextrap ! if 0 set values outside output grid to 0 ! if 1 set to boundary value - ! if 2 set to cyclic boundaries + ! if 2 set to cyclic boundaries ! if 3 leave on input data grid and extrapolate later real(r8), pointer :: datain(:,:,:,:,:) integer :: lchnk @@ -80,8 +80,8 @@ subroutine boundarydata_init(bndyfilename,phys_state,fieldnames,fieldcnt,bndydat allocate(bndydata%datainst(size(bndydata%fields,1),size(bndydata%fields,2), & begchunk:endchunk,bndydata%fieldcnt)) - - deallocate(datain) + + deallocate(datain) end if end subroutine boundarydata_init @@ -99,7 +99,7 @@ subroutine boundarydata_update(phys_state, bndydata, update_out) integer :: kmax integer :: count(4), start(4), ierr - + call get_data_bounding_date_indices(bndydata%cdates,bndydata%nm,bndydata%np,cdate,update) if(present(update_out)) update_out=update nm= bndydata%nm @@ -108,7 +108,7 @@ subroutine boundarydata_update(phys_state, bndydata, update_out) call get_timeinterp_factors(.true., np, bndydata%cdates(nm), bndydata%cdates(np), & cdate, fact1, fact2, _FILE) - if(size(bndydata%fields,5).eq.2) then + if(size(bndydata%fields,5).eq.2) then nm=1 np=2 if(update) then ! we need to read in the next month and interpolate @@ -119,8 +119,8 @@ subroutine boundarydata_update(phys_state, bndydata, update_out) cols=1 cole=cols+bndydata%count(cols,lchnk)-1 do while(cole<=ncol) - - if(bndydata%levsiz==1) then + + if(bndydata%levsiz==1) then ndims=2 start=(/bndydata%start(cols,lchnk),bndydata%np,-1,-1/) count=(/bndydata%count(cols,lchnk),1,-1,-1/) @@ -161,15 +161,15 @@ subroutine boundarydata_update(phys_state, bndydata, update_out) end if #ifdef SPMD call mpibcast (datain, bndydata%levsiz*bndydata%latsiz*1*bndydata%fieldcnt, mpir8, 0, mpicom, ierr) -#endif - bndydata%fields(:,:,:,:,nm) = bndydata%fields(:,:,:,:,np) +#endif + bndydata%fields(:,:,:,:,nm) = bndydata%fields(:,:,:,:,np) call boundarydata_interpolate(phys_state,datain,bndydata) deallocate(datain) end if end if end if kmax = size(bndydata%fields,2) - + do fld=1,bndydata%fieldcnt do lchnk=begchunk,endchunk if(bndydata%isncol) then @@ -189,27 +189,27 @@ end subroutine boundarydata_update subroutine boundarydata_read(phys_state,bndyfilename,fieldcnt,fieldnames,bndydata,datain) - !----------------------------------------------------------------------- - ! - ! Purpose: + !----------------------------------------------------------------------- + ! + ! Purpose: ! Do initial read of time-variant boundary dataset, containing ! 12 monthly fields as a function of latitude and pressure. Determine the two ! consecutive months between which the current date lies. - ! - ! Method: - ! + ! + ! Method: + ! ! Author: NCAR CMS !----------------------------------------------------------------------- use ioFileMod, only : getfil use bnddyi_mod, only: bnddyi - implicit none + implicit none type(physics_state), intent(in) :: phys_state(begchunk:endchunk) character(len=*),intent(in) :: bndyfilename integer,intent(in) :: fieldcnt character(len=*), intent(in) :: fieldnames(fieldcnt) type(boundarydata_type), intent(inout) :: bndydata - real(r8), pointer :: datain(:,:,:,:,:) ! + real(r8), pointer :: datain(:,:,:,:,:) ! ! ! Local variables ! @@ -256,7 +256,7 @@ subroutine boundarydata_read(phys_state,bndyfilename,fieldcnt,fieldnames,bndydat integer :: cols, cole integer :: ierr, dimcnt integer :: i, ncol, lchnk - character(len=256) :: locfn ! netcdf local filename to open + character(len=256) :: locfn ! netcdf local filename to open ! !----------------------------------------------------------------------- @@ -303,7 +303,7 @@ subroutine boundarydata_read(phys_state,bndyfilename,fieldcnt,fieldnames,bndydat else if (dimname(1:4) .eq. 'ncol') then ncoldimid=i ncolsiz=dimlen - bndydata%isncol=.true. + bndydata%isncol=.true. else if (dimname(1:3) .eq. 'lev') then levdimid=i levsiz=dimlen @@ -342,8 +342,8 @@ subroutine boundarydata_read(phys_state,bndyfilename,fieldcnt,fieldnames,bndydat _FILE,__LINE__) call handle_ncerr( nf90_get_var(bndydata%ncid, hybid, bndydata%hybi ),& _FILE,__LINE__) - else - call endrun('Did not recognize a vertical coordinate variable') + else + call endrun('BOUNDARYDATA_READ: Did not recognize a vertical coordinate variable') end if else levsiz=1 @@ -455,10 +455,10 @@ subroutine boundarydata_read(phys_state,bndyfilename,fieldcnt,fieldnames,bndydat bndydata%count(pcols,begchunk:endchunk)) ! -! For i/o efficiency we read in a block of data which includes the data needed on this +! For i/o efficiency we read in a block of data which includes the data needed on this ! processor but which may in fact include data not needed here. physics cids are just the ! offset into the file. -! +! bndydata%start=-1 bndydata%count=1 @@ -466,7 +466,7 @@ subroutine boundarydata_read(phys_state,bndyfilename,fieldcnt,fieldnames,bndydat maxcid=-1 do lchnk=begchunk,endchunk ncol=phys_state(lchnk)%ncol - i=minval(phys_state(lchnk)%cid(1:ncol)) + i=minval(phys_state(lchnk)%cid(1:ncol)) if(i < mincid) mincid = i i=maxval(phys_state(lchnk)%cid(1:ncol)) if(i > maxcid) maxcid = i @@ -508,7 +508,7 @@ subroutine boundarydata_read(phys_state,bndyfilename,fieldcnt,fieldnames,bndydat end if start(2)=1 count(2)=levsiz - + if(bndydata%np>bndydata%nm) then count(dimcnt)=2 else @@ -550,7 +550,7 @@ subroutine boundarydata_read(phys_state,bndyfilename,fieldcnt,fieldnames,bndydat ! ! get the dimension orientation info from the first variable assume but verify that ! all variables requested have the same orientation - ! + ! allocate(bndydata%start(4,1),bndydata%count(4,1)) call handle_ncerr( nf90_inquire_variable(bndydata%ncid,bndydata%dataid(1), & ndims=bndydata%ndims,dimids=bndydata%dimids),_FILE,__LINE__) @@ -588,7 +588,7 @@ subroutine boundarydata_read(phys_state,bndyfilename,fieldcnt,fieldnames,bndydat ndims=ndims,dimids=dimids),_FILE,__LINE__) if(ndims/=bndydata%ndims .or. dimids(1)/=bndydata%dimids(1).or.& dimids(2)/=bndydata%dimids(2) .or. dimids(3)/=bndydata%dimids(3)) then - call endrun('Variable dims or order does not match') + call endrun('BOUNDARYDATA_READ: Variable dims or order does not match') end if if(bndydata%np .gt. bndydata%nm) then @@ -597,6 +597,7 @@ subroutine boundarydata_read(phys_state,bndyfilename,fieldcnt,fieldnames,bndydat map=bndydata%map),_FILE,__LINE__) else bndydata%count(bndydata%thistimedim,1)=1 + bndydata%start(bndydata%thistimedim,1)=bndydata%nm call handle_ncerr( nf90_get_var(bndydata%ncid, bndydata%dataid(i), & datain(:,:,:,1:1,i), bndydata%start(:,1), bndydata%count(:,1), & map=bndydata%map), _FILE,__LINE__) @@ -612,7 +613,7 @@ subroutine boundarydata_read(phys_state,bndyfilename,fieldcnt,fieldnames,bndydat end if #ifdef USE_MASTERPROC end if -#ifdef SPMD +#ifdef SPMD call mpibcast (levsiz, 1, mpiint, 0, mpicom, ierr) call mpibcast (latsiz, 1, mpiint, 0, mpicom, ierr) #endif @@ -664,7 +665,7 @@ subroutine boundarydata_interpolate(phys_state, datain, bndydata) real(r8),intent(in) :: datain(:,:,:,:,:) type(boundarydata_type), intent(inout) :: bndydata type(interp_type) :: interp_wgts, lev_wgts - + integer :: k, lchnk, nt, j, fcnt real(r8) :: zo(pver) real(r8) :: lato(pcols) @@ -712,7 +713,7 @@ subroutine boundarydata_interpolate(phys_state, datain, bndydata) ! Input model latitudes already in degrees. ! do j=1,ulatcnt - lato(j) = phys_state(lchnk)%ulat(j)*180._r8/pi + lato(j) = phys_state(lchnk)%ulat(j)*180._r8/pi end do call lininterp_init(bndydata%lat,size(bndydata%lat),lato(1:ulatcnt),ulatcnt,1,interp_wgts) @@ -726,7 +727,7 @@ subroutine boundarydata_interpolate(phys_state, datain, bndydata) end if if(bndydata%vertextrap.lt.3) then call lininterp(transpose(datain(1,:,:,nt,fcnt)),bndydata%latsiz,bndydata%levsiz, & - bndydata%fields(1:ulatcnt,:,lchnk,fcnt,tvalout), ulatcnt, pver, interp_wgts, lev_wgts) + bndydata%fields(1:ulatcnt,:,lchnk,fcnt,tvalout), ulatcnt, pver, interp_wgts, lev_wgts) else do k=1,bndydata%levsiz call lininterp(datain(1,k,:,nt,fcnt),bndydata%latsiz, & @@ -787,7 +788,7 @@ subroutine get_data_bounding_date_indices(cdates,nm,np, cdayout, update) ncdate = yr*10000 + mon*100 + day write(iulog,*)'model date:', ncdate, ncsec,'boundary data dates:', cdates - call endrun('BOUNDARYDATA_READ: Failed to find dates bracketing dates') + call endrun('get_data_bounding_date_indices: Failed to find dates bracketing dates') end if end if @@ -796,14 +797,14 @@ end subroutine get_data_bounding_date_indices !================================================================================================ subroutine boundarydata_vert_interp(lchnk, ncol, levsiz, fldcnt, pin, pmid, datain, dataout) - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: Interpolate ozone from current time-interpolated values to model levels - ! + ! ! Method: Use pressure values to determine interpolation levels - ! + ! ! Author: Bruce Briegleb - ! + ! !-------------------------------------------------------------------------- implicit none ! Arguments @@ -897,13 +898,13 @@ subroutine boundarydata_vert_interp(lchnk, ncol, levsiz, fldcnt, pin, pmid, data 35 continue end do end subroutine boundarydata_vert_interp -#if 0 +#if 0 subroutine ncol_read_bracket(cid,columnmap,start,count,ncol) integer, intent(in) :: cid(:), columnmap(:), ncol integer, intent(out) :: start(:), count(:) integer :: i, j, tcol - + tcol = size(columnmap) count=1 do i=1,ncol diff --git a/src/physics/cam/cam3_aero_data.F90 b/src/physics/cam/cam3_aero_data.F90 deleted file mode 100644 index bb32e36b8a..0000000000 --- a/src/physics/cam/cam3_aero_data.F90 +++ /dev/null @@ -1,1021 +0,0 @@ -module cam3_aero_data -!----------------------------------------------------------------------- -! -! Purposes: -! read, store, interpolate, and return fields -! of aerosols to CAM. The initialization -! file (mass.nc) is assumed to be a monthly climatology -! of aerosols from MATCH (on a sigma pressure -! coordinate system). -! also provide a "background" aerosol field to correct -! for any deficiencies in the physical parameterizations -! This fields is a "tuning" parameter. -! Public methods: -! (1) - initialization -! read aerosol masses from external file -! also pressure coordinates -! convert from monthly average values to mid-month values -! (2) - interpolation (time and vertical) -! interpolate onto pressure levels of CAM -! interpolate to time step of CAM -! return mass of aerosols -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use shr_scam_mod, only: shr_scam_GetCloseLatLon - use spmd_utils, only: masterproc - use ppgrid, only: pcols, pver, pverp, begchunk, endchunk - use phys_grid, only: get_ncols_p, scatter_field_to_chunk - use time_manager, only: get_curr_calday - use infnan, only: nan, assignment(=) - use cam_abortutils, only: endrun - use scamMod, only: scmlon,scmlat,single_column - use error_messages, only: handle_ncerr - use physics_types, only: physics_state - use boundarydata, only: boundarydata_init, boundarydata_type - use perf_mod, only: t_startf, t_stopf - use cam_logfile, only: iulog - use netcdf - - implicit none - private - save - - public :: & - cam3_aero_data_readnl, & ! read namelist - cam3_aero_data_register, & ! register these aerosols with pbuf2d - cam3_aero_data_init, & ! read from file, interpolate onto horiz grid - cam3_aero_data_timestep_init ! update data-aerosols to this timestep - - ! namelist variables - logical, public :: cam3_aero_data_on = .false. - character(len=256) :: bndtvaer = 'bndtvaer' ! full pathname for time-variant aerosol mass climatology dataset - - ! naer is number of species in climatology - integer, parameter :: naer = 11 - - real(r8), parameter :: wgt_sscm = 6.0_r8 / 7.0_r8 ! Fraction of total seasalt mass in coarse mode - - ! indices to aerosol array (species portion) - integer, parameter :: & - idxSUL = 1, & - idxSSLTA = 2, & ! accumulation mode - idxSSLTC = 3, & ! coarse mode - idxOCPHO = 8, & - idxBCPHO = 9, & - idxOCPHI = 10, & - idxBCPHI = 11 - - ! indices to sections of array that represent - ! groups of aerosols - integer, parameter :: & - idxSSLTfirst = 2, numSSLT = 2, & - idxDUSTfirst = 4, & - numDUST = 4, & - idxCARBONfirst = 8, & - numCARBON = 4 - - ! names of aerosols are they are represented in - ! the climatology file. - ! Appended '_V' indicates field has been vertically summed. - character(len=8), parameter :: aerosol_name(naer) = & - (/"MSUL_V "& - ,"MSSLTA_V"& - ,"MSSLTC_V"& - ,"MDUST1_V"& - ,"MDUST2_V"& - ,"MDUST3_V"& - ,"MDUST4_V"& - ,"MOCPHO_V"& - ,"MBCPHO_V"& - ,"MOCPHI_V"& - ,"MBCPHI_V"/) - - ! number of different "groups" of aerosols - integer, parameter :: num_aer_groups=4 - - ! which group does each bin belong to? - integer, dimension(naer), parameter :: & - group =(/1,2,2,3,3,3,3,4,4,4,4/) - - ! name of each group - character(len=10), dimension(num_aer_groups), parameter :: & - aerosol_names = (/'sul ','sslt ','dust ','car '/) - - ! this boundarydata_type is used for datasets in the ncols format only. - type(boundarydata_type) :: aerosol_datan - - integer :: aernid = -1 ! netcdf id for aerosol file (init to invalid) - integer :: species_id(naer) = -1 ! netcdf_id of each aerosol species (init to invalid) - integer :: Mpsid ! netcdf id for MATCH PS - integer :: nm = 1 ! index to prv month in array. init to 1 and toggle between 1 and 2 - integer :: np = 2 ! index to nxt month in array. init to 2 and toggle between 1 and 2 - integer :: mo_nxt = huge(1) ! index to nxt month in file - - real(r8) :: cdaym ! calendar day of prv month - real(r8) :: cdayp ! calendar day of next month - - ! aerosol mass - real(r8), allocatable :: aer_mass(:, :, :, :) - - ! Days into year for mid month date - ! This variable is dumb, the dates are in the dataset to be read in but they are - ! slightly different than this so getting rid of it causes a change which - ! exceeds roundoff. - real(r8) :: Mid(12) = (/16.5_r8, 46.0_r8, 75.5_r8, 106.0_r8, 136.5_r8, 167.0_r8, & - 197.5_r8, 228.5_r8, 259.0_r8, 289.5_r8, 320.0_r8, 350.5_r8 /) - - ! values read from file and temporary values used for interpolation - ! - ! aerosolc is: - ! Cumulative Mass at midpoint of each month - ! on CAM's horizontal grid (col) - ! on MATCH's levels (lev) - ! aerosolc - integer, parameter :: paerlev = 28 ! number of levels for aerosol fields (MUST = naerlev) - integer :: naerlev ! size of level dimension in MATCH data - integer :: naerlon - integer :: naerlat - real(r8), pointer :: M_hybi(:) ! MATCH hybi - real(r8), pointer :: M_ps(:,:) ! surface pressure from MATCH file - real(r8), pointer :: aerosolc(:,:,:,:,:) ! Aerosol cumulative mass from MATCH - real(r8), pointer :: M_ps_cam_col(:,:,:) ! PS from MATCH on Cam Columns - - ! indices for fields in the physics buffer - integer :: cam3_sul_idx, cam3_ssam_idx, cam3_sscm_idx, & - cam3_dust1_idx, cam3_dust2_idx, cam3_dust3_idx, cam3_dust4_idx,& - cam3_ocpho_idx, cam3_bcpho_idx, cam3_ocphi_idx, cam3_bcphi_idx - -!================================================================================================ -contains -!================================================================================================ - -subroutine cam3_aero_data_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'cam3_aero_data_readnl' - - namelist /cam3_aero_data_nl/ cam3_aero_data_on, bndtvaer - !----------------------------------------------------------------------------- - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'cam3_aero_data_nl', status=ierr) - if (ierr == 0) then - read(unitn, cam3_aero_data_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - -#ifdef SPMD - ! Broadcast namelist variables - call mpibcast(cam3_aero_data_on, 1, mpilog, 0, mpicom) - call mpibcast(bndtvaer, len(bndtvaer), mpichar, 0, mpicom) -#endif - - ! Prevent using these before they are set. - cdaym = nan - cdayp = nan - -end subroutine cam3_aero_data_readnl - -!================================================================================================ - -subroutine cam3_aero_data_register - - ! register old prescribed aerosols with physics buffer - - use physics_buffer, only: pbuf_add_field, dtype_r8 - - call pbuf_add_field('cam3_sul', 'physpkg',dtype_r8,(/pcols,pver/),cam3_sul_idx) - call pbuf_add_field('cam3_ssam', 'physpkg',dtype_r8,(/pcols,pver/),cam3_ssam_idx) - call pbuf_add_field('cam3_sscm', 'physpkg',dtype_r8,(/pcols,pver/),cam3_sscm_idx) - call pbuf_add_field('cam3_dust1','physpkg',dtype_r8,(/pcols,pver/),cam3_dust1_idx) - call pbuf_add_field('cam3_dust2','physpkg',dtype_r8,(/pcols,pver/),cam3_dust2_idx) - call pbuf_add_field('cam3_dust3','physpkg',dtype_r8,(/pcols,pver/),cam3_dust3_idx) - call pbuf_add_field('cam3_dust4','physpkg',dtype_r8,(/pcols,pver/),cam3_dust4_idx) - call pbuf_add_field('cam3_ocpho','physpkg',dtype_r8,(/pcols,pver/),cam3_ocpho_idx) - call pbuf_add_field('cam3_bcpho','physpkg',dtype_r8,(/pcols,pver/),cam3_bcpho_idx) - call pbuf_add_field('cam3_ocphi','physpkg',dtype_r8,(/pcols,pver/),cam3_ocphi_idx) - call pbuf_add_field('cam3_bcphi','physpkg',dtype_r8,(/pcols,pver/),cam3_bcphi_idx) - -end subroutine cam3_aero_data_register - -!================================================================================================ - -subroutine cam3_aero_data_init(phys_state) -!------------------------------------------------------------------ -! Reads in: -! file from which to read aerosol Masses on CAM grid. Currently -! assumed to be MATCH ncep runs, averaged by month. -! NOTE (Data have been externally interpolated onto CAM grid -! and backsolved to provide Mid-month values) -! -! Populates: -! module variables: -! aerosolc(pcols,paerlev+1,begchunk:endchunk,naer,2)) -! aerosolc( column_index -! , level_index (match levels) -! , chunk_index -! , species_index -! , month = 1:2 ) -! M_hybi(level_index = Lev_MATCH) = pressure at mid-level. -! M_ps_cam_col(column,chunk,month) ! PS from MATCH on Cam Columns -! -! Method: -! read data from file -! allocate memory for storage of aerosol data on CAM horizontal grid -! distribute data to remote nodes -! populates the module variables -! -!------------------------------------------------------------------ - use ioFileMod, only: getfil - -#if ( defined SPMD ) - use mpishorthand -#endif - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - -! local variables - - integer :: naerlev - - integer dateid ! netcdf id for date variable - integer secid ! netcdf id for seconds variable - integer londimid ! netcdf id for longitude dimension - integer latdimid ! netcdf id for latitude dimension - integer levdimid ! netcdf id for level dimension - - integer timesiz ! number of time samples (=12) in netcdf file - integer latid ! netcdf id for latitude variable - integer Mhybiid ! netcdf id for MATCH hybi - integer timeid ! netcdf id for time variable - integer dimids(nf90_max_var_dims) ! variable shape - integer :: start(4) ! start vector for netcdf calls - integer :: kount(4) ! count vector for netcdf calls - integer mo ! month index - integer m ! constituent index - integer :: n ! loop index - integer :: i,j,k ! spatial indices - integer :: date_aer(12) ! Date on aerosol dataset (YYYYMMDD) - integer :: attnum ! attribute number - integer :: ierr ! netcdf return code - real(r8) :: coldata(paerlev) ! aerosol field read in from dataset - integer :: ret - integer mo_prv ! index to previous month - integer latidx,lonidx - - character(len=8) :: aname ! temporary aerosol name - character(len=8) :: tmp_aero_name(naer) ! name for input to boundary data - - character(len=256) :: locfn ! netcdf local filename to open -! -! aerosol_data will be read in from the aerosol boundary dataset, then scattered to chunks -! after filling in the bottom level with zeros -! - real(r8), allocatable :: aerosol_data(:,:,:) ! aerosol field read in from dataset - real(r8), allocatable :: aerosol_field(:,:,:) ! (plon,paerlev+1,plat) aerosol field to be scattered - real(r8) :: caldayloc ! calendar day of current timestep - real(r8) :: closelat,closelon - - character(len=*), parameter :: subname = 'cam3_aero_data_init' - !------------------------------------------------------------------ - - call t_startf(subname) - - allocate (aer_mass(pcols, pver, naer, begchunk:endchunk) ) - - ! set new aerosol names because input file has 1 seasalt bin - do m = 1, naer - tmp_aero_name(m)=aerosol_name(m) - if (aerosol_name(m)=='MSSLTA_V') tmp_aero_name(m) = 'MSSLT_V' - if (aerosol_name(m)=='MSSLTC_V') tmp_aero_name(m) = 'MSSLT_V' - end do - - allocate (aerosolc(pcols,paerlev+1,begchunk:endchunk,naer,2)) - aerosolc(:,:,:,:,:) = 0._r8 - - caldayloc = get_curr_calday () - - if (caldayloc < Mid(1)) then - mo_prv = 12 - mo_nxt = 1 - else if (caldayloc >= Mid(12)) then - mo_prv = 12 - mo_nxt = 1 - else - do i = 2 , 12 - if (caldayloc < Mid(i)) then - mo_prv = i-1 - mo_nxt = i - exit - end if - end do - end if - - ! Set initial calendar day values - cdaym = Mid(mo_prv) - cdayp = Mid(mo_nxt) - - if (masterproc) & - write(iulog,*) subname//': CAM3 prescribed aerosol dataset is: ', trim(bndtvaer) - - call getfil (bndtvaer, locfn, 0) - - call handle_ncerr( nf90_open (locfn, 0, aernid),& - subname, __LINE__) - - if (single_column) & - call shr_scam_GetCloseLatLon(aernid,scmlat,scmlon,closelat,closelon,latidx,lonidx) - - ! Check to see if this dataset is in ncol format. - aerosol_datan%isncol=.false. - ierr = nf90_inq_dimid( aernid, 'ncol', londimid ) - if ( ierr==NF90_NOERR ) then - - aerosol_datan%isncol=.true. - call handle_ncerr(nf90_close(aernid),subname, __LINE__) - - call boundarydata_init(bndtvaer, phys_state, tmp_aero_name, naer, & - aerosol_datan, 3) - - aerosolc(:,1:paerlev,:,:,:)=aerosol_datan%fields - - M_ps_cam_col=>aerosol_datan%ps - M_hybi=>aerosol_datan%hybi - - else - - ! Allocate memory for dynamic arrays local to this module - allocate (M_ps_cam_col(pcols,begchunk:endchunk,2)) - allocate (M_hybi(paerlev+1)) - ! TBH: HACK to avoid use of uninitialized values when ncols < pcols - M_ps_cam_col(:,:,:) = 0._r8 - - if (masterproc) then - - ! First ensure dataset is CAM-ready - - call handle_ncerr(nf90_inquire_attribute (aernid, nf90_global, 'cam-ready', attnum=attnum),& - subname//': interpaerosols needs to be run to create a cam-ready aerosol dataset') - - ! Get and check dimension info - - call handle_ncerr( nf90_inq_dimid( aernid, 'lon', londimid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_dimid( aernid, 'lev', levdimid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_dimid( aernid, 'time', timeid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_dimid( aernid, 'lat', latdimid ),& - subname, __LINE__) - call handle_ncerr( nf90_inquire_dimension( aernid, londimid, len=naerlon ),& - subname, __LINE__) - call handle_ncerr( nf90_inquire_dimension( aernid, levdimid, len=naerlev ),& - subname, __LINE__) - call handle_ncerr( nf90_inquire_dimension( aernid, latdimid, len=naerlat ),& - subname, __LINE__) - call handle_ncerr( nf90_inquire_dimension( aernid, timeid, len=timesiz ),& - subname, __LINE__) - - call handle_ncerr( nf90_inq_varid( aernid, 'date', dateid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_varid( aernid, 'datesec', secid ),& - subname, __LINE__) - - do m = 1, naer - aname=aerosol_name(m) - ! rename because file has only one seasalt field - if (aname=='MSSLTA_V') aname = 'MSSLT_V' - if (aname=='MSSLTC_V') aname = 'MSSLT_V' - call handle_ncerr( nf90_inq_varid( aernid, TRIM(aname), species_id(m)), & - subname, __LINE__) - end do - - call handle_ncerr( nf90_inq_varid( aernid, 'lat', latid ),& - subname, __LINE__) - - ! quick sanity check on one field - call handle_ncerr( nf90_inquire_variable (aernid, species_id(1), dimids=dimids),& - subname, __LINE__) - - if ( (dimids(4) /= timeid) .or. & - (dimids(3) /= levdimid) .or. & - (dimids(2) /= latdimid) .or. & - (dimids(1) /= londimid) ) then - write(iulog,*) subname//': Data must be ordered time, lev, lat, lon' - write(iulog,*) 'data are ordered as', dimids(4), dimids(3), dimids(2), dimids(1) - write(iulog,*) 'data should be ordered as', timeid, levdimid, latdimid, londimid - call endrun () - end if - - ! use hybi,PS from MATCH - call handle_ncerr( nf90_inq_varid( aernid, 'hybi', Mhybiid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_varid( aernid, 'PS', Mpsid ),& - subname, __LINE__) - - ! check dimension order for MATCH's surface pressure - call handle_ncerr( nf90_inquire_variable (aernid, Mpsid, dimids=dimids),& - subname, __LINE__) - if ( (dimids(3) /= timeid) .or. & - (dimids(2) /= latdimid) .or. & - (dimids(1) /= londimid) ) then - write(iulog,*) subname//': Pressure must be ordered time, lat, lon' - write(iulog,*) 'data are ordered as', dimids(3), dimids(2), dimids(1) - write(iulog,*) 'data should be ordered as', timeid, levdimid, latdimid, londimid - call endrun () - end if - - ! read in hybi from MATCH - call handle_ncerr( nf90_get_var (aernid, Mhybiid, M_hybi),& - subname, __LINE__) - - ! Retrieve date and sec variables. - call handle_ncerr( nf90_get_var (aernid, dateid, date_aer),& - subname, __LINE__) - if (timesiz < 12) then - write(iulog,*) subname//': When cycling aerosols, dataset must have 12 consecutive ', & - 'months of data starting with Jan' - write(iulog,*) 'Current dataset has only ',timesiz,' months' - call endrun () - end if - do mo = 1,12 - if (mod(date_aer(mo),10000)/100 /= mo) then - write(iulog,*) subname//': When cycling aerosols, dataset must have 12 consecutive ', & - 'months of data starting with Jan' - write(iulog,*)'Month ',mo,' of dataset says date=',date_aer(mo) - call endrun () - end if - end do - if (single_column) then - naerlat=1 - naerlon=1 - endif - kount(:) = (/naerlon,naerlat,paerlev,1/) - end if ! masterproc - - ! broadcast hybi to nodes - -#if ( defined SPMD ) - call mpibcast (M_hybi, paerlev+1, mpir8, 0, mpicom) - call mpibcast (kount, 3, mpiint, 0, mpicom) - naerlon = kount(1) - naerlat = kount(2) -#endif - allocate(aerosol_field(kount(1),kount(3)+1,kount(2))) - allocate(M_ps(kount(1),kount(2))) - if (masterproc) allocate(aerosol_data(kount(1),kount(2),kount(3))) - - ! Retrieve Aerosol Masses (kg/m^2 in each layer), transpose to model order (lon,lev,lat), - ! then scatter to slaves. - if (nm /= 1 .or. np /= 2) call endrun (subname//': bad nm or np value') - do n=nm,np - if (n == 1) then - mo = mo_prv - else - mo = mo_nxt - end if - - do m=1,naer - if (masterproc) then - if (single_column) then - start(:) = (/lonidx,latidx,1,mo/) - else - start(:) = (/1,1,1,mo/) - endif - kount(:) = (/naerlon,naerlat,paerlev,1/) - - call handle_ncerr( nf90_get_var (aernid, species_id(m),aerosol_data, start, kount),& - subname, __LINE__) - do j=1,naerlat - do k=1,paerlev - aerosol_field(:,k,j) = aerosol_data(:,j,k) - end do - aerosol_field(:,paerlev+1,j) = 0._r8 ! value at bottom - end do - - end if - call scatter_field_to_chunk (1, paerlev+1, 1, naerlon, aerosol_field, & - aerosolc(:,:,:,m,n)) - end do - - ! Retrieve PS from Match - - if (masterproc) then - if (single_column) then - start(:) = (/lonidx,latidx,mo,-1/) - else - start(:) = (/1,1,mo,-1/) - endif - kount(:) = (/naerlon,naerlat,1,-1/) - call handle_ncerr( nf90_get_var(aernid, Mpsid, M_ps,start,kount),& - subname, __LINE__) - end if - call scatter_field_to_chunk (1, 1, 1, naerlon, M_ps(:,:), M_ps_cam_col(:,:,n)) - end do ! n=nm,np (=1,2) - - if(masterproc) deallocate(aerosol_data) - deallocate(aerosol_field) - - end if ! Check to see if this dataset is in ncol format. - - call t_stopf(subname) - -end subroutine cam3_aero_data_init - -!================================================================================================ - -subroutine cam3_aero_data_timestep_init(pbuf2d, phys_state) -!------------------------------------------------------------------ -! -! Input: -! time at which aerosol masses are needed (get_curr_calday()) -! chunk index -! CAM's vertical grid (pint) -! -! Output: -! values for Aerosol Mass at time specified by get_curr_calday -! on vertical grid specified by pint (aer_mass) :: aerosol at time t -! -! Method: -! first determine which indexs of aerosols are the bounding data sets -! interpolate both onto vertical grid aerm(),aerp(). -! from those two, interpolate in time. -! -!------------------------------------------------------------------ - - use interpolate_data, only: get_timeinterp_factors - - use physics_buffer, only: physics_buffer_desc, dtype_r8, pbuf_set_field, pbuf_get_chunk - use cam_logfile, only: iulog - use ppgrid, only: begchunk,endchunk - use physconst, only: gravit - -! -! aerosol fields interpolated to current time step -! on pressure levels of this time step. -! these should be made read-only for other modules -! Is allocation done correctly here? -! - - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - type(physics_state), intent(in), dimension(begchunk:endchunk) :: phys_state - -! -! Local workspace -! - type(physics_buffer_desc), pointer :: phys_buffer_chunk(:) - real(r8) :: pint(pcols,pverp) ! interface pres. - integer :: c ! chunk index - real(r8) caldayloc ! calendar day of current timestep - real(r8) fact1, fact2 ! time interpolation factors - - integer i, k, j ! spatial indices - integer m ! constituent index - integer lats(pcols),lons(pcols) ! latitude and longitudes of column - integer ncol ! number of columns - integer lchnk ! chunk index - - real(r8) speciesmin(naer) ! minimal value for each species -! -! values before current time step "the minus month" -! aerosolm(pcols,pver) is value of preceeding month's aerosol masses -! aerosolp(pcols,pver) is value of next month's aerosol masses -! (think minus and plus or values to left and right of point to be interpolated) -! - real(r8) aerosolm(pcols,pver,naer,begchunk:endchunk) ! aerosol mass from MATCH in column,level at previous (minus) month -! -! values beyond (or at) current time step "the plus month" -! - real(r8) aerosolp(pcols,pver,naer,begchunk:endchunk) ! aerosol mass from MATCH in column,level at next (plus) month - real(r8) :: mass_to_mmr(pcols,pver) - - character(len=*), parameter :: subname = 'cam3_aero_data_timestep_init' - - logical error_found - !------------------------------------------------------------------ - - call aerint(phys_state) - - caldayloc = get_curr_calday () - - ! Determine time interpolation factors. 1st arg says we are cycling 1 year of data - call get_timeinterp_factors (.true., mo_nxt, cdaym, cdayp, caldayloc, & - fact1, fact2, 'GET_AEROSOL:') - - ! interpolate (prv and nxt month) bounding datasets onto cam vertical grid. - ! compute mass mixing ratios on CAMS's pressure coordinate - ! for both the "minus" and "plus" months - ! - ! This loop over chunk could probably be removed by working with the whole - ! begchunk:endchunk group at once. It would require a slight generalization - ! in vert_interpolate. - do c = begchunk,endchunk - - lchnk = phys_state(c)%lchnk - pint = phys_state(c)%pint - ncol = get_ncols_p(c) - - call vert_interpolate (M_ps_cam_col(:,c,nm), pint, nm, aerosolm(:,:,:,c), ncol, c) - call vert_interpolate (M_ps_cam_col(:,c,np), pint, np, aerosolp(:,:,:,c), ncol, c) - - ! Time interpolate. - do m=1,naer - do k=1,pver - do i=1,ncol - aer_mass(i,k,m,c) = aerosolm(i,k,m,c)*fact1 + aerosolp(i,k,m,c)*fact2 - end do - end do - ! Partition seasalt aerosol mass - if (m .eq. idxSSLTA) then - aer_mass(:ncol,:,m,c) = (1._r8-wgt_sscm)*aer_mass(:ncol,:,m,c) ! fraction of seasalt mass in accumulation mode - elseif (m .eq. idxSSLTC) then - aer_mass(:ncol,:,m,c) = wgt_sscm*aer_mass(:ncol,:,m,c) ! fraction of seasalt mass in coarse mode - endif - end do - - ! exit if mass is negative (we have previously set - ! cumulative mass to be a decreasing function.) - speciesmin(:) = 0._r8 ! speciesmin(m) = 0 is minimum mass for each species - - error_found = .false. - do m=1,naer - do k=1,pver - do i=1,ncol - if (aer_mass(i, k, m,c) < speciesmin(m)) error_found = .true. - end do - end do - end do - if (error_found) then - do m=1,naer - do k=1,pver - do i=1,ncol - if (aer_mass(i, k, m,c) < speciesmin(m)) then - write(iulog,*) subname//': negative mass mixing ratio, exiting' - write(iulog,*) 'm, column, pver',m, i, k ,aer_mass(i, k, m,c) - call endrun () - end if - end do - end do - end do - end if - do k = 1, pver - mass_to_mmr(1:ncol,k) = gravit/(pint(1:ncol,k+1)-pint(1:ncol,k)) - enddo - - phys_buffer_chunk => pbuf_get_chunk(pbuf2d, lchnk) - - call pbuf_set_field(phys_buffer_chunk, cam3_sul_idx, aer_mass(1:ncol,:, idxSUL,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_ssam_idx, aer_mass(1:ncol,:, idxSSLTA,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_sscm_idx, aer_mass(1:ncol,:, idxSSLTC,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_dust1_idx, aer_mass(1:ncol,:, idxDUSTfirst,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_dust2_idx, aer_mass(1:ncol,:,idxDUSTfirst+1,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_dust3_idx, aer_mass(1:ncol,:,idxDUSTfirst+2,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_dust4_idx, aer_mass(1:ncol,:,idxDUSTfirst+3,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_ocpho_idx, aer_mass(1:ncol,:, idxOCPHO,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_bcpho_idx, aer_mass(1:ncol,:, idxBCPHO,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_ocphi_idx, aer_mass(1:ncol,:, idxOCPHI,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_bcphi_idx, aer_mass(1:ncol,:, idxBCPHI,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - - enddo ! c = begchunk:endchunk - -end subroutine cam3_aero_data_timestep_init - -!================================================================================================ - -subroutine vert_interpolate (Match_ps, pint, n, aerosol_mass, ncol, c) -!-------------------------------------------------------------------- -! Input: match surface pressure, cam interface pressure, -! month index, number of columns, chunk index -! -! Output: Aerosol mass mixing ratio (aerosol_mass) -! -! Method: -! interpolate column mass (cumulative) from match onto -! cam's vertical grid (pressure coordinate) -! convert back to mass mixing ratio -! -!-------------------------------------------------------------------- - - real(r8), intent(out) :: aerosol_mass(pcols,pver,naer) ! aerosol mass from MATCH - real(r8), intent(in) :: Match_ps(pcols) ! surface pressure at a particular month - real(r8), intent(in) :: pint(pcols,pverp) ! interface pressure from CAM - - integer, intent(in) :: ncol,c ! chunk index and number of columns - integer, intent(in) :: n ! prv or nxt month index -! -! Local workspace -! - integer m ! index to aerosol species - integer kupper(pcols) ! last upper bound for interpolation - integer i, k, kk, kkstart, kount ! loop vars for interpolation - integer isv, ksv, msv ! loop indices to save - - logical bad ! indicates a bad point found - logical lev_interp_comp ! interpolation completed for a level - logical error_found - - real(r8) aerosol(pcols,pverp,naer) ! cumulative mass of aerosol in column beneath upper - ! interface of level in column at particular month - real(r8) dpl, dpu ! lower and upper intepolation factors - real(r8) v_coord ! vertical coordinate - real(r8) AER_diff ! temp var for difference between aerosol masses - - character(len=*), parameter :: subname = 'cam3_aero_data.vert_interpolate' - !----------------------------------------------------------------------- - - call t_startf ('vert_interpolate') -! -! Initialize index array -! - do i=1,ncol - kupper(i) = 1 - end do -! -! assign total mass to topmost level -! - aerosol(:,1,:) = aerosolc(:,1,c,:,n) -! -! At every pressure level, interpolate onto that pressure level -! - do k=2,pver -! -! Top level we need to start looking is the top level for the previous k -! for all longitude points -! - kkstart = paerlev+1 - do i=1,ncol - kkstart = min0(kkstart,kupper(i)) - end do - kount = 0 -! -! Store level indices for interpolation -! -! for the pressure interpolation should be comparing -! pint(column,lev) with M_hybi(lev)*M_ps_cam_col(month,column,chunk) -! - lev_interp_comp = .false. - do kk=kkstart,paerlev - if(.not.lev_interp_comp) then - do i=1,ncol - v_coord = pint(i,k) - if (M_hybi(kk)*Match_ps(i) .lt. v_coord .and. v_coord .le. M_hybi(kk+1)*Match_ps(i)) then - kupper(i) = kk - kount = kount + 1 - end if - end do -! -! If all indices for this level have been found, do the interpolation and -! go to the next level -! -! Interpolate in pressure. -! - if (kount.eq.ncol) then - do m=1,naer - do i=1,ncol - dpu = pint(i,k) - M_hybi(kupper(i))*Match_ps(i) - dpl = M_hybi(kupper(i)+1)*Match_ps(i) - pint(i,k) - aerosol(i,k,m) = & - (aerosolc(i,kupper(i) ,c,m,n)*dpl + & - aerosolc(i,kupper(i)+1,c,m,n)*dpu)/(dpl + dpu) - enddo !i - end do - lev_interp_comp = .true. - end if - end if - end do -! -! If we've fallen through the kk=1,levsiz-1 loop, we cannot interpolate and -! must extrapolate from the bottom or top pressure level for at least some -! of the longitude points. -! - - if(.not.lev_interp_comp) then - do m=1,naer - do i=1,ncol - if (pint(i,k) .lt. M_hybi(1)*Match_ps(i)) then - aerosol(i,k,m) = aerosolc(i,1,c,m,n) - else if (pint(i,k) .gt. M_hybi(paerlev+1)*Match_ps(i)) then - aerosol(i,k,m) = 0.0_r8 - else - dpu = pint(i,k) - M_hybi(kupper(i))*Match_ps(i) - dpl = M_hybi(kupper(i)+1)*Match_ps(i) - pint(i,k) - aerosol(i,k,m) = & - (aerosolc(i,kupper(i) ,c,m,n)*dpl + & - aerosolc(i,kupper(i)+1,c,m,n)*dpu)/(dpl + dpu) - end if - end do - end do - - if (kount.gt.ncol) then - call endrun (subname//': Bad data: non-monotonicity suspected in dependent variable') - end if - end if - end do - -! call t_startf ('vi_checks') -! -! aerosol mass beneath lowest interface (pverp) must be 0 -! - aerosol(1:ncol,pverp,:) = 0._r8 -! -! Set mass in layer to zero whenever it is less than -! 1.e-40 kg/m^2 in the layer -! - do m = 1, naer - do k = 1, pver - do i = 1, ncol - if (aerosol(i,k,m) < 1.e-40_r8) aerosol(i,k,m) = 0._r8 - end do - end do - end do -! -! Set mass in layer to zero whenever it is less than -! 10^-15 relative to column total mass -! - error_found = .false. - do m = 1, naer - do k = 1, pver - do i = 1, ncol - AER_diff = aerosol(i,k,m) - aerosol(i,k+1,m) - if( abs(AER_diff) < 1e-15_r8*aerosol(i,1,m)) then - AER_diff = 0._r8 - end if - aerosol_mass(i,k,m)= AER_diff - if (aerosol_mass(i,k,m) < 0) error_found = .true. - end do - end do - end do - if (error_found) then - do m = 1, naer - do k = 1, pver - do i = 1, ncol - if (aerosol_mass(i,k,m) < 0) then - write(iulog,*) subname//': mass < 0, m, col, lev, mass',m, i, k, aerosol_mass(i,k,m) - write(iulog,*) subname//': aerosol(k),(k+1)',aerosol(i,k,m),aerosol(i,k+1,m) - write(iulog,*) subname//': pint(k+1),(k)',pint(i,k+1),pint(i,k) - write(iulog,*)'n,c',n,c - call endrun() - end if - end do - end do - end do - end if - - call t_stopf ('vert_interpolate') - - return -end subroutine vert_interpolate - -!================================================================================================ - -subroutine aerint (phys_state) - - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - - integer :: ntmp ! used in index swapping - integer :: start(4) ! start vector for netcdf calls - integer :: kount(4) ! count vector for netcdf calls - integer :: i,j,k ! spatial indices - integer :: m ! constituent index - integer :: cols, cole - integer :: lchnk, ncol - real(r8) :: caldayloc ! calendar day of current timestep - real(r8) :: aerosol_data(naerlon,naerlat,paerlev) ! aerosol field read in from dataset - real(r8) :: aerosol_field(naerlon,paerlev+1,naerlat) ! aerosol field to be scattered - integer latidx,lonidx - real(r8) closelat,closelon - - character(len=*), parameter :: subname = 'cam3_aero_data.aerint' - !----------------------------------------------------------------------- - - if (single_column) & - call shr_scam_GetCloseLatLon(aernid,scmlat,scmlon,closelat,closelon,latidx,lonidx) - -! -! determine if need to read in next month data -! also determine time interpolation factors -! - caldayloc = get_curr_calday () -! -! If model time is past current forward timeslice, then -! masterproc reads in the next timeslice for time interpolation. Messy logic is -! for interpolation between December and January (mo_nxt == 1). Just like -! ozone_data_timestep_init, sstint. -! - if (caldayloc > cdayp .and. .not. (mo_nxt == 1 .and. caldayloc >= cdaym)) then - mo_nxt = mod(mo_nxt,12) + 1 - cdaym = cdayp - cdayp = Mid(mo_nxt) -! -! Check for valid date info -! - if (.not. (mo_nxt == 1 .or. caldayloc <= cdayp)) then - call endrun (subname//': Non-monotonicity suspected in input aerosol data') - end if - - ntmp = nm - nm = np - np = ntmp - - if(aerosol_datan%isncol) then - do lchnk=begchunk,endchunk - ncol=phys_state(lchnk)%ncol - cols=1 - cole=cols+aerosol_datan%count(cols,lchnk)-1 - do while(cole<=ncol) - start=(/aerosol_datan%start(cols,lchnk),mo_nxt,1,-1/) - kount=(/aerosol_datan%count(cols,lchnk),1,-1,-1/) - call handle_ncerr( nf90_get_var(aerosol_datan%ncid, aerosol_datan%psid , & - aerosol_datan%ps(cols:cole,lchnk,np), start(1:2), & - kount(1:2)),& - subname, __LINE__) - start(2)=1 - start(3)=mo_nxt - kount(2)=paerlev - kount(3)=1 - do m=1,naer - call handle_ncerr( nf90_get_var(aerosol_datan%ncid, aerosol_datan%dataid(m) , & - aerosol_datan%fields(cols:cole,:,lchnk,m,np), & - start(1:3), kount(1:3)),& - subname, __LINE__) - - end do - if(cols==ncol) exit - cols=cols+aerosol_datan%count(cols,lchnk) - cole=cols+aerosol_datan%count(cols,lchnk)-1 - end do - end do - aerosolc(:,1:paerlev,:,:,np)=aerosol_datan%fields(:,:,:,:,np) - else - do m=1,naer - if (masterproc) then - if (single_column) then - naerlon=1 - naerlat=1 - start(:) = (/lonidx,latidx,1,mo_nxt/) - else - start(:) = (/1,1,1,mo_nxt/) - endif - kount(:) = (/naerlon,naerlat,paerlev,1/) - call handle_ncerr( nf90_get_var (aernid, species_id(m), aerosol_data, start, kount),& - subname, __LINE__) - - do j=1,naerlat - do k=1,paerlev - aerosol_field(:,k,j) = aerosol_data(:,j,k) - end do - aerosol_field(:,paerlev+1,j) = 0._r8 ! value at bottom - end do - end if - call scatter_field_to_chunk (1, paerlev+1, 1, naerlon, aerosol_field, & - aerosolc(:,:,:,m,np)) - end do -! -! Retrieve PS from Match -! - if (masterproc) then - if (single_column) then - naerlon=1 - naerlat=1 - start(:) = (/lonidx,latidx,mo_nxt,-1/) - else - start(:) = (/1,1,mo_nxt,-1/) - endif - kount(:) = (/naerlon,naerlat,1,-1/) - call handle_ncerr( nf90_get_var (aernid, Mpsid, M_ps, start, kount),& - subname, __LINE__) - write(iulog,*) subname//': Read aerosols data for julian day', Mid(mo_nxt) - end if - call scatter_field_to_chunk (1, 1, 1, naerlon, M_ps(:,:), M_ps_cam_col(:,:,np)) - end if - end if - -end subroutine aerint - -end module cam3_aero_data diff --git a/src/physics/cam/cam3_ozone_data.F90 b/src/physics/cam/cam3_ozone_data.F90 deleted file mode 100644 index 567679fb0d..0000000000 --- a/src/physics/cam/cam3_ozone_data.F90 +++ /dev/null @@ -1,220 +0,0 @@ -module cam3_ozone_data - -!----------------------------------------------------------------------- -! Purpose: -! -! Interpolates zonal ozone datasets used by CAM3 and puts the field 'O3' into -! the physics buffer. -! -! Revision history: -! 2004-07-31 B. Eaton Assemble module from comozp.F90, oznini.F90, oznint.F90, radozn.F90 -! 2004-08-19 B. Eaton Modify ozone_data_vert_interp to return mass mixing ratio. -! 2004-08-30 B. Eaton Add ozone_data_get_cnst method. -! 2008 June B. Eaton Change name to cam3_ozone_data to support backwards compatibility -! for reading the CAM3 ozone data. Add *_readnl method so module -! reads its own namelist. Add cam3_ozone_data_on variable to -! turn the module on from the namelist. By default it's off. -!----------------------------------------------------------------------- - -use shr_kind_mod, only: r8 => shr_kind_r8 -use spmd_utils, only: masterproc -use ppgrid, only: begchunk, endchunk, pcols, pver -use cam_abortutils, only: endrun -use cam_logfile, only: iulog -use physics_types, only: physics_state -use boundarydata, only: boundarydata_type, boundarydata_init, boundarydata_update, & - boundarydata_vert_interp -use mpishorthand - -implicit none -private -save - -! Public methods -public ::& - cam3_ozone_data_readnl, &! get namelist input - cam3_ozone_data_register, &! register ozone with physics buffer - cam3_ozone_data_init, &! open dataset and spatially interpolate data bounding initial time - cam3_ozone_data_timestep_init ! interpolate to current time - -! Namelist variables -logical, public :: cam3_ozone_data_on = .false. ! switch to turn module on/off -logical :: ozncyc = .true. ! .true. => assume annual cycle ozone data -character(len=256) :: bndtvo = ' ' ! full pathname for time-variant ozone dataset - -! Local -integer :: oz_idx ! index into phys_buffer for ozone - -type(boundarydata_type) :: ozonedata -character(len=6), parameter, dimension(1) :: nc_name = (/'OZONE '/) ! constituent names - -!================================================================================================ -contains -!================================================================================================ - -subroutine cam3_ozone_data_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'cam3_ozone_data_readnl' - - namelist /cam3_ozone_data_nl/ cam3_ozone_data_on, bndtvo, ozncyc - !----------------------------------------------------------------------------- - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'cam3_ozone_data_nl', status=ierr) - if (ierr == 0) then - read(unitn, cam3_ozone_data_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - -#ifdef SPMD - ! Broadcast namelist variables - call mpibcast(cam3_ozone_data_on, 1, mpilog, 0, mpicom) - call mpibcast(bndtvo, len(bndtvo), mpichar, 0, mpicom) - call mpibcast(ozncyc, 1, mpilog, 0, mpicom) -#endif - -end subroutine cam3_ozone_data_readnl - -!================================================================================================ - -subroutine cam3_ozone_data_register() - use physics_buffer, only : pbuf_add_field, dtype_r8 - - call pbuf_add_field('O3','physpkg',dtype_r8,(/pcols,pver/),oz_idx) - -end subroutine cam3_ozone_data_register - -!================================================================================================ - -subroutine cam3_ozone_data_init(phys_state) -!----------------------------------------------------------------------- -! -! Purpose: Do initial read of time-variant ozone boundary dataset, containing -! ozone mixing ratios as a function of latitude and pressure. Read two -! consecutive months between which the current date lies. Routine -! RADOZ2 then evaluates the two path length integrals (with and without -! pressure weighting) from zero to the interfaces between the input -! levels. It also stores the contribution to the integral from each -! layer. -! -! Method: Call appropriate netcdf wrapper routines and interpolate to model grid -! -! Author: CCM Core Group -! Modified: P. Worley, August 2003, for chunking and performance optimization -! J. Edwards, Dec 2005, functionality now performed by zonalbndrydata -!----------------------------------------------------------------------- - - use cam_history, only: addfld - - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - !----------------------------------------------------------------------- - - call addfld ('O3VMR', (/ 'lev' /), 'A', 'm3/m3', 'Ozone volume mixing ratio', sampling_seq='rad_lwsw') - - - ! Initialize for one field (arg_4=1) and do not vertically interpolate (arg_6=3) - call boundarydata_init(bndtvo, phys_state, nc_name, 1, ozonedata, 3) - - if (masterproc) then - write(iulog,*)'cam3_ozone_data_init: Initializing CAM3 prescribed ozone' - write(iulog,*)'Time-variant boundary dataset (ozone) is: ', trim(bndtvo) - if (ozncyc) then - write(iulog,*)'OZONE dataset will be reused for each model year' - else - write(iulog,*)'OZONE dataset will not be cycled' - end if - end if - -end subroutine cam3_ozone_data_init - -!================================================================================================ - -subroutine cam3_ozone_data_timestep_init(pbuf2d, phys_state) -!----------------------------------------------------------------------- -! -! Purpose: Interpolate ozone mixing ratios to current time, reading in new monthly -! data if necessary, and spatially interpolating it. -! -! Method: Find next month of ozone data to interpolate. Linearly interpolate -! vertically and horizontally -! -!----------------------------------------------------------------------- - - - use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk - - - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - real(r8),pointer :: tmpptr(:,:) - - integer lchnk - - call boundarydata_update(phys_state, ozonedata) - - do lchnk = begchunk, endchunk - call pbuf_get_field(pbuf_get_chunk(pbuf2d, lchnk), oz_idx, tmpptr) - call ozone_data_get_cnst(phys_state(lchnk), tmpptr) - enddo - -end subroutine cam3_ozone_data_timestep_init - -!================================================================================================ - -subroutine ozone_data_get_cnst(state, q) - - use cam_history, only: outfld - use physconst, only: mwo3 - - type(physics_state), intent(in) :: state - real(r8) :: q(:,:) ! constituent mass mixing ratio - - ! local variables - integer :: lchnk ! chunk identifier - integer :: i, k - real(r8) :: ozmixin(pcols,ozonedata%levsiz) - ! *** N.B. this hardwired mw of dry air needs to be changed to the share value - real(r8), parameter :: mwdry = 28.9644_r8 ! Effective molecular weight of dry air (g/mol) - real(r8), parameter :: mwr = mwo3/mwdry ! convert from the dataset values of vmr to mmr - !------------------------------------------------------------------------------- - - lchnk = state%lchnk - - ozmixin=0._r8 - do k=1,ozonedata%levsiz - do i=1,state%ncol - ozmixin(i,k) = ozonedata%datainst(state%latmapback(i),k,lchnk,1) - end do - end do - call boundarydata_vert_interp(lchnk, state%ncol, ozonedata%levsiz, & - 1, ozonedata%pin, state%pmid, ozmixin , q) - - call outfld('O3VMR', q, pcols, lchnk) - - do k=1,pver - do i=1,state%ncol - q(i,k) = mwr*q(i,k) - end do - end do - -end subroutine ozone_data_get_cnst - -!================================================================================================ - -end module cam3_ozone_data - diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index a90d806284..5f7e7d9a60 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -12,12 +12,13 @@ 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, dmetendnam, apcnst, bpcnst, cnst_get_ind +use constituents, only: ptendnam, apcnst, bpcnst, cnst_get_ind use dycore, only: dycore_is use phys_control, only: phys_getopts -use wv_saturation, only: qsat, qsat_water, svp_ice +use wv_saturation, only: qsat, qsat_water, svp_ice_vect use time_manager, only: is_first_step use scamMod, only: single_column, wfld @@ -46,6 +47,18 @@ module cam_diagnostics diag_physvar_ic, & nsurf +integer, public, parameter :: num_stages = 8 +character (len = max_fieldname_len), dimension(num_stages) :: stage = (/"phBF","phBP","phAP","phAM","dyBF","dyBP","dyAP","dyAM"/) +character (len = 45),dimension(num_stages) :: stage_txt = (/& + " before energy fixer ",& !phBF - physics energy + " before parameterizations ",& !phBF - physics energy + " after parameterizations ",& !phAP - physics energy + " after dry mass correction ",& !phAM - physics energy + " before energy fixer (dycore) ",& !dyBF - dynamics energy + " before parameterizations (dycore) ",& !dyBF - dynamics energy + " after parameterizations (dycore) ",& !dyAP - dynamics energy + " after dry mass correction (dycore) " & !dyAM - dynamics energy + /) ! Private data @@ -78,18 +91,20 @@ module cam_diagnostics ! Physics buffer indices -integer :: psl_idx = 0 -integer :: relhum_idx = 0 -integer :: qcwat_idx = 0 -integer :: tcwat_idx = 0 -integer :: lcwat_idx = 0 -integer :: cld_idx = 0 -integer :: concld_idx = 0 -integer :: tke_idx = 0 -integer :: kvm_idx = 0 -integer :: kvh_idx = 0 -integer :: cush_idx = 0 +integer :: psl_idx = 0 +integer :: relhum_idx = 0 +integer :: qcwat_idx = 0 +integer :: tcwat_idx = 0 +integer :: lcwat_idx = 0 +integer :: cld_idx = 0 +integer :: concld_idx = 0 +integer :: tke_idx = 0 +integer :: kvm_idx = 0 +integer :: kvh_idx = 0 +integer :: cush_idx = 0 integer :: t_ttend_idx = 0 +integer :: t_utend_idx = 0 +integer :: t_vtend_idx = 0 integer :: prec_dp_idx = 0 integer :: snow_dp_idx = 0 @@ -150,6 +165,8 @@ subroutine diag_register_dry() ! Request physics buffer space for fields that persist across timesteps. call pbuf_add_field('T_TTEND', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), t_ttend_idx) + call pbuf_add_field('T_UTEND', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), t_utend_idx) + call pbuf_add_field('T_VTEND', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), t_vtend_idx) end subroutine diag_register_dry subroutine diag_register_moist() @@ -166,21 +183,18 @@ subroutine diag_register() end subroutine diag_register !============================================================================== - + subroutine diag_init_dry(pbuf2d) ! Declare the history fields for which this module contains outfld calls. use cam_history, only: addfld, add_default, horiz_only use cam_history, only: register_vector_field - use constituent_burden, only: constituent_burden_init - use physics_buffer, only: pbuf_set_field use tidal_diag, only: tidal_diag_init + use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_register, thermo_budget_history type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) - integer :: k, m - integer :: ierr - + integer :: istage ! outfld calls in diag_phys_writeout call addfld (cnst_name(1), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(1)) call addfld ('NSTEP', horiz_only, 'A', 'timestep', 'Model timestep') @@ -195,6 +209,9 @@ subroutine diag_init_dry(pbuf2d) ! State before physics call addfld ('TBP', (/ 'lev' /), 'A','K', 'Temperature (before physics)') + call addfld ('UBP', (/ 'lev' /), 'A','m/s', 'Zonal wind (before physics)') + call addfld ('VBP', (/ 'lev' /), 'A','m/s', 'Meridional Wind (before physics)') + call register_vector_field('UBP','VBP') call addfld (bpcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (before physics)') ! State after physics call addfld ('TAP', (/ 'lev' /), 'A','K', 'Temperature (after physics)' ) @@ -204,15 +221,18 @@ 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 ( dycore_is('LR') .or. dycore_is('SE') .or. dycore_is('FV3') ) then - call addfld ('TFIX', horiz_only, 'A', 'K/s', 'T fixer (T equivalent of Energy correction)') - end if + call addfld ('TFIX', horiz_only, 'A', 'K/s', 'T fixer (T equivalent of Energy correction)') call addfld ('TTEND_TOT', (/ 'lev' /), 'A', 'K/s', 'Total temperature tendency') - + + ! outfld calls in diag_phys_tend_writeout + call addfld ('UTEND_TOT', (/ 'lev' /), 'A', 'm/s2', 'Total zonal wind tendency') + call addfld ('VTEND_TOT', (/ 'lev' /), 'A', 'm/s2', 'Total meridional wind tendency') + call register_vector_field('UTEND_TOT','VTEND_TOT') + ! Debugging negative water output fields - call addfld ('INEGCLPTEND ', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice tendency due to clipping neg values after microp') - call addfld ('LNEGCLPTEND ', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud liq tendency due to clipping neg values after microp') - call addfld ('VNEGCLPTEND ', (/ 'lev' /), 'A', 'kg/kg/s', 'Vapor tendency due to clipping neg values after microp') + call addfld ('INEGCLPTEND ', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice tendency due to clipping neg values after microp', sampled_on_subcycle=.true.) + call addfld ('LNEGCLPTEND ', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud liq tendency due to clipping neg values after microp', sampled_on_subcycle=.true.) + call addfld ('VNEGCLPTEND ', (/ 'lev' /), 'A', 'kg/kg/s', 'Vapor tendency due to clipping neg values after microp', sampled_on_subcycle=.true.) call addfld ('Z3', (/ 'lev' /), 'A', 'm', 'Geopotential Height (above sea level)') call addfld ('Z1000', horiz_only, 'A', 'm', 'Geopotential Z at 1000 mbar pressure surface') @@ -231,10 +251,11 @@ subroutine diag_init_dry(pbuf2d) call addfld ('OMEGAV', (/ 'lev' /), 'A', 'm Pa/s2 ', 'Vertical flux of meridional momentum' ) call addfld ('OMGAOMGA', (/ 'lev' /), 'A', 'Pa2/s2', 'Vertical flux of vertical momentum' ) + call addfld ('UT', (/ 'lev' /), 'A', 'K m/s ', 'Zonal heat transport') call addfld ('UU', (/ 'lev' /), 'A', 'm2/s2', 'Zonal velocity squared' ) call addfld ('WSPEED', (/ 'lev' /), 'X', 'm/s', 'Horizontal total wind speed maximum' ) - call addfld ('WSPDSRFMX', horiz_only, 'X', 'm/s', 'Horizontal total wind speed maximum at the surface' ) - call addfld ('WSPDSRFAV', horiz_only, 'A', 'm/s', 'Horizontal total wind speed average at the surface' ) + call addfld ('WSPDSRFMX', horiz_only, 'X', 'm/s', 'Horizontal total wind speed maximum at surface layer midpoint' ) + call addfld ('WSPDSRFAV', horiz_only, 'A', 'm/s', 'Horizontal total wind speed average at surface layer midpoint' ) call addfld ('OMEGA', (/ 'lev' /), 'A', 'Pa/s', 'Vertical velocity (pressure)') call addfld ('OMEGAT', (/ 'lev' /), 'A', 'K Pa/s ', 'Vertical heat flux' ) @@ -317,6 +338,7 @@ subroutine diag_init_dry(pbuf2d) call add_default ('VT ', 1, ' ') call add_default ('VU ', 1, ' ') call add_default ('VV ', 1, ' ') + call add_default ('UT ', 1, ' ') call add_default ('UU ', 1, ' ') call add_default ('OMEGAT ', 1, ' ') call add_default ('OMEGAU ', 1, ' ') @@ -330,18 +352,20 @@ subroutine diag_init_dry(pbuf2d) call add_default ('U ' , history_budget_histfile_num, ' ') call add_default ('V ' , history_budget_histfile_num, ' ') call add_default ('TTEND_TOT' , history_budget_histfile_num, ' ') + call add_default ('UTEND_TOT' , history_budget_histfile_num, ' ') + call add_default ('VTEND_TOT' , history_budget_histfile_num, ' ') ! State before physics (FV) call add_default ('TBP ' , history_budget_histfile_num, ' ') + call add_default ('UBP ' , history_budget_histfile_num, ' ') + call add_default ('VBP ' , history_budget_histfile_num, ' ') call add_default (bpcnst(1) , history_budget_histfile_num, ' ') ! State after physics (FV) call add_default ('TAP ' , history_budget_histfile_num, ' ') call add_default ('UAP ' , history_budget_histfile_num, ' ') - call add_default ('VAP ' , history_budget_histfile_num, ' ') + call add_default ('VAP ' , history_budget_histfile_num, ' ') call add_default (apcnst(1) , history_budget_histfile_num, ' ') - if ( dycore_is('LR') .or. dycore_is('SE') .or. dycore_is('FV3') ) then - call add_default ('TFIX ' , history_budget_histfile_num, ' ') - end if + call add_default ('TFIX ' , history_budget_histfile_num, ' ') end if if (history_waccm) then @@ -351,68 +375,44 @@ subroutine diag_init_dry(pbuf2d) end if ! outfld calls in diag_phys_tend_writeout - call addfld ('PTTEND', (/ 'lev' /), 'A', 'K/s','T total physics tendency' ) + call addfld ('PTTEND', (/ 'lev' /), 'A', 'K/s','T total physics tendency') + call addfld ('UTEND_PHYSTOT', (/ 'lev' /), 'A', 'm/s2','U total physics tendency') + call addfld ('VTEND_PHYSTOT', (/ 'lev' /), 'A', 'm/s2','V total physics tendency') + call register_vector_field('UTEND_PHYSTOT','VTEND_PHYSTOT') if ( history_budget ) then call add_default ('PTTEND' , history_budget_histfile_num, ' ') + call add_default ('UTEND_PHYSTOT' , history_budget_histfile_num, ' ') + call add_default ('VTEND_PHYSTOT' , history_budget_histfile_num, ' ') end if ! create history variables for fourier coefficients of the diurnal ! and semidiurnal tide in T, U, V, and Z3 call tidal_diag_init() - ! - ! energy diagnostics - ! - call addfld ('SE_pBF', horiz_only, 'A', 'J/m2','Dry Static Energy before energy fixer') - call addfld ('SE_pBP', horiz_only, 'A', 'J/m2','Dry Static Energy before parameterizations') - call addfld ('SE_pAP', horiz_only, 'A', 'J/m2','Dry Static Energy after parameterizations') - call addfld ('SE_pAM', horiz_only, 'A', 'J/m2','Dry Static Energy after dry mass correction') - - call addfld ('KE_pBF', horiz_only, 'A', 'J/m2','Kinetic Energy before energy fixer') - call addfld ('KE_pBP', horiz_only, 'A', 'J/m2','Kinetic Energy before parameterizations') - call addfld ('KE_pAP', horiz_only, 'A', 'J/m2','Kinetic Energy after parameterizations') - call addfld ('KE_pAM', horiz_only, 'A', 'J/m2','Kinetic Energy after dry mass correction') - - call addfld ('TT_pBF', horiz_only, 'A', 'kg/m2','Total column test tracer before energy fixer') - call addfld ('TT_pBP', horiz_only, 'A', 'kg/m2','Total column test tracer before parameterizations') - call addfld ('TT_pAP', horiz_only, 'A', 'kg/m2','Total column test tracer after parameterizations') - call addfld ('TT_pAM', horiz_only, 'A', 'kg/m2','Total column test tracer after dry mass correction') - - call addfld ('WV_pBF', horiz_only, 'A', 'kg/m2','Total column water vapor before energy fixer') - call addfld ('WV_pBP', horiz_only, 'A', 'kg/m2','Total column water vapor before parameterizations') - call addfld ('WV_pAP', horiz_only, 'A', 'kg/m2','Total column water vapor after parameterizations') - call addfld ('WV_pAM', horiz_only, 'A', 'kg/m2','Total column water vapor after dry mass correction') - - call addfld ('WL_pBF', horiz_only, 'A', 'kg/m2','Total column cloud water before energy fixer') - call addfld ('WL_pBP', horiz_only, 'A', 'kg/m2','Total column cloud water before parameterizations') - call addfld ('WL_pAP', horiz_only, 'A', 'kg/m2','Total column cloud water after parameterizations') - call addfld ('WL_pAM', horiz_only, 'A', 'kg/m2','Total column cloud water after dry mass correction') - - call addfld ('WI_pBF', horiz_only, 'A', 'kg/m2','Total column cloud ice before energy fixer') - call addfld ('WI_pBP', horiz_only, 'A', 'kg/m2','Total column cloud ice before parameterizations') - call addfld ('WI_pAP', horiz_only, 'A', 'kg/m2','Total column cloud ice after parameterizations') - call addfld ('WI_pAM', horiz_only, 'A', 'kg/m2','Total column cloud ice after dry mass correction') - ! - ! Axial Angular Momentum diagnostics - ! - call addfld ('MR_pBF', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column wind axial angular momentum before energy fixer') - call addfld ('MR_pBP', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column wind axial angular momentum before parameterizations') - call addfld ('MR_pAP', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column wind axial angular momentum after parameterizations') - call addfld ('MR_pAM', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column wind axial angular momentum after dry mass correction') - - call addfld ('MO_pBF', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column mass axial angular momentum before energy fixer') - call addfld ('MO_pBP', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column mass axial angular momentum before parameterizations') - call addfld ('MO_pAP', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column mass axial angular momentum after parameterizations') - call addfld ('MO_pAM', horiz_only, 'A', 'kg*m2/s*rad2',& - 'Total column mass axial angular momentum after dry mass correction') - + call addfld( 'CPAIRV', (/ 'lev' /), 'I', 'J/K/kg', 'Variable specific heat cap air' ) + call addfld( 'RAIRV', (/ 'lev' /), 'I', 'J/K/kg', 'Variable dry air gas constant' ) + + if (thermo_budget_history) then + ! + ! energy diagnostics addflds for vars_stage combinations plus e_m_snapshots + ! + do istage = 1, num_stages + call cam_budget_em_snapshot(TRIM(ADJUSTL(stage(istage))),'phy',longname=TRIM(ADJUSTL(stage_txt(istage)))) + end do + + ! Create budgets that are a sum/dif of 2 stages + + call cam_budget_em_register('dEdt_param_efix_physE','phAP','phBF','phy','dif',longname='dE/dt CAM physics + energy fixer using physics E formula (phAP-phBF)') + call cam_budget_em_register('dEdt_param_efix_dynE' ,'dyAP','dyBF','phy','dif',longname='dE/dt CAM physics + energy fixer using dycore E formula (dyAP-dyBF)') + call cam_budget_em_register('dEdt_param_physE' ,'phAP','phBP','phy','dif',longname='dE/dt CAM physics using physics E formula (phAP-phBP)') + call cam_budget_em_register('dEdt_param_dynE' ,'dyAP','dyBP','phy','dif',longname='dE/dt CAM physics using dycore E (dyAP-dyBP)') + call cam_budget_em_register('dEdt_dme_adjust_physE','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment using physics E formula (phAM-phAP)') + call cam_budget_em_register('dEdt_dme_adjust_dynE' ,'dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') + call cam_budget_em_register('dEdt_efix_physE' ,'phBP','phBF','phy','dif',longname='dE/dt energy fixer using physics E formula (phBP-phBF)') + call cam_budget_em_register('dEdt_efix_dynE' ,'dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E formula (dyBP-dyBF)') + call cam_budget_em_register('dEdt_phys_tot_physE' ,'phAM','phBF','phy','dif',longname='dE/dt physics total using physics E formula (phAM-phBF)') + call cam_budget_em_register('dEdt_phys_tot_dynE' ,'dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)') + endif end subroutine diag_init_dry subroutine diag_init_moist(pbuf2d) @@ -425,7 +425,7 @@ subroutine diag_init_moist(pbuf2d) type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) - integer :: k, m + integer :: m integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. integer :: ierr ! column burdens for all constituents except water vapor @@ -436,6 +436,7 @@ subroutine diag_init_moist(pbuf2d) ! outfld calls in diag_phys_writeout call addfld ('OMEGAQ', (/ 'lev' /), 'A', 'kgPa/kgs', 'Vertical water transport' ) + call addfld ('UQ', (/ 'lev' /), 'A', 'm/skg/kg', 'Zonal water transport') call addfld ('VQ', (/ 'lev' /), 'A', 'm/skg/kg', 'Meridional water transport') call addfld ('QQ', (/ 'lev' /), 'A', 'kg2/kg2', 'Eddy moisture variance') @@ -446,18 +447,24 @@ subroutine diag_init_moist(pbuf2d) call addfld ('RHI', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to ice') call addfld ('RHCFMIP', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to water above 273 K, ice below 273 K') + call addfld ('IVT', horiz_only, 'A', 'kg/m/s','Total (vertically integrated) vapor transport') + call addfld ('uIVT', horiz_only, 'A', 'kg/m/s','u-component (vertically integrated) vapor transport') + call addfld ('vIVT', horiz_only, 'A', 'kg/m/s','v-component (vertically integrated) vapor transport') + call addfld ('THE8501000', horiz_only, 'A', 'K','ThetaE difference 850 mb - 1000 mb') call addfld ('THE9251000', horiz_only, 'A', 'K','ThetaE difference 925 mb - 1000 mb') call addfld ('Q1000', horiz_only, 'A', 'kg/kg','Specific Humidity at 1000 mbar pressure surface') call addfld ('Q925', horiz_only, 'A', 'kg/kg','Specific Humidity at 925 mbar pressure surface') call addfld ('Q850', horiz_only, 'A', 'kg/kg','Specific Humidity at 850 mbar pressure surface') - call addfld ('Q200', horiz_only, 'A', 'kg/kg','Specific Humidity at 700 mbar pressure surface') + call addfld ('Q200', horiz_only, 'A', 'kg/kg','Specific Humidity at 200 mbar pressure surface') call addfld ('QBOT', horiz_only, 'A', 'kg/kg','Lowest model level water vapor mixing ratio') call addfld ('PSDRY', horiz_only, 'A', 'Pa', 'Dry surface pressure') call addfld ('PMID', (/ 'lev' /), 'A', 'Pa', 'Pressure at layer midpoints') + call addfld ('PINT', (/ 'ilev' /), 'A', 'Pa', 'Pressure at layer interfaces') call addfld ('PDELDRY', (/ 'lev' /), 'A', 'Pa', 'Dry pressure difference between levels') + call addfld ('PDEL', (/ 'lev' /), 'A', 'Pa', 'Pressure difference between levels') ! outfld calls in diag_conv @@ -493,6 +500,8 @@ subroutine diag_init_moist(pbuf2d) call addfld ('TREFHTMX', horiz_only, 'X','K','Maximum reference height temperature over output period') call addfld ('QREFHT', horiz_only, 'A', 'kg/kg','Reference height humidity') call addfld ('U10', horiz_only, 'A', 'm/s','10m wind speed') + call addfld ('UGUST', horiz_only, 'A', 'm/s','Gustiness term added to U10') + call addfld ('U10WITHGUSTS',horiz_only, 'A', 'm/s','10m wind speed with gustiness added') call addfld ('RHREFHT', horiz_only, 'A', 'fraction','Reference height relative humidity') call addfld ('LANDFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by land') @@ -526,18 +535,6 @@ subroutine diag_init_moist(pbuf2d) if (ixcldice > 0) then call addfld (ptendnam(ixcldice),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(ixcldice))//' total physics tendency ') end if - if ( dycore_is('LR') .or. dycore_is('FV3') )then - call addfld (dmetendnam( 1),(/ 'lev' /), 'A','kg/kg/s', & - trim(cnst_name( 1))//' dme adjustment tendency (FV) ') - if (ixcldliq > 0) then - call addfld (dmetendnam(ixcldliq),(/ 'lev' /), 'A','kg/kg/s', & - trim(cnst_name(ixcldliq))//' dme adjustment tendency (FV) ') - end if - if (ixcldice > 0) then - call addfld (dmetendnam(ixcldice),(/ 'lev' /), 'A','kg/kg/s', & - trim(cnst_name(ixcldice))//' dme adjustment tendency (FV) ') - end if - end if ! outfld calls in diag_physvar_ic @@ -570,6 +567,9 @@ subroutine diag_init_moist(pbuf2d) call addfld('a2x_DSTWET4', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin4)') call addfld('a2x_DSTDRY4', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin4)') + call addfld('a2x_NOYDEP', horiz_only, 'A', 'kgN/m2/s', 'NOy Deposition Flux') + call addfld('a2x_NHXDEP', horiz_only, 'A', 'kgN/m2/s', 'NHx Deposition Flux') + ! defaults if (history_amwg) then call add_default (cnst_name(1), 1, ' ') @@ -606,13 +606,22 @@ subroutine diag_init_moist(pbuf2d) call add_default ('PMID', 1, ' ') end if + if (dycore_is('MPAS')) then + call add_default ('PINT', 1, ' ') + call add_default ('PMID', 1, ' ') + call add_default ('PDEL', 1, ' ') + end if + if (history_eddy) then + call add_default ('UQ ', 1, ' ') call add_default ('VQ ', 1, ' ') endif if ( history_budget ) then call add_default (cnst_name(1), history_budget_histfile_num, ' ') call add_default ('PTTEND' , history_budget_histfile_num, ' ') + call add_default ('UTEND_PHYSTOT' , history_budget_histfile_num, ' ') + call add_default ('VTEND_PHYSTOT' , history_budget_histfile_num, ' ') call add_default (ptendnam( 1), history_budget_histfile_num, ' ') if (ixcldliq > 0) then call add_default (ptendnam(ixcldliq), history_budget_histfile_num, ' ') @@ -620,15 +629,6 @@ subroutine diag_init_moist(pbuf2d) if (ixcldice > 0) then call add_default (ptendnam(ixcldice), history_budget_histfile_num, ' ') end if - if ( dycore_is('LR') .or. dycore_is('FV3') )then - call add_default(dmetendnam(1) , history_budget_histfile_num, ' ') - if (ixcldliq > 0) then - call add_default(dmetendnam(ixcldliq), history_budget_histfile_num, ' ') - end if - if (ixcldice > 0) then - call add_default(dmetendnam(ixcldice), history_budget_histfile_num, ' ') - end if - end if if( history_budget_histfile_num > 1 ) then call add_default ('DTCOND ' , history_budget_histfile_num, ' ') end if @@ -724,7 +724,6 @@ subroutine diag_init_moist(pbuf2d) end subroutine diag_init_moist subroutine diag_init(pbuf2d) - use cam_history, only: addfld ! Declare the history fields for which this module contains outfld calls. @@ -862,6 +861,8 @@ subroutine diag_conv_tend_ini(state,pbuf) integer :: i, k, m, lchnk, ncol real(r8), pointer, dimension(:,:) :: t_ttend + real(r8), pointer, dimension(:,:) :: t_utend + real(r8), pointer, dimension(:,:) :: t_vtend lchnk = state%lchnk ncol = state%ncol @@ -885,6 +886,10 @@ subroutine diag_conv_tend_ini(state,pbuf) do m = 1, dyn_time_lvls call pbuf_get_field(pbuf, t_ttend_idx, t_ttend, start=(/1,1,m/), kount=(/pcols,pver,1/)) t_ttend(:ncol,:) = state%t(:ncol,:) + call pbuf_get_field(pbuf, t_utend_idx, t_utend, start=(/1,1,m/), kount=(/pcols,pver,1/)) + t_utend(:ncol,:) = state%u(:ncol,:) + call pbuf_get_field(pbuf, t_vtend_idx, t_vtend, start=(/1,1,m/), kount=(/pcols,pver,1/)) + t_vtend(:ncol,:) = state%v(:ncol,:) end do end if @@ -899,13 +904,12 @@ subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t) ! Purpose: output dry physics diagnostics ! !----------------------------------------------------------------------- - use physconst, only: gravit, rga, rair, cpair, latvap, rearth, pi, cappa - use time_manager, only: get_nstep - use interpolate_data, only: vertinterp - use constituent_burden, only: constituent_burden_comp - use co2_cycle, only: c_i, co2_transport - - use tidal_diag, only: tidal_diag_write + use physconst, only: gravit, rga, rair, cappa + use time_manager, only: get_nstep + use interpolate_data, only: vertinterp + use tidal_diag, only: tidal_diag_write + use air_composition, only: cpairv, rairv + use cam_diagnostic_utils, only: cpslec !----------------------------------------------------------------------- ! ! Arguments @@ -917,15 +921,9 @@ subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t) !---------------------------Local workspace----------------------------- ! real(r8) :: ftem(pcols,pver) ! temporary workspace - real(r8) :: ftem1(pcols,pver) ! another temporary workspace - real(r8) :: ftem2(pcols,pver) ! another temporary workspace real(r8) :: z3(pcols,pver) ! geo-potential height real(r8) :: p_surf(pcols) ! data interpolated to a pressure surface - real(r8) :: tem2(pcols,pver) ! temporary workspace real(r8) :: timestep(pcols) ! used for outfld call - real(r8) :: esl(pcols,pver) ! saturation vapor pressures - real(r8) :: esi(pcols,pver) ! - real(r8) :: dlon(pcols) ! width of grid cell (meters) real(r8), pointer :: psl(:) ! Sea Level Pressure @@ -948,9 +946,10 @@ 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 ) do m = 1, pcnst if (cnst_cam_outfld(m)) then @@ -1021,6 +1020,9 @@ subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t) ! ! zonal advection ! + ftem(:ncol,:) = state%u(:ncol,:)*state%t(:ncol,:) + call outfld ('UT ',ftem ,pcols ,lchnk ) + ftem(:ncol,:) = state%u(:ncol,:)**2 call outfld ('UU ',ftem ,pcols ,lchnk ) @@ -1038,9 +1040,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 ) @@ -1236,8 +1236,7 @@ subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t) ! Purpose: record dynamics variables on physics grid ! !----------------------------------------------------------------------- - use physconst, only: gravit, rga, rair, cpair, latvap, rearth, pi, cappa, & - epsilo, rh2o + use physconst, only: gravit, rga, rair, cpair, latvap, rearth, cappa use interpolate_data, only: vertinterp use constituent_burden, only: constituent_burden_comp use co2_cycle, only: c_i, co2_transport @@ -1254,7 +1253,6 @@ subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t) real(r8) :: ftem(pcols,pver) ! temporary workspace real(r8) :: ftem1(pcols,pver) ! another temporary workspace real(r8) :: ftem2(pcols,pver) ! another temporary workspace - real(r8) :: z3(pcols,pver) ! geo-potential height real(r8) :: p_surf(pcols) ! data interpolated to a pressure surface real(r8) :: p_surf_q1(pcols) ! data interpolated to a pressure surface real(r8) :: p_surf_q2(pcols) ! data interpolated to a pressure surface @@ -1265,12 +1263,15 @@ subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t) real(r8), pointer :: ftem_ptr(:,:) integer :: i, k, m, lchnk, ncol + integer :: ixq, ierr ! !----------------------------------------------------------------------- ! lchnk = state%lchnk ncol = state%ncol + call cnst_get_ind('Q', ixq) + if (co2_transport()) then do m = 1,4 call outfld(trim(cnst_name(c_i(m)))//'_BOT', state%q(1,pver,c_i(m)), pcols, lchnk) @@ -1282,40 +1283,66 @@ subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t) call outfld('PSDRY', state%psdry, pcols, lchnk) call outfld('PMID', state%pmid, pcols, lchnk) + call outfld('PINT', state%pint, pcols, lchnk) call outfld('PDELDRY', state%pdeldry, pcols, lchnk) + call outfld('PDEL', state%pdel, pcols, lchnk) - ! - ! Meridional advection fields - ! - ftem(:ncol,:) = state%v(:ncol,:)*state%q(:ncol,:,1) + + ftem(:ncol,:) = state%u(:ncol,:)*state%q(:ncol,:,ixq) + call outfld ('UQ ',ftem ,pcols ,lchnk ) + + ftem(:ncol,:) = state%v(:ncol,:)*state%q(:ncol,:,ixq) call outfld ('VQ ',ftem ,pcols ,lchnk ) - ftem(:ncol,:) = state%q(:ncol,:,1)*state%q(:ncol,:,1) + ftem(:ncol,:) = state%q(:ncol,:,1)*state%q(:ncol,:,ixq) call outfld ('QQ ',ftem ,pcols ,lchnk ) ! Vertical velocity and advection - ftem(:ncol,:) = state%omega(:ncol,:)*state%q(:ncol,:,1) + ftem(:ncol,:) = state%omega(:ncol,:)*state%q(:ncol,:,ixq) call outfld('OMEGAQ ',ftem, pcols, lchnk ) ! ! Mass of q, by layer and vertically integrated ! - ftem(:ncol,:) = state%q(:ncol,:,1) * state%pdel(:ncol,:) * rga + ftem(:ncol,:) = state%q(:ncol,:,ixq) * state%pdel(:ncol,:) * rga call outfld ('MQ ',ftem ,pcols ,lchnk ) do k=2,pver ftem(:ncol,1) = ftem(:ncol,1) + ftem(:ncol,k) end do call outfld ('TMQ ',ftem, pcols ,lchnk ) + ! + ! Integrated vapor transport calculation + ! + !compute uq*dp/g and vq*dp/g + ftem1(:ncol,:) = state%q(:ncol,:,ixq) * state%u(:ncol,:) *state%pdel(:ncol,:) * rga + ftem2(:ncol,:) = state%q(:ncol,:,ixq) * state%v(:ncol,:) *state%pdel(:ncol,:) * rga + + do k=2,pver + ftem1(:ncol,1) = ftem1(:ncol,1) + ftem1(:ncol,k) + ftem2(:ncol,1) = ftem2(:ncol,1) + ftem2(:ncol,k) + end do + ! compute ivt + ftem(:ncol,1) = sqrt( ftem1(:ncol,1)**2 + ftem2(:ncol,1)**2) + + call outfld ('IVT ',ftem, pcols ,lchnk ) + ! output uq*dp/g + call outfld ('uIVT ',ftem1, pcols ,lchnk ) + + ! output vq*dp/g + call outfld ('vIVT ',ftem2, pcols ,lchnk ) + ! ! Relative humidity + ! if (hist_fld_active('RELHUM')) then if (relhum_idx > 0) then call pbuf_get_field(pbuf, relhum_idx, ftem_ptr) ftem(:ncol,:) = ftem_ptr(:ncol,:) else - call qsat(state%t(:ncol,:), state%pmid(:ncol,:), & - tem2(:ncol,:), ftem(:ncol,:)) - ftem(:ncol,:) = state%q(:ncol,:,1)/ftem(:ncol,:)*100._r8 + do k = 1, pver + call qsat(state%t(1:ncol,k), state%pmid(1:ncol,k), tem2(1:ncol,k), ftem(1:ncol,k), ncol) + end do + ftem(:ncol,:) = state%q(:ncol,:,ixq)/ftem(:ncol,:)*100._r8 end if call outfld ('RELHUM ',ftem ,pcols ,lchnk ) end if @@ -1323,17 +1350,18 @@ subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t) if (hist_fld_active('RHW') .or. hist_fld_active('RHI') .or. hist_fld_active('RHCFMIP') ) then ! RH w.r.t liquid (water) - call qsat_water (state%t(:ncol,:), state%pmid(:ncol,:), & - esl(:ncol,:), ftem(:ncol,:)) - ftem(:ncol,:) = state%q(:ncol,:,1)/ftem(:ncol,:)*100._r8 + do k = 1, pver + call qsat_water (state%t(1:ncol,k), state%pmid(1:ncol,k), esl(1:ncol,k), ftem(1:ncol,k), ncol) + end do + ftem(:ncol,:) = state%q(:ncol,:,ixq)/ftem(:ncol,:)*100._r8 call outfld ('RHW ',ftem ,pcols ,lchnk ) ! Convert to RHI (ice) - do i=1,ncol - do k=1,pver - esi(i,k)=svp_ice(state%t(i,k)) - ftem1(i,k)=ftem(i,k)*esl(i,k)/esi(i,k) - end do + do k=1,pver + call svp_ice_vect(state%t(1:ncol,k), esi(1:ncol,k), ncol) + do i=1,ncol + ftem1(i,k)=ftem(i,k)*esl(i,k)/esi(i,k) + end do end do call outfld ('RHI ',ftem1 ,pcols ,lchnk ) @@ -1358,17 +1386,17 @@ subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t) ! Output q field on pressure surfaces ! if (hist_fld_active('Q850')) then - call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%q(1,1,1), p_surf) + call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%q(1,1,ixq), p_surf) call outfld('Q850 ', p_surf, pcols, lchnk ) end if if (hist_fld_active('Q200')) then - call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%q(1,1,1), p_surf) + call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%q(1,1,ixq), p_surf) call outfld('Q200 ', p_surf, pcols, lchnk ) end if ! ! Output Q at bottom level ! - call outfld ('QBOT ', state%q(1,pver,1), pcols, lchnk) + call outfld ('QBOT ', state%q(1,pver,ixq), pcols, lchnk) ! Total energy of the atmospheric column for atmospheric heat storage calculations @@ -1379,13 +1407,13 @@ subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t) !! calculate sum of sensible, kinetic, latent, and surface geopotential energy !! E=CpT+PHIS+Lv*q+(0.5)*(u^2+v^2) - ftem(:ncol,:) = (cpair*state%t(:ncol,:) + ftem1(:ncol,:) + latvap*state%q(:ncol,:,1) + & + ftem(:ncol,:) = (cpair*state%t(:ncol,:) + ftem1(:ncol,:) + latvap*state%q(:ncol,:,ixq) + & 0.5_r8*(state%u(:ncol,:)**2+state%v(:ncol,:)**2))*(state%pdel(:ncol,:)/gravit) !! vertically integrate do k=2,pver ftem(:ncol,1) = ftem(:ncol,1) + ftem(:ncol,k) end do - call outfld ('ATMEINT ',ftem(:ncol,1) ,pcols ,lchnk ) + call outfld ('ATMEINT ', ftem(:ncol,1), ncol, lchnk) !! Boundary layer atmospheric stability, temperature, water vapor diagnostics @@ -1408,12 +1436,12 @@ subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t) hist_fld_active('THE9251000') .or. & hist_fld_active('THE8501000') .or. & hist_fld_active('THE7001000')) then - call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%q(1,1,1), p_surf_q1) + call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%q(1,1,ixq), p_surf_q1) end if if (hist_fld_active('THE9251000') .or. & hist_fld_active('Q925')) then - call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%q(1,1,1), p_surf_q2) + call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%q(1,1,ixq), p_surf_q2) end if !!! at 1000 mb and 925 mb @@ -1440,7 +1468,7 @@ subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t) !!! at 1000 mb and 850 mb if (hist_fld_active('THE8501000')) then - call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%q(1,1,1), p_surf_q2) + call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%q(1,1,ixq), p_surf_q2) p_surf = ((p_surf_t(:, surf_085000)*(1000.0_r8/850.0_r8)**cappa) * & exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_085000)))) - & (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000))) @@ -1455,7 +1483,7 @@ subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t) !!! at 1000 mb and 700 mb if (hist_fld_active('THE7001000')) then - call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%q(1,1,1), p_surf_q2) + call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%q(1,1,ixq), p_surf_q2) p_surf = ((p_surf_t(:, surf_070000)*(1000.0_r8/700.0_r8)**cappa) * & exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_070000)))) - & (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000))) @@ -1542,7 +1570,6 @@ subroutine diag_conv(state, ztodt, pbuf) ! Output diagnostics associated with all convective processes. ! !----------------------------------------------------------------------- - use physconst, only: cpair use tidal_diag, only: get_tidal_coeffs ! Arguments: @@ -1676,9 +1703,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. @@ -1764,21 +1789,25 @@ subroutine diag_surf (cam_in, cam_out, state, pbuf) call outfld('TREFHTMN', cam_in%tref, pcols, lchnk) call outfld('QREFHT', cam_in%qref, pcols, lchnk) call outfld('U10', cam_in%u10, pcols, lchnk) + call outfld('UGUST', cam_in%ugustOut, pcols, lchnk) + call outfld('U10WITHGUSTS',cam_in%u10withGusts, pcols, lchnk) + ! ! Calculate and output reference height RH (RHREFHT) - - call qsat(cam_in%tref(:ncol), state%ps(:ncol), tem2(:ncol), ftem(:ncol)) + call qsat(cam_in%tref(1:ncol), state%ps(1:ncol), tem2(1:ncol), ftem(1:ncol), ncol) ftem(:ncol) = cam_in%qref(:ncol)/ftem(:ncol)*100._r8 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 ! @@ -1905,7 +1934,6 @@ subroutine diag_physvar_ic (lchnk, pbuf, cam_out, cam_in) ! !---------------------------Local workspace----------------------------- ! - integer :: k ! indices integer :: itim_old ! indices real(r8), pointer, dimension(:,:) :: cwat_var @@ -2018,6 +2046,8 @@ subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) real(r8) :: heat_glob ! global energy integral (FV only) ! CAM pointers to get variables from the physics buffer real(r8), pointer, dimension(:,:) :: t_ttend + real(r8), pointer, dimension(:,:) :: t_utend + real(r8), pointer, dimension(:,:) :: t_vtend integer :: itim_old,m !----------------------------------------------------------------------- @@ -2034,35 +2064,43 @@ 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 (dycore_is('LR') .or. dycore_is('SE') .or. dycore_is('FV3') ) then - call check_energy_get_integrals( heat_glob_out=heat_glob ) - ftem2(:ncol) = heat_glob/cpair - call outfld('TFIX', ftem2, pcols, lchnk ) - ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver) - heat_glob/cpair - else - ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver) - end if + call check_energy_get_integrals( heat_glob_out=heat_glob ) + ftem2(:ncol) = heat_glob/cpair + call outfld('TFIX', ftem2, pcols, lchnk ) + ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver) - heat_glob/cpair call outfld('PTTEND',ftem3, pcols, lchnk ) + ftem3(:ncol,:pver) = tend%dudt(:ncol,:pver) + call outfld('UTEND_PHYSTOT',ftem3, pcols, lchnk ) + ftem3(:ncol,:pver) = tend%dvdt(:ncol,:pver) + call outfld('VTEND_PHYSTOT',ftem3, pcols, lchnk ) ! Total (physics+dynamics, everything!) tendency for Temperature - !! get temperature stored in physics buffer + !! get temperature, U, and V stored in physics buffer itim_old = pbuf_old_tim_idx() call pbuf_get_field(pbuf, t_ttend_idx, t_ttend, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, t_utend_idx, t_utend, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, t_vtend_idx, t_vtend, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - !! calculate and outfld the total temperature tendency + !! calculate and outfld the total temperature, U, and V tendencies ftem3(:ncol,:) = (state%t(:ncol,:) - t_ttend(:ncol,:))/ztodt call outfld('TTEND_TOT', ftem3, pcols, lchnk) + ftem3(:ncol,:) = (state%u(:ncol,:) - t_utend(:ncol,:))/ztodt + call outfld('UTEND_TOT', ftem3, pcols, lchnk) + ftem3(:ncol,:) = (state%v(:ncol,:) - t_vtend(:ncol,:))/ztodt + call outfld('VTEND_TOT', ftem3, pcols, lchnk) - !! update physics buffer with this time-step's temperature + !! update physics buffer with this time-step's temperature, U, and V t_ttend(:ncol,:) = state%t(:ncol,:) + t_utend(:ncol,:) = state%u(:ncol,:) + t_vtend(:ncol,:) = state%v(:ncol,:) end subroutine diag_phys_tend_writeout_dry !####################################################################### subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + qini, cldliqini, cldiceini) !--------------------------------------------------------------- ! @@ -2077,9 +2115,6 @@ subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & type(physics_buffer_desc), pointer :: pbuf(:) type(physics_tend ), intent(in) :: tend real(r8), intent(in) :: ztodt ! physics timestep - real(r8), intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV) real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics @@ -2112,35 +2147,6 @@ subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & end if end if - ! Tendency for dry mass adjustment of q (FV only) - - if (dycore_is('LR') .or. dycore_is('FV3') ) then - tmp_q (:ncol,:pver) = (state%q(:ncol,:pver, 1) - tmp_q (:ncol,:pver))*rtdt - if (ixcldliq > 0) then - tmp_cldliq(:ncol,:pver) = (state%q(:ncol,:pver,ixcldliq) - tmp_cldliq(:ncol,:pver))*rtdt - else - tmp_cldliq(:ncol,:pver) = 0.0_r8 - end if - if (ixcldice > 0) then - tmp_cldice(:ncol,:pver) = (state%q(:ncol,:pver,ixcldice) - tmp_cldice(:ncol,:pver))*rtdt - else - tmp_cldice(:ncol,:pver) = 0.0_r8 - end if - if ( cnst_cam_outfld( 1) ) then - call outfld (dmetendnam( 1), tmp_q , pcols, lchnk) - end if - if (ixcldliq > 0) then - if ( cnst_cam_outfld(ixcldliq) ) then - call outfld (dmetendnam(ixcldliq), tmp_cldliq, pcols, lchnk) - end if - end if - if (ixcldice > 0) then - if ( cnst_cam_outfld(ixcldice) ) then - call outfld (dmetendnam(ixcldice), tmp_cldice, pcols, lchnk) - end if - end if - end if - ! Total physics tendency for moisture and other tracers if ( cnst_cam_outfld( 1) ) then @@ -2165,7 +2171,7 @@ end subroutine diag_phys_tend_writeout_moist !####################################################################### subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + qini, cldliqini, cldiceini) !--------------------------------------------------------------- ! @@ -2180,9 +2186,6 @@ subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, & type(physics_buffer_desc), pointer :: pbuf(:) type(physics_tend ), intent(in) :: tend real(r8), intent(in) :: ztodt ! physics timestep - real(r8) , intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV) real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics @@ -2192,7 +2195,7 @@ subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, & call diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) if (moist_physics) then call diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + qini, cldliqini, cldiceini) end if end subroutine diag_phys_tend_writeout @@ -2220,6 +2223,8 @@ subroutine diag_state_b4_phys_write_dry (state) lchnk = state%lchnk call outfld('TBP', state%t, pcols, lchnk ) + call outfld('UBP', state%u, pcols, lchnk ) + call outfld('VBP', state%v, pcols, lchnk ) end subroutine diag_state_b4_phys_write_dry diff --git a/src/physics/cam/cam_snapshot.F90 b/src/physics/cam/cam_snapshot.F90 new file mode 100644 index 0000000000..da79aeb517 --- /dev/null +++ b/src/physics/cam/cam_snapshot.F90 @@ -0,0 +1,306 @@ +module cam_snapshot +!-------------------------------------------------------- +! The purpose of this module is to handle taking the "snapshot" of CAM data. +! +! This module writes out ALL the state, tend and pbuf fields. It also includes the cam_in and cam_out +! fields which are used within CAM +!-------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use cam_history, only: addfld, add_default, outfld +use cam_history, only: cam_history_snapshot_deactivate, cam_history_snapshot_activate +use cam_history_support, only: horiz_only +use cam_abortutils, only: endrun +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_get_field_name +use physics_types, only: physics_state, physics_tend, physics_ptend +use camsrfexch, only: cam_out_t, cam_in_t +use ppgrid, only: pcols, begchunk, endchunk +use constituents, only: pcnst +use phys_control, only: phys_getopts +use cam_logfile, only: iulog +use cam_snapshot_common, only: snapshot_type, cam_snapshot_deactivate, cam_snapshot_all_outfld, cam_snapshot_ptend_outfld +use cam_snapshot_common, only: snapshot_type, cam_state_snapshot_init, cam_cnst_snapshot_init, cam_tend_snapshot_init +use cam_snapshot_common, only: cam_ptend_snapshot_init, cam_in_snapshot_init, cam_out_snapshot_init +use cam_snapshot_common, only: cam_pbuf_snapshot_init, snapshot_addfld + +implicit none + +private + +public :: cam_snapshot_init +public :: cam_snapshot_all_outfld_tphysbc, cam_snapshot_all_outfld_tphysac + +private :: cam_tphysbc_snapshot_init, cam_tphysac_snapshot_init + +integer :: ntphysbc_var +integer :: ntphysac_var + +integer :: cam_snapshot_before_num, cam_snapshot_after_num + +! Note the maximum number of variables for each type +type (snapshot_type) :: tphysbc_snapshot(30) +type (snapshot_type) :: tphysac_snapshot(30) + +contains + +subroutine cam_snapshot_init(cam_in_arr, cam_out_arr, pbuf, index) + + +!-------------------------------------------------------- +! This subroutine does the addfld calls for ALL state, tend, ptend, and pbuf fields. It also includes the cam_in and cam_out +! elements which are used within CAM +!-------------------------------------------------------- + type(cam_in_t), intent(in) :: cam_in_arr(begchunk:endchunk) + type(cam_out_t), intent(in) :: cam_out_arr(begchunk:endchunk) + type(physics_buffer_desc), pointer, intent(inout) :: pbuf(:,:) + integer, intent(in) :: index + + + call phys_getopts(cam_snapshot_before_num_out = cam_snapshot_before_num, & + cam_snapshot_after_num_out = cam_snapshot_after_num) + + + ! Return if not turned on + if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested + + call cam_state_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + call cam_cnst_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + call cam_tend_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + call cam_ptend_snapshot_init(cam_snapshot_after_num) + call cam_in_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, cam_in_arr(index)) + call cam_out_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, cam_out_arr(index)) + call cam_pbuf_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, pbuf(:,index)) + call cam_tphysac_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + call cam_tphysbc_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + +end subroutine cam_snapshot_init + +subroutine cam_snapshot_all_outfld_tphysbc(file_num, state, tend, cam_in, cam_out, pbuf, flx_heat, cmfmc, cmfcme, & + zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + +use time_manager, only: is_first_step, is_first_restart_step + +!-------------------------------------------------------- +! This subroutine does the outfld calls for ALL state, tend and pbuf fields for routines in tphysbc. +! It also includes the cam_in and cam_out elements which are used within CAM as well as variables which +! are local to tphysbc. +!-------------------------------------------------------- + + integer, intent(in) :: file_num + type(physics_state), intent(in) :: state + type(physics_tend), intent(in) :: tend + type(cam_in_t), intent(in) :: cam_in + type(cam_out_t), intent(in) :: cam_out + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) + real(r8), intent(in) :: flx_heat(:) ! Heat flux for check_energy_chng. + real(r8), intent(in) :: cmfmc(:,:) ! convective mass flux + real(r8), intent(in) :: cmfcme(:,:) ! cmf condensation - evaporation + real(r8), intent(in) :: zdu(:,:) ! detraining mass flux from deep convection + real(r8), intent(in) :: rliq(:) ! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(in) :: rice(:) ! vertical integral of ice not yet in q(ixcldice) + real(r8), intent(in) :: dlf(:,:) ! local copy of DLFZM (copy so need to output) + real(r8), intent(in) :: dlf2(:,:) ! Detraining cld H20 from shallow convections + real(r8), intent(in) :: rliq2(:) ! vertical integral of liquid from shallow scheme + real(r8), intent(in) :: det_s(:) ! vertical integral of detrained static energy from ice + real(r8), intent(in) :: det_ice(:) ! vertical integral of detrained ice + real(r8), intent(in) :: net_flx(:) + + integer :: lchnk + + ! Return if the first timestep as not all fields may be filled in and this will cause a core dump + if (is_first_step().or. is_first_restart_step()) return + + ! Return if not turned on + if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested + + lchnk = state%lchnk + + call cam_history_snapshot_activate('tphysbc_flx_heat', file_num) + call outfld('tphysbc_flx_heat', flx_heat, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysbc_flx_heat') + + call cam_history_snapshot_activate('tphysbc_cmfmc', file_num) + call outfld('tphysbc_cmfmc', cmfmc, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysbc_cmfmc') + + call cam_history_snapshot_activate('tphysbc_cmfcme', file_num) + call outfld('tphysbc_cmfcme', cmfcme, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysbc_cmfcme') + + call cam_history_snapshot_activate('tphysbc_zdu', file_num) + call outfld('tphysbc_zdu', zdu, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysbc_zdu') + + call cam_history_snapshot_activate('tphysbc_rliq', file_num) + call outfld('tphysbc_rliq', rliq, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysbc_rliq') + + call cam_history_snapshot_activate('tphysbc_rice', file_num) + call outfld('tphysbc_rice', rice, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysbc_rice') + + call cam_history_snapshot_activate('tphysbc_dlf', file_num) + call outfld('tphysbc_dlf', dlf, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysbc_dlf') + + call cam_history_snapshot_activate('tphysbc_dlf2', file_num) + call outfld('tphysbc_dlf2', dlf2, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysbc_dlf2') + + call cam_history_snapshot_activate('tphysbc_rliq2', file_num) + call outfld('tphysbc_rliq2', rliq2, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysbc_rliq2') + + call cam_history_snapshot_activate('tphysbc_det_s', file_num) + call outfld('tphysbc_det_s', det_s, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysbc_det_s') + + call cam_history_snapshot_activate('tphysbc_det_ice', file_num) + call outfld('tphysbc_det_ice', det_ice, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysbc_det_ice') + + call cam_history_snapshot_activate('tphysbc_net_flx', file_num) + call outfld('tphysbc_net_flx', net_flx, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysbc_net_flx') + + call cam_snapshot_all_outfld(file_num, state, tend, cam_in, cam_out, pbuf) + +end subroutine cam_snapshot_all_outfld_tphysbc + +subroutine cam_snapshot_all_outfld_tphysac(file_num, state, tend, cam_in, cam_out, pbuf, fh2o, surfric, obklen, flx_heat) + +use time_manager, only: is_first_step + +!-------------------------------------------------------- +! This subroutine does the outfld calls for ALL state, tend and pbuf fields for routines in tphysac. +! It also includes the cam_in and cam_out elements which are used within CAM as well as variables which +! are local to tphysac. +!-------------------------------------------------------- + + integer, intent(in) :: file_num + type(physics_state), intent(in) :: state + type(physics_tend), intent(in) :: tend + type(cam_in_t), intent(in) :: cam_in + type(cam_out_t), intent(in) :: cam_out + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) + real(r8), intent(in) :: fh2o(:) ! h2o flux to balance source from methane chemistry + real(r8), intent(in) :: surfric(:) ! surface friction velocity + real(r8), intent(in) :: obklen(:) ! Obukhov length + real(r8), intent(in) :: flx_heat(:) ! Heat flux for check_energy_chng. + + integer :: lchnk + + ! Return if the first timestep as not all fields may be filled in and this will cause a core dump + if (is_first_step()) return + + ! Return if not turned on + if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested + + lchnk = state%lchnk + + call cam_history_snapshot_activate('tphysac_fh2o', file_num) + call outfld('tphysac_fh2o', fh2o, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysac_fh2o') + + call cam_history_snapshot_activate('tphysac_surfric', file_num) + call outfld('tphysac_surfric', surfric, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysac_surfric') + + call cam_history_snapshot_activate('tphysac_obklen', file_num) + call outfld('tphysac_obklen', obklen, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysac_obklen') + + call cam_history_snapshot_activate('tphysac_flx_heat', file_num) + call outfld('tphysac_flx_heat', flx_heat, pcols, lchnk) + call cam_history_snapshot_deactivate('tphysac_flx_heat') + + + call cam_snapshot_all_outfld(file_num, state, tend, cam_in, cam_out, pbuf) + +end subroutine cam_snapshot_all_outfld_tphysac + +subroutine cam_tphysbc_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + +!-------------------------------------------------------- +! This subroutine does the addfld calls for the misc tphysbc physics variables that are passed individually +! into physics packages +!-------------------------------------------------------- + + integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num + + ntphysbc_var = 0 + + !-------------------------------------------------------- + ! Add the misc tphysbc variables to the output + ! NOTE - flx_heat is added in tphysac + !-------------------------------------------------------- + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'flx', 'tphysbc_flx_heat', 'unset', horiz_only) + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cmfmc', 'tphysbc_cmfmc', 'unset', 'lev') + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cmfcme', 'tphysbc_cmfcme', 'unset', 'lev') + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'zdu', 'tphysbc_zdu', 'unset', 'lev') + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'rliq', 'tphysbc_rliq', 'unset', horiz_only) + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'rice', 'tphysbc_rice', 'unset', horiz_only) + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'dlf', 'tphysbc_dlf', 'unset', 'lev') + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'dlf2', 'tphysbc_dlf2', 'unset', 'lev') + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'rliq2', 'tphysbc_rliq2', 'unset', horiz_only) + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'det_s', 'tphysbc_det_s', 'unset', horiz_only) + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'det_ice', 'tphysbc_det_ice', 'unset', horiz_only) + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'net_flx', 'tphysbc_net_flx', 'unset', horiz_only) + + +end subroutine cam_tphysbc_snapshot_init + +subroutine cam_tphysac_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + +!-------------------------------------------------------- +! This subroutine does the addfld calls for the misc tphysac physics variables that are passed individually +! into physics packages +!-------------------------------------------------------- + + integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num + + ntphysac_var = 0 + + !-------------------------------------------------------- + ! Add the misc tphysac variables to the output + !-------------------------------------------------------- + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'fh2o', 'tphysac_fh2o', 'unset', horiz_only) + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'surfric', 'tphysac_surfric', 'unset', horiz_only) + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'obklen', 'tphysac_obklen', 'unset', horiz_only) + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'flx', 'tphysac_flx_heat', 'unset', horiz_only) + +end subroutine cam_tphysac_snapshot_init + +end module cam_snapshot diff --git a/src/physics/cam/carma_flags_mod.F90 b/src/physics/cam/carma_flags_mod.F90 index 59fee48bf3..2ed1fcc531 100644 --- a/src/physics/cam/carma_flags_mod.F90 +++ b/src/physics/cam/carma_flags_mod.F90 @@ -11,8 +11,13 @@ module carma_flags_mod use spmd_utils, only: masterproc ! Flags for integration with CAM Microphysics - public carma_readnl ! read the carma namelist - + + implicit none + public + + integer, parameter :: carma_maxdiags = 100 + integer, protected :: carma_ndiagpkgs ! Number of diags_packages listed + integer, protected :: carma_ndebugpkgs ! Number of diags_packages listed ! Namelist flags ! @@ -20,45 +25,53 @@ module carma_flags_mod ! calculations, but it will still initialize itself. This allows the same build and ! namelist to be used, but the CARMA processing diabled. Use the configure option ! -carma none to totally disable CARMA and prevent even the register from happening. - logical, public :: carma_flag = .false. ! If .true. then turn on CARMA microphysics in CAM - logical, public :: carma_do_aerosol = .true. ! If .true. then CARMA is processed after surface coupling - logical, public :: carma_do_cldice = .false. ! If .true. then do cloud ice - logical, public :: carma_do_cldliq = .false. ! If .true. then do cloud liquid - logical, public :: carma_do_clearsky = .false. ! If .true. then do clear sky particle calculations - logical, public :: carma_do_coag = .false. ! If .true. then do coagulation - logical, public :: carma_do_detrain = .false. ! If .true. then do detrain - logical, public :: carma_do_drydep = .false. ! If .true. then do dry deposition - logical, public :: carma_do_emission = .false. ! If .true. then do emission - logical, public :: carma_do_fixedinit= .false. ! If .true. then do fixed initialization to a reference state - logical, public :: carma_hetchem_feedback= .false.! If .true. then CARMA sulfate surface area density used in heterogeneous chemistry - logical, public :: carma_rad_feedback= .false. ! If .true. then CARMA sulfate mass mixing ratio & effective radius used in radiation - logical, public :: carma_do_explised = .false. ! If .true. then do sedimentation with substepping - logical, public :: carma_do_incloud = .false. ! If .true. then do incloud particle calculations - logical, public :: carma_do_grow = .false. ! If .true. then do growth - logical, public :: carma_do_optics = .false. ! If .true. then do optical properties file - logical, public :: carma_do_partialinit= .false. ! If .true. then do initialization of coagulation to a reference state (requires fixedinit) - logical, public :: carma_do_pheat = .false. ! If .true. then do particle heating - logical, public :: carma_do_pheatatm = .false. ! If .true. then do particle heating of atmosphere - logical, public :: carma_do_substep = .false. ! If .true. then do substeping - logical, public :: carma_do_thermo = .false. ! If .true. then do solve thermodynamics equation - logical, public :: carma_do_wetdep = .false. ! If .true. then do wet deposition - logical, public :: carma_do_vdiff = .false. ! If .true. then do vertical brownian diffusion - logical, public :: carma_do_vtran = .false. ! If .true. then do vertical transport - integer, public :: carma_maxsubsteps = 1 ! Maximum number of time substeps allowed - integer, public :: carma_minsubsteps = 1 ! Minimum number of time substeps allowed - integer, public :: carma_maxretries = 8 ! Maximum number of time substeps allowed - real(r8), public :: carma_conmax = 0.1_r8 ! Minumum relative concentration to consider in substep - real(r8), public :: carma_dgc_threshold = 0.0_r8 ! When non-zero, the largest percentage change in gas concentration allowed per substep. - real(r8), public :: carma_ds_threshold = 0.0_r8 ! When non-zero, the largest percentage change in gas saturation allowed per substep. - real(r8), public :: carma_dt_threshold = 0.0_r8 ! When non-zero, the largest change in temperature (K) allowed per substep. - real(r8), public :: carma_tstick = 1.0_r8 ! Thermal accommodation coefficient - real(r8), public :: carma_gsticki = 0.93_r8 ! Growth accommodation coefficient for ice - real(r8), public :: carma_gstickl = 1.0_r8 ! Growth accommodation coefficient for liquid - real(r8), public :: carma_cstick = 1.0_r8 ! Coagulation accommodation coefficient - real(r8), public :: carma_rhcrit = 1.0_r8 ! Critical relative humidity for liquid clouds - real(r8), public :: carma_vf_const = 0.0_r8 ! If specified and non-zero, constant fall velocity for all particles [cm/s] - character(len=256), public :: carma_reftfile = 'carma_reft.nc' ! path to the file containing the reference temperature profile - character(len=32), public :: carma_model = "none" ! String (no spaces) that identifies the model + logical, protected :: carma_flag = .false. ! If .true. then turn on CARMA microphysics in CAM + logical, protected :: carma_do_aerosol = .true. ! If .true. then CARMA is processed after surface coupling + logical, protected :: carma_do_coremasscheck = .false. ! If .true. then do coremasscheck and abort model after certain subroutines + logical, protected :: carma_do_cldice = .false. ! If .true. then do cloud ice + logical, protected :: carma_do_cldliq = .false. ! If .true. then do cloud liquid + logical, protected :: carma_do_clearsky = .false. ! If .true. then do clear sky particle calculations + logical, protected :: carma_do_cloudborne = .false. ! If .true. then do then the carma groups can be cloudborne + logical, protected :: carma_do_coag = .false. ! If .true. then do coagulation + logical, protected :: carma_do_detrain = .false. ! If .true. then do detrain + logical, protected :: carma_do_drydep = .false. ! If .true. then do dry deposition + logical, protected :: carma_do_emission = .false. ! If .true. then do emission + logical, protected :: carma_do_fixedinit= .false. ! If .true. then do fixed initialization to a reference state + logical, protected :: carma_hetchem_feedback=.false.! If .true. then CARMA sulfate surface area density used in heterogeneous chemistry + logical, protected :: carma_rad_feedback= .false. ! If .true. then CARMA sulfate mass mixing ratio & effective radius used in radiation + logical, protected :: carma_do_explised = .false. ! If .true. then do sedimentation with substepping + logical, protected :: carma_do_incloud = .false. ! If .true. then do incloud particle calculations + logical, protected :: carma_do_budget_diags = .false. ! If .true. then do budget diagnostics + logical, protected :: carma_do_package_diags = .false. ! If .true. then do package diagnostics + logical, protected :: carma_do_grow = .false. ! If .true. then do growth + logical, protected :: carma_do_optics = .false. ! If .true. then do optical properties file + logical, protected :: carma_do_partialinit= .false. ! If .true. then do initialization of coagulation to a reference state (requires fixedinit) + logical, protected :: carma_do_pheat = .false. ! If .true. then do particle heating + logical, protected :: carma_do_pheatatm = .false. ! If .true. then do particle heating of atmosphere + logical, protected :: carma_do_substep = .false. ! If .true. then do substeping + logical, protected :: carma_do_thermo = .false. ! If .true. then do solve thermodynamics equation + logical, protected :: carma_do_wetdep = .false. ! If .true. then do wet deposition + logical, protected :: carma_do_vdiff = .false. ! If .true. then do vertical brownian diffusion + logical, protected :: carma_do_vtran = .false. ! If .true. then do vertical transport + integer, protected :: carma_diags_file = 0 ! Default file for diagnostic output + integer, protected :: carma_maxsubsteps = 1 ! Maximum number of time substeps allowed + integer, protected :: carma_minsubsteps = 1 ! Minimum number of time substeps allowed + integer, protected :: carma_maxretries = 8 ! Maximum number of time substeps allowed + real(r8), protected :: carma_conmax = 0.1_r8 ! Minumum relative concentration to consider in substep + real(r8), protected :: carma_dgc_threshold = 0.0_r8 ! When non-zero, the largest percentage change in gas concentration allowed per substep. + real(r8), protected :: carma_ds_threshold = 0.0_r8 ! When non-zero, the largest percentage change in gas saturation allowed per substep. + real(r8), protected :: carma_dt_threshold = 0.0_r8 ! When non-zero, the largest change in temperature (K) allowed per substep. + real(r8), protected :: carma_tstick = 1.0_r8 ! Thermal accommodation coefficient + real(r8), protected :: carma_gsticki = 0.93_r8 ! Growth accommodation coefficient for ice + real(r8), protected :: carma_gstickl = 1.0_r8 ! Growth accommodation coefficient for liquid + real(r8), protected :: carma_cstick = 1.0_r8 ! Coagulation accommodation coefficient + real(r8), protected :: carma_rhcrit = 1.0_r8 ! Critical relative humidity for liquid clouds + real(r8), protected :: carma_vf_const = 0.0_r8 ! If specified and non-zero, constant fall velocity for all particles [cm/s] + character(len=32), protected :: carma_model = "none" ! String (no spaces) that identifies the model + character(len=10), protected :: carma_sulfnuc_method = "none" ! Sulfate Nucleation method + character(len=32), protected :: carma_diags_packages(carma_maxdiags) = " " ! Names of physics packages for which diagnostic output is desired + character(len=12), protected :: carma_debug_packages(carma_maxdiags) = " " ! Names of physics packages for which debug output is desired + contains @@ -68,30 +81,32 @@ module carma_flags_mod !! @author Chuck Bardeen !! @version Aug-2010 subroutine carma_readnl(nlfile) - + ! Read carma namelist group. - + use cam_abortutils, only: endrun use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand + use spmd_utils, only: mpicom, masterprocid, mpi_real8, mpi_integer, mpi_logical, mpi_character, mpi_success use carma_model_flags_mod, only: carma_model_readnl - + ! args - + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - + ! local vars - - integer :: unitn, ierr - + + integer :: unitn, ierr, i + character(len=*), parameter :: prefix = 'carma_readnl: ' + ! read namelist for CARMA namelist /carma_nl/ & carma_flag, & carma_do_aerosol, & + carma_do_coremasscheck, & carma_do_cldliq, & carma_do_cldice, & carma_do_clearsky, & + carma_do_cloudborne, & carma_do_coag, & carma_do_detrain, & carma_do_drydep, & @@ -115,7 +130,6 @@ subroutine carma_readnl(nlfile) carma_minsubsteps, & carma_maxretries, & carma_model, & - carma_reftfile, & carma_conmax, & carma_dgc_threshold, & carma_ds_threshold, & @@ -125,67 +139,136 @@ subroutine carma_readnl(nlfile) carma_gstickl, & carma_cstick, & carma_rhcrit, & - carma_vf_const - + carma_vf_const, & + carma_sulfnuc_method, & + carma_do_budget_diags, & + carma_do_package_diags, & + carma_diags_packages, & + carma_debug_packages, & + carma_diags_file + if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'carma_nl', status=ierr) if (ierr == 0) then read(unitn, carma_nl, iostat=ierr) if (ierr /= 0) then - call endrun('carma_readnl: ERROR reading namelist') + call endrun(prefix//'ERROR reading namelist') end if end if close(unitn) - call freeunit(unitn) end if - -#ifdef SPMD - call mpibcast (carma_flag, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_aerosol, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_cldliq, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_cldice, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_clearsky, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_coag, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_detrain, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_drydep, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_emission, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_fixedinit, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_hetchem_feedback,1 ,mpilog, 0,mpicom) - call mpibcast (carma_rad_feedback, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_explised, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_incloud, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_grow, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_optics, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_partialinit, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_pheat, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_pheatatm, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_substep, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_thermo, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_wetdep, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_vdiff, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_do_vtran, 1 ,mpilog, 0,mpicom) - call mpibcast (carma_maxsubsteps, 1 ,mpiint, 0,mpicom) - call mpibcast (carma_minsubsteps, 1 ,mpiint, 0,mpicom) - call mpibcast (carma_maxretries, 1 ,mpiint, 0,mpicom) - call mpibcast (carma_conmax, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_dgc_threshold, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_ds_threshold, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_dt_threshold, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_tstick, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_gsticki, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_gstickl, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_cstick, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_rhcrit, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_vf_const, 1 ,mpir8, 0,mpicom) - call mpibcast (carma_model, len(carma_model), mpichar, 0, mpicom) - call mpibcast (carma_reftfile, len(carma_reftfile), mpichar, 0, mpicom) -#endif + + call mpi_bcast (carma_flag, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_flag') + call mpi_bcast (carma_do_aerosol, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_aerosol') + call mpi_bcast (carma_do_coremasscheck,1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_coremasscheck') + call mpi_bcast (carma_do_cldliq, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_cldliq') + call mpi_bcast (carma_do_cldice, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_cldice') + call mpi_bcast (carma_do_clearsky, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_clearsky') + call mpi_bcast (carma_do_cloudborne, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_cloudborne') + call mpi_bcast (carma_do_coag, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_coag') + call mpi_bcast (carma_do_detrain, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_detrain') + call mpi_bcast (carma_do_drydep, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_drydep') + call mpi_bcast (carma_do_emission, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_emission') + call mpi_bcast (carma_do_fixedinit, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_fixedinit') + call mpi_bcast (carma_hetchem_feedback,1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_hetchem_feedback') + call mpi_bcast (carma_rad_feedback, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_rad_feedback') + call mpi_bcast (carma_do_explised, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_explised') + call mpi_bcast (carma_do_budget_diags, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_budget_diags') + call mpi_bcast (carma_do_package_diags,1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_package_diags') + call mpi_bcast (carma_do_incloud, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_incloud') + call mpi_bcast (carma_do_grow, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_grow') + call mpi_bcast (carma_do_optics, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_optics') + call mpi_bcast (carma_do_partialinit, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_partialinit') + call mpi_bcast (carma_do_pheat, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_pheat') + call mpi_bcast (carma_do_pheatatm, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_pheatatm') + call mpi_bcast (carma_do_substep, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_substep') + call mpi_bcast (carma_do_thermo, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_thermo') + call mpi_bcast (carma_do_wetdep, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_wetdep') + call mpi_bcast (carma_do_vdiff, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_vdiff') + call mpi_bcast (carma_do_vtran, 1 ,mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_do_vtran') + call mpi_bcast (carma_diags_file, 1 ,mpi_integer, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_diags_file') + call mpi_bcast (carma_maxsubsteps, 1 ,mpi_integer, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_maxsubsteps') + call mpi_bcast (carma_minsubsteps, 1 ,mpi_integer, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_minsubsteps') + call mpi_bcast (carma_maxretries, 1 ,mpi_integer, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_maxretries') + call mpi_bcast (carma_conmax, 1 ,mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_conmax') + call mpi_bcast (carma_dgc_threshold, 1 ,mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_dgc_threshold') + call mpi_bcast (carma_ds_threshold, 1 ,mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_ds_threshold') + call mpi_bcast (carma_dt_threshold, 1 ,mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_dt_threshold') + call mpi_bcast (carma_tstick, 1 ,mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_tstick') + call mpi_bcast (carma_gsticki, 1 ,mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_gsticki') + call mpi_bcast (carma_gstickl, 1 ,mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_gstickl') + call mpi_bcast (carma_cstick, 1 ,mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_cstick') + call mpi_bcast (carma_rhcrit, 1 ,mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_rhcrit') + call mpi_bcast (carma_vf_const, 1 ,mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_vf_const') + call mpi_bcast (carma_model, len(carma_model), mpi_character, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_model') + call mpi_bcast (carma_sulfnuc_method, len(carma_sulfnuc_method), mpi_character, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_sulfnuc_method') + call mpibcast (carma_diags_packages, len(carma_diags_packages(1))*carma_maxdiags, mpi_character, 0, mpicom) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_diags_packages') + call mpibcast (carma_debug_packages, len(carma_debug_packages(1))*carma_maxdiags, mpi_character, 0, mpicom) + if (ierr/=mpi_success) call endrun(prefix//'mpi_bcast error : carma_debug_packages') + + carma_ndiagpkgs = 0 + do i = 1, carma_maxdiags + if (len_trim(carma_diags_packages(i)) > 0) then + carma_ndiagpkgs = carma_ndiagpkgs + 1 + endif + enddo + + carma_ndebugpkgs = 0 + do i = 1, carma_maxdiags + if (len_trim(carma_debug_packages(i)) > 0) then + carma_ndebugpkgs = carma_ndebugpkgs + 1 + endif + enddo ! Also cause the CARMA model flags to be read in. call carma_model_readnl(nlfile) - + end subroutine carma_readnl end module carma_flags_mod diff --git a/src/physics/cam/carma_intr.F90 b/src/physics/cam/carma_intr.F90 index fc09de5246..b555aaf68a 100644 --- a/src/physics/cam/carma_intr.F90 +++ b/src/physics/cam/carma_intr.F90 @@ -22,12 +22,12 @@ module carma_intr implicit none - + private save ! Public interfaces - + ! CAM Physics Interface public carma_register ! register consituents public carma_is_active ! retrns true if this package is active (microphysics = .true.) @@ -38,11 +38,11 @@ module carma_intr public carma_timestep_init ! initialize timestep dependent variables public carma_timestep_tend ! interface to tendency computation public carma_accumulate_stats ! collect stats from all MPI tasks - + ! Other Microphysics public carma_emission_tend ! calculate tendency from emission source function public carma_wetdep_tend ! calculate tendency from wet deposition - + contains @@ -55,40 +55,41 @@ end subroutine carma_register function carma_is_active() implicit none - + logical :: carma_is_active - + carma_is_active = .false. - + return end function carma_is_active function carma_implements_cnst(name) implicit none - + character(len=*), intent(in) :: name !! constituent name logical :: carma_implements_cnst ! return value carma_implements_cnst = .false. - + return end function carma_implements_cnst - - subroutine carma_init + + subroutine carma_init(pbuf2d) implicit none - + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + return end subroutine carma_init subroutine carma_final implicit none - + return end subroutine carma_final - + subroutine carma_timestep_init implicit none @@ -103,7 +104,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli use time_manager, only: get_nstep, get_step_size, is_first_step use camsrfexch, only: cam_in_t, cam_out_t use scamMod, only: single_column - + implicit none type(physics_state), intent(inout) :: state !! physics state variables @@ -114,13 +115,13 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer real(r8), intent(in), optional :: dlf(pcols,pver) !! Detraining cld H20 from convection (kg/kg/s) real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(out), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(out), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(out), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(out), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(in), optional :: ustar(pcols) !! friction velocity (m/s) real(r8), intent(in), optional :: obklen(pcols) !! Obukhov length [ m ] - + call physics_ptend_init(ptend,state%psetcols,'none') !Initialize an empty ptend for use with physics_update if (present(prec_str)) prec_str(:) = 0._r8 @@ -140,27 +141,28 @@ subroutine carma_init_cnst(name, latvals, lonvals, mask, q) real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) logical, intent(in) :: mask(:) !! Only initialize where .true. real(r8), intent(out) :: q(:,:) !! mass mixing ratio - + if (name == "carma") then q = 0._r8 - end if - + end if + return end subroutine carma_init_cnst - subroutine carma_emission_tend(state, ptend, cam_in, dt) + subroutine carma_emission_tend(state, ptend, cam_in, dt, pbuf) use camsrfexch, only: cam_in_t implicit none - + type(physics_state), intent(in ) :: state !! physics state type(physics_ptend), intent(inout) :: ptend !! physics state tendencies type(cam_in_t), intent(inout) :: cam_in !! surface inputs real(r8), intent(in) :: dt !! time step (s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer return - end subroutine carma_emission_tend + end subroutine carma_emission_tend subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 2260792315..d1d59e173f 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -21,51 +21,57 @@ module check_energy !--------------------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, pver, begchunk, endchunk + use ppgrid, only: pcols, pver use spmd_utils, only: masterproc - use gmean_mod, only: gmean - use physconst, only: gravit, latvap, latice, cpair, cpairv - use physics_types, only: physics_state, physics_tend, physics_ptend, physics_ptend_init + use physconst, only: rga + use air_composition, only: cpairv, cp_or_cv_dycore + use physics_types, only: physics_state 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 implicit none private -! Public types: + ! Public types: public check_tracers_data -! Public methods - public :: check_energy_readnl ! read namelist values - public :: check_energy_register ! register fields in physics buffer - public :: check_energy_get_integrals ! get energy integrals computed in check_energy_gmean - public :: check_energy_init ! initialization of module - public :: check_energy_timestep_init ! timestep initialization of energy integrals and cumulative boundary fluxes - public :: check_energy_chng ! check changes in integrals against cumulative boundary fluxes - public :: check_energy_gmean ! global means of physics input and output total energy - public :: check_energy_fix ! add global mean energy difference as a heating - public :: check_tracers_init ! initialize tracer integrals and cumulative boundary fluxes - public :: check_tracers_chng ! check changes in integrals against cumulative boundary fluxes + ! Public methods - not CCPP-ized + public :: check_tracers_init ! initialize tracer integrals and cumulative boundary fluxes + public :: check_tracers_chng ! check changes in integrals against cumulative boundary fluxes + public :: tot_energy_phys ! calculate and output total energy and axial angular momentum diagnostics - public :: calc_te_and_aam_budgets ! calculate and output total energy and axial angular momentum diagnostics + ! These subroutines cannot be CCPP-ized + public :: check_energy_readnl ! read namelist values + public :: check_energy_register ! register fields in physics buffer + public :: check_energy_init ! initialization of module + public :: check_energy_gmean ! global means of physics input and output total energy + public :: check_energy_get_integrals ! get energy integrals computed in check_energy_gmean -! Private module data + ! Public methods - CAM interfaces to CCPP version: + public :: check_energy_cam_chng ! check changes in integrals against cumulative boundary fluxes + public :: check_energy_timestep_init ! timestep initialization of energy integrals and cumulative boundary fluxes + ! name is retained for FV3 compatibility - logical :: print_energy_errors = .false. - - real(r8) :: teout_glob ! global mean energy of output state - real(r8) :: teinp_glob ! global mean energy of input state - real(r8) :: tedif_glob ! global mean energy difference - real(r8) :: psurf_glob ! global mean surface pressure - real(r8) :: ptopb_glob ! global mean top boundary pressure - real(r8) :: heat_glob ! global mean heating rate + public :: check_energy_cam_fix ! add heating rate required for global mean total energy conservation -! Physics buffer indices + ! Private module data + logical :: print_energy_errors = .false. - integer :: teout_idx = 0 ! teout index in physics buffer - integer :: dtcore_idx = 0 ! dtcore index in physics buffer + ! used for check_energy_gmean + real(r8) :: teout_glob ! global mean energy of output state + real(r8) :: teinp_glob ! global mean energy of input state + real(r8) :: tedif_glob ! global mean energy difference + real(r8) :: psurf_glob ! global mean surface pressure + real(r8) :: ptopb_glob ! global mean top boundary pressure + real(r8) :: heat_glob ! global mean heating rate + + ! Physics buffer indices + integer, public :: teout_idx = 0 ! teout index in physics buffer + integer, public :: dtcore_idx = 0 ! dtcore index in physics buffer + integer, public :: dqcore_idx = 0 ! dqcore index in physics buffer + integer, public :: ducore_idx = 0 ! ducore index in physics buffer + integer, public :: dvcore_idx = 0 ! dvcore index in physics buffer type check_tracers_data real(r8) :: tracer(pcols,pcnst) ! initial vertically integrated total (kinetic + static) energy @@ -85,6 +91,9 @@ subroutine check_energy_readnl(nlfile) use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical use cam_abortutils, only: endrun + ! update the CCPP-ized namelist option + use check_energy_chng, only: check_energy_chng_init + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input ! Local variables @@ -117,6 +126,9 @@ subroutine check_energy_readnl(nlfile) write(iulog,*) ' print_energy_errors =', print_energy_errors end if + ! update the CCPP-ized namelist option + call check_energy_chng_init(print_energy_errors_in=print_energy_errors) + end subroutine check_energy_readnl !=============================================================================== @@ -137,35 +149,20 @@ subroutine check_energy_register() call pbuf_add_field('TEOUT', 'global',dtype_r8 , (/pcols,dyn_time_lvls/), teout_idx) call pbuf_add_field('DTCORE','global',dtype_r8, (/pcols,pver,dyn_time_lvls/),dtcore_idx) + ! DQCORE refers to dycore tendency of water vapor + call pbuf_add_field('DQCORE','global',dtype_r8, (/pcols,pver,dyn_time_lvls/),dqcore_idx) + call pbuf_add_field('DUCORE','global',dtype_r8, (/pcols,pver,dyn_time_lvls/),ducore_idx) + call pbuf_add_field('DVCORE','global',dtype_r8, (/pcols,pver,dyn_time_lvls/),dvcore_idx) if(is_subcol_on()) then call pbuf_register_subcol('TEOUT', 'phys_register', teout_idx) call pbuf_register_subcol('DTCORE', 'phys_register', dtcore_idx) + call pbuf_register_subcol('DQCORE', 'phys_register', dqcore_idx) + call pbuf_register_subcol('DUCORE', 'phys_register', ducore_idx) + call pbuf_register_subcol('DVCORE', 'phys_register', dvcore_idx) end if end subroutine check_energy_register -!=============================================================================== - -subroutine check_energy_get_integrals( tedif_glob_out, heat_glob_out ) - -!----------------------------------------------------------------------- -! Purpose: Return energy integrals -!----------------------------------------------------------------------- - - real(r8), intent(out), optional :: tedif_glob_out - real(r8), intent(out), optional :: heat_glob_out - -!----------------------------------------------------------------------- - - if ( present(tedif_glob_out) ) then - tedif_glob_out = tedif_glob - endif - if ( present(heat_glob_out) ) then - heat_glob_out = heat_glob - endif - -end subroutine check_energy_get_integrals - !================================================================================================ subroutine check_energy_init() @@ -193,6 +190,7 @@ subroutine check_energy_init() call addfld('TEFIX', horiz_only, 'A', 'J/m2', 'Total energy after fixer') call addfld('EFIX', horiz_only, 'A', 'W/m2', 'Effective sensible heat flux due to energy fixer') call addfld('DTCORE', (/ 'lev' /), 'A', 'K/s' , 'T tendency due to dynamical core') + call addfld('DQCORE', (/ 'lev' /), 'A', 'kg/kg/s' , 'Water vapor tendency due to dynamical core') if ( history_budget ) then call add_default ('DTCORE', history_budget_histfile_num, ' ') @@ -203,429 +201,6 @@ subroutine check_energy_init() end subroutine check_energy_init -!=============================================================================== - - subroutine check_energy_timestep_init(state, tend, pbuf, col_type) - use physics_buffer, only : physics_buffer_desc, pbuf_set_field - use cam_abortutils, only: endrun -!----------------------------------------------------------------------- -! Compute initial values of energy and water integrals, -! zero cumulative tendencies -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- - - type(physics_state), intent(inout) :: state - type(physics_tend ), intent(inout) :: tend - type(physics_buffer_desc), pointer :: pbuf(:) - integer, optional :: col_type ! Flag inidicating whether using grid or subcolumns -!---------------------------Local storage------------------------------- - - real(r8) :: ke(state%ncol) ! vertical integral of kinetic energy - real(r8) :: se(state%ncol) ! vertical integral of static energy - real(r8) :: wv(state%ncol) ! vertical integral of water (vapor) - real(r8) :: wl(state%ncol) ! vertical integral of water (liquid) - real(r8) :: wi(state%ncol) ! vertical integral of water (ice) - - real(r8),allocatable :: cpairv_loc(:,:,:) - - integer lchnk ! chunk identifier - integer ncol ! number of atmospheric columns - integer i,k ! column, level indices - integer :: ixcldice, ixcldliq ! CLDICE and CLDLIQ indices - integer :: ixrain, ixsnow ! RAINQM and SNOWQM indices - integer :: ixgrau ! GRAUQM index -!----------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - call cnst_get_ind('RAINQM', ixrain, abort=.false.) - call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) - call cnst_get_ind('GRAUQM', ixgrau, abort=.false.) - - ! cpairv_loc needs to be allocated to a size which matches state and ptend - ! If psetcols == pcols, cpairv is the correct size and just copy into cpairv_loc - ! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair - - if (state%psetcols == pcols) then - allocate (cpairv_loc(state%psetcols,pver,begchunk:endchunk)) - cpairv_loc(:,:,:) = cpairv(:,:,:) - else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then - allocate(cpairv_loc(state%psetcols,pver,begchunk:endchunk)) - cpairv_loc(:,:,:) = cpair - else - call endrun('check_energy_timestep_init: cpairv is not allowed to vary when subcolumns are turned on') - end if - - ! Compute vertical integrals of dry static energy (modified), kinetic energy and water (vapor, liquid, ice) - ke = 0._r8 - se = 0._r8 - wv = 0._r8 - wl = 0._r8 - wi = 0._r8 - do k = 1, pver - do i = 1, ncol - ke(i) = ke(i) + 0.5_r8*(state%u(i,k)**2 + state%v(i,k)**2)*state%pdel(i,k)/gravit - se(i) = se(i) + state%t(i,k)*cpairv_loc(i,k,lchnk)*state%pdel(i,k)/gravit - wv(i) = wv(i) + state%q(i,k,1) *state%pdel(i,k)/gravit - end do - end do - do i = 1, ncol - se(i) = se(i) + state%phis(i)*state%ps(i)/gravit - end do - - ! Don't require cloud liq/ice to be present. Allows for adiabatic/ideal phys. - if (ixcldliq > 1 .and. ixcldice > 1) then - do k = 1, pver - do i = 1, ncol - wl(i) = wl(i) + state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit - wi(i) = wi(i) + state%q(i,k,ixcldice)*state%pdel(i,k)/gravit - end do - end do - end if - - ! Don't require precip either, if microphysics doesn't add it. - if (ixrain > 1 .and. ixsnow > 1) then - do k = 1, pver - do i = 1, ncol - wl(i) = wl(i) + state%q(i,k,ixrain)*state%pdel(i,k)/gravit - wi(i) = wi(i) + state%q(i,k,ixsnow)*state%pdel(i,k)/gravit - end do - end do - end if - - ! Don't require graupel/hail either, if microphysics doesn't add it. - if (ixgrau > 1) then - do k = 1, pver - do i = 1, ncol - wi(i) = wi(i) + state%q(i,k,ixgrau)*state%pdel(i,k)/gravit - end do - end do - end if - -! Compute vertical integrals of frozen static energy and total water. - do i = 1, ncol - state%te_ini(i) = se(i) + ke(i) + (latvap+latice)*wv(i) + latice*wl(i) - state%tw_ini(i) = wv(i) + wl(i) + wi(i) - - state%te_cur(i) = state%te_ini(i) - state%tw_cur(i) = state%tw_ini(i) - end do - -! zero cummulative boundary fluxes - tend%te_tnd(:ncol) = 0._r8 - tend%tw_tnd(:ncol) = 0._r8 - - state%count = 0 - -! initialize physics buffer - if (is_first_step()) then - call pbuf_set_field(pbuf, teout_idx, state%te_ini, col_type=col_type) - end if - - deallocate(cpairv_loc) - - end subroutine check_energy_timestep_init - -!=============================================================================== - - subroutine check_energy_chng(state, tend, name, nstep, ztodt, & - flx_vap, flx_cnd, flx_ice, flx_sen) - use cam_abortutils, only: endrun - -!----------------------------------------------------------------------- -! Check that the energy and water change matches the boundary fluxes -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- - - type(physics_state) , intent(inout) :: state - type(physics_tend ) , intent(inout) :: tend - character*(*),intent(in) :: name ! parameterization name for fluxes - integer , intent(in ) :: nstep ! current timestep number - real(r8), intent(in ) :: ztodt ! 2 delta t (model time increment) - real(r8), intent(in ) :: flx_vap(:) ! (pcols) - boundary flux of vapor (kg/m2/s) - real(r8), intent(in ) :: flx_cnd(:) ! (pcols) -boundary flux of liquid+ice (m/s) (precip?) - real(r8), intent(in ) :: flx_ice(:) ! (pcols) -boundary flux of ice (m/s) (snow?) - real(r8), intent(in ) :: flx_sen(:) ! (pcols) -boundary flux of sensible heat (w/m2) - -!******************** BAB ****************************************************** -!******* Note that the precip and ice fluxes are in precip units (m/s). ******** -!******* I would prefer to have kg/m2/s. ******** -!******* I would also prefer liquid (not total) and ice fluxes ******** -!******************************************************************************* - -!---------------------------Local storage------------------------------- - - real(r8) :: te_xpd(state%ncol) ! expected value (f0 + dt*boundary_flux) - real(r8) :: te_dif(state%ncol) ! energy of input state - original energy - real(r8) :: te_tnd(state%ncol) ! tendency from last process - real(r8) :: te_rer(state%ncol) ! relative error in energy column - - real(r8) :: tw_xpd(state%ncol) ! expected value (w0 + dt*boundary_flux) - real(r8) :: tw_dif(state%ncol) ! tw_inp - original water - real(r8) :: tw_tnd(state%ncol) ! tendency from last process - real(r8) :: tw_rer(state%ncol) ! relative error in water column - - real(r8) :: ke(state%ncol) ! vertical integral of kinetic energy - real(r8) :: se(state%ncol) ! vertical integral of static energy - real(r8) :: wv(state%ncol) ! vertical integral of water (vapor) - real(r8) :: wl(state%ncol) ! vertical integral of water (liquid) - real(r8) :: wi(state%ncol) ! vertical integral of water (ice) - - real(r8) :: te(state%ncol) ! vertical integral of total energy - real(r8) :: tw(state%ncol) ! vertical integral of total water - - real(r8),allocatable :: cpairv_loc(:,:,:) - - integer lchnk ! chunk identifier - integer ncol ! number of atmospheric columns - integer i,k ! column, level indices - integer :: ixcldice, ixcldliq ! CLDICE and CLDLIQ indices - integer :: ixrain, ixsnow ! RAINQM and SNOWQM indices - integer :: ixgrau ! GRAUQM index -!----------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - call cnst_get_ind('RAINQM', ixrain, abort=.false.) - call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) - call cnst_get_ind('GRAUQM', ixgrau, abort=.false.) - - ! cpairv_loc needs to be allocated to a size which matches state and ptend - ! If psetcols == pcols, cpairv is the correct size and just copy into cpairv_loc - ! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair - - if (state%psetcols == pcols) then - allocate (cpairv_loc(state%psetcols,pver,begchunk:endchunk)) - cpairv_loc(:,:,:) = cpairv(:,:,:) - else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then - allocate(cpairv_loc(state%psetcols,pver,begchunk:endchunk)) - cpairv_loc(:,:,:) = cpair - else - call endrun('check_energy_chng: cpairv is not allowed to vary when subcolumns are turned on') - end if - - ! Compute vertical integrals of dry static energy (modified), kinetic energy and water (vapor, liquid, ice) - ke = 0._r8 - se = 0._r8 - wv = 0._r8 - wl = 0._r8 - wi = 0._r8 - do k = 1, pver - do i = 1, ncol - ke(i) = ke(i) + 0.5_r8*(state%u(i,k)**2 + state%v(i,k)**2)*state%pdel(i,k)/gravit - se(i) = se(i) + state%t(i,k)*cpairv_loc(i,k,lchnk)*state%pdel(i,k)/gravit - wv(i) = wv(i) + state%q(i,k,1) *state%pdel(i,k)/gravit - end do - end do - do i = 1, ncol - se(i) = se(i) + state%phis(i)*state%ps(i)/gravit - end do - - ! Don't require cloud liq/ice to be present. Allows for adiabatic/ideal phys. - if (ixcldliq > 1 .and. ixcldice > 1) then - do k = 1, pver - do i = 1, ncol - wl(i) = wl(i) + state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit - wi(i) = wi(i) + state%q(i,k,ixcldice)*state%pdel(i,k)/gravit - end do - end do - end if - - ! Don't require precip either, if microphysics doesn't add it. - if (ixrain > 1 .and. ixsnow > 1) then - do k = 1, pver - do i = 1, ncol - wl(i) = wl(i) + state%q(i,k,ixrain)*state%pdel(i,k)/gravit - wi(i) = wi(i) + state%q(i,k,ixsnow)*state%pdel(i,k)/gravit - end do - end do - end if - - ! Don't require graupel/hail either, if microphysics doesn't add it. - if (ixgrau > 1) then - do k = 1, pver - do i = 1, ncol - wi(i) = wi(i) + state%q(i,k,ixgrau)*state%pdel(i,k)/gravit - end do - end do - end if - - ! Compute vertical integrals of frozen static energy and total water. - do i = 1, ncol - te(i) = se(i) + ke(i) + (latvap+latice)*wv(i) + latice*wl(i) - tw(i) = wv(i) + wl(i) + wi(i) - end do - - ! compute expected values and tendencies - do i = 1, ncol - ! change in static energy and total water - te_dif(i) = te(i) - state%te_cur(i) - tw_dif(i) = tw(i) - state%tw_cur(i) - - ! expected tendencies from boundary fluxes for last process - te_tnd(i) = flx_vap(i)*(latvap+latice) - (flx_cnd(i) - flx_ice(i))*1000._r8*latice + flx_sen(i) - tw_tnd(i) = flx_vap(i) - flx_cnd(i) *1000._r8 - - ! cummulative tendencies from boundary fluxes - tend%te_tnd(i) = tend%te_tnd(i) + te_tnd(i) - tend%tw_tnd(i) = tend%tw_tnd(i) + tw_tnd(i) - - ! expected new values from previous state plus boundary fluxes - te_xpd(i) = state%te_cur(i) + te_tnd(i)*ztodt - tw_xpd(i) = state%tw_cur(i) + tw_tnd(i)*ztodt - - ! relative error, expected value - input state / previous state - te_rer(i) = (te_xpd(i) - te(i)) / state%te_cur(i) - end do - - ! relative error for total water (allow for dry atmosphere) - tw_rer = 0._r8 - where (state%tw_cur(:ncol) > 0._r8) - tw_rer(:ncol) = (tw_xpd(:ncol) - tw(:ncol)) / state%tw_cur(:ncol) - end where - - ! error checking - if (print_energy_errors) then - if (any(abs(te_rer(1:ncol)) > 1.E-14_r8 .or. abs(tw_rer(1:ncol)) > 1.E-10_r8)) then - do i = 1, ncol - ! the relative error threshold for the water budget has been reduced to 1.e-10 - ! to avoid messages generated by QNEG3 calls - ! PJR- change to identify if error in energy or water - if (abs(te_rer(i)) > 1.E-14_r8 ) then - state%count = state%count + 1 - write(iulog,*) "significant energy conservation error after ", name, & - " count", state%count, " nstep", nstep, "chunk", lchnk, "col", i - write(iulog,*) te(i),te_xpd(i),te_dif(i),tend%te_tnd(i)*ztodt, & - te_tnd(i)*ztodt,te_rer(i) - endif - if ( abs(tw_rer(i)) > 1.E-10_r8) then - state%count = state%count + 1 - write(iulog,*) "significant water conservation error after ", name, & - " count", state%count, " nstep", nstep, "chunk", lchnk, "col", i - write(iulog,*) tw(i),tw_xpd(i),tw_dif(i),tend%tw_tnd(i)*ztodt, & - tw_tnd(i)*ztodt,tw_rer(i) - end if - end do - end if - end if - - ! copy new value to state - do i = 1, ncol - state%te_cur(i) = te(i) - state%tw_cur(i) = tw(i) - end do - - deallocate(cpairv_loc) - - end subroutine check_energy_chng - - -!=============================================================================== - subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) - - use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk - -!----------------------------------------------------------------------- -! Compute global mean total energy of physics input and output states -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- - - type(physics_state), intent(in ), dimension(begchunk:endchunk) :: state - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - real(r8), intent(in) :: dtime ! physics time step - integer , intent(in) :: nstep ! current timestep number - -!---------------------------Local storage------------------------------- - integer :: ncol ! number of active columns - integer :: lchnk ! chunk index - - real(r8) :: te(pcols,begchunk:endchunk,3) - ! total energy of input/output states (copy) - real(r8) :: te_glob(3) ! global means of total energy - real(r8), pointer :: teout(:) -!----------------------------------------------------------------------- - - ! Copy total energy out of input and output states - do lchnk = begchunk, endchunk - ncol = state(lchnk)%ncol - ! input energy - te(:ncol,lchnk,1) = state(lchnk)%te_ini(:ncol) - ! output energy - call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk),teout_idx, teout) - - te(:ncol,lchnk,2) = teout(1:ncol) - ! surface pressure for heating rate - te(:ncol,lchnk,3) = state(lchnk)%pint(:ncol,pver+1) - end do - - ! Compute global means of input and output energies and of - ! surface pressure for heating rate (assume uniform ptop) - call gmean(te, te_glob, 3) - - if (begchunk .le. endchunk) then - teinp_glob = te_glob(1) - teout_glob = te_glob(2) - psurf_glob = te_glob(3) - ptopb_glob = state(begchunk)%pint(1,1) - - ! Global mean total energy difference - tedif_glob = teinp_glob - teout_glob - heat_glob = -tedif_glob/dtime * gravit / (psurf_glob - ptopb_glob) - - if (masterproc) then - write(iulog,'(1x,a9,1x,i8,4(1x,e25.17))') "nstep, te", nstep, teinp_glob, teout_glob, heat_glob, psurf_glob - end if - else - heat_glob = 0._r8 - end if ! (begchunk .le. endchunk) - - end subroutine check_energy_gmean - -!=============================================================================== - subroutine check_energy_fix(state, ptend, nstep, eshflx) - -!----------------------------------------------------------------------- -! Add heating rate required for global mean total energy conservation -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- - - type(physics_state), intent(in ) :: state - type(physics_ptend), intent(out) :: ptend - - integer , intent(in ) :: nstep ! time step number - real(r8), intent(out ) :: eshflx(pcols) ! effective sensible heat flux - -!---------------------------Local storage------------------------------- - integer :: i ! column - integer :: ncol ! number of atmospheric columns in chunk -!----------------------------------------------------------------------- - ncol = state%ncol - - call physics_ptend_init(ptend, state%psetcols, 'chkenergyfix', ls=.true.) - -#if ( defined OFFLINE_DYN ) - ! disable the energy fix for offline driver - heat_glob = 0._r8 -#endif -! add (-) global mean total energy difference as heating - ptend%s(:ncol,:pver) = heat_glob -!!$ write(iulog,*) "chk_fix: heat", state%lchnk, ncol, heat_glob - -! compute effective sensible heat flux - do i = 1, ncol - eshflx(i) = heat_glob * (state%pint(i,pver+1) - state%pint(i,1)) / gravit - end do -!!! if (nstep > 0) write(iulog,*) "heat", heat_glob, eshflx(1) - - return - end subroutine check_energy_fix - - !=============================================================================== subroutine check_tracers_init(state, tracerint) @@ -675,7 +250,7 @@ subroutine check_tracers_init(state, tracerint) tr = 0._r8 do k = 1, pver do i = 1, ncol - tr(i) = tr(i) + state%q(i,k,m)*trpdel(i,k)/gravit + tr(i) = tr(i) + state%q(i,k,m)*trpdel(i,k)*rga end do end do @@ -738,7 +313,6 @@ subroutine check_tracers_chng(state, tracerint, name, nstep, ztodt, cflx) integer :: m ! tracer index character(len=8) :: tracname ! tracername !----------------------------------------------------------------------- -!!$ if (.true.) return lchnk = state%lchnk ncol = state%ncol @@ -764,7 +338,7 @@ subroutine check_tracers_chng(state, tracerint, name, nstep, ztodt, cflx) tr = 0._r8 do k = 1, pver do i = 1, ncol - tr(i) = tr(i) + state%q(i,k,m)*trpdel(i,k)/gravit + tr(i) = tr(i) + state%q(i,k,m)*trpdel(i,k)*rga end do end do @@ -836,127 +410,122 @@ end subroutine check_tracers_chng !####################################################################### - subroutine calc_te_and_aam_budgets(state, outfld_name_suffix) - use physconst, only: gravit,cpair,pi,rearth,omega - use cam_history, only: hist_fld_active, outfld - + subroutine tot_energy_phys(state, outfld_name_suffix,vc) + use physconst, only: rga,rearth,omega + use cam_thermo, only: get_hydrostatic_energy,thermo_budget_num_vars,thermo_budget_vars, & + wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx + use cam_history, only: outfld + use dyn_tests_utils, only: vc_physics + use cam_thermo_formula, only: ENERGY_FORMULA_DYCORE_SE, ENERGY_FORMULA_DYCORE_MPAS + + use cam_abortutils, only: endrun + use cam_history_support, only: max_fieldname_len + use cam_budget, only: thermo_budget_history !------------------------------Arguments-------------------------------- type(physics_state), intent(inout) :: state - character*(*),intent(in) :: outfld_name_suffix ! suffix for "outfld" names + character(len=*), intent(in) :: outfld_name_suffix ! suffix for "outfld" + integer, optional, intent(in) :: vc ! vertical coordinate (controls energy formula to use) !---------------------------Local storage------------------------------- - real(r8) :: se(pcols) ! Dry Static energy (J/m2) + real(r8) :: po(pcols) ! surface potential or potential energy (J/m2) real(r8) :: ke(pcols) ! kinetic energy (J/m2) real(r8) :: wv(pcols) ! column integrated vapor (kg/m2) - real(r8) :: wl(pcols) ! column integrated liquid (kg/m2) - real(r8) :: wi(pcols) ! column integrated ice (kg/m2) + real(r8) :: liq(pcols) ! column integrated liquid (kg/m2) + real(r8) :: ice(pcols) ! column integrated ice (kg/m2) real(r8) :: tt(pcols) ! column integrated test tracer (kg/m2) real(r8) :: mr(pcols) ! column integrated wind axial angular momentum (kg*m2/s) real(r8) :: mo(pcols) ! column integrated mass axial angular momentum (kg*m2/s) - real(r8) :: se_tmp,ke_tmp,wv_tmp,wl_tmp,wi_tmp,tt_tmp,mr_tmp,mo_tmp,cos_lat + real(r8) :: tt_tmp,mr_tmp,mo_tmp,cos_lat real(r8) :: mr_cnst, mo_cnst + real(r8) :: cp_or_cv(pcols,pver) ! cp for pressure-based vcoord and cv for height vcoord + real(r8) :: temp(pcols,pver) ! temperature + real(r8) :: scaling(pcols,pver) ! scaling for conversion of temperature increment + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: i,k ! column, level indices + integer :: vc_loc ! local vertical coordinate variable + integer :: ixtt ! test tracer index + character(len=max_fieldname_len) :: name_out(thermo_budget_num_vars) - integer lchnk ! chunk identifier - integer ncol ! number of atmospheric columns - integer i,k ! column, level indices - integer :: ixcldice, ixcldliq,ixtt ! CLDICE and CLDLIQ indices - character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 !----------------------------------------------------------------------- - name_out1 = 'SE_' //trim(outfld_name_suffix) - name_out2 = 'KE_' //trim(outfld_name_suffix) - name_out3 = 'WV_' //trim(outfld_name_suffix) - name_out4 = 'WL_' //trim(outfld_name_suffix) - name_out5 = 'WI_' //trim(outfld_name_suffix) - name_out6 = 'TT_' //trim(outfld_name_suffix) - - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& - hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then - - lchnk = state%lchnk - ncol = state%ncol - call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) - call cnst_get_ind('TT_LW' , ixtt , abort=.false.) - - ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid - - se = 0._r8 - ke = 0._r8 - wv = 0._r8 - wl = 0._r8 - wi = 0._r8 - tt = 0._r8 - - do k = 1, pver - do i = 1, ncol - ke_tmp = 0.5_r8*(state%u(i,k)**2 + state%v(i,k)**2)*state%pdel(i,k)/gravit - se_tmp = cpair*state%t(i,k) *state%pdel(i,k)/gravit - wv_tmp = state%q(i,k,1 ) *state%pdel(i,k)/gravit - - se (i) = se (i) + se_tmp - ke (i) = ke (i) + ke_tmp - wv (i) = wv (i) + wv_tmp - end do - end do - do i = 1, ncol - se(i) = se(i) + state%phis(i)*state%ps(i)/gravit - end do + if (.not.thermo_budget_history) return + + do i=1,thermo_budget_num_vars + name_out(i)=trim(thermo_budget_vars(i))//'_'//trim(outfld_name_suffix) + end do + + lchnk = state%lchnk + ncol = state%ncol - ! Don't require cloud liq/ice to be present. Allows for adiabatic/ideal phys. + ! The "vertical coordinate" parameter is equivalent to the dynamical core + ! energy formula parameter, which controls the dycore energy formula used + ! by get_hydrostatic_energy. + if (present(vc)) then + vc_loc = vc + else + vc_loc = vc_physics + end if - if (ixcldliq > 1) then + if (state%psetcols == pcols) then + if (vc_loc == ENERGY_FORMULA_DYCORE_MPAS .or. vc_loc == ENERGY_FORMULA_DYCORE_SE) then + cp_or_cv(:ncol,:) = cp_or_cv_dycore(:ncol,:,lchnk) + else + cp_or_cv(:ncol,:) = cpairv(:ncol,:,lchnk) + end if + else + call endrun('tot_energy_phys: energy diagnostics not implemented/tested for subcolumns') + end if + + if (vc_loc == ENERGY_FORMULA_DYCORE_MPAS .or. vc_loc == ENERGY_FORMULA_DYCORE_SE) then + scaling(:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv(:ncol,:)!scaling for energy consistency + else + scaling(:ncol,:) = 1.0_r8 !internal energy / enthalpy same as CAM physics + end if + ! scale accumulated temperature increment for internal energy / enthalpy consistency + 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), & + state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), temp(1:ncol,1:pver), & + vc_loc, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol), & + z_mid = state%z_ini(1:ncol,:), se = se(1:ncol), & + po = po(1:ncol), ke = ke(1:ncol), wv = wv(1:ncol), liq = liq(1:ncol), & + ice = ice(1:ncol)) + + call cnst_get_ind('TT_LW' , ixtt , abort=.false.) + tt = 0._r8 + if (ixtt > 1) then + if (name_out(ttidx) == 'TT_pAM'.or.name_out(ttidx) == 'TT_zAM') then + ! + ! after dme_adjust mixing ratios are all wet + ! do k = 1, pver do i = 1, ncol - wl_tmp = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit - wl (i) = wl(i) + wl_tmp + tt_tmp = state%q(i,k,ixtt)*state%pdel(i,k)*rga + tt (i) = tt(i) + tt_tmp end do end do - end if - - if (ixcldice > 1) then + else do k = 1, pver do i = 1, ncol - wi_tmp = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit - wi(i) = wi(i) + wi_tmp + tt_tmp = state%q(i,k,ixtt)*state%pdeldry(i,k)*rga + tt (i) = tt(i) + tt_tmp end do end do end if - - if (ixtt > 1) then - if (name_out6 == 'TT_pAM') then - ! - ! after dme_adjust mixing ratios are all wet - ! - do k = 1, pver - do i = 1, ncol - tt_tmp = state%q(i,k,ixtt)*state%pdel(i,k)/gravit - tt (i) = tt(i) + tt_tmp - end do - end do - else - do k = 1, pver - do i = 1, ncol - tt_tmp = state%q(i,k,ixtt)*state%pdeldry(i,k)/gravit - tt (i) = tt(i) + tt_tmp - end do - end do - end if - end if - - ! Output energy diagnostics - - call outfld(name_out1 ,se , pcols ,lchnk ) - call outfld(name_out2 ,ke , pcols ,lchnk ) - call outfld(name_out3 ,wv , pcols ,lchnk ) - call outfld(name_out4 ,wl , pcols ,lchnk ) - call outfld(name_out5 ,wi , pcols ,lchnk ) - call outfld(name_out6 ,tt , pcols ,lchnk ) end if - + call outfld(name_out(seidx) ,se , pcols ,lchnk ) + call outfld(name_out(poidx) ,po , pcols ,lchnk ) + call outfld(name_out(keidx) ,ke , pcols ,lchnk ) + call outfld(name_out(wvidx) ,wv , pcols ,lchnk ) + call outfld(name_out(wlidx) ,liq , pcols ,lchnk ) + call outfld(name_out(wiidx) ,ice , pcols ,lchnk ) + call outfld(name_out(ttidx) ,tt , pcols ,lchnk ) + call outfld(name_out(teidx) ,se+ke+po, pcols ,lchnk ) ! ! Axial angular momentum diagnostics ! @@ -970,29 +539,385 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix) ! 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) ! - name_out1 = 'MR_' //trim(outfld_name_suffix) - name_out2 = 'MO_' //trim(outfld_name_suffix) - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then - lchnk = state%lchnk - ncol = state%ncol + mr_cnst = rga*rearth**3 + mo_cnst = rga*omega*rearth**4 - mr_cnst = rearth**3/gravit - mo_cnst = omega*rearth**4/gravit - do k = 1, pver - do i = 1, ncol + mr = 0.0_r8 + mo = 0.0_r8 + do k = 1, pver + do i = 1, ncol 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_out1 ,mr, pcols,lchnk ) - call outfld(name_out1 ,mo, pcols,lchnk ) + end do + end do + + call outfld(name_out(mridx) ,mr, pcols,lchnk ) + call outfld(name_out(moidx) ,mo, pcols,lchnk ) + + end subroutine tot_energy_phys + + ! Compute global mean total energy of physics input and output states + ! computed consistently with dynamical core vertical coordinate + ! (under hydrostatic assumption) + ! + ! This subroutine cannot use the CCPP-ized equivalent because + ! it is dependent on chunks. + 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 ppgrid, only: begchunk, endchunk + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use gmean_mod, only: gmean + use physconst, only: gravit + + type(physics_state), intent(in), dimension(begchunk:endchunk) :: state + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + real(r8), intent(in) :: dtime ! physics time step + integer , intent(in) :: nstep ! current timestep number + + integer :: ncol ! number of active columns + integer :: lchnk ! chunk index + + real(r8) :: te(pcols,begchunk:endchunk,4) + ! total energy of input/output states (copy) + real(r8) :: te_glob(4) ! global means of total energy + real(r8), pointer :: teout(:) + + ! Copy total energy out of input and output states + do lchnk = begchunk, endchunk + ncol = state(lchnk)%ncol + ! input energy using dynamical core energy formula + te(:ncol,lchnk,1) = state(lchnk)%te_ini(:ncol,dyn_te_idx) + ! output energy + call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk),teout_idx, teout) + + te(:ncol,lchnk,2) = teout(1:ncol) + ! surface pressure for heating rate + te(:ncol,lchnk,3) = state(lchnk)%pint(:ncol,pver+1) + ! model top pressure for heating rate (not constant for z-based vertical coordinate!) + te(:ncol,lchnk,4) = state(lchnk)%pint(:ncol,1) + end do + + ! Compute global means of input and output energies and of + ! surface pressure for heating rate (assume uniform ptop) + call gmean(te, te_glob, 4) + + if (begchunk .le. endchunk) then + teinp_glob = te_glob(1) + teout_glob = te_glob(2) + psurf_glob = te_glob(3) + ptopb_glob = te_glob(4) + + ! Global mean total energy difference + tedif_glob = teinp_glob - teout_glob + heat_glob = -tedif_glob/dtime * gravit / (psurf_glob - ptopb_glob) + if (masterproc) then + write(iulog,'(1x,a9,1x,i8,5(1x,e25.17))') "nstep, te", nstep, teinp_glob, teout_glob, & + heat_glob, psurf_glob, ptopb_glob + end if + else + heat_glob = 0._r8 + end if ! (begchunk .le. endchunk) + + end subroutine check_energy_gmean + + ! Return energy integrals (module variables) + subroutine check_energy_get_integrals(tedif_glob_out, heat_glob_out) + real(r8), intent(out), optional :: tedif_glob_out + real(r8), intent(out), optional :: heat_glob_out + + if ( present(tedif_glob_out) ) then + tedif_glob_out = tedif_glob + endif + + if ( present(heat_glob_out) ) then + heat_glob_out = heat_glob + endif + end subroutine check_energy_get_integrals + + ! Compute initial values of energy and water integrals, + ! zero cumulative tendencies + subroutine check_energy_timestep_init(state, tend, pbuf, col_type) + use physics_buffer, only: physics_buffer_desc, pbuf_set_field + use cam_abortutils, only: endrun + use dyn_tests_utils, only: vc_physics, vc_dycore + use cam_thermo_formula, only: ENERGY_FORMULA_DYCORE_SE, ENERGY_FORMULA_DYCORE_MPAS + use physics_types, only: physics_tend + use physics_types, only: phys_te_idx, dyn_te_idx + use time_manager, only: is_first_step + use physconst, only: cpair, rair + use air_composition, only: cpairv, cp_or_cv_dycore + + ! CCPP-ized subroutine + use check_energy_chng, only: check_energy_chng_timestep_init + + type(physics_state), intent(inout) :: state + type(physics_tend ), intent(inout) :: tend + type(physics_buffer_desc), pointer :: pbuf(:) + integer, optional :: col_type ! Flag indicating whether using grid or subcolumns + + real(r8) :: local_cp_phys(state%psetcols,pver) + real(r8) :: local_cp_or_cv_dycore(state%psetcols,pver) + real(r8) :: teout(state%ncol) ! dummy teout argument + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + character(len=512) :: errmsg + integer :: errflg + + lchnk = state%lchnk + ncol = state%ncol + + ! The code below is split into not-subcolumns and subcolumns code, as there is different handling of the + ! cp passed into the hydrostatic energy call. CAM-SIMA does not support subcolumns, so we keep this special + ! handling inside this CAM interface. (hplin, 9/9/24) + if(state%psetcols == pcols) then + ! No subcolumns + local_cp_phys(:ncol,:) = cpairv(:ncol,:,lchnk) + local_cp_or_cv_dycore(:ncol,:) = cp_or_cv_dycore(:ncol,:,lchnk) + else if (state%psetcols > pcols) then + ! Subcolumns code + ! Subcolumns specific error handling + if(.not. all(cpairv(:,:,lchnk) == cpair)) then + call endrun('check_energy_timestep_init: cpairv is not allowed to vary when subcolumns are turned on') + endif + + local_cp_phys(1:ncol,:) = cpair + + if (vc_dycore == ENERGY_FORMULA_DYCORE_MPAS) then + ! MPAS specific hydrostatic energy computation (internal energy) + local_cp_or_cv_dycore(:ncol,:) = cpair-rair + else if(vc_dycore == ENERGY_FORMULA_DYCORE_SE) then + ! SE specific hydrostatic energy (enthalpy) + local_cp_or_cv_dycore(:ncol,:) = cpair + else + ! cp_or_cv is not used in the underlying subroutine, zero it out to be sure + local_cp_or_cv_dycore(:ncol,:) = 0.0_r8 + endif + end if + + ! Call CCPP-ized underlying subroutine. + call check_energy_chng_timestep_init( & + ncol = ncol, & + pver = pver, & + pcnst = pcnst, & + is_first_timestep = is_first_step(), & + q = state%q(1:ncol,1:pver,1:pcnst), & + pdel = state%pdel(1:ncol,1:pver), & + u = state%u(1:ncol,1:pver), & + v = state%v(1:ncol,1:pver), & + T = state%T(1:ncol,1:pver), & + pintdry = state%pintdry(1:ncol,1:pver), & + phis = state%phis(1:ncol), & + zm = state%zm(1:ncol,:), & + cp_phys = local_cp_phys(1:ncol,:), & + cp_or_cv_dycore = local_cp_or_cv_dycore(1:ncol,:), & + te_ini_phys = state%te_ini(1:ncol,phys_te_idx), & + te_ini_dyn = state%te_ini(1:ncol,dyn_te_idx), & + tw_ini = state%tw_ini(1:ncol), & + te_cur_phys = state%te_cur(1:ncol,phys_te_idx), & + te_cur_dyn = state%te_cur(1:ncol,dyn_te_idx), & + tw_cur = state%tw_cur(1:ncol), & + tend_te_tnd = tend%te_tnd(1:ncol), & + tend_tw_tnd = tend%tw_tnd(1:ncol), & + temp_ini = state%temp_ini(:ncol,:), & + z_ini = state%z_ini(:ncol,:), & + count = state%count, & + teout = teout(1:ncol), & ! dummy argument - actual teout written to pbuf directly below + energy_formula_physics = vc_physics, & + energy_formula_dycore = vc_dycore, & + errmsg = errmsg, & + errflg = errflg & + ) + + ! initialize physics buffer + if (is_first_step()) then + call pbuf_set_field(pbuf, teout_idx, state%te_ini(:,dyn_te_idx), col_type=col_type) end if - end subroutine calc_te_and_aam_budgets + end subroutine check_energy_timestep_init + + ! Check that the energy and water change matches the boundary fluxes + subroutine check_energy_cam_chng(state, tend, name, nstep, ztodt, & + flx_vap, flx_cnd, flx_ice, flx_sen) + use dyn_tests_utils, only: vc_physics, vc_dycore + use cam_thermo_formula, only: ENERGY_FORMULA_DYCORE_SE, ENERGY_FORMULA_DYCORE_MPAS + use cam_abortutils, only: endrun + use physics_types, only: phys_te_idx, dyn_te_idx + use physics_types, only: physics_tend + use physconst, only: cpair, rair, latice, latvap + use air_composition, only: cpairv, cp_or_cv_dycore + + ! CCPP-ized subroutine + use check_energy_chng, only: check_energy_chng_run + type(physics_state), intent(inout) :: state + type(physics_tend ), intent(inout) :: tend + character*(*),intent(in) :: name ! parameterization name for fluxes + integer , intent(in) :: nstep ! current timestep number + real(r8), intent(in) :: ztodt ! physics timestep (s) + real(r8), intent(in) :: flx_vap(:) ! (pcols) - boundary flux of vapor (kg/m2/s) + real(r8), intent(in) :: flx_cnd(:) ! (pcols) - boundary flux of lwe liquid+ice (m/s) + real(r8), intent(in) :: flx_ice(:) ! (pcols) - boundary flux of lwe ice (m/s) + real(r8), intent(in) :: flx_sen(:) ! (pcols) - boundary flux of sensible heat (W/m2) + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + real(r8) :: local_cp_phys(state%psetcols,pver) + real(r8) :: local_cp_or_cv_dycore(state%psetcols,pver) + real(r8) :: scaling_dycore(state%ncol,pver) + character(len=512) :: errmsg + integer :: errflg + + lchnk = state%lchnk + ncol = state%ncol + + if(state%psetcols == pcols) then + ! No subcolumns + local_cp_phys(:ncol,:) = cpairv(:ncol,:,lchnk) + + ! Only if using MPAS or SE energy formula cp_or_cv_dycore is nonzero. + if(vc_dycore == ENERGY_FORMULA_DYCORE_MPAS .or. vc_dycore == ENERGY_FORMULA_DYCORE_SE) then + local_cp_or_cv_dycore(:ncol,:) = cp_or_cv_dycore(:ncol,:,lchnk) + + scaling_dycore(:ncol,:) = cpairv(:ncol,:,lchnk)/local_cp_or_cv_dycore(:ncol,:) ! cp/cv scaling + endif + else if(state%psetcols > pcols) then + ! Subcolumns + if(.not. all(cpairv(:,:,:) == cpair)) then + call endrun('check_energy_chng: cpairv is not allowed to vary when subcolumns are turned on') + endif + + local_cp_phys(:,:) = cpair + + ! Note: cp_or_cv set above for pressure coordinate + if (vc_dycore == ENERGY_FORMULA_DYCORE_MPAS) then + ! compute cv if vertical coordinate is height: cv = cp - R + local_cp_or_cv_dycore(:ncol,:) = cpair-rair + scaling_dycore(:ncol,:) = cpairv(:ncol,:,lchnk)/local_cp_or_cv_dycore(:ncol,:) ! cp/cv scaling + else if (vc_dycore == ENERGY_FORMULA_DYCORE_SE) then + ! SE specific hydrostatic energy + local_cp_or_cv_dycore(:ncol,:) = cpair + scaling_dycore(:ncol,:) = 1.0_r8 + else + ! Moist pressure... use phys formula, cp_or_cv_dycore is unused. Reset for safety + local_cp_or_cv_dycore(:ncol,:) = 0.0_r8 + scaling_dycore(:ncol,:) = 0.0_r8 + end if + endif + + ! Call CCPP-ized underlying subroutine. + call check_energy_chng_run( & + ncol = ncol, & + pver = pver, & + pcnst = pcnst, & + iulog = iulog, & + q = state%q(1:ncol,1:pver,1:pcnst), & + pdel = state%pdel(1:ncol,1:pver), & + u = state%u(1:ncol,1:pver), & + v = state%v(1:ncol,1:pver), & + T = state%T(1:ncol,1:pver), & + pintdry = state%pintdry(1:ncol,1:pver), & + phis = state%phis(1:ncol), & + zm = state%zm(1:ncol,:), & + cp_phys = local_cp_phys(1:ncol,:), & + cp_or_cv_dycore = local_cp_or_cv_dycore(1:ncol,:), & + scaling_dycore = scaling_dycore(1:ncol,:), & + te_cur_phys = state%te_cur(1:ncol,phys_te_idx), & + te_cur_dyn = state%te_cur(1:ncol,dyn_te_idx), & + tw_cur = state%tw_cur(1:ncol), & + tend_te_tnd = tend%te_tnd(1:ncol), & + tend_tw_tnd = tend%tw_tnd(1:ncol), & + temp_ini = state%temp_ini(:ncol,:), & + z_ini = state%z_ini(:ncol,:), & + count = state%count, & + ztodt = ztodt, & + latice = latice, & + latvap = latvap, & + energy_formula_physics = vc_physics, & + energy_formula_dycore = vc_dycore, & + name = name, & + flx_vap = flx_vap, & + flx_cnd = flx_cnd, & + flx_ice = flx_ice, & + flx_sen = flx_sen, & + errmsg = errmsg, & + errflg = errflg & + ) + + end subroutine check_energy_cam_chng + + ! Add heating rate required for global mean total energy conservation + subroutine check_energy_cam_fix(state, ptend, nstep, eshflx) + use physics_types, only: physics_ptend, physics_ptend_init + use physconst, only: gravit + + ! SCAM support + use scamMod, only: single_column, use_camiop, heat_glob_scm + use cam_history, only: write_camiop + use cam_history, only: outfld + + ! CCPP-ized subroutine + use check_energy_fix, only: check_energy_fix_run + + type(physics_state), intent(in) :: state + type(physics_ptend), intent(out) :: ptend + + integer , intent(in) :: nstep ! time step number + real(r8), intent(out) :: eshflx(pcols) ! effective sensible heat flux + + integer :: ncol ! number of atmospheric columns in chunk + integer :: lchnk ! chunk number + real(r8) :: heat_out(pcols) + character(len=64) :: dummy_scheme_name ! dummy scheme name for CCPP-ized scheme + + integer :: errflg + character(len=512) :: errmsg + + lchnk = state%lchnk + ncol = state%ncol + + call physics_ptend_init(ptend, state%psetcols, 'chkenergyfix', ls=.true.) + +#if ( defined OFFLINE_DYN ) + ! disable the energy fix for offline driver + heat_glob = 0._r8 +#endif + + ! 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 + + if (nstep > 0 .and. write_camiop) then + heat_out(:ncol) = heat_glob + call outfld('heat_glob', heat_out(:ncol), pcols, lchnk) + endif + + ! Call the CCPP-ized subroutine (for non-SCAM) + ! to compute the effective sensible heat flux and save to ptend%s + call check_energy_fix_run( & + ncol = ncol, & + pver = pver, & + pint = state%pint(:ncol,:), & + gravit = gravit, & + heat_glob = heat_glob, & + ptend_s = ptend%s(:ncol,:), & + eshflx = eshflx(:ncol), & + scheme_name = dummy_scheme_name, & + errmsg = errmsg, & + errflg = errflg & + ) + + end subroutine check_energy_cam_fix end module check_energy 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/cldfrc2m.F90 b/src/physics/cam/cldfrc2m.F90 index daef9ed9b0..77a391fd35 100644 --- a/src/physics/cam/cldfrc2m.F90 +++ b/src/physics/cam/cldfrc2m.F90 @@ -6,7 +6,8 @@ module cldfrc2m use spmd_utils, only: masterproc use ppgrid, only: pcols use physconst, only: rair -use wv_saturation, only: qsat_water, svp_water, svp_ice +use wv_saturation, only: qsat_water, svp_water, svp_ice, & + svp_water_vect, svp_ice_vect use cam_logfile, only: iulog use cam_abortutils, only: endrun @@ -34,18 +35,18 @@ module cldfrc2m real(r8) :: cldfrc2m_rhmaxi real(r8) :: cldfrc2m_rhminis ! Minimum rh for ice cloud fraction > 0 in the stratsophere. real(r8) :: cldfrc2m_rhmaxis +real(r8) :: cldfrc2m_qist_min ! Minimum in-stratus IWC constraint [ kg/kg ] +real(r8) :: cldfrc2m_qist_max ! Maximum in-stratus IWC constraint [ kg/kg ] logical :: cldfrc2m_do_subgrid_growth = .false. +logical :: cldfrc2m_do_avg_aist_algs = .false. ! -------------------------- ! ! Parameters for Ice Stratus ! ! -------------------------- ! real(r8), protected :: rhmini_const ! Minimum rh for ice cloud fraction > 0. real(r8), protected :: rhmaxi_const -real(r8), protected :: rhminis_const ! Minimum rh for ice cloud fraction > 0. +real(r8), protected :: rhminis_const ! Minimum rh for ice cloud fraction > 0. real(r8), protected :: rhmaxis_const -real(r8), parameter :: qist_min = 1.e-7_r8 ! Minimum in-stratus ice IWC constraint [ kg/kg ] -real(r8), parameter :: qist_max = 5.e-3_r8 ! Maximum in-stratus ice IWC constraint [ kg/kg ] - ! ----------------------------- ! ! Parameters for Liquid Stratus ! ! ----------------------------- ! @@ -58,10 +59,10 @@ module cldfrc2m real(r8) :: rhminh_const ! Critical RH for high-level liquid stratus clouds real(r8) :: premit ! Top height for mid-level liquid stratus fraction real(r8) :: premib ! Bottom height for mid-level liquid stratus fraction -integer :: iceopt ! option for ice cloud closure - ! 1=wang & sassen 2=schiller (iciwc) +integer :: iceopt ! option for ice cloud closure + ! 1=wang & sassen 2=schiller (iciwc) ! 3=wood & field, 4=Wilson (based on smith) - ! 5=modified slingo (ssat & empyt cloud) + ! 5=modified slingo (ssat & empyt cloud) real(r8) :: icecrit ! Critical RH for ice clouds in Wilson & Ballard closure ! ( smaller = more ice clouds ) @@ -81,7 +82,8 @@ subroutine cldfrc2m_readnl(nlfile) integer :: unitn, ierr character(len=*), parameter :: subname = 'cldfrc2m_readnl' - namelist /cldfrc2m_nl/ cldfrc2m_rhmini, cldfrc2m_rhmaxi, cldfrc2m_rhminis, cldfrc2m_rhmaxis, cldfrc2m_do_subgrid_growth + namelist /cldfrc2m_nl/ cldfrc2m_rhmini, cldfrc2m_rhmaxi, cldfrc2m_rhminis, cldfrc2m_rhmaxis, cldfrc2m_do_subgrid_growth, & + cldfrc2m_qist_min, cldfrc2m_qist_max, cldfrc2m_do_avg_aist_algs !----------------------------------------------------------------------------- if (masterproc) then @@ -102,7 +104,6 @@ subroutine cldfrc2m_readnl(nlfile) rhmaxi_const = cldfrc2m_rhmaxi rhminis_const = cldfrc2m_rhminis rhmaxis_const = cldfrc2m_rhmaxis - end if ! Broadcast namelist variables @@ -110,7 +111,10 @@ subroutine cldfrc2m_readnl(nlfile) call mpi_bcast(rhmaxi_const, 1, mpi_real8, masterprocid, mpicom, ierr) call mpi_bcast(rhminis_const, 1, mpi_real8, masterprocid, mpicom, ierr) call mpi_bcast(rhmaxis_const, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(cldfrc2m_qist_min, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast(cldfrc2m_qist_max, 1, mpi_real8, masterprocid, mpicom, ierr) call mpi_bcast(cldfrc2m_do_subgrid_growth, 1, mpi_logical,masterprocid, mpicom, ierr) + call mpi_bcast(cldfrc2m_do_avg_aist_algs, 1, mpi_logical,masterprocid, mpicom, ierr) end subroutine cldfrc2m_readnl @@ -138,6 +142,9 @@ subroutine cldfrc2m_init() write(iulog,*) ' rhminis = ', rhminis_const write(iulog,*) ' rhmaxis = ', rhmaxis_const write(iulog,*) ' do_subgrid_growth = ', cldfrc2m_do_subgrid_growth + write(iulog,*) ' do_avg_aist_algs = ', cldfrc2m_do_avg_aist_algs + write(iulog,*) ' cldfrc2m_qist_min = ', cldfrc2m_qist_min + write(iulog,*) ' cldfrc2m_qist_max = ', cldfrc2m_qist_max end if end subroutine cldfrc2m_init @@ -182,7 +189,7 @@ subroutine astG_PDF_single(U, p, qv, landfrac, snowh, a, Ga, orhmin, & real(r8) cldrh ! RH of stratus cloud real(r8) rhmin ! Critical RH real(r8) rhwght - + real(r8) :: rhminl real(r8) :: rhminl_adj_land real(r8) :: rhminh @@ -225,7 +232,7 @@ subroutine astG_PDF_single(U, p, qv, landfrac, snowh, a, Ga, orhmin, & a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8) Ga = dV/sqrt(2._r8)*sqrt(1._r8-a) elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then - a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & + a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8 Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a)) elseif( U .le. (cldrh-dV) ) then @@ -235,7 +242,7 @@ subroutine astG_PDF_single(U, p, qv, landfrac, snowh, a, Ga, orhmin, & if( freeze_dry ) then a = a *max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) - Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) + Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) endif elseif( p .lt. premit ) then @@ -250,7 +257,7 @@ subroutine astG_PDF_single(U, p, qv, landfrac, snowh, a, Ga, orhmin, & a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8) Ga = dV/sqrt(2._r8)*sqrt(1._r8-a) elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then - a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & + a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8 Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a)) elseif( U .le. (cldrh-dV) ) then @@ -277,7 +284,7 @@ subroutine astG_PDF_single(U, p, qv, landfrac, snowh, a, Ga, orhmin, & a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8) Ga = dV/sqrt(2._r8)*sqrt(1._r8-a) elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then - a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & + a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8 Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a)) elseif( U .le. (cldrh-dV) ) then @@ -343,7 +350,7 @@ subroutine astG_PDF(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, nco real(r8) cldrh ! RH of stratus cloud real(r8) rhmin ! Critical RH real(r8) rhwght - + ! Statement functions logical land land(i) = nint(landfrac_in(i)) == 1 @@ -367,13 +374,13 @@ subroutine astG_PDF(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, nco do i = 1, ncol - U = U_in(i) - p = p_in(i) - qv = qv_in(i) - landfrac = landfrac_in(i) - snowh = snowh_in(i) + U = U_in(i) + p = p_in(i) + qv = qv_in(i) + landfrac = landfrac_in(i) + snowh = snowh_in(i) - if (present(rhminl_in)) rhminl = rhminl_in(i) + if (present(rhminl_in)) rhminl = rhminl_in(i) if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in(i) if (present(rhminh_in)) rhminh = rhminh_in(i) @@ -394,7 +401,7 @@ subroutine astG_PDF(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, nco a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8) Ga = dV/sqrt(2._r8)*sqrt(1._r8-a) elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then - a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & + a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8 Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a)) elseif( U .le. (cldrh-dV) ) then @@ -404,7 +411,7 @@ subroutine astG_PDF(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, nco if( freeze_dry ) then a = a *max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) - Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) + Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) endif elseif( p .lt. premit ) then @@ -419,7 +426,7 @@ subroutine astG_PDF(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, nco a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8) Ga = dV/sqrt(2._r8)*sqrt(1._r8-a) elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then - a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & + a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8 Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a)) elseif( U .le. (cldrh-dV) ) then @@ -446,7 +453,7 @@ subroutine astG_PDF(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, nco a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8) Ga = dV/sqrt(2._r8)*sqrt(1._r8-a) elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then - a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & + a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* & (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8 Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a)) elseif( U .le. (cldrh-dV) ) then @@ -457,7 +464,7 @@ subroutine astG_PDF(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, nco endif a_out(i) = a - Ga_out(i) = Ga + Ga_out(i) = Ga enddo @@ -470,7 +477,7 @@ subroutine astG_RHU_single(U, p, qv, landfrac, snowh, a, Ga, orhmin, & ! --------------------------------------------------------- ! ! Compute 'stratus fraction(a)' and Gs=(dU/da) from the ! ! CAM35 cloud fraction formula. ! - ! Below is valid only for CAMUW at 1.9x2.5 fv dynamics core ! + ! Below is valid only for CAMUW at 1.9x2.5 fv dynamics core ! ! For the other cases, I should re-define 'rhminl,rhminh' & ! ! 'premib,premit'. ! ! Note that if U > 1, Ga = 1.e10 instead of Ga = 0, that is ! @@ -523,15 +530,15 @@ subroutine astG_RHU_single(U, p, qv, landfrac, snowh, a, Ga, orhmin, & rhmin = rhminl endif rhdif = (U-rhmin)/(1.0_r8-rhmin) - a = min(1._r8,(max(rhdif,0.0_r8))**2) + a = min(1._r8,(max(rhdif,0.0_r8))**2) if( (U.ge.1._r8) .or. (U.le.rhmin) ) then Ga = 1.e20_r8 - else + else Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin)) endif if( freeze_dry ) then a = a*max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) - Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) + Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) endif elseif( p .lt. premit ) then @@ -541,7 +548,7 @@ subroutine astG_RHU_single(U, p, qv, landfrac, snowh, a, Ga, orhmin, & a = min(1._r8,(max(rhdif,0._r8))**2) if( (U.ge.1._r8) .or. (U.le.rhmin) ) then Ga = 1.e20_r8 - else + else Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin)) endif @@ -559,7 +566,7 @@ subroutine astG_RHU_single(U, p, qv, landfrac, snowh, a, Ga, orhmin, & a = min(1._r8,(max(rhdif,0._r8))**2) if( (U.ge.1._r8) .or. (U.le.rhmin) ) then Ga = 1.e10_r8 - else + else Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin)) endif @@ -577,7 +584,7 @@ subroutine astG_RHU(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, nco ! --------------------------------------------------------- ! ! Compute 'stratus fraction(a)' and Gs=(dU/da) from the ! ! CAM35 cloud fraction formula. ! - ! Below is valid only for CAMUW at 1.9x2.5 fv dynamics core ! + ! Below is valid only for CAMUW at 1.9x2.5 fv dynamics core ! ! For the other cases, I should re-define 'rhminl,rhminh' & ! ! 'premib,premit'. ! ! Note that if U > 1, Ga = 1.e10 instead of Ga = 0, that is ! @@ -634,13 +641,13 @@ subroutine astG_RHU(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, nco do i = 1, ncol - U = U_in(i) - p = p_in(i) - qv = qv_in(i) - landfrac = landfrac_in(i) - snowh = snowh_in(i) + U = U_in(i) + p = p_in(i) + qv = qv_in(i) + landfrac = landfrac_in(i) + snowh = snowh_in(i) - if (present(rhminl_in)) rhminl = rhminl_in(i) + if (present(rhminl_in)) rhminl = rhminl_in(i) if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in(i) if (present(rhminh_in)) rhminh = rhminh_in(i) @@ -652,15 +659,15 @@ subroutine astG_RHU(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, nco rhmin = rhminl endif rhdif = (U-rhmin)/(1.0_r8-rhmin) - a = min(1._r8,(max(rhdif,0.0_r8))**2) + a = min(1._r8,(max(rhdif,0.0_r8))**2) if( (U.ge.1._r8) .or. (U.le.rhmin) ) then Ga = 1.e20_r8 - else + else Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin)) endif if( freeze_dry ) then a = a*max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) - Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) + Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8)) endif elseif( p .lt. premit ) then @@ -670,7 +677,7 @@ subroutine astG_RHU(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, nco a = min(1._r8,(max(rhdif,0._r8))**2) if( (U.ge.1._r8) .or. (U.le.rhmin) ) then Ga = 1.e20_r8 - else + else Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin)) endif @@ -688,14 +695,14 @@ subroutine astG_RHU(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, nco a = min(1._r8,(max(rhdif,0._r8))**2) if( (U.ge.1._r8) .or. (U.le.rhmin) ) then Ga = 1.e10_r8 - else + else Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin)) endif endif a_out(i) = a - Ga_out(i) = Ga + Ga_out(i) = Ga enddo @@ -708,7 +715,7 @@ subroutine aist_single(qv, T, p, qi, landfrac, snowh, aist, & qsatfac_out) ! --------------------------------------------------------- ! - ! Compute non-physical ice stratus fraction ! + ! Compute non-physical ice stratus fraction ! ! --------------------------------------------------------- ! real(r8), intent(in) :: qv ! Grid-mean water vapor[kg/kg] @@ -796,19 +803,19 @@ subroutine aist_single(qv, T, p, qi, landfrac, snowh, aist, & call qsat_water(T, p, es, qs) esl = svp_water(T) esi = svp_ice(T) - + if( iceopt.lt.3 ) then if( iceopt.eq.1 ) then ttmp = max(195._r8,min(T,253._r8)) - 273.16_r8 icicval = a + b * ttmp + c * ttmp**2._r8 rho = p/(rair*T) - icicval = icicval * 1.e-6_r8 / rho + icicval = icicval * 1.e-6_r8 / rho else ttmp = max(190._r8,min(T,273.16_r8)) icicval = 10._r8 **(as * bs**ttmp + cs) icicval = icicval * 1.e-6_r8 * 18._r8 / 28.97_r8 endif - aist = max(0._r8,min(qi/icicval,1._r8)) + aist = max(0._r8,min(qi/icicval,1._r8)) elseif( iceopt.eq.3 ) then aist = 1._r8 - exp(-Kc*qi/(qs*(esi/esl))) aist = max(0._r8,min(aist,1._r8)) @@ -830,9 +837,9 @@ subroutine aist_single(qv, T, p, qi, landfrac, snowh, aist, & ! endif endif ncf = qi/((1._r8 - icecrit)*qs) - if( ncf.le.0._r8 ) then + if( ncf.le.0._r8 ) then aist = 0._r8 - elseif( ncf.gt.0._r8 .and. ncf.le.1._r8/6._r8 ) then + elseif( ncf.gt.0._r8 .and. ncf.le.1._r8/6._r8 ) then aist = 0.5_r8*(6._r8 * ncf)**(2._r8/3._r8) elseif( ncf.gt.1._r8/6._r8 .and. ncf.lt.1._r8 ) then phi = (acos(3._r8*(1._r8-ncf)/2._r8**(3._r8/2._r8))+4._r8*3.1415927_r8)/3._r8 @@ -841,7 +848,7 @@ subroutine aist_single(qv, T, p, qi, landfrac, snowh, aist, & aist = 1._r8 endif aist = max(0._r8,min(aist,1._r8)) - elseif (iceopt.eq.5) then + elseif (iceopt.eq.5) then ! set rh ice cloud fraction rhi= (qv+qi)/qs * (esl/esi) if (rhmaxi .eq. rhmini) then @@ -862,7 +869,7 @@ subroutine aist_single(qv, T, p, qi, landfrac, snowh, aist, & ! NOTE: Limit qsatfac so that adjusted RHliq would be 1. or less. if (present(qsatfac_out) .and. cldfrc2m_do_subgrid_growth) then qsatfac_out = max(min(qv / qs, 1._r8), (1._r8 - aist) * rhmini + aist * rhmaxi) - end if + end if ! limiter to remove empty cloud and ice with no cloud ! and set icecld fraction to mincld if ice exists @@ -878,19 +885,28 @@ subroutine aist_single(qv, T, p, qi, landfrac, snowh, aist, & icimr=qi/aist !minimum - if (icimr.lt.qist_min) then - aist = max(0._r8,min(1._r8,qi/qist_min)) + if (icimr.lt.cldfrc2m_qist_min) then + if (cldfrc2m_do_avg_aist_algs) then + ! + ! Take the geometric mean of the iceopt=4 and iceopt=5 values. + ! Mods developed by Thomas Toniazzo for NorESM. + aist = max(0._r8,min(1._r8,sqrt(aist*qi/cldfrc2m_qist_min))) + else + ! + ! Default for iceopt=5 + aist = max(0._r8,min(1._r8,qi/cldfrc2m_qist_min)) + end if endif !maximum - if (icimr.gt.qist_max) then - aist = max(0._r8,min(1._r8,qi/qist_max)) + if (icimr.gt.cldfrc2m_qist_max) then + aist = max(0._r8,min(1._r8,qi/cldfrc2m_qist_max)) endif endif - endif + endif ! 0.999_r8 is added to prevent infinite 'ql_st' at the end of instratus_condensate - ! computed after updating 'qi_st'. + ! computed after updating 'qi_st'. aist = max(0._r8,min(aist,0.999_r8)) @@ -903,7 +919,7 @@ subroutine aist_vector(qv_in, T_in, p_in, qi_in, ni_in, landfrac_in, snowh_in, a qsatfac_out ) ! --------------------------------------------------------- ! - ! Compute non-physical ice stratus fraction ! + ! Compute non-physical ice stratus fraction ! ! --------------------------------------------------------- ! real(r8), intent(in) :: qv_in(pcols) ! Grid-mean water vapor[kg/kg] @@ -915,7 +931,7 @@ subroutine aist_vector(qv_in, T_in, p_in, qi_in, ni_in, landfrac_in, snowh_in, a real(r8), intent(in) :: snowh_in(pcols) ! Snow depth (liquid water equivalent) real(r8), intent(out) :: aist_out(pcols) ! Non-physical ice stratus fraction ( 0<= aist <= 1 ) - integer, intent(in) :: ncol + integer, intent(in) :: ncol real(r8), optional, intent(in) :: rhmaxi_in(pcols) real(r8), optional, intent(in) :: rhmini_in(pcols) ! Critical relative humidity for ice stratus @@ -951,8 +967,8 @@ subroutine aist_vector(qv_in, T_in, p_in, qi_in, ni_in, landfrac_in, snowh_in, a real(r8) ttmp ! Limited temperature real(r8) icicval ! Empirical IWC value [ kg/kg ] real(r8) rho ! Local air density - real(r8) esl ! Liq sat vapor pressure - real(r8) esi ! Ice sat vapor pressure + real(r8) esl(pcols) ! Liq sat vapor pressure + real(r8) esi(pcols) ! Ice sat vapor pressure real(r8) ncf,phi ! Wilson and Ballard parameters real(r8) qs real(r8) esat_in(pcols) @@ -1007,44 +1023,43 @@ subroutine aist_vector(qv_in, T_in, p_in, qi_in, ni_in, landfrac_in, snowh_in, a esat_in(:) = 0._r8 qsat_in(:) = 0._r8 - call qsat_water(T_in(1:ncol), p_in(1:ncol), & - esat_in(1:ncol), qsat_in(1:ncol)) - - do i = 1, ncol + call qsat_water(T_in(1:ncol), p_in(1:ncol), esat_in(1:ncol), qsat_in(1:ncol), ncol) + call svp_water_vect(T_in(1:ncol), esl(1:ncol), ncol) + call svp_ice_vect(T_in(1:ncol), esi(1:ncol), ncol) - landfrac = landfrac_in(i) - snowh = snowh_in(i) - T = T_in(i) - qv = qv_in(i) - p = p_in(i) - qi = qi_in(i) - ni = ni_in(i) - qs = qsat_in(i) - esl = svp_water(T) - esi = svp_ice(T) + do i = 1, ncol - if (present(rhmaxi_in)) rhmaxi = rhmaxi_in(i) - if (present(rhmini_in)) rhmini = rhmini_in(i) - if (present(rhminl_in)) rhminl = rhminl_in(i) - if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in(i) - if (present(rhminh_in)) rhminh = rhminh_in(i) - - if( iceopt.lt.3 ) then + landfrac = landfrac_in(i) + snowh = snowh_in(i) + T = T_in(i) + qv = qv_in(i) + p = p_in(i) + qi = qi_in(i) + ni = ni_in(i) + qs = qsat_in(i) + + if (present(rhmaxi_in)) rhmaxi = rhmaxi_in(i) + if (present(rhmini_in)) rhmini = rhmini_in(i) + if (present(rhminl_in)) rhminl = rhminl_in(i) + if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in(i) + if (present(rhminh_in)) rhminh = rhminh_in(i) + + if( iceopt.lt.3 ) then if( iceopt.eq.1 ) then ttmp = max(195._r8,min(T,253._r8)) - 273.16_r8 icicval = a + b * ttmp + c * ttmp**2._r8 rho = p/(rair*T) - icicval = icicval * 1.e-6_r8 / rho + icicval = icicval * 1.e-6_r8 / rho else ttmp = max(190._r8,min(T,273.16_r8)) icicval = 10._r8 **(as * bs**ttmp + cs) icicval = icicval * 1.e-6_r8 * 18._r8 / 28.97_r8 endif - aist = max(0._r8,min(qi/icicval,1._r8)) - elseif( iceopt.eq.3 ) then - aist = 1._r8 - exp(-Kc*qi/(qs*(esi/esl))) + aist = max(0._r8,min(qi/icicval,1._r8)) + elseif( iceopt.eq.3 ) then + aist = 1._r8 - exp(-Kc*qi/(qs*(esi(i)/esl(i)))) aist = max(0._r8,min(aist,1._r8)) - elseif( iceopt.eq.4) then + elseif( iceopt.eq.4) then if( p .ge. premib ) then if( land(i) .and. (snowh.le.0.000001_r8) ) then rhmin = rhminl - rhminl_adj_land @@ -1062,9 +1077,9 @@ subroutine aist_vector(qv_in, T_in, p_in, qi_in, ni_in, landfrac_in, snowh_in, a ! endif endif ncf = qi/((1._r8 - icecrit)*qs) - if( ncf.le.0._r8 ) then + if( ncf.le.0._r8 ) then aist = 0._r8 - elseif( ncf.gt.0._r8 .and. ncf.le.1._r8/6._r8 ) then + elseif( ncf.gt.0._r8 .and. ncf.le.1._r8/6._r8 ) then aist = 0.5_r8*(6._r8 * ncf)**(2._r8/3._r8) elseif( ncf.gt.1._r8/6._r8 .and. ncf.lt.1._r8 ) then phi = (acos(3._r8*(1._r8-ncf)/2._r8**(3._r8/2._r8))+4._r8*3.1415927_r8)/3._r8 @@ -1073,81 +1088,90 @@ subroutine aist_vector(qv_in, T_in, p_in, qi_in, ni_in, landfrac_in, snowh_in, a aist = 1._r8 endif aist = max(0._r8,min(aist,1._r8)) - elseif (iceopt.eq.5) then - ! set rh ice cloud fraction - rhi= (qv+qi)/qs * (esl/esi) - if (rhmaxi .eq. rhmini) then + elseif (iceopt.eq.5) then + ! set rh ice cloud fraction + rhi= (qv+qi)/qs * (esl(i)/esi(i)) + if (rhmaxi .eq. rhmini) then if (rhi .gt. rhmini) then rhdif = 1._r8 else rhdif = 0._r8 end if - else + else rhdif = (rhi-rhmini) / (rhmaxi - rhmini) - end if - aist = min(1.0_r8, max(rhdif,0._r8)**2) + end if + aist = min(1.0_r8, max(rhdif,0._r8)**2) + + elseif (iceopt.eq.6) then + !----- ICE CLOUD OPTION 6: fit based on T and Number (Gettelman: based on Heymsfield obs) + ! Use observations from Heymsfield et al 2012 of IWC and Ni v. Temp + ! Multivariate fit follows form of Boudala 2002: ICIWC = a * exp(b*T) * N^c + ! a=6.73e-8, b=0.05, c=0.349 + ! N is #/L, so need to convert Ni_L=N*rhoa/1000. + ah= 6.73834e-08_r8 + bh= 0.0533110_r8 + ch= 0.3493813_r8 + rho=p/(rair*T) + nil=ni*rho/1000._r8 + icicval = ah * exp(bh*T) * nil**ch + !result is in g m-3, convert to kg H2O / kg air (icimr...) + icicval = icicval / rho / 1000._r8 + aist = max(0._r8,min(qi/icicval,1._r8)) + aist = min(aist,1._r8) - elseif (iceopt.eq.6) then - !----- ICE CLOUD OPTION 6: fit based on T and Number (Gettelman: based on Heymsfield obs) - ! Use observations from Heymsfield et al 2012 of IWC and Ni v. Temp - ! Multivariate fit follows form of Boudala 2002: ICIWC = a * exp(b*T) * N^c - ! a=6.73e-8, b=0.05, c=0.349 - ! N is #/L, so need to convert Ni_L=N*rhoa/1000. - ah= 6.73834e-08_r8 - bh= 0.0533110_r8 - ch= 0.3493813_r8 - rho=p/(rair*T) - nil=ni*rho/1000._r8 - icicval = ah * exp(bh*T) * nil**ch - !result is in g m-3, convert to kg H2O / kg air (icimr...) - icicval = icicval / rho / 1000._r8 - aist = max(0._r8,min(qi/icicval,1._r8)) - aist = min(aist,1._r8) - - endif - - if (iceopt.eq.5 .or. iceopt.eq.6) then + endif - ! Similar to alpha in Wilson & Ballard (1999), determine a - ! scaling factor for saturation vapor pressure that reflects - ! the cloud fraction, rhmini, and rhmaxi. - ! - ! NOTE: Limit qsatfac so that adjusted RHliq would be 1. or less. - if (present(qsatfac_out) .and. cldfrc2m_do_subgrid_growth) then + if (iceopt.eq.5 .or. iceopt.eq.6) then + + ! Similar to alpha in Wilson & Ballard (1999), determine a + ! scaling factor for saturation vapor pressure that reflects + ! the cloud fraction, rhmini, and rhmaxi. + ! + ! NOTE: Limit qsatfac so that adjusted RHliq would be 1. or less. + if (present(qsatfac_out) .and. cldfrc2m_do_subgrid_growth) then qsatfac_out(i) = max(min(qv / qs, 1._r8), (1._r8 - aist) * rhmini + aist * rhmaxi) - end if + end if - ! limiter to remove empty cloud and ice with no cloud - ! and set icecld fraction to mincld if ice exists + ! limiter to remove empty cloud and ice with no cloud + ! and set icecld fraction to mincld if ice exists - if (qi.lt.minice) then + if (qi.lt.minice) then aist=0._r8 - else + else aist=max(mincld,aist) - endif + endif - ! enforce limits on icimr - if (qi.ge.minice) then + ! enforce limits on icimr + if (qi.ge.minice) then icimr=qi/aist !minimum - if (icimr.lt.qist_min) then - aist = max(0._r8,min(1._r8,qi/qist_min)) + if (icimr.lt.cldfrc2m_qist_min) then + if (cldfrc2m_do_avg_aist_algs) then + ! + ! Take the geometric mean of the iceopt=4 and iceopt=5 values. + ! Mods developed by Thomas Toniazzo for NorESM. + aist = max(0._r8,min(1._r8,sqrt(aist*qi/cldfrc2m_qist_min))) + else + ! + ! Default for iceopt=5 + aist = max(0._r8,min(1._r8,qi/cldfrc2m_qist_min)) + end if endif !maximum - if (icimr.gt.qist_max) then - aist = max(0._r8,min(1._r8,qi/qist_max)) + if (icimr.gt.cldfrc2m_qist_max) then + aist = max(0._r8,min(1._r8,qi/cldfrc2m_qist_max)) endif - endif - endif + endif + endif - ! 0.999_r8 is added to prevent infinite 'ql_st' at the end of instratus_condensate - ! computed after updating 'qi_st'. + ! 0.999_r8 is added to prevent infinite 'ql_st' at the end of instratus_condensate + ! computed after updating 'qi_st'. - aist = max(0._r8,min(aist,0.999_r8)) + aist = max(0._r8,min(aist,0.999_r8)) - aist_out(i) = aist + aist_out(i) = aist enddo diff --git a/src/physics/cam/cldwat.F90 b/src/physics/cam/cldwat.F90 index 6522bb9917..a2e6c38323 100644 --- a/src/physics/cam/cldwat.F90 +++ b/src/physics/cam/cldwat.F90 @@ -430,6 +430,7 @@ subroutine pcond (lchnk ,ncol ,troplev ,dlat , & pracwo(:ncol,:) = 0._r8 psacwo(:ncol,:) = 0._r8 psacio(:ncol,:) = 0._r8 + ! ! find the wet bulb temp and saturation value ! for the provisional t and q without condensation @@ -440,9 +441,10 @@ subroutine pcond (lchnk ,ncol ,troplev ,dlat , & call findsp_vc(qn(:ncol,k), tn(:ncol,k), p(:ncol,k), .true., & tsp(:ncol,k), qsp(:ncol,k)) - call qsat(t(:ncol,k), p(:ncol,k), & - es(:ncol), qs(:ncol), gam=gamma(:ncol)) + call qsat(t(1:ncol,k), p(1:ncol,k), es(1:ncol), qs(1:ncol), ncol, gam=gamma(1:ncol)) + do i = 1,ncol +! relhum(i) = q(i,k)/qs(i) ! cldm(i) = max(cldn(i,k),mincld) diff --git a/src/physics/cam/cldwat2m_macro.F90 b/src/physics/cam/cldwat2m_macro.F90 index 5359a644f8..ba8ef9d630 100644 --- a/src/physics/cam/cldwat2m_macro.F90 +++ b/src/physics/cam/cldwat2m_macro.F90 @@ -434,7 +434,7 @@ subroutine mmacro_pcond( lchnk , ncol , dt , p , d real(r8) Twb_aw(pcols) ! Wet-bulb temperature [K] real(r8) qvwb_aw(pcols,pver) ! Wet-bulb water vapor specific humidity [kg/kg] - real(r8) esat_b(pcols) + real(r8) esat_b(pcols) real(r8) qsat_b(pcols) real(r8) dqsdT_b(pcols) @@ -812,8 +812,7 @@ subroutine mmacro_pcond( lchnk , ncol , dt , p , d do k = top_lev, pver call findsp_vc(qv_05(:ncol,k), T_05(:ncol,k), p(:ncol,k), .false., & Twb_aw(:ncol), qvwb_aw(:ncol,k)) - call qsat_water(T_05(1:ncol,k), p(1:ncol,k), & - esat_a(1:ncol), qsat_a(1:ncol,k)) + call qsat_water(T_05(1:ncol,k), p(1:ncol,k), esat_a(1:ncol), qsat_a(1:ncol,k), ncol) enddo do iter = 1, niter @@ -839,10 +838,7 @@ subroutine mmacro_pcond( lchnk , ncol , dt , p , d bb(:,:) = 0._r8 do k = top_lev, pver - - call qsat_water(T(1:ncol,k), p(1:ncol,k), & - esat_b(1:ncol), qsat_b(1:ncol), dqsdt=dqsdT_b(1:ncol)) - + call qsat_water(T(1:ncol,k), p(1:ncol,k), esat_b(1:ncol), qsat_b(1:ncol), ncol, dqsdt=dqsdT_b(1:ncol)) if( iter .eq. 1 ) then a_cu(:ncol,k) = a_cud(:ncol,k) else @@ -1324,10 +1320,8 @@ subroutine rhcrit_calc( & if (i_rhmini == 2) then ! Compute the drop of critical RH by the variability induced by PBL turbulence - do k = top_lev, pver - call qsat_ice(T0(1:ncol,k), p(1:ncol,k), esat_tmp(1:ncol), qsat_tmp(1:ncol)) - + call qsat_ice(T0(1:ncol,k), p(1:ncol,k), esat_tmp(1:ncol), qsat_tmp(1:ncol), ncol) do i = 1, ncol sig_tmp = 0.5_r8 * ( qti_flx(i,k) / sqrt(max(qsmall,tke(i,k))) + & qti_flx(i,k+1) / sqrt(max(qsmall,tke(i,k+1))) ) @@ -1376,10 +1370,8 @@ subroutine rhcrit_calc( & if (i_rhminl == 2) then ! Compute the drop of critical RH by the variability induced by PBL turbulence - do k = top_lev, pver - call qsat_water(T0(1:ncol,k), p(1:ncol,k), esat_tmp(1:ncol), qsat_tmp(1:ncol)) - + call qsat_water(T0(1:ncol,k), p(1:ncol,k), esat_tmp(1:ncol), qsat_tmp(1:ncol), ncol) do i = 1, ncol sig_tmp = 0.5_r8 * ( qtl_flx(i,k) / sqrt(max(qsmall,tke(i,k))) + & qtl_flx(i,k+1) / sqrt(max(qsmall,tke(i,k+1))) ) @@ -1529,8 +1521,7 @@ subroutine instratus_condensate( lchnk, ncol, k, & ! Main Computation ! ! ---------------- ! - call qsat_water(T0_in(1:ncol), p_in(1:ncol), & - esat_in(1:ncol), qsat_in(1:ncol)) + call qsat_water(T0_in(1:ncol), p_in(1:ncol), esat_in(1:ncol), qsat_in(1:ncol), ncol) U0_in(:ncol) = qv0_in(:ncol)/qsat_in(:ncol) if( CAMstfrac ) then call astG_RHU(U0_in(:),p_in(:),qv0_in(:),landfrac(:),snowh(:),al0_st_nc_in(:),G0_nc_in(:),ncol,& diff --git a/src/physics/cam/cloud_cover_diags.F90 b/src/physics/cam/cloud_cover_diags.F90 index 6fee6af868..fa0e32ff27 100644 --- a/src/physics/cam/cloud_cover_diags.F90 +++ b/src/physics/cam/cloud_cover_diags.F90 @@ -3,7 +3,7 @@ !=============================================================================== module cloud_cover_diags - use shr_kind_mod, only: r8=>shr_kind_r8 + use shr_kind_mod, only: r8=>shr_kind_r8, shr_kind_CS use ppgrid, only: pcols, pver,pverp use cam_history, only: addfld, add_default, outfld, horiz_only use phys_control, only: phys_getopts @@ -15,6 +15,18 @@ module cloud_cover_diags public :: cloud_cover_diags_init public :: cloud_cover_diags_out + real(r8) plowmax ! Max prs for low cloud cover range + real(r8) plowmin ! Min prs for low cloud cover range + real(r8) pmedmax ! Max prs for mid cloud cover range + real(r8) pmedmin ! Min prs for mid cloud cover range + real(r8) phghmax ! Max prs for hgh cloud cover range + real(r8) phghmin ! Min prs for hgh cloud cover range +! + parameter (plowmax = 120000._r8,plowmin = 70000._r8, & + pmedmax = 70000._r8,pmedmin = 40000._r8, & + phghmax = 40000._r8,phghmin = 5000._r8) + + contains !=============================================================================== @@ -23,13 +35,21 @@ subroutine cloud_cover_diags_init(sampling_seq) character(len=*), intent(in) :: sampling_seq logical :: history_amwg ! output the variables used by the AMWG diag package + character(len=shr_kind_CS) :: long_name_string call addfld ('CLOUD', (/ 'lev' /), 'A','fraction','Cloud fraction' , sampling_seq=sampling_seq) call addfld ('CLDTOT',horiz_only, 'A','fraction','Vertically-integrated total cloud' , sampling_seq=sampling_seq) - call addfld ('CLDLOW',horiz_only, 'A','fraction','Vertically-integrated low cloud' , sampling_seq=sampling_seq) - call addfld ('CLDMED',horiz_only, 'A','fraction','Vertically-integrated mid-level cloud' , sampling_seq=sampling_seq) - call addfld ('CLDHGH',horiz_only, 'A','fraction','Vertically-integrated high cloud' , sampling_seq=sampling_seq) + write(long_name_string,999) 'Vertically-integrated low cloud from ', plowmin, ' to ', plowmax, ' Pa' + call addfld ('CLDLOW',horiz_only, 'A','fraction',long_name_string , sampling_seq=sampling_seq) + + write(long_name_string,999) 'Vertically-integrated mid-level cloud from ', pmedmin, ' to ', pmedmax, ' Pa' + call addfld ('CLDMED',horiz_only, 'A','fraction',long_name_string , sampling_seq=sampling_seq) + + write(long_name_string,999) 'Vertically-integrated high cloud from ', phghmin, ' to ', phghmax, ' Pa' + call addfld ('CLDHGH',horiz_only, 'A','fraction',long_name_string , sampling_seq=sampling_seq) + +999 format(A,F7.0,A,F7.0,A) ! determine the add_default fields call phys_getopts(history_amwg_out = history_amwg ) @@ -128,17 +148,6 @@ subroutine cldsav(lchnk ,ncol , & real(r8) clrsky(pcols) ! Max-random clear sky fraction real(r8) clrskymax(pcols) ! Maximum overlap clear sky fraction !------------------------------Parameters------------------------------- - real(r8) plowmax ! Max prs for low cloud cover range - real(r8) plowmin ! Min prs for low cloud cover range - real(r8) pmedmax ! Max prs for mid cloud cover range - real(r8) pmedmin ! Min prs for mid cloud cover range - real(r8) phghmax ! Max prs for hgh cloud cover range - real(r8) phghmin ! Min prs for hgh cloud cover range -! - parameter (plowmax = 120000._r8,plowmin = 70000._r8, & - pmedmax = 70000._r8,pmedmin = 40000._r8, & - phghmax = 40000._r8,phghmin = 5000._r8) - real(r8) ptypmin(4) real(r8) ptypmax(4) diff --git a/src/physics/cam/cloud_diagnostics.F90 b/src/physics/cam/cloud_diagnostics.F90 index f7a5115914..0aea0afbaf 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 -! +! ! !--------------------------------------------------------------------------------- @@ -30,21 +30,21 @@ module cloud_diagnostics integer :: dei_idx, mu_idx, lambda_idx, iciwp_idx, iclwp_idx, cld_idx ! index into pbuf for cloud fields integer :: ixcldice, ixcldliq, rei_idx, rel_idx - logical :: do_cld_diag, mg_clouds, rk_clouds, camrt_rad, spcam_m2005_clouds, spcam_sam1mom_clouds + logical :: do_cld_diag, camrt_rad logical :: one_mom_clouds, two_mom_clouds - + integer :: cicewp_idx = -1 integer :: cliqwp_idx = -1 integer :: cldemis_idx = -1 integer :: cldtau_idx = -1 integer :: nmxrgn_idx = -1 integer :: pmxrgn_idx = -1 + integer :: gb_totcldliqmr_idx = -1 + integer :: gb_totcldicemr_idx = -1 ! Index fields for precipitation efficiency. integer :: acpr_idx, acgcme_idx, acnum_idx - logical :: use_spcam - contains !=============================================================================== @@ -57,12 +57,8 @@ subroutine cloud_diagnostics_register call phys_getopts(radiation_scheme_out=rad_pkg,microp_scheme_out=microp_pgk) camrt_rad = rad_pkg .eq. 'camrt' - rk_clouds = microp_pgk == 'RK' - mg_clouds = microp_pgk == 'MG' - spcam_m2005_clouds = microp_pgk == 'SPCAM_m2005' - spcam_sam1mom_clouds = microp_pgk == 'SPCAM_sam1mom' - one_mom_clouds = (rk_clouds .or. spcam_sam1mom_clouds) - two_mom_clouds = (mg_clouds .or. spcam_m2005_clouds) + one_mom_clouds = microp_pgk == 'RK' + two_mom_clouds = microp_pgk == 'MG' if (one_mom_clouds) then call pbuf_add_field('CLDEMIS','physpkg', dtype_r8,(/pcols,pver/), cldemis_idx) @@ -82,15 +78,18 @@ subroutine cloud_diagnostics_register end subroutine cloud_diagnostics_register !=============================================================================== - subroutine cloud_diagnostics_init() + subroutine cloud_diagnostics_init(pbuf2d) !----------------------------------------------------------------------- - use physics_buffer,only: pbuf_get_index + use physics_buffer,only: pbuf_get_index, pbuf_set_field, physics_buffer_desc use phys_control, only: phys_getopts use constituents, only: cnst_get_ind use cloud_cover_diags, only: cloud_cover_diags_init + use time_manager, only: is_first_step implicit none + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + !----------------------------------------------------------------------- character(len=16) :: wpunits, sampling_seq @@ -100,18 +99,26 @@ subroutine cloud_diagnostics_init() !----------------------------------------------------------------------- cld_idx = pbuf_get_index('CLD') - - call phys_getopts(use_spcam_out=use_spcam) + ! grid box total cloud liquid water mixing ratio (kg/kg) + gb_totcldliqmr_idx = pbuf_get_index('GB_TOTCLDLIQMR') + ! grid box total cloud ice water mixing ratio (kg/kg) + gb_totcldicemr_idx = pbuf_get_index('GB_TOTCLDICEMR') if (two_mom_clouds) then + ! initialize to zero + if (is_first_step()) then + call pbuf_set_field(pbuf2d, iciwp_idx, 0._r8) + call pbuf_set_field(pbuf2d, iclwp_idx, 0._r8) + end if + call addfld ('ICWMR', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-cloud water mixing ratio') call addfld ('ICIMR', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-cloud ice mixing ratio' ) call addfld ('IWC', (/ 'lev' /), 'A', 'kg/m3', 'Grid box average ice water content' ) call addfld ('LWC', (/ 'lev' /), 'A', 'kg/m3', 'Grid box average liquid water content' ) ! determine the add_default fields - call phys_getopts(history_amwg_out = history_amwg) + call phys_getopts(history_amwg_out = history_amwg) if (history_amwg) then call add_default ('ICWMR', 1, ' ') @@ -136,11 +143,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 (one_mom_clouds) then wpunits = 'gram/m2' sampling_seq='rad_lwsw' - else if (two_mom_clouds .or. spcam_sam1mom_clouds) then + else if (two_mom_clouds) then wpunits = 'kg/m2' sampling_seq='' end if @@ -157,7 +164,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') @@ -191,7 +198,7 @@ subroutine cloud_diagnostics_init() call add_default ('TGCLDLWP', 1, ' ') call add_default ('TGCLDIWP', 1, ' ') call add_default ('TGCLDCWP', 1, ' ') - if(rk_clouds) then + if(one_mom_clouds) then if (camrt_rad) then call add_default ('EMIS', 1, ' ') else @@ -208,10 +215,10 @@ subroutine cloud_diagnostics_calc(state, pbuf) ! ! Compute (liquid+ice) water path and cloud water/ice diagnostics ! *** soon this code will compute liquid and ice paths from input liquid and ice mixing ratios -! +! ! **** mixes interface and physics code temporarily !----------------------------------------------------------------------- - use physics_types, only: physics_state + use physics_types, only: physics_state use physics_buffer,only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx use pkg_cldoptics, only: cldovrlap, cldclw, cldems use conv_water, only: conv_water_in_rad, conv_water_4rad @@ -245,6 +252,9 @@ subroutine cloud_diagnostics_calc(state, pbuf) integer, pointer :: nmxrgn(:) ! Number of maximally overlapped regions real(r8), pointer :: pmxrgn(:,:) ! Maximum values of pressure for each + real(r8), pointer :: totg_ice(:,:) ! grid box total cloud ice mixing ratio + real(r8), pointer :: totg_liq(:,:) ! grid box total cloud liquid mixing ratio + integer :: itim_old real(r8) :: cwp (pcols,pver) ! in-cloud cloud (total) water path @@ -277,7 +287,7 @@ subroutine cloud_diagnostics_calc(state, pbuf) real(r8) :: effcld(pcols,pver) ! effective cloud=cld*emis logical :: dosw,dolw - + !----------------------------------------------------------------------- if (.not.do_cld_diag) return @@ -297,6 +307,9 @@ subroutine cloud_diagnostics_calc(state, pbuf) itim_old = pbuf_old_tim_idx() call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, gb_totcldicemr_idx, totg_ice) + call pbuf_get_field(pbuf, gb_totcldliqmr_idx, totg_liq) + if(two_mom_clouds)then call pbuf_get_field(pbuf, iclwp_idx, iclwp ) @@ -362,10 +375,9 @@ subroutine cloud_diagnostics_calc(state, pbuf) ! iclwp and iciwp to pass to the radiation. ! ! ----------------------------------------------------------- ! if( conv_water_in_rad /= 0 ) then - allcld_ice(:ncol,:) = 0._r8 ! Grid-avg all cloud liquid - allcld_liq(:ncol,:) = 0._r8 ! Grid-avg all cloud ice - - call conv_water_4rad(state, pbuf, allcld_liq, allcld_ice) + call conv_water_4rad(state, pbuf) + allcld_ice(:ncol,:) = totg_ice(:ncol,:) ! Grid-avg all cloud liquid + allcld_liq(:ncol,:) = totg_liq(:ncol,:) ! Grid-avg all cloud ice else allcld_liq(:ncol,top_lev:pver) = state%q(:ncol,top_lev:pver,ixcldliq) ! Grid-ave all cloud liquid allcld_ice(:ncol,top_lev:pver) = state%q(:ncol,top_lev:pver,ixcldice) ! " ice @@ -410,12 +422,14 @@ subroutine cloud_diagnostics_calc(state, pbuf) elseif(one_mom_clouds) then if (conv_water_in_rad /= 0) then - call conv_water_4rad(state, pbuf, allcld_liq, allcld_ice) + call conv_water_4rad(state, pbuf) + allcld_ice(:ncol,:) = totg_ice(:ncol,:) ! Grid-avg all cloud liquid + allcld_liq(:ncol,:) = totg_liq(:ncol,:) ! Grid-avg all cloud ice else allcld_liq = state%q(:,:,ixcldliq) allcld_ice = state%q(:,:,ixcldice) end if - + do k=1,pver do i = 1,ncol gicewp(i,k) = allcld_ice(i,k)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. @@ -430,13 +444,11 @@ subroutine cloud_diagnostics_calc(state, pbuf) ! Determine parameters for maximum/random overlap call cldovrlap(lchnk, ncol, state%pint, cld, nmxrgn, pmxrgn) - if(.not. use_spcam) then ! in spcam, these diagnostics are calcluated in crm_physics.F90 -! Cloud cover diagnostics (done in radiation_tend for camrt) + ! Cloud cover diagnostics (done in radiation_tend for camrt) if (.not.camrt_rad) then call cloud_cover_diags_out(lchnk, ncol, cld, state%pmid, nmxrgn, pmxrgn ) endif - end if - + tgicewp(:ncol) = 0._r8 tgliqwp(:ncol) = 0._r8 @@ -453,14 +465,14 @@ subroutine cloud_diagnostics_calc(state, pbuf) ! Cloud emissivity. call cldems(lchnk, ncol, cwp, ficemr, rei, cldemis, cldtau) - + ! Effective cloud cover do k=1,pver do i=1,ncol effcld(i,k) = cld(i,k)*cldemis(i,k) end do end do - + call outfld('EFFCLD' ,effcld , pcols,lchnk) if (camrt_rad) then call outfld('EMIS' ,cldemis, pcols,lchnk) @@ -481,15 +493,12 @@ subroutine cloud_diagnostics_calc(state, pbuf) endif - 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) - call outfld('TGCLDLWP',tgliqwp, pcols,lchnk) - call outfld('TGCLDIWP',tgicewp, pcols,lchnk) - call outfld('ICLDTWP' ,cwp , pcols,lchnk) - call outfld('ICLDIWP' ,cicewp , pcols,lchnk) - endif + call outfld('GCLDLWP' ,gwp , pcols,lchnk) + call outfld('TGCLDCWP',tgwp , pcols,lchnk) + call outfld('TGCLDLWP',tgliqwp, pcols,lchnk) + call outfld('TGCLDIWP',tgicewp, pcols,lchnk) + call outfld('ICLDTWP' ,cwp , pcols,lchnk) + call outfld('ICLDIWP' ,cicewp , pcols,lchnk) ! Compute total preciptable water in column (in mm) tpw(:ncol) = 0.0_r8 @@ -505,7 +514,7 @@ subroutine cloud_diagnostics_calc(state, pbuf) call cldclw(lchnk, ncol, state%zi, clwpold, tpw, hl) call outfld('SETLWP' ,clwpold, pcols,lchnk) call outfld('LWSH' ,hl , pcols,lchnk) - + if(one_mom_clouds) then if (cldemis_idx<0) deallocate(cldemis) if (cldtau_idx<0) deallocate(cldtau) diff --git a/src/physics/cam/cloud_fraction.F90 b/src/physics/cam/cloud_fraction.F90 index e2b5814b62..7b3297b67d 100644 --- a/src/physics/cam/cloud_fraction.F90 +++ b/src/physics/cam/cloud_fraction.F90 @@ -5,7 +5,7 @@ module cloud_fraction use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver, pverp - use ref_pres, only: pref_mid + use ref_pres, only: pref_mid use spmd_utils, only: masterproc use cam_logfile, only: iulog use cam_abortutils, only: endrun @@ -22,7 +22,8 @@ module cloud_fraction cldfrc_init, &! Inititialization of cloud_fraction run-time parameters cldfrc_getparams, &! public access of tuning parameters cldfrc, &! Computation of cloud fraction - cldfrc_fice ! Calculate fraction of condensate in ice phase (radiation partitioning) + dp1, &! parameter for deep convection cloud fraction needed in clubb_intr + dp2 ! parameter for deep convection cloud fraction needed in clubb_intr ! Private data real(r8), parameter :: unset_r8 = huge(1.0_r8) @@ -30,9 +31,9 @@ module cloud_fraction ! Top level integer :: top_lev = 1 - ! Physics buffer indices - integer :: sh_frac_idx = 0 - integer :: dp_frac_idx = 0 + ! Physics buffer indices + integer :: sh_frac_idx = 0 + integer :: dp_frac_idx = 0 ! Namelist variables logical :: cldfrc_freeze_dry ! switch for Vavrus correction @@ -152,8 +153,8 @@ subroutine cldfrc_register !----------------------------------------------------------------------- - call pbuf_add_field('SH_FRAC', 'physpkg', dtype_r8, (/pcols,pver/), sh_frac_idx) - call pbuf_add_field('DP_FRAC', 'physpkg', dtype_r8, (/pcols,pver/), dp_frac_idx) + call pbuf_add_field('SH_FRAC', 'physpkg', dtype_r8, (/pcols,pver/), sh_frac_idx) + call pbuf_add_field('DP_FRAC', 'physpkg', dtype_r8, (/pcols,pver/), dp_frac_idx) end subroutine cldfrc_register @@ -203,20 +204,19 @@ subroutine cldfrc_init macrop_scheme_out = macrop_scheme ) ! Limit CAM5 cloud physics to below top cloud level. - if ( .not. (macrop_scheme == "rk" .or. macrop_scheme == "SPCAM_sam1mom")) top_lev = trop_cloud_top_lev + if ( .not. macrop_scheme == "rk") top_lev = trop_cloud_top_lev ! Turn off inversion_cld if any UW PBL scheme is being used - if ( (eddy_scheme .eq. 'diag_TKE' ) .or. (shallow_scheme .eq. 'UW' ) .or.& - (shallow_scheme .eq. 'SPCAM_m2005') ) then + if ( eddy_scheme .eq. 'diag_TKE' .or. shallow_scheme .eq. 'UW' ) then inversion_cld_off = .true. else inversion_cld_off = .false. endif - if ( masterproc ) then + if ( masterproc ) then write(iulog,*)'tuning parameters cldfrc_init: inversion_cld_off',inversion_cld_off write(iulog,*)'tuning parameters cldfrc_init: dp1',dp1,'dp2',dp2,'sh1',sh1,'sh2',sh2 - if (shallow_scheme .ne. 'UW' .or. shallow_scheme .eq. 'SPCAM_m2005' ) then + if (shallow_scheme .ne. 'UW') then write(iulog,*)'tuning parameters cldfrc_init: rhminl',rhminl,'rhminl_adj_land',rhminl_adj_land, & 'rhminh',rhminh,'premit',premit,'premib',premib write(iulog,*)'tuning parameters cldfrc_init: iceopt',iceopt,'icecrit',icecrit @@ -247,38 +247,38 @@ subroutine cldfrc(lchnk ,ncol , pbuf, & cmfmc ,cmfmc2 ,landfrac,snowh ,concld ,cldst , & ts ,sst ,ps ,zdu ,ocnfrac ,& rhu00 ,cldice ,icecldf ,liqcldf ,relhum ,dindex ) - !----------------------------------------------------------------------- - ! - ! Purpose: - ! Compute cloud fraction - ! - ! - ! Method: + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Compute cloud fraction + ! + ! + ! Method: ! This calculate cloud fraction using a relative humidity threshold - ! The threshold depends upon pressure, and upon the presence or absence - ! of convection as defined by a reasonably large vertical mass flux + ! The threshold depends upon pressure, and upon the presence or absence + ! of convection as defined by a reasonably large vertical mass flux ! entering that layer from below. - ! + ! ! Author: Many. Last modified by Jim McCaa - ! + ! !----------------------------------------------------------------------- use cam_history, only: outfld use physconst, only: cappa, gravit, rair, tmelt - use wv_saturation, only: qsat, qsat_water, svp_ice + use wv_saturation, only: qsat, qsat_water, svp_ice_vect use phys_grid, only: get_rlat_all_p, get_rlon_all_p - + !RBN - Need this to write shallow,deep fraction to phys buffer. !PJR - we should probably make seperate modules for determining convective ! clouds and make this one just responsible for relative humidity clouds - + use physics_buffer, only: physics_buffer_desc, pbuf_get_field ! Arguments integer, intent(in) :: lchnk ! chunk identifier integer, intent(in) :: ncol ! number of atmospheric columns integer, intent(in) :: dindex ! 0 or 1 to perturb rh - + type(physics_buffer_desc), pointer :: pbuf(:) real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures real(r8), intent(in) :: temp(pcols,pver) ! temperature @@ -305,7 +305,7 @@ subroutine cldfrc(lchnk ,ncol , pbuf, & real(r8), intent(out) :: clc(pcols) ! column convective cloud amount real(r8), intent(out) :: cldst(pcols,pver) ! cloud fraction real(r8), intent(out) :: rhu00(pcols,pver) ! RH threshold for cloud - real(r8), intent(out) :: relhum(pcols,pver) ! RH + real(r8), intent(out) :: relhum(pcols,pver) ! RH real(r8), intent(out) :: icecldf(pcols,pver) ! ice cloud fraction real(r8), intent(out) :: liqcldf(pcols,pver) ! liquid cloud fraction (combined into cloud) @@ -374,7 +374,7 @@ subroutine cldfrc(lchnk ,ncol , pbuf, & ! The idea is that the RH limits for condensation are strict only for ! water saturation ! - ! Ice clouds are formed by explicit parameterization of ice nucleation. + ! Ice clouds are formed by explicit parameterization of ice nucleation. ! Closure for ice cloud fraction is done on available cloud ice, such that ! the in-cloud ice content matches an empirical fit ! thus, icecldf = min(cldice/icicval,1) where icicval = f(temp,cldice,numice) @@ -383,17 +383,17 @@ subroutine cldfrc(lchnk ,ncol , pbuf, & ! No dA/dt term for ice? ! ! There are three co-existing cloud types: convective, inversion related low-level - ! stratocumulus, and layered cloud (based on relative humidity). Layered and - ! stratocumulus clouds do not compete with convective cloud for which one creates - ! the most cloud. They contribute collectively to the total grid-box average cloud - ! amount. This is reflected in the way in which the total cloud amount is evaluated + ! stratocumulus, and layered cloud (based on relative humidity). Layered and + ! stratocumulus clouds do not compete with convective cloud for which one creates + ! the most cloud. They contribute collectively to the total grid-box average cloud + ! amount. This is reflected in the way in which the total cloud amount is evaluated ! (a sum as opposed to a logical "or" operation) ! !================================================================================== ! set defaults for rhu00 rhu00(:,:) = 2.0_r8 ! define rh perturbation in order to estimate rhdfda - rhpert = 0.01_r8 + rhpert = 0.01_r8 !set Wang and Sassen IWC paramters a=26.87_r8 @@ -409,14 +409,15 @@ subroutine cldfrc(lchnk ,ncol , pbuf, & ! Evaluate potential temperature and relative humidity ! If not computing ice cloud fraction then hybrid RH, if MG then water RH if ( cldfrc_ice ) then - call qsat_water(temp(1:ncol,top_lev:pver), pmid(1:ncol,top_lev:pver), & - esl(1:ncol,top_lev:pver), qs(1:ncol,top_lev:pver)) - - esi(1:ncol,top_lev:pver) = svp_ice(temp(1:ncol,top_lev:pver)) + do k = top_lev,pver + call qsat_water(temp(1:ncol,k), pmid(1:ncol,k), esl(1:ncol,k), qs(1:ncol,k), ncol) + call svp_ice_vect(temp(1:ncol,k), esi(1:ncol,k), ncol) + end do else - call qsat(temp(1:ncol,top_lev:pver), pmid(1:ncol,top_lev:pver), & - es(1:ncol,top_lev:pver), qs(1:ncol,top_lev:pver)) - endif + do k = top_lev,pver + call qsat(temp(1:ncol,k), pmid(1:ncol,k), es(1:ncol,k), qs(1:ncol,k), ncol) + end do + end if cloud = 0._r8 icecldf = 0._r8 @@ -457,7 +458,7 @@ subroutine cldfrc(lchnk ,ncol , pbuf, & ! ! Estimate of local convective cloud cover based on convective mass flux - ! Modify local large-scale relative humidity to account for presence of + ! Modify local large-scale relative humidity to account for presence of ! convective cloud when evaluating relative humidity based layered cloud amount ! concld(:ncol,top_lev:pver) = 0.0_r8 @@ -465,7 +466,7 @@ subroutine cldfrc(lchnk ,ncol , pbuf, & ! cloud mass flux in SI units of kg/m2/s; should produce typical numbers of 20% ! shallow and deep convective cloudiness are evaluated separately (since processes ! are evaluated separately) and summed - ! + ! #ifndef PERGRO do k=top_lev,pver do i=1,ncol @@ -485,7 +486,7 @@ subroutine cldfrc(lchnk ,ncol , pbuf, & ! ****** Compute layer cloudiness ****** ! !==================================================================== - ! Begin the evaluation of layered cloud amount based on (modified) RH + ! Begin the evaluation of layered cloud amount based on (modified) RH !==================================================================== ! numkcld = pver @@ -514,7 +515,7 @@ subroutine cldfrc(lchnk ,ncol , pbuf, & ! SJV: decrease cloud amount if very low water vapor content ! (thus very cold): "freeze dry" if (cldfrc_freeze_dry) then - rhcloud(i,k) = rhcloud(i,k)*max(0.15_r8,min(1.0_r8,q(i,k)/0.0030_r8)) + rhcloud(i,k) = rhcloud(i,k)*max(0.15_r8,min(1.0_r8,q(i,k)/0.0030_r8)) endif else if ( pmid(i,k).lt.premit ) then @@ -534,7 +535,7 @@ subroutine cldfrc(lchnk ,ncol , pbuf, & ! linear rh threshold transition between thresholds for low & high cloud ! rhwght = (premib-(max(pmid(i,k),premit)))/(premib-premit) - + if (land(i) .and. (snowh(i) <= 0.000001_r8)) then rhlim = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght) else @@ -588,7 +589,7 @@ subroutine cldfrc(lchnk ,ncol , pbuf, & !--------ICE CLOUD OPTION 3--------Wood & Field 2000 (JAS) ! eq 6: cloud fraction = 1 - exp (-K * qc/qsati) - + icecldf(i,k)=1._r8 - exp(-Kc*cldice(i,k)/(qs(i,k)*(esi(i,k)/esl(i,k)))) icecldf(i,k)=max(0._r8,min(icecldf(i,k),1._r8)) else @@ -631,7 +632,7 @@ subroutine cldfrc(lchnk ,ncol , pbuf, & cloud(i,k) = rhcloud(i,k) end if end do - end do + end do ! ! Add in the marine strat ! MARINE STRATUS SHOULD BE A SPECIAL CASE OF LAYERED CLOUD @@ -641,20 +642,20 @@ subroutine cldfrc(lchnk ,ncol , pbuf, & !=================================================================================== ! ! SOME OBSERVATIONS ABOUT THE FOLLOWING SECTION OF CODE (missed in earlier look) - ! K700 IS SET AS A CONSTANT BASED ON HYBRID COORDINATE: IT DOES NOT DEPEND ON - ! LOCAL PRESSURE; THERE IS NO PRESSURE RAMP => LOOKS LEVEL DEPENDENT AND + ! K700 IS SET AS A CONSTANT BASED ON HYBRID COORDINATE: IT DOES NOT DEPEND ON + ! LOCAL PRESSURE; THERE IS NO PRESSURE RAMP => LOOKS LEVEL DEPENDENT AND ! DISCONTINUOUS IN SPACE (I.E., STRATUS WILL END SUDDENLY WITH NO TRANSITION) ! ! IT APPEARS THAT STRAT IS EVALUATED ACCORDING TO KLEIN AND HARTMANN; HOWEVER, ! THE ACTUAL STRATUS AMOUNT (CLDST) APPEARS TO DEPEND DIRECTLY ON THE RH BELOW - ! THE STRONGEST PART OF THE LOW LEVEL INVERSION. + ! THE STRONGEST PART OF THE LOW LEVEL INVERSION. !PJR answers: 1) the rh limitation is a physical/mathematical limitation ! cant have more cloud than there is RH ! allowed the cloud to exist two layers below the inversion ! because the numerics frequently make 50% relative humidity ! in level below the inversion which would allow no cloud ! 2) since the cloud is only allowed over ocean, it should - ! be very insensitive to surface pressure (except due to + ! be very insensitive to surface pressure (except due to ! spectral ringing, which also causes so many other problems ! I didnt worry about it. ! @@ -735,77 +736,4 @@ end subroutine cldfrc !================================================================================================ - subroutine cldfrc_fice(ncol, t, fice, fsnow) -! -! Compute the fraction of the total cloud water which is in ice phase. -! The fraction depends on temperature only. -! This is the form that was used for radiation, the code came from cldefr originally -! -! Author: B. A. Boville Sept 10, 2002 -! modified: PJR 3/13/03 (added fsnow to ascribe snow production for convection ) -!----------------------------------------------------------------------- - use physconst, only: tmelt - -! Arguments - integer, intent(in) :: ncol ! number of active columns - real(r8), intent(in) :: t(pcols,pver) ! temperature - - real(r8), intent(out) :: fice(pcols,pver) ! Fractional ice content within cloud - real(r8), intent(out) :: fsnow(pcols,pver) ! Fractional snow content for convection - -! Local variables - real(r8) :: tmax_fice ! max temperature for cloud ice formation - real(r8) :: tmin_fice ! min temperature for cloud ice formation - real(r8) :: tmax_fsnow ! max temperature for transition to convective snow - real(r8) :: tmin_fsnow ! min temperature for transition to convective snow - - integer :: i,k ! loop indexes - -!----------------------------------------------------------------------- - - tmax_fice = tmelt - 10._r8 ! max temperature for cloud ice formation - tmin_fice = tmax_fice - 30._r8 ! min temperature for cloud ice formation - tmax_fsnow = tmelt ! max temperature for transition to convective snow - tmin_fsnow = tmelt - 5._r8 ! min temperature for transition to convective snow - - fice(:,:top_lev-1) = 0._r8 - fsnow(:,:top_lev-1) = 0._r8 - -! Define fractional amount of cloud that is ice - do k=top_lev,pver - do i=1,ncol - -! If warmer than tmax then water phase - if (t(i,k) > tmax_fice) then - fice(i,k) = 0.0_r8 - -! If colder than tmin then ice phase - else if (t(i,k) < tmin_fice) then - fice(i,k) = 1.0_r8 - -! Otherwise mixed phase, with ice fraction decreasing linearly from tmin to tmax - else - fice(i,k) =(tmax_fice - t(i,k)) / (tmax_fice - tmin_fice) - end if - -! snow fraction partitioning - -! If warmer than tmax then water phase - if (t(i,k) > tmax_fsnow) then - fsnow(i,k) = 0.0_r8 - -! If colder than tmin then ice phase - else if (t(i,k) < tmin_fsnow) then - fsnow(i,k) = 1.0_r8 - -! Otherwise mixed phase, with ice fraction decreasing linearly from tmin to tmax - else - fsnow(i,k) =(tmax_fsnow - t(i,k)) / (tmax_fsnow - tmin_fsnow) - end if - - end do - end do - - end subroutine cldfrc_fice - end module cloud_fraction diff --git a/src/physics/cam/cloud_rad_props.F90 b/src/physics/cam/cloud_rad_props.F90 new file mode 100644 index 0000000000..257138e7b5 --- /dev/null +++ b/src/physics/cam/cloud_rad_props.F90 @@ -0,0 +1,758 @@ +module cloud_rad_props + +!------------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx +use constituents, only: cnst_get_ind +use radconstants, only: nswbands, nlwbands, idx_sw_diag +use rad_constituents, only: iceopticsfile, liqopticsfile +use oldcloud_optics, only: oldcloud_init, oldcloud_lw, & + old_liq_get_rad_props_lw, old_ice_get_rad_props_lw + +use slingo_liq_optics, only: slingo_rad_props_init +use ebert_curry_ice_optics, only: ec_rad_props_init, scalefactor + +use interpolate_data, only: interp_type, lininterp_init, lininterp, & + extrap_method_bndry, lininterp_finish + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + + +implicit none +private +save + +public :: & + cloud_rad_props_init, & + cloud_rad_props_get_lw, & ! return LW optical props for old cloud optics + get_ice_optics_sw, & ! return Mitchell SW ice radiative properties + ice_cloud_get_rad_props_lw, & ! return Mitchell LW ice radiative properties + get_liquid_optics_sw, & ! return Conley SW radiative properties + liquid_cloud_get_rad_props_lw, & ! return Conley LW radiative properties + get_snow_optics_sw, & + snow_cloud_get_rad_props_lw, & + get_grau_optics_sw, & + grau_cloud_get_rad_props_lw + + +integer :: nmu, nlambda +real(r8), allocatable :: g_mu(:) ! mu samples on grid +real(r8), allocatable :: g_lambda(:,:) ! lambda scale samples on grid +real(r8), allocatable :: ext_sw_liq(:,:,:) +real(r8), allocatable :: ssa_sw_liq(:,:,:) +real(r8), allocatable :: asm_sw_liq(:,:,:) +real(r8), allocatable :: abs_lw_liq(:,:,:) + +integer :: n_g_d +real(r8), allocatable :: g_d_eff(:) ! radiative effective diameter samples on grid +real(r8), allocatable :: ext_sw_ice(:,:) +real(r8), allocatable :: ssa_sw_ice(:,:) +real(r8), allocatable :: asm_sw_ice(:,:) +real(r8), allocatable :: abs_lw_ice(:,:) + +! indexes into pbuf for optical parameters of MG clouds +integer :: i_dei=0 +integer :: i_mu=0 +integer :: i_lambda=0 +integer :: i_iciwp=0 +integer :: i_iclwp=0 +integer :: i_des=0 +integer :: i_icswp=0 +integer :: i_degrau=0 +integer :: i_icgrauwp=0 + +! indexes into constituents for old optics +integer :: & + ixcldice, & ! cloud ice water index + ixcldliq ! cloud liquid water index + +real(r8), parameter :: tiny = 1.e-80_r8 + +!============================================================================== +contains +!============================================================================== + +subroutine cloud_rad_props_init() + + use netcdf + use spmd_utils, only: masterproc + use ioFileMod, only: getfil + use error_messages, only: handle_ncerr +#if ( defined SPMD ) + use mpishorthand +#endif + + character(len=256) :: liquidfile + character(len=256) :: icefile + character(len=256) :: locfn + + integer :: ncid, dimid, f_nlwbands, f_nswbands, ierr + integer :: vdimids(NF90_MAX_VAR_DIMS), ndims, templen + ! liquid clouds + integer :: mudimid, lambdadimid + integer :: mu_id, lambda_id, ext_sw_liq_id, ssa_sw_liq_id, asm_sw_liq_id, abs_lw_liq_id + + ! ice clouds + integer :: d_dimid ! diameters + integer :: d_id, ext_sw_ice_id, ssa_sw_ice_id, asm_sw_ice_id, abs_lw_ice_id + + integer :: err + character(len=*), parameter :: sub = 'cloud_rad_props_init' + + liquidfile = liqopticsfile + icefile = iceopticsfile + + call slingo_rad_props_init + call ec_rad_props_init + call oldcloud_init + + i_dei = pbuf_get_index('DEI',errcode=err) + i_mu = pbuf_get_index('MU',errcode=err) + i_lambda = pbuf_get_index('LAMBDAC',errcode=err) + i_iciwp = pbuf_get_index('ICIWP',errcode=err) + i_iclwp = pbuf_get_index('ICLWP',errcode=err) + i_des = pbuf_get_index('DES',errcode=err) + i_icswp = pbuf_get_index('ICSWP',errcode=err) + i_icgrauwp = pbuf_get_index('ICGRAUWP',errcode=err) ! Available when using MG3 + i_degrau = pbuf_get_index('DEGRAU',errcode=err) ! Available when using MG3 + + ! old optics + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + + ! read liquid cloud optics + if (masterproc) then + call getfil( trim(liquidfile), locfn, 0) + call handle_ncerr( nf90_open(locfn, NF90_NOWRITE, ncid), 'liquid optics file missing') + write(iulog,*)' reading liquid cloud optics from file ',locfn + + call handle_ncerr(nf90_inq_dimid( ncid, 'lw_band', dimid), 'getting lw_band dim') + call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nlwbands), 'getting n lw bands') + if (f_nlwbands /= nlwbands) call endrun(sub//': number of lw bands does not match') + + call handle_ncerr(nf90_inq_dimid( ncid, 'sw_band', dimid), 'getting sw_band_dim') + call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nswbands), 'getting n sw bands') + if (f_nswbands /= nswbands) call endrun(sub//': number of sw bands does not match') + + call handle_ncerr(nf90_inq_dimid( ncid, 'mu', mudimid), 'getting mu dim') + call handle_ncerr(nf90_inquire_dimension( ncid, mudimid, len=nmu), 'getting n mu samples') + + call handle_ncerr(nf90_inq_dimid( ncid, 'lambda_scale', lambdadimid), 'getting lambda dim') + call handle_ncerr(nf90_inquire_dimension( ncid, lambdadimid, len=nlambda), 'getting n lambda samples') + end if ! if (masterproc) + +#if ( defined SPMD ) + call mpibcast(nmu, 1, mpiint, 0, mpicom, ierr) + call mpibcast(nlambda, 1, mpiint, 0, mpicom, ierr) +#endif + + allocate(g_mu(nmu)) + allocate(g_lambda(nmu,nlambda)) + allocate(ext_sw_liq(nmu,nlambda,nswbands) ) + allocate(ssa_sw_liq(nmu,nlambda,nswbands)) + allocate(asm_sw_liq(nmu,nlambda,nswbands)) + allocate(abs_lw_liq(nmu,nlambda,nlwbands)) + + if (masterproc) then + call handle_ncerr( nf90_inq_varid(ncid, 'mu', mu_id),& + 'cloud optics mu get') + call handle_ncerr( nf90_get_var(ncid, mu_id, g_mu),& + 'read cloud optics mu values') + + call handle_ncerr( nf90_inq_varid(ncid, 'lambda', lambda_id),& + 'cloud optics lambda get') + call handle_ncerr( nf90_get_var(ncid, lambda_id, g_lambda),& + 'read cloud optics lambda values') + + call handle_ncerr( nf90_inq_varid(ncid, 'k_ext_sw', ext_sw_liq_id),& + 'cloud optics ext_sw_liq get') + call handle_ncerr( nf90_get_var(ncid, ext_sw_liq_id, ext_sw_liq),& + 'read cloud optics ext_sw_liq values') + + call handle_ncerr( nf90_inq_varid(ncid, 'ssa_sw', ssa_sw_liq_id),& + 'cloud optics ssa_sw_liq get') + call handle_ncerr( nf90_get_var(ncid, ssa_sw_liq_id, ssa_sw_liq),& + 'read cloud optics ssa_sw_liq values') + + call handle_ncerr( nf90_inq_varid(ncid, 'asm_sw', asm_sw_liq_id),& + 'cloud optics asm_sw_liq get') + call handle_ncerr( nf90_get_var(ncid, asm_sw_liq_id, asm_sw_liq),& + 'read cloud optics asm_sw_liq values') + + call handle_ncerr( nf90_inq_varid(ncid, 'k_abs_lw', abs_lw_liq_id),& + 'cloud optics abs_lw_liq get') + call handle_ncerr( nf90_get_var(ncid, abs_lw_liq_id, abs_lw_liq),& + 'read cloud optics abs_lw_liq values') + + call handle_ncerr( nf90_close(ncid), 'liquid optics file missing') + end if ! if masterproc + +#if ( defined SPMD ) + call mpibcast(g_mu, nmu, mpir8, 0, mpicom, ierr) + call mpibcast(g_lambda, nmu*nlambda, mpir8, 0, mpicom, ierr) + call mpibcast(ext_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(ssa_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(asm_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(abs_lw_liq, nmu*nlambda*nlwbands, mpir8, 0, mpicom, ierr) +#endif + ! Convert kext from m^2/Volume to m^2/Kg + ext_sw_liq = ext_sw_liq / 0.9970449e3_r8 + abs_lw_liq = abs_lw_liq / 0.9970449e3_r8 + + ! read ice cloud optics + if (masterproc) then + call getfil( trim(icefile), locfn, 0) + call handle_ncerr( nf90_open(locfn, NF90_NOWRITE, ncid), 'ice optics file missing') + write(iulog,*)' reading ice cloud optics from file ',locfn + call handle_ncerr(nf90_inq_dimid( ncid, 'lw_band', dimid), 'getting lw_band dim') + call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nlwbands), 'getting n lw bands') + if (f_nlwbands /= nlwbands) then + call endrun(sub//': number of lw bands does not match') + end if + call handle_ncerr(nf90_inq_dimid( ncid, 'sw_band', dimid), 'getting sw_band_dim') + call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nswbands), 'getting n sw bands') + if (f_nswbands /= nswbands) then + call endrun(sub//': number of sw bands does not match') + end if + call handle_ncerr(nf90_inq_dimid( ncid, 'd_eff', d_dimid), 'getting deff dim') + call handle_ncerr(nf90_inquire_dimension( ncid, d_dimid, len=n_g_d), 'getting n deff samples') + end if ! if (masterproc) + +#if ( defined SPMD ) + call mpibcast(n_g_d, 1, mpiint, 0, mpicom, ierr) +! call mpibcast(nswbands, 1, mpiint, 0, mpicom, ierr) +! call mpibcast(nlwbands, 1, mpiint, 0, mpicom, ierr) +#endif + + allocate(g_d_eff(n_g_d)) + allocate(ext_sw_ice(n_g_d,nswbands)) + allocate(ssa_sw_ice(n_g_d,nswbands)) + allocate(asm_sw_ice(n_g_d,nswbands)) + allocate(abs_lw_ice(n_g_d,nlwbands)) + + if (masterproc) then + call handle_ncerr( nf90_inq_varid(ncid, 'd_eff', d_id),& + 'cloud optics deff get') + call handle_ncerr( nf90_get_var(ncid, d_id, g_d_eff),& + 'read cloud optics deff values') + + call handle_ncerr( nf90_inq_varid(ncid, 'sw_ext', ext_sw_ice_id),& + 'cloud optics ext_sw_ice get') + call handle_ncerr(nf90_inquire_variable ( ncid, ext_sw_ice_id, ndims=ndims, dimids=vdimids),& + 'checking dimensions of ext_sw_ice') + call handle_ncerr(nf90_inquire_dimension( ncid, vdimids(1), len=templen),& + 'getting first dimension sw_ext') + call handle_ncerr(nf90_inquire_dimension( ncid, vdimids(2), len=templen),& + 'getting first dimension sw_ext') + call handle_ncerr( nf90_get_var(ncid, ext_sw_ice_id, ext_sw_ice),& + 'read cloud optics ext_sw_ice values') + + call handle_ncerr( nf90_inq_varid(ncid, 'sw_ssa', ssa_sw_ice_id),& + 'cloud optics ssa_sw_ice get') + call handle_ncerr( nf90_get_var(ncid, ssa_sw_ice_id, ssa_sw_ice),& + 'read cloud optics ssa_sw_ice values') + + call handle_ncerr( nf90_inq_varid(ncid, 'sw_asm', asm_sw_ice_id),& + 'cloud optics asm_sw_ice get') + call handle_ncerr( nf90_get_var(ncid, asm_sw_ice_id, asm_sw_ice),& + 'read cloud optics asm_sw_ice values') + + call handle_ncerr( nf90_inq_varid(ncid, 'lw_abs', abs_lw_ice_id),& + 'cloud optics abs_lw_ice get') + call handle_ncerr( nf90_get_var(ncid, abs_lw_ice_id, abs_lw_ice),& + 'read cloud optics abs_lw_ice values') + + call handle_ncerr( nf90_close(ncid), 'ice optics file missing') + end if ! if masterproc + +#if ( defined SPMD ) + call mpibcast(g_d_eff, n_g_d, mpir8, 0, mpicom, ierr) + call mpibcast(ext_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(ssa_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(asm_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) + call mpibcast(abs_lw_ice, n_g_d*nlwbands, mpir8, 0, mpicom, ierr) +#endif + + return + +end subroutine cloud_rad_props_init + +!============================================================================== + +subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, oldliq, oldice, oldcloud) + + ! Purpose: Compute cloud longwave absorption optical depth + + ! Arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer:: pbuf(:) + real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer + logical, optional, intent(in) :: oldliq ! use old liquid optics + logical, optional, intent(in) :: oldice ! use old ice optics + logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) + + ! Local variables + integer :: ncol ! number of columns + + ! rad properties for liquid clouds + real(r8) :: liq_tau_abs_od(nlwbands,pcols,pver) ! liquid cloud absorption optical depth + + ! rad properties for ice clouds + real(r8) :: ice_tau_abs_od(nlwbands,pcols,pver) ! ice cloud absorption optical depth + !----------------------------------------------------------------------------- + + ncol = state%ncol + + cld_abs_od = 0._r8 + + if(present(oldcloud))then + if(oldcloud) then + call oldcloud_lw(state,pbuf,cld_abs_od,oldwp=.false.) + return + endif + endif + + if(present(oldliq))then + if(oldliq) then + call old_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.false.) + else + call liquid_cloud_get_rad_props_lw(state, pbuf, liq_tau_abs_od) + endif + else + call liquid_cloud_get_rad_props_lw(state, pbuf, liq_tau_abs_od) + endif + + if(present(oldice))then + if(oldice) then + call old_ice_get_rad_props_lw(state, pbuf, ice_tau_abs_od, oldicewp=.false.) + else + call ice_cloud_get_rad_props_lw(state, pbuf, ice_tau_abs_od) + endif + else + call ice_cloud_get_rad_props_lw(state, pbuf, ice_tau_abs_od) + endif + + cld_abs_od(:,1:ncol,:) = liq_tau_abs_od(:,1:ncol,:) + ice_tau_abs_od(:,1:ncol,:) + +end subroutine cloud_rad_props_get_lw + +!============================================================================== + +subroutine get_ice_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + real(r8), pointer :: iciwpth(:,:), dei(:,:) + + ! Get relevant pbuf fields, and interpolate optical properties from + ! the lookup tables. + call pbuf_get_field(pbuf, i_iciwp, iciwpth) + call pbuf_get_field(pbuf, i_dei, dei) + + call interpolate_ice_optics_sw(state%ncol, iciwpth, dei, tau, tau_w, & + tau_w_g, tau_w_f) + +end subroutine get_ice_optics_sw + +!============================================================================== + +subroutine get_snow_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + real(r8), pointer :: icswpth(:,:), des(:,:) + + ! This does the same thing as get_ice_optics_sw, except with a different + ! water path and effective diameter. + call pbuf_get_field(pbuf, i_icswp, icswpth) + call pbuf_get_field(pbuf, i_des, des) + + call interpolate_ice_optics_sw(state%ncol, icswpth, des, tau, tau_w, & + tau_w_g, tau_w_f) + +end subroutine get_snow_optics_sw + +!============================================================================== + +subroutine get_grau_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + real(r8), pointer :: icgrauwpth(:,:), degrau(:,:) + + integer :: i,k + character(len=*), parameter :: sub = 'get_grau_optics_sw' + + ! This does the same thing as get_ice_optics_sw, except with a different + ! water path and effective diameter. + if((i_icgrauwp > 0) .and. (i_degrau > 0)) then + + call pbuf_get_field(pbuf, i_icgrauwp, icgrauwpth) + call pbuf_get_field(pbuf, i_degrau, degrau) + + call interpolate_ice_optics_sw(state%ncol, icgrauwpth, degrau, tau, tau_w, & + tau_w_g, tau_w_f) + do i = 1, pcols + do k = 1, pver + if (tau(idx_sw_diag,i,k).gt.100._r8) then + write(iulog,*) 'WARNING: SW Graupel Tau > 100 (i,k,icgrauwpth,degrau,tau):' + write(iulog,*) i,k,icgrauwpth(i,k), degrau(i,k), tau(idx_sw_diag,i,k) + end if + enddo + enddo + + else + call endrun(sub//': ERROR: Get_grau_optics_sw called when graupel properties not supported') + end if + +end subroutine get_grau_optics_sw + +!============================================================================== + +subroutine get_liquid_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth + real(r8), dimension(pcols,pver) :: kext + integer i,k,swband, ncol + + ncol = state%ncol + + + call pbuf_get_field(pbuf, i_lambda, lamc) + call pbuf_get_field(pbuf, i_mu, pgam) + call pbuf_get_field(pbuf, i_iclwp, iclwpth) + + do k = 1,pver + do i = 1,ncol + if(lamc(i,k) > 0._r8) then ! This seems to be clue from microphysics of no cloud + call gam_liquid_sw(iclwpth(i,k), lamc(i,k), pgam(i,k), & + tau(1:nswbands,i,k), tau_w(1:nswbands,i,k), tau_w_g(1:nswbands,i,k), tau_w_f(1:nswbands,i,k)) + else + tau(1:nswbands,i,k) = 0._r8 + tau_w(1:nswbands,i,k) = 0._r8 + tau_w_g(1:nswbands,i,k) = 0._r8 + tau_w_f(1:nswbands,i,k) = 0._r8 + endif + enddo + enddo + +end subroutine get_liquid_optics_sw + +!============================================================================== + +subroutine liquid_cloud_get_rad_props_lw(state, pbuf, abs_od) + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + + integer :: ncol + real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth + + integer lwband, i, k + + abs_od = 0._r8 + + ncol = state%ncol + + call pbuf_get_field(pbuf, i_lambda, lamc) + call pbuf_get_field(pbuf, i_mu, pgam) + call pbuf_get_field(pbuf, i_iclwp, iclwpth) + + do k = 1,pver + do i = 1,ncol + if(lamc(i,k) > 0._r8) then ! This seems to be the clue for no cloud from microphysics formulation + call gam_liquid_lw(iclwpth(i,k), lamc(i,k), pgam(i,k), abs_od(1:nlwbands,i,k)) + else + abs_od(1:nlwbands,i,k) = 0._r8 + endif + enddo + enddo + +end subroutine liquid_cloud_get_rad_props_lw +!============================================================================== + +subroutine snow_cloud_get_rad_props_lw(state, pbuf, abs_od) + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + + real(r8), pointer :: icswpth(:,:), des(:,:) + + ! This does the same thing as ice_cloud_get_rad_props_lw, except with a + ! different water path and effective diameter. + call pbuf_get_field(pbuf, i_icswp, icswpth) + call pbuf_get_field(pbuf, i_des, des) + + call interpolate_ice_optics_lw(state%ncol,icswpth, des, abs_od) + +end subroutine snow_cloud_get_rad_props_lw + + +!============================================================================== + +subroutine grau_cloud_get_rad_props_lw(state, pbuf, abs_od) + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + + real(r8), pointer :: icgrauwpth(:,:), degrau(:,:) + character(len=*), parameter :: sub = 'grau_cloud_get_rad_props_lw' + + ! This does the same thing as ice_cloud_get_rad_props_lw, except with a + ! different water path and effective diameter. + if((i_icgrauwp > 0) .and. (i_degrau > 0)) then + call pbuf_get_field(pbuf, i_icgrauwp, icgrauwpth) + call pbuf_get_field(pbuf, i_degrau, degrau) + + call interpolate_ice_optics_lw(state%ncol,icgrauwpth, degrau, abs_od) + else + call endrun(sub//': ERROR: Grau_cloud_get_rad_props_lw called when graupel & + &properties not supported') + end if + +end subroutine grau_cloud_get_rad_props_lw + +!============================================================================== + +subroutine ice_cloud_get_rad_props_lw(state, pbuf, abs_od) + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + + real(r8), pointer :: iciwpth(:,:), dei(:,:) + + ! Get relevant pbuf fields, and interpolate optical properties from + ! the lookup tables. + call pbuf_get_field(pbuf, i_iciwp, iciwpth) + call pbuf_get_field(pbuf, i_dei, dei) + + call interpolate_ice_optics_lw(state%ncol,iciwpth, dei, abs_od) + +end subroutine ice_cloud_get_rad_props_lw + +!============================================================================== +! Private methods +!============================================================================== + +subroutine interpolate_ice_optics_sw(ncol, iciwpth, dei, tau, tau_w, & + tau_w_g, tau_w_f) + + integer, intent(in) :: ncol + real(r8), intent(in) :: iciwpth(pcols,pver) + real(r8), intent(in) :: dei(pcols,pver) + + real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w + real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + + type(interp_type) :: dei_wgts + + integer :: i, k, swband + real(r8) :: ext(nswbands), ssa(nswbands), asm(nswbands) + + do k = 1,pver + do i = 1,ncol + if( iciwpth(i,k) < tiny .or. dei(i,k) == 0._r8) then + ! if ice water path is too small, OD := 0 + tau (:,i,k) = 0._r8 + tau_w (:,i,k) = 0._r8 + tau_w_g(:,i,k) = 0._r8 + tau_w_f(:,i,k) = 0._r8 + else + ! for each cell interpolate to find weights in g_d_eff grid. + call lininterp_init(g_d_eff, n_g_d, dei(i:i,k), 1, & + extrap_method_bndry, dei_wgts) + ! interpolate into grid and extract radiative properties + do swband = 1, nswbands + call lininterp(ext_sw_ice(:,swband), n_g_d, & + ext(swband:swband), 1, dei_wgts) + call lininterp(ssa_sw_ice(:,swband), n_g_d, & + ssa(swband:swband), 1, dei_wgts) + call lininterp(asm_sw_ice(:,swband), n_g_d, & + asm(swband:swband), 1, dei_wgts) + end do + tau (:,i,k) = iciwpth(i,k) * ext + tau_w (:,i,k) = tau(:,i,k) * ssa + tau_w_g(:,i,k) = tau_w(:,i,k) * asm + tau_w_f(:,i,k) = tau_w_g(:,i,k) * asm + call lininterp_finish(dei_wgts) + endif + enddo + enddo + +end subroutine interpolate_ice_optics_sw + +!============================================================================== + +subroutine interpolate_ice_optics_lw(ncol, iciwpth, dei, abs_od) + + integer, intent(in) :: ncol + real(r8), intent(in) :: iciwpth(pcols,pver) + real(r8), intent(in) :: dei(pcols,pver) + + real(r8),intent(out) :: abs_od(nlwbands,pcols,pver) + + type(interp_type) :: dei_wgts + + integer :: i, k, lwband + real(r8) :: absor(nlwbands) + + do k = 1,pver + do i = 1,ncol + ! if ice water path is too small, OD := 0 + if( iciwpth(i,k) < tiny .or. dei(i,k) == 0._r8) then + abs_od (:,i,k) = 0._r8 + else + ! for each cell interpolate to find weights in g_d_eff grid. + call lininterp_init(g_d_eff, n_g_d, dei(i:i,k), 1, & + extrap_method_bndry, dei_wgts) + ! interpolate into grid and extract radiative properties + do lwband = 1, nlwbands + call lininterp(abs_lw_ice(:,lwband), n_g_d, & + absor(lwband:lwband), 1, dei_wgts) + enddo + abs_od(:,i,k) = iciwpth(i,k) * absor + where(abs_od(:,i,k) > 50.0_r8) abs_od(:,i,k) = 50.0_r8 + call lininterp_finish(dei_wgts) + endif + enddo + enddo + +end subroutine interpolate_ice_optics_lw + +!============================================================================== + +subroutine gam_liquid_lw(clwptn, lamc, pgam, abs_od) + real(r8), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? + real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud + real(r8), intent(in) :: pgam ! prognosed value of mu for cloud + real(r8), intent(out) :: abs_od(1:nlwbands) + + integer :: lwband ! sw band index + + type(interp_type) :: mu_wgts + type(interp_type) :: lambda_wgts + + if (clwptn < tiny) then + abs_od = 0._r8 + return + endif + + call get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) + + do lwband = 1, nlwbands + call lininterp(abs_lw_liq(:,:,lwband), nmu, nlambda, & + abs_od(lwband:lwband), 1, mu_wgts, lambda_wgts) + enddo + + abs_od = clwptn * abs_od + + call lininterp_finish(mu_wgts) + call lininterp_finish(lambda_wgts) + +end subroutine gam_liquid_lw + +!============================================================================== + +subroutine gam_liquid_sw(clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f) + real(r8), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? + real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud + real(r8), intent(in) :: pgam ! prognosed value of mu for cloud + real(r8), intent(out) :: tau(1:nswbands), tau_w(1:nswbands), tau_w_f(1:nswbands), tau_w_g(1:nswbands) + + integer :: swband ! sw band index + + real(r8) :: ext(nswbands), ssa(nswbands), asm(nswbands) + + type(interp_type) :: mu_wgts + type(interp_type) :: lambda_wgts + + if (clwptn < tiny) then + tau = 0._r8 + tau_w = 0._r8 + tau_w_g = 0._r8 + tau_w_f = 0._r8 + return + endif + + call get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) + + do swband = 1, nswbands + call lininterp(ext_sw_liq(:,:,swband), nmu, nlambda, & + ext(swband:swband), 1, mu_wgts, lambda_wgts) + call lininterp(ssa_sw_liq(:,:,swband), nmu, nlambda, & + ssa(swband:swband), 1, mu_wgts, lambda_wgts) + call lininterp(asm_sw_liq(:,:,swband), nmu, nlambda, & + asm(swband:swband), 1, mu_wgts, lambda_wgts) + enddo + + ! compute radiative properties + tau = clwptn * ext + tau_w = tau * ssa + tau_w_g = tau_w * asm + tau_w_f = tau_w_g * asm + + call lininterp_finish(mu_wgts) + call lininterp_finish(lambda_wgts) + +end subroutine gam_liquid_sw + +!============================================================================== + +subroutine get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) + real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud + real(r8), intent(in) :: pgam ! prognosed value of mu for cloud + ! Output interpolation weights. Caller is responsible for freeing these. + type(interp_type), intent(out) :: mu_wgts + type(interp_type), intent(out) :: lambda_wgts + + integer :: ilambda + real(r8) :: g_lambda_interp(nlambda) + + ! Make interpolation weights for mu. + ! (Put pgam in a temporary array for this purpose.) + call lininterp_init(g_mu, nmu, [pgam], 1, extrap_method_bndry, mu_wgts) + + ! Use mu weights to interpolate to a row in the lambda table. + do ilambda = 1, nlambda + call lininterp(g_lambda(:,ilambda), nmu, & + g_lambda_interp(ilambda:ilambda), 1, mu_wgts) + end do + + ! Make interpolation weights for lambda. + call lininterp_init(g_lambda_interp, nlambda, [lamc], 1, & + extrap_method_bndry, lambda_wgts) + +end subroutine get_mu_lambda_weights + +!============================================================================== + +end module cloud_rad_props diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index e4417f83fe..9bbed56277 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -4,36 +4,66 @@ module clubb_intr ! Module to interface CAM with Cloud Layers Unified by Bi-normals (CLUBB), developed ! ! by the University of Wisconsin Milwaukee Group (UWM). ! ! ! - ! CLUBB replaces the exisiting turbulence, shallow convection, and macrophysics in CAM5 ! - ! ! + ! CLUBB replaces the exisiting turbulence, shallow convection, and macrophysics in CAM5 ! + ! ! ! Lastly, a implicit diffusion solver is called, and tendencies retrieved by ! ! differencing the diffused and initial states. ! - ! ! + ! ! ! Calling sequence: ! ! ! !---------------------------Code history-------------------------------------------------------------- ! - ! Authors: P. Bogenschutz, C. Craig, A. Gettelman ! - ! Modified by: K Thayer-Calder ! - ! ! + ! Authors: P. Bogenschutz, C. Craig, A. Gettelman ! + ! Modified by: K Thayer-Calder ! + ! ! !----------------------------------------------------------------------------------------------------- ! - use shr_kind_mod, only: r8=>shr_kind_r8 - use ppgrid, only: pver, pverp, pcols, begchunk, endchunk - use phys_control, only: phys_getopts - use physconst, only: rairv, cpairv, cpair, gravit, latvap, latice, zvir, rh2o, karman + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: pver, pverp, pcols, begchunk, endchunk + use phys_control, only: phys_getopts + use physconst, only: cpair, gravit, rga, latvap, latice, zvir, rh2o, karman, pi + use air_composition, only: rairv, cpairv + use cam_history_support, only: max_fieldname_len + + use spmd_utils, only: masterproc + use constituents, only: pcnst, cnst_add + use pbl_utils, only: calc_ustar, calc_obklen + use ref_pres, only: top_lev => trop_cloud_top_lev - use spmd_utils, only: masterproc - use constituents, only: pcnst, cnst_add - use pbl_utils, only: calc_ustar, calc_obklen - use ref_pres, only: top_lev => trop_cloud_top_lev - use zm_conv_intr, only: zmconv_microp #ifdef CLUBB_SGS - use clubb_api_module, only: pdf_parameter, implicit_coefs_terms - use clubb_api_module, only: clubb_config_flags_type - use clubb_mf, only: do_clubb_mf, do_clubb_mf_diag + 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, & + 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 + + integer :: & + nzm_clubb, & !Number of vertical levels used by CLUBB momentum variables + nzt_clubb !Number of vertical levels used by CLUBB thermodynamic variables +#endif + private save @@ -41,13 +71,15 @@ module clubb_intr ! Public interfaces ! ! ----------------- ! - public :: clubb_ini_cam, clubb_register_cam, clubb_tend_cam, & + public :: clubb_ini_cam, clubb_register_cam, clubb_tend_cam, clubb_emissions_cam, & #ifdef CLUBB_SGS ! This utilizes CLUBB specific variables in its interface stats_init_clubb, & - init_clubb_config_flags, & + stats_metadata, & + stats_zt, stats_zm, stats_sfc, & + stats_rad_zt, stats_rad_zm, & + stats_end_timestep_clubb, & #endif - stats_end_timestep_clubb, & clubb_readnl, & clubb_init_cnst, & clubb_implements_cnst @@ -62,6 +94,32 @@ module clubb_intr #ifdef CLUBB_SGS type(clubb_config_flags_type), public :: clubb_config_flags + 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 ! ------------ ! @@ -70,35 +128,36 @@ module clubb_intr 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 - - real(r8), parameter, dimension(0) :: & - sclr_tol = 1.e-8_r8 ! Total water in kg/kg + sclr_dim = 0 ! Higher-order scalars, set to zero - character(len=6) :: saturation_equation + ! 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 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 - - real(r8), parameter :: & + + real(r8), parameter :: & wpthlp_const = 10.0_r8 ! Constant to add to wpthlp when moments are advected - - real(r8), parameter :: & + + real(r8), parameter :: & wprtp_const = 0.01_r8 ! Constant to add to wprtp when moments are advected - - real(r8), parameter :: & + + real(r8), parameter :: & rtpthlp_const = 0.01_r8 ! Constant to add to rtpthlp when moments are advected - + real(r8), parameter :: unset_r8 = huge(1.0_r8) - + integer, parameter :: unset_i = huge(1) + + ! Commonly used temperature for the melting temp of ice crystals [K] + real(r8), parameter :: meltpt_temp = 268.15_r8 + real(r8) :: clubb_timestep = unset_r8 ! Default CLUBB timestep, unless overwriten by namelist real(r8) :: clubb_rnevap_effic = unset_r8 @@ -108,6 +167,12 @@ module clubb_intr real(r8) :: clubb_C2thl = unset_r8 real(r8) :: clubb_C2rtthl = unset_r8 real(r8) :: clubb_C4 = unset_r8 + real(r8) :: clubb_C6rt = unset_r8 + real(r8) :: clubb_c6rtb = unset_r8 + real(r8) :: clubb_c6rtc = unset_r8 + real(r8) :: clubb_c6thl = unset_r8 + real(r8) :: clubb_c6thlb = unset_r8 + real(r8) :: clubb_c6thlc = unset_r8 real(r8) :: clubb_C8 = unset_r8 real(r8) :: clubb_C8b = unset_r8 real(r8) :: clubb_C7 = unset_r8 @@ -115,10 +180,25 @@ module clubb_intr real(r8) :: clubb_c11 = unset_r8 real(r8) :: clubb_c11b = unset_r8 real(r8) :: clubb_c14 = unset_r8 + real(r8) :: clubb_C_wp3_pr_turb = unset_r8 + real(r8) :: clubb_c_K1 = unset_r8 + real(r8) :: clubb_c_K2 = unset_r8 + real(r8) :: clubb_nu2 = unset_r8 + real(r8) :: clubb_c_K8 = unset_r8 real(r8) :: clubb_c_K9 = unset_r8 real(r8) :: clubb_nu9 = unset_r8 real(r8) :: clubb_c_K10 = unset_r8 real(r8) :: clubb_c_K10h = unset_r8 + real(r8) :: clubb_C_invrs_tau_bkgnd = unset_r8 + real(r8) :: clubb_C_invrs_tau_sfc = unset_r8 + real(r8) :: clubb_C_invrs_tau_shear = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2 = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2_wp2 = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2_xp2 = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2_wpxp = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2_clear_wp3 = unset_r8 + real(r8) :: clubb_C_uu_shr = unset_r8 + real(r8) :: clubb_C_uu_buoy = unset_r8 real(r8) :: clubb_gamma_coef = unset_r8 real(r8) :: clubb_gamma_coefb = unset_r8 real(r8) :: clubb_beta = unset_r8 @@ -127,52 +207,169 @@ module clubb_intr real(r8) :: clubb_mult_coef = unset_r8 real(r8) :: clubb_Skw_denom_coef = unset_r8 real(r8) :: clubb_skw_max_mag = unset_r8 - real(r8) :: clubb_up2_vp2_factor = unset_r8 + real(r8) :: clubb_up2_sfc_coef = unset_r8 real(r8) :: clubb_C_wp2_splat = unset_r8 - logical :: clubb_l_brunt_vaisala_freq_moist = .false. - logical :: clubb_l_call_pdf_closure_twice = .false. - logical :: clubb_l_damp_wp3_Skw_squared = .false. - logical :: clubb_l_min_wp2_from_corr_wx = .false. - logical :: clubb_l_min_xp2_from_corr_wx = .false. - logical :: clubb_l_predict_upwp_vpwp = .false. - logical :: clubb_l_rcm_supersat_adj = .false. - logical :: clubb_l_stability_correct_tau_zm = .false. - logical :: clubb_l_trapezoidal_rule_zt = .false. - logical :: clubb_l_trapezoidal_rule_zm = .false. - logical :: clubb_l_upwind_xpyp_ta = .false. - logical :: clubb_l_use_C7_Richardson = .false. - logical :: clubb_l_use_C11_Richardson = .false. - logical :: clubb_l_use_cloud_cover = .false. - logical :: clubb_l_use_thvm_in_bv_freq = .false. - logical :: clubb_l_vert_avg_closure = .false. - logical :: clubb_l_diag_Lscale_from_tau = .false. - logical :: clubb_l_damp_wp2_using_em = .false. + real(r8) :: clubb_wpxp_L_thresh = unset_r8 + real(r8) :: clubb_detliq_rad = unset_r8 + real(r8) :: clubb_detice_rad = unset_r8 + real(r8) :: clubb_detphase_lowtemp = unset_r8 + real(r8) :: clubb_bv_efold = unset_r8 + real(r8) :: clubb_wpxp_Ri_exp = unset_r8 + real(r8) :: clubb_z_displace = unset_r8 + + integer :: & + clubb_iiPDF_type, & ! Selected option for the two-component normal + ! (double Gaussian) PDF type to use for the w, rt, + ! and theta-l (or w, chi, and eta) portion of + ! CLUBB's multivariate, two-component PDF. + 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_saturation_equation = unset_i ! Specifier for which saturation formula to use + + + logical :: & + clubb_l_use_precip_frac, & ! Flag to use precipitation fraction in KK microphysics. The + ! precipitation fraction is automatically set to 1 when this + ! flag is turned off. + clubb_l_predict_upwp_vpwp, & ! Flag to predict and along with and + ! alongside the advancement of , , , + ! , , and in subroutine + ! advance_xm_wpxp. Otherwise, and are still + ! approximated by eddy diffusivity when and are + ! advanced in subroutine advance_windm_edsclrm. + clubb_l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping + ! the overall correlation of w and x (w and rt, as well as w + ! and theta-l) within the limits of -max_mag_correlation_flux + ! to max_mag_correlation_flux. + clubb_l_min_xp2_from_corr_wx, & ! Flag to base the threshold minimum value of xp2 (rtp2 and + ! thlp2) on keeping the overall correlation of w and x within + ! the limits of -max_mag_correlation_flux to + ! max_mag_correlation_flux. + clubb_l_C2_cloud_frac, & ! Flag to use cloud fraction to adjust the value of the + ! turbulent dissipation coefficient, C2. + clubb_l_diffuse_rtm_and_thlm, & ! Diffuses rtm and thlm + clubb_l_stability_correct_Kh_N2_zm, & ! Divides Kh_N2_zm by a stability factor + clubb_l_calc_thlp2_rad, & ! Include the contribution of radiation to thlp2 + clubb_l_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent or mean advection terms. It + ! affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, & + ! sclrpthlp. + clubb_l_upwind_xm_ma, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent or mean advection terms. It + ! affects rtm, thlm, sclrm, um and vm. + clubb_l_uv_nudge, & ! For wind speed nudging. + clubb_l_rtm_nudge, & ! For rtm nudging + clubb_l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. + ! TKE = 1/2 (u'^2 + v'^2 + w'^2) + clubb_l_vert_avg_closure, & ! Use 2 calls to pdf_closure and the trapezoidal rule to + ! compute the varibles that are output from high order + ! closure + clubb_l_trapezoidal_rule_zt, & ! If true, the trapezoidal rule is called for the + ! thermodynamic-level variables output from pdf_closure. + clubb_l_trapezoidal_rule_zm, & ! If true, the trapezoidal rule is called for three + ! momentum-level variables - wpthvp, thlpthvp, and rtpthvp - + ! output from pdf_closure. + clubb_l_call_pdf_closure_twice, & ! This logical flag determines whether or not to call + ! subroutine pdf_closure twice. If true, pdf_closure is + ! called first on thermodynamic levels and then on momentum + ! levels so that each variable is computed on its native + ! level. If false, pdf_closure is only called on + ! thermodynamic levels, and variables which belong on + ! momentum levels are interpolated. + clubb_l_standard_term_ta, & ! Use the standard discretization for the turbulent advection + ! terms. Setting to .false. means that a_1 and a_3 are + ! pulled outside of the derivative in + ! advance_wp2_wp3_module.F90 and in + ! advance_xp2_xpyp_module.F90. + clubb_l_partial_upwind_wp3, & ! Flag to use an "upwind" discretization rather + ! than a centered discretization for the portion + ! of the wp3 turbulent advection term for ADG1 + ! that is linearized in terms of wp3. + ! (Requires ADG1 PDF and clubb_l_standard_term_ta). + clubb_l_godunov_upwind_wpxp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent advection terms. + ! It affects wpxp only. + clubb_l_godunov_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent advection terms. It affects + ! xpyp only. + clubb_l_use_cloud_cover, & ! Use cloud_cover and rcm_in_layer to help boost cloud_frac + ! and rcm to help increase cloudiness at coarser grid + ! resolutions. + clubb_l_diagnose_correlations, & ! Diagnose correlations instead of using fixed ones + clubb_l_calc_w_corr, & ! Calculate the correlations between w and the hydrometeors + clubb_l_const_Nc_in_cloud, & ! Use a constant cloud droplet conc. within cloud (K&K) + clubb_l_fix_w_chi_eta_correlations, & ! Use a fixed correlation for s and t Mellor(chi/eta) + clubb_l_stability_correct_tau_zm, & ! Use tau_N2_zm instead of tau_zm in wpxp_pr1 stability + ! correction + clubb_l_damp_wp2_using_em, & ! In wp2 equation, use a dissipation formula of + ! -(2/3)*em/tau_zm, as in Bougeault (1981) + clubb_l_do_expldiff_rtm_thlm, & ! Diffuse rtm and thlm explicitly + clubb_l_Lscale_plume_centered, & ! Alternate that uses the PDF to compute the perturbed values + clubb_l_diag_Lscale_from_tau, & ! First diagnose dissipation time tau, and then diagnose the + ! mixing length scale as Lscale = tau * tke + clubb_l_use_C7_Richardson, & ! Parameterize C7 based on Richardson number + clubb_l_use_C11_Richardson, & ! Parameterize C11 and C16 based on Richardson number + clubb_l_use_shear_Richardson, & ! Use shear in the calculation of Richardson number + clubb_l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in + ! saturated atmospheres (from Durran and Klemp, 1982) + clubb_l_use_thvm_in_bv_freq, & ! Use thvm in the calculation of Brunt-Vaisala frequency + clubb_l_rcm_supersat_adj, & ! Add excess supersaturated vapor to cloud water + clubb_l_lmm_stepping, & ! Apply Linear Multistep Method (LMM) Stepping + clubb_l_e3sm_config, & ! Run model with E3SM settings + clubb_l_vary_convect_depth, & ! Flag used to calculate convective velocity using + ! a variable estimate of layer depth based on the depth + ! over which wpthlp is positive near the ground when true + ! More information can be found by + ! Looking at issue #905 on the clubb repo + clubb_l_use_tke_in_wp3_pr_turb_term,& ! Use TKE formulation for wp3 pr_turb term + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Use TKE in eddy diffusion for wp2 and wp3 + clubb_l_use_wp3_lim_with_smth_Heaviside, & ! Flag to activate mods on wp3 limiters for conv test + clubb_l_smooth_Heaviside_tau_wpxp, & ! Use smooth Heaviside 'Peskin' in computation of invrs_tau + clubb_l_modify_limiters_for_cnvg_test, & ! Flag to activate mods on limiters for conv test + clubb_l_enable_relaxed_clipping, & ! Flag to relax clipping on wpxp in xm_wpxp_clipping_and_stats + clubb_l_linearize_pbl_winds, & ! Flag to turn on code to linearize PBL winds + clubb_l_single_C2_Skw, & ! Use a single Skewness dependent C2 for rtp2, thlp2, and + ! rtpthlp + clubb_l_damp_wp3_Skw_squared, & ! Set damping on wp3 to use Skw^2 rather than Skw^4 + clubb_l_prescribed_avg_deltaz, & ! used in adj_low_res_nu. If .true., avg_deltaz = deltaz + clubb_l_update_pressure, & ! Flag for having CLUBB update pressure and exner + clubb_l_mono_flux_lim_thlm, & ! Flag to turn on monotonic flux limiter for thlm + clubb_l_mono_flux_lim_rtm, & ! Flag to turn on monotonic flux limiter for rtm + clubb_l_mono_flux_lim_um, & ! Flag to turn on monotonic flux limiter for um + 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_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)) + apply_to_heat = .false. ! Apply WACCM energy fixer to heat or not (.true. = yes (duh)) logical :: lq(pcnst) logical :: prog_modal_aero logical :: do_rainturb - logical :: do_expldiff logical :: clubb_do_adv logical :: clubb_do_liqsupersat = .false. logical :: clubb_do_energyfix = .true. logical :: history_budget - - logical :: clubb_l_lscale_plume_centered - logical :: clubb_l_use_ice_latent - + logical :: do_hb_above_clubb = .false. integer :: history_budget_histfile_num integer :: edsclr_dim ! Number of scalars to transport in CLUBB integer :: offset - -! define physics buffer indicies here + +! define physics buffer indicies here integer :: & wp2_idx, & ! vertical velocity variances wp3_idx, & ! third moment of vertical velocity @@ -198,6 +395,16 @@ module clubb_intr rtpthvp_idx, & ! moisture buoyancy correlation thlpthvp_idx, & ! temperature buoyancy correlation sclrpthvp_idx, & ! passive scalar buoyancy correlation + wp2rtp_idx, & ! w'^2 rt' + wp2thlp_idx, & ! w'^2 thl' + uprcp_idx, & ! < u' r_c' > + vprcp_idx, & ! < v' r_c' > + rc_coef_idx, & ! Coefficient of X'r_c' in Eq. (34) + wp4_idx, & ! w'^4 + wpup2_idx, & ! w'u'^2 + wpvp2_idx, & ! w'v'^2 + wp2up2_idx, & ! w'^2 u'^2 + wp2vp2_idx, & ! w'^2 v'^2 cloud_frac_idx, & ! CLUBB's cloud fraction cld_idx, & ! Cloud fraction concld_idx, & ! Convective cloud fraction @@ -221,11 +428,25 @@ module clubb_intr naai_idx, & ! ice number concentration prer_evap_idx, & ! rain evaporation rate qrl_idx, & ! longwave cooling rate - radf_idx, & - qsatfac_idx, & ! subgrid cloud water saturation scaling factor + radf_idx, & + qsatfac_idx, & ! subgrid cloud water saturation scaling factor ice_supersat_idx, & ! ice cloud fraction for SILHS rcm_idx, & ! Cloud water mixing ratio for SILHS - ztodt_idx ! physics timestep for SILHS + 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 :: & @@ -235,7 +456,14 @@ module clubb_intr wpthlp_mc_zt_idx, & rtpthlp_mc_zt_idx - integer, public :: & + integer :: & ! added pbuf fields for clubb to have restart bfb when ipdf_call_placement=2 + pdf_zm_w_1_idx, & + pdf_zm_w_2_idx, & + pdf_zm_varnce_w_1_idx, & + pdf_zm_varnce_w_2_idx, & + pdf_zm_mixt_frac_idx + + integer, public :: & ixthlp2 = 0, & ixwpthlp = 0, & ixwprtp = 0, & @@ -250,11 +478,10 @@ module clubb_intr integer :: & dlfzm_idx = -1, & ! ZM detrained convective cloud water mixing ratio. - difzm_idx = -1, & ! ZM detrained convective cloud ice mixing ratio. dnlfzm_idx = -1, & ! ZM detrained convective cloud water num concen. dnifzm_idx = -1 ! ZM detrained convective cloud ice num concen. - ! Output arrays for CLUBB statistics + ! Output arrays for CLUBB statistics real(r8), allocatable, dimension(:,:,:) :: out_zt, out_zm, out_radzt, out_radzm, out_sfc character(len=16) :: eddy_scheme ! Default set in phys_control.F90 @@ -267,13 +494,15 @@ module clubb_intr #ifdef CLUBB_SGS type(pdf_parameter), target, allocatable, public, protected :: & - pdf_params_chnk(:,:) ! PDF parameters (thermo. levs.) [units vary] - type(pdf_parameter), target, allocatable :: pdf_params_zm_chnk(:,:) ! PDF parameters on momentum levs. [units vary] - type(implicit_coefs_terms), target, allocatable :: pdf_implicit_coefs_terms_chnk(:,:) ! PDF impl. coefs. & expl. terms [units vary] + pdf_params_chnk(:) ! PDF parameters (thermo. levs.) [units vary] + + type(pdf_parameter), target, allocatable :: pdf_params_zm_chnk(:) ! PDF parameters on momentum levs. [units vary] + + type(implicit_coefs_terms), target, allocatable :: pdf_implicit_coefs_terms_chnk(:) ! PDF impl. coefs. & expl. terms [units vary] #endif contains - + ! =============================================================================== ! ! ! ! =============================================================================== ! @@ -292,27 +521,24 @@ subroutine clubb_register_cam( ) ! Register physics buffer fields and constituents ! !------------------------------------------------ ! - ! Add CLUBB fields to pbuf - use physics_buffer, only: pbuf_add_field, dtype_r8, dyn_time_lvls + ! 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 - + + !----- Begin Code ----- call phys_getopts( eddy_scheme_out = eddy_scheme, & - deep_scheme_out = deep_scheme, & + deep_scheme_out = deep_scheme, & history_budget_out = history_budget, & - history_budget_histfile_num_out = history_budget_histfile_num ) - subcol_scheme = subcol_get_scheme() + history_budget_histfile_num_out = history_budget_histfile_num, & + do_hb_above_clubb_out = do_hb_above_clubb) - 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 '/) do_cnst=.true. ! If CLUBB moments are advected, do not output them automatically which is typically done. Some moments - ! need a constant added to them before they are advected, thus this would corrupt the output. + ! need a constant added to them before they are advected, thus this would corrupt the output. ! Users should refer to the "XXXX_CLUBB" (THLP2_CLUBB for instance) output variables for these moments call cnst_add(trim(cnst_names(1)),0._r8,0._r8,0._r8,ixthlp2,longname='second moment vertical velocity',cam_outfld=.false.) call cnst_add(trim(cnst_names(2)),0._r8,0._r8,0._r8,ixrtp2,longname='second moment rtp',cam_outfld=.false.) @@ -324,6 +550,9 @@ subroutine clubb_register_cam( ) call cnst_add(trim(cnst_names(8)),0._r8,0._r8,0._r8,ixup2,longname='CLUBB 2nd moment u wind',cam_outfld=.false.) call cnst_add(trim(cnst_names(9)),0._r8,0._r8,0._r8,ixvp2,longname='CLUBB 2nd moment v wind',cam_outfld=.false.) end if + if (do_hb_above_clubb) then + call pbuf_add_field('clubbtop', 'physpkg', dtype_i4, (/pcols/), clubbtop_idx) + endif ! put pbuf_add calls here (see macrop_driver.F90 for sample) use indicies defined at top call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx) @@ -342,7 +571,7 @@ subroutine clubb_register_cam( ) call pbuf_add_field('CMELIQ', 'physpkg',dtype_r8, (/pcols,pver/), cmeliq_idx) call pbuf_add_field('QSATFAC', 'physpkg',dtype_r8, (/pcols,pver/), qsatfac_idx) - + call pbuf_add_field('WP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp2_idx) call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp3_idx) call pbuf_add_field('WPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wpthlp_idx) @@ -351,7 +580,7 @@ subroutine clubb_register_cam( ) call pbuf_add_field('RTP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtp2_idx) call pbuf_add_field('THLP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlp2_idx) call pbuf_add_field('UP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), up2_idx) - call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vp2_idx) + call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vp2_idx) call pbuf_add_field('RTP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtp3_idx) call pbuf_add_field('THLP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlp3_idx) @@ -366,13 +595,36 @@ subroutine clubb_register_cam( ) call pbuf_add_field('VM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vm_idx) call pbuf_add_field('WPTHVP', 'global', dtype_r8, (/pcols,pverp/), wpthvp_idx) - call pbuf_add_field('WP2THVP', 'physpkg', dtype_r8, (/pcols,pverp/), wp2thvp_idx) - call pbuf_add_field('RTPTHVP', 'physpkg', dtype_r8, (/pcols,pverp/), rtpthvp_idx) - call pbuf_add_field('THLPTHVP', 'physpkg', dtype_r8, (/pcols,pverp/), thlpthvp_idx) - call pbuf_add_field('CLOUD_FRAC', 'physpkg', dtype_r8, (/pcols,pverp/), cloud_frac_idx) - call pbuf_add_field('ISS_FRAC', 'physpkg', dtype_r8, (/pcols,pverp/), ice_supersat_idx) + call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,pverp/), wp2thvp_idx) + call pbuf_add_field('RTPTHVP', 'global', dtype_r8, (/pcols,pverp/), rtpthvp_idx) + call pbuf_add_field('THLPTHVP', 'global', dtype_r8, (/pcols,pverp/), thlpthvp_idx) + call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,pverp/), cloud_frac_idx) + call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,pverp/), ice_supersat_idx) call pbuf_add_field('RCM', 'physpkg', dtype_r8, (/pcols,pverp/), rcm_idx) call pbuf_add_field('ZTODT', 'physpkg', dtype_r8, (/pcols/), ztodt_idx) + call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,pverp/), wp2rtp_idx) + call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,pverp/), wp2thlp_idx) + call pbuf_add_field('UPRCP', 'global', dtype_r8, (/pcols,pverp/), uprcp_idx) + call pbuf_add_field('VPRCP', 'global', dtype_r8, (/pcols,pverp/), vprcp_idx) + call pbuf_add_field('RC_COEF', 'global', dtype_r8, (/pcols,pverp/), rc_coef_idx) + call pbuf_add_field('WP4', 'global', dtype_r8, (/pcols,pverp/), wp4_idx) + call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,pverp/), wpup2_idx) + call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,pverp/), wpvp2_idx) + 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) @@ -381,7 +633,13 @@ subroutine clubb_register_cam( ) call pbuf_add_field('wpthlp_mc_zt','global',dtype_r8, (/pcols,pverp/), wpthlp_mc_zt_idx) call pbuf_add_field('rtpthlp_mc_zt','global',dtype_r8,(/pcols,pverp/), rtpthlp_mc_zt_idx) -#endif + call pbuf_add_field('pdf_zm_w_1', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_1_idx) + call pbuf_add_field('pdf_zm_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_2_idx) + call pbuf_add_field('pdf_zm_var_w_1', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_varnce_w_1_idx) + call pbuf_add_field('pdf_zm_var_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_varnce_w_2_idx) + call pbuf_add_field('pdf_zm_mixt_frac', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_mixt_frac_idx) + +#endif end subroutine clubb_register_cam ! =============================================================================== ! @@ -405,14 +663,14 @@ function clubb_implements_cnst(name) end function clubb_implements_cnst - + ! =============================================================================== ! ! ! ! =============================================================================== ! subroutine clubb_init_cnst(name, latvals, lonvals, mask, q) #ifdef CLUBB_SGS - use clubb_api_module, only: w_tol_sqd, rt_tol, thl_tol + use clubb_api_module, only: w_tol_sqd, rt_tol, thl_tol #endif !----------------------------------------------------------------------- ! @@ -485,7 +743,7 @@ subroutine clubb_init_cnst(name, latvals, lonvals, mask, q) end subroutine clubb_init_cnst - + ! =============================================================================== ! ! ! ! =============================================================================== ! @@ -496,9 +754,13 @@ subroutine clubb_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit use cam_abortutils, only: endrun - use clubb_api_module, only: l_stats, l_output_rad_files - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical, mpi_real8 + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical, mpi_real8, & + mpi_integer use clubb_mf, only: clubb_mf_readnl + + use clubb_api_module, only: & + set_default_clubb_config_flags_api, & ! Procedure(s) + initialize_clubb_config_flags_type_api #endif character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -507,44 +769,201 @@ subroutine clubb_readnl(nlfile) character(len=*), parameter :: sub = 'clubb_readnl' - logical :: clubb_history, clubb_rad_history, clubb_cloudtop_cooling, clubb_rainevap_turb, & - clubb_expldiff ! Stats enabled (T/F) + logical :: clubb_history = .false., clubb_rad_history = .false. ! Stats enabled (T/F) + logical :: clubb_cloudtop_cooling = .false., clubb_rainevap_turb = .false. integer :: iunit, read_status, ierr namelist /clubb_his_nl/ clubb_history, clubb_rad_history - namelist /clubbpbl_diff_nl/ clubb_cloudtop_cooling, clubb_rainevap_turb, clubb_expldiff, & + namelist /clubbpbl_diff_nl/ clubb_cloudtop_cooling, clubb_rainevap_turb, & clubb_do_adv, clubb_timestep, & clubb_rnevap_effic,clubb_do_icesuper - namelist /clubb_params_nl/ clubb_c1, clubb_c1b, clubb_c11, clubb_c11b, clubb_c14, clubb_mult_coef, clubb_gamma_coef, & - clubb_c_K10, clubb_c_K10h, clubb_beta, clubb_C2rt, clubb_C2thl, & - clubb_C2rtthl, clubb_C8, clubb_C8b, clubb_C7, clubb_C7b, clubb_Skw_denom_coef, & - clubb_C4, clubb_c_K9, clubb_nu9, clubb_C_wp2_splat, & - clubb_lambda0_stability_coef, clubb_l_lscale_plume_centered, & - clubb_l_use_ice_latent, clubb_do_liqsupersat, clubb_do_energyfix,& - clubb_lmin_coef, clubb_skw_max_mag, clubb_l_stability_correct_tau_zm, & - clubb_gamma_coefb, clubb_up2_vp2_factor, & - clubb_l_use_C7_Richardson, clubb_l_use_C11_Richardson, & - clubb_l_brunt_vaisala_freq_moist, clubb_l_use_thvm_in_bv_freq, & - clubb_l_rcm_supersat_adj, clubb_l_damp_wp3_Skw_squared, & - clubb_l_predict_upwp_vpwp, clubb_l_min_wp2_from_corr_wx, & - clubb_l_min_xp2_from_corr_wx, clubb_l_upwind_xpyp_ta, clubb_l_vert_avg_closure, & - clubb_l_trapezoidal_rule_zt, clubb_l_trapezoidal_rule_zm, & - clubb_l_call_pdf_closure_twice, clubb_l_use_cloud_cover, & - clubb_l_diag_Lscale_from_tau, clubb_l_damp_wp2_using_em + namelist /clubb_params_nl/ clubb_beta, & + clubb_bv_efold, & + clubb_c1, & + clubb_c1b, & + clubb_c11, & + clubb_c11b, & + clubb_c14, & + clubb_C2rt, & + clubb_C2rtthl, & + clubb_C2thl, & + clubb_C4, & + clubb_c6rt, & + clubb_c6rtb, & + clubb_c6rtc, & + clubb_c6thl, & + clubb_c6thlb, & + clubb_c6thlc, & + clubb_C7, & + clubb_C7b, & + clubb_C8, & + clubb_C8b, & + clubb_C_invrs_tau_bkgnd, & + clubb_C_invrs_tau_sfc, & + clubb_C_invrs_tau_shear, & + clubb_C_invrs_tau_N2, & + clubb_C_invrs_tau_N2_clear_wp3, & + clubb_C_invrs_tau_N2_wp2, & + clubb_C_invrs_tau_N2_wpxp, & + clubb_C_invrs_tau_N2_xp2, & + clubb_c_K1, & + clubb_c_K10, & + clubb_c_K10h, & + clubb_c_K2, & + clubb_c_K8, & + clubb_c_K9, & + clubb_C_uu_shr, & + clubb_C_uu_buoy, & + clubb_C_wp2_splat, & + clubb_C_wp3_pr_turb, & + clubb_detice_rad, & + clubb_detliq_rad, & + clubb_detphase_lowtemp, & + clubb_do_energyfix, & + clubb_do_liqsupersat, & + clubb_gamma_coef, & + clubb_gamma_coefb, & + clubb_iiPDF_type, & + clubb_ipdf_call_placement, & + clubb_lambda0_stability_coef, & + clubb_lmin_coef, & + clubb_l_brunt_vaisala_freq_moist, & + clubb_l_C2_cloud_frac, & + clubb_l_calc_thlp2_rad, & + clubb_l_calc_w_corr, & + clubb_l_call_pdf_closure_twice, & + clubb_l_const_Nc_in_cloud, & + clubb_l_damp_wp2_using_em, & + clubb_l_damp_wp3_Skw_squared, & + clubb_l_diag_Lscale_from_tau, & + clubb_l_diagnose_correlations, & + clubb_l_diffuse_rtm_and_thlm, & + clubb_l_do_expldiff_rtm_thlm, & + clubb_l_e3sm_config, & + clubb_l_enable_relaxed_clipping, & + clubb_l_fix_w_chi_eta_correlations, & + clubb_l_godunov_upwind_wpxp_ta, & + clubb_l_godunov_upwind_xpyp_ta, & + clubb_l_intr_sfc_flux_smooth, & + clubb_l_lmm_stepping, & + clubb_l_lscale_plume_centered, & + clubb_l_min_wp2_from_corr_wx, & + clubb_l_min_xp2_from_corr_wx, & + clubb_l_modify_limiters_for_cnvg_test, & + clubb_l_mono_flux_lim_rtm, & + clubb_l_mono_flux_lim_spikefix, & + clubb_l_mono_flux_lim_thlm, & + clubb_l_mono_flux_lim_um, & + clubb_l_mono_flux_lim_vm, & + clubb_l_partial_upwind_wp3, & + clubb_l_predict_upwp_vpwp, & + clubb_l_prescribed_avg_deltaz, & + clubb_l_rcm_supersat_adj, & + clubb_l_rtm_nudge, & + clubb_l_smooth_Heaviside_tau_wpxp, & + clubb_l_stability_correct_Kh_N2_zm, & + clubb_l_stability_correct_tau_zm, & + clubb_l_standard_term_ta, & + clubb_l_tke_aniso, & + clubb_l_trapezoidal_rule_zm, & + clubb_l_trapezoidal_rule_zt, & + clubb_l_upwind_xm_ma, & + clubb_l_upwind_xpyp_ta, & + clubb_l_use_C11_Richardson, & + clubb_l_use_C7_Richardson, & + clubb_l_use_cloud_cover, & + clubb_l_use_precip_frac, & + clubb_l_use_shear_Richardson, & + clubb_l_use_thvm_in_bv_freq, & + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & + clubb_l_use_tke_in_wp3_pr_turb_term, & + clubb_l_use_wp3_lim_with_smth_Heaviside, & + clubb_l_uv_nudge, & + clubb_l_vary_convect_depth, & + clubb_l_vert_avg_closure, & + clubb_mult_coef, & + clubb_nu2, & + clubb_nu9, & + clubb_penta_solve_method, & + clubb_Skw_denom_coef, & + clubb_skw_max_mag, & + clubb_tridiag_solve_method, & + clubb_up2_sfc_coef, & + clubb_wpxp_L_thresh, & + clubb_wpxp_Ri_exp, & + clubb_z_displace !----- Begin Code ----- - ! Determine if we want clubb_history to be output - clubb_history = .false. ! Initialize to false - l_stats = .false. ! Initialize to false - l_output_rad_files = .false. ! Initialize to false - do_cldcool = .false. ! Initialize to false - do_rainturb = .false. ! Initialize to false - do_expldiff = .false. ! Initialize to false - - clubb_l_lscale_plume_centered = .false. ! Initialize to false! - clubb_l_use_ice_latent = .false. ! Initialize to false! + ! 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 + do_cldcool = .false. ! Initialize to false + do_rainturb = .false. ! Initialize to false + + ! Initialize namelist variables to clubb defaults + call set_default_clubb_config_flags_api( clubb_iiPDF_type, & ! Out + clubb_ipdf_call_placement, & ! Out + clubb_penta_solve_method, & ! Out + clubb_tridiag_solve_method, & ! Out + clubb_saturation_equation, & ! Out + clubb_l_use_precip_frac, & ! Out + clubb_l_predict_upwp_vpwp, & ! Out + clubb_l_min_wp2_from_corr_wx, & ! Out + clubb_l_min_xp2_from_corr_wx, & ! Out + clubb_l_C2_cloud_frac, & ! Out + clubb_l_diffuse_rtm_and_thlm, & ! Out + clubb_l_stability_correct_Kh_N2_zm, & ! Out + clubb_l_calc_thlp2_rad, & ! Out + clubb_l_upwind_xpyp_ta, & ! Out + clubb_l_upwind_xm_ma, & ! Out + clubb_l_uv_nudge, & ! Out + clubb_l_rtm_nudge, & ! Out + clubb_l_tke_aniso, & ! Out + clubb_l_vert_avg_closure, & ! Out + clubb_l_trapezoidal_rule_zt, & ! Out + clubb_l_trapezoidal_rule_zm, & ! Out + clubb_l_call_pdf_closure_twice, & ! Out + clubb_l_standard_term_ta, & ! Out + clubb_l_partial_upwind_wp3, & ! Out + clubb_l_godunov_upwind_wpxp_ta, & ! Out + clubb_l_godunov_upwind_xpyp_ta, & ! Out + clubb_l_use_cloud_cover, & ! Out + clubb_l_diagnose_correlations, & ! Out + clubb_l_calc_w_corr, & ! Out + clubb_l_const_Nc_in_cloud, & ! Out + clubb_l_fix_w_chi_eta_correlations, & ! Out + clubb_l_stability_correct_tau_zm, & ! Out + clubb_l_damp_wp2_using_em, & ! Out + clubb_l_do_expldiff_rtm_thlm, & ! Out + clubb_l_Lscale_plume_centered, & ! Out + clubb_l_diag_Lscale_from_tau, & ! Out + clubb_l_use_C7_Richardson, & ! Out + clubb_l_use_C11_Richardson, & ! Out + clubb_l_use_shear_Richardson, & ! Out + clubb_l_brunt_vaisala_freq_moist, & ! Out + clubb_l_use_thvm_in_bv_freq, & ! Out + clubb_l_rcm_supersat_adj, & ! Out + clubb_l_damp_wp3_Skw_squared, & ! Out + clubb_l_prescribed_avg_deltaz, & ! Out + clubb_l_lmm_stepping, & ! Out + clubb_l_e3sm_config, & ! Out + clubb_l_vary_convect_depth, & ! Out + clubb_l_use_tke_in_wp3_pr_turb_term, & ! Out + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Out + clubb_l_use_wp3_lim_with_smth_Heaviside, & ! Out + clubb_l_smooth_Heaviside_tau_wpxp, & ! Out + clubb_l_modify_limiters_for_cnvg_test, & ! Out + clubb_l_enable_relaxed_clipping, & ! Out + clubb_l_linearize_pbl_winds, & ! Out + clubb_l_mono_flux_lim_thlm, & ! Out + clubb_l_mono_flux_lim_rtm, & ! Out + clubb_l_mono_flux_lim_um, & ! Out + clubb_l_mono_flux_lim_vm, & ! Out + clubb_l_mono_flux_lim_spikefix, & ! Out + clubb_l_host_applies_sfc_fluxes ) ! Out ! Call CLUBB+MF namelist call clubb_mf_readnl(nlfile) @@ -595,8 +1014,6 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_cloudtop_cooling") call mpi_bcast(clubb_rainevap_turb, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rainevap_turb") - call mpi_bcast(clubb_expldiff, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_expldiff") call mpi_bcast(clubb_do_adv, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_adv") call mpi_bcast(clubb_timestep, 1, mpi_real8, mstrid, mpicom, ierr) @@ -614,6 +1031,22 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c11b") call mpi_bcast(clubb_c14, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c14") + call mpi_bcast(clubb_C_wp3_pr_turb, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_wp3_pr_turb") + call mpi_bcast(clubb_c6rt, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6rt") + call mpi_bcast(clubb_c6rtb, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6rtb") + call mpi_bcast(clubb_c6rtc, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6rtc") + call mpi_bcast(clubb_c6thl, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6thl") + call mpi_bcast(clubb_c6thlb, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6thlb") + call mpi_bcast(clubb_c6thlc, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6thlc") + call mpi_bcast(clubb_wpxp_L_thresh, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_wpxp_L_thresh") call mpi_bcast(clubb_mult_coef, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mult_coef") call mpi_bcast(clubb_gamma_coef, 1, mpi_real8, mstrid, mpicom, ierr) @@ -621,7 +1054,7 @@ subroutine clubb_readnl(nlfile) call mpi_bcast(clubb_c_K10, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K10") call mpi_bcast(clubb_c_K10h, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K10h") + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K10h") call mpi_bcast(clubb_beta, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_beta") call mpi_bcast(clubb_C2rt, 1, mpi_real8, mstrid, mpicom, ierr) @@ -640,25 +1073,56 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C7b") call mpi_bcast(clubb_Skw_denom_coef, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_Skw_denom_coef") - call mpi_bcast(clubb_C4, 1, mpi_real8, mstrid, mpicom, ierr) + call mpi_bcast(clubb_C4, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C4") + call mpi_bcast(clubb_C_uu_shr, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_uu_shr") + call mpi_bcast(clubb_C_uu_buoy, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_uu_buoy") + call mpi_bcast(clubb_c_K1, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K1") + call mpi_bcast(clubb_c_K2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K2") + call mpi_bcast(clubb_nu2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_nu2") + call mpi_bcast(clubb_c_K8, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K8") call mpi_bcast(clubb_c_K9, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K9") call mpi_bcast(clubb_nu9, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_nu9") call mpi_bcast(clubb_C_wp2_splat, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_wp2_splat") + call mpi_bcast(clubb_bv_efold, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_bv_efold") + call mpi_bcast(clubb_wpxp_Ri_exp, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_wpxp_Ri_exp") + call mpi_bcast(clubb_z_displace, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_z_displace") call mpi_bcast(clubb_lambda0_stability_coef, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_lambda0_stability_coef") call mpi_bcast(clubb_l_lscale_plume_centered,1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_lscale_plume_centered") - call mpi_bcast(clubb_l_use_ice_latent, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_ice_latent") call mpi_bcast(clubb_do_liqsupersat, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_liqsupersat") call mpi_bcast(clubb_do_energyfix, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_energyfix") - + call mpi_bcast(clubb_C_invrs_tau_bkgnd, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_bkgnd") + call mpi_bcast(clubb_C_invrs_tau_sfc, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_sfc") + call mpi_bcast(clubb_C_invrs_tau_shear, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_shear") + call mpi_bcast(clubb_C_invrs_tau_N2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2") + call mpi_bcast(clubb_C_invrs_tau_N2_wp2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_wp2") + call mpi_bcast(clubb_C_invrs_tau_N2_xp2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_xp2") + call mpi_bcast(clubb_C_invrs_tau_N2_wpxp, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_wpxp") + call mpi_bcast(clubb_C_invrs_tau_N2_clear_wp3, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_clear_wp3") call mpi_bcast(clubb_lmin_coef, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_lmin_coef") call mpi_bcast(clubb_skw_max_mag, 1, mpi_real8, mstrid, mpicom, ierr) @@ -667,13 +1131,23 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_stability_correct_tau_zm") call mpi_bcast(clubb_gamma_coefb, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_gamma_coefb") - call mpi_bcast(clubb_up2_vp2_factor, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_up2_vp2_factor") + call mpi_bcast(clubb_up2_sfc_coef, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_up2_sfc_coef") + call mpi_bcast(clubb_detliq_rad, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_detliq_rad") + call mpi_bcast(clubb_detice_rad, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_detice_rad") + call mpi_bcast(clubb_detphase_lowtemp, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_detphase_lowtemp") + call mpi_bcast(clubb_iiPDF_type, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_iiPDF_type") call mpi_bcast(clubb_l_use_C7_Richardson, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_C7_Richardson") call mpi_bcast(clubb_l_use_C11_Richardson, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_C11_Richardson") + call mpi_bcast(clubb_l_use_shear_Richardson, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_shear_Richardson") call mpi_bcast(clubb_l_brunt_vaisala_freq_moist, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_brunt_vaisala_freq_moist") call mpi_bcast(clubb_l_use_thvm_in_bv_freq, 1, mpi_logical, mstrid, mpicom, ierr) @@ -690,6 +1164,10 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_min_xp2_from_corr_wx") call mpi_bcast(clubb_l_upwind_xpyp_ta, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_upwind_xpyp_ta") + call mpi_bcast(clubb_l_godunov_upwind_wpxp_ta, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_godunov_upwind_wpxp_ta") + call mpi_bcast(clubb_l_godunov_upwind_xpyp_ta, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_godunov_upwind_xpyp_ta") call mpi_bcast(clubb_l_vert_avg_closure, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_vert_avg_closure") call mpi_bcast(clubb_l_trapezoidal_rule_zt, 1, mpi_logical, mstrid, mpicom, ierr) @@ -704,45 +1182,214 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_diag_Lscale_from_tau") call mpi_bcast(clubb_l_damp_wp2_using_em, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_damp_wp2_using_em") + call mpi_bcast(clubb_l_do_expldiff_rtm_thlm, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_do_expldiff_rtm_thlm") + call mpi_bcast(clubb_l_lmm_stepping, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_lmm_stepping") + call mpi_bcast(clubb_l_e3sm_config, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_e3sm_config") + call mpi_bcast(clubb_l_enable_relaxed_clipping, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_enable_relaxed_clipping") + call mpi_bcast(clubb_l_use_tke_in_wp3_pr_turb_term, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_tke_in_wp3_pr_turb_term") + call mpi_bcast(clubb_l_use_tke_in_wp2_wp3_K_dfsn, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_tke_in_wp2_wp3_K_dfsn") + call mpi_bcast(clubb_l_use_wp3_lim_with_smth_Heaviside, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_wp3_lim_with_smth_Heaviside") + call mpi_bcast(clubb_l_smooth_Heaviside_tau_wpxp, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_smooth_Heaviside_tau_wpxp") + call mpi_bcast(clubb_l_modify_limiters_for_cnvg_test, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_modify_limiters_for_cnvg_test") + call mpi_bcast(clubb_ipdf_call_placement, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_ipdf_call_placement") + call mpi_bcast(clubb_l_mono_flux_lim_thlm, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_mono_flux_lim_thlm") + call mpi_bcast(clubb_l_mono_flux_lim_rtm, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_mono_flux_lim_rtm") + call mpi_bcast(clubb_l_mono_flux_lim_um, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_mono_flux_lim_um") + call mpi_bcast(clubb_l_mono_flux_lim_vm, 1, mpi_logical, mstrid, mpicom, ierr) + 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) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_vary_convect_depth") + call mpi_bcast(clubb_l_standard_term_ta, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_standard_term_ta") + call mpi_bcast(clubb_l_partial_upwind_wp3, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_partial_upwind_wp3") + call mpi_bcast(clubb_l_C2_cloud_frac, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_C2_cloud_frac") + call mpi_bcast(clubb_l_calc_thlp2_rad, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_calc_thlp2_rad") + call mpi_bcast(clubb_l_calc_w_corr, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_calc_w_corr") + call mpi_bcast(clubb_l_const_Nc_in_cloud, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_const_Nc_in_cloud") + call mpi_bcast(clubb_l_diagnose_correlations, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_diagnose_correlations") + call mpi_bcast(clubb_l_diffuse_rtm_and_thlm, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_diffuse_rtm_and_thlm") + call mpi_bcast(clubb_l_fix_w_chi_eta_correlations, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_fix_w_chi_eta_correlations") + call mpi_bcast(clubb_l_prescribed_avg_deltaz, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_prescribed_avg_deltaz") + call mpi_bcast(clubb_l_rtm_nudge, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_rtm_nudge") + call mpi_bcast(clubb_l_stability_correct_Kh_N2_zm, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_stability_correct_Kh_N2_zm") + call mpi_bcast(clubb_l_tke_aniso, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_tke_aniso") + call mpi_bcast(clubb_l_upwind_xm_ma, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_upwind_xm_ma") + call mpi_bcast(clubb_l_use_precip_frac, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_precip_frac") + call mpi_bcast(clubb_l_uv_nudge, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_uv_nudge") ! Overwrite defaults if they are true - if (clubb_history) l_stats = .true. - if (clubb_rad_history) l_output_rad_files = .true. + if (clubb_history) stats_metadata%l_stats = .true. + if (clubb_rad_history) stats_metadata%l_output_rad_files = .true. if (clubb_cloudtop_cooling) do_cldcool = .true. if (clubb_rainevap_turb) do_rainturb = .true. - if (clubb_expldiff) do_expldiff = .true. - -! Check that all namelists have been set - if(clubb_timestep == unset_r8) call endrun(sub//": FATAL: clubb_timestep is not set") - if(clubb_rnevap_effic == unset_r8) call endrun(sub//": FATAL:clubb_rnevap_effic is not set") - - if(clubb_c1 == unset_r8) call endrun(sub//": FATAL: clubb_c1 is not set") - if(clubb_c1b == unset_r8) call endrun(sub//": FATAL: clubb_c1b is not set") - if(clubb_C2rt == unset_r8) call endrun(sub//": FATAL: clubb_C2rt is not set") - if(clubb_C2thl == unset_r8) call endrun(sub//": FATAL: clubb_C2thl is not set") - if(clubb_C2rtthl == unset_r8) call endrun(sub//": FATAL: clubb_C2rtthl is not set") - if(clubb_C4 == unset_r8) call endrun(sub//": FATAL: clubb_C4 is not set") - if(clubb_C8 == unset_r8) call endrun(sub//": FATAL: clubb_C8 is not set") - if(clubb_C8b == unset_r8) call endrun(sub//": FATAL: clubb_C8b is not set") - if(clubb_C7 == unset_r8) call endrun(sub//": FATAL: clubb_C7 is not set") - if(clubb_C7b == unset_r8) call endrun(sub//": FATAL: clubb_C7b is not set") - if(clubb_c11 == unset_r8) call endrun(sub//": FATAL: clubb_c11 is not set") - if(clubb_c11b == unset_r8) call endrun(sub//": FATAL: clubb_c11b is not set") - if(clubb_c14 == unset_r8) call endrun(sub//": FATAL: clubb_c14 is not set") - if(clubb_c_K9 == unset_r8) call endrun(sub//": FATAL: clubb_c_K9 is not set") - if(clubb_nu9 == unset_r8) call endrun(sub//": FATAL: clubb_nu9 is not set") - if(clubb_c_K10 == unset_r8) call endrun(sub//": FATAL: clubb_c_K10 is not set") - if(clubb_c_K10h == unset_r8) call endrun(sub//": FATAL: clubb_c_K10h is not set") - if(clubb_gamma_coef == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coef is not set") - if(clubb_gamma_coefb == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coefb is not set") - if(clubb_beta == unset_r8) call endrun(sub//": FATAL: clubb_beta is not set") - if(clubb_lambda0_stability_coef == unset_r8) call endrun(sub//": FATAL: clubb_lambda0_stability_coef is not set") - if(clubb_lmin_coef == unset_r8) call endrun(sub//": FATAL: clubb_lmin_coef is not set") - if(clubb_mult_coef == unset_r8) call endrun(sub//": FATAL: clubb_mult_coef is not set") - if(clubb_Skw_denom_coef == unset_r8) call endrun(sub//": FATAL: clubb_Skw_denom_coef is not set") - if(clubb_skw_max_mag == unset_r8) call endrun(sub//": FATAL: clubb_skw_max_mag is not set") - if(clubb_up2_vp2_factor == unset_r8) call endrun(sub//": FATAL: clubb_up2_vp2_factor is not set") - if(clubb_C_wp2_splat == unset_r8) call endrun(sub//": FATAL: clubb_C_wp2_splatis not set") + + ! Check that all namelists have been set + if(clubb_timestep == unset_r8) call endrun(sub//": FATAL: clubb_timestep is not set") + if(clubb_rnevap_effic == unset_r8) call endrun(sub//": FATAL:clubb_rnevap_effic is not set") + + if(clubb_c1 == unset_r8) call endrun(sub//": FATAL: clubb_c1 is not set") + if(clubb_c1b == unset_r8) call endrun(sub//": FATAL: clubb_c1b is not set") + if(clubb_C2rt == unset_r8) call endrun(sub//": FATAL: clubb_C2rt is not set") + if(clubb_C2thl == unset_r8) call endrun(sub//": FATAL: clubb_C2thl is not set") + if(clubb_C2rtthl == unset_r8) call endrun(sub//": FATAL: clubb_C2rtthl is not set") + if(clubb_C4 == unset_r8) call endrun(sub//": FATAL: clubb_C4 is not set") + if(clubb_C_uu_shr == unset_r8) call endrun(sub//": FATAL: clubb_C_uu_shr is not set") + if(clubb_C_uu_buoy == unset_r8) call endrun(sub//": FATAL: clubb_C_uu_buoy is not set") + if(clubb_c6rt == unset_r8) call endrun(sub//": FATAL: clubb_c6rt is not set") + if(clubb_c6rtb == unset_r8) call endrun(sub//": FATAL: clubb_c6rtb is not set") + if(clubb_c6rtc == unset_r8) call endrun(sub//": FATAL: clubb_c6rtc is not set") + if(clubb_c6thl == unset_r8) call endrun(sub//": FATAL: clubb_c6thl is not set") + if(clubb_c6thlb == unset_r8) call endrun(sub//": FATAL: clubb_c6thlb is not set") + if(clubb_c6thlc == unset_r8) call endrun(sub//": FATAL: clubb_c6thlc is not set") + if(clubb_wpxp_L_thresh == unset_r8) call endrun(sub//": FATAL: clubb_wpxp_L_thresh is not set") + if(clubb_C8 == unset_r8) call endrun(sub//": FATAL: clubb_C8 is not set") + if(clubb_C8b == unset_r8) call endrun(sub//": FATAL: clubb_C8b is not set") + if(clubb_C7 == unset_r8) call endrun(sub//": FATAL: clubb_C7 is not set") + if(clubb_C7b == unset_r8) call endrun(sub//": FATAL: clubb_C7b is not set") + if(clubb_c11 == unset_r8) call endrun(sub//": FATAL: clubb_c11 is not set") + if(clubb_c11b == unset_r8) call endrun(sub//": FATAL: clubb_c11b is not set") + if(clubb_c14 == unset_r8) call endrun(sub//": FATAL: clubb_c14 is not set") + if(clubb_C_wp3_pr_turb == unset_r8) call endrun(sub//": FATAL: clubb_C_wp3_pr_turb is not set") + if(clubb_c_K1 == unset_r8) call endrun(sub//": FATAL: clubb_c_K1 is not set") + if(clubb_c_K2 == unset_r8) call endrun(sub//": FATAL: clubb_c_K2 is not set") + if(clubb_nu2 == unset_r8) call endrun(sub//": FATAL: clubb_nu2 is not set") + if(clubb_c_K8 == unset_r8) call endrun(sub//": FATAL: clubb_c_K8 is not set") + if(clubb_c_K9 == unset_r8) call endrun(sub//": FATAL: clubb_c_K9 is not set") + if(clubb_nu9 == unset_r8) call endrun(sub//": FATAL: clubb_nu9 is not set") + if(clubb_c_K10 == unset_r8) call endrun(sub//": FATAL: clubb_c_K10 is not set") + if(clubb_c_K10h == unset_r8) call endrun(sub//": FATAL: clubb_c_K10h is not set") + if(clubb_C_invrs_tau_bkgnd == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_bkgnd is not set") + if(clubb_C_invrs_tau_sfc == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_sfc is not set") + if(clubb_C_invrs_tau_shear == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_shear is not set") + if(clubb_C_invrs_tau_N2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2 is not set") + if(clubb_C_invrs_tau_N2_wp2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_wp2 is not set") + if(clubb_C_invrs_tau_N2_xp2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_xp2 is not set") + if(clubb_C_invrs_tau_N2_wpxp == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_wpxp is not set") + if(clubb_C_invrs_tau_N2_clear_wp3 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_clear_wp3 is not set") + if(clubb_gamma_coef == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coef is not set") + if(clubb_gamma_coefb == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coefb is not set") + if(clubb_beta == unset_r8) call endrun(sub//": FATAL: clubb_beta is not set") + if(clubb_lambda0_stability_coef == unset_r8) call endrun(sub//": FATAL: clubb_lambda0_stability_coef is not set") + if(clubb_lmin_coef == unset_r8) call endrun(sub//": FATAL: clubb_lmin_coef is not set") + if(clubb_mult_coef == unset_r8) call endrun(sub//": FATAL: clubb_mult_coef is not set") + if(clubb_Skw_denom_coef == unset_r8) call endrun(sub//": FATAL: clubb_Skw_denom_coef is not set") + if(clubb_skw_max_mag == unset_r8) call endrun(sub//": FATAL: clubb_skw_max_mag is not set") + if(clubb_up2_sfc_coef == unset_r8) call endrun(sub//": FATAL: clubb_up2_sfc_coef is not set") + if(clubb_C_wp2_splat == unset_r8) call endrun(sub//": FATAL: clubb_C_wp2_splat is not set") + if(clubb_bv_efold == unset_r8) call endrun(sub//": FATAL: clubb_bv_efold is not set") + if(clubb_wpxp_Ri_exp == unset_r8) call endrun(sub//": FATAL: clubb_wpxp_Ri_exp is not set") + if(clubb_z_displace == unset_r8) call endrun(sub//": FATAL: clubb_z_displace is not set") + if(clubb_detliq_rad == unset_r8) call endrun(sub//": FATAL: clubb_detliq_rad not set") + if(clubb_detice_rad == unset_r8) call endrun(sub//": FATAL: clubb_detice_rad not set") + if(clubb_ipdf_call_placement == unset_i) call endrun(sub//": FATAL: clubb_ipdf_call_placement not set") + if(clubb_detphase_lowtemp == unset_r8) call endrun(sub//": FATAL: clubb_detphase_lowtemp not set") + if(clubb_penta_solve_method == unset_i) call endrun(sub//": FATAL: clubb_penta_solve_method not set") + if(clubb_tridiag_solve_method == unset_i) call endrun(sub//": FATAL: clubb_tridiag_solve_method not set") + if(clubb_saturation_equation == unset_i) call endrun(sub//": FATAL: clubb_saturation_equation not set") + if(clubb_detphase_lowtemp >= meltpt_temp) & + call endrun(sub//": ERROR: clubb_detphase_lowtemp must be less than 268.15 K") + + call initialize_clubb_config_flags_type_api( clubb_iiPDF_type, & ! In + 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 + clubb_l_min_xp2_from_corr_wx, & ! In + clubb_l_C2_cloud_frac, & ! In + clubb_l_diffuse_rtm_and_thlm, & ! In + clubb_l_stability_correct_Kh_N2_zm, & ! In + clubb_l_calc_thlp2_rad, & ! In + clubb_l_upwind_xpyp_ta, & ! In + clubb_l_upwind_xm_ma, & ! In + clubb_l_uv_nudge, & ! In + clubb_l_rtm_nudge, & ! In + clubb_l_tke_aniso, & ! In + clubb_l_vert_avg_closure, & ! In + clubb_l_trapezoidal_rule_zt, & ! In + clubb_l_trapezoidal_rule_zm, & ! In + clubb_l_call_pdf_closure_twice, & ! In + clubb_l_standard_term_ta, & ! In + clubb_l_partial_upwind_wp3, & ! In + clubb_l_godunov_upwind_wpxp_ta, & ! In + clubb_l_godunov_upwind_xpyp_ta, & ! In + clubb_l_use_cloud_cover, & ! In + clubb_l_diagnose_correlations, & ! In + clubb_l_calc_w_corr, & ! In + clubb_l_const_Nc_in_cloud, & ! In + clubb_l_fix_w_chi_eta_correlations, & ! In + clubb_l_stability_correct_tau_zm, & ! In + clubb_l_damp_wp2_using_em, & ! In + clubb_l_do_expldiff_rtm_thlm, & ! In + clubb_l_Lscale_plume_centered, & ! In + clubb_l_diag_Lscale_from_tau, & ! In + clubb_l_use_C7_Richardson, & ! In + clubb_l_use_C11_Richardson, & ! In + clubb_l_use_shear_Richardson, & ! In + clubb_l_brunt_vaisala_freq_moist, & ! In + clubb_l_use_thvm_in_bv_freq, & ! In + clubb_l_rcm_supersat_adj, & ! In + clubb_l_damp_wp3_Skw_squared, & ! In + clubb_l_prescribed_avg_deltaz, & ! In + clubb_l_lmm_stepping, & ! In + clubb_l_e3sm_config, & ! In + clubb_l_vary_convect_depth, & ! In + clubb_l_use_tke_in_wp3_pr_turb_term, & ! In + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! In + clubb_l_use_wp3_lim_with_smth_Heaviside, & ! In + clubb_l_smooth_Heaviside_tau_wpxp, & ! In + clubb_l_modify_limiters_for_cnvg_test, & ! In + clubb_l_enable_relaxed_clipping, & ! In + clubb_l_linearize_pbl_winds, & ! In + clubb_l_mono_flux_lim_thlm, & ! In + clubb_l_mono_flux_lim_rtm, & ! In + 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 end subroutine clubb_readnl @@ -769,61 +1416,43 @@ subroutine clubb_ini_cam(pbuf2d) ! From CAM libraries use cam_history, only: addfld, add_default, horiz_only - use ref_pres, only: pref_mid - use hb_diff, only: init_hb_diff use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num_idx, rad_cnst_get_mam_mmr_idx use cam_abortutils, only: endrun - ! From the CLUBB libraries - use clubb_api_module, only: core_rknd, & - iC11, iC11b, ibeta, iSkw_denom_coef, & ! Constant(s) - em_min, & - iC1, iC1b, iC2rt, iC2thl, iC2rtthl, igamma_coef, igamma_coefb, & - imult_coef, ic_K10, iskw_max_mag, & - iC8, iC8b, iC11, iC11b, iC4, iC14, iup2_vp2_factor, params_list - - + ! These are needed to set parameters + use clubb_api_module, only: & + core_rknd, em_min, & + ilambda0_stability_coef, ic_K10, ic_K10h, iC7, iC7b, iC8, iC8b, iC11, iC11b, iC4, iC_uu_shr, iC_uu_buoy, & + iC1, iC1b, iC6rt, iC6rtb, iC6rtc, iC6thl, iC6thlb, iC6thlc, iup2_sfc_coef, iwpxp_L_thresh, & + iC14, iC_wp3_pr_turb, igamma_coef, igamma_coefb, imult_coef, ilmin_coef, & + iSkw_denom_coef, ibeta, iskw_max_mag, & + iC_invrs_tau_bkgnd,iC_invrs_tau_sfc,iC_invrs_tau_shear,iC_invrs_tau_N2,iC_invrs_tau_N2_wp2, & + iC_invrs_tau_N2_xp2,iC_invrs_tau_N2_wpxp,iC_invrs_tau_N2_clear_wp3, & + iC2rt, iC2thl, iC2rtthl, ic_K1, ic_K2, inu2, ic_K8, ic_K9, inu9, iC_wp2_splat, ibv_efold, & + iwpxp_Ri_exp, iz_displace, & + params_list use clubb_api_module, only: & print_clubb_config_flags_api, & - setup_clubb_core_api, & + setup_parameters_model_api, & + check_clubb_settings_api, & init_pdf_params_api, & - init_pdf_implicit_coefs_terms_api, & time_precision, & core_rknd, & set_clubb_debug_level_api, & clubb_fatal_error, & ! Error code value to indicate a fatal error nparams, & + set_default_parameters_api, & read_parameters_api, & - l_stats, & - l_stats_samp, & - l_grads, & - stats_zt, & - stats_zm, & - stats_sfc, & - stats_rad_zt, & - stats_rad_zm, & 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 - - ! These are needed to set parameters - use clubb_api_module, only: & - ilambda0_stability_coef, ic_K10, ic_K10h, iC2rtthl, iC7, iC7b, iC8, iC8b, iC11, iC11b, & - iC14, igamma_coef, imult_coef, ilmin_coef, iSkw_denom_coef, ibeta, iskw_max_mag, & - iC2rt, iC2thl, iC2rtthl, ic_K9, inu9, iC_wp2_splat + 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 @@ -838,16 +1467,12 @@ subroutine clubb_ini_cam(pbuf2d) #ifdef CLUBB_SGS real(kind=time_precision) :: dum1, dum2, dum3 - - real(r8), dimension(nparams) :: clubb_params ! These adjustable CLUBB parameters (C1, C2 ...) ! The similar name to clubb_history is unfortunate... logical :: history_amwg, history_clubb integer :: err_code ! Code for when CLUBB fails - integer :: j, k, l ! Indices - integer :: ntop_eddy ! Top interface level to which eddy vertical diffusion is applied ( = 1 ) - integer :: nbot_eddy ! Bottom interface level to which eddy vertical diffusion is applied ( = pver ) + integer :: i, j, k, l ! Indices integer :: nmodes, nspec, m integer :: ixq, ixcldice, ixcldliq, ixnumliq, ixnumice integer :: lptr @@ -855,51 +1480,64 @@ subroutine clubb_ini_cam(pbuf2d) logical, parameter :: l_input_fields = .false. ! Always false for CAM-CLUBB. logical, parameter :: l_update_pressure = .false. ! Always false for CAM-CLUBB. - real(r8) :: zt_g(pverp+1-top_lev) ! Height dummy array - real(r8) :: zi_g(pverp+1-top_lev) ! Height dummy array - - ! CAM defines zi at the surface to be zero. - real(r8), parameter :: sfc_elevation = 0._r8 - - integer :: nlev + integer :: ierr=0 + + real(r8) :: & + 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, & + C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, & + C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & + c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, & + slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, & + coef_spread_DG_means_rt, coef_spread_DG_means_thl, & + gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, & + omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, & + lambda0_stability_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & + Lscale_pert_coef, alpha_corr, Skw_denom_coef, c_K10, c_K10h, & + thlp2_rad_coef, thlp2_rad_cloud_frac_thresh, up2_sfc_coef, & + Skw_max_mag, xp3_coef_base, xp3_coef_slope, altitude_threshold, & + rtp2_clip_coef, C_invrs_tau_bkgnd, C_invrs_tau_sfc, & + C_invrs_tau_shear, C_invrs_tau_N2, C_invrs_tau_N2_wp2, & + C_invrs_tau_N2_xp2, C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & + C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & + Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, wpxp_Ri_exp, & + a3_coef_min, a_const, bv_efold, z_displace !----- Begin Code ----- - nlev = pver + 1 - top_lev - if (core_rknd /= r8) then call endrun('clubb_ini_cam: CLUBB library core_rknd must match CAM r8 and it does not') end if + ! Determine number of vertical levels used in clubb, thermo variables are nzt_clubb + ! and momentum variables are nzm_clubb + nzt_clubb = pver + 1 - top_lev + nzm_clubb = pverp + 1 - top_lev + ! Allocate PDF parameters across columns and chunks allocate( & - pdf_params_chnk(pcols,begchunk:endchunk), & - pdf_params_zm_chnk(pcols,begchunk:endchunk), & - pdf_implicit_coefs_terms_chnk(pcols,begchunk:endchunk) ) - - ! Allocate (in the vertical) and zero PDF parameters - do l = begchunk, endchunk, 1 - do j = 1, pcols, 1 - call init_pdf_params_api( pverp+1-top_lev, pdf_params_chnk(j,l) ) - call init_pdf_params_api( pverp+1-top_lev, pdf_params_zm_chnk(j,l) ) - call init_pdf_implicit_coefs_terms_api( pverp+1-top_lev, sclr_dim, & - pdf_implicit_coefs_terms_chnk(j,l) ) - enddo ! j = 1, pcols, 1 - enddo ! l = begchunk, endchunk, 1 + pdf_params_chnk(begchunk:endchunk), & + pdf_params_zm_chnk(begchunk:endchunk), & + pdf_implicit_coefs_terms_chnk(begchunk:endchunk), stat=ierr ) + if( ierr /= 0 ) call endrun(' clubb_ini_cam: failed to allocate pdf_params') ! ----------------------------------------------------------------- ! - ! Determine how many constituents CLUBB will transport. Note that - ! CLUBB does not transport aerosol consituents. Therefore, need to + ! Determine how many constituents CLUBB will transport. Note that + ! CLUBB does not transport aerosol consituents. Therefore, need to ! determine how many aerosols constituents there are and subtract that - ! off of pcnst (the total consituents) + ! off of pcnst (the total consituents) ! ----------------------------------------------------------------- ! call phys_getopts(prog_modal_aero_out=prog_modal_aero, & history_amwg_out=history_amwg, & - history_clubb_out=history_clubb) + history_clubb_out=history_clubb, & + do_hb_above_clubb_out=do_hb_above_clubb) ! Select variables to apply tendencies back to CAM - + ! Initialize all consituents to true to start lq(1:pcnst) = .true. edsclr_dim = pcnst @@ -913,12 +1551,12 @@ subroutine clubb_ini_cam(pbuf2d) if (prog_modal_aero) then ! Turn off modal aerosols and decrement edsclr_dim accordingly call rad_cnst_get_info(0, nmodes=nmodes) - + do m = 1, nmodes call rad_cnst_get_mode_num_idx(m, lptr) lq(lptr)=.false. edsclr_dim = edsclr_dim-1 - + call rad_cnst_get_info(0, m, nspec=nspec) do l = 1, nspec call rad_cnst_get_mam_mmr_idx(m, l, lptr) @@ -926,7 +1564,7 @@ subroutine clubb_ini_cam(pbuf2d) edsclr_dim = edsclr_dim-1 end do end do - + ! In addition, if running with MAM, droplet number is transported ! in dropmixnuc, therefore we do NOT want CLUBB to apply transport ! tendencies to avoid double counted. Else, we apply tendencies. @@ -947,11 +1585,11 @@ subroutine clubb_ini_cam(pbuf2d) ! Defaults - l_stats_samp = .false. - l_grads = .false. + stats_metadata%l_stats_samp = .false. + stats_metadata%l_grads = .false. - ! Overwrite defaults if needbe - if (l_stats) l_stats_samp = .true. + ! Overwrite defaults if needed + if (stats_metadata%l_stats) stats_metadata%l_stats_samp = .true. ! Define physics buffers indexes cld_idx = pbuf_get_index('CLD') ! Cloud fraction @@ -959,7 +1597,7 @@ subroutine clubb_ini_cam(pbuf2d) ast_idx = pbuf_get_index('AST') ! Stratiform cloud fraction alst_idx = pbuf_get_index('ALST') ! Liquid stratiform cloud fraction aist_idx = pbuf_get_index('AIST') ! Ice stratiform cloud fraction - qlst_idx = pbuf_get_index('QLST') ! Physical in-stratus LWC + qlst_idx = pbuf_get_index('QLST') ! Physical in-stratus LWC qist_idx = pbuf_get_index('QIST') ! Physical in-stratus IWC dp_frac_idx = pbuf_get_index('DP_FRAC') ! Deep convection cloud fraction icwmrdp_idx = pbuf_get_index('ICWMRDP') ! In-cloud deep convective mixing ratio @@ -973,117 +1611,154 @@ subroutine clubb_ini_cam(pbuf2d) npccn_idx = pbuf_get_index('NPCCN') - iisclr_rt = -1 - iisclr_thl = -1 - iisclr_CO2 = -1 - - iiedsclr_rt = -1 - iiedsclr_thl = -1 - iiedsclr_CO2 = -1 + sclr_idx%iisclr_rt = -1 + sclr_idx%iisclr_thl = -1 + sclr_idx%iisclr_CO2 = -1 - if (zmconv_microp) then - dlfzm_idx = pbuf_get_index('DLFZM') - difzm_idx = pbuf_get_index('DIFZM') - dnlfzm_idx = pbuf_get_index('DNLFZM') - dnifzm_idx = pbuf_get_index('DNIFZM') - end if + sclr_idx%iiedsclr_rt = -1 + sclr_idx%iiedsclr_thl = -1 + sclr_idx%iiedsclr_CO2 = -1 ! ----------------------------------------------------------------- ! ! Define number of tracers for CLUBB to diffuse - ! ----------------------------------------------------------------- ! - - if (do_expldiff) then + ! ----------------------------------------------------------------- ! + + if (clubb_l_do_expldiff_rtm_thlm) then offset = 2 ! diffuse temperature and moisture explicitly - edsclr_dim = edsclr_dim + offset + edsclr_dim = edsclr_dim + offset endif - + ! ----------------------------------------------------------------- ! ! Setup CLUBB core ! ----------------------------------------------------------------- ! - - ! Read in parameters for CLUBB. Just read in default values - call read_parameters_api( -99, "", clubb_params ) - - ! Fill in dummy arrays for height. Note that these are overwrote - ! at every CLUBB step to physical values. - do k=1,nlev+1 - zt_g(k) = ((k-1)*1000._r8)-500._r8 ! this is dummy garbage - zi_g(k) = (k-1)*1000._r8 ! this is dummy garbage - enddo - 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_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(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_vp2_factor) = clubb_up2_vp2_factor - clubb_params(iC4) = clubb_C4 - clubb_params(ic_K9) = clubb_c_K9 - clubb_params(inu9) = clubb_nu9 - clubb_params(iC_wp2_splat) = clubb_C_wp2_splat - - call init_clubb_config_flags( clubb_config_flags ) ! In/Out - clubb_config_flags%l_use_C7_Richardson = clubb_l_use_C7_Richardson - clubb_config_flags%l_use_C11_Richardson = clubb_l_use_C11_Richardson - clubb_config_flags%l_brunt_vaisala_freq_moist = clubb_l_brunt_vaisala_freq_moist - clubb_config_flags%l_use_thvm_in_bv_freq = clubb_l_use_thvm_in_bv_freq - clubb_config_flags%l_rcm_supersat_adj = clubb_l_rcm_supersat_adj - clubb_config_flags%l_damp_wp3_Skw_squared = clubb_l_damp_wp3_Skw_squared - clubb_config_flags%l_predict_upwp_vpwp = clubb_l_predict_upwp_vpwp - clubb_config_flags%l_min_wp2_from_corr_wx = clubb_l_min_wp2_from_corr_wx - clubb_config_flags%l_min_xp2_from_corr_wx = clubb_l_min_xp2_from_corr_wx - clubb_config_flags%l_upwind_xpyp_ta = clubb_l_upwind_xpyp_ta - clubb_config_flags%l_vert_avg_closure = clubb_l_vert_avg_closure - clubb_config_flags%l_trapezoidal_rule_zt = clubb_l_trapezoidal_rule_zt - clubb_config_flags%l_trapezoidal_rule_zm = clubb_l_trapezoidal_rule_zm - clubb_config_flags%l_call_pdf_closure_twice = clubb_l_call_pdf_closure_twice - clubb_config_flags%l_use_cloud_cover = clubb_l_use_cloud_cover - clubb_config_flags%l_stability_correct_tau_zm = clubb_l_stability_correct_tau_zm - clubb_config_flags%l_do_expldiff_rtm_thlm = do_expldiff - clubb_config_flags%l_Lscale_plume_centered = clubb_l_lscale_plume_centered - clubb_config_flags%l_use_ice_latent = clubb_l_use_ice_latent - clubb_config_flags%l_diag_Lscale_from_tau = clubb_l_diag_Lscale_from_tau - clubb_config_flags%l_damp_wp2_using_em = clubb_l_damp_wp2_using_em - clubb_config_flags%l_update_pressure = l_update_pressure - - + ! Read in parameters for CLUBB. Just read in default values + call set_default_parameters_api( & + 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, & + C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, & + C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & + c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, & + slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, & + coef_spread_DG_means_rt, coef_spread_DG_means_thl, & + gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, & + omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, & + lambda0_stability_coef, mult_coef, taumin, taumax, & + Lscale_mu_coef, Lscale_pert_coef, alpha_corr, & + Skw_denom_coef, c_K10, c_K10h, thlp2_rad_coef, & + thlp2_rad_cloud_frac_thresh, up2_sfc_coef, & + Skw_max_mag, xp3_coef_base, xp3_coef_slope, & + altitude_threshold, rtp2_clip_coef, C_invrs_tau_bkgnd, & + C_invrs_tau_sfc, C_invrs_tau_shear, C_invrs_tau_N2, & + C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, & + C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & + C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & + Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, & + wpxp_Ri_exp, a3_coef_min, a_const, bv_efold, z_displace ) + + 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, & + C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, & + C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & + c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, & + slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, & + coef_spread_DG_means_rt, coef_spread_DG_means_thl, & + gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, & + omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, & + lambda0_stability_coef, mult_coef, taumin, taumax, & + Lscale_mu_coef, Lscale_pert_coef, alpha_corr, & + Skw_denom_coef, c_K10, c_K10h, thlp2_rad_coef, & + thlp2_rad_cloud_frac_thresh, up2_sfc_coef, & + Skw_max_mag, xp3_coef_base, xp3_coef_slope, & + altitude_threshold, rtp2_clip_coef, C_invrs_tau_bkgnd, & + C_invrs_tau_sfc, C_invrs_tau_shear, C_invrs_tau_N2, & + C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, & + C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & + C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & + Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, & + wpxp_Ri_exp, a3_coef_min, a_const, bv_efold, z_displace, & + clubb_params_single_col ) + + clubb_params_single_col(iC2rtthl) = clubb_C2rtthl + clubb_params_single_col(iC8) = clubb_C8 + clubb_params_single_col(iC11) = clubb_c11 + clubb_params_single_col(iC11b) = clubb_c11b + clubb_params_single_col(iC14) = clubb_c14 + clubb_params_single_col(iC_wp3_pr_turb) = clubb_C_wp3_pr_turb + clubb_params_single_col(ic_K10) = clubb_c_K10 + clubb_params_single_col(imult_coef) = clubb_mult_coef + clubb_params_single_col(iSkw_denom_coef) = clubb_Skw_denom_coef + clubb_params_single_col(iC2rt) = clubb_C2rt + clubb_params_single_col(iC2thl) = clubb_C2thl + clubb_params_single_col(ibeta) = clubb_beta + clubb_params_single_col(iC6rt) = clubb_c6rt + clubb_params_single_col(iC6rtb) = clubb_c6rtb + clubb_params_single_col(iC6rtc) = clubb_c6rtc + clubb_params_single_col(iC6thl) = clubb_c6thl + clubb_params_single_col(iC6thlb) = clubb_c6thlb + clubb_params_single_col(iC6thlc) = clubb_c6thlc + clubb_params_single_col(iwpxp_L_thresh) = clubb_wpxp_L_thresh + clubb_params_single_col(iC7) = clubb_C7 + clubb_params_single_col(iC7b) = clubb_C7b + clubb_params_single_col(igamma_coef) = clubb_gamma_coef + clubb_params_single_col(ic_K10h) = clubb_c_K10h + clubb_params_single_col(ilambda0_stability_coef) = clubb_lambda0_stability_coef + clubb_params_single_col(ilmin_coef) = clubb_lmin_coef + clubb_params_single_col(iC8b) = clubb_C8b + clubb_params_single_col(iskw_max_mag) = clubb_skw_max_mag + clubb_params_single_col(iC1) = clubb_C1 + clubb_params_single_col(iC1b) = clubb_C1b + clubb_params_single_col(igamma_coefb) = clubb_gamma_coefb + clubb_params_single_col(iup2_sfc_coef) = clubb_up2_sfc_coef + clubb_params_single_col(iC4) = clubb_C4 + clubb_params_single_col(iC_uu_shr) = clubb_C_uu_shr + clubb_params_single_col(iC_uu_buoy) = clubb_C_uu_buoy + clubb_params_single_col(ic_K1) = clubb_c_K1 + clubb_params_single_col(ic_K2) = clubb_c_K2 + clubb_params_single_col(inu2) = clubb_nu2 + clubb_params_single_col(ic_K8) = clubb_c_K8 + clubb_params_single_col(ic_K9) = clubb_c_K9 + clubb_params_single_col(inu9) = clubb_nu9 + clubb_params_single_col(iC_wp2_splat) = clubb_C_wp2_splat + clubb_params_single_col(iC_invrs_tau_bkgnd) = clubb_C_invrs_tau_bkgnd + clubb_params_single_col(iC_invrs_tau_sfc) = clubb_C_invrs_tau_sfc + clubb_params_single_col(iC_invrs_tau_shear) = clubb_C_invrs_tau_shear + clubb_params_single_col(iC_invrs_tau_N2) = clubb_C_invrs_tau_N2 + clubb_params_single_col(iC_invrs_tau_N2_wp2) = clubb_C_invrs_tau_N2_wp2 + clubb_params_single_col(iC_invrs_tau_N2_xp2) = clubb_C_invrs_tau_N2_xp2 + clubb_params_single_col(iC_invrs_tau_N2_wpxp) = clubb_C_invrs_tau_N2_wpxp + clubb_params_single_col(iC_invrs_tau_N2_clear_wp3) = clubb_C_invrs_tau_N2_clear_wp3 + clubb_params_single_col(ibv_efold) = clubb_bv_efold + clubb_params_single_col(iwpxp_Ri_exp) = clubb_wpxp_Ri_exp + clubb_params_single_col(iz_displace) = clubb_z_displace + + ! Override clubb default + if ( trim(subcol_scheme) == 'SILHS' ) then + clubb_config_flags%saturation_formula = saturation_flatau + else + clubb_config_flags%saturation_formula = saturation_gfdl ! Goff & Gratch (1946) approximation for SVP + end if + + ! Define model constant parameters + call setup_parameters_model_api( theta0, ts_nudge, clubb_params_single_col(iSkw_max_mag) ) + ! Set up CLUBB core. Note that some of these inputs are overwritten ! when clubb_tend_cam is called. The reason is that heights can change ! at each time step, which is why dummy arrays are read in here for heights ! as they are immediately overwrote. !$OMP PARALLEL - call setup_clubb_core_api & - ( nlev+1, theta0, ts_nudge, & ! In - hydromet_dim, sclr_dim, & ! In - sclr_tol, edsclr_dim, clubb_params, & ! In - l_host_applies_sfc_fluxes, & ! In - saturation_equation, & ! In - l_input_fields, & - l_implemented, grid_type, zi_g(2), zi_g(1), zi_g(nlev+1),& ! In - zi_g(1:nlev+1), zt_g(1:nlev+1), sfc_elevation, & ! In - clubb_config_flags%l_predict_upwp_vpwp, & ! In - clubb_config_flags%l_use_ice_latent, & ! In - clubb_config_flags%l_prescribed_avg_deltaz, & ! In - clubb_config_flags%l_damp_wp2_using_em, & ! In - clubb_config_flags%l_stability_correct_tau_zm, & ! In - err_code ) + call check_clubb_settings_api( nzm_clubb, 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') @@ -1093,144 +1768,157 @@ 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 ! Print configurable CLUBB flags - call print_clubb_config_flags_api( iulog, clubb_config_flags ) ! Intent(in) - - ! ----------------------------------------------------------------- ! - ! Set-up HB diffusion. Only initialized to diagnose PBL depth ! - ! ----------------------------------------------------------------- ! + if ( masterproc ) then + write(iulog,'(a,i0,a)') " CLUBB configurable flags " + call print_clubb_config_flags_api( iulog, clubb_config_flags ) ! Intent(in) + end if - ! Initialize eddy diffusivity module - - ntop_eddy = 1 ! if >1, must be <= nbot_molec - nbot_eddy = pver ! currently always pver - - call init_hb_diff( gravit, cpair, ntop_eddy, nbot_eddy, pref_mid, karman, eddy_scheme ) - ! ----------------------------------------------------------------- ! ! Add output fields for the history files ! ----------------------------------------------------------------- ! ! These are default CLUBB output. Not the higher order history budgets - call addfld ('RHO_CLUBB', (/ 'ilev' /), 'A', 'kg/m3', 'Air Density') - call addfld ('UP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Velocity Variance') - call addfld ('VP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Velocity Variance') - call addfld ('WP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Vertical Velocity Variance') - call addfld ('WP2_ZT_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Vert Vel Variance on zt grid') - call addfld ('UPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Momentum Flux') - call addfld ('VPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Momentum Flux') - call addfld ('WP3_CLUBB', (/ 'ilev' /), 'A', 'm3/s3', 'Third Moment Vertical Velocity') - call addfld ('WPTHLP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Heat Flux') - call addfld ('WPRTP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Moisture Flux') - call addfld ('RTP2_CLUBB', (/ 'ilev' /), 'A', 'g^2/kg^2', 'Moisture Variance') - call addfld ('RTP2_ZT_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2','Moisture Variance on zt grid') - call addfld ('PDFP_RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2','PDF Rtot Variance') - call addfld ('THLP2_CLUBB', (/ 'ilev' /), 'A', 'K^2', 'Temperature Variance') - call addfld ('THLP2_ZT_CLUBB', (/ 'ilev' /), 'A', 'K^2', 'Temperature Variance on zt grid') - call addfld ('RTPTHLP_CLUBB', (/ 'ilev' /), 'A', 'K g/kg', 'Temp. Moist. Covariance') - call addfld ('RCM_CLUBB', (/ 'ilev' /), 'A', 'g/kg', 'Cloud Water Mixing Ratio') - call addfld ('WPRCP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Liquid Water Flux') - call addfld ('CLOUDFRAC_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Fraction') - call addfld ('RCMINLAYER_CLUBB', (/ 'ilev' /), 'A', 'g/kg', 'Cloud Water in Layer') - call addfld ('CLOUDCOVER_CLUBB', (/ 'ilev' /), 'A', 'fraction', 'Cloud Cover') - call addfld ('WPTHVP_CLUBB', (/ 'lev' /), 'A', 'W/m2', 'Buoyancy Flux') - call addfld ('RVMTEND_CLUBB', (/ 'lev' /), 'A', 'g/kg /s', 'Water vapor tendency') - call addfld ('STEND_CLUBB', (/ 'lev' /), 'A', 'J/(kg s)', 'Static energy tendency') - call addfld ('RCMTEND_CLUBB', (/ 'lev' /), 'A', 'g/kg /s', 'Cloud Liquid Water Tendency') - call addfld ('RIMTEND_CLUBB', (/ 'lev' /), 'A', 'g/kg /s', 'Cloud Ice Tendency') - call addfld ('UTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'U-wind Tendency') - call addfld ('VTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'V-wind Tendency') - call addfld ('ZT_CLUBB', (/ 'ilev' /), 'A', 'm', 'Thermodynamic Heights') - call addfld ('ZM_CLUBB', (/ 'ilev' /), 'A', 'm', 'Momentum Heights') - call addfld ('UM_CLUBB', (/ 'ilev' /), 'A', 'm/s', 'Zonal Wind') - call addfld ('VM_CLUBB', (/ 'ilev' /), 'A', 'm/s', 'Meridional Wind') - call addfld ('WM_ZT_CLUBB', (/ 'ilev' /), 'A', 'm/s', 'Vertical Velocity') - call addfld ('THETAL', (/ 'lev' /), 'A', 'K', 'Liquid Water Potential Temperature') - call addfld ('PBLH', horiz_only, 'A', 'm', 'PBL height') - call addfld ('QT', (/ 'lev' /), 'A', 'kg/kg', 'Total water mixing ratio') - call addfld ('SL', (/ 'lev' /), 'A', 'J/kg', 'Liquid water static energy') - call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction') - call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection') - call addfld ('TTENDICE', (/ 'lev' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment') - call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment') - call addfld ('QITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment') - call addfld ('NITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment') - - - call addfld ('QCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment') - call addfld ('NCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment') - call addfld ('FQTENDICE', (/ 'lev' /), 'A', 'fraction', 'Frequency of Ice Saturation Adjustment') - - call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection') - call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection') - call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment') - call addfld ('RELVAR', (/ 'lev' /), 'A', '-', 'Relative cloud water variance') - call addfld ('CLUBB_GRID_SIZE', horiz_only, 'A', 'm', 'Horizontal grid box size seen by CLUBB') - - - call addfld ('ZMDLFI', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice water from ZM convection') - call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover') - call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud') - call addfld ('DETNLIQTND', (/ 'lev' /), 'A', '1/kg/s', 'CLDNUM tendency in detrained water') - - call addfld ('QSATFAC', (/ 'lev' /), 'A', '-', 'Subgrid cloud water saturation scaling factor') - call addfld ('KVH_CLUBB', (/ 'ilev' /), 'A', 'm2/s', 'CLUBB vertical diffusivity of heat/moisture on interface levels') + call addfld ('RHO_CLUBB', (/ 'lev' /), 'A', 'kg/m3', 'Air Density', sampled_on_subcycle=.true.) + call addfld ('UP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Velocity Variance', sampled_on_subcycle=.true.) + call addfld ('VP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Velocity Variance', sampled_on_subcycle=.true.) + call addfld ('WP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Vertical Velocity Variance', sampled_on_subcycle=.true.) + call addfld ('WP2_ZT_CLUBB', (/ 'lev' /), 'A', 'm2/s2', 'Vert Vel Variance on zt grid', sampled_on_subcycle=.true.) + call addfld ('UPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Momentum Flux', sampled_on_subcycle=.true.) + call addfld ('VPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Momentum Flux', sampled_on_subcycle=.true.) + call addfld ('WP3_CLUBB', (/ 'lev' /), 'A', 'm3/s3', 'Third Moment Vertical Velocity', sampled_on_subcycle=.true.) + call addfld ('WPTHLP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Heat Flux', sampled_on_subcycle=.true.) + call addfld ('WPRTP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Moisture Flux', sampled_on_subcycle=.true.) + call addfld ('RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2', 'Moisture Variance', sampled_on_subcycle=.true.) + call addfld ('RTP2_ZT_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2','Moisture Variance on zt grid', sampled_on_subcycle=.true.) + call addfld ('PDFP_RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2','PDF Rtot Variance', sampled_on_subcycle=.true.) + call addfld ('THLP2_CLUBB', (/ 'ilev' /), 'A', 'K^2', 'Temperature Variance', sampled_on_subcycle=.true.) + call addfld ('THLP2_ZT_CLUBB', (/ 'lev' /), 'A', 'K^2', 'Temperature Variance on zt grid', sampled_on_subcycle=.true.) + call addfld ('RTPTHLP_CLUBB', (/ 'ilev' /), 'A', 'K kg/kg', 'Temp. Moist. Covariance', sampled_on_subcycle=.true.) + call addfld ('RCM_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Cloud Water Mixing Ratio', sampled_on_subcycle=.true.) + call addfld ('RTM_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Total Water Mixing Ratio', sampled_on_subcycle=.true.) + call addfld ('THLM_CLUBB', (/ 'lev' /), 'A', 'K', 'Liquid Water Potential Temperature', sampled_on_subcycle=.true.) + call addfld ('WPRCP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Liquid Water Flux', sampled_on_subcycle=.true.) + call addfld ('CLOUDFRAC_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Fraction', sampled_on_subcycle=.true.) + call addfld ('RCMINLAYER_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Cloud Water in Layer', sampled_on_subcycle=.true.) + call addfld ('CLOUDCOVER_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Cover', sampled_on_subcycle=.true.) + call addfld ('WPTHVP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Buoyancy Flux', sampled_on_subcycle=.true.) + call addfld ('RVMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Water vapor tendency', sampled_on_subcycle=.true.) + call addfld ('STEND_CLUBB', (/ 'lev' /), 'A', 'J/(kg s)', 'Static energy tendency', sampled_on_subcycle=.true.) + call addfld ('RCMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Cloud Liquid Water Tendency', sampled_on_subcycle=.true.) + call addfld ('RIMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Cloud Ice Tendency', sampled_on_subcycle=.true.) + call addfld ('UTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'U-wind Tendency', sampled_on_subcycle=.true.) + call addfld ('VTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'V-wind Tendency', sampled_on_subcycle=.true.) + call addfld ('ZT_CLUBB', (/ 'lev' /), 'A', 'm', 'Thermodynamic Heights', sampled_on_subcycle=.true.) + call addfld ('ZM_CLUBB', (/ 'ilev' /), 'A', 'm', 'Momentum Heights', sampled_on_subcycle=.true.) + call addfld ('UM_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Zonal Wind', sampled_on_subcycle=.true.) + call addfld ('VM_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Meridional Wind', sampled_on_subcycle=.true.) + call addfld ('WM_ZT_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Vertical Velocity', sampled_on_subcycle=.true.) + call addfld ('PBLH', horiz_only, 'A', 'm', 'PBL height', sampled_on_subcycle=.true.) + call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction', sampled_on_subcycle=.true.) + call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection', sampled_on_subcycle=.true.) + call addfld ('TTENDICE', (/ 'lev' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) + call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) + call addfld ('QITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) + call addfld ('NITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) + + + call addfld ('QCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) + call addfld ('NCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) + call addfld ('FQTENDICE', (/ 'lev' /), 'A', 'fraction', 'Frequency of Ice Saturation Adjustment', sampled_on_subcycle=.true.) + + call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection', sampled_on_subcycle=.true.) + call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection', sampled_on_subcycle=.true.) + call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment', sampled_on_subcycle=.true.) + call addfld ('RELVAR', (/ 'lev' /), 'A', '-', 'Relative cloud water variance', sampled_on_subcycle=.true.) + call addfld ('CLUBB_GRID_SIZE', horiz_only, 'A', 'm', 'Horizontal grid box size seen by CLUBB', sampled_on_subcycle=.true.) + + + call addfld ('ZMDLFI', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice water from ZM convection', sampled_on_subcycle=.true.) + call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover', sampled_on_subcycle=.true.) + call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud', sampled_on_subcycle=.true.) + call addfld ('DETNLIQTND', (/ 'lev' /), 'A', '1/kg/s', 'CLDNUM tendency in detrained water', sampled_on_subcycle=.true.) + + call addfld ('QSATFAC', (/ 'lev' /), 'A', '-', 'Subgrid cloud water saturation scaling factor', sampled_on_subcycle=.true.) + call addfld ('KVH_CLUBB', (/ 'ilev' /), 'A', 'm2/s', 'CLUBB vertical diffusivity of heat/moisture on interface levels', sampled_on_subcycle=.true.) + call addfld ('ELEAK_CLUBB', horiz_only, 'A', 'W/m2', 'CLUBB energy leak', sampled_on_subcycle=.true.) + call addfld ('TFIX_CLUBB', horiz_only, 'A', 'K', 'Temperature increment to conserve energy', sampled_on_subcycle=.true.) ! ---------------------------------------------------------------------------- ! ! Below are for detailed analysis of EDMF Scheme ! ! ---------------------------------------------------------------------------- ! if (do_clubb_mf) then - call addfld ( 'edmf_DRY_A' , (/ 'ilev' /), 'A', 'fraction', 'Dry updraft area fraction (EDMF)' ) - call addfld ( 'edmf_MOIST_A' , (/ 'ilev' /), 'A', 'fraction', 'Moist updraft area fraction (EDMF)' ) - call addfld ( 'edmf_DRY_W' , (/ 'ilev' /), 'A', 'm/s' , 'Dry updraft vertical velocity (EDMF)' ) - call addfld ( 'edmf_MOIST_W' , (/ 'ilev' /), 'A', 'm/s' , 'Moist updraft vertical velocity (EDMF)' ) - call addfld ( 'edmf_DRY_QT' , (/ 'ilev' /), 'A', 'kg/kg' , 'Dry updraft total water mixing ratio (EDMF)' ) - call addfld ( 'edmf_MOIST_QT' , (/ 'ilev' /), 'A', 'kg/kg' , 'Moist updraft total water mixing ratio (EDMF)' ) - call addfld ( 'edmf_DRY_THL' , (/ 'ilev' /), 'A', 'K' , 'Dry updraft liquid-ice potential temperature (EDMF)' ) - call addfld ( 'edmf_MOIST_THL', (/ 'ilev' /), 'A', 'K' , 'Moist updraft liquid-ice potential temperature (EDMF)' ) - call addfld ( 'edmf_DRY_U' , (/ 'ilev' /), 'A', 'm/s' , 'Dry updraft zonal velocity (EDMF)' ) - call addfld ( 'edmf_MOIST_U' , (/ 'ilev' /), 'A', 'm/s' , 'Moist updraft zonal velocity (EDMF)' ) - call addfld ( 'edmf_DRY_V' , (/ 'ilev' /), 'A', 'm/s' , 'Dry updraft meridional velocity (EDMF)' ) - call addfld ( 'edmf_MOIST_V' , (/ 'ilev' /), 'A', 'm/s' , 'Moist updraft meridional velocity (EDMF)' ) - call addfld ( 'edmf_MOIST_QC' , (/ 'ilev' /), 'A', 'kg/kg' , 'Moist updraft condensate mixing ratio (EDMF)' ) - call addfld ( 'edmf_S_AE' , (/ 'ilev' /), 'A', 'fraction', '1 minus sum of a_i*w_i (EDMF)' ) - call addfld ( 'edmf_S_AW' , (/ 'ilev' /), 'A', 'm/s' , 'Sum of a_i*w_i (EDMF)' ) - call addfld ( 'edmf_S_AWTHL' , (/ 'ilev' /), 'A', 'K m/s' , 'Sum of a_i*w_i*thl_i (EDMF)' ) - call addfld ( 'edmf_S_AWQT' , (/ 'ilev' /), 'A', 'kgm/kgs' , 'Sum of a_i*w_i*q_ti (EDMF)' ) - call addfld ( 'edmf_S_AWU' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*u_i (EDMF)' ) - call addfld ( 'edmf_S_AWV' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*v_i (EDMF)' ) - call addfld ( 'edmf_thlflx' , (/ 'ilev' /), 'A', 'W/m2' , 'thl flux (EDMF)' ) - call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'W/m2' , 'qt flux (EDMF)' ) - end if + call addfld ( 'edmf_DRY_A' , (/ 'ilev' /), 'A', 'fraction', 'Dry updraft area fraction (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_MOIST_A' , (/ 'ilev' /), 'A', 'fraction', 'Moist updraft area fraction (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_DRY_W' , (/ 'ilev' /), 'A', 'm/s' , 'Dry updraft vertical velocity (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_MOIST_W' , (/ 'ilev' /), 'A', 'm/s' , 'Moist updraft vertical velocity (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_DRY_QT' , (/ 'ilev' /), 'A', 'kg/kg' , 'Dry updraft total water mixing ratio (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_MOIST_QT' , (/ 'ilev' /), 'A', 'kg/kg' , 'Moist updraft total water mixing ratio (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_DRY_THL' , (/ 'ilev' /), 'A', 'K' , 'Dry updraft liquid-ice potential temperature (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_MOIST_THL', (/ 'ilev' /), 'A', 'K' , 'Moist updraft liquid-ice potential temperature (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_DRY_U' , (/ 'ilev' /), 'A', 'm/s' , 'Dry updraft zonal velocity (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_MOIST_U' , (/ 'ilev' /), 'A', 'm/s' , 'Moist updraft zonal velocity (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_DRY_V' , (/ 'ilev' /), 'A', 'm/s' , 'Dry updraft meridional velocity (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_MOIST_V' , (/ 'ilev' /), 'A', 'm/s' , 'Moist updraft meridional velocity (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_MOIST_QC' , (/ 'ilev' /), 'A', 'kg/kg' , 'Moist updraft condensate mixing ratio (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_S_AE' , (/ 'ilev' /), 'A', 'fraction', '1 minus sum of a_i*w_i (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_S_AW' , (/ 'ilev' /), 'A', 'm/s' , 'Sum of a_i*w_i (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_S_AWTHL' , (/ 'ilev' /), 'A', 'K m/s' , 'Sum of a_i*w_i*thl_i (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_S_AWQT' , (/ 'ilev' /), 'A', 'kgm/kgs' , 'Sum of a_i*w_i*q_ti (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_S_AWU' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*u_i (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_S_AWV' , (/ 'ilev' /), 'A', 'm2/s2' , 'Sum of a_i*w_i*v_i (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_thlflx' , (/ 'ilev' /), 'A', 'W/m2' , 'thl flux (EDMF)', sampled_on_subcycle=.true.) + call addfld ( 'edmf_qtflx' , (/ 'ilev' /), 'A', 'W/m2' , 'qt flux (EDMF)', sampled_on_subcycle=.true.) + end if + + if ( trim(subcol_scheme) /= 'SILHS' ) then + ! hm_metadata is set up by calling init_pdf_hydromet_arrays_api in subcol_init_SILHS. + ! So if we are not using silhs, we allocate the parts of hm_metadata that need allocating + ! in order to making intel debug tests happy. + allocate( hm_metadata%hydromet_list(1), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate hm_metadata%hydromet_list' ) + allocate( hm_metadata%l_mix_rat_hm(1), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate hm_metadata%l_mix_rat_hm' ) + end if ! Initialize statistics, below are dummy variables dum1 = 300._r8 dum2 = 1200._r8 dum3 = 300._r8 - if (l_stats) then - - call stats_init_clubb( .true., dum1, dum2, & - nlev+1, nlev+1, nlev+1, dum3 ) - - allocate(out_zt(pcols,pverp,stats_zt%num_output_fields)) - allocate(out_zm(pcols,pverp,stats_zm%num_output_fields)) - allocate(out_sfc(pcols,1,stats_sfc%num_output_fields)) - - allocate(out_radzt(pcols,pverp,stats_rad_zt%num_output_fields)) - allocate(out_radzm(pcols,pverp,stats_rad_zm%num_output_fields)) + if (stats_metadata%l_stats) then + + call stats_init_clubb( .true., dum1, dum2, & + nzm_clubb, nzm_clubb, nzm_clubb, dum3, & + stats_zt(:), stats_zm(:), stats_sfc(:), & + stats_rad_zt(:), stats_rad_zm(:)) + + allocate(out_zt(pcols,pverp,stats_zt(1)%num_output_fields), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_zt' ) + allocate(out_zm(pcols,pverp,stats_zm(1)%num_output_fields), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_zm' ) + allocate(out_sfc(pcols,1,stats_sfc(1)%num_output_fields), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_sfc' ) + + if ( stats_metadata%l_output_rad_files ) then + allocate(out_radzt(pcols,pverp,stats_rad_zt(1)%num_output_fields), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_radzt' ) + allocate(out_radzm(pcols,pverp,stats_rad_zm(1)%num_output_fields), stat=ierr) + if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_radzm' ) + end if endif - + ! ----------------------------------------------------------------- ! ! Make all of this output default, this is not CLUBB history ! ----------------------------------------------------------------- ! - - if (clubb_do_adv .or. history_clubb) then + + if (clubb_do_adv .or. history_clubb) then + call add_default('RELVAR', 1, ' ') call add_default('RHO_CLUBB', 1, ' ') call add_default('UP2_CLUBB', 1, ' ') call add_default('VP2_CLUBB', 1, ' ') @@ -1248,6 +1936,8 @@ subroutine clubb_ini_cam(pbuf2d) call add_default('THLP2_ZT_CLUBB', 1, ' ') call add_default('RTPTHLP_CLUBB', 1, ' ') call add_default('RCM_CLUBB', 1, ' ') + call add_default('RTM_CLUBB', 1, ' ') + call add_default('THLM_CLUBB', 1, ' ') call add_default('WPRCP_CLUBB', 1, ' ') call add_default('CLOUDFRAC_CLUBB', 1, ' ') call add_default('RCMINLAYER_CLUBB', 1, ' ') @@ -1260,89 +1950,54 @@ subroutine clubb_ini_cam(pbuf2d) call add_default('UTEND_CLUBB', 1, ' ') call add_default('VTEND_CLUBB', 1, ' ') call add_default('ZT_CLUBB', 1, ' ') - call add_default('ZM_CLUBB', 1, ' ') + call add_default('ZM_CLUBB', 1, ' ') call add_default('UM_CLUBB', 1, ' ') call add_default('VM_CLUBB', 1, ' ') call add_default('WM_ZT_CLUBB', 1, ' ') call add_default('PBLH', 1, ' ') - call add_default('SL', 1, ' ') - call add_default('QT', 1, ' ') - call add_default('THETAL', 1, ' ') - call add_default('CONCLD', 1, ' ') - end if - - if (history_amwg) then - call add_default('PBLH', 1, ' ') - end if - - if (history_clubb) then - - call add_default('RELVAR', 1, ' ') - call add_default('RHO_CLUBB', 1, ' ') - call add_default('UPWP_CLUBB', 1, ' ') - call add_default('VPWP_CLUBB', 1, ' ') - call add_default('RCM_CLUBB', 1, ' ') - call add_default('WPRCP_CLUBB', 1, ' ') - call add_default('CLOUDFRAC_CLUBB', 1, ' ') - call add_default('RCMINLAYER_CLUBB', 1, ' ') - call add_default('CLOUDCOVER_CLUBB', 1, ' ') - call add_default('WPTHVP_CLUBB', 1, ' ') - call add_default('RVMTEND_CLUBB', 1, ' ') - call add_default('STEND_CLUBB', 1, ' ') - call add_default('RCMTEND_CLUBB', 1, ' ') - call add_default('RIMTEND_CLUBB', 1, ' ') - call add_default('UTEND_CLUBB', 1, ' ') - call add_default('VTEND_CLUBB', 1, ' ') - call add_default('ZT_CLUBB', 1, ' ') - call add_default('ZM_CLUBB', 1, ' ') - call add_default('UM_CLUBB', 1, ' ') - call add_default('VM_CLUBB', 1, ' ') - call add_default('SL', 1, ' ') - call add_default('QT', 1, ' ') call add_default('CONCLD', 1, ' ') - - if (do_clubb_mf_diag) then - call add_default( 'edmf_DRY_A' , 1, ' ') - call add_default( 'edmf_MOIST_A' , 1, ' ') - call add_default( 'edmf_DRY_W' , 1, ' ') - call add_default( 'edmf_MOIST_W' , 1, ' ') - call add_default( 'edmf_DRY_QT' , 1, ' ') - call add_default( 'edmf_MOIST_QT' , 1, ' ') - call add_default( 'edmf_DRY_THL' , 1, ' ') - call add_default( 'edmf_MOIST_THL', 1, ' ') - call add_default( 'edmf_DRY_U' , 1, ' ') - call add_default( 'edmf_MOIST_U' , 1, ' ') - call add_default( 'edmf_DRY_V' , 1, ' ') - call add_default( 'edmf_MOIST_V' , 1, ' ') - call add_default( 'edmf_MOIST_QC' , 1, ' ') - call add_default( 'edmf_S_AE' , 1, ' ') - call add_default( 'edmf_S_AW' , 1, ' ') - call add_default( 'edmf_S_AWTHL' , 1, ' ') - call add_default( 'edmf_S_AWQT' , 1, ' ') - call add_default( 'edmf_S_AWU' , 1, ' ') - call add_default( 'edmf_S_AWV' , 1, ' ') - call add_default( 'edmf_thlflx' , 1, ' ') - call add_default( 'edmf_qtflx' , 1, ' ') - end if - - end if + endif if (history_amwg) then call add_default('PBLH', 1, ' ') end if - - if (history_budget) then + + if (do_clubb_mf_diag) then + call add_default( 'edmf_DRY_A' , 1, ' ') + call add_default( 'edmf_MOIST_A' , 1, ' ') + call add_default( 'edmf_DRY_W' , 1, ' ') + call add_default( 'edmf_MOIST_W' , 1, ' ') + call add_default( 'edmf_DRY_QT' , 1, ' ') + call add_default( 'edmf_MOIST_QT' , 1, ' ') + call add_default( 'edmf_DRY_THL' , 1, ' ') + call add_default( 'edmf_MOIST_THL', 1, ' ') + call add_default( 'edmf_DRY_U' , 1, ' ') + call add_default( 'edmf_MOIST_U' , 1, ' ') + call add_default( 'edmf_DRY_V' , 1, ' ') + call add_default( 'edmf_MOIST_V' , 1, ' ') + call add_default( 'edmf_MOIST_QC' , 1, ' ') + call add_default( 'edmf_S_AE' , 1, ' ') + call add_default( 'edmf_S_AW' , 1, ' ') + call add_default( 'edmf_S_AWTHL' , 1, ' ') + call add_default( 'edmf_S_AWQT' , 1, ' ') + call add_default( 'edmf_S_AWU' , 1, ' ') + call add_default( 'edmf_S_AWV' , 1, ' ') + call add_default( 'edmf_thlflx' , 1, ' ') + call add_default( 'edmf_qtflx' , 1, ' ') + end if + + if (history_budget) then call add_default('DPDLFLIQ', history_budget_histfile_num, ' ') call add_default('DPDLFICE', history_budget_histfile_num, ' ') - call add_default('DPDLFT', history_budget_histfile_num, ' ') + call add_default('DPDLFT', history_budget_histfile_num, ' ') call add_default('STEND_CLUBB', history_budget_histfile_num, ' ') call add_default('RCMTEND_CLUBB', history_budget_histfile_num, ' ') call add_default('RIMTEND_CLUBB', history_budget_histfile_num, ' ') call add_default('RVMTEND_CLUBB', history_budget_histfile_num, ' ') call add_default('UTEND_CLUBB', history_budget_histfile_num, ' ') call add_default('VTEND_CLUBB', history_budget_histfile_num, ' ') - endif - + endif + ! --------------- ! ! First step? ! @@ -1361,12 +2016,12 @@ subroutine clubb_ini_cam(pbuf2d) call pbuf_set_field(pbuf2d, thlp2_idx, thl_tol**2) call pbuf_set_field(pbuf2d, up2_idx, w_tol_sqd) call pbuf_set_field(pbuf2d, vp2_idx, w_tol_sqd) - + call pbuf_set_field(pbuf2d, rtp3_idx, 0.0_r8) call pbuf_set_field(pbuf2d, thlp3_idx, 0.0_r8) call pbuf_set_field(pbuf2d, up3_idx, 0.0_r8) call pbuf_set_field(pbuf2d, vp3_idx, 0.0_r8) - + call pbuf_set_field(pbuf2d, upwp_idx, 0.0_r8) call pbuf_set_field(pbuf2d, vpwp_idx, 0.0_r8) call pbuf_set_field(pbuf2d, wpthvp_idx, 0.0_r8) @@ -1378,6 +2033,17 @@ subroutine clubb_ini_cam(pbuf2d) call pbuf_set_field(pbuf2d, tke_idx, 0.0_r8) call pbuf_set_field(pbuf2d, kvh_idx, 0.0_r8) call pbuf_set_field(pbuf2d, radf_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp2rtp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp2thlp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, uprcp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, vprcp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, rc_coef_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp4_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wpup2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wpvp2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp2up2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp2vp2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, ice_supersat_idx, 0.0_r8) ! Initialize SILHS covariance contributions call pbuf_set_field(pbuf2d, rtp2_mc_zt_idx, 0.0_r8) @@ -1385,11 +2051,31 @@ subroutine clubb_ini_cam(pbuf2d) call pbuf_set_field(pbuf2d, wprtp_mc_zt_idx, 0.0_r8) call pbuf_set_field(pbuf2d, wpthlp_mc_zt_idx, 0.0_r8) call pbuf_set_field(pbuf2d, rtpthlp_mc_zt_idx, 0.0_r8) + + call pbuf_set_field(pbuf2d, pdf_zm_w_1_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, pdf_zm_w_2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, pdf_zm_varnce_w_1_idx, 0.0_r8) + 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 call pbuf_set_field(pbuf2d, fice_idx, 0.0_r8) - + ! --------------- ! ! End ! ! Initialization ! @@ -1397,1630 +2083,2317 @@ subroutine clubb_ini_cam(pbuf2d) #endif end subroutine clubb_ini_cam - - + + ! =============================================================================== ! ! ! ! =============================================================================== ! + subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & + cmfmc, cam_in, & + macmic_it, cld_macmic_num_steps,dlf, det_s, det_ice) + + !------------------------------------------------------------------------------- + ! Description: Provide tendencies of shallow convection, turbulence, and + ! macrophysics from CLUBB to CAM + ! + ! Author: Cheryl Craig, March 2011 + ! Modifications: Pete Bogenschutz, March 2011 and onward + ! Origin: Based heavily on UWM clubb_init.F90 + ! References: + ! None + !------------------------------------------------------------------------------- + + use physics_types, only: physics_state, physics_ptend, & + physics_state_copy, physics_ptend_init, & + physics_ptend_sum, physics_update, set_wet_to_dry + + use physics_buffer, only: pbuf_old_tim_idx, pbuf_get_field, physics_buffer_desc + use physics_buffer, only: pbuf_set_field + + use constituents, only: cnst_get_ind, cnst_type + use camsrfexch, only: cam_in_t + use time_manager, only: is_first_step + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use tropopause, only: tropopause_findChemTrop + use time_manager, only: get_nstep, is_first_restart_step + use perf_mod, only: t_startf, t_stopf - subroutine clubb_tend_cam( & - state, ptend_all, pbuf, hdtime, & - cmfmc, cam_in, & - macmic_it, cld_macmic_num_steps,dlf, det_s, det_ice) - -!------------------------------------------------------------------------------- -! Description: Provide tendencies of shallow convection, turbulence, and -! macrophysics from CLUBB to CAM -! -! Author: Cheryl Craig, March 2011 -! Modifications: Pete Bogenschutz, March 2011 and onward -! Origin: Based heavily on UWM clubb_init.F90 -! References: -! None -!------------------------------------------------------------------------------- +#ifdef CLUBB_SGS + use hb_diff, only: pblintd + use clubb_api_module, only: & + nparams, & + setup_parameters_api, & + time_precision, & + advance_clubb_core_api, & + zt2zm_api, zm2zt_api, & + setup_grid_heights_api, & + em_min, & + w_tol_sqd, & + rt_tol, & + thl_tol, & + stats_begin_timestep_api, & + calculate_thlp2_rad_api, update_xp2_mc_api, & + sat_mixrat_liq_api, & + fstderr, & + ipdf_post_advance_fields, & + copy_single_pdf_params_to_multi, & + copy_multi_pdf_params_to_single, & + pdf_parameter, & + init_pdf_params_api, & + init_pdf_implicit_coefs_terms_api, & + setup_grid_api - use physics_types, only: physics_state, physics_ptend, & - physics_state_copy, physics_ptend_init, & - physics_ptend_sum, physics_update, set_dry_to_wet + use clubb_api_module, only: & + clubb_fatal_error ! Error code value to indicate a fatal error - use physics_buffer, only: pbuf_old_tim_idx, pbuf_get_field, physics_buffer_desc + use cldfrc2m, only: aist_vector, rhmini_const, rhmaxi_const, rhminis_const, rhmaxis_const + use cam_history, only: outfld - use constituents, only: cnst_get_ind, cnst_type - use camsrfexch, only: cam_in_t - use time_manager, only: is_first_step - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use tropopause, only: tropopause_findChemTrop - use time_manager, only: get_nstep - -#ifdef CLUBB_SGS - use hb_diff, only: pblintd - use scamMOD, only: single_column,scm_clubb_iop_name - use clubb_api_module, only: & - nparams, & - read_parameters_api, & - setup_parameters_api, & - time_precision, & - advance_clubb_core_api, & - zt2zm_api, zm2zt_api, & - setup_grid_heights_api, & - em_min, & - w_tol_sqd, & - rt_tol, & - thl_tol, & - l_stats, & - stats_tsamp, & - stats_tout, & - stats_zt, & - stats_sfc, & - stats_zm, & - stats_rad_zt, & - stats_rad_zm, & - l_output_rad_files, & - stats_begin_timestep_api, & - hydromet_dim, calculate_thlp2_rad_api, mu, update_xp2_mc_api, & - sat_mixrat_liq_api, & - fstderr - - use clubb_api_module, only: & - clubb_fatal_error ! Error code value to indicate a fatal error - - use cldfrc2m, only: aist_vector, rhmini_const, rhmaxi_const, rhminis_const, rhmaxis_const - use cam_history, only: outfld - - use macrop_driver, only: liquid_macro_tend - use clubb_mf, only: integrate_mf + use macrop_driver, only: liquid_macro_tend + use clubb_mf, only: integrate_mf #endif - implicit none - - ! --------------- ! - ! Input Auguments ! - ! --------------- ! - - type(physics_state), intent(in) :: state ! Physics state variables [vary] - type(cam_in_t), intent(in) :: cam_in - real(r8), intent(in) :: hdtime ! Host model timestep [s] - real(r8), intent(in) :: dlf(pcols,pver) ! Detraining cld H20 from deep convection [kg/ks/s] - real(r8), intent(in) :: cmfmc(pcols,pverp) ! convective mass flux--m sub c [kg/m2/s] - integer, intent(in) :: cld_macmic_num_steps ! number of mac-mic iterations - integer, intent(in) :: macmic_it ! number of mac-mic iterations - - ! ---------------------- ! - ! Input-Output Auguments ! - ! ---------------------- ! - - type(physics_buffer_desc), pointer :: pbuf(:) - - ! ---------------------- ! - ! Output Auguments ! - ! ---------------------- ! - - type(physics_ptend), intent(out) :: ptend_all ! package tendencies - - ! These two variables are needed for energy check - real(r8), intent(out) :: det_s(pcols) ! Integral of detrained static energy from ice - real(r8), intent(out) :: det_ice(pcols) ! Integral of detrained ice for energy check - - - ! --------------- ! - ! Local Variables ! - ! --------------- ! + implicit none -#ifdef CLUBB_SGS + ! ---------------------------------------------------- ! + ! Input Auguments ! + ! ---------------------------------------------------- ! - type(physics_state) :: state1 ! Local copy of state variable - type(physics_ptend) :: ptend_loc ! Local tendency from processes, added up to return as ptend_all - - integer :: i, j, k, t, ixind, nadv - integer :: ixcldice, ixcldliq, ixnumliq, ixnumice, ixq - integer :: itim_old - integer :: ncol, lchnk ! # of columns, and chunk identifier - integer :: err_code ! Diagnostic, for if some calculation goes amiss. - integer :: icnt, clubbtop - logical :: lq2(pcnst) - - integer :: iter - - real(r8) :: frac_limit, ic_limit - - real(r8) :: dtime ! CLUBB time step [s] - real(r8) :: edsclr_in(pverp+1-top_lev,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] - real(r8) :: wp2_in(pverp+1-top_lev) ! vertical velocity variance (CLUBB) [m^2/s^2] - real(r8) :: wp3_in(pverp+1-top_lev) ! third moment vertical velocity [m^3/s^3] - real(r8) :: wpthlp_in(pverp+1-top_lev) ! turbulent flux of thetal [K m/s] - real(r8) :: wprtp_in(pverp+1-top_lev) ! turbulent flux of total water [kg/kg m/s] - real(r8) :: rtpthlp_in(pverp+1-top_lev) ! covariance of thetal and qt [kg/kg K] - real(r8) :: rtp2_in(pverp+1-top_lev) ! total water variance [kg^2/kg^2] - real(r8) :: thlp2_in(pverp+1-top_lev) ! thetal variance [K^2] - real(r8) :: rtp3_in(pverp+1-top_lev) ! total water 3rd order [kg^3/kg^3] - real(r8) :: thlp3_in(pverp+1-top_lev) ! thetal 3rd order [K^3] - real(r8) :: up2_in(pverp+1-top_lev) ! meridional wind variance [m^2/s^2] - real(r8) :: vp2_in(pverp+1-top_lev) ! zonal wind variance [m^2/s^2] - real(r8) :: up3_in(pverp+1-top_lev) ! meridional wind third-order [m^3/s^3] - real(r8) :: vp3_in(pverp+1-top_lev) ! zonal wind third-order [m^3/s^3] - real(r8) :: upwp_in(pverp+1-top_lev) ! meridional wind flux [m^2/s^2] - real(r8) :: vpwp_in(pverp+1-top_lev) ! zonal wind flux [m^2/s^2] - real(r8) :: wpthvp_in(pverp+1-top_lev) ! w'th_v' (momentum levels) [m/s K] - real(r8) :: wp2thvp_in(pverp+1-top_lev) ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] - real(r8) :: rtpthvp_in(pverp+1-top_lev) ! r_t'th_v' (momentum levels) [kg/kg K] - real(r8) :: thlpthvp_in(pverp+1-top_lev) ! th_l'th_v' (momentum levels) [K^2] - real(r8) :: thlm_in(pverp+1-top_lev) ! liquid water potential temperature (thetal) [K] - real(r8) :: rtm_in(pverp+1-top_lev) ! total water mixing ratio [kg/kg] - real(r8) :: rvm_in(pverp+1-top_lev) ! water vapor mixing ratio [kg/kg] - real(r8) :: um_in(pverp+1-top_lev) ! meridional wind [m/s] - real(r8) :: vm_in(pverp+1-top_lev) ! zonal wind [m/s] - real(r8) :: rho_in(pverp+1-top_lev) ! mid-point density [kg/m^3] - real(r8) :: pre_in(pverp+1-top_lev) ! input for precip evaporation - real(r8) :: rtp2_mc_out(pverp+1-top_lev) ! total water tendency from rain evap - real(r8) :: thlp2_mc_out(pverp+1-top_lev) ! thetal tendency from rain evap - real(r8) :: wprtp_mc_out(pverp+1-top_lev) - real(r8) :: wpthlp_mc_out(pverp+1-top_lev) - real(r8) :: rtpthlp_mc_out(pverp+1-top_lev) - real(r8) :: rcm_inout(pverp+1-top_lev) ! CLUBB output of liquid water mixing ratio [kg/kg] - real(r8) :: rcm_out_zm(pverp+1-top_lev) - real(r8) :: wprcp_out(pverp+1-top_lev) ! CLUBB output of flux of liquid water [kg/kg m/s] - real(r8) :: cloud_frac_inout(pverp+1-top_lev) ! CLUBB output of cloud fraction [fraction] - real(r8) :: rcm_in_layer_out(pverp+1-top_lev) ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] - real(r8) :: cloud_cover_out(pverp+1-top_lev) ! CLUBB output of in-cloud cloud fraction [fraction] - real(r8) :: thlprcp_out(pverp+1-top_lev) - real(r8) :: rho_ds_zm(pverp+1-top_lev) ! Dry, static density on momentum levels [kg/m^3] - real(r8) :: rho_ds_zt(pverp+1-top_lev) ! Dry, static density on thermodynamic levels [kg/m^3] - real(r8) :: invrs_rho_ds_zm(pverp+1-top_lev) ! Inv. dry, static density on momentum levels [m^3/kg] - real(r8) :: invrs_rho_ds_zt(pverp+1-top_lev) ! Inv. dry, static density on thermo. levels [m^3/kg] - real(r8) :: thv_ds_zm(pverp+1-top_lev) ! Dry, base-state theta_v on momentum levels [K] - real(r8) :: thv_ds_zt(pverp+1-top_lev) ! Dry, base-state theta_v on thermo. levels [K] - real(r8) :: rfrzm(pverp+1-top_lev) - real(r8) :: radf(pverp+1-top_lev) - real(r8) :: wprtp_forcing(pverp+1-top_lev) - real(r8) :: wpthlp_forcing(pverp+1-top_lev) - real(r8) :: rtp2_forcing(pverp+1-top_lev) - real(r8) :: thlp2_forcing(pverp+1-top_lev) - real(r8) :: rtpthlp_forcing(pverp+1-top_lev) - real(r8) :: ice_supersat_frac_out(pverp+1-top_lev) - real(r8) :: zt_g(pverp+1-top_lev) ! Thermodynamic grid of CLUBB [m] - real(r8) :: zi_g(pverp+1-top_lev) ! Momentum grid of CLUBB [m] - real(r8) :: zt_out(pcols,pverp) ! output for the thermo CLUBB grid [m] - real(r8) :: zi_out(pcols,pverp) ! output for momentum CLUBB grid [m] - real(r8) :: fcor ! Coriolis forcing [s^-1] - real(r8) :: sfc_elevation ! Elevation of ground [m AMSL] [m] - real(r8) :: ubar ! surface wind [m/s] - real(r8) :: ustar ! surface stress [m/s] - real(r8) :: z0 ! roughness height [m] - real(r8) :: thlm_forcing(pverp+1-top_lev) ! theta_l forcing (thermodynamic levels) [K/s] - real(r8) :: rtm_forcing(pverp+1-top_lev) ! r_t forcing (thermodynamic levels) [(kg/kg)/s] - real(r8) :: um_forcing(pverp+1-top_lev) ! u wind forcing (thermodynamic levels) [m/s/s] - real(r8) :: vm_forcing(pverp+1-top_lev) ! v wind forcing (thermodynamic levels) [m/s/s] - real(r8) :: wm_zm(pverp+1-top_lev) ! w mean wind component on momentum levels [m/s] - real(r8) :: wm_zt(pverp+1-top_lev) ! w mean wind component on thermo. levels [m/s] - real(r8) :: p_in_Pa(pverp+1-top_lev) ! Air pressure (thermodynamic levels) [Pa] - real(r8) :: rho_zt(pverp+1-top_lev) ! Air density on thermo levels [kt/m^3] - real(r8) :: rho_zm(pverp+1-top_lev) ! Air density on momentum levels [kg/m^3] - real(r8) :: exner(pverp+1-top_lev) ! Exner function (thermodynamic levels) [-] - real(r8) :: wpthlp_sfc ! w' theta_l' at surface [(m K)/s] - real(r8) :: wprtp_sfc ! w' r_t' at surface [(kg m)/( kg s)] - real(r8) :: upwp_sfc ! u'w' at surface [m^2/s^2] - real(r8) :: vpwp_sfc ! v'w' at surface [m^2/s^2] - real(r8) :: sclrm_forcing(pverp+1-top_lev,sclr_dim) ! Passive scalar forcing [{units vary}/s] - real(r8) :: wpsclrp_sfc(sclr_dim) ! Scalar flux at surface [{units vary} m/s] - real(r8) :: edsclrm_forcing(pverp+1-top_lev,edsclr_dim)! Eddy passive scalar forcing [{units vary}/s] - real(r8) :: wpedsclrp_sfc(edsclr_dim) ! Eddy-scalar flux at surface [{units vary} m/s] - real(r8) :: sclrm(pverp+1-top_lev,sclr_dim) ! Passive scalar mean (thermo. levels) [units vary] - real(r8) :: wpsclrp(pverp+1-top_lev,sclr_dim)! w'sclr' (momentum levels) [{units vary} m/s] - real(r8) :: sclrp2(pverp+1-top_lev,sclr_dim) ! sclr'^2 (momentum levels) [{units vary}^2] - real(r8) :: sclrp3(pverp+1-top_lev,sclr_dim) ! sclr'^3 (thermo. levels) [{units vary}^3] - real(r8) :: sclrprtp(pverp+1-top_lev,sclr_dim) ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] - real(r8) :: sclrpthlp(pverp+1-top_lev,sclr_dim) ! sclr'thlp' (momentum levels) [{units vary} (K)] - real(r8) :: sclrpthvp_inout(pverp,sclr_dim) ! sclr'th_v' (momentum levels) [{units vary} (K)] - real(r8) :: hydromet(pverp+1-top_lev,hydromet_dim) - real(r8) :: wphydrometp(pverp+1-top_lev,hydromet_dim) - real(r8) :: wp2hmp(pverp+1-top_lev,hydromet_dim) - real(r8) :: rtphmp_zt(pverp+1-top_lev,hydromet_dim) - real(r8) :: thlphmp_zt (pverp+1-top_lev,hydromet_dim) - real(r8) :: bflx22 ! Variable for buoyancy flux for pbl [K m/s] - real(r8) :: khzm_out(pverp+1-top_lev) ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] - real(r8) :: khzt_out(pverp+1-top_lev) ! eddy diffusivity on thermo grids [m^2/s] - real(r8) :: qclvar_out(pverp+1-top_lev) ! cloud water variance [kg^2/kg^2] - real(r8) :: qclvar(pcols,pverp) ! cloud water variance [kg^2/kg^2] - real(r8) :: zo ! roughness height [m] - real(r8) :: dz_g(pver) ! thickness of layer [m] - real(r8) :: relvarmax - real(r8) :: se_upper_a, se_upper_b, se_upper_diss - real(r8) :: tw_upper_a, tw_upper_b, tw_upper_diss - real(r8) :: grid_dx(pcols), grid_dy(pcols) ! CAM grid [m] - real(r8) :: host_dx, host_dy ! CAM grid [m] - - ! Variables below are needed to compute energy integrals for conservation - real(r8) :: ke_a(pcols), ke_b(pcols), te_a(pcols), te_b(pcols) - real(r8) :: wv_a(pcols), wv_b(pcols), wl_b(pcols), wl_a(pcols) - real(r8) :: se_dis, se_a(pcols), se_b(pcols), clubb_s(pver) - - real(r8) :: inv_exner_clubb(pcols,pverp) ! Inverse exner function consistent with CLUBB [-] - real(r8) :: wpthlp_output(pcols,pverp) ! Heat flux output variable [W/m2] - real(r8) :: wprtp_output(pcols,pverp) ! Total water flux output variable [W/m2] - real(r8) :: wp3_output(pcols,pverp) ! wp3 output [m^3/s^3] - real(r8) :: rtpthlp_output(pcols,pverp) ! rtpthlp ouptut [K kg/kg] - real(r8) :: qt_output(pcols,pver) ! Total water mixing ratio for output [kg/kg] - real(r8) :: thetal_output(pcols,pver) ! Liquid water potential temperature output [K] - real(r8) :: sl_output(pcols,pver) ! Liquid water static energy [J/kg] - real(r8) :: ustar2(pcols) ! Surface stress for PBL height [m2/s2] - real(r8) :: rho(pcols,pverp) ! Midpoint density in CAM [kg/m^3] - real(r8) :: thv(pcols,pver) ! virtual potential temperature [K] - real(r8) :: edsclr_out(pverp,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] - real(r8) :: rcm_in_layer(pcols,pverp) ! CLUBB in-cloud liquid water mixing ratio [kg/kg] - real(r8) :: cloud_cover(pcols,pverp) ! CLUBB in-cloud cloud fraction [fraction] - real(r8) :: wprcp(pcols,pverp) ! CLUBB liquid water flux [m/s kg/kg] - real(r8) :: wpthvp_diag(pcols,pverp) ! CLUBB buoyancy flux [W/m^2] - real(r8) :: rvm(pcols,pverp) - real(r8) :: pdfp_rtp2(pcols, pverp) ! Calculated R-tot variance from pdf_params [kg^2/kg^2] - real(r8) :: rtp2_zt(pverp+1-top_lev) ! CLUBB R-tot variance on thermo levs - real(r8) :: rtp2_zt_out(pcols, pverp) ! CLUBB R-tot variance on thermo levs [kg^2/kg^2] - real(r8) :: thl2_zt(pverp+1-top_lev) ! CLUBB Theta-l variance on thermo levs [K^2] - real(r8) :: thl2_zt_out(pcols, pverp) ! CLUBB Theta-l variance on thermo levs - real(r8) :: wp2_zt(pverp+1-top_lev) ! CLUBB W variance on theromo levs [m^2/s^2] - real(r8) :: wp2_zt_out(pcols, pverp) - real(r8) :: dlf_liq_out(pcols, pverp) ! Detrained liquid water from ZM [kg/kg/s] - real(r8) :: dlf_ice_out(pcols, pverp) ! Detrained ice water from ZM [kg/kg/s] - real(r8) :: wm_zt_out(pcols, pverp) ! CLUBB mean W on thermo levs output [m/s] - real(r8) :: mean_rt ! Calculated R-tot mean from pdf_params (temp) [kg/kg] - real(r8) :: dlf2(pcols,pver) ! Detraining cld H20 from shallow convection [kg/kg/day] - real(r8) :: eps ! Rv/Rd [-] - real(r8) :: dum1 ! dummy variable [units vary] - real(r8) :: obklen(pcols) ! Obukov length [m] - real(r8) :: kbfs(pcols) ! Kinematic Surface heat flux [K m/s] - real(r8) :: th(pcols,pver) ! potential temperature [K] - real(r8) :: dummy2(pcols) ! dummy variable [units vary] - real(r8) :: dummy3(pcols) ! dummy variable [units vary] - real(r8) :: kinheat(pcols) ! Kinematic Surface heat flux [K m/s] - real(r8) :: rrho(pcols) ! Inverse of air density [1/kg/m^3] - real(r8) :: kinwat(pcols) ! Kinematic water vapor flux [m/s] - real(r8) :: latsub - real(r8) :: qrl_clubb(pverp+1-top_lev) - real(r8) :: qrl_zm(pverp+1-top_lev) - real(r8) :: thlp2_rad_out(pverp+1-top_lev) - real(r8) :: apply_const, rtm_test - - real(r8), dimension(nparams) :: clubb_params ! These adjustable CLUBB parameters (C1, C2 ...) - real(r8), dimension(sclr_dim) :: sclr_tol ! Tolerance on passive scalar [units vary] - - character(len=200) :: temp1, sub ! Strings needed for CLUBB output - real(kind=time_precision) :: time_elapsed ! time keep track of stats [s] - integer :: stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep] - - real(r8) :: rtm_integral_1, rtm_integral_update, rtm_integral_forcing, rtm_integral_vtend, rtm_integral_ltend + type(physics_state), intent(in) :: state ! Physics state variables [vary] + type(cam_in_t), intent(in) :: cam_in + real(r8), intent(in) :: hdtime ! Host model timestep [s] + real(r8), intent(in) :: dlf(pcols,pver) ! Detraining cld H20 from deep convection [kg/ks/s] + real(r8), intent(in) :: cmfmc(pcols,pverp) ! convective mass flux--m sub c [kg/m2/s] + integer, intent(in) :: cld_macmic_num_steps ! number of mac-mic iterations + integer, intent(in) :: macmic_it ! number of mac-mic iterations - ! --------------- ! - ! Pointers ! - ! --------------- ! - - real(r8), pointer, dimension(:,:) :: wp2 ! vertical velocity variance [m^2/s^2] - real(r8), pointer, dimension(:,:) :: wp3 ! third moment of vertical velocity [m^3/s^3] - real(r8), pointer, dimension(:,:) :: wpthlp ! turbulent flux of thetal [m/s K] - real(r8), pointer, dimension(:,:) :: wprtp ! turbulent flux of moisture [m/s kg/kg] - real(r8), pointer, dimension(:,:) :: rtpthlp ! covariance of thetal and qt [kg/kg K] - real(r8), pointer, dimension(:,:) :: rtp2 ! moisture variance [kg^2/kg^2] - real(r8), pointer, dimension(:,:) :: thlp2 ! temperature variance [K^2] - real(r8), pointer, dimension(:,:) :: rtp3 ! moisture 3rd order [kg^3/kg^3] - real(r8), pointer, dimension(:,:) :: thlp3 ! temperature 3rd order [K^3] - real(r8), pointer, dimension(:,:) :: up2 ! east-west wind variance [m^2/s^2] - real(r8), pointer, dimension(:,:) :: vp2 ! north-south wind variance [m^2/s^2] - real(r8), pointer, dimension(:,:) :: up3 ! east-west wind 3rd order [m^3/s^3] - real(r8), pointer, dimension(:,:) :: vp3 ! north-south wind 3rd order [m^3/s^3] - real(r8), pointer, dimension(:,:) :: upwp ! east-west momentum flux [m^2/s^2] - real(r8), pointer, dimension(:,:) :: vpwp ! north-south momentum flux [m^2/s^2] - real(r8), pointer, dimension(:,:) :: wpthvp ! w'th_v' (momentum levels) [m/s K] - real(r8), pointer, dimension(:,:) :: wp2thvp ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] - real(r8), pointer, dimension(:,:) :: rtpthvp ! r_t'th_v' (momentum levels) [kg/kg K] - real(r8), pointer, dimension(:,:) :: thlpthvp ! th_l'th_v' (momentum levels) [K^2] - real(r8), pointer, dimension(:,:) :: cloud_frac ! Cloud fraction (thermodynamic levels) [K^2] - real(r8), pointer, dimension(:,:) :: thlm ! mean temperature [K] - real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: rcm ! CLUBB cloud water mixing ratio [kg/kg] - real(r8), pointer, dimension(:) :: ztodtptr ! timestep to send to SILHS - real(r8), pointer, dimension(:,:) :: um ! mean east-west wind [m/s] - real(r8), pointer, dimension(:,:) :: vm ! mean north-south wind [m/s] - real(r8), pointer, dimension(:,:) :: cld ! cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: concld ! convective cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: ast ! stratiform cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: alst ! liquid stratiform cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: aist ! ice stratiform cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: qlst ! Physical in-stratus LWC [kg/kg] - real(r8), pointer, dimension(:,:) :: qist ! Physical in-stratus IWC [kg/kg] - real(r8), pointer, dimension(:,:) :: deepcu ! deep convection cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: shalcu ! shallow convection cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: khzm ! CLUBB's eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] - real(r8), pointer, dimension(:) :: pblh ! planetary boundary layer height [m] - real(r8), pointer, dimension(:,:) :: tke ! turbulent kinetic energy [m^2/s^2] - real(r8), pointer, dimension(:,:) :: dp_icwmr ! deep convection in cloud mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! Cloud fraction of ice clouds (pverp)[fraction] - real(r8), pointer, dimension(:,:) :: relvar ! relative cloud water variance [-] - real(r8), pointer, dimension(:,:) :: accre_enhan ! accretion enhancement factor [-] - real(r8), pointer, dimension(:,:) :: naai - real(r8), pointer, dimension(:,:) :: cmeliq - real(r8), pointer, dimension(:,:) :: cmfmc_sh ! Shallow convective mass flux--m subc (pcols,pverp) [kg/m2/s/] - - real(r8), pointer, dimension(:,:) :: qsatfac - real(r8), pointer, dimension(:,:) :: npccn - real(r8), pointer, dimension(:,:) :: prer_evap - real(r8), pointer, dimension(:,:) :: qrl - real(r8), pointer, dimension(:,:) :: radf_clubb - - ! SILHS covariance contributions - real(r8), pointer, dimension(:,:) :: rtp2_mc_zt - real(r8), pointer, dimension(:,:) :: thlp2_mc_zt - real(r8), pointer, dimension(:,:) :: wprtp_mc_zt - real(r8), pointer, dimension(:,:) :: wpthlp_mc_zt - real(r8), pointer, dimension(:,:) :: rtpthlp_mc_zt - - real(r8) qitend(pcols,pver) - real(r8) initend(pcols,pver) ! Needed for ice supersaturation adjustment calculation - - ! ZM microphysics - real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio. - real(r8), pointer :: difzm(:,:) ! ZM detrained convective cloud ice mixing ratio. - real(r8), pointer :: dnlfzm(:,:) ! ZM detrained convective cloud water num concen. - real(r8), pointer :: dnifzm(:,:) ! ZM detrained convective cloud ice num concen. - - real(r8) :: stend(pcols,pver) - real(r8) :: qvtend(pcols,pver) - real(r8) :: qctend(pcols,pver) - real(r8) :: inctend(pcols,pver) - real(r8) :: fqtend(pcols,pver) - real(r8) :: rhmini(pcols) - real(r8) :: rhmaxi(pcols) - integer :: troplev(pcols) - logical :: lqice(pcnst) - logical :: apply_to_surface - - ! MF outputs to outfld - real(r8), dimension(pcols,pverp) :: mf_dry_a_output, mf_moist_a_output, & - mf_dry_w_output, mf_moist_w_output, & - mf_dry_qt_output, mf_moist_qt_output, & - mf_dry_thl_output, mf_moist_thl_output, & - mf_dry_u_output, mf_moist_u_output, & - mf_dry_v_output, mf_moist_v_output, & - mf_moist_qc_output, & - s_ae_output, s_aw_output, & - s_awthl_output, s_awqt_output, & - s_awql_output, s_awqi_output, & - s_awu_output, s_awv_output, & - mf_thlflx_output, mf_qtflx_output - ! MF Plume - real(r8), dimension(pverp) :: mf_dry_a, mf_moist_a, & - mf_dry_w, mf_moist_w, & - mf_dry_qt, mf_moist_qt, & - mf_dry_thl, mf_moist_thl, & - mf_dry_u, mf_moist_u, & - mf_dry_v, mf_moist_v, & - mf_moist_qc, & - s_ae, s_aw, & - s_awthl, s_awqt, & - s_awql, s_awqi, & - s_awu, s_awv, & - mf_thlflx, mf_qtflx - ! MF local vars - real(r8), dimension(pverp) :: rtm_zm_in, thlm_zm_in, & ! momentum grid - dzt, invrs_dzt, & ! thermodynamic grid - invrs_exner_zt,& ! thermodynamic grid - kappa_zt, qc_zt, & ! thermodynamic grid - kappa_zm, p_in_Pa_zm, & ! momentum grid - invrs_exner_zm ! momentum grid - - real(r8) :: temp2d(pcols,pver), temp2dp(pcols,pverp) ! temporary array for holding scaled outputs - - - integer :: nlev - - intrinsic :: max - - character(len=*), parameter :: subr='clubb_tend_cam' + ! ---------------------------------------------------- ! + ! Input-Output Auguments ! + ! ---------------------------------------------------- ! -#endif - det_s(:) = 0.0_r8 - det_ice(:) = 0.0_r8 -#ifdef CLUBB_SGS + type(physics_buffer_desc), pointer :: pbuf(:) - !-----------------------------------------------------------------------------------------------! - !-----------------------------------------------------------------------------------------------! - !-----------------------------------------------------------------------------------------------! - ! MAIN COMPUTATION BEGINS HERE ! - !-----------------------------------------------------------------------------------------------! - !-----------------------------------------------------------------------------------------------! - !-----------------------------------------------------------------------------------------------! - - nlev = pver + 1 - top_lev - - rtp2_zt_out = 0._r8 - thl2_zt_out = 0._r8 - wp2_zt_out = 0._r8 - pdfp_rtp2 = 0._r8 - wm_zt_out = 0._r8 - - frac_limit = 0.01_r8 - ic_limit = 1.e-12_r8 - - if (clubb_do_adv) then - apply_const = 1._r8 ! Initialize to one, only if CLUBB's moments are advected - else - apply_const = 0._r8 ! Never want this if CLUBB's moments are not advected - endif - - ! Get indicees for cloud and ice mass and cloud and ice number - - call cnst_get_ind('Q',ixq) - call cnst_get_ind('CLDLIQ',ixcldliq) - call cnst_get_ind('CLDICE',ixcldice) - call cnst_get_ind('NUMLIQ',ixnumliq) - call cnst_get_ind('NUMICE',ixnumice) - - if (clubb_do_icesuper) then - call pbuf_get_field(pbuf, naai_idx, naai) - end if + ! ---------------------------------------------------- ! + ! Output Auguments ! + ! ---------------------------------------------------- ! - ! Initialize physics tendency arrays, copy the state to state1 array to use in this routine - call physics_ptend_init(ptend_all, state%psetcols, 'clubb') + type(physics_ptend), intent(out) :: ptend_all ! package tendencies - ! Copy the state to state1 array to use in this routine - call physics_state_copy(state, state1) + ! These two variables are needed for energy check + real(r8), intent(out) :: det_s(pcols) ! Integral of detrained static energy from ice + real(r8), intent(out) :: det_ice(pcols) ! Integral of detrained ice for energy check - ! constituents are all treated as wet mmr by clubb - call set_dry_to_wet(state1) - if (clubb_do_liqsupersat) then - call pbuf_get_field(pbuf, npccn_idx, npccn) - endif - - ! Determine number of columns and which chunk computation is to be performed on - - ncol = state%ncol - lchnk = state%lchnk - - ! Determine time step of physics buffer - itim_old = pbuf_old_tim_idx() - - ! Establish associations between pointers and physics buffer fields - - call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, wp3_idx, wp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, wpthlp_idx, wpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, wprtp_idx, wprtp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, rtpthlp_idx, rtpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, rtp2_idx, rtp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, thlp2_idx, thlp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, up2_idx, up2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, vp2_idx, vp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - - call pbuf_get_field(pbuf, rtp3_idx, rtp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, thlp3_idx, thlp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, up3_idx, up3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, vp3_idx, vp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - - call pbuf_get_field(pbuf, upwp_idx, upwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, vpwp_idx, vpwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, wpthvp_idx, wpthvp) - call pbuf_get_field(pbuf, wp2thvp_idx, wp2thvp) - call pbuf_get_field(pbuf, rtpthvp_idx, rtpthvp) - call pbuf_get_field(pbuf, thlpthvp_idx,thlpthvp) - call pbuf_get_field(pbuf, rcm_idx, rcm) - call pbuf_get_field(pbuf, cloud_frac_idx, cloud_frac) - call pbuf_get_field(pbuf, thlm_idx, thlm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, rtm_idx, rtm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, um_idx, um, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, vm_idx, vm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - - call pbuf_get_field(pbuf, tke_idx, tke) - call pbuf_get_field(pbuf, qrl_idx, qrl) - call pbuf_get_field(pbuf, radf_idx, radf_clubb) - - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, alst_idx, alst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, aist_idx, aist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, qlst_idx, qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, qist_idx, qist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - call pbuf_get_field(pbuf, qsatfac_idx, qsatfac) - - call pbuf_get_field(pbuf, prer_evap_idx, prer_evap) - call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan) - call pbuf_get_field(pbuf, cmeliq_idx, cmeliq) - call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac) - call pbuf_get_field(pbuf, ztodt_idx, ztodtptr) - call pbuf_get_field(pbuf, relvar_idx, relvar) - call pbuf_get_field(pbuf, dp_frac_idx, deepcu) - call pbuf_get_field(pbuf, sh_frac_idx, shalcu) - call pbuf_get_field(pbuf, kvh_idx, khzm) - call pbuf_get_field(pbuf, pblh_idx, pblh) - call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr) - call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh) - - ! SILHS covariance contributions - call pbuf_get_field(pbuf, rtp2_mc_zt_idx, rtp2_mc_zt) - call pbuf_get_field(pbuf, thlp2_mc_zt_idx, thlp2_mc_zt) - call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt) - call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt) - call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt) - - ! Initialize the apply_const variable (note special logic is due to eularian backstepping) - if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp(1:ncol,1:pver) == 0._r8))) then - apply_const = 0._r8 ! On first time through do not remove constant - ! from moments since it has not been added yet - endif - - ! Set the ztodt timestep in pbuf for SILHS - ztodtptr(:) = 1.0_r8*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) + ! ---------------------------------------------------- ! + ! Local Variables ! + ! ---------------------------------------------------- ! - end if + integer :: i !Must be delcared outside "CLUBB_SGS" ifdef for det_s and det_ice zero-ing loops - if (clubb_do_icesuper) then - - ! -------------------------------------- ! - ! Ice Saturation Adjustment Computation ! - ! -------------------------------------- ! - - lq2(:) = .FALSE. - lq2(1) = .TRUE. - lq2(ixcldice) = .TRUE. - lq2(ixnumice) = .TRUE. - - latsub = latvap + latice - - call physics_ptend_init(ptend_loc, state%psetcols, 'iceadj', ls=.true., lq=lq2 ) - - stend(:ncol,:)=0._r8 - qvtend(:ncol,:)=0._r8 - qitend(:ncol,:)=0._r8 - initend(:ncol,:)=0._r8 - - call ice_macro_tend(naai(:ncol,top_lev:pver),state1%t(:ncol,top_lev:pver), & - state1%pmid(:ncol,top_lev:pver),state1%q(:ncol,top_lev:pver,1),state1%q(:ncol,top_lev:pver,ixcldice),& - state1%q(:ncol,top_lev:pver,ixnumice),latsub,hdtime,& - stend(:ncol,top_lev:pver),qvtend(:ncol,top_lev:pver),qitend(:ncol,top_lev:pver),& - initend(:ncol,top_lev:pver)) - - ! update local copy of state with the tendencies - ptend_loc%q(:ncol,top_lev:pver,1)=qvtend(:ncol,top_lev:pver) - ptend_loc%q(:ncol,top_lev:pver,ixcldice)=qitend(:ncol,top_lev:pver) - ptend_loc%q(:ncol,top_lev:pver,ixnumice)=initend(:ncol,top_lev:pver) - ptend_loc%s(:ncol,top_lev:pver)=stend(:ncol,top_lev:pver) - - ! Add the ice tendency to the output tendency - call physics_ptend_sum(ptend_loc, ptend_all, ncol) - - ! ptend_loc is reset to zero by this call - call physics_update(state1, ptend_loc, hdtime) - - !Write output for tendencies: - temp2d(:ncol,:pver) = stend(:ncol,:pver)/cpairv(:ncol,:pver,lchnk) - call outfld( 'TTENDICE', temp2d, pcols, lchnk ) - call outfld( 'QVTENDICE', qvtend, pcols, lchnk ) - call outfld( 'QITENDICE', qitend, pcols, lchnk ) - call outfld( 'NITENDICE', initend, pcols, lchnk ) - - endif - - - ! Determine CLUBB time step and make it sub-step friendly - ! For now we want CLUBB time step to be 5 min since that is - ! what has been scientifically validated. However, there are certain - ! instances when a 5 min time step will not be possible (based on - ! host model time step or on macro-micro sub-stepping - - dtime = clubb_timestep - - ! Now check to see if dtime is greater than the host model - ! (or sub stepped) time step. If it is, then simply - ! set it equal to the host (or sub step) time step. - ! This section is mostly to deal with small host model - ! time steps (or small sub-steps) - - if (dtime > hdtime) then - dtime = hdtime - endif - - ! Now check to see if CLUBB time step divides evenly into - ! the host model time step. If not, force it to divide evenly. - ! We also want it to be 5 minutes or less. This section is - ! mainly for host model time steps that are not evenly divisible - ! by 5 minutes - - if (mod(hdtime,dtime) .ne. 0) then - dtime = hdtime/2._r8 - do while (dtime > clubb_timestep) - dtime = dtime/2._r8 - end do - endif - - ! If resulting host model time step and CLUBB time step do not divide evenly - ! into each other, have model throw a fit. - - if (mod(hdtime,dtime) .ne. 0) then - call endrun(subr//': CLUBB time step and HOST time step NOT compatible') - endif - - ! determine number of timesteps CLUBB core should be advanced, - ! host time step divided by CLUBB time step - nadv = max(hdtime/dtime,1._r8) - - ! Initialize forcings for transported scalars to zero - - sclrm_forcing(:,:) = 0._r8 - edsclrm_forcing(:,:) = 0._r8 - sclrm(:,:) = 0._r8 - - ! Compute inverse exner function consistent with CLUBB's definition, which uses a constant - ! surface pressure. CAM's exner (in state) does not. Therefore, for consistent - ! treatment with CLUBB code, anytime exner is needed to treat CLUBB variables - ! (such as thlm), use "inv_exner_clubb" otherwise use the exner in state - - do k=1,pver - do i=1,ncol - inv_exner_clubb(i,k) = 1._r8/((state1%pmid(i,k)/p0_clubb)**(rairv(i,k,lchnk)/cpairv(i,k,lchnk))) - enddo - enddo - - ! At each CLUBB call, initialize mean momentum and thermo CLUBB state - ! from the CAM state - - do k=1,pver ! loop over levels - do i=1,ncol ! loop over columns - - rtm(i,k) = state1%q(i,k,ixq)+state1%q(i,k,ixcldliq) - rvm(i,k) = state1%q(i,k,ixq) - um(i,k) = state1%u(i,k) - vm(i,k) = state1%v(i,k) - thlm(i,k) = ( state1%t(i,k) & - - (latvap/cpairv(i,k,lchnk))*state1%q(i,k,ixcldliq) ) & - * inv_exner_clubb(i,k) - - if (clubb_do_adv) then - if (macmic_it == 1) then - - ! Note that some of the moments below can be positive or negative. - ! Remove a constant that was added to prevent dynamics from clipping - ! them to prevent dynamics from making them positive. - thlp2(i,k) = state1%q(i,k,ixthlp2) - rtp2(i,k) = state1%q(i,k,ixrtp2) - rtpthlp(i,k) = state1%q(i,k,ixrtpthlp) - (rtpthlp_const*apply_const) - wpthlp(i,k) = state1%q(i,k,ixwpthlp) - (wpthlp_const*apply_const) - wprtp(i,k) = state1%q(i,k,ixwprtp) - (wprtp_const*apply_const) - wp2(i,k) = state1%q(i,k,ixwp2) - wp3(i,k) = state1%q(i,k,ixwp3) - (wp3_const*apply_const) - up2(i,k) = state1%q(i,k,ixup2) - vp2(i,k) = state1%q(i,k,ixvp2) - endif - endif +#ifdef CLUBB_SGS - enddo - enddo - - if (clubb_do_adv) then - ! If not last step of macmic loop then set apply_const back to - ! zero to prevent output from being corrupted. - if (macmic_it == cld_macmic_num_steps) then - apply_const = 1._r8 - else - apply_const = 0._r8 - endif - endif - - rtm(1:ncol,pverp) = rtm(1:ncol,pver) - um(1:ncol,pverp) = state1%u(1:ncol,pver) - vm(1:ncol,pverp) = state1%v(1:ncol,pver) - thlm(1:ncol,pverp) = thlm(1:ncol,pver) - - if (clubb_do_adv) then - thlp2(1:ncol,pverp)=thlp2(1:ncol,pver) - rtp2(1:ncol,pverp)=rtp2(1:ncol,pver) - rtpthlp(1:ncol,pverp)=rtpthlp(1:ncol,pver) - wpthlp(1:ncol,pverp)=wpthlp(1:ncol,pver) - wprtp(1:ncol,pverp)=wprtp(1:ncol,pver) - wp2(1:ncol,pverp)=wp2(1:ncol,pver) - wp3(1:ncol,pverp)=wp3(1:ncol,pver) - up2(1:ncol,pverp)=up2(1:ncol,pver) - vp2(1:ncol,pverp)=vp2(1:ncol,pver) - endif - - ! Compute virtual potential temperature, which is needed for CLUBB - do k=1,pver - do i=1,ncol - thv(i,k) = state1%t(i,k)*inv_exner_clubb(i,k)*(1._r8+zvir*state1%q(i,k,ixq)& - -state1%q(i,k,ixcldliq)) - enddo - enddo - - call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lu=.true., lv=.true., lq=lq) - - call tropopause_findChemTrop(state, troplev) - - ! Initialize EDMF outputs - mf_dry_a_output(:,:) = 0._r8 - mf_moist_a_output(:,:) = 0._r8 - mf_dry_w_output(:,:) = 0._r8 - mf_moist_w_output(:,:) = 0._r8 - mf_dry_qt_output(:,:) = 0._r8 - mf_moist_qt_output(:,:) = 0._r8 - mf_dry_thl_output(:,:) = 0._r8 - mf_moist_thl_output(:,:) = 0._r8 - mf_dry_u_output(:,:) = 0._r8 - mf_moist_u_output(:,:) = 0._r8 - mf_dry_v_output(:,:) = 0._r8 - mf_moist_v_output(:,:) = 0._r8 - mf_moist_qc_output(:,:) = 0._r8 - s_ae_output(:,:) = 0._r8 - s_aw_output(:,:) = 0._r8 - s_awthl_output(:,:) = 0._r8 - s_awqt_output(:,:) = 0._r8 - s_awql_output(:,:) = 0._r8 - s_awqi_output(:,:) = 0._r8 - s_awu_output(:,:) = 0._r8 - s_awv_output(:,:) = 0._r8 - mf_thlflx_output(:,:) = 0._r8 - mf_qtflx_output(:,:) = 0._r8 - - ! Loop over all columns in lchnk to advance CLUBB core - do i=1,ncol ! loop over columns - - ! Determine Coriolis force at given latitude. This is never used - ! when CLUBB is implemented in a host model, therefore just set - ! to zero. - fcor = 0._r8 - - ! Define the CLUBB momentum grid (in height, units of m) - do k=1,nlev+1 - zi_g(k) = state1%zi(i,pverp-k+1)-state1%zi(i,pver+1) - enddo - - ! Define the CLUBB thermodynamic grid (in units of m) - do k=1,nlev - zt_g(k+1) = state1%zm(i,pver-k+1)-state1%zi(i,pver+1) - end do + type(physics_state) :: state1 ! Local copy of state variable + type(physics_ptend) :: ptend_loc ! Local tendency from processes, added up to return as ptend_all + + integer :: j, k, t, ixind, nadv + integer :: ixcldice, ixcldliq, ixnumliq, ixnumice, ixq + integer :: itim_old + integer :: ncol, lchnk ! # of columns, and chunk identifier + integer :: err_code ! Diagnostic, for if some calculation goes amiss. + integer :: icnt + logical :: lq2(pcnst) + + integer :: iter + + integer :: clubbtop(pcols) + + real(r8) :: frac_limit, ic_limit + + real(r8) :: dtime ! CLUBB time step [s] + real(r8) :: zt_out(pcols,pverp) ! output for the thermo CLUBB grid [m] + real(r8) :: zi_out(pcols,pverp) ! output for momentum CLUBB grid [m] + real(r8) :: ubar ! surface wind [m/s] + real(r8) :: ustar ! surface stress [m/s] + real(r8) :: z0 ! roughness height [m] + real(r8) :: bflx22(pcols) ! Variable for buoyancy flux for pbl [K m/s] + real(r8) :: qclvar(pcols,pverp) ! cloud water variance [kg^2/kg^2] + real(r8) :: zo(pcols) ! roughness height [m] + real(r8) :: dz_g(pcols,pver) ! thickness of layer [m] + real(r8) :: relvarmax + real(r8) :: se_upper_a(pcols), se_upper_b(pcols), se_upper_diss(pcols) + real(r8) :: tw_upper_a(pcols), tw_upper_b(pcols), tw_upper_diss(pcols) + + ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api + ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES + real(r8), dimension(state%ncol) :: & + fcor, & ! Coriolis forcing [s^-1] + sfc_elevation, & ! Elevation of ground [m AMSL][m] + wpthlp_sfc, & ! w' theta_l' at surface [(m K)/s] + wprtp_sfc, & ! w' r_t' at surface [(kg m)/( kg s)] + upwp_sfc, & ! u'w' at surface [m^2/s^2] + vpwp_sfc, & ! v'w' at surface [m^2/s^2] + upwp_sfc_pert, & ! perturbed u'w' at surface [m^2/s^2] + vpwp_sfc_pert, & ! perturbed v'w' at surface [m^2/s^2] + grid_dx, grid_dy ! CAM grid [m] + + real(r8), dimension(state%ncol,sclr_dim) :: & + wpsclrp_sfc ! Scalar flux at surface [{units vary} m/s] + + real(r8), dimension(state%ncol,edsclr_dim) :: & + wpedsclrp_sfc ! Eddy-scalar flux at surface [{units vary} m/s] + + ! 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 + real(r8), dimension(state%ncol,nzm_clubb) :: & + thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s] + rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] + um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s] + vm_forcing, & ! v wind forcing (thermodynamic levels) [m/s/s] + wprtp_forcing, & + wpthlp_forcing, & + rtp2_forcing, & + thlp2_forcing, & + rtpthlp_forcing, & + wm_zm, & ! w mean wind component on momentum levels [m/s] + wm_zt, & ! w mean wind component on thermo. levels [m/s] + rtm_ref, & ! Initial profile of rtm [kg/kg] + thlm_ref, & ! Initial profile of thlm [K] + um_ref, & ! Initial profile of um [m/s] + vm_ref, & ! Initial profile of vm [m/s] + ug, & ! U geostrophic wind [m/s] + vg, & ! V geostrophic wind [m/s] + p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa] + rho_zm, & ! Air density on momentum levels [kg/m^3] + rho_zt, & ! Air density on thermo levels [kg/m^3] + exner, & ! Exner function (thermodynamic levels) [-] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] + invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] + thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] + thv_ds_zt, & ! Dry, base-state theta_v on thermo. levels [K] + rfrzm, & + radf, & + um_in, & ! meridional wind [m/s] + vm_in, & ! zonal wind [m/s] + upwp_in, & ! meridional wind flux [m^2/s^2] + vpwp_in, & ! zonal wind flux [m^2/s^2] + up2_in, & ! meridional wind variance [m^2/s^2] + vp2_in, & ! zonal wind variance [m^2/s^2] + up3_in, & ! meridional wind third-order [m^3/s^3] + vp3_in, & ! zonal wind third-order [m^3/s^3] + thlm_in, & ! liquid water potential temperature (thetal) [K] + rvm_in, & ! water vapor mixing ratio [kg/kg] + rtm_in, & ! total water mixing ratio [kg/kg] + wprtp_in, & ! turbulent flux of total water [kg/kg m/s] + wpthlp_in, & ! turbulent flux of thetal [K m/s] + wp2_in, & ! vertical velocity variance (CLUBB) [m^2/s^2] + wp3_in, & ! third moment vertical velocity [m^3/s^3] + rtp2_in, & ! total water variance [kg^2/kg^2] + rtp2_zt, & ! CLUBB R-tot variance on thermo levs + thl2_zt, & ! CLUBB Theta-l variance on thermo levs [K^2] + wp2_zt, & ! CLUBB W variance on theromo levs [m^2/s^2] + rtp3_in, & ! total water 3rd order [kg^3/kg^3] + thlp2_in, & ! thetal variance [K^2] + thlp3_in, & ! thetal 3rd order [K^3] + rtpthlp_in, & ! covariance of thetal and qt [kg/kg K] + rcm_inout, & ! CLUBB output of liquid water mixing ratio [kg/kg] + rcm_out_zm, & + cloud_frac_inout, & ! CLUBB output of cloud fraction [fraction] + wpthvp_in, & ! w'th_v' (momentum levels) [m/s K] + wp2thvp_in, & ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] + rtpthvp_in, & ! r_t'th_v' (momentum levels) [kg/kg K] + thlpthvp_in, & ! th_l'th_v' (momentum levels) [K^2] + ice_supersat_frac_inout, & + um_pert_inout, & ! Perturbed U wind [m/s] + vm_pert_inout, & ! Perturbed V wind [m/s] + upwp_pert_inout, & ! Perturbed u'w' [m^2/s^2] + vpwp_pert_inout, & ! Perturbed v'w' [m^2/s^2] + khzm_out, & ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] + khzt_out, & ! eddy diffusivity on thermo grids [m^2/s] + qclvar_out, & ! cloud water variance [kg^2/kg^2] + thlprcp_out, & + wprcp_out, & ! CLUBB output of flux of liquid water [kg/kg m/s] + w_up_in_cloud_out, & + w_down_in_cloud_out, & + cloudy_updraft_frac_out, & + cloudy_downdraft_frac_out,& + rcm_in_layer_out, & ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] + cloud_cover_out, & ! CLUBB output of in-cloud cloud fraction [fraction] + invrs_tau_zm_out, & ! CLUBB output of 1 divided by time-scale [1/s] + rtp2_mc_out, & ! total water tendency from rain evap + thlp2_mc_out, & ! thetal tendency from rain evap + wprtp_mc_out, & + wpthlp_mc_out, & + rtpthlp_mc_out, & + pre_in, & ! input for precip evaporation + qrl_clubb, & + qrl_zm, & + wp2rtp_inout, & ! w'^2 rt' (thermodynamic levels) + wp2thlp_inout, & ! w'^2 thl' (thermodynamic levels) + uprcp_inout, & ! < u' r_c' > (momentum levels) + vprcp_inout, & ! < v' r_c' > (momentum levels) + rc_coef_inout, & ! Coef. of X'r_c' in Eq. (34) (t-levs.) + wp4_inout, & ! w'^4 (momentum levels + wpup2_inout, & ! w'u'^2 (thermodynamic levels) + wpvp2_inout, & ! w'v'^2 (thermodynamic levels) + 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] + + ! 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 + real(r8), dimension(state%ncol,nzm_clubb,sclr_dim) :: & + sclrm_forcing, & ! Passive scalar forcing [{units vary}/s] + sclrm, & ! Passive scalar mean (thermo. levels) [units vary] + sclrp2, & ! sclr'^2 (momentum levels) [{units vary}^2] + sclrp3, & ! sclr'^3 (thermo. levels) [{units vary}^3] + sclrprtp, & ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] + sclrpthlp, & ! sclr'thlp' (momentum levels) [{units vary} (K)] + wpsclrp, & ! w'sclr' (momentum levels) [{units vary} m/s] + sclrpthvp_inout ! sclr'th_v' (momentum levels) [{units vary} (K)] + + real(r8), dimension(state%ncol,nzm_clubb,edsclr_dim) :: & + edsclrm_forcing, & ! Eddy passive scalar forcing [{units vary}/s] + edsclr_in ! Scalars to be diffused through CLUBB [units vary] + + ! 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 + real(r8), dimension(state%ncol,nzm_clubb,hydromet_dim) :: & + hydromet, & + wphydrometp, & + wp2hmp, & + rtphmp_zt, & + thlphmp_zt + + ! Variables below are needed to compute energy integrals for conservation + ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines + real(r8) :: te_a, se_a, ke_a, wv_a, wl_a + real(r8) :: te_b, se_b, ke_b, wv_b, wl_b + real(r8) :: se_dis(pcols), clubb_s(pcols,pver), eleak(pcols) + + real(r8) :: inv_exner_clubb(pcols,pverp) ! Inverse exner function consistent with CLUBB [-] + real(r8) :: inv_exner_clubb_surf(pcols) ! Inverse exner function at the surface + real(r8) :: wpthlp_output(pcols,pverp) ! Heat flux output variable [W/m2] + real(r8) :: wprtp_output(pcols,pverp) ! Total water flux output variable [W/m2] + real(r8) :: wp3_output(pcols,pverp) ! wp3 output [m^3/s^3] + real(r8) :: rtpthlp_output(pcols,pverp) ! rtpthlp ouptut [K kg/kg] + real(r8) :: qt_output(pcols,pver) ! Total water mixing ratio for output [kg/kg] + real(r8) :: thetal_output(pcols,pver) ! Liquid water potential temperature output [K] + real(r8) :: sl_output(pcols,pver) ! Liquid water static energy [J/kg] + real(r8) :: ustar2(pcols) ! Surface stress for PBL height [m2/s2] + real(r8) :: rho(pcols,pverp) ! Midpoint density in CAM [kg/m^3] + real(r8) :: thv(pcols,pverp) ! virtual potential temperature [K] + real(r8) :: edsclr_out(pcols,pverp,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] + real(r8) :: rcm_in_layer(pcols,pverp) ! CLUBB in-cloud liquid water mixing ratio [kg/kg] + real(r8) :: cloud_cover(pcols,pverp) ! CLUBB in-cloud cloud fraction [fraction] + real(r8) :: wprcp(pcols,pverp) ! CLUBB liquid water flux [m/s kg/kg] + real(r8) :: wpthvp_diag(pcols,pverp) ! CLUBB buoyancy flux [W/m^2] + real(r8) :: rvm(pcols,pverp) + real(r8) :: pdfp_rtp2(pcols, pverp) ! Calculated R-tot variance from pdf_params [kg^2/kg^2] + real(r8) :: rtp2_zt_out(pcols, pverp) ! CLUBB R-tot variance on thermo levs [kg^2/kg^2] + real(r8) :: thl2_zt_out(pcols, pverp) ! CLUBB Theta-l variance on thermo levs + real(r8) :: wp2_zt_out(pcols, pverp) + real(r8) :: dlf_liq_out(pcols, pverp) ! Detrained liquid water from ZM [kg/kg/s] + real(r8) :: dlf_ice_out(pcols, pverp) ! Detrained ice water from ZM [kg/kg/s] + real(r8) :: wm_zt_out(pcols, pverp) ! CLUBB mean W on thermo levs output [m/s] + real(r8) :: mean_rt ! Calculated R-tot mean from pdf_params (temp) [kg/kg] + real(r8) :: dlf2(pcols,pver) ! Detraining cld H20 from shallow convection [kg/kg/day] + real(r8) :: eps ! Rv/Rd [-] + real(r8) :: dum1 ! dummy variable [units vary] + real(r8) :: obklen(pcols) ! Obukov length [m] + real(r8) :: kbfs(pcols) ! Kinematic Surface heat flux [K m/s] + real(r8) :: th(pcols,pver) ! potential temperature [K] + real(r8) :: dummy2(pcols) ! dummy variable [units vary] + real(r8) :: dummy3(pcols) ! dummy variable [units vary] + real(r8) :: kinheat(pcols) ! Kinematic Surface heat flux [K m/s] + real(r8) :: rrho(pcols) ! Inverse of air density [1/kg/m^3] + real(r8) :: kinwat(pcols) ! Kinematic water vapor flux [m/s] + real(r8) :: latsub + real(r8) :: thlp2_rad_out(pcols,nzm_clubb) + real(r8) :: apply_const, rtm_test + real(r8) :: dl_rad, di_rad, dt_low + + character(len=200) :: temp1, sub ! Strings needed for CLUBB output + real(kind=time_precision) :: time_elapsed ! time keep track of stats [s] + integer :: stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep] + + real(r8) :: rtm_integral_vtend(pcols), & + rtm_integral_ltend(pcols) + + + real(r8) :: rtm_integral_1, rtm_integral_update, rtm_integral_forcing + + ! ---------------------------------------------------- ! + ! Pointers ! + ! ---------------------------------------------------- ! + + real(r8), pointer, dimension(:,:) :: wp2 ! vertical velocity variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: wp3 ! third moment of vertical velocity [m^3/s^3] + real(r8), pointer, dimension(:,:) :: wpthlp ! turbulent flux of thetal [m/s K] + real(r8), pointer, dimension(:,:) :: wprtp ! turbulent flux of moisture [m/s kg/kg] + real(r8), pointer, dimension(:,:) :: rtpthlp ! covariance of thetal and qt [kg/kg K] + real(r8), pointer, dimension(:,:) :: rtp2 ! moisture variance [kg^2/kg^2] + real(r8), pointer, dimension(:,:) :: thlp2 ! temperature variance [K^2] + real(r8), pointer, dimension(:,:) :: rtp3 ! moisture 3rd order [kg^3/kg^3] + real(r8), pointer, dimension(:,:) :: thlp3 ! temperature 3rd order [K^3] + real(r8), pointer, dimension(:,:) :: up2 ! east-west wind variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: vp2 ! north-south wind variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: up3 ! east-west wind 3rd order [m^3/s^3] + real(r8), pointer, dimension(:,:) :: vp3 ! north-south wind 3rd order [m^3/s^3] + real(r8), pointer, dimension(:,:) :: upwp ! east-west momentum flux [m^2/s^2] + real(r8), pointer, dimension(:,:) :: vpwp ! north-south momentum flux [m^2/s^2] + real(r8), pointer, dimension(:,:) :: wpthvp ! w'th_v' (momentum levels) [m/s K] + real(r8), pointer, dimension(:,:) :: wp2thvp ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] + real(r8), pointer, dimension(:,:) :: rtpthvp ! r_t'th_v' (momentum levels) [kg/kg K] + real(r8), pointer, dimension(:,:) :: thlpthvp ! th_l'th_v' (momentum levels) [K^2] + real(r8), pointer, dimension(:,:) :: cloud_frac ! Cloud fraction (thermodynamic levels) [K^2] + real(r8), pointer, dimension(:,:) :: pdf_zm_w_1 !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_w_2 !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_1 !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_2 !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_mixt_frac !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: wp2rtp ! w'^2 rt' (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wp2thlp ! w'^2 thl' (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: uprcp ! < u' r_c' > (momentum levels) + real(r8), pointer, dimension(:,:) :: vprcp ! < v' r_c' > (momentum levels) + real(r8), pointer, dimension(:,:) :: rc_coef ! Coef. of X'r_c' in Eq. (34) (t-levs.) + real(r8), pointer, dimension(:,:) :: wp4 ! w'^4 (momentum levels + real(r8), pointer, dimension(:,:) :: wpup2 ! w'u'^2 (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wpvp2 ! w'v'^2 (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wp2up2 ! w'^2 u'^2 (momentum levels) + real(r8), pointer, dimension(:,:) :: wp2vp2 ! w'^2 v'^2 (momentum levels) + real(r8), pointer, dimension(:,:) :: thlm ! mean temperature [K] + real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio [kg/kg] + real(r8), pointer, dimension(:,:) :: rcm ! CLUBB cloud water mixing ratio [kg/kg] + real(r8), pointer, dimension(:) :: ztodtptr ! timestep to send to SILHS + real(r8), pointer, dimension(:,:) :: um ! mean east-west wind [m/s] + real(r8), pointer, dimension(:,:) :: vm ! mean north-south wind [m/s] + real(r8), pointer, dimension(:,:) :: cld ! cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: concld ! convective cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: ast ! stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: alst ! liquid stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: aist ! ice stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: qlst ! Physical in-stratus LWC [kg/kg] + real(r8), pointer, dimension(:,:) :: qist ! Physical in-stratus IWC [kg/kg] + real(r8), pointer, dimension(:,:) :: deepcu ! deep convection cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: shalcu ! shallow convection cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: khzm ! CLUBB's eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] + real(r8), pointer, dimension(:) :: pblh ! planetary boundary layer height [m] + real(r8), pointer, dimension(:,:) :: tke ! turbulent kinetic energy [m^2/s^2] + real(r8), pointer, dimension(:,:) :: dp_icwmr ! deep convection in cloud mixing ratio [kg/kg] + real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! Cloud fraction of ice clouds (pverp)[fraction] + real(r8), pointer, dimension(:,:) :: relvar ! relative cloud water variance [-] + real(r8), pointer, dimension(:,:) :: accre_enhan ! accretion enhancement factor [-] + real(r8), pointer, dimension(:,:) :: naai + real(r8), pointer, dimension(:,:) :: cmeliq + real(r8), pointer, dimension(:,:) :: cmfmc_sh ! Shallow convective mass flux--m subc (pcols,pverp) [kg/m2/s/] + + real(r8), pointer, dimension(:,:) :: qsatfac + real(r8), pointer, dimension(:,:) :: npccn + real(r8), pointer, dimension(:,:) :: prer_evap + real(r8), pointer, dimension(:,:) :: qrl + real(r8), pointer, dimension(:,:) :: radf_clubb + + ! SILHS covariance contributions + real(r8), pointer, dimension(:,:) :: rtp2_mc_zt + real(r8), pointer, dimension(:,:) :: thlp2_mc_zt + real(r8), pointer, dimension(:,:) :: wprtp_mc_zt + 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 + + ! ZM microphysics + real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio. + real(r8), pointer :: dnlfzm(:,:) ! ZM detrained convective cloud water num concen. + real(r8), pointer :: dnifzm(:,:) ! ZM detrained convective cloud ice num concen. + + real(r8) :: stend(pcols,pver) + real(r8) :: qvtend(pcols,pver) + real(r8) :: qctend(pcols,pver) + real(r8) :: inctend(pcols,pver) + real(r8) :: fqtend(pcols,pver) + real(r8) :: rhmini(pcols) + real(r8) :: rhmaxi(pcols) + integer :: troplev(pcols) + logical :: lqice(pcnst) + logical :: apply_to_surface(pcols) + + ! MF outputs to outfld + ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines + real(r8), dimension(pcols,pverp) :: mf_dry_a_output, mf_moist_a_output, & + mf_dry_w_output, mf_moist_w_output, & + mf_dry_qt_output, mf_moist_qt_output, & + mf_dry_thl_output, mf_moist_thl_output, & + mf_dry_u_output, mf_moist_u_output, & + mf_dry_v_output, mf_moist_v_output, & + mf_moist_qc_output, & + s_ae_output, s_aw_output, & + s_awthl_output, s_awqt_output, & + s_awql_output, s_awqi_output, & + s_awu_output, s_awv_output, & + mf_thlflx_output, mf_qtflx_output + ! MF Plume + ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines + real(r8), dimension(pcols,pverp) :: mf_dry_a, mf_moist_a, & + mf_dry_w, mf_moist_w, & + mf_dry_qt, mf_moist_qt, & + mf_dry_thl, mf_moist_thl, & + mf_dry_u, mf_moist_u, & + mf_dry_v, mf_moist_v, & + mf_moist_qc, & + s_ae, s_aw, & + s_awthl, s_awqt, & + s_awql, s_awqi, & + s_awu, s_awv, & + mf_thlflx, mf_qtflx + + real(r8) :: inv_rh2o ! To reduce the number of divisions in clubb_tend + + ! MF local vars + real(r8), dimension(pcols,pverp) :: rtm_zm_in, thlm_zm_in, & ! momentum grid + dzt, invrs_dzt, & ! thermodynamic grid + invrs_exner_zt,& ! thermodynamic grid + kappa_zt, qc_zt, & ! thermodynamic grid + kappa_zm, p_in_Pa_zm, & ! momentum grid + invrs_exner_zm ! momentum grid + + real(r8) :: temp2d(pcols,pver), temp2dp(pcols,pverp) ! temporary array for holding scaled outputs + + real(r8), dimension(pcols,pver) :: & + rvmtend_clubb, & + rcmtend_clubb, & + rimtend_clubb, & + stend_clubb, & + utend_clubb, & + vtend_clubb, & + dpdlfliq, & + dpdlfice, & + dpdlft, & + detnliquid + + real(r8), dimension(pcols,pverp) :: & + wprcp_clubb, & + wpthvp_clubb + + intrinsic :: max + + character(len=*), parameter :: subr='clubb_tend_cam' + real(r8), parameter :: rad2deg=180.0_r8/pi + real(r8) :: tmp_lon1, tmp_lonN + + type(grid) :: gr + + 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 ...) + + integer :: & + sclr, & + edsclr, & + n - do k=1,pver - dz_g(k) = state1%zi(i,k)-state1%zi(i,k+1) ! compute thickness - enddo - - ! Thermodynamic ghost point is below surface - zt_g(1) = -1._r8*zt_g(2) +#endif - ! Set the elevation of the surface - sfc_elevation = state1%zi(i,pver+1) - - ! Set the grid size - host_dx = grid_dx(i) - host_dy = grid_dy(i) - - ! Compute thermodynamic stuff needed for CLUBB on thermo levels. - ! Inputs for the momentum levels are set below setup_clubb core - do k=1,nlev - p_in_Pa(k+1) = state1%pmid(i,pver-k+1) ! Pressure profile - exner(k+1) = 1._r8/inv_exner_clubb(i,pver-k+1) - rho_ds_zt(k+1) = (1._r8/gravit)*(state1%pdel(i,pver-k+1)/dz_g(pver-k+1)) - invrs_rho_ds_zt(k+1) = 1._r8/(rho_ds_zt(k+1)) ! Inverse ds rho at thermo - rho_in(k+1) = rho_ds_zt(k+1) ! rho on thermo - thv_ds_zt(k+1) = thv(i,pver-k+1) ! thetav on thermo - rfrzm(k+1) = state1%q(i,pver-k+1,ixcldice) - radf(k+1) = radf_clubb(i,pver-k+1) - qrl_clubb(k+1) = qrl(i,pver-k+1)/(cpairv(i,k,lchnk)*state1%pdel(i,pver-k+1)) - enddo + call t_startf('clubb_tend_cam') - ! Below computes the same stuff for the ghost point. May or may - ! not be needed, just to be safe to avoid NaN's - rho_ds_zt(1) = rho_ds_zt(2) - invrs_rho_ds_zt(1) = invrs_rho_ds_zt(2) - rho_in(1) = rho_ds_zt(2) - thv_ds_zt(1) = thv_ds_zt(2) - rho_zt(:) = rho_in(:) - p_in_Pa(1) = p_in_Pa(2) - exner(1) = exner(2) - rfrzm(1) = rfrzm(2) - radf(1) = radf(2) - qrl_clubb(1) = qrl_clubb(2) - - ! Compute mean w wind on thermo grid, convert from omega to w - wm_zt(1) = 0._r8 - do k=1,nlev - wm_zt(k+1) = -1._r8*state1%omega(i,pver-k+1)/(rho_in(k+1)*gravit) - enddo - - ! ------------------------------------------------- ! - ! Begin case specific code for SCAM cases. ! - ! This section of code block NOT called in ! - ! global simulations ! - ! ------------------------------------------------- ! + do i = 1, pcols + det_s(i) = 0.0_r8 + det_ice(i) = 0.0_r8 + end do - if (single_column) then +#ifdef CLUBB_SGS - ! Initialize zo if variable ustar is used +#ifdef _OPENACC + ! These options have not been GPUized + if ( do_clubb_mf ) call endrun(subr//': do_clubb_mf=.true. not available when compiling with OpenACC') + if ( do_rainturb ) call endrun(subr//': do_rainturb=.true. not available when compiling with OpenACC') + if ( do_cldcool ) call endrun(subr//': do_cldcool=.true. not available when compiling with OpenACC') + if ( clubb_do_icesuper ) call endrun(subr//': clubb_do_icesuper=.true. not available when compiling with OpenACC') + if ( single_column .and. .not. scm_cambfb_mode ) then + call endrun(subr//': (single_column && !scm_cambfb_mode)=.true. not available when compiling with OpenACC') + end if +#endif - if (cam_in%landfrac(i) >= 0.5_r8) then - zo = 0.035_r8 - else - zo = 0.0001_r8 - endif + !-----------------------------------------------------------------------------------! + ! MAIN COMPUTATION BEGINS HERE ! + !-----------------------------------------------------------------------------------! - ! Compute surface wind (ubar) - ubar = sqrt(um(i,pver)**2+vm(i,pver)**2) - if (ubar < 0.25_r8) ubar = 0.25_r8 - - ! Below denotes case specifics for surface momentum - ! and thermodynamic fluxes, depending on the case - - ! Define ustar (based on case, if not variable) - ustar = 0.25_r8 ! Initialize ustar in case no case - - if(trim(scm_clubb_iop_name) == 'BOMEX_5day') then - ustar = 0.28_r8 - endif - - if(trim(scm_clubb_iop_name) == 'ATEX_48hr') then - ustar = 0.30_r8 - endif - - if(trim(scm_clubb_iop_name) == 'RICO_3day') then - ustar = 0.28_r8 - endif + call t_startf('clubb_tend_cam:NAR') - if(trim(scm_clubb_iop_name) == 'arm97' .or. trim(scm_clubb_iop_name) == 'gate' .or. & - trim(scm_clubb_iop_name) == 'toga' .or. trim(scm_clubb_iop_name) == 'mpace' .or. & - trim(scm_clubb_iop_name) == 'ARM_CC') then - - bflx22 = (gravit/theta0)*wpthlp_sfc - ustar = diag_ustar(zt_g(2),bflx22,ubar,zo) - endif - - ! Compute the surface momentum fluxes, if this is a SCAM simulation - upwp_sfc = -um(i,pver)*ustar**2/ubar - vpwp_sfc = -vm(i,pver)*ustar**2/ubar - - endif + ! Get indicees for cloud and ice mass and cloud and ice number + call cnst_get_ind('Q',ixq) + call cnst_get_ind('CLDLIQ',ixcldliq) + call cnst_get_ind('CLDICE',ixcldice) + call cnst_get_ind('NUMLIQ',ixnumliq) + call cnst_get_ind('NUMICE',ixnumice) - ! Define surface sources for transported variables for diffusion, will - ! be zero as these tendencies are done in vertical_diffusion - do ixind=1,edsclr_dim - wpedsclrp_sfc(ixind) = 0._r8 - enddo - - ! Set stats output and increment equal to CLUBB and host dt - stats_tsamp = dtime - stats_tout = hdtime - - ! Heights need to be set at each timestep. Therefore, recall - ! setup_grid and setup_parameters for this. - - ! Read in parameters for CLUBB. Just read in default values - call read_parameters_api( -99, "", clubb_params ) - - ! 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 - ! call to setup_grid_heights_api. - call setup_grid_heights_api(l_implemented, grid_type, zi_g(2), & - zi_g(1), zi_g, zt_g) - - call setup_parameters_api( zi_g(2), clubb_params, nlev+1, grid_type, & - zi_g, zt_g, & - clubb_config_flags%l_prescribed_avg_deltaz, & - err_code ) - - ! Define forcings from CAM to CLUBB as zero for momentum and thermo, - ! forcings already applied through CAM - thlm_forcing = 0._r8 - rtm_forcing = 0._r8 - um_forcing = 0._r8 - vm_forcing = 0._r8 - - wprtp_forcing = 0._r8 - wpthlp_forcing = 0._r8 - rtp2_forcing = 0._r8 - thlp2_forcing = 0._r8 - rtpthlp_forcing = 0._r8 - - ice_supersat_frac_out = 0._r8 - - ! Add forcings for SILHS covariance contributions - rtp2_forcing = rtp2_forcing + zt2zm_api( rtp2_mc_zt(i,:) ) - thlp2_forcing = thlp2_forcing + zt2zm_api( thlp2_mc_zt(i,:) ) - wprtp_forcing = wprtp_forcing + zt2zm_api( wprtp_mc_zt(i,:) ) - wpthlp_forcing = wpthlp_forcing + zt2zm_api( wpthlp_mc_zt(i,:) ) - rtpthlp_forcing = rtpthlp_forcing + zt2zm_api( rtpthlp_mc_zt(i,:) ) - - ! Zero out SILHS covariance contribution terms - rtp2_mc_zt(i,:) = 0.0_r8 - thlp2_mc_zt(i,:) = 0.0_r8 - wprtp_mc_zt(i,:) = 0.0_r8 - wpthlp_mc_zt(i,:) = 0.0_r8 - rtpthlp_mc_zt(i,:) = 0.0_r8 - - ! Compute some inputs from the thermodynamic grid - ! to the momentum grid - rho_ds_zm = zt2zm_api(rho_ds_zt) - rho_zm = zt2zm_api(rho_zt) - invrs_rho_ds_zm = zt2zm_api(invrs_rho_ds_zt) - thv_ds_zm = zt2zm_api(thv_ds_zt) - wm_zm = zt2zm_api(wm_zt) - - ! Surface fluxes provided by host model - wpthlp_sfc = cam_in%shf(i)/(cpair*rho_ds_zm(1)) ! Sensible heat flux - wprtp_sfc = cam_in%cflx(i,1)/rho_ds_zm(1) ! Moisture flux (check rho) - upwp_sfc = cam_in%wsx(i)/rho_ds_zm(1) ! Surface meridional momentum flux - vpwp_sfc = cam_in%wsy(i)/rho_ds_zm(1) ! Surface zonal momentum flux - - ! Need to flip arrays around for CLUBB core - do k=1,nlev+1 - um_in(k) = um(i,pverp-k+1) - vm_in(k) = vm(i,pverp-k+1) - upwp_in(k) = upwp(i,pverp-k+1) - vpwp_in(k) = vpwp(i,pverp-k+1) - wpthvp_in(k) = wpthvp(i,pverp-k+1) - wp2thvp_in(k) = wp2thvp(i,pverp-k+1) - rtpthvp_in(k) = rtpthvp(i,pverp-k+1) - thlpthvp_in(k)= thlpthvp(i,pverp-k+1) - up2_in(k) = up2(i,pverp-k+1) - vp2_in(k) = vp2(i,pverp-k+1) - up3_in(k) = up3(i,pverp-k+1) - vp3_in(k) = vp3(i,pverp-k+1) - wp2_in(k) = wp2(i,pverp-k+1) - wp3_in(k) = wp3(i,pverp-k+1) - rtp2_in(k) = rtp2(i,pverp-k+1) - thlp2_in(k) = thlp2(i,pverp-k+1) - rtp3_in(k) = rtp3(i,pverp-k+1) - thlp3_in(k) = thlp3(i,pverp-k+1) - thlm_in(k) = thlm(i,pverp-k+1) - rtm_in(k) = rtm(i,pverp-k+1) - rvm_in(k) = rvm(i,pverp-k+1) - wprtp_in(k) = wprtp(i,pverp-k+1) - wpthlp_in(k) = wpthlp(i,pverp-k+1) - rtpthlp_in(k) = rtpthlp(i,pverp-k+1) - rcm_inout(k) = rcm(i,pverp-k+1) - cloud_frac_inout(k) = cloud_frac(i,pverp-k+1) - sclrpthvp_inout(k,:) = 0._r8 - - if (k .ne. 1) then - pre_in(k) = prer_evap(i,pverp-k+1) - endif + ! Determine time step of physics buffer + itim_old = pbuf_old_tim_idx() + + ! Establish associations between pointers and physics buffer fields + call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, wp3_idx, wp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, wpthlp_idx, wpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, wprtp_idx, wprtp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, rtpthlp_idx, rtpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, rtp2_idx, rtp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, thlp2_idx, thlp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, up2_idx, up2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, vp2_idx, vp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + + call pbuf_get_field(pbuf, rtp3_idx, rtp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, thlp3_idx, thlp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, up3_idx, up3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, vp3_idx, vp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + + call pbuf_get_field(pbuf, upwp_idx, upwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, vpwp_idx, vpwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, wpthvp_idx, wpthvp) + call pbuf_get_field(pbuf, wp2thvp_idx, wp2thvp) + call pbuf_get_field(pbuf, rtpthvp_idx, rtpthvp) + call pbuf_get_field(pbuf, thlpthvp_idx,thlpthvp) + call pbuf_get_field(pbuf, rcm_idx, rcm) + call pbuf_get_field(pbuf, cloud_frac_idx, cloud_frac) + + call pbuf_get_field(pbuf, pdf_zm_w_1_idx, pdf_zm_w_1, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, pdf_zm_w_2_idx, pdf_zm_w_2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, pdf_zm_varnce_w_1_idx, pdf_zm_varnce_w_1, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, pdf_zm_varnce_w_2_idx, pdf_zm_varnce_w_2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, pdf_zm_mixt_frac_idx, pdf_zm_mixt_frac, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + + call pbuf_get_field(pbuf, wp2rtp_idx, wp2rtp) + call pbuf_get_field(pbuf, wp2thlp_idx, wp2thlp) + call pbuf_get_field(pbuf, uprcp_idx, uprcp) + call pbuf_get_field(pbuf, vprcp_idx, vprcp) + call pbuf_get_field(pbuf, rc_coef_idx, rc_coef) + call pbuf_get_field(pbuf, wp4_idx, wp4) + call pbuf_get_field(pbuf, wpup2_idx, wpup2) + call pbuf_get_field(pbuf, wpvp2_idx, wpvp2) + call pbuf_get_field(pbuf, wp2up2_idx, wp2up2) + call pbuf_get_field(pbuf, wp2vp2_idx, wp2vp2) + call pbuf_get_field(pbuf, thlm_idx, thlm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, rtm_idx, rtm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, um_idx, um, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, vm_idx, vm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + + call pbuf_get_field(pbuf, tke_idx, tke) + call pbuf_get_field(pbuf, qrl_idx, qrl) + call pbuf_get_field(pbuf, radf_idx, radf_clubb) + + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, alst_idx, alst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, aist_idx, aist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, qlst_idx, qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, qist_idx, qist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + call pbuf_get_field(pbuf, qsatfac_idx, qsatfac) + + call pbuf_get_field(pbuf, prer_evap_idx, prer_evap) + call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan) + call pbuf_get_field(pbuf, cmeliq_idx, cmeliq) + call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac) + call pbuf_get_field(pbuf, ztodt_idx, ztodtptr) + call pbuf_get_field(pbuf, relvar_idx, relvar) + call pbuf_get_field(pbuf, dp_frac_idx, deepcu) + call pbuf_get_field(pbuf, sh_frac_idx, shalcu) + call pbuf_get_field(pbuf, kvh_idx, khzm) + call pbuf_get_field(pbuf, pblh_idx, pblh) + call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr) + call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh) + + ! SILHS covariance contributions + call pbuf_get_field(pbuf, rtp2_mc_zt_idx, rtp2_mc_zt) + call pbuf_get_field(pbuf, thlp2_mc_zt_idx, thlp2_mc_zt) + call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt) + 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 ) + + if (clubb_do_icesuper) then + call pbuf_get_field(pbuf, naai_idx, naai) + end if - ! Initialize these to prevent crashing behavior - wprcp_out(k) = 0._r8 - rcm_in_layer_out(k) = 0._r8 - cloud_cover_out(k) = 0._r8 - edsclr_in(k,:) = 0._r8 - khzm_out(k) = 0._r8 - khzt_out(k) = 0._r8 - - ! higher order scalar stuff, put to zero - sclrm(k,:) = 0._r8 - wpsclrp(k,:) = 0._r8 - sclrp2(k,:) = 0._r8 - sclrp3(k,:) = 0._r8 - sclrprtp(k,:) = 0._r8 - sclrpthlp(k,:) = 0._r8 - wpsclrp_sfc(:) = 0._r8 - hydromet(k,:) = 0._r8 - wphydrometp(k,:) = 0._r8 - wp2hmp(k,:) = 0._r8 - rtphmp_zt(k,:) = 0._r8 - thlphmp_zt(k,:) = 0._r8 - - enddo - pre_in(1) = pre_in(2) + ! Initialize physics tendency arrays + call physics_ptend_init(ptend_all, state%psetcols, 'clubb') - ! pressure,exner on momentum grid needed for mass flux calc. - if (do_clubb_mf) then - do k=1,pver - kappa_zt(k+1) = (rairv(i,pver-k+1,lchnk)/cpairv(i,pver-k+1,lchnk)) - qc_zt(k+1) = state1%q(i,pver-k+1,ixcldliq) - invrs_exner_zt(k+1) = inv_exner_clubb(i,pver-k+1) - enddo - kappa_zt(1) = kappa_zt(2) - qc_zt(1) = qc_zt(2) - invrs_exner_zt(1) = invrs_exner_zt(2) - - kappa_zm = zt2zm_api(kappa_zt) - do k=1,pverp - p_in_Pa_zm(k) = state1%pint(i,pverp-k+1) - invrs_exner_zm(k) = 1._r8/((p_in_Pa_zm(k)/p0_clubb)**(kappa_zm(k))) - enddo - end if - - if (clubb_do_adv) then - if (macmic_it == 1) then - wp2_in=zt2zm_api(wp2_in) - wpthlp_in=zt2zm_api(wpthlp_in) - wprtp_in=zt2zm_api(wprtp_in) - up2_in=zt2zm_api(up2_in) - vp2_in=zt2zm_api(vp2_in) - thlp2_in=zt2zm_api(thlp2_in) - rtp2_in=zt2zm_api(rtp2_in) - rtpthlp_in=zt2zm_api(rtpthlp_in) - - do k=1,nlev+1 - thlp2_in(k)=max(thl_tol**2,thlp2_in(k)) - rtp2_in(k)=max(rt_tol**2,rtp2_in(k)) - wp2_in(k)=max(w_tol_sqd,wp2_in(k)) - up2_in(k)=max(w_tol_sqd,up2_in(k)) - vp2_in(k)=max(w_tol_sqd,vp2_in(k)) - enddo - endif - endif + ! Copy the state to state1 array to use in this routine + call physics_state_copy(state, state1) - ! Do the same for tracers - icnt=0 - do ixind=1,pcnst - if (lq(ixind)) then - icnt=icnt+1 - do k=1,nlev - edsclr_in(k+1,icnt) = state1%q(i,pver-k+1,ixind) - enddo - edsclr_in(1,icnt) = edsclr_in(2,icnt) - end if - enddo - - if (do_expldiff) then - do k=1,nlev - edsclr_in(k+1,icnt+1) = thlm(i,pver-k+1) - edsclr_in(k+1,icnt+2) = rtm(i,pver-k+1) - enddo - - edsclr_in(1,icnt+1) = edsclr_in(2,icnt+1) - edsclr_in(1,icnt+2) = edsclr_in(2,icnt+2) - endif - - stats_nsamp = nint(stats_tsamp/dtime) - stats_nout = nint(stats_tout/dtime) - - do t=1,nadv ! do needed number of "sub" timesteps for each CAM step - - ! Increment the statistics then being stats timestep - if (l_stats) then - call stats_begin_timestep_api(t, stats_nsamp, stats_nout) - endif + ! Constituents are all treated as dry mmr by clubb. Convert the water species to + ! a dry basis. + call set_wet_to_dry(state1, convert_cnst_type='wet') - !####################################################################### - !###################### CALL MF DIAGNOSTIC PLUMES ###################### - !####################################################################### - if (do_clubb_mf) then - - do k=2,pverp - dzt(k) = zi_g(k) - zi_g(k-1) - enddo - dzt(1) = dzt(2) - invrs_dzt = 1._r8/dzt - - rtm_zm_in = zt2zm_api( rtm_in ) - thlm_zm_in = zt2zm_api( thlm_in ) - - call integrate_mf( pverp, dzt, zi_g, p_in_Pa_zm, invrs_exner_zm, & ! input - p_in_Pa, invrs_exner_zt, & ! input - um_in, vm_in, thlm_in, rtm_in, thv_ds_zt, & ! input - thlm_zm_in, rtm_zm_in, & ! input - wpthlp_sfc, wprtp_sfc, pblh(i), & ! input - mf_dry_a, mf_moist_a, & ! output - plume diagnostics - mf_dry_w, mf_moist_w, & ! output - plume diagnostics - mf_dry_qt, mf_moist_qt, & ! output - plume diagnostics - mf_dry_thl,mf_moist_thl, & ! output - plume diagnostics - mf_dry_u, mf_moist_u, & ! output - plume diagnostics - mf_dry_v, mf_moist_v, & ! output - plume diagnostics - mf_moist_qc, & ! output - plume diagnostics - s_ae, s_aw, & ! output - plume diagnostics - s_awthl, s_awqt, & ! output - plume diagnostics - s_awql, s_awqi, & ! output - plume diagnostics - s_awu, s_awv, & ! output - plume diagnostics - mf_thlflx, mf_qtflx ) ! output - variables needed for solver - - ! pass MF turbulent advection term as CLUBB explicit forcing term - rtm_forcing(1) = 0._r8 - thlm_forcing(1)= 0._r8 - do k=2,pverp - rtm_forcing(k) = rtm_forcing(k) - invrs_rho_ds_zt(k) * invrs_dzt(k) * & - ((rho_ds_zm(k) * mf_qtflx(k)) - (rho_ds_zm(k-1) * mf_qtflx(k-1))) - - thlm_forcing(k) = thlm_forcing(k) - invrs_rho_ds_zt(k) * invrs_dzt(k) * & - ((rho_ds_zm(k) * mf_thlflx(k)) - (rho_ds_zm(k-1) * mf_thlflx(k-1))) - end do + if (clubb_do_liqsupersat) then + call pbuf_get_field(pbuf, npccn_idx, npccn) + endif - end if + ! 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 + call grid_size(state1, grid_dx, grid_dy) - ! Advance CLUBB CORE one timestep in the future - call advance_clubb_core_api & - ( l_implemented, dtime, fcor, sfc_elevation, hydromet_dim, & - thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & - sclrm_forcing, edsclrm_forcing, wprtp_forcing, & - wpthlp_forcing, rtp2_forcing, thlp2_forcing, & - rtpthlp_forcing, wm_zm, wm_zt, & - wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & - wpsclrp_sfc, wpedsclrp_sfc, & - p_in_Pa, rho_zm, rho_in, exner, & - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, hydromet, & - rfrzm, radf, & - wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, & - host_dx, host_dy, & - clubb_config_flags, & - um_in, vm_in, upwp_in, vpwp_in, up2_in, vp2_in, up3_in, vp3_in, & - thlm_in, rtm_in, wprtp_in, wpthlp_in, & - wp2_in, wp3_in, rtp2_in, rtp3_in, thlp2_in, thlp3_in, rtpthlp_in, & - sclrm, & - sclrp2, sclrp3, sclrprtp, sclrpthlp, & - wpsclrp, edsclr_in, err_code, & - rcm_inout, cloud_frac_inout, & - wpthvp_in, wp2thvp_in, rtpthvp_in, thlpthvp_in, & - sclrpthvp_inout, & - pdf_params_chnk(i,lchnk), pdf_params_zm_chnk(i,lchnk), & - pdf_implicit_coefs_terms_chnk(i,lchnk), & - khzm_out, khzt_out, & - qclvar_out, thlprcp_out, & - wprcp_out, ice_supersat_frac_out, & - rcm_in_layer_out, cloud_cover_out) - - if ( err_code == clubb_fatal_error ) then - write(fstderr,*) "Fatal error in CLUBB: at timestep ", get_nstep(), "LAT: ", state1%lat(i), " LON: ", state1%lon(i) - call endrun(subr//': Fatal error in CLUBB library') - end if + ! Determine number of columns and which chunk computation is to be performed on + ncol = state%ncol + lchnk = state%lchnk + ! 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( nzm_clubb, ncol, pdf_params_chnk(lchnk) ) + call init_pdf_params_api( nzm_clubb, ncol, pdf_params_zm_chnk(lchnk) ) + end if - if (do_rainturb) then - rvm_in = rtm_in - rcm_inout - call update_xp2_mc_api(nlev+1, dtime, cloud_frac_inout, & - rcm_inout, rvm_in, thlm_in, wm_zt, exner, pre_in, pdf_params_chnk(i,lchnk), & - rtp2_mc_out, thlp2_mc_out, & - wprtp_mc_out, wpthlp_mc_out, & - rtpthlp_mc_out) + if ( .not. allocated(pdf_implicit_coefs_terms_chnk(lchnk)%coef_wp4_implicit) ) then + call init_pdf_implicit_coefs_terms_api( nzm_clubb, ncol, sclr_dim, & + pdf_implicit_coefs_terms_chnk(lchnk) ) + end if - dum1 = (1._r8 - cam_in%landfrac(i)) + !--------------------- Scalar Setting -------------------- + + dl_rad = clubb_detliq_rad + di_rad = clubb_detice_rad + dt_low = clubb_detphase_lowtemp + + frac_limit = 0.01_r8 + ic_limit = 1.e-12_r8 + inv_rh2o = 1._r8/rh2o + + ! Determine CLUBB time step and make it sub-step friendly + ! For now we want CLUBB time step to be 5 min since that is + ! what has been scientifically validated. However, there are certain + ! instances when a 5 min time step will not be possible (based on + ! host model time step or on macro-micro sub-stepping + dtime = clubb_timestep + + ! Now check to see if dtime is greater than the host model + ! (or sub stepped) time step. If it is, then simply + ! set it equal to the host (or sub step) time step. + ! This section is mostly to deal with small host model + ! time steps (or small sub-steps) + if (dtime > hdtime) then + dtime = hdtime + endif - ! update turbulent moments based on rain evaporation - rtp2_in = rtp2_in + clubb_rnevap_effic * dum1 * rtp2_mc_out * dtime - thlp2_in = thlp2_in + clubb_rnevap_effic * dum1 * thlp2_mc_out * dtime - wprtp_in = wprtp_in + clubb_rnevap_effic * dum1 * wprtp_mc_out * dtime - wpthlp_in = wpthlp_in + clubb_rnevap_effic * dum1 * wpthlp_mc_out * dtime - endif - - if (do_cldcool) then - - rcm_out_zm = zt2zm_api(rcm_inout) - qrl_zm = zt2zm_api(qrl_clubb) - thlp2_rad_out(:) = 0._r8 - call calculate_thlp2_rad_api(nlev+1, rcm_out_zm, thlprcp_out, qrl_zm, thlp2_rad_out) - thlp2_in = thlp2_in + thlp2_rad_out * dtime - thlp2_in = max(thl_tol**2,thlp2_in) - endif + ! Now check to see if CLUBB time step divides evenly into + ! the host model time step. If not, force it to divide evenly. + ! We also want it to be 5 minutes or less. This section is + ! mainly for host model time steps that are not evenly divisible + ! by 5 minutes + if (mod(hdtime,dtime) .ne. 0) then + dtime = hdtime/2._r8 + do while (dtime > clubb_timestep) + dtime = dtime/2._r8 + end do + endif - ! Check to see if stats should be output, here stats are read into - ! output arrays to make them conformable to CAM output - if (l_stats) call stats_end_timestep_clubb(i,out_zt,out_zm,& - out_radzt,out_radzm,out_sfc) - - enddo ! end time loop - - if (clubb_do_adv) then - if (macmic_it == cld_macmic_num_steps) then - wp2_in=zm2zt_api(wp2_in) - wpthlp_in=zm2zt_api(wpthlp_in) - wprtp_in=zm2zt_api(wprtp_in) - up2_in=zm2zt_api(up2_in) - vp2_in=zm2zt_api(vp2_in) - thlp2_in=zm2zt_api(thlp2_in) - rtp2_in=zm2zt_api(rtp2_in) - rtpthlp_in=zm2zt_api(rtpthlp_in) - - do k=1,nlev+1 - thlp2_in(k)=max(thl_tol**2,thlp2_in(k)) - rtp2_in(k)=max(rt_tol**2,rtp2_in(k)) - wp2_in(k)=max(w_tol_sqd,wp2_in(k)) - up2_in(k)=max(w_tol_sqd,up2_in(k)) - vp2_in(k)=max(w_tol_sqd,vp2_in(k)) - enddo - endif - endif - - ! Convert RTP2 and THLP2 to thermo grid for output - rtp2_zt = zm2zt_api(rtp2_in) - thl2_zt = zm2zt_api(thlp2_in) - wp2_zt = zm2zt_api(wp2_in) - - ! Arrays need to be "flipped" to CAM grid - - do k=1,nlev+1 - - um(i,pverp-k+1) = um_in(k) - vm(i,pverp-k+1) = vm_in(k) - upwp(i,pverp-k+1) = upwp_in(k) - vpwp(i,pverp-k+1) = vpwp_in(k) - wpthvp(i,pverp-k+1) = wpthvp_in(k) - wp2thvp(i,pverp-k+1) = wp2thvp_in(k) - rtpthvp(i,pverp-k+1) = rtpthvp_in(k) - thlpthvp(i,pverp-k+1) = thlpthvp_in(k) - up2(i,pverp-k+1) = up2_in(k) - vp2(i,pverp-k+1) = vp2_in(k) - up3(i,pverp-k+1) = up3_in(k) - vp3(i,pverp-k+1) = vp3_in(k) - thlm(i,pverp-k+1) = thlm_in(k) - rtm(i,pverp-k+1) = rtm_in(k) - wprtp(i,pverp-k+1) = wprtp_in(k) - wpthlp(i,pverp-k+1) = wpthlp_in(k) - wp2(i,pverp-k+1) = wp2_in(k) - wp3(i,pverp-k+1) = wp3_in(k) - rtp2(i,pverp-k+1) = rtp2_in(k) - thlp2(i,pverp-k+1) = thlp2_in(k) - rtp3(i,pverp-k+1) = rtp3_in(k) - thlp3(i,pverp-k+1) = thlp3_in(k) - rtpthlp(i,pverp-k+1) = rtpthlp_in(k) - rcm(i,pverp-k+1) = rcm_inout(k) - ice_supersat_frac(i,pverp-k+1) = ice_supersat_frac_out(k) - wprcp(i,pverp-k+1) = wprcp_out(k) - cloud_frac(i,pverp-k+1) = min(cloud_frac_inout(k),1._r8) - rcm_in_layer(i,pverp-k+1) = rcm_in_layer_out(k) - cloud_cover(i,pverp-k+1) = min(cloud_cover_out(k),1._r8) - zt_out(i,pverp-k+1) = zt_g(k) - zi_out(i,pverp-k+1) = zi_g(k) - khzm(i,pverp-k+1) = khzm_out(k) - qclvar(i,pverp-k+1) = min(1._r8,qclvar_out(k)) - wm_zt_out(i,pverp-k+1) = wm_zt(k) - - rtp2_zt_out(i,pverp-k+1) = rtp2_zt(k) - thl2_zt_out(i,pverp-k+1) = thl2_zt(k) - wp2_zt_out(i,pverp-k+1) = wp2_zt(k) - - mean_rt & - = pdf_params_chnk(i,lchnk)%mixt_frac(k) & - * pdf_params_chnk(i,lchnk)%rt_1(k) & - + ( 1.0_r8 - pdf_params_chnk(i,lchnk)%mixt_frac(k) ) & - * pdf_params_chnk(i,lchnk)%rt_2(k) - - pdfp_rtp2(i,pverp-k+1) & - = pdf_params_chnk(i,lchnk)%mixt_frac(k) & - * ( ( pdf_params_chnk(i,lchnk)%rt_1(k) - mean_rt )**2 & - + pdf_params_chnk(i,lchnk)%varnce_rt_1(k) ) & - + ( 1.0_r8 - pdf_params_chnk(i,lchnk)%mixt_frac(k) ) & - * ( ( pdf_params_chnk(i,lchnk)%rt_2(k) - mean_rt )**2 & - + pdf_params_chnk(i,lchnk)%varnce_rt_2(k) ) - - do ixind=1,edsclr_dim - edsclr_out(pverp-k+1,ixind) = edsclr_in(k,ixind) - enddo - - if (do_clubb_mf) then - mf_dry_a_output(i,pverp-k+1) = mf_dry_a(k) - mf_moist_a_output(i,pverp-k+1) = mf_moist_a(k) - mf_dry_w_output(i,pverp-k+1) = mf_dry_w(k) - mf_moist_w_output(i,pverp-k+1) = mf_moist_w(k) - mf_dry_qt_output(i,pverp-k+1) = mf_dry_qt(k) - mf_moist_qt_output(i,pverp-k+1) = mf_moist_qt(k) - mf_dry_thl_output(i,pverp-k+1) = mf_dry_thl(k) - mf_moist_thl_output(i,pverp-k+1) = mf_moist_thl(k) - mf_dry_u_output(i,pverp-k+1) = mf_dry_u(k) - mf_moist_u_output(i,pverp-k+1) = mf_moist_u(k) - mf_dry_v_output(i,pverp-k+1) = mf_dry_v(k) - mf_moist_v_output(i,pverp-k+1) = mf_moist_v(k) - mf_moist_qc_output(i,pverp-k+1) = mf_moist_qc(k) - mf_thlflx_output(i,pverp-k+1) = mf_thlflx(k) - mf_qtflx_output(i,pverp-k+1) = mf_qtflx(k) - s_ae_output(i,pverp-k+1) = s_ae(k) - s_aw_output(i,pverp-k+1) = s_aw(k) - s_awthl_output(i,pverp-k+1) = s_awthl(k) - s_awqt_output(i,pverp-k+1) = s_awqt(k) - s_awql_output(i,pverp-k+1) = s_awql(k) - s_awqi_output(i,pverp-k+1) = s_awqi(k) - s_awu_output(i,pverp-k+1) = s_awu(k) - s_awv_output(i,pverp-k+1) = s_awv(k) - mf_thlflx_output(i,pverp-k+1) = mf_thlflx(k) - mf_qtflx_output(i,pverp-k+1) = mf_qtflx(k) - end if + ! If resulting host model time step and CLUBB time step do not divide evenly + ! into each other, have model throw a fit. + if (mod(hdtime,dtime) .ne. 0) then + call endrun(subr//': CLUBB time step and HOST time step NOT compatible') + endif - enddo + ! determine number of timesteps CLUBB core should be advanced, + ! host time step divided by CLUBB time step + nadv = max(hdtime/dtime,1._r8) - ! Values to use above top_lev, for variables that have not already been - ! set up there. These are mostly fill values that should not actually be - ! used in the run, but may end up in diagnostic output. - upwp(i,:top_lev-1) = 0._r8 - vpwp(i,:top_lev-1) = 0._r8 - rcm(i,:top_lev-1) = 0._r8 - wprcp(i,:top_lev-1) = 0._r8 - cloud_frac(i,:top_lev-1) = 0._r8 - rcm_in_layer(i,:top_lev-1) = 0._r8 - zt_out(i,:top_lev-1) = 0._r8 - zi_out(i,:top_lev-1) = 0._r8 - khzm(i,:top_lev-1) = 0._r8 - qclvar(i,:top_lev-1) = 2._r8 - - - - ! enforce zero tracer tendencies above the top_lev level -- no change - icnt=0 - do ixind=1,pcnst - if (lq(ixind)) then - icnt=icnt+1 - edsclr_out(:top_lev-1,icnt) = state1%q(i,:top_lev-1,ixind) - end if - enddo - ! Fill up arrays needed for McICA. Note we do not want the ghost point, - ! thus why the second loop is needed. - - zi_out(i,1) = 0._r8 + ! Set stats output and increment equal to CLUBB and host dt + stats_metadata%stats_tsamp = dtime + stats_metadata%stats_tout = hdtime - ! Section below is concentrated on energy fixing for conservation. - ! There are two steps to this process. The first is to remove any tendencies - ! CLUBB may have produced above where it is active due to roundoff. - ! The second is to provider a fixer because CLUBB and CAM's thermodynamic - ! variables are different. - - ! Initialize clubbtop with the chemistry topopause top, to prevent CLUBB from - ! firing up in the stratosphere - clubbtop = troplev(i) - do while ((rtp2(i,clubbtop) <= 1.e-15_r8 .and. rcm(i,clubbtop) == 0._r8) .and. clubbtop < pver-1) - clubbtop = clubbtop + 1 - enddo - - ! Compute static energy using CLUBB's variables - do k=1,pver - clubb_s(k) = cpairv(i,k,lchnk) * thlm(i,k) / inv_exner_clubb(i,k) & - + latvap * rcm(i,k) & - + gravit * state1%zm(i,k) + state1%phis(i) - enddo - - ! Compute integrals above layer where CLUBB is active - se_upper_a = 0._r8 ! energy in layers above where CLUBB is active AFTER CLUBB is called - se_upper_b = 0._r8 ! energy in layers above where CLUBB is active BEFORE CLUBB is called - tw_upper_a = 0._r8 ! total water in layers above where CLUBB is active AFTER CLUBB is called - tw_upper_b = 0._r8 ! total water in layers above where CLUBB is active BEFORE CLUBB is called - do k=1,clubbtop - se_upper_a = se_upper_a + (clubb_s(k)+0.5_r8*(um(i,k)**2+vm(i,k)**2)+(latvap+latice)* & - (rtm(i,k)-rcm(i,k))+(latice)*rcm(i,k))*state1%pdel(i,k)/gravit - se_upper_b = se_upper_b + (state1%s(i,k)+0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)+(latvap+latice)* & - state1%q(i,k,ixq)+(latice)*state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit - tw_upper_a = tw_upper_a + rtm(i,k)*state1%pdel(i,k)/gravit - tw_upper_b = tw_upper_b + (state1%q(i,k,ixq)+state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit - enddo - - ! Compute the disbalance of total energy and water in upper levels, - ! divide by the thickness in the lower atmosphere where we will - ! evenly distribute this disbalance - se_upper_diss = (se_upper_a - se_upper_b)/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1)) - tw_upper_diss = (tw_upper_a - tw_upper_b)/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1)) - - ! Perform a test to see if there will be any negative RTM errors - ! in the column. If so, apply the disbalance to the surface - apply_to_surface = .false. - if (tw_upper_diss < 0._r8) then - do k=clubbtop+1,pver - rtm_test = (rtm(i,k) + tw_upper_diss*gravit) - rcm(i,k) - if (rtm_test < 0._r8) then - apply_to_surface = .true. - endif - enddo - endif - - if (apply_to_surface) then - tw_upper_diss = (tw_upper_a - tw_upper_b)/(state1%pint(i,pverp)-state1%pint(i,pver)) - se_upper_diss = (se_upper_a - se_upper_b)/(state1%pint(i,pverp)-state1%pint(i,pver)) - rtm(i,pver) = rtm(i,pver) + tw_upper_diss*gravit - if (apply_to_heat) clubb_s(pver) = clubb_s(pver) + se_upper_diss*gravit - else - ! Apply the disbalances above to layers where CLUBB is active - do k=clubbtop+1,pver - rtm(i,k) = rtm(i,k) + tw_upper_diss*gravit - if (apply_to_heat) clubb_s(k) = clubb_s(k) + se_upper_diss*gravit - enddo - endif - - ! Essentially "zero" out tendencies in the layers above where CLUBB is active - do k=1,clubbtop - if (apply_to_heat) clubb_s(k) = state1%s(i,k) - rcm(i,k) = state1%q(i,k,ixcldliq) - rtm(i,k) = state1%q(i,k,ixq) + rcm(i,k) - enddo - - ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water - ! after CLUBB is called. This is for energy conservation purposes. - se_a = 0._r8 - ke_a = 0._r8 - wv_a = 0._r8 - wl_a = 0._r8 - - ! Do the same as above, but for before CLUBB was called. - se_b = 0._r8 - ke_b = 0._r8 - wv_b = 0._r8 - wl_b = 0._r8 - do k=1,pver - se_a(i) = se_a(i) + clubb_s(k)*state1%pdel(i,k)/gravit - ke_a(i) = ke_a(i) + 0.5_r8*(um(i,k)**2+vm(i,k)**2)*state1%pdel(i,k)/gravit - wv_a(i) = wv_a(i) + (rtm(i,k)-rcm(i,k))*state1%pdel(i,k)/gravit - wl_a(i) = wl_a(i) + (rcm(i,k))*state1%pdel(i,k)/gravit - - se_b(i) = se_b(i) + state1%s(i,k)*state1%pdel(i,k)/gravit - ke_b(i) = ke_b(i) + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)/gravit - wv_b(i) = wv_b(i) + state1%q(i,k,ixq)*state1%pdel(i,k)/gravit - wl_b(i) = wl_b(i) + state1%q(i,k,ixcldliq)*state1%pdel(i,k)/gravit - enddo - - ! Based on these integrals, compute the total energy before and after CLUBB call - te_a(i) = se_a(i) + ke_a(i) + (latvap+latice)*wv_a(i)+latice*wl_a(i) - te_b(i) = se_b(i) + ke_b(i) + (latvap+latice)*wv_b(i)+latice*wl_b(i) - - ! Take into account the surface fluxes of heat and moisture - ! Use correct qflux from cam_in, not lhf/latvap as was done previously - te_b(i) = te_b(i)+(cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice))*hdtime + stats_nsamp = nint(stats_metadata%stats_tsamp/dtime) + stats_nout = nint(stats_metadata%stats_tout/dtime) - ! Compute the disbalance of total energy, over depth where CLUBB is active - se_dis = (te_a(i) - te_b(i))/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1)) - ! Fix the total energy coming out of CLUBB so it achieves enery conservation. - ! Apply this fixer throughout the column evenly, but only at layers where - ! CLUBB is active. - ! - ! NOTE: The energy fixer seems to cause the climate to change significantly - ! when using specified dynamics, so allow this to be turned off via a namelist - ! variable. - if (clubb_do_energyfix) then - do k=clubbtop+1,pver - clubb_s(k) = clubb_s(k) - se_dis*gravit - enddo - endif + if (clubb_do_adv) then + apply_const = 1._r8 ! Initialize to one, only if CLUBB's moments are advected + else + apply_const = 0._r8 ! Never want this if CLUBB's moments are not advected + endif - ! Now compute the tendencies of CLUBB to CAM, note that pverp is the ghost point - ! for all variables and therefore is never called in this loop - rtm_integral_vtend = 0._r8 - rtm_integral_ltend = 0._r8 - do k=1,pver - - 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(k)-state1%s(i,k))/hdtime ! Tendency of static energy - - rtm_integral_ltend = rtm_integral_ltend + ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k)/gravit - rtm_integral_vtend = rtm_integral_vtend + ptend_loc%q(i,k,ixq)*state1%pdel(i,k)/gravit - - if (clubb_do_adv) then - if (macmic_it == cld_macmic_num_steps) then - - ! Here add a constant to moments which can be either positive or - ! negative. This is to prevent clipping when dynamics tries to - ! make all constituents positive - wp3(i,k) = wp3(i,k) + wp3_const - rtpthlp(i,k) = rtpthlp(i,k) + rtpthlp_const - wpthlp(i,k) = wpthlp(i,k) + wpthlp_const - wprtp(i,k) = wprtp(i,k) + wprtp_const - - ptend_loc%q(i,k,ixthlp2)=(thlp2(i,k)-state1%q(i,k,ixthlp2))/hdtime ! THLP Variance - ptend_loc%q(i,k,ixrtp2)=(rtp2(i,k)-state1%q(i,k,ixrtp2))/hdtime ! RTP Variance - ptend_loc%q(i,k,ixrtpthlp)=(rtpthlp(i,k)-state1%q(i,k,ixrtpthlp))/hdtime ! RTP THLP covariance - ptend_loc%q(i,k,ixwpthlp)=(wpthlp(i,k)-state1%q(i,k,ixwpthlp))/hdtime ! WPTHLP - ptend_loc%q(i,k,ixwprtp)=(wprtp(i,k)-state1%q(i,k,ixwprtp))/hdtime ! WPRTP - ptend_loc%q(i,k,ixwp2)=(wp2(i,k)-state1%q(i,k,ixwp2))/hdtime ! WP2 - ptend_loc%q(i,k,ixwp3)=(wp3(i,k)-state1%q(i,k,ixwp3))/hdtime ! WP3 - ptend_loc%q(i,k,ixup2)=(up2(i,k)-state1%q(i,k,ixup2))/hdtime ! UP2 - ptend_loc%q(i,k,ixvp2)=(vp2(i,k)-state1%q(i,k,ixvp2))/hdtime ! VP2 - else - ptend_loc%q(i,k,ixthlp2)=0._r8 - ptend_loc%q(i,k,ixrtp2)=0._r8 - ptend_loc%q(i,k,ixrtpthlp)=0._r8 - ptend_loc%q(i,k,ixwpthlp)=0._r8 - ptend_loc%q(i,k,ixwprtp)=0._r8 - ptend_loc%q(i,k,ixwp2)=0._r8 - ptend_loc%q(i,k,ixwp3)=0._r8 - ptend_loc%q(i,k,ixup2)=0._r8 - ptend_loc%q(i,k,ixvp2)=0._r8 - endif + ! Initialize the apply_const variable (note special logic is due to eulerian backstepping) + if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp(1:ncol,1:pver) == 0._r8))) then + apply_const = 0._r8 ! On first time through do not remove constant + ! from moments since it has not been added yet + endif + + !--------------------- Initializations -------------------- + + ! Set the ztodt timestep in pbuf for SILHS + ztodtptr(:) = 1.0_r8*hdtime + + call t_stopf('clubb_tend_cam:NAR') + call t_startf('clubb_tend_cam:acc_copyin') + !$acc data copyin( sclr_idx, clubb_params_single_col, grid_dx, grid_dy, rairv, cpairv, radf_clubb, qrl, & + !$acc pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), & + !$acc state1, state1%q, state1%u, state1%v, state1%t, state1%pmid, state1%s, state1%pint, & + !$acc state1%zm, state1%zi, state1%pdeldry, state1%pdel, state1%omega, state1%phis, & + !$acc cam_in, cam_in%shf, cam_in%wsx, cam_in%wsy, cam_in%cflx, & + !$acc rrho, prer_evap, rtp2_mc_zt, thlp2_mc_zt, wprtp_mc_zt, wpthlp_mc_zt, rtpthlp_mc_zt ) & + !$acc copy( um, vm, upwp, vpwp, wpthvp, wp2thvp, rtpthvp, thlpthvp, up2, vp2, up3, vp3, & + !$acc wp2, wp3, rtp2, thlp2, rtp3, thlp3, thlm, rtm, rvm, wprtp, wpthlp, rtpthlp, & + !$acc pdf_zm_w_1, pdf_zm_w_2, pdf_zm_varnce_w_1, pdf_zm_varnce_w_2, pdf_zm_mixt_frac, & + !$acc cloud_frac, wp2rtp, wp2thlp, uprcp, vprcp, rc_coef, wp4, wpup2, wpvp2, & + !$acc ttend_clubb_mc, upwp_clubb_gw_mc, vpwp_clubb_gw_mc, thlp2_clubb_gw_mc, wpthlp_clubb_gw_mc, & + !$acc ttend_clubb, upwp_clubb_gw, vpwp_clubb_gw, thlp2_clubb_gw, wpthlp_clubb_gw, & + !$acc wp2up2, wp2vp2, ice_supersat_frac, & + !$acc pdf_params_zm_chnk(lchnk)%w_1, pdf_params_zm_chnk(lchnk)%w_2, & + !$acc pdf_params_zm_chnk(lchnk)%varnce_w_1, pdf_params_zm_chnk(lchnk)%varnce_w_2, & + !$acc pdf_params_zm_chnk(lchnk)%mixt_frac ) & + !$acc copyout( temp2d, temp2dp, rtp2_zt_out, thl2_zt_out, wp2_zt_out, pdfp_rtp2, wm_zt_out, inv_exner_clubb, & + !$acc rcm, wprcp, rcm_in_layer, cloud_cover, zt_out, zi_out, khzm, qclvar, thv, dz_g, & + !$acc clubbtop, se_dis, eleak, clubb_s, wpthvp_clubb, wprcp_clubb ) & + !$acc create( upwp_sfc_pert, vpwp_sfc_pert, khzt_out, khzm_out, & + !$acc fcor, um_in, vm_in, upwp_in, vpwp_in, wpthvp_in, wp2thvp_in, rtpthvp_in, thlpthvp_in, & + !$acc up2_in, vp2_in, up3_in, vp3_in, wp2_in, wp3_in, rtp2_in, thlp2_in, rtp3_in, & + !$acc thlp3_in, thlm_in, rtm_in, rvm_in, wprtp_in, wpthlp_in, rtpthlp_in, cloud_frac_inout, & + !$acc rcm_inout, wp2rtp_inout, wp2thlp_inout, uprcp_inout, vprcp_inout, & + !$acc rc_coef_inout, wp4_inout, wpup2_inout, wpvp2_inout, wp2up2_inout, wp2vp2_inout, & + !$acc ice_supersat_frac_inout, pre_in, kappa_zt, qc_zt, invrs_exner_zt, kappa_zm, p_in_Pa_zm, & + !$acc invrs_exner_zm, cloud_cover_out, rcm_in_layer_out, wprcp_out, & + !$acc qclvar_out, rtp2_zt, thl2_zt, wp2_zt, w_up_in_cloud_out, cloudy_downdraft_frac_out, & + !$acc w_down_in_cloud_out, invrs_tau_zm_out, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, & + !$acc thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & + !$acc wprtp_forcing, wpthlp_forcing, rtp2_forcing, thlp2_forcing, & + !$acc rtpthlp_forcing, wm_zm, wm_zt, rho_zm, rho_zt, rho_ds_zm, rho_ds_zt, & + !$acc invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, rfrzm, & + !$acc radf, wpthlp_sfc, clubb_params, sfc_elevation, wprtp_sfc, upwp_sfc, vpwp_sfc, & + !$acc rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, p_in_Pa, exner, um_pert_inout, & + !$acc inv_exner_clubb_surf, thlprcp_out, zi_g, zt_g, qrl_clubb, & + !$acc pdf_params_chnk(lchnk)%w_1, pdf_params_chnk(lchnk)%w_2, & + !$acc pdf_params_chnk(lchnk)%varnce_w_1, pdf_params_chnk(lchnk)%varnce_w_2, & + !$acc pdf_params_chnk(lchnk)%rt_1, pdf_params_chnk(lchnk)%rt_2, & + !$acc pdf_params_chnk(lchnk)%varnce_rt_1, pdf_params_chnk(lchnk)%varnce_rt_2, & + !$acc pdf_params_chnk(lchnk)%thl_1, pdf_params_chnk(lchnk)%thl_2, & + !$acc pdf_params_chnk(lchnk)%varnce_thl_1, pdf_params_chnk(lchnk)%varnce_thl_2, & + !$acc pdf_params_chnk(lchnk)%corr_w_rt_1, pdf_params_chnk(lchnk)%corr_w_rt_2, & + !$acc pdf_params_chnk(lchnk)%corr_w_thl_1, pdf_params_chnk(lchnk)%corr_w_thl_2, & + !$acc pdf_params_chnk(lchnk)%corr_rt_thl_1, pdf_params_chnk(lchnk)%corr_rt_thl_2,& + !$acc pdf_params_chnk(lchnk)%alpha_thl, pdf_params_chnk(lchnk)%alpha_rt, & + !$acc pdf_params_chnk(lchnk)%crt_1, pdf_params_chnk(lchnk)%crt_2, pdf_params_chnk(lchnk)%cthl_1, & + !$acc pdf_params_chnk(lchnk)%cthl_2, pdf_params_chnk(lchnk)%chi_1, & + !$acc pdf_params_chnk(lchnk)%chi_2, pdf_params_chnk(lchnk)%stdev_chi_1, & + !$acc pdf_params_chnk(lchnk)%stdev_chi_2, pdf_params_chnk(lchnk)%stdev_eta_1, & + !$acc pdf_params_chnk(lchnk)%stdev_eta_2, pdf_params_chnk(lchnk)%covar_chi_eta_1, & + !$acc pdf_params_chnk(lchnk)%covar_chi_eta_2, pdf_params_chnk(lchnk)%corr_w_chi_1, & + !$acc pdf_params_chnk(lchnk)%corr_w_chi_2, pdf_params_chnk(lchnk)%corr_w_eta_1, & + !$acc pdf_params_chnk(lchnk)%corr_w_eta_2, pdf_params_chnk(lchnk)%corr_chi_eta_1, & + !$acc pdf_params_chnk(lchnk)%corr_chi_eta_2, pdf_params_chnk(lchnk)%rsatl_1, & + !$acc pdf_params_chnk(lchnk)%rsatl_2, pdf_params_chnk(lchnk)%rc_1, pdf_params_chnk(lchnk)%rc_2, & + !$acc pdf_params_chnk(lchnk)%cloud_frac_1, pdf_params_chnk(lchnk)%cloud_frac_2, & + !$acc pdf_params_chnk(lchnk)%mixt_frac, pdf_params_chnk(lchnk)%ice_supersat_frac_1, & + !$acc pdf_params_chnk(lchnk)%ice_supersat_frac_2, & + !$acc pdf_params_zm_chnk(lchnk)%rt_1, pdf_params_zm_chnk(lchnk)%rt_2, & + !$acc pdf_params_zm_chnk(lchnk)%varnce_rt_1, pdf_params_zm_chnk(lchnk)%varnce_rt_2, & + !$acc pdf_params_zm_chnk(lchnk)%thl_1, pdf_params_zm_chnk(lchnk)%thl_2, & + !$acc pdf_params_zm_chnk(lchnk)%varnce_thl_1, pdf_params_zm_chnk(lchnk)%varnce_thl_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_w_rt_1, pdf_params_zm_chnk(lchnk)%corr_w_rt_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_w_thl_1, pdf_params_zm_chnk(lchnk)%corr_w_thl_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_rt_thl_1, pdf_params_zm_chnk(lchnk)%corr_rt_thl_2,& + !$acc pdf_params_zm_chnk(lchnk)%alpha_thl, pdf_params_zm_chnk(lchnk)%alpha_rt, & + !$acc pdf_params_zm_chnk(lchnk)%crt_1, pdf_params_zm_chnk(lchnk)%crt_2, pdf_params_zm_chnk(lchnk)%cthl_1, & + !$acc pdf_params_zm_chnk(lchnk)%cthl_2, pdf_params_zm_chnk(lchnk)%chi_1, & + !$acc pdf_params_zm_chnk(lchnk)%chi_2, pdf_params_zm_chnk(lchnk)%stdev_chi_1, & + !$acc pdf_params_zm_chnk(lchnk)%stdev_chi_2, pdf_params_zm_chnk(lchnk)%stdev_eta_1, & + !$acc pdf_params_zm_chnk(lchnk)%stdev_eta_2, pdf_params_zm_chnk(lchnk)%covar_chi_eta_1, & + !$acc pdf_params_zm_chnk(lchnk)%covar_chi_eta_2, pdf_params_zm_chnk(lchnk)%corr_w_chi_1, & + !$acc pdf_params_zm_chnk(lchnk)%corr_w_chi_2, pdf_params_zm_chnk(lchnk)%corr_w_eta_1, & + !$acc pdf_params_zm_chnk(lchnk)%corr_w_eta_2, pdf_params_zm_chnk(lchnk)%corr_chi_eta_1, & + !$acc pdf_params_zm_chnk(lchnk)%corr_chi_eta_2, pdf_params_zm_chnk(lchnk)%rsatl_1, & + !$acc pdf_params_zm_chnk(lchnk)%rsatl_2, pdf_params_zm_chnk(lchnk)%rc_1, pdf_params_zm_chnk(lchnk)%rc_2, & + !$acc pdf_params_zm_chnk(lchnk)%cloud_frac_1, pdf_params_zm_chnk(lchnk)%cloud_frac_2, & + !$acc pdf_params_zm_chnk(lchnk)%ice_supersat_frac_1, pdf_params_zm_chnk(lchnk)%ice_supersat_frac_2 ) + + !$acc data if( sclr_dim > 0 ) & + !$acc create( wpsclrp_sfc, sclrm_forcing, sclrm, wpsclrp, sclrp2, sclrp3, sclrprtp, sclrpthlp, sclrpthvp_inout) & + !$acc copyin( sclr_tol ) + + !$acc data if( edsclr_dim > 0 ) & + !$acc create( wpedsclrp_sfc, edsclrm_forcing, edsclr_in ) & + !$acc copyout( edsclr_out ) + + !$acc data if( hydromet_dim > 0 ) & + !$acc create( hydromet, wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt ) & + !$acc copyin( hm_metadata, hm_metadata%l_mix_rat_hm ) + call t_stopf('clubb_tend_cam:acc_copyin') + call t_startf('clubb_tend_cam:ACCR') + + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, pverp + do i = 1, pcols + rtp2_zt_out(i,k) = 0._r8 + thl2_zt_out(i,k) = 0._r8 + wp2_zt_out(i,k) = 0._r8 + pdfp_rtp2(i,k) = 0._r8 + wm_zt_out(i,k) = 0._r8 + temp2dp(i,k) = 0._r8 + end do + end do + + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, pver + do i = 1, pcols + temp2d(i,k) = 0._r8 + end do + end do + + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzm_clubb + do i = 1, ncol + + ! Define forcings from CAM to CLUBB as zero for momentum and thermo, + ! forcings already applied through CAM + thlm_forcing(i,k) = 0._r8 + rtm_forcing(i,k) = 0._r8 + um_forcing(i,k) = 0._r8 + vm_forcing(i,k) = 0._r8 + + rtm_ref(i,k) = 0.0_r8 + thlm_ref(i,k) = 0.0_r8 + um_ref(i,k) = 0.0_r8 + vm_ref(i,k) = 0.0_r8 + ug(i,k) = 0.0_r8 + vg(i,k) = 0.0_r8 + end do + end do + + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzm_clubb + do i = 1, ncol + ! Perturbed winds are not used in CAM + um_pert_inout(i,k) = 0.0_r8 + vm_pert_inout(i,k) = 0.0_r8 + upwp_pert_inout(i,k) = 0.0_r8 + vpwp_pert_inout(i,k) = 0.0_r8 + + ! Initialize these to prevent crashing behavior + wprcp_out(i,k) = 0._r8 + rcm_in_layer_out(i,k) = 0._r8 + cloud_cover_out(i,k) = 0._r8 + khzm_out(i,k) = 0._r8 + khzt_out(i,k) = 0._r8 + end do + end do + + !$acc parallel loop gang vector default(present) + do i = 1, ncol + ! Perturbed winds are not used in CAM + upwp_sfc_pert(i) = 0.0_r8 + vpwp_sfc_pert(i) = 0.0_r8 + + ! Determine Coriolis force at given latitude. This is never used + ! when CLUBB is implemented in a host model, therefore just set + ! to zero. + fcor(i) = 0._r8 + end do + + if ( sclr_dim > 0 ) then + ! higher order scalar stuff, put to zero + !$acc parallel loop gang vector collapse(3) default(present) + do sclr = 1, sclr_dim + do k = 1, nzm_clubb + do i=1, ncol + sclrm(i,k,sclr) = 0._r8 + wpsclrp(i,k,sclr) = 0._r8 + sclrp2(i,k,sclr) = 0._r8 + sclrp3(i,k,sclr) = 0._r8 + sclrprtp(i,k,sclr) = 0._r8 + sclrpthlp(i,k,sclr) = 0._r8 + sclrpthvp_inout(i,k,sclr) = 0._r8 + sclrm_forcing(i,k,sclr) = 0._r8 + end do + end do + end do + + !$acc parallel loop gang vector collapse(2) default(present) + do sclr = 1, sclr_dim + do i=1, ncol + wpsclrp_sfc(i,sclr) = 0._r8 + end do + end do + end if + + if ( hydromet_dim > 0 ) then + !$acc parallel loop gang vector collapse(3) default(present) + do ixind=1, hydromet_dim + do k=1, nzm_clubb + do i=1, ncol + hydromet(i,k,ixind) = 0._r8 + wphydrometp(i,k,ixind) = 0._r8 + wp2hmp(i,k,ixind) = 0._r8 + rtphmp_zt(i,k,ixind) = 0._r8 + thlphmp_zt(i,k,ixind) = 0._r8 + end do + end do + end do + end if + + if ( edsclr_dim > 0 ) then + !$acc parallel loop gang vector collapse(3) default(present) + do edsclr = 1, edsclr_dim + do i = 1, ncol + do k = 1, nzm_clubb + edsclrm_forcing(i,k,edsclr) = 0._r8 + edsclr_in(i,k,edsclr) = 0._r8 + end do + end do + end do + + ! Define surface sources for transported variables for diffusion, will + ! be zero as these tendencies are done in vertical_diffusion + !$acc parallel loop gang vector collapse(2) default(present) + do edsclr = 1, edsclr_dim + do i = 1, ncol + wpedsclrp_sfc(i,edsclr) = 0._r8 + end do + end do + end if + + ! need to initialize macmic coupling to zero + if ( macmic_it == 1 ) then + !$acc parallel loop gang vector collapse(2) default(present) + do i = 1, ncol + do k = 1, pverp + ttend_clubb_mc(i,k) = 0._r8 + upwp_clubb_gw_mc(i,k) = 0._r8 + vpwp_clubb_gw_mc(i,k) = 0._r8 + thlp2_clubb_gw_mc(i,k) = 0._r8 + wpthlp_clubb_gw_mc(i,k) = 0._r8 + end do + end do + end if + + ! Initialize EDMF outputs + if (do_clubb_mf) then + do k = 1, pverp + do i = 1, pcols + mf_dry_a_output(i,k) = 0._r8 + mf_moist_a_output(i,k) = 0._r8 + mf_dry_w_output(i,k) = 0._r8 + mf_moist_w_output(i,k) = 0._r8 + mf_dry_qt_output(i,k) = 0._r8 + mf_moist_qt_output(i,k) = 0._r8 + mf_dry_thl_output(i,k) = 0._r8 + mf_moist_thl_output(i,k) = 0._r8 + mf_dry_u_output(i,k) = 0._r8 + mf_moist_u_output(i,k) = 0._r8 + mf_dry_v_output(i,k) = 0._r8 + mf_moist_v_output(i,k) = 0._r8 + mf_moist_qc_output(i,k) = 0._r8 + s_ae_output(i,k) = 0._r8 + s_aw_output(i,k) = 0._r8 + s_awthl_output(i,k) = 0._r8 + s_awqt_output(i,k) = 0._r8 + s_awql_output(i,k) = 0._r8 + s_awqi_output(i,k) = 0._r8 + s_awu_output(i,k) = 0._r8 + s_awv_output(i,k) = 0._r8 + mf_thlflx_output(i,k) = 0._r8 + mf_qtflx_output(i,k) = 0._r8 + end do + end do + end if + + if (clubb_do_icesuper) then + + ! -------------------------------------- ! + ! Ice Saturation Adjustment Computation ! + ! -------------------------------------- ! + + lq2(:) = .FALSE. + lq2(1) = .TRUE. + lq2(ixcldice) = .TRUE. + lq2(ixnumice) = .TRUE. + + latsub = latvap + latice + + call physics_ptend_init(ptend_loc, state%psetcols, 'iceadj', ls=.true., lq=lq2 ) + + do i = 1, ncol + do k = 1, pver + stend(i,k) = 0._r8 + qvtend(i,k) = 0._r8 + qitend(i,k) = 0._r8 + initend(i,k) = 0._r8 + end do + end do + + call t_startf('clubb_tend_cam:ice_macro_tend') + call ice_macro_tend(naai(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & + state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,1), & + state1%q(1:ncol,top_lev:pver,ixcldice), state1%q(1:ncol,top_lev:pver,ixnumice), & + latsub, hdtime, stend(1:ncol,top_lev:pver), qvtend(1:ncol,top_lev:pver), & + qitend(1:ncol,top_lev:pver), initend(1:ncol,top_lev:pver), ncol*(pver-top_lev+1)) + call t_stopf('clubb_tend_cam:ice_macro_tend') + + ! update local copy of state with the tendencies + do i = 1, ncol + do k = top_lev, pver + ptend_loc%q(i,k,1) = qvtend(i,k) + ptend_loc%q(i,k,ixcldice) = qitend(i,k) + ptend_loc%q(i,k,ixnumice) = initend(i,k) + ptend_loc%s(i,k) = stend(i,k) + end do + end do + + ! Add the ice tendency to the output tendency + call physics_ptend_sum(ptend_loc, ptend_all, ncol) + + ! ptend_loc is reset to zero by this call + call physics_update(state1, ptend_loc, hdtime) + + ! Write output for tendencies: + do i = 1, ncol + do k = 1, pver + temp2d(i,k) = stend(i,k) / cpairv(i,k,lchnk) + end do + end do + + call outfld( 'TTENDICE', temp2d, pcols, lchnk ) + call outfld( 'QVTENDICE', qvtend, pcols, lchnk ) + call outfld( 'QITENDICE', qitend, pcols, lchnk ) + call outfld( 'NITENDICE', initend, pcols, lchnk ) + + endif + + if (clubb_do_adv) then + + if (macmic_it == 1) then + + ! Note that some of the moments below can be positive or negative. + ! Remove a constant that was added to prevent dynamics from clipping + ! them to prevent dynamics from making them positive. + do k = 1, pver + do i = 1, ncol + thlp2(i,k) = state1%q(i,k,ixthlp2) + rtp2(i,k) = state1%q(i,k,ixrtp2) + rtpthlp(i,k) = state1%q(i,k,ixrtpthlp) - ( rtpthlp_const * apply_const ) + wpthlp(i,k) = state1%q(i,k,ixwpthlp) - ( wpthlp_const * apply_const ) + wprtp(i,k) = state1%q(i,k,ixwprtp) - ( wprtp_const * apply_const ) + wp2(i,k) = state1%q(i,k,ixwp2) + wp3(i,k) = state1%q(i,k,ixwp3) - ( wp3_const * apply_const ) + up2(i,k) = state1%q(i,k,ixup2) + vp2(i,k) = state1%q(i,k,ixvp2) + enddo + enddo + + endif + + ! If not last step of macmic loop then set apply_const back to + ! zero to prevent output from being corrupted. + if (macmic_it == cld_macmic_num_steps) then + apply_const = 1._r8 + else + apply_const = 0._r8 + endif + + do i = 1, ncol + thlp2(i,pverp) = thlp2(i,pver) + rtp2(i,pverp) = rtp2(i,pver) + rtpthlp(i,pverp) = rtpthlp(i,pver) + wpthlp(i,pverp) = wpthlp(i,pver) + wprtp(i,pverp) = wprtp(i,pver) + wp2(i,pverp) = wp2(i,pver) + wp3(i,pverp) = wp3(i,pver) + up2(i,pverp) = up2(i,pver) + vp2(i,pverp) = vp2(i,pver) + end do + + endif + + ! Define the CLUBB momentum grid (in height, units of m) + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, nzm_clubb + do i=1, ncol + zi_g(i,k) = state1%zi(i,pverp-k+1) - state1%zi(i,pver+1) + end do + end do + + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, pver + do i=1, ncol + + ! Compute inverse exner function consistent with CLUBB's definition, which uses a constant + ! surface pressure. CAM's exner (in state) does not. Therefore, for consistent + ! treatment with CLUBB code, anytime exner is needed to treat CLUBB variables + ! (such as thlm), use "inv_exner_clubb" otherwise use the exner in state + inv_exner_clubb(i,k) = 1._r8 / ( ( state1%pmid(i,k) / p0_clubb )**( rairv(i,k,lchnk) / cpairv(i,k,lchnk) ) ) + + ! Compute virtual potential temperature, which is needed for CLUBB + thv(i,k) = state1%t(i,k) * inv_exner_clubb(i,k) & + * ( 1._r8 + zvir * state1%q(i,k,ixq) - state1%q(i,k,ixcldliq) ) + + dz_g(i,k) = state1%zi(i,k) - state1%zi(i,k+1) ! compute thickness + + ! At each CLUBB call, initialize mean momentum and thermo CLUBB state + ! from the CAM state + rtm(i,k) = state1%q(i,k,ixq) + state1%q(i,k,ixcldliq) + rvm(i,k) = state1%q(i,k,ixq) + um(i,k) = state1%u(i,k) + vm(i,k) = state1%v(i,k) + thlm(i,k) = ( state1%t(i,k) - ( latvap / cpairv(i,k,lchnk) ) * state1%q(i,k,ixcldliq) ) & + * inv_exner_clubb(i,k) + + enddo + enddo + + !$acc parallel loop gang vector default(present) + do i = 1, ncol + rtm(i,pverp) = rtm(i,pver) + um(i,pverp) = state1%u(i,pver) + vm(i,pverp) = state1%v(i,pver) + thlm(i,pverp) = thlm(i,pver) + + ! Compute exner at the surface for converting the sensible heat fluxes + ! to a flux of potential temperature for use as clubb's boundary conditions + inv_exner_clubb_surf(i) = inv_exner_clubb(i,pver) + end do + + ! Compute thermodynamic stuff needed for CLUBB on thermo levels. + ! Inputs for the momentum levels are set below setup_clubb core + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzt_clubb + do i = 1, ncol + + ! Define the CLUBB thermodynamic grid (in units of m) + zt_g(i,k+1) = state1%zm(i,pver-k+1) - state1%zi(i,pver+1) + + ! base state (dry) variables + rho_ds_zt(i,k+1) = rga * ( state1%pdeldry(i,pver-k+1) / dz_g(i,pver-k+1) ) + invrs_rho_ds_zt(i,k+1) = 1._r8 / rho_ds_zt(i,k+1) + + ! full state (moist) variables + p_in_Pa(i,k+1) = state1%pmid(i,pver-k+1) + exner(i,k+1) = 1._r8 / inv_exner_clubb(i,pver-k+1) + thv(i,k+1) = state1%t(i,pver-k+1) * inv_exner_clubb(i,pver-k+1) & + * ( 1._r8 + zvir * state1%q(i,pver-k+1,ixq) - state1%q(i,pver-k+1,ixcldliq) ) + rho_zt(i,k+1) = rga * state1%pdel(i,pver-k+1) / dz_g(i,pver-k+1) + + ! exception - setting this to moist thv + thv_ds_zt(i,k+1) = thv(i,k+1) + + rfrzm(i,k+1) = state1%q(i,pver-k+1,ixcldice) + radf(i,k+1) = radf_clubb(i,pver-k+1) + qrl_clubb(i,k+1) = qrl(i,pver-k+1) / ( cpairv(i,k,lchnk) * state1%pdeldry(i,pver-k+1) ) + + ! Compute mean w wind on thermo grid, convert from omega to w + wm_zt(i,k+1) = -1._r8 * ( state1%omega(i,pver-k+1) - state1%omega(i,pver) ) & + / ( rho_zt(i,k+1) * gravit ) + end do + end do + + ! Below computes the same stuff for the ghost point. May or may + ! not be needed, just to be safe to avoid NaN's + !$acc parallel loop gang vector default(present) + do i = 1, ncol + zt_g(i,1) = -1._r8 * zt_g(i,2) + rho_ds_zt(i,1) = rho_ds_zt(i,2) + invrs_rho_ds_zt(i,1) = invrs_rho_ds_zt(i,2) + p_in_Pa(i,1) = p_in_Pa(i,2) + exner(i,1) = exner(i,2) + thv(i,1) = thv(i,2) + rho_zt(i,1) = rho_zt(i,2) + thv_ds_zt(i,1) = thv_ds_zt(i,2) + rfrzm(i,1) = rfrzm(i,2) + radf(i,1) = radf(i,2) + qrl_clubb(i,1) = qrl_clubb(i,2) + wm_zt(i,1) = wm_zt(i,2) + + ! Set the elevation of the surface + sfc_elevation(i) = state1%zi(i,pverp) + end do + + + !$acc parallel loop gang vector collapse(2) default(present) + do i = 1, ncol + do n = 1, nparams + clubb_params(i,n) = clubb_params_single_col(n) + end do + end do + + ! ------------------------------------------------- ! + ! Begin case specific code for SCAM cases. ! + ! This section of code block is NOT called in ! + ! global simulations ! + ! ------------------------------------------------- ! + 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 + zo(1) = 0.035_r8 + else + zo(1) = 0.0001_r8 + endif + + ! Compute surface wind (ubar) + ubar = sqrt(um(1,pver)**2+vm(1,pver)**2) + if (ubar < 0.25_r8) ubar = 0.25_r8 + + ! Below denotes case specifics for surface momentum + ! and thermodynamic fluxes, depending on the case + + ! Define ustar (based on case, if not variable) + ustar = 0.25_r8 ! Initialize ustar in case no case + + if(trim(scm_clubb_iop_name) == 'BOMEX_5day') then + ustar = 0.28_r8 + endif + + if(trim(scm_clubb_iop_name) == 'ATEX_48hr') then + ustar = 0.30_r8 + endif + + if(trim(scm_clubb_iop_name) == 'RICO_3day') then + ustar = 0.28_r8 + endif + + if(trim(scm_clubb_iop_name) == 'arm97' .or. trim(scm_clubb_iop_name) == 'gate' .or. & + trim(scm_clubb_iop_name) == 'toga' .or. trim(scm_clubb_iop_name) == 'mpace' .or. & + trim(scm_clubb_iop_name) == 'ARM_CC') then + + bflx22(1) = (gravit/theta0)*wpthlp_sfc(1) + ustar = diag_ustar(zt_g(1,2),bflx22(1),ubar,zo(1)) + endif + + ! Compute the surface momentum fluxes, if this is a SCAM simulation + upwp_sfc(1) = -um(1,pver)*ustar**2/ubar + vpwp_sfc(1) = -vm(1,pver)*ustar**2/ubar + + end if + + + ! 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 + ! call to setup_grid_heights_api. + + call t_stopf('clubb_tend_cam:ACCR') + call t_startf('clubb_tend_cam:NAR') + !$acc update host( zi_g, zt_g, clubb_params, sfc_elevation ) + + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + grid_type, zi_g(:,2), zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) + zi_g, zt_g, & ! intent(in) + gr ) ! intent(out) + + + call setup_parameters_api( zi_g(:,2), clubb_params, gr, ncol, grid_type, & ! intent(in) + clubb_config_flags%l_prescribed_avg_deltaz, & ! intent(in) + lmin, nu_vert_res_dep, err_code ) ! intent(out) + + if ( err_code == clubb_fatal_error ) then + call endrun(subr//': Fatal error in CLUBB setup_parameters') + end if + + call t_stopf('clubb_tend_cam:NAR') + call t_startf('clubb_tend_cam:acc_copyin') + !$acc data copyin( gr, gr%zm, gr%zt, gr%dzm, gr%dzt, gr%invrs_dzt, gr%invrs_dzm, & + !$acc gr%weights_zt2zm, gr%weights_zm2zt, & + !$acc nu_vert_res_dep, nu_vert_res_dep%nu2, nu_vert_res_dep%nu9, & + !$acc nu_vert_res_dep%nu1, nu_vert_res_dep%nu8, nu_vert_res_dep%nu10, & + !$acc nu_vert_res_dep%nu6) + call t_stopf('clubb_tend_cam:acc_copyin') + call t_startf('clubb_tend_cam:ACCR') + + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzm_clubb + do i = 1, ncol + rtp2_forcing(i,k) = rtp2_mc_zt(i,k) + thlp2_forcing(i,k) = thlp2_mc_zt(i,k) + wprtp_forcing(i,k) = wprtp_mc_zt(i,k) + wpthlp_forcing(i,k) = wpthlp_mc_zt(i,k) + rtpthlp_forcing(i,k) = rtpthlp_mc_zt(i,k) + end do + end do + + ! Add forcings for SILHS covariance contributions + rtp2_forcing = zt2zm_api( nzm_clubb, ncol, gr, rtp2_forcing ) + thlp2_forcing = zt2zm_api( nzm_clubb, ncol, gr, thlp2_forcing ) + wprtp_forcing = zt2zm_api( nzm_clubb, ncol, gr, wprtp_forcing ) + wpthlp_forcing = zt2zm_api( nzm_clubb, ncol, gr, wpthlp_forcing ) + rtpthlp_forcing = zt2zm_api( nzm_clubb, ncol, gr, rtpthlp_forcing ) + + ! Zero out SILHS covariance contribution terms + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, pverp + do i = 1, pcols + rtp2_mc_zt(i,k) = 0.0_r8 + thlp2_mc_zt(i,k) = 0.0_r8 + wprtp_mc_zt(i,k) = 0.0_r8 + wpthlp_mc_zt(i,k) = 0.0_r8 + rtpthlp_mc_zt(i,k) = 0.0_r8 + end do + end do + + ! Compute some inputs from the thermodynamic grid to the momentum grid + rho_ds_zm = zt2zm_api( nzm_clubb, ncol, gr, rho_ds_zt ) + rho_zm = zt2zm_api( nzm_clubb, ncol, gr, rho_zt ) + invrs_rho_ds_zm = zt2zm_api( nzm_clubb, ncol, gr, invrs_rho_ds_zt ) + thv_ds_zm = zt2zm_api( nzm_clubb, ncol, gr, thv_ds_zt ) + wm_zm = zt2zm_api( nzm_clubb, ncol, gr, wm_zt ) + + ! Surface fluxes provided by host model + !$acc parallel loop gang vector default(present) + do i=1,ncol + wpthlp_sfc(i) = cam_in%shf(i)/(cpairv(i,pver,lchnk)*rho_ds_zm(i,1)) ! Sensible heat flux + wpthlp_sfc(i) = wpthlp_sfc(i)*inv_exner_clubb_surf(i) ! Potential temperature flux + wprtp_sfc(i) = cam_in%cflx(i,1)/rho_ds_zm(i,1) ! Moisture flux + end do + + ! Implementation after Thomas Toniazzo (NorESM) and Colin Zarzycki (PSU) + ! Other Surface fluxes provided by host model + if( (cld_macmic_num_steps > 1) .and. clubb_l_intr_sfc_flux_smooth ) then + + call t_stopf('clubb_tend_cam:ACCR') + call t_startf('clubb_tend_cam:NAR') + !$acc update host( state1%u, state1%v, state1%t, state1%pmid, cam_in%wsx, cam_in%wsy, rrho ) + + ! Adjust surface stresses using winds from the prior macmic iteration + do i=1,ncol + ubar = sqrt(state1%u(i,pver)**2+state1%v(i,pver)**2) + if (ubar < 0.25_r8) ubar = 0.25_r8 + + call calc_ustar( state1%t(i,pver), state1%pmid(i,pver), cam_in%wsx(i), cam_in%wsy(i), & + rrho(i), ustar ) + + upwp_sfc(i) = -state1%u(i,pver)*ustar**2/ubar + vpwp_sfc(i) = -state1%v(i,pver)*ustar**2/ubar + end do + + !$acc update device( upwp_sfc, vpwp_sfc ) + call t_stopf('clubb_tend_cam:NAR') + call t_startf('clubb_tend_cam:ACCR') + + else + + !$acc parallel loop gang vector default(present) + do i=1,ncol + upwp_sfc(i) = cam_in%wsx(i)/rho_ds_zm(i,1) ! Surface meridional momentum flux + vpwp_sfc(i) = cam_in%wsy(i)/rho_ds_zm(i,1) ! Surface zonal momentum flux + end do + + endif + + call t_startf('clubb_tend_cam:flip-index') + + ! Need to flip arrays around for CLUBB core + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzm_clubb + do i = 1, ncol + + um_in(i,k) = um(i,pverp-k+1) + vm_in(i,k) = vm(i,pverp-k+1) + upwp_in(i,k) = upwp(i,pverp-k+1) + vpwp_in(i,k) = vpwp(i,pverp-k+1) + wpthvp_in(i,k) = wpthvp(i,pverp-k+1) + wp2thvp_in(i,k) = wp2thvp(i,pverp-k+1) + rtpthvp_in(i,k) = rtpthvp(i,pverp-k+1) + thlpthvp_in(i,k)= thlpthvp(i,pverp-k+1) + up2_in(i,k) = up2(i,pverp-k+1) + vp2_in(i,k) = vp2(i,pverp-k+1) + up3_in(i,k) = up3(i,pverp-k+1) + vp3_in(i,k) = vp3(i,pverp-k+1) + wp2_in(i,k) = wp2(i,pverp-k+1) + wp3_in(i,k) = wp3(i,pverp-k+1) + rtp2_in(i,k) = rtp2(i,pverp-k+1) + thlp2_in(i,k) = thlp2(i,pverp-k+1) + rtp3_in(i,k) = rtp3(i,pverp-k+1) + thlp3_in(i,k) = thlp3(i,pverp-k+1) + thlm_in(i,k) = thlm(i,pverp-k+1) + rtm_in(i,k) = rtm(i,pverp-k+1) + rvm_in(i,k) = rvm(i,pverp-k+1) + wprtp_in(i,k) = wprtp(i,pverp-k+1) + wpthlp_in(i,k) = wpthlp(i,pverp-k+1) + rtpthlp_in(i,k) = rtpthlp(i,pverp-k+1) + cloud_frac_inout(i,k) = cloud_frac(i,pverp-k+1) + if (k>1) then + rcm_inout(i,k) = state1%q(i,pverp-k+1,ixcldliq) + end if + + wp2rtp_inout(i,k) = wp2rtp(i,pverp-k+1) + wp2thlp_inout(i,k) = wp2thlp(i,pverp-k+1) + uprcp_inout(i,k) = uprcp(i,pverp-k+1) + vprcp_inout(i,k) = vprcp(i,pverp-k+1) + rc_coef_inout(i,k) = rc_coef(i,pverp-k+1) + wp4_inout(i,k) = wp4(i,pverp-k+1) + wpup2_inout(i,k) = wpup2(i,pverp-k+1) + wpvp2_inout(i,k) = wpvp2(i,pverp-k+1) + wp2up2_inout(i,k) = wp2up2(i,pverp-k+1) + wp2vp2_inout(i,k) = wp2vp2(i,pverp-k+1) + ice_supersat_frac_inout(i,k) = ice_supersat_frac(i,pverp-k+1) + end do + end do + + ! We only need to copy pdf_params from pbuf if this is a restart and + ! we're calling pdf_closure at the end of advance_clubb_core + if ( is_first_restart_step() & + .and. clubb_config_flags%ipdf_call_placement .eq. ipdf_post_advance_fields ) then + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzm_clubb + do i = 1, ncol + pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1(i,pverp-k+1) + pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2(i,pverp-k+1) + pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) = pdf_zm_varnce_w_1(i,pverp-k+1) + pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) = pdf_zm_varnce_w_2(i,pverp-k+1) + pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac(i,pverp-k+1) + end do + end do + end if + + !$acc parallel loop gang vector collapse(2) default(present) + do k=2, nzm_clubb + do i=1,ncol + pre_in(i,k) = prer_evap(i,pverp-k+1) + end do + end do + + !$acc parallel loop gang vector default(present) + do i=1,ncol + pre_in(i,1) = pre_in(i,2) + rcm_inout(i,1) = rcm_inout(i,2) + end do + + ! pressure,exner on momentum grid needed for mass flux calc. + if (do_clubb_mf) then + + do k=1,pver + do i=1,ncol + kappa_zt(i,k+1) = (rairv(i,pver-k+1,lchnk)/cpairv(i,pver-k+1,lchnk)) + qc_zt(i,k+1) = state1%q(i,pver-k+1,ixcldliq) + invrs_exner_zt(i,k+1) = inv_exner_clubb(i,pver-k+1) + end do + end do + + do i=1,ncol + kappa_zt(i,1) = kappa_zt(i,2) + qc_zt(i,1) = qc_zt(i,2) + invrs_exner_zt(i,1) = invrs_exner_zt(i,2) + end do + + kappa_zm(1:ncol,:) = zt2zm_api(nzm_clubb, ncol, gr, kappa_zt(1:ncol,:)) + + do k=1,pverp + do i=1,ncol + p_in_Pa_zm(i,k) = state1%pint(i,pverp-k+1) + invrs_exner_zm(i,k) = 1._r8/((p_in_Pa_zm(i,k)/p0_clubb)**(kappa_zm(i,k))) + end do + end do + + end if + + if (clubb_do_adv) then + if (macmic_it == 1) then + + wp2_in = zt2zm_api(nzm_clubb, ncol, gr, wp2_in ) + wpthlp_in = zt2zm_api(nzm_clubb, ncol, gr, wpthlp_in ) + wprtp_in = zt2zm_api(nzm_clubb, ncol, gr, wprtp_in ) + up2_in = zt2zm_api(nzm_clubb, ncol, gr, up2_in ) + vp2_in = zt2zm_api(nzm_clubb, ncol, gr, vp2_in ) + thlp2_in = zt2zm_api(nzm_clubb, ncol, gr, thlp2_in ) + rtp2_in = zt2zm_api(nzm_clubb, ncol, gr, rtp2_in ) + rtpthlp_in = zt2zm_api(nzm_clubb, ncol, gr, rtpthlp_in ) + + do k = 1, nzm_clubb + do i = 1, ncol + thlp2_in(i,k) = max(thl_tol**2,thlp2_in(i,k)) + rtp2_in(i,k) = max(rt_tol**2,rtp2_in(i,k)) + wp2_in(i,k) = max(w_tol_sqd,wp2_in(i,k)) + up2_in(i,k) = max(w_tol_sqd,up2_in(i,k)) + vp2_in(i,k) = max(w_tol_sqd,vp2_in(i,k)) + end do + end do + + end if + end if + + ! Do the same for tracers + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + + icnt = icnt+1 + + !$acc parallel loop gang vector collapse(2) default(present) + do k=1,nzt_clubb + do i=1,ncol + edsclr_in(i,k+1,icnt) = state1%q(i,pver-k+1,ixind) + end do + end do + + !$acc parallel loop gang vector default(present) + do i=1,ncol + edsclr_in(i,1,icnt) = edsclr_in(i,2,icnt) + end do + + end if + end do + + if (clubb_l_do_expldiff_rtm_thlm) then + + !$acc parallel loop gang vector collapse(2) default(present) + do k=1,nzt_clubb + do i=1, ncol + edsclr_in(i,k+1,icnt+1) = thlm(i,pver-k+1) + edsclr_in(i,k+1,icnt+2) = rtm(i,pver-k+1) + end do + end do + + !$acc parallel loop gang vector default(present) + do i=1, ncol + edsclr_in(i,1,icnt+1) = edsclr_in(i,2,icnt+1) + edsclr_in(i,1,icnt+2) = edsclr_in(i,2,icnt+2) + end do + + endif + + call t_stopf('clubb_tend_cam:flip-index') + + do t=1,nadv ! do needed number of "sub" timesteps for each CAM step + + ! Increment the statistics then begin stats timestep + if (stats_metadata%l_stats) then + call stats_begin_timestep_api( t, stats_nsamp, stats_nout, & + stats_metadata ) + endif + + !####################################################################### + !###################### CALL MF DIAGNOSTIC PLUMES ###################### + !####################################################################### + if (do_clubb_mf) then + call t_startf('clubb_tend_cam:do_clubb_mf') + + do k=2,pverp + do i=1, ncol + dzt(i,k) = zi_g(i,k) - zi_g(i,k-1) + end do + end do + + do i=1, ncol + dzt(i,1) = dzt(i,2) + invrs_dzt(i,:) = 1._r8/dzt(i,:) + end do + + rtm_zm_in(1:ncol,:) = zt2zm_api( nzm_clubb, ncol, gr, rtm_in(1:ncol,:) ) + thlm_zm_in(1:ncol,:) = zt2zm_api( nzm_clubb, ncol, gr, thlm_in(1:ncol,:) ) + + do i=1, ncol + call integrate_mf( pverp, dzt(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input + p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input + 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 + end do + + ! pass MF turbulent advection term as CLUBB explicit forcing term + do i=1, ncol + rtm_forcing(i,1) = 0._r8 + thlm_forcing(i,1)= 0._r8 + end do + + do k=2,pverp + do i=1, ncol + rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & + ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k-1) * mf_qtflx(i,k-1))) + + thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & + ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k-1) * mf_thlflx(i,k-1))) + end do + end do + call t_stopf('clubb_tend_cam:do_clubb_mf') + + end if + + ! Advance CLUBB CORE one timestep in the future + call t_startf('clubb_tend_cam:advance_clubb_core_api') + call advance_clubb_core_api( gr, nzm_clubb, ncol, & + 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, & + rtpthlp_forcing, wm_zm, wm_zt, & + wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & + wpsclrp_sfc, wpedsclrp_sfc, & + upwp_sfc_pert, vpwp_sfc_pert, & + 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, hm_metadata%l_mix_rat_hm, & + rfrzm, radf, & + wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, & + grid_dx, grid_dy, & + clubb_params, nu_vert_res_dep, lmin, & + clubb_config_flags, & + stats_metadata, & + stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & + um_in, vm_in, upwp_in, vpwp_in, up2_in, vp2_in, up3_in, vp3_in, & + thlm_in, rtm_in, wprtp_in, wpthlp_in, & + wp2_in, wp3_in, rtp2_in, rtp3_in, thlp2_in, thlp3_in, rtpthlp_in, & + sclrm, & + sclrp2, sclrp3, sclrprtp, sclrpthlp, & + wpsclrp, edsclr_in, err_code, & + rcm_inout, cloud_frac_inout, & + wpthvp_in, wp2thvp_in, rtpthvp_in, thlpthvp_in, & + sclrpthvp_inout, & + wp2rtp_inout, wp2thlp_inout, uprcp_inout, & + vprcp_inout, rc_coef_inout, & + wp4_inout, wpup2_inout, wpvp2_inout, & + wp2up2_inout, wp2vp2_inout, ice_supersat_frac_inout, & + um_pert_inout, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, & + pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), & + pdf_implicit_coefs_terms_chnk(lchnk), & + khzm_out, khzt_out, & + qclvar_out, thlprcp_out, & + wprcp_out, w_up_in_cloud_out, w_down_in_cloud_out, & + cloudy_updraft_frac_out, cloudy_downdraft_frac_out, & + rcm_in_layer_out, cloud_cover_out, invrs_tau_zm_out ) + call t_stopf('clubb_tend_cam:advance_clubb_core_api') + + ! Note that CLUBB does not produce an error code specific to any column, and + ! one value only for the entire chunk + if ( err_code == clubb_fatal_error ) then + write(fstderr,*) "Fatal error in CLUBB: at timestep ", get_nstep() + write(fstderr,*) "LAT Range: ", state1%lat(1)*rad2deg, & + " -- ", state1%lat(ncol)*rad2deg + tmp_lon1 = state1%lon(1)*rad2deg + tmp_lon1 = state1%lon(ncol)*rad2deg + if(tmp_lon1.gt.180.0_r8) tmp_lon1=tmp_lon1-360.0_r8 + if(tmp_lonN.gt.180.0_r8) tmp_lonN=tmp_lonN-360.0_r8 + write(fstderr,*) "LON: Range:", tmp_lon1, " -- ", tmp_lonN + call endrun(subr//': Fatal error in CLUBB library') + end if + + if ( do_rainturb ) then + call t_startf('clubb_tend_cam:do_rainturb') + + do k=1,nzm_clubb + do i=1,ncol + rvm_in(i,k) = rtm_in(i,k) - rcm_inout(i,k) + end do + end do + + call update_xp2_mc_api( gr, nzm_clubb, ncol, dtime, cloud_frac_inout, & + rcm_inout, rvm_in, thlm_in, wm_zt, & + exner, pre_in, pdf_params_chnk(lchnk), & + rtp2_mc_out, thlp2_mc_out, & + wprtp_mc_out, wpthlp_mc_out, & + rtpthlp_mc_out) + + do k=1,nzm_clubb + do i=1,ncol + dum1 = (1._r8 - cam_in%landfrac(i)) + + ! update turbulent moments based on rain evaporation + rtp2_in(i,k) = rtp2_in(i,k) + clubb_rnevap_effic * dum1 * rtp2_mc_out(i,k) * dtime + thlp2_in(i,k) = thlp2_in(i,k) + clubb_rnevap_effic * dum1 * thlp2_mc_out(i,k) * dtime + wprtp_in(i,k) = wprtp_in(i,k) + clubb_rnevap_effic * dum1 * wprtp_mc_out(i,k) * dtime + wpthlp_in(i,k) = wpthlp_in(i,k) + clubb_rnevap_effic * dum1 * wpthlp_mc_out(i,k) * dtime + end do + end do + + call t_stopf('clubb_tend_cam:do_rainturb') + end if + + if (do_cldcool) then + call t_startf('clubb_tend_cam:do_cldcool') + + rcm_out_zm = zt2zm_api(nzm_clubb, ncol, gr, rcm_inout ) + qrl_zm = zt2zm_api(nzm_clubb, ncol, gr, qrl_clubb ) + thlp2_rad_out(:,:) = 0._r8 + + do i=1, ncol + call calculate_thlp2_rad_api(nzm_clubb, rcm_out_zm(i,:), thlprcp_out(i,:), qrl_zm(i,:), clubb_params(i,:), & + thlp2_rad_out(i,:)) + end do + + do i=1, ncol + thlp2_in(i,:) = thlp2_in(i,:) + thlp2_rad_out(i,:) * dtime + thlp2_in(i,:) = max(thl_tol**2,thlp2_in(i,:)) + end do + call t_stopf('clubb_tend_cam:do_cldcool') + + end if + + ! Check to see if stats should be output, here stats are read into + ! output arrays to make them conformable to CAM output + if (stats_metadata%l_stats) then + call t_startf('clubb_tend_cam:stats_end_timestep_clubb') + do i=1, ncol + call stats_end_timestep_clubb(i, stats_zt(i), stats_zm(i), stats_rad_zt(i), stats_rad_zm(i), stats_sfc(i), & + out_zt, out_zm, out_radzt, out_radzm, out_sfc) + end do + call t_stopf('clubb_tend_cam:stats_end_timestep_clubb') + end if + + enddo ! end time loop + + if (clubb_do_adv) then + if (macmic_it == cld_macmic_num_steps) then + + wp2_in = zm2zt_api( nzm_clubb, ncol, gr, wp2_in ) + wpthlp_in = zm2zt_api( nzm_clubb, ncol, gr, wpthlp_in ) + wprtp_in = zm2zt_api( nzm_clubb, ncol, gr, wprtp_in ) + up2_in = zm2zt_api( nzm_clubb, ncol, gr, up2_in ) + vp2_in = zm2zt_api( nzm_clubb, ncol, gr, vp2_in ) + thlp2_in = zm2zt_api( nzm_clubb, ncol, gr, thlp2_in ) + rtp2_in = zm2zt_api( nzm_clubb, ncol, gr, rtp2_in ) + rtpthlp_in = zm2zt_api( nzm_clubb, ncol, gr, rtpthlp_in ) + + do k=1,nzm_clubb + do i=1, ncol + thlp2_in(i,k) = max(thl_tol**2, thlp2_in(i,k)) + rtp2_in(i,k) = max(rt_tol**2, rtp2_in(i,k)) + wp2_in(i,k) = max(w_tol_sqd, wp2_in(i,k)) + up2_in(i,k) = max(w_tol_sqd, up2_in(i,k)) + vp2_in(i,k) = max(w_tol_sqd, vp2_in(i,k)) + end do + end do + + end if + end if + + ! Convert RTP2 and THLP2 to thermo grid for output + rtp2_zt = zm2zt_api( nzm_clubb, ncol, gr, rtp2_in ) + thl2_zt = zm2zt_api( nzm_clubb, ncol, gr, thlp2_in ) + wp2_zt = zm2zt_api( nzm_clubb, ncol, gr, wp2_in ) + + call t_startf('clubb_tend_cam:flip-index') + + ! Arrays need to be "flipped" to CAM grid + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, nzm_clubb + do i=1, ncol + um(i,pverp-k+1) = um_in(i,k) + vm(i,pverp-k+1) = vm_in(i,k) + upwp(i,pverp-k+1) = upwp_in(i,k) + vpwp(i,pverp-k+1) = vpwp_in(i,k) + wpthvp(i,pverp-k+1) = wpthvp_in(i,k) + wp2thvp(i,pverp-k+1) = wp2thvp_in(i,k) + rtpthvp(i,pverp-k+1) = rtpthvp_in(i,k) + thlpthvp(i,pverp-k+1) = thlpthvp_in(i,k) + up2(i,pverp-k+1) = up2_in(i,k) + vp2(i,pverp-k+1) = vp2_in(i,k) + up3(i,pverp-k+1) = up3_in(i,k) + vp3(i,pverp-k+1) = vp3_in(i,k) + thlm(i,pverp-k+1) = thlm_in(i,k) + rtm(i,pverp-k+1) = rtm_in(i,k) + wprtp(i,pverp-k+1) = wprtp_in(i,k) + wpthlp(i,pverp-k+1) = wpthlp_in(i,k) + wp2(i,pverp-k+1) = wp2_in(i,k) + wp3(i,pverp-k+1) = wp3_in(i,k) + rtp2(i,pverp-k+1) = rtp2_in(i,k) + thlp2(i,pverp-k+1) = thlp2_in(i,k) + rtp3(i,pverp-k+1) = rtp3_in(i,k) + thlp3(i,pverp-k+1) = thlp3_in(i,k) + rtpthlp(i,pverp-k+1) = rtpthlp_in(i,k) + rcm(i,pverp-k+1) = rcm_inout(i,k) + wprcp(i,pverp-k+1) = wprcp_out(i,k) + cloud_frac(i,pverp-k+1) = min(cloud_frac_inout(i,k),1._r8) + pdf_zm_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_1(i,k) + pdf_zm_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_2(i,k) + pdf_zm_varnce_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) + pdf_zm_varnce_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) + pdf_zm_mixt_frac(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) + rcm_in_layer(i,pverp-k+1) = rcm_in_layer_out(i,k) + cloud_cover(i,pverp-k+1) = min(cloud_cover_out(i,k),1._r8) + zt_out(i,pverp-k+1) = zt_g(i,k) + zi_out(i,pverp-k+1) = zi_g(i,k) + khzm(i,pverp-k+1) = khzm_out(i,k) + qclvar(i,pverp-k+1) = min(1._r8,qclvar_out(i,k)) + wm_zt_out(i,pverp-k+1) = wm_zt(i,k) + wp2rtp(i,pverp-k+1) = wp2rtp_inout(i,k) + wp2thlp(i,pverp-k+1) = wp2thlp_inout(i,k) + uprcp(i,pverp-k+1) = uprcp_inout(i,k) + vprcp(i,pverp-k+1) = vprcp_inout(i,k) + rc_coef(i,pverp-k+1) = rc_coef_inout(i,k) + wp4(i,pverp-k+1) = wp4_inout(i,k) + wpup2(i,pverp-k+1) = wpup2_inout(i,k) + wpvp2(i,pverp-k+1) = wpvp2_inout(i,k) + wp2up2(i,pverp-k+1) = wp2up2_inout(i,k) + wp2vp2(i,pverp-k+1) = wp2vp2_inout(i,k) + ice_supersat_frac(i,pverp-k+1) = ice_supersat_frac_inout(i,k) + + rtp2_zt_out(i,pverp-k+1) = rtp2_zt(i,k) + thl2_zt_out(i,pverp-k+1) = thl2_zt(i,k) + wp2_zt_out(i,pverp-k+1) = wp2_zt(i,k) + + end do + end do + + if ( edsclr_dim > 0 ) then + !$acc parallel loop gang vector collapse(3) default(present) + do ixind=1,edsclr_dim + do k=1, nzm_clubb + do i=1, ncol + edsclr_out(i,pverp-k+1,ixind) = edsclr_in(i,k,ixind) + end do + end do + end do + end if + + if (do_clubb_mf) then + do k=1, nzm_clubb + do i=1, ncol + mf_dry_a_output(i,pverp-k+1) = mf_dry_a(i,k) + mf_moist_a_output(i,pverp-k+1) = mf_moist_a(i,k) + mf_dry_w_output(i,pverp-k+1) = mf_dry_w(i,k) + mf_moist_w_output(i,pverp-k+1) = mf_moist_w(i,k) + mf_dry_qt_output(i,pverp-k+1) = mf_dry_qt(i,k) + mf_moist_qt_output(i,pverp-k+1) = mf_moist_qt(i,k) + mf_dry_thl_output(i,pverp-k+1) = mf_dry_thl(i,k) + mf_moist_thl_output(i,pverp-k+1) = mf_moist_thl(i,k) + mf_dry_u_output(i,pverp-k+1) = mf_dry_u(i,k) + mf_moist_u_output(i,pverp-k+1) = mf_moist_u(i,k) + mf_dry_v_output(i,pverp-k+1) = mf_dry_v(i,k) + mf_moist_v_output(i,pverp-k+1) = mf_moist_v(i,k) + mf_moist_qc_output(i,pverp-k+1) = mf_moist_qc(i,k) + mf_thlflx_output(i,pverp-k+1) = mf_thlflx(i,k) + mf_qtflx_output(i,pverp-k+1) = mf_qtflx(i,k) + s_ae_output(i,pverp-k+1) = s_ae(i,k) + s_aw_output(i,pverp-k+1) = s_aw(i,k) + s_awthl_output(i,pverp-k+1) = s_awthl(i,k) + s_awqt_output(i,pverp-k+1) = s_awqt(i,k) + s_awql_output(i,pverp-k+1) = s_awql(i,k) + s_awqi_output(i,pverp-k+1) = s_awqi(i,k) + s_awu_output(i,pverp-k+1) = s_awu(i,k) + s_awv_output(i,pverp-k+1) = s_awv(i,k) + mf_thlflx_output(i,pverp-k+1) = mf_thlflx(i,k) + mf_qtflx_output(i,pverp-k+1) = mf_qtflx(i,k) + end do + end do + end if + + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, nzm_clubb + do i=1, ncol + + mean_rt = pdf_params_chnk(lchnk)%mixt_frac(i,k) & + * pdf_params_chnk(lchnk)%rt_1(i,k) & + + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & + * pdf_params_chnk(lchnk)%rt_2(i,k) + + pdfp_rtp2(i,pverp-k+1) = pdf_params_chnk(lchnk)%mixt_frac(i,k) & + * ( ( pdf_params_chnk(lchnk)%rt_1(i,k) - mean_rt )**2 & + + pdf_params_chnk(lchnk)%varnce_rt_1(i,k) ) & + + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & + * ( ( pdf_params_chnk(lchnk)%rt_2(i,k) - mean_rt )**2 & + + pdf_params_chnk(lchnk)%varnce_rt_2(i,k) ) + end do + end do + + call t_stopf('clubb_tend_cam:flip-index') + + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, pverp + do i=1, ncol + + ! Accumulate vars through macmic subcycle + upwp_clubb_gw_mc(i,k) = upwp_clubb_gw_mc(i,k) + upwp(i,k) + vpwp_clubb_gw_mc(i,k) = vpwp_clubb_gw_mc(i,k) + vpwp(i,k) + thlp2_clubb_gw_mc(i,k) = thlp2_clubb_gw_mc(i,k) + thlp2(i,k) + wpthlp_clubb_gw_mc(i,k) = wpthlp_clubb_gw_mc(i,k) + wpthlp(i,k) + + ! And average at last macmic step + if (macmic_it == cld_macmic_num_steps) then + upwp_clubb_gw(i,k) = upwp_clubb_gw_mc(i,k)/REAL(cld_macmic_num_steps,r8) + vpwp_clubb_gw(i,k) = vpwp_clubb_gw_mc(i,k)/REAL(cld_macmic_num_steps,r8) + thlp2_clubb_gw(i,k) = thlp2_clubb_gw_mc(i,k)/REAL(cld_macmic_num_steps,r8) + wpthlp_clubb_gw(i,k) = wpthlp_clubb_gw_mc(i,k)/REAL(cld_macmic_num_steps,r8) + end if + + end do + end do + + ! Values to use above top_lev, for variables that have not already been + ! set up there. These are mostly fill values that should not actually be + ! used in the run, but may end up in diagnostic output. + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, top_lev-1 + do i=1, ncol + upwp(i,k) = 0._r8 + vpwp(i,k) = 0._r8 + rcm(i,k) = 0._r8 + wprcp(i,k) = 0._r8 + cloud_frac(i,k) = 0._r8 + rcm_in_layer(i,k) = 0._r8 + zt_out(i,k) = 0._r8 + zi_out(i,k) = 0._r8 + khzm(i,k) = 0._r8 + qclvar(i,k) = 2._r8 + end do + end do + + ! Fill up arrays needed for McICA. Note we do not want the ghost point, + ! thus why the second loop is needed. + !$acc parallel loop gang vector default(present) + do i=1, pcols + zi_out(i,1) = 0._r8 + end do + + ! enforce zero tracer tendencies above the top_lev level -- no change + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + icnt=icnt+1 + + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, top_lev-1 + do i=1, ncol + edsclr_out(i,k,icnt) = state1%q(i,k,ixind) + end do + end do + + end if + end do + + ! Compute static energy using CLUBB's variables + !$acc parallel loop gang vector collapse(2) default(present) + do k=1,pver + do i=1, ncol + clubb_s(i,k) = cpairv(i,k,lchnk) * thlm(i,k) / inv_exner_clubb(i,k) & + + latvap * rcm(i,k) & + + gravit * state1%zm(i,k) + state1%phis(i) + end do + end do + + ! Section below is concentrated on energy fixing for conservation. + ! because CLUBB and CAM's thermodynamic variables are different. + + ! Initialize clubbtop to top_lev, for finding the highlest level CLUBB is + ! active for informing where to apply the energy fixer. + !$acc parallel loop gang vector default(present) + do i=1, ncol + clubbtop(i) = top_lev + do while ((rtp2(i,clubbtop(i)) <= 1.e-15_r8 .and. rcm(i,clubbtop(i)) == 0._r8) .and. clubbtop(i) < pver) + clubbtop(i) = clubbtop(i) + 1 + end do + end do + + !$acc parallel loop gang vector default(present) + do i=1, ncol + + se_a = 0._r8 + ke_a = 0._r8 + wv_a = 0._r8 + wl_a = 0._r8 + + se_b = 0._r8 + ke_b = 0._r8 + wv_b = 0._r8 + wl_b = 0._r8 + + do k=1,pver + ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water + ! after CLUBB is called. This is for energy conservation purposes. + se_a = se_a + clubb_s(i,k)*state1%pdel(i,k)*rga + ke_a = ke_a + 0.5_r8*(um(i,k)**2+vm(i,k)**2)*state1%pdel(i,k)*rga + wv_a = wv_a + (rtm(i,k)-rcm(i,k))*state1%pdeldry(i,k)*rga + wl_a = wl_a + (rcm(i,k))*state1%pdeldry(i,k)*rga + end do + + ! Based on these integrals, compute the total energy after CLUBB call + te_a = se_a + ke_a + (latvap+latice) * wv_a + latice * wl_a + + do k=1, pver + ! Do the same as above, but for before CLUBB was called. + se_b = se_b + state1%s(i,k)*state1%pdel(i,k)*rga + ke_b = ke_b + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)*rga + wv_b = wv_b + state1%q(i,k,ixq)*state1%pdeldry(i,k)*rga + wl_b = wl_b + state1%q(i,k,ixcldliq)*state1%pdeldry(i,k)*rga + end do + + ! Based on these integrals, compute the total energy before CLUBB call + te_b = se_b + ke_b + (latvap+latice) * wv_b + latice * wl_b + + ! Take into account the surface fluxes of heat and moisture + ! Use correct qflux from cam_in, not lhf/latvap as was done previously + te_b = te_b + (cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice)) * hdtime + + ! Compute the disbalance of total energy, over depth where CLUBB is active + se_dis(i) = ( te_a - te_b ) / ( state1%pint(i,pverp) - state1%pint(i,clubbtop(i)) ) + + eleak(i) = ( te_a - te_b ) / hdtime + + end do + + ! Fix the total energy coming out of CLUBB so it achieves energy conservation. + ! Apply this fixer throughout the column evenly, but only at layers where + ! CLUBB is active. + ! + ! NOTE: The energy fixer seems to cause the climate to change significantly + ! when using specified dynamics, so allow this to be turned off via a namelist + ! variable. + if (clubb_do_energyfix) then + + !$acc parallel loop gang vector default(present) + do i=1, ncol + + do k=clubbtop(i),pver + clubb_s(i,k) = clubb_s(i,k) - se_dis(i)*gravit + end do + ! convert to units of +ve [K] + se_dis(i) = -1._r8*se_dis(i)*gravit/cpairv(i,pver,lchnk) + + end do + + endif + + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, pverp + do i=1, ncol + wpthvp_clubb(i,k) = wpthvp(i,k) * cpair + wprcp_clubb(i,k) = wprcp(i,k) * latvap + end do + end do + + call t_stopf('clubb_tend_cam:ACCR') + + call t_startf('clubb_tend_cam:acc_copyout') + !$acc end data + !$acc end data + !$acc end data + !$acc end data + !$acc end data + call t_stopf('clubb_tend_cam:acc_copyout') + + call t_startf('clubb_tend_cam:NAR') + + + call physics_ptend_init( ptend_loc, state%psetcols, 'clubb', ls=.true., lu=.true., lv=.true., lq=lq ) + + ! Now compute the tendencies of CLUBB to CAM, note that pverp is the ghost point + ! for all variables and therefore is never called in this loop + do i=1, ncol + + rtm_integral_vtend(i) = 0._r8 + rtm_integral_ltend(i) = 0._r8 + + do k=1, pver + + 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) - endif + end do - ! Apply tendencies to ice mixing ratio, liquid and ice number, and aerosol constituents. - ! Loading up this array doesn't mean the tendencies are applied. - ! edsclr_out is compressed with just the constituents being used, ptend and state are not compressed - - icnt=0 - do ixind=1,pcnst - if (lq(ixind)) then - icnt=icnt+1 - if ((ixind /= ixq) .and. (ixind /= ixcldliq) .and.& - (ixind /= ixthlp2) .and. (ixind /= ixrtp2) .and.& - (ixind /= ixrtpthlp) .and. (ixind /= ixwpthlp) .and.& - (ixind /= ixwprtp) .and. (ixind /= ixwp2) .and.& - (ixind /= ixwp3) .and. (ixind /= ixup2) .and. (ixind /= ixvp2) ) then - ptend_loc%q(i,k,ixind) = (edsclr_out(k,icnt)-state1%q(i,k,ixind))/hdtime ! transported constituents - end if - end if - enddo + rtm_integral_ltend(i) = rtm_integral_ltend(i)/gravit + rtm_integral_vtend(i) = rtm_integral_vtend(i)/gravit - enddo - + end do - enddo ! end column loop + ! Accumulate Air Temperature Tendency (TTEND) for Gravity Wave parameterization + do k=1, pver + do i=1, ncol + ttend_clubb_mc(i,k) = ttend_clubb_mc(i,k) + ptend_loc%s(i,k)/cpair - call outfld('KVH_CLUBB', khzm, pcols, lchnk) + ! Average at last macmic step + if (macmic_it == cld_macmic_num_steps) then + ttend_clubb(i,k) = ttend_clubb_mc(i,k) / REAL(cld_macmic_num_steps,r8) + end if - ! Add constant to ghost point so that output is not corrupted - if (clubb_do_adv) then + end do + end do + + if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then - wp3(:,pverp) = wp3(:,pverp) + wp3_const - rtpthlp(:,pverp) = rtpthlp(:,pverp) + rtpthlp_const - wpthlp(:,pverp) = wpthlp(:,pverp) + wpthlp_const - wprtp(:,pverp) = wprtp(:,pverp) + wprtp_const - endif - endif - - cmeliq(:,:) = ptend_loc%q(:,:,ixcldliq) - - ! ------------------------------------------------- ! - ! End column computation of CLUBB, begin to apply ! - ! and compute output, etc ! - ! ------------------------------------------------- ! - - ! Output CLUBB tendencies - call outfld( 'RVMTEND_CLUBB', ptend_loc%q(:,:,ixq), pcols, lchnk) - call outfld( 'RCMTEND_CLUBB', ptend_loc%q(:,:,ixcldliq), pcols, lchnk) - call outfld( 'RIMTEND_CLUBB', ptend_loc%q(:,:,ixcldice), pcols, lchnk) - call outfld( 'STEND_CLUBB', ptend_loc%s,pcols, lchnk) - call outfld( 'UTEND_CLUBB', ptend_loc%u,pcols, lchnk) - call outfld( 'VTEND_CLUBB', ptend_loc%v,pcols, lchnk) - - call outfld( 'CMELIQ', cmeliq, pcols, lchnk) - - call physics_ptend_sum(ptend_loc,ptend_all,ncol) - call physics_update(state1,ptend_loc,hdtime) - - ! Due to the order of operation of CLUBB, which closes on liquid first, - ! then advances it's predictive equations second, this can lead to - ! RHliq > 1 directly before microphysics is called. Therefore, we use - ! ice_macro_tend to enforce RHliq <= 1 everywhere before microphysics is called. - + + do k=1, pver + do i=1, ncol + + ! Here add a constant to moments which can be either positive or + ! negative. This is to prevent clipping when dynamics tries to + ! make all constituents positive + wp3(i,k) = wp3(i,k) + wp3_const + rtpthlp(i,k) = rtpthlp(i,k) + rtpthlp_const + wpthlp(i,k) = wpthlp(i,k) + wpthlp_const + wprtp(i,k) = wprtp(i,k) + wprtp_const + + ptend_loc%q(i,k,ixthlp2) = (thlp2(i,k) - state1%q(i,k,ixthlp2)) / hdtime ! THLP Variance + ptend_loc%q(i,k,ixrtp2) = (rtp2(i,k) - state1%q(i,k,ixrtp2)) / hdtime ! RTP Variance + ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp(i,k) - state1%q(i,k,ixrtpthlp)) / hdtime ! RTP THLP covariance + ptend_loc%q(i,k,ixwpthlp) = (wpthlp(i,k) - state1%q(i,k,ixwpthlp)) / hdtime ! WPTHLP + ptend_loc%q(i,k,ixwprtp) = (wprtp(i,k) - state1%q(i,k,ixwprtp)) / hdtime ! WPRTP + ptend_loc%q(i,k,ixwp2) = (wp2(i,k) - state1%q(i,k,ixwp2)) / hdtime ! WP2 + ptend_loc%q(i,k,ixwp3) = (wp3(i,k) - state1%q(i,k,ixwp3)) / hdtime ! WP3 + ptend_loc%q(i,k,ixup2) = (up2(i,k) - state1%q(i,k,ixup2)) / hdtime ! UP2 + ptend_loc%q(i,k,ixvp2) = (vp2(i,k) - state1%q(i,k,ixvp2)) / hdtime ! VP2 + + end do + end do + + ! Add constant to ghost point so that output is not corrupted + wp3(:,pverp) = wp3(:,pverp) + wp3_const + rtpthlp(:,pverp) = rtpthlp(:,pverp) + rtpthlp_const + wpthlp(:,pverp) = wpthlp(:,pverp) + wpthlp_const + wprtp(:,pverp) = wprtp(:,pverp) + wprtp_const + + else + + do k=1, pver + do i=1, ncol + ptend_loc%q(i,k,ixthlp2) = 0._r8 + ptend_loc%q(i,k,ixrtp2) = 0._r8 + ptend_loc%q(i,k,ixrtpthlp) = 0._r8 + ptend_loc%q(i,k,ixwpthlp) = 0._r8 + ptend_loc%q(i,k,ixwprtp) = 0._r8 + ptend_loc%q(i,k,ixwp2) = 0._r8 + ptend_loc%q(i,k,ixwp3) = 0._r8 + ptend_loc%q(i,k,ixup2) = 0._r8 + ptend_loc%q(i,k,ixvp2) = 0._r8 + end do + end do + + end if + end if + + + ! Apply tendencies to ice mixing ratio, liquid and ice number, and aerosol constituents. + ! Loading up this array doesn't mean the tendencies are applied. + ! edsclr_out is compressed with just the constituents being used, ptend and state are not compressed + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + icnt=icnt+1 + if ((ixind /= ixq) .and. (ixind /= ixcldliq) .and.& + (ixind /= ixthlp2) .and. (ixind /= ixrtp2) .and.& + (ixind /= ixrtpthlp) .and. (ixind /= ixwpthlp) .and.& + (ixind /= ixwprtp) .and. (ixind /= ixwp2) .and.& + (ixind /= ixwp3) .and. (ixind /= ixup2) .and. (ixind /= ixvp2) ) then + + do k=1, pver + do i=1, ncol + ptend_loc%q(i,k,ixind) = (edsclr_out(i,k,icnt)-state1%q(i,k,ixind))/hdtime ! transported constituents + end do + end do + + end if + end if + end do + + rvmtend_clubb(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + rcmtend_clubb(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + rimtend_clubb(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + stend_clubb(:ncol,:pver) = ptend_loc%s(:ncol,:pver) + utend_clubb(:ncol,:pver) = ptend_loc%u(:ncol,:pver) + vtend_clubb(:ncol,:pver) = ptend_loc%v(:ncol,:pver) + cmeliq(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + + ! + ! set pbuf field so that HB scheme is only applied above CLUBB top + ! + if (do_hb_above_clubb) then + call pbuf_set_field(pbuf, clubbtop_idx, clubbtop) + endif + + ! ------------------------------------------------- ! + ! End column computation of CLUBB, begin to apply ! + ! and compute output, etc ! + ! ------------------------------------------------- ! + + call physics_ptend_sum(ptend_loc,ptend_all,ncol) + call physics_update(state1,ptend_loc,hdtime) + + ! Due to the order of operation of CLUBB, which closes on liquid first, + ! then advances it's predictive equations second, this can lead to + ! RHliq > 1 directly before microphysics is called. Therefore, we use + ! ice_macro_tend to enforce RHliq <= 1 everywhere before microphysics is called. + if (clubb_do_liqsupersat) then - + + call t_startf('clubb_cam_tend:do_liqsupersat') ! -------------------------------------- ! ! Ice Saturation Adjustment Computation ! ! -------------------------------------- ! - + latsub = latvap + latice lq2(:) = .FALSE. lq2(ixq) = .TRUE. lq2(ixcldliq) = .TRUE. lq2(ixnumliq) = .TRUE. - + call physics_ptend_init(ptend_loc, state%psetcols, 'iceadj', ls=.true., lq=lq2 ) - + stend(:ncol,:)=0._r8 qvtend(:ncol,:)=0._r8 qctend(:ncol,:)=0._r8 inctend(:ncol,:)=0._r8 - - call liquid_macro_tend(npccn(:ncol,top_lev:pver),state1%t(:ncol,top_lev:pver), & - state1%pmid(:ncol,top_lev:pver),state1%q(:ncol,top_lev:pver,ixq),state1%q(:ncol,top_lev:pver,ixcldliq),& - state1%q(:ncol,top_lev:pver,ixnumliq),latvap,hdtime,& - stend(:ncol,top_lev:pver),qvtend(:ncol,top_lev:pver),qctend(:ncol,top_lev:pver),& - inctend(:ncol,top_lev:pver)) - + + call liquid_macro_tend(npccn(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & + state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,ixq), & + state1%q(1:ncol,top_lev:pver,ixcldliq), state1%q(1:ncol,top_lev:pver,ixnumliq), & + latvap, hdtime, stend(1:ncol,top_lev:pver),qvtend(1:ncol,top_lev:pver), & + qctend(1:ncol,top_lev:pver), inctend(1:ncol,top_lev:pver), ncol*(pver-top_lev+1)) + ! update local copy of state with the tendencies ptend_loc%q(:ncol,top_lev:pver,ixq)=qvtend(:ncol,top_lev:pver) ptend_loc%q(:ncol,top_lev:pver,ixcldliq)=qctend(:ncol,top_lev:pver) ptend_loc%q(:ncol,top_lev:pver,ixnumliq)=inctend(:ncol,top_lev:pver) ptend_loc%s(:ncol,top_lev:pver)=stend(:ncol,top_lev:pver) - + ! Add the ice tendency to the output tendency call physics_ptend_sum(ptend_loc, ptend_all, ncol) - + ! ptend_loc is reset to zero by this call call physics_update(state1, ptend_loc, hdtime) - + ! Write output for tendencies: ! oufld: QVTENDICE,QCTENDICE,NCTENDICE,FQTENDICE temp2d(:ncol,:pver) = stend(:ncol,:pver)/cpairv(:ncol,:pver,lchnk) @@ -3028,254 +4401,244 @@ subroutine clubb_tend_cam( & call outfld( 'QVTENDICE', qvtend, pcols, lchnk ) call outfld( 'QCTENDICE', qctend, pcols, lchnk ) call outfld( 'NCTENDICE', inctend, pcols, lchnk ) - + where(qctend .ne. 0._r8) fqtend = 1._r8 elsewhere fqtend = 0._r8 end where - + call outfld( 'FQTENDICE', fqtend, pcols, lchnk ) - end if - - ! ------------------------------------------------------------ ! - ! ------------------------------------------------------------ ! - ! ------------------------------------------------------------ ! - ! The rest of the code deals with diagnosing variables ! - ! for microphysics/radiation computation and macrophysics ! - ! ------------------------------------------------------------ ! - ! ------------------------------------------------------------ ! - ! ------------------------------------------------------------ ! - - - ! --------------------------------------------------------------------------------- ! - ! COMPUTE THE ICE CLOUD DETRAINMENT ! - ! Detrainment of convective condensate into the environment or stratiform cloud ! - ! --------------------------------------------------------------------------------- ! - - ! Initialize the shallow convective detrainment rate, will always be zero - dlf2(:,:) = 0.0_r8 - dlf_liq_out(:,:) = 0.0_r8 - dlf_ice_out(:,:) = 0.0_r8 - - lqice(:) = .false. - lqice(ixcldliq) = .true. - lqice(ixcldice) = .true. - lqice(ixnumliq) = .true. - lqice(ixnumice) = .true. - - call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lq=lqice) - - if (zmconv_microp) then - call pbuf_get_field(pbuf, dlfzm_idx, dlfzm) - call pbuf_get_field(pbuf, difzm_idx, difzm) - call pbuf_get_field(pbuf, dnlfzm_idx, dnlfzm) - call pbuf_get_field(pbuf, dnifzm_idx, dnifzm) - end if - - do k=1,pver + call t_stopf('clubb_cam_tend:do_liqsupersat') + end if + + ! ------------------------------------------------------------ ! + ! The rest of the code deals with diagnosing variables ! + ! for microphysics/radiation computation and macrophysics ! + ! ------------------------------------------------------------ ! + + ! --------------------------------------------------------------------------------- ! + ! COMPUTE THE ICE CLOUD DETRAINMENT ! + ! Detrainment of convective condensate into the environment or stratiform cloud ! + ! --------------------------------------------------------------------------------- ! + + ! Initialize the shallow convective detrainment rate, will always be zero + dlf2(:,:) = 0.0_r8 + dlf_liq_out(:,:) = 0.0_r8 + dlf_ice_out(:,:) = 0.0_r8 + + lqice(:) = .false. + lqice(ixcldliq) = .true. + lqice(ixcldice) = .true. + lqice(ixnumliq) = .true. + lqice(ixnumice) = .true. + + call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lq=lqice) + + do k=1,pver do i=1,ncol - if( state1%t(i,k) > 268.15_r8 ) then - dum1 = 0.0_r8 - elseif ( state1%t(i,k) < 238.15_r8 ) then - dum1 = 1.0_r8 - else - dum1 = ( 268.15_r8 - state1%t(i,k) ) / 30._r8 - endif - if (zmconv_microp) then - ptend_loc%q(i,k,ixcldliq) = dlfzm(i,k) + dlf2(i,k) * ( 1._r8 - dum1 ) - ptend_loc%q(i,k,ixcldice) = difzm(i,k) + dlf2(i,k) * dum1 - - ptend_loc%q(i,k,ixnumliq) = dnlfzm(i,k) + 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) & - / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection - ptend_loc%q(i,k,ixnumice) = dnifzm(i,k) + 3._r8 * ( dlf2(i,k) * dum1 ) & - / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection - ptend_loc%s(i,k) = dlf2(i,k) * dum1 * latice - else - - ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 ) - ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1 - ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) & - / (4._r8*3.14_r8* 8.e-6_r8**3*997._r8) + & ! Deep Convection - 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) & - / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection - ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) & - / (4._r8*3.14_r8*25.e-6_r8**3*500._r8) + & ! Deep Convection - 3._r8 * ( dlf2(i,k) * dum1 ) & - / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection - ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice - - dlf_liq_out(i,k) = dlf(i,k) * ( 1._r8 - dum1 ) - dlf_ice_out(i,k) = dlf(i,k) * dum1 - end if + if( state1%t(i,k) > meltpt_temp ) then + dum1 = 0.0_r8 + elseif ( state1%t(i,k) < dt_low ) then + dum1 = 1.0_r8 + else + dum1 = ( meltpt_temp - state1%t(i,k) ) / ( meltpt_temp - dt_low ) + endif - ! Only rliq is saved from deep convection, which is the reserved liquid. We need to keep - ! track of the integrals of ice and static energy that is effected from conversion to ice - ! so that the energy checker doesn't complain. - det_s(i) = det_s(i) + ptend_loc%s(i,k)*state1%pdel(i,k)/gravit - det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state1%pdel(i,k)/gravit - + ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 ) + ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1 + ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) & + / (4._r8*3.14_r8*dl_rad**3*997._r8) + & ! Deep Convection + 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) & + / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection + ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) & + / (4._r8*3.14_r8*di_rad**3*500._r8) + & ! Deep Convection + 3._r8 * ( dlf2(i,k) * dum1 ) & + / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection + ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice + + dlf_liq_out(i,k) = dlf(i,k) * ( 1._r8 - dum1 ) + dlf_ice_out(i,k) = dlf(i,k) * dum1 + + ! convert moist dlf tendencies to dry + ptend_loc%q(i,k,ixcldliq) = ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k)/state1%pdeldry(i,k) + ptend_loc%q(i,k,ixcldice) = ptend_loc%q(i,k,ixcldice)*state1%pdel(i,k)/state1%pdeldry(i,k) + + ! Only rliq is saved from deep convection, which is the reserved liquid. We need to keep + ! track of the integrals of ice and static energy that is effected from conversion to ice + ! so that the energy checker doesn't complain. + det_s(i) = det_s(i) + ptend_loc%s(i,k)*state1%pdel(i,k)*rga + det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state1%pdeldry(i,k)*rga enddo - enddo - - det_ice(:ncol) = det_ice(:ncol)/1000._r8 ! divide by density of water - - call outfld( 'DPDLFLIQ', ptend_loc%q(:,:,ixcldliq), pcols, lchnk) - call outfld( 'DPDLFICE', ptend_loc%q(:,:,ixcldice), pcols, lchnk) - - temp2d(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpairv(:ncol,:pver, lchnk) - call outfld( 'DPDLFT', temp2d, pcols, lchnk) - - call outfld( 'DETNLIQTND', ptend_loc%q(:,:,ixnumliq),pcols, lchnk ) - - call physics_ptend_sum(ptend_loc,ptend_all,ncol) - call physics_update(state1,ptend_loc,hdtime) - - ! ptend_all now has all accumulated tendencies. Convert the tendencies for the - ! dry constituents to dry air basis. - do ixind = 1, pcnst - if (lq(ixind) .and. cnst_type(ixind) == 'dry') then - do k = 1, pver - do i = 1, ncol - ptend_all%q(i,k,ixind) = ptend_all%q(i,k,ixind)*state1%pdel(i,k)/state1%pdeldry(i,k) - end do - end do + enddo + + det_ice(:ncol) = det_ice(:ncol)/1000._r8 ! divide by density of water + dpdlfliq(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + dpdlfice(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + dpdlft(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpairv(:ncol,:pver, lchnk) + detnliquid(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixnumliq) + + call physics_ptend_sum(ptend_loc,ptend_all,ncol) + call physics_update(state1,ptend_loc,hdtime) + + ! ptend_all now has all accumulated tendencies. Convert the tendencies for the + ! wet constituents to wet air basis. + do ixind = 1, pcnst + if (lq(ixind) .and. cnst_type(ixind) == 'wet') then + do k = 1, pver + do i = 1, ncol + ptend_all%q(i,k,ixind) = ptend_all%q(i,k,ixind)*state1%pdeldry(i,k)/state1%pdel(i,k) + end do + end do end if - end do + end do - ! ------------------------------------------------- ! - ! Diagnose relative cloud water variance ! - ! ------------------------------------------------- ! + ! ------------------------------------------------- ! + ! Diagnose relative cloud water variance ! + ! ------------------------------------------------- ! - if (deep_scheme == 'CLUBB_SGS') then + if (deep_scheme == 'CLUBB_SGS') then relvarmax = 2.0_r8 - else + else relvarmax = 10.0_r8 - endif - - relvar(:,:) = relvarmax ! default - - if (deep_scheme .ne. 'CLUBB_SGS') then - where (rcm(:ncol,:pver) /= 0 .and. qclvar(:ncol,:pver) /= 0) & - relvar(:ncol,:pver) = min(relvarmax,max(0.001_r8,rcm(:ncol,:pver)**2/qclvar(:ncol,:pver))) - endif - - ! ------------------------------------------------- ! - ! Optional Accretion enhancement factor ! - ! ------------------------------------------------- ! + endif + + do i = 1, ncol + do k = 1, pver + relvar(i,k) = relvarmax ! default + end do + end do + + if (deep_scheme .ne. 'CLUBB_SGS') then + do i = 1, ncol + do k = 1, pver + if ( rcm(i,k) /= 0 .and. qclvar(i,k) /= 0 ) then + relvar(i,k) = min( relvarmax, max(0.001_r8, rcm(i,k)**2 / qclvar(i,k) ) ) + end if + end do + end do + endif + ! ------------------------------------------------- ! + ! Optional Accretion enhancement factor ! + ! ------------------------------------------------- ! accre_enhan(:ncol,:pver) = 1._r8 - - ! ------------------------------------------------- ! - ! Diagnose some output variables ! - ! ------------------------------------------------- ! - ! density - rho(:ncol,1:pver) = state1%pmid(:ncol,1:pver)/(rairv(:ncol,1:pver,lchnk)*state1%t(:ncol,1:pver)) - rho(:ncol,pverp) = state1%ps(:ncol)/(rairv(:ncol,pver,lchnk)*state1%t(:ncol,pver)) + ! ------------------------------------------------- ! + ! Diagnose some output variables ! + ! ------------------------------------------------- ! - wpthvp_diag(:,:) = 0.0_r8 - do k=1,pver + ! density + rho(1:ncol,1:pver) = rga*state1%pdel(1:ncol,1:pver)/(state1%zi(1:ncol,1:pver)-state1%zi(1:ncol,2:pverp)) + rho(1:ncol,pverp) = rho(1:ncol,pver) + + wpthvp_diag(:,:) = 0.0_r8 + do k=1,pver do i=1,ncol - eps = rairv(i,k,lchnk)/rh2o - ! buoyancy flux - wpthvp_diag(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))+((1._r8-eps)/eps)*theta0* & + eps = rairv(i,k,lchnk)*inv_rh2o + ! buoyancy flux + wpthvp_diag(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))+((1._r8-eps)/eps)*theta0* & (wprtp(i,k)-(apply_const*wprtp_const))+((latvap/cpairv(i,k,lchnk))* & state1%exner(i,k)-(1._r8/eps)*theta0)*wprcp(i,k) - ! total water mixing ratio - qt_output(i,k) = state1%q(i,k,ixq)+state1%q(i,k,ixcldliq)+state1%q(i,k,ixcldice) - ! liquid water potential temperature - thetal_output(i,k) = (state1%t(i,k)*state1%exner(i,k))-(latvap/cpairv(i,k,lchnk))*state1%q(i,k,ixcldliq) - ! liquid water static energy - sl_output(i,k) = cpairv(i,k,lchnk)*state1%t(i,k)+gravit*state1%zm(i,k)-latvap*state1%q(i,k,ixcldliq) + ! total water mixing ratio + qt_output(i,k) = state1%q(i,k,ixq)+state1%q(i,k,ixcldliq)+state1%q(i,k,ixcldice) + ! liquid water potential temperature + thetal_output(i,k) = (state1%t(i,k)*state1%exner(i,k))-(latvap/cpairv(i,k,lchnk))*state1%q(i,k,ixcldliq) + ! liquid water static energy + sl_output(i,k) = cpairv(i,k,lchnk)*state1%t(i,k)+gravit*state1%zm(i,k)-latvap*state1%q(i,k,ixcldliq) enddo - enddo - - do k=1,pverp + enddo + + do k=1,pverp do i=1,ncol - wpthlp_output(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux - wprtp_output(i,k) = (wprtp(i,k)-(apply_const*wprtp_const))*rho(i,k)*latvap ! total water mixig ratio flux - rtpthlp_output(i,k) = rtpthlp(i,k)-(apply_const*rtpthlp_const) ! rtpthlp output - wp3_output(i,k) = wp3(i,k) - (apply_const*wp3_const) ! wp3 output - tke(i,k) = 0.5_r8*(up2(i,k)+vp2(i,k)+wp2(i,k)) ! turbulent kinetic energy - if (do_clubb_mf) then - mf_thlflx_output(i,k) = mf_thlflx_output(i,k)*rho(i,k)*cpair - mf_qtflx_output(i,k) = mf_qtflx_output(i,k)*rho(i,k)*latvap - end if + wpthlp_output(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux + wprtp_output(i,k) = (wprtp(i,k)-(apply_const*wprtp_const))*rho(i,k)*latvap ! total water mixig ratio flux + rtpthlp_output(i,k) = rtpthlp(i,k)-(apply_const*rtpthlp_const) ! rtpthlp output + wp3_output(i,k) = wp3(i,k) - (apply_const*wp3_const) ! wp3 output + tke(i,k) = 0.5_r8*(up2(i,k)+vp2(i,k)+wp2(i,k)) ! turbulent kinetic energy + if (do_clubb_mf) then + mf_thlflx_output(i,k) = mf_thlflx_output(i,k)*rho(i,k)*cpair + mf_qtflx_output(i,k) = mf_qtflx_output(i,k)*rho(i,k)*latvap + end if enddo - enddo - - ! --------------------------------------------------------------------------------- ! - ! Diagnose some quantities that are computed in macrop_tend here. ! - ! These are inputs required for the microphysics calculation. ! - ! ! - ! FIRST PART COMPUTES THE STRATIFORM CLOUD FRACTION FROM CLUBB CLOUD FRACTION ! - ! --------------------------------------------------------------------------------- ! - - ! initialize variables - alst(:,:) = 0.0_r8 - qlst(:,:) = 0.0_r8 - - do k=1,pver + enddo + + ! --------------------------------------------------------------------------------- ! + ! Diagnose some quantities that are computed in macrop_tend here. ! + ! These are inputs required for the microphysics calculation. ! + ! ! + ! FIRST PART COMPUTES THE STRATIFORM CLOUD FRACTION FROM CLUBB CLOUD FRACTION ! + ! --------------------------------------------------------------------------------- ! + + ! initialize variables + alst(:,:) = 0.0_r8 + qlst(:,:) = 0.0_r8 + + do k=1,pver do i=1,ncol - alst(i,k) = cloud_frac(i,k) - qlst(i,k) = rcm(i,k)/max(0.01_r8,alst(i,k)) ! Incloud stratus condensate mixing ratio + alst(i,k) = cloud_frac(i,k) + qlst(i,k) = rcm(i,k)/max(0.01_r8,alst(i,k)) ! Incloud stratus condensate mixing ratio enddo - enddo - - ! --------------------------------------------------------------------------------- ! - ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! - ! --------------------------------------------------------------------------------- ! - - deepcu(:,pver) = 0.0_r8 - shalcu(:,pver) = 0.0_r8 - - do k=1,pver-1 + enddo + + ! --------------------------------------------------------------------------------- ! + ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! + ! --------------------------------------------------------------------------------- ! + + deepcu(:,:) = 0.0_r8 + shalcu(:,:) = 0.0_r8 + + do k=1,pver-1 do i=1,ncol - ! diagnose the deep convective cloud fraction, as done in macrophysics based on the - ! deep convective mass flux, read in from pbuf. Since shallow convection is never - ! called, the shallow convective mass flux will ALWAYS be zero, ensuring that this cloud - ! fraction is purely from deep convection scheme. - deepcu(i,k) = max(0.0_r8,min(0.1_r8*log(1.0_r8+500.0_r8*(cmfmc(i,k+1)-cmfmc_sh(i,k+1))),0.6_r8)) - shalcu(i,k) = 0._r8 - - if (deepcu(i,k) <= frac_limit .or. dp_icwmr(i,k) < ic_limit) then - deepcu(i,k) = 0._r8 - endif - - ! using the deep convective cloud fraction, and CLUBB cloud fraction (variable - ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation - ! found in macrophysics code. Assumes that convective cloud is all nonstratiform cloud - ! from CLUBB plus the deep convective cloud fraction - concld(i,k) = min(cloud_frac(i,k)-alst(i,k)+deepcu(i,k),0.80_r8) + ! diagnose the deep convective cloud fraction, as done in macrophysics based on the + ! deep convective mass flux, read in from pbuf. Since shallow convection is never + ! called, the shallow convective mass flux will ALWAYS be zero, ensuring that this cloud + ! fraction is purely from deep convection scheme. + deepcu(i,k) = max(0.0_r8,min(dp1*log(1.0_r8+dp2*(cmfmc(i,k+1)-cmfmc_sh(i,k+1))),0.6_r8)) + shalcu(i,k) = 0._r8 + + if (deepcu(i,k) <= frac_limit .or. dp_icwmr(i,k) < ic_limit) then + deepcu(i,k) = 0._r8 + endif + + ! using the deep convective cloud fraction, and CLUBB cloud fraction (variable + ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation + ! found in macrophysics code. Assumes that convective cloud is all nonstratiform cloud + ! from CLUBB plus the deep convective cloud fraction + concld(i,k) = min(cloud_frac(i,k)-alst(i,k)+deepcu(i,k),0.80_r8) enddo - enddo - - if (single_column) then + enddo + + 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. & trim(scm_clubb_iop_name) == 'DYCOMSrf02_06hr' .or. & trim(scm_clubb_iop_name) == 'RICO_3day' .or. & trim(scm_clubb_iop_name) == 'ARM_CC') then - - deepcu(:,:) = 0.0_r8 - concld(:,:) = 0.0_r8 - - endif - endif - - ! --------------------------------------------------------------------------------- ! - ! COMPUTE THE ICE CLOUD FRACTION PORTION ! - ! use the aist_vector function to compute the ice cloud fraction ! - ! --------------------------------------------------------------------------------- ! - - aist(:,:top_lev-1) = 0._r8 - qsatfac(:, :) = 0._r8 ! Zero out entire profile in case qsatfac is left undefined in aist_vector below - - do k = top_lev, pver + + deepcu(:,:) = 0.0_r8 + concld(:,:) = 0.0_r8 + + endif + endif + + ! --------------------------------------------------------------------------------- ! + ! COMPUTE THE ICE CLOUD FRACTION PORTION ! + ! use the aist_vector function to compute the ice cloud fraction ! + ! --------------------------------------------------------------------------------- ! + + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + troplev(:) = 0 + !REMOVECAM_END + call tropopause_findChemTrop( state, troplev ) + + aist(:,:top_lev-1) = 0._r8 + qsatfac(:, :) = 0._r8 ! Zero out entire profile in case qsatfac is left undefined in aist_vector below + + do k = top_lev, pver ! For Type II PSC and for thin cirrus, the clouds can be thin, but ! extensive and they should start forming when the gridbox mean saturation @@ -3286,272 +4649,333 @@ subroutine clubb_tend_cam( & ! identify the level for thin cirrus. Include the tropopause level so that ! the cold point tropopause will use the stratospheric values. where (k <= troplev) - rhmini = rhminis_const - rhmaxi = rhmaxis_const + rhmini = rhminis_const + rhmaxi = rhmaxis_const elsewhere - rhmini = rhmini_const - rhmaxi = rhmaxi_const + rhmini = rhmini_const + rhmaxi = rhmaxi_const end where if ( trim(subcol_scheme) == 'SILHS' ) then - call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), & - state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist(:,k),ncol ) + call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), & + state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist(:,k),ncol ) else - call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), & + call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), & state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist(:,k),ncol,& qsatfac_out=qsatfac(:,k), rhmini_in=rhmini, rhmaxi_in=rhmaxi) endif - enddo - - ! --------------------------------------------------------------------------------- ! - ! THIS PART COMPUTES THE LIQUID STRATUS FRACTION ! - ! ! - ! For now leave the computation of ice stratus fraction from macrop_driver intact ! - ! because CLUBB does nothing with ice. Here I simply overwrite the liquid stratus ! - ! fraction that was coded in macrop_driver ! - ! --------------------------------------------------------------------------------- ! - - ! Recompute net stratus fraction using maximum over-lapping assumption, as done - ! in macrophysics code, using alst computed above and aist read in from physics buffer - - do k=1,pver - do i=1,ncol + enddo - ast(i,k) = max(alst(i,k),aist(i,k)) + ! --------------------------------------------------------------------------------- ! + ! THIS PART COMPUTES THE LIQUID STRATUS FRACTION ! + ! ! + ! For now leave the computation of ice stratus fraction from macrop_driver intact ! + ! because CLUBB does nothing with ice. Here I simply overwrite the liquid stratus ! + ! fraction that was coded in macrop_driver ! + ! --------------------------------------------------------------------------------- ! - qist(i,k) = state1%q(i,k,ixcldice)/max(0.01_r8,aist(i,k)) + ! Recompute net stratus fraction using maximum over-lapping assumption, as done + ! in macrophysics code, using alst computed above and aist read in from physics buffer + + do k=1,pver + do i=1,ncol + ast(i,k) = max(alst(i,k),aist(i,k)) + qist(i,k) = state1%q(i,k,ixcldice)/max(0.01_r8,aist(i,k)) enddo - enddo - - ! Probably need to add deepcu cloud fraction to the cloud fraction array, else would just - ! be outputting the shallow convective cloud fraction + enddo - do k=1,pver + ! Probably need to add deepcu cloud fraction to the cloud fraction array, else would just + ! be outputting the shallow convective cloud fraction + do k=1,pver do i=1,ncol - cloud_frac(i,k) = min(ast(i,k)+deepcu(i,k),1.0_r8) + cloud_frac(i,k) = min(ast(i,k)+deepcu(i,k),1.0_r8) enddo - enddo - - ! --------------------------------------------------------------------------------- ! - ! DIAGNOSE THE PBL DEPTH ! - ! this is needed for aerosol code ! - ! --------------------------------------------------------------------------------- ! - - do i=1,ncol + enddo + + ! --------------------------------------------------------------------------------- ! + ! DIAGNOSE THE PBL DEPTH ! + ! this is needed for aerosol code ! + ! --------------------------------------------------------------------------------- ! + do i=1,ncol do k=1,pver + !subroutine pblind expects "Stull" definition of Exner th(i,k) = state1%t(i,k)*state1%exner(i,k) - thv(i,k) = th(i,k)*(1.0_r8+zvir*state1%q(i,k,ixq)) + !thv should have condensate loading to be consistent with earlier def's in this module + thv(i,k) = th(i,k)*(1.0_r8+zvir*state1%q(i,k,ixq) - state1%q(i,k,ixcldliq)) enddo - enddo - - ! diagnose surface friction and obukhov length (inputs to diagnose PBL depth) - rrho(1:ncol) = (1._r8/gravit)*(state1%pdel(1:ncol,pver)/dz_g(pver)) - call calc_ustar( ncol, state1%t(1:ncol,pver), state1%pmid(1:ncol,pver), cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), & + enddo + + ! diagnose surface friction and obukhov length (inputs to diagnose PBL depth) + rrho(1:ncol) = (rga)*(state1%pdel(1:ncol,pver)/dz_g(1:ncol,pver)) + call calc_ustar( ncol, state1%t(1:ncol,pver), state1%pmid(1:ncol,pver), cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), & rrho(1:ncol), ustar2(1:ncol)) - ! use correct qflux from coupler - call calc_obklen( ncol, th(1:ncol,pver), thv(1:ncol,pver), cam_in%cflx(1:ncol,1), cam_in%shf(1:ncol), & - rrho(1:ncol), ustar2(1:ncol), kinheat(1:ncol), kinwat(1:ncol), kbfs(1:ncol), & - obklen(1:ncol)) - - dummy2(:) = 0._r8 - dummy3(:) = 0._r8 - - where (kbfs(:ncol) == -0.0_r8) kbfs(:ncol) = 0.0_r8 - - ! Compute PBL depth according to Holtslag-Boville Scheme - call pblintd(ncol, thv, state1%zm, state1%u, state1%v, & + ! use correct qflux from coupler + call calc_obklen( ncol, th(1:ncol,pver), thv(1:ncol,pver), cam_in%cflx(1:ncol,1), cam_in%shf(1:ncol), & + rrho(1:ncol), ustar2(1:ncol), kinheat(1:ncol), kinwat(1:ncol), kbfs(1:ncol), & + obklen(1:ncol)) + + dummy2(:) = 0._r8 + dummy3(:) = 0._r8 + + where (kbfs(:ncol) == -0.0_r8) kbfs(:ncol) = 0.0_r8 + + ! Compute PBL depth according to Holtslag-Boville Scheme + call pblintd(ncol, thv, state1%zm, state1%u, state1%v, & ustar2, obklen, kbfs, pblh, dummy2, & state1%zi, cloud_frac(:,1:pver), 1._r8-cam_in%landfrac, dummy3) - ! Output the PBL depth - call outfld('PBLH', pblh, pcols, lchnk) - - ! Assign the first pver levels of cloud_frac back to cld - cld(:,1:pver) = cloud_frac(:,1:pver) - - ! --------------------------------------------------------------------------------- ! - ! END CLOUD FRACTION DIAGNOSIS, begin to store variables back into buffer ! - ! --------------------------------------------------------------------------------- ! - - ! Output calls of variables goes here - call outfld( 'RELVAR', relvar, pcols, lchnk ) - call outfld( 'RHO_CLUBB', rho, pcols, lchnk ) - call outfld( 'WP2_CLUBB', wp2, pcols, lchnk ) - call outfld( 'UP2_CLUBB', up2, pcols, lchnk ) - call outfld( 'VP2_CLUBB', vp2, pcols, lchnk ) - call outfld( 'WP3_CLUBB', wp3_output, pcols, lchnk ) - call outfld( 'UPWP_CLUBB', upwp, pcols, lchnk ) - call outfld( 'VPWP_CLUBB', vpwp, pcols, lchnk ) - call outfld( 'WPTHLP_CLUBB', wpthlp_output, pcols, lchnk ) - call outfld( 'WPRTP_CLUBB', wprtp_output, pcols, lchnk ) - - temp2dp(:ncol,:) = rtp2(:ncol,:)*1.0e6_r8 - call outfld( 'RTP2_CLUBB', temp2dp, pcols, lchnk ) - - rtpthlp_output(:ncol,:) = rtpthlp_output(:ncol,:) * 1000._r8 - call outfld( 'RTPTHLP_CLUBB', rtpthlp_output, pcols, lchnk ) - - temp2dp(:ncol,:) = rcm(:ncol,:) * 1000._r8 - call outfld( 'RCM_CLUBB', temp2dp, pcols, lchnk ) - - temp2dp(:ncol,:) = wprcp(:ncol,:) * latvap - call outfld( 'WPRCP_CLUBB', temp2dp, pcols, lchnk ) - - temp2dp(:ncol,:) = rcm_in_layer(:ncol,:) * 1000._r8 - call outfld( 'RCMINLAYER_CLUBB', temp2dp, pcols, lchnk ) - - temp2dp(:ncol,:) = wpthvp(:ncol,:) * cpair - call outfld( 'WPTHVP_CLUBB', temp2dp, pcols, lchnk ) - - call outfld( 'RTP2_ZT_CLUBB', rtp2_zt_out, pcols, lchnk ) - call outfld( 'THLP2_ZT_CLUBB', thl2_zt_out, pcols, lchnk ) - call outfld( 'WP2_ZT_CLUBB', wp2_zt_out, pcols, lchnk ) - call outfld( 'PDFP_RTP2_CLUBB', pdfp_rtp2, pcols, lchnk ) - call outfld( 'THLP2_CLUBB', thlp2, pcols, lchnk ) - call outfld( 'CLOUDFRAC_CLUBB', alst, pcols, lchnk ) - call outfld( 'CLOUDCOVER_CLUBB', cloud_frac, pcols, lchnk ) - call outfld( 'ZT_CLUBB', zt_out, pcols, lchnk ) - call outfld( 'ZM_CLUBB', zi_out, pcols, lchnk ) - call outfld( 'UM_CLUBB', um, pcols, lchnk ) - call outfld( 'VM_CLUBB', vm, pcols, lchnk ) - call outfld( 'WM_ZT_CLUBB', wm_zt_out, pcols, lchnk ) - call outfld( 'THETAL', thetal_output, pcols, lchnk ) - call outfld( 'QT', qt_output, pcols, lchnk ) - call outfld( 'SL', sl_output, pcols, lchnk ) - call outfld( 'CLOUDCOVER_CLUBB', cloud_frac, pcols, lchnk ) - call outfld( 'ZT_CLUBB', zt_out, pcols, lchnk ) - call outfld( 'ZM_CLUBB', zi_out, pcols, lchnk ) - call outfld( 'UM_CLUBB', um, pcols, lchnk ) - call outfld( 'VM_CLUBB', vm, pcols, lchnk ) - call outfld( 'THETAL', thetal_output, pcols, lchnk ) - call outfld( 'QT', qt_output, pcols, lchnk ) - call outfld( 'SL', sl_output, pcols, lchnk ) - call outfld( 'CONCLD', concld, pcols, lchnk ) - call outfld( 'DP_CLD', deepcu, pcols, lchnk ) - call outfld( 'ZMDLF', dlf_liq_out, pcols, lchnk ) - call outfld( 'ZMDLFI', dlf_ice_out, pcols, lchnk ) - call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk ) - call outfld( 'QSATFAC', qsatfac, pcols, lchnk) - - - ! --------------------------------------------------------------- ! - ! Writing state variables after EDMF scheme for detailed analysis ! - ! --------------------------------------------------------------- ! - if (do_clubb_mf) then - call outfld( 'edmf_DRY_A' , mf_dry_a_output, pcols, lchnk ) - call outfld( 'edmf_MOIST_A' , mf_moist_a_output, pcols, lchnk ) - call outfld( 'edmf_DRY_W' , mf_dry_w_output, pcols, lchnk ) - call outfld( 'edmf_MOIST_W' , mf_moist_w_output, pcols, lchnk ) - call outfld( 'edmf_DRY_QT' , mf_dry_qt_output, pcols, lchnk ) - call outfld( 'edmf_MOIST_QT' , mf_moist_qt_output, pcols, lchnk ) - call outfld( 'edmf_DRY_THL' , mf_dry_thl_output, pcols, lchnk ) - call outfld( 'edmf_MOIST_THL', mf_moist_thl_output, pcols, lchnk ) - call outfld( 'edmf_DRY_U' , mf_dry_u_output, pcols, lchnk ) - call outfld( 'edmf_MOIST_U' , mf_moist_u_output, pcols, lchnk ) - call outfld( 'edmf_DRY_V' , mf_dry_v_output, pcols, lchnk ) - call outfld( 'edmf_MOIST_V' , mf_moist_v_output, pcols, lchnk ) - call outfld( 'edmf_MOIST_QC' , mf_moist_qc_output, pcols, lchnk ) - call outfld( 'edmf_S_AE' , s_ae_output, pcols, lchnk ) - call outfld( 'edmf_S_AW' , s_aw_output, pcols, lchnk ) - call outfld( 'edmf_S_AWTHL' , s_awthl_output, pcols, lchnk ) - call outfld( 'edmf_S_AWQT' , s_awqt_output, pcols, lchnk ) - call outfld( 'edmf_S_AWU' , s_awu_output, pcols, lchnk ) - call outfld( 'edmf_S_AWV' , s_awv_output, pcols, lchnk ) - call outfld( 'edmf_thlflx' , mf_thlflx_output, pcols, lchnk ) - call outfld( 'edmf_qtflx' , mf_qtflx_output, pcols, lchnk ) - end if - ! Output CLUBB history here - if (l_stats) then - - do i=1,stats_zt%num_output_fields - - temp1 = trim(stats_zt%file%var(i)%name) - sub = temp1 - if (len(temp1) > 16) sub = temp1(1:16) - - call outfld(trim(sub), out_zt(:,:,i), pcols, lchnk ) + ! Assign the first pver levels of cloud_frac back to cld + cld(:,1:pver) = cloud_frac(:,1:pver) + + ! --------------------------------------------------------------------------------- ! + ! END CLOUD FRACTION DIAGNOSIS, begin to store variables back into buffer ! + ! --------------------------------------------------------------------------------- ! + + call outfld( 'DETNLIQTND', detnliquid,pcols, lchnk ) + + ! Output CLUBB tendencies (convert dry basis to wet for consistency with history variable definition) + call outfld( 'RVMTEND_CLUBB', rvmtend_clubb, pcols, lchnk) + call outfld( 'RCMTEND_CLUBB', rcmtend_clubb, pcols, lchnk) + call outfld( 'RIMTEND_CLUBB', rimtend_clubb, pcols, lchnk) + call outfld( 'STEND_CLUBB', stend_clubb, pcols, lchnk) + call outfld( 'UTEND_CLUBB', utend_clubb, pcols, lchnk) + call outfld( 'VTEND_CLUBB', vtend_clubb, pcols, lchnk) + + call outfld( 'CMELIQ', cmeliq, pcols, lchnk) + + ! output moist basis to be consistent with history variable definition + call outfld( 'DPDLFLIQ', dpdlfliq, pcols, lchnk) + call outfld( 'DPDLFICE', dpdlfice, pcols, lchnk) + call outfld( 'DPDLFT', dpdlft, pcols, lchnk) + + ! Output the PBL depth + call outfld('PBLH', pblh, pcols, lchnk) + + call outfld('KVH_CLUBB', khzm, pcols, lchnk) + call outfld('ELEAK_CLUBB', eleak, pcols, lchnk) + call outfld('TFIX_CLUBB', se_dis, pcols, lchnk) + + ! Output calls of variables goes here + call outfld( 'RELVAR', relvar, pcols, lchnk ) + call outfld( 'RHO_CLUBB', rho(:,1:pver), pcols, lchnk ) + call outfld( 'WP2_CLUBB', wp2, pcols, lchnk ) + call outfld( 'UP2_CLUBB', up2, pcols, lchnk ) + call outfld( 'VP2_CLUBB', vp2, pcols, lchnk ) + call outfld( 'WP3_CLUBB', wp3_output(:,1:pver), pcols, lchnk ) + call outfld( 'UPWP_CLUBB', upwp, pcols, lchnk ) + call outfld( 'VPWP_CLUBB', vpwp, pcols, lchnk ) + call outfld( 'WPTHLP_CLUBB', wpthlp_output, pcols, lchnk ) + call outfld( 'WPRTP_CLUBB', wprtp_output, pcols, lchnk ) + call outfld( 'RTP2_CLUBB', rtp2, pcols, lchnk ) + call outfld( 'RTPTHLP_CLUBB', rtpthlp_output, pcols, lchnk ) + call outfld( 'RCM_CLUBB', rcm(:,1:pver), pcols, lchnk ) + call outfld( 'RTM_CLUBB', rtm(:,1:pver), pcols, lchnk ) + call outfld( 'THLM_CLUBB', thlm(:,1:pver), pcols, lchnk ) + call outfld( 'WPRCP_CLUBB', wprcp_clubb, pcols, lchnk ) + call outfld( 'WPTHVP_CLUBB', wpthvp_clubb, pcols, lchnk ) + call outfld( 'RTP2_ZT_CLUBB', rtp2_zt_out(:,1:pver), pcols, lchnk ) + call outfld( 'THLP2_ZT_CLUBB', thl2_zt_out(:,1:pver), pcols, lchnk ) + call outfld( 'WP2_ZT_CLUBB', wp2_zt_out(:,1:pver), pcols, lchnk ) + call outfld( 'PDFP_RTP2_CLUBB', pdfp_rtp2, pcols, lchnk ) + call outfld( 'THLP2_CLUBB', thlp2, pcols, lchnk ) + call outfld( 'RCMINLAYER_CLUBB', rcm_in_layer(:,1:pver), pcols, lchnk ) + call outfld( 'CLOUDFRAC_CLUBB', alst, pcols, lchnk ) + call outfld( 'CLOUDCOVER_CLUBB', cloud_frac(:,1:pver), pcols, lchnk ) + call outfld( 'ZT_CLUBB', zt_out(:,1:pver), pcols, lchnk ) + call outfld( 'ZM_CLUBB', zi_out, pcols, lchnk ) + call outfld( 'UM_CLUBB', um(:,1:pver), pcols, lchnk ) + call outfld( 'VM_CLUBB', vm(:,1:pver), pcols, lchnk ) + call outfld( 'WM_ZT_CLUBB', wm_zt_out(:,1:pver), pcols, lchnk ) + call outfld( 'CONCLD', concld, pcols, lchnk ) + call outfld( 'DP_CLD', deepcu, pcols, lchnk ) + call outfld( 'ZMDLF', dlf_liq_out, pcols, lchnk ) + call outfld( 'ZMDLFI', dlf_ice_out, pcols, lchnk ) + call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk ) + call outfld( 'QSATFAC', qsatfac, pcols, lchnk) + + + ! --------------------------------------------------------------- ! + ! Writing state variables after EDMF scheme for detailed analysis ! + ! --------------------------------------------------------------- ! + if (do_clubb_mf) then + call outfld( 'edmf_DRY_A' , mf_dry_a_output, pcols, lchnk ) + call outfld( 'edmf_MOIST_A' , mf_moist_a_output, pcols, lchnk ) + call outfld( 'edmf_DRY_W' , mf_dry_w_output, pcols, lchnk ) + call outfld( 'edmf_MOIST_W' , mf_moist_w_output, pcols, lchnk ) + call outfld( 'edmf_DRY_QT' , mf_dry_qt_output, pcols, lchnk ) + call outfld( 'edmf_MOIST_QT' , mf_moist_qt_output, pcols, lchnk ) + call outfld( 'edmf_DRY_THL' , mf_dry_thl_output, pcols, lchnk ) + call outfld( 'edmf_MOIST_THL', mf_moist_thl_output, pcols, lchnk ) + call outfld( 'edmf_DRY_U' , mf_dry_u_output, pcols, lchnk ) + call outfld( 'edmf_MOIST_U' , mf_moist_u_output, pcols, lchnk ) + call outfld( 'edmf_DRY_V' , mf_dry_v_output, pcols, lchnk ) + call outfld( 'edmf_MOIST_V' , mf_moist_v_output, pcols, lchnk ) + call outfld( 'edmf_MOIST_QC' , mf_moist_qc_output, pcols, lchnk ) + call outfld( 'edmf_S_AE' , s_ae_output, pcols, lchnk ) + call outfld( 'edmf_S_AW' , s_aw_output, pcols, lchnk ) + call outfld( 'edmf_S_AWTHL' , s_awthl_output, pcols, lchnk ) + call outfld( 'edmf_S_AWQT' , s_awqt_output, pcols, lchnk ) + call outfld( 'edmf_S_AWU' , s_awu_output, pcols, lchnk ) + call outfld( 'edmf_S_AWV' , s_awv_output, pcols, lchnk ) + call outfld( 'edmf_thlflx' , mf_thlflx_output, pcols, lchnk ) + call outfld( 'edmf_qtflx' , mf_qtflx_output, pcols, lchnk ) + end if + + ! Output CLUBB history here + 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) + sub = temp1 + if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) + + call outfld(trim(sub), out_zt(:,:,j), pcols, lchnk ) enddo - - do i=1,stats_zm%num_output_fields - - temp1 = trim(stats_zm%file%var(i)%name) - sub = temp1 - if (len(temp1) > 16) sub = temp1(1:16) - - call outfld(trim(sub),out_zm(:,:,i), pcols, lchnk) + + do j=1,stats_zm(1)%num_output_fields + + temp1 = trim(stats_zm(1)%file%grid_avg_var(j)%name) + sub = temp1 + if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) + + call outfld(trim(sub),out_zm(:,:,j), pcols, lchnk) enddo - if (l_output_rad_files) then - do i=1,stats_rad_zt%num_output_fields - call outfld(trim(stats_rad_zt%file%var(i)%name), out_radzt(:,:,i), pcols, lchnk) - enddo - - do i=1,stats_rad_zm%num_output_fields - call outfld(trim(stats_rad_zm%file%var(i)%name), out_radzm(:,:,i), pcols, lchnk) - enddo + 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 + + do j=1,stats_rad_zm(1)%num_output_fields + call outfld(trim(stats_rad_zm(1)%file%grid_avg_var(j)%name), out_radzm(:,:,j), pcols, lchnk) + enddo endif - - do i=1,stats_sfc%num_output_fields - call outfld(trim(stats_sfc%file%var(i)%name), out_sfc(:,:,i), pcols, lchnk) + + do j=1,stats_sfc(1)%num_output_fields + call outfld(trim(stats_sfc(1)%file%grid_avg_var(j)%name), out_sfc(:,:,j), pcols, lchnk) enddo - - endif - - return + + endif + call t_stopf('clubb_tend_cam:NAR') #endif + + call t_stopf('clubb_tend_cam') + + return + end subroutine clubb_tend_cam - + + subroutine clubb_emissions_cam (state, cam_in, ptend) + + !------------------------------------------------------------------------------- + ! Description: Apply surface fluxes of constituents to lowest model level + ! except water vapor (applied in clubb_tend_cam) + ! + ! Author: Adam Herrington, November 2022 + ! Origin: Based on E3SM's clubb_surface subroutine + ! References: + ! None + !------------------------------------------------------------------------------- + use physics_types, only: physics_ptend, physics_ptend_init, physics_state + use constituents, only: cnst_type + use camsrfexch, only: cam_in_t + + ! --------------- ! + ! Input Arguments ! + ! --------------- ! + type(physics_state), intent(in) :: state ! Physics state variables + type(cam_in_t), intent(in) :: cam_in ! Surface inputs + + ! ---------------------- ! + ! Output Arguments ! + ! ---------------------- ! + type(physics_ptend), intent(out) :: ptend ! Individual parameterization tendencies + + ! --------------- ! + ! Local Variables ! + ! --------------- ! + integer :: m, ncol + logical :: lq(pcnst) + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + ncol = state%ncol + + lq(1) = .false. + lq(2:) = .true. + call physics_ptend_init(ptend,state%psetcols, "clubb emissions", lq=lq) + + ! Apply tracer fluxes to lowest model level (except water vapor) + do m = 2,pcnst + ptend%q(:ncol,pver,m) = cam_in%cflx(:ncol,m)*state%rpdel(:ncol,pver)*gravit + end do + + ! Convert tendencies of dry constituents to dry basis. + do m = 2,pcnst + if (cnst_type(m).eq.'dry') then + ptend%q(:ncol,pver,m) = ptend%q(:ncol,pver,m)*state%pdel(:ncol,pver)*state%rpdeldry(:ncol,pver) + endif + end do + + end subroutine clubb_emissions_cam + ! =============================================================================== ! ! ! ! =============================================================================== ! ! Saturation adjustment for ice ! Add ice mass if supersaturated -elemental subroutine ice_macro_tend(naai,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend,nitend) +subroutine ice_macro_tend(naai,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend,nitend,vlen) use wv_sat_methods, only: wv_sat_qsat_ice - real(r8), intent(in) :: naai !Activated number of ice nuclei - real(r8), intent(in) :: t !temperature (k) - real(r8), intent(in) :: p !pressure (pa0 - real(r8), intent(in) :: qv !water vapor mixing ratio - real(r8), intent(in) :: qi !ice mixing ratio - real(r8), intent(in) :: ni !ice number concentration - real(r8), intent(in) :: xxls !latent heat of freezing - real(r8), intent(in) :: deltat !timestep - real(r8), intent(out) :: stend ! 'temperature' tendency - real(r8), intent(out) :: qvtend !vapor tendency - real(r8), intent(out) :: qitend !ice mass tendency - real(r8), intent(out) :: nitend !ice number tendency - - real(r8) :: ESI - real(r8) :: QSI - real(r8) :: tau - - stend = 0._r8 - qvtend = 0._r8 - qitend = 0._r8 - nitend = 0._r8 - -! calculate qsati from t,p,q - - call wv_sat_qsat_ice(t, p, ESI, QSI) + integer, intent(in) :: vlen + real(r8), dimension(vlen), intent(in) :: naai !Activated number of ice nuclei + real(r8), dimension(vlen), intent(in) :: t !temperature (k) + real(r8), dimension(vlen), intent(in) :: p !pressure (pa) + real(r8), dimension(vlen), intent(in) :: qv !water vapor mixing ratio + real(r8), dimension(vlen), intent(in) :: qi !ice mixing ratio + real(r8), dimension(vlen), intent(in) :: ni !ice number concentration + real(r8), intent(in) :: xxls !latent heat of freezing + real(r8), intent(in) :: deltat !timestep + real(r8), dimension(vlen), intent(out) :: stend ! 'temperature' tendency + real(r8), dimension(vlen), intent(out) :: qvtend !vapor tendency + real(r8), dimension(vlen), intent(out) :: qitend !ice mass tendency + real(r8), dimension(vlen), intent(out) :: nitend !ice number tendency + + real(r8) :: ESI(vlen) + real(r8) :: QSI(vlen) + integer :: i - if (naai > 1.e-18_r8 .and. qv > QSI) then + do i = 1, vlen + stend(i) = 0._r8 + qvtend(i) = 0._r8 + qitend(i) = 0._r8 + nitend(i) = 0._r8 + end do +! calculate qsati from t,p,q + do i = 1, vlen + call wv_sat_qsat_ice(t(i), p(i), ESI(i), QSI(i)) + end do - qitend = (qv-QSI)/deltat !* exp(-tau/deltat) - qvtend = 0._r8 - qitend - stend = qitend * xxls ! moist static energy tend...[J/kg/s] ! + do i = 1, vlen + if (naai(i) > 1.e-18_r8 .and. qv(i) > QSI(i)) then + qitend(i) = (qv(i)-QSI(i))/deltat + qvtend(i) = 0._r8 - qitend(i) + stend(i) = qitend(i) * xxls ! moist static energy tend...[J/kg/s] ! - ! if ice exists (more than 1 L-1) and there is condensation, do not add to number (= growth), else, add 10um ice - if (ni < 1.e3_r8 .and. (qi+qitend*deltat) > 1.e-18_r8) then - nitend = nitend + 3._r8 * qitend/(4._r8*3.14_r8* 10.e-6_r8**3*997._r8) - endif + ! if ice exists (more than 1 L-1) and there is condensation, do not add to number (= growth), else, add 10um ice + if (ni(i) < 1.e3_r8 .and. (qi(i)+qitend(i)*deltat) > 1.e-18_r8) then + nitend(i) = nitend(i) + 3._r8 * qitend(i)/(4._r8*3.14_r8* 10.e-6_r8**3*997._r8) + end if - endif + end if + end do end subroutine ice_macro_tend @@ -3578,7 +5002,7 @@ end subroutine ice_macro_tend ! Code writen March, 1999 by Bjorn Stevens ! -real(r8) function diag_ustar( z, bflx, wnd, z0 ) +real(r8) function diag_ustar( z, bflx, wnd, z0 ) use shr_const_mod, only : shr_const_karman, shr_const_pi, shr_const_g @@ -3640,70 +5064,16 @@ end function diag_ustar #ifdef CLUBB_SGS subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & - nnzp, nnrad_zt,nnrad_zm, delt ) + nnzp, nnrad_zt,nnrad_zm, delt, & + stats_zt, stats_zm, stats_sfc, & + stats_rad_zt, stats_rad_zm) ! ! Description: Initializes the statistics saving functionality of ! the CLUBB model. This is for purpose of CAM-CLUBB interface. Here ! the traditional stats_init of CLUBB is not called, as it is not compatible - ! with CAM output. - - !----------------------------------------------------------------------- - - - use clubb_api_module, only: & - stats_zt, & ! Variables - ztscr01, & - ztscr02, & - ztscr03, & - ztscr04, & - ztscr05, & - ztscr06, & - ztscr07, & - ztscr08, & - ztscr09, & - ztscr10, & - ztscr11, & - ztscr12, & - ztscr13, & - ztscr14, & - ztscr15, & - ztscr16, & - ztscr17, & - ztscr18, & - ztscr19, & - ztscr20, & - ztscr21 + ! with CAM output. - use clubb_api_module, only: & - stats_zm, & - zmscr01, & - zmscr02, & - zmscr03, & - zmscr04, & - zmscr05, & - zmscr06, & - zmscr07, & - zmscr08, & - zmscr09, & - zmscr10, & - zmscr11, & - zmscr12, & - zmscr13, & - zmscr14, & - zmscr15, & - zmscr16, & - zmscr17, & - stats_rad_zt, & - stats_rad_zm, & - stats_sfc, & - l_stats, & - l_output_rad_files, & - stats_tsamp, & - stats_tout, & - l_stats_samp, & - l_stats_last, & - l_netcdf, & - l_grads + !----------------------------------------------------------------------- use clubb_api_module, only: time_precision, & ! nvarmax_zm, stats_init_zm_api, & ! @@ -3720,22 +5090,30 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & implicit none - ! Input Variables + !----------------------- Input Variables ----------------------- logical, intent(in) :: l_stats_in ! Stats on? T/F - real(kind=time_precision), intent(in) :: & + real(kind=time_precision), intent(in) :: & stats_tsamp_in, & ! Sampling interval [s] stats_tout_in ! Output interval [s] integer, intent(in) :: nnzp ! Grid points in the vertical [count] - integer, intent(in) :: nnrad_zt ! Grid points in the radiation grid [count] + integer, intent(in) :: nnrad_zt ! Grid points in the radiation grid [count] integer, intent(in) :: nnrad_zm ! Grid points in the radiation grid [count] real(kind=time_precision), intent(in) :: delt ! Timestep (dtmain in CLUBB) [s] + !----------------------- Output Variables ----------------------- + type (stats), intent(out), dimension(pcols) :: & + stats_zt, & ! stats_zt grid + stats_zm, & ! stats_zm grid + stats_rad_zt, & ! stats_rad_zt grid + stats_rad_zm, & ! stats_rad_zm grid + stats_sfc ! stats_sfc - ! Local Variables + + !----------------------- Local Variables ----------------------- ! Namelist Variables @@ -3747,34 +5125,34 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & character(len=var_length), dimension(nvarmax_rad_zm) :: clubb_vars_rad_zm ! Variables on the radiation levels character(len=var_length), dimension(nvarmax_sfc) :: clubb_vars_sfc ! Variables at the model surface - namelist /clubb_stats_nl/ & - clubb_vars_zt, & + namelist /clubb_stats_nl/ & + clubb_vars_zt, & clubb_vars_zm, & clubb_vars_rad_zt, & - clubb_vars_rad_zm, & + clubb_vars_rad_zm, & clubb_vars_sfc - ! Local Variables - logical :: l_error character(len=200) :: temp1, sub - integer :: i, ntot, read_status + integer :: i, ntot, read_status, j integer :: iunit, ierr + !----------------------- Begin Code ----------------------- + ! Initialize l_error = .false. ! Set stats_variables variables with inputs from calling subroutine - l_stats = l_stats_in - - stats_tsamp = stats_tsamp_in - stats_tout = stats_tout_in - - if ( .not. l_stats ) then - l_stats_samp = .false. - l_stats_last = .false. + stats_metadata%l_stats = l_stats_in + + stats_metadata%stats_tsamp = stats_tsamp_in + stats_metadata%stats_tout = stats_tout_in + + if ( .not. stats_metadata%l_stats ) then + stats_metadata%l_stats_samp = .false. + stats_metadata%l_stats_last = .false. return end if @@ -3786,7 +5164,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & clubb_vars_rad_zm = '' clubb_vars_sfc = '' - ! Read variables to compute from the namelist + ! Read variables to compute from the namelist if (masterproc) then iunit= getunit() open(unit=iunit,file="atm_in",status='old') @@ -3813,285 +5191,226 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & call mpi_bcast(clubb_vars_sfc, var_length*nvarmax_sfc, mpi_character, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_sfc") + ! Hardcode these for use in CAM-CLUBB, don't want either - l_netcdf = .false. - l_grads = .false. + stats_metadata%l_netcdf = .false. + stats_metadata%l_grads = .false. ! Check sampling and output frequencies + do j = 1, pcols + + ! The model time step length, delt (which is dtmain), should multiply + ! evenly into the statistical sampling time step length, stats_tsamp. + if ( abs( stats_metadata%stats_tsamp/delt - floor(stats_metadata%stats_tsamp/delt) ) > 1.e-8_r8 ) then + l_error = .true. ! This will cause the run to stop. + write(fstderr,*) 'Error: stats_tsamp should be an even multiple of ', & + 'the clubb time step (delt below)' + write(fstderr,*) 'stats_tsamp = ', stats_metadata%stats_tsamp + write(fstderr,*) 'delt = ', delt + call endrun ("stats_init_clubb: CLUBB stats_tsamp must be an even multiple of the timestep") + endif - ! The model time step length, delt (which is dtmain), should multiply - ! evenly into the statistical sampling time step length, stats_tsamp. - if ( abs( stats_tsamp/delt - floor(stats_tsamp/delt) ) > 1.e-8_r8 ) then - l_error = .true. ! This will cause the run to stop. - write(fstderr,*) 'Error: stats_tsamp should be an even multiple of ', & - 'delt (which is dtmain). Check the appropriate ', & - 'model.in file.' - write(fstderr,*) 'stats_tsamp = ', stats_tsamp - write(fstderr,*) 'delt = ', delt - endif + ! Initialize zt (mass points) - ! Initialize zt (mass points) + i = 1 + do while ( ichar(clubb_vars_zt(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_zt(i)) /= 0 .and. & + i <= nvarmax_zt ) + i = i + 1 + enddo + ntot = i - 1 + if ( ntot == nvarmax_zt ) then + l_error = .true. + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_zt than allowed for by nvarmax_zt." + write(fstderr,*) "Check the number of variables listed for clubb_vars_zt ", & + "in the stats namelist, or change nvarmax_zt." + write(fstderr,*) "nvarmax_zt = ", nvarmax_zt + call endrun ("stats_init_clubb: number of zt statistical variables exceeds limit") + endif - i = 1 - do while ( ichar(clubb_vars_zt(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_zt(i)) /= 0 .and. & - i <= nvarmax_zt ) - i = i + 1 - enddo - ntot = i - 1 - if ( ntot == nvarmax_zt ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_zt than allowed for by nvarmax_zt." - write(fstderr,*) "Check the number of variables listed for clubb_vars_zt ", & - "in the stats namelist, or change nvarmax_zt." - write(fstderr,*) "nvarmax_zt = ", nvarmax_zt - call endrun ("stats_init_clubb: number of zt statistical variables exceeds limit") - endif + stats_zt(j)%num_output_fields = ntot + stats_zt(j)%kk = nnzp + + allocate( stats_zt(j)%z( stats_zt(j)%kk ), stat=ierr ) + if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%z") + + allocate( stats_zt(j)%accum_field_values( 1, 1, stats_zt(j)%kk, stats_zt(j)%num_output_fields ), stat=ierr ) + if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%accum_field_values") + allocate( stats_zt(j)%accum_num_samples( 1, 1, stats_zt(j)%kk, stats_zt(j)%num_output_fields ), stat=ierr ) + if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%accum_num_samples") + allocate( stats_zt(j)%l_in_update( 1, 1, stats_zt(j)%kk, stats_zt(j)%num_output_fields ), stat=ierr ) + if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%l_in_update") + call stats_zero( stats_zt(j)%kk, stats_zt(j)%num_output_fields, stats_zt(j)%accum_field_values, & + stats_zt(j)%accum_num_samples, stats_zt(j)%l_in_update ) + + allocate( stats_zt(j)%file%grid_avg_var( stats_zt(j)%num_output_fields ), stat=ierr ) + if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%file%grid_avg_var") + allocate( stats_zt(j)%file%z( stats_zt(j)%kk ), stat=ierr ) + if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%file%z") + + ! Default initialization for array indices for zt + call stats_init_zt_api( hydromet_dim, sclr_dim, edsclr_dim, & + hm_metadata%hydromet_list, hm_metadata%l_mix_rat_hm, & + clubb_vars_zt, & + l_error, & + stats_metadata, stats_zt(j) ) + + ! Initialize zm (momentum points) + + i = 1 + do while ( ichar(clubb_vars_zm(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_zm(i)) /= 0 .and. & + i <= nvarmax_zm ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_zm ) then + l_error = .true. ! This will cause the run to stop. + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_zm than allowed for by nvarmax_zm." + write(fstderr,*) "Check the number of variables listed for clubb_vars_zm ", & + "in the stats namelist, or change nvarmax_zm." + write(fstderr,*) "nvarmax_zm = ", nvarmax_zm + call endrun ("stats_init_clubb: number of zm statistical variables exceeds limit") + endif - stats_zt%num_output_fields = ntot - stats_zt%kk = nnzp + stats_zm(j)%num_output_fields = ntot + stats_zm(j)%kk = nnzp - allocate( stats_zt%z( stats_zt%kk ) ) + allocate( stats_zm(j)%z( stats_zm(j)%kk ) ) - allocate( stats_zt%accum_field_values( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) - allocate( stats_zt%accum_num_samples( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) - allocate( stats_zt%l_in_update( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) - call stats_zero( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, & - stats_zt%accum_num_samples, stats_zt%l_in_update ) + allocate( stats_zm(j)%accum_field_values( 1, 1, stats_zm(j)%kk, stats_zm(j)%num_output_fields ) ) + allocate( stats_zm(j)%accum_num_samples( 1, 1, stats_zm(j)%kk, stats_zm(j)%num_output_fields ) ) + allocate( stats_zm(j)%l_in_update( 1, 1, stats_zm(j)%kk, stats_zm(j)%num_output_fields ) ) + call stats_zero( stats_zm(j)%kk, stats_zm(j)%num_output_fields, stats_zm(j)%accum_field_values, & + stats_zm(j)%accum_num_samples, stats_zm(j)%l_in_update ) - allocate( stats_zt%file%var( stats_zt%num_output_fields ) ) - allocate( stats_zt%file%z( stats_zt%kk ) ) - - ! Allocate scratch space - - allocate( ztscr01(stats_zt%kk) ) - allocate( ztscr02(stats_zt%kk) ) - allocate( ztscr03(stats_zt%kk) ) - allocate( ztscr04(stats_zt%kk) ) - allocate( ztscr05(stats_zt%kk) ) - allocate( ztscr06(stats_zt%kk) ) - allocate( ztscr07(stats_zt%kk) ) - allocate( ztscr08(stats_zt%kk) ) - allocate( ztscr09(stats_zt%kk) ) - allocate( ztscr10(stats_zt%kk) ) - allocate( ztscr11(stats_zt%kk) ) - allocate( ztscr12(stats_zt%kk) ) - allocate( ztscr13(stats_zt%kk) ) - allocate( ztscr14(stats_zt%kk) ) - allocate( ztscr15(stats_zt%kk) ) - allocate( ztscr16(stats_zt%kk) ) - allocate( ztscr17(stats_zt%kk) ) - allocate( ztscr18(stats_zt%kk) ) - allocate( ztscr19(stats_zt%kk) ) - allocate( ztscr20(stats_zt%kk) ) - allocate( ztscr21(stats_zt%kk) ) - - ztscr01 = 0.0_r8 - ztscr02 = 0.0_r8 - ztscr03 = 0.0_r8 - ztscr04 = 0.0_r8 - ztscr05 = 0.0_r8 - ztscr06 = 0.0_r8 - ztscr07 = 0.0_r8 - ztscr08 = 0.0_r8 - ztscr09 = 0.0_r8 - ztscr10 = 0.0_r8 - ztscr11 = 0.0_r8 - ztscr12 = 0.0_r8 - ztscr13 = 0.0_r8 - ztscr14 = 0.0_r8 - ztscr15 = 0.0_r8 - ztscr16 = 0.0_r8 - ztscr17 = 0.0_r8 - ztscr18 = 0.0_r8 - ztscr19 = 0.0_r8 - ztscr20 = 0.0_r8 - ztscr21 = 0.0_r8 - - ! Default initialization for array indices for zt - - call stats_init_zt_api( clubb_vars_zt, l_error ) - - ! Initialize zm (momentum points) - - i = 1 - do while ( ichar(clubb_vars_zm(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_zm(i)) /= 0 .and. & - i <= nvarmax_zm ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_zm ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_zm than allowed for by nvarmax_zm." - write(fstderr,*) "Check the number of variables listed for clubb_vars_zm ", & - "in the stats namelist, or change nvarmax_zm." - write(fstderr,*) "nvarmax_zm = ", nvarmax_zm - call endrun ("stats_init_clubb: number of zm statistical variables exceeds limit") - endif + allocate( stats_zm(j)%file%grid_avg_var( stats_zm(j)%num_output_fields ) ) + allocate( stats_zm(j)%file%z( stats_zm(j)%kk ) ) - stats_zm%num_output_fields = ntot - stats_zm%kk = nnzp + 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) ) - allocate( stats_zm%z( stats_zm%kk ) ) + ! Initialize rad_zt (radiation points) - allocate( stats_zm%accum_field_values( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) - allocate( stats_zm%accum_num_samples( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) - allocate( stats_zm%l_in_update( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) - call stats_zero( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, & - stats_zm%accum_num_samples, stats_zm%l_in_update ) + if (stats_metadata%l_output_rad_files) then - allocate( stats_zm%file%var( stats_zm%num_output_fields ) ) - allocate( stats_zm%file%z( stats_zm%kk ) ) - - ! Allocate scratch space - - allocate( zmscr01(stats_zm%kk) ) - allocate( zmscr02(stats_zm%kk) ) - allocate( zmscr03(stats_zm%kk) ) - allocate( zmscr04(stats_zm%kk) ) - allocate( zmscr05(stats_zm%kk) ) - allocate( zmscr06(stats_zm%kk) ) - allocate( zmscr07(stats_zm%kk) ) - allocate( zmscr08(stats_zm%kk) ) - allocate( zmscr09(stats_zm%kk) ) - allocate( zmscr10(stats_zm%kk) ) - allocate( zmscr11(stats_zm%kk) ) - allocate( zmscr12(stats_zm%kk) ) - allocate( zmscr13(stats_zm%kk) ) - allocate( zmscr14(stats_zm%kk) ) - allocate( zmscr15(stats_zm%kk) ) - allocate( zmscr16(stats_zm%kk) ) - allocate( zmscr17(stats_zm%kk) ) - - zmscr01 = 0.0_r8 - zmscr02 = 0.0_r8 - zmscr03 = 0.0_r8 - zmscr04 = 0.0_r8 - zmscr05 = 0.0_r8 - zmscr06 = 0.0_r8 - zmscr07 = 0.0_r8 - zmscr08 = 0.0_r8 - zmscr09 = 0.0_r8 - zmscr10 = 0.0_r8 - zmscr11 = 0.0_r8 - zmscr12 = 0.0_r8 - zmscr13 = 0.0_r8 - zmscr14 = 0.0_r8 - zmscr15 = 0.0_r8 - zmscr16 = 0.0_r8 - zmscr17 = 0.0_r8 - - call stats_init_zm_api( clubb_vars_zm, l_error ) - - ! Initialize rad_zt (radiation points) - - if (l_output_rad_files) then - - i = 1 - do while ( ichar(clubb_vars_rad_zt(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_rad_zt(i)) /= 0 .and. & - i <= nvarmax_rad_zt ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_rad_zt ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_rad_zt than allowed for by nvarmax_rad_zt." - write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zt ", & - "in the stats namelist, or change nvarmax_rad_zt." - write(fstderr,*) "nvarmax_rad_zt = ", nvarmax_rad_zt - call endrun ("stats_init_clubb: number of rad_zt statistical variables exceeds limit") - endif + i = 1 + do while ( ichar(clubb_vars_rad_zt(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_rad_zt(i)) /= 0 .and. & + i <= nvarmax_rad_zt ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_rad_zt ) then + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_rad_zt than allowed for by nvarmax_rad_zt." + write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zt ", & + "in the stats namelist, or change nvarmax_rad_zt." + write(fstderr,*) "nvarmax_rad_zt = ", nvarmax_rad_zt + call endrun ("stats_init_clubb: number of rad_zt statistical variables exceeds limit") + endif - stats_rad_zt%num_output_fields = ntot - stats_rad_zt%kk = nnrad_zt + stats_rad_zt(j)%num_output_fields = ntot + stats_rad_zt(j)%kk = nnrad_zt - allocate( stats_rad_zt%z( stats_rad_zt%kk ) ) + allocate( stats_rad_zt(j)%z( stats_rad_zt(j)%kk ) ) - allocate( stats_rad_zt%accum_field_values( 1, 1, stats_rad_zt%kk, stats_rad_zt%num_output_fields ) ) - allocate( stats_rad_zt%accum_num_samples( 1, 1, stats_rad_zt%kk, stats_rad_zt%num_output_fields ) ) - allocate( stats_rad_zt%l_in_update( 1, 1, stats_rad_zt%kk, stats_rad_zt%num_output_fields ) ) + allocate( stats_rad_zt(j)%accum_field_values( 1, 1, stats_rad_zt(j)%kk, stats_rad_zt(j)%num_output_fields ) ) + allocate( stats_rad_zt(j)%accum_num_samples( 1, 1, stats_rad_zt(j)%kk, stats_rad_zt(j)%num_output_fields ) ) + allocate( stats_rad_zt(j)%l_in_update( 1, 1, stats_rad_zt(j)%kk, stats_rad_zt(j)%num_output_fields ) ) - call stats_zero( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, & - stats_rad_zt%accum_num_samples, stats_rad_zt%l_in_update ) + call stats_zero( stats_rad_zt(j)%kk, stats_rad_zt(j)%num_output_fields, stats_rad_zt(j)%accum_field_values, & + stats_rad_zt(j)%accum_num_samples, stats_rad_zt(j)%l_in_update ) - allocate( stats_rad_zt%file%var( stats_rad_zt%num_output_fields ) ) - allocate( stats_rad_zt%file%z( stats_rad_zt%kk ) ) + allocate( stats_rad_zt(j)%file%grid_avg_var( stats_rad_zt(j)%num_output_fields ) ) + allocate( stats_rad_zt(j)%file%z( stats_rad_zt(j)%kk ) ) - call stats_init_rad_zt_api( clubb_vars_rad_zt, l_error ) + call stats_init_rad_zt_api( clubb_vars_rad_zt, & + l_error, & + stats_metadata, stats_rad_zt(j) ) - ! Initialize rad_zm (radiation points) - - i = 1 - do while ( ichar(clubb_vars_rad_zm(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_rad_zm(i)) /= 0 .and. & - i <= nvarmax_rad_zm ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_rad_zm ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_rad_zm than allowed for by nvarmax_rad_zm." - write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zm ", & - "in the stats namelist, or change nvarmax_rad_zm." - write(fstderr,*) "nvarmax_rad_zm = ", nvarmax_rad_zm - call endrun ("stats_init_clubb: number of rad_zm statistical variables exceeds limit") - endif - - stats_rad_zm%num_output_fields = ntot - stats_rad_zm%kk = nnrad_zm - - allocate( stats_rad_zm%z( stats_rad_zm%kk ) ) - - allocate( stats_rad_zm%accum_field_values( 1, 1, stats_rad_zm%kk, stats_rad_zm%num_output_fields ) ) - allocate( stats_rad_zm%accum_num_samples( 1, 1, stats_rad_zm%kk, stats_rad_zm%num_output_fields ) ) - allocate( stats_rad_zm%l_in_update( 1, 1, stats_rad_zm%kk, stats_rad_zm%num_output_fields ) ) - - call stats_zero( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, & - stats_rad_zm%accum_num_samples, stats_rad_zm%l_in_update ) - - allocate( stats_rad_zm%file%var( stats_rad_zm%num_output_fields ) ) - allocate( stats_rad_zm%file%z( stats_rad_zm%kk ) ) - - call stats_init_rad_zm_api( clubb_vars_rad_zm, l_error ) - end if ! l_output_rad_files - - - ! Initialize sfc (surface point) - - i = 1 - do while ( ichar(clubb_vars_sfc(i)(1:1)) /= 0 .and. & - len_trim(clubb_vars_sfc(i)) /= 0 .and. & - i <= nvarmax_sfc ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_sfc ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_sfc than allowed for by nvarmax_sfc." - write(fstderr,*) "Check the number of variables listed for clubb_vars_sfc ", & - "in the stats namelist, or change nvarmax_sfc." - write(fstderr,*) "nvarmax_sfc = ", nvarmax_sfc - call endrun ("stats_init_clubb: number of sfc statistical variables exceeds limit") - endif + ! Initialize rad_zm (radiation points) + + i = 1 + do while ( ichar(clubb_vars_rad_zm(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_rad_zm(i)) /= 0 .and. & + i <= nvarmax_rad_zm ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_rad_zm ) then + l_error = .true. ! This will cause the run to stop. + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_rad_zm than allowed for by nvarmax_rad_zm." + write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zm ", & + "in the stats namelist, or change nvarmax_rad_zm." + write(fstderr,*) "nvarmax_rad_zm = ", nvarmax_rad_zm + call endrun ("stats_init_clubb: number of rad_zm statistical variables exceeds limit") + endif - stats_sfc%num_output_fields = ntot - stats_sfc%kk = 1 + stats_rad_zm(j)%num_output_fields = ntot + stats_rad_zm(j)%kk = nnrad_zm - allocate( stats_sfc%z( stats_sfc%kk ) ) + allocate( stats_rad_zm(j)%z( stats_rad_zm(j)%kk ) ) - allocate( stats_sfc%accum_field_values( 1, 1, stats_sfc%kk, stats_sfc%num_output_fields ) ) - allocate( stats_sfc%accum_num_samples( 1, 1, stats_sfc%kk, stats_sfc%num_output_fields ) ) - allocate( stats_sfc%l_in_update( 1, 1, stats_sfc%kk, stats_sfc%num_output_fields ) ) + allocate( stats_rad_zm(j)%accum_field_values( 1, 1, stats_rad_zm(j)%kk, stats_rad_zm(j)%num_output_fields ) ) + allocate( stats_rad_zm(j)%accum_num_samples( 1, 1, stats_rad_zm(j)%kk, stats_rad_zm(j)%num_output_fields ) ) + allocate( stats_rad_zm(j)%l_in_update( 1, 1, stats_rad_zm(j)%kk, stats_rad_zm(j)%num_output_fields ) ) - call stats_zero( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, & - stats_sfc%accum_num_samples, stats_sfc%l_in_update ) + call stats_zero( stats_rad_zm(j)%kk, stats_rad_zm(j)%num_output_fields, stats_rad_zm(j)%accum_field_values, & + stats_rad_zm(j)%accum_num_samples, stats_rad_zm(j)%l_in_update ) + + allocate( stats_rad_zm(j)%file%grid_avg_var( stats_rad_zm(j)%num_output_fields ) ) + allocate( stats_rad_zm(j)%file%z( stats_rad_zm(j)%kk ) ) + + call stats_init_rad_zm_api( clubb_vars_rad_zm, & + l_error, & + stats_metadata, stats_rad_zm(j) ) + end if ! l_output_rad_files + + + ! Initialize sfc (surface point) + i = 1 + do while ( ichar(clubb_vars_sfc(i)(1:1)) /= 0 .and. & + len_trim(clubb_vars_sfc(i)) /= 0 .and. & + i <= nvarmax_sfc ) + i = i + 1 + end do + ntot = i - 1 + if ( ntot == nvarmax_sfc ) then + l_error = .true. ! This will cause the run to stop. + write(fstderr,*) "There are more statistical variables listed in ", & + "clubb_vars_sfc than allowed for by nvarmax_sfc." + write(fstderr,*) "Check the number of variables listed for clubb_vars_sfc ", & + "in the stats namelist, or change nvarmax_sfc." + write(fstderr,*) "nvarmax_sfc = ", nvarmax_sfc + call endrun ("stats_init_clubb: number of sfc statistical variables exceeds limit") + endif + + stats_sfc(j)%num_output_fields = ntot + stats_sfc(j)%kk = 1 + + allocate( stats_sfc(j)%z( stats_sfc(j)%kk ) ) - allocate( stats_sfc%file%var( stats_sfc%num_output_fields ) ) - allocate( stats_sfc%file%z( stats_sfc%kk ) ) + allocate( stats_sfc(j)%accum_field_values( 1, 1, stats_sfc(j)%kk, stats_sfc(j)%num_output_fields ) ) + allocate( stats_sfc(j)%accum_num_samples( 1, 1, stats_sfc(j)%kk, stats_sfc(j)%num_output_fields ) ) + allocate( stats_sfc(j)%l_in_update( 1, 1, stats_sfc(j)%kk, stats_sfc(j)%num_output_fields ) ) - call stats_init_sfc_api( clubb_vars_sfc, l_error ) + call stats_zero( stats_sfc(j)%kk, stats_sfc(j)%num_output_fields, stats_sfc(j)%accum_field_values, & + stats_sfc(j)%accum_num_samples, stats_sfc(j)%l_in_update ) + + allocate( stats_sfc(j)%file%grid_avg_var( stats_sfc(j)%num_output_fields ) ) + allocate( stats_sfc(j)%file%z( stats_sfc(j)%kk ) ) + + call stats_init_sfc_api( clubb_vars_sfc, & + l_error, & + stats_metadata, stats_sfc(j) ) + end do ! Check for errors @@ -4099,99 +5418,113 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & call endrun ('stats_init: errors found') endif -! Now call add fields - do i = 1, stats_zt%num_output_fields - - temp1 = trim(stats_zt%file%var(i)%name) + ! 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) > 16) sub = temp1(1:16) - -!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical - call addfld(trim(sub),(/ 'ilev' /),& - 'A',trim(stats_zt%file%var(i)%units),trim(stats_zt%file%var(i)%description)) + 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), & + sampled_on_subcycle=.true. ) enddo - - do i = 1, stats_zm%num_output_fields - - temp1 = trim(stats_zm%file%var(i)%name) + + 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) > 16) sub = temp1(1:16) - -!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical - call addfld(trim(sub),(/ 'ilev' /),& - 'A',trim(stats_zm%file%var(i)%units),trim(stats_zm%file%var(i)%description)) + 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), & + sampled_on_subcycle=.true. ) enddo - if (l_output_rad_files) then -!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical - do i = 1, stats_rad_zt%num_output_fields - call addfld(trim(stats_rad_zt%file%var(i)%name),(/ 'ilev' /),& - 'A',trim(stats_rad_zt%file%var(i)%units),trim(stats_rad_zt%file%var(i)%description)) + 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) + sub = temp1 + if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) + call addfld( trim(sub), (/ 'ilev' /), 'A', & + trim(stats_rad_zt(1)%file%grid_avg_var(i)%units), & + trim(stats_rad_zt(1)%file%grid_avg_var(i)%description), & + sampled_on_subcycle=.true. ) enddo - - do i = 1, stats_rad_zm%num_output_fields - call addfld(trim(stats_rad_zm%file%var(i)%name),(/ 'ilev' /),& - 'A',trim(stats_rad_zm%file%var(i)%units),trim(stats_rad_zm%file%var(i)%description)) + + do i = 1, stats_rad_zm(1)%num_output_fields + temp1 = trim(stats_rad_zm(1)%file%grid_avg_var(i)%name) + sub = temp1 + if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) + call addfld( trim(sub), (/ 'ilev' /), 'A', & + trim(stats_rad_zm(1)%file%grid_avg_var(i)%units), & + trim(stats_rad_zm(1)%file%grid_avg_var(i)%description), & + sampled_on_subcycle=.true. ) enddo - endif - - do i = 1, stats_sfc%num_output_fields - call addfld(trim(stats_sfc%file%var(i)%name),horiz_only,& - 'A',trim(stats_sfc%file%var(i)%units),trim(stats_sfc%file%var(i)%description)) + endif + + do i = 1, stats_sfc(1)%num_output_fields + temp1 = trim(stats_sfc(1)%file%grid_avg_var(i)%name) + sub = temp1 + if (len(temp1) > max_fieldname_len) sub = temp1(1:max_fieldname_len) + call addfld( trim(sub), horiz_only, 'A', & + trim(stats_sfc(1)%file%grid_avg_var(i)%units), & + trim(stats_sfc(1)%file%grid_avg_var(i)%description), & + sampled_on_subcycle=.true. ) enddo + return - end subroutine stats_init_clubb - + end subroutine stats_init_clubb + #endif ! =============================================================================== ! ! ! ! =============================================================================== ! - +#ifdef CLUBB_SGS + subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, stats_rad_zm, stats_sfc, & + out_zt, out_zm, out_radzt, out_radzm, out_sfc) !----------------------------------------------------------------------- - subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out_sfc) - ! Description: Called when the stats timestep has ended. This subroutine ! is responsible for calling statistics to be written to the output ! format. !----------------------------------------------------------------------- -#ifdef CLUBB_SGS + use shr_infnan_mod, only: is_nan => shr_infnan_isnan use clubb_api_module, only: & fstderr, & ! Constant(s) - stats_zt, & ! Variable(s) - stats_zm, & - stats_rad_zt, & - stats_rad_zm, & - stats_sfc, & - l_stats_last, & - stats_tsamp, & - stats_tout, & - l_output_rad_files, & clubb_at_least_debug_level_api ! Procedure(s) use cam_abortutils, only: endrun implicit none + integer :: thecol -#endif + ! Input Variables + type (stats), intent(inout) :: stats_zt, & ! stats_zt grid + stats_zm, & ! stats_zm grid + stats_rad_zt, & ! stats_rad_zt grid + stats_rad_zm, & ! stats_rad_zm grid + stats_sfc ! stats_sfc - integer :: thecol - + ! Inout variables real(r8), intent(inout) :: out_zt(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields) real(r8), intent(inout) :: out_zm(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields) real(r8), intent(inout) :: out_radzt(:,:,:) ! (pcols,pverp,stats_rad_zt%num_output_fields) real(r8), intent(inout) :: out_radzm(:,:,:) ! (pcols,pverp,rad_zm%num_output_fields) real(r8), intent(inout) :: out_sfc(:,:,:) ! (pcols,1,sfc%num_output_fields) -#ifdef CLUBB_SGS ! Local Variables integer :: i, k @@ -4199,7 +5532,7 @@ subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out ! Check if it is time to write to file - if ( .not. l_stats_last ) return + if ( .not. stats_metadata%l_stats_last ) return ! Initialize l_error = .false. @@ -4207,7 +5540,7 @@ subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out ! Compute averages call stats_avg( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, stats_zt%accum_num_samples ) call stats_avg( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, stats_zm%accum_num_samples ) - if (l_output_rad_files) then + if (stats_metadata%l_output_rad_files) then call stats_avg( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, & stats_rad_zt%accum_num_samples ) call stats_avg( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, & @@ -4215,36 +5548,36 @@ subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out end if call stats_avg( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, stats_sfc%accum_num_samples ) - ! Here we are not outputting the data, rather reading the stats into + ! Here we are not outputting the data, rather reading the stats into ! arrays which are conformable to CAM output. Also, the data is "flipped" - ! in the vertical level to be the same as CAM output. + ! in the vertical level to be the same as CAM output. do i = 1, stats_zt%num_output_fields - do k = 1, stats_zt%kk + do k = 1, stats_zt%kk out_zt(thecol,pverp-k+1,i) = stats_zt%accum_field_values(1,1,k,i) if(is_nan(out_zt(thecol,k,i))) out_zt(thecol,k,i) = 0.0_r8 - enddo + enddo enddo do i = 1, stats_zm%num_output_fields - do k = 1, stats_zt%kk + do k = 1, stats_zt%kk out_zm(thecol,pverp-k+1,i) = stats_zm%accum_field_values(1,1,k,i) if(is_nan(out_zm(thecol,k,i))) out_zm(thecol,k,i) = 0.0_r8 - enddo + enddo enddo - if (l_output_rad_files) then + if (stats_metadata%l_output_rad_files) then do i = 1, stats_rad_zt%num_output_fields - do k = 1, stats_rad_zt%kk + do k = 1, stats_rad_zt%kk out_radzt(thecol,pverp-k+1,i) = stats_rad_zt%accum_field_values(1,1,k,i) if(is_nan(out_radzt(thecol,k,i))) out_radzt(thecol,k,i) = 0.0_r8 - enddo + enddo enddo - + do i = 1, stats_rad_zm%num_output_fields - do k = 1, stats_rad_zm%kk + do k = 1, stats_rad_zm%kk out_radzm(thecol,pverp-k+1,i) = stats_rad_zm%accum_field_values(1,1,k,i) if(is_nan(out_radzm(thecol,k,i))) out_radzm(thecol,k,i) = 0.0_r8 - enddo + enddo enddo ! Fill in values above the CLUBB top. @@ -4254,9 +5587,9 @@ subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out out_radzm(thecol,:top_lev-1,:) = 0.0_r8 endif ! l_output_rad_files - + do i = 1, stats_sfc%num_output_fields - out_sfc(thecol,1,i) = stats_sfc%accum_field_values(1,1,1,i) + out_sfc(thecol,1,i) = stats_sfc%accum_field_values(1,1,1,i) if(is_nan(out_sfc(thecol,1,i))) out_sfc(thecol,1,i) = 0.0_r8 enddo @@ -4265,7 +5598,7 @@ subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out stats_zt%accum_num_samples, stats_zt%l_in_update ) call stats_zero( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, & stats_zm%accum_num_samples, stats_zm%l_in_update ) - if (l_output_rad_files) then + if (stats_metadata%l_output_rad_files) then call stats_zero( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, & stats_rad_zt%accum_num_samples, stats_rad_zt%l_in_update ) call stats_zero( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, & @@ -4276,17 +5609,15 @@ subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out return + end subroutine stats_end_timestep_clubb #endif - end subroutine stats_end_timestep_clubb - - ! =============================================================================== ! ! ! ! =============================================================================== ! #ifdef CLUBB_SGS - + !----------------------------------------------------------------------- subroutine stats_zero( kk, num_output_fields, x, n, l_in_update ) @@ -4320,14 +5651,14 @@ subroutine stats_zero( kk, num_output_fields, x, n, l_in_update ) return end subroutine stats_zero - + #endif ! =============================================================================== ! ! ! ! =============================================================================== ! - + #ifdef CLUBB_SGS !----------------------------------------------------------------------- subroutine stats_avg( kk, num_output_fields, x, n ) @@ -4375,9 +5706,9 @@ subroutine grid_size(state, grid_dx, grid_dy) use shr_const_mod, only: shr_const_pi use physics_types, only: physics_state - + type(physics_state), intent(in) :: state - real(r8), intent(out) :: grid_dx(pcols), grid_dy(pcols) ! CAM grid [m] + real(r8), intent(out) :: grid_dx(state%ncol), grid_dy(state%ncol) ! CAM grid [m] real(r8), parameter :: earth_ellipsoid1 = 111132.92_r8 ! first coefficient, meters per degree longitude at equator real(r8), parameter :: earth_ellipsoid2 = 559.82_r8 ! second expansion coefficient for WGS84 ellipsoid @@ -4390,220 +5721,17 @@ subroutine grid_size(state, grid_dx, grid_dy) do i=1,state%ncol column_area = get_area_p(state%lchnk,i) degree = sqrt(column_area)*(180._r8/shr_const_pi) - + ! Now find meters per degree latitude ! Below equation finds distance between two points on an ellipsoid, derived from expansion - ! taking into account ellipsoid using World Geodetic System (WGS84) reference + ! taking into account ellipsoid using World Geodetic System (WGS84) reference mpdeglat = earth_ellipsoid1 - earth_ellipsoid2 * cos(2._r8*state%lat(i)) + earth_ellipsoid3 * cos(4._r8*state%lat(i)) grid_dx(i) = mpdeglat * degree grid_dy(i) = grid_dx(i) ! Assume these are the same - enddo + enddo - end subroutine grid_size + end subroutine grid_size #endif -#ifdef CLUBB_SGS - subroutine init_clubb_config_flags( clubb_config_flags_in ) -!------------------------------------------------------------------------------- -! Description: -! Initializes the public module variable 'clubb_config_flags' of type -! 'clubb_config_flags_type' on first call and only on first call. -! References: -! None -!------------------------------------------------------------------------------- - use clubb_api_module, only: & - clubb_config_flags_type, & ! Type - set_default_clubb_config_flags_api, & ! Procedure(s) - initialize_clubb_config_flags_type_api - - implicit none - - ! Input/Output Variables - type(clubb_config_flags_type), intent(inout) :: clubb_config_flags_in - - ! Local Variables - logical :: & - l_use_precip_frac, & ! Flag to use precipitation fraction in KK microphysics. The - ! precipitation fraction is automatically set to 1 when this - ! flag is turned off. - l_predict_upwp_vpwp, & ! Flag to predict and along with and - ! alongside the advancement of , , , - ! , , and in subroutine - ! advance_xm_wpxp. Otherwise, and are still - ! approximated by eddy diffusivity when and are - ! advanced in subroutine advance_windm_edsclrm. - l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping - ! the overall correlation of w and x (w and rt, as well as w - ! and theta-l) within the limits of -max_mag_correlation_flux - ! to max_mag_correlation_flux. - l_min_xp2_from_corr_wx, & ! Flag to base the threshold minimum value of xp2 (rtp2 and - ! thlp2) on keeping the overall correlation of w and x within - ! the limits of -max_mag_correlation_flux to - ! max_mag_correlation_flux. - l_C2_cloud_frac, & ! Flag to use cloud fraction to adjust the value of the - ! turbulent dissipation coefficient, C2. - l_diffuse_rtm_and_thlm, & ! Diffuses rtm and thlm - l_stability_correct_Kh_N2_zm, & ! Divides Kh_N2_zm by a stability factor - l_calc_thlp2_rad, & ! Include the contribution of radiation to thlp2 - l_upwind_wpxp_ta, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent or mean advection terms. It - ! affects wprtp, wpthlp, & wpsclrp. - l_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent or mean advection terms. It - ! affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, & - ! sclrpthlp. - l_upwind_xm_ma, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent or mean advection terms. It - ! affects rtm, thlm, sclrm, um and vm. - l_uv_nudge, & ! For wind speed nudging. - l_rtm_nudge, & ! For rtm nudging - l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. - ! TKE = 1/2 (u'^2 + v'^2 + w'^2) - l_vert_avg_closure, & ! Use 2 calls to pdf_closure and the trapezoidal rule to - ! compute the varibles that are output from high order - ! closure - l_trapezoidal_rule_zt, & ! If true, the trapezoidal rule is called for the - ! thermodynamic-level variables output from pdf_closure. - l_trapezoidal_rule_zm, & ! If true, the trapezoidal rule is called for three - ! momentum-level variables - wpthvp, thlpthvp, and rtpthvp - - ! output from pdf_closure. - l_call_pdf_closure_twice, & ! This logical flag determines whether or not to call - ! subroutine pdf_closure twice. If true, pdf_closure is - ! called first on thermodynamic levels and then on momentum - ! levels so that each variable is computed on its native - ! level. If false, pdf_closure is only called on - ! thermodynamic levels, and variables which belong on - ! momentum levels are interpolated. - l_standard_term_ta, & ! Use the standard discretization for the turbulent advection - ! terms. Setting to .false. means that a_1 and a_3 are - ! pulled outside of the derivative in - ! advance_wp2_wp3_module.F90 and in - ! advance_xp2_xpyp_module.F90. - l_use_cloud_cover, & ! Use cloud_cover and rcm_in_layer to help boost cloud_frac - ! and rcm to help increase cloudiness at coarser grid - ! resolutions. - l_diagnose_correlations, & ! Diagnose correlations instead of using fixed ones - l_calc_w_corr, & ! Calculate the correlations between w and the hydrometeors - l_const_Nc_in_cloud, & ! Use a constant cloud droplet conc. within cloud (K&K) - l_fix_w_chi_eta_correlations, & ! Use a fixed correlation for s and t Mellor(chi/eta) - l_stability_correct_tau_zm, & ! Use tau_N2_zm instead of tau_zm in wpxp_pr1 stability - ! correction - l_damp_wp2_using_em, & ! In wp2 equation, use a dissipation formula of - ! -(2/3)*em/tau_zm, as in Bougeault (1981) - l_do_expldiff_rtm_thlm, & ! Diffuse rtm and thlm explicitly - l_Lscale_plume_centered, & ! Alternate that uses the PDF to compute the perturbed values - l_diag_Lscale_from_tau, & ! First diagnose dissipation time tau, and then diagnose the - ! mixing length scale as Lscale = tau * tke - l_use_ice_latent, & ! Includes the effects of ice latent heating in turbulence - ! terms - l_use_C7_Richardson, & ! Parameterize C7 based on Richardson number - l_use_C11_Richardson, & ! Parameterize C11 and C16 based on Richardson number - l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in - ! saturated atmospheres (from Durran and Klemp, 1982) - l_use_thvm_in_bv_freq, & ! Use thvm in the calculation of Brunt-Vaisala frequency - l_rcm_supersat_adj, & ! Add excess supersaturated vapor to cloud water - l_single_C2_Skw, & ! Use a single Skewness dependent C2 for rtp2, thlp2, and - ! rtpthlp - l_damp_wp3_Skw_squared, & ! Set damping on wp3 to use Skw^2 rather than Skw^4 - l_prescribed_avg_deltaz, & ! used in adj_low_res_nu. If .true., avg_deltaz = deltaz - l_update_pressure ! Flag for having CLUBB update pressure and exner - - logical, save :: first_call = .true. - - if (first_call) then - - call set_default_clubb_config_flags_api( l_use_precip_frac, & ! Out - l_predict_upwp_vpwp, & ! Out - l_min_wp2_from_corr_wx, & ! Out - l_min_xp2_from_corr_wx, & ! Out - l_C2_cloud_frac, & ! Out - l_diffuse_rtm_and_thlm, & ! Out - l_stability_correct_Kh_N2_zm, & ! Out - l_calc_thlp2_rad, & ! Out - l_upwind_wpxp_ta, & ! Out - l_upwind_xpyp_ta, & ! Out - l_upwind_xm_ma, & ! Out - l_uv_nudge, & ! Out - l_rtm_nudge, & ! Out - l_tke_aniso, & ! Out - l_vert_avg_closure, & ! Out - l_trapezoidal_rule_zt, & ! Out - l_trapezoidal_rule_zm, & ! Out - l_call_pdf_closure_twice, & ! Out - l_standard_term_ta, & ! Out - l_use_cloud_cover, & ! Out - l_diagnose_correlations, & ! Out - l_calc_w_corr, & ! Out - l_const_Nc_in_cloud, & ! Out - l_fix_w_chi_eta_correlations, & ! Out - l_stability_correct_tau_zm, & ! Out - l_damp_wp2_using_em, & ! Out - l_do_expldiff_rtm_thlm, & ! Out - l_Lscale_plume_centered, & ! Out - l_diag_Lscale_from_tau, & ! Out - l_use_ice_latent, & ! Out - l_use_C7_Richardson, & ! Out - l_use_C11_Richardson, & ! Out - l_brunt_vaisala_freq_moist, & ! Out - l_use_thvm_in_bv_freq, & ! Out - l_rcm_supersat_adj, & ! Out - l_single_C2_Skw, & ! Out - l_damp_wp3_Skw_squared, & ! Out - l_prescribed_avg_deltaz, & ! Out - l_update_pressure ) ! Out - - call initialize_clubb_config_flags_type_api( l_use_precip_frac, & ! In - l_predict_upwp_vpwp, & ! In - l_min_wp2_from_corr_wx, & ! In - l_min_xp2_from_corr_wx, & ! In - l_C2_cloud_frac, & ! In - l_diffuse_rtm_and_thlm, & ! In - l_stability_correct_Kh_N2_zm, & ! In - l_calc_thlp2_rad, & ! In - l_upwind_wpxp_ta, & ! In - l_upwind_xpyp_ta, & ! In - l_upwind_xm_ma, & ! In - l_uv_nudge, & ! In - l_rtm_nudge, & ! In - l_tke_aniso, & ! In - l_vert_avg_closure, & ! In - l_trapezoidal_rule_zt, & ! In - l_trapezoidal_rule_zm, & ! In - l_call_pdf_closure_twice, & ! In - l_standard_term_ta, & ! In - l_use_cloud_cover, & ! In - l_diagnose_correlations, & ! In - l_calc_w_corr, & ! In - l_const_Nc_in_cloud, & ! In - l_fix_w_chi_eta_correlations, & ! In - l_stability_correct_tau_zm, & ! In - l_damp_wp2_using_em, & ! In - l_do_expldiff_rtm_thlm, & ! In - l_Lscale_plume_centered, & ! In - l_diag_Lscale_from_tau, & ! In - l_use_ice_latent, & ! In - l_use_C7_Richardson, & ! In - l_use_C11_Richardson, & ! In - l_brunt_vaisala_freq_moist, & ! In - l_use_thvm_in_bv_freq, & ! In - l_rcm_supersat_adj, & ! In - l_single_C2_Skw, & ! In - l_damp_wp3_Skw_squared, & ! In - l_prescribed_avg_deltaz, & ! In - l_update_pressure, & ! In - clubb_config_flags_in ) ! Out - - first_call = .false. - - end if - - return - - end subroutine init_clubb_config_flags -#endif - end module clubb_intr diff --git a/src/physics/cam/constituents.F90 b/src/physics/cam/constituents.F90 index 528f254497..b93cf060b3 100644 --- a/src/physics/cam/constituents.F90 +++ b/src/physics/cam/constituents.F90 @@ -57,8 +57,8 @@ module constituents real(r8), public :: cnst_rgas(pcnst) ! gas constant () real(r8), public :: qmin (pcnst) ! minimum permitted constituent concentration (kg/kg) real(r8), public :: qmincg (pcnst) ! for backward compatibility only -logical, public :: cnst_fixed_ubc(pcnst) = .false. ! upper bndy condition = fixed ? -logical, public :: cnst_fixed_ubflx(pcnst) = .false.! upper boundary non-zero fixed constituent flux +logical, public, protected :: cnst_fixed_ubc(pcnst) = .false. ! upper boundary condition (concentration) +logical, public, protected :: cnst_fixed_ubflx(pcnst) = .false. ! upper boundary non-zero fixed constituent flux logical, public, protected :: cnst_is_convtran1(pcnst) = .false. ! do convective transport in phase 1 logical, public, protected :: cnst_is_convtran2(pcnst) = .false. ! do convective transport in phase 2 @@ -72,7 +72,6 @@ module constituents character(len=16), public :: fixcnam (pcnst) ! names of species slt fixer tendencies character(len=16), public :: tendnam (pcnst) ! names of total tendencies of species character(len=16), public :: ptendnam (pcnst) ! names of total physics tendencies of species -character(len=16), public :: dmetendnam(pcnst) ! names of dme adjusted tracers (FV) character(len=16), public :: sflxnam (pcnst) ! names of surface fluxes of species character(len=16), public :: tottnam (pcnst) ! names for horz + vert + fixer tendencies @@ -174,7 +173,7 @@ subroutine cnst_add (name, mwc, cpc, qminc, & padv = padv+1 ind = padv if (padv > pcnst) then - write(errmsg, *) sub//': FATAL: advected tracer index greater than pcnst=', pcnst + write(errmsg, *) sub//': FATAL: advected tracer (', trim(name), ') index is greater than number of constituents' call endrun(errmsg) end if @@ -207,7 +206,7 @@ subroutine cnst_add (name, mwc, cpc, qminc, & cnst_molec(ind) = 'minor' end if - ! set outfld type + ! set outfld type ! (false: the module declaring the constituent is responsible for outfld calls) if (present(cam_outfld)) then cam_outfld_(ind) = cam_outfld @@ -320,7 +319,7 @@ subroutine cnst_set_spec_class(ind, cnst_spec_class_in) write(iulog,*) subname//': illegal tracer index: padv, ind = ', padv, ind call endrun(subname//': illegal tracer index') end if - + ! Check designator if (cnst_spec_class_in /= cnst_spec_class_undefined .and. & cnst_spec_class_in /= cnst_spec_class_cldphysics .and. & @@ -380,7 +379,7 @@ subroutine cnst_get_ind (name, ind, abort) if (present(abort)) abort_on_error = abort if (abort_on_error) then - write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', cnst_name(:) + write(iulog, *) sub//': FATAL: name:', name, ' not found in constituent list: ', cnst_name(:) call endrun(sub//': FATAL: name not found') end if @@ -393,7 +392,7 @@ end subroutine cnst_get_ind character*3 function cnst_get_type_byind(ind) - ! Return the mixing ratio type of a constituent + ! Return the mixing ratio type of a constituent !-----------------------------Arguments--------------------------------- integer, intent(in) :: ind ! global constituent index (in q array) @@ -417,7 +416,7 @@ end function cnst_get_type_byind character*5 function cnst_get_molec_byind (ind) - ! Return the molecular diffusion type of a constituent + ! Return the molecular diffusion type of a constituent !-----------------------------Arguments--------------------------------- integer, intent(in) :: ind ! global constituent index (in q array) @@ -497,7 +496,6 @@ subroutine cnst_chk_dim fixcnam (m) = 'DF'//cnst_name(m) tendnam (m) = 'TE'//cnst_name(m) ptendnam (m) = 'PTE'//cnst_name(m) - dmetendnam(m) = 'DME'//cnst_name(m) tottnam (m) = 'TA'//cnst_name(m) sflxnam(m) = 'SF'//cnst_name(m) end do @@ -510,7 +508,7 @@ function cnst_cam_outfld(m) ! Query whether default CAM outfld calls should be made. - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- integer, intent(in) :: m ! constituent index logical :: cnst_cam_outfld ! true => use default CAM outfld calls @@ -535,7 +533,7 @@ pure logical function cnst_is_a_water_species(name) ! test whether the input name matches the name of a water species - character(len=*), intent(in) :: name + character(len=*), intent(in) :: name !------------------------------------------------------------------------- cnst_is_a_water_species = .false. @@ -546,7 +544,7 @@ pure logical function cnst_is_a_water_species(name) name == 'RAINQM' .or. & name == 'SNOWQM' .or. & name == 'GRAUQM' ) cnst_is_a_water_species = .true. - + end function cnst_is_a_water_species !============================================================================== diff --git a/src/physics/cam/conv_water.F90 b/src/physics/cam/conv_water.F90 index dfcdb7be98..fb054c87b1 100644 --- a/src/physics/cam/conv_water.F90 +++ b/src/physics/cam/conv_water.F90 @@ -3,7 +3,7 @@ module conv_water ! --------------------------------------------------------------------- ! ! Purpose: ! ! Computes grid-box average liquid (and ice) from stratus and cumulus ! - ! Just for the purposes of radiation. ! + ! These values used by both the radiation and the COSP diagnostics. ! ! ! ! Method: ! ! Extract information about deep+shallow liquid and cloud fraction from ! @@ -38,9 +38,10 @@ module conv_water ! pbuf indices integer :: icwmrsh_idx, icwmrdp_idx, fice_idx, sh_frac_idx, dp_frac_idx, & - ast_idx, sh_cldliq1_idx, sh_cldice1_idx, rei_idx + ast_idx, rei_idx integer :: ixcldice, ixcldliq + integer :: gb_totcldliqmr_idx, gb_totcldicemr_idx ! Namelist integer, parameter :: unset_int = huge(1) @@ -113,11 +114,10 @@ subroutine conv_water_register !----------------------------------------------------------------------- - ! these calls were already done in convect_shallow...so here I add the same fields to the physics buffer with a "1" at the end -! shallow gbm cloud liquid water (kg/kg) - call pbuf_add_field('SH_CLDLIQ1','physpkg',dtype_r8,(/pcols,pver/),sh_cldliq1_idx) -! shallow gbm cloud ice water (kg/kg) - call pbuf_add_field('SH_CLDICE1','physpkg',dtype_r8,(/pcols,pver/),sh_cldice1_idx) + ! grid box total cloud liquid water mixing ratio (kg/kg) + call pbuf_add_field('GB_TOTCLDLIQMR', 'physpkg', dtype_r8, (/pcols,pver/), gb_totcldliqmr_idx) + ! grid box total cloud ice water mixing ratio (kg/kg) + call pbuf_add_field('GB_TOTCLDICEMR', 'physpkg', dtype_r8, (/pcols,pver/), gb_totcldicemr_idx) end subroutine conv_water_register @@ -168,7 +168,7 @@ subroutine conv_water_init() end subroutine conv_water_init - subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) + subroutine conv_water_4rad(state, pbuf) ! --------------------------------------------------------------------- ! ! Purpose: ! @@ -202,9 +202,6 @@ subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) type(physics_state), target, intent(in) :: state ! state variables type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out):: totg_ice(pcols,pver) ! Total GBA in-cloud ice - real(r8), intent(out):: totg_liq(pcols,pver) ! Total GBA in-cloud liquid - ! --------------- ! ! Local Workspace ! ! --------------- ! @@ -222,8 +219,9 @@ subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) real(r8), pointer, dimension(:,:) :: dp_icwmr ! Deep conv. cloud water real(r8), pointer, dimension(:,:) :: sh_icwmr ! Shallow conv. cloud water real(r8), pointer, dimension(:,:) :: fice ! Ice partitioning ratio - real(r8), pointer, dimension(:,:) :: sh_cldliq ! shallow convection gbx liq cld mixing ratio for COSP - real(r8), pointer, dimension(:,:) :: sh_cldice ! shallow convection gbx ice cld mixing ratio for COSP + + real(r8), pointer, dimension(:,:) :: totg_ice ! Grid box total cloud ice mixing ratio + real(r8), pointer, dimension(:,:) :: totg_liq ! Grid box total cloud liquid mixing ratio real(r8) :: conv_ice(pcols,pver) ! Convective contributions to IC cloud ice real(r8) :: conv_liq(pcols,pver) ! Convective contributions to IC cloud liquid @@ -282,6 +280,10 @@ subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) itim_old = pbuf_old_tim_idx() call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + ! Fields computed below and stored in pbuf. + call pbuf_get_field(pbuf, gb_totcldicemr_idx, totg_ice) + call pbuf_get_field(pbuf, gb_totcldliqmr_idx, totg_liq) + ! --------------------------------------------------------------- ! ! Loop through grid-boxes and determine: ! ! 1. Effective mean in-cloud convective ice/liquid (deep+shallow) ! @@ -332,7 +334,7 @@ subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) ! Select radiation constants (effective radii) for emissivity averaging. - if( microp_scheme == 'RK' .or. microp_scheme == 'SPCAM_sam1mom') then + if( microp_scheme == 'RK') then kabsi = 0.005_r8 + 1._r8/rei(i,k) else kabsi = 0.005_r8 + 1._r8/min(max(13._r8,rei(i,k)),130._r8) @@ -407,13 +409,6 @@ subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) end do end do -!add pbuff calls for COSP - call pbuf_get_field(pbuf, sh_cldliq1_idx, sh_cldliq ) - call pbuf_get_field(pbuf, sh_cldice1_idx, sh_cldice ) - - sh_cldliq(:ncol,:pver)=sh_icwmr(:ncol,:pver)*(1-fice(:ncol,:pver))*sh_frac(:ncol,:pver) - sh_cldice(:ncol,:pver)=sh_icwmr(:ncol,:pver)*fice(:ncol,:pver)*sh_frac(:ncol,:pver) - ! Output convective IC WMRs call outfld( 'ICLMRCU ', conv_liq , pcols, lchnk ) diff --git a/src/physics/cam/convect_deep.F90 b/src/physics/cam/convect_deep.F90 index edd2043623..2262d8f25c 100644 --- a/src/physics/cam/convect_deep.F90 +++ b/src/physics/cam/convect_deep.F90 @@ -5,7 +5,7 @@ module convect_deep ! ! CAM interface to several deep convection interfaces. Currently includes: ! Zhang-McFarlane (default) -! Kerry Emanuel +! Kerry Emanuel ! ! ! Author: D.B. Coleman, Sep 2004 @@ -28,34 +28,34 @@ module convect_deep convect_deep_tend, &! return tendencies convect_deep_tend_2, &! return tendencies deep_scheme_does_scav_trans ! = .t. if scheme does scavenging and conv. transport - + ! Private module data character(len=16) :: deep_scheme ! default set in phys_control.F90, use namelist to change -! Physics buffer indices - integer :: icwmrdp_idx = 0 - integer :: rprddp_idx = 0 - integer :: nevapr_dpcu_idx = 0 - integer :: cldtop_idx = 0 - integer :: cldbot_idx = 0 - integer :: cld_idx = 0 - integer :: fracis_idx = 0 - - integer :: pblh_idx = 0 - integer :: tpert_idx = 0 +! Physics buffer indices + integer :: icwmrdp_idx = 0 + integer :: rprddp_idx = 0 + integer :: nevapr_dpcu_idx = 0 + integer :: cldtop_idx = 0 + integer :: cldbot_idx = 0 + integer :: cld_idx = 0 + integer :: fracis_idx = 0 + + integer :: pblh_idx = 0 + integer :: tpert_idx = 0 integer :: prec_dp_idx = 0 integer :: snow_dp_idx = 0 integer :: ttend_dp_idx = 0 !========================================================================================= - contains + contains !========================================================================================= function deep_scheme_does_scav_trans() ! ! Function called by tphysbc to determine if it needs to do scavenging and convective transport ! or if those have been done by the deep convection scheme. Each scheme could have its own -! identical query function for a less-knowledgable interface but for now, we know that KE +! identical query function for a less-knowledgable interface but for now, we know that KE ! does scavenging & transport, and ZM doesn't ! @@ -76,7 +76,7 @@ subroutine convect_deep_register ! Purpose: register fields with the physics buffer !---------------------------------------- - + use physics_buffer, only : pbuf_add_field, dtype_r8 use zm_conv_intr, only: zm_conv_register use phys_control, only: phys_getopts, use_gw_convect_dp @@ -118,12 +118,12 @@ subroutine convect_deep_init(pref_edge) ! Purpose: declare output fields, initialize variables needed by convection !---------------------------------------- - use cam_history, only: addfld + use cam_history, only: addfld use pmgrid, only: plevp use spmd_utils, only: masterproc use zm_conv_intr, only: zm_conv_init use cam_abortutils, only: endrun - + use physics_buffer, only: physics_buffer_desc, pbuf_get_index implicit none @@ -140,9 +140,6 @@ subroutine convect_deep_init(pref_edge) call zm_conv_init(pref_edge) case('UNICON') if (masterproc) write(iulog,*)'convect_deep: deep convection done by UNICON' - case('SPCAM') - if (masterproc) write(iulog,*)'convect_deep: deep convection done by SPCAM' - return case default if (masterproc) write(iulog,*)'WARNING: convect_deep: no deep convection scheme. May fail.' end select @@ -169,14 +166,14 @@ end subroutine convect_deep_init subroutine convect_deep_tend( & mcon ,cme , & - pflx ,zdu , & + zdu , & rliq ,rice , & ztodt , & state ,ptend ,landfrac ,pbuf) use physics_types, only: physics_state, physics_ptend, physics_tend, physics_ptend_init - + use cam_history, only: outfld use constituents, only: pcnst use zm_conv_intr, only: zm_conv_tend @@ -187,15 +184,14 @@ subroutine convect_deep_tend( & ! Arguments type(physics_state), intent(in ) :: state ! Physics state variables type(physics_ptend), intent(out) :: ptend ! individual parameterization tendencies - + type(physics_buffer_desc), pointer :: pbuf(:) real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) real(r8), intent(in) :: landfrac(pcols) ! Land fraction - + real(r8), intent(out) :: mcon(pcols,pverp) ! Convective mass flux--m sub c - real(r8), intent(out) :: pflx(pcols,pverp) ! scattered precip flux at each level real(r8), intent(out) :: cme(pcols,pver) ! cmf condensation - evaporation real(r8), intent(out) :: zdu(pcols,pver) ! detraining mass flux @@ -203,11 +199,11 @@ subroutine convect_deep_tend( & real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldice) for energy integrals real(r8), pointer :: prec(:) ! total precipitation - real(r8), pointer :: snow(:) ! snow from ZM convection + real(r8), pointer :: snow(:) ! snow from ZM convection real(r8), pointer, dimension(:) :: jctop real(r8), pointer, dimension(:) :: jcbot - real(r8), pointer, dimension(:,:,:) :: cld + real(r8), pointer, dimension(:,:,:) :: cld real(r8), pointer, dimension(:,:) :: ql ! wg grid slice of cloud liquid water. real(r8), pointer, dimension(:,:) :: rprd ! rain production rate real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble @@ -230,9 +226,8 @@ subroutine convect_deep_tend( & select case ( deep_scheme ) case('off', 'UNICON', 'CLUBB_SGS') ! in UNICON case the run method is called from convect_shallow_tend - zero = 0 + zero = 0 mcon = 0 - pflx = 0 cme = 0 zdu = 0 rliq = 0 @@ -244,7 +239,7 @@ subroutine convect_deep_tend( & ! Associate pointers with physics buffer fields ! - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1/), kount=(/pcols,pver/) ) + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1/), kount=(/pcols,pver/) ) call pbuf_get_field(pbuf, rprddp_idx, rprd ) call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp ) @@ -267,7 +262,7 @@ subroutine convect_deep_tend( & call pbuf_get_field(pbuf, tpert_idx, tpert) call zm_conv_tend( pblh ,mcon ,cme , & - tpert ,pflx ,zdu , & + tpert ,zdu , & rliq ,rice , & ztodt , & jctop, jcbot , & @@ -291,7 +286,7 @@ end subroutine convect_deep_tend subroutine convect_deep_tend_2( state, ptend, ztodt, pbuf) use physics_types, only: physics_state, physics_ptend, physics_ptend_init - + use physics_buffer, only: physics_buffer_desc use constituents, only: pcnst use zm_conv_intr, only: zm_conv_tend_2 @@ -299,14 +294,14 @@ subroutine convect_deep_tend_2( state, ptend, ztodt, pbuf) ! Arguments type(physics_state), intent(in ) :: state ! Physics state variables type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies - + type(physics_buffer_desc), pointer :: pbuf(:) real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) if ( deep_scheme .eq. 'ZM' ) then ! Zhang-McFarlane - call zm_conv_tend_2( state, ptend, ztodt, pbuf) + call zm_conv_tend_2( state, ptend, ztodt, pbuf) else call physics_ptend_init(ptend, state%psetcols, 'convect_deep') end if diff --git a/src/physics/cam/convect_shallow.F90 b/src/physics/cam/convect_shallow.F90 index f4f40d7d50..9edd28c696 100644 --- a/src/physics/cam/convect_shallow.F90 +++ b/src/physics/cam/convect_shallow.F90 @@ -13,25 +13,28 @@ module convect_shallow use shr_kind_mod, only : r8=>shr_kind_r8 use physconst, only : cpair, zvir use ppgrid, only : pver, pcols, pverp - use zm_conv, only : zm_conv_evap + use zm_conv_evap, only : zm_conv_evap_run + use zm_conv_intr, only : zmconv_ke, zmconv_ke_lnd use cam_history, only : outfld, addfld, horiz_only use cam_logfile, only : iulog use phys_control, only : phys_getopts + use cloud_fraction_fice, only: cloud_fraction_fice_run + use ref_pres, only: trop_cloud_top_lev implicit none - private + private save public :: & convect_shallow_register, & ! Register fields in physics buffer convect_shallow_init, & ! Initialize shallow module convect_shallow_tend, & ! Return tendencies - convect_shallow_use_shfrc ! + convect_shallow_use_shfrc ! ! The following namelist variable controls which shallow convection package is used. ! 'Hack' = Hack shallow convection (default) ! 'UW' = UW shallow convection by Sungsu Park and Christopher S. Bretherton - ! 'UNICON' = General Convection Model by Sungsu Park + ! 'UNICON' = General Convection Model by Sungsu Park ! 'off' = No shallow convection character(len=16) :: shallow_scheme ! Default set in phys_control.F90, use namelist to change @@ -40,16 +43,16 @@ module convect_shallow logical :: history_budget ! Output tendencies and state variables for CAM4 T, qv, ql, qi integer :: history_budget_histfile_num ! output history file number for budget fields - ! Physics buffer indices - integer :: icwmrsh_idx = 0 - integer :: rprdsh_idx = 0 - integer :: rprdtot_idx = 0 - integer :: cldtop_idx = 0 - integer :: cldbot_idx = 0 - integer :: cush_idx = 0 + ! Physics buffer indices + integer :: icwmrsh_idx = 0 + integer :: rprdsh_idx = 0 + integer :: rprdtot_idx = 0 + integer :: cldtop_idx = 0 + integer :: cldbot_idx = 0 + integer :: cush_idx = 0 integer :: nevapr_shcu_idx = 0 - integer :: shfrc_idx = 0 - integer :: cld_idx = 0 + integer :: shfrc_idx = 0 + integer :: cld_idx = 0 integer :: concld_idx = 0 integer :: rprddp_idx = 0 integer :: tke_idx = 0 @@ -84,18 +87,15 @@ subroutine convect_shallow_register use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls use phys_control, only: use_gw_convect_sh use unicon_cam, only: unicon_cam_register - + call phys_getopts( shallow_scheme_out = shallow_scheme, microp_scheme_out = microp_scheme) - - ! SPCAM registers its own fields - if (shallow_scheme == 'SPCAM') return call pbuf_add_field('ICWMRSH', 'physpkg' ,dtype_r8,(/pcols,pver/), icwmrsh_idx ) call pbuf_add_field('RPRDSH', 'physpkg' ,dtype_r8,(/pcols,pver/), rprdsh_idx ) call pbuf_add_field('RPRDTOT', 'physpkg' ,dtype_r8,(/pcols,pver/), rprdtot_idx ) call pbuf_add_field('CLDTOP', 'physpkg' ,dtype_r8,(/pcols,1/), cldtop_idx ) call pbuf_add_field('CLDBOT', 'physpkg' ,dtype_r8,(/pcols,1/), cldbot_idx ) - call pbuf_add_field('cush', 'global' ,dtype_r8,(/pcols,dyn_time_lvls/), cush_idx ) + call pbuf_add_field('cush', 'global' ,dtype_r8,(/pcols,dyn_time_lvls/), cush_idx ) call pbuf_add_field('NEVAPR_SHCU','physpkg' ,dtype_r8,(/pcols,pver/), nevapr_shcu_idx ) call pbuf_add_field('PREC_SH', 'physpkg' ,dtype_r8,(/pcols/), prec_sh_idx ) call pbuf_add_field('SNOW_SH', 'physpkg' ,dtype_r8,(/pcols/), snow_sh_idx ) @@ -110,16 +110,16 @@ subroutine convect_shallow_register endif ! shallow interface gbm flux_convective_cloud_rain+snow (kg/m2/s) - call pbuf_add_field('SH_FLXPRC','physpkg',dtype_r8,(/pcols,pverp/),sh_flxprc_idx) + call pbuf_add_field('SH_FLXPRC','physpkg',dtype_r8,(/pcols,pverp/),sh_flxprc_idx) ! shallow interface gbm flux_convective_cloud_snow (kg/m2/s) - call pbuf_add_field('SH_FLXSNW','physpkg',dtype_r8,(/pcols,pverp/),sh_flxsnw_idx) + call pbuf_add_field('SH_FLXSNW','physpkg',dtype_r8,(/pcols,pverp/),sh_flxsnw_idx) ! shallow gbm cloud liquid water (kg/kg) - call pbuf_add_field('SH_CLDLIQ','physpkg',dtype_r8,(/pcols,pver/),sh_cldliq_idx) + call pbuf_add_field('SH_CLDLIQ','physpkg',dtype_r8,(/pcols,pver/),sh_cldliq_idx) ! shallow gbm cloud ice water (kg/kg) - call pbuf_add_field('SH_CLDICE','physpkg',dtype_r8,(/pcols,pver/),sh_cldice_idx) + call pbuf_add_field('SH_CLDICE','physpkg',dtype_r8,(/pcols,pver/),sh_cldice_idx) ! If gravity waves from shallow convection are on, output this field. if (use_gw_convect_sh) then @@ -154,7 +154,7 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) use spmd_utils, only : masterproc use cam_abortutils, only : endrun use phys_control, only : cam_physpkg_is - + use physics_buffer, only : pbuf_get_index, physics_buffer_desc, pbuf_set_field real(r8), intent(in) :: pref_edge(plevp) ! Reference pressures at interfaces @@ -163,9 +163,6 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) integer limcnv ! Top interface level limit for convection integer k character(len=16) :: eddy_scheme - - ! SPCAM does its own convection - if (shallow_scheme == 'SPCAM') return ! ------------------------------------------------- ! ! Variables for detailed abalysis of UW-ShCu scheme ! @@ -214,7 +211,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( 'CIN', horiz_only, 'A', 'J/kg', 'Convective inhibition' ) + 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' ) @@ -222,7 +219,7 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) call addfld( 'PCLDBOT', horiz_only, 'A', '1', 'Pressure of cloud base' ) call addfld( 'FREQSH', horiz_only, 'A', 'fraction', 'Fractional occurance of shallow convection' ) - + call addfld( 'HKFLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s', 'Flux of precipitation from HK convection' ) call addfld( 'HKFLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s', 'Flux of snow from HK convection' ) call addfld( 'HKNTPRPD', (/ 'lev' /), 'A', 'kg/kg/s', 'Net precipitation production from HK convection' ) @@ -249,7 +246,7 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) call add_default( 'CMFDICE ', history_budget_histfile_num, ' ' ) call add_default( 'CMFDT ', history_budget_histfile_num, ' ' ) call add_default( 'CMFDQ ', history_budget_histfile_num, ' ' ) - if( cam_physpkg_is('cam3') .or. cam_physpkg_is('cam4') ) then + if( cam_physpkg_is('cam4') ) then call add_default( 'EVAPQCM ', history_budget_histfile_num, ' ' ) call add_default( 'EVAPTCM ', history_budget_histfile_num, ' ' ) end if @@ -287,7 +284,7 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) if( masterproc ) then write(iulog,*) 'MFINTI: Convection will be capped at intfc ', limcnv, ' which is ', pref_edge(limcnv), ' pascals' end if - + call mfinti( rair, cpair, gravit, latvap, rhoh2o, limcnv) ! Get args from inti.F90 case('UW') ! Park and Bretherton shallow convection scheme @@ -347,7 +344,7 @@ end function convect_shallow_use_shfrc !=============================================================================== ! subroutine convect_shallow_tend( ztodt , cmfmc , & - qc , qc2 , rliq , rliq2 , & + qc , qc2 , rliq , rliq2 , & state , ptend_all, pbuf, cam_in) use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_set_field, pbuf_old_tim_idx @@ -358,7 +355,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & use physics_types, only : physics_ptend_dealloc use physics_types, only : physics_ptend_sum use camsrfexch, only : cam_in_t - + use constituents, only : pcnst, cnst_get_ind, cnst_get_type_byind use hk_conv, only : cmfmca use uwshcu, only : compute_uwshcu_inv @@ -366,7 +363,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & use time_manager, only : get_nstep use wv_saturation, only : qsat - use physconst, only : latice, latvap, rhoh2o + use physconst, only : latice, latvap, rhoh2o, tmelt, gravit use spmd_utils, only : iam implicit none @@ -382,7 +379,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & real(r8), intent(out) :: rliq2(pcols) ! Vertically-integrated reserved cloud condensate [ m/s ] real(r8), intent(out) :: qc2(pcols,pver) ! Same as qc but only from shallow convection scheme - + real(r8), intent(inout) :: cmfmc(pcols,pverp) ! Moist deep + shallow convection cloud mass flux [ kg/s/m2 ] real(r8), intent(inout) :: qc(pcols,pver) ! dq/dt due to export of cloud water into environment by shallow @@ -393,7 +390,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & ! --------------- ! - ! Local Variables ! + ! Local Variables ! ! --------------- ! integer :: i, k, m integer :: n, x @@ -433,7 +430,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & real(r8) :: pcnb(pcols) ! Bottom pressure level of shallow + deep convective activity real(r8) :: cmfsl(pcols,pverp ) ! Convective flux of liquid water static energy real(r8) :: cmflq(pcols,pverp ) ! Convective flux of total water in energy unit - + real(r8) :: ftem_preCu(pcols,pver) ! Saturation vapor pressure after shallow Cu convection real(r8) :: tem2(pcols,pver) ! Saturation specific humidity and RH real(r8) :: t_preCu(pcols,pver) ! Temperature after shallow Cu convection @@ -443,7 +440,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & real(r8) :: icwmr_UW(pcols,pver) ! In-cloud Cumulus LWC [ kg/m2 ] real(r8) :: icimr_UW(pcols,pver) ! In-cloud Cumulus IWC [ kg/m2 ] real(r8) :: ptend_tracer(pcols,pver,pcnst) ! Tendencies of tracers - real(r8) :: sum1, sum2, sum3, pdelx + real(r8) :: sum1, sum2, sum3, pdelx real(r8) :: landfracdum(pcols) real(r8), dimension(pcols,pver) :: sl, qt, slv @@ -472,19 +469,30 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & real(r8), pointer, dimension(:,:) :: cmfmc2 ! (pcols,pverp) Updraft mass flux by shallow convection [ kg/s/m2 ] real(r8), pointer, dimension(:,:) :: sh_e_ed_ratio ! (pcols,pver) fer/(fer+fdr) from uwschu + real(r8), dimension(pcols,pver) :: fsnow_conv + real(r8), dimension(pcols,pver) :: fice + logical :: lq(pcnst) type(unicon_out_t) :: unicon_out + character(len=40) :: scheme_name + character(len=16) :: macrop_scheme + character(len=512):: errmsg + integer :: errflg + integer :: top_lev + + + ! ----------------------- ! - ! Main Computation Begins ! + ! Main Computation Begins ! ! ----------------------- ! zero = 0._r8 nstep = get_nstep() lchnk = state%lchnk ncol = state%ncol - + call physics_state_copy( state, state1 ) ! Copy state to local state1. ! Associate pointers with physics buffer fields @@ -554,7 +562,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & snow = 0._r8 case('Hack') ! Hack scheme - + lq(:) = .TRUE. call physics_ptend_init( ptend_loc, state%psetcols, 'cmfmca', ls=.true., lq=lq ) ! Initialize local ptend type @@ -566,7 +574,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & state%rpdel , state%zm , tpert , qpert , state%phis , & pblh , state%t , state%q , ptend_loc%s , ptend_loc%q , & cmfmc2 , rprdsh , cmfsl , cmflq , precc , & - qc2 , cnt2 , cnb2 , icwmr , rliq2 , & + qc2 , cnt2 , cnb2 , icwmr , rliq2 , & state%pmiddry, state%pdeldry, state%rpdeldry ) case('UW') ! UW shallow convection scheme @@ -577,7 +585,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & ! Initialize local ptend type lq(:) = .TRUE. - call physics_ptend_init( ptend_loc, state%psetcols, 'UWSHCU', ls=.true., lu=.true., lv=.true., lq=lq ) + call physics_ptend_init( ptend_loc, state%psetcols, 'UWSHCU', ls=.true., lu=.true., lv=.true., lq=lq ) call pbuf_get_field(pbuf, cush_idx, cush ,(/1,itim_old/), (/pcols,1/)) call pbuf_get_field(pbuf, tke_idx, tke) @@ -588,7 +596,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & call pbuf_get_field(pbuf, sh_e_ed_ratio_idx, sh_e_ed_ratio) call compute_uwshcu_inv( pcols , pver , ncol , pcnst , ztodt , & - state%pint, state%zi, state%pmid , state%zm , state%pdel , & + state%pint, state%zi, state%pmid , state%zm , state%pdel , & state%u , state%v , state%q(:,:,1) , state%q(:,:,ixcldliq), state%q(:,:,ixcldice), & state%t , state%s , state%q(:,:,:) , & tke , cld , concld , pblh , cush , & @@ -607,14 +615,14 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & ! In addition, define 'icwmr' which includes both liquid and ice. ! ! --------------------------------------------------------------------- ! - icwmr(:ncol,:) = iccmr_UW(:ncol,:) + icwmr(:ncol,:) = iccmr_UW(:ncol,:) rprdsh(:ncol,:) = rprdsh(:ncol,:) + cmfdqs(:ncol,:) do m = 4, pcnst ptend_loc%q(:ncol,:pver,m) = ptend_tracer(:ncol,:pver,m) enddo ! Conservation check - + ! do i = 1, ncol ! do m = 1, pcnst ! sum1 = 0._r8 @@ -627,8 +635,8 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & ! pdelx = state%pdeldry(i,k) ! endif ! sum1 = sum1 + state%q(i,k,m)*pdelx - ! sum2 = sum2 +(state%q(i,k,m)+ptend_loc%q(i,k,m)*ztodt)*pdelx - ! sum3 = sum3 + ptend_loc%q(i,k,m)*pdelx + ! sum2 = sum2 +(state%q(i,k,m)+ptend_loc%q(i,k,m)*ztodt)*pdelx + ! sum3 = sum3 + ptend_loc%q(i,k,m)*pdelx ! enddo ! if( m .gt. 3 .and. abs(sum1) .gt. 1.e-13_r8 .and. abs(sum2-sum1)/sum1 .gt. 1.e-12_r8 ) then !! if( m .gt. 3 .and. abs(sum3) .gt. 1.e-13_r8 ) then @@ -672,7 +680,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & end select - ! --------------------------------------------------------! + ! --------------------------------------------------------! ! Calculate fractional occurance of shallow convection ! ! --------------------------------------------------------! @@ -697,7 +705,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & ! -------------------------------------------------------------- ! ! 'cnt2' & 'cnb2' are from shallow, 'cnt' & 'cnb' are from deep ! - ! 'cnt2' & 'cnb2' are the interface indices of cloud top & base: ! + ! 'cnt2' & 'cnb2' are the interface indices of cloud top & base: ! ! cnt2 = float(kpen) ! ! cnb2 = float(krel - 1) ! ! Note that indices decreases with height. ! @@ -706,29 +714,30 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & do i = 1, ncol if( cnt2(i) < cnt(i)) cnt(i) = cnt2(i) if( cnb2(i) > cnb(i)) cnb(i) = cnb2(i) + if( cnb(i) == 1._r8 ) cnb(i) = cnt(i) pcnt(i) = state%pmid(i,int(cnt(i))) - pcnb(i) = state%pmid(i,int(cnb(i))) + pcnb(i) = state%pmid(i,int(cnb(i))) end do - + ! ----------------------------------------------- ! ! This quantity was previously known as CMFDQR. ! ! Now CMFDQR is the shallow rain production only. ! ! ----------------------------------------------- ! - + call pbuf_set_field(pbuf, rprdtot_idx, rprdsh(:ncol,:pver) + rprddp(:ncol,:pver), start=(/1,1/), kount=(/ncol,pver/)) - - ! ----------------------------------------------------------------------- ! + + ! ----------------------------------------------------------------------- ! ! Add shallow reserved cloud condensate to deep reserved cloud condensate ! ! qc [ kg/kg/s] , rliq [ m/s ] ! ! ----------------------------------------------------------------------- ! qc(:ncol,:pver) = qc(:ncol,:pver) + qc2(:ncol,:pver) - rliq(:ncol) = rliq(:ncol) + rliq2(:ncol) + rliq(:ncol) = rliq(:ncol) + rliq2(:ncol) ! ---------------------------------------------------------------------------- ! ! Output new partition of cloud condensate variables, as well as precipitation ! - ! ---------------------------------------------------------------------------- ! + ! ---------------------------------------------------------------------------- ! if( microp_scheme == 'MG' ) then call cnst_get_ind( 'NUMLIQ', ixnumliq ) @@ -752,12 +761,12 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & call outfld( 'CLDTOP' , cnt , pcols , lchnk ) call outfld( 'CLDBOT' , cnb , pcols , lchnk ) call outfld( 'PCLDTOP', pcnt , pcols , lchnk ) - call outfld( 'PCLDBOT', pcnb , pcols , lchnk ) + call outfld( 'PCLDBOT', pcnb , pcols , lchnk ) call outfld( 'FREQSH' , freqsh , pcols , lchnk ) if( shallow_scheme .eq. 'UW' ) then call outfld( 'CBMF' , cbmf , pcols , lchnk ) - call outfld( 'UWFLXPRC', flxprec , pcols , lchnk ) + call outfld( 'UWFLXPRC', flxprec , pcols , lchnk ) call outfld( 'UWFLXSNW' , flxsnow , pcols , lchnk ) endif @@ -779,8 +788,9 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & slv_preCu(:ncol,:pver) = sl_preCu(:ncol,:pver) * ( 1._r8 + zvir * qt_preCu(:ncol,:pver) ) t_preCu(:ncol,:) = state1%t(:ncol,:pver) - call qsat(state1%t(:ncol,:), state1%pmid(:ncol,:), & - tem2(:ncol,:), ftem(:ncol,:)) + do k = 1, pver + call qsat(state1%t(1:ncol,k), state1%pmid(1:ncol,k), tem2(1:ncol,k), ftem(1:ncol,k), ncol) + end do ftem_preCu(:ncol,:) = state1%q(:ncol,:,1) / ftem(:ncol,:) * 100._r8 call outfld( 'qt_pre_Cu ', qt_preCu , pcols, lchnk ) @@ -794,8 +804,8 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & call outfld( 't_pre_Cu ', state1%t , pcols, lchnk ) call outfld( 'rh_pre_Cu ', ftem_preCu , pcols, lchnk ) - ! ----------------------------------------------- ! - ! Update physics state type state1 with ptend_loc ! + ! ----------------------------------------------- ! + ! Update physics state type state1 with ptend_loc ! ! ----------------------------------------------- ! call physics_update( state1, ptend_loc, ztodt ) @@ -810,8 +820,9 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & + state1%q(:ncol,:pver,ixcldice) slv(:ncol,:pver) = sl(:ncol,:pver) * ( 1._r8 + zvir * qt(:ncol,:pver) ) - call qsat(state1%t(:ncol,:), state1%pmid(:ncol,:), & - tem2(:ncol,:), ftem(:ncol,:)) + do k = 1, pver + call qsat(state1%t(1:ncol,k), state1%pmid(1:ncol,k), tem2(1:ncol,k), ftem(1:ncol,k), ncol) + end do ftem(:ncol,:) = state1%q(:ncol,:,1) / ftem(:ncol,:) * 100._r8 call outfld( 'qt_aft_Cu ', qt , pcols, lchnk ) @@ -825,8 +836,8 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & call outfld( 't_aft_Cu ', state1%t , pcols, lchnk ) call outfld( 'rh_aft_Cu ', ftem , pcols, lchnk ) - tten(:ncol,:) = ( state1%t(:ncol,:pver) - t_preCu(:ncol,:) ) / ztodt - rhten(:ncol,:) = ( ftem(:ncol,:) - ftem_preCu(:ncol,:) ) / ztodt + tten(:ncol,:) = ( state1%t(:ncol,:pver) - t_preCu(:ncol,:) ) / ztodt + rhten(:ncol,:) = ( ftem(:ncol,:) - ftem_preCu(:ncol,:) ) / ztodt call outfld( 'tten_Cu ', tten , pcols, lchnk ) call outfld( 'rhten_Cu ', rhten , pcols, lchnk ) @@ -835,7 +846,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & ! ------------------------------------------------------------------------ ! ! UW-Shallow Cumulus scheme includes ! ! evaporation physics inside in it. So when 'shallow_scheme = UW', we must ! - ! NOT perform below 'zm_conv_evap'. ! + ! NOT perform below 'zm_conv_evap_run'. ! ! ------------------------------------------------------------------------ ! if( shallow_scheme .eq. 'Hack' ) then @@ -853,7 +864,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & lq(1) = .TRUE. lq(2:) = .FALSE. - call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_evap', ls=.true., lq=lq) + call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_evap_run', ls=.true., lq=lq) call pbuf_get_field(pbuf, sh_flxprc_idx, flxprec ) call pbuf_get_field(pbuf, sh_flxsnw_idx, flxsnow ) @@ -864,17 +875,33 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & sh_cldliq(:ncol,:) = 0._r8 sh_cldice(:ncol,:) = 0._r8 - call zm_conv_evap( state1%ncol, state1%lchnk, & - state1%t, state1%pmid, state1%pdel, state1%q(:pcols,:pver,1), & - landfracdum, & - ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, & - ptend_loc%q(:pcols,:pver,1), & - rprdsh, cld, ztodt, & - precc, snow, ntprprd, ntsnprd , flxprec, flxsnow ) - - ! ------------------------------------------ ! - ! record history variables from zm_conv_evap ! - ! ------------------------------------------ ! + !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + tend_s_snwprd(:,:) = 0._r8 + tend_s_snwevmlt(:,:) = 0._r8 + snow(:) = 0._r8 + fice(:,:) = 0._r8 + fsnow_conv(:,:) = 0._r8 + !REMOVECAM_END + + top_lev = 1 + call phys_getopts (macrop_scheme_out = macrop_scheme) + if ( .not. (macrop_scheme == "rk" .or. macrop_scheme == "SPCAM_sam1mom")) top_lev = trop_cloud_top_lev + + call cloud_fraction_fice_run(ncol, state1%t(1:ncol,:), tmelt, top_lev, pver, fice(1:ncol,:), fsnow_conv(1:ncol,:)) + + call zm_conv_evap_run(state1%ncol, pver, pverp, & + gravit, latice, latvap, tmelt, & + cpair, zmconv_ke, zmconv_ke_lnd, & + state1%t(:ncol,:),state1%pmid(:ncol,:),state1%pdel(:ncol,:),state1%q(:ncol,:pver,1), & + landfracdum(:ncol), & + ptend_loc%s(:ncol,:), tend_s_snwprd(:ncol,:), tend_s_snwevmlt(:ncol,:), ptend_loc%q(:ncol,:pver,1), & + rprdsh(:ncol,:), cld(:ncol,:), ztodt, & + precc(:ncol), snow(:ncol), ntprprd(:ncol,:), ntsnprd(:ncol,:), fsnow_conv(:ncol,:), flxprec(:ncol,:), flxsnow(:ncol,:),& + scheme_name, errmsg, errflg) + + ! ---------------------------------------------- ! + ! record history variables from zm_conv_evap_run ! + ! ---------------------------------------------- ! evapcsh(:ncol,:pver) = ptend_loc%q(:ncol,:pver,1) @@ -892,7 +919,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , & call outfld( 'HKNTSNPD' , ntsnprd , pcols, lchnk ) call outfld( 'HKEIHEAT' , ptend_loc%s , pcols, lchnk ) - ! ---------------------------------------------------------------- ! + ! ---------------------------------------------------------------- ! ! Add tendency from this process to tend from other processes here ! ! ---------------------------------------------------------------- ! diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index ac1f6ae091..7e81e61053 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -13,14 +13,15 @@ module cospsimulator_intr use shr_kind_mod, only: r8 => shr_kind_r8 use spmd_utils, only: masterproc use ppgrid, only: pcols, pver, pverp, begchunk, endchunk + use ref_pres, only: ktop => trop_cloud_top_lev use perf_mod, only: t_startf, t_stopf - use cam_abortutils, only: endrun + use cam_abortutils, only: endrun, handle_allocate_error use phys_control, only: cam_physpkg_is use cam_logfile, only: iulog #ifdef USE_COSP use quickbeam, only: radar_cfg use mod_quickbeam_optics, only: size_distribution - use mod_cosp, only: cosp_outputs,cosp_optical_inputs,cosp_column_inputs + use mod_cosp, only: cosp_outputs, cosp_optical_inputs, cosp_column_inputs use mod_cosp_config, only: pres_binCenters, pres_binEdges, tau_binCenters, & tau_binEdges, cloudsat_binCenters, cloudsat_binEdges, calipso_binCenters, & calipso_binEdges, misr_histHgtCenters, misr_histHgtEdges, PARASOL_SZA, & @@ -56,22 +57,23 @@ module cospsimulator_intr ! ###################################################################################### ! Whether to do COSP calcs and I/O, default is false. If docosp is specified in ! the atm_in namelist, this value is overwritten and cosp is run - logical, public :: docosp = .false. + logical, public, protected :: docosp = .false. ! Frequency at which cosp is called, every cosp_nradsteps radiation timestep - integer, public :: cosp_nradsteps = 1! CAM namelist variable default, not in COSP namelist + integer, public, protected :: cosp_nradsteps = 1 #ifdef USE_COSP ! ###################################################################################### ! Local declarations ! ###################################################################################### - integer, parameter :: & - nhtml_cosp = pver ! Mumber of model levels is pver integer :: & - nscol_cosp, & ! Number of subcolumns, use namelist input Ncolumns to set. + nlay, & ! Number of CAM layers used by COSP. + nlayp, & ! Number of CAM layer interfaces used by COSP. + nscol_cosp, & ! Number of subcolumns, allow namelist input to set. nht_cosp ! Number of height for COSP radar and calipso simulator outputs. ! *set to 40 if csat_vgrid=.true., else set to Nlr* + ! ###################################################################################### ! Bin-boundaries for mixed dimensions. Calculated in cospsetupvales OR in cosp_config.F90 @@ -94,7 +96,6 @@ module cospsimulator_intr real(r8), target :: reffICE_binCenters_cosp(numMODISReffIceBins) real(r8), target :: reffLIQ_binCenters_cosp(numMODISReffLiqBins) - real(r8) :: htmlmid_cosp(nhtml_cosp) ! Model level height midpoints for output integer :: prstau_cosp(nprs_cosp*ntau_cosp) ! ISCCP mixed output dimension index integer :: prstau_cosp_modis(nprs_cosp*ntau_cosp_modis) ! MODIS mixed output dimension index integer :: htmisrtau_cosp(nhtmisr_cosp*ntau_cosp) ! MISR mixed output dimension index @@ -104,6 +105,7 @@ module cospsimulator_intr real(r8) :: prstau_taumid_cosp_modis(nprs_cosp*ntau_cosp_modis) real(r8) :: htmisrtau_htmisrmid_cosp(nhtmisr_cosp*ntau_cosp) real(r8) :: htmisrtau_taumid_cosp(nhtmisr_cosp*ntau_cosp) + real(r8),allocatable :: htmlmid_cosp(:) ! Model level height midpoints for output (nlay) real(r8),allocatable, public :: htdbze_dbzemid_cosp(:) ! (nht_cosp*CLOUDSAT_DBZE_BINS) real(r8),allocatable, target :: htlim_cosp(:,:) ! height limits for COSP outputs (nht_cosp+1) real(r8),allocatable, target :: htmid_cosp(:) ! height midpoints of COSP radar/lidar output (nht_cosp) @@ -111,73 +113,64 @@ module cospsimulator_intr real(r8),allocatable :: htdbze_htmid_cosp(:) ! (nht_cosp*CLOUDSAT_DBZE_BINS) real(r8),allocatable :: htsr_htmid_cosp(:) ! (nht_cosp*nsr_cosp) real(r8),allocatable :: htsr_srmid_cosp(:) ! (nht_cosp*nsr_cosp) - real(r8),allocatable :: htmlscol_htmlmid_cosp(:) ! (nhtml_cosp*nscol_cosp) - real(r8),allocatable :: htmlscol_scol_cosp(:) ! (nhtml_cosp*nscol_cosp) + real(r8),allocatable :: htmlscol_htmlmid_cosp(:) ! (nlay*nscol_cosp) + real(r8),allocatable :: htmlscol_scol_cosp(:) ! (nlay*nscol_cosp) integer, allocatable, target :: scol_cosp(:) ! sub-column number (nscol_cosp) integer, allocatable :: htdbze_cosp(:) ! radar CFAD mixed output dimension index (nht_cosp*CLOUDSAT_DBZE_BINS) integer, allocatable :: htsr_cosp(:) ! lidar CFAD mixed output dimension index (nht_cosp*nsr_cosp) - integer, allocatable :: htmlscol_cosp(:) ! html-subcolumn mixed output dimension index (nhtml_cosp*nscol_cosp) + integer, allocatable :: htmlscol_cosp(:) ! html-subcolumn mixed output dimension index (nlay*nscol_cosp) ! ###################################################################################### - ! Default namelists - ! The CAM and COSP namelists defaults are set below. Some of the COSP namelist - ! variables are part of the CAM namelist - they all begin with "cosp_" to keep their - ! names specific to COSP. I set their CAM namelist defaults here, not in namelist_defaults_cam.xml - ! Variables identified as namelist variables are defined in - ! ../models/atm/cam/bld/namelist_files/namelist_definition.xml + ! Default CAM namelist settings ! ###################################################################################### - ! CAM - logical :: cosp_amwg = .false. ! CAM namelist variable default, not in COSP namelist - logical :: cosp_lite = .false. ! CAM namelist variable default, not in COSP namelist - logical :: cosp_passive = .false. ! CAM namelist variable default, not in COSP namelist - logical :: cosp_active = .false. ! CAM namelist variable default, not in COSP namelist - logical :: cosp_isccp = .false. ! CAM namelist variable default, not in COSP namelist - logical :: cosp_lradar_sim = .false. ! CAM namelist variable default - logical :: cosp_llidar_sim = .false. ! CAM namelist variable default - logical :: cosp_lisccp_sim = .false. ! CAM namelist variable default - logical :: cosp_lmisr_sim = .false. ! CAM namelist variable default - logical :: cosp_lmodis_sim = .false. ! CAM namelist variable default - logical :: cosp_histfile_aux = .false. ! CAM namelist variable default - logical :: cosp_lfrac_out = .false. ! CAM namelist variable default - logical :: cosp_runall = .false. ! flag to run all of the cosp simulator package - integer :: cosp_ncolumns = 50 ! CAM namelist variable default - integer :: cosp_histfile_num =1 ! CAM namelist variable default, not in COSP namelist - integer :: cosp_histfile_aux_num =-1 ! CAM namelist variable default, not in COSP namelist + logical :: cosp_amwg = .false. + logical :: cosp_lite = .false. + logical :: cosp_passive = .false. + logical :: cosp_active = .false. + logical :: cosp_isccp = .false. + logical :: cosp_lradar_sim = .false. + logical :: cosp_llidar_sim = .false. + logical :: cosp_lisccp_sim = .false. + logical :: cosp_lmisr_sim = .false. + logical :: cosp_lmodis_sim = .false. + logical :: cosp_histfile_aux = .false. + logical :: cosp_lfrac_out = .false. + logical :: cosp_runall = .false. + integer :: cosp_ncolumns = 50 + integer :: cosp_histfile_num = 1 + integer :: cosp_histfile_aux_num = -1 ! COSP - logical :: lradar_sim = .false. ! COSP namelist variable, can be changed from default by CAM namelist - logical :: llidar_sim = .false. ! - logical :: lparasol_sim = .false. ! - logical :: lgrLidar532 = .false. ! - logical :: latlid = .false. ! - logical :: lisccp_sim = .false. ! "" - logical :: lmisr_sim = .false. ! "" - logical :: lmodis_sim = .false. ! "" - logical :: lrttov_sim = .false. ! not running rttov, always set to .false. - logical :: lfrac_out = .false. ! COSP namelist variable, can be changed from default by CAM namelist + logical :: lradar_sim = .false. + logical :: llidar_sim = .false. + logical :: lparasol_sim = .false. + logical :: lgrLidar532 = .false. + logical :: latlid = .false. + logical :: lisccp_sim = .false. + logical :: lmisr_sim = .false. + logical :: lmodis_sim = .false. + logical :: lrttov_sim = .false. + logical :: lfrac_out = .false. ! ###################################################################################### ! COSP parameters ! ###################################################################################### - ! Note: Unless otherwise specified, these are parameters that cannot be set by the CAM namelist. integer, parameter :: Npoints_it = 10000 ! Max # gridpoints to be processed in one iteration (10,000) - integer :: ncolumns = 50 ! Number of subcolumns in SCOPS (50), can be changed from default by CAM namelist + integer :: ncolumns = 50 ! Number of subcolumns in SCOPS (50) integer :: nlr = 40 ! Number of levels in statistical outputs ! (only used if USE_VGRID=.true.) (40) logical :: use_vgrid = .true. ! Use fixed vertical grid for outputs? ! (if .true. then define # of levels with nlr) (.true.) logical :: csat_vgrid = .true. ! CloudSat vertical grid? - ! (if .true. then the CloudSat standard grid is used. - ! If set, overides use_vgrid.) (.true.) - ! namelist variables for COSP input related to radar simulator + + ! Variables for COSP input related to radar simulator real(r8) :: radar_freq = 94.0_r8 ! CloudSat radar frequency (GHz) (94.0) integer :: surface_radar = 0 ! surface=1, spaceborne=0 (0) - integer :: use_mie_tables = 0 ! use a precomputed lookup table? yes=1,no=0 (0) integer :: use_gas_abs = 1 ! include gaseous absorption? yes=1,no=0 (1) integer :: do_ray = 0 ! calculate/output Rayleigh refl=1, not=0 (0) - integer :: melt_lay = 0 ! melting layer model off=0, on=1 (0) real(r8) :: k2 = -1 ! |K|^2, -1=use frequency dependent default (-1) - ! namelist variables for COSP input related to lidar simulator + + ! Variables for COSP input related to lidar simulator integer, parameter :: Nprmts_max_hydro = 12 ! Max # params for hydrometeor size distributions (12) integer, parameter :: Naero = 1 ! Number of aerosol species (Not used) (1) integer, parameter :: Nprmts_max_aero = 1 ! Max # params for aerosol size distributions (not used) (1) @@ -185,7 +178,7 @@ module cospsimulator_intr ! (0=ice-spheres ; 1=ice-non-spherical) (0) integer, parameter :: overlap = 3 ! overlap type: 1=max, 2=rand, 3=max/rand (3) - !! namelist variables for COSP input related to ISCCP simulator + ! Variables for COSP input related to ISCCP simulator integer :: isccp_topheight = 1 ! 1 = adjust top height using both a computed infrared ! brightness temperature and the visible ! optical depth to adjust cloud top pressure. @@ -219,8 +212,9 @@ module cospsimulator_intr ! chunk (allocatable->1:pcols,begchunk:endchunk) ! pbuf indices integer :: cld_idx, concld_idx, lsreffrain_idx, lsreffsnow_idx, cvreffliq_idx - integer :: cvreffice_idx, dpcldliq_idx, dpcldice_idx - integer :: shcldliq_idx, shcldice_idx, shcldliq1_idx, shcldice1_idx, dpflxprc_idx + integer :: cvreffice_idx + integer :: gb_totcldliqmr_idx, gb_totcldicemr_idx + integer :: dpflxprc_idx integer :: dpflxsnw_idx, shflxprc_idx, shflxsnw_idx, lsflxprc_idx, lsflxsnw_idx integer :: rei_idx, rel_idx @@ -268,188 +262,33 @@ module cospsimulator_intr CONTAINS - ! ###################################################################################### - ! SUBROUTINE setcosp2values - ! ###################################################################################### -#ifdef USE_COSP - subroutine setcosp2values(Nlr_in,use_vgrid_in,csat_vgrid_in,Ncolumns_in,cosp_nradsteps_in) - use mod_cosp, only: cosp_init - use mod_cosp_config, only: vgrid_zl, vgrid_zu, vgrid_z - use mod_quickbeam_optics, only: hydro_class_init, quickbeam_optics_init - ! Inputs - integer, intent(in) :: Nlr_in ! Number of vertical levels for CALIPSO and Cloudsat products - integer, intent(in) :: Ncolumns_in ! Number of sub-columns - integer, intent(in) :: cosp_nradsteps_in ! How often to call COSP? - logical, intent(in) :: use_vgrid_in ! Logical switch to use interpolated, to Nlr_in, grid for CALIPSO and Cloudsat - logical, intent(in) :: csat_vgrid_in ! - - ! Local - logical :: ldouble=.false. - logical :: lsingle=.true. ! Default is to use single moment - integer :: i,k - - prsmid_cosp = pres_binCenters - prslim_cosp = pres_binEdges - taumid_cosp = tau_binCenters - taulim_cosp = tau_binEdges - srmid_cosp = calipso_binCenters - srlim_cosp = calipso_binEdges - sza_cosp = parasol_sza - dbzemid_cosp = cloudsat_binCenters - dbzelim_cosp = cloudsat_binEdges - htmisrmid_cosp = misr_histHgtCenters - htmisrlim_cosp = misr_histHgtEdges - taumid_cosp_modis = tau_binCenters - taulim_cosp_modis = tau_binEdges - reffICE_binCenters_cosp = reffICE_binCenters - reffICE_binEdges_cosp = reffICE_binEdges - reffLIQ_binCenters_cosp = reffLIQ_binCenters - reffLIQ_binEdges_cosp = reffLIQ_binEdges - - ! Initialize the distributional parameters for hydrometeors in radar simulator. In COSPv1.4, this was declared in - ! cosp_defs.f. - if (cloudsat_micro_scheme == 'MMF_v3.5_two_moment') then - ldouble = .true. - lsingle = .false. - endif - call hydro_class_init(lsingle,ldouble,sd) - call quickbeam_optics_init() - - ! DS2017: The setting up of the vertical grid for regridding the CALIPSO and Cloudsat products is - ! now donein cosp_init, but these fields are stored in cosp_config.F90. - ! Additionally all static fields used by the individual simulators are set up by calls - ! to _init functions in cosp_init. - ! DS2019: Add logicals, default=.false., for new Lidar simuldators (Earthcare (atlid) and ground-based - ! lidar at 532nm) - call COSP_INIT(Lisccp_sim, Lmodis_sim, Lmisr_sim, Lradar_sim, Llidar_sim, LgrLidar532, & - Latlid, Lparasol_sim, Lrttov_sim, radar_freq, k2, use_gas_abs, do_ray, & - isccp_topheight, isccp_topheight_direction, surface_radar, rcfg_cloudsat, & - use_vgrid_in, csat_vgrid_in, Nlr_in, pver, cloudsat_micro_scheme) - - ! Set number of sub-columns, from namelist - nscol_cosp = Ncolumns_in - - if (use_vgrid_in) then !! using fixed vertical grid - if (csat_vgrid_in) then - nht_cosp = 40 - else - nht_cosp = Nlr_in - endif - endif - - ! Set COSP call frequency, from namelist. - cosp_nradsteps = cosp_nradsteps_in - - ! DJS2017: In COSP2, most of the bin boundaries, centers, and edges are declared in src/cosp_config.F90. - ! Above I just assign them accordingly in the USE statement. Other bin bounds needed by CAM - ! are calculated here. - ! Allocate - allocate(htlim_cosp(2,nht_cosp),htlim_cosp_1d(nht_cosp+1),htmid_cosp(nht_cosp),scol_cosp(nscol_cosp), & - htdbze_cosp(nht_cosp*CLOUDSAT_DBZE_BINS),htsr_cosp(nht_cosp*nsr_cosp),htmlscol_cosp(nhtml_cosp*nscol_cosp),& - htdbze_htmid_cosp(nht_cosp*CLOUDSAT_DBZE_BINS),htdbze_dbzemid_cosp(nht_cosp*CLOUDSAT_DBZE_BINS), & - htsr_htmid_cosp(nht_cosp*nsr_cosp),htsr_srmid_cosp(nht_cosp*nsr_cosp), & - htmlscol_htmlmid_cosp(nhtml_cosp*nscol_cosp),htmlscol_scol_cosp(nhtml_cosp*nscol_cosp)) - - ! DJS2017: Just pull from cosp_config - if (use_vgrid_in) then - htlim_cosp_1d(1) = vgrid_zu(1) - htlim_cosp_1d(2:nht_cosp+1) = vgrid_zl - endif - htmid_cosp = vgrid_z - htlim_cosp(1,:) = vgrid_zu - htlim_cosp(2,:) = vgrid_zl - - scol_cosp(:) = (/(k,k=1,nscol_cosp)/) - - ! Just using an index here, model height is a prognostic variable - htmlmid_cosp(:) = (/(k,k=1,nhtml_cosp)/) - - ! assign mixed dimensions an integer index for cam_history.F90 - do k=1,nprs_cosp*ntau_cosp - prstau_cosp(k) = k - end do - do k=1,nprs_cosp*ntau_cosp_modis - prstau_cosp_modis(k) = k - end do - do k=1,nht_cosp*CLOUDSAT_DBZE_BINS - htdbze_cosp(k) = k - end do - do k=1,nht_cosp*nsr_cosp - htsr_cosp(k) = k - end do - do k=1,nhtml_cosp*nscol_cosp - htmlscol_cosp(k) = k - end do - do k=1,nhtmisr_cosp*ntau_cosp - htmisrtau_cosp(k) = k - end do - - ! next, assign collapsed reference vectors for cam_history.F90 - ! convention for saving output = prs1,tau1 ... prs1,tau7 ; prs2,tau1 ... prs2,tau7 etc. - ! actual output is specified in cospsimulator1_intr.F90 - do k=1,nprs_cosp - prstau_taumid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=taumid_cosp(1:ntau_cosp) - prstau_prsmid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=prsmid_cosp(k) - prstau_taumid_cosp_modis(ntau_cosp_modis*(k-1)+1:k*ntau_cosp_modis)=taumid_cosp_modis(1:ntau_cosp_modis) - prstau_prsmid_cosp_modis(ntau_cosp_modis*(k-1)+1:k*ntau_cosp_modis)=prsmid_cosp(k) - enddo - - do k=1,nht_cosp - htdbze_dbzemid_cosp(CLOUDSAT_DBZE_BINS*(k-1)+1:k*CLOUDSAT_DBZE_BINS)=dbzemid_cosp(1:CLOUDSAT_DBZE_BINS) - htdbze_htmid_cosp(CLOUDSAT_DBZE_BINS*(k-1)+1:k*CLOUDSAT_DBZE_BINS)=htmid_cosp(k) - enddo - - do k=1,nht_cosp - htsr_srmid_cosp(nsr_cosp*(k-1)+1:k*nsr_cosp)=srmid_cosp(1:nsr_cosp) - htsr_htmid_cosp(nsr_cosp*(k-1)+1:k*nsr_cosp)=htmid_cosp(k) - enddo - - do k=1,nhtml_cosp - htmlscol_scol_cosp(nscol_cosp*(k-1)+1:k*nscol_cosp)=scol_cosp(1:nscol_cosp) - htmlscol_htmlmid_cosp(nscol_cosp*(k-1)+1:k*nscol_cosp)=htmlmid_cosp(k) - enddo - - do k=1,nhtmisr_cosp - htmisrtau_taumid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=taumid_cosp(1:ntau_cosp) - htmisrtau_htmisrmid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=htmisrmid_cosp(k) - enddo - - end subroutine setcosp2values -#endif - ! ###################################################################################### ! SUBROUTINE cospsimulator_intr_readnl - ! - ! PURPOSE: to read namelist variables and run setcospvalues subroutine.note: cldfrc_readnl - ! is a good template in cloud_fraction.F90. Make sure that this routine is reading in a - ! namelist. models/atm/cam/bld/build-namelist is the perl script to check. ! ###################################################################################### subroutine cospsimulator_intr_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit #ifdef SPMD - use mpishorthand, only: mpicom, mpilog, mpiint, mpichar + use mpishorthand, only: mpicom, mpilog, mpiint #endif - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input (nlfile=atm_in) + character(len=*), intent(in) :: nlfile ! file containing namelist input (nlfile=atm_in) ! Local variables integer :: unitn, ierr character(len=*), parameter :: subname = 'cospsimulator_intr_readnl' #ifdef USE_COSP -!!! this list should include any variable that you might want to include in the namelist -!!! philosophy is to not include COSP output flags but just important COSP settings and cfmip controls. - namelist /cospsimulator_nl/ docosp, cosp_active, cosp_amwg, & - cosp_histfile_num, cosp_histfile_aux, cosp_histfile_aux_num, cosp_isccp, cosp_lfrac_out, & - cosp_lite, cosp_lradar_sim, cosp_llidar_sim, cosp_lisccp_sim, cosp_lmisr_sim, cosp_lmodis_sim, cosp_ncolumns, & - cosp_nradsteps, cosp_passive, cosp_runall + namelist /cospsimulator_nl/ docosp, cosp_ncolumns, cosp_nradsteps, & + cosp_amwg, cosp_lite, cosp_passive, cosp_active, cosp_isccp, cosp_runall, & + cosp_lfrac_out, cosp_lradar_sim, cosp_llidar_sim, cosp_lisccp_sim, & + cosp_lmisr_sim, cosp_lmodis_sim, & + cosp_histfile_num, cosp_histfile_aux, cosp_histfile_aux_num !! read in the namelist if (masterproc) then unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) !! presumably opens the namelist file "nlfile" - !! position the file to write to the cospsimulator portion of the cam_in namelist + open( unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'cospsimulator_nl', status=ierr) if (ierr == 0) then read(unitn, cospsimulator_nl, iostat=ierr) @@ -565,24 +404,17 @@ subroutine cospsimulator_intr_readnl(nlfile) cosp_nradsteps = 3 end if - !! reset COSP namelist variables based on input from cam namelist variables - if (cosp_ncolumns .ne. ncolumns) then - ncolumns = cosp_ncolumns - end if + ! Set number of sub-columns, from namelist + ncolumns = cosp_ncolumns + nscol_cosp = cosp_ncolumns - ! *NOTE* COSP is configured in CAM such that if a simulator is requested, all diagnostics - ! are output. So no need turn on/aff outputs if simulator is requested. - - ! Set vertical coordinate, subcolumn, and calculation frequency cosp options based on namelist inputs - call setcosp2values(nlr,use_vgrid,csat_vgrid,ncolumns,cosp_nradsteps) - if (masterproc) then if (docosp) then write(iulog,*)'COSP configuration:' write(iulog,*)' Number of COSP subcolumns = ', cosp_ncolumns - write(iulog,*)' Frequency at which cosp is called = ', cosp_nradsteps + write(iulog,*)' COSP frequency in radiation steps = ', cosp_nradsteps write(iulog,*)' Enable radar simulator = ', lradar_sim - write(iulog,*)' Enable calipso simulator = ', llidar_sim + write(iulog,*)' Enable calipso simulator = ', llidar_sim write(iulog,*)' Enable ISCCP simulator = ', lisccp_sim write(iulog,*)' Enable MISR simulator = ', lmisr_sim write(iulog,*)' Enable MODIS simulator = ', lmodis_sim @@ -590,7 +422,7 @@ subroutine cospsimulator_intr_readnl(nlfile) write(iulog,*)' Write COSP output to history file = ', cosp_histfile_num write(iulog,*)' Write COSP input fields = ', cosp_histfile_aux write(iulog,*)' Write COSP input fields to history file = ', cosp_histfile_aux_num - write(iulog,*)' Write COSP subcolumn fields = ', cosp_lfrac_out + write(iulog,*)' Write COSP subcolumn fields = ', lfrac_out else write(iulog,*)'COSP not enabled' end if @@ -603,10 +435,23 @@ end subroutine cospsimulator_intr_readnl ! ###################################################################################### subroutine cospsimulator_intr_register() + ! The coordinate variables used for COSP output are defined here. This + ! needs to be done before the call to read_restart_history in order for + ! restarts to work. + use cam_history_support, only: add_hist_coord + !--------------------------------------------------------------------------- #ifdef USE_COSP - ! register non-standard variable dimensions + ! Set number of levels used by COSP to the number of levels used by + ! CAM's cloud macro/microphysics parameterizations. + nlay = pver - ktop + 1 + nlayp = nlay + 1 + + ! Set COSP coordinate arrays + call setcosp2values() + + ! Define coordinate variables for COSP outputs. if (lisccp_sim .or. lmodis_sim) then call add_hist_coord('cosp_prs', nprs_cosp, 'COSP Mean ISCCP pressure', & 'hPa', prsmid_cosp, bounds_name='cosp_prs_bnds', bounds=prslim_cosp) @@ -625,7 +470,7 @@ subroutine cospsimulator_intr_register() if (llidar_sim .or. lradar_sim) then call add_hist_coord('cosp_ht', nht_cosp, & - 'COSP Mean Height for calipso and radar simulator outputs', 'm', & + 'COSP Mean Height for calipso and radar simulator outputs', 'm', & htmid_cosp, bounds_name='cosp_ht_bnds', bounds=htlim_cosp, & vertical_coord=.true.) end if @@ -642,7 +487,7 @@ subroutine cospsimulator_intr_register() end if if (lradar_sim) then - call add_hist_coord('cosp_dbze', CLOUDSAT_DBZE_BINS, & + call add_hist_coord('cosp_dbze', CLOUDSAT_DBZE_BINS, & 'COSP Mean dBZe for radar simulator CFAD output', 'dBZ', & dbzemid_cosp, bounds_name='cosp_dbze_bnds', bounds=dbzelim_cosp) end if @@ -676,482 +521,346 @@ subroutine cospsimulator_intr_init() #ifdef USE_COSP use cam_history, only: addfld, add_default, horiz_only -#ifdef SPMD - use mpishorthand, only : mpir8, mpiint, mpicom -#endif - use netcdf, only : nf90_open, nf90_inq_varid, nf90_get_var, nf90_close, nf90_nowrite - use error_messages, only : handle_ncerr, alloc_err - - use physics_buffer, only: pbuf_get_index + use physics_buffer, only: pbuf_get_index - use mod_cosp_config, only : R_UNDEF - - integer :: ncid,latid,lonid,did,hrid,minid,secid, istat - integer :: i + integer :: i, ierr, istat + character(len=*), parameter :: sub = 'cospsimulator_intr_init' + !--------------------------------------------------------------------------- + ! The COSP init method (setcosp2values) was run from cospsimulator_intr_register in order to add + ! the history coordinate variables earlier as needed for the restart time sequencing. + ! ISCCP OUTPUTS if (lisccp_sim) then - !! addfld calls for all - !*cfMon,cfDa* clisccp2 (time,tau,plev,profile), CFMIP wants 7 p bins, 7 tau bins - call addfld('FISCCP1_COSP',(/'cosp_tau','cosp_prs'/),'A','percent', & - 'Grid-box fraction covered by each ISCCP D level cloud type',& - flag_xyfill=.true., fill_value=R_UNDEF) - - !*cfMon,cfDa* tclisccp (time,profile), CFMIP wants "gridbox mean cloud cover from ISCCP" - call addfld('CLDTOT_ISCCP', horiz_only,'A','percent', & + call addfld('FISCCP1_COSP', (/'cosp_tau','cosp_prs'/), 'A', 'percent', & + 'Grid-box fraction covered by each ISCCP D level cloud type', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_ISCCP', horiz_only, 'A', 'percent', & 'Total Cloud Fraction Calculated by the ISCCP Simulator ',flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfDa* albisccp (time,profile) - ! Per CFMIP request - weight by ISCCP Total Cloud Fraction (divide by CLDTOT_ISSCP in history file to get weighted average) - call addfld('MEANCLDALB_ISCCP',horiz_only,'A','1','Mean cloud albedo*CLDTOT_ISCCP',flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfDa* ctpisccp (time,profile) - ! Per CFMIP request - weight by ISCCP Total Cloud Fraction (divide by CLDTOT_ISSCP in history file to get weighted average) - call addfld('MEANPTOP_ISCCP',horiz_only,'A','Pa','Mean cloud top pressure*CLDTOT_ISCCP',flag_xyfill=.true., & - fill_value=R_UNDEF) - ! tauisccp (time,profile) - ! For averaging, weight by ISCCP Total Cloud Fraction (divide by CLDTOT_ISSCP in history file to get weighted average) - call addfld ('MEANTAU_ISCCP',horiz_only,'A','1','Mean optical thickness*CLDTOT_ISCCP',flag_xyfill=.true., & - fill_value=R_UNDEF) - ! meantbisccp (time,profile), at 10.5 um - call addfld ('MEANTB_ISCCP',horiz_only,'A','K','Mean Infrared Tb from ISCCP simulator',flag_xyfill=.true., & - fill_value=R_UNDEF) - ! meantbclrisccp (time,profile) - call addfld ('MEANTBCLR_ISCCP',horiz_only,'A','K','Mean Clear-sky Infrared Tb from ISCCP simulator', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! boxtauisccp (time,column,profile) - call addfld ('TAU_ISCCP',(/'cosp_scol'/),'I','1','Optical Depth in each Subcolumn',flag_xyfill=.true., fill_value=R_UNDEF) - ! boxptopisccp (time,column,profile) - call addfld ('CLDPTOP_ISCCP',(/'cosp_scol'/),'I','Pa','Cloud Top Pressure in each Subcolumn', & - flag_xyfill=.true., fill_value=R_UNDEF) - - !! add all isccp outputs to the history file specified by the CAM namelist variable cosp_histfile_num - call add_default ('FISCCP1_COSP',cosp_histfile_num,' ') - call add_default ('CLDTOT_ISCCP',cosp_histfile_num,' ') - call add_default ('MEANCLDALB_ISCCP',cosp_histfile_num,' ') - call add_default ('MEANPTOP_ISCCP',cosp_histfile_num,' ') - call add_default ('MEANTAU_ISCCP',cosp_histfile_num,' ') - call add_default ('MEANTB_ISCCP',cosp_histfile_num,' ') - call add_default ('MEANTBCLR_ISCCP',cosp_histfile_num,' ') + call addfld('MEANCLDALB_ISCCP', horiz_only, 'A', '1', & + 'Mean cloud albedo*CLDTOT_ISCCP', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('MEANPTOP_ISCCP', horiz_only, 'A', 'Pa', & + 'Mean cloud top pressure*CLDTOT_ISCCP',flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('MEANTAU_ISCCP', horiz_only, 'A', '1', & + 'Mean optical thickness*CLDTOT_ISCCP',flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('MEANTB_ISCCP', horiz_only, 'A', 'K', & + 'Mean Infrared Tb from ISCCP simulator',flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('MEANTBCLR_ISCCP', horiz_only, 'A', 'K', & + 'Mean Clear-sky Infrared Tb from ISCCP simulator', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAU_ISCCP', (/'cosp_scol'/), 'I', '1', & + 'Optical Depth in each Subcolumn', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDPTOP_ISCCP', (/'cosp_scol'/), 'I', 'Pa', & + 'Cloud Top Pressure in each Subcolumn', flag_xyfill=.true., fill_value=R_UNDEF) + + call add_default('FISCCP1_COSP',cosp_histfile_num,' ') + call add_default('CLDTOT_ISCCP',cosp_histfile_num,' ') + call add_default('MEANCLDALB_ISCCP',cosp_histfile_num,' ') + call add_default('MEANPTOP_ISCCP',cosp_histfile_num,' ') + call add_default('MEANTAU_ISCCP',cosp_histfile_num,' ') + call add_default('MEANTB_ISCCP',cosp_histfile_num,' ') + call add_default('MEANTBCLR_ISCCP',cosp_histfile_num,' ') end if ! CALIPSO SIMULATOR OUTPUTS if (llidar_sim) then - !! addfld calls for all - !*cfMon,cfOff,cfDa,cf3hr* cllcalipso (time,profile) - call addfld('CLDLOW_CAL',horiz_only,'A','percent','Calipso Low-level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfOff,cfDa,cf3hr* clmcalipso (time,profile) - call addfld('CLDMED_CAL',horiz_only,'A','percent','Calipso Mid-level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfOff,cfDa,cf3hr* clhcalipso (time,profile) - call addfld('CLDHGH_CAL',horiz_only,'A','percent','Calipso High-level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfOff,cfDa,cf3hr* cltcalipso (time,profile) - call addfld('CLDTOT_CAL',horiz_only,'A','percent','Calipso Total Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfOff,cfDa,cf3hr* clcalipso (time,height,profile) - call addfld('CLD_CAL',(/'cosp_ht'/),'A','percent','Calipso Cloud Fraction (532 nm)', flag_xyfill=.true., fill_value=R_UNDEF) - !*cfMon,cfOff,cfDa,cf3hr* parasol_refl (time,sza,profile) - call addfld ('RFL_PARASOL',(/'cosp_sza'/),'A','fraction','PARASOL-like mono-directional reflectance ', & - flag_xyfill=.true., fill_value=R_UNDEF) - !*cfOff,cf3hr* cfad_calipsosr532 (time,height,scat_ratio,profile), %11%, default is 40 vert levs, 15 SR bins - call addfld('CFAD_SR532_CAL',(/'cosp_sr','cosp_ht'/),'A','fraction', & - 'Calipso Scattering Ratio CFAD (532 nm)', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! beta_mol532 (time,height_mlev,profile) - call addfld ('MOL532_CAL',(/'lev'/),'A','m-1sr-1','Calipso Molecular Backscatter (532 nm) ', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! atb532 (time,height_mlev,column,profile) - call addfld ('ATB532_CAL',(/'cosp_scol','lev '/),'I','no_unit_log10(x)', & - 'Calipso Attenuated Total Backscatter (532 nm) in each Subcolumn', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsoliq (time,alt40,loc) !!+cosp1.4 - call addfld('CLD_CAL_LIQ', (/'cosp_ht'/), 'A','percent', 'Calipso Liquid Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsoice (time,alt40,loc) - call addfld('CLD_CAL_ICE', (/'cosp_ht'/), 'A','percent', 'Calipso Ice Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsoun (time,alt40,loc) - call addfld('CLD_CAL_UN', (/'cosp_ht'/),'A','percent', 'Calipso Undefined-Phase Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsotmp (time,alt40,loc) - call addfld('CLD_CAL_TMP', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsotmpliq (time,alt40,loc) - call addfld('CLD_CAL_TMPLIQ', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsotmpice (time,alt40,loc) - call addfld('CLD_CAL_TMPICE', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclcalipsotmpun (time,alt40,loc) - call addfld('CLD_CAL_TMPUN', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lcltcalipsoice (time,loc) - call addfld('CLDTOT_CAL_ICE', horiz_only,'A','percent','Calipso Total Ice Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lcltcalipsoliq (time,loc) - call addfld('CLDTOT_CAL_LIQ', horiz_only,'A','percent','Calipso Total Liquid Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lcltcalipsoun (time,loc) - call addfld('CLDTOT_CAL_UN',horiz_only,'A','percent','Calipso Total Undefined-Phase Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclhcalipsoice (time,loc) - call addfld('CLDHGH_CAL_ICE',horiz_only,'A','percent','Calipso High-level Ice Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclhcalipsoliq (time,loc) - call addfld('CLDHGH_CAL_LIQ',horiz_only,'A','percent','Calipso High-level Liquid Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclhcalipsoun (time,loc) - call addfld('CLDHGH_CAL_UN',horiz_only,'A','percent','Calipso High-level Undefined-Phase Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclmcalipsoice (time,loc) - call addfld('CLDMED_CAL_ICE',horiz_only,'A','percent','Calipso Mid-level Ice Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclmcalipsoliq (time,loc) - call addfld('CLDMED_CAL_LIQ',horiz_only,'A','percent','Calipso Mid-level Liquid Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lclmcalipsoun (time,loc) - call addfld('CLDMED_CAL_UN',horiz_only,'A','percent','Calipso Mid-level Undefined-Phase Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lcllcalipsoice (time,loc) - call addfld('CLDLOW_CAL_ICE',horiz_only,'A','percent','Calipso Low-level Ice Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lcllcalipsoliq (time,loc) - call addfld('CLDLOW_CAL_LIQ',horiz_only,'A','percent','Calipso Low-level Liquid Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! lcllcalipsoun (time,loc) !+cosp1.4 - call addfld('CLDLOW_CAL_UN',horiz_only,'A','percent','Calipso Low-level Undefined-Phase Cloud Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - -! ! Calipso Opaque/thin cloud diagnostics -! call addfld('CLDOPQ_CAL', horiz_only, 'A', 'percent', 'CALIPSO Opaque Cloud Cover', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL', horiz_only, 'A', 'percent', 'CALIPSO Thin Cloud Cover', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDZOPQ_CAL', horiz_only, 'A', 'm', 'CALIPSO z_opaque Altitude', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDOPQ_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO Opaque Cloud Fraction', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO Thin Cloud Fraction', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDZOPQ_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO z_opaque Fraction', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('OPACITY_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO opacity Fraction', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDOPQ_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO Opaque Cloud Temperature', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO Thin Cloud Temperature', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDZOPQ_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO z_opaque Temperature', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDOPQ_CAL_Z', horiz_only, 'A', 'm', 'CALIPSO Opaque Cloud Altitude', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_Z', horiz_only, 'A', 'm', 'CALIPSO Thin Cloud Altitude', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_EMIS', horiz_only, 'A', '1', 'CALIPSO Thin Cloud Emissivity', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDOPQ_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO Opaque Cloud Altitude with respect to surface-elevation', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDTHN_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO Thin Cloud Altitude with respect to surface-elevation', & -! flag_xyfill=.true., fill_value=R_UNDEF) -! call addfld('CLDZOPQ_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO z_opaque Altitude with respect to surface-elevation', & -! flag_xyfill=.true., fill_value=R_UNDEF) - - ! add_default calls for CFMIP experiments or else all fields are added to history file - ! except those with sub-column dimension/experimental variables - !! add all calipso outputs to the history file specified by the CAM namelist variable cosp_histfile_num - call add_default ('CLDLOW_CAL',cosp_histfile_num,' ') - call add_default ('CLDMED_CAL',cosp_histfile_num,' ') - call add_default ('CLDHGH_CAL',cosp_histfile_num,' ') - call add_default ('CLDTOT_CAL',cosp_histfile_num,' ') - call add_default ('CLD_CAL',cosp_histfile_num,' ') - call add_default ('RFL_PARASOL',cosp_histfile_num,' ') - call add_default ('CFAD_SR532_CAL',cosp_histfile_num,' ') - call add_default ('CLD_CAL_LIQ',cosp_histfile_num,' ') !+COSP1.4 - call add_default ('CLD_CAL_ICE',cosp_histfile_num,' ') - call add_default ('CLD_CAL_UN',cosp_histfile_num,' ') - call add_default ('CLDTOT_CAL_ICE',cosp_histfile_num,' ') - call add_default ('CLDTOT_CAL_LIQ',cosp_histfile_num,' ') - call add_default ('CLDTOT_CAL_UN',cosp_histfile_num,' ') - call add_default ('CLDHGH_CAL_ICE',cosp_histfile_num,' ') - call add_default ('CLDHGH_CAL_LIQ',cosp_histfile_num,' ') - call add_default ('CLDHGH_CAL_UN',cosp_histfile_num,' ') - call add_default ('CLDMED_CAL_ICE',cosp_histfile_num,' ') - call add_default ('CLDMED_CAL_LIQ',cosp_histfile_num,' ') - call add_default ('CLDMED_CAL_UN',cosp_histfile_num,' ') - call add_default ('CLDLOW_CAL_ICE',cosp_histfile_num,' ') - call add_default ('CLDLOW_CAL_LIQ',cosp_histfile_num,' ') - call add_default ('CLDLOW_CAL_UN',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL',cosp_histfile_num,' ') -! call add_default ('CLDZOPQ_CAL',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL_2D',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_2D',cosp_histfile_num,' ') -! call add_default ('CLDZOPQ_CAL_2D',cosp_histfile_num,' ') -! call add_default ('OPACITY_CAL_2D',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL_TMP',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_TMP',cosp_histfile_num,' ') -! call add_default ('CLDZOPQ_CAL_TMP',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL_Z',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_Z',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_EMIS',cosp_histfile_num,' ') -! call add_default ('CLDOPQ_CAL_SE',cosp_histfile_num,' ') -! call add_default ('CLDTHN_CAL_SE',cosp_histfile_num,' ') -! call add_default ('CLDZOPQ_CAL_SE',cosp_histfile_num,' ') + call addfld('CLDLOW_CAL', horiz_only, 'A', 'percent', & + 'Calipso Low-level Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDMED_CAL', horiz_only, 'A', 'percent', & + 'Calipso Mid-level Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDHGH_CAL', horiz_only, 'A', 'percent', & + 'Calipso High-level Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CAL', horiz_only, 'A', 'percent', & + 'Calipso Total Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL', (/'cosp_ht'/), 'A', 'percent', & + 'Calipso Cloud Fraction (532 nm)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('RFL_PARASOL', (/'cosp_sza'/), 'A', 'fraction', & + 'PARASOL-like mono-directional reflectance ', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CFAD_SR532_CAL', (/'cosp_sr','cosp_ht'/), 'A', 'fraction', & + 'Calipso Scattering Ratio CFAD (532 nm)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('MOL532_CAL', (/'trop_pref'/), 'A', 'm-1 sr-1', & + 'Calipso Molecular Backscatter (532 nm) ', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('ATB532_CAL', (/'cosp_scol','trop_pref'/), 'I', 'no_unit_log10(x)', & + 'Calipso Attenuated Total Backscatter (532 nm) in each Subcolumn', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_LIQ', (/'cosp_ht'/), 'A', 'percent', & + 'Calipso Liquid Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_ICE', (/'cosp_ht'/), 'A', 'percent', & + 'Calipso Ice Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_UN', (/'cosp_ht'/), 'A', 'percent', & + 'Calipso Undefined-Phase Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_TMP', (/'cosp_ht'/), 'A', 'K', & + 'Calipso Cloud Temperature', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_TMPLIQ', (/'cosp_ht'/), 'A', 'K', & + 'Calipso Liquid Cloud Temperature', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_TMPICE', (/'cosp_ht'/), 'A', 'K', & + 'Calipso Ice Cloud Temperature', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_TMPUN', (/'cosp_ht'/), 'A', 'K', & + 'Calipso Undefined-Phase Cloud Temperature', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CAL_ICE', horiz_only, 'A', 'percent', & + 'Calipso Total Ice Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CAL_LIQ', horiz_only, 'A', 'percent', & + 'Calipso Total Liquid Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CAL_UN', horiz_only, 'A', 'percent', & + 'Calipso Total Undefined-Phase Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDHGH_CAL_ICE', horiz_only, 'A', 'percent', & + 'Calipso High-level Ice Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDHGH_CAL_LIQ', horiz_only, 'A', 'percent', & + 'Calipso High-level Liquid Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDHGH_CAL_UN', horiz_only, 'A', 'percent', & + 'Calipso High-level Undefined-Phase Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDMED_CAL_ICE', horiz_only, 'A', 'percent', & + 'Calipso Mid-level Ice Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDMED_CAL_LIQ', horiz_only, 'A', 'percent', & + 'Calipso Mid-level Liquid Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDMED_CAL_UN', horiz_only, 'A', 'percent', & + 'Calipso Mid-level Undefined-Phase Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDLOW_CAL_ICE', horiz_only, 'A', 'percent', & + 'Calipso Low-level Ice Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDLOW_CAL_LIQ', horiz_only, 'A', 'percent', & + 'Calipso Low-level Liquid Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDLOW_CAL_UN', horiz_only, 'A', 'percent', & + 'Calipso Low-level Undefined-Phase Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + + call add_default('CLDLOW_CAL',cosp_histfile_num,' ') + call add_default('CLDMED_CAL',cosp_histfile_num,' ') + call add_default('CLDHGH_CAL',cosp_histfile_num,' ') + call add_default('CLDTOT_CAL',cosp_histfile_num,' ') + call add_default('CLD_CAL',cosp_histfile_num,' ') + call add_default('RFL_PARASOL',cosp_histfile_num,' ') + call add_default('CFAD_SR532_CAL',cosp_histfile_num,' ') + call add_default('CLD_CAL_LIQ',cosp_histfile_num,' ') + call add_default('CLD_CAL_ICE',cosp_histfile_num,' ') + call add_default('CLD_CAL_UN',cosp_histfile_num,' ') + call add_default('CLDTOT_CAL_ICE',cosp_histfile_num,' ') + call add_default('CLDTOT_CAL_LIQ',cosp_histfile_num,' ') + call add_default('CLDTOT_CAL_UN',cosp_histfile_num,' ') + call add_default('CLDHGH_CAL_ICE',cosp_histfile_num,' ') + call add_default('CLDHGH_CAL_LIQ',cosp_histfile_num,' ') + call add_default('CLDHGH_CAL_UN',cosp_histfile_num,' ') + call add_default('CLDMED_CAL_ICE',cosp_histfile_num,' ') + call add_default('CLDMED_CAL_LIQ',cosp_histfile_num,' ') + call add_default('CLDMED_CAL_UN',cosp_histfile_num,' ') + call add_default('CLDLOW_CAL_ICE',cosp_histfile_num,' ') + call add_default('CLDLOW_CAL_LIQ',cosp_histfile_num,' ') + call add_default('CLDLOW_CAL_UN',cosp_histfile_num,' ') if ((.not.cosp_amwg) .and. (.not.cosp_lite) .and. (.not.cosp_passive) .and. (.not.cosp_active) & .and. (.not.cosp_isccp)) then - call add_default ('MOL532_CAL',cosp_histfile_num,' ') + call add_default('MOL532_CAL',cosp_histfile_num,' ') end if end if ! RADAR SIMULATOR OUTPUTS + allocate(sd_cs(begchunk:endchunk), rcfg_cs(begchunk:endchunk), stat=istat) + call handle_allocate_error(istat, sub, 'sd_cs,rcfg_cs') if (lradar_sim) then - allocate(sd_cs(begchunk:endchunk), rcfg_cs(begchunk:endchunk)) do i = begchunk, endchunk sd_cs(i) = sd rcfg_cs(i) = rcfg_cloudsat end do - ! addfld calls - !*cfOff,cf3hr* cfad_dbze94 (time,height,dbze,profile), default is 40 vert levs, 15 dBZ bins - call addfld('CFAD_DBZE94_CS',(/'cosp_dbze','cosp_ht '/),'A','fraction',& - 'Radar Reflectivity Factor CFAD (94 GHz)',& - flag_xyfill=.true., fill_value=R_UNDEF) - !*cfOff,cf3hr* clcalipso2 (time,height,profile) - call addfld ('CLD_CAL_NOTCS',(/'cosp_ht'/),'A','percent','Cloud occurrence seen by CALIPSO but not CloudSat ', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! cltcalipsoradar (time,profile) - call addfld ('CLDTOT_CALCS',horiz_only,'A','percent',' Calipso and Radar Total Cloud Fraction ',flag_xyfill=.true., & - fill_value=R_UNDEF) - call addfld ('CLDTOT_CS',horiz_only,'A','percent',' Radar total cloud amount ',flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CLDTOT_CS2',horiz_only,'A','percent', & - ' Radar total cloud amount without the data for the first kilometer above surface ', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! dbze94 (time,height_mlev,column,profile),! height_mlevel = height when vgrid_in = .true. (default) - call addfld ('DBZE_CS',(/'cosp_scol','lev '/),'I','dBZe',' Radar dBZe (94 GHz) in each Subcolumn',& + call addfld('CFAD_DBZE94_CS',(/'cosp_dbze','cosp_ht '/), 'A', 'fraction', & + 'Radar Reflectivity Factor CFAD (94 GHz)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLD_CAL_NOTCS', (/'cosp_ht'/), 'A', 'percent', & + 'Cloud occurrence seen by CALIPSO but not CloudSat ', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CALCS', horiz_only, 'A', 'percent', & + 'Calipso and Radar Total Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CS', horiz_only, 'A', 'percent', & + 'Radar total cloud amount', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLDTOT_CS2', horiz_only, 'A', 'percent', & + 'Radar total cloud amount without the data for the first kilometer above surface ', & flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('DBZE_CS', (/'cosp_scol','trop_pref'/), 'I', 'dBZe', & + 'Radar dBZe (94 GHz) in each Subcolumn', flag_xyfill=.true., fill_value=R_UNDEF) ! Cloudsat near-sfc precipitation diagnostics - call addfld('CS_NOPRECIP', horiz_only, 'A', '1', 'CloudSat No Rain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_RAINPOSS', horiz_only, 'A', '1', 'Cloudsat Rain Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_RAINPROB', horiz_only, 'A', '1', 'CloudSat Rain Probable Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_RAINCERT', horiz_only, 'A', '1', 'CloudSat Rain Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_SNOWPOSS', horiz_only, 'A', '1', 'CloudSat Snow Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_SNOWCERT', horiz_only, 'A', '1', 'CloudSat Snow Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_MIXPOSS', horiz_only, 'A', '1', 'CloudSat Mixed Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_MIXCERT', horiz_only, 'A', '1', 'CloudSat Mixed Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_RAINHARD', horiz_only, 'A', '1', 'CloudSat Heavy Rain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_UN', horiz_only, 'A', '1', 'CloudSat Unclassified Precipitation Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - call addfld('CS_PIA', horiz_only, 'A', 'dBZ', 'CloudSat Radar Path Integrated Attenuation', flag_xyfill=.true., fill_value=R_UNDEF) - ! Associated CAM microphysics - !call addfld('CAM_MP_CVRAIN',horiz_only, 'A', 'kg/kg','CAM Microphysics Convective Rain', flag_xyfill=.true., fill_value=R_UNDEF) - !call addfld('CAM_MP_CVSNOW',horiz_only, 'A', 'kg/kg','CAM Microphysics Convective Snow', flag_xyfill=.true., fill_value=R_UNDEF) - !call addfld('CAM_MP_LSRAIN',horiz_only, 'A', 'kg/kg','CAM Microphysics Large-Scale Rain', flag_xyfill=.true., fill_value=R_UNDEF) - !call addfld('CAM_MP_LSSNOW',horiz_only, 'A', 'kg/kg','CAM Microphysics Large-Scale Snow', flag_xyfill=.true., fill_value=R_UNDEF) - !call addfld('CAM_MP_LSGRPL',horiz_only, 'A', 'kg/kg','CAM Microphysics Large-Scale Graupel', flag_xyfill=.true., fill_value=R_UNDEF) - - - ! add_default calls for CFMIP experiments or else all fields are added to history file except those with sub-column dimension - !! add all radar outputs to the history file specified by the CAM namelist variable cosp_histfile_num - call add_default ('CFAD_DBZE94_CS',cosp_histfile_num,' ') - call add_default ('CLD_CAL_NOTCS', cosp_histfile_num,' ') - call add_default ('CLDTOT_CALCS', cosp_histfile_num,' ') - call add_default ('CLDTOT_CS', cosp_histfile_num,' ') - call add_default ('CLDTOT_CS2', cosp_histfile_num,' ') - call add_default ('CS_NOPRECIP', cosp_histfile_num,' ') - call add_default ('CS_RAINPOSS', cosp_histfile_num,' ') - call add_default ('CS_RAINPROB', cosp_histfile_num,' ') - call add_default ('CS_RAINCERT', cosp_histfile_num,' ') - call add_default ('CS_SNOWPOSS', cosp_histfile_num,' ') - call add_default ('CS_SNOWCERT', cosp_histfile_num,' ') - call add_default ('CS_MIXPOSS', cosp_histfile_num,' ') - call add_default ('CS_MIXCERT', cosp_histfile_num,' ') - call add_default ('CS_RAINHARD', cosp_histfile_num,' ') - call add_default ('CS_UN', cosp_histfile_num,' ') - call add_default ('CS_PIA', cosp_histfile_num,' ') + call addfld('CS_NOPRECIP', horiz_only, 'A', '1', & + 'CloudSat No Rain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_RAINPOSS', horiz_only, 'A', '1', & + 'Cloudsat Rain Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_RAINPROB', horiz_only, 'A', '1', & + 'CloudSat Rain Probable Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_RAINCERT', horiz_only, 'A', '1', & + 'CloudSat Rain Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_SNOWPOSS', horiz_only, 'A', '1', & + 'CloudSat Snow Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_SNOWCERT', horiz_only, 'A', '1', & + 'CloudSat Snow Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_MIXPOSS', horiz_only, 'A', '1', & + 'CloudSat Mixed Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_MIXCERT', horiz_only, 'A', '1', & + 'CloudSat Mixed Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_RAINHARD', horiz_only, 'A', '1', & + 'CloudSat Heavy Rain Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_UN', horiz_only, 'A', '1', & + 'CloudSat Unclassified Precipitation Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CS_PIA', horiz_only, 'A', 'dBZ', & + 'CloudSat Radar Path Integrated Attenuation', flag_xyfill=.true., fill_value=R_UNDEF) + + call add_default('CFAD_DBZE94_CS',cosp_histfile_num,' ') + call add_default('CLD_CAL_NOTCS', cosp_histfile_num,' ') + call add_default('CLDTOT_CALCS', cosp_histfile_num,' ') + call add_default('CLDTOT_CS', cosp_histfile_num,' ') + call add_default('CLDTOT_CS2', cosp_histfile_num,' ') + call add_default('CS_NOPRECIP', cosp_histfile_num,' ') + call add_default('CS_RAINPOSS', cosp_histfile_num,' ') + call add_default('CS_RAINPROB', cosp_histfile_num,' ') + call add_default('CS_RAINCERT', cosp_histfile_num,' ') + call add_default('CS_SNOWPOSS', cosp_histfile_num,' ') + call add_default('CS_SNOWCERT', cosp_histfile_num,' ') + call add_default('CS_MIXPOSS', cosp_histfile_num,' ') + call add_default('CS_MIXCERT', cosp_histfile_num,' ') + call add_default('CS_RAINHARD', cosp_histfile_num,' ') + call add_default('CS_UN', cosp_histfile_num,' ') + call add_default('CS_PIA', cosp_histfile_num,' ') end if ! MISR SIMULATOR OUTPUTS if (lmisr_sim) then - ! clMISR (time,tau,CTH_height_bin,profile) - call addfld ('CLD_MISR',(/'cosp_tau ','cosp_htmisr'/),'A','percent','Cloud Fraction from MISR Simulator', & - flag_xyfill=.true., fill_value=R_UNDEF) - !! add all misr outputs to the history file specified by the CAM namelist variable cosp_histfile_num - call add_default ('CLD_MISR',cosp_histfile_num,' ') + call addfld('CLD_MISR', (/'cosp_tau ','cosp_htmisr'/), 'A', 'percent', & + 'Cloud Fraction from MISR Simulator', flag_xyfill=.true., fill_value=R_UNDEF) + + call add_default('CLD_MISR',cosp_histfile_num,' ') end if ! MODIS OUTPUT if (lmodis_sim) then - ! float cltmodis ( time, loc ) - call addfld ('CLTMODIS',horiz_only,'A','%','MODIS Total Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - ! float clwmodis ( time, loc ) - call addfld ('CLWMODIS',horiz_only,'A','%','MODIS Liquid Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - ! float climodis ( time, loc ) - call addfld ('CLIMODIS',horiz_only,'A','%','MODIS Ice Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - ! float clhmodis ( time, loc ) - call addfld ('CLHMODIS',horiz_only,'A','%','MODIS High Level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - ! float clmmodis ( time, loc ) - call addfld ('CLMMODIS',horiz_only,'A','%','MODIS Mid Level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - ! float cllmodis ( time, loc ) - call addfld ('CLLMODIS',horiz_only,'A','%','MODIS Low Level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF) - ! float tautmodis ( time, loc ) - call addfld ('TAUTMODIS',horiz_only,'A','1','MODIS Total Cloud Optical Thickness*CLTMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float tauwmodis ( time, loc ) - call addfld ('TAUWMODIS',horiz_only,'A','1','MODIS Liquid Cloud Optical Thickness*CLWMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float tauimodis ( time, loc ) - call addfld ('TAUIMODIS',horiz_only,'A','1','MODIS Ice Cloud Optical Thickness*CLIMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float tautlogmodis ( time, loc ) - call addfld ('TAUTLOGMODIS',horiz_only,'A','1','MODIS Total Cloud Optical Thickness (Log10 Mean)*CLTMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float tauwlogmodis ( time, loc ) - call addfld ('TAUWLOGMODIS',horiz_only,'A','1','MODIS Liquid Cloud Optical Thickness (Log10 Mean)*CLWMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float tauilogmodis ( time, loc ) - call addfld ('TAUILOGMODIS',horiz_only,'A','1','MODIS Ice Cloud Optical Thickness (Log10 Mean)*CLIMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float reffclwmodis ( time, loc ) - call addfld ('REFFCLWMODIS',horiz_only,'A','m','MODIS Liquid Cloud Particle Size*CLWMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float reffclimodis ( time, loc ) - call addfld ('REFFCLIMODIS',horiz_only,'A','m','MODIS Ice Cloud Particle Size*CLIMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float pctmodis ( time, loc ) - call addfld ('PCTMODIS',horiz_only,'A','Pa','MODIS Cloud Top Pressure*CLTMODIS',flag_xyfill=.true., fill_value=R_UNDEF) - ! float lwpmodis ( time, loc ) - call addfld ('LWPMODIS',horiz_only,'A','kg m-2','MODIS Cloud Liquid Water Path*CLWMODIS', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float iwpmodis ( time, loc ) - call addfld ('IWPMODIS',horiz_only,'A','kg m-2','MODIS Cloud Ice Water Path*CLIMODIS',flag_xyfill=.true., fill_value=R_UNDEF) - ! float clmodis ( time, plev, tau, loc ) - call addfld ('CLMODIS',(/'cosp_tau_modis','cosp_prs '/),'A','%','MODIS Cloud Area Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float clrimodis ( time, plev, tau, loc ) - call addfld ('CLRIMODIS',(/'cosp_tau_modis','cosp_reffice '/),'A','%','MODIS Cloud Area Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) - ! float clrlmodis ( time, plev, tau, loc ) - call addfld ('CLRLMODIS',(/'cosp_tau_modis','cosp_reffliq '/),'A','%','MODIS Cloud Area Fraction', & - flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLTMODIS', horiz_only, 'A', '%', & + 'MODIS Total Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLWMODIS', horiz_only, 'A', '%', & + 'MODIS Liquid Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLIMODIS', horiz_only, 'A', '%', & + 'MODIS Ice Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLHMODIS', horiz_only, 'A', '%', & + 'MODIS High Level Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLMMODIS', horiz_only, 'A', '%', & + 'MODIS Mid Level Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLLMODIS', horiz_only, 'A', '%', & + 'MODIS Low Level Cloud Fraction', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAUTMODIS', horiz_only, 'A', '1', & + 'MODIS Total Cloud Optical Thickness*CLTMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAUWMODIS', horiz_only, 'A', '1', & + 'MODIS Liquid Cloud Optical Thickness*CLWMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAUIMODIS', horiz_only, 'A', '1', & + 'MODIS Ice Cloud Optical Thickness*CLIMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAUTLOGMODIS', horiz_only, 'A', '1', & + 'MODIS Total Cloud Optical Thickness (Log10 Mean)*CLTMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAUWLOGMODIS', horiz_only, 'A', '1', & + 'MODIS Liquid Cloud Optical Thickness (Log10 Mean)*CLWMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('TAUILOGMODIS', horiz_only, 'A', '1', & + 'MODIS Ice Cloud Optical Thickness (Log10 Mean)*CLIMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('REFFCLWMODIS', horiz_only, 'A', 'm', & + 'MODIS Liquid Cloud Particle Size*CLWMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('REFFCLIMODIS', horiz_only, 'A', 'm', & + 'MODIS Ice Cloud Particle Size*CLIMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('PCTMODIS', horiz_only, 'A', 'Pa', & + 'MODIS Cloud Top Pressure*CLTMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('LWPMODIS', horiz_only, 'A', 'kg m-2', & + 'MODIS Cloud Liquid Water Path*CLWMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('IWPMODIS', horiz_only, 'A', 'kg m-2', & + 'MODIS Cloud Ice Water Path*CLIMODIS', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLMODIS', (/'cosp_tau_modis','cosp_prs '/), 'A', '%', & + 'MODIS Cloud Area Fraction (tau-pressure histogram)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLRIMODIS', (/'cosp_tau_modis','cosp_reffice '/), 'A', '%', & + 'MODIS Cloud Area Fraction (tau-reffice histogram)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld('CLRLMODIS', (/'cosp_tau_modis','cosp_reffliq '/), 'A', '%', & + 'MODIS Cloud Area Fraction (tau-reffliq histogram)', flag_xyfill=.true., fill_value=R_UNDEF) - !! add MODIS output to history file specified by the CAM namelist variable cosp_histfile_num - call add_default ('CLTMODIS',cosp_histfile_num,' ') - call add_default ('CLWMODIS',cosp_histfile_num,' ') - call add_default ('CLIMODIS',cosp_histfile_num,' ') - call add_default ('CLHMODIS',cosp_histfile_num,' ') - call add_default ('CLMMODIS',cosp_histfile_num,' ') - call add_default ('CLLMODIS',cosp_histfile_num,' ') - call add_default ('TAUTMODIS',cosp_histfile_num,' ') - call add_default ('TAUWMODIS',cosp_histfile_num,' ') - call add_default ('TAUIMODIS',cosp_histfile_num,' ') - call add_default ('TAUTLOGMODIS',cosp_histfile_num,' ') - call add_default ('TAUWLOGMODIS',cosp_histfile_num,' ') - call add_default ('TAUILOGMODIS',cosp_histfile_num,' ') - call add_default ('REFFCLWMODIS',cosp_histfile_num,' ') - call add_default ('REFFCLIMODIS',cosp_histfile_num,' ') - call add_default ('PCTMODIS',cosp_histfile_num,' ') - call add_default ('LWPMODIS',cosp_histfile_num,' ') - call add_default ('IWPMODIS',cosp_histfile_num,' ') - call add_default ('CLMODIS',cosp_histfile_num,' ') - call add_default ('CLRIMODIS',cosp_histfile_num,' ') - call add_default ('CLRLMODIS',cosp_histfile_num,' ') + call add_default('CLTMODIS',cosp_histfile_num,' ') + call add_default('CLWMODIS',cosp_histfile_num,' ') + call add_default('CLIMODIS',cosp_histfile_num,' ') + call add_default('CLHMODIS',cosp_histfile_num,' ') + call add_default('CLMMODIS',cosp_histfile_num,' ') + call add_default('CLLMODIS',cosp_histfile_num,' ') + call add_default('TAUTMODIS',cosp_histfile_num,' ') + call add_default('TAUWMODIS',cosp_histfile_num,' ') + call add_default('TAUIMODIS',cosp_histfile_num,' ') + call add_default('TAUTLOGMODIS',cosp_histfile_num,' ') + call add_default('TAUWLOGMODIS',cosp_histfile_num,' ') + call add_default('TAUILOGMODIS',cosp_histfile_num,' ') + call add_default('REFFCLWMODIS',cosp_histfile_num,' ') + call add_default('REFFCLIMODIS',cosp_histfile_num,' ') + call add_default('PCTMODIS',cosp_histfile_num,' ') + call add_default('LWPMODIS',cosp_histfile_num,' ') + call add_default('IWPMODIS',cosp_histfile_num,' ') + call add_default('CLMODIS',cosp_histfile_num,' ') + call add_default('CLRIMODIS',cosp_histfile_num,' ') + call add_default('CLRLMODIS',cosp_histfile_num,' ') end if ! SUB-COLUMN OUTPUT if (lfrac_out) then - ! frac_out (time,height_mlev,column,profile) - call addfld ('SCOPS_OUT',(/'cosp_scol','lev '/),'I','0=nocld,1=strcld,2=cnvcld','SCOPS Subcolumn output', & - flag_xyfill=.true., fill_value=R_UNDEF) - !! add scops ouptut to history file specified by the CAM namelist variable cosp_histfile_num - call add_default ('SCOPS_OUT',cosp_histfile_num,' ') - ! save sub-column outputs from ISCCP if ISCCP is run + call addfld('SCOPS_OUT', (/'cosp_scol','trop_pref'/), 'I', '0=nocld,1=strcld,2=cnvcld', & + 'SCOPS Subcolumn output', flag_xyfill=.true., fill_value=R_UNDEF) + + call add_default('SCOPS_OUT',cosp_histfile_num,' ') + if (lisccp_sim) then - call add_default ('TAU_ISCCP',cosp_histfile_num,' ') - call add_default ('CLDPTOP_ISCCP',cosp_histfile_num,' ') + call add_default('TAU_ISCCP',cosp_histfile_num,' ') + call add_default('CLDPTOP_ISCCP',cosp_histfile_num,' ') end if - ! save sub-column outputs from calipso if calipso is run + if (llidar_sim) then - call add_default ('ATB532_CAL',cosp_histfile_num,' ') + call add_default('ATB532_CAL',cosp_histfile_num,' ') end if - ! save sub-column outputs from radar if radar is run + if (lradar_sim) then - call add_default ('DBZE_CS',cosp_histfile_num,' ') + call add_default('DBZE_CS',cosp_histfile_num,' ') end if end if !! ADDFLD, ADD_DEFAULT, OUTFLD CALLS FOR COSP OUTPUTS IF RUNNING COSP OFF-LINE - !! Note: A suggestion was to add all of the CAM variables needed to add to make it possible to run COSP off-line - !! These fields are available and can be called from the namelist though. Here, when the cosp_runall mode is invoked - !! all of the inputs are saved on the cam history file. This is good de-bugging functionality we should maintain. if (cosp_histfile_aux) then - call addfld ('PS_COSP', horiz_only, 'I','Pa', 'PS_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('TS_COSP', horiz_only, 'I','K', 'TS_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('P_COSP', (/ 'lev'/), 'I','Pa', 'P_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('PH_COSP', (/ 'lev'/), 'I','Pa', 'PH_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('ZLEV_COSP', (/ 'lev'/), 'I','m', 'ZLEV_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('ZLEV_HALF_COSP', (/ 'lev'/), 'I','m', 'ZLEV_HALF_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('T_COSP', (/ 'lev'/), 'I','K', 'T_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('RH_COSP', (/ 'lev'/), 'I','percent','RH_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('Q_COSP', (/ 'lev'/), 'I','kg/kg', 'Q_COSP', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('TAU_067', (/'cosp_scol','lev '/), 'I','1', 'Subcolumn 0.67micron optical depth', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('EMISS_11', (/'cosp_scol','lev '/), 'I','1', 'Subcolumn 11micron emissivity', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('MODIS_fracliq', (/'cosp_scol','lev '/), 'I','1', 'Fraction of tau from liquid water', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('MODIS_asym', (/'cosp_scol','lev '/), 'I','1', 'Assymetry parameter (MODIS)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('MODIS_ssa', (/'cosp_scol','lev '/), 'I','1', 'Single-scattering albedo (MODIS)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CAL_betatot', (/'cosp_scol','lev '/), 'I','1', 'Backscatter coefficient (CALIPSO)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CAL_betatot_ice', (/'cosp_scol','lev '/), 'I','1', 'Backscatter coefficient (CALIPSO)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CAL_betatot_liq', (/'cosp_scol','lev '/), 'I','1', 'Backscatter coefficient (CALIPSO)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CAL_tautot', (/'cosp_scol','lev '/), 'I','1', 'Vertically integrated ptical-depth (CALIPSO)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CAL_tautot_ice', (/'cosp_scol','lev '/), 'I','1', 'Vertically integrated ptical-depth (CALIPSO)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CAL_tautot_liq', (/'cosp_scol','lev '/), 'I','1', 'Vertically integrated ptical-depth (CALIPSO)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CS_z_vol', (/'cosp_scol','lev '/), 'I','1', 'Effective reflectivity factor (CLOUDSAT)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CS_kr_vol', (/'cosp_scol','lev '/), 'I','1', 'Attenuation coefficient (hydro) (CLOUDSAT)', & - flag_xyfill=.true., fill_value=R_UNDEF) - call addfld ('CS_g_vol', (/'cosp_scol','lev '/), 'I','1', 'Attenuation coefficient (gases) (CLOUDSAT)', & - flag_xyfill=.true., fill_value=R_UNDEF) - - call add_default ('PS_COSP', cosp_histfile_aux_num,' ') - call add_default ('TS_COSP', cosp_histfile_aux_num,' ') - call add_default ('P_COSP', cosp_histfile_aux_num,' ') - call add_default ('PH_COSP', cosp_histfile_aux_num,' ') - call add_default ('ZLEV_COSP', cosp_histfile_aux_num,' ') - call add_default ('ZLEV_HALF_COSP', cosp_histfile_aux_num,' ') - call add_default ('T_COSP', cosp_histfile_aux_num,' ') - call add_default ('RH_COSP', cosp_histfile_aux_num,' ') - call add_default ('TAU_067', cosp_histfile_aux_num,' ') - call add_default ('EMISS_11', cosp_histfile_aux_num,' ') - call add_default ('MODIS_fracliq', cosp_histfile_aux_num,' ') - call add_default ('MODIS_asym', cosp_histfile_aux_num,' ') - call add_default ('MODIS_ssa', cosp_histfile_aux_num,' ') - call add_default ('CAL_betatot', cosp_histfile_aux_num,' ') - call add_default ('CAL_betatot_ice', cosp_histfile_aux_num,' ') - call add_default ('CAL_betatot_liq', cosp_histfile_aux_num,' ') - call add_default ('CAL_tautot', cosp_histfile_aux_num,' ') - call add_default ('CAL_tautot_ice', cosp_histfile_aux_num,' ') - call add_default ('CAL_tautot_liq', cosp_histfile_aux_num,' ') - call add_default ('CS_z_vol', cosp_histfile_aux_num,' ') - call add_default ('CS_kr_vol', cosp_histfile_aux_num,' ') - call add_default ('CS_g_vol', cosp_histfile_aux_num,' ') + call addfld ('PS_COSP', horiz_only, 'I','Pa', & + 'COSP Surface Pressure', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('TS_COSP', horiz_only, 'I','K', & + 'COSP Skin Temperature', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('P_COSP', (/ 'trop_pref'/), 'I','Pa', & + 'COSP Pressure (layer midpoint)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('PH_COSP', (/ 'trop_prefi'/), 'I','Pa', & + 'COSP Pressure (layer interface)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('ZLEV_COSP', (/ 'trop_pref'/), 'I','m', & + 'COSP Height (layer midpoint)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('ZLEV_HALF_COSP', (/ 'trop_prefi'/), 'I','m', & + 'COSP Height (layer interface)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('T_COSP', (/ 'trop_pref'/), 'I','K', & + 'COSP Temperature', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('Q_COSP', (/ 'trop_pref'/), 'I','percent', & + 'COSP Specific Humidity', flag_xyfill=.true., fill_value=R_UNDEF) + + call addfld ('TAU_067', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Subcolumn 0.67micron optical depth', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('EMISS_11', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Subcolumn 11micron emissivity', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('MODIS_fracliq', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Fraction of tau from liquid water', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('MODIS_asym', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Asymmetry parameter (MODIS)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('MODIS_ssa', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Single-scattering albedo (MODIS)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CS_z_vol', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Effective reflectivity factor (CLOUDSAT)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CS_kr_vol', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Attenuation coefficient (hydro) (CLOUDSAT)', flag_xyfill=.true., fill_value=R_UNDEF) + call addfld ('CS_g_vol', (/'cosp_scol','trop_pref'/), 'I','1', & + 'Attenuation coefficient (gases) (CLOUDSAT)', flag_xyfill=.true., fill_value=R_UNDEF) + + call add_default('PS_COSP', cosp_histfile_aux_num,' ') + call add_default('TS_COSP', cosp_histfile_aux_num,' ') + call add_default('P_COSP', cosp_histfile_aux_num,' ') + call add_default('PH_COSP', cosp_histfile_aux_num,' ') + call add_default('ZLEV_COSP', cosp_histfile_aux_num,' ') + call add_default('ZLEV_HALF_COSP', cosp_histfile_aux_num,' ') + call add_default('T_COSP', cosp_histfile_aux_num,' ') + call add_default('Q_COSP', cosp_histfile_aux_num,' ') + call add_default('TAU_067', cosp_histfile_aux_num,' ') + call add_default('EMISS_11', cosp_histfile_aux_num,' ') + call add_default('MODIS_fracliq', cosp_histfile_aux_num,' ') + call add_default('MODIS_asym', cosp_histfile_aux_num,' ') + call add_default('MODIS_ssa', cosp_histfile_aux_num,' ') + call add_default('CS_z_vol', cosp_histfile_aux_num,' ') + call add_default('CS_kr_vol', cosp_histfile_aux_num,' ') + call add_default('CS_g_vol', cosp_histfile_aux_num,' ') end if rei_idx = pbuf_get_index('REI') @@ -1162,44 +871,193 @@ subroutine cospsimulator_intr_init() lsreffsnow_idx = pbuf_get_index('LS_REFFSNOW') cvreffliq_idx = pbuf_get_index('CV_REFFLIQ') cvreffice_idx = pbuf_get_index('CV_REFFICE') - dpcldliq_idx = pbuf_get_index('DP_CLDLIQ') - dpcldice_idx = pbuf_get_index('DP_CLDICE') - shcldliq_idx = pbuf_get_index('SH_CLDLIQ') - shcldice_idx = pbuf_get_index('SH_CLDICE') - shcldliq1_idx = pbuf_get_index('SH_CLDLIQ1') - shcldice1_idx = pbuf_get_index('SH_CLDICE1') + gb_totcldliqmr_idx = pbuf_get_index('GB_TOTCLDLIQMR') ! grid box total cloud liquid water mr (kg/kg) + gb_totcldicemr_idx = pbuf_get_index('GB_TOTCLDICEMR') ! grid box total cloud ice water mr (kg/kg) dpflxprc_idx = pbuf_get_index('DP_FLXPRC') dpflxsnw_idx = pbuf_get_index('DP_FLXSNW') - shflxprc_idx = pbuf_get_index('SH_FLXPRC') - shflxsnw_idx = pbuf_get_index('SH_FLXSNW') + shflxprc_idx = pbuf_get_index('SH_FLXPRC', errcode=ierr) + shflxsnw_idx = pbuf_get_index('SH_FLXSNW', errcode=ierr) lsflxprc_idx = pbuf_get_index('LS_FLXPRC') lsflxsnw_idx = pbuf_get_index('LS_FLXSNW') - allocate(first_run_cosp(begchunk:endchunk)) + allocate(first_run_cosp(begchunk:endchunk), run_cosp(1:pcols,begchunk:endchunk), & + stat=istat) + call handle_allocate_error(istat, sub, '*run_cosp') first_run_cosp(begchunk:endchunk)=.true. - allocate(run_cosp(1:pcols,begchunk:endchunk)) run_cosp(1:pcols,begchunk:endchunk)=.false. #endif end subroutine cospsimulator_intr_init + ! ###################################################################################### + ! SUBROUTINE setcosp2values + ! ###################################################################################### +#ifdef USE_COSP + subroutine setcosp2values() + use mod_cosp, only: cosp_init + use mod_cosp_config, only: vgrid_zl, vgrid_zu, vgrid_z + use mod_quickbeam_optics, only: hydro_class_init, quickbeam_optics_init + + ! Local + logical :: ldouble=.false. + logical :: lsingle=.true. ! Default is to use single moment + integer :: k + integer :: istat + character(len=*), parameter :: sub = 'setcosp2values' + !-------------------------------------------------------------------------------------- + + prsmid_cosp = pres_binCenters + prslim_cosp = pres_binEdges + taumid_cosp = tau_binCenters + taulim_cosp = tau_binEdges + srmid_cosp = calipso_binCenters + srlim_cosp = calipso_binEdges + sza_cosp = parasol_sza + dbzemid_cosp = cloudsat_binCenters + dbzelim_cosp = cloudsat_binEdges + htmisrmid_cosp = misr_histHgtCenters + htmisrlim_cosp = misr_histHgtEdges + taumid_cosp_modis = tau_binCenters + taulim_cosp_modis = tau_binEdges + reffICE_binCenters_cosp = reffICE_binCenters + reffICE_binEdges_cosp = reffICE_binEdges + reffLIQ_binCenters_cosp = reffLIQ_binCenters + reffLIQ_binEdges_cosp = reffLIQ_binEdges + + ! Initialize the distributional parameters for hydrometeors in radar simulator. In COSPv1.4, this was declared in + ! cosp_defs.f. + if (cloudsat_micro_scheme == 'MMF_v3.5_two_moment') then + ldouble = .true. + lsingle = .false. + endif + call hydro_class_init(lsingle,ldouble,sd) + call quickbeam_optics_init() + + ! DS2017: The setting up of the vertical grid for regridding the CALIPSO and Cloudsat products is + ! now done in cosp_init, but these fields are stored in cosp_config.F90. + ! Additionally all static fields used by the individual simulators are set up by calls + ! to _init functions in cosp_init. + ! DS2019: Add logicals, default=.false., for new Lidar simuldators (Earthcare (atlid) and ground-based + ! lidar at 532nm) + call COSP_INIT(Lisccp_sim, Lmodis_sim, Lmisr_sim, Lradar_sim, Llidar_sim, LgrLidar532, & + Latlid, Lparasol_sim, Lrttov_sim, radar_freq, k2, use_gas_abs, do_ray, & + isccp_topheight, isccp_topheight_direction, surface_radar, rcfg_cloudsat, & + use_vgrid, csat_vgrid, Nlr, nlay, cloudsat_micro_scheme) + + if (use_vgrid) then !! using fixed vertical grid + if (csat_vgrid) then + nht_cosp = 40 + else + nht_cosp = Nlr + endif + endif + + ! DJS2017: In COSP2, most of the bin boundaries, centers, and edges are declared in src/cosp_config.F90. + ! Above I just assign them accordingly in the USE statement. Other bin bounds needed by CAM + ! are calculated here. + + allocate( & + htmlmid_cosp(nlay), & + htdbze_dbzemid_cosp(nht_cosp*CLOUDSAT_DBZE_BINS), & + htlim_cosp(2,nht_cosp), & + htmid_cosp(nht_cosp), & + htlim_cosp_1d(nht_cosp+1), & + htdbze_htmid_cosp(nht_cosp*CLOUDSAT_DBZE_BINS), & + htsr_htmid_cosp(nht_cosp*nsr_cosp), & + htsr_srmid_cosp(nht_cosp*nsr_cosp), & + htmlscol_htmlmid_cosp(nlay*nscol_cosp), & + htmlscol_scol_cosp(nlay*nscol_cosp), & + scol_cosp(nscol_cosp), & + htdbze_cosp(nht_cosp*CLOUDSAT_DBZE_BINS), & + htsr_cosp(nht_cosp*nsr_cosp), & + htmlscol_cosp(nlay*nscol_cosp), stat=istat) + call handle_allocate_error(istat, sub, 'htmlmid_cosp,..,htmlscol_cosp') + + ! DJS2017: Just pull from cosp_config + if (use_vgrid) then + htlim_cosp_1d(1) = vgrid_zu(1) + htlim_cosp_1d(2:nht_cosp+1) = vgrid_zl + endif + htmid_cosp = vgrid_z + htlim_cosp(1,:) = vgrid_zu + htlim_cosp(2,:) = vgrid_zl + + scol_cosp(:) = (/(k,k=1,nscol_cosp)/) + + ! Just using an index here, model height is a prognostic variable + htmlmid_cosp(:) = (/(k,k=1,nlay)/) + + ! assign mixed dimensions an integer index for cam_history.F90 + do k=1,nprs_cosp*ntau_cosp + prstau_cosp(k) = k + end do + do k=1,nprs_cosp*ntau_cosp_modis + prstau_cosp_modis(k) = k + end do + do k=1,nht_cosp*CLOUDSAT_DBZE_BINS + htdbze_cosp(k) = k + end do + do k=1,nht_cosp*nsr_cosp + htsr_cosp(k) = k + end do + do k=1,nlay*nscol_cosp + htmlscol_cosp(k) = k + end do + do k=1,nhtmisr_cosp*ntau_cosp + htmisrtau_cosp(k) = k + end do + + ! next, assign collapsed reference vectors for cam_history.F90 + ! convention for saving output = prs1,tau1 ... prs1,tau7 ; prs2,tau1 ... prs2,tau7 etc. + ! actual output is specified in cospsimulator_intr_init. + do k=1,nprs_cosp + prstau_taumid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=taumid_cosp(1:ntau_cosp) + prstau_prsmid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=prsmid_cosp(k) + prstau_taumid_cosp_modis(ntau_cosp_modis*(k-1)+1:k*ntau_cosp_modis)=taumid_cosp_modis(1:ntau_cosp_modis) + prstau_prsmid_cosp_modis(ntau_cosp_modis*(k-1)+1:k*ntau_cosp_modis)=prsmid_cosp(k) + enddo + + do k=1,nht_cosp + htdbze_dbzemid_cosp(CLOUDSAT_DBZE_BINS*(k-1)+1:k*CLOUDSAT_DBZE_BINS)=dbzemid_cosp(1:CLOUDSAT_DBZE_BINS) + htdbze_htmid_cosp(CLOUDSAT_DBZE_BINS*(k-1)+1:k*CLOUDSAT_DBZE_BINS)=htmid_cosp(k) + enddo + + do k=1,nht_cosp + htsr_srmid_cosp(nsr_cosp*(k-1)+1:k*nsr_cosp)=srmid_cosp(1:nsr_cosp) + htsr_htmid_cosp(nsr_cosp*(k-1)+1:k*nsr_cosp)=htmid_cosp(k) + enddo + + do k=1,nlay + htmlscol_scol_cosp(nscol_cosp*(k-1)+1:k*nscol_cosp)=scol_cosp(1:nscol_cosp) + htmlscol_htmlmid_cosp(nscol_cosp*(k-1)+1:k*nscol_cosp)=htmlmid_cosp(k) + enddo + + do k=1,nhtmisr_cosp + htmisrtau_taumid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=taumid_cosp(1:ntau_cosp) + htmisrtau_htmisrmid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=htmisrmid_cosp(k) + enddo + + end subroutine setcosp2values +#endif + ! ###################################################################################### ! SUBROUTINE cospsimulator_intr_run ! ###################################################################################### - subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,snow_tau_in,snow_emis_in) + subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & + cld_swtau_in, snow_tau_in, snow_emis_in) + use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx use camsrfexch, only: cam_in_t use constituents, only: cnst_get_ind use rad_constituents, only: rad_cnst_get_gas - use wv_saturation, only: qsat_water use interpolate_data, only: lininterp_init,lininterp,lininterp_finish,interp_type - use physconst, only: pi, gravit + use physconst, only: pi, inverse_gravit => rga use cam_history, only: outfld,hist_fld_col_active use cam_history_support, only: max_fieldname_len - use cmparray_mod, only: CmpDayNite, ExpDayNite + #ifdef USE_COSP - use mod_cosp_config, only: R_UNDEF,parasol_nrefl, Nlvgrid, vgrid_zl, vgrid_zu + use mod_cosp_config, only: R_UNDEF,parasol_nrefl, Nlvgrid use mod_cosp, only: cosp_simulator use mod_quickbeam_optics, only: size_distribution #endif @@ -1222,69 +1080,20 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ! ###################################################################################### integer :: lchnk ! chunk identifier integer :: ncol ! number of active atmospheric columns - integer :: i,k,ip,it,ipt,ih,id,ihd,is,ihs,isc,ihsc,ihm,ihmt,ihml,itim_old,ifld - - ! Variables for day/nite and orbital subsetting - ! Gathered indicies of day and night columns - ! chunk_column_index = IdxDay(daylight_column_index) - integer :: Nday ! Number of daylight columns - integer :: Nno ! Number of columns not using for simulator - integer, dimension(pcols) :: IdxDay ! Indices of daylight columns - integer, dimension(pcols) :: IdxNo ! Indices of columns not using for simulator - real(r8) :: tmp(pcols) ! tempororary variable for array expansion - real(r8) :: tmp1(pcols,pver) ! tempororary variable for array expansion - real(r8) :: tmp2(pcols,pver) ! tempororary variable for array expansion - real(r8) :: lon_cosp_day(pcols) ! tempororary variable for sunlit lons - real(r8) :: lat_cosp_day(pcols) ! tempororary variable for sunlit lats - real(r8) :: ptop_day(pcols,pver) ! tempororary variable for sunlit ptop - real(r8) :: pmid_day(pcols,pver) ! tempororary variable for sunlit pmid - real(r8) :: ztop_day(pcols,pver) ! tempororary variable for sunlit ztop - real(r8) :: zmid_day(pcols,pver) ! tempororary variable for sunlit zmid - real(r8) :: t_day(pcols,pver) ! tempororary variable for sunlit t - real(r8) :: rh_day(pcols,pver) ! tempororary variable for sunlit rh - real(r8) :: q_day(pcols,pver) ! tempororary variable for sunlit q - real(r8) :: concld_day(pcols,pver) ! tempororary variable for sunlit concld - real(r8) :: cld_day(pcols,pver) ! tempororary variable for sunlit cld - real(r8) :: ps_day(pcols) ! tempororary variable for sunlit ps - real(r8) :: ts_day(pcols) ! tempororary variable for sunlit ts - real(r8) :: landmask_day(pcols) ! tempororary variable for sunlit landmask - real(r8) :: o3_day(pcols,pver) ! tempororary variable for sunlit o3 - real(r8) :: us_day(pcols) ! tempororary variable for sunlit us - real(r8) :: vs_day(pcols) ! tempororary variable for sunlit vs - real(r8) :: mr_lsliq_day(pcols,pver) ! tempororary variable for sunlit mr_lsliq - real(r8) :: mr_lsice_day(pcols,pver) ! tempororary variable for sunlit mr_lsice - real(r8) :: mr_ccliq_day(pcols,pver) ! tempororary variable for sunlit mr_ccliq - real(r8) :: mr_ccice_day(pcols,pver) ! tempororary variable for sunlit mr_ccice - real(r8) :: rain_ls_interp_day(pcols,pver) ! tempororary variable for sunlit rain_ls_interp - real(r8) :: snow_ls_interp_day(pcols,pver) ! tempororary variable for sunlit snow_ls_interp - real(r8) :: grpl_ls_interp_day(pcols,pver) ! tempororary variable for sunlit grpl_ls_interp - real(r8) :: rain_cv_interp_day(pcols,pver) ! tempororary variable for sunlit rain_cv_interp - real(r8) :: snow_cv_interp_day(pcols,pver) ! tempororary variable for sunlit snow_cv_interp - real(r8) :: reff_cosp_day(pcols,pver,nhydro) ! tempororary variable for sunlit reff_cosp(:,:,:) - real(r8) :: dtau_s_day(pcols,pver) ! tempororary variable for sunlit dtau_s - real(r8) :: dtau_c_day(pcols,pver) ! tempororary variable for sunlit dtau_c - real(r8) :: dtau_s_snow_day(pcols,pver) ! tempororary variable for sunlit dtau_s_snow - real(r8) :: dem_s_day(pcols,pver) ! tempororary variable for sunlit dem_s - real(r8) :: dem_c_day(pcols,pver) ! tempororary variable for sunlit dem_c - real(r8) :: dem_s_snow_day(pcols,pver) ! tempororary variable for sunlit dem_s_snow - - ! Constants for optical depth calculation (from radcswmx.F90) - real(r8), parameter :: abarl = 2.817e-02_r8 ! A coefficient for extinction optical depth - real(r8), parameter :: bbarl = 1.305_r8 ! b coefficient for extinction optical depth - real(r8), parameter :: abari = 3.448e-03_r8 ! A coefficient for extinction optical depth - real(r8), parameter :: bbari = 2.431_r8 ! b coefficient for extinction optical depth - real(r8), parameter :: cldmin = 1.0e-80_r8 ! note: cldmin much less than cldmin from cldnrh - real(r8), parameter :: cldeps = 0.0_r8 + integer :: i, k, kk + integer :: itim_old + integer :: ip, it + integer :: ipt + integer :: ih, ihd, ihs, ihsc, ihm, ihmt, ihml + integer :: isc + integer :: is + integer :: id + + real(r8), parameter :: rad2deg = 180._r8/pi ! Microphysics variables - integer, parameter :: ncnstmax=4 ! number of constituents - character(len=8), dimension(ncnstmax), parameter :: & ! constituent names - cnst_names = (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE'/) - integer :: ncnst ! number of constituents (can vary) integer :: ixcldliq ! cloud liquid amount index for state%q integer :: ixcldice ! cloud ice amount index - integer :: ixnumliq ! cloud liquid number index - integer :: ixnumice ! cloud ice water index ! COSP-related local vars type(cosp_outputs) :: cospOUT ! COSP simulator outputs @@ -1292,52 +1101,37 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn type(cosp_column_inputs) :: cospstateIN ! COSP model fields needed by simulators ! COSP input variables that depend on CAM - ! 1) Npoints = number of gridpoints COSP will process (without subsetting, Npoints=ncol) - ! 2) Nlevels = number of model levels (Nlevels=pver) - real(r8), parameter :: time = 1.0_r8 ! time ! Time since start of run [days], set to 1 bc running over single CAM timestep - real(r8), parameter :: time_bnds(2)=(/0.5_r8,1.5_r8/) ! time_bnds ! Time boundaries - new in cosp v1.3, set following cosp_test.f90 line 121 integer :: Npoints ! Number of gridpoints COSP will process - integer :: Nlevels ! Nlevels - logical :: use_reff ! True if effective radius to be used by radar simulator - ! (always used by lidar) - logical :: use_precipitation_fluxes ! True if precipitation fluxes are input to the algorithm real(r8), parameter :: emsfc_lw = 0.99_r8 ! longwave emissivity of surface at 10.5 microns - ! set value same as in cloudsimulator.F90 ! Local vars related to calculations to go from CAM input to COSP input ! cosp convective value includes both deep and shallow convection - real(r8) :: ptop(pcols,pver) ! top interface pressure (Pa) - real(r8) :: ztop(pcols,pver) ! top interface height asl (m) - real(r8) :: pbot(pcols,pver) ! bottom interface pressure (Pa) - real(r8) :: zbot(pcols,pver) ! bottom interface height asl (m) - real(r8) :: zmid(pcols,pver) ! middle interface height asl (m) - real(r8) :: lat_cosp(pcols) ! lat for cosp (degrees_north) - real(r8) :: lon_cosp(pcols) ! lon for cosp (degrees_east) - real(r8) :: landmask(pcols) ! landmask (0 or 1) - real(r8) :: mr_lsliq(pcols,pver) ! mixing_ratio_large_scale_cloud_liquid (kg/kg) - real(r8) :: mr_lsice(pcols,pver) ! mixing_ratio_large_scale_cloud_ice (kg/kg) - real(r8) :: mr_ccliq(pcols,pver) ! mixing_ratio_convective_cloud_liquid (kg/kg) - real(r8) :: mr_ccice(pcols,pver) ! mixing_ratio_convective_cloud_ice (kg/kg) - real(r8) :: rain_cv(pcols,pverp) ! interface flux_convective_cloud_rain (kg m^-2 s^-1) - real(r8) :: snow_cv(pcols,pverp) ! interface flux_convective_cloud_snow (kg m^-2 s^-1) - real(r8) :: rain_cv_interp(pcols,pver) ! midpoint flux_convective_cloud_rain (kg m^-2 s^-1) - real(r8) :: snow_cv_interp(pcols,pver) ! midpoint flux_convective_cloud_snow (kg m^-2 s^-1) - real(r8) :: grpl_ls_interp(pcols,pver) ! midpoint ls grp flux, should be 0 - real(r8) :: rain_ls_interp(pcols,pver) ! midpoint ls rain flux (kg m^-2 s^-1) - real(r8) :: snow_ls_interp(pcols,pver) ! midpoint ls snow flux - real(r8) :: reff_cosp(pcols,pver,nhydro) ! effective radius for cosp input - real(r8) :: rh(pcols,pver) ! relative_humidity_liquid_water (%) - real(r8) :: es(pcols,pver) ! saturation vapor pressure - real(r8) :: qs(pcols,pver) ! saturation mixing ratio (kg/kg), saturation specific humidity - real(r8) :: cld_swtau(pcols,pver) ! incloud sw tau for input to COSP - real(r8) :: dtau_s(pcols,pver) ! dtau_s - Optical depth of stratiform cloud at 0.67 um - real(r8) :: dtau_c(pcols,pver) ! dtau_c - Optical depth of convective cloud at 0.67 um - real(r8) :: dtau_s_snow(pcols,pver) ! dtau_s_snow - Grid-box mean Optical depth of stratiform snow at 0.67 um - real(r8) :: dem_s(pcols,pver) ! dem_s - Longwave emis of stratiform cloud at 10.5 um - real(r8) :: dem_c(pcols,pver) ! dem_c - Longwave emis of convective cloud at 10.5 um - real(r8) :: dem_s_snow(pcols,pver) ! dem_s_snow - Grid-box mean Optical depth of stratiform snow at 10.5 um - integer :: cam_sunlit(pcols) ! cam_sunlit - Sunlit flag(1-sunlit/0-dark). - integer :: nSunLit,nNoSunLit ! Number of sunlit (not sunlit) scenes. + real(r8), allocatable :: & + zmid(:,:), & ! layer midpoint height asl (m) + zint(:,:), & ! layer interface height asl (m) + surf_hgt(:), & ! surface height (m) + landmask(:), & ! landmask (0 or 1) + mr_ccliq(:,:), & ! mixing_ratio_convective_cloud_liquid (kg/kg) + mr_ccice(:,:), & ! mixing_ratio_convective_cloud_ice (kg/kg) + mr_lsliq(:,:), & ! mixing_ratio_large_scale_cloud_liquid (kg/kg) + mr_lsice(:,:), & ! mixing_ratio_large_scale_cloud_ice (kg/kg) + rain_cv(:,:), & ! interface flux_convective_cloud_rain (kg m^-2 s^-1) + snow_cv(:,:), & ! interface flux_convective_cloud_snow (kg m^-2 s^-1) + rain_cv_interp(:,:), & ! midpoint flux_convective_cloud_rain (kg m^-2 s^-1) + snow_cv_interp(:,:), & ! midpoint flux_convective_cloud_snow (kg m^-2 s^-1) + rain_ls_interp(:,:), & ! midpoint ls rain flux (kg m^-2 s^-1) + snow_ls_interp(:,:), & ! midpoint ls snow flux + grpl_ls_interp(:,:), & ! midpoint ls grp flux, set to 0 + reff_cosp(:,:,:), & ! effective radius for cosp input + dtau_s(:,:), & ! Optical depth of stratiform cloud at 0.67 um + dtau_c(:,:), & ! Optical depth of convective cloud at 0.67 um + dtau_s_snow(:,:), & ! Grid-box mean Optical depth of stratiform snow at 0.67 um + dem_s(:,:), & ! Longwave emis of stratiform cloud at 10.5 um + dem_c(:,:), & ! Longwave emis of convective cloud at 10.5 um + dem_s_snow(:,:) ! Grid-box mean Optical depth of stratiform snow at 10.5 um + + integer :: cam_sunlit(pcols) ! cam_sunlit - Sunlit flag(1-sunlit/0-dark). + integer :: nSunLit ! Number of sunlit (not sunlit) scenes. ! ###################################################################################### ! Simulator output info @@ -1355,9 +1149,7 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn 'CS_NOPRECIP ', 'CS_RAINPOSS ', 'CS_RAINPROB ', & 'CS_RAINCERT ', 'CS_SNOWPOSS ', 'CS_SNOWCERT ', & 'CS_MIXPOSS ', 'CS_MIXCERT ', 'CS_RAINHARD ', & - 'CS_UN ', 'CS_PIA '/)!, 'CAM_MP_CVRAIN ', & - !'CAM_MP_CVSNOW ', 'CAM_MP_LSRAIN ', 'CAM_MP_LSSNOW ', & - !'CAM_MP_LSGRPL '/) + 'CS_UN ', 'CS_PIA '/) ! CALIPSO outputs character(len=max_fieldname_len),dimension(nf_calipso),parameter :: & @@ -1366,11 +1158,7 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn 'CLD_CAL_ICE ','CLD_CAL_UN ','CLD_CAL_TMP ','CLD_CAL_TMPLIQ ','CLD_CAL_TMPICE ',& 'CLD_CAL_TMPUN ','CLDTOT_CAL_ICE ','CLDTOT_CAL_LIQ ','CLDTOT_CAL_UN ','CLDHGH_CAL_ICE ',& 'CLDHGH_CAL_LIQ ','CLDHGH_CAL_UN ','CLDMED_CAL_ICE ','CLDMED_CAL_LIQ ','CLDMED_CAL_UN ',& - 'CLDLOW_CAL_ICE ','CLDLOW_CAL_LIQ ','CLDLOW_CAL_UN '/)!, & -! 'CLDOPQ_CAL ','CLDTHN_CAL ','CLDZOPQ_CAL ','CLDOPQ_CAL_2D ','CLDTHN_CAL_2D ',& -! 'CLDZOPQ_CAL_2D ','OPACITY_CAL_2D ','CLDOPQ_CAL_TMP ','CLDTHN_CAL_TMP ','CLDZOPQ_CAL_TMP',& -! 'CLDOPQ_CAL_Z ','CLDTHN_CAL_Z ','CLDTHN_CAL_EMIS','CLDOPQ_CAL_SE ','CLDTHN_CAL_SE ',& -! 'CLDZOPQ_CAL_SE' /) + 'CLDLOW_CAL_ICE ','CLDLOW_CAL_LIQ ','CLDLOW_CAL_UN '/) ! ISCCP outputs character(len=max_fieldname_len),dimension(nf_isccp),parameter :: & fname_isccp=(/'FISCCP1_COSP ','CLDTOT_ISCCP ','MEANCLDALB_ISCCP',& @@ -1388,7 +1176,7 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn 'CLRLMODIS '/) logical :: run_radar(nf_radar,pcols) ! logical telling you if you should run radar simulator - logical :: run_calipso(nf_calipso,pcols) ! logical telling you if you should run calipso simulator + logical :: run_calipso(nf_calipso,pcols) ! logical telling you if you should run calipso simulator logical :: run_isccp(nf_isccp,pcols) ! logical telling you if you should run isccp simulator logical :: run_misr(nf_misr,pcols) ! logical telling you if you should run misr simulator logical :: run_modis(nf_modis,pcols) ! logical telling you if you should run modis simulator @@ -1396,9 +1184,6 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ! CAM pointers to get variables from radiation interface (get from rad_cnst_get_gas) real(r8), pointer, dimension(:,:) :: q ! specific humidity (kg/kg) real(r8), pointer, dimension(:,:) :: o3 ! Mass mixing ratio 03 - real(r8), pointer, dimension(:,:) :: co2 ! Mass mixing ratio C02 - real(r8), pointer, dimension(:,:) :: ch4 ! Mass mixing ratio CH4 - real(r8), pointer, dimension(:,:) :: n2o ! Mass mixing ratio N20 ! CAM pointers to get variables from the physics buffer real(r8), pointer, dimension(:,:) :: cld ! cloud fraction, tca - total_cloud_amount (0-1) @@ -1410,102 +1195,68 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn real(r8), pointer, dimension(:,:) :: cv_reffliq ! convective cld liq effective drop radius (microns) real(r8), pointer, dimension(:,:) :: cv_reffice ! convective cld ice effective drop size (microns) - !! precip flux pointers (use for cam4 or cam5) - ! Added pointers; pbuff in zm_conv_intr.F90, calc in zm_conv.F90 + !! precip flux pointers + real(r8), target, dimension(pcols,pverp) :: zero_ifc ! zero array for interface fields not in the pbuf real(r8), pointer, dimension(:,:) :: dp_flxprc ! deep interface gbm flux_convective_cloud_rain+snow (kg m^-2 s^-1) real(r8), pointer, dimension(:,:) :: dp_flxsnw ! deep interface gbm flux_convective_cloud_snow (kg m^-2 s^-1) - ! More pointers; pbuf in convect_shallow.F90, calc in hk_conv.F90/convect_shallow.F90 (CAM4), uwshcu.F90 (CAM5) real(r8), pointer, dimension(:,:) :: sh_flxprc ! shallow interface gbm flux_convective_cloud_rain+snow (kg m^-2 s^-1) real(r8), pointer, dimension(:,:) :: sh_flxsnw ! shallow interface gbm flux_convective_cloud_snow (kg m^-2 s^-1) - ! More pointers; pbuf in stratiform.F90, getting from pbuf here - ! a) added as output to pcond subroutine in cldwat.F90 and to nmicro_pcond subroutine in cldwat2m_micro.F90 real(r8), pointer, dimension(:,:) :: ls_flxprc ! stratiform interface gbm flux_cloud_rain+snow (kg m^-2 s^-1) real(r8), pointer, dimension(:,:) :: ls_flxsnw ! stratiform interface gbm flux_cloud_snow (kg m^-2 s^-1) - !! cloud mixing ratio pointers (note: large-scale in state) - ! More pointers; pbuf in convect_shallow.F90 (cam4) or stratiform.F90 (cam5) - ! calc in hk_conv.F90 (CAM4 should be 0!), uwshcu.F90 but then affected by micro so values from stratiform.F90 (CAM5) - real(r8), pointer, dimension(:,:) :: sh_cldliq ! shallow gbm cloud liquid water (kg/kg) - real(r8), pointer, dimension(:,:) :: sh_cldice ! shallow gbm cloud ice water (kg/kg) - ! More pointers; pbuf in zm_conv_intr.F90, calc in zm_conv.F90, 0 for CAM4 and CAM5 (same convection scheme) - real(r8), pointer, dimension(:,:) :: dp_cldliq ! deep gbm cloud liquid water (kg/kg) - real(r8), pointer, dimension(:,:) :: dp_cldice ! deep gmb cloud ice water (kg/kg) + !! grid box total cloud mixing ratio (large-scale + convective) + real(r8), pointer, dimension(:,:) :: totg_liq ! gbm total cloud liquid water (kg/kg) + real(r8), pointer, dimension(:,:) :: totg_ice ! gbm total cloud ice water (kg/kg) ! Output CAM variables - ! Notes: - ! 1) use pcols (maximum number of columns that code could use, maybe 16) - ! pcols vs. ncol. ncol is the number of columns a chunk is actually using, pcols is maximum number - ! 2) Mixed variables rules/notes, need to collapse because CAM history does not support increased dimensionality - ! MIXED DIMS: ntau_cosp*nprs_cosp, CLOUDSAT_DBZE_BINS*nht_cosp, nsr_cosp*nht_cosp, nscol_cosp*nhtml_cosp, ntau_cosp*nhtmisr_cosp - ! a) always making mixed variables VERTICAL*OTHER, e.g., pressure*tau or ht*dbze - ! b) always collapsing output as V1_1/V2_1...V1_1/V2_N ; V1_2/V2_1 ...V1_2/V2_N etc. to V1_N/V2_1 ... V1_N/V2_N - ! c) here, need vars for both multi-dimensional output from COSP, and two-dimensional output from CAM - ! 3) ntime=1, nprofile=ncol - ! 4) dimensions listed in COSP units are from netcdf output from cosp test case, and are not necessarily in the - ! correct order. In fact, most of them are not as I discovered after trying to run COSP in-line. - ! BE says this could be because FORTRAN and C (netcdf defaults to C) have different conventions. - ! 5) !! Note: after running COSP, it looks like height_mlev is actually the model levels after all!! - real(r8) :: clisccp2(pcols,ntau_cosp,nprs_cosp) ! clisccp2 (time,tau,plev,profile) - real(r8) :: cfad_dbze94(pcols,CLOUDSAT_DBZE_BINS,nht_cosp) ! cfad_dbze94 (time,height,dbze,profile) - real(r8) :: cfad_lidarsr532(pcols,nsr_cosp,nht_cosp) ! cfad_lidarsr532 (time,height,scat_ratio,profile) - real(r8) :: dbze94(pcols,nscol_cosp,nhtml_cosp) ! dbze94 (time,height_mlev,column,profile) - real(r8) :: atb532(pcols,nscol_cosp,nhtml_cosp) ! atb532 (time,height_mlev,column,profile) - real(r8) :: clMISR(pcols,ntau_cosp,nhtmisr_cosp) ! clMISR (time,tau,CTH_height_bin,profile) - real(r8) :: frac_out(pcols,nscol_cosp,nhtml_cosp) ! frac_out (time,height_mlev,column,profile) - real(r8) :: cldtot_isccp(pcols) ! CAM tclisccp (time,profile) - real(r8) :: meancldalb_isccp(pcols) ! CAM albisccp (time,profile) - real(r8) :: meanptop_isccp(pcols) ! CAM ctpisccp (time,profile) - real(r8) :: cldlow_cal(pcols) ! CAM cllcalipso (time,profile) - real(r8) :: cldmed_cal(pcols) ! CAM clmcalipso (time,profile) - real(r8) :: cldhgh_cal(pcols) ! CAM clhcalipso (time,profile) - real(r8) :: cldtot_cal(pcols) ! CAM cltcalipso (time,profile) - real(r8) :: cldtot_cal_ice(pcols) ! CAM (time,profile) !!+cosp1.4 - real(r8) :: cldtot_cal_liq(pcols) ! CAM (time,profile) - real(r8) :: cldtot_cal_un(pcols) ! CAM (time,profile) - real(r8) :: cldhgh_cal_ice(pcols) ! CAM (time,profile) - real(r8) :: cldhgh_cal_liq(pcols) ! CAM (time,profile) - real(r8) :: cldhgh_cal_un(pcols) ! CAM (time,profile) - real(r8) :: cldmed_cal_ice(pcols) ! CAM (time,profile) - real(r8) :: cldmed_cal_liq(pcols) ! CAM (time,profile) - real(r8) :: cldmed_cal_un(pcols) ! CAM (time,profile) - real(r8) :: cldlow_cal_ice(pcols) ! CAM (time,profile) - real(r8) :: cldlow_cal_liq(pcols) ! CAM (time,profile) - real(r8) :: cldlow_cal_un(pcols) ! CAM (time,profile) !+cosp1.4 - real(r8) :: cld_cal(pcols,nht_cosp) ! CAM clcalipso (time,height,profile) - real(r8) :: cld_cal_liq(pcols,nht_cosp) ! CAM (time,height,profile) !+cosp1.4 - real(r8) :: cld_cal_ice(pcols,nht_cosp) ! CAM (time,height,profile) - real(r8) :: cld_cal_un(pcols,nht_cosp) ! CAM (time,height,profile) - real(r8) :: cld_cal_tmp(pcols,nht_cosp) ! CAM (time,height,profile) - real(r8) :: cld_cal_tmpliq(pcols,nht_cosp) ! CAM (time,height,profile) - real(r8) :: cld_cal_tmpice(pcols,nht_cosp) ! CAM (time,height,profile) - real(r8) :: cld_cal_tmpun(pcols,nht_cosp) ! CAM (time,height,profile) !+cosp1.4 -! real(r8) :: cldopaq_cal(pcols) -! real(r8) :: cldthin_cal(pcols) -! real(r8) :: cldopaqz_cal(pcols) -! real(r8) :: cldopaq_cal_temp(pcols) -! real(r8) :: cldthin_cal_temp(pcols) -! real(r8) :: cldzopaq_cal_temp(pcols) -! real(r8) :: cldopaq_cal_z(pcols) -! real(r8) :: cldthin_cal_z(pcols) -! real(r8) :: cldthin_cal_emis(pcols) -! real(r8) :: cldopaq_cal_se(pcols) -! real(r8) :: cldthin_cal_se(pcols) -! real(r8) :: cldzopaq_cal_se(pcols) -! real(r8) :: cldopaq_cal_2d(pcols,nht_cosp) -! real(r8) :: cldthin_cal_2d(pcols,nht_cosp) -! real(r8) :: cldzopaq_cal_2d(pcols,nht_cosp) -! real(r8) :: opacity_cal_2d(pcols,nht_cosp) - real(r8) :: cfad_dbze94_cs(pcols,nht_cosp*CLOUDSAT_DBZE_BINS)! CAM cfad_dbze94 (time,height,dbze,profile) - real(r8) :: cfad_sr532_cal(pcols,nht_cosp*nsr_cosp) ! CAM cfad_lidarsr532 (time,height,scat_ratio,profile) - real(r8) :: tau_isccp(pcols,nscol_cosp) ! CAM boxtauisccp (time,column,profile) - real(r8) :: cldptop_isccp(pcols,nscol_cosp) ! CAM boxptopisccp (time,column,profile) - real(r8) :: meantau_isccp(pcols) ! CAM tauisccp (time,profile) - real(r8) :: meantb_isccp(pcols) ! CAM meantbisccp (time,profile) - real(r8) :: meantbclr_isccp(pcols) ! CAM meantbclrisccp (time,profile) - real(r8) :: dbze_cs(pcols,nhtml_cosp*nscol_cosp) ! CAM dbze94 (time,height_mlev,column,profile) - real(r8) :: cldtot_calcs(pcols) ! CAM cltlidarradar (time,profile) - real(r8) :: cldtot_cs(pcols) ! CAM cltradar (time,profile) - real(r8) :: cldtot_cs2(pcols) ! CAM cltradar2 (time,profile) + ! Multiple "mdims" are collapsed because CAM history buffers only support one mdim. + ! MIXED DIMS: ntau_cosp*nprs_cosp, CLOUDSAT_DBZE_BINS*nht_cosp, nsr_cosp*nht_cosp, nscol_cosp*nlay, + ! ntau_cosp*nhtmisr_cosp + real(r8) :: clisccp2(pcols,ntau_cosp,nprs_cosp) + real(r8) :: cfad_dbze94(pcols,CLOUDSAT_DBZE_BINS,nht_cosp) + real(r8) :: cfad_lidarsr532(pcols,nsr_cosp,nht_cosp) + real(r8) :: dbze94(pcols,nscol_cosp,nlay) + real(r8) :: atb532(pcols,nscol_cosp,nlay) + real(r8) :: clMISR(pcols,ntau_cosp,nhtmisr_cosp) + real(r8) :: frac_out(pcols,nscol_cosp,nlay) + real(r8) :: cldtot_isccp(pcols) + real(r8) :: meancldalb_isccp(pcols) + real(r8) :: meanptop_isccp(pcols) + real(r8) :: cldlow_cal(pcols) + real(r8) :: cldmed_cal(pcols) + real(r8) :: cldhgh_cal(pcols) + real(r8) :: cldtot_cal(pcols) + real(r8) :: cldtot_cal_ice(pcols) + real(r8) :: cldtot_cal_liq(pcols) + real(r8) :: cldtot_cal_un(pcols) + real(r8) :: cldhgh_cal_ice(pcols) + real(r8) :: cldhgh_cal_liq(pcols) + real(r8) :: cldhgh_cal_un(pcols) + real(r8) :: cldmed_cal_ice(pcols) + real(r8) :: cldmed_cal_liq(pcols) + real(r8) :: cldmed_cal_un(pcols) + real(r8) :: cldlow_cal_ice(pcols) + real(r8) :: cldlow_cal_liq(pcols) + real(r8) :: cldlow_cal_un(pcols) + real(r8) :: cld_cal(pcols,nht_cosp) + real(r8) :: cld_cal_liq(pcols,nht_cosp) + real(r8) :: cld_cal_ice(pcols,nht_cosp) + real(r8) :: cld_cal_un(pcols,nht_cosp) + real(r8) :: cld_cal_tmp(pcols,nht_cosp) + real(r8) :: cld_cal_tmpliq(pcols,nht_cosp) + real(r8) :: cld_cal_tmpice(pcols,nht_cosp) + real(r8) :: cld_cal_tmpun(pcols,nht_cosp) + real(r8) :: cfad_dbze94_cs(pcols,nht_cosp*CLOUDSAT_DBZE_BINS) + real(r8) :: cfad_sr532_cal(pcols,nht_cosp*nsr_cosp) + real(r8) :: tau_isccp(pcols,nscol_cosp) + real(r8) :: cldptop_isccp(pcols,nscol_cosp) + real(r8) :: meantau_isccp(pcols) + real(r8) :: meantb_isccp(pcols) + real(r8) :: meantbclr_isccp(pcols) + real(r8) :: dbze_cs(pcols,nlay*nscol_cosp) + real(r8) :: cldtot_calcs(pcols) + real(r8) :: cldtot_cs(pcols) + real(r8) :: cldtot_cs2(pcols) real(r8) :: ptcloudsatflag0(pcols) real(r8) :: ptcloudsatflag1(pcols) real(r8) :: ptcloudsatflag2(pcols) @@ -1517,12 +1268,12 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn real(r8) :: ptcloudsatflag8(pcols) real(r8) :: ptcloudsatflag9(pcols) real(r8) :: cloudsatpia(pcols) - real(r8) :: cld_cal_notcs(pcols,nht_cosp) ! CAM clcalipso2 (time,height,profile) - real(r8) :: atb532_cal(pcols,nhtml_cosp*nscol_cosp) ! CAM atb532 (time,height_mlev,column,profile) - real(r8) :: mol532_cal(pcols,nhtml_cosp) ! CAM beta_mol532 (time,height_mlev,profile) - real(r8) :: cld_misr(pcols,nhtmisr_cosp*ntau_cosp) ! CAM clMISR (time,tau,CTH_height_bin,profile) - real(r8) :: refl_parasol(pcols,nsza_cosp) ! CAM parasol_refl (time,sza,profile) - real(r8) :: scops_out(pcols,nhtml_cosp*nscol_cosp) ! CAM frac_out (time,height_mlev,column,profile) + real(r8) :: cld_cal_notcs(pcols,nht_cosp) + real(r8) :: atb532_cal(pcols,nlay*nscol_cosp) + real(r8) :: mol532_cal(pcols,nlay) + real(r8) :: cld_misr(pcols,nhtmisr_cosp*ntau_cosp) + real(r8) :: refl_parasol(pcols,nsza_cosp) + real(r8) :: scops_out(pcols,nlay*nscol_cosp) real(r8) :: cltmodis(pcols) real(r8) :: clwmodis(pcols) real(r8) :: climodis(pcols) @@ -1546,43 +1297,40 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn real(r8) :: clrimodis(pcols,ntau_cosp,numMODISReffIceBins) real(r8) :: clrlmodis_cam(pcols,ntau_cosp*numMODISReffLiqBins) real(r8) :: clrlmodis(pcols,ntau_cosp,numMODISReffLiqBins) - !real(r8) :: tau067_out(pcols,nhtml_cosp*nscol_cosp),emis11_out(pcols,nhtml_cosp*nscol_cosp) - real(r8),dimension(pcols,nhtml_cosp*nscol_cosp) :: & - tau067_out,emis11_out,fracliq_out,cal_betatot,cal_betatot_ice, & - cal_betatot_liq,cal_tautot,cal_tautot_ice,cal_tautot_liq,cs_gvol_out,cs_krvol_out,cs_zvol_out,& - asym34_out,ssa34_out + real(r8), dimension(pcols,nlay*nscol_cosp) :: & + tau067_out, emis11_out, fracliq_out, asym34_out, ssa34_out type(interp_type) :: interp_wgts - integer, parameter :: extrap_method = 1 ! sets extrapolation method to boundary value (1) + integer, parameter :: extrap_method = 1 ! sets extrapolation method to boundary value (1) ! COSPv2 stuff character(len=256),dimension(100) :: cosp_status integer :: nerror + integer :: istat + character(len=*), parameter :: sub = 'cospsimulator_intr_run' + !-------------------------------------------------------------------------------------- + call t_startf("init_and_stuff") ! ###################################################################################### ! Initialization ! ###################################################################################### - ! Find the chunk and ncol from the state vector - lchnk = state%lchnk ! state variable contains a number of columns, one chunk + + lchnk = state%lchnk ! chunk ID ncol = state%ncol ! number of columns in the chunk + Npoints = ncol ! number of COSP gridpoints - ! Initialize temporary variables as R_UNDEF - need to do this otherwise array expansion puts garbage in history - ! file for columns over which COSP did make calculations. - tmp(1:pcols) = R_UNDEF - tmp1(1:pcols,1:pver) = R_UNDEF - tmp2(1:pcols,1:pver) = R_UNDEF - + zero_ifc = 0._r8 + ! Initialize CAM variables as R_UNDEF, important for history files because it will exclude these from averages - ! (multi-dimensional output that will be collapsed) ! initialize over all pcols, not just ncol. missing values needed in chunks where ncol 0) then + call pbuf_get_field(pbuf, shflxprc_idx, sh_flxprc ) + else + sh_flxprc => zero_ifc + end if + if (shflxsnw_idx > 0) then + call pbuf_get_field(pbuf, shflxsnw_idx, sh_flxsnw ) + else + sh_flxsnw => zero_ifc + end if call pbuf_get_field(pbuf, lsflxprc_idx, ls_flxprc ) call pbuf_get_field(pbuf, lsflxsnw_idx, ls_flxsnw ) !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! CALCULATE COSP INPUT VARIABLES FROM CAM VARIABLES, done for all columns within chunk !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - ! 0) Create ptop/ztop for gbx%pf and gbx%zlev are for the the interface, - ! also reverse CAM height/pressure values for input into CSOP - ! CAM state%pint from top to surface, COSP wants surface to top. - - ! Initalize - ptop(1:ncol,1:pver)=0._r8 - pbot(1:ncol,1:pver)=0._r8 - ztop(1:ncol,1:pver)=0._r8 - zbot(1:ncol,1:pver)=0._r8 - zmid(1:ncol,1:pver)=0._r8 - - ! assign values from top - do k=1,pverp-1 - ! assign values from top - ptop(1:ncol,k)=state%pint(1:ncol,pverp-k) - ztop(1:ncol,k)=state%zi(1:ncol,pverp-k) - ! assign values from bottom - pbot(1:ncol,k)=state%pint(1:ncol,pverp-k+1) - zbot(1:ncol,k)=state%zi(1:ncol,pverp-k+1) - end do - - ! add surface height (surface geopotential/gravity) to convert CAM heights based on geopotential above surface into height above sea level - do k=1,pver - do i=1,ncol - ztop(i,k)=ztop(i,k)+state%phis(i)/gravit - zbot(i,k)=zbot(i,k)+state%phis(i)/gravit - zmid(i,k)=state%zm(i,k)+state%phis(i)/gravit - end do - end do - - ! 1) lat/lon - convert from radians to cosp input type - ! Initalize - lat_cosp(1:ncol)=0._r8 - lon_cosp(1:ncol)=0._r8 - ! convert from radians to degrees_north and degrees_east - lat_cosp=state%lat*180._r8/(pi) ! needs to go from -90 to +90 degrees north - lon_cosp=state%lon*180._r8/(pi) ! needs to go from 0 to 360 degrees east - - ! 2) rh - relative_humidity_liquid_water (%) - ! calculate from CAM q and t using CAM built-in functions - call qsat_water(state%t(1:ncol,1:pver), state%pmid(1:ncol,1:pver), & - es(1:ncol,1:pver), qs(1:ncol,1:pver)) - - ! initialize rh - rh(1:ncol,1:pver)=0._r8 - - ! calculate rh - do k=1,pver - do i=1,ncol - rh(i,k)=(q(i,k)/qs(i,k))*100 - end do + + ! These arrays are dimensioned to only include active columns (ncol), and the number + ! of layers (nlay) and layer interfaces (nlayp) operated on by COSP. + allocate( & + zmid(ncol,nlay), & + zint(ncol,nlayp), & + surf_hgt(ncol), & + landmask(ncol), & + mr_ccliq(ncol,nlay), & + mr_ccice(ncol,nlay), & + mr_lsliq(ncol,nlay), & + mr_lsice(ncol,nlay), & + rain_cv(ncol,nlayp), & + snow_cv(ncol,nlayp), & + rain_cv_interp(ncol,nlay), & + snow_cv_interp(ncol,nlay), & + rain_ls_interp(ncol,nlay), & + snow_ls_interp(ncol,nlay), & + grpl_ls_interp(ncol,nlay), & + reff_cosp(ncol,nlay,nhydro), & + dtau_s(ncol,nlay), & + dtau_c(ncol,nlay), & + dtau_s_snow(ncol,nlay), & + dem_s(ncol,nlay), & + dem_c(ncol,nlay), & + dem_s_snow(ncol,nlay), stat=istat) + call handle_allocate_error(istat, sub, 'zmid,..,dem_s_snow') + + ! add surface height (surface geopotential/gravity) to convert CAM heights based on + ! geopotential above surface into height above sea level + surf_hgt = state%phis(:ncol)*inverse_gravit + do k = 1, nlay + zmid(:,k) = state%zm(:ncol,ktop+k-1) + surf_hgt + zint(:,k) = state%zi(:ncol,ktop+k-1) + surf_hgt end do - - ! 3) landmask - calculate from cam_in%landfrac - ! initalize landmask - landmask(1:ncol)=0._r8 - ! calculate landmask - do i=1,ncol - if (cam_in%landfrac(i).gt.0.01_r8) landmask(i)= 1 + zint(:,nlayp) = surf_hgt + + landmask = 0._r8 + do i = 1, ncol + if (cam_in%landfrac(i) > 0.01_r8) landmask(i)= 1 end do - ! 4) calculate necessary input cloud/precip variables - ! CAM4 note: don't take the cloud water from the hack shallow convection scheme or the deep convection. - ! cloud water values for convection are the same as the stratiform value. (Sungsu) - ! all precip fluxes are mid points, all values are grid-box mean ("gbm") (Yuying) - - ! initialize local variables - mr_ccliq(1:ncol,1:pver) = 0._r8 - mr_ccice(1:ncol,1:pver) = 0._r8 - mr_lsliq(1:ncol,1:pver) = 0._r8 - mr_lsice(1:ncol,1:pver) = 0._r8 - grpl_ls_interp(1:ncol,1:pver) = 0._r8 - rain_ls_interp(1:ncol,1:pver) = 0._r8 - snow_ls_interp(1:ncol,1:pver) = 0._r8 - rain_cv(1:ncol,1:pverp) = 0._r8 - snow_cv(1:ncol,1:pverp) = 0._r8 - rain_cv_interp(1:ncol,1:pver) = 0._r8 - snow_cv_interp(1:ncol,1:pver) = 0._r8 - reff_cosp(1:ncol,1:pver,1:nhydro) = 0._r8 - ! note: reff_cosp dimensions should be same as cosp (reff_cosp has 9 hydrometeor dimension) - ! Reff(Npoints,Nlevels,N_HYDRO) - - use_precipitation_fluxes = .true. !!! consistent with cam4 implementation. - - ! add together deep and shallow convection precipitation fluxes, recall *_flxprc variables are rain+snow - rain_cv(1:ncol,1:pverp) = (sh_flxprc(1:ncol,1:pverp)-sh_flxsnw(1:ncol,1:pverp)) + & - (dp_flxprc(1:ncol,1:pverp)-dp_flxsnw(1:ncol,1:pverp)) - snow_cv(1:ncol,1:pverp) = sh_flxsnw(1:ncol,1:pverp) + dp_flxsnw(1:ncol,1:pverp) + ! Add together deep and shallow convection precipitation fluxes. + ! Note: sh_flxprc and dp_flxprc variables are rain+snow + rain_cv = (sh_flxprc(:ncol,ktop:pverp) - sh_flxsnw(:ncol,ktop:pverp)) + & + (dp_flxprc(:ncol,ktop:pverp) - dp_flxsnw(:ncol,ktop:pverp)) + snow_cv = sh_flxsnw(:ncol,ktop:pverp) + dp_flxsnw(:ncol,ktop:pverp) ! interpolate interface precip fluxes to mid points - do i=1,ncol - ! find weights (pressure weighting?) - call lininterp_init(state%zi(i,1:pverp),pverp,state%zm(i,1:pver),pver,extrap_method,interp_wgts) - ! interpolate lininterp1d(arrin, nin, arrout, nout, interp_wgts) - ! note: lininterp is an interface, contains lininterp1d -- code figures out to use lininterp1d. - call lininterp(rain_cv(i,1:pverp),pverp,rain_cv_interp(i,1:pver),pver,interp_wgts) - call lininterp(snow_cv(i,1:pverp),pverp,snow_cv_interp(i,1:pver),pver,interp_wgts) - call lininterp(ls_flxprc(i,1:pverp),pverp,rain_ls_interp(i,1:pver),pver,interp_wgts) - call lininterp(ls_flxsnw(i,1:pverp),pverp,snow_ls_interp(i,1:pver),pver,interp_wgts) + do i = 1, ncol + ! find weights + call lininterp_init(state%zi(i,ktop:pverp), nlayp, state%zm(i,ktop:pver), nlay, & + extrap_method, interp_wgts) + ! interpolate lininterp(arrin, nin, arrout, nout, interp_wgts) + call lininterp(rain_cv(i,:), nlayp, rain_cv_interp(i,:), nlay, interp_wgts) + call lininterp(snow_cv(i,:), nlayp, snow_cv_interp(i,:), nlay, interp_wgts) + call lininterp(ls_flxprc(i,ktop:pverp), nlayp, rain_ls_interp(i,:), nlay, interp_wgts) + call lininterp(ls_flxsnw(i,ktop:pverp), nlayp, snow_ls_interp(i,:), nlay, interp_wgts) call lininterp_finish(interp_wgts) !! ls_flxprc is for rain+snow, find rain_ls_interp by subtracting off snow_ls_interp - rain_ls_interp(i,1:pver)=rain_ls_interp(i,1:pver)-snow_ls_interp(i,1:pver) + rain_ls_interp(i,:) = rain_ls_interp(i,:) - snow_ls_interp(i,:) end do - - !! CAM5 cloud mixing ratio calculations - !! Note: Although CAM5 has non-zero convective cloud mixing ratios that affect the model state, - !! Convective cloud water is NOT part of radiation calculations. - do k=1,pver - do i=1,ncol - if (cld(i,k) .gt. 0._r8) then - !! note: convective mixing ratio is the sum of shallow and deep convective clouds in CAM5 - mr_ccliq(i,k) = sh_cldliq(i,k) + dp_cldliq(i,k) - mr_ccice(i,k) = sh_cldice(i,k) + dp_cldice(i,k) - mr_lsliq(i,k)=state%q(i,k,ixcldliq) ! mr_lsliq, mixing_ratio_large_scale_cloud_liquid, state only includes stratiform (kg/kg) - mr_lsice(i,k)=state%q(i,k,ixcldice) ! mr_lsice - mixing_ratio_large_scale_cloud_ice, state only includes stratiform (kg/kg) - else - mr_ccliq(i,k) = 0._r8 - mr_ccice(i,k) = 0._r8 - mr_lsliq(i,k) = 0._r8 - mr_lsice(i,k) = 0._r8 + + !! Make sure interpolated values are not less than 0 + do k = 1, nlay + do i = 1, ncol + if (rain_ls_interp(i,k) < 0._r8) then + rain_ls_interp(i,k) = 0._r8 end if - end do - end do - - !! Previously, I had set use_reff=.false. - !! use_reff = .false. !! if you use this,all sizes use DEFAULT_LIDAR_REFF = 30.0e-6 meters - - !! The specification of reff_cosp now follows e-mail discussion with Yuying in January 2011. (see above) - !! All of the values that I have assembled in the code are in microns... convert to meters here since that is what COSP wants. - use_reff = .true. - reff_cosp(1:ncol,1:pver,1) = rel(1:ncol,1:pver)*1.e-6_r8 !! LSCLIQ (same as effc and effliq in stratiform.F90) - reff_cosp(1:ncol,1:pver,2) = rei(1:ncol,1:pver)*1.e-6_r8 !! LSCICE (same as effi and effice in stratiform.F90) - reff_cosp(1:ncol,1:pver,3) = ls_reffrain(1:ncol,1:pver)*1.e-6_r8 !! LSRAIN (calculated in cldwat2m_micro.F90, passed to stratiform.F90) - reff_cosp(1:ncol,1:pver,4) = ls_reffsnow(1:ncol,1:pver)*1.e-6_r8 !! LSSNOW (calculated in cldwat2m_micro.F90, passed to stratiform.F90) - reff_cosp(1:ncol,1:pver,5) = cv_reffliq(1:ncol,1:pver)*1.e-6_r8 !! CVCLIQ (calculated in stratiform.F90, not actually used in radiation) - reff_cosp(1:ncol,1:pver,6) = cv_reffice(1:ncol,1:pver)*1.e-6_r8 !! CVCICE (calculated in stratiform.F90, not actually used in radiation) - reff_cosp(1:ncol,1:pver,7) = ls_reffrain(1:ncol,1:pver)*1.e-6_r8 !! CVRAIN (same as stratiform per Andrew) - reff_cosp(1:ncol,1:pver,8) = ls_reffsnow(1:ncol,1:pver)*1.e-6_r8 !! CVSNOW (same as stratiform per Andrew) - reff_cosp(1:ncol,1:pver,9) = 0._r8 !! LSGRPL (using radar default reff) - - !! Need code below for when effective radius is fillvalue, and you multiply it by 1.e-6 to convert units, and value becomes no longer fillvalue. - !! Here, we set it back to zero. - where (rel(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,1) = 0._r8 - end where - where (rei(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,2) = 0._r8 - end where - where (ls_reffrain(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,3) = 0._r8 - end where - where (ls_reffsnow(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,4) = 0._r8 - end where - where (cv_reffliq(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,5) = 0._r8 - end where - where (cv_reffice(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,6) = 0._r8 - end where - where (ls_reffrain(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,7) = 0._r8 - end where - where (ls_reffsnow(1:ncol,1:pver) .eq. R_UNDEF) - reff_cosp(1:ncol,1:pver,8) = 0._r8 - end where - - !! Make sure interpolated values are not less than 0 - COSP was complaining and resetting small negative values to zero. - !! ----- WARNING: COSP_CHECK_INPUT_2D: minimum value of rain_ls set to: 0.000000000000000 - !! So I set negative values to zero here... - do k=1,pver - do i=1,ncol - if (rain_ls_interp(i,k) .lt. 0._r8) then - rain_ls_interp(i,k)=0._r8 + if (snow_ls_interp(i,k) < 0._r8) then + snow_ls_interp(i,k) = 0._r8 end if - if (snow_ls_interp(i,k) .lt. 0._r8) then - snow_ls_interp(i,k)=0._r8 + if (rain_cv_interp(i,k) < 0._r8) then + rain_cv_interp(i,k) = 0._r8 end if - if (rain_cv_interp(i,k) .lt. 0._r8) then - rain_cv_interp(i,k)=0._r8 + if (snow_cv_interp(i,k) < 0._r8) then + snow_cv_interp(i,k) = 0._r8 end if - if (snow_cv_interp(i,k) .lt. 0._r8) then - snow_cv_interp(i,k)=0._r8 + end do + end do + + grpl_ls_interp = 0._r8 + + ! subroutine subsample_and_optics provides separate arguments to pass + ! the large scale and convective cloud condensate. Below the grid box + ! total cloud water mixing ratios are passed in the arrays for the + ! large scale contributions and the arrays for the convective + ! contributions are set to zero. This is consistent with the treatment + ! of cloud water by the radiation code. + mr_ccliq = 0._r8 + mr_ccice = 0._r8 + mr_lsliq = 0._r8 + mr_lsice = 0._r8 + do k = 1, nlay + kk = ktop + k -1 + do i = 1, ncol + if (cld(i,k) > 0._r8) then + mr_lsliq(i,k) = totg_liq(i,kk) + mr_lsice(i,k) = totg_ice(i,kk) end if end do end do - ! 5) assign optical depths and emissivities needed for isccp simulator - cld_swtau(1:ncol,1:pver) = cld_swtau_in(1:ncol,1:pver) - - ! initialize cosp inputs - dtau_s(1:ncol,1:pver) = 0._r8 - dtau_c(1:ncol,1:pver) = 0._r8 - dtau_s_snow(1:ncol,1:pver) = 0._r8 - dem_s(1:ncol,1:pver) = 0._r8 - dem_c(1:ncol,1:pver) = 0._r8 - dem_s_snow(1:ncol,1:pver) = 0._r8 - - ! assign values - ! NOTES: - ! 1) CAM4 assumes same radiative properties for stratiform and convective clouds, - ! (see ISCCP_CLOUD_TYPES subroutine call in cloudsimulator.F90) - ! I presume CAM5 is doing the same thing based on the ISCCP simulator calls within RRTM's radiation.F90 - ! 2) COSP wants in-cloud values. CAM5 values cld_swtau are in-cloud. - ! 3) snow_tau_in and snow_emis_in are passed without modification to COSP - dtau_s(1:ncol,1:pver) = cld_swtau(1:ncol,1:pver) ! mean 0.67 micron optical depth of stratiform (in-cloud) - dtau_c(1:ncol,1:pver) = cld_swtau(1:ncol,1:pver) ! mean 0.67 micron optical depth of convective (in-cloud) - dem_s(1:ncol,1:pver) = emis(1:ncol,1:pver) ! 10.5 micron longwave emissivity of stratiform (in-cloud) - dem_c(1:ncol,1:pver) = emis(1:ncol,1:pver) ! 10.5 micron longwave emissivity of convective (in-cloud) - dem_s_snow(1:ncol,1:pver) = snow_emis_in(1:ncol,1:pver) ! 10.5 micron grid-box mean optical depth of stratiform snow - dtau_s_snow(1:ncol,1:pver) = snow_tau_in(1:ncol,1:pver) ! 0.67 micron grid-box mean optical depth of stratiform snow + !! The specification of reff_cosp now follows e-mail discussion with Yuying in January 2011. + !! The values from the physics buffer are in microns... convert to meters for COSP. + reff_cosp(:,:,I_LSCLIQ) = rel(:ncol,ktop:pver)*1.e-6_r8 + reff_cosp(:,:,I_LSCICE) = rei(:ncol,ktop:pver)*1.e-6_r8 + reff_cosp(:,:,I_LSRAIN) = ls_reffrain(:ncol,ktop:pver)*1.e-6_r8 + reff_cosp(:,:,I_LSSNOW) = ls_reffsnow(:ncol,ktop:pver)*1.e-6_r8 + reff_cosp(:,:,I_CVCLIQ) = cv_reffliq(:ncol,ktop:pver)*1.e-6_r8 + reff_cosp(:,:,I_CVCICE) = cv_reffice(:ncol,ktop:pver)*1.e-6_r8 + reff_cosp(:,:,I_CVRAIN) = ls_reffrain(:ncol,ktop:pver)*1.e-6_r8 !! same as stratiform per Andrew + reff_cosp(:,:,I_CVSNOW) = ls_reffsnow(:ncol,ktop:pver)*1.e-6_r8 !! same as stratiform per Andrew + reff_cosp(:,:,I_LSGRPL) = 0._r8 !! using radar default reff + + ! assign optical depths and emissivities + ! CAM4 assumes same radiative properties for stratiform and convective clouds, + ! (see ISCCP_CLOUD_TYPES subroutine call in cloudsimulator.F90) + ! Assume CAM5 is doing the same thing based on the ISCCP simulator calls within RRTM's radiation.F90 + ! COSP wants in-cloud values. CAM5 values cld_swtau are in-cloud. + ! snow_tau_in and snow_emis_in are passed without modification to COSP + dtau_s = cld_swtau_in(:ncol,ktop:pver) + dtau_c = cld_swtau_in(:ncol,ktop:pver) + dtau_s_snow = snow_tau_in(:ncol,ktop:pver) + dem_s = emis(:ncol,ktop:pver) + dem_c = emis(:ncol,ktop:pver) + dem_s_snow = snow_emis_in(:ncol,ktop:pver) ! ###################################################################################### ! Compute sunlit flag. If cosp_runall=.true., then run on all points. @@ -2035,32 +1663,22 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn if (cosp_runall) then cam_sunlit(:) = 1 nSunLit = ncol - nNoSunLit = 0 else nSunLit = 0 - nNoSunLit = 0 do i=1,ncol if ((coszrs(i) > 0.0_r8) .and. (run_cosp(i,lchnk))) then cam_sunlit(i) = 1 nSunLit = nSunLit+1 - else - nNoSunLit = nNoSunlit+1 endif enddo endif call t_stopf("init_and_stuff") - ! ###################################################################################### - ! ###################################################################################### - ! END TRANSLATE CAM VARIABLES TO COSP INPUT VARIABLES - ! ###################################################################################### - ! ###################################################################################### - ! ###################################################################################### ! Construct COSP output derived type. ! ###################################################################################### call t_startf("construct_cosp_outputs") - call construct_cosp_outputs(ncol,nscol_cosp,pver,Nlvgrid,0,cospOUT) + call construct_cosp_outputs(ncol, nscol_cosp, nlay, Nlvgrid, cospOUT) call t_stopf("construct_cosp_outputs") ! ###################################################################################### @@ -2068,44 +1686,45 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ! ###################################################################################### ! Model state call t_startf("construct_cospstateIN") - call construct_cospstateIN(ncol,pver,0,cospstateIN) - cospstateIN%lat = lat_cosp(1:ncol) - cospstateIN%lon = lon_cosp(1:ncol) - cospstateIN%at = state%t(1:ncol,1:pver) - cospstateIN%qv = q(1:ncol,1:pver) - cospstateIN%o3 = o3(1:ncol,1:pver) - cospstateIN%sunlit = cam_sunlit(1:ncol) - cospstateIN%skt = cam_in%ts(1:ncol) - cospstateIN%land = landmask(1:ncol) - cospstateIN%pfull = state%pmid(1:ncol,1:pver) - cospstateIN%phalf(1:ncol,1) = 0._r8 - cospstateIN%phalf(1:ncol,2:pver+1) = pbot(1:ncol,pver:1:-1) - cospstateIN%hgt_matrix = zmid(1:ncol,1:pver) - cospstateIN%hgt_matrix_half(1:ncol,pver+1) = 0._r8 - cospstateIN%hgt_matrix_half(1:ncol,1:pver) = zbot(1:ncol,pver:1:-1) - cospstateIN%surfelev(1:ncol) = zbot(1:ncol,1) + + call construct_cospstateIN(ncol, nlay, 0, cospstateIN) + + ! convert to degrees. Lat in range [-90,..,90], Lon in range [0,..,360] + cospstateIN%lat = state%lat(:ncol)*rad2deg + cospstateIN%lon = state%lon(:ncol)*rad2deg + cospstateIN%at = state%t(:ncol,ktop:pver) + cospstateIN%qv = q(:ncol,ktop:pver) + cospstateIN%o3 = o3(:ncol,ktop:pver) + cospstateIN%sunlit = cam_sunlit(:ncol) + cospstateIN%skt = cam_in%ts(:ncol) + cospstateIN%land = landmask + cospstateIN%pfull = state%pmid(:ncol,ktop:pver) + cospstateIN%phalf = state%pint(:ncol,ktop:pverp) + cospstateIN%hgt_matrix = zmid + cospstateIN%hgt_matrix_half = zint + cospstateIN%surfelev = surf_hgt call t_stopf("construct_cospstateIN") ! Optical inputs call t_startf("construct_cospIN") - call construct_cospIN(ncol,nscol_cosp,pver,cospIN) - cospIN%emsfc_lw = emsfc_lw + call construct_cospIN(ncol, nscol_cosp, nlay, cospIN) + cospIN%emsfc_lw = emsfc_lw if (lradar_sim) cospIN%rcfg_cloudsat = rcfg_cs(lchnk) call t_stopf("construct_cospIN") - ! *NOTE* Fields passed into subsample_and_optics are ordered from TOA-2-SFC. call t_startf("subsample_and_optics") - call subsample_and_optics(ncol,pver,nscol_cosp,nhydro,overlap, & - use_precipitation_fluxes,lidar_ice_type,sd_cs(lchnk),cld(1:ncol,1:pver),& - concld(1:ncol,1:pver),rain_ls_interp(1:ncol,1:pver), & - snow_ls_interp(1:ncol,1:pver),grpl_ls_interp(1:ncol,1:pver), & - rain_cv_interp(1:ncol,1:pver),snow_cv_interp(1:ncol,1:pver), & - mr_lsliq(1:ncol,1:pver),mr_lsice(1:ncol,1:pver), & - mr_ccliq(1:ncol,1:pver),mr_ccice(1:ncol,1:pver), & - reff_cosp(1:ncol,1:pver,:),dtau_c(1:ncol,1:pver), & - dtau_s(1:ncol,1:pver),dem_c(1:ncol,1:pver), & - dem_s(1:ncol,1:pver),dtau_s_snow(1:ncol,1:pver), & - dem_s_snow(1:ncol,1:pver),state%ps(1:ncol),cospstateIN,cospIN) + ! The arrays passed here contain only active columns and the limited vertical + ! domain operated on by COSP. Unsubscripted array arguments have already been + ! allocated to the correct size. Arrays the size of a CAM chunk (pcol,pver) + ! need to pass the correct section (:ncol,ktop:pver). + call subsample_and_optics( & + ncol, nlay, nscol_cosp, nhydro, overlap, & + lidar_ice_type, sd_cs(lchnk), & + cld(:ncol,ktop:pver), concld(:ncol,ktop:pver), & + rain_ls_interp, snow_ls_interp, grpl_ls_interp, rain_cv_interp, & + snow_cv_interp, mr_lsliq, mr_lsice, mr_ccliq, mr_ccice, & + reff_cosp, dtau_c, dtau_s ,dem_c, dem_s, dtau_s_snow, & + dem_s_snow, state%ps(:ncol), cospstateIN, cospIN) call t_stopf("subsample_and_optics") ! ###################################################################################### @@ -2142,12 +1761,11 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn call outfld('ZLEV_COSP', cospstateIN%hgt_matrix, ncol,lchnk) call outfld('ZLEV_HALF_COSP', cospstateIN%hgt_matrix_half, ncol,lchnk) call outfld('T_COSP', cospstateIN%at, ncol,lchnk) - call outfld('RH_COSP', cospstateIN%qv, ncol,lchnk) - call outfld('Q_COSP', q(1:ncol,1:pver), ncol,lchnk) + call outfld('Q_COSP', cospstateIN%qv, ncol,lchnk) ! 3D outputs, but first compress to 2D do i=1,ncol - do ihml=1,nhtml_cosp + do ihml=1,nlay do isc=1,nscol_cosp ihsc = (ihml-1)*nscol_cosp+isc tau067_out(i,ihsc) = cospIN%tau_067(i,isc,ihml) @@ -2259,18 +1877,18 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ! ###################################################################################### call t_startf("output_copying") if (allocated(cospIN%frac_out)) & - frac_out(1:ncol,1:nscol_cosp,1:nhtml_cosp) = cospIN%frac_out ! frac_out (time,height_mlev,column,profile) + frac_out(1:ncol,1:nscol_cosp,1:nlay) = cospIN%frac_out ! Cloudsat if (lradar_sim) then - cfad_dbze94(1:ncol,1:CLOUDSAT_DBZE_BINS,1:nht_cosp) = cospOUT%cloudsat_cfad_ze ! cfad_dbze94 (time,height,dbze,profile) - dbze94(1:ncol,1:nscol_cosp,1:nhtml_cosp) = cospOUT%cloudsat_Ze_tot ! dbze94 (time,height_mlev,column,profile) - cldtot_cs(1:ncol) = 0._r8!cospOUT%cloudsat_radar_tcc ! CAM version of cltradar (time,profile) ! NOT COMPUTED IN COSP2 - cldtot_cs2(1:ncol) = 0._r8!cospOUT%cloudsat_radar_tcc2 ! CAM version of cltradar2 (time,profile) ! NOT COMPUTED IN COSP2 + cfad_dbze94(1:ncol,1:CLOUDSAT_DBZE_BINS,1:nht_cosp) = cospOUT%cloudsat_cfad_ze + dbze94(1:ncol,1:nscol_cosp,1:nlay) = cospOUT%cloudsat_Ze_tot + cldtot_cs(1:ncol) = 0._r8 + cldtot_cs2(1:ncol) = 0._r8 ! *NOTE* These two fields are joint-simulator products, but in CAM they are controlled ! by the radar simulator control. - cldtot_calcs(1:ncol) = cospOUT%radar_lidar_tcc ! CAM version of cltlidarradar (time,profile) - cld_cal_notcs(1:ncol,1:nht_cosp) = cospOUT%lidar_only_freq_cloud ! CAM version of clcalipso2 (time,height,profile) + cldtot_calcs(1:ncol) = cospOUT%radar_lidar_tcc + cld_cal_notcs(1:ncol,1:nht_cosp) = cospOUT%lidar_only_freq_cloud ! Cloudsat near-surface precipitation diagnostics ptcloudsatflag0(1:ncol) = cospOUT%cloudsat_precip_cover(:,1) @@ -2285,81 +1903,56 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn ptcloudsatflag9(1:ncol) = cospOUT%cloudsat_precip_cover(:,10) cloudsatpia(1:ncol) = cospOUT%cloudsat_pia - ! Output the mixing-ratio for all hydrometeor types in Cloudsat near-surface precipitation diagnostics - ! *NOTE* These fields are simply the native CAM mixing-ratios for each hydrometeor type used in the - ! CAM6 microphysics scheme, interpolated to the same vertical grid used by the Cloudsat - ! simulator. These fields are not part of the radar simulator standard output, as these fields - ! are entirely dependent on the host models microphysics, not the retrieval. - - endif ! CALIPSO if (llidar_sim) then - cldlow_cal(1:ncol) = cospOUT%calipso_cldlayer(:,1) ! CAM version of cllcalipso (time,profile) - cldmed_cal(1:ncol) = cospOUT%calipso_cldlayer(:,2) ! CAM version of clmcalipso (time,profile) - cldhgh_cal(1:ncol) = cospOUT%calipso_cldlayer(:,3) ! CAM version of clhcalipso (time,profile) - cldtot_cal(1:ncol) = cospOUT%calipso_cldlayer(:,4) ! CAM version of cltcalipso (time,profile) - cldlow_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,1) ! CAM version of cllcalipsoice !+cosp1.4 - cldmed_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,1) ! CAM version of clmcalipsoice - cldhgh_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,1) ! CAM version of clhcalipsoice - cldtot_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,1) ! CAM version of cltcalipsoice - cldlow_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,2) ! CAM version of cllcalipsoliq - cldmed_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,2) ! CAM version of clmcalipsoliq - cldhgh_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,2) ! CAM version of clhcalipsoliq - cldtot_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,2) ! CAM version of cltcalipsoliq - cldlow_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,3) ! CAM version of cllcalipsoun - cldmed_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,3) ! CAM version of clmcalipsoun - cldhgh_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,3) ! CAM version of clhcalipsoun - cldtot_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,3) ! CAM version of cltcalipsoun, !+cosp1.4 - cld_cal_ice(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,1) ! CAM version of clcalipsoice !+cosp1.4 - cld_cal_liq(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,2) ! CAM version of clcalipsoliq - cld_cal_un(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,3) ! CAM version of clcalipsoun - cld_cal_tmp(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,1) ! CAM version of clcalipsotmp - cld_cal_tmpliq(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,2) ! CAM version of clcalipsotmpice - cld_cal_tmpice(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,3) ! CAM version of clcalipsotmpliq - cld_cal_tmpun(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,4) ! CAM version of clcalipsotmpun, !+cosp1.4 - cld_cal(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcld(:,1:nht_cosp) ! CAM version of clcalipso (time,height,profile) - mol532_cal(1:ncol,1:nhtml_cosp) = cospOUT%calipso_beta_mol ! CAM version of beta_mol532 (time,height_mlev,profile) - atb532(1:ncol,1:nscol_cosp,1:nhtml_cosp) = cospOUT%calipso_beta_tot ! atb532 (time,height_mlev,column,profile) - cfad_lidarsr532(1:ncol,1:nsr_cosp,1:nht_cosp) = cospOUT%calipso_cfad_sr(:,:,:) ! cfad_lidarsr532 (time,height,scat_ratio,profile) - ! PARASOL. In COSP2, the Parasol simulator is independent of the calipso simulator. - refl_parasol(1:ncol,1:nsza_cosp) = cospOUT%parasolGrid_refl ! CAM version of parasolrefl (time,sza,profile) - ! CALIPSO Opaque cloud diagnostics -! cldopaq_cal(1:pcols) = cospOUT%calipso_cldtype(:,1) -! cldthin_cal(1:pcols) = cospOUT%calipso_cldtype(:,2) -! cldopaqz_cal(1:pcols) = cospOUT%calipso_cldtype(:,3) -! cldopaq_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,1) -! cldthin_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,2) -! cldzopaq_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,3) -! cldopaq_cal_z(1:pcols) = cospOUT%calipso_cldtypemeanz(:,1) -! cldthin_cal_z(1:pcols) = cospOUT%calipso_cldtypemeanz(:,2) -! cldthin_cal_emis(1:pcols) = cospOUT%calipso_cldthinemis -! cldopaq_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,1) -! cldthin_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,2) -! cldzopaq_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,3) -! cldopaq_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,1) -! cldthin_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,2) -! cldzopaq_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,3) -! opacity_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,4) + cldlow_cal(1:ncol) = cospOUT%calipso_cldlayer(:,1) + cldmed_cal(1:ncol) = cospOUT%calipso_cldlayer(:,2) + cldhgh_cal(1:ncol) = cospOUT%calipso_cldlayer(:,3) + cldtot_cal(1:ncol) = cospOUT%calipso_cldlayer(:,4) + cldlow_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,1) + cldmed_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,1) + cldhgh_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,1) + cldtot_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,1) + cldlow_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,2) + cldmed_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,2) + cldhgh_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,2) + cldtot_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,2) + cldlow_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,3) + cldmed_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,3) + cldhgh_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,3) + cldtot_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,3) + cld_cal_ice(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,1) + cld_cal_liq(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,2) + cld_cal_un(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,3) + cld_cal_tmp(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,1) + cld_cal_tmpliq(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,2) + cld_cal_tmpice(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,3) + cld_cal_tmpun(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,4) + cld_cal(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcld(:,1:nht_cosp) + mol532_cal(1:ncol,1:nlay) = cospOUT%calipso_beta_mol + atb532(1:ncol,1:nscol_cosp,1:nlay)= cospOUT%calipso_beta_tot + cfad_lidarsr532(1:ncol,1:nsr_cosp,1:nht_cosp) = cospOUT%calipso_cfad_sr(:,:,:) + refl_parasol(1:ncol,1:nsza_cosp) = cospOUT%parasolGrid_refl endif ! ISCCP if (lisccp_sim) then - clisccp2(1:ncol,1:ntau_cosp,1:nprs_cosp) = cospOUT%isccp_fq ! CAM version of clisccp2 (time,tau,plev,profile) - tau_isccp(1:ncol,1:nscol_cosp) = cospOUT%isccp_boxtau ! CAM version of boxtauisccp (time,column,profile) - cldptop_isccp(1:ncol,1:nscol_cosp) = cospOUT%isccp_boxptop ! CAM version of boxptopisccp (time,column,profile) - cldtot_isccp(1:ncol) = cospOUT%isccp_totalcldarea ! CAM version of tclisccp (time, profile) - meanptop_isccp(1:ncol) = cospOUT%isccp_meanptop ! CAM version of ctpisccp (time, profile) - meantau_isccp(1:ncol) = cospOUT%isccp_meantaucld ! CAM version of meantbisccp (time, profile) - meancldalb_isccp(1:ncol) = cospOUT%isccp_meanalbedocld ! CAM version of albisccp (time, profile) - meantb_isccp(1:ncol) = cospOUT%isccp_meantb ! CAM version of meantbisccp (time, profile) - meantbclr_isccp(1:ncol) = cospOUT%isccp_meantbclr ! CAM version of meantbclrisccp (time, profile) + clisccp2(1:ncol,1:ntau_cosp,1:nprs_cosp) = cospOUT%isccp_fq + tau_isccp(1:ncol,1:nscol_cosp) = cospOUT%isccp_boxtau + cldptop_isccp(1:ncol,1:nscol_cosp) = cospOUT%isccp_boxptop + cldtot_isccp(1:ncol) = cospOUT%isccp_totalcldarea + meanptop_isccp(1:ncol) = cospOUT%isccp_meanptop + meantau_isccp(1:ncol) = cospOUT%isccp_meantaucld + meancldalb_isccp(1:ncol) = cospOUT%isccp_meanalbedocld + meantb_isccp(1:ncol) = cospOUT%isccp_meantb + meantbclr_isccp(1:ncol) = cospOUT%isccp_meantbclr endif ! MISR if (lmisr_sim) then - clMISR(1:ncol,1:ntau_cosp,1:nhtmisr_cosp) = cospOUT%misr_fq ! CAM version of clMISR (time,tau,CTH_height_bin,profile) + clMISR(1:ncol,1:ntau_cosp,1:nhtmisr_cosp) = cospOUT%misr_fq endif ! MODIS @@ -2386,46 +1979,39 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn clrlmodis(1:ncol,1:ntau_cosp_modis,1:numMODISReffLiqBins) = cospOUT%modis_Optical_Thickness_vs_ReffLIQ endif - ! Use high-dimensional output to populate CAM collapsed output variables - ! see above for mixed dimension definitions - ! i am using the convention of starting vertical coordinates at the surface, up to down, COSP convention, not CAM. + ! Use COSP output to populate CAM collapsed output variables do i=1,ncol if (lradar_sim) then - ! CAM cfad_dbze94 (time,height,dbze,profile) do ih=1,nht_cosp do id=1,CLOUDSAT_DBZE_BINS ihd=(ih-1)*CLOUDSAT_DBZE_BINS+id - cfad_dbze94_cs(i,ihd) = cfad_dbze94(i,id,ih) ! cfad_dbze94_cs(pcols,nht_cosp*CLOUDSAT_DBZE_BINS) + cfad_dbze94_cs(i,ihd) = cfad_dbze94(i,id,ih) end do end do - ! CAM dbze94 (time,height_mlev,column,profile) - do ihml=1,nhtml_cosp + do ihml=1,nlay do isc=1,nscol_cosp ihsc=(ihml-1)*nscol_cosp+isc - dbze_cs(i,ihsc) = dbze94(i,isc,ihml) ! dbze_cs(pcols,pver*nscol_cosp) + dbze_cs(i,ihsc) = dbze94(i,isc,ihml) end do end do endif if (llidar_sim) then - ! CAM cfad_lidarsr532 (time,height,scat_ratio,profile) do ih=1,nht_cosp do is=1,nsr_cosp ihs=(ih-1)*nsr_cosp+is - cfad_sr532_cal(i,ihs) = cfad_lidarsr532(i,is,ih) ! cfad_sr532_cal(pcols,nht_cosp*nsr_cosp) + cfad_sr532_cal(i,ihs) = cfad_lidarsr532(i,is,ih) end do end do - ! CAM atb532 (time,height_mlev,column,profile) FIX - do ihml=1,nhtml_cosp + do ihml=1,nlay do isc=1,nscol_cosp ihsc=(ihml-1)*nscol_cosp+isc - atb532_cal(i,ihsc) = atb532(i,isc,ihml) ! atb532_cal(pcols,nht_cosp*nscol_cosp) + atb532_cal(i,ihsc) = atb532(i,isc,ihml) end do end do endif if (lmisr_sim) then - ! CAM clMISR (time,tau,CTH_height_bin,profile) do ihm=1,nhtmisr_cosp do it=1,ntau_cosp ihmt=(ihm-1)*ntau_cosp+it @@ -2435,21 +2021,18 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn endif if (lmodis_sim) then - ! CAM clmodis do ip=1,nprs_cosp do it=1,ntau_cosp_modis ipt=(ip-1)*ntau_cosp_modis+it clmodis_cam(i,ipt) = clmodis(i,it,ip) end do end do - ! CAM clrimodis do ip=1,numMODISReffIceBins do it=1,ntau_cosp_modis ipt=(ip-1)*ntau_cosp_modis+it clrimodis_cam(i,ipt) = clrimodis(i,it,ip) end do end do - ! CAM clrlmodis do ip=1,numMODISReffLiqBins do it=1,ntau_cosp_modis ipt=(ip-1)*ntau_cosp_modis+it @@ -2459,10 +2042,10 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn endif ! Subcolums - do ihml=1,nhtml_cosp + do ihml=1,nlay do isc=1,nscol_cosp ihsc=(ihml-1)*nscol_cosp+isc - scops_out(i,ihsc) = frac_out(i,isc,ihml) ! scops_out(pcols,nht_cosp*nscol_cosp) + scops_out(i,ihsc) = frac_out(i,isc,ihml) end do end do end do @@ -2592,40 +2175,6 @@ subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,sn end where call outfld('CLD_CAL_TMPUN',cld_cal_tmpun ,pcols,lchnk) !! !+cosp1.4 - ! Opaque cloud diagnostics -! call outfld('CLDOPQ_CAL', cldopaq_cal, pcols, lchnk) -! call outfld('CLDTHN_CAL', cldthin_cal, pcols, lchnk) -! call outfld('CLDZOPQ_CAL', cldopaqz_cal, pcols, lchnk) -! call outfld('CLDOPQ_CAL_TMP', cldopaq_cal_temp, pcols, lchnk) -! call outfld('CLDTHN_CAL_TMP', cldthin_cal_temp, pcols, lchnk) -! call outfld('CLDZOPQ_CAL_TMP', cldzopaq_cal_temp, pcols, lchnk) -! call outfld('CLDOPQ_CAL_Z', cldopaq_cal_z, pcols, lchnk) -! call outfld('CLDTHN_CAL_Z', cldthin_cal_z, pcols, lchnk) -! call outfld('CLDTHN_CAL_EMIS', cldthin_cal_emis, pcols, lchnk) -! call outfld('CLDOPQ_CAL_SE', cldopaq_cal_se, pcols, lchnk) -! call outfld('CLDTHN_CAL_SE', cldthin_cal_se, pcols, lchnk) -! call outfld('CLDZOPQ_CAL_SE', cldzopaq_cal_se, pcols, lchnk) -! ! -! where (cldopaq_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) -! cldopaq_cal_2d(:ncol,:nht_cosp) = 0.0_r8 -! end where -! call outfld('CLDOPQ_CAL_2D', cldopaq_cal_2d, pcols, lchnk) -! ! -! where (cldthin_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) -! cldthin_cal_2d(:ncol,:nht_cosp) = 0.0_r8 -! end where -! call outfld('CLDTHN_CAL_2D', cldthin_cal_2d, pcols, lchnk) -! ! -! where (cldzopaq_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) -! cldzopaq_cal_2d(:ncol,:nht_cosp) = 0.0_r8 -! end where -! call outfld('CLDZOPQ_CAL_2D', cldzopaq_cal_2d, pcols, lchnk) -! ! -! where (opacity_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF) -! opacity_cal_2d(:ncol,:nht_cosp) = 0.0_r8 -! end where -! call outfld('OPACITY_CAL_2D', opacity_cal_2d, pcols, lchnk) - end if ! RADAR SIMULATOR OUTPUTS @@ -2785,7 +2334,7 @@ end subroutine cospsimulator_intr_run ! SUBROUTINE subsample_and_optics ! ###################################################################################### subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, & - use_precipitation_fluxes, lidar_ice_type, sd, tca, cca,& + lidar_ice_type, sd, tca, cca, & fl_lsrainIN, fl_lssnowIN, fl_lsgrplIN, fl_ccrainIN, & fl_ccsnowIN, mr_lsliq, mr_lsice, mr_ccliq, mr_ccice, & reffIN, dtau_c, dtau_s, dem_c, dem_s, dtau_s_snow, & @@ -2803,8 +2352,6 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, use mod_cosp_config, only: Nlvgrid, vgrid_zl, vgrid_zu use mod_cosp_stats, only: cosp_change_vertical_grid ! Inputs - logical,intent(in) :: & - use_precipitation_fluxes integer,intent(in) :: & nPoints, & ! Number of gridpoints nLevels, & ! Number of vertical levels @@ -2843,7 +2390,7 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, type(cosp_column_inputs),intent(inout) :: cospstateIN ! Local variables - integer :: i,j,k + integer :: i, j, k, istat real(wp),dimension(nPoints,nLevels) :: column_frac_out,column_prec_out, & fl_lsrain,fl_lssnow,fl_lsgrpl,fl_ccrain, & fl_ccsnow @@ -2861,6 +2408,9 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, MODIS_opticalThicknessIce, & fracPrecipIce, fracPrecipIce_statGrid real(wp),dimension(:,:,:,:),allocatable :: mr_hydro,Reff,Np + + character(len=*), parameter :: sub = 'subsample_and_optics' + !-------------------------------------------------------------------------------------- call t_startf("scops") if (Ncolumns .gt. 1) then @@ -2868,7 +2418,8 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, ! Generate subcolumns for clouds (SCOPS) and precipitation type (PREC_SCOPS) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! RNG used for subcolumn generation - allocate(rngs(nPoints),seed(nPoints)) + allocate(rngs(nPoints), seed(nPoints), stat=istat) + call handle_allocate_error(istat, sub, 'rngs, seed') seed = int(sfcP) if (Npoints .gt. 1) seed=(sfcP-int(sfcP))*1000000 call init_rng(rngs, seed) @@ -2877,28 +2428,24 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, call scops(NPoints,Nlevels,Ncolumns,rngs,tca,cca,overlap,cospIN%frac_out,0) deallocate(seed,rngs) - ! Sum up precipitation rates. If not using preciitation fluxes, mixing ratios are - ! stored in _rate variables. - allocate(ls_p_rate(nPoints,nLevels),cv_p_rate(nPoints,Nlevels)) - if(use_precipitation_fluxes) then - ls_p_rate(:,1:nLevels) = fl_lsrainIN + fl_lssnowIN + fl_lsgrplIN - cv_p_rate(:,1:nLevels) = fl_ccrainIN + fl_ccsnowIN - else - ls_p_rate(:,1:nLevels) = 0 ! mixing_ratio(rain) + mixing_ratio(snow) + mixing_ratio (groupel) - cv_p_rate(:,1:nLevels) = 0 ! mixing_ratio(rain) + mixing_ratio(snow) - endif + ! Sum up precipitation rates. + allocate(ls_p_rate(nPoints,nLevels), cv_p_rate(nPoints,Nlevels), stat=istat) + call handle_allocate_error(istat, sub, 'ls_p_rate, cv_p_rate') + ls_p_rate(:,1:nLevels) = fl_lsrainIN + fl_lssnowIN + fl_lsgrplIN + cv_p_rate(:,1:nLevels) = fl_ccrainIN + fl_ccsnowIN ! Call PREC_SCOPS - allocate(frac_prec(nPoints,nColumns,nLevels)) + allocate(frac_prec(nPoints,nColumns,nLevels), stat=istat) + call handle_allocate_error(istat, sub, 'frac_prec') call prec_scops(nPoints,nLevels,nColumns,ls_p_rate,cv_p_rate,cospIN%frac_out,frac_prec) deallocate(ls_p_rate,cv_p_rate) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Compute precipitation fraction in each gridbox !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ! Allocate - allocate(frac_ls(nPoints,nLevels),prec_ls(nPoints,nLevels), & - frac_cv(nPoints,nLevels),prec_cv(nPoints,nLevels)) + allocate(frac_ls(nPoints,nLevels),prec_ls(nPoints,nLevels), & + frac_cv(nPoints,nLevels),prec_cv(nPoints,nLevels), stat=istat) + call handle_allocate_error(istat, sub, 'frac_ls,..,prec_cv') ! Initialize frac_ls(1:nPoints,1:nLevels) = 0._wp @@ -2936,9 +2483,10 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, ! Compute mixing ratios, effective radii and precipitation fluxes for clouds ! and precipitation !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - allocate(mr_hydro(nPoints,nColumns,nLevels,nHydro), & - Reff(nPoints,nColumns,nLevels,nHydro), & - Np(nPoints,nColumns,nLevels,nHydro)) + allocate(mr_hydro(nPoints,nColumns,nLevels,nHydro), & + Reff(nPoints,nColumns,nLevels,nHydro), & + Np(nPoints,nColumns,nLevels,nHydro), stat=istat) + call handle_allocate_error(istat, sub, 'mr_hydro,Reff,Np') ! Initialize mr_hydro(:,:,:,:) = 0._wp @@ -2995,26 +2543,14 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, endif ! Precipitation - if (use_precipitation_fluxes) then - if (prec_ls(j,k) .ne. 0._r8) then - fl_lsrain(j,k) = fl_lsrainIN(j,k)/prec_ls(j,k) - fl_lssnow(j,k) = fl_lssnowIN(j,k)/prec_ls(j,k) - fl_lsgrpl(j,k) = fl_lsgrplIN(j,k)/prec_ls(j,k) - endif - if (prec_cv(j,k) .ne. 0._r8) then - fl_ccrain(j,k) = fl_ccrainIN(j,k)/prec_cv(j,k) - fl_ccsnow(j,k) = fl_ccsnowIN(j,k)/prec_cv(j,k) - endif - else - if (prec_ls(j,k) .ne. 0._r8) then - mr_hydro(j,:,k,I_LSRAIN) = mr_hydro(j,:,k,I_LSRAIN)/prec_ls(j,k) - mr_hydro(j,:,k,I_LSSNOW) = mr_hydro(j,:,k,I_LSSNOW)/prec_ls(j,k) - mr_hydro(j,:,k,I_LSGRPL) = mr_hydro(j,:,k,I_LSGRPL)/prec_ls(j,k) - endif - if (prec_cv(j,k) .ne. 0._r8) then - mr_hydro(j,:,k,I_CVRAIN) = mr_hydro(j,:,k,I_CVRAIN)/prec_cv(j,k) - mr_hydro(j,:,k,I_CVSNOW) = mr_hydro(j,:,k,I_CVSNOW)/prec_cv(j,k) - endif + if (prec_ls(j,k) .ne. 0._r8) then + fl_lsrain(j,k) = fl_lsrainIN(j,k)/prec_ls(j,k) + fl_lssnow(j,k) = fl_lssnowIN(j,k)/prec_ls(j,k) + fl_lsgrpl(j,k) = fl_lsgrplIN(j,k)/prec_ls(j,k) + endif + if (prec_cv(j,k) .ne. 0._r8) then + fl_ccrain(j,k) = fl_ccrainIN(j,k)/prec_cv(j,k) + fl_ccsnow(j,k) = fl_ccsnowIN(j,k)/prec_cv(j,k) endif enddo enddo @@ -3022,48 +2558,48 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Convert precipitation fluxes to mixing ratios !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if (use_precipitation_fluxes) then - ! LS rain - call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & - cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSRAIN), n_bx(I_LSRAIN), & - alpha_x(I_LSRAIN), c_x(I_LSRAIN), d_x(I_LSRAIN), g_x(I_LSRAIN), & - a_x(I_LSRAIN), b_x(I_LSRAIN), gamma_1(I_LSRAIN), gamma_2(I_LSRAIN), & - gamma_3(I_LSRAIN), gamma_4(I_LSRAIN), fl_lsrain, & - mr_hydro(:,:,:,I_LSRAIN), Reff(:,:,:,I_LSRAIN)) - ! LS snow - call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & - cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSSNOW), n_bx(I_LSSNOW), & - alpha_x(I_LSSNOW), c_x(I_LSSNOW), d_x(I_LSSNOW), g_x(I_LSSNOW), & - a_x(I_LSSNOW), b_x(I_LSSNOW), gamma_1(I_LSSNOW), gamma_2(I_LSSNOW), & - gamma_3(I_LSSNOW), gamma_4(I_LSSNOW), fl_lssnow, & - mr_hydro(:,:,:,I_LSSNOW), Reff(:,:,:,I_LSSNOW)) - ! CV rain - call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & - cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVRAIN), n_bx(I_CVRAIN), & - alpha_x(I_CVRAIN), c_x(I_CVRAIN), d_x(I_CVRAIN), g_x(I_CVRAIN), & - a_x(I_CVRAIN), b_x(I_CVRAIN), gamma_1(I_CVRAIN), gamma_2(I_CVRAIN), & - gamma_3(I_CVRAIN), gamma_4(I_CVRAIN), fl_ccrain, & - mr_hydro(:,:,:,I_CVRAIN), Reff(:,:,:,I_CVRAIN)) - ! CV snow - call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & - cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVSNOW), n_bx(I_CVSNOW), & - alpha_x(I_CVSNOW), c_x(I_CVSNOW), d_x(I_CVSNOW), g_x(I_CVSNOW), & - a_x(I_CVSNOW), b_x(I_CVSNOW), gamma_1(I_CVSNOW), gamma_2(I_CVSNOW), & - gamma_3(I_CVSNOW), gamma_4(I_CVSNOW), fl_ccsnow, & - mr_hydro(:,:,:,I_CVSNOW), Reff(:,:,:,I_CVSNOW)) - ! LS groupel. - call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & - cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSGRPL), n_bx(I_LSGRPL), & - alpha_x(I_LSGRPL), c_x(I_LSGRPL), d_x(I_LSGRPL), g_x(I_LSGRPL), & - a_x(I_LSGRPL), b_x(I_LSGRPL), gamma_1(I_LSGRPL), gamma_2(I_LSGRPL), & - gamma_3(I_LSGRPL), gamma_4(I_LSGRPL), fl_lsgrpl, & - mr_hydro(:,:,:,I_LSGRPL), Reff(:,:,:,I_LSGRPL)) - endif + + ! LS rain + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSRAIN), n_bx(I_LSRAIN), & + alpha_x(I_LSRAIN), c_x(I_LSRAIN), d_x(I_LSRAIN), g_x(I_LSRAIN), & + a_x(I_LSRAIN), b_x(I_LSRAIN), gamma_1(I_LSRAIN), gamma_2(I_LSRAIN), & + gamma_3(I_LSRAIN), gamma_4(I_LSRAIN), fl_lsrain, & + mr_hydro(:,:,:,I_LSRAIN), Reff(:,:,:,I_LSRAIN)) + ! LS snow + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSSNOW), n_bx(I_LSSNOW), & + alpha_x(I_LSSNOW), c_x(I_LSSNOW), d_x(I_LSSNOW), g_x(I_LSSNOW), & + a_x(I_LSSNOW), b_x(I_LSSNOW), gamma_1(I_LSSNOW), gamma_2(I_LSSNOW), & + gamma_3(I_LSSNOW), gamma_4(I_LSSNOW), fl_lssnow, & + mr_hydro(:,:,:,I_LSSNOW), Reff(:,:,:,I_LSSNOW)) + ! CV rain + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVRAIN), n_bx(I_CVRAIN), & + alpha_x(I_CVRAIN), c_x(I_CVRAIN), d_x(I_CVRAIN), g_x(I_CVRAIN), & + a_x(I_CVRAIN), b_x(I_CVRAIN), gamma_1(I_CVRAIN), gamma_2(I_CVRAIN), & + gamma_3(I_CVRAIN), gamma_4(I_CVRAIN), fl_ccrain, & + mr_hydro(:,:,:,I_CVRAIN), Reff(:,:,:,I_CVRAIN)) + ! CV snow + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVSNOW), n_bx(I_CVSNOW), & + alpha_x(I_CVSNOW), c_x(I_CVSNOW), d_x(I_CVSNOW), g_x(I_CVSNOW), & + a_x(I_CVSNOW), b_x(I_CVSNOW), gamma_1(I_CVSNOW), gamma_2(I_CVSNOW), & + gamma_3(I_CVSNOW), gamma_4(I_CVSNOW), fl_ccsnow, & + mr_hydro(:,:,:,I_CVSNOW), Reff(:,:,:,I_CVSNOW)) + ! LS groupel. + call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & + cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSGRPL), n_bx(I_LSGRPL), & + alpha_x(I_LSGRPL), c_x(I_LSGRPL), d_x(I_LSGRPL), g_x(I_LSGRPL), & + a_x(I_LSGRPL), b_x(I_LSGRPL), gamma_1(I_LSGRPL), gamma_2(I_LSGRPL), & + gamma_3(I_LSGRPL), gamma_4(I_LSGRPL), fl_lsgrpl, & + mr_hydro(:,:,:,I_LSGRPL), Reff(:,:,:,I_LSGRPL)) else cospIN%frac_out(:,:,:) = 1 allocate(mr_hydro(nPoints, 1,nLevels,nHydro),Reff(nPoints,1,nLevels,nHydro), & - Np(nPoints,1,nLevels,nHydro)) + Np(nPoints,1,nLevels,nHydro), stat=istat) + call handle_allocate_error(istat, sub, 'mr_hydro,Reff,Np') mr_hydro(:,1,:,I_LSCLIQ) = mr_lsliq mr_hydro(:,1,:,I_LSCICE) = mr_lsice mr_hydro(:,1,:,I_CVCLIQ) = mr_ccliq @@ -3078,7 +2614,8 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, call t_startf("cloudsat_optics") if (lradar_sim) then ! Compute gaseous absorption (assume identical for each subcolun) - allocate(g_vol(nPoints,nLevels)) + allocate(g_vol(nPoints,nLevels), stat=istat) + call handle_allocate_error(istat, sub, 'g_vol') g_vol(:,:)=0._wp do i = 1, nPoints do j = 1, nLevels @@ -3092,7 +2629,8 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, end do ! Loop over all subcolumns - allocate(fracPrecipIce(nPoints,nColumns,nLevels)) + allocate(fracPrecipIce(nPoints,nColumns,nLevels), stat=istat) + call handle_allocate_error(istat, sub, 'fracPrecipIce') fracPrecipIce(:,:,:) = 0._wp do k=1,nColumns call quickbeam_optics(sd, cospIN%rcfg_cloudsat, nPoints, nLevels, R_UNDEF, & @@ -3115,7 +2653,8 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, enddo ! Regrid frozen fraction to Cloudsat/Calipso statistical grid - allocate(fracPrecipIce_statGrid(nPoints,nColumns,Nlvgrid)) + allocate(fracPrecipIce_statGrid(nPoints,nColumns,Nlvgrid), stat=istat) + call handle_allocate_error(istat, sub, 'fracPrecipIce_statGrid') fracPrecipIce_statGrid(:,:,:) = 0._wp call cosp_change_vertical_grid(Npoints, Ncolumns, Nlevels, cospstateIN%hgt_matrix(:,Nlevels:1:-1), & cospstateIN%hgt_matrix_half(:,Nlevels:1:-1), fracPrecipIce(:,:,Nlevels:1:-1), Nlvgrid, & @@ -3124,13 +2663,6 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, ! For near-surface diagnostics, we only need the frozen fraction at one layer. cospIN%fracPrecipIce(:,:) = fracPrecipIce_statGrid(:,:,cloudsat_preclvl) - ! Regrid preipitation mixing-ratios to statistical grid. - !allocate(tempStatGrid(nPoints,ncol,Nlvgrid)) - !tempStatGrid(:,:,:,:) = 0._wp - !call cosp_change_vertical_grid(Npoints, ncol, pver, cospstateIN%hgt_matrix(:,pver:1:-1), & - ! cospstateIN%hgt_matrix_half(:,pver:1:-1), mr_hydro(:,:,:,LSGRPL), & - ! Nlvgrid,vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), tempStatGrid) - ! endif call t_stopf("cloudsat_optics") @@ -3219,7 +2751,8 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, MODIS_snowSize(nPoints,nColumns,nLevels), & MODIS_opticalThicknessLiq(nPoints,nColumns,nLevels), & MODIS_opticalThicknessIce(nPoints,nColumns,nLevels), & - MODIS_opticalThicknessSnow(nPoints,nColumns,nLevels)) + MODIS_opticalThicknessSnow(nPoints,nColumns,nLevels), stat=istat) + call handle_allocate_error(istat, sub, 'MODIS_*') ! Cloud water call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, & @@ -3253,7 +2786,7 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, MODIS_snowSize, cospIN%tau_067, MODIS_opticalThicknessLiq, & MODIS_opticalThicknessIce, MODIS_opticalThicknessSnow) - ! Compute assymetry parameter and single scattering albedo + ! Compute asymmetry parameter and single scattering albedo call modis_optics(nPoints, nLevels, nColumns, MODIS_opticalThicknessLiq, & MODIS_waterSize*1.0e6_wp, MODIS_opticalThicknessIce, & MODIS_iceSize*1.0e6_wp, MODIS_opticalThicknessSnow, & @@ -3275,6 +2808,11 @@ subroutine construct_cospIN(npoints,ncolumns,nlevels,y) nlevels ! Number of vertical levels ! Outputs type(cosp_optical_inputs),intent(out) :: y + + ! local + integer :: istat + character(len=*), parameter :: sub = 'construct_cospIN' + !-------------------------------------------------------------------------------------- ! Dimensions y%Npoints = Npoints @@ -3302,7 +2840,9 @@ subroutine construct_cospIN(npoints,ncolumns,nlevels,y) y%tau_mol_calipso( npoints, nlevels),& y%tautot_S_ice( npoints, ncolumns ),& y%tautot_S_liq( npoints, ncolumns) ,& - y%fracPrecipIce(npoints, ncolumns)) + y%fracPrecipIce(npoints, ncolumns), stat=istat) + call handle_allocate_error(istat, sub, 'tau_067,..,fracPrecipIce') + end subroutine construct_cospIN !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -3315,15 +2855,37 @@ subroutine construct_cospstateIN(npoints,nlevels,nchan,y) nlevels, & ! Number of vertical levels nchan ! Number of channels ! Outputs - type(cosp_column_inputs),intent(out) :: y - - allocate(y%sunlit(npoints),y%skt(npoints),y%land(npoints),y%at(npoints,nlevels), & - y%pfull(npoints,nlevels),y%phalf(npoints,nlevels+1),y%qv(npoints,nlevels), & - y%o3(npoints,nlevels),y%hgt_matrix(npoints,nlevels),y%u_sfc(npoints), & - y%v_sfc(npoints),y%lat(npoints),y%lon(nPoints),y%emis_sfc(nchan), & - y%cloudIce(nPoints,nLevels),y%cloudLiq(nPoints,nLevels),y%surfelev(nPoints),& - y%fl_snow(nPoints,nLevels),y%fl_rain(nPoints,nLevels),y%seaice(npoints), & - y%tca(nPoints,nLevels),y%hgt_matrix_half(npoints,nlevels+1)) + type(cosp_column_inputs),intent(out) :: y + + ! local + integer :: istat + character(len=*), parameter :: sub = 'construct_cospstateIN' + !-------------------------------------------------------------------------------------- + + allocate( & + y%sunlit(npoints), & + y%at(npoints,nlevels), & + y%pfull(npoints,nlevels), & + y%phalf(npoints,nlevels+1), & + y%qv(npoints,nlevels), & + y%hgt_matrix(npoints,nlevels), & + y%hgt_matrix_half(npoints,nlevels+1), & + y%land(npoints), & + y%skt(npoints), & + y%surfelev(nPoints), & + y%emis_sfc(nchan), & + y%u_sfc(npoints), & + y%v_sfc(npoints), & + y%seaice(npoints), & + y%lat(npoints), & + y%lon(nPoints), & + y%o3(npoints,nlevels), & + y%tca(nPoints,nLevels), & + y%cloudIce(nPoints,nLevels), & + y%cloudLiq(nPoints,nLevels), & + y%fl_rain(nPoints,nLevels), & + y%fl_snow(nPoints,nLevels), stat=istat) + call handle_allocate_error(istat, sub, 'sunlit,..,fl_snow') end subroutine construct_cospstateIN ! ###################################################################################### @@ -3331,106 +2893,114 @@ end subroutine construct_cospstateIN ! ! This subroutine allocates output fields based on input logical flag switches. ! ###################################################################################### - subroutine construct_cosp_outputs(Npoints,Ncolumns,Nlevels,Nlvgrid,Nchan,x) + subroutine construct_cosp_outputs(Npoints,Ncolumns,Nlevels,Nlvgrid,x) ! Inputs integer,intent(in) :: & Npoints, & ! Number of sampled points Ncolumns, & ! Number of subgrid columns Nlevels, & ! Number of model levels - Nlvgrid, & ! Number of levels in L3 stats computation - Nchan ! Number of RTTOV channels + Nlvgrid ! Number of levels in L3 stats computation ! Outputs type(cosp_outputs),intent(out) :: & x ! COSP output structure + + ! local + integer :: istat + character(len=*), parameter :: sub = 'construct_cosp_outputs' + !-------------------------------------------------------------------------------------- ! ISCCP simulator outputs if (lisccp_sim) then - allocate(x%isccp_boxtau(Npoints,Ncolumns)) - allocate(x%isccp_boxptop(Npoints,Ncolumns)) - allocate(x%isccp_fq(Npoints,numISCCPTauBins,numISCCPPresBins)) - allocate(x%isccp_totalcldarea(Npoints)) - allocate(x%isccp_meanptop(Npoints)) - allocate(x%isccp_meantaucld(Npoints)) - allocate(x%isccp_meantb(Npoints)) - allocate(x%isccp_meantbclr(Npoints)) - allocate(x%isccp_meanalbedocld(Npoints)) + allocate( & + x%isccp_boxtau(Npoints,Ncolumns), & + x%isccp_boxptop(Npoints,Ncolumns), & + x%isccp_fq(Npoints,numISCCPTauBins,numISCCPPresBins), & + x%isccp_totalcldarea(Npoints), & + x%isccp_meanptop(Npoints), & + x%isccp_meantaucld(Npoints), & + x%isccp_meantb(Npoints), & + x%isccp_meantbclr(Npoints), & + x%isccp_meanalbedocld(Npoints), stat=istat) + call handle_allocate_error(istat, sub, 'isccp_*') endif ! MISR simulator if (lmisr_sim) then - allocate(x%misr_fq(Npoints,numMISRTauBins,numMISRHgtBins)) - ! *NOTE* These 3 fields are not output, but were part of the v1.4.0 cosp_misr, so - ! they are still computed. Should probably have a logical to control these - ! outputs. - allocate(x%misr_dist_model_layertops(Npoints,numMISRHgtBins)) - allocate(x%misr_meanztop(Npoints)) - allocate(x%misr_cldarea(Npoints)) + allocate( & + x%misr_fq(Npoints,numMISRTauBins,numMISRHgtBins), & + ! *NOTE* These 3 fields are not output, but were part of the v1.4.0 cosp_misr, so + ! they are still computed. Should probably have a logical to control these + ! outputs. + x%misr_dist_model_layertops(Npoints,numMISRHgtBins), & + x%misr_meanztop(Npoints), & + x%misr_cldarea(Npoints), stat=istat) + call handle_allocate_error(istat, sub, 'misr_*') endif ! MODIS simulator if (lmodis_sim) then - allocate(x%modis_Cloud_Fraction_Total_Mean(Npoints)) - allocate(x%modis_Cloud_Fraction_Water_Mean(Npoints)) - allocate(x%modis_Cloud_Fraction_Ice_Mean(Npoints)) - allocate(x%modis_Cloud_Fraction_High_Mean(Npoints)) - allocate(x%modis_Cloud_Fraction_Mid_Mean(Npoints)) - allocate(x%modis_Cloud_Fraction_Low_Mean(Npoints)) - allocate(x%modis_Optical_Thickness_Total_Mean(Npoints)) - allocate(x%modis_Optical_Thickness_Water_Mean(Npoints)) - allocate(x%modis_Optical_Thickness_Ice_Mean(Npoints)) - allocate(x%modis_Optical_Thickness_Total_LogMean(Npoints)) - allocate(x%modis_Optical_Thickness_Water_LogMean(Npoints)) - allocate(x%modis_Optical_Thickness_Ice_LogMean(Npoints)) - allocate(x%modis_Cloud_Particle_Size_Water_Mean(Npoints)) - allocate(x%modis_Cloud_Particle_Size_Ice_Mean(Npoints)) - allocate(x%modis_Cloud_Top_Pressure_Total_Mean(Npoints)) - allocate(x%modis_Liquid_Water_Path_Mean(Npoints)) - allocate(x%modis_Ice_Water_Path_Mean(Npoints)) - allocate(x%modis_Optical_Thickness_vs_Cloud_Top_Pressure(nPoints,numModisTauBins,numMODISPresBins)) - allocate(x%modis_Optical_thickness_vs_ReffLIQ(nPoints,numMODISTauBins,numMODISReffLiqBins)) - allocate(x%modis_Optical_Thickness_vs_ReffICE(nPoints,numMODISTauBins,numMODISReffIceBins)) + allocate( & + x%modis_Cloud_Fraction_Total_Mean(Npoints), & + x%modis_Cloud_Fraction_Water_Mean(Npoints), & + x%modis_Cloud_Fraction_Ice_Mean(Npoints), & + x%modis_Cloud_Fraction_High_Mean(Npoints), & + x%modis_Cloud_Fraction_Mid_Mean(Npoints), & + x%modis_Cloud_Fraction_Low_Mean(Npoints), & + x%modis_Optical_Thickness_Total_Mean(Npoints), & + x%modis_Optical_Thickness_Water_Mean(Npoints), & + x%modis_Optical_Thickness_Ice_Mean(Npoints), & + x%modis_Optical_Thickness_Total_LogMean(Npoints), & + x%modis_Optical_Thickness_Water_LogMean(Npoints), & + x%modis_Optical_Thickness_Ice_LogMean(Npoints), & + x%modis_Cloud_Particle_Size_Water_Mean(Npoints), & + x%modis_Cloud_Particle_Size_Ice_Mean(Npoints), & + x%modis_Cloud_Top_Pressure_Total_Mean(Npoints), & + x%modis_Liquid_Water_Path_Mean(Npoints), & + x%modis_Ice_Water_Path_Mean(Npoints), & + x%modis_Optical_Thickness_vs_Cloud_Top_Pressure(nPoints,numModisTauBins,numMODISPresBins), & + x%modis_Optical_thickness_vs_ReffLIQ(nPoints,numMODISTauBins,numMODISReffLiqBins), & + x%modis_Optical_Thickness_vs_ReffICE(nPoints,numMODISTauBins,numMODISReffIceBins), & + stat=istat) + call handle_allocate_error(istat, sub, 'modis_*') endif ! CALIPSO simulator if (llidar_sim) then - allocate(x%calipso_beta_mol(Npoints,Nlevels)) - allocate(x%calipso_beta_tot(Npoints,Ncolumns,Nlevels)) - allocate(x%calipso_srbval(SR_BINS+1)) - allocate(x%calipso_cfad_sr(Npoints,SR_BINS,Nlvgrid)) - allocate(x%calipso_betaperp_tot(Npoints,Ncolumns,Nlevels)) - allocate(x%calipso_lidarcld(Npoints,Nlvgrid)) - allocate(x%calipso_cldlayer(Npoints,LIDAR_NCAT)) - allocate(x%calipso_lidarcldphase(Npoints,Nlvgrid,6)) - allocate(x%calipso_lidarcldtmp(Npoints,LIDAR_NTEMP,5)) - allocate(x%calipso_cldlayerphase(Npoints,LIDAR_NCAT,6)) - ! These 2 outputs are part of the calipso output type, but are not controlled by an - ! logical switch in the output namelist, so if all other fields are on, then allocate - allocate(x%calipso_tau_tot(Npoints,Ncolumns,Nlevels)) - allocate(x%calipso_temp_tot(Npoints,Nlevels)) - ! Calipso opaque cloud diagnostics -! allocate(x%calipso_cldtype(Npoints,LIDAR_NTYPE)) -! allocate(x%calipso_cldtypetemp(Npoints,LIDAR_NTYPE)) -! allocate(x%calipso_cldtypemeanz(Npoints,2)) -! allocate(x%calipso_cldtypemeanzse(Npoints,3)) -! allocate(x%calipso_cldthinemis(Npoints)) -! allocate(x%calipso_lidarcldtype(Npoints,Nlvgrid,LIDAR_NTYPE+1)) + allocate( & + x%calipso_beta_mol(Npoints,Nlevels), & + x%calipso_beta_tot(Npoints,Ncolumns,Nlevels), & + x%calipso_srbval(SR_BINS+1), & + x%calipso_cfad_sr(Npoints,SR_BINS,Nlvgrid), & + x%calipso_betaperp_tot(Npoints,Ncolumns,Nlevels), & + x%calipso_lidarcld(Npoints,Nlvgrid), & + x%calipso_cldlayer(Npoints,LIDAR_NCAT), & + x%calipso_lidarcldphase(Npoints,Nlvgrid,6), & + x%calipso_lidarcldtmp(Npoints,LIDAR_NTEMP,5), & + x%calipso_cldlayerphase(Npoints,LIDAR_NCAT,6), & + x%calipso_tau_tot(Npoints,Ncolumns,Nlevels), & + x%calipso_temp_tot(Npoints,Nlevels), stat=istat) + call handle_allocate_error(istat, sub, 'calipso_*') endif ! PARASOL if (lparasol_sim) then - allocate(x%parasolPix_refl(Npoints,Ncolumns,PARASOL_NREFL)) - allocate(x%parasolGrid_refl(Npoints,PARASOL_NREFL)) + allocate( & + x%parasolPix_refl(Npoints,Ncolumns,PARASOL_NREFL), & + x%parasolGrid_refl(Npoints,PARASOL_NREFL), stat=istat) + call handle_allocate_error(istat, sub, 'parasol*') endif ! Cloudsat simulator if (lradar_sim) then - allocate(x%cloudsat_Ze_tot(Npoints,Ncolumns,Nlevels)) - allocate(x%cloudsat_cfad_ze(Npoints,CLOUDSAT_DBZE_BINS,Nlvgrid)) - allocate(x%lidar_only_freq_cloud(Npoints,Nlvgrid)) - allocate(x%radar_lidar_tcc(Npoints)) - allocate(x%cloudsat_precip_cover(Npoints,nCloudsatPrecipClass)) - allocate(x%cloudsat_pia(Npoints)) + allocate( & + x%cloudsat_Ze_tot(Npoints,Ncolumns,Nlevels), & + x%cloudsat_cfad_ze(Npoints,CLOUDSAT_DBZE_BINS,Nlvgrid), & + x%lidar_only_freq_cloud(Npoints,Nlvgrid), & + x%radar_lidar_tcc(Npoints), & + x%cloudsat_precip_cover(Npoints,nCloudsatPrecipClass), & + x%cloudsat_pia(Npoints), stat=istat) + call handle_allocate_error(istat, sub, 'cloudsat*') endif end subroutine construct_cosp_outputs diff --git a/src/physics/cam/cpslec.F90 b/src/physics/cam/cpslec.F90 deleted file mode 100644 index cb29dc29e7..0000000000 --- a/src/physics/cam/cpslec.F90 +++ /dev/null @@ -1,81 +0,0 @@ - -subroutine cpslec (ncol, pmid, phis, ps, t, psl, gravit, rair) - -!----------------------------------------------------------------------- -! -! Purpose: -! Hybrid coord version: Compute sea level pressure for a latitude line -! -! Method: -! CCM2 hybrid coord version using ECMWF formulation -! Algorithm: See section 3.1.b in NCAR NT-396 "Vertical -! Interpolation and Truncation of Model-Coordinate Data -! -! Author: Stolen from the Processor by Erik Kluzek -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, pver - - implicit none - -!-----------------------------Arguments--------------------------------- - integer , intent(in) :: ncol ! longitude dimension - - real(r8), intent(in) :: pmid(pcols,pver) ! Atmospheric pressure (pascals) - real(r8), intent(in) :: phis(pcols) ! Surface geopotential (m**2/sec**2) - real(r8), intent(in) :: ps(pcols) ! Surface pressure (pascals) - real(r8), intent(in) :: T(pcols,pver) ! Vertical slice of temperature (top to bot) - real(r8), intent(in) :: gravit ! Gravitational acceleration - real(r8), intent(in) :: rair ! gas constant for dry air - - real(r8), intent(out):: psl(pcols) ! Sea level pressures (pascals) -!----------------------------------------------------------------------- - -!-----------------------------Parameters-------------------------------- - real(r8), parameter :: xlapse = 6.5e-3_r8 ! Temperature lapse rate (K/m) -!----------------------------------------------------------------------- - -!-----------------------------Local Variables--------------------------- - integer i ! Loop index - real(r8) alpha ! Temperature lapse rate in terms of pressure ratio (unitless) - real(r8) Tstar ! Computed surface temperature - real(r8) TT0 ! Computed temperature at sea-level - real(r8) alph ! Power to raise P/Ps to get rate of increase of T with pressure - real(r8) beta ! alpha*phis/(R*T) term used in approximation of PSL -!----------------------------------------------------------------------- -! - alpha = rair*xlapse/gravit - do i=1,ncol - if ( abs(phis(i)/gravit) < 1.e-4_r8 )then - psl(i)=ps(i) - else - Tstar=T(i,pver)*(1._r8+alpha*(ps(i)/pmid(i,pver)-1._r8)) ! pg 7 eq 5 - - TT0=Tstar + xlapse*phis(i)/gravit ! pg 8 eq 13 - - if ( Tstar<=290.5_r8 .and. TT0>290.5_r8 ) then ! pg 8 eq 14.1 - alph=rair/phis(i)*(290.5_r8-Tstar) - else if (Tstar>290.5_r8 .and. TT0>290.5_r8) then ! pg 8 eq 14.2 - alph=0._r8 - Tstar= 0.5_r8 * (290.5_r8 + Tstar) - else - alph=alpha - if (Tstar<255._r8) then - Tstar= 0.5_r8 * (255._r8 + Tstar) ! pg 8 eq 14.3 - endif - endif - - beta = phis(i)/(rair*Tstar) - psl(i)=ps(i)*exp( beta*(1._r8-alph*beta/2._r8+((alph*beta)**2)/3._r8)) - end if - enddo - - return -end subroutine cpslec 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 31bcb324c8..c2a6d685d1 100644 --- a/src/physics/cam/dadadj_cam.F90 +++ b/src/physics/cam/dadadj_cam.F90 @@ -2,10 +2,11 @@ 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 physconst, only: cappav, cpairv, pi +use air_composition, only: cappav, cpairv +use physconst, only: pi use physics_types, only: physics_state, physics_ptend, physics_ptend_init use phys_control, only: use_simple_phys use cam_abortutils, only: endrun @@ -16,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 @@ -24,7 +25,7 @@ module dadadj_cam public :: & dadadj_readnl, & - dadadj_init, & + dadadj_cam_init, & dadadj_tend ! Namelist variables @@ -41,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 @@ -66,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 @@ -80,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 !=============================================================================== @@ -97,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/diffusion_solver.F90 b/src/physics/cam/diffusion_solver.F90 index fd33773066..2a715596ea 100644 --- a/src/physics/cam/diffusion_solver.F90 +++ b/src/physics/cam/diffusion_solver.F90 @@ -3,10 +3,10 @@ module diffusion_solver !------------------------------------------------------------------------------------ ! ! Module to solve vertical diffusion equations using a tri-diagonal solver. ! - ! The module will also apply countergradient fluxes, and apply molecular ! + ! The module will also apply countergradient fluxes, and apply molecular ! ! diffusion for constituents. ! ! ! - ! Public interfaces : ! + ! Public interfaces : ! ! init_vdiff initializes time independent coefficients ! ! compute_vdiff solves diffusion equations ! ! vdiff_selector type for storing fields selected to be diffused ! @@ -21,7 +21,7 @@ module diffusion_solver !------------------------------------------------------------------------------------ ! implicit none - private + private save integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real @@ -37,10 +37,10 @@ module diffusion_solver public vdiff_select ! Selects fields to be diffused public operator(.not.) ! Extends .not. to operate on type vdiff_selector public any ! Provides functionality of intrinsic any for type vdiff_selector - + ! Below stores logical array of fields to be diffused - type vdiff_selector + type vdiff_selector private logical, allocatable, dimension(:) :: fields end type vdiff_selector @@ -53,7 +53,7 @@ module diffusion_solver ! Below provides functionality of intrinsic any for type vdiff_selector - interface any + interface any module procedure my_any end interface @@ -77,7 +77,7 @@ module diffusion_solver real(r8), parameter :: horomin = 10._r8 ! Min value of subgrid orographic height for mountain stress real(r8), parameter :: dv2min = 0.01_r8 ! Minimum shear squared - logical :: am_correction ! logical switch for AM correction + logical :: am_correction ! logical switch for AM correction contains @@ -96,7 +96,7 @@ subroutine init_vdiff( kind, iulog_in, rair_in, cpair_in, gravit_in, do_iss_in, logical, intent(in) :: do_iss_in ! Input ISS flag logical, intent(in) :: am_correction_in! for angular momentum conservation character(128), intent(out) :: errstring ! Output status - + errstring = '' iulog = iulog_in if( kind .ne. r8 ) then @@ -135,7 +135,7 @@ subroutine compute_vdiff( lchnk , p , t , rhoi , ztodt , taux , & tauy , shflx , cflx , & kvh , kvm , kvq , cgs , cgh , & - zi , ksrftms , dragblj , & + zi , ksrftms , dragblj , & qmincg , fieldlist , fieldlistm , & u , v , q , dse , & tautmsx , tautmsy , dtk , topflx , errstring , & @@ -148,7 +148,7 @@ subroutine compute_vdiff( lchnk , !-------------------------------------------------------------------------- ! ! Driver routine to compute vertical diffusion of momentum, moisture, trace ! ! constituents and dry static energy. The new temperature is computed from ! - ! the diffused dry static energy. ! + ! the diffused dry static energy. ! ! Turbulent diffusivities and boundary layer nonlocal transport terms are ! ! obtained from the turbulence module. ! !-------------------------------------------------------------------------- ! @@ -161,9 +161,10 @@ subroutine compute_vdiff( lchnk , use linear_1d_operators, only : BoundaryType, BoundaryFixedLayer, & BoundaryData, BoundaryFlux, TriDiagDecomp use vdiff_lu_solver, only : fin_vol_lu_decomp + use vertical_diffusion_solver, only : fin_vol_solve use beljaars_drag_cam, only : do_beljaars ! FIXME: This should not be needed - use physconst, only: rairv + use air_composition, only: rairv use phys_control, only : phys_getopts @@ -175,7 +176,7 @@ subroutine compute_vdiff( lchnk , ! Input Arguments ! ! --------------- ! - integer, intent(in) :: lchnk + integer, intent(in) :: lchnk integer, intent(in) :: pcols integer, intent(in) :: pver integer, intent(in) :: ncnst @@ -303,7 +304,7 @@ end function vd_lu_qdecomp real(r8), intent(in), optional :: mw_fac(pcols,pver+1,ncnst) ! --------------- ! - ! Local Variables ! + ! Local Variables ! ! --------------- ! integer :: i, k, m ! Longitude, level, constituent indices @@ -328,7 +329,7 @@ end function vd_lu_qdecomp real(r8) :: tmpi2(pcols,pver+1) ! dt*(g*rho)**2/dp at interfaces real(r8) :: keg_in(pcols,pver) ! KE on entry to subroutine real(r8) :: keg_out(pcols,pver) ! KE after U and V dissipation/diffusion - real(r8) :: rrho(pcols) ! 1./bottom level density + real(r8) :: rrho(pcols) ! 1./bottom level density real(r8) :: tautotx(pcols) ! Total surface stress ( zonal ) real(r8) :: tautoty(pcols) ! Total surface stress ( meridional ) @@ -345,7 +346,7 @@ end function vd_lu_qdecomp real(r8) :: ksrfturb(pcols) ! Surface drag coefficient of 'normal' stress. > 0. ! Virtual mass input per unit time per unit area [ kg/s/m2 ] real(r8) :: ksrf(pcols) ! Surface drag coefficient of 'normal' stress + - ! Surface drag coefficient of 'tms' stress. > 0. [ kg/s/m2 ] + ! Surface drag coefficient of 'tms' stress. > 0. [ kg/s/m2 ] real(r8) :: usum_in(pcols) ! Vertical integral of input u-momentum. Total zonal ! momentum per unit area in column [ sum of u*dp/g = kg m/s m-2 ] real(r8) :: vsum_in(pcols) ! Vertical integral of input v-momentum. Total meridional @@ -367,8 +368,6 @@ end function vd_lu_qdecomp ! Combined molecular and eddy diffusion. real(r8) :: kv_total(pcols,pver+1) - logical :: use_spcam - !-------------------------------- ! Variables needed for WACCM-X !-------------------------------- @@ -388,8 +387,6 @@ end function vd_lu_qdecomp ! Main Computation Begins ! ! ----------------------- ! - call phys_getopts(use_spcam_out = use_spcam) - errstring = '' if( ( diffuse(fieldlist,'u') .or. diffuse(fieldlist,'v') ) .and. .not. diffuse(fieldlist,'s') ) then errstring = 'diffusion_solver.compute_vdiff: must diffuse s if diffusing u or v' @@ -400,7 +397,7 @@ end function vd_lu_qdecomp ! Computation of Molecular Diffusivities ! !--------------------------------------- ! - ! Modification : Why 'kvq' is not changed by molecular diffusion ? + ! Modification : Why 'kvq' is not changed by molecular diffusion ? if( do_molec_diff ) then @@ -474,8 +471,8 @@ end function vd_lu_qdecomp if( do_iss ) then - ! Compute surface drag coefficient for implicit diffusion - ! including turbulent mountain stress. + ! Compute surface drag coefficient for implicit diffusion + ! including turbulent mountain stress. do i = 1, ncol ws(i) = max( sqrt( u(i,pver)**2._r8 + v(i,pver)**2._r8 ), wsmin ) @@ -484,10 +481,10 @@ end function vd_lu_qdecomp end do ksrf(:ncol) = ksrfturb(:ncol) + ksrftms(:ncol) ! Do all surface stress ( normal + tms ) implicitly - ! Vertical integration of input momentum. + ! Vertical integration of input momentum. ! This is total horizontal momentum per unit area [ kg*m/s/m2 ] in each column. ! Note (u,v) are the raw input to the PBL scheme, not the - ! provisionally-marched ones within the iteration loop of the PBL scheme. + ! provisionally-marched ones within the iteration loop of the PBL scheme. do i = 1, ncol usum_in(i) = 0._r8 @@ -496,13 +493,13 @@ end function vd_lu_qdecomp usum_in(i) = usum_in(i) + (1._r8/gravit)*u(i,k)*p%del(i,k) vsum_in(i) = vsum_in(i) + (1._r8/gravit)*v(i,k)*p%del(i,k) end do - end do + end do ! Add residual stress of previous time step explicitly into the lowest ! model layer with a relaxation time scale of 'timeres'. if (am_correction) then - ! preserve time-mean torque + ! preserve time-mean torque ramda = 1._r8 else ramda = ztodt / timeres @@ -521,18 +518,18 @@ end function vd_lu_qdecomp usum_mid(i) = usum_mid(i) + (1._r8/gravit)*u(i,k)*p%del(i,k) vsum_mid(i) = vsum_mid(i) + (1._r8/gravit)*v(i,k)*p%del(i,k) end do - end do + end do else - ! In this case, do 'turbulent mountain stress' implicitly, + ! In this case, do 'turbulent mountain stress' implicitly, ! but do 'normal turbulent stress' explicitly. ! In this case, there is no 'residual stress' as long as 'tms' is ! treated in a fully implicit way, which is true. ! 1. Do 'tms' implicitly - ksrf(:ncol) = ksrftms(:ncol) + ksrf(:ncol) = ksrftms(:ncol) ! 2. Do 'normal stress' explicitly @@ -562,7 +559,7 @@ end function vd_lu_qdecomp ! wind speed, i.e. the rate at which wind is exponentially damped by ! surface stress. - ! Beljaars et al SGO scheme incorporated here. It + ! Beljaars et al SGO scheme incorporated here. It ! appears as a "3D" tau_damp_rate specification. tau_damp_rate(:,pver) = -gravit*ksrf(:ncol)*p%rdel(:,pver) @@ -570,16 +567,19 @@ end function vd_lu_qdecomp tau_damp_rate(:,k) = tau_damp_rate(:,k) + dragblj(:ncol,k) end do - decomp = fin_vol_lu_decomp(ztodt, p, & - coef_q=tau_damp_rate, coef_q_diff=kvm(:ncol,:)*dpidz_sq) + v(:ncol,:) = fin_vol_solve(ztodt, p, v(:ncol,:), ncol, pver, & + coef_q=tau_damp_rate, & + coef_q_diff=kvm(:ncol,:)*dpidz_sq) + + u(:ncol,:) = fin_vol_solve(ztodt, p, u(:ncol,:), ncol, pver, & + coef_q=tau_damp_rate, & + coef_q_diff=kvm(:ncol,:)*dpidz_sq) + - call decomp%left_div(u(:ncol,:)) - call decomp%left_div(v(:ncol,:)) - call decomp%finalize() ! ---------------------------------------------------------------------- ! ! Calculate 'total' ( tautotx ) and 'tms' ( tautmsx ) stresses that ! - ! have been actually added into the atmosphere at the current time step. ! + ! have been actually added into the atmosphere at the current time step. ! ! Also, update residual stress, if required. ! ! ---------------------------------------------------------------------- ! @@ -588,13 +588,13 @@ end function vd_lu_qdecomp ! Compute the implicit 'tms' using the updated winds. ! Below 'tautmsx(i),tautmsy(i)' are pure implicit mountain stresses ! that has been actually added into the atmosphere both for explicit - ! and implicit approach. + ! and implicit approach. tautmsx(i) = -ksrftms(i)*u(i,pver) tautmsy(i) = -ksrftms(i)*v(i,pver) ! We want to add vertically-integrated Beljaars drag to residual stress. - ! So this has to be calculated locally. + ! So this has to be calculated locally. ! We may want to rethink the residual drag calculation performed here on. (jtb) taubljx(i) = 0._r8 taubljy(i) = 0._r8 @@ -602,7 +602,7 @@ end function vd_lu_qdecomp taubljx(i) = taubljx(i) + (1._r8/gravit)*dragblj(i,k)*u(i,k)*p%del(i,k) taubljy(i) = taubljy(i) + (1._r8/gravit)*dragblj(i,k)*v(i,k)*p%del(i,k) end do - + if( do_iss ) then ! Compute vertical integration of final horizontal momentum @@ -617,14 +617,14 @@ end function vd_lu_qdecomp ! Compute net stress added into the atmosphere at the current time step. ! Note that the difference between 'usum_in' and 'usum_out' are induced ! by 'explicit residual stress + implicit total stress' for implicit case, while - ! by 'explicit normal stress + implicit tms stress' for explicit case. + ! by 'explicit normal stress + implicit tms stress' for explicit case. ! Here, 'tautotx(i)' is net stress added into the air at the current time step. tauimpx(i) = ( usum_out(i) - usum_in(i) ) / ztodt tauimpy(i) = ( vsum_out(i) - vsum_in(i) ) / ztodt - tautotx(i) = tauimpx(i) - tautoty(i) = tauimpy(i) + tautotx(i) = tauimpx(i) + tautoty(i) = tauimpy(i) ! Compute residual stress and update if required. ! Note that the total stress we should have added at the current step is @@ -648,13 +648,13 @@ end function vd_lu_qdecomp ! ------------------------------------ ! ! Calculate kinetic energy dissipation ! - ! ------------------------------------ ! + ! ------------------------------------ ! - ! Modification : In future, this should be set exactly same as - ! the ones in the convection schemes + ! Modification : In future, this should be set exactly same as + ! the ones in the convection schemes ! 1. Compute dissipation term at interfaces - ! Note that 'u,v' are already diffused wind, and 'tautotx,tautoty' are + ! Note that 'u,v' are already diffused wind, and 'tautotx,tautoty' are ! implicit stress that has been actually added. On the other hand, ! 'dinp_u, dinp_v' were computed using non-diffused input wind. @@ -685,7 +685,7 @@ end function vd_lu_qdecomp keg_out(i,k) = 0.5_r8 * ( u(i,k)*u(i,k) + v(i,k)*v(i,k) ) end do end do - + do k = 1, pver do i = 1, ncol dtk(i,k) = keg_in(i,k) - keg_out(i,k) @@ -711,46 +711,39 @@ end function vd_lu_qdecomp ! Diffuse Dry Static Energy ! !-------------------------- ! - ! Modification : In future, we should diffuse the fully conservative + ! Modification : In future, we should diffuse the fully conservative ! moist static energy,not the dry static energy. if( diffuse(fieldlist,'s') ) then - if (.not. use_spcam) then ! Add counter-gradient to input static energy profiles + do k = 1, pver + dse(:ncol,k) = dse(:ncol,k) + ztodt * p%rdel(:,k) * gravit * & + ( rhoi(:ncol,k+1) * kvh(:ncol,k+1) * cgh(:ncol,k+1) & + - rhoi(:ncol,k ) * kvh(:ncol,k ) * cgh(:ncol,k ) ) + end do - do k = 1, pver - dse(:ncol,k) = dse(:ncol,k) + ztodt * p%rdel(:,k) * gravit * & - ( rhoi(:ncol,k+1) * kvh(:ncol,k+1) * cgh(:ncol,k+1) & - - rhoi(:ncol,k ) * kvh(:ncol,k ) * cgh(:ncol,k ) ) - end do - endif ! Add the explicit surface fluxes to the lowest layer dse(:ncol,pver) = dse(:ncol,pver) + tmp1(:ncol) * shflx(:ncol) ! Diffuse dry static energy !--------------------------------------------------- - ! Solve for temperature using thermal conductivity + ! Solve for temperature using thermal conductivity !--------------------------------------------------- - if ( use_temperature_molec_diff ) then + if ( use_temperature_molec_diff ) then !---------------------------------------------------------------------------------------------------- - ! In Extended WACCM, kvt is calculated rather kvh. This is because molecular diffusion operates on + ! In Extended WACCM, kvt is calculated rather kvh. This is because molecular diffusion operates on ! temperature, while eddy diffusion operates on dse. Also, pass in constituent dependent "constants" !---------------------------------------------------------------------------------------------------- ! Boundary layer thickness of "0._r8" signifies that the boundary ! condition is defined directly on the top interface. - decomp = fin_vol_lu_decomp(ztodt, p, & - coef_q_diff=kvh(:ncol,:)*dpidz_sq, & - upper_bndry=interface_boundary) - - if (.not. use_spcam) then - call decomp%left_div(dse(:ncol,:), & - l_cond=BoundaryData(dse_top(:ncol))) - endif - call decomp%finalize() + dse(:ncol,:) = fin_vol_solve(ztodt, p, dse(:ncol,:), ncol, pver, & + coef_q_diff=kvh(:ncol,:)*dpidz_sq, & + upper_bndry=interface_boundary, & + l_cond=BoundaryData(dse_top(:ncol))) ! Calculate flux at top interface @@ -759,19 +752,14 @@ end function vd_lu_qdecomp topflx(:ncol) = - kvh(:ncol,1) * tmpi2(:ncol,1) / (ztodt*gravit) * & ( dse(:ncol,1) - dse_top(:ncol) ) - decomp = fin_vol_lu_decomp(ztodt, p, & - coef_q_diff=kvt(:ncol,:)*dpidz_sq, & - coef_q_weight=cpairv(:ncol,:)) - ttemp0 = t(:ncol,:) ttemp = ttemp0 ! upper boundary is zero flux for extended model - if (.not. use_spcam) then - call decomp%left_div(ttemp) - end if + ttemp = fin_vol_solve(ztodt, p, ttemp, ncol, pver, & + coef_q_diff=kvt(:ncol,:)*dpidz_sq, & + coef_q_weight=cpairv(:ncol,:)) - call decomp%finalize() !------------------------------------- ! Update dry static energy @@ -791,16 +779,10 @@ end function vd_lu_qdecomp ! Boundary layer thickness of "0._r8" signifies that the boundary ! condition is defined directly on the top interface. - decomp = fin_vol_lu_decomp(ztodt, p, & - coef_q_diff=kv_total(:ncol,:)*dpidz_sq, & - upper_bndry=interface_boundary) - - if (.not. use_spcam) then - call decomp%left_div(dse(:ncol,:), & - l_cond=BoundaryData(dse_top(:ncol))) - end if - - call decomp%finalize() + dse(:ncol,:) = fin_vol_solve(ztodt, p, dse(:ncol,:), ncol, pver, & + coef_q_diff=kv_total(:ncol,:)*dpidz_sq, & + upper_bndry=interface_boundary, & + l_cond=BoundaryData(dse_top(:ncol))) ! Calculate flux at top interface @@ -821,8 +803,8 @@ end function vd_lu_qdecomp ! Diffuse Water Vapor Tracers ! !---------------------------- ! - ! Modification : For aerosols, I need to use separate treatment - ! for aerosol mass and aerosol number. + ! Modification : For aerosols, I need to use separate treatment + ! for aerosol mass and aerosol number. ! Loop through constituents @@ -832,27 +814,25 @@ end function vd_lu_qdecomp do m = 1, ncnst if( diffuse(fieldlist,'q',m) ) then - if (.not. use_spcam) then - - ! Add the nonlocal transport terms to constituents in the PBL. - ! Check for neg q's in each constituent and put the original vertical - ! profile back if a neg value is found. A neg value implies that the - ! quasi-equilibrium conditions assumed for the countergradient term are - ! strongly violated. - - qtm(:ncol,:pver) = q(:ncol,:pver,m) - - do k = 1, pver - q(:ncol,k,m) = q(:ncol,k,m) + & - ztodt * p%rdel(:,k) * gravit * ( cflx(:ncol,m) * rrho(:ncol) ) * & - ( rhoi(:ncol,k+1) * kvh(:ncol,k+1) * cgs(:ncol,k+1) & - - rhoi(:ncol,k ) * kvh(:ncol,k ) * cgs(:ncol,k ) ) - end do - lqtst(:ncol) = all(q(:ncol,1:pver,m) >= qmincg(m), 2) - do k = 1, pver - q(:ncol,k,m) = merge( q(:ncol,k,m), qtm(:ncol,k), lqtst(:ncol) ) - end do - endif + + ! Add the nonlocal transport terms to constituents in the PBL. + ! Check for neg q's in each constituent and put the original vertical + ! profile back if a neg value is found. A neg value implies that the + ! quasi-equilibrium conditions assumed for the countergradient term are + ! strongly violated. + + qtm(:ncol,:pver) = q(:ncol,:pver,m) + + do k = 1, pver + q(:ncol,k,m) = q(:ncol,k,m) + & + ztodt * p%rdel(:,k) * gravit * ( cflx(:ncol,m) * rrho(:ncol) ) * & + ( rhoi(:ncol,k+1) * kvh(:ncol,k+1) * cgs(:ncol,k+1) & + - rhoi(:ncol,k ) * kvh(:ncol,k ) * cgs(:ncol,k ) ) + end do + lqtst(:ncol) = all(q(:ncol,1:pver,m) >= qmincg(m), 2) + do k = 1, pver + q(:ncol,k,m) = merge( q(:ncol,k,m), qtm(:ncol,k), lqtst(:ncol) ) + end do ! Add the explicit surface fluxes to the lowest layer @@ -893,12 +873,15 @@ end function vd_lu_qdecomp else - if (.not. use_spcam) then - ! Currently, no ubc for constituents without molecular - ! diffusion (they cannot diffuse out the top of the model). - call no_molec_decomp%left_div(q(:ncol,:,m)) + if (present(cnst_fixed_ubc)) then + ! explicitly set mmr in top layer for cases where molecular diffusion is not active + if (cnst_fixed_ubc(m)) then + q(:ncol,1,m) = ubc_mmr(:ncol,m) + endif end if + call no_molec_decomp%left_div(q(:ncol,:,m)) + end if end if @@ -911,7 +894,7 @@ end subroutine compute_vdiff ! =============================================================================== ! ! ! ! =============================================================================== ! - + character(128) function vdiff_select( fieldlist, name, qindex ) ! --------------------------------------------------------------------- ! ! This function sets the field with incoming name as one to be diffused ! @@ -919,7 +902,7 @@ character(128) function vdiff_select( fieldlist, name, qindex ) type(vdiff_selector), intent(inout) :: fieldlist character(*), intent(in) :: name integer, intent(in), optional :: qindex - + vdiff_select = '' select case (name) case ('u','U') @@ -938,13 +921,13 @@ character(128) function vdiff_select( fieldlist, name, qindex ) write(vdiff_select,*) 'Bad argument to vdiff_index: ', name end select return - + end function vdiff_select type(vdiff_selector) function not(a) ! ------------------------------------------------------------- ! ! This function extends .not. to operate on type vdiff_selector ! - ! ------------------------------------------------------------- ! + ! ------------------------------------------------------------- ! type(vdiff_selector), intent(in) :: a allocate(not%fields(size(a%fields))) not%fields = .not. a%fields @@ -952,8 +935,8 @@ end function not logical function my_any(a) ! -------------------------------------------------- ! - ! This function extends the intrinsic function 'any' ! - ! to operate on type vdiff_selector ! + ! This function extends the intrinsic function 'any' ! + ! to operate on type vdiff_selector ! ! -------------------------------------------------- ! type(vdiff_selector), intent(in) :: a my_any = any(a%fields) @@ -966,7 +949,7 @@ logical function diffuse(fieldlist,name,qindex) type(vdiff_selector), intent(in) :: fieldlist character(*), intent(in) :: name integer, intent(in), optional :: qindex - + select case (name) case ('u','U') diffuse = fieldlist%fields(1) diff --git a/src/physics/cam/ebert_curry_ice_optics.F90 b/src/physics/cam/ebert_curry_ice_optics.F90 new file mode 100644 index 0000000000..8d9b4985a7 --- /dev/null +++ b/src/physics/cam/ebert_curry_ice_optics.F90 @@ -0,0 +1,264 @@ +module ebert_curry_ice_optics + + +use shr_kind_mod, only: r8 => shr_kind_r8 +use physconst, only: gravit +use ppgrid, only: pcols, pver +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx +use constituents, only: cnst_get_ind +use radconstants, only: nswbands, nlwbands, get_sw_spectral_boundaries +use cam_abortutils, only: endrun + +implicit none +private +save + +public :: & + ec_rad_props_init, & + ec_ice_optics_sw, & + ec_ice_get_rad_props_lw + + +real(r8), public, parameter:: scalefactor = 1._r8 !500._r8/917._r8 + +! indices into pbuf +integer :: iciwp_idx = 0 +integer :: iclwp_idx = 0 +integer :: cld_idx = 0 +integer :: rei_idx = 0 + +! indices into constituents for old optics +integer :: ixcldice ! cloud ice water index +integer :: ixcldliq ! cloud liquid water index + + +!============================================================================== +contains +!============================================================================== + +subroutine ec_rad_props_init() + + integer :: err + + iciwp_idx = pbuf_get_index('ICIWP',errcode=err) + iclwp_idx = pbuf_get_index('ICLWP',errcode=err) + cld_idx = pbuf_get_index('CLD') + rei_idx = pbuf_get_index('REI') + + ! old optics + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + +end subroutine ec_rad_props_init + +!============================================================================== + +subroutine ec_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp) + + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8),intent(out) :: ice_tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: ice_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w + real(r8),intent(out) :: ice_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + logical, intent(in) :: oldicewp + + real(r8), pointer, dimension(:,:) :: rei + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: tmpptr + real(r8), dimension(pcols,pver) :: cicewp + real(r8), dimension(nswbands) :: wavmin + real(r8), dimension(nswbands) :: wavmax + ! + ! ice water coefficients (Ebert and Curry,1992, JGR, 97, 3831-3836) + real(r8) :: abari(4) = & ! a coefficient for extinction optical depth + (/ 3.448e-03_r8, 3.448e-03_r8,3.448e-03_r8,3.448e-03_r8/) + real(r8) :: bbari(4) = & ! b coefficient for extinction optical depth + (/ 2.431_r8 , 2.431_r8 ,2.431_r8 ,2.431_r8 /) + real(r8) :: cbari(4) = & ! c coefficient for single scat albedo + (/ 1.00e-05_r8 , 1.10e-04_r8 ,1.861e-02_r8,.46658_r8 /) + real(r8) :: dbari(4) = & ! d coefficient for single scat albedo + (/ 0.0_r8 , 1.405e-05_r8,8.328e-04_r8,2.05e-05_r8 /) + real(r8) :: ebari(4) = & ! e coefficient for asymmetry parameter + (/ 0.7661_r8 , 0.7730_r8 ,0.794_r8 ,0.9595_r8 /) + real(r8) :: fbari(4) = & ! f coefficient for asymmetry parameter + (/ 5.851e-04_r8, 5.665e-04_r8,7.267e-04_r8,1.076e-04_r8/) + + real(r8) :: abarii ! A coefficient for current spectral band + real(r8) :: bbarii ! B coefficient for current spectral band + real(r8) :: cbarii ! C coefficient for current spectral band + real(r8) :: dbarii ! D coefficient for current spectral band + real(r8) :: ebarii ! E coefficient for current spectral band + real(r8) :: fbarii ! F coefficient for current spectral band + + ! Minimum cloud amount (as a fraction of the grid-box area) to + ! distinguish from clear sky + real(r8), parameter :: cldmin = 1.0e-80_r8 + + ! Decimal precision of cloud amount (0 -> preserve full resolution; + ! 10^-n -> preserve n digits of cloud amount) + real(r8), parameter :: cldeps = 0.0_r8 + + integer :: ns, i, k, indxsl, lchnk, Nday + integer :: itim_old + real(r8) :: tmp1i, tmp2i, tmp3i, g + + Nday = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, rei_idx,rei) + + if(oldicewp) then + do k=1,pver + do i = 1,Nday + cicewp(i,k) = 1000.0_r8*state%q(i,k,ixcldice)*state%pdel(i,k) /(gravit* max(0.01_r8,cldn(i,k))) + end do + end do + else + if (iciwp_idx<=0) then + call endrun('ec_ice_optics_sw: oldicewp must be set to true since ICIWP was not found in pbuf') + endif + call pbuf_get_field(pbuf, iciwp_idx, tmpptr) + cicewp(1:pcols,1:pver) = 1000.0_r8*tmpptr(1:pcols,1:pver) + endif + + call get_sw_spectral_boundaries(wavmin,wavmax,'microns') + + do ns = 1, nswbands + + if(wavmax(ns) <= 0.7_r8) then + indxsl = 1 + else if(wavmax(ns) <= 1.25_r8) then + indxsl = 2 + else if(wavmax(ns) <= 2.38_r8) then + indxsl = 3 + else if(wavmax(ns) > 2.38_r8) then + indxsl = 4 + end if + + abarii = abari(indxsl) + bbarii = bbari(indxsl) + cbarii = cbari(indxsl) + dbarii = dbari(indxsl) + ebarii = ebari(indxsl) + fbarii = fbari(indxsl) + + do k=1,pver + do i=1,Nday + + ! note that optical properties for ice valid only + ! in range of 13 > rei > 130 micron (Ebert and Curry 92) + if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then + tmp1i = abarii + bbarii/max(13._r8,min(scalefactor*rei(i,k),130._r8)) + ice_tau(ns,i,k) = cicewp(i,k)*tmp1i + else + ice_tau(ns,i,k) = 0.0_r8 + endif + + tmp2i = 1._r8 - cbarii - dbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) + tmp3i = fbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) + ! Do not let single scatter albedo be 1. Delta-eddington solution + ! for non-conservative case has different analytic form from solution + ! for conservative case, and raddedmx is written for non-conservative case. + ice_tau_w(ns,i,k) = ice_tau(ns,i,k) * min(tmp2i,.999999_r8) + g = ebarii + tmp3i + ice_tau_w_g(ns,i,k) = ice_tau_w(ns,i,k) * g + ice_tau_w_f(ns,i,k) = ice_tau_w(ns,i,k) * g * g + + end do ! End do i=1,Nday + end do ! End do k=1,pver + end do ! nswbands + +end subroutine ec_ice_optics_sw + +!============================================================================== + +subroutine ec_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + logical, intent(in) :: oldicewp + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, itim_old, lwband, i, k, lchnk + + real(r8) :: kabs, kabsi + + real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) + parameter (kabsl = 0.090361_r8) + + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + + ncol = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + + if(oldicewp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('ec_ice_get_rad_props_lw: oldicewp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp(i,k) = 1000.0_r8 *iciwpth(i,k) + 1000.0_r8 *iclwpth(i,k) + ficemr(i,k) = 1000.0_r8*iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) + end do + end do + endif + + do k=1,pver + do i=1,ncol + + ! Note from Andrew Conley: + ! Optics for RK no longer supported, This is constructed to get + ! close to bit for bit. Otherwise we could simply use ice water path + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) + kabs = kabsi*ficemr(i,k) ! kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) + !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do + + do lwband = 1,nlwbands + abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + +end subroutine ec_ice_get_rad_props_lw + +!============================================================================== + +end module ebert_curry_ice_optics diff --git a/src/physics/cam/eddy_diff.F90 b/src/physics/cam/eddy_diff.F90 index 48f57e4a97..b48e7ed137 100644 --- a/src/physics/cam/eddy_diff.F90 +++ b/src/physics/cam/eddy_diff.F90 @@ -501,9 +501,8 @@ subroutine trbintd( pcols , pver , ncol , ! Calculate conservative scalars (qt,sl,slv) and buoyancy coefficients at the layer mid-points. ! Note that 'ntop_turb = 1', 'nbot_turb = pver' - do k = ntop_turb, nbot_turb - call qsat( t(:ncol,k), pmid(:ncol,k), es(:ncol,k), qs(:ncol,k), gam=gam(:ncol,k)) + call qsat( t(1:ncol,k), pmid(1:ncol,k), es(1:ncol,k), qs(1:ncol,k), ncol, gam=gam(1:ncol,k)) do i = 1, ncol qt(i,k) = qv(i,k) + ql(i,k) + qi(i,k) sl(i,k) = cpair * t(i,k) + g * z(i,k) - latvap * ql(i,k) - latsub * qi(i,k) @@ -633,7 +632,7 @@ subroutine caleddy( pcols , pver , ncol , kvh_in , kvm_in , kvh , kvm , & tpert , qpert , qrlin , kvf , tke , & wstarent , bprod , sprod , minpblh , wpert , & - tkes , went , turbtype , sm_aw , & + tkes , went , turbtype , & kbase_o , ktop_o , ncvfin_o , & kbase_mg , ktop_mg , ncvfin_mg , & kbase_f , ktop_f , ncvfin_f , & @@ -753,8 +752,6 @@ subroutine caleddy( pcols , pver , ncol , ! 3. = Bottom external interface of CL ! 4. = Top external interface of CL. ! 5. = Double entraining CL external interface - real(r8), intent(out) :: sm_aw(pcols,pver+1) ! Galperin instability function of momentum for use in the microphysics - ! [ no unit ] integer(i4), intent(out) :: ipbl(pcols) ! If 1, PBL is CL, while if 0, PBL is STL. integer(i4), intent(out) :: kpblh(pcols) ! Layer index containing PBL within or at the base interface real(r8), intent(out) :: wsed_CL(pcols,ncvmax) ! Sedimentation velocity at the top of each CL [ m/s ] @@ -1003,7 +1000,6 @@ subroutine caleddy( pcols , pver , ncol , sh_a(i,:pver+1) = 0._r8 sm_a(i,:pver+1) = 0._r8 ri_a(i,:pver+1) = 0._r8 - sm_aw(i,:pver+1) = 0._r8 ipbl(i) = 0 kpblh(i) = pver wsed_CL(i,:ncvmax) = 0._r8 @@ -1845,7 +1841,6 @@ subroutine caleddy( pcols , pver , ncol , bprod(i,k) = -kvh(i,k) * n2(i,k) sprod(i,k) = kvm(i,k) * s2(i,k) turbtype(i,k) = 2 ! CL interior interfaces. - sm_aw(i,k) = smcl(i,ncv)/alph1 ! Diagnostic output for microphysics end do ! 2. At CL top entrainment interface @@ -1861,7 +1856,6 @@ subroutine caleddy( pcols , pver , ncol , rcap = min( max(rcap,rcapmin), rcapmax ) tke(i,kt) = ebrk(i,ncv) * rcap tke(i,kt) = min( tke(i,kt), tkemax ) - sm_aw(i,kt) = smcl(i,ncv) / alph1 ! Diagnostic output for microphysics ! 3. At CL base entrainment interface and double entraining interfaces ! When current CL base is also the top interface of CL regime below, @@ -1922,12 +1916,6 @@ subroutine caleddy( pcols , pver , ncol , end if - ! For double entraining interface, simply use smcl(i,ncv) of the overlying CL. - ! Below 'sm_aw' is a diagnostic output for use in the microphysics. - ! When 'kb' is surface, 'sm' will be over-written later below. - - sm_aw(i,kb) = smcl(i,ncv)/alph1 - ! Calculate wcap at all interfaces of CL. Put a minimum threshold on TKE ! to prevent possible division by zero. 'wcap' at CL internal interfaces ! are already calculated in the first part of 'do ncv' loop correctly. @@ -2123,8 +2111,6 @@ subroutine caleddy( pcols , pver , ncol , bprod(i,k) = -kvh(i,k) * n2(i,k) sprod(i,k) = kvm(i,k) * s2(i,k) - sm_aw(i,k) = sm/alph1 ! This is diagnostic output for use in the microphysics - end if end do ! k @@ -2193,7 +2179,6 @@ subroutine caleddy( pcols , pver , ncol , wcap(i,k) = tke_imsi / b1 bprod(i,k) = -kvh_imsi * n2(i,k) sprod(i,k) = kvm_imsi * s2(i,k) - sm_aw(i,k) = sm/alph1 ! This is diagnostic output for use in the microphysics turbtype(i,k) = 1 ! This was added on Dec.10.2009 for use in microphysics. endif @@ -2258,7 +2243,6 @@ subroutine caleddy( pcols , pver , ncol , else sm_a(i,pver+1) = max(0._r8,(alph1+alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4exs*gh)) endif - sm_aw(i,pver+1) = sm_a(i,pver+1)/alph1 ri_a(i,pver+1) = -(sm_a(i,pver+1)/sh_a(i,pver+1))*(bprod(i,pver+1)/sprod(i,pver+1)) do k = 1, pver diff --git a/src/physics/cam/eddy_diff_cam.F90 b/src/physics/cam/eddy_diff_cam.F90 index fa0d6053d6..1742bf5038 100644 --- a/src/physics/cam/eddy_diff_cam.F90 +++ b/src/physics/cam/eddy_diff_cam.F90 @@ -321,7 +321,7 @@ subroutine eddy_diff_tend(state, pbuf, cam_in, & ztodt, p, tint, rhoi, cldn, wstarent, & kvm_in, kvh_in, ksrftms, dragblj,tauresx, tauresy, & rrho, ustar, pblh, kvm, kvh, kvq, cgh, cgs, tpert, qpert, & - tke, sprod, sfi, turbtype, sm_aw) + tke, sprod, sfi) use physics_types, only: physics_state use camsrfexch, only: cam_in_t @@ -355,8 +355,6 @@ subroutine eddy_diff_tend(state, pbuf, cam_in, & real(r8), intent(out) :: tke(pcols,pver+1) real(r8), intent(out) :: sprod(pcols,pver+1) real(r8), intent(out) :: sfi(pcols,pver+1) - integer(i4), intent(out) :: turbtype(pcols,pver+1) - real(r8), intent(out) :: sm_aw(pcols,pver+1) integer :: i, k @@ -370,7 +368,7 @@ subroutine eddy_diff_tend(state, pbuf, cam_in, & kvh , kvq , cgh , & cgs , tpert , qpert , tke , & sprod , sfi , & - tauresx , tauresy , ksrftms , dragblj , turbtype , sm_aw ) + tauresx , tauresy , ksrftms , dragblj ) ! The diffusivities from diag_TKE can be much larger than from HB in the free ! troposphere and upper atmosphere. These seem to be larger than observations, @@ -416,7 +414,7 @@ subroutine compute_eddy_diff( pbuf, lchnk , ustar , pblh , kvm_in , kvh_in , kvm_out , kvh_out , kvq , & cgh , cgs , tpert , qpert , tke , & sprod , sfi , & - tauresx, tauresy, ksrftms, dragblj, turbtype, sm_aw ) + tauresx, tauresy, ksrftms, dragblj ) !-------------------------------------------------------------------- ! ! Purpose: Interface to compute eddy diffusivities. ! @@ -429,7 +427,7 @@ subroutine compute_eddy_diff( pbuf, lchnk , use diffusion_solver, only: compute_vdiff use cam_history, only: outfld use phys_debug_util, only: phys_debug_col - use physconst, only: cpairv + use air_composition, only: cpairv use pbl_utils, only: calc_ustar, austausch_atm use error_messages, only: handle_errmsg use coords_1d, only: Coords1D @@ -490,10 +488,6 @@ subroutine compute_eddy_diff( pbuf, lchnk , real(r8), intent(out) :: tke(pcols,pver+1) ! Turbulent kinetic energy [ m2/s2 ] real(r8), intent(out) :: sprod(pcols,pver+1) ! Shear production [ m2/s3 ] real(r8), intent(out) :: sfi(pcols,pver+1) ! Interfacial layer saturation fraction [ fraction ] - integer(i4), intent(out):: turbtype(pcols,pver+1) ! Turbulence type identifier at all interfaces [ no unit ] - real(r8), intent(out) :: sm_aw(pcols,pver+1) ! Normalized Galperin instability function for momentum [ no unit ] - ! This is 1 when neutral condition (Ri=0), - ! 4.964 for maximum unstable case, and 0 when Ri > Ricrit=0.19. ! ---------------------- ! ! Input-Output Variables ! @@ -623,6 +617,8 @@ subroutine compute_eddy_diff( pbuf, lchnk , ! For sedimentation-entrainment feedback real(r8) :: wsed(pcols,ncvmax) ! Sedimentation velocity at the top of each CL [ m/s ] + integer(i4) :: turbtype(pcols,pver+1) ! Turbulence type identifier at all interfaces [ no unit ] + ! ---------- ! ! Parameters ! ! ---------- ! @@ -738,7 +734,7 @@ subroutine compute_eddy_diff( pbuf, lchnk , kvh , kvm , kvh_out , kvm_out , & tpert , qpert , qrl , kvf , tke , & wstarent , bprod , sprod , minpblh , wpert , & - tkes , went , turbtype , sm_aw , & + tkes , went , turbtype , & kbase_o , ktop_o , ncvfin_o , & kbase_mg , ktop_mg , ncvfin_mg , & kbase_f , ktop_f , ncvfin_f , & diff --git a/src/physics/cam/geopotential.F90 b/src/physics/cam/geopotential.F90 index 1d5c8a768c..52d4998133 100644 --- a/src/physics/cam/geopotential.F90 +++ b/src/physics/cam/geopotential.F90 @@ -1,4 +1,3 @@ - module geopotential !--------------------------------------------------------------------------------- @@ -8,7 +7,7 @@ module geopotential ! The hydrostatic matrix elements must be consistent with the dynamics algorithm. ! The diagonal element is the itegration weight from interface k+1 to midpoint k. ! The offdiagonal element is the weight between interfaces. -! +! ! Author: B.Boville, Feb 2001 from earlier code by Boville and S.J. Lin !--------------------------------------------------------------------------------- @@ -20,102 +19,9 @@ module geopotential private save - public geopotential_dse public geopotential_t contains -!=============================================================================== - subroutine geopotential_dse( & - piln , pmln , pint , pmid , pdel , rpdel , & - dse , q , phis , rair , gravit , cpair , & - zvir , t , zi , zm , ncol ) -!----------------------------------------------------------------------- -! -! Purpose: -! Compute the temperature and geopotential height (above the surface) at the -! midpoints and interfaces from the input dry static energy and pressures. -! -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- -! -! Input arguments - integer, intent(in) :: ncol ! Number of longitudes - - ! rair, and cpair are passed in as slices of rank 3 arrays allocated - ! at runtime. Don't specify size to avoid temporary copy. - real(r8), intent(in) :: piln (:,:) ! (pcols,pverp) - Log interface pressures - real(r8), intent(in) :: pmln (:,:) ! (pcols,pver) - Log midpoint pressures - real(r8), intent(in) :: pint (:,:) ! (pcols,pverp) - Interface pressures - real(r8), intent(in) :: pmid (:,:) ! (pcols,pver) - Midpoint pressures - real(r8), intent(in) :: pdel (:,:) ! (pcols,pver) - layer thickness - real(r8), intent(in) :: rpdel(:,:) ! (pcols,pver) - inverse of layer thickness - real(r8), intent(in) :: dse (:,:) ! (pcols,pver) - dry static energy - real(r8), intent(in) :: q (:,:) ! (pcols,pver) - specific humidity - real(r8), intent(in) :: phis (:) ! (pcols) - surface geopotential - real(r8), intent(in) :: rair (:,:) ! - Gas constant for dry air - real(r8), intent(in) :: gravit ! - Acceleration of gravity - real(r8), intent(in) :: cpair(:,:) ! - specific heat at constant p for dry air - real(r8), intent(in) :: zvir (:,:) ! (pcols,pver) - rh2o/rair - 1 - -! Output arguments - - real(r8), intent(out) :: t(:,:) ! (pcols,pver) - temperature - real(r8), intent(out) :: zi(:,:) ! (pcols,pverp) - Height above surface at interfaces - real(r8), intent(out) :: zm(:,:) ! (pcols,pver) - Geopotential height at mid level -! -!---------------------------Local variables----------------------------------------- -! - logical :: calc1 ! switch for calculation method - integer :: i,k ! Lon, level, level indices - real(r8) :: hkk(ncol) ! diagonal element of hydrostatic matrix - real(r8) :: hkl(ncol) ! off-diagonal element - real(r8) :: rog(ncol,pver) ! Rair / gravit - real(r8) :: tv ! virtual temperature - real(r8) :: tvfac ! Tv/T -! -!---------------------------------------------------------------------------------- - rog(:ncol,:) = rair(:ncol,:) / gravit - -! set calculation method based on dycore type - calc1 = dycore_is ('LR').or.dycore_is ('SE').or. dycore_is('FV3') - -! The surface height is zero by definition. - do i = 1,ncol - zi(i,pverp) = 0.0_r8 - end do - -! Compute the virtual temperature, zi, zm from bottom up -! Note, zi(i,k) is the interface above zm(i,k) - do k = pver, 1, -1 - -! First set hydrostatic elements consistent with dynamics - if (calc1) then - do i = 1,ncol - hkl(i) = piln(i,k+1) - piln(i,k) - hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) - end do - else - do i = 1,ncol - hkl(i) = pdel(i,k) / pmid(i,k) - hkk(i) = 0.5_r8 * hkl(i) - end do - end if - -! Now compute tv, t, zm, zi - do i = 1,ncol - tvfac = 1._r8 + zvir(i,k) * q(i,k) - tv = (dse(i,k) - phis(i) - gravit*zi(i,k+1)) / ((cpair(i,k) / tvfac) + & - rair(i,k)*hkk(i)) - - t (i,k) = tv / tvfac - - zm(i,k) = zi(i,k+1) + rog(i,k) * tv * hkk(i) - zi(i,k) = zi(i,k+1) + rog(i,k) * tv * hkl(i) - end do - end do - - return - end subroutine geopotential_dse !=============================================================================== subroutine geopotential_t( & @@ -123,16 +29,18 @@ subroutine geopotential_t( & t , q , rair , gravit , zvir , & zi , zm , ncol ) -!----------------------------------------------------------------------- -! -! Purpose: -! Compute the geopotential height (above the surface) at the midpoints and +!----------------------------------------------------------------------- +! +! Purpose: +! Compute the geopotential height (above the surface) at the midpoints and ! interfaces using the input temperatures and pressures. ! !----------------------------------------------------------------------- -use ppgrid, only : pcols - +use ppgrid, only: pcols +use constituents, only: pcnst, cnst_get_ind +use ccpp_constituent_prop_mod, only: ccpp_const_props !CCPP constituent properties array (CAM version) +use geopotential_temp, only: geopotential_temp_run !CCPP version !------------------------------Arguments-------------------------------- ! ! Input arguments @@ -146,7 +54,7 @@ subroutine geopotential_t( & real(r8), intent(in) :: pdel (:,:) ! (pcols,pver) - layer thickness real(r8), intent(in) :: rpdel(:,:) ! (pcols,pver) - inverse of layer thickness real(r8), intent(in) :: t (:,:) ! (pcols,pver) - temperature - real(r8), intent(in) :: q (:,:) ! (pcols,pver) - specific humidity + real(r8), intent(in) :: q (:,:,:) ! (pcols,pver,:)- tracers (moist mixing ratios) real(r8), intent(in) :: rair (:,:) ! (pcols,pver) - Gas constant for dry air real(r8), intent(in) :: gravit ! - Acceleration of gravity real(r8), intent(in) :: zvir (:,:) ! (pcols,pver) - rh2o/rair - 1 @@ -158,58 +66,88 @@ subroutine geopotential_t( & ! !---------------------------Local variables----------------------------- ! - logical :: fvdyn ! finite volume dynamics - integer :: i,k ! Lon, level indices + logical :: lagrang ! Lagrangian vertical coordinate flag + integer :: ixq ! state constituent array index for water vapor + integer :: i,k,idx ! Lon, level indices, water species index real(r8) :: hkk(ncol) ! diagonal element of hydrostatic matrix real(r8) :: hkl(ncol) ! off-diagonal element real(r8) :: rog(ncol,pver) ! Rair / gravit real(r8) :: tv ! virtual temperature real(r8) :: tvfac ! Tv/T + real(r8) :: qfac(ncol,pver) ! factor to convert from wet to dry mixing ratio + real(r8) :: sum_dry_mixing_ratio(ncol,pver)! sum of dry water mixing ratios + + !CCPP-required variables (not used): + integer :: errflg + character(len=512) :: errmsg + ! !----------------------------------------------------------------------- ! - rog(:ncol,:) = rair(:ncol,:) / gravit + !Determine index for water vapor mass mixing ratio + call cnst_get_ind('Q', ixq) -! Set dynamics flag + ! + ! original code for backwards compatability with FV + ! + if (.not.(dycore_is('MPAS') .or. dycore_is('SE'))) then - fvdyn = (dycore_is('LR') .or. dycore_is('FV3')) + !dry air gas constant over gravity + rog(:ncol,:) = rair(:ncol,:) / gravit -! The surface height is zero by definition. + ! The surface height is zero by definition. + do i = 1,ncol + zi(i,pverp) = 0.0_r8 + end do - do i = 1,ncol - zi(i,pverp) = 0.0_r8 - end do + ! Compute zi, zm from bottom up. + ! Note, zi(i,k) is the interface above zm(i,k) + do k = pver, 1, -1 -! Compute zi, zm from bottom up. -! Note, zi(i,k) is the interface above zm(i,k) + ! First set hydrostatic elements consistent with dynamics - do k = pver, 1, -1 - -! First set hydrostatic elements consistent with dynamics - - if (fvdyn) then + if ((dycore_is('LR') .or. dycore_is('FV3'))) then do i = 1,ncol - hkl(i) = piln(i,k+1) - piln(i,k) - hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) + hkl(i) = piln(i,k+1) - piln(i,k) + hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) end do - else + else do i = 1,ncol - hkl(i) = pdel(i,k) / pmid(i,k) - hkk(i) = 0.5_r8 * hkl(i) + hkl(i) = pdel(i,k) / pmid(i,k) + hkk(i) = 0.5_r8 * hkl(i) end do - end if + end if -! Now compute tv, zm, zi + ! Now compute tv, zm, zi - do i = 1,ncol - tvfac = 1._r8 + zvir(i,k) * q(i,k) + do i = 1,ncol + tvfac = 1._r8 + zvir(i,k) * q(i,k,ixq) tv = t(i,k) * tvfac zm(i,k) = zi(i,k+1) + rog(i,k) * tv * hkk(i) zi(i,k) = zi(i,k+1) + rog(i,k) * tv * hkl(i) - end do - end do - - return + end do + end do + else !Using MPAS or SE dycore + + !Determine vertical coordinate type, + !NOTE: Currently the FV (LR) or FV3 dycores + ! do not allow for condensate loading, + ! so for now 'lagrang' will always be FALSE. + if ((dycore_is('LR') .or. dycore_is('FV3'))) then + lagrang = .true. + else + lagrang = .false. + end if + + !Use CCPP version of geopotential_t: + call geopotential_temp_run(pver, lagrang, pver, 1, pverp, 1, & + pcnst, piln(1:ncol,:), pint(1:ncol,:), pmid(1:ncol,:), & + pdel(1:ncol,:), rpdel(1:ncol,:), t(1:ncol,:), & + q(1:ncol,:,ixq), q(1:ncol,:,:), ccpp_const_props, & + rair(1:ncol,:), gravit, zvir(1:ncol,:), zi(1:ncol,:), & + zm(1:ncol,:), ncol, errflg, errmsg) + + end if end subroutine geopotential_t end module geopotential diff --git a/src/physics/cam/gw_common.F90 b/src/physics/cam/gw_common.F90 index 803e67aadc..a9897cb140 100644 --- a/src/physics/cam/gw_common.F90 +++ b/src/physics/cam/gw_common.F90 @@ -98,7 +98,7 @@ module gw_common real(r8) :: dc ! Reference speeds [m/s]. real(r8), allocatable :: cref(:) - ! Critical Froude number, squared (usually 1, but CAM3 used 0.5). + ! Critical Froude number, squared real(r8) :: fcrit2 ! Horizontal wave number [1/m]. real(r8) :: kwv @@ -132,7 +132,9 @@ function new_GWBand(ngwv, dc, fcrit2, wavelength) result(band) ! Simple assignments. band%ngwv = ngwv band%dc = dc - band%fcrit2 = fcrit2 + + ! For now just ensure fcrit is always set to 1 + band%fcrit2 = 1.0_r8 ! fcrit2 ! Uniform phase speed reference grid. allocate(band%cref(-ngwv:ngwv)) @@ -147,7 +149,7 @@ end function new_GWBand !========================================================================== subroutine gw_common_init(pver_in, & - tau_0_ubc_in, ktop_in, gravit_in, rair_in, alpha_in, & + tau_0_ubc_in, ktop_in, gravit_in, rair_in, alpha_in, & prndl_in, qbo_hdepth_scaling_in, errstring) integer, intent(in) :: pver_in @@ -269,7 +271,7 @@ subroutine gw_drag_prof(ncol, band, p, src_level, tend_level, dt, & piln, rhoi, nm, ni, ubm, ubi, xv, yv, & effgw, c, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, egwdffi, gwut, dttdf, dttke, ro_adjust, & - kwvrdg, satfac_in, lapply_effgw_in, lapply_vdiff ) + kwvrdg, satfac_in, lapply_effgw_in, lapply_vdiff, tau_diag ) !----------------------------------------------------------------------- ! Solve for the drag profile from the multiple gravity wave drag @@ -356,13 +358,15 @@ subroutine gw_drag_prof(ncol, band, p, src_level, tend_level, dt, & real(r8), intent(in), optional :: & kwvrdg(ncol) - ! Factor for saturation calculation. Here backwards - ! compatibility. I believe it should be 1.0 (jtb). + ! Factor for saturation calculation. Here backwards + ! compatibility. I believe it should be 1.0 (jtb). ! Looks like it has been 2.0 for a while in CAM. real(r8), intent(in), optional :: & satfac_in logical, intent(in), optional :: lapply_effgw_in, lapply_vdiff + ! Provisional Wave Reynolds stress. + real(r8), intent(out), optional :: tau_diag(ncol,pver+1) !---------------------------Local storage------------------------------- @@ -423,7 +427,7 @@ subroutine gw_drag_prof(ncol, band, p, src_level, tend_level, dt, & lapply_effgw = .TRUE. endif - + ! Lowest levels that loops need to iterate over. kbot_tend = maxval(tend_level) kbot_src = maxval(src_level) @@ -455,9 +459,9 @@ subroutine gw_drag_prof(ncol, band, p, src_level, tend_level, dt, & !------------------------------------------------------------------------ ! Loop from bottom to top to get stress profiles. - ! do k = kbot_src-1, ktop, -1 !++jtb I think this is right - do k = kbot_src, ktop, -1 !++ but this is in model now - + ! do k = kbot_src-1, ktop, -1 !++jtb I think this is right + do k = kbot_src, ktop, -1 !++ but this is in model now + ! Determine the diffusivity for each column. d = dback + kvtt(:,k) @@ -548,6 +552,13 @@ subroutine gw_drag_prof(ncol, band, p, src_level, tend_level, dt, & ! Force tau at the top of the model to zero, if requested. if (tau_0_ubc) tau(:,:,ktop) = 0._r8 + ! Write out pre-adjustment tau profile for diagnostc purposes. + ! Current implementation only makes sense for orographic waves. + ! Fix later. + if (PRESENT(tau_diag)) then + tau_diag(:,:) = tau(:,0,:) + end if + ! Apply efficiency to completed stress profile. if (lapply_effgw) then do k = ktop, kbot_tend+1 @@ -583,11 +594,11 @@ subroutine gw_drag_prof(ncol, band, p, src_level, tend_level, dt, & ubtl = min(ubtl, umcfac * abs(c(:,l)-ubm(:,k)) / dt) if (.not. lapply_effgw) ubtl = min(ubtl, tndmax) - + where (k <= tend_level) ! Save tendency for each wave (for later computation of kzz). - ! sign function returns magnitude of ubtl with sign of c-ubm + ! sign function returns magnitude of ubtl with sign of c-ubm ! Renders ubt/ubm check for mountain waves unecessary gwut(:,k,l) = sign(ubtl, c(:,l)-ubm(:,k)) ubt(:,k) = ubt(:,k) + gwut(:,k,l) @@ -611,7 +622,7 @@ subroutine gw_drag_prof(ncol, band, p, src_level, tend_level, dt, & else ubt_lim_ratio = 1._r8 end if - + do l = -band%ngwv, band%ngwv gwut(:,k,l) = ubt_lim_ratio*gwut(:,k,l) ! Redetermine the effective stress on the interface below from the @@ -625,11 +636,11 @@ subroutine gw_drag_prof(ncol, band, p, src_level, tend_level, dt, & !-------------------------------------------------- where( abs(gwut(:,k,l)) < 1.e-15_r8 ) gwut(:,k,l) = 0._r8 - endwhere + endwhere where (k <= tend_level) - tau(:,l,k+1) = tau(:,l,k) + & - abs(gwut(:,k,l)) * p%del(:,k) / gravit + tau(:,l,k+1) = tau(:,l,k) + & + abs(gwut(:,k,l)) * p%del(:,k) / gravit end where end do @@ -857,7 +868,7 @@ subroutine momentum_fixer(tend_level, p, um_flux, vm_flux, utgw, vtgw) vtgw(:,k) = vtgw(:,k) + dv end where end do - + end subroutine momentum_fixer !========================================================================== diff --git a/src/physics/cam/gw_convect.F90 b/src/physics/cam/gw_convect.F90 index 09ca64a016..311865b499 100644 --- a/src/physics/cam/gw_convect.F90 +++ b/src/physics/cam/gw_convect.F90 @@ -161,7 +161,7 @@ subroutine gw_beres_src(ncol, band, desc, u, v, & do k = pver, 1, -1 do i = 1, ncol if (boti(i) == 0) then - ! Detect if we are outside the maximum range (where z = 20 km). + ! Detect if we are outside the top of range (where z = 20 km). if (zm(i,k) >= 20000._r8) then boti(i) = k topi(i) = k @@ -169,17 +169,20 @@ subroutine gw_beres_src(ncol, band, desc, u, v, & ! 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. + ! When all done, exit + if (all(boti /= 0)) exit + end do + + do k = 1, pver + do i = 1, ncol + if (topi(i) == 0) then + ! First spot where heating rate is positive. + if ((netdt(i,k) > 0.0_r8) .AND. (zm(i,k) <= 20000._r8)) topi(i) = k-1 + end if + end do + ! When all done, exit if (all(topi /= 0)) exit end do @@ -283,7 +286,7 @@ subroutine gw_beres_src(ncol, band, desc, u, v, & ! Adjust for critical level filtering. tau0(Umini(i):Umaxi(i)) = 0.0_r8 - + tau(i,:,topi(i)+1) = tau0 end if ! heating depth above min and not at the pole diff --git a/src/physics/cam/gw_drag.F90 b/src/physics/cam/gw_drag.F90 index ba381f48ef..6f2b66f886 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 @@ -72,7 +77,7 @@ module gw_drag ! Factor for SH orographic waves. real(r8) :: gw_oro_south_fac = 1._r8 - + ! Frontogenesis function critical threshold. real(r8) :: frontgfc = unset_r8 @@ -104,6 +109,18 @@ module gw_drag real(r8) :: effgw_beres_dp = unset_r8 ! Beres (shallow convection). real(r8) :: effgw_beres_sh = unset_r8 + ! PBL moving mtn + real(r8) :: effgw_movmtn_pbl = unset_r8 + integer :: movmtn_source = -1 + integer :: movmtn_ksteer = -1 + integer :: movmtn_klaunch = -1 + real(r8) :: movmtn_psteer = unset_r8 + real(r8) :: movmtn_plaunch = unset_r8 + + ! Parameters controlling isotropic residual + ! orographic GW. + logical :: use_gw_rdg_resid = .false. + real(r8) :: effgw_rdg_resid = unset_r8 ! Horzontal wavelengths [m]. real(r8), parameter :: wavelength_mid = 1.e5_r8 @@ -129,15 +146,16 @@ 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 - ! Width of gaussian used to create frontogenesis tau profile [m/s]. - real(r8), parameter :: front_gaussian_width = 30._r8 + ! Moving mountain settings and table. + type(MovMtnSourceDesc) :: movmtn_desc ! Frontogenesis wave settings. type(CMSourceDesc) :: cm_desc @@ -149,13 +167,25 @@ module gw_drag integer :: ttend_sh_idx = -1 integer :: frontgf_idx = -1 integer :: frontga_idx = -1 + + integer :: vort4gw_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 real(r8), allocatable, dimension(:,:), target :: & - rdg_gbxar + rdg_gbxar, & + rdg_isovar, & + rdg_isowgt ! Meso Beta real(r8), allocatable, dimension(:,:,:), target :: & @@ -183,12 +213,17 @@ module gw_drag character(len=1), parameter :: beres_dp_pf = "B" character(len=1), parameter :: beres_sh_pf = "S" - ! namelist + ! namelist logical :: history_amwg ! output the variables used by the AMWG diag package logical :: gw_lndscl_sgh = .true. ! scale SGH by land frac 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-1]. + real(r8) :: front_gaussian_width = -huge(1._r8) + + real(r8) :: alpha_gw_movmtn + logical :: gw_top_taper=.false. real(r8), pointer :: vramp(:)=>null() @@ -217,14 +252,9 @@ subroutine gw_drag_readnl(nlfile) integer :: pgwv_long = -1 real(r8) :: gw_dc_long = unset_r8 - ! fcrit2 for the mid-scale waves has been made a namelist variable to - ! facilitate backwards compatibility with the CAM3 version of this - ! parameterization. In CAM3, fcrit2=0.5. - real(r8) :: fcrit2 = unset_r8 ! critical froude number squared - namelist /gw_drag_nl/ pgwv, gw_dc, pgwv_long, gw_dc_long, tau_0_ubc, & effgw_beres_dp, effgw_beres_sh, effgw_cm, effgw_cm_igw, effgw_oro, & - fcrit2, frontgfc, gw_drag_file, gw_drag_file_sh, taubgnd, & + frontgfc, gw_drag_file, gw_drag_file_sh, gw_drag_file_mm, taubgnd, & taubgnd_igw, gw_polar_taper, & use_gw_rdg_beta, n_rdg_beta, effgw_rdg_beta, effgw_rdg_beta_max, & rdg_beta_cd_llb, trpd_leewv_rdg_beta, & @@ -232,7 +262,10 @@ 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 + gw_top_taper, front_gaussian_width, alpha_gw_movmtn, use_gw_rdg_resid, & + effgw_rdg_resid, effgw_movmtn_pbl, movmtn_source, movmtn_psteer, & + movmtn_plaunch + !---------------------------------------------------------------------- if (use_simple_phys) return @@ -302,8 +335,6 @@ subroutine gw_drag_readnl(nlfile) call mpi_bcast(gw_oro_south_fac, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_oro_south_fac") - call mpi_bcast(fcrit2, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fcrit2") call mpi_bcast(frontgfc, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frontgfc") call mpi_bcast(taubgnd, 1, mpi_real8, mstrid, mpicom, ierr) @@ -332,12 +363,28 @@ 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") + call mpi_bcast(effgw_movmtn_pbl, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: effgw_movmtn_pbl") + call mpi_bcast(movmtn_source, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: movmtn_source") + call mpi_bcast(movmtn_psteer, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: movmtn_psteer") + call mpi_bcast(movmtn_plaunch, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: movmtn_plaunch") + + call mpi_bcast(use_gw_rdg_resid, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: use_gw_rdg_resid") + call mpi_bcast(effgw_rdg_resid, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: effgw_rdg_resid") - ! Check if fcrit2 was set. - call shr_assert(fcrit2 /= unset_r8, & - "gw_drag_readnl: fcrit2 must be set via the namelist."// & - errMsg(__FILE__, __LINE__)) ! Check if pgwv was set. call shr_assert(pgwv >= 0, & @@ -350,9 +397,10 @@ subroutine gw_drag_readnl(nlfile) "gw_drag_readnl: gw_dc must be set via the namelist."// & errMsg(__FILE__, __LINE__)) - band_oro = GWBand(0, gw_dc, fcrit2, wavelength_mid) + band_oro = GWBand(0, gw_dc, 1.0_r8, wavelength_mid) band_mid = GWBand(pgwv, gw_dc, 1.0_r8, wavelength_mid) band_long = GWBand(pgwv_long, gw_dc_long, 1.0_r8, wavelength_long) + band_movmtn = GWBand(0, gw_dc, 1.0_r8, wavelength_mid) if (use_gw_rdg_gamma .or. use_gw_rdg_beta) then call gw_rdg_readnl(nlfile) @@ -379,7 +427,7 @@ subroutine gw_init() ! temporary for restart with ridge scheme use cam_initfiles, only: bnd_topo - + use cam_pio_utils, only: cam_pio_openfile use cam_grid_support, only: cam_grid_check, cam_grid_id use cam_grid_support, only: cam_grid_get_dim_names @@ -466,14 +514,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 @@ -504,7 +552,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 @@ -539,7 +587,7 @@ subroutine gw_init() ! Initialize subordinate modules. call gw_common_init(pver,& - tau_0_ubc, ktop, gravit, rair, alpha, gw_prndl, & + tau_0_ubc, ktop, gravit, rair, alpha, gw_prndl, & gw_qbo_hdepth_scaling, errstring ) call shr_assert(trim(errstring) == "", "gw_common_init: "//errstring// & errMsg(__FILE__, __LINE__)) @@ -547,32 +595,32 @@ 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 - + if (use_gw_oro .or. use_gw_rdg_beta .or. use_gw_rdg_gamma) then 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') @@ -611,7 +659,7 @@ subroutine gw_init() ! Try to open topo file here. This workaround will not be needed ! once the refactored initialization sequence is on trunk. - + allocate(fh_topo) ! Error exit is from getfil if file not found. call getfil(bnd_topo, bnd_topo_loc) @@ -622,17 +670,31 @@ subroutine gw_init() ! Get beta ridge data allocate( & rdg_gbxar(pcols,begchunk:endchunk), & + rdg_isovar(pcols,begchunk:endchunk), & + rdg_isowgt(pcols,begchunk:endchunk), & rdg_hwdth(pcols,prdg,begchunk:endchunk), & rdg_clngt(pcols,prdg,begchunk:endchunk), & rdg_mxdis(pcols,prdg,begchunk:endchunk), & rdg_anixy(pcols,prdg,begchunk:endchunk), & rdg_angll(pcols,prdg,begchunk:endchunk) ) - + call infld('GBXAR', fh_topo, dim1name, dim2name, 1, pcols, & begchunk, endchunk, rdg_gbxar, found, gridname='physgrid') if (.not. found) call endrun(sub//': ERROR: GBXAR not found on topo file') rdg_gbxar = rdg_gbxar * (rearth/1000._r8)*(rearth/1000._r8) ! transform to km^2 - + + call infld('ISOVAR', fh_topo, dim1name, dim2name, 1, pcols, & + begchunk, endchunk, rdg_isovar, found, gridname='physgrid') +! if (.not. found) call endrun(sub//': ERROR: ISOVAR not found on topo file') + ! ++jtb - Temporary fix until topo files contain this variable + if (.not. found) rdg_isovar(:,:) = 0._r8 + + call infld('ISOWGT', fh_topo, dim1name, dim2name, 1, pcols, & + begchunk, endchunk, rdg_isowgt, found, gridname='physgrid') +! if (.not. found) call endrun(sub//': ERROR: ISOWGT not found on topo file') + ! ++jtb - Temporary fix until topo files contain this variable + if (.not. found) rdg_isowgt(:,:) = 0._r8 + call infld('HWDTH', fh_topo, dim1name, 'nrdg', dim2name, 1, pcols, & 1, prdg, begchunk, endchunk, rdg_hwdth, found, gridname='physgrid') if (.not. found) call endrun(sub//': ERROR: HWDTH not found on topo file') @@ -658,41 +720,115 @@ subroutine gw_init() call pio_closefile(fh_topo) end if - call addfld('UEGW', (/ 'lev' /) , 'A' ,'1/s' , & + call addfld ('WBR_HT1', horiz_only, 'I','m', & + 'Wave breaking height for DSW') + call addfld ('TLB_HT1', horiz_only, 'I','m', & + 'Form drag layer height') + call addfld ('BWV_HT1', horiz_only, 'I','m', & + 'Bottom of freely-propagating OGW regime') + call addfld ('TAUDSW1', horiz_only, 'I','Nm-2', & + 'DSW enhanced drag') + call addfld ('TAUORO1', horiz_only, 'I','Nm-2', & + 'lower BC on propagating wave stress') + call addfld ('UBMSRC1', horiz_only, 'I','ms-1', & + 'below-peak-level on-ridge wind') + call addfld ('USRC1', horiz_only, 'I','ms-1', & + 'below-peak-level Zonal wind') + call addfld ('VSRC1', horiz_only, 'I','ms-1', & + 'below-peak-level Meridional wind') + call addfld ('NSRC1', horiz_only, 'I','s-1', & + 'below-peak-level stratification') + call addfld ('MXDIS1', horiz_only, 'I','m', & + 'Ridge/obstacle height') + call addfld ('ANGLL1', horiz_only, 'I','degrees', & + 'orientation clockwise w/resp north-south') + call addfld ('ANIXY1', horiz_only, 'I','1', & + 'Ridge quality') + call addfld ('HWDTH1', horiz_only, 'I','km', & + 'Ridge width') + call addfld ('CLNGT1', horiz_only, 'I','km', & + 'Ridge length') + call addfld ('GBXAR1', horiz_only, 'I','km+2', & + 'grid box area') + + call addfld ('Fr1_DIAG', horiz_only, 'I','1', & + 'Critical Froude number for linear waves') + call addfld ('Fr2_DIAG', horiz_only, 'I','1', & + 'Critical Froude number for blocked flow') + call addfld ('Frx_DIAG', horiz_only, 'I','1', & + 'Obstacle Froude Number') + + 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' , & 'Temperature profile-entry to GW ' ) - - call addfld('TAU1RDGBETAM' , (/ 'ilev' /) , 'I' ,'N/m2' , & + call addfld('ZEGW', (/ 'ilev' /) , 'A' ,'m' , & + 'interface geopotential heights in GW code ' ) + call addfld('ZMGW', (/ 'lev' /) , 'A' ,'m' , & + 'midlayer geopotential heights in GW code ' ) + + + call addfld('NIEGW', (/ 'ilev' /) , 'I' ,'1/s' , & + 'interface BV freq in GW code ' ) + call addfld('NMEGW', (/ 'lev' /) , 'I' ,'1/s' , & + 'midlayer BV freq in GW code ' ) + call addfld('RHOIEGW', (/ 'ilev' /) , 'I' ,'kg/m^3' , & + 'interface density in GW code ' ) + call addfld('PINTEGW', (/ 'ilev' /) , 'I' ,'Pa' , & + 'interface air pressure in GW code ' ) + + call addfld('TAUM1_DIAG' , (/ 'ilev' /) , 'I' ,'N m-2' , & + 'Ridge based momentum flux profile') + 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' ,'m s-1' , & 'On-ridge wind profile ' ) - call addfld('UBT1RDGBETA' , (/ 'lev' /) , 'I' ,'m/s' , & + call addfld('UBT1RDGBETA' , (/ 'lev' /) , 'I' ,'m s-2' , & 'On-ridge wind tendency from ridge 1 ') + call addfld('TAURESIDBETAM' , (/ 'ilev' /) , 'I' ,'N m-2' , & + 'Ridge based momentum flux profile') + call addfld('UBMRESIDBETA', (/ 'lev' /) , 'I' ,'m s-1' , & + 'On-ridge wind profile ' ) + call addfld('UBIRESIDBETA', (/ 'ilev' /) , 'I' ,'m s-1' , & + 'On-ridge wind profile (interface) ' ) + call addfld('SRC_LEVEL_RESIDBETA', horiz_only , 'I' ,'1' , & + 'src level index for ridge residual ' ) + call addfld('TAUORO_RESID', horiz_only , 'I' ,'N m-2' , & + 'Surface momentum flux from ridge residual ' ) + call addfld('TAUDIAG_RESID' , (/ 'ilev' /) , 'I' ,'N m-2' , & + 'Ridge based momentum flux profile') + + 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') + call addfld('TAURESIDBETAY' , (/ 'ilev' /) , 'I' ,'N m-2' , & + 'Ridge based momentum flux profile') + call addfld('TAURESIDBETAX' , (/ 'ilev' /) , 'I' ,'N m-2' , & + 'Ridge based momentum flux profile') + call register_vector_field('TAURESIDBETAX','TAURESIDBETAY') + if (history_waccm) then call add_default('TAUARDGBETAX', 1, ' ') call add_default('TAUARDGBETAY ', 1, ' ') @@ -705,7 +841,7 @@ subroutine gw_init() if (effgw_rdg_gamma == unset_r8) then call endrun(sub//": ERROR: Anisotropic OGW enabled, but effgw_rdg_gamma was not set.") end if - + call getfil(bnd_rdggm, bnd_rdggm_loc, iflag=1, lexist=found) if (found) then call cam_pio_openfile(fh_rdggm, bnd_rdggm_loc, PIO_NOWRITE) @@ -749,42 +885,42 @@ subroutine gw_init() call infld('ANGLL', fh_rdggm, dim1name, 'nrdg', dim2name, 1, pcols, & 1, prdg, begchunk, endchunk, rdg_angllg, found, gridname='physgrid') if (.not. found) call endrun(sub//': ERROR: ANGLL not found on bnd_rdggm') - + 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 @@ -795,7 +931,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__)) @@ -825,10 +961,33 @@ subroutine gw_init() end if + if (use_gw_movmtn_pbl) then + do k = 1, pver + ! Find steering level + if ( (pref_edge(k+1) >= movmtn_psteer).and.(pref_edge(k) < movmtn_psteer) ) then + movmtn_ksteer = k + end if + end do + do k = 1, pver + ! Find launch level + if ( (pref_edge(k+1) >= movmtn_plaunch).and.(pref_edge(k) < movmtn_plaunch ) ) then + movmtn_klaunch = k + end if + end do + + end if + if (use_gw_movmtn_pbl) then + + vort4gw_idx = pbuf_get_index('VORT4GW') + + call addfld ('VORT4GW', (/ 'lev' /), 'A', 's-1', & + 'Vorticity') + end if + 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__)) @@ -850,7 +1009,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__)) @@ -869,6 +1028,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') @@ -892,7 +1132,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__)) @@ -902,9 +1142,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') @@ -939,7 +1179,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__)) @@ -949,9 +1189,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') @@ -971,14 +1211,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. @@ -1043,9 +1283,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 @@ -1071,8 +1311,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. @@ -1133,6 +1373,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. @@ -1184,20 +1552,22 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Interface for multiple gravity wave drag parameterization. !----------------------------------------------------------------------- - use physics_types, only: physics_state_copy, set_dry_to_wet - use constituents, only: cnst_type - use physics_buffer, only: physics_buffer_desc, pbuf_get_field - use camsrfexch, only: cam_in_t + use physics_types, only: physics_state_copy + use constituents, only: cnst_type + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use camsrfexch, only: cam_in_t ! Location-dependent cpair - use physconst, only: cpairv, pi - use coords_1d, only: Coords1D - use gw_common, only: gw_prof, gw_drag_prof, calc_taucd, & - momentum_flux, momentum_fixer, energy_change, energy_fixer, & - coriolis_speed, adjust_inertial - use gw_oro, only: gw_oro_src - use gw_front, only: gw_cm_src - use gw_convect, only: gw_beres_src - + use air_composition, only: cpairv + use physconst, only: pi + use coords_1d, only: Coords1D + use gw_common, only: gw_prof, gw_drag_prof, calc_taucd + use gw_common, only: momentum_flux, momentum_fixer, energy_change + use gw_common, only: energy_fixer, coriolis_speed, adjust_inertial + 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 + use dycore, only: dycore_is !------------------------------Arguments-------------------------------- type(physics_state), intent(in) :: state ! physics state structure type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer @@ -1213,6 +1583,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 @@ -1247,7 +1618,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) @@ -1266,12 +1637,23 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Frontogenesis real(r8), pointer :: frontgf(:,:) real(r8), pointer :: frontga(:,:) + ! Vorticity source + real(r8), pointer :: vort4gw(:,:) ! Temperature change due to deep convection. real(r8), pointer :: ttend_dp(:,:) ! 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(:) @@ -1289,6 +1671,12 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) real(r8), pointer :: angll(:,:) ! anisotropy of ridges. real(r8), pointer :: anixy(:,:) + ! sqrt(residual variance) not repr by ridges (assumed isotropic). + real(r8), pointer :: isovar(:) + ! area fraction of res variance + real(r8), pointer :: isowgt(:) + + ! Gamma ridges ! width of ridges. @@ -1320,7 +1708,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) real(r8), parameter :: degree2radian = pi/180._r8 real(r8), parameter :: al0 = 82.5_r8 * degree2radian real(r8), parameter :: dlat0 = 5.0_r8 * degree2radian - + ! effective gw diffusivity at interfaces needed for output real(r8) :: egwdffi(state%ncol,pver+1) ! sum from the two types of spectral GW @@ -1343,14 +1731,12 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) real(r8) :: piln(state%ncol,pver+1) real(r8) :: zm(state%ncol,pver) real(r8) :: zi(state%ncol,pver+1) + !------------------------------------------------------------------------ ! Make local copy of input state. call physics_state_copy(state, state1) - ! constituents are all treated as wet mmr - call set_dry_to_wet(state1) - lchnk = state1%lchnk ncol = state1%ncol @@ -1406,16 +1792,128 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Totals that accumulate over different sources. egwdffi_tot = 0._r8 flx_heat = 0._r8 - + + if (use_gw_movmtn_pbl) then + !------------------------------------------------------------------ + !Convective moving mountain gravity waves (Beres scheme). + !------------------------------------------------------------------ + + call outfld('U_MOVMTN_IN', u, ncol, lchnk) + call outfld('V_MOVMTN_IN', v, ncol, lchnk) + + ! Allocate wavenumber fields. + allocate(tau(ncol,-band_movmtn%ngwv:band_movmtn%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_movmtn%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,-band_movmtn%ngwv:band_movmtn%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*band_movmtn%ngwv**2+1) + allocate(phase_speeds(ncol,-band_movmtn%ngwv:band_movmtn%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','phase_speeds',ncol*band_movmtn%ngwv**2+1) + + ! Set up heating + if (ttend_dp_idx > 0) then + call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp) + else + allocate(ttend_dp(pcols,pver), stat=istat) + call alloc_err(istat, 'gw_tend', 'ttend_dp', pcols*pver) + ttend_dp = 0.0_r8 + end if + + ! New couplings from CLUBB + call pbuf_get_field(pbuf, ttend_clubb_idx, ttend_clubb) + call pbuf_get_field(pbuf, thlp2_clubb_gw_idx, thlp2_clubb_gw) + call pbuf_get_field(pbuf, wpthlp_clubb_gw_idx, wpthlp_clubb_gw) + call pbuf_get_field(pbuf, upwp_clubb_gw_idx, upwp_clubb_gw) + call pbuf_get_field(pbuf, vpwp_clubb_gw_idx, vpwp_clubb_gw) + call pbuf_get_field(pbuf, vort4gw_idx, vort4gw) + + xpwp_clubb(:ncol,:) = sqrt( upwp_clubb_gw(:ncol,:)**2 + vpwp_clubb_gw(:ncol,:)**2 ) + + effgw = effgw_movmtn_pbl + call gw_movmtn_src(ncol, lchnk, band_movmtn , movmtn_desc, & + u, v, ttend_dp(:ncol,:), ttend_clubb(:ncol,:), xpwp_clubb(:ncol,:), vort4gw(:ncol,:), & + zm, alpha_gw_movmtn, movmtn_source, movmtn_ksteer, movmtn_klaunch, 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) + call outfld ('VORT4GW', vort4gw, pcols, lchnk) + + !Deallocate variables that are no longer used: + deallocate(tau, gwut, phase_speeds) + + !Deallocate/nullify ttend_dp if not a pbuf variable: + if (ttend_dp_idx <= 0) then + deallocate(ttend_dp) + nullify(ttend_dp) + end if + + end if + if (use_gw_convect_dp) then !------------------------------------------------------------------ ! Convective gravity waves (Beres scheme, deep). !------------------------------------------------------------------ ! Allocate wavenumber fields. - allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1)) - allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv)) - allocate(c(ncol,-band_mid%ngwv:band_mid%ngwv)) + allocate(tau(ncol,-band_mid%ngwv:band_mid%ngwv,pver+1),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_mid%ngwv**2+1)*(pver+1)) + allocate(gwut(ncol,pver,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','gwut',ncol*pver*(band_mid%ngwv**2+1)) + allocate(phase_speeds(ncol,-band_mid%ngwv:band_mid%ngwv),stat=istat) + call alloc_err(istat,'gw_tend','tau',ncol*(band_mid%ngwv**2+1)) ! Set up heating call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp) @@ -1431,18 +1929,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 @@ -1479,7 +1977,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) @@ -1488,7 +1986,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 @@ -1498,9 +1996,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) @@ -1516,18 +2017,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 @@ -1560,7 +2061,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) @@ -1569,7 +2070,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 @@ -1589,9 +2090,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 @@ -1601,18 +2105,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 @@ -1649,11 +2153,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 @@ -1663,10 +2167,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 @@ -1685,21 +2193,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 @@ -1736,11 +2244,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 @@ -1750,14 +2258,17 @@ 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. call pbuf_get_field(pbuf, sgh_idx, sgh) - + if (gw_lndscl_sgh) then where (cam_in%landfrac(:ncol) >= epsilon(1._r8)) effgw = effgw_oro * cam_in%landfrac(:ncol) @@ -1770,14 +2281,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 @@ -1789,7 +2300,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) @@ -1838,7 +2349,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 @@ -1856,6 +2367,8 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) mxdis => rdg_mxdis(:ncol,:,lchnk) angll => rdg_angll(:ncol,:,lchnk) anixy => rdg_anixy(:ncol,:,lchnk) + isovar => rdg_isovar(:ncol,lchnk) + isowgt => rdg_isowgt(:ncol,lchnk) where(mxdis < 0._r8) mxdis = 0._r8 @@ -1866,13 +2379,17 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) call outfld('UEGW', u , ncol, lchnk) call outfld('VEGW', v , ncol, lchnk) call outfld('TEGW', t , ncol, lchnk) + call outfld('ZEGW', zi , ncol, lchnk) + call outfld('ZMGW', zm , ncol, lchnk) call gw_rdg_calc(& 'BETA ', ncol, lchnk, n_rdg_beta, dt, & u, v, t, p, piln, zm, zi, & nm, ni, rhoi, kvtt, q, dse, & effgw_rdg_beta, effgw_rdg_beta_max, & + effgw_rdg_resid, use_gw_rdg_resid, & hwdth, clngt, gbxar, mxdis, angll, anixy, & + isovar, isowgt, & rdg_beta_cd_llb, trpd_leewv_rdg_beta, & ptend, flx_heat) @@ -1902,7 +2419,9 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) u, v, t, p, piln, zm, zi, & nm, ni, rhoi, kvtt, q, dse, & effgw_rdg_gamma, effgw_rdg_gamma_max, & + effgw_rdg_resid, use_gw_rdg_resid, & hwdthg, clngtg, gbxar, mxdisg, angllg, anixyg, & + isovar, isowgt, & rdg_gamma_cd_llb, trpd_leewv_rdg_gamma, & ptend, flx_heat) @@ -1922,7 +2441,7 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) ! Write totals to history file. call outfld('EKGW', egwdffi_tot , ncol, lchnk) call outfld('TTGW', ptend%s/cpairv(:,:,lchnk), pcols, lchnk) - + call outfld('UTGW_TOTAL', ptend%u, pcols, lchnk) call outfld('VTGW_TOTAL', ptend%v, pcols, lchnk) @@ -1942,13 +2461,15 @@ subroutine gw_rdg_calc( & u, v, t, p, piln, zm, zi, & nm, ni, rhoi, kvtt, q, dse, & effgw_rdg, effgw_rdg_max, & + effgw_rdg_resid, luse_gw_rdg_resid, & hwdth, clngt, gbxar, & mxdis, angll, anixy, & + isovar, isowgt, & rdg_cd_llb, trpd_leewv, & ptend, flx_heat) use coords_1d, only: Coords1D - use gw_rdg, only: gw_rdg_src, gw_rdg_belowpeak, gw_rdg_break_trap, gw_rdg_do_vdiff + use gw_rdg, only: gw_rdg_src, gw_rdg_resid_src, gw_rdg_belowpeak, gw_rdg_break_trap, gw_rdg_do_vdiff use gw_common, only: gw_drag_prof, energy_change character(len=5), intent(in) :: type ! BETA or GAMMA @@ -1974,6 +2495,8 @@ subroutine gw_rdg_calc( & real(r8), intent(in) :: effgw_rdg ! Tendency efficiency. real(r8), intent(in) :: effgw_rdg_max + real(r8), intent(in) :: effgw_rdg_resid ! Tendency efficiency. + logical, intent(in) :: luse_gw_rdg_resid ! On-Off switch real(r8), intent(in) :: hwdth(ncol,prdg) ! width of ridges. real(r8), intent(in) :: clngt(ncol,prdg) ! length of ridges. real(r8), intent(in) :: gbxar(ncol) ! gridbox area @@ -1982,6 +2505,9 @@ subroutine gw_rdg_calc( & real(r8), intent(in) :: angll(ncol,prdg) ! orientation of ridges. real(r8), intent(in) :: anixy(ncol,prdg) ! Anisotropy parameter. + real(r8), intent(in) :: isovar(ncol) ! sqrt of residual variance + real(r8), intent(in) :: isowgt(ncol) ! area frac of residual variance + real(r8), intent(in) :: rdg_cd_llb ! Drag coefficient for low-level flow logical, intent(in) :: trpd_leewv @@ -1991,13 +2517,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) @@ -2074,6 +2600,8 @@ subroutine gw_rdg_calc( & real(r8) :: taurx0(ncol,pver+1) real(r8) :: taury(ncol,pver+1) real(r8) :: taury0(ncol,pver+1) + ! Provisional absolute wave stress from gw_drag_prof + real(r8) :: tau_diag(ncol,pver+1) ! U,V tendency accumulators real(r8) :: utrdg(ncol,pver) @@ -2088,49 +2616,54 @@ 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 - taury = 0._r8 + taury = 0._r8 ttrdg = 0._r8 utrdg = 0._r8 vtrdg = 0._r8 + tau_diag = -9999._r8 do nn = 1, n_rdg - kwvrdg = 0.001_r8 / ( hwdth(:,nn) + 0.001_r8 ) ! this cant be done every time step !!! - isoflag = 0 + isoflag = 0 effgw = effgw_rdg * ( hwdth(1:ncol,nn)* clngt(1:ncol,nn) ) / gbxar(1:ncol) effgw = min( effgw_rdg_max , effgw ) 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) + src_level, tend_level, bwv_level, tlb_level, tau, ubm, ubi, xv, yv, & + 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, & + t, mxdis(:,nn), anixy(:,nn), kwvrdg, & zi, nm, ni, rhoi, & - src_level, tau, & - ubmsrc, nsrc, rsrc, m2src, tlb, bwv, Fr1, Fr2, Frx, & + src_level, tau, & + ubmsrc, nsrc, rsrc, m2src, tlb, bwv, Fr1, Fr2, Frx, & tauoro, taudsw, hdspwv, hdspdw) + call gw_rdg_break_trap(ncol, band_oro, & - zi, nm, ni, ubm, ubi, rhoi, kwvrdg , bwv, tlb, wbr, & - src_level, tlb_level, hdspwv, hdspdw, mxdis(:,nn), & - tauoro, taudsw, tau, & + zi, nm, ni, ubm, ubi, rhoi, kwvrdg , bwv, tlb, wbr, & + src_level, tlb_level, hdspwv, hdspdw, mxdis(:,nn), & + tauoro, taudsw, tau, & ldo_trapped_waves=trpd_leewv) - + + 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 ) + kwvrdg=kwvrdg, & + satfac_in = 1._r8, lapply_vdiff=gw_rdg_do_vdiff , tau_diag=tau_diag ) ! Add the tendencies from each ridge to the totals. do k = 1, pver @@ -2158,6 +2691,27 @@ subroutine gw_rdg_calc( & end do if (nn == 1) then + call outfld('BWV_HT1', bwv, ncol, lchnk) + call outfld('TLB_HT1', tlb, ncol, lchnk) + call outfld('WBR_HT1', wbr, ncol, lchnk) + call outfld('TAUDSW1', taudsw, ncol, lchnk) + call outfld('TAUORO1', tauoro, ncol, lchnk) + call outfld('UBMSRC1', ubmsrc, ncol, lchnk) + call outfld('USRC1', usrc, ncol, lchnk) + call outfld('VSRC1', vsrc, ncol, lchnk) + call outfld('NSRC1' , nsrc, ncol, lchnk) + ! Froude numbers + call outfld('Fr1_DIAG' , Fr1, ncol, lchnk) + call outfld('Fr2_DIAG' , Fr2, ncol, lchnk) + call outfld('Frx_DIAG' , Frx, ncol, lchnk) + ! Ridge quantities - don't change. Written for convenience + call outfld('MXDIS1' , mxdis(:,nn) , ncol, lchnk) + call outfld('ANGLL1' , angll(:,nn) , ncol, lchnk) + call outfld('ANIXY1' , anixy(:,nn) , ncol, lchnk) + call outfld('HWDTH1' , hwdth(:,nn) , ncol, lchnk) + call outfld('CLNGT1' , clngt(:,nn) , ncol, lchnk) + call outfld('GBXAR1' , gbxar , ncol, lchnk) + call outfld('TAUM1_DIAG' , tau_diag , ncol, lchnk) call outfld('TAU1RDG'//trim(type)//'M', tau(:,0,:), ncol, lchnk) call outfld('UBM1'//trim(type), ubm, ncol, lchnk) call outfld('UBT1RDG'//trim(type), gwut, ncol, lchnk) @@ -2173,13 +2727,70 @@ subroutine gw_rdg_calc( & end do ! end of loop over multiple ridges + call outfld('TAUARDG'//trim(type)//'X', taurx, ncol, lchnk) + call outfld('TAUARDG'//trim(type)//'Y', taury, ncol, lchnk) + + if (luse_gw_rdg_resid) then + ! Add additional GW from residual variance. Assumed isotropic + kwvrdg = 0.001_r8 / ( 100._r8 ) + effgw = effgw_rdg_resid * isowgt + tauoro = 0._r8 + + call gw_rdg_resid_src(ncol, band_oro, p, & + u, v, t, isovar, kwvrdg, zi, nm, & + src_level, tend_level, tau, ubm, ubi, xv, yv, & + ubmsrc, usrc, vsrc, nsrc, rsrc, m2src, phase_speeds, tauoro ) + + call gw_drag_prof(ncol, band_oro, 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, & + kwvrdg=kwvrdg, & + satfac_in = 1._r8, lapply_vdiff=gw_rdg_do_vdiff , tau_diag=tau_diag ) + + ! Add the tendencies from isotropic residual to the totals. + do k = 1, pver + ! diagnostics + utrdg(:,k) = utrdg(:,k) + utgw(:,k) + vtrdg(:,k) = vtrdg(:,k) + vtgw(:,k) + ttrdg(:,k) = ttrdg(:,k) + ttgw(:,k) + ! physics tendencies + ptend%u(:ncol,k) = ptend%u(:ncol,k) + utgw(:,k) + ptend%v(:ncol,k) = ptend%v(:ncol,k) + vtgw(:,k) + ptend%s(:ncol,k) = ptend%s(:ncol,k) + ttgw(:,k) + end do + + 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 + + do k = 1, pver+1 + taurx0(:,k) = tau(:,0,k)*xv + taury0(:,k) = tau(:,0,k)*yv + taurx(:,k) = taurx(:,k) + taurx0(:,k) + taury(:,k) = taury(:,k) + taury0(:,k) + end do + + call outfld('TAUDIAG_RESID', tau_diag, ncol, lchnk) + call outfld('TAUORO_RESID', tauoro , ncol, lchnk) + call outfld('TAURESID'//trim(type)//'M', tau(:,0,:), ncol, lchnk) + call outfld('TAURESID'//trim(type)//'X', taurx, ncol, lchnk) + call outfld('TAURESID'//trim(type)//'Y', taury, ncol, lchnk) + + call outfld('UBMRESID'//trim(type), ubm, ncol, lchnk) + call outfld('UBIRESID'//trim(type), ubi, ncol, lchnk) + call outfld('SRC_LEVEL_RESID'//trim(type), real(src_level, r8) , ncol, lchnk) + ! end of residual variance calc + end if + ! Calculate energy change for output to CAM's energy checker. call energy_change(dt, p, u, v, ptend%u(:ncol,:), & ptend%v(:ncol,:), ptend%s(:ncol,:), de) flx_heat(:ncol) = de - call outfld('TAUARDG'//trim(type)//'X', taurx, ncol, lchnk) - call outfld('TAUARDG'//trim(type)//'Y', taury, ncol, lchnk) if (trim(type) == 'BETA') then fname(1) = 'TAUGWX' @@ -2202,7 +2813,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 @@ -2236,25 +2847,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. @@ -2280,9 +2891,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. @@ -2292,7 +2903,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) @@ -2314,7 +2925,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 @@ -2327,7 +2938,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) @@ -2379,7 +2990,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 @@ -2413,12 +3024,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..2240042ce2 --- /dev/null +++ b/src/physics/cam/gw_movmtn.F90 @@ -0,0 +1,502 @@ +module gw_movmtn + +! +! This module parameterizes gravity waves generated by the obstacle effect produced by +! internal circulations in the atmosphere. +! + +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, vorticity, & + zm, alpha_gw_movmtn, movmtn_source, ksteer_in, klaunch_in, & + src_level, tend_level, tau, ubm, ubi, xv, yv, & + c, hdepth) +!----------------------------------------------------------------------- +! Flexible driver for gravity wave source from obstacle effects produced +! by internal circulations +!----------------------------------------------------------------------- + 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) + ! Relative vorticity + real(r8), intent(in) :: vorticity(ncol,pver) + ! 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 + ! code for source of gw: 1=vorticity, 2=upwp + integer, intent(in) :: movmtn_source + ! Steering level and launch level inputs + integer, intent(in) :: ksteer_in, klaunch_in + + ! 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) + ! GW Flux source + real(r8) :: xpwp_src(ncol) + ! Manual steering level set + integer :: Steer_k(ncol), Launch_k(ncol) + ! Set source (1=vorticity, 2=PBL mom fluxes) + integer :: source_type + + !---------------------------------------------------------------------- + ! Initialize tau array + !---------------------------------------------------------------------- + tau = 0.0_r8 + hdepth = 0.0_r8 + q0 = 0.0_r8 + tau0 = 0.0_r8 + + source_type=movmtn_source + if ( source_type==1 ) then + !---------------------------------------------------------------------- + ! Calculate flux source from vorticity + !---------------------------------------------------------------------- + call vorticity_flux_src( vorticity, ncol, pver , alpha_gw_movmtn, xpwp_src, Steer_k, Launch_k ) + else if ( source_type==2 ) then + !---------------------------------------------------------------------- + ! Calculate flux source from ShCu/PBL and set Steering level + !---------------------------------------------------------------------- + call shcu_flux_src( xpwp_shcu, ncol, pver+1, alpha_gw_movmtn, xpwp_src, Steer_k, Launch_k ) + end if + + !------------------------------------------------- + ! Override steering and launch levels if inputs>0 + !------------------------------------------------- + if (klaunch_in > 0) then + Launch_k(:ncol) = klaunch_in + end if + if (ksteer_in > 0) then + Steer_k(:ncol) = ksteer_in + end if + + !------------------------------------------------------------------------ + ! Determine wind and unit vectors at the steering level) then + ! project winds. + !------------------------------------------------------------------------ + do i=1,ncol + usteer(i) = u(i, Steer_k(i) ) + vsteer(i) = v(i, Steer_k(i) ) + steer_level(i) = real(Steer_k(i),r8) + end do + ! 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=Launch_k ! set in source subr + 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 + +!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine shcu_flux_src (xpwp_shcu , ncol, pverx, alpha_gw_movmtn, xpwp_src, steering_level, launch_level ) + integer, intent(in) :: ncol,pverx + real(r8), intent(in) :: xpwp_shcu (ncol,pverx) + real(r8), intent(in) :: alpha_gw_movmtn + + real(r8), intent(out) :: xpwp_src(ncol) + integer, intent(out) :: steering_level(ncol), launch_level(ncol) + + integer :: k, nlayers + + steering_level(:ncol) = (pverx-1) - 5 !++ tuning test 12/30/24 + launch_level(:ncol) = steering_level -10 !++ tuning test 01/05/25 + + !----------------------------------- + ! 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 subroutine shcu_flux_src + +!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine vorticity_flux_src (vorticity , ncol, pverx, alpha_gw_movmtn, vort_src, steering_level, launch_level ) + integer, intent(in) :: ncol,pverx + real(r8), intent(in) :: vorticity (ncol,pverx) + real(r8), intent(in) :: alpha_gw_movmtn + + real(r8), intent(out) :: vort_src(ncol) + integer, intent(out) :: steering_level(ncol), launch_level(ncol) + + real(r8) :: scale_factor + integer :: k, nlayers + + steering_level(:ncol) = pverx - 20 + launch_level(:ncol) = steering_level -10 + + scale_factor = 1.e4_r8 ! scales vorticity amp to u'w' in CLUBB + !----------------------------------- + ! Simple average over layers. + ! Probably can do better + !----------------------------------- + nlayers=10 + vort_src(:) =0._r8 + do k = 0, nlayers-1 + vort_src(:) = vort_src(:) + scale_factor * abs( vorticity(:,pverx-k) ) + end do + vort_src(:) = alpha_gw_movmtn * vort_src(:)/nlayers + +end subroutine vorticity_flux_src + +end module gw_movmtn diff --git a/src/physics/cam/gw_rdg.F90 b/src/physics/cam/gw_rdg.F90 index 6d1a56db93..4e91db565a 100644 --- a/src/physics/cam/gw_rdg.F90 +++ b/src/physics/cam/gw_rdg.F90 @@ -19,6 +19,7 @@ module gw_rdg ! Public interface public :: gw_rdg_readnl public :: gw_rdg_src +public :: gw_rdg_resid_src public :: gw_rdg_belowpeak public :: gw_rdg_break_trap public :: gw_rdg_do_vdiff @@ -51,7 +52,7 @@ module gw_rdg -! NOTE: Critical inverse Froude number Fr_c is +! NOTE: Critical inverse Froude number Fr_c is ! 1./(SQRT(2.)~0.707 in SM2000 ! (should be <= 1) real(r8), protected :: Fr_c @@ -92,10 +93,10 @@ subroutine gw_rdg_readnl(nlfile) logical :: gw_rdg_do_divstream, gw_rdg_do_smooth_regimes, gw_rdg_do_adjust_tauoro, & gw_rdg_do_backward_compat - + real(r8) :: gw_rdg_C_BetaMax_DS, gw_rdg_C_GammaMax, & gw_rdg_Frx0, gw_rdg_Frx1, gw_rdg_C_BetaMax_SM, gw_rdg_Fr_c, & - gw_rdg_orohmin, gw_rdg_orovmin, gw_rdg_orostratmin, gw_rdg_orom2min + gw_rdg_orohmin, gw_rdg_orovmin, gw_rdg_orostratmin, gw_rdg_orom2min namelist /gw_rdg_nl/ gw_rdg_do_divstream, gw_rdg_C_BetaMax_DS, gw_rdg_C_GammaMax, & gw_rdg_Frx0, gw_rdg_Frx1, gw_rdg_C_BetaMax_SM, gw_rdg_Fr_c, & @@ -119,7 +120,7 @@ subroutine gw_rdg_readnl(nlfile) call freeunit(unitn) ! Set the local variables - do_divstream = gw_rdg_do_divstream + do_divstream = gw_rdg_do_divstream C_BetaMax_DS = gw_rdg_C_BetaMax_DS C_GammaMax = gw_rdg_C_GammaMax Frx0 = gw_rdg_Frx0 @@ -175,9 +176,213 @@ subroutine gw_rdg_readnl(nlfile) end subroutine gw_rdg_readnl +!========================================================================== +subroutine gw_rdg_resid_src(ncol, band, p, & + u, v, t, mxdis, kwvrdg, zi, nm, & + src_level, tend_level, tau, ubm, ubi, xv, yv, & + ubmsrc, usrc, vsrc, nsrc, rsrc, m2src, c, tauoro ) + use gw_common, only: rair, GWBand + use gw_utils, only: dot_2d, midpoint_interp, get_unit_vector + !----------------------------------------------------------------------- + ! Orographic source for multiple gravity wave drag parameterization. + ! + ! The stress is returned for a single wave with c=0, over orography. + ! For points where the orographic variance is small (including ocean), + ! the returned stress is zero. + !------------------------------Arguments-------------------------------- + ! Column dimension. + integer, intent(in) :: ncol + + ! Band to emit orographic waves in. + ! Regardless, we will only ever emit into l = 0. + type(GWBand), intent(in) :: band + ! Pressure coordinates. + type(Coords1D), intent(in) :: p + + + ! Midpoint zonal/meridional winds. ( m s-1) + real(r8), intent(in) :: u(ncol,pver), v(ncol,pver) + ! Midpoint temperatures. (K) + real(r8), intent(in) :: t(ncol,pver) + ! Height estimate for ridge (m) [anisotropic orography]. + real(r8), intent(in) :: mxdis(ncol) + ! horiz wavenumber [anisotropic orography]. + real(r8), intent(in) :: kwvrdg(ncol) + ! Interface altitudes above ground (m). + real(r8), intent(in) :: zi(ncol,pver+1) + ! Midpoint Brunt-Vaisalla frequencies (s-1). + real(r8), intent(in) :: nm(ncol,pver) + + ! 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) + + ! Averages over source region. + real(r8), intent(out) :: nsrc(ncol) ! B-V frequency. + real(r8), intent(out) :: rsrc(ncol) ! Density. + real(r8), intent(out) :: usrc(ncol) ! Zonal wind. + real(r8), intent(out) :: vsrc(ncol) ! Meridional wind. + real(r8), intent(out) :: ubmsrc(ncol) ! On-obstacle wind. + ! normalized wavenumber + real(r8), intent(out) :: m2src(ncol) + + + ! Wave Reynolds stress. + real(r8), intent(out) :: tau(ncol,-band%ngwv:band%ngwv,pver+1) + ! 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) + ! Phase speeds. + real(r8), intent(out) :: c(ncol,-band%ngwv:band%ngwv) + ! source level mom. flux + real(r8), intent(out) :: tauoro(ncol) + + !---------------------------Local Storage------------------------------- + ! Column and level indices. + integer :: i, k + + ! Surface streamline displacement height (2*sgh). + real(r8) :: hdsp(ncol) + + ! Difference in interface pressure across source region. + real(r8) :: dpsrc(ncol) + ! Thickness of downslope wind region. + real(r8) :: ddw(ncol) + ! Thickness of linear wave region. + real(r8) :: dwv(ncol) + ! Wind speed in source region. + real(r8) :: wmsrc(ncol) + + real(r8) :: ragl(ncol) + real(r8) :: Fcrit_res,sghmax + +!-------------------------------------------------------------------------- +! Check that ngwav is equal to zero, otherwise end the job +!-------------------------------------------------------------------------- + if (band%ngwv /= 0) call endrun(' gw_rdg_src :: ERROR - band%ngwv must be zero and it is not') + +!-------------------------------------------------------------------------- +! Average the basic state variables for the wave source over the depth of +! the orographic standard deviation. Here we assume that the appropiate +! values of wind, stability, etc. for determining the wave source are +! averages over the depth of the atmosphere penterated by the typical +! mountain. +! Reduces to the bottom midpoint values when mxdis=0, such as over ocean. +!-------------------------------------------------------------------------- + + Fcrit_res = 1.0_r8 + hdsp = mxdis ! no longer multipied by 2 + where(hdsp < 10._r8) + hdsp = 0._r8 + end where + + src_level = pver+1 + + tau(:,0,:) = 0.0_r8 + + ! Find depth of "source layer" for mountain waves + ! i.e., between ground and mountain top + do k = pver, 1, -1 + do i = 1, ncol + ! Need to have h >= z(k+1) here or code will bomb when h=0. + if ( (hdsp(i) >= zi(i,k+1)) .and. (hdsp(i) < zi(i,k)) ) then + src_level(i) = k + end if + end do + end do + + rsrc = 0._r8 + usrc = 0._r8 + vsrc = 0._r8 + nsrc = 0._r8 + do i = 1, ncol + do k = pver, src_level(i), -1 + rsrc(i) = rsrc(i) + p%mid(i,k) / (rair*t(i,k))* p%del(i,k) + usrc(i) = usrc(i) + u(i,k) * p%del(i,k) + vsrc(i) = vsrc(i) + v(i,k) * p%del(i,k) + nsrc(i) = nsrc(i) + nm(i,k)* p%del(i,k) + end do + end do + + + do i = 1, ncol + dpsrc(i) = p%ifc(i,pver+1) - p%ifc(i,src_level(i)) + end do + + rsrc = rsrc / dpsrc + usrc = usrc / dpsrc + vsrc = vsrc / dpsrc + nsrc = nsrc / dpsrc + + ! Get the unit vector components and magnitude at the surface. + call get_unit_vector(usrc, vsrc, xv, yv, wmsrc ) + + ubmsrc = wmsrc + + ! Project the local wind at midpoints onto the source wind. + do k = 1, pver + ubm(:,k) = dot_2d(u(:,k), v(:,k), xv, yv) + end do + + ! Compute the interface wind projection by averaging the midpoint winds. + ! Use the top level wind at the top interface. + ubi(:,1) = ubm(:,1) + + ubi(:,2:pver) = midpoint_interp(ubm) + + ! The minimum stratification allowing GW behavior + ! should really depend on horizontal scale since + ! + ! m^2 ~ (N/U)^2 - k^2 + ! + + m2src = ( (nsrc/(ubmsrc+0.01_r8))**2 - kwvrdg**2 ) /((nsrc/(ubmsrc+0.01_r8))**2) + + ! Compute the interface wind projection by averaging the midpoint winds. + ! Use the top level wind at the top interface. + ubi(:,1) = ubm(:,1) + ubi(:,2:pver) = midpoint_interp(ubm) + ubi(:,pver+1) = ubm(:,pver) + + + + ! Determine the orographic c=0 source term following McFarlane (1987). + ! (DOI: https://doi.org/10.1175/1520-0469(1987)044<1775:TEOOEG>2.0.CO;2) + ! Set the source top interface index to pver, if the orographic term is + ! zero. + do i = 1, ncol + if ( ( src_level(i) > 0 ) .and. ( m2src(i) > orom2min ) ) then + sghmax = Fcrit_res * (ubmsrc(i) / nsrc(i))**2 + tauoro(i) = 0.5_r8 * kwvrdg(i) * min(hdsp(i)**2, sghmax) * & + rsrc(i) * nsrc(i) * ubmsrc(i) + else + tauoro(i) = 0._r8 + end if + end do + + do i = 1, ncol + do k=src_level(i),pver+1 + tau(i,0,k) = tauoro(i) + end do + end do + + + ! Allow wind tendencies all the way to the model bottom. + tend_level = pver + + ! No spectrum; phase speed is just 0. + c = 0._r8 + +end subroutine gw_rdg_resid_src + + +!========================================================================== + subroutine gw_rdg_src(ncol, band, p, & u, v, t, mxdis, angxy, anixy, kwvrdg, iso, zi, nm, & - src_level, tend_level, bwv_level ,tlb_level , tau, ubm, ubi, xv, yv, & + 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) use gw_common, only: rair, GWBand use gw_utils, only: dot_2d, midpoint_interp @@ -264,8 +469,8 @@ subroutine gw_rdg_src(ncol, band, p, & ! Wind speed in source region. real(r8) :: wmsrc(ncol) - real(r8) :: ragl(ncol) - + real(r8) :: ragl(ncol) + !-------------------------------------------------------------------------- ! Check that ngwav is equal to zero, otherwise end the job !-------------------------------------------------------------------------- @@ -293,13 +498,13 @@ subroutine gw_rdg_src(ncol, band, p, & do i = 1, ncol ! Need to have h >= z(k+1) here or code will bomb when h=0. if ( (hdsp(i) >= zi(i,k+1)) .and. (hdsp(i) < zi(i,k)) ) then - src_level(i) = k + src_level(i) = k end if end do end do rsrc = 0._r8 - usrc = 0._r8 + usrc = 0._r8 vsrc = 0._r8 nsrc = 0._r8 do i = 1, ncol @@ -329,7 +534,7 @@ subroutine gw_rdg_src(ncol, band, p, & ragl = angxy * pii/180._r8 - ! protect from wierd "bad" angles + ! protect from wierd "bad" angles ! that may occur if hdsp is zero where( hdsp <= orohmin ) ragl = 0._r8 @@ -341,7 +546,7 @@ subroutine gw_rdg_src(ncol, band, p, & ! Kluge in possible "isotropic" obstacle. where( ( iso == 1 ) .and. (wmsrc > orovmin) ) - xv = usrc/wmsrc + xv = usrc/wmsrc yv = vsrc/wmsrc end where @@ -357,7 +562,7 @@ subroutine gw_rdg_src(ncol, band, p, & ubm(:,k) = sign( ubmsrc*0._r8+1._r8 , ubmsrc ) * ubm(:,k) end do - ! Sean says just use 1._r8 as + ! Sean says just use 1._r8 as ! first argument xv = sign( ubmsrc*0._r8+1._r8 , ubmsrc ) * xv yv = sign( ubmsrc*0._r8+1._r8 , ubmsrc ) * yv @@ -366,7 +571,7 @@ subroutine gw_rdg_src(ncol, band, p, & ! against zero ubmsrc = abs(ubmsrc) ubmsrc = max( 0.01_r8 , ubmsrc ) - + ! The minimum stratification allowing GW behavior ! should really depend on horizontal scale since @@ -374,9 +579,9 @@ subroutine gw_rdg_src(ncol, band, p, & ! m^2 ~ (N/U)^2 - k^2 ! ! Should also think about parameterizing - ! trapped lee-waves. + ! trapped lee-waves. + - ! This needs to be made constistent with later ! treatment of nonhydrostatic effects. m2src = ( (nsrc/(ubmsrc+0.01_r8))**2 - kwvrdg**2 ) /((nsrc/(ubmsrc+0.01_r8))**2) @@ -387,9 +592,9 @@ subroutine gw_rdg_src(ncol, band, p, & ! will modified later if wave breaking or trapping are ! diagnosed ! - ! ^ + ! ^ ! | *** linear propagation *** - ! (H) -------- mountain top ------------- | *** or wave breaking **** + ! (H) -------- mountain top ------------- | *** or wave breaking **** ! | *** regimes ************* ! (BWV)------ bottom of linear waves ---- | ! : | @@ -397,7 +602,7 @@ subroutine gw_rdg_src(ncol, band, p, & ! : | ! (TLB)--- top of flow diversion layer--- ' ! : - ! **** flow diversion ***** + ! **** flow diversion ***** ! : !============================================ @@ -406,17 +611,17 @@ subroutine gw_rdg_src(ncol, band, p, & !-------------------------------------------- ! High-drag downslope wind regime exists ! between bottom of linear waves and top of - ! flow diversion. Linear waves can only + ! flow diversion. Linear waves can only ! attain vertical displacment of f1*U/N. So, ! bottom of linear waves is given by ! - ! BWV = H - Fr1*U/N + ! BWV = H - Fr1*U/N ! - ! Downslope wind layer begins at BWV and + ! Downslope wind layer begins at BWV and ! extends below it until some maximum high ! drag obstacle height Fr2*U/N is attained ! (where Fr2 >= f1). Below downslope wind - ! there is flow diversion, so top of + ! there is flow diversion, so top of ! diversion layer (TLB) is equivalent to ! bottom of downslope wind layer and is; ! @@ -431,27 +636,27 @@ subroutine gw_rdg_src(ncol, band, p, & if ( do_divstream ) then !------------------------------------------------ - ! Calculate Fr2(Frx) for DS2017 + ! Calculate Fr2(Frx) for DS2017 !------------------------------------------------ where(Frx <= Frx0) Fr2(:) = Fr1(:) + Fr1(:)* C_GammaMax * anixy(:) elsewhere((Frx > Frx0).and.(Frx <= Frx1) ) Fr2(:) = Fr1(:) + Fr1(:)* C_GammaMax * anixy(:) & - * (Frx1 - Frx(:))/(Frx1-Frx0) - elsewhere(Frx > Frx1) + * (Frx1 - Frx(:))/(Frx1-Frx0) + elsewhere(Frx > Frx1) Fr2(:)=Fr1(:) endwhere else - !------------------------------------------ + !------------------------------------------ ! Regime distinctions entirely carried by ! amplification of taudsw (next subr) !------------------------------------------ Fr2(:)=Fr1(:) - end if + end if - - where( m2src > orom2min ) + + where( m2src > orom2min ) ddw = Fr2 * ( abs(ubmsrc) )/nsrc elsewhere ddw = 0._r8 @@ -475,7 +680,7 @@ subroutine gw_rdg_src(ncol, band, p, & ! Find *BOTTOM* of linear wave layer (BWV) !where ( nsrc > orostratmin ) - where( m2src > orom2min ) + where( m2src > orom2min ) dwv = Fr1 * ( abs(ubmsrc) )/nsrc elsewhere dwv = -9.999e9_r8 ! if weak strat - no waves @@ -507,7 +712,7 @@ subroutine gw_rdg_src(ncol, band, p, & ! No spectrum; phase speed is just 0. c = 0._r8 - where( m2src < orom2min ) + where( m2src < orom2min ) tlb = mxdis tlb_level = src_level endwhere @@ -520,8 +725,8 @@ end subroutine gw_rdg_src subroutine gw_rdg_belowpeak(ncol, band, rdg_cd_llb, & t, mxdis, anixy, kwvrdg, zi, nm, ni, rhoi, & - src_level , tau, & - ubmsrc, nsrc, rsrc, m2src,tlb,bwv,Fr1,Fr2,Frx, & + src_level , tau, & + ubmsrc, nsrc, rsrc, m2src,tlb,bwv,Fr1,Fr2,Frx, & tauoro,taudsw, hdspwv,hdspdw ) use gw_common, only: GWBand @@ -564,9 +769,9 @@ subroutine gw_rdg_belowpeak(ncol, band, rdg_cd_llb, & ! Wave Reynolds stress. real(r8), intent(inout) :: tau(ncol,-band%ngwv:band%ngwv,pver+1) ! Top of low-level flow layer. - real(r8), intent(inout) :: tlb(ncol) + real(r8), intent(in) :: tlb(ncol) ! Bottom of linear wave region. - real(r8), intent(inout) :: bwv(ncol) + real(r8), intent(in) :: bwv(ncol) ! surface stress from linear waves. real(r8), intent(out) :: tauoro(ncol) ! surface stress for downslope wind regime. @@ -604,16 +809,16 @@ subroutine gw_rdg_belowpeak(ncol, band, rdg_cd_llb, & end do do i = 1, ncol - if ( m2src(i) > orom2min ) then + if ( m2src(i) > orom2min ) then hdspwv(i) = min( mxdis(i) , Fr1(i) * ubsrcx(i) / nsrc(i) ) else hdspwv(i) = 0._r8 end if end do - + if (do_divstream) then do i = 1, ncol - if ( m2src(i) > orom2min ) then + if ( m2src(i) > orom2min ) then hdspdw(i) = min( mxdis(i) , Fr2(i) * ubsrcx(i) / nsrc(i) ) else hdspdw(i) = 0._r8 @@ -622,8 +827,8 @@ subroutine gw_rdg_belowpeak(ncol, band, rdg_cd_llb, & else do i = 1, ncol ! Needed only to mark where a DSW occurs - if ( m2src(i) > orom2min ) then - hdspdw(i) = mxdis(i) + if ( m2src(i) > orom2min ) then + hdspdw(i) = mxdis(i) else hdspdw(i) = 0._r8 end if @@ -637,14 +842,14 @@ subroutine gw_rdg_belowpeak(ncol, band, rdg_cd_llb, & ! Determine the orographic c=0 source term following McFarlane (1987). ! Set the source top interface index to pver, if the orographic term is ! zero. - ! + ! ! This formula is basically from ! ! tau(src) = rho * u' * w' - ! where + ! where ! u' ~ N*h' and w' ~ U*h'/b (b="breite") ! - ! and 1/b has been replaced with k (kwvrdg) + ! and 1/b has been replaced with k (kwvrdg) ! do i = 1, ncol if ( ( src_level(i) > 0 ) .and. ( m2src(i) > orom2min ) ) then @@ -680,7 +885,7 @@ subroutine gw_rdg_belowpeak(ncol, band, rdg_cd_llb, & ! Amplify DSW between Frx=1. and Frx=Frx1 do i = 1,ncol dswamp=0._r8 - BetaMax = C_BetaMax_DS * anixy(i) + BetaMax = C_BetaMax_DS * anixy(i) if ( (Frx(i)>1._r8).and.(Frx(i)<=Frx1)) then dswamp = (Frx(i)-1._r8)*(Frx1-Frx(i))/(0.25_r8*(Frx1-1._r8)**2) end if @@ -691,30 +896,30 @@ subroutine gw_rdg_belowpeak(ncol, band, rdg_cd_llb, & ! Scinocca&McFarlane !-------------------- do i = 1, ncol - BetaMax = C_BetaMax_SM * anixy(i) + BetaMax = C_BetaMax_SM * anixy(i) if ( (Frx(i) >=1._r8) .and. (Frx(i) < 1.5_r8) ) then dswamp = 2._r8 * BetaMax * (Frx(i) -1._r8) else if ( ( Frx(i) >= 1.5_r8 ) .and. (Frx(i) < 3._r8 ) ) then - dswamp = ( 1._r8 + BetaMax - (0.666_r8**2) ) * ( 0.666_r8*(3._r8 - Frx(i) ))**2 & + dswamp = ( 1._r8 + BetaMax - (0.666_r8**2) ) * ( 0.666_r8*(3._r8 - Frx(i) ))**2 & + ( 1._r8 / Frx(i) )**2 -1._r8 else - dswamp = 0._r8 + dswamp = 0._r8 end if if ( (Frx(i) >=1._r8) .and. (Frx(i) < 3._r8) ) then taudsw(i) = (1._r8 + dswamp )*taulin(i) - tauoro(i) else - taudsw(i) = 0._r8 + taudsw(i) = 0._r8 endif ! This code defines "taudsw" as SUM of freely-propagating ! DSW enhancement. Different than in SM2000 - taudsw(i) = taudsw(i) + tauoro(i) + taudsw(i) = taudsw(i) + tauoro(i) end do !---------------------------------------------------- end if - + do i = 1, ncol - if ( m2src(i) > orom2min ) then + if ( m2src(i) > orom2min ) then where ( ( zi(i,:) < mxdis(i) ) .and. ( zi(i,:) >= bwv(i) ) ) tau(i,0,:) = tauoro(i) else where ( ( zi(i,:) < bwv(i) ) .and. ( zi(i,:) >= tlb(i) ) ) @@ -728,7 +933,7 @@ subroutine gw_rdg_belowpeak(ncol, band, rdg_cd_llb, & tau(i,0,:) = taudsw(i) + & Coeff_LB(i) * kwvrdg(i) * rsrc(i) * 0.5_r8 * (ubsrcx(i)**2) * ( tlb(i) - zi(i,:) ) endwhere - + if (do_smooth_regimes) then ! This blocks accounts for case where both mxdis and tlb fall ! between adjacent edges @@ -739,7 +944,7 @@ subroutine gw_rdg_belowpeak(ncol, band, rdg_cd_llb, & tau(i,0,k) = tauoro(i) end if end do - end if + end if else !---------------------------------------------- ! This block allows low-level dynamics to occur @@ -758,11 +963,11 @@ subroutine gw_rdg_belowpeak(ncol, band, rdg_cd_llb, & k=src_level(i) if ( ni(i,k) > orostratmin ) then tausat = (Fr_c**2) * kwvrdg(i) * rhoi(i,k) * ubsrcx(i)**3 / & - (1._r8*ni(i,k)) + (1._r8*ni(i,k)) else tausat = 0._r8 - endif - tau(i,0,src_level(i)) = min( tauoro(i), tausat ) + endif + tau(i,0,src_level(i)) = min( tauoro(i), tausat ) end do @@ -770,18 +975,18 @@ subroutine gw_rdg_belowpeak(ncol, band, rdg_cd_llb, & ! Final clean-up. Do nothing if obstacle less than orohmin do i = 1, ncol if ( mxdis(i) < orohmin ) then - tau(i,0,:) = 0._r8 + tau(i,0,:) = 0._r8 tauoro(i) = 0._r8 taudsw(i) = 0._r8 - endif + endif end do - ! Disable vertical propagation if Scorer param is + ! Disable vertical propagation if Scorer param is ! too small. do i = 1, ncol if ( m2src(i) <= orom2min ) then src_level(i)=1 - endif + endif end do @@ -790,10 +995,10 @@ end subroutine gw_rdg_belowpeak !========================================================================== subroutine gw_rdg_break_trap(ncol, band, & - zi, nm, ni, ubm, ubi, rhoi, kwvrdg, bwv, tlb, wbr, & - src_level, tlb_level, & + zi, nm, ni, ubm, ubi, rhoi, kwvrdg, bwv, tlb, wbr, & + src_level, tlb_level, & hdspwv, hdspdw, mxdis, & - tauoro, taudsw, tau, & + tauoro, taudsw, tau, & ldo_trapped_waves, wdth_kwv_scale_in ) use gw_common, only: GWBand !----------------------------------------------------------------------- @@ -824,7 +1029,8 @@ subroutine gw_rdg_break_trap(ncol, band, & ! Wave Reynolds stress. real(r8), intent(inout) :: tau(ncol,-band%ngwv:band%ngwv,pver+1) ! Wave Reynolds stresses at source. - real(r8), intent(inout) :: taudsw(ncol),tauoro(ncol) + real(r8), intent(in) :: taudsw(ncol) + real(r8), intent(inout) :: tauoro(ncol) ! Projection of wind at midpoints and interfaces. real(r8), intent(in) :: ubm(ncol,pver) real(r8), intent(in) :: ubi(ncol,pver+1) @@ -892,7 +1098,7 @@ subroutine gw_rdg_break_trap(ncol, band, & endwhere end do - ! Take square root of m**2 and + ! Take square root of m**2 and ! do vertical integral to find ! WKB phase. !----------------------------- @@ -900,8 +1106,8 @@ subroutine gw_rdg_break_trap(ncol, band, & phswkb(:,:)=0 do k=pver,1,-1 where( zi(:,k) > tlb(:) ) - delz(:) = min( zi(:,k)-zi(:,k+1) , zi(:,k)-tlb(:) ) - phswkb(:,k) = phswkb(:,k+1) + m2(:,k)*delz(:) + delz(:) = min( zi(:,k)-zi(:,k+1) , zi(:,k)-tlb(:) ) + phswkb(:,k) = phswkb(:,k+1) + m2(:,k)*delz(:) endwhere end do @@ -912,9 +1118,9 @@ subroutine gw_rdg_break_trap(ncol, band, & wbrx(:)=0._r8 if (do_smooth_regimes) then do k=pver,1,-1 - where( (phswkb(:,k+1)<1.5_r8*pii).and.(phswkb(:,k)>=1.5_r8*pii) & + where( (phswkb(:,k+1)<1.5_r8*pii).and.(phswkb(:,k)>=1.5_r8*pii) & .and.(hdspdw(:)>hdspwv(:)) ) - wbr(:) = zi(:,k) + wbr(:) = zi(:,k) ! Extrapolation to make regime ! transitions smoother wbrx(:) = zi(:,k) - ( phswkb(:,k) - 1.5_r8*pii ) & @@ -924,7 +1130,7 @@ subroutine gw_rdg_break_trap(ncol, band, & end do else do k=pver,1,-1 - where( (phswkb(:,k+1)<1.5_r8*pii).and.(phswkb(:,k)>=1.5_r8*pii) & + where( (phswkb(:,k+1)<1.5_r8*pii).and.(phswkb(:,k)>=1.5_r8*pii) & .and.(hdspdw(:)>hdspwv(:)) ) wbr(:) = zi(:,k) src_level(:) = k @@ -935,12 +1141,12 @@ subroutine gw_rdg_break_trap(ncol, band, & ! Adjust tauoro at new source levels if needed. ! This is problematic if Fr_c<1.0. Not sure why. !---------------------------------------------------------- - if (do_adjust_tauoro) then + if (do_adjust_tauoro) then do i = 1,ncol if (wbr(i) > 0._r8 ) then - tausat(i) = (Fr_c**2) * kwvrdg(i) * rhoi( i, src_level(i) ) & + tausat(i) = (Fr_c**2) * kwvrdg(i) * rhoi( i, src_level(i) ) & * abs(ubi(i , src_level(i) ))**3 & - / ni( i , src_level(i) ) + / ni( i , src_level(i) ) tauoro(i) = min( tauoro(i), tausat(i) ) end if end do @@ -953,9 +1159,9 @@ subroutine gw_rdg_break_trap(ncol, band, & tau(i,0,k) = tauoro(i) + (taudsw(i)-tauoro(i)) * & ( wbrx(i) - zi(i,k) ) / & ( wbrx(i) - tlb(i) ) - tau(i,0,k) = max( tau(i,0,k), tauoro(i) ) + tau(i,0,k) = max( tau(i,0,k), tauoro(i) ) endif - end do + end do end do else ! Following is for backwards B4B compatibility with earlier versions @@ -968,7 +1174,7 @@ subroutine gw_rdg_break_trap(ncol, band, & ( wbr(i) - zi(i,k) ) / & ( wbr(i) - tlb(i) ) endif - end do + end do end do else do i = 1, ncol @@ -978,13 +1184,13 @@ subroutine gw_rdg_break_trap(ncol, band, & ( wbr(i) - zi(i,k) ) / & ( wbr(i) - tlb(i) ) endif - end do + end do end do end if end if - - if (lldo_trapped_waves) then - + + if (lldo_trapped_waves) then + ! Identify top edge of layer in which Scorer param drops below 0 ! - approximately the "turning level" !---------------------------------------------------------- diff --git a/src/physics/cam/hb_diff.F90 b/src/physics/cam/hb_diff.F90 index f1b67d68a0..a3bb11a17d 100644 --- a/src/physics/cam/hb_diff.F90 +++ b/src/physics/cam/hb_diff.F90 @@ -35,6 +35,7 @@ module hb_diff ! Public interfaces public init_hb_diff public compute_hb_diff + public compute_hb_free_atm_diff public pblintd ! ! PBL limits @@ -131,7 +132,7 @@ end subroutine init_hb_diff !=============================================================================== - subroutine compute_hb_diff(lchnk, ncol, & + subroutine compute_hb_diff(ncol , & th ,t ,q ,z ,zi , & pmid ,u ,v ,taux ,tauy , & shflx ,qflx ,obklen ,ustar ,pblh , & @@ -139,8 +140,8 @@ subroutine compute_hb_diff(lchnk, ncol, & tpert ,qpert ,cldn ,ocnfrac ,tke , & ri , & eddy_scheme) - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: ! Interface routines for calcualtion and diatnostics of turbulence related ! coefficients @@ -155,7 +156,6 @@ subroutine compute_hb_diff(lchnk, ncol, & ! ! Input arguments ! - integer, intent(in) :: lchnk ! chunk index (for debug only) integer, intent(in) :: ncol ! number of atmospheric columns real(r8), intent(in) :: th(pcols,pver) ! potential temperature [K] @@ -196,8 +196,8 @@ subroutine compute_hb_diff(lchnk, ncol, & real(r8) :: rrho(pcols) ! 1./bottom level density real(r8) :: wstar(pcols) ! convective velocity scale [m/s] real(r8) :: kqfs(pcols) ! kinematic surf constituent flux (kg/m2/s) - real(r8) :: khfs(pcols) ! kinimatic surface heat flux - real(r8) :: kbfs(pcols) ! surface buoyancy flux + real(r8) :: khfs(pcols) ! kinimatic surface heat flux + real(r8) :: kbfs(pcols) ! surface buoyancy flux real(r8) :: kvf(pcols,pverp) ! free atmospheric eddy diffsvty [m2/s] real(r8) :: s2(pcols,pver) ! shear squared real(r8) :: n2(pcols,pver) ! brunt vaisaila frequency @@ -236,7 +236,7 @@ subroutine compute_hb_diff(lchnk, ncol, & ! ! Get pbl exchange coefficients ! - call austausch_pbl(lchnk, ncol, & + call austausch_pbl(ncol , & z ,kvf ,kqfs ,khfs ,kbfs , & obklen ,ustar ,wstar ,pblh ,kvm , & kvh ,cgh ,cgs ,tpert ,qpert , & @@ -244,9 +244,95 @@ subroutine compute_hb_diff(lchnk, ncol, & ! kvq(:ncol,:) = kvh(:ncol,:) - - return end subroutine compute_hb_diff + + subroutine compute_hb_free_atm_diff(ncol, & + th ,t ,q ,z , & + pmid ,u ,v ,taux ,tauy , & + shflx ,qflx ,obklen ,ustar , & + kvm ,kvh ,kvq ,cgh ,cgs , & + ri ) + !----------------------------------------------------------------------- + ! + ! This is a version of compute_hb_diff that only computes free + ! atmosphere exchange (no PBL computations) + ! + ! Author: B. Stevens (rewrite August 2000) + ! Modified by Thomas Toniazzo and Peter H. Lauritzen (June 2023) + ! + !----------------------------------------------------------------------- + + use pbl_utils, only: virtem, calc_ustar, calc_obklen, austausch_atm_free + + !------------------------------Arguments-------------------------------- + ! + ! Input arguments + ! + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: th(pcols,pver) ! potential temperature [K] + real(r8), intent(in) :: t(pcols,pver) ! temperature (used for density) + real(r8), intent(in) :: q(pcols,pver) ! specific humidity [kg/kg] + real(r8), intent(in) :: z(pcols,pver) ! height above surface [m] + real(r8), intent(in) :: u(pcols,pver) ! zonal velocity + real(r8), intent(in) :: v(pcols,pver) ! meridional velocity + real(r8), intent(in) :: taux(pcols) ! zonal stress [N/m2] + real(r8), intent(in) :: tauy(pcols) ! meridional stress [N/m2] + real(r8), intent(in) :: shflx(pcols) ! sensible heat flux + real(r8), intent(in) :: qflx(pcols) ! water vapor flux + real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures + ! + ! Output arguments + ! + real(r8), intent(out) :: kvm(pcols,pverp) ! eddy diffusivity for momentum [m2/s] + real(r8), intent(out) :: kvh(pcols,pverp) ! eddy diffusivity for heat [m2/s] + real(r8), intent(out) :: kvq(pcols,pverp) ! eddy diffusivity for constituents [m2/s] + real(r8), intent(out) :: cgh(pcols,pverp) ! counter-gradient term for heat [J/kg/m] + real(r8), intent(out) :: cgs(pcols,pverp) ! counter-gradient star (cg/flux) + real(r8), intent(out) :: ustar(pcols) ! surface friction velocity [m/s] + real(r8), intent(out) :: obklen(pcols) ! Obukhov length + real(r8), intent(out) :: ri(pcols,pver) ! richardson number: n2/s2 + ! + !---------------------------Local workspace----------------------------- + ! + real(r8) :: thv(pcols,pver) ! virtual potential temperature + real(r8) :: rrho(pcols) ! 1./bottom level density + real(r8) :: kqfs(pcols) ! kinematic surf constituent flux (kg/m2/s) + real(r8) :: khfs(pcols) ! kinimatic surface heat flux + real(r8) :: kbfs(pcols) ! surface buoyancy flux + real(r8) :: kvf(pcols,pverp) ! free atmospheric eddy diffsvty [m2/s] + real(r8) :: s2(pcols,pver) ! shear squared + real(r8) :: n2(pcols,pver) ! brunt vaisaila frequency + + ! virtual potential temperature + call virtem(ncol, (pver-ntop_turb+1), th(:ncol,ntop_turb:),q(:ncol,ntop_turb:), thv(:ncol,ntop_turb:)) + + ! Compute ustar, Obukhov length, and kinematic surface fluxes. + call calc_ustar(ncol, t(:ncol,pver),pmid(:ncol,pver),taux(:ncol),tauy(:ncol), & + rrho(:ncol),ustar(:ncol)) + call calc_obklen(ncol, th(:ncol,pver), thv(:ncol,pver), qflx(:ncol), & + shflx(:ncol), rrho(:ncol), ustar(:ncol), & + khfs(:ncol), kqfs(:ncol), kbfs(:ncol), & + obklen(:ncol)) + ! Calculate s2, n2, and Richardson number. + call trbintd(ncol , & + thv ,z ,u ,v , & + s2 ,n2 ,ri ) + ! + ! Get free atmosphere exchange coefficients + ! + call austausch_atm_free(pcols, ncol, pver, ntop_turb, nbot_turb, & + ml2, ri, s2, kvf) + + kvq(:ncol,:) = kvf(:ncol,:) + kvm(:ncol,:) = kvf(:ncol,:) + kvh(:ncol,:) = kvf(:ncol,:) + cgh(:ncol,:) = 0._r8 + cgs(:ncol,:) = 0._r8 + + end subroutine compute_hb_free_atm_diff + + ! !=============================================================================== subroutine trbintd(ncol , & @@ -488,7 +574,7 @@ subroutine pblintd(ncol , & end subroutine pblintd ! !=============================================================================== - subroutine austausch_pbl(lchnk ,ncol , & + subroutine austausch_pbl(ncol , & z ,kvf ,kqfs ,khfs ,kbfs , & obklen ,ustar ,wstar ,pblh ,kvm , & kvh ,cgh ,cgs ,tpert ,qpert , & @@ -524,7 +610,6 @@ subroutine austausch_pbl(lchnk ,ncol , & ! ! Input arguments ! - integer, intent(in) :: lchnk ! local chunk index (for debug only) integer, intent(in) :: ncol ! number of atmospheric columns real(r8), intent(in) :: z(pcols,pver) ! height above surface [m] diff --git a/src/physics/cam/hetfrz_classnuc.F90 b/src/physics/cam/hetfrz_classnuc.F90 index f0afa46525..01ec5a57e5 100644 --- a/src/physics/cam/hetfrz_classnuc.F90 +++ b/src/physics/cam/hetfrz_classnuc.F90 @@ -9,24 +9,25 @@ module hetfrz_classnuc ! hetfrz_classnuc_init ! hetfrz_classnuc_calc ! -! Author: +! Author: ! Corinna Hoose, UiO, May 2009 -! Yong Wang and Xiaohong Liu, UWyo, 12/2012, +! Yong Wang and Xiaohong Liu, UWyo, 12/2012, ! implement in CAM5 and constrain uncertain parameters using natural dust and -! BC(soot) datasets. -! Yong Wang and Xiaohong Liu, UWyo, 05/2013, implement the PDF-contact angle -! approach: Y. Wang et al., Atmos. Chem. Phys., 2014. +! BC(soot) datasets. +! Yong Wang and Xiaohong Liu, UWyo, 05/2013, implement the PDF-contact angle approach: +! Y. Wang et al., Atmos. Chem. Phys., 2014. https://doi.org/10.5194/acp-14-10411-2014 ! Jack Chen, NCAR, 09/2015, modify calculation of dust activation fraction. ! !----------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 -use wv_saturation, only: svp_water, svp_ice +use wv_saturation, only: svp_water use shr_spfn_mod, only: erf => shr_spfn_erf +use physconst, only: pi, planck, boltz, mwso4, amu, pstd + implicit none private -save public :: hetfrz_classnuc_init, hetfrz_classnuc_calc @@ -36,10 +37,9 @@ module hetfrz_classnuc real(r8) :: rhoh2o real(r8) :: mwh2o real(r8) :: tmelt -real(r8) :: pi !***************************************************************************** -! PDF theta model +! PDF theta model !***************************************************************************** ! some variables for PDF theta model ! immersion freezing @@ -52,25 +52,35 @@ module hetfrz_classnuc ! dim_theta index values of 53 through 113. These loop bounds are ! hardcoded in the variables i1 and i2. -logical :: pdf_imm_in = .true. +logical, parameter :: pdf_imm_in = .true. integer, parameter :: pdf_n_theta = 301 integer, parameter :: i1 = 53 integer, parameter :: i2 = 113 -real(r8) :: dim_theta(pdf_n_theta) = 0.0_r8 + +real(r8) :: dim_theta(pdf_n_theta) = -huge(1._r8) real(r8) :: pdf_imm_theta(pdf_n_theta) = 0.0_r8 -real(r8) :: pdf_d_theta -real(r8) :: dim_f_imm_dust_a1(pdf_n_theta) = 0.0_r8 -real(r8) :: dim_f_imm_dust_a3(pdf_n_theta) = 0.0_r8 +real(r8) :: pdf_d_theta = -huge(1._r8) +real(r8) :: dim_f_imm(pdf_n_theta) = 0.0_r8 integer :: iulog +real(r8), parameter :: n1 = 1.e19_r8 ! number of water molecules in contact with unit area of substrate [m-2] +real(r8), parameter :: rhplanck = 1._r8/planck +real(r8), parameter :: nus = 1.e13_r8 ! frequ. of vibration [s-1] higher freq. (as in P&K, consistent with Anupam's data) +real(r8), parameter :: rhwincloud = 0.98_r8 ! 98% RH in mixed-phase clouds (Korolev & Isaac, JAS 2006) + +logical, parameter :: tot_in = .false. + +real(r8) :: bc_limfac = -huge(1._r8) ! soot ice nucleating fraction +real(r8) :: dust_limfac = -huge(1._r8) ! dust ice nucleating fraction + !=================================================================================================== contains !=================================================================================================== subroutine hetfrz_classnuc_init( & rair_in, cpair_in, rh2o_in, rhoh2o_in, mwh2o_in, & - tmelt_in, pi_in, iulog_in) + tmelt_in, iulog_in, bc_limfac_in, dust_limfac_in) real(r8), intent(in) :: rair_in real(r8), intent(in) :: cpair_in @@ -78,8 +88,9 @@ subroutine hetfrz_classnuc_init( & real(r8), intent(in) :: rhoh2o_in real(r8), intent(in) :: mwh2o_in real(r8), intent(in) :: tmelt_in - real(r8), intent(in) :: pi_in integer, intent(in) :: iulog_in + real(r8), intent(in) :: bc_limfac_in + real(r8), intent(in) :: dust_limfac_in rair = rair_in cpair = cpair_in @@ -87,9 +98,11 @@ subroutine hetfrz_classnuc_init( & rhoh2o = rhoh2o_in mwh2o = mwh2o_in tmelt = tmelt_in - pi = pi_in iulog = iulog_in + bc_limfac = bc_limfac_in + dust_limfac = dust_limfac_in + ! Initialize all the PDF theta variables: if (pdf_imm_in) then call hetfrz_classnuc_init_pdftheta() @@ -99,100 +112,60 @@ end subroutine hetfrz_classnuc_init !=================================================================================================== -subroutine hetfrz_classnuc_calc( & - deltat, t, p, supersatice, & +subroutine hetfrz_classnuc_calc(ntypes, types,& + deltat, T, p, supersatice, & fn, & r3lx, icnlx, & frzbcimm, frzduimm, & frzbccnt, frzducnt, & frzbcdep, frzdudep, & - hetraer, awcam, awfacm, dstcoat, & - total_aer_num, coated_aer_num, uncoated_aer_num, & + hetraer, wact_factor, dstcoat, & + total_aer_num, uncoated_aer_num, & total_interstitial_aer_num, total_cloudborne_aer_num, errstring) + integer, intent(in) :: ntypes + character(len=*), intent(in) :: types(ntypes) real(r8), intent(in) :: deltat ! timestep [s] - real(r8), intent(in) :: t ! temperature [K] + real(r8), intent(in) :: T ! temperature [K] real(r8), intent(in) :: p ! pressure [Pa] real(r8), intent(in) :: supersatice ! supersaturation ratio wrt ice at 100%rh over water [ ] real(r8), intent(in) :: r3lx ! volume mean drop radius [m] real(r8), intent(in) :: icnlx ! in-cloud droplet concentration [cm-3] - real(r8), intent(in) :: fn(3) ! fraction activated [ ] for cloud borne aerosol number - ! index values are 1:bc, 2:dust_a1, 3:dust_a3 - real(r8), intent(in) :: hetraer(3) ! bc and dust mass mean radius [m] - real(r8), intent(in) :: awcam(3) ! modal added mass [mug m-3] - real(r8), intent(in) :: awfacm(3) ! (OC+BC)/(OC+BC+SO4) - real(r8), intent(in) :: dstcoat(3) ! coated fraction - real(r8), intent(in) :: total_aer_num(3) ! total bc and dust number concentration(interstitial+cloudborne) [#/cm^3] - real(r8), intent(in) :: coated_aer_num(3) ! coated bc and dust number concentration(interstitial) - real(r8), intent(in) :: uncoated_aer_num(3) ! uncoated bc and dust number concentration(interstitial) - real(r8), intent(in) :: total_interstitial_aer_num(3) ! total bc and dust concentration(interstitial) - real(r8), intent(in) :: total_cloudborne_aer_num(3) ! total bc and dust concentration(cloudborne) - - real(r8), intent(out) :: frzbcimm ! het. frz by BC immersion nucleation [cm-3 s-1] - real(r8), intent(out) :: frzduimm ! het. frz by dust immersion nucleation [cm-3 s-1] - real(r8), intent(out) :: frzbccnt ! het. frz by BC contact nucleation [cm-3 s-1] - real(r8), intent(out) :: frzducnt ! het. frz by dust contact nucleation [cm-3 s-1] - real(r8), intent(out) :: frzbcdep ! het. frz by BC deposition nucleation [cm-3 s-1] - real(r8), intent(out) :: frzdudep ! het. frz by dust deposition nucleation [cm-3 s-1] + real(r8), intent(in) :: fn(ntypes) ! fraction activated [ ] for cloud borne aerosol number + ! index values are 1:bc, 2:dust_a1, 3:dust_a3 + real(r8), intent(in) :: hetraer(ntypes) ! bc and dust mass mean radius [m] + real(r8), intent(in) :: wact_factor(ntypes) ! water activity factor -- density*(1.-(OC+BC)/(OC+BC+SO4)) [mug m-3] + real(r8), intent(in) :: dstcoat(ntypes) ! coated fraction + real(r8), intent(in) :: total_aer_num(ntypes) ! total bc and dust number concentration(interstitial+cloudborne) [#/cm^3] + real(r8), intent(in) :: uncoated_aer_num(ntypes) ! uncoated bc and dust number concentration(interstitial) + real(r8), intent(in) :: total_interstitial_aer_num(ntypes) ! total bc and dust concentration(interstitial) + real(r8), intent(in) :: total_cloudborne_aer_num(ntypes) ! total bc and dust concentration(cloudborne) + + real(r8), target, intent(out) :: frzbcimm ! het. frz by BC immersion nucleation [cm-3 s-1] + real(r8), target, intent(out) :: frzduimm ! het. frz by dust immersion nucleation [cm-3 s-1] + real(r8), target, intent(out) :: frzbccnt ! het. frz by BC contact nucleation [cm-3 s-1] + real(r8), target, intent(out) :: frzducnt ! het. frz by dust contact nucleation [cm-3 s-1] + real(r8), target, intent(out) :: frzbcdep ! het. frz by BC deposition nucleation [cm-3 s-1] + real(r8), target, intent(out) :: frzdudep ! het. frz by dust deposition nucleation [cm-3 s-1] character(len=*), intent(out) :: errstring ! local variables - real(r8) :: aw(3) ! water activity [ ] - real(r8) :: molal(3) ! molality [moles/kg] - real(r8), parameter :: Mso4 = 96.06_r8 - - integer, parameter :: id_bc = 1 - integer, parameter :: id_dst1 = 2 - integer, parameter :: id_dst3 = 3 - logical :: do_bc, do_dst1, do_dst3 - - real(r8), parameter :: n1 = 1.e19_r8 ! number of water molecules in contact with unit area of substrate [m-2] - real(r8), parameter :: kboltz = 1.38e-23_r8 - real(r8), parameter :: hplanck = 6.63e-34_r8 - real(r8), parameter :: rhplanck = 1._r8/hplanck - real(r8), parameter :: amu = 1.66053886e-27_r8 - real(r8), parameter :: nus = 1.e13_r8 ! frequ. of vibration [s-1] higher freq. (as in P&K, consistent with Anupam's data) - real(r8), parameter :: taufrz = 195.435_r8 ! time constant for falloff of freezing rate [s] - real(r8), parameter :: rhwincloud = 0.98_r8 ! 98% RH in mixed-phase clouds (Korolev & Isaac, JAS 2006) - real(r8), parameter :: limfacbc = 0.01_r8 ! max. ice nucleating fraction soot - real(r8) :: tc - real(r8) :: vwice - real(r8) :: rhoice - real(r8) :: sigma_iw ! [J/m2] - real(r8) :: sigma_iv ! [J/m2] - real(r8) :: esice ! [Pa] - real(r8) :: eswtr ! [Pa] - real(r8) :: rgimm - real(r8) :: rgdep - real(r8) :: dg0dep - real(r8) :: Adep - real(r8) :: dg0cnt - real(r8) :: Acnt - real(r8) :: rgimm_bc - real(r8) :: rgimm_dust_a1, rgimm_dust_a3 - real(r8) :: dg0imm_bc - real(r8) :: dg0imm_dust_a1, dg0imm_dust_a3 - real(r8) :: Aimm_bc - real(r8) :: Aimm_dust_a1, Aimm_dust_a3 - real(r8) :: q, m, phi - real(r8) :: r_bc ! model radii of BC modes [m] - real(r8) :: r_dust_a1, r_dust_a3 ! model radii of dust modes [m] - real(r8) :: f_imm_bc - real(r8) :: f_imm_dust_a1, f_imm_dust_a3 - real(r8) :: Jimm_bc - real(r8) :: Jimm_dust_a1, Jimm_dust_a3 - real(r8) :: f_dep_bc - real(r8) :: f_dep_dust_a1, f_dep_dust_a3 - real(r8) :: Jdep_bc - real(r8) :: Jdep_dust_a1, Jdep_dust_a3 - real(r8) :: f_cnt_bc - real(r8) :: f_cnt_dust_a1,f_cnt_dust_a3 - real(r8) :: Jcnt_bc - real(r8) :: Jcnt_dust_a1,Jcnt_dust_a3 - integer :: i + real(r8) :: tc + real(r8) :: vwice + real(r8) :: rhoice + real(r8) :: sigma_iw ! [J/m2] + real(r8) :: sigma_iv ! [J/m2] + real(r8) :: eswtr ! [Pa] + + real(r8) :: rgimm ! critical germ size + real(r8) :: rgdep + real(r8) :: dg0dep ! homogeneous energy of germ formation + real(r8) :: dg0cnt + real(r8) :: Adep ! prefactors + real(r8) :: Acnt !******************************************************** ! Hoose et al., 2010 fitting parameters @@ -221,334 +194,322 @@ subroutine hetfrz_classnuc_calc( & real(r8),parameter :: theta_dep_bc = 28._r8 ! contact angle [deg], converted to rad later !Moehler et al (2005), soot real(r8),parameter :: dga_dep_bc = -2.E-19_r8 ! activation energy [J] - real(r8) :: Kcoll_bc ! collision kernel [cm3 s-1] - real(r8) :: Kcoll_dust_a1 ! collision kernel [cm3 s-1] - real(r8) :: Kcoll_dust_a3 ! collision kernel [cm3 s-1] + ! form factor + ! only consider flat surfaces due to uncertainty of curved surfaces + real(r8),parameter :: m_depcnt_bc = COS(theta_dep_bc*pi/180._r8) + real(r8),parameter :: f_depcnt_bc = (2+m_depcnt_bc)*(1-m_depcnt_bc)**2/4._r8 + + real(r8),parameter :: m_depcnt_dst = COS(theta_dep_dust*pi/180._r8) + real(r8),parameter :: f_depcnt_dust = (2+m_depcnt_dst)*(1-m_depcnt_dst)**2/4._r8 + + real(r8),parameter :: m_imm_bc = COS(theta_imm_bc*pi/180._r8) + real(r8),parameter :: f_imm_bc = (2+m_imm_bc)*(1-m_imm_bc)**2/4._r8 + + real(r8),parameter :: m_imm_dust = COS(theta_imm_dust*pi/180._r8) + real(r8),parameter :: f_imm_dust = (2+m_imm_dust)*(1-m_imm_dust)**2/4._r8 - logical :: tot_in = .false. + real(r8) :: f_dep, f_cnt, f_imm + real(r8) :: dga_dep, dga_imm + real(r8) :: limfac + real(r8) :: frzimm, frzcnt, frzdep + real(r8), pointer :: frzimm_ptr, frzcnt_ptr, frzdep_ptr - real(r8) :: dim_Jimm_dust_a1(pdf_n_theta), dim_Jimm_dust_a3(pdf_n_theta) - real(r8) :: sum_imm_dust_a1, sum_imm_dust_a3 + logical :: pdf_imm + + integer :: ispc + + real(r8) :: ktherm(ntypes), kcoll(ntypes) + + real(r8), parameter :: Ktherm_bc = 4.2_r8 ! black carbon thermal conductivity [J/(m s K)] + real(r8), parameter :: Ktherm_dst = 0.72_r8 ! clay thermal conductivity [J/(m s K)] !------------------------------------------------------------------------------------------------ errstring = ' ' - ! get saturation vapor pressures + nullify(frzimm_ptr) + nullify(frzcnt_ptr) + nullify(frzdep_ptr) + + frzbcimm = 0._r8 + frzbccnt= 0._r8 + frzbcdep = 0._r8 + frzduimm = 0._r8 + frzducnt= 0._r8 + frzdudep = 0._r8 + + ! get saturation vapor pressure eswtr = svp_water(t) ! 0 for liquid - esice = svp_ice(t) ! 1 for ice - tc = t - tmelt + tc = T - tmelt rhoice = 916.7_r8-0.175_r8*tc-5.e-4_r8*tc**2 vwice = mwh2o*amu/rhoice sigma_iw = (28.5_r8+0.25_r8*tc)*1E-3_r8 sigma_iv = (76.1_r8-0.155_r8*tc + 28.5_r8+0.25_r8*tc)*1E-3_r8 - ! get mass mean radius - r_bc = hetraer(1) - r_dust_a1 = hetraer(2) - r_dust_a3 = hetraer(3) - - ! calculate collision kernels as a function of environmental parameters and aerosol/droplet sizes - call collkernel(t, p, eswtr, rhwincloud, r3lx, & - r_bc, & ! BC modes - r_dust_a1, r_dust_a3, & ! dust modes - Kcoll_bc, & ! collision kernel [cm3 s-1] - Kcoll_dust_a1, Kcoll_dust_a3) - - !***************************************************************************** - ! take water activity into account - !***************************************************************************** - ! solute effect - aw(:) = 1._r8 - molal(:) = 0._r8 + ! critical germ size + rgimm = 2*vwice*sigma_iw/(boltz*T*LOG(supersatice)) - ! The heterogeneous ice freezing temperatures of all IN generally decrease with - ! increasing total solute mole fraction. Therefore, the large solution concentration - ! will cause the freezing point depression and the ice freezing temperatures of all - ! IN will get close to the homogeneous ice freezing temperatures. Since we take into - ! account water activity for three heterogeneous freezing modes(immersion, deposition, - ! and contact), we utilize interstitial aerosols(not cloudborne aerosols) to calculate - ! water activity. - ! If the index of IN is 0, it means three freezing modes of this aerosol are depressed. + ! critical germ size + ! assume 98% RH in mixed-phase clouds (Korolev & Isaac, JAS 2006) + rgdep=2*vwice*sigma_iv/(boltz*T*LOG(rhwincloud*supersatice)) - do i = 1, 3 - !calculate molality - if ( total_interstitial_aer_num(i) > 0._r8 ) then - molal(i) = (1.e-6_r8*awcam(i)*(1._r8-awfacm(i))/(Mso4*total_interstitial_aer_num(i)*1.e6_r8))/ & - (4*pi/3*rhoh2o*(MAX(r3lx,4.e-6_r8))**3) - aw(i) = 1._r8/(1._r8+2.9244948e-2_r8*molal(i)+2.3141243e-3_r8*molal(i)**2+7.8184854e-7_r8*molal(i)**3) - end if - end do + ! homogeneous energy of germ formation + dg0dep = 4*pi/3._r8*sigma_iv*rgdep**2 - !***************************************************************************** - ! immersion freezing begin - !***************************************************************************** + ! prefactor + ! attention: division of small numbers + Adep = (rhwincloud*eswtr)**2*(vwice/(mwh2o*amu))/(boltz*T*nus)*SQRT(sigma_iv/(boltz*T)) - frzbcimm = 0._r8 - frzduimm = 0._r8 - frzbccnt = 0._r8 - frzducnt = 0._r8 - frzbcdep = 0._r8 - frzdudep = 0._r8 + ! homogeneous energy of germ formation + dg0cnt = 4*pi/3._r8*sigma_iv*rgimm**2 - ! critical germ size - rgimm = 2*vwice*sigma_iw/(kboltz*t*LOG(supersatice)) - ! take solute effect into account - rgimm_bc = rgimm - rgimm_dust_a1 = rgimm - rgimm_dust_a3 = rgimm + ! prefactor + ! attention: division of small numbers + Acnt = rhwincloud*eswtr*4*pi/(nus*SQRT(2*pi*mwh2o*amu*boltz*T)) + + do ispc = 1, ntypes + + select case (trim(types(ispc))) + case ('black-c') + ktherm(ispc) = ktherm_bc + case ('dust') + ktherm(ispc) = ktherm_dst + case default + errstring = 'hetfrz_classnuc_calc ERROR: unrecognized aerosol type: '//trim(types(ispc)) + return + end select + end do - ! if aw*Si<=1, the freezing point depression is strong enough to prevent freezing + call collkernel(T, p, eswtr, rhwincloud, r3lx, hetraer, Ktherm, Kcoll) + + do ispc = 1, ntypes + + select case (trim(types(ispc))) + case ('black-c') + f_dep = f_depcnt_bc + f_cnt = f_depcnt_bc + f_imm = f_imm_bc + dga_dep = dga_dep_bc + dga_imm = dga_imm_bc + pdf_imm = .false. + limfac = bc_limfac + frzimm_ptr => frzbcimm + frzcnt_ptr => frzbccnt + frzdep_ptr => frzbcdep + case ('dust') + f_dep = f_depcnt_dust + f_cnt = f_depcnt_dust + f_imm = f_imm_dust + dga_dep = dga_dep_dust + dga_imm = dga_imm_dust + pdf_imm = .true. + limfac = dust_limfac + frzimm_ptr => frzduimm + frzcnt_ptr => frzducnt + frzdep_ptr => frzdudep + case default + errstring = 'hetfrz_classnuc_calc ERROR: unrecognized aerosol type: '//trim(types(ispc)) + return + end select + + call hetfrz_classnuc_calc_rates( f_dep, f_cnt, f_imm, dga_dep, dga_imm, pdf_imm, limfac, & + kcoll(ispc), hetraer(ispc), icnlx, r3lx, T, supersatice, sigma_iw, & + rgimm, rgdep, dg0dep, Adep, dg0cnt, Acnt, vwice, deltat, & + fn(ispc), wact_factor(ispc), dstcoat(ispc), & + total_aer_num(ispc), total_interstitial_aer_num(ispc), total_cloudborne_aer_num(ispc), uncoated_aer_num(ispc), & + frzimm, frzcnt, frzdep, errstring ) + + ! accumulate dust and bc frz rates + frzimm_ptr = frzimm_ptr + frzimm + frzcnt_ptr = frzcnt_ptr + frzcnt + frzdep_ptr = frzdep_ptr + frzdep - if (aw(id_bc)*supersatice > 1._r8 ) then - do_bc = .true. - rgimm_bc = 2*vwice*sigma_iw/(kboltz*t*LOG(aw(id_bc)*supersatice)) - else - do_bc = .false. - end if + end do - if (aw(id_dst1)*supersatice > 1._r8 ) then - do_dst1 = .true. - rgimm_dust_a1 = 2*vwice*sigma_iw/(kboltz*t*LOG(aw(id_dst1)*supersatice)) - else - do_dst1 = .false. - end if + end subroutine hetfrz_classnuc_calc + + subroutine hetfrz_classnuc_calc_rates( f_dep, f_cnt, f_imm, dga_dep, dga_imm, pdf_imm, limfac, & + kcoll, mradius, icnlx, r3lx, T, supersatice, sigma_iw, & + rgimm, rgdep, dg0dep, Adep, dg0cnt, Acnt, vwice, deltat, & + fn, wact_factor, dstcoat, & + total_aer_num, total_interstitial_aer_num, total_cloudborne_aer_num, uncoated_aer_num, & + frzimm, frzcnt, frzdep, errstring ) + + ! input + real(r8), intent(in) :: f_dep ! deposition form factor + real(r8), intent(in) :: f_cnt ! contact form factor + real(r8), intent(in) :: f_imm ! immersion form factor + real(r8), intent(in) :: dga_dep ! deposition activation energy [J] + real(r8), intent(in) :: dga_imm ! immersion activation energy [J] + logical, intent(in) :: pdf_imm ! PDF theta model switch (TRUE for dust) + real(r8), intent(in) :: limfac ! Limit to 1% of available potential IN (for BC), no limit for dust + real(r8), intent(in) :: kcoll ! collision kernel [cm3 s-1] + real(r8), intent(in) :: mradius ! mass mean radius [m] + real(r8), intent(in) :: icnlx ! in-cloud droplet concentration [cm-3] + real(r8), intent(in) :: r3lx ! volume mean drop radius [m] + real(r8), intent(in) :: T ! temperature [K] + real(r8), intent(in) :: supersatice ! supersaturation ratio wrt ice at 100%rh over water [ ] + real(r8), intent(in) :: sigma_iw ! [J/m2] + real(r8), intent(in) :: rgimm ! critical germ size + real(r8), intent(in) :: rgdep ! critical germ size + real(r8), intent(in) :: dg0dep ! homogeneous energy of germ formation + real(r8), intent(in) :: Adep ! deposition nucleation prefactor + real(r8), intent(in) :: dg0cnt ! homogeneous energy of germ formation + real(r8), intent(in) :: Acnt ! contact nucleation prefactor + + real(r8), intent(in) :: vwice + real(r8), intent(in) :: deltat ! timestep [s] + real(r8), intent(in) :: fn ! fraction activated [ ] for cloud borne aerosol number + real(r8), intent(in) :: wact_factor ! water activity factor -- density*(1.-(OC+BC)/(OC+BC+SO4)) [mug m-3] + real(r8), intent(in) :: dstcoat ! coated fraction + real(r8), intent(in) :: total_aer_num ! total bc and dust number concentration(interstitial+cloudborne) [#/cm^3] + real(r8), intent(in) :: total_interstitial_aer_num ! total bc and dust concentration(interstitial) + real(r8), intent(in) :: total_cloudborne_aer_num ! total bc and dust concentration(cloudborne) + real(r8), intent(in) :: uncoated_aer_num ! uncoated bc and dust number concentration(interstitial) + ! output + real(r8), intent(out) :: frzimm ! het. frz by immersion nucleation [cm-3 s-1] + real(r8), intent(out) :: frzcnt ! het. frz by contact nucleation [cm-3 s-1] + real(r8), intent(out) :: frzdep ! het. frz by deposition nucleation [cm-3 s-1] - if (aw(id_dst3)*supersatice > 1._r8 ) then - do_dst3 = .true. - rgimm_dust_a3 = 2*vwice*sigma_iw/(kboltz*t*LOG(aw(id_dst3)*supersatice)) - else - do_dst3 = .false. - end if - - ! form factor - ! only consider flat surfaces due to uncertainty of curved surfaces + character(len=*), intent(out) :: errstring - m = COS(theta_imm_bc*pi/180._r8) - f_imm_bc = (2+m)*(1-m)**2/4._r8 - if (.not. pdf_imm_in) then - m = COS(theta_imm_dust*pi/180._r8) - f_imm_dust_a1 = (2+m)*(1-m)**2/4._r8 + ! local vars + real(r8) :: aw ! water activity [ ] + real(r8) :: molal ! molality [moles/kg] - m = COS(theta_imm_dust*pi/180._r8) - f_imm_dust_a3 = (2+m)*(1-m)**2/4._r8 - end if + real(r8) :: Aimm + real(r8) :: Jdep + real(r8) :: Jimm + real(r8) :: Jcnt + real(r8) :: dg0imm + real(r8) :: rgimm_aer + real(r8) :: sum_imm + real(r8) :: dim_Jimm(pdf_n_theta) - ! homogeneous energy of germ formation - dg0imm_bc = 4*pi/3._r8*sigma_iw*rgimm_bc**2 - dg0imm_dust_a1 = 4*pi/3._r8*sigma_iw*rgimm_dust_a1**2 - dg0imm_dust_a3 = 4*pi/3._r8*sigma_iw*rgimm_dust_a3**2 + logical :: do_frz + logical :: do_imm - ! prefactor - Aimm_bc = n1*((vwice*rhplanck)/(rgimm_bc**3)*SQRT(3._r8/pi*kboltz*T*dg0imm_bc)) - Aimm_dust_a1 = n1*((vwice*rhplanck)/(rgimm_dust_a1**3)*SQRT(3._r8/pi*kboltz*T*dg0imm_dust_a1)) - Aimm_dust_a3 = n1*((vwice*rhplanck)/(rgimm_dust_a3**3)*SQRT(3._r8/pi*kboltz*T*dg0imm_dust_a3)) + integer :: i - ! nucleation rate per particle + !***************************************************************************** + ! take water activity into account + !***************************************************************************** + ! solute effect + aw = 1._r8 + molal = 0._r8 - Jimm_bc = Aimm_bc*r_bc**2/SQRT(f_imm_bc)*EXP((-dga_imm_bc-f_imm_bc*dg0imm_bc)/(kboltz*T)) - if (.not. pdf_imm_in) then - ! 1/sqrt(f) - ! the expression of Chen et al. (sqrt(f)) may however lead to unphysical - ! behavior as it implies J->0 when f->0 (i.e. ice nucleation would be - ! more difficult on easily wettable materials). - Jimm_dust_a1 = Aimm_dust_a1*r_dust_a1**2/SQRT(f_imm_dust_a1)*EXP((-dga_imm_dust-f_imm_dust_a1*dg0imm_dust_a1)/(kboltz*T)) - Jimm_dust_a3 = Aimm_dust_a3*r_dust_a3**2/SQRT(f_imm_dust_a3)*EXP((-dga_imm_dust-f_imm_dust_a3*dg0imm_dust_a3)/(kboltz*T)) - end if + ! The heterogeneous ice freezing temperatures of all IN generally decrease with + ! increasing total solute mole fraction. Therefore, the large solution concentration + ! will cause the freezing point depression and the ice freezing temperatures of all + ! IN will get close to the homogeneous ice freezing temperatures. Since we take into + ! account water activity for three heterogeneous freezing modes(immersion, deposition, + ! and contact), we utilize interstitial aerosols(not cloudborne aerosols) to calculate + ! water activity. + ! If the index of IN is 0, it means three freezing modes of this aerosol are depressed. - if (pdf_imm_in) then - dim_Jimm_dust_a1 = 0.0_r8 - dim_Jimm_dust_a3 = 0.0_r8 - do i = i1,i2 - ! 1/sqrt(f) - dim_Jimm_dust_a1(i) = Aimm_dust_a1*r_dust_a1**2/SQRT(dim_f_imm_dust_a1(i))*EXP((-dga_imm_dust-dim_f_imm_dust_a1(i)* & - dg0imm_dust_a1)/(kboltz*T)) - dim_Jimm_dust_a1(i) = max(dim_Jimm_dust_a1(i), 0._r8) - - dim_Jimm_dust_a3(i) = Aimm_dust_a3*r_dust_a3**2/SQRT(dim_f_imm_dust_a3(i))*EXP((-dga_imm_dust-dim_f_imm_dust_a3(i)* & - dg0imm_dust_a3)/(kboltz*T)) - dim_Jimm_dust_a3(i) = max(dim_Jimm_dust_a3(i), 0._r8) - end do + !calculate molality + if ( total_interstitial_aer_num > 0._r8 ) then + molal = (1.e-6_r8*wact_factor/(mwso4*total_interstitial_aer_num*1.e6_r8))/ & + (4*pi/3*rhoh2o*(MAX(r3lx,4.e-6_r8))**3) + aw = 1._r8/(1._r8+2.9244948e-2_r8*molal+2.3141243e-3_r8*molal**2+7.8184854e-7_r8*molal**3) end if - ! Limit to 1% of available potential IN (for BC), no limit for dust - if (pdf_imm_in) then - sum_imm_dust_a1 = 0._r8 - sum_imm_dust_a3 = 0._r8 - do i = i1,i2-1 - sum_imm_dust_a1 = sum_imm_dust_a1+0.5_r8*((pdf_imm_theta(i)*exp(-dim_Jimm_dust_a1(i)*deltat)+ & - pdf_imm_theta(i+1)*exp(-dim_Jimm_dust_a1(i+1)*deltat)))*pdf_d_theta - sum_imm_dust_a3 = sum_imm_dust_a3+0.5_r8*((pdf_imm_theta(i)*exp(-dim_Jimm_dust_a3(i)*deltat)+ & - pdf_imm_theta(i+1)*exp(-dim_Jimm_dust_a3(i+1)*deltat)))*pdf_d_theta - end do - do i = i1,i2 - if (sum_imm_dust_a1 > 0.99_r8) then - sum_imm_dust_a1 = 1.0_r8 - end if - if (sum_imm_dust_a3 > 0.99_r8) then - sum_imm_dust_a3 = 1.0_r8 - end if - end do - - end if + !***************************************************************************** + ! immersion freezing begin + !***************************************************************************** - if (.not.tot_in) then - if (do_bc) frzbcimm = frzbcimm+MIN(limfacbc*total_cloudborne_aer_num(id_bc)/deltat, & - total_cloudborne_aer_num(id_bc)/deltat*(1._r8-exp(-Jimm_bc*deltat))) + frzimm = 0._r8 + frzcnt = 0._r8 + frzdep = 0._r8 - if (.not. pdf_imm_in) then - if (do_dst1) frzduimm = frzduimm+MIN(1*total_cloudborne_aer_num(id_dst1)/deltat, & - total_cloudborne_aer_num(id_dst1)/deltat*(1._r8-exp(-Jimm_dust_a1*deltat))) - if (do_dst3) frzduimm = frzduimm+MIN(1*total_cloudborne_aer_num(id_dst3)/deltat, & - total_cloudborne_aer_num(id_dst3)/deltat*(1._r8-exp(-Jimm_dust_a3*deltat))) - else - if (do_dst1) frzduimm = frzduimm+MIN(1*total_cloudborne_aer_num(id_dst1)/deltat, & - total_cloudborne_aer_num(id_dst1)/deltat*(1._r8-sum_imm_dust_a1)) - if (do_dst3) frzduimm = frzduimm+MIN(1*total_cloudborne_aer_num(id_dst3)/deltat, & - total_cloudborne_aer_num(id_dst3)/deltat*(1._r8-sum_imm_dust_a3)) - end if + ! take solute effect into account + rgimm_aer = rgimm + + ! if aw*Si<=1, the freezing point depression is strong enough to prevent freezing + do_frz = aw*supersatice > 1._r8 + if (do_frz) then + rgimm_aer = 2*vwice*sigma_iw/(boltz*T*LOG(aw*supersatice)) else - if (do_bc) frzbcimm = frzbcimm+MIN(limfacbc*fn(id_bc)*total_aer_num(id_bc)/deltat, & - fn(id_bc)*total_aer_num(id_bc)/deltat*(1._r8-exp(-Jimm_bc*deltat))) - - if (.not. pdf_imm_in) then - if (do_dst1) frzduimm = frzduimm+MIN(1*fn(id_dst1)*total_aer_num(id_dst1)/deltat, & - fn(id_dst1)*total_aer_num(id_dst1)/deltat*(1._r8-exp(-Jimm_dust_a1*deltat))) - if (do_dst3) frzduimm = frzduimm+MIN(1*fn(id_dst3)*total_aer_num(id_dst3)/deltat, & - fn(id_dst3)*total_aer_num(id_dst3)/deltat*(1._r8-exp(-Jimm_dust_a3*deltat))) + return + endif + + do_imm = T <= 263.15_r8 ! temperature threshold for immersion freezing (-10 C) + + if (do_imm) then + ! homogeneous energy of germ formation + dg0imm = 4*pi/3._r8*sigma_iw*rgimm_aer**2 + + ! prefactor + Aimm = n1*((vwice*rhplanck)/(rgimm_aer**3)*SQRT(3._r8/pi*boltz*T*dg0imm)) + + ! nucleation rate per particle + + if (pdf_imm) then + dim_Jimm(:) = 0._r8 + do i = i1,i2 + ! 1/sqrt(f) + dim_Jimm(i) = Aimm*mradius**2/SQRT(dim_f_imm(i))*EXP((-dga_imm-dim_f_imm(i)*dg0imm)/(boltz*T)) + dim_Jimm(i) = max(dim_Jimm(i), 0._r8) + end do + + sum_imm = 0._r8 + do i = i1,i2-1 + sum_imm = sum_imm + 0.5_r8*((pdf_imm_theta(i )*exp(-dim_Jimm(i )*deltat)+ & + pdf_imm_theta(i+1)*exp(-dim_Jimm(i+1)*deltat)))*pdf_d_theta + end do + if (sum_imm > 0.99_r8) then + sum_imm = 1.0_r8 + end if else - if (do_dst1) frzduimm = frzduimm+MIN(1*fn(id_dst1)*total_aer_num(id_dst1)/deltat, & - fn(id_dst1)*total_aer_num(id_dst1)/deltat*(1._r8-sum_imm_dust_a1)) - if (do_dst3) frzduimm = frzduimm+MIN(1*fn(id_dst3)*total_aer_num(id_dst3)/deltat, & - fn(id_dst3)*total_aer_num(id_dst3)/deltat*(1._r8-sum_imm_dust_a3)) + Jimm = Aimm*mradius**2/SQRT(f_imm)*EXP(( -dga_imm - f_imm*dg0imm )/(boltz*T)) + sum_imm = exp(-Jimm*deltat) end if end if - if (t > 263.15_r8) then - frzduimm = 0._r8 - frzbcimm = 0._r8 - end if - !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Deposition nucleation !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! critical germ size - ! assume 98% RH in mixed-phase clouds (Korolev & Isaac, JAS 2006) - rgdep=2*vwice*sigma_iv/(kboltz*t*LOG(rhwincloud*supersatice)) - - ! form factor - m = COS(theta_dep_bc*pi/180._r8) - f_dep_bc = (2+m)*(1-m)**2/4._r8 - - m = COS(theta_dep_dust*pi/180._r8) - f_dep_dust_a1 = (2+m)*(1-m)**2/4._r8 - - m = COS(theta_dep_dust*pi/180._r8) - f_dep_dust_a3 = (2+m)*(1-m)**2/4._r8 - - ! homogeneous energy of germ formation - dg0dep = 4*pi/3._r8*sigma_iv*rgdep**2 - - ! prefactor - ! attention: division of small numbers - Adep = (rhwincloud*eswtr)**2*(vwice/(mwh2o*amu))/(kboltz*T*nus)*SQRT(sigma_iv/(kboltz*T)) ! nucleation rate per particle if (rgdep > 0) then - Jdep_bc = Adep*r_bc**2/SQRT(f_dep_bc)*EXP((-dga_dep_bc-f_dep_bc*dg0dep)/(kboltz*T)) - Jdep_dust_a1 = Adep*r_dust_a1**2/SQRT(f_dep_dust_a1)*EXP((-dga_dep_dust-f_dep_dust_a1*dg0dep)/(kboltz*T)) - Jdep_dust_a3 = Adep*r_dust_a3**2/SQRT(f_dep_dust_a3)*EXP((-dga_dep_dust-f_dep_dust_a3*dg0dep)/(kboltz*T)) + Jdep = Adep*mradius**2/SQRT(f_dep)*EXP((-dga_dep-f_dep*dg0dep)/(boltz*T)) else - Jdep_bc = 0._r8 - Jdep_dust_a1 = 0._r8 - Jdep_dust_a3 = 0._r8 + Jdep = 0._r8 end if - ! Limit to 1% of available potential IN (for BC), no limit for dust - if (.not.tot_in) then - if (do_bc) frzbcdep = frzbcdep+MIN(limfacbc*uncoated_aer_num(id_bc)/deltat, & - uncoated_aer_num(id_bc)/deltat & - *(1._r8-exp(-Jdep_bc*deltat))) - if (do_dst1) frzdudep = frzdudep+MIN(uncoated_aer_num(id_dst1)/deltat, & - uncoated_aer_num(id_dst1)/deltat & - *(1._r8-exp(-Jdep_dust_a1*deltat))) - if (do_dst3) frzdudep = frzdudep+MIN(uncoated_aer_num(id_dst3)/deltat, & - uncoated_aer_num(id_dst3)/deltat & - *(1._r8-exp(-Jdep_dust_a3*deltat))) - else - if (do_bc) frzbcdep = frzbcdep+MIN(limfacbc*(1._r8-fn(id_bc)) & - *(1._r8-dstcoat(1))*total_aer_num(id_bc)/deltat, & - (1._r8-fn(id_bc))*(1._r8-dstcoat(1))*total_aer_num(id_bc)/deltat & - *(1._r8-exp(-Jdep_bc*deltat))) - if (do_dst1) frzdudep = frzdudep+MIN((1._r8-fn(id_dst1)) & - *(1._r8-dstcoat(2))*total_aer_num(id_dst1)/deltat, & - (1._r8-fn(id_dst1))*(1._r8-dstcoat(2))*total_aer_num(id_dst1)/deltat & - *(1._r8-exp(-Jdep_dust_a1*deltat))) - if (do_dst3) frzdudep = frzdudep+MIN((1._r8-fn(id_dst3)) & - *(1._r8-dstcoat(3))*total_aer_num(id_dst3)/deltat, & - (1._r8-fn(id_dst3))*(1._r8-dstcoat(3))*total_aer_num(id_dst3)/deltat & - *(1._r8-exp(-Jdep_dust_a3*deltat))) - end if - - !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! contact nucleation - !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! form factor - m = COS(theta_dep_bc*pi/180._r8) - f_cnt_bc = (2+m)*(1-m)**2/4._r8 - - m = COS(theta_dep_dust*pi/180._r8) - f_cnt_dust_a1 = (2+m)*(1-m)**2/4._r8 - - m = COS(theta_dep_dust*pi/180._r8) - f_cnt_dust_a3 = (2+m)*(1-m)**2/4._r8 - - ! homogeneous energy of germ formation - dg0cnt = 4*pi/3._r8*sigma_iv*rgimm**2 - - ! prefactor - ! attention: division of small numbers - Acnt = rhwincloud*eswtr*4*pi/(nus*SQRT(2*pi*mwh2o*amu*kboltz*T)) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! nucleation rate per particle - Jcnt_bc = Acnt*r_bc**2*EXP((-dga_dep_bc-f_cnt_bc*dg0cnt)/(kboltz*T))*Kcoll_bc*icnlx - Jcnt_dust_a1 = Acnt*r_dust_a1**2*EXP((-dga_dep_dust-f_cnt_dust_a1*dg0cnt)/(kboltz*T))*Kcoll_dust_a1*icnlx - Jcnt_dust_a3 = Acnt*r_dust_a3**2*EXP((-dga_dep_dust-f_cnt_dust_a3*dg0cnt)/(kboltz*T))*Kcoll_dust_a3*icnlx - - ! Limit to 1% of available potential IN (for BC), no limit for dust - if (.not.tot_in) then - if (do_bc) frzbccnt = frzbccnt+MIN(limfacbc*uncoated_aer_num(id_bc)/deltat, & - uncoated_aer_num(id_bc)/deltat & - *(1._r8-exp(-Jcnt_bc*deltat))) - if (do_dst1) frzducnt = frzducnt+MIN(uncoated_aer_num(id_dst1)/deltat, & - uncoated_aer_num(id_dst1)/deltat & - *(1._r8-exp(-Jcnt_dust_a1*deltat))) - if (do_dst3) frzducnt = frzducnt+MIN(uncoated_aer_num(id_dst3)/deltat, & - uncoated_aer_num(id_dst3)/deltat & - *(1._r8-exp(-Jcnt_dust_a3*deltat))) + Jcnt = Acnt*mradius**2*EXP((-dga_dep-f_cnt*dg0cnt)/(boltz*T))*Kcoll*icnlx + + ! Limit to 1% of available potential IN (for BC), no limit for dust + if (tot_in) then + if (do_imm) then + frzimm = MIN(limfac*fn*total_aer_num/deltat, fn*total_aer_num/deltat*(1._r8-sum_imm)) + end if + frzdep = MIN(limfac*(1._r8-fn)*(1._r8-dstcoat)*total_aer_num/deltat, & + (1._r8-fn)*(1._r8-dstcoat)*total_aer_num/deltat*(1._r8-exp(-Jdep*deltat))) + frzcnt = MIN(limfac*(1._r8-fn)*(1._r8-dstcoat)*total_aer_num/deltat, & + (1._r8-fn)*(1._r8-dstcoat)*total_aer_num/deltat*(1._r8-exp(-Jcnt*deltat))) else - if (do_bc) frzbccnt = frzbccnt+MIN(limfacbc*(1._r8-fn(id_bc))*(1._r8-dstcoat(1))*total_aer_num(id_bc)/deltat, & - (1._r8-fn(id_bc))*(1._r8-dstcoat(1))*total_aer_num(id_bc)/deltat & - *(1._r8-exp(-Jcnt_bc*deltat))) - if (do_dst1) frzducnt = frzducnt+MIN((1._r8-fn(id_dst1))*(1._r8-dstcoat(2))*total_aer_num(id_dst1)/deltat, & - (1._r8-fn(id_dst1))*(1._r8-dstcoat(2))*total_aer_num(id_dst1)/deltat & - *(1._r8-exp(-Jcnt_dust_a1*deltat))) - if (do_dst3) frzducnt = frzducnt+MIN((1._r8-fn(id_dst3))*(1._r8-dstcoat(3))*total_aer_num(id_dst3)/deltat, & - (1._r8-fn(id_dst3))*(1._r8-dstcoat(3))*total_aer_num(id_dst3)/deltat & - *(1._r8-exp(-Jcnt_dust_a3*deltat))) + if (do_imm) then + frzimm = MIN(limfac*total_cloudborne_aer_num /deltat, total_cloudborne_aer_num/deltat*(1._r8-sum_imm)) + end if + frzdep = MIN(limfac*uncoated_aer_num/deltat, uncoated_aer_num/deltat*(1._r8-exp(-Jdep*deltat))) + frzcnt = MIN(limfac*uncoated_aer_num/deltat, uncoated_aer_num/deltat*(1._r8-exp(-Jcnt*deltat))) end if - - if (frzducnt <= -1._r8) then - write(iulog,*) 'hetfrz_classnuc_calc: frzducnt', frzducnt, Jcnt_dust_a1,Jcnt_dust_a3, & - Kcoll_dust_a1, Kcoll_dust_a3 + + if (frzcnt <= -1._r8) then + write(iulog,*) 'hetfrz_classnuc_calc: frzcnt, Jcnt, Kcoll: ', frzcnt, Jcnt, Kcoll errstring = 'ERROR in hetfrz_classnuc_calc::frzducnt' return end if -end subroutine hetfrz_classnuc_calc +end subroutine hetfrz_classnuc_calc_rates !=================================================================================================== @@ -559,27 +520,22 @@ end subroutine hetfrz_classnuc_calc ! Author: Corinna Hoose, UiO, October 2009 ! ! Modifications: Yong Wang and Xiaohong Liu, UWyo, 12/2012 +! +! "Seinfeld & Pandis" referenced in several places in this routine is: +! Atmospheric Chemistry and Physics: From Air Pollution to Climate Change, 3rd Edition +! John H. Seinfeld, Spyros N. Pandis ISBN: 978-1-118-94740-1 !----------------------------------------------------------------------- -subroutine collkernel( & - t, pres, eswtr, rhwincloud, r3lx, & - r_bc, & ! BC modes - r_dust_a1, r_dust_a3, & ! dust modes - Kcoll_bc, & ! collision kernel [cm3 s-1] - Kcoll_dust_a1, Kcoll_dust_a3) - - real(r8), intent(in) :: t ! temperature [K] - real(r8), intent(in) :: pres ! pressure [Pa] - real(r8), intent(in) :: eswtr ! saturation vapor pressure of water [Pa] - real(r8), intent(in) :: r3lx ! volume mean drop radius [m] - real(r8), intent(in) :: rhwincloud ! in-cloud relative humidity over water [ ] - real(r8), intent(in) :: r_bc ! model radii of BC modes [m] - real(r8), intent(in) :: r_dust_a1 ! model radii of dust modes [m] - real(r8), intent(in) :: r_dust_a3 ! model radii of dust modes [m] - - real(r8), intent(out) :: Kcoll_bc ! collision kernel [cm3 s-1] - real(r8), intent(out) :: Kcoll_dust_a1 - real(r8), intent(out) :: Kcoll_dust_a3 +subroutine collkernel( temp, pres, eswtr, rhwincloud, r3lx, rad, Ktherm, Kcoll ) + + real(r8), intent(in) :: temp ! temperature [K] + real(r8), intent(in) :: pres ! pressure [Pa] + real(r8), intent(in) :: eswtr ! saturation vapor pressure of water [Pa] + real(r8), intent(in) :: r3lx ! volume mean drop radius [m] + real(r8), intent(in) :: rhwincloud ! in-cloud relative humidity over water [ ] + real(r8), intent(in) :: rad(:) ! aerosol radius [m] + real(r8), intent(in) :: Ktherm(:) ! thermal conductivity of aerosol [J/(m s K)] + real(r8), intent(out) :: Kcoll(:) ! collision kernel [cm3 s-1] ! local variables real(r8) :: a, b, c, a_f, b_f, c_f, f @@ -593,37 +549,34 @@ subroutine collkernel( & real(r8) :: Pr ! Prandtl number [ ] real(r8) :: Sc ! Schmidt number [ ] real(r8) :: vterm ! terminal velocity [m s-1] - real(r8) :: Ktherm ! thermal conductivity of aerosol [J/(m s K)] real(r8) :: Dvap ! water vapor diffusivity [m2 s-1] real(r8) :: Daer ! aerosol diffusivity [m2 s-1] real(r8) :: latvap ! latent heat of vaporization [J kg-1] - real(r8) :: kboltz ! Boltzmann constant [J K-1] real(r8) :: G ! thermodynamic function in Cotton et al. [kg m-1 s-1] - real(r8) :: r_a ! aerosol radius [m] real(r8) :: f_t ! factor by Waldmann & Schmidt [ ] real(r8) :: Q_heat ! heat flux [J m-2 s-1] real(r8) :: Tdiff_cotton ! temperature difference between droplet and environment [K] real(r8) :: K_brownian,K_thermo_cotton,K_diffusio_cotton ! collision kernels [m3 s-1] - real(r8) :: K_total ! total collision kernel [cm3 s-1] - integer :: i + + integer :: ntot, idx + !------------------------------------------------------------------------------------------------ - - Kcoll_bc = 0._r8 - Kcoll_dust_a1 = 0._r8 - Kcoll_dust_a3 = 0._r8 - tc = t - tmelt - kboltz = 1.38065e-23_r8 + ntot = size(ktherm) + + Kcoll(:) = 0._r8 + + tc = temp - tmelt ! air viscosity for tc<0, from depvel_part.F90 viscos_air = (1.718_r8+0.0049_r8*tc-1.2e-5_r8*tc*tc)*1.e-5_r8 ! air density - rho_air = pres/(rair*t) - ! mean free path: Seinfeld & Pandis 8.6 - lambda = 2*viscos_air/(pres*SQRT(8/(pi*rair*t))) + rho_air = pres/(rair*temp) + ! mean free path: Seinfeld & Pandis 8.6 (Book: ISBN: 978-1-118-94740-1) + lambda = 2*viscos_air/(pres*SQRT(8/(pi*rair*temp))) ! latent heat of vaporization, varies with T latvap = 1000*(-0.0000614342_r8*tc**3 + 0.00158927_r8*tc**2 - 2.36418_r8*tc + 2500.79_r8) - ! droplet terminal velocity after Chen & Liu, QJRMS 2004 + ! droplet terminal velocity after Chen & Liu, QJRMS 2004 (https://doi-org.cuucar.idm.oclc.org/10.1256/qj.03.41) a = 8.8462e2_r8 b = 9.7593e7_r8 c = -3.4249e-11_r8 @@ -635,54 +588,49 @@ subroutine collkernel( & ! Reynolds number Re = 2*vterm*r3lx*rho_air/viscos_air - ! thermal conductivity of air: Seinfeld & Pandis eq. 15.75 - Ktherm_air = 1.e-3_r8*(4.39_r8+0.071_r8*t) !J/(m s K) + ! thermal conductivity of air: Seinfeld & Pandis eq. 15.75 (Book: ISBN: 978-1-118-94740-1) + Ktherm_air = 1.e-3_r8*(4.39_r8+0.071_r8*temp) !J/(m s K) ! Prandtl number Pr = viscos_air*cpair/Ktherm_air - ! water vapor diffusivity: Pruppacher & Klett 13-3 - Dvap = 0.211e-4_r8*(t/273.15_r8)*(101325._r8/pres) + ! water vapor diffusivity: Pruppacher & Klett 13-3 (https://link.springer.com/book/10.1007/978-0-306-48100-0) + Dvap = 0.211e-4_r8*(temp/tmelt)*(pstd/pres) ! G-factor = rhoh2o*Xi in Rogers & Yau, p. 104 - G = rhoh2o/((latvap/(rh2o*t) - 1)*latvap*rhoh2o/(Ktherm_air*t) & - + rhoh2o*rh2o*t/(Dvap*eswtr)) - - ! variables depending on aerosol radius - ! loop over 3 aerosol modes - do i = 1, 3 - if (i == 1) r_a = r_bc - if (i == 2) r_a = r_dust_a1 - if (i == 3) r_a = r_dust_a3 - ! Knudsen number (Seinfeld & Pandis 8.1) - Kn = lambda/r_a - ! aerosol diffusivity - Daer = kboltz*t*(1 + Kn)/(6*pi*r_a*viscos_air) - ! Schmidt number - Sc = viscos_air/(Daer*rho_air) - - ! Young (1974) first equ. on page 771 - K_brownian = 4*pi*r3lx*Daer*(1 + 0.3_r8*Re**0.5_r8*Sc**0.33_r8) - - ! thermal conductivities from Seinfeld & Pandis, Table 8.6 - if (i == 1) Ktherm = 4.2_r8 ! Carbon - if (i == 2 .or. i == 3) Ktherm = 0.72_r8 ! clay - ! form factor - f_t = 0.4_r8*(1._r8 + 1.45_r8*Kn + 0.4_r8*Kn*EXP(-1._r8/Kn)) & - *(Ktherm_air + 2.5_r8*Kn*Ktherm) & - /((1._r8 + 3._r8*Kn)*(2._r8*Ktherm_air + 5._r8*Kn*Ktherm+Ktherm)) - ! calculate T-Tc as in Cotton et al. - Tdiff_cotton = -G*(rhwincloud - 1._r8)*latvap/Ktherm_air - Q_heat = Ktherm_air/r3lx*(1._r8 + 0.3_r8*Re**0.5_r8*Pr**0.33_r8)*Tdiff_cotton - K_thermo_cotton = 4._r8*pi*r3lx*r3lx*f_t*Q_heat/pres - K_diffusio_cotton = -(1._r8/f_t)*(rh2o*t/latvap)*K_thermo_cotton - K_total = 1.e6_r8*(K_brownian + K_thermo_cotton + K_diffusio_cotton) ! convert m3/s -> cm3/s - ! set K to 0 if negative - if (K_total .lt. 0._r8) K_total = 0._r8 - - if (i == 1) Kcoll_bc = K_total - if (i == 2) Kcoll_dust_a1 = K_total - if (i == 3) Kcoll_dust_a3 = K_total - + G = rhoh2o/((latvap/(rh2o*temp) - 1)*latvap*rhoh2o/(Ktherm_air*temp) & + + rhoh2o*rh2o*temp/(Dvap*eswtr)) + + do idx = 1,ntot + if (rad(idx)>0._r8) then + ! Knudsen number (Seinfeld & Pandis 8.1) (Book: ISBN: 978-1-118-94740-1) + Kn = lambda/rad(idx) + ! aerosol diffusivity + Daer = boltz*temp*(1 + Kn)/(6*pi*rad(idx)*viscos_air) + + ! Schmidt number + Sc = viscos_air/(Daer*rho_air) + + ! Young (1974) first equ. on page 771 (doi: 10.1175/1520-0469(1974)031<0768:TROCNI>2.0.CO;2) + K_brownian = 4*pi*r3lx*Daer*(1 + 0.3_r8*Re**0.5_r8*Sc**0.33_r8) + + ! thermal conductivities from Seinfeld & Pandis, Table 8.6 (Book: ISBN: 978-1-118-94740-1) + ! form factor + f_t = 0.4_r8*(1._r8 + 1.45_r8*Kn + 0.4_r8*Kn*EXP(-1._r8/Kn)) & + *(Ktherm_air + 2.5_r8*Kn*Ktherm(idx)) & + /((1._r8 + 3._r8*Kn)*(2._r8*Ktherm_air + 5._r8*Kn*Ktherm(idx)+Ktherm(idx))) + + ! calculate T-Tc as in Cotton et al. + Tdiff_cotton = -G*(rhwincloud - 1._r8)*latvap/Ktherm_air + Q_heat = Ktherm_air/r3lx*(1._r8 + 0.3_r8*Re**0.5_r8*Pr**0.33_r8)*Tdiff_cotton + K_thermo_cotton = 4._r8*pi*r3lx*r3lx*f_t*Q_heat/pres + K_diffusio_cotton = -(1._r8/f_t)*(rh2o*temp/latvap)*K_thermo_cotton + Kcoll(idx) = 1.e6_r8*(K_brownian + K_thermo_cotton + K_diffusio_cotton) ! convert m3/s -> cm3/s + + ! set K to 0 if negative + if (Kcoll(idx) < 0._r8) Kcoll(idx) = 0._r8 + else + Kcoll(idx) = 0._r8 + endif end do - + end subroutine collkernel !=================================================================================================== @@ -722,8 +670,7 @@ subroutine hetfrz_classnuc_init_pdftheta() do i = i1, i2 m = cos(dim_theta(i)) temp = (2+m)*(1-m)**2/4._r8 - dim_f_imm_dust_a1(i) = temp - dim_f_imm_dust_a3(i) = temp + dim_f_imm(i) = temp end do end subroutine hetfrz_classnuc_init_pdftheta diff --git a/src/physics/cam/hetfrz_classnuc_cam.F90 b/src/physics/cam/hetfrz_classnuc_cam.F90 index 8de3fa96ec..175ba8cfbb 100644 --- a/src/physics/cam/hetfrz_classnuc_cam.F90 +++ b/src/physics/cam/hetfrz_classnuc_cam.F90 @@ -8,28 +8,25 @@ module hetfrz_classnuc_cam use shr_kind_mod, only: r8=>shr_kind_r8 use spmd_utils, only: masterproc -use ppgrid, only: pcols, pver, begchunk, endchunk +use ppgrid, only: pcols, pver use physconst, only: rair, cpair, rh2o, rhoh2o, mwh2o, tmelt, pi use constituents, only: cnst_get_ind use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field -use phys_control, only: phys_getopts, use_hetfrz_classnuc -use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_idx, rad_cnst_get_spec_idx, & - rad_cnst_get_aer_mmr, rad_cnst_get_aer_props, & - rad_cnst_get_mode_num, rad_cnst_get_mode_props - +use phys_control, only: use_hetfrz_classnuc use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_old_tim_idx, & pbuf_get_index, pbuf_get_field -use cam_history, only: addfld, add_default, outfld - +use cam_history, only: addfld, add_default, outfld, fieldname_len use ref_pres, only: top_lev => trop_cloud_top_lev -use wv_saturation, only: svp_water, svp_ice - +use wv_saturation, only: svp_water_vect, svp_ice_vect use cam_logfile, only: iulog use error_messages, only: handle_errmsg, alloc_err use cam_abortutils, only: endrun +use string_utils, only: int2str +use hetfrz_classnuc,only: hetfrz_classnuc_init, hetfrz_classnuc_calc -use hetfrz_classnuc, only: hetfrz_classnuc_init, hetfrz_classnuc_calc +use aerosol_properties_mod, only: aerosol_properties, aero_name_len +use aerosol_state_mod, only: aerosol_state implicit none private @@ -39,11 +36,12 @@ module hetfrz_classnuc_cam hetfrz_classnuc_cam_readnl, & hetfrz_classnuc_cam_register, & hetfrz_classnuc_cam_init, & - hetfrz_classnuc_cam_calc, & - hetfrz_classnuc_cam_save_cbaero + hetfrz_classnuc_cam_calc ! Namelist variables logical :: hist_hetfrz_classnuc = .false. +real(r8) :: hetfrz_bc_scalfac = -huge(1._r8) ! scaling factor for BC +real(r8) :: hetfrz_dust_scalfac = -huge(1._r8) ! scaling factor for dust ! Vars set via init method. real(r8) :: mincld ! minimum allowed cloud fraction @@ -57,80 +55,32 @@ module hetfrz_classnuc_cam ! pbuf indices for fields provided by heterogeneous freezing integer :: & - frzimm_idx, & - frzcnt_idx, & - frzdep_idx + frzimm_idx = -1, & + frzcnt_idx = -1, & + frzdep_idx = -1 ! pbuf indices for fields needed by heterogeneous freezing integer :: & ast_idx = -1 -! modal aerosols -integer, parameter :: MAM3_nmodes = 3 -integer, parameter :: MAM7_nmodes = 7 -integer, parameter :: MAM4_nmodes = 4 -integer :: nmodes = -1 ! number of aerosol modes - -! mode indices -integer :: mode_accum_idx = -1 ! accumulation mode -integer :: mode_coarse_idx = -1 ! coarse mode -integer :: mode_finedust_idx = -1 ! fine dust mode -integer :: mode_coardust_idx = -1 ! coarse dust mode -integer :: mode_pcarbon_idx = -1 ! primary carbon mode - -! mode properties -real(r8) :: alnsg_mode_accum -real(r8) :: alnsg_mode_coarse -real(r8) :: alnsg_mode_finedust -real(r8) :: alnsg_mode_coardust -real(r8) :: alnsg_mode_pcarbon - -! specie properties -real(r8) :: specdens_dust -real(r8) :: specdens_so4 -real(r8) :: specdens_bc -real(r8) :: specdens_soa -real(r8) :: specdens_pom - -! List all species -integer :: ncnst = 0 ! Total number of constituents (mass and number) needed - ! by the parameterization (depends on aerosol model used) - -integer :: so4_accum ! sulfate in accumulation mode -integer :: bc_accum ! black-c in accumulation mode -integer :: pom_accum ! p-organic in accumulation mode -integer :: soa_accum ! s-organic in accumulation mode -integer :: dst_accum ! dust in accumulation mode -integer :: ncl_accum ! seasalt in accumulation mode -integer :: num_accum ! number in accumulation mode - -integer :: dst_coarse ! dust in coarse mode -integer :: ncl_coarse ! seasalt in coarse mode -integer :: so4_coarse ! sulfate in coarse mode -integer :: num_coarse ! number in coarse mode - -integer :: dst_finedust ! dust in finedust mode -integer :: so4_finedust ! sulfate in finedust mode -integer :: num_finedust ! number in finedust mode - -integer :: dst_coardust ! dust in coardust mode -integer :: so4_coardust ! sulfate in coardust mode -integer :: num_coardust ! number in coardust mode - -integer :: bc_pcarbon ! black-c in primary carbon mode -integer :: pom_pcarbon ! p-organic in primary carbon mode -integer :: num_pcarbon ! number in primary carbon mode - -! Index arrays for looping over all constituents -integer, allocatable :: mode_idx(:) -integer, allocatable :: spec_idx(:) - -! Copy of cloud borne aerosols before modification by droplet nucleation -! The basis is converted from mass to volume. -real(r8), allocatable :: aer_cb(:,:,:,:) - -! Copy of interstitial aerosols with basis converted from mass to volume. -real(r8), allocatable :: aer(:,:,:,:) +type index_t + integer :: bin_ndx + integer :: spc_ndx +end type index_t + +type(index_t),allocatable :: indices(:) +character(len=16),allocatable :: types(:) +character(len=fieldname_len),allocatable :: tot_dens_hnames(:) +character(len=fieldname_len),allocatable :: cld_dens_hnames(:) +character(len=fieldname_len),allocatable :: amb_dens_hnames(:) +character(len=fieldname_len),allocatable :: coated_dens_hnames(:) +character(len=fieldname_len),allocatable :: uncoated_dens_hnames(:) +character(len=fieldname_len),allocatable :: cldfn_dens_hnames(:) +character(len=fieldname_len),allocatable :: coated_frac_hnames(:) +character(len=fieldname_len),allocatable :: radius_hnames(:) +character(len=fieldname_len),allocatable :: wactfac_hnames(:) + +integer :: tot_num_bins = 0 !=============================================================================== contains @@ -140,7 +90,7 @@ subroutine hetfrz_classnuc_cam_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit - use mpishorthand + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical, mpi_real8, mpi_success character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -148,7 +98,7 @@ subroutine hetfrz_classnuc_cam_readnl(nlfile) integer :: unitn, ierr character(len=*), parameter :: subname = 'hetfrz_classnuc_cam_readnl' - namelist /hetfrz_classnuc_nl/ hist_hetfrz_classnuc + namelist /hetfrz_classnuc_nl/ hist_hetfrz_classnuc, hetfrz_bc_scalfac, hetfrz_dust_scalfac !----------------------------------------------------------------------------- @@ -164,13 +114,21 @@ subroutine hetfrz_classnuc_cam_readnl(nlfile) end if close(unitn) call freeunit(unitn) - end if -#ifdef SPMD ! Broadcast namelist variables - call mpibcast(hist_hetfrz_classnuc, 1, mpilog, 0, mpicom) -#endif + call mpi_bcast(hist_hetfrz_classnuc, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//" mpi_bcast: hist_hetfrz_classnuc") + call mpi_bcast(hetfrz_bc_scalfac, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//" mpi_bcast: hetfrz_bc_scalfac") + call mpi_bcast(hetfrz_dust_scalfac, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(subname//" mpi_bcast: hetfrz_dust_scalfac") + + if (masterproc) then + write(iulog,*) subname,': hist_hetfrz_classnuc = ',hist_hetfrz_classnuc + write(iulog,*) subname,': hetfrz_bc_scalfac = ',hetfrz_bc_scalfac + write(iulog,*) subname,': hetfrz_dust_scalfac = ',hetfrz_dust_scalfac + end if end subroutine hetfrz_classnuc_cam_readnl @@ -189,26 +147,109 @@ end subroutine hetfrz_classnuc_cam_register !================================================================================================ -subroutine hetfrz_classnuc_cam_init(mincld_in) +subroutine hetfrz_classnuc_cam_init(mincld_in, aero_props) real(r8), intent(in) :: mincld_in + class(aerosol_properties), intent(in) :: aero_props ! local variables - logical :: prog_modal_aero - integer :: m, n, nspec - integer :: istat - - real(r8) :: sigma_logr_aer - - character(len=32) :: str32 + integer :: istat, cnt, ibin, ispc + character(len=42) :: tmpstr + character(len=aero_name_len) :: species_type character(len=*), parameter :: routine = 'hetfrz_classnuc_cam_init' + !-------------------------------------------------------------------------------------------- if (.not. use_hetfrz_classnuc) return - ! This parameterization currently assumes that prognostic modal aerosols are on. Check... - call phys_getopts(prog_modal_aero_out=prog_modal_aero) - if (.not. prog_modal_aero) call endrun(routine//': cannot use hetfrz_classnuc without prognostic modal aerosols') + cnt = 0 + do ibin = 1, aero_props%nbins() + do ispc = 1, aero_props%nspecies(ibin) + if (aero_props%hetfrz_species(ibin,ispc)) then + cnt = cnt+1 + end if + end do + end do + + tot_num_bins = cnt + + allocate(indices(tot_num_bins), stat=istat) + call alloc_err(istat, routine, 'indices', tot_num_bins) + allocate(types(tot_num_bins), stat=istat) + call alloc_err(istat, routine, 'types', tot_num_bins) + + allocate(tot_dens_hnames(tot_num_bins), stat=istat) + call alloc_err(istat, routine, 'tot_dens_hnames', tot_num_bins) + + allocate(cld_dens_hnames(tot_num_bins), stat=istat) + call alloc_err(istat, routine, 'cld_dens_hnames', tot_num_bins) + + allocate(cldfn_dens_hnames(tot_num_bins), stat=istat) + call alloc_err(istat, routine, 'cldfn_dens_hnames', tot_num_bins) + + allocate(amb_dens_hnames(tot_num_bins), stat=istat) + call alloc_err(istat, routine, 'amb_dens_hnames', tot_num_bins) + + allocate(coated_dens_hnames(tot_num_bins), stat=istat) + call alloc_err(istat, routine, 'coated_dens_hnames', tot_num_bins) + + allocate(uncoated_dens_hnames(tot_num_bins), stat=istat) + call alloc_err(istat, routine, 'uncoated_dens_hnames', tot_num_bins) + + allocate(coated_frac_hnames(tot_num_bins), stat=istat) + call alloc_err(istat, routine, 'coated_frac_hnames', tot_num_bins) + + allocate(radius_hnames(tot_num_bins), stat=istat) + call alloc_err(istat, routine, 'radius_hnames', tot_num_bins) + + allocate(wactfac_hnames(tot_num_bins), stat=istat) + call alloc_err(istat, routine, 'wactfac_hnames', tot_num_bins) + + cnt = 0 + do ibin = 1, aero_props%nbins() + + do ispc = 1, aero_props%nspecies(ibin) + if (aero_props%hetfrz_species(ibin,ispc)) then + call aero_props%species_type(ibin, ispc, species_type) + cnt = cnt+1 + indices(cnt)%bin_ndx = ibin + indices(cnt)%spc_ndx = ispc + types(cnt) = trim(species_type) + tmpstr = trim(species_type)//trim(int2str(ibin)) + + cldfn_dens_hnames(cnt) = trim(tmpstr)//'_cld_fn' + tot_dens_hnames(cnt) = trim(tmpstr)//'_tot_num' + cld_dens_hnames(cnt) = trim(tmpstr)//'_cld_num' + amb_dens_hnames(cnt) = trim(tmpstr)//'_amb_num' + coated_dens_hnames(cnt) = trim(tmpstr)//'_coated' + uncoated_dens_hnames(cnt) = trim(tmpstr)//'_uncoated' + coated_frac_hnames(cnt) = trim(tmpstr)//'_coated_frac' + radius_hnames(cnt) = trim(tmpstr)//'_radius' + wactfac_hnames(cnt) = trim(tmpstr)//'_wactfac' + + call addfld(tot_dens_hnames(cnt),(/ 'lev' /), 'A', '#/cm3', & + 'total '//trim(tmpstr)//' number density', sampled_on_subcycle=.true.) + call addfld(cld_dens_hnames(cnt),(/ 'lev' /), 'A', '#/cm3', & + 'cloud borne '//trim(tmpstr)//' number density', sampled_on_subcycle=.true.) + call addfld(cldfn_dens_hnames(cnt),(/ 'lev' /), 'A', '#/cm3', & + 'cloud borne '//trim(tmpstr)//' number density derived from fn', sampled_on_subcycle=.true.) + call addfld(amb_dens_hnames(cnt),(/ 'lev' /), 'A', '#/cm3', & + 'ambient '//trim(tmpstr)//' number density', sampled_on_subcycle=.true.) + call addfld(coated_dens_hnames(cnt),(/ 'lev' /), 'A', '#/cm3', & + 'coated '//trim(tmpstr)//' number density', sampled_on_subcycle=.true.) + call addfld(uncoated_dens_hnames(cnt),(/ 'lev' /), 'A', '#/cm3', & + 'uncoated '//trim(tmpstr)//' number density', sampled_on_subcycle=.true.) + call addfld(coated_frac_hnames(cnt),(/ 'lev' /), 'A', '#/cm3', & + 'coated '//trim(tmpstr)//' fraction', sampled_on_subcycle=.true.) + call addfld(radius_hnames(cnt),(/ 'lev' /), 'A', 'm', & + 'ambient '//trim(tmpstr)//' radius', sampled_on_subcycle=.true.) + call addfld(wactfac_hnames(cnt),(/ 'lev' /), 'A', ' ', & + trim(tmpstr)//' water activity mass factor', sampled_on_subcycle=.true.) + + end if + end do + + end do mincld = mincld_in @@ -220,97 +261,52 @@ subroutine hetfrz_classnuc_cam_init(mincld_in) ! pbuf fields used by hetfrz_classnuc ast_idx = pbuf_get_index('AST') - call addfld('bc_num', (/ 'lev' /), 'A', '#/cm3', 'total bc number') - call addfld('dst1_num', (/ 'lev' /), 'A', '#/cm3', 'total dst1 number') - call addfld('dst3_num', (/ 'lev' /), 'A', '#/cm3', 'total dst3 number') - call addfld('bcc_num', (/ 'lev' /), 'A', '#/cm3', 'coated bc number') - call addfld('dst1c_num', (/ 'lev' /), 'A', '#/cm3', 'coated dst1 number') - call addfld('dst3c_num', (/ 'lev' /), 'A', '#/cm3', 'coated dst3 number') - call addfld('bcuc_num', (/ 'lev' /), 'A', '#/cm3', 'uncoated bc number') - call addfld('dst1uc_num', (/ 'lev' /), 'A', '#/cm3', 'uncoated dst1 number') - call addfld('dst3uc_num', (/ 'lev' /), 'A', '#/cm3', 'uncoated dst3 number') - - call addfld('bc_a1_num', (/ 'lev' /), 'A', '#/cm3', 'interstitial bc number') - call addfld('dst_a1_num', (/ 'lev' /), 'A', '#/cm3', 'interstitial dst1 number') - call addfld('dst_a3_num', (/ 'lev' /), 'A', '#/cm3', 'interstitial dst3 number') - call addfld('bc_c1_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne bc number') - call addfld('dst_c1_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne dst1 number') - call addfld('dst_c3_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne dst3 number') - - call addfld('fn_bc_c1_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne bc number derived from fn') - call addfld('fn_dst_c1_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne dst1 number derived from fn') - call addfld('fn_dst_c3_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne dst3 number derived from fn') - - call addfld('na500', (/ 'lev' /), 'A', '#/cm3', 'interstitial aerosol number with D>500 nm') - call addfld('totna500', (/ 'lev' /), 'A', '#/cm3', 'total aerosol number with D>500 nm') - - call addfld('FREQIMM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of immersion freezing') - call addfld('FREQCNT', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of contact freezing') - call addfld('FREQDEP', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of deposition freezing') - call addfld('FREQMIX', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of mixed-phase clouds' ) - - call addfld('DSTFREZIMM', (/ 'lev' /), 'A', 'm-3s-1', 'dust immersion freezing rate') - call addfld('DSTFREZCNT', (/ 'lev' /), 'A', 'm-3s-1', 'dust contact freezing rate') - call addfld('DSTFREZDEP', (/ 'lev' /), 'A', 'm-3s-1', 'dust deposition freezing rate') - - call addfld('BCFREZIMM', (/ 'lev' /), 'A', 'm-3s-1', 'bc immersion freezing rate') - call addfld('BCFREZCNT', (/ 'lev' /), 'A', 'm-3s-1', 'bc contact freezing rate') - call addfld('BCFREZDEP', (/ 'lev' /), 'A', 'm-3s-1', 'bc deposition freezing rate') + call addfld('FRZIMM', (/ 'lev' /), 'A', ' ', 'immersion freezing', sampled_on_subcycle=.true.) + call addfld('FRZCNT', (/ 'lev' /), 'A', ' ', 'contact freezing', sampled_on_subcycle=.true.) + call addfld('FRZDEP', (/ 'lev' /), 'A', ' ', 'deposition freezing', sampled_on_subcycle=.true.) + call addfld('FREQIMM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of immersion freezing', sampled_on_subcycle=.true.) + call addfld('FREQCNT', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of contact freezing', sampled_on_subcycle=.true.) + call addfld('FREQDEP', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of deposition freezing', sampled_on_subcycle=.true.) + call addfld('FREQMIX', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of mixed-phase clouds' , sampled_on_subcycle=.true.) + + call addfld('DSTFREZIMM', (/ 'lev' /), 'A', 'm-3s-1', 'dust immersion freezing rate', sampled_on_subcycle=.true.) + call addfld('DSTFREZCNT', (/ 'lev' /), 'A', 'm-3s-1', 'dust contact freezing rate', sampled_on_subcycle=.true.) + call addfld('DSTFREZDEP', (/ 'lev' /), 'A', 'm-3s-1', 'dust deposition freezing rate', sampled_on_subcycle=.true.) + + call addfld('BCFREZIMM', (/ 'lev' /), 'A', 'm-3s-1', 'bc immersion freezing rate', sampled_on_subcycle=.true.) + call addfld('BCFREZCNT', (/ 'lev' /), 'A', 'm-3s-1', 'bc contact freezing rate', sampled_on_subcycle=.true.) + call addfld('BCFREZDEP', (/ 'lev' /), 'A', 'm-3s-1', 'bc deposition freezing rate', sampled_on_subcycle=.true.) call addfld('NIMIX_IMM', (/ 'lev' /), 'A', '#/m3', & - 'Activated Ice Number Concentration due to het immersion freezing in Mixed Clouds') + 'Activated Ice Number Concentration due to het immersion freezing in Mixed Clouds', sampled_on_subcycle=.true.) call addfld('NIMIX_CNT', (/ 'lev' /), 'A', '#/m3', & - 'Activated Ice Number Concentration due to het contact freezing in Mixed Clouds') + 'Activated Ice Number Concentration due to het contact freezing in Mixed Clouds', sampled_on_subcycle=.true.) call addfld('NIMIX_DEP', (/ 'lev' /), 'A', '#/m3', & - 'Activated Ice Number Concentration due to het deposition freezing in Mixed Clouds') + 'Activated Ice Number Concentration due to het deposition freezing in Mixed Clouds', sampled_on_subcycle=.true.) call addfld('DSTNIDEP', (/ 'lev' /), 'A', '#/m3', & - 'Activated Ice Number Concentration due to dst dep freezing in Mixed Clouds') + 'Activated Ice Number Concentration due to dst dep freezing in Mixed Clouds', sampled_on_subcycle=.true.) call addfld('DSTNICNT', (/ 'lev' /), 'A', '#/m3', & - 'Activated Ice Number Concentration due to dst cnt freezing in Mixed Clouds') + 'Activated Ice Number Concentration due to dst cnt freezing in Mixed Clouds', sampled_on_subcycle=.true.) call addfld('DSTNIIMM', (/ 'lev' /), 'A', '#/m3', & - 'Activated Ice Number Concentration due to dst imm freezing in Mixed Clouds') + 'Activated Ice Number Concentration due to dst imm freezing in Mixed Clouds', sampled_on_subcycle=.true.) call addfld('BCNIDEP', (/ 'lev' /), 'A', '#/m3', & - 'Activated Ice Number Concentration due to bc dep freezing in Mixed Clouds') + 'Activated Ice Number Concentration due to bc dep freezing in Mixed Clouds', sampled_on_subcycle=.true.) call addfld('BCNICNT', (/ 'lev' /), 'A', '#/m3', & - 'Activated Ice Number Concentration due to bc cnt freezing in Mixed Clouds') + 'Activated Ice Number Concentration due to bc cnt freezing in Mixed Clouds', sampled_on_subcycle=.true.) call addfld('BCNIIMM', (/ 'lev' /), 'A', '#/m3', & - 'Activated Ice Number Concentration due to bc imm freezing in Mixed Clouds') + 'Activated Ice Number Concentration due to bc imm freezing in Mixed Clouds', sampled_on_subcycle=.true.) call addfld('NUMICE10s', (/ 'lev' /), 'A', '#/m3', & - 'Ice Number Concentration due to het freezing in Mixed Clouds during 10-s period') + 'Ice Number Concentration due to het freezing in Mixed Clouds during 10-s period', sampled_on_subcycle=.true.) call addfld('NUMIMM10sDST', (/ 'lev' /), 'A', '#/m3', & - 'Ice Number Concentration due to imm freezing by dst in Mixed Clouds during 10-s period') + 'Ice Number Concentration due to imm freezing by dst in Mixed Clouds during 10-s period', sampled_on_subcycle=.true.) call addfld('NUMIMM10sBC', (/ 'lev' /), 'A', '#/m3', & - 'Ice Number Concentration due to imm freezing by bc in Mixed Clouds during 10-s period') + 'Ice Number Concentration due to imm freezing by bc in Mixed Clouds during 10-s period', sampled_on_subcycle=.true.) if (hist_hetfrz_classnuc) then - call add_default('bc_num', 1, ' ') - call add_default('dst1_num', 1, ' ') - call add_default('dst3_num', 1, ' ') - call add_default('bcc_num', 1, ' ') - call add_default('dst1c_num', 1, ' ') - call add_default('dst3c_num', 1, ' ') - call add_default('bcuc_num', 1, ' ') - call add_default('dst1uc_num', 1, ' ') - call add_default('dst3uc_num', 1, ' ') - - call add_default('bc_a1_num', 1, ' ') - call add_default('dst_a1_num', 1, ' ') - call add_default('dst_a3_num', 1, ' ') - call add_default('bc_c1_num', 1, ' ') - call add_default('dst_c1_num', 1, ' ') - call add_default('dst_c3_num', 1, ' ') - - call add_default('fn_bc_c1_num', 1, ' ') - call add_default('fn_dst_c1_num', 1, ' ') - call add_default('fn_dst_c3_num', 1, ' ') - - call add_default('na500', 1, ' ') - call add_default('totna500', 1, ' ') - call add_default('FREQIMM', 1, ' ') call add_default('FREQCNT', 1, ' ') call add_default('FREQDEP', 1, ' ') @@ -325,7 +321,7 @@ subroutine hetfrz_classnuc_cam_init(mincld_in) call add_default('BCFREZDEP', 1, ' ') call add_default('NIMIX_IMM', 1, ' ') - call add_default('NIMIX_CNT', 1, ' ') + call add_default('NIMIX_CNT', 1, ' ') call add_default('NIMIX_DEP', 1, ' ') call add_default('DSTNIDEP', 1, ' ') @@ -342,241 +338,23 @@ subroutine hetfrz_classnuc_cam_init(mincld_in) end if - ! The following code sets indices of the mode specific species used - ! in the module. Having a list of the species needed allows us to - ! allocate temporary space for just those species rather than for all the - ! CAM species (pcnst) which may be considerably more than needed. - ! - ! The indices set below are for use with the CAM rad_constituents - ! interfaces. Using the rad_constituents interfaces isolates the physics - ! parameterization which requires constituent information from the chemistry - ! code which provides that information. - - ! nmodes is the total number of modes - call rad_cnst_get_info(0, nmodes=nmodes) - - ! Determine mode indices for all modes referenced in this module. - mode_accum_idx = rad_cnst_get_mode_idx(0, 'accum') - mode_coarse_idx = rad_cnst_get_mode_idx(0, 'coarse') - mode_finedust_idx = rad_cnst_get_mode_idx(0, 'fine_dust') - mode_coardust_idx = rad_cnst_get_mode_idx(0, 'coarse_dust') - mode_pcarbon_idx = rad_cnst_get_mode_idx(0, 'primary_carbon') - - ! Check that required mode types were found - if (nmodes == MAM3_nmodes) then - if (mode_accum_idx == -1 .or. mode_coarse_idx == -1) then - write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & - mode_accum_idx, mode_coarse_idx - call endrun(routine//': ERROR required mode type not found') - end if - - else if (nmodes == MAM7_nmodes) then - if (mode_coardust_idx == -1 .or. mode_finedust_idx == -1 .or. mode_pcarbon_idx == -1) then - write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & - mode_coardust_idx, mode_finedust_idx, mode_pcarbon_idx - call endrun(routine//': ERROR required mode type not found') - end if - else if (nmodes == MAM4_nmodes) then - if (mode_accum_idx == -1 .or. mode_coarse_idx == -1 .or. mode_pcarbon_idx == -1) then - write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & - mode_accum_idx, mode_coarse_idx, mode_pcarbon_idx - call endrun(routine//': ERROR required mode type not found') - end if - end if - - ! Set some mode properties - - call rad_cnst_get_mode_props(0, mode_accum_idx, sigmag=sigma_logr_aer) - alnsg_mode_accum = log(sigma_logr_aer) - - if (nmodes == MAM3_nmodes) then - call rad_cnst_get_mode_props(0, mode_coarse_idx, sigmag=sigma_logr_aer) - alnsg_mode_coarse = log(sigma_logr_aer) - - else if (nmodes == MAM7_nmodes) then - call rad_cnst_get_mode_props(0, mode_finedust_idx, sigmag=sigma_logr_aer) - alnsg_mode_finedust = log(sigma_logr_aer) - - call rad_cnst_get_mode_props(0, mode_coardust_idx, sigmag=sigma_logr_aer) - alnsg_mode_coardust = log(sigma_logr_aer) - - call rad_cnst_get_mode_props(0, mode_pcarbon_idx, sigmag=sigma_logr_aer) - alnsg_mode_pcarbon = log(sigma_logr_aer) - - else if (nmodes == MAM4_nmodes) then - call rad_cnst_get_mode_props(0, mode_coarse_idx, sigmag=sigma_logr_aer) - alnsg_mode_coarse = log(sigma_logr_aer) - - call rad_cnst_get_mode_props(0, mode_pcarbon_idx, sigmag=sigma_logr_aer) - alnsg_mode_pcarbon = log(sigma_logr_aer) - end if - - ! Set list indices for all constituents (mass and number) used in this module. - ! The list is specific to the aerosol model used. Note that the order of the - ! constituents in these lists is arbitrary. - - if (nmodes == MAM3_nmodes) then - ncnst = 11 - so4_accum = 1 - bc_accum = 2 - pom_accum = 3 - soa_accum = 4 - dst_accum = 5 - ncl_accum = 6 - num_accum = 7 - dst_coarse = 8 - ncl_coarse = 9 - so4_coarse = 10 - num_coarse = 11 - else if (nmodes == MAM7_nmodes) then - ncnst = 15 - so4_accum = 1 - bc_accum = 2 - pom_accum = 3 - soa_accum = 4 - ncl_accum = 6 - num_accum = 7 - dst_finedust = 8 - so4_finedust = 9 - num_finedust = 10 - dst_coardust = 11 - so4_coardust = 12 - num_coardust = 13 - bc_pcarbon = 5 - pom_pcarbon = 14 - num_pcarbon = 15 - else if (nmodes == MAM4_nmodes) then - ncnst = 14 - so4_accum = 1 - bc_accum = 2 - pom_accum = 3 - soa_accum = 4 - dst_accum = 5 - ncl_accum = 6 - num_accum = 7 - dst_coarse = 8 - ncl_coarse = 9 - so4_coarse = 10 - num_coarse = 11 - bc_pcarbon = 12 - pom_pcarbon = 13 - num_pcarbon = 14 - end if - - ! Allocate arrays to hold specie and mode indices for all constitutents (mass and number) - ! needed in this module. - allocate(mode_idx(ncnst), spec_idx(ncnst), stat=istat) - call alloc_err(istat, routine, 'mode_idx, spec_idx', ncnst) - mode_idx = -1 - spec_idx = -1 - - ! Allocate space for copy of cloud borne aerosols before modification by droplet nucleation. - allocate(aer_cb(pcols,pver,ncnst,begchunk:endchunk), stat=istat) - call alloc_err(istat, routine, 'aer_cb', pcols*pver*ncnst*(endchunk-begchunk+1)) - - ! Allocate space for copy of interstitial aerosols with modified basis - allocate(aer(pcols,pver,ncnst,begchunk:endchunk), stat=istat) - call alloc_err(istat, routine, 'aer', pcols*pver*ncnst*(endchunk-begchunk+1)) - - ! The following code sets the species and mode indices for each constituent - ! in the list. The indices are identical in the interstitial and the cloud - ! borne phases. - ! Specie index 0 is used to indicate the mode number mixing ratio - - ! Indices for species in accumulation mode (so4, bc, pom, soa, nacl, dust) - spec_idx(num_accum) = 0 - mode_idx(num_accum) = mode_accum_idx - spec_idx(so4_accum) = rad_cnst_get_spec_idx(0, mode_accum_idx, 'sulfate') - mode_idx(so4_accum) = mode_accum_idx - spec_idx(bc_accum) = rad_cnst_get_spec_idx(0, mode_accum_idx, 'black-c') - mode_idx(bc_accum) = mode_accum_idx - spec_idx(pom_accum) = rad_cnst_get_spec_idx(0, mode_accum_idx, 'p-organic') - mode_idx(pom_accum) = mode_accum_idx - spec_idx(soa_accum) = rad_cnst_get_spec_idx(0, mode_accum_idx, 's-organic') - mode_idx(soa_accum) = mode_accum_idx - spec_idx(ncl_accum) = rad_cnst_get_spec_idx(0, mode_accum_idx, 'seasalt') - mode_idx(ncl_accum) = mode_accum_idx - if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then - spec_idx(dst_accum) = rad_cnst_get_spec_idx(0, mode_accum_idx, 'dust') - mode_idx(dst_accum) = mode_accum_idx - end if - - ! Indices for species in coarse mode (dust, nacl, so4) - if (mode_coarse_idx > 0) then - spec_idx(num_coarse) = 0 - mode_idx(num_coarse) = mode_coarse_idx - spec_idx(ncl_coarse) = rad_cnst_get_spec_idx(0, mode_coarse_idx, 'seasalt') - mode_idx(ncl_coarse) = mode_coarse_idx - spec_idx(dst_coarse) = rad_cnst_get_spec_idx(0, mode_coarse_idx, 'dust') - mode_idx(dst_coarse) = mode_coarse_idx - spec_idx(so4_coarse) = rad_cnst_get_spec_idx(0, mode_coarse_idx, 'sulfate') - mode_idx(so4_coarse) = mode_coarse_idx - end if - - ! Indices for species in fine dust mode (dust, so4) - if (mode_finedust_idx > 0) then - spec_idx(num_finedust) = 0 - mode_idx(num_finedust) = mode_finedust_idx - spec_idx(dst_finedust) = rad_cnst_get_spec_idx(0, mode_finedust_idx, 'dust') - mode_idx(dst_finedust) = mode_finedust_idx - spec_idx(so4_finedust) = rad_cnst_get_spec_idx(0, mode_finedust_idx, 'sulfate') - mode_idx(so4_finedust) = mode_finedust_idx - end if - - ! Indices for species in coarse dust mode (dust, so4) - if (mode_coardust_idx > 0) then - spec_idx(num_coardust) = 0 - mode_idx(num_coardust) = mode_coardust_idx - spec_idx(dst_coardust) = rad_cnst_get_spec_idx(0, mode_coardust_idx, 'dust') - mode_idx(dst_coardust) = mode_coardust_idx - spec_idx(so4_coardust) = rad_cnst_get_spec_idx(0, mode_coardust_idx, 'sulfate') - mode_idx(so4_coardust) = mode_coardust_idx - end if - - ! Indices for species in primary carbon mode (bc, pom) - if (mode_pcarbon_idx > 0) then - spec_idx(num_pcarbon) = 0 - mode_idx(num_pcarbon) = mode_pcarbon_idx - spec_idx(bc_pcarbon) = rad_cnst_get_spec_idx(0, mode_pcarbon_idx, 'black-c') - mode_idx(bc_pcarbon) = mode_pcarbon_idx - spec_idx(pom_pcarbon) = rad_cnst_get_spec_idx(0, mode_pcarbon_idx, 'p-organic') - mode_idx(pom_pcarbon) = mode_pcarbon_idx - end if - - ! Check that all required specie types were found - if (any(spec_idx == -1)) then - write(iulog,*) routine//': ERROR required species type not found - indicies:', spec_idx - call endrun(routine//': ERROR required species type not found') - end if - - ! Get some specie specific properties. - if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then - call rad_cnst_get_aer_props(0, mode_idx(dst_accum), spec_idx(dst_accum), density_aer=specdens_dust) - else if (nmodes == MAM7_nmodes) then - call rad_cnst_get_aer_props(0, mode_idx(dst_finedust), spec_idx(dst_finedust), density_aer=specdens_dust) - end if - call rad_cnst_get_aer_props(0, mode_idx(so4_accum), spec_idx(so4_accum), density_aer=specdens_so4) - call rad_cnst_get_aer_props(0, mode_idx(bc_accum), spec_idx(bc_accum), density_aer=specdens_bc) - call rad_cnst_get_aer_props(0, mode_idx(soa_accum), spec_idx(soa_accum), density_aer=specdens_soa) - call rad_cnst_get_aer_props(0, mode_idx(pom_accum), spec_idx(pom_accum), density_aer=specdens_pom) - - call hetfrz_classnuc_init( & - rair, cpair, rh2o, rhoh2o, mwh2o, & - tmelt, pi, iulog) + call hetfrz_classnuc_init(rair, cpair, rh2o, rhoh2o, mwh2o, tmelt, iulog, & + hetfrz_bc_scalfac, hetfrz_dust_scalfac ) end subroutine hetfrz_classnuc_cam_init !================================================================================================ -subroutine hetfrz_classnuc_cam_calc( & - state, deltatin, factnum, pbuf) +subroutine hetfrz_classnuc_cam_calc(aero_props, aero_state, state, deltatin, factnum, pbuf) ! arguments - type(physics_state), target, intent(in) :: state - real(r8), intent(in) :: deltatin ! time step (s) - real(r8), intent(in) :: factnum(:,:,:) ! activation fraction for aerosol number - type(physics_buffer_desc), pointer :: pbuf(:) - + class(aerosol_properties), intent(in) :: aero_props + class(aerosol_state), intent(in) :: aero_state + type(physics_state), target, intent(in) :: state + real(r8), intent(in) :: deltatin ! time step (s) + real(r8), intent(in) :: factnum(:,:,:) ! activation fraction for aerosol number + type(physics_buffer_desc), pointer :: pbuf(:) + ! local workspace ! outputs shared with the microphysics via the pbuf @@ -589,26 +367,11 @@ subroutine hetfrz_classnuc_cam_calc( & real(r8) :: rho(pcols,pver) ! air density (kg m-3) - real(r8), pointer :: ast(:,:) + real(r8), pointer :: ast(:,:) real(r8) :: lcldm(pcols,pver) - real(r8), pointer :: ptr2d(:,:) - - real(r8) :: fn(3) - real(r8) :: awcam(pcols,pver,3) - real(r8) :: awfacm(pcols,pver,3) - real(r8) :: hetraer(pcols,pver,3) - real(r8) :: dstcoat(pcols,pver,3) - real(r8) :: total_interstitial_aer_num(pcols,pver,3) - real(r8) :: total_cloudborne_aer_num(pcols,pver,3) - real(r8) :: total_aer_num(pcols,pver,3) - real(r8) :: coated_aer_num(pcols,pver,3) - real(r8) :: uncoated_aer_num(pcols,pver,3) - - real(r8) :: fn_cloudborne_aer_num(pcols,pver,3) - - + real(r8) :: esi(pcols), esl(pcols) real(r8) :: con1, r3lx, supersatice real(r8) :: qcic @@ -619,6 +382,7 @@ subroutine hetfrz_classnuc_cam_calc( & real(r8) :: frzbcdep(pcols,pver), frzdudep(pcols,pver) real(r8) :: freqimm(pcols,pver), freqcnt(pcols,pver), freqdep(pcols,pver), freqmix(pcols,pver) + real(r8) :: nnuccc_bc(pcols,pver), nnucct_bc(pcols,pver), nnudep_bc(pcols,pver) real(r8) :: nnuccc_dst(pcols,pver), nnucct_dst(pcols,pver), nnudep_dst(pcols,pver) real(r8) :: niimm_bc(pcols,pver), nicnt_bc(pcols,pver), nidep_bc(pcols,pver) @@ -627,8 +391,17 @@ subroutine hetfrz_classnuc_cam_calc( & real(r8) :: numice10s_imm_dst(pcols,pver) real(r8) :: numice10s_imm_bc(pcols,pver) - real(r8) :: na500(pcols,pver) - real(r8) :: tot_na500(pcols,pver) + real(r8) :: coated(pcols,pver,tot_num_bins) + real(r8) :: aer_radius(pcols,pver,tot_num_bins) + real(r8) :: aer_wactfac(pcols,pver,tot_num_bins) + + real(r8) :: coated_amb_aer_num(pcols,pver,tot_num_bins) + real(r8) :: uncoated_amb_aer_num(pcols,pver,tot_num_bins) + real(r8) :: amb_aer_num(pcols,pver,tot_num_bins) + real(r8) :: cld_aer_num(pcols,pver,tot_num_bins) + real(r8) :: tot_aer_num(pcols,pver,tot_num_bins) + real(r8) :: fn_cld_aer_num(pcols,pver) + real(r8) :: fraction_activated(pcols,pver,tot_num_bins) character(128) :: errstring ! Error status !------------------------------------------------------------------------------- @@ -658,85 +431,45 @@ subroutine hetfrz_classnuc_cam_calc( & end do end do - ! Convert interstitial and cloud borne aerosols from a mass to a volume basis before - ! being used in get_aer_num - do i = 1, ncnst - aer_cb(:ncol,:,i,lchnk) = aer_cb(:ncol,:,i,lchnk) * rho(:ncol,:) - - ! Check whether constituent is a mass or number mixing ratio - if (spec_idx(i) == 0) then - call rad_cnst_get_mode_num(0, mode_idx(i), 'a', state, pbuf, ptr2d) - else - call rad_cnst_get_aer_mmr(0, mode_idx(i), spec_idx(i), 'a', state, pbuf, ptr2d) - end if - aer(:ncol,:,i,lchnk) = ptr2d(:ncol,:) * rho(:ncol,:) - end do + do i = 1,tot_num_bins - ! Init top levels of outputs of get_aer_num - total_aer_num = 0._r8 - coated_aer_num = 0._r8 - uncoated_aer_num = 0._r8 - total_interstitial_aer_num = 0._r8 - total_cloudborne_aer_num = 0._r8 - hetraer = 0._r8 - awcam = 0._r8 - awfacm = 0._r8 - dstcoat = 0._r8 - na500 = 0._r8 - tot_na500 = 0._r8 - - ! output aerosols as reference information for heterogeneous freezing - do i = 1, ncol - do k = top_lev, pver - call get_aer_num(i, k, ncnst, aer(:,:,:,lchnk), aer_cb(:,:,:,lchnk), rho(i,k), & - total_aer_num(i,k,:), coated_aer_num(i,k,:), uncoated_aer_num(i,k,:), & - total_interstitial_aer_num(i,k,:), total_cloudborne_aer_num(i,k,:), & - hetraer(i,k,:), awcam(i,k,:), awfacm(i,k,:), dstcoat(i,k,:), & - na500(i,k), tot_na500(i,k)) - - fn_cloudborne_aer_num(i,k,1) = total_aer_num(i,k,1)*factnum(i,k,mode_accum_idx) ! bc - if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then - fn_cloudborne_aer_num(i,k,2) = total_aer_num(i,k,2)*factnum(i,k,mode_accum_idx) ! dst_a1 - fn_cloudborne_aer_num(i,k,3) = total_aer_num(i,k,3)*factnum(i,k,mode_coarse_idx) ! dst_a3 - else if (nmodes == MAM7_nmodes) then - fn_cloudborne_aer_num(i,k,2) = total_aer_num(i,k,2)*factnum(i,k,mode_finedust_idx) - fn_cloudborne_aer_num(i,k,3) = total_aer_num(i,k,3)*factnum(i,k,mode_coardust_idx) - end if - end do - end do + call aero_state%get_amb_species_numdens( indices(i)%bin_ndx, ncol, pver, types(i), aero_props, rho, amb_aer_num(:,:,i)) + call aero_state%get_cld_species_numdens( indices(i)%bin_ndx, ncol, pver, types(i), aero_props, rho, cld_aer_num(:,:,i)) + + tot_aer_num(:ncol,:,i) = cld_aer_num(:ncol,:,i) + amb_aer_num(:ncol,:,i) + + call outfld(tot_dens_hnames(i), tot_aer_num(:,:,i), pcols, lchnk) + call outfld(amb_dens_hnames(i), amb_aer_num(:,:,i), pcols, lchnk) + call outfld(cld_dens_hnames(i), cld_aer_num(:,:,i), pcols, lchnk) + + aer_radius(:ncol,:,i) = aero_state%mass_mean_radius( indices(i)%bin_ndx, indices(i)%spc_ndx, ncol, pver, aero_props, rho ) + + coated(:ncol,:,i) = aero_state%coated_frac( indices(i)%bin_ndx, types(i), ncol, pver, aero_props, aer_radius(:,:,i) ) - call outfld('bc_num', total_aer_num(:,:,1), pcols, lchnk) - call outfld('dst1_num', total_aer_num(:,:,2), pcols, lchnk) - call outfld('dst3_num', total_aer_num(:,:,3), pcols, lchnk) + call outfld(coated_frac_hnames(i), coated(:,:,i), pcols, lchnk) - call outfld('bcc_num', coated_aer_num(:,:,1), pcols, lchnk) - call outfld('dst1c_num', coated_aer_num(:,:,2), pcols, lchnk) - call outfld('dst3c_num', coated_aer_num(:,:,3), pcols, lchnk) + coated_amb_aer_num(:ncol,:,i) = amb_aer_num(:ncol,:,i)*coated(:ncol,:,i) + uncoated_amb_aer_num(:ncol,:,i) = amb_aer_num(:ncol,:,i)*(1._r8-coated(:ncol,:,i)) - call outfld('bcuc_num', uncoated_aer_num(:,:,1), pcols, lchnk) - call outfld('dst1uc_num', uncoated_aer_num(:,:,2), pcols, lchnk) - call outfld('dst3uc_num', uncoated_aer_num(:,:,3), pcols, lchnk) + call outfld(coated_dens_hnames(i), coated_amb_aer_num(:,:,i), pcols, lchnk) + call outfld(uncoated_dens_hnames(i), uncoated_amb_aer_num(:,:,i), pcols, lchnk) + call outfld(radius_hnames(i), aer_radius(:ncol,:,i), ncol, lchnk) - call outfld('bc_a1_num', total_interstitial_aer_num(:,:,1), pcols, lchnk) - call outfld('dst_a1_num', total_interstitial_aer_num(:,:,2), pcols, lchnk) - call outfld('dst_a3_num', total_interstitial_aer_num(:,:,3), pcols, lchnk) + call aero_state%watact_mfactor(indices(i)%bin_ndx, types(i), ncol, pver, aero_props, rho, aer_wactfac(:ncol,:,i)) + call outfld(wactfac_hnames(i), aer_wactfac(:,:,i), pcols, lchnk) - call outfld('bc_c1_num', total_cloudborne_aer_num(:,:,1), pcols, lchnk) - call outfld('dst_c1_num', total_cloudborne_aer_num(:,:,2), pcols, lchnk) - call outfld('dst_c3_num', total_cloudborne_aer_num(:,:,3), pcols, lchnk) + fn_cld_aer_num(:ncol,:) = tot_aer_num(:ncol,:,i)*factnum(:ncol,:,indices(i)%bin_ndx) + call outfld(cldfn_dens_hnames(i), fn_cld_aer_num, pcols, lchnk) - call outfld('fn_bc_c1_num', fn_cloudborne_aer_num(:,:,1), pcols, lchnk) - call outfld('fn_dst_c1_num', fn_cloudborne_aer_num(:,:,2), pcols, lchnk) - call outfld('fn_dst_c3_num', fn_cloudborne_aer_num(:,:,3), pcols, lchnk) - - call outfld('na500', na500, pcols, lchnk) - call outfld('totna500', tot_na500, pcols, lchnk) + fraction_activated(:ncol,:,i) = factnum(:ncol,:,indices(i)%bin_ndx) + + end do ! frzimm, frzcnt, frzdep are the outputs of this parameterization used by the microphysics call pbuf_get_field(pbuf, frzimm_idx, frzimm) call pbuf_get_field(pbuf, frzcnt_idx, frzcnt) call pbuf_get_field(pbuf, frzdep_idx, frzdep) - + frzimm(:ncol,:) = 0._r8 frzcnt(:ncol,:) = 0._r8 frzdep(:ncol,:) = 0._r8 @@ -773,8 +506,10 @@ subroutine hetfrz_classnuc_cam_calc( & nicnt_dst(:,:) = 0._r8 nidep_dst(:,:) = 0._r8 - do i = 1, ncol - do k = top_lev, pver + do k = top_lev, pver + call svp_water_vect(t(1:ncol,k), esl(1:ncol), ncol) + call svp_ice_vect(t(1:ncol,k), esi(1:ncol), ncol) + do i = 1, ncol if (t(i,k) > 235.15_r8 .and. t(i,k) < 269.15_r8) then qcic = min(qc(i,k)/lcldm(i,k), 5.e-3_r8) @@ -783,24 +518,15 @@ subroutine hetfrz_classnuc_cam_calc( & con1 = 1._r8/(1.333_r8*pi)**0.333_r8 r3lx = con1*(rho(i,k)*qcic/(rhoh2o*max(ncic*rho(i,k), 1.0e6_r8)))**0.333_r8 ! in m r3lx = max(4.e-6_r8, r3lx) - supersatice = svp_water(t(i,k))/svp_ice(t(i,k)) - - fn(1) = factnum(i,k,mode_accum_idx) ! bc accumulation mode - if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then - fn(2) = factnum(i,k,mode_accum_idx) ! dust_a1 accumulation mode - fn(3) = factnum(i,k,mode_coarse_idx) ! dust_a3 coarse mode - else if (nmodes == MAM7_nmodes) then - fn(2) = factnum(i,k,mode_finedust_idx) - fn(3) = factnum(i,k,mode_coardust_idx) - end if - - call hetfrz_classnuc_calc( & + supersatice = esl(i)/esi(i) + + call hetfrz_classnuc_calc( tot_num_bins, types, & deltatin, t(i,k), pmid(i,k), supersatice, & - fn, r3lx, ncic*rho(i,k)*1.0e-6_r8, frzbcimm(i,k), frzduimm(i,k), & - frzbccnt(i,k), frzducnt(i,k), frzbcdep(i,k), frzdudep(i,k), hetraer(i,k,:), & - awcam(i,k,:), awfacm(i,k,:), dstcoat(i,k,:), total_aer_num(i,k,:), & - coated_aer_num(i,k,:), uncoated_aer_num(i,k,:), total_interstitial_aer_num(i,k,:), & - total_cloudborne_aer_num(i,k,:), errstring) + fraction_activated(i,k,:), r3lx, ncic*rho(i,k)*1.0e-6_r8, frzbcimm(i,k), frzduimm(i,k), & + frzbccnt(i,k), frzducnt(i,k), frzbcdep(i,k), frzdudep(i,k), aer_radius(i,k,:), & + aer_wactfac(i,k,:), coated(i,k,:), tot_aer_num(i,k,:), & + uncoated_amb_aer_num(i,k,:), amb_aer_num(i,k,:), & + cld_aer_num(i,k,:), errstring) call handle_errmsg(errstring, subname="hetfrz_classnuc_calc") @@ -812,6 +538,7 @@ subroutine hetfrz_classnuc_cam_calc( & if (frzcnt(i,k) > 0._r8) freqcnt(i,k) = 1._r8 if (frzdep(i,k) > 0._r8) freqdep(i,k) = 1._r8 if ((frzimm(i,k) + frzcnt(i,k) + frzdep(i,k)) > 0._r8) freqmix(i,k) = 1._r8 + else frzimm(i,k) = 0._r8 frzcnt(i,k) = 0._r8 @@ -823,7 +550,7 @@ subroutine hetfrz_classnuc_cam_calc( & nnudep_bc(i,k) = frzbcdep(i,k)*1.0e6_r8*ast(i,k) nnuccc_dst(i,k) = frzduimm(i,k)*1.0e6_r8*ast(i,k) - nnucct_dst(i,k) = frzducnt(i,k)*1.0e6_r8*ast(i,k) + nnucct_dst(i,k) = frzducnt(i,k)*1.0e6_r8*ast(i,k) nnudep_dst(i,k) = frzdudep(i,k)*1.0e6_r8*ast(i,k) niimm_bc(i,k) = frzbcimm(i,k)*1.0e6_r8*deltatin @@ -840,6 +567,10 @@ subroutine hetfrz_classnuc_cam_calc( & end do end do + call outfld('FRZIMM', frzimm, pcols, lchnk) + call outfld('FRZCNT', frzcnt, pcols, lchnk) + call outfld('FRZDEP', frzdep, pcols, lchnk) + call outfld('FREQIMM', freqimm, pcols, lchnk) call outfld('FREQCNT', freqcnt, pcols, lchnk) call outfld('FREQDEP', freqdep, pcols, lchnk) @@ -854,7 +585,7 @@ subroutine hetfrz_classnuc_cam_calc( & call outfld('BCFREZDEP', nnudep_bc, pcols, lchnk) call outfld('NIMIX_IMM', niimm_bc+niimm_dst, pcols, lchnk) - call outfld('NIMIX_CNT', nicnt_bc+nicnt_dst, pcols, lchnk) + call outfld('NIMIX_CNT', nicnt_bc+nicnt_dst, pcols, lchnk) call outfld('NIMIX_DEP', nidep_bc+nidep_dst, pcols, lchnk) call outfld('DSTNICNT', nicnt_dst, pcols, lchnk) @@ -875,491 +606,4 @@ end subroutine hetfrz_classnuc_cam_calc !==================================================================================================== -subroutine hetfrz_classnuc_cam_save_cbaero(state, pbuf) - - ! Save the required cloud borne aerosol constituents. - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - - ! local variables - integer :: i, lchnk - real(r8), pointer :: ptr2d(:,:) - !------------------------------------------------------------------------------- - - lchnk = state%lchnk - - ! loop over the cloud borne constituents required by this module and save - ! a local copy - - do i = 1, ncnst - - ! Check whether constituent is a mass or number mixing ratio - if (spec_idx(i) == 0) then - call rad_cnst_get_mode_num(0, mode_idx(i), 'c', state, pbuf, ptr2d) - else - call rad_cnst_get_aer_mmr(0, mode_idx(i), spec_idx(i), 'c', state, pbuf, ptr2d) - end if - aer_cb(:,:,i,lchnk) = ptr2d - end do - -end subroutine hetfrz_classnuc_cam_save_cbaero - -!==================================================================================================== - -subroutine get_aer_num(ii, kk, ncnst, aer, aer_cb, rhoair,& - total_aer_num, & - coated_aer_num, & - uncoated_aer_num, & - total_interstial_aer_num, & - total_cloudborne_aer_num, & - hetraer, awcam, awfacm, dstcoat, & - na500, tot_na500) - - !***************************************************************************** - ! Purpose: Calculate BC and Dust number, including total number(interstitial+ - ! cloud borne), one monolayer coated number, and uncoated number - ! - ! Author: Yong Wang and Xiaohong Liu, UWyo, 12/2012 - !***************************************************************************** - - ! input - integer, intent(in) :: ii, kk, ncnst - real(r8), intent(in) :: aer(pcols,pver,ncnst) ! interstitial aerosols, volume basis - real(r8), intent(in) :: aer_cb(pcols,pver,ncnst) ! cloud borne aerosols, volume basis - real(r8), intent(in) :: rhoair ! air density (kg/m3) - - ! The interstitial and cloud borne aerosol concentrations are accessed from - ! module variables local to this module. - - ! output - real(r8), intent(out) :: total_aer_num(3) ! #/cm^3 - real(r8), intent(out) :: total_interstial_aer_num(3) ! #/cm^3 - real(r8), intent(out) :: total_cloudborne_aer_num(3) ! #/cm^3 - real(r8), intent(out) :: coated_aer_num(3) ! #/cm^3 - real(r8), intent(out) :: uncoated_aer_num(3) ! #/cm^3 - real(r8), intent(out) :: hetraer(3) ! BC and Dust mass mean radius [m] - real(r8), intent(out) :: awcam(3) ! modal added mass [mug m-3] - real(r8), intent(out) :: awfacm(3) ! (OC+BC)/(OC+BC+SO4) - real(r8), intent(out) :: dstcoat(3) ! coated fraction - real(r8), intent(out) :: na500 ! #/cm^3 interstitial aerosol number with D>500 nm (#/cm^3) - real(r8), intent(out) :: tot_na500 ! #/cm^3 total aerosol number with D>500 nm (#/cm^3) - - - !local variables - !------------coated variables-------------------- - real(r8), parameter :: n_so4_monolayers_dust = 1.0_r8 ! number of so4(+nh4) monolayers needed to coat a dust particle - real(r8), parameter :: dr_so4_monolayers_dust = n_so4_monolayers_dust * 4.76e-10_r8 - real(r8), parameter :: spechygro_so4 = 0.507_r8 ! Sulfate hygroscopicity - real(r8), parameter :: spechygro_soa = 0.14_r8 ! SOA hygroscopicity - real(r8), parameter :: spechygro_pom = 0.1_r8 ! POM hygroscopicity - real(r8), parameter :: soa_equivso4_factor = spechygro_soa/spechygro_so4 - real(r8), parameter :: pom_equivso4_factor = spechygro_pom/spechygro_so4 - real(r8) :: vol_shell(3) - real(r8) :: vol_core(3) - real(r8) :: fac_volsfc_dust_a1, fac_volsfc_dust_a3, fac_volsfc_bc - real(r8) :: tmp1, tmp2 - real(r8) :: bc_num ! bc number in accumulation mode for MAM3 - ! bc number in accumulation and primary carbon mode for MAM7 and MAM4 - real(r8) :: dst1_num, dst3_num ! dust number in accumulation and corase mode for MAM3 - ! dust number in fine dust and corase dust mode for MAM7 and MAM4 - logical :: num_to_mass_in = .true. - real(r8), parameter :: bc_num_to_mass = 4.669152e+17_r8 ! #/kg from emission - real(r8), parameter :: dst1_num_to_mass = 3.484e+15_r8 ! #/kg for dust in accumulation mode - - real(r8) :: dmc, ssmc - - real(r8) :: as_so4, as_du, as_soa - real(r8) :: dst1_num_imm, dst3_num_imm, bc_num_imm - real(r8) :: dmc_imm, ssmc_imm - real(r8) :: as_bc, as_pom, as_ss - - real(r8) :: r_bc ! model radii of BC modes [m] - real(r8) :: r_dust_a1, r_dust_a3 ! model radii of dust modes [m] - - integer :: i - real(r8) :: dst1_scale - !------------------------------------------------------------------------------- - - ! init output vars - total_aer_num = 0._r8 - total_interstial_aer_num = 0._r8 - total_cloudborne_aer_num = 0._r8 - coated_aer_num = 0._r8 - uncoated_aer_num = 0._r8 - hetraer = 0._r8 - awcam = 0._r8 - awfacm = 0._r8 - dstcoat = 0._r8 - na500 = 0._r8 - tot_na500 = 0._r8 - - !***************************************************************************** - ! calculate intersitial aerosol - !***************************************************************************** - - if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then - - if (.not. num_to_mass_in) then - - as_so4 = aer(ii,kk,so4_accum) - as_bc = aer(ii,kk,bc_accum) - as_pom = aer(ii,kk,pom_accum) - as_soa = aer(ii,kk,soa_accum) - as_ss = aer(ii,kk,ncl_accum) - as_du = aer(ii,kk,dst_accum) - - if (as_du > 0._r8) then - dst1_num = as_du/(as_so4+as_bc+as_pom+as_soa+as_ss+as_du) & - * aer(ii,kk,num_accum)*1.0e-6_r8 ! #/cm^3 - else - dst1_num = 0.0_r8 - end if - - if (as_bc > 0._r8) then - bc_num = as_bc/(as_so4+as_bc+as_pom+as_soa+as_ss+as_du) & - * aer(ii,kk,num_accum)*1.0e-6_r8 ! #/cm^3 - else - bc_num = 0.0_r8 - end if - - else - - dst1_num = aer(ii,kk,dst_accum) * dst1_num_to_mass*1.0e-6_r8 ! #/cm^3, dust # in accumulation mode - bc_num = aer(ii,kk,bc_accum) * bc_num_to_mass*1.0e-6_r8 ! #/cm^3 - end if - dmc = aer(ii,kk,dst_coarse) - ssmc = aer(ii,kk,ncl_coarse) - - if (dmc > 0._r8 ) then - dst3_num = dmc/(ssmc+dmc) * aer(ii,kk,num_coarse)*1.0e-6_r8 ! #/cm^3 - else - dst3_num = 0.0_r8 - end if - - if (nmodes == MAM4_nmodes) then - bc_num = bc_num+(aer(ii,kk,bc_pcarbon)) * bc_num_to_mass*1.0e-6_r8 ! #/cm^3 - end if - else if (nmodes == MAM7_nmodes) then - bc_num = (aer(ii,kk,bc_accum)+aer(ii,kk,bc_pcarbon)) * bc_num_to_mass*1.0e-6_r8 ! #/cm^3 - dst1_num = aer(ii,kk,num_finedust)*1.0e-6_r8 ! #/cm^3 - dst3_num = aer(ii,kk,num_coardust)*1.0e-6_r8 ! #/cm^3 - end if - - !***************************************************************************** - ! calculate cloud borne aerosol - !***************************************************************************** - - if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then - - as_so4 = aer_cb(ii,kk,so4_accum) - as_bc = aer_cb(ii,kk,bc_accum) - as_pom = aer_cb(ii,kk,pom_accum) - as_soa = aer_cb(ii,kk,soa_accum) - as_ss = aer_cb(ii,kk,ncl_accum) - as_du = aer_cb(ii,kk,dst_accum) - - if (as_du > 0._r8) then - dst1_num_imm = as_du/(as_so4+as_bc+as_pom+as_soa+as_ss+as_du) & - * aer_cb(ii,kk,num_accum)*1.0e-6_r8 ! #/cm^3 - else - dst1_num_imm = 0.0_r8 - end if - - if (as_bc > 0._r8) then - bc_num_imm = as_bc/(as_so4+as_bc+as_pom+as_soa+as_ss+as_du) & - * aer_cb(ii,kk,num_accum)*1.0e-6_r8 ! #/cm^3 - else - bc_num_imm = 0.0_r8 - end if - - dmc_imm = aer_cb(ii,kk,dst_coarse) - ssmc_imm = aer_cb(ii,kk,ncl_coarse) - - if (dmc_imm > 0._r8) then - dst3_num_imm = dmc_imm/(ssmc_imm+dmc_imm) * aer_cb(ii,kk,num_coarse)*1.0e-6_r8 ! #/cm^3 - else - dst3_num_imm = 0.0_r8 - end if - - else if (nmodes == MAM7_nmodes) then - ! primary carbon mode is insoluble and thus don't consider its cloud-borne state - as_so4 = aer_cb(ii,kk,so4_accum) - as_bc = aer_cb(ii,kk,bc_accum) - as_pom = aer_cb(ii,kk,pom_accum) - as_soa = aer_cb(ii,kk,soa_accum) - as_ss = aer_cb(ii,kk,ncl_accum) - if (as_bc > 0._r8) then - bc_num_imm = as_bc/(as_so4+as_bc+as_pom+as_soa+as_ss) & - * aer_cb(ii,kk,num_accum)*1.0e-6_r8 ! #/cm^3 - else - bc_num_imm = 0.0_r8 - end if - dst1_num_imm = aer_cb(ii,kk,num_finedust)*1.0e-6_r8 ! #/cm^3 - dst3_num_imm = aer_cb(ii,kk,num_coardust)*1.0e-6_r8 ! #/cm^3 - end if - - total_interstial_aer_num(1) = bc_num - total_interstial_aer_num(2) = dst1_num - total_interstial_aer_num(3) = dst3_num - - total_cloudborne_aer_num(1) = bc_num_imm - total_cloudborne_aer_num(2) = dst1_num_imm - total_cloudborne_aer_num(3) = dst3_num_imm - - !***************************************************************************** - ! calculate mass mean radius - !***************************************************************************** - - if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then - - if (nmodes == MAM3_nmodes) then - - if (aer(ii,kk,bc_accum)*1.0e-3_r8 > 1.0e-30_r8 .and. bc_num > 1.0e-3_r8) then - r_bc = ( 3._r8/(4*pi*specdens_bc)*aer(ii,kk,bc_accum)/(bc_num*1.0e6_r8) )**(1._r8/3._r8) - else - r_bc = 0.04e-6_r8 - end if - - else - if ((aer(ii,kk,bc_accum)+aer(ii,kk,bc_pcarbon))*1.0e-3_r8 > 1.0e-30_r8 & - .and. bc_num > 1.0e-3_r8) then - r_bc = ( 3._r8/(4*pi*specdens_bc)*(aer(ii,kk,bc_accum)+aer(ii,kk,bc_pcarbon))/ & - (bc_num*1.0e6_r8) )**(1._r8/3._r8) - else - r_bc = 0.067e-6_r8 ! from emission size - end if - - end if - - if (aer(ii,kk,dst_accum)*1.0e-3_r8 > 1.0e-30_r8 .and. dst1_num > 1.0e-3_r8) then - r_dust_a1 = ( 3._r8/(4*pi*specdens_dust)*aer(ii,kk,dst_accum)/(dst1_num*1.0e6_r8) )**(1._r8/3._r8) - else - r_dust_a1 = 0.258e-6_r8 - end if - - if (aer(ii,kk,dst_coarse)*1.0e-3_r8 > 1.0e-30_r8 .and. dst3_num > 1.0e-3_r8) then - r_dust_a3 = ( 3._r8/(4*pi*specdens_dust)*aer(ii,kk,dst_coarse)/(dst3_num*1.0e6_r8) )**(1._r8/3._r8) - else - r_dust_a3 = 1.576e-6_r8 - end if - - else if (nmodes == MAM7_nmodes) then - - if ((aer(ii,kk,bc_accum)+aer(ii,kk,bc_pcarbon))*1.0e-3_r8 > 1.0e-30_r8 & - .and. bc_num > 1.0e-3_r8) then - r_bc = ( 3._r8/(4*pi*specdens_bc)*(aer(ii,kk,bc_accum)+aer(ii,kk,bc_pcarbon))/ & - (bc_num*1.0e6_r8) )**(1._r8/3._r8) - else - r_bc = 0.067e-6_r8 ! from emission size - end if - - if (aer(ii,kk,dst_finedust)*1.0e-3_r8 > 1.0e-30_r8 .and. dst1_num > 1.0e-3_r8) then - r_dust_a1 = ( 3._r8/(4*pi*specdens_dust)*aer(ii,kk,dst_finedust)/(dst1_num*1.0e6_r8) )**(1._r8/3._r8) - else - r_dust_a1 = 0.258e-6_r8 - end if - - if (aer(ii,kk,dst_coardust)*1.0e-3_r8 > 1.0e-30_r8 .and. dst3_num > 1.0e-3_r8) then - r_dust_a3 = ( 3._r8/(4*pi*specdens_dust)*aer(ii,kk,dst_coardust)/(dst3_num*1.0e6_r8) )**(1._r8/3._r8) - else - r_dust_a3 = 1.576e-6_r8 - end if - end if - - hetraer(1) = r_bc - hetraer(2) = r_dust_a1 - hetraer(3) = r_dust_a3 - - !***************************************************************************** - ! calculate coated fraction - !***************************************************************************** - - if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then - - fac_volsfc_bc = exp(2.5_r8*alnsg_mode_accum**2) - fac_volsfc_dust_a1 = exp(2.5_r8*alnsg_mode_accum**2) - fac_volsfc_dust_a3 = exp(2.5_r8*alnsg_mode_coarse**2) - - vol_shell(2) = ( aer(ii,kk,so4_accum)/specdens_so4 + & - aer(ii,kk,pom_accum)*pom_equivso4_factor/specdens_pom + & - aer(ii,kk,soa_accum)*soa_equivso4_factor/specdens_soa )/rhoair - - vol_core(2) = aer(ii,kk,dst_accum)/(specdens_dust*rhoair) - - ! ratio1 = vol_shell/vol_core = - ! actual hygroscopic-shell-volume/dust-core-volume - ! ratio2 = 6.0_r8*dr_so4_monolayers_pcage/(dgncur_a*fac_volsfc_dust) - ! = (shell-volume corresponding to n_so4_monolayers_pcage)/core-volume - ! The 6.0/(dgncur_a*fac_volsfc_dust) = (mode-surface-area/mode-volume) - ! Note that vol_shell includes both so4, pom, AND soa as "equivalent so4", - ! The soa_equivso4_factor accounts for the lower hygroscopicity of soa. - ! - ! Define xferfrac_pcage = min( 1.0, ratio1/ratio2) - ! But ratio1/ratio2 == tmp1/tmp2, and coding below avoids possible overflow - - ! bc - if (nmodes == MAM3_nmodes) then - vol_shell(1) = vol_shell(2) - vol_core(1) = aer(ii,kk,bc_accum)/(specdens_bc*rhoair) - tmp1 = vol_shell(1)*(r_bc*2._r8)*fac_volsfc_bc - tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(1), 0.0_r8) - dstcoat(1) = tmp1/tmp2 - else - fac_volsfc_bc = exp(2.5_r8*alnsg_mode_pcarbon**2) - vol_shell(1) = ( aer(ii,kk,pom_pcarbon)*pom_equivso4_factor/specdens_pom )/rhoair - vol_core(1) = aer(ii,kk,bc_pcarbon)/(specdens_bc*rhoair) - tmp1 = vol_shell(1)*(r_bc*2._r8)*fac_volsfc_bc - tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(1), 0.0_r8) - dstcoat(1) = tmp1/tmp2 - end if - - ! dust_a1 - tmp1 = vol_shell(2)*(r_dust_a1*2._r8)*fac_volsfc_dust_a1 - tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(2), 0.0_r8) - dstcoat(2) = tmp1/tmp2 - - ! dust_a3 - vol_shell(3) = aer(ii,kk,so4_coarse)/(specdens_so4*rhoair) - vol_core(3) = aer(ii,kk,dst_coarse)/(specdens_dust*rhoair) - tmp1 = vol_shell(3)*(r_dust_a3*2._r8)*fac_volsfc_dust_a3 - tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(3), 0.0_r8) - dstcoat(3) = tmp1/tmp2 - - else if (nmodes == MAM7_nmodes) then - - ! for BC, only consider primary carbon mode, - ! because most of particles in this mode are uncoated - ! and nearly all particles in accumulation mode are coated - fac_volsfc_bc = exp(2.5_r8*alnsg_mode_pcarbon**2) - - vol_shell(1) = ( aer(ii,kk,pom_pcarbon)*pom_equivso4_factor/specdens_pom )/rhoair - vol_core(1) = aer(ii,kk,bc_pcarbon)/(specdens_bc*rhoair) - tmp1 = vol_shell(1)*(r_bc*2._r8)*fac_volsfc_bc - tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(1), 0.0_r8) - dstcoat(1) = tmp1/tmp2 - - fac_volsfc_dust_a1 = exp(2.5_r8*alnsg_mode_finedust**2) - fac_volsfc_dust_a3 = exp(2.5_r8*alnsg_mode_coardust**2) - - vol_shell(2) = aer(ii,kk,so4_finedust)/(specdens_so4*rhoair) - vol_core(2) = aer(ii,kk,dst_finedust)/(specdens_dust*rhoair) - - tmp1 = vol_shell(2)*(r_dust_a1*2._r8)*fac_volsfc_dust_a1 - tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(2), 0.0_r8) - dstcoat(2) = tmp1/tmp2 - - vol_shell(3) = aer(ii,kk,so4_coardust)/(specdens_so4*rhoair) - vol_core(3) = aer(ii,kk,dst_coardust)/(specdens_dust*rhoair) - tmp1 = vol_shell(3)*(r_dust_a3*2._r8)*fac_volsfc_dust_a3 - tmp2 = max(6.0_r8*dr_so4_monolayers_dust*vol_core(3), 0.0_r8) - dstcoat(3) = tmp1/tmp2 - - end if - - if (dstcoat(1) > 1._r8) dstcoat(1) = 1._r8 - if (dstcoat(1) < 0.001_r8) dstcoat(1) = 0.001_r8 - if (dstcoat(2) > 1._r8) dstcoat(2) = 1._r8 - if (dstcoat(2) < 0.001_r8) dstcoat(2) = 0.001_r8 - if (dstcoat(3) > 1._r8) dstcoat(3) = 1._r8 - if (dstcoat(3) < 0.001_r8) dstcoat(3) = 0.001_r8 - - do i = 1, 3 - total_aer_num(i) = total_interstial_aer_num(i) + total_cloudborne_aer_num(i) - coated_aer_num(i) = total_interstial_aer_num(i)*dstcoat(i) - uncoated_aer_num(i) = total_interstial_aer_num(i)*(1._r8-dstcoat(i)) - end do - - if (nmodes == MAM4_nmodes .or. nmodes == MAM7_nmodes) then - coated_aer_num(1) = (aer(ii,kk,bc_pcarbon)*bc_num_to_mass*1.0e-6_r8)*dstcoat(1)+ & - (aer(ii,kk,bc_accum)*bc_num_to_mass*1.0e-6_r8) - uncoated_aer_num(1) = (aer(ii,kk,bc_pcarbon)*bc_num_to_mass*1.0e-6_r8)*(1._r8-dstcoat(1)) - end if - - if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then - dst1_scale = 0.488_r8 ! scaled for D>0.5-1 um from 0.1-1 um - else if (nmodes == MAM7_nmodes) then - dst1_scale = 0.566_r8 ! scaled for D>0.5-2 um from 0.1-2 um - end if - - tot_na500 = total_aer_num(1)*0.0256_r8 & ! scaled for D>0.5 um using Clarke et al., 1997; 2004; 2007: rg=0.1um, sig=1.6 - + total_aer_num(2)*dst1_scale + total_aer_num(3) - - na500 = total_interstial_aer_num(1)*0.0256_r8 & ! scaled for D>0.5 um using Clarke et al., 1997; 2004; 2007: rg=0.1um, sig=1.6 - + total_interstial_aer_num(2)*dst1_scale + total_interstial_aer_num(3) - - !***************************************************************************** - ! prepare some variables for water activity - !***************************************************************************** - - if (nmodes == MAM3_nmodes .or. nmodes == MAM4_nmodes) then - ! accumulation mode for dust_a1 - if (aer(ii,kk,num_accum) > 0._r8) then - awcam(2) = (dst1_num*1.0e6_r8)/aer(ii,kk,num_accum)* & - ( aer(ii,kk,so4_accum) + aer(ii,kk,soa_accum) + & - aer(ii,kk,pom_accum) + aer(ii,kk,bc_accum) )*1.0e9_r8 ! [mug m-3] - else - awcam(2) = 0._r8 - end if - - if (awcam(2) > 0._r8) then - awfacm(2) = ( aer(ii,kk,bc_accum) + aer(ii,kk,soa_accum) + aer(ii,kk,pom_accum) )/ & - ( aer(ii,kk,soa_accum) + aer(ii,kk,pom_accum) + aer(ii,kk,so4_accum) + aer(ii,kk,bc_accum) ) - else - awfacm(2) = 0._r8 - end if - - ! accumulation mode for bc (if MAM4, primary carbon mode is insoluble) - if (aer(ii,kk,num_accum) > 0._r8) then - awcam(1) = (bc_num*1.0e6_r8)/aer(ii,kk,num_accum)* & - ( aer(ii,kk,so4_accum) + aer(ii,kk,soa_accum) + aer(ii,kk,pom_accum) + aer(ii,kk,bc_accum) )*1.0e9_r8 ! [mug m-3] - else - awcam(1) = 0._r8 - end if - awfacm(1) = awfacm(2) - - ! coarse mode for dust_a3 - if (aer(ii,kk,num_coarse) > 0._r8) then - awcam(3) = (dst3_num*1.0e6_r8)/aer(ii,kk,num_coarse)* aer(ii,kk,so4_coarse)*1.0e9_r8 - else - awcam(3) = 0._r8 - end if - awfacm(3) = 0._r8 - - else if (nmodes == MAM7_nmodes) then - - ! accumulation mode for bc (primary carbon mode is insoluble) - if (aer(ii,kk,num_accum) > 0._r8) then - awcam(1) = (bc_num*1.0e6_r8)/aer(ii,kk,num_accum)* & - ( aer(ii,kk,so4_accum) + aer(ii,kk,soa_accum) + aer(ii,kk,pom_accum) + aer(ii,kk,bc_accum) )*1.0e9_r8 ! [mug m-3] - else - awcam(1) = 0._r8 - end if - - if (awcam(1) > 0._r8) then - awfacm(1) = ( aer(ii,kk,bc_accum) + aer(ii,kk,soa_accum) + aer(ii,kk,pom_accum) )/ & - ( aer(ii,kk,soa_accum) + aer(ii,kk,pom_accum) + aer(ii,kk,so4_accum) + aer(ii,kk,bc_accum) ) - else - awfacm(1) = 0._r8 - end if - - if (aer(ii,kk,num_finedust) > 0._r8) then - awcam(2) = (dst1_num*1.0e6_r8)/aer(ii,kk,num_finedust)* aer(ii,kk,so4_finedust)*1.0e9_r8 - else - awcam(2) = 0._r8 - end if - awfacm(2) = 0._r8 - - if (aer(ii,kk,num_coardust) > 0._r8) then - awcam(3) = (dst3_num*1.0e6_r8)/aer(ii,kk,num_coardust)* aer(ii,kk,so4_coardust)*1.0e9_r8 - else - awcam(3) = 0._r8 - end if - awfacm(3) = 0._r8 - - end if - -end subroutine get_aer_num - -!==================================================================================================== - end module hetfrz_classnuc_cam diff --git a/src/physics/cam/hk_conv.F90 b/src/physics/cam/hk_conv.F90 index 67955a08f7..222bd910b1 100644 --- a/src/physics/cam/hk_conv.F90 +++ b/src/physics/cam/hk_conv.F90 @@ -27,8 +27,8 @@ module hk_conv real(r8), parameter :: unset_r8 = huge(1.0_r8) ! Namelist variables - real(r8) :: hkconv_c0 = unset_r8 - real(r8) :: hkconv_cmftau = unset_r8 + real(r8) :: hkconv_c0 = unset_r8 + real(r8) :: hkconv_cmftau = unset_r8 real(r8) :: hlat ! latent heat of vaporization real(r8) :: c0 ! rain water autoconversion coefficient set from namelist input hkconv_c0 @@ -41,7 +41,7 @@ module hk_conv real(r8) :: tiny ! arbitrary small num used in transport estimates real(r8) :: eps ! convergence criteria (machine dependent) real(r8) :: tpmax ! maximum acceptable t perturbation (degrees C) - real(r8) :: shpmax ! maximum acceptable q perturbation (g/g) + real(r8) :: shpmax ! maximum acceptable q perturbation (g/g) integer :: iloc ! longitude location for diagnostics integer :: jloc ! latitude location for diagnostics @@ -50,7 +50,7 @@ module hk_conv logical :: rlxclm ! logical to relax column versus cloud triplet real(r8) cp ! specific heat of dry air - real(r8) grav ! gravitational constant + real(r8) grav ! gravitational constant real(r8) rgrav ! reciprocal of grav real(r8) rgas ! gas constant for dry air integer limcnv ! top interface level limit for convection @@ -104,17 +104,17 @@ end subroutine hkconv_readnl !================================================================================================ subroutine mfinti (rair ,cpair ,gravit ,latvap ,rhowtr,limcnv_in ) -!----------------------------------------------------------------------- -! -! Purpose: +!----------------------------------------------------------------------- +! +! Purpose: ! Initialize moist convective mass flux procedure common block, cmfmca -! -! Method: -! -! -! +! +! Method: +! +! +! ! Author: J. Hack -! +! !----------------------------------------------------------------------- use spmd_utils, only: masterproc !------------------------------Arguments-------------------------------- @@ -186,14 +186,14 @@ subroutine cmfmca(lchnk ,ncol , & rpdel ,zm ,tpert ,qpert ,phis , & pblh ,t ,q ,cmfdt ,dq , & cmfmc ,cmfdqr ,cmfsl ,cmflq ,precc , & - qc ,cnt ,cnb ,icwmr ,rliq , & + qc ,cnt ,cnb ,icwmr ,rliq , & pmiddry ,pdeldry ,rpdeldry) -!----------------------------------------------------------------------- -! -! Purpose: +!----------------------------------------------------------------------- +! +! Purpose: ! Moist convective mass flux procedure: -! -! Method: +! +! Method: ! If stratification is unstable to nonentraining parcel ascent, ! complete an adjustment making successive use of a simple cloud model ! consisting of three layers (sometimes referred to as a triplet) @@ -205,13 +205,13 @@ subroutine cmfmca(lchnk ,ncol , & ! in the calling list from the block of other transported ! constituents, even though as currently designed, it is the ! first component in the constituents field. -! +! ! Author: J. Hack ! ! BAB: changed code to report tendencies in cmfdt and dq, instead of ! updating profiles. Cmfdq contains water only, made it a local variable ! made dq (all constituents) the argument. -! +! !----------------------------------------------------------------------- !####################################################################### @@ -222,7 +222,9 @@ subroutine cmfmca(lchnk ,ncol , & use constituents, only: pcnst use constituents, only: cnst_get_type_byind use ppgrid, only: pcols, pver, pverp +#if ( defined DIAGNS ) use phys_grid, only: get_lat_all_p, get_lon_all_p +#endif use wv_saturation, only: qsat real(r8) ssfac ! supersaturation bound (detrained air) @@ -265,7 +267,7 @@ subroutine cmfmca(lchnk ,ncol , & real(r8), intent(out) :: cnb(pcols) ! bottom level of convective activity real(r8), intent(out) :: dq(pcols,pver,pcnst) ! constituent tendencies real(r8), intent(out) :: icwmr(pcols,pver) - real(r8), intent(out) :: rliq(pcols) + real(r8), intent(out) :: rliq(pcols) ! !---------------------------Local workspace----------------------------- ! @@ -434,9 +436,11 @@ subroutine cmfmca(lchnk ,ncol , & ! ! Compute sb,hb,shbs,hbs ! - call qsat(tb(:ncol,limcnv:pver), pmid(:ncol,limcnv:pver), & - estemp(:ncol,limcnv:pver), shbs(:ncol,limcnv:pver), & - gam=gam(:ncol,limcnv:pver)) + do k = limcnv,pver + call qsat(tb(1:ncol,k), pmid(1:ncol,k), & + estemp(1:ncol,k), shbs(1:ncol,k), ncol, & + gam=gam(1:ncol,k)) + end do ! do k=limcnv,pver do i=1,ncol @@ -741,7 +745,7 @@ subroutine cmfmca(lchnk ,ncol , & dq1(i) = etagdt(i)*(shbh(i,k+1) - shc(i))*rpdel(i,k+1) ds2(i) = (etagdt(i)*(sc(i) - sbh(i,k+1)) + & hlat*grav*cldwtr(i) - beta(i)*etagdt(i)*(sc(i) - sbh(i,k)))*rpdel(i,k) -! JJH change for export of cloud liquid water; must use total condensate +! JJH change for export of cloud liquid water; must use total condensate ! since rainwater no longer represents total condensate dq2(i) = (etagdt(i)*(shc(i) - shbh(i,k+1)) - grav*totcond(i) - beta(i)* & etagdt(i)*(shc(i) - shbh(i,k)))*rpdel(i,k) @@ -908,8 +912,8 @@ subroutine cmfmca(lchnk ,ncol , & vtemp2(ii ) = pmid(i,k) vtemp2(ii+len1) = pmid(i,k-1) end do - call qsat(vtemp1(:2*len1), vtemp2(:2*len1), & - vtemp5(:2*len1), vtemp3(:2*len1), gam=vtemp4(:2*len1)) + call qsat(vtemp1(1:2*len1), vtemp2(1:2*len1), & + vtemp5(1:2*len1), vtemp3(1:2*len1), 2*len1, gam=vtemp4(1:2*len1)) do ii=1,len1 i = indx1(ii) shbs(i,k ) = vtemp3(ii ) @@ -1013,7 +1017,7 @@ subroutine cmfmca(lchnk ,ncol , & !!$ q(i,k,1) = q(i,k,1) + cmfdq(i,k)*ztodt !!$ end do !!$ end do -! Set output q tendencies +! Set output q tendencies dq(:ncol,:,1 ) = cmfdq(:ncol,:) dq(:ncol,:,2:) = (dq(:ncol,:,2:) - q(:ncol,:,2:))/ztodt ! diff --git a/src/physics/cam/macrop_driver.F90 b/src/physics/cam/macrop_driver.F90 index c707d0a961..26217c2a8c 100644 --- a/src/physics/cam/macrop_driver.F90 +++ b/src/physics/cam/macrop_driver.F90 @@ -6,7 +6,7 @@ module macrop_driver ! Provides the CAM interface to the prognostic cloud macrophysics ! ! Author: Andrew Gettelman, Cheryl Craig October 2010 - ! Origin: modified from stratiform.F90 elements + ! Origin: modified from stratiform.F90 elements ! (Boville 2002, Coleman 2004, Park 2009, Kay 2010) !------------------------------------------------------------------------------------------------------- @@ -22,7 +22,6 @@ module macrop_driver use perf_mod, only: t_startf, t_stopf use cam_logfile, only: iulog use cam_abortutils, only: endrun - use zm_conv_intr, only: zmconv_microp implicit none private @@ -42,12 +41,12 @@ module macrop_driver ! Private Module Parameters ! ! ------------------------- ! - ! 'cu_det_st' : If .true. (.false.), detrain cumulus liquid condensate into the pre-existing liquid stratus - ! (environment) without (with) macrophysical evaporation. If there is no pre-esisting stratus, + ! 'cu_det_st' : If .true. (.false.), detrain cumulus liquid condensate into the pre-existing liquid stratus + ! (environment) without (with) macrophysical evaporation. If there is no pre-esisting stratus, ! evaporate cumulus liquid condensate. This option only influences the treatment of cumulus ! liquid condensate, not cumulus ice condensate. - logical, parameter :: cu_det_st = .false. + logical, parameter :: cu_det_st = .false. ! Parameters used for selecting generalized critical RH for liquid and ice stratus integer :: rhminl_opt = 0 @@ -79,16 +78,15 @@ module macrop_driver ast_idx, &! stratiform cloud fraction index in physics buffer aist_idx, &! ice stratiform cloud fraction index in physics buffer alst_idx, &! liquid stratiform cloud fraction index in physics buffer - qist_idx, &! ice stratiform in-cloud IWC - qlst_idx, &! liquid stratiform in-cloud LWC + qist_idx, &! ice stratiform in-cloud IWC + qlst_idx, &! liquid stratiform in-cloud LWC concld_idx, &! concld index in physics buffer - fice_idx, & - cmeliq_idx, & + fice_idx, & + cmeliq_idx, & shfrc_idx integer :: & dlfzm_idx = -1, & ! ZM detrained convective cloud water mixing ratio. - difzm_idx = -1, & ! ZM detrained convective cloud ice mixing ratio. dnlfzm_idx = -1, & ! ZM detrained convective cloud water num concen. dnifzm_idx = -1 ! ZM detrained convective cloud ice num concen. @@ -98,8 +96,8 @@ module macrop_driver qtl_flx_idx = -1, &! overbar(w'qtl' where qtl = qv + ql) from the PBL scheme qti_flx_idx = -1, &! overbar(w'qti' where qti = qv + qi) from the PBL scheme cmfr_det_idx = -1, &! detrained convective mass flux from UNICON - qlr_det_idx = -1, &! detrained convective ql from UNICON - qir_det_idx = -1, &! detrained convective qi from UNICON + qlr_det_idx = -1, &! detrained convective ql from UNICON + qir_det_idx = -1, &! detrained convective qi from UNICON cmfmc_sh_idx = -1 contains @@ -166,7 +164,7 @@ subroutine macrop_driver_register ! ! !---------------------------------------------------------------------- ! - + use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls !----------------------------------------------------------------------- @@ -203,12 +201,12 @@ subroutine macrop_driver_init(pbuf2d) !-------------------------------------------- ! ! ! ! Initialize the cloud water parameterization ! - ! ! + ! ! !-------------------------------------------- ! use physics_buffer, only : pbuf_get_index use cam_history, only: addfld, add_default use convect_shallow, only: convect_shallow_use_shfrc - + type(physics_buffer_desc), pointer :: pbuf2d(:,:) logical :: history_aerosol ! Output the MAM aerosol tendencies @@ -234,57 +232,57 @@ subroutine macrop_driver_init(pbuf2d) if( convect_shallow_use_shfrc() ) then use_shfrc = .true. shfrc_idx = pbuf_get_index('shfrc') - else + else use_shfrc = .false. endif - call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection' ) - call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection' ) - call addfld ('SHDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from shallow convection' ) - call addfld ('SHDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from shallow convection' ) - call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment' ) - call addfld ('SHDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to shallow convective detrainment' ) + call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection', sampled_on_subcycle=.true.) + call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection', sampled_on_subcycle=.true.) + call addfld ('SHDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from shallow convection', sampled_on_subcycle=.true.) + call addfld ('SHDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from shallow convection', sampled_on_subcycle=.true.) + call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment', sampled_on_subcycle=.true.) + call addfld ('SHDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to shallow convective detrainment', sampled_on_subcycle=.true.) - call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection' ) + call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection', sampled_on_subcycle=.true.) - call addfld ('MACPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Revised macrophysics' ) - call addfld ('MACPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Revised macrophysics' ) - call addfld ('MACPDLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ tendency - Revised macrophysics' ) - call addfld ('MACPDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency - Revised macrophysics' ) + call addfld ('MACPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Revised macrophysics', sampled_on_subcycle=.true.) + call addfld ('MACPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Revised macrophysics', sampled_on_subcycle=.true.) + call addfld ('MACPDLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ tendency - Revised macrophysics', sampled_on_subcycle=.true.) + call addfld ('MACPDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency - Revised macrophysics', sampled_on_subcycle=.true.) call addfld ('CLDVAPADJ', (/ 'lev' /), 'A', 'kg/kg/s', & - 'Q tendency associated with liq/ice adjustment - Revised macrophysics' ) - call addfld ('CLDLIQADJ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ adjustment tendency - Revised macrophysics' ) - call addfld ('CLDICEADJ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE adjustment tendency - Revised macrophysics' ) + 'Q tendency associated with liq/ice adjustment - Revised macrophysics', sampled_on_subcycle=.true.) + call addfld ('CLDLIQADJ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ adjustment tendency - Revised macrophysics', sampled_on_subcycle=.true.) + call addfld ('CLDICEADJ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE adjustment tendency - Revised macrophysics', sampled_on_subcycle=.true.) call addfld ('CLDLIQDET', (/ 'lev' /), 'A', 'kg/kg/s', & - 'Detrainment of conv cld liq into envrionment - Revised macrophysics' ) + 'Detrainment of conv cld liq into envrionment - Revised macrophysics', sampled_on_subcycle=.true.) call addfld ('CLDICEDET', (/ 'lev' /), 'A', 'kg/kg/s', & - 'Detrainment of conv cld ice into envrionment - Revised macrophysics' ) - call addfld ('CLDLIQLIM', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ limiting tendency - Revised macrophysics' ) - call addfld ('CLDICELIM', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE limiting tendency - Revised macrophysics' ) - - call addfld ('AST', (/ 'lev' /), 'A', '1', 'Stratus cloud fraction' ) - call addfld ('LIQCLDF', (/ 'lev' /), 'A', '1', 'Stratus Liquid cloud fraction' ) - call addfld ('ICECLDF', (/ 'lev' /), 'A', '1', 'Stratus ICE cloud fraction' ) - - call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction' ) - call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover' ) - - call addfld ('CLR_LIQ', (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for liquid stratus' ) - call addfld ('CLR_ICE', (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for ice stratus' ) - - call addfld ('CLDLIQSTR', (/ 'lev' /), 'A', 'kg/kg', 'Stratiform CLDLIQ' ) - call addfld ('CLDICESTR', (/ 'lev' /), 'A', 'kg/kg', 'Stratiform CLDICE' ) - call addfld ('CLDLIQCON', (/ 'lev' /), 'A', 'kg/kg', 'Convective CLDLIQ' ) - call addfld ('CLDICECON', (/ 'lev' /), 'A', 'kg/kg', 'Convective CLDICE' ) - - call addfld ('CLDSICE', (/ 'lev' /), 'A', 'kg/kg', 'CloudSat equivalent ice mass mixing ratio' ) - call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud' ) - - call addfld ('TTENDICE', (/ 'lev' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment' ) - call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment' ) - call addfld ('QITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment' ) - call addfld ('NITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment' ) + 'Detrainment of conv cld ice into envrionment - Revised macrophysics', sampled_on_subcycle=.true.) + call addfld ('CLDLIQLIM', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ limiting tendency - Revised macrophysics', sampled_on_subcycle=.true.) + call addfld ('CLDICELIM', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE limiting tendency - Revised macrophysics', sampled_on_subcycle=.true.) + + call addfld ('AST', (/ 'lev' /), 'A', '1', 'Stratus cloud fraction', sampled_on_subcycle=.true.) + call addfld ('LIQCLDF', (/ 'lev' /), 'A', '1', 'Stratus Liquid cloud fraction', sampled_on_subcycle=.true.) + call addfld ('ICECLDF', (/ 'lev' /), 'A', '1', 'Stratus ICE cloud fraction', sampled_on_subcycle=.true.) + + call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction', sampled_on_subcycle=.true.) + call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover', sampled_on_subcycle=.true.) + + call addfld ('CLR_LIQ', (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for liquid stratus', sampled_on_subcycle=.true.) + call addfld ('CLR_ICE', (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for ice stratus', sampled_on_subcycle=.true.) + + call addfld ('CLDLIQSTR', (/ 'lev' /), 'A', 'kg/kg', 'Stratiform CLDLIQ', sampled_on_subcycle=.true.) + call addfld ('CLDICESTR', (/ 'lev' /), 'A', 'kg/kg', 'Stratiform CLDICE', sampled_on_subcycle=.true.) + call addfld ('CLDLIQCON', (/ 'lev' /), 'A', 'kg/kg', 'Convective CLDLIQ', sampled_on_subcycle=.true.) + call addfld ('CLDICECON', (/ 'lev' /), 'A', 'kg/kg', 'Convective CLDICE', sampled_on_subcycle=.true.) + + call addfld ('CLDSICE', (/ 'lev' /), 'A', 'kg/kg', 'CloudSat equivalent ice mass mixing ratio', sampled_on_subcycle=.true.) + call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud', sampled_on_subcycle=.true.) + + call addfld ('TTENDICE', (/ 'lev' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) + call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) + call addfld ('QITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) + call addfld ('NITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) if ( history_budget ) then call add_default ('DPDLFLIQ ', history_budget_histfile_num, ' ') @@ -299,7 +297,7 @@ subroutine macrop_driver_init(pbuf2d) call add_default ('MACPDQ ', history_budget_histfile_num, ' ') call add_default ('MACPDLIQ ', history_budget_histfile_num, ' ') call add_default ('MACPDICE ', history_budget_histfile_num, ' ') - + call add_default ('CLDVAPADJ', history_budget_histfile_num, ' ') call add_default ('CLDLIQLIM', history_budget_histfile_num, ' ') call add_default ('CLDLIQDET', history_budget_histfile_num, ' ') @@ -328,14 +326,6 @@ subroutine macrop_driver_init(pbuf2d) CC_qlst_idx = pbuf_get_index('CC_qlst') cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') - if (zmconv_microp) then - dlfzm_idx = pbuf_get_index('DLFZM') - difzm_idx = pbuf_get_index('DIFZM') - dnlfzm_idx = pbuf_get_index('DNLFZM') - dnifzm_idx = pbuf_get_index('DNIFZM') - end if - - if (rhminl_opt > 0 .or. rhmini_opt > 0) then cmfr_det_idx = pbuf_get_index('cmfr_det', istat) if (istat < 0) call endrun(subname//': macrop option requires cmfr_det in pbuf') @@ -361,7 +351,7 @@ subroutine macrop_driver_init(pbuf2d) end if end if - ! Init pbuf fields. Note that the fields CLD, CONCLD, QCWAT, LCWAT, + ! Init pbuf fields. Note that the fields CLD, CONCLD, QCWAT, LCWAT, ! ICCWAT, and TCWAT are initialized in phys_inidat. if (is_first_step()) then call pbuf_set_field(pbuf2d, ast_idx, 0._r8) @@ -392,19 +382,20 @@ subroutine macrop_driver_tend( & pbuf, & det_s, det_ice) - !-------------------------------------------------------- ! - ! ! + !-------------------------------------------------------- ! + ! ! ! Purpose: ! ! ! ! Interface to detrain, cloud fraction and ! ! cloud macrophysics subroutines ! - ! ! + ! ! ! Author: A. Gettelman, C. Craig, Oct 2010 ! ! based on stratiform_tend by D.B. Coleman 4/2010 ! ! ! !-------------------------------------------------------- ! - use cloud_fraction, only: cldfrc, cldfrc_fice + use cloud_fraction, only: cldfrc + use cloud_fraction_fice, only: cloud_fraction_fice_run use physics_types, only: physics_state, physics_ptend use physics_types, only: physics_ptend_init, physics_update use physics_types, only: physics_ptend_sum, physics_state_copy @@ -438,7 +429,7 @@ subroutine macrop_driver_tend( & real(r8), intent(in) :: zdu(pcols,pver) ! Detrainment rate from deep convection - ! These two variables are needed for energy check + ! These two variables are needed for energy check real(r8), intent(out) :: det_s(pcols) ! Integral of detrained static energy from ice real(r8), intent(out) :: det_ice(pcols) ! Integral of detrained ice for energy check @@ -495,7 +486,6 @@ subroutine macrop_driver_tend( & ! ZM microphysics real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio. - real(r8), pointer :: difzm(:,:) ! ZM detrained convective cloud ice mixing ratio. real(r8), pointer :: dnlfzm(:,:) ! ZM detrained convective cloud water num concen. real(r8), pointer :: dnifzm(:,:) ! ZM detrained convective cloud ice num concen. @@ -525,13 +515,13 @@ subroutine macrop_driver_tend( & real(r8) ltend(pcols,pver) ! Cloud liquid water tendencies real(r8) fice(pcols,pver) ! Fractional ice content within cloud real(r8) fsnow(pcols,pver) ! Fractional snow production - real(r8) homoo(pcols,pver) - real(r8) qcreso(pcols,pver) - real(r8) prcio(pcols,pver) - real(r8) praio(pcols,pver) + real(r8) homoo(pcols,pver) + real(r8) qcreso(pcols,pver) + real(r8) prcio(pcols,pver) + real(r8) praio(pcols,pver) real(r8) qireso(pcols,pver) real(r8) ftem(pcols,pver) - real(r8) pracso (pcols,pver) + real(r8) pracso (pcols,pver) real(r8) dpdlfliq(pcols,pver) real(r8) dpdlfice(pcols,pver) real(r8) shdlfliq(pcols,pver) @@ -575,11 +565,11 @@ subroutine macrop_driver_tend( & real(r8) qi_inout(pcols,pver) real(r8) concld_old(pcols,pver) - ! Note that below 'clr_old' is defined using 'alst_old' not 'ast_old' for full consistency with the - ! liquid condensation process which is using 'alst' not 'ast'. + ! Note that below 'clr_old' is defined using 'alst_old' not 'ast_old' for full consistency with the + ! liquid condensation process which is using 'alst' not 'ast'. ! For microconsistency use 'concld_old', since 'alst_old' was computed using 'concld_old'. ! Since convective updraft fractional area is small, it does not matter whether 'concld' or 'concld_old' is used. - ! Note also that 'clri_old' is defined using 'ast_old' since current microphysics is operating on 'ast_old' + ! Note also that 'clri_old' is defined using 'ast_old' since current microphysics is operating on 'ast_old' real(r8) clrw_old(pcols,pver) ! (1 - concld_old - alst_old) real(r8) clri_old(pcols,pver) ! (1 - concld_old - ast_old) @@ -669,7 +659,7 @@ subroutine macrop_driver_tend( & dlf_ni(:,:) = 0._r8 ! ------------------------------------- ! - ! From here, process computation begins ! + ! From here, process computation begins ! ! ------------------------------------- ! ! ----------------------------------------------------------------------------- ! @@ -689,23 +679,16 @@ subroutine macrop_driver_tend( & ! If convection scheme can handle this internally, this step is not necssary. ! (2) Assuming a certain effective droplet radius, computes number concentration ! of detrained convective cloud liquid and ice. - ! (3) If 'cu_det_st = .true' ('false'), detrain convective cloud 'liquid' into + ! (3) If 'cu_det_st = .true' ('false'), detrain convective cloud 'liquid' into ! the pre-existing 'liquid' stratus ( mean environment ). The former does ! not involve any macrophysical evaporation while the latter does. This is - ! a kind of 'targetted' deposition. Then, force in-stratus LWC to be bounded + ! a kind of 'targetted' deposition. Then, force in-stratus LWC to be bounded ! by qcst_min and qcst_max in mmacro_pcond. - ! (4) In contrast to liquid, convective ice is detrained into the environment + ! (4) In contrast to liquid, convective ice is detrained into the environment ! and involved in the sublimation. Similar bounds as liquid stratus are imposed. ! This is the key procesure generating upper-level cirrus clouds. ! The unit of dlf : [ kg/kg/s ] - if (zmconv_microp) then - call pbuf_get_field(pbuf, dlfzm_idx, dlfzm) - call pbuf_get_field(pbuf, difzm_idx, difzm) - call pbuf_get_field(pbuf, dnlfzm_idx, dnlfzm) - call pbuf_get_field(pbuf, dnifzm_idx, dnifzm) - end if - det_s(:) = 0._r8 det_ice(:) = 0._r8 @@ -729,57 +712,43 @@ subroutine macrop_driver_tend( & ! If detrainment was done elsewhere, still update the variables used for output ! assuming that the temperature split between liquid and ice is the same as assumed ! here. - if (zmconv_microp) then - ptend_loc%q(i,k,ixcldliq) = dlfzm(i,k) + dlf2(i,k) * ( 1._r8 - dum1 ) - ptend_loc%q(i,k,ixcldice) = difzm(i,k) + dlf2(i,k) * dum1 - - ptend_loc%q(i,k,ixnumliq) = dnlfzm(i,k) + 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) & - / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection - ptend_loc%q(i,k,ixnumice) = dnifzm(i,k) + 3._r8 * ( dlf2(i,k) * dum1 ) & - / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection - ptend_loc%s(i,k) = dlf2(i,k) * dum1 * latice - - else - if (do_detrain) then + if (do_detrain) then ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 ) ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1 ! dum2 = dlf(i,k) * ( 1._r8 - dum1 ) ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) / & (4._r8*3.14_r8* 8.e-6_r8**3*997._r8) + & ! Deep Convection 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) / & - (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection + (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection ! dum2 = dlf(i,k) * dum1 ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) / & (4._r8*3.14_r8*25.e-6_r8**3*500._r8) + & ! Deep Convection 3._r8 * ( dlf2(i,k) * dum1 ) / & (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice - else + else ptend_loc%q(i,k,ixcldliq) = 0._r8 ptend_loc%q(i,k,ixcldice) = 0._r8 ptend_loc%q(i,k,ixnumliq) = 0._r8 ptend_loc%q(i,k,ixnumice) = 0._r8 ptend_loc%s(i,k) = 0._r8 - end if - - end if ! Only rliq is saved from deep convection, which is the reserved liquid. We need to keep ! track of the integrals of ice and static energy that is effected from conversion to ice ! so that the energy checker doesn't complain. det_s(i) = det_s(i) + ptend_loc%s(i,k)*state_loc%pdel(i,k)/gravit - det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state_loc%pdel(i,k)/gravit + det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state_loc%pdel(i,k)/gravit ! Targetted detrainment of convective liquid water either directly into the - ! existing liquid stratus or into the environment. + ! existing liquid stratus or into the environment. if( cu_det_st ) then dlf_T(i,k) = ptend_loc%s(i,k)/cpair dlf_qv(i,k) = 0._r8 dlf_ql(i,k) = ptend_loc%q(i,k,ixcldliq) dlf_qi(i,k) = ptend_loc%q(i,k,ixcldice) dlf_nl(i,k) = ptend_loc%q(i,k,ixnumliq) - dlf_ni(i,k) = ptend_loc%q(i,k,ixnumice) + dlf_ni(i,k) = ptend_loc%q(i,k,ixnumice) ptend_loc%q(i,k,ixcldliq) = 0._r8 ptend_loc%q(i,k,ixcldice) = 0._r8 ptend_loc%q(i,k,ixnumliq) = 0._r8 @@ -792,15 +761,9 @@ subroutine macrop_driver_tend( & dpdlft (i,k) = 0._r8 shdlft (i,k) = 0._r8 else - if (zmconv_microp) then - dpdlfliq(i,k) = dlfzm(i,k) - dpdlfice(i,k) = difzm(i,k) - dpdlft (i,k) = 0._r8 - else - dpdlfliq(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( 1._r8 - dum1 ) - dpdlfice(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( dum1 ) - dpdlft (i,k) = ( dlf(i,k) - dlf2(i,k) ) * dum1 * latice/cpair - end if + dpdlfliq(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( 1._r8 - dum1 ) + dpdlfice(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( dum1 ) + dpdlft (i,k) = ( dlf(i,k) - dlf2(i,k) ) * dum1 * latice/cpair shdlfliq(i,k) = dlf2(i,k) * ( 1._r8 - dum1 ) shdlfice(i,k) = dlf2(i,k) * ( dum1 ) @@ -833,7 +796,7 @@ subroutine macrop_driver_tend( & ! -------------------------------------- ! ! ----------------------------------------------------------------------------- ! - ! Treatment of cloud fraction in CAM4 and CAM5 differs ! + ! Treatment of cloud fraction in CAM4 and CAM5 differs ! ! (1) CAM4 ! ! . Cumulus AMT = Deep Cumulus AMT ( empirical fcn of mass flux ) + ! ! Shallow Cumulus AMT ( empirical fcn of mass flux ) ! @@ -846,7 +809,7 @@ subroutine macrop_driver_tend( & ! . Stratus AMT = fcn of environmental-mean RH ( no Stability Stratus ) ! ! . Cumulus and Stratus are non-overlapped with higher priority on Cumulus ! ! . Cumulus ( both Deep and Shallow ) has its own LWC and IWC. ! - ! ----------------------------------------------------------------------------- ! + ! ----------------------------------------------------------------------------- ! concld_old(:ncol,top_lev:pver) = concld(:ncol,top_lev:pver) @@ -862,22 +825,22 @@ subroutine macrop_driver_tend( & clri_old(:ncol,:top_lev-1) = 0._r8 do k = top_lev, pver do i = 1, ncol - clrw_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - alst(i,k) ) ) - clri_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - ast(i,k) ) ) + clrw_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - alst(i,k) ) ) + clri_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - ast(i,k) ) ) end do end do if( use_shfrc ) then call pbuf_get_field(pbuf, shfrc_idx, shfrc ) - else + else allocate(shfrc(pcols,pver)) shfrc(:,:) = 0._r8 endif - ! CAM5 only uses 'concld' output from the below subroutine. + ! CAM5 only uses 'concld' output from the below subroutine. ! Stratus ('ast' = max(alst,aist)) and total cloud fraction ('cld = ast + concld') - ! will be computed using this updated 'concld' in the stratiform macrophysics - ! scheme (mmacro_pcond) later below. + ! will be computed using this updated 'concld' in the stratiform macrophysics + ! scheme (mmacro_pcond) later below. call t_startf("cldfrc") @@ -901,11 +864,15 @@ subroutine macrop_driver_tend( & rdtime = 1._r8/dtime ! Define fractional amount of stratus condensate and precipitation in ice phase. - ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ). + ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ). ! The ramp within convective cloud may be different - call cldfrc_fice( ncol, state_loc%t, fice, fsnow ) +!REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + fice(:,:) = 0._r8 + fsnow(:,:) = 0._r8 +!REMOVECAM_END + call cloud_fraction_fice_run(ncol, state_loc%t(:ncol,:), tmelt, top_lev, pver, fice(:ncol,:), fsnow(:ncol,:)) lq(:) = .FALSE. @@ -918,7 +885,7 @@ subroutine macrop_driver_tend( & ! Initialize local physics_ptend object again call physics_ptend_init(ptend_loc, state%psetcols, 'macro_park', & - ls=.true., lq=lq ) + ls=.true., lq=lq ) ! --------------------------------- ! ! Liquid Macrop_Driver Macrophysics ! @@ -932,9 +899,9 @@ subroutine macrop_driver_tend( & nc(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixnumliq) ni(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixnumice) - ! In CAM5, 'microphysical forcing' ( CC_... ) and 'the other advective forcings' ( ttend, ... ) + ! In CAM5, 'microphysical forcing' ( CC_... ) and 'the other advective forcings' ( ttend, ... ) ! are separately provided into the prognostic microp_driver macrophysics scheme. This is an - ! attempt to resolve in-cloud and out-cloud forcings. + ! attempt to resolve in-cloud and out-cloud forcings. if( get_nstep() .le. 1 ) then tcwat(:ncol,top_lev:pver) = state_loc%t(:ncol,top_lev:pver) @@ -958,7 +925,7 @@ subroutine macrop_driver_tend( & CC_qlst(:ncol,:) = 0._r8 else ttend(:ncol,top_lev:pver) = ( state_loc%t(:ncol,top_lev:pver) - tcwat(:ncol,top_lev:pver)) * rdtime & - - CC_T(:ncol,top_lev:pver) + - CC_T(:ncol,top_lev:pver) qtend(:ncol,top_lev:pver) = ( state_loc%q(:ncol,top_lev:pver,1) - qcwat(:ncol,top_lev:pver)) * rdtime & - CC_qv(:ncol,top_lev:pver) ltend(:ncol,top_lev:pver) = ( qc(:ncol,top_lev:pver) + qi(:ncol,top_lev:pver) - lcwat(:ncol,top_lev:pver) ) * rdtime & @@ -972,7 +939,7 @@ subroutine macrop_driver_tend( & endif lmitend(:ncol,top_lev:pver) = ltend(:ncol,top_lev:pver) - itend(:ncol,top_lev:pver) - t_inout(:ncol,top_lev:pver) = tcwat(:ncol,top_lev:pver) + t_inout(:ncol,top_lev:pver) = tcwat(:ncol,top_lev:pver) qv_inout(:ncol,top_lev:pver) = qcwat(:ncol,top_lev:pver) ql_inout(:ncol,top_lev:pver) = lcwat(:ncol,top_lev:pver) - iccwat(:ncol,top_lev:pver) qi_inout(:ncol,top_lev:pver) = iccwat(:ncol,top_lev:pver) @@ -982,20 +949,20 @@ subroutine macrop_driver_tend( & ! Liquid Microp_Driver Macrophysics. ! The main roles of this subroutines are ! (1) compute net condensation rate of stratiform liquid ( cmeliq ) - ! (2) compute liquid stratus and ice stratus fractions. + ! (2) compute liquid stratus and ice stratus fractions. ! Note 'ttend...' are advective tendencies except microphysical process while - ! 'CC...' are microphysical tendencies. + ! 'CC...' are microphysical tendencies. call mmacro_pcond( lchnk, ncol, dtime, state_loc%pmid, state_loc%pdel, & - t_inout, qv_inout, ql_inout, qi_inout, nl_inout, ni_inout, & + t_inout, qv_inout, ql_inout, qi_inout, nl_inout, ni_inout, & ttend, qtend, lmitend, itend, nltend, nitend, & - CC_T, CC_qv, CC_ql, CC_qi, CC_nl, CC_ni, CC_qlst, & + CC_T, CC_qv, CC_ql, CC_qi, CC_nl, CC_ni, CC_qlst, & dlf_T, dlf_qv, dlf_ql, dlf_qi, dlf_nl, dlf_ni, & concld_old, concld, clrw_old, clri_old, landfrac, snowh, & tke, qtl_flx, qti_flx, cmfr_det, qlr_det, qir_det, & tlat, qvlat, qcten, qiten, ncten, niten, & cmeliq, qvadj, qladj, qiadj, qllim, qilim, & - cld, alst, aist, qlst, qist, do_cldice ) + cld, alst, aist, qlst, qist, do_cldice ) ! Copy of concld/fice to put in physics buffer ! Below are used only for convective cloud. @@ -1021,20 +988,20 @@ subroutine macrop_driver_tend( & ! Check to make sure that the macrophysics code is respecting the flags that control ! whether cldwat should be prognosing cloud ice and cloud liquid or not. - if ((.not. do_cldice) .and. (qiten(i,k) /= 0.0_r8)) then + if ((.not. do_cldice) .and. (qiten(i,k) /= 0.0_r8)) then call endrun("macrop_driver:ERROR - "// & "Cldwat is configured not to prognose cloud ice, but mmacro_pcond has ice mass tendencies.") end if - if ((.not. do_cldice) .and. (niten(i,k) /= 0.0_r8)) then + if ((.not. do_cldice) .and. (niten(i,k) /= 0.0_r8)) then call endrun("macrop_driver:ERROR -"// & " Cldwat is configured not to prognose cloud ice, but mmacro_pcond has ice number tendencies.") end if - if ((.not. do_cldliq) .and. (qcten(i,k) /= 0.0_r8)) then + if ((.not. do_cldliq) .and. (qcten(i,k) /= 0.0_r8)) then call endrun("macrop_driver:ERROR - "// & "Cldwat is configured not to prognose cloud liquid, but mmacro_pcond has liquid mass tendencies.") end if - if ((.not. do_cldliq) .and. (ncten(i,k) /= 0.0_r8)) then + if ((.not. do_cldliq) .and. (ncten(i,k) /= 0.0_r8)) then call endrun("macrop_driver:ERROR - "// & "Cldwat is configured not to prognose cloud liquid, but mmacro_pcond has liquid number tendencies.") end if @@ -1064,7 +1031,7 @@ subroutine macrop_driver_tend( & call outfld( 'ICECLDF ', aist, pcols, lchnk ) call outfld( 'LIQCLDF ', alst, pcols, lchnk ) - call outfld( 'AST', ast, pcols, lchnk ) + call outfld( 'AST', ast, pcols, lchnk ) call outfld( 'CONCLD ', concld, pcols, lchnk ) call outfld( 'CLDST ', cldst, pcols, lchnk ) @@ -1075,7 +1042,7 @@ subroutine macrop_driver_tend( & ! calculations and outfld calls for CLDLIQSTR, CLDICESTR, CLDLIQCON, CLDICECON for CFMIP ! initialize local variables - mr_ccliq = 0._r8 !! not seen by radiation, so setting to 0 + mr_ccliq = 0._r8 !! not seen by radiation, so setting to 0 mr_ccice = 0._r8 !! not seen by radiation, so setting to 0 mr_lsliq = 0._r8 mr_lsice = 0._r8 @@ -1098,7 +1065,7 @@ subroutine macrop_driver_tend( & call outfld( 'CLDICECON ', mr_ccice, pcols, lchnk ) ! ------------------------------------------------- ! - ! Save equilibrium state variables for macrophysics ! + ! Save equilibrium state variables for macrophysics ! ! at the next time step ! ! ------------------------------------------------- ! cldsice = 0._r8 @@ -1125,58 +1092,69 @@ end subroutine macrop_driver_tend ! With CLUBB, we are seeing relative humidity with respect to water ! greater than 1. This should not be happening and is not what the ! microphsyics expects from the macrophysics. As a work around while -! this issue is investigated in CLUBB, this routine will enfornce a +! this issue is investigated in CLUBB, this routine will enfornce a ! maximum RHliq of 1 everywhere in the atmosphere. Any excess water will ! be converted into cloud drops. -elemental subroutine liquid_macro_tend(npccn,t,p,qv,qc,nc,xxlv,deltat,stend,qvtend,qctend,nctend) +subroutine liquid_macro_tend(npccn,t,p,qv,qc,nc,xxlv,deltat,stend,qvtend,qctend,nctend,vlen) - use wv_sat_methods, only: wv_sat_qsat_ice, wv_sat_qsat_water - use micro_mg_utils, only: rhow + use wv_sat_methods, only: wv_sat_qsat_ice_vect, wv_sat_qsat_water_vect + use micro_pumas_utils, only: rhow use physconst, only: rair use cldfrc2m, only: rhmini_const, rhmaxi_const - real(r8), intent(in) :: npccn !Activated number of cloud condensation nuclei - real(r8), intent(in) :: t !temperature (k) - real(r8), intent(in) :: p !pressure (pa) - real(r8), intent(in) :: qv !water vapor mixing ratio - real(r8), intent(in) :: qc !liquid mixing ratio - real(r8), intent(in) :: nc !liquid number concentration - real(r8), intent(in) :: xxlv !latent heat of vaporization - real(r8), intent(in) :: deltat !timestep - real(r8), intent(out) :: stend ! 'temperature' tendency - real(r8), intent(out) :: qvtend !vapor tendency - real(r8), intent(out) :: qctend !liquid mass tendency - real(r8), intent(out) :: nctend !liquid number tendency - - - real(r8) :: ESL - real(r8) :: QSL - - stend = 0._r8 - qvtend = 0._r8 - qctend = 0._r8 - nctend = 0._r8 + integer, intent(in) :: vlen + real(r8), dimension(vlen), intent(in) :: npccn !Activated number of cloud condensation nuclei + real(r8), dimension(vlen), intent(in) :: t !temperature (k) + real(r8), dimension(vlen), intent(in) :: p !pressure (pa) + real(r8), dimension(vlen), intent(in) :: qv !water vapor mixing ratio + real(r8), dimension(vlen), intent(in) :: qc !liquid mixing ratio + real(r8), dimension(vlen), intent(in) :: nc !liquid number concentration + real(r8), intent(in) :: xxlv !latent heat of vaporization + real(r8), intent(in) :: deltat !timestep + real(r8), dimension(vlen), intent(out) :: stend ! 'temperature' tendency + real(r8), dimension(vlen), intent(out) :: qvtend !vapor tendency + real(r8), dimension(vlen), intent(out) :: qctend !liquid mass tendency + real(r8), dimension(vlen), intent(out) :: nctend !liquid number tendency + + real(r8) :: ESL(vlen) + real(r8) :: QSL(vlen) + real(r8) :: drop_size_param + integer :: i + + drop_size_param = 3._r8/(4._r8*3.14_r8*6.e-6_r8**3*rhow) + + do i = 1, vlen + stend(i) = 0._r8 + qvtend(i) = 0._r8 + qctend(i) = 0._r8 + nctend(i) = 0._r8 + end do ! calculate qsatl from t,p,q - call wv_sat_qsat_water(t, p, ESL, QSL) - - ! Don't allow supersaturation with respect to liquid. - if (qv.gt.QSL) then - - qctend = (qv - QSL) / deltat - qvtend = 0._r8 - qctend - stend = qctend * xxlv ! moist static energy tend...[J/kg/s] ! - - ! If drops exists (more than 1 L-1) and there is condensation, - ! do not add to number (= growth), otherwise add 6um drops. - ! - ! This is somewhat arbitrary, but ensures that some reasonable droplet - ! size is create to remove the excess water. This could be enhanced to - ! look at npccn, but ideally this entire routine should go away. - if (nc*p/rair/t.lt.1e3_r8.and.(qc+qctend*deltat).gt.1e-18_r8) then - nctend = nctend + 3._r8 * qctend/(4._r8*3.14_r8*6.e-6_r8**3*rhow) - endif - endif + !$acc data copyin(t,p) copyout(ESL,QSL) + call wv_sat_qsat_water_vect(t, p, ESL, QSL, vlen) + !$acc end data + + do i = 1, vlen + ! Don't allow supersaturation with respect to liquid. + if (qv(i) > QSL(i)) then + + qctend(i) = (qv(i) - QSL(i)) / deltat + qvtend(i) = 0._r8 - qctend(i) + stend(i) = qctend(i) * xxlv ! moist static energy tend...[J/kg/s] ! + + ! If drops exists (more than 1 L-1) and there is condensation, + ! do not add to number (= growth), otherwise add 6um drops. + ! + ! This is somewhat arbitrary, but ensures that some reasonable droplet + ! size is created to remove the excess water. This could be enhanced to + ! look at npccn, but ideally this entire routine should go away. + if ((nc(i)*p(i)/rair/t(i) < 1e3_r8) .and. (qc(i)+qctend(i)*deltat > 1e-18_r8)) then + nctend(i) = nctend(i) + qctend(i)*drop_size_param + end if + end if + end do + end subroutine liquid_macro_tend end module macrop_driver diff --git a/src/physics/cam/micro_mg_cam.F90 b/src/physics/cam/micro_mg_cam.F90 deleted file mode 100644 index 7a5336ace4..0000000000 --- a/src/physics/cam/micro_mg_cam.F90 +++ /dev/null @@ -1,3764 +0,0 @@ -module micro_mg_cam - -!--------------------------------------------------------------------------------- -! -! CAM Interfaces for MG microphysics -! -!--------------------------------------------------------------------------------- -! -! How to add new packed MG inputs to micro_mg_cam_tend: -! -! If you have an input with first dimension [psetcols, pver], the procedure -! for adding inputs is as follows: -! -! 1) In addition to any variables you need to declare for the "unpacked" -! (CAM format) version, you must declare an array for the "packed" -! (MG format) version. -! -! 2) Add a call similar to the following line (look before the -! micro_mg_tend calls to see similar lines): -! -! packed_array = packer%pack(original_array) -! -! The packed array can then be passed into any of the MG schemes. -! -! This same procedure will also work for 1D arrays of size psetcols, 3-D -! arrays with psetcols and pver as the first dimensions, and for arrays of -! dimension [psetcols, pverp]. You only have to modify the allocation of -! the packed array before the "pack" call. -! -!--------------------------------------------------------------------------------- -! -! How to add new packed MG outputs to micro_mg_cam_tend: -! -! 1) As with inputs, in addition to the unpacked outputs you must declare -! an array for packed data. The unpacked and packed arrays must *also* -! be targets or pointers (but cannot be both). -! -! 2) Add the field to post-processing as in the following line (again, -! there are many examples before the micro_mg_tend calls): -! -! call post_proc%add_field(p(final_array),p(packed_array)) -! -! *** IMPORTANT ** If the fields are only being passed to a certain version of -! MG, you must only add them if that version is being called (see -! the "if (micro_mg_version >1)" sections below -! -! This registers the field for post-MG averaging, and to scatter to the -! final, unpacked version of the array. -! -! By default, any columns/levels that are not operated on by MG will be -! set to 0 on output; this value can be adjusted using the "fillvalue" -! optional argument to post_proc%add_field. -! -! Also by default, outputs from multiple substeps will be averaged after -! MG's substepping is complete. Passing the optional argument -! "accum_method=accum_null" will change this behavior so that the last -! substep is always output. -! -! This procedure works on 1-D and 2-D outputs. Note that the final, -! unpacked arrays are not set until the call to -! "post_proc%process_and_unpack", which sets every single field that was -! added with post_proc%add_field. -! -!--------------------------------------------------------------------------------- - -use shr_kind_mod, only: r8=>shr_kind_r8 -use spmd_utils, only: masterproc -use ppgrid, only: pcols, pver, pverp, psubcols -use physconst, only: gravit, rair, tmelt, cpair, rh2o, rhoh2o, & - latvap, latice, mwh2o -use phys_control, only: phys_getopts, use_hetfrz_classnuc - - -use physics_types, only: physics_state, physics_ptend, & - physics_ptend_init, physics_state_copy, & - physics_update, physics_state_dealloc, & - physics_ptend_sum, physics_ptend_scale - -use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dyn_time_lvls, & - pbuf_old_tim_idx, pbuf_get_index, dtype_r8, dtype_i4, & - pbuf_get_field, pbuf_set_field, col_type_subcol, & - pbuf_register_subcol -use constituents, only: cnst_add, cnst_get_ind, & - cnst_name, cnst_longname, sflxnam, apcnst, bpcnst, pcnst - -use cldfrc2m, only: rhmini=>rhmini_const - -use cam_history, only: addfld, add_default, outfld, horiz_only - -use cam_logfile, only: iulog -use cam_abortutils, only: endrun -use scamMod, only: single_column -use error_messages, only: handle_errmsg -use ref_pres, only: top_lev=>trop_cloud_top_lev - -use subcol_utils, only: subcol_get_scheme - -implicit none -private -save - -public :: & - micro_mg_cam_readnl, & - micro_mg_cam_register, & - micro_mg_cam_init_cnst, & - micro_mg_cam_implements_cnst, & - micro_mg_cam_init, & - micro_mg_cam_tend, & - micro_mg_version, & - massless_droplet_destroyer - -integer :: micro_mg_version = 1 ! Version number for MG. -integer :: micro_mg_sub_version = 0 ! Second part of version number. - -real(r8) :: micro_mg_dcs = -1._r8 - -logical :: microp_uniform = .false. -logical :: micro_mg_adjust_cpt = .false. - -logical :: micro_do_massless_droplet_destroyer ! turn on/off destruction of massless droplets - -character(len=16) :: micro_mg_precip_frac_method = 'max_overlap' ! type of precipitation fraction method - -real(r8) :: micro_mg_berg_eff_factor = 1.0_r8 ! berg efficiency factor - -logical, public :: do_cldliq ! Prognose cldliq flag -logical, public :: do_cldice ! Prognose cldice flag - -integer :: num_steps ! Number of MG substeps - -integer :: ncnst = 4 ! Number of constituents - -! Namelist variables for option to specify constant cloud droplet/ice number -logical :: micro_mg_nccons = .false. ! set .true. to specify constant cloud droplet number -logical :: micro_mg_nicons = .false. ! set .true. to specify constant cloud ice number -logical :: micro_mg_ngcons = .false. ! set .true. to specify constant graupel/hail number -logical :: micro_mg_nrcons = .false. ! set .true. to specify constant rain number -logical :: micro_mg_nscons = .false. ! set .true. to specify constant snow number - -! parameters for specified ice and droplet number concentration -! note: these are local in-cloud values, not grid-mean -real(r8) :: micro_mg_ncnst = 50.e6_r8 ! constant liquid droplet num concentration (m-3) -real(r8) :: micro_mg_ninst = 0.05e6_r8 ! ice num concentration when nicons=.true. (m-3) -real(r8) :: micro_mg_nrnst = 0.2e6_r8 ! rain num concentration when nrcons=.true. (m-3) -real(r8) :: micro_mg_nsnst = 0.005e6_r8 ! snow num concentration when nscons=.true. (m-3) -real(r8) :: micro_mg_ngnst = 0.0005e6_r8 ! graupel/hail num concentration when ngcons=.true. (m-3) - -logical, public :: micro_mg_do_graupel -logical, public :: micro_mg_do_hail - -! switches for IFS like behavior -logical :: micro_mg_evap_sed_off = .false. ! Turn off evaporation/sublimation based on cloud fraction for sedimenting condensate -logical :: micro_mg_icenuc_rh_off = .false. ! Remove RH conditional from ice nucleation -logical :: micro_mg_icenuc_use_meyers = .false. ! Meyers Ice Nucleation -logical :: micro_mg_evap_scl_ifs = .false. ! Scale evaporation as IFS does -logical :: micro_mg_evap_rhthrsh_ifs = .false. ! Evap RH threhold following IFS -logical :: micro_mg_rainfreeze_ifs = .false. ! Rain freezing at 0C following IFS -logical :: micro_mg_ifs_sed = .false. ! Snow sedimentation = 1 m/s following IFS -logical :: micro_mg_precip_fall_corr = .false. ! Precip fall speed following IFS - -character(len=10), parameter :: & ! Constituent names - cnst_names(10) = (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE', & - 'RAINQM', 'SNOWQM','NUMRAI','NUMSNO','GRAUQM','NUMGRA'/) - -integer :: & - ixcldliq = -1, &! cloud liquid amount index - ixcldice = -1, &! cloud ice amount index - ixnumliq = -1, &! cloud liquid number index - ixnumice = -1, &! cloud ice water index - ixrain = -1, &! rain index - ixsnow = -1, &! snow index - ixnumrain = -1, &! rain number index - ixnumsnow = -1, &! snow number index - ixgraupel = -1, &! graupel index - ixnumgraupel = -1 ! graupel number index - -! Physics buffer indices for fields registered by this module -integer :: & - cldo_idx, & - qme_idx, & - prain_idx, & - nevapr_idx, & - wsedl_idx, & - rei_idx, & - sadice_idx, & - sadsnow_idx, & - rel_idx, & - dei_idx, & - mu_idx, & - prer_evap_idx, & - lambdac_idx, & - iciwpst_idx, & - iclwpst_idx, & - des_idx, & - icswp_idx, & - cldfsnow_idx, & - degrau_idx = -1, & - icgrauwp_idx = -1, & - cldfgrau_idx = -1, & - rate1_cw2pr_st_idx = -1, & - ls_flxprc_idx, & - ls_flxsnw_idx, & - relvar_idx, & - cmeliq_idx, & - accre_enhan_idx - -! Fields for UNICON -integer :: & - am_evp_st_idx, &! Evaporation area of stratiform precipitation - evprain_st_idx, &! Evaporation rate of stratiform rain [kg/kg/s]. >= 0. - evpsnow_st_idx ! Evaporation rate of stratiform snow [kg/kg/s]. >= 0. - -! Fields needed as inputs to COSP -integer :: & - ls_mrprc_idx, ls_mrsnw_idx, & - ls_reffrain_idx, ls_reffsnow_idx, & - cv_reffliq_idx, cv_reffice_idx - -! Fields needed by Park macrophysics -integer :: & - cc_t_idx, cc_qv_idx, & - cc_ql_idx, cc_qi_idx, & - cc_nl_idx, cc_ni_idx, & - cc_qlst_idx - -! Used to replace aspects of MG microphysics -! (e.g. by CARMA) -integer :: & - tnd_qsnow_idx = -1, & - tnd_nsnow_idx = -1, & - re_ice_idx = -1 - -! Index fields for precipitation efficiency. -integer :: & - acpr_idx = -1, & - acgcme_idx = -1, & - acnum_idx = -1 - -! Physics buffer indices for fields registered by other modules -integer :: & - ast_idx = -1, & - cld_idx = -1, & - concld_idx = -1, & - qsatfac_idx = -1 - -! Pbuf fields needed for subcol_SILHS -integer :: & - qrain_idx=-1, qsnow_idx=-1, & - nrain_idx=-1, nsnow_idx=-1, & - qcsedten_idx=-1, qrsedten_idx=-1, & - qisedten_idx=-1, qssedten_idx=-1, & - vtrmc_idx=-1, umr_idx=-1, & - vtrmi_idx=-1, ums_idx=-1, & - qcsevap_idx=-1, qisevap_idx=-1 - -integer :: & - naai_idx = -1, & - naai_hom_idx = -1, & - npccn_idx = -1, & - rndst_idx = -1, & - nacon_idx = -1, & - prec_str_idx = -1, & - snow_str_idx = -1, & - prec_pcw_idx = -1, & - snow_pcw_idx = -1, & - prec_sed_idx = -1, & - snow_sed_idx = -1 - -! pbuf fields for heterogeneous freezing -integer :: & - frzimm_idx = -1, & - frzcnt_idx = -1, & - frzdep_idx = -1 - -logical :: allow_sed_supersat ! allow supersaturated conditions after sedimentation loop -logical :: micro_do_sb_physics = .false. ! do SB 2001 autoconversion and accretion - -integer :: bergso_idx = -1 - -interface p - module procedure p1 - module procedure p2 -end interface p - - -!=============================================================================== -contains -!=============================================================================== - -subroutine micro_mg_cam_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_real8, & - mpi_logical, mpi_character - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Namelist variables - logical :: micro_mg_do_cldice = .true. ! do_cldice = .true., MG microphysics is prognosing cldice - logical :: micro_mg_do_cldliq = .true. ! do_cldliq = .true., MG microphysics is prognosing cldliq - integer :: micro_mg_num_steps = 1 ! Number of substepping iterations done by MG (1.5 only for now). - - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: sub = 'micro_mg_cam_readnl' - - namelist /micro_mg_nl/ micro_mg_version, micro_mg_sub_version, & - micro_mg_do_cldice, micro_mg_do_cldliq, micro_mg_num_steps, & - microp_uniform, micro_mg_dcs, micro_mg_precip_frac_method, & - micro_mg_berg_eff_factor, micro_do_sb_physics, micro_mg_adjust_cpt, & - micro_mg_do_hail, micro_mg_do_graupel,micro_mg_ngcons, micro_mg_ngnst,& - micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, micro_mg_ninst,& - micro_mg_nrcons, micro_mg_nscons, micro_mg_nrnst, micro_mg_nsnst,& - micro_do_massless_droplet_destroyer,& - micro_mg_evap_sed_off, micro_mg_icenuc_rh_off, micro_mg_icenuc_use_meyers, & - micro_mg_evap_scl_ifs, micro_mg_evap_rhthrsh_ifs, & - micro_mg_rainfreeze_ifs, micro_mg_ifs_sed, micro_mg_precip_fall_corr - - - !----------------------------------------------------------------------------- - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'micro_mg_nl', status=ierr) - if (ierr == 0) then - read(unitn, micro_mg_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(sub // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - - ! set local variables - do_cldice = micro_mg_do_cldice - do_cldliq = micro_mg_do_cldliq - num_steps = micro_mg_num_steps - - ! Verify that version numbers are valid. - select case (micro_mg_version) - case (1) - select case (micro_mg_sub_version) - case(0) - ! MG version 1.0 - case default - call bad_version_endrun() - end select - case (2) - select case (micro_mg_sub_version) - case(0) - ! MG version 2.0 - case default - call bad_version_endrun() - end select - case (3) - select case (micro_mg_sub_version) - case(0) - ! MG version 3.0 - case default - call bad_version_endrun() - end select - case default - call bad_version_endrun() - end select - - if (micro_mg_dcs < 0._r8) call endrun( "micro_mg_cam_readnl: & - µ_mg_dcs has not been set to a valid value.") - - if (micro_mg_version < 3) then - - if(micro_mg_do_graupel .or. micro_mg_do_hail ) then - call endrun ("micro_mg_cam_readnl: Micro_mg_do_graupel and micro_mg_do_hail & - &must be false for MG versions before MG3.") - end if - - else ! micro_mg_version = 3 or greater - - if(micro_mg_do_graupel .and. micro_mg_do_hail ) then - call endrun ("micro_mg_cam_readnl: Only one of micro_mg_do_graupel or & - µ_mg_do_hail may be true at a time.") - end if - - end if - - end if - - ! Broadcast namelist variables - call mpi_bcast(micro_mg_version, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_version") - - call mpi_bcast(micro_mg_sub_version, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_sub_version") - - call mpi_bcast(do_cldice, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_cldice") - - call mpi_bcast(do_cldliq, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_cldliq") - - call mpi_bcast(num_steps, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: num_steps") - - call mpi_bcast(microp_uniform, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: microp_uniform") - - call mpi_bcast(micro_mg_dcs, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_dcs") - - call mpi_bcast(micro_mg_berg_eff_factor, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_berg_eff_factor") - - call mpi_bcast(micro_mg_precip_frac_method, 16, mpi_character, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_precip_frac_method") - - call mpi_bcast(micro_do_sb_physics, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_do_sb_physics") - - call mpi_bcast(micro_mg_adjust_cpt, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_adjust_cpt") - - call mpi_bcast(micro_mg_nccons, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nccons") - - call mpi_bcast(micro_mg_nicons, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nicons") - - call mpi_bcast(micro_mg_nrcons, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nrcons") - - call mpi_bcast(micro_mg_nscons, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nscons") - - call mpi_bcast(micro_mg_ncnst, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ncnst") - - call mpi_bcast(micro_mg_ninst, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ninst") - - call mpi_bcast(micro_mg_nrnst, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nrnst") - - call mpi_bcast(micro_mg_nsnst, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nsnst") - - call mpi_bcast(micro_mg_do_hail, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_do_hail") - - call mpi_bcast(micro_mg_do_graupel, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_do_graupel") - - call mpi_bcast(micro_mg_ngcons, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ngcons") - - call mpi_bcast(micro_mg_ngnst, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ngnst") - - call mpi_bcast(micro_do_massless_droplet_destroyer, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_do_massless_droplet_destroyer") - - call mpi_bcast(micro_mg_evap_sed_off, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_evap_sed_off") - - call mpi_bcast(micro_mg_icenuc_rh_off, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_icenuc_rh_off") - - call mpi_bcast(micro_mg_icenuc_use_meyers, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_icenuc_use_meyers") - - call mpi_bcast(micro_mg_evap_scl_ifs, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_evap_scl_ifs") - - call mpi_bcast(micro_mg_evap_rhthrsh_ifs, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_evap_rhthrsh_ifs") - - call mpi_bcast(micro_mg_rainfreeze_ifs, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_rainfreeze_ifs") - - call mpi_bcast(micro_mg_ifs_sed, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ifs_sed") - - call mpi_bcast(micro_mg_precip_fall_corr, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_precip_fall_corr") - - if (masterproc) then - - write(iulog,*) 'MG microphysics namelist:' - write(iulog,*) ' micro_mg_version = ', micro_mg_version - write(iulog,*) ' micro_mg_sub_version = ', micro_mg_sub_version - write(iulog,*) ' micro_mg_do_cldice = ', do_cldice - write(iulog,*) ' micro_mg_do_cldliq = ', do_cldliq - write(iulog,*) ' micro_mg_num_steps = ', num_steps - write(iulog,*) ' microp_uniform = ', microp_uniform - write(iulog,*) ' micro_mg_dcs = ', micro_mg_dcs - write(iulog,*) ' micro_mg_berg_eff_factor = ', micro_mg_berg_eff_factor - write(iulog,*) ' micro_mg_precip_frac_method = ', micro_mg_precip_frac_method - write(iulog,*) ' micro_do_sb_physics = ', micro_do_sb_physics - write(iulog,*) ' micro_mg_adjust_cpt = ', micro_mg_adjust_cpt - write(iulog,*) ' micro_mg_nccons = ', micro_mg_nccons - write(iulog,*) ' micro_mg_nicons = ', micro_mg_nicons - write(iulog,*) ' micro_mg_ncnst = ', micro_mg_ncnst - write(iulog,*) ' micro_mg_ninst = ', micro_mg_ninst - write(iulog,*) ' micro_mg_ngcons = ', micro_mg_ngcons - write(iulog,*) ' micro_mg_ngnst = ', micro_mg_ngnst - write(iulog,*) ' micro_mg_do_hail = ', micro_mg_do_hail - write(iulog,*) ' micro_mg_do_graupel = ', micro_mg_do_graupel - write(iulog,*) ' micro_do_massless_droplet_destroyer = ', micro_do_massless_droplet_destroyer - write(iulog,*) ' micro_mg_nrcons = ', micro_mg_nrcons - write(iulog,*) ' micro_mg_nscons = ', micro_mg_nscons - write(iulog,*) ' micro_mg_nrnst = ', micro_mg_nrnst - write(iulog,*) ' micro_mg_nsnst = ', micro_mg_nsnst - write(iulog,*) ' micro_mg_evap_sed_off = ', micro_mg_evap_sed_off - write(iulog,*) ' micro_mg_icenuc_rh_off = ', micro_mg_icenuc_rh_off - write(iulog,*) ' micro_mg_icenuc_use_meyers = ', micro_mg_icenuc_use_meyers - write(iulog,*) ' micro_mg_evap_scl_ifs = ', micro_mg_evap_scl_ifs - write(iulog,*) ' micro_mg_evap_rhthrsh_ifs = ', micro_mg_evap_rhthrsh_ifs - write(iulog,*) ' micro_mg_rainfreeze_ifs = ', micro_mg_rainfreeze_ifs - write(iulog,*) ' micro_mg_ifs_sed = ', micro_mg_ifs_sed - write(iulog,*) ' micro_mg_precip_fall_corr = ', micro_mg_precip_fall_corr - end if - -contains - - subroutine bad_version_endrun - ! Endrun wrapper with a more useful error message. - character(len=128) :: errstring - write(errstring,*) "Invalid version number specified for MG microphysics: ", & - micro_mg_version,".",micro_mg_sub_version - call endrun(errstring) - end subroutine bad_version_endrun - -end subroutine micro_mg_cam_readnl - -!================================================================================================ - -subroutine micro_mg_cam_register - - ! Register microphysics constituents and fields in the physics buffer. - !----------------------------------------------------------------------- - - logical :: prog_modal_aero - logical :: use_subcol_microp ! If true, then are using subcolumns in microphysics - - call phys_getopts(use_subcol_microp_out = use_subcol_microp, & - prog_modal_aero_out = prog_modal_aero) - - ! Register microphysics constituents and save indices. - - call cnst_add(cnst_names(1), mwh2o, cpair, 0._r8, ixcldliq, & - longname='Grid box averaged cloud liquid amount', is_convtran1=.true.) - call cnst_add(cnst_names(2), mwh2o, cpair, 0._r8, ixcldice, & - longname='Grid box averaged cloud ice amount', is_convtran1=.true.) - - call cnst_add(cnst_names(3), mwh2o, cpair, 0._r8, ixnumliq, & - longname='Grid box averaged cloud liquid number', is_convtran1=.true.) - call cnst_add(cnst_names(4), mwh2o, cpair, 0._r8, ixnumice, & - longname='Grid box averaged cloud ice number', is_convtran1=.true.) - - ! Note is_convtran1 is set to .true. - if (micro_mg_version > 1) then - call cnst_add(cnst_names(5), mwh2o, cpair, 0._r8, ixrain, & - longname='Grid box averaged rain amount', is_convtran1=.true.) - call cnst_add(cnst_names(6), mwh2o, cpair, 0._r8, ixsnow, & - longname='Grid box averaged snow amount', is_convtran1=.true.) - call cnst_add(cnst_names(7), mwh2o, cpair, 0._r8, ixnumrain, & - longname='Grid box averaged rain number', is_convtran1=.true.) - call cnst_add(cnst_names(8), mwh2o, cpair, 0._r8, ixnumsnow, & - longname='Grid box averaged snow number', is_convtran1=.true.) - end if - - if (micro_mg_version > 2) then - call cnst_add(cnst_names(9), mwh2o, cpair, 0._r8, ixgraupel, & - longname='Grid box averaged graupel/hail amount', is_convtran1=.true.) - call cnst_add(cnst_names(10), mwh2o, cpair, 0._r8, ixnumgraupel, & - longname='Grid box averaged graupel/hail number', is_convtran1=.true.) - end if - - ! Request physics buffer space for fields that persist across timesteps. - - call pbuf_add_field('CLDO','global',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldo_idx) - - ! Physics buffer variables for convective cloud properties. - - call pbuf_add_field('QME', 'physpkg',dtype_r8,(/pcols,pver/), qme_idx) - call pbuf_add_field('PRAIN', 'physpkg',dtype_r8,(/pcols,pver/), prain_idx) - call pbuf_add_field('NEVAPR', 'physpkg',dtype_r8,(/pcols,pver/), nevapr_idx) - call pbuf_add_field('PRER_EVAP', 'global', dtype_r8,(/pcols,pver/), prer_evap_idx) - call pbuf_add_field('BERGSO', 'physpkg',dtype_r8,(/pcols,pver/), bergso_idx) - - call pbuf_add_field('WSEDL', 'physpkg',dtype_r8,(/pcols,pver/), wsedl_idx) - - call pbuf_add_field('REI', 'physpkg',dtype_r8,(/pcols,pver/), rei_idx) - call pbuf_add_field('SADICE', 'physpkg',dtype_r8,(/pcols,pver/), sadice_idx) - call pbuf_add_field('SADSNOW', 'physpkg',dtype_r8,(/pcols,pver/), sadsnow_idx) - call pbuf_add_field('REL', 'physpkg',dtype_r8,(/pcols,pver/), rel_idx) - - ! Mitchell ice effective diameter for radiation - call pbuf_add_field('DEI', 'physpkg',dtype_r8,(/pcols,pver/), dei_idx) - ! Size distribution shape parameter for radiation - call pbuf_add_field('MU', 'physpkg',dtype_r8,(/pcols,pver/), mu_idx) - ! Size distribution shape parameter for radiation - call pbuf_add_field('LAMBDAC', 'physpkg',dtype_r8,(/pcols,pver/), lambdac_idx) - - ! Stratiform only in cloud ice water path for radiation - call pbuf_add_field('ICIWPST', 'physpkg',dtype_r8,(/pcols,pver/), iciwpst_idx) - ! Stratiform in cloud liquid water path for radiation - call pbuf_add_field('ICLWPST', 'physpkg',dtype_r8,(/pcols,pver/), iclwpst_idx) - - ! Snow effective diameter for radiation - call pbuf_add_field('DES', 'physpkg',dtype_r8,(/pcols,pver/), des_idx) - ! In cloud snow water path for radiation - call pbuf_add_field('ICSWP', 'physpkg',dtype_r8,(/pcols,pver/), icswp_idx) - ! Cloud fraction for liquid drops + snow - call pbuf_add_field('CLDFSNOW ', 'physpkg',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldfsnow_idx) - - if (micro_mg_version > 2) then - ! Graupel effective diameter for radiation - call pbuf_add_field('DEGRAU', 'physpkg',dtype_r8,(/pcols,pver/), degrau_idx) - ! In cloud snow water path for radiation - call pbuf_add_field('ICGRAUWP', 'physpkg',dtype_r8,(/pcols,pver/), icgrauwp_idx) - ! Cloud fraction for liquid drops + graupel - call pbuf_add_field('CLDFGRAU', 'physpkg',dtype_r8,(/pcols,pver/), cldfgrau_idx) - end if - - if (prog_modal_aero) then - call pbuf_add_field('RATE1_CW2PR_ST','physpkg',dtype_r8,(/pcols,pver/), rate1_cw2pr_st_idx) - endif - - call pbuf_add_field('LS_FLXPRC', 'physpkg',dtype_r8,(/pcols,pverp/), ls_flxprc_idx) - call pbuf_add_field('LS_FLXSNW', 'physpkg',dtype_r8,(/pcols,pverp/), ls_flxsnw_idx) - - - ! Fields needed as inputs to COSP - call pbuf_add_field('LS_MRPRC', 'physpkg',dtype_r8,(/pcols,pver/), ls_mrprc_idx) - call pbuf_add_field('LS_MRSNW', 'physpkg',dtype_r8,(/pcols,pver/), ls_mrsnw_idx) - call pbuf_add_field('LS_REFFRAIN','physpkg',dtype_r8,(/pcols,pver/), ls_reffrain_idx) - call pbuf_add_field('LS_REFFSNOW','physpkg',dtype_r8,(/pcols,pver/), ls_reffsnow_idx) - call pbuf_add_field('CV_REFFLIQ', 'physpkg',dtype_r8,(/pcols,pver/), cv_reffliq_idx) - call pbuf_add_field('CV_REFFICE', 'physpkg',dtype_r8,(/pcols,pver/), cv_reffice_idx) - - ! CC_* Fields needed by Park macrophysics - call pbuf_add_field('CC_T', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_t_idx) - call pbuf_add_field('CC_qv', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qv_idx) - call pbuf_add_field('CC_ql', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_ql_idx) - call pbuf_add_field('CC_qi', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qi_idx) - call pbuf_add_field('CC_nl', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_nl_idx) - call pbuf_add_field('CC_ni', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_ni_idx) - call pbuf_add_field('CC_qlst', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qlst_idx) - - ! Fields for UNICON - call pbuf_add_field('am_evp_st', 'global', dtype_r8, (/pcols,pver/), am_evp_st_idx) - call pbuf_add_field('evprain_st', 'global', dtype_r8, (/pcols,pver/), evprain_st_idx) - call pbuf_add_field('evpsnow_st', 'global', dtype_r8, (/pcols,pver/), evpsnow_st_idx) - - ! Register subcolumn pbuf fields - if (use_subcol_microp) then - ! Global pbuf fields - call pbuf_register_subcol('CLDO', 'micro_mg_cam_register', cldo_idx) - - ! CC_* Fields needed by Park macrophysics - call pbuf_register_subcol('CC_T', 'micro_mg_cam_register', cc_t_idx) - call pbuf_register_subcol('CC_qv', 'micro_mg_cam_register', cc_qv_idx) - call pbuf_register_subcol('CC_ql', 'micro_mg_cam_register', cc_ql_idx) - call pbuf_register_subcol('CC_qi', 'micro_mg_cam_register', cc_qi_idx) - call pbuf_register_subcol('CC_nl', 'micro_mg_cam_register', cc_nl_idx) - call pbuf_register_subcol('CC_ni', 'micro_mg_cam_register', cc_ni_idx) - call pbuf_register_subcol('CC_qlst', 'micro_mg_cam_register', cc_qlst_idx) - - ! Physpkg pbuf fields - ! Physics buffer variables for convective cloud properties. - - call pbuf_register_subcol('QME', 'micro_mg_cam_register', qme_idx) - call pbuf_register_subcol('PRAIN', 'micro_mg_cam_register', prain_idx) - call pbuf_register_subcol('NEVAPR', 'micro_mg_cam_register', nevapr_idx) - call pbuf_register_subcol('PRER_EVAP', 'micro_mg_cam_register', prer_evap_idx) - call pbuf_register_subcol('BERGSO', 'micro_mg_cam_register', bergso_idx) - - call pbuf_register_subcol('WSEDL', 'micro_mg_cam_register', wsedl_idx) - - call pbuf_register_subcol('REI', 'micro_mg_cam_register', rei_idx) - call pbuf_register_subcol('SADICE', 'micro_mg_cam_register', sadice_idx) - call pbuf_register_subcol('SADSNOW', 'micro_mg_cam_register', sadsnow_idx) - call pbuf_register_subcol('REL', 'micro_mg_cam_register', rel_idx) - - ! Mitchell ice effective diameter for radiation - call pbuf_register_subcol('DEI', 'micro_mg_cam_register', dei_idx) - ! Size distribution shape parameter for radiation - call pbuf_register_subcol('MU', 'micro_mg_cam_register', mu_idx) - ! Size distribution shape parameter for radiation - call pbuf_register_subcol('LAMBDAC', 'micro_mg_cam_register', lambdac_idx) - - ! Stratiform only in cloud ice water path for radiation - call pbuf_register_subcol('ICIWPST', 'micro_mg_cam_register', iciwpst_idx) - ! Stratiform in cloud liquid water path for radiation - call pbuf_register_subcol('ICLWPST', 'micro_mg_cam_register', iclwpst_idx) - - ! Snow effective diameter for radiation - call pbuf_register_subcol('DES', 'micro_mg_cam_register', des_idx) - ! In cloud snow water path for radiation - call pbuf_register_subcol('ICSWP', 'micro_mg_cam_register', icswp_idx) - ! Cloud fraction for liquid drops + snow - call pbuf_register_subcol('CLDFSNOW ', 'micro_mg_cam_register', cldfsnow_idx) - - if (micro_mg_version > 2) then - ! Graupel effective diameter for radiation - call pbuf_register_subcol('DEGRAU', 'micro_mg_cam_register', degrau_idx) - ! In cloud snow water path for radiation - call pbuf_register_subcol('ICGRAUWP', 'micro_mg_cam_register', icgrauwp_idx) - ! Cloud fraction for liquid drops + snow - call pbuf_register_subcol('CLDFGRAU', 'micro_mg_cam_register', cldfgrau_idx) - end if - - if (prog_modal_aero) then - call pbuf_register_subcol('RATE1_CW2PR_ST', 'micro_mg_cam_register', rate1_cw2pr_st_idx) - end if - - call pbuf_register_subcol('LS_FLXPRC', 'micro_mg_cam_register', ls_flxprc_idx) - call pbuf_register_subcol('LS_FLXSNW', 'micro_mg_cam_register', ls_flxsnw_idx) - - ! Fields needed as inputs to COSP - call pbuf_register_subcol('LS_MRPRC', 'micro_mg_cam_register', ls_mrprc_idx) - call pbuf_register_subcol('LS_MRSNW', 'micro_mg_cam_register', ls_mrsnw_idx) - call pbuf_register_subcol('LS_REFFRAIN', 'micro_mg_cam_register', ls_reffrain_idx) - call pbuf_register_subcol('LS_REFFSNOW', 'micro_mg_cam_register', ls_reffsnow_idx) - call pbuf_register_subcol('CV_REFFLIQ', 'micro_mg_cam_register', cv_reffliq_idx) - call pbuf_register_subcol('CV_REFFICE', 'micro_mg_cam_register', cv_reffice_idx) - end if - - ! Additional pbuf for CARMA interface - if (.not. do_cldice) then - call pbuf_add_field('TND_QSNOW', 'physpkg',dtype_r8,(/pcols,pver/), tnd_qsnow_idx) - call pbuf_add_field('TND_NSNOW', 'physpkg',dtype_r8,(/pcols,pver/), tnd_nsnow_idx) - call pbuf_add_field('RE_ICE', 'physpkg',dtype_r8,(/pcols,pver/), re_ice_idx) - end if - - ! Precipitation efficiency fields across timesteps. - call pbuf_add_field('ACPRECL', 'global',dtype_r8,(/pcols/), acpr_idx) ! accumulated precip - call pbuf_add_field('ACGCME', 'global',dtype_r8,(/pcols/), acgcme_idx) ! accumulated condensation - call pbuf_add_field('ACNUM', 'global',dtype_i4,(/pcols/), acnum_idx) ! counter for accumulated # timesteps - - ! SGS variability -- These could be reset by CLUBB so they need to be grid only - call pbuf_add_field('RELVAR', 'global',dtype_r8,(/pcols,pver/), relvar_idx) - call pbuf_add_field('ACCRE_ENHAN','global',dtype_r8,(/pcols,pver/), accre_enhan_idx) - - ! Diagnostic fields needed for subcol_SILHS, need to be grid-only - if (subcol_get_scheme() == 'SILHS') then - call pbuf_add_field('QRAIN', 'global',dtype_r8,(/pcols,pver/), qrain_idx) - call pbuf_add_field('QSNOW', 'global',dtype_r8,(/pcols,pver/), qsnow_idx) - call pbuf_add_field('NRAIN', 'global',dtype_r8,(/pcols,pver/), nrain_idx) - call pbuf_add_field('NSNOW', 'global',dtype_r8,(/pcols,pver/), nsnow_idx) - ! Fields for subcol_SILHS hole filling - call pbuf_add_field('QCSEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qcsedten_idx) - if (micro_mg_version > 1) then - call pbuf_add_field('QRSEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qrsedten_idx) - endif - call pbuf_add_field('QISEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qisedten_idx) - if (micro_mg_version > 1) then - call pbuf_add_field('QSSEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qssedten_idx) - endif - call pbuf_add_field('VTRMC', 'physpkg', dtype_r8, (/pcols,pver/), vtrmc_idx) - if (micro_mg_version > 1) then - call pbuf_add_field('UMR', 'physpkg', dtype_r8, (/pcols,pver/), umr_idx) - endif - call pbuf_add_field('VTRMI', 'physpkg', dtype_r8, (/pcols,pver/), vtrmi_idx) - if (micro_mg_version > 1) then - call pbuf_add_field('UMS', 'physpkg', dtype_r8, (/pcols,pver/), ums_idx) - endif - call pbuf_add_field('QCSEVAP', 'physpkg', dtype_r8, (/pcols,pver/), qcsevap_idx) - call pbuf_add_field('QISEVAP', 'physpkg', dtype_r8, (/pcols,pver/), qisevap_idx) - end if - -end subroutine micro_mg_cam_register - -!=============================================================================== - -function micro_mg_cam_implements_cnst(name) - - ! Return true if specified constituent is implemented by the - ! microphysics package - - character(len=*), intent(in) :: name ! constituent name - logical :: micro_mg_cam_implements_cnst ! return value - - !----------------------------------------------------------------------- - - micro_mg_cam_implements_cnst = any(name == cnst_names) - -end function micro_mg_cam_implements_cnst - -!=============================================================================== - -subroutine micro_mg_cam_init_cnst(name, latvals, lonvals, mask, q) - - ! Initialize the microphysics constituents, if they are - ! not read from the initial file. - - character(len=*), intent(in) :: name ! constituent name - real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) - real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) - logical, intent(in) :: mask(:) ! Only initialize where .true. - real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev - !----------------------------------------------------------------------- - integer :: k - - if (micro_mg_cam_implements_cnst(name)) then - do k = 1, size(q, 2) - where(mask) - q(:, k) = 0.0_r8 - end where - end do - end if - -end subroutine micro_mg_cam_init_cnst - -!=============================================================================== - -subroutine micro_mg_cam_init(pbuf2d) - use time_manager, only: is_first_step - use micro_mg_utils, only: micro_mg_utils_init - use micro_mg1_0, only: micro_mg_init1_0 => micro_mg_init - use micro_mg3_0, only: micro_mg_init3_0 => micro_mg_init - - !----------------------------------------------------------------------- - ! - ! Initialization for MG microphysics - ! - !----------------------------------------------------------------------- - - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - - integer :: m, mm - logical :: history_amwg ! output the variables used by the AMWG diag package - logical :: history_budget ! Output tendencies and state variables for CAM4 - ! temperature, water vapor, cloud ice and cloud - ! liquid budgets. - logical :: use_subcol_microp - logical :: do_clubb_sgs - integer :: budget_histfile ! output history file number for budget fields - integer :: ierr - character(128) :: errstring ! return status (non-blank for error return) - - !----------------------------------------------------------------------- - - call phys_getopts(use_subcol_microp_out=use_subcol_microp, & - do_clubb_sgs_out =do_clubb_sgs) - - if (do_clubb_sgs) then - allow_sed_supersat = .false. - else - allow_sed_supersat = .true. - endif - - if (masterproc) then - write(iulog,"(A,I2,A,I2)") "Initializing MG version ",micro_mg_version,".",micro_mg_sub_version - if (.not. do_cldliq) & - write(iulog,*) "MG prognostic cloud liquid has been turned off via namelist." - if (.not. do_cldice) & - write(iulog,*) "MG prognostic cloud ice has been turned off via namelist." - write(iulog,*) "Number of microphysics substeps is: ",num_steps - end if - - select case (micro_mg_version) - case (1) - ! Set constituent number for later loops. - ncnst = 4 - - select case (micro_mg_sub_version) - case (0) - ! MG 1 does not initialize micro_mg_utils, so have to do it here. - call micro_mg_utils_init(r8, rair, rh2o, cpair, tmelt, latvap, latice, & - micro_mg_dcs, errstring) - - call handle_errmsg(errstring, subname="micro_mg_utils_init") - - call micro_mg_init1_0( & - r8, gravit, rair, rh2o, cpair, & - rhoh2o, tmelt, latvap, latice, & - rhmini, micro_mg_dcs, use_hetfrz_classnuc, & - micro_mg_precip_frac_method, micro_mg_berg_eff_factor, & - micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, & - micro_mg_ninst, errstring) - end select - case (2:3) - ! Set constituent number for later loops. - if(micro_mg_version == 2) then - ncnst = 8 - else - ncnst = 10 - end if - - call micro_mg_init3_0( & - r8, gravit, rair, rh2o, cpair, & - tmelt, latvap, latice, rhmini, & - micro_mg_dcs, & - micro_mg_do_hail,micro_mg_do_graupel, & - microp_uniform, do_cldice, use_hetfrz_classnuc, & - micro_mg_precip_frac_method, micro_mg_berg_eff_factor, & - allow_sed_supersat, micro_do_sb_physics, & - micro_mg_evap_sed_off, micro_mg_icenuc_rh_off, micro_mg_icenuc_use_meyers, & - micro_mg_evap_scl_ifs, micro_mg_evap_rhthrsh_ifs, & - micro_mg_rainfreeze_ifs, micro_mg_ifs_sed, micro_mg_precip_fall_corr,& - micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, & - micro_mg_ninst, micro_mg_ngcons, micro_mg_ngnst, & - micro_mg_nrcons, micro_mg_nrnst, micro_mg_nscons, micro_mg_nsnst, errstring) - end select - - call handle_errmsg(errstring, subname="micro_mg_init") - - ! Register history variables - do m = 1, ncnst - call cnst_get_ind(cnst_names(m), mm) - if ( any(mm == (/ ixcldliq, ixcldice, ixrain, ixsnow, ixgraupel /)) ) then - ! mass mixing ratios - call addfld(cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(mm) ) - call addfld(sflxnam(mm), horiz_only, 'A', 'kg/m2/s', trim(cnst_name(mm))//' surface flux') - else if ( any(mm == (/ ixnumliq, ixnumice, ixnumrain, ixnumsnow, ixnumgraupel /)) ) then - ! number concentrations - call addfld(cnst_name(mm), (/ 'lev' /), 'A', '1/kg', cnst_longname(mm) ) - call addfld(sflxnam(mm), horiz_only, 'A', '1/m2/s', trim(cnst_name(mm))//' surface flux') - else - call endrun( "micro_mg_cam_init: & - &Could not call addfld for constituent with unknown units.") - endif - end do - - call addfld(apcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' after physics' ) - call addfld(apcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' after physics' ) - call addfld(bpcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' before physics' ) - call addfld(bpcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' before physics' ) - - if (micro_mg_version > 1) then - call addfld(apcnst(ixrain), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixrain))//' after physics' ) - call addfld(apcnst(ixsnow), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' after physics' ) - call addfld(bpcnst(ixrain), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixrain))//' before physics' ) - call addfld(bpcnst(ixsnow), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' before physics' ) - end if - - if (micro_mg_version > 2) then - call addfld(apcnst(ixgraupel), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixgraupel))//' after physics' ) - call addfld(bpcnst(ixgraupel), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixgraupel))//' before physics' ) - end if - - call addfld ('CME', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap within the cloud' ) - call addfld ('PRODPREC', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of conversion of condensate to precip' ) - call addfld ('EVAPPREC', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling precip' ) - call addfld ('EVAPSNOW', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling snow' ) - call addfld ('HPROGCLD', (/ 'lev' /), 'A', 'W/kg' , 'Heating from prognostic clouds' ) - call addfld ('FICE', (/ 'lev' /), 'A', 'fraction', 'Fractional ice content within cloud' ) - call addfld ('CLDFSNOW', (/ 'lev' /), 'A', '1', 'Cloud fraction adjusted for snow' ) - call addfld ('ICWMRST', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-stratus water mixing ratio' ) - call addfld ('ICIMRST', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-stratus ice mixing ratio' ) - - ! MG microphysics diagnostics - call addfld ('QCSEVAP', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling cloud water' ) - call addfld ('QISEVAP', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of sublimation of falling cloud ice' ) - call addfld ('QVRES', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of residual condensation term' ) - call addfld ('CMEIOUT', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of deposition/sublimation of cloud ice' ) - call addfld ('VTRMC', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted cloud water fallspeed' ) - call addfld ('VTRMI', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted cloud ice fallspeed' ) - call addfld ('QCSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud water mixing ratio tendency from sedimentation' ) - call addfld ('QISEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice mixing ratio tendency from sedimentation' ) - call addfld ('PRAO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud water by rain' ) - call addfld ('PRCO', (/ 'lev' /), 'A', 'kg/kg/s', 'Autoconversion of cloud water' ) - call addfld ('MNUCCCO', (/ 'lev' /), 'A', 'kg/kg/s', 'Immersion freezing of cloud water' ) - call addfld ('MNUCCTO', (/ 'lev' /), 'A', 'kg/kg/s', 'Contact freezing of cloud water' ) - call addfld ('MNUCCDO', (/ 'lev' /), 'A', 'kg/kg/s', 'Homogeneous and heterogeneous nucleation from vapor' ) - call addfld ('MNUCCDOhet', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous nucleation from vapor' ) - call addfld ('MSACWIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water from rime-splintering' ) - call addfld ('PSACWSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud water by snow' ) - call addfld ('BERGSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water to snow from bergeron' ) - call addfld ('BERGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water to cloud ice from bergeron' ) - call addfld ('MELTO', (/ 'lev' /), 'A', 'kg/kg/s', 'Melting of cloud ice' ) - call addfld ('MELTSTOT', (/ 'lev' /), 'A', 'kg/kg/s', 'Melting of snow' ) - call addfld ('MNUDEPO', (/ 'lev' /), 'A', 'kg/kg/s', 'Deposition Nucleation' ) - call addfld ('HOMOO', (/ 'lev' /), 'A', 'kg/kg/s', 'Homogeneous freezing of cloud water' ) - call addfld ('QCRESO', (/ 'lev' /), 'A', 'kg/kg/s', 'Residual condensation term for cloud water' ) - call addfld ('PRCIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Autoconversion of cloud ice to snow' ) - call addfld ('PRAIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud ice to snow' ) - call addfld ('QIRESO', (/ 'lev' /), 'A', 'kg/kg/s', 'Residual deposition term for cloud ice' ) - call addfld ('MNUCCRO', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous freezing of rain to snow' ) - call addfld ('MNUCCRIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous freezing of rain to ice' ) - call addfld ('PRACSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of rain by snow' ) - call addfld ('MELTSDT', (/ 'lev' /), 'A', 'W/kg', 'Latent heating rate due to melting of snow' ) - call addfld ('FRZRDT', (/ 'lev' /), 'A', 'W/kg', 'Latent heating rate due to homogeneous freezing of rain' ) - if (micro_mg_version > 1) then - call addfld ('QRSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Rain mixing ratio tendency from sedimentation' ) - call addfld ('QSSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Snow mixing ratio tendency from sedimentation' ) - end if - - - if (micro_mg_version > 2) then - - call addfld ('PSACRO', (/ 'lev' /), 'A', 'kg/kg/s', 'Collisions between rain & snow (Graupel collecting snow)') - call addfld ('PRACGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change in q collection rain by graupel' ) - call addfld ('PSACWGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change in q collection droplets by graupel' ) - call addfld ('PGSACWO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q conversion to graupel due to collection droplets by snow') - call addfld ('PGRACSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q conversion to graupel due to collection rain by snow') - call addfld ('PRDGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Deposition of graupel') - call addfld ('QMULTGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q change due to ice mult droplets/graupel') - call addfld ('QMULTRGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q change due to ice mult rain/graupel') - call addfld ('QGSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Graupel/Hail mixing ratio tendency from sedimentation') - call addfld ('NPRACGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change N collection rain by graupel') - call addfld ('NSCNGO', (/'lev'/),'A','kg/kg/s','Change N conversion to graupel due to collection droplets by snow') - call addfld ('NGRACSO',(/'lev'/),'A','kg/kg/s','Change N conversion to graupel due to collection rain by snow') - call addfld ('NMULTGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice mult due to acc droplets by graupel ') - call addfld ('NMULTRGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice mult due to acc rain by graupel') - call addfld ('NPSACWGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change N collection droplets by graupel') - call addfld ('CLDFGRAU', (/ 'lev' /), 'A', '1', 'Cloud fraction adjusted for graupel' ) - call addfld ('MELTGTOT', (/ 'lev' /), 'A', 'kg/kg/s', 'Melting of graupel' ) - - end if - - ! History variables for CAM5 microphysics - call addfld ('MPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Morrison microphysics' ) - call addfld ('MPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Morrison microphysics' ) - call addfld ('MPDLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ tendency - Morrison microphysics' ) - call addfld ('MPDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency - Morrison microphysics' ) - call addfld ('MPDNLIQ', (/ 'lev' /), 'A', '1/kg/s', 'NUMLIQ tendency - Morrison microphysics' ) - call addfld ('MPDNICE', (/ 'lev' /), 'A', '1/kg/s', 'NUMICE tendency - Morrison microphysics' ) - call addfld ('MPDW2V', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Vapor tendency - Morrison microphysics' ) - call addfld ('MPDW2I', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Ice tendency - Morrison microphysics' ) - call addfld ('MPDW2P', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Precip tendency - Morrison microphysics' ) - call addfld ('MPDI2V', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Vapor tendency - Morrison microphysics' ) - call addfld ('MPDI2W', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Water tendency - Morrison microphysics' ) - call addfld ('MPDI2P', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Precip tendency - Morrison microphysics' ) - call addfld ('ICWNC', (/ 'lev' /), 'A', 'm-3', 'Prognostic in-cloud water number conc' ) - call addfld ('ICINC', (/ 'lev' /), 'A', 'm-3', 'Prognostic in-cloud ice number conc' ) - call addfld ('EFFLIQ_IND', (/ 'lev' /), 'A','Micron', 'Prognostic droplet effective radius (indirect effect)' ) - call addfld ('CDNUMC', horiz_only, 'A', '1/m2', 'Vertically-integrated droplet concentration' ) - call addfld ('MPICLWPI', horiz_only, 'A', 'kg/m2', 'Vertically-integrated & - &in-cloud Initial Liquid WP (Before Micro)' ) - call addfld ('MPICIWPI', horiz_only, 'A', 'kg/m2', 'Vertically-integrated & - &in-cloud Initial Ice WP (Before Micro)' ) - - ! This is provided as an example on how to write out subcolumn output - ! NOTE -- only 'I' should be used for sub-column fields as subc-columns could shift from time-step to time-step - if (use_subcol_microp) then - call addfld('FICE_SCOL', (/'psubcols','lev '/), 'I', 'fraction', & - 'Sub-column fractional ice content within cloud', flag_xyfill=.true., fill_value=1.e30_r8) - call addfld('MPDICE_SCOL', (/'psubcols','lev '/), 'I', 'kg/kg/s', & - 'Sub-column CLDICE tendency - Morrison microphysics', flag_xyfill=.true., fill_value=1.e30_r8) - call addfld('MPDLIQ_SCOL', (/'psubcols','lev '/), 'I', 'kg/kg/s', & - 'Sub-column CLDLIQ tendency - Morrison microphysics', flag_xyfill=.true., fill_value=1.e30_r8) - end if - - - ! This is only if the coldpoint temperatures are being adjusted. - ! NOTE: Some fields related to these and output later are added in tropopause.F90. - if (micro_mg_adjust_cpt) then - call addfld ('TROPF_TADJ', (/ 'lev' /), 'A', 'K', 'Temperatures after cold point adjustment' ) - call addfld ('TROPF_RHADJ', (/ 'lev' /), 'A', 'K', 'Relative Hunidity after cold point adjustment' ) - call addfld ('TROPF_CDT', horiz_only, 'A', 'K', 'Cold point temperature adjustment' ) - call addfld ('TROPF_CDZ', horiz_only, 'A', 'm', 'Distance of coldpoint from coldest model level' ) - end if - - - ! Averaging for cloud particle number and size - call addfld ('AWNC', (/ 'lev' /), 'A', 'm-3', 'Average cloud water number conc' ) - call addfld ('AWNI', (/ 'lev' /), 'A', 'm-3', 'Average cloud ice number conc' ) - call addfld ('AREL', (/ 'lev' /), 'A', 'Micron', 'Average droplet effective radius' ) - call addfld ('AREI', (/ 'lev' /), 'A', 'Micron', 'Average ice effective radius' ) - ! Frequency arrays for above - call addfld ('FREQL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of liquid' ) - call addfld ('FREQI', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of ice' ) - - ! Average cloud top particle size and number (liq, ice) and frequency - call addfld ('ACTREL', horiz_only, 'A', 'Micron', 'Average Cloud Top droplet effective radius' ) - call addfld ('ACTREI', horiz_only, 'A', 'Micron', 'Average Cloud Top ice effective radius' ) - call addfld ('ACTNL', horiz_only, 'A', 'm-3', 'Average Cloud Top droplet number' ) - call addfld ('ACTNI', horiz_only, 'A', 'm-3', 'Average Cloud Top ice number' ) - - call addfld ('FCTL', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top liquid' ) - call addfld ('FCTI', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top ice' ) - - ! New frequency arrays for mixed phase and supercooled liquid (only and mixed) for (a) Cloud Top and (b) everywhere.. - call addfld ('FREQM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of mixed phase' ) - call addfld ('FREQSL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of only supercooled liquid' ) - call addfld ('FREQSLM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of super cooled liquid with ice' ) - call addfld ('FCTM', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top mixed phase' ) - call addfld ('FCTSL', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top only supercooled liquid' ) - call addfld ('FCTSLM', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top super cooled liquid with ice' ) - - call addfld ('LS_FLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface rain+snow flux' ) - call addfld ('LS_FLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface snow flux' ) - - call addfld ('REL', (/ 'lev' /), 'A', 'micron', 'MG REL stratiform cloud effective radius liquid' ) - call addfld ('REI', (/ 'lev' /), 'A', 'micron', 'MG REI stratiform cloud effective radius ice' ) - call addfld ('LS_REFFRAIN', (/ 'lev' /), 'A', 'micron', 'ls stratiform rain effective radius' ) - call addfld ('LS_REFFSNOW', (/ 'lev' /), 'A', 'micron', 'ls stratiform snow effective radius' ) - call addfld ('CV_REFFLIQ', (/ 'lev' /), 'A', 'micron', 'convective cloud liq effective radius' ) - call addfld ('CV_REFFICE', (/ 'lev' /), 'A', 'micron', 'convective cloud ice effective radius' ) - call addfld ('MG_SADICE', (/ 'lev' /), 'A', 'cm2/cm3', 'MG surface area density ice' ) - call addfld ('MG_SADSNOW', (/ 'lev' /), 'A', 'cm2/cm3', 'MG surface area density snow' ) - - ! diagnostic precip - call addfld ('QRAIN', (/ 'lev' /), 'A', 'kg/kg', 'Diagnostic grid-mean rain mixing ratio' ) - call addfld ('QSNOW', (/ 'lev' /), 'A', 'kg/kg', 'Diagnostic grid-mean snow mixing ratio' ) - call addfld ('NRAIN', (/ 'lev' /), 'A', 'm-3', 'Diagnostic grid-mean rain number conc' ) - call addfld ('NSNOW', (/ 'lev' /), 'A', 'm-3', 'Diagnostic grid-mean snow number conc' ) - - ! size of precip - call addfld ('RERCLD', (/ 'lev' /), 'A', 'm', 'Diagnostic effective radius of Liquid Cloud and Rain' ) - call addfld ('DSNOW', (/ 'lev' /), 'A', 'm', 'Diagnostic grid-mean snow diameter' ) - - ! diagnostic radar reflectivity, cloud-averaged - call addfld ('REFL', (/ 'lev' /), 'A', 'DBz', '94 GHz radar reflectivity' ) - call addfld ('AREFL', (/ 'lev' /), 'A', 'DBz', 'Average 94 GHz radar reflectivity' ) - call addfld ('FREFL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of radar reflectivity' ) - - call addfld ('CSRFL', (/ 'lev' /), 'A', 'DBz', '94 GHz radar reflectivity (CloudSat thresholds)' ) - call addfld ('ACSRFL', (/ 'lev' /), 'A', 'DBz', 'Average 94 GHz radar reflectivity (CloudSat thresholds)' ) - call addfld ('FCSRFL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of radar reflectivity (CloudSat thresholds)' ) - - call addfld ('AREFLZ', (/ 'lev' /), 'A', 'mm^6/m^3', 'Average 94 GHz radar reflectivity' ) - - ! Aerosol information - call addfld ('NCAL', (/ 'lev' /), 'A', '1/m3', 'Number Concentation Activated for Liquid' ) - call addfld ('NCAI', (/ 'lev' /), 'A', '1/m3', 'Number Concentation Activated for Ice' ) - - ! Average rain and snow mixing ratio (Q), number (N) and diameter (D), with frequency - call addfld ('AQRAIN', (/ 'lev' /), 'A', 'kg/kg', 'Average rain mixing ratio' ) - call addfld ('AQSNOW', (/ 'lev' /), 'A', 'kg/kg', 'Average snow mixing ratio' ) - call addfld ('ANRAIN', (/ 'lev' /), 'A', 'm-3', 'Average rain number conc' ) - call addfld ('ANSNOW', (/ 'lev' /), 'A', 'm-3', 'Average snow number conc' ) - call addfld ('ADRAIN', (/ 'lev' /), 'A', 'm', 'Average rain effective Diameter' ) - call addfld ('ADSNOW', (/ 'lev' /), 'A', 'm', 'Average snow effective Diameter' ) - call addfld ('FREQR', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of rain' ) - call addfld ('FREQS', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of snow' ) - - ! precipitation efficiency & other diagnostic fields - call addfld('PE' , horiz_only, 'A', '1', 'Stratiform Precipitation Efficiency (precip/cmeliq)' ) - call addfld('APRL' , horiz_only, 'A', 'm/s', 'Average Stratiform Precip Rate over efficiency calculation' ) - call addfld('PEFRAC', horiz_only, 'A', '1', 'Fraction of timesteps precip efficiency reported' ) - call addfld('VPRCO' , horiz_only, 'A', 'kg/kg/s', 'Vertical average of autoconversion rate' ) - call addfld('VPRAO' , horiz_only, 'A', 'kg/kg/s', 'Vertical average of accretion rate' ) - call addfld('RACAU' , horiz_only, 'A', 'kg/kg/s', 'Accretion/autoconversion ratio from vertical average' ) - - if (micro_mg_version > 1) then - call addfld('UMR', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted rain fallspeed' ) - call addfld('UMS', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted snow fallspeed' ) - end if - - if (micro_mg_version > 2) then - call addfld('UMG', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted graupel/hail fallspeed' ) - call addfld ('FREQG', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of Graupel' ) - call addfld ('LS_REFFGRAU', (/ 'lev' /), 'A', 'micron', 'ls stratiform graupel/hail effective radius' ) - call addfld ('AQGRAU', (/ 'lev' /), 'A', 'kg/kg', 'Average graupel/hail mixing ratio' ) - call addfld ('ANGRAU', (/ 'lev' /), 'A', 'm-3', 'Average graupel/hail number conc' ) - end if - - - ! qc limiter (only output in versions 1.5 and later) - if (.not. (micro_mg_version == 1 .and. micro_mg_sub_version == 0)) then - call addfld('QCRAT', (/ 'lev' /), 'A', 'fraction', 'Qc Limiter: Fraction of qc tendency applied') - end if - - ! determine the add_default fields - call phys_getopts(history_amwg_out = history_amwg , & - history_budget_out = history_budget , & - history_budget_histfile_num_out = budget_histfile) - - if (history_amwg) then - call add_default ('FICE ', 1, ' ') - call add_default ('AQRAIN ', 1, ' ') - call add_default ('AQSNOW ', 1, ' ') - call add_default ('ANRAIN ', 1, ' ') - call add_default ('ANSNOW ', 1, ' ') - call add_default ('ADRAIN ', 1, ' ') - call add_default ('ADSNOW ', 1, ' ') - call add_default ('AREI ', 1, ' ') - call add_default ('AREL ', 1, ' ') - call add_default ('AWNC ', 1, ' ') - call add_default ('AWNI ', 1, ' ') - call add_default ('CDNUMC ', 1, ' ') - call add_default ('FREQR ', 1, ' ') - call add_default ('FREQS ', 1, ' ') - call add_default ('FREQL ', 1, ' ') - call add_default ('FREQI ', 1, ' ') - do m = 1, ncnst - call cnst_get_ind(cnst_names(m), mm) - call add_default(cnst_name(mm), 1, ' ') - end do - end if - - if ( history_budget ) then - call add_default ('EVAPSNOW ', budget_histfile, ' ') - call add_default ('EVAPPREC ', budget_histfile, ' ') - call add_default ('QVRES ', budget_histfile, ' ') - call add_default ('QISEVAP ', budget_histfile, ' ') - call add_default ('QCSEVAP ', budget_histfile, ' ') - call add_default ('QISEDTEN ', budget_histfile, ' ') - call add_default ('QCSEDTEN ', budget_histfile, ' ') - call add_default ('QIRESO ', budget_histfile, ' ') - call add_default ('QCRESO ', budget_histfile, ' ') - if (micro_mg_version > 1) then - call add_default ('QRSEDTEN ', budget_histfile, ' ') - call add_default ('QSSEDTEN ', budget_histfile, ' ') - end if - call add_default ('PSACWSO ', budget_histfile, ' ') - call add_default ('PRCO ', budget_histfile, ' ') - call add_default ('PRCIO ', budget_histfile, ' ') - call add_default ('PRAO ', budget_histfile, ' ') - call add_default ('PRAIO ', budget_histfile, ' ') - call add_default ('PRACSO ', budget_histfile, ' ') - call add_default ('MSACWIO ', budget_histfile, ' ') - call add_default ('MPDW2V ', budget_histfile, ' ') - call add_default ('MPDW2P ', budget_histfile, ' ') - call add_default ('MPDW2I ', budget_histfile, ' ') - call add_default ('MPDT ', budget_histfile, ' ') - call add_default ('MPDQ ', budget_histfile, ' ') - call add_default ('MPDLIQ ', budget_histfile, ' ') - call add_default ('MPDICE ', budget_histfile, ' ') - call add_default ('MPDI2W ', budget_histfile, ' ') - call add_default ('MPDI2V ', budget_histfile, ' ') - call add_default ('MPDI2P ', budget_histfile, ' ') - call add_default ('MNUCCTO ', budget_histfile, ' ') - call add_default ('MNUCCRO ', budget_histfile, ' ') - call add_default ('MNUCCRIO ', budget_histfile, ' ') - call add_default ('MNUCCCO ', budget_histfile, ' ') - call add_default ('MELTSDT ', budget_histfile, ' ') - call add_default ('MELTO ', budget_histfile, ' ') - call add_default ('HOMOO ', budget_histfile, ' ') - call add_default ('FRZRDT ', budget_histfile, ' ') - call add_default ('CMEIOUT ', budget_histfile, ' ') - call add_default ('BERGSO ', budget_histfile, ' ') - call add_default ('BERGO ', budget_histfile, ' ') - call add_default ('MELTSTOT ', budget_histfile, ' ') - call add_default ('MNUDEPO ', budget_histfile, ' ') - if (micro_mg_version > 2) then - call add_default ('QGSEDTEN ', budget_histfile, ' ') - call add_default ('PSACRO ', budget_histfile, ' ') - call add_default ('PRACGO ', budget_histfile, ' ') - call add_default ('PSACWGO ', budget_histfile, ' ') - call add_default ('PGSACWO ', budget_histfile, ' ') - call add_default ('PGRACSO ', budget_histfile, ' ') - call add_default ('PRDGO ', budget_histfile, ' ') - call add_default ('QMULTGO ', budget_histfile, ' ') - call add_default ('QMULTRGO ', budget_histfile, ' ') - call add_default ('MELTGTOT ', budget_histfile, ' ') - end if - call add_default(cnst_name(ixcldliq), budget_histfile, ' ') - call add_default(cnst_name(ixcldice), budget_histfile, ' ') - call add_default(apcnst (ixcldliq), budget_histfile, ' ') - call add_default(apcnst (ixcldice), budget_histfile, ' ') - call add_default(bpcnst (ixcldliq), budget_histfile, ' ') - call add_default(bpcnst (ixcldice), budget_histfile, ' ') - if (micro_mg_version > 1) then - call add_default(cnst_name(ixrain), budget_histfile, ' ') - call add_default(cnst_name(ixsnow), budget_histfile, ' ') - call add_default(apcnst (ixrain), budget_histfile, ' ') - call add_default(apcnst (ixsnow), budget_histfile, ' ') - call add_default(bpcnst (ixrain), budget_histfile, ' ') - call add_default(bpcnst (ixsnow), budget_histfile, ' ') - end if - - if (micro_mg_version > 2) then - call add_default(cnst_name(ixgraupel), budget_histfile, ' ') - call add_default(apcnst (ixgraupel), budget_histfile, ' ') - call add_default(bpcnst (ixgraupel), budget_histfile, ' ') - end if - - end if - - ! physics buffer indices - ast_idx = pbuf_get_index('AST') - cld_idx = pbuf_get_index('CLD') - concld_idx = pbuf_get_index('CONCLD') - - naai_idx = pbuf_get_index('NAAI') - naai_hom_idx = pbuf_get_index('NAAI_HOM') - npccn_idx = pbuf_get_index('NPCCN') - rndst_idx = pbuf_get_index('RNDST') - nacon_idx = pbuf_get_index('NACON') - - prec_str_idx = pbuf_get_index('PREC_STR') - snow_str_idx = pbuf_get_index('SNOW_STR') - prec_sed_idx = pbuf_get_index('PREC_SED') - snow_sed_idx = pbuf_get_index('SNOW_SED') - prec_pcw_idx = pbuf_get_index('PREC_PCW') - snow_pcw_idx = pbuf_get_index('SNOW_PCW') - - cmeliq_idx = pbuf_get_index('CMELIQ') - - ! These fields may have been added, so don't abort if they have not been - qsatfac_idx = pbuf_get_index('QSATFAC', ierr) - qrain_idx = pbuf_get_index('QRAIN', ierr) - qsnow_idx = pbuf_get_index('QSNOW', ierr) - nrain_idx = pbuf_get_index('NRAIN', ierr) - nsnow_idx = pbuf_get_index('NSNOW', ierr) - - ! fields for heterogeneous freezing - frzimm_idx = pbuf_get_index('FRZIMM', ierr) - frzcnt_idx = pbuf_get_index('FRZCNT', ierr) - frzdep_idx = pbuf_get_index('FRZDEP', ierr) - - ! Initialize physics buffer grid fields for accumulating precip and condensation - if (is_first_step()) then - call pbuf_set_field(pbuf2d, cldo_idx, 0._r8) - call pbuf_set_field(pbuf2d, cc_t_idx, 0._r8) - call pbuf_set_field(pbuf2d, cc_qv_idx, 0._r8) - call pbuf_set_field(pbuf2d, cc_ql_idx, 0._r8) - call pbuf_set_field(pbuf2d, cc_qi_idx, 0._r8) - call pbuf_set_field(pbuf2d, cc_nl_idx, 0._r8) - call pbuf_set_field(pbuf2d, cc_ni_idx, 0._r8) - call pbuf_set_field(pbuf2d, cc_qlst_idx,0._r8) - call pbuf_set_field(pbuf2d, acpr_idx, 0._r8) - call pbuf_set_field(pbuf2d, acgcme_idx, 0._r8) - call pbuf_set_field(pbuf2d, acnum_idx, 0) - call pbuf_set_field(pbuf2d, relvar_idx, 2._r8) - call pbuf_set_field(pbuf2d, accre_enhan_idx, 1._r8) - call pbuf_set_field(pbuf2d, am_evp_st_idx, 0._r8) - call pbuf_set_field(pbuf2d, evprain_st_idx, 0._r8) - call pbuf_set_field(pbuf2d, evpsnow_st_idx, 0._r8) - call pbuf_set_field(pbuf2d, prer_evap_idx, 0._r8) - call pbuf_set_field(pbuf2d, bergso_idx, 0._r8) - - if (qrain_idx > 0) call pbuf_set_field(pbuf2d, qrain_idx, 0._r8) - if (qsnow_idx > 0) call pbuf_set_field(pbuf2d, qsnow_idx, 0._r8) - if (nrain_idx > 0) call pbuf_set_field(pbuf2d, nrain_idx, 0._r8) - if (nsnow_idx > 0) call pbuf_set_field(pbuf2d, nsnow_idx, 0._r8) - if (qcsedten_idx > 0) call pbuf_set_field(pbuf2d, qcsedten_idx, 0._r8) - if (qrsedten_idx > 0) call pbuf_set_field(pbuf2d, qrsedten_idx, 0._r8) - if (qisedten_idx > 0) call pbuf_set_field(pbuf2d, qisedten_idx, 0._r8) - if (qssedten_idx > 0) call pbuf_set_field(pbuf2d, qssedten_idx, 0._r8) - if (vtrmc_idx > 0) call pbuf_set_field(pbuf2d, vtrmc_idx, 0._r8) - if (umr_idx > 0) call pbuf_set_field(pbuf2d, umr_idx, 0._r8) - if (vtrmi_idx > 0) call pbuf_set_field(pbuf2d, vtrmi_idx, 0._r8) - if (ums_idx > 0) call pbuf_set_field(pbuf2d, ums_idx, 0._r8) - if (qcsevap_idx > 0) call pbuf_set_field(pbuf2d, qcsevap_idx, 0._r8) - if (qisevap_idx > 0) call pbuf_set_field(pbuf2d, qisevap_idx, 0._r8) - - ! If sub-columns turned on, need to set the sub-column fields as well - if (use_subcol_microp) then - call pbuf_set_field(pbuf2d, cldo_idx, 0._r8, col_type=col_type_subcol) - call pbuf_set_field(pbuf2d, cc_t_idx, 0._r8, col_type=col_type_subcol) - call pbuf_set_field(pbuf2d, cc_qv_idx, 0._r8, col_type=col_type_subcol) - call pbuf_set_field(pbuf2d, cc_ql_idx, 0._r8, col_type=col_type_subcol) - call pbuf_set_field(pbuf2d, cc_qi_idx, 0._r8, col_type=col_type_subcol) - call pbuf_set_field(pbuf2d, cc_nl_idx, 0._r8, col_type=col_type_subcol) - call pbuf_set_field(pbuf2d, cc_ni_idx, 0._r8, col_type=col_type_subcol) - call pbuf_set_field(pbuf2d, cc_qlst_idx,0._r8, col_type=col_type_subcol) - end if - - end if - -end subroutine micro_mg_cam_init - -!=============================================================================== - -subroutine micro_mg_cam_tend(state, ptend, dtime, pbuf) - - use micro_mg1_0, only: micro_mg_get_cols1_0 => micro_mg_get_cols - use micro_mg3_0, only: micro_mg_get_cols3_0 => micro_mg_get_cols - - type(physics_state), intent(in) :: state - type(physics_ptend), intent(out) :: ptend - real(r8), intent(in) :: dtime - type(physics_buffer_desc), pointer :: pbuf(:) - - ! Local variables - integer :: ncol, nlev, mgncol - integer, allocatable :: mgcols(:) ! Columns with microphysics performed - - ! Find the number of levels used in the microphysics. - nlev = pver - top_lev + 1 - ncol = state%ncol - - select case (micro_mg_version) - case (1) - call micro_mg_get_cols1_0(ncol, nlev, top_lev, state%q(:,:,ixcldliq), & - state%q(:,:,ixcldice), mgncol, mgcols) - case (2:3) - - if (micro_mg_do_hail .or. micro_mg_do_graupel) then - call micro_mg_get_cols3_0(ncol, nlev, top_lev, mgncol, mgcols, state%q(:,:,ixcldliq), & - state%q(:,:,ixcldice), state%q(:,:,ixrain), state%q(:,:,ixsnow), state%q(:,:,ixgraupel)) - else - call micro_mg_get_cols3_0(ncol, nlev, top_lev, mgncol, mgcols, state%q(:,:,ixcldliq), & - state%q(:,:,ixcldice), state%q(:,:,ixrain), state%q(:,:,ixsnow)) - endif - - end select - - call micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nlev) - -end subroutine micro_mg_cam_tend - -subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nlev) - - use micro_mg_utils, only: size_dist_param_basic, size_dist_param_liq, & - mg_liq_props, mg_ice_props, avg_diameter, rhoi, rhosn, rhow, rhows, & - mg_graupel_props, rhog, & - qsmall, mincld - - use micro_mg_data, only: MGPacker, MGPostProc, accum_null, accum_mean - - use micro_mg1_0, only: micro_mg_tend1_0 => micro_mg_tend - use micro_mg3_0, only: micro_mg_tend3_0 => micro_mg_tend - - use physics_buffer, only: pbuf_col_type_index - use subcol, only: subcol_field_avg - use tropopause, only: tropopause_find, TROP_ALG_CPP, TROP_ALG_NONE, NOTFOUND - use wv_saturation, only: qsat - - type(physics_state), intent(in) :: state - type(physics_ptend), intent(out) :: ptend - real(r8), intent(in) :: dtime - type(physics_buffer_desc), pointer :: pbuf(:) - - integer, intent(in) :: nlev - integer, intent(in) :: mgncol - integer, intent(in) :: mgcols(:) - - ! Local variables - integer :: lchnk, ncol, psetcols, ngrdcol - - integer :: i, k, itim_old, it - - real(r8), pointer :: naai(:,:) ! ice nucleation number - real(r8), pointer :: naai_hom(:,:) ! ice nucleation number (homogeneous) - real(r8), pointer :: npccn(:,:) ! liquid activation number tendency - real(r8), pointer :: rndst(:,:,:) - real(r8), pointer :: nacon(:,:,:) - real(r8), pointer :: am_evp_st_grid(:,:) ! Evaporation area of stratiform precipitation. 0<= am_evp_st <=1. - real(r8), pointer :: evprain_st_grid(:,:) ! Evaporation rate of stratiform rain [kg/kg/s] - real(r8), pointer :: evpsnow_st_grid(:,:) ! Evaporation rate of stratiform snow [kg/kg/s] - - real(r8), pointer :: prec_str(:) ! [Total] Sfc flux of precip from stratiform [ m/s ] - real(r8), pointer :: snow_str(:) ! [Total] Sfc flux of snow from stratiform [ m/s ] - real(r8), pointer :: prec_sed(:) ! Surface flux of total cloud water from sedimentation - real(r8), pointer :: snow_sed(:) ! Surface flux of cloud ice from sedimentation - real(r8), pointer :: prec_pcw(:) ! Sfc flux of precip from microphysics [ m/s ] - real(r8), pointer :: snow_pcw(:) ! Sfc flux of snow from microphysics [ m/s ] - - real(r8), pointer :: ast(:,:) ! Relative humidity cloud fraction - real(r8), pointer :: qsatfac(:,:) ! Subgrid cloud water saturation scaling factor. - real(r8), pointer :: alst_mic(:,:) - real(r8), pointer :: aist_mic(:,:) - real(r8), pointer :: cldo(:,:) ! Old cloud fraction - real(r8), pointer :: nevapr(:,:) ! Evaporation of total precipitation (rain + snow) - real(r8), pointer :: prer_evap(:,:) ! precipitation evaporation rate - real(r8), pointer :: relvar(:,:) ! relative variance of cloud water - real(r8), pointer :: accre_enhan(:,:) ! optional accretion enhancement for experimentation - real(r8), pointer :: prain(:,:) ! Total precipitation (rain + snow) - real(r8), pointer :: dei(:,:) ! Ice effective diameter (meters) - real(r8), pointer :: mu(:,:) ! Size distribution shape parameter for radiation - real(r8), pointer :: lambdac(:,:) ! Size distribution slope parameter for radiation - real(r8), pointer :: des(:,:) ! Snow effective diameter (m) - real(r8), pointer :: degrau(:,:) ! Graupel effective diameter (m) - real(r8), pointer :: bergso(:,:) ! Conversion of cloud water to snow from bergeron - - real(r8) :: rho(state%psetcols,pver) - real(r8) :: cldmax(state%psetcols,pver) - - real(r8), target :: rate1cld(state%psetcols,pver) ! array to hold rate1ord_cw2pr_st from microphysics - - real(r8), target :: tlat(state%psetcols,pver) - real(r8), target :: qvlat(state%psetcols,pver) - real(r8), target :: qcten(state%psetcols,pver) - real(r8), target :: qiten(state%psetcols,pver) - real(r8), target :: ncten(state%psetcols,pver) - real(r8), target :: niten(state%psetcols,pver) - - real(r8), target :: qrten(state%psetcols,pver) - real(r8), target :: qsten(state%psetcols,pver) - real(r8), target :: nrten(state%psetcols,pver) - real(r8), target :: nsten(state%psetcols,pver) - real(r8), target :: qgten(state%psetcols,pver) - real(r8), target :: ngten(state%psetcols,pver) - - real(r8), target :: prect(state%psetcols) - real(r8), target :: preci(state%psetcols) - real(r8), target :: am_evp_st(state%psetcols,pver) ! Area over which precip evaporates - real(r8), target :: evapsnow(state%psetcols,pver) ! Local evaporation of snow - real(r8), target :: prodsnow(state%psetcols,pver) ! Local production of snow - real(r8), target :: cmeice(state%psetcols,pver) ! Rate of cond-evap of ice within the cloud - real(r8), target :: qsout(state%psetcols,pver) ! Snow mixing ratio - real(r8), target :: cflx(state%psetcols,pverp) ! grid-box avg liq condensate flux (kg m^-2 s^-1) - real(r8), target :: iflx(state%psetcols,pverp) ! grid-box avg ice condensate flux (kg m^-2 s^-1) - real(r8), target :: rflx(state%psetcols,pverp) ! grid-box average rain flux (kg m^-2 s^-1) - real(r8), target :: sflx(state%psetcols,pverp) ! grid-box average snow flux (kg m^-2 s^-1) - real(r8), target :: gflx(state%psetcols,pverp) ! grid-box average snow flux (kg m^-2 s^-1) - real(r8), target :: qrout(state%psetcols,pver) ! Rain mixing ratio - real(r8), target :: qcsevap(state%psetcols,pver) ! Evaporation of falling cloud water - real(r8), target :: qisevap(state%psetcols,pver) ! Sublimation of falling cloud ice - real(r8), target :: qvres(state%psetcols,pver) ! Residual condensation term to remove excess saturation - real(r8), target :: cmeiout(state%psetcols,pver) ! Deposition/sublimation rate of cloud ice - real(r8), target :: vtrmc(state%psetcols,pver) ! Mass-weighted cloud water fallspeed - real(r8), target :: vtrmi(state%psetcols,pver) ! Mass-weighted cloud ice fallspeed - real(r8), target :: umr(state%psetcols,pver) ! Mass-weighted rain fallspeed - real(r8), target :: ums(state%psetcols,pver) ! Mass-weighted snow fallspeed - real(r8), target :: qcsedten(state%psetcols,pver) ! Cloud water mixing ratio tendency from sedimentation - real(r8), target :: qisedten(state%psetcols,pver) ! Cloud ice mixing ratio tendency from sedimentation - real(r8), target :: qrsedten(state%psetcols,pver) ! Rain mixing ratio tendency from sedimentation - real(r8), target :: qssedten(state%psetcols,pver) ! Snow mixing ratio tendency from sedimentation - real(r8), target :: qgsedten(state%psetcols,pver) ! Graupel/Hail mixing ratio tendency from sedimentation - real(r8), target :: umg(state%psetcols,pver) ! Mass-weighted Graupel/Hail fallspeed - - real(r8), target :: prao(state%psetcols,pver) - real(r8), target :: prco(state%psetcols,pver) - real(r8), target :: mnuccco(state%psetcols,pver) - real(r8), target :: mnuccto(state%psetcols,pver) - real(r8), target :: msacwio(state%psetcols,pver) - real(r8), target :: psacwso(state%psetcols,pver) - real(r8), target :: bergo(state%psetcols,pver) - real(r8), target :: melto(state%psetcols,pver) - real(r8), target :: homoo(state%psetcols,pver) - real(r8), target :: qcreso(state%psetcols,pver) - real(r8), target :: prcio(state%psetcols,pver) - real(r8), target :: praio(state%psetcols,pver) - real(r8), target :: qireso(state%psetcols,pver) - real(r8), target :: mnuccro(state%psetcols,pver) - real(r8), target :: mnuccrio(state%psetcols,pver) - real(r8), target :: mnudepo(state%psetcols,pver) - real(r8), target :: meltstot(state%psetcols,pver) - real(r8), target :: meltgtot(state%psetcols,pver) - real(r8), target :: pracso (state%psetcols,pver) - real(r8), target :: meltsdt(state%psetcols,pver) - real(r8), target :: frzrdt (state%psetcols,pver) - real(r8), target :: mnuccdo(state%psetcols,pver) - real(r8), target :: nrout(state%psetcols,pver) - real(r8), target :: nsout(state%psetcols,pver) - real(r8), target :: refl(state%psetcols,pver) ! analytic radar reflectivity - real(r8), target :: arefl(state%psetcols,pver) ! average reflectivity will zero points outside valid range - real(r8), target :: areflz(state%psetcols,pver) ! average reflectivity in z. - real(r8), target :: frefl(state%psetcols,pver) - real(r8), target :: csrfl(state%psetcols,pver) ! cloudsat reflectivity - real(r8), target :: acsrfl(state%psetcols,pver) ! cloudsat average - real(r8), target :: fcsrfl(state%psetcols,pver) - real(r8), target :: rercld(state%psetcols,pver) ! effective radius calculation for rain + cloud - real(r8), target :: ncai(state%psetcols,pver) ! output number conc of ice nuclei available (1/m3) - real(r8), target :: ncal(state%psetcols,pver) ! output number conc of CCN (1/m3) - real(r8), target :: qrout2(state%psetcols,pver) - real(r8), target :: qsout2(state%psetcols,pver) - real(r8), target :: nrout2(state%psetcols,pver) - real(r8), target :: nsout2(state%psetcols,pver) - real(r8), target :: freqs(state%psetcols,pver) - real(r8), target :: freqr(state%psetcols,pver) - real(r8), target :: nfice(state%psetcols,pver) - real(r8), target :: qcrat(state%psetcols,pver) ! qc limiter ratio (1=no limit) -!Hail/Graupel Output - real(r8), target :: freqg(state%psetcols,pver) - real(r8), target :: qgout(state%psetcols,pver) - real(r8), target :: ngout(state%psetcols,pver) - real(r8), target :: dgout(state%psetcols,pver) - real(r8), target :: qgout2(state%psetcols,pver) - real(r8), target :: ngout2(state%psetcols,pver) - real(r8), target :: dgout2(state%psetcols,pver) -!Hail/Graupel Process Rates - real(r8), target :: psacro(state%psetcols,pver) - real(r8), target :: pracgo(state%psetcols,pver) - real(r8), target :: psacwgo(state%psetcols,pver) - real(r8), target :: pgsacwo(state%psetcols,pver) - real(r8), target :: pgracso(state%psetcols,pver) - real(r8), target :: prdgo(state%psetcols,pver) - real(r8), target :: qmultgo(state%psetcols,pver) - real(r8), target :: qmultrgo(state%psetcols,pver) - real(r8), target :: npracgo(state%psetcols,pver) - real(r8), target :: nscngo(state%psetcols,pver) - real(r8), target :: ngracso(state%psetcols,pver) - real(r8), target :: nmultgo(state%psetcols,pver) - real(r8), target :: nmultrgo(state%psetcols,pver) - real(r8), target :: npsacwgo(state%psetcols,pver) - - ! Object that packs columns with clouds/precip. - type(MGPacker) :: packer - - ! Packed versions of inputs. - real(r8) :: packed_t(mgncol,nlev) - real(r8) :: packed_q(mgncol,nlev) - real(r8) :: packed_qc(mgncol,nlev) - real(r8) :: packed_nc(mgncol,nlev) - real(r8) :: packed_qi(mgncol,nlev) - real(r8) :: packed_ni(mgncol,nlev) - real(r8) :: packed_qr(mgncol,nlev) - real(r8) :: packed_nr(mgncol,nlev) - real(r8) :: packed_qs(mgncol,nlev) - real(r8) :: packed_ns(mgncol,nlev) - real(r8) :: packed_qg(mgncol,nlev) - real(r8) :: packed_ng(mgncol,nlev) - - real(r8) :: packed_relvar(mgncol,nlev) - real(r8) :: packed_accre_enhan(mgncol,nlev) - - real(r8) :: packed_p(mgncol,nlev) - real(r8) :: packed_pdel(mgncol,nlev) - - real(r8) :: packed_cldn(mgncol,nlev) - real(r8) :: packed_liqcldf(mgncol,nlev) - real(r8) :: packed_icecldf(mgncol,nlev) - real(r8), allocatable :: packed_qsatfac(:,:) - - real(r8) :: packed_naai(mgncol,nlev) - real(r8) :: packed_npccn(mgncol,nlev) - - real(r8), allocatable :: packed_rndst(:,:,:) - real(r8), allocatable :: packed_nacon(:,:,:) - - ! Optional outputs. - real(r8) :: packed_tnd_qsnow(mgncol,nlev) - real(r8) :: packed_tnd_nsnow(mgncol,nlev) - real(r8) :: packed_re_ice(mgncol,nlev) - - real(r8) :: packed_frzimm(mgncol,nlev) - real(r8) :: packed_frzcnt(mgncol,nlev) - real(r8) :: packed_frzdep(mgncol,nlev) - - ! Output field post-processing. - type(MGPostProc) :: post_proc - - ! Packed versions of outputs. - real(r8), target :: packed_rate1ord_cw2pr_st(mgncol,nlev) - real(r8), target :: packed_tlat(mgncol,nlev) - real(r8), target :: packed_qvlat(mgncol,nlev) - real(r8), target :: packed_qctend(mgncol,nlev) - real(r8), target :: packed_qitend(mgncol,nlev) - real(r8), target :: packed_nctend(mgncol,nlev) - real(r8), target :: packed_nitend(mgncol,nlev) - - real(r8), target :: packed_qrtend(mgncol,nlev) - real(r8), target :: packed_qstend(mgncol,nlev) - real(r8), target :: packed_nrtend(mgncol,nlev) - real(r8), target :: packed_nstend(mgncol,nlev) - real(r8), target :: packed_qgtend(mgncol,nlev) - real(r8), target :: packed_ngtend(mgncol,nlev) - - real(r8), target :: packed_prect(mgncol) - real(r8), target :: packed_preci(mgncol) - real(r8), target :: packed_nevapr(mgncol,nlev) - real(r8), target :: packed_am_evp_st(mgncol,nlev) - real(r8), target :: packed_evapsnow(mgncol,nlev) - real(r8), target :: packed_prain(mgncol,nlev) - real(r8), target :: packed_prodsnow(mgncol,nlev) - real(r8), target :: packed_cmeout(mgncol,nlev) - real(r8), target :: packed_qsout(mgncol,nlev) - real(r8), target :: packed_cflx(mgncol,nlev+1) - real(r8), target :: packed_iflx(mgncol,nlev+1) - real(r8), target :: packed_rflx(mgncol,nlev+1) - real(r8), target :: packed_sflx(mgncol,nlev+1) - real(r8), target :: packed_gflx(mgncol,nlev+1) - real(r8), target :: packed_qrout(mgncol,nlev) - real(r8), target :: packed_qcsevap(mgncol,nlev) - real(r8), target :: packed_qisevap(mgncol,nlev) - real(r8), target :: packed_qvres(mgncol,nlev) - real(r8), target :: packed_cmei(mgncol,nlev) - real(r8), target :: packed_vtrmc(mgncol,nlev) - real(r8), target :: packed_vtrmi(mgncol,nlev) - real(r8), target :: packed_qcsedten(mgncol,nlev) - real(r8), target :: packed_qisedten(mgncol,nlev) - real(r8), target :: packed_qrsedten(mgncol,nlev) - real(r8), target :: packed_qssedten(mgncol,nlev) - real(r8), target :: packed_qgsedten(mgncol,nlev) - real(r8), target :: packed_umg(mgncol,nlev) - real(r8), target :: packed_umr(mgncol,nlev) - real(r8), target :: packed_ums(mgncol,nlev) - real(r8), target :: packed_pra(mgncol,nlev) - real(r8), target :: packed_prc(mgncol,nlev) - real(r8), target :: packed_mnuccc(mgncol,nlev) - real(r8), target :: packed_mnucct(mgncol,nlev) - real(r8), target :: packed_msacwi(mgncol,nlev) - real(r8), target :: packed_psacws(mgncol,nlev) - real(r8), target :: packed_bergs(mgncol,nlev) - real(r8), target :: packed_berg(mgncol,nlev) - real(r8), target :: packed_melt(mgncol,nlev) - real(r8), target :: packed_homo(mgncol,nlev) - real(r8), target :: packed_qcres(mgncol,nlev) - real(r8), target :: packed_prci(mgncol,nlev) - real(r8), target :: packed_prai(mgncol,nlev) - real(r8), target :: packed_qires(mgncol,nlev) - real(r8), target :: packed_mnuccr(mgncol,nlev) - real(r8), target :: packed_mnuccri(mgncol,nlev) - real(r8), target :: packed_mnudeptot(mgncol,nlev) - real(r8), target :: packed_meltgtot(mgncol,nlev) - real(r8), target :: packed_meltstot(mgncol,nlev) - real(r8), target :: packed_pracs(mgncol,nlev) - real(r8), target :: packed_meltsdt(mgncol,nlev) - real(r8), target :: packed_frzrdt(mgncol,nlev) - real(r8), target :: packed_mnuccd(mgncol,nlev) - real(r8), target :: packed_nrout(mgncol,nlev) - real(r8), target :: packed_nsout(mgncol,nlev) - real(r8), target :: packed_refl(mgncol,nlev) - real(r8), target :: packed_arefl(mgncol,nlev) - real(r8), target :: packed_areflz(mgncol,nlev) - real(r8), target :: packed_frefl(mgncol,nlev) - real(r8), target :: packed_csrfl(mgncol,nlev) - real(r8), target :: packed_acsrfl(mgncol,nlev) - real(r8), target :: packed_fcsrfl(mgncol,nlev) - real(r8), target :: packed_rercld(mgncol,nlev) - real(r8), target :: packed_ncai(mgncol,nlev) - real(r8), target :: packed_ncal(mgncol,nlev) - real(r8), target :: packed_qrout2(mgncol,nlev) - real(r8), target :: packed_qsout2(mgncol,nlev) - real(r8), target :: packed_nrout2(mgncol,nlev) - real(r8), target :: packed_nsout2(mgncol,nlev) - real(r8), target :: packed_freqs(mgncol,nlev) - real(r8), target :: packed_freqr(mgncol,nlev) - real(r8), target :: packed_freqg(mgncol,nlev) - real(r8), target :: packed_nfice(mgncol,nlev) - real(r8), target :: packed_prer_evap(mgncol,nlev) - real(r8), target :: packed_qcrat(mgncol,nlev) - - real(r8), target :: packed_rel(mgncol,nlev) - real(r8), target :: packed_rei(mgncol,nlev) - real(r8), target :: packed_sadice(mgncol,nlev) - real(r8), target :: packed_sadsnow(mgncol,nlev) - real(r8), target :: packed_lambdac(mgncol,nlev) - real(r8), target :: packed_mu(mgncol,nlev) - real(r8), target :: packed_des(mgncol,nlev) - real(r8), target :: packed_dei(mgncol,nlev) - -!Hail/Graupel Output - real(r8), target :: packed_qgout(mgncol,nlev) - real(r8), target :: packed_ngout(mgncol,nlev) - real(r8), target :: packed_dgout(mgncol,nlev) - real(r8), target :: packed_qgout2(mgncol,nlev) - real(r8), target :: packed_ngout2(mgncol,nlev) - real(r8), target :: packed_dgout2(mgncol,nlev) -!Hail/Graupel Process Rates - real(r8), target :: packed_psacr(mgncol,nlev) - real(r8), target :: packed_pracg(mgncol,nlev) - real(r8), target :: packed_psacwg(mgncol,nlev) - real(r8), target :: packed_pgsacw(mgncol,nlev) - real(r8), target :: packed_pgracs(mgncol,nlev) - real(r8), target :: packed_prdg(mgncol,nlev) - real(r8), target :: packed_qmultg(mgncol,nlev) - real(r8), target :: packed_qmultrg(mgncol,nlev) - real(r8), target :: packed_npracg(mgncol,nlev) - real(r8), target :: packed_nscng(mgncol,nlev) - real(r8), target :: packed_ngracs(mgncol,nlev) - real(r8), target :: packed_nmultg(mgncol,nlev) - real(r8), target :: packed_nmultrg(mgncol,nlev) - real(r8), target :: packed_npsacwg(mgncol,nlev) - - ! Dummy arrays for cases where we throw away the MG version and - ! recalculate sizes on the CAM grid to avoid time/subcolumn averaging - ! issues. - real(r8) :: rel_fn_dum(mgncol,nlev) - real(r8) :: dsout2_dum(mgncol,nlev) - real(r8) :: drout_dum(mgncol,nlev) - real(r8) :: reff_rain_dum(mgncol,nlev) - real(r8) :: reff_snow_dum(mgncol,nlev) - real(r8) :: reff_grau_dum(mgncol,nlev) !not used for now or passed to COSP. - - ! Heterogeneous-only version of mnuccdo. - real(r8) :: mnuccdohet(state%psetcols,pver) - - ! physics buffer fields for COSP simulator - real(r8), pointer :: mgflxprc(:,:) ! MG grid-box mean flux_large_scale_cloud_rain+snow at interfaces (kg/m2/s) - real(r8), pointer :: mgflxsnw(:,:) ! MG grid-box mean flux_large_scale_cloud_snow at interfaces (kg/m2/s) - real(r8), pointer :: mgmrprc(:,:) ! MG grid-box mean mixingratio_large_scale_cloud_rain+snow at interfaces (kg/kg) - real(r8), pointer :: mgmrsnw(:,:) ! MG grid-box mean mixingratio_large_scale_cloud_snow at interfaces (kg/kg) - real(r8), pointer :: mgreffrain_grid(:,:) ! MG diagnostic rain effective radius (um) - real(r8), pointer :: mgreffsnow_grid(:,:) ! MG diagnostic snow effective radius (um) - real(r8), pointer :: cvreffliq(:,:) ! convective cloud liquid effective radius (um) - real(r8), pointer :: cvreffice(:,:) ! convective cloud ice effective radius (um) - - ! physics buffer fields used with CARMA - real(r8), pointer, dimension(:,:) :: tnd_qsnow ! external tendency on snow mass (kg/kg/s) - real(r8), pointer, dimension(:,:) :: tnd_nsnow ! external tendency on snow number(#/kg/s) - real(r8), pointer, dimension(:,:) :: re_ice ! ice effective radius (m) - - real(r8), pointer :: rate1ord_cw2pr_st(:,:) ! 1st order rate for direct conversion of - ! strat. cloud water to precip (1/s) ! rce 2010/05/01 - real(r8), pointer :: wsedl(:,:) ! Sedimentation velocity of liquid stratus cloud droplet [ m/s ] - - - real(r8), pointer :: CC_T(:,:) ! Grid-mean microphysical tendency - real(r8), pointer :: CC_qv(:,:) ! Grid-mean microphysical tendency - real(r8), pointer :: CC_ql(:,:) ! Grid-mean microphysical tendency - real(r8), pointer :: CC_qi(:,:) ! Grid-mean microphysical tendency - real(r8), pointer :: CC_nl(:,:) ! Grid-mean microphysical tendency - real(r8), pointer :: CC_ni(:,:) ! Grid-mean microphysical tendency - real(r8), pointer :: CC_qlst(:,:) ! In-liquid stratus microphysical tendency - - ! variables for heterogeneous freezing - real(r8), pointer :: frzimm(:,:) - real(r8), pointer :: frzcnt(:,:) - real(r8), pointer :: frzdep(:,:) - - real(r8), pointer :: qme(:,:) - - ! A local copy of state is used for diagnostic calculations - type(physics_state) :: state_loc - type(physics_ptend) :: ptend_loc - - real(r8) :: icecldf(state%psetcols,pver) ! Ice cloud fraction - real(r8) :: liqcldf(state%psetcols,pver) ! Liquid cloud fraction (combined into cloud) - - real(r8), pointer :: rel(:,:) ! Liquid effective drop radius (microns) - real(r8), pointer :: rei(:,:) ! Ice effective drop size (microns) - real(r8), pointer :: sadice(:,:) ! Ice surface area density (cm2/cm3) - real(r8), pointer :: sadsnow(:,:) ! Snow surface area density (cm2/cm3) - - - real(r8), pointer :: cmeliq(:,:) - - real(r8), pointer :: cld(:,:) ! Total cloud fraction - real(r8), pointer :: concld(:,:) ! Convective cloud fraction - real(r8), pointer :: iciwpst(:,:) ! Stratiform in-cloud ice water path for radiation - real(r8), pointer :: iclwpst(:,:) ! Stratiform in-cloud liquid water path for radiation - real(r8), pointer :: cldfsnow(:,:) ! Cloud fraction for liquid+snow - real(r8), pointer :: icswp(:,:) ! In-cloud snow water path - - real(r8), pointer :: cldfgrau(:,:) ! Cloud fraction for liquid+snow - real(r8), pointer :: icgrauwp(:,:) ! In-cloud snow water path - - real(r8) :: icimrst(state%psetcols,pver) ! In stratus ice mixing ratio - real(r8) :: icwmrst(state%psetcols,pver) ! In stratus water mixing ratio - real(r8) :: icinc(state%psetcols,pver) ! In cloud ice number conc - real(r8) :: icwnc(state%psetcols,pver) ! In cloud water number conc - - real(r8) :: iclwpi(state%psetcols) ! Vertically-integrated in-cloud Liquid WP before microphysics - real(r8) :: iciwpi(state%psetcols) ! Vertically-integrated in-cloud Ice WP before microphysics - - ! Averaging arrays for effective radius and number.... - real(r8) :: efiout_grid(pcols,pver) - real(r8) :: efcout_grid(pcols,pver) - real(r8) :: ncout_grid(pcols,pver) - real(r8) :: niout_grid(pcols,pver) - real(r8) :: freqi_grid(pcols,pver) - real(r8) :: freql_grid(pcols,pver) - -! Averaging arrays for supercooled liquid - real(r8) :: freqm_grid(pcols,pver) - real(r8) :: freqsl_grid(pcols,pver) - real(r8) :: freqslm_grid(pcols,pver) - real(r8) :: fctm_grid(pcols) - real(r8) :: fctsl_grid(pcols) - real(r8) :: fctslm_grid(pcols) - - real(r8) :: cdnumc_grid(pcols) ! Vertically-integrated droplet concentration - real(r8) :: icimrst_grid_out(pcols,pver) ! In stratus ice mixing ratio - real(r8) :: icwmrst_grid_out(pcols,pver) ! In stratus water mixing ratio - - ! Cloud fraction used for precipitation. - real(r8) :: cldmax_grid(pcols,pver) - - ! Average cloud top radius & number - real(r8) :: ctrel_grid(pcols) - real(r8) :: ctrei_grid(pcols) - real(r8) :: ctnl_grid(pcols) - real(r8) :: ctni_grid(pcols) - real(r8) :: fcti_grid(pcols) - real(r8) :: fctl_grid(pcols) - - real(r8) :: ftem_grid(pcols,pver) - - ! Variables for precip efficiency calculation - real(r8) :: minlwp ! LWP threshold - - real(r8), pointer, dimension(:) :: acprecl_grid ! accumulated precip across timesteps - real(r8), pointer, dimension(:) :: acgcme_grid ! accumulated condensation across timesteps - integer, pointer, dimension(:) :: acnum_grid ! counter for # timesteps accumulated - - ! Variables for liquid water path and column condensation - real(r8) :: tgliqwp_grid(pcols) ! column liquid - real(r8) :: tgcmeliq_grid(pcols) ! column condensation rate (units) - - real(r8) :: pe_grid(pcols) ! precip efficiency for output - real(r8) :: pefrac_grid(pcols) ! fraction of time precip efficiency is written out - real(r8) :: tpr_grid(pcols) ! average accumulated precipitation rate in pe calculation - - ! variables for autoconversion and accretion vertical averages - real(r8) :: vprco_grid(pcols) ! vertical average autoconversion - real(r8) :: vprao_grid(pcols) ! vertical average accretion - real(r8) :: racau_grid(pcols) ! ratio of vertical averages - integer :: cnt_grid(pcols) ! counters - - logical :: lq(pcnst) - - real(r8) :: icimrst_grid(pcols,pver) ! stratus ice mixing ratio - on grid - real(r8) :: icwmrst_grid(pcols,pver) ! stratus water mixing ratio - on grid - - real(r8), pointer :: lambdac_grid(:,:) - real(r8), pointer :: mu_grid(:,:) - real(r8), pointer :: rel_grid(:,:) - real(r8), pointer :: rei_grid(:,:) - real(r8), pointer :: sadice_grid(:,:) - real(r8), pointer :: sadsnow_grid(:,:) - real(r8), pointer :: dei_grid(:,:) - real(r8), pointer :: des_grid(:,:) - real(r8), pointer :: iclwpst_grid(:,:) - real(r8), pointer :: degrau_grid(:,:) - - real(r8) :: rho_grid(pcols,pver) - real(r8) :: liqcldf_grid(pcols,pver) - real(r8) :: qsout_grid(pcols,pver) - real(r8) :: ncic_grid(pcols,pver) - real(r8) :: niic_grid(pcols,pver) - real(r8) :: rel_fn_grid(pcols,pver) ! Ice effective drop size at fixed number (indirect effect) (microns) - on grid - real(r8) :: qrout_grid(pcols,pver) - real(r8) :: drout2_grid(pcols,pver) - real(r8) :: dsout2_grid(pcols,pver) - real(r8) :: nsout_grid(pcols,pver) - real(r8) :: nrout_grid(pcols,pver) - real(r8) :: reff_rain_grid(pcols,pver) - real(r8) :: reff_snow_grid(pcols,pver) - real(r8) :: reff_grau_grid(pcols,pver) - real(r8) :: cld_grid(pcols,pver) - real(r8) :: pdel_grid(pcols,pver) - real(r8) :: prco_grid(pcols,pver) - real(r8) :: prao_grid(pcols,pver) - real(r8) :: icecldf_grid(pcols,pver) - real(r8) :: icwnc_grid(pcols,pver) - real(r8) :: icinc_grid(pcols,pver) - real(r8) :: qcreso_grid(pcols,pver) - real(r8) :: melto_grid(pcols,pver) - real(r8) :: mnuccco_grid(pcols,pver) - real(r8) :: mnuccto_grid(pcols,pver) - real(r8) :: bergo_grid(pcols,pver) - real(r8) :: homoo_grid(pcols,pver) - real(r8) :: msacwio_grid(pcols,pver) - real(r8) :: psacwso_grid(pcols,pver) - real(r8) :: cmeiout_grid(pcols,pver) - real(r8) :: qireso_grid(pcols,pver) - real(r8) :: prcio_grid(pcols,pver) - real(r8) :: praio_grid(pcols,pver) - real(r8) :: psacro_grid(pcols,pver) - real(r8) :: pracgo_grid(pcols,pver) - real(r8) :: psacwgo_grid(pcols,pver) - real(r8) :: pgsacwo_grid(pcols,pver) - real(r8) :: pgracso_grid(pcols,pver) - real(r8) :: prdgo_grid(pcols,pver) - real(r8) :: qmultgo_grid(pcols,pver) - real(r8) :: qmultrgo_grid(pcols,pver) - real(r8) :: npracgo_grid(pcols,pver) - real(r8) :: nscngo_grid(pcols,pver) - real(r8) :: ngracso_grid(pcols,pver) - real(r8) :: nmultgo_grid(pcols,pver) - real(r8) :: nmultrgo_grid(pcols,pver) - real(r8) :: npsacwgo_grid(pcols,pver) - real(r8) :: qcsedtenout_grid(pcols,pver) - real(r8) :: qrsedtenout_grid(pcols,pver) - real(r8) :: qisedtenout_grid(pcols,pver) - real(r8) :: qssedtenout_grid(pcols,pver) - real(r8) :: vtrmcout_grid(pcols,pver) - real(r8) :: umrout_grid(pcols,pver) - real(r8) :: vtrmiout_grid(pcols,pver) - real(r8) :: umsout_grid(pcols,pver) - real(r8) :: qcsevapout_grid(pcols,pver) - real(r8) :: qisevapout_grid(pcols,pver) - - real(r8) :: nc_grid(pcols,pver) - real(r8) :: ni_grid(pcols,pver) - real(r8) :: qr_grid(pcols,pver) - real(r8) :: nr_grid(pcols,pver) - real(r8) :: qs_grid(pcols,pver) - real(r8) :: ns_grid(pcols,pver) - real(r8) :: qg_grid(pcols,pver) - real(r8) :: ng_grid(pcols,pver) - - real(r8) :: qgout_grid(pcols,pver) - real(r8) :: dgout2_grid(pcols,pver) - real(r8) :: ngout_grid(pcols,pver) - - real(r8) :: cp_rh(pcols,pver) - real(r8) :: cp_t(pcols) - real(r8) :: cp_z(pcols) - real(r8) :: cp_dt(pcols) - real(r8) :: cp_dz(pcols) - integer :: troplev(pcols) - real(r8) :: es - real(r8) :: qs - - real(r8), pointer :: cmeliq_grid(:,:) - - real(r8), pointer :: prec_str_grid(:) - real(r8), pointer :: snow_str_grid(:) - real(r8), pointer :: prec_pcw_grid(:) - real(r8), pointer :: snow_pcw_grid(:) - real(r8), pointer :: prec_sed_grid(:) - real(r8), pointer :: snow_sed_grid(:) - real(r8), pointer :: cldo_grid(:,:) - real(r8), pointer :: nevapr_grid(:,:) - real(r8), pointer :: prain_grid(:,:) - real(r8), pointer :: mgflxprc_grid(:,:) - real(r8), pointer :: mgflxsnw_grid(:,:) - real(r8), pointer :: mgmrprc_grid(:,:) - real(r8), pointer :: mgmrsnw_grid(:,:) - real(r8), pointer :: cvreffliq_grid(:,:) - real(r8), pointer :: cvreffice_grid(:,:) - real(r8), pointer :: rate1ord_cw2pr_st_grid(:,:) - real(r8), pointer :: wsedl_grid(:,:) - real(r8), pointer :: CC_t_grid(:,:) - real(r8), pointer :: CC_qv_grid(:,:) - real(r8), pointer :: CC_ql_grid(:,:) - real(r8), pointer :: CC_qi_grid(:,:) - real(r8), pointer :: CC_nl_grid(:,:) - real(r8), pointer :: CC_ni_grid(:,:) - real(r8), pointer :: CC_qlst_grid(:,:) - real(r8), pointer :: qme_grid(:,:) - real(r8), pointer :: iciwpst_grid(:,:) - real(r8), pointer :: icswp_grid(:,:) - real(r8), pointer :: ast_grid(:,:) - real(r8), pointer :: cldfsnow_grid(:,:) - real(r8), pointer :: bergso_grid(:,:) - - real(r8), pointer :: icgrauwp_grid(:,:) - real(r8), pointer :: cldfgrau_grid(:,:) - - real(r8), pointer :: qrout_grid_ptr(:,:) - real(r8), pointer :: qsout_grid_ptr(:,:) - real(r8), pointer :: nrout_grid_ptr(:,:) - real(r8), pointer :: nsout_grid_ptr(:,:) - real(r8), pointer :: qcsedtenout_grid_ptr(:,:) - real(r8), pointer :: qrsedtenout_grid_ptr(:,:) - real(r8), pointer :: qisedtenout_grid_ptr(:,:) - real(r8), pointer :: qssedtenout_grid_ptr(:,:) - real(r8), pointer :: vtrmcout_grid_ptr(:,:) - real(r8), pointer :: umrout_grid_ptr(:,:) - real(r8), pointer :: vtrmiout_grid_ptr(:,:) - real(r8), pointer :: umsout_grid_ptr(:,:) - real(r8), pointer :: qcsevapout_grid_ptr(:,:) - real(r8), pointer :: qisevapout_grid_ptr(:,:) - - - logical :: use_subcol_microp - integer :: col_type ! Flag to store whether accessing grid or sub-columns in pbuf_get_field - - character(128) :: errstring ! return status (non-blank for error return) - - ! For rrtmg optics. specified distribution. - real(r8), parameter :: dcon = 25.e-6_r8 ! Convective size distribution effective radius (meters) - real(r8), parameter :: mucon = 5.3_r8 ! Convective size distribution shape parameter - real(r8), parameter :: deicon = 50._r8 ! Convective ice effective diameter (meters) - - real(r8), pointer :: pckdptr(:,:) - - !------------------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - psetcols = state%psetcols - ngrdcol = state%ngrdcol - - itim_old = pbuf_old_tim_idx() - - call phys_getopts(use_subcol_microp_out=use_subcol_microp) - - ! Set the col_type flag to grid or subcolumn dependent on the value of use_subcol_microp - call pbuf_col_type_index(use_subcol_microp, col_type=col_type) - - !----------------------- - ! These physics buffer fields are read only and not set in this parameterization - ! If these fields do not have subcolumn data, copy the grid to the subcolumn if subcolumns is turned on - ! If subcolumns is not turned on, then these fields will be grid data - - call pbuf_get_field(pbuf, naai_idx, naai, col_type=col_type, copy_if_needed=use_subcol_microp) - call pbuf_get_field(pbuf, naai_hom_idx, naai_hom, col_type=col_type, copy_if_needed=use_subcol_microp) - call pbuf_get_field(pbuf, npccn_idx, npccn, col_type=col_type, copy_if_needed=use_subcol_microp) - call pbuf_get_field(pbuf, rndst_idx, rndst, col_type=col_type, copy_if_needed=use_subcol_microp) - call pbuf_get_field(pbuf, nacon_idx, nacon, col_type=col_type, copy_if_needed=use_subcol_microp) - call pbuf_get_field(pbuf, relvar_idx, relvar, col_type=col_type, copy_if_needed=use_subcol_microp) - call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan, col_type=col_type, copy_if_needed=use_subcol_microp) - call pbuf_get_field(pbuf, cmeliq_idx, cmeliq, col_type=col_type, copy_if_needed=use_subcol_microp) - - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & - col_type=col_type, copy_if_needed=use_subcol_microp) - call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & - col_type=col_type, copy_if_needed=use_subcol_microp) - call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & - col_type=col_type, copy_if_needed=use_subcol_microp) - - if (.not. do_cldice) then - call pbuf_get_field(pbuf, tnd_qsnow_idx, tnd_qsnow, col_type=col_type, copy_if_needed=use_subcol_microp) - call pbuf_get_field(pbuf, tnd_nsnow_idx, tnd_nsnow, col_type=col_type, copy_if_needed=use_subcol_microp) - call pbuf_get_field(pbuf, re_ice_idx, re_ice, col_type=col_type, copy_if_needed=use_subcol_microp) - end if - - if (use_hetfrz_classnuc) then - call pbuf_get_field(pbuf, frzimm_idx, frzimm, col_type=col_type, copy_if_needed=use_subcol_microp) - call pbuf_get_field(pbuf, frzcnt_idx, frzcnt, col_type=col_type, copy_if_needed=use_subcol_microp) - call pbuf_get_field(pbuf, frzdep_idx, frzdep, col_type=col_type, copy_if_needed=use_subcol_microp) - end if - - if (qsatfac_idx > 0) call pbuf_get_field(pbuf, qsatfac_idx, qsatfac, col_type=col_type, copy_if_needed=use_subcol_microp) - - !----------------------- - ! These physics buffer fields are calculated and set in this parameterization - ! If subcolumns is turned on, then these fields will be calculated on a subcolumn grid, otherwise they will be a normal grid - - call pbuf_get_field(pbuf, prec_str_idx, prec_str, col_type=col_type) - call pbuf_get_field(pbuf, snow_str_idx, snow_str, col_type=col_type) - call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw, col_type=col_type) - call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw, col_type=col_type) - call pbuf_get_field(pbuf, prec_sed_idx, prec_sed, col_type=col_type) - call pbuf_get_field(pbuf, snow_sed_idx, snow_sed, col_type=col_type) - call pbuf_get_field(pbuf, nevapr_idx, nevapr, col_type=col_type) - call pbuf_get_field(pbuf, prer_evap_idx, prer_evap, col_type=col_type) - call pbuf_get_field(pbuf, prain_idx, prain, col_type=col_type) - call pbuf_get_field(pbuf, dei_idx, dei, col_type=col_type) - call pbuf_get_field(pbuf, mu_idx, mu, col_type=col_type) - call pbuf_get_field(pbuf, lambdac_idx, lambdac, col_type=col_type) - call pbuf_get_field(pbuf, des_idx, des, col_type=col_type) - call pbuf_get_field(pbuf, ls_flxprc_idx, mgflxprc, col_type=col_type) - call pbuf_get_field(pbuf, ls_flxsnw_idx, mgflxsnw, col_type=col_type) - call pbuf_get_field(pbuf, ls_mrprc_idx, mgmrprc, col_type=col_type) - call pbuf_get_field(pbuf, ls_mrsnw_idx, mgmrsnw, col_type=col_type) - call pbuf_get_field(pbuf, cv_reffliq_idx, cvreffliq, col_type=col_type) - call pbuf_get_field(pbuf, cv_reffice_idx, cvreffice, col_type=col_type) - call pbuf_get_field(pbuf, iciwpst_idx, iciwpst, col_type=col_type) - call pbuf_get_field(pbuf, iclwpst_idx, iclwpst, col_type=col_type) - call pbuf_get_field(pbuf, icswp_idx, icswp, col_type=col_type) - call pbuf_get_field(pbuf, rel_idx, rel, col_type=col_type) - call pbuf_get_field(pbuf, rei_idx, rei, col_type=col_type) - call pbuf_get_field(pbuf, sadice_idx, sadice, col_type=col_type) - call pbuf_get_field(pbuf, sadsnow_idx, sadsnow, col_type=col_type) - call pbuf_get_field(pbuf, wsedl_idx, wsedl, col_type=col_type) - call pbuf_get_field(pbuf, qme_idx, qme, col_type=col_type) - call pbuf_get_field(pbuf, bergso_idx, bergso, col_type=col_type) - if (degrau_idx > 0) call pbuf_get_field(pbuf, degrau_idx, degrau, col_type=col_type) - if (icgrauwp_idx > 0) call pbuf_get_field(pbuf, icgrauwp_idx, icgrauwp, col_type=col_type) - if (cldfgrau_idx > 0) call pbuf_get_field(pbuf, cldfgrau_idx, cldfgrau, col_type=col_type) - - call pbuf_get_field(pbuf, cldo_idx, cldo, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) - call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) - call pbuf_get_field(pbuf, cc_t_idx, CC_t, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) - call pbuf_get_field(pbuf, cc_qv_idx, CC_qv, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) - call pbuf_get_field(pbuf, cc_ql_idx, CC_ql, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) - call pbuf_get_field(pbuf, cc_qi_idx, CC_qi, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) - call pbuf_get_field(pbuf, cc_nl_idx, CC_nl, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) - call pbuf_get_field(pbuf, cc_ni_idx, CC_ni, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) - call pbuf_get_field(pbuf, cc_qlst_idx, CC_qlst, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) - - if (rate1_cw2pr_st_idx > 0) then - call pbuf_get_field(pbuf, rate1_cw2pr_st_idx, rate1ord_cw2pr_st, col_type=col_type) - end if - - if (qrain_idx > 0) call pbuf_get_field(pbuf, qrain_idx, qrout_grid_ptr) - if (qsnow_idx > 0) call pbuf_get_field(pbuf, qsnow_idx, qsout_grid_ptr) - if (nrain_idx > 0) call pbuf_get_field(pbuf, nrain_idx, nrout_grid_ptr) - if (nsnow_idx > 0) call pbuf_get_field(pbuf, nsnow_idx, nsout_grid_ptr) - if (qcsedten_idx > 0) call pbuf_get_field(pbuf, qcsedten_idx, qcsedtenout_grid_ptr) - if (qrsedten_idx > 0) call pbuf_get_field(pbuf, qrsedten_idx, qrsedtenout_grid_ptr) - if (qisedten_idx > 0) call pbuf_get_field(pbuf, qisedten_idx, qisedtenout_grid_ptr) - if (qssedten_idx > 0) call pbuf_get_field(pbuf, qssedten_idx, qssedtenout_grid_ptr) - if (vtrmc_idx > 0) call pbuf_get_field(pbuf, vtrmc_idx, vtrmcout_grid_ptr) - if (umr_idx > 0) call pbuf_get_field(pbuf, umr_idx, umrout_grid_ptr) - if (vtrmi_idx > 0) call pbuf_get_field(pbuf, vtrmi_idx, vtrmiout_grid_ptr) - if (ums_idx > 0) call pbuf_get_field(pbuf, ums_idx, umsout_grid_ptr) - if (qcsevap_idx > 0) call pbuf_get_field(pbuf, qcsevap_idx, qcsevapout_grid_ptr) - if (qisevap_idx > 0) call pbuf_get_field(pbuf, qisevap_idx, qisevapout_grid_ptr) - - !----------------------- - ! If subcolumns is turned on, all calculated fields which are on subcolumns - ! need to be retrieved on the grid as well for storing averaged values - - if (use_subcol_microp) then - call pbuf_get_field(pbuf, prec_str_idx, prec_str_grid) - call pbuf_get_field(pbuf, snow_str_idx, snow_str_grid) - call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw_grid) - call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw_grid) - call pbuf_get_field(pbuf, prec_sed_idx, prec_sed_grid) - call pbuf_get_field(pbuf, snow_sed_idx, snow_sed_grid) - call pbuf_get_field(pbuf, nevapr_idx, nevapr_grid) - call pbuf_get_field(pbuf, prain_idx, prain_grid) - call pbuf_get_field(pbuf, dei_idx, dei_grid) - call pbuf_get_field(pbuf, mu_idx, mu_grid) - call pbuf_get_field(pbuf, lambdac_idx, lambdac_grid) - call pbuf_get_field(pbuf, des_idx, des_grid) - call pbuf_get_field(pbuf, ls_flxprc_idx, mgflxprc_grid) - call pbuf_get_field(pbuf, ls_flxsnw_idx, mgflxsnw_grid) - call pbuf_get_field(pbuf, ls_mrprc_idx, mgmrprc_grid) - call pbuf_get_field(pbuf, ls_mrsnw_idx, mgmrsnw_grid) - call pbuf_get_field(pbuf, cv_reffliq_idx, cvreffliq_grid) - call pbuf_get_field(pbuf, cv_reffice_idx, cvreffice_grid) - call pbuf_get_field(pbuf, iciwpst_idx, iciwpst_grid) - call pbuf_get_field(pbuf, iclwpst_idx, iclwpst_grid) - call pbuf_get_field(pbuf, icswp_idx, icswp_grid) - call pbuf_get_field(pbuf, rel_idx, rel_grid) - call pbuf_get_field(pbuf, rei_idx, rei_grid) - call pbuf_get_field(pbuf, sadice_idx, sadice_grid) - call pbuf_get_field(pbuf, sadsnow_idx, sadsnow_grid) - call pbuf_get_field(pbuf, wsedl_idx, wsedl_grid) - call pbuf_get_field(pbuf, qme_idx, qme_grid) - call pbuf_get_field(pbuf, bergso_idx, bergso_grid) - if (degrau_idx > 0) call pbuf_get_field(pbuf, degrau_idx, degrau_grid) - if (icgrauwp_idx > 0) call pbuf_get_field(pbuf, icgrauwp_idx, icgrauwp_grid) - if (cldfgrau_idx > 0) call pbuf_get_field(pbuf, cldfgrau_idx, cldfgrau_grid) - - call pbuf_get_field(pbuf, cldo_idx, cldo_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, cc_t_idx, CC_t_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, cc_qv_idx, CC_qv_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, cc_ql_idx, CC_ql_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, cc_qi_idx, CC_qi_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, cc_nl_idx, CC_nl_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, cc_ni_idx, CC_ni_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, cc_qlst_idx, CC_qlst_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - if (rate1_cw2pr_st_idx > 0) then - call pbuf_get_field(pbuf, rate1_cw2pr_st_idx, rate1ord_cw2pr_st_grid) - end if - - end if - - !----------------------- - ! These are only on the grid regardless of whether subcolumns are turned on or not - call pbuf_get_field(pbuf, ls_reffrain_idx, mgreffrain_grid) - call pbuf_get_field(pbuf, ls_reffsnow_idx, mgreffsnow_grid) - call pbuf_get_field(pbuf, acpr_idx, acprecl_grid) - call pbuf_get_field(pbuf, acgcme_idx, acgcme_grid) - call pbuf_get_field(pbuf, acnum_idx, acnum_grid) - call pbuf_get_field(pbuf, cmeliq_idx, cmeliq_grid) - call pbuf_get_field(pbuf, ast_idx, ast_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - call pbuf_get_field(pbuf, evprain_st_idx, evprain_st_grid) - call pbuf_get_field(pbuf, evpsnow_st_idx, evpsnow_st_grid) - call pbuf_get_field(pbuf, am_evp_st_idx, am_evp_st_grid) - - !------------------------------------------------------------------------------------- - ! Microphysics assumes 'liquid stratus frac = ice stratus frac - ! = max( liquid stratus frac, ice stratus frac )'. - alst_mic => ast - aist_mic => ast - - ! Output initial in-cloud LWP (before microphysics) - - iclwpi = 0._r8 - iciwpi = 0._r8 - - do i = 1, ncol - do k = top_lev, pver - iclwpi(i) = iclwpi(i) + & - min(state%q(i,k,ixcldliq) / max(mincld,ast(i,k)),0.005_r8) & - * state%pdel(i,k) / gravit - iciwpi(i) = iciwpi(i) + & - min(state%q(i,k,ixcldice) / max(mincld,ast(i,k)),0.005_r8) & - * state%pdel(i,k) / gravit - end do - end do - - cldo(:ncol,top_lev:pver)=ast(:ncol,top_lev:pver) - - ! Initialize local state from input. - call physics_state_copy(state, state_loc) - - ! Because of the of limited vertical resolution, there can be a signifcant - ! warm bias at the cold point tropopause, which can create a wet bias in the - ! stratosphere. For the microphysics only, update the cold point temperature, with - ! an estimate of the coldest point between the model layers. - if (micro_mg_adjust_cpt) then - cp_rh(:ncol, :pver) = 0._r8 - cp_dt(:ncol) = 0._r8 - cp_dz(:ncol) = 0._r8 - - call tropopause_find(state_loc, troplev, primary=TROP_ALG_CPP, backup=TROP_ALG_NONE, & - tropZ=cp_z, tropT=cp_t) - - do i = 1, ncol - - ! Update statistics and output results. - if (troplev(i) .ne. NOTFOUND) then - cp_dt(i) = cp_t(i) - state_loc%t(i,troplev(i)) - cp_dz(i) = cp_z(i) - state_loc%zm(i,troplev(i)) - - ! NOTE: This change in temperature is just for the microphysics - ! and should not be added to any tendencies or used to update - ! any states - state_loc%t(i,troplev(i)) = state_loc%t(i,troplev(i)) + cp_dt(i) - end if - end do - - ! Output all of the statistics related to the cold point - ! tropopause adjustment. Th cold point information itself is - ! output in tropopause.F90. - call outfld("TROPF_TADJ", state_loc%t, pcols, lchnk) - call outfld("TROPF_CDT", cp_dt, pcols, lchnk) - call outfld("TROPF_CDZ", cp_dz, pcols, lchnk) - end if - - ! Initialize ptend for output. - lq = .false. - lq(1) = .true. - lq(ixcldliq) = .true. - lq(ixcldice) = .true. - lq(ixnumliq) = .true. - lq(ixnumice) = .true. - if (micro_mg_version > 1) then - lq(ixrain) = .true. - lq(ixsnow) = .true. - lq(ixnumrain) = .true. - lq(ixnumsnow) = .true. - end if - if (micro_mg_version > 2) then - lq(ixgraupel) = .true. - lq(ixnumgraupel) = .true. - end if - - ! the name 'cldwat' triggers special tests on cldliq - ! and cldice in physics_update - call physics_ptend_init(ptend, psetcols, "cldwat", ls=.true., lq=lq) - - packer = MGPacker(psetcols, pver, mgcols, top_lev) - post_proc = MGPostProc(packer) - pckdptr => packed_rate1ord_cw2pr_st ! workaround an apparent pgi compiler bug - call post_proc%add_field(p(rate1cld), pckdptr) - call post_proc%add_field(p(tlat) , p(packed_tlat)) - call post_proc%add_field(p(qvlat), p(packed_qvlat)) - call post_proc%add_field(p(qcten), p(packed_qctend)) - call post_proc%add_field(p(qiten), p(packed_qitend)) - call post_proc%add_field(p(ncten), p(packed_nctend)) - call post_proc%add_field(p(niten), p(packed_nitend)) - - if (micro_mg_version > 1) then - call post_proc%add_field(p(qrten), p(packed_qrtend)) - call post_proc%add_field(p(qsten), p(packed_qstend)) - call post_proc%add_field(p(nrten), p(packed_nrtend)) - call post_proc%add_field(p(nsten), p(packed_nstend)) - call post_proc%add_field(p(umr), p(packed_umr)) - call post_proc%add_field(p(ums), p(packed_ums)) - call post_proc%add_field(p(cflx), p(packed_cflx)) - call post_proc%add_field(p(iflx), p(packed_iflx)) - end if - - if (micro_mg_version > 2) then - call post_proc%add_field(p(qgten), p(packed_qgtend)) - call post_proc%add_field(p(ngten), p(packed_ngtend)) - call post_proc%add_field(p(umg), p(packed_umg)) - end if - - call post_proc%add_field(p(am_evp_st), p(packed_am_evp_st)) - - call post_proc%add_field(p(prect), p(packed_prect)) - call post_proc%add_field(p(preci), p(packed_preci)) - call post_proc%add_field(p(nevapr), p(packed_nevapr)) - call post_proc%add_field(p(evapsnow), p(packed_evapsnow)) - call post_proc%add_field(p(prain), p(packed_prain)) - call post_proc%add_field(p(prodsnow), p(packed_prodsnow)) - call post_proc%add_field(p(cmeice), p(packed_cmeout)) - call post_proc%add_field(p(qsout), p(packed_qsout)) - call post_proc%add_field(p(rflx), p(packed_rflx)) - call post_proc%add_field(p(sflx), p(packed_sflx)) - call post_proc%add_field(p(qrout), p(packed_qrout)) - call post_proc%add_field(p(qcsevap), p(packed_qcsevap)) - call post_proc%add_field(p(qisevap), p(packed_qisevap)) - call post_proc%add_field(p(qvres), p(packed_qvres)) - call post_proc%add_field(p(cmeiout), p(packed_cmei)) - call post_proc%add_field(p(vtrmc), p(packed_vtrmc)) - call post_proc%add_field(p(vtrmi), p(packed_vtrmi)) - call post_proc%add_field(p(qcsedten), p(packed_qcsedten)) - call post_proc%add_field(p(qisedten), p(packed_qisedten)) - if (micro_mg_version > 1) then - call post_proc%add_field(p(qrsedten), p(packed_qrsedten)) - call post_proc%add_field(p(qssedten), p(packed_qssedten)) - end if - - if (micro_mg_version > 2) then - call post_proc%add_field(p(qgsedten), p(packed_qgsedten)) - call post_proc%add_field(p(gflx), p(packed_gflx)) - end if - - call post_proc%add_field(p(prao), p(packed_pra)) - call post_proc%add_field(p(prco), p(packed_prc)) - call post_proc%add_field(p(mnuccco), p(packed_mnuccc)) - call post_proc%add_field(p(mnuccto), p(packed_mnucct)) - call post_proc%add_field(p(msacwio), p(packed_msacwi)) - call post_proc%add_field(p(psacwso), p(packed_psacws)) - call post_proc%add_field(p(bergso), p(packed_bergs)) - call post_proc%add_field(p(bergo), p(packed_berg)) - call post_proc%add_field(p(melto), p(packed_melt)) - call post_proc%add_field(p(homoo), p(packed_homo)) - call post_proc%add_field(p(qcreso), p(packed_qcres)) - call post_proc%add_field(p(prcio), p(packed_prci)) - call post_proc%add_field(p(praio), p(packed_prai)) - call post_proc%add_field(p(qireso), p(packed_qires)) - call post_proc%add_field(p(mnuccro), p(packed_mnuccr)) - call post_proc%add_field(p(pracso), p(packed_pracs)) - call post_proc%add_field(p(meltsdt), p(packed_meltsdt)) - call post_proc%add_field(p(frzrdt), p(packed_frzrdt)) - call post_proc%add_field(p(mnuccdo), p(packed_mnuccd)) - call post_proc%add_field(p(nrout), p(packed_nrout)) - call post_proc%add_field(p(nsout), p(packed_nsout)) - call post_proc%add_field(p(mnudepo), p(packed_mnudeptot)) - call post_proc%add_field(p(meltstot), p(packed_meltstot)) - - call post_proc%add_field(p(refl), p(packed_refl), fillvalue=-9999._r8) - call post_proc%add_field(p(arefl), p(packed_arefl)) - call post_proc%add_field(p(areflz), p(packed_areflz)) - call post_proc%add_field(p(frefl), p(packed_frefl)) - call post_proc%add_field(p(csrfl), p(packed_csrfl), fillvalue=-9999._r8) - call post_proc%add_field(p(acsrfl), p(packed_acsrfl)) - call post_proc%add_field(p(fcsrfl), p(packed_fcsrfl)) - - call post_proc%add_field(p(rercld), p(packed_rercld)) - call post_proc%add_field(p(ncai), p(packed_ncai)) - call post_proc%add_field(p(ncal), p(packed_ncal)) - call post_proc%add_field(p(qrout2), p(packed_qrout2)) - call post_proc%add_field(p(qsout2), p(packed_qsout2)) - call post_proc%add_field(p(nrout2), p(packed_nrout2)) - call post_proc%add_field(p(nsout2), p(packed_nsout2)) - call post_proc%add_field(p(freqs), p(packed_freqs)) - call post_proc%add_field(p(freqr), p(packed_freqr)) - call post_proc%add_field(p(nfice), p(packed_nfice)) - if (micro_mg_version /= 1) then - call post_proc%add_field(p(qcrat), p(packed_qcrat), fillvalue=1._r8) - call post_proc%add_field(p(mnuccrio), p(packed_mnuccri)) - end if - - if (micro_mg_version > 2) then - call post_proc%add_field(p(freqg), p(packed_freqg)) -! Graupel/Hail size - call post_proc%add_field(p(qgout), p(packed_qgout)) - call post_proc%add_field(p(qgout2), p(packed_qgout2)) - call post_proc%add_field(p(ngout2), p(packed_ngout2)) -! Graupel/Hail process rates - call post_proc%add_field(p(psacro), p(packed_psacr)) - call post_proc%add_field(p(pracgo), p(packed_pracg)) - call post_proc%add_field(p(psacwgo), p(packed_psacwg)) - call post_proc%add_field(p(pgsacwo), p(packed_pgsacw)) - call post_proc%add_field(p(pgracso), p(packed_pgracs)) - call post_proc%add_field(p(prdgo), p(packed_prdg)) - call post_proc%add_field(p(qmultgo), p(packed_qmultg)) - call post_proc%add_field(p(qmultrgo), p(packed_qmultrg)) - call post_proc%add_field(p(meltgtot), p(packed_meltgtot)) - end if - - ! The following are all variables related to sizes, where it does not - ! necessarily make sense to average over time steps. Instead, we keep - ! the value from the last substep, which is what "accum_null" does. - call post_proc%add_field(p(rel), p(packed_rel), & - fillvalue=10._r8, accum_method=accum_null) - call post_proc%add_field(p(rei), p(packed_rei), & - fillvalue=25._r8, accum_method=accum_null) - call post_proc%add_field(p(sadice), p(packed_sadice), & - accum_method=accum_null) - call post_proc%add_field(p(sadsnow), p(packed_sadsnow), & - accum_method=accum_null) - call post_proc%add_field(p(lambdac), p(packed_lambdac), & - accum_method=accum_null) - call post_proc%add_field(p(mu), p(packed_mu), & - accum_method=accum_null) - call post_proc%add_field(p(des), p(packed_des), & - accum_method=accum_null) - call post_proc%add_field(p(dei), p(packed_dei), & - accum_method=accum_null) - call post_proc%add_field(p(prer_evap), p(packed_prer_evap), & - accum_method=accum_null) - - ! Pack input variables that are not updated during substeps. - packed_relvar = packer%pack(relvar) - packed_accre_enhan = packer%pack(accre_enhan) - - packed_p = packer%pack(state_loc%pmid) - packed_pdel = packer%pack(state_loc%pdel) - - packed_cldn = packer%pack(ast) - packed_liqcldf = packer%pack(alst_mic) - packed_icecldf = packer%pack(aist_mic) - allocate(packed_qsatfac(mgncol,nlev)) - if (qsatfac_idx > 0) then - packed_qsatfac = packer%pack(qsatfac) - else - packed_qsatfac = 1._r8 - endif - packed_naai = packer%pack(naai) - packed_npccn = packer%pack(npccn) - - allocate(packed_rndst(mgncol,nlev,size(rndst, 3))) - packed_rndst = packer%pack(rndst) - - allocate(packed_nacon(mgncol,nlev,size(nacon, 3))) - packed_nacon = packer%pack(nacon) - - if (.not. do_cldice) then - packed_tnd_qsnow = packer%pack(tnd_qsnow) - packed_tnd_nsnow = packer%pack(tnd_nsnow) - packed_re_ice = packer%pack(re_ice) - end if - - if (use_hetfrz_classnuc) then - packed_frzimm = packer%pack(frzimm) - packed_frzcnt = packer%pack(frzcnt) - packed_frzdep = packer%pack(frzdep) - end if - - do it = 1, num_steps - - ! Pack input variables that are updated during substeps. - packed_t = packer%pack(state_loc%t) - packed_q = packer%pack(state_loc%q(:,:,1)) - packed_qc = packer%pack(state_loc%q(:,:,ixcldliq)) - packed_nc = packer%pack(state_loc%q(:,:,ixnumliq)) - packed_qi = packer%pack(state_loc%q(:,:,ixcldice)) - packed_ni = packer%pack(state_loc%q(:,:,ixnumice)) - if (micro_mg_version > 1) then - packed_qr = packer%pack(state_loc%q(:,:,ixrain)) - packed_nr = packer%pack(state_loc%q(:,:,ixnumrain)) - packed_qs = packer%pack(state_loc%q(:,:,ixsnow)) - packed_ns = packer%pack(state_loc%q(:,:,ixnumsnow)) - end if - - if (micro_mg_version > 1) then - if (micro_mg_version > 2) then - packed_qg = packer%pack(state_loc%q(:,:,ixgraupel)) - packed_ng = packer%pack(state_loc%q(:,:,ixnumgraupel)) - else - packed_qg(:,:) = 0._r8 - packed_ng(:,:) = 0._r8 - end if - end if - - select case (micro_mg_version) - case (1) - select case (micro_mg_sub_version) - case (0) - call micro_mg_tend1_0( & - microp_uniform, mgncol, nlev, mgncol, 1, dtime/num_steps, & - packed_t, packed_q, packed_qc, packed_qi, packed_nc, & - packed_ni, packed_p, packed_pdel, packed_cldn, packed_liqcldf,& - packed_relvar, packed_accre_enhan, & - packed_icecldf, packed_rate1ord_cw2pr_st, packed_naai, packed_npccn, & - packed_rndst, packed_nacon, packed_tlat, packed_qvlat, packed_qctend, & - packed_qitend, packed_nctend, packed_nitend, packed_rel, rel_fn_dum, & - packed_rei, packed_prect, packed_preci, packed_nevapr, packed_evapsnow, packed_am_evp_st, & - packed_prain, packed_prodsnow, packed_cmeout, packed_dei, packed_mu, & - packed_lambdac, packed_qsout, packed_des, packed_rflx, packed_sflx, & - packed_qrout, reff_rain_dum, reff_snow_dum, packed_qcsevap, packed_qisevap, & - packed_qvres, packed_cmei, packed_vtrmc, packed_vtrmi, packed_qcsedten, & - packed_qisedten, packed_pra, packed_prc, packed_mnuccc, packed_mnucct, & - packed_msacwi, packed_psacws, packed_bergs, packed_berg, packed_melt, & - packed_homo, packed_qcres, packed_prci, packed_prai, packed_qires, & - packed_mnuccr, packed_pracs, packed_meltsdt, packed_frzrdt, packed_mnuccd, & - packed_nrout, packed_nsout, packed_refl, packed_arefl, packed_areflz, & - packed_frefl, packed_csrfl, packed_acsrfl, packed_fcsrfl, packed_rercld, & - packed_ncai, packed_ncal, packed_qrout2, packed_qsout2, packed_nrout2, & - packed_nsout2, drout_dum, dsout2_dum, packed_freqs,packed_freqr, & - packed_nfice, packed_prer_evap, do_cldice, errstring, & - packed_tnd_qsnow, packed_tnd_nsnow, packed_re_ice, & - packed_frzimm, packed_frzcnt, packed_frzdep) - - end select - case(2:3) - call micro_mg_tend3_0( & - mgncol, nlev, dtime/num_steps,& - packed_t, packed_q, & - packed_qc, packed_qi, & - packed_nc, packed_ni, & - packed_qr, packed_qs, & - packed_nr, packed_ns, & - packed_qg, packed_ng, & - packed_relvar, packed_accre_enhan, & - packed_p, packed_pdel, & - packed_cldn, packed_liqcldf, packed_icecldf, packed_qsatfac, & - packed_rate1ord_cw2pr_st, & - packed_naai, packed_npccn, & - packed_rndst, packed_nacon, & - packed_tlat, packed_qvlat, & - packed_qctend, packed_qitend, & - packed_nctend, packed_nitend, & - packed_qrtend, packed_qstend, & - packed_nrtend, packed_nstend, & - packed_qgtend, packed_ngtend, & - packed_rel, rel_fn_dum, packed_rei, & - packed_sadice, packed_sadsnow, & - packed_prect, packed_preci, & - packed_nevapr, packed_evapsnow, & - packed_am_evp_st, & - packed_prain, packed_prodsnow, & - packed_cmeout, packed_dei, & - packed_mu, packed_lambdac, & - packed_qsout, packed_des, & - packed_qgout, packed_ngout, packed_dgout, & - packed_cflx, packed_iflx, & - packed_gflx, & - packed_rflx, packed_sflx, packed_qrout, & - reff_rain_dum, reff_snow_dum, reff_grau_dum, & - packed_qcsevap, packed_qisevap, packed_qvres, & - packed_cmei, packed_vtrmc, packed_vtrmi, & - packed_umr, packed_ums, & - packed_umg, packed_qgsedten, & - packed_qcsedten, packed_qisedten, & - packed_qrsedten, packed_qssedten, & - packed_pra, packed_prc, & - packed_mnuccc, packed_mnucct, packed_msacwi, & - packed_psacws, packed_bergs, packed_berg, & - packed_melt, packed_meltstot, packed_meltgtot, packed_homo, & - packed_qcres, packed_prci, packed_prai, & - packed_qires, packed_mnuccr, packed_mnudeptot, packed_mnuccri, packed_pracs, & - packed_meltsdt, packed_frzrdt, packed_mnuccd, & - packed_pracg, packed_psacwg, packed_pgsacw, & - packed_pgracs, packed_prdg, & - packed_qmultg, packed_qmultrg, packed_psacr, & - packed_npracg, packed_nscng, packed_ngracs, & - packed_nmultg, packed_nmultrg, packed_npsacwg, & - packed_nrout, packed_nsout, & - packed_refl, packed_arefl, packed_areflz, & - packed_frefl, packed_csrfl, packed_acsrfl, & - packed_fcsrfl, packed_rercld, & - packed_ncai, packed_ncal, & - packed_qrout2, packed_qsout2, & - packed_nrout2, packed_nsout2, & - drout_dum, dsout2_dum, & - packed_qgout2, packed_ngout2, packed_dgout2, packed_freqg, & - packed_freqs, packed_freqr, & - packed_nfice, packed_qcrat, & - errstring, & - packed_tnd_qsnow,packed_tnd_nsnow,packed_re_ice,& - packed_prer_evap, & - packed_frzimm, packed_frzcnt, packed_frzdep ) - end select - - call handle_errmsg(errstring, subname="micro_mg_tend") - - call physics_ptend_init(ptend_loc, psetcols, "micro_mg", & - ls=.true., lq=lq) - - ! Set local tendency. - ptend_loc%s = packer%unpack(packed_tlat, 0._r8) - ptend_loc%q(:,:,1) = packer%unpack(packed_qvlat, 0._r8) - ptend_loc%q(:,:,ixcldliq) = packer%unpack(packed_qctend, 0._r8) - ptend_loc%q(:,:,ixcldice) = packer%unpack(packed_qitend, 0._r8) - ptend_loc%q(:,:,ixnumliq) = packer%unpack(packed_nctend, & - -state_loc%q(:,:,ixnumliq)/(dtime/num_steps)) - if (do_cldice) then - ptend_loc%q(:,:,ixnumice) = packer%unpack(packed_nitend, & - -state_loc%q(:,:,ixnumice)/(dtime/num_steps)) - else - ! In this case, the tendency should be all 0. - if (any(packed_nitend /= 0._r8)) & - call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// & - " but micro_mg_tend has ice number tendencies.") - ptend_loc%q(:,:,ixnumice) = 0._r8 - end if - - if (micro_mg_version > 1) then - ptend_loc%q(:,:,ixrain) = packer%unpack(packed_qrtend, 0._r8) - ptend_loc%q(:,:,ixsnow) = packer%unpack(packed_qstend, 0._r8) - ptend_loc%q(:,:,ixnumrain) = packer%unpack(packed_nrtend, & - -state_loc%q(:,:,ixnumrain)/(dtime/num_steps)) - ptend_loc%q(:,:,ixnumsnow) = packer%unpack(packed_nstend, & - -state_loc%q(:,:,ixnumsnow)/(dtime/num_steps)) - end if - - if (micro_mg_version > 2) then - ptend_loc%q(:,:,ixgraupel) = packer%unpack(packed_qgtend, 0._r8) - ptend_loc%q(:,:,ixnumgraupel) = packer%unpack(packed_ngtend, & - -state_loc%q(:,:,ixnumgraupel)/(dtime/num_steps)) - end if - - ! Sum into overall ptend - call physics_ptend_sum(ptend_loc, ptend, ncol) - - ! Update local state - call physics_update(state_loc, ptend_loc, dtime/num_steps) - - ! Sum all outputs for averaging. - call post_proc%accumulate() - - end do - - ! Divide ptend by substeps. - call physics_ptend_scale(ptend, 1._r8/num_steps, ncol) - - ! Use summed outputs to produce averages - call post_proc%process_and_unpack() - - call post_proc%finalize() - - ! Check to make sure that the microphysics code is respecting the flags that control - ! whether MG should be prognosing cloud ice and cloud liquid or not. - if (.not. do_cldice) then - if (any(ptend%q(:ncol,top_lev:pver,ixcldice) /= 0.0_r8)) & - call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// & - " but micro_mg_tend has ice mass tendencies.") - if (any(ptend%q(:ncol,top_lev:pver,ixnumice) /= 0.0_r8)) & - call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// & - " but micro_mg_tend has ice number tendencies.") - end if - if (.not. do_cldliq) then - if (any(ptend%q(:ncol,top_lev:pver,ixcldliq) /= 0.0_r8)) & - call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud liquid,"// & - " but micro_mg_tend has liquid mass tendencies.") - if (any(ptend%q(:ncol,top_lev:pver,ixnumliq) /= 0.0_r8)) & - call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud liquid,"// & - " but micro_mg_tend has liquid number tendencies.") - end if - - mnuccdohet = 0._r8 - do k=top_lev,pver - do i=1,ncol - if (naai(i,k) > 0._r8) then - mnuccdohet(i,k) = mnuccdo(i,k) - (naai_hom(i,k)/naai(i,k))*mnuccdo(i,k) - end if - end do - end do - - mgflxprc(:ncol,top_lev:pverp) = rflx(:ncol,top_lev:pverp) + sflx(:ncol,top_lev:pverp) - mgflxsnw(:ncol,top_lev:pverp) = sflx(:ncol,top_lev:pverp) - - !add condensate fluxes for MG2 (ice and snow already added for MG1) - if (micro_mg_version >= 2) then - mgflxprc(:ncol,top_lev:pverp) = mgflxprc(:ncol,top_lev:pverp)+ iflx(:ncol,top_lev:pverp) + cflx(:ncol,top_lev:pverp) - mgflxsnw(:ncol,top_lev:pverp) = mgflxsnw(:ncol,top_lev:pverp) + iflx(:ncol,top_lev:pverp) - end if - - !add graupel fluxes for MG3 to snow flux - if (micro_mg_version >= 3) then - mgflxprc(:ncol,top_lev:pverp) = mgflxprc(:ncol,top_lev:pverp)+gflx(:ncol,top_lev:pverp) - mgflxsnw(:ncol,top_lev:pverp) = mgflxsnw(:ncol,top_lev:pverp)+gflx(:ncol,top_lev:pverp) - end if - - mgmrprc(:ncol,top_lev:pver) = qrout(:ncol,top_lev:pver) + qsout(:ncol,top_lev:pver) - mgmrsnw(:ncol,top_lev:pver) = qsout(:ncol,top_lev:pver) - - !! calculate effective radius of convective liquid and ice using dcon and deicon (not used by code, not useful for COSP) - !! hard-coded as average of hard-coded values used for deep/shallow convective detrainment (near line 1502/1505) - cvreffliq(:ncol,top_lev:pver) = 9.0_r8 - cvreffice(:ncol,top_lev:pver) = 37.0_r8 - - ! Reassign rate1 if modal aerosols - if (rate1_cw2pr_st_idx > 0) then - rate1ord_cw2pr_st(:ncol,top_lev:pver) = rate1cld(:ncol,top_lev:pver) - end if - - ! Sedimentation velocity for liquid stratus cloud droplet - wsedl(:ncol,top_lev:pver) = vtrmc(:ncol,top_lev:pver) - - ! Microphysical tendencies for use in the macrophysics at the next time step - CC_T(:ncol,top_lev:pver) = tlat(:ncol,top_lev:pver)/cpair - CC_qv(:ncol,top_lev:pver) = qvlat(:ncol,top_lev:pver) - CC_ql(:ncol,top_lev:pver) = qcten(:ncol,top_lev:pver) - CC_qi(:ncol,top_lev:pver) = qiten(:ncol,top_lev:pver) - CC_nl(:ncol,top_lev:pver) = ncten(:ncol,top_lev:pver) - CC_ni(:ncol,top_lev:pver) = niten(:ncol,top_lev:pver) - CC_qlst(:ncol,top_lev:pver) = qcten(:ncol,top_lev:pver)/max(0.01_r8,alst_mic(:ncol,top_lev:pver)) - - ! Net micro_mg_cam condensation rate - qme(:ncol,:top_lev-1) = 0._r8 - qme(:ncol,top_lev:pver) = cmeliq(:ncol,top_lev:pver) + cmeiout(:ncol,top_lev:pver) - - bergso(:ncol,:top_lev-1) = 0._r8 - - ! For precip, accumulate only total precip in prec_pcw and snow_pcw variables. - ! Other precip output variables are set to 0 - ! Do not subscript by ncol here, because in physpkg we divide the whole - ! array and need to avoid an FPE due to uninitialized data. - prec_pcw = prect - snow_pcw = preci - prec_sed = 0._r8 - snow_sed = 0._r8 - prec_str = prec_pcw + prec_sed - snow_str = snow_pcw + snow_sed - - icecldf(:ncol,top_lev:pver) = ast(:ncol,top_lev:pver) - liqcldf(:ncol,top_lev:pver) = ast(:ncol,top_lev:pver) - - ! ------------------------------------------------------------ ! - ! Compute in cloud ice and liquid mixing ratios ! - ! Note that 'iclwp, iciwp' are used for radiation computation. ! - ! ------------------------------------------------------------ ! - - icinc = 0._r8 - icwnc = 0._r8 - iciwpst = 0._r8 - iclwpst = 0._r8 - icswp = 0._r8 - cldfsnow = 0._r8 - if (micro_mg_version > 2) then - icgrauwp = 0._r8 - cldfgrau = 0._r8 - end if - - do k = top_lev, pver - do i = 1, ncol - ! Limits for in-cloud mixing ratios consistent with MG microphysics - ! in-cloud mixing ratio maximum limit of 0.005 kg/kg - icimrst(i,k) = min( state_loc%q(i,k,ixcldice) / max(mincld,icecldf(i,k)),0.005_r8 ) - icwmrst(i,k) = min( state_loc%q(i,k,ixcldliq) / max(mincld,liqcldf(i,k)),0.005_r8 ) - icinc(i,k) = state_loc%q(i,k,ixnumice) / max(mincld,icecldf(i,k)) * & - state_loc%pmid(i,k) / (287.15_r8*state_loc%t(i,k)) - icwnc(i,k) = state_loc%q(i,k,ixnumliq) / max(mincld,liqcldf(i,k)) * & - state_loc%pmid(i,k) / (287.15_r8*state_loc%t(i,k)) - ! Calculate micro_mg_cam cloud water paths in each layer - ! Note: uses stratiform cloud fraction! - iciwpst(i,k) = min(state_loc%q(i,k,ixcldice)/max(mincld,ast(i,k)),0.005_r8) * state_loc%pdel(i,k) / gravit - iclwpst(i,k) = min(state_loc%q(i,k,ixcldliq)/max(mincld,ast(i,k)),0.005_r8) * state_loc%pdel(i,k) / gravit - - ! ------------------------------ ! - ! Adjust cloud fraction for snow ! - ! ------------------------------ ! - cldfsnow(i,k) = cld(i,k) - ! If cloud and only ice ( no convective cloud or ice ), then set to 0. - if( ( cldfsnow(i,k) .gt. 1.e-4_r8 ) .and. & - ( concld(i,k) .lt. 1.e-4_r8 ) .and. & - ( state_loc%q(i,k,ixcldliq) .lt. 1.e-10_r8 ) ) then - cldfsnow(i,k) = 0._r8 - end if - ! If no cloud and snow, then set to 0.25 - if( ( cldfsnow(i,k) .le. 1.e-4_r8 ) .and. ( qsout(i,k) .gt. 1.e-6_r8 ) ) then - cldfsnow(i,k) = 0.25_r8 - end if - ! Calculate in-cloud snow water path - icswp(i,k) = qsout(i,k) / max( mincld, cldfsnow(i,k) ) * state_loc%pdel(i,k) / gravit - - ! --------------------------------- ! - ! Adjust cloud fraction for graupel ! - ! --------------------------------- ! - if (micro_mg_version > 2) then - cldfgrau(i,k) = cld(i,k) - ! If cloud and only ice ( no convective cloud or ice ), then set to 0. - if( ( cldfgrau(i,k) .gt. 1.e-4_r8 ) .and. & - ( concld(i,k) .lt. 1.e-4_r8 ) .and. & - ( state_loc%q(i,k,ixcldliq) .lt. 1.e-10_r8 ) ) then - cldfgrau(i,k) = 0._r8 - end if - ! If no cloud and graupel, then set to 0.25 - if( ( cldfgrau(i,k) .le. 1.e-4_r8 ) .and. ( qgout(i,k) .gt. 1.e-9_r8 ) ) then - cldfgrau(i,k) = 0.25_r8 - end if - - ! Calculate in-cloud snow water path - icgrauwp(i,k) = qgout(i,k) / max( 1.e-2_r8, cldfgrau(i,k) ) * state_loc%pdel(i,k) / gravit - end if - - end do - end do - - ! Calculate cloud fraction for prognostic precip sizes. - if (micro_mg_version > 1) then - ! Cloud fraction for purposes of precipitation is maximum cloud - ! fraction out of all the layers that the precipitation may be - ! falling down from. - cldmax(:ncol,:) = max(mincld, ast(:ncol,:)) - do k = top_lev+1, pver - where (state_loc%q(:ncol,k-1,ixrain) >= qsmall .or. & - state_loc%q(:ncol,k-1,ixsnow) >= qsmall) - cldmax(:ncol,k) = max(cldmax(:ncol,k-1), cldmax(:ncol,k)) - end where - end do - end if - - ! ------------------------------------------------------ ! - ! ------------------------------------------------------ ! - ! All code from here to the end is on grid columns only ! - ! ------------------------------------------------------ ! - ! ------------------------------------------------------ ! - - ! Average the fields which are needed later in this paramterization to be on the grid - if (use_subcol_microp) then - call subcol_field_avg(prec_str, ngrdcol, lchnk, prec_str_grid) - call subcol_field_avg(iclwpst, ngrdcol, lchnk, iclwpst_grid) - call subcol_field_avg(cvreffliq, ngrdcol, lchnk, cvreffliq_grid) - call subcol_field_avg(cvreffice, ngrdcol, lchnk, cvreffice_grid) - call subcol_field_avg(mgflxprc, ngrdcol, lchnk, mgflxprc_grid) - call subcol_field_avg(mgflxsnw, ngrdcol, lchnk, mgflxsnw_grid) - call subcol_field_avg(qme, ngrdcol, lchnk, qme_grid) - call subcol_field_avg(nevapr, ngrdcol, lchnk, nevapr_grid) - call subcol_field_avg(prain, ngrdcol, lchnk, prain_grid) - call subcol_field_avg(evapsnow, ngrdcol, lchnk, evpsnow_st_grid) - call subcol_field_avg(bergso, ngrdcol, lchnk, bergso_grid) - - call subcol_field_avg(am_evp_st, ngrdcol, lchnk, am_evp_st_grid) - - ! Average fields which are not in pbuf - call subcol_field_avg(qrout, ngrdcol, lchnk, qrout_grid) - call subcol_field_avg(qsout, ngrdcol, lchnk, qsout_grid) - call subcol_field_avg(nsout, ngrdcol, lchnk, nsout_grid) - call subcol_field_avg(nrout, ngrdcol, lchnk, nrout_grid) - call subcol_field_avg(cld, ngrdcol, lchnk, cld_grid) - call subcol_field_avg(qcreso, ngrdcol, lchnk, qcreso_grid) - call subcol_field_avg(melto, ngrdcol, lchnk, melto_grid) - call subcol_field_avg(mnuccco, ngrdcol, lchnk, mnuccco_grid) - call subcol_field_avg(mnuccto, ngrdcol, lchnk, mnuccto_grid) - call subcol_field_avg(bergo, ngrdcol, lchnk, bergo_grid) - call subcol_field_avg(homoo, ngrdcol, lchnk, homoo_grid) - call subcol_field_avg(msacwio, ngrdcol, lchnk, msacwio_grid) - call subcol_field_avg(psacwso, ngrdcol, lchnk, psacwso_grid) - call subcol_field_avg(cmeiout, ngrdcol, lchnk, cmeiout_grid) - call subcol_field_avg(qireso, ngrdcol, lchnk, qireso_grid) - call subcol_field_avg(prcio, ngrdcol, lchnk, prcio_grid) - call subcol_field_avg(praio, ngrdcol, lchnk, praio_grid) - call subcol_field_avg(icwmrst, ngrdcol, lchnk, icwmrst_grid) - call subcol_field_avg(icimrst, ngrdcol, lchnk, icimrst_grid) - call subcol_field_avg(liqcldf, ngrdcol, lchnk, liqcldf_grid) - call subcol_field_avg(icecldf, ngrdcol, lchnk, icecldf_grid) - call subcol_field_avg(icwnc, ngrdcol, lchnk, icwnc_grid) - call subcol_field_avg(icinc, ngrdcol, lchnk, icinc_grid) - call subcol_field_avg(state_loc%pdel, ngrdcol, lchnk, pdel_grid) - call subcol_field_avg(prao, ngrdcol, lchnk, prao_grid) - call subcol_field_avg(prco, ngrdcol, lchnk, prco_grid) - - call subcol_field_avg(state_loc%q(:,:,ixnumliq), ngrdcol, lchnk, nc_grid) - call subcol_field_avg(state_loc%q(:,:,ixnumice), ngrdcol, lchnk, ni_grid) - - call subcol_field_avg(qcsedten, ngrdcol, lchnk, qcsedtenout_grid) - call subcol_field_avg(qisedten, ngrdcol, lchnk, qisedtenout_grid) - call subcol_field_avg(vtrmc, ngrdcol, lchnk, vtrmcout_grid) - call subcol_field_avg(vtrmi, ngrdcol, lchnk, vtrmiout_grid) - call subcol_field_avg(qcsevap, ngrdcol, lchnk, qcsevapout_grid) - call subcol_field_avg(qisevap, ngrdcol, lchnk, qisevapout_grid) - - if (micro_mg_version > 1) then - call subcol_field_avg(cldmax, ngrdcol, lchnk, cldmax_grid) - - call subcol_field_avg(state_loc%q(:,:,ixrain), ngrdcol, lchnk, qr_grid) - call subcol_field_avg(state_loc%q(:,:,ixnumrain), ngrdcol, lchnk, nr_grid) - call subcol_field_avg(state_loc%q(:,:,ixsnow), ngrdcol, lchnk, qs_grid) - call subcol_field_avg(state_loc%q(:,:,ixnumsnow), ngrdcol, lchnk, ns_grid) - call subcol_field_avg(qrsedten, ngrdcol, lchnk, qrsedtenout_grid) - call subcol_field_avg(qssedten, ngrdcol, lchnk, qssedtenout_grid) - call subcol_field_avg(umr, ngrdcol, lchnk, umrout_grid) - call subcol_field_avg(ums, ngrdcol, lchnk, umsout_grid) - end if - - if (micro_mg_version > 2) then - call subcol_field_avg(state_loc%q(:,:,ixgraupel), ngrdcol, lchnk, qg_grid) - call subcol_field_avg(state_loc%q(:,:,ixnumgraupel), ngrdcol, lchnk, ng_grid) - call subcol_field_avg(psacro, ngrdcol, lchnk, psacro_grid) - call subcol_field_avg(pracgo, ngrdcol, lchnk, pracgo_grid) - call subcol_field_avg(psacwgo, ngrdcol, lchnk, psacwgo_grid) - call subcol_field_avg(pgsacwo, ngrdcol, lchnk, pgsacwo_grid) - call subcol_field_avg(pgracso, ngrdcol, lchnk, pgracso_grid) - call subcol_field_avg(prdgo, ngrdcol, lchnk, prdgo_grid) - call subcol_field_avg(qmultgo, ngrdcol, lchnk, qmultgo_grid) - call subcol_field_avg(qmultrgo, ngrdcol, lchnk, qmultrgo_grid) - call subcol_field_avg(npracgo, ngrdcol, lchnk, npracgo_grid) - call subcol_field_avg(nscngo, ngrdcol, lchnk, nscngo_grid) - call subcol_field_avg(ngracso, ngrdcol, lchnk, ngracso_grid) - call subcol_field_avg(nmultgo, ngrdcol, lchnk, nmultgo_grid) - call subcol_field_avg(nmultrgo, ngrdcol, lchnk, nmultrgo_grid) - call subcol_field_avg(npsacwgo, ngrdcol, lchnk, npsacwgo_grid) - end if - - else - ! These pbuf fields need to be assigned. There is no corresponding subcol_field_avg - ! as they are reset before being used, so it would be a needless calculation - lambdac_grid => lambdac - mu_grid => mu - rel_grid => rel - rei_grid => rei - sadice_grid => sadice - sadsnow_grid => sadsnow - dei_grid => dei - des_grid => des - degrau_grid => degrau - - ! fields already on grids, so just assign - prec_str_grid => prec_str - iclwpst_grid => iclwpst - cvreffliq_grid => cvreffliq - cvreffice_grid => cvreffice - mgflxprc_grid => mgflxprc - mgflxsnw_grid => mgflxsnw - qme_grid => qme - nevapr_grid => nevapr - prain_grid => prain - bergso_grid => bergso - - am_evp_st_grid = am_evp_st - - evpsnow_st_grid = evapsnow - qrout_grid = qrout - qsout_grid = qsout - nsout_grid = nsout - nrout_grid = nrout - cld_grid = cld - qcreso_grid = qcreso - melto_grid = melto - mnuccco_grid = mnuccco - mnuccto_grid = mnuccto - bergo_grid = bergo - homoo_grid = homoo - msacwio_grid = msacwio - psacwso_grid = psacwso - cmeiout_grid = cmeiout - qireso_grid = qireso - prcio_grid = prcio - praio_grid = praio - icwmrst_grid = icwmrst - icimrst_grid = icimrst - liqcldf_grid = liqcldf - icecldf_grid = icecldf - icwnc_grid = icwnc - icinc_grid = icinc - pdel_grid = state_loc%pdel - prao_grid = prao - prco_grid = prco - - nc_grid = state_loc%q(:,:,ixnumliq) - ni_grid = state_loc%q(:,:,ixnumice) - - qcsedtenout_grid = qcsedten - qisedtenout_grid = qisedten - vtrmcout_grid = vtrmc - vtrmiout_grid = vtrmi - qcsevapout_grid = qcsevap - qisevapout_grid = qisevap - - if (micro_mg_version > 1) then - cldmax_grid = cldmax - - qr_grid = state_loc%q(:,:,ixrain) - nr_grid = state_loc%q(:,:,ixnumrain) - qs_grid = state_loc%q(:,:,ixsnow) - ns_grid = state_loc%q(:,:,ixnumsnow) - qrsedtenout_grid = qrsedten - qssedtenout_grid = qssedten - umrout_grid = umr - umsout_grid = ums - end if - -! Zero out terms for budgets if not mg3.... - psacwgo_grid = 0._r8 - pgsacwo_grid = 0._r8 - qmultgo_grid = 0._r8 - - if (micro_mg_version > 2) then - qg_grid = state_loc%q(:,:,ixgraupel) - ng_grid = state_loc%q(:,:,ixnumgraupel) - psacro_grid = psacro - pracgo_grid = pracgo - psacwgo_grid = psacwgo - pgsacwo_grid = pgsacwo - pgracso_grid = pgracso - prdgo_grid = prdgo - qmultgo_grid = qmultgo - qmultrgo_grid = qmultrgo - npracgo_grid = npracgo - nscngo_grid = nscngo - ngracso_grid = ngracso - nmultgo_grid = nmultgo - nmultrgo_grid = nmultrgo - npsacwgo_grid = npsacwgo - end if - - - end if - - ! If on subcolumns, average the rest of the pbuf fields which were modified on subcolumns but are not used further in - ! this parameterization (no need to assign in the non-subcolumn case -- the else step) - if (use_subcol_microp) then - call subcol_field_avg(snow_str, ngrdcol, lchnk, snow_str_grid) - call subcol_field_avg(prec_pcw, ngrdcol, lchnk, prec_pcw_grid) - call subcol_field_avg(snow_pcw, ngrdcol, lchnk, snow_pcw_grid) - call subcol_field_avg(prec_sed, ngrdcol, lchnk, prec_sed_grid) - call subcol_field_avg(snow_sed, ngrdcol, lchnk, snow_sed_grid) - call subcol_field_avg(cldo, ngrdcol, lchnk, cldo_grid) - call subcol_field_avg(mgmrprc, ngrdcol, lchnk, mgmrprc_grid) - call subcol_field_avg(mgmrsnw, ngrdcol, lchnk, mgmrsnw_grid) - call subcol_field_avg(wsedl, ngrdcol, lchnk, wsedl_grid) - call subcol_field_avg(cc_t, ngrdcol, lchnk, cc_t_grid) - call subcol_field_avg(cc_qv, ngrdcol, lchnk, cc_qv_grid) - call subcol_field_avg(cc_ql, ngrdcol, lchnk, cc_ql_grid) - call subcol_field_avg(cc_qi, ngrdcol, lchnk, cc_qi_grid) - call subcol_field_avg(cc_nl, ngrdcol, lchnk, cc_nl_grid) - call subcol_field_avg(cc_ni, ngrdcol, lchnk, cc_ni_grid) - call subcol_field_avg(cc_qlst, ngrdcol, lchnk, cc_qlst_grid) - call subcol_field_avg(iciwpst, ngrdcol, lchnk, iciwpst_grid) - call subcol_field_avg(icswp, ngrdcol, lchnk, icswp_grid) - call subcol_field_avg(cldfsnow, ngrdcol, lchnk, cldfsnow_grid) - - if (micro_mg_version > 2) then - call subcol_field_avg(icgrauwp, ngrdcol, lchnk, icgrauwp_grid) - call subcol_field_avg(cldfgrau, ngrdcol, lchnk, cldfsnow_grid) - end if - - if (rate1_cw2pr_st_idx > 0) then - call subcol_field_avg(rate1ord_cw2pr_st, ngrdcol, lchnk, rate1ord_cw2pr_st_grid) - end if - - end if - - ! ------------------------------------- ! - ! Size distribution calculation ! - ! ------------------------------------- ! - - ! Calculate rho (on subcolumns if turned on) for size distribution - ! parameter calculations and average it if needed - ! - ! State instead of state_loc to preserve answers for MG1 (and in any - ! case, it is unlikely to make much difference). - rho(:ncol,top_lev:) = state%pmid(:ncol,top_lev:) / & - (rair*state%t(:ncol,top_lev:)) - if (use_subcol_microp) then - call subcol_field_avg(rho, ngrdcol, lchnk, rho_grid) - else - rho_grid = rho - end if - - ! Effective radius for cloud liquid, fixed number. - mu_grid = 0._r8 - lambdac_grid = 0._r8 - rel_fn_grid = 10._r8 - - ncic_grid = 1.e8_r8 - - call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,top_lev:), & - ncic_grid(:ngrdcol,top_lev:), rho_grid(:ngrdcol,top_lev:), & - mu_grid(:ngrdcol,top_lev:), lambdac_grid(:ngrdcol,top_lev:)) - - where (icwmrst_grid(:ngrdcol,top_lev:) > qsmall) - rel_fn_grid(:ngrdcol,top_lev:) = & - (mu_grid(:ngrdcol,top_lev:) + 3._r8)/ & - lambdac_grid(:ngrdcol,top_lev:)/2._r8 * 1.e6_r8 - end where - - ! Effective radius for cloud liquid, and size parameters - ! mu_grid and lambdac_grid. - mu_grid = 0._r8 - lambdac_grid = 0._r8 - rel_grid = 10._r8 - - ! Calculate ncic on the grid - ncic_grid(:ngrdcol,top_lev:) = nc_grid(:ngrdcol,top_lev:) / & - max(mincld,liqcldf_grid(:ngrdcol,top_lev:)) - - call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,top_lev:), & - ncic_grid(:ngrdcol,top_lev:), rho_grid(:ngrdcol,top_lev:), & - mu_grid(:ngrdcol,top_lev:), lambdac_grid(:ngrdcol,top_lev:)) - - where (icwmrst_grid(:ngrdcol,top_lev:) >= qsmall) - rel_grid(:ngrdcol,top_lev:) = & - (mu_grid(:ngrdcol,top_lev:) + 3._r8) / & - lambdac_grid(:ngrdcol,top_lev:)/2._r8 * 1.e6_r8 - elsewhere - ! Deal with the fact that size_dist_param_liq sets mu_grid to -100 - ! wherever there is no cloud. - mu_grid(:ngrdcol,top_lev:) = 0._r8 - end where - - ! Rain/Snow effective diameter. - drout2_grid = 0._r8 - reff_rain_grid = 0._r8 - des_grid = 0._r8 - dsout2_grid = 0._r8 - reff_snow_grid = 0._r8 - reff_grau_grid = 0._r8 - - if (micro_mg_version > 1) then - ! Prognostic precipitation - - where (qr_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) - drout2_grid(:ngrdcol,top_lev:) = avg_diameter( & - qr_grid(:ngrdcol,top_lev:), & - nr_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & - rho_grid(:ngrdcol,top_lev:), rhow) - - reff_rain_grid(:ngrdcol,top_lev:) = drout2_grid(:ngrdcol,top_lev:) * & - 1.5_r8 * 1.e6_r8 - end where - - where (qs_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) - dsout2_grid(:ngrdcol,top_lev:) = avg_diameter( & - qs_grid(:ngrdcol,top_lev:), & - ns_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & - rho_grid(:ngrdcol,top_lev:), rhosn) - - des_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) *& - 3._r8 * rhosn/rhows - - reff_snow_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) * & - 1.5_r8 * 1.e6_r8 - end where - - else - ! Diagnostic precipitation - - where (qrout_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) - drout2_grid(:ngrdcol,top_lev:) = avg_diameter( & - qrout_grid(:ngrdcol,top_lev:), & - nrout_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & - rho_grid(:ngrdcol,top_lev:), rhow) - - reff_rain_grid(:ngrdcol,top_lev:) = drout2_grid(:ngrdcol,top_lev:) * & - 1.5_r8 * 1.e6_r8 - end where - - where (qsout_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) - dsout2_grid(:ngrdcol,top_lev:) = avg_diameter( & - qsout_grid(:ngrdcol,top_lev:), & - nsout_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & - rho_grid(:ngrdcol,top_lev:), rhosn) - - des_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) & - * 3._r8 * rhosn/rhows - - reff_snow_grid(:ngrdcol,top_lev:) = & - dsout2_grid(:ngrdcol,top_lev:) * 1.5_r8 * 1.e6_r8 - end where - - end if - -! Graupel/Hail size distribution Placeholder - if (micro_mg_version > 2) then - degrau_grid = 0._r8 - where (qg_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) - dgout2_grid(:ngrdcol,top_lev:) = avg_diameter( & - qg_grid(:ngrdcol,top_lev:), & - ng_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & - rho_grid(:ngrdcol,top_lev:), rhog) - - reff_grau_grid(:ngrdcol,top_lev:) = dgout2_grid(:ngrdcol,top_lev:) * & - 1.5_r8 * 1.e6_r8 - degrau_grid(:ngrdcol,top_lev:) = dgout2_grid(:ngrdcol,top_lev:) *& - 3._r8 * rhog/rhows - end where - end if - - ! Effective radius and diameter for cloud ice. - rei_grid = 25._r8 - - niic_grid(:ngrdcol,top_lev:) = ni_grid(:ngrdcol,top_lev:) / & - max(mincld,icecldf_grid(:ngrdcol,top_lev:)) - - call size_dist_param_basic(mg_ice_props, icimrst_grid(:ngrdcol,top_lev:), & - niic_grid(:ngrdcol,top_lev:), rei_grid(:ngrdcol,top_lev:)) - - where (icimrst_grid(:ngrdcol,top_lev:) >= qsmall) - rei_grid(:ngrdcol,top_lev:) = 1.5_r8/rei_grid(:ngrdcol,top_lev:) & - * 1.e6_r8 - elsewhere - rei_grid(:ngrdcol,top_lev:) = 25._r8 - end where - - dei_grid = rei_grid * rhoi/rhows * 2._r8 - - ! Limiters for low cloud fraction. - do k = top_lev, pver - do i = 1, ngrdcol - ! Convert snow effective diameter to microns - des_grid(i,k) = des_grid(i,k) * 1.e6_r8 - if ( ast_grid(i,k) < 1.e-4_r8 ) then - mu_grid(i,k) = mucon - lambdac_grid(i,k) = (mucon + 1._r8)/dcon - dei_grid(i,k) = deicon - end if - end do - end do - - mgreffrain_grid(:ngrdcol,top_lev:pver) = reff_rain_grid(:ngrdcol,top_lev:pver) - mgreffsnow_grid(:ngrdcol,top_lev:pver) = reff_snow_grid(:ngrdcol,top_lev:pver) - - ! ------------------------------------- ! - ! Precipitation efficiency Calculation ! - ! ------------------------------------- ! - - !----------------------------------------------------------------------- - ! Liquid water path - - ! Compute liquid water paths, and column condensation - tgliqwp_grid(:ngrdcol) = 0._r8 - tgcmeliq_grid(:ngrdcol) = 0._r8 - do k = top_lev, pver - do i = 1, ngrdcol - tgliqwp_grid(i) = tgliqwp_grid(i) + iclwpst_grid(i,k)*cld_grid(i,k) - - if (cmeliq_grid(i,k) > 1.e-12_r8) then - !convert cmeliq to right units: kgh2o/kgair/s * kgair/m2 / kgh2o/m3 = m/s - tgcmeliq_grid(i) = tgcmeliq_grid(i) + cmeliq_grid(i,k) * & - (pdel_grid(i,k) / gravit) / rhoh2o - end if - end do - end do - - ! note: 1e-6 kgho2/kgair/s * 1000. pa / (9.81 m/s2) / 1000 kgh2o/m3 = 1e-7 m/s - ! this is 1ppmv of h2o in 10hpa - ! alternatively: 0.1 mm/day * 1.e-4 m/mm * 1/86400 day/s = 1.e-9 - - !----------------------------------------------------------------------- - ! precipitation efficiency calculation (accumulate cme and precip) - - minlwp = 0.01_r8 !minimum lwp threshold (kg/m3) - - ! zero out precip efficiency and total averaged precip - pe_grid(:ngrdcol) = 0._r8 - tpr_grid(:ngrdcol) = 0._r8 - pefrac_grid(:ngrdcol) = 0._r8 - - ! accumulate precip and condensation - do i = 1, ngrdcol - - acgcme_grid(i) = acgcme_grid(i) + tgcmeliq_grid(i) - acprecl_grid(i) = acprecl_grid(i) + prec_str_grid(i) - acnum_grid(i) = acnum_grid(i) + 1 - - ! if LWP is zero, then 'end of cloud': calculate precip efficiency - if (tgliqwp_grid(i) < minlwp) then - if (acprecl_grid(i) > 5.e-8_r8) then - tpr_grid(i) = max(acprecl_grid(i)/acnum_grid(i), 1.e-15_r8) - if (acgcme_grid(i) > 1.e-10_r8) then - pe_grid(i) = min(max(acprecl_grid(i)/acgcme_grid(i), 1.e-15_r8), 1.e5_r8) - pefrac_grid(i) = 1._r8 - end if - end if - - ! reset counters -! if (pe_grid(i) /= 0._r8 .and. (pe_grid(i) < 1.e-8_r8 .or. pe_grid(i) > 1.e3_r8)) then -! write (iulog,*) 'PE_grid:ANOMALY pe_grid, acprecl_grid, acgcme_grid, tpr_grid, acnum_grid ', & -! pe_grid(i),acprecl_grid(i), acgcme_grid(i), tpr_grid(i), acnum_grid(i) -! endif - - acprecl_grid(i) = 0._r8 - acgcme_grid(i) = 0._r8 - acnum_grid(i) = 0 - end if ! end LWP zero conditional - - ! if never find any rain....(after 10^3 timesteps...) - if (acnum_grid(i) > 1000) then - acnum_grid(i) = 0 - acprecl_grid(i) = 0._r8 - acgcme_grid(i) = 0._r8 - end if - - end do - - !----------------------------------------------------------------------- - ! vertical average of non-zero accretion, autoconversion and ratio. - ! vars: vprco_grid(i),vprao_grid(i),racau_grid(i),cnt_grid - - vprao_grid = 0._r8 - cnt_grid = 0 - do k = top_lev, pver - vprao_grid(:ngrdcol) = vprao_grid(:ngrdcol) + prao_grid(:ngrdcol,k) - where (prao_grid(:ngrdcol,k) /= 0._r8) cnt_grid(:ngrdcol) = cnt_grid(:ngrdcol) + 1 - end do - - where (cnt_grid > 0) vprao_grid = vprao_grid/cnt_grid - - vprco_grid = 0._r8 - cnt_grid = 0 - do k = top_lev, pver - vprco_grid(:ngrdcol) = vprco_grid(:ngrdcol) + prco_grid(:ngrdcol,k) - where (prco_grid(:ngrdcol,k) /= 0._r8) cnt_grid(:ngrdcol) = cnt_grid(:ngrdcol) + 1 - end do - - where (cnt_grid > 0) - vprco_grid = vprco_grid/cnt_grid - racau_grid = vprao_grid/vprco_grid - elsewhere - racau_grid = 0._r8 - end where - - racau_grid = min(racau_grid, 1.e10_r8) - - ! --------------------- ! - ! History Output Fields ! - ! --------------------- ! - - ! Column droplet concentration - cdnumc_grid(:ngrdcol) = sum(nc_grid(:ngrdcol,top_lev:pver) * & - pdel_grid(:ngrdcol,top_lev:pver)/gravit, dim=2) - - ! Averaging for new output fields - efcout_grid = 0._r8 - efiout_grid = 0._r8 - ncout_grid = 0._r8 - niout_grid = 0._r8 - freql_grid = 0._r8 - freqi_grid = 0._r8 - icwmrst_grid_out = 0._r8 - icimrst_grid_out = 0._r8 - freqm_grid = 0._r8 - freqsl_grid = 0._r8 - freqslm_grid = 0._r8 - - do k = top_lev, pver - do i = 1, ngrdcol - if ( liqcldf_grid(i,k) > 0.01_r8 .and. icwmrst_grid(i,k) > 5.e-5_r8 ) then - efcout_grid(i,k) = rel_grid(i,k) * liqcldf_grid(i,k) - ncout_grid(i,k) = icwnc_grid(i,k) * liqcldf_grid(i,k) - freql_grid(i,k) = liqcldf_grid(i,k) - icwmrst_grid_out(i,k) = icwmrst_grid(i,k) - end if - if ( icecldf_grid(i,k) > 0.01_r8 .and. icimrst_grid(i,k) > 1.e-6_r8 ) then - efiout_grid(i,k) = rei_grid(i,k) * icecldf_grid(i,k) - niout_grid(i,k) = icinc_grid(i,k) * icecldf_grid(i,k) - freqi_grid(i,k) = icecldf_grid(i,k) - icimrst_grid_out(i,k) = icimrst_grid(i,k) - end if - - ! Supercooled liquid - if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) > 0.01_r8 ) then - freqm_grid(i,k)=min(liqcldf_grid(i,k),icecldf_grid(i,k)) - end if - if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) < 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then - freqsl_grid(i,k)=liqcldf_grid(i,k) - end if - if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) > 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then - freqslm_grid(i,k)=liqcldf_grid(i,k) - end if - - end do - end do - - ! Cloud top effective radius and number. - fcti_grid = 0._r8 - fctl_grid = 0._r8 - ctrel_grid = 0._r8 - ctrei_grid = 0._r8 - ctnl_grid = 0._r8 - ctni_grid = 0._r8 - fctm_grid = 0._r8 - fctsl_grid = 0._r8 - fctslm_grid= 0._r8 - - do i = 1, ngrdcol - do k = top_lev, pver - if ( liqcldf_grid(i,k) > 0.01_r8 .and. icwmrst_grid(i,k) > 1.e-7_r8 ) then - ctrel_grid(i) = rel_grid(i,k) * liqcldf_grid(i,k) - ctnl_grid(i) = icwnc_grid(i,k) * liqcldf_grid(i,k) - fctl_grid(i) = liqcldf_grid(i,k) - - ! Cloud Top Mixed phase, supercooled liquid only and supercooled liquid mixed - if (freqi_grid(i,k) > 0.01_r8) then - fctm_grid(i)=min(liqcldf_grid(i,k),icecldf_grid(i,k)) - end if - if (freqi_grid(i,k) < 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then - fctsl_grid(i)=liqcldf_grid(i,k) - end if - if (freqi_grid(i,k) > 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then - fctslm_grid(i)=liqcldf_grid(i,k) - end if - - exit - end if - - if ( icecldf_grid(i,k) > 0.01_r8 .and. icimrst_grid(i,k) > 1.e-7_r8 ) then - ctrei_grid(i) = rei_grid(i,k) * icecldf_grid(i,k) - ctni_grid(i) = icinc_grid(i,k) * icecldf_grid(i,k) - fcti_grid(i) = icecldf_grid(i,k) - exit - end if - end do - end do - - ! Evaporation of stratiform precipitation fields for UNICON - evprain_st_grid(:ngrdcol,:pver) = nevapr_grid(:ngrdcol,:pver) - evpsnow_st_grid(:ngrdcol,:pver) - do k = top_lev, pver - do i = 1, ngrdcol - evprain_st_grid(i,k) = max(evprain_st_grid(i,k), 0._r8) - evpsnow_st_grid(i,k) = max(evpsnow_st_grid(i,k), 0._r8) - end do - end do - - ! Assign the values to the pbuf pointers if they exist in pbuf - if (qrain_idx > 0) qrout_grid_ptr = qrout_grid - if (qsnow_idx > 0) qsout_grid_ptr = qsout_grid - if (nrain_idx > 0) nrout_grid_ptr = nrout_grid - if (nsnow_idx > 0) nsout_grid_ptr = nsout_grid - if (qcsedten_idx > 0) qcsedtenout_grid_ptr = qcsedtenout_grid - if (qrsedten_idx > 0) qrsedtenout_grid_ptr = qrsedtenout_grid - if (qisedten_idx > 0) qisedtenout_grid_ptr = qisedtenout_grid - if (qssedten_idx > 0) qssedtenout_grid_ptr = qssedtenout_grid - if (vtrmc_idx > 0) vtrmcout_grid_ptr = vtrmcout_grid - if (umr_idx > 0) umrout_grid_ptr = umrout_grid - if (vtrmi_idx > 0) vtrmiout_grid_ptr = vtrmiout_grid - if (ums_idx > 0) umsout_grid_ptr = umsout_grid - if (qcsevap_idx > 0 ) qcsevapout_grid_ptr = qcsevapout_grid - if (qisevap_idx > 0 ) qisevapout_grid_ptr = qisevapout_grid - - ! --------------------------------------------- ! - ! General outfield calls for microphysics ! - ! --------------------------------------------- ! - - ! Output a handle of variables which are calculated on the fly - - ftem_grid = 0._r8 - - ftem_grid(:ngrdcol,top_lev:pver) = qcreso_grid(:ngrdcol,top_lev:pver) - call outfld( 'MPDW2V', ftem_grid, pcols, lchnk) - - ftem_grid(:ngrdcol,top_lev:pver) = melto_grid(:ngrdcol,top_lev:pver) - mnuccco_grid(:ngrdcol,top_lev:pver)& - - mnuccto_grid(:ngrdcol,top_lev:pver) - bergo_grid(:ngrdcol,top_lev:pver) - homoo_grid(:ngrdcol,top_lev:pver)& - - msacwio_grid(:ngrdcol,top_lev:pver) - call outfld( 'MPDW2I', ftem_grid, pcols, lchnk) - - if (micro_mg_version > 2) then - ftem_grid(:ngrdcol,top_lev:pver) = -prao_grid(:ngrdcol,top_lev:pver) - prco_grid(:ngrdcol,top_lev:pver)& - - psacwso_grid(:ngrdcol,top_lev:pver) - bergso_grid(:ngrdcol,top_lev:pver)& - - psacwgo_grid(:ngrdcol,top_lev:pver) - pgsacwo_grid(:ngrdcol,top_lev:pver) - else - ftem_grid(:ngrdcol,top_lev:pver) = -prao_grid(:ngrdcol,top_lev:pver) - prco_grid(:ngrdcol,top_lev:pver)& - - psacwso_grid(:ngrdcol,top_lev:pver) - bergso_grid(:ngrdcol,top_lev:pver) - endif - - call outfld( 'MPDW2P', ftem_grid, pcols, lchnk) - - ftem_grid(:ngrdcol,top_lev:pver) = cmeiout_grid(:ngrdcol,top_lev:pver) + qireso_grid(:ngrdcol,top_lev:pver) - call outfld( 'MPDI2V', ftem_grid, pcols, lchnk) - - if (micro_mg_version > 2) then - ftem_grid(:ngrdcol,top_lev:pver) = -melto_grid(:ngrdcol,top_lev:pver) + mnuccco_grid(:ngrdcol,top_lev:pver) & - + mnuccto_grid(:ngrdcol,top_lev:pver) + bergo_grid(:ngrdcol,top_lev:pver) + homoo_grid(:ngrdcol,top_lev:pver)& - + msacwio_grid(:ngrdcol,top_lev:pver)& - - qmultgo_grid(:ngrdcol,top_lev:pver) - else - ftem_grid(:ngrdcol,top_lev:pver) = -melto_grid(:ngrdcol,top_lev:pver) + mnuccco_grid(:ngrdcol,top_lev:pver) & - + mnuccto_grid(:ngrdcol,top_lev:pver) + bergo_grid(:ngrdcol,top_lev:pver) + homoo_grid(:ngrdcol,top_lev:pver)& - + msacwio_grid(:ngrdcol,top_lev:pver) - endif - - call outfld( 'MPDI2W', ftem_grid, pcols, lchnk) - - ftem_grid(:ngrdcol,top_lev:pver) = -prcio_grid(:ngrdcol,top_lev:pver) - praio_grid(:ngrdcol,top_lev:pver) - call outfld( 'MPDI2P', ftem_grid, pcols, lchnk) - - ! Output fields which have not been averaged already, averaging if use_subcol_microp is true - call outfld('MPICLWPI', iclwpi, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MPICIWPI', iciwpi, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('REFL', refl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('AREFL', arefl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('AREFLZ', areflz, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('FREFL', frefl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('CSRFL', csrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('ACSRFL', acsrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('FCSRFL', fcsrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('RERCLD', rercld, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('NCAL', ncal, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('NCAI', ncai, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('AQRAIN', qrout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('AQSNOW', qsout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('ANRAIN', nrout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('ANSNOW', nsout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('FREQR', freqr, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('FREQS', freqs, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MPDT', tlat, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MPDQ', qvlat, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MPDLIQ', qcten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MPDICE', qiten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MPDNLIQ', ncten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MPDNICE', niten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('EVAPSNOW', evapsnow, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('QCSEVAP', qcsevap, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('QISEVAP', qisevap, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('QVRES', qvres, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('VTRMC', vtrmc, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('VTRMI', vtrmi, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('QCSEDTEN', qcsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('QISEDTEN', qisedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - if (micro_mg_version > 1) then - call outfld('QRSEDTEN', qrsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('QSSEDTEN', qssedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MNUCCRIO', mnuccrio, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MNUDEPO', mnudepo, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MELTSTOT', meltstot, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - end if - call outfld('MNUCCDO', mnuccdo, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MNUCCDOhet', mnuccdohet, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MNUCCRO', mnuccro, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('PRACSO', pracso , psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MELTSDT', meltsdt, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('FRZRDT', frzrdt , psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('FICE', nfice, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('CLDFSNOW', cldfsnow, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - - if (micro_mg_version > 1) then - call outfld('UMR', umr, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('UMS', ums, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - end if - - if (.not. (micro_mg_version == 1 .and. micro_mg_sub_version == 0)) then - call outfld('QCRAT', qcrat, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - end if - - if (micro_mg_version > 2) then - call outfld('UMG', umg, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('QGSEDTEN', qgsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('FREQG', freqg, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('AQGRAU', qgout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('ANGRAU', ngout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('CLDFGRAU', cldfgrau, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - call outfld('MELTGTOT', meltgtot, psetcols, lchnk, avg_subcol_field=use_subcol_microp) - - end if - - ! Example subcolumn outfld call - if (use_subcol_microp) then - call outfld('FICE_SCOL', nfice, psubcols*pcols, lchnk) - call outfld('MPDLIQ_SCOL', qcten, psubcols*pcols, lchnk) - call outfld('MPDICE_SCOL', qiten, psubcols*pcols, lchnk) - end if - - ! Output fields which are already on the grid - call outfld('QRAIN', qrout_grid, pcols, lchnk) - call outfld('QSNOW', qsout_grid, pcols, lchnk) - call outfld('NRAIN', nrout_grid, pcols, lchnk) - call outfld('NSNOW', nsout_grid, pcols, lchnk) - call outfld('CV_REFFLIQ', cvreffliq_grid, pcols, lchnk) - call outfld('CV_REFFICE', cvreffice_grid, pcols, lchnk) - call outfld('LS_FLXPRC', mgflxprc_grid, pcols, lchnk) - call outfld('LS_FLXSNW', mgflxsnw_grid, pcols, lchnk) - call outfld('CME', qme_grid, pcols, lchnk) - call outfld('PRODPREC', prain_grid, pcols, lchnk) - call outfld('EVAPPREC', nevapr_grid, pcols, lchnk) - call outfld('QCRESO', qcreso_grid, pcols, lchnk) - call outfld('LS_REFFRAIN', mgreffrain_grid, pcols, lchnk) - call outfld('LS_REFFSNOW', mgreffsnow_grid, pcols, lchnk) - call outfld('DSNOW', des_grid, pcols, lchnk) - call outfld('ADRAIN', drout2_grid, pcols, lchnk) - call outfld('ADSNOW', dsout2_grid, pcols, lchnk) - call outfld('PE', pe_grid, pcols, lchnk) - call outfld('PEFRAC', pefrac_grid, pcols, lchnk) - call outfld('APRL', tpr_grid, pcols, lchnk) - call outfld('VPRAO', vprao_grid, pcols, lchnk) - call outfld('VPRCO', vprco_grid, pcols, lchnk) - call outfld('RACAU', racau_grid, pcols, lchnk) - call outfld('AREL', efcout_grid, pcols, lchnk) - call outfld('AREI', efiout_grid, pcols, lchnk) - call outfld('AWNC' , ncout_grid, pcols, lchnk) - call outfld('AWNI' , niout_grid, pcols, lchnk) - call outfld('FREQL', freql_grid, pcols, lchnk) - call outfld('FREQI', freqi_grid, pcols, lchnk) - call outfld('ACTREL', ctrel_grid, pcols, lchnk) - call outfld('ACTREI', ctrei_grid, pcols, lchnk) - call outfld('ACTNL', ctnl_grid, pcols, lchnk) - call outfld('ACTNI', ctni_grid, pcols, lchnk) - call outfld('FCTL', fctl_grid, pcols, lchnk) - call outfld('FCTI', fcti_grid, pcols, lchnk) - call outfld('ICINC', icinc_grid, pcols, lchnk) - call outfld('ICWNC', icwnc_grid, pcols, lchnk) - call outfld('EFFLIQ_IND', rel_fn_grid, pcols, lchnk) - call outfld('CDNUMC', cdnumc_grid, pcols, lchnk) - call outfld('REL', rel_grid, pcols, lchnk) - call outfld('REI', rei_grid, pcols, lchnk) - call outfld('MG_SADICE', sadice_grid, pcols, lchnk) - call outfld('MG_SADSNOW', sadsnow_grid, pcols, lchnk) - call outfld('ICIMRST', icimrst_grid_out, pcols, lchnk) - call outfld('ICWMRST', icwmrst_grid_out, pcols, lchnk) - call outfld('CMEIOUT', cmeiout_grid, pcols, lchnk) - call outfld('PRAO', prao_grid, pcols, lchnk) - call outfld('PRCO', prco_grid, pcols, lchnk) - call outfld('MNUCCCO', mnuccco_grid, pcols, lchnk) - call outfld('MNUCCTO', mnuccto_grid, pcols, lchnk) - call outfld('MSACWIO', msacwio_grid, pcols, lchnk) - call outfld('PSACWSO', psacwso_grid, pcols, lchnk) - call outfld('BERGSO', bergso_grid, pcols, lchnk) - call outfld('BERGO', bergo_grid, pcols, lchnk) - call outfld('MELTO', melto_grid, pcols, lchnk) - call outfld('HOMOO', homoo_grid, pcols, lchnk) - call outfld('PRCIO', prcio_grid, pcols, lchnk) - call outfld('PRAIO', praio_grid, pcols, lchnk) - call outfld('QIRESO', qireso_grid, pcols, lchnk) - call outfld('FREQM', freqm_grid, pcols, lchnk) - call outfld('FREQSL', freqsl_grid, pcols, lchnk) - call outfld('FREQSLM', freqslm_grid, pcols, lchnk) - call outfld('FCTM', fctm_grid, pcols, lchnk) - call outfld('FCTSL', fctsl_grid, pcols, lchnk) - call outfld('FCTSLM', fctslm_grid, pcols, lchnk) - - if (micro_mg_version > 2) then - call outfld('PRACGO', pracgo_grid, pcols, lchnk) - call outfld('PSACRO', psacro_grid, pcols, lchnk) - call outfld('PSACWGO', psacwgo_grid, pcols, lchnk) - call outfld('PGSACWO', pgsacwo_grid, pcols, lchnk) - call outfld('PGRACSO', pgracso_grid, pcols, lchnk) - call outfld('PRDGO', prdgo_grid, pcols, lchnk) - call outfld('QMULTGO', qmultgo_grid, pcols, lchnk) - call outfld('QMULTRGO', qmultrgo_grid, pcols, lchnk) - call outfld('LS_REFFGRAU', reff_grau_grid, pcols, lchnk) - call outfld ('NPRACGO', npracgo_grid, pcols, lchnk) - call outfld ('NSCNGO', nscngo_grid, pcols, lchnk) - call outfld ('NGRACSO', ngracso_grid, pcols, lchnk) - call outfld ('NMULTGO', nmultgo_grid, pcols, lchnk) - call outfld ('NMULTRGO', nmultrgo_grid, pcols, lchnk) - call outfld ('NPSACWGO', npsacwgo_grid, pcols, lchnk) - end if - - if (micro_mg_adjust_cpt) then - cp_rh(:ncol, :pver) = 0._r8 - - do i = 1, ncol - - ! Calculate the RH including any T change that we make. - do k = top_lev, pver - call qsat(state_loc%t(i,k), state_loc%pmid(i,k), es, qs) - cp_rh(i,k) = state_loc%q(i, k, 1) / qs * 100._r8 - end do - end do - - call outfld("TROPF_RHADJ", cp_rh, pcols, lchnk) - end if - - ! ptend_loc is deallocated in physics_update above - call physics_state_dealloc(state_loc) - -end subroutine micro_mg_cam_tend_pack - -subroutine massless_droplet_destroyer(ztodt, state, ptend) - - ! This subroutine eradicates cloud droplets in grid boxes with no cloud - ! mass. This code is now expanded to remove massless rain drops, ice - ! crystals, and snow flakes. - ! - ! Note: qsmall, which is a small, positive number, is used as the - ! threshold here instead of qmin, which is 0. Some numbers that are - ! supposed to have a value of 0, but don't because of numerical - ! roundoff (especially after hole filling) will have small, positive - ! values. Using qsmall as the threshold here instead of qmin allows - ! for unreasonable massless drop concentrations to be removed in - ! those scenarios. - - use constituents, only: cnst_get_ind - use micro_mg_utils, only: qsmall - use ref_pres, only: top_lev => trop_cloud_top_lev - - implicit none - - ! Input Variables - real(r8), intent(in) :: ztodt ! model time increment - type(physics_state), intent(in) :: state ! state for columns - - ! Input/Output Variables - type(physics_ptend), intent(inout) :: ptend ! ptend for columns - - ! Local Variables - integer :: icol, k - - !----- Begin Code ----- - - ! Don't do anything if this option isn't enabled. - if ( .not. micro_do_massless_droplet_destroyer ) return - - col_loop: do icol=1, state%ncol - vert_loop: do k = top_lev, pver - ! If updated qc (after microphysics) is zero, then ensure updated nc is also zero!! - if ( state%q(icol,k,ixcldliq) + ztodt * ptend%q(icol,k,ixcldliq) < qsmall ) then - ptend%lq(ixnumliq) = .true. ! This is probably already true, but it doesn't - ! hurt to set it. - ptend%q(icol,k,ixnumliq) = -(state%q(icol,k,ixnumliq) / ztodt) - end if - if ( ixnumrain > 0 ) then - ! If updated qr (after microphysics) is zero, then ensure updated nr is also zero!! - if ( state%q(icol,k,ixrain) + ztodt * ptend%q(icol,k,ixrain) < qsmall ) then - ptend%lq(ixnumrain) = .true. ! This is probably already true, but it doesn't - ! hurt to set it. - ptend%q(icol,k,ixnumrain) = -(state%q(icol,k,ixnumrain) / ztodt) - end if - endif ! ixnumrain > 0 - ! If updated qi (after microphysics) is zero, then ensure updated ni is also zero!! - if ( state%q(icol,k,ixcldice) + ztodt * ptend%q(icol,k,ixcldice) < qsmall ) then - ptend%lq(ixnumice) = .true. ! This is probably already true, but it doesn't - ! hurt to set it. - ptend%q(icol,k,ixnumice) = -(state%q(icol,k,ixnumice) / ztodt) - end if - if ( ixnumsnow > 0 ) then - ! If updated qs (after microphysics) is zero, then ensure updated ns is also zero!! - if ( state%q(icol,k,ixsnow) + ztodt * ptend%q(icol,k,ixsnow) < qsmall ) then - ptend%lq(ixnumsnow) = .true. ! This is probably already true, but it doesn't - ! hurt to set it. - ptend%q(icol,k,ixnumsnow) = -(state%q(icol,k,ixnumsnow) / ztodt) - end if - endif ! ixnumsnow > 0 - end do vert_loop - end do col_loop - - return -end subroutine massless_droplet_destroyer - -function p1(tin) result(pout) - real(r8), target, intent(in) :: tin(:) - real(r8), pointer :: pout(:) - pout => tin -end function p1 - -function p2(tin) result(pout) - real(r8), target, intent(in) :: tin(:,:) - real(r8), pointer :: pout(:,:) - pout => tin -end function p2 - -end module micro_mg_cam diff --git a/src/physics/cam/micro_pumas_cam.F90 b/src/physics/cam/micro_pumas_cam.F90 new file mode 100644 index 0000000000..d5f98c9813 --- /dev/null +++ b/src/physics/cam/micro_pumas_cam.F90 @@ -0,0 +1,3694 @@ +module micro_pumas_cam + +!--------------------------------------------------------------------------------- +! +! CAM Interfaces for MG microphysics +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver, pverp, psubcols +use physconst, only: gravit, rair, tmelt, cpair, rh2o, rhoh2o, & + latvap, latice, mwh2o +use phys_control, only: phys_getopts, use_hetfrz_classnuc +use shr_const_mod, only: pi => shr_const_pi +use time_manager, only: get_curr_date, get_curr_calday +use phys_grid, only: get_rlat_all_p, get_rlon_all_p +use orbit, only: zenith + +use physics_types, only: physics_state, physics_ptend, & + physics_ptend_init, physics_state_copy, & + physics_update, physics_state_dealloc, & + physics_ptend_sum, physics_ptend_scale + +use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dyn_time_lvls, & + pbuf_old_tim_idx, pbuf_get_index, dtype_r8, dtype_i4, & + pbuf_get_field, pbuf_set_field, col_type_subcol, & + pbuf_register_subcol +use constituents, only: cnst_add, cnst_get_ind, & + cnst_name, cnst_longname, sflxnam, apcnst, bpcnst, pcnst + +use cldfrc2m, only: rhmini=>rhmini_const + +use cam_history, only: addfld, add_default, outfld, horiz_only + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use error_messages, only: handle_errmsg +use ref_pres, only: top_lev=>trop_cloud_top_lev + +use subcol_utils, only: subcol_get_scheme + +implicit none +private +save + +public :: & + micro_pumas_cam_readnl, & + micro_pumas_cam_register, & + micro_pumas_cam_init_cnst, & + micro_pumas_cam_implements_cnst, & + micro_pumas_cam_init, & + micro_pumas_cam_tend, & + micro_mg_version, & + massless_droplet_destroyer + +integer :: micro_mg_version = 1 ! Version number for MG. +integer :: micro_mg_sub_version = 0 ! Second part of version number. + +real(r8) :: micro_mg_dcs = -1._r8 + +logical :: microp_uniform = .false. +logical :: micro_mg_adjust_cpt = .false. + +logical :: micro_do_massless_droplet_destroyer ! turn on/off destruction of massless droplets + +character(len=16) :: micro_mg_precip_frac_method = 'max_overlap' ! type of precipitation fraction method + +real(r8), parameter :: unset_r8 = huge(1.0_r8) + +! Tunable namelist parameters (set in atm_in) +real(r8) :: micro_mg_berg_eff_factor = unset_r8 ! berg efficiency factor +real(r8) :: micro_mg_accre_enhan_fact = unset_r8 ! accretion enhancment factor +real(r8) :: micro_mg_autocon_fact = unset_r8 ! autoconversion prefactor +real(r8) :: micro_mg_autocon_nd_exp = unset_r8 ! autoconversion nd exponent +real(r8) :: micro_mg_autocon_lwp_exp = unset_r8 ! autoconversion lwp exponent +real(r8) :: micro_mg_homog_size = unset_r8 ! size of freezing homogeneous ice +real(r8) :: micro_mg_vtrmi_factor = unset_r8 ! ice fall speed factor +real(r8) :: micro_mg_effi_factor = unset_r8 ! ice effective radius factor +real(r8) :: micro_mg_iaccr_factor = unset_r8 ! ice accretion of cloud droplet +real(r8) :: micro_mg_max_nicons = unset_r8 ! max allowed ice number concentration + + +logical, public :: do_cldliq ! Prognose cldliq flag +logical, public :: do_cldice ! Prognose cldice flag + +integer :: num_steps ! Number of MG substeps + +integer :: ncnst = 4 ! Number of constituents + +! Namelist variables for option to specify constant cloud droplet/ice number +logical :: micro_mg_nccons = .false. ! set .true. to specify constant cloud droplet number +logical :: micro_mg_nicons = .false. ! set .true. to specify constant cloud ice number +logical :: micro_mg_ngcons = .false. ! set .true. to specify constant graupel/hail number +logical :: micro_mg_nrcons = .false. ! set .true. to specify constant rain number +logical :: micro_mg_nscons = .false. ! set .true. to specify constant snow number + +! parameters for specified ice and droplet number concentration +! note: these are local in-cloud values, not grid-mean +real(r8) :: micro_mg_ncnst = 50.e6_r8 ! constant liquid droplet num concentration (m-3) +real(r8) :: micro_mg_ninst = 0.05e6_r8 ! ice num concentration when nicons=.true. (m-3) +real(r8) :: micro_mg_nrnst = 0.2e6_r8 ! rain num concentration when nrcons=.true. (m-3) +real(r8) :: micro_mg_nsnst = 0.005e6_r8 ! snow num concentration when nscons=.true. (m-3) +real(r8) :: micro_mg_ngnst = 0.0005e6_r8 ! graupel/hail num concentration when ngcons=.true. (m-3) + +logical, public :: micro_mg_do_graupel +logical, public :: micro_mg_do_hail + +! switches for IFS like behavior +logical :: micro_mg_evap_sed_off = .false. ! Turn off evaporation/sublimation based on cloud fraction for sedimenting condensate +logical :: micro_mg_icenuc_rh_off = .false. ! Remove RH conditional from ice nucleation +logical :: micro_mg_icenuc_use_meyers = .false. ! Meyers Ice Nucleation +logical :: micro_mg_evap_scl_ifs = .false. ! Scale evaporation as IFS does +logical :: micro_mg_evap_rhthrsh_ifs = .false. ! Evap RH threhold following IFS +logical :: micro_mg_rainfreeze_ifs = .false. ! Rain freezing at 0C following IFS +logical :: micro_mg_ifs_sed = .false. ! Snow sedimentation = 1 m/s following IFS +logical :: micro_mg_precip_fall_corr = .false. ! Precip fall speed following IFS + +character(len=10), parameter :: & ! Constituent names + cnst_names(10) = (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE', & + 'RAINQM', 'SNOWQM','NUMRAI','NUMSNO','GRAUQM','NUMGRA'/) + +integer :: & + ixq = -1, &! water vapor + ixcldliq = -1, &! cloud liquid amount index + ixcldice = -1, &! cloud ice amount index + ixnumliq = -1, &! cloud liquid number index + ixnumice = -1, &! cloud ice water index + ixrain = -1, &! rain index + ixsnow = -1, &! snow index + ixnumrain = -1, &! rain number index + ixnumsnow = -1, &! snow number index + ixgraupel = -1, &! graupel index + ixnumgraupel = -1 ! graupel number index + +! Physics buffer indices for fields registered by this module +integer :: & + cldo_idx, & + qme_idx, & + prain_idx, & + nevapr_idx, & + wsedl_idx, & + rei_idx, & + sadice_idx, & + sadsnow_idx, & + rel_idx, & + dei_idx, & + mu_idx, & + prer_evap_idx, & + lambdac_idx, & + iciwpst_idx, & + iclwpst_idx, & + des_idx, & + icswp_idx, & + cldfsnow_idx, & + degrau_idx = -1, & + icgrauwp_idx = -1, & + cldfgrau_idx = -1, & + rate1_cw2pr_st_idx = -1, & + ls_flxprc_idx, & + ls_flxsnw_idx, & + relvar_idx, & + cmeliq_idx, & + accre_enhan_idx + +! Fields for UNICON +integer :: & + am_evp_st_idx, &! Evaporation area of stratiform precipitation + evprain_st_idx, &! Evaporation rate of stratiform rain [kg/kg/s]. >= 0. + evpsnow_st_idx ! Evaporation rate of stratiform snow [kg/kg/s]. >= 0. + +! Fields needed as inputs to COSP +integer :: & + ls_mrprc_idx, ls_mrsnw_idx, & + ls_reffrain_idx, ls_reffsnow_idx, & + cv_reffliq_idx, cv_reffice_idx + +! Fields needed by Park macrophysics +integer :: & + cc_t_idx, cc_qv_idx, & + cc_ql_idx, cc_qi_idx, & + cc_nl_idx, cc_ni_idx, & + cc_qlst_idx + +! Used to replace aspects of MG microphysics +! (e.g. by CARMA) +integer :: & + tnd_qsnow_idx = -1, & + tnd_nsnow_idx = -1, & + re_ice_idx = -1 + +! Index fields for precipitation efficiency. +integer :: & + acpr_idx = -1, & + acgcme_idx = -1, & + acnum_idx = -1 + +! Physics buffer indices for fields registered by other modules +integer :: & + ast_idx = -1, & + cld_idx = -1, & + concld_idx = -1, & + prec_dp_idx = -1, & + prec_sh_idx = -1, & + qsatfac_idx = -1 + +! Pbuf fields needed for subcol_SILHS +integer :: & + qrain_idx=-1, qsnow_idx=-1, & + nrain_idx=-1, nsnow_idx=-1, & + qcsedten_idx=-1, qrsedten_idx=-1, & + qisedten_idx=-1, qssedten_idx=-1, & + vtrmc_idx=-1, umr_idx=-1, & + vtrmi_idx=-1, ums_idx=-1, & + qcsevap_idx=-1, qisevap_idx=-1 + +integer :: & + naai_idx = -1, & + naai_hom_idx = -1, & + npccn_idx = -1, & + rndst_idx = -1, & + nacon_idx = -1, & + prec_str_idx = -1, & + snow_str_idx = -1, & + prec_pcw_idx = -1, & + snow_pcw_idx = -1, & + prec_sed_idx = -1, & + snow_sed_idx = -1 + +! pbuf fields for heterogeneous freezing +integer :: & + frzimm_idx = -1, & + frzcnt_idx = -1, & + frzdep_idx = -1 + +logical :: allow_sed_supersat ! allow supersaturated conditions after sedimentation loop +logical :: micro_do_sb_physics = .false. ! do SB 2001 autoconversion and accretion + +integer :: bergso_idx = -1 + +!=============================================================================== +contains +!=============================================================================== + +subroutine micro_pumas_cam_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_real8, & + mpi_logical, mpi_character + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Namelist variables + logical :: micro_mg_do_cldice = .true. ! do_cldice = .true., MG microphysics is prognosing cldice + logical :: micro_mg_do_cldliq = .true. ! do_cldliq = .true., MG microphysics is prognosing cldliq + integer :: micro_mg_num_steps = 1 ! Number of substepping iterations done by MG (1.5 only for now). + + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'micro_pumas_cam_readnl' + + namelist /micro_mg_nl/ micro_mg_version, micro_mg_sub_version, & + micro_mg_do_cldice, micro_mg_do_cldliq, micro_mg_num_steps, & + microp_uniform, micro_mg_dcs, micro_mg_precip_frac_method, & + micro_mg_berg_eff_factor, micro_do_sb_physics, micro_mg_adjust_cpt, & + micro_mg_do_hail, micro_mg_do_graupel, micro_mg_ngcons, micro_mg_ngnst, & + micro_mg_vtrmi_factor, micro_mg_effi_factor, micro_mg_iaccr_factor, & + micro_mg_max_nicons, micro_mg_accre_enhan_fact, & + micro_mg_autocon_fact, micro_mg_autocon_nd_exp, micro_mg_autocon_lwp_exp, micro_mg_homog_size, & + micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, micro_mg_ninst, & + micro_mg_nrcons, micro_mg_nscons, micro_mg_nrnst, micro_mg_nsnst, & + micro_do_massless_droplet_destroyer, & + micro_mg_evap_sed_off, micro_mg_icenuc_rh_off, micro_mg_icenuc_use_meyers, & + micro_mg_evap_scl_ifs, micro_mg_evap_rhthrsh_ifs, & + micro_mg_rainfreeze_ifs, micro_mg_ifs_sed, micro_mg_precip_fall_corr + + + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'micro_mg_nl', status=ierr) + if (ierr == 0) then + read(unitn, micro_mg_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + ! set local variables + do_cldice = micro_mg_do_cldice + do_cldliq = micro_mg_do_cldliq + num_steps = micro_mg_num_steps + + ! Verify that version numbers are valid. + select case (micro_mg_version) + case (1) + select case (micro_mg_sub_version) + case(0) + ! MG version 1.0 + case default + call bad_version_endrun() + end select + case (2) + select case (micro_mg_sub_version) + case(0) + ! MG version 2.0 + case default + call bad_version_endrun() + end select + case (3) + select case (micro_mg_sub_version) + case(0) + ! MG version 3.0 + case default + call bad_version_endrun() + end select + case default + call bad_version_endrun() + end select + + if (micro_mg_dcs < 0._r8) call endrun( "micro_pumas_cam_readnl: & + µ_mg_dcs has not been set to a valid value.") + + if (micro_mg_version < 3) then + + if(micro_mg_do_graupel .or. micro_mg_do_hail ) then + call endrun ("micro_pumas_cam_readnl: Micro_mg_do_graupel and micro_mg_do_hail & + &must be false for MG versions before MG3.") + end if + + else ! micro_mg_version = 3 or greater + + if(micro_mg_do_graupel .and. micro_mg_do_hail ) then + call endrun ("micro_pumas_cam_readnl: Only one of micro_mg_do_graupel or & + µ_mg_do_hail may be true at a time.") + end if + + end if + + end if + + ! Broadcast namelist variables + call mpi_bcast(micro_mg_version, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_version") + + call mpi_bcast(micro_mg_sub_version, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_sub_version") + + call mpi_bcast(do_cldice, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_cldice") + + call mpi_bcast(do_cldliq, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_cldliq") + + call mpi_bcast(num_steps, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: num_steps") + + call mpi_bcast(microp_uniform, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: microp_uniform") + + call mpi_bcast(micro_mg_dcs, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_dcs") + + call mpi_bcast(micro_mg_berg_eff_factor, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_berg_eff_factor") + + call mpi_bcast(micro_mg_accre_enhan_fact, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_accre_enhan_fact") + + call mpi_bcast(micro_mg_autocon_fact, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_autocon_fact") + + call mpi_bcast(micro_mg_autocon_nd_exp, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_autocon_nd_exp") + + call mpi_bcast(micro_mg_autocon_lwp_exp, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_autocon_lwp_exp") + + call mpi_bcast(micro_mg_homog_size, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_homog_size") + + call mpi_bcast(micro_mg_vtrmi_factor, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_vtrmi_factor") + + call mpi_bcast(micro_mg_effi_factor, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_effi_factor") + + call mpi_bcast(micro_mg_iaccr_factor, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_iaccr_factor") + + call mpi_bcast(micro_mg_max_nicons, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_max_nicons") + + call mpi_bcast(micro_mg_precip_frac_method, 16, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_precip_frac_method") + + call mpi_bcast(micro_do_sb_physics, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_do_sb_physics") + + call mpi_bcast(micro_mg_adjust_cpt, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_adjust_cpt") + + call mpi_bcast(micro_mg_nccons, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nccons") + + call mpi_bcast(micro_mg_nicons, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nicons") + + call mpi_bcast(micro_mg_nrcons, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nrcons") + + call mpi_bcast(micro_mg_nscons, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nscons") + + call mpi_bcast(micro_mg_ncnst, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ncnst") + + call mpi_bcast(micro_mg_ninst, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ninst") + + call mpi_bcast(micro_mg_nrnst, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nrnst") + + call mpi_bcast(micro_mg_nsnst, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nsnst") + + call mpi_bcast(micro_mg_do_hail, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_do_hail") + + call mpi_bcast(micro_mg_do_graupel, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_do_graupel") + + call mpi_bcast(micro_mg_ngcons, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ngcons") + + call mpi_bcast(micro_mg_ngnst, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ngnst") + + call mpi_bcast(micro_do_massless_droplet_destroyer, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_do_massless_droplet_destroyer") + + call mpi_bcast(micro_mg_evap_sed_off, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_evap_sed_off") + + call mpi_bcast(micro_mg_icenuc_rh_off, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_icenuc_rh_off") + + call mpi_bcast(micro_mg_icenuc_use_meyers, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_icenuc_use_meyers") + + call mpi_bcast(micro_mg_evap_scl_ifs, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_evap_scl_ifs") + + call mpi_bcast(micro_mg_evap_rhthrsh_ifs, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_evap_rhthrsh_ifs") + + call mpi_bcast(micro_mg_rainfreeze_ifs, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_rainfreeze_ifs") + + call mpi_bcast(micro_mg_ifs_sed, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ifs_sed") + + call mpi_bcast(micro_mg_precip_fall_corr, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_precip_fall_corr") + + if(micro_mg_berg_eff_factor == unset_r8) call endrun(sub//": FATAL: micro_mg_berg_eff_factor is not set") + if(micro_mg_accre_enhan_fact == unset_r8) call endrun(sub//": FATAL: micro_mg_accre_enhan_fact is not set") + if(micro_mg_autocon_fact == unset_r8) call endrun(sub//": FATAL: micro_mg_autocon_fact is not set") + if(micro_mg_autocon_nd_exp == unset_r8) call endrun(sub//": FATAL: micro_mg_autocon_nd_exp is not set") + if(micro_mg_autocon_lwp_exp == unset_r8) call endrun(sub//": FATAL: micro_mg_autocon_lwp_exp is not set") + if(micro_mg_homog_size == unset_r8) call endrun(sub//": FATAL: micro_mg_homog_size is not set") + if(micro_mg_vtrmi_factor == unset_r8) call endrun(sub//": FATAL: micro_mg_vtrmi_factor is not set") + if(micro_mg_effi_factor == unset_r8) call endrun(sub//": FATAL: micro_mg_effi_factor is not set") + if(micro_mg_iaccr_factor == unset_r8) call endrun(sub//": FATAL: micro_mg_iaccr_factor is not set") + if(micro_mg_max_nicons == unset_r8) call endrun(sub//": FATAL: micro_mg_max_nicons is not set") + + if (masterproc) then + + write(iulog,*) 'MG microphysics namelist:' + write(iulog,*) ' micro_mg_version = ', micro_mg_version + write(iulog,*) ' micro_mg_sub_version = ', micro_mg_sub_version + write(iulog,*) ' micro_mg_do_cldice = ', do_cldice + write(iulog,*) ' micro_mg_do_cldliq = ', do_cldliq + write(iulog,*) ' micro_mg_num_steps = ', num_steps + write(iulog,*) ' microp_uniform = ', microp_uniform + write(iulog,*) ' micro_mg_dcs = ', micro_mg_dcs + write(iulog,*) ' micro_mg_berg_eff_factor = ', micro_mg_berg_eff_factor + write(iulog,*) ' micro_mg_accre_enhan_fact = ', micro_mg_accre_enhan_fact + write(iulog,*) ' micro_mg_autocon_fact = ' , micro_mg_autocon_fact + write(iulog,*) ' micro_mg_autocon_nd_exp = ' , micro_mg_autocon_nd_exp + write(iulog,*) ' micro_mg_autocon_lwp_exp = ' , micro_mg_autocon_lwp_exp + write(iulog,*) ' micro_mg_homog_size = ', micro_mg_homog_size + write(iulog,*) ' micro_mg_vtrmi_factor = ', micro_mg_vtrmi_factor + write(iulog,*) ' micro_mg_effi_factor = ', micro_mg_effi_factor + write(iulog,*) ' micro_mg_iaccr_factor = ', micro_mg_iaccr_factor + write(iulog,*) ' micro_mg_max_nicons = ', micro_mg_max_nicons + write(iulog,*) ' micro_mg_precip_frac_method = ', micro_mg_precip_frac_method + write(iulog,*) ' micro_do_sb_physics = ', micro_do_sb_physics + write(iulog,*) ' micro_mg_adjust_cpt = ', micro_mg_adjust_cpt + write(iulog,*) ' micro_mg_nccons = ', micro_mg_nccons + write(iulog,*) ' micro_mg_nicons = ', micro_mg_nicons + write(iulog,*) ' micro_mg_ncnst = ', micro_mg_ncnst + write(iulog,*) ' micro_mg_ninst = ', micro_mg_ninst + write(iulog,*) ' micro_mg_ngcons = ', micro_mg_ngcons + write(iulog,*) ' micro_mg_ngnst = ', micro_mg_ngnst + write(iulog,*) ' micro_mg_do_hail = ', micro_mg_do_hail + write(iulog,*) ' micro_mg_do_graupel = ', micro_mg_do_graupel + write(iulog,*) ' micro_do_massless_droplet_destroyer = ', micro_do_massless_droplet_destroyer + write(iulog,*) ' micro_mg_nrcons = ', micro_mg_nrcons + write(iulog,*) ' micro_mg_nscons = ', micro_mg_nscons + write(iulog,*) ' micro_mg_nrnst = ', micro_mg_nrnst + write(iulog,*) ' micro_mg_nsnst = ', micro_mg_nsnst + write(iulog,*) ' micro_mg_evap_sed_off = ', micro_mg_evap_sed_off + write(iulog,*) ' micro_mg_icenuc_rh_off = ', micro_mg_icenuc_rh_off + write(iulog,*) ' micro_mg_icenuc_use_meyers = ', micro_mg_icenuc_use_meyers + write(iulog,*) ' micro_mg_evap_scl_ifs = ', micro_mg_evap_scl_ifs + write(iulog,*) ' micro_mg_evap_rhthrsh_ifs = ', micro_mg_evap_rhthrsh_ifs + write(iulog,*) ' micro_mg_rainfreeze_ifs = ', micro_mg_rainfreeze_ifs + write(iulog,*) ' micro_mg_ifs_sed = ', micro_mg_ifs_sed + write(iulog,*) ' micro_mg_precip_fall_corr = ', micro_mg_precip_fall_corr + end if + +contains + + subroutine bad_version_endrun + ! Endrun wrapper with a more useful error message. + character(len=128) :: errstring + write(errstring,*) "Invalid version number specified for MG microphysics: ", & + micro_mg_version,".",micro_mg_sub_version + call endrun(errstring) + end subroutine bad_version_endrun + +end subroutine micro_pumas_cam_readnl + +!================================================================================================ + +subroutine micro_pumas_cam_register + + ! Register microphysics constituents and fields in the physics buffer. + !----------------------------------------------------------------------- + + logical :: prog_modal_aero + logical :: use_subcol_microp ! If true, then are using subcolumns in microphysics + + call phys_getopts(use_subcol_microp_out = use_subcol_microp, & + prog_modal_aero_out = prog_modal_aero) + + ! Register microphysics constituents and save indices. + + call cnst_add(cnst_names(1), mwh2o, cpair, 0._r8, ixcldliq, & + longname='Grid box averaged cloud liquid amount', is_convtran1=.true.) + call cnst_add(cnst_names(2), mwh2o, cpair, 0._r8, ixcldice, & + longname='Grid box averaged cloud ice amount', is_convtran1=.true.) + + call cnst_add(cnst_names(3), mwh2o, cpair, 0._r8, ixnumliq, & + longname='Grid box averaged cloud liquid number', is_convtran1=.true.) + call cnst_add(cnst_names(4), mwh2o, cpair, 0._r8, ixnumice, & + longname='Grid box averaged cloud ice number', is_convtran1=.true.) + + ! Note is_convtran1 is set to .true. + if (micro_mg_version > 1) then + call cnst_add(cnst_names(5), mwh2o, cpair, 0._r8, ixrain, & + longname='Grid box averaged rain amount', is_convtran1=.true.) + call cnst_add(cnst_names(6), mwh2o, cpair, 0._r8, ixsnow, & + longname='Grid box averaged snow amount', is_convtran1=.true.) + call cnst_add(cnst_names(7), mwh2o, cpair, 0._r8, ixnumrain, & + longname='Grid box averaged rain number', is_convtran1=.true.) + call cnst_add(cnst_names(8), mwh2o, cpair, 0._r8, ixnumsnow, & + longname='Grid box averaged snow number', is_convtran1=.true.) + end if + + if (micro_mg_version > 2) then + call cnst_add(cnst_names(9), mwh2o, cpair, 0._r8, ixgraupel, & + longname='Grid box averaged graupel/hail amount', is_convtran1=.true.) + call cnst_add(cnst_names(10), mwh2o, cpair, 0._r8, ixnumgraupel, & + longname='Grid box averaged graupel/hail number', is_convtran1=.true.) + end if + + ! Request physics buffer space for fields that persist across timesteps. + + call pbuf_add_field('CLDO','global',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldo_idx) + + ! Physics buffer variables for convective cloud properties. + + call pbuf_add_field('QME', 'physpkg',dtype_r8,(/pcols,pver/), qme_idx) + call pbuf_add_field('PRAIN', 'physpkg',dtype_r8,(/pcols,pver/), prain_idx) + call pbuf_add_field('NEVAPR', 'physpkg',dtype_r8,(/pcols,pver/), nevapr_idx) + call pbuf_add_field('PRER_EVAP', 'global', dtype_r8,(/pcols,pver/), prer_evap_idx) + call pbuf_add_field('BERGSO', 'physpkg',dtype_r8,(/pcols,pver/), bergso_idx) + + call pbuf_add_field('WSEDL', 'physpkg',dtype_r8,(/pcols,pver/), wsedl_idx) + + call pbuf_add_field('REI', 'physpkg',dtype_r8,(/pcols,pver/), rei_idx) + call pbuf_add_field('SADICE', 'physpkg',dtype_r8,(/pcols,pver/), sadice_idx) + call pbuf_add_field('SADSNOW', 'physpkg',dtype_r8,(/pcols,pver/), sadsnow_idx) + call pbuf_add_field('REL', 'physpkg',dtype_r8,(/pcols,pver/), rel_idx) + + ! Mitchell ice effective diameter for radiation + call pbuf_add_field('DEI', 'physpkg',dtype_r8,(/pcols,pver/), dei_idx) + ! Size distribution shape parameter for radiation + call pbuf_add_field('MU', 'physpkg',dtype_r8,(/pcols,pver/), mu_idx) + ! Size distribution shape parameter for radiation + call pbuf_add_field('LAMBDAC', 'physpkg',dtype_r8,(/pcols,pver/), lambdac_idx) + + ! Stratiform only in cloud ice water path for radiation + call pbuf_add_field('ICIWPST', 'physpkg',dtype_r8,(/pcols,pver/), iciwpst_idx) + ! Stratiform in cloud liquid water path for radiation + call pbuf_add_field('ICLWPST', 'physpkg',dtype_r8,(/pcols,pver/), iclwpst_idx) + + ! Snow effective diameter for radiation + call pbuf_add_field('DES', 'physpkg',dtype_r8,(/pcols,pver/), des_idx) + ! In cloud snow water path for radiation + call pbuf_add_field('ICSWP', 'physpkg',dtype_r8,(/pcols,pver/), icswp_idx) + ! Cloud fraction for liquid drops + snow + call pbuf_add_field('CLDFSNOW ', 'physpkg',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldfsnow_idx) + + if (micro_mg_version > 2) then + ! Graupel effective diameter for radiation + call pbuf_add_field('DEGRAU', 'physpkg',dtype_r8,(/pcols,pver/), degrau_idx) + ! In cloud snow water path for radiation + call pbuf_add_field('ICGRAUWP', 'physpkg',dtype_r8,(/pcols,pver/), icgrauwp_idx) + ! Cloud fraction for liquid drops + graupel + call pbuf_add_field('CLDFGRAU', 'physpkg',dtype_r8,(/pcols,pver/), cldfgrau_idx) + end if + + if (prog_modal_aero) then + call pbuf_add_field('RATE1_CW2PR_ST','physpkg',dtype_r8,(/pcols,pver/), rate1_cw2pr_st_idx) + endif + + call pbuf_add_field('LS_FLXPRC', 'physpkg',dtype_r8,(/pcols,pverp/), ls_flxprc_idx) + call pbuf_add_field('LS_FLXSNW', 'physpkg',dtype_r8,(/pcols,pverp/), ls_flxsnw_idx) + + + ! Fields needed as inputs to COSP + call pbuf_add_field('LS_MRPRC', 'physpkg',dtype_r8,(/pcols,pver/), ls_mrprc_idx) + call pbuf_add_field('LS_MRSNW', 'physpkg',dtype_r8,(/pcols,pver/), ls_mrsnw_idx) + call pbuf_add_field('LS_REFFRAIN','physpkg',dtype_r8,(/pcols,pver/), ls_reffrain_idx) + call pbuf_add_field('LS_REFFSNOW','physpkg',dtype_r8,(/pcols,pver/), ls_reffsnow_idx) + call pbuf_add_field('CV_REFFLIQ', 'physpkg',dtype_r8,(/pcols,pver/), cv_reffliq_idx) + call pbuf_add_field('CV_REFFICE', 'physpkg',dtype_r8,(/pcols,pver/), cv_reffice_idx) + + ! CC_* Fields needed by Park macrophysics + call pbuf_add_field('CC_T', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_t_idx) + call pbuf_add_field('CC_qv', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qv_idx) + call pbuf_add_field('CC_ql', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_ql_idx) + call pbuf_add_field('CC_qi', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qi_idx) + call pbuf_add_field('CC_nl', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_nl_idx) + call pbuf_add_field('CC_ni', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_ni_idx) + call pbuf_add_field('CC_qlst', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qlst_idx) + + ! Fields for UNICON + call pbuf_add_field('am_evp_st', 'global', dtype_r8, (/pcols,pver/), am_evp_st_idx) + call pbuf_add_field('evprain_st', 'global', dtype_r8, (/pcols,pver/), evprain_st_idx) + call pbuf_add_field('evpsnow_st', 'global', dtype_r8, (/pcols,pver/), evpsnow_st_idx) + + ! Register subcolumn pbuf fields + if (use_subcol_microp) then + ! Global pbuf fields + call pbuf_register_subcol('CLDO', 'micro_pumas_cam_register', cldo_idx) + + ! CC_* Fields needed by Park macrophysics + call pbuf_register_subcol('CC_T', 'micro_pumas_cam_register', cc_t_idx) + call pbuf_register_subcol('CC_qv', 'micro_pumas_cam_register', cc_qv_idx) + call pbuf_register_subcol('CC_ql', 'micro_pumas_cam_register', cc_ql_idx) + call pbuf_register_subcol('CC_qi', 'micro_pumas_cam_register', cc_qi_idx) + call pbuf_register_subcol('CC_nl', 'micro_pumas_cam_register', cc_nl_idx) + call pbuf_register_subcol('CC_ni', 'micro_pumas_cam_register', cc_ni_idx) + call pbuf_register_subcol('CC_qlst', 'micro_pumas_cam_register', cc_qlst_idx) + + ! Physpkg pbuf fields + ! Physics buffer variables for convective cloud properties. + + call pbuf_register_subcol('QME', 'micro_pumas_cam_register', qme_idx) + call pbuf_register_subcol('PRAIN', 'micro_pumas_cam_register', prain_idx) + call pbuf_register_subcol('NEVAPR', 'micro_pumas_cam_register', nevapr_idx) + call pbuf_register_subcol('PRER_EVAP', 'micro_pumas_cam_register', prer_evap_idx) + call pbuf_register_subcol('BERGSO', 'micro_pumas_cam_register', bergso_idx) + + call pbuf_register_subcol('WSEDL', 'micro_pumas_cam_register', wsedl_idx) + + call pbuf_register_subcol('REI', 'micro_pumas_cam_register', rei_idx) + call pbuf_register_subcol('SADICE', 'micro_pumas_cam_register', sadice_idx) + call pbuf_register_subcol('SADSNOW', 'micro_pumas_cam_register', sadsnow_idx) + call pbuf_register_subcol('REL', 'micro_pumas_cam_register', rel_idx) + + ! Mitchell ice effective diameter for radiation + call pbuf_register_subcol('DEI', 'micro_pumas_cam_register', dei_idx) + ! Size distribution shape parameter for radiation + call pbuf_register_subcol('MU', 'micro_pumas_cam_register', mu_idx) + ! Size distribution shape parameter for radiation + call pbuf_register_subcol('LAMBDAC', 'micro_pumas_cam_register', lambdac_idx) + + ! Stratiform only in cloud ice water path for radiation + call pbuf_register_subcol('ICIWPST', 'micro_pumas_cam_register', iciwpst_idx) + ! Stratiform in cloud liquid water path for radiation + call pbuf_register_subcol('ICLWPST', 'micro_pumas_cam_register', iclwpst_idx) + + ! Snow effective diameter for radiation + call pbuf_register_subcol('DES', 'micro_pumas_cam_register', des_idx) + ! In cloud snow water path for radiation + call pbuf_register_subcol('ICSWP', 'micro_pumas_cam_register', icswp_idx) + ! Cloud fraction for liquid drops + snow + call pbuf_register_subcol('CLDFSNOW ', 'micro_pumas_cam_register', cldfsnow_idx) + + if (micro_mg_version > 2) then + ! Graupel effective diameter for radiation + call pbuf_register_subcol('DEGRAU', 'micro_pumas_cam_register', degrau_idx) + ! In cloud snow water path for radiation + call pbuf_register_subcol('ICGRAUWP', 'micro_pumas_cam_register', icgrauwp_idx) + ! Cloud fraction for liquid drops + snow + call pbuf_register_subcol('CLDFGRAU', 'micro_pumas_cam_register', cldfgrau_idx) + end if + + if (prog_modal_aero) then + call pbuf_register_subcol('RATE1_CW2PR_ST', 'micro_pumas_cam_register', rate1_cw2pr_st_idx) + end if + + call pbuf_register_subcol('LS_FLXPRC', 'micro_pumas_cam_register', ls_flxprc_idx) + call pbuf_register_subcol('LS_FLXSNW', 'micro_pumas_cam_register', ls_flxsnw_idx) + + ! Fields needed as inputs to COSP + call pbuf_register_subcol('LS_MRPRC', 'micro_pumas_cam_register', ls_mrprc_idx) + call pbuf_register_subcol('LS_MRSNW', 'micro_pumas_cam_register', ls_mrsnw_idx) + call pbuf_register_subcol('LS_REFFRAIN', 'micro_pumas_cam_register', ls_reffrain_idx) + call pbuf_register_subcol('LS_REFFSNOW', 'micro_pumas_cam_register', ls_reffsnow_idx) + call pbuf_register_subcol('CV_REFFLIQ', 'micro_pumas_cam_register', cv_reffliq_idx) + call pbuf_register_subcol('CV_REFFICE', 'micro_pumas_cam_register', cv_reffice_idx) + end if + + ! Additional pbuf for CARMA interface + if (.not. do_cldice) then + call pbuf_add_field('TND_QSNOW', 'physpkg',dtype_r8,(/pcols,pver/), tnd_qsnow_idx) + call pbuf_add_field('TND_NSNOW', 'physpkg',dtype_r8,(/pcols,pver/), tnd_nsnow_idx) + call pbuf_add_field('RE_ICE', 'physpkg',dtype_r8,(/pcols,pver/), re_ice_idx) + end if + + ! Precipitation efficiency fields across timesteps. + call pbuf_add_field('ACPRECL', 'global',dtype_r8,(/pcols/), acpr_idx) ! accumulated precip + call pbuf_add_field('ACGCME', 'global',dtype_r8,(/pcols/), acgcme_idx) ! accumulated condensation + call pbuf_add_field('ACNUM', 'global',dtype_i4,(/pcols/), acnum_idx) ! counter for accumulated # timesteps + + ! SGS variability -- These could be reset by CLUBB so they need to be grid only + call pbuf_add_field('RELVAR', 'global',dtype_r8,(/pcols,pver/), relvar_idx) + call pbuf_add_field('ACCRE_ENHAN','global',dtype_r8,(/pcols,pver/), accre_enhan_idx) + + ! Diagnostic fields needed for subcol_SILHS, need to be grid-only + if (subcol_get_scheme() == 'SILHS') then + call pbuf_add_field('QRAIN', 'global',dtype_r8,(/pcols,pver/), qrain_idx) + call pbuf_add_field('QSNOW', 'global',dtype_r8,(/pcols,pver/), qsnow_idx) + call pbuf_add_field('NRAIN', 'global',dtype_r8,(/pcols,pver/), nrain_idx) + call pbuf_add_field('NSNOW', 'global',dtype_r8,(/pcols,pver/), nsnow_idx) + ! Fields for subcol_SILHS hole filling + call pbuf_add_field('QCSEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qcsedten_idx) + if (micro_mg_version > 1) then + call pbuf_add_field('QRSEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qrsedten_idx) + endif + call pbuf_add_field('QISEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qisedten_idx) + if (micro_mg_version > 1) then + call pbuf_add_field('QSSEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qssedten_idx) + endif + call pbuf_add_field('VTRMC', 'physpkg', dtype_r8, (/pcols,pver/), vtrmc_idx) + if (micro_mg_version > 1) then + call pbuf_add_field('UMR', 'physpkg', dtype_r8, (/pcols,pver/), umr_idx) + endif + call pbuf_add_field('VTRMI', 'physpkg', dtype_r8, (/pcols,pver/), vtrmi_idx) + if (micro_mg_version > 1) then + call pbuf_add_field('UMS', 'physpkg', dtype_r8, (/pcols,pver/), ums_idx) + endif + call pbuf_add_field('QCSEVAP', 'physpkg', dtype_r8, (/pcols,pver/), qcsevap_idx) + call pbuf_add_field('QISEVAP', 'physpkg', dtype_r8, (/pcols,pver/), qisevap_idx) + end if + +end subroutine micro_pumas_cam_register + +!=============================================================================== + +function micro_pumas_cam_implements_cnst(name) + + ! Return true if specified constituent is implemented by the + ! microphysics package + + character(len=*), intent(in) :: name ! constituent name + logical :: micro_pumas_cam_implements_cnst ! return value + + !----------------------------------------------------------------------- + + micro_pumas_cam_implements_cnst = any(name == cnst_names) + +end function micro_pumas_cam_implements_cnst + +!=============================================================================== + +subroutine micro_pumas_cam_init_cnst(name, latvals, lonvals, mask, q) + + ! Initialize the microphysics constituents, if they are + ! not read from the initial file. + + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev + !----------------------------------------------------------------------- + integer :: k + + if (micro_pumas_cam_implements_cnst(name)) then + do k = 1, size(q, 2) + where(mask) + q(:, k) = 0.0_r8 + end where + end do + end if + +end subroutine micro_pumas_cam_init_cnst + +!=============================================================================== + +subroutine micro_pumas_cam_init(pbuf2d) + use time_manager, only: is_first_step + use micro_pumas_utils, only: micro_pumas_utils_init + use micro_mg1_0, only: micro_mg_init1_0 => micro_mg_init + use micro_pumas_v1, only: micro_mg_init3_0 => micro_pumas_init + + !----------------------------------------------------------------------- + ! + ! Initialization for MG microphysics + ! + !----------------------------------------------------------------------- + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: m, mm + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: history_budget ! Output tendencies and state variables for CAM4 + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. + logical :: use_subcol_microp + logical :: do_clubb_sgs + integer :: budget_histfile ! output history file number for budget fields + integer :: ierr + character(128) :: errstring ! return status (non-blank for error return) + + !----------------------------------------------------------------------- + + call phys_getopts(use_subcol_microp_out=use_subcol_microp, & + do_clubb_sgs_out =do_clubb_sgs) + + if (do_clubb_sgs) then + allow_sed_supersat = .false. + else + allow_sed_supersat = .true. + endif + + if (masterproc) then + write(iulog,"(A,I2,A,I2)") "Initializing MG version ",micro_mg_version,".",micro_mg_sub_version + if (.not. do_cldliq) & + write(iulog,*) "MG prognostic cloud liquid has been turned off via namelist." + if (.not. do_cldice) & + write(iulog,*) "MG prognostic cloud ice has been turned off via namelist." + write(iulog,*) "Number of microphysics substeps is: ",num_steps + end if + + select case (micro_mg_version) + case (1) + ! Set constituent number for later loops. + ncnst = 4 + + select case (micro_mg_sub_version) + case (0) + ! MG 1 does not initialize micro_mg_utils, so have to do it here. + call micro_pumas_utils_init(r8, rair, rh2o, cpair, tmelt, latvap, latice, & + micro_mg_dcs, errstring) + + call handle_errmsg(errstring, subname="micro_pumas_utils_init") + + call micro_mg_init1_0( & + r8, gravit, rair, rh2o, cpair, & + rhoh2o, tmelt, latvap, latice, & + rhmini, micro_mg_dcs, use_hetfrz_classnuc, & + micro_mg_precip_frac_method, micro_mg_berg_eff_factor, & + micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, & + micro_mg_ninst, errstring) + end select + case (2:3) + ! Set constituent number for later loops. + if(micro_mg_version == 2) then + ncnst = 8 + else + ncnst = 10 + end if + + call micro_mg_init3_0( & + r8, gravit, rair, rh2o, cpair, & + tmelt, latvap, latice, rhmini, & + micro_mg_dcs, & + micro_mg_do_hail,micro_mg_do_graupel, & + microp_uniform, do_cldice, use_hetfrz_classnuc, & + micro_mg_precip_frac_method, micro_mg_berg_eff_factor, & + micro_mg_accre_enhan_fact , & + micro_mg_autocon_fact , micro_mg_autocon_nd_exp, micro_mg_autocon_lwp_exp, micro_mg_homog_size, & + micro_mg_vtrmi_factor, micro_mg_effi_factor, micro_mg_iaccr_factor, & + micro_mg_max_nicons, & + allow_sed_supersat, micro_do_sb_physics, & + micro_mg_evap_sed_off, micro_mg_icenuc_rh_off, micro_mg_icenuc_use_meyers, & + micro_mg_evap_scl_ifs, micro_mg_evap_rhthrsh_ifs, & + micro_mg_rainfreeze_ifs, micro_mg_ifs_sed, micro_mg_precip_fall_corr,& + micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, & + micro_mg_ninst, micro_mg_ngcons, micro_mg_ngnst, & + micro_mg_nrcons, micro_mg_nrnst, micro_mg_nscons, micro_mg_nsnst, errstring) + end select + + call handle_errmsg(errstring, subname="micro_mg_init") + + ! Retrieve the index for water vapor + call cnst_get_ind('Q', ixq) + + ! Register history variables + do m = 1, ncnst + call cnst_get_ind(cnst_names(m), mm) + if ( any(mm == (/ ixcldliq, ixcldice, ixrain, ixsnow, ixgraupel /)) ) then + ! mass mixing ratios + call addfld(cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(mm), sampled_on_subcycle=.true.) + call addfld(sflxnam(mm), horiz_only, 'A', 'kg/m2/s', trim(cnst_name(mm))//' surface flux', sampled_on_subcycle=.true.) + else if ( any(mm == (/ ixnumliq, ixnumice, ixnumrain, ixnumsnow, ixnumgraupel /)) ) then + ! number concentrations + call addfld(cnst_name(mm), (/ 'lev' /), 'A', '1/kg', cnst_longname(mm), sampled_on_subcycle=.true.) + call addfld(sflxnam(mm), horiz_only, 'A', '1/m2/s', trim(cnst_name(mm))//' surface flux', sampled_on_subcycle=.true.) + else + call endrun( "micro_pumas_cam_init: & + &Could not call addfld for constituent with unknown units.") + endif + end do + + call addfld(apcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' after physics', sampled_on_subcycle=.true.) + call addfld(apcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' after physics', sampled_on_subcycle=.true.) + call addfld(bpcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' before physics', sampled_on_subcycle=.true.) + call addfld(bpcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' before physics', sampled_on_subcycle=.true.) + + if (micro_mg_version > 1) then + call addfld(apcnst(ixrain), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixrain))//' after physics', sampled_on_subcycle=.true.) + call addfld(apcnst(ixsnow), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' after physics', sampled_on_subcycle=.true.) + call addfld(bpcnst(ixrain), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixrain))//' before physics', sampled_on_subcycle=.true.) + call addfld(bpcnst(ixsnow), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' before physics', sampled_on_subcycle=.true.) + end if + + if (micro_mg_version > 2) then + call addfld(apcnst(ixgraupel), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixgraupel))//' after physics', sampled_on_subcycle=.true.) + call addfld(bpcnst(ixgraupel), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixgraupel))//' before physics', sampled_on_subcycle=.true.) + end if + + call addfld ('CME', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap within the cloud', sampled_on_subcycle=.true.) + call addfld ('PRODPREC', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of conversion of condensate to precip', sampled_on_subcycle=.true.) + call addfld ('EVAPPREC', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling precip', sampled_on_subcycle=.true.) + call addfld ('EVAPSNOW', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling snow', sampled_on_subcycle=.true.) + call addfld ('HPROGCLD', (/ 'lev' /), 'A', 'W/kg' , 'Heating from prognostic clouds', sampled_on_subcycle=.true.) + call addfld ('FICE', (/ 'lev' /), 'A', 'fraction', 'Fractional ice content within cloud', sampled_on_subcycle=.true.) + call addfld ('CLDFSNOW', (/ 'lev' /), 'A', '1', 'Cloud fraction adjusted for snow', sampled_on_subcycle=.true.) + call addfld ('ICWMRST', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-stratus water mixing ratio', sampled_on_subcycle=.true.) + call addfld ('ICIMRST', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-stratus ice mixing ratio', sampled_on_subcycle=.true.) + + ! MG microphysics diagnostics + call addfld ('QCSEVAP', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling cloud water', sampled_on_subcycle=.true.) + call addfld ('QISEVAP', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of sublimation of falling cloud ice', sampled_on_subcycle=.true.) + call addfld ('QVRES', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of residual condensation term', sampled_on_subcycle=.true.) + call addfld ('CMEIOUT', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of deposition/sublimation of cloud ice',sampled_on_subcycle=.true.) + call addfld ('VTRMC', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted cloud water fallspeed', sampled_on_subcycle=.true.) + call addfld ('VTRMI', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted cloud ice fallspeed', sampled_on_subcycle=.true.) + call addfld ('QCSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud water mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.) + call addfld ('QISEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.) + call addfld ('PRAO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud water by rain', sampled_on_subcycle=.true.) + call addfld ('PRCO', (/ 'lev' /), 'A', 'kg/kg/s', 'Autoconversion of cloud water', sampled_on_subcycle=.true.) + call addfld ('MNUCCCO', (/ 'lev' /), 'A', 'kg/kg/s', 'Immersion freezing of cloud water', sampled_on_subcycle=.true.) + call addfld ('MNUCCTO', (/ 'lev' /), 'A', 'kg/kg/s', 'Contact freezing of cloud water', sampled_on_subcycle=.true.) + call addfld ('MNUCCDO', (/ 'lev' /), 'A', 'kg/kg/s', 'Homogeneous and heterogeneous nucleation from vapor', sampled_on_subcycle=.true.) + call addfld ('MNUCCDOhet', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous nucleation from vapor', sampled_on_subcycle=.true.) + call addfld ('MSACWIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water from rime-splintering', sampled_on_subcycle=.true.) + call addfld ('PSACWSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud water by snow', sampled_on_subcycle=.true.) + call addfld ('BERGSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water to snow from bergeron', sampled_on_subcycle=.true.) + call addfld ('BERGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water to cloud ice from bergeron', sampled_on_subcycle=.true.) + call addfld ('MELTO', (/ 'lev' /), 'A', 'kg/kg/s', 'Melting of cloud ice', sampled_on_subcycle=.true.) + call addfld ('MELTSTOT', (/ 'lev' /), 'A', 'kg/kg/s', 'Melting of snow', sampled_on_subcycle=.true.) + call addfld ('MNUDEPO', (/ 'lev' /), 'A', 'kg/kg/s', 'Deposition Nucleation', sampled_on_subcycle=.true.) + call addfld ('HOMOO', (/ 'lev' /), 'A', 'kg/kg/s', 'Homogeneous freezing of cloud water', sampled_on_subcycle=.true.) + call addfld ('QCRESO', (/ 'lev' /), 'A', 'kg/kg/s', 'Residual condensation term for cloud water', sampled_on_subcycle=.true.) + call addfld ('PRCIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Autoconversion of cloud ice to snow', sampled_on_subcycle=.true.) + call addfld ('PRAIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud ice to snow', sampled_on_subcycle=.true.) + call addfld ('QIRESO', (/ 'lev' /), 'A', 'kg/kg/s', 'Residual deposition term for cloud ice', sampled_on_subcycle=.true.) + call addfld ('MNUCCRO', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous freezing of rain to snow', sampled_on_subcycle=.true.) + call addfld ('MNUCCRIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous freezing of rain to ice', sampled_on_subcycle=.true.) + call addfld ('PRACSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of rain by snow', sampled_on_subcycle=.true.) + call addfld ('MELTSDT', (/ 'lev' /), 'A', 'W/kg', 'Latent heating rate due to melting of snow', sampled_on_subcycle=.true.) + call addfld ('FRZRDT', (/ 'lev' /), 'A', 'W/kg', 'Latent heating rate due to homogeneous freezing of rain', sampled_on_subcycle=.true.) + if (micro_mg_version > 1) then + call addfld ('QRSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Rain mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.) + call addfld ('QSSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Snow mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.) + end if + + + if (micro_mg_version > 2) then + + call addfld ('PSACRO', (/ 'lev' /), 'A', 'kg/kg/s', 'Collisions between rain & snow (Graupel collecting snow)', sampled_on_subcycle=.true.) + call addfld ('PRACGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change in q collection rain by graupel', sampled_on_subcycle=.true.) + call addfld ('PSACWGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change in q collection droplets by graupel', sampled_on_subcycle=.true.) + call addfld ('PGSACWO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q conversion to graupel due to collection droplets by snow', sampled_on_subcycle=.true.) + call addfld ('PGRACSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q conversion to graupel due to collection rain by snow', sampled_on_subcycle=.true.) + call addfld ('PRDGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Deposition of graupel', sampled_on_subcycle=.true.) + call addfld ('QMULTGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q change due to ice mult droplets/graupel', sampled_on_subcycle=.true.) + call addfld ('QMULTRGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q change due to ice mult rain/graupel', sampled_on_subcycle=.true.) + call addfld ('QGSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Graupel/Hail mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.) + call addfld ('NPRACGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change N collection rain by graupel', sampled_on_subcycle=.true.) + call addfld ('NSCNGO', (/'lev'/),'A','kg/kg/s','Change N conversion to graupel due to collection droplets by snow', sampled_on_subcycle=.true.) + call addfld ('NGRACSO',(/'lev'/),'A','kg/kg/s','Change N conversion to graupel due to collection rain by snow', sampled_on_subcycle=.true.) + call addfld ('NMULTGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice mult due to acc droplets by graupel', sampled_on_subcycle=.true.) + call addfld ('NMULTRGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice mult due to acc rain by graupel', sampled_on_subcycle=.true.) + call addfld ('NPSACWGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change N collection droplets by graupel', sampled_on_subcycle=.true.) + call addfld ('CLDFGRAU', (/ 'lev' /), 'A', '1', 'Cloud fraction adjusted for graupel', sampled_on_subcycle=.true.) + call addfld ('MELTGTOT', (/ 'lev' /), 'A', 'kg/kg/s', 'Melting of graupel', sampled_on_subcycle=.true.) + + end if + + call addfld ('RBFRAC', horiz_only, 'A', 'Fraction', 'Fraction of sky covered by a potential rainbow', sampled_on_subcycle=.true.) + call addfld ('RBFREQ', horiz_only, 'A', 'Frequency', 'Potential rainbow frequency', sampled_on_subcycle=.true.) + call addfld( 'rbSZA', horiz_only, 'I', 'degrees', 'solar zenith angle', sampled_on_subcycle=.true.) + + ! History variables for CAM5 microphysics + call addfld ('MPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDNLIQ', (/ 'lev' /), 'A', '1/kg/s', 'NUMLIQ tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDNICE', (/ 'lev' /), 'A', '1/kg/s', 'NUMICE tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDW2V', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Vapor tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDW2I', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Ice tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDW2P', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Precip tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDI2V', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Vapor tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDI2W', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Water tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDI2P', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Precip tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('ICWNC', (/ 'lev' /), 'A', 'm-3', 'Prognostic in-cloud water number conc', sampled_on_subcycle=.true.) + call addfld ('ICINC', (/ 'lev' /), 'A', 'm-3', 'Prognostic in-cloud ice number conc', sampled_on_subcycle=.true.) + call addfld ('EFFLIQ_IND', (/ 'lev' /), 'A','Micron', 'Prognostic droplet effective radius (indirect effect)', sampled_on_subcycle=.true.) + call addfld ('CDNUMC', horiz_only, 'A', '1/m2', 'Vertically-integrated droplet concentration', sampled_on_subcycle=.true.) + call addfld ('MPICLWPI', horiz_only, 'A', 'kg/m2', 'Vertically-integrated & + &in-cloud Initial Liquid WP (Before Micro)', sampled_on_subcycle=.true.) + call addfld ('MPICIWPI', horiz_only, 'A', 'kg/m2', 'Vertically-integrated & + &in-cloud Initial Ice WP (Before Micro)', sampled_on_subcycle=.true.) + + ! This is provided as an example on how to write out subcolumn output + ! NOTE -- only 'I' should be used for sub-column fields as subc-columns could shift from time-step to time-step + if (use_subcol_microp) then + call addfld('FICE_SCOL', (/'psubcols','lev '/), 'I', 'fraction', & + 'Sub-column fractional ice content within cloud', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) + call addfld('MPDICE_SCOL', (/'psubcols','lev '/), 'I', 'kg/kg/s', & + 'Sub-column CLDICE tendency - Morrison microphysics', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) + call addfld('MPDLIQ_SCOL', (/'psubcols','lev '/), 'I', 'kg/kg/s', & + 'Sub-column CLDLIQ tendency - Morrison microphysics', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) + end if + + + ! This is only if the coldpoint temperatures are being adjusted. + ! NOTE: Some fields related to these and output later are added in tropopause.F90. + if (micro_mg_adjust_cpt) then + call addfld ('TROPF_TADJ', (/ 'lev' /), 'A', 'K', 'Temperatures after cold point adjustment', sampled_on_subcycle=.true.) + call addfld ('TROPF_RHADJ', (/ 'lev' /), 'A', 'K', 'Relative Hunidity after cold point adjustment', sampled_on_subcycle=.true.) + call addfld ('TROPF_CDT', horiz_only, 'A', 'K', 'Cold point temperature adjustment', sampled_on_subcycle=.true.) + call addfld ('TROPF_CDZ', horiz_only, 'A', 'm', 'Distance of coldpoint from coldest model level', sampled_on_subcycle=.true.) + end if + + + ! Averaging for cloud particle number and size + call addfld ('AWNC', (/ 'lev' /), 'A', 'm-3', 'Average cloud water number conc', sampled_on_subcycle=.true.) + call addfld ('AWNI', (/ 'lev' /), 'A', 'm-3', 'Average cloud ice number conc', sampled_on_subcycle=.true.) + call addfld ('AREL', (/ 'lev' /), 'A', 'Micron', 'Average droplet effective radius', sampled_on_subcycle=.true.) + call addfld ('AREI', (/ 'lev' /), 'A', 'Micron', 'Average ice effective radius', sampled_on_subcycle=.true.) + ! Frequency arrays for above + call addfld ('FREQL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of liquid', sampled_on_subcycle=.true.) + call addfld ('FREQI', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of ice', sampled_on_subcycle=.true.) + + ! Average cloud top particle size and number (liq, ice) and frequency + call addfld ('ACTREL', horiz_only, 'A', 'Micron', 'Average Cloud Top droplet effective radius', sampled_on_subcycle=.true.) + call addfld ('ACTREI', horiz_only, 'A', 'Micron', 'Average Cloud Top ice effective radius', sampled_on_subcycle=.true.) + call addfld ('ACTNL', horiz_only, 'A', 'm-3', 'Average Cloud Top droplet number', sampled_on_subcycle=.true.) + call addfld ('ACTNI', horiz_only, 'A', 'm-3', 'Average Cloud Top ice number', sampled_on_subcycle=.true.) + + call addfld ('FCTL', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top liquid', sampled_on_subcycle=.true.) + call addfld ('FCTI', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top ice', sampled_on_subcycle=.true.) + + ! New frequency arrays for mixed phase and supercooled liquid (only and mixed) for (a) Cloud Top and (b) everywhere.. + call addfld ('FREQM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of mixed phase', sampled_on_subcycle=.true.) + call addfld ('FREQSL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of only supercooled liquid', sampled_on_subcycle=.true.) + call addfld ('FREQSLM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of super cooled liquid with ice', sampled_on_subcycle=.true.) + call addfld ('FCTM', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top mixed phase', sampled_on_subcycle=.true.) + call addfld ('FCTSL', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top only supercooled liquid', sampled_on_subcycle=.true.) + call addfld ('FCTSLM', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top super cooled liquid with ice', sampled_on_subcycle=.true.) + + call addfld ('LS_FLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface rain+snow flux', sampled_on_subcycle=.true.) + call addfld ('LS_FLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface snow flux', sampled_on_subcycle=.true.) + + call addfld ('REL', (/ 'lev' /), 'A', 'micron', 'MG REL stratiform cloud effective radius liquid', sampled_on_subcycle=.true.) + call addfld ('REI', (/ 'lev' /), 'A', 'micron', 'MG REI stratiform cloud effective radius ice', sampled_on_subcycle=.true.) + call addfld ('LS_REFFRAIN', (/ 'lev' /), 'A', 'micron', 'ls stratiform rain effective radius', sampled_on_subcycle=.true.) + call addfld ('LS_REFFSNOW', (/ 'lev' /), 'A', 'micron', 'ls stratiform snow effective radius', sampled_on_subcycle=.true.) + call addfld ('CV_REFFLIQ', (/ 'lev' /), 'A', 'micron', 'convective cloud liq effective radius', sampled_on_subcycle=.true.) + call addfld ('CV_REFFICE', (/ 'lev' /), 'A', 'micron', 'convective cloud ice effective radius', sampled_on_subcycle=.true.) + call addfld ('MG_SADICE', (/ 'lev' /), 'A', 'cm2/cm3', 'MG surface area density ice', sampled_on_subcycle=.true.) + call addfld ('MG_SADSNOW', (/ 'lev' /), 'A', 'cm2/cm3', 'MG surface area density snow', sampled_on_subcycle=.true.) + + ! diagnostic precip + call addfld ('QRAIN', (/ 'lev' /), 'A', 'kg/kg', 'Diagnostic grid-mean rain mixing ratio', sampled_on_subcycle=.true.) + call addfld ('QSNOW', (/ 'lev' /), 'A', 'kg/kg', 'Diagnostic grid-mean snow mixing ratio', sampled_on_subcycle=.true.) + call addfld ('NRAIN', (/ 'lev' /), 'A', 'm-3', 'Diagnostic grid-mean rain number conc', sampled_on_subcycle=.true.) + call addfld ('NSNOW', (/ 'lev' /), 'A', 'm-3', 'Diagnostic grid-mean snow number conc', sampled_on_subcycle=.true.) + + ! size of precip + call addfld ('RERCLD', (/ 'lev' /), 'A', 'm', 'Diagnostic effective radius of Liquid Cloud and Rain', sampled_on_subcycle=.true.) + call addfld ('DSNOW', (/ 'lev' /), 'A', 'm', 'Diagnostic grid-mean snow diameter', sampled_on_subcycle=.true.) + + ! diagnostic radar reflectivity, cloud-averaged + call addfld ('REFL', (/ 'lev' /), 'A', 'DBz', '94 GHz radar reflectivity', sampled_on_subcycle=.true.) + call addfld ('AREFL', (/ 'lev' /), 'A', 'DBz', 'Average 94 GHz radar reflectivity', sampled_on_subcycle=.true.) + call addfld ('FREFL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of radar reflectivity', sampled_on_subcycle=.true.) + + call addfld ('CSRFL', (/ 'lev' /), 'A', 'DBz', '94 GHz radar reflectivity (CloudSat thresholds)', sampled_on_subcycle=.true.) + call addfld ('ACSRFL', (/ 'lev' /), 'A', 'DBz', 'Average 94 GHz radar reflectivity (CloudSat thresholds)', sampled_on_subcycle=.true.) + call addfld ('FCSRFL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of radar reflectivity (CloudSat thresholds)', sampled_on_subcycle=.true.) + + call addfld ('AREFLZ', (/ 'lev' /), 'A', 'mm^6/m^3', 'Average 94 GHz radar reflectivity', sampled_on_subcycle=.true.) + + ! Aerosol information + call addfld ('NCAL', (/ 'lev' /), 'A', '1/m3', 'Number Concentation Activated for Liquid', sampled_on_subcycle=.true.) + call addfld ('NCAI', (/ 'lev' /), 'A', '1/m3', 'Number Concentation Activated for Ice', sampled_on_subcycle=.true.) + + ! Average rain and snow mixing ratio (Q), number (N) and diameter (D), with frequency + call addfld ('AQRAIN', (/ 'lev' /), 'A', 'kg/kg', 'Average rain mixing ratio', sampled_on_subcycle=.true.) + call addfld ('AQSNOW', (/ 'lev' /), 'A', 'kg/kg', 'Average snow mixing ratio', sampled_on_subcycle=.true.) + call addfld ('ANRAIN', (/ 'lev' /), 'A', 'm-3', 'Average rain number conc', sampled_on_subcycle=.true.) + call addfld ('ANSNOW', (/ 'lev' /), 'A', 'm-3', 'Average snow number conc', sampled_on_subcycle=.true.) + call addfld ('ADRAIN', (/ 'lev' /), 'A', 'm', 'Average rain effective Diameter', sampled_on_subcycle=.true.) + call addfld ('ADSNOW', (/ 'lev' /), 'A', 'm', 'Average snow effective Diameter', sampled_on_subcycle=.true.) + call addfld ('FREQR', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of rain', sampled_on_subcycle=.true.) + call addfld ('FREQS', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of snow', sampled_on_subcycle=.true.) + + ! precipitation efficiency & other diagnostic fields + call addfld('PE' , horiz_only, 'A', '1', 'Stratiform Precipitation Efficiency (precip/cmeliq)', sampled_on_subcycle=.true.) + call addfld('APRL' , horiz_only, 'A', 'm/s', 'Average Stratiform Precip Rate over efficiency calculation', sampled_on_subcycle=.true.) + call addfld('PEFRAC', horiz_only, 'A', '1', 'Fraction of timesteps precip efficiency reported', sampled_on_subcycle=.true.) + call addfld('VPRCO' , horiz_only, 'A', 'kg/kg/s', 'Vertical average of autoconversion rate', sampled_on_subcycle=.true.) + call addfld('VPRAO' , horiz_only, 'A', 'kg/kg/s', 'Vertical average of accretion rate', sampled_on_subcycle=.true.) + call addfld('RACAU' , horiz_only, 'A', 'kg/kg/s', 'Accretion/autoconversion ratio from vertical average', sampled_on_subcycle=.true.) + + if (micro_mg_version > 1) then + call addfld('UMR', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted rain fallspeed', sampled_on_subcycle=.true.) + call addfld('UMS', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted snow fallspeed', sampled_on_subcycle=.true.) + end if + + if (micro_mg_version > 2) then + call addfld('UMG', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted graupel/hail fallspeed', sampled_on_subcycle=.true.) + call addfld ('FREQG', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of Graupel', sampled_on_subcycle=.true.) + call addfld ('LS_REFFGRAU', (/ 'lev' /), 'A', 'micron', 'ls stratiform graupel/hail effective radius', sampled_on_subcycle=.true.) + call addfld ('AQGRAU', (/ 'lev' /), 'A', 'kg/kg', 'Average graupel/hail mixing ratio', sampled_on_subcycle=.true.) + call addfld ('ANGRAU', (/ 'lev' /), 'A', 'm-3', 'Average graupel/hail number conc', sampled_on_subcycle=.true.) + end if + + + ! qc limiter (only output in versions 1.5 and later) + if (.not. (micro_mg_version == 1 .and. micro_mg_sub_version == 0)) then + call addfld('QCRAT', (/ 'lev' /), 'A', 'fraction', 'Qc Limiter: Fraction of qc tendency applied', sampled_on_subcycle=.true.) + end if + + ! determine the add_default fields + call phys_getopts(history_amwg_out = history_amwg , & + history_budget_out = history_budget , & + history_budget_histfile_num_out = budget_histfile) + + if (history_amwg) then + call add_default ('FICE ', 1, ' ') + call add_default ('AQRAIN ', 1, ' ') + call add_default ('AQSNOW ', 1, ' ') + call add_default ('ANRAIN ', 1, ' ') + call add_default ('ANSNOW ', 1, ' ') + call add_default ('ADRAIN ', 1, ' ') + call add_default ('ADSNOW ', 1, ' ') + call add_default ('AREI ', 1, ' ') + call add_default ('AREL ', 1, ' ') + call add_default ('AWNC ', 1, ' ') + call add_default ('AWNI ', 1, ' ') + call add_default ('CDNUMC ', 1, ' ') + call add_default ('FREQR ', 1, ' ') + call add_default ('FREQS ', 1, ' ') + call add_default ('FREQL ', 1, ' ') + call add_default ('FREQI ', 1, ' ') + do m = 1, ncnst + call cnst_get_ind(cnst_names(m), mm) + call add_default(cnst_name(mm), 1, ' ') + end do + end if + + if ( history_budget ) then + call add_default ('EVAPSNOW ', budget_histfile, ' ') + call add_default ('EVAPPREC ', budget_histfile, ' ') + call add_default ('QVRES ', budget_histfile, ' ') + call add_default ('QISEVAP ', budget_histfile, ' ') + call add_default ('QCSEVAP ', budget_histfile, ' ') + call add_default ('QISEDTEN ', budget_histfile, ' ') + call add_default ('QCSEDTEN ', budget_histfile, ' ') + call add_default ('QIRESO ', budget_histfile, ' ') + call add_default ('QCRESO ', budget_histfile, ' ') + if (micro_mg_version > 1) then + call add_default ('QRSEDTEN ', budget_histfile, ' ') + call add_default ('QSSEDTEN ', budget_histfile, ' ') + end if + call add_default ('PSACWSO ', budget_histfile, ' ') + call add_default ('PRCO ', budget_histfile, ' ') + call add_default ('PRCIO ', budget_histfile, ' ') + call add_default ('PRAO ', budget_histfile, ' ') + call add_default ('PRAIO ', budget_histfile, ' ') + call add_default ('PRACSO ', budget_histfile, ' ') + call add_default ('MSACWIO ', budget_histfile, ' ') + call add_default ('MPDW2V ', budget_histfile, ' ') + call add_default ('MPDW2P ', budget_histfile, ' ') + call add_default ('MPDW2I ', budget_histfile, ' ') + call add_default ('MPDT ', budget_histfile, ' ') + call add_default ('MPDQ ', budget_histfile, ' ') + call add_default ('MPDLIQ ', budget_histfile, ' ') + call add_default ('MPDICE ', budget_histfile, ' ') + call add_default ('MPDI2W ', budget_histfile, ' ') + call add_default ('MPDI2V ', budget_histfile, ' ') + call add_default ('MPDI2P ', budget_histfile, ' ') + call add_default ('MNUCCTO ', budget_histfile, ' ') + call add_default ('MNUCCRO ', budget_histfile, ' ') + call add_default ('MNUCCRIO ', budget_histfile, ' ') + call add_default ('MNUCCCO ', budget_histfile, ' ') + call add_default ('MELTSDT ', budget_histfile, ' ') + call add_default ('MELTO ', budget_histfile, ' ') + call add_default ('HOMOO ', budget_histfile, ' ') + call add_default ('FRZRDT ', budget_histfile, ' ') + call add_default ('CMEIOUT ', budget_histfile, ' ') + call add_default ('BERGSO ', budget_histfile, ' ') + call add_default ('BERGO ', budget_histfile, ' ') + call add_default ('MELTSTOT ', budget_histfile, ' ') + call add_default ('MNUDEPO ', budget_histfile, ' ') + if (micro_mg_version > 2) then + call add_default ('QGSEDTEN ', budget_histfile, ' ') + call add_default ('PSACRO ', budget_histfile, ' ') + call add_default ('PRACGO ', budget_histfile, ' ') + call add_default ('PSACWGO ', budget_histfile, ' ') + call add_default ('PGSACWO ', budget_histfile, ' ') + call add_default ('PGRACSO ', budget_histfile, ' ') + call add_default ('PRDGO ', budget_histfile, ' ') + call add_default ('QMULTGO ', budget_histfile, ' ') + call add_default ('QMULTRGO ', budget_histfile, ' ') + call add_default ('MELTGTOT ', budget_histfile, ' ') + end if + call add_default(cnst_name(ixcldliq), budget_histfile, ' ') + call add_default(cnst_name(ixcldice), budget_histfile, ' ') + call add_default(apcnst (ixcldliq), budget_histfile, ' ') + call add_default(apcnst (ixcldice), budget_histfile, ' ') + call add_default(bpcnst (ixcldliq), budget_histfile, ' ') + call add_default(bpcnst (ixcldice), budget_histfile, ' ') + if (micro_mg_version > 1) then + call add_default(cnst_name(ixrain), budget_histfile, ' ') + call add_default(cnst_name(ixsnow), budget_histfile, ' ') + call add_default(apcnst (ixrain), budget_histfile, ' ') + call add_default(apcnst (ixsnow), budget_histfile, ' ') + call add_default(bpcnst (ixrain), budget_histfile, ' ') + call add_default(bpcnst (ixsnow), budget_histfile, ' ') + end if + + if (micro_mg_version > 2) then + call add_default(cnst_name(ixgraupel), budget_histfile, ' ') + call add_default(apcnst (ixgraupel), budget_histfile, ' ') + call add_default(bpcnst (ixgraupel), budget_histfile, ' ') + end if + + end if + + ! physics buffer indices + ast_idx = pbuf_get_index('AST') + cld_idx = pbuf_get_index('CLD') + concld_idx = pbuf_get_index('CONCLD') + prec_dp_idx = pbuf_get_index('PREC_DP') + prec_sh_idx = pbuf_get_index('PREC_SH') + + naai_idx = pbuf_get_index('NAAI') + naai_hom_idx = pbuf_get_index('NAAI_HOM') + npccn_idx = pbuf_get_index('NPCCN') + rndst_idx = pbuf_get_index('RNDST') + nacon_idx = pbuf_get_index('NACON') + + prec_str_idx = pbuf_get_index('PREC_STR') + snow_str_idx = pbuf_get_index('SNOW_STR') + prec_sed_idx = pbuf_get_index('PREC_SED') + snow_sed_idx = pbuf_get_index('SNOW_SED') + prec_pcw_idx = pbuf_get_index('PREC_PCW') + snow_pcw_idx = pbuf_get_index('SNOW_PCW') + + cmeliq_idx = pbuf_get_index('CMELIQ') + + ! These fields may have been added, so don't abort if they have not been + qsatfac_idx = pbuf_get_index('QSATFAC', ierr) + qrain_idx = pbuf_get_index('QRAIN', ierr) + qsnow_idx = pbuf_get_index('QSNOW', ierr) + nrain_idx = pbuf_get_index('NRAIN', ierr) + nsnow_idx = pbuf_get_index('NSNOW', ierr) + + ! fields for heterogeneous freezing + frzimm_idx = pbuf_get_index('FRZIMM', ierr) + frzcnt_idx = pbuf_get_index('FRZCNT', ierr) + frzdep_idx = pbuf_get_index('FRZDEP', ierr) + + ! Initialize physics buffer grid fields for accumulating precip and condensation + if (is_first_step()) then + call pbuf_set_field(pbuf2d, cldo_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_t_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_qv_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_ql_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_qi_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_nl_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_ni_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_qlst_idx,0._r8) + call pbuf_set_field(pbuf2d, acpr_idx, 0._r8) + call pbuf_set_field(pbuf2d, acgcme_idx, 0._r8) + call pbuf_set_field(pbuf2d, acnum_idx, 0) + call pbuf_set_field(pbuf2d, relvar_idx, 2._r8) + call pbuf_set_field(pbuf2d, accre_enhan_idx, 1._r8) + call pbuf_set_field(pbuf2d, am_evp_st_idx, 0._r8) + call pbuf_set_field(pbuf2d, evprain_st_idx, 0._r8) + call pbuf_set_field(pbuf2d, evpsnow_st_idx, 0._r8) + call pbuf_set_field(pbuf2d, prer_evap_idx, 0._r8) + call pbuf_set_field(pbuf2d, bergso_idx, 0._r8) + call pbuf_set_field(pbuf2d, icswp_idx, 0._r8) + call pbuf_set_field(pbuf2d, cldfsnow_idx, 0._r8) + call pbuf_set_field(pbuf2d, dei_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, des_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, mu_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, lambdac_idx, 0.0_r8) + + if (degrau_idx > 0) call pbuf_set_field(pbuf2d, degrau_idx, 0.0_r8) + if (icgrauwp_idx > 0) call pbuf_set_field(pbuf2d, icgrauwp_idx, 0.0_r8) + if (qrain_idx > 0) call pbuf_set_field(pbuf2d, qrain_idx, 0._r8) + if (qsnow_idx > 0) call pbuf_set_field(pbuf2d, qsnow_idx, 0._r8) + if (nrain_idx > 0) call pbuf_set_field(pbuf2d, nrain_idx, 0._r8) + if (nsnow_idx > 0) call pbuf_set_field(pbuf2d, nsnow_idx, 0._r8) + if (qcsedten_idx > 0) call pbuf_set_field(pbuf2d, qcsedten_idx, 0._r8) + if (qrsedten_idx > 0) call pbuf_set_field(pbuf2d, qrsedten_idx, 0._r8) + if (qisedten_idx > 0) call pbuf_set_field(pbuf2d, qisedten_idx, 0._r8) + if (qssedten_idx > 0) call pbuf_set_field(pbuf2d, qssedten_idx, 0._r8) + if (vtrmc_idx > 0) call pbuf_set_field(pbuf2d, vtrmc_idx, 0._r8) + if (umr_idx > 0) call pbuf_set_field(pbuf2d, umr_idx, 0._r8) + if (vtrmi_idx > 0) call pbuf_set_field(pbuf2d, vtrmi_idx, 0._r8) + if (ums_idx > 0) call pbuf_set_field(pbuf2d, ums_idx, 0._r8) + if (qcsevap_idx > 0) call pbuf_set_field(pbuf2d, qcsevap_idx, 0._r8) + if (qisevap_idx > 0) call pbuf_set_field(pbuf2d, qisevap_idx, 0._r8) + + ! If sub-columns turned on, need to set the sub-column fields as well + if (use_subcol_microp) then + call pbuf_set_field(pbuf2d, cldo_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_t_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_qv_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_ql_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_qi_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_nl_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_ni_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_qlst_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, icswp_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cldfsnow_idx,0._r8, col_type=col_type_subcol) + end if + + end if + +end subroutine micro_pumas_cam_init + +!=============================================================================== + +subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) + + use micro_pumas_utils, only: size_dist_param_basic, size_dist_param_liq + use micro_pumas_utils, only: mg_liq_props, mg_ice_props, avg_diameter + use micro_pumas_utils, only: rhoi, rhosn, rhow, rhows, rhog, qsmall, mincld + + use micro_mg1_0, only: micro_mg_tend1_0 => micro_mg_tend + use micro_pumas_v1, only: micro_pumas_tend => micro_pumas_tend + + use physics_buffer, only: pbuf_col_type_index + use subcol, only: subcol_field_avg + use tropopause, only: tropopause_find_cam, TROP_ALG_CPP, TROP_ALG_NONE, NOTFOUND + use wv_saturation, only: qsat + use infnan, only: nan, assignment(=) + + type(physics_state), intent(in) :: state + type(physics_ptend), intent(out) :: ptend + real(r8), intent(in) :: dtime + type(physics_buffer_desc), pointer :: pbuf(:) + + ! Local variables + integer :: lchnk, ncol, psetcols, ngrdcol + + integer :: i, k, itim_old, it + + real(r8), pointer :: naai(:,:) ! ice nucleation number + real(r8), pointer :: naai_hom(:,:) ! ice nucleation number (homogeneous) + real(r8), pointer :: npccn(:,:) ! liquid activation number tendency + real(r8), pointer :: rndst(:,:,:) + real(r8), pointer :: nacon(:,:,:) + real(r8), pointer :: am_evp_st_grid(:,:) ! Evaporation area of stratiform precipitation. 0<= am_evp_st <=1. + real(r8), pointer :: evprain_st_grid(:,:) ! Evaporation rate of stratiform rain [kg/kg/s] + real(r8), pointer :: evpsnow_st_grid(:,:) ! Evaporation rate of stratiform snow [kg/kg/s] + + real(r8), pointer :: prec_str(:) ! [Total] Sfc flux of precip from stratiform [ m/s ] + real(r8), pointer :: snow_str(:) ! [Total] Sfc flux of snow from stratiform [ m/s ] + real(r8), pointer :: prec_sed(:) ! Surface flux of total cloud water from sedimentation + real(r8), pointer :: snow_sed(:) ! Surface flux of cloud ice from sedimentation + real(r8), pointer :: prec_pcw(:) ! Sfc flux of precip from microphysics [ m/s ] + real(r8), pointer :: snow_pcw(:) ! Sfc flux of snow from microphysics [ m/s ] + + real(r8), pointer :: ast(:,:) ! Relative humidity cloud fraction + real(r8), pointer :: qsatfac(:,:) ! Subgrid cloud water saturation scaling factor. + real(r8), pointer :: alst_mic(:,:) + real(r8), pointer :: aist_mic(:,:) + real(r8), pointer :: cldo(:,:) ! Old cloud fraction + real(r8), pointer :: nevapr(:,:) ! Evaporation of total precipitation (rain + snow) + real(r8), pointer :: prer_evap(:,:) ! precipitation evaporation rate + real(r8), pointer :: relvar(:,:) ! relative variance of cloud water + real(r8), pointer :: accre_enhan(:,:) ! optional accretion enhancement for experimentation + real(r8), pointer :: prain(:,:) ! Total precipitation (rain + snow) + real(r8), pointer :: dei(:,:) ! Ice effective diameter (meters) + real(r8), pointer :: mu(:,:) ! Size distribution shape parameter for radiation + real(r8), pointer :: lambdac(:,:) ! Size distribution slope parameter for radiation + real(r8), pointer :: des(:,:) ! Snow effective diameter (m) + real(r8), pointer :: degrau(:,:) ! Graupel effective diameter (m) + real(r8), pointer :: bergso(:,:) ! Conversion of cloud water to snow from bergeron + + real(r8) :: rho(state%psetcols,pver) + real(r8) :: cldmax(state%psetcols,pver) + + real(r8) :: rate1cld(state%psetcols,pver) ! array to hold rate1ord_cw2pr_st from microphysics + + real(r8) :: tlat(state%psetcols,pver) + real(r8) :: qvlat(state%psetcols,pver) + real(r8) :: qcten(state%psetcols,pver) + real(r8) :: qiten(state%psetcols,pver) + real(r8) :: ncten(state%psetcols,pver) + real(r8) :: niten(state%psetcols,pver) + + real(r8) :: qrten(state%psetcols,pver) + real(r8) :: qsten(state%psetcols,pver) + real(r8) :: nrten(state%psetcols,pver) + real(r8) :: nsten(state%psetcols,pver) + real(r8) :: qgten(state%psetcols,pver) + real(r8) :: ngten(state%psetcols,pver) + + real(r8) :: prect(state%psetcols) + real(r8) :: preci(state%psetcols) + real(r8) :: am_evp_st(state%psetcols,pver) ! Area over which precip evaporates + real(r8) :: evapsnow(state%psetcols,pver) ! Local evaporation of snow + real(r8) :: prodsnow(state%psetcols,pver) ! Local production of snow + real(r8) :: cmeice(state%psetcols,pver) ! Rate of cond-evap of ice within the cloud + real(r8) :: qsout(state%psetcols,pver) ! Snow mixing ratio + real(r8) :: cflx(state%psetcols,pverp) ! grid-box avg liq condensate flux (kg m^-2 s^-1) + real(r8) :: iflx(state%psetcols,pverp) ! grid-box avg ice condensate flux (kg m^-2 s^-1) + real(r8) :: rflx(state%psetcols,pverp) ! grid-box average rain flux (kg m^-2 s^-1) + real(r8) :: sflx(state%psetcols,pverp) ! grid-box average snow flux (kg m^-2 s^-1) + real(r8) :: gflx(state%psetcols,pverp) ! grid-box average snow flux (kg m^-2 s^-1) + real(r8) :: qrout(state%psetcols,pver) ! Rain mixing ratio + real(r8) :: qcsevap(state%psetcols,pver) ! Evaporation of falling cloud water + real(r8) :: qisevap(state%psetcols,pver) ! Sublimation of falling cloud ice + real(r8) :: qvres(state%psetcols,pver) ! Residual condensation term to remove excess saturation + real(r8) :: cmeiout(state%psetcols,pver) ! Deposition/sublimation rate of cloud ice + real(r8) :: vtrmc(state%psetcols,pver) ! Mass-weighted cloud water fallspeed + real(r8) :: vtrmi(state%psetcols,pver) ! Mass-weighted cloud ice fallspeed + real(r8) :: umr(state%psetcols,pver) ! Mass-weighted rain fallspeed + real(r8) :: ums(state%psetcols,pver) ! Mass-weighted snow fallspeed + real(r8) :: qcsedten(state%psetcols,pver) ! Cloud water mixing ratio tendency from sedimentation + real(r8) :: qisedten(state%psetcols,pver) ! Cloud ice mixing ratio tendency from sedimentation + real(r8) :: qrsedten(state%psetcols,pver) ! Rain mixing ratio tendency from sedimentation + real(r8) :: qssedten(state%psetcols,pver) ! Snow mixing ratio tendency from sedimentation + real(r8) :: qgsedten(state%psetcols,pver) ! Graupel/Hail mixing ratio tendency from sedimentation + real(r8) :: umg(state%psetcols,pver) ! Mass-weighted Graupel/Hail fallspeed + + real(r8) :: prao(state%psetcols,pver) + real(r8) :: prco(state%psetcols,pver) + real(r8) :: mnuccco(state%psetcols,pver) + real(r8) :: mnuccto(state%psetcols,pver) + real(r8) :: msacwio(state%psetcols,pver) + real(r8) :: psacwso(state%psetcols,pver) + real(r8) :: bergo(state%psetcols,pver) + real(r8) :: melto(state%psetcols,pver) + real(r8) :: homoo(state%psetcols,pver) + real(r8) :: qcreso(state%psetcols,pver) + real(r8) :: prcio(state%psetcols,pver) + real(r8) :: praio(state%psetcols,pver) + real(r8) :: qireso(state%psetcols,pver) + real(r8) :: mnuccro(state%psetcols,pver) + real(r8) :: mnuccrio(state%psetcols,pver) + real(r8) :: mnudepo(state%psetcols,pver) + real(r8) :: meltstot(state%psetcols,pver) + real(r8) :: meltgtot(state%psetcols,pver) + real(r8) :: pracso (state%psetcols,pver) + real(r8) :: meltsdt(state%psetcols,pver) + real(r8) :: frzrdt (state%psetcols,pver) + real(r8) :: mnuccdo(state%psetcols,pver) + real(r8) :: nrout(state%psetcols,pver) + real(r8) :: nsout(state%psetcols,pver) + real(r8) :: refl(state%psetcols,pver) ! analytic radar reflectivity + real(r8) :: arefl(state%psetcols,pver) ! average reflectivity will zero points outside valid range + real(r8) :: areflz(state%psetcols,pver) ! average reflectivity in z. + real(r8) :: frefl(state%psetcols,pver) + real(r8) :: csrfl(state%psetcols,pver) ! cloudsat reflectivity + real(r8) :: acsrfl(state%psetcols,pver) ! cloudsat average + real(r8) :: fcsrfl(state%psetcols,pver) + real(r8) :: rercld(state%psetcols,pver) ! effective radius calculation for rain + cloud + real(r8) :: ncai(state%psetcols,pver) ! output number conc of ice nuclei available (1/m3) + real(r8) :: ncal(state%psetcols,pver) ! output number conc of CCN (1/m3) + real(r8) :: qrout2(state%psetcols,pver) + real(r8) :: qsout2(state%psetcols,pver) + real(r8) :: nrout2(state%psetcols,pver) + real(r8) :: nsout2(state%psetcols,pver) + real(r8) :: freqs(state%psetcols,pver) + real(r8) :: freqr(state%psetcols,pver) + real(r8) :: nfice(state%psetcols,pver) + real(r8) :: qcrat(state%psetcols,pver) ! qc limiter ratio (1=no limit) +!Hail/Graupel Output + real(r8) :: freqg(state%psetcols,pver) + real(r8) :: qgout(state%psetcols,pver) + real(r8) :: ngout(state%psetcols,pver) + real(r8) :: dgout(state%psetcols,pver) + real(r8) :: qgout2(state%psetcols,pver) + real(r8) :: ngout2(state%psetcols,pver) + real(r8) :: dgout2(state%psetcols,pver) +!Hail/Graupel Process Rates + real(r8) :: psacro(state%psetcols,pver) + real(r8) :: pracgo(state%psetcols,pver) + real(r8) :: psacwgo(state%psetcols,pver) + real(r8) :: pgsacwo(state%psetcols,pver) + real(r8) :: pgracso(state%psetcols,pver) + real(r8) :: prdgo(state%psetcols,pver) + real(r8) :: qmultgo(state%psetcols,pver) + real(r8) :: qmultrgo(state%psetcols,pver) + real(r8) :: npracgo(state%psetcols,pver) + real(r8) :: nscngo(state%psetcols,pver) + real(r8) :: ngracso(state%psetcols,pver) + real(r8) :: nmultgo(state%psetcols,pver) + real(r8) :: nmultrgo(state%psetcols,pver) + real(r8) :: npsacwgo(state%psetcols,pver) + + ! Dummy arrays for cases where we throw away the MG version and + ! recalculate sizes on the CAM grid to avoid time/subcolumn averaging + ! issues. + real(r8) :: rel_fn_dum(state%ncol,pver) + real(r8) :: dsout2_dum(state%ncol,pver) + real(r8) :: drout_dum(state%ncol,pver) + real(r8) :: reff_rain_dum(state%ncol,pver) + real(r8) :: reff_snow_dum(state%ncol,pver) + real(r8) :: reff_grau_dum(state%ncol,pver) !not used for now or passed to COSP. + real(r8), target :: nan_array(state%ncol,pver) ! Array for NaN's + + ! Heterogeneous-only version of mnuccdo. + real(r8) :: mnuccdohet(state%psetcols,pver) + + ! physics buffer fields for COSP simulator + real(r8), pointer :: mgflxprc(:,:) ! MG grid-box mean flux_large_scale_cloud_rain+snow at interfaces (kg/m2/s) + real(r8), pointer :: mgflxsnw(:,:) ! MG grid-box mean flux_large_scale_cloud_snow at interfaces (kg/m2/s) + real(r8), pointer :: mgmrprc(:,:) ! MG grid-box mean mixingratio_large_scale_cloud_rain+snow at interfaces (kg/kg) + real(r8), pointer :: mgmrsnw(:,:) ! MG grid-box mean mixingratio_large_scale_cloud_snow at interfaces (kg/kg) + real(r8), pointer :: mgreffrain_grid(:,:) ! MG diagnostic rain effective radius (um) + real(r8), pointer :: mgreffsnow_grid(:,:) ! MG diagnostic snow effective radius (um) + real(r8), pointer :: cvreffliq(:,:) ! convective cloud liquid effective radius (um) + real(r8), pointer :: cvreffice(:,:) ! convective cloud ice effective radius (um) + + ! physics buffer fields used with CARMA + real(r8), pointer, dimension(:,:) :: tnd_qsnow ! external tendency on snow mass (kg/kg/s) + real(r8), pointer, dimension(:,:) :: tnd_nsnow ! external tendency on snow number(#/kg/s) + real(r8), pointer, dimension(:,:) :: re_ice ! ice effective radius (m) + + real(r8), pointer :: rate1ord_cw2pr_st(:,:) ! 1st order rate for direct conversion of + ! strat. cloud water to precip (1/s) ! rce 2010/05/01 + real(r8), pointer :: wsedl(:,:) ! Sedimentation velocity of liquid stratus cloud droplet [ m/s ] + + + real(r8), pointer :: CC_T(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_qv(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_ql(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_qi(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_nl(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_ni(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_qlst(:,:) ! In-liquid stratus microphysical tendency + + ! variables for heterogeneous freezing + real(r8), pointer :: frzimm(:,:) + real(r8), pointer :: frzcnt(:,:) + real(r8), pointer :: frzdep(:,:) + + real(r8), pointer :: qme(:,:) + + ! A local copy of state is used for diagnostic calculations + type(physics_state) :: state_loc + type(physics_ptend) :: ptend_loc + + real(r8) :: icecldf(state%psetcols,pver) ! Ice cloud fraction + real(r8) :: liqcldf(state%psetcols,pver) ! Liquid cloud fraction (combined into cloud) + + real(r8), pointer :: rel(:,:) ! Liquid effective drop radius (microns) + real(r8), pointer :: rei(:,:) ! Ice effective drop size (microns) + real(r8), pointer :: sadice(:,:) ! Ice surface area density (cm2/cm3) + real(r8), pointer :: sadsnow(:,:) ! Snow surface area density (cm2/cm3) + + + real(r8), pointer :: cmeliq(:,:) + + real(r8), pointer :: cld(:,:) ! Total cloud fraction + real(r8), pointer :: concld(:,:) ! Convective cloud fraction + real(r8), pointer :: prec_dp(:) ! Deep Convective precip + real(r8), pointer :: prec_sh(:) ! Shallow Convective precip + + real(r8), pointer :: iciwpst(:,:) ! Stratiform in-cloud ice water path for radiation + real(r8), pointer :: iclwpst(:,:) ! Stratiform in-cloud liquid water path for radiation + real(r8), pointer :: cldfsnow(:,:) ! Cloud fraction for liquid+snow + real(r8), pointer :: icswp(:,:) ! In-cloud snow water path + + real(r8), pointer :: cldfgrau(:,:) ! Cloud fraction for liquid+snow + real(r8), pointer :: icgrauwp(:,:) ! In-cloud snow water path + + real(r8) :: icimrst(state%psetcols,pver) ! In stratus ice mixing ratio + real(r8) :: icwmrst(state%psetcols,pver) ! In stratus water mixing ratio + real(r8) :: icinc(state%psetcols,pver) ! In cloud ice number conc + real(r8) :: icwnc(state%psetcols,pver) ! In cloud water number conc + + real(r8) :: iclwpi(state%psetcols) ! Vertically-integrated in-cloud Liquid WP before microphysics + real(r8) :: iciwpi(state%psetcols) ! Vertically-integrated in-cloud Ice WP before microphysics + + ! Averaging arrays for effective radius and number.... + real(r8) :: efiout_grid(pcols,pver) + real(r8) :: efcout_grid(pcols,pver) + real(r8) :: ncout_grid(pcols,pver) + real(r8) :: niout_grid(pcols,pver) + real(r8) :: freqi_grid(pcols,pver) + real(r8) :: freql_grid(pcols,pver) + +! Averaging arrays for supercooled liquid + real(r8) :: freqm_grid(pcols,pver) + real(r8) :: freqsl_grid(pcols,pver) + real(r8) :: freqslm_grid(pcols,pver) + real(r8) :: fctm_grid(pcols) + real(r8) :: fctsl_grid(pcols) + real(r8) :: fctslm_grid(pcols) + + real(r8) :: cdnumc_grid(pcols) ! Vertically-integrated droplet concentration + real(r8) :: icimrst_grid_out(pcols,pver) ! In stratus ice mixing ratio + real(r8) :: icwmrst_grid_out(pcols,pver) ! In stratus water mixing ratio + + ! Cloud fraction used for precipitation. + real(r8) :: cldmax_grid(pcols,pver) + + ! Average cloud top radius & number + real(r8) :: ctrel_grid(pcols) + real(r8) :: ctrei_grid(pcols) + real(r8) :: ctnl_grid(pcols) + real(r8) :: ctni_grid(pcols) + real(r8) :: fcti_grid(pcols) + real(r8) :: fctl_grid(pcols) + + real(r8) :: ftem_grid(pcols,pver) + + ! Variables for precip efficiency calculation + real(r8) :: minlwp ! LWP threshold + + real(r8), pointer, dimension(:) :: acprecl_grid ! accumulated precip across timesteps + real(r8), pointer, dimension(:) :: acgcme_grid ! accumulated condensation across timesteps + integer, pointer, dimension(:) :: acnum_grid ! counter for # timesteps accumulated + + ! Variables for liquid water path and column condensation + real(r8) :: tgliqwp_grid(pcols) ! column liquid + real(r8) :: tgcmeliq_grid(pcols) ! column condensation rate (units) + + real(r8) :: pe_grid(pcols) ! precip efficiency for output + real(r8) :: pefrac_grid(pcols) ! fraction of time precip efficiency is written out + real(r8) :: tpr_grid(pcols) ! average accumulated precipitation rate in pe calculation + + ! variables for autoconversion and accretion vertical averages + real(r8) :: vprco_grid(pcols) ! vertical average autoconversion + real(r8) :: vprao_grid(pcols) ! vertical average accretion + real(r8) :: racau_grid(pcols) ! ratio of vertical averages + integer :: cnt_grid(pcols) ! counters + + logical :: lq(pcnst) + + real(r8) :: icimrst_grid(pcols,pver) ! stratus ice mixing ratio - on grid + real(r8) :: icwmrst_grid(pcols,pver) ! stratus water mixing ratio - on grid + + real(r8), pointer :: lambdac_grid(:,:) + real(r8), pointer :: mu_grid(:,:) + real(r8), pointer :: rel_grid(:,:) + real(r8), pointer :: rei_grid(:,:) + real(r8), pointer :: sadice_grid(:,:) + real(r8), pointer :: sadsnow_grid(:,:) + real(r8), pointer :: dei_grid(:,:) + real(r8), pointer :: des_grid(:,:) + real(r8), pointer :: iclwpst_grid(:,:) + real(r8), pointer :: degrau_grid(:,:) + + real(r8) :: rho_grid(pcols,pver) + real(r8) :: liqcldf_grid(pcols,pver) + real(r8) :: qsout_grid(pcols,pver) + real(r8) :: ncic_grid(pcols,pver) + real(r8) :: niic_grid(pcols,pver) + real(r8) :: rel_fn_grid(pcols,pver) ! Ice effective drop size at fixed number (indirect effect) (microns) - on grid + real(r8) :: qrout_grid(pcols,pver) + real(r8) :: drout2_grid(pcols,pver) + real(r8) :: dsout2_grid(pcols,pver) + real(r8) :: nsout_grid(pcols,pver) + real(r8) :: nrout_grid(pcols,pver) + real(r8) :: reff_rain_grid(pcols,pver) + real(r8) :: reff_snow_grid(pcols,pver) + real(r8) :: reff_grau_grid(pcols,pver) + real(r8) :: cld_grid(pcols,pver) + real(r8) :: pdel_grid(pcols,pver) + real(r8) :: prco_grid(pcols,pver) + real(r8) :: prao_grid(pcols,pver) + real(r8) :: icecldf_grid(pcols,pver) + real(r8) :: icwnc_grid(pcols,pver) + real(r8) :: icinc_grid(pcols,pver) + real(r8) :: qcreso_grid(pcols,pver) + real(r8) :: melto_grid(pcols,pver) + real(r8) :: mnuccco_grid(pcols,pver) + real(r8) :: mnuccto_grid(pcols,pver) + real(r8) :: bergo_grid(pcols,pver) + real(r8) :: homoo_grid(pcols,pver) + real(r8) :: msacwio_grid(pcols,pver) + real(r8) :: psacwso_grid(pcols,pver) + real(r8) :: cmeiout_grid(pcols,pver) + real(r8) :: qireso_grid(pcols,pver) + real(r8) :: prcio_grid(pcols,pver) + real(r8) :: praio_grid(pcols,pver) + real(r8) :: psacro_grid(pcols,pver) + real(r8) :: pracgo_grid(pcols,pver) + real(r8) :: psacwgo_grid(pcols,pver) + real(r8) :: pgsacwo_grid(pcols,pver) + real(r8) :: pgracso_grid(pcols,pver) + real(r8) :: prdgo_grid(pcols,pver) + real(r8) :: qmultgo_grid(pcols,pver) + real(r8) :: qmultrgo_grid(pcols,pver) + real(r8) :: npracgo_grid(pcols,pver) + real(r8) :: nscngo_grid(pcols,pver) + real(r8) :: ngracso_grid(pcols,pver) + real(r8) :: nmultgo_grid(pcols,pver) + real(r8) :: nmultrgo_grid(pcols,pver) + real(r8) :: npsacwgo_grid(pcols,pver) + real(r8) :: qcsedtenout_grid(pcols,pver) + real(r8) :: qrsedtenout_grid(pcols,pver) + real(r8) :: qisedtenout_grid(pcols,pver) + real(r8) :: qssedtenout_grid(pcols,pver) + real(r8) :: vtrmcout_grid(pcols,pver) + real(r8) :: umrout_grid(pcols,pver) + real(r8) :: vtrmiout_grid(pcols,pver) + real(r8) :: umsout_grid(pcols,pver) + real(r8) :: qcsevapout_grid(pcols,pver) + real(r8) :: qisevapout_grid(pcols,pver) + + real(r8) :: nc_grid(pcols,pver) + real(r8) :: ni_grid(pcols,pver) + real(r8) :: qr_grid(pcols,pver) + real(r8) :: nr_grid(pcols,pver) + real(r8) :: qs_grid(pcols,pver) + real(r8) :: ns_grid(pcols,pver) + real(r8) :: qg_grid(pcols,pver) + real(r8) :: ng_grid(pcols,pver) + + real(r8) :: dgout2_grid(pcols,pver) + + real(r8) :: cp_rh(pcols,pver) + real(r8) :: cp_t(pcols) + real(r8) :: cp_z(pcols) + real(r8) :: cp_dt(pcols) + real(r8) :: cp_dz(pcols) + integer :: troplev(pcols) + real(r8) :: es + real(r8) :: qs + + real(r8) :: state_loc_graup(state%psetcols,pver) + real(r8) :: state_loc_numgraup(state%psetcols,pver) + + real(r8), pointer :: cmeliq_grid(:,:) + + real(r8), pointer :: prec_str_grid(:) + real(r8), pointer :: snow_str_grid(:) + real(r8), pointer :: prec_pcw_grid(:) + real(r8), pointer :: snow_pcw_grid(:) + real(r8), pointer :: prec_sed_grid(:) + real(r8), pointer :: snow_sed_grid(:) + real(r8), pointer :: cldo_grid(:,:) + real(r8), pointer :: nevapr_grid(:,:) + real(r8), pointer :: prain_grid(:,:) + real(r8), pointer :: mgflxprc_grid(:,:) + real(r8), pointer :: mgflxsnw_grid(:,:) + real(r8), pointer :: mgmrprc_grid(:,:) + real(r8), pointer :: mgmrsnw_grid(:,:) + real(r8), pointer :: cvreffliq_grid(:,:) + real(r8), pointer :: cvreffice_grid(:,:) + real(r8), pointer :: rate1ord_cw2pr_st_grid(:,:) + real(r8), pointer :: wsedl_grid(:,:) + real(r8), pointer :: CC_t_grid(:,:) + real(r8), pointer :: CC_qv_grid(:,:) + real(r8), pointer :: CC_ql_grid(:,:) + real(r8), pointer :: CC_qi_grid(:,:) + real(r8), pointer :: CC_nl_grid(:,:) + real(r8), pointer :: CC_ni_grid(:,:) + real(r8), pointer :: CC_qlst_grid(:,:) + real(r8), pointer :: qme_grid(:,:) + real(r8), pointer :: iciwpst_grid(:,:) + real(r8), pointer :: icswp_grid(:,:) + real(r8), pointer :: ast_grid(:,:) + real(r8), pointer :: cldfsnow_grid(:,:) + real(r8), pointer :: bergso_grid(:,:) + + real(r8), pointer :: icgrauwp_grid(:,:) + real(r8), pointer :: cldfgrau_grid(:,:) + + real(r8), pointer :: qrout_grid_ptr(:,:) + real(r8), pointer :: qsout_grid_ptr(:,:) + real(r8), pointer :: nrout_grid_ptr(:,:) + real(r8), pointer :: nsout_grid_ptr(:,:) + real(r8), pointer :: qcsedtenout_grid_ptr(:,:) + real(r8), pointer :: qrsedtenout_grid_ptr(:,:) + real(r8), pointer :: qisedtenout_grid_ptr(:,:) + real(r8), pointer :: qssedtenout_grid_ptr(:,:) + real(r8), pointer :: vtrmcout_grid_ptr(:,:) + real(r8), pointer :: umrout_grid_ptr(:,:) + real(r8), pointer :: vtrmiout_grid_ptr(:,:) + real(r8), pointer :: umsout_grid_ptr(:,:) + real(r8), pointer :: qcsevapout_grid_ptr(:,:) + real(r8), pointer :: qisevapout_grid_ptr(:,:) + + + logical :: use_subcol_microp + integer :: col_type ! Flag to store whether accessing grid or sub-columns in pbuf_get_field + integer :: ierr + integer :: nlev + + character(128) :: errstring ! return status (non-blank for error return) + + ! For rrtmg optics. specified distribution. + real(r8), parameter :: dcon = 25.e-6_r8 ! Convective size distribution effective radius (meters) + real(r8), parameter :: mucon = 5.3_r8 ! Convective size distribution shape parameter + real(r8), parameter :: deicon = 50._r8 ! Convective ice effective diameter (meters) + + ! Rainbows: solar zenith angle (SZA) + real(r8) :: zen_angle(state%psetcols) ! Daytime solar zenith angles (radians) + real(r8) :: rlats(state%psetcols), rlons(state%psetcols) ! chunk latitudes and longitudes (radains) + real(r8) :: sza(state%psetcols) ! solar zenith angles (degrees) + real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor + real(r8) :: calday !current calendar day + + real(r8) :: precc(state%psetcols) ! convective precip rate + +! Rainbow frequency and fraction for output + + real(r8) :: rbfreq(state%psetcols) + real(r8) :: rbfrac(state%psetcols) + +!Rainbows: parameters + + real(r8), parameter :: rb_rmin =1.e-6_r8 ! Strat Rain threshold (mixing ratio) + real(r8), parameter :: rb_rcmin = 5._r8/(86400._r8*1000._r8) ! Conv Rain Threshold (mm/d--> m/s) + real(r8), parameter :: rb_pmin =85000._r8 ! Minimum pressure for surface layer + real(r8), parameter :: deg2rad = pi/180._r8 ! Conversion factor + integer :: top_idx !Index for top level below rb_pmin + real(r8) :: convmx + real(r8) :: cldmx + real(r8) :: frlow + real(r8) :: cldtot + real(r8) :: rmax + logical :: rval + + !------------------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + psetcols = state%psetcols + ngrdcol = state%ngrdcol + itim_old = pbuf_old_tim_idx() + nlev = pver - top_lev + 1 + + nan_array = nan + + call phys_getopts(use_subcol_microp_out=use_subcol_microp) + + ! Set the col_type flag to grid or subcolumn dependent on the value of use_subcol_microp + call pbuf_col_type_index(use_subcol_microp, col_type=col_type) + + !----------------------- + ! These physics buffer fields are read only and not set in this parameterization + ! If these fields do not have subcolumn data, copy the grid to the subcolumn if subcolumns is turned on + ! If subcolumns is not turned on, then these fields will be grid data + + call pbuf_get_field(pbuf, naai_idx, naai, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, naai_hom_idx, naai_hom, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, npccn_idx, npccn, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, rndst_idx, rndst, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, nacon_idx, nacon, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, relvar_idx, relvar, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, cmeliq_idx, cmeliq, col_type=col_type, copy_if_needed=use_subcol_microp) + + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & + col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & + col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & + col_type=col_type, copy_if_needed=use_subcol_microp) + + ! Get convective precip + if (prec_dp_idx > 0) then + call pbuf_get_field(pbuf, prec_dp_idx, prec_dp, col_type=col_type, copy_if_needed=use_subcol_microp) + else + nullify(prec_dp) + end if + if (prec_sh_idx > 0) then + call pbuf_get_field(pbuf, prec_sh_idx, prec_sh, col_type=col_type, copy_if_needed=use_subcol_microp) + else + nullify(prec_sh) + end if + +! Merge Precipitation rates (multi-process) + if (associated(prec_dp) .and. associated(prec_sh)) then + precc(:ncol) = prec_dp(:ncol) + prec_sh(:ncol) + else if (associated(prec_dp)) then + precc(:ncol) = prec_dp(:ncol) + else if (associated(prec_sh)) then + precc(:ncol) = prec_sh(:ncol) + else + precc(:ncol) = 0._r8 + end if + + if (.not. do_cldice) then + ! If we are NOT prognosing ice and snow tendencies, then get them from the Pbuf + call pbuf_get_field(pbuf, tnd_qsnow_idx, tnd_qsnow, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, tnd_nsnow_idx, tnd_nsnow, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, re_ice_idx, re_ice, col_type=col_type, copy_if_needed=use_subcol_microp) + else + ! If we ARE prognosing tendencies, then just point to an array of NaN fields to have + ! something for PUMAS to use in call + tnd_qsnow => nan_array + tnd_nsnow => nan_array + re_ice => nan_array + end if + + if (use_hetfrz_classnuc) then + call pbuf_get_field(pbuf, frzimm_idx, frzimm, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, frzcnt_idx, frzcnt, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, frzdep_idx, frzdep, col_type=col_type, copy_if_needed=use_subcol_microp) + else + ! Needed to satisfy gnu compiler with optional argument - set to an array of NaN fields + frzimm => nan_array + frzcnt => nan_array + frzdep => nan_array + end if + + if (qsatfac_idx > 0) then + call pbuf_get_field(pbuf, qsatfac_idx, qsatfac, col_type=col_type, copy_if_needed=use_subcol_microp) + else + allocate(qsatfac(ncol,pver),stat=ierr) + if (ierr /= 0) then + call endrun(' micro_pumas_cam_tend: error allocating qsatfac') + end if + qsatfac = 1._r8 + end if + + ! initialize tendency variables + preci = 0._r8 + prect = 0._r8 + + + !----------------------- + ! These physics buffer fields are calculated and set in this parameterization + ! If subcolumns is turned on, then these fields will be calculated on a subcolumn grid, otherwise they will be a normal grid + + call pbuf_get_field(pbuf, prec_str_idx, prec_str, col_type=col_type) + call pbuf_get_field(pbuf, snow_str_idx, snow_str, col_type=col_type) + call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw, col_type=col_type) + call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw, col_type=col_type) + call pbuf_get_field(pbuf, prec_sed_idx, prec_sed, col_type=col_type) + call pbuf_get_field(pbuf, snow_sed_idx, snow_sed, col_type=col_type) + call pbuf_get_field(pbuf, nevapr_idx, nevapr, col_type=col_type) + call pbuf_get_field(pbuf, prer_evap_idx, prer_evap, col_type=col_type) + call pbuf_get_field(pbuf, prain_idx, prain, col_type=col_type) + call pbuf_get_field(pbuf, dei_idx, dei, col_type=col_type) + call pbuf_get_field(pbuf, mu_idx, mu, col_type=col_type) + call pbuf_get_field(pbuf, lambdac_idx, lambdac, col_type=col_type) + call pbuf_get_field(pbuf, des_idx, des, col_type=col_type) + call pbuf_get_field(pbuf, ls_flxprc_idx, mgflxprc, col_type=col_type) + call pbuf_get_field(pbuf, ls_flxsnw_idx, mgflxsnw, col_type=col_type) + call pbuf_get_field(pbuf, ls_mrprc_idx, mgmrprc, col_type=col_type) + call pbuf_get_field(pbuf, ls_mrsnw_idx, mgmrsnw, col_type=col_type) + call pbuf_get_field(pbuf, cv_reffliq_idx, cvreffliq, col_type=col_type) + call pbuf_get_field(pbuf, cv_reffice_idx, cvreffice, col_type=col_type) + call pbuf_get_field(pbuf, iciwpst_idx, iciwpst, col_type=col_type) + call pbuf_get_field(pbuf, iclwpst_idx, iclwpst, col_type=col_type) + call pbuf_get_field(pbuf, icswp_idx, icswp, col_type=col_type) + call pbuf_get_field(pbuf, rel_idx, rel, col_type=col_type) + call pbuf_get_field(pbuf, rei_idx, rei, col_type=col_type) + call pbuf_get_field(pbuf, sadice_idx, sadice, col_type=col_type) + call pbuf_get_field(pbuf, sadsnow_idx, sadsnow, col_type=col_type) + call pbuf_get_field(pbuf, wsedl_idx, wsedl, col_type=col_type) + call pbuf_get_field(pbuf, qme_idx, qme, col_type=col_type) + call pbuf_get_field(pbuf, bergso_idx, bergso, col_type=col_type) + if (degrau_idx > 0) call pbuf_get_field(pbuf, degrau_idx, degrau, col_type=col_type) + if (icgrauwp_idx > 0) call pbuf_get_field(pbuf, icgrauwp_idx, icgrauwp, col_type=col_type) + if (cldfgrau_idx > 0) call pbuf_get_field(pbuf, cldfgrau_idx, cldfgrau, col_type=col_type) + + call pbuf_get_field(pbuf, cldo_idx, cldo, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_t_idx, CC_t, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_qv_idx, CC_qv, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_ql_idx, CC_ql, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_qi_idx, CC_qi, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_nl_idx, CC_nl, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_ni_idx, CC_ni, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_qlst_idx, CC_qlst, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + + if (rate1_cw2pr_st_idx > 0) then + call pbuf_get_field(pbuf, rate1_cw2pr_st_idx, rate1ord_cw2pr_st, col_type=col_type) + end if + + if (qrain_idx > 0) call pbuf_get_field(pbuf, qrain_idx, qrout_grid_ptr) + if (qsnow_idx > 0) call pbuf_get_field(pbuf, qsnow_idx, qsout_grid_ptr) + if (nrain_idx > 0) call pbuf_get_field(pbuf, nrain_idx, nrout_grid_ptr) + if (nsnow_idx > 0) call pbuf_get_field(pbuf, nsnow_idx, nsout_grid_ptr) + if (qcsedten_idx > 0) call pbuf_get_field(pbuf, qcsedten_idx, qcsedtenout_grid_ptr) + if (qrsedten_idx > 0) call pbuf_get_field(pbuf, qrsedten_idx, qrsedtenout_grid_ptr) + if (qisedten_idx > 0) call pbuf_get_field(pbuf, qisedten_idx, qisedtenout_grid_ptr) + if (qssedten_idx > 0) call pbuf_get_field(pbuf, qssedten_idx, qssedtenout_grid_ptr) + if (vtrmc_idx > 0) call pbuf_get_field(pbuf, vtrmc_idx, vtrmcout_grid_ptr) + if (umr_idx > 0) call pbuf_get_field(pbuf, umr_idx, umrout_grid_ptr) + if (vtrmi_idx > 0) call pbuf_get_field(pbuf, vtrmi_idx, vtrmiout_grid_ptr) + if (ums_idx > 0) call pbuf_get_field(pbuf, ums_idx, umsout_grid_ptr) + if (qcsevap_idx > 0) call pbuf_get_field(pbuf, qcsevap_idx, qcsevapout_grid_ptr) + if (qisevap_idx > 0) call pbuf_get_field(pbuf, qisevap_idx, qisevapout_grid_ptr) + + !----------------------- + ! If subcolumns is turned on, all calculated fields which are on subcolumns + ! need to be retrieved on the grid as well for storing averaged values + + if (use_subcol_microp) then + call pbuf_get_field(pbuf, prec_str_idx, prec_str_grid) + call pbuf_get_field(pbuf, snow_str_idx, snow_str_grid) + call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw_grid) + call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw_grid) + call pbuf_get_field(pbuf, prec_sed_idx, prec_sed_grid) + call pbuf_get_field(pbuf, snow_sed_idx, snow_sed_grid) + call pbuf_get_field(pbuf, nevapr_idx, nevapr_grid) + call pbuf_get_field(pbuf, prain_idx, prain_grid) + call pbuf_get_field(pbuf, dei_idx, dei_grid) + call pbuf_get_field(pbuf, mu_idx, mu_grid) + call pbuf_get_field(pbuf, lambdac_idx, lambdac_grid) + call pbuf_get_field(pbuf, des_idx, des_grid) + call pbuf_get_field(pbuf, ls_flxprc_idx, mgflxprc_grid) + call pbuf_get_field(pbuf, ls_flxsnw_idx, mgflxsnw_grid) + call pbuf_get_field(pbuf, ls_mrprc_idx, mgmrprc_grid) + call pbuf_get_field(pbuf, ls_mrsnw_idx, mgmrsnw_grid) + call pbuf_get_field(pbuf, cv_reffliq_idx, cvreffliq_grid) + call pbuf_get_field(pbuf, cv_reffice_idx, cvreffice_grid) + call pbuf_get_field(pbuf, iciwpst_idx, iciwpst_grid) + call pbuf_get_field(pbuf, iclwpst_idx, iclwpst_grid) + call pbuf_get_field(pbuf, icswp_idx, icswp_grid) + call pbuf_get_field(pbuf, rel_idx, rel_grid) + call pbuf_get_field(pbuf, rei_idx, rei_grid) + call pbuf_get_field(pbuf, sadice_idx, sadice_grid) + call pbuf_get_field(pbuf, sadsnow_idx, sadsnow_grid) + call pbuf_get_field(pbuf, wsedl_idx, wsedl_grid) + call pbuf_get_field(pbuf, qme_idx, qme_grid) + call pbuf_get_field(pbuf, bergso_idx, bergso_grid) + if (degrau_idx > 0) call pbuf_get_field(pbuf, degrau_idx, degrau_grid) + if (icgrauwp_idx > 0) call pbuf_get_field(pbuf, icgrauwp_idx, icgrauwp_grid) + if (cldfgrau_idx > 0) call pbuf_get_field(pbuf, cldfgrau_idx, cldfgrau_grid) + + call pbuf_get_field(pbuf, cldo_idx, cldo_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_t_idx, CC_t_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_qv_idx, CC_qv_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_ql_idx, CC_ql_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_qi_idx, CC_qi_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_nl_idx, CC_nl_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_ni_idx, CC_ni_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_qlst_idx, CC_qlst_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if (rate1_cw2pr_st_idx > 0) then + call pbuf_get_field(pbuf, rate1_cw2pr_st_idx, rate1ord_cw2pr_st_grid) + end if + + end if + + !----------------------- + ! These are only on the grid regardless of whether subcolumns are turned on or not + call pbuf_get_field(pbuf, ls_reffrain_idx, mgreffrain_grid) + call pbuf_get_field(pbuf, ls_reffsnow_idx, mgreffsnow_grid) + call pbuf_get_field(pbuf, acpr_idx, acprecl_grid) + call pbuf_get_field(pbuf, acgcme_idx, acgcme_grid) + call pbuf_get_field(pbuf, acnum_idx, acnum_grid) + call pbuf_get_field(pbuf, cmeliq_idx, cmeliq_grid) + call pbuf_get_field(pbuf, ast_idx, ast_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + call pbuf_get_field(pbuf, evprain_st_idx, evprain_st_grid) + call pbuf_get_field(pbuf, evpsnow_st_idx, evpsnow_st_grid) + call pbuf_get_field(pbuf, am_evp_st_idx, am_evp_st_grid) + + !----------------------------------------------------------------------- + ! ... Calculate cosine of zenith angle + ! then cast back to angle (radians) + !----------------------------------------------------------------------- + zen_angle(:) = 0.0_r8 + rlats(:) = 0.0_r8 + rlons(:) = 0.0_r8 + calday = get_curr_calday() + call get_rlat_all_p( lchnk, ncol, rlats ) + call get_rlon_all_p( lchnk, ncol, rlons ) + call zenith( calday, rlats, rlons, zen_angle, ncol ) + where (zen_angle(:) <= 1.0_r8 .and. zen_angle(:) >= -1.0_r8) + zen_angle(:) = acos( zen_angle(:) ) + elsewhere + zen_angle(:) = 0.0_r8 + end where + + sza(:) = zen_angle(:) * rad2deg + call outfld( 'rbSZA', sza, ncol, lchnk ) + + !------------------------------------------------------------------------------------- + ! Microphysics assumes 'liquid stratus frac = ice stratus frac + ! = max( liquid stratus frac, ice stratus frac )'. + alst_mic => ast + aist_mic => ast + + ! Output initial in-cloud LWP (before microphysics) + + iclwpi = 0._r8 + iciwpi = 0._r8 + + do i = 1, ncol + do k = top_lev, pver + iclwpi(i) = iclwpi(i) + & + min(state%q(i,k,ixcldliq) / max(mincld,ast(i,k)),0.005_r8) & + * state%pdel(i,k) / gravit + iciwpi(i) = iciwpi(i) + & + min(state%q(i,k,ixcldice) / max(mincld,ast(i,k)),0.005_r8) & + * state%pdel(i,k) / gravit + end do + end do + + cldo(:ncol,top_lev:pver)=ast(:ncol,top_lev:pver) + + ! Initialize local state from input. + call physics_state_copy(state, state_loc) + + ! Because of the of limited vertical resolution, there can be a signifcant + ! warm bias at the cold point tropopause, which can create a wet bias in the + ! stratosphere. For the microphysics only, update the cold point temperature, with + ! an estimate of the coldest point between the model layers. + if (micro_mg_adjust_cpt) then + cp_rh(:ncol, :pver) = 0._r8 + cp_dt(:ncol) = 0._r8 + cp_dz(:ncol) = 0._r8 + + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + troplev(:) = 0 + cp_z(:) = 0._r8 + cp_t(:) = 0._r8 + !REMOVECAM_END + call tropopause_find_cam(state_loc, troplev, primary=TROP_ALG_CPP, backup=TROP_ALG_NONE, & + tropZ=cp_z, tropT=cp_t) + + do i = 1, ncol + + ! Update statistics and output results. + if (troplev(i) .ne. NOTFOUND) then + cp_dt(i) = cp_t(i) - state_loc%t(i,troplev(i)) + cp_dz(i) = cp_z(i) - state_loc%zm(i,troplev(i)) + + ! NOTE: This change in temperature is just for the microphysics + ! and should not be added to any tendencies or used to update + ! any states + state_loc%t(i,troplev(i)) = state_loc%t(i,troplev(i)) + cp_dt(i) + end if + end do + + ! Output all of the statistics related to the cold point + ! tropopause adjustment. Th cold point information itself is + ! output in tropopause.F90. + call outfld("TROPF_TADJ", state_loc%t, pcols, lchnk) + call outfld("TROPF_CDT", cp_dt, pcols, lchnk) + call outfld("TROPF_CDZ", cp_dz, pcols, lchnk) + end if + + ! Initialize ptend for output. + lq = .false. + lq(ixq) = .true. + lq(ixcldliq) = .true. + lq(ixcldice) = .true. + lq(ixnumliq) = .true. + lq(ixnumice) = .true. + if (micro_mg_version > 1) then + lq(ixrain) = .true. + lq(ixsnow) = .true. + lq(ixnumrain) = .true. + lq(ixnumsnow) = .true. + end if + if (micro_mg_version > 2) then + lq(ixgraupel) = .true. + lq(ixnumgraupel) = .true. + end if + + ! the name 'cldwat' triggers special tests on cldliq + ! and cldice in physics_update + call physics_ptend_init(ptend, psetcols, "cldwat", ls=.true., lq=lq) + + if (micro_mg_version > 2) then + state_loc_graup(:ncol,:) = state_loc%q(:ncol,:,ixgraupel) + state_loc_numgraup(:ncol,:) = state_loc%q(:ncol,:,ixnumgraupel) + else + state_loc_graup(:ncol,:) = 0._r8 + state_loc_numgraup(:ncol,:) = 0._r8 + end if + + ! Zero out diagnostic rainbow arrays + rbfreq = 0._r8 + rbfrac = 0._r8 + + ! Zero out values above top_lev before passing into _tend for some pbuf variables that are inputs + naai(:ncol,:top_lev-1) = 0._r8 + npccn(:ncol,:top_lev-1) = 0._r8 + + ! The null value for qsatfac is 1, not zero + qsatfac(:ncol,:top_lev-1) = 1._r8 + + ! Zero out values above top_lev for all output variables + tlat(:ncol,:top_lev-1)=0._r8 + qvlat(:ncol,:top_lev-1)=0._r8 + qcten(:ncol,:top_lev-1)=0._r8 + qiten(:ncol,:top_lev-1)=0._r8 + ncten(:ncol,:top_lev-1)=0._r8 + niten(:ncol,:top_lev-1)=0._r8 + qrten(:ncol,:top_lev-1)=0._r8 + qsten(:ncol,:top_lev-1)=0._r8 + nrten(:ncol,:top_lev-1)=0._r8 + nsten(:ncol,:top_lev-1)=0._r8 + qgten(:ncol,:top_lev-1)=0._r8 + ngten(:ncol,:top_lev-1)=0._r8 + rel(:ncol,:top_lev-1)=0._r8 + rel_fn_dum(:ncol,:top_lev-1)=0._r8 + rei(:ncol,:top_lev-1)=0._r8 + sadice(:ncol,:top_lev-1)=0._r8 + sadsnow(:ncol,:top_lev-1)=0._r8 + prect(:ncol)=0._r8 + preci(:ncol)=0._r8 + nevapr(:ncol,:top_lev-1)=0._r8 + evapsnow(:ncol,:top_lev-1)=0._r8 + am_evp_st(:ncol,:top_lev-1)=0._r8 + prain(:ncol,:top_lev-1)=0._r8 + prodsnow(:ncol,:top_lev-1)=0._r8 + cmeice(:ncol,:top_lev-1)=0._r8 + dei(:ncol,:top_lev-1)=0._r8 + mu(:ncol,:top_lev-1)=0._r8 + lambdac(:ncol,:top_lev-1)=0._r8 + qsout(:ncol,:top_lev-1)=0._r8 + des(:ncol,:top_lev-1)=0._r8 + qgout(:ncol,:top_lev-1)=0._r8 + ngout(:ncol,:top_lev-1)=0._r8 + dgout(:ncol,:top_lev-1)=0._r8 + cflx(:ncol,:top_lev-1)=0._r8 + iflx(:ncol,:top_lev-1)=0._r8 + gflx(:ncol,:top_lev-1)=0._r8 + rflx(:ncol,:top_lev-1)=0._r8 + sflx(:ncol,:top_lev-1)=0._r8 + qrout(:ncol,:top_lev-1)=0._r8 + reff_rain_dum(:ncol,:top_lev-1)=0._r8 + reff_snow_dum(:ncol,:top_lev-1)=0._r8 + reff_grau_dum(:ncol,:top_lev-1)=0._r8 + qcsevap(:ncol,:top_lev-1)=0._r8 + qisevap(:ncol,:top_lev-1)=0._r8 + qvres(:ncol,:top_lev-1)=0._r8 + cmeiout(:ncol,:top_lev-1)=0._r8 + vtrmc(:ncol,:top_lev-1)=0._r8 + vtrmi(:ncol,:top_lev-1)=0._r8 + umr(:ncol,:top_lev-1)=0._r8 + ums(:ncol,:top_lev-1)=0._r8 + umg(:ncol,:top_lev-1)=0._r8 + qgsedten(:ncol,:top_lev-1)=0._r8 + qcsedten(:ncol,:top_lev-1)=0._r8 + qisedten(:ncol,:top_lev-1)=0._r8 + qrsedten(:ncol,:top_lev-1)=0._r8 + qssedten(:ncol,:top_lev-1)=0._r8 + prao(:ncol,:top_lev-1)=0._r8 + prco(:ncol,:top_lev-1)=0._r8 + mnuccco(:ncol,:top_lev-1)=0._r8 + mnuccto(:ncol,:top_lev-1)=0._r8 + msacwio(:ncol,:top_lev-1)=0._r8 + psacwso(:ncol,:top_lev-1)=0._r8 + bergso(:ncol,:top_lev-1)=0._r8 + bergo(:ncol,:top_lev-1)=0._r8 + melto(:ncol,:top_lev-1)=0._r8 + meltstot(:ncol,:top_lev-1)=0._r8 + meltgtot(:ncol,:top_lev-1)=0._r8 + homoo(:ncol,:top_lev-1)=0._r8 + qcreso(:ncol,:top_lev-1)=0._r8 + prcio(:ncol,:top_lev-1)=0._r8 + praio(:ncol,:top_lev-1)=0._r8 + qireso(:ncol,:top_lev-1)=0._r8 + mnuccro(:ncol,:top_lev-1)=0._r8 + mnudepo(:ncol,:top_lev-1)=0._r8 + mnuccrio(:ncol,:top_lev-1)=0._r8 + pracso(:ncol,:top_lev-1)=0._r8 + meltsdt(:ncol,:top_lev-1)=0._r8 + frzrdt(:ncol,:top_lev-1)=0._r8 + mnuccdo(:ncol,:top_lev-1)=0._r8 + pracgo(:ncol,:top_lev-1)=0._r8 + psacwgo(:ncol,:top_lev-1)=0._r8 + pgracso(:ncol,:top_lev-1)=0._r8 + prdgo(:ncol,:top_lev-1)=0._r8 + qmultgo(:ncol,:top_lev-1)=0._r8 + qmultrgo(:ncol,:top_lev-1)=0._r8 + psacro(:ncol,:top_lev-1)=0._r8 + npracgo(:ncol,:top_lev-1)=0._r8 + nscngo(:ncol,:top_lev-1)=0._r8 + ngracso(:ncol,:top_lev-1)=0._r8 + nmultgo(:ncol,:top_lev-1)=0._r8 + nmultrgo(:ncol,:top_lev-1)=0._r8 + npsacwgo(:ncol,:top_lev-1)=0._r8 + nrout(:ncol,:top_lev-1)=0._r8 + nsout(:ncol,:top_lev-1)=0._r8 + refl(:ncol,:top_lev-1)=0._r8 + arefl(:ncol,:top_lev-1)=0._r8 + areflz(:ncol,:top_lev-1)=0._r8 + frefl(:ncol,:top_lev-1)=0._r8 + csrfl(:ncol,:top_lev-1)=0._r8 + acsrfl(:ncol,:top_lev-1)=0._r8 + fcsrfl(:ncol,:top_lev-1)=0._r8 + rercld(:ncol,:top_lev-1)=0._r8 + ncai(:ncol,:top_lev-1)=0._r8 + ncal(:ncol,:top_lev-1)=0._r8 + qrout2(:ncol,:top_lev-1)=0._r8 + qsout2(:ncol,:top_lev-1)=0._r8 + nrout2(:ncol,:top_lev-1)=0._r8 + nsout2(:ncol,:top_lev-1)=0._r8 + qgout2(:ncol,:top_lev-1)=0._r8 + ngout2(:ncol,:top_lev-1)=0._r8 + dgout2(:ncol,:top_lev-1)=0._r8 + freqg(:ncol,:top_lev-1)=0._r8 + freqs(:ncol,:top_lev-1)=0._r8 + freqr(:ncol,:top_lev-1)=0._r8 + nfice(:ncol,:top_lev-1)=0._r8 + qcrat(:ncol,:top_lev-1)=0._r8 + tnd_qsnow(:ncol,:top_lev-1)=0._r8 + tnd_nsnow(:ncol,:top_lev-1)=0._r8 + re_ice(:ncol,:top_lev-1)=0._r8 + prer_evap(:ncol,:top_lev-1)=0._r8 + frzimm(:ncol,:top_lev-1)=0._r8 + frzcnt(:ncol,:top_lev-1)=0._r8 + frzdep(:ncol,:top_lev-1)=0._r8 + + do it = 1, num_steps + + select case (micro_mg_version) + case (1) + select case (micro_mg_sub_version) + case (0) + call micro_mg_tend1_0( & + microp_uniform, ncol, nlev, ncol, 1, dtime/num_steps, & + state_loc%t(:ncol,top_lev:), state_loc%q(:ncol,top_lev:,ixq), state_loc%q(:ncol,top_lev:,ixcldliq), & + state_loc%q(:ncol,top_lev:,ixcldice), state_loc%q(:ncol,top_lev:,ixnumliq), & + state_loc%q(:ncol,top_lev:,ixnumice), state_loc%pmid(:ncol,top_lev:), state_loc%pdel(:ncol,top_lev:), & + ast(:ncol,top_lev:), alst_mic(:ncol,top_lev:),& + relvar(:ncol,top_lev:), accre_enhan(:ncol,top_lev:), & + aist_mic(:ncol,top_lev:), rate1cld(:ncol,top_lev:), naai(:ncol,top_lev:), npccn(:ncol,top_lev:), & + rndst(:ncol,top_lev:,:), nacon(:ncol,top_lev:,:), tlat(:ncol,top_lev:), qvlat(:ncol,top_lev:), & + qcten(:ncol,top_lev:), & + qiten(:ncol,top_lev:), ncten(:ncol,top_lev:), niten(:ncol,top_lev:), rel(:ncol,top_lev:), & + rel_fn_dum(:ncol,top_lev:), & + rei(:ncol,top_lev:), prect(:ncol), preci(:ncol), nevapr(:ncol,top_lev:), evapsnow(:ncol,top_lev:), & + am_evp_st(:ncol,top_lev:), & + prain(:ncol,top_lev:), prodsnow(:ncol,top_lev:), cmeice(:ncol,top_lev:), dei(:ncol,top_lev:), mu(:ncol,top_lev:), & + lambdac(:ncol,top_lev:), qsout(:ncol,top_lev:), des(:ncol,top_lev:), rflx(:ncol,top_lev:), sflx(:ncol,top_lev:), & + qrout(:ncol,top_lev:), reff_rain_dum(:ncol,top_lev:), reff_snow_dum(:ncol,top_lev:), qcsevap(:ncol,top_lev:), & + qisevap(:ncol,top_lev:), & + qvres(:ncol,top_lev:), cmeiout(:ncol,top_lev:), vtrmc(:ncol,top_lev:), vtrmi(:ncol,top_lev:), & + qcsedten(:ncol,top_lev:), & + qisedten(:ncol,top_lev:), prao(:ncol,top_lev:), prco(:ncol,top_lev:), mnuccco(:ncol,top_lev:), & + mnuccto(:ncol,top_lev:), & + msacwio(:ncol,top_lev:), psacwso(:ncol,top_lev:), bergso(:ncol,top_lev:), bergo(:ncol,top_lev:), & + melto(:ncol,top_lev:), & + homoo(:ncol,top_lev:), qcreso(:ncol,top_lev:), prcio(:ncol,top_lev:), praio(:ncol,top_lev:), & + qireso(:ncol,top_lev:), & + mnuccro(:ncol,top_lev:), pracso(:ncol,top_lev:), meltsdt(:ncol,top_lev:), frzrdt(:ncol,top_lev:), & + mnuccdo(:ncol,top_lev:), & + nrout(:ncol,top_lev:), nsout(:ncol,top_lev:), refl(:ncol,top_lev:), arefl(:ncol,top_lev:), areflz(:ncol,top_lev:),& + frefl(:ncol,top_lev:), csrfl(:ncol,top_lev:), acsrfl(:ncol,top_lev:), fcsrfl(:ncol,top_lev:), & + rercld(:ncol,top_lev:), & + ncai(:ncol,top_lev:), ncal(:ncol,top_lev:), qrout2(:ncol,top_lev:), qsout2(:ncol,top_lev:), & + nrout2(:ncol,top_lev:), & + nsout2(:ncol,top_lev:), drout_dum(:ncol,top_lev:), dsout2_dum(:ncol,top_lev:), freqs(:ncol,top_lev:),& + freqr(:ncol,top_lev:), & + nfice(:ncol,top_lev:), prer_evap(:ncol,top_lev:), do_cldice, errstring, & + tnd_qsnow(:ncol,top_lev:), tnd_nsnow(:ncol,top_lev:), re_ice(:ncol,top_lev:), & + frzimm(:ncol,top_lev:), frzcnt(:ncol,top_lev:), frzdep(:ncol,top_lev:)) + + end select + case(2:3) + call micro_pumas_tend( & + ncol, nlev, dtime/num_steps,& + state_loc%t(:ncol,top_lev:), state_loc%q(:ncol,top_lev:,ixq), & + state_loc%q(:ncol,top_lev:,ixcldliq), state_loc%q(:ncol,top_lev:,ixcldice), & + state_loc%q(:ncol,top_lev:,ixnumliq), state_loc%q(:ncol,top_lev:,ixnumice), & + state_loc%q(:ncol,top_lev:,ixrain), state_loc%q(:ncol,top_lev:,ixsnow), & + state_loc%q(:ncol,top_lev:,ixnumrain), state_loc%q(:ncol,top_lev:,ixnumsnow), & + state_loc_graup(:ncol,top_lev:), state_loc_numgraup(:ncol,top_lev:), & + relvar(:ncol,top_lev:), accre_enhan(:ncol,top_lev:), & + state_loc%pmid(:ncol,top_lev:), state_loc%pdel(:ncol,top_lev:), & + ast(:ncol,top_lev:), alst_mic(:ncol,top_lev:), aist_mic(:ncol,top_lev:), qsatfac(:ncol,top_lev:), & + rate1cld(:ncol,top_lev:), & + naai(:ncol,top_lev:), npccn(:ncol,top_lev:), & + rndst(:ncol,top_lev:,:), nacon(:ncol,top_lev:,:), & + tlat(:ncol,top_lev:), qvlat(:ncol,top_lev:), & + qcten(:ncol,top_lev:), qiten(:ncol,top_lev:), & + ncten(:ncol,top_lev:), niten(:ncol,top_lev:), & + qrten(:ncol,top_lev:), qsten(:ncol,top_lev:), & + nrten(:ncol,top_lev:), nsten(:ncol,top_lev:), & + qgten(:ncol,top_lev:), ngten(:ncol,top_lev:), & + rel(:ncol,top_lev:), rel_fn_dum(:ncol,top_lev:), rei(:ncol,top_lev:), & + sadice(:ncol,top_lev:), sadsnow(:ncol,top_lev:), & + prect(:ncol), preci(:ncol), & + nevapr(:ncol,top_lev:), evapsnow(:ncol,top_lev:), & + am_evp_st(:ncol,top_lev:), & + prain(:ncol,top_lev:), prodsnow(:ncol,top_lev:), & + cmeice(:ncol,top_lev:), dei(:ncol,top_lev:), & + mu(:ncol,top_lev:), lambdac(:ncol,top_lev:), & + qsout(:ncol,top_lev:), des(:ncol,top_lev:), & + qgout(:ncol,top_lev:), ngout(:ncol,top_lev:), dgout(:ncol,top_lev:), & + cflx(:ncol,top_lev:), iflx(:ncol,top_lev:), & + gflx(:ncol,top_lev:), & + rflx(:ncol,top_lev:), sflx(:ncol,top_lev:), qrout(:ncol,top_lev:), & + reff_rain_dum(:ncol,top_lev:), reff_snow_dum(:ncol,top_lev:), reff_grau_dum(:ncol,top_lev:), & + qcsevap(:ncol,top_lev:), qisevap(:ncol,top_lev:), qvres(:ncol,top_lev:), & + cmeiout(:ncol,top_lev:), vtrmc(:ncol,top_lev:), vtrmi(:ncol,top_lev:), & + umr(:ncol,top_lev:), ums(:ncol,top_lev:), & + umg(:ncol,top_lev:), qgsedten(:ncol,top_lev:), & + qcsedten(:ncol,top_lev:), qisedten(:ncol,top_lev:), & + qrsedten(:ncol,top_lev:), qssedten(:ncol,top_lev:), & + prao(:ncol,top_lev:), prco(:ncol,top_lev:), & + mnuccco(:ncol,top_lev:), mnuccto(:ncol,top_lev:), msacwio(:ncol,top_lev:), & + psacwso(:ncol,top_lev:), bergso(:ncol,top_lev:), bergo(:ncol,top_lev:), & + melto(:ncol,top_lev:), meltstot(:ncol,top_lev:), meltgtot(:ncol,top_lev:), homoo(:ncol,top_lev:), & + qcreso(:ncol,top_lev:), prcio(:ncol,top_lev:), praio(:ncol,top_lev:), & + qireso(:ncol,top_lev:), mnuccro(:ncol,top_lev:), mnudepo(:ncol,top_lev:), mnuccrio(:ncol,top_lev:), & + pracso(:ncol,top_lev:), & + meltsdt(:ncol,top_lev:), frzrdt(:ncol,top_lev:), mnuccdo(:ncol,top_lev:), & + pracgo(:ncol,top_lev:), psacwgo(:ncol,top_lev:), pgsacwo(:ncol,top_lev:), & + pgracso(:ncol,top_lev:), prdgo(:ncol,top_lev:), & + qmultgo(:ncol,top_lev:), qmultrgo(:ncol,top_lev:), psacro(:ncol,top_lev:), & + npracgo(:ncol,top_lev:), nscngo(:ncol,top_lev:), ngracso(:ncol,top_lev:), & + nmultgo(:ncol,top_lev:), nmultrgo(:ncol,top_lev:), npsacwgo(:ncol,top_lev:), & + nrout(:ncol,top_lev:), nsout(:ncol,top_lev:), & + refl(:ncol,top_lev:), arefl(:ncol,top_lev:), areflz(:ncol,top_lev:), & + frefl(:ncol,top_lev:), csrfl(:ncol,top_lev:), acsrfl(:ncol,top_lev:), & + fcsrfl(:ncol,top_lev:), rercld(:ncol,top_lev:), & + ncai(:ncol,top_lev:), ncal(:ncol,top_lev:), & + qrout2(:ncol,top_lev:), qsout2(:ncol,top_lev:), & + nrout2(:ncol,top_lev:), nsout2(:ncol,top_lev:), & + drout_dum(:ncol,top_lev:), dsout2_dum(:ncol,top_lev:), & + qgout2(:ncol,top_lev:), ngout2(:ncol,top_lev:), dgout2(:ncol,top_lev:), freqg(:ncol,top_lev:), & + freqs(:ncol,top_lev:), freqr(:ncol,top_lev:), & + nfice(:ncol,top_lev:), qcrat(:ncol,top_lev:), & + errstring, & + tnd_qsnow(:ncol,top_lev:),tnd_nsnow(:ncol,top_lev:),re_ice(:ncol,top_lev:),& + prer_evap(:ncol,top_lev:), & + frzimm(:ncol,top_lev:), frzcnt(:ncol,top_lev:), frzdep(:ncol,top_lev:) ) + end select + + call handle_errmsg(errstring, subname="micro_pumas_tend") + + call physics_ptend_init(ptend_loc, psetcols, "micro_pumas", & + ls=.true., lq=lq) + + ! Set local tendency. + ptend_loc%s(:ncol,top_lev:) = tlat(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixq) = qvlat(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixcldliq) = qcten(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixcldice) = qiten(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixnumliq) = ncten(:ncol,top_lev:) + + if (do_cldice) then + ptend_loc%q(:ncol,top_lev:,ixnumice) = niten(:ncol,top_lev:) + else + ! In this case, the tendency should be all 0. + if (any(niten(:ncol,:) /= 0._r8)) then + call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// & + " but micro_pumas_tend has ice number tendencies.") + end if + ptend_loc%q(:ncol,:,ixnumice) = 0._r8 + end if + + if (micro_mg_version > 1) then + ptend_loc%q(:ncol,top_lev:,ixrain) = qrten(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixsnow) = qsten(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixnumrain) = nrten(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixnumsnow) = nsten(:ncol,top_lev:) + end if + + if (micro_mg_version > 2) then + ptend_loc%q(:ncol,top_lev:,ixgraupel) = qgten(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixnumgraupel) = ngten(:ncol,top_lev:) + end if + + ! Sum into overall ptend + call physics_ptend_sum(ptend_loc, ptend, ncol) + + ! Update local state + call physics_update(state_loc, ptend_loc, dtime/num_steps) + + end do + + ! Divide ptend by substeps. + call physics_ptend_scale(ptend, 1._r8/num_steps, ncol) + + ! Check to make sure that the microphysics code is respecting the flags that control + ! whether MG should be prognosing cloud ice and cloud liquid or not. + if (.not. do_cldice) then + if (any(ptend%q(:ncol,top_lev:pver,ixcldice) /= 0.0_r8)) & + call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// & + " but micro_pumas_tend has ice mass tendencies.") + if (any(ptend%q(:ncol,top_lev:pver,ixnumice) /= 0.0_r8)) & + call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// & + " but micro_pumas_tend has ice number tendencies.") + end if + if (.not. do_cldliq) then + if (any(ptend%q(:ncol,top_lev:pver,ixcldliq) /= 0.0_r8)) & + call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud liquid,"// & + " but micro_pumas_tend has liquid mass tendencies.") + if (any(ptend%q(:ncol,top_lev:pver,ixnumliq) /= 0.0_r8)) & + call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud liquid,"// & + " but micro_pumas_tend has liquid number tendencies.") + end if + + mnuccdohet = 0._r8 + do k=top_lev,pver + do i=1,ncol + if (naai(i,k) > 0._r8) then + mnuccdohet(i,k) = mnuccdo(i,k) - (naai_hom(i,k)/naai(i,k))*mnuccdo(i,k) + end if + end do + end do + + mgflxprc(:ncol,top_lev:pverp) = rflx(:ncol,top_lev:pverp) + sflx(:ncol,top_lev:pverp) + mgflxsnw(:ncol,top_lev:pverp) = sflx(:ncol,top_lev:pverp) + + !add condensate fluxes for MG2 (ice and snow already added for MG1) + if (micro_mg_version >= 2) then + mgflxprc(:ncol,top_lev:pverp) = mgflxprc(:ncol,top_lev:pverp)+ iflx(:ncol,top_lev:pverp) + cflx(:ncol,top_lev:pverp) + mgflxsnw(:ncol,top_lev:pverp) = mgflxsnw(:ncol,top_lev:pverp) + iflx(:ncol,top_lev:pverp) + end if + + !add graupel fluxes for MG3 to snow flux + if (micro_mg_version >= 3) then + mgflxprc(:ncol,top_lev:pverp) = mgflxprc(:ncol,top_lev:pverp)+gflx(:ncol,top_lev:pverp) + mgflxsnw(:ncol,top_lev:pverp) = mgflxsnw(:ncol,top_lev:pverp)+gflx(:ncol,top_lev:pverp) + end if + + mgmrprc(:ncol,top_lev:pver) = qrout(:ncol,top_lev:pver) + qsout(:ncol,top_lev:pver) + mgmrsnw(:ncol,top_lev:pver) = qsout(:ncol,top_lev:pver) + + !! calculate effective radius of convective liquid and ice using dcon and deicon (not used by code, not useful for COSP) + !! hard-coded as average of hard-coded values used for deep/shallow convective detrainment (near line 1502/1505) + cvreffliq(:ncol,top_lev:pver) = 9.0_r8 + cvreffice(:ncol,top_lev:pver) = 37.0_r8 + + ! Reassign rate1 if modal aerosols + if (rate1_cw2pr_st_idx > 0) then + rate1ord_cw2pr_st(:ncol,top_lev:pver) = rate1cld(:ncol,top_lev:pver) + end if + + ! Sedimentation velocity for liquid stratus cloud droplet + wsedl(:ncol,top_lev:pver) = vtrmc(:ncol,top_lev:pver) + + ! Microphysical tendencies for use in the macrophysics at the next time step + CC_T(:ncol,top_lev:pver) = tlat(:ncol,top_lev:pver)/cpair + CC_qv(:ncol,top_lev:pver) = qvlat(:ncol,top_lev:pver) + CC_ql(:ncol,top_lev:pver) = qcten(:ncol,top_lev:pver) + CC_qi(:ncol,top_lev:pver) = qiten(:ncol,top_lev:pver) + CC_nl(:ncol,top_lev:pver) = ncten(:ncol,top_lev:pver) + CC_ni(:ncol,top_lev:pver) = niten(:ncol,top_lev:pver) + CC_qlst(:ncol,top_lev:pver) = qcten(:ncol,top_lev:pver)/max(0.01_r8,alst_mic(:ncol,top_lev:pver)) + + ! Net micro_pumas_cam condensation rate + qme(:ncol,:top_lev-1) = 0._r8 + qme(:ncol,top_lev:pver) = cmeliq(:ncol,top_lev:pver) + cmeiout(:ncol,top_lev:pver) + + bergso(:ncol,:top_lev-1) = 0._r8 + + ! For precip, accumulate only total precip in prec_pcw and snow_pcw variables. + ! Other precip output variables are set to 0 + ! Do not subscript by ncol here, because in physpkg we divide the whole + ! array and need to avoid an FPE due to uninitialized data. + prec_pcw = prect + snow_pcw = preci + prec_sed = 0._r8 + snow_sed = 0._r8 + prec_str = prec_pcw + prec_sed + snow_str = snow_pcw + snow_sed + + icecldf(:ncol,top_lev:pver) = ast(:ncol,top_lev:pver) + liqcldf(:ncol,top_lev:pver) = ast(:ncol,top_lev:pver) + + ! ------------------------------------------------------------ ! + ! Compute in cloud ice and liquid mixing ratios ! + ! Note that 'iclwp, iciwp' are used for radiation computation. ! + ! ------------------------------------------------------------ ! + + icinc = 0._r8 + icwnc = 0._r8 + iciwpst = 0._r8 + iclwpst = 0._r8 + icswp = 0._r8 + cldfsnow = 0._r8 + if (micro_mg_version > 2) then + icgrauwp = 0._r8 + cldfgrau = 0._r8 + end if + + do k = top_lev, pver + do i = 1, ncol + ! Limits for in-cloud mixing ratios consistent with MG microphysics + ! in-cloud mixing ratio maximum limit of 0.005 kg/kg + icimrst(i,k) = min( state_loc%q(i,k,ixcldice) / max(mincld,icecldf(i,k)),0.005_r8 ) + icwmrst(i,k) = min( state_loc%q(i,k,ixcldliq) / max(mincld,liqcldf(i,k)),0.005_r8 ) + icinc(i,k) = state_loc%q(i,k,ixnumice) / max(mincld,icecldf(i,k)) * & + state_loc%pmid(i,k) / (287.15_r8*state_loc%t(i,k)) + icwnc(i,k) = state_loc%q(i,k,ixnumliq) / max(mincld,liqcldf(i,k)) * & + state_loc%pmid(i,k) / (287.15_r8*state_loc%t(i,k)) + ! Calculate micro_pumas_cam cloud water paths in each layer + ! Note: uses stratiform cloud fraction! + iciwpst(i,k) = min(state_loc%q(i,k,ixcldice)/max(mincld,ast(i,k)),0.005_r8) * state_loc%pdel(i,k) / gravit + iclwpst(i,k) = min(state_loc%q(i,k,ixcldliq)/max(mincld,ast(i,k)),0.005_r8) * state_loc%pdel(i,k) / gravit + + ! ------------------------------ ! + ! Adjust cloud fraction for snow ! + ! ------------------------------ ! + cldfsnow(i,k) = cld(i,k) + ! If cloud and only ice ( no convective cloud or ice ), then set to 0. + if( ( cldfsnow(i,k) .gt. 1.e-4_r8 ) .and. & + ( concld(i,k) .lt. 1.e-4_r8 ) .and. & + ( state_loc%q(i,k,ixcldliq) .lt. 1.e-10_r8 ) ) then + cldfsnow(i,k) = 0._r8 + end if + ! If no cloud and snow, then set to 0.25 + if( ( cldfsnow(i,k) .le. 1.e-4_r8 ) .and. ( qsout(i,k) .gt. 1.e-6_r8 ) ) then + cldfsnow(i,k) = 0.25_r8 + end if + ! Calculate in-cloud snow water path + icswp(i,k) = qsout(i,k) / max( mincld, cldfsnow(i,k) ) * state_loc%pdel(i,k) / gravit + + ! --------------------------------- ! + ! Adjust cloud fraction for graupel ! + ! --------------------------------- ! + if (micro_mg_version > 2) then + cldfgrau(i,k) = cld(i,k) + ! If cloud and only ice ( no convective cloud or ice ), then set to 0. + if( ( cldfgrau(i,k) .gt. 1.e-4_r8 ) .and. & + ( concld(i,k) .lt. 1.e-4_r8 ) .and. & + ( state_loc%q(i,k,ixcldliq) .lt. 1.e-10_r8 ) ) then + cldfgrau(i,k) = 0._r8 + end if + ! If no cloud and graupel, then set to 0.25 + if( ( cldfgrau(i,k) .le. 1.e-4_r8 ) .and. ( qgout(i,k) .gt. 1.e-9_r8 ) ) then + cldfgrau(i,k) = 0.25_r8 + end if + + ! Calculate in-cloud snow water path + icgrauwp(i,k) = qgout(i,k) / max( 1.e-2_r8, cldfgrau(i,k) ) * state_loc%pdel(i,k) / gravit + end if + + end do + end do + + ! Calculate cloud fraction for prognostic precip sizes. + if (micro_mg_version > 1) then + ! Cloud fraction for purposes of precipitation is maximum cloud + ! fraction out of all the layers that the precipitation may be + ! falling down from. + cldmax(:ncol,top_lev:) = max(mincld, ast(:ncol,top_lev:)) + do k = top_lev+1, pver + where (state_loc%q(:ncol,k-1,ixrain) >= qsmall .or. & + state_loc%q(:ncol,k-1,ixsnow) >= qsmall) + cldmax(:ncol,k) = max(cldmax(:ncol,k-1), cldmax(:ncol,k)) + end where + end do + end if + + ! ------------------------------------------------------ ! + ! ------------------------------------------------------ ! + ! All code from here to the end is on grid columns only ! + ! ------------------------------------------------------ ! + ! ------------------------------------------------------ ! + + ! Average the fields which are needed later in this paramterization to be on the grid + if (use_subcol_microp) then + call subcol_field_avg(prec_str, ngrdcol, lchnk, prec_str_grid) + call subcol_field_avg(iclwpst, ngrdcol, lchnk, iclwpst_grid) + call subcol_field_avg(cvreffliq, ngrdcol, lchnk, cvreffliq_grid) + call subcol_field_avg(cvreffice, ngrdcol, lchnk, cvreffice_grid) + call subcol_field_avg(mgflxprc, ngrdcol, lchnk, mgflxprc_grid) + call subcol_field_avg(mgflxsnw, ngrdcol, lchnk, mgflxsnw_grid) + call subcol_field_avg(qme, ngrdcol, lchnk, qme_grid) + call subcol_field_avg(nevapr, ngrdcol, lchnk, nevapr_grid) + call subcol_field_avg(prain, ngrdcol, lchnk, prain_grid) + call subcol_field_avg(evapsnow, ngrdcol, lchnk, evpsnow_st_grid) + call subcol_field_avg(bergso, ngrdcol, lchnk, bergso_grid) + + call subcol_field_avg(am_evp_st, ngrdcol, lchnk, am_evp_st_grid) + + ! Average fields which are not in pbuf + call subcol_field_avg(qrout, ngrdcol, lchnk, qrout_grid) + call subcol_field_avg(qsout, ngrdcol, lchnk, qsout_grid) + call subcol_field_avg(nsout, ngrdcol, lchnk, nsout_grid) + call subcol_field_avg(nrout, ngrdcol, lchnk, nrout_grid) + call subcol_field_avg(cld, ngrdcol, lchnk, cld_grid) + call subcol_field_avg(qcreso, ngrdcol, lchnk, qcreso_grid) + call subcol_field_avg(melto, ngrdcol, lchnk, melto_grid) + call subcol_field_avg(mnuccco, ngrdcol, lchnk, mnuccco_grid) + call subcol_field_avg(mnuccto, ngrdcol, lchnk, mnuccto_grid) + call subcol_field_avg(bergo, ngrdcol, lchnk, bergo_grid) + call subcol_field_avg(homoo, ngrdcol, lchnk, homoo_grid) + call subcol_field_avg(msacwio, ngrdcol, lchnk, msacwio_grid) + call subcol_field_avg(psacwso, ngrdcol, lchnk, psacwso_grid) + call subcol_field_avg(cmeiout, ngrdcol, lchnk, cmeiout_grid) + call subcol_field_avg(qireso, ngrdcol, lchnk, qireso_grid) + call subcol_field_avg(prcio, ngrdcol, lchnk, prcio_grid) + call subcol_field_avg(praio, ngrdcol, lchnk, praio_grid) + call subcol_field_avg(icwmrst, ngrdcol, lchnk, icwmrst_grid) + call subcol_field_avg(icimrst, ngrdcol, lchnk, icimrst_grid) + call subcol_field_avg(liqcldf, ngrdcol, lchnk, liqcldf_grid) + call subcol_field_avg(icecldf, ngrdcol, lchnk, icecldf_grid) + call subcol_field_avg(icwnc, ngrdcol, lchnk, icwnc_grid) + call subcol_field_avg(icinc, ngrdcol, lchnk, icinc_grid) + call subcol_field_avg(state_loc%pdel, ngrdcol, lchnk, pdel_grid) + call subcol_field_avg(prao, ngrdcol, lchnk, prao_grid) + call subcol_field_avg(prco, ngrdcol, lchnk, prco_grid) + + call subcol_field_avg(state_loc%q(:,:,ixnumliq), ngrdcol, lchnk, nc_grid) + call subcol_field_avg(state_loc%q(:,:,ixnumice), ngrdcol, lchnk, ni_grid) + + call subcol_field_avg(qcsedten, ngrdcol, lchnk, qcsedtenout_grid) + call subcol_field_avg(qisedten, ngrdcol, lchnk, qisedtenout_grid) + call subcol_field_avg(vtrmc, ngrdcol, lchnk, vtrmcout_grid) + call subcol_field_avg(vtrmi, ngrdcol, lchnk, vtrmiout_grid) + call subcol_field_avg(qcsevap, ngrdcol, lchnk, qcsevapout_grid) + call subcol_field_avg(qisevap, ngrdcol, lchnk, qisevapout_grid) + + if (micro_mg_version > 1) then + call subcol_field_avg(cldmax, ngrdcol, lchnk, cldmax_grid) + + call subcol_field_avg(state_loc%q(:,:,ixrain), ngrdcol, lchnk, qr_grid) + call subcol_field_avg(state_loc%q(:,:,ixnumrain), ngrdcol, lchnk, nr_grid) + call subcol_field_avg(state_loc%q(:,:,ixsnow), ngrdcol, lchnk, qs_grid) + call subcol_field_avg(state_loc%q(:,:,ixnumsnow), ngrdcol, lchnk, ns_grid) + call subcol_field_avg(qrsedten, ngrdcol, lchnk, qrsedtenout_grid) + call subcol_field_avg(qssedten, ngrdcol, lchnk, qssedtenout_grid) + call subcol_field_avg(umr, ngrdcol, lchnk, umrout_grid) + call subcol_field_avg(ums, ngrdcol, lchnk, umsout_grid) + end if + + if (micro_mg_version > 2) then + call subcol_field_avg(state_loc%q(:,:,ixgraupel), ngrdcol, lchnk, qg_grid) + call subcol_field_avg(state_loc%q(:,:,ixnumgraupel), ngrdcol, lchnk, ng_grid) + call subcol_field_avg(psacro, ngrdcol, lchnk, psacro_grid) + call subcol_field_avg(pracgo, ngrdcol, lchnk, pracgo_grid) + call subcol_field_avg(psacwgo, ngrdcol, lchnk, psacwgo_grid) + call subcol_field_avg(pgsacwo, ngrdcol, lchnk, pgsacwo_grid) + call subcol_field_avg(pgracso, ngrdcol, lchnk, pgracso_grid) + call subcol_field_avg(prdgo, ngrdcol, lchnk, prdgo_grid) + call subcol_field_avg(qmultgo, ngrdcol, lchnk, qmultgo_grid) + call subcol_field_avg(qmultrgo, ngrdcol, lchnk, qmultrgo_grid) + call subcol_field_avg(npracgo, ngrdcol, lchnk, npracgo_grid) + call subcol_field_avg(nscngo, ngrdcol, lchnk, nscngo_grid) + call subcol_field_avg(ngracso, ngrdcol, lchnk, ngracso_grid) + call subcol_field_avg(nmultgo, ngrdcol, lchnk, nmultgo_grid) + call subcol_field_avg(nmultrgo, ngrdcol, lchnk, nmultrgo_grid) + call subcol_field_avg(npsacwgo, ngrdcol, lchnk, npsacwgo_grid) + end if + + else + ! These pbuf fields need to be assigned. There is no corresponding subcol_field_avg + ! as they are reset before being used, so it would be a needless calculation + lambdac_grid => lambdac + mu_grid => mu + rel_grid => rel + rei_grid => rei + sadice_grid => sadice + sadsnow_grid => sadsnow + dei_grid => dei + des_grid => des + degrau_grid => degrau + + ! fields already on grids, so just assign + prec_str_grid => prec_str + iclwpst_grid => iclwpst + cvreffliq_grid => cvreffliq + cvreffice_grid => cvreffice + mgflxprc_grid => mgflxprc + mgflxsnw_grid => mgflxsnw + qme_grid => qme + nevapr_grid => nevapr + prain_grid => prain + bergso_grid => bergso + + am_evp_st_grid = am_evp_st + + evpsnow_st_grid = evapsnow + qrout_grid = qrout + qsout_grid = qsout + nsout_grid = nsout + nrout_grid = nrout + cld_grid = cld + qcreso_grid = qcreso + melto_grid = melto + mnuccco_grid = mnuccco + mnuccto_grid = mnuccto + bergo_grid = bergo + homoo_grid = homoo + msacwio_grid = msacwio + psacwso_grid = psacwso + cmeiout_grid = cmeiout + qireso_grid = qireso + prcio_grid = prcio + praio_grid = praio + icwmrst_grid = icwmrst + icimrst_grid = icimrst + liqcldf_grid = liqcldf + icecldf_grid = icecldf + icwnc_grid = icwnc + icinc_grid = icinc + pdel_grid = state_loc%pdel + prao_grid = prao + prco_grid = prco + + nc_grid = state_loc%q(:,:,ixnumliq) + ni_grid = state_loc%q(:,:,ixnumice) + + qcsedtenout_grid = qcsedten + qisedtenout_grid = qisedten + vtrmcout_grid = vtrmc + vtrmiout_grid = vtrmi + qcsevapout_grid = qcsevap + qisevapout_grid = qisevap + + if (micro_mg_version > 1) then + cldmax_grid = cldmax + + qr_grid = state_loc%q(:,:,ixrain) + nr_grid = state_loc%q(:,:,ixnumrain) + qs_grid = state_loc%q(:,:,ixsnow) + ns_grid = state_loc%q(:,:,ixnumsnow) + qrsedtenout_grid = qrsedten + qssedtenout_grid = qssedten + umrout_grid = umr + umsout_grid = ums + end if + +! Zero out terms for budgets if not mg3.... + psacwgo_grid = 0._r8 + pgsacwo_grid = 0._r8 + qmultgo_grid = 0._r8 + + if (micro_mg_version > 2) then + qg_grid = state_loc%q(:,:,ixgraupel) + ng_grid = state_loc%q(:,:,ixnumgraupel) + psacro_grid = psacro + pracgo_grid = pracgo + psacwgo_grid = psacwgo + pgsacwo_grid = pgsacwo + pgracso_grid = pgracso + prdgo_grid = prdgo + qmultgo_grid = qmultgo + qmultrgo_grid = qmultrgo + npracgo_grid = npracgo + nscngo_grid = nscngo + ngracso_grid = ngracso + nmultgo_grid = nmultgo + nmultrgo_grid = nmultrgo + npsacwgo_grid = npsacwgo + end if + + + end if + + ! If on subcolumns, average the rest of the pbuf fields which were modified on subcolumns but are not used further in + ! this parameterization (no need to assign in the non-subcolumn case -- the else step) + if (use_subcol_microp) then + call subcol_field_avg(snow_str, ngrdcol, lchnk, snow_str_grid) + call subcol_field_avg(prec_pcw, ngrdcol, lchnk, prec_pcw_grid) + call subcol_field_avg(snow_pcw, ngrdcol, lchnk, snow_pcw_grid) + call subcol_field_avg(prec_sed, ngrdcol, lchnk, prec_sed_grid) + call subcol_field_avg(snow_sed, ngrdcol, lchnk, snow_sed_grid) + call subcol_field_avg(cldo, ngrdcol, lchnk, cldo_grid) + call subcol_field_avg(mgmrprc, ngrdcol, lchnk, mgmrprc_grid) + call subcol_field_avg(mgmrsnw, ngrdcol, lchnk, mgmrsnw_grid) + call subcol_field_avg(wsedl, ngrdcol, lchnk, wsedl_grid) + call subcol_field_avg(cc_t, ngrdcol, lchnk, cc_t_grid) + call subcol_field_avg(cc_qv, ngrdcol, lchnk, cc_qv_grid) + call subcol_field_avg(cc_ql, ngrdcol, lchnk, cc_ql_grid) + call subcol_field_avg(cc_qi, ngrdcol, lchnk, cc_qi_grid) + call subcol_field_avg(cc_nl, ngrdcol, lchnk, cc_nl_grid) + call subcol_field_avg(cc_ni, ngrdcol, lchnk, cc_ni_grid) + call subcol_field_avg(cc_qlst, ngrdcol, lchnk, cc_qlst_grid) + call subcol_field_avg(iciwpst, ngrdcol, lchnk, iciwpst_grid) + call subcol_field_avg(icswp, ngrdcol, lchnk, icswp_grid) + call subcol_field_avg(cldfsnow, ngrdcol, lchnk, cldfsnow_grid) + + if (micro_mg_version > 2) then + call subcol_field_avg(icgrauwp, ngrdcol, lchnk, icgrauwp_grid) + call subcol_field_avg(cldfgrau, ngrdcol, lchnk, cldfsnow_grid) + end if + + if (rate1_cw2pr_st_idx > 0) then + call subcol_field_avg(rate1ord_cw2pr_st, ngrdcol, lchnk, rate1ord_cw2pr_st_grid) + end if + + end if + + ! ------------------------------------- ! + ! Size distribution calculation ! + ! ------------------------------------- ! + + ! Calculate rho (on subcolumns if turned on) for size distribution + ! parameter calculations and average it if needed + ! + ! State instead of state_loc to preserve answers for MG1 (and in any + ! case, it is unlikely to make much difference). + rho(:ncol,top_lev:) = state%pmid(:ncol,top_lev:) / & + (rair*state%t(:ncol,top_lev:)) + if (use_subcol_microp) then + call subcol_field_avg(rho, ngrdcol, lchnk, rho_grid) + else + rho_grid = rho + end if + + ! Effective radius for cloud liquid, fixed number. + mu_grid = 0._r8 + lambdac_grid = 0._r8 + rel_fn_grid = 10._r8 + + ncic_grid = 1.e8_r8 + + do k = top_lev, pver + !$acc data copyin (mg_liq_props,icwmrst_grid(:ngrdcol,k),rho_grid(:ngrdcol,k)) & + !$acc copy (ncic_grid(:ngrdcol,k)) & + !$acc copyout (mu_grid(:ngrdcol,k),lambdac_grid(:ngrdcol,k)) + call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,k), & + ncic_grid(:ngrdcol,k), rho_grid(:ngrdcol,k), & + mu_grid(:ngrdcol,k), lambdac_grid(:ngrdcol,k), ngrdcol) + !$acc end data + end do + + where (icwmrst_grid(:ngrdcol,top_lev:) > qsmall) + rel_fn_grid(:ngrdcol,top_lev:) = & + (mu_grid(:ngrdcol,top_lev:) + 3._r8)/ & + lambdac_grid(:ngrdcol,top_lev:)/2._r8 * 1.e6_r8 + end where + + ! Effective radius for cloud liquid, and size parameters + ! mu_grid and lambdac_grid. + mu_grid = 0._r8 + lambdac_grid = 0._r8 + rel_grid = 10._r8 + + ! Calculate ncic on the grid + ncic_grid(:ngrdcol,top_lev:) = nc_grid(:ngrdcol,top_lev:) / & + max(mincld,liqcldf_grid(:ngrdcol,top_lev:)) + + do k = top_lev, pver + !$acc data copyin (mg_liq_props,icwmrst_grid(:ngrdcol,k), rho_grid(:ngrdcol,k)) & + !$acc copy (ncic_grid(:ngrdcol,k)) & + !$acc copyout (mu_grid(:ngrdcol,k),lambdac_grid(:ngrdcol,k)) + call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,k), & + ncic_grid(:ngrdcol,k), rho_grid(:ngrdcol,k), & + mu_grid(:ngrdcol,k), lambdac_grid(:ngrdcol,k), ngrdcol) + !$acc end data + end do + + where (icwmrst_grid(:ngrdcol,top_lev:) >= qsmall) + rel_grid(:ngrdcol,top_lev:) = & + (mu_grid(:ngrdcol,top_lev:) + 3._r8) / & + lambdac_grid(:ngrdcol,top_lev:)/2._r8 * 1.e6_r8 + elsewhere + ! Deal with the fact that size_dist_param_liq sets mu_grid to -100 + ! wherever there is no cloud. + mu_grid(:ngrdcol,top_lev:) = 0._r8 + end where + + ! Rain/Snow effective diameter. + drout2_grid = 0._r8 + reff_rain_grid = 0._r8 + des_grid = 0._r8 + dsout2_grid = 0._r8 + reff_snow_grid = 0._r8 + reff_grau_grid = 0._r8 + + if (micro_mg_version > 1) then + ! Prognostic precipitation + + where (qr_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) + drout2_grid(:ngrdcol,top_lev:) = avg_diameter( & + qr_grid(:ngrdcol,top_lev:), & + nr_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & + rho_grid(:ngrdcol,top_lev:), rhow) + + reff_rain_grid(:ngrdcol,top_lev:) = drout2_grid(:ngrdcol,top_lev:) * & + 1.5_r8 * 1.e6_r8 + end where + + where (qs_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) + dsout2_grid(:ngrdcol,top_lev:) = avg_diameter( & + qs_grid(:ngrdcol,top_lev:), & + ns_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & + rho_grid(:ngrdcol,top_lev:), rhosn) + + des_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) *& + 3._r8 * rhosn/rhows + + reff_snow_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) * & + 1.5_r8 * 1.e6_r8 + end where + + else + ! Diagnostic precipitation + + where (qrout_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) + drout2_grid(:ngrdcol,top_lev:) = avg_diameter( & + qrout_grid(:ngrdcol,top_lev:), & + nrout_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & + rho_grid(:ngrdcol,top_lev:), rhow) + + reff_rain_grid(:ngrdcol,top_lev:) = drout2_grid(:ngrdcol,top_lev:) * & + 1.5_r8 * 1.e6_r8 + end where + + where (qsout_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) + dsout2_grid(:ngrdcol,top_lev:) = avg_diameter( & + qsout_grid(:ngrdcol,top_lev:), & + nsout_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & + rho_grid(:ngrdcol,top_lev:), rhosn) + + des_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) & + * 3._r8 * rhosn/rhows + + reff_snow_grid(:ngrdcol,top_lev:) = & + dsout2_grid(:ngrdcol,top_lev:) * 1.5_r8 * 1.e6_r8 + end where + + end if + +! Graupel/Hail size distribution Placeholder + if (micro_mg_version > 2) then + degrau_grid = 0._r8 + where (qg_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) + dgout2_grid(:ngrdcol,top_lev:) = avg_diameter( & + qg_grid(:ngrdcol,top_lev:), & + ng_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & + rho_grid(:ngrdcol,top_lev:), rhog) + + reff_grau_grid(:ngrdcol,top_lev:) = dgout2_grid(:ngrdcol,top_lev:) * & + 1.5_r8 * 1.e6_r8 + degrau_grid(:ngrdcol,top_lev:) = dgout2_grid(:ngrdcol,top_lev:) *& + 3._r8 * rhog/rhows + end where + end if + + ! Effective radius and diameter for cloud ice. + rei_grid = 25._r8 + + niic_grid(:ngrdcol,top_lev:) = ni_grid(:ngrdcol,top_lev:) / & + max(mincld,icecldf_grid(:ngrdcol,top_lev:)) + + do k = top_lev, pver + !$acc data copyin (mg_ice_props, icimrst_grid(:ngrdcol,k)) & + !$acc copy (niic_grid(:ngrdcol,k)) & + !$acc copyout (rei_grid(:ngrdcol,k)) + call size_dist_param_basic(mg_ice_props,icimrst_grid(:ngrdcol,k), & + niic_grid(:ngrdcol,k),rei_grid(:ngrdcol,k),ngrdcol) + !$acc end data + end do + + where (icimrst_grid(:ngrdcol,top_lev:) >= qsmall) + rei_grid(:ngrdcol,top_lev:) = 1.5_r8/rei_grid(:ngrdcol,top_lev:) & + * 1.e6_r8 + elsewhere + rei_grid(:ngrdcol,top_lev:) = 25._r8 + end where + + dei_grid = rei_grid * rhoi/rhows * 2._r8 + + ! Limiters for low cloud fraction. + do k = top_lev, pver + do i = 1, ngrdcol + ! Convert snow effective diameter to microns + des_grid(i,k) = des_grid(i,k) * 1.e6_r8 + if ( ast_grid(i,k) < 1.e-4_r8 ) then + mu_grid(i,k) = mucon + lambdac_grid(i,k) = (mucon + 1._r8)/dcon + dei_grid(i,k) = deicon + end if + end do + end do + + mgreffrain_grid(:ngrdcol,top_lev:pver) = reff_rain_grid(:ngrdcol,top_lev:pver) + mgreffsnow_grid(:ngrdcol,top_lev:pver) = reff_snow_grid(:ngrdcol,top_lev:pver) + + ! ------------------------------------- ! + ! Precipitation efficiency Calculation ! + ! ------------------------------------- ! + + !----------------------------------------------------------------------- + ! Liquid water path + + ! Compute liquid water paths, and column condensation + tgliqwp_grid(:ngrdcol) = 0._r8 + tgcmeliq_grid(:ngrdcol) = 0._r8 + do k = top_lev, pver + do i = 1, ngrdcol + tgliqwp_grid(i) = tgliqwp_grid(i) + iclwpst_grid(i,k)*cld_grid(i,k) + + if (cmeliq_grid(i,k) > 1.e-12_r8) then + !convert cmeliq to right units: kgh2o/kgair/s * kgair/m2 / kgh2o/m3 = m/s + tgcmeliq_grid(i) = tgcmeliq_grid(i) + cmeliq_grid(i,k) * & + (pdel_grid(i,k) / gravit) / rhoh2o + end if + end do + end do + + ! note: 1e-6 kgho2/kgair/s * 1000. pa / (9.81 m/s2) / 1000 kgh2o/m3 = 1e-7 m/s + ! this is 1ppmv of h2o in 10hpa + ! alternatively: 0.1 mm/day * 1.e-4 m/mm * 1/86400 day/s = 1.e-9 + + !----------------------------------------------------------------------- + ! precipitation efficiency calculation (accumulate cme and precip) + + minlwp = 0.01_r8 !minimum lwp threshold (kg/m3) + + ! zero out precip efficiency and total averaged precip + pe_grid(:ngrdcol) = 0._r8 + tpr_grid(:ngrdcol) = 0._r8 + pefrac_grid(:ngrdcol) = 0._r8 + + ! accumulate precip and condensation + do i = 1, ngrdcol + + acgcme_grid(i) = acgcme_grid(i) + tgcmeliq_grid(i) + acprecl_grid(i) = acprecl_grid(i) + prec_str_grid(i) + acnum_grid(i) = acnum_grid(i) + 1 + + ! if LWP is zero, then 'end of cloud': calculate precip efficiency + if (tgliqwp_grid(i) < minlwp) then + if (acprecl_grid(i) > 5.e-8_r8) then + tpr_grid(i) = max(acprecl_grid(i)/acnum_grid(i), 1.e-15_r8) + if (acgcme_grid(i) > 1.e-10_r8) then + pe_grid(i) = min(max(acprecl_grid(i)/acgcme_grid(i), 1.e-15_r8), 1.e5_r8) + pefrac_grid(i) = 1._r8 + end if + end if + + ! reset counters +! if (pe_grid(i) /= 0._r8 .and. (pe_grid(i) < 1.e-8_r8 .or. pe_grid(i) > 1.e3_r8)) then +! write (iulog,*) 'PE_grid:ANOMALY pe_grid, acprecl_grid, acgcme_grid, tpr_grid, acnum_grid ', & +! pe_grid(i),acprecl_grid(i), acgcme_grid(i), tpr_grid(i), acnum_grid(i) +! endif + + acprecl_grid(i) = 0._r8 + acgcme_grid(i) = 0._r8 + acnum_grid(i) = 0 + end if ! end LWP zero conditional + + ! if never find any rain....(after 10^3 timesteps...) + if (acnum_grid(i) > 1000) then + acnum_grid(i) = 0 + acprecl_grid(i) = 0._r8 + acgcme_grid(i) = 0._r8 + end if + + end do + + !----------------------------------------------------------------------- + ! vertical average of non-zero accretion, autoconversion and ratio. + ! vars: vprco_grid(i),vprao_grid(i),racau_grid(i),cnt_grid + + vprao_grid = 0._r8 + cnt_grid = 0 + do k = top_lev, pver + vprao_grid(:ngrdcol) = vprao_grid(:ngrdcol) + prao_grid(:ngrdcol,k) + where (prao_grid(:ngrdcol,k) /= 0._r8) cnt_grid(:ngrdcol) = cnt_grid(:ngrdcol) + 1 + end do + + where (cnt_grid > 0) vprao_grid = vprao_grid/cnt_grid + + vprco_grid = 0._r8 + cnt_grid = 0 + do k = top_lev, pver + vprco_grid(:ngrdcol) = vprco_grid(:ngrdcol) + prco_grid(:ngrdcol,k) + where (prco_grid(:ngrdcol,k) /= 0._r8) cnt_grid(:ngrdcol) = cnt_grid(:ngrdcol) + 1 + end do + + where (cnt_grid > 0) + vprco_grid = vprco_grid/cnt_grid + racau_grid = vprao_grid/vprco_grid + elsewhere + racau_grid = 0._r8 + end where + + racau_grid = min(racau_grid, 1.e10_r8) + +!----------------------------------------------------------------------- +! Diagnostic Rainbow Calculation. Seriously. +!----------------------------------------------------------------------- + +! Rainbows currently calculated on the grid, not subcolumn specific + do i = 1, ngrdcol + + top_idx = pver + convmx = 0._r8 + frlow = 0._r8 + cldmx = 0._r8 + cldtot = maxval(ast(i,top_lev:)) + +! Find levels in surface layer + do k = top_lev, pver + if (state%pmid(i,k) > rb_pmin) then + top_idx = min(k,top_idx) + end if + end do + +!For all fractional precip calculated below, use maximum in surface layer. +!For convective precip, base on convective cloud area + convmx = maxval(concld(i,top_idx:)) +!For stratiform precip, base on precip fraction + cldmx= maxval(freqr(i,top_idx:)) +! Combine and use maximum of strat or conv fraction + frlow= max(cldmx,convmx) + +!max precip + rmax=maxval(qrout_grid(i,top_idx:)) + +! Stratiform precip mixing ratio OR some convective precip +! (rval = true if any sig precip) + + rval = ((precc(i) > rb_rcmin) .or. (rmax > rb_rmin)) + +!Now can find conditions for a rainbow: +! Maximum cloud cover (CLDTOT) < 0.5 +! 48 < SZA < 90 +! freqr (below rb_pmin) > 0.25 +! Some rain (liquid > 1.e-6 kg/kg, convective precip > 1.e-7 m/s + + if ((cldtot < 0.5_r8) .and. (sza(i) > 48._r8) .and. (sza(i) < 90._r8) .and. rval) then + +!Rainbow 'probability' (area) derived from solid angle theory +!as the fraction of the hemisphere for a spherical cap with angle phi=sza-48. +! This is only valid between 48 < sza < 90 (controlled for above). + + rbfrac(i) = max(0._r8,(1._r8-COS((sza(i)-48._r8)*deg2rad))/2._r8) * frlow + rbfreq(i) = 1.0_r8 + end if + + end do ! end column loop for rainbows + + call outfld('RBFRAC', rbfrac, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('RBFREQ', rbfreq, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + + ! --------------------- ! + ! History Output Fields ! + ! --------------------- ! + + ! Column droplet concentration + cdnumc_grid(:ngrdcol) = sum(nc_grid(:ngrdcol,top_lev:pver) * & + pdel_grid(:ngrdcol,top_lev:pver)/gravit, dim=2) + + ! Averaging for new output fields + efcout_grid = 0._r8 + efiout_grid = 0._r8 + ncout_grid = 0._r8 + niout_grid = 0._r8 + freql_grid = 0._r8 + freqi_grid = 0._r8 + icwmrst_grid_out = 0._r8 + icimrst_grid_out = 0._r8 + freqm_grid = 0._r8 + freqsl_grid = 0._r8 + freqslm_grid = 0._r8 + + do k = top_lev, pver + do i = 1, ngrdcol + if ( liqcldf_grid(i,k) > 0.01_r8 .and. icwmrst_grid(i,k) > 5.e-5_r8 ) then + efcout_grid(i,k) = rel_grid(i,k) * liqcldf_grid(i,k) + ncout_grid(i,k) = icwnc_grid(i,k) * liqcldf_grid(i,k) + freql_grid(i,k) = liqcldf_grid(i,k) + icwmrst_grid_out(i,k) = icwmrst_grid(i,k) + end if + if ( icecldf_grid(i,k) > 0.01_r8 .and. icimrst_grid(i,k) > 1.e-6_r8 ) then + efiout_grid(i,k) = rei_grid(i,k) * icecldf_grid(i,k) + niout_grid(i,k) = icinc_grid(i,k) * icecldf_grid(i,k) + freqi_grid(i,k) = icecldf_grid(i,k) + icimrst_grid_out(i,k) = icimrst_grid(i,k) + end if + + ! Supercooled liquid + if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) > 0.01_r8 ) then + freqm_grid(i,k)=min(liqcldf_grid(i,k),icecldf_grid(i,k)) + end if + if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) < 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then + freqsl_grid(i,k)=liqcldf_grid(i,k) + end if + if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) > 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then + freqslm_grid(i,k)=liqcldf_grid(i,k) + end if + + end do + end do + + ! Cloud top effective radius and number. + fcti_grid = 0._r8 + fctl_grid = 0._r8 + ctrel_grid = 0._r8 + ctrei_grid = 0._r8 + ctnl_grid = 0._r8 + ctni_grid = 0._r8 + fctm_grid = 0._r8 + fctsl_grid = 0._r8 + fctslm_grid= 0._r8 + + do i = 1, ngrdcol + do k = top_lev, pver + if ( liqcldf_grid(i,k) > 0.01_r8 .and. icwmrst_grid(i,k) > 1.e-7_r8 ) then + ctrel_grid(i) = rel_grid(i,k) * liqcldf_grid(i,k) + ctnl_grid(i) = icwnc_grid(i,k) * liqcldf_grid(i,k) + fctl_grid(i) = liqcldf_grid(i,k) + + ! Cloud Top Mixed phase, supercooled liquid only and supercooled liquid mixed + if (freqi_grid(i,k) > 0.01_r8) then + fctm_grid(i)=min(liqcldf_grid(i,k),icecldf_grid(i,k)) + end if + if (freqi_grid(i,k) < 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then + fctsl_grid(i)=liqcldf_grid(i,k) + end if + if (freqi_grid(i,k) > 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then + fctslm_grid(i)=liqcldf_grid(i,k) + end if + + exit + end if + + if ( icecldf_grid(i,k) > 0.01_r8 .and. icimrst_grid(i,k) > 1.e-7_r8 ) then + ctrei_grid(i) = rei_grid(i,k) * icecldf_grid(i,k) + ctni_grid(i) = icinc_grid(i,k) * icecldf_grid(i,k) + fcti_grid(i) = icecldf_grid(i,k) + exit + end if + end do + end do + + ! Evaporation of stratiform precipitation fields for UNICON + evprain_st_grid(:ngrdcol,:pver) = nevapr_grid(:ngrdcol,:pver) - evpsnow_st_grid(:ngrdcol,:pver) + do k = top_lev, pver + do i = 1, ngrdcol + evprain_st_grid(i,k) = max(evprain_st_grid(i,k), 0._r8) + evpsnow_st_grid(i,k) = max(evpsnow_st_grid(i,k), 0._r8) + end do + end do + + ! Assign the values to the pbuf pointers if they exist in pbuf + if (qrain_idx > 0) qrout_grid_ptr = qrout_grid + if (qsnow_idx > 0) qsout_grid_ptr = qsout_grid + if (nrain_idx > 0) nrout_grid_ptr = nrout_grid + if (nsnow_idx > 0) nsout_grid_ptr = nsout_grid + if (qcsedten_idx > 0) qcsedtenout_grid_ptr = qcsedtenout_grid + if (qrsedten_idx > 0) qrsedtenout_grid_ptr = qrsedtenout_grid + if (qisedten_idx > 0) qisedtenout_grid_ptr = qisedtenout_grid + if (qssedten_idx > 0) qssedtenout_grid_ptr = qssedtenout_grid + if (vtrmc_idx > 0) vtrmcout_grid_ptr = vtrmcout_grid + if (umr_idx > 0) umrout_grid_ptr = umrout_grid + if (vtrmi_idx > 0) vtrmiout_grid_ptr = vtrmiout_grid + if (ums_idx > 0) umsout_grid_ptr = umsout_grid + if (qcsevap_idx > 0 ) qcsevapout_grid_ptr = qcsevapout_grid + if (qisevap_idx > 0 ) qisevapout_grid_ptr = qisevapout_grid + + ! --------------------------------------------- ! + ! General outfield calls for microphysics ! + ! --------------------------------------------- ! + + ! Output a handle of variables which are calculated on the fly + + ftem_grid = 0._r8 + + ftem_grid(:ngrdcol,top_lev:pver) = qcreso_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDW2V', ftem_grid, pcols, lchnk) + + ftem_grid(:ngrdcol,top_lev:pver) = melto_grid(:ngrdcol,top_lev:pver) - mnuccco_grid(:ngrdcol,top_lev:pver)& + - mnuccto_grid(:ngrdcol,top_lev:pver) - bergo_grid(:ngrdcol,top_lev:pver) - homoo_grid(:ngrdcol,top_lev:pver)& + - msacwio_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDW2I', ftem_grid, pcols, lchnk) + + if (micro_mg_version > 2) then + ftem_grid(:ngrdcol,top_lev:pver) = -prao_grid(:ngrdcol,top_lev:pver) - prco_grid(:ngrdcol,top_lev:pver)& + - psacwso_grid(:ngrdcol,top_lev:pver) - bergso_grid(:ngrdcol,top_lev:pver)& + - psacwgo_grid(:ngrdcol,top_lev:pver) - pgsacwo_grid(:ngrdcol,top_lev:pver) + else + ftem_grid(:ngrdcol,top_lev:pver) = -prao_grid(:ngrdcol,top_lev:pver) - prco_grid(:ngrdcol,top_lev:pver)& + - psacwso_grid(:ngrdcol,top_lev:pver) - bergso_grid(:ngrdcol,top_lev:pver) + endif + + call outfld( 'MPDW2P', ftem_grid, pcols, lchnk) + + ftem_grid(:ngrdcol,top_lev:pver) = cmeiout_grid(:ngrdcol,top_lev:pver) + qireso_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDI2V', ftem_grid, pcols, lchnk) + + if (micro_mg_version > 2) then + ftem_grid(:ngrdcol,top_lev:pver) = -melto_grid(:ngrdcol,top_lev:pver) + mnuccco_grid(:ngrdcol,top_lev:pver) & + + mnuccto_grid(:ngrdcol,top_lev:pver) + bergo_grid(:ngrdcol,top_lev:pver) + homoo_grid(:ngrdcol,top_lev:pver)& + + msacwio_grid(:ngrdcol,top_lev:pver)& + - qmultgo_grid(:ngrdcol,top_lev:pver) + else + ftem_grid(:ngrdcol,top_lev:pver) = -melto_grid(:ngrdcol,top_lev:pver) + mnuccco_grid(:ngrdcol,top_lev:pver) & + + mnuccto_grid(:ngrdcol,top_lev:pver) + bergo_grid(:ngrdcol,top_lev:pver) + homoo_grid(:ngrdcol,top_lev:pver)& + + msacwio_grid(:ngrdcol,top_lev:pver) + endif + + call outfld( 'MPDI2W', ftem_grid, pcols, lchnk) + + ftem_grid(:ngrdcol,top_lev:pver) = -prcio_grid(:ngrdcol,top_lev:pver) - praio_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDI2P', ftem_grid, pcols, lchnk) + + ! Output fields which have not been averaged already, averaging if use_subcol_microp is true + call outfld('MPICLWPI', iclwpi, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPICIWPI', iciwpi, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('REFL', refl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AREFL', arefl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AREFLZ', areflz, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FREFL', frefl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('CSRFL', csrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ACSRFL', acsrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FCSRFL', fcsrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('RERCLD', rercld, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('NCAL', ncal, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('NCAI', ncai, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AQRAIN', qrout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AQSNOW', qsout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ANRAIN', nrout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ANSNOW', nsout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FREQR', freqr, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FREQS', freqs, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDT', tlat, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDQ', qvlat, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDLIQ', qcten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDICE', qiten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDNLIQ', ncten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDNICE', niten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('EVAPSNOW', evapsnow, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QCSEVAP', qcsevap, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QISEVAP', qisevap, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QVRES', qvres, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('VTRMC', vtrmc, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('VTRMI', vtrmi, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QCSEDTEN', qcsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QISEDTEN', qisedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + if (micro_mg_version > 1) then + call outfld('QRSEDTEN', qrsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QSSEDTEN', qssedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MNUCCRIO', mnuccrio, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MNUDEPO', mnudepo, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MELTSTOT', meltstot, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + end if + call outfld('MNUCCDO', mnuccdo, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MNUCCDOhet', mnuccdohet, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MNUCCRO', mnuccro, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('PRACSO', pracso , psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MELTSDT', meltsdt, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FRZRDT', frzrdt , psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FICE', nfice, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('CLDFSNOW', cldfsnow, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + + if (micro_mg_version > 1) then + call outfld('UMR', umr, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('UMS', ums, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + end if + + if (.not. (micro_mg_version == 1 .and. micro_mg_sub_version == 0)) then + call outfld('QCRAT', qcrat, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + end if + + if (micro_mg_version > 2) then + call outfld('UMG', umg, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QGSEDTEN', qgsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FREQG', freqg, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AQGRAU', qgout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ANGRAU', ngout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('CLDFGRAU', cldfgrau, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MELTGTOT', meltgtot, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + + end if + + ! Example subcolumn outfld call + if (use_subcol_microp) then + call outfld('FICE_SCOL', nfice, psubcols*pcols, lchnk) + call outfld('MPDLIQ_SCOL', ptend%q(:,:,ixcldliq), psubcols*pcols, lchnk) + call outfld('MPDICE_SCOL', qiten, psubcols*pcols, lchnk) + end if + + ! Output fields which are already on the grid + call outfld('QRAIN', qrout_grid, pcols, lchnk) + call outfld('QSNOW', qsout_grid, pcols, lchnk) + call outfld('NRAIN', nrout_grid, pcols, lchnk) + call outfld('NSNOW', nsout_grid, pcols, lchnk) + call outfld('CV_REFFLIQ', cvreffliq_grid, pcols, lchnk) + call outfld('CV_REFFICE', cvreffice_grid, pcols, lchnk) + call outfld('LS_FLXPRC', mgflxprc_grid, pcols, lchnk) + call outfld('LS_FLXSNW', mgflxsnw_grid, pcols, lchnk) + call outfld('CME', qme_grid, pcols, lchnk) + call outfld('PRODPREC', prain_grid, pcols, lchnk) + call outfld('EVAPPREC', nevapr_grid, pcols, lchnk) + call outfld('QCRESO', qcreso_grid, pcols, lchnk) + call outfld('LS_REFFRAIN', mgreffrain_grid, pcols, lchnk) + call outfld('LS_REFFSNOW', mgreffsnow_grid, pcols, lchnk) + call outfld('DSNOW', des_grid, pcols, lchnk) + call outfld('ADRAIN', drout2_grid, pcols, lchnk) + call outfld('ADSNOW', dsout2_grid, pcols, lchnk) + call outfld('PE', pe_grid, pcols, lchnk) + call outfld('PEFRAC', pefrac_grid, pcols, lchnk) + call outfld('APRL', tpr_grid, pcols, lchnk) + call outfld('VPRAO', vprao_grid, pcols, lchnk) + call outfld('VPRCO', vprco_grid, pcols, lchnk) + call outfld('RACAU', racau_grid, pcols, lchnk) + call outfld('AREL', efcout_grid, pcols, lchnk) + call outfld('AREI', efiout_grid, pcols, lchnk) + call outfld('AWNC' , ncout_grid, pcols, lchnk) + call outfld('AWNI' , niout_grid, pcols, lchnk) + call outfld('FREQL', freql_grid, pcols, lchnk) + call outfld('FREQI', freqi_grid, pcols, lchnk) + call outfld('ACTREL', ctrel_grid, pcols, lchnk) + call outfld('ACTREI', ctrei_grid, pcols, lchnk) + call outfld('ACTNL', ctnl_grid, pcols, lchnk) + call outfld('ACTNI', ctni_grid, pcols, lchnk) + call outfld('FCTL', fctl_grid, pcols, lchnk) + call outfld('FCTI', fcti_grid, pcols, lchnk) + call outfld('ICINC', icinc_grid, pcols, lchnk) + call outfld('ICWNC', icwnc_grid, pcols, lchnk) + call outfld('EFFLIQ_IND', rel_fn_grid, pcols, lchnk) + call outfld('CDNUMC', cdnumc_grid, pcols, lchnk) + call outfld('REL', rel_grid, pcols, lchnk) + call outfld('REI', rei_grid, pcols, lchnk) + call outfld('MG_SADICE', sadice_grid, pcols, lchnk) + call outfld('MG_SADSNOW', sadsnow_grid, pcols, lchnk) + call outfld('ICIMRST', icimrst_grid_out, pcols, lchnk) + call outfld('ICWMRST', icwmrst_grid_out, pcols, lchnk) + call outfld('CMEIOUT', cmeiout_grid, pcols, lchnk) + call outfld('PRAO', prao_grid, pcols, lchnk) + call outfld('PRCO', prco_grid, pcols, lchnk) + call outfld('MNUCCCO', mnuccco_grid, pcols, lchnk) + call outfld('MNUCCTO', mnuccto_grid, pcols, lchnk) + call outfld('MSACWIO', msacwio_grid, pcols, lchnk) + call outfld('PSACWSO', psacwso_grid, pcols, lchnk) + call outfld('BERGSO', bergso_grid, pcols, lchnk) + call outfld('BERGO', bergo_grid, pcols, lchnk) + call outfld('MELTO', melto_grid, pcols, lchnk) + call outfld('HOMOO', homoo_grid, pcols, lchnk) + call outfld('PRCIO', prcio_grid, pcols, lchnk) + call outfld('PRAIO', praio_grid, pcols, lchnk) + call outfld('QIRESO', qireso_grid, pcols, lchnk) + call outfld('FREQM', freqm_grid, pcols, lchnk) + call outfld('FREQSL', freqsl_grid, pcols, lchnk) + call outfld('FREQSLM', freqslm_grid, pcols, lchnk) + call outfld('FCTM', fctm_grid, pcols, lchnk) + call outfld('FCTSL', fctsl_grid, pcols, lchnk) + call outfld('FCTSLM', fctslm_grid, pcols, lchnk) + + if (micro_mg_version > 2) then + call outfld('PRACGO', pracgo_grid, pcols, lchnk) + call outfld('PSACRO', psacro_grid, pcols, lchnk) + call outfld('PSACWGO', psacwgo_grid, pcols, lchnk) + call outfld('PGSACWO', pgsacwo_grid, pcols, lchnk) + call outfld('PGRACSO', pgracso_grid, pcols, lchnk) + call outfld('PRDGO', prdgo_grid, pcols, lchnk) + call outfld('QMULTGO', qmultgo_grid, pcols, lchnk) + call outfld('QMULTRGO', qmultrgo_grid, pcols, lchnk) + call outfld('LS_REFFGRAU', reff_grau_grid, pcols, lchnk) + call outfld ('NPRACGO', npracgo_grid, pcols, lchnk) + call outfld ('NSCNGO', nscngo_grid, pcols, lchnk) + call outfld ('NGRACSO', ngracso_grid, pcols, lchnk) + call outfld ('NMULTGO', nmultgo_grid, pcols, lchnk) + call outfld ('NMULTRGO', nmultrgo_grid, pcols, lchnk) + call outfld ('NPSACWGO', npsacwgo_grid, pcols, lchnk) + end if + + if (micro_mg_adjust_cpt) then + cp_rh(:ncol, :pver) = 0._r8 + + do i = 1, ncol + + ! Calculate the RH including any T change that we make. + do k = top_lev, pver + call qsat(state_loc%t(i,k), state_loc%pmid(i,k), es, qs) + cp_rh(i,k) = state_loc%q(i, k, ixq) / qs * 100._r8 + end do + end do + + call outfld("TROPF_RHADJ", cp_rh, pcols, lchnk) + end if + + ! ptend_loc is deallocated in physics_update above + call physics_state_dealloc(state_loc) + + if (qsatfac_idx <= 0) then + deallocate(qsatfac) + end if + +end subroutine micro_pumas_cam_tend + +subroutine massless_droplet_destroyer(ztodt, state, ptend) + + ! This subroutine eradicates cloud droplets in grid boxes with no cloud + ! mass. This code is now expanded to remove massless rain drops, ice + ! crystals, and snow flakes. + ! + ! Note: qsmall, which is a small, positive number, is used as the + ! threshold here instead of qmin, which is 0. Some numbers that are + ! supposed to have a value of 0, but don't because of numerical + ! roundoff (especially after hole filling) will have small, positive + ! values. Using qsmall as the threshold here instead of qmin allows + ! for unreasonable massless drop concentrations to be removed in + ! those scenarios. + + use micro_pumas_utils, only: qsmall + use ref_pres, only: top_lev => trop_cloud_top_lev + + implicit none + + ! Input Variables + real(r8), intent(in) :: ztodt ! model time increment + type(physics_state), intent(in) :: state ! state for columns + + ! Input/Output Variables + type(physics_ptend), intent(inout) :: ptend ! ptend for columns + + ! Local Variables + integer :: icol, k + + !----- Begin Code ----- + + ! Don't do anything if this option isn't enabled. + if ( .not. micro_do_massless_droplet_destroyer ) return + + col_loop: do icol=1, state%ncol + vert_loop: do k = top_lev, pver + ! If updated qc (after microphysics) is zero, then ensure updated nc is also zero!! + if ( state%q(icol,k,ixcldliq) + ztodt * ptend%q(icol,k,ixcldliq) < qsmall ) then + ptend%lq(ixnumliq) = .true. ! This is probably already true, but it doesn't + ! hurt to set it. + ptend%q(icol,k,ixnumliq) = -(state%q(icol,k,ixnumliq) / ztodt) + end if + if ( ixnumrain > 0 ) then + ! If updated qr (after microphysics) is zero, then ensure updated nr is also zero!! + if ( state%q(icol,k,ixrain) + ztodt * ptend%q(icol,k,ixrain) < qsmall ) then + ptend%lq(ixnumrain) = .true. ! This is probably already true, but it doesn't + ! hurt to set it. + ptend%q(icol,k,ixnumrain) = -(state%q(icol,k,ixnumrain) / ztodt) + end if + endif ! ixnumrain > 0 + ! If updated qi (after microphysics) is zero, then ensure updated ni is also zero!! + if ( state%q(icol,k,ixcldice) + ztodt * ptend%q(icol,k,ixcldice) < qsmall ) then + ptend%lq(ixnumice) = .true. ! This is probably already true, but it doesn't + ! hurt to set it. + ptend%q(icol,k,ixnumice) = -(state%q(icol,k,ixnumice) / ztodt) + end if + if ( ixnumsnow > 0 ) then + ! If updated qs (after microphysics) is zero, then ensure updated ns is also zero!! + if ( state%q(icol,k,ixsnow) + ztodt * ptend%q(icol,k,ixsnow) < qsmall ) then + ptend%lq(ixnumsnow) = .true. ! This is probably already true, but it doesn't + ! hurt to set it. + ptend%q(icol,k,ixnumsnow) = -(state%q(icol,k,ixnumsnow) / ztodt) + end if + endif ! ixnumsnow > 0 + end do vert_loop + end do col_loop + + return +end subroutine massless_droplet_destroyer + +end module micro_pumas_cam diff --git a/src/physics/cam/microp_aero.F90 b/src/physics/cam/microp_aero.F90 index d6d2468214..38079466af 100644 --- a/src/physics/cam/microp_aero.F90 +++ b/src/physics/cam/microp_aero.F90 @@ -12,9 +12,9 @@ module microp_aero ! Based on code from: Hugh Morrison, Xiaohong Liu and Steve Ghan ! May 2010 ! Description in: Morrison and Gettelman, 2008. J. Climate (MG2008) -! Gettelman et al., 2010 J. Geophys. Res. - Atmospheres (G2010) +! Gettelman et al., 2010 J. Geophys. Res. - Atmospheres (G2010) ! for questions contact Andrew Gettelman (andrew@ucar.edu) -! Modifications: A. Gettelman Nov 2010 - changed to support separation of +! Modifications: A. Gettelman Nov 2010 - changed to support separation of ! microphysics and macrophysics and concentrate aerosol information here ! B. Eaton, Sep 2014 - Refactored to move CAM interface code into the CAM ! interface modules and preserve just the driver layer functionality here. @@ -23,13 +23,14 @@ module microp_aero use shr_kind_mod, only: r8=>shr_kind_r8 use spmd_utils, only: masterproc -use ppgrid, only: pcols, pver, pverp +use ppgrid, only: pcols, pver, pverp, begchunk, endchunk use ref_pres, only: top_lev => trop_cloud_top_lev use physconst, only: rair use constituents, only: cnst_get_ind use physics_types, only: physics_state, physics_ptend, physics_ptend_init, physics_ptend_sum, & physics_state_copy, physics_update -use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field, & + pbuf_get_chunk use phys_control, only: phys_getopts, use_hetfrz_classnuc use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, rad_cnst_get_aer_props, & rad_cnst_get_mode_num @@ -41,21 +42,30 @@ module microp_aero use ndrop_bam, only: ndrop_bam_init, ndrop_bam_run, ndrop_bam_ccn use hetfrz_classnuc_cam, only: hetfrz_classnuc_cam_readnl, hetfrz_classnuc_cam_register, hetfrz_classnuc_cam_init, & - hetfrz_classnuc_cam_save_cbaero, hetfrz_classnuc_cam_calc + hetfrz_classnuc_cam_calc use cam_history, only: addfld, add_default, outfld use cam_logfile, only: iulog use cam_abortutils, only: endrun +use aerosol_properties_mod, only: aerosol_properties +use modal_aerosol_properties_mod, only: modal_aerosol_properties + +use aerosol_state_mod, only: aerosol_state +use modal_aerosol_state_mod, only: modal_aerosol_state + implicit none private save public :: microp_aero_init, microp_aero_run, microp_aero_readnl, microp_aero_register +public :: microp_aero_final +public :: aerosol_state_object +public :: aerosol_properties_object ! Private module data - character(len=16) :: eddy_scheme +real(r8), parameter :: unset_r8 = huge(1.0_r8) ! contact freezing due to dust ! dust number mean radius (m), Zender et al JGR 2003 assuming number mode radius of 0.6 micron, sigma=2 @@ -64,7 +74,14 @@ module microp_aero real(r8), parameter :: rn_dst3 = 1.576e-6_r8 real(r8), parameter :: rn_dst4 = 3.026e-6_r8 +! Namelist parameters real(r8) :: bulk_scale ! prescribed aerosol bulk sulfur scale factor +real(r8) :: npccn_scale ! scaling for activated number +real(r8) :: wsub_scale ! scaling for sub-grid vertical velocity (liquid) +real(r8) :: wsubi_scale ! scaling for sub-grid vertical velocity (ice) +real(r8) :: wsub_min ! minimum sub-grid vertical velocity (liquid) before scale factor +real(r8) :: wsub_min_asf ! minimum sub-grid vertical velocity (liquid) after scale factor +real(r8) :: wsubi_min ! minimum sub-grid vertical velocity (ice) ! smallest mixing ratio considered in microphysics real(r8), parameter :: qsmall = 1.e-18_r8 @@ -110,18 +127,25 @@ module microp_aero logical :: separate_dust = .false. +type aero_state_t + class(aerosol_state), pointer :: obj=>null() +end type aero_state_t + +class(aerosol_properties), pointer :: aero_props_obj=>null() +type(aero_state_t), pointer :: aero_state(:) => null() + !========================================================================================= contains !========================================================================================= subroutine microp_aero_register - !----------------------------------------------------------------------- - ! - ! Purpose: + !----------------------------------------------------------------------- + ! + ! Purpose: ! Register pbuf fields for aerosols needed by microphysics - ! + ! ! Author: Cheryl Craig October 2012 - ! + ! !----------------------------------------------------------------------- use ppgrid, only: pcols use physics_buffer, only: pbuf_add_field, dtype_r8 @@ -130,7 +154,7 @@ subroutine microp_aero_register call pbuf_add_field('RNDST', 'physpkg',dtype_r8,(/pcols,pver,4/), rndst_idx) call pbuf_add_field('NACON', 'physpkg',dtype_r8,(/pcols,pver,4/), nacon_idx) - + call nucleate_ice_cam_register() call hetfrz_classnuc_cam_register() @@ -138,17 +162,18 @@ end subroutine microp_aero_register !========================================================================================= -subroutine microp_aero_init(pbuf2d) +subroutine microp_aero_init(phys_state,pbuf2d) - !----------------------------------------------------------------------- - ! - ! Purpose: + !----------------------------------------------------------------------- + ! + ! Purpose: ! Initialize constants for aerosols needed by microphysics - ! + ! ! Author: Andrew Gettelman May 2010 - ! + ! !----------------------------------------------------------------------- + type(physics_state), pointer :: phys_state(:) type(physics_buffer_desc), pointer :: pbuf2d(:,:) ! local variables @@ -158,6 +183,9 @@ subroutine microp_aero_init(pbuf2d) character(len=32) :: str32 character(len=*), parameter :: routine = 'microp_aero_init' logical :: history_amwg + type(physics_buffer_desc), pointer :: pbuf(:) + integer :: c + !----------------------------------------------------------------------- ! Query the PBL eddy scheme @@ -175,7 +203,7 @@ subroutine microp_aero_init(pbuf2d) select case(trim(eddy_scheme)) case ('diag_TKE') - tke_idx = pbuf_get_index('tke') + tke_idx = pbuf_get_index('tke') case ('CLUBB_SGS') wp2_idx = pbuf_get_index('WP2_nadv') case default @@ -191,10 +219,24 @@ subroutine microp_aero_init(pbuf2d) if (clim_modal_aero) then - cldo_idx = pbuf_get_index('CLDO') + cldo_idx = pbuf_get_index('CLDO') dgnumwet_idx = pbuf_get_index('DGNUMWET') - call ndrop_init() + aero_props_obj => modal_aerosol_properties() + if (.not.associated(aero_props_obj)) then + call endrun('ma_convproc_init: construction of modal_aerosol_properties object failed') + end if + call ndrop_init(aero_props_obj) + call nucleate_ice_cam_init(mincld, bulk_scale, pbuf2d, aero_props=aero_props_obj) + + allocate(aero_state(begchunk:endchunk)) + do c = begchunk,endchunk + pbuf => pbuf_get_chunk(pbuf2d, c) + aero_state(c)%obj => modal_aerosol_state( phys_state(c), pbuf ) + if (.not.associated(aero_state(c)%obj)) then + call endrun('microp_aero_init: construction of modal_aerosol_state object failed') + end if + end do ! Init indices for specific modes/species @@ -218,7 +260,7 @@ subroutine microp_aero_init(pbuf2d) ! check if coarse dust is in separate mode separate_dust = mode_coarse_dst_idx > 0 - ! for 3-mode + ! for 3-mode if ( mode_coarse_dst_idx<0 ) mode_coarse_dst_idx = mode_coarse_idx if ( mode_coarse_slt_idx<0 ) mode_coarse_slt_idx = mode_coarse_idx @@ -288,41 +330,96 @@ subroutine microp_aero_init(pbuf2d) end do call ndrop_bam_init() + call nucleate_ice_cam_init(mincld, bulk_scale, pbuf2d) end if - call addfld('LCLOUD', (/ 'lev' /), 'A', ' ', 'Liquid cloud fraction used in stratus activation') + call addfld('LCLOUD', (/ 'lev' /), 'A', ' ', 'Liquid cloud fraction used in stratus activation', sampled_on_subcycle=.true.) - call addfld('WSUB', (/ 'lev' /), 'A', 'm/s', 'Diagnostic sub-grid vertical velocity' ) - call addfld('WSUBI', (/ 'lev' /), 'A', 'm/s', 'Diagnostic sub-grid vertical velocity for ice' ) + call addfld('WSUB', (/ 'lev' /), 'A', 'm/s', 'Diagnostic sub-grid vertical velocity', sampled_on_subcycle=.true.) + call addfld('WSUBI', (/ 'lev' /), 'A', 'm/s', 'Diagnostic sub-grid vertical velocity for ice', sampled_on_subcycle=.true.) if (history_amwg) then call add_default ('WSUB ', 1, ' ') end if - call nucleate_ice_cam_init(mincld, bulk_scale, pbuf2d) - call hetfrz_classnuc_cam_init(mincld) + if (use_hetfrz_classnuc) then + if (associated(aero_props_obj)) then + call hetfrz_classnuc_cam_init(mincld, aero_props_obj) + else + call endrun(routine//': cannot use hetfrz_classnuc without prognostic aerosols') + endif + endif end subroutine microp_aero_init +!========================================================================================= +! returns a pointer to an aerosol state object for a given chunk index +function aerosol_state_object(lchnk) result(obj) + + integer,intent(in) :: lchnk ! local chunk index + class(aerosol_state), pointer :: obj ! aerosol state object pointer for local chunk + + obj => aero_state(lchnk)%obj + +end function aerosol_state_object + +!========================================================================================= +! returns a pointer to an aerosol properties object +function aerosol_properties_object() result(obj) + + class(aerosol_properties), pointer :: obj ! aerosol properties object pointer + + obj => aero_props_obj + +end function aerosol_properties_object + +!========================================================================================= + +subroutine microp_aero_final + + integer :: c + + if (associated(aero_props_obj)) then + deallocate(aero_props_obj) + end if + nullify(aero_props_obj) + + if (associated(aero_state)) then + do c = begchunk,endchunk + deallocate(aero_state(c)%obj) + end do + deallocate(aero_state) + nullify(aero_state) + end if + +end subroutine microp_aero_final + !========================================================================================= subroutine microp_aero_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit - use mpishorthand + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_real8 character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input ! Namelist variables - real(r8) :: microp_aero_bulk_scale = 2._r8 ! prescribed aerosol bulk sulfur scale factor - + real(r8) :: microp_aero_bulk_scale = unset_r8 ! prescribed aerosol bulk sulfur scale factor + real(r8) :: microp_aero_npccn_scale = unset_r8 ! prescribed aerosol bulk sulfur scale factor + real(r8) :: microp_aero_wsub_scale = unset_r8 ! subgrid vertical velocity (liquid) scale factor + real(r8) :: microp_aero_wsubi_scale = unset_r8 ! subgrid vertical velocity (ice) scale factor + real(r8) :: microp_aero_wsub_min = unset_r8 ! subgrid vertical velocity (liquid) minimum (before scale factor) + real(r8) :: microp_aero_wsub_min_asf = unset_r8 ! subgrid vertical velocity (liquid) minimum (after scale factor) + real(r8) :: microp_aero_wsubi_min = unset_r8 ! subgrid vertical velocity (ice) minimum + ! Local variables integer :: unitn, ierr character(len=*), parameter :: subname = 'microp_aero_readnl' - namelist /microp_aero_nl/ microp_aero_bulk_scale + namelist /microp_aero_nl/ microp_aero_bulk_scale, microp_aero_npccn_scale, microp_aero_wsub_min, & + microp_aero_wsubi_min, microp_aero_wsub_scale, microp_aero_wsubi_scale, microp_aero_wsub_min_asf !----------------------------------------------------------------------------- if (masterproc) then @@ -339,13 +436,38 @@ subroutine microp_aero_readnl(nlfile) call freeunit(unitn) end if -#ifdef SPMD - ! Broadcast namelist variable - call mpibcast(microp_aero_bulk_scale, 1, mpir8, 0, mpicom) -#endif + ! Broadcast namelist variables + call mpi_bcast(microp_aero_bulk_scale, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: microp_aero_bulk_scale") + call mpi_bcast(microp_aero_npccn_scale, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: microp_aero_npccn_scale") + call mpi_bcast(microp_aero_wsub_scale, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: microp_aero_wsub_scale") + call mpi_bcast(microp_aero_wsubi_scale, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: microp_aero_wsubi_scale") + call mpi_bcast(microp_aero_wsub_min, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: microp_aero_wsub_min") + call mpi_bcast(microp_aero_wsub_min_asf, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: microp_aero_wsub_min_asf") + call mpi_bcast(microp_aero_wsubi_min, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: microp_aero_wsubi_min") ! set local variables bulk_scale = microp_aero_bulk_scale + npccn_scale = microp_aero_npccn_scale + wsub_scale = microp_aero_wsub_scale + wsubi_scale = microp_aero_wsubi_scale + wsub_min = microp_aero_wsub_min + wsub_min_asf = microp_aero_wsub_min_asf + wsubi_min = microp_aero_wsubi_min + + if(bulk_scale == unset_r8) call endrun(subname//": FATAL: bulk_scale is not set") + if(npccn_scale == unset_r8) call endrun(subname//": FATAL: npccn_scale is not set") + if(wsub_scale == unset_r8) call endrun(subname//": FATAL: wsub_scale is not set") + if(wsubi_scale == unset_r8) call endrun(subname//": FATAL: wsubi_scale is not set") + if(wsub_min == unset_r8) call endrun(subname//": FATAL: wsub_min is not set") + if(wsub_min_asf == unset_r8) call endrun(subname//": FATAL: wsub_min_asf is not set") + if(wsubi_min == unset_r8) call endrun(subname//": FATAL: wsubi_min is not set") call nucleate_ice_cam_readnl(nlfile) call hetfrz_classnuc_cam_readnl(nlfile) @@ -368,12 +490,11 @@ subroutine microp_aero_run ( & integer :: i, k, m integer :: itim_old - integer :: nmodes - type(physics_state) :: state1 ! Local copy of state variable + type(physics_state), target :: state1 ! Local copy of state variable type(physics_ptend) :: ptend_loc - real(r8), pointer :: ast(:,:) + real(r8), pointer :: ast(:,:) real(r8), pointer :: npccn(:,:) ! number of CCN (liquid activated) @@ -407,7 +528,6 @@ subroutine microp_aero_run ( & real(r8) :: nctend_mixnuc(pcols,pver) real(r8) :: dum, dum2 ! temporary dummy variable real(r8) :: dmc, ssmc, so4mc ! variables for modal scheme. - integer :: dst_idx, num_idx ! bulk aerosol variables real(r8), allocatable :: naer2(:,:,:) ! bulk aerosol number concentration (1/m3) @@ -419,11 +539,16 @@ subroutine microp_aero_run ( & real(r8) :: wght - integer :: lchnk, ncol + integer :: lchnk, ncol, astat real(r8), allocatable :: factnum(:,:,:) ! activation fraction for aerosol number + + class(aerosol_state), pointer :: aero_state1_obj + !------------------------------------------------------------------------------- + nullify(aero_state1_obj) + call physics_state_copy(state,state1) lchnk = state1%lchnk @@ -440,21 +565,21 @@ subroutine microp_aero_run ( & call physics_ptend_init(ptend_all, state%psetcols, 'microp_aero') if (clim_modal_aero) then + ! create an aerosol state object specifically for cam state1 + aero_state1_obj => modal_aerosol_state( state1, pbuf ) + if (.not.associated(aero_state1_obj)) then + call endrun('microp_aero_run: construction of aero_state1_obj modal_aerosol_state object failed') + end if itim_old = pbuf_old_tim_idx() - + call pbuf_get_field(pbuf, ast_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, cldo_idx, cldo, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - - call rad_cnst_get_info(0, nmodes=nmodes) - call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) - - allocate(factnum(pcols,pver,nmodes)) - + call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet) end if ! initialize output - npccn(1:ncol,1:pver) = 0._r8 + npccn(1:ncol,1:pver) = 0._r8 nacon(1:ncol,1:pver,:) = 0._r8 @@ -464,11 +589,6 @@ subroutine microp_aero_run ( & rndst(1:ncol,1:pver,3) = rn_dst3 rndst(1:ncol,1:pver,4) = rn_dst4 - ! save copy of cloud borne aerosols for use in heterogeneous freezing - if (use_hetfrz_classnuc) then - call hetfrz_classnuc_cam_save_cbaero(state1, pbuf) - end if - ! initialize time-varying parameters do k = top_lev, pver do i = 1, ncol @@ -496,7 +616,7 @@ subroutine microp_aero_run ( & do m = 1, naer_all call rad_cnst_get_aer_mmr(0, m, state1, pbuf, aer_mmr) maerosol(:ncol,:,m) = aer_mmr(:ncol,:)*rho(:ncol,:) - + if (m .eq. idxsul) then naer2(:ncol,:,m) = maerosol(:ncol,:,m)*num_to_mass_aer(m)*bulk_scale else @@ -506,7 +626,7 @@ subroutine microp_aero_run ( & end if !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - ! More refined computation of sub-grid vertical velocity + ! More refined computation of sub-grid vertical velocity ! Set to be zero at the surface by initialization. select case (trim(eddy_scheme)) @@ -523,8 +643,8 @@ subroutine microp_aero_run ( & end select ! Set minimum values above top_lev. - wsub(:ncol,:top_lev-1) = 0.20_r8 - wsubi(:ncol,:top_lev-1) = 0.001_r8 + wsub(:ncol,:top_lev-1) = wsub_min + wsubi(:ncol,:top_lev-1) = wsubi_min do k = top_lev, pver do i = 1, ncol @@ -533,7 +653,7 @@ subroutine microp_aero_run ( & case ('diag_TKE', 'CLUBB_SGS') wsub(i,k) = sqrt(0.5_r8*(tke(i,k) + tke(i,k+1))*(2._r8/3._r8)) wsub(i,k) = min(wsub(i,k),10._r8) - case default + case default ! get sub-grid vertical velocity from diff coef. ! following morrison et al. 2005, JAS ! assume mixing length of 30 m @@ -544,12 +664,12 @@ subroutine microp_aero_run ( & wsub(i,k) = dum end select - wsubi(i,k) = max(0.001_r8, wsub(i,k)) + wsubi(i,k) = max(wsubi_min, wsub(i,k)) * wsubi_scale if (.not. use_preexisting_ice) then wsubi(i,k) = min(wsubi(i,k), 0.2_r8) endif - wsub(i,k) = max(0.20_r8, wsub(i,k)) + wsub(i,k) = max(wsub_min, wsub(i,k)) * wsub_scale end do end do @@ -562,7 +682,11 @@ subroutine microp_aero_run ( & !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc !ICE Nucleation - call nucleate_ice_cam_calc(state1, wsubi, pbuf, deltatin, ptend_loc) + if (associated(aero_props_obj).and.associated(aero_state1_obj)) then + call nucleate_ice_cam_calc(state1, wsubi, pbuf, deltatin, ptend_loc, aero_props_obj, aero_state1_obj) + else + call nucleate_ice_cam_calc(state1, wsubi, pbuf, deltatin, ptend_loc) + end if call physics_ptend_sum(ptend_loc, ptend_all, ncol) call physics_update(state1, ptend_loc, deltatin) @@ -600,21 +724,28 @@ subroutine microp_aero_run ( & call outfld('LCLOUD', lcldn, pcols, lchnk) + allocate(factnum(pcols,pver,aero_props_obj%nbins()),stat=astat) + if (astat/=0) then + call endrun('microp_aero_run: not able to allocate factnum') + endif + ! If not using preexsiting ice, then only use cloudbourne aerosol for the ! liquid clouds. This is the same behavior as CAM5. if (use_preexisting_ice) then - call dropmixnuc( & - state1, ptend_loc, deltatin, pbuf, wsub, & - cldn, cldo, cldliqf, nctend_mixnuc, factnum) - else + call dropmixnuc( aero_props_obj, aero_state1_obj, & + state1, ptend_loc, deltatin, pbuf, wsub, wsub_min_asf, & + cldn, cldo, cldliqf, nctend_mixnuc, factnum) + else cldliqf = 1._r8 - call dropmixnuc( & - state1, ptend_loc, deltatin, pbuf, wsub, & - lcldn, lcldo, cldliqf, nctend_mixnuc, factnum) + call dropmixnuc( aero_props_obj, aero_state1_obj, & + state1, ptend_loc, deltatin, pbuf, wsub, wsub_min_asf, & + lcldn, lcldo, cldliqf, nctend_mixnuc, factnum) end if npccn(:ncol,:) = nctend_mixnuc(:ncol,:) + npccn(:ncol,:) = npccn(:ncol,:) * npccn_scale + else ! for bulk aerosol @@ -625,7 +756,7 @@ subroutine microp_aero_run ( & do k = top_lev, pver do i = 1, ncol - if (state1%q(i,k,cldliq_idx) >= qsmall) then + if (naer_all > 0 .and. state1%q(i,k,cldliq_idx) >= qsmall) then ! get droplet activation rate @@ -662,12 +793,12 @@ subroutine microp_aero_run ( & ! For modal aerosols: ! use size '3' for dust coarse mode... ! scale by dust fraction in coarse mode - + dmc = coarse_dust(i,k) ssmc = coarse_nacl(i,k) if ( separate_dust ) then - ! 7-mode -- has separate dust and seasalt mode types and no need for weighting + ! 7-mode -- has separate dust and seasalt mode types and no need for weighting wght = 1._r8 else so4mc = coarse_so4(i,k) @@ -684,7 +815,7 @@ subroutine microp_aero_run ( & !also redefine parameters based on size... rndst(i,k,3) = 0.5_r8*dgnumwet(i,k,mode_coarse_dst_idx) - if (rndst(i,k,3) <= 0._r8) then + if (rndst(i,k,3) <= 0._r8) then rndst(i,k,3) = rn_dst3 end if @@ -692,13 +823,13 @@ subroutine microp_aero_run ( & !For Bulk Aerosols: set equal to aerosol number for dust for bins 2-4 (bin 1=0) - if (idxdst2 > 0) then + if (idxdst2 > 0) then nacon(i,k,2) = naer2(i,k,idxdst2) end if - if (idxdst3 > 0) then + if (idxdst3 > 0) then nacon(i,k,3) = naer2(i,k,idxdst3) end if - if (idxdst4 > 0) then + if (idxdst4 > 0) then nacon(i,k,4) = naer2(i,k,idxdst4) end if end if @@ -724,7 +855,7 @@ subroutine microp_aero_run ( & ! heterogeneous freezing if (use_hetfrz_classnuc) then - call hetfrz_classnuc_cam_calc(state1, deltatin, factnum, pbuf) + call hetfrz_classnuc_cam_calc(aero_props_obj, aero_state1_obj, state1, deltatin, factnum, pbuf) end if @@ -732,7 +863,13 @@ subroutine microp_aero_run ( & deallocate(factnum) end if -end subroutine microp_aero_run + if (associated(aero_state1_obj)) then + ! destroy the aerosol state object + deallocate(aero_state1_obj) + nullify(aero_state1_obj) + endif + + end subroutine microp_aero_run !========================================================================================= diff --git a/src/physics/cam/microp_driver.F90 b/src/physics/cam/microp_driver.F90 index 00e18f8364..b328e3a670 100644 --- a/src/physics/cam/microp_driver.F90 +++ b/src/physics/cam/microp_driver.F90 @@ -13,9 +13,9 @@ module microp_driver use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc use phys_control, only: phys_getopts -use micro_mg_cam, only: micro_mg_cam_readnl, micro_mg_cam_register, & - micro_mg_cam_implements_cnst, micro_mg_cam_init_cnst, & - micro_mg_cam_init, micro_mg_cam_tend +use micro_pumas_cam, only: micro_pumas_cam_readnl, micro_pumas_cam_register, & + micro_pumas_cam_implements_cnst, micro_pumas_cam_init_cnst, & + micro_pumas_cam_init, micro_pumas_cam_tend use cam_logfile, only: iulog use cam_abortutils, only: endrun use perf_mod, only: t_startf, t_stopf @@ -49,8 +49,8 @@ subroutine microp_driver_readnl(nlfile) select case (microp_scheme) case ('MG') - call micro_mg_cam_readnl(nlfile) - case ('NONE', 'RK', 'SPCAM_sam1mom', 'SPCAM_m2005') + call micro_pumas_cam_readnl(nlfile) + case ('NONE', 'RK') continue case default call endrun('microp_driver_readnl:: unrecognized microp_scheme, "'//trim(microp_scheme)//'"') @@ -66,7 +66,7 @@ subroutine microp_driver_register select case (microp_scheme) case ('MG') - call micro_mg_cam_register() + call micro_pumas_cam_register() case ('RK') ! microp_driver doesn't handle this one continue @@ -94,8 +94,8 @@ function microp_driver_implements_cnst(name) select case (microp_scheme) case ('MG') - microp_driver_implements_cnst = micro_mg_cam_implements_cnst(name) - case ('NONE', 'RK', 'SPCAM_sam1mom', 'SPCAM_m2005') + microp_driver_implements_cnst = micro_pumas_cam_implements_cnst(name) + case ('NONE', 'RK') continue case default call endrun('microp_driver_implements_cnst:: unrecognized microp_scheme, '//trim(microp_scheme)) @@ -119,16 +119,10 @@ subroutine microp_driver_init_cnst(name, latvals, lonvals, mask, q) select case (microp_scheme) case ('MG') - call micro_mg_cam_init_cnst(name, latvals, lonvals, mask, q) + call micro_pumas_cam_init_cnst(name, latvals, lonvals, mask, q) case ('RK') ! microp_driver doesn't handle this one continue - case ('SPCAM_m2005') - ! microp_driver doesn't handle this one - continue - case ('SPCAM_sam1mom') - ! microp_driver doesn't handle this one - continue case default call endrun('microp_driver_init_cnst:: unrecognized microp_scheme'//trim(microp_scheme)) end select @@ -146,7 +140,7 @@ subroutine microp_driver_init(pbuf2d) select case (microp_scheme) case ('MG') - call micro_mg_cam_init(pbuf2d) + call micro_pumas_cam_init(pbuf2d) case ('RK') ! microp_driver doesn't handle this one continue @@ -186,7 +180,7 @@ subroutine microp_driver_tend(state, ptend, dtime, pbuf) select case (microp_scheme) case ('MG') call t_startf('microp_mg_tend') - call micro_mg_cam_tend(state, ptend, dtime, pbuf) + call micro_pumas_cam_tend(state, ptend, dtime, pbuf) call t_stopf('microp_mg_tend') case ('RK') ! microp_driver doesn't handle this one diff --git a/src/physics/cam/modal_aer_opt.F90 b/src/physics/cam/modal_aer_opt.F90 deleted file mode 100644 index 5c95c17840..0000000000 --- a/src/physics/cam/modal_aer_opt.F90 +++ /dev/null @@ -1,1621 +0,0 @@ -module modal_aer_opt - -! parameterizes aerosol coefficients using chebychev polynomial -! parameterize aerosol radiative properties in terms of -! surface mode wet radius and wet refractive index - -! Ghan and Zaveri, JGR 2007. - -! uses Wiscombe's (1979) mie scattering code - - -use shr_kind_mod, only: r8 => shr_kind_r8, shr_kind_cl -use ppgrid, only: pcols, pver, pverp -use constituents, only: pcnst -use spmd_utils, only: masterproc -use ref_pres, only: top_lev => clim_modal_aero_top_lev -use physconst, only: rhoh2o, rga, rair -use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_uv_diag, idx_nir_diag -use rad_constituents, only: n_diag, rad_cnst_get_call_list, rad_cnst_get_info, rad_cnst_get_aer_mmr, & - rad_cnst_get_aer_props, rad_cnst_get_mode_props -use physics_types, only: physics_state - -use physics_buffer, only : pbuf_get_index,physics_buffer_desc, pbuf_get_field -use pio, only: file_desc_t, var_desc_t, pio_inq_dimlen, pio_inq_dimid, pio_inq_varid, & - pio_get_var, pio_nowrite, pio_closefile -use cam_pio_utils, only: cam_pio_openfile -use cam_history, only: addfld, add_default, outfld, horiz_only -use cam_history_support, only: fillvalue -use cam_logfile, only: iulog -use perf_mod, only: t_startf, t_stopf -use cam_abortutils, only: endrun - -use modal_aero_wateruptake, only: modal_aero_wateruptake_dr -use modal_aero_calcsize, only: modal_aero_calcsize_diag - -implicit none -private -save - -public :: modal_aer_opt_readnl, modal_aer_opt_init, modal_aero_sw, modal_aero_lw - - -character(len=*), parameter :: unset_str = 'UNSET' - -! Namelist variables: -character(shr_kind_cl) :: modal_optics_file = unset_str ! full pathname for modal optics dataset -character(shr_kind_cl) :: water_refindex_file = unset_str ! full pathname for water refractive index dataset - -! Dimension sizes in coefficient arrays used to parameterize aerosol radiative properties -! in terms of refractive index and wet radius -integer, parameter :: ncoef=5, prefr=7, prefi=10 - -real(r8) :: xrmin, xrmax - -! refractive index for water read in read_water_refindex -complex(r8) :: crefwsw(nswbands) ! complex refractive index for water visible -complex(r8) :: crefwlw(nlwbands) ! complex refractive index for water infrared - -! physics buffer indices -integer :: dgnumwet_idx = -1 -integer :: qaerwat_idx = -1 - -character(len=4) :: diag(0:n_diag) = (/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ', & - '_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) - -!=============================================================================== -CONTAINS -!=============================================================================== - -subroutine modal_aer_opt_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'modal_aer_opt_readnl' - - namelist /modal_aer_opt_nl/ water_refindex_file - !----------------------------------------------------------------------------- - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'modal_aer_opt_nl', status=ierr) - if (ierr == 0) then - read(unitn, modal_aer_opt_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - -#ifdef SPMD - call mpibcast(water_refindex_file, len(water_refindex_file), mpichar, 0, mpicom) -#endif - - -end subroutine modal_aer_opt_readnl - -!=============================================================================== - -subroutine modal_aer_opt_init() - - use ioFileMod, only: getfil - use phys_control, only: phys_getopts - - ! Local variables - - integer :: i, m - real(r8) :: rmmin, rmmax ! min, max aerosol surface mode radius treated (m) - character(len=256) :: locfile - - logical :: history_amwg ! output the variables used by the AMWG diag package - logical :: history_aero_optics ! output aerosol optics diagnostics - logical :: history_dust ! output dust diagnostics - - logical :: call_list(0:n_diag) - integer :: ilist, nmodes, m_ncoef, m_prefr, m_prefi - integer :: errcode - - character(len=*), parameter :: routine='modal_aer_opt_init' - character(len=10) :: fldname - character(len=128) :: lngname - - !---------------------------------------------------------------------------- - - rmmin = 0.01e-6_r8 - rmmax = 25.e-6_r8 - xrmin = log(rmmin) - xrmax = log(rmmax) - - ! Check that dimension sizes in the coefficient arrays used to - ! parameterize aerosol radiative properties are consistent between this - ! module and the mode physprop files. - call rad_cnst_get_call_list(call_list) - do ilist = 0, n_diag - if (call_list(ilist)) then - call rad_cnst_get_info(ilist, nmodes=nmodes) - do m = 1, nmodes - call rad_cnst_get_mode_props(ilist, m, ncoef=m_ncoef, prefr=m_prefr, prefi=m_prefi) - if (m_ncoef /= ncoef .or. m_prefr /= prefr .or. m_prefi /= prefi) then - write(iulog,*) routine//': ERROR - file and module values do not match:' - write(iulog,*) ' ncoef:', ncoef, m_ncoef - write(iulog,*) ' prefr:', prefr, m_prefr - write(iulog,*) ' prefi:', prefi, m_prefi - call endrun(routine//': ERROR - file and module values do not match') - end if - end do - end if - end do - - ! Initialize physics buffer indices for dgnumwet and qaerwat. Note the implicit assumption - ! that the loops over modes in the optics calculations will use the values for dgnumwet and qaerwat - ! that are set in the aerosol_wet_intr code. - dgnumwet_idx = pbuf_get_index('DGNUMWET',errcode) - if (errcode < 0) then - call endrun(routine//' ERROR: cannot find physics buffer field DGNUMWET') - end if - qaerwat_idx = pbuf_get_index('QAERWAT',errcode) - if (errcode < 0) then - call endrun(routine//' ERROR: cannot find physics buffer field QAERWAT') - end if - - call getfil(water_refindex_file, locfile) - call read_water_refindex(locfile) - if (masterproc) write(iulog,*) "modal_aer_opt_init: read water refractive index file:", trim(locfile) - - call phys_getopts(history_amwg_out = history_amwg, & - history_aero_optics_out = history_aero_optics, & - history_dust_out = history_dust ) - - ! Add diagnostic fields to history output. - - call addfld ('EXTINCT', (/ 'lev' /), 'A','/m','Aerosol extinction 550 nm, day only', & - flag_xyfill=.true.) - call addfld ('EXTINCTUV', (/ 'lev' /), 'A','/m','Aerosol extinction 350 nm, day only', & - flag_xyfill=.true.) - call addfld ('EXTINCTNIR', (/ 'lev' /), 'A','/m','Aerosol extinction 1020 nm, day only', & - flag_xyfill=.true.) - call addfld ('ABSORB', (/ 'lev' /), 'A','/m','Aerosol absorption, day only', & - flag_xyfill=.true.) - call addfld ('AODVIS', horiz_only, 'A',' ','Aerosol optical depth 550 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODVISst', horiz_only, 'A',' ','Stratospheric aerosol optical depth 550 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODUV', horiz_only, 'A',' ','Aerosol optical depth 350 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODUVst', horiz_only, 'A',' ','Stratospheric aerosol optical depth 350 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODNIR', horiz_only, 'A',' ','Aerosol optical depth 1020 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODNIRst', horiz_only, 'A',' ','Stratospheric aerosol optical depth 1020 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODABS', horiz_only, 'A',' ','Aerosol absorption optical depth 550 nm, day only', & - flag_xyfill=.true.) - call addfld ('AODxASYM', horiz_only, 'A',' ','Aerosol optical depth 550 * asymmetry factor, day only',& - flag_xyfill=.true.) - call addfld ('EXTxASYM', (/ 'lev' /), 'A',' ','extinction 550 nm * asymmetry factor, day only', & - flag_xyfill=.true.) - - call addfld ('EXTINCTdn', (/ 'lev' /), 'A','/m','Aerosol extinction 550 nm, day night', & - flag_xyfill=.true.) - call addfld ('EXTINCTUVdn', (/ 'lev' /), 'A','/m','Aerosol extinction 350 nm, day night', & - flag_xyfill=.true.) - call addfld ('EXTINCTNIRdn', (/ 'lev' /), 'A','/m','Aerosol extinction 1020 nm, day night', & - flag_xyfill=.true.) - call addfld ('ABSORBdn', (/ 'lev' /), 'A','/m','Aerosol absorption, day night', & - flag_xyfill=.true.) - call addfld ('AODVISdn', horiz_only, 'A',' ','Aerosol optical depth 550 nm, day night', & - flag_xyfill=.true.) - call addfld ('AODVISstdn', horiz_only, 'A',' ','Stratospheric aerosol optical depth 550 nm, day night',& - flag_xyfill=.true.) - call addfld ('AODUVdn', horiz_only, 'A',' ','Aerosol optical depth 350 nm, day night', & - flag_xyfill=.true.) - call addfld ('AODUVstdn', horiz_only, 'A',' ','Stratospheric aerosol optical depth 350 nm, day night',& - flag_xyfill=.true.) - call addfld ('AODNIRdn', horiz_only, 'A',' ','Aerosol optical depth 1020 nm, day night', & - flag_xyfill=.true.) - call addfld ('AODNIRstdn', horiz_only, 'A',' ','Stratospheric aerosol optical depth 1020 nm, day night',& - flag_xyfill=.true.) - call addfld ('AODABSdn', horiz_only, 'A',' ','Aerosol absorption optical depth 550 nm, day night', & - flag_xyfill=.true.) - call addfld ('AODxASYMdn', horiz_only, 'A',' ','Aerosol optical depth 550 * asymmetry factor, day night',& - flag_xyfill=.true.) - call addfld ('EXTxASYMdn', (/ 'lev' /), 'A',' ','extinction 550 * asymmetry factor, day night', & - flag_xyfill=.true.) - - call rad_cnst_get_info(0, nmodes=nmodes) - - do m = 1, nmodes - - write(fldname,'(a,i1)') 'BURDEN', m - write(lngname,'(a,i1)') 'Aerosol burden, day only, mode ', m - call addfld (fldname, horiz_only, 'A', 'kg/m2', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then - call add_default (fldname, 1, ' ') - endif - - write(fldname,'(a,i1)') 'AODMODE', m - write(lngname,'(a,i1)') 'Aerosol optical depth, day only, 550 nm mode ', m - call addfld (fldname, horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then - call add_default (fldname, 1, ' ') - endif - - write(fldname,'(a,i1)') 'AODDUST', m - write(lngname,'(a,i1,a)') 'Aerosol optical depth, day only, 550 nm mode ',m,' from dust' - call addfld (fldname, horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then - call add_default (fldname, 1, ' ') - endif - - write(fldname,'(a,i1)') 'BURDENdn', m - write(lngname,'(a,i1)') 'Aerosol burden, day night, mode ', m - call addfld (fldname, horiz_only, 'A', 'kg/m2', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then - call add_default (fldname, 1, ' ') - endif - - write(fldname,'(a,i1)') 'AODdnMODE', m - write(lngname,'(a,i1)') 'Aerosol optical depth 550 nm, day night, mode ', m - call addfld (fldname, horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then - call add_default (fldname, 1, ' ') - endif - - write(fldname,'(a,i1)') 'AODdnDUST', m - write(lngname,'(a,i1,a)') 'Aerosol optical depth 550 nm, day night, mode ',m,' from dust' - call addfld (fldname, horiz_only, 'A', ' ', lngname, flag_xyfill=.true.) - if (m>3 .and. history_aero_optics) then - call add_default (fldname, 1, ' ') - endif - - enddo - - call addfld ('AODDUST', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from dust, day only', & - flag_xyfill=.true.) - call addfld ('AODSO4', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SO4, day only', & - flag_xyfill=.true.) - call addfld ('AODPOM', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from POM, day only', & - flag_xyfill=.true.) - call addfld ('AODSOA', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SOA, day only', & - flag_xyfill=.true.) - call addfld ('AODBC', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from BC, day only', & - flag_xyfill=.true.) - call addfld ('AODSS', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from seasalt, day only', & - flag_xyfill=.true.) - call addfld ('AODABSBC', horiz_only, 'A',' ', 'Aerosol absorption optical depth 550 nm from BC, day only',& - flag_xyfill=.true.) - call addfld ('BURDENDUST', horiz_only, 'A','kg/m2', 'Dust aerosol burden, day only' , & - flag_xyfill=.true.) - call addfld ('BURDENSO4', horiz_only, 'A','kg/m2', 'Sulfate aerosol burden, day only' , & - flag_xyfill=.true.) - call addfld ('BURDENPOM', horiz_only, 'A','kg/m2', 'POM aerosol burden, day only' , & - flag_xyfill=.true.) - call addfld ('BURDENSOA', horiz_only, 'A','kg/m2', 'SOA aerosol burden, day only' , & - flag_xyfill=.true.) - call addfld ('BURDENBC', horiz_only, 'A','kg/m2', 'Black carbon aerosol burden, day only', & - flag_xyfill=.true.) - call addfld ('BURDENSEASALT', horiz_only, 'A','kg/m2', 'Seasalt aerosol burden, day only' , & - flag_xyfill=.true.) - call addfld ('SSAVIS', horiz_only, 'A',' ', 'Aerosol single-scatter albedo, day only', & - flag_xyfill=.true.) - - call addfld ('AODDUSTdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from dust, day night', & - flag_xyfill=.true.) - call addfld ('AODSO4dn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SO4, day night', & - flag_xyfill=.true.) - call addfld ('AODPOMdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from POM, day night', & - flag_xyfill=.true.) - call addfld ('AODSOAdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from SOA, day night', & - flag_xyfill=.true.) - call addfld ('AODBCdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from BC, day night', & - flag_xyfill=.true.) - call addfld ('AODSSdn', horiz_only, 'A',' ', 'Aerosol optical depth 550 nm from seasalt, day night', & - flag_xyfill=.true.) - call addfld ('AODABSBCdn', horiz_only, 'A',' ', 'Aerosol absorption optical depth 550 nm from BC, day night',& - flag_xyfill=.true.) - call addfld ('BURDENDUSTdn', horiz_only, 'A','kg/m2', 'Dust aerosol burden, day night' , & - flag_xyfill=.true.) - call addfld ('BURDENSO4dn', horiz_only, 'A','kg/m2', 'Sulfate aerosol burden, day night' , & - flag_xyfill=.true.) - call addfld ('BURDENPOMdn', horiz_only, 'A','kg/m2', 'POM aerosol burden, day night' , & - flag_xyfill=.true.) - call addfld ('BURDENSOAdn', horiz_only, 'A','kg/m2', 'SOA aerosol burden, day night' , & - flag_xyfill=.true.) - call addfld ('BURDENBCdn', horiz_only, 'A','kg/m2', 'Black carbon aerosol burden, day night', & - flag_xyfill=.true.) - call addfld ('BURDENSEASALTdn', horiz_only, 'A','kg/m2', 'Seasalt aerosol burden, day night' , & - flag_xyfill=.true.) - call addfld ('SSAVISdn', horiz_only, 'A',' ', 'Aerosol single-scatter albedo, day night', & - flag_xyfill=.true.) - - - if (history_amwg) then - call add_default ('AODDUST1' , 1, ' ') - call add_default ('AODDUST3' , 1, ' ') - call add_default ('AODDUST' , 1, ' ') - call add_default ('AODVIS' , 1, ' ') - end if - - if (history_dust) then - call add_default ('AODDUST1' , 1, ' ') - call add_default ('AODDUST2' , 1, ' ') - call add_default ('AODDUST3' , 1, ' ') - end if - - if (history_aero_optics) then - call add_default ('AODDUST1' , 1, ' ') - call add_default ('AODDUST3' , 1, ' ') - call add_default ('ABSORB' , 1, ' ') - call add_default ('AODMODE1' , 1, ' ') - call add_default ('AODMODE2' , 1, ' ') - call add_default ('AODMODE3' , 1, ' ') - call add_default ('AODVIS' , 1, ' ') - call add_default ('AODUV' , 1, ' ') - call add_default ('AODNIR' , 1, ' ') - call add_default ('AODABS' , 1, ' ') - call add_default ('AODABSBC' , 1, ' ') - call add_default ('AODDUST' , 1, ' ') - call add_default ('AODSO4' , 1, ' ') - call add_default ('AODPOM' , 1, ' ') - call add_default ('AODSOA' , 1, ' ') - call add_default ('AODBC' , 1, ' ') - call add_default ('AODSS' , 1, ' ') - call add_default ('BURDEN1' , 1, ' ') - call add_default ('BURDEN2' , 1, ' ') - call add_default ('BURDEN3' , 1, ' ') - call add_default ('BURDENDUST' , 1, ' ') - call add_default ('BURDENSO4' , 1, ' ') - call add_default ('BURDENPOM' , 1, ' ') - call add_default ('BURDENSOA' , 1, ' ') - call add_default ('BURDENBC' , 1, ' ') - call add_default ('BURDENSEASALT', 1, ' ') - call add_default ('SSAVIS' , 1, ' ') - call add_default ('EXTINCT' , 1, ' ') - call add_default ('AODxASYM' , 1, ' ') - call add_default ('EXTxASYM' , 1, ' ') - - call add_default ('AODdnDUST1' , 1, ' ') - call add_default ('AODdnDUST3' , 1, ' ') - call add_default ('ABSORBdn' , 1, ' ') - call add_default ('AODdnMODE1' , 1, ' ') - call add_default ('AODdnMODE2' , 1, ' ') - call add_default ('AODdnMODE3' , 1, ' ') - call add_default ('AODVISdn' , 1, ' ') - call add_default ('AODUVdn' , 1, ' ') - call add_default ('AODNIRdn' , 1, ' ') - call add_default ('AODABSdn' , 1, ' ') - call add_default ('AODABSBCdn' , 1, ' ') - call add_default ('AODDUSTdn' , 1, ' ') - call add_default ('AODSO4dn' , 1, ' ') - call add_default ('AODPOMdn' , 1, ' ') - call add_default ('AODSOAdn' , 1, ' ') - call add_default ('AODBCdn' , 1, ' ') - call add_default ('AODSSdn' , 1, ' ') - call add_default ('BURDENdn1' , 1, ' ') - call add_default ('BURDENdn2' , 1, ' ') - call add_default ('BURDENdn3' , 1, ' ') - call add_default ('BURDENDUSTdn' , 1, ' ') - call add_default ('BURDENSO4dn' , 1, ' ') - call add_default ('BURDENPOMdn' , 1, ' ') - call add_default ('BURDENSOAdn' , 1, ' ') - call add_default ('BURDENBCdn' , 1, ' ') - call add_default ('BURDENSEASALTdn', 1, ' ') - call add_default ('SSAVISdn' , 1, ' ') - call add_default ('EXTINCTdn' , 1, ' ') - call add_default ('AODxASYMdn' , 1, ' ') - call add_default ('EXTxASYMdn' , 1, ' ') - end if - - do ilist = 1, n_diag - if (call_list(ilist)) then - - call addfld ('EXTINCT'//diag(ilist), (/ 'lev' /), 'A','/m', & - 'Aerosol extinction', flag_xyfill=.true.) - call addfld ('ABSORB'//diag(ilist), (/ 'lev' /), 'A','/m', & - 'Aerosol absorption', flag_xyfill=.true.) - call addfld ('AODVIS'//diag(ilist), horiz_only, 'A',' ', & - 'Aerosol optical depth 550 nm', flag_xyfill=.true.) - call addfld ('AODVISst'//diag(ilist), horiz_only, 'A',' ', & - 'Stratospheric aerosol optical depth 550 nm', flag_xyfill=.true.) - call addfld ('AODABS'//diag(ilist), horiz_only, 'A',' ', & - 'Aerosol absorption optical depth 550 nm', flag_xyfill=.true.) - - call addfld ('EXTINCTdn'//diag(ilist), (/ 'lev' /), 'A','/m',& - 'Aerosol extinction 550 nm, day night', flag_xyfill=.true.) - call addfld ('ABSORBdn'//diag(ilist), (/ 'lev' /), 'A','/m',& - 'Aerosol absorption, day night', flag_xyfill=.true.) - call addfld ('AODVISdn'//diag(ilist), horiz_only, 'A',' ',& - 'Aerosol optical depth 550 nm, day night', flag_xyfill=.true.) - call addfld ('AODVISstdn'//diag(ilist), horiz_only, 'A',' ',& - 'Stratospheric aerosol optical depth 550 nm, day night', flag_xyfill=.true.) - call addfld ('AODABSdn'//diag(ilist), horiz_only, 'A',' ',& - 'Aerosol absorption optical depth 550 nm, day night', flag_xyfill=.true.) - call addfld ('EXTxASYMdn'//diag(ilist), (/ 'lev' /), 'A',' ',& - 'extinction 550 * asymmetry factor, day night', flag_xyfill=.true.) - call addfld ('EXTxASYM'//diag(ilist), (/ 'lev' /), 'A',' ',& - 'extinction 550 nm * asymmetry factor, day only', flag_xyfill=.true.) - - if (history_aero_optics) then - call add_default ('EXTINCT'//diag(ilist), 1, ' ') - call add_default ('ABSORB'//diag(ilist), 1, ' ') - call add_default ('AODVIS'//diag(ilist), 1, ' ') - call add_default ('AODVISst'//diag(ilist), 1, ' ') - call add_default ('AODABS'//diag(ilist), 1, ' ') - end if - - end if - end do - -end subroutine modal_aer_opt_init - -!=============================================================================== - -subroutine modal_aero_sw(list_idx, state, pbuf, nnite, idxnite, & - tauxar, wa, ga, fa) - - ! calculates aerosol sw radiative properties - - use tropopause, only : tropopause_findChemTrop - - integer, intent(in) :: list_idx ! index of the climate or a diagnostic list - type(physics_state), intent(in), target :: state ! state variables - - type(physics_buffer_desc), pointer :: pbuf(:) - integer, intent(in) :: nnite ! number of night columns - integer, intent(in) :: idxnite(nnite) ! local column indices of night columns - - real(r8), intent(out) :: tauxar(pcols,0:pver,nswbands) ! layer extinction optical depth - real(r8), intent(out) :: wa(pcols,0:pver,nswbands) ! layer single-scatter albedo - real(r8), intent(out) :: ga(pcols,0:pver,nswbands) ! asymmetry factor - real(r8), intent(out) :: fa(pcols,0:pver,nswbands) ! forward scattered fraction - - ! Local variables - integer :: i, ifld, isw, k, l, m, nc, ns - integer :: lchnk ! chunk id - integer :: ncol ! number of active columns in the chunk - integer :: nmodes - integer :: nspec - integer :: troplevchem(pcols) ! Chemical tropopause level - integer :: istat - - real(r8) :: mass(pcols,pver) ! layer mass - real(r8) :: air_density(pcols,pver) ! (kg/m3) - - real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio - real(r8) :: specdens ! species density (kg/m3) - complex(r8), pointer :: specrefindex(:) ! species refractive index - character*32 :: spectype ! species type - real(r8) :: hygro_aer ! - - real(r8), pointer :: dgnumwet(:,:) ! number mode wet diameter - real(r8), pointer :: qaerwat(:,:) ! aerosol water (g/g) - - real(r8), pointer :: dgnumdry_m(:,:,:) ! number mode dry diameter for all modes - real(r8), pointer :: dgnumwet_m(:,:,:) ! number mode wet diameter for all modes - real(r8), pointer :: qaerwat_m(:,:,:) ! aerosol water (g/g) for all modes - real(r8), pointer :: wetdens_m(:,:,:) ! - real(r8), pointer :: hygro_m(:,:,:) ! - real(r8), pointer :: dryvol_m(:,:,:) ! - real(r8), pointer :: dryrad_m(:,:,:) ! - real(r8), pointer :: drymass_m(:,:,:) ! - real(r8), pointer :: so4dryvol_m(:,:,:) ! - real(r8), pointer :: naer_m(:,:,:) ! - - real(r8) :: sigma_logr_aer ! geometric standard deviation of number distribution - real(r8) :: radsurf(pcols,pver) ! aerosol surface mode radius - real(r8) :: logradsurf(pcols,pver) ! log(aerosol surface mode radius) - real(r8) :: cheb(ncoef,pcols,pver) - - real(r8) :: refr(pcols) ! real part of refractive index - real(r8) :: refi(pcols) ! imaginary part of refractive index - complex(r8) :: crefin(pcols) ! complex refractive index - real(r8), pointer :: refrtabsw(:,:) ! table of real refractive indices for aerosols - real(r8), pointer :: refitabsw(:,:) ! table of imag refractive indices for aerosols - real(r8), pointer :: extpsw(:,:,:,:) ! specific extinction - real(r8), pointer :: abspsw(:,:,:,:) ! specific absorption - real(r8), pointer :: asmpsw(:,:,:,:) ! asymmetry factor - - real(r8) :: vol(pcols) ! volume concentration of aerosol specie (m3/kg) - real(r8) :: dryvol(pcols) ! volume concentration of aerosol mode (m3/kg) - real(r8) :: watervol(pcols) ! volume concentration of water in each mode (m3/kg) - real(r8) :: wetvol(pcols) ! volume concentration of wet mode (m3/kg) - - integer :: itab(pcols), jtab(pcols) - real(r8) :: ttab(pcols), utab(pcols) - real(r8) :: cext(pcols,ncoef), cabs(pcols,ncoef), casm(pcols,ncoef) - real(r8) :: pext(pcols) ! parameterized specific extinction (m2/kg) - real(r8) :: specpext(pcols) ! specific extinction (m2/kg) - real(r8) :: dopaer(pcols) ! aerosol optical depth in layer - real(r8) :: pabs(pcols) ! parameterized specific absorption (m2/kg) - real(r8) :: pasm(pcols) ! parameterized asymmetry factor - real(r8) :: palb(pcols) ! parameterized single scattering albedo - - ! Diagnostics - real(r8) :: extinct(pcols,pver) - real(r8) :: extinctnir(pcols,pver) - real(r8) :: extinctuv(pcols,pver) - real(r8) :: absorb(pcols,pver) - real(r8) :: aodvis(pcols) ! extinction optical depth - real(r8) :: aodvisst(pcols) ! stratospheric extinction optical depth - real(r8) :: aodabs(pcols) ! absorption optical depth - real(r8) :: asymvis(pcols) ! asymmetry factor * optical depth - real(r8) :: asymext(pcols,pver) ! asymmetry factor * extinction - - real(r8) :: aodabsbc(pcols) ! absorption optical depth of BC - - real(r8) :: ssavis(pcols) - real(r8) :: dustvol(pcols) ! volume concentration of dust in aerosol mode (m3/kg) - - real(r8) :: burden(pcols) - real(r8) :: burdendust(pcols), burdenso4(pcols), burdenbc(pcols), & - burdenpom(pcols), burdensoa(pcols), burdenseasalt(pcols) - - real(r8) :: aodmode(pcols) - real(r8) :: dustaodmode(pcols) ! dust aod in aerosol mode - - real(r8) :: specrefr, specrefi - real(r8) :: scatdust(pcols), scatso4(pcols), scatbc(pcols), & - scatpom(pcols), scatsoa(pcols), scatseasalt(pcols) - real(r8) :: absdust(pcols), absso4(pcols), absbc(pcols), & - abspom(pcols), abssoa(pcols), absseasalt(pcols) - real(r8) :: hygrodust(pcols), hygroso4(pcols), hygrobc(pcols), & - hygropom(pcols), hygrosoa(pcols), hygroseasalt(pcols) - - real(r8) :: scath2o, absh2o, sumscat, sumabs, sumhygro - real(r8) :: aodc ! aod of component - - ! total species AOD - real(r8) :: dustaod(pcols), so4aod(pcols), bcaod(pcols), & - pomaod(pcols), soaaod(pcols), seasaltaod(pcols) - - - - - logical :: savaervis ! true if visible wavelength (0.55 micron) - logical :: savaernir ! true if near ir wavelength (~0.88 micron) - logical :: savaeruv ! true if uv wavelength (~0.35 micron) - - real(r8) :: aoduv(pcols) ! extinction optical depth in uv - real(r8) :: aoduvst(pcols) ! stratospheric extinction optical depth in uv - real(r8) :: aodnir(pcols) ! extinction optical depth in nir - real(r8) :: aodnirst(pcols) ! stratospheric extinction optical depth in nir - - - character(len=32) :: outname - - ! debug output - integer, parameter :: nerrmax_dopaer=1000 - integer :: nerr_dopaer = 0 - real(r8) :: volf ! volume fraction of insoluble aerosol - character(len=*), parameter :: subname = 'modal_aero_sw' - !---------------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - - ! initialize output variables - tauxar(:ncol,:,:) = 0._r8 - wa(:ncol,:,:) = 0._r8 - ga(:ncol,:,:) = 0._r8 - fa(:ncol,:,:) = 0._r8 - - ! zero'th layer does not contain aerosol - tauxar(1:ncol,0,:) = 0._r8 - wa(1:ncol,0,:) = 0.925_r8 - ga(1:ncol,0,:) = 0.850_r8 - fa(1:ncol,0,:) = 0.7225_r8 - - mass(:ncol,:) = state%pdeldry(:ncol,:)*rga - air_density(:ncol,:) = state%pmid(:ncol,:)/(rair*state%t(:ncol,:)) - - ! diagnostics for visible band summed over modes - extinct(1:ncol,:) = 0.0_r8 - absorb(1:ncol,:) = 0.0_r8 - aodvis(1:ncol) = 0.0_r8 - aodvisst(1:ncol) = 0.0_r8 - aodabs(1:ncol) = 0.0_r8 - burdendust(:ncol) = 0.0_r8 - burdenso4(:ncol) = 0.0_r8 - burdenpom(:ncol) = 0.0_r8 - burdensoa(:ncol) = 0.0_r8 - burdenbc(:ncol) = 0.0_r8 - burdenseasalt(:ncol) = 0.0_r8 - ssavis(1:ncol) = 0.0_r8 - asymvis(1:ncol) = 0.0_r8 - asymext(1:ncol,:) = 0.0_r8 - - aodabsbc(:ncol) = 0.0_r8 - dustaod(:ncol) = 0.0_r8 - so4aod(:ncol) = 0.0_r8 - pomaod(:ncol) = 0.0_r8 - soaaod(:ncol) = 0.0_r8 - bcaod(:ncol) = 0.0_r8 - seasaltaod(:ncol) = 0.0_r8 - - ! diags for other bands - extinctuv(1:ncol,:) = 0.0_r8 - extinctnir(1:ncol,:) = 0.0_r8 - aoduv(:ncol) = 0.0_r8 - aodnir(:ncol) = 0.0_r8 - aoduvst(:ncol) = 0.0_r8 - aodnirst(:ncol) = 0.0_r8 - call tropopause_findChemTrop(state, troplevchem) - - ! loop over all aerosol modes - call rad_cnst_get_info(list_idx, nmodes=nmodes) - - if (list_idx == 0) then - ! water uptake and wet radius for the climate list has already been calculated - call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet_m) - call pbuf_get_field(pbuf, qaerwat_idx, qaerwat_m) - else - ! If doing a diagnostic calculation then need to calculate the wet radius - ! and water uptake for the diagnostic modes - allocate(dgnumdry_m(pcols,pver,nmodes), dgnumwet_m(pcols,pver,nmodes), & - qaerwat_m(pcols,pver,nmodes), wetdens_m(pcols,pver,nmodes), & - hygro_m(pcols,pver,nmodes), dryvol_m(pcols,pver,nmodes), & - dryrad_m(pcols,pver,nmodes), drymass_m(pcols,pver,nmodes), & - so4dryvol_m(pcols,pver,nmodes), naer_m(pcols,pver,nmodes), stat=istat) - if (istat > 0) then - call endrun('modal_aero_sw: allocation FAILURE: arrays for diagnostic calcs') - end if - call modal_aero_calcsize_diag(state, pbuf, list_idx, dgnumdry_m, hygro_m, & - dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) - call modal_aero_wateruptake_dr(state, pbuf, list_idx, dgnumdry_m, dgnumwet_m, & - qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_m, & - drymass_m, so4dryvol_m, naer_m) - endif - - do m = 1, nmodes - - ! diagnostics for visible band for each mode - burden(:ncol) = 0._r8 - aodmode(1:ncol) = 0.0_r8 - dustaodmode(1:ncol) = 0.0_r8 - - dgnumwet => dgnumwet_m(:,:,m) - qaerwat => qaerwat_m(:,:,m) - - ! get mode properties - call rad_cnst_get_mode_props(list_idx, m, sigmag=sigma_logr_aer, refrtabsw=refrtabsw , & - refitabsw=refitabsw, extpsw=extpsw, abspsw=abspsw, asmpsw=asmpsw) - - ! get mode info - call rad_cnst_get_info(list_idx, m, nspec=nspec) - - ! calc size parameter for all columns - call modal_size_parameters(ncol, sigma_logr_aer, dgnumwet, radsurf, logradsurf, cheb) - - do isw = 1, nswbands - savaervis = (isw .eq. idx_sw_diag) - savaeruv = (isw .eq. idx_uv_diag) - savaernir = (isw .eq. idx_nir_diag) - - do k = top_lev, pver - - ! form bulk refractive index - crefin(:ncol) = (0._r8, 0._r8) - dryvol(:ncol) = 0._r8 - dustvol(:ncol) = 0._r8 - - scatdust(:ncol) = 0._r8 - absdust(:ncol) = 0._r8 - hygrodust(:ncol) = 0._r8 - scatso4(:ncol) = 0._r8 - absso4(:ncol) = 0._r8 - hygroso4(:ncol) = 0._r8 - scatbc(:ncol) = 0._r8 - absbc(:ncol) = 0._r8 - hygrobc(:ncol) = 0._r8 - scatpom(:ncol) = 0._r8 - abspom(:ncol) = 0._r8 - hygropom(:ncol) = 0._r8 - scatsoa(:ncol) = 0._r8 - abssoa(:ncol) = 0._r8 - hygrosoa(:ncol) = 0._r8 - scatseasalt(:ncol) = 0._r8 - absseasalt(:ncol) = 0._r8 - hygroseasalt(:ncol) = 0._r8 - - ! aerosol species loop - do l = 1, nspec - call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, specmmr) - call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & - refindex_aer_sw=specrefindex, spectype=spectype, & - hygro_aer=hygro_aer) - - do i = 1, ncol - vol(i) = specmmr(i,k)/specdens - dryvol(i) = dryvol(i) + vol(i) - crefin(i) = crefin(i) + vol(i)*specrefindex(isw) - end do - - ! compute some diagnostics for visible band only - if (savaervis) then - - specrefr = real(specrefindex(isw)) - specrefi = aimag(specrefindex(isw)) - - do i = 1, ncol - burden(i) = burden(i) + specmmr(i,k)*mass(i,k) - end do - - if (trim(spectype) == 'dust') then - do i = 1, ncol - burdendust(i) = burdendust(i) + specmmr(i,k)*mass(i,k) - dustvol(i) = vol(i) - scatdust(i) = vol(i)*specrefr - absdust(i) = -vol(i)*specrefi - hygrodust(i) = vol(i)*hygro_aer - end do - end if - - if (trim(spectype) == 'sulfate') then - do i = 1, ncol - burdenso4(i) = burdenso4(i) + specmmr(i,k)*mass(i,k) - scatso4(i) = vol(i)*specrefr - absso4(i) = -vol(i)*specrefi - hygroso4(i) = vol(i)*hygro_aer - end do - end if - if (trim(spectype) == 'black-c') then - do i = 1, ncol - burdenbc(i) = burdenbc(i) + specmmr(i,k)*mass(i,k) - scatbc(i) = vol(i)*specrefr - absbc(i) = -vol(i)*specrefi - hygrobc(i) = vol(i)*hygro_aer - end do - end if - if (trim(spectype) == 'p-organic') then - do i = 1, ncol - burdenpom(i) = burdenpom(i) + specmmr(i,k)*mass(i,k) - scatpom(i) = vol(i)*specrefr - abspom(i) = -vol(i)*specrefi - hygropom(i) = vol(i)*hygro_aer - end do - end if - if (trim(spectype) == 's-organic') then - do i = 1, ncol - burdensoa(i) = burdensoa(i) + specmmr(i,k)*mass(i,k) - scatsoa(i) = vol(i)*specrefr - abssoa(i) = -vol(i)*specrefi - hygrosoa(i) = vol(i)*hygro_aer - end do - end if - if (trim(spectype) == 'seasalt') then - do i = 1, ncol - burdenseasalt(i) = burdenseasalt(i) + specmmr(i,k)*mass(i,k) - scatseasalt(i) = vol(i)*specrefr - absseasalt(i) = -vol(i)*specrefi - hygroseasalt(i) = vol(i)*hygro_aer - end do - end if - - end if - end do ! species loop - - do i = 1, ncol - watervol(i) = qaerwat(i,k)/rhoh2o - wetvol(i) = watervol(i) + dryvol(i) - if (watervol(i) < 0._r8) then - if (abs(watervol(i)) .gt. 1.e-1_r8*wetvol(i)) then - write(iulog,'(a,2e10.2,a)') 'watervol,wetvol=', & - watervol(i), wetvol(i), ' in '//subname - end if - watervol(i) = 0._r8 - wetvol(i) = dryvol(i) - end if - - ! volume mixing - crefin(i) = crefin(i) + watervol(i)*crefwsw(isw) - crefin(i) = crefin(i)/max(wetvol(i),1.e-60_r8) - refr(i) = real(crefin(i)) - refi(i) = abs(aimag(crefin(i))) - end do - - ! call t_startf('binterp') - - ! interpolate coefficients linear in refractive index - ! first call calcs itab,jtab,ttab,utab - itab(:ncol) = 0 - call binterp(extpsw(:,:,:,isw), ncol, ncoef, prefr, prefi, & - refr, refi, refrtabsw(:,isw), refitabsw(:,isw), & - itab, jtab, ttab, utab, cext) - call binterp(abspsw(:,:,:,isw), ncol, ncoef, prefr, prefi, & - refr, refi, refrtabsw(:,isw), refitabsw(:,isw), & - itab, jtab, ttab, utab, cabs) - call binterp(asmpsw(:,:,:,isw), ncol, ncoef, prefr, prefi, & - refr, refi, refrtabsw(:,isw), refitabsw(:,isw), & - itab, jtab, ttab, utab, casm) - - ! call t_stopf('binterp') - - ! parameterized optical properties - do i=1,ncol - - if (logradsurf(i,k) .le. xrmax) then - pext(i) = 0.5_r8*cext(i,1) - do nc = 2, ncoef - pext(i) = pext(i) + cheb(nc,i,k)*cext(i,nc) - enddo - pext(i) = exp(pext(i)) - else - pext(i) = 1.5_r8/(radsurf(i,k)*rhoh2o) ! geometric optics - endif - - ! convert from m2/kg water to m2/kg aerosol - specpext(i) = pext(i) - pext(i) = pext(i)*wetvol(i)*rhoh2o - pabs(i) = 0.5_r8*cabs(i,1) - pasm(i) = 0.5_r8*casm(i,1) - do nc = 2, ncoef - pabs(i) = pabs(i) + cheb(nc,i,k)*cabs(i,nc) - pasm(i) = pasm(i) + cheb(nc,i,k)*casm(i,nc) - enddo - pabs(i) = pabs(i)*wetvol(i)*rhoh2o - pabs(i) = max(0._r8,pabs(i)) - pabs(i) = min(pext(i),pabs(i)) - - palb(i) = 1._r8-pabs(i)/max(pext(i),1.e-40_r8) - palb(i) = 1._r8-pabs(i)/max(pext(i),1.e-40_r8) - - dopaer(i) = pext(i)*mass(i,k) - end do - - if (savaeruv) then - do i = 1, ncol - extinctuv(i,k) = extinctuv(i,k) + dopaer(i)*air_density(i,k)/mass(i,k) - aoduv(i) = aoduv(i) + dopaer(i) - if (k.le.troplevchem(i)) then - aoduvst(i) = aoduvst(i) + dopaer(i) - end if - end do - end if - - if (savaernir) then - do i = 1, ncol - extinctnir(i,k) = extinctnir(i,k) + dopaer(i)*air_density(i,k)/mass(i,k) - aodnir(i) = aodnir(i) + dopaer(i) - if (k.le.troplevchem(i)) then - aodnirst(i) = aodnirst(i) + dopaer(i) - end if - end do - endif - - ! Save aerosol optical depth at longest visible wavelength - ! sum over layers - if (savaervis) then - ! aerosol extinction (/m) - do i = 1, ncol - extinct(i,k) = extinct(i,k) + dopaer(i)*air_density(i,k)/mass(i,k) - absorb(i,k) = absorb(i,k) + pabs(i)*air_density(i,k) - aodvis(i) = aodvis(i) + dopaer(i) - aodabs(i) = aodabs(i) + pabs(i)*mass(i,k) - aodmode(i) = aodmode(i) + dopaer(i) - ssavis(i) = ssavis(i) + dopaer(i)*palb(i) - asymvis(i) = asymvis(i) + dopaer(i)*pasm(i) - asymext(i,k) = asymext(i,k) + dopaer(i)*pasm(i)*air_density(i,k)/mass(i,k) - if (k.le.troplevchem(i)) then - aodvisst(i) = aodvisst(i) + dopaer(i) - end if - - if (wetvol(i) > 1.e-40_r8) then - - dustaodmode(i) = dustaodmode(i) + dopaer(i)*dustvol(i)/wetvol(i) - - ! partition optical depth into contributions from each constituent - ! assume contribution is proportional to refractive index X volume - - scath2o = watervol(i)*real(crefwsw(isw)) - absh2o = -watervol(i)*aimag(crefwsw(isw)) - sumscat = scatso4(i) + scatpom(i) + scatsoa(i) + scatbc(i) + & - scatdust(i) + scatseasalt(i) + scath2o - sumabs = absso4(i) + abspom(i) + abssoa(i) + absbc(i) + & - absdust(i) + absseasalt(i) + absh2o - sumhygro = hygroso4(i) + hygropom(i) + hygrosoa(i) + hygrobc(i) + & - hygrodust(i) + hygroseasalt(i) - - scatdust(i) = (scatdust(i) + scath2o*hygrodust(i)/sumhygro)/sumscat - absdust(i) = (absdust(i) + absh2o*hygrodust(i)/sumhygro)/sumabs - - scatso4(i) = (scatso4(i) + scath2o*hygroso4(i)/sumhygro)/sumscat - absso4(i) = (absso4(i) + absh2o*hygroso4(i)/sumhygro)/sumabs - - scatpom(i) = (scatpom(i) + scath2o*hygropom(i)/sumhygro)/sumscat - abspom(i) = (abspom(i) + absh2o*hygropom(i)/sumhygro)/sumabs - - scatsoa(i) = (scatsoa(i) + scath2o*hygrosoa(i)/sumhygro)/sumscat - abssoa(i) = (abssoa(i) + absh2o*hygrosoa(i)/sumhygro)/sumabs - - scatbc(i) = (scatbc(i) + scath2o*hygrobc(i)/sumhygro)/sumscat - absbc(i) = (absbc(i) + absh2o*hygrobc(i)/sumhygro)/sumabs - - scatseasalt(i) = (scatseasalt(i) + scath2o*hygroseasalt(i)/sumhygro)/sumscat - absseasalt(i) = (absseasalt(i) + absh2o*hygroseasalt(i)/sumhygro)/sumabs - - aodabsbc(i) = aodabsbc(i) + absbc(i)*dopaer(i)*(1.0_r8-palb(i)) - - aodc = (absdust(i)*(1.0_r8 - palb(i)) + palb(i)*scatdust(i))*dopaer(i) - dustaod(i) = dustaod(i) + aodc - - aodc = (absso4(i)*(1.0_r8 - palb(i)) + palb(i)*scatso4(i))*dopaer(i) - so4aod(i) = so4aod(i) + aodc - - aodc = (abspom(i)*(1.0_r8 - palb(i)) + palb(i)*scatpom(i))*dopaer(i) - pomaod(i) = pomaod(i) + aodc - - aodc = (abssoa(i)*(1.0_r8 - palb(i)) + palb(i)*scatsoa(i))*dopaer(i) - soaaod(i) = soaaod(i) + aodc - - aodc = (absbc(i)*(1.0_r8 - palb(i)) + palb(i)*scatbc(i))*dopaer(i) - bcaod(i) = bcaod(i) + aodc - - aodc = (absseasalt(i)*(1.0_r8 - palb(i)) + palb(i)*scatseasalt(i))*dopaer(i) - seasaltaod(i) = seasaltaod(i) + aodc - - endif - - end do - endif - - do i = 1, ncol - - if ((dopaer(i) <= -1.e-10_r8) .or. (dopaer(i) >= 30._r8)) then - - if (dopaer(i) <= -1.e-10_r8) then - write(iulog,*) "ERROR: Negative aerosol optical depth & - &in this layer." - else - write(iulog,*) "WARNING: Aerosol optical depth is & - &unreasonably high in this layer." - end if - - write(iulog,*) 'dopaer(', i, ',', k, ',', m, ',', lchnk, ')=', dopaer(i) - ! write(iulog,*) 'itab,jtab,ttab,utab=',itab(i),jtab(i),ttab(i),utab(i) - write(iulog,*) 'k=', k, ' pext=', pext(i), ' specext=', specpext(i) - write(iulog,*) 'wetvol=', wetvol(i), ' dryvol=', dryvol(i), ' watervol=', watervol(i) - ! write(iulog,*) 'cext=',(cext(i,l),l=1,ncoef) - ! write(iulog,*) 'crefin=',crefin(i) - write(iulog,*) 'nspec=', nspec - ! write(iulog,*) 'cheb=', (cheb(nc,m,i,k),nc=2,ncoef) - do l = 1, nspec - call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, specmmr) - call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & - refindex_aer_sw=specrefindex) - volf = specmmr(i,k)/specdens - write(iulog,*) 'l=', l, 'vol(l)=', volf - write(iulog,*) 'isw=', isw, 'specrefindex(isw)=', specrefindex(isw) - write(iulog,*) 'specdens=', specdens - end do - - nerr_dopaer = nerr_dopaer + 1 -! if (nerr_dopaer >= nerrmax_dopaer) then - if (dopaer(i) < -1.e-10_r8) then - write(iulog,*) '*** halting in '//subname//' after nerr_dopaer =', nerr_dopaer - call endrun('exit from '//subname) - end if - - end if - end do - - do i=1,ncol - tauxar(i,k,isw) = tauxar(i,k,isw) + dopaer(i) - wa(i,k,isw) = wa(i,k,isw) + dopaer(i)*palb(i) - ga(i,k,isw) = ga(i,k,isw) + dopaer(i)*palb(i)*pasm(i) - fa(i,k,isw) = fa(i,k,isw) + dopaer(i)*palb(i)*pasm(i)*pasm(i) - end do - - end do ! pver - - end do ! sw bands - - ! mode diagnostics - ! The diagnostics are currently only output for the climate list. Code mods will - ! be necessary to provide output for the rad_diag lists. - if (list_idx == 0) then - - write(outname,'(a,i1)') 'BURDENdn', m - call outfld(trim(outname), burden, pcols, lchnk) - - write(outname,'(a,i1)') 'AODdnMODE', m - call outfld(trim(outname), aodmode, pcols, lchnk) - - write(outname,'(a,i1)') 'AODdnDUST', m - call outfld(trim(outname), dustaodmode, pcols, lchnk) - - do i = 1, nnite - burden(idxnite(i)) = fillvalue - aodmode(idxnite(i)) = fillvalue - dustaodmode(idxnite(i)) = fillvalue - end do - - write(outname,'(a,i1)') 'BURDEN', m - call outfld(trim(outname), burden, pcols, lchnk) - - write(outname,'(a,i1)') 'AODMODE', m - call outfld(trim(outname), aodmode, pcols, lchnk) - - write(outname,'(a,i1)') 'AODDUST', m - call outfld(trim(outname), dustaodmode, pcols, lchnk) - - end if - - end do ! nmodes - - if (list_idx > 0) then - deallocate(dgnumdry_m) - deallocate(dgnumwet_m) - deallocate(qaerwat_m) - deallocate(wetdens_m) - deallocate(hygro_m) - deallocate(dryvol_m) - deallocate(dryrad_m) - deallocate(drymass_m) - deallocate(so4dryvol_m) - deallocate(naer_m) - end if - - ! Output visible band diagnostics for quantities summed over the modes - ! These fields are put out for diagnostic lists as well as the climate list. - - call outfld('EXTINCTdn'//diag(list_idx), extinct, pcols, lchnk) - call outfld('ABSORBdn'//diag(list_idx), absorb, pcols, lchnk) - call outfld('AODVISdn'//diag(list_idx), aodvis, pcols, lchnk) - call outfld('AODABSdn'//diag(list_idx), aodabs, pcols, lchnk) - call outfld('AODVISstdn'//diag(list_idx), aodvisst,pcols, lchnk) - call outfld('EXTxASYMdn'//diag(list_idx), asymext, pcols, lchnk) - - do i = 1, nnite - extinct(idxnite(i),:) = fillvalue - absorb(idxnite(i),:) = fillvalue - aodvis(idxnite(i)) = fillvalue - aodabs(idxnite(i)) = fillvalue - aodvisst(idxnite(i)) = fillvalue - asymext(idxnite(i),:) = fillvalue - end do - - call outfld('EXTINCT'//diag(list_idx), extinct, pcols, lchnk) - call outfld('ABSORB'//diag(list_idx), absorb, pcols, lchnk) - call outfld('AODVIS'//diag(list_idx), aodvis, pcols, lchnk) - call outfld('AODABS'//diag(list_idx), aodabs, pcols, lchnk) - call outfld('AODVISst'//diag(list_idx), aodvisst,pcols, lchnk) - call outfld('EXTxASYM'//diag(list_idx), asymext, pcols, lchnk) - - ! These diagnostics are output only for climate list - if (list_idx == 0) then - do i = 1, ncol - if (aodvis(i) > 1.e-10_r8) then - ssavis(i) = ssavis(i)/aodvis(i) - else - ssavis(i) = 0.925_r8 - endif - end do - - call outfld('SSAVISdn', ssavis, pcols, lchnk) - call outfld('AODxASYMdn', asymvis, pcols, lchnk) - - call outfld('EXTINCTUVdn', extinctuv, pcols, lchnk) - call outfld('EXTINCTNIRdn', extinctnir, pcols, lchnk) - call outfld('AODUVdn', aoduv, pcols, lchnk) - call outfld('AODNIRdn', aodnir, pcols, lchnk) - call outfld('AODUVstdn', aoduvst, pcols, lchnk) - call outfld('AODNIRstdn', aodnirst, pcols, lchnk) - - call outfld('BURDENDUSTdn', burdendust, pcols, lchnk) - call outfld('BURDENSO4dn' , burdenso4, pcols, lchnk) - call outfld('BURDENPOMdn' , burdenpom, pcols, lchnk) - call outfld('BURDENSOAdn' , burdensoa, pcols, lchnk) - call outfld('BURDENBCdn' , burdenbc, pcols, lchnk) - call outfld('BURDENSEASALTdn', burdenseasalt, pcols, lchnk) - - call outfld('AODABSBCdn', aodabsbc, pcols, lchnk) - - call outfld('AODDUSTdn', dustaod, pcols, lchnk) - call outfld('AODSO4dn', so4aod, pcols, lchnk) - call outfld('AODPOMdn', pomaod, pcols, lchnk) - call outfld('AODSOAdn', soaaod, pcols, lchnk) - call outfld('AODBCdn', bcaod, pcols, lchnk) - call outfld('AODSSdn', seasaltaod, pcols, lchnk) - - - do i = 1, nnite - ssavis(idxnite(i)) = fillvalue - asymvis(idxnite(i)) = fillvalue - - aoduv(idxnite(i)) = fillvalue - aodnir(idxnite(i)) = fillvalue - aoduvst(idxnite(i)) = fillvalue - aodnirst(idxnite(i)) = fillvalue - extinctuv(idxnite(i),:) = fillvalue - extinctnir(idxnite(i),:) = fillvalue - - burdendust(idxnite(i)) = fillvalue - burdenso4(idxnite(i)) = fillvalue - burdenpom(idxnite(i)) = fillvalue - burdensoa(idxnite(i)) = fillvalue - burdenbc(idxnite(i)) = fillvalue - burdenseasalt(idxnite(i)) = fillvalue - - aodabsbc(idxnite(i)) = fillvalue - - dustaod(idxnite(i)) = fillvalue - so4aod(idxnite(i)) = fillvalue - pomaod(idxnite(i)) = fillvalue - soaaod(idxnite(i)) = fillvalue - bcaod(idxnite(i)) = fillvalue - seasaltaod(idxnite(i)) = fillvalue - end do - - call outfld('SSAVIS', ssavis, pcols, lchnk) - call outfld('AODxASYM', asymvis, pcols, lchnk) - - call outfld('EXTINCTUV', extinctuv, pcols, lchnk) - call outfld('EXTINCTNIR', extinctnir, pcols, lchnk) - call outfld('AODUV', aoduv, pcols, lchnk) - call outfld('AODNIR', aodnir, pcols, lchnk) - call outfld('AODUVst', aoduvst, pcols, lchnk) - call outfld('AODNIRst', aodnirst, pcols, lchnk) - - call outfld('BURDENDUST', burdendust, pcols, lchnk) - call outfld('BURDENSO4' , burdenso4, pcols, lchnk) - call outfld('BURDENPOM' , burdenpom, pcols, lchnk) - call outfld('BURDENSOA' , burdensoa, pcols, lchnk) - call outfld('BURDENBC' , burdenbc, pcols, lchnk) - call outfld('BURDENSEASALT', burdenseasalt, pcols, lchnk) - - call outfld('AODABSBC', aodabsbc, pcols, lchnk) - - call outfld('AODDUST', dustaod, pcols, lchnk) - call outfld('AODSO4', so4aod, pcols, lchnk) - call outfld('AODPOM', pomaod, pcols, lchnk) - call outfld('AODSOA', soaaod, pcols, lchnk) - call outfld('AODBC', bcaod, pcols, lchnk) - call outfld('AODSS', seasaltaod, pcols, lchnk) - end if - -end subroutine modal_aero_sw - -!=============================================================================== - -subroutine modal_aero_lw(list_idx, state, pbuf, tauxar) - - ! calculates aerosol lw radiative properties - - integer, intent(in) :: list_idx ! index of the climate or a diagnostic list - type(physics_state), intent(in), target :: state ! state variables - - type(physics_buffer_desc), pointer :: pbuf(:) - - real(r8), intent(out) :: tauxar(pcols,pver,nlwbands) ! layer absorption optical depth - - ! Local variables - integer :: i, ifld, ilw, k, l, m, nc, ns - integer :: lchnk ! chunk id - integer :: ncol ! number of active columns in the chunk - integer :: nmodes - integer :: nspec - integer :: istat - - real(r8), pointer :: dgnumwet(:,:) ! wet number mode diameter (m) - real(r8), pointer :: qaerwat(:,:) ! aerosol water (g/g) - - real(r8), pointer :: dgnumdry_m(:,:,:) ! number mode dry diameter for all modes - real(r8), pointer :: dgnumwet_m(:,:,:) ! number mode wet diameter for all modes - real(r8), pointer :: qaerwat_m(:,:,:) ! aerosol water (g/g) for all modes - real(r8), pointer :: wetdens_m(:,:,:) ! - real(r8), pointer :: hygro_m(:,:,:) ! - real(r8), pointer :: dryvol_m(:,:,:) ! - real(r8), pointer :: dryrad_m(:,:,:) ! - real(r8), pointer :: drymass_m(:,:,:) ! - real(r8), pointer :: so4dryvol_m(:,:,:) ! - real(r8), pointer :: naer_m(:,:,:) ! - - real(r8) :: sigma_logr_aer ! geometric standard deviation of number distribution - real(r8) :: alnsg_amode ! log of geometric standard deviation of number distribution - real(r8) :: xrad(pcols) - real(r8) :: cheby(ncoef,pcols,pver) ! chebychef polynomials - - real(r8) :: mass(pcols,pver) ! layer mass - - real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio - real(r8) :: specdens ! species density (kg/m3) - complex(r8), pointer :: specrefindex(:) ! species refractive index - - real(r8) :: vol(pcols) ! volume concentration of aerosol specie (m3/kg) - real(r8) :: dryvol(pcols) ! volume concentration of aerosol mode (m3/kg) - real(r8) :: wetvol(pcols) ! volume concentration of wet mode (m3/kg) - real(r8) :: watervol(pcols) ! volume concentration of water in each mode (m3/kg) - real(r8) :: refr(pcols) ! real part of refractive index - real(r8) :: refi(pcols) ! imaginary part of refractive index - complex(r8) :: crefin(pcols) ! complex refractive index - real(r8), pointer :: refrtablw(:,:) ! table of real refractive indices for aerosols - real(r8), pointer :: refitablw(:,:) ! table of imag refractive indices for aerosols - real(r8), pointer :: absplw(:,:,:,:) ! specific absorption - - integer :: itab(pcols), jtab(pcols) - real(r8) :: ttab(pcols), utab(pcols) - real(r8) :: cabs(pcols,ncoef) - real(r8) :: pabs(pcols) ! parameterized specific absorption (m2/kg) - real(r8) :: dopaer(pcols) ! aerosol optical depth in layer - - integer, parameter :: nerrmax_dopaer=1000 - integer :: nerr_dopaer = 0 - real(r8) :: volf ! volume fraction of insoluble aerosol - - character(len=*), parameter :: subname = 'modal_aero_lw' - !---------------------------------------------------------------------------- - - lchnk = state%lchnk - ncol = state%ncol - - ! initialize output variables - tauxar(:ncol,:,:) = 0._r8 - - ! dry mass in each cell - mass(:ncol,:) = state%pdeldry(:ncol,:)*rga - - ! loop over all aerosol modes - call rad_cnst_get_info(list_idx, nmodes=nmodes) - - if (list_idx == 0) then - ! water uptake and wet radius for the climate list has already been calculated - call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet_m) - call pbuf_get_field(pbuf, qaerwat_idx, qaerwat_m) - else - ! If doing a diagnostic calculation then need to calculate the wet radius - ! and water uptake for the diagnostic modes - allocate(dgnumdry_m(pcols,pver,nmodes), dgnumwet_m(pcols,pver,nmodes), & - qaerwat_m(pcols,pver,nmodes), wetdens_m(pcols,pver,nmodes), & - hygro_m(pcols,pver,nmodes), dryvol_m(pcols,pver,nmodes), & - dryrad_m(pcols,pver,nmodes), drymass_m(pcols,pver,nmodes), & - so4dryvol_m(pcols,pver,nmodes), naer_m(pcols,pver,nmodes), stat=istat) - - if (istat > 0) then - call endrun('modal_aero_lw: allocation FAILURE: arrays for diagnostic calcs') - end if - call modal_aero_calcsize_diag(state, pbuf, list_idx, dgnumdry_m, hygro_m, & - dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m) - call modal_aero_wateruptake_dr(state, pbuf, list_idx, dgnumdry_m, dgnumwet_m, & - qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_m, & - drymass_m, so4dryvol_m, naer_m) - endif - - do m = 1, nmodes - - dgnumwet => dgnumwet_m(:,:,m) - qaerwat => qaerwat_m(:,:,m) - - ! get mode properties - call rad_cnst_get_mode_props(list_idx, m, sigmag=sigma_logr_aer, refrtablw=refrtablw , & - refitablw=refitablw, absplw=absplw) - - ! get mode info - call rad_cnst_get_info(list_idx, m, nspec=nspec) - - ! calc size parameter for all columns - ! this is the same calculation that's done in modal_size_parameters, but there - ! some intermediate results are saved and the chebyshev polynomials are stored - ! in a array with different index order. Could be unified. - do k = top_lev, pver - do i = 1, ncol - alnsg_amode = log( sigma_logr_aer ) - ! convert from number diameter to surface area - xrad(i) = log(0.5_r8*dgnumwet(i,k)) + 2.0_r8*alnsg_amode*alnsg_amode - ! normalize size parameter - xrad(i) = max(xrad(i), xrmin) - xrad(i) = min(xrad(i), xrmax) - xrad(i) = (2*xrad(i)-xrmax-xrmin)/(xrmax-xrmin) - ! chebyshev polynomials - cheby(1,i,k) = 1.0_r8 - cheby(2,i,k) = xrad(i) - do nc = 3, ncoef - cheby(nc,i,k) = 2.0_r8*xrad(i)*cheby(nc-1,i,k)-cheby(nc-2,i,k) - end do - end do - end do - - do ilw = 1, nlwbands - - do k = top_lev, pver - - ! form bulk refractive index. Use volume mixing for infrared - crefin(:ncol) = (0._r8, 0._r8) - dryvol(:ncol) = 0._r8 - - ! aerosol species loop - do l = 1, nspec - call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, specmmr) - call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & - refindex_aer_lw=specrefindex) - - do i = 1, ncol - vol(i) = specmmr(i,k)/specdens - dryvol(i) = dryvol(i) + vol(i) - crefin(i) = crefin(i) + vol(i)*specrefindex(ilw) - end do - end do - - do i = 1, ncol - watervol(i) = qaerwat(i,k)/rhoh2o - wetvol(i) = watervol(i) + dryvol(i) - if (watervol(i) < 0.0_r8) then - if (abs(watervol(i)) .gt. 1.e-1_r8*wetvol(i)) then - write(iulog,*) 'watervol,wetvol,dryvol=',watervol(i),wetvol(i),dryvol(i),' in '//subname - end if - watervol(i) = 0._r8 - wetvol(i) = dryvol(i) - end if - - crefin(i) = crefin(i) + watervol(i)*crefwlw(ilw) - if (wetvol(i) > 1.e-40_r8) crefin(i) = crefin(i)/wetvol(i) - refr(i) = real(crefin(i)) - refi(i) = aimag(crefin(i)) - end do - - ! interpolate coefficients linear in refractive index - ! first call calcs itab,jtab,ttab,utab - itab(:ncol) = 0 - call binterp(absplw(:,:,:,ilw), ncol, ncoef, prefr, prefi, & - refr, refi, refrtablw(:,ilw), refitablw(:,ilw), & - itab, jtab, ttab, utab, cabs) - - ! parameterized optical properties - do i = 1, ncol - pabs(i) = 0.5_r8*cabs(i,1) - do nc = 2, ncoef - pabs(i) = pabs(i) + cheby(nc,i,k)*cabs(i,nc) - end do - pabs(i) = pabs(i)*wetvol(i)*rhoh2o - pabs(i) = max(0._r8,pabs(i)) - dopaer(i) = pabs(i)*mass(i,k) - end do - - do i = 1, ncol - - if ((dopaer(i) <= -1.e-10_r8) .or. (dopaer(i) >= 20._r8)) then - - if (dopaer(i) <= -1.e-10_r8) then - write(iulog,*) "ERROR: Negative aerosol optical depth & - &in this layer." - else - write(iulog,*) "WARNING: Aerosol optical depth is & - &unreasonably high in this layer." - end if - - write(iulog,*) 'dopaer(',i,',',k,',',m,',',lchnk,')=', dopaer(i) - write(iulog,*) 'k=',k,' pabs=', pabs(i) - write(iulog,*) 'wetvol=',wetvol(i),' dryvol=',dryvol(i), & - ' watervol=',watervol(i) - write(iulog,*) 'cabs=', (cabs(i,l),l=1,ncoef) - write(iulog,*) 'crefin=', crefin(i) - write(iulog,*) 'nspec=', nspec - do l = 1,nspec - call rad_cnst_get_aer_mmr(list_idx, m, l, 'a', state, pbuf, specmmr) - call rad_cnst_get_aer_props(list_idx, m, l, density_aer=specdens, & - refindex_aer_lw=specrefindex) - volf = specmmr(i,k)/specdens - write(iulog,*) 'l=',l,'vol(l)=',volf - write(iulog,*) 'ilw=',ilw,' specrefindex(ilw)=',specrefindex(ilw) - write(iulog,*) 'specdens=',specdens - end do - - nerr_dopaer = nerr_dopaer + 1 - if (nerr_dopaer >= nerrmax_dopaer .or. dopaer(i) < -1.e-10_r8) then - write(iulog,*) '*** halting in '//subname//' after nerr_dopaer =', nerr_dopaer - call endrun() - end if - - end if - end do - - do i = 1, ncol - tauxar(i,k,ilw) = tauxar(i,k,ilw) + dopaer(i) - end do - - end do ! k = top_lev, pver - - end do ! nlwbands - - end do ! m = 1, nmodes - - if (list_idx > 0) then - deallocate(dgnumdry_m) - deallocate(dgnumwet_m) - deallocate(qaerwat_m) - deallocate(wetdens_m) - deallocate(hygro_m) - deallocate(dryvol_m) - deallocate(dryrad_m) - deallocate(drymass_m) - deallocate(so4dryvol_m) - deallocate(naer_m) - end if - -end subroutine modal_aero_lw - -!=============================================================================== -! Private routines -!=============================================================================== - -subroutine read_water_refindex(infilename) - - ! read water refractive index file and set module data - - character*(*), intent(in) :: infilename ! modal optics filename - - ! Local variables - - integer :: i, ierr - type(file_desc_t) :: ncid ! pio file handle - integer :: did ! dimension ids - integer :: dimlen ! dimension lengths - type(var_desc_t) :: vid ! variable ids - real(r8) :: refrwsw(nswbands), refiwsw(nswbands) ! real, imaginary ref index for water visible - real(r8) :: refrwlw(nlwbands), refiwlw(nlwbands) ! real, imaginary ref index for water infrared - !---------------------------------------------------------------------------- - - ! open file - call cam_pio_openfile(ncid, infilename, PIO_NOWRITE) - - ! inquire dimensions. Check that file values match parameter values. - - ierr = pio_inq_dimid(ncid, 'lw_band', did) - ierr = pio_inq_dimlen(ncid, did, dimlen) - if (dimlen .ne. nlwbands) then - write(iulog,*) 'lw_band len=', dimlen, ' from ', infilename, ' ne nlwbands=', nlwbands - call endrun('read_modal_optics: bad lw_band value') - endif - - ierr = pio_inq_dimid(ncid, 'sw_band', did) - ierr = pio_inq_dimlen(ncid, did, dimlen) - if (dimlen .ne. nswbands) then - write(iulog,*) 'sw_band len=', dimlen, ' from ', infilename, ' ne nswbands=', nswbands - call endrun('read_modal_optics: bad sw_band value') - endif - - ! read variables - ierr = pio_inq_varid(ncid, 'refindex_real_water_sw', vid) - ierr = pio_get_var(ncid, vid, refrwsw) - - ierr = pio_inq_varid(ncid, 'refindex_im_water_sw', vid) - ierr = pio_get_var(ncid, vid, refiwsw) - - ierr = pio_inq_varid(ncid, 'refindex_real_water_lw', vid) - ierr = pio_get_var(ncid, vid, refrwlw) - - ierr = pio_inq_varid(ncid, 'refindex_im_water_lw', vid) - ierr = pio_get_var(ncid, vid, refiwlw) - - ! set complex representation of refractive indices as module data - do i = 1, nswbands - crefwsw(i) = cmplx(refrwsw(i), abs(refiwsw(i)),kind=r8) - end do - do i = 1, nlwbands - crefwlw(i) = cmplx(refrwlw(i), abs(refiwlw(i)),kind=r8) - end do - - call pio_closefile(ncid) - -end subroutine read_water_refindex - -!=============================================================================== - -subroutine modal_size_parameters(ncol, sigma_logr_aer, dgnumwet, radsurf, logradsurf, cheb) - - integer, intent(in) :: ncol - real(r8), intent(in) :: sigma_logr_aer ! geometric standard deviation of number distribution - real(r8), intent(in) :: dgnumwet(:,:) ! aerosol wet number mode diameter (m) - real(r8), intent(out) :: radsurf(:,:) ! aerosol surface mode radius - real(r8), intent(out) :: logradsurf(:,:) ! log(aerosol surface mode radius) - real(r8), intent(out) :: cheb(:,:,:) - - integer :: i, k, nc - real(r8) :: alnsg_amode - real(r8) :: explnsigma - real(r8) :: xrad(pcols) ! normalized aerosol radius - !------------------------------------------------------------------------------- - - alnsg_amode = log(sigma_logr_aer) - explnsigma = exp(2.0_r8*alnsg_amode*alnsg_amode) - - do k = top_lev, pver - do i = 1, ncol - ! convert from number mode diameter to surface area - radsurf(i,k) = 0.5_r8*dgnumwet(i,k)*explnsigma - logradsurf(i,k) = log(radsurf(i,k)) - ! normalize size parameter - xrad(i) = max(logradsurf(i,k),xrmin) - xrad(i) = min(xrad(i),xrmax) - xrad(i) = (2._r8*xrad(i)-xrmax-xrmin)/(xrmax-xrmin) - ! chebyshev polynomials - cheb(1,i,k) = 1._r8 - cheb(2,i,k) = xrad(i) - do nc = 3, ncoef - cheb(nc,i,k) = 2._r8*xrad(i)*cheb(nc-1,i,k)-cheb(nc-2,i,k) - end do - end do - end do - -end subroutine modal_size_parameters - -!=============================================================================== - - subroutine binterp(table,ncol,km,im,jm,x,y,xtab,ytab,ix,jy,t,u,out) - - ! bilinear interpolation of table - ! - implicit none - integer im,jm,km,ncol - real(r8) table(km,im,jm),xtab(im),ytab(jm),out(pcols,km) - integer i,ix(pcols),ip1,j,jy(pcols),jp1,k,ic,ip1m(pcols),jp1m(pcols),ixc,jyc - real(r8) x(pcols),dx,t(pcols),y(pcols),dy,u(pcols),tu(pcols),tuc(pcols),tcu(pcols),tcuc(pcols) - - if(ix(1).gt.0) go to 30 - if(im.gt.1)then - do ic=1,ncol - do i=1,im - if(x(ic).lt.xtab(i))go to 10 - enddo - 10 ix(ic)=max0(i-1,1) - ip1=min(ix(ic)+1,im) - dx=(xtab(ip1)-xtab(ix(ic))) - if(abs(dx).gt.1.e-20_r8)then - t(ic)=(x(ic)-xtab(ix(ic)))/dx - else - t(ic)=0._r8 - endif - end do - else - ix(:ncol)=1 - t(:ncol)=0._r8 - endif - if(jm.gt.1)then - do ic=1,ncol - do j=1,jm - if(y(ic).lt.ytab(j))go to 20 - enddo - 20 jy(ic)=max0(j-1,1) - jp1=min(jy(ic)+1,jm) - dy=(ytab(jp1)-ytab(jy(ic))) - if(abs(dy).gt.1.e-20_r8)then - u(ic)=(y(ic)-ytab(jy(ic)))/dy - else - u(ic)=0._r8 - endif - end do - else - jy(:ncol)=1 - u(:ncol)=0._r8 - endif - 30 continue - do ic=1,ncol - tu(ic)=t(ic)*u(ic) - tuc(ic)=t(ic)-tu(ic) - tcuc(ic)=1._r8-tuc(ic)-u(ic) - tcu(ic)=u(ic)-tu(ic) - jp1m(ic)=min(jy(ic)+1,jm) - ip1m(ic)=min(ix(ic)+1,im) - enddo - do ic=1,ncol - jyc=jy(ic) - ixc=ix(ic) - jp1=jp1m(ic) - ip1=ip1m(ic) - do k=1,km - out(ic,k) = tcuc(ic) * table(k,ixc,jyc) + tuc(ic) * table(k,ip1,jyc) + & - tu(ic) * table(k,ip1,jp1) + tcu(ic) * table(k,ixc,jp1) - end do - end do - return - end subroutine binterp - -end module modal_aer_opt diff --git a/src/physics/cam/molec_diff.F90 b/src/physics/cam/molec_diff.F90 index bcb55c3d4f..1877b8f594 100644 --- a/src/physics/cam/molec_diff.F90 +++ b/src/physics/cam/molec_diff.F90 @@ -19,8 +19,8 @@ module molec_diff !------------------------------------------------------------------------------------------------- ! use perf_mod - use physconst, only : mbarv - use phys_control, only : waccmx_is !WACCM-X runtime switch + use air_composition, only: mbarv + use phys_control, only: waccmx_is !WACCM-X runtime switch implicit none private @@ -59,7 +59,7 @@ module molec_diff subroutine init_molec_diff( kind, ncnst, mw_dry_in, n_avog_in, & errstring) - use constituents, only : cnst_mw, cnst_get_ind + use constituents, only: cnst_mw, cnst_get_ind integer, intent(in) :: kind ! Kind of reals being passed in integer, intent(in) :: ncnst ! Number of constituents @@ -122,7 +122,8 @@ subroutine compute_molec_diff(lchnk, pcols, pver, ncnst, ncol, & kvm, kvt, tint, rhoi, kq_scal, cnst_mw, & mw_fac_out, nbot_molec) - use physconst, only : cpairv, kmvis, kmcnd + use cam_thermo, only: kmvis, kmcnd + use air_composition, only: cpairv ! --------------------- ! ! Input-Output Argument ! @@ -219,9 +220,9 @@ function vd_lu_qdecomp( & tint , ztodt , nbot_molec , & lchnk , t , m , no_molec_decomp) result(decomp) - use coords_1d, only: Coords1D + use coords_1d, only: Coords1D use linear_1d_operators, only: BoundaryType, TriDiagDecomp - use vdiff_lu_solver, only: fin_vol_lu_decomp + use vdiff_lu_solver, only: fin_vol_lu_decomp !------------------------------------------------------------------------------ ! ! Add the molecular diffusivity to the turbulent diffusivity for a consitutent. ! diff --git a/src/physics/cam/ndrop.F90 b/src/physics/cam/ndrop.F90 index aa545c8032..3a2bed88c3 100644 --- a/src/physics/cam/ndrop.F90 +++ b/src/physics/cam/ndrop.F90 @@ -9,11 +9,10 @@ module ndrop ! index 0 in all the calls to rad_constituent interfaces. !--------------------------------------------------------------------------------- -use shr_kind_mod, only: r8 => shr_kind_r8 -use spmd_utils, only: masterproc -use ppgrid, only: pcols, pver, pverp +use shr_kind_mod, only: r8 => shr_kind_r8, shr_kind_cs +use ppgrid, only: pcols, pver use physconst, only: pi, rhoh2o, mwh2o, r_universal, rh2o, & - gravit, latvap, cpair, epsilo, rair + gravit, latvap, cpair, rair use constituents, only: pcnst, cnst_get_ind, cnst_name, cnst_spec_class_gas, cnst_species_class use physics_types, only: physics_state, physics_ptend, physics_ptend_init use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field @@ -22,30 +21,31 @@ module ndrop use phys_control, only: phys_getopts use ref_pres, only: top_lev => trop_cloud_top_lev use shr_spfn_mod, only: erf => shr_spfn_erf -use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num, rad_cnst_get_aer_mmr, & - rad_cnst_get_aer_props, rad_cnst_get_mode_props, & - rad_cnst_get_mam_mmr_idx, rad_cnst_get_mode_num_idx use cam_history, only: addfld, add_default, horiz_only, fieldname_len, outfld use cam_abortutils, only: endrun use cam_logfile, only: iulog +use aerosol_properties_mod, only: aerosol_properties +use aerosol_state_mod, only: aerosol_state, ptr2d_t + implicit none private save -public ndrop_init, dropmixnuc, activate_modal, loadaer +public ndrop_init, dropmixnuc, activate_aerosol -real(r8), allocatable :: alogsig(:) ! natl log of geometric standard dev of aerosol -real(r8), allocatable :: exp45logsig(:) -real(r8), allocatable :: f1(:) ! abdul-razzak functions of width -real(r8), allocatable :: f2(:) ! abdul-razzak functions of width +! mathematical constants +real(r8), parameter :: zero = 0._r8 +real(r8), parameter :: third = 1._r8/3._r8 +real(r8), parameter :: twothird = 2._r8*third +real(r8), parameter :: sixth = 1._r8/6._r8 +real(r8), parameter :: sq2 = sqrt(2._r8) +real(r8), parameter :: sq2pi = sqrt(2._r8*pi) +real(r8), parameter :: sqpi = sqrt(pi) +real(r8), parameter :: surften = 0.076_r8 +real(r8), parameter :: tmelt = 273._r8 -real(r8) :: t0 ! reference temperature real(r8) :: aten -real(r8) :: surften ! surface tension of water w/respect to air (N/m) -real(r8) :: alog2, alog3, alogaten -real(r8) :: third, twothird, sixth, zero -real(r8) :: sq2, sqpi ! CCN diagnostic fields integer, parameter :: psat=6 ! number of supersaturations to calc ccn concentration @@ -58,34 +58,13 @@ module ndrop integer :: numliq_idx = -1 integer :: kvh_idx = -1 -! description of modal aerosols -integer :: ntot_amode ! number of aerosol modes -integer, allocatable :: nspec_amode(:) ! number of chemical species in each aerosol mode -real(r8), allocatable :: sigmag_amode(:)! geometric standard deviation for each aerosol mode -real(r8), allocatable :: dgnumlo_amode(:) -real(r8), allocatable :: dgnumhi_amode(:) -real(r8), allocatable :: voltonumblo_amode(:) -real(r8), allocatable :: voltonumbhi_amode(:) - -logical :: history_aerosol ! Output the MAM aerosol tendencies +logical :: history_aerosol ! Output the aerosol tendencies character(len=fieldname_len), allocatable :: fieldname(:) ! names for drop nuc tendency output fields character(len=fieldname_len), allocatable :: fieldname_cw(:) ! names for drop nuc tendency output fields -! local indexing for MAM -integer, allocatable :: mam_idx(:,:) ! table for local indexing of modal aero number and mmr -integer :: ncnst_tot ! total number of mode number conc + mode species - -! Indices for MAM species in the ptend%q array. Needed for prognostic aerosol case. -integer, allocatable :: mam_cnst_idx(:,:) +! Indices for aerosol species in the ptend%q array. +integer, allocatable :: aer_cnst_idx(:,:) - -! ptr2d_t is used to create arrays of pointers to 2D fields -type ptr2d_t - real(r8), pointer :: fld(:,:) -end type ptr2d_t - -! modal aerosols -logical :: prog_modal_aero ! true when modal aerosols are prognostic logical :: lq(pcnst) = .false. ! set flags true for constituents with non-zero tendencies ! in the ptend object @@ -93,10 +72,12 @@ module ndrop contains !=============================================================================== -subroutine ndrop_init +subroutine ndrop_init(aero_props) + + class(aerosol_properties), intent(in) :: aero_props - integer :: ii, l, lptr, m, mm - integer :: nspec_max ! max number of species in a mode + integer :: l, m, mm + integer :: idxtmp = -1 character(len=32) :: tmpname character(len=32) :: tmpname_cw character(len=128) :: long_name @@ -108,99 +89,25 @@ subroutine ndrop_init ! get indices into state%q and pbuf structures call cnst_get_ind('NUMLIQ', numliq_idx) - kvh_idx = pbuf_get_index('kvh') + kvh_idx = pbuf_get_index('kvh') - zero = 0._r8 - third = 1._r8/3._r8 - twothird = 2._r8*third - sixth = 1._r8/6._r8 - sq2 = sqrt(2._r8) - sqpi = sqrt(pi) - - t0 = 273._r8 - surften = 0.076_r8 - aten = 2._r8*mwh2o*surften/(r_universal*t0*rhoh2o) - alogaten = log(aten) - alog2 = log(2._r8) - alog3 = log(3._r8) - - ! get info about the modal aerosols - ! get ntot_amode - call rad_cnst_get_info(0, nmodes=ntot_amode) - - allocate( & - nspec_amode(ntot_amode), & - sigmag_amode(ntot_amode), & - dgnumlo_amode(ntot_amode), & - dgnumhi_amode(ntot_amode), & - alogsig(ntot_amode), & - exp45logsig(ntot_amode), & - f1(ntot_amode), & - f2(ntot_amode), & - voltonumblo_amode(ntot_amode), & - voltonumbhi_amode(ntot_amode) ) - - do m = 1, ntot_amode - ! use only if width of size distribution is prescribed - - ! get mode info - call rad_cnst_get_info(0, m, nspec=nspec_amode(m)) - - ! get mode properties - call rad_cnst_get_mode_props(0, m, sigmag=sigmag_amode(m), & - dgnumhi=dgnumhi_amode(m), dgnumlo=dgnumlo_amode(m)) - - alogsig(m) = log(sigmag_amode(m)) - exp45logsig(m) = exp(4.5_r8*alogsig(m)*alogsig(m)) - f1(m) = 0.5_r8*exp(2.5_r8*alogsig(m)*alogsig(m)) - f2(m) = 1._r8 + 0.25_r8*alogsig(m) - - voltonumblo_amode(m) = 1._r8 / ( (pi/6._r8)* & - (dgnumlo_amode(m)**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) ) - voltonumbhi_amode(m) = 1._r8 / ( (pi/6._r8)* & - (dgnumhi_amode(m)**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) ) - end do - - ! Init the table for local indexing of mam number conc and mmr. - ! This table uses species index 0 for the number conc. - - ! Find max number of species in all the modes, and the total - ! number of mode number concentrations + mode species - nspec_max = nspec_amode(1) - ncnst_tot = nspec_amode(1) + 1 - do m = 2, ntot_amode - nspec_max = max(nspec_max, nspec_amode(m)) - ncnst_tot = ncnst_tot + nspec_amode(m) + 1 - end do + aten = 2._r8*mwh2o*surften/(r_universal*tmelt*rhoh2o) allocate( & - mam_idx(ntot_amode,0:nspec_max), & - mam_cnst_idx(ntot_amode,0:nspec_max), & - fieldname(ncnst_tot), & - fieldname_cw(ncnst_tot) ) - - ! Local indexing compresses the mode and number/mass indicies into one index. - ! This indexing is used by the pointer arrays used to reference state and pbuf - ! fields. - ii = 0 - do m = 1, ntot_amode - do l = 0, nspec_amode(m) - ii = ii + 1 - mam_idx(m,l) = ii - end do - end do + aer_cnst_idx(aero_props%nbins(),0:maxval(aero_props%nmasses())), & + fieldname(aero_props%ncnst_tot()), & + fieldname_cw(aero_props%ncnst_tot()) ) ! Add dropmixnuc tendencies for all modal aerosol species call phys_getopts(history_amwg_out = history_amwg, & - history_aerosol_out = history_aerosol, & - prog_modal_aero_out=prog_modal_aero) + history_aerosol_out = history_aerosol) - do m = 1, ntot_amode - do l = 0, nspec_amode(m) ! loop over number + chem constituents + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) - mm = mam_idx(m,l) + mm = aero_props%indexer(m,l) unit = 'kg/m2/s' if (l == 0) then ! number @@ -208,88 +115,65 @@ subroutine ndrop_init end if if (l == 0) then ! number - call rad_cnst_get_info(0, m, num_name=tmpname, num_name_cw=tmpname_cw) + call aero_props%num_names( m, tmpname, tmpname_cw) else - call rad_cnst_get_info(0, m, l, spec_name=tmpname, spec_name_cw=tmpname_cw) + call aero_props%mmr_names( m,l, tmpname, tmpname_cw) end if fieldname(mm) = trim(tmpname) // '_mixnuc1' fieldname_cw(mm) = trim(tmpname_cw) // '_mixnuc1' - if (prog_modal_aero) then - - ! To set tendencies in the ptend object need to get the constituent indices - ! for the prognostic species - if (l == 0) then ! number - call rad_cnst_get_mode_num_idx(m, lptr) - else - call rad_cnst_get_mam_mmr_idx(m, l, lptr) - end if - mam_cnst_idx(m,l) = lptr - lq(lptr) = .true. + ! To set tendencies in the ptend object need to get the constituent indices + ! for the prognostic species - ! Add tendency fields to the history only when prognostic MAM is enabled. - long_name = trim(tmpname) // ' dropmixnuc mixnuc column tendency' - call addfld(fieldname(mm), horiz_only, 'A', unit, long_name) + call cnst_get_ind(tmpname, idxtmp, abort=.false.) + aer_cnst_idx(m,l) = idxtmp - long_name = trim(tmpname_cw) // ' dropmixnuc mixnuc column tendency' - call addfld(fieldname_cw(mm), horiz_only, 'A', unit, long_name) - - if (history_aerosol) then - call add_default(fieldname(mm), 1, ' ') - call add_default(fieldname_cw(mm), 1, ' ') - end if + if (idxtmp>0) then + lq(idxtmp) = .true. + end if + ! Add tendency fields to the history only when prognostic MAM is enabled. + long_name = trim(tmpname) // ' dropmixnuc mixnuc column tendency' + call addfld(fieldname(mm), horiz_only, 'A', unit, long_name, sampled_on_subcycle=.true.) + long_name = trim(tmpname_cw) // ' dropmixnuc mixnuc column tendency' + call addfld(fieldname_cw(mm), horiz_only, 'A', unit, long_name, sampled_on_subcycle=.true.) + if (history_aerosol) then + call add_default(fieldname(mm), 1, ' ') + call add_default(fieldname_cw(mm), 1, ' ') end if - + end do end do - call addfld('CCN1',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.02%') - call addfld('CCN2',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.05%') - call addfld('CCN3',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.1%') - call addfld('CCN4',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.2%') - call addfld('CCN5',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.5%') - call addfld('CCN6',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=1.0%') + call addfld('CCN1',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.02%', sampled_on_subcycle=.true.) + call addfld('CCN2',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.05%', sampled_on_subcycle=.true.) + call addfld('CCN3',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.1%', sampled_on_subcycle=.true.) + call addfld('CCN4',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.2%', sampled_on_subcycle=.true.) + call addfld('CCN5',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.5%', sampled_on_subcycle=.true.) + call addfld('CCN6',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=1.0%', sampled_on_subcycle=.true.) - call addfld('WTKE', (/ 'lev' /), 'A', 'm/s', 'Standard deviation of updraft velocity') - call addfld('NDROPMIX', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number mixing') - call addfld('NDROPSRC', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number source') - call addfld('NDROPSNK', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number loss by microphysics') - call addfld('NDROPCOL', horiz_only, 'A', '#/m2', 'Column droplet number') + call addfld('WTKE', (/ 'lev' /), 'A', 'm/s', 'Standard deviation of updraft velocity', sampled_on_subcycle=.true.) + call addfld('NDROPMIX', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number mixing', sampled_on_subcycle=.true.) + call addfld('NDROPSRC', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number source', sampled_on_subcycle=.true.) + call addfld('NDROPSNK', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number loss by microphysics', sampled_on_subcycle=.true.) + call addfld('NDROPCOL', horiz_only, 'A', '#/m2', 'Column droplet number', sampled_on_subcycle=.true.) - ! set the add_default fields + ! set the add_default fields if (history_amwg) then call add_default('CCN3', 1, ' ') endif - if (history_aerosol .and. prog_modal_aero) then - do m = 1, ntot_amode - do l = 0, nspec_amode(m) ! loop over number + chem constituents - mm = mam_idx(m,l) - if (l == 0) then ! number - call rad_cnst_get_info(0, m, num_name=tmpname, num_name_cw=tmpname_cw) - else - call rad_cnst_get_info(0, m, l, spec_name=tmpname, spec_name_cw=tmpname_cw) - end if - fieldname(mm) = trim(tmpname) // '_mixnuc1' - fieldname_cw(mm) = trim(tmpname_cw) // '_mixnuc1' - end do - end do - endif - - - end subroutine ndrop_init !=============================================================================== -subroutine dropmixnuc( & - state, ptend, dtmicro, pbuf, wsub, & - cldn, cldo, cldliqf, tendnd, factnum, from_spcam) +subroutine dropmixnuc( aero_props, aero_state, & + state, ptend, dtmicro, pbuf, wsub, wmixmin, & + cldn, cldo, cldliqf, tendnd, factnum) ! vertical diffusion and nucleation of cloud droplets ! assume cloud presence controlled by cloud fraction @@ -299,15 +183,18 @@ subroutine dropmixnuc( & type(physics_state), target, intent(in) :: state type(physics_ptend), intent(out) :: ptend real(r8), intent(in) :: dtmicro ! time step for microphysics (s) + real(r8), intent(in) :: wmixmin ! minimum turbulence vertical velocity (m/s) type(physics_buffer_desc), pointer :: pbuf(:) + class(aerosol_properties), intent(in) :: aero_props + class(aerosol_state), intent(in) :: aero_state + ! arguments real(r8), intent(in) :: wsub(pcols,pver) ! subgrid vertical velocity real(r8), intent(in) :: cldn(pcols,pver) ! cloud fraction real(r8), intent(in) :: cldo(pcols,pver) ! cloud fraction on previous time step real(r8), intent(in) :: cldliqf(pcols,pver) ! liquid cloud fraction (liquid / (liquid + ice)) - logical, intent(in),optional :: from_spcam ! value insignificant - if variable present, is called from spcam ! output arguments real(r8), intent(out) :: tendnd(pcols,pver) ! change in droplet number concentration (#/kg/s) @@ -316,10 +203,11 @@ subroutine dropmixnuc( & integer :: lchnk ! chunk identifier integer :: ncol ! number of columns + integer :: nbin ! number of modes/bins + integer :: nele_tot ! total number of aerosol elements real(r8), pointer :: ncldwtr(:,:) ! droplet number concentration (#/kg) real(r8), pointer :: temp(:,:) ! temperature (K) - real(r8), pointer :: omega(:,:) ! vertical velocity (Pa/s) real(r8), pointer :: pmid(:,:) ! mid-level pressure (Pa) real(r8), pointer :: pint(:,:) ! pressure at layer interfaces (Pa) real(r8), pointer :: pdel(:,:) ! pressure thickess of layer (Pa) @@ -333,11 +221,7 @@ subroutine dropmixnuc( & real(r8) :: raertend(pver) ! tendency of aerosol mass, number mixing ratios real(r8) :: qqcwtend(pver) ! tendency of cloudborne aerosol mass, number mixing ratios - real(r8), parameter :: zkmin = 0.01_r8, zkmax = 100._r8 - real(r8), parameter :: wmixmin = 0.1_r8 ! minimum turbulence vertical velocity (m/s) - real(r8) :: sq2pi - integer :: i, k, l, m, mm, n integer :: km1, kp1 integer :: nnew, nsav, ntemp @@ -387,7 +271,6 @@ subroutine dropmixnuc( & real(r8) :: ndropcol(pcols) ! column droplet number (#/m2) real(r8) :: cldo_tmp, cldn_tmp real(r8) :: tau_cld_regenerate - real(r8) :: zeroaer(pver) real(r8) :: taumix_internal_pver_inv ! 1/(internal mixing time scale for k=pver) (1/s) @@ -411,7 +294,7 @@ subroutine dropmixnuc( & real(r8), allocatable :: fluxn(:) ! number activation fraction flux (cm/s) real(r8), allocatable :: fluxm(:) ! mass activation fraction flux (cm/s) real(r8) :: flux_fullact(pver) ! 100% activation fraction flux (cm/s) - ! note: activation fraction fluxes are defined as + ! note: activation fraction fluxes are defined as ! fluxn = [flux of activated aero. number into cloud (#/cm2/s)] ! / [aero. number conc. in updraft, just below cloudbase (#/cm3)] @@ -427,17 +310,17 @@ subroutine dropmixnuc( & real(r8) :: zerogas(pver) character*200 fieldnamegas - logical :: called_from_spcam + integer :: errnum + character(len=shr_kind_cs) :: errstr !------------------------------------------------------------------------------- - sq2pi = sqrt(2._r8*pi) - lchnk = state%lchnk ncol = state%ncol + nbin = aero_props%nbins() + nele_tot = aero_props%ncnst_tot() ncldwtr => state%q(:,:,numliq_idx) temp => state%t - omega => state%omega pmid => state%pmid pint => state%pint pdel => state%pdel @@ -469,53 +352,35 @@ subroutine dropmixnuc( & dtinv = 1._r8/dtmicro allocate( & - nact(pver,ntot_amode), & - mact(pver,ntot_amode), & - raer(ncnst_tot), & - qqcw(ncnst_tot), & - raercol(pver,ncnst_tot,2), & - raercol_cw(pver,ncnst_tot,2), & - coltend(pcols,ncnst_tot), & - coltend_cw(pcols,ncnst_tot), & - naermod(ntot_amode), & - hygro(ntot_amode), & - vaerosol(ntot_amode), & - fn(ntot_amode), & - fm(ntot_amode), & - fluxn(ntot_amode), & - fluxm(ntot_amode) ) - - ! Init pointers to mode number and specie mass mixing ratios in + nact(pver,nbin), & + mact(pver,nbin), & + raer(nele_tot), & + qqcw(nele_tot), & + raercol(pver,nele_tot,2), & + raercol_cw(pver,nele_tot,2), & + coltend(pcols,nele_tot), & + coltend_cw(pcols,nele_tot), & + naermod(nbin), & + hygro(nbin), & + vaerosol(nbin), & + fn(nbin), & + fm(nbin), & + fluxn(nbin), & + fluxm(nbin) ) + + ! Init pointers to mode number and specie mass mixing ratios in ! intersitial and cloud borne phases. - do m = 1, ntot_amode - mm = mam_idx(m, 0) - call rad_cnst_get_mode_num(0, m, 'a', state, pbuf, raer(mm)%fld) - call rad_cnst_get_mode_num(0, m, 'c', state, pbuf, qqcw(mm)%fld) ! cloud-borne aerosol - do l = 1, nspec_amode(m) - mm = mam_idx(m, l) - call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, raer(mm)%fld) - call rad_cnst_get_aer_mmr(0, m, l, 'c', state, pbuf, qqcw(mm)%fld) ! cloud-borne aerosol - end do - end do - - called_from_spcam = (present(from_spcam)) - - if (called_from_spcam) then - rgas => state%q - allocate(rgascol(pver, pcnst, 2)) - allocate(coltendgas(pcols)) - endif + call aero_state%get_states( aero_props, raer, qqcw ) factnum = 0._r8 wtke = 0._r8 + nsource = 0._r8 + ndropmix = 0._r8 + ndropcol = 0._r8 + tendnd = 0._r8 - if (prog_modal_aero) then - ! aerosol tendencies - call physics_ptend_init(ptend, state%psetcols, 'ndrop', lq=lq) - else - ! no aerosol tendencies - call physics_ptend_init(ptend, state%psetcols, 'ndrop') - end if + ! initialize aerosol tendencies + call physics_ptend_init(ptend, state%psetcols, 'ndrop', lq=lq) ! overall_main_i_loop do i = 1, ncol @@ -535,7 +400,7 @@ subroutine dropmixnuc( & cs(i,k) = pmid(i,k)/(rair*temp(i,k)) ! air density (kg/m3) dz(i,k) = 1._r8/(cs(i,k)*gravit*rpdel(i,k)) ! layer thickness in m - do m = 1, ntot_amode + do m = 1, nbin nact(k,m) = 0._r8 mact(k,m) = 0._r8 end do @@ -567,44 +432,19 @@ subroutine dropmixnuc( & nsav = 1 nnew = 2 - do m = 1, ntot_amode - mm = mam_idx(m,0) + + do mm = 1,nele_tot raercol_cw(:,mm,nsav) = 0.0_r8 raercol(:,mm,nsav) = 0.0_r8 raercol_cw(top_lev:pver,mm,nsav) = qqcw(mm)%fld(i,top_lev:pver) raercol(top_lev:pver,mm,nsav) = raer(mm)%fld(i,top_lev:pver) - do l = 1, nspec_amode(m) - mm = mam_idx(m,l) - raercol_cw(top_lev:pver,mm,nsav) = qqcw(mm)%fld(i,top_lev:pver) - raercol(top_lev:pver,mm,nsav) = raer(mm)%fld(i,top_lev:pver) - end do end do - - if (called_from_spcam) then - ! - ! In the MMF model, turbulent mixing for tracer species are turned off. - ! So the turbulent for gas species mixing are added here. - ! (Previously, it had the turbulent mixing for aerosol species) - ! - do m=1, pcnst - if (cnst_species_class(m) == cnst_spec_class_gas) rgascol(:,m,nsav) = rgas(i,:,m) - end do - - endif - ! droplet nucleation/aerosol activation - ! tau_cld_regenerate = time scale for regeneration of cloudy air + ! tau_cld_regenerate = time scale for regeneration of cloudy air ! by (horizontal) exchange with clear air - tau_cld_regenerate = 3600.0_r8 * 3.0_r8 - - if (called_from_spcam) then - ! when this is called in the MMF part, no cloud regeneration and decay. - ! set the time scale be very long so that no cloud regeneration. - tau_cld_regenerate = 3600.0_r8 * 24.0_r8 * 365.0_r8 - endif - + tau_cld_regenerate = 3600.0_r8 * 3.0_r8 ! k-loop for growing/shrinking cloud calcs ............................. ! grow_shrink_main_k_loop: & @@ -628,18 +468,12 @@ subroutine dropmixnuc( & ! convert activated aerosol to interstitial in decaying cloud dumc = (cldn_tmp - cldo_tmp)/cldo_tmp * (1._r8 - cldliqf(i,k)) - do m = 1, ntot_amode - mm = mam_idx(m,0) + do mm = 1,nele_tot dact = raercol_cw(k,mm,nsav)*dumc raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact - do l = 1, nspec_amode(m) - mm = mam_idx(m,l) - dact = raercol_cw(k,mm,nsav)*dumc - raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol - raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact - end do end do + end if ! shrinking liquid cloud ...................................................... @@ -650,7 +484,7 @@ subroutine dropmixnuc( & ! alternate formulation ! cldn_tmp = cldn(i,k) * max( 0.0_r8, (1.0_r8-dtmicro/tau_cld_regenerate) ) - ! fraction is also provided. + ! fraction is also provided. if (cldn_tmp < cldo_tmp) then ! droplet loss in decaying cloud !++ sungsup @@ -661,23 +495,17 @@ subroutine dropmixnuc( & ! convert activated aerosol to interstitial in decaying cloud dumc = (cldn_tmp - cldo_tmp)/cldo_tmp * cldliqf(i,k) - do m = 1, ntot_amode - mm = mam_idx(m,0) + do mm = 1,nele_tot dact = raercol_cw(k,mm,nsav)*dumc raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact - do l = 1, nspec_amode(m) - mm = mam_idx(m,l) - dact = raercol_cw(k,mm,nsav)*dumc - raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol - raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact - end do end do + end if ! growing liquid cloud ...................................................... ! treat the increase of cloud fraction from when cldn(i,k) > cldo(i,k) - ! and also regenerate part of the cloud + ! and also regenerate part of the cloud cldo_tmp = cldn_tmp cldn_tmp = lcldn(i,k) @@ -693,40 +521,45 @@ subroutine dropmixnuc( & ! load aerosol properties, assuming external mixtures phase = 1 ! interstitial - do m = 1, ntot_amode - call loadaer( & - state, pbuf, i, i, k, & + do m = 1, nbin + call aero_state%loadaer( aero_props, & + i, i, k, & m, cs, phase, na, va, & - hy) + hy, errnum, errstr) + if (errnum/=0) then + call endrun('dropmixnuc : '//trim(errstr)) + end if naermod(m) = na(i) vaerosol(m) = va(i) hygro(m) = hy(i) end do - call activate_modal( & + call activate_aerosol( & wbar, wmix, wdiab, wmin, wmax, & - temp(i,k), cs(i,k), naermod, ntot_amode, & - vaerosol, hygro, fn, fm, fluxn, & + temp(i,k), cs(i,k), naermod, nbin, & + vaerosol, hygro, aero_props, fn, fm, fluxn, & fluxm,flux_fullact(k)) factnum(i,k,:) = fn dumc = (cldn_tmp - cldo_tmp) - do m = 1, ntot_amode - mm = mam_idx(m,0) + + do m = 1, nbin + mm = aero_props%indexer(m,0) dact = dumc*fn(m)*raer(mm)%fld(i,k) ! interstitial only qcld(k) = qcld(k) + dact nsource(i,k) = nsource(i,k) + dact*dtinv raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact dum = dumc*fm(m) - do l = 1, nspec_amode(m) - mm = mam_idx(m,l) + do l = 1,aero_props%nmasses(m) + mm = aero_props%indexer(m,l) dact = dum*raer(mm)%fld(i,k) ! interstitial only raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact enddo enddo + endif enddo ! grow_shrink_main_k_loop @@ -777,22 +610,25 @@ subroutine dropmixnuc( & wmin = wbar + wmix*0.25_r8*sq2pi*log(alogarg) phase = 1 ! interstitial - do m = 1, ntot_amode - ! rce-comment - use kp1 here as old-cloud activation involves + do m = 1, nbin + ! rce-comment - use kp1 here as old-cloud activation involves ! aerosol from layer below - call loadaer( & - state, pbuf, i, i, kp1, & + call aero_state%loadaer( aero_props, & + i, i, kp1, & m, cs, phase, na, va, & - hy) + hy, errnum, errstr) + if (errnum/=0) then + call endrun('dropmixnuc : '//trim(errstr)) + end if naermod(m) = na(i) vaerosol(m) = va(i) hygro(m) = hy(i) end do - call activate_modal( & + call activate_aerosol( & wbar, wmix, wdiab, wmin, wmax, & - temp(i,k), cs(i,k), naermod, ntot_amode, & - vaerosol, hygro, fn, fm, fluxn, & + temp(i,k), cs(i,k), naermod, nbin, & + vaerosol, hygro, aero_props, fn, fm, fluxn, & fluxm, flux_fullact(k)) factnum(i,k,:) = fn @@ -817,14 +653,14 @@ subroutine dropmixnuc( & ! rce-comment 2 ! code for k=pver was changed to use the following conceptual model ! in k=pver, there can be no cloud-base activation unless one considers - ! a scenario such as the layer being partially cloudy, + ! a scenario such as the layer being partially cloudy, ! with clear air at bottom and cloudy air at top - ! assume this scenario, and that the clear/cloudy portions mix with + ! assume this scenario, and that the clear/cloudy portions mix with ! a timescale taumix_internal = dz(i,pver)/wtke_cen(i,pver) - ! in the absence of other sources/sinks, qact (the activated particle + ! in the absence of other sources/sinks, qact (the activated particle ! mixratio) attains a steady state value given by ! qact_ss = fcloud*fact*qtot - ! where fcloud is cloud fraction, fact is activation fraction, + ! where fcloud is cloud fraction, fact is activation fraction, ! qtot=qact+qint, qint is interstitial particle mixratio ! the activation rate (from mixing within the layer) can now be ! written as @@ -834,8 +670,8 @@ subroutine dropmixnuc( & ! also, d(qact)/dt can be negative. in the code below ! it is forced to be >= 0 ! - ! steve -- - ! you will likely want to change this. i did not really understand + ! steve -- + ! you will likely want to change this. i did not really understand ! what was previously being done in k=pver ! in the cam3_5_3 code, wtke(i,pver) appears to be equal to the ! droplet deposition velocity which is quite small @@ -846,8 +682,8 @@ subroutine dropmixnuc( & taumix_internal_pver_inv = flux_fullact(k)/dz(i,k) end if - do m = 1, ntot_amode - mm = mam_idx(m,0) + do m = 1, nbin + mm = aero_props%indexer(m,0) fluxn(m) = fluxn(m)*dumc fluxm(m) = fluxm(m)*dumc nact(k,m) = nact(k,m) + fluxn(m)*dum @@ -879,17 +715,11 @@ subroutine dropmixnuc( & ! convert activated aerosol to interstitial in decaying cloud - do m = 1, ntot_amode - mm = mam_idx(m,0) + do mm = 1,nele_tot raercol(k,mm,nsav) = raercol(k,mm,nsav) + raercol_cw(k,mm,nsav) ! cloud-borne aerosol raercol_cw(k,mm,nsav) = 0._r8 - - do l = 1, nspec_amode(m) - mm = mam_idx(m,l) - raercol(k,mm,nsav) = raercol(k,mm,nsav) + raercol_cw(k,mm,nsav) ! cloud-borne aerosol - raercol_cw(k,mm,nsav) = 0._r8 - end do end do + end if end if @@ -908,7 +738,7 @@ subroutine dropmixnuc( & do k = top_lev, pver-1 ! rce-comment -- ekd(k) is eddy-diffusivity at k/k+1 interface ! want ekk(k) = ekd(k) * (density at k/k+1 interface) - ! so use pint(i,k+1) as pint is 1:pverp + ! so use pint(i,k+1) as pint is 1:pverp ! ekk(k)=ekd(k)*2.*pint(i,k)/(rair*(temp(i,k)+temp(i,k+1))) ! ekk(k)=ekd(k)*2.*pint(i,k+1)/(rair*(temp(i,k)+temp(i,k+1))) ekk(k) = ekd(k)*csbot(k) @@ -924,10 +754,10 @@ subroutine dropmixnuc( & ! for the layer. for most layers, the activation loss rate ! (for interstitial particles) is accounted for by the loss by ! turb-transfer to the layer above. - ! k=pver is special, and the loss rate for activation within + ! k=pver is special, and the loss rate for activation within ! the layer must be added to tinv. if not, the time step ! can be too big, and explmix can produce negative values. - ! the negative values are reset to zero, resulting in an + ! the negative values are reset to zero, resulting in an ! artificial source. if (k == pver) tinv = tinv + taumix_internal_pver_inv @@ -938,7 +768,7 @@ subroutine dropmixnuc( & end do dtmix = 0.9_r8*dtmin - nsubmix = dtmicro/dtmix + 1 + nsubmix = int(dtmicro/dtmix) + 1 if (nsubmix > 100) then nsubmix_bnd = 100 else @@ -971,7 +801,7 @@ subroutine dropmixnuc( & ! however it might if things are not "just right" in subr activate ! the following is a safety measure to avoid negatives in explmix do k = top_lev, pver-1 - do m = 1, ntot_amode + do m = 1, nbin nact(k,m) = min( nact(k,m), ekkp(k) ) mact(k,m) = min( mact(k,m), ekkp(k) ) end do @@ -987,8 +817,8 @@ subroutine dropmixnuc( & nnew = ntemp srcn(:) = 0.0_r8 - do m = 1, ntot_amode - mm = mam_idx(m,0) + do m = 1, nbin + mm = aero_props%indexer(m,0) ! update droplet source ! rce-comment- activation source in layer k involves particles from k+1 @@ -1011,10 +841,10 @@ subroutine dropmixnuc( & ! of a layer, and generally higher in the clear portion. (we have/had ! a method for diagnosing the the clear/cloudy mixratios.) the activation ! source terms involve clear air (from below) moving into cloudy air (above). - ! in theory, the clear-portion mixratio should be used when calculating + ! in theory, the clear-portion mixratio should be used when calculating ! source terms - do m = 1, ntot_amode - mm = mam_idx(m,0) + do m = 1, nbin + mm = aero_props%indexer(m,0) ! rce-comment - activation source in layer k involves particles from k+1 ! source(:)= nact(:,m)*(raercol(:,mm,nsav)) source(top_lev:pver-1) = nact(top_lev:pver-1,m)*(raercol(top_lev+1:pver,mm,nsav)) @@ -1026,17 +856,17 @@ subroutine dropmixnuc( & flxconv = 0._r8 call explmix( & - raercol_cw(:,mm,nnew), source, ekkp, ekkm, overlapp, & - overlapm, raercol_cw(:,mm,nsav), zero, zero, pver, & - dtmix, .false.) + raercol_cw(:,mm,nnew), source, ekkp, ekkm, overlapp, & + overlapm, raercol_cw(:,mm,nsav), zero, zero, pver, & + dtmix, .false.) call explmix( & - raercol(:,mm,nnew), source, ekkp, ekkm, overlapp, & - overlapm, raercol(:,mm,nsav), zero, flxconv, pver, & - dtmix, .true., raercol_cw(:,mm,nsav)) + raercol(:,mm,nnew), source, ekkp, ekkm, overlapp, & + overlapm, raercol(:,mm,nsav), zero, flxconv, pver, & + dtmix, .true., raercol_cw(:,mm,nsav)) - do l = 1, nspec_amode(m) - mm = mam_idx(m,l) + do l = 1,aero_props%nmasses(m) + mm = aero_props%indexer(m,l) ! rce-comment - activation source in layer k involves particles from k+1 ! source(:)= mact(:,m)*(raercol(:,mm,nsav)) source(top_lev:pver-1) = mact(top_lev:pver-1,m)*(raercol(top_lev+1:pver,mm,nsav)) @@ -1048,33 +878,18 @@ subroutine dropmixnuc( & flxconv = 0._r8 call explmix( & - raercol_cw(:,mm,nnew), source, ekkp, ekkm, overlapp, & - overlapm, raercol_cw(:,mm,nsav), zero, zero, pver, & - dtmix, .false.) + raercol_cw(:,mm,nnew), source, ekkp, ekkm, overlapp, & + overlapm, raercol_cw(:,mm,nsav), zero, zero, pver, & + dtmix, .false.) call explmix( & - raercol(:,mm,nnew), source, ekkp, ekkm, overlapp, & - overlapm, raercol(:,mm,nsav), zero, flxconv, pver, & - dtmix, .true., raercol_cw(:,mm,nsav)) + raercol(:,mm,nnew), source, ekkp, ekkm, overlapp, & + overlapm, raercol(:,mm,nsav), zero, flxconv, pver, & + dtmix, .true., raercol_cw(:,mm,nsav)) end do end do - if (called_from_spcam) then - ! - ! turbulent mixing for gas species . - ! - do m=1, pcnst - if (cnst_species_class(m) == cnst_spec_class_gas) then - flxconv = 0.0_r8 - zerogas(:) = 0.0_r8 - call explmix(rgascol(1,m,nnew),zerogas,ekkp,ekkm,overlapp,overlapm, & - rgascol(1,m,nsav),zero, flxconv, pver,dtmix,& - .true., zerogas) - end if - end do - endif - end do ! old_cloud_nsubmix_loop ! evaporate particles again if no cloud (either ice or liquid) @@ -1085,17 +900,11 @@ subroutine dropmixnuc( & qcld(k)=0._r8 ! convert activated aerosol to interstitial in decaying cloud - do m = 1, ntot_amode - mm = mam_idx(m,0) + do mm = 1,nele_tot raercol(k,mm,nnew) = raercol(k,mm,nnew) + raercol_cw(k,mm,nnew) raercol_cw(k,mm,nnew) = 0._r8 - - do l = 1, nspec_amode(m) - mm = mam_idx(m,l) - raercol(k,mm,nnew) = raercol(k,mm,nnew) + raercol_cw(k,mm,nnew) - raercol_cw(k,mm,nnew) = 0._r8 - end do end do + end if end do @@ -1109,43 +918,35 @@ subroutine dropmixnuc( & end do ndropcol(i) = ndropcol(i)/gravit - if (prog_modal_aero) then - - raertend = 0._r8 - qqcwtend = 0._r8 + raertend = 0._r8 + qqcwtend = 0._r8 - do m = 1, ntot_amode - do l = 0, nspec_amode(m) + do m = 1, nbin + do l = 0, aero_props%nmasses(m) - mm = mam_idx(m,l) - lptr = mam_cnst_idx(m,l) + mm = aero_props%indexer(m,l) + lptr = aer_cnst_idx(m,l) - raertend(top_lev:pver) = (raercol(top_lev:pver,mm,nnew) - raer(mm)%fld(i,top_lev:pver))*dtinv - qqcwtend(top_lev:pver) = (raercol_cw(top_lev:pver,mm,nnew) - qqcw(mm)%fld(i,top_lev:pver))*dtinv + raertend(top_lev:pver) = (raercol(top_lev:pver,mm,nnew) - raer(mm)%fld(i,top_lev:pver))*dtinv + qqcwtend(top_lev:pver) = (raercol_cw(top_lev:pver,mm,nnew) - qqcw(mm)%fld(i,top_lev:pver))*dtinv - coltend(i,mm) = sum( pdel(i,:)*raertend )/gravit - coltend_cw(i,mm) = sum( pdel(i,:)*qqcwtend )/gravit + coltend(i,mm) = sum( pdel(i,:)*raertend )/gravit + coltend_cw(i,mm) = sum( pdel(i,:)*qqcwtend )/gravit + ! check for advected aerosol constituents + if (lptr>0) then ! advected aerosol parts ptend%q(i,:,lptr) = 0.0_r8 - ptend%q(i,top_lev:pver,lptr) = raertend(top_lev:pver) ! set tendencies for interstitial aerosol - qqcw(mm)%fld(i,:) = 0.0_r8 - qqcw(mm)%fld(i,top_lev:pver) = raercol_cw(top_lev:pver,mm,nnew) ! update cloud-borne aerosol - end do - end do + ptend%q(i,top_lev:pver,lptr) = raertend(top_lev:pver) ! set tendencies for interstitial aerosol + else + raer(mm)%fld(i,:) = 0.0_r8 + raer(mm)%fld(i,top_lev:pver) = raercol(top_lev:pver,mm,nnew) ! update non-advected interstitial aerosol (pbuf) + end if - end if + qqcw(mm)%fld(i,:) = 0.0_r8 + qqcw(mm)%fld(i,top_lev:pver) = raercol_cw(top_lev:pver,mm,nnew) ! update cloud-borne aerosol - if (called_from_spcam) then - ! - ! Gas tendency - ! - do m=1, pcnst - if (cnst_species_class(m) == cnst_spec_class_gas) then - ptend%lq(m) = .true. - ptend%q(i, :, m) = (rgascol(:,m,nnew)-rgas(i,:,m)) * dtinv - end if - end do - endif + end do + end do end do ! overall_main_i_loop ! end of main loop over i/longitude .................................... @@ -1155,42 +956,19 @@ subroutine dropmixnuc( & call outfld('NDROPMIX', ndropmix, pcols, lchnk) call outfld('WTKE ', wtke, pcols, lchnk) - if(called_from_spcam) then - call outfld('SPLCLOUD ', cldn , pcols, lchnk ) - call outfld('SPKVH ', kvh , pcols, lchnk ) - endif - - call ccncalc(state, pbuf, cs, ccn) + call ccncalc(aero_state, aero_props, state, cs, ccn) do l = 1, psat call outfld(ccn_name(l), ccn(1,1,l), pcols, lchnk) enddo ! do column tendencies - if (prog_modal_aero) then - do m = 1, ntot_amode - do l = 0, nspec_amode(m) - mm = mam_idx(m,l) - call outfld(fieldname(mm), coltend(:,mm), pcols, lchnk) - call outfld(fieldname_cw(mm), coltend_cw(:,mm), pcols, lchnk) - end do + do m = 1, nbin + do l = 0,aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + call outfld(fieldname(mm), coltend(:,mm), pcols, lchnk) + call outfld(fieldname_cw(mm), coltend_cw(:,mm), pcols, lchnk) end do - end if - - if(called_from_spcam) then - ! - ! output column-integrated Gas tendency (this should be zero) - ! - do m=1, pcnst - if (cnst_species_class(m) == cnst_spec_class_gas) then - do i=1, ncol - coltendgas(i) = sum( pdel(i,:)*ptend%q(i,:,m) )/gravit - end do - fieldnamegas = trim(cnst_name(m)) // '_mixnuc1sp' - call outfld( trim(fieldnamegas), coltendgas, pcols, lchnk) - end if - end do - deallocate(rgascol, coltendgas) - end if + end do deallocate( & nact, & @@ -1289,13 +1067,13 @@ end subroutine explmix !=============================================================================== -subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & - na, nmode, volume, hygro, & +subroutine activate_aerosol(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + na, nbins, volume, hygro, aero_props, & fn, fm, fluxn, fluxm, flux_fullact, smax_prescribed, in_cloud_in, smax_f) ! calculates number, surface, and mass fraction of aerosols activated as CCN ! calculates flux of cloud droplets, surface area, and aerosol mass into cloud - ! assumes an internal mixture within each of up to nmode multiple aerosol modes + ! assumes an internal mixture within each of up to nbin multiple aerosol bins ! a gaussiam spectrum of updrafts can be treated. ! mks units @@ -1303,7 +1081,6 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & ! Abdul-Razzak and Ghan, A parameterization of aerosol activation. ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844. - ! input real(r8), intent(in) :: wbar ! grid cell mean vertical velocity (m/s) @@ -1314,10 +1091,12 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & real(r8), intent(in) :: tair ! air temperature (K) real(r8), intent(in) :: rhoair ! air density (kg/m3) real(r8), intent(in) :: na(:) ! aerosol number concentration (/m3) - integer, intent(in) :: nmode ! number of aerosol modes + integer, intent(in) :: nbins ! number of aerosol bins real(r8), intent(in) :: volume(:) ! aerosol volume concentration (m3/m3) real(r8), intent(in) :: hygro(:) ! hygroscopicity of aerosol mode + class(aerosol_properties), intent(in) :: aero_props + ! output real(r8), intent(out) :: fn(:) ! number fraction of aerosols activated @@ -1329,7 +1108,7 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & ! used for consistency check -- this should match (ekd(k)*zs(k)) ! also, fluxm/flux_fullact gives fraction of aerosol mass flux ! that is activated - + ! optional real(r8), optional, intent(in) :: smax_prescribed ! prescribed max. supersaturation for secondary activation logical, optional, intent(in) :: in_cloud_in ! switch to modify calculations when above cloud base @@ -1339,54 +1118,37 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & ! local integer, parameter:: nx=200 - integer iquasisect_option, isectional real(r8) integ,integf real(r8), parameter :: p0 = 1013.25e2_r8 ! reference pressure (Pa) - real(r8) xmin(nmode),xmax(nmode) ! ln(r) at section interfaces - real(r8) volmin(nmode),volmax(nmode) ! volume at interfaces - real(r8) tmass ! total aerosol mass concentration (g/cm3) - real(r8) sign(nmode) ! geometric standard deviation of size distribution - real(r8) rm ! number mode radius of aerosol at max supersat (cm) real(r8) pres ! pressure (Pa) - real(r8) path ! mean free path (m) - real(r8) diff ! diffusivity (m2/s) - real(r8) conduct ! thermal conductivity (Joule/m/sec/deg) real(r8) diff0,conduct0 real(r8) es ! saturation vapor pressure real(r8) qs ! water vapor saturation mixing ratio real(r8) dqsdt ! change in qs with temperature - real(r8) dqsdp ! change in qs with pressure real(r8) g ! thermodynamic function (m2/s) - real(r8) zeta(nmode), eta(nmode) - real(r8) lnsmax ! ln(smax) + real(r8) zeta(nbins), eta(nbins) real(r8) alpha real(r8) gamma real(r8) beta real(r8) sqrtg - real(r8) :: amcube(nmode) ! cube of dry mode radius (m) - real(r8) :: smcrit(nmode) ! critical supersatuation for activation - real(r8) :: lnsm(nmode) ! ln(smcrit) - real(r8) smc(nmode) ! critical supersaturation for number mode radius + real(r8) :: amcube(nbins) ! cube of dry bin radius (m) + real(r8) smc(nbins) ! critical supersaturation for number bin radius real(r8) sumflx_fullact - real(r8) sumflxn(nmode) - real(r8) sumflxm(nmode) - real(r8) sumfn(nmode) - real(r8) sumfm(nmode) - real(r8) fnold(nmode) ! number fraction activated - real(r8) fmold(nmode) ! mass fraction activated + real(r8) sumflxn(nbins) + real(r8) sumflxm(nbins) + real(r8) sumfn(nbins) + real(r8) sumfm(nbins) + real(r8) fnold(nbins) ! number fraction activated + real(r8) fmold(nbins) ! mass fraction activated real(r8) wold,gold - real(r8) alogam - real(r8) rlo,rhi,xint1,xint2,xint3,xint4 real(r8) wmin,wmax,w,dw,dwmax,dwmin,wnuc,dwnew,wb - real(r8) dfmin,dfmax,fnew,fold,fnmin,fnbar,fsbar,fmbar + real(r8) dfmin,dfmax,fnew,fold,fnmin,fnbar,fmbar real(r8) alw,sqrtalw real(r8) smax - real(r8) x,arg - real(r8) xmincoeff,xcut,volcut,surfcut real(r8) z,z1,z2,wf1,wf2,zf1,zf2,gf1,gf2,gf - real(r8) etafactor1,etafactor2(nmode),etafactor2max + real(r8) etafactor1,etafactor2(nbins),etafactor2max real(r8) grow - character(len=*), parameter :: subname='activate_modal' + character(len=*), parameter :: subname='activate_aerosol' logical :: in_cloud integer m,n @@ -1400,7 +1162,7 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & save ndist if (present(in_cloud_in)) then - if (.not. present(smax_f)) call endrun('activate_modal error: smax_f must be supplied when in_cloud is used') + if (.not. present(smax_f)) call endrun(subname//' error: smax_f must be supplied when in_cloud is used') in_cloud = in_cloud_in else in_cloud = .false. @@ -1412,7 +1174,7 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & fluxm(:)=0._r8 flux_fullact=0._r8 - if(nmode.eq.1.and.na(1).lt.1.e-20_r8)return + if(nbins.eq.1.and.na(1).lt.1.e-20_r8)return if(sigw.le.1.e-5_r8.and.wbar.le.0._r8)return @@ -1421,8 +1183,8 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & end if pres=rair*rhoair*tair - diff0=0.211e-4_r8*(p0/pres)*(tair/t0)**1.94_r8 - conduct0=(5.69_r8+0.017_r8*(tair-t0))*4.186e2_r8*1.e-5_r8 ! convert to J/m/s/deg + diff0=0.211e-4_r8*(p0/pres)*(tair/tmelt)**1.94_r8 + conduct0=(5.69_r8+0.017_r8*(tair-tmelt))*4.186e2_r8*1.e-5_r8 ! convert to J/m/s/deg call qsat(tair, pres, es, qs) dqsdt=latvap/(rh2o*tair*tair)*qs alpha=gravit*(latvap/(cpair*rh2o*tair*tair)-1._r8/(rair*tair)) @@ -1434,30 +1196,26 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & sqrtg = sqrt(grow) beta = 2._r8*pi*rhoh2o*grow*gamma - do m=1,nmode + do m=1,nbins if(volume(m).gt.1.e-39_r8.and.na(m).gt.1.e-39_r8)then - ! number mode radius (m) - ! write(iulog,*)'alogsig,volc,na=',alogsig(m),volc(m),na(m) - amcube(m)=(3._r8*volume(m)/(4._r8*pi*exp45logsig(m)*na(m))) ! only if variable size dist - ! growth coefficent Abdul-Razzak & Ghan 1998 eqn 16 - ! should depend on mean radius of mode to account for gas kinetic effects - ! see Fountoukis and Nenes, JGR2005 and Meskhidze et al., JGR2006 - ! for approriate size to use for effective diffusivity. + ! number mode radius (m) + amcube(m)=aero_props%amcube(m, volume(m),na(m)) + ! growth coefficent Abdul-Razzak & Ghan 1998 eqn 16 + ! should depend on mean radius of mode to account for gas kinetic effects + ! see Fountoukis and Nenes, JGR2005 and Meskhidze et al., JGR2006 + ! for approriate size to use for effective diffusivity. etafactor2(m)=1._r8/(na(m)*beta*sqrtg) if(hygro(m).gt.1.e-10_r8)then smc(m)=2._r8*aten*sqrt(aten/(27._r8*hygro(m)*amcube(m))) ! only if variable size dist else smc(m)=100._r8 endif - ! write(iulog,*)'sm,hygro,amcube=',smcrit(m),hygro(m),amcube(m) else smc(m)=1._r8 etafactor2(m)=etafactor2max ! this should make eta big if na is very small. endif - lnsm(m)=log(smc(m)) ! only if variable size dist - ! write(iulog,'(a,i4,4g12.2)')'m,na,amcube,hygro,sm,lnsm=', & - ! m,na(m),amcube(m),hygro(m),sm(m),lnsm(m) + enddo if(sigw.gt.1.e-5_r8)then ! spectrum of updrafts @@ -1471,7 +1229,7 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & dfmax=0.2_r8 dfmin=0.1_r8 if (wmax <= w) return - do m=1,nmode + do m=1,nbins sumflxn(m)=0._r8 sumfn(m)=0._r8 fnold(m)=0._r8 @@ -1494,7 +1252,7 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & sqrtalw=sqrt(alw) etafactor1=alw*sqrtalw - do m=1,nmode + do m=1,nbins eta(m)=etafactor1*etafactor2(m) zeta(m)=twothird*sqrtalw*aten/sqrtg enddo @@ -1502,15 +1260,10 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & if ( present( smax_prescribed ) ) then smax = smax_prescribed else - call maxsat(zeta,eta,nmode,smc,smax) + smax = aero_props%maxsat(zeta,eta,smc) endif - ! write(iulog,*)'w,smax=',w,smax - - lnsmax=log(smax) - - x=twothird*(lnsm(nmode)-lnsmax)/(sq2*alogsig(nmode)) - fnew=0.5_r8*(1._r8-erf(x)) + call aero_props%actfracs( nbins, smc(nbins), smax, fnew, fm(nbins) ) dwnew = dw if(fnew-fold.gt.dfmax.and.n.gt.1)then @@ -1534,18 +1287,14 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & z=(w-wbar)/(sigw*sq2) g=exp(-z*z) fnmin=1._r8 - xmincoeff=alogaten-twothird*(lnsmax-alog2)-alog3 - do m=1,nmode + do m=1,nbins ! modal - x=twothird*(lnsm(m)-lnsmax)/(sq2*alogsig(m)) - fn(m)=0.5_r8*(1._r8-erf(x)) + call aero_props%actfracs( m, smc(m), smax, fn(m), fm(m) ) fnmin=min(fn(m),fnmin) ! integration is second order accurate ! assumes linear variation of f*g with w fnbar=(fn(m)*g+fnold(m)*gold) - arg=x-1.5_r8*sq2*alogsig(m) - fm(m)=0.5_r8*(1._r8-erf(arg)) fmbar=(fm(m)*g+fmold(m)*gold) wb=(w+wold) if(w.gt.0._r8)then @@ -1555,7 +1304,6 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & +(fm(m)*g*w+fmold(m)*gold*wold))*dw endif sumfn(m)=sumfn(m)+0.5_r8*fnbar*dw - ! write(iulog,'(a,9g10.2)')'lnsmax,lnsm(m),x,fn(m),fnold(m),g,gold,fnbar,dw=',lnsmax,lnsm(m),x,fn(m),fnold(m),g,gold,fnbar,dw fnold(m)=fn(m) sumfm(m)=sumfm(m)+0.5_r8*fmbar*dw fmold(m)=fm(m) @@ -1563,7 +1311,6 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & ! same form as sumflxm but replace the fm with 1.0 sumflx_fullact = sumflx_fullact & + sixth*(wb*(g+gold) + (g*w+gold*wold))*dw - ! sumg=sumg+0.5_r8*(g+gold)*dw gold=g wold=w dw=dwnew @@ -1574,15 +1321,15 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & write(iulog,*)'wmin=',wmin,' w=',w,' wmax=',wmax,' dw=',dw write(iulog,*)'wbar=',wbar,' sigw=',sigw,' wdiab=',wdiab write(iulog,*)'wnuc=',wnuc - write(iulog,*)'na=',(na(m),m=1,nmode) - write(iulog,*)'fn=',(fn(m),m=1,nmode) + write(iulog,*)'na=',(na(m),m=1,nbins) + write(iulog,*)'fn=',(fn(m),m=1,nbins) ! dump all subr parameters to allow testing with standalone code ! (build a driver that will read input and call activate) - write(iulog,*)'wbar,sigw,wdiab,tair,rhoair,nmode=' - write(iulog,*) wbar,sigw,wdiab,tair,rhoair,nmode + write(iulog,*)'wbar,sigw,wdiab,tair,rhoair,nbins=' + write(iulog,*) wbar,sigw,wdiab,tair,rhoair,nbins write(iulog,*)'na=',na - write(iulog,*)'volume=', (volume(m),m=1,nmode) - write(iulog,*)'hydro=' + write(iulog,*)'volume=', (volume(m),m=1,nbins) + write(iulog,*)'hygro=' write(iulog,*) hygro call endrun(subname) end if @@ -1610,7 +1357,7 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & gf=(gf1-gf2) integf=wbar*sigw*0.5_r8*sq2*sqpi*(erf(zf2)-erf(zf1))+sigw*sigw*gf - do m=1,nmode + do m=1,nbins sumflxn(m)=sumflxn(m)+integf*fn(m) sumfn(m)=sumfn(m)+fn(m)*integ sumflxm(m)=sumflxm(m)+integf*fm(m) @@ -1622,7 +1369,7 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & endif - do m=1,nmode + do m=1,nbins fn(m)=sumfn(m)/(sq2*sqpi*sigw) ! fn(m)=sumfn(m)/(sumg) if(fn(m).gt.1.01_r8)then @@ -1650,7 +1397,7 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & if(wnuc.gt.0._r8)then w=wbar - + if(in_cloud) then if (smax_f > 0._r8) then @@ -1664,27 +1411,21 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & sqrtalw = sqrt(alw) etafactor1 = alw*sqrtalw - do m = 1, nmode + do m = 1, nbins eta(m) = etafactor1*etafactor2(m) zeta(m) = twothird*sqrtalw*aten/sqrtg end do if ( present(smax_prescribed) ) then smax = smax_prescribed else - call maxsat(zeta, eta, nmode, smc, smax) + smax = aero_props%maxsat(zeta,eta,smc) end if end if - lnsmax=log(smax) - xmincoeff=alogaten-twothird*(lnsmax-alog2)-alog3 + do m=1,nbins + call aero_props%actfracs( m, smc(m), smax, fn(m), fm(m) ) - do m=1,nmode - ! modal - x=twothird*(lnsm(m)-lnsmax)/(sq2*alogsig(m)) - fn(m)=0.5_r8*(1._r8-erf(x)) - arg=x-1.5_r8*sq2*alogsig(m) - fm(m)=0.5_r8*(1._r8-erf(arg)) if(wbar.gt.0._r8)then fluxn(m)=fn(m)*w fluxm(m)=fm(m)*w @@ -1695,61 +1436,11 @@ subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & endif -end subroutine activate_modal +end subroutine activate_aerosol !=============================================================================== -subroutine maxsat(zeta,eta,nmode,smc,smax) - - ! calculates maximum supersaturation for multiple - ! competing aerosol modes. - - ! Abdul-Razzak and Ghan, A parameterization of aerosol activation. - ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844. - - integer, intent(in) :: nmode ! number of modes - real(r8), intent(in) :: smc(nmode) ! critical supersaturation for number mode radius - real(r8), intent(in) :: zeta(nmode) - real(r8), intent(in) :: eta(nmode) - real(r8), intent(out) :: smax ! maximum supersaturation - integer :: m ! mode index - real(r8) :: sum, g1, g2, g1sqrt, g2sqrt - - do m=1,nmode - if(zeta(m).gt.1.e5_r8*eta(m).or.smc(m)*smc(m).gt.1.e5_r8*eta(m))then - ! weak forcing. essentially none activated - smax=1.e-20_r8 - else - ! significant activation of this mode. calc activation all modes. - exit - endif - ! No significant activation in any mode. Do nothing. - if (m == nmode) return - - enddo - - sum=0.0_r8 - do m=1,nmode - if(eta(m).gt.1.e-20_r8)then - g1=zeta(m)/eta(m) - g1sqrt=sqrt(g1) - g1=g1sqrt*g1 - g2=smc(m)/sqrt(eta(m)+3._r8*zeta(m)) - g2sqrt=sqrt(g2) - g2=g2sqrt*g2 - sum=sum+(f1(m)*g1+f2(m)*g2)/(smc(m)*smc(m)) - else - sum=1.e20_r8 - endif - enddo - - smax=1._r8/sqrt(sum) - -end subroutine maxsat - -!=============================================================================== - -subroutine ccncalc(state, pbuf, cs, ccn) +subroutine ccncalc(aero_state, aero_props, state, cs, ccn) ! calculates number concentration of aerosols activated as CCN at ! supersaturation supersat. @@ -1759,59 +1450,56 @@ subroutine ccncalc(state, pbuf, cs, ccn) ! Ghan et al., Atmos. Res., 1993, 198-221. ! arguments + class(aerosol_state), intent(in) :: aero_state + class(aerosol_properties), intent(in) :: aero_props type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(in) :: cs(pcols,pver) ! air density (kg/m3) real(r8), intent(out) :: ccn(pcols,pver,psat) ! number conc of aerosols activated at supersat (#/m3) ! local - integer :: lchnk ! chunk index integer :: ncol ! number of columns + integer :: nbin ! number of bins real(r8), pointer :: tair(:,:) ! air temperature (K) real(r8) naerosol(pcols) ! interstit+activated aerosol number conc (/m3) real(r8) vaerosol(pcols) ! interstit+activated aerosol volume conc (m3/m3) real(r8) amcube(pcols) - real(r8) super(psat) ! supersaturation - real(r8), allocatable :: amcubecoef(:) real(r8), allocatable :: argfactor(:) - real(r8) :: surften ! surface tension of water w/respect to air (N/m) real(r8) surften_coef real(r8) a(pcols) ! surface tension parameter real(r8) hygro(pcols) ! aerosol hygroscopicity real(r8) sm(pcols) ! critical supersaturation at mode radius real(r8) arg(pcols) - ! mathematical constants - real(r8) twothird,sq2 - integer l,m,n,i,k - real(r8) log,cc - real(r8) smcoefcoef,smcoef(pcols) + integer l,m,i,k, astat + real(r8) smcoef(pcols) integer phase ! phase of aerosol + + integer :: errnum + character(len=shr_kind_cs) :: errstr + + ! mathematical constants + real(r8), parameter :: super(psat) = supersat(:psat)*0.01_r8 + real(r8), parameter :: smcoefcoef = 2._r8/sqrt(27._r8) + !------------------------------------------------------------------------------- - lchnk = state%lchnk + nbin = aero_props%nbins() ncol = state%ncol tair => state%t - allocate( & - amcubecoef(ntot_amode), & - argfactor(ntot_amode) ) + allocate( argfactor(nbin), stat=astat ) + if (astat/=0) then + call endrun('ndrop::ccncalc : not able to allocate argfactor') + end if - super(:)=supersat(:)*0.01_r8 - sq2=sqrt(2._r8) - twothird=2._r8/3._r8 - surften=0.076_r8 surften_coef=2._r8*mwh2o*surften/(r_universal*rhoh2o) - smcoefcoef=2._r8/sqrt(27._r8) - do m=1,ntot_amode - amcubecoef(m)=3._r8/(4._r8*pi*exp45logsig(m)) - argfactor(m)=twothird/(sq2*alogsig(m)) + do m=1,nbin + argfactor(m)=twothird/(sq2*aero_props%alogsig(m)) end do ccn = 0._r8 @@ -1822,17 +1510,20 @@ subroutine ccncalc(state, pbuf, cs, ccn) smcoef(i)=smcoefcoef*a(i)*sqrt(a(i)) end do - do m=1,ntot_amode + do m=1,nbin phase=3 ! interstitial+cloudborne - call loadaer( & - state, pbuf, 1, ncol, k, & + call aero_state%loadaer( aero_props, & + 1, ncol, k, & m, cs, phase, naerosol, vaerosol, & - hygro) + hygro, errnum, errstr) + if (errnum/=0) then + call endrun('ccncalc : '//trim(errstr)) + end if - where(naerosol(:ncol)>1.e-3_r8) - amcube(:ncol)=amcubecoef(m)*vaerosol(:ncol)/naerosol(:ncol) + where(naerosol(:ncol)>1.e-3_r8 .and. hygro(:ncol)>1.e-10_r8) + amcube(:ncol)=aero_props%amcube(m, vaerosol(:ncol), naerosol(:ncol) ) sm(:ncol)=smcoef(:ncol)/sqrt(hygro(:ncol)*amcube(:ncol)) ! critical supersaturation elsewhere sm(:ncol)=1._r8 ! value shouldn't matter much since naerosol is small @@ -1847,123 +1538,9 @@ subroutine ccncalc(state, pbuf, cs, ccn) enddo ccn(:ncol,:,:)=ccn(:ncol,:,:)*1.e-6_r8 ! convert from #/m3 to #/cm3 - deallocate( & - amcubecoef, & - argfactor ) + deallocate( argfactor ) end subroutine ccncalc !=============================================================================== - -subroutine loadaer( & - state, pbuf, istart, istop, k, & - m, cs, phase, naerosol, & - vaerosol, hygro) - - ! return aerosol number, volume concentrations, and bulk hygroscopicity - - ! input arguments - type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - - integer, intent(in) :: istart ! start column index (1 <= istart <= istop <= pcols) - integer, intent(in) :: istop ! stop column index - integer, intent(in) :: m ! mode index - integer, intent(in) :: k ! level index - real(r8), intent(in) :: cs(:,:) ! air density (kg/m3) - integer, intent(in) :: phase ! phase of aerosol: 1 for interstitial, 2 for cloud-borne, 3 for sum - - ! output arguments - real(r8), intent(out) :: naerosol(:) ! number conc (1/m3) - real(r8), intent(out) :: vaerosol(:) ! volume conc (m3/m3) - real(r8), intent(out) :: hygro(:) ! bulk hygroscopicity of mode - - ! internal - integer :: lchnk ! chunk identifier - - real(r8), pointer :: raer(:,:) ! interstitial aerosol mass, number mixing ratios - real(r8), pointer :: qqcw(:,:) ! cloud-borne aerosol mass, number mixing ratios - real(r8) :: specdens, spechygro - - real(r8) :: vol(pcols) ! aerosol volume mixing ratio - integer :: i, l - !------------------------------------------------------------------------------- - - lchnk = state%lchnk - - do i = istart, istop - vaerosol(i) = 0._r8 - hygro(i) = 0._r8 - end do - - do l = 1, nspec_amode(m) - - call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, raer) - call rad_cnst_get_aer_mmr(0, m, l, 'c', state, pbuf, qqcw) - call rad_cnst_get_aer_props(0, m, l, density_aer=specdens, hygro_aer=spechygro) - - if (phase == 3) then - do i = istart, istop - vol(i) = max(raer(i,k) + qqcw(i,k), 0._r8)/specdens - end do - else if (phase == 2) then - do i = istart, istop - vol(i) = max(qqcw(i,k), 0._r8)/specdens - end do - else if (phase == 1) then - do i = istart, istop - vol(i) = max(raer(i,k), 0._r8)/specdens - end do - else - write(iulog,*)'phase=',phase,' in loadaer' - call endrun('phase error in loadaer') - end if - - do i = istart, istop - vaerosol(i) = vaerosol(i) + vol(i) - hygro(i) = hygro(i) + vol(i)*spechygro - end do - - end do - - do i = istart, istop - if (vaerosol(i) > 1.0e-30_r8) then ! +++xl add 8/2/2007 - hygro(i) = hygro(i)/(vaerosol(i)) - vaerosol(i) = vaerosol(i)*cs(i,k) - else - hygro(i) = 0.0_r8 - vaerosol(i) = 0.0_r8 - end if - end do - - ! aerosol number - call rad_cnst_get_mode_num(0, m, 'a', state, pbuf, raer) - call rad_cnst_get_mode_num(0, m, 'c', state, pbuf, qqcw) - if (phase == 3) then - do i = istart, istop - naerosol(i) = (raer(i,k) + qqcw(i,k))*cs(i,k) - end do - else if (phase == 2) then - do i = istart, istop - naerosol(i) = qqcw(i,k)*cs(i,k) - end do - else - do i = istart, istop - naerosol(i) = raer(i,k)*cs(i,k) - end do - end if - ! adjust number so that dgnumlo < dgnum < dgnumhi - do i = istart, istop - naerosol(i) = max(naerosol(i), vaerosol(i)*voltonumbhi_amode(m)) - naerosol(i) = min(naerosol(i), vaerosol(i)*voltonumblo_amode(m)) - end do - -end subroutine loadaer - -!=============================================================================== - end module ndrop - - - - diff --git a/src/physics/cam/ndrop_bam.F90 b/src/physics/cam/ndrop_bam.F90 index 6cd8231356..01ab3b5856 100644 --- a/src/physics/cam/ndrop_bam.F90 +++ b/src/physics/cam/ndrop_bam.F90 @@ -112,7 +112,7 @@ subroutine ndrop_bam_init if (trim(aername(iaer)) == 'SULFATE') idxsul = iaer ! aerosol number concentration - call addfld(trim(aername(iaer))//'_m3', (/ 'lev' /), 'A', 'm-3', 'aerosol number concentration') + call addfld(trim(aername(iaer))//'_m3', (/ 'lev' /), 'A', 'm-3', 'aerosol number concentration', sampled_on_subcycle=.true.) end do @@ -129,12 +129,12 @@ subroutine ndrop_bam_init end if end if - call addfld ('CCN1',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.02%') - call addfld ('CCN2',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.05%') - call addfld ('CCN3',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.1%') - call addfld ('CCN4',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.2%') - call addfld ('CCN5',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.5%') - call addfld ('CCN6',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=1.0%') + call addfld ('CCN1',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.02%', sampled_on_subcycle=.true.) + call addfld ('CCN2',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.05%', sampled_on_subcycle=.true.) + call addfld ('CCN3',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.1%', sampled_on_subcycle=.true.) + call addfld ('CCN4',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.2%', sampled_on_subcycle=.true.) + call addfld ('CCN5',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.5%', sampled_on_subcycle=.true.) + call addfld ('CCN6',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=1.0%', sampled_on_subcycle=.true.) if (history_amwg) then call add_default('CCN3', 1, ' ') diff --git a/src/physics/cam/nucleate_ice.F90 b/src/physics/cam/nucleate_ice.F90 index b005305123..ac7268c068 100644 --- a/src/physics/cam/nucleate_ice.F90 +++ b/src/physics/cam/nucleate_ice.F90 @@ -12,10 +12,10 @@ module nucleate_ice ! The current method is based on Liu & Penner (2005) & Liu et al. (2007) ! It related the ice nucleation with the aerosol number, temperature and the ! updraft velocity. It includes homogeneous freezing of sulfate & immersion -! freezing on mineral dust (soot disabled) in cirrus clouds, and +! freezing on mineral dust (soot disabled) in cirrus clouds, and ! Meyers et al. (1992) deposition nucleation in mixed-phase clouds ! -! The effect of preexisting ice crystals on ice nucleation in cirrus clouds is included, +! The effect of preexisting ice crystals on ice nucleation in cirrus clouds is included, ! and also consider the sub-grid variability of temperature in cirrus clouds, ! following X. Shi et al. ACP (2014). ! @@ -49,10 +49,10 @@ module nucleate_ice real(r8), parameter :: Shet = 1.3_r8 ! het freezing threshold real(r8), parameter :: rhoice = 0.5e3_r8 ! kg/m3, Wpice is not sensitive to rhoice real(r8), parameter :: minweff= 0.001_r8 ! m/s -real(r8), parameter :: gamma1=1.0_r8 -real(r8), parameter :: gamma2=1.0_r8 -real(r8), parameter :: gamma3=2.0_r8 -real(r8), parameter :: gamma4=6.0_r8 +real(r8), parameter :: gamma1=1.0_r8 +real(r8), parameter :: gamma2=1.0_r8 +real(r8), parameter :: gamma3=2.0_r8 +real(r8), parameter :: gamma4=6.0_r8 real(r8) :: ci @@ -90,7 +90,8 @@ subroutine nucleati( & so4_num, dst_num, soot_num, subgrid, & nuci, onihf, oniimm, onidep, onimey, & wpice, weff, fhom, regm, & - oso4_num, odst_num, osoot_num, call_frm_zm_in) + oso4_num, odst_num, osoot_num, & + call_frm_zm_in, add_preexisting_ice_in) ! Input Arguments real(r8), intent(in) :: wbar ! grid cell mean vertical velocity (m/s) @@ -100,7 +101,7 @@ subroutine nucleati( & real(r8), intent(in) :: cldn ! new value of cloud fraction (fraction) real(r8), intent(in) :: qc ! liquid water mixing ratio (kg/kg) real(r8), intent(in) :: qi ! grid-mean preexisting cloud ice mass mixing ratio (kg/kg) - real(r8), intent(in) :: ni_in ! grid-mean preexisting cloud ice number conc (#/kg) + real(r8), intent(in) :: ni_in ! grid-mean preexisting cloud ice number conc (#/kg) real(r8), intent(in) :: rhoair ! air density (kg/m3) real(r8), intent(in) :: so4_num ! so4 aerosol number (#/cm^3) real(r8), intent(in) :: dst_num ! total dust aerosol number (#/cm^3) @@ -123,6 +124,7 @@ subroutine nucleati( & ! Optional Arguments logical, intent(in), optional :: call_frm_zm_in ! true if called from ZM convection scheme + logical, intent(in), optional :: add_preexisting_ice_in ! only false if called with pumas_v1.21+ ! Local workspace real(r8) :: nihf ! nucleated number from homogeneous freezing of so4 @@ -135,17 +137,19 @@ subroutine nucleati( & real(r8) :: wbar1, wbar2 ! used in SUBROUTINE Vpreice - real(r8) :: Ni_preice ! cloud ice number conc (1/m3) + real(r8) :: Ni_preice ! cloud ice number conc (1/m3) real(r8) :: lami,Ri_preice ! mean cloud ice radius (m) real(r8) :: Shom ! initial ice saturation ratio; if <1, use hom threshold Si real(r8) :: detaT,RHimean ! temperature standard deviation, mean cloudy RHi real(r8) :: wpicehet ! diagnosed Vertical velocity Reduction caused by preexisting ice (m/s), at shet - real(r8) :: weffhet ! effective Vertical velocity for ice nucleation (m/s) weff=wbar-wpicehet + real(r8) :: weffhet ! effective Vertical velocity for ice nucleation (m/s) weff=wbar-wpicehet - logical :: call_frm_zm + logical :: call_frm_zm, add_preexisting_ice !------------------------------------------------------------------------------- + nuci = 0._r8 + RHimean = relhum*svp_water(tair)/svp_ice(tair)*subgrid ! temp variables that depend on use_preexisting_ice @@ -162,12 +166,18 @@ subroutine nucleati( & call_frm_zm = .false. end if + if (present(add_preexisting_ice_in)) then + add_preexisting_ice = add_preexisting_ice_in + else + add_preexisting_ice = .true. + end if + if (use_preexisting_ice .and. (.not. call_frm_zm)) then Ni_preice = ni_in*rhoair ! (convert from #/kg -> #/m3) - Ni_preice = Ni_preice / max(mincld,cldn) ! in-cloud ice number density + Ni_preice = Ni_preice / max(mincld,cldn) ! in-cloud ice number density - if (Ni_preice > 10.0_r8 .and. qi > 1.e-10_r8) then ! > 0.01/L = 10/m3 + if (Ni_preice > 10.0_r8 .and. qi > 1.e-10_r8) then ! > 0.01/L = 10/m3 Shom = -1.5_r8 ! if Shom<1 , Shom will be recalculated in SUBROUTINE Vpreice, according to Ren & McKenzie, 2005 lami = (gamma4*ci*ni_in/qi)**(1._r8/3._r8) Ri_preice = 0.5_r8/lami ! radius @@ -235,7 +245,7 @@ subroutine nucleati( & niimm = dst_num + soot_num ! assuming dst_num freeze firstly odst_num = dst_num osoot_num = soot_num - + oso4_num = nihf endif @@ -249,9 +259,9 @@ subroutine nucleati( & nihf = 0._r8 n1 = niimm + nidep - - osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) - odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) + + osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) + odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) endif ! homogeneous nucleation only @@ -267,7 +277,7 @@ subroutine nucleati( & niimm = dst_num + soot_num ! assuming dst_num freeze firstly odst_num = dst_num osoot_num = soot_num - + oso4_num = nihf endif @@ -311,7 +321,7 @@ subroutine nucleati( & if (nihf.gt.1e-3_r8) then ! hom occur, add preexisting ice oso4_num = nihf endif - + osoot_num = soot_num * (niimm + nidep) / (soot_num + dst_num) odst_num = dst_num * (niimm + nidep) / (soot_num + dst_num) @@ -327,9 +337,11 @@ subroutine nucleati( & ! MG is expecting to find. ni = n1 - ! If using prexsiting ice, then add it to the total. - if (use_preexisting_ice .and. (.not. call_frm_zm)) then - ni = ni + Ni_preice * 1e-6_r8 + ! If using prexsiting ice, and allowed to add, then add it to the total. + if (use_preexisting_ice) then + if (add_preexisting_ice .and. (.not. call_frm_zm)) then + ni = ni + Ni_preice * 1e-6_r8 + end if end if end if end if @@ -340,7 +352,7 @@ subroutine nucleati( & esl = svp_water(tair) ! over water in mixed clouds esi = svp_ice(tair) ! over ice deles = (esl - esi) - nimey=1.e-3_r8*exp(12.96_r8*deles/esi - 0.639_r8) + nimey=1.e-3_r8*exp(12.96_r8*deles/esi - 0.639_r8) else nimey=0._r8 endif @@ -483,25 +495,25 @@ SUBROUTINE Vpreice(P_in, T_in, R_in, C_in, S_in, V_out) ! VERTICAL VELOCITY CALCULATED FROM DEPOSITIONAL LOSS TERM ! SUBROUTINE arguments - REAL(r8), INTENT(in) :: P_in ! [Pa],INITIAL AIR pressure - REAL(r8), INTENT(in) :: T_in ! [K] ,INITIAL AIR temperature - REAL(r8), INTENT(in) :: R_in ! [m],INITIAL MEAN ICE CRYSTAL NUMBER RADIUS + REAL(r8), INTENT(in) :: P_in ! [Pa],INITIAL AIR pressure + REAL(r8), INTENT(in) :: T_in ! [K] ,INITIAL AIR temperature + REAL(r8), INTENT(in) :: R_in ! [m],INITIAL MEAN ICE CRYSTAL NUMBER RADIUS REAL(r8), INTENT(in) :: C_in ! [m-3],INITIAL TOTAL ICE CRYSTAL NUMBER DENSITY, [1/cm3] - REAL(r8), INTENT(in) :: S_in ! [-],INITIAL ICE SATURATION RATIO;; if <1, use hom threshold Si + REAL(r8), INTENT(in) :: S_in ! [-],INITIAL ICE SATURATION RATIO;; if <1, use hom threshold Si REAL(r8), INTENT(out) :: V_out ! [m/s], VERTICAL VELOCITY REDUCTION (caused by preexisting ice) ! SUBROUTINE parameters - REAL(r8), PARAMETER :: ALPHAc = 0.5_r8 ! density of ice (g/cm3), !!!V is not related to ALPHAc - REAL(r8), PARAMETER :: FA1c = 0.601272523_r8 + REAL(r8), PARAMETER :: ALPHAc = 0.5_r8 ! density of ice (g/cm3), !!!V is not related to ALPHAc + REAL(r8), PARAMETER :: FA1c = 0.601272523_r8 REAL(r8), PARAMETER :: FA2c = 0.000342181855_r8 - REAL(r8), PARAMETER :: FA3c = 1.49236645E-12_r8 - REAL(r8), PARAMETER :: WVP1c = 3.6E+10_r8 + REAL(r8), PARAMETER :: FA3c = 1.49236645E-12_r8 + REAL(r8), PARAMETER :: WVP1c = 3.6E+10_r8 REAL(r8), PARAMETER :: WVP2c = 6145.0_r8 REAL(r8), PARAMETER :: FVTHc = 11713803.0_r8 REAL(r8), PARAMETER :: THOUBKc = 7.24637701E+18_r8 REAL(r8), PARAMETER :: SVOLc = 3.23E-23_r8 ! SVOL=XMW/RHOICE REAL(r8), PARAMETER :: FDc = 249.239822_r8 - REAL(r8), PARAMETER :: FPIVOLc = 3.89051704E+23_r8 + REAL(r8), PARAMETER :: FPIVOLc = 3.89051704E+23_r8 REAL(r8) :: T,P,S,R,C REAL(r8) :: A1,A2,A3,B1,B2 REAL(r8) :: T_1,PICE,FLUX,ALP4,CISAT,DLOSS,VICE @@ -519,22 +531,22 @@ SUBROUTINE Vpreice(P_in, T_in, R_in, C_in, S_in, V_out) C = C_in*1e-6_r8 ! m-3 => cm-3 T_1 = 1.0_r8/ T PICE = WVP1c * EXP(-(WVP2c*T_1)) - ALP4 = 0.25_r8 * ALPHAc + ALP4 = 0.25_r8 * ALPHAc FLUX = ALP4 * SQRT(FVTHc*T) - CISAT = THOUBKc * PICE * T_1 - A1 = ( FA1c * T_1 - FA2c ) * T_1 - A2 = 1.0_r8/ CISAT + CISAT = THOUBKc * PICE * T_1 + A1 = ( FA1c * T_1 - FA2c ) * T_1 + A2 = 1.0_r8/ CISAT A3 = FA3c * T_1 / P - B1 = FLUX * SVOLc * CISAT * ( S-1.0_r8 ) - B2 = FLUX * FDc * P * T_1**1.94_r8 - DLOSS = FPIVOLc * C * B1 * R**2 / ( 1.0_r8+ B2 * R ) + B1 = FLUX * SVOLc * CISAT * ( S-1.0_r8 ) + B2 = FLUX * FDc * P * T_1**1.94_r8 + DLOSS = FPIVOLc * C * B1 * R**2 / ( 1.0_r8+ B2 * R ) VICE = ( A2 + A3 * S ) * DLOSS / ( A1 * S ) ! 2006,(19) V_out = VICE*1e-2_r8 ! cm/s => m/s END SUBROUTINE Vpreice subroutine frachom(Tmean,RHimean,detaT,fhom) - ! How much fraction of cirrus might reach Shom + ! How much fraction of cirrus might reach Shom ! base on "A cirrus cloud scheme for general circulation models", ! B. Karcher and U. Burkhardt 2008 @@ -545,7 +557,7 @@ subroutine frachom(Tmean,RHimean,detaT,fhom) integer, parameter :: Nbin=200 ! (Tmean - 3*detaT, Tmean + 3*detaT) real(r8) :: PDF_T(Nbin) ! temperature PDF; ! PDF_T=0 outside (Tmean-3*detaT, Tmean+3*detaT) - real(r8) :: Sbin(Nbin) ! the fluctuations of Si that are driven by the T variations + real(r8) :: Sbin(Nbin) ! the fluctuations of Si that are driven by the T variations real(r8) :: Sihom, deta integer :: i @@ -557,7 +569,7 @@ subroutine frachom(Tmean,RHimean,detaT,fhom) deta = (i - 0.5_r8 - Nbin/2)*6.0_r8/Nbin ! PDF_T=0 outside (Tmean-3*detaT, Tmean+3*detaT) Sbin(i) = RHimean*exp(deta*detaT*seta/Tmean**2.0_r8) PDF_T(i) = exp(-deta**2.0_r8/2.0_r8)*6.0_r8/(sqrt(2.0_r8*Pi)*Nbin) - + if (Sbin(i).ge.Sihom) then fhom = fhom + PDF_T(i) diff --git a/src/physics/cam/nucleate_ice_cam.F90 b/src/physics/cam/nucleate_ice_cam.F90 index 264e95fc5b..3edd3f616a 100644 --- a/src/physics/cam/nucleate_ice_cam.F90 +++ b/src/physics/cam/nucleate_ice_cam.F90 @@ -15,9 +15,7 @@ module nucleate_ice_cam use physics_types, only: physics_state, physics_ptend, physics_ptend_init use physics_buffer, only: physics_buffer_desc use phys_control, only: use_hetfrz_classnuc -use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, rad_cnst_get_aer_props, & - rad_cnst_get_mode_num, rad_cnst_get_mode_props, rad_cnst_get_mode_num_idx, & - rad_cnst_get_mam_mmr_idx +use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, rad_cnst_get_aer_props use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_old_tim_idx, & pbuf_get_index, pbuf_get_field, & @@ -25,14 +23,17 @@ module nucleate_ice_cam use cam_history, only: addfld, add_default, outfld use ref_pres, only: top_lev => trop_cloud_top_lev -use wv_saturation, only: qsat_water, svp_water, svp_ice -use shr_spfn_mod, only: erf => shr_spfn_erf +use wv_saturation, only: qsat_water use cam_logfile, only: iulog use cam_abortutils, only: endrun use nucleate_ice, only: nucleati_init, nucleati +use aerosol_properties_mod, only: aerosol_properties +use aerosol_state_mod, only: aerosol_state + +use phys_control, only: cam_physpkg_is implicit none private @@ -43,7 +44,6 @@ module nucleate_ice_cam nucleate_ice_cam_register, & nucleate_ice_cam_init, & nucleate_ice_cam_calc - ! Namelist variables logical, public, protected :: use_preexisting_ice = .false. @@ -65,21 +65,20 @@ module nucleate_ice_cam numice_idx = -1 integer :: & - naai_idx, & - naai_hom_idx + naai_idx = -1, & + naai_hom_idx = -1 integer :: & - ast_idx = -1, & - dgnum_idx = -1 + aist_idx = -1 integer :: & - qsatfac_idx - + qsatfac_idx = -1 + ! Bulk aerosols character(len=20), allocatable :: aername(:) real(r8), allocatable :: num_to_mass_aer(:) -integer :: naer_all ! number of aerosols affecting climate +integer :: naer_all = -1 ! number of aerosols affecting climate integer :: idxsul = -1 ! index in aerosol list for sulfate integer :: idxdst1 = -1 ! index in aerosol list for dust1 integer :: idxdst2 = -1 ! index in aerosol list for dust2 @@ -88,25 +87,12 @@ module nucleate_ice_cam integer :: idxbcphi = -1 ! index in aerosol list for Soot (BCPHIL) ! modal aerosols -logical :: clim_modal_aero -logical :: prog_modal_aero - -integer :: nmodes = -1 -integer :: mode_accum_idx = -1 ! index of accumulation mode -integer :: mode_aitken_idx = -1 ! index of aitken mode -integer :: mode_coarse_idx = -1 ! index of coarse mode -integer :: mode_coarse_dst_idx = -1 ! index of coarse dust mode -integer :: mode_coarse_slt_idx = -1 ! index of coarse sea salt mode -integer :: coarse_dust_idx = -1 ! index of dust in coarse mode -integer :: coarse_nacl_idx = -1 ! index of nacl in coarse mode -integer :: coarse_so4_idx = -1 ! index of sulfate in coarse mode - -logical :: separate_dust = .false. -real(r8) :: sigmag_aitken -real(r8) :: sigmag_accum +logical :: clim_modal_aero = .false. +logical :: prog_modal_aero = .false. logical :: lq(pcnst) = .false. ! set flags true for constituents with non-zero tendencies -integer :: cnum_idx, cdst_idx, cso4_idx + +integer, allocatable :: aer_cnst_idx(:,:) !=============================================================================== contains @@ -168,29 +154,86 @@ end subroutine nucleate_ice_cam_register !================================================================================================ -subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d) +subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d, aero_props) use phys_control, only: phys_getopts use time_manager, only: is_first_step real(r8), intent(in) :: mincld_in real(r8), intent(in) :: bulk_scale_in + class(aerosol_properties), optional, intent(in) :: aero_props type(physics_buffer_desc), pointer :: pbuf2d(:,:) ! local variables - integer :: iaer + integer :: iaer integer :: ierr - integer :: m, n, nspec + integer :: ispc, ibin + integer :: idxtmp + integer :: nmodes - character(len=32) :: str32 character(len=*), parameter :: routine = 'nucleate_ice_cam_init' logical :: history_cesm_forcing + + character(len=32) :: tmpname + !-------------------------------------------------------------------------------------------- call phys_getopts(prog_modal_aero_out = prog_modal_aero, history_cesm_forcing_out = history_cesm_forcing) mincld = mincld_in bulk_scale = bulk_scale_in + lq(:) = .false. + + if (prog_modal_aero.and.use_preexisting_ice) then + + if (.not. present(aero_props)) then + call endrun(routine//' : aero_props must be present') + end if + + ! constituent tendencies are calculated only if use_preexisting_ice is TRUE + ! set lq for constituent tendencies -- + + allocate(aer_cnst_idx(aero_props%nbins(),0:maxval(aero_props%nspecies())), stat=ierr) + if( ierr /= 0 ) then + call endrun(routine//': aer_cnst_idx allocation failed') + end if + aer_cnst_idx = -1 + + do ibin = 1, aero_props%nbins() + if (aero_props%icenuc_updates_num(ibin)) then + + ! constituents of this bin will need to be updated + + if (aero_props%icenuc_updates_mmr(ibin,0)) then ! species 0 indicates bin MMR + call aero_props%amb_mmr_name( ibin, 0, tmpname) + else + call aero_props%amb_num_name( ibin, tmpname) + end if + + call cnst_get_ind(tmpname, idxtmp, abort=.false.) + aer_cnst_idx(ibin,0) = idxtmp + if (idxtmp>0) then + lq(idxtmp) = .true. + end if + + ! iterate over the species within the bin + do ispc = 1, aero_props%nspecies(ibin) + if (aero_props%icenuc_updates_mmr(ibin,ispc)) then + ! this aerosol constituent will be updated + call aero_props%amb_mmr_name( ibin, ispc, tmpname) + call cnst_get_ind(tmpname, idxtmp, abort=.false.) + aer_cnst_idx(ibin,ispc) = idxtmp + if (idxtmp>0) then + lq(idxtmp) = .true. + end if + end if + end do + + end if + end do + + end if + ! Initialize naai. if (is_first_step()) then call pbuf_set_field(pbuf2d, naai_idx, 0.0_r8) @@ -217,38 +260,60 @@ subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d) if (((nucleate_ice_subgrid .eq. -1._r8) .or. (nucleate_ice_subgrid_strat .eq. -1._r8)) .and. (qsatfac_idx .eq. -1)) then call endrun(routine//': ERROR qsatfac is required when subgrid = -1 or subgrid_strat = -1') end if - - call addfld('NIHF', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentation due to homogenous freezing') - call addfld('NIDEP', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentation due to deposition nucleation') - call addfld('NIIMM', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentation due to immersion freezing') - call addfld('NIMEY', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentation due to meyers deposition') - - call addfld('NIREGM',(/ 'lev' /), 'A', 'C', 'Ice Nucleation Temperature Threshold for Regime') - call addfld('NISUBGRID',(/ 'lev' /), 'A', '', 'Ice Nucleation subgrid saturation factor') - call addfld('NITROP_PD',(/ 'lev' /), 'A', '', 'Chemical Tropopause probability') + + if (cam_physpkg_is("cam7")) then + ! Updates for PUMAS v1.21+ + call addfld('NIHFTEN', (/ 'lev' /), 'A', '1/m3/s', 'Activated Ice Number Concentration tendency due to homogenous freezing', sampled_on_subcycle=.true.) + call addfld('NIDEPTEN', (/ 'lev' /), 'A', '1/m3/s', 'Activated Ice Number Concentration tendency due to deposition nucleation', sampled_on_subcycle=.true.) + call addfld('NIIMMTEN', (/ 'lev' /), 'A', '1/m3/s', 'Activated Ice Number Concentration tendency due to immersion freezing', sampled_on_subcycle=.true.) + call addfld('NIMEYTEN', (/ 'lev' /), 'A', '1/m3/s', 'Activated Ice Number Concentration tendency due to meyers deposition', sampled_on_subcycle=.true.) + else + call addfld('NIHF', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentration due to homogenous freezing', sampled_on_subcycle=.true.) + call addfld('NIDEP', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentration due to deposition nucleation', sampled_on_subcycle=.true.) + call addfld('NIIMM', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentration due to immersion freezing', sampled_on_subcycle=.true.) + call addfld('NIMEY', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentration due to meyers deposition', sampled_on_subcycle=.true.) + endif + + call addfld('NIREGM',(/ 'lev' /), 'A', 'C', 'Ice Nucleation Temperature Threshold for Regime', sampled_on_subcycle=.true.) + call addfld('NISUBGRID',(/ 'lev' /), 'A', '', 'Ice Nucleation subgrid saturation factor', sampled_on_subcycle=.true.) + call addfld('NITROP_PD',(/ 'lev' /), 'A', '', 'Chemical Tropopause probability', sampled_on_subcycle=.true.) if ( history_cesm_forcing ) then call add_default('NITROP_PD',8,' ') endif if (use_preexisting_ice) then - call addfld('fhom', (/ 'lev' /), 'A','fraction', 'Fraction of cirrus where homogeneous freezing occur' ) - call addfld ('WICE', (/ 'lev' /), 'A','m/s','Vertical velocity Reduction caused by preexisting ice' ) - call addfld ('WEFF', (/ 'lev' /), 'A','m/s','Effective Vertical velocity for ice nucleation' ) - call addfld ('INnso4', (/ 'lev' /), 'A','1/m3','Number Concentation so4 (in) to ice_nucleation') - call addfld ('INnbc', (/ 'lev' /), 'A','1/m3','Number Concentation bc (in) to ice_nucleation') - call addfld ('INndust', (/ 'lev' /), 'A','1/m3','Number Concentation dust (in) ice_nucleation') - call addfld ('INondust', (/ 'lev' /), 'A','1/m3','Number Concentation dust (out) from ice_nucleation') - call addfld ('INhet', (/ 'lev' /), 'A','1/m3', & - 'contribution for in-cloud ice number density increase by het nucleation in ice cloud') - call addfld ('INhom', (/ 'lev' /), 'A','1/m3', & - 'contribution for in-cloud ice number density increase by hom nucleation in ice cloud') - call addfld ('INFrehom', (/ 'lev' /), 'A','frequency','hom IN frequency ice cloud') - call addfld ('INFreIN', (/ 'lev' /), 'A','frequency','frequency of ice nucleation occur') + call addfld('fhom', (/ 'lev' /), 'A','fraction', 'Fraction of cirrus where homogeneous freezing occur', sampled_on_subcycle=.true.) + call addfld ('WICE', (/ 'lev' /), 'A','m/s','Vertical velocity Reduction caused by preexisting ice', sampled_on_subcycle=.true.) + call addfld ('WEFF', (/ 'lev' /), 'A','m/s','Effective Vertical velocity for ice nucleation', sampled_on_subcycle=.true.) + + if (cam_physpkg_is("cam7")) then + ! Updates for PUMAS v1.21+ + call addfld ('INnso4TEN', (/ 'lev' /), 'A','1/m3/s','Number Concentration tendency so4 (in) to ice_nucleation', sampled_on_subcycle=.true.) + call addfld ('INnbcTEN', (/ 'lev' /), 'A','1/m3/s','Number Concentration tendency bc (in) to ice_nucleation', sampled_on_subcycle=.true.) + call addfld ('INndustTEN', (/ 'lev' /), 'A','1/m3/s','Number Concentration tendency dust (in) ice_nucleation', sampled_on_subcycle=.true.) + call addfld ('INondustTEN', (/ 'lev' /), 'A','1/m3/s','Number Concentration tendency dust (out) from ice_nucleation', sampled_on_subcycle=.true.) + call addfld ('INhetTEN', (/ 'lev' /), 'A','1/m3/s', & + 'Tendency for contribution for in-cloud ice number density increase by het nucleation in ice cloud', sampled_on_subcycle=.true.) + call addfld ('INhomTEN', (/ 'lev' /), 'A','1/m3/s', & + 'Tendency for contribution for in-cloud ice number density increase by hom nucleation in ice cloud', sampled_on_subcycle=.true.) + else + call addfld ('INnso4', (/ 'lev' /), 'A','1/m3','Number Concentration so4 (in) to ice_nucleation', sampled_on_subcycle=.true.) + call addfld ('INnbc', (/ 'lev' /), 'A','1/m3','Number Concentration bc (in) to ice_nucleation', sampled_on_subcycle=.true.) + call addfld ('INndust', (/ 'lev' /), 'A','1/m3','Number Concentration dust (in) ice_nucleation', sampled_on_subcycle=.true.) + call addfld ('INondust', (/ 'lev' /), 'A','1/m3','Number Concentration dust (out) from ice_nucleation', sampled_on_subcycle=.true.) + call addfld ('INhet', (/ 'lev' /), 'A','1/m3', & + 'contribution for in-cloud ice number density increase by het nucleation in ice cloud', sampled_on_subcycle=.true.) + call addfld ('INhom', (/ 'lev' /), 'A','1/m3', & + 'contribution for in-cloud ice number density increase by hom nucleation in ice cloud', sampled_on_subcycle=.true.) + endif + + call addfld ('INFrehom', (/ 'lev' /), 'A','frequency','hom IN frequency ice cloud', sampled_on_subcycle=.true.) + call addfld ('INFreIN', (/ 'lev' /), 'A','frequency','frequency of ice nucleation occur', sampled_on_subcycle=.true.) if (hist_preexisting_ice) then call add_default ('WSUBI ', 1, ' ') ! addfld/outfld calls are in microp_aero - call add_default ('fhom ', 1, ' ') + call add_default ('fhom ', 1, ' ') call add_default ('WICE ', 1, ' ') call add_default ('WEFF ', 1, ' ') call add_default ('INnso4 ', 1, ' ') @@ -264,98 +329,10 @@ subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d) ! clim_modal_aero determines whether modal aerosols are used in the climate calculation. ! The modal aerosols can be either prognostic or prescribed. call rad_cnst_get_info(0, nmodes=nmodes) - clim_modal_aero = (nmodes > 0) - - if (clim_modal_aero) then - - dgnum_idx = pbuf_get_index('DGNUM' ) - - ! Init indices for specific modes/species - - ! mode index for specified mode types - do m = 1, nmodes - call rad_cnst_get_info(0, m, mode_type=str32) - select case (trim(str32)) - case ('accum') - mode_accum_idx = m - case ('aitken') - mode_aitken_idx = m - case ('coarse') - mode_coarse_idx = m - case ('coarse_dust') - mode_coarse_dst_idx = m - case ('coarse_seasalt') - mode_coarse_slt_idx = m - end select - end do - - ! check if coarse dust is in separate mode - separate_dust = mode_coarse_dst_idx > 0 - ! for 3-mode - if (mode_coarse_dst_idx < 0) mode_coarse_dst_idx = mode_coarse_idx - if (mode_coarse_slt_idx < 0) mode_coarse_slt_idx = mode_coarse_idx - - ! Check that required mode types were found - if (mode_accum_idx == -1 .or. mode_aitken_idx == -1 .or. & - mode_coarse_dst_idx == -1.or. mode_coarse_slt_idx == -1) then - write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & - mode_accum_idx, mode_aitken_idx, mode_coarse_dst_idx, mode_coarse_slt_idx - call endrun(routine//': ERROR required mode type not found') - end if - - ! species indices for specified types - ! find indices for the dust, seasalt and sulfate species in the coarse mode - call rad_cnst_get_info(0, mode_coarse_dst_idx, nspec=nspec) - do n = 1, nspec - call rad_cnst_get_info(0, mode_coarse_dst_idx, n, spec_type=str32) - select case (trim(str32)) - case ('dust') - coarse_dust_idx = n - end select - end do - call rad_cnst_get_info(0, mode_coarse_slt_idx, nspec=nspec) - do n = 1, nspec - call rad_cnst_get_info(0, mode_coarse_slt_idx, n, spec_type=str32) - select case (trim(str32)) - case ('seasalt') - coarse_nacl_idx = n - end select - end do - if (mode_coarse_idx>0) then - call rad_cnst_get_info(0, mode_coarse_idx, nspec=nspec) - do n = 1, nspec - call rad_cnst_get_info(0, mode_coarse_idx, n, spec_type=str32) - select case (trim(str32)) - case ('sulfate') - coarse_so4_idx = n - end select - end do - endif - - ! Check that required mode specie types were found - if ( coarse_dust_idx == -1 .or. coarse_nacl_idx == -1 ) then - write(iulog,*) routine//': ERROR required mode-species type not found - indicies:', & - coarse_dust_idx, coarse_nacl_idx - call endrun(routine//': ERROR required mode-species type not found') - end if - - - ! get specific mode properties - call rad_cnst_get_mode_props(0, mode_aitken_idx, sigmag=sigmag_aitken) - call rad_cnst_get_mode_props(0, mode_accum_idx, sigmag=sigmag_accum) - - if (prog_modal_aero) then - call rad_cnst_get_mode_num_idx(mode_coarse_dst_idx, cnum_idx) - call rad_cnst_get_mam_mmr_idx(mode_coarse_dst_idx, coarse_dust_idx, cdst_idx) - if (mode_coarse_idx>0) then - call rad_cnst_get_mam_mmr_idx(mode_coarse_idx, coarse_so4_idx, cso4_idx) - end if - lq(cnum_idx) = .true. - lq(cdst_idx) = .true. - endif + clim_modal_aero = (nmodes > 0) - else + if (.not. clim_modal_aero) then ! Props needed for BAM number concentration calcs. @@ -374,7 +351,7 @@ subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d) if (trim(aername(iaer)) == 'DUST2') idxdst2 = iaer if (trim(aername(iaer)) == 'DUST3') idxdst3 = iaer if (trim(aername(iaer)) == 'DUST4') idxdst4 = iaer - if (trim(aername(iaer)) == 'BCPHIL') idxbcphi = iaer + if (trim(aername(iaer)) == 'BCPHI') idxbcphi = iaer end do end if @@ -383,14 +360,14 @@ subroutine nucleate_ice_cam_init(mincld_in, bulk_scale_in, pbuf2d) mincld) ! get indices for fields in the physics buffer - ast_idx = pbuf_get_index('AST') + aist_idx = pbuf_get_index('AIST') end subroutine nucleate_ice_cam_init !================================================================================================ subroutine nucleate_ice_cam_calc( & - state, wsubi, pbuf, dtime, ptend) + state, wsubi, pbuf, dtime, ptend, aero_props, aero_state ) use tropopause, only: tropopause_findChemTrop @@ -400,16 +377,20 @@ subroutine nucleate_ice_cam_calc( & type(physics_buffer_desc), pointer :: pbuf(:) real(r8), intent(in) :: dtime type(physics_ptend), intent(out) :: ptend - + class(aerosol_properties),optional, intent(in) :: aero_props + class(aerosol_state),optional, intent(in) :: aero_state + ! local workspace ! naai and naai_hom are the outputs shared with the microphysics - real(r8), pointer :: naai(:,:) ! number of activated aerosol for ice nucleation + real(r8), pointer :: naai(:,:) ! number of activated aerosol for ice nucleation real(r8), pointer :: naai_hom(:,:) ! number of activated aerosol for ice nucleation (homogeneous freezing only) integer :: lchnk, ncol integer :: itim_old - integer :: i, k, m + integer :: i, k, l, m + + character(len=32) :: spectype real(r8), pointer :: t(:,:) ! input temperature (K) real(r8), pointer :: qn(:,:) ! input water vapor mixing ratio (kg/kg) @@ -418,18 +399,8 @@ subroutine nucleate_ice_cam_calc( & real(r8), pointer :: ni(:,:) ! cloud ice number conc (1/kg) real(r8), pointer :: pmid(:,:) ! pressure at layer midpoints (pa) - real(r8), pointer :: num_accum(:,:) ! number m.r. of accumulation mode - real(r8), pointer :: num_aitken(:,:) ! number m.r. of aitken mode - real(r8), pointer :: num_coarse(:,:) ! number m.r. of coarse mode - real(r8), pointer :: coarse_dust(:,:) ! mass m.r. of coarse dust - real(r8), pointer :: coarse_nacl(:,:) ! mass m.r. of coarse nacl - real(r8), pointer :: coarse_so4(:,:) ! mass m.r. of coarse sulfate real(r8), pointer :: aer_mmr(:,:) ! aerosol mass mixing ratio - real(r8), pointer :: dgnum(:,:,:) ! mode dry radius - real(r8), pointer :: cld_num_coarse(:,:) ! number m.r. of coarse mode - real(r8), pointer :: cld_coarse_dust(:,:) ! mass m.r. of coarse dust - - real(r8), pointer :: ast(:,:) + real(r8), pointer :: aist(:,:) real(r8) :: icecldf(pcols,pver) ! ice cloud fraction real(r8), pointer :: qsatfac(:,:) ! Subgrid cloud water saturation scaling factor. @@ -446,29 +417,24 @@ subroutine nucleate_ice_cam_calc( & real(r8) :: relhum(pcols,pver) ! relative humidity real(r8) :: icldm(pcols,pver) ! ice cloud fraction + real(r8) :: dst_num ! total dust aerosol number (#/cm^3) + real(r8) :: dso4_num ! so4 aerosol number (#/cm^3) real(r8) :: so4_num ! so4 aerosol number (#/cm^3) real(r8) :: soot_num ! soot (hydrophilic) aerosol number (#/cm^3) - real(r8) :: dst1_num,dst2_num,dst3_num,dst4_num ! dust aerosol number (#/cm^3) - real(r8) :: dst_num ! total dust aerosol number (#/cm^3) real(r8) :: wght - real(r8) :: dmc - real(r8) :: ssmc - real(r8) :: so4mc real(r8) :: oso4_num real(r8) :: odst_num real(r8) :: osoot_num - real(r8) :: dso4_num - real(r8) :: so4_num_ac - real(r8) :: so4_num_cr + real(r8) :: so4_num_st_cr_tot real(r8) :: ramp - + real(r8) :: subgrid(pcols,pver) real(r8) :: trop_pd(pcols,pver) ! For pre-existing ice real(r8) :: fhom(pcols,pver) ! how much fraction of cloud can reach Shom - real(r8) :: wice(pcols,pver) ! diagnosed Vertical velocity Reduction caused by preexisting ice (m/s), at Shom - real(r8) :: weff(pcols,pver) ! effective Vertical velocity for ice nucleation (m/s); weff=wsubi-wice + real(r8) :: wice(pcols,pver) ! diagnosed Vertical velocity Reduction caused by preexisting ice (m/s), at Shom + real(r8) :: weff(pcols,pver) ! effective Vertical velocity for ice nucleation (m/s); weff=wsubi-wice real(r8) :: INnso4(pcols,pver) ! #/m3, so4 aerosol number used for ice nucleation real(r8) :: INnbc(pcols,pver) ! #/m3, bc aerosol number used for ice nucleation real(r8) :: INndust(pcols,pver) ! #/m3, dust aerosol number used for ice nucleation @@ -485,6 +451,24 @@ subroutine nucleate_ice_cam_calc( & real(r8) :: nimey(pcols,pver) !output number conc of ice nuclei due to meyers deposition (1/m3) real(r8) :: regm(pcols,pver) !output temperature thershold for nucleation regime + real(r8) :: size_wghts(pcols,pver) + real(r8) :: type_wghts(pcols,pver) + real(r8), pointer :: num_col(:,:) + real(r8) :: dust_num_col(pcols,pver) + real(r8) :: sulf_num_col(pcols,pver) + real(r8) :: soot_num_col(pcols,pver) + real(r8) :: sulf_num_tot_col(pcols,pver) + + integer :: idxtmp + real(r8), pointer :: amb_num(:,:) + real(r8), pointer :: amb_mmr(:,:) + real(r8), pointer :: cld_num(:,:) + real(r8), pointer :: cld_mmr(:,:) + + real(r8) :: delmmr, delmmr_sum + real(r8) :: delnum, delnum_sum + + real(r8), parameter :: per_cm3 = 1.e-6_r8 ! factor for m-3 to cm-3 conversions !------------------------------------------------------------------------------- @@ -497,31 +481,12 @@ subroutine nucleate_ice_cam_calc( & ni => state%q(:,:,numice_idx) pmid => state%pmid - do k = top_lev, pver - do i = 1, ncol - rho(i,k) = pmid(i,k)/(rair*t(i,k)) - end do - end do + rho(:ncol,:) = pmid(:ncol,:)/(rair*t(:ncol,:)) if (clim_modal_aero) then - ! mode number mixing ratios - call rad_cnst_get_mode_num(0, mode_accum_idx, 'a', state, pbuf, num_accum) - call rad_cnst_get_mode_num(0, mode_aitken_idx, 'a', state, pbuf, num_aitken) - call rad_cnst_get_mode_num(0, mode_coarse_dst_idx, 'a', state, pbuf, num_coarse) - - ! mode specie mass m.r. - call rad_cnst_get_aer_mmr(0, mode_coarse_dst_idx, coarse_dust_idx, 'a', state, pbuf, coarse_dust) - call rad_cnst_get_aer_mmr(0, mode_coarse_slt_idx, coarse_nacl_idx, 'a', state, pbuf, coarse_nacl) - if (mode_coarse_idx>0) then - call rad_cnst_get_aer_mmr(0, mode_coarse_idx, coarse_so4_idx, 'a', state, pbuf, coarse_so4) - endif - - ! Get the cloudbourne coarse mode fields, so aerosol used for nucleated - ! can be moved from interstial to cloudbourne. - call rad_cnst_get_mode_num(0, mode_coarse_dst_idx, 'c', state, pbuf, cld_num_coarse) - call rad_cnst_get_aer_mmr(0, mode_coarse_dst_idx, coarse_dust_idx, 'c', state, pbuf, cld_coarse_dust) call physics_ptend_init(ptend, state%psetcols, 'nucleatei', lq=lq) + else ! init number/mass arrays for bulk aerosols allocate( & @@ -543,35 +508,33 @@ subroutine nucleate_ice_cam_calc( & end if itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - icecldf(:ncol,:pver) = ast(:ncol,:pver) - - if (clim_modal_aero) then - call pbuf_get_field(pbuf, dgnum_idx, dgnum) - end if + call pbuf_get_field(pbuf, aist_idx, aist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + icecldf(:ncol,:pver) = aist(:ncol,:pver) ! naai and naai_hom are the outputs from this parameterization call pbuf_get_field(pbuf, naai_idx, naai) call pbuf_get_field(pbuf, naai_hom_idx, naai_hom) - naai(1:ncol,1:pver) = 0._r8 - naai_hom(1:ncol,1:pver) = 0._r8 + naai(1:ncol,1:pver) = 0._r8 + naai_hom(1:ncol,1:pver) = 0._r8 ! Use the same criteria that is used in chemistry and in CLUBB (for cloud fraction) ! to determine whether to use tropospheric or stratospheric settings. Include the ! tropopause level so that the cold point tropopause will use the stratospheric values. + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + troplev(:) = 0 + !REMOVECAM_END call tropopause_findChemTrop(state, troplev) - + if ((nucleate_ice_subgrid .eq. -1._r8) .or. (nucleate_ice_subgrid_strat .eq. -1._r8)) then call pbuf_get_field(pbuf, qsatfac_idx, qsatfac) end if - + trop_pd(:,:) = 0._r8 - + do k = top_lev, pver do i = 1, ncol trop_pd(i, troplev(i)) = 1._r8 - + if (k <= troplev(i)) then if (nucleate_ice_subgrid_strat .eq. -1._r8) then subgrid(i, k) = 1._r8 / qsatfac(i, k) @@ -590,10 +553,12 @@ subroutine nucleate_ice_cam_calc( & ! initialize history output fields for ice nucleation - nihf(1:ncol,1:pver) = 0._r8 - niimm(1:ncol,1:pver) = 0._r8 - nidep(1:ncol,1:pver) = 0._r8 - nimey(1:ncol,1:pver) = 0._r8 + nihf(1:ncol,1:pver) = 0._r8 + niimm(1:ncol,1:pver) = 0._r8 + nidep(1:ncol,1:pver) = 0._r8 + nimey(1:ncol,1:pver) = 0._r8 + + regm(1:ncol,1:pver) = 0._r8 if (use_preexisting_ice) then fhom(:,:) = 0.0_r8 @@ -610,10 +575,8 @@ subroutine nucleate_ice_cam_calc( & endif do k = top_lev, pver - ! Get humidity and saturation vapor pressures - call qsat_water(t(:ncol,k), pmid(:ncol,k), & - es(:ncol), qs(:ncol), gam=gammas(:ncol)) + call qsat_water(t(1:ncol,k), pmid(1:ncol,k), es(1:ncol), qs(1:ncol), ncol, gam=gammas(1:ncol)) do i = 1, ncol @@ -625,130 +588,157 @@ subroutine nucleate_ice_cam_calc( & end do end do + dust_num_col = 0._r8 + sulf_num_col = 0._r8 + sulf_num_tot_col = 0._r8 + soot_num_col = 0._r8 - do k = top_lev, pver - do i = 1, ncol + if (clim_modal_aero) then - if (t(i,k) < tmelt - 5._r8) then - - ! compute aerosol number for so4, soot, and dust with units #/cm^3 - so4_num = 0._r8 - soot_num = 0._r8 - dst1_num = 0._r8 - dst2_num = 0._r8 - dst3_num = 0._r8 - dst4_num = 0._r8 - dst_num = 0._r8 - so4_num_cr = 0._r8 - - if (clim_modal_aero) then - !For modal aerosols, assume for the upper troposphere: - ! soot = accumulation mode - ! sulfate = aiken mode - ! dust = coarse mode - ! since modal has internal mixtures. - soot_num = num_accum(i,k)*rho(i,k)*1.0e-6_r8 - dmc = coarse_dust(i,k)*rho(i,k) - ssmc = coarse_nacl(i,k)*rho(i,k) - - if (dmc > 0._r8) then - if ( separate_dust ) then - ! 7-mode -- has separate dust and seasalt mode types and - ! no need for weighting - wght = 1._r8 - else - ! 3-mode -- needs weighting for dust since dust, seasalt, - ! and sulfate are combined in the "coarse" mode type - so4mc = coarse_so4(i,k)*rho(i,k) - wght = dmc/(ssmc + dmc + so4mc) - endif - dst_num = wght * num_coarse(i,k)*rho(i,k)*1.0e-6_r8 - else - dst_num = 0.0_r8 - end if + if (.not.(present(aero_props).and.present(aero_state))) then + call endrun('nucleate_ice_cam_calc: aero_props and aero_state must be present') + end if - if ( separate_dust ) then - ! 7-mode -- the 7 mode scheme does not support - ! stratospheric sulfates, and the sulfates are mixed in - ! with the separate soot and dust modes, so just ignore - ! for now. - so4_num_cr = 0.0_r8 - else - ! 3-mode -- needs weighting for dust since dust, seasalt, - ! and sulfate are combined in the "coarse" mode - ! type - so4mc = coarse_so4(i,k)*rho(i,k) - - if (so4mc > 0._r8) then - wght = so4mc/(ssmc + dmc + so4mc) - so4_num_cr = wght * num_coarse(i,k)*rho(i,k)*1.0e-6_r8 - else - so4_num_cr = 0.0_r8 - end if - endif + ! collect number densities (#/cm^3) for dust, sulfate, and soot + call aero_state%nuclice_get_numdens( aero_props, use_preexisting_ice, ncol, pver, rho, & + dust_num_col, sulf_num_col, soot_num_col, sulf_num_tot_col ) - so4_num = 0.0_r8 - if (.not. use_preexisting_ice) then - if (dgnum(i,k,mode_aitken_idx) > 0._r8) then - ! only allow so4 with D>0.1 um in ice nucleation - so4_num = so4_num + max(0._r8, num_aitken(i,k)*rho(i,k)*1.0e-6_r8 & - * (0.5_r8 - 0.5_r8*erf(log(0.1e-6_r8/dgnum(i,k,mode_aitken_idx))/ & - (2._r8**0.5_r8*log(sigmag_aitken))))) - end if - else - ! all so4 from aitken - so4_num = num_aitken(i,k)*rho(i,k)*1.0e-6_r8 - end if + else + ! for bulk model + if (idxdst1 > 0 .and. idxdst2 > 0 .and. idxdst3 > 0 .and. idxdst4 > 0) then + dust_num_col(:ncol,:) = naer2(:ncol,:,idxdst1)/25._r8 * per_cm3 & ! #/cm3 + + naer2(:ncol,:,idxdst2)/25._r8 * per_cm3 & + + naer2(:ncol,:,idxdst3)/25._r8 * per_cm3 & + + naer2(:ncol,:,idxdst4)/25._r8 * per_cm3 + end if + if (idxsul > 0) then + sulf_num_col(:ncol,:) = naer2(:ncol,:,idxsul)/25._r8 * per_cm3 + end if + if (idxbcphi > 0) then + soot_num_col(:ncol,:) = naer2(:ncol,:,idxbcphi)/25._r8 * per_cm3 + end if + endif - else + kloop: do k = top_lev, pver + iloop: do i = 1, ncol - if (idxsul > 0) then - so4_num = naer2(i,k,idxsul)/25._r8 *1.0e-6_r8 - end if - if (idxbcphi > 0) then - soot_num = naer2(i,k,idxbcphi)/25._r8 *1.0e-6_r8 - end if - if (idxdst1 > 0) then - dst1_num = naer2(i,k,idxdst1)/25._r8 *1.0e-6_r8 - end if - if (idxdst2 > 0) then - dst2_num = naer2(i,k,idxdst2)/25._r8 *1.0e-6_r8 - end if - if (idxdst3 > 0) then - dst3_num = naer2(i,k,idxdst3)/25._r8 *1.0e-6_r8 - end if - if (idxdst4 > 0) then - dst4_num = naer2(i,k,idxdst4)/25._r8 *1.0e-6_r8 - end if - dst_num = dst1_num + dst2_num + dst3_num + dst4_num + so4_num_st_cr_tot = 0._r8 - end if + freezing: if (t(i,k) < tmelt - 5._r8) then + + ! set aerosol number for so4, soot, and dust with units #/cm^3 + so4_num = sulf_num_col(i,k) + dst_num = dust_num_col(i,k) + so4_num_st_cr_tot=sulf_num_tot_col(i,k) ! *** Turn off soot nucleation *** soot_num = 0.0_r8 - call nucleati( & - wsubi(i,k), t(i,k), pmid(i,k), relhum(i,k), icldm(i,k), & - qc(i,k), qi(i,k), ni(i,k), rho(i,k), & - so4_num, dst_num, soot_num, subgrid(i,k), & - naai(i,k), nihf(i,k), niimm(i,k), nidep(i,k), nimey(i,k), & - wice(i,k), weff(i,k), fhom(i,k), regm(i,k), & - oso4_num, odst_num, osoot_num) + if (cam_physpkg_is("cam7")) then + + call nucleati( & + wsubi(i,k), t(i,k), pmid(i,k), relhum(i,k), icldm(i,k), & + qc(i,k), qi(i,k), ni(i,k), rho(i,k), & + so4_num, dst_num, soot_num, subgrid(i,k), & + naai(i,k), nihf(i,k), niimm(i,k), nidep(i,k), nimey(i,k), & + wice(i,k), weff(i,k), fhom(i,k), regm(i,k), & + oso4_num, odst_num, osoot_num, & + call_frm_zm_in = .false., add_preexisting_ice_in = .false.) + + else - ! Move aerosol used for nucleation from interstial to cloudborne, + call nucleati( & + wsubi(i,k), t(i,k), pmid(i,k), relhum(i,k), icldm(i,k), & + qc(i,k), qi(i,k), ni(i,k), rho(i,k), & + so4_num, dst_num, soot_num, subgrid(i,k), & + naai(i,k), nihf(i,k), niimm(i,k), nidep(i,k), nimey(i,k), & + wice(i,k), weff(i,k), fhom(i,k), regm(i,k), & + oso4_num, odst_num, osoot_num) + + end if + + ! Move aerosol used for nucleation from interstial to cloudborne, ! otherwise the same coarse mode aerosols will be available again ! in the next timestep and will supress homogeneous freezing. + + if (prog_modal_aero .and. use_preexisting_ice) then - if (separate_dust) then - call endrun('nucleate_ice_cam: use_preexisting_ice is not supported in separate_dust mode (MAM7)') - endif - ptend%q(i,k,cnum_idx) = -(odst_num * icldm(i,k))/rho(i,k)/1e-6_r8/dtime - cld_num_coarse(i,k) = cld_num_coarse(i,k) + (odst_num * icldm(i,k))/rho(i,k)/1e-6_r8 - ptend%q(i,k,cdst_idx) = - odst_num / dst_num * icldm(i,k) * coarse_dust(i,k) / dtime - cld_coarse_dust(i,k) = cld_coarse_dust(i,k) + odst_num / dst_num *icldm(i,k) * coarse_dust(i,k) + ! compute tendencies for transported aerosol constituents + ! and update not-transported constituents + + do m = 1, aero_props%nbins() + + if (aero_props%icenuc_updates_num(m)) then + + ! constituents of this bin will need to be updated + + call aero_state%get_ambient_num(m, amb_num) + call aero_state%get_cldbrne_num(m, cld_num) + + if (amb_num(i,k)>0._r8) then + delmmr_sum = 0._r8 + delnum_sum = 0._r8 + + ! iterate over the species within the bin + do l = 1, aero_props%nspecies(m) + if (aero_props%icenuc_updates_mmr(m,l)) then + + call aero_props%species_type(m, l, spectype) + call aero_state%icenuc_size_wght( m, i,k, spectype, use_preexisting_ice, wght) + + if (wght>0._r8) then + + ! this aerosol constituent will be updated + + idxtmp = aer_cnst_idx(m,l) + + call aero_state%get_ambient_mmr(l,m,amb_mmr) + call aero_state%get_cldbrne_mmr(l,m,cld_mmr) + + ! determine change in aerosol mass + delmmr = 0._r8 + delnum = 0._r8 + if (trim(spectype)=='dust') then + if (dst_num>0._r8) then + delmmr = (odst_num / dst_num) * icldm(i,k) * amb_mmr(i,k) * wght + delnum = (odst_num * icldm(i,k)) /rho(i,k)/per_cm3 + endif + elseif (trim(spectype)=='sulfate') then + if (so4_num>0._r8) then + delmmr = (oso4_num / so4_num) * icldm(i,k) * amb_mmr(i,k) * wght + delnum = (oso4_num * icldm(i,k)) /rho(i,k)/per_cm3 + endif + endif + + if (idxtmp>0) then + ! constituent tendency (for transported species) + ptend%q(i,k,idxtmp) = -delmmr/dtime + else + ! apply change of mass to not-transported species + amb_mmr(i,k) = amb_mmr(i,k) - delmmr + endif + cld_mmr(i,k) = cld_mmr(i,k) + delmmr + + delmmr_sum = delmmr_sum + delmmr + delnum_sum = delnum_sum + delnum + end if + end if + end do + + idxtmp = aer_cnst_idx(m,0) + + ! update aerosol state bin and tendency for grid box i,k + call aero_state%update_bin( m,i,k, delmmr_sum, delnum_sum, idxtmp, dtime, ptend%q ) + + end if + + end if + end do + end if + ! Liu&Penner does not generate enough nucleation in the polar winter ! stratosphere, which affects surface area density, dehydration and ! ozone chemistry. Part of this is that there are a larger number of @@ -766,81 +756,126 @@ subroutine nucleate_ice_cam_calc( & ! particles. It may not represent the proper saturation threshold for ! nucleation, and wsubi from CLUBB is probably not representative of ! wave driven varaibility in the polar stratosphere. - if (nucleate_ice_use_troplev .and. clim_modal_aero) then - if ((k < troplev(i)) .and. (nucleate_ice_strat > 0._r8)) then - if (oso4_num > 0._r8) then - so4_num_ac = num_accum(i,k)*rho(i,k)*1.0e-6_r8 - dso4_num = max(0._r8, (nucleate_ice_strat * (so4_num_cr + so4_num_ac)) - oso4_num) * 1e6_r8 / rho(i,k) - naai(i,k) = naai(i,k) + dso4_num - nihf(i,k) = nihf(i,k) + dso4_num - end if - end if + if (nucleate_ice_use_troplev .and. clim_modal_aero) then + if ((k < troplev(i)) .and. (nucleate_ice_strat > 0._r8) .and. (oso4_num > 0._r8)) then + dso4_num = max(0._r8, (nucleate_ice_strat*so4_num_st_cr_tot - oso4_num) * 1e6_r8 / rho(i,k)) + naai(i,k) = naai(i,k) + dso4_num + nihf(i,k) = nihf(i,k) + dso4_num + endif else - - ! This maintains backwards compatibility with the previous version. - if (pmid(i,k) <= 12500._r8 .and. pmid(i,k) > 100._r8 .and. abs(state%lat(i)) >= 60._r8 * pi / 180._r8) then - ramp = 1._r8 - min(1._r8, max(0._r8, (pmid(i,k) - 10000._r8) / 2500._r8)) - - if (oso4_num > 0._r8) then - dso4_num = (max(oso4_num, ramp * nucleate_ice_strat * so4_num) - oso4_num) * 1e6_r8 / rho(i,k) - naai(i,k) = naai(i,k) + dso4_num - nihf(i,k) = nihf(i,k) + dso4_num - end if - end if + ! This maintains backwards compatibility with the previous version. + if (pmid(i,k) <= 12500._r8 .and. pmid(i,k) > 100._r8 .and. abs(state%lat(i)) >= 60._r8 * pi / 180._r8) then + ramp = 1._r8 - min(1._r8, max(0._r8, (pmid(i,k) - 10000._r8) / 2500._r8)) + + if (oso4_num > 0._r8) then + dso4_num = (max(oso4_num, ramp * nucleate_ice_strat * so4_num) - oso4_num) * 1e6_r8 / rho(i,k) + naai(i,k) = naai(i,k) + dso4_num + nihf(i,k) = nihf(i,k) + dso4_num + end if + end if end if - naai_hom(i,k) = nihf(i,k) - - ! output activated ice (convert from #/kg -> #/m3) - nihf(i,k) = nihf(i,k) *rho(i,k) - niimm(i,k) = niimm(i,k)*rho(i,k) - nidep(i,k) = nidep(i,k)*rho(i,k) - nimey(i,k) = nimey(i,k)*rho(i,k) - - if (use_preexisting_ice) then - INnso4(i,k) =so4_num*1e6_r8 ! (convert from #/cm3 -> #/m3) - INnbc(i,k) =soot_num*1e6_r8 - INndust(i,k)=dst_num*1e6_r8 - INondust(i,k)=odst_num*1e6_r8 - INFreIN(i,k)=1.0_r8 ! 1,ice nucleation occur - INhet(i,k) = (niimm(i,k) + nidep(i,k)) ! #/m3, nimey not in cirrus - INhom(i,k) = nihf(i,k) ! #/m3 - if (INhom(i,k).gt.1e3_r8) then ! > 1/L - INFrehom(i,k)=1.0_r8 ! 1, hom freezing occur - endif + if (cam_physpkg_is("cam7")) then + !Updates for pumas v1.21+ + + naai_hom(i,k) = nihf(i,k)/dtime + naai(i,k)= naai(i,k)/dtime + + ! output activated ice (convert from #/kg -> #/m3/s) + nihf(i,k) = nihf(i,k) *rho(i,k)/dtime + niimm(i,k) = niimm(i,k)*rho(i,k)/dtime + nidep(i,k) = nidep(i,k)*rho(i,k)/dtime + nimey(i,k) = nimey(i,k)*rho(i,k)/dtime + + if (use_preexisting_ice) then + INnso4(i,k) =so4_num*1e6_r8/dtime ! (convert from #/cm3 -> #/m3/s) + INnbc(i,k) =soot_num*1e6_r8/dtime + INndust(i,k)=dst_num*1e6_r8/dtime + INondust(i,k)=odst_num*1e6_r8/dtime + INFreIN(i,k)=1.0_r8 ! 1,ice nucleation occur + INhet(i,k) = (niimm(i,k) + nidep(i,k)) ! #/m3/s, nimey not in cirrus + INhom(i,k) = nihf(i,k) ! #/m3/s + if (INhom(i,k).gt.1e3_r8) then ! > 1/L + INFrehom(i,k)=1.0_r8 ! 1, hom freezing occur + endif - ! exclude no ice nucleaton - if ((INFrehom(i,k) < 0.5_r8) .and. (INhet(i,k) < 1.0_r8)) then - INnso4(i,k) =0.0_r8 - INnbc(i,k) =0.0_r8 - INndust(i,k)=0.0_r8 - INondust(i,k)=0.0_r8 - INFreIN(i,k)=0.0_r8 - INhet(i,k) = 0.0_r8 - INhom(i,k) = 0.0_r8 - INFrehom(i,k)=0.0_r8 - wice(i,k) = 0.0_r8 - weff(i,k) = 0.0_r8 - fhom(i,k) = 0.0_r8 + ! exclude no ice nucleaton + if ((INFrehom(i,k) < 0.5_r8) .and. (INhet(i,k) < 1.0_r8)) then + INnso4(i,k) =0.0_r8 + INnbc(i,k) =0.0_r8 + INndust(i,k)=0.0_r8 + INondust(i,k)=0.0_r8 + INFreIN(i,k)=0.0_r8 + INhet(i,k) = 0.0_r8 + INhom(i,k) = 0.0_r8 + INFrehom(i,k)=0.0_r8 + wice(i,k) = 0.0_r8 + weff(i,k) = 0.0_r8 + fhom(i,k) = 0.0_r8 + endif endif - end if - end if - end do - end do + else ! Not cam7 + + naai_hom(i,k) = nihf(i,k) + + ! output activated ice (convert from #/kg -> #/m3/s) + nihf(i,k) = nihf(i,k) *rho(i,k) + niimm(i,k) = niimm(i,k)*rho(i,k) + nidep(i,k) = nidep(i,k)*rho(i,k) + nimey(i,k) = nimey(i,k)*rho(i,k) + + if (use_preexisting_ice) then + INnso4(i,k) =so4_num*1e6_r8 ! (convert from #/cm3 -> #/m3/s) + INnbc(i,k) =soot_num*1e6_r8 + INndust(i,k)=dst_num*1e6_r8 + INondust(i,k)=odst_num*1e6_r8 + INFreIN(i,k)=1.0_r8 ! 1,ice nucleation occur + INhet(i,k) = (niimm(i,k) + nidep(i,k)) ! #/m3, nimey not in cirrus + INhom(i,k) = nihf(i,k) ! #/m3 + if (INhom(i,k).gt.1e3_r8) then ! > 1/L + INFrehom(i,k)=1.0_r8 ! 1, hom freezing occur + endif - if (.not. clim_modal_aero) then + ! exclude no ice nucleaton + if ((INFrehom(i,k) < 0.5_r8) .and. (INhet(i,k) < 1.0_r8)) then + INnso4(i,k) =0.0_r8 + INnbc(i,k) =0.0_r8 + INndust(i,k)=0.0_r8 + INondust(i,k)=0.0_r8 + INFreIN(i,k)=0.0_r8 + INhet(i,k) = 0.0_r8 + INhom(i,k) = 0.0_r8 + INFrehom(i,k)=0.0_r8 + wice(i,k) = 0.0_r8 + weff(i,k) = 0.0_r8 + fhom(i,k) = 0.0_r8 + endif + end if - deallocate( & - naer2, & - maerosol) + end if ! cam7 + end if freezing + end do iloop + end do kloop + if (.not. clim_modal_aero) then + deallocate( & + naer2, & + maerosol) end if - call outfld('NIHF', nihf, pcols, lchnk) - call outfld('NIIMM', niimm, pcols, lchnk) - call outfld('NIDEP', nidep, pcols, lchnk) - call outfld('NIMEY', nimey, pcols, lchnk) + if (cam_physpkg_is("cam7")) then + ! Updates for PUMAS v1.21+ + call outfld('NIHFTEN', nihf, pcols, lchnk) + call outfld('NIIMMTEN', niimm, pcols, lchnk) + call outfld('NIDEPTEN', nidep, pcols, lchnk) + call outfld('NIMEYTEN', nimey, pcols, lchnk) + else + call outfld('NIHF', nihf, pcols, lchnk) + call outfld('NIIMM', niimm, pcols, lchnk) + call outfld('NIDEP', nidep, pcols, lchnk) + call outfld('NIMEY', nimey, pcols, lchnk) + end if call outfld('NIREGM', regm, pcols, lchnk) call outfld('NISUBGRID', subgrid, pcols, lchnk) call outfld('NITROP_PD', trop_pd, pcols, lchnk) @@ -849,12 +884,22 @@ subroutine nucleate_ice_cam_calc( & call outfld( 'fhom' , fhom, pcols, lchnk) call outfld( 'WICE' , wice, pcols, lchnk) call outfld( 'WEFF' , weff, pcols, lchnk) - call outfld('INnso4 ',INnso4 , pcols,lchnk) - call outfld('INnbc ',INnbc , pcols,lchnk) - call outfld('INndust ',INndust, pcols,lchnk) - call outfld('INondust ',INondust, pcols,lchnk) - call outfld('INhet ',INhet , pcols,lchnk) - call outfld('INhom ',INhom , pcols,lchnk) + if (cam_physpkg_is("cam7")) then + ! Updates for PUMAS v1.21+ + call outfld('INnso4TEN',INnso4 , pcols,lchnk) + call outfld('INnbcTEN',INnbc , pcols,lchnk) + call outfld('INndustTEN',INndust, pcols,lchnk) + call outfld('INondustTEN',INondust, pcols,lchnk) + call outfld('INhetTEN',INhet , pcols,lchnk) + call outfld('INhomTEN',INhom , pcols,lchnk) + else + call outfld('INnso4 ',INnso4 , pcols,lchnk) + call outfld('INnbc ',INnbc , pcols,lchnk) + call outfld('INndust ',INndust, pcols,lchnk) + call outfld('INondust ',INondust, pcols,lchnk) + call outfld('INhet ',INhet , pcols,lchnk) + call outfld('INhom ',INhom , pcols,lchnk) + end if call outfld('INFrehom',INFrehom,pcols,lchnk) call outfld('INFreIN ',INFreIN, pcols,lchnk) end if diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 20b3789f68..ced2ef57d2 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -2,43 +2,43 @@ module nudging !===================================================================== ! ! Purpose: Implement Nudging of the model state of U,V,T,Q, and/or PS -! toward specified values from analyses. +! toward specified values from analyses. ! ! Author: Patrick Callaghan ! ! Description: -! -! This module assumes that the user has {U,V,T,Q,PS} values from analyses -! which have been preprocessed onto the current model grid and adjusted -! for differences in topography. It is also assumed that these resulting -! values and are stored in individual files which are indexed with respect -! to year, month, day, and second of the day. When the model is inbetween -! the given begining and ending times, a relaxation forcing is added to -! nudge the model toward the analyses values determined from the forcing -! option specified. After the model passes the ending analyses time, the +! +! This module assumes that the user has {U,V,T,Q,PS} values from analyses +! which have been preprocessed onto the current model grid and adjusted +! for differences in topography. It is also assumed that these resulting +! values and are stored in individual files which are indexed with respect +! to year, month, day, and second of the day. When the model is inbetween +! the given begining and ending times, a relaxation forcing is added to +! nudge the model toward the analyses values determined from the forcing +! option specified. After the model passes the ending analyses time, the ! forcing discontinues. ! ! Some analyses products can have gaps in the available data, where values -! are missing for some interval of time. When files are missing, the nudging +! are missing for some interval of time. When files are missing, the nudging ! force is switched off for that interval of time, so we effectively 'coast' -! thru the gap. +! thru the gap. ! ! Currently, the nudging module is set up to accomodate nudging of PS ! values, however that functionality requires forcing that is applied in -! the selected dycore and is not yet implemented. +! the selected dycore and is not yet implemented. ! -! The nudging of the model toward the analyses data is controlled by +! The nudging of the model toward the analyses data is controlled by ! the 'nudging_nl' namelist in 'user_nl_cam'; whose variables control the ! time interval over which nudging is applied, the strength of the nudging -! tendencies, and its spatial distribution. +! tendencies, and its spatial distribution. ! ! FORCING: ! -------- ! Nudging tendencies are applied as a relaxation force between the current ! model state values and target state values derived from the avalilable ! analyses. The form of the target values is selected by the 'Nudge_Force_Opt' -! option, the timescale of the forcing is determined from the given -! 'Nudge_TimeScale_Opt', and the nudging strength Alpha=[0.,1.] for each +! option, the timescale of the forcing is determined from the given +! 'Nudge_TimeScale_Opt', and the nudging strength Alpha=[0.,1.] for each ! variable is specified by the 'Nudge_Xcoef' values. Where X={U,V,T,Q,PS} ! ! F_nudge = Alpha*((Target-Model(t_curr))/TimeScale @@ -46,41 +46,41 @@ module nudging ! ! WINDOWING: ! ---------- -! The region of applied nudging can be limited using Horizontal/Vertical -! window functions that are constructed using a parameterization of the -! Heaviside step function. +! The region of applied nudging can be limited using Horizontal/Vertical +! window functions that are constructed using a parameterization of the +! Heaviside step function. ! -! The Heaviside window function is the product of separate horizonal and vertical +! The Heaviside window function is the product of separate horizonal and vertical ! windows that are controled via 12 parameters: ! -! Nudge_Hwin_lat0: Specify the horizontal center of the window in degrees. -! Nudge_Hwin_lon0: The longitude must be in the range [0,360] and the +! Nudge_Hwin_lat0: Specify the horizontal center of the window in degrees. +! Nudge_Hwin_lon0: The longitude must be in the range [0,360] and the ! latitude should be [-90,+90]. -! Nudge_Hwin_latWidth: Specify the lat and lon widths of the window as positive -! Nudge_Hwin_lonWidth: values in degrees.Setting a width to a large value (e.g. 999) +! Nudge_Hwin_latWidth: Specify the lat and lon widths of the window as positive +! Nudge_Hwin_lonWidth: values in degrees.Setting a width to a large value (e.g. 999) ! renders the window a constant in that direction. -! Nudge_Hwin_latDelta: Controls the sharpness of the window transition with a -! Nudge_Hwin_lonDelta: length in degrees. Small non-zero values yeild a step +! Nudge_Hwin_latDelta: Controls the sharpness of the window transition with a +! Nudge_Hwin_lonDelta: length in degrees. Small non-zero values yeild a step ! function while a large value yeilds a smoother transition. -! Nudge_Hwin_Invert : A logical flag used to invert the horizontal window function +! Nudge_Hwin_Invert : A logical flag used to invert the horizontal window function ! to get its compliment.(e.g. to nudge outside a given window). ! -! Nudge_Vwin_Lindex: In the vertical, the window is specified in terms of model -! Nudge_Vwin_Ldelta: level indcies. The High and Low transition levels should -! Nudge_Vwin_Hindex: range from [0,(NLEV+1)]. The transition lengths are also -! Nudge_Vwin_Hdelta: specified in terms of model indices. For a window function +! Nudge_Vwin_Lindex: In the vertical, the window is specified in terms of model +! Nudge_Vwin_Ldelta: level indcies. The High and Low transition levels should +! Nudge_Vwin_Hindex: range from [0,(NLEV+1)]. The transition lengths are also +! Nudge_Vwin_Hdelta: specified in terms of model indices. For a window function ! constant in the vertical, the Low index should be set to 0, -! the High index should be set to (NLEV+1), and the transition -! lengths should be set to 0.001 -! Nudge_Vwin_Invert : A logical flag used to invert the vertical window function +! the High index should be set to (NLEV+1), and the transition +! lengths should be set to 0.001 +! Nudge_Vwin_Invert : A logical flag used to invert the vertical window function ! to get its compliment. ! -! EXAMPLE: For a channel window function centered at the equator and independent +! EXAMPLE: For a channel window function centered at the equator and independent ! of the vertical (30 levels): ! Nudge_Hwin_lat0 = 0. Nudge_Vwin_Lindex = 0. ! Nudge_Hwin_latWidth = 30. Nudge_Vwin_Ldelta = 0.001 ! Nudge_Hwin_latDelta = 5.0 Nudge_Vwin_Hindex = 31. -! Nudge_Hwin_lon0 = 180. Nudge_Vwin_Hdelta = 0.001 +! Nudge_Hwin_lon0 = 180. Nudge_Vwin_Hdelta = 0.001 ! Nudge_Hwin_lonWidth = 999. Nudge_Vwin_Invert = .false. ! Nudge_Hwin_lonDelta = 1.0 ! Nudge_Hwin_Invert = .false. @@ -89,18 +89,18 @@ module nudging ! not at the equator, the settings would be similar but with: ! Nudge_Hwin_Invert = .true. ! -! A user can preview the window resulting from a given set of namelist values before -! running the model. Lookat_NudgeWindow.ncl is a script avalable in the tools directory +! A user can preview the window resulting from a given set of namelist values before +! running the model. Lookat_NudgeWindow.ncl is a script avalable in the tools directory ! which will read in the values for a given namelist and display the resulting window. ! -! The module is currently configured for only 1 window function. It can readily be +! The module is currently configured for only 1 window function. It can readily be ! extended for multiple windows if the need arises. ! ! ! Input/Output Values: -! Forcing contributions are available for history file output by +! Forcing contributions are available for history file output by ! the names: {'Nudge_U','Nudge_V','Nudge_T',and 'Nudge_Q'} -! The target values that the model state is nudged toward are available for history +! The target values that the model state is nudged toward are available for history ! file output via the variables: {'Target_U','Target_V','Target_T',and 'Target_Q'} ! ! &nudging_nl @@ -120,9 +120,9 @@ module nudging ! 4 --> 6 hourly analyses. ! 8 --> 3 hourly. ! -! Model_Times_Per_Day - INT Number of times to update the model state (used for nudging) -! each day. The value is restricted to be longer than the -! current model timestep and shorter than the analyses +! Model_Times_Per_Day - INT Number of times to update the model state (used for nudging) +! each day. The value is restricted to be longer than the +! current model timestep and shorter than the analyses ! timestep. As this number is increased, the nudging ! force has the form of newtonian cooling. ! 48 --> 1800 Second timestep. @@ -135,8 +135,8 @@ module nudging ! Nudge_End_Month - INT nudging ending month. [1-12] ! Nudge_End_Day - INT nudging ending day. [1-31] ! -! Nudge_Force_Opt - INT Index to select the nudging Target for a relaxation -! forcing of the form: +! Nudge_Force_Opt - INT Index to select the nudging Target for a relaxation +! forcing of the form: ! where (t'==Analysis times ; t==Model Times) ! ! 0 -> NEXT-OBS: Target=Anal(t'_next) [DEFAULT] @@ -144,7 +144,7 @@ module nudging ! F =(t'_next - t_curr )/Tdlt_Anal ! ! Nudge_TimeScale_Opt - INT Index to select the timescale for nudging. -! where (t'==Analysis times ; t==Model Times) +! where (t'==Analysis times ; t==Model Times) ! ! 0 --> TimeScale = 1/Tdlt_Anal [DEFAULT] ! 1 --> TimeScale = 1/(t'_next - t_curr ) @@ -160,15 +160,15 @@ module nudging ! 1 == CONSTANT (Spatially Uniform Nudging) ! 2 == HEAVISIDE WINDOW FUNCTION ! -! Nudge_Ucoef - REAL fractional nudging coeffcient for U. -! Nudge_Vcoef - REAL fractional nudging coeffcient for V. -! Nudge_Tcoef - REAL fractional nudging coeffcient for T. -! Nudge_Qcoef - REAL fractional nudging coeffcient for Q. -! Nudge_PScoef - REAL fractional nudging coeffcient for PS. +! Nudge_Ucoef - REAL fractional nudging coeffcient for U. +! Nudge_Vcoef - REAL fractional nudging coeffcient for V. +! Nudge_Tcoef - REAL fractional nudging coeffcient for T. +! Nudge_Qcoef - REAL fractional nudging coeffcient for Q. +! Nudge_PScoef - REAL fractional nudging coeffcient for PS. ! -! The strength of the nudging is specified as a fractional +! The strength of the nudging is specified as a fractional ! coeffcient between [0,1]. -! +! ! Nudge_Hwin_lat0 - REAL latitudinal center of window in degrees. ! Nudge_Hwin_lon0 - REAL longitudinal center of window in degrees. ! Nudge_Hwin_latWidth - REAL latitudinal width of window in degrees. @@ -179,8 +179,8 @@ module nudging ! TRUE = value=0 inside the specified window, 1 outside ! Nudge_Vwin_Lindex - REAL LO model index of transition ! Nudge_Vwin_Hindex - REAL HI model index of transition -! Nudge_Vwin_Ldelta - REAL LO transition length -! Nudge_Vwin_Hdelta - REAL HI transition length +! Nudge_Vwin_Ldelta - REAL LO transition length +! Nudge_Vwin_Hdelta - REAL HI transition length ! Nudge_Vwin_Invert - LOGICAL FALSE= value=1 inside the specified window, 0 outside ! TRUE = value=0 inside the specified window, 1 outside ! / @@ -190,100 +190,106 @@ module nudging ! TO DO: ! ----------- ! ** Implement Ps Nudging???? -! +! !===================================================================== ! Useful modules !------------------ - use shr_kind_mod, only:r8=>SHR_KIND_R8,cs=>SHR_KIND_CS,cl=>SHR_KIND_CL - use time_manager, only:timemgr_time_ge,timemgr_time_inc,get_curr_date,get_step_size - use phys_grid , only:scatter_field_to_chunk - use cam_abortutils, only:endrun - use spmd_utils , only:masterproc - use cam_logfile , only:iulog -#ifdef SPMD - use mpishorthand -#endif - - ! Set all Global values and routines to private by default + use shr_kind_mod, only: r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL + use time_manager, only: timemgr_time_ge, timemgr_time_inc, get_curr_date + use time_manager, only: get_step_size + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc, mstrid=>masterprocid, mpicom, mpi_success + use spmd_utils, only: mpi_integer, mpi_real8, mpi_logical, mpi_character + use cam_logfile, only: iulog + use zonal_mean_mod, only: ZonalMean_t + + ! Set all Global values and routines to private by default ! and then explicitly set their exposure. !---------------------------------------------------------- implicit none private - public:: Nudge_Model,Nudge_ON - public:: nudging_readnl - public:: nudging_init - public:: nudging_timestep_init - public:: nudging_timestep_tend - private::nudging_update_analyses_se - private::nudging_update_analyses_eul - private::nudging_update_analyses_fv - private::nudging_set_PSprofile - private::nudging_set_profile - private::calc_DryStaticEnergy + public :: Nudge_Model,Nudge_ON + public :: nudging_readnl + public :: nudging_init + public :: nudging_timestep_init + public :: nudging_timestep_tend + private :: nudging_update_analyses + private :: nudging_set_PSprofile + private :: nudging_set_profile + private :: calc_DryStaticEnergy + public :: nudging_final ! Nudging Parameters !-------------------- - logical :: Nudge_Model =.false. - logical :: Nudge_ON =.false. - logical :: Nudge_Initialized =.false. - character(len=cl):: Nudge_Path - character(len=cs):: Nudge_File,Nudge_File_Template - integer :: Nudge_Force_Opt - integer :: Nudge_TimeScale_Opt - integer :: Nudge_TSmode - integer :: Nudge_Times_Per_Day - integer :: Model_Times_Per_Day - real(r8) :: Nudge_Ucoef,Nudge_Vcoef - integer :: Nudge_Uprof,Nudge_Vprof - real(r8) :: Nudge_Qcoef,Nudge_Tcoef - integer :: Nudge_Qprof,Nudge_Tprof - real(r8) :: Nudge_PScoef - integer :: Nudge_PSprof - integer :: Nudge_Beg_Year ,Nudge_Beg_Month - integer :: Nudge_Beg_Day ,Nudge_Beg_Sec - integer :: Nudge_End_Year ,Nudge_End_Month - integer :: Nudge_End_Day ,Nudge_End_Sec - integer :: Nudge_Curr_Year,Nudge_Curr_Month - integer :: Nudge_Curr_Day ,Nudge_Curr_Sec - integer :: Nudge_Next_Year,Nudge_Next_Month - integer :: Nudge_Next_Day ,Nudge_Next_Sec - integer :: Nudge_Step - integer :: Model_Curr_Year,Model_Curr_Month - integer :: Model_Curr_Day ,Model_Curr_Sec - integer :: Model_Next_Year,Model_Next_Month - integer :: Model_Next_Day ,Model_Next_Sec - integer :: Model_Step - real(r8) :: Nudge_Hwin_lat0 - real(r8) :: Nudge_Hwin_latWidth - real(r8) :: Nudge_Hwin_latDelta - real(r8) :: Nudge_Hwin_lon0 - real(r8) :: Nudge_Hwin_lonWidth - real(r8) :: Nudge_Hwin_lonDelta - logical :: Nudge_Hwin_Invert = .false. - real(r8) :: Nudge_Hwin_lo - real(r8) :: Nudge_Hwin_hi - real(r8) :: Nudge_Vwin_Hindex - real(r8) :: Nudge_Vwin_Hdelta - real(r8) :: Nudge_Vwin_Lindex - real(r8) :: Nudge_Vwin_Ldelta - logical :: Nudge_Vwin_Invert =.false. - real(r8) :: Nudge_Vwin_lo - real(r8) :: Nudge_Vwin_hi - real(r8) :: Nudge_Hwin_latWidthH - real(r8) :: Nudge_Hwin_lonWidthH - real(r8) :: Nudge_Hwin_max - real(r8) :: Nudge_Hwin_min + logical :: Nudge_Model =.false. + logical :: Nudge_ON =.false. + logical :: Nudge_Initialized =.false. + character(len=cl) :: Nudge_Path + character(len=cs) :: Nudge_File,Nudge_File_Template + integer :: Nudge_Force_Opt + integer :: Nudge_TimeScale_Opt + integer :: Nudge_TSmode + integer :: Nudge_Times_Per_Day + integer :: Model_Times_Per_Day + real(r8) :: Nudge_Ucoef,Nudge_Vcoef + integer :: Nudge_Uprof,Nudge_Vprof + real(r8) :: Nudge_Qcoef,Nudge_Tcoef + integer :: Nudge_Qprof,Nudge_Tprof + real(r8) :: Nudge_PScoef + integer :: Nudge_PSprof + integer :: Nudge_Beg_Year ,Nudge_Beg_Month + integer :: Nudge_Beg_Day ,Nudge_Beg_Sec + integer :: Nudge_End_Year ,Nudge_End_Month + integer :: Nudge_End_Day ,Nudge_End_Sec + integer :: Nudge_Curr_Year,Nudge_Curr_Month + integer :: Nudge_Curr_Day ,Nudge_Curr_Sec + integer :: Nudge_Next_Year,Nudge_Next_Month + integer :: Nudge_Next_Day ,Nudge_Next_Sec + integer :: Nudge_Step + integer :: Model_Curr_Year,Model_Curr_Month + integer :: Model_Curr_Day ,Model_Curr_Sec + integer :: Model_Next_Year,Model_Next_Month + integer :: Model_Next_Day ,Model_Next_Sec + integer :: Model_Step + real(r8) :: Nudge_Hwin_lat0 + real(r8) :: Nudge_Hwin_latWidth + real(r8) :: Nudge_Hwin_latDelta + real(r8) :: Nudge_Hwin_lon0 + real(r8) :: Nudge_Hwin_lonWidth + real(r8) :: Nudge_Hwin_lonDelta + logical :: Nudge_Hwin_Invert = .false. + real(r8) :: Nudge_Hwin_lo + real(r8) :: Nudge_Hwin_hi + real(r8) :: Nudge_Vwin_Hindex + real(r8) :: Nudge_Vwin_Hdelta + real(r8) :: Nudge_Vwin_Lindex + real(r8) :: Nudge_Vwin_Ldelta + logical :: Nudge_Vwin_Invert =.false. + real(r8) :: Nudge_Vwin_lo + real(r8) :: Nudge_Vwin_hi + real(r8) :: Nudge_Hwin_latWidthH + real(r8) :: Nudge_Hwin_lonWidthH + real(r8) :: Nudge_Hwin_max + real(r8) :: Nudge_Hwin_min + + ! Nudging Zonal Filter variables + !--------------------------------- + logical :: Nudge_ZonalFilter =.false. + integer :: Nudge_ZonalNbasis = -1 + type(ZonalMean_t) :: ZM + real(r8),allocatable:: Zonal_Bamp2d(:) + real(r8),allocatable:: Zonal_Bamp3d(:,:) ! Nudging State Arrays !----------------------- - integer Nudge_nlon,Nudge_nlat,Nudge_ncol,Nudge_nlev - real(r8),allocatable::Target_U (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable::Target_V (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable::Target_T (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable::Target_S (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable::Target_Q (:,:,:) !(pcols,pver,begchunk:endchunk) - real(r8),allocatable::Target_PS (:,:) !(pcols,begchunk:endchunk) + integer :: Nudge_nlon,Nudge_nlat,Nudge_ncol,Nudge_nlev + real(r8),allocatable:: Target_U (:,:,:) !(pcols,pver,begchunk:endchunk) + real(r8),allocatable:: Target_V (:,:,:) !(pcols,pver,begchunk:endchunk) + real(r8),allocatable:: Target_T (:,:,:) !(pcols,pver,begchunk:endchunk) + real(r8),allocatable:: Target_S (:,:,:) !(pcols,pver,begchunk:endchunk) + real(r8),allocatable:: Target_Q (:,:,:) !(pcols,pver,begchunk:endchunk) + real(r8),allocatable:: Target_PS (:,:) !(pcols,begchunk:endchunk) real(r8),allocatable:: Model_U (:,:,:) !(pcols,pver,begchunk:endchunk) real(r8),allocatable:: Model_V (:,:,:) !(pcols,pver,begchunk:endchunk) real(r8),allocatable:: Model_T (:,:,:) !(pcols,pver,begchunk:endchunk) @@ -303,7 +309,7 @@ module nudging ! Nudging Observation Arrays !----------------------------- - integer Nudge_NumObs + integer :: Nudge_NumObs integer,allocatable:: Nudge_ObsInd(:) logical ,allocatable::Nudge_File_Present(:) real(r8),allocatable::Nobs_U (:,:,:,:) !(pcols,pver,begchunk:endchunk,Nudge_NumObs) @@ -315,41 +321,45 @@ module nudging contains !================================================================ subroutine nudging_readnl(nlfile) - ! - ! NUDGING_READNL: Initialize default values controlling the Nudging - ! process. Then read namelist values to override + ! + ! NUDGING_READNL: Initialize default values controlling the Nudging + ! process. Then read namelist values to override ! them. !=============================================================== - use ppgrid ,only: pver - use namelist_utils,only:find_group_name - use units ,only:getunit,freeunit + use ppgrid, only: pver + use namelist_utils, only:find_group_name ! ! Arguments !------------- - character(len=*),intent(in)::nlfile + character(len=*), intent(in) :: nlfile ! ! Local Values !--------------- - integer ierr,unitn - - namelist /nudging_nl/ Nudge_Model,Nudge_Path, & - Nudge_File_Template,Nudge_Force_Opt, & - Nudge_TimeScale_Opt, & - Nudge_Times_Per_Day,Model_Times_Per_Day, & - Nudge_Ucoef ,Nudge_Uprof, & - Nudge_Vcoef ,Nudge_Vprof, & - Nudge_Qcoef ,Nudge_Qprof, & - Nudge_Tcoef ,Nudge_Tprof, & - Nudge_PScoef,Nudge_PSprof, & - Nudge_Beg_Year,Nudge_Beg_Month,Nudge_Beg_Day, & - Nudge_End_Year,Nudge_End_Month,Nudge_End_Day, & - Nudge_Hwin_lat0,Nudge_Hwin_lon0, & - Nudge_Hwin_latWidth,Nudge_Hwin_lonWidth, & - Nudge_Hwin_latDelta,Nudge_Hwin_lonDelta, & - Nudge_Hwin_Invert, & - Nudge_Vwin_Lindex,Nudge_Vwin_Hindex, & - Nudge_Vwin_Ldelta,Nudge_Vwin_Hdelta, & - Nudge_Vwin_Invert + integer :: ierr, unitn + + character(len=*), parameter :: prefix = 'nudging_readnl: ' + + namelist /nudging_nl/ Nudge_Model, Nudge_Path, & + Nudge_File_Template, Nudge_Force_Opt, & + Nudge_TimeScale_Opt, & + Nudge_Times_Per_Day, Model_Times_Per_Day, & + Nudge_Ucoef , Nudge_Uprof, & + Nudge_Vcoef , Nudge_Vprof, & + Nudge_Qcoef , Nudge_Qprof, & + Nudge_Tcoef , Nudge_Tprof, & + Nudge_PScoef, Nudge_PSprof, & + Nudge_Beg_Year, Nudge_Beg_Month, Nudge_Beg_Day, & + Nudge_End_Year, Nudge_End_Month, Nudge_End_Day, & + Nudge_Hwin_lat0, Nudge_Hwin_lon0, & + Nudge_Hwin_latWidth, Nudge_Hwin_lonWidth, & + Nudge_Hwin_latDelta, Nudge_Hwin_lonDelta, & + Nudge_Hwin_Invert, & + Nudge_Vwin_Lindex, Nudge_Vwin_Hindex, & + Nudge_Vwin_Ldelta, Nudge_Vwin_Hdelta, & + Nudge_Vwin_Invert + + ! For Zonal Mean Filtering + namelist /nudging_nl/ Nudge_ZonalFilter, Nudge_ZonalNbasis ! Nudging is NOT initialized yet, For now ! Nudging will always begin/end at midnight. @@ -405,54 +415,52 @@ subroutine nudging_readnl(nlfile) ! Read in namelist values !------------------------ if(masterproc) then - unitn = getunit() - open(unitn,file=trim(nlfile),status='old') - call find_group_name(unitn,'nudging_nl',status=ierr) - if(ierr.eq.0) then - read(unitn,nudging_nl,iostat=ierr) - if(ierr.ne.0) then - call endrun('nudging_readnl:: ERROR reading namelist') - endif - endif - close(unitn) - call freeunit(unitn) - endif + open(newunit=unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'nudging_nl', status=ierr) + if(ierr == 0) then + read(unitn,nudging_nl,iostat=ierr) + if(ierr /= 0) then + call endrun('nudging_readnl:: ERROR reading namelist') + end if + end if + close(unitn) + end if ! Set hi/lo values according to the given '_Invert' parameters !-------------------------------------------------------------- if(Nudge_Hwin_Invert) then - Nudge_Hwin_lo = 1.0_r8 - Nudge_Hwin_hi = 0.0_r8 + Nudge_Hwin_lo = 1.0_r8 + Nudge_Hwin_hi = 0.0_r8 else - Nudge_Hwin_lo = 0.0_r8 - Nudge_Hwin_hi = 1.0_r8 - endif + Nudge_Hwin_lo = 0.0_r8 + Nudge_Hwin_hi = 1.0_r8 + end if if(Nudge_Vwin_Invert) then - Nudge_Vwin_lo = 1.0_r8 - Nudge_Vwin_hi = 0.0_r8 + Nudge_Vwin_lo = 1.0_r8 + Nudge_Vwin_hi = 0.0_r8 else - Nudge_Vwin_lo = 0.0_r8 - Nudge_Vwin_hi = 1.0_r8 - endif + Nudge_Vwin_lo = 0.0_r8 + Nudge_Vwin_hi = 1.0_r8 + end if - ! Check for valid namelist values + ! Check for valid namelist values !---------------------------------- - if((Nudge_Hwin_lat0.lt.-90._r8).or.(Nudge_Hwin_lat0.gt.+90._r8)) then + if((Nudge_Hwin_lat0 < -90._r8) .or. (Nudge_Hwin_lat0 > +90._r8)) then write(iulog,*) 'NUDGING: Window lat0 must be in [-90,+90]' write(iulog,*) 'NUDGING: Nudge_Hwin_lat0=',Nudge_Hwin_lat0 call endrun('nudging_readnl:: ERROR in namelist') endif - if((Nudge_Hwin_lon0.lt.0._r8).or.(Nudge_Hwin_lon0.ge.360._r8)) then + if((Nudge_Hwin_lon0 < 0._r8) .or. (Nudge_Hwin_lon0 >= 360._r8)) then write(iulog,*) 'NUDGING: Window lon0 must be in [0,+360)' write(iulog,*) 'NUDGING: Nudge_Hwin_lon0=',Nudge_Hwin_lon0 call endrun('nudging_readnl:: ERROR in namelist') endif - if((Nudge_Vwin_Lindex.gt.Nudge_Vwin_Hindex) .or. & - (Nudge_Vwin_Hindex.gt.float(pver+1)).or.(Nudge_Vwin_Hindex.lt.0._r8).or. & - (Nudge_Vwin_Lindex.gt.float(pver+1)).or.(Nudge_Vwin_Lindex.lt.0._r8) ) then + if((Nudge_Vwin_Lindex > Nudge_Vwin_Hindex) .or. & + (Nudge_Vwin_Hindex > float(pver+1)) .or. (Nudge_Vwin_Hindex < 0._r8) .or. & + (Nudge_Vwin_Lindex > float(pver+1)) .or. (Nudge_Vwin_Lindex < 0._r8) ) then write(iulog,*) 'NUDGING: Window Lindex must be in [0,pver+1]' write(iulog,*) 'NUDGING: Window Hindex must be in [0,pver+1]' write(iulog,*) 'NUDGING: Lindex must be LE than Hindex' @@ -461,8 +469,8 @@ subroutine nudging_readnl(nlfile) call endrun('nudging_readnl:: ERROR in namelist') endif - if((Nudge_Hwin_latDelta.le.0._r8).or.(Nudge_Hwin_lonDelta.le.0._r8).or. & - (Nudge_Vwin_Hdelta .le.0._r8).or.(Nudge_Vwin_Ldelta .le.0._r8) ) then + if((Nudge_Hwin_latDelta <= 0._r8) .or. (Nudge_Hwin_lonDelta <= 0._r8) .or. & + (Nudge_Vwin_Hdelta <= 0._r8) .or. (Nudge_Vwin_Ldelta <= 0._r8) ) then write(iulog,*) 'NUDGING: Window Deltas must be positive' write(iulog,*) 'NUDGING: Nudge_Hwin_latDelta=',Nudge_Hwin_latDelta write(iulog,*) 'NUDGING: Nudge_Hwin_lonDelta=',Nudge_Hwin_lonDelta @@ -472,7 +480,7 @@ subroutine nudging_readnl(nlfile) endif - if((Nudge_Hwin_latWidth.le.0._r8).or.(Nudge_Hwin_lonWidth.le.0._r8)) then + if((Nudge_Hwin_latWidth <= 0._r8) .or. (Nudge_Hwin_lonWidth <= 0._r8)) then write(iulog,*) 'NUDGING: Window widths must be positive' write(iulog,*) 'NUDGING: Nudge_Hwin_latWidth=',Nudge_Hwin_latWidth write(iulog,*) 'NUDGING: Nudge_Hwin_lonWidth=',Nudge_Hwin_lonWidth @@ -481,63 +489,111 @@ subroutine nudging_readnl(nlfile) ! Broadcast namelist variables !------------------------------ -#ifdef SPMD - call mpibcast(Nudge_Path ,len(Nudge_Path) ,mpichar,0,mpicom) - call mpibcast(Nudge_File_Template,len(Nudge_File_Template),mpichar,0,mpicom) - call mpibcast(Nudge_Model , 1, mpilog, 0, mpicom) - call mpibcast(Nudge_Initialized , 1, mpilog, 0, mpicom) - call mpibcast(Nudge_ON , 1, mpilog, 0, mpicom) - call mpibcast(Nudge_Force_Opt , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_TimeScale_Opt, 1, mpiint, 0, mpicom) - call mpibcast(Nudge_TSmode , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Times_Per_Day, 1, mpiint, 0, mpicom) - call mpibcast(Model_Times_Per_Day, 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Ucoef , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vcoef , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Tcoef , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Qcoef , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_PScoef , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Uprof , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Vprof , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Tprof , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Qprof , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_PSprof , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Beg_Year , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Beg_Month , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Beg_Day , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Beg_Sec , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_End_Year , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_End_Month , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_End_Day , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_End_Sec , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Hwin_lo , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_hi , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_lat0 , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_latWidth, 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_latDelta, 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_lon0 , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_lonWidth, 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_lonDelta, 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_Invert, 1, mpilog, 0, mpicom) - call mpibcast(Nudge_Vwin_lo , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vwin_hi , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vwin_Hindex , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vwin_Hdelta , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vwin_Lindex , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vwin_Ldelta , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Vwin_Invert, 1, mpilog, 0, mpicom) -#endif + call MPI_bcast(Nudge_Path , len(Nudge_Path), & + mpi_character, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Path ') + call MPI_bcast(Nudge_File_Template,len(Nudge_File_Template), & + mpi_character, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_File_Template') + call MPI_bcast(Nudge_Model , 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Model') + call MPI_bcast(Nudge_Initialized , 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Initialized') + call MPI_bcast(Nudge_ON , 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ON') + call MPI_bcast(Nudge_Force_Opt , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Force_Opt') + call MPI_bcast(Nudge_TimeScale_Opt, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_TimeScale_Opt') + call MPI_bcast(Nudge_TSmode , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_TSmode') + call MPI_bcast(Nudge_Times_Per_Day, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Times_Per_Day') + call MPI_bcast(Model_Times_Per_Day, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Times_Per_Day') + call MPI_bcast(Nudge_Ucoef , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Ucoef') + call MPI_bcast(Nudge_Vcoef , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vcoef') + call MPI_bcast(Nudge_Tcoef , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Tcoef') + call MPI_bcast(Nudge_Qcoef , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Qcoef') + call MPI_bcast(Nudge_PScoef , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_PScoef') + call MPI_bcast(Nudge_Uprof , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Uprof') + call MPI_bcast(Nudge_Vprof , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vprof') + call MPI_bcast(Nudge_Tprof , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Tprof') + call MPI_bcast(Nudge_Qprof , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Qprof') + call MPI_bcast(Nudge_PSprof , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_PSprof') + call MPI_bcast(Nudge_Beg_Year , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Year') + call MPI_bcast(Nudge_Beg_Month , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Month') + call MPI_bcast(Nudge_Beg_Day , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Day') + call MPI_bcast(Nudge_Beg_Sec , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Beg_Sec') + call MPI_bcast(Nudge_End_Year , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Year') + call MPI_bcast(Nudge_End_Month , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Month') + call MPI_bcast(Nudge_End_Day , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Day') + call MPI_bcast(Nudge_End_Sec , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_End_Sec') + call MPI_bcast(Nudge_Hwin_lo , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lo') + call MPI_bcast(Nudge_Hwin_hi , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_hi') + call MPI_bcast(Nudge_Hwin_lat0 , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lat0') + call MPI_bcast(Nudge_Hwin_latWidth, 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_latWidth') + call MPI_bcast(Nudge_Hwin_latDelta, 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_latDelta') + call MPI_bcast(Nudge_Hwin_lon0 , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lon0') + call MPI_bcast(Nudge_Hwin_lonWidth, 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lonWidth') + call MPI_bcast(Nudge_Hwin_lonDelta, 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lonDelta') + call MPI_bcast(Nudge_Hwin_Invert, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_Invert') + call MPI_bcast(Nudge_Vwin_lo , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_lo') + call MPI_bcast(Nudge_Vwin_hi , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_hi') + call MPI_bcast(Nudge_Vwin_Hindex , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Hindex') + call MPI_bcast(Nudge_Vwin_Hdelta , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Hdelta') + call MPI_bcast(Nudge_Vwin_Lindex , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Lindex') + call MPI_bcast(Nudge_Vwin_Ldelta , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Ldelta') + call MPI_bcast(Nudge_Vwin_Invert, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Vwin_Invert') + call MPI_bcast(Nudge_ZonalFilter, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ZonalFilter') + call MPI_bcast(Nudge_ZonalNbasis, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ZonalNbasis') ! End Routine !------------ - return - end subroutine ! nudging_readnl + + end subroutine nudging_readnl !================================================================ !================================================================ subroutine nudging_init - ! + ! ! NUDGING_INIT: Allocate space and initialize Nudging values !=============================================================== use ppgrid ,only: pver,pcols,begchunk,endchunk @@ -551,19 +607,22 @@ subroutine nudging_init ! Local values !---------------- - integer Year,Month,Day,Sec - integer YMD1,YMD - logical After_Beg,Before_End - integer istat,lchnk,ncol,icol,ilev - integer hdim1_d,hdim2_d - integer dtime - real(r8) rlat,rlon - real(r8) Wprof(pver) - real(r8) lonp,lon0,lonn,latp,lat0,latn - real(r8) Val1_p,Val2_p,Val3_p,Val4_p - real(r8) Val1_0,Val2_0,Val3_0,Val4_0 - real(r8) Val1_n,Val2_n,Val3_n,Val4_n - integer nn + integer :: Year,Month,Day,Sec + integer :: YMD1,YMD + logical :: After_Beg,Before_End + integer :: istat,lchnk,ncol,icol,ilev + integer :: hdim1_d,hdim2_d + integer :: ierr + integer :: dtime + real(r8) :: rlat,rlon + real(r8) :: Wprof(pver) + real(r8) :: lonp,lon0,lonn,latp,lat0,latn + real(r8) :: Val1_p,Val2_p,Val3_p,Val4_p + real(r8) :: Val1_0,Val2_0,Val3_0,Val4_0 + real(r8) :: Val1_n,Val2_n,Val3_n,Val4_n + integer :: nn + + character(len=*), parameter :: prefix = 'nudging_init: ' ! Get the time step size !------------------------ @@ -597,7 +656,7 @@ subroutine nudging_init allocate(Model_PS(pcols,begchunk:endchunk),stat=istat) call alloc_err(istat,'nudging_init','Model_PS',pcols*((endchunk-begchunk)+1)) - ! Allocate Space for spatial dependence of + ! Allocate Space for spatial dependence of ! Nudging Coefs and Nudging Forcing. !------------------------------------------- allocate(Nudge_Utau(pcols,pver,begchunk:endchunk),stat=istat) @@ -644,14 +703,14 @@ subroutine nudging_init !-------------------------------------------------------- Model_Step=86400/Model_Times_Per_Day Nudge_Step=86400/Nudge_Times_Per_Day - if(Model_Step.lt.dtime) then + if(Model_Step < dtime) then write(iulog,*) ' ' write(iulog,*) 'NUDGING: Model_Step cannot be less than a model timestep' write(iulog,*) 'NUDGING: Setting Model_Step=dtime , dtime=',dtime write(iulog,*) ' ' Model_Step=dtime endif - if(Model_Step.gt.Nudge_Step) then + if(Model_Step > Nudge_Step) then write(iulog,*) ' ' write(iulog,*) 'NUDGING: Model_Step cannot be more than Nudge_Step' write(iulog,*) 'NUDGING: Setting Model_Step=Nudge_Step, Nudge_Step=',Nudge_Step @@ -672,14 +731,14 @@ subroutine nudging_init call get_curr_date(Year,Month,Day,Sec) YMD=(Year*10000) + (Month*100) + Day YMD1=(Nudge_Beg_Year*10000) + (Nudge_Beg_Month*100) + Nudge_Beg_Day - call timemgr_time_ge(YMD1,Nudge_Beg_Sec, & + call timemgr_time_ge(YMD1,Nudge_Beg_Sec, & YMD ,Sec ,After_Beg) YMD1=(Nudge_End_Year*10000) + (Nudge_End_Month*100) + Nudge_End_Day - call timemgr_time_ge(YMD ,Sec , & + call timemgr_time_ge(YMD ,Sec , & YMD1,Nudge_End_Sec,Before_End) - - if((After_Beg).and.(Before_End)) then - ! Set Time indicies so that the next call to + + if((After_Beg) .and. (Before_End)) then + ! Set Time indicies so that the next call to ! timestep_init will initialize the data arrays. !-------------------------------------------- Model_Next_Year =Year @@ -713,7 +772,7 @@ subroutine nudging_init write(iulog,*) ' ' endif - ! Initialize values for window function + ! Initialize values for window function !---------------------------------------- lonp= 180._r8 lon0= 0._r8 @@ -721,7 +780,7 @@ subroutine nudging_init latp= 90._r8-Nudge_Hwin_lat0 lat0= 0._r8 latn= -90._r8-Nudge_Hwin_lat0 - + Nudge_Hwin_lonWidthH=Nudge_Hwin_lonWidth/2._r8 Nudge_Hwin_latWidthH=Nudge_Hwin_latWidth/2._r8 @@ -740,15 +799,15 @@ subroutine nudging_init Val4_n=(1._r8+tanh((Nudge_Hwin_latWidthH-latn)/Nudge_Hwin_latDelta))/2._r8 Nudge_Hwin_max= Val1_0*Val2_0*Val3_0*Val4_0 - Nudge_Hwin_min=min((Val1_p*Val2_p*Val3_n*Val4_n), & - (Val1_p*Val2_p*Val3_p*Val4_p), & - (Val1_n*Val2_n*Val3_n*Val4_n), & + Nudge_Hwin_min=min((Val1_p*Val2_p*Val3_n*Val4_n), & + (Val1_p*Val2_p*Val3_p*Val4_p), & + (Val1_n*Val2_n*Val3_n*Val4_n), & (Val1_n*Val2_n*Val3_p*Val4_p)) ! Initialize number of nudging observation values to keep track of. - ! Allocate and initialize observation indices + ! Allocate and initialize observation indices !----------------------------------------------------------------- - if((Nudge_Force_Opt.ge.0).and.(Nudge_Force_Opt.le.1)) then + if((Nudge_Force_Opt >= 0) .and. (Nudge_Force_Opt <= 1)) then Nudge_NumObs=2 else ! Additional Options may need OBS values at more times. @@ -765,19 +824,11 @@ subroutine nudging_init do nn=1,Nudge_NumObs Nudge_ObsInd(nn) = Nudge_NumObs+1-nn end do - Nudge_File_Present(:)=.false. + Nudge_File_Present(:) = .false. - ! Initialization is done, + ! Initialization is done, !-------------------------- - Nudge_Initialized=.true. - - ! Check that this is a valid DYCORE model - !------------------------------------------ - if((.not.dycore_is('UNSTRUCTURED')).and. & - (.not.dycore_is('EUL') ).and. & - (.not.dycore_is('LR') ) ) then - call endrun('NUDGING IS CURRENTLY ONLY CONFIGURED FOR CAM-SE, FV, or EUL') - endif + Nudge_Initialized = .true. ! Informational Output !--------------------------- @@ -788,13 +839,15 @@ subroutine nudging_init write(iulog,*) 'NUDGING: Nudge_Model=',Nudge_Model write(iulog,*) 'NUDGING: Nudge_Path=',Nudge_Path write(iulog,*) 'NUDGING: Nudge_File_Template =',Nudge_File_Template - write(iulog,*) 'NUDGING: Nudge_Force_Opt=',Nudge_Force_Opt - write(iulog,*) 'NUDGING: Nudge_TimeScale_Opt=',Nudge_TimeScale_Opt + write(iulog,*) 'NUDGING: Nudge_Force_Opt=',Nudge_Force_Opt + write(iulog,*) 'NUDGING: Nudge_TimeScale_Opt=',Nudge_TimeScale_Opt write(iulog,*) 'NUDGING: Nudge_TSmode=',Nudge_TSmode write(iulog,*) 'NUDGING: Nudge_Times_Per_Day=',Nudge_Times_Per_Day write(iulog,*) 'NUDGING: Model_Times_Per_Day=',Model_Times_Per_Day write(iulog,*) 'NUDGING: Nudge_Step=',Nudge_Step write(iulog,*) 'NUDGING: Model_Step=',Model_Step + write(iulog,*) 'NUDGING: Nudge_ZonalFilter=',Nudge_ZonalFilter + write(iulog,*) 'NUDGING: Nudge_ZonalNbasis=',Nudge_ZonalNbasis write(iulog,*) 'NUDGING: Nudge_Ucoef =',Nudge_Ucoef write(iulog,*) 'NUDGING: Nudge_Vcoef =',Nudge_Vcoef write(iulog,*) 'NUDGING: Nudge_Qcoef =',Nudge_Qcoef @@ -817,14 +870,14 @@ subroutine nudging_init write(iulog,*) 'NUDGING: Nudge_Hwin_lon0 =',Nudge_Hwin_lon0 write(iulog,*) 'NUDGING: Nudge_Hwin_lonWidth =',Nudge_Hwin_lonWidth write(iulog,*) 'NUDGING: Nudge_Hwin_lonDelta =',Nudge_Hwin_lonDelta - write(iulog,*) 'NUDGING: Nudge_Hwin_Invert =',Nudge_Hwin_Invert + write(iulog,*) 'NUDGING: Nudge_Hwin_Invert =',Nudge_Hwin_Invert write(iulog,*) 'NUDGING: Nudge_Hwin_lo =',Nudge_Hwin_lo write(iulog,*) 'NUDGING: Nudge_Hwin_hi =',Nudge_Hwin_hi write(iulog,*) 'NUDGING: Nudge_Vwin_Hindex =',Nudge_Vwin_Hindex write(iulog,*) 'NUDGING: Nudge_Vwin_Hdelta =',Nudge_Vwin_Hdelta write(iulog,*) 'NUDGING: Nudge_Vwin_Lindex =',Nudge_Vwin_Lindex write(iulog,*) 'NUDGING: Nudge_Vwin_Ldelta =',Nudge_Vwin_Ldelta - write(iulog,*) 'NUDGING: Nudge_Vwin_Invert =',Nudge_Vwin_Invert + write(iulog,*) 'NUDGING: Nudge_Vwin_Invert =',Nudge_Vwin_Invert write(iulog,*) 'NUDGING: Nudge_Vwin_lo =',Nudge_Vwin_lo write(iulog,*) 'NUDGING: Nudge_Vwin_hi =',Nudge_Vwin_hi write(iulog,*) 'NUDGING: Nudge_Hwin_latWidthH=',Nudge_Hwin_latWidthH @@ -840,30 +893,50 @@ subroutine nudging_init ! Broadcast other variables that have changed !--------------------------------------------- -#ifdef SPMD - call mpibcast(Model_Step , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Step , 1, mpir8 , 0, mpicom) - call mpibcast(Model_Next_Year , 1, mpiint, 0, mpicom) - call mpibcast(Model_Next_Month , 1, mpiint, 0, mpicom) - call mpibcast(Model_Next_Day , 1, mpiint, 0, mpicom) - call mpibcast(Model_Next_Sec , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Next_Year , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Next_Month , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Next_Day , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Next_Sec , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Model , 1, mpilog, 0, mpicom) - call mpibcast(Nudge_ON , 1, mpilog, 0, mpicom) - call mpibcast(Nudge_Initialized , 1, mpilog, 0, mpicom) - call mpibcast(Nudge_ncol , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_nlev , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_nlon , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_nlat , 1, mpiint, 0, mpicom) - call mpibcast(Nudge_Hwin_max , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_min , 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_lonWidthH, 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_Hwin_latWidthH, 1, mpir8 , 0, mpicom) - call mpibcast(Nudge_NumObs , 1, mpiint, 0, mpicom) -#endif + call MPI_bcast(Model_Step , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Step') + call MPI_bcast(Nudge_Step , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Step') + call MPI_bcast(Model_Next_Year , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Next_Year') + call MPI_bcast(Model_Next_Month , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Next_Month') + call MPI_bcast(Model_Next_Day , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Next_Day') + call MPI_bcast(Model_Next_Sec , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Model_Next_Sec') + call MPI_bcast(Nudge_Next_Year , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Next_Year') + call MPI_bcast(Nudge_Next_Month , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Next_Month') + call MPI_bcast(Nudge_Next_Day , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Next_Day') + call MPI_bcast(Nudge_Next_Sec , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Next_Sec') + call MPI_bcast(Nudge_Model , 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Model') + call MPI_bcast(Nudge_ON , 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ON') + call MPI_bcast(Nudge_Initialized , 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Initialized') + call MPI_bcast(Nudge_ncol , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ncol') + call MPI_bcast(Nudge_nlev , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_nlev') + call MPI_bcast(Nudge_nlon , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_nlon') + call MPI_bcast(Nudge_nlat , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_nlat') + call MPI_bcast(Nudge_Hwin_max , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_max') + call MPI_bcast(Nudge_Hwin_min , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_min') + call MPI_bcast(Nudge_Hwin_lonWidthH, 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_lonWidthH') + call MPI_bcast(Nudge_Hwin_latWidthH, 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_Hwin_latWidthH') + call MPI_bcast(Nudge_NumObs , 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_NumObs') ! All non-masterproc processes also need to allocate space ! before the broadcast of Nudge_NumObs dependent data. @@ -874,10 +947,11 @@ subroutine nudging_init allocate(Nudge_File_Present(Nudge_NumObs),stat=istat) call alloc_err(istat,'nudging_init','Nudge_File_Present',Nudge_NumObs) endif -#ifdef SPMD - call mpibcast(Nudge_ObsInd , Nudge_NumObs, mpiint, 0, mpicom) - call mpibcast(Nudge_File_Present , Nudge_NumObs, mpilog, 0, mpicom) -#endif + + call MPI_bcast(Nudge_ObsInd , Nudge_NumObs, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: ') + call MPI_bcast(Nudge_File_Present, Nudge_NumObs, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: ') ! Allocate Space for Nudging observation arrays, initialize with 0's !--------------------------------------------------------------------- @@ -911,6 +985,16 @@ subroutine nudging_init endif !!DIAG + ! Initialize the Zonal Mean type if needed + !------------------------------------------ + if(Nudge_ZonalFilter) then + call ZM%init(Nudge_ZonalNbasis) + allocate(Zonal_Bamp2d(Nudge_ZonalNbasis),stat=istat) + call alloc_err(istat,'nudging_init','Zonal_Bamp2d',Nudge_ZonalNbasis) + allocate(Zonal_Bamp3d(Nudge_ZonalNbasis,pver),stat=istat) + call alloc_err(istat,'nudging_init','Zonal_Bamp3d',Nudge_ZonalNbasis*pver) + endif + ! Initialize the analysis filename at the NEXT time for startup. !--------------------------------------------------------------- Nudge_File=interpret_filename_spec(Nudge_File_Template , & @@ -922,17 +1006,11 @@ subroutine nudging_init write(iulog,*) 'NUDGING: Reading analyses:',trim(Nudge_Path)//trim(Nudge_File) endif - ! Rotate Nudge_ObsInd() indices for new data, then update - ! the Nudge observation arrays with analysis data at the + ! Rotate Nudge_ObsInd() indices for new data, then update + ! the Nudge observation arrays with analysis data at the ! NEXT==Nudge_ObsInd(1) time. !---------------------------------------------------------- - if(dycore_is('UNSTRUCTURED')) then - call nudging_update_analyses_se (trim(Nudge_Path)//trim(Nudge_File)) - elseif(dycore_is('EUL')) then - call nudging_update_analyses_eul(trim(Nudge_Path)//trim(Nudge_File)) - else !if(dycore_is('LR')) then - call nudging_update_analyses_fv (trim(Nudge_Path)//trim(Nudge_File)) - endif + call nudging_update_analyses (trim(Nudge_Path)//trim(Nudge_File)) ! Initialize Nudging Coeffcient profiles in local arrays ! Load zeros into nudging arrays @@ -980,16 +1058,16 @@ subroutine nudging_init ! End Routine !------------ - return - end subroutine ! nudging_init + + end subroutine nudging_init !================================================================ !================================================================ subroutine nudging_timestep_init(phys_state) - ! - ! NUDGING_TIMESTEP_INIT: - ! Check the current time and update Model/Nudging + ! + ! NUDGING_TIMESTEP_INIT: + ! Check the current time and update Model/Nudging ! arrays when necessary. Toggle the Nudging flag ! when the time is withing the nudging window. !=============================================================== @@ -1007,22 +1085,22 @@ subroutine nudging_timestep_init(phys_state) ! Local values !---------------- - integer Year,Month,Day,Sec - integer YMD1,YMD2,YMD - logical Update_Model,Update_Nudge,Sync_Error - logical After_Beg ,Before_End - integer lchnk,ncol,indw - - type(ESMF_Time) Date1,Date2 - type(ESMF_TimeInterval) DateDiff - integer DeltaT - real(r8) Tscale - real(r8) Tfrac - integer rc - integer nn - integer kk - real(r8) Sbar,Qbar,Wsum - integer dtime + integer :: Year,Month,Day,Sec + integer :: YMD1,YMD2,YMD + logical :: Update_Model,Update_Nudge,Sync_Error + logical :: After_Beg ,Before_End + integer :: lchnk,ncol,indw + + type(ESMF_Time) :: Date1,Date2 + type(ESMF_TimeInterval) :: DateDiff + integer :: DeltaT + real(r8) :: Tscale + real(r8) :: Tfrac + integer :: rc + integer :: nn + integer :: kk + real(r8) :: Sbar,Qbar,Wsum + integer :: dtime ! Check if Nudging is initialized !--------------------------------- @@ -1058,7 +1136,7 @@ subroutine nudging_timestep_init(phys_state) call timemgr_time_ge(YMD1,Model_Next_Sec, & YMD ,Sec ,Update_Model) - if((Before_End).and.(Update_Model)) then + if((Before_End) .and. (Update_Model)) then ! Increment the Model times by the current interval !--------------------------------------------------- Model_Curr_Year =Model_Next_Year @@ -1070,7 +1148,7 @@ subroutine nudging_timestep_init(phys_state) YMD2,Model_Next_Sec,Model_Step,0,0) ! Check for Sync Error where NEXT model time after the update - ! is before the current time. If so, reset the next model + ! is before the current time. If so, reset the next model ! time to a Model_Step after the current time. !-------------------------------------------------------------- call timemgr_time_ge(YMD2,Model_Next_Sec, & @@ -1103,14 +1181,14 @@ subroutine nudging_timestep_init(phys_state) ! Load Dry Static Energy values for Model !----------------------------------------- - if(Nudge_TSmode.eq.0) then + if(Nudge_TSmode == 0) then ! DSE tendencies from Temperature only !--------------------------------------- do lchnk=begchunk,endchunk ncol=phys_state(lchnk)%ncol Model_S(:ncol,:pver,lchnk)=cpair*Model_T(:ncol,:pver,lchnk) end do - elseif(Nudge_TSmode.eq.1) then + elseif(Nudge_TSmode == 1) then ! Caluculate DSE tendencies from Temperature, Water Vapor, and Surface Pressure !------------------------------------------------------------------------------ do lchnk=begchunk,endchunk @@ -1119,8 +1197,30 @@ subroutine nudging_timestep_init(phys_state) phys_state(lchnk)%phis, Model_PS(:,lchnk), & Model_S(:,:,lchnk), ncol) end do - endif - endif ! ((Before_End).and.(Update_Model)) then + endif + + ! Optionally: Apply Zonal Filtering to Model state data + !------------------------------------------------------- + if(Nudge_ZonalFilter) then + call ZM%calc_amps(Model_U,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Model_U) + + call ZM%calc_amps(Model_V,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Model_V) + + call ZM%calc_amps(Model_T,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Model_T) + + call ZM%calc_amps(Model_S,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Model_S) + + call ZM%calc_amps(Model_Q,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Model_Q) + + call ZM%calc_amps(Model_PS,Zonal_Bamp2d) + call ZM%eval_grid(Zonal_Bamp2d,Model_PS) + endif + endif ! ((Before_End) .and. (Update_Model)) then !---------------------------------------------------------------- ! When past the NEXT time, Update Nudging Arrays and time indices @@ -1129,7 +1229,7 @@ subroutine nudging_timestep_init(phys_state) call timemgr_time_ge(YMD1,Nudge_Next_Sec, & YMD ,Sec ,Update_Nudge) - if((Before_End).and.(Update_Nudge)) then + if((Before_End) .and. (Update_Nudge)) then ! Increment the Nudge times by the current interval !--------------------------------------------------- Nudge_Curr_Year =Nudge_Next_Year @@ -1155,32 +1255,26 @@ subroutine nudging_timestep_init(phys_state) write(iulog,*) 'NUDGING: Reading analyses:',trim(Nudge_Path)//trim(Nudge_File) endif - ! Rotate Nudge_ObsInd() indices for new data, then update - ! the Nudge observation arrays with analysis data at the + ! Rotate Nudge_ObsInd() indices for new data, then update + ! the Nudge observation arrays with analysis data at the ! NEXT==Nudge_ObsInd(1) time. !---------------------------------------------------------- - if(dycore_is('UNSTRUCTURED')) then - call nudging_update_analyses_se (trim(Nudge_Path)//trim(Nudge_File)) - elseif(dycore_is('EUL')) then - call nudging_update_analyses_eul(trim(Nudge_Path)//trim(Nudge_File)) - else !if(dycore_is('LR')) then - call nudging_update_analyses_fv (trim(Nudge_Path)//trim(Nudge_File)) - endif - endif ! ((Before_End).and.(Update_Nudge)) then + call nudging_update_analyses (trim(Nudge_Path)//trim(Nudge_File)) + endif ! ((Before_End) .and. (Update_Nudge)) then !---------------------------------------------------------------- - ! Toggle Nudging flag when the time interval is between + ! Toggle Nudging flag when the time interval is between ! beginning and ending times, and all of the analyses files exist. !---------------------------------------------------------------- - if((After_Beg).and.(Before_End)) then - if(Nudge_Force_Opt.eq.0) then + if((After_Beg) .and. (Before_End)) then + if(Nudge_Force_Opt == 0) then ! Verify that the NEXT analyses are available !--------------------------------------------- Nudge_ON=Nudge_File_Present(Nudge_ObsInd(1)) - elseif(Nudge_Force_Opt.eq.1) then + elseif(Nudge_Force_Opt == 1) then ! Verify that the CURR and NEXT analyses are available !----------------------------------------------------- - Nudge_ON=(Nudge_File_Present(Nudge_ObsInd(1)).and. & + Nudge_ON=(Nudge_File_Present(Nudge_ObsInd(1)) .and. & Nudge_File_Present(Nudge_ObsInd(2)) ) else ! Verify that the ALL analyses are available @@ -1208,11 +1302,11 @@ subroutine nudging_timestep_init(phys_state) !--------------------------------------------------- ! If Data arrays have changed update stepping arrays !--------------------------------------------------- - if((Before_End).and.((Update_Nudge).or.(Update_Model))) then + if((Before_End) .and. ((Update_Nudge) .or. (Update_Model))) then ! Now Load the Target values for nudging tendencies !--------------------------------------------------- - if(Nudge_Force_Opt.eq.0) then + if(Nudge_Force_Opt == 0) then ! Target is OBS data at NEXT time !---------------------------------- do lchnk=begchunk,endchunk @@ -1223,8 +1317,8 @@ subroutine nudging_timestep_init(phys_state) Target_Q(:ncol,:pver,lchnk)=Nobs_Q(:ncol,:pver,lchnk,Nudge_ObsInd(1)) Target_PS(:ncol ,lchnk)=Nobs_PS(:ncol ,lchnk,Nudge_ObsInd(1)) end do - elseif(Nudge_Force_Opt.eq.1) then - ! Target is linear interpolation of OBS data CURR<-->NEXT time + elseif(Nudge_Force_Opt == 1) then + ! Target is linear interpolation of OBS data CURR<-->NEXT time !--------------------------------------------------------------- call ESMF_TimeSet(Date1,YY=Year,MM=Month,DD=Day,S=Sec) call ESMF_TimeSet(Date2,YY=Nudge_Next_Year,MM=Nudge_Next_Month, & @@ -1252,14 +1346,14 @@ subroutine nudging_timestep_init(phys_state) ! Now load Dry Static Energy values for Target !--------------------------------------------- - if(Nudge_TSmode.eq.0) then + if(Nudge_TSmode == 0) then ! DSE tendencies from Temperature only !--------------------------------------- do lchnk=begchunk,endchunk ncol=phys_state(lchnk)%ncol Target_S(:ncol,:pver,lchnk)=cpair*Target_T(:ncol,:pver,lchnk) end do - elseif(Nudge_TSmode.eq.1) then + elseif(Nudge_TSmode == 1) then ! Caluculate DSE tendencies from Temperature, Water Vapor, and Surface Pressure !------------------------------------------------------------------------------ do lchnk=begchunk,endchunk @@ -1270,11 +1364,11 @@ subroutine nudging_timestep_init(phys_state) end do endif - ! Set Tscale for the specified Forcing Option + ! Set Tscale for the specified Forcing Option !----------------------------------------------- - if(Nudge_TimeScale_Opt.eq.0) then + if(Nudge_TimeScale_Opt == 0) then Tscale=1._r8 - elseif(Nudge_TimeScale_Opt.eq.1) then + elseif(Nudge_TimeScale_Opt == 1) then call ESMF_TimeSet(Date1,YY=Year,MM=Month,DD=Day,S=Sec) call ESMF_TimeSet(Date2,YY=Nudge_Next_Year,MM=Nudge_Next_Month, & DD=Nudge_Next_Day , S=Nudge_Next_Sec ) @@ -1311,30 +1405,30 @@ subroutine nudging_timestep_init(phys_state) ! DIAG !****************** ! if(masterproc) then -! write(iulog,*) 'PFC: Target_T(1,:pver,begchunk)=',Target_T(1,:pver,begchunk) +! write(iulog,*) 'PFC: Target_T(1,:pver,begchunk)=',Target_T(1,:pver,begchunk) ! write(iulog,*) 'PFC: Model_T(1,:pver,begchunk)=',Model_T(1,:pver,begchunk) -! write(iulog,*) 'PFC: Target_S(1,:pver,begchunk)=',Target_S(1,:pver,begchunk) +! write(iulog,*) 'PFC: Target_S(1,:pver,begchunk)=',Target_S(1,:pver,begchunk) ! write(iulog,*) 'PFC: Model_S(1,:pver,begchunk)=',Model_S(1,:pver,begchunk) -! write(iulog,*) 'PFC: Target_PS(1,begchunk)=',Target_PS(1,begchunk) +! write(iulog,*) 'PFC: Target_PS(1,begchunk)=',Target_PS(1,begchunk) ! write(iulog,*) 'PFC: Model_PS(1,begchunk)=',Model_PS(1,begchunk) ! write(iulog,*) 'PFC: Nudge_Sstep(1,:pver,begchunk)=',Nudge_Sstep(1,:pver,begchunk) ! write(iulog,*) 'PFC: Nudge_Xstep arrays updated:' ! endif - endif ! ((Before_End).and.((Update_Nudge).or.(Update_Model))) then + endif ! ((Before_End) .and. ((Update_Nudge) .or. (Update_Model))) then ! End Routine !------------ - return - end subroutine ! nudging_timestep_init + + end subroutine nudging_timestep_init !================================================================ !================================================================ subroutine nudging_timestep_tend(phys_state,phys_tend) - ! - ! NUDGING_TIMESTEP_TEND: - ! If Nudging is ON, return the Nudging contributions - ! to forcing using the current contents of the Nudge + ! + ! NUDGING_TIMESTEP_TEND: + ! If Nudging is ON, return the Nudging contributions + ! to forcing using the current contents of the Nudge ! arrays. Send output to the cam history module as well. !=============================================================== use physconst ,only: cpair @@ -1350,8 +1444,8 @@ subroutine nudging_timestep_tend(phys_state,phys_tend) ! Local values !-------------------- - integer indw,ncol,lchnk - logical lq(pcnst) + integer :: indw,ncol,lchnk + logical :: lq(pcnst) call cnst_get_ind('Q',indw) lq(:) =.false. @@ -1378,223 +1472,24 @@ subroutine nudging_timestep_tend(phys_state,phys_tend) ! End Routine !------------ - return - end subroutine ! nudging_timestep_tend - !================================================================ - + end subroutine nudging_timestep_tend !================================================================ - subroutine nudging_update_analyses_se(anal_file) - ! - ! NUDGING_UPDATE_ANALYSES_SE: - ! Open the given analyses data file, read in - ! U,V,T,Q, and PS values and then distribute - ! the values to all of the chunks. - !=============================================================== - use ppgrid ,only: pver,begchunk - use netcdf - - ! Arguments - !------------- - character(len=*),intent(in):: anal_file - ! Local values - !------------- - integer lev - integer ncol,plev,istat - integer ncid,varid - real(r8) Xanal(Nudge_ncol,Nudge_nlev) - real(r8) PSanal(Nudge_ncol) - real(r8) Lat_anal(Nudge_ncol) - real(r8) Lon_anal(Nudge_ncol) - integer nn,Nindex - - ! Rotate Nudge_ObsInd() indices, then check the existence of the analyses - ! file; broadcast the updated indices and file status to all the other MPI nodes. - ! If the file is not there, then just return. - !------------------------------------------------------------------------ - if(masterproc) then - Nindex=Nudge_ObsInd(Nudge_NumObs) - do nn=Nudge_NumObs,2,-1 - Nudge_ObsInd(nn)=Nudge_ObsInd(nn-1) - end do - Nudge_ObsInd(1)=Nindex - inquire(FILE=trim(anal_file),EXIST=Nudge_File_Present(Nudge_ObsInd(1))) - write(iulog,*)'NUDGING: Nudge_ObsInd=',Nudge_ObsInd - write(iulog,*)'NUDGING: Nudge_File_Present=',Nudge_File_Present - endif -#ifdef SPMD - call mpibcast(Nudge_File_Present, Nudge_NumObs, mpilog, 0, mpicom) - call mpibcast(Nudge_ObsInd , Nudge_NumObs, mpiint, 0, mpicom) -#endif - if(.not.Nudge_File_Present(Nudge_ObsInd(1))) return - - ! masterporc does all of the work here - !----------------------------------------- - if(masterproc) then - - ! Open the given file - !----------------------- - istat=nf90_open(trim(anal_file),NF90_NOWRITE,ncid) - if(istat.ne.NF90_NOERR) then - write(iulog,*)'NF90_OPEN: failed for file ',trim(anal_file) - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - ! Read in Dimensions - !-------------------- - istat=nf90_inq_dimid(ncid,'ncol',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_inquire_dimension(ncid,varid,len=ncol) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - istat=nf90_inq_dimid(ncid,'lev',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_inquire_dimension(ncid,varid,len=plev) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - istat=nf90_inq_varid(ncid,'lon',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,Lon_anal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - istat=nf90_inq_varid(ncid,'lat',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,Lat_anal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - if((Nudge_ncol.ne.ncol).or.(plev.ne.pver)) then - write(iulog,*) 'ERROR: nudging_update_analyses_se: ncol=',ncol,' Nudge_ncol=',Nudge_ncol - write(iulog,*) 'ERROR: nudging_update_analyses_se: plev=',plev,' pver=',pver - call endrun('nudging_update_analyses_se: analyses dimension mismatch') - endif - - ! Read in and scatter data arrays - !---------------------------------- - istat=nf90_inq_varid(ncid,'U',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_ncol,Xanal, & - Nobs_U(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'V',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_ncol,Xanal, & - Nobs_V(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'T',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_ncol,Xanal, & - Nobs_T(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'Q',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_ncol,Xanal, & - Nobs_Q(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'PS',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,PSanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - ! Close the analyses file - !----------------------- - istat=nf90_close(ncid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,1,1,Nudge_ncol,PSanal, & - Nobs_PS(1,begchunk,Nudge_ObsInd(1))) - - ! End Routine - !------------ - return - end subroutine ! nudging_update_analyses_se !================================================================ - - - !================================================================ - subroutine nudging_update_analyses_eul(anal_file) - ! - ! NUDGING_UPDATE_ANALYSES_EUL: - ! Open the given analyses data file, read in + subroutine nudging_update_analyses(anal_file) + ! + ! NUDGING_UPDATE_ANALYSES: + ! Open the given analyses data file, read in ! U,V,T,Q, and PS values and then distribute ! the values to all of the chunks. !=============================================================== - use ppgrid ,only: pver,begchunk - use netcdf + use ppgrid ,only: pcols,pver,begchunk,endchunk + use cam_pio_utils ,only: cam_pio_openfile + use pio ,only: PIO_BCAST_ERROR,PIO_INTERNAL_ERROR + use pio ,only: pio_closefile,pio_seterrorhandling,file_desc_t + use ncdio_atm ,only: infld + use cam_grid_support,only: cam_grid_id,cam_grid_get_dim_names,DLEN=>max_hcoordname_len ! Arguments !------------- @@ -1602,262 +1497,21 @@ subroutine nudging_update_analyses_eul(anal_file) ! Local values !------------- - integer lev - integer nlon,nlat,plev,istat - integer ncid,varid - integer ilat,ilon,ilev - real(r8) Xanal(Nudge_nlon,Nudge_nlat,Nudge_nlev) - real(r8) PSanal(Nudge_nlon,Nudge_nlat) - real(r8) Lat_anal(Nudge_nlat) - real(r8) Lon_anal(Nudge_nlon) - real(r8) Xtrans(Nudge_nlon,Nudge_nlev,Nudge_nlat) - integer nn,Nindex - - ! Rotate Nudge_ObsInd() indices, then check the existence of the analyses - ! file; broadcast the updated indices and file status to all the other MPI nodes. - ! If the file is not there, then just return. - !------------------------------------------------------------------------ - if(masterproc) then - Nindex=Nudge_ObsInd(Nudge_NumObs) - do nn=Nudge_NumObs,2,-1 - Nudge_ObsInd(nn)=Nudge_ObsInd(nn-1) - end do - Nudge_ObsInd(1)=Nindex - inquire(FILE=trim(anal_file),EXIST=Nudge_File_Present(Nudge_ObsInd(1))) - endif -#ifdef SPMD - call mpibcast(Nudge_File_Present, Nudge_NumObs, mpilog, 0, mpicom) - call mpibcast(Nudge_ObsInd , Nudge_NumObs, mpiint, 0, mpicom) -#endif - if(.not.Nudge_File_Present(Nudge_ObsInd(1))) return + type(file_desc_t) :: fileID + integer :: nn,Nindex + logical :: VARflag + integer :: grid_id + integer :: ierr + character(len=DLEN):: dim1name,dim2name + integer :: err_handling - ! masterporc does all of the work here - !----------------------------------------- - if(masterproc) then - - ! Open the given file - !----------------------- - istat=nf90_open(trim(anal_file),NF90_NOWRITE,ncid) - if(istat.ne.NF90_NOERR) then - write(iulog,*)'NF90_OPEN: failed for file ',trim(anal_file) - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif + real(r8),allocatable:: Tmp3D(:,:,:) + real(r8),allocatable:: Tmp2D(:,:) - ! Read in Dimensions - !-------------------- - istat=nf90_inq_dimid(ncid,'lon',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_inquire_dimension(ncid,varid,len=nlon) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif + character(len=*), parameter :: prefix = 'nudging_update_analyses: ' - istat=nf90_inq_dimid(ncid,'lat',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_inquire_dimension(ncid,varid,len=nlat) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - - istat=nf90_inq_dimid(ncid,'lev',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_inquire_dimension(ncid,varid,len=plev) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - - istat=nf90_inq_varid(ncid,'lon',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_get_var(ncid,varid,Lon_anal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - - istat=nf90_inq_varid(ncid,'lat',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_get_var(ncid,varid,Lat_anal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - - if((Nudge_nlon.ne.nlon).or.(Nudge_nlat.ne.nlat).or.(plev.ne.pver)) then - write(iulog,*) 'ERROR: nudging_update_analyses_eul: nlon=',nlon,' Nudge_nlon=',Nudge_nlon - write(iulog,*) 'ERROR: nudging_update_analyses_eul: nlat=',nlat,' Nudge_nlat=',Nudge_nlat - write(iulog,*) 'ERROR: nudging_update_analyses_eul: plev=',plev,' pver=',pver - call endrun('nudging_update_analyses_eul: analyses dimension mismatch') - endif - - ! Read in, transpose lat/lev indices, - ! and scatter data arrays - !---------------------------------- - istat=nf90_inq_varid(ncid,'U',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_U(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'V',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_V(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'T',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_T(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'Q',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_Q(1,1,begchunk,Nudge_ObsInd(1))) - - if(masterproc) then - istat=nf90_inq_varid(ncid,'PS',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,PSanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - ! Close the analyses file - !----------------------- - istat=nf90_close(ncid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,1,1,Nudge_nlon,PSanal, & - Nobs_PS(1,begchunk,Nudge_ObsInd(1))) - - ! End Routine - !------------ - return - end subroutine ! nudging_update_analyses_eul - !================================================================ - - - !================================================================ - subroutine nudging_update_analyses_fv(anal_file) - ! - ! NUDGING_UPDATE_ANALYSES_FV: - ! Open the given analyses data file, read in - ! U,V,T,Q, and PS values and then distribute - ! the values to all of the chunks. - !=============================================================== - use ppgrid ,only: pver,begchunk - use netcdf - - ! Arguments - !------------- - character(len=*),intent(in):: anal_file - - ! Local values - !------------- - integer lev - integer nlon,nlat,plev,istat - integer ncid,varid - integer ilat,ilon,ilev - real(r8) Xanal(Nudge_nlon,Nudge_nlat,Nudge_nlev) - real(r8) PSanal(Nudge_nlon,Nudge_nlat) - real(r8) Lat_anal(Nudge_nlat) - real(r8) Lon_anal(Nudge_nlon) - real(r8) Xtrans(Nudge_nlon,Nudge_nlev,Nudge_nlat) - integer nn,Nindex - - ! Rotate Nudge_ObsInd() indices, then check the existence of the analyses - ! file; broadcast the updated indices and file status to all the other MPI nodes. + ! Rotate Nudge_ObsInd() indices, then check the existence of the analyses + ! file; broadcast the updated indices and file status to all the other MPI nodes. ! If the file is not there, then just return. !------------------------------------------------------------------------ if(masterproc) then @@ -1870,212 +1524,115 @@ subroutine nudging_update_analyses_fv(anal_file) write(iulog,*)'NUDGING: Nudge_ObsInd=',Nudge_ObsInd write(iulog,*)'NUDGING: Nudge_File_Present=',Nudge_File_Present endif -#ifdef SPMD - call mpibcast(Nudge_File_Present, Nudge_NumObs, mpilog, 0, mpicom) - call mpibcast(Nudge_ObsInd , Nudge_NumObs, mpiint, 0, mpicom) -#endif - if(.not.Nudge_File_Present(Nudge_ObsInd(1))) return - ! masterporc does all of the work here - !----------------------------------------- - if(masterproc) then - - ! Open the given file - !----------------------- - istat=nf90_open(trim(anal_file),NF90_NOWRITE,ncid) - if(istat.ne.NF90_NOERR) then - write(iulog,*)'NF90_OPEN: failed for file ',trim(anal_file) - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif + call MPI_bcast(Nudge_File_Present, Nudge_NumObs, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_File_Present') + call MPI_bcast(Nudge_ObsInd , Nudge_NumObs, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= mpi_success) call endrun(prefix//'FATAL: mpi_bcast: Nudge_ObsInd') - ! Read in Dimensions - !-------------------- - istat=nf90_inq_dimid(ncid,'lon',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_inquire_dimension(ncid,varid,len=nlon) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif + if(.not. Nudge_File_Present(Nudge_ObsInd(1))) then + return + end if - istat=nf90_inq_dimid(ncid,'lat',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_inquire_dimension(ncid,varid,len=nlat) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif + ! Open the file and get the fileID. + !------------------------------------- + call cam_pio_openfile(fileID,trim(anal_file),0) + call pio_seterrorhandling(fileID,PIO_BCAST_ERROR,oldmethod=err_handling) + if(masterproc) write(iulog,*)'PIO_OPEN: file=',trim(anal_file) - istat=nf90_inq_dimid(ncid,'lev',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_inquire_dimension(ncid,varid,len=plev) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif + grid_id = cam_grid_id('physgrid') + call cam_grid_get_dim_names(grid_id,dim1name,dim2name) - istat=nf90_inq_varid(ncid,'lon',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_get_var(ncid,varid,Lon_anal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif + allocate(Tmp3D(pcols,pver,begchunk:endchunk)) + allocate(Tmp2D(pcols,begchunk:endchunk)) - istat=nf90_inq_varid(ncid,'lat',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_get_var(ncid,varid,Lat_anal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif + ! Read in, U,V,T,Q, and PS + !---------------------------------- + call infld('U',fileID,dim1name,'lev',dim2name, & + 1,pcols,1,pver,begchunk,endchunk,Tmp3D, & + VARflag,gridname='physgrid',timelevel=1 ) + if(VARflag) then + if(Nudge_ZonalFilter) then + call ZM%calc_amps(Tmp3D,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Tmp3D) + endif + Nobs_U(:,:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp3D(:,:,begchunk:endchunk) + else + call endrun('Variable "U" is missing in '//trim(anal_file)) + endif - if((Nudge_nlon.ne.nlon).or.(Nudge_nlat.ne.nlat).or.(plev.ne.pver)) then - write(iulog,*) 'ERROR: nudging_update_analyses_fv: nlon=',nlon,' Nudge_nlon=',Nudge_nlon - write(iulog,*) 'ERROR: nudging_update_analyses_fv: nlat=',nlat,' Nudge_nlat=',Nudge_nlat - write(iulog,*) 'ERROR: nudging_update_analyses_fv: plev=',plev,' pver=',pver - call endrun('nudging_update_analyses_fv: analyses dimension mismatch') + call infld('V',fileID,dim1name,'lev',dim2name, & + 1,pcols,1,pver,begchunk,endchunk,Tmp3D, & + VARflag,gridname='physgrid',timelevel=1 ) + if(VARflag) then + if(Nudge_ZonalFilter) then + call ZM%calc_amps(Tmp3D,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Tmp3D) endif + Nobs_V(:,:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp3D(:,:,begchunk:endchunk) + else + call endrun('Variable "V" is missing in '//trim(anal_file)) + endif - ! Read in, transpose lat/lev indices, - ! and scatter data arrays - !---------------------------------- - istat=nf90_inq_varid(ncid,'U',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') + call infld('T',fileID,dim1name,'lev',dim2name, & + 1,pcols,1,pver,begchunk,endchunk,Tmp3D, & + VARflag,gridname='physgrid',timelevel=1 ) + if(VARflag) then + if(Nudge_ZonalFilter) then + call ZM%calc_amps(Tmp3D,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Tmp3D) endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_U(1,1,begchunk,Nudge_ObsInd(1))) + Nobs_T(:,:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp3D(:,:,begchunk:endchunk) + else + call endrun('Variable "T" is missing in '//trim(anal_file)) + endif - if(masterproc) then - istat=nf90_inq_varid(ncid,'V',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') + call infld('Q',fileID,dim1name,'lev',dim2name, & + 1,pcols,1,pver,begchunk,endchunk,Tmp3D, & + VARflag,gridname='physgrid',timelevel=1 ) + if(VARflag) then + if(Nudge_ZonalFilter) then + call ZM%calc_amps(Tmp3D,Zonal_Bamp3d) + call ZM%eval_grid(Zonal_Bamp3d,Tmp3D) endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_V(1,1,begchunk,Nudge_ObsInd(1))) + Nobs_Q(:,:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp3D(:,:,begchunk:endchunk) + else + call endrun('Variable "Q" is missing in '//trim(anal_file)) + endif - if(masterproc) then - istat=nf90_inq_varid(ncid,'T',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') + call infld('PS',fileID,dim1name,dim2name, & + 1,pcols,begchunk,endchunk,Tmp2D, & + VARflag,gridname='physgrid',timelevel=1 ) + if(VARflag) then + if(Nudge_ZonalFilter) then + call ZM%calc_amps(Tmp2D,Zonal_Bamp2d) + call ZM%eval_grid(Zonal_Bamp2d,Tmp2D) endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_T(1,1,begchunk,Nudge_ObsInd(1))) + Nobs_PS(:,begchunk:endchunk,Nudge_ObsInd(1)) = Tmp2D(:,begchunk:endchunk) + else + call endrun('Variable "PS" is missing in '//trim(anal_file)) + endif - if(masterproc) then - istat=nf90_inq_varid(ncid,'Q',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - istat=nf90_get_var(ncid,varid,Xanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_FV') - endif - do ilat=1,nlat - do ilev=1,plev - do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) - end do - end do - end do - endif ! (masterproc) then - call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & - Nobs_Q(1,1,begchunk,Nudge_ObsInd(1))) + ! Restore old error handling + !---------------------------- + call pio_seterrorhandling(fileID,err_handling) - if(masterproc) then - istat=nf90_inq_varid(ncid,'PS',varid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - istat=nf90_get_var(ncid,varid,PSanal) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_SE') - endif - - ! Close the analyses file - !----------------------- - istat=nf90_close(ncid) - if(istat.ne.NF90_NOERR) then - write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') - endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,1,1,Nudge_nlon,PSanal, & - Nobs_PS(1,begchunk,Nudge_ObsInd(1))) + ! Close the analyses file + !----------------------- + deallocate(Tmp3D) + deallocate(Tmp2D) + call pio_closefile(fileID) ! End Routine !------------ - return - end subroutine ! nudging_update_analyses_fv + + end subroutine nudging_update_analyses !================================================================ !================================================================ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) - ! + ! ! NUDGING_SET_PROFILE: for the given lat,lon, and Nudging_prof, set ! the verical profile of window coeffcients. ! Values range from 0. to 1. to affect spatial @@ -2084,32 +1641,32 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) ! Arguments !-------------- - integer nlev,Nudge_prof - real(r8) rlat,rlon - real(r8) Wprof(nlev) + integer :: nlev,Nudge_prof + real(r8) :: rlat,rlon + real(r8) :: Wprof(nlev) ! Local values !---------------- - integer ilev - real(r8) Hcoef,latx,lonx,Vmax,Vmin - real(r8) lon_lo,lon_hi,lat_lo,lat_hi,lev_lo,lev_hi + integer :: ilev + real(r8) :: Hcoef,latx,lonx,Vmax,Vmin + real(r8) :: lon_lo,lon_hi,lat_lo,lat_hi,lev_lo,lev_hi !--------------- ! set coeffcient !--------------- - if(Nudge_prof.eq.0) then + if(Nudge_prof == 0) then ! No Nudging !------------- Wprof(:)=0.0_r8 - elseif(Nudge_prof.eq.1) then + elseif(Nudge_prof == 1) then ! Uniform Nudging !----------------- Wprof(:)=1.0_r8 - elseif(Nudge_prof.eq.2) then + elseif(Nudge_prof == 2) then ! Localized Nudging with specified Heaviside window function !------------------------------------------------------------ - if(Nudge_Hwin_max.le.Nudge_Hwin_min) then - ! For a constant Horizontal window function, + if(Nudge_Hwin_max <= Nudge_Hwin_min) then + ! For a constant Horizontal window function, ! just set Hcoef to the maximum of Hlo/Hhi. !-------------------------------------------- Hcoef=max(Nudge_Hwin_lo,Nudge_Hwin_hi) @@ -2118,8 +1675,8 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) !------------------------------------------ latx=rlat-Nudge_Hwin_lat0 lonx=rlon-Nudge_Hwin_lon0 - if(lonx.gt. 180._r8) lonx=lonx-360._r8 - if(lonx.le.-180._r8) lonx=lonx+360._r8 + if(lonx > 180._r8) lonx=lonx-360._r8 + if(lonx <= -180._r8) lonx=lonx+360._r8 ! Calcualte RAW window value !------------------------------- @@ -2142,15 +1699,15 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) lev_lo=(float(ilev)-Nudge_Vwin_Lindex)/Nudge_Vwin_Ldelta lev_hi=(Nudge_Vwin_Hindex-float(ilev))/Nudge_Vwin_Hdelta Wprof(ilev)=((1._r8+tanh(lev_lo))/2._r8)*((1._r8+tanh(lev_hi))/2._r8) - end do + end do ! Scale the Window function to span the values between Vlo and Vhi: !----------------------------------------------------------------- Vmax=maxval(Wprof) Vmin=minval(Wprof) - if((Vmax.le.Vmin).or.((Nudge_Vwin_Hindex.ge.(nlev+1)).and. & - (Nudge_Vwin_Lindex.le. 0 ) )) then - ! For a constant Vertical window function, + if((Vmax <= Vmin) .or. ((Nudge_Vwin_Hindex >= (nlev+1)) .and. & + (Nudge_Vwin_Lindex <= 0 ) )) then + ! For a constant Vertical window function, ! load maximum of Vlo/Vhi into Wprof() !-------------------------------------------- Vmax=max(Nudge_Vwin_lo,Nudge_Vwin_hi) @@ -2162,7 +1719,7 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) Wprof(:)=Nudge_Vwin_lo + Wprof(:)*(Nudge_Vwin_hi-Nudge_Vwin_lo) endif - ! The desired result is the product of the vertical profile + ! The desired result is the product of the vertical profile ! and the horizontal window coeffcient. !---------------------------------------------------- Wprof(:)=Hcoef*Wprof(:) @@ -2172,14 +1729,54 @@ subroutine nudging_set_profile(rlat,rlon,Nudge_prof,Wprof,nlev) ! End Routine !------------ - return - end subroutine ! nudging_set_profile + + end subroutine nudging_set_profile !================================================================ + !================================================================ + subroutine nudging_final + + if (allocated(Target_U)) deallocate(Target_U) + if (allocated(Target_V)) deallocate(Target_V) + if (allocated(Target_T)) deallocate(Target_T) + if (allocated(Target_S)) deallocate(Target_S) + if (allocated(Target_Q)) deallocate(Target_Q) + if (allocated(Target_PS)) deallocate(Target_PS) + if (allocated(Model_U)) deallocate(Model_U) + if (allocated(Model_V)) deallocate(Model_V) + if (allocated(Model_T)) deallocate(Model_T) + if (allocated(Model_S)) deallocate(Model_S) + if (allocated(Model_Q)) deallocate(Model_Q) + if (allocated(Model_PS)) deallocate(Model_PS) + if (allocated(Nudge_Utau)) deallocate(Nudge_Utau) + if (allocated(Nudge_Vtau)) deallocate(Nudge_Vtau) + if (allocated(Nudge_Stau)) deallocate(Nudge_Stau) + if (allocated(Nudge_Qtau)) deallocate(Nudge_Qtau) + if (allocated(Nudge_PStau)) deallocate(Nudge_PStau) + if (allocated(Nudge_Ustep)) deallocate(Nudge_Ustep) + if (allocated(Nudge_Vstep)) deallocate(Nudge_Vstep) + if (allocated(Nudge_Sstep)) deallocate(Nudge_Sstep) + if (allocated(Nudge_Qstep)) deallocate(Nudge_Qstep) + if (allocated(Nudge_PSstep)) deallocate(Nudge_PSstep) + + if (allocated(Nudge_ObsInd)) deallocate(Nudge_ObsInd) + if (allocated(Nudge_File_Present)) deallocate(Nudge_File_Present) + if (allocated(Nobs_U)) deallocate(Nobs_U) + if (allocated(Nobs_V)) deallocate(Nobs_V) + if (allocated(Nobs_T)) deallocate(Nobs_T) + if (allocated(Nobs_Q)) deallocate(Nobs_Q) + if (allocated(Nobs_PS)) deallocate(Nobs_PS) + if (allocated(Zonal_Bamp2d)) deallocate(Zonal_Bamp2d) + if (allocated(Zonal_Bamp3d)) deallocate(Zonal_Bamp3d) + + call ZM%final() + + end subroutine nudging_final + !================================================================ !================================================================ real(r8) function nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) - ! + ! ! NUDGING_SET_PSPROFILE: for the given lat and lon set the surface ! pressure profile value for the specified index. ! Values range from 0. to 1. to affect spatial @@ -2188,8 +1785,8 @@ real(r8) function nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) ! Arguments !-------------- - real(r8) rlat,rlon - integer Nudge_PSprof + real(r8) :: rlat,rlon + integer :: Nudge_PSprof ! Local values !---------------- @@ -2197,11 +1794,11 @@ real(r8) function nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) !--------------- ! set coeffcient !--------------- - if(Nudge_PSprof.eq.0) then + if(Nudge_PSprof == 0) then ! No Nudging !------------- nudging_set_PSprofile=0.0_r8 - elseif(Nudge_PSprof.eq.1) then + elseif(Nudge_PSprof == 1) then ! Uniform Nudging !----------------- nudging_set_PSprofile=1.0_r8 @@ -2211,16 +1808,16 @@ real(r8) function nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) ! End Routine !------------ - return - end function ! nudging_set_PSprofile + + end function nudging_set_PSprofile !================================================================ !================================================================ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) - ! + ! ! calc_DryStaticEnergy: Given the temperature, specific humidity, surface pressure, - ! and surface geopotential for a chunk containing 'ncol' columns, + ! and surface geopotential for a chunk containing 'ncol' columns, ! calculate and return the corresponding dry static energy values. !-------------------------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 @@ -2234,7 +1831,7 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) integer , intent(in) :: ncol ! Number of columns in chunk real(r8), intent(in) :: t(:,:) ! (pcols,pver) - temperature real(r8), intent(in) :: q(:,:) ! (pcols,pver) - specific humidity - real(r8), intent(in) :: ps(:) ! (pcols) - surface pressure + real(r8), intent(in) :: ps(:) ! (pcols) - surface pressure real(r8), intent(in) :: phis(:) ! (pcols) - surface geopotential real(r8), intent(out):: dse(:,:) ! (pcols,pver) - dry static energy ! @@ -2254,7 +1851,7 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) !------------------- fvdyn = dycore_is ('LR') - ! Load Pressure values and midpoint pressures + ! Load Pressure values and midpoint pressures !---------------------------------------------- do kk=1,pverp do ii=1,ncol @@ -2305,7 +1902,7 @@ subroutine calc_DryStaticEnergy(t, q, phis, ps, dse, ncol) ! End Routine !----------- - return + end subroutine calc_DryStaticEnergy !================================================================ diff --git a/src/physics/cam/oldcloud_optics.F90 b/src/physics/cam/oldcloud_optics.F90 new file mode 100644 index 0000000000..bf53856ad6 --- /dev/null +++ b/src/physics/cam/oldcloud_optics.F90 @@ -0,0 +1,324 @@ +module oldcloud_optics + +!------------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver, pverp +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field +use constituents, only: cnst_get_ind +use physconst, only: gravit +use radconstants, only: nlwbands +use ebert_curry_ice_optics, only: scalefactor + +use cam_abortutils, only: endrun + +implicit none +private +save + +public :: & + oldcloud_init, & + oldcloud_lw, & + old_liq_get_rad_props_lw, & + old_ice_get_rad_props_lw + +integer :: nmu, nlambda +real(r8), allocatable :: g_mu(:) ! mu samples on grid +real(r8), allocatable :: g_lambda(:,:) ! lambda scale samples on grid +real(r8), allocatable :: ext_sw_liq(:,:,:) +real(r8), allocatable :: ssa_sw_liq(:,:,:) +real(r8), allocatable :: asm_sw_liq(:,:,:) +real(r8), allocatable :: abs_lw_liq(:,:,:) + +integer :: n_g_d +real(r8), allocatable :: g_d_eff(:) ! radiative effective diameter samples on grid +real(r8), allocatable :: ext_sw_ice(:,:) +real(r8), allocatable :: ssa_sw_ice(:,:) +real(r8), allocatable :: asm_sw_ice(:,:) +real(r8), allocatable :: abs_lw_ice(:,:) + +! Minimum cloud amount (as a fraction of the grid-box area) to +! distinguish from clear sky +real(r8), parameter :: cldmin = 1.0e-80_r8 + +! Decimal precision of cloud amount (0 -> preserve full resolution; +! 10^-n -> preserve n digits of cloud amount) +real(r8), parameter :: cldeps = 0.0_r8 + +! indexes into pbuf +integer :: iciwp_idx = 0 +integer :: iclwp_idx = 0 +integer :: cld_idx = 0 +integer :: rel_idx = 0 +integer :: rei_idx = 0 + +! indexes into constituents for old optics +integer :: & + ixcldice, & ! cloud ice water index + ixcldliq ! cloud liquid water index + + +!============================================================================== +contains +!============================================================================== + +subroutine oldcloud_init() + + + integer :: err + + iciwp_idx = pbuf_get_index('ICIWP',errcode=err) + iclwp_idx = pbuf_get_index('ICLWP',errcode=err) + cld_idx = pbuf_get_index('CLD') + rel_idx = pbuf_get_index('REL') + rei_idx = pbuf_get_index('REI') + + ! old optics + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + +end subroutine oldcloud_init + +!============================================================================== + +subroutine oldcloud_lw(state,pbuf,cld_abs_od,oldwp) + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer + logical,intent(in) :: oldwp ! use old definition of waterpath + + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, itim_old, lwband, i, k, lchnk + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + real(r8) :: kabs, kabsi + real(r8), parameter :: kabsl = 0.090361_r8 ! longwave liquid absorption coeff (m**2/g) + + + ncol = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if (oldwp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('oldcloud_lw: oldwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp(i,k) = 1000.0_r8 *iclwpth(i,k) + 1000.0_r8 *iciwpth(i, k) + ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) + end do + end do + endif + + do k=1,pver + do i=1,ncol + + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) + kabs = kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do +! + do lwband = 1,nlwbands + cld_abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + +end subroutine oldcloud_lw + +!============================================================================== + +subroutine old_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + logical, intent(in) :: oldliqwp + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, itim_old, lwband, i, k, lchnk + + real(r8) :: kabs, kabsi + real(r8), parameter :: kabsl = 0.090361_r8 ! longwave liquid absorption coeff (m**2/g) + + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + ncol=state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if (oldliqwp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('old_liq_get_rad_props_lw: oldliqwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp(i,k) = 1000.0_r8 *iclwpth(i,k) + 1000.0_r8 *iciwpth(i, k) + ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) + end do + end do + endif + + + do k=1,pver + do i=1,ncol + + ! Note from Andrew Conley: + ! Optics for RK no longer supported, This is constructed to get + ! close to bit for bit. Otherwise we could simply use liquid water path + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) + kabs = kabsl*(1._r8-ficemr(i,k)) ! + kabsi*ficemr(i,k) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do + + do lwband = 1,nlwbands + abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + + +end subroutine old_liq_get_rad_props_lw + +!============================================================================== + +subroutine old_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + logical, intent(in) :: oldicewp + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, itim_old, lwband, i, k, lchnk + + real(r8) :: kabs, kabsi + real(r8), parameter :: kabsl = 0.090361_r8 ! longwave liquid absorption coeff (m**2/g) + + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + + ncol = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if(oldicewp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('old_ice_get_rad_props_lw: oldicewp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp(i,k) = 1000.0_r8 *iciwpth(i,k) + 1000.0_r8 *iclwpth(i,k) + ficemr(i,k) = 1000.0_r8*iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) + end do + end do + endif + + do k=1,pver + do i=1,ncol + + ! Note from Andrew Conley: + ! Optics for RK no longer supported, This is constructed to get + ! close to bit for bit. Otherwise we could simply use ice water path + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) + kabs = kabsi*ficemr(i,k) ! kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do + + do lwband = 1,nlwbands + abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + +end subroutine old_ice_get_rad_props_lw + +!============================================================================== + +end module oldcloud_optics 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 f75130c52f..0ad08646ce 100644 --- a/src/physics/cam/phys_control.F90 +++ b/src/physics/cam/phys_control.F90 @@ -13,7 +13,7 @@ module phys_control use spmd_utils, only: masterproc use cam_logfile, only: iulog use cam_abortutils, only: endrun -use shr_kind_mod, only: r8 => shr_kind_r8 +use shr_kind_mod, only: r8 => shr_kind_r8, cl=>shr_kind_cl implicit none private @@ -36,7 +36,7 @@ module phys_control ! Namelist variables: character(len=16) :: cam_physpkg = unset_str ! CAM physics package -character(len=32) :: cam_chempkg = unset_str ! CAM chemistry package +character(len=32) :: cam_chempkg = unset_str ! CAM chemistry package character(len=16) :: waccmx_opt = unset_str ! WACCMX run option [ionosphere | neutral | off character(len=16) :: deep_scheme = unset_str ! deep convection package character(len=16) :: shallow_scheme = unset_str ! shallow convection package @@ -44,6 +44,7 @@ module phys_control character(len=16) :: microp_scheme = unset_str ! microphysics package character(len=16) :: macrop_scheme = unset_str ! macrophysics package character(len=16) :: radiation_scheme = unset_str ! radiation package +character(len=cl) :: cam_physics_mesh = unset_str ! SCRIP file for phys integer :: srf_flux_avg = unset_int ! 1 => smooth surface fluxes, 0 otherwise logical :: use_subcol_microp = .false. ! if .true. then use sub-columns in microphysics @@ -55,9 +56,8 @@ 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 CAM4 - ! temperature, water vapor, cloud ice and cloud - ! liquid budgets. +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 integer :: history_budget_histfile_num = 1 ! output history file number for budget fields @@ -72,6 +72,8 @@ module phys_control logical :: history_chemspecies_srf = .false. logical :: do_clubb_sgs +logical :: do_hb_above_clubb = .false. ! enable HB vertical mixing above clubb top + ! Check validity of physics_state objects in physics_update. logical :: state_debug_checks = .false. @@ -83,8 +85,6 @@ module phys_control logical, public, protected :: use_simple_phys = .false. ! true => simple physics configuration -logical :: use_spcam ! true => use super parameterized CAM - logical :: prog_modal_aero ! determines whether prognostic modal aerosols are present in the run. ! Option to use heterogeneous freezing @@ -96,19 +96,23 @@ 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. +! Option for Harmonized Emissions Component (HEMCO) +logical, public, protected :: use_hemco = .false. + ! CAM snapshot before/after file numbers and control character(len=32) :: cam_take_snapshot_before = '' ! Physics routine to take a snopshot "before" character(len=32) :: cam_take_snapshot_after = '' ! Physics routine to take a snopshot "after" integer :: cam_snapshot_before_num = -1 ! output history file number for CAM "before" snapshot integer :: cam_snapshot_after_num = -1 ! output history file number for CAM "after" snapshot -!======================================================================= +!======================================================================= contains -!======================================================================= +!======================================================================= subroutine phys_ctl_readnl(nlfile) @@ -131,9 +135,9 @@ 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_take_snapshot_before, cam_take_snapshot_after, cam_physics_mesh, use_hemco, do_hb_above_clubb !----------------------------------------------------------------------------- if (masterproc) then @@ -188,6 +192,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) @@ -195,9 +200,9 @@ subroutine phys_ctl_readnl(nlfile) call mpi_bcast(cam_snapshot_after_num, 1, mpi_integer, masterprocid, mpicom, ierr) call mpi_bcast(cam_take_snapshot_before, len(cam_take_snapshot_before), mpi_character, masterprocid, mpicom, ierr) call mpi_bcast(cam_take_snapshot_after, len(cam_take_snapshot_after), mpi_character, masterprocid, mpicom, ierr) - - use_spcam = ( cam_physpkg_is('spcam_sam1mom') & - .or. cam_physpkg_is('spcam_m2005')) + call mpi_bcast(cam_physics_mesh, len(cam_physics_mesh), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(do_hb_above_clubb, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(use_hemco, 1, mpi_logical, masterprocid, mpicom, ierr) call cam_ctrl_set_physics_type(cam_physpkg) @@ -219,21 +224,40 @@ subroutine phys_ctl_readnl(nlfile) write(iulog,*)'UW PBL is not compatible with RK microphysics. Quiting' call endrun('PBL and Microphysics schemes incompatible') endif - + ! Add a check to make sure CLUBB and MG are used together - if ( do_clubb_sgs .and. ( microp_scheme .ne. 'MG') .and. .not. use_spcam) then + if ( do_clubb_sgs .and. microp_scheme .ne. 'MG') then write(iulog,*)'CLUBB is only compatible with MG microphysics. Quiting' call endrun('CLUBB and microphysics schemes incompatible') endif ! Check that eddy_scheme, macrop_scheme, shallow_scheme are all set to CLUBB_SGS if do_clubb_sgs is true - if (do_clubb_sgs .and. .not. use_spcam) then + if (do_clubb_sgs) then if (eddy_scheme .ne. 'CLUBB_SGS' .or. macrop_scheme .ne. 'CLUBB_SGS' .or. shallow_scheme .ne. 'CLUBB_SGS') then write(iulog,*)'eddy_scheme, macrop_scheme and shallow_scheme must all be CLUBB_SGS. Quiting' call endrun('CLUBB and eddy, macrop or shallow schemes incompatible') endif endif - + + if (cam_physpkg_is("cam7")) then + ! Check that eddy_scheme, macrop_scheme, shallow_scheme are all set to CLUBB + if (eddy_scheme /= 'CLUBB_SGS' .or. macrop_scheme /= 'CLUBB_SGS' .or. shallow_scheme /= 'CLUBB_SGS') then + write(iulog,*) 'cam7 is only compatible with CLUBB. Quitting' + call endrun('cam7 is only compatible with eddy, macrop, and shallow schemes = CLUBB_SGS') + end if + ! Add check to make sure we are not trying to use `camrt` + if (trim(radiation_scheme) == 'camrt') then + write(iulog,*) ' camrt specified and it is not compatible with cam7' + call endrun('cam7 is not compatible with camrt radiation scheme') + end if + end if + + ! do_hb_above_clubb requires that CLUBB is being used + if (do_hb_above_clubb .and. .not. do_clubb_sgs) then + write(iulog,*)'do_hb_above_clubb requires CLUBB to be active' + call endrun('do_hb_above_clubb incompatible with do_clubb_sgs = .false.') + endif + ! Macro/micro co-substepping support. if (cld_macmic_num_steps > 1) then if (microp_scheme /= "MG" .or. (macrop_scheme /= "park" .and. macrop_scheme /= "CLUBB_SGS")) then @@ -254,7 +278,7 @@ logical function cam_physpkg_is(name) ! query for the name of the physics package character(len=*) :: name - + cam_physpkg_is = (trim(name) == trim(cam_physpkg)) end function cam_physpkg_is @@ -265,7 +289,7 @@ logical function cam_chempkg_is(name) ! query for the name of the chemics package character(len=*) :: name - + cam_chempkg_is = (trim(name) == trim(cam_chempkg)) end function cam_chempkg_is @@ -276,7 +300,7 @@ logical function waccmx_is(name) ! query for the name of the waccmx run option character(len=*) :: name - + waccmx_is = (trim(name) == trim(waccmx_opt)) end function waccmx_is @@ -290,9 +314,9 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi history_carma_out, history_clubb_out, history_dust_out, & history_cesm_forcing_out, history_scwaccm_forcing_out, history_chemspecies_srf_out, & cam_chempkg_out, prog_modal_aero_out, macrop_scheme_out, & - do_clubb_sgs_out, use_spcam_out, state_debug_checks_out, cld_macmic_num_steps_out, & + do_clubb_sgs_out, state_debug_checks_out, cld_macmic_num_steps_out, & offline_driver_out, convproc_do_aer_out, cam_snapshot_before_num_out, cam_snapshot_after_num_out,& - cam_take_snapshot_before_out, cam_take_snapshot_after_out) + cam_take_snapshot_before_out, cam_take_snapshot_after_out, physics_grid_out, do_hb_above_clubb_out) !----------------------------------------------------------------------- ! Purpose: Return runtime settings ! deep_scheme_out : deep convection scheme @@ -300,7 +324,6 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi ! eddy_scheme_out : vertical diffusion scheme ! microp_scheme_out : microphysics scheme ! radiation_scheme_out : radiation_scheme -! SPCAM_microp_scheme_out : SPCAM microphysics scheme !----------------------------------------------------------------------- character(len=16), intent(out), optional :: deep_scheme_out @@ -310,7 +333,6 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi character(len=16), intent(out), optional :: radiation_scheme_out character(len=16), intent(out), optional :: macrop_scheme_out logical, intent(out), optional :: use_subcol_microp_out - logical, intent(out), optional :: use_spcam_out logical, intent(out), optional :: atm_dep_flux_out logical, intent(out), optional :: history_amwg_out logical, intent(out), optional :: history_vdiag_out @@ -339,6 +361,8 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi integer, intent(out), optional :: cam_snapshot_after_num_out character(len=32), intent(out), optional :: cam_take_snapshot_before_out character(len=32), intent(out), optional :: cam_take_snapshot_after_out + character(len=cl), intent(out), optional :: physics_grid_out + logical, intent(out), optional :: do_hb_above_clubb_out if ( present(deep_scheme_out ) ) deep_scheme_out = deep_scheme if ( present(shallow_scheme_out ) ) shallow_scheme_out = shallow_scheme @@ -346,7 +370,6 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi if ( present(microp_scheme_out ) ) microp_scheme_out = microp_scheme if ( present(radiation_scheme_out ) ) radiation_scheme_out = radiation_scheme if ( present(use_subcol_microp_out ) ) use_subcol_microp_out = use_subcol_microp - if ( present(use_spcam_out ) ) use_spcam_out = use_spcam if ( present(macrop_scheme_out ) ) macrop_scheme_out = macrop_scheme if ( present(atm_dep_flux_out ) ) atm_dep_flux_out = atm_dep_flux @@ -377,6 +400,8 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi if ( present(cam_snapshot_after_num_out ) ) cam_snapshot_after_num_out = cam_snapshot_after_num if ( present(cam_take_snapshot_before_out) ) cam_take_snapshot_before_out = cam_take_snapshot_before if ( present(cam_take_snapshot_after_out ) ) cam_take_snapshot_after_out = cam_take_snapshot_after + if ( present(physics_grid_out ) ) physics_grid_out = cam_physics_mesh + if ( present(do_hb_above_clubb_out ) ) do_hb_above_clubb_out = do_hb_above_clubb end subroutine phys_getopts diff --git a/src/physics/cam/phys_debug_util.F90 b/src/physics/cam/phys_debug_util.F90 index a7775c2202..76d91d3746 100644 --- a/src/physics/cam/phys_debug_util.F90 +++ b/src/physics/cam/phys_debug_util.F90 @@ -18,8 +18,7 @@ module phys_debug_util !---------------------------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 -use phys_grid, only: phys_grid_find_col, get_rlat_p, get_rlon_p -use spmd_utils, only: masterproc, iam +use spmd_utils, only: masterproc, iam, mpicom, npes use cam_logfile, only: iulog use cam_abortutils, only: endrun @@ -27,7 +26,7 @@ module phys_debug_util private save -real(r8), parameter :: uninit_r8 = huge(1._r8) +real(r8), parameter :: uninitr8 = huge(1._r8) ! Public methods public phys_debug_readnl ! read namelist input @@ -35,8 +34,8 @@ module phys_debug_util public phys_debug_col ! return local column index in debug chunk ! Namelist variables -real(r8) :: phys_debug_lat = uninit_r8 ! latitude of requested debug column location in degrees -real(r8) :: phys_debug_lon = uninit_r8 ! longitude of requested debug column location in degrees +real(r8) :: phys_debug_lat = uninitr8 ! latitude of requested debug column location in degrees +real(r8) :: phys_debug_lon = uninitr8 ! longitude of requested debug column location in degrees integer :: debchunk = -999 ! local index of the chuck we will debug @@ -73,6 +72,23 @@ subroutine phys_debug_readnl(nlfile) end if close(unitn) call freeunit(unitn) + ! Check inputs + if (phys_debug_lat /= uninitr8) then + if (abs(phys_debug_lat) > 90.0_r8) then + write(iulog, *) subname, ': phys_debug_lat out of range [-90., 90.]' + call endrun(subname//': phys_debug_lat out of range [-90., 90.]') + end if + else + write(iulog, *) subname, ': phys_debug_lat = ', phys_debug_lat + end if + if (phys_debug_lon /= uninitr8) then + if ((phys_debug_lon < 0.0_r8) .or. (phys_debug_lon > 360.0_r8)) then + write(iulog, *) subname, ': phys_debug_lon out of range [0., 360.]' + call endrun(subname//': phys_debug_lon out of range [0., 360.]') + end if + else + write(iulog, *) subname, ': phys_debug_lon = ', phys_debug_lon + end if end if #ifdef SPMD @@ -83,27 +99,116 @@ subroutine phys_debug_readnl(nlfile) end subroutine phys_debug_readnl -!================================================================================ +!============================================================================== subroutine phys_debug_init() - - integer :: owner, lchunk, icol - real(r8) :: deblat, deblon - !----------------------------------------------------------------------------- + use mpi, only: mpi_real8, mpi_integer, mpi_min, mpi_max + use physconst, only: pi + use ppgrid, only: begchunk, endchunk + use phys_grid, only: get_ncols_p, get_rlat_p, get_rlon_p + + integer :: owner, lchunk, icol, ncol + integer :: lchunk_min, icol_min, minlondist + real(r8) :: deblat, deblon + real(r8) :: latmin, lonmin + real(r8) :: lat, lon, dist, temp1, temp2 + real(r8) :: mindist + real(r8), parameter :: maxangle = pi / 4.0_r8 + real(r8), parameter :: rad2deg = 180.0_r8 / pi + real(r8), parameter :: deg2rad = pi / 180.0_r8 + real(r8), parameter :: maxtol = 0.99999_r8 ! max cos value + real(r8), parameter :: maxlat = pi * maxtol / 2.0_r8 + !--------------------------------------------------------------------------- ! If no debug column specified then do nothing - if (phys_debug_lat == uninit_r8 .or. phys_debug_lon == uninit_r8) return + if ((phys_debug_lat == uninitr8) .or. (phys_debug_lon == uninitr8)) then + return + end if ! User has specified a column location for debugging. Find the closest ! column in the physics grid. - call phys_grid_find_col(phys_debug_lat, phys_debug_lon, owner, lchunk, icol) - + mindist = 2.0_r8 * pi + deblat = pi + deblon = 3.0_r8 * pi + latmin = phys_debug_lat * deg2rad + lonmin = phys_debug_lon * deg2rad + lchunk_min = -1 + icol_min = -1 + do lchunk = begchunk, endchunk + ncol = get_ncols_p(lchunk) + do icol = 1, ncol + lat = get_rlat_p(lchunk, icol) + lon = get_rlon_p(lchunk, icol) + if ( (abs(lat - latmin) <= maxangle) .and. & + (abs(lon - lonmin) <= maxangle)) then + ! maxangle could be pi but why waste all those trig functions? + if ((lat == latmin) .and. (lon == lonmin)) then + dist = 0.0_r8 + else + temp1 = (sin(latmin) * sin(lat)) + & + (cos(latmin) * cos(lat) * cos(lon - lonmin)) + if (temp1 > maxtol) then + ! Use haversine formula + temp1 = sin((latmin - lat) / 2.0_r8) + temp2 = sin((lonmin - lon) / 2.0_r8) + dist = (temp1 * temp1) + & + (cos(latmin)* cos(lat) * temp2 * temp2) + dist = 2.0_r8 * asin(sqrt(dist)) + else + dist = acos(temp1) + end if + end if + if ( (dist < mindist) .or. & + ((dist == mindist) .and. & + (abs(lon - lonmin) < abs(deblon - lonmin)))) then + lchunk_min = lchunk + icol_min = icol + mindist = dist + deblon = lon + deblat = lat + if (dist == 0.0_r8) then + exit + end if + end if + end if + end do + end do + ! We need to find the minimum mindist and use only that value + dist = mindist + call MPI_allreduce(dist, mindist, 1, mpi_real8, mpi_min, mpicom, icol) + ! Special case for pole points + if (deblat > pi / 2.0_r8) then + temp1 = 0.0_r8 + else + temp1 = abs(deblat) + end if + call MPI_allreduce(temp1, lat, 1, mpi_real8, mpi_max, mpicom, icol) + if ((abs(latmin) > maxlat) .or. (lat > maxlat)) then + if (dist == mindist) then + ! Only distance winners can compete + lon = abs(deblon - lonmin) + else + lon = 3.0_r8 * pi + end if + call MPI_allreduce(lon, minlondist, 1, mpi_real8, mpi_min, mpicom, icol) + ! Kill the losers + if (lon /= minlondist) then + dist = dist + 1.0_r8 + end if + end if + ! Now, only task(s) which have real minimum distance should be owner + if (dist == mindist) then + lchunk = iam + else + lchunk = npes + 2 + end if + call MPI_allreduce(lchunk, owner, 1, mpi_integer, mpi_min, mpicom, icol) ! If the column is owned by this process then save its local indices if (iam == owner) then - debchunk = lchunk - debcol = icol - deblat = get_rlat_p(lchunk, icol)*57.296_r8 ! approximate conversion for log output only - deblon = get_rlon_p(lchunk, icol)*57.296_r8 + debchunk = lchunk_min + debcol = icol_min + deblat = get_rlat_p(lchunk_min, icol_min) * rad2deg + deblon = get_rlon_p(lchunk_min, icol_min) * rad2deg write(iulog,*) 'phys_debug_init: debugging column at lat=', deblat, ' lon=', deblon end if diff --git a/src/physics/cam/phys_gmean.F90 b/src/physics/cam/phys_gmean.F90 index 2fd003b96e..6681bcd7b2 100644 --- a/src/physics/cam/phys_gmean.F90 +++ b/src/physics/cam/phys_gmean.F90 @@ -2,43 +2,18 @@ module phys_gmean !----------------------------------------------------------------------- ! ! Purpose: -! Perform mixed layer global calculations for energy conservation checks. -! -! Methods: -! Reproducible (nonscalable): -! Gather to a master processor who does all the work. -! Reproducible (scalable): -! Convert to fixed point (integer representation) to enable -! reproducibility when using MPI collectives. Results compared with -! a nonreproducible (but scalable) algorithm using floating point -! and MPI_Allreduce to verify the results are good enough. +! Computes global mean mass, max and min mmr, of constituents on the +! physics decomposition. Prints diagnostics to log file. ! -! Author: Byron Boville from SOM code by Jim Rosinski/Bruce Briegleb -! Modified: P. Worley to aggregate calculations (4/04) -! Modified: J. White/P. Worley to introduce scalable algorithms; -! B. Eaton to remove dycore-specific dependencies and to -! introduce gmean_mass (10/07) -! Modified: P. Worley to replace in-place implementation with call -! to repro_sum. +! Author: B. Eaton (based on gavglook) ! !----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use physconst, only: pi - use spmd_utils, only: masterproc, MPI_REAL8, MPI_MAX, MPI_MIN, mpicom - use gmean_mod, only: gmean - use ppgrid, only: pcols, begchunk, endchunk - use shr_reprosum_mod, only: shr_reprosum_calc, shr_reprosum_tolExceeded, & - shr_reprosum_reldiffmax, shr_reprosum_recompute - use perf_mod - use cam_logfile, only: iulog - implicit none private - save public :: gmean_mass ! compute global mean mass of constituent fields on physics decomposition - CONTAINS +CONTAINS ! !======================================================================== @@ -54,8 +29,14 @@ subroutine gmean_mass(title, state) ! Author: B. Eaton (based on gavglook) ! !----------------------------------------------------------------------- - use ppgrid, only: pver + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: MPI_REAL8, MPI_MAX, MPI_MIN + use spmd_utils, only: masterproc, masterprocid, mpicom + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use ppgrid, only: pver, pcols, begchunk, endchunk use physconst, only: gravit + use gmean_mod, only: gmean use phys_grid, only: get_ncols_p use physics_types, only: physics_state use constituents, only: pcnst, cnst_name @@ -68,10 +49,9 @@ subroutine gmean_mass(title, state) ! Local workspace ! character(len=*), parameter :: sub_name='gmean_mass: ' - - integer :: c, i, k, m - integer :: ierr - integer :: ncols + integer :: ick, icol, lind, im + integer :: ierr + integer :: ncols real(r8), pointer :: mass_wet(:,:,:) ! constituent masses assuming moist mmr real(r8), pointer :: mass_dry(:,:,:) ! constituent masses assuming dry mmr @@ -85,35 +65,39 @@ subroutine gmean_mass(title, state) !----------------------------------------------------------------------- ! allocate(mass_wet(pcols,begchunk:endchunk,pcnst), stat=ierr) - if (ierr /= 0) write(iulog,*) sub_name // 'FAIL to allocate mass_wet' + if (ierr /= 0) then + call endrun(sub_name //'FAIL to allocate mass_wet') + end if allocate(mass_dry(pcols,begchunk:endchunk,pcnst), stat=ierr) - if (ierr /= 0) write(iulog,*) sub_name // 'FAIL to allocate mass_wet' + if (ierr /= 0) then + call endrun(sub_name//'FAIL to allocate mass_wet') + end if mmr_max(:) = -1.e36_r8 mmr_min(:) = 1.e36_r8 - do m = 1, pcnst - do c = begchunk, endchunk - ncols = get_ncols_p(c) - do i = 1, ncols + do im = 1, pcnst + do ick = begchunk, endchunk + ncols = get_ncols_p(ick) + do icol = 1, ncols ! Compute column masses assuming both dry and wet mixing ratios - mass_wet(i,c,m) = 0.0_r8 - do k = 1, pver - mass_wet(i,c,m) = mass_wet(i,c,m) + & - state(c)%pdel(i,k)*state(c)%q(i,k,m) - mmr_max(m) = max(mmr_max(m), state(c)%q(i,k,m)) - mmr_min(m) = min(mmr_min(m), state(c)%q(i,k,m)) + mass_wet(icol, ick, im) = 0.0_r8 + do lind = 1, pver + mass_wet(icol,ick,im) = mass_wet(icol,ick,im) + & + state(ick)%pdel(icol,lind)*state(ick)%q(icol,lind,im) + mmr_max(im) = max(mmr_max(im), state(ick)%q(icol,lind,im)) + mmr_min(im) = min(mmr_min(im), state(ick)%q(icol,lind,im)) end do - mass_wet(i,c,m) = mass_wet(i,c,m)/gravit + mass_wet(icol,ick,im) = mass_wet(icol,ick,im)/gravit - mass_dry(i,c,m) = 0.0_r8 - do k = 1, pver - mass_dry(i,c,m) = mass_dry(i,c,m) + & - state(c)%pdeldry(i,k)*state(c)%q(i,k,m) + mass_dry(icol,ick,im) = 0.0_r8 + do lind = 1, pver + mass_dry(icol,ick,im) = mass_dry(icol,ick,im) + & + state(ick)%pdeldry(icol,lind)*state(ick)%q(icol,lind,im) end do - mass_dry(i,c,m) = mass_dry(i,c,m)/gravit + mass_dry(icol,ick,im) = mass_dry(icol,ick,im)/gravit end do end do @@ -124,20 +108,24 @@ subroutine gmean_mass(title, state) call gmean(mass_dry, mass_dry_mean, pcnst) ! global min/max mmr - call mpi_reduce(mmr_max, mmr_max_glob, pcnst, MPI_REAL8, MPI_MAX, 0, mpicom, ierr) - call mpi_reduce(mmr_min, mmr_min_glob, pcnst, MPI_REAL8, MPI_MIN, 0, mpicom, ierr) + call mpi_reduce(mmr_max, mmr_max_glob, pcnst, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, ierr) + call mpi_reduce(mmr_min, mmr_min_glob, pcnst, MPI_REAL8, MPI_MIN, & + masterprocid, mpicom, ierr) ! report to log file if (masterproc) then - - do m = 1, pcnst - write (6,66) trim(title)//' m=',m, & - 'name='//trim(cnst_name(m))//' gavg dry, wet, min, max ', & - mass_dry_mean(m), mass_wet_mean(m), mmr_min_glob(m), mmr_max_glob(m) -66 format (a24,i2,a36,1p,4e25.13) + write(iulog, *) 'vvvvv ', sub_name, trim(title), ' vvvvv' + write(iulog, *) 'm name ', & + ' gavg dry ', ' gavg wet ', & + ' gavg min ', ' gavg max ' + do im = 1, pcnst + write (iulog, '(i2,a36,4(" ",e20.13e2))') im, & + trim(cnst_name(im)), mass_dry_mean(im), mass_wet_mean(im), & + mmr_min_glob(im), mmr_max_glob(im) end do - - endif + write(iulog, *) '^^^^^ ', sub_name, trim(title), ' ^^^^^' + end if deallocate(mass_wet) deallocate(mass_dry) diff --git a/src/physics/cam/phys_grid.F90 b/src/physics/cam/phys_grid.F90 index ea609dc2d1..e87726469f 100644 --- a/src/physics/cam/phys_grid.F90 +++ b/src/physics/cam/phys_grid.F90 @@ -14,6 +14,7 @@ module phys_grid ! ! get_chunk_indices_p get local chunk index range ! get_ncols_p get number of columns for a given chunk +! get_grid_dims return physics grid axis global sizes ! get_xxx_all_p get global indices, coordinates, or values ! for a given chunk ! get_xxx_vec_p get global indices, coordinates, or values @@ -110,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 @@ -118,9 +120,9 @@ module phys_grid ! hdim2_d == 1. ! physics field data structures - integer :: ngcols ! global column count in physics grid (all) - integer, public :: ngcols_p ! global column count in physics grid - ! (without holes) + integer, private :: ngcols ! global column count in physics grid (all) + integer, public :: num_global_phys_cols ! global column count in phys grid + ! (without holes) integer, dimension(:), allocatable, private :: dyn_to_latlon_gcol_map ! map from unsorted (dynamics) to lat/lon sorted grid indices @@ -294,6 +296,8 @@ module phys_grid integer, private, parameter :: def_alltoall = -1 ! default integer, private :: phys_alltoall = def_alltoall + logical :: calc_memory_increase = .false. + !======================================================================== contains !======================================================================== @@ -362,7 +366,7 @@ subroutine phys_grid_readnl(nlfile) lbal_opt = phys_loadbalance - if (lbal_opt .eq. 3) then + if (lbal_opt == 3) then phys_mirror_decomp_req = .true. else phys_mirror_decomp_req = .false. @@ -374,12 +378,12 @@ subroutine phys_grid_readnl(nlfile) ! Some consistency checks - if (((phys_alltoall .lt. min_alltoall) .or. & - (phys_alltoall .gt. max_alltoall)) & + if (((phys_alltoall < min_alltoall) .or. & + (phys_alltoall > max_alltoall)) & # if defined(MODCM_DP_TRANSPOSE) - .and. & - ((phys_alltoall .lt. modmin_alltoall) .or. & - (phys_alltoall .gt. modmax_alltoall)) & + .and. & + ((phys_alltoall < modmin_alltoall) .or. & + (phys_alltoall > modmax_alltoall)) & # endif ) then if (masterproc) then @@ -446,15 +450,19 @@ subroutine phys_grid_init( ) ! Author: John Drake and Patrick Worley ! !----------------------------------------------------------------------- - use pmgrid, only: plev - use dycore, only: dycore_is - use dyn_grid, only: get_block_bounds_d, & - get_block_gcol_d, get_block_gcol_cnt_d, & - get_block_levels_d, get_block_lvl_cnt_d, & - get_block_owner_d, & - get_gcol_block_d, get_gcol_block_cnt_d, & + 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, & + get_block_gcol_d, get_block_gcol_cnt_d, & + get_block_levels_d, get_block_lvl_cnt_d, & + get_block_owner_d, & + get_gcol_block_d, get_gcol_block_cnt_d, & get_horiz_grid_dim_d, get_horiz_grid_d, physgrid_copy_attributes_d - use spmd_utils, only: pair, ceil2 + use spmd_utils, only: pair, ceil2, masterprocid, mpicom use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register use cam_grid_support, only: iMap, max_hcoordname_len use cam_grid_support, only: horiz_coord_t, horiz_coord_create @@ -493,6 +501,9 @@ subroutine phys_grid_init( ) ! column surface area (from dynamics) real(r8), dimension(:), pointer :: area_d + ! column surface areawt (from dynamics) + real(r8), dimension(:), pointer :: areawt_d + ! column integration weight (from dynamics) real(r8), dimension(:), allocatable :: wght_d @@ -517,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 @@ -525,15 +537,21 @@ subroutine phys_grid_init( ) character(len=max_hcoordname_len) :: copy_gridname logical :: unstructured real(r8) :: lonmin, latmin + real(r8) :: mem_hw_beg, mem_hw_end + real(r8) :: mem_beg, mem_end nullify(area_d) nullify(lonvals) nullify(latvals) nullify(grid_map) + if (single_column) nullify(grid_map_scm) nullify(lat_coord) nullify(lon_coord) - call t_adj_detailf(-2) + if (calc_memory_increase) then + call shr_mem_getusage(mem_hw_beg, mem_beg) + end if + call t_startf("phys_grid_init") !----------------------------------------------------------------------- @@ -553,13 +571,12 @@ subroutine phys_grid_init( ) call get_horiz_grid_d(ngcols, clat_d_out=clat_d, clon_d_out=clon_d, lat_d_out=lat_d, lon_d_out=lon_d) latmin = minval(lat_d) lonmin = minval(lon_d) -!!XXgoldyXX: To do: replace collection above with local physics points ! count number of "real" column indices - ngcols_p = 0 + num_global_phys_cols = 0 do i=1,ngcols if (clon_d(i) < 100000.0_r8) then - ngcols_p = ngcols_p + 1 + num_global_phys_cols = num_global_phys_cols + 1 endif enddo @@ -569,7 +586,7 @@ subroutine phys_grid_init( ) clon_p_tmp = clon_d(cdex(1)) clon_p_tot = 1 - do i=2,ngcols_p + do i=2,num_global_phys_cols if (clon_d(cdex(i)) > clon_p_tmp) then clon_p_tot = clon_p_tot + 1 clon_p_tmp = clon_d(cdex(i)) @@ -584,7 +601,7 @@ subroutine phys_grid_init( ) clon_p_tot = 1 clon_p(1) = clon_d(cdex(1)) londeg_p(1) = lon_d(cdex(1)) - do i=2,ngcols_p + do i=2,num_global_phys_cols if (clon_d(cdex(i)) > clon_p(clon_p_tot)) then clon_p_cnt(clon_p_tot) = i-pre_i pre_i = i @@ -593,14 +610,14 @@ subroutine phys_grid_init( ) londeg_p(clon_p_tot) = lon_d(cdex(i)) endif enddo - clon_p_cnt(clon_p_tot) = (ngcols_p+1)-pre_i + clon_p_cnt(clon_p_tot) = (num_global_phys_cols+1)-pre_i ! sort over latitude and identify unique latitude coordinates call IndexSet(ngcols,cdex) call IndexSort(ngcols,cdex,clat_d,descend=.false.) clat_p_tmp = clat_d(cdex(1)) clat_p_tot = 1 - do i=2,ngcols_p + do i=2,num_global_phys_cols if (clat_d(cdex(i)) > clat_p_tmp) then clat_p_tot = clat_p_tot + 1 clat_p_tmp = clat_d(cdex(i)) @@ -616,7 +633,7 @@ subroutine phys_grid_init( ) clat_p_tot = 1 clat_p(1) = clat_d(cdex(1)) latdeg_p(1) = lat_d(cdex(1)) - do i=2,ngcols_p + do i=2,num_global_phys_cols if (clat_d(cdex(i)) > clat_p(clat_p_tot)) then clat_p_cnt(clat_p_tot) = i-pre_i pre_i = i @@ -625,7 +642,7 @@ subroutine phys_grid_init( ) latdeg_p(clat_p_tot) = lat_d(cdex(i)) endif enddo - clat_p_cnt(clat_p_tot) = (ngcols_p+1)-pre_i + clat_p_cnt(clat_p_tot) = (num_global_phys_cols+1)-pre_i clat_p_idx(1) = 1 do j=2,clat_p_tot @@ -645,8 +662,9 @@ subroutine phys_grid_init( ) ! Early clean-up, to minimize memory high water mark ! (not executing find_partner or find_twin) - if (((twin_alg .ne. 1) .and. (lbal_opt .ne. 3)) .or. & - (lbal_opt .eq. -1)) deallocate( clat_p_cnt) + if (((twin_alg /= 1) .and. (lbal_opt /= 3)) .or. (lbal_opt == -1)) then + deallocate( clat_p_cnt) + end if ! save "longitude within latitude" column ordering ! and determine mapping from unsorted global column index to @@ -654,13 +672,15 @@ subroutine phys_grid_init( ) allocate( lat_p(1:ngcols) ) allocate( lon_p(1:ngcols) ) allocate( dyn_to_latlon_gcol_map(1:ngcols) ) - if (lbal_opt .ne. -1) allocate( latlon_to_dyn_gcol_map(1:ngcols_p) ) + if (lbal_opt /= -1) then + allocate(latlon_to_dyn_gcol_map(1:num_global_phys_cols)) + end if clat_p_dex = 1 lat_p = -1 dyn_to_latlon_gcol_map = -1 - do i=1,ngcols_p - if (lbal_opt .ne. -1) latlon_to_dyn_gcol_map(i) = cdex(i) + do i = 1, num_global_phys_cols + if (lbal_opt /= -1) latlon_to_dyn_gcol_map(i) = cdex(i) dyn_to_latlon_gcol_map(cdex(i)) = i do while ((clat_p(clat_p_dex) < clat_d(cdex(i))) .and. & @@ -682,17 +702,17 @@ subroutine phys_grid_init( ) ! Early clean-up, to minimize memory high water mark ! (not executing find_twin) - if ((twin_alg .ne. 1) .or. (lbal_opt .eq. -1)) deallocate( clon_p_cnt ) + if ((twin_alg /= 1) .or. (lbal_opt == -1)) deallocate( clon_p_cnt ) ! save "latitude within longitude" column ordering ! (only need in find_twin) - if ((twin_alg .eq. 1) .and. (lbal_opt .ne. -1)) & - allocate( lonlat_to_dyn_gcol_map(1:ngcols_p) ) + if ((twin_alg == 1) .and. (lbal_opt /= -1)) & + allocate( lonlat_to_dyn_gcol_map(1:num_global_phys_cols) ) clon_p_dex = 1 lon_p = -1 - do i=1,ngcols_p - if ((twin_alg .eq. 1) .and. (lbal_opt .ne. -1)) & + do i=1,num_global_phys_cols + if ((twin_alg == 1) .and. (lbal_opt /= -1)) & lonlat_to_dyn_gcol_map(i) = cdex(i) do while ((clon_p(clon_p_dex) < clon_d(cdex(i))) .and. & (clon_p_dex < clon_p_tot)) @@ -762,7 +782,7 @@ subroutine phys_grid_init( ) ! check whether global index is for a column that dynamics ! intends to pass to the physics curgcol_d = cdex(i) - if (dyn_to_latlon_gcol_map(curgcol_d) .ne. -1) then + if (dyn_to_latlon_gcol_map(curgcol_d) /= -1) then ! yes - then save the information ncols = ncols + 1 chunks(cid)%gcol(ncols) = curgcol_d @@ -832,9 +852,9 @@ subroutine phys_grid_init( ) deallocate( lat_p ) deallocate( lon_p ) deallocate( latlon_to_dyn_gcol_map ) - if (twin_alg .eq. 1) deallocate( lonlat_to_dyn_gcol_map ) - if (twin_alg .eq. 1) deallocate( clon_p_cnt ) - if ((twin_alg .eq. 1) .or. (lbal_opt .eq. 3)) deallocate( clat_p_cnt ) + if (twin_alg == 1) deallocate( lonlat_to_dyn_gcol_map ) + if (twin_alg == 1) deallocate( clon_p_cnt ) + if ((twin_alg == 1) .or. (lbal_opt == 3)) deallocate( clat_p_cnt ) ! ! Determine whether dynamics and physics decompositions @@ -848,7 +868,7 @@ subroutine phys_grid_init( ) call get_gcol_block_d(curgcol_d,block_cnt,blockids,bcids) do jb=1,block_cnt owner_d = get_block_owner_d(blockids(jb)) - if (owner_d .ne. chunks(cid)%owner) then + if (owner_d /= chunks(cid)%owner) then local_dp_map = .false. endif enddo @@ -858,7 +878,7 @@ subroutine phys_grid_init( ) ! ! Allocate and initialize data structures for gather/scatter ! - allocate( pgcols(1:ngcols_p) ) + allocate( pgcols(1:num_global_phys_cols) ) allocate( gs_col_offset(0:npes) ) allocate( pchunkid(0:npes) ) @@ -971,7 +991,7 @@ subroutine phys_grid_init( ) glbcnt = 0 curcnt = 0 curp = 0 - do curgcol=1,ngcols_p + do curgcol=1,num_global_phys_cols cid = pgcols(curgcol)%chunk i = pgcols(curgcol)%ccol owner_p = chunks(cid)%owner @@ -1090,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 @@ -1117,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 @@ -1135,12 +1167,13 @@ subroutine phys_grid_init( ) ! Note that if the dycore is using the same points as the physics grid, ! it will have already set up 'lat' and 'lon' axes for the physics grid ! However, these will be in the dynamics decomposition - if (unstructured) then - lon_coord => horiz_coord_create('lon', 'ncol', ngcols_p, 'longitude', & - 'degrees_east', 1, size(lonvals), lonvals, map=grid_map(3,:)) - lat_coord => horiz_coord_create('lat', 'ncol', ngcols_p, 'latitude', & - 'degrees_north', 1, size(latvals), latvals, map=grid_map(3,:)) + lon_coord => horiz_coord_create('lon', 'ncol', num_global_phys_cols, & + 'longitude', 'degrees_east', 1, size(lonvals), lonvals, & + map=grid_map(3,:)) + lat_coord => horiz_coord_create('lat', 'ncol', num_global_phys_cols, & + 'latitude', 'degrees_north', 1, size(latvals), latvals, & + map=grid_map(3,:)) else allocate(coord_map(size(grid_map, 2))) @@ -1168,19 +1201,21 @@ 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) do i = 1, size(copy_attributes) call cam_grid_attribute_copy(copy_gridname, 'physgrid', copy_attributes(i)) end do - if ((.not. cam_grid_attr_exists('physgrid', 'area')) .and. unstructured) then ! Physgrid always needs an area attribute. If we did not inherit one ! from the dycore (i.e., physics and dynamics are on different grids), ! create that attribute here (unstructured grids only, physgrid is ! not supported for structured grids). allocate(area_d(size(grid_map, 2))) + allocate(areawt_d(size(grid_map, 2))) p = 0 do lcid = begchunk, endchunk ncols = lchunks(lcid)%ncols @@ -1189,19 +1224,25 @@ subroutine phys_grid_init( ) cid = lchunks(lcid)%cid do i = 1, chunks(cid)%ncols area_d(p + i) = lchunks(lcid)%area(i) + areawt_d(p + i) = lchunks(lcid)%wght(i) end do if (pcols > ncols) then ! Need to set these to detect unused columns area_d(p+ncols+1:p+pcols) = 0.0_r8 + areawt_d(p+ncols+1:p+pcols) = 0.0_r8 end if p = p + pcols end do call cam_grid_attribute_register('physgrid', 'area', & 'physics column areas', 'ncol', area_d, map=grid_map(3,:)) + call cam_grid_attribute_register('physgrid', 'areawt', & + 'physics column area wts', 'ncol', areawt_d, map=grid_map(3,:)) nullify(area_d) ! Belongs to attribute now + nullify(areawt_d) ! Belongs to attribute now 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) @@ -1216,8 +1257,25 @@ subroutine phys_grid_init( ) physgrid_set = .true. ! Set flag indicating physics grid is now set ! call t_stopf("phys_grid_init") - call t_adj_detailf(+2) - return + + if (calc_memory_increase) then + call shr_mem_getusage(mem_hw_end, mem_end) + clat_p_tmp = mem_end - mem_beg + call MPI_reduce(clat_p_tmp, mem_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) then + write(iulog, *) 'phys_grid_init: Increase in memory usage = ', & + mem_end, ' (MB)' + end if + clat_p_tmp = mem_hw_end - mem_hw_beg + call MPI_reduce(clat_p_tmp, mem_hw_end, 1, MPI_REAL8, MPI_MAX, & + masterprocid, mpicom, curp) + if (masterproc) then + write(iulog, *) 'phys_grid_init: Increase in memory highwater = ', & + mem_end, ' (MB)' + end if + end if + end subroutine phys_grid_init !======================================================================== @@ -1531,6 +1589,24 @@ integer function get_ncols_p(lcid) return end function get_ncols_p + +!======================================================================== + + subroutine get_grid_dims(hdim1_d_out, hdim2_d_out) + use cam_abortutils, only: endrun + ! retrieve dynamics field grid information + ! hdim1_d and hdim2_d are dimensions of rectangular horizontal grid + ! data structure, If 1D data structure, then hdim2_d == 1. + integer, intent(out) :: hdim1_d_out + integer, intent(out) :: hdim2_d_out + + if (.not. phys_grid_initialized()) then + call endrun('get_grid_dims: physics grid not initialized') + end if + hdim1_d_out = hdim1_d + hdim2_d_out = hdim2_d + + end subroutine get_grid_dims ! !======================================================================== ! @@ -2043,92 +2119,6 @@ end function get_rlon_p ! !======================================================================== ! -! integer function get_gcol_owner_p(gcol) -!----------------------------------------------------------------------- -! -! Purpose: Return owner of physics column with indicate index -! -! Method: -! -! Author: P. Worley -! -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- -! integer, intent(in) :: gcol ! physics column index -! -!----------------------------------------------------------------------- -! -! get_gcol_owner_p = chunks(knuhcs(gcol)%chunkid)%owner -! -! return -! end function get_gcol_owner_p -! -!======================================================================== - -! subroutine buff_to_chunk(fdim,mdim,lbuff,localchunks) -!----------------------------------------------------------------------- -! -! Purpose: Copy from local buffer -! to local chunk data structure. -! Needed for cpl6. -! -! Method: -! -! Author: Pat Worley and Robert Jacob -! -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- -! integer, intent(in) :: fdim ! declared length of first lbuff dimension -! integer, intent(in) :: mdim ! declared length of middle lbuff dimension -! real(r8), intent(in) :: lbuff(fdim, mdim) ! local lon/lat buffer -! -! real(r8), intent(out):: localchunks(pcols,mdim,begchunk:endchunk) ! local chunks -! -! -!---------------------------Local workspace----------------------------- -! integer :: i,j,m,n ! loop indices -! -! integer, save :: numcols = 0 -! integer, allocatable, save :: columnid(:), chunkid(:) -!----------------------------------------------------------------------- -! -! if (numcols .eq. 0) then -! n = 0 -! do i=1,ngcols -! if (dyn_to_latlon_gcol_map(i) .ne. -1) then -! if(chunks(knuhcs(i)%chunkid)%owner .eq. iam) then -! n = n + 1 -! endif -! endif -! enddo -! allocate(columnid(1:n)) -! allocate(chunkid(1:n)) -! -! n = 0 -! do i=1,ngcols -! if (dyn_to_latlon_gcol_map(i) .ne. -1) then -! if(chunks(knuhcs(i)%chunkid)%owner .eq. iam) then -! n = n + 1 -! columnid(n) = knuhcs(i)%col -! chunkid(n) = chunks(knuhcs(i)%chunkid)%lcid -! endif -! endif -! end do -! -! numcols = n -! endif -! -! if (numcols .gt. fdim) call endrun('buff_to_chunk') -! do m=1,mdim -! do n = 1, numcols -! localchunks(columnid(n),m,chunkid(n)) = lbuff(n,m) -! end do -! end do -! -! return -! end subroutine buff_to_chunk -! -!======================================================================== subroutine scatter_field_to_chunk(fdim,mdim,ldim, & hdim1d,globalfield,localchunks) @@ -2201,7 +2191,7 @@ subroutine scatter_field_to_chunk(fdim,mdim,ldim, & ! copy field into global (process-ordered) chunked data structure do l=1,ldim - do i=1,ngcols_p + do i=1,num_global_phys_cols cid = pgcols(i)%chunk lid = pgcols(i)%ccol gcol = chunks(cid)%gcol(lid) @@ -2247,7 +2237,7 @@ subroutine scatter_field_to_chunk(fdim,mdim,ldim, & ! local ordering) do l=1,ldim - do i=1,ngcols_p + do i=1,num_global_phys_cols cid = pgcols(i)%chunk lcid = chunks(cid)%lcid lid = pgcols(i)%ccol @@ -2336,7 +2326,7 @@ subroutine scatter_field_to_chunk4(fdim,mdim,ldim, & if (masterproc) then ! copy field into global (process-ordered) chunked data structure do l=1,ldim - do i=1,ngcols_p + do i=1,num_global_phys_cols cid = pgcols(i)%chunk lid = pgcols(i)%ccol gcol = chunks(cid)%gcol(lid) @@ -2381,7 +2371,7 @@ subroutine scatter_field_to_chunk4(fdim,mdim,ldim, & ! (pgcol ordering chosen to reflect begchunk:endchunk ! local ordering) do l=1,ldim - do i=1,ngcols_p + do i=1,num_global_phys_cols cid = pgcols(i)%chunk lcid = chunks(cid)%lcid lid = pgcols(i)%ccol @@ -2471,7 +2461,7 @@ subroutine scatter_field_to_chunk_int(fdim,mdim,ldim, & ! copy field into global (process-ordered) chunked data structure do l=1,ldim - do i=1,ngcols_p + do i=1,num_global_phys_cols cid = pgcols(i)%chunk lid = pgcols(i)%ccol gcol = chunks(cid)%gcol(lid) @@ -2516,7 +2506,7 @@ subroutine scatter_field_to_chunk_int(fdim,mdim,ldim, & ! (pgcol ordering chosen to reflect begchunk:endchunk ! local ordering) do l=1,ldim - do i=1,ngcols_p + do i=1,num_global_phys_cols cid = pgcols(i)%chunk lcid = chunks(cid)%lcid lid = pgcols(i)%ccol @@ -2538,71 +2528,6 @@ subroutine scatter_field_to_chunk_int(fdim,mdim,ldim, & end subroutine scatter_field_to_chunk_int ! !======================================================================== -! -! subroutine chunk_to_buff(fdim,mdim,localchunks,lbuff) -! -!----------------------------------------------------------------------- -! -! Purpose: Copy from local chunk data structure -! to local buffer. Needed for cpl6. -! (local = assigned to same process) -! -! Method: -! -! Author: Pat Worley and Robert Jacob -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- -! integer, intent(in) :: fdim ! declared length of first lbuff dimension -! integer, intent(in) :: mdim ! declared length of middle lbuff dimension -! real(r8), intent(in):: localchunks(pcols,mdim, begchunk:endchunk) ! local chunks -! -! real(r8), intent(out) :: lbuff(fdim,mdim) ! local buff -! -!---------------------------Local workspace----------------------------- -! integer :: i,j,m,n ! loop indices -! -! integer, save :: numcols = 0 -! integer, allocatable, save :: columnid(:), chunkid(:) -!----------------------------------------------------------------------- -! -! if (numcols .eq. 0) then -! n = 0 -! do i=1,ngcols -! if (dyn_to_latlon_gcol_map(i) .ne. -1) then -! if(chunks(knuhcs(i)%chunkid)%owner .eq. iam) then -! n = n + 1 -! endif -! endif -! enddo -! allocate(columnid(1:n)) -! allocate(chunkid(1:n)) -! -! n = 0 -! do i=1,ngcols -! if (dyn_to_latlon_gcol_map(i) .ne. -1) then -! if(chunks(knuhcs(i)%chunkid)%owner .eq. iam) then -! n = n + 1 -! columnid(n) = knuhcs(i)%col -! chunkid(n) = chunks(knuhcs(i)%chunkid)%lcid -! endif -! endif -! end do -! -! numcols = n -! endif -! -! if (numcols .gt. fdim) call endrun('chunk_to_buff') -! do m=1,mdim -! do n = 1, numcols -! lbuff(n,m) = localchunks(columnid(n),m,chunkid(n)) -! end do -! end do -! -! return -! end subroutine chunk_to_buff -! -! -!======================================================================== ! subroutine gather_chunk_to_field(fdim,mdim,ldim, & hdim1d,localchunks,globalfield) @@ -2698,7 +2623,7 @@ subroutine gather_chunk_to_field(fdim,mdim,ldim, & ! copy gathered columns into lon/lat field - do i=1,ngcols_p + do i=1,num_global_phys_cols cid = pgcols(i)%chunk lid = pgcols(i)%ccol gcol = chunks(cid)%gcol(lid) @@ -2721,7 +2646,7 @@ subroutine gather_chunk_to_field(fdim,mdim,ldim, & ! (pgcol ordering chosen to reflect begchunk:endchunk ! local ordering) do l=1,ldim - do i=1,ngcols_p + do i=1,num_global_phys_cols cid = pgcols(i)%chunk lcid = chunks(cid)%lcid lid = pgcols(i)%ccol @@ -2839,7 +2764,7 @@ subroutine gather_chunk_to_field4 (fdim,mdim,ldim, & ! copy gathered columns into lon/lat field - do i=1,ngcols_p + do i=1,num_global_phys_cols cid = pgcols(i)%chunk lid = pgcols(i)%ccol gcol = chunks(cid)%gcol(lid) @@ -2863,7 +2788,7 @@ subroutine gather_chunk_to_field4 (fdim,mdim,ldim, & ! local ordering) do l=1,ldim - do i=1,ngcols_p + do i=1,num_global_phys_cols cid = pgcols(i)%chunk lcid = chunks(cid)%lcid lid = pgcols(i)%ccol @@ -2979,7 +2904,7 @@ subroutine gather_chunk_to_field_int (fdim,mdim,ldim, & ! copy gathered columns into lon/lat field - do i=1,ngcols_p + do i=1,num_global_phys_cols cid = pgcols(i)%chunk lid = pgcols(i)%ccol gcol = chunks(cid)%gcol(lid) @@ -3002,7 +2927,7 @@ subroutine gather_chunk_to_field_int (fdim,mdim,ldim, & ! (pgcol ordering chosen to reflect begchunk:endchunk ! local ordering) do l=1,ldim - do i=1,ngcols_p + do i=1,num_global_phys_cols cid = pgcols(i)%chunk lcid = chunks(cid)%lcid lid = pgcols(i)%ccol @@ -3194,7 +3119,7 @@ subroutine transpose_block_to_chunk(record_size, block_buffer, & ! Also, sendbl and recvbl must have exactly npes elements, to match ! this size of the communicator, or the transpose will fail. ! - if (phys_alltoall .ge. modmin_alltoall) then + if (phys_alltoall >= modmin_alltoall) then mod_method = phys_alltoall - modmin_alltoall ione = 1 allocate( sendbl(0:npes-1) ) @@ -3218,7 +3143,7 @@ subroutine transpose_block_to_chunk(record_size, block_buffer, & first = .false. endif ! - if (record_size .ne. prev_record_size) then + if (record_size /= prev_record_size) then ! ! Compute send/recv/put counts and displacements sdispls(0) = 0 @@ -3238,13 +3163,13 @@ subroutine transpose_block_to_chunk(record_size, block_buffer, & call mpialltoallint(rdispls, 1, pdispls, 1, mpicom) ! # if defined(MODCM_DP_TRANSPOSE) - if (phys_alltoall .ge. modmin_alltoall) then + if (phys_alltoall >= modmin_alltoall) then do p = 0,npes-1 sendbl(p)%type = MPI_DATATYPE_NULL - if ( sndcnts(p) .ne. 0 ) then + if ( sndcnts(p) /= 0 ) then - if (phys_alltoall .gt. modmin_alltoall) then + if (phys_alltoall > modmin_alltoall) then call MPI_TYPE_INDEXED(ione, sndcnts(p), & sdispls(p), mpir8, & sendbl(p)%type, ierror) @@ -3267,9 +3192,9 @@ subroutine transpose_block_to_chunk(record_size, block_buffer, & max_nparcels = max(max_nparcels, sendbl(p)%nparcels) recvbl(p)%type = MPI_DATATYPE_NULL - if ( rcvcnts(p) .ne. 0) then + if ( rcvcnts(p) /= 0) then - if (phys_alltoall .gt. modmin_alltoall) then + if (phys_alltoall > modmin_alltoall) then call MPI_TYPE_INDEXED(ione, rcvcnts(p), & rdispls(p), mpir8, & recvbl(p)%type, ierror) @@ -3309,7 +3234,7 @@ subroutine transpose_block_to_chunk(record_size, block_buffer, & endif else lopt = phys_alltoall - if ((lopt .eq. 2) .and. ( .not. present(window) )) lopt = 1 + if ((lopt == 2) .and. ( .not. present(window) )) lopt = 1 endif if (lopt < 4) then ! @@ -3524,7 +3449,7 @@ subroutine transpose_chunk_to_block(record_size, chunk_buffer, & ! Also, sendbl and recvbl must have exactly npes elements, to match ! this size of the communicator, or the transpose will fail. ! - if (phys_alltoall .ge. modmin_alltoall) then + if (phys_alltoall >= modmin_alltoall) then mod_method = phys_alltoall - modmin_alltoall ione = 1 allocate( sendbl(0:npes-1) ) @@ -3548,7 +3473,7 @@ subroutine transpose_chunk_to_block(record_size, chunk_buffer, & first = .false. endif ! - if (record_size .ne. prev_record_size) then + if (record_size /= prev_record_size) then ! ! Compute send/recv/put counts and displacements sdispls(0) = 0 @@ -3568,13 +3493,13 @@ subroutine transpose_chunk_to_block(record_size, chunk_buffer, & call mpialltoallint(rdispls, 1, pdispls, 1, mpicom) ! # if defined(MODCM_DP_TRANSPOSE) - if (phys_alltoall .ge. modmin_alltoall) then + if (phys_alltoall >= modmin_alltoall) then do p = 0,npes-1 sendbl(p)%type = MPI_DATATYPE_NULL - if ( sndcnts(p) .ne. 0 ) then + if ( sndcnts(p) /= 0 ) then - if (phys_alltoall .gt. modmin_alltoall) then + if (phys_alltoall > modmin_alltoall) then call MPI_TYPE_INDEXED(ione, sndcnts(p), & sdispls(p), mpir8, & sendbl(p)%type, ierror) @@ -3597,9 +3522,9 @@ subroutine transpose_chunk_to_block(record_size, chunk_buffer, & max_nparcels = max(max_nparcels, sendbl(p)%nparcels) recvbl(p)%type = MPI_DATATYPE_NULL - if ( rcvcnts(p) .ne. 0) then + if ( rcvcnts(p) /= 0) then - if (phys_alltoall .gt. modmin_alltoall) then + if (phys_alltoall > modmin_alltoall) then call MPI_TYPE_INDEXED(ione, rcvcnts(p), & rdispls(p), mpir8, & recvbl(p)%type, ierror) @@ -3639,7 +3564,7 @@ subroutine transpose_chunk_to_block(record_size, chunk_buffer, & endif else lopt = phys_alltoall - if ((lopt .eq. 2) .and. ( .not. present(window) )) lopt = 1 + if ((lopt == 2) .and. ( .not. present(window) )) lopt = 1 endif if (lopt < 4) then ! @@ -4030,7 +3955,7 @@ subroutine create_chunks(opt, chunks_per_thread) ! (wrap map) nsmpy = 0 do p=0,npes-1 - if (proc_smp_mapx(p) .eq. -1) then + if (proc_smp_mapx(p) == -1) then proc_smp_mapx(p) = nsmpy nsmpy = mod(nsmpy+1,nsmpx) endif @@ -4070,15 +3995,15 @@ subroutine create_chunks(opt, chunks_per_thread) ! col_smp_mapx(:) = -1 error = .false. - do i=1,ngcols_p + do i=1,num_global_phys_cols curgcol = latlon_to_dyn_gcol_map(i) block_cnt = get_gcol_block_cnt_d(curgcol) call get_gcol_block_d(curgcol,block_cnt,blockids,bcids) do jb=1,block_cnt p = get_block_owner_d(blockids(jb)) - if (col_smp_mapx(i) .eq. -1) then + if (col_smp_mapx(i) == -1) then col_smp_mapx(i) = proc_smp_mapx(p) - elseif (col_smp_mapx(i) .ne. proc_smp_mapx(p)) then + elseif (col_smp_mapx(i) /= proc_smp_mapx(p)) then error = .true. endif enddo @@ -4091,7 +4016,7 @@ subroutine create_chunks(opt, chunks_per_thread) ! allocate( nsmpcolumns(0:nsmpx-1) ) nsmpcolumns(:) = 0 - do i=1,ngcols_p + do i=1,num_global_phys_cols curgcol = latlon_to_dyn_gcol_map(i) smp = col_smp_mapx(curgcol) nsmpcolumns(smp) = nsmpcolumns(smp) + 1 @@ -4138,13 +4063,13 @@ subroutine create_chunks(opt, chunks_per_thread) nchunks = 0 do smp=0,nsmpx-1 nsmpchunks(smp) = nsmpcolumns(smp)/pcols - if (mod(nsmpcolumns(smp), pcols) .ne. 0) then + if (mod(nsmpcolumns(smp), pcols) /= 0) then nsmpchunks(smp) = nsmpchunks(smp) + 1 endif if (nsmpchunks(smp) < chunks_per_thread*nsmpthreads(smp)) then nsmpchunks(smp) = chunks_per_thread*nsmpthreads(smp) endif - do while (mod(nsmpchunks(smp), nsmpthreads(smp)) .ne. 0) + do while (mod(nsmpchunks(smp), nsmpthreads(smp)) /= 0) nsmpchunks(smp) = nsmpchunks(smp) + 1 enddo if (nsmpchunks(smp) > nsmpcolumns(smp)) then @@ -4204,7 +4129,7 @@ subroutine create_chunks(opt, chunks_per_thread) ! ! Assign column to a chunk if not already assigned curgcol = cols(ib) - if ((dyn_to_latlon_gcol_map(curgcol) .ne. -1) .and. & + if ((dyn_to_latlon_gcol_map(curgcol) /= -1) .and. & (knuhcs(curgcol)%chunkid == -1)) then ! ! Find next chunk with space @@ -4222,7 +4147,7 @@ subroutine create_chunks(opt, chunks_per_thread) enddo endif chunks(cid)%ncols = chunks(cid)%ncols + 1 - if (chunks(cid)%ncols .eq. maxcol_chk(smp)) & + if (chunks(cid)%ncols == maxcol_chk(smp)) & maxcol_chks(smp) = maxcol_chks(smp) - 1 ! i = chunks(cid)%ncols @@ -4243,7 +4168,7 @@ subroutine create_chunks(opt, chunks_per_thread) if (twingcol > 0) then chunks(cid)%ncols = chunks(cid)%ncols + 1 - if (chunks(cid)%ncols .eq. maxcol_chk(smp)) & + if (chunks(cid)%ncols == maxcol_chk(smp)) & maxcol_chks(smp) = maxcol_chks(smp) - 1 ! i = chunks(cid)%ncols @@ -4323,7 +4248,7 @@ subroutine create_chunks(opt, chunks_per_thread) ! check whether global index is for a column that dynamics ! intends to pass to the physics curgcol = cols(ib) - if (dyn_to_latlon_gcol_map(curgcol) .ne. -1) then + if (dyn_to_latlon_gcol_map(curgcol) /= -1) then ! yes - then save the information ncols = ncols + 1 chunks(cid)%gcol(ncols) = curgcol @@ -4426,7 +4351,7 @@ subroutine find_partners(opt, proc_busy_d, nsmpx, proc_smp_mapx) twin_proc_mapx(:) = -1 error = .false. - do gcol_latlon=1,ngcols_p + do gcol_latlon=1,num_global_phys_cols ! Assume latitude and longitude symmetries and that index manipulations ! are sufficient to find partners. (Will be true for lon/lat grids.) @@ -4442,9 +4367,9 @@ subroutine find_partners(opt, proc_busy_d, nsmpx, proc_smp_mapx) call get_gcol_block_d(gcol,block_cnt,blockids,bcids) do jb=1,block_cnt p = get_block_owner_d(blockids(jb)) - if (col_proc_mapx(gcol) .eq. -1) then + if (col_proc_mapx(gcol) == -1) then col_proc_mapx(gcol) = p - elseif (col_proc_mapx(gcol) .ne. p) then + elseif (col_proc_mapx(gcol) /= p) then error = .true. endif enddo @@ -4453,9 +4378,9 @@ subroutine find_partners(opt, proc_busy_d, nsmpx, proc_smp_mapx) call get_gcol_block_d(twingcol,block_cnt,blockids,bcids) do jb=1,block_cnt p = get_block_owner_d(blockids(jb)) - if (twin_proc_mapx(gcol) .eq. -1) then + if (twin_proc_mapx(gcol) == -1) then twin_proc_mapx(gcol) = p - elseif (twin_proc_mapx(gcol) .ne. p) then + elseif (twin_proc_mapx(gcol) /= p) then error = .true. endif enddo @@ -4483,9 +4408,9 @@ subroutine find_partners(opt, proc_busy_d, nsmpx, proc_smp_mapx) ! For each process, determine number of twins in each of the other processes ! (running over all columns multiple times to minimize memory requirements). ! - do gcol_latlon=1,ngcols_p + do gcol_latlon=1,num_global_phys_cols gcol = latlon_to_dyn_gcol_map(gcol_latlon) - if (col_proc_mapx(gcol) .eq. p) then + if (col_proc_mapx(gcol) == p) then twin_cnt(twin_proc_mapx(gcol)) = & twin_cnt(twin_proc_mapx(gcol)) + 1 endif @@ -4497,7 +4422,7 @@ subroutine find_partners(opt, proc_busy_d, nsmpx, proc_smp_mapx) maxpartner = -1 maxcnt = 0 do twp=0,npes-1 - if ((.not. assigned(twp)) .and. (twp .ne. p)) then + if ((.not. assigned(twp)) .and. (twp /= p)) then if (twin_cnt(twp) >= maxcnt) then maxcnt = twin_cnt(twp) maxpartner = twp @@ -4507,7 +4432,7 @@ subroutine find_partners(opt, proc_busy_d, nsmpx, proc_smp_mapx) ! ! Assign p and twp to the same SMP node ! - if (maxpartner .ne. -1) then + if (maxpartner /= -1) then assigned(p) = .true. assigned(maxpartner) = .true. proc_smp_mapx(p) = nsmpx @@ -4598,7 +4523,7 @@ subroutine find_twin(gcol, smp, proc_smp_mapx, twingcol_f) clat = clat_p(lat) twinclat = -clat twinlat = clat_p_tot+1-lat - if (clat_p(twinlat) .eq. twinclat) then + if (clat_p(twinlat) == twinclat) then found = .true. else found = .false. @@ -4609,7 +4534,7 @@ subroutine find_twin(gcol, smp, proc_smp_mapx, twingcol_f) endif do while (.not. found) if ((abs(clat_p(upper)-twinclat) < abs(clat_p(twinlat)-twinclat)) .and. & - (upper .ne. twinlat)) then + (upper /= twinlat)) then twinlat = upper if (upper < clat_p_tot) then upper = twinlat + 1 @@ -4617,7 +4542,7 @@ subroutine find_twin(gcol, smp, proc_smp_mapx, twingcol_f) found = .true. endif else if ((abs(clat_p(lower)-twinclat) < abs(clat_p(twinlat)-twinclat)) .and. & - (lower .ne. twinlat)) then + (lower /= twinlat)) then twinlat = lower if (lower > 1) then lower = twinlat - 1 @@ -4635,7 +4560,7 @@ subroutine find_twin(gcol, smp, proc_smp_mapx, twingcol_f) clon = clon_p(lon) twinclon = mod(clon+pi,twopi) twinlon = mod((lon-1)+(clon_p_tot/2), clon_p_tot) + 1 - if (clon_p(twinlon) .eq. twinclon) then + if (clon_p(twinlon) == twinclon) then found = .true. else found = .false. @@ -4646,7 +4571,7 @@ subroutine find_twin(gcol, smp, proc_smp_mapx, twingcol_f) endif do while (.not. found) if ((abs(clon_p(upper)-twinclon) < abs(clon_p(twinlon)-twinclon)) .and. & - (upper .ne. twinlon)) then + (upper /= twinlon)) then twinlon = upper if (upper < clon_p_tot) then upper = twinlon + 1 @@ -4654,7 +4579,7 @@ subroutine find_twin(gcol, smp, proc_smp_mapx, twingcol_f) found = .true. endif else if ((abs(clon_p(lower)-twinclon) < abs(clon_p(twinlon)-twinclon)) .and. & - (lower .ne. twinlon)) then + (lower /= twinlon)) then twinlon = lower if (lower > 1) then lower = twinlon - 1 @@ -4672,7 +4597,7 @@ subroutine find_twin(gcol, smp, proc_smp_mapx, twingcol_f) twingcol = latlon_to_dyn_gcol_map(twingcol_latlon) ! otherwise, look around for an approximate match using lonlat sorted indices - if ((lon_p(twingcol) .ne. twinlon) .or. (lat_p(twingcol) .ne. twinlat)) then + if ((lon_p(twingcol) /= twinlon) .or. (lat_p(twingcol) /= twinlat)) then twingcol_lonlat = clon_p_idx(twinlon) twingcol = lonlat_to_dyn_gcol_map(twingcol_lonlat) min_diff = abs(lat_p(twingcol) - twinlat) @@ -4696,7 +4621,7 @@ subroutine find_twin(gcol, smp, proc_smp_mapx, twingcol_f) twinproc = get_block_owner_d(jbtwin(1)) twinsmp = proc_smp_mapx(twinproc) ! - if ((twinsmp .eq. smp) .and. & + if ((twinsmp == smp) .and. & (knuhcs(twingcol)%chunkid == -1)) then found = .true. twingcol_f = twingcol @@ -4712,8 +4637,8 @@ subroutine find_twin(gcol, smp, proc_smp_mapx, twingcol_f) ! otherwise, look around for an approximate match using lonlat ! column ordering - if ((lon_p(twingcol) .ne. twinlon) .or. & - (lat_p(twingcol) .ne. lat)) then + if ((lon_p(twingcol) /= twinlon) .or. & + (lat_p(twingcol) /= lat)) then twingcol_lonlat = clon_p_idx(twinlon) twingcol = lonlat_to_dyn_gcol_map(twingcol_lonlat) min_diff = abs(lat_p(twingcol) - lat) @@ -4735,7 +4660,7 @@ subroutine find_twin(gcol, smp, proc_smp_mapx, twingcol_f) twinproc = get_block_owner_d(jbtwin(1)) twinsmp = proc_smp_mapx(twinproc) ! - if ((twinsmp .eq. smp) .and. & + if ((twinsmp == smp) .and. & (knuhcs(twingcol)%chunkid == -1)) then found = .true. twingcol_f = twingcol @@ -4865,7 +4790,7 @@ subroutine assign_chunks(npthreads, nsmpx, proc_smp_mapx, & ! Update extra chunk increment if (ntmp3_smp(smp) > 0) then ntmp3_smp(smp) = ntmp3_smp(smp) - 1 - if (ntmp3_smp(smp) .eq. 0) then + if (ntmp3_smp(smp) == 0) then ntmp4_smp(smp) = ntmp4_smp(smp) - 1 endif endif diff --git a/src/physics/cam/phys_grid_ctem.F90 b/src/physics/cam/phys_grid_ctem.F90 new file mode 100644 index 0000000000..6863799864 --- /dev/null +++ b/src/physics/cam/phys_grid_ctem.F90 @@ -0,0 +1,383 @@ +!---------------------------------------------------------------------------------- +! circulation diagnostics -- terms of the Transformed Eulerian Mean (TEM) equation +! +!---------------------------------------------------------------------------------- +module phys_grid_ctem + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: begchunk, endchunk, pcols, pver + use physics_types, only: physics_state + use cam_history, only: addfld, outfld + use zonal_mean_mod,only: ZonalAverage_t, ZonalMean_t + use physconst, only: pi + use cam_logfile, only: iulog + use cam_abortutils,only: endrun, handle_allocate_error + use namelist_utils,only: find_group_name + use spmd_utils, only: masterproc, mpi_integer, masterprocid, mpicom + use time_manager, only: get_step_size, get_nstep + + use shr_const_mod, only: rgas => shr_const_rgas ! J/K/kmole + use shr_const_mod, only: grav => shr_const_g ! m/s2 + use air_composition, only: mbarv ! g/mole + use string_utils, only: int2str + + implicit none + + private + public :: phys_grid_ctem_readnl + public :: phys_grid_ctem_reg + public :: phys_grid_ctem_init + public :: phys_grid_ctem_diags + public :: phys_grid_ctem_final + + type(ZonalMean_t) :: ZMobj + type(ZonalAverage_t) :: ZAobj + + integer :: nzalat = -huge(1) + integer :: nzmbas = -huge(1) + + integer :: ntimesteps = -huge(1) ! number of time steps bewteen TEM calculations + + logical :: do_tem_diags = .false. + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine phys_grid_ctem_readnl(nlfile) + character(len=*), intent(in) :: nlfile + integer :: ierr, unitn + + character(len=*), parameter :: prefix = 'phys_grid_ctem_readnl: ' + real(r8) :: dtime + + integer :: phys_grid_ctem_zm_nbas + integer :: phys_grid_ctem_za_nlat + integer :: phys_grid_ctem_nfreq + + namelist /phys_grid_ctem_opts/ phys_grid_ctem_zm_nbas, phys_grid_ctem_za_nlat, phys_grid_ctem_nfreq + + phys_grid_ctem_zm_nbas = 0 + phys_grid_ctem_za_nlat = 0 + phys_grid_ctem_nfreq = 0 + + ! Read in namelist values + !------------------------ + if(masterproc) then + open(newunit=unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'phys_grid_ctem_opts', status=ierr) + if(ierr == 0) then + read(unitn,phys_grid_ctem_opts,iostat=ierr) + if(ierr /= 0) then + call endrun(prefix//'ERROR reading namelist') + end if + end if + close(unitn) + end if + + call MPI_bcast(phys_grid_ctem_zm_nbas, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'FATAL: mpi_bcast: phys_grid_ctem_zm_nbas') + call MPI_bcast(phys_grid_ctem_za_nlat, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'FATAL: mpi_bcast: phys_grid_ctem_za_nlat') + call MPI_bcast(phys_grid_ctem_nfreq, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(prefix//'FATAL: mpi_bcast: phys_grid_ctem_nfreq') + + do_tem_diags = .false. + if (phys_grid_ctem_nfreq/=0) then + if (.not.(phys_grid_ctem_zm_nbas>0 .and. phys_grid_ctem_za_nlat>0)) then + call endrun(prefix//'inconsistent phys_grid_ctem namelist settings -- phys_grid_ctem_zm_nbas=' & + //int2str(phys_grid_ctem_zm_nbas)//', phys_grid_ctem_za_nlat='//int2str(phys_grid_ctem_za_nlat)) + end if + if (phys_grid_ctem_nfreq>0) then + ntimesteps = phys_grid_ctem_nfreq + else + dtime = get_step_size() + ntimesteps = nint( -phys_grid_ctem_nfreq*3600._r8/dtime ) + end if + if (ntimesteps<1) then + call endrun(prefix//'invalid ntimesteps -- phys_grid_ctem_nfreq needs to be a larger negative value ' & + //'or the model time step needs to be shorter') + end if + do_tem_diags = .true. + end if + + if (masterproc) then + if (do_tem_diags) then + write(iulog,*) 'TEM diagnostics will be calculated every ',ntimesteps,' time steps' + write(iulog,*) ' phys_grid_ctem_zm_nbas = ', phys_grid_ctem_zm_nbas + write(iulog,*) ' phys_grid_ctem_za_nlat = ', phys_grid_ctem_za_nlat + write(iulog,*) ' phys_grid_ctem_nfreq = ', phys_grid_ctem_nfreq + else + write(iulog,*) 'TEM diagnostics will not be performed' + end if + endif + + if (do_tem_diags) then + nzalat = phys_grid_ctem_za_nlat + nzmbas = phys_grid_ctem_zm_nbas + end if + + end subroutine phys_grid_ctem_readnl + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine phys_grid_ctem_reg + + use cam_grid_support, only: horiz_coord_t, horiz_coord_create, iMap, cam_grid_register + + type(horiz_coord_t), pointer :: zalon_coord + type(horiz_coord_t), pointer :: zalat_coord + integer(iMap), pointer :: grid_map(:,:) + + real(r8) :: zalats(nzalat) + real(r8) :: area(nzalat) + real(r8) :: zalons(1) + real(r8) :: dlatrad, dlatdeg, lat1, lat2 + real(r8) :: total_area + real(r8) :: total_wght + integer :: j, astat + + real(r8), parameter :: latdeg0 = -90._r8 + real(r8), parameter :: latrad0 = -pi*0.5_r8 + real(r8), parameter :: fourpi = pi*4._r8 + + integer, parameter :: ctem_zavg_phys_decomp = 333 ! Must be unique within CAM + + if (.not.do_tem_diags) return + + nullify(zalat_coord) + nullify(zalon_coord) + nullify(grid_map) + + zalons(1) = 0._r8 + + dlatrad = pi/real(nzalat,kind=r8) + dlatdeg = 180._r8/real(nzalat,kind=r8) + total_area = 0._r8 + total_wght = 0._r8 + + ! calculate latitudes and areas of zonal average grid boxes + do j = 1,nzalat + zalats(j) = latdeg0 + (real(j,kind=r8)-0.5_r8)*dlatdeg + lat1 = latrad0 + real(j-1,kind=r8)*dlatrad + lat2 = latrad0 + real(j ,kind=r8)*dlatrad + area(j) = 2._r8*pi*(sin(lat2)-sin(lat1)) + total_area = total_area + area(j) + total_wght = total_wght + 0.5_r8*(sin(lat2)-sin(lat1)) + end do + + ! sanity check + if ( abs(1._r8-total_wght)>1.e-12_r8 .or. abs(fourpi-total_area)>1.e-12_r8 ) then + call endrun('phys_grid_ctem_reg: problem with area/wght calc') + end if + + ! initialize zonal-average and zonal-mean utility objects + call ZAobj%init(zalats,area,nzalat,GEN_GAUSSLATS=.false.) + call ZMobj%init(nzmbas) + + ! Zonal average grid for history fields + + zalat_coord => horiz_coord_create('zalat', '', nzalat, 'latitude', 'degrees_north', 1, nzalat, zalats) + zalon_coord => horiz_coord_create('zalon', '', 1, 'longitude', 'degrees_east', 1, 1, zalons) + + ! grid decomposition map + allocate(grid_map(4,nzalat), stat=astat) + call handle_allocate_error(astat, 'phys_grid_ctem_reg', 'grid_map') + + do j = 1,nzalat + grid_map(1,j) = 1 + grid_map(2,j) = j + if (masterproc) then + grid_map(3,j) = 1 + grid_map(4,j) = j + else + grid_map(3,j) = 0 + grid_map(4,j) = 0 + end if + end do + + ! register the zonal average grid + call cam_grid_register('ctem_zavg_phys', ctem_zavg_phys_decomp, zalat_coord, zalon_coord, grid_map, & + unstruct=.false., zonal_grid=.true.) + + end subroutine phys_grid_ctem_reg + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine phys_grid_ctem_init + + if (.not.do_tem_diags) return + + call addfld ('Uzm', (/'lev'/), 'A','m s-1', 'Zonal-Mean zonal wind', gridname='ctem_zavg_phys' ) + call addfld ('Vzm', (/'lev'/), 'A','m s-1', 'Zonal-Mean meridional wind', gridname='ctem_zavg_phys' ) + call addfld ('Wzm', (/'lev'/), 'A','m s-1', 'Zonal-Mean vertical wind', gridname='ctem_zavg_phys' ) + call addfld ('THzm', (/'lev'/), 'A','K', 'Zonal-Mean potential temp', gridname='ctem_zavg_phys' ) + call addfld ('VTHzm',(/'lev'/), 'A','K m s-1','Meridional Heat Flux:', gridname='ctem_zavg_phys') + call addfld ('WTHzm',(/'lev'/), 'A','K m s-1','Vertical Heat Flux:', gridname='ctem_zavg_phys') + call addfld ('UVzm', (/'lev'/), 'A','m2 s-2', 'Meridional Flux of Zonal Momentum', gridname='ctem_zavg_phys') + call addfld ('UWzm', (/'lev'/), 'A','m2 s-2', 'Vertical Flux of Zonal Momentum', gridname='ctem_zavg_phys') + call addfld ('THphys',(/'lev'/), 'A', 'K', 'Potential temp', gridname='physgrid' ) + + end subroutine phys_grid_ctem_init + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine phys_grid_ctem_diags(phys_state) + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + + character(len=*), parameter :: prefix = 'phys_grid_ctem_diags: ' + + real(r8) :: u(pcols,pver,begchunk:endchunk) + real(r8) :: v(pcols,pver,begchunk:endchunk) + real(r8) :: w(pcols,pver,begchunk:endchunk) + + real(r8) :: uzm(pcols,pver,begchunk:endchunk) + real(r8) :: vzm(pcols,pver,begchunk:endchunk) + real(r8) :: wzm(pcols,pver,begchunk:endchunk) + + real(r8) :: ud(pcols,pver,begchunk:endchunk) + real(r8) :: vd(pcols,pver,begchunk:endchunk) + real(r8) :: wd(pcols,pver,begchunk:endchunk) + real(r8) :: thd(pcols,pver,begchunk:endchunk) + + real(r8) :: uvp(pcols,pver,begchunk:endchunk) + real(r8) :: uwp(pcols,pver,begchunk:endchunk) + real(r8) :: vthp(pcols,pver,begchunk:endchunk) + real(r8) :: wthp(pcols,pver,begchunk:endchunk) + + integer :: lchnk, ncol, j, k + + ! potential temperature + real(r8) :: theta(pcols,pver,begchunk:endchunk) + real(r8) :: thzm(pcols,pver,begchunk:endchunk) + + real(r8) :: uvza(nzalat,pver) + real(r8) :: uwza(nzalat,pver) + real(r8) :: vthza(nzalat,pver) + real(r8) :: wthza(nzalat,pver) + + real(r8) :: uza(nzalat,pver) + real(r8) :: vza(nzalat,pver) + real(r8) :: wza(nzalat,pver) + real(r8) :: thza(nzalat,pver) + + real(r8) :: sheight(pcols,pver) ! pressure scale height (m) + + if (.not.do_calc()) return + + do lchnk = begchunk,endchunk + + ncol = phys_state(lchnk)%ncol + + ! scale height + sheight(:ncol,:) = phys_state(lchnk)%t(:ncol,:) * rgas / ( mbarv(:ncol,:,lchnk) * grav ) ! meters + + ! potential temperature + theta(:ncol,:,lchnk) = phys_state(lchnk)%t(:ncol,:) * phys_state(lchnk)%exner(:ncol,:) + + ! vertical velocity + w(:ncol,:,lchnk) = -sheight(:ncol,:) * phys_state(lchnk)%omega(:ncol,:) / phys_state(lchnk)%pmid(:ncol,:) + + u(:ncol,:,lchnk) = phys_state(lchnk)%u(:ncol,:) + v(:ncol,:,lchnk) = phys_state(lchnk)%v(:ncol,:) + + end do + + ! zonal means evaluated on the physics grid (3D) to be used in the deviations calculation below + uzm(:,:,:) = zmean_fld(u(:,:,:)) + vzm(:,:,:) = zmean_fld(v(:,:,:)) + wzm(:,:,:) = zmean_fld(w(:,:,:)) + thzm(:,:,:) = zmean_fld(theta(:,:,:)) + + ! diagnostic output + do lchnk = begchunk, endchunk + call outfld( 'THphys', theta(:,:,lchnk), pcols, lchnk) + end do + + do lchnk = begchunk,endchunk + ncol = phys_state(lchnk)%ncol + do k = 1,pver + ! zonal deviations + thd(:ncol,k,lchnk) = theta(:ncol,k,lchnk) - thzm(:ncol,k,lchnk) + ud(:ncol,k,lchnk) = u(:ncol,k,lchnk) - uzm(:ncol,k,lchnk) + vd(:ncol,k,lchnk) = v(:ncol,k,lchnk) - vzm(:ncol,k,lchnk) + wd(:ncol,k,lchnk) = w(:ncol,k,lchnk) - wzm(:ncol,k,lchnk) + ! fluxes + uvp(:ncol,k,lchnk) = ud(:ncol,k,lchnk) * vd(:ncol,k,lchnk) + uwp(:ncol,k,lchnk) = ud(:ncol,k,lchnk) * wd(:ncol,k,lchnk) + vthp(:ncol,k,lchnk) = vd(:ncol,k,lchnk) * thd(:ncol,k,lchnk) + wthp(:ncol,k,lchnk) = wd(:ncol,k,lchnk) * thd(:ncol,k,lchnk) + end do + end do + + ! evaluate and output fluxes on the zonal-average grid + call ZAobj%binAvg(uvp, uvza) + call ZAobj%binAvg(uwp, uwza) + call ZAobj%binAvg(vthp, vthza) + call ZAobj%binAvg(wthp, wthza) + + if (any(abs(uvza)>1.e20_r8)) call endrun(prefix//'bad values in uvza') + if (any(abs(uwza)>1.e20_r8)) call endrun(prefix//'bad values in uwza') + if (any(abs(vthza)>1.e20_r8)) call endrun(prefix//'bad values in vthza') + if (any(abs(wthza)>1.e20_r8)) call endrun(prefix//'bad values in wthza') + + call ZAobj%binAvg(uzm, uza) + call ZAobj%binAvg(vzm, vza) + call ZAobj%binAvg(wzm, wza) + call ZAobj%binAvg(thzm, thza) + + if (any(abs(uza)>1.e20_r8)) call endrun(prefix//'bad values in uza') + if (any(abs(vza)>1.e20_r8)) call endrun(prefix//'bad values in vza') + if (any(abs(wza)>1.e20_r8)) call endrun(prefix//'bad values in wza') + if (any(abs(thza)>1.e20_r8)) call endrun(prefix//'bad values in thza') + + ! diagnostic output + do j = 1,nzalat + call outfld('Uzm',uza(j,:),1,j) + call outfld('Vzm',vza(j,:),1,j) + call outfld('Wzm',wza(j,:),1,j) + call outfld('THzm',thza(j,:),1,j) + call outfld('UVzm',uvza(j,:),1,j) + call outfld('UWzm',uwza(j,:),1,j) + call outfld('VTHzm',vthza(j,:),1,j) + call outfld('WTHzm',wthza(j,:),1,j) + end do + + contains + + !------------------------------------------------------------------------------ + ! utility function for evaluating 3D zonal mean fields + !------------------------------------------------------------------------------ + function zmean_fld( fld ) result(fldzm) + + real(r8), intent(in) :: fld(pcols,pver,begchunk:endchunk) + + real(r8) :: fldzm(pcols,pver,begchunk:endchunk) + + real(r8) :: Zonal_Bamp3d(nzmbas,pver) + + call ZMobj%calc_amps(fld,Zonal_Bamp3d) + call ZMobj%eval_grid(Zonal_Bamp3d,fldzm) + + end function zmean_fld + + !------------------------------------------------------------------------------ + ! utility function returns TRUE when time to update TEM diags + !------------------------------------------------------------------------------ + logical function do_calc() + + integer :: nstep + nstep = get_nstep() + do_calc = do_tem_diags .and. mod(nstep,ntimesteps) == 0 + + end function do_calc + + end subroutine phys_grid_ctem_diags + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + subroutine phys_grid_ctem_final + call ZAobj%final() + call ZMobj%final() + end subroutine phys_grid_ctem_final + +end module phys_grid_ctem diff --git a/src/physics/cam/phys_prop.F90 b/src/physics/cam/phys_prop.F90 index 568427e44e..6c504e8c78 100644 --- a/src/physics/cam/phys_prop.F90 +++ b/src/physics/cam/phys_prop.F90 @@ -11,7 +11,7 @@ module phys_prop use shr_kind_mod, only: r8 => shr_kind_r8 use spmd_utils, only: masterproc -use radconstants, only: nrh, nlwbands, nswbands, idx_sw_diag +use radconstants, only: nlwbands, nswbands, idx_sw_diag use ioFileMod, only: getfil use cam_pio_utils, only: cam_pio_openfile use pio, only: file_desc_t, var_desc_t, pio_get_var, pio_inq_varid, & @@ -26,6 +26,7 @@ module phys_prop save integer, parameter, public :: ot_length = 32 + public :: & physprop_accum_unique_files, &! Make a list of the unique set of files that contain properties ! This is an initialization step that must be done before calling physprop_init @@ -105,6 +106,10 @@ module phys_prop ! array. character(len=256), allocatable :: uniquefilenames(:) +! Number of evenly spaced intervals in rh used in this module and in the aer_rad_props module +! for calculations of aerosol hygroscopic growth. +integer, parameter, public :: nrh = 1000 + !================================================================================================ contains !================================================================================================ @@ -1106,7 +1111,7 @@ subroutine bulk_props_init(physprop, nc_id) type(var_desc_T) :: vid - logical :: debug = .true. + logical :: debug = .false. character(len=*), parameter :: subname = 'bulk_props_init' !------------------------------------------------------------------------------------ @@ -1134,7 +1139,7 @@ subroutine bulk_props_init(physprop, nc_id) ierr = pio_get_var(nc_id, vid, physprop%num_to_mass_aer) ! Output select data to log file - if (debug .and. masterproc) then + if (debug .and. masterproc .and. idx_sw_diag > 0) then if (trim(physprop%aername) == 'SULFATE') then write(iulog, '(2x, a)') '_______ hygroscopic growth in visible band _______' call aer_optics_log_rh('SO4', physprop%sw_hygro_ext(:,idx_sw_diag), & diff --git a/src/physics/cam/physics_buffer.F90.in b/src/physics/cam/physics_buffer.F90.in index f8e2a58871..b9af23610f 100644 --- a/src/physics/cam/physics_buffer.F90.in +++ b/src/physics/cam/physics_buffer.F90.in @@ -167,9 +167,11 @@ module physics_buffer ! ! private pio descriptor for time ! - type(var_desc_t) :: timeidx_desc + ! Set to .true. for more output + logical :: debug = .false. + !=============================================================================== CONTAINS !=============================================================================== @@ -357,6 +359,7 @@ end subroutine pbuf_readnl ! have been completed and should only be called once in a run ! subroutine pbuf_initialize(pbuf2d) + use phys_grid, only: phys_grid_initialized type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer :: i, c @@ -365,7 +368,10 @@ end subroutine pbuf_readnl ! ! Allocate memory ! - if(buffer_initialized) return + if (buffer_initialized) return + if (.not. phys_grid_initialized()) then + call endrun('pbuf_initialize: Physics decomposition not initialized') + end if ! Allocate at least 1 to avoid unallocated error in ideal physics allocate(pbuf2d(max(1,currentpbufflds),begchunk:endchunk)) if(currentpbufflds<1) return @@ -754,15 +760,21 @@ end subroutine pbuf_readnl end subroutine pbuf2d_print subroutine pbuf1d_print(pbuf) + use spmd_utils, only: masterproc + type(physics_buffer_desc), pointer :: pbuf(:) - integer :: i + + integer :: ind type(physics_buffer_desc), pointer :: pbufPtr - print *,__FILE__,__LINE__,currentpbufflds,size(pbuf) - do i=1,currentpbufflds - pbufPtr => pbuf(i) - print *,__FILE__,__LINE__,i,trim(pbufPtr%hdr%name),pbufPtr%hdr%dtype,pbufPtr%hdr%persistence,pbufPtr%hdr%dimsizes - end do + if (masterproc .and. debug) then + write(iulog, *) __FILE__, __LINE__, currentpbufflds, size(pbuf) + do ind = 1, currentpbufflds + pbufPtr => pbuf(ind) + write(iulog, *) __FILE__, __LINE__, ind, trim(pbufPtr%hdr%name), & + pbufPtr%hdr%dtype, pbufPtr%hdr%persistence, pbufPtr%hdr%dimsizes + end do + end if end subroutine pbuf1d_print ! diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index a36b8f4039..fb66116bb2 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -5,9 +5,10 @@ module physics_types use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver - use constituents, only: pcnst, qmin, cnst_name - use geopotential, only: geopotential_dse, geopotential_t - use physconst, only: zvir, gravit, cpair, rair, cpairv, rairv + use constituents, only: pcnst, qmin, cnst_name, cnst_get_ind + use geopotential, only: geopotential_t + use physconst, only: zvir, gravit, cpair, rair + use air_composition, only: cpairv, rairv use phys_grid, only: get_ncols_p, get_rlon_all_p, get_rlat_all_p, get_gcol_all_p use cam_logfile, only: iulog use cam_abortutils, only: endrun @@ -17,8 +18,6 @@ module physics_types implicit none private ! Make default type private to the module - logical, parameter :: adjust_te = .FALSE. - ! Public types: public physics_state @@ -33,7 +32,6 @@ module physics_types public physics_ptend_init public physics_state_set_grid public physics_dme_adjust ! adjust dry mass and energy for change in water - ! cannot be applied to eul or sld dycores public physics_state_copy ! copy a physics_state object public physics_ptend_copy ! copy a physics_ptend object public physics_ptend_sum ! accumulate physics_ptend objects @@ -52,7 +50,11 @@ module physics_types public physics_ptend_alloc ! allocate individual components within tend public physics_ptend_dealloc ! deallocate individual components within tend + public physics_cnst_limit ! apply limiters to constituents (waccmx) !------------------------------------------------------------------------------- + integer, parameter, public :: phys_te_idx = 1 + integer ,parameter, public :: dyn_te_idx = 2 + type physics_state integer :: & lchnk, &! chunk index @@ -88,17 +90,23 @@ module physics_types q ! constituent mixing ratio (kg/kg moist or dry air depending on type) real(r8), dimension(:,:),allocatable :: & - pint, &! interface pressure (Pa) - pintdry, &! interface pressure dry (Pa) - lnpint, &! ln(pint) + pint, &! interface pressure (Pa) + pintdry, &! interface pressure dry (Pa) + lnpint, &! ln(pint) lnpintdry,&! log interface pressure dry (Pa) - zi ! geopotential height above surface at interfaces (m) - - real(r8), dimension(:),allocatable :: & - te_ini, &! vertically integrated total (kinetic + static) energy of initial state - te_cur, &! vertically integrated total (kinetic + static) energy of current state - tw_ini, &! vertically integrated total water of initial state - tw_cur ! vertically integrated total water of new state + zi ! geopotential height above surface at interfaces (m) + + real(r8), dimension(:,:),allocatable :: & + ! Second dimension is (phys_te_idx) CAM physics total energy and + ! (dyn_te_idx) dycore total energy computed in physics + te_ini, &! vertically integrated total (kinetic + static) energy of initial state + te_cur ! vertically integrated total (kinetic + static) energy of current state + real(r8), dimension(:), allocatable :: & + tw_ini, &! vertically integrated total water of initial state + tw_cur ! vertically integrated total water of new state + real(r8), dimension(:,:),allocatable :: & + temp_ini, &! Temperature of initial state (used for energy computations) + z_ini ! Height of initial state (used for energy computations) integer :: count ! count of values with significant energy or water imbalances integer, dimension(:),allocatable :: & latmapback, &! map from column to unique lat for that column @@ -200,12 +208,11 @@ subroutine physics_update(state, ptend, dt, tend) !----------------------------------------------------------------------- ! Update the state and or tendency structure with the parameterization tendencies !----------------------------------------------------------------------- - use shr_sys_mod, only: shr_sys_flush - use constituents, only: cnst_get_ind - use scamMod, only: scm_crm_mode, single_column - use phys_control, only: phys_getopts - use physconst, only: physconst_update ! Routine which updates physconst variables (WACCM-X) - use qneg_module, only: qneg3 + use scamMod, only: scm_crm_mode, single_column + use phys_control, only: phys_getopts + use cam_thermo, only: cam_thermo_dry_air_update ! Routine which updates physconst variables (WACCM-X) + use air_composition, only: dry_air_species_num + use qneg_module , only: qneg3 !------------------------------Arguments-------------------------------- type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies @@ -367,11 +374,10 @@ subroutine physics_update(state, ptend, dt, tend) end if !------------------------------------------------------------------------ - ! Get indices for molecular weights and call WACCM-X physconst_update + ! Get indices for molecular weights and call WACCM-X cam_thermo_update !------------------------------------------------------------------------ - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - call physconst_update(state%q, state%t, state%lchnk, state%ncol, & - to_moist_factor=state%pdeldry(:ncol,:)/state%pdel(:ncol,:) ) + if (dry_air_species_num>0) then + call cam_thermo_dry_air_update(state%q, state%t, state%lchnk, state%ncol) endif !----------------------------------------------------------------------- @@ -418,7 +424,7 @@ subroutine physics_update(state, ptend, dt, tend) if (ptend%ls .or. ptend%lq(1)) then call geopotential_t ( & state%lnpint, state%lnpmid, state%pint , state%pmid , state%pdel , state%rpdel , & - state%t , state%q(:,:,1), rairv_loc(:,:), gravit , zvirv , & + state%t , state%q(:,:,:), rairv_loc(:,:), gravit , zvirv , & state%zi , state%zm , ncol ) ! update dry static energy for use in next process do k = ptend%top_level, ptend%bot_level @@ -427,9 +433,6 @@ subroutine physics_update(state, ptend, dt, tend) end do end if - ! Good idea to do this regularly. - call shr_sys_flush(iulog) - if (state_debug_checks) call physics_state_check(state, ptend%name) deallocate(cpairv_loc, rairv_loc) @@ -530,14 +533,18 @@ subroutine physics_state_check(state, name) varname="state%psdry", msg=msg) call shr_assert_in_domain(state%phis(:ncol), is_nan=.false., & varname="state%phis", msg=msg) - call shr_assert_in_domain(state%te_ini(:ncol), is_nan=.false., & + call shr_assert_in_domain(state%te_ini(:ncol,:), is_nan=.false., & varname="state%te_ini", msg=msg) - call shr_assert_in_domain(state%te_cur(:ncol), is_nan=.false., & + call shr_assert_in_domain(state%te_cur(:ncol,:), is_nan=.false., & varname="state%te_cur", msg=msg) call shr_assert_in_domain(state%tw_ini(:ncol), is_nan=.false., & varname="state%tw_ini", msg=msg) call shr_assert_in_domain(state%tw_cur(:ncol), is_nan=.false., & varname="state%tw_cur", msg=msg) + call shr_assert_in_domain(state%temp_ini(:ncol,:), is_nan=.false., & + varname="state%temp_ini", msg=msg) + call shr_assert_in_domain(state%z_ini(:ncol,:), is_nan=.false., & + varname="state%z_ini", msg=msg) ! 2-D variables (at midpoints) call shr_assert_in_domain(state%t(:ncol,:), is_nan=.false., & @@ -604,14 +611,18 @@ subroutine physics_state_check(state, name) varname="state%psdry", msg=msg) call shr_assert_in_domain(state%phis(:ncol), lt=posinf_r8, gt=neginf_r8, & varname="state%phis", msg=msg) - call shr_assert_in_domain(state%te_ini(:ncol), lt=posinf_r8, gt=neginf_r8, & + call shr_assert_in_domain(state%te_ini(:ncol,:), lt=posinf_r8, gt=neginf_r8, & varname="state%te_ini", msg=msg) - call shr_assert_in_domain(state%te_cur(:ncol), lt=posinf_r8, gt=neginf_r8, & + call shr_assert_in_domain(state%te_cur(:ncol,:), lt=posinf_r8, gt=neginf_r8, & varname="state%te_cur", msg=msg) call shr_assert_in_domain(state%tw_ini(:ncol), lt=posinf_r8, gt=neginf_r8, & varname="state%tw_ini", msg=msg) call shr_assert_in_domain(state%tw_cur(:ncol), lt=posinf_r8, gt=neginf_r8, & varname="state%tw_cur", msg=msg) + call shr_assert_in_domain(state%temp_ini(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%temp_ini", msg=msg) + call shr_assert_in_domain(state%z_ini(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%z_ini", msg=msg) ! 2-D variables (at midpoints) call shr_assert_in_domain(state%t(:ncol,:), lt=posinf_r8, gt=0._r8, & @@ -1126,7 +1137,63 @@ subroutine init_geo_unique(phys_state,ncol) end subroutine init_geo_unique !=============================================================================== - subroutine physics_dme_adjust(state, tend, qini, dt) + subroutine physics_cnst_limit(state) + type(physics_state), intent(inout) :: state + + integer :: i,k, ncol + + real(r8) :: mmrSum_O_O2_H ! Sum of mass mixing ratios for O, O2, and H + real(r8), parameter :: mmrMin=1.e-20_r8 ! lower limit of o2, o, and h mixing ratios + real(r8), parameter :: N2mmrMin=1.e-6_r8 ! lower limit of N2 mass mixing ratio + real(r8), parameter :: H2lim=6.e-5_r8 ! H2 limiter: 10x global H2 MMR (Roble, 1995) + integer :: ixo, ixo2, ixh, ixh2 + + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + call cnst_get_ind('O', ixo) + call cnst_get_ind('O2', ixo2) + call cnst_get_ind('H', ixh) + call cnst_get_ind('H2', ixh2) + + ncol = state%ncol + + !------------------------------------------------------------ + ! Ensure N2 = 1-(O2 + O + H) mmr is greater than 0 + ! Check for unusually large H2 values and set to lower value. + !------------------------------------------------------------ + + do k=1,pver + do i=1,ncol + + if (state%q(i,k,ixo) < mmrMin) state%q(i,k,ixo) = mmrMin + if (state%q(i,k,ixo2) < mmrMin) state%q(i,k,ixo2) = mmrMin + + mmrSum_O_O2_H = state%q(i,k,ixo)+state%q(i,k,ixo2)+state%q(i,k,ixh) + + if ((1._r8-mmrMin-mmrSum_O_O2_H) < 0._r8) then + + state%q(i,k,ixo) = state%q(i,k,ixo) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H + + state%q(i,k,ixo2) = state%q(i,k,ixo2) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H + + state%q(i,k,ixh) = state%q(i,k,ixh) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H + + endif + + if(state%q(i,k,ixh2) > H2lim) then + state%q(i,k,ixh2) = H2lim + endif + + end do + end do + + end if + end subroutine physics_cnst_limit + +!=============================================================================== + subroutine physics_dme_adjust(state, tend, qini, liqini, iceini, dt) + use air_composition, only: dry_air_species_num,thermodynamic_active_species_num + use air_composition, only: thermodynamic_active_species_idx + use dycore, only: dycore_is !----------------------------------------------------------------------- ! ! Purpose: Adjust the dry mass in each layer back to the value of physics input state @@ -1141,9 +1208,6 @@ subroutine physics_dme_adjust(state, tend, qini, dt) ! interfaces and midpoints to the surface pressure. The result is no longer in ! the original hybrid coordinate. ! - ! This procedure cannot be applied to the "eul" or "sld" dycores because they - ! require the hybrid coordinate. - ! ! Author: Byron Boville ! !REVISION HISTORY: @@ -1158,6 +1222,8 @@ subroutine physics_dme_adjust(state, tend, qini, dt) type(physics_state), intent(inout) :: state type(physics_tend ), intent(inout) :: tend real(r8), intent(in ) :: qini(pcols,pver) ! initial specific humidity + real(r8), intent(in ) :: liqini(pcols,pver) ! initial total liquid + real(r8), intent(in ) :: iceini(pcols,pver) ! initial total ice real(r8), intent(in ) :: dt ! model physics timestep ! !---------------------------Local workspace----------------------------- @@ -1172,16 +1238,18 @@ subroutine physics_dme_adjust(state, tend, qini, dt) real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer + real(r8) :: tot_water (pcols,2) ! total water (initial, present) + real(r8) :: tot_water_chg(pcols) ! total water change + + real(r8),allocatable :: cpairv_loc(:,:) + integer :: m_cnst ! !----------------------------------------------------------------------- if (state%psetcols .ne. pcols) then call endrun('physics_dme_adjust: cannot pass in a state which has sub-columns') end if - if (adjust_te) then - call endrun('physics_dme_adjust: must update code based on the "correct" energy before turning on "adjust_te"') - end if lchnk = state%lchnk ncol = state%ncol @@ -1189,76 +1257,57 @@ subroutine physics_dme_adjust(state, tend, qini, dt) ! adjust dry mass in each layer back to input value, while conserving ! constituents, momentum, and total energy state%ps(:ncol) = state%pint(:ncol,1) - do k = 1, pver - - ! adjusment factor is just change in water vapor - fdq(:ncol) = 1._r8 + state%q(:ncol,k,1) - qini(:ncol,k) - ! adjust constituents to conserve mass in each layer - do m = 1, pcnst + ! + ! original code for backwards compatability with FV + ! + if (.not.(dycore_is('MPAS') .or. dycore_is('SE'))) then + do k = 1, pver + + ! adjusment factor is just change in water vapor + fdq(:ncol) = 1._r8 + state%q(:ncol,k,1) - qini(:ncol,k) + + ! adjust constituents to conserve mass in each layer + do m = 1, pcnst state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) - end do - - if (adjust_te) then - ! compute specific total energy of unadjusted state (J/kg) - te(:ncol) = state%s(:ncol,k) + 0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2) - - ! recompute initial u,v from the new values and the tendencies - utmp(:ncol) = state%u(:ncol,k) - dt * tend%dudt(:ncol,k) - vtmp(:ncol) = state%v(:ncol,k) - dt * tend%dvdt(:ncol,k) - ! adjust specific total energy and specific momentum (velocity) to conserve each - te (:ncol) = te (:ncol) / fdq(:ncol) - state%u(:ncol,k) = state%u(:ncol,k ) / fdq(:ncol) - state%v(:ncol,k) = state%v(:ncol,k ) / fdq(:ncol) - ! compute adjusted u,v tendencies - tend%dudt(:ncol,k) = (state%u(:ncol,k) - utmp(:ncol)) / dt - tend%dvdt(:ncol,k) = (state%v(:ncol,k) - vtmp(:ncol)) / dt - - ! compute adjusted static energy - state%s(:ncol,k) = te(:ncol) - 0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2) - end if - -! compute new total pressure variables - state%pdel (:ncol,k ) = state%pdel(:ncol,k ) * fdq(:ncol) - state%ps(:ncol) = state%ps(:ncol) + state%pdel(:ncol,k) - state%pint (:ncol,k+1) = state%pint(:ncol,k ) + state%pdel(:ncol,k) - state%lnpint(:ncol,k+1) = log(state%pint(:ncol,k+1)) - state%rpdel (:ncol,k ) = 1._r8/ state%pdel(:ncol,k ) - end do - + end do + ! compute new total pressure variables + state%pdel (:ncol,k ) = state%pdel(:ncol,k ) * fdq(:ncol) + state%ps(:ncol) = state%ps(:ncol) + state%pdel(:ncol,k) + state%pint (:ncol,k+1) = state%pint(:ncol,k ) + state%pdel(:ncol,k) + state%lnpint(:ncol,k+1) = log(state%pint(:ncol,k+1)) + state%rpdel (:ncol,k ) = 1._r8/ state%pdel(:ncol,k ) + end do + else + do k = 1, pver + tot_water(:ncol,1) = qini(:ncol,k) +liqini(:ncol,k)+iceini(:ncol,k) !initial total H2O + tot_water(:ncol,2) = 0.0_r8 + do m_cnst=dry_air_species_num+1,thermodynamic_active_species_num + m = thermodynamic_active_species_idx(m_cnst) + tot_water(:ncol,2) = tot_water(:ncol,2)+state%q(:ncol,k,m) + end do + fdq(:ncol) = 1._r8 + tot_water(:ncol,2) - tot_water(:ncol,1) + ! adjust constituents to conserve mass in each layer + do m = 1, pcnst + state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) + end do + ! compute new total pressure variables + state%pdel (:ncol,k ) = state%pdel(:ncol,k ) * fdq(:ncol) + state%ps(:ncol) = state%ps(:ncol) + state%pdel(:ncol,k) + state%pint (:ncol,k+1) = state%pint(:ncol,k ) + state%pdel(:ncol,k) + state%lnpint(:ncol,k+1) = log(state%pint(:ncol,k+1)) + state%rpdel (:ncol,k ) = 1._r8/ state%pdel(:ncol,k ) + !note that mid-level variables (e.g. pmid) are not recomputed + end do + endif if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then zvirv(:,:) = shr_const_rwv / rairv(:,:,state%lchnk) - 1._r8 else zvirv(:,:) = zvir endif -! compute new T,z from new s,q,dp - if (adjust_te) then - -! cpairv_loc needs to be allocated to a size which matches state and ptend -! If psetcols == pcols, cpairv is the correct size and just copy into cpairv_loc -! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair - - allocate(cpairv_loc(state%psetcols,pver)) - if (state%psetcols == pcols) then - cpairv_loc(:,:) = cpairv(:,:,state%lchnk) - else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then - cpairv_loc(:,:) = cpair - else - call endrun('physics_dme_adjust: cpairv is not allowed to vary when subcolumns are turned on') - end if - - call geopotential_dse(state%lnpint, state%lnpmid, state%pint, & - state%pmid , state%pdel , state%rpdel, & - state%s , state%q(:,:,1), state%phis , rairv(:,:,state%lchnk), & - gravit, cpairv_loc(:,:), zvirv, & - state%t , state%zi , state%zm , ncol) - - deallocate(cpairv_loc) - - end if - end subroutine physics_dme_adjust + !----------------------------------------------------------------------- !=============================================================================== @@ -1292,18 +1341,20 @@ subroutine physics_state_copy(state_in, state_out) state_out%count = state_in%count do i = 1, ncol - state_out%lat(i) = state_in%lat(i) - state_out%lon(i) = state_in%lon(i) - state_out%ps(i) = state_in%ps(i) - state_out%phis(i) = state_in%phis(i) - state_out%te_ini(i) = state_in%te_ini(i) - state_out%te_cur(i) = state_in%te_cur(i) - state_out%tw_ini(i) = state_in%tw_ini(i) - state_out%tw_cur(i) = state_in%tw_cur(i) - end do + state_out%lat(i) = state_in%lat(i) + state_out%lon(i) = state_in%lon(i) + state_out%ps(i) = state_in%ps(i) + state_out%phis(i) = state_in%phis(i) + end do + state_out%te_ini(:ncol,:) = state_in%te_ini(:ncol,:) + state_out%te_cur(:ncol,:) = state_in%te_cur(:ncol,:) + state_out%tw_ini(:ncol) = state_in%tw_ini(:ncol) + state_out%tw_cur(:ncol) = state_in%tw_cur(:ncol) do k = 1, pver do i = 1, ncol + state_out%temp_ini(i,k) = state_in%temp_ini(i,k) + state_out%z_ini(i,k) = state_in%z_ini(i,k) state_out%t(i,k) = state_in%t(i,k) state_out%u(i,k) = state_in%u(i,k) state_out%v(i,k) = state_in%v(i,k) @@ -1427,40 +1478,72 @@ end subroutine set_state_pdry !=============================================================================== -subroutine set_wet_to_dry (state) +subroutine set_wet_to_dry(state, convert_cnst_type) + + ! Convert mixing ratios from a wet to dry basis for constituents of type + ! convert_cnst_type. Constituents are given a type when they are added + ! to the constituent array by a call to cnst_add during the register + ! phase of initialization. There are two constituent types: 'wet' for + ! water species and 'dry' for non-water species. use constituents, only: pcnst, cnst_type type(physics_state), intent(inout) :: state + character(len=3), intent(in) :: convert_cnst_type + ! local variables integer m, ncol + character(len=*), parameter :: sub = 'set_wet_to_dry' + !----------------------------------------------------------------------------- + + ! check input + if (.not.(convert_cnst_type == 'wet' .or. convert_cnst_type == 'dry')) then + write(iulog,*) sub//': FATAL: convert_cnst_type not recognized: '//convert_cnst_type + call endrun(sub//': FATAL: convert_cnst_type not recognized: '//convert_cnst_type) + end if ncol = state%ncol - do m = 1,pcnst - if (cnst_type(m).eq.'dry') then + do m = 1, pcnst + if (cnst_type(m) == convert_cnst_type) then state%q(:ncol,:,m) = state%q(:ncol,:,m)*state%pdel(:ncol,:)/state%pdeldry(:ncol,:) - endif + end if end do end subroutine set_wet_to_dry !=============================================================================== -subroutine set_dry_to_wet (state) +subroutine set_dry_to_wet(state, convert_cnst_type) + + ! Convert mixing ratios from a dry to wet basis for constituents of type + ! convert_cnst_type. Constituents are given a type when they are added + ! to the constituent array by a call to cnst_add during the register + ! phase of initialization. There are two constituent types: 'wet' for + ! water species and 'dry' for non-water species. use constituents, only: pcnst, cnst_type type(physics_state), intent(inout) :: state + character(len=3), intent(in) :: convert_cnst_type + ! local variables integer m, ncol + character(len=*), parameter :: sub = 'set_dry_to_wet' + !----------------------------------------------------------------------------- + + ! check input + if (.not.(convert_cnst_type == 'wet' .or. convert_cnst_type == 'dry')) then + write(iulog,*) sub//': FATAL: convert_cnst_type not recognized: '//convert_cnst_type + call endrun(sub//': FATAL: convert_cnst_type not recognized: '//convert_cnst_type) + end if ncol = state%ncol - do m = 1,pcnst - if (cnst_type(m).eq.'dry') then + do m = 1, pcnst + if (cnst_type(m) == convert_cnst_type) then state%q(:ncol,:,m) = state%q(:ncol,:,m)*state%pdeldry(:ncol,:)/state%pdel(:ncol,:) - endif + end if end do end subroutine set_dry_to_wet @@ -1469,7 +1552,7 @@ end subroutine set_dry_to_wet subroutine physics_state_alloc(state,lchnk,psetcols) - use infnan, only : inf, assignment(=) + use infnan, only: inf, assignment(=) ! allocate the individual state components @@ -1575,10 +1658,10 @@ subroutine physics_state_alloc(state,lchnk,psetcols) allocate(state%zi(psetcols,pver+1), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%zi') - allocate(state%te_ini(psetcols), stat=ierr) + allocate(state%te_ini(psetcols,2), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_ini') - allocate(state%te_cur(psetcols), stat=ierr) + allocate(state%te_cur(psetcols,2), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_cur') allocate(state%tw_ini(psetcols), stat=ierr) @@ -1587,6 +1670,12 @@ subroutine physics_state_alloc(state,lchnk,psetcols) allocate(state%tw_cur(psetcols), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%tw_cur') + allocate(state%temp_ini(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%temp_ini') + + allocate(state%z_ini(psetcols,pver), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%z_ini') + allocate(state%latmapback(psetcols), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%latmapback') @@ -1626,10 +1715,12 @@ subroutine physics_state_alloc(state,lchnk,psetcols) state%lnpintdry(:,:) = inf state%zi(:,:) = inf - state%te_ini(:) = inf - state%te_cur(:) = inf + state%te_ini(:,:) = inf + state%te_cur(:,:) = inf state%tw_ini(:) = inf state%tw_cur(:) = inf + state%temp_ini(:,:) = inf + state%z_ini(:,:) = inf end subroutine physics_state_alloc @@ -1738,6 +1829,12 @@ subroutine physics_state_dealloc(state) deallocate(state%tw_cur, stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%tw_cur') + deallocate(state%temp_ini, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%temp_ini') + + deallocate(state%z_ini, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%z_ini') + deallocate(state%latmapback, stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%latmapback') diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 38cc4fca9d..0e83ad2707 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -13,7 +13,7 @@ module physpkg use shr_kind_mod, only: r8 => shr_kind_r8 use spmd_utils, only: masterproc - use physconst, only: latvap, latice, rh2o + use physconst, only: latvap, latice use physics_types, only: physics_state, physics_tend, physics_state_set_grid, & physics_ptend, physics_tend_init, physics_update, & physics_type_alloc, physics_ptend_dealloc,& @@ -21,7 +21,7 @@ module physpkg use phys_grid, only: get_ncols_p use phys_gmean, only: gmean_mass use ppgrid, only: begchunk, endchunk, pcols, pver, pverp, psubcols - use constituents, only: pcnst, cnst_name, cnst_get_ind + use constituents, only: pcnst, cnst_get_ind use camsrfexch, only: cam_out_t, cam_in_t use cam_control_mod, only: ideal_phys, adiabatic @@ -32,7 +32,10 @@ module physpkg use cam_logfile, only: iulog use camsrfexch, only: cam_export + 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 @@ -74,6 +77,8 @@ module physpkg integer :: qini_idx = 0 integer :: cldliqini_idx = 0 integer :: cldiceini_idx = 0 + integer :: totliqini_idx = 0 + integer :: toticeini_idx = 0 integer :: prec_str_idx = 0 integer :: snow_str_idx = 0 @@ -86,6 +91,10 @@ module physpkg integer :: prec_sh_idx = 0 integer :: snow_sh_idx = 0 integer :: dlfzm_idx = 0 ! detrained convective cloud water mixing ratio. + integer :: ducore_idx = 0 ! ducore index in physics buffer + integer :: dvcore_idx = 0 ! dvcore index in physics buffer + integer :: dtcore_idx = 0 ! dtcore index in physics buffer + integer :: dqcore_idx = 0 ! dqcore index in physics buffer !======================================================================= contains @@ -105,11 +114,11 @@ subroutine phys_register use physics_buffer, only: pbuf_init_time, pbuf_cam_snapshot_register use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_register_subcol use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: masterproc - use constituents, only: pcnst, cnst_add, cnst_chk_dim, cnst_name + use constituents, only: pcnst, cnst_add, cnst_chk_dim use cam_control_mod, only: moist_physics use chemistry, only: chem_register + use mo_lightning, only: lightning_register use cloud_fraction, only: cldfrc_register use rk_stratiform, only: rk_stratiform_register use microp_driver, only: microp_driver_register @@ -117,12 +126,10 @@ subroutine phys_register use macrop_driver, only: macrop_driver_register use clubb_intr, only: clubb_register_cam use conv_water, only: conv_water_register - use physconst, only: mwdry, cpair, mwh2o, cpwv + use physconst, only: mwh2o, cpwv use tracers, only: tracers_register use check_energy, only: check_energy_register use carma_intr, only: carma_register - use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_register - use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_register use ghg_data, only: ghg_data_register use vertical_diffusion, only: vd_register use convect_deep, only: convect_deep_register @@ -132,7 +139,6 @@ subroutine phys_register use flux_avg, only: flux_avg_register use iondrag, only: iondrag_register use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_reg - use string_utils, only: to_lower use prescribed_ozone, only: prescribed_ozone_register use prescribed_volcaero,only: prescribed_volcaero_register use prescribed_strataero,only: prescribed_strataero_register @@ -145,17 +151,20 @@ subroutine phys_register use cloud_diagnostics, only: cloud_diagnostics_register use cospsimulator_intr, only: cospsimulator_intr_register use rad_constituents, only: rad_cnst_get_info ! Added to query if it is a modal aero sim or not + use radheat, only: radheat_register use subcol, only: subcol_register use subcol_utils, only: is_subcol_on, subcol_get_scheme use dyn_comp, only: dyn_register - use spcam_drivers, only: spcam_register use offline_driver, only: offline_driver_reg + use hemco_interface, only: HCOI_Chunk_Init + use upper_bc, only: ubc_fixed_conc !---------------------------Local variables----------------------------- ! integer :: m ! loop index integer :: mm ! constituent index integer :: nmodes + logical :: has_fixed_ubc ! for upper bndy cond !----------------------------------------------------------------------- ! Get physics options @@ -182,11 +191,12 @@ subroutine phys_register ! Register water vapor. ! ***** N.B. ***** This must be the first call to cnst_add so that ! water vapor is constituent 1. + has_fixed_ubc = ubc_fixed_conc('Q') ! .false. if (moist_physics) then - call cnst_add('Q', mwh2o, cpwv, 1.E-12_r8, mm, & + call cnst_add('Q', mwh2o, cpwv, 1.E-12_r8, mm, fixed_ubc=has_fixed_ubc, & longname='Specific humidity', readiv=.true., is_convtran1=.true.) else - call cnst_add('Q', mwh2o, cpwv, 0.0_r8, mm, & + call cnst_add('Q', mwh2o, cpwv, 0.0_r8, mm, fixed_ubc=has_fixed_ubc, & longname='Specific humidity', readiv=.false., is_convtran1=.true.) end if @@ -199,6 +209,8 @@ subroutine phys_register call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) + call pbuf_add_field('TOTLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), totliqini_idx) + call pbuf_add_field('TOTICEINI', 'physpkg', dtype_r8, (/pcols,pver/), toticeini_idx) ! check energy package call check_energy_register @@ -259,13 +271,13 @@ subroutine phys_register ! register chemical constituents including aerosols ... call chem_register() + ! add prognostic lightning flash freq pbuf fld + call lightning_register() + ! co2 constituents call co2_register() ! register data model ozone with pbuf - if (cam3_ozone_data_on) then - call cam3_ozone_data_register() - end if call prescribed_volcaero_register() call prescribed_strataero_register() call prescribed_ozone_register() @@ -273,11 +285,6 @@ subroutine phys_register call prescribed_ghg_register() call sslt_rebin_register - ! CAM3 prescribed aerosols - if (cam3_aero_data_on) then - call cam3_aero_data_register() - end if - ! register various data model gasses with pbuf call ghg_data_register() @@ -301,12 +308,10 @@ subroutine phys_register ! shallow convection call convect_shallow_register - - call spcam_register - ! radiation call radiation_register call cloud_diagnostics_register + call radheat_register ! COSP call cospsimulator_intr_register @@ -336,6 +341,11 @@ subroutine phys_register call offline_driver_reg() + if (use_hemco) then + ! initialize harmonized emissions component (HEMCO) + call HCOI_Chunk_Init() + endif + ! This needs to be last as it requires all pbuf fields to be added if (cam_snapshot_before_num > 0 .or. cam_snapshot_after_num > 0) then call pbuf_cam_snapshot_register() @@ -350,7 +360,7 @@ end subroutine phys_register subroutine phys_inidat( cam_out, pbuf2d ) use cam_abortutils, only: endrun - use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc, pbuf_set_field, dyn_time_lvls + use physics_buffer, only: pbuf_get_index, physics_buffer_desc, pbuf_set_field, dyn_time_lvls use cam_initfiles, only: initial_file_get_id, topo_file_get_id @@ -366,11 +376,10 @@ subroutine phys_inidat( cam_out, pbuf2d ) type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) - integer :: lchnk, m, n, i, k, ncol + integer :: lchnk, m, n, ncol type(file_desc_t), pointer :: fh_ini, fh_topo character(len=8) :: fieldname real(r8), pointer :: tptr(:,:), tptr_2(:,:), tptr3d(:,:,:), tptr3d_2(:,:,:) - real(r8), pointer :: qpert(:,:) character(len=11) :: subname='phys_inidat' ! subroutine name integer :: tpert_idx, qpert_idx, pblh_idx @@ -697,15 +706,15 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) !----------------------------------------------------------------------- use physics_buffer, only: physics_buffer_desc, pbuf_initialize, pbuf_get_index - use physconst, only: rair, cpair, gravit, stebol, tmelt, & - latvap, latice, rh2o, rhoh2o, pstd, zvir, & - karman, rhodair, physconst_init + use physconst, only: rair, cpair, gravit, zvir, karman + use cam_thermo, only: cam_thermo_init use ref_pres, only: pref_edge, pref_mid use carma_intr, only: carma_init use cam_control_mod, only: initial_run use check_energy, only: check_energy_init use chemistry, only: chem_init + use mo_lightning, only: lightning_init use prescribed_ozone, only: prescribed_ozone_init use prescribed_ghg, only: prescribed_ghg_init use prescribed_aero, only: prescribed_aero_init @@ -718,10 +727,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use co2_cycle, only: co2_init, co2_transport use convect_deep, only: convect_deep_init use convect_shallow, only: convect_shallow_init + use constituents, only: cnst_get_ind use cam_diagnostics, only: diag_init use gw_drag, only: gw_init - use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_init - use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_init use radheat, only: radheat_init use radiation, only: radiation_init use cloud_diagnostics, only: cloud_diagnostics_init @@ -731,21 +739,19 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use microp_aero, only: microp_aero_init use macrop_driver, only: macrop_driver_init use conv_water, only: conv_water_init - use spcam_drivers, only: spcam_init use tracers, only: tracers_init use aoa_tracers, only: aoa_tracers_init use rayleigh_friction, only: rayleigh_friction_init use pbl_utils, only: pbl_utils_init use vertical_diffusion, only: vertical_diffusion_init use phys_debug_util, only: phys_debug_init - use phys_debug, only: phys_debug_state_init use rad_constituents, only: rad_cnst_init use aer_rad_props, only: aer_rad_props_init use subcol, only: subcol_init use qbo, only: qbo_init use qneg_module, only: qneg_init use lunar_tides, only: lunar_tides_init - use iondrag, only: iondrag_init, do_waccm_ions + use iondrag, only: iondrag_init #if ( defined OFFLINE_DYN ) use metdata, only: metdata_phys_init #endif @@ -756,10 +762,16 @@ 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 + use cam_history, only: addfld, register_vector_field, add_default + use phys_control, only: phys_getopts + use phys_grid_ctem, only: phys_grid_ctem_init + use cam_budget, only: cam_budget_init + + use ccpp_constituent_prop_mod, only: ccpp_const_props_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -771,8 +783,12 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! local variables integer :: lchnk - integer :: ierr + integer :: ierr, ixq + logical :: history_budget ! output tendencies and state variables for + ! temperature, water vapor, cloud + ! ice, cloud liquid, U, V + integer :: history_budget_histfile_num ! output history file number for budget fields !----------------------------------------------------------------------- call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols) @@ -782,9 +798,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) end do !------------------------------------------------------------------------------------------- - ! Initialize any variables in physconst which are not temporally and/or spatially constant + ! Initialize any variables in cam_thermo which are not temporally and/or spatially constant !------------------------------------------------------------------------------------------- - call physconst_init() + call cam_thermo_init() ! Initialize debugging a physics column call phys_debug_init() @@ -824,22 +840,25 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! low level, so init it early. Must at least do this before radiation. call wv_sat_init - ! CAM3 prescribed aerosols - if (cam3_aero_data_on) call cam3_aero_data_init(phys_state) + ! solar irradiance data modules + call solar_data_init() ! Initialize rad constituents and their properties call rad_cnst_init() + + call radiation_init(pbuf2d) + call aer_rad_props_init() ! initialize carma - call carma_init() - - ! solar irradiance data modules - call solar_data_init() + call carma_init(pbuf2d) ! Prognostic chemistry. call chem_init(phys_state,pbuf2d) + ! Lightning flash frq and NOx prod + call lightning_init( pbuf2d ) + ! Prescribed tracers call prescribed_ozone_init() call prescribed_ghg_init() @@ -854,9 +873,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call co2_init() end if - ! CAM3 prescribed ozone - if (cam3_ozone_data_on) call cam3_ozone_data_init(phys_state) - call gw_init() call rayleigh_friction_init() @@ -872,9 +888,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) endif endif - call radiation_init(pbuf2d) - - call cloud_diagnostics_init() + call cloud_diagnostics_init(pbuf2d) call radheat_init(pref_mid) @@ -889,23 +903,18 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call rk_stratiform_init() elseif( microp_scheme == 'MG' ) then if (.not. do_clubb_sgs) call macrop_driver_init(pbuf2d) - call microp_aero_init(pbuf2d) + call microp_aero_init(phys_state,pbuf2d) call microp_driver_init(pbuf2d) call conv_water_init - elseif( microp_scheme == 'SPCAM_m2005') then - call conv_water_init end if - ! initiate CLUBB within CAM if (do_clubb_sgs) call clubb_ini_cam(pbuf2d) - call spcam_init(pbuf2d) - call qbo_init call lunar_tides_init() - + call iondrag_init(pref_mid) ! Geomagnetic module -- after iondrag_init if (epp_ionization_active) then @@ -917,7 +926,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') @@ -946,12 +955,93 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) end if + ! Initialize CAM CCPP constituent properties array + ! for use in CCPP-ized physics schemes: + call cnst_get_ind('Q', ixq) + call ccpp_const_props_init(ixq) + ! Initialize qneg3 and qneg4 call qneg_init() + ! Initialize phys TEM diagnostics + call phys_grid_ctem_init() + ! Initialize the snapshot capability call cam_snapshot_init(cam_in, cam_out, pbuf2d, begchunk) + ! Initialize the budget capability + call cam_budget_init() + + ! addfld calls for U, V tendency budget variables that are output in + ! tphysac, tphysbc + call addfld ( 'UTEND_DCONV', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by deep convection') + call addfld ( 'VTEND_DCONV', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by deep convection') + call register_vector_field ( 'UTEND_DCONV', 'VTEND_DCONV') + call addfld ( 'UTEND_SHCONV', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by shallow convection') + call addfld ( 'VTEND_SHCONV', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by shallow convection') + call register_vector_field ( 'UTEND_SHCONV', 'VTEND_SHCONV') + call addfld ( 'UTEND_MACROP', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by macrophysics') + call addfld ( 'VTEND_MACROP', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by macrophysics') + call register_vector_field ( 'UTEND_MACROP', 'VTEND_MACROP') + call addfld ( 'UTEND_VDIFF', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by vert. diffus.') + call addfld ( 'VTEND_VDIFF', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by vert. diffus.') + call register_vector_field ( 'UTEND_VDIFF', 'VTEND_VDIFF') + call addfld ( 'UTEND_RAYLEIGH', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by Rayleigh Fric.') + call addfld ( 'VTEND_RAYLEIGH', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by Rayleigh Fric.') + call register_vector_field ( 'UTEND_RAYLEIGH', 'VTEND_RAYLEIGH') + call addfld ( 'UTEND_GWDTOT', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by all GWs') + call addfld ( 'VTEND_GWDTOT', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by all GWs') + call register_vector_field ( 'UTEND_GWDTOT', 'VTEND_GWDTOT') + call addfld ( 'UTEND_QBORLX', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by QBO relaxation') + call addfld ( 'VTEND_QBORLX', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by QBO relaxation') + call register_vector_field ( 'UTEND_QBORLX', 'VTEND_QBORLX') + call addfld ( 'UTEND_LUNART', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by lunar tides') + call addfld ( 'VTEND_LUNART', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by lunar tides') + call register_vector_field ( 'UTEND_LUNART', 'VTEND_LUNART') + call addfld ( 'UTEND_IONDRG', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by ion drag') + call addfld ( 'VTEND_IONDRG', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by ion drag') + call register_vector_field ( 'UTEND_IONDRG', 'VTEND_IONDRG') + call addfld ( 'UTEND_NDG', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by nudging') + call addfld ( 'VTEND_NDG', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by nudging') + call register_vector_field ( 'UTEND_NDG', 'VTEND_NDG') + call addfld('UTEND_CORE', (/ 'lev' /), 'A', 'm/s2' , 'Zonal wind tendency due to dynamical core') + call addfld('VTEND_CORE', (/ 'lev' /), 'A', 'm/s2' , 'Meridional wind tendency due to dynamical core') + call register_vector_field('UTEND_CORE','VTEND_CORE') + + + call phys_getopts(history_budget_out = history_budget, & + history_budget_histfile_num_out = history_budget_histfile_num) + + if ( history_budget ) then + call add_default ( 'UTEND_DCONV' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_DCONV' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_SHCONV' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_SHCONV' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_MACROP' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_MACROP' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_VDIFF' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_VDIFF' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_RAYLEIGH' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_RAYLEIGH' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_GWDTOT' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_GWDTOT' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_QBORLX' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_QBORLX' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_LUNART' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_LUNART' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_IONDRG' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_IONDRG' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_NDG' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_NDG' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_CORE' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_CORE' , history_budget_histfile_num, ' ') + end if + + ducore_idx = pbuf_get_index('DUCORE') + dvcore_idx = pbuf_get_index('DVCORE') + dtcore_idx = pbuf_get_index('DTCORE') + dqcore_idx = pbuf_get_index('DQCORE') + end subroutine phys_init ! @@ -969,12 +1059,9 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) use cam_diagnostics,only: diag_allocate, diag_physvar_ic use check_energy, only: check_energy_gmean use phys_control, only: phys_getopts - 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 @@ -997,9 +1084,7 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) !---------------------------Local workspace----------------------------- ! integer :: c ! indices - integer :: ncol ! number of columns integer :: nstep ! current timestep number - logical :: use_spcam type(physics_buffer_desc), pointer :: phys_buffer_chunk(:) call t_startf ('physpkg_st1') @@ -1022,10 +1107,6 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) call t_stopf ('chk_en_gmean') - call t_stopf ('physpkg_st1') - - call t_startf ('physpkg_st1') - call pbuf_allocate(pbuf2d, 'physpkg') call diag_allocate() @@ -1047,18 +1128,16 @@ 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') call t_adj_detailf(+1) - call phys_getopts( use_spcam_out = use_spcam) - !$OMP PARALLEL DO PRIVATE (C, phys_buffer_chunk) do c=begchunk, endchunk ! @@ -1070,16 +1149,8 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) call diag_physvar_ic ( c, phys_buffer_chunk, cam_out(c), cam_in(c) ) call t_stopf ('diag_physvar_ic') - if (use_spcam) then - call tphysbc_spcam (ztodt, phys_state(c), & - phys_tend(c), phys_buffer_chunk, & - cam_out(c), cam_in(c) ) - else - call tphysbc (ztodt, phys_state(c), & - phys_tend(c), phys_buffer_chunk, & - cam_out(c), cam_in(c) ) - end if - + call tphysbc(ztodt, phys_state(c), phys_tend(c), phys_buffer_chunk, & + cam_out(c), cam_in(c) ) end do call t_adj_detailf(-1) @@ -1109,13 +1180,13 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_deallocate, pbuf_update_tim_idx use mo_lightning, only: lightning_no_prod use cam_diagnostics, only: diag_deallocate, diag_surf - use physconst, only: stebol, latvap use carma_intr, only: carma_accumulate_stats use spmd_utils, only: mpicom use iop_forcing, only: scam_use_iop_srf #if ( defined OFFLINE_DYN ) use metdata, only: get_met_srf2 #endif + use hemco_interface, only: HCOI_Chunk_Run ! ! Input arguments ! @@ -1140,12 +1211,24 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & ! If exit condition just return ! - if(single_column.and.scm_crm_mode) return + if(single_column.and.scm_crm_mode) then + call diag_deallocate() + return + end if !----------------------------------------------------------------------- ! if using IOP values for surface fluxes overwrite here after surface components run !----------------------------------------------------------------------- if (single_column) call scam_use_iop_srf(cam_in) + + if(use_hemco) then + !---------------------------------------------------------- + ! run hemco (phase 2 before chemistry) + ! only phase 2 is used currently for HEMCO-CESM + !---------------------------------------------------------- + call HCOI_Chunk_Run(cam_in, phys_state, pbuf2d, phase=2) + endif + !----------------------------------------------------------------------- ! Tendency physics after coupler ! Not necessary at terminal timestep. @@ -1157,9 +1240,9 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & ! call get_met_srf2( cam_in ) #endif - ! Set lightning production of NO + ! lightning flash freq and prod rate of NOx call t_startf ('lightning_no_prod') - call lightning_no_prod( phys_state, pbuf2d, cam_in ) + call lightning_no_prod( phys_state, pbuf2d, cam_in ) call t_stopf ('lightning_no_prod') call t_barrierf('sync_ac_physics', mpicom) @@ -1212,6 +1295,11 @@ subroutine phys_final( phys_state, phys_tend, pbuf2d ) use chemistry, only : chem_final use carma_intr, only : carma_final use wv_saturation, only : wv_sat_final + use hemco_interface, only: HCOI_Chunk_Final + use microp_aero, only : microp_aero_final + use phys_grid_ctem, only : phys_grid_ctem_final + use nudging, only: Nudge_Model, nudging_final + !----------------------------------------------------------------------- ! ! Purpose: @@ -1232,6 +1320,14 @@ subroutine phys_final( phys_state, phys_tend, pbuf2d ) call chem_final call carma_final call wv_sat_final + call microp_aero_final() + call phys_grid_ctem_final() + if(Nudge_Model) call nudging_final() + + if(use_hemco) then + ! cleanup hemco + call HCOI_Chunk_Final + endif end subroutine phys_final @@ -1264,16 +1360,19 @@ subroutine tphysac (ztodt, cam_in, & use rayleigh_friction, only: rayleigh_friction_tend use constituents, only: cnst_get_ind use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, & - physics_dme_adjust, set_dry_to_wet, physics_state_check + physics_dme_adjust, set_dry_to_wet, physics_state_check, & + dyn_te_idx use waccmx_phys_intr, only: waccmx_phys_mspd_tend ! WACCM-X major diffusion use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X use aoa_tracers, only: aoa_tracers_timestep_tend use physconst, only: rhoh2o, latvap,latice + use dyn_tests_utils, only: vc_dycore use aero_model, only: aero_model_drydep use carma_intr, only: carma_emission_tend, carma_timestep_tend use carma_flags_mod, only: carma_do_aerosol, carma_do_emission - use check_energy, only: check_energy_chng, calc_te_and_aam_budgets + use check_energy, only: tot_energy_phys use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng + use check_energy, only: check_energy_cam_chng use time_manager, only: get_nstep use cam_abortutils, only: endrun use dycore, only: dycore_is @@ -1286,14 +1385,17 @@ subroutine tphysac (ztodt, cam_in, & use perf_mod use flux_avg, only: flux_avg_run use unicon_cam, only: unicon_cam_org_diags - use cam_history, only: hist_fld_active + use cam_history, only: outfld use qneg_module, only: qneg4 use co2_cycle, only: co2_cycle_set_ptend use nudging, only: Nudge_Model,Nudge_ON,nudging_timestep_tend use cam_snapshot, only: cam_snapshot_all_outfld_tphysac - use cam_snapshot, only: cam_snapshot_ptend_outfld + use cam_snapshot_common,only: cam_snapshot_ptend_outfld use lunar_tides, only: lunar_tides_tend - + use cam_thermo, only: cam_thermo_water_update + use cam_budget, only: thermo_budget_history + use dyn_tests_utils, only: vc_dycore, vc_height, vc_dry_pressure + use air_composition, only: cpairv, cp_or_cv_dycore ! ! Arguments ! @@ -1313,29 +1415,25 @@ subroutine tphysac (ztodt, cam_in, & ! type(physics_ptend) :: ptend ! indivdual parameterization tendencies - integer :: nstep ! current timestep number - real(r8) :: zero(pcols) ! array of zeros + integer :: nstep ! current timestep number + real(r8) :: zero(pcols) ! array of zeros - integer :: lchnk ! chunk identifier - integer :: ncol ! number of atmospheric columns - integer i,k,m ! Longitude, level indices - integer :: yr, mon, day, tod ! components of a date - integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: i,k ! Longitude, level indices + integer :: ixq - logical :: labort ! abort flag + logical :: labort ! abort flag - real(r8) tvm(pcols,pver) ! virtual temperature - real(r8) prect(pcols) ! total precipitation real(r8) surfric(pcols) ! surface friction velocity real(r8) obklen(pcols) ! Obukhov length real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry real(r8) :: flx_heat(pcols) ! Heat flux for check_energy_chng. - real(r8) :: tmp_q (pcols,pver) ! tmp space - real(r8) :: tmp_cldliq(pcols,pver) ! tmp space - real(r8) :: tmp_cldice(pcols,pver) ! tmp space real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space real(r8) :: tmp_pdel (pcols,pver) ! tmp space real(r8) :: tmp_ps (pcols) ! tmp space + real(r8) :: scaling(pcols,pver) + logical :: moist_mixing_ratio_dycore ! physics buffer fields for total energy and mass adjustment integer itim_old, ifld @@ -1344,7 +1442,12 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: qini real(r8), pointer, dimension(:,:) :: cldliqini real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: totliqini + real(r8), pointer, dimension(:,:) :: toticeini real(r8), pointer, dimension(:,:) :: dtcore + real(r8), pointer, dimension(:,:) :: dqcore + real(r8), pointer, dimension(:,:) :: ducore + real(r8), pointer, dimension(:,:) :: dvcore real(r8), pointer, dimension(:,:) :: ast ! relative humidity cloud fraction !----------------------------------------------------------------------- @@ -1352,6 +1455,7 @@ subroutine tphysac (ztodt, cam_in, & ncol = state%ncol nstep = get_nstep() + call cnst_get_ind('Q', ixq) ! Adjust the surface fluxes to reduce instabilities in near sfc layer if (phys_do_flux_avg()) then @@ -1366,13 +1470,16 @@ subroutine tphysac (ztodt, cam_in, & ! Associate pointers with physics buffer fields itim_old = pbuf_old_tim_idx() - - ifld = pbuf_get_index('DTCORE') - call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, ducore_idx, ducore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, dvcore_idx, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, qini_idx, qini) call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, totliqini_idx, totliqini) + call pbuf_get_field(pbuf, toticeini_idx, toticeini) ifld = pbuf_get_index('CLD') call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/)) @@ -1396,7 +1503,7 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if - call chem_emissions( state, cam_in ) + call chem_emissions( state, cam_in, pbuf ) if (trim(cam_take_snapshot_after) == "chem_emissions") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) @@ -1404,7 +1511,7 @@ subroutine tphysac (ztodt, cam_in, & if (carma_do_emission) then ! carma emissions - call carma_emission_tend (state, ptend, cam_in, ztodt) + call carma_emission_tend (state, ptend, cam_in, ztodt, pbuf) call physics_update(state, ptend, ztodt, tend) end if @@ -1431,7 +1538,7 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if - call aoa_tracers_timestep_tend(state, ptend, cam_in%cflx, cam_in%landfrac, ztodt) + call aoa_tracers_timestep_tend(state, ptend, ztodt) if ( (trim(cam_take_snapshot_after) == "aoa_tracers_timestep_tend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) @@ -1489,7 +1596,7 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if - call check_energy_chng(state, tend, "chem", nstep, ztodt, fh2o, zero, zero, zero) + call check_energy_cam_chng(state, tend, "chem", nstep, ztodt, fh2o, zero, zero, zero) call check_tracers_chng(state, tracerint, "chem_timestep_tend", nstep, ztodt, & cam_in%cflx) end if @@ -1521,6 +1628,12 @@ subroutine tphysac (ztodt, cam_in, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + if ( ptend%lu ) then + call outfld( 'UTEND_VDIFF', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_VDIFF', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "vertical_diffusion_section") then @@ -1535,13 +1648,19 @@ subroutine tphysac (ztodt, cam_in, & !=================================================== call t_startf('rayleigh_friction') call rayleigh_friction_tend( ztodt, state, ptend) + if ( ptend%lu ) then + call outfld( 'UTEND_RAYLEIGH', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_RAYLEIGH', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) call t_stopf('rayleigh_friction') if (do_clubb_sgs) then - call check_energy_chng(state, tend, "vdiff", nstep, ztodt, zero, zero, zero, zero) + call check_energy_cam_chng(state, tend, "vdiff", nstep, ztodt, zero, zero, zero, zero) else - call check_energy_chng(state, tend, "vdiff", nstep, ztodt, cam_in%cflx(:,1), zero, & + call check_energy_cam_chng(state, tend, "vdiff", nstep, ztodt, cam_in%cflx(:,1), zero, & zero, cam_in%shf) endif @@ -1581,7 +1700,7 @@ subroutine tphysac (ztodt, cam_in, & call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, obklen=obklen, ustar=surfric) call physics_update(state, ptend, ztodt, tend) - call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, zero, zero, zero) + call check_energy_cam_chng(state, tend, "carma_tend", nstep, ztodt, zero, zero, zero, zero) call t_stopf('carma_timestep_tend') end if @@ -1607,6 +1726,12 @@ subroutine tphysac (ztodt, cam_in, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + if ( ptend%lu ) then + call outfld( 'UTEND_GWDTOT', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_GWDTOT', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "gw_tend") then @@ -1615,7 +1740,7 @@ subroutine tphysac (ztodt, cam_in, & end if ! Check energy integrals - call check_energy_chng(state, tend, "gwdrag", nstep, ztodt, zero, & + call check_energy_cam_chng(state, tend, "gwdrag", nstep, ztodt, zero, & zero, zero, flx_heat) call t_stopf('gw_tend') @@ -1631,6 +1756,12 @@ subroutine tphysac (ztodt, cam_in, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + if ( ptend%lu ) then + call outfld( 'UTEND_QBORLX', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_QBORLX', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "qbo_relax") then @@ -1639,13 +1770,19 @@ subroutine tphysac (ztodt, cam_in, & end if ! Check energy integrals - call check_energy_chng(state, tend, "qborelax", nstep, ztodt, zero, zero, zero, zero) + call check_energy_cam_chng(state, tend, "qborelax", nstep, ztodt, zero, zero, zero, zero) ! Lunar tides call lunar_tides_tend( state, ptend ) + if ( ptend%lu ) then + call outfld( 'UTEND_LUNART', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_LUNART', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) ! Check energy integrals - call check_energy_chng(state, tend, "lunar_tides", nstep, ztodt, zero, zero, zero, zero) + call check_energy_cam_chng(state, tend, "lunar_tides", nstep, ztodt, zero, zero, zero, zero) ! Ion drag calculation call t_startf ( 'iondrag' ) @@ -1671,6 +1808,12 @@ subroutine tphysac (ztodt, cam_in, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + if ( ptend%lu ) then + call outfld( 'UTEND_IONDRG', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_IONDRG', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "iondrag_calc_section") then @@ -1678,7 +1821,8 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - call calc_te_and_aam_budgets(state, 'pAP') + call tot_energy_phys(state, 'phAP') + call tot_energy_phys(state, 'dyAP',vc=vc_dycore) !--------------------------------------------------------------------------------- ! Enforce charge neutrality after O+ change from ionos_tend @@ -1688,7 +1832,7 @@ subroutine tphysac (ztodt, cam_in, & endif ! Check energy integrals - call check_energy_chng(state, tend, "iondrag", nstep, ztodt, zero, zero, zero, zero) + call check_energy_cam_chng(state, tend, "iondrag", nstep, ztodt, zero, zero, zero, zero) call t_stopf ( 'iondrag' ) @@ -1696,14 +1840,23 @@ subroutine tphysac (ztodt, cam_in, & !---------------------------------- if((Nudge_Model).and.(Nudge_ON)) then call nudging_timestep_tend(state,ptend) + if ( ptend%lu ) then + call outfld( 'UTEND_NDG', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_NDG', ptend%v, pcols, lchnk) + end if call physics_update(state,ptend,ztodt,tend) - call check_energy_chng(state, tend, "nudging", nstep, ztodt, zero, zero, zero, zero) + call check_energy_cam_chng(state, tend, "nudging", nstep, ztodt, zero, zero, zero, zero) endif !-------------- Energy budget checks vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv - ! Save total energy for global fixer in next timestep (FV and SE dycores) - call pbuf_set_field(pbuf, teout_idx, state%te_cur, (/1,itim_old/),(/pcols,1/)) + ! Save total energy for global fixer in next timestep + ! + ! This call must be after the last parameterization and call to physics_update + ! + call pbuf_set_field(pbuf, teout_idx, state%te_cur(:,dyn_te_idx), (/1,itim_old/),(/pcols,1/)) if (shallow_scheme .eq. 'UNICON') then @@ -1724,71 +1877,77 @@ subroutine tphysac (ztodt, cam_in, & ! ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. - if ( dycore_is('LR').or. dycore_is('FV3')) call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist - - ! Scale dry mass and energy (does nothing if dycore is EUL or SLD) - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) + moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') + ! + ! update cp/cv for energy computation based in updated water variables + ! + call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore,& + to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) - tmp_q (:ncol,:pver) = state%q(:ncol,:pver,1) - tmp_cldliq(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - tmp_cldice(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) - - ! For not ('FV'|'FV3'), physics_dme_adjust is called for energy diagnostic purposes only. So, save off tracers - if (.not.(dycore_is('FV').or.dycore_is('FV3')).and.& - (hist_fld_active('SE_pAM').or.hist_fld_active('KE_pAM').or.hist_fld_active('WV_pAM').or.& - hist_fld_active('WL_pAM').or.hist_fld_active('WI_pAM'))) then - tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) - tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) - tmp_ps(:ncol) = state%ps(:ncol) + ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. + ! So, save off tracers + if (.not.moist_mixing_ratio_dycore) then ! - ! pint, lnpint,rpdel are altered by dme_adjust but not used for tendencies in dynamics of SE - ! we do not reset them to pre-dme_adjust values + ! for dry-mixing ratio based dycores dme_adjust takes place in the dynamical core ! - if (dycore_is('SE')) call set_dry_to_wet(state) - - if (trim(cam_take_snapshot_before) == "physics_dme_adjust") then - call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& - fh2o, surfric, obklen, flx_heat) - end if - - call physics_dme_adjust(state, tend, qini, ztodt) - - if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then - call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& - fh2o, surfric, obklen, flx_heat) + ! only compute dme_adjust for diagnostics purposes + ! + if (thermo_budget_history) then + tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) + tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) + tmp_ps(:ncol) = state%ps(:ncol) + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) + ! Restore pre-"physics_dme_adjust" tracers + state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) + state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) + state%ps(:ncol) = tmp_ps(:ncol) end if - - call calc_te_and_aam_budgets(state, 'pAM') - ! Restore pre-"physics_dme_adjust" tracers - state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) - state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) - state%ps(:ncol) = tmp_ps(:ncol) - end if - - if (dycore_is('LR') .or. dycore_is('FV3')) then + else + ! + ! for moist-mixing ratio based dycores + ! + ! Note: this operation will NOT be reverted with set_wet_to_dry after set_dry_to_wet call + ! + call set_dry_to_wet(state, convert_cnst_type='dry') if (trim(cam_take_snapshot_before) == "physics_dme_adjust") then - call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if - - call physics_dme_adjust(state, tend, qini, ztodt) - + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then - call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& - fh2o, surfric, obklen, flx_heat) + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat) end if - call calc_te_and_aam_budgets(state, 'pAM') + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) endif -!!! REMOVE THIS CALL, SINCE ONLY Q IS BEING ADJUSTED. WON'T BALANCE ENERGY. TE IS SAVED BEFORE THIS -!!! call check_energy_chng(state, tend, "drymass", nstep, ztodt, zero, zero, zero, zero) + if (vc_dycore == vc_height.or.vc_dycore == vc_dry_pressure) then + ! + ! MPAS and SE specific scaling of temperature for enforcing energy consistency + ! (and to make sure that temperature dependent diagnostic tendencies + ! are computed correctly; e.g. dtcore) + ! + scaling(1:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv_dycore(:ncol,:,lchnk) + state%T(1:ncol,:) = state%temp_ini(1:ncol,:)+& + scaling(1:ncol,:)*(state%T(1:ncol,:)-state%temp_ini(1:ncol,:)) + tend%dtdt(:ncol,:) = scaling(:ncol,:)*tend%dtdt(:ncol,:) + ! + ! else: do nothing for dycores with energy consistent with CAM physics + ! + end if + - ! store T in buffer for use in computing dynamics T-tendency in next timestep + ! store T, U, and V in buffer for use in computing dynamics T-tendency in next timestep do k = 1,pver dtcore(:ncol,k) = state%t(:ncol,k) + dqcore(:ncol,k) = state%q(:ncol,k,ixq) + ducore(:ncol,k) = state%u(:ncol,k) + dvcore(:ncol,k) = state%v(:ncol,k) end do !-------------- Energy budget checks ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ @@ -1806,11 +1965,18 @@ subroutine tphysac (ztodt, cam_in, & endif endif - call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_cldliq, tmp_cldice, & - qini, cldliqini, cldiceini) + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, cldliqini, cldiceini) call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) + ! output these here -- after updates by chem_timestep_tend or export_fields within the current time step + if (associated(cam_out%nhx_nitrogen_flx)) then + call outfld('a2x_NHXDEP', cam_out%nhx_nitrogen_flx, pcols, lchnk) + end if + if (associated(cam_out%noy_nitrogen_flx)) then + call outfld('a2x_NOYDEP', cam_out%noy_nitrogen_flx, pcols, lchnk) + end if + end subroutine tphysac subroutine tphysbc (ztodt, state, & @@ -1854,21 +2020,26 @@ subroutine tphysbc (ztodt, state, & use microp_aero, only: microp_aero_run use macrop_driver, only: macrop_driver_tend use physics_types, only: physics_state, physics_tend, physics_ptend, & - physics_update, physics_ptend_init, physics_ptend_sum, & - physics_state_check, physics_ptend_scale + physics_update, physics_ptend_init, physics_ptend_sum, & + physics_state_check, physics_ptend_scale, & + dyn_te_idx use cam_diagnostics, only: diag_conv_tend_ini, diag_phys_writeout, diag_conv, diag_export, diag_state_b4_phys_write use cam_diagnostics, only: diag_clip_tend_writeout use cam_history, only: outfld - use physconst, only: cpair, latvap + use physconst, only: latvap use constituents, only: pcnst, qmin, cnst_get_ind + use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx + use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use convect_deep, only: convect_deep_tend, convect_deep_tend_2, deep_scheme_does_scav_trans use time_manager, only: is_first_step, get_nstep use convect_shallow, only: convect_shallow_tend - use check_energy, only: check_energy_chng, check_energy_fix, check_energy_timestep_init + use check_energy, only: check_energy_timestep_init, check_energy_cam_chng + use check_energy, only: check_energy_cam_fix use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng - use check_energy, only: calc_te_and_aam_budgets + use check_energy, only: tot_energy_phys use dycore, only: dycore_is use aero_model, only: aero_model_wetdep + use aero_wetdep_cam, only: 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 @@ -1883,12 +2054,14 @@ subroutine tphysbc (ztodt, state, & use subcol, only: subcol_gen, subcol_ptend_avg use subcol_utils, only: subcol_ptend_copy, is_subcol_on use qneg_module, only: qneg3 - use subcol_SILHS, only: subcol_SILHS_var_covar_driver + use subcol_SILHS, only: subcol_SILHS_var_covar_driver, init_state_subcol use subcol_SILHS, only: subcol_SILHS_fill_holes_conserv use subcol_SILHS, only: subcol_SILHS_hydromet_conc_tend_lim - use micro_mg_cam, only: massless_droplet_destroyer + use micro_pumas_cam, only: massless_droplet_destroyer use cam_snapshot, only: cam_snapshot_all_outfld_tphysbc - use cam_snapshot, only: cam_snapshot_ptend_outfld + use cam_snapshot_common, only: cam_snapshot_ptend_outfld + use ssatcontrail, only: ssatcontrail_d0 + use dyn_tests_utils, only: vc_dycore ! Arguments @@ -1907,6 +2080,7 @@ subroutine tphysbc (ztodt, state, & ! type(physics_ptend) :: ptend ! indivdual parameterization tendencies + type(physics_ptend) :: ptend_macp_all ! sum of macrophysics tendencies (e.g. CLUBB) over substeps type(physics_state) :: state_sc ! state for sub-columns type(physics_ptend) :: ptend_sc ! ptend for sub-columns type(physics_ptend) :: ptend_aero ! ptend for microp_aero @@ -1924,7 +2098,6 @@ subroutine tphysbc (ztodt, state, & real(r8) dlf(pcols,pver) ! Detraining cld H20 from shallow + deep convections real(r8) dlf2(pcols,pver) ! Detraining cld H20 from shallow convections - real(r8) pflx(pcols,pverp) ! Conv rain flux thru out btm of lev real(r8) rtdt ! 1./ztodt integer lchnk ! chunk identifier @@ -1932,9 +2105,10 @@ subroutine tphysbc (ztodt, state, & integer :: i ! column indicex 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 @@ -1945,7 +2119,12 @@ subroutine tphysbc (ztodt, state, & real(r8), pointer, dimension(:,:) :: qini real(r8), pointer, dimension(:,:) :: cldliqini real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: totliqini + real(r8), pointer, dimension(:,:) :: toticeini real(r8), pointer, dimension(:,:) :: dtcore + real(r8), pointer, dimension(:,:) :: dqcore + real(r8), pointer, dimension(:,:) :: ducore + real(r8), pointer, dimension(:,:) :: dvcore real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble @@ -1990,8 +2169,6 @@ subroutine tphysbc (ztodt, state, & type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes real(r8) :: zero_tracers(pcols,pcnst) - logical :: lq(pcnst) - !----------------------------------------------------------------------- call t_startf('bc_init') @@ -2017,9 +2194,13 @@ subroutine tphysbc (ztodt, state, & call pbuf_get_field(pbuf, qini_idx, qini) call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, totliqini_idx, totliqini) + call pbuf_get_field(pbuf, toticeini_idx, toticeini) - ifld = pbuf_get_index('DTCORE') - call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, ducore_idx, ducore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, dvcore_idx, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) ifld = pbuf_get_index('FRACIS') call pbuf_get_field(pbuf, ifld, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) @@ -2060,14 +2241,16 @@ subroutine tphysbc (ztodt, state, & !=================================================== call t_startf('energy_fixer') - call calc_te_and_aam_budgets(state, 'pBF') - if (dycore_is('LR') .or. dycore_is('FV3') .or. dycore_is('SE')) then - call check_energy_fix(state, ptend, nstep, flx_heat) - call physics_update(state, ptend, ztodt, tend) - call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) - call outfld( 'EFIX', flx_heat , pcols, lchnk ) - end if - call calc_te_and_aam_budgets(state, 'pBP') + call tot_energy_phys(state, 'phBF') + call tot_energy_phys(state, 'dyBF',vc=vc_dycore) + + call check_energy_cam_fix(state, ptend, nstep, flx_heat) + call physics_update(state, ptend, ztodt, tend) + call check_energy_cam_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) + call outfld( 'EFIX', flx_heat , pcols, lchnk ) + + call tot_energy_phys(state, 'phBP') + call tot_energy_phys(state, 'dyBP',vc=vc_dycore) ! Save state for convective tendency calculations. call diag_conv_tend_ini(state, pbuf) @@ -2078,14 +2261,32 @@ subroutine tphysbc (ztodt, state, & cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + totliqini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_liq_num + m = thermodynamic_active_species_liq_idx(m_cnst) + totliqini(:ncol,:pver) = totliqini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do + toticeini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_ice_num + m = thermodynamic_active_species_ice_idx(m_cnst) + toticeini(:ncol,:pver) = toticeini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do + + call outfld('TEOUT', teout , pcols, lchnk ) - call outfld('TEINP', state%te_ini, pcols, lchnk ) - call outfld('TEFIX', state%te_cur, pcols, lchnk ) + call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) + call outfld('TEFIX', state%te_cur(:,dyn_te_idx), pcols, lchnk ) - ! T tendency due to dynamics + ! T, U, V tendency due to dynamics if( nstep > dyn_time_lvls-1 ) then dtcore(:ncol,:pver) = (state%t(:ncol,:pver) - dtcore(:ncol,:pver))/ztodt + dqcore(:ncol,:pver) = (state%q(:ncol,:pver,ixq) - dqcore(:ncol,:pver))/ztodt + ducore(:ncol,:pver) = (state%u(:ncol,:pver) - ducore(:ncol,:pver))/ztodt + dvcore(:ncol,:pver) = (state%v(:ncol,:pver) - dvcore(:ncol,:pver))/ztodt call outfld( 'DTCORE', dtcore, pcols, lchnk ) + call outfld( 'DQCORE', dqcore, pcols, lchnk ) + call outfld( 'UTEND_CORE', ducore, pcols, lchnk ) + call outfld( 'VTEND_CORE', dvcore, pcols, lchnk ) end if call t_stopf('energy_fixer') @@ -2097,7 +2298,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "dadadj_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call dadadj_tend(ztodt, state, ptend) @@ -2110,7 +2311,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "dadadj_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call t_stopf('dry_adjustment') @@ -2124,12 +2325,12 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "convect_deep_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call convect_deep_tend( & cmfmc, cmfcme, & - pflx, zdu, & + zdu, & rliq, rice, & ztodt, & state, ptend, cam_in%landfrac, pbuf) @@ -2138,11 +2339,18 @@ subroutine tphysbc (ztodt, state, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + + if ( ptend%lu ) then + call outfld( 'UTEND_DCONV', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_DCONV', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "convect_deep_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call t_stopf('convect_deep_tend') @@ -2166,7 +2374,7 @@ subroutine tphysbc (ztodt, state, & ! Check energy integrals, including "reserved liquid" flx_cnd(:ncol) = prec_dp(:ncol) + rliq(:ncol) snow_dp(:ncol) = snow_dp(:ncol) + rice(:ncol) - call check_energy_chng(state, tend, "convect_deep", nstep, ztodt, zero, flx_cnd, snow_dp, zero) + call check_energy_cam_chng(state, tend, "convect_deep", nstep, ztodt, zero, flx_cnd, snow_dp, zero) snow_dp(:ncol) = snow_dp(:ncol) - rice(:ncol) ! @@ -2183,7 +2391,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "convect_shallow_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call convect_shallow_tend (ztodt , cmfmc, & @@ -2195,15 +2403,21 @@ subroutine tphysbc (ztodt, state, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + if ( ptend%lu ) then + call outfld( 'UTEND_SHCONV', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_SHCONV', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "convect_shallow_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if flx_cnd(:ncol) = prec_sh(:ncol) + rliq2(:ncol) - call check_energy_chng(state, tend, "convect_shallow", nstep, ztodt, zero, flx_cnd, snow_sh, zero) + call check_energy_cam_chng(state, tend, "convect_shallow", nstep, ztodt, zero, flx_cnd, snow_sh, zero) call check_tracers_chng(state, tracerint, "convect_shallow", nstep, ztodt, zero_tracers) @@ -2235,9 +2449,9 @@ subroutine tphysbc (ztodt, state, & ! Before the detrainment, the reserved condensate is all liquid, but if CARMA is doing ! detrainment, then the reserved condensate is snow. if (carma_do_detrain) then - call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str+rliq, snow_str+rliq, zero) + call check_energy_cam_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str+rliq, snow_str+rliq, zero) else - call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str, snow_str, zero) + call check_energy_cam_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str, snow_str, zero) end if end if @@ -2259,7 +2473,7 @@ subroutine tphysbc (ztodt, state, & cam_in%ts, cam_in%sst, zdu) call physics_update(state, ptend, ztodt, tend) - call check_energy_chng(state, tend, "cldwat_tend", nstep, ztodt, zero, prec_str, snow_str, zero) + call check_energy_cam_chng(state, tend, "cldwat_tend", nstep, ztodt, zero, prec_str, snow_str, zero) call t_stopf('rk_stratiform_tend') @@ -2273,6 +2487,17 @@ subroutine tphysbc (ztodt, state, & prec_pcw_macmic = 0._r8 snow_pcw_macmic = 0._r8 + ! contrail parameterization + ! see Chen et al., 2012: Global contrail coverage simulated + ! by CAM5 with the inventory of 2006 global aircraft emissions, JAMES + ! https://doi.org/10.1029/2011MS000105 + call ssatcontrail_d0(state, pbuf, ztodt, ptend) + call physics_update(state, ptend, ztodt, tend) + + ! initialize ptend structures where macro and microphysics tendencies are + ! accumulated over macmic substeps + call physics_ptend_init(ptend_macp_all,state%psetcols,'macrophysics',lu=.true.,lv=.true.) + do macmic_it = 1, cld_macmic_num_steps !=================================================== @@ -2286,7 +2511,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "macrop_driver_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call macrop_driver_tend( & @@ -2312,14 +2537,15 @@ subroutine tphysbc (ztodt, state, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + call physics_ptend_sum(ptend,ptend_macp_all,ncol) call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "macrop_driver_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if - call check_energy_chng(state, tend, "macrop_tend", nstep, ztodt, & + call check_energy_cam_chng(state, tend, "macrop_tend", nstep, ztodt, & zero, flx_cnd(:ncol)/cld_macmic_num_steps, & det_ice(:ncol)/cld_macmic_num_steps, & flx_heat(:ncol)/cld_macmic_num_steps) @@ -2332,7 +2558,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "clubb_tend_cam") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call clubb_tend_cam(state, ptend, pbuf, cld_macmic_ztodt,& @@ -2357,15 +2583,16 @@ subroutine tphysbc (ztodt, state, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + call physics_ptend_sum(ptend,ptend_macp_all,ncol) call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "clubb_tend_cam") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if ! Use actual qflux (not lhf/latvap) for consistency with surface fluxes and revised code - call check_energy_chng(state, tend, "clubb_tend", nstep, ztodt, & + call check_energy_cam_chng(state, tend, "clubb_tend", nstep, ztodt, & cam_in%cflx(:ncol,1)/cld_macmic_num_steps, & flx_cnd(:ncol)/cld_macmic_num_steps, & det_ice(:ncol)/cld_macmic_num_steps, & @@ -2379,12 +2606,17 @@ subroutine tphysbc (ztodt, state, & ! Calculate cloud microphysics !=================================================== + if (is_subcol_on() .neqv. use_subcol_microp ) then + call endrun("Error calculating cloud microphysics: is_subcol_on() != use_subcol_microp") + end if + if (is_subcol_on()) then ! Allocate sub-column structures. call physics_state_alloc(state_sc, lchnk, psubcols*pcols) call physics_tend_alloc(tend_sc, psubcols*pcols) ! Generate sub-columns using the requested scheme + if (trim(subcol_scheme) == 'SILHS') call init_state_subcol(state, tend, state_sc, tend_sc) call subcol_gen(state, tend, state_sc, tend_sc, pbuf) !Initialize check energy for subcolumns @@ -2393,7 +2625,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "microp_section") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call t_startf('microp_aero_run') @@ -2406,7 +2638,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "microp_driver_tend_subcol") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state_sc, tend_sc, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call microp_driver_tend(state_sc, ptend_sc, cld_macmic_ztodt, pbuf) @@ -2458,10 +2690,10 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "microp_driver_tend_subcol") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state_sc, tend_sc, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if - call check_energy_chng(state_sc, tend_sc, "microp_tend_subcol", & + call check_energy_cam_chng(state_sc, tend_sc, "microp_tend_subcol", & nstep, ztodt, zero_sc, & prec_str_sc(:state_sc%ncol)/cld_macmic_num_steps, & snow_str_sc(:state_sc%ncol)/cld_macmic_num_steps, zero_sc) @@ -2490,10 +2722,10 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "microp_section") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if - call check_energy_chng(state, tend, "microp_tend", nstep, ztodt, & + call check_energy_cam_chng(state, tend, "microp_tend", nstep, ztodt, & zero, prec_str(:ncol)/cld_macmic_num_steps, & snow_str(:ncol)/cld_macmic_num_steps, zero) @@ -2505,6 +2737,10 @@ subroutine tphysbc (ztodt, state, & end do ! end substepping over macrophysics/microphysics + call outfld( 'UTEND_MACROP', ptend_macp_all%u, pcols, lchnk) + call outfld( 'VTEND_MACROP', ptend_macp_all%v, pcols, lchnk) + call physics_ptend_dealloc(ptend_macp_all) + prec_sed(:ncol) = prec_sed_macmic(:ncol)/cld_macmic_num_steps snow_sed(:ncol) = snow_sed_macmic(:ncol)/cld_macmic_num_steps prec_pcw(:ncol) = prec_pcw_macmic(:ncol)/cld_macmic_num_steps @@ -2533,15 +2769,27 @@ subroutine tphysbc (ztodt, state, & ! wet scavenging but not 'convect_deep_tend2'. ! ------------------------------------------------------------------------------- - call t_startf('bc_aerosols') - if (clim_modal_aero .and. .not. prog_modal_aero) then - call modal_aero_calcsize_diag(state, pbuf) - call modal_aero_wateruptake_dr(state, pbuf) + call t_startf('aerosol_wet_processes') + if (clim_modal_aero) then + if (prog_modal_aero) then + call physics_ptend_init(ptend, state%psetcols, 'aero_water_uptake', lq=wetdep_lq) + ! Do calculations of mode radius and water uptake if: + ! 1) modal aerosols are affecting the climate, or + ! 2) prognostic modal aerosols are enabled + call modal_aero_calcsize_sub(state, ptend, ztodt, pbuf) + ! for prognostic modal aerosols the transfer of mass between aitken and accumulation + ! modes is done in conjunction with the dry radius calculation + call modal_aero_wateruptake_dr(state, pbuf) + call physics_update(state, ptend, ztodt, tend) + else + call modal_aero_calcsize_diag(state, pbuf) + call modal_aero_wateruptake_dr(state, pbuf) + endif endif if (trim(cam_take_snapshot_before) == "aero_model_wetdep") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call aero_model_wetdep( state, ztodt, dlf, cam_out, ptend, pbuf) @@ -2553,7 +2801,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "aero_model_wetdep") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if if (carma_do_wetdep) then @@ -2576,7 +2824,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 @@ -2608,7 +2856,7 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_before) == "radiation_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if call radiation_tend( & @@ -2627,10 +2875,10 @@ subroutine tphysbc (ztodt, state, & if (trim(cam_take_snapshot_after) == "radiation_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & - flx_heat, cmfmc, cmfcme, pflx, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) + flx_heat, cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, det_s, det_ice, net_flx) end if - call check_energy_chng(state, tend, "radheat", nstep, ztodt, zero, zero, zero, net_flx) + call check_energy_cam_chng(state, tend, "radheat", nstep, ztodt, zero, zero, zero, net_flx) call t_stopf('radiation') @@ -2659,15 +2907,12 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) ! datasets. ! !----------------------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 use chemistry, only: chem_timestep_init use chem_surfvals, only: chem_surfvals_set use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc use carma_intr, only: carma_timestep_init use ghg_data, only: ghg_data_timestep_init - use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_timestep_init - use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_timestep_init use aoa_tracers, only: aoa_tracers_timestep_init use vertical_diffusion, only: vertical_diffusion_ts_init use radheat, only: radheat_timestep_init @@ -2687,6 +2932,8 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) use epp_ionization, only: epp_ionization_active use iop_forcing, only: scam_use_iop_srf use nudging, only: Nudge_Model, nudging_timestep_init + use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_timestep_init + use phys_grid_ctem, only: phys_grid_ctem_diags implicit none @@ -2714,6 +2961,10 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) ! Time interpolate for chemistry. call chem_timestep_init(phys_state, pbuf2d) + if( waccmx_is('ionosphere') ) then + call waccmx_phys_ion_elec_temp_timestep_init(phys_state,pbuf2d) + endif + ! Prescribed tracers call prescribed_ozone_adv(phys_state, pbuf2d) call prescribed_ghg_adv(phys_state, pbuf2d) @@ -2725,12 +2976,6 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) ! prescribed aerosol deposition fluxes call aerodep_flx_adv(phys_state, pbuf2d, cam_out) - ! CAM3 prescribed aerosol masses - if (cam3_aero_data_on) call cam3_aero_data_timestep_init(pbuf2d, phys_state) - - ! CAM3 prescribed ozone data - if (cam3_ozone_data_on) call cam3_ozone_data_timestep_init(pbuf2d, phys_state) - ! Time interpolate data models of gasses in pbuf2d call ghg_data_timestep_init(pbuf2d, phys_state) @@ -2756,6 +3001,9 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) !---------------------------------- if(Nudge_Model) call nudging_timestep_init(phys_state) + ! Update TEM diagnostics + call phys_grid_ctem_diags(phys_state) + end subroutine phys_timestep_init end module physpkg diff --git a/src/physics/cam/pkg_cldoptics.F90 b/src/physics/cam/pkg_cldoptics.F90 index aa40dae6c3..221184a301 100644 --- a/src/physics/cam/pkg_cldoptics.F90 +++ b/src/physics/cam/pkg_cldoptics.F90 @@ -118,7 +118,7 @@ subroutine cldems(lchnk ,ncol ,clwp ,fice ,rei ,emis ,cldtau) !note that optical properties for ice valid only !in range of 13 > rei > 130 micron (Ebert and Curry 92) - if ( microp_scheme == 'RK' .or. microp_scheme == 'SPCAM_sam1mom') then + if ( microp_scheme == 'RK') then kabsi = 0.005_r8 + 1._r8/rei(i,k) else kabsi = 0.005_r8 + 1._r8/min(max(13._r8,rei(i,k)),130._r8) diff --git a/src/physics/cam/qneg_module.F90 b/src/physics/cam/qneg_module.F90 index f3e14f52fd..773bf220a5 100644 --- a/src/physics/cam/qneg_module.F90 +++ b/src/physics/cam/qneg_module.F90 @@ -325,7 +325,6 @@ subroutine qneg4 (subnam, lchnk, ncol, ztodt, & ! Author: J. Olson ! !----------------------------------------------------------------------- -! use phys_grid, only: get_lat_p, get_lon_p use physconst, only: gravit, latvap use constituents, only: qmin use cam_history, only: outfld diff --git a/src/physics/cam/rad_constituents.F90 b/src/physics/cam/rad_constituents.F90 index 23459f3988..777af8728e 100644 --- a/src/physics/cam/rad_constituents.F90 +++ b/src/physics/cam/rad_constituents.F90 @@ -2,9 +2,9 @@ module rad_constituents !------------------------------------------------------------------------------------------------ ! -! Provide constituent distributions and properties to the radiation and +! Provide constituent distributions and properties to the radiation and ! cloud microphysics routines. -! +! ! The logic to control which constituents are used in the climate calculations ! and which are used in diagnostic radiation calculations is contained in this module. ! @@ -17,9 +17,9 @@ module rad_constituents use physics_types, only: physics_state use phys_control, only: use_simple_phys use constituents, only: cnst_get_ind -use radconstants, only: nradgas, rad_gas_index, ot_length +use radconstants, only: nradgas, rad_gas_index use phys_prop, only: physprop_accum_unique_files, physprop_init, & - physprop_get_id + physprop_get_id, ot_length use cam_history, only: addfld, fieldname_len, outfld, horiz_only use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index @@ -115,7 +115,7 @@ module rad_constituents ! type to provide access to the data parsed from the rad_climate and rad_diag_* strings type :: rad_cnst_namelist_t integer :: ncnst - character(len= 1), pointer :: source(:) ! 'A' for state (advected), 'N' for pbuf (non-advected), + character(len= 1), pointer :: source(:) ! 'A' for state (advected), 'N' for pbuf (non-advected), ! 'M' for mode, 'Z' for zero character(len= 64), pointer :: camname(:) ! name registered in pbuf or constituents character(len=cs1), pointer :: radname(:) ! radname is the name as identfied in radiation, @@ -127,7 +127,7 @@ module rad_constituents type(rad_cnst_namelist_t) :: namelist(0:N_DIAG) ! gas, bulk aerosol, and modal components used in ! climate/diagnostic calculations -logical :: active_calls(0:N_DIAG) ! active_calls(i) is true if the i-th call to radiation is +logical :: active_calls(0:N_DIAG) ! active_calls(i) is true if the i-th call to radiation is ! specified. Note that the 0th call is for the climate ! calculation which is always made. @@ -184,7 +184,7 @@ module rad_constituents ! values for constituents with requested value of zero -real(r8), allocatable, target :: zero_cols(:,:) +real(r8), allocatable, target :: zero_cols(:,:) ! define generic interface routines interface rad_cnst_get_info @@ -207,11 +207,12 @@ module rad_constituents logical :: verbose = .true. character(len=1), parameter :: nl = achar(10) -integer, parameter :: num_mode_types = 8 +integer, parameter :: num_mode_types = 9 integer, parameter :: num_spec_types = 8 character(len=14), parameter :: mode_type_names(num_mode_types) = (/ & 'accum ', 'aitken ', 'primary_carbon', 'fine_seasalt ', & - 'fine_dust ', 'coarse ', 'coarse_seasalt', 'coarse_dust ' /) + 'fine_dust ', 'coarse ', 'coarse_seasalt', 'coarse_dust ', & + 'coarse_strat ' /) character(len=9), parameter :: spec_type_names(num_spec_types) = (/ & 'sulfate ', 'ammonium ', 'nitrate ', 'p-organic', & 's-organic', 'black-c ', 'seasalt ', 'dust '/) @@ -298,7 +299,7 @@ subroutine rad_cnst_readnl(nlfile) ! Mode definition stings call parse_mode_defs(mode_defs, modes) - + ! Lists of externally mixed entities for climate and diagnostic calculations do i = 0,N_DIAG select case (i) @@ -330,7 +331,7 @@ subroutine rad_cnst_readnl(nlfile) ! were there any constituents specified for the nth diagnostic call? ! if so, radiation will make a call with those consituents active_calls(:) = (namelist(:)%ncnst > 0) - + ! Initialize the gas and aerosol lists with the information from the ! namelist. This is done here so that this information is available via ! the query functions at the time when the register methods are called. @@ -469,13 +470,13 @@ subroutine rad_cnst_get_gas(list_idx, gasname, state, pbuf, mmr) write(iulog,*) subname//': list_idx =', list_idx call endrun(subname//': list_idx out of bounds') endif - + lchnk = state%lchnk - ! Get index of gas in internal arrays. rad_gas_index will abort if the + ! Get index of gas in internal arrays. rad_gas_index will abort if the ! specified gasname is not recognized by the radiative transfer code. igas = rad_gas_index(trim(gasname)) - + ! Get data source source = list%gas(igas)%source idx = list%gas(igas)%idx @@ -515,10 +516,10 @@ function rad_cnst_num_name(list_idx, spc_name_in, num_name_out, mode_out, spec_o character(len= 32) :: spec_name found = .false. - + m_list => ma_list(list_idx) nmodes = m_list%nmodes - + do n = 1,nmodes mm = m_list%idx(n) nspecs = modes%comps(mm)%nspec @@ -628,7 +629,7 @@ subroutine rad_cnst_get_info(list_idx, gasnames, aernames, & ! get index of O3 in gas list igas = rad_gas_index('O3') - + ! Get data source source = g_list%gas(igas)%source @@ -1053,7 +1054,7 @@ subroutine init_mode_comps(modes) modes%comps(m)%camname_mmr_c(ispec), routine) ! get physprop ID - modes%comps(m)%idx_props(ispec) = physprop_get_id(modes%comps(m)%props(ispec)) + modes%comps(m)%idx_props(ispec) = physprop_get_id(modes%comps(m)%props(ispec)) if (modes%comps(m)%idx_props(ispec) == -1) then call endrun(routine//' : ERROR idx not found for '//trim(modes%comps(m)%props(ispec))) end if @@ -1078,7 +1079,7 @@ integer function get_cam_idx(source, name, routine) integer :: idx integer :: errcode !----------------------------------------------------------------------------- - + if (source(1:1) == 'N') then idx = pbuf_get_index(trim(name),errcode) @@ -1102,7 +1103,7 @@ integer function get_cam_idx(source, name, routine) call endrun(routine//' ERROR: invalid source for specie '//trim(name)) end if - + get_cam_idx = idx end function get_cam_idx @@ -1111,7 +1112,7 @@ end function get_cam_idx subroutine list_init1(namelist, gaslist, aerlist, ma_list) - ! Initialize the gas and bulk and modal aerosol lists with the + ! Initialize the gas and bulk and modal aerosol lists with the ! entities specified in the climate or diagnostic lists. ! This first phase initialization just sets the information that @@ -1179,7 +1180,7 @@ subroutine list_init1(namelist, gaslist, aerlist, ma_list) end if ! Add component to appropriate list (gas, modal or bulk aerosol) - if (namelist%type(ii) == 'A') then + if (namelist%type(ii) == 'A') then ! Add to bulk aerosol list ba_idx = ba_idx + 1 @@ -1188,7 +1189,7 @@ subroutine list_init1(namelist, gaslist, aerlist, ma_list) aerlist%aer(ba_idx)%camname = namelist%camname(ii) aerlist%aer(ba_idx)%physprop_file = namelist%radname(ii) - else if (namelist%type(ii) == 'M') then + else if (namelist%type(ii) == 'M') then ! Add to modal aerosol list ma_idx = ma_idx + 1 @@ -1208,7 +1209,7 @@ subroutine list_init1(namelist, gaslist, aerlist, ma_list) ! Also save the name of the physprop file ma_list%physprop_files(ma_idx) = namelist%radname(ii) - else + else ! Add to gas list @@ -1387,7 +1388,7 @@ end subroutine rad_aer_diag_init subroutine parse_mode_defs(nl_in, modes) ! Parse the mode definition specifiers. The specifiers are of the form: - ! + ! ! 'mode_name:mode_type:=', ! 'source_num_a:camname_num_a:source_num_c:camname_num_c:num_mr:+', ! 'source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file[:+]'[,] @@ -1421,7 +1422,7 @@ subroutine parse_mode_defs(nl_in, modes) ! associated field for the prop_file. There can only be one entry ! with the num_mr type in a mode definition. ! prop_file -- For aerosol species this is a filename, which is - ! identified by a ".nc" suffix. The file contains optical and + ! identified by a ".nc" suffix. The file contains optical and ! other physical properties of the aerosol. ! ! A mode definition must contain only 1 string for the number mixing ratio components @@ -1447,7 +1448,7 @@ subroutine parse_mode_defs(nl_in, modes) character(len=32) :: tmp_name_c character(len=32) :: tmp_type !------------------------------------------------------------------------- - + ! Determine number of modes defined by counting number of strings that are ! terminated by ':=' ! (algorithm stops counting at first blank element). @@ -1457,7 +1458,7 @@ subroutine parse_mode_defs(nl_in, modes) if (len_trim(nl_in(m)) == 0) exit nstr = nstr + 1 - + ! There are no fields in the input strings in which a blank character is allowed. ! To simplify the parsing go through the input strings and remove blanks. tmpstr = adjustl(nl_in(m)) @@ -1488,7 +1489,7 @@ subroutine parse_mode_defs(nl_in, modes) write(iulog,*) routine//': ERROR: cannot allocate storage for modes. nmodes=', nmodes call endrun(routine//': ERROR allocating storage for modes') end if - + mcur = 1 ! index of current string being processed @@ -1511,7 +1512,7 @@ subroutine parse_mode_defs(nl_in, modes) nspec = nspec + 1 mcur = mcur + 1 end do - + ! a mode must have at least one specie if (nspec == 0) call parse_error('mode must have at least one specie', nl_in(mbeg)) @@ -1548,7 +1549,7 @@ subroutine parse_mode_defs(nl_in, modes) ! return to first string in mode definition mcur = mbeg tmpstr = nl_in(mcur) - + ! mode name ipos = index(tmpstr, ':') if (ipos < 2) call parse_error('mode name not found', tmpstr) @@ -1692,7 +1693,7 @@ subroutine check_specie_type(str, ib, ie) character(len=*), intent(in) :: str integer, intent(in) :: ib, ie - + integer :: i do i = 1, num_spec_types @@ -1709,7 +1710,7 @@ subroutine check_mode_type(str, ib, ie) character(len=*), intent(in) :: str integer, intent(in) :: ib, ie ! begin, end character of mode type substring - + integer :: i do i = 1, num_mode_types @@ -1738,7 +1739,7 @@ subroutine parse_rad_specifier(specifier, namelist_data) ! radname -- For gases this is a name that identifies the constituent to the ! radiative transfer codes. These names are contained in the ! radconstants module. For aerosols this is a filename, which is -! identified by a ".nc" suffix. The file contains optical and +! identified by a ".nc" suffix. The file contains optical and ! other physical properties of the aerosol. ! ! This code also identifies whether the constituent is a gas or an aerosol @@ -1758,11 +1759,11 @@ subroutine parse_rad_specifier(specifier, namelist_data) character(len=cs1) :: radname(n_rad_cnst) character(len=1) :: type(n_rad_cnst) !------------------------------------------------------------------------- - + number = 0 parse_loop: do i = 1, n_rad_cnst - if ( len_trim(specifier(i)) == 0 ) then + if ( len_trim(specifier(i)) == 0 ) then exit parse_loop endif @@ -1783,12 +1784,12 @@ subroutine parse_rad_specifier(specifier, namelist_data) ! locate the ':' separating camname from radname j = scan(tmpstr, ':') - + camname(i) = tmpstr(:j-1) radname(i) = tmpstr(j+1:) ! determine the type of constituent - if (source(i) == 'M') then + if (source(i) == 'M') then type(i) = 'M' else if(index(radname(i),".nc") .gt. 0) then type(i) = 'A' @@ -1796,7 +1797,7 @@ subroutine parse_rad_specifier(specifier, namelist_data) type(i) = 'G' end if - number = number+1 + number = number+1 end do parse_loop namelist_data%ncnst = number @@ -1875,7 +1876,7 @@ end subroutine rad_cnst_get_aer_mmr_by_idx subroutine rad_cnst_get_mam_mmr_by_idx(list_idx, mode_idx, spec_idx, phase, state, pbuf, mmr) ! Return pointer to mass mixing ratio for the modal aerosol specie from the specified - ! climate or diagnostic list. + ! climate or diagnostic list. ! Arguments integer, intent(in) :: list_idx ! index of the climate or a diagnostic list @@ -1949,7 +1950,7 @@ subroutine rad_cnst_get_mam_mmr_idx(mode_idx, spec_idx, idx) ! Return constituent index of mam specie mass mixing ratio for aerosol modes in ! the climate list. - ! This is a special routine to allow direct access to information in the + ! This is a special routine to allow direct access to information in the ! constituent array inside physics parameterizations that have been passed, ! and are operating over the entire constituent array. The interstitial phase ! is assumed since that's what is contained in the constituent array. @@ -1993,7 +1994,7 @@ end subroutine rad_cnst_get_mam_mmr_idx subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, state, pbuf, num) ! Return pointer to number mixing ratio for the aerosol mode from the specified - ! climate or diagnostic list. + ! climate or diagnostic list. ! Arguments integer, intent(in) :: list_idx ! index of the climate or a diagnostic list @@ -2060,7 +2061,7 @@ subroutine rad_cnst_get_mode_num_idx(mode_idx, cnst_idx) ! Return constituent index of mode number mixing ratio for the aerosol mode in ! the climate list. - ! This is a special routine to allow direct access to information in the + ! This is a special routine to allow direct access to information in the ! constituent array inside physics parameterizations that have been passed, ! and are operating over the entire constituent array. The interstitial phase ! is assumed since that's what is contained in the constituent array. @@ -2115,7 +2116,7 @@ integer function rad_cnst_get_aer_idx(list_idx, aer_name) type(aerlist_t), pointer :: aerlist character(len=*), parameter :: subname = "rad_cnst_get_aer_idx" !------------------------------------------------------------------------- - + if (list_idx >= 0 .and. list_idx <= N_DIAG) then aerlist => aerosollist(list_idx) else @@ -2133,7 +2134,7 @@ integer function rad_cnst_get_aer_idx(list_idx, aer_name) end do if (aer_idx == -1) call endrun(subname//": ERROR - name not found") - + rad_cnst_get_aer_idx = aer_idx end function rad_cnst_get_aer_idx @@ -2159,30 +2160,30 @@ subroutine rad_cnst_get_aer_props_by_idx(list_idx, & integer, intent(in) :: list_idx ! index of the climate or a diagnostic list integer, intent(in) :: aer_idx ! index of the aerosol character(len=ot_length), optional, intent(out) :: opticstype - real(r8), optional, pointer :: sw_hygro_ext(:,:) - real(r8), optional, pointer :: sw_hygro_ssa(:,:) - real(r8), optional, pointer :: sw_hygro_asm(:,:) - real(r8), optional, pointer :: lw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_ext(:,:) real(r8), optional, pointer :: sw_nonhygro_ext(:) real(r8), optional, pointer :: sw_nonhygro_ssa(:) real(r8), optional, pointer :: sw_nonhygro_asm(:) real(r8), optional, pointer :: sw_nonhygro_scat(:) real(r8), optional, pointer :: sw_nonhygro_ascat(:) - real(r8), optional, pointer :: lw_ext(:) + real(r8), optional, pointer :: lw_ext(:) complex(r8), optional, pointer :: refindex_aer_sw(:) complex(r8), optional, pointer :: refindex_aer_lw(:) - character(len=20), optional, intent(out) :: aername + character(len=20), optional, intent(out) :: aername real(r8), optional, intent(out) :: density_aer real(r8), optional, intent(out) :: hygro_aer - real(r8), optional, intent(out) :: dryrad_aer - real(r8), optional, intent(out) :: dispersion_aer - real(r8), optional, intent(out) :: num_to_mass_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer - real(r8), optional, pointer :: r_sw_ext(:,:) - real(r8), optional, pointer :: r_sw_scat(:,:) - real(r8), optional, pointer :: r_sw_ascat(:,:) - real(r8), optional, pointer :: r_lw_abs(:,:) - real(r8), optional, pointer :: mu(:) + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) ! Local variables integer :: id @@ -2258,31 +2259,31 @@ subroutine rad_cnst_get_mam_props_by_idx(list_idx, & integer, intent(in) :: mode_idx ! mode index integer, intent(in) :: spec_idx ! index of specie in the mode character(len=ot_length), optional, intent(out) :: opticstype - real(r8), optional, pointer :: sw_hygro_ext(:,:) - real(r8), optional, pointer :: sw_hygro_ssa(:,:) - real(r8), optional, pointer :: sw_hygro_asm(:,:) - real(r8), optional, pointer :: lw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ext(:,:) + real(r8), optional, pointer :: sw_hygro_ssa(:,:) + real(r8), optional, pointer :: sw_hygro_asm(:,:) + real(r8), optional, pointer :: lw_hygro_ext(:,:) real(r8), optional, pointer :: sw_nonhygro_ext(:) real(r8), optional, pointer :: sw_nonhygro_ssa(:) real(r8), optional, pointer :: sw_nonhygro_asm(:) real(r8), optional, pointer :: sw_nonhygro_scat(:) real(r8), optional, pointer :: sw_nonhygro_ascat(:) - real(r8), optional, pointer :: lw_ext(:) + real(r8), optional, pointer :: lw_ext(:) complex(r8), optional, pointer :: refindex_aer_sw(:) complex(r8), optional, pointer :: refindex_aer_lw(:) - real(r8), optional, pointer :: r_sw_ext(:,:) - real(r8), optional, pointer :: r_sw_scat(:,:) - real(r8), optional, pointer :: r_sw_ascat(:,:) - real(r8), optional, pointer :: r_lw_abs(:,:) - real(r8), optional, pointer :: mu(:) + real(r8), optional, pointer :: r_sw_ext(:,:) + real(r8), optional, pointer :: r_sw_scat(:,:) + real(r8), optional, pointer :: r_sw_ascat(:,:) + real(r8), optional, pointer :: r_lw_abs(:,:) + real(r8), optional, pointer :: mu(:) - character(len=20), optional, intent(out) :: aername + character(len=20), optional, intent(out) :: aername real(r8), optional, intent(out) :: density_aer real(r8), optional, intent(out) :: hygro_aer - real(r8), optional, intent(out) :: dryrad_aer - real(r8), optional, intent(out) :: dispersion_aer - real(r8), optional, intent(out) :: num_to_mass_aer + real(r8), optional, intent(out) :: dryrad_aer + real(r8), optional, intent(out) :: dispersion_aer + real(r8), optional, intent(out) :: num_to_mass_aer character(len=32), optional, intent(out) :: spectype ! Local variables @@ -2351,7 +2352,7 @@ end subroutine rad_cnst_get_mam_props_by_idx !================================================================================================ -subroutine rad_cnst_get_mode_props(list_idx, mode_idx, & +subroutine rad_cnst_get_mode_props(list_idx, mode_idx, opticstype, & extpsw, abspsw, asmpsw, absplw, refrtabsw, & refitabsw, refrtablw, refitablw, ncoef, prefr, & prefi, sigmag, dgnum, dgnumlo, dgnumhi, & @@ -2365,7 +2366,7 @@ subroutine rad_cnst_get_mode_props(list_idx, mode_idx, & ! Arguments integer, intent(in) :: list_idx ! index of the climate or a diagnostic list integer, intent(in) :: mode_idx ! mode index - + character(len=ot_length), optional, intent(out) :: opticstype real(r8), optional, pointer :: extpsw(:,:,:,:) real(r8), optional, pointer :: abspsw(:,:,:,:) real(r8), optional, pointer :: asmpsw(:,:,:,:) @@ -2406,6 +2407,7 @@ subroutine rad_cnst_get_mode_props(list_idx, mode_idx, & ! Get the physprop index for the requested mode id = mlist%idx_props(mode_idx) + if (present(opticstype)) call physprop_get(id, opticstype=opticstype) if (present(extpsw)) call physprop_get(id, extpsw=extpsw) if (present(abspsw)) call physprop_get(id, abspsw=abspsw) if (present(asmpsw)) call physprop_get(id, asmpsw=asmpsw) diff --git a/src/physics/cam/radheat.F90 b/src/physics/cam/radheat.F90 index dabf94accf..37f8127931 100644 --- a/src/physics/cam/radheat.F90 +++ b/src/physics/cam/radheat.F90 @@ -7,7 +7,7 @@ module radheat ! ! This module provides a hook to allow incorporating additional ! radiative terms (eUV heating and nonLTE longwave cooling). -! +! ! Original version: B.A. Boville !----------------------------------------------------------------------- @@ -24,6 +24,7 @@ module radheat ! Public interfaces public & radheat_readnl, &! + radheat_register, &! radheat_init, &! radheat_timestep_init, &! radheat_tend ! return net radiative heating @@ -42,6 +43,14 @@ subroutine radheat_readnl(nlfile) end subroutine radheat_readnl +!================================================================================================ + + subroutine radheat_register + + ! No options for this version of radheat; this is just a stub. + + end subroutine radheat_register + !================================================================================================ subroutine radheat_init(pref_mid) @@ -51,7 +60,6 @@ subroutine radheat_init(pref_mid) real(r8), intent(in) :: pref_mid(plev) - end subroutine radheat_init !================================================================================================ @@ -61,7 +69,7 @@ subroutine radheat_timestep_init (state, pbuf2d) use ppgrid, only : begchunk, endchunk use physics_buffer, only : physics_buffer_desc - type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_state), intent(in):: state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -81,7 +89,7 @@ subroutine radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, & ! Arguments type(physics_state), intent(in) :: state ! Physics state variables - + type(physics_buffer_desc), pointer :: pbuf(:) type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencie real(r8), intent(in) :: qrl(pcols,pver) ! longwave heating @@ -91,7 +99,7 @@ subroutine radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, & real(r8), intent(in) :: flns(pcols) ! Srf longwave cooling (up-down) flux real(r8), intent(in) :: flnt(pcols) ! Net outgoing lw flux at model top real(r8), intent(in) :: asdir(pcols) ! shortwave, direct albedo - real(r8), intent(out) :: net_flx(pcols) + real(r8), intent(out) :: net_flx(pcols) ! Local variables @@ -109,7 +117,7 @@ subroutine radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, & if (met_rlx(k) < 1._r8 .or. met_srf_feedback) then ptend%s(:ncol,k) = (qrs(:ncol,k) + qrl(:ncol,k)) endif - enddo + enddo #else ptend%s(:ncol,:) = (qrs(:ncol,:) + qrl(:ncol,:)) #endif diff --git a/src/physics/cam/radiation_data.F90 b/src/physics/cam/radiation_data.F90 index 517b967f10..66337e7060 100644 --- a/src/physics/cam/radiation_data.F90 +++ b/src/physics/cam/radiation_data.F90 @@ -740,7 +740,7 @@ subroutine rad_data_read(indata, phys_state, pbuf2d, cam_in, recno ) use camsrfexch, only: cam_in_t use physics_buffer, only: pbuf_get_field, pbuf_old_tim_idx use constituents, only: cnst_get_ind - use tropopause, only: tropopause_find, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE + use tropopause, only: tropopause_find_cam, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE implicit none @@ -984,7 +984,11 @@ subroutine rad_data_read(indata, phys_state, pbuf2d, cam_in, recno ) call pbuf_get_field(pbuf, qrsin_idx, qrsin) call pbuf_get_field(pbuf, qrlin_idx, qrlin) - call tropopause_find(phys_state(c), troplev, tropP=tropp(:), primary=TROP_ALG_CLIMATE, & + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + troplev(:) = 0 + tropp(:) = 0._r8 + !REMOVECAM_END + call tropopause_find_cam(phys_state(c), troplev, tropP=tropp, primary=TROP_ALG_CLIMATE, & backup=TROP_ALG_CLIMATE) qrsin(:,:) = qrs_ptrs(c)%array(:,:) diff --git a/src/physics/cam/ref_pres.F90 b/src/physics/cam/ref_pres.F90 index 742652db11..1630072d3e 100644 --- a/src/physics/cam/ref_pres.F90 +++ b/src/physics/cam/ref_pres.F90 @@ -1,18 +1,21 @@ module ref_pres !-------------------------------------------------------------------------- -! +! ! Provides access to reference pressures for use by the physics ! parameterizations. The pressures are provided by the dynamical core ! since it determines the grid used by the physics. -! +! ! Note that the init method for this module is called before the init ! method in physpkg; therefore, most physics modules can use these ! reference pressures during their init phases. -! +! !-------------------------------------------------------------------------- -use shr_kind_mod, only: r8=>shr_kind_r8 -use ppgrid, only: pver, pverp +use shr_kind_mod, only: r8=>shr_kind_r8 +use ppgrid, only: pver, pverp +use cam_history_support, only: add_vert_coord +use cam_logfile, only: iulog +use error_messages, only: alloc_err implicit none public @@ -25,7 +28,7 @@ module ref_pres ! surface pressure ('eta' coordinate) real(r8), protected :: ptop_ref ! Top of model -real(r8), protected :: psurf_ref ! Surface pressure +real(r8), protected :: psurf_ref ! reference pressure ! Number of top levels using pure pressure representation integer, protected :: num_pr_lev @@ -49,6 +52,11 @@ module ref_pres logical, protected :: do_molec_diff = .false. integer, protected :: nbot_molec = 0 +! Data for the trop_pref coordinate. It is the target of a pointer in a hist_coord_t +! object in the cam_history_support module. It is associated by the call to add_vert_coord. +real(r8), private, allocatable, target :: trop_pref(:) +real(r8), private, allocatable, target :: trop_prefi(:) + !==================================================================================== contains !==================================================================================== @@ -111,6 +119,11 @@ subroutine ref_pres_init(pref_edge_in, pref_mid_in, num_pr_lev_in) real(r8), intent(in) :: pref_edge_in(:) ! reference pressure at layer edges (Pa) real(r8), intent(in) :: pref_mid_in(:) ! reference pressure at layer midpoints (Pa) integer, intent(in) :: num_pr_lev_in ! number of top levels using pure pressure representation + + ! local variables + integer :: nlev + integer :: istat + character(len=*), parameter :: sub = 'ref_pres_init' !--------------------------------------------------------------------------- pref_edge = pref_edge_in @@ -137,6 +150,24 @@ subroutine ref_pres_init(pref_edge_in, pref_mid_in, num_pr_lev_in) top=.false.) end if + ! Add vertical coordinates to history file for use with outputs that are only + ! computed in the subdomain bounded by the top of troposphere clouds. + nlev = pver - trop_cloud_top_lev + 1 + + allocate(trop_pref(nlev), stat=istat) + call alloc_err(istat, sub, 'trop_pref', nlev) + trop_pref = pref_mid(trop_cloud_top_lev:)*0.01_r8 ! convert Pa to hPa + + call add_vert_coord('trop_pref', nlev, 'troposphere reference pressures', & + 'hPa', trop_pref, positive='down') + + allocate(trop_prefi(nlev+1), stat=istat) + call alloc_err(istat, sub, 'trop_prefi', nlev+1) + trop_prefi = pref_edge(trop_cloud_top_lev:)*0.01_r8 ! convert Pa to hPa + + call add_vert_coord('trop_prefi', nlev+1, 'troposphere reference pressures (interfaces)', & + 'hPa', trop_prefi, positive='down') + end subroutine ref_pres_init !==================================================================================== diff --git a/src/physics/cam/restart_physics.F90 b/src/physics/cam/restart_physics.F90 index 9cf0a194f9..2793e26b6e 100644 --- a/src/physics/cam/restart_physics.F90 +++ b/src/physics/cam/restart_physics.F90 @@ -48,7 +48,7 @@ module restart_physics CONTAINS subroutine init_restart_physics ( File, pbuf2d) - + use physics_buffer, only: pbuf_init_restart, physics_buffer_desc use ppgrid, only: pver, pverp use chemistry, only: chem_init_restart @@ -127,7 +127,7 @@ subroutine init_restart_physics ( File, pbuf2d) ierr = pio_def_var(File, 'wsx', pio_double, hdimids, wsx_desc) ierr = pio_def_var(File, 'wsy', pio_double, hdimids, wsy_desc) ierr = pio_def_var(File, 'shf', pio_double, hdimids, shf_desc) - + call radiation_define_restart(file) if (is_subcol_on()) then @@ -141,7 +141,7 @@ subroutine write_restart_physics (File, cam_in, cam_out, pbuf2d) !----------------------------------------------------------------------- use physics_buffer, only: physics_buffer_desc, pbuf_write_restart use phys_grid, only: phys_decomp - + use ppgrid, only: begchunk, endchunk, pcols, pverp use chemistry, only: chem_write_restart use prescribed_ozone, only: write_prescribed_ozone_restart @@ -329,7 +329,7 @@ subroutine write_restart_physics (File, cam_in, cam_out, pbuf2d) call pio_write_darray(File, shf_desc, iodesc, tmpfield, ierr) call radiation_write_restart(file) - + end subroutine write_restart_physics !####################################################################### @@ -338,7 +338,7 @@ subroutine read_restart_physics(File, cam_in, cam_out, pbuf2d) !----------------------------------------------------------------------- use physics_buffer, only: physics_buffer_desc, pbuf_read_restart - + use ppgrid, only: begchunk, endchunk, pcols, pver, pverp use chemistry, only: chem_read_restart use cam_grid_support, only: cam_grid_read_dist_array, cam_grid_id @@ -396,7 +396,7 @@ subroutine read_restart_physics(File, cam_in, cam_out, pbuf2d) end if call cam_grid_get_decomp(physgrid, dims(1:2), gdims(1:nhdims), pio_double, & iodesc) - + ! data for chemistry call chem_read_restart(File) diff --git a/src/physics/cam/rk_stratiform.F90 b/src/physics/cam/rk_stratiform.F90 index a951edd3fa..148ea3fd28 100644 --- a/src/physics/cam/rk_stratiform.F90 +++ b/src/physics/cam/rk_stratiform.F90 @@ -2,8 +2,8 @@ module rk_stratiform !------------------------------------------------------------------------------------------------------- ! -! Provides the CAM interface to the Rasch and Kristjansson (RK) -! prognostic cloud microphysics, and the cam3/4 macrophysics. +! Provides the CAM interface to the Rasch and Kristjansson (RK) +! prognostic cloud microphysics, and the cam4 macrophysics. ! !------------------------------------------------------------------------------------------------------- @@ -27,26 +27,26 @@ module rk_stratiform public :: rk_stratiform_tend public :: rk_stratiform_readnl -! Physics buffer indices +! Physics buffer indices integer :: landm_idx = 0 -integer :: qcwat_idx = 0 -integer :: lcwat_idx = 0 -integer :: tcwat_idx = 0 +integer :: qcwat_idx = 0 +integer :: lcwat_idx = 0 +integer :: tcwat_idx = 0 -integer :: cld_idx = 0 -integer :: ast_idx = 0 -integer :: concld_idx = 0 -integer :: fice_idx = 0 +integer :: cld_idx = 0 +integer :: ast_idx = 0 +integer :: concld_idx = 0 +integer :: fice_idx = 0 -integer :: qme_idx = 0 -integer :: prain_idx = 0 -integer :: nevapr_idx = 0 +integer :: qme_idx = 0 +integer :: prain_idx = 0 +integer :: nevapr_idx = 0 integer :: wsedl_idx = 0 -integer :: rei_idx = 0 -integer :: rel_idx = 0 +integer :: rei_idx = 0 +integer :: rel_idx = 0 integer :: shfrc_idx = 0 integer :: cmfmc_sh_idx = 0 @@ -92,8 +92,8 @@ subroutine rk_stratiform_readnl(nlfile) character(len=*), parameter :: subname = 'rk_stratiform_readnl' ! Namelist variables - real(r8) :: rk_strat_icritw = unset_r8 ! icritw = threshold for autoconversion of warm ice - real(r8) :: rk_strat_icritc = unset_r8 ! icritc = threshold for autoconversion of cold ice + real(r8) :: rk_strat_icritw = unset_r8 ! icritw = threshold for autoconversion of warm ice + real(r8) :: rk_strat_icritc = unset_r8 ! icritc = threshold for autoconversion of cold ice real(r8) :: rk_strat_conke = unset_r8 ! conke = tunable constant for evaporation of precip real(r8) :: rk_strat_r3lcrit = unset_r8 ! r3lcrit = critical radius where liq conversion begins real(r8) :: rk_strat_polstrat_rhmin = unset_r8 ! condensation threadhold in polar stratosphere @@ -144,7 +144,7 @@ subroutine rk_stratiform_register use constituents, only: cnst_add, pcnst use physconst, only: mwh2o, cpair - + use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls !----------------------------------------------------------------------- @@ -166,7 +166,7 @@ subroutine rk_stratiform_register call pbuf_add_field('AST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx) call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx) - call pbuf_add_field('FICE', 'physpkg', dtype_r8, (/pcols,pver/), fice_idx) + call pbuf_add_field('FICE', 'physpkg', dtype_r8, (/pcols,pver/), fice_idx) call pbuf_add_field('QME', 'physpkg', dtype_r8, (/pcols,pver/), qme_idx) call pbuf_add_field('PRAIN', 'physpkg', dtype_r8, (/pcols,pver/), prain_idx) @@ -186,8 +186,8 @@ end subroutine rk_stratiform_register function rk_stratiform_implements_cnst(name) - !----------------------------------------------------------------------------- ! - ! ! + !----------------------------------------------------------------------------- ! + ! ! ! Return true if specified constituent is implemented by this package ! ! ! !----------------------------------------------------------------------------- ! @@ -208,7 +208,7 @@ subroutine rk_stratiform_init_cnst(name, latvals, lonvals, mask, q) !----------------------------------------------------------------------- ! ! ! ! Initialize the cloud water mixing ratios (liquid and ice), if they are ! - ! not read from the initial file ! + ! not read from the initial file ! ! ! !----------------------------------------------------------------------- ! @@ -237,7 +237,7 @@ subroutine rk_stratiform_init() !-------------------------------------------- ! ! ! ! Initialize the cloud water parameterization ! - ! ! + ! ! !-------------------------------------------- ! use physics_buffer, only: physics_buffer_desc, pbuf_get_index @@ -247,7 +247,7 @@ subroutine rk_stratiform_init() use phys_control, only: cam_physpkg_is use physconst, only: tmelt, rhodair, rh2o use cldwat, only: inimc - + integer :: m, mm logical :: history_amwg ! output the variables used by the AMWG diag package logical :: history_aerosol ! Output the MAM aerosol tendencies @@ -258,7 +258,7 @@ subroutine rk_stratiform_init() !----------------------------------------------------------------------- call phys_getopts( history_aerosol_out = history_aerosol , & - history_amwg_out = history_amwg , & + history_amwg_out = history_amwg , & history_budget_out = history_budget , & history_budget_histfile_num_out = history_budget_histfile_num) @@ -268,7 +268,7 @@ subroutine rk_stratiform_init() if( convect_shallow_use_shfrc() ) then use_shfrc = .true. shfrc_idx = pbuf_get_index('shfrc') - else + else use_shfrc = .false. endif @@ -326,7 +326,7 @@ subroutine rk_stratiform_init() 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 ('PCSNOW', horiz_only , 'A', 'm/s' , 'Snow fall from prognostic clouds' ) - + call addfld ('DQSED', (/ 'lev' /), 'A', 'kg/kg/s' , 'Water vapor tendency from cloud sedimentation' ) call addfld ('DLSED', (/ 'lev' /), 'A', 'kg/kg/s' , 'Cloud liquid tendency from sedimentation' ) call addfld ('DISED', (/ 'lev' /), 'A', 'kg/kg/s' , 'Cloud ice tendency from sedimentation' ) @@ -339,7 +339,7 @@ subroutine rk_stratiform_init() call addfld ('CNVCLD', horiz_only, 'A', 'fraction', 'Vertically integrated convective cloud amount' ) call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction' ) call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover' ) - + call addfld ('AST', (/ 'lev' /), 'A','fraction' , 'Stratus cloud fraction' ) call addfld ('LIQCLDF', (/ 'lev' /), 'A', 'fraction', 'Stratus Liquid cloud fraction' ) call addfld ('ICECLDF', (/ 'lev' /), 'A', 'fraction', 'Stratus ICE cloud fraction' ) @@ -356,7 +356,7 @@ subroutine rk_stratiform_init() call add_default ('EVAPPREC ', history_budget_histfile_num, ' ') call add_default ('CMELIQ ', history_budget_histfile_num, ' ') - if( cam_physpkg_is('cam3') .or. cam_physpkg_is('cam4') ) then + if( cam_physpkg_is('cam4') ) then call add_default ('ZMDLF ', history_budget_histfile_num, ' ') call add_default ('CME ', history_budget_histfile_num, ' ') @@ -420,14 +420,15 @@ subroutine rk_stratiform_tend( & dlf2, rliq, cmfmc, ts, & sst, zdu) - !-------------------------------------------------------- ! - ! ! + !-------------------------------------------------------- ! + ! ! ! Interface to sedimentation, detrain, cloud fraction and ! ! cloud macro - microphysics subroutines ! - ! ! + ! ! !-------------------------------------------------------- ! - use cloud_fraction, only: cldfrc, cldfrc_fice + use cloud_fraction, only: cldfrc + use cloud_fraction_fice, only: cloud_fraction_fice_run use physics_types, only: physics_state, physics_ptend use physics_types, only: physics_ptend_init, physics_update use physics_types, only: physics_ptend_sum, physics_state_copy @@ -438,9 +439,9 @@ subroutine rk_stratiform_tend( & use cldwat, only: pcond use pkg_cldoptics, only: cldefr use phys_control, only: cam_physpkg_is - use tropopause, only: tropopause_find, TROP_ALG_TWMO, TROP_ALG_CLIMATE + use tropopause, only: tropopause_find_cam use phys_grid, only: get_rlat_all_p - use physconst, only: pi + use physconst, only: pi, tmelt ! Arguments type(physics_state), intent(in) :: state ! State variables @@ -475,7 +476,7 @@ subroutine rk_stratiform_tend( & ! Physics buffer fields real(r8), pointer :: landm(:) ! Land fraction ramped over water - real(r8), pointer :: prec_str(:) ! [Total] Sfc flux of precip from stratiform [ m/s ] + real(r8), pointer :: prec_str(:) ! [Total] Sfc flux of precip from stratiform [ m/s ] real(r8), pointer :: snow_str(:) ! [Total] Sfc flux of snow from stratiform [ m/s ] real(r8), pointer :: prec_sed(:) ! Surface flux of total cloud water from sedimentation real(r8), pointer :: snow_sed(:) ! Surface flux of cloud ice from sedimentation @@ -517,12 +518,12 @@ subroutine rk_stratiform_tend( & real(r8) :: clc(pcols) ! Column convective cloud amount real(r8) :: relhum(pcols,pver) ! RH, output to determine drh/da real(r8) :: rhu00(pcols,pver) - real(r8) :: rhu002(pcols,pver) ! Same as rhu00 but for perturbed rh + real(r8) :: rhu002(pcols,pver) ! Same as rhu00 but for perturbed rh real(r8) :: rhdfda(pcols,pver) real(r8) :: cld2(pcols,pver) ! Same as cld but for perturbed rh - real(r8) :: concld2(pcols,pver) ! Same as concld but for perturbed rh - real(r8) :: cldst2(pcols,pver) ! Same as cldst but for perturbed rh - real(r8) :: relhum2(pcols,pver) ! RH after perturbation + real(r8) :: concld2(pcols,pver) ! Same as concld but for perturbed rh + real(r8) :: cldst2(pcols,pver) ! Same as cldst but for perturbed rh + real(r8) :: relhum2(pcols,pver) ! RH after perturbation real(r8) :: icecldf(pcols,pver) ! Ice cloud fraction real(r8) :: liqcldf(pcols,pver) ! Liquid cloud fraction (combined into cloud) real(r8) :: icecldf_out(pcols,pver) ! Ice cloud fraction @@ -547,11 +548,11 @@ subroutine rk_stratiform_tend( & real(r8) :: repartht(pcols,pver) ! Heating rate due to phase repartition of input precip real(r8) :: icimr(pcols,pver) ! In cloud ice mixing ratio real(r8) :: icwmr(pcols,pver) ! In cloud water mixing ratio - real(r8) :: fwaut(pcols,pver) - real(r8) :: fsaut(pcols,pver) - real(r8) :: fracw(pcols,pver) - real(r8) :: fsacw(pcols,pver) - real(r8) :: fsaci(pcols,pver) + real(r8) :: fwaut(pcols,pver) + real(r8) :: fsaut(pcols,pver) + real(r8) :: fracw(pcols,pver) + real(r8) :: fsacw(pcols,pver) + real(r8) :: fsaci(pcols,pver) real(r8) :: cmeice(pcols,pver) ! Rate of cond-evap of ice within the cloud real(r8) :: cmeliq(pcols,pver) ! Rate of cond-evap of liq within the cloud real(r8) :: ice2pr(pcols,pver) ! Rate of conversion of ice to precip @@ -569,14 +570,17 @@ subroutine rk_stratiform_tend( & real(r8) :: psacio(pcols,pver) ! RK accretion of cloud ice by snow (1/s) real(r8) :: iwc(pcols,pver) ! Grid box average ice water content - real(r8) :: lwc(pcols,pver) ! Grid box average liquid water content - + real(r8) :: lwc(pcols,pver) ! Grid box average liquid water content + logical :: lq(pcnst) integer :: troplev(pcols) real(r8) :: rlat(pcols) real(r8) :: dlat(pcols) real(r8), parameter :: rad2deg = 180._r8/pi + integer :: top_lev + + ! ====================================================================== lchnk = state%lchnk @@ -598,7 +602,7 @@ subroutine rk_stratiform_tend( & call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, fice_idx, fice) - + call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh) call pbuf_get_field(pbuf, prec_str_idx, prec_str) @@ -616,7 +620,7 @@ subroutine rk_stratiform_tend( & call pbuf_get_field(pbuf, rei_idx, rei) call pbuf_get_field(pbuf, wsedl_idx, wsedl) - + ! check that qcwat and tcwat were initialized; if not then do it now. if (qcwat(1,1) == huge(1._r8)) then qcwat(:ncol,:) = state%q(:ncol,:,1) @@ -626,9 +630,12 @@ subroutine rk_stratiform_tend( & end if if ( do_psrhmin ) then - call tropopause_find(state, troplev, primary=TROP_ALG_TWMO, backup=TROP_ALG_CLIMATE) + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + troplev(:) = 0 + !REMOVECAM_END + call tropopause_find_cam(state, troplev) call get_rlat_all_p(lchnk,ncol,rlat) - dlat = rlat*rad2deg + dlat(:ncol) = rlat(:ncol)*rad2deg endif ! ------------- ! @@ -636,16 +643,16 @@ subroutine rk_stratiform_tend( & ! ------------- ! ! Allow the cloud liquid drops and ice particles to sediment. - ! This is done before adding convectively detrained cloud water, + ! This is done before adding convectively detrained cloud water, ! because the phase of the detrained water is unknown. call t_startf('stratiform_sediment') call cld_sediment_vel( ncol, & icefrac, landfrac, ocnfrac, state1%pmid, state1%pdel, state1%t, & - cld, state1%q(:,:,ixcldliq), state1%q(:,:,ixcldice), & + cld, state1%q(:,:,ixcldliq), state1%q(:,:,ixcldice), & pvliq, pvice, landm, snowh ) - + wsedl(:ncol,:pver) = pvliq(:ncol,:pver)/gravit/(state1%pmid(:ncol,:pver)/(287.15_r8*state1%t(:ncol,:pver))) lq(:) = .FALSE. @@ -680,7 +687,7 @@ subroutine rk_stratiform_tend( & call physics_ptend_init(ptend_all, state%psetcols, 'stratiform') call physics_ptend_sum( ptend_loc, ptend_all, ncol ) - ! Update physics state type state1 with ptend_loc + ! Update physics state type state1 with ptend_loc call physics_update( state1, ptend_loc, dtime ) call t_stopf('stratiform_sediment') @@ -695,13 +702,13 @@ subroutine rk_stratiform_tend( & ! Put all of the detraining cloud water from convection into the large scale cloud. ! It all goes in liquid for the moment. - ! Strictly speaking, this approach is detraining all the cconvective water into + ! Strictly speaking, this approach is detraining all the cconvective water into ! the environment, not the large-scale cloud. lq(:) = .FALSE. lq(ixcldliq) = .TRUE. call physics_ptend_init( ptend_loc, state1%psetcols, 'pcwdetrain', lq=lq) - + do k = 1, pver do i = 1, state1%ncol ptend_loc%q(i,k,ixcldliq) = dlf(i,k) @@ -725,7 +732,7 @@ subroutine rk_stratiform_tend( & ! -------------------------------------- ! ! ----------------------------------------------------------------------------- ! - ! Treatment of cloud fraction in CAM4 and CAM5 differs ! + ! Treatment of cloud fraction in CAM4 and CAM5 differs ! ! (1) CAM4 ! ! . Cumulus AMT = Deep Cumulus AMT ( empirical fcn of mass flux ) + ! ! Shallow Cumulus AMT ( empirical fcn of mass flux ) ! @@ -738,7 +745,7 @@ subroutine rk_stratiform_tend( & ! . Stratus AMT = fcn of environmental-mean RH ( no Stability Stratus ) ! ! . Cumulus and Stratus are non-overlapped with higher priority on Cumulus ! ! . Cumulus ( both Deep and Shallow ) has its own LWC and IWC. ! - ! ----------------------------------------------------------------------------- ! + ! ----------------------------------------------------------------------------- ! if( use_shfrc ) then call pbuf_get_field(pbuf, shfrc_idx, shfrc ) @@ -748,8 +755,8 @@ subroutine rk_stratiform_tend( & endif ! Stratus ('ast' = max(alst,aist)) and total cloud fraction ('cld = ast + concld') - ! will be computed using this updated 'concld' in the stratiform macrophysics - ! scheme (mmacro_pcond) later below. + ! will be computed using this updated 'concld' in the stratiform macrophysics + ! scheme (mmacro_pcond) later below. call t_startf("cldfrc") call cldfrc( lchnk, ncol, pbuf, & @@ -759,7 +766,7 @@ subroutine rk_stratiform_tend( & cmfmc, cmfmc_sh, landfrac,snowh, concld, cldst, & ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu00, & state1%q(:,:,ixcldice), icecldf, liqcldf, & - relhum, 0 ) + relhum, 0 ) ! Re-calculate cloud with perturbed rh add call cldfrc to estimate rhdfda. @@ -770,7 +777,7 @@ subroutine rk_stratiform_tend( & cmfmc, cmfmc_sh, landfrac, snowh, concld2, cldst2, & ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu002, & state1%q(:,:,ixcldice), icecldf2, liqcldf2, & - relhum2, 1 ) + relhum2, 1 ) call t_stopf("cldfrc") @@ -785,7 +792,7 @@ subroutine rk_stratiform_tend( & ! Under certain circumstances, rh+ cause cld not to changed ! when at an upper limit, or w/ strong subsidence if( ( cld2(i,k) - cld(i,k) ) < 1.e-4_r8 ) then - rhdfda(i,k) = 0.01_r8*relhum(i,k)*1.e+4_r8 + rhdfda(i,k) = 0.01_r8*relhum(i,k)*1.e+4_r8 else rhdfda(i,k) = 0.01_r8*relhum(i,k)/(cld2(i,k)-cld(i,k)) endif @@ -802,13 +809,19 @@ subroutine rk_stratiform_tend( & rdtime = 1._r8/dtime ! Define fractional amount of stratus condensate and precipitation in ice phase. - ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ). + ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ). ! The ramp within convective cloud may be different - call cldfrc_fice(ncol, state1%t, fice, fsnow) +!REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + fice(:,:) = 0._r8 + fsnow(:,:) = 0._r8 +!REMOVECAM_END + top_lev = 1 + call cloud_fraction_fice_run(ncol, state1%t(:ncol,:), tmelt, top_lev, pver, fice(:ncol,:), fsnow(:ncol,:)) - ! Perform repartitioning of stratiform condensate. - ! Corresponding heating tendency will be added later. + + ! Perform repartitioning of stratiform condensate. + ! Corresponding heating tendency will be added later. lq(:) = .FALSE. lq(ixcldice) = .true. @@ -830,7 +843,7 @@ subroutine rk_stratiform_tend( & repartht(:ncol,:pver) = (latice/dtime) * ( state1%q(:ncol,:pver,ixcldice) - repartht(:ncol,:pver) ) - ! Non-micro and non-macrophysical external advective forcings to compute net condensation rate. + ! Non-micro and non-macrophysical external advective forcings to compute net condensation rate. ! Note that advective forcing of condensate is aggregated into liquid phase. qtend(:ncol,:pver) = ( state1%q(:ncol,:pver,1) - qcwat(:ncol,:pver) ) * rdtime @@ -869,7 +882,7 @@ subroutine rk_stratiform_tend( & ptend_loc%q(i,k,ixcldliq) = qme(i,k)*(1._r8-fice(i,k)) - liq2pr(i,k) end do end do - + do k = 1, pver do i = 1, ncol ast(i,k) = cld(i,k) @@ -950,25 +963,21 @@ subroutine rk_stratiform_tend( & call physics_ptend_sum( ptend_loc, ptend_all, ncol ) call physics_update( state1, ptend_loc, dtime ) - if (.not. cam_physpkg_is('cam3')) then - - call t_startf("cldfrc") - call cldfrc( lchnk, ncol, pbuf, & - state1%pmid, state1%t, state1%q(:,:,1), state1%omega, state1%phis, & - shfrc, use_shfrc, & - cld, rhcloud, clc, state1%pdel, & - cmfmc, cmfmc_sh, landfrac, snowh, concld, cldst, & - ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu00, & - state1%q(:,:,ixcldice), icecldf, liqcldf, & - relhum, 0 ) - call t_stopf("cldfrc") - - endif + call t_startf("cldfrc") + call cldfrc( lchnk, ncol, pbuf, & + state1%pmid, state1%t, state1%q(:,:,1), state1%omega, state1%phis, & + shfrc, use_shfrc, & + cld, rhcloud, clc, state1%pdel, & + cmfmc, cmfmc_sh, landfrac, snowh, concld, cldst, & + ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu00, & + state1%q(:,:,ixcldice), icecldf, liqcldf, & + relhum, 0 ) + call t_stopf("cldfrc") call outfld( 'CONCLD ', concld, pcols, lchnk ) call outfld( 'CLDST ', cldst, pcols, lchnk ) call outfld( 'CNVCLD ', clc, pcols, lchnk ) - call outfld( 'AST', ast, pcols, lchnk ) + call outfld( 'AST', ast, pcols, lchnk ) do k = 1, pver do i = 1, ncol @@ -1000,7 +1009,7 @@ subroutine rk_stratiform_tend( & tcwat(:ncol,k) = state1%t(:ncol,k) lcwat(:ncol,k) = state1%q(:ncol,k,ixcldice) + state1%q(:ncol,k,ixcldliq) end do - + ! Cloud water and ice particle sizes, saved in physics buffer for radiation call cldefr( lchnk, ncol, landfrac, state1%t, rel, rei, state1%ps, state1%pmid, landm, icefrac, snowh ) @@ -1025,7 +1034,7 @@ subroutine debug_microphys_1(state1,ptend,i,k, & use physconst, only: tmelt implicit none - + integer, intent(in) :: i,k type(physics_state), intent(in) :: state1 ! local copy of the state variable type(physics_ptend), intent(in) :: ptend ! local copy of the ptend variable @@ -1058,11 +1067,11 @@ subroutine debug_microphys_1(state1,ptend,i,k, & wv = 0 wi = 0 wlf = 0 - wvf = 0 + wvf = 0 wif = 0 - write(iulog,*) + write(iulog,*) write(iulog,*) ' input state, t, q, l, i ', k, state1%t(i,k), state1%q(i,k,1), state1%q(i,k,ixcldliq), state1%q(i,k,ixcldice) write(iulog,*) ' rain, snow, total from components before accumulation ', qr1, qs1, qr1+qs1 write(iulog,*) ' total precip before accumulation ', k, pr1 @@ -1143,7 +1152,7 @@ subroutine debug_microphys_1(state1,ptend,i,k, & ! + evapheat(i,k) + prfzheat(i,k) + meltheat(i,k) res = qs1+qr1-pr1 - w4 = max(abs(qs1),abs(qr1),abs(pr1)) + w4 = max(abs(qs1),abs(qr1),abs(pr1)) if (w4.gt.0._r8) then if (res/w4.gt.1.e-14_r8) then write(iulog,*) ' imbalance in precips calculated two ways ' @@ -1173,14 +1182,14 @@ subroutine debug_microphys_2(state1,& use ppgrid, only: pver use physconst, only: tmelt use physics_types, only: physics_state - + implicit none type(physics_state), intent(in) :: state1 ! local copy of the state variable real(r8), intent(in) :: snow_pcw(pcols) - real(r8), intent(in) :: fsaut(pcols,pver) - real(r8), intent(in) :: fsacw(pcols,pver) - real(r8), intent(in) :: fsaci(pcols,pver) + real(r8), intent(in) :: fsaut(pcols,pver) + real(r8), intent(in) :: fsacw(pcols,pver) + real(r8), intent(in) :: fsaci(pcols,pver) real(r8), intent(in) :: meltheat(pcols,pver) ! heating rate due to phase change of precip @@ -1189,7 +1198,7 @@ subroutine debug_microphys_2(state1,& ncol = state1%ncol lchnk = state1%lchnk - + do i = 1,ncol if (snow_pcw(i) .gt. 0.01_r8/8.64e4_r8 .and. state1%t(i,pver) .gt. tmelt) then write(iulog,*) ' stratiform: snow, temp, ', i, lchnk, & @@ -1201,7 +1210,7 @@ subroutine debug_microphys_2(state1,& write(iulog,*) ' meltheat ', meltheat(i,:) call endrun ('STRATIFORM_TEND') endif - + if (snow_pcw(i)*8.64e4_r8 .lt. -1.e-5_r8) then write(iulog,*) ' neg snow ', snow_pcw(i)*8.64e4_r8 write(iulog,*) ' stratiform: snow_pcw, temp, ', i, lchnk, & @@ -1214,7 +1223,7 @@ subroutine debug_microphys_2(state1,& call endrun ('STRATIFORM_TEND') endif end do - + end subroutine debug_microphys_2 end module rk_stratiform diff --git a/src/physics/cam/slingo_liq_optics.F90 b/src/physics/cam/slingo_liq_optics.F90 new file mode 100644 index 0000000000..781a056b29 --- /dev/null +++ b/src/physics/cam/slingo_liq_optics.F90 @@ -0,0 +1,284 @@ +module slingo_liq_optics + +!------------------------------------------------------------------------------------------------ +! Implements Slingo Optics for MG/RRTMG for liquid clouds and +! a copy of the old cloud routine for reference +!------------------------------------------------------------------------------------------------ + +use shr_kind_mod, only: r8 => shr_kind_r8 +use physconst, only: gravit +use ppgrid, only: pcols, pver, pverp +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx +use radconstants, only: nswbands, nlwbands, get_sw_spectral_boundaries +use cam_abortutils, only: endrun + +implicit none +private +save + +public :: & + slingo_rad_props_init, & + slingo_liq_get_rad_props_lw, & + slingo_liq_optics_sw + +! Minimum cloud amount (as a fraction of the grid-box area) to +! distinguish from clear sky +real(r8), parameter :: cldmin = 1.0e-80_r8 + +! Decimal precision of cloud amount (0 -> preserve full resolution; +! 10^-n -> preserve n digits of cloud amount) +real(r8), parameter :: cldeps = 0.0_r8 + +! indexes into pbuf for optical parameters of MG clouds +integer :: iclwp_idx = 0 +integer :: iciwp_idx = 0 +integer :: cld_idx = 0 +integer :: rel_idx = 0 +integer :: rei_idx = 0 + +! indexes into constituents for old optics +integer :: & + ixcldliq, & ! cloud liquid water index + ixcldice ! cloud liquid water index + +!============================================================================== +contains +!============================================================================== + +subroutine slingo_rad_props_init() + +! use cam_history, only: addfld + use netcdf + use spmd_utils, only: masterproc + use ioFileMod, only: getfil + use cam_logfile, only: iulog + use error_messages, only: handle_ncerr +#if ( defined SPMD ) + use mpishorthand +#endif + use constituents, only: cnst_get_ind + + integer :: err + + iciwp_idx = pbuf_get_index('ICIWP',errcode=err) + iclwp_idx = pbuf_get_index('ICLWP',errcode=err) + cld_idx = pbuf_get_index('CLD') + rel_idx = pbuf_get_index('REL') + rei_idx = pbuf_get_index('REI') + + ! old optics + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + +end subroutine slingo_rad_props_init + +!============================================================================== + +subroutine slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp) + + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8),intent(out) :: liq_tau (nswbands,pcols,pver) ! extinction optical depth + real(r8),intent(out) :: liq_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau + real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w + real(r8),intent(out) :: liq_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w + logical, intent(in) :: oldliqwp + + real(r8), pointer, dimension(:,:) :: rel + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: tmpptr + real(r8), dimension(pcols,pver) :: cliqwp + real(r8), dimension(nswbands) :: wavmin + real(r8), dimension(nswbands) :: wavmax + + ! A. Slingo's data for cloud particle radiative properties (from 'A GCM + ! Parameterization for the Shortwave Properties of Water Clouds' JAS + ! vol. 46 may 1989 pp 1419-1427) + real(r8) :: abarl(4) = & ! A coefficient for extinction optical depth + (/ 2.817e-02_r8, 2.682e-02_r8,2.264e-02_r8,1.281e-02_r8/) + real(r8) :: bbarl(4) = & ! B coefficient for extinction optical depth + (/ 1.305_r8 , 1.346_r8 ,1.454_r8 ,1.641_r8 /) + real(r8) :: cbarl(4) = & ! C coefficient for single scat albedo + (/-5.62e-08_r8 ,-6.94e-06_r8 ,4.64e-04_r8 ,0.201_r8 /) + real(r8) :: dbarl(4) = & ! D coefficient for single scat albedo + (/ 1.63e-07_r8 , 2.35e-05_r8 ,1.24e-03_r8 ,7.56e-03_r8 /) + real(r8) :: ebarl(4) = & ! E coefficient for asymmetry parameter + (/ 0.829_r8 , 0.794_r8 ,0.754_r8 ,0.826_r8 /) + real(r8) :: fbarl(4) = & ! F coefficient for asymmetry parameter + (/ 2.482e-03_r8, 4.226e-03_r8,6.560e-03_r8,4.353e-03_r8/) + + real(r8) :: abarli ! A coefficient for current spectral band + real(r8) :: bbarli ! B coefficient for current spectral band + real(r8) :: cbarli ! C coefficient for current spectral band + real(r8) :: dbarli ! D coefficient for current spectral band + real(r8) :: ebarli ! E coefficient for current spectral band + real(r8) :: fbarli ! F coefficient for current spectral band + + ! Caution... A. Slingo recommends no less than 4.0 micro-meters nor + ! greater than 20 micro-meters + + integer :: ns, i, k, indxsl, Nday + integer :: i_rel, lchnk, icld, itim_old + real(r8) :: tmp1l, tmp2l, tmp3l, g + real(r8) :: kext(pcols,pver) + real(r8), pointer, dimension(:,:) :: iclwpth + + Nday = state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, rel_idx, rel) + + if (oldliqwp) then + do k=1,pver + do i = 1,Nday + cliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/(gravit*max(0.01_r8,cldn(i,k))) + end do + end do + else + if (iclwp_idx<=0) then + call endrun('slingo_liq_optics_sw: oldliqwp must be set to true since ICLWP was not found in pbuf') + endif + ! The following is the eventual target specification for in cloud liquid water path. + call pbuf_get_field(pbuf, iclwp_idx, tmpptr) + cliqwp = tmpptr + endif + + call get_sw_spectral_boundaries(wavmin,wavmax,'microns') + + do ns = 1, nswbands + ! Set index for cloud particle properties based on the wavelength, + ! according to A. Slingo (1989) equations 1-3: + ! Use index 1 (0.25 to 0.69 micrometers) for visible + ! Use index 2 (0.69 - 1.19 micrometers) for near-infrared + ! Use index 3 (1.19 to 2.38 micrometers) for near-infrared + ! Use index 4 (2.38 to 4.00 micrometers) for near-infrared + if(wavmax(ns) <= 0.7_r8) then + indxsl = 1 + else if(wavmax(ns) <= 1.25_r8) then + indxsl = 2 + else if(wavmax(ns) <= 2.38_r8) then + indxsl = 3 + else if(wavmax(ns) > 2.38_r8) then + indxsl = 4 + end if + + ! Set cloud extinction optical depth, single scatter albedo, + ! asymmetry parameter, and forward scattered fraction: + abarli = abarl(indxsl) + bbarli = bbarl(indxsl) + cbarli = cbarl(indxsl) + dbarli = dbarl(indxsl) + ebarli = ebarl(indxsl) + fbarli = fbarl(indxsl) + + do k=1,pver + do i=1,Nday + + ! note that optical properties for liquid valid only + ! in range of 4.2 > rel > 16 micron (Slingo 89) + if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then + tmp1l = abarli + bbarli/min(max(4.2_r8,rel(i,k)),16._r8) + liq_tau(ns,i,k) = 1000._r8*cliqwp(i,k)*tmp1l + else + liq_tau(ns,i,k) = 0.0_r8 + endif + + tmp2l = 1._r8 - cbarli - dbarli*min(max(4.2_r8,rel(i,k)),16._r8) + tmp3l = fbarli*min(max(4.2_r8,rel(i,k)),16._r8) + ! Do not let single scatter albedo be 1. Delta-eddington solution + ! for non-conservative case has different analytic form from solution + ! for conservative case, and raddedmx is written for non-conservative case. + liq_tau_w(ns,i,k) = liq_tau(ns,i,k) * min(tmp2l,.999999_r8) + g = ebarli + tmp3l + liq_tau_w_g(ns,i,k) = liq_tau_w(ns,i,k) * g + liq_tau_w_f(ns,i,k) = liq_tau_w(ns,i,k) * g * g + + end do ! End do i=1,Nday + end do ! End do k=1,pver + end do ! nswbands + +end subroutine slingo_liq_optics_sw + +subroutine slingo_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) + + type(physics_state), intent(in) :: state + type(physics_buffer_desc),pointer :: pbuf(:) + real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) + logical, intent(in) :: oldliqwp + + real(r8) :: gicewp(pcols,pver) + real(r8) :: gliqwp(pcols,pver) + real(r8) :: cicewp(pcols,pver) + real(r8) :: cliqwp(pcols,pver) + real(r8) :: ficemr(pcols,pver) + real(r8) :: cwp(pcols,pver) + real(r8) :: cldtau(pcols,pver) + + real(r8), pointer, dimension(:,:) :: cldn + real(r8), pointer, dimension(:,:) :: rei + integer :: ncol, icld, itim_old, i_rei, lwband, i, k, lchnk + + real(r8) :: kabs, kabsi + real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) + parameter (kabsl = 0.090361_r8) + + real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth + + ncol=state%ncol + lchnk = state%lchnk + + itim_old = pbuf_old_tim_idx() + call pbuf_get_field(pbuf, rei_idx, rei) + call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if (oldliqwp) then + do k=1,pver + do i = 1,ncol + gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. + gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. + cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. + cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. + ficemr(i,k) = state%q(i,k,ixcldice) / & + max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) + end do + end do + cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) + else + if (iclwp_idx<=0 .or. iciwp_idx<=0) then + call endrun('slingo_liq_get_rad_props_lw: oldliqwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') + endif + call pbuf_get_field(pbuf, iclwp_idx, iclwpth) + call pbuf_get_field(pbuf, iciwp_idx, iciwpth) + do k=1,pver + do i = 1,ncol + cwp (i,k) = 1000.0_r8 * iclwpth(i,k) + 1000.0_r8 * iciwpth(i, k) + ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8, cwp(i,k))) + end do + end do + endif + + + do k=1,pver + do i=1,ncol + + ! Note from Andrew Conley: + ! Optics for RK no longer supported, This is constructed to get + ! close to bit for bit. Otherwise we could simply use liquid water path + !note that optical properties for ice valid only + !in range of 13 > rei > 130 micron (Ebert and Curry 92) + kabs = kabsl*(1._r8-ficemr(i,k)) + cldtau(i,k) = kabs*cwp(i,k) + end do + end do +! + do lwband = 1,nlwbands + abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) + enddo + +end subroutine slingo_liq_get_rad_props_lw + +end module slingo_liq_optics diff --git a/src/physics/cam/spcam_drivers.F90 b/src/physics/cam/spcam_drivers.F90 deleted file mode 100644 index d44c1db730..0000000000 --- a/src/physics/cam/spcam_drivers.F90 +++ /dev/null @@ -1,54 +0,0 @@ -module spcam_drivers - -! stub module - -use shr_kind_mod, only: r8 => shr_kind_r8 -use physics_types, only: physics_state, physics_tend -use physics_buffer, only: physics_buffer_desc -use camsrfexch, only: cam_out_t, cam_in_t -use cam_abortutils, only: endrun - -implicit none -private -save - -public :: tphysbc_spcam, spcam_register, spcam_init - -!======================================================================================== -contains -!======================================================================================== - -subroutine tphysbc_spcam (ztodt, state, & - tend, pbuf, & - cam_out, cam_in ) - - real(r8), intent(in) :: ztodt - type(physics_state), intent(inout) :: state - type(physics_tend ), intent(inout) :: tend - type(physics_buffer_desc), pointer :: pbuf(:) - type(cam_out_t), intent(inout) :: cam_out - type(cam_in_t), intent(in) :: cam_in - !--------------------------------------------------------------------------- - - call endrun('tphysbc_spcam: ERROR: this is a stub') - -end subroutine tphysbc_spcam - -!======================================================================================== - -subroutine spcam_register() - -end subroutine spcam_register - -!======================================================================================== - -subroutine spcam_init(pbuf2d) - - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - -end subroutine spcam_init - -!======================================================================================== - -end module spcam_drivers - diff --git a/src/physics/cam/ssatcontrail.F90 b/src/physics/cam/ssatcontrail.F90 new file mode 100644 index 0000000000..204ba5ab8d --- /dev/null +++ b/src/physics/cam/ssatcontrail.F90 @@ -0,0 +1,236 @@ +module ssatcontrail +! contrail parameterization +! see Chen et al., 2012: Global contrail coverage simulated +! by CAM5 with the inventory of 2006 global aircraft emissions, JAMES +! https://doi.org/10.1029/2011MS000105 + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, pver + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use physconst, only: cpair,mwdry,mwh2o, gravit, zvir, rair, pi, rearth, tmelt + use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc, pbuf_old_tim_idx + use constituents, only: cnst_get_ind, pcnst + use phys_grid, only: get_wght_all_p + use wv_saturation, only: qsat_water, qsat_ice + use aircraft_emit, only: get_aircraft + + implicit none + private + save + + public ssatcontrail_d0 + + ! Private data + real(r8), parameter :: rhoi = 500.0_r8 ! density of ice (500 kg/m3) + real(r8), parameter :: radius = 3.75e-6_r8 ! diameter of ice particle = 7.5 microns + + +contains + + subroutine ssatcontrail_d0(state1,pbuf,dtime,ptend_loc) + implicit none + + type(physics_state), intent(in) :: state1 + type(physics_ptend), intent(inout) :: ptend_loc + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(in) :: dtime ! time step +!------------------------Local storage------------------------------------------------------ + real(r8) :: Ma, Mh2o, epsi, Q, eta, p, G, T_contr, eslTc, eslT, RH_contr, qslTc, qslT + real(r8) :: w, esiT, qsiT, ws, RH, ei + integer :: i,k + integer :: lchnk,ncol + real(r8) :: contrail(pcols,pver), pcontrail(pcols,pver) + real(r8), pointer, dimension(:,:) :: cld ! cloud fraction + real(r8), pointer, dimension(:,:) :: ac_H2O + real(r8), pointer, dimension(:,:) :: ac_SLANT_DIST + integer :: itim, ifld + integer :: ixcldice, ixcldliq ! indices for CLDICE and CLDLIQ + integer :: ixnumice, ixnumliq + real(r8):: zi, zm, rog + logical :: has_aircraft_H2O + logical :: has_aircraft_distance + real(r8) :: hkl, hkk, tv + real(r8) :: particle_mass + real(r8) :: ICIWC0(pcols,pver), ICIWC, rho + real(r8) :: qs + real(r8) :: wght(pcols) + real(r8) :: dz, ratio(pcols,pver) + real(r8) :: dcld(pcols,pver) + real(r8) :: ac_Q, ac_Q1, ac_Q2 + real(r8) :: RHcts(pcols,pver) + logical :: lq(pcnst) + + integer :: yr, mon, day, ncsec + real(r8) :: curr_factor + integer :: aircraft_cnt + character(len=16) :: spc_name_list(30) + + has_aircraft_H2O = .false. + has_aircraft_distance = .false. + + ! Update constituents, all schemes use time split q: no tendency kept + call cnst_get_ind('CLDICE', ixcldice, abort=.false.) + call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) + ! Check for number concentration of cloud liquid and cloud ice (if not present) + ! the indices will be set to -1) + call cnst_get_ind('NUMICE', ixnumice, abort=.false.) + call cnst_get_ind('NUMLIQ', ixnumliq, abort=.false.) + + call get_aircraft(aircraft_cnt, spc_name_list) +!----------------------------------------------------------------------------------------- +! check if ac_H2O in namelist +! if not, then bypass this subroutine +!----------------------------------------------------------------------------------------- + if(aircraft_cnt>0) then + do i=1,aircraft_cnt + if(trim(spc_name_list(i)) == 'ac_H2O') then + has_aircraft_H2O = .true. + endif + if(trim(spc_name_list(i)) == 'ac_SLANT_DIST' .or. trim(spc_name_list(i)) == 'ac_TRACK_DIST') then + has_aircraft_distance = .true. + endif + enddo + endif +!------------------------------------------------------------------------------------------ + lq(:) = .FALSE. + lq(1) = .TRUE. + lq(ixcldice) = .TRUE. + lq(ixnumice) = .TRUE. + + call physics_ptend_init(ptend_loc, state1%psetcols,'ssatcontrail',ls=.true.,lq = lq) +!----------------------------------------------------------------------------------------- + if(.not. has_aircraft_H2O) return + if(.not. has_aircraft_distance) return + + particle_mass = 4._r8/3._r8*pi*rhoi*radius**3 ! mass of ice particle + + rog = rair/gravit ! Rd/Cp + + + contrail(:,:) = 0.0_r8 + pcontrail(:,:) = 0.0_r8 + ICIWC0(:,:) = 0.0_r8 + RHcts(:,:) = 0.0_r8 + + lchnk = state1%lchnk + ncol = state1%ncol + + call get_wght_all_p(lchnk, ncol, wght) + + itim = pbuf_old_tim_idx() + ifld = pbuf_get_index('CLD') + call pbuf_get_field(pbuf, ifld, cld, (/1,1,itim/),(/pcols,pver,1/)) + + ifld = pbuf_get_index('ac_H2O') + call pbuf_get_field(pbuf,ifld,ac_H2O) + ifld = pbuf_get_index('ac_SLANT_DIST') + call pbuf_get_field(pbuf,ifld,ac_SLANT_DIST) + +! adjust h2o to volume mixing ratio (mass adjustment and conversion from g/kg to kg/kg) + Ma = mwdry + Mh2o = mwh2o + +! contrail paramter (G = CF*p/epi) +! and Schumann 1996 DOI: 10.1127/metz/5/1996/4, reprinted by Ponater 2002, JGR (eq 6-8) DOI: 10.1029/2011MS000105 + + epsi = Mh2o/Ma + ei = 1.21_r8 ! water vapor emision index (g) h2o per kg fuel (Schumann 96) + Q = 43.e6_r8 ! specific combustion heat Schummann 1996, Q = 43 MJ/kg + eta = 0.3_r8 ! propulsion effieciency (Ponater 2002) + + ratio = 0._r8 + dcld = 0._r8 + + do i=1,ncol + do k=1,pver + p = (state1%pint(i,k)+state1%pint(i,k+1))/2.0_r8 + + G = (ei*cpair*p)/(epsi*Q*(1.0_r8-eta)) ! eq 7, Ponater JGR 2002 + + if( G > 0.053_r8 ) then + T_contr = -46.46_r8+9.43_r8*log(G-0.053_r8)+0.72_r8*log(G-0.053_r8)*log(G-0.053_r8) ! eq 6, Ponater JGR 2002 + T_contr = T_contr + tmelt ! convert to Kelvin + + ! compute saturation pressure + call qsat_water(T_contr, p, eslTc, qslTc) + call qsat_water(state1%t(i,k), p, eslT, qslT) + + RH_contr = (G*(state1%t(i,k)-T_contr)+eslTc)/eslT + ! RH_contr ranges between 0 and 1 + if(RH_contr>1.0_r8) RH_contr = 1.0_r8 + if(RH_contr<0.0_r8) RH_contr = 0.0_r8 + + w = state1%q(i,k,1)/(1.0_r8-state1%q(i,k,1)) ! mixing ratio from specific humidity + call qsat_ice(state1%t(i,k), p, esiT, qsiT) + ws = epsi*esiT/(p-esiT) ! saturation mixing ration with respect to ice + qs = ws/(1.0_r8+ws) + + RH = w/ws ! relative humidity with respect to ice + if( RH>=1.0_r8 ) RHcts(i,k) = 1.0_r8 + +! Schumann, U. “Contrail Cirrus.” In Cirrus, edited by D. K. Lynch and others, 231–55. Oxford University Press, 2002 +! IWC(g/m3) = exp(6.97+0.103*T(C))*1e-3 +! IWC(kg/m3) = exp(6.97+0.103*T(C))*1e-6 + + ICIWC0(i,k) = exp(6.97_r8+0.103_r8*(state1%t(i,k)-tmelt)) ! in mg/m3 + rho = p/(rair*state1%t(i,k)) + ICIWC = ICIWC0(i,k)/rho*1.0e-6_r8 + + +! persistent contrail condition + if( (state1%t(i,k)RH_contr).and.(RH>1.0_r8).and.(ac_H2O(i,k)>0.0_r8) ) then + +! if persistent contrail, H2O emitted from aircraft turns into cloud ice + dz = state1%zi(i,k)-state1%zi(i,k+1) + ratio(i,k) = (ac_SLANT_DIST(i,k)*dtime*1.e4_r8)/(dz*rearth*rearth*wght(i)) + + ac_Q = min(ac_H2O(i,k)*dtime + (state1%q(i,k,1)-qs)*ratio(i,k),ratio(i,k)*ICIWC) + ptend_loc%q(i,k,ixcldice) = ac_Q/dtime + +! take out water vapor from q + ptend_loc%q(i,k,1) = -(ac_Q-ac_H2O(i,k)*dtime)/dtime + +! modify cloud fraction +! by a prescribed ICIWC, we may deduce the new cloud fraction + + cld(i,k) = min(1._r8, cld(i,k)+ac_Q/ICIWC) + +! modify cloud ice number concentration, +! by assuming the particle size, the number of ice particles may be obtained + ptend_loc%q(i,k,ixnumice) = ac_Q/particle_mass/dtime + + else +! if not persistent contrail, just add ac_H2O to state1%q(1) (vapor phase) + + ptend_loc%q(i,k,1) = ac_H2O(i,k) + + endif + + else + ptend_loc%q(i,k,1) = ac_H2O(i,k) + end if + + enddo + +! modify dry static energy if water field is added to any grid cell +! this bypasses geopotential_t which assumes dry static energy conservation +! water vapor added to the system is assumed to increase dry static energy +! conservation of dry static energy by geopotential_t will lower temperature to compensate + + zi = 0.0_r8 + do k=pver,1,-1 + hkl = state1%lnpint(i,k+1)-state1%lnpint(i,k) + hkk = 1._r8 - state1%pint(i,k) * hkl * state1%rpdel(i,k) + + tv = state1%t(i,k) * (1._r8 + zvir*(state1%q(i,k,1)+ptend_loc%q(i,k,1)*dtime)) + + zm = zi + rog * tv * hkk + zi = zi + rog * tv * hkl + + ptend_loc%s(i,k) = (cpair*state1%t(i,k)+gravit*zm + state1%phis(i) - state1%s(i,k) )/dtime + enddo + + enddo + + end subroutine ssatcontrail_d0 + +end module ssatcontrail diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index 5c335c932d..05653b9f03 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -9,23 +9,36 @@ module subcol_SILHS use shr_kind_mod, only: r8=>shr_kind_r8, r4=>shr_kind_r4, i4=>shr_kind_i4 use physics_types, only: physics_state, physics_tend, physics_ptend - use ppgrid, only: pcols, psubcols, pver, pverp + use ppgrid, only: pcols, psubcols, pver, pverp, begchunk, endchunk use constituents, only: pcnst, cnst_get_ind use cam_abortutils, only: endrun use cam_logfile, only: iulog use cam_history, only: addfld, add_default, outfld, horiz_only + use ref_pres, only: top_lev => trop_cloud_top_lev #ifdef CLUBB_SGS #ifdef SILHS - use clubb_intr, only: pdf_params_chnk + use clubb_intr, only: & + clubb_config_flags, & + clubb_params_single_col, & + stats_metadata, & + stats_zt, stats_zm, stats_sfc, & + 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 + hmp2_ip_on_hmm2_ip_intrcpt_type, & + precipitation_fractions, & + stats, & + core_rknd use silhs_api_module, only: & silhs_config_flags_type #endif #endif - use physconst, only: cpair, gravit, latvap, latice, rair + use physconst, only: cpair, gravit, latvap, latice, rair, rga, cappa implicit none private @@ -39,14 +52,22 @@ module subcol_SILHS public :: subcol_SILHS_var_covar_driver public :: subcol_SILHS_fill_holes_conserv public :: subcol_SILHS_hydromet_conc_tend_lim + public :: init_state_subcol private :: fill_holes_sedimentation private :: fill_holes_same_phase_vert #ifdef SILHS - private :: Abs_Temp_profile - private :: StaticEng_profile ! Calc subcol mean ! Calc subcol variance private :: meansc private :: stdsc + + 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 !----- @@ -66,7 +87,7 @@ module subcol_SILHS ixnumsnow= 0 ! Pbuf indicies - integer :: thlm_idx, rcm_idx, rtm_idx, ice_supersat_idx, & + integer :: thlm_idx, rtm_idx, ice_supersat_idx, & alst_idx, cld_idx, qrain_idx, qsnow_idx, & nrain_idx, nsnow_idx, ztodt_idx, tke_idx, kvh_idx, & prec_pcw_idx, snow_pcw_idx, prec_str_idx, snow_str_idx, & @@ -128,11 +149,13 @@ end subroutine subcol_register_SILHS subroutine subcol_readnl_SILHS(nlfile) #ifdef CLUBB_SGS #ifdef SILHS - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: masterproc, masterprocid, mpicom - use spmd_utils, only: mpi_integer, mpi_logical, mpi_character, mpir8 - use clubb_api_module,only: core_rknd + use namelist_utils, only: find_group_name + use spmd_utils, only: masterproc, masterprocid, mpicom + use spmd_utils, only: mpi_integer, mpi_logical, mpi_character, mpir8, iam + use clubb_api_module, only: core_rknd + use silhs_api_module, only: set_default_silhs_config_flags_api, & + initialize_silhs_config_flags_type_api, & + print_silhs_config_flags_api #endif #endif character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -141,6 +164,23 @@ subroutine subcol_readnl_SILHS(nlfile) integer :: unitn, ierr #ifdef CLUBB_SGS #ifdef SILHS + + integer :: & + cluster_allocation_strategy + + logical :: & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights + namelist /subcol_SILHS_nl/ subcol_SILHS_weight, & subcol_SILHS_numsubcol, & subcol_SILHS_corr_file_path, & @@ -158,6 +198,18 @@ subroutine subcol_readnl_SILHS(nlfile) ! subcol_SILHS_c8, subcol_SILHS_c11, subcol_SILHS_c11b, & ! subcol_SILHS_gamma_coef, subcol_SILHS_mult_coef, subcol_SILHS_mu + namelist /silhs_config_flags_nl/ subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights + !----------------------------------------------------------------------------- ! Set defaults @@ -166,8 +218,7 @@ subroutine subcol_readnl_SILHS(nlfile) subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ni = 0.5_core_rknd 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, 'subcol_SILHS_nl', status=ierr) if (ierr == 0) then read(unitn, subcol_SILHS_nl, iostat=ierr) @@ -176,9 +227,53 @@ subroutine subcol_readnl_SILHS(nlfile) end if end if close(unitn) - call freeunit(unitn) end if + ! Set default silhs_config_flags entires + call set_default_silhs_config_flags_api( cluster_allocation_strategy, & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights ) + + ! Get silhs_config_flags entries from namelist + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'silhs_config_flags_nl', status=ierr) + if (ierr == 0) then + read(unitn, silhs_config_flags_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('silhs_config_flags_nl: ERROR reading namelist') + end if + end if + close(unitn) + end if + + ! Save silhs_config_flags entries into module variable silhs_config_flags + call initialize_silhs_config_flags_type_api( cluster_allocation_strategy, & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights, & + silhs_config_flags ) + + ! Print the SILHS configurable flags + call print_silhs_config_flags_api( iulog, silhs_config_flags ) ! Intent(in) + #ifdef SPMD ! Broadcast namelist variables call mpi_bcast(subcol_SILHS_weight, 1, mpi_logical, masterprocid, mpicom, ierr) @@ -214,6 +309,17 @@ subroutine subcol_readnl_SILHS(nlfile) ! call mpi_bcast(subcol_SILHS_gamma_coef, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_mult_coef, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_mu, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_importance_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_Lscale_vert_avg, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_straight_mc, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_clustered_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_rcm_in_cloud_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_random_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_max_overlap_in_cloud, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_instant_var_covar_src, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_limit_weights, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_var_frac, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_normalize_weights, 1, mpi_logical, masterprocid, mpicom, ierr) ! SPMD #endif @@ -234,25 +340,13 @@ subroutine subcol_init_SILHS(pbuf2d) use physics_buffer, only: physics_buffer_desc, pbuf_get_field, & dtype_r8, pbuf_get_index - use units, only: getunit, freeunit #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 - use silhs_api_module, only: set_default_silhs_config_flags_api, & - initialize_silhs_config_flags_type_api, & - print_silhs_config_flags_api - - use spmd_utils, only: iam - - use clubb_intr, only: init_clubb_config_flags, & - clubb_config_flags - #endif #endif @@ -270,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 @@ -280,22 +373,7 @@ subroutine subcol_init_SILHS(pbuf2d) iiNi, & ! Hydrometeor array index for ice concentration, Ni iiNg ! Hydrometeor array index for graupel concentration, Ng - integer :: & - cluster_allocation_strategy - - logical :: & - l_lh_importance_sampling, & - l_Lscale_vert_avg, & - l_lh_straight_mc, & - l_lh_clustered_sampling, & - l_rcm_in_cloud_k_lh_start, & - l_random_k_lh_start, & - l_max_overlap_in_cloud, & - l_lh_instant_var_covar_src, & - l_lh_limit_weights, & - l_lh_var_frac, & - l_lh_normalize_weights - + 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. @@ -304,45 +382,13 @@ subroutine subcol_init_SILHS(pbuf2d) !------------------------------- ! CLUBB-SILHS Parameters (global module variables) !------------------------------- - call set_default_silhs_config_flags_api( cluster_allocation_strategy, & - l_lh_importance_sampling, & - l_Lscale_vert_avg, & - l_lh_straight_mc, & - l_lh_clustered_sampling, & - l_rcm_in_cloud_k_lh_start, & - l_random_k_lh_start, & - l_max_overlap_in_cloud, & - l_lh_instant_var_covar_src, & - l_lh_limit_weights, & - l_lh_var_frac, & - l_lh_normalize_weights ) - - call init_clubb_config_flags( clubb_config_flags ) ! In/Out clubb_config_flags%l_fix_w_chi_eta_correlations = .true. - l_lh_importance_sampling = .true. clubb_config_flags%l_diagnose_correlations = .false. clubb_config_flags%l_calc_w_corr = .false. ! l_prescribed_avg_deltaz = .false. clubb_config_flags%l_use_cloud_cover = .false. clubb_config_flags%l_const_Nc_in_cloud = .true. - call initialize_silhs_config_flags_type_api( cluster_allocation_strategy, & - l_lh_importance_sampling, & - l_Lscale_vert_avg, & - l_lh_straight_mc, & - l_lh_clustered_sampling, & - l_rcm_in_cloud_k_lh_start, & - l_random_k_lh_start, & - l_max_overlap_in_cloud, & - l_lh_instant_var_covar_src, & - l_lh_limit_weights, & - l_lh_var_frac, & - l_lh_normalize_weights, & - silhs_config_flags ) - - ! Print the SILHS configurable flags - call print_silhs_config_flags_api( iulog, silhs_config_flags ) ! Intent(in) - ! Values from the namelist docldfracscaling = subcol_SILHS_use_clear_col @@ -359,7 +405,6 @@ subroutine subcol_init_SILHS(pbuf2d) ! mu = subcol_SILHS_mu !call set_clubb_debug_level( 0 ) !#KTCtodo: Add a namelist variable to set debug level - ! Get constituent indices call cnst_get_ind('Q', ixq) @@ -374,7 +419,6 @@ subroutine subcol_init_SILHS(pbuf2d) ! Get physics buffer indexes thlm_idx = pbuf_get_index('THLM') - rcm_idx = pbuf_get_index('RCM') rtm_idx = pbuf_get_index('RTM') cld_idx = pbuf_get_index('CLD') alst_idx = pbuf_get_index('ALST') ! SILHS expects clubb's cloud_frac liq stratus fraction @@ -408,125 +452,143 @@ 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 - iunit = getunit() - - call setup_corr_varnce_array_api( corr_file_path_cloud, corr_file_path_below, & - iunit, & - clubb_config_flags%l_fix_w_chi_eta_correlations ) - call freeunit(iunit) + 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 - ! #KTCtodo: Remove these from the default output list !------------------------------- call addfld('SILHS_NCLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'm^-3', & - 'Subcolumn Cloud Number Concentration', flag_xyfill=.true., fill_value=1.e30_r8) + 'Subcolumn Cloud Number Concentration', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) call addfld('SILHS_NRAIN_SCOL', (/'psubcols', 'ilev '/), 'I', 'm^-3', & - 'Subcolumn Number Concentration of Rain from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + 'Subcolumn Number Concentration of Rain from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) call addfld('SILHS_OMEGA_SCOL', (/'psubcols', 'ilev '/), 'I', 'Pa/s', & - 'Subcolumn vertical pressure velocity', flag_xyfill=.true., fill_value=1.e30_r8) + 'Subcolumn vertical pressure velocity', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) call addfld('SILHS_RCM_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & - 'Subcolumn Cloud Liquid Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + 'Subcolumn Cloud Liquid Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) call addfld('SILHS_RICLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & - 'Subcolumn Cloud Ice Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + 'Subcolumn Cloud Ice Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) call addfld('SILHS_NICLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & - 'Subcolumn Cloud Ice Number Conc from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + 'Subcolumn Cloud Ice Number Conc from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) call addfld('SILHS_RRAIN_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & - 'Subcolumn Precipitating Liquid Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + 'Subcolumn Precipitating Liquid Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) call addfld('SILHS_RT_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg ', & - 'Subcolumn Total Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + 'Subcolumn Total Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) call addfld('SILHS_THLM_SCOL', (/'psubcols', 'ilev '/), 'I', 'K', & - 'Subcolumn liquid water pot temperature', flag_xyfill=.true., fill_value=1.e30_r8) + 'Subcolumn liquid water pot temperature', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) call addfld('SILHS_WEIGHT_SCOL', (/'psubcols'/), 'I', 'frac', & - 'Weights for each subcolumn', flag_xyfill=.true., fill_value=1.e30_r8) + 'Weights for each subcolumn', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) call addfld('SILHS_WM_SCOL', (/'psubcols', 'ilev '/), 'I', 'm/s', & - 'Subcolumn vertical velocity from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + 'Subcolumn vertical velocity from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) call addfld('NR_IN_LH', (/ 'lev' /), 'I', 'm^-3', & - 'Num Rain Conc as input to SILHS') - call addfld('RTM_CLUBB', (/ 'ilev' /), 'I', 'kg/kg', & - 'Input total water mixing ratio') - call addfld('THLM_CLUBB', (/ 'ilev' /), 'I', 'K', & - 'Input liquid water potential temperature') + 'Num Rain Conc as input to SILHS', sampled_on_subcycle=.true.) + call addfld('SILHS_RTM', (/ 'ilev' /), 'I', 'kg/kg', & + 'Input total water mixing ratio', sampled_on_subcycle=.true.) + call addfld('SILHS_THLM', (/ 'ilev' /), 'I', 'K', & + 'Input liquid water potential temperature', sampled_on_subcycle=.true.) call addfld('SILHS_QC_IN', (/ 'lev' /), 'I', 'kg/kg', & - 'Input cloud water mixing ratio') + 'Input cloud water mixing ratio', sampled_on_subcycle=.true.) call addfld('SILHS_QI_IN', (/ 'lev' /), 'I', 'kg/kg', & - 'Input cloud ice mixing ratio') + 'Input cloud ice mixing ratio', sampled_on_subcycle=.true.) call addfld('SILHS_NC_IN', (/ 'lev' /), 'I', '#/kg', & - 'Input cloud water number concentration') + 'Input cloud water number concentration', sampled_on_subcycle=.true.) call addfld('SILHS_NI_IN', (/ 'lev' /), 'I', '#/kg', & - 'Input cloud ice number concentration') + 'Input cloud ice number concentration', sampled_on_subcycle=.true.) call addfld('AKM_CLUBB', (/ 'ilev' /), 'I', '(kg/kg)/s', & - 'Exact Kessler autoconversion') + 'Exact Kessler autoconversion', sampled_on_subcycle=.true.) call addfld('AKM_LH_CLUBB', (/ 'ilev' /), 'I', '(kg/kg)/s', & - 'Monte Carlo estimate of Kessler autoconversion') + 'Monte Carlo estimate of Kessler autoconversion', sampled_on_subcycle=.true.) call addfld('INVS_EXNER', (/ 'lev' /), 'I', 'none', & - 'inverse EXNER function from state in subcol_SILHS') + 'inverse EXNER function from state in subcol_SILHS', sampled_on_subcycle=.true.) call addfld('SILHS_ZTODT', horiz_only, 'I', 's', & - 'Length of Physics timestep (for debugging)') + 'Length of Physics timestep (for debugging)', sampled_on_subcycle=.true.) if ( subcol_SILHS_constrainmn ) then call addfld('SILHS_MSC_CLDICE', (/ 'lev' /), 'A', 'kg/kg', & - 'Mean Cloud Ice across subcolumns') + 'Mean Cloud Ice across subcolumns', sampled_on_subcycle=.true.) call addfld('SILHS_STDSC_CLDICE', (/ 'lev' /), 'A', 'kg/kg', & - 'Standard deviation of Ice across subcolumns') + 'Standard deviation of Ice across subcolumns', sampled_on_subcycle=.true.) if ( ixsnow > 0 ) then call addfld('SILHS_MSC_CLDLIQ', (/ 'lev' /), 'A', 'kg/kg', & - 'Mean Cloud Liquid across subcolumns') + 'Mean Cloud Liquid across subcolumns', sampled_on_subcycle=.true.) call addfld('SILHS_STDSC_CLDLIQ', (/ 'lev' /), 'A', 'kg/kg', & - 'Standard deviation of Liquid across subcolumns') + 'Standard deviation of Liquid across subcolumns', sampled_on_subcycle=.true.) call addfld('SILHS_MSC_Q', (/ 'lev' /), 'A', 'kg/kg', & - 'Mean water vapor across subcolumns') + 'Mean water vapor across subcolumns', sampled_on_subcycle=.true.) call addfld('SILHS_STDSC_Q', (/ 'lev' /), 'A', 'kg/kg', & - 'Standard deviation of water vapor across subcolumns') + 'Standard deviation of water vapor across subcolumns', sampled_on_subcycle=.true.) endif ! ixsnow > 0 endif ! subcol_SILHS_constrainmn call addfld('SILHS_EFF_CLDFRAC', (/ 'lev' /), 'A', 'frac', & - 'Calculated cloud fraction from subcolumn liq or ice') + 'Calculated cloud fraction from subcolumn liq or ice', sampled_on_subcycle=.true.) call addfld('SILHS_CLUBB_PRECIP_FRAC', (/ 'lev' /), 'A', 'frac', & - 'Precipitation fraction from CLUBB (set_up_pdf_params_incl_hydromet)') + 'Precipitation fraction from CLUBB (set_up_pdf_params_incl_hydromet)', sampled_on_subcycle=.true.) call addfld('SILHS_CLUBB_ICE_SS_FRAC', (/ 'lev' /), 'A', 'frac', & - 'Ice supersaturation fraction from CLUBB') + 'Ice supersaturation fraction from CLUBB', sampled_on_subcycle=.true.) - call addfld ('QVHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Water vapor mixing ratio tendency from hole filling') - call addfld ('QCHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud water mixing ratio tendency from hole filling') - call addfld ('QRHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Rain water mixing ratio tendency from hole filling') - call addfld ('QIHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice mixing ratio tendency from hole filling') - call addfld ('QSHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Snow mixing ratio tendency from hole filling') - call addfld ('THFTEN', (/ 'lev' /), 'A', 'K/s', 'Temperature tendency from hole filling') + call addfld ('QVHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Water vapor mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) + call addfld ('QCHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud water mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) + call addfld ('QRHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Rain water mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) + call addfld ('QIHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) + call addfld ('QSHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Snow mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) + call addfld ('THFTEN', (/ 'lev' /), 'A', 'K/s', 'Temperature tendency from hole filling', sampled_on_subcycle=.true.) #endif #endif end subroutine subcol_init_SILHS - +!==============================================================! + subroutine init_state_subcol(state, tend, state_sc, tend_sc) + + use ppgrid, only : pver, pverp, pcols + + use subcol_utils, only : subcol_set_subcols + + implicit none + + type(physics_state), intent(inout) :: state + type(physics_tend), intent(inout) :: tend + type(physics_state), intent(inout) :: state_sc ! sub-column state + type(physics_tend), intent(inout) :: tend_sc ! sub-column tend + + integer, dimension(pcols) :: numsubcol_arr ! To set up the state struct + + numsubcol_arr(:) = 0 ! Start over each chunk + numsubcol_arr(:state%ngrdcol) = subcol_SILHS_numsubcol ! Only set for valid grid columns + call subcol_set_subcols(state, tend, numsubcol_arr, state_sc, tend_sc) + + end subroutine init_state_subcol +!==================================================================! subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !------------------------------- ! This is where the subcolumns are created, and the call to @@ -537,53 +599,37 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) use physics_buffer, only : physics_buffer_desc, pbuf_get_index, & pbuf_get_field - use ppgrid, only : pver, pverp, pcols - use ref_pres, only : top_lev => trop_cloud_top_lev use time_manager, only : get_nstep use subcol_utils, only : subcol_set_subcols, subcol_set_weight + use subcol_pack_mod, only : subcol_pack use phys_control, only : phys_getopts use spmd_utils, only : masterproc use shr_const_mod, only : SHR_CONST_PI, SHR_CONST_RHOFW #ifdef CLUBB_SGS #ifdef SILHS - use clubb_api_module, only : hydromet_dim, & - - setup_pdf_parameters_api, & - - l_stats_samp, & - - hydromet_pdf_parameter, & + use clubb_api_module, only : setup_pdf_parameters_api, & - zm2zt_api, setup_grid_heights_api, gr, & - - iirr, iiNr, iirs, iiri, & - iirg, iiNs, & - iiNi, iiNg, & + zm2zt_api, setup_grid_heights_api, & 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, & - read_parameters_api + read_parameters_api, & + Cp, Lv, & + grid, setup_grid_api, & + init_precip_fracs_api use silhs_api_module, only : generate_silhs_sample_api, & ! Ncn_to_Nc, & clip_transform_silhs_output_api, & - est_kessler_microphys_api + est_kessler_microphys_api, & + vert_decorr_coef - use clubb_intr, only: clubb_config_flags #endif #endif @@ -609,15 +655,14 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) real(r8), parameter :: qsmall = 1.0e-18_r8 ! Microphysics cut-off for cloud integer :: i, j, k, ngrdcol, ncol, lchnk, stncol - integer :: begin_height, end_height ! Output from setup_grid call - real(r8) :: sfc_elevation ! Surface elevation - real(r8), dimension(pverp-top_lev+1) :: zt_g, zi_g ! Thermo & Momentum grids for clubb + real(r8) :: sfc_elevation(state%ngrdcol) ! Surface elevation + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: zt_g, zi_g ! Thermo & Momentum grids for clubb + real(r8), dimension(pverp) :: scfrac ! cloud fraction based on sc distributions real(r8) :: msc, std, maxcldfrac, maxsccldfrac real(r8) :: scale = 1.0_r8 - real(r8), dimension(nparams) :: clubb_params ! Adjustable CLUBB parameters - real(r8) :: c_K ! CLUBB parameter c_K (for eddy diffusivity) integer( kind = genrand_intg ) :: & @@ -627,19 +672,21 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- ! Required for set_up_pdf_params_incl_hydromet !---------------- - real(r8), dimension(pverp-top_lev+1) :: cld_frac_in ! Cloud fraction - type(hydromet_pdf_parameter), dimension(pverp-top_lev+1) :: & - hydromet_pdf_params ! Hydrometeor PDF parameters - real(r8), dimension(:,:,:), allocatable :: & ! Correlation matrix for pdf components - corr_array_1, corr_array_2 - real(r8), dimension(:,:), allocatable :: & - mu_x_1, mu_x_2, & ! Mean array for PDF components - sigma_x_1, sigma_x_2 ! Std dev arr for PDF components - real(r8), dimension(:,:,:), allocatable :: & ! Transposed corr cholesky mtx - corr_cholesky_mtx_1, corr_cholesky_mtx_2 - real(r8), dimension(pverp-top_lev+1) :: Nc_in_cloud - real(r8), dimension(pverp-top_lev+1) :: ice_supersat_frac_in - real(r8), dimension(pverp-top_lev+1,hydromet_dim) :: hydrometp2 + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: cld_frac_in ! Cloud fraction + + real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim, pdf_dim) :: & + corr_array_1, corr_array_2 ! Correlation matrix for pdf components + + real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim) :: & + mu_x_1, mu_x_2, & ! Mean array for PDF components + sigma_x_1, sigma_x_2 ! Std dev arr for PDF components + + real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim, pdf_dim) :: & + corr_cholesky_mtx_1, corr_cholesky_mtx_2 ! Transposed corr cholesky mtx + + real(r8), dimension(state%ngrdcol, pverp-top_lev+1) :: Nc_in_cloud + real(r8), dimension(state%ngrdcol, pverp-top_lev+1) :: ice_supersat_frac_in + real(r8), dimension(state%ngrdcol, pverp-top_lev+1, hydromet_dim) :: hydrometp2 !---------------- @@ -647,21 +694,20 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- integer :: iter ! CLUBB iteration integer :: num_subcols ! Number of subcolumns - integer, dimension(pcols) :: numsubcol_arr ! To set up the state struct integer, parameter :: sequence_length = 1 ! Number of timesteps btn subcol calls - real(r8), dimension(pverp-top_lev+1) :: rho_ds_zt ! Dry static density (kg/m^3) on thermo levs - real(r8), dimension(pver) :: dz_g ! thickness of layer - real(r8), dimension(pverp-top_lev+1) :: delta_zm ! Difference in u wind altitudes - real(r8), dimension(pverp-top_lev+1) :: invs_dzm ! 1/delta_zm - real(r8), dimension(pverp-top_lev+1) :: rcm_in ! Cld water mixing ratio on CLUBB levs - real(r8), dimension(pverp-top_lev+1,hydromet_dim) :: hydromet ! Hydrometeor species - real(r8), dimension(pverp-top_lev+1,hydromet_dim) :: wphydrometp ! Hydrometeor flux - real(r8), dimension(pverp-top_lev+1) :: Ncm ! Mean cloud droplet concentration, - - real(r8), dimension(pverp-top_lev+1) :: tke ! TKE - real(r8), dimension(pverp-top_lev+1) :: khzm ! Eddy diffusivity coef - real(r8), dimension(pverp-top_lev+1) :: Lscale_zm ! CLUBB's length scale on momentum (zm) levels - real(r8), dimension(pverp-top_lev+1) :: Lscale ! CLUBB's length scale + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: rho_ds_zt ! Dry static density (kg/m^3) on thermo levs + real(r8), dimension(state%ngrdcol,pver) :: dz_g ! thickness of layer + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: delta_zm ! Difference in u wind altitudes + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1,hydromet_dim) :: hydromet ! Hydrometeor species + real(r8), dimension(state%ngrdcol,pverp-top_lev+1,hydromet_dim) :: wphydrometp ! Hydrometeor flux + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Ncm ! Mean cloud droplet concentration, + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: tke ! TKE + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: khzm ! Eddy diffusivity coef + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Lscale_zm ! CLUBB's length scale on momentum (zm) levels + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Lscale ! CLUBB's length scale logical, parameter :: & l_calc_weights_all_levs = .false. ! .false. if all time steps use the same @@ -670,29 +716,29 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) l_calc_weights_all_levs_itime, & ! .true. if we calculate sample weights separately at all ! grid levels at the current time step l_rad_itime ! .true. if we calculate radiation at the current time step - + !--------------- !Output from generate_silhs_sample !-------------- - real(r8), allocatable, dimension(:,:,:) :: X_nl_all_levs ! Sample transformed to normal-lognormal - real(r8), allocatable, dimension(:,:) :: lh_sample_point_weights ! Subcolumn weights - integer, allocatable, dimension(:,:) :: X_mixt_comp_all_levs ! Which Mixture Component - - real(r8), allocatable, dimension(:,:) :: rc_all_points ! Calculate RCM from LH output - real(r8), allocatable, dimension(:,:) :: rain_all_pts ! Calculate Rain from LH output - real(r8), allocatable, dimension(:,:) :: nrain_all_pts ! Calculate Rain Conc from LH - real(r8), allocatable, dimension(:,:) :: snow_all_pts ! Calculate Snow from LH output - real(r8), allocatable, dimension(:,:) :: nsnow_all_pts ! Calculate Snow Conc from LH - real(r8), allocatable, dimension(:,:) :: w_all_points ! Calculate W from LH output - ! real(r8), allocatable, dimension(:,:) :: RVM_lh_out ! Vapor mixing ratio sent away - real(r8), allocatable, dimension(:,:) :: ice_all_pts ! Calculate Cld Ice from LH output - real(r8), allocatable, dimension(:,:) :: nice_all_pts ! Calculate Num cld ice from LH - real(r8), allocatable, dimension(:,:) :: nclw_all_pts ! Calculate Num cld wat from LH + real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1,pdf_dim) :: X_nl_all_levs ! Sample transformed to normal-lognormal + real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: lh_sample_point_weights ! Subcolumn weights + integer, dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: X_mixt_comp_all_levs ! Which Mixture Component + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1, subcol_SILHS_numsubcol) :: & + rc_all_points, & ! Calculate RCM from LH output + rain_all_pts, & ! Calculate Rain from LH output + nrain_all_pts, & ! Calculate Rain Conc from LH + snow_all_pts, & ! Calculate Snow from LH output + nsnow_all_pts, & ! Calculate Snow Conc from LH + w_all_points, & ! Calculate W from LH output + ice_all_pts, & ! Calculate Cld Ice from LH output + nice_all_pts, & ! Calculate Num cld ice from LH + nclw_all_pts ! Calculate Num cld wat from LH !---------------- ! Output from clip_transform_silhs_output_api !---------------- - real( kind = core_rknd ), dimension(:,:), allocatable :: & + real( kind = core_rknd ), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: & lh_rt_clipped, & ! rt generated from silhs sample points lh_thl_clipped, & ! thl generated from silhs sample points lh_rc_clipped, & ! rc generated from silhs sample points @@ -748,13 +794,13 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- ! Output from Est_Kessler_microphys !---------------- - real(r8), dimension(pverp-top_lev+1) :: lh_Akm ! Monte Carlo estimate of Kessler Autoconversion - real(r8), dimension(pverp-top_lev+1) :: AKm ! Exact Kessler autoconversion - real(r8), dimension(pverp-top_lev+1) :: AKstd ! Exact Stdev of gba Kessler - real(r8), dimension(pverp-top_lev+1) :: AKstd_cld ! Exact w/in cloud stdev of gba Kessler - real(r8), dimension(pverp-top_lev+1) :: AKm_rcm ! Exact local gba Kessler auto based on rcm - real(r8), dimension(pverp-top_lev+1) :: AKm_rcc ! Exact local gba Kessler based on w/in cloud rc - real(r8), dimension(pverp-top_lev+1) :: lh_rcm_avg ! LH estimate of grid box avg liquid water + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: lh_Akm ! Monte Carlo estimate of Kessler Autoconversion + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm ! Exact Kessler autoconversion + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKstd ! Exact Stdev of gba Kessler + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKstd_cld ! Exact w/in cloud stdev of gba Kessler + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm_rcm ! Exact local gba Kessler auto based on rcm + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm_rcc ! Exact local gba Kessler based on w/in cloud rc + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: lh_rcm_avg ! LH estimate of grid box avg liquid water real(r8), dimension(pcols,pverp) :: lh_AKm_out, AKm_out !---------------- @@ -766,7 +812,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) real(r8), dimension(pcols, pver) :: invs_exner ! inverse exner sent to conversion codw ! pcols for output to history real(r8) :: eff_rad_coef = 1.0_r8/(4.0_r8/3.0_r8*SHR_CONST_RHOFW*SHR_CONST_PI) - real(r8), dimension(pver) :: eff_rad_prof ! r^3 as calculated from grid mean MR & NC !---------------- ! Pointers @@ -774,7 +819,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) real(r8), pointer, dimension(:) :: ztodt_ptr real(r8), pointer, dimension(:,:) :: thlm ! Mean temperature real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! ice cloud fraction - real(r8), pointer, dimension(:,:) :: rcm ! CLUBB cld water mr real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio real(r8), pointer, dimension(:,:) :: cld ! CAM cloud fraction real(r8), pointer, dimension(:,:) :: alst ! CLUBB liq cloud fraction @@ -785,10 +829,50 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) real(r8), pointer, dimension(:,:) :: tke_in ! TKE real(r8), pointer, dimension(:,:) :: khzm_in ! Eddy diffusivity coef + + logical, parameter :: l_est_kessler_microphys = .false. + logical, parameter :: l_outfld_subcol = .false. + + 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 + !------------------------------------------------ + +#ifdef SILHS_OPENACC + if ( l_est_kessler_microphys ) then + call endrun('subcol_gen error: compilation with OpenACC requires l_est_kessler_microphys = .false.') + end if + + if ( subcol_SILHS_constrainmn ) then + call endrun('subcol_gen error: compilation with OpenACC requires subcol_SILHS_constrainmn = .false.') + end if + + if ( subcol_SILHS_weight ) then + call endrun('subcol_gen error: Importance sampling is not enabled for SILHS when using OpenACC. Set subcol_SILHS_weight to false.') + end if +#endif if (.not. allocated(state_sc%lat)) then call endrun('subcol_gen error: state_sc must be allocated before calling subcol_gen') end if + + if( rx_Nc ) then + call endrun('subcol_gen_SILHS: rx_Nc not enabled') + endif + + if (subcol_SILHS_meanice) then + call endrun('subcol_gen_SILHS: subcol_SILHS_meanice = T not currently available') + end if ! Determine num of columns and which chunk we're working on and what timestep ngrdcol = state%ngrdcol @@ -800,13 +884,32 @@ 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 !---------------- call pbuf_get_field(pbuf, thlm_idx, thlm) call pbuf_get_field(pbuf, ztodt_idx, ztodt_ptr) call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac) - call pbuf_get_field(pbuf, rcm_idx, rcm) call pbuf_get_field(pbuf, rtm_idx, rtm) call pbuf_get_field(pbuf, alst_idx, alst) call pbuf_get_field(pbuf, cld_idx, cld) @@ -817,19 +920,14 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call pbuf_get_field(pbuf, tke_idx, tke_in) call pbuf_get_field(pbuf, kvh_idx, khzm_in) - ! Read the clubb parameters in order to extract c_K. - call read_parameters_api( -99, "", clubb_params ) - ! 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 !---------------- ztodt = ztodt_ptr(1) - numsubcol_arr(:) = 0 ! Start over each chunk - numsubcol_arr(:ngrdcol) = subcol_SILHS_numsubcol ! Only set for valid grid columns - call subcol_set_subcols(state, tend, numsubcol_arr, state_sc, tend_sc) + num_subcols = subcol_SILHS_numsubcol ! The number of vertical grid levels used in CLUBB is pverp, which is originally ! set in the call to setup_clubb_core_api from subroutine clubb_ini_cam. This @@ -838,572 +936,752 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! levels and also uses the gr%nz object. The value of gr%nz needs to be reset ! for SILHS here and then set again for CLUBB in subroutine clubb_tend_cam. gr%nz = pverp - top_lev + 1 + + ! Calculate sample weights separately at all grid levels when + ! radiation is not called + l_calc_weights_all_levs_itime = .false. ! subcol_utils cannot compute weighted avgs + ! when the weights vary with height. + ! Don't set to true until this is fixed!! - !---------------- - ! Loop over all the active grid columns in the chunk - !---------------- - do i = 1, ngrdcol + + ! Setup the CLUBB vertical grid object. This must be done for each + ! column as the z-distance between hybrid pressure levels can + ! change easily. + ! Define the CLUBB momentum grid (in height, units of m) + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + zi_g(i,k) = state%zi(i,pverp-k+1)-state%zi(i,pverp) + end do + end do + - ! JHDBG: Big suspicion about that code - ! V. Larson: I don't know what happens to arrays allocated with size - ! num_subcols if num_subcols varies with the grid column. - num_subcols = numsubcol_arr(i) - stncol = 0 ! Each grid column needs to know how many subcolumns have gone by - do k = 1, i-1 - ! stncol = stncol + numsubcol_arr(i-1) - ! Eric Raut replaced i-1 with k in line immediately above. - stncol = stncol + numsubcol_arr(k) - enddo - - ! Setup the CLUBB vertical grid object. This must be done for each - ! column as the z-distance between hybrid pressure levels can - ! change easily. - sfc_elevation = state%zi(i,pverp) - ! Define the CLUBB momentum grid (in height, units of m) - do k = 1, pverp-top_lev+1 - zi_g(k) = state%zi(i,pverp-k+1)-sfc_elevation - enddo - ! Define the CLUBB thermodynamic grid (in units of m) - do k = 1, pver-top_lev+1 - zt_g(k+1) = state%zm(i,pver-k+1)-state%zi(i,pverp) - enddo - ! Thermodynamic ghost point is below surface - zt_g(1) = -1._r8*zt_g(2) - ! Calculate the distance between grid levels on the host model grid, - ! using host model grid indices. - do k = top_lev, pver - dz_g(k) = state%zi(i,k)-state%zi(i,k+1) - enddo - ! allocate grid object - call setup_grid_heights_api( l_implemented, grid_type, & - zi_g(2), zi_g(1), zi_g(1:pverp-top_lev+1), & - zt_g(1:pverp-top_lev+1) ) - - ! Inverse delta_zm is required for the 3-level L-scale averaging - do k = 1, pver-top_lev+1 - delta_zm(k+1) = state%zi(i,pverp-k)-state%zi(i,pverp-k+1) - invs_dzm(k+1) = 1.0_r8/delta_zm(k+1) - enddo - ! Handle CLUBB sub-sfc ghost point as done in clubb grid_class.F90 - delta_zm(1) = delta_zm(2) - invs_dzm(1) = invs_dzm(2) - - ! Compute dry static density on CLUBB vertical grid - do k = 1, pver-top_lev+1 - rho_ds_zt(k+1) = (1._r8/gravit)*state%pdel(i,pver-k+1)/dz_g(pver-k+1) - enddo - ! CLUBB ghost point under the surface - rho_ds_zt(1) = rho_ds_zt(2) - - ! Set up hydromet array, flipped from CAM vert grid to CLUBB - do k = 1, pver-top_lev+1 - if ( iirr > 0 ) then - ! If ixrain and family are greater than zero, then MG2 is - ! being used, and rain and snow are part of state. Otherwise, - ! diagnostic rain and snow from MG1 are used in hydromet. - if (ixrain > 0) then - hydromet(k+1,iirr) = state%q(i,pver-k+1,ixrain) - else - hydromet(k+1,iirr) = qrain(i,pver-k+1) - endif - endif - if ( iiNr > 0 ) then - if (ixnumrain > 0) then - hydromet(k+1,iiNr) = state%q(i,pver-k+1,ixnumrain) - else - hydromet(k+1,iiNr) = nrain(i,pver-k+1) - endif - endif - if ( iirs > 0 ) then - if (ixsnow > 0) then - hydromet(k+1,iirs) = state%q(i,pver-k+1,ixsnow) - else - hydromet(k+1,iirs) = qsnow(i,pver-k+1) - endif - endif - if ( iiNs > 0 ) then - if (ixnumsnow > 0) then - hydromet(k+1,iiNs) = state%q(i,pver-k+1,ixnumsnow) - else - hydromet(k+1,iiNs) = nsnow(i,pver-k+1) - endif - endif - if ( iiri > 0 ) then - hydromet(k+1,iiri) = state%q(i,pver-k+1,ixcldice) - endif - if ( iiNi > 0 ) then - hydromet(k+1,iiNi) = state%q(i,pver-k+1,ixnumice) - endif - - Ncm(k+1) = state%q(i,pver-k+1,ixnumliq) - - enddo - - do k = 1, hydromet_dim ! ghost point below the surface - hydromet(1,k) = hydromet(2,k) - enddo - - Ncm(1) = Ncm(2) - - do k = top_lev, pver - ! Calculate effective radius cubed, CAM-grid oriented for use in subcolumns - eff_rad_prof(k) = eff_rad_coef*state%q(i,k,ixcldliq)/state%q(i,k,ixnumliq) - ! Test a fixed effective radius - ! eff_rad_prof(k) = 5.12e-16_r8 ! 8 microns - enddo - - ! Allocate arrays for set_up_pdf_params_incl_hydromet - allocate( corr_array_1(pdf_dim, pdf_dim, pverp-top_lev+1) ) - allocate( corr_array_2(pdf_dim, pdf_dim, pverp-top_lev+1) ) - allocate( mu_x_1(pdf_dim, pverp-top_lev+1) ) - allocate( mu_x_2(pdf_dim, pverp-top_lev+1) ) - allocate( sigma_x_1(pdf_dim, pverp-top_lev+1) ) - allocate( sigma_x_2(pdf_dim, pverp-top_lev+1) ) - allocate( corr_cholesky_mtx_1(pdf_dim, pdf_dim, pverp-top_lev+1) ) - allocate( corr_cholesky_mtx_2(pdf_dim, pdf_dim, pverp-top_lev+1) ) - ! Allocate arrays for SILHS output - allocate( lh_sample_point_weights(pverp-top_lev+1,num_subcols) ) - allocate( X_mixt_comp_all_levs(pverp-top_lev+1,num_subcols) ) - allocate( X_nl_all_levs(pverp-top_lev+1,num_subcols,pdf_dim) ) - allocate( lh_rt_clipped(pverp-top_lev+1,num_subcols) ) - allocate( lh_thl_clipped(pverp-top_lev+1,num_subcols) ) - allocate( lh_rc_clipped(pverp-top_lev+1,num_subcols) ) - allocate( lh_rv_clipped(pverp-top_lev+1,num_subcols) ) - allocate( lh_Nc_clipped(pverp-top_lev+1,num_subcols) ) - ! Allocate arrays for output to either history files or for updating state_sc - allocate( rc_all_points(pverp-top_lev+1, num_subcols) ) - allocate( rain_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( nrain_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( snow_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( nsnow_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( w_all_points(pverp-top_lev+1, num_subcols) ) - ! allocate( RVM_lh_out(num_subcols, pverp) ) ! This one used only to update state - allocate( ice_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( nice_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( nclw_all_pts(pverp-top_lev+1, num_subcols) ) + ! Define the CLUBB thermodynamic grid (in units of m) + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + zt_g(i,k+1) = state%zm(i,pver-k+1)-state%zi(i,pverp) + + ! Thermodynamic ghost point is below surface + zt_g(i,1) = -1._r8*zt_g(i,2) + end do + end do + + do i=1, ncol + ! Set the elevation of the surface + sfc_elevation(i) = state%zi(i,pver+1) + end do + + ! Heights need to be set at each timestep. + call setup_grid_api( pverp+1-top_lev, ncol, sfc_elevation(1:ncol), l_implemented, & ! intent(in) + grid_type, zi_g(1:ncol,2), zi_g(1:ncol,1), zi_g(1:ncol,pverp+1-top_lev), & ! intent(in) + zi_g(1:ncol,:), zt_g(1:ncol,:), & ! intent(in) + gr ) - ! Convert from CAM vertical grid to CLUBB - do k = 1, pverp-top_lev+1 - rcm_in(k) = rcm(i,pverp-k+1) - ice_supersat_frac_in(k) = ice_supersat_frac(i,pverp-k+1) - enddo - do k = 1, pver-top_lev+1 - cld_frac_in(k+1) = alst(i,pver-k+1) - enddo - cld_frac_in(1) = cld_frac_in(2) ! Ghost pt below surface - ! Calculate a clubb-specific exner function - ! (This is grid mean, as pressure levels do not change in - ! the subcolumn state) - invs_exner(i,:) = ((state%pmid(i,:)/p0_clubb)**(rair/cpair)) - - ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS - ! Compute Num concentration of cloud nuclei - Nc_in_cloud = Ncm / max( cld_frac_in, cloud_frac_min ) - - ! The variable wphydrometp is only used when l_calc_w_corr is enabled. - ! The l_calc_w_corr flag is turned off by default, so wphydrometp will - ! simply be set to 0 to simplify matters. - wphydrometp = 0.0_r8 + ! Calculate the distance between grid levels on the host model grid, + ! using host model grid indices. + do k = top_lev, pver + do i = 1, ngrdcol + dz_g(i,k) = state%zi(i,k)-state%zi(i,k+1) + end do + end do + + ! Inverse delta_zm is required for the 3-level L-scale averaging + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + delta_zm(i,k+1) = state%zi(i,pverp-k)-state%zi(i,pverp-k+1) + + ! Handle CLUBB sub-sfc ghost point as done in clubb grid_class.F90 + delta_zm(i,1) = delta_zm(i,2) + end do + end do + + ! Compute dry static density on CLUBB vertical grid + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + rho_ds_zt(i,k+1) = (rga)*state%pdel(i,pverp-k)/dz_g(i,pverp-k) + + ! CLUBB ghost point under the surface + rho_ds_zt(i,1) = rho_ds_zt(i,2) + end do + end do + + ! Set up hydromet array, flipped from CAM vert grid to CLUBB + if ( iirr > 0 ) then + ! If ixrain and family are greater than zero, then MG2 is + ! being used, and rain and snow are part of state. Otherwise, + ! diagnostic rain and snow from MG1 are used in hydromet. + if (ixrain > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iirr) = state%q(i,pver-k+1,ixrain) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iirr) = qrain(i,pver-k+1) + end do + end do + endif + endif + + if ( iiNr > 0 ) then + if (ixnumrain > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNr) = state%q(i,pver-k+1,ixnumrain) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNr) = nrain(i,pver-k+1) + end do + end do + endif + endif + + if ( iirs > 0 ) then + if (ixsnow > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iirs) = state%q(i,pver-k+1,ixsnow) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iirs) = qsnow(i,pver-k+1) + end do + end do + endif + endif + + if ( iiNs > 0 ) then + if (ixnumsnow > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNs) = state%q(i,pver-k+1,ixnumsnow) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNs) = nsnow(i,pver-k+1) + end do + end do + endif + endif + + if ( iiri > 0 ) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiri) = state%q(i,pver-k+1,ixcldice) + end do + end do + endif + + if ( iiNi > 0 ) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNi) = state%q(i,pver-k+1,ixnumice) + end do + end do + endif + + do k = 1, hydromet_dim ! ghost point below the surface + do i = 1, ngrdcol + hydromet(i,1,k) = hydromet(i,2,k) + end do + end do + + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + Ncm(i,k+1) = state%q(i,pver-k+1,ixnumliq) + Ncm(i,1) = Ncm(i,2) + end do + end do + + ! Convert from CAM vertical grid to CLUBB + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + ice_supersat_frac_in(i,k) = ice_supersat_frac(i,pverp-k+1) + end do + end do + + + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + cld_frac_in(i,k+1) = alst(i,pver-k+1) + cld_frac_in(i,1) = cld_frac_in(i,2) ! Ghost pt below surface + end do + end do + + ! Calculate a clubb-specific exner function + ! (This is grid mean, as pressure levels do not change in + ! the subcolumn state) + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + invs_exner(i,k) = ((state%pmid(i,k)/p0_clubb)**(cappa)) + end do + end do - ! make the call - call setup_pdf_parameters_api( pverp-top_lev+1, pdf_dim, ztodt, & ! In - Nc_in_cloud, rcm_in, cld_frac_in, & ! In - ice_supersat_frac_in, hydromet, wphydrometp, & ! In - corr_array_n_cloud, corr_array_n_below, & ! In - pdf_params_chnk(i,lchnk), l_stats_samp, & ! 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 - hydrometp2, & ! Out - 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 - hydromet_pdf_params ) ! Out - - ! Calculate radiation only once in a while - ! l_rad_itime = (mod( itime, floor(dt_rad/dt_main) ) == 0 .or. itime == 1) - - ! Calculate sample weights separately at all grid levels when - ! radiation is not called - ! l_calc_weights_all_levs_itime = l_calc_weights_all_levs .and. .not. - ! l_rad_itime - l_calc_weights_all_levs_itime = .false. ! subcol_utils cannot compute weighted avgs - ! when the weights vary with height. - ! Don't set to true until this is fixed!! - - ! 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 - ! pbuf for use here. The profile of Lscale is passed into subroutine - ! generate_silhs_sample_api for use in calculating the vertical - ! correlation coefficient. Rather than output Lscale directly, its - ! value can be calculated from other fields that are already output to - ! pbuf. The equation relating Lscale to eddy diffusivity is: - ! - ! Kh = c_K * Lscale * sqrt( TKE ). - ! - ! Both Kh and TKE are written to the pbuf, and c_K is easily extracted - ! from CLUBB's tunable parameters. The equation for Lscale is: - ! - ! Lscale = Kh / ( c_K * sqrt( TKE ) ). - ! - ! Since Kh and TKE are output on momentum (interface) grid levels, the - ! resulting calculation of Lscale is also found on momentum levels. It - ! needs to be interpolated back to thermodynamic (midpoint) grid levels - ! for further use. - do k = 1, pverp-top_lev+1 - khzm(k) = khzm_in(i,pverp-k+1) - tke(k) = tke_in(i,pverp-k+1) - enddo - Lscale_zm = khzm / ( c_K * sqrt( max( tke, em_min ) ) ) - - ! Interpolate Lscale_zm back to thermodynamic grid levels. - Lscale = max( zm2zt_api( Lscale_zm ), 0.01_r8 ) - - ! Set the seed to the random number generator based on a quantity that - ! will be reproducible for restarts. - lh_seed = int( 1.0e4_r8 * rtm(i,pver), kind = genrand_intg ) - call genrand_init_api( put=lh_seed ) - - ! Let's generate some subcolumns!!!!! - call generate_silhs_sample_api & - ( iter, pdf_dim, num_subcols, sequence_length, pverp-top_lev+1, & ! In - l_calc_weights_all_levs_itime, & ! In - pdf_params_chnk(i,lchnk), delta_zm, rcm_in, Lscale, & ! In - rho_ds_zt, mu_x_1, mu_x_2, sigma_x_1, sigma_x_2, & ! In - corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! In - hydromet_pdf_params, silhs_config_flags, & ! In - clubb_config_flags%l_uv_nudge, & ! In - clubb_config_flags%l_tke_aniso, & ! In - clubb_config_flags%l_standard_term_ta, & ! In - clubb_config_flags%l_single_C2_Skw, & ! In - X_nl_all_levs, X_mixt_comp_all_levs, & ! Out - lh_sample_point_weights) ! Out - - ! Extract clipped variables from subcolumns - call clip_transform_silhs_output_api( pverp-top_lev+1, num_subcols, & ! In - pdf_dim, hydromet_dim, & ! In - X_mixt_comp_all_levs, & ! In - X_nl_all_levs, & ! In - pdf_params_chnk(i,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 - - ! Test subcolumns by comparing to an estimate of kessler autoconversion - call est_kessler_microphys_api & - ( pverp-top_lev+1, num_subcols, pdf_dim, X_nl_all_levs, & - pdf_params_chnk(i,lchnk), & - rcm_in, cld_frac_in, X_mixt_comp_all_levs, lh_sample_point_weights, & - silhs_config_flags%l_lh_importance_sampling, & - lh_AKm, AKm, AKstd, AKstd_cld, AKm_rcm, AKm_rcc, lh_rcm_avg) - - ! Calc column liquid water for output (rcm) - rc_all_points = lh_rc_clipped(:,:) - - if ( iiPDF_rr > 0 ) then - ! Calc subcolumn precipitating liq water for output (rrm) - rain_all_pts = real( X_nl_all_levs(:,:,iiPDF_rr), kind=r8 ) - end if - - if ( iiPDF_Nr > 0 ) then - ! Calc subcolumn number rain conc for output (nrainm) - nrain_all_pts = real( X_nl_all_levs(:,:,iiPDF_Nr), kind=r8 ) - end if - - if ( iiPDF_rs > 0 ) then - ! Calc subcolumn precipitating snow for output (rsm) - snow_all_pts = real( X_nl_all_levs(:,:,iiPDF_rs), kind=r8 ) - end if + ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS + ! Compute Num concentration of cloud nuclei + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + Nc_in_cloud(i,k) = Ncm(i,k) / max( cld_frac_in(i,k), cloud_frac_min ) + end do + end do - if ( iiPDF_Ns > 0 ) then - ! Calc subcolumn precipitating snow conc for output (Nsm) - nsnow_all_pts = real( X_nl_all_levs(:,:,iiPDF_Ns), kind=r8 ) - end if + ! The variable wphydrometp is only used when l_calc_w_corr is enabled. + ! The l_calc_w_corr flag is turned off by default, so wphydrometp will + ! simply be set to 0 to simplify matters. + wphydrometp = 0.0_r8 - if ( iiPDF_ri > 0 ) then - ! Calc subcolumn cloud ice mixing ratio - ice_all_pts = real( X_nl_all_levs(:,:,iiPDF_ri), kind=r8) - end if + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + khzm(i,k) = khzm_in(i,pverp-k+1) + end do + end do + + ! Allocate 2D arrays in precip_fracs for all grid columns and vertical levels + 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, 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 + ! pbuf for use here. The profile of Lscale is passed into subroutine + ! generate_silhs_sample_api for use in calculating the vertical + ! correlation coefficient. Rather than output Lscale directly, its + ! value can be calculated from other fields that are already output to + ! pbuf. The equation relating Lscale to eddy diffusivity is: + ! + ! Kh = c_K * Lscale * sqrt( TKE ). + ! + ! Both Kh and TKE are written to the pbuf, and c_K is easily extracted + ! from CLUBB's tunable parameters. The equation for Lscale is: + ! + ! Lscale = Kh / ( c_K * sqrt( TKE ) ). + ! + ! Since Kh and TKE are output on momentum (interface) grid levels, the + ! resulting calculation of Lscale is also found on momentum levels. It + ! needs to be interpolated back to thermodynamic (midpoint) grid levels + ! for further use. + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + tke(i,k) = tke_in(i,pverp-k+1) + end do + end do + + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + Lscale_zm(i,k) = khzm(i,k) / ( c_K * sqrt( max( tke(i,k), em_min ) ) ) + end do + end do - if ( iiPDF_Ni > 0 ) then - ! Calc subcolumn cloud ice number - nice_all_pts = real( X_nl_all_levs(:,:,iiPDF_Ni), kind=r8) - end if + do i = 1, ngrdcol + Lscale(i,1) = Lscale_zm(i,1) + ( Lscale_zm(i,2) - Lscale_zm(i,1) ) & + * ( zt_g(i,1) - zi_g(i,1) ) / ( zi_g(i,2) - zi_g(i,1) ) + end do + + do k = 2, pverp-top_lev+1 + do i = 1, ngrdcol + Lscale(i,k) = Lscale_zm(i,k-1) + ( Lscale_zm(i,k) - Lscale_zm(i,k-1) ) & + * ( zt_g(i,k) - zi_g(i,k-1) ) / ( zi_g(i,k) - zi_g(i,k-1) ) + end do + end do + + do k = 2, pverp-top_lev+1 + do i = 1, ngrdcol + Lscale(i,:) = max( Lscale(i,:), 0.01_r8 ) + end do + end do + + !$acc data create( X_mixt_comp_all_levs, X_nl_all_levs, lh_rc_clipped, lh_Nc_clipped, & + !$acc& lh_sample_point_weights, lh_rt_clipped, lh_rt_clipped, & + !$acc& lh_rv_clipped, lh_thl_clipped, THL_lh_out, & + !$acc& RT_lh_out, RCM_lh_out, NCLW_lh_out, ICE_lh_out, & + !$acc& NICE_lh_out, RVM_lh_out, THL_lh_out, RAIN_lh_out, & + !$acc& NRAIN_lh_out, SNOW_lh_out, NSNOW_lh_out, WM_lh_out, & + !$acc& OMEGA_lh_out ) & + !$acc& copyin( state, state%zm, state%phis, rho_ds_zt, invs_exner ) & + !$acc& copyout( state%t, state%s, state%omega, state_sc%q ) + !$acc& async(1) + + ! Set the seed to the random number generator based on a quantity that + ! will be reproducible for restarts. + lh_seed = int( 1.0e4_r8 * rtm(1,pver), kind = genrand_intg ) + + ! Let's generate some subcolumns!!!!! + call generate_silhs_sample_api( & + 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, 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 + vert_decorr_coef, & ! In + stats_metadata, & ! In + stats_lh_zt, stats_lh_sfc, & ! InOut + X_nl_all_levs, X_mixt_comp_all_levs, & ! Out + lh_sample_point_weights) ! Out + + ! Extract clipped variables from subcolumns + call clip_transform_silhs_output_api( gr, pverp-top_lev+1, ngrdcol, num_subcols, & ! In + pdf_dim, hydromet_dim, 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 + call endrun('subcol_SILHS: l_est_kessler_microphys = T is not currently supported') + end if - ! Calc subcolumn vert velocity for output (wm) - w_all_points = real( X_nl_all_levs(:,:,iiPDF_w), kind=r8 ) - ! Calc cloud liq water number conc - nclw_all_pts = lh_Nc_clipped(:,:) - ! Calc mean liquid water potential temp for clear air - !call THL_profile(pver, state%t(i,:), invs_exner(i,:), No_cloud, Temp_prof) - - ! Calc effective cloud fraction for testing - eff_cldfrac(:,:) = 0.0_r8 - do k = top_lev, pver - do j=1, num_subcols - - if ( ( rc_all_points(pverp-k+1,j) .gt. qsmall ) & - .or. ( ice_all_pts(pverp-k+1,j) .gt. qsmall ) ) then - eff_cldfrac(i,k) = eff_cldfrac(i,k)+lh_sample_point_weights(pverp-k+1,j) - endif - enddo - - eff_cldfrac(i,k) = eff_cldfrac(i,k)/real(num_subcols, kind=r8) - enddo - - ! Pack precip_frac for output - do k = 2, pverp-top_lev+1 - precip_frac_out(i,pver-k+2) = hydromet_pdf_params(k)%precip_frac - enddo - - ! Pack up weights for output - do j = 1, num_subcols - if (subcol_SILHS_weight) then - weights(stncol+j) = lh_sample_point_weights(2,j) ! Using grid level 2 always won't work - ! if weights vary with height. - else - weights(stncol+j) = 1._r8 - endif - enddo + !------------------------------------------------------------------------- + ! Convert from CLUBB vertical grid to CAM grid + !------------------------------------------------------------------------ + ! This kernel is executed in stream 1: + !$acc parallel loop collapse(3) default(present) async(1) + do k = top_lev, pverp + do j = 1, num_subcols + do i = 1, ngrdcol + RT_lh_out( num_subcols*(i-1)+j,k ) = lh_rt_clipped(i,j,pverp-k+1) + RCM_lh_out( num_subcols*(i-1)+j,k ) = lh_rc_clipped(i,j,pverp-k+1) + NCLW_lh_out( num_subcols*(i-1)+j,k ) = lh_Nc_clipped(i,j,pverp-k+1) + RVM_lh_out( num_subcols*(i-1)+j,k ) = lh_rv_clipped(i,j,pverp-k+1) + THL_lh_out( num_subcols*(i-1)+j,k ) = lh_thl_clipped(i,j,pverp-k+1) + end do + end do + end do + + ! This kernel is executed in stream 2: + !$acc parallel loop collapse(3) default(present) async(2) + do k = top_lev, pverp + do j = 1, num_subcols + do i = 1, ngrdcol + ICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_ri) + NICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Ni) + RAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_rr) + NRAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Nr) + SNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_rs) + NSNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Ns) + WM_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_w) + end do + end do + end do + + ! This kernel is executed in stream 2 because WM_lh_out comes from stream 2: + !$acc parallel loop collapse(3) default(present) async(2) + do k = top_lev, pverp + do j = 1, num_subcols + do i = 1, ngrdcol + OMEGA_lh_out( num_subcols*(i-1)+j,k ) = -1._r8 * WM_lh_out(num_subcols*(i-1)+j,k) & + * rho_ds_zt(i,pverp-k+1) * gravit + end do + end do + end do + + if ( l_est_kessler_microphys ) then + do k = top_lev, pverp + do j = 1, num_subcols + do i = 1, ngrdcol + AKm_out(i,k) = AKm(i,pverp-k+1) + lh_AKm_out(i,k) = lh_AKm(i,pverp-k+1) + end do + end do + end do + end if - ! Convert from CLUBB vertical grid to CAM grid for history output and - ! Updating state variables - do k = top_lev, pverp - do j = 1, num_subcols - RT_lh_out( stncol+j,k ) = lh_rt_clipped(pverp-k+1,j) - RCM_lh_out( stncol+j,k ) = rc_all_points(pverp-k+1,j) - NCLW_lh_out( stncol+j,k ) = nclw_all_pts(pverp-k+1,j) - ICE_lh_out( stncol+j,k ) = ice_all_pts(pverp-k+1,j) - NICE_lh_out( stncol+j,k ) = nice_all_pts(pverp-k+1,j) -! RVM_lh_out(j,k) = RT_lh_out(stncol+j,k)-RCM_lh_out(stncol+j,k)-ICE_lh_out(stncol+j,k) - RVM_lh_out( stncol+j,k ) = lh_rv_clipped(pverp-k+1,j) - THL_lh_out( stncol+j,k ) = lh_thl_clipped(pverp-k+1,j) - RAIN_lh_out( stncol+j,k ) = rain_all_pts(pverp-k+1,j) - NRAIN_lh_out( stncol+j,k ) = nrain_all_pts(pverp-k+1,j) - SNOW_lh_out( stncol+j,k ) = snow_all_pts(pverp-k+1,j) - NSNOW_lh_out( stncol+j,k ) = nsnow_all_pts(pverp-k+1,j) - WM_lh_out( stncol+j,k ) = w_all_points(pverp-k+1,j) - OMEGA_lh_out( stncol+j,k ) = -1._r8*WM_lh_out(stncol+j,k)*rho_ds_zt(pverp-k+1)*gravit - AKm_out(i,k) = AKm(pverp-k+1) - lh_AKm_out(i,k) = lh_AKm(pverp-k+1) - enddo - enddo - - ! Constrain the sample distribution of cloud water and ice to the same mean - ! as the grid to prevent negative condensate errors - if(subcol_SILHS_constrainmn) then - call subcol_constrainmn( num_subcols, ICE_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixcldice), meansc_ice(i,:), stdsc_ice(i,:) ) - if ( ixrain > 0 ) & - call subcol_constrainmn( num_subcols, RAIN_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixrain) ) - if ( ixsnow > 0 ) & - call subcol_constrainmn( num_subcols, SNOW_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixsnow) ) - call subcol_constrainmn( num_subcols, RCM_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixcldliq), meansc_liq(i,:), stdsc_liq(i,:) ) - call subcol_constrainmn( num_subcols, RVM_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixq), meansc_vap(i,:), stdsc_vap(i,:) ) - call subcol_constrainmn( num_subcols, NICE_lh_out(stncol+1:stncol+num_subcols,:), & + ! Pack up weights + ! Using grid level 2 always won't work if weights vary with height. + call subcol_pack(lchnk, lh_sample_point_weights(:,:,2), weights ) + call subcol_set_weight(lchnk, weights) + + ! Constrain the sample distribution of cloud water and ice to the same mean + ! as the grid to prevent negative condensate errors + if(subcol_SILHS_constrainmn) then + + do i = 1, ngrdcol + + stncol = num_subcols*(i-1) + + call subcol_constrainmn( num_subcols, ICE_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixcldice), meansc_ice(i,:), stdsc_ice(i,:) ) + if ( ixrain > 0 ) & + call subcol_constrainmn( num_subcols, RAIN_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixrain) ) + if ( ixsnow > 0 ) & + call subcol_constrainmn( num_subcols, SNOW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixsnow) ) + call subcol_constrainmn( num_subcols, RCM_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixcldliq), meansc_liq(i,:), stdsc_liq(i,:) ) + call subcol_constrainmn( num_subcols, RVM_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixq), meansc_vap(i,:), stdsc_vap(i,:) ) + call subcol_constrainmn( num_subcols, NICE_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumice) ) + if ( ixnumrain > 0 ) & + call subcol_constrainmn( num_subcols, NRAIN_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumrain) ) + if ( ixnumsnow > 0 ) & + call subcol_constrainmn( num_subcols, NSNOW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumsnow) ) + call subcol_constrainmn( num_subcols, NCLW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumliq) ) + do k = top_lev, pver + ! Look for exceptionally large values of condensate + if(ANY(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8)) then + ! Clip the large values + where(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8) + ICE_lh_out(stncol+1:stncol+num_subcols,k) = 0.01_r8 + NICE_lh_out(stncol+1:stncol+num_subcols,k) = 1.5e+7_r8 + end where + ! Recalculate the weighted subcolumn mean + tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumice) ) - if ( ixnumrain > 0 ) & - call subcol_constrainmn( num_subcols, NRAIN_lh_out(stncol+1:stncol+num_subcols,:), & + real(num_subcols,r8) ) + ! Calculate the difference between the weighted mean and grid mean + diff_mean = state%q(i,k,ixcldice)-tmp_mean + ! Add the difference to each subcolumn + ICE_lh_out(stncol+1:stncol+num_subcols,k) = & + ICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean + ! Recalculate the weight subcolumn mean for ice num conc + tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumrain) ) - if ( ixnumsnow > 0 ) & - call subcol_constrainmn( num_subcols, NSNOW_lh_out(stncol+1:stncol+num_subcols,:), & + real(num_subcols,r8) ) + ! Calculate the difference between the weighted mean and grid mean + diff_mean = state%q(i,k,ixnumice)-tmp_mean + ! Add the difference to each subcolumn + if(diff_mean.gt.0.0_r8) then + NICE_lh_out(stncol+1:stncol+num_subcols,k) = & + NICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean + else ! just use the grid mean in each subcolumn + NICE_lh_out(stncol+1:stncol+num_subcols,k) = & + state%q(i,k,ixnumice) + end if + ! Test adjusted means for debugging + tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumsnow) ) - call subcol_constrainmn( num_subcols, NCLW_lh_out(stncol+1:stncol+num_subcols,:), & + real(num_subcols,r8) ) + diff_mean = state%q(i,k,ixcldice)-tmp_mean + tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumliq) ) - do k = top_lev, pver - ! Look for exceptionally large values of condensate - if(ANY(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8)) then - ! Clip the large values - where(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8) - ICE_lh_out(stncol+1:stncol+num_subcols,k) = 0.01_r8 - NICE_lh_out(stncol+1:stncol+num_subcols,k) = 1.5e+7_r8 - end where - ! Recalculate the weighted subcolumn mean - tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - ! Calculate the difference between the weighted mean and grid mean - diff_mean = state%q(i,k,ixcldice)-tmp_mean - ! Add the difference to each subcolumn - ICE_lh_out(stncol+1:stncol+num_subcols,k) = & - ICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean - ! Recalculate the weight subcolumn mean for ice num conc - tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - ! Calculate the difference between the weighted mean and grid mean - diff_mean = state%q(i,k,ixnumice)-tmp_mean - ! Add the difference to each subcolumn - if(diff_mean.gt.0.0_r8) then - NICE_lh_out(stncol+1:stncol+num_subcols,k) = & - NICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean - else ! just use the grid mean in each subcolumn - NICE_lh_out(stncol+1:stncol+num_subcols,k) = & - state%q(i,k,ixnumice) - end if - ! Test adjusted means for debugging - tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - diff_mean = state%q(i,k,ixcldice)-tmp_mean - tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - diff_mean = state%q(i,k,ixnumice)-tmp_mean - endif - enddo ! k = top_lev, pver - endif ! subcol_silhs_constrainm - - ! Code to update the state variables for interactive runs - ! Set state variables - do j = 1, numsubcol_arr(i) - - call Abs_Temp_profile( pver-top_lev+1, THL_lh_out(stncol+j,top_lev:pver), & - invs_exner(i,top_lev:pver), RCM_lh_out(stncol+j,top_lev:pver), & - Temp_prof(top_lev:pver) ) - state_sc%t(stncol+j,top_lev:pver) = Temp_prof(top_lev:pver) - call StaticEng_profile( pver-top_lev+1, Temp_prof(top_lev:pver), & - state%zm(i,top_lev:pver), state%phis(i), & - SE_prof(top_lev:pver) ) - state_sc%s(stncol+j,top_lev:pver) = SE_prof(top_lev:pver) - + real(num_subcols,r8) ) + diff_mean = state%q(i,k,ixnumice)-tmp_mean + endif + end do ! k = top_lev, pver + end do + endif ! subcol_silhs_constrainm + + + !--------------------------------------------------- + ! Updating state variables + !--------------------------------------------------- + ! Code to update the state variables for interactive runs + ! This kernel is executed in stream 3, but waits for stream 1 + ! because THL_lh_out and RCM_lh_out come from stream 1: + !$acc parallel loop collapse(3) default(present) wait(1) async(3) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + + state_sc%t(num_subcols*(i-1)+j,k) = THL_lh_out(num_subcols*(i-1)+j,k) * invs_exner(i,k) & + + Lv * RCM_lh_out(num_subcols*(i-1)+j,k) / Cp + + state_sc%s(num_subcols*(i-1)+j,k) = cpair * state_sc%t(num_subcols*(i-1)+j,k) & + + gravit * state%zm(i,k) + state%phis(i) + end do + end do + end do + + ! This kernel is executed in stream 4, but waits for stream 1 and 2 + ! because RVM_lh_out is from stream 1 and OMEGA_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(1,2) async(4) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol ! Vertical Velocity is not part of the energy conservation checks, but ! we need to be careful here, because the SILHS output VV is noisy. - state_sc%omega(stncol+j,top_lev:pver) = OMEGA_lh_out(stncol+j,top_lev:pver) - state_sc%q(stncol+j,top_lev:pver,ixq) = RVM_lh_out(stncol+j,top_lev:pver) - - if( rx_Nc ) then - call endrun('subcol_gen_SILHS: rx_Nc not enabled') - endif - - - if (subcol_SILHS_meanice) then - call endrun('subcol_gen_SILHS: subcol_SILHS_meanice = T not currently available') - state_sc%q(stncol+j,top_lev:pver,ixcldice) = state%q(i,top_lev:pver,ixcldice) - state_sc%q(stncol+j,top_lev:pver,ixnumice) = state%q(i,top_lev:pver,ixnumice) - state_sc%q(stncol+j,top_lev:pver,ixcldliq) = RCM_lh_out(stncol+j,top_lev:pver) - state_sc%q(stncol+j,top_lev:pver,ixnumliq) = NCLW_lh_out(stncol+j,top_lev:pver) - else - if (subcol_SILHS_q_to_micro) then ! Send SILHS predicted constituents to microp - state_sc%q(stncol+j,top_lev:pver,ixcldliq) = RCM_lh_out(stncol+j,top_lev:pver) - state_sc%q(stncol+j,top_lev:pver,ixcldice) = ICE_lh_out(stncol+j,top_lev:pver) - if (ixrain > 0) & - state_sc%q(stncol+j,top_lev:pver,ixrain) = RAIN_lh_out(stncol+j,top_lev:pver) - if (ixsnow > 0) & - state_sc%q(stncol+j,top_lev:pver,ixsnow) = SNOW_lh_out(stncol+j,top_lev:pver) - else - state_sc%q(stncol+j,top_lev:pver,ixcldliq) = state%q(i,top_lev:pver,ixcldliq) - state_sc%q(stncol+j,top_lev:pver,ixcldice) = state%q(i,top_lev:pver,ixcldice) - if (ixrain > 0) & - state_sc%q(stncol+j,top_lev:pver,ixrain) = state%q(i,top_lev:pver,ixrain) - if (ixsnow > 0) & - state_sc%q(stncol+j,top_lev:pver,ixsnow) = state%q(i,top_lev:pver,ixsnow) - endif - if (subcol_SILHS_n_to_micro) then ! Send SILHS predicted number conc to microp - state_sc%q(stncol+j,top_lev:pver,ixnumice) = NICE_lh_out(stncol+j,top_lev:pver) - state_sc%q(stncol+j,top_lev:pver,ixnumliq) = NCLW_lh_out(stncol+j,top_lev:pver) - if (ixnumrain > 0) & - state_sc%q(stncol+j,top_lev:pver,ixnumrain) = NRAIN_lh_out(stncol+j,top_lev:pver) - if (ixnumsnow > 0) & - state_sc%q(stncol+j,top_lev:pver,ixnumsnow) = NSNOW_lh_out(stncol+j,top_lev:pver) - else - state_sc%q(stncol+j,top_lev:pver,ixnumliq) = state%q(i,top_lev:pver,ixnumliq) - state_sc%q(stncol+j,top_lev:pver,ixnumice) = state%q(i,top_lev:pver,ixnumice) - if (ixnumrain > 0) & - state_sc%q(stncol+j,top_lev:pver,ixnumrain) = state%q(i,top_lev:pver,ixnumrain) - if (ixnumsnow > 0) & - state_sc%q(stncol+j,top_lev:pver,ixnumsnow) = state%q(i,top_lev:pver,ixnumsnow) - endif - endif ! meanice + state_sc%omega(num_subcols*(i-1)+j,k) = OMEGA_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixq) = RVM_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + + if (subcol_SILHS_q_to_micro) then ! Send SILHS predicted constituents to microp + + ! This kernel is executed in stream 5, but waits for stream 1 and 2 + ! because RCM_lh_out is from stream 1 and ICE_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(1,2) async(5) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = RCM_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = ICE_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + + if (ixrain > 0) then + ! This kernel is executed in stream 6, but waits for stream 2 + ! because RAIN_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(6) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixrain) = RAIN_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + if (ixsnow > 0) then + ! This kernel is executed in stream 7, but waits for stream 2 + ! because SNOW_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(7) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = SNOW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + else + + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = state%q(i,k,ixcldliq) + state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = state%q(i,k,ixcldice) + if (ixrain > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixrain) = state%q(i,k,ixrain) + end if + if (ixsnow > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = state%q(i,k,ixsnow) + end if + end do + end do + end do + + endif + + if (subcol_SILHS_n_to_micro) then ! Send SILHS predicted number conc to microp + + ! This kernel is executed in stream 8, but waits for stream 1 and 2 + ! because NCLW_lh_out is from stream 1 and NICE_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(1,2) async(8) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = NICE_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = NCLW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + + if (ixnumrain > 0) then + ! This kernel is executed in stream 9, but waits for stream 2 + ! because NRAIN_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(9) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = NRAIN_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + if (ixnumsnow > 0) then + ! This kernel is executed in stream 10, but waits for stream 2 + ! because NSNOW_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(10) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = NSNOW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + else + + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = state%q(i,k,ixnumliq) + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = state%q(i,k,ixnumice) + if (ixnumrain > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = state%q(i,k,ixnumrain) + end if + if (ixnumsnow > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = state%q(i,k,ixnumsnow) + end if + end do + end do + end do + + endif + + ! This kernel is executed in stream 8, because state_sc%q(:,:,ixnumliq) and + ! state_sc%q(:,:,ixnumice) are from stream 8 + !$acc parallel loop collapse(3) default(present) async(8) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol ! Change liq and ice (and rain and snow) num conc zeros to min values (1e-12) - where (state_sc%q(stncol+j,top_lev:pver,ixnumliq) .lt. min_num_conc) - state_sc%q(stncol+j,top_lev:pver,ixnumliq) = min_num_conc - end where - where (state_sc%q(stncol+j,top_lev:pver,ixnumice) .lt. min_num_conc) - state_sc%q(stncol+j,top_lev:pver,ixnumice) = min_num_conc - end where - if (ixnumrain > 0) then - where(state_sc%q(stncol+j,top_lev:pver,ixnumrain) .lt. min_num_conc) - state_sc%q(stncol+j,top_lev:pver,ixnumrain) = min_num_conc - end where - endif - if (ixnumsnow > 0) then - where(state_sc%q(stncol+j,top_lev:pver,ixnumsnow) .lt. min_num_conc) - state_sc%q(stncol+j,top_lev:pver,ixnumsnow) = min_num_conc - end where - endif + if (state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = min_num_conc + end if + + if (state_sc%q(num_subcols*(i-1)+j,k,ixnumice) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = min_num_conc + end if + end do + end do + end do + + if (ixnumrain > 0) then + ! This kernel is executed in stream 9, because state_sc%q(:,:,ixnumrain) is + ! from stream 9 + !$acc parallel loop collapse(3) default(present) async(9) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + if(state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = min_num_conc + end if + end do + end do + end do + endif + + if (ixnumsnow > 0) then + ! This kernel is executed in stream 10, because state_sc%q(:,:,ixnumsnow) is + ! from stream 10 + !$acc parallel loop collapse(3) default(present) async(10) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + if(state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = min_num_conc + end if + end do + end do + end do + endif + + if ( l_outfld_subcol ) then + + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + do j = 1, num_subcols - enddo - - ! Only use weights if namelist variable turned on - if (subcol_SILHS_weight) call subcol_set_weight(state_sc%lchnk, weights) - - - ! Deallocate the dynamic arrays used - deallocate( lh_sample_point_weights, X_mixt_comp_all_levs, & - X_nl_all_levs, lh_rt_clipped, lh_thl_clipped, lh_rc_clipped, & - lh_rv_clipped, lh_Nc_clipped, & - corr_array_1, corr_array_2, mu_x_1, mu_x_2, sigma_x_1, & - sigma_x_2, corr_cholesky_mtx_1, corr_cholesky_mtx_2 ) - ! deallocate( RVM_lh_out ) - deallocate( rc_all_points, rain_all_pts, nrain_all_pts, snow_all_pts, nsnow_all_pts, ice_all_pts, & - nice_all_pts, nclw_all_pts, w_all_points ) - enddo ! ngrdcol - - call outfld( 'SILHS_THLM_SCOL', THL_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RT_SCOL', RT_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_OMEGA_SCOL', OMEGA_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_WM_SCOL', WM_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RCM_SCOL', RCM_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RICLD_SCOL', ICE_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NICLD_SCOL', NICE_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NCLD_SCOL', NCLW_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RRAIN_SCOL', RAIN_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NRAIN_SCOL', NRAIN_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_WEIGHT_SCOL', weights, pcols*psubcols, lchnk ) - call outfld( 'NR_IN_LH', nrain, pcols, lchnk ) - call outfld( 'RTM_CLUBB', rtm, pcols, lchnk ) - call outfld( 'THLM_CLUBB', thlm, pcols, lchnk ) - call outfld( 'SILHS_QC_IN', state%q(:,:,ixcldliq), pcols, lchnk ) - call outfld( 'SILHS_QI_IN', state%q(:,:,ixcldice), pcols, lchnk ) - call outfld( 'SILHS_NC_IN', state%q(:,:,ixnumliq), pcols, lchnk ) - call outfld( 'SILHS_NI_IN', state%q(:,:,ixnumice), pcols, lchnk ) - call outfld( 'AKM_CLUBB', AKm_out, pcols, lchnk ) - call outfld( 'AKM_LH_CLUBB', lh_AKm_out, pcols, lchnk ) - call outfld( 'INVS_EXNER', invs_exner, pcols, lchnk ) - call outfld( 'SILHS_ZTODT', ztodt_ptr, pcols, lchnk ) - if ( subcol_SILHS_constrainmn ) then - call outfld( 'SILHS_MSC_CLDICE', meansc_ice, pcols, lchnk ) - call outfld( 'SILHS_STDSC_CLDICE', stdsc_ice, pcols, lchnk ) - if ( ixsnow > 0 ) then + ! Calc effective cloud fraction for testing + if ( ( lh_rc_clipped(i,j,pverp-k+1) .gt. qsmall ) & + .or. ( X_nl_all_levs(i,j,pverp-k+1,iiPDF_ri) .gt. qsmall ) ) then + eff_cldfrac(i,k) = eff_cldfrac(i,k) + lh_sample_point_weights(i,j,pverp-k+1) + else + eff_cldfrac(i,k) = 0.0_r8 + endif + + end do + + eff_cldfrac(i,k) = eff_cldfrac(i,k)/real(num_subcols, kind=r8) + + end do + end do + + ! Pack precip_frac for output + do k = 2, pverp-top_lev+1 + do i = 1, ngrdcol + precip_frac_out(i,pver-k+2) = precip_fracs%precip_frac(i,k) + end do + end do + + call outfld( 'SILHS_THLM_SCOL', THL_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RT_SCOL', RT_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_OMEGA_SCOL', OMEGA_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_WM_SCOL', WM_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RCM_SCOL', RCM_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RICLD_SCOL', ICE_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NICLD_SCOL', NICE_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NCLD_SCOL', NCLW_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RRAIN_SCOL', RAIN_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NRAIN_SCOL', NRAIN_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_WEIGHT_SCOL', weights, pcols*psubcols, lchnk ) + call outfld( 'NR_IN_LH', nrain, pcols, lchnk ) + call outfld( 'SILHS_RTM', rtm, pcols, lchnk ) + call outfld( 'SILHS_THLM', thlm, pcols, lchnk ) + call outfld( 'SILHS_QC_IN', state%q(:,:,ixcldliq), pcols, lchnk ) + call outfld( 'SILHS_QI_IN', state%q(:,:,ixcldice), pcols, lchnk ) + call outfld( 'SILHS_NC_IN', state%q(:,:,ixnumliq), pcols, lchnk ) + call outfld( 'SILHS_NI_IN', state%q(:,:,ixnumice), pcols, lchnk ) + if ( l_est_kessler_microphys ) then + call outfld( 'AKM_CLUBB', AKm_out, pcols, lchnk ) + call outfld( 'AKM_LH_CLUBB', lh_AKm_out, pcols, lchnk ) + end if + call outfld( 'INVS_EXNER', invs_exner, pcols, lchnk ) + call outfld( 'SILHS_ZTODT', ztodt_ptr, pcols, lchnk ) + if ( subcol_SILHS_constrainmn ) then + call outfld( 'SILHS_MSC_CLDICE', meansc_ice, pcols, lchnk ) + call outfld( 'SILHS_STDSC_CLDICE', stdsc_ice, pcols, lchnk ) + if ( ixsnow > 0 ) then call outfld( 'SILHS_MSC_CLDLIQ', meansc_liq, pcols, lchnk ) call outfld( 'SILHS_STDSC_CLDLIQ', stdsc_liq, pcols, lchnk ) call outfld( 'SILHS_MSC_Q', meansc_vap, pcols, lchnk ) call outfld( 'SILHS_STDSC_Q', stdsc_vap, pcols, lchnk ) - endif ! ixsnow > 0 - endif ! subcol_SILHS_constrainmn - call outfld( 'SILHS_EFF_CLDFRAC', eff_cldfrac, pcols, lchnk ) - call outfld( 'SILHS_CLUBB_PRECIP_FRAC', precip_frac_out, pcols, lchnk ) - call outfld( 'SILHS_CLUBB_ICE_SS_FRAC', ice_supersat_frac, pcols, lchnk ) + endif ! ixsnow > 0 + endif ! subcol_SILHS_constrainmn + call outfld( 'SILHS_EFF_CLDFRAC', eff_cldfrac, pcols, lchnk ) + call outfld( 'SILHS_CLUBB_PRECIP_FRAC', precip_frac_out, pcols, lchnk ) + call outfld( 'SILHS_CLUBB_ICE_SS_FRAC', ice_supersat_frac, pcols, lchnk ) + end if + + !$acc end data + !$acc wait #endif #endif @@ -1443,10 +1721,12 @@ subroutine subcol_SILHS_var_covar_driver & use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field #ifdef CLUBB_SGS #ifdef SILHS - use ref_pres, only: top_lev => trop_cloud_top_lev use subcol_utils, only: subcol_get_weight use subcol_pack_mod, only: subcol_unpack, subcol_get_nsubcol - use clubb_api_module, only: T_in_K2thlm_api + use clubb_api_module, only: T_in_K2thlm_api, & + init_pdf_params_api, & + copy_multi_pdf_params_to_single,& + pdf_parameter use silhs_api_module, only: lh_microphys_var_covar_driver_api #endif #endif @@ -1484,9 +1764,9 @@ subroutine subcol_SILHS_var_covar_driver & real(r8), dimension(pcols,psubcols,pver ) :: exner ! Inputs to lh_microphys_var_covar_driver - real(r8), dimension(pcols,pverp,psubcols) :: rt_all_clubb, thl_all_clubb, w_all_clubb, & + real(r8), dimension(pcols,psubcols,pverp) :: rt_all_clubb, thl_all_clubb, w_all_clubb, & qctend_clubb, qvtend_clubb, thltend_clubb - real(r8), dimension(pcols,pverp-top_lev+1,psubcols) :: height_depndt_weights + real(r8), dimension(pcols,psubcols,pverp-top_lev+1) :: height_depndt_weights ! Outputs from lh_microphys_var_covar_driver real(r8), dimension(:,:), pointer :: rtp2_mc_zt, thlp2_mc_zt, wprtp_mc_zt, & @@ -1499,8 +1779,12 @@ subroutine subcol_SILHS_var_covar_driver & wprtp_mc_zt_idx, & wpthlp_mc_zt_idx, & rtpthlp_mc_zt_idx + + type(pdf_parameter) :: pdf_params_single_col !----- Begin Code ----- + + call init_pdf_params_api( pverp+1-top_lev, 1, pdf_params_single_col ) ! Don't do anything if this option isn't enabled. if ( .not. subcol_SILHS_var_covar_src ) return @@ -1558,8 +1842,8 @@ subroutine subcol_SILHS_var_covar_driver & ! Compute dry static density on CLUBB vertical grid do k = top_lev, pver dz_g(igrdcol,isubcol,k) = zi_all(igrdcol,isubcol,k) - zi_all(igrdcol,isubcol,k+1) ! thickness - rho(igrdcol,isubcol,k) = (1._r8/gravit)*pdel_all(igrdcol,isubcol,k)/dz_g(igrdcol,isubcol,k) - enddo + rho(igrdcol,isubcol,k) = (rga)*pdel_all(igrdcol,isubcol,k)/dz_g(igrdcol,isubcol,k) + end do ! Compute w from omega w_all(igrdcol,isubcol,top_lev:pver) = -omega_all(igrdcol,isubcol,top_lev:pver) & @@ -1575,7 +1859,7 @@ subroutine subcol_SILHS_var_covar_driver & t_all(igrdcol,isubcol,k) = ( s_all(igrdcol,isubcol,k) & - gravit * zm_all(igrdcol,isubcol,k) & - phis_all(igrdcol,isubcol) ) / cpair - enddo ! k = 1, pver + end do ! k = 1, pver ! This formula is taken from earlier in this file. exner(igrdcol,isubcol,top_lev:pver) & @@ -1590,7 +1874,7 @@ subroutine subcol_SILHS_var_covar_driver & thl_all(igrdcol,isubcol,k) & = T_in_K2thlm_api( t_all(igrdcol,isubcol,k), exner(igrdcol,isubcol,k), & rc_all(igrdcol,isubcol,k) ) - enddo ! k = 1, pver + end do ! k = 1, pver ! Add ghost points rt_all (igrdcol,isubcol,pverp) = rt_all (igrdcol,isubcol,pver) @@ -1601,15 +1885,15 @@ subroutine subcol_SILHS_var_covar_driver & thltend(igrdcol,isubcol,pverp) = thltend(igrdcol,isubcol,pver) ! Flip inputs to CLUBB's grid. Note the dimension ordering change. - rt_all_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pverp) ) - thl_all_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pverp) ) - w_all_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pverp) ) - qctend_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pverp) ) - qvtend_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pverp) ) - thltend_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pverp) ) + rt_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pverp) ) + thl_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pverp) ) + w_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pverp) ) + qctend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pverp) ) + qvtend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pverp) ) + thltend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pverp) ) - enddo ! isubcol = 1, nsubcol(igrdcol) - enddo ! igrdcol = 1, ngrdcol + end do ! isubcol = 1, nsubcol(igrdcol) + end do ! igrdcol = 1, ngrdcol ! Obtain weights call subcol_get_weight(lchnk, weights_packed) @@ -1623,16 +1907,22 @@ subroutine subcol_SILHS_var_covar_driver & ! It will have to change once the weights vary with altitude! ! I'm not sure whether the grid will need to be flipped. do k = 1, pverp-top_lev+1 - height_depndt_weights(igrdcol,k,1:ns) = weights(igrdcol,1:ns) + height_depndt_weights(igrdcol,1:ns,k) = weights(igrdcol,1:ns) end do + ! Copy the igrdcol column from the multicolumn pdf_params_chnk to the single column + ! version of pdf_params_single_col since lh_microphys_var_covar_driver_api only + ! works over 1 column currently + call copy_multi_pdf_params_to_single( pdf_params_chnk(lchnk), igrdcol, & + pdf_params_single_col ) + ! Make the call!!!!! call lh_microphys_var_covar_driver_api & - ( pverp-top_lev+1, ns, ztodt, height_depndt_weights(igrdcol,1:pverp-top_lev+1,1:ns), & - pdf_params_chnk(igrdcol,lchnk), & - rt_all_clubb(igrdcol,1:pverp-top_lev+1,1:ns), thl_all_clubb(igrdcol,1:pverp-top_lev+1,1:ns), & - w_all_clubb(igrdcol,1:pverp-top_lev+1,1:ns), qctend_clubb(igrdcol,1:pverp-top_lev+1,1:ns), & - qvtend_clubb(igrdcol,1:pverp-top_lev+1,1:ns), thltend_clubb(igrdcol,1:pverp-top_lev+1,1:ns), & + ( pverp-top_lev+1, ns, ztodt, height_depndt_weights(igrdcol,1:ns,1:pverp-top_lev+1), & + pdf_params_single_col, & + rt_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), thl_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & + w_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), qctend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & + qvtend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), thltend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & silhs_config_flags%l_lh_instant_var_covar_src, & rtp2_mc_zt(igrdcol,1:pverp-top_lev+1), thlp2_mc_zt(igrdcol,1:pverp-top_lev+1), & wprtp_mc_zt(igrdcol,1:pverp-top_lev+1), wpthlp_mc_zt(igrdcol,1:pverp-top_lev+1), & @@ -1654,7 +1944,7 @@ subroutine subcol_SILHS_var_covar_driver & rtpthlp_mc_zt(igrdcol,pverp-top_lev+2:pverp) = 0.0_r8 endif ! pverp > pverp-top_lev+1 - enddo ! igrdcol = 1, ngrdcol + end do ! igrdcol = 1, ngrdcol #endif #endif @@ -1671,7 +1961,7 @@ real(r8) function meansc(arr_in, w_in, ns) result(val) val = 0 do i=1,ns acc = acc + arr_in(i)*w_in(i) - enddo + end do val = acc/ns end function @@ -1684,28 +1974,11 @@ real(r8) function stdsc(arr_in, w_in, mn_in, ns) result(val) accvar = 0 do i=1,ns accvar = accvar + ((arr_in(i)-mn_in)**2)*w_in(i) - enddo + end do var = accvar/ns val = sqrt(var) end function - subroutine Abs_Temp_profile(nz, LWPT_prof, ex_prof, rcm_prof, ABST_prof) - - use clubb_api_module, only : thlm2T_in_K_api - - integer, intent(in) :: nz ! Num vert levels - real(r8), dimension(nz), intent(in) :: LWPT_prof ! Temp prof in LWPT - real(r8), dimension(nz), intent(in) :: ex_prof ! Profile of Exner func - real(r8), dimension(nz), intent(in) :: rcm_prof ! Profile of Cld Wat MR - real(r8), dimension(nz), intent(out) :: ABST_prof ! Abs Temp prof - integer :: i - - do i=1,nz - ABST_prof(i) = thlm2T_in_K_api(LWPT_prof(i), ex_prof(i), rcm_prof(i)) - enddo - - end subroutine - subroutine THL_profile(nz, ABST_prof, ex_prof, rcm_prof, THL_prof) use clubb_api_module, only : T_in_K2thlm_api @@ -1719,24 +1992,10 @@ subroutine THL_profile(nz, ABST_prof, ex_prof, rcm_prof, THL_prof) do i=1,nz THL_prof(i) = T_in_K2thlm_api(ABST_prof(i), ex_prof(i), rcm_prof(i)) - enddo + end do end subroutine - subroutine StaticEng_profile(nz, ABST_prof, zm_prof, zsfc, s_prof) - integer, intent(in) :: nz - real(r8), dimension(nz), intent(in) :: ABST_prof - real(r8), dimension(nz), intent(in) :: zm_prof - real(r8), intent(in) :: zsfc - real(r8), dimension(nz), intent(out) :: s_prof - integer :: i - - do i=1,nz - s_prof(i) = cpair*(ABST_prof(i)) + gravit*zm_prof(i)+zsfc - enddo - - end subroutine - subroutine subcol_constrainmn( num_subcols, samples, weights, grid_mean, mean_sc, std_sc ) ! Input/Output Variables @@ -2153,24 +2412,24 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) + ptend%q(icol,k,ixcldliq) * dt & + state%q(icol,k,ixcldice) & + ptend%q(icol,k,ixcldice) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga if ( ixrain > 0 ) then grand_total_water_column_start(icol) & = grand_total_water_column_start(icol) & + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif if ( ixsnow > 0 ) then grand_total_water_column_start(icol) & = grand_total_water_column_start(icol) & + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif - enddo ! k = top_lev, pver + end do ! k = top_lev, pver grand_total_water_column_start(icol) & = grand_total_water_column_start(icol) & + prect(icol) * dt * 1000.0_r8 - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Calculate total energy in each column. ! This calculation is the vertically-integrated total energy in each @@ -2188,19 +2447,19 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & + latice * ( state%q(icol,k,ixcldliq) & + ptend%q(icol,k,ixcldliq) * dt ) ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga if ( ixrain > 0 ) then total_energy_column_start(icol) & = total_energy_column_start(icol) & + latice * ( state%q(icol,k,ixrain) & + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif - enddo ! k = top_lev, pver + end do ! k = top_lev, pver total_energy_column_start(icol) & = total_energy_column_start(icol) & + latice * precl(icol) * dt * 1000.0_r8 - enddo ! icol = 1, ncol + end do ! icol = 1, ncol endif ! l_check_conservation @@ -2810,9 +3069,9 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) endif ! ixsnow > 0 .and. ( .not. l_pos_rs_mc_tend ) - enddo ! k = top_lev, pver + end do ! k = top_lev, pver - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Calculate the new overall tendencies by adding the sedimentation ! tendencies back onto the new microphysics process tendencies. @@ -2990,24 +3249,24 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) + ptend%q(icol,k,ixcldliq) * dt & + state%q(icol,k,ixcldice) & + ptend%q(icol,k,ixcldice) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga if ( ixrain > 0 ) then grand_total_water_column_finish(icol) & = grand_total_water_column_finish(icol) & + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif if ( ixsnow > 0 ) then grand_total_water_column_finish(icol) & = grand_total_water_column_finish(icol) & + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif - enddo ! k = top_lev, pver + end do ! k = top_lev, pver grand_total_water_column_finish(icol) & = grand_total_water_column_finish(icol) & + prect(icol) * dt * 1000.0_r8 - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Calculate total energy in each column. ! This calculation is the vertically-integrated total energy in each @@ -3026,19 +3285,19 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & + latice * ( state%q(icol,k,ixcldliq) & + ptend%q(icol,k,ixcldliq) * dt ) ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga if ( ixrain > 0 ) then total_energy_column_finish(icol) & = total_energy_column_finish(icol) & + latice * ( state%q(icol,k,ixrain) & + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif - enddo ! k = top_lev, pver + end do ! k = top_lev, pver total_energy_column_finish(icol) & = total_energy_column_finish(icol) & + latice * precl(icol) * dt * 1000.0_r8 - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Calculate the total relative error in each grid column. do icol = 1, ncol @@ -3055,7 +3314,7 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) / min( total_energy_column_finish(icol), & total_energy_column_start(icol) ) - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Print an error message if any total water relative error is found to ! be greater than the threshold. @@ -3070,7 +3329,7 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) "Column-integrated grand total water at finish = ", & grand_total_water_column_finish(icol) endif ! tot_water_rel_err(icol) >= err_thresh - enddo ! icol = 1, ncol + end do ! icol = 1, ncol endif ! any( tot_water_rel_err >= err_thresh ) ! Print an error message if any total energy relative error is found to @@ -3086,7 +3345,7 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) "Column-integrated total energy at finish = ", & total_energy_column_finish(icol) endif ! tot_energy_rel_err(icol) >= err_thresh - enddo ! icol = 1, ncol + end do ! icol = 1, ncol endif ! any( tot_energy_rel_err >= err_thresh ) endif ! l_check_conservation @@ -3224,7 +3483,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & else ! hm_curr < qmin_hm l_pos_hm(k) = .false. endif ! hm_curr >= qmin_hm - enddo ! k = top_lev, pver + end do ! k = top_lev, pver do k = pver, top_lev, -1 @@ -3236,7 +3495,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & ! to be filled. ! The value of the hydrometeor mixing ratio is negative, but ! the value of total_hole is positive. - total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) / gravit + total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga ! Calculate the total hydrometeor mass available from below ! to fill the hole. @@ -3304,7 +3563,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & idx = idx + 1 endif ! idx == pver endif ! sum_pdel >= total_fall_Pa - enddo + end do ! Calculate the available amount of hydrometeor mass to ! fill the hole. @@ -3318,9 +3577,9 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & total_fill_mass & = total_fill_mass & + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) / gravit + * pdel(icol,idx) * rga endif ! l_pos_hm(idx) - enddo ! idx = k+1, pver, 1 + end do ! idx = k+1, pver, 1 ! Contribution to total fill mass from the surface. total_fill_mass & = total_fill_mass + prec(icol) * dt * 1000.0_r8 @@ -3332,7 +3591,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & total_fill_mass & = total_fill_mass & + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) / gravit + * pdel(icol,idx) * rga endif ! l_pos_hm(idx) if ( idx >= lowest_level_idx ) then ! Check if enough mass has been gathered in @@ -3369,7 +3628,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & ! increment and keep going. idx = idx + 1 endif ! idx >= lowest_level_idx - enddo + end do endif ! l_reached_surface endif ! k == pver @@ -3386,9 +3645,9 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & total_fill_mass & = total_fill_mass & + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) / gravit + * pdel(icol,idx) * rga endif ! l_pos_hm(idx) - enddo ! idx = top_lev, k-1, 1 + end do ! idx = top_lev, k-1, 1 endif ! total_fill_mass >= total_hole ! Calculate the ratio of total hole to total fill mass. This @@ -3411,7 +3670,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & + ( hm_curr(idx) - qmin_hm ) & * ( 1.0_r8 - hole_fillmass_ratio ) endif ! l_pos_hm(idx) - enddo ! idx = k+1, lowest_level_idx + end do ! idx = k+1, lowest_level_idx endif ! k < pver if ( l_reached_surface ) then @@ -3435,7 +3694,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & + ( hm_curr(idx) - qmin_hm ) & * ( 1.0_r8 - hole_fillmass_ratio ) endif ! l_pos_hm(idx) - enddo ! idx = top_lev, k-1 + end do ! idx = top_lev, k-1 endif ! l_fill_from_above ! Update the value of the hydrometeor at the level where the @@ -3449,14 +3708,14 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & endif ! .not. l_pos_hm(k) - enddo ! k = pver, top_lev, -1 + end do ! k = pver, top_lev, -1 endif ! any( hm_curr(top_lev:pver) < qmin_hm ) ! Update the value of total microphysics tendency after hole filling. hm_tend(icol,:) = hm_tend(icol,:) + ( hm_curr - hm_update ) / dt - enddo ! icol = 1, ncol + end do ! icol = 1, ncol return @@ -3617,7 +3876,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & else ! hm_curr_filler < qmin_hm_filler l_pos_hm_filler(k) = .false. endif ! hm_curr_filler >= qmin_hm_filler - enddo ! k = top_lev, pver + end do ! k = top_lev, pver do k = top_lev, pver @@ -3629,7 +3888,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & ! to be filled. ! The value of the hydrometeor mixing ratio is negative, but ! the value of total_hole is positive. - total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) / gravit + total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga ! Calculate the total hydrometeor mass available from the ! filler hydrometeor to fill the hole. @@ -3639,9 +3898,9 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & total_fill_mass & = total_fill_mass & + ( hm_curr_filler(idx) - qmin_hm_filler ) & - * pdel(icol,idx) / gravit + * pdel(icol,idx) * rga endif ! l_pos_hm_filler(idx) - enddo ! idx = top_lev, pver, 1 + end do ! idx = top_lev, pver, 1 ! Calculate the ratio of total hole to total fill mass. This ! should not exceed 1 except as a result of numerical round-off @@ -3661,7 +3920,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & + ( hm_curr_filler(idx) - qmin_hm_filler ) & * ( 1.0_r8 - hole_fillmass_ratio ) endif ! l_pos_hm_filler(idx) - enddo ! idx = top_lev, pver + end do ! idx = top_lev, pver ! Update the value of the hydrometeor at the level where the ! hole was found. Mathematically, as long as the available @@ -3674,7 +3933,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & endif ! .not. l_pos_hm(k) - enddo ! k = top_lev, pver + end do ! k = top_lev, pver endif ! any( hm_curr(top_lev:pver) < qmin_hm ) @@ -3686,7 +3945,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & hm_tend_filler(icol,:) & = hm_tend_filler(icol,:) + ( hm_curr_filler - hm_update_filler ) / dt - enddo ! icol = 1, ncol + end do ! icol = 1, ncol return @@ -3867,9 +4126,9 @@ subroutine subcol_SILHS_hydromet_conc_tend_lim( state, dt, ptend ) endif ! ixsnow > 0 .and. ixnumsnow > 0 - enddo ! k = top_lev, pver + end do ! k = top_lev, pver - enddo ! icol = 1, ncol + end do ! icol = 1, ncol return @@ -3877,5 +4136,27 @@ subroutine subcol_SILHS_hydromet_conc_tend_lim( state, dt, ptend ) end subroutine subcol_SILHS_hydromet_conc_tend_lim !============================================================================ + + ! Getunit and Freeunit are depreciated in Fortran going forward, so this is a + ! small function to get an unused stream identifier to send to setup_corr_varnce_array_api + ! or any other silhs/clubb functions that require a unit number argument + ! This comes directly from the Fortran wiki + integer function newunit(unit) + integer, intent(out), optional :: unit + + integer, parameter :: LUN_MIN=10, LUN_MAX=1000 + logical :: opened + integer :: lun + + newunit=-1 + do lun=LUN_MIN,LUN_MAX + inquire(unit=lun,opened=opened) + if (.not. opened) then + newunit=lun + exit + end if + end do + if (present(unit)) unit=newunit + end function newunit end module subcol_SILHS diff --git a/src/physics/cam/subcol_pack_mod.F90.in b/src/physics/cam/subcol_pack_mod.F90.in index 0ad4f917a9..f13983a264 100644 --- a/src/physics/cam/subcol_pack_mod.F90.in +++ b/src/physics/cam/subcol_pack_mod.F90.in @@ -104,6 +104,7 @@ contains use cam_pio_utils, only: cam_pio_handle_error use cam_grid_support, only: cam_grid_read_dist_array use ppgrid, only: begchunk, endchunk + use phys_grid, only: get_ncols_p ! Dummy argument type(file_desc_t), intent(inout) :: File @@ -112,6 +113,7 @@ contains integer :: ierr, c integer :: adimlens(3) + integer :: ncols character(len=*), parameter :: subname = 'SUBCOL_PACK_READ_RESTART' ! Array dimensions @@ -123,14 +125,16 @@ contains call cam_grid_read_dist_array(File, grid_id, adimlens(1:2), & fdimlens(:), nsubcol2d, nsubcol_desc) + ! We need to update indcol2d so set nsubcol2d to itself do c = begchunk, endchunk + ncols = get_ncols_p(c) + if(ncols < pcols) nsubcol2d(ncols+1:pcols,:) = 0 call subcol_set_nsubcol(c, pcols, nsubcol2d(:, c)) end do end subroutine subcol_pack_read_restart - subroutine subcol_get_nsubcol(lchnk, nsubcol) !----------------------------------------------------------------------- ! Retrieve a chunk from the nsubcol module variable @@ -160,6 +164,7 @@ contains end subroutine subcol_get_indcol subroutine subcol_set_nsubcol(lchnk, ngrdcol, nsubcol) + use cam_logfile, only : iulog !----------------------------------------------------------------------- ! Set a chunk of the nsubcol module variable ! Also, recompute indcol for lchnk @@ -172,6 +177,7 @@ contains integer :: i, j, indx if (any(nsubcol(:) > psubcols)) then + write(iulog, *) __FILE__,__LINE__,psubcols, nsubcol call endrun('subcol_set_nsubcol: psubcols not set large enough to hold the number of subcolumns requested') end if if (any(nsubcol(:) < 0)) then diff --git a/src/physics/cam/subcol_tstcp.F90 b/src/physics/cam/subcol_tstcp.F90 index 0ef2a6bb49..c401d524aa 100644 --- a/src/physics/cam/subcol_tstcp.F90 +++ b/src/physics/cam/subcol_tstcp.F90 @@ -170,29 +170,28 @@ subroutine subcol_gen_tstcp(state, tend, state_sc, tend_sc, pbuf) else call subcol_get_nsubcol(state%lchnk, nsubcol) ! Since this is a test generator, check for nsubcol correctness. -10 format(a,i3,a,i5) do i = 1, pcols if (i > ngrdcol) then if (nsubcol(i) /= 0) then - write(errmsg, 10) 'subcol_gen_tstcp: Bad value for nsubcol(',& + write(errmsg, *) 'subcol_gen_tstcp: Bad value for nsubcol(',& i,') = ',nsubcol(i),', /= 0' call endrun(errmsg) end if else if (state%lat(i) > 0.7854_r8) then if (nsubcol(i) /= 1) then - write(errmsg, 10) 'subcol_gen_tstcp: Bad value for nsubcol(',& + write(errmsg, *) 'subcol_gen_tstcp: Bad value for nsubcol(',& i,') = ',nsubcol(i),', /= 1' call endrun(errmsg) end if else if (state%lat(i) < -0.7854_r8) then if (nsubcol(i) /= 2) then - write(errmsg, 10) 'subcol_gen_tstcp: Bad value for nsubcol(',& + write(errmsg, *) 'subcol_gen_tstcp: Bad value for nsubcol(',& i,') = ',nsubcol(i),', /= 2' call endrun(errmsg) end if else if (nsubcol(i) /= psubcols) then - write(errmsg, 10) 'subcol_gen_tstcp: Bad value for nsubcol(',& + write(errmsg, *) 'subcol_gen_tstcp: Bad value for nsubcol(',& i,') = ',nsubcol(i),', /=',psubcols call endrun(errmsg) end if diff --git a/src/physics/cam/tracers.F90 b/src/physics/cam/tracers.F90 index 3b1773745c..bd5dff976f 100644 --- a/src/physics/cam/tracers.F90 +++ b/src/physics/cam/tracers.F90 @@ -291,7 +291,11 @@ subroutine tracers_init_cnst(name, latvals, lonvals, mask, q, z) do m = 1, test_tracer_num if (name == test_tracer_names(m)) then if (analytic_tracer(m)) then - call test_func_set(name, latvals, lonvals, mask, q, z=z) + if (present(z)) then + call test_func_set(name, latvals, lonvals, mask, q, z=z) + else + call test_func_set(name, latvals, lonvals, mask, q) + end if found = .true. exit else @@ -528,10 +532,10 @@ function test_func(name, lat, lon, k, z) result(fout) fout = 2.0_r8 + cos(lon) case('TT_COSB') ! - ! Cosine bell (Kent et al., 2012, MWR) + ! Cosine bell inspired by Kent et al., 2012, MWR; only one bell and location changed ! https://journals.ametsoc.org/doi/pdf/10.1175/MWR-D-11-00150.1 ! - R0 = 0.9_r8*1.0_r8/2.0_r8 ! radius of the perturbation + R0 = 0.5_r8 ! radius of the perturbation lon1 = pi/9.0_r8 lat1 = 2.0_r8*pi/9.0_r8 @@ -546,18 +550,15 @@ function test_func(name, lat, lon, k, z) result(fout) end if if (Rg1 < R0) then - fout = 0.1_r8+0.5_r8*(1.0_r8+COS(pi*d1)) + fout = 0.1_r8+0.9_r8*0.5_r8*(1.0_r8+COS(pi*d1)) else fout = 0.1_r8 end if - ! IF (ABS(fout) < 1.0E-8_r8) fout = 0.0_r8 - ! eta_c = 0.6_r8 - ! eta = (hyam(k)*ps0 + hybm(k)*psurf_moist)/psurf_moist case('TT_CCOSB') ! ! Correlated cosine bell ! - R0 = 0.9_r8*1.0_r8/2.0_r8 ! radius of the perturbation + R0 = 0.5_r8 ! radius of the perturbation lon1 = pi/9.0_r8 lat1 = 2.0_r8*pi/9.0_r8 @@ -572,7 +573,7 @@ function test_func(name, lat, lon, k, z) result(fout) end if if (Rg1 < R0) then - f1 = 0.1_r8+0.5_r8*(1.0_r8+COS(pi*d1)) + f1 = 0.1_r8+0.9_r8*0.5_r8*(1.0_r8+COS(pi*d1)) else f1 = 0.1_r8 end if @@ -582,7 +583,7 @@ function test_func(name, lat, lon, k, z) result(fout) ! ! Correlated cosine bell ! - R0 = 0.9_r8*1.0_r8/2.0_r8 ! radius of the perturbation + R0 = 0.5_r8 ! radius of the perturbation lon1 = pi/9.0_r8 lat1 = 2.0_r8*pi/9.0_r8 @@ -597,7 +598,7 @@ function test_func(name, lat, lon, k, z) result(fout) end if if (Rg1 < R0) then - f1 = 0.1_r8+0.5_r8*(1.0_r8+COS(pi*d1)) + f1 = 0.1_r8+0.9_r8*0.5_r8*(1.0_r8+COS(pi*d1)) else f1 = 0.1_r8 end if diff --git a/src/physics/cam/tropopause.F90 b/src/physics/cam/tropopause.F90 index a2fd830817..db2cd67fad 100644 --- a/src/physics/cam/tropopause.F90 +++ b/src/physics/cam/tropopause.F90 @@ -1,18 +1,10 @@ -! This module is used to diagnose the location of the tropopause. Multiple -! algorithms are provided, some of which may not be able to identify a -! tropopause in all situations. To handle these cases, an analytic -! definition and a climatology are provided that can be used to fill in -! when the original algorithm fails. The tropopause temperature and -! pressure are determined and can be output to the history file. +! This is the CAM interface to the CCPP-ized tropopause_find scheme. +! Full compatibility, bit-for-bit, to old CAM approach is achieved through +! this module, however this module will not be necessary in CAM-SIMA. ! -! These routines are based upon code in the WACCM chemistry module -! including mo_tropoause.F90 and llnl_set_chem_trop.F90. The code -! for the Reichler et al. [2003] algorithm is from: -! -! http://www.gfdl.noaa.gov/~tjr/TROPO/tropocode.htm -! -! Author: Charles Bardeen -! Created: April, 2009 +! For science description of the underlying algorithms, refer to +! atmospheric_physics/tropopause_find/tropopause_find.F90. +! (hplin, 8/20/24) module tropopause !--------------------------------------------------------------- @@ -21,19 +13,18 @@ module tropopause use shr_kind_mod, only : r8 => shr_kind_r8 use shr_const_mod, only : pi => shr_const_pi - use ppgrid, only : pcols, pver, begchunk, endchunk + use ppgrid, only : pcols, pver, pverp, begchunk, endchunk use cam_abortutils, only : endrun use cam_logfile, only : iulog use cam_history_support, only : fillvalue use physics_types, only : physics_state - use physconst, only : cappa, rair, gravit use spmd_utils, only : masterproc implicit none private - - public :: tropopause_readnl, tropopause_init, tropopause_find, tropopause_output + + public :: tropopause_readnl, tropopause_init, tropopause_find_cam, tropopause_output public :: tropopause_findChemTrop public :: TROP_ALG_NONE, TROP_ALG_ANALYTIC, TROP_ALG_CLIMATE public :: TROP_ALG_STOBIE, TROP_ALG_HYBSTOB, TROP_ALG_TWMO, TROP_ALG_WMO @@ -55,8 +46,10 @@ module tropopause integer, parameter :: TROP_ALG_WMO = 6 ! WMO Definition integer, parameter :: TROP_ALG_HYBSTOB = 7 ! Hybrid Stobie Algorithm integer, parameter :: TROP_ALG_CPP = 8 ! Cold Point Parabolic - - integer, parameter :: TROP_NALG = 8 ! Number of Algorithms + integer, parameter :: TROP_ALG_CHEMTROP = 9 ! Chemical tropopause + + ! Note: exclude CHEMTROP here as it is a new flag added in CCPP-ized routines to unify the chemTrop routine. (hplin, 8/20/24) + integer, parameter :: TROP_NALG = 8 ! Number of Algorithms character,parameter :: TROP_LETTER(TROP_NALG) = (/ ' ', 'A', 'C', 'S', 'T', 'W', 'H', 'F' /) ! unique identifier for output, don't use P @@ -74,10 +67,8 @@ module tropopause integer, parameter :: NOTFOUND = -1 - real(r8),parameter :: ALPHA = 0.03_r8 - ! physical constants - ! These constants are set in module variables rather than as parameters + ! These constants are set in module variables rather than as parameters ! to support the aquaplanet mode in which the constants have values determined ! by the experiment protocol real(r8) :: cnst_kap ! = cappa @@ -131,16 +122,16 @@ end subroutine tropopause_readnl ! climatology from a file and to define the output fields. Much of this code ! is taken from mo_tropopause. subroutine tropopause_init() - - use cam_history, only: addfld, horiz_only + use cam_history, only: addfld, horiz_only + use tropopause_find, only: tropopause_find_init + use physconst, only: cappa, rair, gravit, pi - implicit none + character(len=512) :: errmsg + integer :: errflg - ! define physical constants - cnst_kap = cappa - cnst_faktor = -gravit/rair - cnst_ka1 = cnst_kap - 1._r8 + ! Call underlying CCPP-initialization routine. + call tropopause_find_init(cappa, rair, gravit, pi, errmsg, errflg) ! Define the output fields. call addfld('TROP_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure', flag_xyfill=.True.) @@ -149,14 +140,14 @@ subroutine tropopause_init() call addfld('TROP_DZ', (/ 'lev' /), 'A', 'm', 'Relative Tropopause Height') call addfld('TROP_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Probabilty') call addfld('TROP_FD', horiz_only, 'A', 'probability', 'Tropopause Found') - + call addfld('TROPP_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (primary)', flag_xyfill=.True.) call addfld('TROPP_T', horiz_only, 'A', 'K', 'Tropopause Temperature (primary)', flag_xyfill=.True.) call addfld('TROPP_Z', horiz_only, 'A', 'm', 'Tropopause Height (primary)', flag_xyfill=.True.) call addfld('TROPP_DZ', (/ 'lev' /), 'A', 'm', 'Relative Tropopause Height (primary)') call addfld('TROPP_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (primary)') call addfld('TROPP_FD', horiz_only, 'A', 'probability', 'Tropopause Found (primary)') - + call addfld('TROPF_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (cold point)', flag_xyfill=.True.) call addfld('TROPF_T', horiz_only, 'A', 'K', 'Tropopause Temperature (cold point)', flag_xyfill=.True.) call addfld('TROPF_Z', horiz_only, 'A', 'm', 'Tropopause Height (cold point)', flag_xyfill=.True.) @@ -213,7 +204,7 @@ subroutine tropopause_init() end subroutine tropopause_init - + subroutine tropopause_read_file !------------------------------------------------------------------ @@ -221,7 +212,7 @@ subroutine tropopause_read_file !------------------------------------------------------------------ use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish use dyn_grid, only : get_dyn_grid_parm - use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p + use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p use ioFileMod, only : getfil use time_manager, only : get_calday use physconst, only : pi @@ -338,7 +329,7 @@ subroutine tropopause_read_file call lininterp_init(lon, nlon, to_lons, ncols, 2, lon_wgts, zero, twopi) call lininterp_init(lat, nlat, to_lats, ncols, 1, lat_wgts) do n=1,ntimes - call lininterp(tropp_p_in(:,:,n), nlon, nlat, tropp_p_loc(1:ncols,c,n), ncols, lon_wgts, lat_wgts) + call lininterp(tropp_p_in(:,:,n), nlon, nlat, tropp_p_loc(1:ncols,c,n), ncols, lon_wgts, lat_wgts) end do call lininterp_finish(lon_wgts) call lininterp_finish(lat_wgts) @@ -360,1070 +351,200 @@ subroutine tropopause_read_file endif end subroutine tropopause_read_file - - - ! This analytic expression closely matches the mean tropopause determined - ! by the NCEP reanalysis and has been used by the radiation code. - subroutine tropopause_analytic(pstate, tropLev, tropP, tropT, tropZ) - - implicit none - - type(physics_state), intent(in) :: pstate - integer, intent(inout) :: tropLev(pcols) ! tropopause level index - real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) - real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) - real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) - - ! Local Variables - integer :: i - integer :: k - integer :: ncol ! number of columns in the chunk - integer :: lchnk ! chunk identifier - real(r8) :: tP ! tropopause pressure (Pa) - - ! Information about the chunk. - lchnk = pstate%lchnk - ncol = pstate%ncol - - ! Iterate over all of the columns. - do i = 1, ncol - - ! Skip column in which the tropopause has already been found. - if (tropLev(i) == NOTFOUND) then - - ! Calculate the pressure of the tropopause. - tP = (25000.0_r8 - 15000.0_r8 * (cos(pstate%lat(i)))**2) - - ! Find the level that contains the tropopause. - do k = pver, 2, -1 - if (tP >= pstate%pint(i, k)) then - tropLev(i) = k - exit - end if - end do - - ! Return the optional outputs - if (present(tropP)) tropP(i) = tP - - if (present(tropT)) then - tropT(i) = tropopause_interpolateT(pstate, i, tropLev(i), tP) - end if - - if (present(tropZ)) then - tropZ(i) = tropopause_interpolateZ(pstate, i, tropLev(i), tP) - end if - end if - end do - end subroutine tropopause_analytic - - - ! Read the tropopause pressure in from a file containging a climatology. The - ! data is interpolated to the current dat of year and latitude. - ! - ! NOTE: The data is read in during tropopause_init and stored in the module - ! variable trop - subroutine tropopause_climate(pstate, tropLev, tropP, tropT, tropZ) - use time_manager, only : get_curr_calday - - implicit none - - type(physics_state), intent(in) :: pstate - integer, intent(inout) :: tropLev(pcols) ! tropopause level index - real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) - real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) - real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) - - ! Local Variables - integer :: i - integer :: k - integer :: m - integer :: ncol ! number of columns in the chunk - integer :: lchnk ! chunk identifier - real(r8) :: tP ! tropopause pressure (Pa) - real(r8) :: calday ! day of year including fraction - real(r8) :: dels - integer :: last - integer :: next - - ! Information about the chunk. - lchnk = pstate%lchnk - ncol = pstate%ncol - - ! If any columns remain to be indentified, the nget the current - ! day from the calendar. - - if (any(tropLev == NOTFOUND)) then - - ! Determine the calendar day. - calday = get_curr_calday() - - !-------------------------------------------------------- - ! ... setup the time interpolation - !-------------------------------------------------------- - if( calday < days(1) ) then - next = 1 - last = 12 - dels = (365._r8 + calday - days(12)) / (365._r8 + days(1) - days(12)) - else if( calday >= days(12) ) then - next = 1 - last = 12 - dels = (calday - days(12)) / (365._r8 + days(1) - days(12)) - else - do m = 11,1,-1 - if( calday >= days(m) ) then - exit - end if - end do - last = m - next = m + 1 - dels = (calday - days(m)) / (days(m+1) - days(m)) - end if - - dels = max( min( 1._r8,dels ),0._r8 ) - - - ! Iterate over all of the columns. - do i = 1, ncol - - ! Skip column in which the tropopause has already been found. - if (tropLev(i) == NOTFOUND) then - - !-------------------------------------------------------- - ! ... get tropopause level from climatology - !-------------------------------------------------------- - ! Interpolate the tropopause pressure. - tP = tropp_p_loc(i,lchnk,last) & - + dels * (tropp_p_loc(i,lchnk,next) - tropp_p_loc(i,lchnk,last)) - - ! Find the associated level. - do k = pver, 2, -1 - if (tP >= pstate%pint(i, k)) then - tropLev(i) = k - exit - end if - end do - - ! Return the optional outputs - if (present(tropP)) tropP(i) = tP - - if (present(tropT)) then - tropT(i) = tropopause_interpolateT(pstate, i, tropLev(i), tP) - end if - - if (present(tropZ)) then - tropZ(i) = tropopause_interpolateZ(pstate, i, tropLev(i), tP) - end if - end if - end do - end if - - return - end subroutine tropopause_climate - - !----------------------------------------------------------------------- - !----------------------------------------------------------------------- - subroutine tropopause_hybridstobie(pstate, tropLev, tropP, tropT, tropZ) - use cam_history, only : outfld - - !----------------------------------------------------------------------- - ! Originally written by Philip Cameron-Smith, LLNL - ! - ! Stobie-Linoz hybrid: the highest altitude of - ! a) Stobie algorithm, or - ! b) minimum Linoz pressure. - ! - ! NOTE: the ltrop(i) gridbox itself is assumed to be a STRATOSPHERIC gridbox. - !----------------------------------------------------------------------- - !----------------------------------------------------------------------- - ! ... Local variables - !----------------------------------------------------------------------- - - implicit none - - type(physics_state), intent(in) :: pstate - integer, intent(inout) :: tropLev(pcols) ! tropopause level index - real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) - real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) - real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) - - real(r8),parameter :: min_Stobie_Pressure= 40.E2_r8 !For case 2 & 4. [Pa] - real(r8),parameter :: max_Linoz_Pressure =208.E2_r8 !For case 4. [Pa] - - integer :: i, k, ncol - real(r8) :: stobie_min, shybrid_temp !temporary variable for case 2 & 3. - integer :: ltrop_linoz(pcols) !Lowest possible Linoz vertical level - integer :: ltrop_trop(pcols) !Tropopause level for hybrid case. - logical :: ltrop_linoz_set !Flag that lowest linoz level already found. - real(r8) :: trop_output(pcols,pver) !For output purposes only. - real(r8) :: trop_linoz_output(pcols,pver) !For output purposes only. - real(r8) :: trop_trop_output(pcols,pver) !For output purposes only. - - ! write(iulog,*) 'In set_chem_trop, o3_ndx =',o3_ndx - ltrop_linoz(:) = 1 ! Initialize to default value. - ltrop_trop(:) = 1 ! Initialize to default value. - ncol = pstate%ncol - - LOOP_COL4: do i=1,ncol - - ! Skip column in which the tropopause has already been found. - not_found: if (tropLev(i) == NOTFOUND) then - - stobie_min = 1.e10_r8 ! An impossibly large number - ltrop_linoz_set = .FALSE. - LOOP_LEV: do k=pver,1,-1 - IF (pstate%pmid(i,k) < min_stobie_pressure) cycle - shybrid_temp = ALPHA * pstate%t(i,k) - Log10(pstate%pmid(i,k)) - !PJC_NOTE: the units of pmid won't matter, because it is just an additive offset. - IF (shybrid_temp0) then - trop_output(i,tropLev(i))=1._r8 - trop_linoz_output(i,ltrop_linoz(i))=1._r8 - trop_trop_output(i,ltrop_trop(i))=1._r8 - endif - enddo - - call outfld( 'hstobie_trop', trop_output(:ncol,:), ncol, pstate%lchnk ) - call outfld( 'hstobie_linoz', trop_linoz_output(:ncol,:), ncol, pstate%lchnk ) - call outfld( 'hstobie_tropop', trop_trop_output(:ncol,:), ncol, pstate%lchnk ) - - endsubroutine tropopause_hybridstobie - - ! This routine originates with Stobie at NASA Goddard, but does not have a - ! known reference. It was supplied by Philip Cameron-Smith of LLNL. - ! - subroutine tropopause_stobie(pstate, tropLev, tropP, tropT, tropZ) - - implicit none - - type(physics_state), intent(in) :: pstate - integer, intent(inout) :: tropLev(pcols) ! tropopause level index - real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) - real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) - real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) - - ! Local Variables - integer :: i - integer :: k - integer :: ncol ! number of columns in the chunk - integer :: lchnk ! chunk identifier - integer :: tLev ! tropopause level - real(r8) :: tP ! tropopause pressure (Pa) - real(r8) :: stobie(pver) ! stobie weighted temperature - real(r8) :: sTrop ! stobie value at the tropopause - - ! Information about the chunk. - lchnk = pstate%lchnk - ncol = pstate%ncol - - ! Iterate over all of the columns. - do i = 1, ncol - - ! Skip column in which the tropopause has already been found. - if (tropLev(i) == NOTFOUND) then - - ! Caclulate a pressure weighted temperature. - stobie(:) = ALPHA * pstate%t(i,:) - log10(pstate%pmid(i, :)) - - ! Search from the bottom up, looking for the first minimum. - tLev = -1 - - do k = pver-1, 1, -1 - - if (pstate%pmid(i, k) <= 4000._r8) then - exit - end if - - if (pstate%pmid(i, k) >= 55000._r8) then - cycle - end if - - if ((tLev == -1) .or. (stobie(k) < sTrop)) then - tLev = k - tP = pstate%pmid(i, k) - sTrop = stobie(k) - end if - end do - - if (tLev /= -1) then - tropLev(i) = tLev - - ! Return the optional outputs - if (present(tropP)) tropP(i) = tP - - if (present(tropT)) then - tropT(i) = tropopause_interpolateT(pstate, i, tropLev(i), tP) - end if - - if (present(tropZ)) then - tropZ(i) = tropopause_interpolateZ(pstate, i, tropLev(i), tP) - end if - end if - end if - end do - - return - end subroutine tropopause_stobie - - - ! This routine is an implementation of Reichler et al. [2003] done by - ! Reichler and downloaded from his web site. Minimal modifications were - ! made to have the routine work within the CAM framework (i.e. using - ! CAM constants and types). - ! - ! NOTE: I am not a big fan of the goto's and multiple returns in this - ! code, but for the moment I have left them to preserve as much of the - ! original and presumably well tested code as possible. - ! UPDATE: The most "obvious" substitutions have been made to replace - ! goto/return statements with cycle/exit. The structure is still - ! somewhat tangled. - ! UPDATE 2: "gamma" renamed to "gam" in order to avoid confusion - ! with the Fortran 2008 intrinsic. "level" argument removed because - ! a physics column is not contiguous, so using explicit dimensions - ! will cause the data to be needlessly copied. - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! determination of tropopause height from gridded temperature data - ! - ! reference: Reichler, T., M. Dameris, and R. Sausen (2003) - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine twmo(t, p, plimu, pliml, gam, trp) - - real(r8), intent(in), dimension(:) :: t, p - real(r8), intent(in) :: plimu, pliml, gam - real(r8), intent(out) :: trp - - real(r8), parameter :: deltaz = 2000.0_r8 - - real(r8) :: pmk, pm, a, b, tm, dtdp, dtdz - real(r8) :: ag, bg, ptph - real(r8) :: pm0, pmk0, dtdz0 - real(r8) :: p2km, asum, aquer - real(r8) :: pmk2, pm2, a2, b2, tm2, dtdp2, dtdz2 - integer :: level - integer :: icount, jj - integer :: j - - - trp=-99.0_r8 ! negative means not valid - - ! initialize start level - ! dt/dz - level = size(t) - pmk= .5_r8 * (p(level-1)**cnst_kap+p(level)**cnst_kap) - pm = pmk**(1/cnst_kap) - a = (t(level-1)-t(level))/(p(level-1)**cnst_kap-p(level)**cnst_kap) - b = t(level)-(a*p(level)**cnst_kap) - tm = a * pmk + b - dtdp = a * cnst_kap * (pm**cnst_ka1) - dtdz = cnst_faktor*dtdp*pm/tm - - main_loop: do j=level-1,2,-1 - pm0 = pm - pmk0 = pmk - dtdz0 = dtdz - - ! dt/dz - pmk= .5_r8 * (p(j-1)**cnst_kap+p(j)**cnst_kap) - pm = pmk**(1/cnst_kap) - a = (t(j-1)-t(j))/(p(j-1)**cnst_kap-p(j)**cnst_kap) - b = t(j)-(a*p(j)**cnst_kap) - tm = a * pmk + b - dtdp = a * cnst_kap * (pm**cnst_ka1) - dtdz = cnst_faktor*dtdp*pm/tm - ! dt/dz valid? - if (dtdz.le.gam) cycle main_loop ! no, dt/dz < -2 K/km - if (pm.gt.plimu) cycle main_loop ! no, too low - - ! dtdz is valid, calculate tropopause pressure - if (dtdz0.lt.gam) then - ag = (dtdz-dtdz0) / (pmk-pmk0) - bg = dtdz0 - (ag * pmk0) - ptph = exp(log((gam-bg)/ag)/cnst_kap) - else - ptph = pm - endif - - if (ptph.lt.pliml) cycle main_loop - if (ptph.gt.plimu) cycle main_loop - - ! 2nd test: dtdz above 2 km must not exceed gam - p2km = ptph + deltaz*(pm/tm)*cnst_faktor ! p at ptph + 2km - asum = 0.0_r8 ! dtdz above - icount = 0 ! number of levels above - - ! test until apm < p2km - in_loop: do jj=j,2,-1 - - pmk2 = .5_r8 * (p(jj-1)**cnst_kap+p(jj)**cnst_kap) ! p mean ^kappa - pm2 = pmk2**(1/cnst_kap) ! p mean - if(pm2.gt.ptph) cycle in_loop ! doesn't happen - if(pm2.lt.p2km) exit in_loop ! ptropo is valid - - a2 = (t(jj-1)-t(jj)) ! a - a2 = a2/(p(jj-1)**cnst_kap-p(jj)**cnst_kap) - b2 = t(jj)-(a2*p(jj)**cnst_kap) ! b - tm2 = a2 * pmk2 + b2 ! T mean - dtdp2 = a2 * cnst_kap * (pm2**(cnst_kap-1)) ! dt/dp - dtdz2 = cnst_faktor*dtdp2*pm2/tm2 - asum = asum+dtdz2 - icount = icount+1 - aquer = asum/float(icount) ! dt/dz mean - - ! discard ptropo ? - if (aquer.le.gam) cycle main_loop ! dt/dz above < gam - - enddo in_loop ! test next level - - trp = ptph - exit main_loop - enddo main_loop - - end subroutine twmo - - - ! This routine uses an implementation of Reichler et al. [2003] done by - ! Reichler and downloaded from his web site. This is similar to the WMO - ! routines, but is designed for GCMs with a coarse vertical grid. - subroutine tropopause_twmo(pstate, tropLev, tropP, tropT, tropZ) - - implicit none - - type(physics_state), intent(in) :: pstate - integer, intent(inout) :: tropLev(pcols) ! tropopause level index - real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) - real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) - real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) - - ! Local Variables - real(r8), parameter :: gam = -0.002_r8 ! K/m - real(r8), parameter :: plimu = 45000._r8 ! Pa - real(r8), parameter :: pliml = 7500._r8 ! Pa - - integer :: i - integer :: k - integer :: ncol ! number of columns in the chunk - integer :: lchnk ! chunk identifier - real(r8) :: tP ! tropopause pressure (Pa) - - ! Information about the chunk. - lchnk = pstate%lchnk - ncol = pstate%ncol - - ! Iterate over all of the columns. - do i = 1, ncol - - ! Skip column in which the tropopause has already been found. - if (tropLev(i) == NOTFOUND) then - - ! Use the routine from Reichler. - call twmo(pstate%t(i, :), pstate%pmid(i, :), plimu, pliml, gam, tP) - - ! if successful, store of the results and find the level and temperature. - if (tP > 0) then - - ! Find the associated level. - do k = pver, 2, -1 - if (tP >= pstate%pint(i, k)) then - tropLev(i) = k - exit - end if - end do - - ! Return the optional outputs - if (present(tropP)) tropP(i) = tP - - if (present(tropT)) then - tropT(i) = tropopause_interpolateT(pstate, i, tropLev(i), tP) - end if - - if (present(tropZ)) then - tropZ(i) = tropopause_interpolateZ(pstate, i, tropLev(i), tP) - end if - end if - end if - end do - - return - end subroutine tropopause_twmo - - ! This routine implements the WMO definition of the tropopause (WMO, 1957; Seidel and Randel, 2006). - ! This requires that the lapse rate be less than 2 K/km for an altitude range - ! of 2 km. The search starts at the surface and stops the first time this - ! criteria is met. - ! - ! NOTE: This code was modeled after the code in mo_tropopause; however, the - ! requirement that dt be greater than 0 was removed and the check to make - ! sure that the lapse rate is maintained for 2 km was added. - subroutine tropopause_wmo(pstate, tropLev, tropP, tropT, tropZ) - - implicit none - - type(physics_state), intent(in) :: pstate - integer, intent(inout) :: tropLev(pcols) ! tropopause level index - real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) - real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) - real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) - - ! Local Variables - real(r8), parameter :: ztrop_low = 5000._r8 ! lowest tropopause level allowed (m) - real(r8), parameter :: ztrop_high = 20000._r8 ! highest tropopause level allowed (m) - real(r8), parameter :: max_dtdz = 0.002_r8 ! max dt/dz for tropopause level (K/m) - real(r8), parameter :: min_trop_dz = 2000._r8 ! min tropopause thickness (m) - - integer :: i - integer :: k - integer :: k2 - integer :: ncol ! number of columns in the chunk - integer :: lchnk ! chunk identifier - real(r8) :: tP ! tropopause pressure (Pa) - real(r8) :: dt - - ! Information about the chunk. - lchnk = pstate%lchnk - ncol = pstate%ncol - - ! Iterate over all of the columns. - do i = 1, ncol - - ! Skip column in which the tropopause has already been found. - if (tropLev(i) == NOTFOUND) then - - kloop: do k = pver-1, 2, -1 - - ! Skip levels below the minimum and stop if nothing is found - ! before the maximum. - if (pstate%zm(i, k) < ztrop_low) then - cycle kloop - else if (pstate%zm(i, k) > ztrop_high) then - exit kloop - end if - - ! Compare the actual lapse rate to the threshold - dt = pstate%t(i, k) - pstate%t(i, k-1) - - if (dt <= (max_dtdz * (pstate%zm(i, k-1) - pstate%zm(i, k)))) then - - ! Make sure that the lapse rate stays below the threshold for the - ! specified range. - k2loop: do k2 = k-1, 2, -1 - if ((pstate%zm(i, k2) - pstate%zm(i, k)) >= min_trop_dz) then - tP = pstate%pmid(i, k) - tropLev(i) = k - exit k2loop - end if - - dt = pstate%t(i, k) - pstate%t(i, k2) - if (dt > (max_dtdz * (pstate%zm(i, k2) - pstate%zm(i, k)))) then - exit k2loop - end if - end do k2loop - - if (tropLev(i) == NOTFOUND) then - cycle kloop - else - - ! Return the optional outputs - if (present(tropP)) tropP(i) = tP - - if (present(tropT)) then - tropT(i) = tropopause_interpolateT(pstate, i, tropLev(i), tP) - end if - - if (present(tropZ)) then - tropZ(i) = tropopause_interpolateZ(pstate, i, tropLev(i), tP) - end if - - exit kloop - end if - end if - end do kloop - end if - end do - - return - end subroutine tropopause_wmo - - - ! This routine searches for the cold point tropopause, and uses a parabolic - ! fit of the coldest point and two adjacent points to interpolate the cold point - ! between model levels. - subroutine tropopause_cpp(pstate, tropLev, tropP, tropT, tropZ) - - implicit none - - type(physics_state), intent(in) :: pstate - integer, intent(inout) :: tropLev(pcols) ! tropopause level index - real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) - real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) - real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) - - ! Local Variables - real(r8), parameter :: ztrop_low = 5000._r8 ! lowest tropopause level allowed (m) - real(r8), parameter :: ztrop_high = 25000._r8 ! highest tropopause level allowed (m) - - integer :: i - integer :: k, firstk, lastk - integer :: k2 - integer :: ncol ! number of columns in the chunk - integer :: lchnk ! chunk identifier - real(r8) :: tZ ! tropopause height (m) - real(r8) :: tmin - real(r8) :: f0, f1, f2 - real(r8) :: x0, x1, x2 - real(r8) :: c0, c1, c2 - real(r8) :: a, b, c - - ! Information about the chunk. - lchnk = pstate%lchnk - ncol = pstate%ncol - - ! Iterate over all of the columns. - do i = 1, ncol - - firstk = 0 - lastk = pver+1 - - ! Skip column in which the tropopause has already been found. - if (tropLev(i) == NOTFOUND) then - tmin = 1e6_r8 - - kloop: do k = pver-1, 2, -1 - - ! Skip levels below the minimum and stop if nothing is found - ! before the maximum. - if (pstate%zm(i, k) < ztrop_low) then - firstk = k - cycle kloop - else if (pstate%zm(i, k) > ztrop_high) then - lastk = k - exit kloop - end if - - ! Find the coldest point - if (pstate%t(i, k) < tmin) then - tropLev(i) = k - tmin = pstate%t(i,k) - end if - end do kloop - - - ! If the minimum is at the edge of the search range, then don't - ! consider this to be a minima - if ((tropLev(i) >= (firstk-1)) .or. (tropLev(i) <= (lastk+1))) then - tropLev(i) = NOTFOUND - else - - ! If returning P, Z, or T, then do a parabolic fit using the - ! cold point and it its 2 surrounding points to interpolate - ! between model levels. - if (present(tropP) .or. present(tropZ) .or. present(tropT)) then - f0 = pstate%t(i, tropLev(i)-1) - f1 = pstate%t(i, tropLev(i)) - f2 = pstate%t(i, tropLev(i)+1) - - x0 = pstate%zm(i, tropLev(i)-1) - x1 = pstate%zm(i, tropLev(i)) - x2 = pstate%zm(i, tropLev(i)+1) - - c0 = (x0-x1)*(x0-x2) - c1 = (x1-x0)*(x1-x2) - c2 = (x2-x0)*(x2-x1) - - ! Determine the quadratic coefficients of: - ! T = a * z^2 - b*z + c - a = (f0/c0 + f1/c1 + f2/c2) - b = (f0/c0*(x1+x2) + f1/c1*(x0+x2) + f2/c2*(x0+x1)) - c = f0/c0*x1*x2 + f1/c1*x0*x2 + f2/c2*x0*x1 - - ! Find the altitude of the minimum temperature - tZ = 0.5_r8 * b / a - - ! The fit should be between the upper and lower points, - ! so skip the point if the fit fails. - if ((tZ >= x0) .or. (tZ <= x2)) then - tropLev(i) = NOTFOUND - else - - ! Return the optional outputs - if (present(tropP)) then - tropP(i) = tropopause_interpolateP(pstate, i, tropLev(i), tZ) - end if - - if (present(tropT)) then - tropT(i) = a * tZ*tZ - b*tZ + c - end if - - if (present(tropZ)) then - tropZ(i) = tZ - end if - end if - end if - end if - end if - end do - - return - end subroutine tropopause_cpp - ! Searches all the columns in the chunk and attempts to identify the tropopause. ! Two routines can be specifed, a primary routine which is tried first and a ! backup routine which will be tried only if the first routine fails. If the ! tropopause can not be identified by either routine, then a NOTFOUND is returned ! for the tropopause level, temperature and pressure. - subroutine tropopause_find(pstate, tropLev, tropP, tropT, tropZ, primary, backup) + subroutine tropopause_find_cam(pstate, tropLev, tropP, tropT, tropZ, primary, backup) + + use tropopause_find, only: tropopause_findWithBackup + + use cam_history, only: outfld + use time_manager, only: get_curr_calday implicit none - type(physics_state), intent(in) :: pstate + type(physics_state), intent(in) :: pstate integer, optional, intent(in) :: primary ! primary detection algorithm integer, optional, intent(in) :: backup ! backup detection algorithm - integer, intent(out) :: tropLev(pcols) ! tropopause level index - real(r8), optional, intent(out) :: tropP(pcols) ! tropopause pressure (Pa) - real(r8), optional, intent(out) :: tropT(pcols) ! tropopause temperature (K) - real(r8), optional, intent(out) :: tropZ(pcols) ! tropopause height (m) - + integer, intent(out) :: tropLev(:) ! tropopause level index + real(r8), optional, intent(out) :: tropP(:) ! tropopause pressure (Pa) + real(r8), optional, intent(out) :: tropT(:) ! tropopause temperature (K) + real(r8), optional, intent(out) :: tropZ(:) ! tropopause height (m) + ! Local Variable - integer :: primAlg ! Primary algorithm - integer :: backAlg ! Backup algorithm - + integer :: primAlg ! Primary algorithm + integer :: backAlg ! Backup algorithm + + real(r8) :: calday + integer :: ncol + + real(r8) :: hstobie_trop (pcols, pver) + real(r8) :: hstobie_linoz (pcols, pver) + real(r8) :: hstobie_tropop(pcols, pver) + + character(len=512) :: errmsg + integer :: errflg + + ! Get compatibility variables for CCPP-ized routine + ncol = pstate%ncol + calday = get_curr_calday() + ! Initialize the results to a missing value, so that the algorithms will - ! attempt to find the tropopause for all of them. - tropLev(:) = NOTFOUND - if (present(tropP)) tropP(:) = fillvalue - if (present(tropT)) tropT(:) = fillvalue - if (present(tropZ)) tropZ(:) = fillvalue - + ! attempt to find the tropopause for all of them. Only do this for the active columns. + tropLev(:ncol) = NOTFOUND + if (present(tropP)) tropP(:ncol) = fillvalue + if (present(tropT)) tropT(:ncol) = fillvalue + if (present(tropZ)) tropZ(:ncol) = fillvalue + ! Set the algorithms to be used, either the ones provided or the defaults. if (present(primary)) then primAlg = primary else primAlg = default_primary end if - + if (present(backup)) then backAlg = backup else backAlg = default_backup end if - - ! Try to find the tropopause using the primary algorithm. - if (primAlg /= TROP_ALG_NONE) then - call tropopause_findUsing(pstate, primAlg, tropLev, tropP, tropT, tropZ) - end if - - if ((backAlg /= TROP_ALG_NONE) .and. any(tropLev(:) == NOTFOUND)) then - call tropopause_findUsing(pstate, backAlg, tropLev, tropP, tropT, tropZ) - end if - - return - end subroutine tropopause_find - + + ! This does not call the tropopause_find_run routine directly, because it + ! computes multiple needed tropopauses simultaneously. Instead, here we + ! specify the algorithm needed directly to the algorithm driver routine. + call tropopause_findWithBackup( & + ncol = ncol, & + pver = pver, & + fillvalue = fillvalue, & + lat = pstate%lat(:ncol), & + pint = pstate%pint(:ncol, :pverp), & + pmid = pstate%pmid(:ncol, :pver), & + t = pstate%t(:ncol, :pver), & + zi = pstate%zi(:ncol, :pverp), & + zm = pstate%zm(:ncol, :pver), & + phis = pstate%phis(:ncol), & + calday = calday, & + tropp_p_loc = tropp_p_loc(:ncol,pstate%lchnk,:), & ! Subset into chunk as the underlying routines are no longer chunkized. + tropp_days = days, & + tropLev = tropLev(:ncol), & + tropP = tropP, & + tropT = tropT, & + tropZ = tropZ, & + primary = primAlg, & + backup = backAlg, & + hstobie_trop = hstobie_trop(:ncol, :pver), & ! Only used if TROP_ALG_HYBSTOB + hstobie_linoz = hstobie_linoz(:ncol, :pver), & ! Only used if TROP_ALG_HYBSTOB + hstobie_tropop = hstobie_tropop(:ncol, :pver), & ! Only used if TROP_ALG_HYBSTOB + errmsg = errmsg, & + errflg = errflg & + ) + + ! Output hybridstobie specific fields + if(primAlg == TROP_ALG_HYBSTOB) then + call outfld('hstobie_trop', hstobie_trop(:ncol,:), ncol, pstate%lchnk ) + call outfld('hstobie_linoz', hstobie_linoz(:ncol,:), ncol, pstate%lchnk ) + call outfld('hstobie_tropop', hstobie_tropop(:ncol,:), ncol, pstate%lchnk ) + endif + end subroutine tropopause_find_cam + ! Searches all the columns in the chunk and attempts to identify the "chemical" ! tropopause. This is the lapse rate tropopause, backed up by the climatology ! if the lapse rate fails to find the tropopause at pressures higher than a certain - ! threshold. This pressure threshold depends on latitude. Between 50S and 50N, - ! the climatology is used if the lapse rate tropopause is not found at P > 75 hPa. - ! At high latitude (poleward of 50), the threshold is increased to 125 hPa to + ! threshold. This pressure threshold depends on latitude. Between 50S and 50N, + ! the climatology is used if the lapse rate tropopause is not found at P > 75 hPa. + ! At high latitude (poleward of 50), the threshold is increased to 125 hPa to ! eliminate false events that are sometimes detected in the cold polar stratosphere. ! ! NOTE: This routine was adapted from code in chemistry.F90 and mo_gasphase_chemdr.F90. - subroutine tropopause_findChemTrop(pstate, tropLev, primary, backup) + subroutine tropopause_findChemTrop(pstate, tropLev) + + use tropopause_find, only: tropopause_findWithBackup + + use time_manager, only: get_curr_calday implicit none - type(physics_state), intent(in) :: pstate - integer, optional, intent(in) :: primary ! primary detection algorithm - integer, optional, intent(in) :: backup ! backup detection algorithm - integer, intent(out) :: tropLev(pcols) ! tropopause level index + type(physics_state), intent(in) :: pstate + integer, intent(out) :: tropLev(:) ! tropopause level index ! Local Variable - real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor - real(r8) :: dlats(pcols) + real(r8) :: calday integer :: i integer :: ncol - integer :: backAlg - - ! First use the lapse rate tropopause. - ncol = pstate%ncol - call tropopause_find(pstate, tropLev, primary=primary, backup=TROP_ALG_NONE) - - ! Now check high latitudes (poleward of 50) and set the level to the - ! climatology if the level was not found or is at P <= 125 hPa. - dlats(:ncol) = pstate%lat(:ncol) * rad2deg ! convert to degrees - if (present(backup)) then - backAlg = backup - else - backAlg = default_backup - end if - - do i = 1, ncol - if (abs(dlats(i)) > 50._r8) then - if (tropLev(i) .ne. NOTFOUND) then - if (pstate%pmid(i, tropLev(i)) <= 12500._r8) then - tropLev(i) = NOTFOUND - end if - end if - end if - end do - - ! Now use the backup algorithm - if ((backAlg /= TROP_ALG_NONE) .and. any(tropLev(:) == NOTFOUND)) then - call tropopause_findUsing(pstate, backAlg, tropLev) - end if - - return + character(len=512) :: errmsg + integer :: errflg + + ! Get compatibility variables for CCPP-ized routine + ncol = pstate%ncol + calday = get_curr_calday() + + ! Now call the unified routine with the CHEMTROP option, which has automatic + ! backup fall to climatology. + call tropopause_findWithBackup( & + ncol = ncol, & + pver = pver, & + fillvalue = fillvalue, & + lat = pstate%lat(:ncol), & + pint = pstate%pint(:ncol, :pverp), & + pmid = pstate%pmid(:ncol, :pver), & + t = pstate%t(:ncol, :pver), & + zi = pstate%zi(:ncol, :pverp), & + zm = pstate%zm(:ncol, :pver), & + phis = pstate%phis(:ncol), & + calday = calday, & + tropp_p_loc = tropp_p_loc(:ncol,pstate%lchnk,:), & ! Subset into chunk as the underlying routines are no longer chunkized. + tropp_days = days, & + tropLev = tropLev(1:ncol), & + primary = TROP_ALG_CHEMTROP, & + backup = TROP_ALG_CLIMATE, & + errmsg = errmsg, & + errflg = errflg & + ) end subroutine tropopause_findChemTrop - - - ! Call the appropriate tropopause detection routine based upon the algorithm - ! specifed. - ! - ! NOTE: It is assumed that the output fields have been initialized by the - ! caller, and only output values set to fillvalue will be detected. - subroutine tropopause_findUsing(pstate, algorithm, tropLev, tropP, tropT, tropZ) - - implicit none - - type(physics_state), intent(in) :: pstate - integer, intent(in) :: algorithm ! detection algorithm - integer, intent(inout) :: tropLev(pcols) ! tropopause level index - real(r8), optional, intent(inout) :: tropP(pcols) ! tropopause pressure (Pa) - real(r8), optional, intent(inout) :: tropT(pcols) ! tropopause temperature (K) - real(r8), optional, intent(inout) :: tropZ(pcols) ! tropopause height (m) - - ! Dispatch the request to the appropriate routine. - select case(algorithm) - case(TROP_ALG_ANALYTIC) - call tropopause_analytic(pstate, tropLev, tropP, tropT, tropZ) - - case(TROP_ALG_CLIMATE) - call tropopause_climate(pstate, tropLev, tropP, tropT, tropZ) - - case(TROP_ALG_STOBIE) - call tropopause_stobie(pstate, tropLev, tropP, tropT, tropZ) - - case(TROP_ALG_HYBSTOB) - call tropopause_hybridstobie(pstate, tropLev, tropP, tropT, tropZ) - - case(TROP_ALG_TWMO) - call tropopause_twmo(pstate, tropLev, tropP, tropT, tropZ) - - case(TROP_ALG_WMO) - call tropopause_wmo(pstate, tropLev, tropP, tropT, tropZ) - - case(TROP_ALG_CPP) - call tropopause_cpp(pstate, tropLev, tropP, tropT, tropZ) - - case default - write(iulog, *) 'tropopause: Invalid detection algorithm (', algorithm, ') specified.' - call endrun - end select - - return - end subroutine tropopause_findUsing - - ! This routine interpolates the pressures in the physics state to - ! find the pressure at the specified tropopause altitude. - function tropopause_interpolateP(pstate, icol, tropLev, tropZ) - - implicit none - - type(physics_state), intent(in) :: pstate - integer, intent(in) :: icol ! column being processed - integer, intent(in) :: tropLev ! tropopause level index - real(r8), optional, intent(in) :: tropZ ! tropopause pressure (m) - real(r8) :: tropopause_interpolateP - - ! Local Variables - real(r8) :: tropP ! tropopause pressure (Pa) - real(r8) :: dlogPdZ ! dlog(p)/dZ - - ! Interpolate the temperature linearly against log(P) - - ! Is the tropopause at the midpoint? - if (tropZ == pstate%zm(icol, tropLev)) then - tropP = pstate%pmid(icol, tropLev) - - else if (tropZ > pstate%zm(icol, tropLev)) then - - ! It is above the midpoint? Make sure we aren't at the top. - if (tropLev > 1) then - dlogPdZ = (log(pstate%pmid(icol, tropLev)) - log(pstate%pmid(icol, tropLev - 1))) / & - (pstate%zm(icol, tropLev) - pstate%zm(icol, tropLev - 1)) - tropP = pstate%pmid(icol, tropLev) + exp((tropZ - pstate%zm(icol, tropLev)) * dlogPdZ) - end if - else - - ! It is below the midpoint. Make sure we aren't at the bottom. - if (tropLev < pver) then - dlogPdZ = (log(pstate%pmid(icol, tropLev + 1)) - log(pstate%pmid(icol, tropLev))) / & - (pstate%zm(icol, tropLev + 1) - pstate%zm(icol, tropLev)) - tropP = pstate%pmid(icol, tropLev) + exp((tropZ - pstate%zm(icol, tropLev)) * dlogPdZ) - end if - end if - - tropopause_interpolateP = tropP - end function tropopause_interpolateP - - - ! This routine interpolates the temperatures in the physics state to - ! find the temperature at the specified tropopause pressure. - function tropopause_interpolateT(pstate, icol, tropLev, tropP) - - implicit none - - type(physics_state), intent(in) :: pstate - integer, intent(in) :: icol ! column being processed - integer, intent(in) :: tropLev ! tropopause level index - real(r8), optional, intent(in) :: tropP ! tropopause pressure (Pa) - real(r8) :: tropopause_interpolateT - - ! Local Variables - real(r8) :: tropT ! tropopause temperature (K) - real(r8) :: dTdlogP ! dT/dlog(P) - - ! Interpolate the temperature linearly against log(P) - - ! Is the tropopause at the midpoint? - if (tropP == pstate%pmid(icol, tropLev)) then - tropT = pstate%t(icol, tropLev) - - else if (tropP < pstate%pmid(icol, tropLev)) then - - ! It is above the midpoint? Make sure we aren't at the top. - if (tropLev > 1) then - dTdlogP = (pstate%t(icol, tropLev) - pstate%t(icol, tropLev - 1)) / & - (log(pstate%pmid(icol, tropLev)) - log(pstate%pmid(icol, tropLev - 1))) - tropT = pstate%t(icol, tropLev) + (log(tropP) - log(pstate%pmid(icol, tropLev))) * dTdlogP - end if - else - - ! It is below the midpoint. Make sure we aren't at the bottom. - if (tropLev < pver) then - dTdlogP = (pstate%t(icol, tropLev + 1) - pstate%t(icol, tropLev)) / & - (log(pstate%pmid(icol, tropLev + 1)) - log(pstate%pmid(icol, tropLev))) - tropT = pstate%t(icol, tropLev) + (log(tropP) - log(pstate%pmid(icol, tropLev))) * dTdlogP - end if - end if - - tropopause_interpolateT = tropT - end function tropopause_interpolateT - - - ! This routine interpolates the geopotential height in the physics state to - ! find the geopotential height at the specified tropopause pressure. - function tropopause_interpolateZ(pstate, icol, tropLev, tropP) - use physconst, only: rga - - implicit none - - type(physics_state), intent(in) :: pstate - integer, intent(in) :: icol ! column being processed - integer, intent(in) :: tropLev ! tropopause level index - real(r8), optional, intent(in) :: tropP ! tropopause pressure (Pa) - real(r8) :: tropopause_interpolateZ - - ! Local Variables - real(r8) :: tropZ ! tropopause geopotential height (m) - real(r8) :: dZdlogP ! dZ/dlog(P) - - ! Interpolate the geopotential height linearly against log(P) - - ! Is the tropoause at the midpoint? - if (tropP == pstate%pmid(icol, tropLev)) then - tropZ = pstate%zm(icol, tropLev) - - else if (tropP < pstate%pmid(icol, tropLev)) then - - ! It is above the midpoint? Make sure we aren't at the top. - dZdlogP = (pstate%zm(icol, tropLev) - pstate%zi(icol, tropLev)) / & - (log(pstate%pmid(icol, tropLev)) - log(pstate%pint(icol, tropLev))) - tropZ = pstate%zm(icol, tropLev) + (log(tropP) - log(pstate%pmid(icol, tropLev))) * dZdlogP - else - - ! It is below the midpoint. Make sure we aren't at the bottom. - dZdlogP = (pstate%zm(icol, tropLev) - pstate%zi(icol, tropLev+1)) / & - (log(pstate%pmid(icol, tropLev)) - log(pstate%pint(icol, tropLev+1))) - tropZ = pstate%zm(icol, tropLev) + (log(tropP) - log(pstate%pmid(icol, tropLev))) * dZdlogP - end if - - tropopause_interpolateZ = tropZ + pstate%phis(icol)*rga - end function tropopause_interpolateZ - - ! Output the tropopause pressure and temperature to the history files. Two sets ! of output will be generated, one for the default algorithm and another one ! using the default routine, but backed by a climatology when the default ! algorithm fails. subroutine tropopause_output(pstate) use cam_history, only : outfld - + implicit none type(physics_state), intent(in) :: pstate - + ! Local Variables integer :: i integer :: alg integer :: ncol ! number of cloumns in the chunk integer :: lchnk ! chunk identifier - integer :: tropLev(pcols) ! tropopause level index - real(r8) :: tropP(pcols) ! tropopause pressure (Pa) - real(r8) :: tropT(pcols) ! tropopause temperature (K) - real(r8) :: tropZ(pcols) ! tropopause height (m) - real(r8) :: tropFound(pcols) ! tropopause found - real(r8) :: tropDZ(pcols, pver) ! relative tropopause height (m) - real(r8) :: tropPdf(pcols, pver) ! tropopause probability distribution - - ! Information about the chunk. + integer :: tropLev(pcols) ! tropopause level index + real(r8) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8) :: tropT(pcols) ! tropopause temperature (K) + real(r8) :: tropZ(pcols) ! tropopause height (m) + real(r8) :: tropFound(pcols) ! tropopause found + real(r8) :: tropDZ(pcols, pver) ! relative tropopause height (m) + real(r8) :: tropPdf(pcols, pver) ! tropopause probability distribution + + ! Information about the chunk. lchnk = pstate%lchnk ncol = pstate%ncol ! Find the tropopause using the default algorithm backed by the climatology. - call tropopause_find(pstate, tropLev, tropP=tropP, tropT=tropT, tropZ=tropZ) - + call tropopause_find_cam(pstate, tropLev, tropP=tropP, tropT=tropT, tropZ=tropZ) + tropPdf(:,:) = 0._r8 tropFound(:) = 0._r8 - tropDZ(:,:) = fillvalue + tropDZ(:,:) = fillvalue do i = 1, ncol if (tropLev(i) /= NOTFOUND) then tropPdf(i, tropLev(i)) = 1._r8 tropFound(i) = 1._r8 - tropDZ(i,:) = pstate%zm(i,:) - tropZ(i) + tropDZ(i,:) = pstate%zm(i,:) - tropZ(i) end if end do @@ -1433,20 +554,20 @@ subroutine tropopause_output(pstate) call outfld('TROP_DZ', tropDZ(:ncol, :), ncol, lchnk) call outfld('TROP_PD', tropPdf(:ncol, :), ncol, lchnk) call outfld('TROP_FD', tropFound(:ncol), ncol, lchnk) - - + + ! Find the tropopause using just the primary algorithm. - call tropopause_find(pstate, tropLev, tropP=tropP, tropT=tropT, tropZ=tropZ, backup=TROP_ALG_NONE) + call tropopause_find_cam(pstate, tropLev, tropP=tropP, tropT=tropT, tropZ=tropZ, backup=TROP_ALG_NONE) tropPdf(:,:) = 0._r8 tropFound(:) = 0._r8 - tropDZ(:,:) = fillvalue - + tropDZ(:,:) = fillvalue + do i = 1, ncol if (tropLev(i) /= NOTFOUND) then tropPdf(i, tropLev(i)) = 1._r8 tropFound(i) = 1._r8 - tropDZ(i,:) = pstate%zm(i,:) - tropZ(i) + tropDZ(i,:) = pstate%zm(i,:) - tropZ(i) end if end do @@ -1459,17 +580,17 @@ subroutine tropopause_output(pstate) ! Find the tropopause using just the cold point algorithm. - call tropopause_find(pstate, tropLev, tropP=tropP, tropT=tropT, tropZ=tropZ, primary=TROP_ALG_CPP, backup=TROP_ALG_NONE) + call tropopause_find_cam(pstate, tropLev, tropP=tropP, tropT=tropT, tropZ=tropZ, primary=TROP_ALG_CPP, backup=TROP_ALG_NONE) tropPdf(:,:) = 0._r8 tropFound(:) = 0._r8 - tropDZ(:,:) = fillvalue - + tropDZ(:,:) = fillvalue + do i = 1, ncol if (tropLev(i) /= NOTFOUND) then tropPdf(i, tropLev(i)) = 1._r8 tropFound(i) = 1._r8 - tropDZ(i,:) = pstate%zm(i,:) - tropZ(i) + tropDZ(i,:) = pstate%zm(i,:) - tropZ(i) end if end do @@ -1479,26 +600,26 @@ subroutine tropopause_output(pstate) call outfld('TROPF_DZ', tropDZ(:ncol, :), ncol, lchnk) call outfld('TROPF_PD', tropPdf(:ncol, :), ncol, lchnk) call outfld('TROPF_FD', tropFound(:ncol), ncol, lchnk) - - + + ! If requested, do all of the algorithms. if (output_all) then - + do alg = 2, TROP_NALG - + ! Find the tropopause using just the analytic algorithm. - call tropopause_find(pstate, tropLev, tropP=tropP, tropT=tropT, tropZ=tropZ, primary=alg, backup=TROP_ALG_NONE) - + call tropopause_find_cam(pstate, tropLev, tropP=tropP, tropT=tropT, tropZ=tropZ, primary=alg, backup=TROP_ALG_NONE) + tropPdf(:,:) = 0._r8 tropFound(:) = 0._r8 - + do i = 1, ncol if (tropLev(i) /= NOTFOUND) then tropPdf(i, tropLev(i)) = 1._r8 tropFound(i) = 1._r8 end if end do - + call outfld('TROP' // TROP_LETTER(alg) // '_P', tropP(:ncol), ncol, lchnk) call outfld('TROP' // TROP_LETTER(alg) // '_T', tropT(:ncol), ncol, lchnk) call outfld('TROP' // TROP_LETTER(alg) // '_Z', tropZ(:ncol), ncol, lchnk) @@ -1506,7 +627,5 @@ subroutine tropopause_output(pstate) call outfld('TROP' // TROP_LETTER(alg) // '_FD', tropFound(:ncol), ncol, lchnk) end do end if - - return end subroutine tropopause_output end module tropopause diff --git a/src/physics/cam/uwshcu.F90 b/src/physics/cam/uwshcu.F90 index 914d131a94..a5e5a0c6ea 100644 --- a/src/physics/cam/uwshcu.F90 +++ b/src/physics/cam/uwshcu.F90 @@ -3765,7 +3765,7 @@ subroutine compute_uwshcu( mix , mkx , iend , ncnst , dt ! -------------------------------------------------------------------------- ! ! 'rliq' : Verticall-integrated 'suspended cloud condensate' ! ! [m/s] This is so called 'reserved liquid water' in other subroutines ! - ! of CAM3, since the contribution of this term should not be included into ! + ! of CAM, since the contribution of this term should not be included into ! ! the tendency of each layer or surface flux (precip) within this cumulus ! ! scheme. The adding of this term to the layer tendency will be done inthe ! ! 'stratiform_tend', just after performing sediment process there. ! @@ -3928,9 +3928,9 @@ subroutine compute_uwshcu( mix , mkx , iend , ncnst , dt ! --------------------------------------------------------------------------- ! ! Until now, all the calculations are done completely in this shallow cumulus ! - ! scheme. If you want to use this cumulus scheme other than CAM3, then do not ! + ! scheme. If you want to use this cumulus scheme other than CAM, then do not ! ! perform below block. However, for compatible use with the other subroutines ! - ! in CAM3, I should subtract the effect of 'qc(k)' ('rliq') from the tendency ! + ! in CAM, I should subtract the effect of 'qc(k)' ('rliq') from the tendency ! ! equation in each layer, since this effect will be separately added later in ! ! in 'stratiform_tend' just after performing sediment process there. In order ! ! to be consistent with 'stratiform_tend', just subtract qc(k) from tendency ! diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 index 7fbcf1e79c..efd571269a 100644 --- a/src/physics/cam/vertical_diffusion.F90 +++ b/src/physics/cam/vertical_diffusion.F90 @@ -72,7 +72,6 @@ module vertical_diffusion use ref_pres, only : do_molec_diff, nbot_molec use phys_control, only : phys_getopts use time_manager, only : is_first_step - implicit none private save @@ -106,7 +105,6 @@ module vertical_diffusion type(vdiff_selector) :: fieldlist_molec ! Logical switches for molecular diffusion integer :: tke_idx, kvh_idx, kvm_idx ! TKE and eddy diffusivity indices for fields in the physics buffer integer :: kvt_idx ! Index for kinematic molecular conductivity -integer :: turbtype_idx, smaw_idx ! Turbulence type and instability functions integer :: tauresx_idx, tauresy_idx ! Redisual stress for implicit surface stress character(len=fieldname_len) :: vdiffnam(pcnst) ! Names of vertical diffusion tendencies @@ -129,6 +127,9 @@ module vertical_diffusion integer :: taubljx_idx = -1 integer :: taubljy_idx = -1 +! pbuf field for clubb top above which HB (Holtslag Boville) scheme may be enabled +integer :: clubbtop_idx = -1 + logical :: diff_cnsrv_mass_check ! do mass conservation check logical :: do_iss ! switch for implicit turbulent surface stress logical :: prog_modal_aero = .false. ! set true if prognostic modal aerosols are present @@ -137,6 +138,9 @@ module vertical_diffusion logical :: do_pbl_diags = .false. logical :: waccmx_mode = .false. +logical :: do_hb_above_clubb = .false. + +real(r8),allocatable :: kvm_sponge(:) contains @@ -191,7 +195,7 @@ subroutine vd_readnl(nlfile) ! Beljaars reads its own namelist. call beljaars_drag_readnl(nlfile) - if (eddy_scheme == 'diag_TKE' .or. eddy_scheme == 'SPCAM_m2005' ) call eddy_diff_readnl(nlfile) + if (eddy_scheme == 'diag_TKE') call eddy_diff_readnl(nlfile) end subroutine vd_readnl @@ -223,8 +227,6 @@ subroutine vd_register() call pbuf_add_field('kvm', 'global', dtype_r8, (/pcols, pverp/), kvm_idx ) call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx) call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx) - call pbuf_add_field('turbtype', 'global', dtype_i4, (/pcols, pverp/), turbtype_idx) - call pbuf_add_field('smaw', 'global', dtype_r8, (/pcols, pverp/), smaw_idx) call pbuf_add_field('tauresx', 'global', dtype_r8, (/pcols/), tauresx_idx) call pbuf_add_field('tauresy', 'global', dtype_r8, (/pcols/), tauresy_idx) @@ -238,7 +240,7 @@ subroutine vd_register() end if ! diag_TKE fields - if (eddy_scheme == 'diag_TKE' .or. eddy_scheme == 'SPCAM_m2005') then + if (eddy_scheme == 'diag_TKE') then call eddy_diff_register() end if @@ -277,6 +279,7 @@ subroutine vertical_diffusion_init(pbuf2d) use beljaars_drag_cam, only : beljaars_drag_init use upper_bc, only : ubc_init use phys_control, only : waccmx_is, fv_am_correction + use ref_pres, only : ptop_ref type(physics_buffer_desc), pointer :: pbuf2d(:,:) character(128) :: errstring ! Error status for init_vdiff @@ -284,9 +287,9 @@ subroutine vertical_diffusion_init(pbuf2d) integer :: nbot_eddy ! Bottom interface level to which eddy vertical diffusion is applied ( = pver ) integer :: k ! Vertical loop index - real(r8), parameter :: ntop_eddy_pres = 1.e-5_r8 ! Pressure below which eddy diffusion is not done in WACCM-X. (Pa) + real(r8), parameter :: ntop_eddy_pres = 1.e-7_r8 ! Pressure below which eddy diffusion is not done in WACCM-X. (Pa) - integer :: im, l, m, nmodes, nspec + integer :: im, l, m, nmodes, nspec, ierr logical :: history_amwg ! output the variables used by the AMWG diag package logical :: history_eddy ! output the eddy variables @@ -294,10 +297,48 @@ subroutine vertical_diffusion_init(pbuf2d) integer :: history_budget_histfile_num ! output history file number for budget fields logical :: history_waccm ! output variables of interest for WACCM runs - ! ----------------------------------------------------------------- ! + ! + ! add sponge layer vertical diffusion + ! + if (ptop_ref>1e-1_r8.and.ptop_ref<100.0_r8) then + ! + ! CAM7 FMT (but not CAM6 top (~225 Pa) or CAM7 low top or lower) + ! + allocate(kvm_sponge(4), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'vertical_diffusion_init: kvm_sponge allocation error = ',ierr + call endrun('vertical_diffusion_init: failed to allocate kvm_sponge array') + end if + kvm_sponge(1) = 2E6_r8 + kvm_sponge(2) = 2E6_r8 + kvm_sponge(3) = 0.5E6_r8 + kvm_sponge(4) = 0.1E6_r8 + else if (ptop_ref>1e-4_r8) then + ! + ! WACCM and WACCM-x + ! + allocate(kvm_sponge(6), stat=ierr) + if( ierr /= 0 ) then + write(iulog,*) 'vertical_diffusion_init: kvm_sponge allocation error = ',ierr + call endrun('vertical_diffusion_init: failed to allocate kvm_sponge array') + end if + kvm_sponge(1) = 2E6_r8 + kvm_sponge(2) = 2E6_r8 + kvm_sponge(3) = 1.5E6_r8 + kvm_sponge(4) = 1.0E6_r8 + kvm_sponge(5) = 0.5E6_r8 + kvm_sponge(6) = 0.1E6_r8 + end if if (masterproc) then write(iulog,*)'Initializing vertical diffusion (vertical_diffusion_init)' + if (allocated(kvm_sponge)) then + write(iulog,*)'Artificial sponge layer vertical diffusion added:' + do k=1,size(kvm_sponge(:),1) + write(iulog,'(a44,i2,a17,e7.2,a8)') 'vertical diffusion coefficient at interface',k,' is increased by ', & + kvm_sponge(k),' m2 s-2' + end do + end if !allocated end if ! Check to see if WACCM-X is on (currently we don't care whether the @@ -389,18 +430,32 @@ subroutine vertical_diffusion_init(pbuf2d) if (masterproc) write(iulog, fmt='(a,i3,5x,a,i3)') 'NTOP_EDDY =', ntop_eddy, 'NBOT_EDDY =', nbot_eddy + call phys_getopts(do_hb_above_clubb_out=do_hb_above_clubb) + select case ( eddy_scheme ) - case ( 'diag_TKE', 'SPCAM_m2005' ) + case ( 'diag_TKE' ) if( masterproc ) write(iulog,*) & 'vertical_diffusion_init: eddy_diffusivity scheme: UW Moist Turbulence Scheme by Bretherton and Park' call eddy_diff_init(pbuf2d, ntop_eddy, nbot_eddy) - case ( 'HB', 'HBR', 'SPCAM_sam1mom') + case ( 'HB', 'HBR') if( masterproc ) write(iulog,*) 'vertical_diffusion_init: eddy_diffusivity scheme: Holtslag and Boville' call init_hb_diff(gravit, cpair, ntop_eddy, nbot_eddy, pref_mid, & karman, eddy_scheme) call addfld('HB_ri', (/ 'lev' /), 'A', 'no', 'Richardson Number (HB Scheme), I' ) case ( 'CLUBB_SGS' ) do_pbl_diags = .true. + call init_hb_diff(gravit, cpair, ntop_eddy, nbot_eddy, pref_mid, karman, eddy_scheme) + ! + ! run HB scheme where CLUBB is not active when running cam7 or cam6 physics + ! else init_hb_diff is called just for diagnostic purposes + ! + if (do_hb_above_clubb) then + if( masterproc ) then + write(iulog,*) 'vertical_diffusion_init: ' + write(iulog,*) 'eddy_diffusivity scheme where CLUBB is not active: Holtslag and Boville' + end if + call addfld('HB_ri', (/ 'lev' /), 'A', 'no', 'Richardson Number (HB Scheme), I' ) + end if end select ! ------------------------------------------- ! @@ -564,8 +619,10 @@ subroutine vertical_diffusion_init(pbuf2d) endif if (history_eddy) then - call add_default( 'UFLX ', 1, ' ' ) - call add_default( 'VFLX ', 1, ' ' ) + if (.not. do_pbl_diags) then + call add_default( 'UFLX ', 1, ' ' ) + call add_default( 'VFLX ', 1, ' ' ) + end if endif if( history_budget ) then @@ -599,11 +656,14 @@ subroutine vertical_diffusion_init(pbuf2d) kvh_idx = pbuf_get_index('kvh') end if + if (do_hb_above_clubb) then + ! pbuf field denoting top of clubb + clubbtop_idx = pbuf_get_index('clubbtop') + end if + ! Initialization of some pbuf fields if (is_first_step()) then ! Initialization of pbuf fields tke, kvh, kvm are done in phys_inidat - call pbuf_set_field(pbuf2d, turbtype_idx, 0 ) - call pbuf_set_field(pbuf2d, smaw_idx, 0.0_r8) call pbuf_set_field(pbuf2d, tauresx_idx, 0.0_r8) call pbuf_set_field(pbuf2d, tauresy_idx, 0.0_r8) if (trim(shallow_scheme) == 'UNICON') then @@ -611,7 +671,6 @@ subroutine vertical_diffusion_init(pbuf2d) call pbuf_set_field(pbuf2d, qti_flx_idx, 0.0_r8) end if end if - end subroutine vertical_diffusion_init ! =============================================================================== ! @@ -650,27 +709,29 @@ subroutine vertical_diffusion_tend( & !---------------------------------------------------- ! use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_set_field use physics_types, only : physics_state, physics_ptend, physics_ptend_init - use physics_types, only : set_dry_to_wet, set_wet_to_dry - + use camsrfexch, only : cam_in_t use cam_history, only : outfld use trb_mtn_stress_cam, only : trb_mtn_stress_tend use beljaars_drag_cam, only : beljaars_drag_tend use eddy_diff_cam, only : eddy_diff_tend - use hb_diff, only : compute_hb_diff + use hb_diff, only : compute_hb_diff, compute_hb_free_atm_diff use wv_saturation, only : qsat use molec_diff, only : compute_molec_diff, vd_lu_qdecomp use constituents, only : qmincg, qmin, cnst_type use diffusion_solver, only : compute_vdiff, any, operator(.not.) - use physconst, only : cpairv, rairv !Needed for calculation of upward H flux + use air_composition, only : cpairv, rairv !Needed for calculation of upward H flux use time_manager, only : get_nstep use constituents, only : cnst_get_type_byind, cnst_name, & cnst_mw, cnst_fixed_ubc, cnst_fixed_ubflx use physconst, only : pi use pbl_utils, only : virtem, calc_obklen, calc_ustar - use upper_bc, only : ubc_get_vals + use upper_bc, only : ubc_get_vals, ubc_fixed_temp + use upper_bc, only : ubc_get_flxs use coords_1d, only : Coords1D + use phys_control, only : cam_physpkg_is + use ref_pres, only : ptop_ref ! --------------- ! ! Input Arguments ! @@ -708,9 +769,6 @@ subroutine vertical_diffusion_tend( & real(r8) :: dtk(pcols,pver) ! T tendency from KE dissipation real(r8), pointer :: tke(:,:) ! Turbulent kinetic energy [ m2/s2 ] - integer(i4),pointer :: turbtype(:,:) ! Turbulent interface types [ no unit ] - real(r8), pointer :: smaw(:,:) ! Normalized Galperin instability function - ! ( 0<= <=4.964 and 1 at neutral ) real(r8), pointer :: qtl_flx(:,:) ! overbar(w'qtl') where qtl = qv + ql real(r8), pointer :: qti_flx(:,:) ! overbar(w'qti') where qti = qv + qi @@ -837,6 +895,7 @@ subroutine vertical_diffusion_tend( & real(r8) :: tauy(pcols) real(r8) :: shflux(pcols) real(r8) :: cflux(pcols,pcnst) + integer, pointer :: clubbtop(:) ! (pcols) logical :: lq(pcnst) @@ -844,9 +903,6 @@ subroutine vertical_diffusion_tend( & ! Main Computation Begins ! ! ----------------------- ! - ! Assume 'wet' mixing ratios in diffusion code. - call set_dry_to_wet(state) - rztodt = 1._r8 / ztodt lchnk = state%lchnk ncol = state%ncol @@ -856,7 +912,6 @@ subroutine vertical_diffusion_tend( & call pbuf_get_field(pbuf, tpert_idx, tpert) call pbuf_get_field(pbuf, qpert_idx, qpert) call pbuf_get_field(pbuf, pblh_idx, pblh) - call pbuf_get_field(pbuf, turbtype_idx, turbtype) ! Interpolate temperature to interfaces. do k = 2, pver @@ -867,17 +922,14 @@ subroutine vertical_diffusion_tend( & tint(:ncol,pver+1) = state%t(:ncol,pver) ! Get upper boundary values - call ubc_get_vals( state%lchnk, ncol, state%pint, state%zi, state%t, state%q, state%omega, state%phis, & - ubc_t, ubc_mmr, ubc_flux ) - - ! Always have a fixed upper boundary T if molecular diffusion is active. Why ? - ! For WACCM-X, set ubc temperature to extrapolate from next two lower interface level temperatures - if (do_molec_diff) then - if (waccmx_mode) then - tint(:ncol,1) = 1.5_r8*tint(:ncol,2)-.5_r8*tint(:ncol,3) - else - tint (:ncol,1) = ubc_t(:ncol) - endif + call ubc_get_vals( state%lchnk, ncol, state%pint, state%zi, ubc_t, ubc_mmr ) + + if (waccmx_mode) then + call ubc_get_flxs( state%lchnk, ncol, state%pint, state%zi, state%t, state%q, state%phis, ubc_flux ) + ! For WACCM-X, set ubc temperature to extrapolate from next two lower interface level temperatures + tint(:ncol,1) = 1.5_r8*tint(:ncol,2)-.5_r8*tint(:ncol,3) + else if(ubc_fixed_temp) then + tint(:ncol,1) = ubc_t(:ncol) else tint(:ncol,1) = state%t(:ncol,1) end if @@ -952,20 +1004,19 @@ subroutine vertical_diffusion_tend( & !----------------------------------------------------------------------- ! call pbuf_get_field(pbuf, kvm_idx, kvm_in) call pbuf_get_field(pbuf, kvh_idx, kvh_in) - call pbuf_get_field(pbuf, smaw_idx, smaw) call pbuf_get_field(pbuf, tke_idx, tke) ! Get potential temperature. th(:ncol,:pver) = state%t(:ncol,:pver) * state%exner(:ncol,:pver) select case (eddy_scheme) - case ( 'diag_TKE', 'SPCAM_m2005' ) + case ( 'diag_TKE' ) call eddy_diff_tend(state, pbuf, cam_in, & ztodt, p, tint, rhoi, cldn, wstarent, & kvm_in, kvh_in, ksrftms, dragblj, tauresx, tauresy, & rrho, ustar, pblh, kvm, kvh, kvq, cgh, cgs, tpert, qpert, & - tke, sprod, sfi, turbtype, smaw) + tke, sprod, sfi) ! The diag_TKE scheme does not calculate the Monin-Obukhov length, which is used in dry deposition calculations. ! Use the routines from pbl_utils to accomplish this. Assumes ustar and rrho have been set. @@ -975,51 +1026,84 @@ subroutine vertical_diffusion_tend( & khfs(:ncol), kqfs(:ncol), kbfs(:ncol), obklen(:ncol)) - case ( 'HB', 'HBR', 'SPCAM_sam1mom' ) + case ( 'HB', 'HBR' ) ! Modification : We may need to use 'taux' instead of 'tautotx' here, for ! consistency with the previous HB scheme. - call compute_hb_diff( lchnk , ncol , & - th , state%t , state%q , state%zm , state%zi, & - state%pmid, state%u , state%v , tautotx , tautoty , & - cam_in%shf, cam_in%cflx(:,1), obklen , ustar , pblh , & - kvm , kvh , kvq , cgh , cgs , & - tpert , qpert , cldn , cam_in%ocnfrac , tke , & + + call compute_hb_diff(ncol , & + th , state%t , state%q , state%zm , state%zi , & + state%pmid, state%u , state%v , tautotx , tautoty , & + cam_in%shf, cam_in%cflx(:,1), obklen , ustar , pblh , & + kvm , kvh , kvq , cgh , cgs , & + tpert , qpert , cldn , cam_in%ocnfrac , tke , & ri , & - eddy_scheme ) + eddy_scheme) call outfld( 'HB_ri', ri, pcols, lchnk ) case ( 'CLUBB_SGS' ) - - ! CLUBB has only a bare-bones placeholder here. If using CLUBB, the - ! PBL diffusion will happen before coupling, so vertical_diffusion - ! is only handling other things, e.g. some boundary conditions, tms, - ! and molecular diffusion. - - call virtem(ncol, th(:ncol,pver),state%q(:ncol,pver,1), thvs(:ncol)) - - call calc_ustar( ncol, state%t(:ncol,pver), state%pmid(:ncol,pver), & - cam_in%wsx(:ncol), cam_in%wsy(:ncol), rrho(:ncol), ustar(:ncol)) - ! Use actual qflux, not lhf/latvap as was done previously - call calc_obklen( ncol, th(:ncol,pver), thvs(:ncol), cam_in%cflx(:ncol,1), & - cam_in%shf(:ncol), rrho(:ncol), ustar(:ncol), & - khfs(:ncol), kqfs(:ncol), kbfs(:ncol), obklen(:ncol)) - - ! These tendencies all applied elsewhere. - kvm = 0._r8 - kvh = 0._r8 - kvq = 0._r8 - - ! Not defined since PBL is not actually running here. - cgh = 0._r8 - cgs = 0._r8 - + ! + ! run HB scheme where CLUBB is not active when running cam7 + ! + if (do_hb_above_clubb) then + call compute_hb_free_atm_diff( ncol , & + th , state%t , state%q , state%zm , & + state%pmid, state%u , state%v , tautotx , tautoty , & + cam_in%shf, cam_in%cflx(:,1), obklen , ustar , & + kvm , kvh , kvq , cgh , cgs , & + ri ) + + call pbuf_get_field(pbuf, clubbtop_idx, clubbtop) + ! + ! zero out HB where CLUBB is active + ! + do i=1,ncol + do k=clubbtop(i),pverp + kvm(i,k) = 0.0_r8 + kvh(i,k) = 0.0_r8 + kvq(i,k) = 0.0_r8 + cgs(i,k) = 0.0_r8 + cgh(i,k) = 0.0_r8 + end do + end do + + call outfld( 'HB_ri', ri, pcols, lchnk ) + else + ! CLUBB has only a bare-bones placeholder here. If using CLUBB, the + ! PBL diffusion will happen before coupling, so vertical_diffusion + ! is only handling other things, e.g. some boundary conditions, tms, + ! and molecular diffusion. + + call virtem(ncol, th(:ncol,pver),state%q(:ncol,pver,1), thvs(:ncol)) + + call calc_ustar( ncol, state%t(:ncol,pver), state%pmid(:ncol,pver), & + cam_in%wsx(:ncol), cam_in%wsy(:ncol), rrho(:ncol), ustar(:ncol)) + ! Use actual qflux, not lhf/latvap as was done previously + call calc_obklen( ncol, th(:ncol,pver), thvs(:ncol), cam_in%cflx(:ncol,1), & + cam_in%shf(:ncol), rrho(:ncol), ustar(:ncol), & + khfs(:ncol), kqfs(:ncol), kbfs(:ncol), obklen(:ncol)) + ! These tendencies all applied elsewhere. + kvm = 0._r8 + kvh = 0._r8 + kvq = 0._r8 + ! Not defined since PBL is not actually running here. + cgh = 0._r8 + cgs = 0._r8 + end if end select call outfld( 'ustar', ustar(:), pcols, lchnk ) call outfld( 'obklen', obklen(:), pcols, lchnk ) + ! + ! add sponge layer vertical diffusion + ! + if (allocated(kvm_sponge)) then + do k=1,size(kvm_sponge(:),1) + kvm(:ncol,1) = kvm(:ncol,1)+kvm_sponge(k) + end do + end if ! kvh (in pbuf) is used by other physics parameterizations, and as an initial guess in compute_eddy_diff ! on the next timestep. It is not updated by the compute_vdiff call below. @@ -1051,8 +1135,9 @@ subroutine vertical_diffusion_tend( & + q_tmp(:ncol,:,ixcldice) slv_prePBL(:ncol,:pver) = sl_prePBL(:ncol,:pver) * ( 1._r8 + zvir*qt_prePBL(:ncol,:pver) ) - call qsat(state%t(:ncol,:), state%pmid(:ncol,:), & - tem2(:ncol,:), ftem(:ncol,:)) + do k = 1, pver + call qsat(state%t(1:ncol,k), state%pmid(1:ncol,k), tem2(1:ncol,k), ftem(1:ncol,k), ncol) + end do ftem_prePBL(:ncol,:) = state%q(:ncol,:,1)/ftem(:ncol,:)*100._r8 call outfld( 'qt_pre_PBL ', qt_prePBL, pcols, lchnk ) @@ -1060,9 +1145,9 @@ subroutine vertical_diffusion_tend( & call outfld( 'slv_pre_PBL ', slv_prePBL, pcols, lchnk ) call outfld( 'u_pre_PBL ', state%u, pcols, lchnk ) call outfld( 'v_pre_PBL ', state%v, pcols, lchnk ) - call outfld( 'qv_pre_PBL ', state%q(:ncol,:,1), pcols, lchnk ) - call outfld( 'ql_pre_PBL ', state%q(:ncol,:,ixcldliq), pcols, lchnk ) - call outfld( 'qi_pre_PBL ', state%q(:ncol,:,ixcldice), pcols, lchnk ) + call outfld( 'qv_pre_PBL ', state%q(:,:,1), pcols, lchnk ) + call outfld( 'ql_pre_PBL ', state%q(:,:,ixcldliq), pcols, lchnk ) + call outfld( 'qi_pre_PBL ', state%q(:,:,ixcldice), pcols, lchnk ) call outfld( 't_pre_PBL ', state%t, pcols, lchnk ) call outfld( 'rh_pre_PBL ', ftem_prePBL, pcols, lchnk ) @@ -1097,7 +1182,12 @@ subroutine vertical_diffusion_tend( & tauy = 0._r8 shflux = 0._r8 cflux(:,1) = 0._r8 - cflux(:,2:) = cam_in%cflx(:,2:) + if (cam_physpkg_is("cam7")) then + ! surface fluxes applied in clubb emissions module + cflux(:,2:) = 0._r8 + else + cflux(:,2:) = cam_in%cflx(:,2:) + end if case default taux = cam_in%wsx tauy = cam_in%wsy @@ -1151,7 +1241,7 @@ subroutine vertical_diffusion_tend( & p_dry , state%t , rhoi_dry, ztodt , taux , & tauy , shflux , cflux , & kvh , kvm , kvq , cgs , cgh , & - state%zi , ksrftms , dragblj , & + state%zi , ksrftms , dragblj , & qmincg , fieldlist_dry , fieldlist_molec,& u_tmp , v_tmp , q_tmp , s_tmp , & tautmsx_temp , tautmsy_temp , dtk_temp , topflx_temp , errstring , & @@ -1175,7 +1265,7 @@ subroutine vertical_diffusion_tend( & tmp1(:ncol) = ztodt * gravit * state%rpdel(:ncol,pver) do m = 1, pmam_ncnst l = pmam_cnst_idx(m) - q_tmp(:ncol,pver,l) = q_tmp(:ncol,pver,l) + tmp1(:ncol) * cam_in%cflx(:ncol,l) + q_tmp(:ncol,pver,l) = q_tmp(:ncol,pver,l) + tmp1(:ncol) * cflux(:ncol,l) enddo end if @@ -1281,8 +1371,6 @@ subroutine vertical_diffusion_tend( & ptend%q(:ncol,:pver,m) = ptend%q(:ncol,:pver,m)*state%pdel(:ncol,:pver)/state%pdeldry(:ncol,:pver) endif end do - ! convert wet mmr back to dry before conservation check - call set_wet_to_dry(state) if (.not. do_pbl_diags) then slten(:ncol,:) = ( sl(:ncol,:) - sl_prePBL(:ncol,:) ) * rztodt @@ -1301,7 +1389,7 @@ subroutine vertical_diffusion_tend( & ! ! ! ------------------------------------------------------------ ! - if( (eddy_scheme .eq. 'diag_TKE' .or. eddy_scheme .eq. 'SPCAM_m2005') .and. do_pseudocon_diff ) then + if( eddy_scheme .eq. 'diag_TKE' .and. do_pseudocon_diff ) then ptend%q(:ncol,:pver,1) = qtten(:ncol,:pver) ptend%s(:ncol,:pver) = slten(:ncol,:pver) @@ -1343,8 +1431,9 @@ subroutine vertical_diffusion_tend( & u_aft_PBL(:ncol,:pver) = state%u(:ncol,:pver) + ptend%u(:ncol,:pver) * ztodt v_aft_PBL(:ncol,:pver) = state%v(:ncol,:pver) + ptend%v(:ncol,:pver) * ztodt - call qsat(t_aftPBL(:ncol,:pver), state%pmid(:ncol,:pver), & - tem2(:ncol,:pver), ftem(:ncol,:pver)) + do k = 1, pver + call qsat(t_aftPBL(1:ncol,k), state%pmid(1:ncol,k), tem2(1:ncol,k), ftem(1:ncol,k), ncol) + end do ftem_aftPBL(:ncol,:pver) = qv_aft_PBL(:ncol,:pver) / ftem(:ncol,:pver) * 100._r8 tten(:ncol,:pver) = ( t_aftPBL(:ncol,:pver) - state%t(:ncol,:pver) ) * rztodt @@ -1418,11 +1507,11 @@ subroutine vertical_diffusion_tend( & call outfld( 'vflx_cg_PBL' , vflx_cg, pcols, lchnk ) call outfld( 'slten_PBL' , slten, pcols, lchnk ) call outfld( 'qtten_PBL' , qtten, pcols, lchnk ) - call outfld( 'uten_PBL' , ptend%u(:ncol,:), pcols, lchnk ) - call outfld( 'vten_PBL' , ptend%v(:ncol,:), pcols, lchnk ) - call outfld( 'qvten_PBL' , ptend%q(:ncol,:,1), pcols, lchnk ) - call outfld( 'qlten_PBL' , ptend%q(:ncol,:,ixcldliq), pcols, lchnk ) - call outfld( 'qiten_PBL' , ptend%q(:ncol,:,ixcldice), pcols, lchnk ) + call outfld( 'uten_PBL' , ptend%u, pcols, lchnk ) + call outfld( 'vten_PBL' , ptend%v, pcols, lchnk ) + call outfld( 'qvten_PBL' , ptend%q(:,:,1), pcols, lchnk ) + call outfld( 'qlten_PBL' , ptend%q(:,:,ixcldliq), pcols, lchnk ) + call outfld( 'qiten_PBL' , ptend%q(:,:,ixcldice), pcols, lchnk ) call outfld( 'tten_PBL' , tten, pcols, lchnk ) call outfld( 'rhten_PBL' , rhten, pcols, lchnk ) @@ -1451,7 +1540,7 @@ subroutine vertical_diffusion_tend( & call outfld( 'KVT' , kvt, pcols, lchnk ) call outfld( 'KVM' , kvm, pcols, lchnk ) call outfld( 'CGS' , cgs, pcols, lchnk ) - dtk(:ncol,:) = dtk(:ncol,:) / cpair ! Normalize heating for history + dtk(:ncol,:) = dtk(:ncol,:) / cpair / ztodt ! Normalize heating for history call outfld( 'DTVKE' , dtk, pcols, lchnk ) dtk(:ncol,:) = ptend%s(:ncol,:) / cpair ! Normalize heating for history using dtk call outfld( 'DTV' , dtk, pcols, lchnk ) diff --git a/src/physics/cam/waccmx_phys_intr.F90 b/src/physics/cam/waccmx_phys_intr.F90 index 0b81b30f74..3a695e77af 100644 --- a/src/physics/cam/waccmx_phys_intr.F90 +++ b/src/physics/cam/waccmx_phys_intr.F90 @@ -8,6 +8,7 @@ module waccmx_phys_intr use majorsp_diffusion, only: mspd_intr use ion_electron_temp, only: ion_electron_temp_readnl use ion_electron_temp, only: ion_electron_temp_init + use ion_electron_temp, only: ion_electron_temp_timestep_init use ion_electron_temp, only: ion_electron_temp_register use ion_electron_temp, only: ion_electron_temp_inidat use ion_electron_temp, only: ion_electron_temp_tend @@ -22,6 +23,7 @@ module waccmx_phys_intr public :: waccmx_phys_ion_elec_temp_reg public :: waccmx_phys_ion_elec_temp_inidat public :: waccmx_phys_ion_elec_temp_init + public :: waccmx_phys_ion_elec_temp_timestep_init public :: waccmx_phys_ion_elec_temp_tend public :: waccmx_phys_ion_elec_temp_readnl @@ -94,6 +96,19 @@ subroutine waccmx_phys_ion_elec_temp_init(pbuf2d) #endif end subroutine waccmx_phys_ion_elec_temp_init + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine waccmx_phys_ion_elec_temp_timestep_init(phys_state,pbuf2d) + use ppgrid, only : begchunk, endchunk + + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + +#ifdef WACCMX_PHYS + call ion_electron_temp_timestep_init(phys_state,pbuf2d) +#endif + end subroutine waccmx_phys_ion_elec_temp_timestep_init + !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ subroutine waccmx_phys_ion_elec_temp_tend(state, ptend, pbuf, ztodt) diff --git a/src/physics/cam/wv_sat_methods.F90 b/src/physics/cam/wv_sat_methods.F90 deleted file mode 100644 index c413376631..0000000000 --- a/src/physics/cam/wv_sat_methods.F90 +++ /dev/null @@ -1,484 +0,0 @@ -module wv_sat_methods - -! This portable module contains all CAM methods for estimating -! the saturation vapor pressure of water. -! -! wv_saturation provides CAM-specific interfaces and utilities -! based on these formulae. -! -! Typical usage of this module: -! -! Init: -! call wv_sat_methods_init(r8, , errstring) -! -! Get scheme index from a name string: -! scheme_idx = wv_sat_get_scheme_idx(scheme_name) -! if (.not. wv_sat_valid_idx(scheme_idx)) -! -! Get pressures: -! es = wv_sat_svp_water(t, scheme_idx) -! es = wv_sat_svp_ice(t, scheme_idx) -! -! Use ice/water transition range: -! es = wv_sat_svp_trice(t, ttrice, scheme_idx) -! -! Note that elemental functions cannot be pointed to, nor passed -! as arguments. If you need to do either, it is recommended to -! wrap the function so that it can be given an explicit (non- -! elemental) interface. - -implicit none -private -save - -integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real - -real(r8) :: tmelt ! Melting point of water at 1 atm (K) -real(r8) :: h2otrip ! Triple point temperature of water (K) -real(r8) :: tboil ! Boiling point of water at 1 atm (K) - -real(r8) :: ttrice ! Ice-water transition range - -real(r8) :: epsilo ! Ice-water transition range -real(r8) :: omeps ! 1._r8 - epsilo - -! Indices representing individual schemes -integer, parameter :: Invalid_idx = -1 -integer, parameter :: OldGoffGratch_idx = 0 -integer, parameter :: GoffGratch_idx = 1 -integer, parameter :: MurphyKoop_idx = 2 -integer, parameter :: Bolton_idx = 3 - -! Index representing the current default scheme. -integer, parameter :: initial_default_idx = GoffGratch_idx -integer :: default_idx = initial_default_idx - -public wv_sat_methods_init -public wv_sat_get_scheme_idx -public wv_sat_valid_idx - -public wv_sat_set_default -public wv_sat_reset_default - -public wv_sat_svp_water -public wv_sat_svp_ice -public wv_sat_svp_trans - -! pressure -> humidity conversion -public wv_sat_svp_to_qsat - -! Combined qsat operations -public wv_sat_qsat_water -public wv_sat_qsat_ice -public wv_sat_qsat_trans - -contains - -!--------------------------------------------------------------------- -! ADMINISTRATIVE FUNCTIONS -!--------------------------------------------------------------------- - -! Get physical constants -subroutine wv_sat_methods_init(kind, tmelt_in, h2otrip_in, tboil_in, & - ttrice_in, epsilo_in, errstring) - integer, intent(in) :: kind - real(r8), intent(in) :: tmelt_in - real(r8), intent(in) :: h2otrip_in - real(r8), intent(in) :: tboil_in - real(r8), intent(in) :: ttrice_in - real(r8), intent(in) :: epsilo_in - character(len=*), intent(out) :: errstring - - errstring = ' ' - - if (kind /= r8) then - write(errstring,*) 'wv_sat_methods_init: ERROR: ', & - kind,' was input kind but ',r8,' is internal kind.' - return - end if - - if (ttrice_in < 0._r8) then - write(errstring,*) 'wv_sat_methods_init: ERROR: ', & - ttrice_in,' was input for ttrice, but negative range is invalid.' - return - end if - - tmelt = tmelt_in - h2otrip = h2otrip_in - tboil = tboil_in - ttrice = ttrice_in - epsilo = epsilo_in - - omeps = 1._r8 - epsilo - -end subroutine wv_sat_methods_init - -! Look up index by name. -pure function wv_sat_get_scheme_idx(name) result(idx) - character(len=*), intent(in) :: name - integer :: idx - - select case (name) - case("GoffGratch") - idx = GoffGratch_idx - case("MurphyKoop") - idx = MurphyKoop_idx - case("OldGoffGratch") - idx = OldGoffGratch_idx - case("Bolton") - idx = Bolton_idx - case default - idx = Invalid_idx - end select - -end function wv_sat_get_scheme_idx - -! Check validity of an index from the above routine. -pure function wv_sat_valid_idx(idx) result(status) - integer, intent(in) :: idx - logical :: status - - status = (idx /= Invalid_idx) - -end function wv_sat_valid_idx - -! Set default scheme (otherwise, Goff & Gratch is default) -! Returns a logical representing success (.true.) or -! failure (.false.). -function wv_sat_set_default(name) result(status) - character(len=*), intent(in) :: name - logical :: status - - ! Don't want to overwrite valid default with invalid, - ! so assign to temporary and check it first. - integer :: tmp_idx - - tmp_idx = wv_sat_get_scheme_idx(name) - - status = wv_sat_valid_idx(tmp_idx) - - if (status) default_idx = tmp_idx - -end function wv_sat_set_default - -! Reset default scheme to initial value. -! The same thing can be accomplished with wv_sat_set_default; -! the real reason to provide this routine is to reset the -! module for testing purposes. -subroutine wv_sat_reset_default() - - default_idx = initial_default_idx - -end subroutine wv_sat_reset_default - -!--------------------------------------------------------------------- -! UTILITIES -!--------------------------------------------------------------------- - -! Get saturation specific humidity given pressure and SVP. -! Specific humidity is limited to range 0-1. -elemental function wv_sat_svp_to_qsat(es, p) result(qs) - - real(r8), intent(in) :: es ! SVP - real(r8), intent(in) :: p ! Current pressure. - real(r8) :: qs - - ! If pressure is less than SVP, set qs to maximum of 1. - if ( (p - es) <= 0._r8 ) then - qs = 1.0_r8 - else - qs = epsilo*es / (p - omeps*es) - end if - -end function wv_sat_svp_to_qsat - -elemental subroutine wv_sat_qsat_water(t, p, es, qs, idx) - !------------------------------------------------------------------! - ! Purpose: ! - ! Calculate SVP over water at a given temperature, and then ! - ! calculate and return saturation specific humidity. ! - !------------------------------------------------------------------! - - ! Inputs - real(r8), intent(in) :: t ! Temperature - real(r8), intent(in) :: p ! Pressure - ! Outputs - real(r8), intent(out) :: es ! Saturation vapor pressure - real(r8), intent(out) :: qs ! Saturation specific humidity - - integer, intent(in), optional :: idx ! Scheme index - - es = wv_sat_svp_water(t, idx) - - qs = wv_sat_svp_to_qsat(es, p) - - ! Ensures returned es is consistent with limiters on qs. - es = min(es, p) - -end subroutine wv_sat_qsat_water - -elemental subroutine wv_sat_qsat_ice(t, p, es, qs, idx) - !------------------------------------------------------------------! - ! Purpose: ! - ! Calculate SVP over ice at a given temperature, and then ! - ! calculate and return saturation specific humidity. ! - !------------------------------------------------------------------! - - ! Inputs - real(r8), intent(in) :: t ! Temperature - real(r8), intent(in) :: p ! Pressure - ! Outputs - real(r8), intent(out) :: es ! Saturation vapor pressure - real(r8), intent(out) :: qs ! Saturation specific humidity - - integer, intent(in), optional :: idx ! Scheme index - - es = wv_sat_svp_ice(t, idx) - - qs = wv_sat_svp_to_qsat(es, p) - - ! Ensures returned es is consistent with limiters on qs. - es = min(es, p) - -end subroutine wv_sat_qsat_ice - -elemental subroutine wv_sat_qsat_trans(t, p, es, qs, idx) - !------------------------------------------------------------------! - ! Purpose: ! - ! Calculate SVP over ice at a given temperature, and then ! - ! calculate and return saturation specific humidity. ! - !------------------------------------------------------------------! - - ! Inputs - real(r8), intent(in) :: t ! Temperature - real(r8), intent(in) :: p ! Pressure - ! Outputs - real(r8), intent(out) :: es ! Saturation vapor pressure - real(r8), intent(out) :: qs ! Saturation specific humidity - - integer, intent(in), optional :: idx ! Scheme index - - es = wv_sat_svp_trans(t, idx) - - qs = wv_sat_svp_to_qsat(es, p) - - ! Ensures returned es is consistent with limiters on qs. - es = min(es, p) - -end subroutine wv_sat_qsat_trans - -!--------------------------------------------------------------------- -! SVP INTERFACE FUNCTIONS -!--------------------------------------------------------------------- - -elemental function wv_sat_svp_water(t, idx) result(es) - real(r8), intent(in) :: t - integer, intent(in), optional :: idx - real(r8) :: es - - integer :: use_idx - - if (present(idx)) then - use_idx = idx - else - use_idx = default_idx - end if - - select case (use_idx) - case(GoffGratch_idx) - es = GoffGratch_svp_water(t) - case(MurphyKoop_idx) - es = MurphyKoop_svp_water(t) - case(OldGoffGratch_idx) - es = OldGoffGratch_svp_water(t) - case(Bolton_idx) - es = Bolton_svp_water(t) - end select - -end function wv_sat_svp_water - -elemental function wv_sat_svp_ice(t, idx) result(es) - real(r8), intent(in) :: t - integer, intent(in), optional :: idx - real(r8) :: es - - integer :: use_idx - - if (present(idx)) then - use_idx = idx - else - use_idx = default_idx - end if - - select case (use_idx) - case(GoffGratch_idx) - es = GoffGratch_svp_ice(t) - case(MurphyKoop_idx) - es = MurphyKoop_svp_ice(t) - case(OldGoffGratch_idx) - es = OldGoffGratch_svp_ice(t) - case(Bolton_idx) - es = Bolton_svp_water(t) - end select - -end function wv_sat_svp_ice - -elemental function wv_sat_svp_trans(t, idx) result (es) - - real(r8), intent(in) :: t - integer, intent(in), optional :: idx - - real(r8) :: es - - real(r8) :: esice ! Saturation vapor pressure over ice - real(r8) :: weight ! Intermediate scratch variable for es transition - -! -! Water -! - if (t >= (tmelt - ttrice)) then - es = wv_sat_svp_water(t,idx) - else - es = 0.0_r8 - end if - -! -! Ice -! - if (t < tmelt) then - - esice = wv_sat_svp_ice(t,idx) - - if ( (tmelt - t) > ttrice ) then - weight = 1.0_r8 - else - weight = (tmelt - t)/ttrice - end if - - es = weight*esice + (1.0_r8 - weight)*es - end if - -end function wv_sat_svp_trans - -!--------------------------------------------------------------------- -! SVP METHODS -!--------------------------------------------------------------------- - -! Goff & Gratch (1946) - -elemental function GoffGratch_svp_water(t) result(es) - real(r8), intent(in) :: t ! Temperature in Kelvin - real(r8) :: es ! SVP in Pa - - ! uncertain below -70 C - es = 10._r8**(-7.90298_r8*(tboil/t-1._r8)+ & - 5.02808_r8*log10(tboil/t)- & - 1.3816e-7_r8*(10._r8**(11.344_r8*(1._r8-t/tboil))-1._r8)+ & - 8.1328e-3_r8*(10._r8**(-3.49149_r8*(tboil/t-1._r8))-1._r8)+ & - log10(1013.246_r8))*100._r8 - -end function GoffGratch_svp_water - -elemental function GoffGratch_svp_ice(t) result(es) - real(r8), intent(in) :: t ! Temperature in Kelvin - real(r8) :: es ! SVP in Pa - - ! good down to -100 C - es = 10._r8**(-9.09718_r8*(h2otrip/t-1._r8)-3.56654_r8* & - log10(h2otrip/t)+0.876793_r8*(1._r8-t/h2otrip)+ & - log10(6.1071_r8))*100._r8 - -end function GoffGratch_svp_ice - -! Murphy & Koop (2005) - -elemental function MurphyKoop_svp_water(t) result(es) - real(r8), intent(in) :: t ! Temperature in Kelvin - real(r8) :: es ! SVP in Pa - - ! (good for 123 < T < 332 K) - es = exp(54.842763_r8 - (6763.22_r8 / t) - (4.210_r8 * log(t)) + & - (0.000367_r8 * t) + (tanh(0.0415_r8 * (t - 218.8_r8)) * & - (53.878_r8 - (1331.22_r8 / t) - (9.44523_r8 * log(t)) + & - 0.014025_r8 * t))) - -end function MurphyKoop_svp_water - -elemental function MurphyKoop_svp_ice(t) result(es) - real(r8), intent(in) :: t ! Temperature in Kelvin - real(r8) :: es ! SVP in Pa - - ! (good down to 110 K) - es = exp(9.550426_r8 - (5723.265_r8 / t) + (3.53068_r8 * log(t)) & - - (0.00728332_r8 * t)) - -end function MurphyKoop_svp_ice - -! Old CAM implementation, also labelled Goff & Gratch (1946) - -! The water formula differs only due to compiler-dependent order of -! operations, so differences are roundoff level, usually 0. - -! The ice formula gives fairly close answers to the current -! implementation, but has been rearranged, and uses the -! 1 atm melting point of water as the triple point. -! Differences are thus small but above roundoff. - -! A curious fact: although using the melting point of water was -! probably a mistake, it mildly improves accuracy for ice svp, -! since it compensates for a systematic error in Goff & Gratch. - -elemental function OldGoffGratch_svp_water(t) result(es) - real(r8), intent(in) :: t - real(r8) :: es - real(r8) :: ps, e1, e2, f1, f2, f3, f4, f5, f - - ps = 1013.246_r8 - e1 = 11.344_r8*(1.0_r8 - t/tboil) - e2 = -3.49149_r8*(tboil/t - 1.0_r8) - f1 = -7.90298_r8*(tboil/t - 1.0_r8) - f2 = 5.02808_r8*log10(tboil/t) - f3 = -1.3816_r8*(10.0_r8**e1 - 1.0_r8)/10000000.0_r8 - f4 = 8.1328_r8*(10.0_r8**e2 - 1.0_r8)/1000.0_r8 - f5 = log10(ps) - f = f1 + f2 + f3 + f4 + f5 - - es = (10.0_r8**f)*100.0_r8 - -end function OldGoffGratch_svp_water - -elemental function OldGoffGratch_svp_ice(t) result(es) - real(r8), intent(in) :: t - real(r8) :: es - real(r8) :: term1, term2, term3 - - term1 = 2.01889049_r8/(tmelt/t) - term2 = 3.56654_r8*log(tmelt/t) - term3 = 20.947031_r8*(tmelt/t) - - es = 575.185606e10_r8*exp(-(term1 + term2 + term3)) - -end function OldGoffGratch_svp_ice - -! Bolton (1980) -! zm_conv deep convection scheme contained this SVP calculation. -! It appears to be from D. Bolton, 1980, Monthly Weather Review. -! Unlike the other schemes, no distinct ice formula is associated -! with it. (However, a Bolton ice formula exists in CLUBB.) - -! The original formula used degrees C, but this function -! takes Kelvin and internally converts. - -elemental function Bolton_svp_water(t) result(es) - real(r8),parameter :: c1 = 611.2_r8 - real(r8),parameter :: c2 = 17.67_r8 - real(r8),parameter :: c3 = 243.5_r8 - - real(r8), intent(in) :: t ! Temperature in Kelvin - real(r8) :: es ! SVP in Pa - - es = c1*exp( (c2*(t - tmelt))/((t - tmelt)+c3) ) - -end function Bolton_svp_water - -end module wv_sat_methods diff --git a/src/physics/cam/wv_saturation.F90 b/src/physics/cam/wv_saturation.F90 deleted file mode 100644 index 94b32acd73..0000000000 --- a/src/physics/cam/wv_saturation.F90 +++ /dev/null @@ -1,802 +0,0 @@ -module wv_saturation - -!--------------------------------------------------------------------! -! Module Overview: ! -! ! -! This module provides an interface to wv_sat_methods, providing ! -! saturation vapor pressure and related calculations to CAM. ! -! ! -! The original wv_saturation codes were introduced by J. J. Hack, ! -! February 1990. The code has been extensively rewritten since then, ! -! including a total refactoring in Summer 2012. ! -! ! -!--------------------------------------------------------------------! -! Methods: ! -! ! -! Pure water/ice saturation vapor pressures are calculated on the ! -! fly, with the specific method determined by a runtime option. ! -! Mixed phase SVP is interpolated from the internal table, estbl, ! -! which is created during initialization. ! -! ! -! The default method for calculating SVP is determined by a namelist ! -! option, and used whenever svp_water/ice or qsat are called. ! -! ! -!--------------------------------------------------------------------! - -use shr_kind_mod, only: r8 => shr_kind_r8 -use physconst, only: epsilo, & - latvap, & - latice, & - rh2o, & - cpair, & - tmelt, & - h2otrip - -use wv_sat_methods, only: & - svp_to_qsat => wv_sat_svp_to_qsat - -implicit none -private -save - -! Public interfaces -! Namelist, initialization, finalization -public wv_sat_readnl -public wv_sat_init -public wv_sat_final - -! Saturation vapor pressure calculations -public svp_water -public svp_ice - -! Mixed phase (water + ice) saturation vapor pressure table lookup -public estblf - -public svp_to_qsat - -! Subroutines that return both SVP and humidity -! Optional arguments do temperature derivatives -public qsat ! Mixed phase -public qsat_water ! SVP over water only -public qsat_ice ! SVP over ice only - -! Wet bulb temperature solver -public :: findsp_vc, findsp - -! Data - -! This value is slightly high, but it seems to be the value for the -! steam point of water originally (and most frequently) used in the -! Goff & Gratch scheme. -real(r8), parameter :: tboil = 373.16_r8 - -! Table of saturation vapor pressure values (estbl) from tmin to -! tmax+1 Kelvin, in one degree increments. ttrice defines the -! transition region, estbl contains a combination of ice & water -! values. -! Make these public parameters in case another module wants to see the -! extent of the table. - real(r8), public, parameter :: tmin = 127.16_r8 - real(r8), public, parameter :: tmax = 375.16_r8 - - real(r8), parameter :: ttrice = 20.00_r8 ! transition range from es over H2O to es over ice - - integer :: plenest ! length of estbl - real(r8), allocatable :: estbl(:) ! table values of saturation vapor pressure - - real(r8) :: omeps ! 1.0_r8 - epsilo - - real(r8) :: c3 ! parameter used by findsp - - ! Set coefficients for polynomial approximation of difference - ! between saturation vapor press over water and saturation pressure - ! over ice for -ttrice < t < 0 (degrees C). NOTE: polynomial is - ! valid in the range -40 < t < 0 (degrees C). - real(r8) :: pcf(5) = (/ & - 5.04469588506e-01_r8, & - -5.47288442819e+00_r8, & - -3.67471858735e-01_r8, & - -8.95963532403e-03_r8, & - -7.78053686625e-05_r8 /) - -! --- Degree 6 approximation --- -! real(r8) :: pcf(6) = (/ & -! 7.63285250063e-02, & -! 5.86048427932e+00, & -! 4.38660831780e-01, & -! 1.37898276415e-02, & -! 2.14444472424e-04, & -! 1.36639103771e-06 /) - -contains - -!--------------------------------------------------------------------- -! ADMINISTRATIVE FUNCTIONS -!--------------------------------------------------------------------- - -subroutine wv_sat_readnl(nlfile) - !------------------------------------------------------------------! - ! Purpose: ! - ! Get runtime options for wv_saturation. ! - !------------------------------------------------------------------! - - use wv_sat_methods, only: wv_sat_get_scheme_idx, & - wv_sat_valid_idx, & - wv_sat_set_default - - use spmd_utils, only: masterproc - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand - use cam_abortutils, only: endrun - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - - character(len=32) :: wv_sat_scheme = "GoffGratch" - - character(len=*), parameter :: subname = 'wv_sat_readnl' - - namelist /wv_sat_nl/ wv_sat_scheme - !----------------------------------------------------------------------------- - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'wv_sat_nl', status=ierr) - if (ierr == 0) then - read(unitn, wv_sat_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - return - end if - end if - close(unitn) - call freeunit(unitn) - - end if - -#ifdef SPMD - call mpibcast(wv_sat_scheme, len(wv_sat_scheme) , mpichar, 0, mpicom) -#endif - - if (.not. wv_sat_set_default(wv_sat_scheme)) then - call endrun('wv_sat_readnl :: Invalid wv_sat_scheme.') - return - end if - -end subroutine wv_sat_readnl - -subroutine wv_sat_init - !------------------------------------------------------------------! - ! Purpose: ! - ! Initialize module (e.g. setting parameters, initializing the ! - ! SVP lookup table). ! - !------------------------------------------------------------------! - - use wv_sat_methods, only: wv_sat_methods_init, & - wv_sat_get_scheme_idx, & - wv_sat_valid_idx - use spmd_utils, only: masterproc - use cam_logfile, only: iulog - use cam_abortutils, only: endrun - use shr_assert_mod, only: shr_assert_in_domain - use error_messages, only: handle_errmsg - - integer :: status - - ! For wv_sat_methods error reporting. - character(len=256) :: errstring - - ! For generating internal SVP table. - real(r8) :: t ! Temperature - integer :: i ! Increment counter - - ! Precalculated because so frequently used. - omeps = 1.0_r8 - epsilo - - ! Transition range method is only valid for transition temperatures at: - ! -40 deg C < T < 0 deg C - call shr_assert_in_domain(ttrice, ge=0._r8, le=40._r8, varname="ttrice",& - msg="wv_sat_init: Invalid transition temperature range.") - -! This parameter uses a hardcoded 287.04_r8? - c3 = 287.04_r8*(7.5_r8*log(10._r8))/cpair - -! Init "methods" module containing actual SVP formulae. - - call wv_sat_methods_init(r8, tmelt, h2otrip, tboil, ttrice, & - epsilo, errstring) - - call handle_errmsg(errstring, subname="wv_sat_methods_init") - - ! Add two to make the table slightly too big, just in case. - plenest = ceiling(tmax-tmin) + 2 - - ! Allocate SVP table. - allocate(estbl(plenest), stat=status) - if (status /= 0) then - call endrun('wv_sat_init :: ERROR allocating saturation vapor pressure table') - return - end if - - do i = 1, plenest - estbl(i) = svp_trans(tmin + real(i-1,r8)) - end do - - if (masterproc) then - write(iulog,*)' *** SATURATION VAPOR PRESSURE TABLE COMPLETED ***' - end if - -end subroutine wv_sat_init - -subroutine wv_sat_final - !------------------------------------------------------------------! - ! Purpose: ! - ! Deallocate global variables in module. ! - !------------------------------------------------------------------! - use cam_abortutils, only: endrun - - integer :: status - - if (allocated(estbl)) then - - deallocate(estbl, stat=status) - - if (status /= 0) then - call endrun('wv_sat_final :: ERROR deallocating table') - return - end if - - end if - -end subroutine wv_sat_final - -!--------------------------------------------------------------------- -! DEFAULT SVP FUNCTIONS -!--------------------------------------------------------------------- - -! Compute saturation vapor pressure over water -elemental function svp_water(t) result(es) - - use wv_sat_methods, only: & - wv_sat_svp_water - - real(r8), intent(in) :: t ! Temperature (K) - real(r8) :: es ! SVP (Pa) - - es = wv_sat_svp_water(T) - -end function svp_water - -! Compute saturation vapor pressure over ice -elemental function svp_ice(t) result(es) - - use wv_sat_methods, only: & - wv_sat_svp_ice - - real(r8), intent(in) :: t ! Temperature (K) - real(r8) :: es ! SVP (Pa) - - es = wv_sat_svp_ice(T) - -end function svp_ice - -! Compute saturation vapor pressure with an ice-water transition -elemental function svp_trans(t) result(es) - - use wv_sat_methods, only: & - wv_sat_svp_trans - - real(r8), intent(in) :: t ! Temperature (K) - real(r8) :: es ! SVP (Pa) - - es = wv_sat_svp_trans(T) - -end function svp_trans - -!--------------------------------------------------------------------- -! UTILITIES -!--------------------------------------------------------------------- - -! Does linear interpolation from nearest values found -! in the table (estbl). -elemental function estblf(t) result(es) - - real(r8), intent(in) :: t ! Temperature - real(r8) :: es ! SVP (Pa) - - integer :: i ! Index for t in the table - real(r8) :: t_tmp ! intermediate temperature for es look-up - - real(r8) :: weight ! Weight for interpolation - - t_tmp = max(min(t,tmax)-tmin, 0._r8) ! Number of table entries above tmin - i = int(t_tmp) + 1 ! Corresponding index. - weight = t_tmp - aint(t_tmp, r8) ! Fractional part of t_tmp (for interpolation). - es = (1._r8 - weight)*estbl(i) + weight*estbl(i+1) - -end function estblf - -! Get enthalpy based only on temperature -! and specific humidity. -elemental function tq_enthalpy(t, q, hltalt) result(enthalpy) - - real(r8), intent(in) :: t ! Temperature - real(r8), intent(in) :: q ! Specific humidity - real(r8), intent(in) :: hltalt ! Modified hlat for T derivatives - - real(r8) :: enthalpy - - enthalpy = cpair * t + hltalt * q - -end function tq_enthalpy - -!--------------------------------------------------------------------- -! LATENT HEAT OF VAPORIZATION CORRECTIONS -!--------------------------------------------------------------------- - -elemental subroutine no_ip_hltalt(t, hltalt) - !------------------------------------------------------------------! - ! Purpose: ! - ! Calculate latent heat of vaporization of pure liquid water at ! - ! a given temperature. ! - !------------------------------------------------------------------! - - ! Inputs - real(r8), intent(in) :: t ! Temperature - ! Outputs - real(r8), intent(out) :: hltalt ! Appropriately modified hlat - - hltalt = latvap - - ! Account for change of latvap with t above freezing where - ! constant slope is given by -2369 j/(kg c) = cpv - cw - if (t >= tmelt) then - hltalt = hltalt - 2369.0_r8*(t-tmelt) - end if - -end subroutine no_ip_hltalt - -elemental subroutine calc_hltalt(t, hltalt, tterm) - !------------------------------------------------------------------! - ! Purpose: ! - ! Calculate latent heat of vaporization of water at a given ! - ! temperature, taking into account the ice phase if temperature ! - ! is below freezing. ! - ! Optional argument also calculates a term used to calculate ! - ! d(es)/dT within the water-ice transition range. ! - !------------------------------------------------------------------! - - ! Inputs - real(r8), intent(in) :: t ! Temperature - ! Outputs - real(r8), intent(out) :: hltalt ! Appropriately modified hlat - ! Term to account for d(es)/dT in transition region. - real(r8), intent(out), optional :: tterm - - ! Local variables - real(r8) :: tc ! Temperature in degrees C - real(r8) :: weight ! Weight for es transition from water to ice - ! Loop iterator - integer :: i - - if (present(tterm)) tterm = 0.0_r8 - - call no_ip_hltalt(t,hltalt) - if (t < tmelt) then - ! Weighting of hlat accounts for transition from water to ice. - tc = t - tmelt - - if (tc >= -ttrice) then - weight = -tc/ttrice - - ! polynomial expression approximates difference between es - ! over water and es over ice from 0 to -ttrice (C) (max of - ! ttrice is 40): required for accurate estimate of es - ! derivative in transition range from ice to water - if (present(tterm)) then - do i = size(pcf), 1, -1 - tterm = pcf(i) + tc*tterm - end do - tterm = tterm/ttrice - end if - - else - weight = 1.0_r8 - end if - - hltalt = hltalt + weight*latice - - end if - -end subroutine calc_hltalt - -!--------------------------------------------------------------------- -! OPTIONAL OUTPUTS -!--------------------------------------------------------------------- - -! Temperature derivative outputs, for qsat_* -elemental subroutine deriv_outputs(t, p, es, qs, hltalt, tterm, & - gam, dqsdt) - - ! Inputs - real(r8), intent(in) :: t ! Temperature - real(r8), intent(in) :: p ! Pressure - real(r8), intent(in) :: es ! Saturation vapor pressure - real(r8), intent(in) :: qs ! Saturation specific humidity - real(r8), intent(in) :: hltalt ! Modified latent heat - real(r8), intent(in) :: tterm ! Extra term for d(es)/dT in - ! transition region. - - ! Outputs - real(r8), intent(out), optional :: gam ! (hltalt/cpair)*(d(qs)/dt) - real(r8), intent(out), optional :: dqsdt ! (d(qs)/dt) - - ! Local variables - real(r8) :: desdt ! d(es)/dt - real(r8) :: dqsdt_loc ! local copy of dqsdt - - if (qs == 1.0_r8) then - dqsdt_loc = 0._r8 - else - desdt = hltalt*es/(rh2o*t*t) + tterm - dqsdt_loc = qs*p*desdt/(es*(p-omeps*es)) - end if - - if (present(dqsdt)) dqsdt = dqsdt_loc - if (present(gam)) gam = dqsdt_loc * (hltalt/cpair) - -end subroutine deriv_outputs - -!--------------------------------------------------------------------- -! QSAT (SPECIFIC HUMIDITY) PROCEDURES -!--------------------------------------------------------------------- - -elemental subroutine qsat(t, p, es, qs, gam, dqsdt, enthalpy) - !------------------------------------------------------------------! - ! Purpose: ! - ! Look up and return saturation vapor pressure from precomputed ! - ! table, then calculate and return saturation specific humidity. ! - ! Optionally return various temperature derivatives or enthalpy ! - ! at saturation. ! - !------------------------------------------------------------------! - - ! Inputs - real(r8), intent(in) :: t ! Temperature - real(r8), intent(in) :: p ! Pressure - ! Outputs - real(r8), intent(out) :: es ! Saturation vapor pressure - real(r8), intent(out) :: qs ! Saturation specific humidity - - real(r8), intent(out), optional :: gam ! (l/cpair)*(d(qs)/dt) - real(r8), intent(out), optional :: dqsdt ! (d(qs)/dt) - real(r8), intent(out), optional :: enthalpy ! cpair*t + hltalt*q - - ! Local variables - real(r8) :: hltalt ! Modified latent heat for T derivatives - real(r8) :: tterm ! Account for d(es)/dT in transition region - - es = estblf(t) - - qs = svp_to_qsat(es, p) - - ! Ensures returned es is consistent with limiters on qs. - es = min(es, p) - - ! Calculate optional arguments. - if (present(gam) .or. present(dqsdt) .or. present(enthalpy)) then - - ! "generalized" analytic expression for t derivative of es - ! accurate to within 1 percent for 173.16 < t < 373.16 - call calc_hltalt(t, hltalt, tterm) - - if (present(enthalpy)) enthalpy = tq_enthalpy(t, qs, hltalt) - - call deriv_outputs(t, p, es, qs, hltalt, tterm, & - gam=gam, dqsdt=dqsdt) - - end if - -end subroutine qsat - -elemental subroutine qsat_water(t, p, es, qs, gam, dqsdt, enthalpy) - !------------------------------------------------------------------! - ! Purpose: ! - ! Calculate SVP over water at a given temperature, and then ! - ! calculate and return saturation specific humidity. ! - ! Optionally return various temperature derivatives or enthalpy ! - ! at saturation. ! - !------------------------------------------------------------------! - - use wv_sat_methods, only: wv_sat_qsat_water - - ! Inputs - real(r8), intent(in) :: t ! Temperature - real(r8), intent(in) :: p ! Pressure - ! Outputs - real(r8), intent(out) :: es ! Saturation vapor pressure - real(r8), intent(out) :: qs ! Saturation specific humidity - - real(r8), intent(out), optional :: gam ! (l/cpair)*(d(qs)/dt) - real(r8), intent(out), optional :: dqsdt ! (d(qs)/dt) - real(r8), intent(out), optional :: enthalpy ! cpair*t + hltalt*q - - ! Local variables - real(r8) :: hltalt ! Modified latent heat for T derivatives - - call wv_sat_qsat_water(t, p, es, qs) - - if (present(gam) .or. present(dqsdt) .or. present(enthalpy)) then - - ! "generalized" analytic expression for t derivative of es - ! accurate to within 1 percent for 173.16 < t < 373.16 - call no_ip_hltalt(t, hltalt) - - if (present(enthalpy)) enthalpy = tq_enthalpy(t, qs, hltalt) - - ! For pure water/ice transition term is 0. - call deriv_outputs(t, p, es, qs, hltalt, 0._r8, & - gam=gam, dqsdt=dqsdt) - - end if - -end subroutine qsat_water - -elemental subroutine qsat_ice(t, p, es, qs, gam, dqsdt, enthalpy) - !------------------------------------------------------------------! - ! Purpose: ! - ! Calculate SVP over ice at a given temperature, and then ! - ! calculate and return saturation specific humidity. ! - ! Optionally return various temperature derivatives or enthalpy ! - ! at saturation. ! - !------------------------------------------------------------------! - - use wv_sat_methods, only: wv_sat_qsat_ice - - ! Inputs - real(r8), intent(in) :: t ! Temperature - real(r8), intent(in) :: p ! Pressure - ! Outputs - real(r8), intent(out) :: es ! Saturation vapor pressure - real(r8), intent(out) :: qs ! Saturation specific humidity - - real(r8), intent(out), optional :: gam ! (l/cpair)*(d(qs)/dt) - real(r8), intent(out), optional :: dqsdt ! (d(qs)/dt) - real(r8), intent(out), optional :: enthalpy ! cpair*t + hltalt*q - - ! Local variables - real(r8) :: hltalt ! Modified latent heat for T derivatives - - call wv_sat_qsat_ice(t, p, es, qs) - - if (present(gam) .or. present(dqsdt) .or. present(enthalpy)) then - - ! For pure ice, just add latent heats. - hltalt = latvap + latice - - if (present(enthalpy)) enthalpy = tq_enthalpy(t, qs, hltalt) - - ! For pure water/ice transition term is 0. - call deriv_outputs(t, p, es, qs, hltalt, 0._r8, & - gam=gam, dqsdt=dqsdt) - - end if - -end subroutine qsat_ice - -!--------------------------------------------------------------------- -! FINDSP (WET BULB TEMPERATURE) PROCEDURES -!--------------------------------------------------------------------- - -subroutine findsp_vc(q, t, p, use_ice, tsp, qsp) - - use cam_logfile, only: iulog - use cam_abortutils, only: endrun - - ! Wrapper for findsp which is 1D and handles the output status. - ! Changing findsp to elemental restricted debugging output. - ! If that output is needed again, it's preferable *not* to copy findsp, - ! but to change the existing version. - - ! input arguments - real(r8), intent(in) :: q(:) ! water vapor (kg/kg) - real(r8), intent(in) :: t(:) ! temperature (K) - real(r8), intent(in) :: p(:) ! pressure (Pa) - logical, intent(in) :: use_ice ! flag to include ice phase in calculations - - ! output arguments - real(r8), intent(out) :: tsp(:) ! saturation temp (K) - real(r8), intent(out) :: qsp(:) ! saturation mixing ratio (kg/kg) - - integer :: status(size(q)) ! flag representing state of output - ! 0 => Successful convergence - ! 1 => No calculation done: pressure or specific - ! humidity not within usable range - ! 2 => Run failed to converge - ! 4 => Temperature fell below minimum - ! 8 => Enthalpy not conserved - - integer :: n, i - - n = size(q) - - call findsp(q, t, p, use_ice, tsp, qsp, status) - - ! Currently, only 2 and 8 seem to be treated as fatal errors. - do i = 1,n - if (status(i) == 2) then - write(iulog,*) ' findsp not converging at i = ', i - write(iulog,*) ' t, q, p ', t(i), q(i), p(i) - write(iulog,*) ' tsp, qsp ', tsp(i), qsp(i) - call endrun ('wv_saturation::FINDSP -- not converging') - else if (status(i) == 8) then - write(iulog,*) ' the enthalpy is not conserved at i = ', i - write(iulog,*) ' t, q, p ', t(i), q(i), p(i) - write(iulog,*) ' tsp, qsp ', tsp(i), qsp(i) - call endrun ('wv_saturation::FINDSP -- enthalpy is not conserved') - endif - end do - -end subroutine findsp_vc - -elemental subroutine findsp (q, t, p, use_ice, tsp, qsp, status) -!----------------------------------------------------------------------- -! -! Purpose: -! find the wet bulb temperature for a given t and q -! in a longitude height section -! wet bulb temp is the temperature and spec humidity that is -! just saturated and has the same enthalpy -! if q > qs(t) then tsp > t and qsp = qs(tsp) < q -! if q < qs(t) then tsp < t and qsp = qs(tsp) > q -! -! Method: -! a Newton method is used -! first guess uses an algorithm provided by John Petch from the UKMO -! we exclude points where the physical situation is unrealistic -! e.g. where the temperature is outside the range of validity for the -! saturation vapor pressure, or where the water vapor pressure -! exceeds the ambient pressure, or the saturation specific humidity is -! unrealistic -! -! Author: P. Rasch -! -!----------------------------------------------------------------------- -! -! input arguments -! - - real(r8), intent(in) :: q ! water vapor (kg/kg) - real(r8), intent(in) :: t ! temperature (K) - real(r8), intent(in) :: p ! pressure (Pa) - logical, intent(in) :: use_ice ! flag to include ice phase in calculations -! -! output arguments -! - real(r8), intent(out) :: tsp ! saturation temp (K) - real(r8), intent(out) :: qsp ! saturation mixing ratio (kg/kg) - integer, intent(out) :: status ! flag representing state of output - ! 0 => Successful convergence - ! 1 => No calculation done: pressure or specific - ! humidity not within usable range - ! 2 => Run failed to converge - ! 4 => Temperature fell below minimum - ! 8 => Enthalpy not conserved -! -! local variables -! - integer, parameter :: iter = 8 ! max number of times to iterate the calculation - integer :: l ! iterator - - real(r8) es ! sat. vapor pressure - real(r8) gam ! change in sat spec. hum. wrt temperature (times hltalt/cpair) - real(r8) dgdt ! work variable - real(r8) g ! work variable - real(r8) hltalt ! lat. heat. of vap. - real(r8) qs ! spec. hum. of water vapor - -! work variables - real(r8) t1, q1, dt, dq - real(r8) qvd - real(r8) r1b, c1, c2 - real(r8), parameter :: dttol = 1.e-4_r8 ! the relative temp error tolerance required to quit the iteration - real(r8), parameter :: dqtol = 1.e-4_r8 ! the relative moisture error tolerance required to quit the iteration - real(r8) enin, enout - - ! Saturation specific humidity at this temperature - if (use_ice) then - call qsat(t, p, es, qs) - else - call qsat_water(t, p, es, qs) - end if - - ! make sure a meaningful calculation is possible - if (p <= 5._r8*es .or. qs <= 0._r8 .or. qs >= 0.5_r8 & - .or. t < tmin .or. t > tmax) then - status = 1 - ! Keep initial parameters when conditions aren't suitable - tsp = t - qsp = q - enin = 1._r8 - enout = 1._r8 - - return - end if - - ! Prepare to iterate - status = 2 - - ! Get initial enthalpy - if (use_ice) then - call calc_hltalt(t,hltalt) - else - call no_ip_hltalt(t,hltalt) - end if - enin = tq_enthalpy(t, q, hltalt) - - ! make a guess at the wet bulb temp using a UKMO algorithm (from J. Petch) - c1 = hltalt*c3 - c2 = (t + 36._r8)**2 - r1b = c2/(c2 + c1*qs) - qvd = r1b * (q - qs) - tsp = t + ((hltalt/cpair)*qvd) - - ! Generate qsp, gam, and enout from tsp. - if (use_ice) then - call qsat(tsp, p, es, qsp, gam=gam, enthalpy=enout) - else - call qsat_water(tsp, p, es, qsp, gam=gam, enthalpy=enout) - end if - - ! iterate on first guess - do l = 1, iter - - g = enin - enout - dgdt = -cpair * (1 + gam) - - ! New tsp - t1 = tsp - g/dgdt - dt = abs(t1 - tsp)/t1 - tsp = t1 - - ! bail out if past end of temperature range - if ( tsp < tmin ) then - tsp = tmin - ! Get latent heat and set qsp to a value - ! that preserves enthalpy. - if (use_ice) then - call calc_hltalt(tsp,hltalt) - else - call no_ip_hltalt(tsp,hltalt) - end if - qsp = (enin - cpair*tsp)/hltalt - enout = tq_enthalpy(tsp, qsp, hltalt) - status = 4 - exit - end if - - ! Re-generate qsp, gam, and enout from new tsp. - if (use_ice) then - call qsat(tsp, p, es, q1, gam=gam, enthalpy=enout) - else - call qsat_water(tsp, p, es, q1, gam=gam, enthalpy=enout) - end if - dq = abs(q1 - qsp)/max(q1,1.e-12_r8) - qsp = q1 - - ! if converged at this point, exclude it from more iterations - if (dt < dttol .and. dq < dqtol) then - status = 0 - exit - endif - end do - - ! Test for enthalpy conservation - if (abs((enin-enout)/(enin+enout)) > 1.e-4_r8) status = 8 - -end subroutine findsp - -end module wv_saturation diff --git a/src/physics/cam/zm_conv.F90 b/src/physics/cam/zm_conv.F90 deleted file mode 100644 index 99c2d36232..0000000000 --- a/src/physics/cam/zm_conv.F90 +++ /dev/null @@ -1,4722 +0,0 @@ -module zm_conv - -!--------------------------------------------------------------------------------- -! Purpose: -! -! Interface from Zhang-McFarlane convection scheme, includes evaporation of convective -! precip from the ZM scheme -! -! Apr 2006: RBN: Code added to perform a dilute ascent for closure of the CM mass flux -! based on an entraining plume a la Raymond and Blythe (1992) -! -! Author: Byron Boville, from code in tphysbc -! -!--------------------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: masterproc - use ppgrid, only: pcols, pver, pverp - use cloud_fraction, only: cldfrc_fice - use physconst, only: cpair, epsilo, gravit, latice, latvap, tmelt, rair, & - cpwv, cpliq, rh2o - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use zm_microphysics, only: zm_mphy, zm_aero_t, zm_conv_t - - implicit none - - save - private ! Make default type private to the module -! -! PUBLIC: interfaces -! - public zm_convi ! ZM schemea - public zm_convr ! ZM schemea - public zm_conv_evap ! evaporation of precip from ZM schemea - public convtran ! convective transport - public momtran ! convective momentum transport - -! -! Private data -! - real(r8) rl ! wg latent heat of vaporization. - real(r8) cpres ! specific heat at constant pressure in j/kg-degk. - real(r8), parameter :: capelmt = 70._r8 ! threshold value for cape for deep convection. - real(r8) :: ke ! Tunable evaporation efficiency set from namelist input zmconv_ke - real(r8) :: ke_lnd - real(r8) :: c0_lnd ! set from namelist input zmconv_c0_lnd - real(r8) :: c0_ocn ! set from namelist input zmconv_c0_ocn - integer :: num_cin ! set from namelist input zmconv_num_cin - ! The number of negative buoyancy regions that are allowed - ! before the convection top and CAPE calculations are completed. - logical :: zm_org - real(r8) tau ! convective time scale - real(r8),parameter :: c1 = 6.112_r8 - real(r8),parameter :: c2 = 17.67_r8 - real(r8),parameter :: c3 = 243.5_r8 - real(r8) :: tfreez - real(r8) :: eps1 - real(r8) :: momcu - real(r8) :: momcd - - logical :: zmconv_microp - - logical :: no_deep_pbl ! default = .false. - ! no_deep_pbl = .true. eliminates deep convection entirely within PBL - - -!moved from moistconvection.F90 - real(r8) :: rgrav ! reciprocal of grav - real(r8) :: rgas ! gas constant for dry air - real(r8) :: grav ! = gravit - real(r8) :: cp ! = cpres = cpair - - integer limcnv ! top interface level limit for convection - - real(r8),parameter :: tiedke_add = 0.5_r8 - -contains - - -subroutine zm_convi(limcnv_in, zmconv_c0_lnd, zmconv_c0_ocn, zmconv_ke, zmconv_ke_lnd, & - zmconv_momcu, zmconv_momcd, zmconv_num_cin, zmconv_org, & - zmconv_microp_in, no_deep_pbl_in) - - integer, intent(in) :: limcnv_in ! top interface level limit for convection - integer, intent(in) :: zmconv_num_cin ! Number negative buoyancy regions that are allowed - ! before the convection top and CAPE calculations are completed. - real(r8),intent(in) :: zmconv_c0_lnd - real(r8),intent(in) :: zmconv_c0_ocn - real(r8),intent(in) :: zmconv_ke - real(r8),intent(in) :: zmconv_ke_lnd - real(r8),intent(in) :: zmconv_momcu - real(r8),intent(in) :: zmconv_momcd - logical :: zmconv_org - logical, intent(in) :: zmconv_microp_in - logical, intent(in), optional :: no_deep_pbl_in ! no_deep_pbl = .true. eliminates ZM convection entirely within PBL - - - ! Initialization of ZM constants - limcnv = limcnv_in - tfreez = tmelt - eps1 = epsilo - rl = latvap - cpres = cpair - rgrav = 1.0_r8/gravit - rgas = rair - grav = gravit - cp = cpres - - c0_lnd = zmconv_c0_lnd - c0_ocn = zmconv_c0_ocn - num_cin = zmconv_num_cin - ke = zmconv_ke - ke_lnd = zmconv_ke_lnd - zm_org = zmconv_org - momcu = zmconv_momcu - momcd = zmconv_momcd - - zmconv_microp = zmconv_microp_in - - if ( present(no_deep_pbl_in) ) then - no_deep_pbl = no_deep_pbl_in - else - no_deep_pbl = .false. - endif - - tau = 3600._r8 - - if ( masterproc ) then - write(iulog,*) 'tuning parameters zm_convi: tau',tau - write(iulog,*) 'tuning parameters zm_convi: c0_lnd',c0_lnd, ', c0_ocn', c0_ocn - write(iulog,*) 'tuning parameters zm_convi: num_cin', num_cin - write(iulog,*) 'tuning parameters zm_convi: ke',ke - write(iulog,*) 'tuning parameters zm_convi: no_deep_pbl',no_deep_pbl - endif - - if (masterproc) write(iulog,*)'**** ZM: DILUTE Buoyancy Calculation ****' - -end subroutine zm_convi - - - -subroutine zm_convr(lchnk ,ncol , & - t ,qh ,prec ,jctop ,jcbot , & - pblh ,zm ,geos ,zi ,qtnd , & - heat ,pap ,paph ,dpp , & - delt ,mcon ,cme ,cape , & - tpert ,dlf ,pflx ,zdu ,rprd , & - mu ,md ,du ,eu ,ed , & - dp ,dsubcld ,jt ,maxg ,ideep , & - ql ,rliq ,landfrac, & - org ,orgt ,org2d , & - dif ,dnlf ,dnif ,conv , & - aero , rice) -!----------------------------------------------------------------------- -! -! Purpose: -! Main driver for zhang-mcfarlane convection scheme -! -! Method: -! performs deep convective adjustment based on mass-flux closure -! algorithm. -! -! Author:guang jun zhang, m.lazare, n.mcfarlane. CAM Contact: P. Rasch -! -! This is contributed code not fully standardized by the CAM core group. -! All variables have been typed, where most are identified in comments -! The current procedure will be reimplemented in a subsequent version -! of the CAM where it will include a more straightforward formulation -! and will make use of the standard CAM nomenclature -! -!----------------------------------------------------------------------- - use phys_control, only: cam_physpkg_is - -! -! ************************ index of variables ********************** -! -! wg * alpha array of vertical differencing used (=1. for upstream). -! w * cape convective available potential energy. -! wg * capeg gathered convective available potential energy. -! c * capelmt threshold value for cape for deep convection. -! ic * cpres specific heat at constant pressure in j/kg-degk. -! i * dpp -! ic * delt length of model time-step in seconds. -! wg * dp layer thickness in mbs (between upper/lower interface). -! wg * dqdt mixing ratio tendency at gathered points. -! wg * dsdt dry static energy ("temp") tendency at gathered points. -! wg * dudt u-wind tendency at gathered points. -! wg * dvdt v-wind tendency at gathered points. -! wg * dsubcld layer thickness in mbs between lcl and maxi. -! ic * grav acceleration due to gravity in m/sec2. -! wg * du detrainment in updraft. specified in mid-layer -! wg * ed entrainment in downdraft. -! wg * eu entrainment in updraft. -! wg * hmn moist static energy. -! wg * hsat saturated moist static energy. -! w * ideep holds position of gathered points vs longitude index. -! ic * pver number of model levels. -! wg * j0 detrainment initiation level index. -! wg * jd downdraft initiation level index. -! ic * jlatpr gaussian latitude index for printing grids (if needed). -! wg * jt top level index of deep cumulus convection. -! w * lcl base level index of deep cumulus convection. -! wg * lclg gathered values of lcl. -! w * lel index of highest theoretical convective plume. -! wg * lelg gathered values of lel. -! w * lon index of onset level for deep convection. -! w * maxi index of level with largest moist static energy. -! wg * maxg gathered values of maxi. -! wg * mb cloud base mass flux. -! wg * mc net upward (scaled by mb) cloud mass flux. -! wg * md downward cloud mass flux (positive up). -! wg * mu upward cloud mass flux (positive up). specified -! at interface -! ic * msg number of missing moisture levels at the top of model. -! w * p grid slice of ambient mid-layer pressure in mbs. -! i * pblt row of pbl top indices. -! w * pcpdh scaled surface pressure. -! w * pf grid slice of ambient interface pressure in mbs. -! wg * pg grid slice of gathered values of p. -! w * q grid slice of mixing ratio. -! wg * qd grid slice of mixing ratio in downdraft. -! wg * qg grid slice of gathered values of q. -! i/o * qh grid slice of specific humidity. -! w * qh0 grid slice of initial specific humidity. -! wg * qhat grid slice of upper interface mixing ratio. -! wg * ql grid slice of cloud liquid water. -! wg * qs grid slice of saturation mixing ratio. -! w * qstp grid slice of parcel temp. saturation mixing ratio. -! wg * qstpg grid slice of gathered values of qstp. -! wg * qu grid slice of mixing ratio in updraft. -! ic * rgas dry air gas constant. -! wg * rl latent heat of vaporization. -! w * s grid slice of scaled dry static energy (t+gz/cp). -! wg * sd grid slice of dry static energy in downdraft. -! wg * sg grid slice of gathered values of s. -! wg * shat grid slice of upper interface dry static energy. -! wg * su grid slice of dry static energy in updraft. -! i/o * t -! o * jctop row of top-of-deep-convection indices passed out. -! O * jcbot row of base of cloud indices passed out. -! wg * tg grid slice of gathered values of t. -! w * tl row of parcel temperature at lcl. -! wg * tlg grid slice of gathered values of tl. -! w * tp grid slice of parcel temperatures. -! wg * tpg grid slice of gathered values of tp. -! i/o * u grid slice of u-wind (real). -! wg * ug grid slice of gathered values of u. -! i/o * utg grid slice of u-wind tendency (real). -! i/o * v grid slice of v-wind (real). -! w * va work array re-used by called subroutines. -! wg * vg grid slice of gathered values of v. -! i/o * vtg grid slice of v-wind tendency (real). -! i * w grid slice of diagnosed large-scale vertical velocity. -! w * z grid slice of ambient mid-layer height in metres. -! w * zf grid slice of ambient interface height in metres. -! wg * zfg grid slice of gathered values of zf. -! wg * zg grid slice of gathered values of z. -! -!----------------------------------------------------------------------- -! -! multi-level i/o fields: -! i => input arrays. -! i/o => input/output arrays. -! w => work arrays. -! wg => work arrays operating only on gathered points. -! ic => input data constants. -! c => data constants pertaining to subroutine itself. -! -! input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncol ! number of atmospheric columns - - real(r8), intent(in) :: t(pcols,pver) ! grid slice of temperature at mid-layer. - real(r8), intent(in) :: qh(pcols,pver) ! grid slice of specific humidity. - real(r8), intent(in) :: pap(pcols,pver) - real(r8), intent(in) :: paph(pcols,pver+1) - real(r8), intent(in) :: dpp(pcols,pver) ! local sigma half-level thickness (i.e. dshj). - real(r8), intent(in) :: zm(pcols,pver) - real(r8), intent(in) :: geos(pcols) - real(r8), intent(in) :: zi(pcols,pver+1) - real(r8), intent(in) :: pblh(pcols) - real(r8), intent(in) :: tpert(pcols) - real(r8), intent(in) :: landfrac(pcols) ! RBN Landfrac - - type(zm_conv_t), intent(inout) :: conv - type(zm_aero_t), intent(inout) :: aero ! aerosol object. intent(inout) because the - ! gathered arrays are set here - ! before passing object - ! to microphysics -! output arguments -! - real(r8), intent(out) :: qtnd(pcols,pver) ! specific humidity tendency (kg/kg/s) - real(r8), intent(out) :: heat(pcols,pver) ! heating rate (dry static energy tendency, W/kg) - real(r8), intent(out) :: mcon(pcols,pverp) - real(r8), intent(out) :: dlf(pcols,pver) ! scattrd version of the detraining cld h2o tend - real(r8), intent(out) :: pflx(pcols,pverp) ! scattered precip flux at each level - real(r8), intent(out) :: cme(pcols,pver) - real(r8), intent(out) :: cape(pcols) ! w convective available potential energy. - real(r8), intent(out) :: zdu(pcols,pver) - real(r8), intent(out) :: rprd(pcols,pver) ! rain production rate - real(r8), intent(out) :: dif(pcols,pver) ! detrained convective cloud ice mixing ratio. - real(r8), intent(out) :: dnlf(pcols,pver) ! detrained convective cloud water num concen. - real(r8), intent(out) :: dnif(pcols,pver) ! detrained convective cloud ice num concen. - -! move these vars from local storage to output so that convective -! transports can be done in outside of conv_cam. - real(r8), intent(out) :: mu(pcols,pver) - real(r8), intent(out) :: eu(pcols,pver) - real(r8), intent(out) :: du(pcols,pver) - real(r8), intent(out) :: md(pcols,pver) - real(r8), intent(out) :: ed(pcols,pver) - real(r8), intent(out) :: dp(pcols,pver) ! wg layer thickness in mbs (between upper/lower interface). - real(r8), intent(out) :: dsubcld(pcols) ! wg layer thickness in mbs between lcl and maxi. - real(r8), intent(out) :: jctop(pcols) ! o row of top-of-deep-convection indices passed out. - real(r8), intent(out) :: jcbot(pcols) ! o row of base of cloud indices passed out. - real(r8), intent(out) :: prec(pcols) - real(r8), intent(out) :: rliq(pcols) ! reserved liquid (not yet in cldliq) for energy integrals - real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldce) for energy integrals - - integer, intent(out) :: ideep(pcols) ! column indices of gathered points - - type(zm_conv_t) :: loc_conv - - real(r8), pointer :: org(:,:) ! Only used if zm_org is true - real(r8), pointer :: orgt(:,:) ! Only used if zm_org is true - real(r8), pointer :: org2d(:,:) ! Only used if zm_org is true - - real(r8) zs(pcols) - real(r8) dlg(pcols,pver) ! gathrd version of the detraining cld h2o tend - real(r8) pflxg(pcols,pverp) ! gather precip flux at each level - real(r8) cug(pcols,pver) ! gathered condensation rate - - real(r8) evpg(pcols,pver) ! gathered evap rate of rain in downdraft - real(r8) orgavg(pcols) - real(r8) dptot(pcols) - real(r8) mumax(pcols) - integer jt(pcols) ! wg top level index of deep cumulus convection. - integer maxg(pcols) ! wg gathered values of maxi. - integer lengath -! diagnostic field used by chem/wetdep codes - real(r8) ql(pcols,pver) ! wg grid slice of cloud liquid water. -! - real(r8) pblt(pcols) ! i row of pbl top indices. - - - - -! -!----------------------------------------------------------------------- -! -! general work fields (local variables): -! - real(r8) q(pcols,pver) ! w grid slice of mixing ratio. - real(r8) p(pcols,pver) ! w grid slice of ambient mid-layer pressure in mbs. - real(r8) z(pcols,pver) ! w grid slice of ambient mid-layer height in metres. - real(r8) s(pcols,pver) ! w grid slice of scaled dry static energy (t+gz/cp). - real(r8) tp(pcols,pver) ! w grid slice of parcel temperatures. - real(r8) zf(pcols,pver+1) ! w grid slice of ambient interface height in metres. - real(r8) pf(pcols,pver+1) ! w grid slice of ambient interface pressure in mbs. - real(r8) qstp(pcols,pver) ! w grid slice of parcel temp. saturation mixing ratio. - - real(r8) tl(pcols) ! w row of parcel temperature at lcl. - - integer lcl(pcols) ! w base level index of deep cumulus convection. - integer lel(pcols) ! w index of highest theoretical convective plume. - integer lon(pcols) ! w index of onset level for deep convection. - integer maxi(pcols) ! w index of level with largest moist static energy. - - real(r8) precip -! -! gathered work fields: -! - real(r8) qg(pcols,pver) ! wg grid slice of gathered values of q. - real(r8) tg(pcols,pver) ! w grid slice of temperature at interface. - real(r8) pg(pcols,pver) ! wg grid slice of gathered values of p. - real(r8) zg(pcols,pver) ! wg grid slice of gathered values of z. - real(r8) sg(pcols,pver) ! wg grid slice of gathered values of s. - real(r8) tpg(pcols,pver) ! wg grid slice of gathered values of tp. - real(r8) zfg(pcols,pver+1) ! wg grid slice of gathered values of zf. - real(r8) qstpg(pcols,pver) ! wg grid slice of gathered values of qstp. - real(r8) ug(pcols,pver) ! wg grid slice of gathered values of u. - real(r8) vg(pcols,pver) ! wg grid slice of gathered values of v. - real(r8) cmeg(pcols,pver) - - real(r8) rprdg(pcols,pver) ! wg gathered rain production rate - real(r8) capeg(pcols) ! wg gathered convective available potential energy. - real(r8) tlg(pcols) ! wg grid slice of gathered values of tl. - real(r8) landfracg(pcols) ! wg grid slice of landfrac - - integer lclg(pcols) ! wg gathered values of lcl. - integer lelg(pcols) -! -! work fields arising from gathered calculations. -! - real(r8) dqdt(pcols,pver) ! wg mixing ratio tendency at gathered points. - real(r8) dsdt(pcols,pver) ! wg dry static energy ("temp") tendency at gathered points. -! real(r8) alpha(pcols,pver) ! array of vertical differencing used (=1. for upstream). - real(r8) sd(pcols,pver) ! wg grid slice of dry static energy in downdraft. - real(r8) qd(pcols,pver) ! wg grid slice of mixing ratio in downdraft. - real(r8) mc(pcols,pver) ! wg net upward (scaled by mb) cloud mass flux. - real(r8) qhat(pcols,pver) ! wg grid slice of upper interface mixing ratio. - real(r8) qu(pcols,pver) ! wg grid slice of mixing ratio in updraft. - real(r8) su(pcols,pver) ! wg grid slice of dry static energy in updraft. - real(r8) qs(pcols,pver) ! wg grid slice of saturation mixing ratio. - real(r8) shat(pcols,pver) ! wg grid slice of upper interface dry static energy. - real(r8) hmn(pcols,pver) ! wg moist static energy. - real(r8) hsat(pcols,pver) ! wg saturated moist static energy. - real(r8) qlg(pcols,pver) - real(r8) dudt(pcols,pver) ! wg u-wind tendency at gathered points. - real(r8) dvdt(pcols,pver) ! wg v-wind tendency at gathered points. -! real(r8) ud(pcols,pver) -! real(r8) vd(pcols,pver) - - - - - - - - real(r8) qldeg(pcols,pver) ! cloud liquid water mixing ratio for detrainment (kg/kg) - real(r8) mb(pcols) ! wg cloud base mass flux. - - integer jlcl(pcols) - integer j0(pcols) ! wg detrainment initiation level index. - integer jd(pcols) ! wg downdraft initiation level index. - - real(r8) delt ! length of model time-step in seconds. - - integer i - integer ii - integer k, kk, l, m - - integer msg ! ic number of missing moisture levels at the top of model. - real(r8) qdifr - real(r8) sdifr - - real(r8), parameter :: dcon = 25.e-6_r8 - real(r8), parameter :: mucon = 5.3_r8 - real(r8) negadq - logical doliq - - -! -!--------------------------Data statements------------------------------ - -! -! Set internal variable "msg" (convection limit) to "limcnv-1" -! - msg = limcnv - 1 -! -! initialize necessary arrays. -! zero out variables not used in cam -! - - if (zm_org) then - orgt(:,:) = 0._r8 - end if - - qtnd(:,:) = 0._r8 - heat(:,:) = 0._r8 - mcon(:,:) = 0._r8 - rliq(:ncol) = 0._r8 - rice(:ncol) = 0._r8 - - if (zmconv_microp) then - allocate( & - loc_conv%frz(pcols,pver), & - loc_conv%sprd(pcols,pver), & - loc_conv%wu(pcols,pver), & - loc_conv%qi(pcols,pver), & - loc_conv%qliq(pcols,pver), & - loc_conv%qice(pcols,pver), & - loc_conv%qrain(pcols,pver), & - loc_conv%qsnow(pcols,pver), & - loc_conv%di(pcols,pver), & - loc_conv%dnl(pcols,pver), & - loc_conv%dni(pcols,pver), & - loc_conv%qnl(pcols,pver), & - loc_conv%qni(pcols,pver), & - loc_conv%qnr(pcols,pver), & - loc_conv%qns(pcols,pver), & - loc_conv%qide(pcols,pver), & - loc_conv%qncde(pcols,pver), & - loc_conv%qnide(pcols,pver), & - loc_conv%autolm(pcols,pver), & - loc_conv%accrlm(pcols,pver), & - loc_conv%bergnm(pcols,pver), & - loc_conv%fhtimm(pcols,pver), & - loc_conv%fhtctm(pcols,pver), & - loc_conv%fhmlm(pcols,pver), & - loc_conv%hmpim(pcols,pver), & - loc_conv%accslm(pcols,pver), & - loc_conv%dlfm(pcols,pver), & - loc_conv%cmel(pcols,pver), & - loc_conv%autoln(pcols,pver), & - loc_conv%accrln(pcols,pver), & - loc_conv%bergnn(pcols,pver), & - loc_conv%fhtimn(pcols,pver), & - loc_conv%fhtctn(pcols,pver), & - loc_conv%fhmln(pcols,pver), & - loc_conv%accsln(pcols,pver), & - loc_conv%activn(pcols,pver), & - loc_conv%dlfn(pcols,pver), & - loc_conv%autoim(pcols,pver), & - loc_conv%accsim(pcols,pver), & - loc_conv%difm(pcols,pver), & - loc_conv%cmei(pcols,pver), & - loc_conv%nuclin(pcols,pver), & - loc_conv%autoin(pcols,pver), & - loc_conv%accsin(pcols,pver), & - loc_conv%hmpin(pcols,pver), & - loc_conv%difn(pcols,pver), & - loc_conv%trspcm(pcols,pver), & - loc_conv%trspcn(pcols,pver), & - loc_conv%trspim(pcols,pver), & - loc_conv%trspin(pcols,pver), & - loc_conv%lambdadpcu(pcols,pver), & - loc_conv%mudpcu(pcols,pver), & - loc_conv%dcape(pcols) ) - end if - -! -! initialize convective tendencies -! - prec(:ncol) = 0._r8 - do k = 1,pver - do i = 1,ncol - dqdt(i,k) = 0._r8 - dsdt(i,k) = 0._r8 - dudt(i,k) = 0._r8 - dvdt(i,k) = 0._r8 - pflx(i,k) = 0._r8 - pflxg(i,k) = 0._r8 - cme(i,k) = 0._r8 - rprd(i,k) = 0._r8 - zdu(i,k) = 0._r8 - ql(i,k) = 0._r8 - qlg(i,k) = 0._r8 - dlf(i,k) = 0._r8 - dlg(i,k) = 0._r8 - qldeg(i,k) = 0._r8 - - dif(i,k) = 0._r8 - dnlf(i,k) = 0._r8 - dnif(i,k) = 0._r8 - - end do - end do - - if (zmconv_microp) then - do k = 1,pver - do i = 1,ncol - loc_conv%qliq(i,k) = 0._r8 - loc_conv%qice(i,k) = 0._r8 - loc_conv%di(i,k) = 0._r8 - loc_conv%qrain(i,k)= 0._r8 - loc_conv%qsnow(i,k)= 0._r8 - loc_conv%dnl(i,k) = 0._r8 - loc_conv%dni(i,k) = 0._r8 - loc_conv%wu(i,k) = 0._r8 - loc_conv%qnl(i,k) = 0._r8 - loc_conv%qni(i,k) = 0._r8 - loc_conv%qnr(i,k) = 0._r8 - loc_conv%qns(i,k) = 0._r8 - loc_conv%frz(i,k) = 0._r8 - loc_conv%sprd(i,k) = 0._r8 - loc_conv%qide(i,k) = 0._r8 - loc_conv%qncde(i,k) = 0._r8 - loc_conv%qnide(i,k) = 0._r8 - - loc_conv%autolm(i,k) = 0._r8 - loc_conv%accrlm(i,k) = 0._r8 - loc_conv%bergnm(i,k) = 0._r8 - loc_conv%fhtimm(i,k) = 0._r8 - loc_conv%fhtctm(i,k) = 0._r8 - loc_conv%fhmlm (i,k) = 0._r8 - loc_conv%hmpim (i,k) = 0._r8 - loc_conv%accslm(i,k) = 0._r8 - loc_conv%dlfm (i,k) = 0._r8 - - loc_conv%autoln(i,k) = 0._r8 - loc_conv%accrln(i,k) = 0._r8 - loc_conv%bergnn(i,k) = 0._r8 - loc_conv%fhtimn(i,k) = 0._r8 - loc_conv%fhtctn(i,k) = 0._r8 - loc_conv%fhmln (i,k) = 0._r8 - loc_conv%accsln(i,k) = 0._r8 - loc_conv%activn(i,k) = 0._r8 - loc_conv%dlfn (i,k) = 0._r8 - loc_conv%cmel (i,k) = 0._r8 - - loc_conv%autoim(i,k) = 0._r8 - loc_conv%accsim(i,k) = 0._r8 - loc_conv%difm (i,k) = 0._r8 - loc_conv%cmei (i,k) = 0._r8 - - loc_conv%nuclin(i,k) = 0._r8 - loc_conv%autoin(i,k) = 0._r8 - loc_conv%accsin(i,k) = 0._r8 - loc_conv%hmpin (i,k) = 0._r8 - loc_conv%difn (i,k) = 0._r8 - - loc_conv%trspcm(i,k) = 0._r8 - loc_conv%trspcn(i,k) = 0._r8 - loc_conv%trspim(i,k) = 0._r8 - loc_conv%trspin(i,k) = 0._r8 - - conv%qi(i,k) = 0._r8 - conv%frz(i,k) = 0._r8 - conv%sprd(i,k) = 0._r8 - conv%qi(i,k) = 0._r8 - conv%qliq(i,k) = 0._r8 - conv%qice(i,k) = 0._r8 - conv%qnl(i,k) = 0._r8 - conv%qni(i,k) = 0._r8 - conv%qnr(i,k) = 0._r8 - conv%qns(i,k) = 0._r8 - conv%qrain(i,k) = 0._r8 - conv%qsnow(i,k) = 0._r8 - conv%wu(i,k) = 0._r8 - - conv%autolm(i,k) = 0._r8 - conv%accrlm(i,k) = 0._r8 - conv%bergnm(i,k) = 0._r8 - conv%fhtimm(i,k) = 0._r8 - conv%fhtctm(i,k) = 0._r8 - conv%fhmlm (i,k) = 0._r8 - conv%hmpim (i,k) = 0._r8 - conv%accslm(i,k) = 0._r8 - conv%dlfm (i,k) = 0._r8 - - conv%autoln(i,k) = 0._r8 - conv%accrln(i,k) = 0._r8 - conv%bergnn(i,k) = 0._r8 - conv%fhtimn(i,k) = 0._r8 - conv%fhtctn(i,k) = 0._r8 - conv%fhmln (i,k) = 0._r8 - conv%accsln(i,k) = 0._r8 - conv%activn(i,k) = 0._r8 - conv%dlfn (i,k) = 0._r8 - conv%cmel (i,k) = 0._r8 - - conv%autoim(i,k) = 0._r8 - conv%accsim(i,k) = 0._r8 - conv%difm (i,k) = 0._r8 - conv%cmei (i,k) = 0._r8 - - conv%nuclin(i,k) = 0._r8 - conv%autoin(i,k) = 0._r8 - conv%accsin(i,k) = 0._r8 - conv%hmpin (i,k) = 0._r8 - conv%difn (i,k) = 0._r8 - - conv%trspcm(i,k) = 0._r8 - conv%trspcn(i,k) = 0._r8 - conv%trspim(i,k) = 0._r8 - conv%trspin(i,k) = 0._r8 - - end do - end do - - conv%lambdadpcu = (mucon + 1._r8)/dcon - conv%mudpcu = mucon - loc_conv%lambdadpcu = conv%lambdadpcu - loc_conv%mudpcu = conv%mudpcu - - end if - - do i = 1,ncol - pflx(i,pverp) = 0 - pflxg(i,pverp) = 0 - end do -! - do i = 1,ncol - pblt(i) = pver - dsubcld(i) = 0._r8 - - - jctop(i) = pver - jcbot(i) = 1 - - end do - - if (zmconv_microp) then - do i = 1,ncol - conv%dcape(i) = 0._r8 - loc_conv%dcape(i) = 0._r8 - end do - end if - - if (zm_org) then -! compute vertical average here - orgavg(:) = 0._r8 - dptot(:) = 0._r8 - - do k = 1, pver - do i = 1,ncol - if (org(i,k) .gt. 0) then - orgavg(i) = orgavg(i)+dpp(i,k)*org(i,k) - dptot(i) = dptot(i)+dpp(i,k) - endif - enddo - enddo - - do i = 1,ncol - if (dptot(i) .gt. 0) then - orgavg(i) = orgavg(i)/dptot(i) - endif - enddo - - do k = 1, pver - do i = 1, ncol - org2d(i,k) = orgavg(i) - enddo - enddo - - endif - -! -! calculate local pressure (mbs) and height (m) for both interface -! and mid-layer locations. -! - do i = 1,ncol - zs(i) = geos(i)*rgrav - pf(i,pver+1) = paph(i,pver+1)*0.01_r8 - zf(i,pver+1) = zi(i,pver+1) + zs(i) - end do - do k = 1,pver - do i = 1,ncol - p(i,k) = pap(i,k)*0.01_r8 - pf(i,k) = paph(i,k)*0.01_r8 - z(i,k) = zm(i,k) + zs(i) - zf(i,k) = zi(i,k) + zs(i) - end do - end do -! - do k = pver - 1,msg + 1,-1 - do i = 1,ncol - if (abs(z(i,k)-zs(i)-pblh(i)) < (zf(i,k)-zf(i,k+1))*0.5_r8) pblt(i) = k - end do - end do -! -! store incoming specific humidity field for subsequent calculation -! of precipitation (through change in storage). -! define dry static energy (normalized by cp). -! - do k = 1,pver - do i = 1,ncol - q(i,k) = qh(i,k) - s(i,k) = t(i,k) + (grav/cpres)*z(i,k) - tp(i,k)=0.0_r8 - shat(i,k) = s(i,k) - qhat(i,k) = q(i,k) - end do - end do - - do i = 1,ncol - capeg(i) = 0._r8 - lclg(i) = 1 - lelg(i) = pver - maxg(i) = 1 - tlg(i) = 400._r8 - dsubcld(i) = 0._r8 - end do - - if( cam_physpkg_is('cam3')) then - - ! For cam3 physics package, call non-dilute - - call buoyan(lchnk ,ncol , & - q ,t ,p ,z ,pf , & - tp ,qstp ,tl ,rl ,cape , & - pblt ,lcl ,lel ,lon ,maxi , & - rgas ,grav ,cpres ,msg , & - tpert ) - else - - ! Evaluate Tparcel, qs(Tparcel), buoyancy and CAPE, - ! lcl, lel, parcel launch level at index maxi()=hmax - - call buoyan_dilute(lchnk ,ncol , & - q ,t ,p ,z ,pf , & - tp ,qstp ,tl ,rl ,cape , & - pblt ,lcl ,lel ,lon ,maxi , & - rgas ,grav ,cpres ,msg , & - tpert , org2d , landfrac) - end if - -! -! determine whether grid points will undergo some deep convection -! (ideep=1) or not (ideep=0), based on values of cape,lcl,lel -! (require cape.gt. 0 and lel capelmt) then - lengath = lengath + 1 - ideep(lengath) = i - end if - end do - - if (lengath.eq.0) return -! -! obtain gathered arrays necessary for ensuing calculations. -! - do k = 1,pver - do i = 1,lengath - dp(i,k) = 0.01_r8*dpp(ideep(i),k) - qg(i,k) = q(ideep(i),k) - tg(i,k) = t(ideep(i),k) - pg(i,k) = p(ideep(i),k) - zg(i,k) = z(ideep(i),k) - sg(i,k) = s(ideep(i),k) - tpg(i,k) = tp(ideep(i),k) - zfg(i,k) = zf(ideep(i),k) - qstpg(i,k) = qstp(ideep(i),k) - ug(i,k) = 0._r8 - vg(i,k) = 0._r8 - end do - end do - - if (zmconv_microp) then - - if (aero%scheme == 'modal') then - - do m = 1, aero%nmodes - - do k = 1,pver - do i = 1,lengath - aero%numg_a(i,k,m) = aero%num_a(m)%val(ideep(i),k) - aero%dgnumg(i,k,m) = aero%dgnum(m)%val(ideep(i),k) - end do - end do - - do l = 1, aero%nspec(m) - do k = 1,pver - do i = 1,lengath - aero%mmrg_a(i,k,l,m) = aero%mmr_a(l,m)%val(ideep(i),k) - end do - end do - end do - - end do - - else if (aero%scheme == 'bulk') then - - do m = 1, aero%nbulk - do k = 1,pver - do i = 1,lengath - aero%mmrg_bulk(i,k,m) = aero%mmr_bulk(m)%val(ideep(i),k) - end do - end do - end do - - end if - - end if - -! - do i = 1,lengath - zfg(i,pver+1) = zf(ideep(i),pver+1) - end do - do i = 1,lengath - capeg(i) = cape(ideep(i)) - lclg(i) = lcl(ideep(i)) - lelg(i) = lel(ideep(i)) - maxg(i) = maxi(ideep(i)) - tlg(i) = tl(ideep(i)) - landfracg(i) = landfrac(ideep(i)) - end do -! -! calculate sub-cloud layer pressure "thickness" for use in -! closure and tendency routines. -! - do k = msg + 1,pver - do i = 1,lengath - if (k >= maxg(i)) then - dsubcld(i) = dsubcld(i) + dp(i,k) - end if - end do - end do -! -! define array of factors (alpha) which defines interfacial -! values, as well as interfacial values for (q,s) used in -! subsequent routines. -! - do k = msg + 2,pver - do i = 1,lengath -! alpha(i,k) = 0.5 - sdifr = 0._r8 - qdifr = 0._r8 - if (sg(i,k) > 0._r8 .or. sg(i,k-1) > 0._r8) & - sdifr = abs((sg(i,k)-sg(i,k-1))/max(sg(i,k-1),sg(i,k))) - if (qg(i,k) > 0._r8 .or. qg(i,k-1) > 0._r8) & - qdifr = abs((qg(i,k)-qg(i,k-1))/max(qg(i,k-1),qg(i,k))) - if (sdifr > 1.E-6_r8) then - shat(i,k) = log(sg(i,k-1)/sg(i,k))*sg(i,k-1)*sg(i,k)/(sg(i,k-1)-sg(i,k)) - else - shat(i,k) = 0.5_r8* (sg(i,k)+sg(i,k-1)) - end if - if (qdifr > 1.E-6_r8) then - qhat(i,k) = log(qg(i,k-1)/qg(i,k))*qg(i,k-1)*qg(i,k)/(qg(i,k-1)-qg(i,k)) - else - qhat(i,k) = 0.5_r8* (qg(i,k)+qg(i,k-1)) - end if - end do - end do -! -! obtain cloud properties. -! - - call cldprp(lchnk , & - qg ,tg ,ug ,vg ,pg , & - zg ,sg ,mu ,eu ,du , & - md ,ed ,sd ,qd ,mc , & - qu ,su ,zfg ,qs ,hmn , & - hsat ,shat ,qlg , & - cmeg ,maxg ,lelg ,jt ,jlcl , & - maxg ,j0 ,jd ,rl ,lengath , & - rgas ,grav ,cpres ,msg , & - pflxg ,evpg ,cug ,rprdg ,limcnv ,landfracg , & - qldeg ,aero ,loc_conv,qhat ) - - if (zmconv_microp) then - do i = 1,lengath - capeg(i) = capeg(i)+ loc_conv%dcape(i) - end do - end if - -! -! convert detrainment from units of "1/m" to "1/mb". -! - - do k = msg + 1,pver - do i = 1,lengath - du (i,k) = du (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - eu (i,k) = eu (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - ed (i,k) = ed (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - cug (i,k) = cug (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - cmeg (i,k) = cmeg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - rprdg(i,k) = rprdg(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - evpg (i,k) = evpg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - end do - end do - - if (zmconv_microp) then - do k = msg + 1,pver - do i = 1,lengath - loc_conv%sprd(i,k) = loc_conv%sprd(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - loc_conv%frz (i,k) = loc_conv%frz (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - end do - end do - end if - - call closure(lchnk , & - qg ,tg ,pg ,zg ,sg , & - tpg ,qs ,qu ,su ,mc , & - du ,mu ,md ,qd ,sd , & - qhat ,shat ,dp ,qstpg ,zfg , & - qlg ,dsubcld ,mb ,capeg ,tlg , & - lclg ,lelg ,jt ,maxg ,1 , & - lengath ,rgas ,grav ,cpres ,rl , & - msg ,capelmt ) -! -! limit cloud base mass flux to theoretical upper bound. -! - do i=1,lengath - mumax(i) = 0 - end do - do k=msg + 2,pver - do i=1,lengath - mumax(i) = max(mumax(i), mu(i,k)/dp(i,k)) - end do - end do - - do i=1,lengath - if (mumax(i) > 0._r8) then - mb(i) = min(mb(i),0.5_r8/(delt*mumax(i))) - else - mb(i) = 0._r8 - endif - end do - ! If no_deep_pbl = .true., don't allow convection entirely - ! within PBL (suggestion of Bjorn Stevens, 8-2000) - - if (no_deep_pbl) then - do i=1,lengath - if (zm(ideep(i),jt(i)) < pblh(ideep(i))) mb(i) = 0 - end do - end if - - if (zmconv_microp) then - do k=msg+1,pver - do i=1,lengath - loc_conv%sprd(i,k) = loc_conv%sprd(i,k)*mb(i) - loc_conv%frz (i,k) = loc_conv%frz (i,k)*mb(i) - end do - end do - end if - - do k=msg+1,pver - do i=1,lengath - mu (i,k) = mu (i,k)*mb(i) - md (i,k) = md (i,k)*mb(i) - mc (i,k) = mc (i,k)*mb(i) - du (i,k) = du (i,k)*mb(i) - eu (i,k) = eu (i,k)*mb(i) - ed (i,k) = ed (i,k)*mb(i) - cmeg (i,k) = cmeg (i,k)*mb(i) - rprdg(i,k) = rprdg(i,k)*mb(i) - cug (i,k) = cug (i,k)*mb(i) - evpg (i,k) = evpg (i,k)*mb(i) - pflxg(i,k+1)= pflxg(i,k+1)*mb(i)*100._r8/grav - - - if ( zmconv_microp .and. mb(i).eq.0._r8) then - qlg (i,k) = 0._r8 - loc_conv%qliq (i,k) = 0._r8 - loc_conv%qice (i,k) = 0._r8 - loc_conv%qrain(i,k) = 0._r8 - loc_conv%qsnow(i,k) = 0._r8 - loc_conv%wu(i,k) = 0._r8 - loc_conv%qnl (i,k) = 0._r8 - loc_conv%qni (i,k) = 0._r8 - loc_conv%qnr (i,k) = 0._r8 - loc_conv%qns (i,k) = 0._r8 - - loc_conv%autolm(i,k) = 0._r8 - loc_conv%accrlm(i,k) = 0._r8 - loc_conv%bergnm(i,k) = 0._r8 - loc_conv%fhtimm(i,k) = 0._r8 - loc_conv%fhtctm(i,k) = 0._r8 - loc_conv%fhmlm (i,k) = 0._r8 - loc_conv%hmpim (i,k) = 0._r8 - loc_conv%accslm(i,k) = 0._r8 - loc_conv%dlfm (i,k) = 0._r8 - - loc_conv%autoln(i,k) = 0._r8 - loc_conv%accrln(i,k) = 0._r8 - loc_conv%bergnn(i,k) = 0._r8 - loc_conv%fhtimn(i,k) = 0._r8 - loc_conv%fhtctn(i,k) = 0._r8 - loc_conv%fhmln (i,k) = 0._r8 - loc_conv%accsln(i,k) = 0._r8 - loc_conv%activn(i,k) = 0._r8 - loc_conv%dlfn (i,k) = 0._r8 - loc_conv%cmel (i,k) = 0._r8 - - loc_conv%autoim(i,k) = 0._r8 - loc_conv%accsim(i,k) = 0._r8 - loc_conv%difm (i,k) = 0._r8 - loc_conv%cmei (i,k) = 0._r8 - - loc_conv%nuclin(i,k) = 0._r8 - loc_conv%autoin(i,k) = 0._r8 - loc_conv%accsin(i,k) = 0._r8 - loc_conv%hmpin (i,k) = 0._r8 - loc_conv%difn (i,k) = 0._r8 - - loc_conv%trspcm(i,k) = 0._r8 - loc_conv%trspcn(i,k) = 0._r8 - loc_conv%trspim(i,k) = 0._r8 - loc_conv%trspin(i,k) = 0._r8 - end if - end do - end do -! -! compute temperature and moisture changes due to convection. -! - call q1q2_pjr(lchnk , & - dqdt ,dsdt ,qg ,qs ,qu , & - su ,du ,qhat ,shat ,dp , & - mu ,md ,sd ,qd ,qldeg , & - dsubcld ,jt ,maxg ,1 ,lengath , & - cpres ,rl ,msg , & - dlg ,evpg ,cug , & - loc_conv ) -! -! gather back temperature and mixing ratio. -! - - if (zmconv_microp) then - do k = msg + 1,pver - do i = 1,lengath - if (dqdt(i,k)*2._r8*delt+qg(i,k)<0._r8) then - negadq = (dqdt(i,k)+0.5_r8*qg(i,k)/delt)/0.9999_r8 - dqdt(i,k) = dqdt(i,k)-negadq - - do kk=k,jt(i),-1 - if (negadq<0._r8) then - if (rprdg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres - if (rprdg(i,kk)>loc_conv%sprd(i,kk)) then - if(rprdg(i,kk)-loc_conv%sprd(i,kk)<-negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + (negadq+ (rprdg(i,kk)-loc_conv%sprd(i,kk))*dp(i,kk)/dp(i,k))*latice/cpres - loc_conv%sprd(i,kk) = negadq*dp(i,k)/dp(i,kk)+rprdg(i,kk) - end if - else - loc_conv%sprd(i,kk) = loc_conv%sprd(i,kk)+negadq*dp(i,k)/dp(i,kk) - dsdt(i,k) = dsdt(i,k) + negadq*latice/cpres - end if - rprdg(i,kk) = rprdg(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - negadq = rprdg(i,kk)*dp(i,kk)/dp(i,k)+negadq - dsdt(i,k) = dsdt(i,k) - rprdg(i,kk)*rl/cpres*dp(i,kk)/dp(i,k) - if (rprdg(i,kk)>loc_conv%sprd(i,kk)) then - dsdt(i,k) = dsdt(i,k) - loc_conv%sprd(i,kk)*latice/cpres*dp(i,kk)/dp(i,k) - loc_conv%sprd(i,kk) = 0._r8 - else - dsdt(i,k) = dsdt(i,k) -rprdg(i,kk)*latice/cpres*dp(i,kk)/dp(i,k) - loc_conv%sprd(i,kk)= loc_conv%sprd(i,kk)- rprdg(i,kk) - end if - rprdg(i,kk) = 0._r8 - end if - - if (dlg(i,kk)>loc_conv%di(i,kk)) then - doliq= .true. - else - doliq= .false. - end if - - if (negadq<0._r8) then - if (doliq) then - if (dlg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres - loc_conv%dnl(i,kk) = loc_conv%dnl(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dlg(i,kk)) - dlg(i,kk) = dlg(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - negadq = negadq + dlg(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - dlg(i,kk)*dp(i,kk)/dp(i,k)*rl/cpres - dlg(i,kk) = 0._r8 - loc_conv%dnl(i,kk) = 0._r8 - end if - else - if (loc_conv%di(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + negadq*(rl+latice)/cpres - loc_conv%dni(i,kk) = loc_conv%dni(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/loc_conv%di(i,kk)) - loc_conv%di(i,kk) = loc_conv%di(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - negadq = negadq + loc_conv%di(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - loc_conv%di(i,kk)*dp(i,kk)/dp(i,k)*(rl+latice)/cpres - loc_conv%di(i,kk) = 0._r8 - loc_conv%dni(i,kk) = 0._r8 - end if - doliq= .false. - end if - end if - if (negadq<0._r8 .and. doliq ) then - if (dlg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres - loc_conv%dnl(i,kk) = loc_conv%dnl(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dlg(i,kk)) - dlg(i,kk) = dlg(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - negadq = negadq + dlg(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - dlg(i,kk)*dp(i,kk)/dp(i,k)*rl/cpres - dlg(i,kk) = 0._r8 - loc_conv%dnl(i,kk) = 0._r8 - end if - end if - - end if - end do - - if (negadq<0._r8) then - dqdt(i,k) = dqdt(i,k) + negadq - end if - - end if - end do - end do - end if - - do k = msg + 1,pver - do i = 1,lengath -! -! q is updated to compute net precip. -! - q(ideep(i),k) = qh(ideep(i),k) + 2._r8*delt*dqdt(i,k) - qtnd(ideep(i),k) = dqdt (i,k) - cme (ideep(i),k) = cmeg (i,k) - rprd(ideep(i),k) = rprdg(i,k) - zdu (ideep(i),k) = du (i,k) - mcon(ideep(i),k) = mc (i,k) - heat(ideep(i),k) = dsdt (i,k)*cpres - dlf (ideep(i),k) = dlg (i,k) - pflx(ideep(i),k) = pflxg(i,k) - ql (ideep(i),k) = qlg (i,k) - end do - end do - - if (zmconv_microp) then - do k = msg + 1,pver - do i = 1,lengath - dif (ideep(i),k) = loc_conv%di (i,k) - dnlf(ideep(i),k) = loc_conv%dnl (i,k) - dnif(ideep(i),k) = loc_conv%dni (i,k) - - conv%qi (ideep(i),k) = loc_conv%qice(i,k) - conv%frz(ideep(i),k) = loc_conv%frz(i,k)*latice/cpres - conv%sprd(ideep(i),k) = loc_conv%sprd(i,k) - conv%wu (ideep(i),k) = loc_conv%wu (i,k) - conv%qliq(ideep(i),k) = loc_conv%qliq (i,k) - conv%qice(ideep(i),k) = loc_conv%qice (i,k) - conv%qrain(ideep(i),k) = loc_conv%qrain (i,k) - conv%qsnow(ideep(i),k) = loc_conv%qsnow (i,k) - conv%qnl(ideep(i),k) = loc_conv%qnl(i,k) - conv%qni(ideep(i),k) = loc_conv%qni(i,k) - conv%qnr(ideep(i),k) = loc_conv%qnr(i,k) - conv%qns(ideep(i),k) = loc_conv%qns(i,k) - - conv%autolm(ideep(i),k) = loc_conv%autolm(i,k) - conv%accrlm(ideep(i),k) = loc_conv%accrlm(i,k) - conv%bergnm(ideep(i),k) = loc_conv%bergnm(i,k) - conv%fhtimm(ideep(i),k) = loc_conv%fhtimm(i,k) - conv%fhtctm(ideep(i),k) = loc_conv%fhtctm(i,k) - conv%fhmlm (ideep(i),k) = loc_conv%fhmlm (i,k) - conv%hmpim (ideep(i),k) = loc_conv%hmpim (i,k) - conv%accslm(ideep(i),k) = loc_conv%accslm(i,k) - conv%dlfm (ideep(i),k) = loc_conv%dlfm (i,k) - - conv%autoln(ideep(i),k) = loc_conv%autoln(i,k) - conv%accrln(ideep(i),k) = loc_conv%accrln(i,k) - conv%bergnn(ideep(i),k) = loc_conv%bergnn(i,k) - conv%fhtimn(ideep(i),k) = loc_conv%fhtimn(i,k) - conv%fhtctn(ideep(i),k) = loc_conv%fhtctn(i,k) - conv%fhmln (ideep(i),k) = loc_conv%fhmln (i,k) - conv%accsln(ideep(i),k) = loc_conv%accsln(i,k) - conv%activn(ideep(i),k) = loc_conv%activn(i,k) - conv%dlfn (ideep(i),k) = loc_conv%dlfn (i,k) - conv%cmel (ideep(i),k) = loc_conv%cmel (i,k) - - conv%autoim(ideep(i),k) = loc_conv%autoim(i,k) - conv%accsim(ideep(i),k) = loc_conv%accsim(i,k) - conv%difm (ideep(i),k) = loc_conv%difm (i,k) - conv%cmei (ideep(i),k) = loc_conv%cmei (i,k) - - conv%nuclin(ideep(i),k) = loc_conv%nuclin(i,k) - conv%autoin(ideep(i),k) = loc_conv%autoin(i,k) - conv%accsin(ideep(i),k) = loc_conv%accsin(i,k) - conv%hmpin (ideep(i),k) = loc_conv%hmpin (i,k) - conv%difn (ideep(i),k) = loc_conv%difn (i,k) - - conv%trspcm(ideep(i),k) = loc_conv%trspcm(i,k) - conv%trspcn(ideep(i),k) = loc_conv%trspcn(i,k) - conv%trspim(ideep(i),k) = loc_conv%trspim(i,k) - conv%trspin(ideep(i),k) = loc_conv%trspin(i,k) - conv%lambdadpcu(ideep(i),k) = loc_conv%lambdadpcu(i,k) - conv%mudpcu(ideep(i),k) = loc_conv%mudpcu(i,k) - - end do - end do - - do k = msg + 1,pver - do i = 1,ncol - - !convert it from units of "kg/kg" to "g/m3" - - if(k.lt.pver) then - conv%qice (i,k) = 0.5_r8*(conv%qice(i,k)+conv%qice(i,k+1)) - conv%qliq (i,k) = 0.5_r8*(conv%qliq(i,k)+conv%qliq(i,k+1)) - conv%qrain (i,k) = 0.5_r8*(conv%qrain(i,k)+conv%qrain(i,k+1)) - conv%qsnow (i,k) = 0.5_r8*(conv%qsnow(i,k)+conv%qsnow(i,k+1)) - conv%qni (i,k) = 0.5_r8*(conv%qni(i,k)+conv%qni(i,k+1)) - conv%qnl (i,k) = 0.5_r8*(conv%qnl(i,k)+conv%qnl(i,k+1)) - conv%qnr (i,k) = 0.5_r8*(conv%qnr(i,k)+conv%qnr(i,k+1)) - conv%qns (i,k) = 0.5_r8*(conv%qns(i,k)+conv%qns(i,k+1)) - conv%wu(i,k) = 0.5_r8*(conv%wu(i,k)+conv%wu(i,k+1)) - end if - - if (t(i,k).gt. 273.15_r8 .and. t(i,k-1).le.273.15_r8) then - conv%qice (i,k-1) = conv%qice (i,k-1) + conv%qice (i,k) - conv%qice (i,k) = 0._r8 - conv%qni (i,k-1) = conv%qni (i,k-1) + conv%qni (i,k) - conv%qni (i,k) = 0._r8 - conv%qsnow (i,k-1) = conv%qsnow (i,k-1) + conv%qsnow (i,k) - conv%qsnow (i,k) = 0._r8 - conv%qns (i,k-1) = conv%qns (i,k-1) + conv%qns (i,k) - conv%qns (i,k) = 0._r8 - end if - - conv%qice (i,k) = conv%qice(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8 - conv%qliq (i,k) = conv%qliq(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8 - conv%qrain (i,k) = conv%qrain(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8 - conv%qsnow (i,k) = conv%qsnow(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8 - conv%qni (i,k) = conv%qni(i,k) * pap(i,k)/t(i,k)/rgas - conv%qnl (i,k) = conv%qnl(i,k) * pap(i,k)/t(i,k)/rgas - conv%qnr (i,k) = conv%qnr(i,k) * pap(i,k)/t(i,k)/rgas - conv%qns (i,k) = conv%qns(i,k) * pap(i,k)/t(i,k)/rgas - end do - end do - end if - -! - do i = 1,lengath - jctop(ideep(i)) = jt(i) - jcbot(ideep(i)) = maxg(i) - pflx(ideep(i),pverp) = pflxg(i,pverp) - end do - - if (zmconv_microp) then - do i = 1,lengath - conv%dcape(ideep(i)) = loc_conv%dcape(i) - end do - end if - -! Compute precip by integrating change in water vapor minus detrained cloud water - do k = pver,msg + 1,-1 - do i = 1,ncol - prec(i) = prec(i) - dpp(i,k)* (q(i,k)-qh(i,k)) - dpp(i,k)*(dlf(i,k)+dif(i,k))*2._r8*delt - end do - end do - -! obtain final precipitation rate in m/s. - do i = 1,ncol - prec(i) = rgrav*max(prec(i),0._r8)/ (2._r8*delt)/1000._r8 - end do - -! Compute reserved liquid (not yet in cldliq) for energy integrals. -! Treat rliq as flux out bottom, to be added back later. - do k = 1, pver - do i = 1, ncol - rliq(i) = rliq(i) + (dlf(i,k)+dif(i,k))*dpp(i,k)/gravit - rice(i) = rice(i) + dif(i,k)*dpp(i,k)/gravit - end do - end do - rliq(:ncol) = rliq(:ncol) /1000._r8 - rice(:ncol) = rice(:ncol) /1000._r8 - - if (zmconv_microp) then - deallocate( & - loc_conv%frz, & - loc_conv%sprd, & - loc_conv%wu, & - loc_conv%qi, & - loc_conv%qliq, & - loc_conv%qice, & - loc_conv%qrain, & - loc_conv%qsnow, & - loc_conv%di, & - loc_conv%dnl, & - loc_conv%dni, & - loc_conv%qnl, & - loc_conv%qni, & - loc_conv%qnr, & - loc_conv%qns, & - loc_conv%qide, & - loc_conv%qncde, & - loc_conv%qnide, & - loc_conv%autolm, & - loc_conv%accrlm, & - loc_conv%bergnm, & - loc_conv%fhtimm, & - loc_conv%fhtctm, & - loc_conv%fhmlm, & - loc_conv%hmpim, & - loc_conv%accslm, & - loc_conv%dlfm, & - loc_conv%cmel, & - loc_conv%autoln, & - loc_conv%accrln, & - loc_conv%bergnn, & - loc_conv%fhtimn, & - loc_conv%fhtctn, & - loc_conv%fhmln, & - loc_conv%accsln, & - loc_conv%activn, & - loc_conv%dlfn, & - loc_conv%autoim, & - loc_conv%accsim, & - loc_conv%difm, & - loc_conv%cmei, & - loc_conv%nuclin, & - loc_conv%autoin, & - loc_conv%accsin, & - loc_conv%hmpin, & - loc_conv%difn, & - loc_conv%trspcm, & - loc_conv%trspcn, & - loc_conv%trspim, & - loc_conv%trspin, & - loc_conv%lambdadpcu, & - loc_conv%mudpcu, & - loc_conv%dcape ) - end if - - return -end subroutine zm_convr - -!=============================================================================== -subroutine zm_conv_evap(ncol,lchnk, & - t,pmid,pdel,q, & - landfrac, & - tend_s, tend_s_snwprd, tend_s_snwevmlt, tend_q, & - prdprec, cldfrc, deltat, & - prec, snow, ntprprd, ntsnprd, flxprec, flxsnow, prdsnow) - - -!----------------------------------------------------------------------- -! Compute tendencies due to evaporation of rain from ZM scheme -!-- -! Compute the total precipitation and snow fluxes at the surface. -! Add in the latent heat of fusion for snow formation and melt, since it not dealt with -! in the Zhang-MacFarlane parameterization. -! Evaporate some of the precip directly into the environment using a Sundqvist type algorithm -!----------------------------------------------------------------------- - - use wv_saturation, only: qsat - use phys_grid, only: get_rlat_all_p - -!------------------------------Arguments-------------------------------- - integer,intent(in) :: ncol, lchnk ! number of columns and chunk index - real(r8),intent(in), dimension(pcols,pver) :: t ! temperature (K) - real(r8),intent(in), dimension(pcols,pver) :: pmid ! midpoint pressure (Pa) - real(r8),intent(in), dimension(pcols,pver) :: pdel ! layer thickness (Pa) - real(r8),intent(in), dimension(pcols,pver) :: q ! water vapor (kg/kg) - real(r8),intent(in), dimension(pcols) :: landfrac - real(r8),intent(inout), dimension(pcols,pver) :: tend_s ! heating rate (J/kg/s) - real(r8),intent(inout), dimension(pcols,pver) :: tend_q ! water vapor tendency (kg/kg/s) - real(r8),intent(out ), dimension(pcols,pver) :: tend_s_snwprd ! Heating rate of snow production - real(r8),intent(out ), dimension(pcols,pver) :: tend_s_snwevmlt ! Heating rate of evap/melting of snow - - - - real(r8), intent(in ) :: prdprec(pcols,pver)! precipitation production (kg/ks/s) - real(r8), intent(in ) :: cldfrc(pcols,pver) ! cloud fraction - real(r8), intent(in ) :: deltat ! time step - - real(r8), intent(inout) :: prec(pcols) ! Convective-scale preciptn rate - real(r8), intent(out) :: snow(pcols) ! Convective-scale snowfall rate - - real(r8), optional, intent(in), allocatable :: prdsnow(:,:) ! snow production (kg/ks/s) - -! -!---------------------------Local storage------------------------------- - - real(r8) :: es (pcols,pver) ! Saturation vapor pressure - real(r8) :: fice (pcols,pver) ! ice fraction in precip production - real(r8) :: fsnow_conv(pcols,pver) ! snow fraction in precip production - real(r8) :: qs (pcols,pver) ! saturation specific humidity - real(r8),intent(out) :: flxprec(pcols,pverp) ! Convective-scale flux of precip at interfaces (kg/m2/s) - real(r8),intent(out) :: flxsnow(pcols,pverp) ! Convective-scale flux of snow at interfaces (kg/m2/s) - real(r8),intent(out) :: ntprprd(pcols,pver) ! net precip production in layer - real(r8),intent(out) :: ntsnprd(pcols,pver) ! net snow production in layer - real(r8) :: work1 ! temp variable (pjr) - real(r8) :: work2 ! temp variable (pjr) - - real(r8) :: evpvint(pcols) ! vertical integral of evaporation - real(r8) :: evpprec(pcols) ! evaporation of precipitation (kg/kg/s) - real(r8) :: evpsnow(pcols) ! evaporation of snowfall (kg/kg/s) - real(r8) :: snowmlt(pcols) ! snow melt tendency in layer - real(r8) :: flxsntm(pcols) ! flux of snow into layer, after melting - - real(r8) :: kemask - real(r8) :: evplimit ! temp variable for evaporation limits - real(r8) :: rlat(pcols) - real(r8) :: dum - real(r8) :: omsm - - integer :: i,k ! longitude,level indices - logical :: old_snow - - -!----------------------------------------------------------------------- - - ! If prdsnow is passed in and allocated, then use it in the calculation, otherwise - ! use the old snow calculation - old_snow=.true. - if (present(prdsnow)) then - if (allocated(prdsnow)) then - old_snow=.false. - end if - end if - -! convert input precip to kg/m2/s - prec(:ncol) = prec(:ncol)*1000._r8 - -! determine saturation vapor pressure - call qsat(t(1:ncol, 1:pver), pmid(1:ncol, 1:pver), & - es(1:ncol, 1:pver), qs(1:ncol, 1:pver)) - -! determine ice fraction in rain production (use cloud water parameterization fraction at present) - call cldfrc_fice(ncol, t, fice, fsnow_conv) - -! zero the flux integrals on the top boundary - flxprec(:ncol,1) = 0._r8 - flxsnow(:ncol,1) = 0._r8 - evpvint(:ncol) = 0._r8 - omsm=0.9999_r8 - - do k = 1, pver - do i = 1, ncol - -! Melt snow falling into layer, if necessary. - if( old_snow ) then - if (t(i,k) > tmelt) then - flxsntm(i) = 0._r8 - snowmlt(i) = flxsnow(i,k) * gravit/ pdel(i,k) - else - flxsntm(i) = flxsnow(i,k) - snowmlt(i) = 0._r8 - end if - else - ! make sure melting snow doesn't reduce temperature below threshold - if (t(i,k) > tmelt) then - dum = -latice/cpres*flxsnow(i,k)*gravit/pdel(i,k)*deltat - if (t(i,k) + dum .le. tmelt) then - dum = (t(i,k)-tmelt)*cpres/latice/deltat - dum = dum/(flxsnow(i,k)*gravit/pdel(i,k)) - dum = max(0._r8,dum) - dum = min(1._r8,dum) - else - dum = 1._r8 - end if - dum = dum*omsm - flxsntm(i) = flxsnow(i,k)*(1.0_r8-dum) - snowmlt(i) = dum*flxsnow(i,k)*gravit/ pdel(i,k) - else - flxsntm(i) = flxsnow(i,k) - snowmlt(i) = 0._r8 - end if - end if - -! relative humidity depression must be > 0 for evaporation - evplimit = max(1._r8 - q(i,k)/qs(i,k), 0._r8) - - if (zm_org) then - kemask = ke * (1._r8 - landfrac(i)) + ke_lnd * landfrac(i) - else - kemask = ke - endif - -! total evaporation depends on flux in the top of the layer -! flux prec is the net production above layer minus evaporation into environmet - evpprec(i) = kemask * (1._r8 - cldfrc(i,k)) * evplimit * sqrt(flxprec(i,k)) -!********************************************************** -!! evpprec(i) = 0. ! turn off evaporation for now -!********************************************************** - -! Don't let evaporation supersaturate layer (approx). Layer may already be saturated. -! Currently does not include heating/cooling change to qs - evplimit = max(0._r8, (qs(i,k)-q(i,k)) / deltat) - -! Don't evaporate more than is falling into the layer - do not evaporate rain formed -! in this layer but if precip production is negative, remove from the available precip -! Negative precip production occurs because of evaporation in downdrafts. -!!$ evplimit = flxprec(i,k) * gravit / pdel(i,k) + min(prdprec(i,k), 0.) - evplimit = min(evplimit, flxprec(i,k) * gravit / pdel(i,k)) - -! Total evaporation cannot exceed input precipitation - evplimit = min(evplimit, (prec(i) - evpvint(i)) * gravit / pdel(i,k)) - - evpprec(i) = min(evplimit, evpprec(i)) - if( .not.old_snow ) then - evpprec(i) = max(0._r8, evpprec(i)) - evpprec(i) = evpprec(i)*omsm - end if - - -! evaporation of snow depends on snow fraction of total precipitation in the top after melting - if (flxprec(i,k) > 0._r8) then -! evpsnow(i) = evpprec(i) * flxsntm(i) / flxprec(i,k) -! prevent roundoff problems - work1 = min(max(0._r8,flxsntm(i)/flxprec(i,k)),1._r8) - evpsnow(i) = evpprec(i) * work1 - else - evpsnow(i) = 0._r8 - end if - -! vertically integrated evaporation - evpvint(i) = evpvint(i) + evpprec(i) * pdel(i,k)/gravit - -! net precip production is production - evaporation - ntprprd(i,k) = prdprec(i,k) - evpprec(i) -! net snow production is precip production * ice fraction - evaporation - melting -!pjrworks ntsnprd(i,k) = prdprec(i,k)*fice(i,k) - evpsnow(i) - snowmlt(i) -!pjrwrks2 ntsnprd(i,k) = prdprec(i,k)*fsnow_conv(i,k) - evpsnow(i) - snowmlt(i) -! the small amount added to flxprec in the work1 expression has been increased from -! 1e-36 to 8.64e-11 (1e-5 mm/day). This causes the temperature based partitioning -! scheme to be used for small flxprec amounts. This is to address error growth problems. - - if( old_snow ) then -#ifdef PERGRO - work1 = min(max(0._r8,flxsnow(i,k)/(flxprec(i,k)+8.64e-11_r8)),1._r8) -#else - if (flxprec(i,k).gt.0._r8) then - work1 = min(max(0._r8,flxsnow(i,k)/flxprec(i,k)),1._r8) - else - work1 = 0._r8 - endif -#endif - work2 = max(fsnow_conv(i,k), work1) - if (snowmlt(i).gt.0._r8) work2 = 0._r8 -! work2 = fsnow_conv(i,k) - ntsnprd(i,k) = prdprec(i,k)*work2 - evpsnow(i) - snowmlt(i) - tend_s_snwprd (i,k) = prdprec(i,k)*work2*latice - tend_s_snwevmlt(i,k) = - ( evpsnow(i) + snowmlt(i) )*latice - else - ntsnprd(i,k) = prdsnow(i,k) - min(flxsnow(i,k)*gravit/pdel(i,k), evpsnow(i)+snowmlt(i)) - tend_s_snwprd (i,k) = prdsnow(i,k)*latice - tend_s_snwevmlt(i,k) = -min(flxsnow(i,k)*gravit/pdel(i,k), evpsnow(i)+snowmlt(i) )*latice - end if - -! precipitation fluxes - flxprec(i,k+1) = flxprec(i,k) + ntprprd(i,k) * pdel(i,k)/gravit - flxsnow(i,k+1) = flxsnow(i,k) + ntsnprd(i,k) * pdel(i,k)/gravit - -! protect against rounding error - flxprec(i,k+1) = max(flxprec(i,k+1), 0._r8) - flxsnow(i,k+1) = max(flxsnow(i,k+1), 0._r8) -! more protection (pjr) -! flxsnow(i,k+1) = min(flxsnow(i,k+1), flxprec(i,k+1)) - -! heating (cooling) and moistening due to evaporation -! - latent heat of vaporization for precip production has already been accounted for -! - snow is contained in prec - if( old_snow ) then - tend_s(i,k) =-evpprec(i)*latvap + ntsnprd(i,k)*latice - else - tend_s(i,k) =-evpprec(i)*latvap + tend_s_snwevmlt(i,k) - end if - tend_q(i,k) = evpprec(i) - end do - end do - -! set output precipitation rates (m/s) - prec(:ncol) = flxprec(:ncol,pver+1) / 1000._r8 - snow(:ncol) = flxsnow(:ncol,pver+1) / 1000._r8 - -!********************************************************** -!!$ tend_s(:ncol,:) = 0. ! turn heating off -!********************************************************** - - end subroutine zm_conv_evap - - - -subroutine convtran(lchnk , & - doconvtran,q ,ncnst ,mu ,md , & - du ,eu ,ed ,dp ,dsubcld , & - jt ,mx ,ideep ,il1g ,il2g , & - nstep ,fracis ,dqdt ,dpdry ,dt) -!----------------------------------------------------------------------- -! -! Purpose: -! Convective transport of trace species -! -! Mixing ratios may be with respect to either dry or moist air -! -! Method: -! -! -! -! Author: P. Rasch -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use constituents, only: cnst_get_type_byind - use ppgrid - - implicit none -!----------------------------------------------------------------------- -! -! Input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncnst ! number of tracers to transport - logical, intent(in) :: doconvtran(ncnst) ! flag for doing convective transport - real(r8), intent(in) :: q(pcols,pver,ncnst) ! Tracer array including moisture - real(r8), intent(in) :: mu(pcols,pver) ! Mass flux up - real(r8), intent(in) :: md(pcols,pver) ! Mass flux down - real(r8), intent(in) :: du(pcols,pver) ! Mass detraining from updraft - real(r8), intent(in) :: eu(pcols,pver) ! Mass entraining from updraft - real(r8), intent(in) :: ed(pcols,pver) ! Mass entraining from downdraft - real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces - real(r8), intent(in) :: dsubcld(pcols) ! Delta pressure from cloud base to sfc - real(r8), intent(in) :: fracis(pcols,pver,ncnst) ! fraction of tracer that is insoluble - - integer, intent(in) :: jt(pcols) ! Index of cloud top for each column - integer, intent(in) :: mx(pcols) ! Index of cloud top for each column - integer, intent(in) :: ideep(pcols) ! Gathering array - integer, intent(in) :: il1g ! Gathered min lon indices over which to operate - integer, intent(in) :: il2g ! Gathered max lon indices over which to operate - integer, intent(in) :: nstep ! Time step index - - real(r8), intent(in) :: dpdry(pcols,pver) ! Delta pressure between interfaces - - real(r8), intent(in) :: dt ! 2 delta t (model time increment) - -! input/output - - real(r8), intent(out) :: dqdt(pcols,pver,ncnst) ! Tracer tendency array - -!--------------------------Local Variables------------------------------ - - integer i ! Work index - integer k ! Work index - integer kbm ! Highest altitude index of cloud base - integer kk ! Work index - integer kkp1 ! Work index - integer km1 ! Work index - integer kp1 ! Work index - integer ktm ! Highest altitude index of cloud top - integer m ! Work index - - real(r8) cabv ! Mix ratio of constituent above - real(r8) cbel ! Mix ratio of constituent below - real(r8) cdifr ! Normalized diff between cabv and cbel - real(r8) chat(pcols,pver) ! Mix ratio in env at interfaces - real(r8) cond(pcols,pver) ! Mix ratio in downdraft at interfaces - real(r8) const(pcols,pver) ! Gathered tracer array - real(r8) fisg(pcols,pver) ! gathered insoluble fraction of tracer - real(r8) conu(pcols,pver) ! Mix ratio in updraft at interfaces - real(r8) dcondt(pcols,pver) ! Gathered tend array - real(r8) small ! A small number - real(r8) mbsth ! Threshold for mass fluxes - real(r8) mupdudp ! A work variable - real(r8) minc ! A work variable - real(r8) maxc ! A work variable - real(r8) fluxin ! A work variable - real(r8) fluxout ! A work variable - real(r8) netflux ! A work variable - - real(r8) dutmp(pcols,pver) ! Mass detraining from updraft - real(r8) eutmp(pcols,pver) ! Mass entraining from updraft - real(r8) edtmp(pcols,pver) ! Mass entraining from downdraft - real(r8) dptmp(pcols,pver) ! Delta pressure between interfaces - real(r8) total(pcols) - real(r8) negadt,qtmp - -!----------------------------------------------------------------------- -! - small = 1.e-36_r8 -! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s) - mbsth = 1.e-15_r8 - -! Find the highest level top and bottom levels of convection - ktm = pver - kbm = pver - do i = il1g, il2g - ktm = min(ktm,jt(i)) - kbm = min(kbm,mx(i)) - end do - -! Loop ever each constituent - do m = 2, ncnst - if (doconvtran(m)) then - - if (cnst_get_type_byind(m).eq.'dry') then - do k = 1,pver - do i =il1g,il2g - dptmp(i,k) = dpdry(i,k) - dutmp(i,k) = du(i,k)*dp(i,k)/dpdry(i,k) - eutmp(i,k) = eu(i,k)*dp(i,k)/dpdry(i,k) - edtmp(i,k) = ed(i,k)*dp(i,k)/dpdry(i,k) - end do - end do - else - do k = 1,pver - do i =il1g,il2g - dptmp(i,k) = dp(i,k) - dutmp(i,k) = du(i,k) - eutmp(i,k) = eu(i,k) - edtmp(i,k) = ed(i,k) - end do - end do - endif -! dptmp = dp - -! Gather up the constituent and set tend to zero - do k = 1,pver - do i =il1g,il2g - const(i,k) = q(ideep(i),k,m) - fisg(i,k) = fracis(ideep(i),k,m) - end do - end do - -! From now on work only with gathered data - -! Interpolate environment tracer values to interfaces - do k = 1,pver - km1 = max(1,k-1) - do i = il1g, il2g - minc = min(const(i,km1),const(i,k)) - maxc = max(const(i,km1),const(i,k)) - if (minc < 0) then - cdifr = 0._r8 - else - cdifr = abs(const(i,k)-const(i,km1))/max(maxc,small) - endif - -! If the two layers differ significantly use a geometric averaging -! procedure - if (cdifr > 1.E-6_r8) then - cabv = max(const(i,km1),maxc*1.e-12_r8) - cbel = max(const(i,k),maxc*1.e-12_r8) - chat(i,k) = log(cabv/cbel)/(cabv-cbel)*cabv*cbel - - else ! Small diff, so just arithmetic mean - chat(i,k) = 0.5_r8* (const(i,k)+const(i,km1)) - end if - -! Provisional up and down draft values - conu(i,k) = chat(i,k) - cond(i,k) = chat(i,k) - -! provisional tends - dcondt(i,k) = 0._r8 - - end do - end do - -! Do levels adjacent to top and bottom - k = 2 - km1 = 1 - kk = pver - do i = il1g,il2g - mupdudp = mu(i,kk) + dutmp(i,kk)*dptmp(i,kk) - if (mupdudp > mbsth) then - conu(i,kk) = (+eutmp(i,kk)*fisg(i,kk)*const(i,kk)*dptmp(i,kk))/mupdudp - endif - if (md(i,k) < -mbsth) then - cond(i,k) = (-edtmp(i,km1)*fisg(i,km1)*const(i,km1)*dptmp(i,km1))/md(i,k) - endif - end do - -! Updraft from bottom to top - do kk = pver-1,1,-1 - kkp1 = min(pver,kk+1) - do i = il1g,il2g - mupdudp = mu(i,kk) + dutmp(i,kk)*dptmp(i,kk) - if (mupdudp > mbsth) then - conu(i,kk) = ( mu(i,kkp1)*conu(i,kkp1)+eutmp(i,kk)*fisg(i,kk)* & - const(i,kk)*dptmp(i,kk) )/mupdudp - endif - end do - end do - -! Downdraft from top to bottom - do k = 3,pver - km1 = max(1,k-1) - do i = il1g,il2g - if (md(i,k) < -mbsth) then - cond(i,k) = ( md(i,km1)*cond(i,km1)-edtmp(i,km1)*fisg(i,km1)*const(i,km1) & - *dptmp(i,km1) )/md(i,k) - endif - end do - end do - - - do k = ktm,pver - km1 = max(1,k-1) - kp1 = min(pver,k+1) - do i = il1g,il2g - -! version 1 hard to check for roundoff errors -! dcondt(i,k) = -! $ +(+mu(i,kp1)* (conu(i,kp1)-chat(i,kp1)) -! $ -mu(i,k)* (conu(i,k)-chat(i,k)) -! $ +md(i,kp1)* (cond(i,kp1)-chat(i,kp1)) -! $ -md(i,k)* (cond(i,k)-chat(i,k)) -! $ )/dp(i,k) - -! version 2 hard to limit fluxes -! fluxin = mu(i,kp1)*conu(i,kp1) + mu(i,k)*chat(i,k) -! $ -(md(i,k) *cond(i,k) + md(i,kp1)*chat(i,kp1)) -! fluxout = mu(i,k)*conu(i,k) + mu(i,kp1)*chat(i,kp1) -! $ -(md(i,kp1)*cond(i,kp1) + md(i,k)*chat(i,k)) - -! version 3 limit fluxes outside convection to mass in appropriate layer -! these limiters are probably only safe for positive definite quantitities -! it assumes that mu and md already satify a courant number limit of 1 - fluxin = mu(i,kp1)*conu(i,kp1)+ mu(i,k)*min(chat(i,k),const(i,km1)) & - -(md(i,k) *cond(i,k) + md(i,kp1)*min(chat(i,kp1),const(i,kp1))) - fluxout = mu(i,k)*conu(i,k) + mu(i,kp1)*min(chat(i,kp1),const(i,k)) & - -(md(i,kp1)*cond(i,kp1) + md(i,k)*min(chat(i,k),const(i,k))) - - netflux = fluxin - fluxout - if (abs(netflux) < max(fluxin,fluxout)*1.e-12_r8) then - netflux = 0._r8 - endif - dcondt(i,k) = netflux/dptmp(i,k) - end do - end do -! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -! - do k = kbm,pver - km1 = max(1,k-1) - do i = il1g,il2g - if (k == mx(i)) then - -! version 1 -! dcondt(i,k) = (1./dsubcld(i))* -! $ (-mu(i,k)*(conu(i,k)-chat(i,k)) -! $ -md(i,k)*(cond(i,k)-chat(i,k)) -! $ ) - -! version 2 -! fluxin = mu(i,k)*chat(i,k) - md(i,k)*cond(i,k) -! fluxout = mu(i,k)*conu(i,k) - md(i,k)*chat(i,k) -! version 3 - fluxin = mu(i,k)*min(chat(i,k),const(i,km1)) - md(i,k)*cond(i,k) - fluxout = mu(i,k)*conu(i,k) - md(i,k)*min(chat(i,k),const(i,k)) - - netflux = fluxin - fluxout - if (abs(netflux) < max(fluxin,fluxout)*1.e-12_r8) then - netflux = 0._r8 - endif -! dcondt(i,k) = netflux/dsubcld(i) - dcondt(i,k) = netflux/dptmp(i,k) - else if (k > mx(i)) then -! dcondt(i,k) = dcondt(i,k-1) - dcondt(i,k) = 0._r8 - end if - end do - end do - - if (zmconv_microp) then - do i = il1g,il2g - do k = jt(i),mx(i) - if (dcondt(i,k)*dt+const(i,k)<0._r8) then - negadt = dcondt(i,k)+const(i,k)/dt - dcondt(i,k) = -const(i,k)/dt - do kk= k+1, mx(i) - if (negadt<0._r8 .and. dcondt(i,kk)*dt+const(i,kk)>0._r8 ) then - qtmp = dcondt(i,kk)+negadt*dptmp(i,k)/dptmp(i,kk) - if (qtmp*dt+const(i,kk)>0._r8) then - dcondt(i,kk)= qtmp - negadt=0._r8 - else - negadt= negadt+(const(i,kk)/dt+dcondt(i,kk))*dptmp(i,kk)/dptmp(i,k) - dcondt(i,kk)= -const(i,kk)/dt - end if - - end if - end do - do kk= k-1, jt(i), -1 - if (negadt<0._r8 .and. dcondt(i,kk)*dt+const(i,kk)>0._r8 ) then - qtmp = dcondt(i,kk)+negadt*dptmp(i,k)/dptmp(i,kk) - if (qtmp*dt+const(i,kk)>0._r8) then - dcondt(i,kk)= qtmp - negadt=0._r8 - else - negadt= negadt+(const(i,kk)/dt+dcondt(i,kk))*dptmp(i,kk)/dptmp(i,k) - dcondt(i,kk)= -const(i,kk)/dt - end if - end if - end do - - if (negadt<0._r8) then - dcondt(i,k) = dcondt(i,k) + negadt - end if - end if - end do - end do - end if - - -! Initialize to zero everywhere, then scatter tendency back to full array - dqdt(:,:,m) = 0._r8 - do k = 1,pver - kp1 = min(pver,k+1) - do i = il1g,il2g - dqdt(ideep(i),k,m) = dcondt(i,k) - end do - end do - - end if ! for doconvtran - - end do - - return -end subroutine convtran - -!========================================================================================= - -subroutine momtran(lchnk, ncol, & - domomtran,q ,ncnst ,mu ,md , & - du ,eu ,ed ,dp ,dsubcld , & - jt ,mx ,ideep ,il1g ,il2g , & - nstep ,dqdt ,pguall ,pgdall, icwu, icwd, dt, seten ) -!----------------------------------------------------------------------- -! -! Purpose: -! Convective transport of momentum -! -! Mixing ratios may be with respect to either dry or moist air -! -! Method: -! Based on the convtran subroutine by P. Rasch -! -! -! Author: J. Richter and P. Rasch -! -!----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use constituents, only: cnst_get_type_byind - use ppgrid - - implicit none -!----------------------------------------------------------------------- -! -! Input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncol ! number of atmospheric columns - integer, intent(in) :: ncnst ! number of tracers to transport - logical, intent(in) :: domomtran(ncnst) ! flag for doing convective transport - real(r8), intent(in) :: q(pcols,pver,ncnst) ! Wind array - real(r8), intent(in) :: mu(pcols,pver) ! Mass flux up - real(r8), intent(in) :: md(pcols,pver) ! Mass flux down - real(r8), intent(in) :: du(pcols,pver) ! Mass detraining from updraft - real(r8), intent(in) :: eu(pcols,pver) ! Mass entraining from updraft - real(r8), intent(in) :: ed(pcols,pver) ! Mass entraining from downdraft - real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces - real(r8), intent(in) :: dsubcld(pcols) ! Delta pressure from cloud base to sfc - real(r8), intent(in) :: dt ! time step in seconds : 2*delta_t - - integer, intent(in) :: jt(pcols) ! Index of cloud top for each column - integer, intent(in) :: mx(pcols) ! Index of cloud top for each column - integer, intent(in) :: ideep(pcols) ! Gathering array - integer, intent(in) :: il1g ! Gathered min lon indices over which to operate - integer, intent(in) :: il2g ! Gathered max lon indices over which to operate - integer, intent(in) :: nstep ! Time step index - - - -! input/output - - real(r8), intent(out) :: dqdt(pcols,pver,ncnst) ! Tracer tendency array - -!--------------------------Local Variables------------------------------ - - integer i ! Work index - integer k ! Work index - integer kbm ! Highest altitude index of cloud base - integer kk ! Work index - integer kkp1 ! Work index - integer kkm1 ! Work index - integer km1 ! Work index - integer kp1 ! Work index - integer ktm ! Highest altitude index of cloud top - integer m ! Work index - integer ii ! Work index - - real(r8) cabv ! Mix ratio of constituent above - real(r8) cbel ! Mix ratio of constituent below - real(r8) cdifr ! Normalized diff between cabv and cbel - real(r8) chat(pcols,pver) ! Mix ratio in env at interfaces - real(r8) cond(pcols,pver) ! Mix ratio in downdraft at interfaces - real(r8) const(pcols,pver) ! Gathered wind array - real(r8) conu(pcols,pver) ! Mix ratio in updraft at interfaces - real(r8) dcondt(pcols,pver) ! Gathered tend array - real(r8) mbsth ! Threshold for mass fluxes - real(r8) mupdudp ! A work variable - real(r8) minc ! A work variable - real(r8) maxc ! A work variable - real(r8) fluxin ! A work variable - real(r8) fluxout ! A work variable - real(r8) netflux ! A work variable - - real(r8) sum ! sum - real(r8) sum2 ! sum2 - - real(r8) mududp(pcols,pver) ! working variable - real(r8) mddudp(pcols,pver) ! working variable - - real(r8) pgu(pcols,pver) ! Pressure gradient term for updraft - real(r8) pgd(pcols,pver) ! Pressure gradient term for downdraft - - real(r8),intent(out) :: pguall(pcols,pver,ncnst) ! Apparent force from updraft PG - real(r8),intent(out) :: pgdall(pcols,pver,ncnst) ! Apparent force from downdraft PG - - real(r8),intent(out) :: icwu(pcols,pver,ncnst) ! In-cloud winds in updraft - real(r8),intent(out) :: icwd(pcols,pver,ncnst) ! In-cloud winds in downdraft - - real(r8),intent(out) :: seten(pcols,pver) ! Dry static energy tendency - real(r8) gseten(pcols,pver) ! Gathered dry static energy tendency - - real(r8) mflux(pcols,pverp,ncnst) ! Gathered momentum flux - - real(r8) wind0(pcols,pver,ncnst) ! gathered wind before time step - real(r8) windf(pcols,pver,ncnst) ! gathered wind after time step - real(r8) fkeb, fket, ketend_cons, ketend, utop, ubot, vtop, vbot, gset2 - - -!----------------------------------------------------------------------- -! - -! Initialize outgoing fields - pguall(:,:,:) = 0.0_r8 - pgdall(:,:,:) = 0.0_r8 -! Initialize in-cloud winds to environmental wind - icwu(:ncol,:,:) = q(:ncol,:,:) - icwd(:ncol,:,:) = q(:ncol,:,:) - -! Initialize momentum flux and final winds - mflux(:,:,:) = 0.0_r8 - wind0(:,:,:) = 0.0_r8 - windf(:,:,:) = 0.0_r8 - -! Initialize dry static energy - - seten(:,:) = 0.0_r8 - gseten(:,:) = 0.0_r8 - -! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s) - mbsth = 1.e-15_r8 - -! Find the highest level top and bottom levels of convection - ktm = pver - kbm = pver - do i = il1g, il2g - ktm = min(ktm,jt(i)) - kbm = min(kbm,mx(i)) - end do - -! Loop ever each wind component - do m = 1, ncnst !start at m = 1 to transport momentum - if (domomtran(m)) then - -! Gather up the winds and set tend to zero - do k = 1,pver - do i =il1g,il2g - const(i,k) = q(ideep(i),k,m) - wind0(i,k,m) = const(i,k) - end do - end do - - -! From now on work only with gathered data - -! Interpolate winds to interfaces - - do k = 1,pver - km1 = max(1,k-1) - do i = il1g, il2g - - ! use arithmetic mean - chat(i,k) = 0.5_r8* (const(i,k)+const(i,km1)) - -! Provisional up and down draft values - conu(i,k) = chat(i,k) - cond(i,k) = chat(i,k) - -! provisional tends - dcondt(i,k) = 0._r8 - - end do - end do - - -! -! Pressure Perturbation Term -! - - !Top boundary: assume mu is zero - - k=1 - pgu(:il2g,k) = 0.0_r8 - pgd(:il2g,k) = 0.0_r8 - - do k=2,pver-1 - km1 = max(1,k-1) - kp1 = min(pver,k+1) - do i = il1g,il2g - - !interior points - - mududp(i,k) = ( mu(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) & - + mu(i,kp1) * (const(i,kp1) - const(i,k))/dp(i,k)) - - pgu(i,k) = - momcu * 0.5_r8 * mududp(i,k) - - - mddudp(i,k) = ( md(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) & - + md(i,kp1) * (const(i,kp1) - const(i,k))/dp(i,k)) - - pgd(i,k) = - momcd * 0.5_r8 * mddudp(i,k) - - - end do - end do - - ! bottom boundary - k = pver - km1 = max(1,k-1) - do i=il1g,il2g - - mududp(i,k) = mu(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) - pgu(i,k) = - momcu * mududp(i,k) - - mddudp(i,k) = md(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) - - pgd(i,k) = - momcd * mddudp(i,k) - - end do - - -! -! In-cloud velocity calculations -! - -! Do levels adjacent to top and bottom - k = 2 - km1 = 1 - kk = pver - kkm1 = max(1,kk-1) - do i = il1g,il2g - mupdudp = mu(i,kk) + du(i,kk)*dp(i,kk) - if (mupdudp > mbsth) then - - conu(i,kk) = (+eu(i,kk)*const(i,kk)*dp(i,kk)+pgu(i,kk)*dp(i,kk))/mupdudp - endif - if (md(i,k) < -mbsth) then - cond(i,k) = (-ed(i,km1)*const(i,km1)*dp(i,km1))-pgd(i,km1)*dp(i,km1)/md(i,k) - endif - - - end do - - - -! Updraft from bottom to top - do kk = pver-1,1,-1 - kkm1 = max(1,kk-1) - kkp1 = min(pver,kk+1) - do i = il1g,il2g - mupdudp = mu(i,kk) + du(i,kk)*dp(i,kk) - if (mupdudp > mbsth) then - - conu(i,kk) = ( mu(i,kkp1)*conu(i,kkp1)+eu(i,kk)* & - const(i,kk)*dp(i,kk)+pgu(i,kk)*dp(i,kk))/mupdudp - endif - end do - - end do - - -! Downdraft from top to bottom - do k = 3,pver - km1 = max(1,k-1) - do i = il1g,il2g - if (md(i,k) < -mbsth) then - - cond(i,k) = ( md(i,km1)*cond(i,km1)-ed(i,km1)*const(i,km1) & - *dp(i,km1)-pgd(i,km1)*dp(i,km1) )/md(i,k) - - endif - end do - end do - - - sum = 0._r8 - sum2 = 0._r8 - - - do k = ktm,pver - km1 = max(1,k-1) - kp1 = min(pver,k+1) - do i = il1g,il2g - ii = ideep(i) - -! version 1 hard to check for roundoff errors - dcondt(i,k) = & - +(mu(i,kp1)* (conu(i,kp1)-chat(i,kp1)) & - -mu(i,k)* (conu(i,k)-chat(i,k)) & - +md(i,kp1)* (cond(i,kp1)-chat(i,kp1)) & - -md(i,k)* (cond(i,k)-chat(i,k)) & - )/dp(i,k) - - end do - end do - - ! dcont for bottom layer - ! - do k = kbm,pver - km1 = max(1,k-1) - do i = il1g,il2g - if (k == mx(i)) then - - ! version 1 - dcondt(i,k) = (1._r8/dp(i,k))* & - (-mu(i,k)*(conu(i,k)-chat(i,k)) & - -md(i,k)*(cond(i,k)-chat(i,k)) & - ) - end if - end do - end do - -! Initialize to zero everywhere, then scatter tendency back to full array - dqdt(:,:,m) = 0._r8 - - do k = 1,pver - do i = il1g,il2g - ii = ideep(i) - dqdt(ii,k,m) = dcondt(i,k) - ! Output apparent force on the mean flow from pressure gradient - pguall(ii,k,m) = -pgu(i,k) - pgdall(ii,k,m) = -pgd(i,k) - icwu(ii,k,m) = conu(i,k) - icwd(ii,k,m) = cond(i,k) - end do - end do - - ! Calculate momentum flux in units of mb*m/s2 - - do k = ktm,pver - do i = il1g,il2g - ii = ideep(i) - mflux(i,k,m) = & - -mu(i,k)* (conu(i,k)-chat(i,k)) & - -md(i,k)* (cond(i,k)-chat(i,k)) - end do - end do - - - ! Calculate winds at the end of the time step - - do k = ktm,pver - do i = il1g,il2g - ii = ideep(i) - km1 = max(1,k-1) - kp1 = k+1 - windf(i,k,m) = const(i,k) - (mflux(i,kp1,m) - mflux(i,k,m)) * dt /dp(i,k) - - end do - end do - - end if ! for domomtran - end do - - ! Need to add an energy fix to account for the dissipation of kinetic energy - ! Formulation follows from Boville and Bretherton (2003) - ! formulation by PJR - - do k = ktm,pver - km1 = max(1,k-1) - kp1 = min(pver,k+1) - do i = il1g,il2g - - ii = ideep(i) - - ! calculate the KE fluxes at top and bot of layer - ! based on a discrete approximation to b&b eq(35) F_KE = u*F_u + v*F_v at interface - utop = (wind0(i,k,1)+wind0(i,km1,1))/2._r8 - vtop = (wind0(i,k,2)+wind0(i,km1,2))/2._r8 - ubot = (wind0(i,kp1,1)+wind0(i,k,1))/2._r8 - vbot = (wind0(i,kp1,2)+wind0(i,k,2))/2._r8 - fket = utop*mflux(i,k,1) + vtop*mflux(i,k,2) ! top of layer - fkeb = ubot*mflux(i,k+1,1) + vbot*mflux(i,k+1,2) ! bot of layer - - ! divergence of these fluxes should give a conservative redistribution of KE - ketend_cons = (fket-fkeb)/dp(i,k) - - ! tendency in kinetic energy resulting from the momentum transport - ketend = ((windf(i,k,1)**2 + windf(i,k,2)**2) - (wind0(i,k,1)**2 + wind0(i,k,2)**2))*0.5_r8/dt - - ! the difference should be the dissipation - gset2 = ketend_cons - ketend - gseten(i,k) = gset2 - - end do - - end do - - ! Scatter dry static energy to full array - do k = 1,pver - do i = il1g,il2g - ii = ideep(i) - seten(ii,k) = gseten(i,k) - - end do - end do - - return -end subroutine momtran - -!========================================================================================= - -subroutine buoyan(lchnk ,ncol , & - q ,t ,p ,z ,pf , & - tp ,qstp ,tl ,rl ,cape , & - pblt ,lcl ,lel ,lon ,mx , & - rd ,grav ,cp ,msg , & - tpert ) -!----------------------------------------------------------------------- -! -! Purpose: -! -! -! Method: -! -! -! -! Author: -! This is contributed code not fully standardized by the CCM core group. -! The documentation has been enhanced to the degree that we are able. -! Reviewed: P. Rasch, April 1996 -! -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -! -! input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncol ! number of atmospheric columns - - real(r8), intent(in) :: q(pcols,pver) ! spec. humidity - real(r8), intent(in) :: t(pcols,pver) ! temperature - real(r8), intent(in) :: p(pcols,pver) ! pressure - real(r8), intent(in) :: z(pcols,pver) ! height - real(r8), intent(in) :: pf(pcols,pver+1) ! pressure at interfaces - real(r8), intent(in) :: pblt(pcols) ! index of pbl depth - real(r8), intent(in) :: tpert(pcols) ! perturbation temperature by pbl processes - -! -! output arguments -! - real(r8), intent(out) :: tp(pcols,pver) ! parcel temperature - real(r8), intent(out) :: qstp(pcols,pver) ! saturation mixing ratio of parcel - real(r8), intent(out) :: tl(pcols) ! parcel temperature at lcl - real(r8), intent(out) :: cape(pcols) ! convective aval. pot. energy. - integer lcl(pcols) ! - integer lel(pcols) ! - integer lon(pcols) ! level of onset of deep convection - integer mx(pcols) ! level of max moist static energy -! -!--------------------------Local Variables------------------------------ -! - real(r8) capeten(pcols,num_cin) ! provisional value of cape - real(r8) tv(pcols,pver) ! - real(r8) tpv(pcols,pver) ! - real(r8) buoy(pcols,pver) - - real(r8) a1(pcols) - real(r8) a2(pcols) - real(r8) estp(pcols) - real(r8) pl(pcols) - real(r8) plexp(pcols) - real(r8) hmax(pcols) - real(r8) hmn(pcols) - real(r8) y(pcols) - - logical plge600(pcols) - integer knt(pcols) - integer lelten(pcols,num_cin) - - real(r8) cp - real(r8) e - real(r8) grav - - integer i - integer k - integer msg - integer n - - real(r8) rd - real(r8) rl -#ifdef PERGRO - real(r8) rhd -#endif -! -!----------------------------------------------------------------------- -! - do n = 1,num_cin - do i = 1,ncol - lelten(i,n) = pver - capeten(i,n) = 0._r8 - end do - end do -! - do i = 1,ncol - lon(i) = pver - knt(i) = 0 - lel(i) = pver - mx(i) = lon(i) - cape(i) = 0._r8 - hmax(i) = 0._r8 - end do - - tp(:ncol,:) = t(:ncol,:) - qstp(:ncol,:) = q(:ncol,:) - -!!! RBN - Initialize tv and buoy for output. -!!! tv=tv : tpv=tpv : qstp=q : buoy=0. - tv(:ncol,:) = t(:ncol,:) *(1._r8+1.608_r8*q(:ncol,:))/ (1._r8+q(:ncol,:)) - tpv(:ncol,:) = tv(:ncol,:) - buoy(:ncol,:) = 0._r8 - -! -! set "launching" level(mx) to be at maximum moist static energy. -! search for this level stops at planetary boundary layer top. -! -#ifdef PERGRO - do k = pver,msg + 1,-1 - do i = 1,ncol - hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) -! -! Reset max moist static energy level when relative difference exceeds 1.e-4 -! - rhd = (hmn(i) - hmax(i))/(hmn(i) + hmax(i)) - if (k >= nint(pblt(i)) .and. k <= lon(i) .and. rhd > -1.e-4_r8) then - hmax(i) = hmn(i) - mx(i) = k - end if - end do - end do -#else - do k = pver,msg + 1,-1 - do i = 1,ncol - hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) - if (k >= nint(pblt(i)) .and. k <= lon(i) .and. hmn(i) > hmax(i)) then - hmax(i) = hmn(i) - mx(i) = k - end if - end do - end do -#endif -! - do i = 1,ncol - lcl(i) = mx(i) - e = p(i,mx(i))*q(i,mx(i))/ (eps1+q(i,mx(i))) - tl(i) = 2840._r8/ (3.5_r8*log(t(i,mx(i)))-log(e)-4.805_r8) + 55._r8 - if (tl(i) < t(i,mx(i))) then - plexp(i) = (1._r8/ (0.2854_r8* (1._r8-0.28_r8*q(i,mx(i))))) - pl(i) = p(i,mx(i))* (tl(i)/t(i,mx(i)))**plexp(i) - else - tl(i) = t(i,mx(i)) - pl(i) = p(i,mx(i)) - end if - end do - -! -! calculate lifting condensation level (lcl). -! - do k = pver,msg + 2,-1 - do i = 1,ncol - if (k <= mx(i) .and. (p(i,k) > pl(i) .and. p(i,k-1) <= pl(i))) then - lcl(i) = k - 1 - end if - end do - end do -! -! if lcl is above the nominal level of non-divergence (600 mbs), -! no deep convection is permitted (ensuing calculations -! skipped and cape retains initialized value of zero). -! - do i = 1,ncol - plge600(i) = pl(i).ge.600._r8 - end do -! -! initialize parcel properties in sub-cloud layer below lcl. -! - do k = pver,msg + 1,-1 - do i=1,ncol - if (k > lcl(i) .and. k <= mx(i) .and. plge600(i)) then - tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) - qstp(i,k) = q(i,mx(i)) - tp(i,k) = t(i,mx(i))* (p(i,k)/p(i,mx(i)))**(0.2854_r8* (1._r8-0.28_r8*q(i,mx(i)))) -! -! buoyancy is increased by 0.5 k as in tiedtke -! -!-jjh tpv (i,k)=tp(i,k)*(1.+1.608*q(i,mx(i)))/ -!-jjh 1 (1.+q(i,mx(i))) - tpv(i,k) = (tp(i,k)+tpert(i))*(1._r8+1.608_r8*q(i,mx(i)))/ (1._r8+q(i,mx(i))) - buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add - end if - end do - end do - -! -! define parcel properties at lcl (i.e. level immediately above pl). -! - do k = pver,msg + 1,-1 - do i=1,ncol - if (k == lcl(i) .and. plge600(i)) then - tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) - qstp(i,k) = q(i,mx(i)) - tp(i,k) = tl(i)* (p(i,k)/pl(i))**(0.2854_r8* (1._r8-0.28_r8*qstp(i,k))) -! estp(i) =exp(21.656_r8 - 5418._r8/tp(i,k)) -! use of different formulas for es has about 1 g/kg difference -! in qs at t= 300k, and 0.02 g/kg at t=263k, with the formula -! above giving larger qs. - call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k)) - a1(i) = cp / rl + qstp(i,k) * (1._r8+ qstp(i,k) / eps1) * rl * eps1 / & - (rd * tp(i,k) ** 2) - a2(i) = .5_r8* (qstp(i,k)* (1._r8+2._r8/eps1*qstp(i,k))* & - (1._r8+qstp(i,k)/eps1)*eps1**2*rl*rl/ & - (rd**2*tp(i,k)**4)-qstp(i,k)* & - (1._r8+qstp(i,k)/eps1)*2._r8*eps1*rl/ & - (rd*tp(i,k)**3)) - a1(i) = 1._r8/a1(i) - a2(i) = -a2(i)*a1(i)**3 - y(i) = q(i,mx(i)) - qstp(i,k) - tp(i,k) = tp(i,k) + a1(i)*y(i) + a2(i)*y(i)**2 - call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k)) -! -! buoyancy is increased by 0.5 k in cape calculation. -! dec. 9, 1994 -!-jjh tpv(i,k) =tp(i,k)*(1.+1.608*qstp(i,k))/(1.+q(i,mx(i))) -! - tpv(i,k) = (tp(i,k)+tpert(i))* (1._r8+1.608_r8*qstp(i,k)) / (1._r8+q(i,mx(i))) - buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add - end if - end do - end do -! -! main buoyancy calculation. -! - do k = pver - 1,msg + 1,-1 - do i=1,ncol - if (k < lcl(i) .and. plge600(i)) then - tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) - qstp(i,k) = qstp(i,k+1) - tp(i,k) = tp(i,k+1)* (p(i,k)/p(i,k+1))**(0.2854_r8* (1._r8-0.28_r8*qstp(i,k))) - call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k)) - a1(i) = cp/rl + qstp(i,k)* (1._r8+qstp(i,k)/eps1)*rl*eps1/ (rd*tp(i,k)**2) - a2(i) = .5_r8* (qstp(i,k)* (1._r8+2._r8/eps1*qstp(i,k))* & - (1._r8+qstp(i,k)/eps1)*eps1**2*rl*rl/ & - (rd**2*tp(i,k)**4)-qstp(i,k)* & - (1._r8+qstp(i,k)/eps1)*2._r8*eps1*rl/ & - (rd*tp(i,k)**3)) - a1(i) = 1._r8/a1(i) - a2(i) = -a2(i)*a1(i)**3 - y(i) = qstp(i,k+1) - qstp(i,k) - tp(i,k) = tp(i,k) + a1(i)*y(i) + a2(i)*y(i)**2 - call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k)) -!-jjh tpv(i,k) =tp(i,k)*(1.+1.608*qstp(i,k))/ -!jt (1.+q(i,mx(i))) - tpv(i,k) = (tp(i,k)+tpert(i))* (1._r8+1.608_r8*qstp(i,k))/(1._r8+q(i,mx(i))) - buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add - end if - end do - end do - -! - do k = msg + 2,pver - do i = 1,ncol - if (k < lcl(i) .and. plge600(i)) then - if (buoy(i,k+1) > 0._r8 .and. buoy(i,k) <= 0._r8) then - knt(i) = min(5,knt(i) + 1) - lelten(i,knt(i)) = k - end if - end if - end do - end do -! -! calculate convective available potential energy (cape). -! - do n = 1,5 - do k = msg + 1,pver - do i = 1,ncol - if (plge600(i) .and. k <= mx(i) .and. k > lelten(i,n)) then - capeten(i,n) = capeten(i,n) + rd*buoy(i,k)*log(pf(i,k+1)/pf(i,k)) - end if - end do - end do - end do -! -! find maximum cape from all possible tentative capes from -! one sounding, -! and use it as the final cape, april 26, 1995 -! - do n = 1,5 - do i = 1,ncol - if (capeten(i,n) > cape(i)) then - cape(i) = capeten(i,n) - lel(i) = lelten(i,n) - end if - end do - end do -! -! put lower bound on cape for diagnostic purposes. -! - do i = 1,ncol - cape(i) = max(cape(i), 0._r8) - end do -! - return -end subroutine buoyan - -subroutine cldprp(lchnk , & - q ,t ,u ,v ,p , & - z ,s ,mu ,eu ,du , & - md ,ed ,sd ,qd ,mc , & - qu ,su ,zf ,qst ,hmn , & - hsat ,shat ,ql , & - cmeg ,jb ,lel ,jt ,jlcl , & - mx ,j0 ,jd ,rl ,il2g , & - rd ,grav ,cp ,msg , & - pflx ,evp ,cu ,rprd ,limcnv ,landfrac, & - qcde ,aero ,loc_conv,qhat ) - -!----------------------------------------------------------------------- -! -! Purpose: -! -! -! Method: -! may 09/91 - guang jun zhang, m.lazare, n.mcfarlane. -! original version cldprop. -! -! Author: See above, modified by P. Rasch -! This is contributed code not fully standardized by the CCM core group. -! -! this code is very much rougher than virtually anything else in the CCM -! there are debug statements left strewn about and code segments disabled -! these are to facilitate future development. We expect to release a -! cleaner code in a future release -! -! the documentation has been enhanced to the degree that we are able -! -!----------------------------------------------------------------------- - - implicit none - -!------------------------------------------------------------------------------ -! -! Input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - - real(r8), intent(in) :: q(pcols,pver) ! spec. humidity of env - real(r8), intent(in) :: t(pcols,pver) ! temp of env - real(r8), intent(in) :: p(pcols,pver) ! pressure of env - real(r8), intent(in) :: z(pcols,pver) ! height of env - real(r8), intent(in) :: s(pcols,pver) ! normalized dry static energy of env - real(r8), intent(in) :: zf(pcols,pverp) ! height of interfaces - real(r8), intent(in) :: u(pcols,pver) ! zonal velocity of env - real(r8), intent(in) :: v(pcols,pver) ! merid. velocity of env - - real(r8), intent(in) :: landfrac(pcols) ! RBN Landfrac - - integer, intent(in) :: jb(pcols) ! updraft base level - integer, intent(in) :: lel(pcols) ! updraft launch level - integer, intent(out) :: jt(pcols) ! updraft plume top - integer, intent(out) :: jlcl(pcols) ! updraft lifting cond level - integer, intent(in) :: mx(pcols) ! updraft base level (same is jb) - integer, intent(out) :: j0(pcols) ! level where updraft begins detraining - integer, intent(out) :: jd(pcols) ! level of downdraft - integer, intent(in) :: limcnv ! convection limiting level - integer, intent(in) :: il2g !CORE GROUP REMOVE - integer, intent(in) :: msg ! missing moisture vals (always 0) - real(r8), intent(in) :: rl ! latent heat of vap - real(r8), intent(in) :: shat(pcols,pver) ! interface values of dry stat energy - real(r8), intent(in) :: qhat(pcols,pver) ! wg grid slice of upper interface mixing ratio. - type(zm_aero_t), intent(in) :: aero ! aerosol object - -! -! output -! - real(r8), intent(out) :: rprd(pcols,pver) ! rate of production of precip at that layer - real(r8), intent(out) :: du(pcols,pver) ! detrainement rate of updraft - real(r8), intent(out) :: ed(pcols,pver) ! entrainment rate of downdraft - real(r8), intent(out) :: eu(pcols,pver) ! entrainment rate of updraft - real(r8), intent(out) :: hmn(pcols,pver) ! moist stat energy of env - real(r8), intent(out) :: hsat(pcols,pver) ! sat moist stat energy of env - real(r8), intent(out) :: mc(pcols,pver) ! net mass flux - real(r8), intent(out) :: md(pcols,pver) ! downdraft mass flux - real(r8), intent(out) :: mu(pcols,pver) ! updraft mass flux - real(r8), intent(out) :: pflx(pcols,pverp) ! precipitation flux thru layer - real(r8), intent(out) :: qd(pcols,pver) ! spec humidity of downdraft - real(r8), intent(out) :: ql(pcols,pver) ! liq water of updraft - real(r8), intent(out) :: qst(pcols,pver) ! saturation mixing ratio of env. - real(r8), intent(out) :: qu(pcols,pver) ! spec hum of updraft - real(r8), intent(out) :: sd(pcols,pver) ! normalized dry stat energy of downdraft - real(r8), intent(out) :: su(pcols,pver) ! normalized dry stat energy of updraft - real(r8), intent(out) :: qcde(pcols,pver) ! cloud water mixing ratio for detrainment (kg/kg) - - type(zm_conv_t) :: loc_conv - - real(r8) rd ! gas constant for dry air - real(r8) grav ! gravity - real(r8) cp ! heat capacity of dry air - -! -! Local workspace -! - real(r8) gamma(pcols,pver) - real(r8) dz(pcols,pver) - real(r8) iprm(pcols,pver) - real(r8) hu(pcols,pver) - real(r8) hd(pcols,pver) - real(r8) eps(pcols,pver) - real(r8) f(pcols,pver) - real(r8) k1(pcols,pver) - real(r8) i2(pcols,pver) - real(r8) ihat(pcols,pver) - real(r8) i3(pcols,pver) - real(r8) idag(pcols,pver) - real(r8) i4(pcols,pver) - real(r8) qsthat(pcols,pver) - real(r8) hsthat(pcols,pver) - real(r8) gamhat(pcols,pver) - real(r8) cu(pcols,pver) - real(r8) evp(pcols,pver) - real(r8) cmeg(pcols,pver) - real(r8) qds(pcols,pver) -! RBN For c0mask - real(r8) c0mask(pcols) - - real(r8) hmin(pcols) - real(r8) expdif(pcols) - real(r8) expnum(pcols) - real(r8) ftemp(pcols) - real(r8) eps0(pcols) - real(r8) rmue(pcols) - real(r8) zuef(pcols) - real(r8) zdef(pcols) - real(r8) epsm(pcols) - real(r8) ratmjb(pcols) - real(r8) est(pcols) - real(r8) totpcp(pcols) - real(r8) totevp(pcols) - real(r8) alfa(pcols) - real(r8) ql1 - real(r8) tu - real(r8) estu - real(r8) qstu - - real(r8) small - real(r8) mdt - - real(r8) fice(pcols,pver) ! ice fraction in precip production - real(r8) tug(pcols,pver) - - real(r8) tvuo(pcols,pver) ! updraft virtual T w/o freezing heating - real(r8) tvu(pcols,pver) ! updraft virtual T with freezing heating - real(r8) totfrz(pcols) - real(r8) frz (pcols,pver) ! rate of freezing - integer jto(pcols) ! updraft plume old top - integer tmplel(pcols) - - integer iter, itnum - integer m - - integer khighest - integer klowest - integer kount - integer i,k - - logical doit(pcols) - logical done(pcols) -! -!------------------------------------------------------------------------------ -! - if (zmconv_microp) then - loc_conv%autolm(:il2g,:) = 0._r8 - loc_conv%accrlm(:il2g,:) = 0._r8 - loc_conv%bergnm(:il2g,:) = 0._r8 - loc_conv%fhtimm(:il2g,:) = 0._r8 - loc_conv%fhtctm(:il2g,:) = 0._r8 - loc_conv%fhmlm (:il2g,:) = 0._r8 - loc_conv%hmpim (:il2g,:) = 0._r8 - loc_conv%accslm(:il2g,:) = 0._r8 - loc_conv%dlfm (:il2g,:) = 0._r8 - - loc_conv%autoln(:il2g,:) = 0._r8 - loc_conv%accrln(:il2g,:) = 0._r8 - loc_conv%bergnn(:il2g,:) = 0._r8 - loc_conv%fhtimn(:il2g,:) = 0._r8 - loc_conv%fhtctn(:il2g,:) = 0._r8 - loc_conv%fhmln (:il2g,:) = 0._r8 - loc_conv%accsln(:il2g,:) = 0._r8 - loc_conv%activn(:il2g,:) = 0._r8 - loc_conv%dlfn (:il2g,:) = 0._r8 - - loc_conv%autoim(:il2g,:) = 0._r8 - loc_conv%accsim(:il2g,:) = 0._r8 - loc_conv%difm (:il2g,:) = 0._r8 - - loc_conv%nuclin(:il2g,:) = 0._r8 - loc_conv%autoin(:il2g,:) = 0._r8 - loc_conv%accsin(:il2g,:) = 0._r8 - loc_conv%hmpin (:il2g,:) = 0._r8 - loc_conv%difn (:il2g,:) = 0._r8 - - loc_conv%trspcm(:il2g,:) = 0._r8 - loc_conv%trspcn(:il2g,:) = 0._r8 - loc_conv%trspim(:il2g,:) = 0._r8 - loc_conv%trspin(:il2g,:) = 0._r8 - - loc_conv%dcape (:il2g) = 0._r8 - - end if - - do i = 1,il2g - ftemp(i) = 0._r8 - expnum(i) = 0._r8 - expdif(i) = 0._r8 - c0mask(i) = c0_ocn * (1._r8-landfrac(i)) + c0_lnd * landfrac(i) - end do -! -!jr Change from msg+1 to 1 to prevent blowup -! - do k = 1,pver - do i = 1,il2g - dz(i,k) = zf(i,k) - zf(i,k+1) - end do - end do - -! -! initialize many output and work variables to zero -! - pflx(:il2g,1) = 0 - - do k = 1,pver - do i = 1,il2g - k1(i,k) = 0._r8 - i2(i,k) = 0._r8 - i3(i,k) = 0._r8 - i4(i,k) = 0._r8 - mu(i,k) = 0._r8 - f(i,k) = 0._r8 - eps(i,k) = 0._r8 - eu(i,k) = 0._r8 - du(i,k) = 0._r8 - ql(i,k) = 0._r8 - cu(i,k) = 0._r8 - evp(i,k) = 0._r8 - cmeg(i,k) = 0._r8 - qds(i,k) = q(i,k) - md(i,k) = 0._r8 - ed(i,k) = 0._r8 - sd(i,k) = s(i,k) - qd(i,k) = q(i,k) - mc(i,k) = 0._r8 - qu(i,k) = q(i,k) - su(i,k) = s(i,k) - call qsat_hPa(t(i,k), p(i,k), est(i), qst(i,k)) - - if ( p(i,k)-est(i) <= 0._r8 ) then - qst(i,k) = 1.0_r8 - end if - - gamma(i,k) = qst(i,k)*(1._r8 + qst(i,k)/eps1)*eps1*rl/(rd*t(i,k)**2)*rl/cp - hmn(i,k) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) - hsat(i,k) = cp*t(i,k) + grav*z(i,k) + rl*qst(i,k) - hu(i,k) = hmn(i,k) - hd(i,k) = hmn(i,k) - rprd(i,k) = 0._r8 - - fice(i,k) = 0._r8 - tug(i,k) = 0._r8 - qcde(i,k) = 0._r8 - tvuo(i,k) = (shat(i,k) - grav/cp*zf(i,k))*(1._r8 + 0.608_r8*qhat(i,k)) - tvu(i,k) = tvuo(i,k) - frz(i,k) = 0._r8 - - end do - end do - if (zmconv_microp) then - do k = 1,pver - do i = 1,il2g - loc_conv%sprd(i,k) = 0._r8 - loc_conv%wu(i,k) = 0._r8 - loc_conv%cmel(i,k) = 0._r8 - loc_conv%cmei(i,k) = 0._r8 - loc_conv%qliq(i,k) = 0._r8 - loc_conv%qice(i,k) = 0._r8 - loc_conv%qnl(i,k) = 0._r8 - loc_conv%qni(i,k) = 0._r8 - loc_conv%qide(i,k) = 0._r8 - loc_conv%qncde(i,k) = 0._r8 - loc_conv%qnide(i,k) = 0._r8 - loc_conv%qnr(i,k) = 0._r8 - loc_conv%qns(i,k) = 0._r8 - loc_conv%qrain(i,k)= 0._r8 - loc_conv%qsnow(i,k)= 0._r8 - loc_conv%frz(i,k) = 0._r8 - end do - end do - end if -! -!jr Set to zero things which make this routine blow up -! - do k=1,msg - do i=1,il2g - rprd(i,k) = 0._r8 - end do - end do -! -! interpolate the layer values of qst, hsat and gamma to -! layer interfaces -! - do k = 1, msg+1 - do i = 1,il2g - hsthat(i,k) = hsat(i,k) - qsthat(i,k) = qst(i,k) - gamhat(i,k) = gamma(i,k) - end do - end do - do i = 1,il2g - totpcp(i) = 0._r8 - totevp(i) = 0._r8 - end do - do k = msg + 2,pver - do i = 1,il2g - if (abs(qst(i,k-1)-qst(i,k)) > 1.E-6_r8) then - qsthat(i,k) = log(qst(i,k-1)/qst(i,k))*qst(i,k-1)*qst(i,k)/ (qst(i,k-1)-qst(i,k)) - else - qsthat(i,k) = qst(i,k) - end if - hsthat(i,k) = cp*shat(i,k) + rl*qsthat(i,k) - if (abs(gamma(i,k-1)-gamma(i,k)) > 1.E-6_r8) then - gamhat(i,k) = log(gamma(i,k-1)/gamma(i,k))*gamma(i,k-1)*gamma(i,k)/ & - (gamma(i,k-1)-gamma(i,k)) - else - gamhat(i,k) = gamma(i,k) - end if - end do - end do -! -! initialize cloud top to highest plume top. -!jr changed hard-wired 4 to limcnv+1 (not to exceed pver) -! - jt(:) = pver - do i = 1,il2g - jt(i) = max(lel(i),limcnv+1) - jt(i) = min(jt(i),pver) - jd(i) = pver - jlcl(i) = lel(i) - hmin(i) = 1.E6_r8 - end do -! -! find the level of minimum hsat, where detrainment starts -! - - do k = msg + 1,pver - do i = 1,il2g - if (hsat(i,k) <= hmin(i) .and. k >= jt(i) .and. k <= jb(i)) then - hmin(i) = hsat(i,k) - j0(i) = k - end if - end do - end do - do i = 1,il2g - j0(i) = min(j0(i),jb(i)-2) - j0(i) = max(j0(i),jt(i)+2) -! -! Fix from Guang Zhang to address out of bounds array reference -! - j0(i) = min(j0(i),pver) - end do -! -! Initialize certain arrays inside cloud -! - do k = msg + 1,pver - do i = 1,il2g - if (k >= jt(i) .and. k <= jb(i)) then - hu(i,k) = hmn(i,mx(i)) + cp*tiedke_add - su(i,k) = s(i,mx(i)) + tiedke_add - end if - end do - end do -! -! ********************************************************* -! compute taylor series for approximate eps(z) below -! ********************************************************* -! - do k = pver - 1,msg + 1,-1 - do i = 1,il2g - if (k < jb(i) .and. k >= jt(i)) then - k1(i,k) = k1(i,k+1) + (hmn(i,mx(i))-hmn(i,k))*dz(i,k) - ihat(i,k) = 0.5_r8* (k1(i,k+1)+k1(i,k)) - i2(i,k) = i2(i,k+1) + ihat(i,k)*dz(i,k) - idag(i,k) = 0.5_r8* (i2(i,k+1)+i2(i,k)) - i3(i,k) = i3(i,k+1) + idag(i,k)*dz(i,k) - iprm(i,k) = 0.5_r8* (i3(i,k+1)+i3(i,k)) - i4(i,k) = i4(i,k+1) + iprm(i,k)*dz(i,k) - end if - end do - end do -! -! re-initialize hmin array for ensuing calculation. -! - do i = 1,il2g - hmin(i) = 1.E6_r8 - end do - do k = msg + 1,pver - do i = 1,il2g - if (k >= j0(i) .and. k <= jb(i) .and. hmn(i,k) <= hmin(i)) then - hmin(i) = hmn(i,k) - expdif(i) = hmn(i,mx(i)) - hmin(i) - end if - end do - end do -! -! ********************************************************* -! compute approximate eps(z) using above taylor series -! ********************************************************* -! - do k = msg + 2,pver - do i = 1,il2g - expnum(i) = 0._r8 - ftemp(i) = 0._r8 - if (k < jt(i) .or. k >= jb(i)) then - k1(i,k) = 0._r8 - expnum(i) = 0._r8 - else - expnum(i) = hmn(i,mx(i)) - (hsat(i,k-1)*(zf(i,k)-z(i,k)) + & - hsat(i,k)* (z(i,k-1)-zf(i,k)))/(z(i,k-1)-z(i,k)) - end if - if ((expdif(i) > 100._r8 .and. expnum(i) > 0._r8) .and. & - k1(i,k) > expnum(i)*dz(i,k)) then - ftemp(i) = expnum(i)/k1(i,k) - f(i,k) = ftemp(i) + i2(i,k)/k1(i,k)*ftemp(i)**2 + & - (2._r8*i2(i,k)**2-k1(i,k)*i3(i,k))/k1(i,k)**2* & - ftemp(i)**3 + (-5._r8*k1(i,k)*i2(i,k)*i3(i,k)+ & - 5._r8*i2(i,k)**3+k1(i,k)**2*i4(i,k))/ & - k1(i,k)**3*ftemp(i)**4 - f(i,k) = max(f(i,k),0._r8) - f(i,k) = min(f(i,k),0.0002_r8) - end if - end do - end do - do i = 1,il2g - if (j0(i) < jb(i)) then - if (f(i,j0(i)) < 1.E-6_r8 .and. f(i,j0(i)+1) > f(i,j0(i))) j0(i) = j0(i) + 1 - end if - end do - do k = msg + 2,pver - do i = 1,il2g - if (k >= jt(i) .and. k <= j0(i)) then - f(i,k) = max(f(i,k),f(i,k-1)) - end if - end do - end do - do i = 1,il2g - eps0(i) = f(i,j0(i)) - eps(i,jb(i)) = eps0(i) - end do -! -! This is set to match the Rasch and Kristjansson paper -! - do k = pver,msg + 1,-1 - do i = 1,il2g - if (k >= j0(i) .and. k <= jb(i)) then - eps(i,k) = f(i,j0(i)) - end if - end do - end do - do k = pver,msg + 1,-1 - do i = 1,il2g - if (k < j0(i) .and. k >= jt(i)) eps(i,k) = f(i,k) - end do - end do - - if (zmconv_microp) then - itnum = 2 - else - itnum = 1 - end if - - do iter=1, itnum - - if (zmconv_microp) then - do k = pver,msg + 1,-1 - do i = 1,il2g - cu(i,k) = 0._r8 - loc_conv%qliq(i,k) = 0._r8 - loc_conv%qice(i,k) = 0._r8 - ql(i,k) = 0._r8 - loc_conv%frz(i,k) = 0._r8 - end do - end do - do i = 1,il2g - totpcp(i) = 0._r8 - hu(i,jb(i)) = hmn(i,jb(i)) + cp*tiedke_add - end do - - end if - -! -! specify the updraft mass flux mu, entrainment eu, detrainment du -! and moist static energy hu. -! here and below mu, eu,du, md and ed are all normalized by mb -! - do i = 1,il2g - if (eps0(i) > 0._r8) then - mu(i,jb(i)) = 1._r8 - eu(i,jb(i)) = mu(i,jb(i))/dz(i,jb(i)) - end if - if (zmconv_microp) then - tmplel(i) = lel(i) - else - tmplel(i) = jt(i) - end if - end do - do k = pver,msg + 1,-1 - do i = 1,il2g - if (eps0(i) > 0._r8 .and. (k >= tmplel(i) .and. k < jb(i))) then - zuef(i) = zf(i,k) - zf(i,jb(i)) - rmue(i) = (1._r8/eps0(i))* (exp(eps(i,k+1)*zuef(i))-1._r8)/zuef(i) - mu(i,k) = (1._r8/eps0(i))* (exp(eps(i,k )*zuef(i))-1._r8)/zuef(i) - eu(i,k) = (rmue(i)-mu(i,k+1))/dz(i,k) - du(i,k) = (rmue(i)-mu(i,k))/dz(i,k) - end if - end do - end do - - khighest = pverp - klowest = 1 - do i=1,il2g - khighest = min(khighest,lel(i)) - klowest = max(klowest,jb(i)) - end do - do k = klowest-1,khighest,-1 - do i = 1,il2g - if (k <= jb(i)-1 .and. k >= lel(i) .and. eps0(i) > 0._r8) then - if (mu(i,k) < 0.02_r8) then - hu(i,k) = hmn(i,k) - mu(i,k) = 0._r8 - eu(i,k) = 0._r8 - du(i,k) = mu(i,k+1)/dz(i,k) - else - if (zmconv_microp) then - hu(i,k) = (mu(i,k+1)*hu(i,k+1) + dz(i,k)*(eu(i,k)*hmn(i,k) + & - latice*frz(i,k)))/(mu(i,k)+ dz(i,k)*du(i,k)) - else - hu(i,k) = mu(i,k+1)/mu(i,k)*hu(i,k+1) + & - dz(i,k)/mu(i,k)* (eu(i,k)*hmn(i,k)- du(i,k)*hsat(i,k)) - end if - end if - end if - end do - end do -! -! reset cloud top index beginning from two layers above the -! cloud base (i.e. if cloud is only one layer thick, top is not reset -! - do i=1,il2g - doit(i) = .true. - totfrz(i)= 0._r8 - do k = pver,msg + 1,-1 - totfrz(i)= totfrz(i)+ frz(i,k)*dz(i,k) - end do - end do - do k=klowest-2,khighest-1,-1 - do i=1,il2g - if (doit(i) .and. k <= jb(i)-2 .and. k >= lel(i)-1) then - if (hu(i,k) <= hsthat(i,k) .and. hu(i,k+1) > hsthat(i,k+1) & - .and. mu(i,k) >= 0.02_r8) then - if (hu(i,k)-hsthat(i,k) < -2000._r8) then - jt(i) = k + 1 - doit(i) = .false. - else - jt(i) = k - doit(i) = .false. - end if - else if ( (hu(i,k) > hu(i,jb(i)) .and. totfrz(i)<=0._r8) .or. mu(i,k) < 0.02_r8) then - jt(i) = k + 1 - doit(i) = .false. - end if - end if - end do - end do - - if (iter == 1) jto(:) = jt(:) - - do k = pver,msg + 1,-1 - do i = 1,il2g - if (k >= lel(i) .and. k <= jt(i) .and. eps0(i) > 0._r8) then - mu(i,k) = 0._r8 - eu(i,k) = 0._r8 - du(i,k) = 0._r8 - hu(i,k) = hmn(i,k) - end if - if (k == jt(i) .and. eps0(i) > 0._r8) then - du(i,k) = mu(i,k+1)/dz(i,k) - eu(i,k) = 0._r8 - mu(i,k) = 0._r8 - end if - end do - end do - - do i = 1,il2g - done(i) = .false. - end do - kount = 0 - do k = pver,msg + 2,-1 - do i = 1,il2g - if (k == jb(i) .and. eps0(i) > 0._r8) then - qu(i,k) = q(i,mx(i)) - su(i,k) = (hu(i,k)-rl*qu(i,k))/cp - end if - if (( .not. done(i) .and. k > jt(i) .and. k < jb(i)) .and. eps0(i) > 0._r8) then - su(i,k) = mu(i,k+1)/mu(i,k)*su(i,k+1) + & - dz(i,k)/mu(i,k)* (eu(i,k)-du(i,k))*s(i,k) - qu(i,k) = mu(i,k+1)/mu(i,k)*qu(i,k+1) + dz(i,k)/mu(i,k)* (eu(i,k)*q(i,k)- & - du(i,k)*qst(i,k)) - tu = su(i,k) - grav/cp*zf(i,k) - call qsat_hPa(tu, (p(i,k)+p(i,k-1))/2._r8, estu, qstu) - if (qu(i,k) >= qstu) then - jlcl(i) = k - kount = kount + 1 - done(i) = .true. - end if - end if - end do - if (kount >= il2g) goto 690 - end do -690 continue - do k = msg + 2,pver - do i = 1,il2g - if ((k > jt(i) .and. k <= jlcl(i)) .and. eps0(i) > 0._r8) then - su(i,k) = shat(i,k) + (hu(i,k)-hsthat(i,k))/(cp* (1._r8+gamhat(i,k))) - qu(i,k) = qsthat(i,k) + gamhat(i,k)*(hu(i,k)-hsthat(i,k))/ & - (rl* (1._r8+gamhat(i,k))) - end if - end do - end do - -! compute condensation in updraft - if (zmconv_microp) then - tmplel(:il2g) = jlcl(:il2g)+1 - else - tmplel(:il2g) = jb(:il2g) - end if - - do k = pver,msg + 2,-1 - do i = 1,il2g - if (k >= jt(i) .and. k < tmplel(i) .and. eps0(i) > 0._r8) then - if (zmconv_microp) then - cu(i,k) = ((mu(i,k)*su(i,k)-mu(i,k+1)*su(i,k+1))/ & - dz(i,k)- eu(i,k)*s(i,k)+du(i,k)*su(i,k))/(rl/cp) & - - latice*frz(i,k)/rl - else - - cu(i,k) = ((mu(i,k)*su(i,k)-mu(i,k+1)*su(i,k+1))/ & - dz(i,k)- (eu(i,k)-du(i,k))*s(i,k))/(rl/cp) - end if - if (k == jt(i)) cu(i,k) = 0._r8 - cu(i,k) = max(0._r8,cu(i,k)) - end if - end do - end do - - - if (zmconv_microp) then - - tug(:il2g,:) = t(:il2g,:) - fice(:,:) = 0._r8 - - do k = pver, msg+2, -1 - do i = 1, il2g - tug(i,k) = su(i,k) - grav/cp*zf(i,k) - end do - end do - - do k = 1, pver-1 - do i = 1, il2g - - if (tug(i,k+1) > 273.15_r8) then - ! If warmer than tmax then water phase - fice(i,k) = 0._r8 - - else if (tug(i,k+1) < 233.15_r8) then - ! If colder than tmin then ice phase - fice(i,k) = 1._r8 - - else - ! Otherwise mixed phase, with ice fraction decreasing linearly - ! from tmin to tmax - fice(i,k) =(273.15_r8 - tug(i,k+1)) / 40._r8 - end if - end do - end do - - do k = 1, pver - do i = 1,il2g - loc_conv%cmei(i,k) = cu(i,k)* fice(i,k) - loc_conv%cmel(i,k) = cu(i,k) * (1._r8-fice(i,k)) - end do - end do - - call zm_mphy(su, qu, mu, du, eu, loc_conv%cmel, loc_conv%cmei, zf, p, t, q, & - eps0, jb, jt, jlcl, msg, il2g, grav, cp, rd, aero, gamhat, & - loc_conv%qliq, loc_conv%qice, loc_conv%qnl, loc_conv%qni, qcde, loc_conv%qide, & - loc_conv%qncde, loc_conv%qnide, rprd, loc_conv%sprd, frz, & - loc_conv%wu, loc_conv%qrain, loc_conv%qsnow, loc_conv%qnr, loc_conv%qns, & - loc_conv%autolm, loc_conv%accrlm, loc_conv%bergnm, loc_conv%fhtimm, loc_conv%fhtctm, & - loc_conv%fhmlm, loc_conv%hmpim, loc_conv%accslm, loc_conv%dlfm, loc_conv%autoln, & - loc_conv%accrln, loc_conv%bergnn, loc_conv%fhtimn, loc_conv%fhtctn, & - loc_conv%fhmln, loc_conv%accsln, loc_conv%activn, loc_conv%dlfn, loc_conv%autoim, & - loc_conv%accsim, loc_conv%difm, loc_conv%nuclin, loc_conv%autoin, & - loc_conv%accsin, loc_conv%hmpin, loc_conv%difn, loc_conv%trspcm, loc_conv%trspcn, & - loc_conv%trspim, loc_conv%trspin, loc_conv%lambdadpcu, loc_conv%mudpcu ) - - - do k = pver,msg + 2,-1 - do i = 1,il2g - ql(i,k) = loc_conv%qliq(i,k)+ loc_conv%qice(i,k) - loc_conv%frz(i,k) = frz(i,k) - end do - end do - - do i = 1,il2g - if (iter == 2 .and. jt(i)> jto(i)) then - do k = jt(i), jto(i), -1 - loc_conv%frz(i,k) = 0.0_r8 - cu(i,k)=0.0_r8 - end do - end if - end do - - - do k = pver,msg + 2,-1 - do i = 1,il2g - if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8 .and. mu(i,k) >= 0.0_r8) then - totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*(qcde(i,k+1)+loc_conv%qide(i,k+1) )) - end if - end do - end do - - do k = msg + 2,pver - do i = 1,il2g - if ((k > jt(i) .and. k <= jlcl(i)) .and. eps0(i) > 0._r8) then - if (iter == 1) tvuo(i,k)= (su(i,k) - grav/cp*zf(i,k))*(1._r8+0.608_r8*qu(i,k)) - if (iter == 2 .and. k > max(jt(i),jto(i)) ) then - tvu(i,k) = (su(i,k) - grav/cp*zf(i,k))*(1._r8 +0.608_r8*qu(i,k)) - loc_conv%dcape(i) = loc_conv%dcape(i)+ rd*(tvu(i,k)-tvuo(i,k))*log(p(i,k)/p(i,k-1)) - end if - end if - end do - end do - - else ! no convective microphysics - -! compute condensed liquid, rain production rate -! accumulate total precipitation (condensation - detrainment of liquid) -! Note ql1 = ql(k) + rprd(k)*dz(k)/mu(k) -! The differencing is somewhat strange (e.g. du(i,k)*ql(i,k+1)) but is -! consistently applied. -! mu, ql are interface quantities -! cu, du, eu, rprd are midpoint quantites - - do k = pver,msg + 2,-1 - do i = 1,il2g - rprd(i,k) = 0._r8 - if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8 .and. mu(i,k) >= 0.0_r8) then - if (mu(i,k) > 0._r8) then - ql1 = 1._r8/mu(i,k)* (mu(i,k+1)*ql(i,k+1)- & - dz(i,k)*du(i,k)*ql(i,k+1)+dz(i,k)*cu(i,k)) - ql(i,k) = ql1/ (1._r8+dz(i,k)*c0mask(i)) - else - ql(i,k) = 0._r8 - end if - totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*ql(i,k+1)) - rprd(i,k) = c0mask(i)*mu(i,k)*ql(i,k) - qcde(i,k) = ql(i,k) - - if (zmconv_microp) then - loc_conv%qide(i,k) = 0._r8 - loc_conv%qncde(i,k) = 0._r8 - loc_conv%qnide(i,k) = 0._r8 - loc_conv%sprd(i,k) = 0._r8 - end if - - end if - end do - end do -! - end if ! zmconv_microp - - end do !iter -! -! specify downdraft properties (no downdrafts if jd.ge.jb). -! scale down downward mass flux profile so that net flux -! (up-down) at cloud base in not negative. -! - do i = 1,il2g -! -! in normal downdraft strength run alfa=0.2. In test4 alfa=0.1 -! - alfa(i) = 0.1_r8 - jt(i) = min(jt(i),jb(i)-1) - jd(i) = max(j0(i),jt(i)+1) - jd(i) = min(jd(i),jb(i)) - hd(i,jd(i)) = hmn(i,jd(i)-1) - if (jd(i) < jb(i) .and. eps0(i) > 0._r8) then - epsm(i) = eps0(i) - md(i,jd(i)) = -alfa(i)*epsm(i)/eps0(i) - end if - end do - do k = msg + 1,pver - do i = 1,il2g - if ((k > jd(i) .and. k <= jb(i)) .and. eps0(i) > 0._r8) then - zdef(i) = zf(i,jd(i)) - zf(i,k) - md(i,k) = -alfa(i)/ (2._r8*eps0(i))*(exp(2._r8*epsm(i)*zdef(i))-1._r8)/zdef(i) - end if - end do - end do - - do k = msg + 1,pver - do i = 1,il2g - if ((k >= jt(i) .and. k <= jb(i)) .and. eps0(i) > 0._r8 .and. jd(i) < jb(i)) then - ratmjb(i) = min(abs(mu(i,jb(i))/md(i,jb(i))),1._r8) - md(i,k) = md(i,k)*ratmjb(i) - end if - end do - end do - - small = 1.e-20_r8 - do k = msg + 1,pver - do i = 1,il2g - if ((k >= jt(i) .and. k <= pver) .and. eps0(i) > 0._r8) then - ed(i,k-1) = (md(i,k-1)-md(i,k))/dz(i,k-1) - mdt = min(md(i,k),-small) - hd(i,k) = (md(i,k-1)*hd(i,k-1) - dz(i,k-1)*ed(i,k-1)*hmn(i,k-1))/mdt - end if - end do - end do -! -! calculate updraft and downdraft properties. -! - do k = msg + 2,pver - do i = 1,il2g - if ((k >= jd(i) .and. k <= jb(i)) .and. eps0(i) > 0._r8 .and. jd(i) < jb(i)) then - qds(i,k) = qsthat(i,k) + gamhat(i,k)*(hd(i,k)-hsthat(i,k))/ & - (rl*(1._r8 + gamhat(i,k))) - end if - end do - end do - - do i = 1,il2g - qd(i,jd(i)) = qds(i,jd(i)) - sd(i,jd(i)) = (hd(i,jd(i)) - rl*qd(i,jd(i)))/cp - end do -! - do k = msg + 2,pver - do i = 1,il2g - if (k >= jd(i) .and. k < jb(i) .and. eps0(i) > 0._r8) then - qd(i,k+1) = qds(i,k+1) - evp(i,k) = -ed(i,k)*q(i,k) + (md(i,k)*qd(i,k)-md(i,k+1)*qd(i,k+1))/dz(i,k) - evp(i,k) = max(evp(i,k),0._r8) - mdt = min(md(i,k+1),-small) - if (zmconv_microp) then - evp(i,k) = min(evp(i,k),rprd(i,k)) - end if - sd(i,k+1) = ((rl/cp*evp(i,k)-ed(i,k)*s(i,k))*dz(i,k) + md(i,k)*sd(i,k))/mdt - totevp(i) = totevp(i) - dz(i,k)*ed(i,k)*q(i,k) - end if - end do - end do - do i = 1,il2g -!*guang totevp(i) = totevp(i) + md(i,jd(i))*q(i,jd(i)-1) - - totevp(i) = totevp(i) + md(i,jd(i))*qd(i,jd(i)) - md(i,jb(i))*qd(i,jb(i)) - end do -!!$ if (.true.) then - if (.false.) then - do i = 1,il2g - k = jb(i) - if (eps0(i) > 0._r8) then - evp(i,k) = -ed(i,k)*q(i,k) + (md(i,k)*qd(i,k))/dz(i,k) - evp(i,k) = max(evp(i,k),0._r8) - totevp(i) = totevp(i) - dz(i,k)*ed(i,k)*q(i,k) - end if - end do - endif - - do i = 1,il2g - totpcp(i) = max(totpcp(i),0._r8) - totevp(i) = max(totevp(i),0._r8) - end do -! - do k = msg + 2,pver - do i = 1,il2g - if (totevp(i) > 0._r8 .and. totpcp(i) > 0._r8) then - md(i,k) = md (i,k)*min(1._r8, totpcp(i)/(totevp(i)+totpcp(i))) - ed(i,k) = ed (i,k)*min(1._r8, totpcp(i)/(totevp(i)+totpcp(i))) - evp(i,k) = evp(i,k)*min(1._r8, totpcp(i)/(totevp(i)+totpcp(i))) - else - md(i,k) = 0._r8 - ed(i,k) = 0._r8 - evp(i,k) = 0._r8 - end if -! cmeg is the cloud water condensed - rain water evaporated -! rprd is the cloud water converted to rain - (rain evaporated) - cmeg(i,k) = cu(i,k) - evp(i,k) - rprd(i,k) = rprd(i,k)-evp(i,k) - end do - end do - -! compute the net precipitation flux across interfaces - pflx(:il2g,1) = 0._r8 - do k = 2,pverp - do i = 1,il2g - pflx(i,k) = pflx(i,k-1) + rprd(i,k-1)*dz(i,k-1) - end do - end do -! - do k = msg + 1,pver - do i = 1,il2g - mc(i,k) = mu(i,k) + md(i,k) - end do - end do -! - return -end subroutine cldprp - -subroutine closure(lchnk , & - q ,t ,p ,z ,s , & - tp ,qs ,qu ,su ,mc , & - du ,mu ,md ,qd ,sd , & - qhat ,shat ,dp ,qstp ,zf , & - ql ,dsubcld ,mb ,cape ,tl , & - lcl ,lel ,jt ,mx ,il1g , & - il2g ,rd ,grav ,cp ,rl , & - msg ,capelmt ) -!----------------------------------------------------------------------- -! -! Purpose: -! -! -! Method: -! -! -! -! Author: G. Zhang and collaborators. CCM contact:P. Rasch -! This is contributed code not fully standardized by the CCM core group. -! -! this code is very much rougher than virtually anything else in the CCM -! We expect to release cleaner code in a future release -! -! the documentation has been enhanced to the degree that we are able -! -!----------------------------------------------------------------------- - -! -!-----------------------------Arguments--------------------------------- -! - integer, intent(in) :: lchnk ! chunk identifier - - real(r8), intent(inout) :: q(pcols,pver) ! spec humidity - real(r8), intent(inout) :: t(pcols,pver) ! temperature - real(r8), intent(inout) :: p(pcols,pver) ! pressure (mb) - real(r8), intent(inout) :: mb(pcols) ! cloud base mass flux - real(r8), intent(in) :: z(pcols,pver) ! height (m) - real(r8), intent(in) :: s(pcols,pver) ! normalized dry static energy - real(r8), intent(in) :: tp(pcols,pver) ! parcel temp - real(r8), intent(in) :: qs(pcols,pver) ! sat spec humidity - real(r8), intent(in) :: qu(pcols,pver) ! updraft spec. humidity - real(r8), intent(in) :: su(pcols,pver) ! normalized dry stat energy of updraft - real(r8), intent(in) :: mc(pcols,pver) ! net convective mass flux - real(r8), intent(in) :: du(pcols,pver) ! detrainment from updraft - real(r8), intent(in) :: mu(pcols,pver) ! mass flux of updraft - real(r8), intent(in) :: md(pcols,pver) ! mass flux of downdraft - real(r8), intent(in) :: qd(pcols,pver) ! spec. humidity of downdraft - real(r8), intent(in) :: sd(pcols,pver) ! dry static energy of downdraft - real(r8), intent(in) :: qhat(pcols,pver) ! environment spec humidity at interfaces - real(r8), intent(in) :: shat(pcols,pver) ! env. normalized dry static energy at intrfcs - real(r8), intent(in) :: dp(pcols,pver) ! pressure thickness of layers - real(r8), intent(in) :: qstp(pcols,pver) ! spec humidity of parcel - real(r8), intent(in) :: zf(pcols,pver+1) ! height of interface levels - real(r8), intent(in) :: ql(pcols,pver) ! liquid water mixing ratio - - real(r8), intent(in) :: cape(pcols) ! available pot. energy of column - real(r8), intent(in) :: tl(pcols) - real(r8), intent(in) :: dsubcld(pcols) ! thickness of subcloud layer - - integer, intent(in) :: lcl(pcols) ! index of lcl - integer, intent(in) :: lel(pcols) ! index of launch leve - integer, intent(in) :: jt(pcols) ! top of updraft - integer, intent(in) :: mx(pcols) ! base of updraft -! -!--------------------------Local variables------------------------------ -! - real(r8) dtpdt(pcols,pver) - real(r8) dqsdtp(pcols,pver) - real(r8) dtmdt(pcols,pver) - real(r8) dqmdt(pcols,pver) - real(r8) dboydt(pcols,pver) - real(r8) thetavp(pcols,pver) - real(r8) thetavm(pcols,pver) - - real(r8) dtbdt(pcols),dqbdt(pcols),dtldt(pcols) - real(r8) beta - real(r8) capelmt - real(r8) cp - real(r8) dadt(pcols) - real(r8) debdt - real(r8) dltaa - real(r8) eb - real(r8) grav - - integer i - integer il1g - integer il2g - integer k, kmin, kmax - integer msg - - real(r8) rd - real(r8) rl -! change of subcloud layer properties due to convection is -! related to cumulus updrafts and downdrafts. -! mc(z)=f(z)*mb, mub=betau*mb, mdb=betad*mb are used -! to define betau, betad and f(z). -! note that this implies all time derivatives are in effect -! time derivatives per unit cloud-base mass flux, i.e. they -! have units of 1/mb instead of 1/sec. -! - do i = il1g,il2g - mb(i) = 0._r8 - eb = p(i,mx(i))*q(i,mx(i))/ (eps1+q(i,mx(i))) - dtbdt(i) = (1._r8/dsubcld(i))* (mu(i,mx(i))*(shat(i,mx(i))-su(i,mx(i)))+ & - md(i,mx(i))* (shat(i,mx(i))-sd(i,mx(i)))) - dqbdt(i) = (1._r8/dsubcld(i))* (mu(i,mx(i))*(qhat(i,mx(i))-qu(i,mx(i)))+ & - md(i,mx(i))* (qhat(i,mx(i))-qd(i,mx(i)))) - debdt = eps1*p(i,mx(i))/ (eps1+q(i,mx(i)))**2*dqbdt(i) - dtldt(i) = -2840._r8* (3.5_r8/t(i,mx(i))*dtbdt(i)-debdt/eb)/ & - (3.5_r8*log(t(i,mx(i)))-log(eb)-4.805_r8)**2 - end do -! -! dtmdt and dqmdt are cumulus heating and drying. -! - do k = msg + 1,pver - do i = il1g,il2g - dtmdt(i,k) = 0._r8 - dqmdt(i,k) = 0._r8 - end do - end do -! - do k = msg + 1,pver - 1 - do i = il1g,il2g - if (k == jt(i)) then - dtmdt(i,k) = (1._r8/dp(i,k))*(mu(i,k+1)* (su(i,k+1)-shat(i,k+1)- & - rl/cp*ql(i,k+1))+md(i,k+1)* (sd(i,k+1)-shat(i,k+1))) - dqmdt(i,k) = (1._r8/dp(i,k))*(mu(i,k+1)* (qu(i,k+1)- & - qhat(i,k+1)+ql(i,k+1))+md(i,k+1)*(qd(i,k+1)-qhat(i,k+1))) - end if - end do - end do -! - beta = 0._r8 - do k = msg + 1,pver - 1 - do i = il1g,il2g - if (k > jt(i) .and. k < mx(i)) then - dtmdt(i,k) = (mc(i,k)* (shat(i,k)-s(i,k))+mc(i,k+1)* (s(i,k)-shat(i,k+1)))/ & - dp(i,k) - rl/cp*du(i,k)*(beta*ql(i,k)+ (1-beta)*ql(i,k+1)) -! dqmdt(i,k)=(mc(i,k)*(qhat(i,k)-q(i,k)) -! 1 +mc(i,k+1)*(q(i,k)-qhat(i,k+1)))/dp(i,k) -! 2 +du(i,k)*(qs(i,k)-q(i,k)) -! 3 +du(i,k)*(beta*ql(i,k)+(1-beta)*ql(i,k+1)) - - dqmdt(i,k) = (mu(i,k+1)* (qu(i,k+1)-qhat(i,k+1)+cp/rl* (su(i,k+1)-s(i,k)))- & - mu(i,k)* (qu(i,k)-qhat(i,k)+cp/rl*(su(i,k)-s(i,k)))+md(i,k+1)* & - (qd(i,k+1)-qhat(i,k+1)+cp/rl*(sd(i,k+1)-s(i,k)))-md(i,k)* & - (qd(i,k)-qhat(i,k)+cp/rl*(sd(i,k)-s(i,k))))/dp(i,k) + & - du(i,k)* (beta*ql(i,k)+(1-beta)*ql(i,k+1)) - end if - end do - end do -! - do k = msg + 1,pver - do i = il1g,il2g - if (k >= lel(i) .and. k <= lcl(i)) then - thetavp(i,k) = tp(i,k)* (1000._r8/p(i,k))** (rd/cp)*(1._r8+1.608_r8*qstp(i,k)-q(i,mx(i))) - thetavm(i,k) = t(i,k)* (1000._r8/p(i,k))** (rd/cp)*(1._r8+0.608_r8*q(i,k)) - dqsdtp(i,k) = qstp(i,k)* (1._r8+qstp(i,k)/eps1)*eps1*rl/(rd*tp(i,k)**2) -! -! dtpdt is the parcel temperature change due to change of -! subcloud layer properties during convection. -! - dtpdt(i,k) = tp(i,k)/ (1._r8+rl/cp* (dqsdtp(i,k)-qstp(i,k)/tp(i,k)))* & - (dtbdt(i)/t(i,mx(i))+rl/cp* (dqbdt(i)/tl(i)-q(i,mx(i))/ & - tl(i)**2*dtldt(i))) -! -! dboydt is the integrand of cape change. -! - dboydt(i,k) = ((dtpdt(i,k)/tp(i,k)+1._r8/(1._r8+1.608_r8*qstp(i,k)-q(i,mx(i)))* & - (1.608_r8 * dqsdtp(i,k) * dtpdt(i,k) -dqbdt(i))) - (dtmdt(i,k)/t(i,k)+0.608_r8/ & - (1._r8+0.608_r8*q(i,k))*dqmdt(i,k)))*grav*thetavp(i,k)/thetavm(i,k) - end if - end do - end do -! - do k = msg + 1,pver - do i = il1g,il2g - if (k > lcl(i) .and. k < mx(i)) then - thetavp(i,k) = tp(i,k)* (1000._r8/p(i,k))** (rd/cp)*(1._r8+0.608_r8*q(i,mx(i))) - thetavm(i,k) = t(i,k)* (1000._r8/p(i,k))** (rd/cp)*(1._r8+0.608_r8*q(i,k)) -! -! dboydt is the integrand of cape change. -! - dboydt(i,k) = (dtbdt(i)/t(i,mx(i))+0.608_r8/ (1._r8+0.608_r8*q(i,mx(i)))*dqbdt(i)- & - dtmdt(i,k)/t(i,k)-0.608_r8/ (1._r8+0.608_r8*q(i,k))*dqmdt(i,k))* & - grav*thetavp(i,k)/thetavm(i,k) - end if - end do - end do - -! -! buoyant energy change is set to 2/3*excess cape per 3 hours -! - dadt(il1g:il2g) = 0._r8 - kmin = minval(lel(il1g:il2g)) - kmax = maxval(mx(il1g:il2g)) - 1 - do k = kmin, kmax - do i = il1g,il2g - if ( k >= lel(i) .and. k <= mx(i) - 1) then - dadt(i) = dadt(i) + dboydt(i,k)* (zf(i,k)-zf(i,k+1)) - endif - end do - end do - do i = il1g,il2g - dltaa = -1._r8* (cape(i)-capelmt) - if (dadt(i) /= 0._r8) mb(i) = max(dltaa/tau/dadt(i),0._r8) - end do -! - return -end subroutine closure - -subroutine q1q2_pjr(lchnk , & - dqdt ,dsdt ,q ,qs ,qu , & - su ,du ,qhat ,shat ,dp , & - mu ,md ,sd ,qd ,ql , & - dsubcld ,jt ,mx ,il1g ,il2g , & - cp ,rl ,msg , & - dl ,evp ,cu , & - loc_conv) - - - implicit none - -!----------------------------------------------------------------------- -! -! Purpose: -! -! -! Method: -! -! -! -! Author: phil rasch dec 19 1995 -! -!----------------------------------------------------------------------- - - - real(r8), intent(in) :: cp - - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: il1g - integer, intent(in) :: il2g - integer, intent(in) :: msg - - real(r8), intent(in) :: q(pcols,pver) - real(r8), intent(in) :: qs(pcols,pver) - real(r8), intent(in) :: qu(pcols,pver) - real(r8), intent(in) :: su(pcols,pver) - real(r8), intent(in) :: du(pcols,pver) - real(r8), intent(in) :: qhat(pcols,pver) - real(r8), intent(in) :: shat(pcols,pver) - real(r8), intent(in) :: dp(pcols,pver) - real(r8), intent(in) :: mu(pcols,pver) - real(r8), intent(in) :: md(pcols,pver) - real(r8), intent(in) :: sd(pcols,pver) - real(r8), intent(in) :: qd(pcols,pver) - real(r8), intent(in) :: ql(pcols,pver) - real(r8), intent(in) :: evp(pcols,pver) - real(r8), intent(in) :: cu(pcols,pver) - real(r8), intent(in) :: dsubcld(pcols) - - real(r8),intent(out) :: dqdt(pcols,pver),dsdt(pcols,pver) - real(r8),intent(out) :: dl(pcols,pver) - - type(zm_conv_t) :: loc_conv - - integer kbm - integer ktm - integer jt(pcols) - integer mx(pcols) -! -! work fields: -! - integer i - integer k - - real(r8) emc - real(r8) rl -!------------------------------------------------------------------- - do k = msg + 1,pver - do i = il1g,il2g - dsdt(i,k) = 0._r8 - dqdt(i,k) = 0._r8 - dl(i,k) = 0._r8 - end do - end do - - if (zmconv_microp) then - do k = msg + 1,pver - do i = il1g,il2g - loc_conv%di(i,k) = 0._r8 - loc_conv%dnl(i,k) = 0._r8 - loc_conv%dni(i,k) = 0._r8 - end do - end do - end if -! -! find the highest level top and bottom levels of convection -! - ktm = pver - kbm = pver - do i = il1g, il2g - ktm = min(ktm,jt(i)) - kbm = min(kbm,mx(i)) - end do - - do k = ktm,pver-1 - do i = il1g,il2g - emc = -cu (i,k) & ! condensation in updraft - +evp(i,k) ! evaporating rain in downdraft - - dsdt(i,k) = -rl/cp*emc & - + (+mu(i,k+1)* (su(i,k+1)-shat(i,k+1)) & - -mu(i,k)* (su(i,k)-shat(i,k)) & - +md(i,k+1)* (sd(i,k+1)-shat(i,k+1)) & - -md(i,k)* (sd(i,k)-shat(i,k)) & - )/dp(i,k) - - if (zmconv_microp) dsdt(i,k) = dsdt(i,k) + latice/cp*loc_conv%frz(i,k) - - dqdt(i,k) = emc + & - (+mu(i,k+1)* (qu(i,k+1)-qhat(i,k+1)) & - -mu(i,k)* (qu(i,k)-qhat(i,k)) & - +md(i,k+1)* (qd(i,k+1)-qhat(i,k+1)) & - -md(i,k)* (qd(i,k)-qhat(i,k)) & - )/dp(i,k) - - dl(i,k) = du(i,k)*ql(i,k+1) - - if (zmconv_microp) then - loc_conv%di(i,k) = du(i,k)*loc_conv%qide(i,k+1) - loc_conv%dnl(i,k) = du(i,k)*loc_conv%qncde(i,k+1) - loc_conv%dni(i,k) = du(i,k)*loc_conv%qnide(i,k+1) - end if - - end do - end do - -! - do k = kbm,pver - do i = il1g,il2g - if (k == mx(i)) then - dsdt(i,k) = (1._r8/dsubcld(i))* & - (-mu(i,k)* (su(i,k)-shat(i,k)) & - -md(i,k)* (sd(i,k)-shat(i,k)) & - ) - dqdt(i,k) = (1._r8/dsubcld(i))* & - (-mu(i,k)*(qu(i,k)-qhat(i,k)) & - -md(i,k)*(qd(i,k)-qhat(i,k)) & - ) - else if (k > mx(i)) then - dsdt(i,k) = dsdt(i,k-1) - dqdt(i,k) = dqdt(i,k-1) - end if - end do - end do -! - return -end subroutine q1q2_pjr - -subroutine buoyan_dilute(lchnk ,ncol , & - q ,t ,p ,z ,pf , & - tp ,qstp ,tl ,rl ,cape , & - pblt ,lcl ,lel ,lon ,mx , & - rd ,grav ,cp ,msg , & - tpert , org , landfrac) -!----------------------------------------------------------------------- -! -! Purpose: -! Calculates CAPE the lifting condensation level and the convective top -! where buoyancy is first -ve. -! -! Method: Calculates the parcel temperature based on a simple constant -! entraining plume model. CAPE is integrated from buoyancy. -! 09/09/04 - Simplest approach using an assumed entrainment rate for -! testing (dmpdp). -! 08/04/05 - Swap to convert dmpdz to dmpdp -! -! SCAM Logical Switches - DILUTE:RBN - Now Disabled -! --------------------- -! switch(1) = .T. - Uses the dilute parcel calculation to obtain tendencies. -! switch(2) = .T. - Includes entropy/q changes due to condensate loss and freezing. -! switch(3) = .T. - Adds the PBL Tpert for the parcel temperature at all levels. -! -! References: -! Raymond and Blythe (1992) JAS -! -! Author: -! Richard Neale - September 2004 -! -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -! -! input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncol ! number of atmospheric columns - - real(r8), intent(in) :: q(pcols,pver) ! spec. humidity - real(r8), intent(in) :: t(pcols,pver) ! temperature - real(r8), intent(in) :: p(pcols,pver) ! pressure - real(r8), intent(in) :: z(pcols,pver) ! height - real(r8), intent(in) :: pf(pcols,pver+1) ! pressure at interfaces - real(r8), intent(in) :: pblt(pcols) ! index of pbl depth - real(r8), intent(in) :: tpert(pcols) ! perturbation temperature by pbl processes - -! -! output arguments -! - real(r8), intent(out) :: tp(pcols,pver) ! parcel temperature - real(r8), intent(out) :: qstp(pcols,pver) ! saturation mixing ratio of parcel (only above lcl, just q below). - real(r8), intent(out) :: tl(pcols) ! parcel temperature at lcl - real(r8), intent(out) :: cape(pcols) ! convective aval. pot. energy. - integer lcl(pcols) ! - integer lel(pcols) ! - integer lon(pcols) ! level of onset of deep convection - integer mx(pcols) ! level of max moist static energy - - real(r8), pointer :: org(:,:) ! organization parameter - real(r8), intent(in) :: landfrac(pcols) -! -!--------------------------Local Variables------------------------------ -! - real(r8) capeten(pcols,5) ! provisional value of cape - real(r8) tv(pcols,pver) ! - real(r8) tpv(pcols,pver) ! - real(r8) buoy(pcols,pver) - - real(r8) a1(pcols) - real(r8) a2(pcols) - real(r8) estp(pcols) - real(r8) pl(pcols) - real(r8) plexp(pcols) - real(r8) hmax(pcols) - real(r8) hmn(pcols) - real(r8) y(pcols) - - logical plge600(pcols) - integer knt(pcols) - integer lelten(pcols,5) - - real(r8) cp - real(r8) e - real(r8) grav - - integer i - integer k - integer msg - integer n - - real(r8) rd - real(r8) rl -#ifdef PERGRO - real(r8) rhd -#endif -! -!----------------------------------------------------------------------- -! - do n = 1,5 - do i = 1,ncol - lelten(i,n) = pver - capeten(i,n) = 0._r8 - end do - end do -! - do i = 1,ncol - lon(i) = pver - knt(i) = 0 - lel(i) = pver - mx(i) = lon(i) - cape(i) = 0._r8 - hmax(i) = 0._r8 - end do - - tp(:ncol,:) = t(:ncol,:) - qstp(:ncol,:) = q(:ncol,:) - -!!! RBN - Initialize tv and buoy for output. -!!! tv=tv : tpv=tpv : qstp=q : buoy=0. - tv(:ncol,:) = t(:ncol,:) *(1._r8+1.608_r8*q(:ncol,:))/ (1._r8+q(:ncol,:)) - tpv(:ncol,:) = tv(:ncol,:) - buoy(:ncol,:) = 0._r8 - -! -! set "launching" level(mx) to be at maximum moist static energy. -! search for this level stops at planetary boundary layer top. -! -#ifdef PERGRO - do k = pver,msg + 1,-1 - do i = 1,ncol - hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) -! -! Reset max moist static energy level when relative difference exceeds 1.e-4 -! - rhd = (hmn(i) - hmax(i))/(hmn(i) + hmax(i)) - if (k >= nint(pblt(i)) .and. k <= lon(i) .and. rhd > -1.e-4_r8) then - hmax(i) = hmn(i) - mx(i) = k - end if - end do - end do -#else - do k = pver,msg + 1,-1 - do i = 1,ncol - hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k) - if (k >= nint(pblt(i)) .and. k <= lon(i) .and. hmn(i) > hmax(i)) then - hmax(i) = hmn(i) - mx(i) = k - end if - end do - end do -#endif - -! LCL dilute calculation - initialize to mx(i) -! Determine lcl in parcel_dilute and get pl,tl after parcel_dilute -! Original code actually sets LCL as level above wher condensate forms. -! Therefore in parcel_dilute lcl(i) will be at first level where qsmix < qtmix. - - do i = 1,ncol ! Initialise LCL variables. - lcl(i) = mx(i) - tl(i) = t(i,mx(i)) - pl(i) = p(i,mx(i)) - end do - -! -! main buoyancy calculation. -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!! DILUTE PLUME CALCULATION USING ENTRAINING PLUME !!! -!!! RBN 9/9/04 !!! - - call parcel_dilute(lchnk, ncol, msg, mx, p, t, q, & - tpert, tp, tpv, qstp, pl, tl, lcl, & - org, landfrac) - - -! If lcl is above the nominal level of non-divergence (600 mbs), -! no deep convection is permitted (ensuing calculations -! skipped and cape retains initialized value of zero). -! - do i = 1,ncol - plge600(i) = pl(i).ge.600._r8 ! Just change to always allow buoy calculation. - end do - -! -! Main buoyancy calculation. -! - do k = pver,msg + 1,-1 - do i=1,ncol - if (k <= mx(i) .and. plge600(i)) then ! Define buoy from launch level to cloud top. - tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) - buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add ! +0.5K or not? - else - qstp(i,k) = q(i,k) - tp(i,k) = t(i,k) - tpv(i,k) = tv(i,k) - endif - end do - end do - - - -!------------------------------------------------------------------------------- - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - - -! - do k = msg + 2,pver - do i = 1,ncol - if (k < lcl(i) .and. plge600(i)) then - if (buoy(i,k+1) > 0._r8 .and. buoy(i,k) <= 0._r8) then - knt(i) = min(num_cin,knt(i) + 1) - lelten(i,knt(i)) = k - end if - end if - end do - end do -! -! calculate convective available potential energy (cape). -! - do n = 1,num_cin - do k = msg + 1,pver - do i = 1,ncol - if (plge600(i) .and. k <= mx(i) .and. k > lelten(i,n)) then - capeten(i,n) = capeten(i,n) + rd*buoy(i,k)*log(pf(i,k+1)/pf(i,k)) - end if - end do - end do - end do -! -! find maximum cape from all possible tentative capes from -! one sounding, -! and use it as the final cape, april 26, 1995 -! - do n = 1,num_cin - do i = 1,ncol - if (capeten(i,n) > cape(i)) then - cape(i) = capeten(i,n) - lel(i) = lelten(i,n) - end if - end do - end do -! -! put lower bound on cape for diagnostic purposes. -! - do i = 1,ncol - cape(i) = max(cape(i), 0._r8) - end do -! - return -end subroutine buoyan_dilute - -subroutine parcel_dilute (lchnk, ncol, msg, klaunch, p, t, q, & - tpert, tp, tpv, qstp, pl, tl, lcl, & - org, landfrac) - -! Routine to determine -! 1. Tp - Parcel temperature -! 2. qstp - Saturated mixing ratio at the parcel temperature. - -!-------------------- -implicit none -!-------------------- - -integer, intent(in) :: lchnk -integer, intent(in) :: ncol -integer, intent(in) :: msg - -integer, intent(in), dimension(pcols) :: klaunch(pcols) - -real(r8), intent(in), dimension(pcols,pver) :: p -real(r8), intent(in), dimension(pcols,pver) :: t -real(r8), intent(in), dimension(pcols,pver) :: q -real(r8), intent(in), dimension(pcols) :: tpert ! PBL temperature perturbation. - -real(r8), intent(inout), dimension(pcols,pver) :: tp ! Parcel temp. -real(r8), intent(inout), dimension(pcols,pver) :: qstp ! Parcel water vapour (sat value above lcl). -real(r8), intent(inout), dimension(pcols) :: tl ! Actual temp of LCL. -real(r8), intent(inout), dimension(pcols) :: pl ! Actual pressure of LCL. - -integer, intent(inout), dimension(pcols) :: lcl ! Lifting condesation level (first model level with saturation). - -real(r8), intent(out), dimension(pcols,pver) :: tpv ! Define tpv within this routine. - -real(r8), pointer, dimension(:,:) :: org -real(r8), intent(in), dimension(pcols) :: landfrac -!-------------------- - -! Have to be careful as s is also dry static energy. - - -! If we are to retain the fact that CAM loops over grid-points in the internal -! loop then we need to dimension sp,atp,mp,xsh2o with ncol. - - -real(r8) tmix(pcols,pver) ! Tempertaure of the entraining parcel. -real(r8) qtmix(pcols,pver) ! Total water of the entraining parcel. -real(r8) qsmix(pcols,pver) ! Saturated mixing ratio at the tmix. -real(r8) smix(pcols,pver) ! Entropy of the entraining parcel. -real(r8) xsh2o(pcols,pver) ! Precipitate lost from parcel. -real(r8) ds_xsh2o(pcols,pver) ! Entropy change due to loss of condensate. -real(r8) ds_freeze(pcols,pver) ! Entropy change sue to freezing of precip. -real(r8) dmpdz2d(pcols,pver) ! variable detrainment rate - -real(r8) mp(pcols) ! Parcel mass flux. -real(r8) qtp(pcols) ! Parcel total water. -real(r8) sp(pcols) ! Parcel entropy. - -real(r8) sp0(pcols) ! Parcel launch entropy. -real(r8) qtp0(pcols) ! Parcel launch total water. -real(r8) mp0(pcols) ! Parcel launch relative mass flux. - -real(r8) lwmax ! Maximum condesate that can be held in cloud before rainout. -real(r8) dmpdp ! Parcel fractional mass entrainment rate (/mb). -!real(r8) dmpdpc ! In cloud parcel mass entrainment rate (/mb). -real(r8) dmpdz ! Parcel fractional mass entrainment rate (/m) -real(r8) dpdz,dzdp ! Hydrstatic relation and inverse of. -real(r8) senv ! Environmental entropy at each grid point. -real(r8) qtenv ! Environmental total water " " ". -real(r8) penv ! Environmental total pressure " " ". -real(r8) tenv ! Environmental total temperature " " ". -real(r8) new_s ! Hold value for entropy after condensation/freezing adjustments. -real(r8) new_q ! Hold value for total water after condensation/freezing adjustments. -real(r8) dp ! Layer thickness (center to center) -real(r8) tfguess ! First guess for entropy inversion - crucial for efficiency! -real(r8) tscool ! Super cooled temperature offset (in degC) (eg -35). - -real(r8) qxsk, qxskp1 ! LCL excess water (k, k+1) -real(r8) dsdp, dqtdp, dqxsdp ! LCL s, qt, p gradients (k, k+1) -real(r8) slcl,qtlcl,qslcl ! LCL s, qt, qs values. -real(r8) org2rkm, org2Tpert -real(r8) dmpdz_lnd, dmpdz_mask - -integer rcall ! Number of ientropy call for errors recording -integer nit_lheat ! Number of iterations for condensation/freezing loop. -integer i,k,ii ! Loop counters. - -!====================================================================== -! SUMMARY -! -! 9/9/04 - Assumes parcel is initiated from level of maxh (klaunch) -! and entrains at each level with a specified entrainment rate. -! -! 15/9/04 - Calculates lcl(i) based on k where qsmix is first < qtmix. -! -!====================================================================== -! -! Set some values that may be changed frequently. -! - -if (zm_org) then - org2rkm = 10._r8 - org2Tpert = 0._r8 -endif -nit_lheat = 2 ! iterations for ds,dq changes from condensation freezing. -dmpdz=-1.e-3_r8 ! Entrainment rate. (-ve for /m) -dmpdz_lnd=-1.e-3_r8 -!dmpdpc = 3.e-2_r8 ! In cloud entrainment rate (/mb). -lwmax = 1.e-3_r8 ! Need to put formula in for this. -tscool = 0.0_r8 ! Temp at which water loading freezes in the cloud. - -qtmix=0._r8 -smix=0._r8 - -qtenv = 0._r8 -senv = 0._r8 -tenv = 0._r8 -penv = 0._r8 - -qtp0 = 0._r8 -sp0 = 0._r8 -mp0 = 0._r8 - -qtp = 0._r8 -sp = 0._r8 -mp = 0._r8 - -new_q = 0._r8 -new_s = 0._r8 - -! **** Begin loops **** - -do k = pver, msg+1, -1 - do i=1,ncol - -! Initialize parcel values at launch level. - - if (k == klaunch(i)) then - qtp0(i) = q(i,k) ! Parcel launch total water (assuming subsaturated) - OK????. - sp0(i) = entropy(t(i,k),p(i,k),qtp0(i)) ! Parcel launch entropy. - mp0(i) = 1._r8 ! Parcel launch relative mass (i.e. 1 parcel stays 1 parcel for dmpdp=0, undilute). - smix(i,k) = sp0(i) - qtmix(i,k) = qtp0(i) - tfguess = t(i,k) - rcall = 1 - call ientropy (rcall,i,lchnk,smix(i,k),p(i,k),qtmix(i,k),tmix(i,k),qsmix(i,k),tfguess) - end if - -! Entraining levels - - if (k < klaunch(i)) then - -! Set environmental values for this level. - - dp = (p(i,k)-p(i,k+1)) ! In -ve mb as p decreasing with height - difference between center of layers. - qtenv = 0.5_r8*(q(i,k)+q(i,k+1)) ! Total water of environment. - tenv = 0.5_r8*(t(i,k)+t(i,k+1)) - penv = 0.5_r8*(p(i,k)+p(i,k+1)) - - senv = entropy(tenv,penv,qtenv) ! Entropy of environment. - -! Determine fractional entrainment rate /pa given value /m. - - dpdz = -(penv*grav)/(rgas*tenv) ! in mb/m since p in mb. - dzdp = 1._r8/dpdz ! in m/mb - if (zm_org) then - dmpdz_mask = landfrac(i) * dmpdz_lnd + (1._r8 - landfrac(i)) * dmpdz - dmpdp = (dmpdz_mask/(1._r8+org(i,k)*org2rkm))*dzdp ! /mb Fractional entrainment - else - dmpdp = dmpdz*dzdp - endif - -! Sum entrainment to current level -! entrains q,s out of intervening dp layers, in which linear variation is assumed -! so really it entrains the mean of the 2 stored values. - - sp(i) = sp(i) - dmpdp*dp*senv - qtp(i) = qtp(i) - dmpdp*dp*qtenv - mp(i) = mp(i) - dmpdp*dp - -! Entrain s and qt to next level. - - smix(i,k) = (sp0(i) + sp(i)) / (mp0(i) + mp(i)) - qtmix(i,k) = (qtp0(i) + qtp(i)) / (mp0(i) + mp(i)) - -! Invert entropy from s and q to determine T and saturation-capped q of mixture. -! t(i,k) used as a first guess so that it converges faster. - - tfguess = tmix(i,k+1) - rcall = 2 - call ientropy(rcall,i,lchnk,smix(i,k),p(i,k),qtmix(i,k),tmix(i,k),qsmix(i,k),tfguess) - -! -! Determine if this is lcl of this column if qsmix <= qtmix. -! FIRST LEVEL where this happens on ascending. - - if (qsmix(i,k) <= qtmix(i,k) .and. qsmix(i,k+1) > qtmix(i,k+1)) then - lcl(i) = k - qxsk = qtmix(i,k) - qsmix(i,k) - qxskp1 = qtmix(i,k+1) - qsmix(i,k+1) - dqxsdp = (qxsk - qxskp1)/dp - pl(i) = p(i,k+1) - qxskp1/dqxsdp ! pressure level of actual lcl. - dsdp = (smix(i,k) - smix(i,k+1))/dp - dqtdp = (qtmix(i,k) - qtmix(i,k+1))/dp - slcl = smix(i,k+1) + dsdp* (pl(i)-p(i,k+1)) - qtlcl = qtmix(i,k+1) + dqtdp*(pl(i)-p(i,k+1)) - - tfguess = tmix(i,k) - rcall = 3 - call ientropy (rcall,i,lchnk,slcl,pl(i),qtlcl,tl(i),qslcl,tfguess) - -! write(iulog,*)' ' -! write(iulog,*)' p',p(i,k+1),pl(i),p(i,lcl(i)) -! write(iulog,*)' t',tmix(i,k+1),tl(i),tmix(i,lcl(i)) -! write(iulog,*)' s',smix(i,k+1),slcl,smix(i,lcl(i)) -! write(iulog,*)'qt',qtmix(i,k+1),qtlcl,qtmix(i,lcl(i)) -! write(iulog,*)'qs',qsmix(i,k+1),qslcl,qsmix(i,lcl(i)) - - endif -! - end if ! k < klaunch - - - end do ! Levels loop -end do ! Columns loop - -!!!!!!!!!!!!!!!!!!!!!!!!!!END ENTRAINMENT LOOP!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!! Could stop now and test with this as it will provide some estimate of buoyancy -!! without the effects of freezing/condensation taken into account for tmix. - -!! So we now have a profile of entropy and total water of the entraining parcel -!! Varying with height from the launch level klaunch parcel=environment. To the -!! top allowed level for the existence of convection. - -!! Now we have to adjust these values such that the water held in vaopor is < or -!! = to qsmix. Therefore, we assume that the cloud holds a certain amount of -!! condensate (lwmax) and the rest is rained out (xsh2o). This, obviously -!! provides latent heating to the mixed parcel and so this has to be added back -!! to it. But does this also increase qsmix as well? Also freezing processes - - -xsh2o = 0._r8 -ds_xsh2o = 0._r8 -ds_freeze = 0._r8 - -!!!!!!!!!!!!!!!!!!!!!!!!!PRECIPITATION/FREEZING LOOP!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Iterate solution twice for accuracy - - - -do k = pver, msg+1, -1 - do i=1,ncol - -! Initialize variables at k=klaunch - - if (k == klaunch(i)) then - -! Set parcel values at launch level assume no liquid water. - - tp(i,k) = tmix(i,k) - qstp(i,k) = q(i,k) - if (zm_org) then - tpv(i,k) = (tp(i,k) + (org2Tpert*org(i,k)+tpert(i))) * (1._r8+1.608_r8*qstp(i,k)) / (1._r8+qstp(i,k)) - else - tpv(i,k) = (tp(i,k) + tpert(i)) * (1._r8+1.608_r8*qstp(i,k)) / (1._r8+qstp(i,k)) - endif - - end if - - if (k < klaunch(i)) then - -! Initiaite loop if switch(2) = .T. - RBN:DILUTE - TAKEN OUT BUT COULD BE RETURNED LATER. - -! Iterate nit_lheat times for s,qt changes. - - do ii=0,nit_lheat-1 - -! Rain (xsh2o) is excess condensate, bar LWMAX (Accumulated loss from qtmix). - - xsh2o(i,k) = max (0._r8, qtmix(i,k) - qsmix(i,k) - lwmax) - -! Contribution to ds from precip loss of condensate (Accumulated change from smix).(-ve) - - ds_xsh2o(i,k) = ds_xsh2o(i,k+1) - cpliq * log (tmix(i,k)/tfreez) * max(0._r8,(xsh2o(i,k)-xsh2o(i,k+1))) -! -! Entropy of freezing: latice times amount of water involved divided by T. -! - - if (tmix(i,k) <= tfreez+tscool .and. ds_freeze(i,k+1) == 0._r8) then ! One off freezing of condensate. - ds_freeze(i,k) = (latice/tmix(i,k)) * max(0._r8,qtmix(i,k)-qsmix(i,k)-xsh2o(i,k)) ! Gain of LH - end if - - if (tmix(i,k) <= tfreez+tscool .and. ds_freeze(i,k+1) /= 0._r8) then ! Continual freezing of additional condensate. - ds_freeze(i,k) = ds_freeze(i,k+1)+(latice/tmix(i,k)) * max(0._r8,(qsmix(i,k+1)-qsmix(i,k))) - end if - -! Adjust entropy and accordingly to sum of ds (be careful of signs). - - new_s = smix(i,k) + ds_xsh2o(i,k) + ds_freeze(i,k) - -! Adjust liquid water and accordingly to xsh2o. - - new_q = qtmix(i,k) - xsh2o(i,k) - -! Invert entropy to get updated Tmix and qsmix of parcel. - - tfguess = tmix(i,k) - rcall =4 - call ientropy (rcall,i,lchnk,new_s, p(i,k), new_q, tmix(i,k), qsmix(i,k), tfguess) - - end do ! Iteration loop for freezing processes. - -! tp - Parcel temp is temp of mixture. -! tpv - Parcel v. temp should be density temp with new_q total water. - - tp(i,k) = tmix(i,k) - -! tpv = tprho in the presence of condensate (i.e. when new_q > qsmix) - - if (new_q > qsmix(i,k)) then ! Super-saturated so condensate present - reduces buoyancy. - qstp(i,k) = qsmix(i,k) - else ! Just saturated/sub-saturated - no condensate virtual effects. - qstp(i,k) = new_q - end if - - if (zm_org) then - tpv(i,k) = (tp(i,k)+(org2Tpert*org(i,k)+tpert(i)))* (1._r8+1.608_r8*qstp(i,k)) / (1._r8+ new_q) - else - tpv(i,k) = (tp(i,k)+tpert(i))* (1._r8+1.608_r8*qstp(i,k)) / (1._r8+ new_q) - endif - - end if ! k < klaunch - - end do ! Loop for columns - -end do ! Loop for vertical levels. - - -return -end subroutine parcel_dilute - -!----------------------------------------------------------------------------------------- -real(r8) function entropy(TK,p,qtot) -!----------------------------------------------------------------------------------------- -! -! TK(K),p(mb),qtot(kg/kg) -! from Raymond and Blyth 1992 -! - real(r8), intent(in) :: p,qtot,TK - real(r8) :: qv,qst,e,est,L - real(r8), parameter :: pref = 1000._r8 - -L = rl - (cpliq - cpwv)*(TK-tfreez) ! T IN CENTIGRADE - -call qsat_hPa(TK, p, est, qst) - -qv = min(qtot,qst) ! Partition qtot into vapor part only. -e = qv*p / (eps1 +qv) - -entropy = (cpres + qtot*cpliq)*log( TK/tfreez) - rgas*log( (p-e)/pref ) + & - L*qv/TK - qv*rh2o*log(qv/qst) - -end FUNCTION entropy - -! -!----------------------------------------------------------------------------------------- -SUBROUTINE ientropy (rcall,icol,lchnk,s,p,qt,T,qst,Tfg) -!----------------------------------------------------------------------------------------- -! -! p(mb), Tfg/T(K), qt/qv(kg/kg), s(J/kg). -! Inverts entropy, pressure and total water qt -! for T and saturated vapor mixing ratio -! - - use phys_grid, only: get_rlon_p, get_rlat_p - - integer, intent(in) :: icol, lchnk, rcall - real(r8), intent(in) :: s, p, Tfg, qt - real(r8), intent(out) :: qst, T - real(r8) :: est, this_lat,this_lon - real(r8) :: a,b,c,d,ebr,fa,fb,fc,pbr,qbr,rbr,sbr,tol1,xm,tol - integer :: i - - logical :: converged - - ! Max number of iteration loops. - integer, parameter :: LOOPMAX = 100 - real(r8), parameter :: EPS = 3.e-8_r8 - - converged = .false. - - ! Invert the entropy equation -- use Brent's method - ! Brent, R. P. Ch. 3-4 in Algorithms for Minimization Without Derivatives. Englewood Cliffs, NJ: Prentice-Hall, 1973. - - T = Tfg ! Better first guess based on Tprofile from conv. - - a = Tfg-10 !low bracket - b = Tfg+10 !high bracket - - fa = entropy(a, p, qt) - s - fb = entropy(b, p, qt) - s - - c=b - fc=fb - tol=0.001_r8 - - converge: do i=0, LOOPMAX - if ((fb > 0.0_r8 .and. fc > 0.0_r8) .or. & - (fb < 0.0_r8 .and. fc < 0.0_r8)) then - c=a - fc=fa - d=b-a - ebr=d - end if - if (abs(fc) < abs(fb)) then - a=b - b=c - c=a - fa=fb - fb=fc - fc=fa - end if - - tol1=2.0_r8*EPS*abs(b)+0.5_r8*tol - xm=0.5_r8*(c-b) - converged = (abs(xm) <= tol1 .or. fb == 0.0_r8) - if (converged) exit converge - - if (abs(ebr) >= tol1 .and. abs(fa) > abs(fb)) then - sbr=fb/fa - if (a == c) then - pbr=2.0_r8*xm*sbr - qbr=1.0_r8-sbr - else - qbr=fa/fc - rbr=fb/fc - pbr=sbr*(2.0_r8*xm*qbr*(qbr-rbr)-(b-a)*(rbr-1.0_r8)) - qbr=(qbr-1.0_r8)*(rbr-1.0_r8)*(sbr-1.0_r8) - end if - if (pbr > 0.0_r8) qbr=-qbr - pbr=abs(pbr) - if (2.0_r8*pbr < min(3.0_r8*xm*qbr-abs(tol1*qbr),abs(ebr*qbr))) then - ebr=d - d=pbr/qbr - else - d=xm - ebr=d - end if - else - d=xm - ebr=d - end if - a=b - fa=fb - b=b+merge(d,sign(tol1,xm), abs(d) > tol1 ) - - fb = entropy(b, p, qt) - s - - end do converge - - T = b - call qsat_hPa(T, p, est, qst) - - if (.not. converged) then - this_lat = get_rlat_p(lchnk, icol)*57.296_r8 - this_lon = get_rlon_p(lchnk, icol)*57.296_r8 - write(iulog,*) '*** ZM_CONV: IENTROPY: Failed and about to exit, info follows ****' - write(iulog,100) 'ZM_CONV: IENTROPY. Details: call#,lchnk,icol= ',rcall,lchnk,icol, & - ' lat: ',this_lat,' lon: ',this_lon, & - ' P(mb)= ', p, ' Tfg(K)= ', Tfg, ' qt(g/kg) = ', 1000._r8*qt, & - ' qst(g/kg) = ', 1000._r8*qst,', s(J/kg) = ',s - call endrun('**** ZM_CONV IENTROPY: Tmix did not converge ****') - end if - -100 format (A,I1,I4,I4,7(A,F6.2)) - -end SUBROUTINE ientropy - -! Wrapper for qsat_water that does translation between Pa and hPa -! qsat_water uses Pa internally, so get it right, need to pass in Pa. -! Afterward, set es back to hPa. -elemental subroutine qsat_hPa(t, p, es, qm) - use wv_saturation, only: qsat_water - - ! Inputs - real(r8), intent(in) :: t ! Temperature (K) - real(r8), intent(in) :: p ! Pressure (hPa) - ! Outputs - real(r8), intent(out) :: es ! Saturation vapor pressure (hPa) - real(r8), intent(out) :: qm ! Saturation mass mixing ratio - ! (vapor mass over dry mass, kg/kg) - - call qsat_water(t, p*100._r8, es, qm) - - es = es*0.01_r8 - -end subroutine qsat_hPa - -end module zm_conv diff --git a/src/physics/cam/zm_conv_intr.F90 b/src/physics/cam/zm_conv_intr.F90 index d5e87a4d6a..44488ac737 100644 --- a/src/physics/cam/zm_conv_intr.F90 +++ b/src/physics/cam/zm_conv_intr.F90 @@ -8,20 +8,25 @@ module zm_conv_intr ! January 2010 modified by J. Kay to add COSP simulator fields to physics buffer !--------------------------------------------------------------------------------- use shr_kind_mod, only: r8=>shr_kind_r8 - use physconst, only: cpair + use physconst, only: cpair, epsilo, gravit, latvap, tmelt, rair use ppgrid, only: pver, pcols, pverp, begchunk, endchunk - use zm_conv, only: zm_conv_evap, zm_convr, convtran, momtran - use zm_microphysics, only: zm_aero_t, zm_conv_t + use zm_conv_evap, only: zm_conv_evap_run + use zm_convr, only: zm_convr_init, zm_convr_run + use zm_conv_convtran, only: zm_conv_convtran_run + use zm_conv_momtran, only: zm_conv_momtran_run + use cloud_fraction_fice, only: cloud_fraction_fice_run + use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num, rad_cnst_get_aer_mmr, & rad_cnst_get_aer_props, rad_cnst_get_mode_props !, & - use ndrop_bam, only: ndrop_bam_init use cam_abortutils, only: endrun use physconst, only: pi use spmd_utils, only: masterproc use perf_mod use cam_logfile, only: iulog use constituents, only: cnst_add - + use ref_pres, only: trop_cloud_top_lev + use phys_control, only: phys_getopts + implicit none private save @@ -35,7 +40,7 @@ module zm_conv_intr zm_conv_tend, &! return tendencies zm_conv_tend_2 ! return tendencies - public :: zmconv_microp + public zmconv_ke, zmconv_ke_lnd ! needed by convect_shallow integer ::& ! indices for fields in the physics buffer zm_mu_idx, & @@ -51,14 +56,11 @@ module zm_conv_intr dp_flxprc_idx, & dp_flxsnw_idx, & dp_cldliq_idx, & - ixorg, & dp_cldice_idx, & dlfzm_idx, & ! detrained convective cloud water mixing ratio. - difzm_idx, & ! detrained convective cloud ice mixing ratio. - dnlfzm_idx, & ! detrained convective cloud water num concen. - dnifzm_idx, & ! detrained convective cloud ice num concen. prec_dp_idx, & - snow_dp_idx + snow_dp_idx, & + mconzm_idx ! convective mass flux real(r8), parameter :: unset_r8 = huge(1.0_r8) real(r8) :: zmconv_c0_lnd = unset_r8 @@ -67,26 +69,26 @@ module zm_conv_intr real(r8) :: zmconv_ke_lnd = unset_r8 real(r8) :: zmconv_momcu = unset_r8 real(r8) :: zmconv_momcd = unset_r8 - integer :: zmconv_num_cin ! Number of negative buoyancy regions that are allowed + integer :: zmconv_num_cin ! Number of negative buoyancy regions that are allowed ! before the convection top and CAPE calculations are completed. - logical :: zmconv_org ! Parameterization for sub-grid scale convective organization for the ZM deep - ! convective scheme based on Mapes and Neale (2011) - logical :: zmconv_microp = .false. ! switch for microphysics + real(r8) :: zmconv_dmpdz = unset_r8 ! Parcel fractional mass entrainment rate + real(r8) :: zmconv_tiedke_add = unset_r8 ! Convective parcel temperature perturbation + real(r8) :: zmconv_capelmt = unset_r8 ! Triggering thereshold for ZM convection + logical :: zmconv_parcel_pbl = .false. ! switch for parcel pbl calculation + real(r8) :: zmconv_tau = unset_r8 ! Timescale for convection ! indices for fields in the physics buffer - integer :: cld_idx = 0 - integer :: icwmrdp_idx = 0 - integer :: rprddp_idx = 0 - integer :: fracis_idx = 0 - integer :: nevapr_dpcu_idx = 0 + integer :: cld_idx = 0 + integer :: icwmrdp_idx = 0 + integer :: rprddp_idx = 0 + integer :: fracis_idx = 0 + integer :: nevapr_dpcu_idx = 0 integer :: dgnum_idx = 0 integer :: nmodes integer :: nbulk - type(zm_aero_t), allocatable :: aero(:) ! object contains information about the aerosols - !========================================================================================= contains !========================================================================================= @@ -103,38 +105,32 @@ subroutine zm_conv_register integer idx - call pbuf_add_field('ZM_MU', 'physpkg', dtype_r8, (/pcols,pver/), zm_mu_idx) - call pbuf_add_field('ZM_EU', 'physpkg', dtype_r8, (/pcols,pver/), zm_eu_idx) - call pbuf_add_field('ZM_DU', 'physpkg', dtype_r8, (/pcols,pver/), zm_du_idx) - call pbuf_add_field('ZM_MD', 'physpkg', dtype_r8, (/pcols,pver/), zm_md_idx) - call pbuf_add_field('ZM_ED', 'physpkg', dtype_r8, (/pcols,pver/), zm_ed_idx) + call pbuf_add_field('ZM_MU', 'physpkg', dtype_r8, (/pcols,pver/), zm_mu_idx) + call pbuf_add_field('ZM_EU', 'physpkg', dtype_r8, (/pcols,pver/), zm_eu_idx) + call pbuf_add_field('ZM_DU', 'physpkg', dtype_r8, (/pcols,pver/), zm_du_idx) + call pbuf_add_field('ZM_MD', 'physpkg', dtype_r8, (/pcols,pver/), zm_md_idx) + call pbuf_add_field('ZM_ED', 'physpkg', dtype_r8, (/pcols,pver/), zm_ed_idx) ! wg layer thickness in mbs (between upper/lower interface). - call pbuf_add_field('ZM_DP', 'physpkg', dtype_r8, (/pcols,pver/), zm_dp_idx) + call pbuf_add_field('ZM_DP', 'physpkg', dtype_r8, (/pcols,pver/), zm_dp_idx) ! wg layer thickness in mbs between lcl and maxi. - call pbuf_add_field('ZM_DSUBCLD', 'physpkg', dtype_r8, (/pcols/), zm_dsubcld_idx) + call pbuf_add_field('ZM_DSUBCLD', 'physpkg', dtype_r8, (/pcols/), zm_dsubcld_idx) ! wg top level index of deep cumulus convection. - call pbuf_add_field('ZM_JT', 'physpkg', dtype_i4, (/pcols/), zm_jt_idx) + call pbuf_add_field('ZM_JT', 'physpkg', dtype_i4, (/pcols/), zm_jt_idx) ! wg gathered values of maxi. - call pbuf_add_field('ZM_MAXG', 'physpkg', dtype_i4, (/pcols/), zm_maxg_idx) + call pbuf_add_field('ZM_MAXG', 'physpkg', dtype_i4, (/pcols/), zm_maxg_idx) ! map gathered points to chunk index - call pbuf_add_field('ZM_IDEEP', 'physpkg', dtype_i4, (/pcols/), zm_ideep_idx) + call pbuf_add_field('ZM_IDEEP', 'physpkg', dtype_i4, (/pcols/), zm_ideep_idx) ! Flux of precipitation from deep convection (kg/m2/s) - call pbuf_add_field('DP_FLXPRC','global',dtype_r8,(/pcols,pverp/),dp_flxprc_idx) - -! Flux of snow from deep convection (kg/m2/s) - call pbuf_add_field('DP_FLXSNW','global',dtype_r8,(/pcols,pverp/),dp_flxsnw_idx) + call pbuf_add_field('DP_FLXPRC','global',dtype_r8,(/pcols,pverp/),dp_flxprc_idx) -! deep gbm cloud liquid water (kg/kg) - call pbuf_add_field('DP_CLDLIQ','global',dtype_r8,(/pcols,pver/), dp_cldliq_idx) - -! deep gbm cloud liquid water (kg/kg) - call pbuf_add_field('DP_CLDICE','global',dtype_r8,(/pcols,pver/), dp_cldice_idx) +! Flux of snow from deep convection (kg/m2/s) + call pbuf_add_field('DP_FLXSNW','global',dtype_r8,(/pcols,pverp/),dp_flxsnw_idx) call pbuf_add_field('ICWMRDP', 'physpkg',dtype_r8,(/pcols,pver/),icwmrdp_idx) call pbuf_add_field('RPRDDP', 'physpkg',dtype_r8,(/pcols,pver/),rprddp_idx) @@ -144,21 +140,9 @@ subroutine zm_conv_register ! detrained convective cloud water mixing ratio. call pbuf_add_field('DLFZM', 'physpkg', dtype_r8, (/pcols,pver/), dlfzm_idx) - ! detrained convective cloud ice mixing ratio. - call pbuf_add_field('DIFZM', 'physpkg', dtype_r8, (/pcols,pver/), difzm_idx) - - if (zmconv_microp) then - ! Only add the number conc fields if the microphysics is active. - - ! detrained convective cloud water num concen. - call pbuf_add_field('DNLFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnlfzm_idx) - ! detrained convective cloud ice num concen. - call pbuf_add_field('DNIFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnifzm_idx) - end if + ! convective mass fluxes + call pbuf_add_field('CMFMC_DP', 'physpkg', dtype_r8, (/pcols,pverp/), mconzm_idx) - if (zmconv_org) then - call cnst_add('ZM_ORG',0._r8,0._r8,0._r8,ixorg,longname='organization parameter') - endif end subroutine zm_conv_register @@ -168,7 +152,6 @@ subroutine zm_conv_readnl(nlfile) use spmd_utils, only: mpicom, masterproc, masterprocid, mpi_real8, mpi_integer, mpi_logical use namelist_utils, only: find_group_name - use units, only: getunit, freeunit character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -177,13 +160,14 @@ subroutine zm_conv_readnl(nlfile) character(len=*), parameter :: subname = 'zm_conv_readnl' namelist /zmconv_nl/ zmconv_c0_lnd, zmconv_c0_ocn, zmconv_num_cin, & - zmconv_ke, zmconv_ke_lnd, zmconv_org, & - zmconv_momcu, zmconv_momcd, zmconv_microp + zmconv_ke, zmconv_ke_lnd, & + zmconv_momcu, zmconv_momcd, & + zmconv_dmpdz, zmconv_tiedke_add, zmconv_capelmt, & + zmconv_parcel_pbl, zmconv_tau !----------------------------------------------------------------------------- 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, 'zmconv_nl', status=ierr) if (ierr == 0) then read(unitn, zmconv_nl, iostat=ierr) @@ -192,7 +176,6 @@ subroutine zm_conv_readnl(nlfile) end if end if close(unitn) - call freeunit(unitn) end if @@ -211,10 +194,16 @@ subroutine zm_conv_readnl(nlfile) if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_momcu") call mpi_bcast(zmconv_momcd, 1, mpi_real8, masterprocid, mpicom, ierr) if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_momcd") - call mpi_bcast(zmconv_org, 1, mpi_logical, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_org") - call mpi_bcast(zmconv_microp, 1, mpi_logical, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_microp") + call mpi_bcast(zmconv_dmpdz, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_dmpdz") + call mpi_bcast(zmconv_tiedke_add, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_tiedke_add") + call mpi_bcast(zmconv_capelmt, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_capelmt") + call mpi_bcast(zmconv_parcel_pbl, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_parcel_pbl") + call mpi_bcast(zmconv_tau, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_tau") end subroutine zm_conv_readnl @@ -228,7 +217,7 @@ subroutine zm_conv_init(pref_edge) use cam_history, only: addfld, add_default, horiz_only use ppgrid, only: pcols, pver - use zm_conv, only: zm_convi + use zm_convr, only: zm_convr_init use pmgrid, only: plev,plevp use spmd_utils, only: masterproc use phys_control, only: phys_deepconv_pbl, phys_getopts, cam_physpkg_is @@ -238,6 +227,14 @@ subroutine zm_conv_init(pref_edge) real(r8),intent(in) :: pref_edge(plevp) ! reference pressures at interfaces + ! local variables + real(r8), parameter :: scale_height = 7000._r8 ! std atm scale height (m) + real(r8), parameter :: dz_min = 100._r8 ! minimum thickness for using + ! zmconv_parcel_pbl=.false. + real(r8) :: dz_bot_layer ! thickness of bottom layer (m) + + character(len=512) :: errmsg + integer :: errflg logical :: no_deep_pbl ! if true, no deep convection in PBL integer limcnv ! top interface level limit for convection @@ -247,20 +244,10 @@ subroutine zm_conv_init(pref_edge) ! liquid budgets. integer :: history_budget_histfile_num ! output history file number for budget fields -! Allocate the basic aero structure outside the zmconv_microp logical -! This allows the aero structure to be passed -! Note that all of the arrays inside this structure are conditionally allocated - - allocate(aero(begchunk:endchunk)) - -! +! ! Register fields with the output buffer ! - if (zmconv_org) then - call addfld ('ZM_ORG ', (/ 'lev' /), 'A', '- ','Organization parameter') - call addfld ('ZM_ORG2D ', (/ 'lev' /), 'A', '- ','Organization parameter 2D') - endif call addfld ('PRECZ', horiz_only, 'A', 'm/s','total precipitation from ZM convection') call addfld ('ZMDT', (/ 'lev' /), 'A', 'K/s','T tendency - Zhang-McFarlane moist convection') call addfld ('ZMDQ', (/ 'lev' /), 'A', 'kg/kg/s','Q tendency - Zhang-McFarlane moist convection') @@ -270,21 +257,21 @@ subroutine zm_conv_init(pref_edge) call addfld ('FZSNTZM', (/ 'lev' /), 'A', 'K/s','T tendency - Rain to snow conversion from Zhang convection') call addfld ('EVSNTZM', (/ 'lev' /), 'A', 'K/s','T tendency - Snow to rain prod from Zhang convection') call addfld ('EVAPQZM', (/ 'lev' /), 'A', 'kg/kg/s','Q tendency - Evaporation from Zhang-McFarlane moist convection') - + call addfld ('ZMFLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s','Flux of precipitation from ZM convection' ) call addfld ('ZMFLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s','Flux of snow from ZM convection' ) call addfld ('ZMNTPRPD', (/ 'lev' /) , 'A', 'kg/kg/s','Net precipitation production from ZM convection') call addfld ('ZMNTSNPD', (/ 'lev' /) , 'A', 'kg/kg/s','Net snow production from ZM convection' ) call addfld ('ZMEIHEAT', (/ 'lev' /) , 'A', 'W/kg' ,'Heating by ice and evaporation in ZM convection') - - call addfld ('CMFMCDZM', (/ 'ilev' /), 'A', 'kg/m2/s','Convection mass flux from ZM deep ') + + call addfld ('CMFMC_DP', (/ 'ilev' /), 'A', 'kg/m2/s','Convection mass flux from ZM deep ') call addfld ('PRECCDZM', horiz_only, 'A', 'm/s','Convective precipitation rate from ZM deep') call addfld ('PCONVB', horiz_only , 'A', 'Pa' ,'convection base pressure') call addfld ('PCONVT', horiz_only , 'A', 'Pa' ,'convection top pressure') call addfld ('CAPE', horiz_only, 'A', 'J/kg', 'Convectively available potential energy') - call addfld ('FREQZM', horiz_only , 'A', 'fraction', 'Fractional occurance of ZM convection') + call addfld ('FREQZM', horiz_only , 'A', 'fraction', 'Fractional occurance of ZM convection') call addfld ('ZMMTT', (/ 'lev' /), 'A', 'K/s', 'T tendency - ZM convective momentum transport') call addfld ('ZMMTU', (/ 'lev' /), 'A', 'm/s2', 'U tendency - ZM convective momentum transport') @@ -303,16 +290,11 @@ subroutine zm_conv_init(pref_edge) call addfld ('ZMICVU', (/ 'lev' /), 'A', 'm/s', 'ZM in-cloud V updrafts') call addfld ('ZMICVD', (/ 'lev' /), 'A', 'm/s', 'ZM in-cloud V downdrafts') - call addfld ('DIFZM' ,(/ 'lev' /), 'A','kg/kg/s ','Detrained ice water from ZM convection') call addfld ('DLFZM' ,(/ 'lev' /), 'A','kg/kg/s ','Detrained liquid water from ZM convection') call phys_getopts( history_budget_out = history_budget, & history_budget_histfile_num_out = history_budget_histfile_num) - if (zmconv_org) then - call add_default('ZM_ORG', 1, ' ') - call add_default('ZM_ORG2D', 1, ' ') - endif if ( history_budget ) then call add_default('EVAPTZM ', history_budget_histfile_num, ' ') call add_default('EVAPQZM ', history_budget_histfile_num, ' ') @@ -323,10 +305,6 @@ subroutine zm_conv_init(pref_edge) call add_default('ZMMTT ', history_budget_histfile_num, ' ') end if - if (zmconv_microp) then - call add_default ('DIFZM', 1, ' ') - call add_default ('DLFZM', 1, ' ') - end if ! ! Limit deep convection to regions below 40 mb ! Note this calculation is repeated in the shallow convection interface @@ -343,32 +321,50 @@ subroutine zm_conv_init(pref_edge) end do if ( limcnv == 0 ) limcnv = plevp end if - + if (masterproc) then write(iulog,*)'ZM_CONV_INIT: Deep convection will be capped at intfc ',limcnv, & ' which is ',pref_edge(limcnv),' pascals' end if - + + ! If thickness of bottom layer is less than dz_min, and zmconv_parcel_pbl=.false., + ! then issue a warning. + dz_bot_layer = scale_height * log(pref_edge(pverp)/pref_edge(pver)) + if (dz_bot_layer < dz_min .and. .not. zmconv_parcel_pbl) then + if (masterproc) then + write(iulog,*)'********** WARNING **********' + write(iulog,*)' ZM_CONV_INIT: Bottom layer thickness (m) is ', dz_bot_layer + write(iulog,*)' The namelist variable zmconv_parcel_pbl should be set to .true.' + write(iulog,*)' when the bottom layer thickness is < ', dz_min + write(iulog,*)'********** WARNING **********' + end if + end if + no_deep_pbl = phys_deepconv_pbl() - call zm_convi(limcnv,zmconv_c0_lnd, zmconv_c0_ocn, zmconv_ke, zmconv_ke_lnd, & - zmconv_momcu, zmconv_momcd, zmconv_num_cin, zmconv_org, & - zmconv_microp, no_deep_pbl_in = no_deep_pbl) + call zm_convr_init(plev, plevp, cpair, epsilo, gravit, latvap, tmelt, rair, & + pref_edge,zmconv_c0_lnd, zmconv_c0_ocn, zmconv_ke, zmconv_ke_lnd, & + zmconv_momcu, zmconv_momcd, zmconv_num_cin, & + no_deep_pbl, zmconv_tiedke_add, & + zmconv_capelmt, zmconv_dmpdz,zmconv_parcel_pbl, zmconv_tau, & + masterproc, iulog, errmsg, errflg) + + if (errflg /= 0) then + call endrun('From zm_convr_init:' // errmsg) + end if cld_idx = pbuf_get_index('CLD') fracis_idx = pbuf_get_index('FRACIS') - if (zmconv_microp) call zm_conv_micro_init() - end subroutine zm_conv_init !========================================================================================= !subroutine zm_conv_tend(state, ptend, tdt) subroutine zm_conv_tend(pblh ,mcon ,cme , & - tpert ,pflx ,zdu , & + tpert ,zdu , & rliq ,rice ,ztodt , & jctop ,jcbot , & state ,ptend_all ,landfrac, pbuf) - + use cam_history, only: outfld use physics_types, only: physics_state, physics_ptend @@ -376,13 +372,14 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & use physics_types, only: physics_state_copy, physics_state_dealloc use physics_types, only: physics_ptend_sum, physics_ptend_dealloc - use phys_grid, only: get_lat_p, get_lon_p use time_manager, only: get_nstep, is_first_step use physics_buffer, only : pbuf_get_field, physics_buffer_desc, pbuf_old_tim_idx use constituents, only: pcnst, cnst_get_ind, cnst_is_convtran1 - use check_energy, only: check_energy_chng - use physconst, only: gravit + use physconst, only: gravit, latice, latvap, tmelt, cpwv, cpliq, rh2o + use phys_grid, only: get_rlat_all_p, get_rlon_all_p + use phys_control, only: cam_physpkg_is + use ccpp_constituent_prop_mod, only: ccpp_const_props ! Arguments @@ -393,10 +390,9 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) real(r8), intent(in) :: pblh(pcols) ! Planetary boundary layer height real(r8), intent(in) :: tpert(pcols) ! Thermal temperature excess - real(r8), intent(in) :: landfrac(pcols) ! RBN - Landfrac + real(r8), intent(in) :: landfrac(pcols) ! RBN - Landfrac real(r8), intent(out) :: mcon(pcols,pverp) ! Convective mass flux--m sub c - real(r8), intent(out) :: pflx(pcols,pverp) ! scattered precip flux at each level real(r8), intent(out) :: cme(pcols,pver) ! cmf condensation - evaporation real(r8), intent(out) :: zdu(pcols,pver) ! detraining mass flux @@ -405,8 +401,8 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ! Local variables - - type(zm_conv_t) :: conv + character(len=512) :: errmsg + integer :: errflg integer :: i,k,l,m integer :: ilon ! global longitude index of a column @@ -430,7 +426,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ! physics buffer fields real(r8), pointer, dimension(:) :: prec ! total precipitation - real(r8), pointer, dimension(:) :: snow ! snow from ZM convection + real(r8), pointer, dimension(:) :: snow ! snow from ZM convection real(r8), pointer, dimension(:,:) :: cld real(r8), pointer, dimension(:,:) :: ql ! wg grid slice of cloud liquid water. real(r8), pointer, dimension(:,:) :: rprd ! rain production rate @@ -438,25 +434,21 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & real(r8), pointer, dimension(:,:) :: evapcdp ! Evaporation of deep convective precipitation real(r8), pointer, dimension(:,:) :: flxprec ! Convective-scale flux of precip at interfaces (kg/m2/s) real(r8), pointer, dimension(:,:) :: flxsnow ! Convective-scale flux of snow at interfaces (kg/m2/s) - real(r8), pointer, dimension(:,:) :: dp_cldliq - real(r8), pointer, dimension(:,:) :: dp_cldice real(r8), pointer :: dlf(:,:) ! detrained convective cloud water mixing ratio. - real(r8), pointer :: dif(:,:) ! detrained convective cloud ice mixing ratio. - real(r8), pointer :: dnlf(:,:) ! detrained convective cloud water num concen. - real(r8), pointer :: dnif(:,:) ! detrained convective cloud ice num concen. real(r8), pointer :: lambdadpcu(:,:) ! slope of cloud liquid size distr real(r8), pointer :: mudpcu(:,:) ! width parameter of droplet size distr - - real(r8), pointer :: mu(:,:) ! (pcols,pver) - real(r8), pointer :: eu(:,:) ! (pcols,pver) - real(r8), pointer :: du(:,:) ! (pcols,pver) - real(r8), pointer :: md(:,:) ! (pcols,pver) - real(r8), pointer :: ed(:,:) ! (pcols,pver) - real(r8), pointer :: dp(:,:) ! (pcols,pver) - real(r8), pointer :: dsubcld(:) ! (pcols) - integer, pointer :: jt(:) ! (pcols) - integer, pointer :: maxg(:) ! (pcols) - integer, pointer :: ideep(:) ! (pcols) + real(r8), pointer :: mconzm(:,:) !convective mass fluxes + + real(r8), pointer :: mu(:,:) ! (pcols,pver) + real(r8), pointer :: eu(:,:) ! (pcols,pver) + real(r8), pointer :: du(:,:) ! (pcols,pver) + real(r8), pointer :: md(:,:) ! (pcols,pver) + real(r8), pointer :: ed(:,:) ! (pcols,pver) + real(r8), pointer :: dp(:,:) ! (pcols,pver) + real(r8), pointer :: dsubcld(:) ! (pcols) + integer, pointer :: jt(:) ! (pcols) + integer, pointer :: maxg(:) ! (pcols) + integer, pointer :: ideep(:) ! (pcols) integer :: lengath real(r8) :: jctop(pcols) ! o row of top-of-deep-convection indices passed out. @@ -464,27 +456,36 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & real(r8) :: pcont(pcols), pconb(pcols), freqzm(pcols) + real(r8) :: lat_all(pcols), long_all(pcols) + ! history output fields real(r8) :: cape(pcols) ! w convective available potential energy. real(r8) :: mu_out(pcols,pver) real(r8) :: md_out(pcols,pver) + real(r8) :: dif(pcols,pver) ! used in momentum transport calculation - real(r8) :: winds(pcols, pver, 2) - real(r8) :: wind_tends(pcols, pver, 2) - real(r8) :: pguall(pcols, pver, 2) - real(r8) :: pgdall(pcols, pver, 2) - real(r8) :: icwu(pcols,pver, 2) - real(r8) :: icwd(pcols,pver, 2) + real(r8) :: pguallu(pcols, pver) + real(r8) :: pguallv(pcols, pver) + real(r8) :: pgdallu(pcols, pver) + real(r8) :: pgdallv(pcols, pver) + real(r8) :: icwuu(pcols,pver) + real(r8) :: icwuv(pcols,pver) + real(r8) :: icwdu(pcols,pver) + real(r8) :: icwdv(pcols,pver) real(r8) :: seten(pcols, pver) - logical :: l_windt(2) + logical :: l_windt real(r8) :: tfinal1, tfinal2 integer :: ii - - real(r8),pointer :: zm_org2d(:,:) - real(r8),pointer :: orgt(:,:), org(:,:) + + real(r8) :: fice(pcols,pver) + real(r8) :: fsnow_conv(pcols,pver) logical :: lq(pcnst) + character(len=16) :: macrop_scheme + character(len=40) :: scheme_name + character(len=40) :: str + integer :: top_lev !---------------------------------------------------------------------- @@ -493,70 +494,15 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ncol = state%ncol nstep = get_nstep() - if (zmconv_microp) then - allocate( & - conv%qi(pcols,pver), & - conv%qliq(pcols,pver), & - conv%qice(pcols,pver), & - conv%wu(pcols,pver), & - conv%sprd(pcols,pver), & - conv%qrain(pcols,pver), & - conv%qsnow(pcols,pver), & - conv%qnl(pcols,pver), & - conv%qni(pcols,pver), & - conv%qnr(pcols,pver), & - conv%qns(pcols,pver), & - conv%frz(pcols,pver), & - conv%autolm(pcols,pver), & - conv%accrlm(pcols,pver), & - conv%bergnm(pcols,pver), & - conv%fhtimm(pcols,pver), & - conv%fhtctm(pcols,pver), & - conv%fhmlm (pcols,pver), & - conv%hmpim (pcols,pver), & - conv%accslm(pcols,pver), & - conv%dlfm (pcols,pver), & - conv%autoln(pcols,pver), & - conv%accrln(pcols,pver), & - conv%bergnn(pcols,pver), & - conv%fhtimn(pcols,pver), & - conv%fhtctn(pcols,pver), & - conv%fhmln (pcols,pver), & - conv%accsln(pcols,pver), & - conv%activn(pcols,pver), & - conv%dlfn (pcols,pver), & - conv%autoim(pcols,pver), & - conv%accsim(pcols,pver), & - conv%difm (pcols,pver), & - conv%nuclin(pcols,pver), & - conv%autoin(pcols,pver), & - conv%accsin(pcols,pver), & - conv%hmpin (pcols,pver), & - conv%difn (pcols,pver), & - conv%cmel (pcols,pver), & - conv%cmei (pcols,pver), & - conv%trspcm(pcols,pver), & - conv%trspcn(pcols,pver), & - conv%trspim(pcols,pver), & - conv%trspin(pcols,pver), & - conv%lambdadpcu(pcols,pver), & - conv%mudpcu(pcols,pver), & - conv%dcape(pcols) ) - end if - - ftem = 0._r8 + ftem = 0._r8 mu_out(:,:) = 0._r8 md_out(:,:) = 0._r8 - wind_tends(:ncol,:pver,:) = 0.0_r8 call physics_state_copy(state,state1) ! copy state to local state1. lq(:) = .FALSE. lq(1) = .TRUE. - if (zmconv_org) then - lq(ixorg) = .TRUE. - endif - call physics_ptend_init(ptend_loc, state%psetcols, 'zm_convr', ls=.true., lq=lq)! initialize local ptend type + call physics_ptend_init(ptend_loc, state%psetcols, 'zm_convr_run', ls=.true., lq=lq)! initialize local ptend type ! ! Associate pointers with physics buffer fields @@ -583,68 +529,65 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call pbuf_get_field(pbuf, zm_ideep_idx, ideep) call pbuf_get_field(pbuf, dlfzm_idx, dlf) - call pbuf_get_field(pbuf, difzm_idx, dif) + call pbuf_get_field(pbuf, mconzm_idx, mconzm) - if (zmconv_microp) then - call pbuf_get_field(pbuf, dnlfzm_idx, dnlf) - call pbuf_get_field(pbuf, dnifzm_idx, dnif) - else - allocate(dnlf(pcols,pver), dnif(pcols,pver)) - end if - - if (zmconv_microp) then - - if (nmodes > 0) then - - ! Associate pointers with the modes and species that affect the climate - ! (list 0) - - do m = 1, nmodes - call rad_cnst_get_mode_num(0, m, 'a', state, pbuf, aero(lchnk)%num_a(m)%val) - call pbuf_get_field(pbuf, dgnum_idx, aero(lchnk)%dgnum(m)%val, start=(/1,1,m/), kount=(/pcols,pver,1/)) - - do l = 1, aero(lchnk)%nspec(m) - call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, aero(lchnk)%mmr_a(l,m)%val) - end do - end do - - else if (nbulk > 0) then - - ! Associate pointers with the bulk aerosols that affect the climate - ! (list 0) - - do m = 1, nbulk - call rad_cnst_get_aer_mmr(0, m, state, pbuf, aero(lchnk)%mmr_bulk(m)%val) - end do - - end if - end if - -! ! Begin with Zhang-McFarlane (1996) convection parameterization ! - call t_startf ('zm_convr') - - if (zmconv_org) then - allocate(zm_org2d(pcols,pver)) - org => state%q(:,:,ixorg) - orgt => ptend_loc%q(:,:,ixorg) - endif - - call zm_convr( lchnk ,ncol , & - state%t ,state%q(:,:,1), prec ,jctop ,jcbot , & - pblh ,state%zm ,state%phis ,state%zi ,ptend_loc%q(:,:,1) , & - ptend_loc%s , state%pmid ,state%pint ,state%pdel , & - .5_r8*ztodt ,mcon ,cme , cape, & - tpert ,dlf ,pflx ,zdu ,rprd , & - mu, md, du, eu, ed, & - dp, dsubcld, jt, maxg, ideep, & - ql, rliq, landfrac, & - org, orgt, zm_org2d, & - dif, dnlf, dnif, conv, & - aero(lchnk), rice) + call t_startf ('zm_convr_run') + +!REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + ptend_loc%q(:,:,1) = 0._r8 + ptend_loc%s(:,:) = 0._r8 + dif(:,:) = 0._r8 + mcon(:,:) = 0._r8 + dlf(:,:) = 0._r8 + cme(:,:) = 0._r8 + cape(:) = 0._r8 + zdu(:,:) = 0._r8 + rprd(:,:) = 0._r8 + mu(:,:) = 0._r8 + eu(:,:) = 0._r8 + du(:,:) = 0._r8 + md(:,:) = 0._r8 + ed(:,:) = 0._r8 + dp(:,:) = 0._r8 + dsubcld(:) = 0._r8 + jctop(:) = 0._r8 + jcbot(:) = 0._r8 + prec(:) = 0._r8 + rliq(:) = 0._r8 + rice(:) = 0._r8 + ideep(:) = 0._r8 +!REMOVECAM_END + + + call get_rlat_all_p(lchnk, ncol, lat_all) + call get_rlon_all_p(lchnk, ncol, long_all) + + call zm_convr_run(ncol, pver, & + pverp, gravit, latice, cpwv, cpliq, rh2o, & + lat_all, long_all, & + 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,:), & + ztodt, mcon(:ncol,:), cme(:ncol,:), cape(:ncol), & + tpert(:ncol), dlf(:ncol,:), dif(:ncol,:), zdu(:ncol,:), rprd(:ncol,:), & + mu(:ncol,:), md(:ncol,:), du(:ncol,:), eu(:ncol,:), ed(:ncol,:), & + dp(:ncol,:), dsubcld(:ncol), jt(:ncol), maxg(:ncol), ideep(:ncol), & + ql(:ncol,:), rliq(:ncol), landfrac(:ncol), & + rice(:ncol), lengath, scheme_name, errmsg, errflg) + + if (errflg /= 0) then + write(str,*) 'From zm_convr_run: at chunk ',lchnk, ' : ' + call endrun(str // errmsg) + end if - lengath = count(ideep > 0) + jctop(:) = real(pver,r8) + jcbot(:) = 1._r8 + do i = 1,lengath + jctop(ideep(i)) = real(jt(i), r8) + jcbot(ideep(i)) = real(maxg(i), r8) + end do call outfld('CAPE', cape, pcols, lchnk) ! RBN - CAPE output ! @@ -658,9 +601,10 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ! ! Convert mass flux from reported mb/s to kg/m^2/s ! - mcon(:ncol,:pver) = mcon(:ncol,:pver) * 100._r8/gravit + mcon(:ncol,:pverp) = mcon(:ncol,:pverp) * 100._r8/gravit + mconzm(:ncol,:pverp) = mcon(:ncol,:pverp) - call outfld('CMFMCDZM', mcon, pcols, lchnk) + call outfld('CMFMC_DP', mconzm, pcols, lchnk) ! Store upward and downward mass fluxes in un-gathered arrays ! + convert from mb/s to kg/m^2/s @@ -678,13 +622,10 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ftem(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpair call outfld('ZMDT ',ftem ,pcols ,lchnk ) call outfld('ZMDQ ',ptend_loc%q(1,1,1) ,pcols ,lchnk ) - call t_stopf ('zm_convr') + call t_stopf ('zm_convr_run') - call outfld('DIFZM' ,dif ,pcols, lchnk) call outfld('DLFZM' ,dlf ,pcols, lchnk) - if (zmconv_microp) call zm_conv_micro_outfld(conv, dnif, dnlf, lchnk, ncol) - pcont(:ncol) = state%ps(:ncol) pconb(:ncol) = state%ps(:ncol) do i = 1,lengath @@ -702,18 +643,15 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & ! add tendency from this process to tendencies from other processes call physics_ptend_sum(ptend_loc,ptend_all, ncol) - ! update physics state type state1 with ptend_loc + ! update physics state type state1 with ptend_loc call physics_update(state1, ptend_loc, ztodt) ! initialize ptend for next process lq(:) = .FALSE. lq(1) = .TRUE. - if (zmconv_org) then - lq(ixorg) = .TRUE. - endif - call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_evap', ls=.true., lq=lq) + call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_evap_run', ls=.true., lq=lq) - call t_startf ('zm_conv_evap') + call t_startf ('zm_conv_evap_run') ! ! Determine the phase of the precipitation produced and add latent heat of fusion ! Evaporate some of the precip directly into the environment (Sundqvist) @@ -723,28 +661,34 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call pbuf_get_field(pbuf, dp_flxprc_idx, flxprec ) call pbuf_get_field(pbuf, dp_flxsnw_idx, flxsnow ) - call pbuf_get_field(pbuf, dp_cldliq_idx, dp_cldliq ) - call pbuf_get_field(pbuf, dp_cldice_idx, dp_cldice ) - dp_cldliq(:ncol,:) = 0._r8 - dp_cldice(:ncol,:) = 0._r8 - - call zm_conv_evap(state1%ncol,state1%lchnk, & - state1%t,state1%pmid,state1%pdel,state1%q(:pcols,:pver,1), & - landfrac, & - ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, ptend_loc%q(:pcols,:pver,1), & - rprd, cld, ztodt, & - prec, snow, ntprprd, ntsnprd , flxprec, flxsnow, conv%sprd) +!REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + flxprec(:,:) = 0._r8 + flxsnow(:,:) = 0._r8 + snow(:) = 0._r8 + fice(:,:) = 0._r8 + fsnow_conv(:,:) = 0._r8 +!REMOVECAM_END + + top_lev = 1 + call phys_getopts (macrop_scheme_out = macrop_scheme) + if ( .not. (macrop_scheme == "rk" .or. macrop_scheme == "SPCAM_sam1mom")) top_lev = trop_cloud_top_lev + + call cloud_fraction_fice_run(ncol, state1%t(:ncol,:), tmelt, top_lev, pver, fice(:ncol,:), fsnow_conv(:ncol,:)) + + call zm_conv_evap_run(state1%ncol, pver, pverp, & + gravit, latice, latvap, tmelt, & + cpair, zmconv_ke, zmconv_ke_lnd, & + state1%t(:ncol,:),state1%pmid(:ncol,:),state1%pdel(:ncol,:),state1%q(:ncol,:pver,1), & + landfrac(:ncol), & + ptend_loc%s(:ncol,:), tend_s_snwprd(:ncol,:), tend_s_snwevmlt(:ncol,:), ptend_loc%q(:ncol,:pver,1), & + rprd(:ncol,:), cld(:ncol,:), ztodt, & + prec(:ncol), snow(:ncol), ntprprd(:ncol,:), ntsnprd(:ncol,:), fsnow_conv(:ncol,:), flxprec(:ncol,:), flxsnow(:ncol,:),& + scheme_name, errmsg, errflg) evapcdp(:ncol,:pver) = ptend_loc%q(:ncol,:pver,1) - - if (zmconv_org) then - ptend_loc%q(:ncol,:pver,ixorg) = min(1._r8,max(0._r8,(50._r8*1000._r8*1000._r8*abs(evapcdp(:ncol,:pver))) & - -(state%q(:ncol,:pver,ixorg)/10800._r8))) - ptend_loc%q(:ncol,:pver,ixorg) = (ptend_loc%q(:ncol,:pver,ixorg) - state%q(:ncol,:pver,ixorg))/ztodt - endif - + ! -! Write out variables from zm_conv_evap +! Write out variables from zm_conv_evap_run ! ftem(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpair call outfld('EVAPTZM ',ftem ,pcols ,lchnk ) @@ -758,80 +702,78 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call outfld('ZMNTPRPD', ntprprd, pcols, lchnk) call outfld('ZMNTSNPD', ntsnprd, pcols, lchnk) call outfld('ZMEIHEAT', ptend_loc%s, pcols, lchnk) - call outfld('CMFMCDZM ',mcon , pcols ,lchnk ) + call outfld('CMFMC_DP ',mcon , pcols ,lchnk ) call outfld('PRECCDZM ',prec, pcols ,lchnk ) - call t_stopf ('zm_conv_evap') + call t_stopf ('zm_conv_evap_run') call outfld('PRECZ ', prec , pcols, lchnk) ! add tendency from this process to tend from other processes here call physics_ptend_sum(ptend_loc,ptend_all, ncol) - ! update physics state type state1 with ptend_loc + ! update physics state type state1 with ptend_loc call physics_update(state1, ptend_loc, ztodt) - ! Momentum Transport (non-cam3 physics) + ! Momentum Transport - if ( .not. cam_physpkg_is('cam3')) then + call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_momtran_run', ls=.true., lu=.true., lv=.true.) - call physics_ptend_init(ptend_loc, state1%psetcols, 'momtran', ls=.true., lu=.true., lv=.true.) + l_windt = .true. +!REMOVECAM - no longer need these when CAM is retired and pcols no longer exists + ptend_loc%s(:,:) = 0._r8 + ptend_loc%u(:,:) = 0._r8 + ptend_loc%v(:,:) = 0._r8 +!REMOVECAM_END - winds(:ncol,:pver,1) = state1%u(:ncol,:pver) - winds(:ncol,:pver,2) = state1%v(:ncol,:pver) - - l_windt(1) = .true. - l_windt(2) = .true. + call t_startf ('zm_conv_momtran_run') - call t_startf ('momtran') - call momtran (lchnk, ncol, & - l_windt,winds, 2, mu, md, & - du, eu, ed, dp, dsubcld, & - jt, maxg, ideep, 1, lengath, & - nstep, wind_tends, pguall, pgdall, icwu, icwd, ztodt, seten ) - call t_stopf ('momtran') + call zm_conv_momtran_run (ncol, pver, pverp, & + l_windt,state1%u(:ncol,:), state1%v(:ncol,:), mu(:ncol,:), md(:ncol,:), & + zmconv_momcu, zmconv_momcd, & + du(:ncol,:), eu(:ncol,:), ed(:ncol,:), dp(:ncol,:), dsubcld(:ncol), & + jt(:ncol), maxg(:ncol), ideep(:ncol), 1, lengath, & + nstep, ptend_loc%u(:ncol,:), ptend_loc%v(:ncol,:),& + pguallu(:ncol,:), pguallv(:ncol,:), pgdallu(:ncol,:), pgdallv(:ncol,:), & + icwuu(:ncol,:), icwuv(:ncol,:), icwdu(:ncol,:), icwdv(:ncol,:), ztodt, seten(:ncol,:), & + scheme_name, errmsg, errflg) + call t_stopf ('zm_conv_momtran_run') - ptend_loc%u(:ncol,:pver) = wind_tends(:ncol,:pver,1) - ptend_loc%v(:ncol,:pver) = wind_tends(:ncol,:pver,2) - ptend_loc%s(:ncol,:pver) = seten(:ncol,:pver) + ptend_loc%s(:ncol,:pver) = seten(:ncol,:pver) - call physics_ptend_sum(ptend_loc,ptend_all, ncol) + call physics_ptend_sum(ptend_loc,ptend_all, ncol) + + ! Output ptend variables before they are set to zero with physics_update + call outfld('ZMMTU', ptend_loc%u, pcols, lchnk) + call outfld('ZMMTV', ptend_loc%v, pcols, lchnk) - ! update physics state type state1 with ptend_loc - call physics_update(state1, ptend_loc, ztodt) + ! update physics state type state1 with ptend_loc + call physics_update(state1, ptend_loc, ztodt) ftem(:ncol,:pver) = seten(:ncol,:pver)/cpair - if (zmconv_org) then - call outfld('ZM_ORG', state%q(:,:,ixorg), pcols, lchnk) - call outfld('ZM_ORG2D', zm_org2d, pcols, lchnk) - endif call outfld('ZMMTT', ftem , pcols, lchnk) - call outfld('ZMMTU', wind_tends(1,1,1), pcols, lchnk) - call outfld('ZMMTV', wind_tends(1,1,2), pcols, lchnk) - - ! Output apparent force from pressure gradient - call outfld('ZMUPGU', pguall(1,1,1), pcols, lchnk) - call outfld('ZMUPGD', pgdall(1,1,1), pcols, lchnk) - call outfld('ZMVPGU', pguall(1,1,2), pcols, lchnk) - call outfld('ZMVPGD', pgdall(1,1,2), pcols, lchnk) - - ! Output in-cloud winds - call outfld('ZMICUU', icwu(1,1,1), pcols, lchnk) - call outfld('ZMICUD', icwd(1,1,1), pcols, lchnk) - call outfld('ZMICVU', icwu(1,1,2), pcols, lchnk) - call outfld('ZMICVD', icwd(1,1,2), pcols, lchnk) - end if + ! Output apparent force from pressure gradient + call outfld('ZMUPGU', pguallu, pcols, lchnk) + call outfld('ZMUPGD', pgdallu, pcols, lchnk) + call outfld('ZMVPGU', pguallv, pcols, lchnk) + call outfld('ZMVPGD', pgdallv, pcols, lchnk) - ! Transport cloud water and ice only - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) + ! Output in-cloud winds + call outfld('ZMICUU', icwuu, pcols, lchnk) + call outfld('ZMICUD', icwdu, pcols, lchnk) + call outfld('ZMICVU', icwuv, pcols, lchnk) + call outfld('ZMICVD', icwdv, pcols, lchnk) - lq(:) = .FALSE. - lq(2:) = cnst_is_convtran1(2:) - call physics_ptend_init(ptend_loc, state1%psetcols, 'convtran1', lq=lq) + ! Transport cloud water and ice only + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + + lq(:) = .FALSE. + lq(2:) = cnst_is_convtran1(2:) + call physics_ptend_init(ptend_loc, state1%psetcols, 'convtran1', lq=lq) ! dpdry is not used in this call to convtran since the cloud liquid and ice mixing @@ -839,11 +781,17 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & fake_dpdry(:,:) = 0._r8 call t_startf ('convtran1') - call convtran (lchnk, & - ptend_loc%lq,state1%q, pcnst, mu, md, & - du, eu, ed, dp, dsubcld, & - jt,maxg, ideep, 1, lengath, & - nstep, fracis, ptend_loc%q, fake_dpdry, ztodt) + +!REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + ptend_loc%q(:,:,:) = 0._r8 +!REMOVECAM_END + + call zm_conv_convtran_run (ncol, pver, & + 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,:), ccpp_const_props, & + scheme_name, errmsg, errflg) call t_stopf ('convtran1') call outfld('ZMDICE ',ptend_loc%q(1,1,ixcldice) ,pcols ,lchnk ) @@ -855,65 +803,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call physics_state_dealloc(state1) call physics_ptend_dealloc(ptend_loc) - if (zmconv_org) then - deallocate(zm_org2d) - end if - if (zmconv_microp) then - deallocate( & - conv%qi, & - conv%qliq, & - conv%qice, & - conv%wu, & - conv%sprd, & - conv%qrain, & - conv%qsnow, & - conv%qnl, & - conv%qni, & - conv%qnr, & - conv%qns, & - conv%frz, & - conv%autolm, & - conv%accrlm, & - conv%bergnm, & - conv%fhtimm, & - conv%fhtctm, & - conv%fhmlm , & - conv%hmpim , & - conv%accslm, & - conv%dlfm , & - conv%autoln, & - conv%accrln, & - conv%bergnn, & - conv%fhtimn, & - conv%fhtctn, & - conv%fhmln , & - conv%accsln, & - conv%activn, & - conv%dlfn , & - conv%autoim, & - conv%accsim, & - conv%difm , & - conv%nuclin, & - conv%autoin, & - conv%accsin, & - conv%hmpin , & - conv%difn , & - conv%cmel , & - conv%cmei , & - conv%trspcm, & - conv%trspcn, & - conv%trspim, & - conv%trspin, & - conv%lambdadpcu, & - conv%mudpcu, & - conv%dcape ) - - else - - deallocate(dnlf, dnif) - - end if end subroutine zm_conv_tend !========================================================================================= @@ -925,11 +815,13 @@ subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf) use time_manager, only: get_nstep use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc use constituents, only: pcnst, cnst_is_convtran2 - + use ccpp_constituent_prop_mod, only: ccpp_const_props + + ! Arguments type(physics_state), intent(in ) :: state ! Physics state variables type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies - + type(physics_buffer_desc), pointer :: pbuf(:) real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) @@ -938,21 +830,27 @@ subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf) integer :: i, lchnk, istat integer :: lengath ! number of columns with deep convection integer :: nstep + integer :: ncol real(r8), dimension(pcols,pver) :: dpdry - ! physics buffer fields + ! physics buffer fields real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble - real(r8), pointer :: mu(:,:) ! (pcols,pver) - real(r8), pointer :: eu(:,:) ! (pcols,pver) - real(r8), pointer :: du(:,:) ! (pcols,pver) - real(r8), pointer :: md(:,:) ! (pcols,pver) - real(r8), pointer :: ed(:,:) ! (pcols,pver) - real(r8), pointer :: dp(:,:) ! (pcols,pver) - real(r8), pointer :: dsubcld(:) ! (pcols) - integer, pointer :: jt(:) ! (pcols) - integer, pointer :: maxg(:) ! (pcols) - integer, pointer :: ideep(:) ! (pcols) + real(r8), pointer :: mu(:,:) ! (pcols,pver) + real(r8), pointer :: eu(:,:) ! (pcols,pver) + real(r8), pointer :: du(:,:) ! (pcols,pver) + real(r8), pointer :: md(:,:) ! (pcols,pver) + real(r8), pointer :: ed(:,:) ! (pcols,pver) + real(r8), pointer :: dp(:,:) ! (pcols,pver) + real(r8), pointer :: dsubcld(:) ! (pcols) + integer, pointer :: jt(:) ! (pcols) + integer, pointer :: maxg(:) ! (pcols) + integer, pointer :: ideep(:) ! (pcols) + + character(len=40) :: scheme_name + character(len=512) :: errmsg + integer :: errflg + !----------------------------------------------------------------------------------- @@ -970,11 +868,14 @@ subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf) call pbuf_get_field(pbuf, zm_maxg_idx, maxg) call pbuf_get_field(pbuf, zm_ideep_idx, ideep) - lengath = count(ideep > 0) lchnk = state%lchnk + ncol = state%ncol nstep = get_nstep() + lengath = count(ideep > 0) + if (lengath > ncol) lengath = ncol ! should not happen, but force it to not be larger than ncol for safety sake + if (any(ptend%lq(:))) then ! initialize dpdry for call to convtran ! it is used for tracers of dry mixing ratio type @@ -984,396 +885,28 @@ subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf) end do call t_startf ('convtran2') - call convtran (lchnk, & - ptend%lq,state%q, pcnst, mu, md, & - du, eu, ed, dp, dsubcld, & - jt, maxg, ideep, 1, lengath, & - nstep, fracis, ptend%q, dpdry, ztodt) - call t_stopf ('convtran2') - end if - -end subroutine zm_conv_tend_2 - -!========================================================================================= - -subroutine zm_conv_micro_init() - - use cam_history, only: addfld, add_default, horiz_only - use ppgrid, only: pcols, pver - use pmgrid, only: plev,plevp - use phys_control, only: cam_physpkg_is - use physics_buffer, only: pbuf_get_index - use zm_microphysics, only: zm_mphyi - - implicit none - - integer :: i - - ! - ! Register fields with the output buffer - ! - call addfld ('ICIMRDP', (/ 'lev' /), 'A','kg/kg', 'Deep Convection in-cloud ice mixing ratio ') - call addfld ('CLDLIQZM',(/ 'lev' /), 'A','g/m3' ,'Cloud liquid water - ZM convection') - call addfld ('CLDICEZM',(/ 'lev' /), 'A','g/m3' ,'Cloud ice water - ZM convection') - call addfld ('CLIQSNUM',(/ 'lev' /), 'A','1' ,'Cloud liquid water sample number - ZM convection') - call addfld ('CICESNUM',(/ 'lev' /), 'A','1' ,'Cloud ice water sample number - ZM convection') - call addfld ('QRAINZM' ,(/ 'lev' /), 'A','g/m3' ,'rain water - ZM convection') - call addfld ('QSNOWZM' ,(/ 'lev' /), 'A','g/m3' ,'snow - ZM convection') - call addfld ('CRAINNUM',(/ 'lev' /), 'A','1' ,'Cloud rain water sample number - ZM convection') - call addfld ('CSNOWNUM',(/ 'lev' /), 'A','1' ,'Cloud snow sample number - ZM convection') - - call addfld ('DNIFZM' ,(/ 'lev' /), 'A','1/kg/s ' ,'Detrained ice water num concen from ZM convection') - call addfld ('DNLFZM' ,(/ 'lev' /), 'A','1/kg/s ' ,'Detrained liquid water num concen from ZM convection') - call addfld ('WUZM' ,(/ 'lev' /), 'A','m/s' ,'vertical velocity - ZM convection') - call addfld ('WUZMSNUM',(/ 'lev' /), 'A','1' ,'vertical velocity sample number - ZM convection') - - call addfld ('QNLZM',(/ 'lev' /), 'A','1/m3' ,'Cloud liquid water number concen - ZM convection') - call addfld ('QNIZM',(/ 'lev' /), 'A','1/m3' ,'Cloud ice number concen - ZM convection') - call addfld ('QNRZM',(/ 'lev' /), 'A','1/m3' ,'Cloud rain water number concen - ZM convection') - call addfld ('QNSZM',(/ 'lev' /), 'A','1/m3' ,'Cloud snow number concen - ZM convection') - - call addfld ('FRZZM',(/ 'lev' /), 'A','1/s' ,'mass tendency due to freezing - ZM convection') - - call addfld ('AUTOL_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to autoconversion of droplets to rain') - call addfld ('ACCRL_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to accretion of droplets by rain') - call addfld ('BERGN_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to Bergeron process') - call addfld ('FHTIM_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to immersion freezing') - call addfld ('FHTCT_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to contact freezing') - call addfld ('FHML_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to homogeneous freezing of droplet') - call addfld ('HMPI_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to HM process') - call addfld ('ACCSL_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to accretion of droplet by snow') - call addfld ('DLF_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to detrainment of droplet') - call addfld ('COND_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to condensation') - - call addfld ('AUTOL_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to autoconversion of droplets to rain') - call addfld ('ACCRL_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to accretion of droplets by rain') - call addfld ('BERGN_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to Bergeron process') - call addfld ('FHTIM_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to immersion freezing') - call addfld ('FHTCT_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to contact freezing') - call addfld ('FHML_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to homogeneous freezing of droplet') - call addfld ('ACCSL_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to accretion of droplet by snow') - call addfld ('ACTIV_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to droplets activation') - call addfld ('DLF_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to detrainment of droplet') - - call addfld ('AUTOI_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to autoconversion of ice to snow') - call addfld ('ACCSI_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to accretion of ice by snow') - call addfld ('DIF_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to detrainment of cloud ice') - call addfld ('DEPOS_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to deposition') - - call addfld ('NUCLI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to ice nucleation') - call addfld ('AUTOI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to autoconversion of ice to snow') - call addfld ('ACCSI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to accretion of ice by snow') - call addfld ('HMPI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to HM process') - call addfld ('DIF_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to detrainment of cloud ice') - - call addfld ('TRSPC_M' ,(/ 'lev' /), 'A','kg/kg/m','mass tendency of droplets due to convective transport') - call addfld ('TRSPC_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency of droplets due to convective transport') - call addfld ('TRSPI_M' ,(/ 'lev' /), 'A','kg/kg/m','mass tendency of ice crystal due to convective transport') - call addfld ('TRSPI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency of ice crystal due to convective transport') - - - call add_default ('CLDLIQZM', 1, ' ') - call add_default ('CLDICEZM', 1, ' ') - call add_default ('CLIQSNUM', 1, ' ') - call add_default ('CICESNUM', 1, ' ') - call add_default ('DNIFZM', 1, ' ') - call add_default ('DNLFZM', 1, ' ') - call add_default ('WUZM', 1, ' ') - call add_default ('QRAINZM', 1, ' ') - call add_default ('QSNOWZM', 1, ' ') - call add_default ('CRAINNUM', 1, ' ') - call add_default ('CSNOWNUM', 1, ' ') - call add_default ('QNLZM', 1, ' ') - call add_default ('QNIZM', 1, ' ') - call add_default ('QNRZM', 1, ' ') - call add_default ('QNSZM', 1, ' ') - call add_default ('FRZZM', 1, ' ') - - ! Initialization for the microphysics - - call zm_mphyi() - - ! Initialize the aerosol object with data from the modes/species - ! affecting climate, - ! i.e., the list index is hardcoded to 0. - - call rad_cnst_get_info(0, nmodes=nmodes, naero=nbulk) - - - do i = begchunk, endchunk - call zm_aero_init(nmodes, nbulk, aero(i)) - end do - - if (nmodes > 0) then - - dgnum_idx = pbuf_get_index('DGNUM') - - else if (nbulk > 0 .and. cam_physpkg_is('cam4')) then - - ! This call is needed to allow running the ZM microphysics with the - ! cam4 physics package. - call ndrop_bam_init() - - end if - - end subroutine zm_conv_micro_init +!REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + ptend%q(:,:,:) = 0._r8 +!REMOVECAM_END - subroutine zm_aero_init(nmodes, nbulk, aero) + call zm_conv_convtran_run (ncol, pver, & + 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,:), ccpp_const_props, & + scheme_name, errmsg, errflg) - use pmgrid, only: plev,plevp - - ! Initialize the zm_aero_t object for modal aerosols - - integer, intent(in) :: nmodes - integer, intent(in) :: nbulk - type(zm_aero_t), intent(out) :: aero - - integer :: iaer, l, m - integer :: nspecmx ! max number of species in a mode - - character(len=20), allocatable :: aername(:) - character(len=32) :: str32 - character(len=*), parameter :: routine = 'zm_conv_init' - - real(r8) :: sigmag, dgnumlo, dgnumhi - real(r8) :: alnsg - !---------------------------------------------------------------------------------- - - aero%nmodes = nmodes - aero%nbulk = nbulk - - if (nmodes > 0) then - - ! Initialize the modal aerosol information - - aero%scheme = 'modal' - - ! Get number of species in each mode, and find max. - allocate(aero%nspec(aero%nmodes)) - nspecmx = 0 - do m = 1, aero%nmodes - - call rad_cnst_get_info(0, m, nspec=aero%nspec(m), mode_type=str32) - - nspecmx = max(nspecmx, aero%nspec(m)) - - ! save mode index for specified mode types - select case (trim(str32)) - case ('accum') - aero%mode_accum_idx = m - case ('aitken') - aero%mode_aitken_idx = m - case ('coarse') - aero%mode_coarse_idx = m - end select - - end do - - ! Check that required mode types were found - if (aero%mode_accum_idx == -1 .or. aero%mode_aitken_idx == -1 .or. aero%mode_coarse_idx == -1) then - write(iulog,*) routine//': ERROR required mode type not found - mode idx:', & - aero%mode_accum_idx, aero%mode_aitken_idx, aero%mode_coarse_idx - call endrun(routine//': ERROR required mode type not found') - end if - - ! find indices for the dust and seasalt species in the coarse mode - do l = 1, aero%nspec(aero%mode_coarse_idx) - call rad_cnst_get_info(0, aero%mode_coarse_idx, l, spec_type=str32) - select case (trim(str32)) - case ('dust') - aero%coarse_dust_idx = l - case ('seasalt') - aero%coarse_nacl_idx = l - end select - end do - ! Check that required modal specie types were found - if (aero%coarse_dust_idx == -1 .or. aero%coarse_nacl_idx == -1) then - write(iulog,*) routine//': ERROR required mode-species type not found - indicies:', & - aero%coarse_dust_idx, aero%coarse_nacl_idx - call endrun(routine//': ERROR required mode-species type not found') - end if - - allocate( & - aero%num_a(nmodes), & - aero%mmr_a(nspecmx,nmodes), & - aero%numg_a(pcols,pver,nmodes), & - aero%mmrg_a(pcols,pver,nspecmx,nmodes), & - aero%voltonumblo(nmodes), & - aero%voltonumbhi(nmodes), & - aero%specdens(nspecmx,nmodes), & - aero%spechygro(nspecmx,nmodes), & - aero%dgnum(nmodes), & - aero%dgnumg(pcols,pver,nmodes) ) - - - do m = 1, nmodes - - ! Properties of modes - call rad_cnst_get_mode_props(0, m, & - sigmag=sigmag, dgnumlo=dgnumlo, dgnumhi=dgnumhi) - - alnsg = log(sigmag) - aero%voltonumblo(m) = 1._r8 / ( (pi/6._r8)*(dgnumlo**3._r8)*exp(4.5_r8*alnsg**2._r8) ) - aero%voltonumbhi(m) = 1._r8 / ( (pi/6._r8)*(dgnumhi**3._r8)*exp(4.5_r8*alnsg**2._r8) ) - - ! save sigmag of aitken mode - if (m == aero%mode_aitken_idx) aero%sigmag_aitken = sigmag - - ! Properties of modal species - do l = 1, aero%nspec(m) - call rad_cnst_get_aer_props(0, m, l, density_aer=aero%specdens(l,m), & - hygro_aer=aero%spechygro(l,m)) - end do - end do - - else if (nbulk > 0) then - - aero%scheme = 'bulk' - - ! Props needed for BAM number concentration calcs. - allocate( & - aername(nbulk), & - aero%num_to_mass_aer(nbulk), & - aero%mmr_bulk(nbulk), & - aero%mmrg_bulk(pcols,plev,nbulk) ) - - do iaer = 1, aero%nbulk - call rad_cnst_get_aer_props(0, iaer, & - aername = aername(iaer), & - num_to_mass_aer = aero%num_to_mass_aer(iaer) ) - - ! Look for sulfate aerosol in this list (Bulk aerosol only) - if (trim(aername(iaer)) == 'SULFATE') aero%idxsul = iaer - if (trim(aername(iaer)) == 'DUST1') aero%idxdst1 = iaer - if (trim(aername(iaer)) == 'DUST2') aero%idxdst2 = iaer - if (trim(aername(iaer)) == 'DUST3') aero%idxdst3 = iaer - if (trim(aername(iaer)) == 'DUST4') aero%idxdst4 = iaer - if (trim(aername(iaer)) == 'BCPHI') aero%idxbcphi = iaer - end do - - end if - - end subroutine zm_aero_init + if (errflg /= 0) then + call endrun('From zm_conv_convtran_run:' // errmsg) + end if - subroutine zm_conv_micro_outfld(conv, dnif, dnlf, lchnk, ncol) + call t_stopf ('convtran2') + end if - use cam_history, only: outfld +end subroutine zm_conv_tend_2 - type(zm_conv_t),intent(in) :: conv - real(r8), intent(in) :: dnlf(:,:) ! detrained convective cloud water num concen. - real(r8), intent(in) :: dnif(:,:) ! detrained convective cloud ice num concen. - integer, intent(in) :: lchnk - integer, intent(in) :: ncol - - integer :: i,k - - real(r8) :: cice_snum(pcols,pver) ! convective cloud ice sample number. - real(r8) :: cliq_snum(pcols,pver) ! convective cloud liquid sample number. - real(r8) :: crain_snum(pcols,pver) ! convective rain water sample number. - real(r8) :: csnow_snum(pcols,pver) ! convective snow sample number. - real(r8) :: wu_snum(pcols,pver) ! vertical velocity sample number - - real(r8) :: qni_snum(pcols,pver) ! convective cloud ice number sample number. - real(r8) :: qnl_snum(pcols,pver) ! convective cloud liquid number sample number. - - do k = 1,pver - do i = 1,ncol - if (conv%qice(i,k) .gt. 0.0_r8) then - cice_snum(i,k) = 1.0_r8 - else - cice_snum(i,k) = 0.0_r8 - end if - if (conv%qliq(i,k) .gt. 0.0_r8) then - cliq_snum(i,k) = 1.0_r8 - else - cliq_snum(i,k) = 0.0_r8 - end if - if (conv%qsnow(i,k) .gt. 0.0_r8) then - csnow_snum(i,k) = 1.0_r8 - else - csnow_snum(i,k) = 0.0_r8 - end if - if (conv%qrain(i,k) .gt. 0.0_r8) then - crain_snum(i,k) = 1.0_r8 - else - crain_snum(i,k) = 0.0_r8 - end if - - if (conv%qnl(i,k) .gt. 0.0_r8) then - qnl_snum(i,k) = 1.0_r8 - else - qnl_snum(i,k) = 0.0_r8 - end if - if (conv%qni(i,k) .gt. 0.0_r8) then - qni_snum(i,k) = 1.0_r8 - else - qni_snum(i,k) = 0.0_r8 - end if - if (conv%wu(i,k) .gt. 0.0_r8) then - wu_snum(i,k) = 1.0_r8 - else - wu_snum(i,k) = 0.0_r8 - end if - - end do - end do +!========================================================================================= - call outfld('ICIMRDP ',conv%qi ,pcols, lchnk ) - call outfld('CLDLIQZM',conv%qliq ,pcols, lchnk) - call outfld('CLDICEZM',conv%qice ,pcols, lchnk) - call outfld('CLIQSNUM',cliq_snum ,pcols, lchnk) - call outfld('CICESNUM',cice_snum ,pcols, lchnk) - call outfld('QRAINZM' ,conv%qrain ,pcols, lchnk) - call outfld('QSNOWZM' ,conv%qsnow ,pcols, lchnk) - call outfld('CRAINNUM',crain_snum ,pcols, lchnk) - call outfld('CSNOWNUM',csnow_snum ,pcols, lchnk) - - call outfld('WUZM' ,conv%wu ,pcols, lchnk) - call outfld('WUZMSNUM',wu_snum ,pcols, lchnk) - call outfld('QNLZM' ,conv%qnl ,pcols, lchnk) - call outfld('QNIZM' ,conv%qni ,pcols, lchnk) - call outfld('QNRZM' ,conv%qnr ,pcols, lchnk) - call outfld('QNSZM' ,conv%qns ,pcols, lchnk) - call outfld('FRZZM' ,conv%frz ,pcols, lchnk) - - call outfld('AUTOL_M' ,conv%autolm ,pcols, lchnk) - call outfld('ACCRL_M' ,conv%accrlm ,pcols, lchnk) - call outfld('BERGN_M' ,conv%bergnm ,pcols, lchnk) - call outfld('FHTIM_M' ,conv%fhtimm ,pcols, lchnk) - call outfld('FHTCT_M' ,conv%fhtctm ,pcols, lchnk) - call outfld('FHML_M' ,conv%fhmlm ,pcols, lchnk) - call outfld('HMPI_M' ,conv%hmpim ,pcols, lchnk) - call outfld('ACCSL_M' ,conv%accslm ,pcols, lchnk) - call outfld('DLF_M' ,conv%dlfm ,pcols, lchnk) - - call outfld('AUTOL_N' ,conv%autoln ,pcols, lchnk) - call outfld('ACCRL_N' ,conv%accrln ,pcols, lchnk) - call outfld('BERGN_N' ,conv%bergnn ,pcols, lchnk) - call outfld('FHTIM_N' ,conv%fhtimn ,pcols, lchnk) - call outfld('FHTCT_N' ,conv%fhtctn ,pcols, lchnk) - call outfld('FHML_N' ,conv%fhmln ,pcols, lchnk) - call outfld('ACCSL_N' ,conv%accsln ,pcols, lchnk) - call outfld('ACTIV_N' ,conv%activn ,pcols, lchnk) - call outfld('DLF_N' ,conv%dlfn ,pcols, lchnk) - call outfld('AUTOI_M' ,conv%autoim ,pcols, lchnk) - call outfld('ACCSI_M' ,conv%accsim ,pcols, lchnk) - call outfld('DIF_M' ,conv%difm ,pcols, lchnk) - call outfld('NUCLI_N' ,conv%nuclin ,pcols, lchnk) - call outfld('AUTOI_N' ,conv%autoin ,pcols, lchnk) - call outfld('ACCSI_N' ,conv%accsin ,pcols, lchnk) - call outfld('HMPI_N' ,conv%hmpin ,pcols, lchnk) - call outfld('DIF_N' ,conv%difn ,pcols, lchnk) - call outfld('COND_M' ,conv%cmel ,pcols, lchnk) - call outfld('DEPOS_M' ,conv%cmei ,pcols, lchnk) - - call outfld('TRSPC_M' ,conv%trspcm ,pcols, lchnk) - call outfld('TRSPC_N' ,conv%trspcn ,pcols, lchnk) - call outfld('TRSPI_M' ,conv%trspim ,pcols, lchnk) - call outfld('TRSPI_N' ,conv%trspin ,pcols, lchnk) - call outfld('DNIFZM' ,dnif ,pcols, lchnk) - call outfld('DNLFZM' ,dnlf ,pcols, lchnk) - - end subroutine zm_conv_micro_outfld end module zm_conv_intr diff --git a/src/physics/cam/zm_microphysics.F90 b/src/physics/cam/zm_microphysics.F90 deleted file mode 100644 index 29607725bc..0000000000 --- a/src/physics/cam/zm_microphysics.F90 +++ /dev/null @@ -1,2445 +0,0 @@ -module zm_microphysics - -!--------------------------------------------------------------------------------- -! Purpose: -! CAM Interface for cumulus microphysics -! -! Author: Xialiang Song and Guang Jun Zhang, June 2010 -!--------------------------------------------------------------------------------- - -use shr_kind_mod, only: r8=>shr_kind_r8 -use spmd_utils, only: masterproc -use ppgrid, only: pcols, pver, pverp -use physconst, only: gravit, rair, tmelt, cpair, rh2o, r_universal, mwh2o, rhoh2o -use physconst, only: latvap, latice -!use activate_drop_mam, only: actdrop_mam_calc -use ndrop, only: activate_modal -use ndrop_bam, only: ndrop_bam_run -use nucleate_ice, only: nucleati -use shr_spfn_mod, only: erf => shr_spfn_erf -use shr_spfn_mod, only: gamma => shr_spfn_gamma -use wv_saturation, only: svp_water, svp_ice -use cam_logfile, only: iulog -use cam_abortutils, only: endrun -use micro_mg_utils, only:ice_autoconversion, snow_self_aggregation, accrete_cloud_water_snow, & - secondary_ice_production, accrete_rain_snow, heterogeneous_rain_freezing, & - accrete_cloud_water_rain, self_collection_rain, accrete_cloud_ice_snow - -implicit none -private -save - -public :: & - zm_mphyi, & - zm_mphy, & - zm_conv_t,& - zm_aero_t - -! Private module data - -! constants remaped -real(r8) :: g ! gravity -real(r8) :: mw ! molecular weight of water -real(r8) :: r ! Dry air Gas constant -real(r8) :: rv ! water vapor gas contstant -real(r8) :: rr ! universal gas constant -real(r8) :: cpp ! specific heat of dry air -real(r8) :: rhow ! density of liquid water -real(r8) :: xlf ! latent heat of freezing - -!from 'microconstants' -real(r8) :: rhosn ! bulk density snow -real(r8) :: rhoi ! bulk density ice - -real(r8) :: ac,bc,as,bs,ai,bi,ar,br !fall speed parameters -real(r8) :: ci,di !ice mass-diameter relation parameters -real(r8) :: cs,ds !snow mass-diameter relation parameters -real(r8) :: cr,dr !drop mass-diameter relation parameters -real(r8) :: Eii !collection efficiency aggregation of ice -real(r8) :: Ecc !collection efficiency -real(r8) :: Ecr !collection efficiency cloud droplets/rain -real(r8) :: DCS !autoconversion size threshold -real(r8) :: bimm,aimm !immersion freezing -real(r8) :: rhosu !typical 850mn air density -real(r8) :: mi0 ! new crystal mass -real(r8) :: rin ! radius of contact nuclei -real(r8) :: pi ! pi - -! contact freezing due to dust -! dust number mean radius (m), Zender et al JGR 2003 assuming number mode radius of 0.6 micron, sigma=2 -real(r8), parameter :: rn_dst1 = 0.258e-6_r8 -real(r8), parameter :: rn_dst2 = 0.717e-6_r8 -real(r8), parameter :: rn_dst3 = 1.576e-6_r8 -real(r8), parameter :: rn_dst4 = 3.026e-6_r8 - -! smallest mixing ratio considered in microphysics -real(r8), parameter :: qsmall = 1.e-18_r8 - - -type, public :: ptr2d - real(r8), pointer :: val(:,:) -end type ptr2d - -! Aerosols -type :: zm_aero_t - - ! Aerosol treatment - character(len=5) :: scheme ! either 'bulk' or 'modal' - - ! Bulk aerosols - integer :: nbulk = 0 ! number of bulk aerosols affecting climate - integer :: idxsul = -1 ! index in aerosol list for sulfate - integer :: idxdst1 = -1 ! index in aerosol list for dust1 - integer :: idxdst2 = -1 ! index in aerosol list for dust2 - integer :: idxdst3 = -1 ! index in aerosol list for dust3 - integer :: idxdst4 = -1 ! index in aerosol list for dust4 - integer :: idxbcphi = -1 ! index in aerosol list for Soot (BCPHI) - - real(r8), allocatable :: num_to_mass_aer(:) ! conversion of mmr to number conc for bulk aerosols - type(ptr2d), allocatable :: mmr_bulk(:) ! array of pointers to bulk aerosol mmr - real(r8), allocatable :: mmrg_bulk(:,:,:) ! gathered bulk aerosol mmr - - ! Modal aerosols - integer :: nmodes = 0 ! number of modes - integer, allocatable :: nspec(:) ! number of species in each mode - type(ptr2d), allocatable :: num_a(:) ! number mixing ratio of modes (interstitial phase) - type(ptr2d), allocatable :: mmr_a(:,:) ! species mmr in each mode (interstitial phase) - real(r8), allocatable :: numg_a(:,:,:) ! gathered number mixing ratio of modes (interstitial phase) - real(r8), allocatable :: mmrg_a(:,:,:,:) ! gathered species mmr in each mode (interstitial phase) - real(r8), allocatable :: voltonumblo(:) ! volume to number conversion (lower bound) for each mode - real(r8), allocatable :: voltonumbhi(:) ! volume to number conversion (upper bound) for each mode - real(r8), allocatable :: specdens(:,:) ! density of modal species - real(r8), allocatable :: spechygro(:,:) ! hygroscopicity of modal species - - integer :: mode_accum_idx = -1 ! index of accumulation mode - integer :: mode_aitken_idx = -1 ! index of aitken mode - integer :: mode_coarse_idx = -1 ! index of coarse mode - integer :: coarse_dust_idx = -1 ! index of dust in coarse mode - integer :: coarse_nacl_idx = -1 ! index of nacl in coarse mode - - type(ptr2d), allocatable :: dgnum(:) ! mode dry radius - real(r8), allocatable :: dgnumg(:,:,:) ! gathered mode dry radius - - real(r8) :: sigmag_aitken - -end type zm_aero_t - -type :: zm_conv_t - - real(r8), allocatable :: qi(:,:) ! wg grid slice of cloud ice. - real(r8), allocatable :: qliq(:,:) ! convective cloud liquid water. - real(r8), allocatable :: qice(:,:) ! convective cloud ice. - real(r8), allocatable :: wu(:,:) ! vertical velocity - real(r8), allocatable :: sprd(:,:) ! rate of production of snow at that layer - real(r8), allocatable :: qrain(:,:) ! convective rain water. - real(r8), allocatable :: qsnow(:,:) ! convective snow. - real(r8), allocatable :: qnl(:,:) ! convective cloud liquid water num concen. - real(r8), allocatable :: qni(:,:) ! convective cloud ice num concen. - real(r8), allocatable :: qnr(:,:) ! convective rain water num concen. - real(r8), allocatable :: qns(:,:) ! convective snow num concen. - real(r8), allocatable :: frz(:,:) ! heating rate due to freezing - real(r8), allocatable :: autolm(:,:) !mass tendency due to autoconversion of droplets to rain - real(r8), allocatable :: accrlm(:,:) !mass tendency due to accretion of droplets by rain - real(r8), allocatable :: bergnm(:,:) !mass tendency due to Bergeron process - real(r8), allocatable :: fhtimm(:,:) !mass tendency due to immersion freezing - real(r8), allocatable :: fhtctm(:,:) !mass tendency due to contact freezing - real(r8), allocatable :: fhmlm (:,:) !mass tendency due to homogeneous freezing - real(r8), allocatable :: hmpim (:,:) !mass tendency due to HM process - real(r8), allocatable :: accslm(:,:) !mass tendency due to accretion of droplets by snow - real(r8), allocatable :: dlfm (:,:) !mass tendency due to detrainment of droplet - real(r8), allocatable :: autoln(:,:) !num tendency due to autoconversion of droplets to rain - real(r8), allocatable :: accrln(:,:) !num tendency due to accretion of droplets by rain - real(r8), allocatable :: bergnn(:,:) !num tendency due to Bergeron process - real(r8), allocatable :: fhtimn(:,:) !num tendency due to immersion freezing - real(r8), allocatable :: fhtctn(:,:) !num tendency due to contact freezing - real(r8), allocatable :: fhmln (:,:) !num tendency due to homogeneous freezing - real(r8), allocatable :: accsln(:,:) !num tendency due to accretion of droplets by snow - real(r8), allocatable :: activn(:,:) !num tendency due to droplets activation - real(r8), allocatable :: dlfn (:,:) !num tendency due to detrainment of droplet - real(r8), allocatable :: autoim(:,:) !mass tendency due to autoconversion of cloud ice to snow - real(r8), allocatable :: accsim(:,:) !mass tendency due to accretion of cloud ice by snow - real(r8), allocatable :: difm (:,:) !mass tendency due to detrainment of cloud ice - real(r8), allocatable :: nuclin(:,:) !num tendency due to ice nucleation - real(r8), allocatable :: autoin(:,:) !num tendency due to autoconversion of cloud ice to snow - real(r8), allocatable :: accsin(:,:) !num tendency due to accretion of cloud ice by snow - real(r8), allocatable :: hmpin (:,:) !num tendency due to HM process - real(r8), allocatable :: difn (:,:) !num tendency due to detrainment of cloud ice - real(r8), allocatable :: cmel (:,:) !mass tendency due to condensation - real(r8), allocatable :: cmei (:,:) !mass tendency due to deposition - real(r8), allocatable :: trspcm(:,:) !LWC tendency due to convective transport - real(r8), allocatable :: trspcn(:,:) !droplet num tendency due to convective transport - real(r8), allocatable :: trspim(:,:) !IWC tendency due to convective transport - real(r8), allocatable :: trspin(:,:) !ice crystal num tendency due to convective transport - real(r8), allocatable :: dcape(:) ! CAPE change due to freezing heating - real(r8), allocatable :: lambdadpcu(:,:)! slope of cloud liquid size distr - real(r8), allocatable :: mudpcu(:,:) ! width parameter of droplet size distr - real(r8), allocatable :: di(:,:) - real(r8), allocatable :: dnl(:,:) - real(r8), allocatable :: dni(:,:) - real(r8), allocatable :: qide(:,:) ! cloud ice mixing ratio for detrainment (kg/kg) - real(r8), allocatable :: qncde(:,:) ! cloud water number concentration for detrainment (1/kg) - real(r8), allocatable :: qnide(:,:) ! cloud ice number concentration for detrainment (1/kg) - - -end type zm_conv_t - -real(r8), parameter :: dcon = 25.e-6_r8 -real(r8), parameter :: mucon = 5.3_r8 -real(r8), parameter :: lambdadpcu = (mucon + 1._r8)/dcon - -!=============================================================================== -contains -!=============================================================================== - -subroutine zm_mphyi - -!----------------------------------------------------------------------- -! -! Purpose: -! initialize constants for the cumulus microphysics -! called from zm_conv_init() in zm_conv_intr.F90 -! -! Author: Xialiang Song, June 2010 -! -!----------------------------------------------------------------------- - -!NOTE: -! latent heats should probably be fixed with temperature -! for energy conservation with the rest of the model -! (this looks like a +/- 3 or 4% effect, but will mess up energy balance) - - xlf = latice ! latent heat freezing - -! from microconstants - -! parameters below from Reisner et al. (1998) -! density parameters (kg/m3) - - rhosn = 100._r8 ! bulk density snow - rhoi = 500._r8 ! bulk density ice - rhow = 1000._r8 ! bulk density liquid - -! fall speed parameters, V = aD^b -! V is in m/s - -! droplets - ac = 3.e7_r8 - bc = 2._r8 - -! snow - as = 11.72_r8 - bs = 0.41_r8 - -! cloud ice - ai = 700._r8 - bi = 1._r8 - -! rain - ar = 841.99667_r8 - br = 0.8_r8 - -! particle mass-diameter relationship -! currently we assume spherical particles for cloud ice/snow -! m = cD^d - - pi= 3.14159265358979323846_r8 - -! cloud ice mass-diameter relationship - - ci = rhoi*pi/6._r8 - di = 3._r8 - -! snow mass-diameter relationship - - cs = rhosn*pi/6._r8 - ds = 3._r8 - -! drop mass-diameter relationship - - cr = rhow*pi/6._r8 - dr = 3._r8 - -! collection efficiency, aggregation of cloud ice and snow - - Eii = 0.1_r8 - -! collection efficiency, accretion of cloud water by rain - - Ecr = 1.0_r8 - -! autoconversion size threshold for cloud ice to snow (m) - - Dcs = 150.e-6_r8 -! immersion freezing parameters, bigg 1953 - - bimm = 100._r8 - aimm = 0.66_r8 - -! typical air density at 850 mb - - rhosu = 85000._r8/(rair * tmelt) - -! mass of new crystal due to aerosol freezing and growth (kg) - - mi0 = 4._r8/3._r8*pi*rhoi*(10.e-6_r8)*(10.e-6_r8)*(10.e-6_r8) - -! radius of contact nuclei aerosol (m) - - rin = 0.1e-6_r8 - -end subroutine zm_mphyi - -!=============================================================================== - -subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, qe, & - eps0, jb, jt, jlcl, msg, il2g, grav, cp, rd, aero, gamhat, & - qc, qi, nc, ni, qcde, qide, ncde, nide, rprd, sprd, frz, & - wu, qr, qni, nr, ns, autolm, accrlm, bergnm, fhtimm, fhtctm, & - fhmlm, hmpim, accslm, dlfm, autoln, accrln, bergnn, fhtimn, fhtctn, & - fhmln, accsln, activn, dlfn, autoim, accsim, difm, nuclin, autoin, & - accsin, hmpin, difn, trspcm, trspcn, trspim, trspin, lamc, pgam ) - - -! Purpose: -! microphysic parameterization for Zhang-McFarlane convection scheme -! called from cldprp() in zm_conv.F90 -! -! Author: Xialiang Song, June 2010 - - use time_manager, only: get_step_size - -! variable declarations - - implicit none - -! input variables - real(r8), intent(in) :: su(pcols,pver) ! normalized dry stat energy of updraft - real(r8), intent(in) :: qu(pcols,pver) ! spec hum of updraft - real(r8), intent(in) :: mu(pcols,pver) ! updraft mass flux - real(r8), intent(in) :: du(pcols,pver) ! detrainement rate of updraft - real(r8), intent(in) :: eu(pcols,pver) ! entrainment rate of updraft - real(r8), intent(in) :: cmel(pcols,pver) ! condensation rate of updraft - real(r8), intent(in) :: cmei(pcols,pver) ! condensation rate of updraft - real(r8), intent(in) :: zf(pcols,pverp) ! height of interfaces - real(r8), intent(in) :: pm(pcols,pver) ! pressure of env - real(r8), intent(in) :: te(pcols,pver) ! temp of env - real(r8), intent(in) :: qe(pcols,pver) ! spec. humidity of env - real(r8), intent(in) :: eps0(pcols) - real(r8), intent(in) :: gamhat(pcols,pver) ! gamma=L/cp(dq*/dT) at interface - - integer, intent(in) :: jb(pcols) ! updraft base level - integer, intent(in) :: jt(pcols) ! updraft plume top - integer, intent(in) :: jlcl(pcols) ! updraft lifting cond level - integer, intent(in) :: msg ! missing moisture vals - integer, intent(in) :: il2g ! number of columns in gathered arrays - - type(zm_aero_t), intent(in) :: aero ! aerosol object - - real(r8) grav ! gravity - real(r8) cp ! heat capacity of dry air - real(r8) rd ! gas constant for dry air - -! output variables - real(r8), intent(out) :: qc(pcols,pver) ! cloud water mixing ratio (kg/kg) - real(r8), intent(out) :: qi(pcols,pver) ! cloud ice mixing ratio (kg/kg) - real(r8), intent(out) :: nc(pcols,pver) ! cloud water number conc (1/kg) - real(r8), intent(out) :: ni(pcols,pver) ! cloud ice number conc (1/kg) - real(r8), intent(out) :: qcde(pcols,pver) ! cloud water mixing ratio for detrainment(kg/kg) - real(r8), intent(out) :: qide(pcols,pver) ! cloud ice mixing ratio for detrainment (kg/kg) - real(r8), intent(out) :: ncde(pcols,pver) ! cloud water number conc for detrainment (1/kg) - real(r8), intent(out) :: nide(pcols,pver) ! cloud ice number conc for detrainment (1/kg) - real(r8), intent(out) :: wu(pcols,pver) - real(r8), intent(out) :: qni(pcols,pver) ! snow mixing ratio - real(r8), intent(out) :: qr(pcols,pver) ! rain mixing ratio - real(r8), intent(out) :: ns(pcols,pver) ! snow number conc - real(r8), intent(out) :: nr(pcols,pver) ! rain number conc - real(r8), intent(out) :: rprd(pcols,pver) ! rate of production of precip at that layer - real(r8), intent(out) :: sprd(pcols,pver) ! rate of production of snow at that layer - real(r8), intent(out) :: frz(pcols,pver) ! rate of freezing - - - real(r8), intent(inout) :: lamc(pcols,pver) ! slope of cloud liquid size distr - real(r8), intent(inout) :: pgam(pcols,pver) ! spectral width parameter of droplet size distr - -! tendency for output - real(r8),intent(out) :: autolm(pcols,pver) !mass tendency due to autoconversion of droplets to rain - real(r8),intent(out) :: accrlm(pcols,pver) !mass tendency due to accretion of droplets by rain - real(r8),intent(out) :: bergnm(pcols,pver) !mass tendency due to Bergeron process - real(r8),intent(out) :: fhtimm(pcols,pver) !mass tendency due to immersion freezing - real(r8),intent(out) :: fhtctm(pcols,pver) !mass tendency due to contact freezing - real(r8),intent(out) :: fhmlm (pcols,pver) !mass tendency due to homogeneous freezing - real(r8),intent(out) :: hmpim (pcols,pver) !mass tendency due to HM process - real(r8),intent(out) :: accslm(pcols,pver) !mass tendency due to accretion of droplets by snow - real(r8),intent(out) :: dlfm (pcols,pver) !mass tendency due to detrainment of droplet - real(r8),intent(out) :: trspcm(pcols,pver) !mass tendency of droplets due to convective transport - - real(r8),intent(out) :: autoln(pcols,pver) !num tendency due to autoconversion of droplets to rain - real(r8),intent(out) :: accrln(pcols,pver) !num tendency due to accretion of droplets by rain - real(r8),intent(out) :: bergnn(pcols,pver) !num tendency due to Bergeron process - real(r8),intent(out) :: fhtimn(pcols,pver) !num tendency due to immersion freezing - real(r8),intent(out) :: fhtctn(pcols,pver) !num tendency due to contact freezing - real(r8),intent(out) :: fhmln (pcols,pver) !num tendency due to homogeneous freezing - real(r8),intent(out) :: accsln(pcols,pver) !num tendency due to accretion of droplets by snow - real(r8),intent(out) :: activn(pcols,pver) !num tendency due to droplets activation - real(r8),intent(out) :: dlfn (pcols,pver) !num tendency due to detrainment of droplet - real(r8),intent(out) :: trspcn(pcols,pver) !num tendency of droplets due to convective transport - - real(r8),intent(out) :: autoim(pcols,pver) !mass tendency due to autoconversion of cloud ice to snow - real(r8),intent(out) :: accsim(pcols,pver) !mass tendency due to accretion of cloud ice by snow - real(r8),intent(out) :: difm (pcols,pver) !mass tendency due to detrainment of cloud ice - real(r8),intent(out) :: trspim(pcols,pver) !mass tendency of ice crystal due to convective transport - - real(r8),intent(out) :: nuclin(pcols,pver) !num tendency due to ice nucleation - real(r8),intent(out) :: autoin(pcols,pver) !num tendency due to autoconversion of cloud ice to snow - real(r8),intent(out) :: accsin(pcols,pver) !num tendency due to accretion of cloud ice by snow - real(r8),intent(out) :: hmpin (pcols,pver) !num tendency due to HM process - real(r8),intent(out) :: difn (pcols,pver) !num tendency due to detrainment of cloud ice - real(r8),intent(out) :: trspin(pcols,pver) !num tendency of ice crystal due to convective transport - -!................................................................................ -! local workspace -! all units mks unless otherwise stated - real(r8) :: deltat ! time step (s) - real(r8) :: omsm ! number near unity for round-off issues - real(r8) :: dum ! temporary dummy variable - real(r8) :: dum1 ! temporary dummy variable - real(r8) :: dum2 ! temporary dummy variable - - real(r8) :: q(pcols,pver) ! water vapor mixing ratio (kg/kg) - real(r8) :: t(pcols,pver) ! temperature (K) - real(r8) :: rho(pcols,pver) ! air density (kg m-3) - real(r8) :: dz(pcols,pver) ! height difference across model vertical level - - real(r8) :: qcic(pcols,pver) ! in-cloud cloud liquid mixing ratio - real(r8) :: qiic(pcols,pver) ! in-cloud cloud ice mixing ratio - real(r8) :: qniic(pcols,pver) ! in-precip snow mixing ratio - real(r8) :: qric(pcols,pver) ! in-precip rain mixing ratio - real(r8) :: ncic(pcols,pver) ! in-cloud droplet number conc - real(r8) :: niic(pcols,pver) ! in-cloud cloud ice number conc - real(r8) :: nsic(pcols,pver) ! in-precip snow number conc - real(r8) :: nric(pcols,pver) ! in-precip rain number conc - - real(r8) :: lami(pver) ! slope of cloud ice size distr - real(r8) :: n0i(pver) ! intercept of cloud ice size distr - real(r8) :: n0c(pver) ! intercept of cloud liquid size distr - real(r8) :: lams(pver) ! slope of snow size distr - real(r8) :: n0s(pver) ! intercept of snow size distr - real(r8) :: lamr(pver) ! slope of rain size distr - real(r8) :: n0r(pver) ! intercept of rain size distr - real(r8) :: cdist1(pver) ! size distr parameter to calculate droplet freezing - real(r8) :: lammax ! maximum allowed slope of size distr - real(r8) :: lammin ! minimum allowed slope of size distr - - real(r8) :: mnuccc(pver) ! mixing ratio tendency due to freezing of cloud water - real(r8) :: nnuccc(pver) ! number conc tendency due to freezing of cloud water - real(r8) :: mnucct(pver) ! mixing ratio tendency due to contact freezing of cloud water - real(r8) :: nnucct(pver) ! number conc tendency due to contact freezing of cloud water - real(r8) :: msacwi(pver) ! mixing ratio tendency due to HM ice multiplication - real(r8) :: nsacwi(pver) ! number conc tendency due to HM ice multiplication - real(r8) :: prf(pver) ! mixing ratio tendency due to fallout of rain - real(r8) :: psf(pver) ! mixing ratio tendency due to fallout of snow - real(r8) :: pnrf(pver) ! number conc tendency due to fallout of rain - real(r8) :: pnsf(pver) ! number conc tendency due to fallout of snow - real(r8) :: prc(pver) ! mixing ratio tendency due to autoconversion of cloud droplets - real(r8) :: nprc(pver) ! number conc tendency due to autoconversion of cloud droplets - real(r8) :: nprc1(pver) ! qr tendency due to autoconversion of cloud droplets - real(r8) :: nsagg(pver) ! ns tendency due to self-aggregation of snow - real(r8) :: dc0 ! mean size droplet size distr - real(r8) :: ds0 ! mean size snow size distr (area weighted) - real(r8) :: eci ! collection efficiency for riming of snow by droplets - real(r8) :: dv(pcols,pver) ! diffusivity of water vapor in air - real(r8) :: mua(pcols,pver) ! viscocity of air - real(r8) :: psacws(pver) ! mixing rat tendency due to collection of droplets by snow - real(r8) :: npsacws(pver) ! number conc tendency due to collection of droplets by snow - real(r8) :: pracs(pver) ! mixing rat tendency due to collection of rain by snow - real(r8) :: npracs(pver) ! number conc tendency due to collection of rain by snow - real(r8) :: mnuccr(pver) ! mixing rat tendency due to freezing of rain - real(r8) :: nnuccr(pver) ! number conc tendency due to freezing of rain - real(r8) :: pra(pver) ! mixing rat tendnency due to accretion of droplets by rain - real(r8) :: npra(pver) ! nc tendnency due to accretion of droplets by rain - real(r8) :: nragg(pver) ! nr tendency due to self-collection of rain - real(r8) :: prci(pver) ! mixing rat tendency due to autoconversion of cloud ice to snow - real(r8) :: nprci(pver) ! number conc tendency due to autoconversion of cloud ice to snow - real(r8) :: prai(pver) ! mixing rat tendency due to accretion of cloud ice by snow - real(r8) :: nprai(pver) ! number conc tendency due to accretion of cloud ice by snow - real(r8) :: prb(pver) ! rain mixing rat tendency due to Bergeron process - real(r8) :: nprb(pver) ! number conc tendency due to Bergeron process - real(r8) :: fhmrm (pcols,pver) !mass tendency due to homogeneous freezing of rain - -! fall speed - real(r8) :: arn(pcols,pver) ! air density corrected rain fallspeed parameter - real(r8) :: asn(pcols,pver) ! air density corrected snow fallspeed parameter - real(r8) :: acn(pcols,pver) ! air density corrected cloud droplet fallspeed parameter - real(r8) :: ain(pcols,pver) ! air density corrected cloud ice fallspeed parameter - real(r8) :: uns(pver) ! number-weighted snow fallspeed - real(r8) :: ums(pver) ! mass-weighted snow fallspeed - real(r8) :: unr(pver) ! number-weighted rain fallspeed - real(r8) :: umr(pver) ! mass-weighted rain fallspeed - -! conservation check - real(r8) :: qce ! dummy qc for conservation check - real(r8) :: qie ! dummy qi for conservation check - real(r8) :: nce ! dummy nc for conservation check - real(r8) :: nie ! dummy ni for conservation check - real(r8) :: qre ! dummy qr for conservation check - real(r8) :: nre ! dummy nr for conservation check - real(r8) :: qnie ! dummy qni for conservation check - real(r8) :: nse ! dummy ns for conservation check - real(r8) :: ratio ! parameter for conservation check - -! sum of source/sink terms for cloud hydrometeor - real(r8) :: qctend(pcols,pver) ! microphysical tendency qc (1/s) - real(r8) :: qitend(pcols,pver) ! microphysical tendency qi (1/s) - real(r8) :: nctend(pcols,pver) ! microphysical tendency nc (1/(kg*s)) - real(r8) :: nitend(pcols,pver) ! microphysical tendency ni (1/(kg*s)) - real(r8) :: qnitend(pcols,pver) ! snow mixing ratio source/sink term - real(r8) :: nstend(pcols,pver) ! snow number concentration source/sink term - real(r8) :: qrtend(pcols,pver) ! rain mixing ratio source/sink term - real(r8) :: nrtend(pcols,pver) ! rain number concentration source/sink term - -! terms for Bergeron process - real(r8) :: bergtsf !bergeron timescale to remove all liquid - real(r8) :: plevap ! cloud liquid water evaporation rate - -! variables for droplet activation by modal aerosols - real(r8) :: wmix, wmin, wmax, wdiab - real(r8) :: vol, nlsrc - real(r8), allocatable :: vaerosol(:), hygro(:), naermod(:) - real(r8), allocatable :: fn(:) ! number fraction of aerosols activated - real(r8), allocatable :: fm(:) ! mass fraction of aerosols activated - real(r8), allocatable :: fluxn(:) ! flux of activated aerosol number fraction into cloud (cm/s) - real(r8), allocatable :: fluxm(:) ! flux of activated aerosol mass fraction into cloud (cm/s) - real(r8) :: flux_fullact ! flux of activated aerosol fraction assuming 100% activation (cm/s) - real(r8) :: dmc - real(r8) :: ssmc - real(r8) :: dgnum_aitken - -! bulk aerosol variables - real(r8), allocatable :: naer2(:,:,:) ! new aerosol number concentration (/m3) - real(r8), allocatable :: naer2h(:,:,:) ! new aerosol number concentration (/m3) - real(r8), allocatable :: maerosol(:) ! aerosol mass conc (kg/m3) - real(r8) :: so4_num - real(r8) :: soot_num - real(r8) :: dst1_num - real(r8) :: dst2_num - real(r8) :: dst3_num - real(r8) :: dst4_num - real(r8) :: dst_num - -! droplet activation - logical :: in_cloud ! true when above cloud base layer (k > jb) - real(r8) :: smax_f ! droplet and rain size distr factor used in the - ! in-cloud smax calculation - real(r8) :: dum2l(pcols,pver) ! number conc of CCN (1/kg) - real(r8) :: npccn(pver) ! droplet activation rate - real(r8) :: ncmax - real(r8) :: mtimec ! factor to account for droplet activation timescale - -! ice nucleation - real(r8) :: dum2i(pcols,pver) ! number conc of ice nuclei available (1/kg) - real(r8) :: qs(pcols,pver) ! liquid-ice weighted sat mixing rat (kg/kg) - real(r8) :: es(pcols,pver) ! sat vapor press (pa) over water - real(r8) :: relhum(pcols,pver) ! relative humidity - real(r8) :: esi(pcols,pver) ! sat vapor press (pa) over ice - real(r8) :: nnuccd(pver) ! ice nucleation rate from deposition/cond.-freezing - real(r8) :: mnuccd(pver) ! mass tendency from ice nucleation - real(r8) :: mtime ! factor to account for ice nucleation timescale - -! output for ice nucleation - real(r8) :: nimey(pcols,pver) !number conc of ice nuclei due to meyers deposition (1/m3) - real(r8) :: nihf(pcols,pver) !number conc of ice nuclei due to heterogenous freezing (1/m3) - real(r8) :: nidep(pcols,pver) !number conc of ice nuclei due to deoposion nucleation (hetero nuc) (1/m3) - real(r8) :: niimm(pcols,pver) !number conc of ice nuclei due to immersion freezing (hetero nuc) (1/m3) - - real(r8) :: wpice, weff, fhom ! unused dummies - -! loop array variables - integer i,k, n, l - integer ii,kk, m - -! loop variables for iteration solution - integer iter,it,ltrue(pcols) - -! used in contact freezing via dust particles - real(r8) tcnt, viscosity, mfp - real(r8) slip1, slip2, slip3, slip4 - real(r8) dfaer1, dfaer2, dfaer3, dfaer4 - real(r8) nacon1,nacon2,nacon3,nacon4 - -! used in immersion freezing via soot - real(r8) ttend(pver) - real(r8) naimm - real(r8) :: ntaer(pcols,pver) - real(r8) :: ntaerh(pcols,pver) - -! used in homogeneous freezing - real(r8) :: fholm (pcols,pver) !mass tendency due to homogeneous freezing - real(r8) :: fholn (pcols,pver) !number conc tendency due to homogeneous freezing - -! used in secondary ice production - real(r8) ni_secp - -! used in vertical velocity calculation - real(r8) th(pcols,pver) - real(r8) qh(pcols,pver) - real(r8) zkine(pcols,pver) - real(r8) zbuo(pcols,pver) - real(r8) zfacbuo, cwdrag, cwifrac, retv, zbuoc - real(r8) zbc, zbe, zdkbuo, zdken - real(r8) arcf(pcols,pver) - real(r8) p(pcols,pver) - real(r8) ph(pcols,pver) - -! used in vertical integreation - logical qcimp(pver) ! true to solve qc with implicit formula - logical ncimp(pver) ! true to solve nc with implicit formula - logical qiimp(pver) ! true to solve qi with implicit formula - logical niimp(pver) ! true to solve ni with implicit formula - -! tendency due to adjustment - real(r8) :: ncadj(pcols,pver) !droplet num tendency due to adjustment - real(r8) :: niadj(pcols,pver) !ice crystal num tendency due to adjustment - real(r8) :: ncorg, niorg, total - - real(r8) :: rhoh(pcols,pver) ! air density (kg m-3) at interface - real(r8) :: rhom(pcols,pver) ! air density (kg m-3) at mid-level - real(r8) :: tu(pcols,pver) ! temperature in updraft (K) - - integer kqi(pcols),kqc(pcols) - logical lcbase(pcols), libase(pcols) - - real(r8) :: nai_bcphi, nai_dst1, nai_dst2, nai_dst3, nai_dst4 - - real(r8) flxrm, mvtrm, flxrn, mvtrn, flxsm, mvtsm, flxsn, mvtsn - integer nlr, nls - - real(r8) rmean, beta6, beta66, r6, r6c - real(r8) temp1, temp2, temp3, temp4 ! variable to store output which is not required by this routine - -!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -! initialization -!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - - if (aero%scheme == 'modal') then - - allocate(vaerosol(aero%nmodes), hygro(aero%nmodes), naermod(aero%nmodes), & - fn(aero%nmodes), fm(aero%nmodes), fluxn(aero%nmodes), fluxm(aero%nmodes)) - - else if (aero%scheme == 'bulk') then - - allocate( & - naer2(pcols,pver,aero%nbulk), & - naer2h(pcols,pver,aero%nbulk), & - maerosol(aero%nbulk)) - - end if - - deltat= get_step_size() !for FV dynamical core - - ! parameters for scheme - omsm=0.99999_r8 - zfacbuo = 0.5_r8/(1._r8+0.5_r8) - cwdrag = 1.875_r8*0.506_r8 - cwifrac = 0.5_r8 - retv = 0.608_r8 - bergtsf = 1800._r8 - - ! initialize multi-level fields - do i=1,il2g - do k=1,pver - q(i,k) = qu(i,k) - tu(i,k)= su(i,k) - grav/cp*zf(i,k) - t(i,k) = su(i,k) - grav/cp*zf(i,k) - p(i,k) = 100._r8*pm(i,k) - wu(i,k) = 0._r8 - zkine(i,k)= 0._r8 - arcf(i,k) = 0._r8 - zbuo(i,k) = 0._r8 - nc(i,k) = 0._r8 - ni(i,k) = 0._r8 - qc(i,k) = 0._r8 - qi(i,k) = 0._r8 - ncde(i,k) = 0._r8 - nide(i,k) = 0._r8 - qcde(i,k) = 0._r8 - qide(i,k) = 0._r8 - rprd(i,k) = 0._r8 - sprd(i,k) = 0._r8 - frz(i,k) = 0._r8 - qcic(i,k) = 0._r8 - qiic(i,k) = 0._r8 - ncic(i,k) = 0._r8 - niic(i,k) = 0._r8 - qr(i,k) = 0._r8 - qni(i,k) = 0._r8 - nr(i,k) = 0._r8 - ns(i,k) = 0._r8 - qric(i,k) = 0._r8 - qniic(i,k) = 0._r8 - nric(i,k) = 0._r8 - nsic(i,k) = 0._r8 - nimey(i,k) = 0._r8 - nihf(i,k) = 0._r8 - nidep(i,k) = 0._r8 - niimm(i,k) = 0._r8 - fhmrm(i,k) = 0._r8 - - autolm(i,k) = 0._r8 - accrlm(i,k) = 0._r8 - bergnm(i,k) = 0._r8 - fhtimm(i,k) = 0._r8 - fhtctm(i,k) = 0._r8 - fhmlm (i,k) = 0._r8 - fholm (i,k) = 0._r8 - hmpim (i,k) = 0._r8 - accslm(i,k) = 0._r8 - dlfm (i,k) = 0._r8 - - autoln(i,k) = 0._r8 - accrln(i,k) = 0._r8 - bergnn(i,k) = 0._r8 - fhtimn(i,k) = 0._r8 - fhtctn(i,k) = 0._r8 - fhmln (i,k) = 0._r8 - fholn (i,k) = 0._r8 - accsln(i,k) = 0._r8 - activn(i,k) = 0._r8 - dlfn (i,k) = 0._r8 - - autoim(i,k) = 0._r8 - accsim(i,k) = 0._r8 - difm (i,k) = 0._r8 - - nuclin(i,k) = 0._r8 - autoin(i,k) = 0._r8 - accsin(i,k) = 0._r8 - hmpin (i,k) = 0._r8 - difn (i,k) = 0._r8 - - trspcm(i,k) = 0._r8 - trspcn(i,k) = 0._r8 - trspim(i,k) = 0._r8 - trspin(i,k) = 0._r8 - - ncadj (i,k) = 0._r8 - niadj (i,k) = 0._r8 - end do - end do - - ! initialize time-varying parameters - do k=1,pver - do i=1,il2g - if (k .eq.1) then - rhoh(i,k) = p(i,k)/(t(i,k)*rd) - rhom(i,k) = p(i,k)/(t(i,k)*rd) - th (i,k) = te(i,k) - qh (i,k) = qe(i,k) - dz (i,k) = zf(i,k) - zf(i,k+1) - ph(i,k) = p(i,k) - else - rhoh(i,k) = 0.5_r8*(p(i,k)+p(i,k-1))/(t(i,k)*rd) - if (k .eq. pver) then - rhom(i,k) = p(i,k)/(rd*t(i,k)) - else - rhom(i,k) = 2.0_r8*p(i,k)/(rd*(t(i,k)+t(i,k+1))) - end if - th (i,k) = 0.5_r8*(te(i,k)+te(i,k-1)) - qh (i,k) = 0.5_r8*(qe(i,k)+qe(i,k-1)) - dz(i,k) = zf(i,k-1) - zf(i,k) - ph(i,k) = 0.5_r8*(p(i,k) + p(i,k-1)) - end if - dv(i,k) = 8.794E-5_r8*t(i,k)**1.81_r8/ph(i,k) - mua(i,k) = 1.496E-6_r8*t(i,k)**1.5_r8/ & - (t(i,k)+120._r8) - - rho(i,k) = rhoh(i,k) - - ! air density adjustment for fallspeed parameters - ! add air density correction factor to the power of - ! 0.54 following Heymsfield and Bansemer 2006 - - arn(i,k)=ar*(rhosu/rho(i,k))**0.54_r8 - asn(i,k)=as*(rhosu/rho(i,k))**0.54_r8 - acn(i,k)=ac*(rhosu/rho(i,k))**0.54_r8 - ain(i,k)=ai*(rhosu/rho(i,k))**0.54_r8 - - end do - end do - - if (aero%scheme == 'modal') then - - wmix = 0._r8 - wmin = 0._r8 - wmax = 10._r8 - wdiab = 0._r8 - - do k=1,pver - do i=1,il2g - dum2l(i,k)=0._r8 - dum2i(i,k)=0._r8 - ntaer(i,k) = 0.0_r8 - ntaerh(i,k) = 0.0_r8 - do m = 1, aero%nmodes - ntaer(i,k) = ntaer(i,k) + aero%numg_a(i,k,m)*rhom(i,k) - enddo - end do - end do - - else if (aero%scheme == 'bulk') then - - ! initialize aerosol number - do k=1,pver - do i=1,il2g - naer2(i,k,:)=0._r8 - naer2h(i,k,:)=0._r8 - dum2l(i,k)=0._r8 - dum2i(i,k)=0._r8 - end do - end do - - do k=1,pver - do i=1,il2g - ntaer(i,k) = 0.0_r8 - ntaerh(i,k) = 0.0_r8 - do m = 1, aero%nbulk - maerosol(m) = aero%mmrg_bulk(i,k,m)*rhom(i,k) - - ! set number nucleated for sulfate based on Lohmann et al. 2000 (JGR) Eq.2 - ! Na=340.*(massSO4)^0.58 where Na=cm-3 and massSO4=ug/m3 - ! convert units to Na [m-3] and SO4 [kgm-3] - ! Na(m-3)= 1.e6 cm3 m-3 Na(cm-3)=340. *(massSO4[kg/m3]*1.e9ug/kg)^0.58 - ! or Na(m-3)= 1.e6* 340.*(1.e9ug/kg)^0.58 * (massSO4[kg/m3])^0.58 - - if (m .eq. aero%idxsul) then - naer2(i,k,m)= 5.64259e13_r8 * maerosol(m)**0.58_r8 - else - naer2(i,k,m)=maerosol(m)*aero%num_to_mass_aer(m) - end if - ntaer(i,k) = ntaer(i,k) + naer2(i,k,m) - end do - end do - end do - - end if - - do i=1,il2g - ltrue(i)=0 - do k=1,pver - if (qc(i,k).ge.qsmall.or.qi(i,k).ge.qsmall.or.cmel(i,k).ge.qsmall.or.cmei(i,k).ge.qsmall) ltrue(i)=1 - end do - end do - - ! skip microphysical calculations if no cloud water - do i=1,il2g - if (ltrue(i).eq.0) then - do k=1,pver - qctend(i,k)=0._r8 - qitend(i,k)=0._r8 - qnitend(i,k)=0._r8 - qrtend(i,k)=0._r8 - nctend(i,k)=0._r8 - nitend(i,k)=0._r8 - nrtend(i,k)=0._r8 - nstend(i,k)=0._r8 - qniic(i,k)=0._r8 - qric(i,k)=0._r8 - nsic(i,k)=0._r8 - nric(i,k)=0._r8 - qni(i,k)=0._r8 - qr(i,k)=0._r8 - ns(i,k)=0._r8 - nr(i,k)=0._r8 - qc(i,k) = 0._r8 - qi(i,k) = 0._r8 - nc(i,k) = 0._r8 - ni(i,k) = 0._r8 - qcde(i,k) = 0._r8 - qide(i,k) = 0._r8 - ncde(i,k) = 0._r8 - nide(i,k) = 0._r8 - rprd(i,k) = 0._r8 - sprd(i,k) = 0._r8 - frz(i,k) = 0._r8 - end do - goto 300 - end if - - kqc(i) = 1 - kqi(i) = 1 - lcbase(i) = .true. - libase(i) = .true. - - ! assign number of steps for iteration - ! use 2 steps following Song and Zhang, 2011, J. Clim. - iter = 2 - - !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - ! iteration - !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - - do it=1,iter - - ! initialize sub-step microphysical tendencies - do k=1,pver - qctend(i,k)=0._r8 - qitend(i,k)=0._r8 - qnitend(i,k)=0._r8 - qrtend(i,k)=0._r8 - nctend(i,k)=0._r8 - nitend(i,k)=0._r8 - nrtend(i,k)=0._r8 - nstend(i,k)=0._r8 - rprd(i,k) = 0._r8 - sprd(i,k) = 0._r8 - frz(i,k) = 0._r8 - qniic(i,k)=0._r8 - qric(i,k)=0._r8 - nsic(i,k)=0._r8 - nric(i,k)=0._r8 - qiic(i,k)=0._r8 - qcic(i,k)=0._r8 - niic(i,k)=0._r8 - ncic(i,k)=0._r8 - qcimp(k) = .false. - ncimp(k) = .false. - qiimp(k) = .false. - niimp(k) = .false. - dum2l(i,k)=0._r8 - dum2i(i,k)=0._r8 - autolm(i,k) = 0._r8 - accrlm(i,k) = 0._r8 - bergnm(i,k) = 0._r8 - fhtimm(i,k) = 0._r8 - fhtctm(i,k) = 0._r8 - fhmlm (i,k) = 0._r8 - fholm (i,k) = 0._r8 - hmpim (i,k) = 0._r8 - accslm(i,k) = 0._r8 - dlfm (i,k) = 0._r8 - - autoln(i,k) = 0._r8 - accrln(i,k) = 0._r8 - bergnn(i,k) = 0._r8 - fhtimn(i,k) = 0._r8 - fhtctn(i,k) = 0._r8 - fhmln (i,k) = 0._r8 - fholn (i,k) = 0._r8 - accsln(i,k) = 0._r8 - activn(i,k) = 0._r8 - dlfn (i,k) = 0._r8 - ncadj (i,k) = 0._r8 - - autoim(i,k) = 0._r8 - accsim(i,k) = 0._r8 - difm (i,k) = 0._r8 - - nuclin(i,k) = 0._r8 - autoin(i,k) = 0._r8 - accsin(i,k) = 0._r8 - hmpin (i,k) = 0._r8 - difn (i,k) = 0._r8 - niadj (i,k) = 0._r8 - - trspcm(i,k) = 0._r8 - trspcn(i,k) = 0._r8 - trspim(i,k) = 0._r8 - trspin(i,k) = 0._r8 - - fhmrm (i,k) = 0._r8 - end do - - do k = pver,msg+2,-1 - - if (k > jt(i) .and. k <= jb(i) .and. eps0(i) > 0._r8 & - .and.mu(i,k).gt.0._r8 .and. mu(i,k-1).gt.0._r8) then - - ! initialize precip fallspeeds to zero - if (it.eq.1) then - ums(k)=0._r8 - uns(k)=0._r8 - umr(k)=0._r8 - unr(k)=0._r8 - prf(k)=0._r8 - pnrf(k)=0._r8 - psf(k) =0._r8 - pnsf(k) = 0._r8 - end if - ttend(k)=0._r8 - nnuccd(k)=0._r8 - npccn(k)=0._r8 - - !************************************************************************************ - ! obtain values of cloud water/ice mixing ratios and number concentrations in updraft - ! for microphysical process calculations - ! units are kg/kg for mixing ratio, 1/kg for number conc - !************************************************************************************ - - - if (it.eq.1) then - qcic(i,k) = qc(i,k) - qiic(i,k) = qi(i,k) - ncic(i,k) = nc(i,k) - niic(i,k) = ni(i,k) - qniic(i,k)= qni(i,k) - qric(i,k) = qr(i,k) - nsic(i,k) = ns(i,k) - nric(i,k) = nr(i,k) - else - if (k.le.kqc(i)) then - qcic(i,k) = qc(i,k) - ncic(i,k) = nc(i,k) - - ! consider rain falling from above - flxrm = 0._r8 - mvtrm = 0._r8 - flxrn = 0._r8 - mvtrn = 0._r8 - nlr = 0 - - do kk= k,jt(i)+3,-1 - if (qr(i,kk-1) .gt. 0._r8) then - nlr = nlr + 1 - flxrm = flxrm + umr(kk-1)*qr(i,kk-1)*arcf(i,kk-1) - flxrn = flxrn + unr(kk-1)*nr(i,kk-1)*arcf(i,kk-1) - mvtrm = mvtrm + umr(kk-1)*arcf(i,kk-1) - mvtrn = mvtrn + unr(kk-1)*arcf(i,kk-1) - end if - end do - if (mvtrm.gt.0) then - qric(i,k) = (qr(i,k)*mu(i,k)+flxrm)/(mu(i,k)+mvtrm) - else - qric(i,k) = qr(i,k) - end if - if (mvtrn.gt.0) then - nric(i,k) = (nr(i,k)*mu(i,k)+flxrn)/(mu(i,k)+mvtrn) - else - nric(i,k) = nr(i,k) - end if - - end if - if (k.eq.kqc(i)) then - qcic(i,k) = qc(i,k-1) - ncic(i,k) = nc(i,k-1) - end if - if(k.le.kqi(i)) then - qiic(i,k) = qi(i,k) - niic(i,k) = ni(i,k) -! consider snow falling from above - flxsm = 0._r8 - mvtsm = 0._r8 - flxsn = 0._r8 - mvtsn = 0._r8 - nls = 0 - - do kk= k,jt(i)+3,-1 - if (qni(i,kk-1) .gt. 0._r8) then - nls = nls + 1 - flxsm = flxsm + ums(kk-1)*qni(i,kk-1)*arcf(i,kk-1) - mvtsm = mvtsm + ums(kk-1)*arcf(i,kk-1) - flxsn = flxsn + uns(kk-1)*ns(i,kk-1)*arcf(i,kk-1) - mvtsn = mvtsn + uns(kk-1)*arcf(i,kk-1) - end if - end do - - if (mvtsm.gt.0) then - qniic(i,k) = (qni(i,k)*mu(i,k)+flxsm)/(mu(i,k)+mvtsm) - else - qniic(i,k) = qni(i,k) - end if - if (mvtsn.gt.0) then - nsic(i,k) = (ns(i,k)*mu(i,k)+flxsn)/(mu(i,k)+mvtsn) - else - nsic(i,k) = ns(i,k) - end if - end if - if(k.eq.kqi(i)) then - qiic(i,k) = qi(i,k-1) - niic(i,k) = ni(i,k-1) - end if - end if - - !********************************************************************** - ! boundary condition for cloud liquid water and cloud ice - !*********************************************************************** - - ! boundary condition for provisional cloud water - if (cmel(i,k-1).gt.qsmall .and. lcbase(i) .and. it.eq.1 ) then - kqc(i) = k - lcbase(i) = .false. - qcic(i,k) = dz(i,k)*cmel(i,k-1)/(mu(i,k-1)+dz(i,k)*du(i,k-1)) - ncic(i,k) = qcic(i,k)/(4._r8/3._r8*pi*10.e-6_r8**3*rhow) - end if - - ! boundary condition for provisional cloud ice - if (qiic(i,k).gt.qsmall .and. libase(i) .and. it.eq.1 ) then - kqi(i) = k - libase(i) = .false. - else if ( cmei(i,k-1).gt.qsmall .and. & - cmei(i,k).lt.qsmall .and. k.le.jb(i) .and. libase(i) .and. it.eq.1 ) then - kqi(i)=k - libase(i) = .false. - qiic(i,k) = dz(i,k)*cmei(i,k-1)/(mu(i,k-1)+dz(i,k)*du(i,k-1)) - niic(i,k) = qiic(i,k)/(4._r8/3._r8*pi*25.e-6_r8**3*rhoi) - end if - - !*************************************************************************** - ! get size distribution parameters based on in-cloud cloud water/ice - ! these calculations also ensure consistency between number and mixing ratio - !*************************************************************************** - ! cloud ice - if (qiic(i,k).ge.qsmall) then - - ! add upper limit to in-cloud number concentration to prevent numerical error - niic(i,k)=min(niic(i,k),qiic(i,k)*1.e20_r8) - lami(k) = (gamma(1._r8+di)*ci* & - niic(i,k)/qiic(i,k))**(1._r8/di) - n0i(k) = niic(i,k)*lami(k) - - ! check for slope - lammax = 1._r8/10.e-6_r8 - lammin = 1._r8/(2._r8*dcs) - - ! adjust vars - if (lami(k).lt.lammin) then - lami(k) = lammin - n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*gamma(1._r8+di)) - niic(i,k) = n0i(k)/lami(k) - else if (lami(k).gt.lammax) then - lami(k) = lammax - n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*gamma(1._r8+di)) - niic(i,k) = n0i(k)/lami(k) - end if - else - lami(k) = 0._r8 - n0i(k) = 0._r8 - end if - - ! cloud water - if (qcic(i,k).ge.qsmall) then - - ! add upper limit to in-cloud number concentration to prevent numerical error - ncic(i,k)=min(ncic(i,k),qcic(i,k)*1.e20_r8) - - ! get pgam from fit to observations of martin et al. 1994 - - pgam(i,k)=0.0005714_r8*(ncic(i,k)/1.e6_r8/rho(i,k))+0.2714_r8 - pgam(i,k)=1._r8/(pgam(i,k)**2)-1._r8 - pgam(i,k)=max(pgam(i,k),2._r8) - pgam(i,k)=min(pgam(i,k),15._r8) - - ! calculate lamc - lamc(i,k) = (pi/6._r8*rhow*ncic(i,k)*gamma(pgam(i,k)+4._r8)/ & - (qcic(i,k)*gamma(pgam(i,k)+1._r8)))**(1._r8/3._r8) - - ! lammin, 50 micron diameter max mean size - lammin = (pgam(i,k)+1._r8)/40.e-6_r8 - lammax = (pgam(i,k)+1._r8)/1.e-6_r8 - - if (lamc(i,k).lt.lammin) then - lamc(i,k) = lammin - ncic(i,k) = 6._r8*lamc(i,k)**3*qcic(i,k)* & - gamma(pgam(i,k)+1._r8)/ & - (pi*rhow*gamma(pgam(i,k)+4._r8)) - else if (lamc(i,k).gt.lammax) then - lamc(i,k) = lammax - ncic(i,k) = 6._r8*lamc(i,k)**3*qcic(i,k)* & - gamma(pgam(i,k)+1._r8)/ & - (pi*rhow*gamma(pgam(i,k)+4._r8)) - end if - - ! parameter to calculate droplet freezing - - cdist1(k) = ncic(i,k)/gamma(pgam(i,k)+1._r8) - else - lamc(i,k) = 0._r8 - cdist1(k) = 0._r8 - end if - - ! boundary condition for cloud liquid water - if ( kqc(i) .eq. k ) then - qc(i,k) = 0._r8 - nc(i,k) = 0._r8 - end if - - ! boundary condition for cloud ice - if (kqi(i).eq.k ) then - qi(i,k) = 0._r8 - ni(i,k) = 0._r8 - end if - - !************************************************************************** - ! begin micropysical process calculations - !************************************************************************** - - !................................................................. - ! autoconversion of cloud liquid water to rain - ! formula from Khrouditnov and Kogan (2000) - ! minimum qc of 1 x 10^-8 prevents floating point error - - if (qcic(i,k).ge.1.e-8_r8) then - - ! nprc is increase in rain number conc due to autoconversion - ! nprc1 is decrease in cloud droplet conc due to autoconversion - ! Khrouditnov and Kogan (2000) -! prc(k) = 1350._r8*qcic(i,k)**2.47_r8* & -! (ncic(i,k)/1.e6_r8*rho(i,k))**(-1.79_r8) - - ! Liu and Daum(2004)(modified), Wood(2005) - rmean = 1.e6_r8*((qcic(i,k)/ncic(i,k))/(4._r8/3._r8*pi*rhow))**(1._r8/3._r8) - - if (rmean .ge. 15._r8) then - - beta6 = (1._r8+3._r8/rmean)**(1._r8/3._r8) - beta66 = (1._r8+3._r8/rmean)**2._r8 - r6 = beta6*rmean - r6c = 7.5_r8/(r6**0.5_r8*(qcic(i,k)*rho(i,k))**(1._r8/6._r8)) - prc(k) = 1.3e9_r8*beta66*(qcic(i,k)*rho(i,k))**3._r8/ & - (ncic(i,k)*rho(i,k))*max(0._r8,r6-r6c)/rho(i,k) - - nprc1(k) = prc(k)/(qcic(i,k)/ncic(i,k)) - nprc(k) = nprc1(k)*0.5_r8 - else - prc(k)=0._r8 - nprc(k)=0._r8 - nprc1(k)=0._r8 - end if - else - prc(k)=0._r8 - nprc(k)=0._r8 - nprc1(k)=0._r8 - end if - - ! provisional rain mixing ratio and number concentration (qric and nric) - ! at boundary are estimated via autoconversion - - if (k.eq.kqc(i) .and. it.eq.1) then - qric(i,k) = prc(k)*dz(i,k)/0.55_r8 - nric(i,k) = nprc(k)*dz(i,k)/0.55_r8 - qr(i,k) = 0.0_r8 - nr(i,k) = 0.0_r8 - end if - - !....................................................................... - ! Autoconversion of cloud ice to snow - ! similar to Ferrier (1994) - - call ice_autoconversion(t(i,k), qiic(i,k), lami(k), n0i(k), dcs, prci(k), nprci(k), 1) - - ! provisional snow mixing ratio and number concentration (qniic and nsic) - ! at boundary are estimated via autoconversion - - if (k.eq.kqi(i) .and. it.eq.1) then - qniic(i,k)= prci(k)*dz(i,k)*0.25_r8 - nsic(i,k)= nprci(k)*dz(i,k)*0.25_r8 - qni(i,k)= 0.0_r8 - ns(i,k)= 0.0_r8 - end if - - ! if precip mix ratio is zero so should number concentration - if (qniic(i,k).lt.qsmall) then - qniic(i,k)=0._r8 - nsic(i,k)=0._r8 - end if - if (qric(i,k).lt.qsmall) then - qric(i,k)=0._r8 - nric(i,k)=0._r8 - end if - - ! make sure number concentration is a positive number to avoid - ! taking root of negative later - nric(i,k)=max(nric(i,k),0._r8) - nsic(i,k)=max(nsic(i,k),0._r8) - - !********************************************************************** - ! get size distribution parameters for precip - !********************************************************************** - ! rain - - if (qric(i,k).ge.qsmall) then - lamr(k) = (pi*rhow*nric(i,k)/qric(i,k))**(1._r8/3._r8) - n0r(k) = nric(i,k)*lamr(k) - - ! check for slope - lammax = 1._r8/150.e-6_r8 - lammin = 1._r8/3000.e-6_r8 - - ! adjust vars - if (lamr(k).lt.lammin) then - lamr(k) = lammin - n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow) - nric(i,k) = n0r(k)/lamr(k) - else if (lamr(k).gt.lammax) then - lamr(k) = lammax - n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow) - nric(i,k) = n0r(k)/lamr(k) - end if - - ! provisional rain number and mass weighted mean fallspeed (m/s) - ! Eq.18 of Morrison and Gettelman, 2008, J. Climate - unr(k) = min(arn(i,k)*gamma(1._r8+br)/lamr(k)**br,10._r8) - umr(k) = min(arn(i,k)*gamma(4._r8+br)/(6._r8*lamr(k)**br),10._r8) - else - lamr(k) = 0._r8 - n0r(k) = 0._r8 - umr(k) = 0._r8 - unr(k) = 0._r8 - end if - - !...................................................................... - ! snow - if (qniic(i,k).ge.qsmall) then - lams(k) = (gamma(1._r8+ds)*cs*nsic(i,k)/ & - qniic(i,k))**(1._r8/ds) - n0s(k) = nsic(i,k)*lams(k) - - ! check for slope - lammax = 1._r8/10.e-6_r8 - lammin = 1._r8/2000.e-6_r8 - - ! adjust vars - if (lams(k).lt.lammin) then - lams(k) = lammin - n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*gamma(1._r8+ds)) - nsic(i,k) = n0s(k)/lams(k) - else if (lams(k).gt.lammax) then - lams(k) = lammax - n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*gamma(1._r8+ds)) - nsic(i,k) = n0s(k)/lams(k) - end if - - ! provisional snow number and mass weighted mean fallspeed (m/s) - ums(k) = min(asn(i,k)*gamma(4._r8+bs)/(6._r8*lams(k)**bs),3.6_r8) - uns(k) = min(asn(i,k)*gamma(1._r8+bs)/lams(k)**bs,3.6_r8) - else - lams(k) = 0._r8 - n0s(k) = 0._r8 - ums(k) = 0._r8 - uns(k) = 0._r8 - end if - - !....................................................................... - ! snow self-aggregation from passarelli, 1978, used by Reisner(1998,Eq.A.35) - ! this is hard-wired for bs = 0.4 for now - ! ignore self-collection of cloud ice - - call snow_self_aggregation(t(i,k), rho(i,k), asn(i,k), rhosn, qniic(i,k), nsic(i,k), nsagg(k), 1) - - !....................................................................... - ! accretion of cloud droplets onto snow/graupel - ! here use continuous collection equation with - ! simple gravitational collection kernel - ! ignore collisions between droplets/cloud ice - - ! ignore collision of snow with droplets above freezing - - call accrete_cloud_water_snow(t(i,k), rho(i,k), asn(i,k), uns(k), mua(i,k), & - qcic(i,k), ncic(i,k), qniic(i,k), pgam(i,k), lamc(i,k), lams(k), n0s(k), & - psacws(k), npsacws(k), 1) - - ! secondary ice production due to accretion of droplets by snow - ! (Hallet-Mossop process) (from Cotton et al., 1986) - - call secondary_ice_production(t(i,k), psacws(k), msacwi(k), nsacwi(k), 1) - - !....................................................................... - ! accretion of rain water by snow - ! formula from ikawa and saito, 1991, used by reisner et al., 1998 - - call accrete_rain_snow(t(i,k), rho(i,k), umr(k), ums(k), unr(k), uns(k), qric(i,k), & - qniic(i,k), lamr(k), n0r(k), lams(k), n0s(k), pracs(k), npracs(k), 1 ) - - !....................................................................... - ! heterogeneous freezing of rain drops - ! follows from Bigg (1953) - - call heterogeneous_rain_freezing(t(i,k), qric(i,k), nric(i,k), lamr(k), mnuccr(k), nnuccr(k), 1) - - !....................................................................... - ! accretion of cloud liquid water by rain - ! formula from Khrouditnov and Kogan (2000) - ! gravitational collection kernel, droplet fall speed neglected - - call accrete_cloud_water_rain(.true., qric(i,k), qcic(i,k), ncic(i,k), [1._r8], [0._r8], pra(k), npra(k), 1) - - !....................................................................... - ! Self-collection of rain drops - ! from Beheng(1994) - - call self_collection_rain(rho(i,k), qric(i,k), nric(i,k), nragg(k), 1) - - !....................................................................... - ! Accretion of cloud ice by snow - ! For this calculation, it is assumed that the Vs >> Vi - ! and Ds >> Di for continuous collection - - call accrete_cloud_ice_snow(t(i,k), rho(i,k), asn(i,k), qiic(i,k), niic(i,k), & - qniic(i,k), lams(k), n0s(k), prai(k), nprai(k), 1) - - !....................................................................... - ! fallout term - prf(k) = -umr(k)*qric(i,k)/dz(i,k) - pnrf(k) = -unr(k)*nric(i,k)/dz(i,k) - psf(k) = -ums(k)*qniic(i,k)/dz(i,k) - pnsf(k) = -uns(k)*nsic(i,k)/dz(i,k) - - !........................................................................ - ! calculate vertical velocity in cumulus updraft - - if (k.eq.jb(i)) then - zkine(i,jb(i)) = 0.5_r8 - wu (i,jb(i)) = 1._r8 - zbuo (i,jb(i)) = (tu(i,jb(i))*(1._r8+retv*qu(i,jb(i)))- & - th(i,jb(i))*(1._r8+retv*qh(i,jb(i))))/ & - (th(i,jb(i))*(1._r8+retv*qh(i,jb(i)))) - else - if (.true.) then - ! ECMWF formula - zbc = tu(i,k)*(1._r8+retv*qu(i,k)-qr(i,k)-qni(i,k)-qi(i,k)-qc(i,k)) - zbe = th(i,k)*(1._r8+retv*qh(i,k)) - zbuo(i,k) = (zbc-zbe)/zbe - zbuoc= (zbuo(i,k)+zbuo(i,k+1))*0.5_r8 - zdkbuo = dz(i,k+1)*grav*zfacbuo*zbuoc - zdken = min(.99_r8,(1._r8+cwdrag)*max(du(i,k),eu(i,k))*dz(i,k+1)/ & - max(1.e-10_r8,mu(i,k+1))) - zkine(i,k) = (zkine(i,k+1)*(1._r8-zdken)+zdkbuo)/ & - (1._r8+zdken) - else - ! Gregory formula - zbc = tu(i,k)*(1._r8+retv*qu(i,k)) - zbe = th(i,k)*(1._r8+retv*qh(i,k)) - zbuo(i,k) = (zbc-zbe)/zbe-qr(i,k)-qni(i,k)-qi(i,k)-qc(i,k) - zbuoc= (zbuo(i,k)+zbuo(i,k+1))*0.5_r8 - zdkbuo = dz(i,k+1)*grav*zbuoc*(1.0_r8-0.25_r8)/6._r8 - zdken = du(i,k)*dz(i,k+1)/max(1.e-10_r8,mu(i,k+1)) - zkine(i,k) = (zkine(i,k+1)*(1._r8-zdken)+zdkbuo)/ & - (1._r8+zdken) - end if - wu(i,k) = min(15._r8,sqrt(2._r8*max(0.1_r8,zkine(i,k) ))) - end if - - arcf(i,k)= mu(i,k)/wu(i,k) - - !............................................................................ - ! droplet activation - ! calculate potential for droplet activation if cloud water is present - ! formulation from Abdul-Razzak and Ghan (2000) and Abdul-Razzak et al. (1998), AR98 - - if (aero%scheme == 'bulk') then - naer2h(i,k,:) = 0.5_r8*(naer2(i,k,:) + naer2(i,k-1,:)) - end if - - ntaerh(i,k) = 0.5_r8*(ntaer(i,k) + ntaer(i,k-1)) - - if (qcic(i,k).ge.qsmall ) then - - if (aero%scheme == 'modal') then - - nlsrc = 0._r8 - - do m = 1, aero%nmodes - vaerosol(m) = 0._r8 - hygro(m) = 0._r8 - do l = 1, aero%nspec(m) - vol = max(0.5_r8*(aero%mmrg_a(i,k,l,m)+aero%mmrg_a(i,k-1,l,m)) , 0._r8)/aero%specdens(l,m) - vaerosol(m) = vaerosol(m) + vol - hygro(m) = hygro(m) + vol*aero%spechygro(l,m) - end do - if (vaerosol(m) > 1.0e-30_r8) then - hygro(m) = hygro(m)/(vaerosol(m)) - vaerosol(m) = vaerosol(m)*rho(i,k) - else - hygro(m) = 0.0_r8 - vaerosol(m) = 0.0_r8 - endif - naermod(m) = 0.5_r8*(aero%numg_a(i,k,m)+aero%numg_a(i,k-1,m))*rho(i,k) - naermod(m) = max(naermod(m), vaerosol(m)*aero%voltonumbhi(m)) - naermod(m) = min(naermod(m), vaerosol(m)*aero%voltonumblo(m)) - end do - - in_cloud = (k < jb(i)) - smax_f = 0.0_r8 - if (in_cloud) then - if ( qcic(i,k).ge.qsmall ) & - smax_f = ncic(i,k)/lamc(i,k) * gamma(2.0_r8 + pgam(i,k))/gamma(1.0_r8 + pgam(i,k)) - if ( qric(i,k).ge.qsmall) smax_f = smax_f + nric(i,k)/lamr(k) - - end if - - call activate_modal( & - wu(i,k), wmix, wdiab, wmin, wmax, & - t(i,k), rho(i,k), naermod, aero%nmodes, vaerosol, & - hygro, fn, fm, & - fluxn, fluxm, flux_fullact, in_cloud_in=in_cloud, smax_f=smax_f) - - do m = 1, aero%nmodes - nlsrc = nlsrc + fn(m)*naermod(m) ! number nucleated - end do - - if (nlsrc .ne. nlsrc) then - write(iulog,*) "nlsrc=",nlsrc,"wu(i,k)=",wu(i,k) - write(iulog,*) "fn(m)=",fn,"naermod(m)=",naermod,"aero%specdens(l,m)=",aero%specdens - write(iulog,*) "vaerosol(m)=",vaerosol,"aero%voltonumbhi(m)=",aero%voltonumbhi - write(iulog,*) "aero%voltonumblo(m)=",aero%voltonumblo,"k=",k,"i=",i - write(iulog,*) "aero%numg_a(i,k,m)=",aero%numg_a(i,k,:),"rho(i,k)=",rho(i,k) - write(iulog,*) "aero%mmrg_a(i,k,l,m)=",aero%mmrg_a(i,k,:,:) - end if - - dum2l(i,k) = nlsrc - - else if (aero%scheme == 'bulk') then - - call ndrop_bam_run( & - wu(i,k), t(i,k), rho(i,k), naer2h(i,k,:), aero%nbulk, & - aero%nbulk, maerosol, dum2) - - dum2l(i,k) = dum2 - - end if - - else - dum2l(i,k) = 0._r8 - end if - - ! get droplet activation rate - if (qcic(i,k).ge.qsmall .and. t(i,k).gt.238.15_r8 .and. k.gt.jt(i)+2 ) then - - ! assume aerosols already activated are equal number of existing droplets for simplicity - if (k.eq.kqc(i)) then - npccn(k) = dum2l(i,k)/deltat - else - npccn(k) = (dum2l(i,k)-ncic(i,k))/deltat - end if - - ! make sure number activated > 0 - npccn(k) = max(0._r8,npccn(k)) - ncmax = dum2l(i,k) - else - npccn(k)=0._r8 - ncmax = 0._r8 - end if - - !.............................................................................. - !ice nucleation - es(i,k) = svp_water(t(i,k)) ! over water in mixed clouds - esi(i,k) = svp_ice(t(i,k)) ! over ice - qs(i,k) = 0.622_r8*es(i,k)/(ph(i,k) - (1.0_r8-0.622_r8)*es(i,k)) - qs(i,k) = min(1.0_r8,qs(i,k)) - if (qs(i,k) < 0.0_r8) qs(i,k) = 1.0_r8 - - relhum(i,k)= 1.0_r8 - - if (t(i,k).lt.tmelt ) then - - ! compute aerosol number for so4, soot, and dust with units #/cm^3 - so4_num = 0._r8 - soot_num = 0._r8 - dst1_num = 0._r8 - dst2_num = 0._r8 - dst3_num = 0._r8 - dst4_num = 0._r8 - - if (aero%scheme == 'modal') then - - !For modal aerosols, assume for the upper troposphere: - ! soot = accumulation mode - ! sulfate = aiken mode - ! dust = coarse mode - ! since modal has internal mixtures. - soot_num = 0.5_r8*(aero%numg_a(i,k-1,aero%mode_accum_idx) & - +aero%numg_a(i,k,aero%mode_accum_idx))*rho(i,k)*1.0e-6_r8 - dmc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_dust_idx,aero%mode_coarse_idx) & - +aero%mmrg_a(i,k,aero%coarse_dust_idx,aero%mode_coarse_idx)) - ssmc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_nacl_idx,aero%mode_coarse_idx) & - +aero%mmrg_a(i,k,aero%coarse_nacl_idx,aero%mode_coarse_idx)) - if (dmc > 0._r8) then - dst_num = dmc/(ssmc + dmc) *(aero%numg_a(i,k-1,aero%mode_coarse_idx) & - + aero%numg_a(i,k,aero%mode_coarse_idx))*0.5_r8*rho(i,k)*1.0e-6_r8 - else - dst_num = 0.0_r8 - end if - dgnum_aitken = 0.5_r8*(aero%dgnumg(i,k,aero%mode_aitken_idx)+ & - aero%dgnumg(i,k-1,aero%mode_aitken_idx)) - if (dgnum_aitken > 0._r8) then - ! only allow so4 with D>0.1 um in ice nucleation - so4_num = 0.5_r8*(aero%numg_a(i,k-1,aero%mode_aitken_idx)+ & - aero%numg_a(i,k,aero%mode_aitken_idx))*rho(i,k)*1.0e-6_r8 & - * (0.5_r8 - 0.5_r8*erf(log(0.1e-6_r8/dgnum_aitken)/ & - (2._r8**0.5_r8*log(aero%sigmag_aitken)))) - else - so4_num = 0.0_r8 - end if - so4_num = max(0.0_r8, so4_num) - - else if (aero%scheme == 'bulk') then - - if (aero%idxsul > 0) then - so4_num = naer2h(i,k,aero%idxsul)/25._r8 *1.0e-6_r8 - end if - if (aero%idxbcphi > 0) then - soot_num = naer2h(i,k,aero%idxbcphi)/25._r8 *1.0e-6_r8 - end if - if (aero%idxdst1 > 0) then - dst1_num = naer2h(i,k,aero%idxdst1)/25._r8 *1.0e-6_r8 - end if - if (aero%idxdst2 > 0) then - dst2_num = naer2h(i,k,aero%idxdst2)/25._r8 *1.0e-6_r8 - end if - if (aero%idxdst3 > 0) then - dst3_num = naer2h(i,k,aero%idxdst3)/25._r8 *1.0e-6_r8 - end if - if (aero%idxdst4 > 0) then - dst4_num = naer2h(i,k,aero%idxdst4)/25._r8 *1.0e-6_r8 - end if - dst_num = dst1_num + dst2_num + dst3_num + dst4_num - - end if - - ! *** Turn off soot nucleation *** - soot_num = 0.0_r8 - - ! Liu et al.,J. climate, 2007 - if ( wu(i,k) .lt. 4.0_r8) then - call nucleati( & - wu(i,k), t(i,k), ph(i,k), relhum(i,k), 1.0_r8, qcic(i,k), & - 1.0e-20_r8, 0.0_r8, rho(i,k), so4_num, dst_num, soot_num, 1.0_r8, & - dum2i(i,k), nihf(i,k), niimm(i,k), nidep(i,k), nimey(i,k), & - wpice, weff, fhom, temp1, temp2, temp3, temp4, .true. ) - end if - nihf(i,k)=nihf(i,k)*rho(i,k) ! convert from #/kg -> #/m3) - niimm(i,k)=niimm(i,k)*rho(i,k) - nidep(i,k)=nidep(i,k)*rho(i,k) - nimey(i,k)=nimey(i,k)*rho(i,k) - - if (.false.) then - ! cooper curve (factor of 1000 is to convert from L-1 to m-3) - !dum2i(i,k)=0.005_r8*exp(0.304_r8*(273.15_r8-t(i,k)))*1000._r8 - - ! put limit on number of nucleated crystals, set to number at T=-30 C - ! cooper (limit to value at -35 C) - !dum2i(i,k)=min(dum2i(i,k),208.9e3_r8)/rho(i,k) ! convert from m-3 to kg-1 - end if - - else - dum2i(i,k)=0._r8 - end if - - ! ice nucleation if activated nuclei exist at t<0C - - if (dum2i(i,k).gt.0._r8.and.t(i,k).lt.tmelt.and. & - relhum(i,k)*es(i,k)/esi(i,k).gt. 1.05_r8 .and. k.gt.jt(i)+1) then - - if (k.eq.kqi(i)) then - nnuccd(k)=dum2i(i,k)/deltat - else - nnuccd(k)=(dum2i(i,k)-niic(i,k))/deltat - end if - nnuccd(k)=max(nnuccd(k),0._r8) - - !Calc mass of new particles using new crystal mass... - !also this will be multiplied by mtime as nnuccd is... - - mnuccd(k) = nnuccd(k) * mi0 - else - nnuccd(k)=0._r8 - mnuccd(k) = 0._r8 - end if - - !................................................................................ - ! Bergeron process - ! If 0C< T <-40C and both ice and liquid exist - - if (t(i,k).le.273.15_r8 .and. t(i,k).gt.233.15_r8 .and. & - qiic(i,k).gt.0.5e-6_r8 .and. qcic(i,k).gt. qsmall) then - plevap = qcic(i,k)/bergtsf - prb(k) = max(0._r8,plevap) - nprb(k) = prb(k)/(qcic(i,k)/ncic(i,k)) - else - prb(k)=0._r8 - nprb(k)=0._r8 - end if - - !................................................................................ - ! heterogeneous freezing of cloud water (-5C < T < -35C) - - if (qcic(i,k).ge.qsmall .and.ncic(i,k).gt.0._r8 .and. ntaerh(i,k).gt.0._r8 .and. & - t(i,k).le.268.15_r8 .and. t(i,k).gt.238.15_r8 ) then - - if (aero%scheme == 'bulk') then - ! immersion freezing (Diehl and Wurzler, 2004) - ttend(k) = -grav*wu(i,k)/cp/(1.0_r8+gamhat(i,k)) - - nai_bcphi = 0.0_r8 - nai_dst1 = 0.0_r8 - nai_dst2 = 0.0_r8 - nai_dst3 = 0.0_r8 - nai_dst4 = 0.0_r8 - - if (aero%idxbcphi > 0) nai_bcphi = naer2h(i,k,aero%idxbcphi) - if (aero%idxdst1 > 0) nai_dst1 = naer2h(i,k,aero%idxdst1) - if (aero%idxdst2 > 0) nai_dst2 = naer2h(i,k,aero%idxdst2) - if (aero%idxdst3 > 0) nai_dst3 = naer2h(i,k,aero%idxdst3) - if (aero%idxdst4 > 0) nai_dst4 = naer2h(i,k,aero%idxdst4) - - naimm = (0.00291_r8*nai_bcphi + 32.3_r8*(nai_dst1 + nai_dst2 + & - nai_dst3 + nai_dst4))/ntaerh(i,k) !m-3 - if (ttend(k) .lt. 0._r8) then - nnuccc(k) = -naimm*exp(273.15_r8-t(i,k))*ttend(k)*qcic(i,k)/rhow ! kg-1s-1 - mnuccc(k) = nnuccc(k)*qcic(i,k)/ncic(i,k) - end if - else - if (.false.) then - ! immersion freezing (Diehl and Wurzler, 2004) - ttend(k) = -grav*wu(i,k)/cp/(1.0_r8+gamhat(i,k)) - naimm = (0.00291_r8*soot_num + 32.3_r8*dst_num )*1.0e6_r8/ntaerh(i,k) !m-3 - if (ttend(k) .lt. 0._r8) then - nnuccc(k) = -naimm*exp(273.15_r8-t(i,k))*ttend(k)*qcic(i,k)/rhow ! kg-1s-1 - mnuccc(k) = nnuccc(k)*qcic(i,k)/ncic(i,k) - end if - else - ! immersion freezing (Bigg, 1953) - mnuccc(k) = pi*pi/36._r8*rhow* & - cdist1(k)*gamma(7._r8+pgam(i,k))* & - bimm*(exp(aimm*(273.15_r8-t(i,k)))-1._r8)/ & - lamc(i,k)**3/lamc(i,k)**3 - - nnuccc(k) = pi/6._r8*cdist1(k)*gamma(pgam(i,k)+4._r8) & - *bimm*(exp(aimm*(273.15_r8-t(i,k)))-1._r8)/lamc(i,k)**3 - end if - end if - - ! contact freezing (Young, 1974) with hooks into simulated dust - - tcnt=(270.16_r8-t(i,k))**1.3_r8 - viscosity=1.8e-5_r8*(t(i,k)/298.0_r8)**0.85_r8 ! Viscosity (kg/m/s) - mfp=2.0_r8*viscosity/(ph(i,k) & ! Mean free path (m) - *sqrt(8.0_r8*28.96e-3_r8/(pi*8.314409_r8*t(i,k)))) - - slip1=1.0_r8+(mfp/rn_dst1)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst1/mfp))))! Slip correction factor - slip2=1.0_r8+(mfp/rn_dst2)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst2/mfp)))) - slip3=1.0_r8+(mfp/rn_dst3)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst3/mfp)))) - slip4=1.0_r8+(mfp/rn_dst4)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst4/mfp)))) - - dfaer1=1.381e-23_r8*t(i,k)*slip1/(6._r8*pi*viscosity*rn_dst1) ! aerosol diffusivity (m2/s) - dfaer2=1.381e-23_r8*t(i,k)*slip2/(6._r8*pi*viscosity*rn_dst2) - dfaer3=1.381e-23_r8*t(i,k)*slip3/(6._r8*pi*viscosity*rn_dst3) - dfaer4=1.381e-23_r8*t(i,k)*slip4/(6._r8*pi*viscosity*rn_dst4) - - nacon1=0.0_r8 - nacon2=0.0_r8 - nacon3=0.0_r8 - nacon4=0.0_r8 - - if (aero%scheme == 'modal') then - - ! For modal aerosols: - ! use size '3' for dust coarse mode... - ! scale by dust fraction in coarse mode - - dmc = 0.5_r8*(aero%mmrg_a(i,k,aero%coarse_dust_idx,aero%mode_coarse_idx) & - +aero%mmrg_a(i,k-1,aero%coarse_dust_idx,aero%mode_coarse_idx)) - ssmc = 0.5_r8*(aero%mmrg_a(i,k,aero%coarse_nacl_idx,aero%mode_coarse_idx) & - +aero%mmrg_a(i,k-1,aero%coarse_nacl_idx,aero%mode_coarse_idx)) - if (dmc > 0.0_r8) then - nacon3 = dmc/(ssmc + dmc) * (aero%numg_a(i,k,aero%mode_coarse_idx) & - + aero%numg_a(i,k-1,aero%mode_coarse_idx))*0.5_r8*rho(i,k) - end if - - else if (aero%scheme == 'bulk') then - - if (aero%idxdst1.gt.0) then - nacon1=naer2h(i,k,aero%idxdst1)*tcnt *0.0_r8 - endif - if (aero%idxdst2.gt.0) then - nacon2=naer2h(i,k,aero%idxdst2)*tcnt ! 1/m3 - endif - if (aero%idxdst3.gt.0) then - nacon3=naer2h(i,k,aero%idxdst3)*tcnt - endif - if (aero%idxdst4.gt.0) then - nacon4=naer2h(i,k,aero%idxdst4)*tcnt - endif - end if - - mnucct(k) = (dfaer1*nacon1+dfaer2*nacon2+dfaer3*nacon3+dfaer4*nacon4)*pi*pi/3._r8*rhow* & - cdist1(k)*gamma(pgam(i,k)+5._r8)/lamc(i,k)**4 - - nnucct(k) = (dfaer1*nacon1+dfaer2*nacon2+dfaer3*nacon3+dfaer4*nacon4)*2._r8*pi* & - cdist1(k)*gamma(pgam(i,k)+2._r8)/lamc(i,k) - - ! if (nnuccc(k).gt.nnuccd(k)) then - ! dum=nnuccd(k)/nnuccc(k) - ! scale mixing ratio of droplet freezing with limit - ! mnuccc(k)=mnuccc(k)*dum - ! nnuccc(k)=nnuccd(k) - ! end if - - else - mnuccc(k) = 0._r8 - nnuccc(k) = 0._r8 - mnucct(k) = 0._r8 - nnucct(k) = 0._r8 - end if - - ! freeze cloud liquid water homogeneously at -40 C - if (t(i,k) < 233.15_r8 .and. qc(i,k) > 0._r8) then - - ! make sure freezing rain doesn't increase temperature above - ! threshold - dum = xlf/cp*qc(i,k) - if (t(i,k)+dum.gt.233.15_r8) then - dum = -(t(i,k)-233.15_r8)*cp/xlf - dum = dum/qc(i,k) - dum = max(0._r8,dum) - dum = min(1._r8,dum) - else - dum = 1._r8 - end if - fholm(i,k) = mu(i,k)*dum*qc(i,k) - fholn(i,k) = mu(i,k)*dum*nc(i,k) - end if - - - !**************************************************************************************** - ! conservation to ensure no negative values of cloud water/precipitation - ! in case microphysical process rates are large - ! note: for check on conservation, processes are multiplied by omsm - ! to prevent problems due to round off error - - ! since activation/nucleation processes are fast, need to take into account - ! factor mtime = mixing timescale in cloud / model time step - ! for now mixing timescale is assumed to be 15 min - !***************************************************************************************** - - mtime=deltat/900._r8 - mtimec=deltat/900._r8 - - ! conservation of qc - ! ice mass production from ice nucleation(deposition/cond.-freezing), mnuccd, - ! is considered as a part of cmei. - - qce = mu(i,k)*qc(i,k)-fholm(i,k) +dz(i,k)*cmel(i,k-1) - dum = arcf(i,k)*(pra(k)+prc(k)+prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)+ & - psacws(k))*dz(i,k) - if( qce.lt.0._r8) then - qcimp(k) = .true. - prc(k) = 0._r8 - pra(k) = 0._r8 - prb(k) = 0._r8 - mnuccc(k) = 0._r8 - mnucct(k) = 0._r8 - msacwi(k) = 0._r8 - psacws(k) = 0._r8 - else if (dum.gt.qce) then - ratio = qce/dum*omsm - prc(k) = prc(k)*ratio - pra(k) = pra(k)*ratio - prb(k) = prb(k)*ratio - mnuccc(k) = mnuccc(k)*ratio - mnucct(k) = mnucct(k)*ratio - msacwi(k) = msacwi(k)*ratio - psacws(k) = psacws(k)*ratio - end if - - ! conservation of nc - nce = mu(i,k)*nc(i,k)-fholn(i,k) + (arcf(i,k)*npccn(k)*mtimec)*dz(i,k) - dum = arcf(i,k)*dz(i,k)*(nprc1(k)+npra(k)+nnuccc(k)+nnucct(k)+ & - npsacws(k)+ nprb(k) ) - if (nce.lt.0._r8) then - ncimp(k) = .true. - nprc1(k) = 0._r8 - npra(k) = 0._r8 - nnuccc(k) = 0._r8 - nnucct(k) = 0._r8 - npsacws(k) = 0._r8 - nprb(k) = 0._r8 - else if (dum.gt.nce) then - ratio = nce/dum*omsm - nprc1(k) = nprc1(k)*ratio - npra(k) = npra(k)*ratio - nnuccc(k) = nnuccc(k)*ratio - nnucct(k) = nnucct(k)*ratio - npsacws(k) = npsacws(k)*ratio - nprb(k) = nprb(k)*ratio - end if - - ! conservation of qi - qie = mu(i,k)*qi(i,k)+fholm(i,k) +dz(i,k)*(cmei(i,k-1) + & - ( mnuccc(k)+mnucct(k)+msacwi(k)+prb(k))*arcf(i,k) ) - dum = arcf(i,k)*(prci(k)+ prai(k))*dz(i,k) - if (qie.lt.0._r8) then - qiimp(k) = .true. - prci(k) = 0._r8 - prai(k) = 0._r8 - else if (dum.gt.qie) then - ratio = qie/dum*omsm - prci(k) = prci(k)*ratio - prai(k) = prai(k)*ratio - end if - - ! conservation of ni - nie = mu(i,k)*ni(i,k)+fholn(i,k) +dz(i,k)*(nnuccd(k)*mtime*arcf(i,k) & - +(nnuccc(k)+ nnucct(k))*arcf(i,k) ) - dum = arcf(i,k)*dz(i,k)*(-nsacwi(k)+nprci(k)+ nprai(k)) - if( nie.lt.0._r8) then - niimp(k) = .true. - nsacwi(k)= 0._r8 - nprci(k) = 0._r8 - nprai(k) = 0._r8 - else if (dum.gt.nie) then - ratio = nie/dum*omsm - nsacwi(k)= nsacwi(k)*ratio - nprci(k) = nprci(k)*ratio - nprai(k) = nprai(k)*ratio - end if - - ! conservation of qr - - qre = mu(i,k)*qr(i,k)+dz(i,k)*(pra(k)+prc(k))*arcf(i,k) - dum = arcf(i,k)*dz(i,k)*(pracs(k)+ mnuccr(k)-prf(k)) - if (qre.lt.0._r8) then - prf(k) = 0._r8 - pracs(k) = 0._r8 - mnuccr(k) = 0._r8 - else if (dum.gt.qre) then - ratio = qre/dum*omsm - prf(k) = prf(k)*ratio - pracs(k) = pracs(k)*ratio - mnuccr(k) = mnuccr(k)*ratio - end if - - ! conservation of nr - nre = mu(i,k)*nr(i,k) + nprc(k)*arcf(i,k)*dz(i,k) - dum = arcf(i,k)*dz(i,k)*(npracs(k)+nnuccr(k) & - -nragg(k)-pnrf(k)) - if(nre.lt.0._r8) then - npracs(k)= 0._r8 - nnuccr(k)= 0._r8 - nragg(k) = 0._r8 - pnrf(k) = 0._r8 - else if (dum.gt.nre) then - ratio = nre/dum*omsm - npracs(k)= npracs(k)*ratio - nnuccr(k)= nnuccr(k)*ratio - nragg(k) = nragg(k)*ratio - pnrf(k) = pnrf(k)*ratio - end if - - ! conservation of qni - - qnie = mu(i,k)*qni(i,k)+dz(i,k)*( (prai(k)+psacws(k)+prci(k)+ & - pracs(k)+mnuccr(k))*arcf(i,k) ) - dum = arcf(i,k)*dz(i,k)*(-psf(k)) - - if(qnie.lt.0._r8) then - psf(k) = 0._r8 - else if (dum.gt.qnie) then - ratio = qnie/dum*omsm - psf(k) = psf(k)*ratio - end if - - ! conservation of ns - nse = mu(i,k)*ns(i,k)+dz(i,k)*(nprci(k)+nnuccr(k))*arcf(i,k) - dum = arcf(i,k)*dz(i,k)*(-nsagg(k)-pnsf(k)) - if (nse.lt.0._r8) then - nsagg(k) = 0._r8 - pnsf(k) = 0._r8 - else if (dum.gt.nse) then - ratio = nse/dum*omsm - nsagg(k) = nsagg(k)*ratio - pnsf(k) = pnsf(k)*ratio - end if - - !***************************************************************************** - ! get tendencies due to microphysical conversion processes - !***************************************************************************** - - if (k.le.kqc(i)) then - qctend(i,k) = (-pra(k)-prc(k)-prb(k)-mnuccc(k)-mnucct(k)-msacwi(k)- & - psacws(k)) - - qitend(i,k) = (prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)-prci(k)- prai(k)) - - qrtend(i,k) = (pra(k)+prc(k))+(-pracs(k)- mnuccr(k)) - - qnitend(i,k) = (prai(k)+psacws(k)+prci(k))+(pracs(k)+mnuccr(k)) - - ! multiply activation/nucleation by mtime to account for fast timescale - - nctend(i,k) = npccn(k)*mtimec+(-nnuccc(k)-nnucct(k)-npsacws(k) & - -npra(k)-nprc1(k)-nprb(k)) - - nitend(i,k) = nnuccd(k)*mtime+(nnuccc(k)+ nnucct(k)+nsacwi(k)-nprci(k)- & - nprai(k)) - - nstend(i,k) = nsagg(k)+nnuccr(k) + nprci(k) - - nrtend(i,k) = nprc(k)+(-npracs(k)-nnuccr(k) +nragg(k)) - - ! for output - ! cloud liquid water------------- - - autolm(i,k-1) = -prc(k)*arcf(i,k) - accrlm(i,k-1) = -pra(k)*arcf(i,k) - bergnm(i,k-1) = -prb(k)*arcf(i,k) - fhtimm(i,k-1) = -mnuccc(k)*arcf(i,k) - fhtctm(i,k-1) = -mnucct(k)*arcf(i,k) - hmpim (i,k-1) = -msacwi(k)*arcf(i,k) - accslm(i,k-1) = -psacws(k)*arcf(i,k) - fhmlm(i,k-1) = -fholm(i,k)/dz(i,k) - - autoln(i,k-1) = -nprc1(k)*arcf(i,k) - accrln(i,k-1) = -npra(k)*arcf(i,k) - bergnn(i,k-1) = -nprb(k)*arcf(i,k) - fhtimn(i,k-1) = -nnuccc(k)*arcf(i,k) - fhtctn(i,k-1) = -nnucct(k)*arcf(i,k) - accsln(i,k-1) = -npsacws(k)*arcf(i,k) - activn(i,k-1) = npccn(k)*mtimec*arcf(i,k) - fhmln(i,k-1) = -fholn(i,k)/dz(i,k) - - !cloud ice------------------------ - - autoim(i,k-1) = -prci(k)*arcf(i,k) - accsim(i,k-1) = -prai(k)*arcf(i,k) - - nuclin(i,k-1) = nnuccd(k)*mtime*arcf(i,k) - autoin(i,k-1) = -nprci(k)*arcf(i,k) - accsin(i,k-1) = -nprai(k)*arcf(i,k) - hmpin (i,k-1) = nsacwi(k)*arcf(i,k) - - else - qctend(i,k) = 0._r8 - qitend(i,k) = 0._r8 - qrtend(i,k) = 0._r8 - qnitend(i,k) = 0._r8 - nctend(i,k) = 0._r8 - nitend(i,k) = 0._r8 - nstend(i,k) = 0._r8 - nrtend(i,k) = 0._r8 - end if - - !******************************************************************************** - ! vertical integration - !******************************************************************************** - ! snow - if ( k.le.kqi(i) ) then - qni(i,k-1) = 1._r8/mu(i,k-1)* & - (mu(i,k)*qni(i,k)+dz(i,k)*(qnitend(i,k)+psf(k))*arcf(i,k) ) - - ns(i,k-1) = 1._r8/mu(i,k-1)* & - (mu(i,k)*ns(i,k)+dz(i,k)*(nstend(i,k)+pnsf(k))*arcf(i,k) ) - - else - qni(i,k-1)=0._r8 - ns(i,k-1)=0._r8 - end if - - if (qni(i,k-1).le.0._r8) then - qni(i,k-1)=0._r8 - ns(i,k-1)=0._r8 - end if - - ! rain - if (k.le.kqc(i) ) then - qr(i,k-1) = 1._r8/mu(i,k-1)* & - (mu(i,k)*qr(i,k)+dz(i,k)*(qrtend(i,k)+prf(k))*arcf(i,k) ) - - nr(i,k-1) = 1._r8/mu(i,k-1)* & - (mu(i,k)*nr(i,k)+dz(i,k)*(nrtend(i,k)+pnrf(k))*arcf(i,k) ) - - else - qr(i,k-1)=0._r8 - nr(i,k-1)=0._r8 - end if - - if( qr(i,k-1) .le. 0._r8) then - qr(i,k-1)=0._r8 - nr(i,k-1)=0._r8 - end if - - ! freeze rain homogeneously at -40 C - - if (t(i,k-1) < 233.15_r8 .and. qr(i,k-1) > 0._r8) then - - ! make sure freezing rain doesn't increase temperature above threshold - dum = xlf/cp*qr(i,k-1) - if (t(i,k-1)+dum.gt.233.15_r8) then - dum = -(t(i,k-1)-233.15_r8)*cp/xlf - dum = dum/qr(i,k-1) - dum = max(0._r8,dum) - dum = min(1._r8,dum) - else - dum = 1._r8 - end if - qni(i,k-1)=qni(i,k-1)+dum*qr(i,k-1) - ns(i,k-1)=ns(i,k-1)+dum*nr(i,k-1) - qr(i,k-1)=(1._r8-dum)*qr(i,k-1) - nr(i,k-1)=(1._r8-dum)*nr(i,k-1) - fhmrm(i,k-1) = -mu(i,k-1)*dum*qr(i,k-1)/dz(i,k) - end if - - - ! cloud water - if ( k.le.kqc(i) ) then - qc(i,k-1) = (mu(i,k)*qc(i,k)-fholm(i,k)+dz(i,k)*qctend(i,k)*arcf(i,k) & - +dz(i,k)*cmel(i,k-1) )/(mu(i,k-1)+dz(i,k)*du(i,k-1)) - - qcde(i,k) = qc(i,k-1) - - nc(i,k-1) = (mu(i,k)*nc(i,k) -fholn(i,k) +dz(i,k)*nctend(i,k)*arcf(i,k) ) & - /(mu(i,k-1)+dz(i,k)*du(i,k-1)) - - ncde(i,k) = nc(i,k-1) - else - qc(i,k-1)=0._r8 - nc(i,k-1)=0._r8 - end if - - if (qc(i,k-1).lt.0._r8) write(iulog,*) "negative qc(i,k-1)=",qc(i,k-1) - dlfm(i,k-1) = -du(i,k-1)*qcde(i,k) - dlfn(i,k-1) = -du(i,k-1)*ncde(i,k) - - if (qc(i,k-1).le. 0._r8) then - qc(i,k-1)=0._r8 - nc(i,k-1)=0._r8 - end if - - if (nc(i,k-1).lt. 0._r8) then - write(iulog,*) "nc(i,k-1)=",nc(i,k-1),"k-1=",k-1,"arcf(i,k)=",arcf(i,k) - write(iulog,*) "mu(i,k-1)=",mu(i,k-1),"mu(i,k)=",mu(i,k),"nc(i,k)=",ni(i,k) - write(iulog,*) "dz(i,k)=",dz(i,k),"du(i,k-1)=",du(i,k-1),"nctend(i,k)=",nctend(i,k) - write(iulog,*) "eu(i,k-1)=",eu(i,k-1) - end if - - ! cloud ice - if( k.le.kqi(i)) then - qi(i,k-1) = (mu(i,k)*qi(i,k)+fholm(i,k) +dz(i,k)*qitend(i,k)*arcf(i,k) & - +dz(i,k)*cmei(i,k-1) )/(mu(i,k-1)+dz(i,k)*du(i,k-1)) - - qide(i,k) = qi(i,k-1) - - ni(i,k-1) = (mu(i,k)*ni(i,k)+fholn(i,k)+dz(i,k)*nitend(i,k)*arcf(i,k) ) & - /(mu(i,k-1)+dz(i,k)*du(i,k-1)) - - nide(i,k) = ni(i,k-1) - else - qi(i,k-1)=0._r8 - ni(i,k-1)=0._r8 - end if - - if (qi(i,k-1).lt.0._r8) write(iulog,*) "negative qi(i,k-1)=",qi(i,k-1) - difm(i,k-1) = -du(i,k-1)*qide(i,k) - difn(i,k-1) = -du(i,k-1)*nide(i,k) - - if (qi(i,k-1).le. 0._r8) then - qi(i,k-1)=0._r8 - ni(i,k-1)=0._r8 - end if - - - if (ni(i,k-1).lt. 0._r8) then - write(iulog,*) "ni(i,k-1)=",ni(i,k-1),"k-1=",k-1,"arcf(i,k)=",arcf(i,k) - write(iulog,*) "mu(i,k-1)=",mu(i,k-1),"mu(i,k)=",mu(i,k),"ni(i,k)=",ni(i,k) - write(iulog,*) "dz(i,k)=",dz(i,k),"du(i,k-1)=",du(i,k-1),"nitend(i,k)=",nitend(i,k) - write(iulog,*) "eu(i,k-1)=",eu(i,k-1) - end if - - - frz(i,k-1) = cmei(i,k-1) + arcf(i,k)*(prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)+ & - pracs(k)+mnuccr(k)+psacws(k) )-fhmlm(i,k-1)-fhmrm(i,k-1) - - - !****************************************************************************** - ! get size distribution parameters based on in-cloud cloud water/ice - ! these calculations also ensure consistency between number and mixing ratio - - ! following equation(2,3,4) of Morrison and Gettelman, 2008, J. Climate. - ! Gamma(n)= (n-1)! - ! lamc <-> lambda for cloud liquid water - ! pgam <-> meu for cloud liquid water - ! meu=0 for ice,rain and snow - !******************************************************************************* - - ! cloud ice - niorg = ni(i,k-1) - if (qi(i,k-1).ge.qsmall) then - - ! add upper limit to in-cloud number concentration to prevent numerical error - ni(i,k-1)=min(ni(i,k-1),qi(i,k-1)*1.e20_r8) - ! ni should be non-negative - ! ni(i,k-1) = max(ni(i,k-1), 0._r8) - if (ni(i,k-1).lt. 0._r8) write(iulog,*) "ni(i,k-1)=",ni(i,k-1) - - lami(k-1) = (gamma(1._r8+di)*ci* & - ni(i,k-1)/qi(i,k-1))**(1._r8/di) - n0i(k-1) = ni(i,k-1)*lami(k-1) - - ! check for slope - lammax = 1._r8/10.e-6_r8 - lammin = 1._r8/(2._r8*dcs) - - ! adjust vars - if (lami(k-1).lt.lammin) then - lami(k-1) = lammin - n0i(k-1) = lami(k-1)**(di+1._r8)*qi(i,k-1)/(ci*gamma(1._r8+di)) - ni(i,k-1) = n0i(k-1)/lami(k-1) - else if (lami(k-1).gt.lammax) then - lami(k-1) = lammax - n0i(k-1) = lami(k-1)**(di+1._r8)*qi(i,k-1)/(ci*gamma(1._r8+di)) - ni(i,k-1) = n0i(k-1)/lami(k-1) - end if - else - lami(k-1) = 0._r8 - n0i(k-1) = 0._r8 - end if - - nide(i,k) = ni(i,k-1) - difn(i,k-1) = -du(i,k-1)*nide(i,k) - - niadj(i,k-1)= (ni(i,k-1)- niorg)*mu(i,k-1)/dz(i,k) - - if (niadj(i,k-1) .lt. 0._r8) then - total = nuclin(i,k-1)-fhtimn(i,k-1)-fhtctn(i,k-1)-fhmln(i,k-1)+ hmpin (i,k-1) - if (total .ne. 0._r8) then - nuclin(i,k-1) = nuclin(i,k-1) + nuclin(i,k-1)*niadj(i,k-1)/total - fhtimn(i,k-1) = fhtimn(i,k-1) + fhtimn(i,k-1)*niadj(i,k-1)/total - fhtctn(i,k-1) = fhtctn(i,k-1) + fhtctn(i,k-1)*niadj(i,k-1)/total - fhmln (i,k-1) = fhmln (i,k-1) + fhmln (i,k-1)*niadj(i,k-1)/total - hmpin (i,k-1) = hmpin (i,k-1) + hmpin (i,k-1)*niadj(i,k-1)/total - else - total = 5._r8 - nuclin(i,k-1) = nuclin(i,k-1) + niadj(i,k-1)/total - fhtimn(i,k-1) = fhtimn(i,k-1) + niadj(i,k-1)/total - fhtctn(i,k-1) = fhtctn(i,k-1) + niadj(i,k-1)/total - fhmln (i,k-1) = fhmln (i,k-1) + niadj(i,k-1)/total - hmpin (i,k-1) = hmpin (i,k-1) + niadj(i,k-1)/total - end if - else if (niadj(i,k-1) .gt. 0._r8) then - total = autoin(i,k-1)+accsin(i,k-1) - if (total .ne. 0._r8) then - autoin(i,k-1) = autoin(i,k-1) + autoin(i,k-1)*niadj(i,k-1)/total - accsin(i,k-1) = accsin(i,k-1) + accsin(i,k-1)*niadj(i,k-1)/total - else - total = 2._r8 - autoin(i,k-1) = autoin(i,k-1) + niadj(i,k-1)/total - accsin(i,k-1) = accsin(i,k-1) + niadj(i,k-1)/total - end if - end if - - !................................................................................ - !cloud water - ncorg = nc(i,k-1) - if (qc(i,k-1).ge.qsmall) then - - ! add upper limit to in-cloud number concentration to prevent numerical error - nc(i,k-1)=min(nc(i,k-1),qc(i,k-1)*1.e20_r8) - ! and make sure it's non-negative - ! nc(i,k-1) = max(nc(i,k-1), 0._r8) - if (nc(i,k-1).lt. 0._r8) write(iulog,*) "nc(i,k-1)=",nc(i,k-1) - - ! get pgam from fit to observations of martin et al. 1994 - - pgam(i,k-1)=0.0005714_r8*(nc(i,k-1)/1.e6_r8/rho(i,k-1))+0.2714_r8 - pgam(i,k-1)=1._r8/(pgam(i,k-1)**2)-1._r8 - pgam(i,k-1)=max(pgam(i,k-1),2._r8) - pgam(i,k-1)=min(pgam(i,k-1),15._r8) - ! calculate lamc - - lamc(i,k-1) = (pi/6._r8*rhow*nc(i,k-1)*gamma(pgam(i,k-1)+4._r8)/ & - (qc(i,k-1)*gamma(pgam(i,k-1)+1._r8)))**(1._r8/3._r8) - - ! lammin, 50 micron diameter max mean size - lammin = (pgam(i,k-1)+1._r8)/40.e-6_r8 - lammax = (pgam(i,k-1)+1._r8)/1.e-6_r8 - - if (lamc(i,k-1).lt.lammin) then - lamc(i,k-1) = lammin - nc(i,k-1) = 6._r8*lamc(i,k-1)**3*qc(i,k-1)* & - gamma(pgam(i,k-1)+1._r8)/ & - (pi*rhow*gamma(pgam(i,k-1)+4._r8)) - else if (lamc(i,k-1).gt.lammax) then - lamc(i,k-1) = lammax - nc(i,k-1) = 6._r8*lamc(i,k-1)**3*qc(i,k-1)* & - gamma(pgam(i,k-1)+1._r8)/ & - (pi*rhow*gamma(pgam(i,k-1)+4._r8)) - end if - - ! parameter to calculate droplet freezing - - cdist1(k-1) = nc(i,k-1)/gamma(pgam(i,k-1)+1._r8) - else - lamc(i,k-1) = 0._r8 - cdist1(k-1) = 0._r8 - end if - - ncde(i,k) = nc(i,k-1) - dlfn(i,k-1) = -du(i,k-1)*ncde(i,k) - - ncadj(i,k-1) = (nc(i,k-1)- ncorg)*mu(i,k-1)/dz(i,k) - if (ncadj(i,k-1) .lt. 0._r8) then - activn(i,k-1) = activn(i,k-1) + ncadj(i,k-1) - else if (ncadj(i,k-1) .gt. 0._r8) then - total = autoln(i,k-1)+accrln(i,k-1)+bergnn(i,k-1)+accsln(i,k-1) - if (total .ne. 0._r8) then - autoln(i,k-1) = autoln(i,k-1) + autoln(i,k-1)*ncadj(i,k-1)/total - accrln(i,k-1) = accrln(i,k-1) + accrln(i,k-1)*ncadj(i,k-1)/total - bergnn(i,k-1) = bergnn(i,k-1) + bergnn(i,k-1)*ncadj(i,k-1)/total - accsln(i,k-1) = accsln(i,k-1) + accsln(i,k-1)*ncadj(i,k-1)/total - else - total = 4._r8 - autoln(i,k-1) = autoln(i,k-1) + ncadj(i,k-1)/total - accrln(i,k-1) = accrln(i,k-1) + ncadj(i,k-1)/total - bergnn(i,k-1) = bergnn(i,k-1) + ncadj(i,k-1)/total - accsln(i,k-1) = accsln(i,k-1) + ncadj(i,k-1)/total - end if - end if - - trspcm(i,k-1) = (mu(i,k)*qc(i,k) - mu(i,k-1)*qc(i,k-1))/dz(i,k) - trspcn(i,k-1) = (mu(i,k)*nc(i,k) - mu(i,k-1)*nc(i,k-1))/dz(i,k) - trspim(i,k-1) = (mu(i,k)*qi(i,k) - mu(i,k-1)*qi(i,k-1))/dz(i,k) - trspin(i,k-1) = (mu(i,k)*ni(i,k) - mu(i,k-1)*ni(i,k-1))/dz(i,k) - - if (k-1 .eq. jt(i)+1) then - trspcm(i,k-2) = mu(i,k-1)*qc(i,k-1)/dz(i,k-1) - trspcn(i,k-2) = mu(i,k-1)*nc(i,k-1)/dz(i,k-1) - trspim(i,k-2) = mu(i,k-1)*qi(i,k-1)/dz(i,k-1) - trspin(i,k-2) = mu(i,k-1)*ni(i,k-1)/dz(i,k-1) - qcde(i,k-1) = qc(i,k-1) - ncde(i,k-1) = nc(i,k-1) - qide(i,k-1) = qi(i,k-1) - nide(i,k-1) = ni(i,k-1) - dlfm (i,k-2) = -du(i,k-2)*qcde(i,k-1) - dlfn (i,k-2) = -du(i,k-2)*ncde(i,k-1) - difm (i,k-2) = -du(i,k-2)*qide(i,k-1) - difn (i,k-2) = -du(i,k-2)*nide(i,k-1) - end if - - - !....................................................................... - ! get size distribution parameters for precip - !...................................................................... - ! rain - if (qr(i,k-1).ge.qsmall) then - - lamr(k-1) = (pi*rhow*nr(i,k-1)/qr(i,k-1))**(1._r8/3._r8) - n0r(k-1) = nr(i,k-1)*lamr(k-1) - - ! check for slope - lammax = 1._r8/150.e-6_r8 - lammin = 1._r8/3000.e-6_r8 - ! adjust vars - if (lamr(k-1).lt.lammin) then - lamr(k-1) = lammin - n0r(k-1) = lamr(k-1)**4*qr(i,k-1)/(pi*rhow) - nr(i,k-1) = n0r(k-1)/lamr(k-1) - else if (lamr(k-1).gt.lammax) then - lamr(k-1) = lammax - n0r(k-1) = lamr(k-1)**4*qr(i,k-1)/(pi*rhow) - nr(i,k-1) = n0r(k-1)/lamr(k-1) - end if - - unr(k-1) = min(arn(i,k-1)*gamma(1._r8+br)/lamr(k-1)**br,10._r8) - umr(k-1) = min(arn(i,k-1)*gamma(4._r8+br)/(6._r8*lamr(k-1)**br),10._r8) - else - lamr(k-1) = 0._r8 - n0r(k-1) = 0._r8 - umr(k-1) = 0._r8 - unr(k-1) = 0._r8 - end if - - !...................................................................... - ! snow - if (qni(i,k-1).ge.qsmall) then - lams(k-1) = (gamma(1._r8+ds)*cs*ns(i,k-1)/ & - qni(i,k-1))**(1._r8/ds) - n0s(k-1) = ns(i,k-1)*lams(k-1) - - ! check for slope - lammax = 1._r8/10.e-6_r8 - lammin = 1._r8/2000.e-6_r8 - - ! adjust vars - if (lams(k-1).lt.lammin) then - lams(k-1) = lammin - n0s(k-1) = lams(k-1)**(ds+1._r8)*qni(i,k-1)/(cs*gamma(1._r8+ds)) - ns(i,k-1) = n0s(k-1)/lams(k-1) - else if (lams(k-1).gt.lammax) then - lams(k-1) = lammax - n0s(k-1) = lams(k-1)**(ds+1._r8)*qni(i,k-1)/(cs*gamma(1._r8+ds)) - ns(i,k-1) = n0s(k-1)/lams(k-1) - end if - ums(k-1) = min(asn(i,k-1)*gamma(4._r8+bs)/(6._r8*lams(k-1)**bs),3.6_r8) - uns(k-1) = min(asn(i,k-1)*gamma(1._r8+bs)/lams(k-1)**bs,3.6_r8) - else - lams(k-1) = 0._r8 - n0s(k-1) = 0._r8 - ums(k-1) = 0._r8 - uns(k-1) = 0._r8 - end if - - rprd(i,k-1)= (qnitend(i,k) + qrtend(i,k))*arcf(i,k) - sprd(i,k-1)= qnitend(i,k) *arcf(i,k) -fhmrm(i,k-1) - - end if ! k shr_kind_r8 +use cam_history, only: addfld, add_default, outfld +use cam_history, only: cam_history_snapshot_deactivate, cam_history_snapshot_activate +use cam_history_support, only: horiz_only +use cam_abortutils, only: endrun +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_get_field_name +use physics_types, only: physics_state, physics_tend, physics_ptend +use camsrfexch, only: cam_out_t, cam_in_t +use ppgrid, only: pcols, begchunk, endchunk +use constituents, only: pcnst +use phys_control, only: phys_getopts +use cam_logfile, only: iulog +use cam_snapshot_common, only: snapshot_type, cam_snapshot_deactivate, cam_snapshot_all_outfld, cam_snapshot_ptend_outfld +use cam_snapshot_common, only: snapshot_type, cam_state_snapshot_init, cam_cnst_snapshot_init, cam_tend_snapshot_init +use cam_snapshot_common, only: cam_ptend_snapshot_init, cam_in_snapshot_init, cam_out_snapshot_init +use cam_snapshot_common, only: cam_pbuf_snapshot_init, snapshot_addfld + +implicit none + +private + +public :: cam_snapshot_init +public :: cam_snapshot_all_outfld_tphysbc, cam_snapshot_all_outfld_tphysac + +private :: cam_tphysbc_snapshot_init, cam_tphysac_snapshot_init + +integer :: ntphysbc_var +integer :: ntphysac_var + +integer :: cam_snapshot_before_num, cam_snapshot_after_num + +! Note the maximum number of variables for each type +type (snapshot_type) :: tphysbc_snapshot(30) +type (snapshot_type) :: tphysac_snapshot(30) + +contains + +subroutine cam_snapshot_init(cam_in_arr, cam_out_arr, pbuf, index) + + +!-------------------------------------------------------- +! This subroutine does the addfld calls for ALL state, tend, ptend, and pbuf fields. It also includes the cam_in and cam_out +! elements which are used within CAM +!-------------------------------------------------------- + type(cam_in_t), intent(in) :: cam_in_arr(begchunk:endchunk) + type(cam_out_t), intent(in) :: cam_out_arr(begchunk:endchunk) + type(physics_buffer_desc), pointer, intent(inout) :: pbuf(:,:) + integer, intent(in) :: index + + + call phys_getopts(cam_snapshot_before_num_out = cam_snapshot_before_num, & + cam_snapshot_after_num_out = cam_snapshot_after_num) + + + ! Return if not turned on + if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested + + call cam_state_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + call cam_cnst_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + call cam_tend_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + call cam_ptend_snapshot_init(cam_snapshot_after_num) + call cam_in_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, cam_in_arr(index)) + call cam_out_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, cam_out_arr(index)) + call cam_pbuf_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num, pbuf(:,index)) + call cam_tphysac_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + call cam_tphysbc_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + +end subroutine cam_snapshot_init + +subroutine cam_snapshot_all_outfld_tphysbc(file_num, state, tend, cam_in, cam_out, pbuf, cmfmc, cmfcme, & + zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) + +use time_manager, only: is_first_step, is_first_restart_step + +!-------------------------------------------------------- +! This subroutine does the outfld calls for ALL state, tend and pbuf fields for routines in tphysbc. +! It also includes the cam_in and cam_out elements which are used within CAM as well as variables which +! are local to tphysbc. +!-------------------------------------------------------- + + integer, intent(in) :: file_num + type(physics_state), intent(in) :: state + type(physics_tend), intent(in) :: tend + type(cam_in_t), intent(in) :: cam_in + type(cam_out_t), intent(in) :: cam_out + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) + real(r8), intent(in) :: cmfmc(:,:) ! convective mass flux + real(r8), intent(in) :: cmfcme(:,:) ! cmf condensation - evaporation + real(r8), intent(in) :: zdu(:,:) ! detraining mass flux from deep convection + real(r8), intent(in) :: rliq(:) ! vertical integral of liquid not yet in q(ixcldliq) + real(r8), intent(in) :: rice(:) ! vertical integral of ice not yet in q(ixcldice) + real(r8), intent(in) :: dlf(:,:) ! local copy of DLFZM (copy so need to output) + real(r8), intent(in) :: dlf2(:,:) ! Detraining cld H20 from shallow convections + real(r8), intent(in) :: rliq2(:) ! vertical integral of liquid from shallow scheme + real(r8), intent(in) :: net_flx(:) + + integer :: lchnk + + ! Return if the first timestep as not all fields may be filled in and this will cause a core dump + if (is_first_step().or. is_first_restart_step()) return + + ! Return if not turned on + if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested + + lchnk = state%lchnk + + call outfld('tphysbc_cmfmc', cmfmc, pcols, lchnk) + call outfld('tphysbc_cmfcme', cmfcme, pcols, lchnk) + call outfld('tphysbc_zdu', zdu, pcols, lchnk) + call outfld('tphysbc_rliq', rliq, pcols, lchnk) + call outfld('tphysbc_rice', rice, pcols, lchnk) + call outfld('tphysbc_dlf', dlf, pcols, lchnk) + call outfld('tphysbc_dlf2', dlf2, pcols, lchnk) + call outfld('tphysbc_rliq2', rliq2, pcols, lchnk) + call outfld('tphysbc_net_flx', net_flx, pcols, lchnk) + + call cam_snapshot_all_outfld(file_num, state, tend, cam_in, cam_out, pbuf) + +end subroutine cam_snapshot_all_outfld_tphysbc + +subroutine cam_snapshot_all_outfld_tphysac(file_num, state, tend, cam_in, cam_out, pbuf, fh2o, surfric, obklen, flx_heat, & + cmfmc, dlf, det_s, det_ice, net_flx) + +use time_manager, only: is_first_step + +!-------------------------------------------------------- +! This subroutine does the outfld calls for ALL state, tend and pbuf fields for routines in tphysac. +! It also includes the cam_in and cam_out elements which are used within CAM as well as variables which +! are local to tphysac. +!-------------------------------------------------------- + + integer, intent(in) :: file_num + type(physics_state), intent(in) :: state + type(physics_tend), intent(in) :: tend + type(cam_in_t), intent(in) :: cam_in + type(cam_out_t), intent(in) :: cam_out + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) + real(r8), intent(in) :: fh2o(:) ! h2o flux to balance source from methane chemistry + real(r8), intent(in) :: surfric(:) ! surface friction velocity + real(r8), intent(in) :: obklen(:) ! Obukhov length + real(r8), intent(in) :: flx_heat(:) ! Heat flux for check_energy_chng. + real(r8), intent(in) :: cmfmc(:,:) ! convective mass flux + real(r8), intent(in) :: dlf(:,:) ! local copy of DLFZM (copy so need to output) + real(r8), intent(in) :: det_s(:) ! vertical integral of detrained static energy from ice + real(r8), intent(in) :: det_ice(:) ! vertical integral of detrained ice + real(r8), intent(in) :: net_flx(:) + + integer :: lchnk + + ! Return if the first timestep as not all fields may be filled in and this will cause a core dump + if (is_first_step()) return + + ! Return if not turned on + if (cam_snapshot_before_num <= 0 .and. cam_snapshot_after_num <= 0) return ! No snapshot files are being requested + + lchnk = state%lchnk + + call outfld('tphysac_fh2o', fh2o, pcols, lchnk) + call outfld('tphysac_surfric', surfric, pcols, lchnk) + call outfld('tphysac_obklen', obklen, pcols, lchnk) + call outfld('tphysac_flx_heat', flx_heat, pcols, lchnk) + call outfld('tphysac_cmfmc', cmfmc, pcols, lchnk) + call outfld('tphysac_dlf', dlf, pcols, lchnk) + call outfld('tphysac_det_s', det_s, pcols, lchnk) + call outfld('tphysac_det_ice', det_ice, pcols, lchnk) + call outfld('tphysac_net_flx', net_flx, pcols, lchnk) + + call cam_snapshot_all_outfld(file_num, state, tend, cam_in, cam_out, pbuf) + +end subroutine cam_snapshot_all_outfld_tphysac + +subroutine cam_tphysbc_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + +!-------------------------------------------------------- +! This subroutine does the addfld calls for the misc tphysbc physics variables that are passed individually +! into physics packages +!-------------------------------------------------------- + + integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num + + ntphysbc_var = 0 + + !-------------------------------------------------------- + ! Add the misc tphysbc variables to the output + ! NOTE - flx_heat is added in tphysac + !-------------------------------------------------------- + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'flx', 'tphysbc_flx_heat', 'unset', horiz_only) + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cmfmc', 'tphysbc_cmfmc', 'unset', 'lev') + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cmfcme', 'tphysbc_cmfcme', 'unset', 'lev') + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'zdu', 'tphysbc_zdu', 'unset', 'lev') + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'rliq', 'tphysbc_rliq', 'unset', horiz_only) + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'rice', 'tphysbc_rice', 'unset', horiz_only) + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'dlf', 'tphysbc_dlf', 'unset', 'lev') + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'dlf2', 'tphysbc_dlf2', 'unset', 'lev') + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'rliq2', 'tphysbc_rliq2', 'unset', horiz_only) + + call snapshot_addfld( ntphysbc_var, tphysbc_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'net_flx', 'tphysbc_net_flx', 'unset', horiz_only) + + +end subroutine cam_tphysbc_snapshot_init + +subroutine cam_tphysac_snapshot_init(cam_snapshot_before_num, cam_snapshot_after_num) + +!-------------------------------------------------------- +! This subroutine does the addfld calls for the misc tphysac physics variables that are passed individually +! into physics packages +!-------------------------------------------------------- + + integer,intent(in) :: cam_snapshot_before_num, cam_snapshot_after_num + + ntphysac_var = 0 + + !-------------------------------------------------------- + ! Add the misc tphysac variables to the output + !-------------------------------------------------------- + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'fh2o', 'tphysac_fh2o', 'unset', horiz_only) + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'surfric', 'tphysac_surfric', 'unset', horiz_only) + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'obklen', 'tphysac_obklen', 'unset', horiz_only) + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'flx', 'tphysac_flx_heat', 'unset', horiz_only) + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'cmfmc', 'tphysac_cmfmc', 'unset', 'lev') + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'zdu', 'tphysac_zdu', 'unset', 'lev') + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'rliq', 'tphysac_rliq', 'unset', horiz_only) + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'dlf', 'tphysac_dlf', 'unset', 'lev') + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'dlf2', 'tphysac_dlf2', 'unset', 'lev') + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'rliq2', 'tphysac_rliq2', 'unset', horiz_only) + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'det_s', 'tphysac_det_s', 'unset', horiz_only) + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'det_ice', 'tphysac_det_ice', 'unset', horiz_only) + + call snapshot_addfld( ntphysac_var, tphysac_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'net_flx', 'tphysac_net_flx', 'unset', horiz_only) + + +end subroutine cam_tphysac_snapshot_init + +end module cam_snapshot diff --git a/src/physics/cam7/convect_diagnostics.F90 b/src/physics/cam7/convect_diagnostics.F90 new file mode 100644 index 0000000000..1ea7b38221 --- /dev/null +++ b/src/physics/cam7/convect_diagnostics.F90 @@ -0,0 +1,233 @@ + module convect_diagnostics + + !----------------------------------------------- ! + ! Purpose: ! + ! ! + ! CAM convection diagnostics ! + ! to be called after convection routines ! + ! A. Herrington. Nov. 2021 ! + !----------------------------------------------- ! + + use shr_kind_mod, only: r8=>shr_kind_r8 + use ppgrid, only: pver, pcols, pverp + use cam_history, only: outfld, addfld, horiz_only + use phys_control, only: phys_getopts + use cam_abortutils, only: endrun + implicit none + private + save + + public :: & + convect_diagnostics_register, & ! Register fields in physics buffer + convect_diagnostics_init, & ! Initialize convect diagnostic module + convect_diagnostics_calc ! Return convect diagnostic + + character(len=16) :: shallow_scheme ! Default set in phys_control.F90, use namelist to change + + ! Physics buffer indices + integer :: icwmrsh_idx = 0 + integer :: rprdsh_idx = 0 + integer :: rprdtot_idx = 0 + integer :: cldtop_idx = 0 + integer :: cldbot_idx = 0 + integer :: nevapr_shcu_idx = 0 + integer :: rprddp_idx = 0 + integer :: prec_sh_idx = 0 + integer :: snow_sh_idx = 0 + integer :: cmfmc_sh_idx = 0 + + contains + + !=============================================================================== ! + ! ! + !=============================================================================== ! + + subroutine convect_diagnostics_register + + !-------------------------------------------------- ! + ! Purpose : Register fields with the physics buffer ! + !-------------------------------------------------- ! + use physics_buffer, only: pbuf_add_field, dtype_r8 + + call phys_getopts( shallow_scheme_out = shallow_scheme ) + + call pbuf_add_field('ICWMRSH', 'physpkg' ,dtype_r8,(/pcols,pver/), icwmrsh_idx ) + call pbuf_add_field('RPRDSH', 'physpkg' ,dtype_r8,(/pcols,pver/), rprdsh_idx ) + call pbuf_add_field('RPRDTOT', 'physpkg' ,dtype_r8,(/pcols,pver/), rprdtot_idx ) + call pbuf_add_field('CLDTOP', 'physpkg' ,dtype_r8,(/pcols,1/), cldtop_idx ) + call pbuf_add_field('CLDBOT', 'physpkg' ,dtype_r8,(/pcols,1/), cldbot_idx ) + call pbuf_add_field('NEVAPR_SHCU','physpkg' ,dtype_r8,(/pcols,pver/), nevapr_shcu_idx ) + call pbuf_add_field('PREC_SH', 'physpkg' ,dtype_r8,(/pcols/), prec_sh_idx ) + call pbuf_add_field('SNOW_SH', 'physpkg' ,dtype_r8,(/pcols/), snow_sh_idx ) + ! Updraft mass flux by shallow convection [ kg/s/m2 ] + call pbuf_add_field('CMFMC_SH', 'physpkg' ,dtype_r8,(/pcols,pverp/), cmfmc_sh_idx ) + + ! for this implementation, only CLUBB_SGS is supported + if (shallow_scheme /= 'CLUBB_SGS') then + call endrun("convect_diagnostics_register: Unsupported shallow_scheme") + end if + + end subroutine convect_diagnostics_register + + !=============================================================================== ! + ! ! + !=============================================================================== ! + + subroutine convect_diagnostics_init + + !------------------------------------------------------------------------------- ! + ! Purpose : Declare output fields, and initialize variables needed by convection ! + !------------------------------------------------------------------------------- ! + use physics_buffer, only: pbuf_get_index + + call addfld( 'CMFMC', (/ 'ilev' /), 'A', 'kg/m2/s', 'Moist convection (deep+shallow) 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' ) + call addfld( 'PCLDTOP', horiz_only, 'A', 'Pa', 'Pressure of cloud top' ) + call addfld( 'PCLDBOT', horiz_only, 'A', 'Pa', 'Pressure of cloud base' ) + + rprddp_idx = pbuf_get_index('RPRDDP') + + end subroutine convect_diagnostics_init + + !=============================================================================== ! + ! ! + !=============================================================================== ! + + subroutine convect_diagnostics_calc( ztodt , cmfmc , & + qc , qc2 , rliq , rliq2 , & + state , pbuf) + + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_set_field + use physics_types, only: physics_state + implicit none + + ! ---------------------- ! + ! Input-Output Arguments ! + ! ---------------------- ! + type(physics_buffer_desc), pointer :: pbuf(:) + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: ztodt ! 2 delta-t [ s ] + + real(r8), intent(out) :: rliq2(pcols) ! Vertically-integrated reserved cloud condensate [ m/s ] + real(r8), intent(out) :: qc2(pcols,pver) ! Same as qc but only from shallow convection scheme + + real(r8), intent(inout) :: cmfmc(pcols,pverp) ! Moist deep + shallow convection cloud mass flux [ kg/s/m2 ] + real(r8), intent(inout) :: qc(pcols,pver) ! dq/dt due to export of cloud water into environment by shallow + ! and deep convection [ kg/kg/s ] + real(r8), intent(inout) :: rliq(pcols) ! Vertical integral of qc [ m/s ] + + integer :: i + integer :: lchnk ! Chunk identifier + integer :: ncol ! Number of atmospheric columns + + real(r8), pointer :: precc(:) ! Shallow convective precipitation (rain+snow) rate at surface [ m/s ] + real(r8), pointer :: snow(:) ! Shallow convective snow rate at surface [ m/s ] + + real(r8) :: cnt2(pcols) ! Top level of shallow convective activity + real(r8) :: cnb2(pcols) ! Bottom level of convective activity + real(r8) :: pcnt(pcols) ! Top pressure level of shallow + deep convective activity + real(r8) :: pcnb(pcols) ! Bottom pressure level of shallow + deep convective activity + + real(r8), pointer, dimension(:,:) :: icwmr ! In cloud water + ice mixing ratio + real(r8), pointer, dimension(:,:) :: rprddp ! dq/dt due to deep convective rainout + real(r8), pointer, dimension(:,:) :: rprdsh ! dq/dt due to deep and shallow convective rainout + real(r8), pointer, dimension(:,:) :: evapcsh ! Evaporation of shallow convective precipitation >= 0. + real(r8), pointer, dimension(:) :: cnt + real(r8), pointer, dimension(:) :: cnb + real(r8), pointer, dimension(:,:) :: cmfmc2 ! (pcols,pverp) Updraft mass flux by shallow convection [ kg/s/m2 ] + + ! ----------------------- ! + ! Main Computation Begins ! + ! ----------------------- ! + + lchnk = state%lchnk + ncol = state%ncol + + call pbuf_get_field(pbuf, icwmrsh_idx, icwmr) + + call pbuf_get_field(pbuf, rprddp_idx, rprddp ) + + call pbuf_get_field(pbuf, rprdsh_idx, rprdsh ) + + call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh ) + + call pbuf_get_field(pbuf, cldtop_idx, cnt ) + + call pbuf_get_field(pbuf, cldbot_idx, cnb ) + + call pbuf_get_field(pbuf, prec_sh_idx, precc ) + + call pbuf_get_field(pbuf, snow_sh_idx, snow ) + + call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc2) + + ! If no shallow convection scheme zero out relevant vars + ! (should also do the same if there's no deep scheme) + if (shallow_scheme == 'CLUBB_SGS') then + cmfmc2 = 0._r8 + rprdsh = 0._r8 + precc = 0._r8 + icwmr = 0._r8 + rliq2 = 0._r8 + qc2 = 0._r8 + cnt2 = real(pver, r8) + cnb2 = 1._r8 + evapcsh = 0._r8 + snow = 0._r8 + end if + + ! ------------------------------------------------------------------------------ ! + ! Merge shallow convection output with prior results from deep convection scheme ! + ! ------------------------------------------------------------------------------ ! + + ! ----------------------------------------------------------------------- ! + ! Combine cumulus updraft mass flux : 'cmfmc2'(shallow) + 'cmfmc'(deep) ! + ! ----------------------------------------------------------------------- ! + + cmfmc(:ncol,:) = cmfmc(:ncol,:) + cmfmc2(:ncol,:) + + ! -------------------------------------------------------------- ! + ! 'cnt2' & 'cnb2' are from shallow, 'cnt' & 'cnb' are from deep ! + ! 'cnt2' & 'cnb2' are the interface indices of cloud top & base: ! + ! cnt2 = float(kpen) ! + ! cnb2 = float(krel - 1) ! + ! Note that indices decreases with height. ! + ! -------------------------------------------------------------- ! + + do i = 1, ncol + if( cnt2(i) < cnt(i)) cnt(i) = cnt2(i) + if( cnb2(i) > cnb(i)) cnb(i) = cnb2(i) + if( cnb(i) == 1._r8 ) cnb(i) = cnt(i) + pcnt(i) = state%pmid(i,int(cnt(i))) + pcnb(i) = state%pmid(i,int(cnb(i))) + end do + + ! ----------------------------------------------- ! + ! This quantity was previously known as CMFDQR. ! + ! Now CMFDQR is the shallow rain production only. ! + ! ----------------------------------------------- ! + + call pbuf_set_field(pbuf, rprdtot_idx, rprdsh(:ncol,:pver) + rprddp(:ncol,:pver), start=(/1,1/), kount=(/ncol,pver/)) + + ! ----------------------------------------------------------------------- ! + ! Add shallow reserved cloud condensate to deep reserved cloud condensate ! + ! qc [ kg/kg/s] , rliq [ m/s ] ! + ! ----------------------------------------------------------------------- ! + + qc(:ncol,:pver) = qc(:ncol,:pver) + qc2(:ncol,:pver) + rliq(:ncol) = rliq(:ncol) + rliq2(:ncol) + + ! ---------------------------------------------------------------------------- ! + ! Output new partition of cloud condensate variables, as well as precipitation ! + ! ---------------------------------------------------------------------------- ! + + call outfld( 'CMFMC' , cmfmc , pcols , lchnk ) + call outfld( 'CLDTOP' , cnt , pcols , lchnk ) + call outfld( 'CLDBOT' , cnb , pcols , lchnk ) + call outfld( 'PCLDTOP', pcnt , pcols , lchnk ) + call outfld( 'PCLDBOT', pcnb , pcols , lchnk ) + + end subroutine convect_diagnostics_calc + + end module convect_diagnostics diff --git a/src/physics/cam7/micro_pumas_cam.F90 b/src/physics/cam7/micro_pumas_cam.F90 new file mode 100644 index 0000000000..5d76f36be5 --- /dev/null +++ b/src/physics/cam7/micro_pumas_cam.F90 @@ -0,0 +1,3740 @@ +module micro_pumas_cam + +!--------------------------------------------------------------------------------- +! +! CAM Interfaces for MG microphysics +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use shr_kind_mod, only: cl=>shr_kind_cl +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver, pverp, psubcols +use physconst, only: gravit, rair, tmelt, cpair, rh2o, rhoh2o, & + latvap, latice, mwh2o +use phys_control, only: phys_getopts, use_hetfrz_classnuc + +use shr_const_mod, only: pi => shr_const_pi +use time_manager, only: get_curr_date, get_curr_calday +use phys_grid, only: get_rlat_all_p, get_rlon_all_p +use orbit, only: zenith + +use physics_types, only: physics_state, physics_ptend, & + physics_ptend_init, physics_state_copy, & + physics_update, physics_state_dealloc, & + physics_ptend_sum, physics_ptend_scale + +use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dyn_time_lvls, & + pbuf_old_tim_idx, pbuf_get_index, dtype_r8, dtype_i4, & + pbuf_get_field, pbuf_set_field, col_type_subcol, & + pbuf_register_subcol +use constituents, only: cnst_add, cnst_get_ind, & + cnst_name, cnst_longname, sflxnam, apcnst, bpcnst, pcnst + +use cldfrc2m, only: rhmini=>rhmini_const + +use cam_history, only: addfld, add_default, outfld, horiz_only + +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use error_messages, only: handle_errmsg +use ref_pres, only: top_lev=>trop_cloud_top_lev + +use micro_pumas_diags, only: proc_rates_type + +use subcol_utils, only: subcol_get_scheme + +implicit none +private +save + +public :: & + micro_pumas_cam_readnl, & + micro_pumas_cam_register, & + micro_pumas_cam_init_cnst, & + micro_pumas_cam_implements_cnst, & + micro_pumas_cam_init, & + micro_pumas_cam_tend, & + micro_mg_version, & + massless_droplet_destroyer + +integer :: micro_mg_version = 1 ! Version number for MG. +integer :: micro_mg_sub_version = 0 ! Second part of version number. + +real(r8) :: micro_mg_dcs = -1._r8 +real(r8), target, allocatable :: trop_levs(:) + +logical :: microp_uniform = .false. +logical :: micro_mg_adjust_cpt = .false. + +logical :: micro_do_massless_droplet_destroyer ! turn on/off destruction of massless droplets + +character(len=16) :: micro_mg_precip_frac_method = 'max_overlap' ! type of precipitation fraction method + +real(r8), parameter :: unset_r8 = huge(1.0_r8) + +! Tunable namelist parameters (set in atm_in) +real(r8) :: micro_mg_berg_eff_factor = unset_r8 ! berg efficiency factor +real(r8) :: micro_mg_accre_enhan_fact = unset_r8 ! accretion enhancment factor +real(r8) :: micro_mg_autocon_fact = unset_r8 ! autoconversion prefactor +real(r8) :: micro_mg_autocon_nd_exp = unset_r8 ! autoconversion nd exponent +real(r8) :: micro_mg_autocon_lwp_exp = unset_r8 ! autoconversion lwp exponent +real(r8) :: micro_mg_homog_size = unset_r8 ! size of freezing homogeneous ice +real(r8) :: micro_mg_vtrmi_factor = unset_r8 ! ice fall speed factor +real(r8) :: micro_mg_vtrms_factor = unset_r8 ! snow fall speed factor +real(r8) :: micro_mg_effi_factor = unset_r8 ! ice effective radius factor +real(r8) :: micro_mg_iaccr_factor = unset_r8 ! ice accretion of cloud droplet +real(r8) :: micro_mg_max_nicons = unset_r8 ! max allowed ice number concentration + + +logical, public :: do_cldliq ! Prognose cldliq flag +logical, public :: do_cldice ! Prognose cldice flag + +integer :: num_steps ! Number of MG substeps + +integer :: ncnst = 4 ! Number of constituents + +! Namelist variables for option to specify constant cloud droplet/ice number +logical :: micro_mg_nccons = .false. ! set .true. to specify constant cloud droplet number +logical :: micro_mg_nicons = .false. ! set .true. to specify constant cloud ice number +logical :: micro_mg_ngcons = .false. ! set .true. to specify constant graupel/hail number +logical :: micro_mg_nrcons = .false. ! set .true. to specify constant rain number +logical :: micro_mg_nscons = .false. ! set .true. to specify constant snow number + +! parameters for specified ice and droplet number concentration +! note: these are local in-cloud values, not grid-mean +real(r8) :: micro_mg_ncnst = 50.e6_r8 ! constant liquid droplet num concentration (m-3) +real(r8) :: micro_mg_ninst = 0.05e6_r8 ! ice num concentration when nicons=.true. (m-3) +real(r8) :: micro_mg_nrnst = 0.2e6_r8 ! rain num concentration when nrcons=.true. (m-3) +real(r8) :: micro_mg_nsnst = 0.005e6_r8 ! snow num concentration when nscons=.true. (m-3) +real(r8) :: micro_mg_ngnst = 0.0005e6_r8 ! graupel/hail num concentration when ngcons=.true. (m-3) + +logical, public :: micro_mg_do_graupel +logical, public :: micro_mg_do_hail + +! switches for IFS like behavior +logical :: micro_mg_evap_sed_off = .false. ! Turn off evaporation/sublimation based on cloud fraction for sedimenting condensate +logical :: micro_mg_icenuc_rh_off = .false. ! Remove RH conditional from ice nucleation +logical :: micro_mg_icenuc_use_meyers = .false. ! Meyers Ice Nucleation +logical :: micro_mg_evap_scl_ifs = .false. ! Scale evaporation as IFS does +logical :: micro_mg_evap_rhthrsh_ifs = .false. ! Evap RH threhold following IFS +logical :: micro_mg_rainfreeze_ifs = .false. ! Rain freezing at 0C following IFS +logical :: micro_mg_ifs_sed = .false. ! Snow sedimentation = 1 m/s following IFS +logical :: micro_mg_precip_fall_corr = .false. ! Precip fall speed following IFS (does not go to zero) + +logical :: micro_mg_implicit_fall = .false. !Implicit fall speed (sedimentation) for hydrometeors + +logical :: micro_mg_accre_sees_auto = .false. !Accretion sees autoconverted rain + +character(len=10), parameter :: & ! Constituent names + cnst_names(10) = (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE', & + 'RAINQM', 'SNOWQM','NUMRAI','NUMSNO','GRAUQM','NUMGRA'/) + +integer :: & + ixq = -1, &! water vapor + ixcldliq = -1, &! cloud liquid amount index + ixcldice = -1, &! cloud ice amount index + ixnumliq = -1, &! cloud liquid number index + ixnumice = -1, &! cloud ice water index + ixrain = -1, &! rain index + ixsnow = -1, &! snow index + ixnumrain = -1, &! rain number index + ixnumsnow = -1, &! snow number index + ixgraupel = -1, &! graupel index + ixnumgraupel = -1 ! graupel number index + +! Physics buffer indices for fields registered by this module +integer :: & + cldo_idx, & + qme_idx, & + prain_idx, & + nevapr_idx, & + wsedl_idx, & + rei_idx, & + sadice_idx, & + sadsnow_idx, & + rel_idx, & + dei_idx, & + mu_idx, & + prer_evap_idx, & + lambdac_idx, & + iciwpst_idx, & + iclwpst_idx, & + des_idx, & + icswp_idx, & + cldfsnow_idx, & + degrau_idx = -1, & + icgrauwp_idx = -1, & + cldfgrau_idx = -1, & + rate1_cw2pr_st_idx = -1, & + ls_flxprc_idx, & + ls_flxsnw_idx, & + relvar_idx, & + cmeliq_idx, & + accre_enhan_idx + +! Fields for UNICON +integer :: & + am_evp_st_idx, &! Evaporation area of stratiform precipitation + evprain_st_idx, &! Evaporation rate of stratiform rain [kg/kg/s]. >= 0. + evpsnow_st_idx ! Evaporation rate of stratiform snow [kg/kg/s]. >= 0. + +! Fields needed as inputs to COSP +integer :: & + ls_mrprc_idx, ls_mrsnw_idx, & + ls_reffrain_idx, ls_reffsnow_idx, & + cv_reffliq_idx, cv_reffice_idx + +! Fields needed by Park macrophysics +integer :: & + cc_t_idx, cc_qv_idx, & + cc_ql_idx, cc_qi_idx, & + cc_nl_idx, cc_ni_idx, & + cc_qlst_idx + +! Used to replace aspects of MG microphysics +! (e.g. by CARMA) +integer :: & + tnd_qsnow_idx = -1, & + tnd_nsnow_idx = -1, & + re_ice_idx = -1 + +! Index fields for precipitation efficiency. +integer :: & + acpr_idx = -1, & + acgcme_idx = -1, & + acnum_idx = -1 + +! Physics buffer indices for fields registered by other modules +integer :: & + ast_idx = -1, & + cld_idx = -1, & + concld_idx = -1, & + prec_dp_idx = -1, & + prec_sh_idx = -1, & + qsatfac_idx = -1 + +! Pbuf fields needed for subcol_SILHS +integer :: & + qrain_idx=-1, qsnow_idx=-1, & + nrain_idx=-1, nsnow_idx=-1, & + qcsedten_idx=-1, qrsedten_idx=-1, & + qisedten_idx=-1, qssedten_idx=-1, & + vtrmc_idx=-1, umr_idx=-1, & + vtrmi_idx=-1, ums_idx=-1, & + qcsevap_idx=-1, qisevap_idx=-1 + +integer :: & + naai_idx = -1, & + naai_hom_idx = -1, & + npccn_idx = -1, & + rndst_idx = -1, & + nacon_idx = -1, & + prec_str_idx = -1, & + snow_str_idx = -1, & + prec_pcw_idx = -1, & + snow_pcw_idx = -1, & + prec_sed_idx = -1, & + snow_sed_idx = -1 + +! pbuf fields for heterogeneous freezing +integer :: & + frzimm_idx = -1, & + frzcnt_idx = -1, & + frzdep_idx = -1 + +logical :: allow_sed_supersat ! allow supersaturated conditions after sedimentation loop +character(len=16) :: micro_mg_warm_rain= 'kk2000' ! 'tau', 'emulated', 'sb2001' and ' kk2000' + +integer :: bergso_idx = -1 + +!=============================================================================== +contains +!=============================================================================== + +subroutine micro_pumas_cam_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_real8, & + mpi_logical, mpi_character + + use stochastic_emulated_cam, only: stochastic_emulated_readnl + use stochastic_tau_cam, only: stochastic_tau_readnl + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Namelist variables + logical :: micro_mg_do_cldice = .true. ! do_cldice = .true., MG microphysics is prognosing cldice + logical :: micro_mg_do_cldliq = .true. ! do_cldliq = .true., MG microphysics is prognosing cldliq + integer :: micro_mg_num_steps = 1 ! Number of substepping iterations done by MG (1.5 only for now). + + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'micro_pumas_cam_readnl' + + namelist /micro_mg_nl/ micro_mg_version, micro_mg_sub_version, & + micro_mg_do_cldice, micro_mg_do_cldliq, micro_mg_num_steps, & + microp_uniform, micro_mg_dcs, micro_mg_precip_frac_method, & + micro_mg_berg_eff_factor, micro_mg_warm_rain, micro_mg_adjust_cpt, & + micro_mg_do_hail, micro_mg_do_graupel, micro_mg_ngcons, micro_mg_ngnst, & + micro_mg_vtrmi_factor, micro_mg_vtrms_factor, micro_mg_effi_factor, & + micro_mg_iaccr_factor, micro_mg_max_nicons, micro_mg_accre_enhan_fact, & + micro_mg_autocon_fact, micro_mg_autocon_nd_exp, micro_mg_autocon_lwp_exp, micro_mg_homog_size, & + micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, micro_mg_ninst, & + micro_mg_nrcons, micro_mg_nscons, micro_mg_nrnst, micro_mg_nsnst, & + micro_do_massless_droplet_destroyer, & + micro_mg_evap_sed_off, micro_mg_icenuc_rh_off, micro_mg_icenuc_use_meyers, & + micro_mg_evap_scl_ifs, micro_mg_evap_rhthrsh_ifs, & + micro_mg_rainfreeze_ifs, micro_mg_ifs_sed, micro_mg_precip_fall_corr, & + micro_mg_accre_sees_auto, micro_mg_implicit_fall + + !----------------------------------------------------------------------------- + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'micro_mg_nl', status=ierr) + if (ierr == 0) then + read(unitn, micro_mg_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + + ! set local variables + do_cldice = micro_mg_do_cldice + do_cldliq = micro_mg_do_cldliq + num_steps = micro_mg_num_steps + + ! Verify that version numbers are valid. + select case (micro_mg_version) + case (2) + select case (micro_mg_sub_version) + case(0) + ! MG version 2.0 + case default + call bad_version_endrun() + end select + case (3) + select case (micro_mg_sub_version) + case(0) + ! MG version 3.0 + case default + call bad_version_endrun() + end select + case default + call bad_version_endrun() + end select + + if (micro_mg_dcs < 0._r8) call endrun( "micro_pumas_cam_readnl: & + µ_mg_dcs has not been set to a valid value.") + + if (micro_mg_version < 3) then + + if(micro_mg_do_graupel .or. micro_mg_do_hail ) then + call endrun ("micro_pumas_cam_readnl: Micro_mg_do_graupel and micro_mg_do_hail & + &must be false for MG versions before MG3.") + end if + + else ! micro_mg_version = 3 or greater + + if(micro_mg_do_graupel .and. micro_mg_do_hail ) then + call endrun ("micro_pumas_cam_readnl: Only one of micro_mg_do_graupel or & + µ_mg_do_hail may be true at a time.") + end if + + end if + + end if + + ! Broadcast namelist variables + call mpi_bcast(micro_mg_version, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_version") + + call mpi_bcast(micro_mg_sub_version, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_sub_version") + + call mpi_bcast(do_cldice, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_cldice") + + call mpi_bcast(do_cldliq, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_cldliq") + + call mpi_bcast(num_steps, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: num_steps") + + call mpi_bcast(microp_uniform, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: microp_uniform") + + call mpi_bcast(micro_mg_dcs, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_dcs") + + call mpi_bcast(micro_mg_berg_eff_factor, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_berg_eff_factor") + + call mpi_bcast(micro_mg_accre_enhan_fact, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_accre_enhan_fact") + + call mpi_bcast(micro_mg_autocon_fact, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_autocon_fact") + + call mpi_bcast(micro_mg_autocon_nd_exp, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_autocon_nd_exp") + + call mpi_bcast(micro_mg_autocon_lwp_exp, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_autocon_lwp_exp") + + call mpi_bcast(micro_mg_homog_size, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_homog_size") + + call mpi_bcast(micro_mg_vtrmi_factor, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_vtrmi_factor") + + call mpi_bcast(micro_mg_vtrms_factor, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_vtrms_factor") + + call mpi_bcast(micro_mg_effi_factor, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_effi_factor") + + call mpi_bcast(micro_mg_iaccr_factor, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_iaccr_factor") + + call mpi_bcast(micro_mg_max_nicons, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_max_nicons") + + call mpi_bcast(micro_mg_precip_frac_method, 16, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_precip_frac_method") + + call mpi_bcast(micro_mg_warm_rain, 16, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_warm_rain") + + call mpi_bcast(micro_mg_adjust_cpt, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_adjust_cpt") + + call mpi_bcast(micro_mg_nccons, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nccons") + + call mpi_bcast(micro_mg_nicons, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nicons") + + call mpi_bcast(micro_mg_nrcons, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nrcons") + + call mpi_bcast(micro_mg_nscons, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nscons") + + call mpi_bcast(micro_mg_ncnst, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ncnst") + + call mpi_bcast(micro_mg_ninst, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ninst") + + call mpi_bcast(micro_mg_nrnst, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nrnst") + + call mpi_bcast(micro_mg_nsnst, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nsnst") + + call mpi_bcast(micro_mg_do_hail, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_do_hail") + + call mpi_bcast(micro_mg_do_graupel, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_do_graupel") + + call mpi_bcast(micro_mg_ngcons, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ngcons") + + call mpi_bcast(micro_mg_ngnst, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ngnst") + + call mpi_bcast(micro_do_massless_droplet_destroyer, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_do_massless_droplet_destroyer") + + call mpi_bcast(micro_mg_evap_sed_off, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_evap_sed_off") + + call mpi_bcast(micro_mg_icenuc_rh_off, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_icenuc_rh_off") + + call mpi_bcast(micro_mg_icenuc_use_meyers, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_icenuc_use_meyers") + + call mpi_bcast(micro_mg_evap_scl_ifs, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_evap_scl_ifs") + + call mpi_bcast(micro_mg_evap_rhthrsh_ifs, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_evap_rhthrsh_ifs") + + call mpi_bcast(micro_mg_rainfreeze_ifs, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_rainfreeze_ifs") + + call mpi_bcast(micro_mg_ifs_sed, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ifs_sed") + + call mpi_bcast(micro_mg_precip_fall_corr, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_precip_fall_corr") + + call mpi_bcast(micro_mg_implicit_fall, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_implicit_fall") + + call mpi_bcast(micro_mg_accre_sees_auto, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_accre_sees_auto") + + if(micro_mg_berg_eff_factor == unset_r8) call endrun(sub//": FATAL: micro_mg_berg_eff_factor is not set") + if(micro_mg_accre_enhan_fact == unset_r8) call endrun(sub//": FATAL: micro_mg_accre_enhan_fact is not set") + if(micro_mg_autocon_fact == unset_r8) call endrun(sub//": FATAL: micro_mg_autocon_fact is not set") + if(micro_mg_autocon_nd_exp == unset_r8) call endrun(sub//": FATAL: micro_mg_autocon_nd_exp is not set") + if(micro_mg_autocon_lwp_exp == unset_r8) call endrun(sub//": FATAL: micro_mg_autocon_lwp_exp is not set") + if(micro_mg_homog_size == unset_r8) call endrun(sub//": FATAL: micro_mg_homog_size is not set") + if(micro_mg_vtrmi_factor == unset_r8) call endrun(sub//": FATAL: micro_mg_vtrmi_factor is not set") + if(micro_mg_vtrms_factor == unset_r8) call endrun(sub//": FATAL: micro_mg_vtrms_factor is not set") + if(micro_mg_effi_factor == unset_r8) call endrun(sub//": FATAL: micro_mg_effi_factor is not set") + if(micro_mg_iaccr_factor == unset_r8) call endrun(sub//": FATAL: micro_mg_iaccr_factor is not set") + if(micro_mg_max_nicons == unset_r8) call endrun(sub//": FATAL: micro_mg_max_nicons is not set") + + if (masterproc) then + + write(iulog,*) 'MG microphysics namelist:' + write(iulog,*) ' micro_mg_version = ', micro_mg_version + write(iulog,*) ' micro_mg_sub_version = ', micro_mg_sub_version + write(iulog,*) ' micro_mg_do_cldice = ', do_cldice + write(iulog,*) ' micro_mg_do_cldliq = ', do_cldliq + write(iulog,*) ' micro_mg_num_steps = ', num_steps + write(iulog,*) ' microp_uniform = ', microp_uniform + write(iulog,*) ' micro_mg_dcs = ', micro_mg_dcs + write(iulog,*) ' micro_mg_berg_eff_factor = ', micro_mg_berg_eff_factor + write(iulog,*) ' micro_mg_accre_enhan_fact = ', micro_mg_accre_enhan_fact + write(iulog,*) ' micro_mg_autocon_fact = ' , micro_mg_autocon_fact + write(iulog,*) ' micro_mg_autocon_nd_exp = ' , micro_mg_autocon_nd_exp + write(iulog,*) ' micro_mg_autocon_lwp_exp = ' , micro_mg_autocon_lwp_exp + write(iulog,*) ' micro_mg_homog_size = ', micro_mg_homog_size + write(iulog,*) ' micro_mg_vtrmi_factor = ', micro_mg_vtrmi_factor + write(iulog,*) ' micro_mg_vtrms_factor = ', micro_mg_vtrms_factor + write(iulog,*) ' micro_mg_effi_factor = ', micro_mg_effi_factor + write(iulog,*) ' micro_mg_iaccr_factor = ', micro_mg_iaccr_factor + write(iulog,*) ' micro_mg_max_nicons = ', micro_mg_max_nicons + write(iulog,*) ' micro_mg_precip_frac_method = ', micro_mg_precip_frac_method + write(iulog,*) ' micro_mg_warm_rain = ', micro_mg_warm_rain + write(iulog,*) ' micro_mg_adjust_cpt = ', micro_mg_adjust_cpt + write(iulog,*) ' micro_mg_nccons = ', micro_mg_nccons + write(iulog,*) ' micro_mg_nicons = ', micro_mg_nicons + write(iulog,*) ' micro_mg_ncnst = ', micro_mg_ncnst + write(iulog,*) ' micro_mg_ninst = ', micro_mg_ninst + write(iulog,*) ' micro_mg_ngcons = ', micro_mg_ngcons + write(iulog,*) ' micro_mg_ngnst = ', micro_mg_ngnst + write(iulog,*) ' micro_mg_do_hail = ', micro_mg_do_hail + write(iulog,*) ' micro_mg_do_graupel = ', micro_mg_do_graupel + write(iulog,*) ' micro_do_massless_droplet_destroyer = ', micro_do_massless_droplet_destroyer + write(iulog,*) ' micro_mg_nrcons = ', micro_mg_nrcons + write(iulog,*) ' micro_mg_nscons = ', micro_mg_nscons + write(iulog,*) ' micro_mg_nrnst = ', micro_mg_nrnst + write(iulog,*) ' micro_mg_nsnst = ', micro_mg_nsnst + write(iulog,*) ' micro_mg_evap_sed_off = ', micro_mg_evap_sed_off + write(iulog,*) ' micro_mg_icenuc_rh_off = ', micro_mg_icenuc_rh_off + write(iulog,*) ' micro_mg_icenuc_use_meyers = ', micro_mg_icenuc_use_meyers + write(iulog,*) ' micro_mg_evap_scl_ifs = ', micro_mg_evap_scl_ifs + write(iulog,*) ' micro_mg_evap_rhthrsh_ifs = ', micro_mg_evap_rhthrsh_ifs + write(iulog,*) ' micro_mg_rainfreeze_ifs = ', micro_mg_rainfreeze_ifs + write(iulog,*) ' micro_mg_ifs_sed = ', micro_mg_ifs_sed + write(iulog,*) ' micro_mg_precip_fall_corr = ', micro_mg_precip_fall_corr + write(iulog,*) ' micro_mg_implicit_fall = ', micro_mg_implicit_fall + write(iulog,*) ' micro_mg_accre_sees_auto = ', micro_mg_accre_sees_auto + end if + + ! Read in the emulated or tau namelist if needed + if( trim(micro_mg_warm_rain) == 'emulated') then + call stochastic_emulated_readnl(nlfile) + else if (trim(micro_mg_warm_rain) == 'tau') then + call stochastic_tau_readnl(nlfile) + end if + +contains + + subroutine bad_version_endrun + ! Endrun wrapper with a more useful error message. + character(len=128) :: errstring + write(errstring,*) "Invalid version number specified for MG microphysics: ", & + micro_mg_version,".",micro_mg_sub_version + call endrun(errstring) + end subroutine bad_version_endrun + +end subroutine micro_pumas_cam_readnl + +!================================================================================================ + +subroutine micro_pumas_cam_register + use cam_history_support, only: add_vert_coord, hist_dimension_values + use cam_abortutils, only: handle_allocate_error + + ! Register microphysics constituents and fields in the physics buffer. + !----------------------------------------------------------------------- + + logical :: prog_modal_aero + logical :: use_subcol_microp ! If true, then are using subcolumns in microphysics + logical :: found + + integer :: i, ierr + real(r8) :: all_levs(pver) + + allocate(trop_levs(pver-top_lev+1), stat=ierr) + call handle_allocate_error(ierr, 'micro_pumas_cam_register', 'trop_levs') + + call phys_getopts(use_subcol_microp_out = use_subcol_microp, & + prog_modal_aero_out = prog_modal_aero) + + ! Register microphysics constituents and save indices. + + call cnst_add(cnst_names(1), mwh2o, cpair, 0._r8, ixcldliq, & + longname='Grid box averaged cloud liquid amount', is_convtran1=.true.) + call cnst_add(cnst_names(2), mwh2o, cpair, 0._r8, ixcldice, & + longname='Grid box averaged cloud ice amount', is_convtran1=.true.) + + call cnst_add(cnst_names(3), mwh2o, cpair, 0._r8, ixnumliq, & + longname='Grid box averaged cloud liquid number', is_convtran1=.true.) + call cnst_add(cnst_names(4), mwh2o, cpair, 0._r8, ixnumice, & + longname='Grid box averaged cloud ice number', is_convtran1=.true.) + + ! Add history coordinate for DDT nlev + call hist_dimension_values('lev',all_levs, 1, pver, found) + + if (found) then + trop_levs(1:pver-top_lev+1) = all_levs(top_lev:pver) + call add_vert_coord('trop_cld_lev', pver-top_lev+1, & + 'troposphere hybrid level at midpoints (1000*(A+B))', 'hPa', trop_levs, & + positive='down' ) + else + call endrun( "micro_pumas_cam_register: unable to find dimension field 'lev'") + end if + + +! ---- Note is_convtran1 is set to .true. + call cnst_add(cnst_names(5), mwh2o, cpair, 0._r8, ixrain, & + longname='Grid box averaged rain amount', is_convtran1=.true.) + call cnst_add(cnst_names(6), mwh2o, cpair, 0._r8, ixsnow, & + longname='Grid box averaged snow amount', is_convtran1=.true.) + call cnst_add(cnst_names(7), mwh2o, cpair, 0._r8, ixnumrain, & + longname='Grid box averaged rain number', is_convtran1=.true.) + call cnst_add(cnst_names(8), mwh2o, cpair, 0._r8, ixnumsnow, & + longname='Grid box averaged snow number', is_convtran1=.true.) + + if (micro_mg_version > 2) then + call cnst_add(cnst_names(9), mwh2o, cpair, 0._r8, ixgraupel, & + longname='Grid box averaged graupel/hail amount', is_convtran1=.true.) + call cnst_add(cnst_names(10), mwh2o, cpair, 0._r8, ixnumgraupel, & + longname='Grid box averaged graupel/hail number', is_convtran1=.true.) + end if + + ! Request physics buffer space for fields that persist across timesteps. + + call pbuf_add_field('CLDO','global',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldo_idx) + + ! Physics buffer variables for convective cloud properties. + + call pbuf_add_field('QME', 'physpkg',dtype_r8,(/pcols,pver/), qme_idx) + call pbuf_add_field('PRAIN', 'physpkg',dtype_r8,(/pcols,pver/), prain_idx) + call pbuf_add_field('NEVAPR', 'physpkg',dtype_r8,(/pcols,pver/), nevapr_idx) + call pbuf_add_field('PRER_EVAP', 'global', dtype_r8,(/pcols,pver/), prer_evap_idx) + call pbuf_add_field('BERGSO', 'physpkg',dtype_r8,(/pcols,pver/), bergso_idx) + + call pbuf_add_field('WSEDL', 'physpkg',dtype_r8,(/pcols,pver/), wsedl_idx) + + call pbuf_add_field('REI', 'physpkg',dtype_r8,(/pcols,pver/), rei_idx) + call pbuf_add_field('SADICE', 'physpkg',dtype_r8,(/pcols,pver/), sadice_idx) + call pbuf_add_field('SADSNOW', 'physpkg',dtype_r8,(/pcols,pver/), sadsnow_idx) + call pbuf_add_field('REL', 'physpkg',dtype_r8,(/pcols,pver/), rel_idx) + + ! Mitchell ice effective diameter for radiation + call pbuf_add_field('DEI', 'physpkg',dtype_r8,(/pcols,pver/), dei_idx) + ! Size distribution shape parameter for radiation + call pbuf_add_field('MU', 'physpkg',dtype_r8,(/pcols,pver/), mu_idx) + ! Size distribution shape parameter for radiation + call pbuf_add_field('LAMBDAC', 'physpkg',dtype_r8,(/pcols,pver/), lambdac_idx) + + ! Stratiform only in cloud ice water path for radiation + call pbuf_add_field('ICIWPST', 'physpkg',dtype_r8,(/pcols,pver/), iciwpst_idx) + ! Stratiform in cloud liquid water path for radiation + call pbuf_add_field('ICLWPST', 'physpkg',dtype_r8,(/pcols,pver/), iclwpst_idx) + + ! Snow effective diameter for radiation + call pbuf_add_field('DES', 'physpkg',dtype_r8,(/pcols,pver/), des_idx) + ! In cloud snow water path for radiation + call pbuf_add_field('ICSWP', 'physpkg',dtype_r8,(/pcols,pver/), icswp_idx) + ! Cloud fraction for liquid drops + snow + call pbuf_add_field('CLDFSNOW ', 'physpkg',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldfsnow_idx) + + if (micro_mg_version > 2) then + ! Graupel effective diameter for radiation + call pbuf_add_field('DEGRAU', 'physpkg',dtype_r8,(/pcols,pver/), degrau_idx) + ! In cloud snow water path for radiation + call pbuf_add_field('ICGRAUWP', 'physpkg',dtype_r8,(/pcols,pver/), icgrauwp_idx) + ! Cloud fraction for liquid drops + graupel + call pbuf_add_field('CLDFGRAU', 'physpkg',dtype_r8,(/pcols,pver/), cldfgrau_idx) + end if + + if (prog_modal_aero) then + call pbuf_add_field('RATE1_CW2PR_ST','physpkg',dtype_r8,(/pcols,pver/), rate1_cw2pr_st_idx) + endif + + call pbuf_add_field('LS_FLXPRC', 'physpkg',dtype_r8,(/pcols,pverp/), ls_flxprc_idx) + call pbuf_add_field('LS_FLXSNW', 'physpkg',dtype_r8,(/pcols,pverp/), ls_flxsnw_idx) + + + ! Fields needed as inputs to COSP + call pbuf_add_field('LS_MRPRC', 'physpkg',dtype_r8,(/pcols,pver/), ls_mrprc_idx) + call pbuf_add_field('LS_MRSNW', 'physpkg',dtype_r8,(/pcols,pver/), ls_mrsnw_idx) + call pbuf_add_field('LS_REFFRAIN','physpkg',dtype_r8,(/pcols,pver/), ls_reffrain_idx) + call pbuf_add_field('LS_REFFSNOW','physpkg',dtype_r8,(/pcols,pver/), ls_reffsnow_idx) + call pbuf_add_field('CV_REFFLIQ', 'physpkg',dtype_r8,(/pcols,pver/), cv_reffliq_idx) + call pbuf_add_field('CV_REFFICE', 'physpkg',dtype_r8,(/pcols,pver/), cv_reffice_idx) + + ! CC_* Fields needed by Park macrophysics + call pbuf_add_field('CC_T', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_t_idx) + call pbuf_add_field('CC_qv', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qv_idx) + call pbuf_add_field('CC_ql', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_ql_idx) + call pbuf_add_field('CC_qi', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qi_idx) + call pbuf_add_field('CC_nl', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_nl_idx) + call pbuf_add_field('CC_ni', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_ni_idx) + call pbuf_add_field('CC_qlst', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qlst_idx) + + ! Fields for UNICON + call pbuf_add_field('am_evp_st', 'global', dtype_r8, (/pcols,pver/), am_evp_st_idx) + call pbuf_add_field('evprain_st', 'global', dtype_r8, (/pcols,pver/), evprain_st_idx) + call pbuf_add_field('evpsnow_st', 'global', dtype_r8, (/pcols,pver/), evpsnow_st_idx) + + ! Register subcolumn pbuf fields + if (use_subcol_microp) then + ! Global pbuf fields + call pbuf_register_subcol('CLDO', 'micro_pumas_cam_register', cldo_idx) + + ! CC_* Fields needed by Park macrophysics + call pbuf_register_subcol('CC_T', 'micro_pumas_cam_register', cc_t_idx) + call pbuf_register_subcol('CC_qv', 'micro_pumas_cam_register', cc_qv_idx) + call pbuf_register_subcol('CC_ql', 'micro_pumas_cam_register', cc_ql_idx) + call pbuf_register_subcol('CC_qi', 'micro_pumas_cam_register', cc_qi_idx) + call pbuf_register_subcol('CC_nl', 'micro_pumas_cam_register', cc_nl_idx) + call pbuf_register_subcol('CC_ni', 'micro_pumas_cam_register', cc_ni_idx) + call pbuf_register_subcol('CC_qlst', 'micro_pumas_cam_register', cc_qlst_idx) + + ! Physpkg pbuf fields + ! Physics buffer variables for convective cloud properties. + + call pbuf_register_subcol('QME', 'micro_pumas_cam_register', qme_idx) + call pbuf_register_subcol('PRAIN', 'micro_pumas_cam_register', prain_idx) + call pbuf_register_subcol('NEVAPR', 'micro_pumas_cam_register', nevapr_idx) + call pbuf_register_subcol('PRER_EVAP', 'micro_pumas_cam_register', prer_evap_idx) + call pbuf_register_subcol('BERGSO', 'micro_pumas_cam_register', bergso_idx) + + call pbuf_register_subcol('WSEDL', 'micro_pumas_cam_register', wsedl_idx) + + call pbuf_register_subcol('REI', 'micro_pumas_cam_register', rei_idx) + call pbuf_register_subcol('SADICE', 'micro_pumas_cam_register', sadice_idx) + call pbuf_register_subcol('SADSNOW', 'micro_pumas_cam_register', sadsnow_idx) + call pbuf_register_subcol('REL', 'micro_pumas_cam_register', rel_idx) + + ! Mitchell ice effective diameter for radiation + call pbuf_register_subcol('DEI', 'micro_pumas_cam_register', dei_idx) + ! Size distribution shape parameter for radiation + call pbuf_register_subcol('MU', 'micro_pumas_cam_register', mu_idx) + ! Size distribution shape parameter for radiation + call pbuf_register_subcol('LAMBDAC', 'micro_pumas_cam_register', lambdac_idx) + + ! Stratiform only in cloud ice water path for radiation + call pbuf_register_subcol('ICIWPST', 'micro_pumas_cam_register', iciwpst_idx) + ! Stratiform in cloud liquid water path for radiation + call pbuf_register_subcol('ICLWPST', 'micro_pumas_cam_register', iclwpst_idx) + + ! Snow effective diameter for radiation + call pbuf_register_subcol('DES', 'micro_pumas_cam_register', des_idx) + ! In cloud snow water path for radiation + call pbuf_register_subcol('ICSWP', 'micro_pumas_cam_register', icswp_idx) + ! Cloud fraction for liquid drops + snow + call pbuf_register_subcol('CLDFSNOW ', 'micro_pumas_cam_register', cldfsnow_idx) + + if (micro_mg_version > 2) then + ! Graupel effective diameter for radiation + call pbuf_register_subcol('DEGRAU', 'micro_pumas_cam_register', degrau_idx) + ! In cloud snow water path for radiation + call pbuf_register_subcol('ICGRAUWP', 'micro_pumas_cam_register', icgrauwp_idx) + ! Cloud fraction for liquid drops + snow + call pbuf_register_subcol('CLDFGRAU', 'micro_pumas_cam_register', cldfgrau_idx) + end if + + if (prog_modal_aero) then + call pbuf_register_subcol('RATE1_CW2PR_ST', 'micro_pumas_cam_register', rate1_cw2pr_st_idx) + end if + + call pbuf_register_subcol('LS_FLXPRC', 'micro_pumas_cam_register', ls_flxprc_idx) + call pbuf_register_subcol('LS_FLXSNW', 'micro_pumas_cam_register', ls_flxsnw_idx) + + ! Fields needed as inputs to COSP + call pbuf_register_subcol('LS_MRPRC', 'micro_pumas_cam_register', ls_mrprc_idx) + call pbuf_register_subcol('LS_MRSNW', 'micro_pumas_cam_register', ls_mrsnw_idx) + call pbuf_register_subcol('LS_REFFRAIN', 'micro_pumas_cam_register', ls_reffrain_idx) + call pbuf_register_subcol('LS_REFFSNOW', 'micro_pumas_cam_register', ls_reffsnow_idx) + call pbuf_register_subcol('CV_REFFLIQ', 'micro_pumas_cam_register', cv_reffliq_idx) + call pbuf_register_subcol('CV_REFFICE', 'micro_pumas_cam_register', cv_reffice_idx) + end if + + ! Additional pbuf for CARMA interface + if (.not. do_cldice) then + call pbuf_add_field('TND_QSNOW', 'physpkg',dtype_r8,(/pcols,pver/), tnd_qsnow_idx) + call pbuf_add_field('TND_NSNOW', 'physpkg',dtype_r8,(/pcols,pver/), tnd_nsnow_idx) + call pbuf_add_field('RE_ICE', 'physpkg',dtype_r8,(/pcols,pver/), re_ice_idx) + end if + + ! Precipitation efficiency fields across timesteps. + call pbuf_add_field('ACPRECL', 'global',dtype_r8,(/pcols/), acpr_idx) ! accumulated precip + call pbuf_add_field('ACGCME', 'global',dtype_r8,(/pcols/), acgcme_idx) ! accumulated condensation + call pbuf_add_field('ACNUM', 'global',dtype_i4,(/pcols/), acnum_idx) ! counter for accumulated # timesteps + + ! SGS variability -- These could be reset by CLUBB so they need to be grid only + call pbuf_add_field('RELVAR', 'global',dtype_r8,(/pcols,pver/), relvar_idx) + call pbuf_add_field('ACCRE_ENHAN','global',dtype_r8,(/pcols,pver/), accre_enhan_idx) + + ! Diagnostic fields needed for subcol_SILHS, need to be grid-only + if (subcol_get_scheme() == 'SILHS') then + call pbuf_add_field('QRAIN', 'global',dtype_r8,(/pcols,pver/), qrain_idx) + call pbuf_add_field('QSNOW', 'global',dtype_r8,(/pcols,pver/), qsnow_idx) + call pbuf_add_field('NRAIN', 'global',dtype_r8,(/pcols,pver/), nrain_idx) + call pbuf_add_field('NSNOW', 'global',dtype_r8,(/pcols,pver/), nsnow_idx) + + ! Fields for subcol_SILHS hole filling + ! Note -- hole filling is on the grid, so pbuf_register_setcols do not need to be called for these pbuf fields + call pbuf_add_field('QCSEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qcsedten_idx) + call pbuf_add_field('QRSEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qrsedten_idx) + call pbuf_add_field('QISEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qisedten_idx) + call pbuf_add_field('QSSEDTEN', 'physpkg', dtype_r8, (/pcols,pver/), qssedten_idx) + call pbuf_add_field('VTRMC', 'physpkg', dtype_r8, (/pcols,pver/), vtrmc_idx) + call pbuf_add_field('UMR', 'physpkg', dtype_r8, (/pcols,pver/), umr_idx) + call pbuf_add_field('VTRMI', 'physpkg', dtype_r8, (/pcols,pver/), vtrmi_idx) + call pbuf_add_field('UMS', 'physpkg', dtype_r8, (/pcols,pver/), ums_idx) + call pbuf_add_field('QCSEVAP', 'physpkg', dtype_r8, (/pcols,pver/), qcsevap_idx) + call pbuf_add_field('QISEVAP', 'physpkg', dtype_r8, (/pcols,pver/), qisevap_idx) + end if + +end subroutine micro_pumas_cam_register + +!=============================================================================== + +function micro_pumas_cam_implements_cnst(name) + + ! Return true if specified constituent is implemented by the + ! microphysics package + + character(len=*), intent(in) :: name ! constituent name + logical :: micro_pumas_cam_implements_cnst ! return value + + !----------------------------------------------------------------------- + + micro_pumas_cam_implements_cnst = any(name == cnst_names) + +end function micro_pumas_cam_implements_cnst + +!=============================================================================== + +subroutine micro_pumas_cam_init_cnst(name, latvals, lonvals, mask, q) + + ! Initialize the microphysics constituents, if they are + ! not read from the initial file. + + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol) + real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol) + logical, intent(in) :: mask(:) ! Only initialize where .true. + real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev + !----------------------------------------------------------------------- + integer :: k + + if (micro_pumas_cam_implements_cnst(name)) then + do k = 1, size(q, 2) + where(mask) + q(:, k) = 0.0_r8 + end where + end do + end if + +end subroutine micro_pumas_cam_init_cnst + +!=============================================================================== + +subroutine micro_pumas_cam_init(pbuf2d) + use time_manager, only: is_first_step + use micro_pumas_utils, only: micro_pumas_utils_init + use micro_pumas_v1, only: micro_mg_init3_0 => micro_pumas_init + use stochastic_tau_cam, only: stochastic_tau_init_cam + use stochastic_emulated_cam, only: stochastic_emulated_init_cam + + !----------------------------------------------------------------------- + ! + ! Initialization for MG microphysics + ! + !----------------------------------------------------------------------- + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: m, mm + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: history_budget ! Output tendencies and state variables for CAM4 + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. + logical :: use_subcol_microp + logical :: do_clubb_sgs + integer :: budget_histfile ! output history file number for budget fields + integer :: ierr + character(128) :: errstring ! return status (non-blank for error return) + + character(len=cl) :: stochastic_emulated_filename_quantile, stochastic_emulated_filename_input_scale, & + stochastic_emulated_filename_output_scale + + !----------------------------------------------------------------------- + + call phys_getopts(use_subcol_microp_out=use_subcol_microp, & + do_clubb_sgs_out =do_clubb_sgs) + + if (do_clubb_sgs) then + allow_sed_supersat = .false. + else + allow_sed_supersat = .true. + endif + + if (masterproc) then + write(iulog,"(A,I2,A,I2)") "Initializing MG version ",micro_mg_version,".",micro_mg_sub_version + if (.not. do_cldliq) & + write(iulog,*) "MG prognostic cloud liquid has been turned off via namelist." + if (.not. do_cldice) & + write(iulog,*) "MG prognostic cloud ice has been turned off via namelist." + write(iulog,*) "Number of microphysics substeps is: ",num_steps + end if + + ! Set constituent number for later loops. + if(micro_mg_version == 2) then + ncnst = 8 + else + ncnst = 10 + end if + + ! If Machine learning is turned on, perform its initializations + if (trim(micro_mg_warm_rain) == 'tau') then + call stochastic_tau_init_cam() + else if( trim(micro_mg_warm_rain) == 'emulated') then + call stochastic_emulated_init_cam(stochastic_emulated_filename_quantile, & + stochastic_emulated_filename_input_scale, & + stochastic_emulated_filename_output_scale) + end if + + call micro_mg_init3_0( & + r8, gravit, rair, rh2o, cpair, & + tmelt, latvap, latice, rhmini, & + micro_mg_dcs, & + micro_mg_do_hail,micro_mg_do_graupel, & + microp_uniform, do_cldice, use_hetfrz_classnuc, & + micro_mg_precip_frac_method, micro_mg_berg_eff_factor, & + micro_mg_accre_enhan_fact , & + micro_mg_autocon_fact , micro_mg_autocon_nd_exp, micro_mg_autocon_lwp_exp, micro_mg_homog_size, & + micro_mg_vtrmi_factor, micro_mg_vtrms_factor, micro_mg_effi_factor, & + micro_mg_iaccr_factor, micro_mg_max_nicons, & + allow_sed_supersat, micro_mg_warm_rain, & + micro_mg_evap_sed_off, micro_mg_icenuc_rh_off, micro_mg_icenuc_use_meyers, & + micro_mg_evap_scl_ifs, micro_mg_evap_rhthrsh_ifs, & + micro_mg_rainfreeze_ifs, micro_mg_ifs_sed, micro_mg_precip_fall_corr,& + micro_mg_accre_sees_auto, micro_mg_implicit_fall, & + micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, & + micro_mg_ninst, micro_mg_ngcons, micro_mg_ngnst, & + micro_mg_nrcons, micro_mg_nrnst, micro_mg_nscons, micro_mg_nsnst, & + stochastic_emulated_filename_quantile, stochastic_emulated_filename_input_scale, & + stochastic_emulated_filename_output_scale, iulog, errstring) + + call handle_errmsg(errstring, subname="micro_pumas_cam_init") + + ! Retrieve the index for water vapor + call cnst_get_ind('Q', ixq) + + ! Register history variables + do m = 1, ncnst + call cnst_get_ind(cnst_names(m), mm) + if ( any(mm == (/ ixcldliq, ixcldice, ixrain, ixsnow, ixgraupel /)) ) then + ! mass mixing ratios + call addfld(cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(mm), sampled_on_subcycle=.true.) + call addfld(sflxnam(mm), horiz_only, 'A', 'kg/m2/s', trim(cnst_name(mm))//' surface flux', sampled_on_subcycle=.true.) + else if ( any(mm == (/ ixnumliq, ixnumice, ixnumrain, ixnumsnow, ixnumgraupel /)) ) then + ! number concentrations + call addfld(cnst_name(mm), (/ 'lev' /), 'A', '1/kg', cnst_longname(mm), sampled_on_subcycle=.true.) + call addfld(sflxnam(mm), horiz_only, 'A', '1/m2/s', trim(cnst_name(mm))//' surface flux', sampled_on_subcycle=.true.) + else + call endrun( "micro_pumas_cam_init: & + &Could not call addfld for constituent with unknown units.") + endif + end do + + call addfld(apcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' after physics', sampled_on_subcycle=.true.) + call addfld(apcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' after physics', sampled_on_subcycle=.true.) + call addfld(bpcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' before physics', sampled_on_subcycle=.true.) + call addfld(bpcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' before physics', sampled_on_subcycle=.true.) + + call addfld(apcnst(ixrain), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixrain))//' after physics', sampled_on_subcycle=.true.) + call addfld(apcnst(ixsnow), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' after physics', sampled_on_subcycle=.true.) + call addfld(bpcnst(ixrain), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixrain))//' before physics', sampled_on_subcycle=.true.) + call addfld(bpcnst(ixsnow), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' before physics', sampled_on_subcycle=.true.) + + if (micro_mg_version > 2) then + call addfld(apcnst(ixgraupel), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixgraupel))//' after physics', sampled_on_subcycle=.true.) + call addfld(bpcnst(ixgraupel), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixgraupel))//' before physics', sampled_on_subcycle=.true.) + end if + + call addfld ('CME', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap within the cloud', sampled_on_subcycle=.true.) + call addfld ('PRODPREC', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of conversion of condensate to precip', sampled_on_subcycle=.true.) + call addfld ('EVAPPREC', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling precip', sampled_on_subcycle=.true.) + call addfld ('EVAPSNOW', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling snow', sampled_on_subcycle=.true.) + call addfld ('HPROGCLD', (/ 'lev' /), 'A', 'W/kg' , 'Heating from prognostic clouds', sampled_on_subcycle=.true.) + call addfld ('FICE', (/ 'lev' /), 'A', 'fraction', 'Fractional ice content within cloud', sampled_on_subcycle=.true.) + call addfld ('CLDFSNOW', (/ 'lev' /), 'A', '1', 'Cloud fraction adjusted for snow', sampled_on_subcycle=.true.) + call addfld ('ICWMRST', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-stratus water mixing ratio', sampled_on_subcycle=.true.) + call addfld ('ICIMRST', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-stratus ice mixing ratio', sampled_on_subcycle=.true.) + + ! MG microphysics diagnostics + call addfld ('QCSEVAP', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling cloud water', sampled_on_subcycle=.true.) + call addfld ('QISEVAP', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Rate of sublimation of falling cloud ice', sampled_on_subcycle=.true.) + call addfld ('QVRES', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Rate of residual condensation term', sampled_on_subcycle=.true.) + call addfld ('CMEIOUT', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Rate of deposition/sublimation of cloud ice',sampled_on_subcycle=.true.) + call addfld ('VTRMC', (/ 'trop_cld_lev' /), 'A', 'm/s', 'Mass-weighted cloud water fallspeed', sampled_on_subcycle=.true.) + call addfld ('VTRMI', (/ 'trop_cld_lev' /), 'A', 'm/s', 'Mass-weighted cloud ice fallspeed', sampled_on_subcycle=.true.) + call addfld ('QCSEDTEN', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Cloud water mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.) + call addfld ('QISEDTEN', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Cloud ice mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.) + call addfld ('PRAO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud water by rain', sampled_on_subcycle=.true.) + call addfld ('PRCO', (/ 'lev' /), 'A', 'kg/kg/s', 'Autoconversion of cloud water', sampled_on_subcycle=.true.) + call addfld ('MNUCCCO', (/ 'lev' /), 'A', 'kg/kg/s', 'Immersion freezing of cloud water', sampled_on_subcycle=.true.) + call addfld ('MNUCCTO', (/ 'lev' /), 'A', 'kg/kg/s', 'Contact freezing of cloud water', sampled_on_subcycle=.true.) + call addfld ('MNUCCDO', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Homogeneous and heterogeneous nucleation from vapor', sampled_on_subcycle=.true.) + call addfld ('MNUCCDOhet', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous nucleation from vapor', sampled_on_subcycle=.true.) + call addfld ('MSACWIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water from rime-splintering', sampled_on_subcycle=.true.) + call addfld ('PSACWSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud water by snow', sampled_on_subcycle=.true.) + call addfld ('BERGSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water to snow from bergeron', sampled_on_subcycle=.true.) + call addfld ('BERGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water to cloud ice from bergeron',sampled_on_subcycle=.true.) + call addfld ('MELTO', (/ 'lev' /), 'A', 'kg/kg/s', 'Melting of cloud ice', sampled_on_subcycle=.true.) + call addfld ('MELTSTOT', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Melting of snow', sampled_on_subcycle=.true.) + call addfld ('MNUDEPO', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Deposition Nucleation', sampled_on_subcycle=.true.) + call addfld ('HOMOO', (/ 'lev' /), 'A', 'kg/kg/s', 'Homogeneous freezing of cloud water', sampled_on_subcycle=.true.) + call addfld ('QCRESO', (/ 'lev' /), 'A', 'kg/kg/s', 'Residual condensation term for cloud water', sampled_on_subcycle=.true.) + call addfld ('PRCIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Autoconversion of cloud ice to snow', sampled_on_subcycle=.true.) + call addfld ('PRAIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud ice to snow', sampled_on_subcycle=.true.) + call addfld ('QIRESO', (/ 'lev' /), 'A', 'kg/kg/s', 'Residual deposition term for cloud ice', sampled_on_subcycle=.true.) + call addfld ('MNUCCRO', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Heterogeneous freezing of rain to snow', sampled_on_subcycle=.true.) + call addfld ('MNUCCRIO', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Heterogeneous freezing of rain to ice', sampled_on_subcycle=.true.) + call addfld ('PRACSO', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Accretion of rain by snow', sampled_on_subcycle=.true.) + call addfld ('VAPDEPSO', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Vapor deposition onto snow', sampled_on_subcycle=.true.) + call addfld ('MELTSDT', (/ 'trop_cld_lev' /), 'A', 'W/kg', 'Latent heating rate due to melting of snow', sampled_on_subcycle=.true.) + call addfld ('FRZRDT', (/ 'trop_cld_lev' /), 'A', 'W/kg', 'Latent heating rate due to homogeneous freezing of rain', sampled_on_subcycle=.true.) + call addfld ('QRSEDTEN', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Rain mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.) + call addfld ('QSSEDTEN', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Snow mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.) + call addfld ('NNUCCCO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Immersion freezing of cloud water', sampled_on_subcycle=.true.) + call addfld ('NNUCCTO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Contact freezing of cloud water', sampled_on_subcycle=.true.) + call addfld ('NNUCCDO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Ice nucleation', sampled_on_subcycle=.true.) + call addfld ('NNUDEPO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Deposition Nucleation', sampled_on_subcycle=.true.) + call addfld ('NHOMO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Homogeneous freezing of cloud water', sampled_on_subcycle=.true.) + call addfld ('NNUCCRO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to heterogeneous freezing of rain to snow', sampled_on_subcycle=.true.) + call addfld ('NNUCCRIO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Heterogeneous freezing of rain to ice', sampled_on_subcycle=.true.) + call addfld ('NSACWIO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Ice Multiplication- Rime-splintering', sampled_on_subcycle=.true.) + call addfld ('NPRAO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Accretion of cloud water by rain', sampled_on_subcycle=.true.) + call addfld ('NPSACWSO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Accretion of cloud water by snow', sampled_on_subcycle=.true.) + call addfld ('NPRAIO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Accretion of cloud ice to snow', sampled_on_subcycle=.true.) + call addfld ('NPRACSO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Accretion of rain by snow', sampled_on_subcycle=.true.) + call addfld ('NPRCO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Autoconversion of cloud water [to rain]', sampled_on_subcycle=.true.) + call addfld ('NPRCIO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Autoconversion of cloud ice to snow', sampled_on_subcycle=.true.) + call addfld ('NCSEDTEN', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to cloud liquid sedimentation', sampled_on_subcycle=.true.) + call addfld ('NISEDTEN', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to cloud ice sedimentation', sampled_on_subcycle=.true.) + call addfld ('NRSEDTEN', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to rain sedimentation', sampled_on_subcycle=.true.) + call addfld ('NSSEDTEN', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to snow sedimentation', sampled_on_subcycle=.true.) + call addfld ('NMELTO', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Melting of cloud ice', sampled_on_subcycle=.true.) + call addfld ('NMELTS', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Melting of snow', sampled_on_subcycle=.true.) + + if (trim(micro_mg_warm_rain) == 'kk2000') then + call addfld ('qctend_KK2000', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'cloud liquid mass tendency due to autoconversion & accretion from KK2000', sampled_on_subcycle=.true.) + call addfld ('nctend_KK2000', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'cloud number mass tendency due to autoconversion & accretion from KK2000', sampled_on_subcycle=.true.) + call addfld ('qrtend_KK2000', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'rain mass tendency due to autoconversion & accretion from KK2000', sampled_on_subcycle=.true.) + call addfld ('nrtend_KK2000', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'rain number tendency due to autoconversion & accretion from KK2000', sampled_on_subcycle=.true.) + end if + if (trim(micro_mg_warm_rain) == 'sb2001') then + call addfld ('qctend_SB2001', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'cloud liquid mass tendency due to autoconversion & accretion from SB2001', sampled_on_subcycle=.true.) + call addfld ('nctend_SB2001', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'cloud liquid number tendency due to autoconversion & accretion from SB2001',sampled_on_subcycle=.true.) + call addfld ('qrtend_SB2001', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'rain mass tendency due to autoconversion & accretion from SB2001', sampled_on_subcycle=.true.) + call addfld ('nrtend_SB2001', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'rain number tendency due to autoconversion & accretion from SB2001', sampled_on_subcycle=.true.) + end if + call addfld ('LAMC', (/ 'trop_cld_lev' /), 'A', 'unitless', 'Size distribution parameter lambda for liquid', sampled_on_subcycle=.true. ) + call addfld ('LAMR', (/ 'trop_cld_lev' /), 'A', 'unitless', 'Size distribution parameter lambda for rain', sampled_on_subcycle=.true.) + call addfld ('PGAM', (/ 'trop_cld_lev' /), 'A', 'unitless', 'Size distribution parameter mu (pgam) for liquid', sampled_on_subcycle=.true.) + call addfld ('N0R', (/ 'trop_cld_lev' /), 'A', 'unitless', 'Size distribution parameter n0 for rain', sampled_on_subcycle=.true.) + + if (micro_mg_version > 2) then + call addfld ('NMELTG', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to Melting of graupel', sampled_on_subcycle=.true.) + call addfld ('NGSEDTEN', (/ 'trop_cld_lev' /), 'A', '#/kg/s', 'Number Tendency due to graupel sedimentation', sampled_on_subcycle=.true.) + call addfld ('PSACRO', (/ 'lev' /), 'A', 'kg/kg/s', 'Collisions between rain & snow (Graupel collecting snow)',sampled_on_subcycle=.true.) + call addfld ('PRACGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change in q collection rain by graupel', sampled_on_subcycle=.true.) + call addfld ('PSACWGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Change in q collection droplets by graupel', sampled_on_subcycle=.true.) + call addfld ('PGSACWO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q conversion to graupel due to collection droplets by snow', sampled_on_subcycle=.true.) + call addfld ('PGRACSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q conversion to graupel due to collection rain by snow', sampled_on_subcycle=.true.) + call addfld ('PRDGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Deposition of graupel', sampled_on_subcycle=.true.) + call addfld ('QMULTGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q change due to ice mult droplets/graupel', sampled_on_subcycle=.true.) + call addfld ('QMULTRGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Q change due to ice mult rain/graupel', sampled_on_subcycle=.true.) + call addfld ('QGSEDTEN', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Graupel/Hail mixing ratio tendency from sedimentation', sampled_on_subcycle=.true.) + call addfld ('NPRACGO', (/ 'lev' /), 'A', '#/kg/s', 'Change N collection rain by graupel', sampled_on_subcycle=.true.) + call addfld ('NSCNGO', (/ 'lev' /), 'A', '#/kg/s', 'Change N conversion to graupel due to collection droplets by snow', sampled_on_subcycle=.true.) + call addfld ('NGRACSO', (/ 'lev' /), 'A', '#/kg/s', 'Change N conversion to graupel due to collection rain by snow', sampled_on_subcycle=.true.) + call addfld ('NMULTGO', (/ 'lev' /), 'A', '#/kg/s', 'Ice mult due to acc droplets by graupel', sampled_on_subcycle=.true.) + call addfld ('NMULTRGO', (/ 'lev' /), 'A', '#/kg/s', 'Ice mult due to acc rain by graupel', sampled_on_subcycle=.true.) + call addfld ('NPSACWGO', (/ 'lev' /), 'A', '#/kg/s', 'Change N collection droplets by graupel', sampled_on_subcycle=.true.) + call addfld ('CLDFGRAU', (/ 'lev' /), 'A', '1', 'Cloud fraction adjusted for graupel', sampled_on_subcycle=.true.) + call addfld ('MELTGTOT', (/ 'trop_cld_lev' /), 'A', 'kg/kg/s', 'Melting of graupel', sampled_on_subcycle=.true.) + + end if + + call addfld ('RBFRAC', horiz_only, 'A', 'Fraction', 'Fraction of sky covered by a potential rainbow', sampled_on_subcycle=.true.) + call addfld ('RBFREQ', horiz_only, 'A', 'Frequency', 'Potential rainbow frequency', sampled_on_subcycle=.true.) + call addfld( 'rbSZA', horiz_only, 'I', 'degrees', 'solar zenith angle', sampled_on_subcycle=.true.) + + ! History variables for CAM5 microphysics + call addfld ('MPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDNLIQ', (/ 'lev' /), 'A', '1/kg/s', 'NUMLIQ tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDNICE', (/ 'lev' /), 'A', '1/kg/s', 'NUMICE tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDW2V', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Vapor tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDW2I', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Ice tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDW2P', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Precip tendency - Morrison microphysics',sampled_on_subcycle=.true.) + call addfld ('MPDI2V', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Vapor tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDI2W', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Water tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('MPDI2P', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Precip tendency - Morrison microphysics', sampled_on_subcycle=.true.) + call addfld ('ICWNC', (/ 'lev' /), 'A', 'm-3', 'Prognostic in-cloud water number conc', sampled_on_subcycle=.true.) + call addfld ('ICINC', (/ 'lev' /), 'A', 'm-3', 'Prognostic in-cloud ice number conc', sampled_on_subcycle=.true.) + call addfld ('EFFLIQ_IND', (/ 'lev' /), 'A','Micron', 'Prognostic droplet effective radius (indirect effect)', sampled_on_subcycle=.true.) + call addfld ('CDNUMC', horiz_only, 'A', '1/m2', 'Vertically-integrated droplet concentration', sampled_on_subcycle=.true.) + call addfld ('MPICLWPI', horiz_only, 'A', 'kg/m2', 'Vertically-integrated & + &in-cloud Initial Liquid WP (Before Micro)', sampled_on_subcycle=.true.) + call addfld ('MPICIWPI', horiz_only, 'A', 'kg/m2', 'Vertically-integrated & + &in-cloud Initial Ice WP (Before Micro)', sampled_on_subcycle=.true.) + + ! This is provided as an example on how to write out subcolumn output + ! NOTE -- only 'I' should be used for sub-column fields as subc-columns could shift from time-step to time-step + if (use_subcol_microp) then + call addfld('FICE_SCOL', (/'psubcols','lev '/), 'I', 'fraction', & + 'Sub-column fractional ice content within cloud', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) + call addfld('MPDICE_SCOL', (/'psubcols','lev '/), 'I', 'kg/kg/s', & + 'Sub-column CLDICE tendency - Morrison microphysics', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) + call addfld('MPDLIQ_SCOL', (/'psubcols','lev '/), 'I', 'kg/kg/s', & + 'Sub-column CLDLIQ tendency - Morrison microphysics', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) + end if + + + ! This is only if the coldpoint temperatures are being adjusted. + ! NOTE: Some fields related to these and output later are added in tropopause.F90. + if (micro_mg_adjust_cpt) then + call addfld ('TROPF_TADJ', (/ 'lev' /), 'A', 'K', 'Temperatures after cold point adjustment', sampled_on_subcycle=.true.) + call addfld ('TROPF_RHADJ', (/ 'lev' /), 'A', 'K', 'Relative Hunidity after cold point adjustment', sampled_on_subcycle=.true.) + call addfld ('TROPF_CDT', horiz_only, 'A', 'K', 'Cold point temperature adjustment', sampled_on_subcycle=.true.) + call addfld ('TROPF_CDZ', horiz_only, 'A', 'm', 'Distance of coldpoint from coldest model level',sampled_on_subcycle=.true.) + end if + + + ! Averaging for cloud particle number and size + call addfld ('AWNC', (/ 'lev' /), 'A', 'm-3', 'Average cloud water number conc', sampled_on_subcycle=.true.) + call addfld ('AWNI', (/ 'lev' /), 'A', 'm-3', 'Average cloud ice number conc', sampled_on_subcycle=.true.) + call addfld ('AREL', (/ 'lev' /), 'A', 'Micron', 'Average droplet effective radius', sampled_on_subcycle=.true.) + call addfld ('AREI', (/ 'lev' /), 'A', 'Micron', 'Average ice effective radius', sampled_on_subcycle=.true.) + ! Frequency arrays for above + call addfld ('FREQL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of liquid', sampled_on_subcycle=.true.) + call addfld ('FREQI', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of ice', sampled_on_subcycle=.true.) + + ! Average cloud top particle size and number (liq, ice) and frequency + call addfld ('ACTREL', horiz_only, 'A', 'Micron', 'Average Cloud Top droplet effective radius', sampled_on_subcycle=.true.) + call addfld ('ACTREI', horiz_only, 'A', 'Micron', 'Average Cloud Top ice effective radius', sampled_on_subcycle=.true.) + call addfld ('ACTNL', horiz_only, 'A', 'm-3', 'Average Cloud Top droplet number', sampled_on_subcycle=.true.) + call addfld ('ACTNI', horiz_only, 'A', 'm-3', 'Average Cloud Top ice number', sampled_on_subcycle=.true.) + + call addfld ('FCTL', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top liquid', sampled_on_subcycle=.true.) + call addfld ('FCTI', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top ice', sampled_on_subcycle=.true.) + + ! New frequency arrays for mixed phase and supercooled liquid (only and mixed) for (a) Cloud Top and (b) everywhere.. + call addfld ('FREQM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of mixed phase', sampled_on_subcycle=.true.) + call addfld ('FREQSL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of only supercooled liquid', sampled_on_subcycle=.true.) + call addfld ('FREQSLM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of super cooled liquid with ice', sampled_on_subcycle=.true.) + call addfld ('FCTM', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top mixed phase', sampled_on_subcycle=.true.) + call addfld ('FCTSL', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top only supercooled liquid', sampled_on_subcycle=.true.) + call addfld ('FCTSLM', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top super cooled liquid with ice', sampled_on_subcycle=.true.) + + call addfld ('LS_FLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface rain+snow flux', sampled_on_subcycle=.true.) + call addfld ('LS_FLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface snow flux', sampled_on_subcycle=.true.) + + call addfld ('REL', (/ 'lev' /), 'A', 'micron', 'MG REL stratiform cloud effective radius liquid', sampled_on_subcycle=.true.) + call addfld ('REI', (/ 'lev' /), 'A', 'micron', 'MG REI stratiform cloud effective radius ice', sampled_on_subcycle=.true.) + call addfld ('LS_REFFRAIN', (/ 'lev' /), 'A', 'micron', 'ls stratiform rain effective radius', sampled_on_subcycle=.true.) + call addfld ('LS_REFFSNOW', (/ 'lev' /), 'A', 'micron', 'ls stratiform snow effective radius', sampled_on_subcycle=.true.) + call addfld ('CV_REFFLIQ', (/ 'lev' /), 'A', 'micron', 'convective cloud liq effective radius', sampled_on_subcycle=.true.) + call addfld ('CV_REFFICE', (/ 'lev' /), 'A', 'micron', 'convective cloud ice effective radius', sampled_on_subcycle=.true.) + call addfld ('MG_SADICE', (/ 'lev' /), 'A', 'cm2/cm3', 'MG surface area density ice', sampled_on_subcycle=.true.) + call addfld ('MG_SADSNOW', (/ 'lev' /), 'A', 'cm2/cm3', 'MG surface area density snow', sampled_on_subcycle=.true.) + + ! diagnostic precip + call addfld ('QRAIN', (/ 'lev' /), 'A', 'kg/kg', 'Diagnostic grid-mean rain mixing ratio', sampled_on_subcycle=.true.) + call addfld ('QSNOW', (/ 'lev' /), 'A', 'kg/kg', 'Diagnostic grid-mean snow mixing ratio', sampled_on_subcycle=.true.) + call addfld ('NRAIN', (/ 'lev' /), 'A', 'm-3', 'Diagnostic grid-mean rain number conc', sampled_on_subcycle=.true.) + call addfld ('NSNOW', (/ 'lev' /), 'A', 'm-3', 'Diagnostic grid-mean snow number conc', sampled_on_subcycle=.true.) + + ! size of precip + call addfld ('RERCLD', (/ 'lev' /), 'A', 'm', 'Diagnostic effective radius of Liquid Cloud and Rain', sampled_on_subcycle=.true.) + call addfld ('DSNOW', (/ 'lev' /), 'A', 'm', 'Diagnostic grid-mean snow diameter', sampled_on_subcycle=.true.) + + ! diagnostic radar reflectivity, cloud-averaged + call addfld ('REFL', (/ 'lev' /), 'A', 'DBz', '94 GHz radar reflectivity', sampled_on_subcycle=.true.) + call addfld ('AREFL', (/ 'lev' /), 'A', 'DBz', 'Average 94 GHz radar reflectivity', sampled_on_subcycle=.true.) + call addfld ('FREFL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of radar reflectivity', sampled_on_subcycle=.true.) + + call addfld ('CSRFL', (/ 'lev' /), 'A', 'DBz', '94 GHz radar reflectivity (CloudSat thresholds)', sampled_on_subcycle=.true.) + call addfld ('ACSRFL', (/ 'lev' /), 'A', 'DBz', 'Average 94 GHz radar reflectivity (CloudSat thresholds)', sampled_on_subcycle=.true.) + call addfld ('FCSRFL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of radar reflectivity (CloudSat thresholds)', sampled_on_subcycle=.true.) + + call addfld ('AREFLZ', (/ 'lev' /), 'A', 'mm^6/m^3', 'Average 94 GHz radar reflectivity', sampled_on_subcycle=.true.) + + ! 10cm (rain) radar reflectivity + call addfld ('REFL10CM', (/ 'lev' /), 'A', 'DBz', '10cm (Rain) radar reflectivity (Dbz)', sampled_on_subcycle=.true.) + call addfld ('REFLZ10CM', (/ 'lev' /), 'A', 'mm^6/m^3', '10cm (Rain) radar reflectivity (Z units)', sampled_on_subcycle=.true.) + + ! Aerosol information + call addfld ('NCAL', (/ 'lev' /), 'A', '1/m3', 'Number Concentation Activated for Liquid', sampled_on_subcycle=.true.) + call addfld ('NCAI', (/ 'lev' /), 'A', '1/m3', 'Number Concentation Activated for Ice', sampled_on_subcycle=.true.) + + ! Average rain and snow mixing ratio (Q), number (N) and diameter (D), with frequency + call addfld ('AQRAIN', (/ 'lev' /), 'A', 'kg/kg', 'Average rain mixing ratio', sampled_on_subcycle=.true.) + call addfld ('AQSNOW', (/ 'lev' /), 'A', 'kg/kg', 'Average snow mixing ratio', sampled_on_subcycle=.true.) + call addfld ('ANRAIN', (/ 'lev' /), 'A', 'm-3', 'Average rain number conc', sampled_on_subcycle=.true.) + call addfld ('ANSNOW', (/ 'lev' /), 'A', 'm-3', 'Average snow number conc', sampled_on_subcycle=.true.) + call addfld ('ADRAIN', (/ 'lev' /), 'A', 'm', 'Average rain effective Diameter', sampled_on_subcycle=.true.) + call addfld ('ADSNOW', (/ 'lev' /), 'A', 'm', 'Average snow effective Diameter', sampled_on_subcycle=.true.) + call addfld ('FREQR', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of rain', sampled_on_subcycle=.true.) + call addfld ('FREQS', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of snow', sampled_on_subcycle=.true.) + + ! precipitation efficiency & other diagnostic fields + call addfld('PE' , horiz_only, 'A', '1', 'Stratiform Precipitation Efficiency (precip/cmeliq)', sampled_on_subcycle=.true.) + call addfld('APRL' , horiz_only, 'A', 'm/s', 'Average Stratiform Precip Rate over efficiency calculation', sampled_on_subcycle=.true.) + call addfld('PEFRAC', horiz_only, 'A', '1', 'Fraction of timesteps precip efficiency reported', sampled_on_subcycle=.true.) + call addfld('VPRCO' , horiz_only, 'A', 'kg/kg/s', 'Vertical average of autoconversion rate', sampled_on_subcycle=.true.) + call addfld('VPRAO' , horiz_only, 'A', 'kg/kg/s', 'Vertical average of accretion rate', sampled_on_subcycle=.true.) + call addfld('RACAU' , horiz_only, 'A', 'kg/kg/s', 'Accretion/autoconversion ratio from vertical average', sampled_on_subcycle=.true.) + + call addfld('UMR', (/ 'trop_cld_lev' /), 'A', 'm/s', 'Mass-weighted rain fallspeed', sampled_on_subcycle=.true.) + call addfld('UMS', (/ 'trop_cld_lev' /), 'A', 'm/s', 'Mass-weighted snow fallspeed', sampled_on_subcycle=.true.) + + if (micro_mg_version > 2) then + call addfld('UMG', (/ 'trop_cld_lev' /), 'A', 'm/s', 'Mass-weighted graupel/hail fallspeed', sampled_on_subcycle=.true.) + call addfld ('FREQG', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of Graupel', sampled_on_subcycle=.true.) + call addfld ('LS_REFFGRAU', (/ 'lev' /), 'A', 'micron', 'ls stratiform graupel/hail effective radius', sampled_on_subcycle=.true.) + call addfld ('AQGRAU', (/ 'lev' /), 'A', 'kg/kg', 'Average graupel/hail mixing ratio', sampled_on_subcycle=.true.) + call addfld ('ANGRAU', (/ 'lev' /), 'A', 'm-3', 'Average graupel/hail number conc', sampled_on_subcycle=.true.) + end if + + + ! qc limiter (only output in versions 1.5 and later) + call addfld('QCRAT', (/ 'lev' /), 'A', 'fraction', 'Qc Limiter: Fraction of qc tendency applied', sampled_on_subcycle=.true.) + + ! determine the add_default fields + call phys_getopts(history_amwg_out = history_amwg , & + history_budget_out = history_budget , & + history_budget_histfile_num_out = budget_histfile) + + if (history_amwg) then + call add_default ('FICE ', 1, ' ') + call add_default ('AQRAIN ', 1, ' ') + call add_default ('AQSNOW ', 1, ' ') + call add_default ('ANRAIN ', 1, ' ') + call add_default ('ANSNOW ', 1, ' ') + call add_default ('ADRAIN ', 1, ' ') + call add_default ('ADSNOW ', 1, ' ') + call add_default ('AREI ', 1, ' ') + call add_default ('AREL ', 1, ' ') + call add_default ('AWNC ', 1, ' ') + call add_default ('AWNI ', 1, ' ') + call add_default ('CDNUMC ', 1, ' ') + call add_default ('FREQR ', 1, ' ') + call add_default ('FREQS ', 1, ' ') + call add_default ('FREQL ', 1, ' ') + call add_default ('FREQI ', 1, ' ') + do m = 1, ncnst + call cnst_get_ind(cnst_names(m), mm) + call add_default(cnst_name(mm), 1, ' ') + end do + end if + + if ( history_budget ) then + call add_default ('EVAPSNOW ', budget_histfile, ' ') + call add_default ('EVAPPREC ', budget_histfile, ' ') + call add_default ('QVRES ', budget_histfile, ' ') + call add_default ('QISEVAP ', budget_histfile, ' ') + call add_default ('QCSEVAP ', budget_histfile, ' ') + call add_default ('QISEDTEN ', budget_histfile, ' ') + call add_default ('QCSEDTEN ', budget_histfile, ' ') + call add_default ('QIRESO ', budget_histfile, ' ') + call add_default ('QCRESO ', budget_histfile, ' ') + call add_default ('QRSEDTEN ', budget_histfile, ' ') + call add_default ('QSSEDTEN ', budget_histfile, ' ') + call add_default ('PSACWSO ', budget_histfile, ' ') + call add_default ('PRCO ', budget_histfile, ' ') + call add_default ('PRCIO ', budget_histfile, ' ') + call add_default ('PRAO ', budget_histfile, ' ') + call add_default ('PRAIO ', budget_histfile, ' ') + call add_default ('PRACSO ', budget_histfile, ' ') + call add_default ('VAPDEPSO ', budget_histfile, ' ') + call add_default ('MSACWIO ', budget_histfile, ' ') + call add_default ('MPDW2V ', budget_histfile, ' ') + call add_default ('MPDW2P ', budget_histfile, ' ') + call add_default ('MPDW2I ', budget_histfile, ' ') + call add_default ('MPDT ', budget_histfile, ' ') + call add_default ('MPDQ ', budget_histfile, ' ') + call add_default ('MPDLIQ ', budget_histfile, ' ') + call add_default ('MPDICE ', budget_histfile, ' ') + call add_default ('MPDI2W ', budget_histfile, ' ') + call add_default ('MPDI2V ', budget_histfile, ' ') + call add_default ('MPDI2P ', budget_histfile, ' ') + call add_default ('MNUCCTO ', budget_histfile, ' ') + call add_default ('MNUCCRO ', budget_histfile, ' ') + call add_default ('MNUCCRIO ', budget_histfile, ' ') + call add_default ('MNUCCCO ', budget_histfile, ' ') + call add_default ('MELTSDT ', budget_histfile, ' ') + call add_default ('MELTO ', budget_histfile, ' ') + call add_default ('HOMOO ', budget_histfile, ' ') + call add_default ('FRZRDT ', budget_histfile, ' ') + call add_default ('CMEIOUT ', budget_histfile, ' ') + call add_default ('BERGSO ', budget_histfile, ' ') + call add_default ('BERGO ', budget_histfile, ' ') + call add_default ('MELTSTOT ', budget_histfile, ' ') + call add_default ('MNUDEPO ', budget_histfile, ' ') + call add_default ('NNUCCCO ', budget_histfile, ' ') + call add_default ('NNUCCTO ', budget_histfile, ' ') + call add_default ('NNUCCDO ', budget_histfile, ' ') + call add_default ('NNUDEPO ', budget_histfile, ' ') + call add_default ('NHOMO ', budget_histfile, ' ') + call add_default ('NNUCCRO ', budget_histfile, ' ') + call add_default ('NNUCCRIO ', budget_histfile, ' ') + call add_default ('NSACWIO ', budget_histfile, ' ') + call add_default ('NPRAO ', budget_histfile, ' ') + call add_default ('NPSACWSO ', budget_histfile, ' ') + call add_default ('NPRAIO ', budget_histfile, ' ') + call add_default ('NPRACSO ', budget_histfile, ' ') + call add_default ('NPRCO ', budget_histfile, ' ') + call add_default ('NPRCIO ', budget_histfile, ' ') + call add_default ('NCSEDTEN ', budget_histfile, ' ') + call add_default ('NISEDTEN ', budget_histfile, ' ') + call add_default ('NRSEDTEN ', budget_histfile, ' ') + call add_default ('NSSEDTEN ', budget_histfile, ' ') + call add_default ('NMELTO ', budget_histfile, ' ') + call add_default ('NMELTS ', budget_histfile, ' ') + call add_default ('NCAL ', budget_histfile, ' ') + if (micro_mg_version > 2) then + call add_default ('QGSEDTEN ', budget_histfile, ' ') + call add_default ('PSACRO ', budget_histfile, ' ') + call add_default ('PRACGO ', budget_histfile, ' ') + call add_default ('PSACWGO ', budget_histfile, ' ') + call add_default ('PGSACWO ', budget_histfile, ' ') + call add_default ('PGRACSO ', budget_histfile, ' ') + call add_default ('PRDGO ', budget_histfile, ' ') + call add_default ('QMULTGO ', budget_histfile, ' ') + call add_default ('QMULTRGO ', budget_histfile, ' ') + call add_default ('MELTGTOT ', budget_histfile, ' ') + call add_default ('NPRACGO ', budget_histfile, ' ') + call add_default ('NSCNGO ', budget_histfile, ' ') + call add_default ('NGRACSO ', budget_histfile, ' ') + call add_default ('NMULTGO ', budget_histfile, ' ') + call add_default ('NMULTRGO ', budget_histfile, ' ') + call add_default ('NPSACWGO ', budget_histfile, ' ') + call add_default ('NGSEDTEN ', budget_histfile, ' ') + call add_default ('NMELTG ', budget_histfile, ' ') + end if + call add_default(cnst_name(ixcldliq), budget_histfile, ' ') + call add_default(cnst_name(ixcldice), budget_histfile, ' ') + call add_default(apcnst (ixcldliq), budget_histfile, ' ') + call add_default(apcnst (ixcldice), budget_histfile, ' ') + call add_default(bpcnst (ixcldliq), budget_histfile, ' ') + call add_default(bpcnst (ixcldice), budget_histfile, ' ') + call add_default(cnst_name(ixrain), budget_histfile, ' ') + call add_default(cnst_name(ixsnow), budget_histfile, ' ') + call add_default(apcnst (ixrain), budget_histfile, ' ') + call add_default(apcnst (ixsnow), budget_histfile, ' ') + call add_default(bpcnst (ixrain), budget_histfile, ' ') + call add_default(bpcnst (ixsnow), budget_histfile, ' ') + + if (micro_mg_version > 2) then + call add_default(cnst_name(ixgraupel), budget_histfile, ' ') + call add_default(apcnst (ixgraupel), budget_histfile, ' ') + call add_default(bpcnst (ixgraupel), budget_histfile, ' ') + end if + + end if + + ! physics buffer indices + ast_idx = pbuf_get_index('AST') + cld_idx = pbuf_get_index('CLD') + concld_idx = pbuf_get_index('CONCLD') + prec_dp_idx = pbuf_get_index('PREC_DP') + prec_sh_idx = pbuf_get_index('PREC_SH') + + naai_idx = pbuf_get_index('NAAI') + naai_hom_idx = pbuf_get_index('NAAI_HOM') + npccn_idx = pbuf_get_index('NPCCN') + rndst_idx = pbuf_get_index('RNDST') + nacon_idx = pbuf_get_index('NACON') + + prec_str_idx = pbuf_get_index('PREC_STR') + snow_str_idx = pbuf_get_index('SNOW_STR') + prec_sed_idx = pbuf_get_index('PREC_SED') + snow_sed_idx = pbuf_get_index('SNOW_SED') + prec_pcw_idx = pbuf_get_index('PREC_PCW') + snow_pcw_idx = pbuf_get_index('SNOW_PCW') + + cmeliq_idx = pbuf_get_index('CMELIQ') + + ! These fields may have been added, so don't abort if they have not been + qsatfac_idx = pbuf_get_index('QSATFAC', ierr) + qrain_idx = pbuf_get_index('QRAIN', ierr) + qsnow_idx = pbuf_get_index('QSNOW', ierr) + nrain_idx = pbuf_get_index('NRAIN', ierr) + nsnow_idx = pbuf_get_index('NSNOW', ierr) + + ! fields for heterogeneous freezing + frzimm_idx = pbuf_get_index('FRZIMM', ierr) + frzcnt_idx = pbuf_get_index('FRZCNT', ierr) + frzdep_idx = pbuf_get_index('FRZDEP', ierr) + + ! Initialize physics buffer grid fields for accumulating precip and condensation + if (is_first_step()) then + call pbuf_set_field(pbuf2d, cldo_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_t_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_qv_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_ql_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_qi_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_nl_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_ni_idx, 0._r8) + call pbuf_set_field(pbuf2d, cc_qlst_idx,0._r8) + call pbuf_set_field(pbuf2d, acpr_idx, 0._r8) + call pbuf_set_field(pbuf2d, acgcme_idx, 0._r8) + call pbuf_set_field(pbuf2d, acnum_idx, 0) + call pbuf_set_field(pbuf2d, relvar_idx, 2._r8) + call pbuf_set_field(pbuf2d, accre_enhan_idx, 1._r8) + call pbuf_set_field(pbuf2d, am_evp_st_idx, 0._r8) + call pbuf_set_field(pbuf2d, evprain_st_idx, 0._r8) + call pbuf_set_field(pbuf2d, evpsnow_st_idx, 0._r8) + call pbuf_set_field(pbuf2d, prer_evap_idx, 0._r8) + call pbuf_set_field(pbuf2d, bergso_idx, 0._r8) + call pbuf_set_field(pbuf2d, icswp_idx, 0._r8) + call pbuf_set_field(pbuf2d, cldfsnow_idx, 0._r8) + call pbuf_set_field(pbuf2d, dei_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, des_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, mu_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, lambdac_idx, 0.0_r8) + + if (degrau_idx > 0) call pbuf_set_field(pbuf2d, degrau_idx, 0.0_r8) + if (icgrauwp_idx > 0) call pbuf_set_field(pbuf2d, icgrauwp_idx, 0.0_r8) + if (qrain_idx > 0) call pbuf_set_field(pbuf2d, qrain_idx, 0._r8) + if (qsnow_idx > 0) call pbuf_set_field(pbuf2d, qsnow_idx, 0._r8) + if (nrain_idx > 0) call pbuf_set_field(pbuf2d, nrain_idx, 0._r8) + if (nsnow_idx > 0) call pbuf_set_field(pbuf2d, nsnow_idx, 0._r8) + if (qcsedten_idx > 0) call pbuf_set_field(pbuf2d, qcsedten_idx, 0._r8) + if (qrsedten_idx > 0) call pbuf_set_field(pbuf2d, qrsedten_idx, 0._r8) + if (qisedten_idx > 0) call pbuf_set_field(pbuf2d, qisedten_idx, 0._r8) + if (qssedten_idx > 0) call pbuf_set_field(pbuf2d, qssedten_idx, 0._r8) + if (vtrmc_idx > 0) call pbuf_set_field(pbuf2d, vtrmc_idx, 0._r8) + if (umr_idx > 0) call pbuf_set_field(pbuf2d, umr_idx, 0._r8) + if (vtrmi_idx > 0) call pbuf_set_field(pbuf2d, vtrmi_idx, 0._r8) + if (ums_idx > 0) call pbuf_set_field(pbuf2d, ums_idx, 0._r8) + if (qcsevap_idx > 0) call pbuf_set_field(pbuf2d, qcsevap_idx, 0._r8) + if (qisevap_idx > 0) call pbuf_set_field(pbuf2d, qisevap_idx, 0._r8) + + ! If sub-columns turned on, need to set the sub-column fields as well + if (use_subcol_microp) then + call pbuf_set_field(pbuf2d, cldo_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_t_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_qv_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_ql_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_qi_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_nl_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_ni_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cc_qlst_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, icswp_idx, 0._r8, col_type=col_type_subcol) + call pbuf_set_field(pbuf2d, cldfsnow_idx,0._r8, col_type=col_type_subcol) + end if + + end if + +end subroutine micro_pumas_cam_init + +!=============================================================================== + +subroutine micro_pumas_cam_tend(state, ptend, dtime, pbuf) + + use micro_pumas_utils, only: size_dist_param_basic, size_dist_param_liq + use micro_pumas_utils, only: mg_liq_props, mg_ice_props, avg_diameter + use micro_pumas_utils, only: rhoi, rhosn, rhow, rhows, rhog, qsmall, mincld + + use micro_pumas_v1, only: micro_pumas_tend + + use physics_buffer, only: pbuf_col_type_index + use subcol, only: subcol_field_avg + use tropopause, only: tropopause_find_cam, TROP_ALG_CPP, TROP_ALG_NONE, NOTFOUND + use wv_saturation, only: qsat + use infnan, only: nan, assignment(=) + use cam_abortutils, only: handle_allocate_error + + use stochastic_tau_cam, only: ncd + + type(physics_state), intent(in) :: state + type(physics_ptend), intent(out) :: ptend + real(r8), intent(in) :: dtime + type(physics_buffer_desc), pointer :: pbuf(:) + + ! Local variables + + type(proc_rates_type) :: proc_rates + + integer :: lchnk, ncol, psetcols, ngrdcol + + integer :: i, k, itim_old, it + + real(r8), parameter :: micron2meter = 1.e6_r8 + real(r8), parameter :: shapeparam = 1.e5_r8 + + real(r8), pointer :: naai(:,:) ! ice nucleation number + real(r8), pointer :: naai_hom(:,:) ! ice nucleation number (homogeneous) + real(r8), pointer :: npccn(:,:) ! liquid activation number tendency + real(r8), pointer :: rndst(:,:,:) + real(r8), pointer :: nacon(:,:,:) + real(r8), pointer :: am_evp_st_grid(:,:) ! Evaporation area of stratiform precipitation. 0<= am_evp_st <=1. + real(r8), pointer :: evprain_st_grid(:,:) ! Evaporation rate of stratiform rain [kg/kg/s] + real(r8), pointer :: evpsnow_st_grid(:,:) ! Evaporation rate of stratiform snow [kg/kg/s] + + real(r8), pointer :: prec_str(:) ! [Total] Sfc flux of precip from stratiform [ m/s ] + real(r8), pointer :: snow_str(:) ! [Total] Sfc flux of snow from stratiform [ m/s ] + real(r8), pointer :: prec_sed(:) ! Surface flux of total cloud water from sedimentation + real(r8), pointer :: snow_sed(:) ! Surface flux of cloud ice from sedimentation + real(r8), pointer :: prec_pcw(:) ! Sfc flux of precip from microphysics [ m/s ] + real(r8), pointer :: snow_pcw(:) ! Sfc flux of snow from microphysics [ m/s ] + + real(r8), pointer :: ast(:,:) ! Relative humidity cloud fraction + real(r8), pointer :: qsatfac(:,:) ! Subgrid cloud water saturation scaling factor. + real(r8), pointer :: alst_mic(:,:) + real(r8), pointer :: aist_mic(:,:) + real(r8), pointer :: cldo(:,:) ! Old cloud fraction + real(r8), pointer :: nevapr(:,:) ! Evaporation of total precipitation (rain + snow) + real(r8), pointer :: prer_evap(:,:) ! precipitation evaporation rate + real(r8), pointer :: relvar(:,:) ! relative variance of cloud water + real(r8), pointer :: accre_enhan(:,:) ! optional accretion enhancement for experimentation + real(r8), pointer :: prain(:,:) ! Total precipitation (rain + snow) + real(r8), pointer :: dei(:,:) ! Ice effective diameter (meters) + real(r8), pointer :: mu(:,:) ! Size distribution shape parameter for radiation + real(r8), pointer :: lambdac(:,:) ! Size distribution slope parameter for radiation + real(r8), pointer :: des(:,:) ! Snow effective diameter (m) + real(r8), pointer :: degrau(:,:) ! Graupel effective diameter (m) + real(r8), pointer :: bergstot(:,:) ! Conversion of cloud water to snow from bergeron + + real(r8) :: rho(state%psetcols,pver) + real(r8) :: cldmax(state%psetcols,pver) + + real(r8) :: rate1cld(state%psetcols,pver) ! array to hold rate1ord_cw2pr_st from microphysics + + real(r8) :: tlat(state%psetcols,pver) + real(r8) :: qvlat(state%psetcols,pver) + real(r8) :: qcten(state%psetcols,pver) + real(r8) :: qiten(state%psetcols,pver) + real(r8) :: ncten(state%psetcols,pver) + real(r8) :: niten(state%psetcols,pver) + + real(r8) :: qrten(state%psetcols,pver) + real(r8) :: qsten(state%psetcols,pver) + real(r8) :: nrten(state%psetcols,pver) + real(r8) :: nsten(state%psetcols,pver) + real(r8) :: qgten(state%psetcols,pver) + real(r8) :: ngten(state%psetcols,pver) + + real(r8) :: prect(state%psetcols) + real(r8) :: preci(state%psetcols) + real(r8) :: am_evp_st(state%psetcols,pver) ! Area over which precip evaporates + real(r8) :: cmeice(state%psetcols,pver) ! Rate of cond-evap of ice within the cloud + real(r8) :: qsout(state%psetcols,pver) ! Snow mixing ratio + real(r8) :: cflx(state%psetcols,pverp) ! grid-box avg liq condensate flux (kg m^-2 s^-1) + real(r8) :: iflx(state%psetcols,pverp) ! grid-box avg ice condensate flux (kg m^-2 s^-1) + real(r8) :: rflx(state%psetcols,pverp) ! grid-box average rain flux (kg m^-2 s^-1) + real(r8) :: sflx(state%psetcols,pverp) ! grid-box average snow flux (kg m^-2 s^-1) + real(r8) :: gflx(state%psetcols,pverp) ! grid-box average snow flux (kg m^-2 s^-1) + real(r8) :: qrout(state%psetcols,pver) ! Rain mixing ratio + + real(r8) :: nrout(state%psetcols,pver) + real(r8) :: nsout(state%psetcols,pver) + real(r8) :: refl(state%psetcols,pver) ! analytic radar reflectivity + real(r8) :: arefl(state%psetcols,pver) ! average reflectivity will zero points outside valid range + real(r8) :: areflz(state%psetcols,pver) ! average reflectivity in z. + real(r8) :: frefl(state%psetcols,pver) + real(r8) :: csrfl(state%psetcols,pver) ! cloudsat reflectivity + real(r8) :: acsrfl(state%psetcols,pver) ! cloudsat average + real(r8) :: fcsrfl(state%psetcols,pver) + real(r8) :: refl10cm(state%psetcols,pver) ! analytic radar reflectivity + real(r8) :: reflz10cm(state%psetcols,pver) ! analytic radar reflectivity Z + real(r8) :: rercld(state%psetcols,pver) ! effective radius calculation for rain + cloud + real(r8) :: ncai(state%psetcols,pver) ! output number conc of ice nuclei available (1/m3) + real(r8) :: ncal(state%psetcols,pver) ! output number conc of CCN (1/m3) + real(r8) :: qrout2(state%psetcols,pver) + real(r8) :: qsout2(state%psetcols,pver) + real(r8) :: nrout2(state%psetcols,pver) + real(r8) :: nsout2(state%psetcols,pver) + real(r8) :: freqs(state%psetcols,pver) + real(r8) :: freqr(state%psetcols,pver) + real(r8) :: nfice(state%psetcols,pver) + real(r8) :: qcrat(state%psetcols,pver) ! qc limiter ratio (1=no limit) + +!Hail/Graupel Output + real(r8) :: freqg(state%psetcols,pver) + real(r8) :: qgout(state%psetcols,pver) + real(r8) :: ngout(state%psetcols,pver) + real(r8) :: dgout(state%psetcols,pver) + real(r8) :: qgout2(state%psetcols,pver) + real(r8) :: ngout2(state%psetcols,pver) + real(r8) :: dgout2(state%psetcols,pver) + + ! Dummy arrays for cases where we throw away the MG version and + ! recalculate sizes on the CAM grid to avoid time/subcolumn averaging + ! issues. + real(r8) :: rel_fn_dum(state%ncol,pver) + real(r8) :: dsout2_dum(state%ncol,pver) + real(r8) :: drout_dum(state%ncol,pver) + real(r8) :: reff_rain_dum(state%ncol,pver) + real(r8) :: reff_snow_dum(state%ncol,pver) + real(r8) :: reff_grau_dum(state%ncol,pver) !not used for now or passed to COSP. + real(r8), target :: nan_array(state%ncol,pver) ! Array for NaN's + + ! Heterogeneous-only version of mnuccdtot. + real(r8) :: mnuccdohet(state%psetcols,pver) + + ! physics buffer fields for COSP simulator + real(r8), pointer :: mgflxprc(:,:) ! MG grid-box mean flux_large_scale_cloud_rain+snow at interfaces (kg/m2/s) + real(r8), pointer :: mgflxsnw(:,:) ! MG grid-box mean flux_large_scale_cloud_snow at interfaces (kg/m2/s) + real(r8), pointer :: mgmrprc(:,:) ! MG grid-box mean mixingratio_large_scale_cloud_rain+snow at interfaces (kg/kg) + real(r8), pointer :: mgmrsnw(:,:) ! MG grid-box mean mixingratio_large_scale_cloud_snow at interfaces (kg/kg) + real(r8), pointer :: mgreffrain_grid(:,:) ! MG diagnostic rain effective radius (um) + real(r8), pointer :: mgreffsnow_grid(:,:) ! MG diagnostic snow effective radius (um) + real(r8), pointer :: cvreffliq(:,:) ! convective cloud liquid effective radius (um) + real(r8), pointer :: cvreffice(:,:) ! convective cloud ice effective radius (um) + + ! physics buffer fields used with CARMA + real(r8), pointer, dimension(:,:) :: tnd_qsnow ! external tendency on snow mass (kg/kg/s) + real(r8), pointer, dimension(:,:) :: tnd_nsnow ! external tendency on snow number(#/kg/s) + real(r8), pointer, dimension(:,:) :: re_ice ! ice effective radius (m) + + real(r8), pointer :: rate1ord_cw2pr_st(:,:) ! 1st order rate for direct conversion of + ! strat. cloud water to precip (1/s) ! rce 2010/05/01 + real(r8), pointer :: wsedl(:,:) ! Sedimentation velocity of liquid stratus cloud droplet [ m/s ] + + + real(r8), pointer :: CC_T(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_qv(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_ql(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_qi(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_nl(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_ni(:,:) ! Grid-mean microphysical tendency + real(r8), pointer :: CC_qlst(:,:) ! In-liquid stratus microphysical tendency + + ! variables for heterogeneous freezing + real(r8), pointer :: frzimm(:,:) + real(r8), pointer :: frzcnt(:,:) + real(r8), pointer :: frzdep(:,:) + + real(r8), pointer :: qme(:,:) + + ! A local copy of state is used for diagnostic calculations + type(physics_state) :: state_loc + type(physics_ptend) :: ptend_loc + + real(r8) :: icecldf(state%psetcols,pver) ! Ice cloud fraction + real(r8) :: liqcldf(state%psetcols,pver) ! Liquid cloud fraction (combined into cloud) + + real(r8), pointer :: rel(:,:) ! Liquid effective drop radius (microns) + real(r8), pointer :: rei(:,:) ! Ice effective drop size (microns) + real(r8), pointer :: sadice(:,:) ! Ice surface area density (cm2/cm3) + real(r8), pointer :: sadsnow(:,:) ! Snow surface area density (cm2/cm3) + + + real(r8), pointer :: cmeliq(:,:) + + real(r8), pointer :: cld(:,:) ! Total cloud fraction + real(r8), pointer :: concld(:,:) ! Convective cloud fraction + real(r8), pointer :: prec_dp(:) ! Deep Convective precip + real(r8), pointer :: prec_sh(:) ! Shallow Convective precip + + real(r8), pointer :: iciwpst(:,:) ! Stratiform in-cloud ice water path for radiation + real(r8), pointer :: iclwpst(:,:) ! Stratiform in-cloud liquid water path for radiation + real(r8), pointer :: cldfsnow(:,:) ! Cloud fraction for liquid+snow + real(r8), pointer :: icswp(:,:) ! In-cloud snow water path + + real(r8), pointer :: cldfgrau(:,:) ! Cloud fraction for liquid+snow + real(r8), pointer :: icgrauwp(:,:) ! In-cloud snow water path + + real(r8) :: icimrst(state%psetcols,pver) ! In stratus ice mixing ratio + real(r8) :: icwmrst(state%psetcols,pver) ! In stratus water mixing ratio + real(r8) :: icinc(state%psetcols,pver) ! In cloud ice number conc + real(r8) :: icwnc(state%psetcols,pver) ! In cloud water number conc + + real(r8) :: iclwpi(state%psetcols) ! Vertically-integrated in-cloud Liquid WP before microphysics + real(r8) :: iciwpi(state%psetcols) ! Vertically-integrated in-cloud Ice WP before microphysics + + ! Averaging arrays for effective radius and number.... + real(r8) :: efiout_grid(pcols,pver) + real(r8) :: efcout_grid(pcols,pver) + real(r8) :: ncout_grid(pcols,pver) + real(r8) :: niout_grid(pcols,pver) + real(r8) :: freqi_grid(pcols,pver) + real(r8) :: freql_grid(pcols,pver) + +! Averaging arrays for supercooled liquid + real(r8) :: freqm_grid(pcols,pver) + real(r8) :: freqsl_grid(pcols,pver) + real(r8) :: freqslm_grid(pcols,pver) + real(r8) :: fctm_grid(pcols) + real(r8) :: fctsl_grid(pcols) + real(r8) :: fctslm_grid(pcols) + + real(r8) :: cdnumc_grid(pcols) ! Vertically-integrated droplet concentration + real(r8) :: icimrst_grid_out(pcols,pver) ! In stratus ice mixing ratio + real(r8) :: icwmrst_grid_out(pcols,pver) ! In stratus water mixing ratio + + ! Cloud fraction used for precipitation. + real(r8) :: cldmax_grid(pcols,pver) + + ! Average cloud top radius & number + real(r8) :: ctrel_grid(pcols) + real(r8) :: ctrei_grid(pcols) + real(r8) :: ctnl_grid(pcols) + real(r8) :: ctni_grid(pcols) + real(r8) :: fcti_grid(pcols) + real(r8) :: fctl_grid(pcols) + + real(r8) :: ftem_grid(pcols,pver) + + ! Variables for precip efficiency calculation + real(r8) :: minlwp ! LWP threshold + + real(r8), pointer, dimension(:) :: acprecl_grid ! accumulated precip across timesteps + real(r8), pointer, dimension(:) :: acgcme_grid ! accumulated condensation across timesteps + integer, pointer, dimension(:) :: acnum_grid ! counter for # timesteps accumulated + + ! Variables for liquid water path and column condensation + real(r8) :: tgliqwp_grid(pcols) ! column liquid + real(r8) :: tgcmeliq_grid(pcols) ! column condensation rate (units) + + real(r8) :: pe_grid(pcols) ! precip efficiency for output + real(r8) :: pefrac_grid(pcols) ! fraction of time precip efficiency is written out + real(r8) :: tpr_grid(pcols) ! average accumulated precipitation rate in pe calculation + + ! variables for autoconversion and accretion vertical averages + real(r8) :: vprco_grid(pcols) ! vertical average autoconversion + real(r8) :: vprao_grid(pcols) ! vertical average accretion + real(r8) :: racau_grid(pcols) ! ratio of vertical averages + integer :: cnt_grid(pcols) ! counters + + logical :: lq(pcnst) + + real(r8) :: icimrst_grid(pcols,pver) ! stratus ice mixing ratio - on grid + real(r8) :: icwmrst_grid(pcols,pver) ! stratus water mixing ratio - on grid + + real(r8), pointer :: lambdac_grid(:,:) + real(r8), pointer :: mu_grid(:,:) + real(r8), pointer :: rel_grid(:,:) + real(r8), pointer :: rei_grid(:,:) + real(r8), pointer :: sadice_grid(:,:) + real(r8), pointer :: sadsnow_grid(:,:) + real(r8), pointer :: dei_grid(:,:) + real(r8), pointer :: des_grid(:,:) + real(r8), pointer :: iclwpst_grid(:,:) + real(r8), pointer :: degrau_grid(:,:) + + real(r8) :: rho_grid(pcols,pver) + real(r8) :: liqcldf_grid(pcols,pver) + real(r8) :: qsout_grid(pcols,pver) + real(r8) :: ncic_grid(pcols,pver) + real(r8) :: niic_grid(pcols,pver) + real(r8) :: rel_fn_grid(pcols,pver) ! Ice effective drop size at fixed number (indirect effect) (microns) - on grid + real(r8) :: qrout_grid(pcols,pver) + real(r8) :: drout2_grid(pcols,pver) + real(r8) :: dsout2_grid(pcols,pver) + real(r8) :: nsout_grid(pcols,pver) + real(r8) :: nrout_grid(pcols,pver) + real(r8) :: reff_rain_grid(pcols,pver) + real(r8) :: reff_snow_grid(pcols,pver) + real(r8) :: reff_grau_grid(pcols,pver) + real(r8) :: cld_grid(pcols,pver) + real(r8) :: pdel_grid(pcols,pver) + real(r8) :: prco_grid(pcols,pver) + real(r8) :: prao_grid(pcols,pver) + real(r8) :: icecldf_grid(pcols,pver) + real(r8) :: icwnc_grid(pcols,pver) + real(r8) :: icinc_grid(pcols,pver) + real(r8) :: qcreso_grid(pcols,pver) + real(r8) :: melto_grid(pcols,pver) + real(r8) :: mnuccco_grid(pcols,pver) + real(r8) :: mnuccto_grid(pcols,pver) + real(r8) :: bergo_grid(pcols,pver) + real(r8) :: homoo_grid(pcols,pver) + real(r8) :: msacwio_grid(pcols,pver) + real(r8) :: psacwso_grid(pcols,pver) + real(r8) :: cmeiout_grid(pcols,pver) + real(r8) :: qireso_grid(pcols,pver) + real(r8) :: prcio_grid(pcols,pver) + real(r8) :: praio_grid(pcols,pver) + real(r8) :: psacro_grid(pcols,pver) + real(r8) :: pracgo_grid(pcols,pver) + real(r8) :: psacwgo_grid(pcols,pver) + real(r8) :: pgsacwo_grid(pcols,pver) + real(r8) :: pgracso_grid(pcols,pver) + real(r8) :: prdgo_grid(pcols,pver) + real(r8) :: qmultgo_grid(pcols,pver) + real(r8) :: qmultrgo_grid(pcols,pver) + real(r8) :: npracgo_grid(pcols,pver) + real(r8) :: nscngo_grid(pcols,pver) + real(r8) :: ngracso_grid(pcols,pver) + real(r8) :: nmultgo_grid(pcols,pver) + real(r8) :: nmultrgo_grid(pcols,pver) + real(r8) :: npsacwgo_grid(pcols,pver) + real(r8) :: qcsedtenout_grid(pcols,pver) + real(r8) :: qrsedtenout_grid(pcols,pver) + real(r8) :: qisedtenout_grid(pcols,pver) + real(r8) :: qssedtenout_grid(pcols,pver) + real(r8) :: vtrmcout_grid(pcols,pver) + real(r8) :: umrout_grid(pcols,pver) + real(r8) :: vtrmiout_grid(pcols,pver) + real(r8) :: umsout_grid(pcols,pver) + real(r8) :: qcsevapout_grid(pcols,pver) + real(r8) :: qisevapout_grid(pcols,pver) + + real(r8) :: nc_grid(pcols,pver) + real(r8) :: ni_grid(pcols,pver) + real(r8) :: qr_grid(pcols,pver) + real(r8) :: nr_grid(pcols,pver) + real(r8) :: qs_grid(pcols,pver) + real(r8) :: ns_grid(pcols,pver) + real(r8) :: qg_grid(pcols,pver) + real(r8) :: ng_grid(pcols,pver) + + real(r8) :: dgout2_grid(pcols,pver) + + real(r8) :: cp_rh(pcols,pver) + real(r8) :: cp_t(pcols) + real(r8) :: cp_z(pcols) + real(r8) :: cp_dt(pcols) + real(r8) :: cp_dz(pcols) + integer :: troplev(pcols) + real(r8) :: es + real(r8) :: qs + + real(r8) :: state_loc_graup(state%psetcols,pver) + real(r8) :: state_loc_numgraup(state%psetcols,pver) + + real(r8), pointer :: cmeliq_grid(:,:) + + real(r8), pointer :: prec_str_grid(:) + real(r8), pointer :: snow_str_grid(:) + real(r8), pointer :: prec_pcw_grid(:) + real(r8), pointer :: snow_pcw_grid(:) + real(r8), pointer :: prec_sed_grid(:) + real(r8), pointer :: snow_sed_grid(:) + real(r8), pointer :: cldo_grid(:,:) + real(r8), pointer :: nevapr_grid(:,:) + real(r8), pointer :: prain_grid(:,:) + real(r8), pointer :: mgflxprc_grid(:,:) + real(r8), pointer :: mgflxsnw_grid(:,:) + real(r8), pointer :: mgmrprc_grid(:,:) + real(r8), pointer :: mgmrsnw_grid(:,:) + real(r8), pointer :: cvreffliq_grid(:,:) + real(r8), pointer :: cvreffice_grid(:,:) + real(r8), pointer :: rate1ord_cw2pr_st_grid(:,:) + real(r8), pointer :: wsedl_grid(:,:) + real(r8), pointer :: CC_t_grid(:,:) + real(r8), pointer :: CC_qv_grid(:,:) + real(r8), pointer :: CC_ql_grid(:,:) + real(r8), pointer :: CC_qi_grid(:,:) + real(r8), pointer :: CC_nl_grid(:,:) + real(r8), pointer :: CC_ni_grid(:,:) + real(r8), pointer :: CC_qlst_grid(:,:) + real(r8), pointer :: qme_grid(:,:) + real(r8), pointer :: iciwpst_grid(:,:) + real(r8), pointer :: icswp_grid(:,:) + real(r8), pointer :: ast_grid(:,:) + real(r8), pointer :: cldfsnow_grid(:,:) + real(r8), pointer :: bergso_grid(:,:) + + real(r8), pointer :: icgrauwp_grid(:,:) + real(r8), pointer :: cldfgrau_grid(:,:) + + real(r8), pointer :: qrout_grid_ptr(:,:) + real(r8), pointer :: qsout_grid_ptr(:,:) + real(r8), pointer :: nrout_grid_ptr(:,:) + real(r8), pointer :: nsout_grid_ptr(:,:) + real(r8), pointer :: qcsedtenout_grid_ptr(:,:) + real(r8), pointer :: qrsedtenout_grid_ptr(:,:) + real(r8), pointer :: qisedtenout_grid_ptr(:,:) + real(r8), pointer :: qssedtenout_grid_ptr(:,:) + real(r8), pointer :: vtrmcout_grid_ptr(:,:) + real(r8), pointer :: umrout_grid_ptr(:,:) + real(r8), pointer :: vtrmiout_grid_ptr(:,:) + real(r8), pointer :: umsout_grid_ptr(:,:) + real(r8), pointer :: qcsevapout_grid_ptr(:,:) + real(r8), pointer :: qisevapout_grid_ptr(:,:) + + + logical :: use_subcol_microp + integer :: col_type ! Flag to store whether accessing grid or sub-columns in pbuf_get_field + integer :: ierr + integer :: nlev + + character(128) :: errstring ! return status (non-blank for error return) + + ! For rrtmg optics. specified distribution. + real(r8), parameter :: dcon = 25.e-6_r8 ! Convective size distribution effective radius (meters) + real(r8), parameter :: mucon = 5.3_r8 ! Convective size distribution shape parameter + real(r8), parameter :: deicon = 50._r8 ! Convective ice effective diameter (meters) + +! Rainbows: SZA + real(r8) :: zen_angle(state%psetcols) ! Daytime solar zenith angles (radians) + real(r8) :: rlats(state%psetcols), rlons(state%psetcols) ! chunk latitudes and longitudes (radians) + real(r8) :: sza(state%psetcols) ! solar zenith angles (degrees) + real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor + real(r8) :: calday !current calendar day + + real(r8) :: precc(state%psetcols) ! convective precip rate + +! Rainbow frequency and fraction for output + + real(r8) :: rbfreq(state%psetcols) + real(r8) :: rbfrac(state%psetcols) + +!Rainbows: parameters + + real(r8), parameter :: rb_rmin =1.e-6_r8 ! Strat Rain threshold (mixing ratio) + real(r8), parameter :: rb_rcmin = 5._r8/(86400._r8*1000._r8) ! Conv Rain Threshold (mm/d--> m/s) + real(r8), parameter :: rb_pmin =85000._r8 ! Minimum pressure for surface layer + real(r8), parameter :: deg2rad = pi/180._r8 ! Conversion factor + integer :: top_idx !Index for top level below rb_pmin + real(r8) :: convmx + real(r8) :: cldmx + real(r8) :: frlow + real(r8) :: cldtot + real(r8) :: rmax + logical :: rval + + !------------------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + psetcols = state%psetcols + ngrdcol = state%ngrdcol + itim_old = pbuf_old_tim_idx() + nlev = pver - top_lev + 1 + + nan_array = nan + + ! Allocate the proc_rates DDT + ! IMPORTANT NOTE -- elements in proc_rates are dimensioned to the nlev dimension while + ! all the other arrays in this routine are dimensioned pver. This is required because + ! PUMAS only gets the top_lev:pver array subsection, and the proc_rates arrays + ! need to be the same levels. + call proc_rates%allocate(ncol, nlev, ncd, micro_mg_warm_rain, errstring) + + call handle_errmsg(errstring, subname="micro_pumas_cam_tend") + + + call phys_getopts(use_subcol_microp_out=use_subcol_microp) + + ! Set the col_type flag to grid or subcolumn dependent on the value of use_subcol_microp + call pbuf_col_type_index(use_subcol_microp, col_type=col_type) + + !----------------------- + ! These physics buffer fields are read only and not set in this parameterization + ! If these fields do not have subcolumn data, copy the grid to the subcolumn if subcolumns is turned on + ! If subcolumns is not turned on, then these fields will be grid data + + call pbuf_get_field(pbuf, naai_idx, naai, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, naai_hom_idx, naai_hom, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, npccn_idx, npccn, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, rndst_idx, rndst, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, nacon_idx, nacon, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, relvar_idx, relvar, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, cmeliq_idx, cmeliq, col_type=col_type, copy_if_needed=use_subcol_microp) + + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & + col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & + col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), & + col_type=col_type, copy_if_needed=use_subcol_microp) + + ! Get convective precip for rainbows + if (prec_dp_idx > 0) then + call pbuf_get_field(pbuf, prec_dp_idx, prec_dp, col_type=col_type, copy_if_needed=use_subcol_microp) + else + nullify(prec_dp) + end if + if (prec_sh_idx > 0) then + call pbuf_get_field(pbuf, prec_sh_idx, prec_sh, col_type=col_type, copy_if_needed=use_subcol_microp) + else + nullify(prec_sh) + end if + +! Merge Precipitation rates (multi-process) + if (associated(prec_dp) .and. associated(prec_sh)) then + precc(:ncol) = prec_dp(:ncol) + prec_sh(:ncol) + else if (associated(prec_dp)) then + precc(:ncol) = prec_dp(:ncol) + else if (associated(prec_sh)) then + precc(:ncol) = prec_sh(:ncol) + else + precc(:ncol) = 0._r8 + end if + + if (.not. do_cldice) then + ! If we are NOT prognosing ice and snow tendencies, then get them from the Pbuf + call pbuf_get_field(pbuf, tnd_qsnow_idx, tnd_qsnow, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, tnd_nsnow_idx, tnd_nsnow, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, re_ice_idx, re_ice, col_type=col_type, copy_if_needed=use_subcol_microp) + else + ! If we ARE prognosing tendencies, then just point to an array of NaN fields to have + ! something for PUMAS to use in call + tnd_qsnow => nan_array + tnd_nsnow => nan_array + re_ice => nan_array + end if + + if (use_hetfrz_classnuc) then + call pbuf_get_field(pbuf, frzimm_idx, frzimm, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, frzcnt_idx, frzcnt, col_type=col_type, copy_if_needed=use_subcol_microp) + call pbuf_get_field(pbuf, frzdep_idx, frzdep, col_type=col_type, copy_if_needed=use_subcol_microp) + else + ! Needed to satisfy gnu compiler with optional argument - set to an array of Nan fields + frzimm => nan_array + frzcnt => nan_array + frzdep => nan_array + end if + + if (qsatfac_idx > 0) then + call pbuf_get_field(pbuf, qsatfac_idx, qsatfac, col_type=col_type, copy_if_needed=use_subcol_microp) + else + allocate(qsatfac(ncol,pver),stat=ierr) + call handle_allocate_error(ierr, 'micro_pumas_cam_tend', 'qsatfac') + qsatfac = 1._r8 + end if + + ! initialize tendency variables + preci = 0._r8 + prect = 0._r8 + + + !----------------------- + ! These physics buffer fields are calculated and set in this parameterization + ! If subcolumns is turned on, then these fields will be calculated on a subcolumn grid, otherwise they will be a normal grid + + call pbuf_get_field(pbuf, prec_str_idx, prec_str, col_type=col_type) + call pbuf_get_field(pbuf, snow_str_idx, snow_str, col_type=col_type) + call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw, col_type=col_type) + call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw, col_type=col_type) + call pbuf_get_field(pbuf, prec_sed_idx, prec_sed, col_type=col_type) + call pbuf_get_field(pbuf, snow_sed_idx, snow_sed, col_type=col_type) + call pbuf_get_field(pbuf, nevapr_idx, nevapr, col_type=col_type) + call pbuf_get_field(pbuf, prer_evap_idx, prer_evap, col_type=col_type) + call pbuf_get_field(pbuf, prain_idx, prain, col_type=col_type) + call pbuf_get_field(pbuf, dei_idx, dei, col_type=col_type) + call pbuf_get_field(pbuf, mu_idx, mu, col_type=col_type) + call pbuf_get_field(pbuf, lambdac_idx, lambdac, col_type=col_type) + call pbuf_get_field(pbuf, des_idx, des, col_type=col_type) + call pbuf_get_field(pbuf, ls_flxprc_idx, mgflxprc, col_type=col_type) + call pbuf_get_field(pbuf, ls_flxsnw_idx, mgflxsnw, col_type=col_type) + call pbuf_get_field(pbuf, ls_mrprc_idx, mgmrprc, col_type=col_type) + call pbuf_get_field(pbuf, ls_mrsnw_idx, mgmrsnw, col_type=col_type) + call pbuf_get_field(pbuf, cv_reffliq_idx, cvreffliq, col_type=col_type) + call pbuf_get_field(pbuf, cv_reffice_idx, cvreffice, col_type=col_type) + call pbuf_get_field(pbuf, iciwpst_idx, iciwpst, col_type=col_type) + call pbuf_get_field(pbuf, iclwpst_idx, iclwpst, col_type=col_type) + call pbuf_get_field(pbuf, icswp_idx, icswp, col_type=col_type) + call pbuf_get_field(pbuf, rel_idx, rel, col_type=col_type) + call pbuf_get_field(pbuf, rei_idx, rei, col_type=col_type) + call pbuf_get_field(pbuf, sadice_idx, sadice, col_type=col_type) + call pbuf_get_field(pbuf, sadsnow_idx, sadsnow, col_type=col_type) + call pbuf_get_field(pbuf, wsedl_idx, wsedl, col_type=col_type) + call pbuf_get_field(pbuf, qme_idx, qme, col_type=col_type) + call pbuf_get_field(pbuf, bergso_idx, bergstot, col_type=col_type) + + ! Assign the pointer values to the non-pointer proc_rates element + proc_rates%bergstot(:ncol,1:nlev) = bergstot(:ncol,top_lev:pver) + + if (degrau_idx > 0) call pbuf_get_field(pbuf, degrau_idx, degrau, col_type=col_type) + if (icgrauwp_idx > 0) call pbuf_get_field(pbuf, icgrauwp_idx, icgrauwp, col_type=col_type) + if (cldfgrau_idx > 0) call pbuf_get_field(pbuf, cldfgrau_idx, cldfgrau, col_type=col_type) + + call pbuf_get_field(pbuf, cldo_idx, cldo, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_t_idx, CC_t, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_qv_idx, CC_qv, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_ql_idx, CC_ql, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_qi_idx, CC_qi, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_nl_idx, CC_nl, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_ni_idx, CC_ni, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + call pbuf_get_field(pbuf, cc_qlst_idx, CC_qlst, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type) + + if (rate1_cw2pr_st_idx > 0) then + call pbuf_get_field(pbuf, rate1_cw2pr_st_idx, rate1ord_cw2pr_st, col_type=col_type) + end if + + if (qrain_idx > 0) call pbuf_get_field(pbuf, qrain_idx, qrout_grid_ptr) + if (qsnow_idx > 0) call pbuf_get_field(pbuf, qsnow_idx, qsout_grid_ptr) + if (nrain_idx > 0) call pbuf_get_field(pbuf, nrain_idx, nrout_grid_ptr) + if (nsnow_idx > 0) call pbuf_get_field(pbuf, nsnow_idx, nsout_grid_ptr) + if (qcsedten_idx > 0) call pbuf_get_field(pbuf, qcsedten_idx, qcsedtenout_grid_ptr) + if (qrsedten_idx > 0) call pbuf_get_field(pbuf, qrsedten_idx, qrsedtenout_grid_ptr) + if (qisedten_idx > 0) call pbuf_get_field(pbuf, qisedten_idx, qisedtenout_grid_ptr) + if (qssedten_idx > 0) call pbuf_get_field(pbuf, qssedten_idx, qssedtenout_grid_ptr) + if (vtrmc_idx > 0) call pbuf_get_field(pbuf, vtrmc_idx, vtrmcout_grid_ptr) + if (umr_idx > 0) call pbuf_get_field(pbuf, umr_idx, umrout_grid_ptr) + if (vtrmi_idx > 0) call pbuf_get_field(pbuf, vtrmi_idx, vtrmiout_grid_ptr) + if (ums_idx > 0) call pbuf_get_field(pbuf, ums_idx, umsout_grid_ptr) + if (qcsevap_idx > 0) call pbuf_get_field(pbuf, qcsevap_idx, qcsevapout_grid_ptr) + if (qisevap_idx > 0) call pbuf_get_field(pbuf, qisevap_idx, qisevapout_grid_ptr) + + !----------------------- + ! If subcolumns is turned on, all calculated fields which are on subcolumns + ! need to be retrieved on the grid as well for storing averaged values + + if (use_subcol_microp) then + call pbuf_get_field(pbuf, prec_str_idx, prec_str_grid) + call pbuf_get_field(pbuf, snow_str_idx, snow_str_grid) + call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw_grid) + call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw_grid) + call pbuf_get_field(pbuf, prec_sed_idx, prec_sed_grid) + call pbuf_get_field(pbuf, snow_sed_idx, snow_sed_grid) + call pbuf_get_field(pbuf, nevapr_idx, nevapr_grid) + call pbuf_get_field(pbuf, prain_idx, prain_grid) + call pbuf_get_field(pbuf, dei_idx, dei_grid) + call pbuf_get_field(pbuf, mu_idx, mu_grid) + call pbuf_get_field(pbuf, lambdac_idx, lambdac_grid) + call pbuf_get_field(pbuf, des_idx, des_grid) + call pbuf_get_field(pbuf, ls_flxprc_idx, mgflxprc_grid) + call pbuf_get_field(pbuf, ls_flxsnw_idx, mgflxsnw_grid) + call pbuf_get_field(pbuf, ls_mrprc_idx, mgmrprc_grid) + call pbuf_get_field(pbuf, ls_mrsnw_idx, mgmrsnw_grid) + call pbuf_get_field(pbuf, cv_reffliq_idx, cvreffliq_grid) + call pbuf_get_field(pbuf, cv_reffice_idx, cvreffice_grid) + call pbuf_get_field(pbuf, iciwpst_idx, iciwpst_grid) + call pbuf_get_field(pbuf, iclwpst_idx, iclwpst_grid) + call pbuf_get_field(pbuf, icswp_idx, icswp_grid) + call pbuf_get_field(pbuf, rel_idx, rel_grid) + call pbuf_get_field(pbuf, rei_idx, rei_grid) + call pbuf_get_field(pbuf, sadice_idx, sadice_grid) + call pbuf_get_field(pbuf, sadsnow_idx, sadsnow_grid) + call pbuf_get_field(pbuf, wsedl_idx, wsedl_grid) + call pbuf_get_field(pbuf, qme_idx, qme_grid) + call pbuf_get_field(pbuf, bergso_idx, bergso_grid) + if (degrau_idx > 0) call pbuf_get_field(pbuf, degrau_idx, degrau_grid) + if (icgrauwp_idx > 0) call pbuf_get_field(pbuf, icgrauwp_idx, icgrauwp_grid) + if (cldfgrau_idx > 0) call pbuf_get_field(pbuf, cldfgrau_idx, cldfgrau_grid) + + call pbuf_get_field(pbuf, cldo_idx, cldo_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_t_idx, CC_t_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_qv_idx, CC_qv_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_ql_idx, CC_ql_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_qi_idx, CC_qi_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_nl_idx, CC_nl_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_ni_idx, CC_ni_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, cc_qlst_idx, CC_qlst_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + if (rate1_cw2pr_st_idx > 0) then + call pbuf_get_field(pbuf, rate1_cw2pr_st_idx, rate1ord_cw2pr_st_grid) + end if + + else + allocate(bergso_grid(pcols,pver), stat=ierr) + call handle_allocate_error(ierr, 'micro_pumas_cam_tend', 'bergso_grid') + bergso_grid(:,:) = 0._r8 + end if + + !----------------------- + ! These are only on the grid regardless of whether subcolumns are turned on or not + call pbuf_get_field(pbuf, ls_reffrain_idx, mgreffrain_grid) + call pbuf_get_field(pbuf, ls_reffsnow_idx, mgreffsnow_grid) + call pbuf_get_field(pbuf, acpr_idx, acprecl_grid) + call pbuf_get_field(pbuf, acgcme_idx, acgcme_grid) + call pbuf_get_field(pbuf, acnum_idx, acnum_grid) + call pbuf_get_field(pbuf, cmeliq_idx, cmeliq_grid) + call pbuf_get_field(pbuf, ast_idx, ast_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + call pbuf_get_field(pbuf, evprain_st_idx, evprain_st_grid) + call pbuf_get_field(pbuf, evpsnow_st_idx, evpsnow_st_grid) + call pbuf_get_field(pbuf, am_evp_st_idx, am_evp_st_grid) + + !----------------------------------------------------------------------- + ! ... Calculate cosine of zenith angle + ! then cast back to angle (radians) + !----------------------------------------------------------------------- + + zen_angle(:) = 0.0_r8 + rlats(:) = 0.0_r8 + rlons(:) = 0.0_r8 + calday = get_curr_calday() + call get_rlat_all_p( lchnk, ncol, rlats ) + call get_rlon_all_p( lchnk, ncol, rlons ) + call zenith( calday, rlats, rlons, zen_angle, ncol ) + where (zen_angle(:) <= 1.0_r8 .and. zen_angle(:) >= -1.0_r8) + zen_angle(:) = acos( zen_angle(:) ) + elsewhere + zen_angle(:) = 0.0_r8 + end where + + sza(:) = zen_angle(:) * rad2deg + call outfld( 'rbSZA', sza, ncol, lchnk ) + + !------------------------------------------------------------------------------------- + ! Microphysics assumes 'liquid stratus frac = ice stratus frac + ! = max( liquid stratus frac, ice stratus frac )'. + alst_mic => ast + aist_mic => ast + + ! Output initial in-cloud LWP (before microphysics) + + iclwpi = 0._r8 + iciwpi = 0._r8 + + do i = 1, ncol + do k = top_lev, pver + iclwpi(i) = iclwpi(i) + & + min(state%q(i,k,ixcldliq) / max(mincld,ast(i,k)),0.005_r8) & + * state%pdel(i,k) / gravit + iciwpi(i) = iciwpi(i) + & + min(state%q(i,k,ixcldice) / max(mincld,ast(i,k)),0.005_r8) & + * state%pdel(i,k) / gravit + end do + end do + + cldo(:ncol,top_lev:pver)=ast(:ncol,top_lev:pver) + + ! Initialize local state from input. + call physics_state_copy(state, state_loc) + + ! Because of the of limited vertical resolution, there can be a signifcant + ! warm bias at the cold point tropopause, which can create a wet bias in the + ! stratosphere. For the microphysics only, update the cold point temperature, with + ! an estimate of the coldest point between the model layers. + if (micro_mg_adjust_cpt) then + cp_rh(:ncol, :pver) = 0._r8 + cp_dt(:ncol) = 0._r8 + cp_dz(:ncol) = 0._r8 + + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + troplev(:) = 0 + cp_z(:) = 0._r8 + cp_t(:) = 0._r8 + !REMOVECAM_END + call tropopause_find_cam(state_loc, troplev, primary=TROP_ALG_CPP, backup=TROP_ALG_NONE, & + tropZ=cp_z, tropT=cp_t) + + do i = 1, ncol + + ! Update statistics and output results. + if (troplev(i) .ne. NOTFOUND) then + cp_dt(i) = cp_t(i) - state_loc%t(i,troplev(i)) + cp_dz(i) = cp_z(i) - state_loc%zm(i,troplev(i)) + + ! NOTE: This change in temperature is just for the microphysics + ! and should not be added to any tendencies or used to update + ! any states + state_loc%t(i,troplev(i)) = state_loc%t(i,troplev(i)) + cp_dt(i) + end if + end do + + ! Output all of the statistics related to the cold point + ! tropopause adjustment. Th cold point information itself is + ! output in tropopause.F90. + call outfld("TROPF_TADJ", state_loc%t, pcols, lchnk) + call outfld("TROPF_CDT", cp_dt, pcols, lchnk) + call outfld("TROPF_CDZ", cp_dz, pcols, lchnk) + end if + + ! Initialize ptend for output. + lq = .false. + lq(ixq) = .true. + lq(ixcldliq) = .true. + lq(ixcldice) = .true. + lq(ixnumliq) = .true. + lq(ixnumice) = .true. + lq(ixrain) = .true. + lq(ixsnow) = .true. + lq(ixnumrain) = .true. + lq(ixnumsnow) = .true. + if (micro_mg_version > 2) then + lq(ixgraupel) = .true. + lq(ixnumgraupel) = .true. + end if + + ! the name 'cldwat' triggers special tests on cldliq + ! and cldice in physics_update + call physics_ptend_init(ptend, psetcols, "cldwat", ls=.true., lq=lq) + + if (micro_mg_version > 2) then + state_loc_graup(:ncol,:) = state_loc%q(:ncol,:,ixgraupel) + state_loc_numgraup(:ncol,:) = state_loc%q(:ncol,:,ixnumgraupel) + else + state_loc_graup(:ncol,:) = 0._r8 + state_loc_numgraup(:ncol,:) = 0._r8 + end if + + ! Zero out diagnostic rainbow arrays + rbfreq = 0._r8 + rbfrac = 0._r8 + + ! Zero out values above top_lev before passing into _tend for some pbuf variables that are inputs + naai(:ncol,:top_lev-1) = 0._r8 + npccn(:ncol,:top_lev-1) = 0._r8 + + ! The null value for qsatfac is 1, not zero + qsatfac(:ncol,:top_lev-1) = 1._r8 + + ! Zero out values above top_lev for all output variables + ! Note that elements in proc_rates do not have the extra levels as they are dimensioned to be nlev instead of pver + tlat(:ncol,:top_lev-1)=0._r8 + qvlat(:ncol,:top_lev-1)=0._r8 + qcten(:ncol,:top_lev-1)=0._r8 + qiten(:ncol,:top_lev-1)=0._r8 + ncten(:ncol,:top_lev-1)=0._r8 + niten(:ncol,:top_lev-1)=0._r8 + qrten(:ncol,:top_lev-1)=0._r8 + qsten(:ncol,:top_lev-1)=0._r8 + nrten(:ncol,:top_lev-1)=0._r8 + nsten(:ncol,:top_lev-1)=0._r8 + qgten(:ncol,:top_lev-1)=0._r8 + ngten(:ncol,:top_lev-1)=0._r8 + rel(:ncol,:top_lev-1)=0._r8 + rel_fn_dum(:ncol,:top_lev-1)=0._r8 + rei(:ncol,:top_lev-1)=0._r8 + sadice(:ncol,:top_lev-1)=0._r8 + sadsnow(:ncol,:top_lev-1)=0._r8 + prect(:ncol)=0._r8 + preci(:ncol)=0._r8 + nevapr(:ncol,:top_lev-1)=0._r8 + am_evp_st(:ncol,:top_lev-1)=0._r8 + prain(:ncol,:top_lev-1)=0._r8 + cmeice(:ncol,:top_lev-1)=0._r8 + dei(:ncol,:top_lev-1)=0._r8 + mu(:ncol,:top_lev-1)=0._r8 + lambdac(:ncol,:top_lev-1)=0._r8 + qsout(:ncol,:top_lev-1)=0._r8 + des(:ncol,:top_lev-1)=0._r8 + qgout(:ncol,:top_lev-1)=0._r8 + ngout(:ncol,:top_lev-1)=0._r8 + dgout(:ncol,:top_lev-1)=0._r8 + cflx(:ncol,:top_lev-1)=0._r8 + iflx(:ncol,:top_lev-1)=0._r8 + gflx(:ncol,:top_lev-1)=0._r8 + rflx(:ncol,:top_lev-1)=0._r8 + sflx(:ncol,:top_lev-1)=0._r8 + qrout(:ncol,:top_lev-1)=0._r8 + reff_rain_dum(:ncol,:top_lev-1)=0._r8 + reff_snow_dum(:ncol,:top_lev-1)=0._r8 + reff_grau_dum(:ncol,:top_lev-1)=0._r8 + nrout(:ncol,:top_lev-1)=0._r8 + nsout(:ncol,:top_lev-1)=0._r8 + refl(:ncol,:top_lev-1)=0._r8 + arefl(:ncol,:top_lev-1)=0._r8 + areflz(:ncol,:top_lev-1)=0._r8 + frefl(:ncol,:top_lev-1)=0._r8 + csrfl(:ncol,:top_lev-1)=0._r8 + acsrfl(:ncol,:top_lev-1)=0._r8 + fcsrfl(:ncol,:top_lev-1)=0._r8 + refl10cm(:ncol,:top_lev-1)=-9999._r8 + reflz10cm(:ncol,:top_lev-1)=0._r8 + rercld(:ncol,:top_lev-1)=0._r8 + ncai(:ncol,:top_lev-1)=0._r8 + ncal(:ncol,:top_lev-1)=0._r8 + qrout2(:ncol,:top_lev-1)=0._r8 + qsout2(:ncol,:top_lev-1)=0._r8 + nrout2(:ncol,:top_lev-1)=0._r8 + nsout2(:ncol,:top_lev-1)=0._r8 + qgout2(:ncol,:top_lev-1)=0._r8 + ngout2(:ncol,:top_lev-1)=0._r8 + dgout2(:ncol,:top_lev-1)=0._r8 + freqg(:ncol,:top_lev-1)=0._r8 + freqs(:ncol,:top_lev-1)=0._r8 + freqr(:ncol,:top_lev-1)=0._r8 + nfice(:ncol,:top_lev-1)=0._r8 + qcrat(:ncol,:top_lev-1)=0._r8 + tnd_qsnow(:ncol,:top_lev-1)=0._r8 + tnd_nsnow(:ncol,:top_lev-1)=0._r8 + re_ice(:ncol,:top_lev-1)=0._r8 + prer_evap(:ncol,:top_lev-1)=0._r8 + frzimm(:ncol,:top_lev-1)=0._r8 + frzcnt(:ncol,:top_lev-1)=0._r8 + frzdep(:ncol,:top_lev-1)=0._r8 + + do it = 1, num_steps + + call micro_pumas_tend( & + ncol, nlev, dtime/num_steps,& + state_loc%t(:ncol,top_lev:), state_loc%q(:ncol,top_lev:,ixq), & + state_loc%q(:ncol,top_lev:,ixcldliq), state_loc%q(:ncol,top_lev:,ixcldice), & + state_loc%q(:ncol,top_lev:,ixnumliq), state_loc%q(:ncol,top_lev:,ixnumice), & + state_loc%q(:ncol,top_lev:,ixrain), state_loc%q(:ncol,top_lev:,ixsnow), & + state_loc%q(:ncol,top_lev:,ixnumrain), state_loc%q(:ncol,top_lev:,ixnumsnow), & + state_loc_graup(:ncol,top_lev:), state_loc_numgraup(:ncol,top_lev:), & + relvar(:ncol,top_lev:), accre_enhan(:ncol,top_lev:), & + state_loc%pmid(:ncol,top_lev:), state_loc%pdel(:ncol,top_lev:), state_loc%pint(:ncol,top_lev:), & + ast(:ncol,top_lev:), alst_mic(:ncol,top_lev:), aist_mic(:ncol,top_lev:), qsatfac(:ncol,top_lev:), & + rate1cld(:ncol,top_lev:), & + naai(:ncol,top_lev:), npccn(:ncol,top_lev:), & + rndst(:ncol,top_lev:,:), nacon(:ncol,top_lev:,:), & + tlat(:ncol,top_lev:), qvlat(:ncol,top_lev:), & + qcten(:ncol,top_lev:), qiten(:ncol,top_lev:), & + ncten(:ncol,top_lev:), niten(:ncol,top_lev:), & + qrten(:ncol,top_lev:), qsten(:ncol,top_lev:), & + nrten(:ncol,top_lev:), nsten(:ncol,top_lev:), & + qgten(:ncol,top_lev:), ngten(:ncol,top_lev:), & + rel(:ncol,top_lev:), rel_fn_dum(:ncol,top_lev:), rei(:ncol,top_lev:), & + sadice(:ncol,top_lev:), sadsnow(:ncol,top_lev:), & + prect(:ncol), preci(:ncol), & + nevapr(:ncol,top_lev:), am_evp_st(:ncol,top_lev:), & + prain(:ncol,top_lev:), & + cmeice(:ncol,top_lev:), dei(:ncol,top_lev:), & + mu(:ncol,top_lev:), lambdac(:ncol,top_lev:), & + qsout(:ncol,top_lev:), des(:ncol,top_lev:), & + qgout(:ncol,top_lev:), ngout(:ncol,top_lev:), dgout(:ncol,top_lev:), & + cflx(:ncol,top_lev:), iflx(:ncol,top_lev:), & + gflx(:ncol,top_lev:), & + rflx(:ncol,top_lev:), sflx(:ncol,top_lev:), qrout(:ncol,top_lev:), & + reff_rain_dum(:ncol,top_lev:), reff_snow_dum(:ncol,top_lev:), reff_grau_dum(:ncol,top_lev:), & + nrout(:ncol,top_lev:), nsout(:ncol,top_lev:), & + refl(:ncol,top_lev:), arefl(:ncol,top_lev:), areflz(:ncol,top_lev:), & + frefl(:ncol,top_lev:), csrfl(:ncol,top_lev:), acsrfl(:ncol,top_lev:), & + fcsrfl(:ncol,top_lev:), & + refl10cm(:ncol,top_lev:), reflz10cm(:ncol,top_lev:), rercld(:ncol,top_lev:), & + ncai(:ncol,top_lev:), ncal(:ncol,top_lev:), & + qrout2(:ncol,top_lev:), qsout2(:ncol,top_lev:), & + nrout2(:ncol,top_lev:), nsout2(:ncol,top_lev:), & + drout_dum(:ncol,top_lev:), dsout2_dum(:ncol,top_lev:), & + qgout2(:ncol,top_lev:), ngout2(:ncol,top_lev:), dgout2(:ncol,top_lev:), freqg(:ncol,top_lev:), & + freqs(:ncol,top_lev:), freqr(:ncol,top_lev:), & + nfice(:ncol,top_lev:), qcrat(:ncol,top_lev:), & + proc_rates, & + errstring, & + tnd_qsnow(:ncol,top_lev:),tnd_nsnow(:ncol,top_lev:),re_ice(:ncol,top_lev:),& + prer_evap(:ncol,top_lev:), & + frzimm(:ncol,top_lev:), frzcnt(:ncol,top_lev:), frzdep(:ncol,top_lev:) ) + + call handle_errmsg(errstring, subname="micro_pumas_cam_tend") + + call physics_ptend_init(ptend_loc, psetcols, "micro_pumas", & + ls=.true., lq=lq) + + ! Set local tendency. + ptend_loc%s(:ncol,top_lev:) = tlat(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixq) = qvlat(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixcldliq) = qcten(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixcldice) = qiten(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixnumliq) = ncten(:ncol,top_lev:) + + if (do_cldice) then + ptend_loc%q(:ncol,top_lev:,ixnumice) = niten(:ncol,top_lev:) + else + ! In this case, the tendency should be all 0. + if (any(niten(:ncol,:) /= 0._r8)) then + call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// & + " but micro_pumas_tend has ice number tendencies.") + end if + ptend_loc%q(:ncol,:,ixnumice) = 0._r8 + end if + + ptend_loc%q(:ncol,top_lev:,ixrain) = qrten(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixsnow) = qsten(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixnumrain) = nrten(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixnumsnow) = nsten(:ncol,top_lev:) + + if (micro_mg_version > 2) then + ptend_loc%q(:ncol,top_lev:,ixgraupel) = qgten(:ncol,top_lev:) + ptend_loc%q(:ncol,top_lev:,ixnumgraupel) = ngten(:ncol,top_lev:) + end if + + ! Sum into overall ptend + call physics_ptend_sum(ptend_loc, ptend, ncol) + + ! Update local state + call physics_update(state_loc, ptend_loc, dtime/num_steps) + + if (trim(micro_mg_warm_rain) == 'tau') then + proc_rates%amk_c(:ncol,:,:) = proc_rates%amk_c(:ncol,:,:)/num_steps + proc_rates%ank_c(:ncol,:,:) = proc_rates%ank_c(:ncol,:,:)/num_steps + proc_rates%amk_r(:ncol,:,:) = proc_rates%amk_r(:ncol,:,:)/num_steps + proc_rates%ank_r(:ncol,:,:) = proc_rates%ank_r(:ncol,:,:)/num_steps + proc_rates%amk(:ncol,:,:) = proc_rates%amk(:ncol,:,:)/num_steps + proc_rates%ank(:ncol,:,:) = proc_rates%ank(:ncol,:,:)/num_steps + proc_rates%amk_out(:ncol,:,:) = proc_rates%amk_out(:ncol,:,:)/num_steps + end if + + end do + + ! Divide ptend by substeps. + call physics_ptend_scale(ptend, 1._r8/num_steps, ncol) + + ! Check to make sure that the microphysics code is respecting the flags that control + ! whether MG should be prognosing cloud ice and cloud liquid or not. + if (.not. do_cldice) then + if (any(ptend%q(:ncol,top_lev:pver,ixcldice) /= 0.0_r8)) & + call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// & + " but micro_pumas_tend has ice mass tendencies.") + if (any(ptend%q(:ncol,top_lev:pver,ixnumice) /= 0.0_r8)) & + call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// & + " but micro_pumas_tend has ice number tendencies.") + end if + if (.not. do_cldliq) then + if (any(ptend%q(:ncol,top_lev:pver,ixcldliq) /= 0.0_r8)) & + call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud liquid,"// & + " but micro_pumas_tend has liquid mass tendencies.") + if (any(ptend%q(:ncol,top_lev:pver,ixnumliq) /= 0.0_r8)) & + call endrun("micro_pumas_cam:ERROR - MG microphysics is configured not to prognose cloud liquid,"// & + " but micro_pumas_tend has liquid number tendencies.") + end if + + mnuccdohet = 0._r8 + do k=top_lev,pver + do i=1,ncol + if (naai(i,k) > 0._r8) then + mnuccdohet(i,k) = proc_rates%mnuccdtot(i,k-top_lev+1) - (naai_hom(i,k)/naai(i,k))*proc_rates%mnuccdtot(i,k-top_lev+1) + end if + end do + end do + + mgflxprc(:ncol,top_lev:pverp) = rflx(:ncol,top_lev:pverp) + sflx(:ncol,top_lev:pverp) + mgflxsnw(:ncol,top_lev:pverp) = sflx(:ncol,top_lev:pverp) + + !add condensate fluxes for MG2 (ice and snow already added for MG1) + if (micro_mg_version >= 2) then + mgflxprc(:ncol,top_lev:pverp) = mgflxprc(:ncol,top_lev:pverp)+ iflx(:ncol,top_lev:pverp) + cflx(:ncol,top_lev:pverp) + mgflxsnw(:ncol,top_lev:pverp) = mgflxsnw(:ncol,top_lev:pverp) + iflx(:ncol,top_lev:pverp) + end if + + !add graupel fluxes for MG3 to snow flux + if (micro_mg_version >= 3) then + mgflxprc(:ncol,top_lev:pverp) = mgflxprc(:ncol,top_lev:pverp)+gflx(:ncol,top_lev:pverp) + mgflxsnw(:ncol,top_lev:pverp) = mgflxsnw(:ncol,top_lev:pverp)+gflx(:ncol,top_lev:pverp) + end if + + mgmrprc(:ncol,top_lev:pver) = qrout(:ncol,top_lev:pver) + qsout(:ncol,top_lev:pver) + mgmrsnw(:ncol,top_lev:pver) = qsout(:ncol,top_lev:pver) + + !! calculate effective radius of convective liquid and ice using dcon and deicon (not used by code, not useful for COSP) + !! hard-coded as average of hard-coded values used for deep/shallow convective detrainment (near line 1502/1505) + cvreffliq(:ncol,top_lev:pver) = 9.0_r8 + cvreffice(:ncol,top_lev:pver) = 37.0_r8 + + ! Reassign rate1 if modal aerosols + if (rate1_cw2pr_st_idx > 0) then + rate1ord_cw2pr_st(:ncol,top_lev:pver) = rate1cld(:ncol,top_lev:pver) + end if + + ! Sedimentation velocity for liquid stratus cloud droplet + wsedl(:ncol,top_lev:pver) = proc_rates%vtrmc(:ncol,1:nlev) + + ! Microphysical tendencies for use in the macrophysics at the next time step + CC_T(:ncol,top_lev:pver) = tlat(:ncol,top_lev:pver)/cpair + CC_qv(:ncol,top_lev:pver) = qvlat(:ncol,top_lev:pver) + CC_ql(:ncol,top_lev:pver) = qcten(:ncol,top_lev:pver) + CC_qi(:ncol,top_lev:pver) = qiten(:ncol,top_lev:pver) + CC_nl(:ncol,top_lev:pver) = ncten(:ncol,top_lev:pver) + CC_ni(:ncol,top_lev:pver) = niten(:ncol,top_lev:pver) + CC_qlst(:ncol,top_lev:pver) = qcten(:ncol,top_lev:pver)/max(0.01_r8,alst_mic(:ncol,top_lev:pver)) + + ! Net micro_pumas_cam condensation rate + qme(:ncol,:top_lev-1) = 0._r8 + qme(:ncol,top_lev:pver) = cmeliq(:ncol,top_lev:pver) + proc_rates%cmeitot(:ncol,1:nlev) + + ! For precip, accumulate only total precip in prec_pcw and snow_pcw variables. + ! Other precip output variables are set to 0 + ! Do not subscript by ncol here, because in physpkg we divide the whole + ! array and need to avoid an FPE due to uninitialized data. + prec_pcw = prect + snow_pcw = preci + prec_sed = 0._r8 + snow_sed = 0._r8 + prec_str = prec_pcw + prec_sed + snow_str = snow_pcw + snow_sed + + icecldf(:ncol,top_lev:pver) = ast(:ncol,top_lev:pver) + liqcldf(:ncol,top_lev:pver) = ast(:ncol,top_lev:pver) + + ! ------------------------------------------------------------ ! + ! Compute in cloud ice and liquid mixing ratios ! + ! Note that 'iclwp, iciwp' are used for radiation computation. ! + ! ------------------------------------------------------------ ! + + icinc = 0._r8 + icwnc = 0._r8 + iciwpst = 0._r8 + iclwpst = 0._r8 + icswp = 0._r8 + cldfsnow = 0._r8 + if (micro_mg_version > 2) then + icgrauwp = 0._r8 + cldfgrau = 0._r8 + end if + + do k = top_lev, pver + do i = 1, ncol + ! Limits for in-cloud mixing ratios consistent with MG microphysics + ! in-cloud mixing ratio maximum limit of 0.005 kg/kg + icimrst(i,k) = min( state_loc%q(i,k,ixcldice) / max(mincld,icecldf(i,k)),0.005_r8 ) + icwmrst(i,k) = min( state_loc%q(i,k,ixcldliq) / max(mincld,liqcldf(i,k)),0.005_r8 ) + icinc(i,k) = state_loc%q(i,k,ixnumice) / max(mincld,icecldf(i,k)) * & + state_loc%pmid(i,k) / (287.15_r8*state_loc%t(i,k)) + icwnc(i,k) = state_loc%q(i,k,ixnumliq) / max(mincld,liqcldf(i,k)) * & + state_loc%pmid(i,k) / (287.15_r8*state_loc%t(i,k)) + ! Calculate micro_pumas_cam cloud water paths in each layer + ! Note: uses stratiform cloud fraction! + iciwpst(i,k) = min(state_loc%q(i,k,ixcldice)/max(mincld,ast(i,k)),0.005_r8) * state_loc%pdel(i,k) / gravit + iclwpst(i,k) = min(state_loc%q(i,k,ixcldliq)/max(mincld,ast(i,k)),0.005_r8) * state_loc%pdel(i,k) / gravit + + ! ------------------------------ ! + ! Adjust cloud fraction for snow ! + ! ------------------------------ ! + cldfsnow(i,k) = cld(i,k) + ! If cloud and only ice ( no convective cloud or ice ), then set to 0. + if( ( cldfsnow(i,k) .gt. 1.e-4_r8 ) .and. & + ( concld(i,k) .lt. 1.e-4_r8 ) .and. & + ( state_loc%q(i,k,ixcldliq) .lt. 1.e-10_r8 ) ) then + cldfsnow(i,k) = 0._r8 + end if + ! If no cloud and snow, then set to 0.25 + if( ( cldfsnow(i,k) .le. 1.e-4_r8 ) .and. ( qsout(i,k) .gt. 1.e-6_r8 ) ) then + cldfsnow(i,k) = 0.25_r8 + end if + ! Calculate in-cloud snow water path + icswp(i,k) = qsout(i,k) / max( mincld, cldfsnow(i,k) ) * state_loc%pdel(i,k) / gravit + + ! --------------------------------- ! + ! Adjust cloud fraction for graupel ! + ! --------------------------------- ! + if (micro_mg_version > 2) then + cldfgrau(i,k) = cld(i,k) + ! If cloud and only ice ( no convective cloud or ice ), then set to 0. + if( ( cldfgrau(i,k) .gt. 1.e-4_r8 ) .and. & + ( concld(i,k) .lt. 1.e-4_r8 ) .and. & + ( state_loc%q(i,k,ixcldliq) .lt. 1.e-10_r8 ) ) then + cldfgrau(i,k) = 0._r8 + end if + ! If no cloud and graupel, then set to 0.25 + if( ( cldfgrau(i,k) .le. 1.e-4_r8 ) .and. ( qgout(i,k) .gt. 1.e-9_r8 ) ) then + cldfgrau(i,k) = 0.25_r8 + end if + + ! Calculate in-cloud snow water path + icgrauwp(i,k) = qgout(i,k) / max( 1.e-2_r8, cldfgrau(i,k) ) * state_loc%pdel(i,k) / gravit + end if + + end do + end do + + ! Calculate cloud fraction for prognostic precip sizes. + ! Cloud fraction for purposes of precipitation is maximum cloud + ! fraction out of all the layers that the precipitation may be + ! falling down from. + cldmax(:ncol,top_lev:) = max(mincld, ast(:ncol,top_lev:)) + do k = top_lev+1, pver + where (state_loc%q(:ncol,k-1,ixrain) >= qsmall .or. & + state_loc%q(:ncol,k-1,ixsnow) >= qsmall) + cldmax(:ncol,k) = max(cldmax(:ncol,k-1), cldmax(:ncol,k)) + end where + end do + + !Copy pbuf field from proc_rates back to pbuf pointer + bergstot(:ncol,top_lev:) = proc_rates%bergstot(:ncol,1:nlev) + bergstot(:ncol,1:top_lev-1) = 0._r8 + + ! ------------------------------------------------------ ! + ! ------------------------------------------------------ ! + ! All code from here to the end is on grid columns only ! + ! ------------------------------------------------------ ! + ! ------------------------------------------------------ ! + + ! Average the fields which are needed later in this paramterization to be on the grid + if (use_subcol_microp) then + call subcol_field_avg(prec_str, ngrdcol, lchnk, prec_str_grid) + call subcol_field_avg(iclwpst, ngrdcol, lchnk, iclwpst_grid) + call subcol_field_avg(cvreffliq, ngrdcol, lchnk, cvreffliq_grid) + call subcol_field_avg(cvreffice, ngrdcol, lchnk, cvreffice_grid) + call subcol_field_avg(mgflxprc, ngrdcol, lchnk, mgflxprc_grid) + call subcol_field_avg(mgflxsnw, ngrdcol, lchnk, mgflxsnw_grid) + call subcol_field_avg(qme, ngrdcol, lchnk, qme_grid) + call subcol_field_avg(nevapr, ngrdcol, lchnk, nevapr_grid) + call subcol_field_avg(prain, ngrdcol, lchnk, prain_grid) + call subcol_field_avg(proc_rates%evapsnow, ngrdcol, lchnk, evpsnow_st_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%bergstot, ngrdcol, lchnk, bergso_grid(:,top_lev:)) + + call subcol_field_avg(am_evp_st, ngrdcol, lchnk, am_evp_st_grid) + + ! Average fields which are not in pbuf + call subcol_field_avg(qrout, ngrdcol, lchnk, qrout_grid) + call subcol_field_avg(qsout, ngrdcol, lchnk, qsout_grid) + call subcol_field_avg(nsout, ngrdcol, lchnk, nsout_grid) + call subcol_field_avg(nrout, ngrdcol, lchnk, nrout_grid) + call subcol_field_avg(cld, ngrdcol, lchnk, cld_grid) + call subcol_field_avg(proc_rates%qcrestot, ngrdcol, lchnk, qcreso_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%melttot, ngrdcol, lchnk, melto_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%mnuccctot, ngrdcol, lchnk, mnuccco_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%mnuccttot, ngrdcol, lchnk, mnuccto_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%bergtot, ngrdcol, lchnk, bergo_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%homotot, ngrdcol, lchnk, homoo_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%msacwitot, ngrdcol, lchnk, msacwio_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%psacwstot, ngrdcol, lchnk, psacwso_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%cmeitot, ngrdcol, lchnk, cmeiout_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%qirestot, ngrdcol, lchnk, qireso_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%prcitot, ngrdcol, lchnk, prcio_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%praitot, ngrdcol, lchnk, praio_grid(:,top_lev:)) + call subcol_field_avg(icwmrst, ngrdcol, lchnk, icwmrst_grid) + call subcol_field_avg(icimrst, ngrdcol, lchnk, icimrst_grid) + call subcol_field_avg(liqcldf, ngrdcol, lchnk, liqcldf_grid) + call subcol_field_avg(icecldf, ngrdcol, lchnk, icecldf_grid) + call subcol_field_avg(icwnc, ngrdcol, lchnk, icwnc_grid) + call subcol_field_avg(icinc, ngrdcol, lchnk, icinc_grid) + call subcol_field_avg(state_loc%pdel, ngrdcol, lchnk, pdel_grid) + call subcol_field_avg(proc_rates%pratot, ngrdcol, lchnk, prao_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%prctot, ngrdcol, lchnk, prco_grid(:,top_lev:)) + + call subcol_field_avg(state_loc%q(:,:,ixnumliq), ngrdcol, lchnk, nc_grid(:,top_lev:)) + call subcol_field_avg(state_loc%q(:,:,ixnumice), ngrdcol, lchnk, ni_grid(:,top_lev:)) + + call subcol_field_avg(proc_rates%qcsedten, ngrdcol, lchnk, qcsedtenout_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%qisedten, ngrdcol, lchnk, qisedtenout_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%vtrmc, ngrdcol, lchnk, vtrmcout_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%vtrmi, ngrdcol, lchnk, vtrmiout_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%qcsevap, ngrdcol, lchnk, qcsevapout_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%qisevap, ngrdcol, lchnk, qisevapout_grid(:,top_lev:)) + + call subcol_field_avg(cldmax, ngrdcol, lchnk, cldmax_grid) + + call subcol_field_avg(state_loc%q(:,:,ixrain), ngrdcol, lchnk, qr_grid) + call subcol_field_avg(state_loc%q(:,:,ixnumrain), ngrdcol, lchnk, nr_grid) + call subcol_field_avg(state_loc%q(:,:,ixsnow), ngrdcol, lchnk, qs_grid) + call subcol_field_avg(state_loc%q(:,:,ixnumsnow), ngrdcol, lchnk, ns_grid) + call subcol_field_avg(proc_rates%qrsedten, ngrdcol, lchnk, qrsedtenout_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%qssedten, ngrdcol, lchnk, qssedtenout_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%umr, ngrdcol, lchnk, umrout_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%ums, ngrdcol, lchnk, umsout_grid(:,top_lev:)) + + if (micro_mg_version > 2) then + call subcol_field_avg(state_loc%q(:,:,ixgraupel), ngrdcol, lchnk, qg_grid) + call subcol_field_avg(state_loc%q(:,:,ixnumgraupel), ngrdcol, lchnk, ng_grid) + call subcol_field_avg(proc_rates%psacrtot, ngrdcol, lchnk, psacro_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%pracgtot, ngrdcol, lchnk, pracgo_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%psacwgtot, ngrdcol, lchnk, psacwgo_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%pgsacwtot, ngrdcol, lchnk, pgsacwo_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%pgracstot, ngrdcol, lchnk, pgracso_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%prdgtot, ngrdcol, lchnk, prdgo_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%qmultgtot, ngrdcol, lchnk, qmultgo_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%qmultrgtot, ngrdcol, lchnk, qmultrgo_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%npracgtot, ngrdcol, lchnk, npracgo_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%nscngtot, ngrdcol, lchnk, nscngo_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%ngracstot, ngrdcol, lchnk, ngracso_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%nmultgtot, ngrdcol, lchnk, nmultgo_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%nmultrgtot, ngrdcol, lchnk, nmultrgo_grid(:,top_lev:)) + call subcol_field_avg(proc_rates%npsacwgtot, ngrdcol, lchnk, npsacwgo_grid(:,top_lev:)) + end if + + else + qcreso_grid(:ncol,:top_lev-1) = 0._r8 + melto_grid(:ncol,:top_lev-1) = 0._r8 + mnuccco_grid(:ncol,:top_lev-1) = 0._r8 + mnuccto_grid(:ncol,:top_lev-1) = 0._r8 + bergo_grid(:ncol,:top_lev-1) = 0._r8 + homoo_grid(:ncol,:top_lev-1) = 0._r8 + msacwio_grid(:ncol,:top_lev-1) = 0._r8 + psacwso_grid(:ncol,:top_lev-1) = 0._r8 + cmeiout_grid(:ncol,:top_lev-1) = 0._r8 + qireso_grid(:ncol,:top_lev-1) = 0._r8 + prcio_grid(:ncol,:top_lev-1) = 0._r8 + praio_grid(:ncol,:top_lev-1) = 0._r8 + prao_grid(:ncol,:top_lev-1) = 0._r8 + prco_grid(:ncol,:top_lev-1) = 0._r8 + qcsedtenout_grid(:ncol,:top_lev-1) = 0._r8 + qisedtenout_grid(:ncol,:top_lev-1) = 0._r8 + vtrmcout_grid(:ncol,:top_lev-1) = 0._r8 + vtrmiout_grid(:ncol,:top_lev-1) = 0._r8 + qcsevapout_grid(:ncol,:top_lev-1) = 0._r8 + qisevapout_grid(:ncol,:top_lev-1) = 0._r8 + qrsedtenout_grid(:ncol,:top_lev-1) = 0._r8 + qssedtenout_grid(:ncol,:top_lev-1) = 0._r8 + umrout_grid(:ncol,:top_lev-1) = 0._r8 + umsout_grid(:ncol,:top_lev-1) = 0._r8 + psacro_grid(:ncol,:top_lev-1) = 0._r8 + pracgo_grid(:ncol,:top_lev-1) = 0._r8 + psacwgo_grid(:ncol,:top_lev-1) = 0._r8 + pgsacwo_grid(:ncol,:top_lev-1) = 0._r8 + pgracso_grid(:ncol,:top_lev-1) = 0._r8 + prdgo_grid(:ncol,:top_lev-1) = 0._r8 + qmultgo_grid(:ncol,:top_lev-1) = 0._r8 + qmultrgo_grid(:ncol,:top_lev-1) = 0._r8 + npracgo_grid(:ncol,:top_lev-1) = 0._r8 + nscngo_grid(:ncol,:top_lev-1) = 0._r8 + ngracso_grid(:ncol,:top_lev-1) = 0._r8 + nmultgo_grid(:ncol,:top_lev-1) = 0._r8 + nmultrgo_grid(:ncol,:top_lev-1) = 0._r8 + npsacwgo_grid(:ncol,:top_lev-1) = 0._r8 + bergso_grid(:ncol,:top_lev-1) = 0._r8 + + ! These pbuf fields need to be assigned. There is no corresponding subcol_field_avg + ! as they are reset before being used, so it would be a needless calculation + lambdac_grid => lambdac + mu_grid => mu + rel_grid => rel + rei_grid => rei + sadice_grid => sadice + sadsnow_grid => sadsnow + dei_grid => dei + des_grid => des + degrau_grid => degrau + + ! fields already on grids, so just assign + prec_str_grid => prec_str + iclwpst_grid => iclwpst + cvreffliq_grid => cvreffliq + cvreffice_grid => cvreffice + mgflxprc_grid => mgflxprc + mgflxsnw_grid => mgflxsnw + qme_grid => qme + nevapr_grid => nevapr + prain_grid => prain + + bergso_grid(:ncol,top_lev:) = proc_rates%bergstot + am_evp_st_grid = am_evp_st + + evpsnow_st_grid(:ncol,top_lev:) = proc_rates%evapsnow + qrout_grid = qrout + qsout_grid = qsout + nsout_grid = nsout + nrout_grid = nrout + cld_grid = cld + qcreso_grid(:ncol,top_lev:) = proc_rates%qcrestot + melto_grid(:ncol,top_lev:) = proc_rates%melttot + mnuccco_grid(:ncol,top_lev:) = proc_rates%mnuccctot + mnuccto_grid(:ncol,top_lev:) = proc_rates%mnuccttot + bergo_grid(:ncol,top_lev:) = proc_rates%bergtot + homoo_grid(:ncol,top_lev:) = proc_rates%homotot + msacwio_grid(:ncol,top_lev:) = proc_rates%msacwitot + psacwso_grid(:ncol,top_lev:) = proc_rates%psacwstot + cmeiout_grid(:ncol,top_lev:) = proc_rates%cmeitot + qireso_grid(:ncol,top_lev:) = proc_rates%qirestot + prcio_grid(:ncol,top_lev:) = proc_rates%prcitot + praio_grid(:ncol,top_lev:) = proc_rates%praitot + icwmrst_grid = icwmrst + icimrst_grid = icimrst + liqcldf_grid = liqcldf + icecldf_grid = icecldf + icwnc_grid = icwnc + icinc_grid = icinc + pdel_grid = state_loc%pdel + prao_grid(:ncol,top_lev:) = proc_rates%pratot + prco_grid(:ncol,top_lev:) = proc_rates%prctot + + nc_grid = state_loc%q(:,:,ixnumliq) + ni_grid = state_loc%q(:,:,ixnumice) + + qcsedtenout_grid(:ncol,top_lev:) = proc_rates%qcsedten + qisedtenout_grid(:ncol,top_lev:) = proc_rates%qisedten + vtrmcout_grid(:ncol,top_lev:) = proc_rates%vtrmc + vtrmiout_grid(:ncol,top_lev:) = proc_rates%vtrmi + qcsevapout_grid(:ncol,top_lev:) = proc_rates%qcsevap + qisevapout_grid(:ncol,top_lev:) = proc_rates%qisevap + + cldmax_grid = cldmax + + qr_grid = state_loc%q(:,:,ixrain) + nr_grid = state_loc%q(:,:,ixnumrain) + qs_grid = state_loc%q(:,:,ixsnow) + ns_grid = state_loc%q(:,:,ixnumsnow) + qrsedtenout_grid(:ncol,top_lev:) = proc_rates%qrsedten + qssedtenout_grid(:ncol,top_lev:) = proc_rates%qssedten + umrout_grid(:ncol,top_lev:) = proc_rates%umr + umsout_grid(:ncol,top_lev:) = proc_rates%ums + +! Zero out terms for budgets if not mg3.... + psacwgo_grid = 0._r8 + pgsacwo_grid = 0._r8 + qmultgo_grid = 0._r8 + + if (micro_mg_version > 2) then + qg_grid = state_loc%q(:,:,ixgraupel) + ng_grid = state_loc%q(:,:,ixnumgraupel) + psacro_grid(:ncol,top_lev:) = proc_rates%psacrtot + pracgo_grid(:ncol,top_lev:) = proc_rates%pracgtot + psacwgo_grid(:ncol,top_lev:) = proc_rates%psacwgtot + pgsacwo_grid(:ncol,top_lev:) = proc_rates%pgsacwtot + pgracso_grid(:ncol,top_lev:) = proc_rates%pgracstot + prdgo_grid(:ncol,top_lev:) = proc_rates%prdgtot + qmultgo_grid(:ncol,top_lev:) = proc_rates%qmultgtot + qmultrgo_grid(:ncol,top_lev:) = proc_rates%qmultrgtot + npracgo_grid(:ncol,top_lev:) = proc_rates%npracgtot + nscngo_grid(:ncol,top_lev:) = proc_rates%nscngtot + ngracso_grid(:ncol,top_lev:) = proc_rates%ngracstot + nmultgo_grid(:ncol,top_lev:) = proc_rates%nmultgtot + nmultrgo_grid(:ncol,top_lev:) = proc_rates%nmultrgtot + npsacwgo_grid(:ncol,top_lev:) = proc_rates%npsacwgtot + end if + + + end if + + ! If on subcolumns, average the rest of the pbuf fields which were modified on subcolumns but are not used further in + ! this parameterization (no need to assign in the non-subcolumn case -- the else step) + if (use_subcol_microp) then + call subcol_field_avg(snow_str, ngrdcol, lchnk, snow_str_grid) + call subcol_field_avg(prec_pcw, ngrdcol, lchnk, prec_pcw_grid) + call subcol_field_avg(snow_pcw, ngrdcol, lchnk, snow_pcw_grid) + call subcol_field_avg(prec_sed, ngrdcol, lchnk, prec_sed_grid) + call subcol_field_avg(snow_sed, ngrdcol, lchnk, snow_sed_grid) + call subcol_field_avg(cldo, ngrdcol, lchnk, cldo_grid) + call subcol_field_avg(mgmrprc, ngrdcol, lchnk, mgmrprc_grid) + call subcol_field_avg(mgmrsnw, ngrdcol, lchnk, mgmrsnw_grid) + call subcol_field_avg(wsedl, ngrdcol, lchnk, wsedl_grid) + call subcol_field_avg(cc_t, ngrdcol, lchnk, cc_t_grid) + call subcol_field_avg(cc_qv, ngrdcol, lchnk, cc_qv_grid) + call subcol_field_avg(cc_ql, ngrdcol, lchnk, cc_ql_grid) + call subcol_field_avg(cc_qi, ngrdcol, lchnk, cc_qi_grid) + call subcol_field_avg(cc_nl, ngrdcol, lchnk, cc_nl_grid) + call subcol_field_avg(cc_ni, ngrdcol, lchnk, cc_ni_grid) + call subcol_field_avg(cc_qlst, ngrdcol, lchnk, cc_qlst_grid) + call subcol_field_avg(iciwpst, ngrdcol, lchnk, iciwpst_grid) + call subcol_field_avg(icswp, ngrdcol, lchnk, icswp_grid) + call subcol_field_avg(cldfsnow, ngrdcol, lchnk, cldfsnow_grid) + + if (micro_mg_version > 2) then + call subcol_field_avg(icgrauwp, ngrdcol, lchnk, icgrauwp_grid) + call subcol_field_avg(cldfgrau, ngrdcol, lchnk, cldfsnow_grid) + end if + + if (rate1_cw2pr_st_idx > 0) then + call subcol_field_avg(rate1ord_cw2pr_st, ngrdcol, lchnk, rate1ord_cw2pr_st_grid) + end if + + end if + + ! ------------------------------------- ! + ! Size distribution calculation ! + ! ------------------------------------- ! + + ! Calculate rho (on subcolumns if turned on) for size distribution + ! parameter calculations and average it if needed + ! + ! State instead of state_loc to preserve answers for MG1 (and in any + ! case, it is unlikely to make much difference). + rho(:ncol,top_lev:) = state%pmid(:ncol,top_lev:) / & + (rair*state%t(:ncol,top_lev:)) + if (use_subcol_microp) then + call subcol_field_avg(rho, ngrdcol, lchnk, rho_grid) + else + rho_grid = rho + end if + + ! Effective radius for cloud liquid, fixed number. + mu_grid = 0._r8 + lambdac_grid = 0._r8 + rel_fn_grid = 10._r8 + + ncic_grid = 1.e8_r8 + + do k = top_lev, pver + !$acc data copyin (mg_liq_props,icwmrst_grid(:ngrdcol,k),rho_grid(:ngrdcol,k)) & + !$acc copy (ncic_grid(:ngrdcol,k)) & + !$acc copyout (mu_grid(:ngrdcol,k),lambdac_grid(:ngrdcol,k)) + call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,k), & + ncic_grid(:ngrdcol,k), rho_grid(:ngrdcol,k), & + mu_grid(:ngrdcol,k), lambdac_grid(:ngrdcol,k), ngrdcol) + !$acc end data + end do + + where (icwmrst_grid(:ngrdcol,top_lev:) > qsmall) + rel_fn_grid(:ngrdcol,top_lev:) = & + (mu_grid(:ngrdcol,top_lev:) + 3._r8)/ & + lambdac_grid(:ngrdcol,top_lev:)/2._r8 * 1.e6_r8 + end where + + ! Effective radius for cloud liquid, and size parameters + ! mu_grid and lambdac_grid. + mu_grid = 0._r8 + lambdac_grid = 0._r8 + rel_grid = 10._r8 + + ! Calculate ncic on the grid + ncic_grid(:ngrdcol,top_lev:) = nc_grid(:ngrdcol,top_lev:) / & + max(mincld,liqcldf_grid(:ngrdcol,top_lev:)) + + do k = top_lev, pver + !$acc data copyin (mg_liq_props,icwmrst_grid(:ngrdcol,k), rho_grid(:ngrdcol,k)) & + !$acc copy (ncic_grid(:ngrdcol,k)) & + !$acc copyout (mu_grid(:ngrdcol,k),lambdac_grid(:ngrdcol,k)) + call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,k), & + ncic_grid(:ngrdcol,k), rho_grid(:ngrdcol,k), & + mu_grid(:ngrdcol,k), lambdac_grid(:ngrdcol,k), ngrdcol) + !$acc end data + end do + + where (icwmrst_grid(:ngrdcol,top_lev:) >= qsmall) + rel_grid(:ngrdcol,top_lev:) = & + (mu_grid(:ngrdcol,top_lev:) + 3._r8) / & + lambdac_grid(:ngrdcol,top_lev:)/2._r8 * 1.e6_r8 + elsewhere + ! Deal with the fact that size_dist_param_liq sets mu_grid to -100 + ! wherever there is no cloud. + mu_grid(:ngrdcol,top_lev:) = 0._r8 + end where + + ! Rain/Snow effective diameter. + drout2_grid = 0._r8 + reff_rain_grid = 0._r8 + des_grid = 0._r8 + dsout2_grid = 0._r8 + reff_snow_grid = 0._r8 + reff_grau_grid = 0._r8 + + ! Prognostic precipitation + + where (qr_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) + drout2_grid(:ngrdcol,top_lev:) = avg_diameter( & + qr_grid(:ngrdcol,top_lev:), & + nr_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & + rho_grid(:ngrdcol,top_lev:), rhow) + + reff_rain_grid(:ngrdcol,top_lev:) = drout2_grid(:ngrdcol,top_lev:) * & + shapeparam * micron2meter + end where + + where (qs_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) + dsout2_grid(:ngrdcol,top_lev:) = avg_diameter( & + qs_grid(:ngrdcol,top_lev:), & + ns_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & + rho_grid(:ngrdcol,top_lev:), rhosn) + + des_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) *& + 3._r8 * rhosn/rhows + + reff_snow_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) * & + shapeparam * micron2meter + end where + + +! Graupel/Hail size distribution Placeholder + if (micro_mg_version > 2) then + degrau_grid = 0._r8 + where (qg_grid(:ngrdcol,top_lev:) >= 1.e-7_r8) + dgout2_grid(:ngrdcol,top_lev:) = avg_diameter( & + qg_grid(:ngrdcol,top_lev:), & + ng_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), & + rho_grid(:ngrdcol,top_lev:), rhog) + + reff_grau_grid(:ngrdcol,top_lev:) = dgout2_grid(:ngrdcol,top_lev:) * & + 1.5_r8 * 1.e6_r8 + degrau_grid(:ngrdcol,top_lev:) = dgout2_grid(:ngrdcol,top_lev:) *& + 3._r8 * rhog/rhows + end where + end if + + ! Effective radius and diameter for cloud ice. + rei_grid = 25._r8 + + niic_grid(:ngrdcol,top_lev:) = ni_grid(:ngrdcol,top_lev:) / & + max(mincld,icecldf_grid(:ngrdcol,top_lev:)) + + do k = top_lev, pver + !$acc data copyin (mg_ice_props, icimrst_grid(:ngrdcol,k)) & + !$acc copy (niic_grid(:ngrdcol,k)) & + !$acc copyout (rei_grid(:ngrdcol,k)) + call size_dist_param_basic(mg_ice_props,icimrst_grid(:ngrdcol,k), & + niic_grid(:ngrdcol,k),rei_grid(:ngrdcol,k),ngrdcol) + !$acc end data + end do + + where (icimrst_grid(:ngrdcol,top_lev:) >= qsmall) + rei_grid(:ngrdcol,top_lev:) = 1.5_r8/rei_grid(:ngrdcol,top_lev:) & + * 1.e6_r8 + elsewhere + rei_grid(:ngrdcol,top_lev:) = 25._r8 + end where + + dei_grid = rei_grid * rhoi/rhows * 2._r8 + + ! Limiters for low cloud fraction. + do k = top_lev, pver + do i = 1, ngrdcol + ! Convert snow effective diameter to microns + des_grid(i,k) = des_grid(i,k) * 1.e6_r8 + if ( ast_grid(i,k) < 1.e-4_r8 ) then + mu_grid(i,k) = mucon + lambdac_grid(i,k) = (mucon + 1._r8)/dcon + dei_grid(i,k) = deicon + end if + end do + end do + + mgreffrain_grid(:ngrdcol,top_lev:pver) = reff_rain_grid(:ngrdcol,top_lev:pver) + mgreffsnow_grid(:ngrdcol,top_lev:pver) = reff_snow_grid(:ngrdcol,top_lev:pver) + + ! ------------------------------------- ! + ! Precipitation efficiency Calculation ! + ! ------------------------------------- ! + + !----------------------------------------------------------------------- + ! Liquid water path + + ! Compute liquid water paths, and column condensation + tgliqwp_grid(:ngrdcol) = 0._r8 + tgcmeliq_grid(:ngrdcol) = 0._r8 + do k = top_lev, pver + do i = 1, ngrdcol + tgliqwp_grid(i) = tgliqwp_grid(i) + iclwpst_grid(i,k)*cld_grid(i,k) + + if (cmeliq_grid(i,k) > 1.e-12_r8) then + !convert cmeliq to right units: kgh2o/kgair/s * kgair/m2 / kgh2o/m3 = m/s + tgcmeliq_grid(i) = tgcmeliq_grid(i) + cmeliq_grid(i,k) * & + (pdel_grid(i,k) / gravit) / rhoh2o + end if + end do + end do + + ! note: 1e-6 kgho2/kgair/s * 1000. pa / (9.81 m/s2) / 1000 kgh2o/m3 = 1e-7 m/s + ! this is 1ppmv of h2o in 10hpa + ! alternatively: 0.1 mm/day * 1.e-4 m/mm * 1/86400 day/s = 1.e-9 + + !----------------------------------------------------------------------- + ! precipitation efficiency calculation (accumulate cme and precip) + + minlwp = 0.01_r8 !minimum lwp threshold (kg/m3) + + ! zero out precip efficiency and total averaged precip + pe_grid(:ngrdcol) = 0._r8 + tpr_grid(:ngrdcol) = 0._r8 + pefrac_grid(:ngrdcol) = 0._r8 + + ! accumulate precip and condensation + do i = 1, ngrdcol + + acgcme_grid(i) = acgcme_grid(i) + tgcmeliq_grid(i) + acprecl_grid(i) = acprecl_grid(i) + prec_str_grid(i) + acnum_grid(i) = acnum_grid(i) + 1 + + ! if LWP is zero, then 'end of cloud': calculate precip efficiency + if (tgliqwp_grid(i) < minlwp) then + if (acprecl_grid(i) > 5.e-8_r8) then + tpr_grid(i) = max(acprecl_grid(i)/acnum_grid(i), 1.e-15_r8) + if (acgcme_grid(i) > 1.e-10_r8) then + pe_grid(i) = min(max(acprecl_grid(i)/acgcme_grid(i), 1.e-15_r8), 1.e5_r8) + pefrac_grid(i) = 1._r8 + end if + end if + + ! reset counters +! if (pe_grid(i) /= 0._r8 .and. (pe_grid(i) < 1.e-8_r8 .or. pe_grid(i) > 1.e3_r8)) then +! write (iulog,*) 'PE_grid:ANOMALY pe_grid, acprecl_grid, acgcme_grid, tpr_grid, acnum_grid ', & +! pe_grid(i),acprecl_grid(i), acgcme_grid(i), tpr_grid(i), acnum_grid(i) +! endif + + acprecl_grid(i) = 0._r8 + acgcme_grid(i) = 0._r8 + acnum_grid(i) = 0 + end if ! end LWP zero conditional + + ! if never find any rain....(after 10^3 timesteps...) + if (acnum_grid(i) > 1000) then + acnum_grid(i) = 0 + acprecl_grid(i) = 0._r8 + acgcme_grid(i) = 0._r8 + end if + + end do + + !----------------------------------------------------------------------- + ! vertical average of non-zero accretion, autoconversion and ratio. + ! vars: vprco_grid(i),vprao_grid(i),racau_grid(i),cnt_grid + + vprao_grid = 0._r8 + cnt_grid = 0 + do k = top_lev, pver + vprao_grid(:ngrdcol) = vprao_grid(:ngrdcol) + prao_grid(:ngrdcol,k) + where (prao_grid(:ngrdcol,k) /= 0._r8) cnt_grid(:ngrdcol) = cnt_grid(:ngrdcol) + 1 + end do + + where (cnt_grid > 0) vprao_grid = vprao_grid/cnt_grid + + vprco_grid = 0._r8 + cnt_grid = 0 + do k = top_lev, pver + vprco_grid(:ngrdcol) = vprco_grid(:ngrdcol) + prco_grid(:ngrdcol,k) + where (prco_grid(:ngrdcol,k) /= 0._r8) cnt_grid(:ngrdcol) = cnt_grid(:ngrdcol) + 1 + end do + + where (cnt_grid > 0) + vprco_grid = vprco_grid/cnt_grid + racau_grid = vprao_grid/vprco_grid + elsewhere + racau_grid = 0._r8 + end where + + racau_grid = min(racau_grid, 1.e10_r8) + +!----------------------------------------------------------------------- +! Diagnostic Rainbow Calculation. Seriously. +!----------------------------------------------------------------------- + + do i = 1, ngrdcol + + top_idx = pver + convmx = 0._r8 + frlow = 0._r8 + cldmx = 0._r8 + cldtot = maxval(ast(i,top_lev:)) + +! Find levels in surface layer + do k = top_lev, pver + if (state%pmid(i,k) > rb_pmin) then + top_idx = min(k,top_idx) + end if + end do + +!For all fractional precip calculated below, use maximum in surface layer. +!For convective precip, base on convective cloud area + convmx = maxval(concld(i,top_idx:)) +!For stratiform precip, base on precip fraction + cldmx= maxval(freqr(i,top_idx:)) +! Combine and use maximum of strat or conv fraction + frlow= max(cldmx,convmx) + +!max precip + rmax=maxval(qrout_grid(i,top_idx:)) + +! Stratiform precip mixing ratio OR some convective precip +! (rval = true if any sig precip) + + rval = ((precc(i) > rb_rcmin) .or. (rmax > rb_rmin)) + +!Now can find conditions for a rainbow: +! Maximum cloud cover (CLDTOT) < 0.5 +! 48 < SZA < 90 +! freqr (below rb_pmin) > 0.25 +! Some rain (liquid > 1.e-6 kg/kg, convective precip > 1.e-7 m/s + + if ((cldtot < 0.5_r8) .and. (sza(i) > 48._r8) .and. (sza(i) < 90._r8) .and. rval) then + +!Rainbow 'probability' (area) derived from solid angle theory +!as the fraction of the hemisphere for a spherical cap with angle phi=sza-48. +! This is only valid between 48 < sza < 90 (controlled for above). + + rbfrac(i) = max(0._r8,(1._r8-COS((sza(i)-48._r8)*deg2rad))/2._r8) * frlow + rbfreq(i) = 1.0_r8 + end if + + end do ! end column loop for rainbows + + call outfld('RBFRAC', rbfrac, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('RBFREQ', rbfreq, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + + + ! --------------------- ! + ! History Output Fields ! + ! --------------------- ! + + ! Column droplet concentration + cdnumc_grid(:ngrdcol) = sum(nc_grid(:ngrdcol,top_lev:pver) * & + pdel_grid(:ngrdcol,top_lev:pver)/gravit, dim=2) + + ! Averaging for new output fields + efcout_grid = 0._r8 + efiout_grid = 0._r8 + ncout_grid = 0._r8 + niout_grid = 0._r8 + freql_grid = 0._r8 + freqi_grid = 0._r8 + icwmrst_grid_out = 0._r8 + icimrst_grid_out = 0._r8 + freqm_grid = 0._r8 + freqsl_grid = 0._r8 + freqslm_grid = 0._r8 + + do k = top_lev, pver + do i = 1, ngrdcol + if ( liqcldf_grid(i,k) > 0.01_r8 .and. icwmrst_grid(i,k) > 5.e-5_r8 ) then + efcout_grid(i,k) = rel_grid(i,k) * liqcldf_grid(i,k) + ncout_grid(i,k) = icwnc_grid(i,k) * liqcldf_grid(i,k) + freql_grid(i,k) = liqcldf_grid(i,k) + icwmrst_grid_out(i,k) = icwmrst_grid(i,k) + end if + if ( icecldf_grid(i,k) > 0.01_r8 .and. icimrst_grid(i,k) > 1.e-6_r8 ) then + efiout_grid(i,k) = rei_grid(i,k) * icecldf_grid(i,k) + niout_grid(i,k) = icinc_grid(i,k) * icecldf_grid(i,k) + freqi_grid(i,k) = icecldf_grid(i,k) + icimrst_grid_out(i,k) = icimrst_grid(i,k) + end if + + ! Supercooled liquid + if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) > 0.01_r8 ) then + freqm_grid(i,k)=min(liqcldf_grid(i,k),icecldf_grid(i,k)) + end if + if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) < 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then + freqsl_grid(i,k)=liqcldf_grid(i,k) + end if + if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) > 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then + freqslm_grid(i,k)=liqcldf_grid(i,k) + end if + + end do + end do + + ! Cloud top effective radius and number. + fcti_grid = 0._r8 + fctl_grid = 0._r8 + ctrel_grid = 0._r8 + ctrei_grid = 0._r8 + ctnl_grid = 0._r8 + ctni_grid = 0._r8 + fctm_grid = 0._r8 + fctsl_grid = 0._r8 + fctslm_grid= 0._r8 + + do i = 1, ngrdcol + do k = top_lev, pver + if ( liqcldf_grid(i,k) > 0.01_r8 .and. icwmrst_grid(i,k) > 1.e-7_r8 ) then + ctrel_grid(i) = rel_grid(i,k) * liqcldf_grid(i,k) + ctnl_grid(i) = icwnc_grid(i,k) * liqcldf_grid(i,k) + fctl_grid(i) = liqcldf_grid(i,k) + + ! Cloud Top Mixed phase, supercooled liquid only and supercooled liquid mixed + if (freqi_grid(i,k) > 0.01_r8) then + fctm_grid(i)=min(liqcldf_grid(i,k),icecldf_grid(i,k)) + end if + if (freqi_grid(i,k) < 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then + fctsl_grid(i)=liqcldf_grid(i,k) + end if + if (freqi_grid(i,k) > 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then + fctslm_grid(i)=liqcldf_grid(i,k) + end if + + exit + end if + + if ( icecldf_grid(i,k) > 0.01_r8 .and. icimrst_grid(i,k) > 1.e-7_r8 ) then + ctrei_grid(i) = rei_grid(i,k) * icecldf_grid(i,k) + ctni_grid(i) = icinc_grid(i,k) * icecldf_grid(i,k) + fcti_grid(i) = icecldf_grid(i,k) + exit + end if + end do + end do + + ! Evaporation of stratiform precipitation fields for UNICON + evprain_st_grid(:ngrdcol,:pver) = nevapr_grid(:ngrdcol,:pver) - evpsnow_st_grid(:ngrdcol,:pver) + do k = top_lev, pver + do i = 1, ngrdcol + evprain_st_grid(i,k) = max(evprain_st_grid(i,k), 0._r8) + evpsnow_st_grid(i,k) = max(evpsnow_st_grid(i,k), 0._r8) + end do + end do + + ! Assign the values to the pbuf pointers if they exist in pbuf + if (qrain_idx > 0) qrout_grid_ptr = qrout_grid + if (qsnow_idx > 0) qsout_grid_ptr = qsout_grid + if (nrain_idx > 0) nrout_grid_ptr = nrout_grid + if (nsnow_idx > 0) nsout_grid_ptr = nsout_grid + if (qcsedten_idx > 0) qcsedtenout_grid_ptr = qcsedtenout_grid + if (qrsedten_idx > 0) qrsedtenout_grid_ptr = qrsedtenout_grid + if (qisedten_idx > 0) qisedtenout_grid_ptr = qisedtenout_grid + if (qssedten_idx > 0) qssedtenout_grid_ptr = qssedtenout_grid + if (vtrmc_idx > 0) vtrmcout_grid_ptr = vtrmcout_grid + if (umr_idx > 0) umrout_grid_ptr = umrout_grid + if (vtrmi_idx > 0) vtrmiout_grid_ptr = vtrmiout_grid + if (ums_idx > 0) umsout_grid_ptr = umsout_grid + if (qcsevap_idx > 0 ) qcsevapout_grid_ptr = qcsevapout_grid + if (qisevap_idx > 0 ) qisevapout_grid_ptr = qisevapout_grid + + ! --------------------------------------------- ! + ! General outfield calls for microphysics ! + ! --------------------------------------------- ! + + ! Output a handle of variables which are calculated on the fly + + ftem_grid = 0._r8 + + ftem_grid(:ngrdcol,top_lev:pver) = qcreso_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDW2V', ftem_grid, pcols, lchnk) + + ftem_grid(:ngrdcol,top_lev:pver) = melto_grid(:ngrdcol,top_lev:pver) - mnuccco_grid(:ngrdcol,top_lev:pver)& + - mnuccto_grid(:ngrdcol,top_lev:pver) - bergo_grid(:ngrdcol,top_lev:pver) - homoo_grid(:ngrdcol,top_lev:pver)& + - msacwio_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDW2I', ftem_grid, pcols, lchnk) + + if (micro_mg_version > 2) then + ftem_grid(:ngrdcol,top_lev:pver) = -prao_grid(:ngrdcol,top_lev:pver) - prco_grid(:ngrdcol,top_lev:pver)& + - psacwso_grid(:ngrdcol,top_lev:pver) - bergso_grid(:ngrdcol,top_lev:pver)& + - psacwgo_grid(:ngrdcol,top_lev:pver) - pgsacwo_grid(:ngrdcol,top_lev:pver) + else + ftem_grid(:ngrdcol,top_lev:pver) = -prao_grid(:ngrdcol,top_lev:pver) - prco_grid(:ngrdcol,top_lev:pver)& + - psacwso_grid(:ngrdcol,top_lev:pver) - bergso_grid(:ngrdcol,top_lev:pver) + endif + + call outfld( 'MPDW2P', ftem_grid, pcols, lchnk) + + ftem_grid(:ngrdcol,top_lev:pver) = cmeiout_grid(:ngrdcol,top_lev:pver) + qireso_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDI2V', ftem_grid, pcols, lchnk) + + if (micro_mg_version > 2) then + ftem_grid(:ngrdcol,top_lev:pver) = -melto_grid(:ngrdcol,top_lev:pver) + mnuccco_grid(:ngrdcol,top_lev:pver) & + + mnuccto_grid(:ngrdcol,top_lev:pver) + bergo_grid(:ngrdcol,top_lev:pver) + homoo_grid(:ngrdcol,top_lev:pver)& + + msacwio_grid(:ngrdcol,top_lev:pver)& + - qmultgo_grid(:ngrdcol,top_lev:pver) + else + ftem_grid(:ngrdcol,top_lev:pver) = -melto_grid(:ngrdcol,top_lev:pver) + mnuccco_grid(:ngrdcol,top_lev:pver) & + + mnuccto_grid(:ngrdcol,top_lev:pver) + bergo_grid(:ngrdcol,top_lev:pver) + homoo_grid(:ngrdcol,top_lev:pver)& + + msacwio_grid(:ngrdcol,top_lev:pver) + endif + + call outfld( 'MPDI2W', ftem_grid, pcols, lchnk) + + ftem_grid(:ngrdcol,top_lev:pver) = -prcio_grid(:ngrdcol,top_lev:pver) - praio_grid(:ngrdcol,top_lev:pver) + call outfld( 'MPDI2P', ftem_grid, pcols, lchnk) + + ! Output fields which have not been averaged already, averaging if use_subcol_microp is true + if (trim(micro_mg_warm_rain) == 'tau' .or. trim(micro_mg_warm_rain) == 'emulated') then + call outfld('scale_qc', proc_rates%scale_qc, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('scale_nc', proc_rates%scale_nc, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('scale_qr', proc_rates%scale_qr, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('scale_nr', proc_rates%scale_nr, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('amk_c', proc_rates%amk_c, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ank_c', proc_rates%ank_c, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('amk_r', proc_rates%amk_r, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ank_r', proc_rates%ank_r, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('amk', proc_rates%amk, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ank', proc_rates%ank, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('amk_out', proc_rates%amk_out, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ank_out', proc_rates%ank_out, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QC_TAU_out', proc_rates%qc_out_TAU, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('NC_TAU_out', proc_rates%nc_out_TAU, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QR_TAU_out', proc_rates%qr_out_TAU, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('NR_TAU_out', proc_rates%nr_out_TAU, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('qctend_TAU', proc_rates%qctend_TAU, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('nctend_TAU', proc_rates%nctend_TAU, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('qrtend_TAU', proc_rates%qrtend_TAU, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('nrtend_TAU', proc_rates%nrtend_TAU, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('gmnnn_lmnnn_TAU', proc_rates%gmnnn_lmnnn_TAU, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ML_fixer', proc_rates%ML_fixer, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('qc_fixer', proc_rates%qc_fixer, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('nc_fixer', proc_rates%nc_fixer, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('qr_fixer', proc_rates%qr_fixer, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('nr_fixer', proc_rates%nr_fixer, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QC_TAU_in', proc_rates%qc_in_TAU, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('NC_TAU_in', proc_rates%nc_in_TAU, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QR_TAU_in', proc_rates%qr_in_TAU, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('NR_TAU_in', proc_rates%nr_in_TAU, ncol, lchnk, avg_subcol_field=use_subcol_microp) + end if + + if (trim(micro_mg_warm_rain) == 'sb2001') then + call outfld('qctend_SB2001', proc_rates%qctend_SB2001, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('nctend_SB2001', proc_rates%nctend_SB2001, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('qrtend_SB2001', proc_rates%qrtend_SB2001, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('nrtend_SB2001', proc_rates%nrtend_SB2001, ncol, lchnk, avg_subcol_field=use_subcol_microp) + end if + if (trim(micro_mg_warm_rain) == 'kk2000') then + call outfld('qctend_KK2000', proc_rates%qctend_KK2000, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('nctend_KK2000', proc_rates%nctend_KK2000, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('qrtend_KK2000', proc_rates%qrtend_KK2000, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('nrtend_KK2000', proc_rates%nrtend_KK2000, ncol, lchnk, avg_subcol_field=use_subcol_microp) + end if + call outfld('LAMC', proc_rates%lamc_out, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('LAMR', proc_rates%lamr_out, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('PGAM', proc_rates%pgam_out, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('N0R', proc_rates%n0r_out, ncol, lchnk, avg_subcol_field=use_subcol_microp) + + call outfld('MPICLWPI', iclwpi, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPICIWPI', iciwpi, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('REFL', refl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AREFL', arefl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AREFLZ', areflz, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FREFL', frefl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('CSRFL', csrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ACSRFL', acsrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FCSRFL', fcsrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('REFL10CM', refl10cm, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('REFLZ10CM', reflz10cm, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('RERCLD', rercld, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('NCAL', ncal, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('NCAI', ncai, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AQRAIN', qrout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AQSNOW', qsout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ANRAIN', nrout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ANSNOW', nsout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FREQR', freqr, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FREQS', freqs, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDT', tlat, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDQ', qvlat, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDLIQ', qcten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDICE', qiten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDNLIQ', ncten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MPDNICE', niten, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('EVAPSNOW', proc_rates%evapsnow, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QCSEVAP', proc_rates%qcsevap, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QISEVAP', proc_rates%qisevap, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QVRES', proc_rates%qvres, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('VTRMC', proc_rates%vtrmc, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('VTRMI', proc_rates%vtrmi, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QCSEDTEN', proc_rates%qcsedten, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QISEDTEN', proc_rates%qisedten, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QRSEDTEN', proc_rates%qrsedten, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QSSEDTEN', proc_rates%qssedten, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MNUCCRIO', proc_rates%mnuccritot, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MNUDEPO', proc_rates%mnudeptot, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MELTSTOT', proc_rates%meltstot, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MNUCCDO', proc_rates%mnuccdtot, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MNUCCDOhet', mnuccdohet, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MNUCCRO', proc_rates%mnuccrtot, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('PRACSO', proc_rates%pracstot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('VAPDEPSO', proc_rates%vapdepstot, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MELTSDT', proc_rates%meltsdttot, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FRZRDT', proc_rates%frzrdttot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FICE', nfice, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('CLDFSNOW', cldfsnow, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NNUCCCO', proc_rates%nnuccctot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NNUCCTO', proc_rates%nnuccttot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NNUCCDO', proc_rates%nnuccdtot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NNUDEPO', proc_rates%nnudeptot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NHOMO', proc_rates%nhomotot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NNUCCRO', proc_rates%nnuccrtot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NNUCCRIO', proc_rates%nnuccritot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NSACWIO', proc_rates%nsacwitot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NPRAO', proc_rates%npratot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NPSACWSO', proc_rates%npsacwstot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NPRAIO', proc_rates%npraitot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NPRACSO', proc_rates%npracstot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NPRCO', proc_rates%nprctot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NPRCIO', proc_rates%nprcitot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NCSEDTEN', proc_rates%ncsedten , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NISEDTEN', proc_rates%nisedten , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NRSEDTEN', proc_rates%nrsedten , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NSSEDTEN', proc_rates%nssedten , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NMELTO', proc_rates%nmelttot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld ('NMELTS', proc_rates%nmeltstot , ncol, lchnk, avg_subcol_field=use_subcol_microp) + + call outfld('UMR', proc_rates%umr, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('UMS', proc_rates%ums, ncol, lchnk, avg_subcol_field=use_subcol_microp) + + call outfld('QCRAT', qcrat, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + + if (micro_mg_version > 2) then + call outfld('UMG', proc_rates%umg, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('QGSEDTEN', proc_rates%qgsedten, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('FREQG', freqg, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('AQGRAU', qgout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('ANGRAU', ngout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('CLDFGRAU', cldfgrau, psetcols, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('MELTGTOT', proc_rates%meltgtot, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('NMELTG', proc_rates%nmeltgtot, ncol, lchnk, avg_subcol_field=use_subcol_microp) + call outfld('NGSEDTEN', proc_rates%ngsedten , ncol, lchnk, avg_subcol_field=use_subcol_microp) + + end if + + ! Example subcolumn outfld call + if (use_subcol_microp) then + call outfld('FICE_SCOL', nfice, psubcols*pcols, lchnk) + call outfld('MPDLIQ_SCOL', ptend%q(:,:,ixcldliq), psubcols*pcols, lchnk) + call outfld('MPDICE_SCOL', qiten, psubcols*pcols, lchnk) + end if + + ! Output fields which are already on the grid + call outfld('QRAIN', qrout_grid, pcols, lchnk) + call outfld('QSNOW', qsout_grid, pcols, lchnk) + call outfld('NRAIN', nrout_grid, pcols, lchnk) + call outfld('NSNOW', nsout_grid, pcols, lchnk) + call outfld('CV_REFFLIQ', cvreffliq_grid, pcols, lchnk) + call outfld('CV_REFFICE', cvreffice_grid, pcols, lchnk) + call outfld('LS_FLXPRC', mgflxprc_grid, pcols, lchnk) + call outfld('LS_FLXSNW', mgflxsnw_grid, pcols, lchnk) + call outfld('CME', qme_grid, pcols, lchnk) + call outfld('PRODPREC', prain_grid, pcols, lchnk) + call outfld('EVAPPREC', nevapr_grid, pcols, lchnk) + call outfld('QCRESO', qcreso_grid, pcols, lchnk) + call outfld('LS_REFFRAIN', mgreffrain_grid, pcols, lchnk) + call outfld('LS_REFFSNOW', mgreffsnow_grid, pcols, lchnk) + call outfld('DSNOW', des_grid, pcols, lchnk) + call outfld('ADRAIN', drout2_grid, pcols, lchnk) + call outfld('ADSNOW', dsout2_grid, pcols, lchnk) + call outfld('PE', pe_grid, pcols, lchnk) + call outfld('PEFRAC', pefrac_grid, pcols, lchnk) + call outfld('APRL', tpr_grid, pcols, lchnk) + call outfld('VPRAO', vprao_grid, pcols, lchnk) + call outfld('VPRCO', vprco_grid, pcols, lchnk) + call outfld('RACAU', racau_grid, pcols, lchnk) + call outfld('AREL', efcout_grid, pcols, lchnk) + call outfld('AREI', efiout_grid, pcols, lchnk) + call outfld('AWNC' , ncout_grid, pcols, lchnk) + call outfld('AWNI' , niout_grid, pcols, lchnk) + call outfld('FREQL', freql_grid, pcols, lchnk) + call outfld('FREQI', freqi_grid, pcols, lchnk) + call outfld('ACTREL', ctrel_grid, pcols, lchnk) + call outfld('ACTREI', ctrei_grid, pcols, lchnk) + call outfld('ACTNL', ctnl_grid, pcols, lchnk) + call outfld('ACTNI', ctni_grid, pcols, lchnk) + call outfld('FCTL', fctl_grid, pcols, lchnk) + call outfld('FCTI', fcti_grid, pcols, lchnk) + call outfld('ICINC', icinc_grid, pcols, lchnk) + call outfld('ICWNC', icwnc_grid, pcols, lchnk) + call outfld('EFFLIQ_IND', rel_fn_grid, pcols, lchnk) + call outfld('CDNUMC', cdnumc_grid, pcols, lchnk) + call outfld('REL', rel_grid, pcols, lchnk) + call outfld('REI', rei_grid, pcols, lchnk) + call outfld('MG_SADICE', sadice_grid, pcols, lchnk) + call outfld('MG_SADSNOW', sadsnow_grid, pcols, lchnk) + call outfld('ICIMRST', icimrst_grid_out, pcols, lchnk) + call outfld('ICWMRST', icwmrst_grid_out, pcols, lchnk) + call outfld('CMEIOUT', cmeiout_grid, pcols, lchnk) + call outfld('PRAO', prao_grid, pcols, lchnk) + call outfld('PRCO', prco_grid, pcols, lchnk) + call outfld('MNUCCCO', mnuccco_grid, pcols, lchnk) + call outfld('MNUCCTO', mnuccto_grid, pcols, lchnk) + call outfld('MSACWIO', msacwio_grid, pcols, lchnk) + call outfld('PSACWSO', psacwso_grid, pcols, lchnk) + call outfld('BERGSO', bergso_grid, pcols, lchnk) + call outfld('BERGO', bergo_grid, pcols, lchnk) + call outfld('MELTO', melto_grid, pcols, lchnk) + call outfld('HOMOO', homoo_grid, pcols, lchnk) + call outfld('PRCIO', prcio_grid, pcols, lchnk) + call outfld('PRAIO', praio_grid, pcols, lchnk) + call outfld('QIRESO', qireso_grid, pcols, lchnk) + call outfld('FREQM', freqm_grid, pcols, lchnk) + call outfld('FREQSL', freqsl_grid, pcols, lchnk) + call outfld('FREQSLM', freqslm_grid, pcols, lchnk) + call outfld('FCTM', fctm_grid, pcols, lchnk) + call outfld('FCTSL', fctsl_grid, pcols, lchnk) + call outfld('FCTSLM', fctslm_grid, pcols, lchnk) + + if (micro_mg_version > 2) then + call outfld('PRACGO', pracgo_grid, pcols, lchnk) + call outfld('PSACRO', psacro_grid, pcols, lchnk) + call outfld('PSACWGO', psacwgo_grid, pcols, lchnk) + call outfld('PGSACWO', pgsacwo_grid, pcols, lchnk) + call outfld('PGRACSO', pgracso_grid, pcols, lchnk) + call outfld('PRDGO', prdgo_grid, pcols, lchnk) + call outfld('QMULTGO', qmultgo_grid, pcols, lchnk) + call outfld('QMULTRGO', qmultrgo_grid, pcols, lchnk) + call outfld('LS_REFFGRAU', reff_grau_grid, pcols, lchnk) + call outfld ('NPRACGO', npracgo_grid, pcols, lchnk) + call outfld ('NSCNGO', nscngo_grid, pcols, lchnk) + call outfld ('NGRACSO', ngracso_grid, pcols, lchnk) + call outfld ('NMULTGO', nmultgo_grid, pcols, lchnk) + call outfld ('NMULTRGO', nmultrgo_grid, pcols, lchnk) + call outfld ('NPSACWGO', npsacwgo_grid, pcols, lchnk) + end if + + if (micro_mg_adjust_cpt) then + cp_rh(:ncol, :pver) = 0._r8 + + do i = 1, ncol + + ! Calculate the RH including any T change that we make. + do k = top_lev, pver + call qsat(state_loc%t(i,k), state_loc%pmid(i,k), es, qs) + cp_rh(i,k) = state_loc%q(i, k, ixq) / qs * 100._r8 + end do + end do + + call outfld("TROPF_RHADJ", cp_rh, pcols, lchnk) + end if + + ! deallocate the temporary pbuf grid variable which was allocated if subcolumns are not used + if (.not. use_subcol_microp) then + deallocate(bergso_grid) + end if + + ! deallocate the proc_rates DDT + call proc_rates%deallocate(micro_mg_warm_rain) + + ! ptend_loc is deallocated in physics_update above + call physics_state_dealloc(state_loc) + + if (qsatfac_idx <= 0) then + deallocate(qsatfac) + end if + +end subroutine micro_pumas_cam_tend + +subroutine massless_droplet_destroyer(ztodt, state, ptend) + + ! This subroutine eradicates cloud droplets in grid boxes with no cloud + ! mass. This code is now expanded to remove massless rain drops, ice + ! crystals, and snow flakes. + ! + ! Note: qsmall, which is a small, positive number, is used as the + ! threshold here instead of qmin, which is 0. Some numbers that are + ! supposed to have a value of 0, but don't because of numerical + ! roundoff (especially after hole filling) will have small, positive + ! values. Using qsmall as the threshold here instead of qmin allows + ! for unreasonable massless drop concentrations to be removed in + ! those scenarios. + + use micro_pumas_utils, only: qsmall + use ref_pres, only: top_lev => trop_cloud_top_lev + + implicit none + + ! Input Variables + real(r8), intent(in) :: ztodt ! model time increment + type(physics_state), intent(in) :: state ! state for columns + + ! Input/Output Variables + type(physics_ptend), intent(inout) :: ptend ! ptend for columns + + ! Local Variables + integer :: icol, k + + !----- Begin Code ----- + + ! Don't do anything if this option isn't enabled. + if ( .not. micro_do_massless_droplet_destroyer ) return + + col_loop: do icol=1, state%ncol + vert_loop: do k = top_lev, pver + ! If updated qc (after microphysics) is zero, then ensure updated nc is also zero!! + if ( state%q(icol,k,ixcldliq) + ztodt * ptend%q(icol,k,ixcldliq) < qsmall ) then + ptend%lq(ixnumliq) = .true. ! This is probably already true, but it doesn't + ! hurt to set it. + ptend%q(icol,k,ixnumliq) = -(state%q(icol,k,ixnumliq) / ztodt) + end if + if ( ixnumrain > 0 ) then + ! If updated qr (after microphysics) is zero, then ensure updated nr is also zero!! + if ( state%q(icol,k,ixrain) + ztodt * ptend%q(icol,k,ixrain) < qsmall ) then + ptend%lq(ixnumrain) = .true. ! This is probably already true, but it doesn't + ! hurt to set it. + ptend%q(icol,k,ixnumrain) = -(state%q(icol,k,ixnumrain) / ztodt) + end if + endif ! ixnumrain > 0 + ! If updated qi (after microphysics) is zero, then ensure updated ni is also zero!! + if ( state%q(icol,k,ixcldice) + ztodt * ptend%q(icol,k,ixcldice) < qsmall ) then + ptend%lq(ixnumice) = .true. ! This is probably already true, but it doesn't + ! hurt to set it. + ptend%q(icol,k,ixnumice) = -(state%q(icol,k,ixnumice) / ztodt) + end if + if ( ixnumsnow > 0 ) then + ! If updated qs (after microphysics) is zero, then ensure updated ns is also zero!! + if ( state%q(icol,k,ixsnow) + ztodt * ptend%q(icol,k,ixsnow) < qsmall ) then + ptend%lq(ixnumsnow) = .true. ! This is probably already true, but it doesn't + ! hurt to set it. + ptend%q(icol,k,ixnumsnow) = -(state%q(icol,k,ixnumsnow) / ztodt) + end if + endif ! ixnumsnow > 0 + end do vert_loop + end do col_loop + + return +end subroutine massless_droplet_destroyer + +end module micro_pumas_cam diff --git a/src/physics/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90 new file mode 100644 index 0000000000..43b55137f9 --- /dev/null +++ b/src/physics/cam7/physpkg.F90 @@ -0,0 +1,3029 @@ +module physpkg + !----------------------------------------------------------------------- + ! Purpose: + ! + ! Provides the interface to CAM physics package + ! + ! Module contains reordered physics to accomodate CLUBB + ! Modified after original physpkg module, Dec 2021, A. Herrington + !----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use physconst, only: latvap, latice + use physics_types, only: physics_state, physics_tend, physics_state_set_grid, & + physics_ptend, physics_tend_init, physics_update, & + physics_type_alloc, physics_ptend_dealloc,& + physics_state_alloc, physics_state_dealloc, physics_tend_alloc, physics_tend_dealloc + use phys_grid, only: get_ncols_p + use phys_gmean, only: gmean_mass + use ppgrid, only: begchunk, endchunk, pcols, pver, pverp, psubcols + use constituents, only: pcnst, cnst_name, cnst_get_ind + use camsrfexch, only: cam_out_t, cam_in_t + + use phys_control, only: use_hemco ! Use Harmonized Emissions Component (HEMCO) + + use cam_control_mod, only: ideal_phys, adiabatic + use phys_control, only: phys_do_flux_avg, phys_getopts, waccmx_is + use scamMod, only: single_column, scm_crm_mode + use flux_avg, only: flux_avg_init + use perf_mod + use cam_logfile, only: iulog + 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 + private + save + + ! Public methods + public phys_register ! was initindx - register physics methods + public phys_init ! Public initialization method + public phys_run1 ! First phase of the public run method + public phys_run2 ! Second phase of the public run method + public phys_final ! Public finalization method + + ! Private module data + + ! Physics package options + character(len=16) :: shallow_scheme + character(len=16) :: macrop_scheme + character(len=16) :: microp_scheme + character(len=16) :: subcol_scheme + character(len=32) :: cam_take_snapshot_before ! Physics routine to take a snapshot "before" + character(len=32) :: cam_take_snapshot_after ! Physics routine to take a snapshot "after" + integer :: cld_macmic_num_steps ! Number of macro/micro substeps + integer :: cam_snapshot_before_num ! tape number for before snapshots + integer :: cam_snapshot_after_num ! tape number for after snapshots + logical :: do_clubb_sgs + logical :: use_subcol_microp ! if true, use subcolumns in microphysics + logical :: state_debug_checks ! Debug physics_state. + logical :: clim_modal_aero ! climate controled by prognostic or prescribed modal aerosols + logical :: prog_modal_aero ! Prognostic modal aerosols present + + ! Physics buffer index + integer :: teout_idx = 0 + + integer :: landm_idx = 0 + integer :: sgh_idx = 0 + integer :: sgh30_idx = 0 + + integer :: qini_idx = 0 + integer :: cldliqini_idx = 0 + integer :: cldiceini_idx = 0 + integer :: totliqini_idx = 0 + integer :: toticeini_idx = 0 + + integer :: prec_str_idx = 0 + integer :: snow_str_idx = 0 + integer :: prec_sed_idx = 0 + integer :: snow_sed_idx = 0 + integer :: prec_pcw_idx = 0 + integer :: snow_pcw_idx = 0 + integer :: prec_dp_idx = 0 + integer :: snow_dp_idx = 0 + integer :: prec_sh_idx = 0 + integer :: snow_sh_idx = 0 + integer :: dlfzm_idx = 0 ! detrained convective cloud water mixing ratio. + integer :: ducore_idx = 0 ! ducore index in physics buffer + integer :: dvcore_idx = 0 ! dvcore index in physics buffer + integer :: dtcore_idx = 0 ! dtcore index in physics buffer + integer :: dqcore_idx = 0 ! dqcore index in physics buffer + integer :: cmfmczm_idx = 0 ! Zhang-McFarlane convective mass fluxes + integer :: rliqbc_idx = 0 ! tphysbc reserve liquid + integer :: psl_idx = 0 + +!======================================================================= +contains +!======================================================================= + + subroutine phys_register + !----------------------------------------------------------------------- + ! + ! Purpose: Register constituents and physics buffer fields. + ! + ! Author: CSM Contact: M. Vertenstein, Aug. 1997 + ! B.A. Boville, Oct 2001 + ! A. Gettelman, Nov 2010 - put micro/macro physics into separate routines + ! + !----------------------------------------------------------------------- + use cam_abortutils, only: endrun + use physics_buffer, only: pbuf_init_time, pbuf_cam_snapshot_register + use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_register_subcol + use constituents, only: cnst_add, cnst_chk_dim + + use cam_control_mod, only: moist_physics + use chemistry, only: chem_register + use mo_lightning, only: lightning_register + use cloud_fraction, only: cldfrc_register + use microp_driver, only: microp_driver_register + use microp_aero, only: microp_aero_register + use macrop_driver, only: macrop_driver_register + use clubb_intr, only: clubb_register_cam + use conv_water, only: conv_water_register + use physconst, only: mwh2o, cpwv + use tracers, only: tracers_register + use check_energy, only: check_energy_register + use carma_intr, only: carma_register + use ghg_data, only: ghg_data_register + use vertical_diffusion, only: vd_register + use convect_deep, only: convect_deep_register + use convect_diagnostics,only: convect_diagnostics_register + use radiation, only: radiation_register + use co2_cycle, only: co2_register + use flux_avg, only: flux_avg_register + use iondrag, only: iondrag_register + use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_reg + use prescribed_ozone, only: prescribed_ozone_register + use prescribed_volcaero,only: prescribed_volcaero_register + use prescribed_strataero,only: prescribed_strataero_register + use prescribed_aero, only: prescribed_aero_register + use prescribed_ghg, only: prescribed_ghg_register + use aoa_tracers, only: aoa_tracers_register + use aircraft_emit, only: aircraft_emit_register + use cam_diagnostics, only: diag_register + use cloud_diagnostics, only: cloud_diagnostics_register + use cospsimulator_intr, only: cospsimulator_intr_register + use rad_constituents, only: rad_cnst_get_info ! Added to query if it is a modal aero sim or not + use radheat, only: radheat_register + use subcol, only: subcol_register + use subcol_utils, only: is_subcol_on, subcol_get_scheme + use dyn_comp, only: dyn_register + use offline_driver, only: offline_driver_reg + use hemco_interface, only: HCOI_Chunk_Init + + !---------------------------Local variables----------------------------- + ! + integer :: m ! loop index + integer :: mm ! constituent index + integer :: nmodes + !----------------------------------------------------------------------- + + ! Get physics options + call phys_getopts(shallow_scheme_out = shallow_scheme, & + macrop_scheme_out = macrop_scheme, & + microp_scheme_out = microp_scheme, & + cld_macmic_num_steps_out = cld_macmic_num_steps, & + do_clubb_sgs_out = do_clubb_sgs, & + use_subcol_microp_out = use_subcol_microp, & + state_debug_checks_out = state_debug_checks, & + cam_take_snapshot_before_out= cam_take_snapshot_before, & + cam_take_snapshot_after_out = cam_take_snapshot_after, & + cam_snapshot_before_num_out = cam_snapshot_before_num, & + cam_snapshot_after_num_out = cam_snapshot_after_num) + + subcol_scheme = subcol_get_scheme() + + ! Initialize dyn_time_lvls + call pbuf_init_time() + + ! Register the subcol scheme + call subcol_register() + + ! Register water vapor. + ! ***** N.B. ***** This must be the first call to cnst_add so that + ! water vapor is constituent 1. + if (moist_physics) then + call cnst_add('Q', mwh2o, cpwv, 1.E-12_r8, mm, & + longname='Specific humidity', readiv=.true., is_convtran1=.true.) + else + call cnst_add('Q', mwh2o, cpwv, 0.0_r8, mm, & + longname='Specific humidity', readiv=.false., is_convtran1=.true.) + end if + + ! Topography file fields. + call pbuf_add_field('LANDM', 'global', dtype_r8, (/pcols/), landm_idx) + call pbuf_add_field('SGH', 'global', dtype_r8, (/pcols/), sgh_idx) + call pbuf_add_field('SGH30', 'global', dtype_r8, (/pcols/), sgh30_idx) + + ! Fields for physics package diagnostics + call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) + call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) + call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) + call pbuf_add_field('TOTLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), totliqini_idx) + call pbuf_add_field('TOTICEINI', 'physpkg', dtype_r8, (/pcols,pver/), toticeini_idx) + + ! check energy package + call check_energy_register + + ! If using a simple physics option (e.g., held_suarez, adiabatic), + ! the normal CAM physics parameterizations are not called. + if (moist_physics) then + + ! register fluxes for saving across time + if (phys_do_flux_avg()) call flux_avg_register() + + call cldfrc_register() + + ! cloud water + if (.not. do_clubb_sgs) call macrop_driver_register() + call microp_aero_register() + call microp_driver_register() + + ! Register CLUBB_SGS here + if (do_clubb_sgs) call clubb_register_cam() + + call pbuf_add_field('PREC_STR', 'global',dtype_r8,(/pcols/),prec_str_idx) + call pbuf_add_field('SNOW_STR', 'global',dtype_r8,(/pcols/),snow_str_idx) + call pbuf_add_field('PREC_PCW', 'global',dtype_r8,(/pcols/),prec_pcw_idx) + call pbuf_add_field('SNOW_PCW', 'global',dtype_r8,(/pcols/),snow_pcw_idx) + call pbuf_add_field('PREC_SED', 'global',dtype_r8,(/pcols/),prec_sed_idx) + call pbuf_add_field('SNOW_SED', 'global',dtype_r8,(/pcols/),snow_sed_idx) + + if (is_subcol_on()) then + call pbuf_register_subcol('PREC_STR', 'phys_register', prec_str_idx) + call pbuf_register_subcol('SNOW_STR', 'phys_register', snow_str_idx) + call pbuf_register_subcol('PREC_PCW', 'phys_register', prec_pcw_idx) + call pbuf_register_subcol('SNOW_PCW', 'phys_register', snow_pcw_idx) + call pbuf_register_subcol('PREC_SED', 'phys_register', prec_sed_idx) + call pbuf_register_subcol('SNOW_SED', 'phys_register', snow_sed_idx) + end if + + ! Reserve liquid at end of tphysbc + call pbuf_add_field('RLIQBC','physpkg',dtype_r8,(/pcols/),rliqbc_idx) + + ! Who should add FRACIS? + ! -- It does not seem that aero_intr should add it since FRACIS is used in convection + ! even if there are no prognostic aerosols ... so do it here for now + call pbuf_add_field('FRACIS','physpkg',dtype_r8,(/pcols,pver,pcnst/),m) + + call conv_water_register() + + ! Determine whether its a 'modal' aerosol simulation or not + call rad_cnst_get_info(0, nmodes=nmodes) + clim_modal_aero = (nmodes > 0) + + if (clim_modal_aero) then + call modal_aero_calcsize_reg() + call modal_aero_wateruptake_reg() + endif + + ! register chemical constituents including aerosols ... + call chem_register() + + ! add prognostic lightning flash freq pbuf fld + call lightning_register() + + ! co2 constituents + call co2_register() + + ! register other constituents + call prescribed_volcaero_register() + call prescribed_strataero_register() + call prescribed_ozone_register() + call prescribed_aero_register() + call prescribed_ghg_register() + + ! register various data model gasses with pbuf + call ghg_data_register() + + ! carma microphysics + ! + call carma_register() + + ! Register iondrag variables with pbuf + call iondrag_register() + + ! Register ionosphere variables with pbuf if mode set to ionosphere + if( waccmx_is('ionosphere') ) then + call waccmx_phys_ion_elec_temp_reg() + endif + + call aircraft_emit_register() + + ! deep convection + call convect_deep_register + + ! convection diagnostics + call convect_diagnostics_register + + ! radiation + call radiation_register + call cloud_diagnostics_register + call radheat_register + + ! COSP + call cospsimulator_intr_register + + ! vertical diffusion + call vd_register() + else + ! held_suarez/adiabatic physics option should be in simple_physics + call endrun('phys_register: moist_physics configuration error') + end if + + ! Register diagnostics PBUF + call diag_register() + + ! Register age of air tracers + call aoa_tracers_register() + + ! Register test tracers + call tracers_register() + + call dyn_register() + + ! All tracers registered, check that the dimensions are correct + call cnst_chk_dim() + + ! ***NOTE*** No registering constituents after the call to cnst_chk_dim. + + call offline_driver_reg() + + if (use_hemco) then + ! initialize harmonized emissions component (HEMCO) + call HCOI_Chunk_Init() + endif + + ! This needs to be last as it requires all pbuf fields to be added + if (cam_snapshot_before_num > 0 .or. cam_snapshot_after_num > 0) then + call pbuf_cam_snapshot_register() + end if + + end subroutine phys_register + + + + !======================================================================= + + subroutine phys_inidat( cam_out, pbuf2d ) + use cam_abortutils, only: endrun + + use physics_buffer, only: pbuf_get_index, physics_buffer_desc, pbuf_set_field, dyn_time_lvls + + + use cam_initfiles, only: initial_file_get_id, topo_file_get_id + use cam_grid_support, only: cam_grid_check, cam_grid_id + use cam_grid_support, only: cam_grid_get_dim_names + use pio, only: file_desc_t + use ncdio_atm, only: infld + use dycore, only: dycore_is + use polar_avg, only: polar_average + use short_lived_species, only: initialize_short_lived_species + use cam_control_mod, only: aqua_planet + use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_inidat + + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer :: lchnk, m, n, i, k, ncol + type(file_desc_t), pointer :: fh_ini, fh_topo + character(len=8) :: fieldname + real(r8), pointer :: tptr(:,:), tptr_2(:,:), tptr3d(:,:,:), tptr3d_2(:,:,:) + real(r8), pointer :: qpert(:,:) + + character(len=11) :: subname='phys_inidat' ! subroutine name + integer :: tpert_idx, qpert_idx, pblh_idx + + logical :: found=.false., found2=.false. + integer :: ierr + character(len=8) :: dim1name, dim2name + integer :: ixcldice, ixcldliq + integer :: grid_id ! grid ID for data mapping + + nullify(tptr,tptr_2,tptr3d,tptr3d_2) + + fh_ini => initial_file_get_id() + fh_topo => topo_file_get_id() + + ! dynamics variables are handled in dyn_init - here we read variables needed for physics + ! but not dynamics + + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(trim(subname)//': Internal error, no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + + allocate(tptr(1:pcols,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(subname//': Failed to allocate tptr(1:pcols,begchunk:endchunk)') + end if + + if (associated(fh_topo) .and. .not. aqua_planet) then + call infld('SGH', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr, found, gridname='physgrid') + if(.not. found) call endrun('ERROR: SGH not found on topo file') + + call pbuf_set_field(pbuf2d, sgh_idx, tptr) + + allocate(tptr_2(1:pcols,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(subname//': Failed to allocate tptr_2(1:pcols,begchunk:endchunk)') + end if + call infld('SGH30', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr_2, found, gridname='physgrid') + if(found) then + call pbuf_set_field(pbuf2d, sgh30_idx, tptr_2) + else + if (masterproc) write(iulog,*) 'Warning: Error reading SGH30 from topo file.' + if (masterproc) write(iulog,*) 'The field SGH30 will be filled using data from SGH.' + call pbuf_set_field(pbuf2d, sgh30_idx, tptr) + end if + + deallocate(tptr_2) + + call infld('LANDM_COSLAT', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr, found, gridname='physgrid') + + if(.not.found) call endrun(' ERROR: LANDM_COSLAT not found on topo dataset.') + + call pbuf_set_field(pbuf2d, landm_idx, tptr) + + else + call pbuf_set_field(pbuf2d, sgh_idx, 0._r8) + call pbuf_set_field(pbuf2d, sgh30_idx, 0._r8) + call pbuf_set_field(pbuf2d, landm_idx, 0._r8) + end if + + call infld('PBLH', fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr(:,:), found, gridname='physgrid') + if(.not. found) then + tptr(:,:) = 0._r8 + if (masterproc) write(iulog,*) 'PBLH initialized to 0.' + end if + pblh_idx = pbuf_get_index('pblh') + + call pbuf_set_field(pbuf2d, pblh_idx, tptr) + + call infld('TPERT', fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr(:,:), found, gridname='physgrid') + if(.not. found) then + tptr(:,:) = 0._r8 + if (masterproc) write(iulog,*) 'TPERT initialized to 0.' + end if + tpert_idx = pbuf_get_index( 'tpert') + call pbuf_set_field(pbuf2d, tpert_idx, tptr) + + fieldname='QPERT' + qpert_idx = pbuf_get_index( 'qpert',ierr) + if (qpert_idx > 0) then + call infld(fieldname, fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr, found, gridname='physgrid') + if(.not. found) then + tptr=0_r8 + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' + end if + + allocate(tptr3d_2(pcols,pcnst,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(subname//': Failed to allocate tptr3d_2(pcols,pcnst,begchunk:endchunk)') + end if + tptr3d_2 = 0_r8 + tptr3d_2(:,1,:) = tptr(:,:) + + call pbuf_set_field(pbuf2d, qpert_idx, tptr3d_2) + deallocate(tptr3d_2) + end if + + fieldname='CUSH' + m = pbuf_get_index('cush', ierr) + if (m > 0) then + call infld(fieldname, fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, & + tptr, found, gridname='physgrid') + if(.not.found) then + if(masterproc) write(iulog,*) trim(fieldname), ' initialized to 1000.' + tptr=1000._r8 + end if + do n=1,dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr, start=(/1,n/), kount=(/pcols,1/)) + end do + deallocate(tptr) + end if + + ! + ! 3-D fields + ! + + allocate(tptr3d(pcols,pver,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(subname//': Failed to allocate tptr3d(pcols,pver,begchunk:endchunk)') + end if + + fieldname='CLOUD' + m = pbuf_get_index('CLD') + call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(found) then + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + else + call pbuf_set_field(pbuf2d, m, 0._r8) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' + end if + + fieldname='QCWAT' + m = pbuf_get_index(fieldname,ierr) + if (m > 0) then + call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(.not. found) then + call infld('Q',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if (found) then + if (masterproc) write(iulog,*) trim(fieldname), ' initialized with Q' + if(dycore_is('LR')) call polar_average(pver, tptr3d) + else + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to huge()' + tptr3d = huge(1.0_r8) + end if + end if + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + end if + + fieldname = 'ICCWAT' + m = pbuf_get_index(fieldname, ierr) + if (m > 0) then + call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(found) then + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + else + call cnst_get_ind('CLDICE', ixcldice) + call infld('CLDICE',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(found) then + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + else + call pbuf_set_field(pbuf2d, m, 0._r8) + end if + if (masterproc) then + if (found) then + write(iulog,*) trim(fieldname), ' initialized with CLDICE' + else + write(iulog,*) trim(fieldname), ' initialized to 0.0' + end if + end if + end if + end if + + fieldname = 'LCWAT' + m = pbuf_get_index(fieldname,ierr) + if (m > 0) then + call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(found) then + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + else + allocate(tptr3d_2(pcols,pver,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(subname//': Failed to allocate tptr3d_2(pcols,pver,begchunk:endchunk)') + end if + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('CLDLIQ', ixcldliq) + call infld('CLDICE',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + call infld('CLDLIQ',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d_2, found2, gridname='physgrid') + if(found .and. found2) then + do lchnk = begchunk, endchunk + ncol = get_ncols_p(lchnk) + tptr3d(:ncol,:,lchnk)=tptr3d(:ncol,:,lchnk)+tptr3d_2(:ncol,:,lchnk) + end do + if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDICE + CLDLIQ' + else if (found) then ! Data already loaded in tptr3d + if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDICE only' + else if (found2) then + tptr3d(:,:,:)=tptr3d_2(:,:,:) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDLIQ only' + end if + + if (found .or. found2) then + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + if(dycore_is('LR')) call polar_average(pver, tptr3d) + else + call pbuf_set_field(pbuf2d, m, 0._r8) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.0' + end if + deallocate(tptr3d_2) + end if + end if + + fieldname = 'TCWAT' + m = pbuf_get_index(fieldname,ierr) + if (m > 0) then + call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(.not.found) then + call infld('T', fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if (found) then + if(dycore_is('LR')) call polar_average(pver, tptr3d) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized with T' + else + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to huge()' + tptr3d = huge(1._r8) + end if + end if + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + end if + + fieldname = 'CONCLD' + m = pbuf_get_index('CONCLD',ierr) + if (m > 0) then + call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if(found) then + do n = 1, dyn_time_lvls + call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/)) + end do + else + call pbuf_set_field(pbuf2d, m, 0._r8) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' + end if + end if + + deallocate(tptr3d) + allocate(tptr3d(pcols,pverp,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(subname//': Failed to allocate tptr3d(pcols,pver,begchunk:endchunk)') + end if + + fieldname = 'TKE' + m = pbuf_get_index( 'tke') + call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if (found) then + call pbuf_set_field(pbuf2d, m, tptr3d) + else + call pbuf_set_field(pbuf2d, m, 0.01_r8) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.01' + end if + + + fieldname = 'KVM' + m = pbuf_get_index('kvm') + call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if (found) then + call pbuf_set_field(pbuf2d, m, tptr3d) + else + call pbuf_set_field(pbuf2d, m, 0._r8) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' + end if + + + fieldname = 'KVH' + m = pbuf_get_index('kvh') + call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, & + tptr3d, found, gridname='physgrid') + if (found) then + call pbuf_set_field(pbuf2d, m, tptr3d) + else + call pbuf_set_field(pbuf2d, m, 0._r8) + if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.' + end if + + call initialize_short_lived_species(fh_ini, pbuf2d) + + !--------------------------------------------------------------------------------- + ! If needed, get ion and electron temperature fields from initial condition file + !--------------------------------------------------------------------------------- + + call waccmx_phys_ion_elec_temp_inidat(fh_ini,pbuf2d) + + end subroutine phys_inidat + + + subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) + + !----------------------------------------------------------------------- + ! + ! Initialization of physics package. + ! + !----------------------------------------------------------------------- + + use physics_buffer, only: physics_buffer_desc, pbuf_initialize, pbuf_get_index + use physconst, only: rair, cpair, gravit, zvir, & + karman + use cam_thermo, only: cam_thermo_init + use ref_pres, only: pref_edge, pref_mid + + use carma_intr, only: carma_init + use cam_control_mod, only: initial_run + use check_energy, only: check_energy_init + use chemistry, only: chem_init + use mo_lightning, only: lightning_init + use prescribed_ozone, only: prescribed_ozone_init + use prescribed_ghg, only: prescribed_ghg_init + use prescribed_aero, only: prescribed_aero_init + use aerodep_flx, only: aerodep_flx_init + use aircraft_emit, only: aircraft_emit_init + use prescribed_volcaero,only: prescribed_volcaero_init + use prescribed_strataero,only: prescribed_strataero_init + use cloud_fraction, only: cldfrc_init + use cldfrc2m, only: cldfrc2m_init + use co2_cycle, only: co2_init, co2_transport + use convect_deep, only: convect_deep_init + use convect_diagnostics,only: convect_diagnostics_init + use cam_diagnostics, only: diag_init + use gw_drag, only: gw_init + use radheat, only: radheat_init + use radiation, only: radiation_init + use cloud_diagnostics, only: cloud_diagnostics_init + use wv_saturation, only: wv_sat_init + use microp_driver, only: microp_driver_init + use microp_aero, only: microp_aero_init + use macrop_driver, only: macrop_driver_init + use conv_water, only: conv_water_init + use tracers, only: tracers_init + use aoa_tracers, only: aoa_tracers_init + use rayleigh_friction, only: rayleigh_friction_init + use pbl_utils, only: pbl_utils_init + use vertical_diffusion, only: vertical_diffusion_init + use phys_debug_util, only: phys_debug_init + use phys_debug, only: phys_debug_state_init + use rad_constituents, only: rad_cnst_init + use aer_rad_props, only: aer_rad_props_init + use subcol, only: subcol_init + use qbo, only: qbo_init + use qneg_module, only: qneg_init + use lunar_tides, only: lunar_tides_init + use iondrag, only: iondrag_init +#if ( defined OFFLINE_DYN ) + use metdata, only: metdata_phys_init +#endif + use epp_ionization, only: epp_ionization_init, epp_ionization_active + use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_init ! Initialization of ionosphere module (WACCM-X) + use waccmx_phys_intr, only: waccmx_phys_mspd_init ! Initialization of major species diffusion module (WACCM-X) + use clubb_intr, only: clubb_ini_cam + use tropopause, only: tropopause_init + use solar_data, only: solar_data_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 + use cam_history, only: addfld, register_vector_field, add_default + use cam_budget, only: cam_budget_init + use phys_grid_ctem, only: phys_grid_ctem_init + + use ccpp_constituent_prop_mod, only: ccpp_const_props_init + + ! Input/output arguments + type(physics_state), pointer :: phys_state(:) + type(physics_tend ), pointer :: phys_tend(:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + type(cam_in_t), intent(in) :: cam_in(begchunk:endchunk) + type(cam_out_t),intent(inout) :: cam_out(begchunk:endchunk) + + ! local variables + integer :: lchnk + integer :: ierr + integer :: ixq + + logical :: history_budget ! output tendencies and state variables for + ! temperature, water vapor, cloud + ! ice, cloud liquid, U, V + integer :: history_budget_histfile_num ! output history file number for budget fields + + !----------------------------------------------------------------------- + + call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols) + + do lchnk = begchunk, endchunk + call physics_state_set_grid(lchnk, phys_state(lchnk)) + end do + + !------------------------------------------------------------------------------------------- + ! Initialize any variables in cam_thermo which are not temporally and/or spatially constant + !------------------------------------------------------------------------------------------- + call cam_thermo_init() + + ! Initialize debugging a physics column + call phys_debug_init() + + call pbuf_initialize(pbuf2d) + + ! Initialize subcol scheme + call subcol_init(pbuf2d) + + ! diag_init makes addfld calls for dynamics fields that are output from + ! the physics decomposition + call diag_init(pbuf2d) + + call check_energy_init() + + call tracers_init() + + ! age of air tracers + call aoa_tracers_init() + + teout_idx = pbuf_get_index( 'TEOUT') + + ! adiabatic or ideal physics should be only used if in simple_physics + if (adiabatic .or. ideal_phys) then + if (adiabatic) then + call endrun('phys_init: adiabatic configuration error') + else + call endrun('phys_init: ideal_phys configuration error') + end if + end if + + if (initial_run) then + call phys_inidat(cam_out, pbuf2d) + end if + + ! wv_saturation is relatively independent of everything else and + ! low level, so init it early. Must at least do this before radiation. + call wv_sat_init + + ! solar irradiance data modules + call solar_data_init() + + ! Initialize rad constituents and their properties + call rad_cnst_init() + + call radiation_init(pbuf2d) + + call aer_rad_props_init() + + ! initialize carma + call carma_init(pbuf2d) + + ! Prognostic chemistry. + call chem_init(phys_state,pbuf2d) + + ! Lightning flash frq and NOx prod + call lightning_init( pbuf2d ) + + ! Prescribed tracers + call prescribed_ozone_init() + call prescribed_ghg_init() + call prescribed_aero_init() + call aerodep_flx_init() + call aircraft_emit_init() + call prescribed_volcaero_init() + call prescribed_strataero_init() + + ! co2 cycle + if (co2_transport()) then + call co2_init() + end if + + call gw_init() + + call rayleigh_friction_init() + + call pbl_utils_init(gravit, karman, cpair, rair, zvir) + call vertical_diffusion_init(pbuf2d) + + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + call waccmx_phys_mspd_init () + ! Initialization of ionosphere module if mode set to ionosphere + if( waccmx_is('ionosphere') ) then + call waccmx_phys_ion_elec_temp_init(pbuf2d) + endif + endif + + call cloud_diagnostics_init(pbuf2d) + + call radheat_init(pref_mid) + + call convect_diagnostics_init + + call cldfrc_init() + call cldfrc2m_init() + + call convect_deep_init(pref_edge) + + if (.not. do_clubb_sgs) call macrop_driver_init(pbuf2d) + call microp_aero_init(phys_state,pbuf2d) + call microp_driver_init(pbuf2d) + call conv_water_init + + ! initiate CLUBB within CAM + if (do_clubb_sgs) call clubb_ini_cam(pbuf2d) + + call qbo_init + + call lunar_tides_init() + + call iondrag_init(pref_mid) + ! Geomagnetic module -- after iondrag_init + if (epp_ionization_active) then + call epp_ionization_init() + endif + +#if ( defined OFFLINE_DYN ) + call metdata_phys_init() +#endif + call tropopause_init() + call dadadj_cam_init() + + prec_dp_idx = pbuf_get_index('PREC_DP') + snow_dp_idx = pbuf_get_index('SNOW_DP') + prec_sh_idx = pbuf_get_index('PREC_SH') + snow_sh_idx = pbuf_get_index('SNOW_SH') + + dlfzm_idx = pbuf_get_index('DLFZM', ierr) + cmfmczm_idx = pbuf_get_index('CMFMC_DP', ierr) + + call phys_getopts(prog_modal_aero_out=prog_modal_aero) + + ! Initialize Nudging Parameters + !-------------------------------- + if(Nudge_Model) call nudging_init + + if (clim_modal_aero) then + + ! If climate calculations are affected by prescribed modal aerosols, the + ! initialization routine for the dry mode radius calculation is called + ! here. For prognostic MAM the initialization is called from + ! modal_aero_initialize + if (.not. prog_modal_aero) then + call modal_aero_calcsize_init(pbuf2d) + endif + + call modal_aero_wateruptake_init(pbuf2d) + + end if + + ! Initialize CAM CCPP constituent properties array + ! for use in CCPP-ized physics schemes: + call cnst_get_ind('Q', ixq) + call ccpp_const_props_init(ixq) + + ! Initialize qneg3 and qneg4 + call qneg_init() + + ! Initialize phys TEM diagnostics + call phys_grid_ctem_init() + + ! Initialize the snapshot capability + call cam_snapshot_init(cam_in, cam_out, pbuf2d, begchunk) + + ! Initialize the budget capability + call cam_budget_init() + + ! addfld calls for U, V tendency budget variables that are output in + ! tphysac, tphysbc + call addfld ( 'UTEND_DCONV', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by deep convection') + call addfld ( 'VTEND_DCONV', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by deep convection') + call register_vector_field ( 'UTEND_DCONV', 'VTEND_DCONV') + call addfld ( 'UTEND_SHCONV', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by shallow convection') + call addfld ( 'VTEND_SHCONV', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by shallow convection') + call register_vector_field ( 'UTEND_SHCONV', 'VTEND_SHCONV') + call addfld ( 'UTEND_MACROP', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by macrophysics') + call addfld ( 'VTEND_MACROP', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by macrophysics') + call register_vector_field ( 'UTEND_MACROP', 'VTEND_MACROP') + call addfld ( 'UTEND_VDIFF', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by vert. diffus.') + call addfld ( 'VTEND_VDIFF', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by vert. diffus.') + call register_vector_field ( 'UTEND_VDIFF', 'VTEND_VDIFF') + call addfld ( 'UTEND_RAYLEIGH', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by Rayleigh Fric.') + call addfld ( 'VTEND_RAYLEIGH', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by Rayleigh Fric.') + call register_vector_field ( 'UTEND_RAYLEIGH', 'VTEND_RAYLEIGH') + call addfld ( 'UTEND_GWDTOT', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by all GWs') + call addfld ( 'VTEND_GWDTOT', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by all GWs') + call register_vector_field ( 'UTEND_GWDTOT', 'VTEND_GWDTOT') + call addfld ( 'UTEND_QBORLX', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by QBO relaxation') + call addfld ( 'VTEND_QBORLX', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by QBO relaxation') + call register_vector_field ( 'UTEND_QBORLX', 'VTEND_QBORLX') + call addfld ( 'UTEND_LUNART', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by lunar tides') + call addfld ( 'VTEND_LUNART', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by lunar tides') + call register_vector_field ( 'UTEND_LUNART', 'VTEND_LUNART') + call addfld ( 'UTEND_IONDRG', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by ion drag') + call addfld ( 'VTEND_IONDRG', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by ion drag') + call register_vector_field ( 'UTEND_IONDRG', 'VTEND_IONDRG') + call addfld ( 'UTEND_NDG', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by nudging') + call addfld ( 'VTEND_NDG', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by nudging') + call register_vector_field ( 'UTEND_NDG', 'VTEND_NDG') + call addfld('UTEND_CORE', (/ 'lev' /), 'A', 'm/s2' , 'Zonal wind tendency due to dynamical core') + call addfld('VTEND_CORE', (/ 'lev' /), 'A', 'm/s2' , 'Meridional wind tendency due to dynamical core') + call register_vector_field('UTEND_CORE','VTEND_CORE') + + + call phys_getopts(history_budget_out = history_budget, & + history_budget_histfile_num_out = history_budget_histfile_num) + + if ( history_budget ) then + call add_default ( 'UTEND_DCONV' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_DCONV' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_SHCONV' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_SHCONV' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_MACROP' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_MACROP' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_VDIFF' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_VDIFF' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_RAYLEIGH' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_RAYLEIGH' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_GWDTOT' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_GWDTOT' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_QBORLX' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_QBORLX' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_LUNART' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_LUNART' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_IONDRG' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_IONDRG' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_NDG' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_NDG' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_CORE' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_CORE' , history_budget_histfile_num, ' ') + end if + + ducore_idx = pbuf_get_index('DUCORE') + dvcore_idx = pbuf_get_index('DVCORE') + dtcore_idx = pbuf_get_index('DTCORE') + dqcore_idx = pbuf_get_index('DQCORE') + + psl_idx = pbuf_get_index('PSL') + + end subroutine phys_init + + ! + !----------------------------------------------------------------------- + ! + + subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! First part of atmospheric physics package before updating of surface models + ! + !----------------------------------------------------------------------- + use time_manager, only: get_nstep + use cam_diagnostics,only: diag_allocate, diag_physvar_ic + use check_energy, only: check_energy_gmean + use spmd_utils, only: mpicom + use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate + use cam_history, only: outfld, write_camiop + use cam_abortutils, only: endrun +#if ( defined OFFLINE_DYN ) + use metdata, only: get_met_srf1 +#endif + ! + ! Input arguments + ! + real(r8), intent(in) :: ztodt ! physics time step unless nstep=0 + ! + ! Input/Output arguments + ! + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend + + type(physics_buffer_desc), pointer, dimension(:,:) :: pbuf2d + type(cam_in_t), dimension(begchunk:endchunk) :: cam_in + type(cam_out_t), dimension(begchunk:endchunk) :: cam_out + !----------------------------------------------------------------------- + ! + !---------------------------Local workspace----------------------------- + ! + integer :: c ! indices + integer :: ncol ! number of columns + integer :: nstep ! current timestep number + type(physics_buffer_desc), pointer :: phys_buffer_chunk(:) + + call t_startf ('physpkg_st1') + nstep = get_nstep() + +#if ( defined OFFLINE_DYN ) + ! + ! if offline mode set SNOWH and TS for micro-phys + ! + call get_met_srf1( cam_in ) +#endif + + ! The following initialization depends on the import state (cam_in) + ! being initialized. This isn't true when cam_init is called, so need + ! to postpone this initialization to here. + if (nstep == 0 .and. phys_do_flux_avg()) call flux_avg_init(cam_in, pbuf2d) + + ! Compute total energy of input state and previous output state + call t_startf ('chk_en_gmean') + call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) + call t_stopf ('chk_en_gmean') + + call pbuf_allocate(pbuf2d, 'physpkg') + call diag_allocate() + + !----------------------------------------------------------------------- + ! Advance time information + !----------------------------------------------------------------------- + + call phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) + + call t_stopf ('physpkg_st1') + +#ifdef TRACER_CHECK + call gmean_mass ('before tphysbc DRY', phys_state) +#endif + + + !----------------------------------------------------------------------- + ! Tendency physics before flux coupler invocation + !----------------------------------------------------------------------- + ! + + 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') + call t_adj_detailf(+1) + +!$OMP PARALLEL DO PRIVATE (C, phys_buffer_chunk) + do c=begchunk, endchunk + ! + ! Output physics terms to IC file + ! + phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c) + + call t_startf ('diag_physvar_ic') + call diag_physvar_ic ( c, phys_buffer_chunk, cam_out(c), cam_in(c) ) + call t_stopf ('diag_physvar_ic') + + call tphysbc (ztodt, phys_state(c), & + phys_tend(c), phys_buffer_chunk, & + cam_out(c), cam_in(c) ) + end do + + call t_adj_detailf(-1) + call t_stopf ('bc_physics') + + ! Don't call the rest in CRM mode + if(single_column.and.scm_crm_mode) return + +#ifdef TRACER_CHECK + call gmean_mass ('between DRY', phys_state) +#endif + + end subroutine phys_run1 + + ! + !----------------------------------------------------------------------- + ! + + subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & + cam_in ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Second part of atmospheric physics package after updating of surface models + ! + !----------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_deallocate, pbuf_update_tim_idx + use mo_lightning, only: lightning_no_prod + use cam_diagnostics, only: diag_deallocate, diag_surf + use carma_intr, only: carma_accumulate_stats + use spmd_utils, only: mpicom + use iop_forcing, only: scam_use_iop_srf +#if ( defined OFFLINE_DYN ) + use metdata, only: get_met_srf2 +#endif + use hemco_interface, only: HCOI_Chunk_Run + ! + ! Input arguments + ! + real(r8), intent(in) :: ztodt ! physics time step unless nstep=0 + ! + ! Input/Output arguments + ! + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend + type(physics_buffer_desc),pointer, dimension(:,:) :: pbuf2d + + type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out + type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in + ! + !----------------------------------------------------------------------- + !---------------------------Local workspace----------------------------- + ! + integer :: c ! chunk index + integer :: ncol ! number of columns + type(physics_buffer_desc),pointer, dimension(:) :: phys_buffer_chunk + ! + ! If exit condition just return + ! + + if(single_column.and.scm_crm_mode) then + call diag_deallocate() + return + end if + !----------------------------------------------------------------------- + ! if using IOP values for surface fluxes overwrite here after surface components run + !----------------------------------------------------------------------- + if (single_column) call scam_use_iop_srf(cam_in) + + if(use_hemco) then + !---------------------------------------------------------- + ! run hemco (phase 2 before chemistry) + ! only phase 2 is used currently for HEMCO-CESM + !---------------------------------------------------------- + call HCOI_Chunk_Run(cam_in, phys_state, pbuf2d, phase=2) + endif + + !----------------------------------------------------------------------- + ! Tendency physics after coupler + ! Not necessary at terminal timestep. + !----------------------------------------------------------------------- + ! +#if ( defined OFFLINE_DYN ) + ! + ! if offline mode set SHFLX QFLX TAUX TAUY for vert diffusion + ! + call get_met_srf2( cam_in ) +#endif + ! lightning flash freq and prod rate of NOx + call t_startf ('lightning_no_prod') + call lightning_no_prod( phys_state, pbuf2d, cam_in ) + call t_stopf ('lightning_no_prod') + + call t_barrierf('sync_ac_physics', mpicom) + call t_startf ('ac_physics') + call t_adj_detailf(+1) + +!$OMP PARALLEL DO PRIVATE (C, NCOL, phys_buffer_chunk) + + do c=begchunk,endchunk + ncol = get_ncols_p(c) + phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c) + ! + ! surface diagnostics for history files + ! + call t_startf('diag_surf') + call diag_surf(cam_in(c), cam_out(c), phys_state(c), phys_buffer_chunk) + call t_stopf('diag_surf') + + call tphysac(ztodt, cam_in(c), & + cam_out(c), & + phys_state(c), phys_tend(c), phys_buffer_chunk) + end do ! Chunk loop + + call t_adj_detailf(-1) + call t_stopf('ac_physics') + +#ifdef TRACER_CHECK + call gmean_mass ('after tphysac FV:WET)', phys_state) +#endif + + call t_startf ('carma_accumulate_stats') + call carma_accumulate_stats() + call t_stopf ('carma_accumulate_stats') + + call t_startf ('physpkg_st2') + call pbuf_deallocate(pbuf2d, 'physpkg') + + call pbuf_update_tim_idx() + call diag_deallocate() + call t_stopf ('physpkg_st2') + + end subroutine phys_run2 + + ! + !----------------------------------------------------------------------- + ! + + subroutine phys_final( phys_state, phys_tend, pbuf2d ) + use physics_buffer, only: physics_buffer_desc, pbuf_deallocate + use chemistry, only: chem_final + use carma_intr, only: carma_final + use wv_saturation, only: wv_sat_final + use microp_aero, only: microp_aero_final + use phys_grid_ctem, only: phys_grid_ctem_final + use nudging, only: Nudge_Model, nudging_final + use hemco_interface, only: HCOI_Chunk_Final + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Finalization of physics package + ! + !----------------------------------------------------------------------- + ! Input/output arguments + type(physics_state), pointer :: phys_state(:) + type(physics_tend ), pointer :: phys_tend(:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + if(associated(pbuf2d)) then + call pbuf_deallocate(pbuf2d,'global') + deallocate(pbuf2d) + end if + deallocate(phys_state) + deallocate(phys_tend) + call chem_final + call carma_final + call wv_sat_final + call microp_aero_final() + call phys_grid_ctem_final() + if(Nudge_Model) call nudging_final() + + if(use_hemco) then + ! cleanup hemco + call HCOI_Chunk_Final + endif + + end subroutine phys_final + + + subroutine tphysac (ztodt, cam_in, & + cam_out, state, tend, pbuf) + !----------------------------------------------------------------------- + ! + ! Tendency physics after coupling to land, sea, and ice models. + ! + ! Computes the following: + ! + ! o Aerosol Emission at Surface + ! o Stratiform Macro-Microphysics + ! o Wet Scavenging of Aerosol + ! o Radiation + ! o Source-Sink for Advected Tracers + ! o Symmetric Turbulence Scheme - Vertical Diffusion + ! o Rayleigh Friction + ! o Dry Deposition of Aerosol + ! o Enforce Charge Neutrality ( Only for WACCM ) + ! o Gravity Wave Drag + ! o QBO Relaxation ( Only for WACCM ) + ! o Ion Drag ( Only for WACCM ) + ! o Scale Dry Mass Energy + !----------------------------------------------------------------------- + use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx + use chemistry, only: chem_is_active, chem_timestep_tend, chem_emissions + use cam_diagnostics, only: diag_phys_tend_writeout + use gw_drag, only: gw_tend + use vertical_diffusion, only: vertical_diffusion_tend + use rayleigh_friction, only: rayleigh_friction_tend + use physics_types, only: physics_dme_adjust, set_dry_to_wet, physics_state_check, & + dyn_te_idx + use waccmx_phys_intr, only: waccmx_phys_mspd_tend ! WACCM-X major diffusion + use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X + use aoa_tracers, only: aoa_tracers_timestep_tend + use physconst, only: rhoh2o + use aero_model, only: aero_model_drydep + use check_energy, only: check_energy_timestep_init, check_energy_cam_chng + use check_energy, only: tot_energy_phys + use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng + use time_manager, only: get_nstep + use cam_abortutils, only: endrun + use dycore, only: dycore_is + use cam_control_mod, only: aqua_planet + use mo_gas_phase_chemdr,only: map2chm + use clybry_fam, only: clybry_fam_set + use charge_neutrality, only: charge_balance + use qbo, only: qbo_relax + use iondrag, only: iondrag_calc, do_waccm_ions + use perf_mod + use flux_avg, only: flux_avg_run + use cam_history, only: hist_fld_active, outfld + use qneg_module, only: qneg4 + use co2_cycle, only: co2_cycle_set_ptend + use nudging, only: Nudge_Model,Nudge_ON,nudging_timestep_tend + use cam_snapshot, only: cam_snapshot_all_outfld_tphysac + use cam_snapshot_common,only: cam_snapshot_ptend_outfld + use lunar_tides, only: lunar_tides_tend + use ssatcontrail, only: ssatcontrail_d0 + use physics_types, only: physics_ptend_init, physics_ptend_sum, physics_ptend_scale + use microp_driver, only: microp_driver_tend + use microp_aero, only: microp_aero_run + use clubb_intr, only: clubb_tend_cam, clubb_emissions_cam + use subcol, only: subcol_gen, subcol_ptend_avg + use subcol_utils, only: subcol_ptend_copy, is_subcol_on + use subcol_SILHS, only: subcol_SILHS_var_covar_driver, init_state_subcol + use subcol_SILHS, only: subcol_SILHS_fill_holes_conserv + use subcol_SILHS, only: subcol_SILHS_hydromet_conc_tend_lim + use micro_pumas_cam, only: massless_droplet_destroyer + use convect_deep, only: convect_deep_tend_2, deep_scheme_does_scav_trans + use cloud_diagnostics, only: cloud_diagnostics_calc + 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_wetdep_cam, only: wetdep_lq + use physics_buffer, only: col_type_subcol + use carma_intr, only: carma_wetdep_tend, carma_timestep_tend, carma_emission_tend + use carma_flags_mod, only: carma_do_aerosol, carma_do_emission, carma_do_detrain + use carma_flags_mod, only: carma_do_cldice, carma_do_cldliq, carma_do_wetdep + use dyn_tests_utils, only: vc_dycore + use cam_thermo, only: cam_thermo_water_update + use cam_budget, only: thermo_budget_history + use dyn_tests_utils, only: vc_dycore, vc_height, vc_dry_pressure + use air_composition, only: cpairv, cp_or_cv_dycore + ! + ! Arguments + ! + real(r8), intent(in) :: ztodt ! Two times model timestep (2 delta-t) + + type(cam_in_t), intent(inout) :: cam_in + type(cam_out_t), intent(inout) :: cam_out + type(physics_state), intent(inout) :: state + type(physics_tend ), intent(inout) :: tend + type(physics_buffer_desc), pointer :: pbuf(:) + + + type(check_tracers_data):: tracerint ! tracer mass integrals and cummulative boundary fluxes + + ! + !---------------------------Local workspace----------------------------- + ! + type(physics_ptend) :: ptend ! indivdual parameterization tendencies + type(physics_ptend) :: ptend_macp_all ! sum of macrophysics tendencies (e.g. CLUBB) over substeps + type(physics_state) :: state_sc ! state for sub-columns + type(physics_ptend) :: ptend_sc ! ptend for sub-columns + type(physics_ptend) :: ptend_aero ! ptend for microp_aero + type(physics_ptend) :: ptend_aero_sc ! ptend for microp_aero on sub-columns + type(physics_tend) :: tend_sc ! tend for sub-columns + + integer :: nstep ! current timestep number + real(r8) :: zero(pcols) ! array of zeros + + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer i,k,m ! Longitude, level indices + integer :: yr, mon, day, tod ! components of a date + integer :: ixq, ixcldice, ixcldliq ! constituent indices for vapor, cloud liquid and ice water. + + ! for macro/micro co-substepping + integer :: macmic_it ! iteration variables + real(r8) :: cld_macmic_ztodt ! modified timestep + + real(r8) :: net_flx(pcols) + + real(r8) :: cmfmc(pcols,pverp) ! Convective mass flux--m sub c + + real(r8) dlf(pcols,pver) ! Detraining cld H20 from shallow + deep convections + real(r8) rtdt ! 1./ztodt + + real(r8) :: rliq(pcols) ! vertical integral of liquid not yet in q(ixcldliq) + real(r8) :: det_s (pcols) ! vertical integral of detrained static energy from ice + real(r8) :: det_ice(pcols) ! vertical integral of detrained ice + real(r8) :: flx_cnd(pcols) + + real(r8) :: zero_sc(pcols*psubcols) ! array of zeros + real(r8) :: zero_tracers(pcols,pcnst) + + real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio. + real(r8), pointer :: cmfmczm(:,:) ! ZM convective mass fluxes + real(r8), pointer :: rliqbc(:) ! tphysbc reserve liquid + + ! stratiform precipitation variables + real(r8),pointer :: prec_str(:) ! sfc flux of precip from stratiform (m/s) + real(r8),pointer :: snow_str(:) ! sfc flux of snow from stratiform (m/s) + real(r8),pointer :: prec_str_sc(:) ! sfc flux of precip from stratiform (m/s) -- for subcolumns + real(r8),pointer :: snow_str_sc(:) ! sfc flux of snow from stratiform (m/s) -- for subcolumns + real(r8),pointer :: prec_pcw(:) ! total precip from prognostic cloud scheme + real(r8),pointer :: snow_pcw(:) ! snow from prognostic cloud scheme + real(r8),pointer :: prec_sed(:) ! total precip from cloud sedimentation + real(r8),pointer :: snow_sed(:) ! snow from cloud ice sedimentation + + ! Local copies for substepping + real(r8) :: prec_pcw_macmic(pcols) + real(r8) :: snow_pcw_macmic(pcols) + real(r8) :: prec_sed_macmic(pcols) + real(r8) :: snow_sed_macmic(pcols) + + ! carma precipitation variables + real(r8) :: prec_sed_carma(pcols) ! total precip from cloud sedimentation (CARMA) + real(r8) :: snow_sed_carma(pcols) ! snow from cloud ice sedimentation (CARMA) + + logical :: labort ! abort flag + + real(r8) tvm(pcols,pver) ! virtual temperature + real(r8) prect(pcols) ! total precipitation + real(r8) surfric(pcols) ! surface friction velocity + real(r8) obklen(pcols) ! Obukhov length + real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry + real(r8) :: flx_heat(pcols) ! Heat flux for check_energy_chng. + real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space + real(r8) :: tmp_pdel (pcols,pver) ! tmp space + real(r8) :: tmp_ps (pcols) ! tmp space + real(r8) :: scaling(pcols,pver) + logical :: moist_mixing_ratio_dycore + + ! physics buffer fields for total energy and mass adjustment + integer itim_old, ifld + + real(r8), pointer, dimension(:,:) :: cld + real(r8), pointer, dimension(:,:) :: qini + real(r8), pointer, dimension(:,:) :: cldliqini + real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: totliqini + real(r8), pointer, dimension(:,:) :: toticeini + real(r8), pointer, dimension(:,:) :: dtcore + real(r8), pointer, dimension(:,:) :: dqcore + real(r8), pointer, dimension(:,:) :: ducore + real(r8), pointer, dimension(:,:) :: dvcore + real(r8), pointer, dimension(:,:) :: ast ! relative humidity cloud fraction + + !----------------------------------------------------------------------- + lchnk = state%lchnk + ncol = state%ncol + + nstep = get_nstep() + rtdt = 1._r8/ztodt + + ! Adjust the surface fluxes to reduce instabilities in near sfc layer + if (phys_do_flux_avg()) then + call flux_avg_run(state, cam_in, pbuf, nstep, ztodt) + endif + + ! Validate the physics state. + if (state_debug_checks) then + call physics_state_check(state, name="before tphysac") + end if + + call t_startf('tphysac_init') + ! Associate pointers with physics buffer fields + itim_old = pbuf_old_tim_idx() + + call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, ducore_idx, ducore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, dvcore_idx, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, qini_idx, qini) + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, totliqini_idx, totliqini) + call pbuf_get_field(pbuf, toticeini_idx, toticeini) + + ifld = pbuf_get_index('CLD') + call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/)) + + ifld = pbuf_get_index('AST') + call pbuf_get_field(pbuf, ifld, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call cnst_get_ind('Q', ixq) + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + + call pbuf_get_field(pbuf, prec_str_idx, prec_str ) + call pbuf_get_field(pbuf, snow_str_idx, snow_str ) + call pbuf_get_field(pbuf, prec_sed_idx, prec_sed ) + call pbuf_get_field(pbuf, snow_sed_idx, snow_sed ) + call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw ) + call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw ) + + if (is_subcol_on()) then + call pbuf_get_field(pbuf, prec_str_idx, prec_str_sc, col_type=col_type_subcol) + call pbuf_get_field(pbuf, snow_str_idx, snow_str_sc, col_type=col_type_subcol) + end if + + if (dlfzm_idx > 0) then + call pbuf_get_field(pbuf, dlfzm_idx, dlfzm) + dlf(:ncol,:) = dlfzm(:ncol,:) + else + dlf(:,:) = 0._r8 + end if + + if (cmfmczm_idx > 0) then + call pbuf_get_field(pbuf, cmfmczm_idx, cmfmczm) + cmfmc(:ncol,:) = cmfmczm(:ncol,:) + else + cmfmc(:ncol,:) = 0._r8 + end if + + call pbuf_get_field(pbuf, rliqbc_idx, rliqbc) + rliq(:ncol) = rliqbc(:ncol) + + ! + ! accumulate fluxes into net flux array for spectral dycores + ! jrm Include latent heat of fusion for snow + ! + do i=1,ncol + tend%flx_net(i) = tend%flx_net(i) + cam_in%shf(i) + (cam_out%precc(i) & + + cam_out%precl(i))*latvap*rhoh2o & + + (cam_out%precsc(i) + cam_out%precsl(i))*latice*rhoh2o + end do + + ! emissions of aerosols and gas-phase chemistry constituents at surface + + if (trim(cam_take_snapshot_before) == "chem_emissions") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + call chem_emissions( state, cam_in, pbuf ) + if (trim(cam_take_snapshot_after) == "chem_emissions") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + if (carma_do_emission) then + ! carma emissions + call carma_emission_tend (state, ptend, cam_in, ztodt, pbuf) + call physics_update(state, ptend, ztodt, tend) + end if + + ! get nstep and zero array for energy checker + zero = 0._r8 + zero_sc(:) = 0._r8 + zero_tracers(:,:) = 0._r8 + nstep = get_nstep() + call check_tracers_init(state, tracerint) + + ! Check if latent heat flux exceeds the total moisture content of the + ! lowest model layer, thereby creating negative moisture. + + call qneg4('TPHYSAC', lchnk, ncol, ztodt , & + state%q(1,pver,1), state%rpdel(1,pver), & + cam_in%shf, cam_in%lhf, cam_in%cflx) + + call t_stopf('tphysac_init') + + !=================================================== + ! Apply tracer surface fluxes to lowest model layer + !=================================================== + call t_startf('clubb_emissions_tend') + + call clubb_emissions_cam(state, cam_in, ptend) + + call physics_update(state, ptend, ztodt, tend) + + call check_energy_cam_chng(state, tend, "clubb_emissions_tend", nstep, ztodt, zero, zero, zero, zero) + + call t_stopf('clubb_emissions_tend') + + !=================================================== + ! Calculate tendencies from CARMA bin microphysics. + !=================================================== + ! + ! If CARMA is doing detrainment, then on output, rliq no longer represents + ! water reserved + ! for detrainment, but instead represents potential snow fall. The mass and + ! number of the + ! snow are stored in the physics buffer and will be incorporated by the MG + ! microphysics. + ! + ! Currently CARMA cloud microphysics is only supported with the MG + ! microphysics. + call t_startf('carma_timestep_tend') + + if (carma_do_cldice .or. carma_do_cldliq) then + call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, dlf=dlf, rliq=rliq, & + prec_str=prec_str, snow_str=snow_str, prec_sed=prec_sed_carma, snow_sed=snow_sed_carma) + call physics_update(state, ptend, ztodt, tend) + + ! Before the detrainment, the reserved condensate is all liquid, but if + ! CARMA is doing + ! detrainment, then the reserved condensate is snow. + if (carma_do_detrain) then + call check_energy_cam_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str+rliq, snow_str+rliq, zero) + else + call check_energy_cam_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str, snow_str, zero) + end if + end if + + call t_stopf('carma_timestep_tend') + + if( microp_scheme == 'MG' ) then + ! Start co-substepping of macrophysics and microphysics + cld_macmic_ztodt = ztodt/cld_macmic_num_steps + + ! Clear precip fields that should accumulate. + prec_sed_macmic = 0._r8 + snow_sed_macmic = 0._r8 + prec_pcw_macmic = 0._r8 + snow_pcw_macmic = 0._r8 + + ! contrail parameterization + ! see Chen et al., 2012: Global contrail coverage simulated + ! by CAM5 with the inventory of 2006 global aircraft emissions, JAMES + ! https://doi.org/10.1029/2011MS000105 + call ssatcontrail_d0(state, pbuf, ztodt, ptend) + call physics_update(state, ptend, ztodt, tend) + + ! initialize ptend structures where macro and microphysics tendencies are + ! accumulated over macmic substeps + call physics_ptend_init(ptend_macp_all,state%psetcols,'macrophysics',lu=.true.,lv=.true.) + + do macmic_it = 1, cld_macmic_num_steps + + !=================================================== + ! Calculate macrophysical tendency (sedimentation, detrain, cloud fraction) + !=================================================== + + call t_startf('macrop_tend') + + ! ===================================================== + ! CLUBB call (PBL, shallow convection, macrophysics) + ! ===================================================== + + if (trim(cam_take_snapshot_before) == "clubb_tend_cam") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call clubb_tend_cam(state, ptend, pbuf, cld_macmic_ztodt,& + cmfmc, cam_in, macmic_it, cld_macmic_num_steps, & + dlf, det_s, det_ice) + + ! Since we "added" the reserved liquid back in this routine, we need + ! to account for it in the energy checker + flx_cnd(:ncol) = -1._r8*rliq(:ncol) + flx_heat(:ncol) = cam_in%shf(:ncol) + det_s(:ncol) + + ! Unfortunately, physics_update does not know what time period + ! "tend" is supposed to cover, and therefore can't update it + ! with substeps correctly. For now, work around this by scaling + ! ptend down by the number of substeps, then applying it for + ! the full time (ztodt). + call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol) + + ! Update physics tendencies and copy state to state_eq, because that is + ! input for microphysics + if ( (trim(cam_take_snapshot_after) == "clubb_tend_cam") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + call physics_ptend_sum(ptend,ptend_macp_all,ncol) + call physics_update(state, ptend, ztodt, tend) + + if (trim(cam_take_snapshot_after) == "clubb_tend_cam") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + ! Use actual qflux (not lhf/latvap) for consistency with surface fluxes and revised code + call check_energy_cam_chng(state, tend, "clubb_tend", nstep, ztodt, & + cam_in%cflx(:ncol,1)/cld_macmic_num_steps, & + flx_cnd(:ncol)/cld_macmic_num_steps, & + det_ice(:ncol)/cld_macmic_num_steps, & + flx_heat(:ncol)/cld_macmic_num_steps) + + call t_stopf('macrop_tend') + + !=================================================== + ! Calculate cloud microphysics + !=================================================== + + if (is_subcol_on() .neqv. use_subcol_microp ) then + call endrun("Error calculating cloud microphysics: is_subcol_on() != use_subcol_microp") + end if + + if (is_subcol_on()) then + ! Allocate sub-column structures. + call physics_state_alloc(state_sc, lchnk, psubcols*pcols) + call physics_tend_alloc(tend_sc, psubcols*pcols) + + ! Generate sub-columns using the requested scheme + if (trim(subcol_scheme) == 'SILHS') call init_state_subcol(state, tend, state_sc, tend_sc) + call subcol_gen(state, tend, state_sc, tend_sc, pbuf) + + !Initialize check energy for subcolumns + call check_energy_timestep_init(state_sc, tend_sc, pbuf, col_type_subcol) + end if + + if (trim(cam_take_snapshot_before) == "microp_section") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call t_startf('microp_aero_run') + call microp_aero_run(state, ptend_aero, cld_macmic_ztodt, pbuf) + call t_stopf('microp_aero_run') + + call t_startf('microp_tend') + + if (use_subcol_microp) then + + if (trim(cam_take_snapshot_before) == "microp_driver_tend_subcol") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state_sc, tend_sc, cam_in, cam_out, pbuf, & + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call microp_driver_tend(state_sc, ptend_sc, cld_macmic_ztodt, pbuf) + ! Parameterize subcolumn effects on covariances, if enabled + if (trim(subcol_scheme) == 'SILHS') & + call subcol_SILHS_var_covar_driver( cld_macmic_ztodt, state_sc, ptend_sc, pbuf ) + + ! Average the sub-column ptend for use in gridded update - will not contain ptend_aero + call subcol_ptend_avg(ptend_sc, state_sc%ngrdcol, lchnk, ptend) + + ! Call the conservative hole filler. + ! Hole filling is only necessary when using subcolumns. + ! Note: this needs to be called after subcol_ptend_avg but before + ! physics_ptend_scale. + if (trim(subcol_scheme) == 'SILHS') & + call subcol_SILHS_fill_holes_conserv( state, cld_macmic_ztodt, & + ptend, pbuf ) + + ! Destroy massless droplets - Note this routine returns with no change unless + ! micro_do_massless_droplet_destroyer has been set to true + call massless_droplet_destroyer( cld_macmic_ztodt, state, & ! Intent(in) + ptend ) ! Intent(inout) + + ! Limit the value of hydrometeor concentrations in order to place + ! reasonable limits on hydrometeor drop size and keep them from + ! becoming too large. + ! Note: this needs to be called after hydrometeor mixing ratio + ! tendencies are adjusted by subcol_SILHS_fill_holes_conserv + ! and after massless drop concentrations are removed by the + ! subcol_SILHS_massless_droplet_destroyer, but before the + ! call to physics_ptend_scale. + if (trim(subcol_scheme) == 'SILHS') & + call subcol_SILHS_hydromet_conc_tend_lim( state, cld_macmic_ztodt, ptend ) + + ! Copy ptend_aero field to one dimensioned by sub-columns before summing with ptend + call subcol_ptend_copy(ptend_aero, state_sc, ptend_aero_sc) + call physics_ptend_sum(ptend_aero_sc, ptend_sc, state_sc%ncol) + call physics_ptend_dealloc(ptend_aero_sc) + + ! Have to scale and apply for full timestep to get tend right + ! (see above note for macrophysics). + call physics_ptend_scale(ptend_sc, 1._r8/cld_macmic_num_steps, ncol) + + if ( (trim(cam_take_snapshot_after) == "microp_driver_tend_subcol") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + call physics_update (state_sc, ptend_sc, ztodt, tend_sc) + + if (trim(cam_take_snapshot_after) == "microp_driver_tend_subcol") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state_sc, tend_sc, cam_in, cam_out, pbuf, & + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call check_energy_cam_chng(state_sc, tend_sc, "microp_tend_subcol", & + nstep, ztodt, zero_sc, & + prec_str_sc(:state_sc%ncol)/cld_macmic_num_steps, & + snow_str_sc(:state_sc%ncol)/cld_macmic_num_steps, zero_sc) + + call physics_state_dealloc(state_sc) + call physics_tend_dealloc(tend_sc) + call physics_ptend_dealloc(ptend_sc) + else + call microp_driver_tend(state, ptend, cld_macmic_ztodt, pbuf) + end if + ! combine aero and micro tendencies for the grid + call physics_ptend_sum(ptend_aero, ptend, ncol) + call physics_ptend_dealloc(ptend_aero) + + ! Have to scale and apply for full timestep to get tend right + ! (see above note for macrophysics). + call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol) + + call diag_clip_tend_writeout(state, ptend, ncol, lchnk, ixcldliq, ixcldice, ixq, ztodt, rtdt) + + if ( (trim(cam_take_snapshot_after) == "microp_section") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + call physics_update (state, ptend, ztodt, tend) + + if (trim(cam_take_snapshot_after) == "microp_section") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call check_energy_cam_chng(state, tend, "microp_tend", nstep, ztodt, & + zero, prec_str(:ncol)/cld_macmic_num_steps, & + snow_str(:ncol)/cld_macmic_num_steps, zero) + + call t_stopf('microp_tend') + + prec_sed_macmic(:ncol) = prec_sed_macmic(:ncol) + prec_sed(:ncol) + snow_sed_macmic(:ncol) = snow_sed_macmic(:ncol) + snow_sed(:ncol) + prec_pcw_macmic(:ncol) = prec_pcw_macmic(:ncol) + prec_pcw(:ncol) + snow_pcw_macmic(:ncol) = snow_pcw_macmic(:ncol) + snow_pcw(:ncol) + + end do ! end substepping over macrophysics/microphysics + + call outfld( 'UTEND_MACROP', ptend_macp_all%u, pcols, lchnk) + call outfld( 'VTEND_MACROP', ptend_macp_all%v, pcols, lchnk) + call physics_ptend_dealloc(ptend_macp_all) + + prec_sed(:ncol) = prec_sed_macmic(:ncol)/cld_macmic_num_steps + snow_sed(:ncol) = snow_sed_macmic(:ncol)/cld_macmic_num_steps + prec_pcw(:ncol) = prec_pcw_macmic(:ncol)/cld_macmic_num_steps + snow_pcw(:ncol) = snow_pcw_macmic(:ncol)/cld_macmic_num_steps + prec_str(:ncol) = prec_pcw(:ncol) + prec_sed(:ncol) + snow_str(:ncol) = snow_pcw(:ncol) + snow_sed(:ncol) + + endif + + ! Add the precipitation from CARMA to the precipitation from stratiform. + if (carma_do_cldice .or. carma_do_cldliq) then + prec_sed(:ncol) = prec_sed(:ncol) + prec_sed_carma(:ncol) + snow_sed(:ncol) = snow_sed(:ncol) + snow_sed_carma(:ncol) + end if + + if ( .not. deep_scheme_does_scav_trans() ) then + + ! ------------------------------------------------------------------------------- + ! 1. Wet Scavenging of Aerosols by Convective and Stratiform Precipitation. + ! 2. Convective Transport of Non-Water Aerosol Species. + ! + ! . Aerosol wet chemistry determines scavenging fractions, and transformations + ! . Then do convective transport of all trace species except qv,ql,qi. + ! . We needed to do the scavenging first to determine the interstitial fraction. + ! . When UNICON is used as unified convection, we should still perform + ! wet scavenging but not 'convect_deep_tend2'. + ! ------------------------------------------------------------------------------- + + call t_startf('aerosol_wet_processes') + if (clim_modal_aero) then + if (prog_modal_aero) then + call physics_ptend_init(ptend, state%psetcols, 'aero_water_uptake', lq=wetdep_lq) + ! Do calculations of mode radius and water uptake if: + ! 1) modal aerosols are affecting the climate, or + ! 2) prognostic modal aerosols are enabled + call modal_aero_calcsize_sub(state, ptend, ztodt, pbuf) + ! for prognostic modal aerosols the transfer of mass between aitken and accumulation + ! modes is done in conjunction with the dry radius calculation + call modal_aero_wateruptake_dr(state, pbuf) + call physics_update(state, ptend, ztodt, tend) + else + call modal_aero_calcsize_diag(state, pbuf) + call modal_aero_wateruptake_dr(state, pbuf) + endif + endif + + if (trim(cam_take_snapshot_before) == "aero_model_wetdep") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call aero_model_wetdep( state, ztodt, dlf, cam_out, ptend, pbuf) + if ( (trim(cam_take_snapshot_after) == "aero_model_wetdep") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + + if (trim(cam_take_snapshot_after) == "aero_model_wetdep") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + if (carma_do_wetdep) then + ! CARMA wet deposition + ! + ! NOTE: It needs to follow aero_model_wetdep, so that + ! cam_out%xxxwetxxx + ! fields have already been set for CAM aerosols and cam_out can be + ! added + ! to for CARMA aerosols. + call t_startf ('carma_wetdep_tend') + call carma_wetdep_tend(state, ptend, ztodt, pbuf, dlf, cam_out) + call physics_update(state, ptend, ztodt, tend) + call t_stopf ('carma_wetdep_tend') + end if + + call t_startf ('convect_deep_tend2') + call convect_deep_tend_2( state, ptend, ztodt, pbuf ) + call physics_update(state, ptend, ztodt, tend) + call t_stopf ('convect_deep_tend2') + + ! check tracer integrals + call check_tracers_chng(state, tracerint, "cmfmca", nstep, ztodt, zero_tracers) + + call t_stopf('aerosol_wet_processes') + + endif + + !=================================================== + ! Moist physical parameteriztions complete: + ! send dynamical variables, and derived variables to history file + !=================================================== + + call t_startf('bc_history_write') + call diag_phys_writeout(state, pbuf) + call diag_conv(state, ztodt, pbuf) + + call t_stopf('bc_history_write') + + !=================================================== + ! Write cloud diagnostics on history file + !=================================================== + + call t_startf('bc_cld_diag_history_write') + + call cloud_diagnostics_calc(state, pbuf) + + call t_stopf('bc_cld_diag_history_write') + + !=================================================== + ! Radiation computations + !=================================================== + call t_startf('radiation') + + if (trim(cam_take_snapshot_before) == "radiation_tend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call radiation_tend( & + state, ptend, pbuf, cam_out, cam_in, net_flx) + + ! Set net flux used by spectral dycores + do i=1,ncol + tend%flx_net(i) = net_flx(i) + end do + + if ( (trim(cam_take_snapshot_after) == "radiation_tend") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + + if (trim(cam_take_snapshot_after) == "radiation_tend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call check_energy_cam_chng(state, tend, "radheat", nstep, ztodt, zero, zero, zero, net_flx) + + call t_stopf('radiation') + + ! Diagnose the location of the tropopause and its location to the history file(s). + call t_startf('tropopause') + call tropopause_output(state) + call t_stopf('tropopause') + + !=================================================== + ! Source/sink terms for advected tracers. + !=================================================== + call t_startf('adv_tracer_src_snk') + ! Test tracers + + if (trim(cam_take_snapshot_before) == "aoa_tracers_timestep_tend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + call aoa_tracers_timestep_tend(state, ptend, ztodt) + if ( (trim(cam_take_snapshot_after) == "aoa_tracers_timestep_tend") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + if (trim(cam_take_snapshot_after) == "aoa_tracers_timestep_tend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + call check_tracers_chng(state, tracerint, "aoa_tracers_timestep_tend", nstep, ztodt, & + cam_in%cflx) + + if (trim(cam_take_snapshot_before) == "co2_cycle_set_ptend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + call co2_cycle_set_ptend(state, pbuf, ptend) + if ( (trim(cam_take_snapshot_after) == "co2_cycle_set_ptend") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + if (trim(cam_take_snapshot_after) == "co2_cycle_set_ptend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + !=================================================== + ! Chemistry and MAM calculation + ! MAM core aerosol conversion process is performed in the below 'chem_timestep_tend'. + ! In addition, surface flux of aerosol species other than 'dust' and 'sea salt', and + ! elevated emission of aerosol species are treated in 'chem_timestep_tend' before + ! Gas chemistry and MAM core aerosol conversion. + ! Note that surface flux is not added into the atmosphere, but elevated emission is + ! added into the atmosphere as tendency. + !=================================================== + if (chem_is_active()) then + + if (trim(cam_take_snapshot_before) == "chem_timestep_tend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, & + pbuf, fh2o=fh2o) + + + if ( (trim(cam_take_snapshot_after) == "chem_timestep_tend") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + + if (trim(cam_take_snapshot_after) == "chem_timestep_tend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + call check_energy_cam_chng(state, tend, "chem", nstep, ztodt, fh2o, zero, zero, zero) + call check_tracers_chng(state, tracerint, "chem_timestep_tend", nstep, ztodt, & + cam_in%cflx) + end if + call t_stopf('adv_tracer_src_snk') + + !=================================================== + ! Vertical diffusion/pbl calculation + ! Call vertical diffusion (apply tracer emissions, molecular diffusion and pbl form drag) + !=================================================== + + call t_startf('vertical_diffusion_tend') + + if (trim(cam_take_snapshot_before) == "vertical_diffusion_section") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call vertical_diffusion_tend (ztodt ,state , cam_in, & + surfric ,obklen ,ptend ,ast ,pbuf ) + + !------------------------------------------ + ! Call major diffusion for extended model + !------------------------------------------ + if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + call waccmx_phys_mspd_tend (ztodt ,state ,ptend) + endif + + if ( (trim(cam_take_snapshot_after) == "vertical_diffusion_section") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + if ( ptend%lu ) then + call outfld( 'UTEND_VDIFF', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_VDIFF', ptend%v, pcols, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + + if (trim(cam_take_snapshot_after) == "vertical_diffusion_section") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call t_stopf ('vertical_diffusion_tend') + + !=================================================== + ! Rayleigh friction calculation + !=================================================== + call t_startf('rayleigh_friction') + call rayleigh_friction_tend( ztodt, state, ptend) + if ( ptend%lu ) then + call outfld( 'UTEND_RAYLEIGH', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_RAYLEIGH', ptend%v, pcols, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + call t_stopf('rayleigh_friction') + + if (do_clubb_sgs) then + call check_energy_cam_chng(state, tend, "vdiff", nstep, ztodt, zero, zero, zero, zero) + else + call check_energy_cam_chng(state, tend, "vdiff", nstep, ztodt, cam_in%cflx(:,1), zero, & + zero, cam_in%shf) + endif + + call check_tracers_chng(state, tracerint, "vdiff", nstep, ztodt, cam_in%cflx) + + ! aerosol dry deposition processes + call t_startf('aero_drydep') + + if (trim(cam_take_snapshot_before) == "aero_model_drydep") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call aero_model_drydep( state, pbuf, obklen, surfric, cam_in, ztodt, cam_out, ptend ) + if ( (trim(cam_take_snapshot_after) == "aero_model_drydep") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + + if (trim(cam_take_snapshot_after) == "aero_model_drydep") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call t_stopf('aero_drydep') + + ! CARMA microphysics + ! + ! NOTE: This does both the timestep_tend for CARMA aerosols as well as doing + ! the dry + ! deposition for CARMA aerosols. It needs to follow vertical_diffusion_tend, + ! so that + ! obklen and surfric have been calculated. It needs to follow + ! aero_model_drydep, so + ! that cam_out%xxxdryxxx fields have already been set for CAM aerosols and + ! cam_out + ! can be added to for CARMA aerosols. + if (carma_do_aerosol) then + call t_startf('carma_timestep_tend') + call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, obklen=obklen, ustar=surfric) + call physics_update(state, ptend, ztodt, tend) + + call check_energy_cam_chng(state, tend, "carma_tend", nstep, ztodt, zero, zero, zero, zero) + call t_stopf('carma_timestep_tend') + end if + + !--------------------------------------------------------------------------------- + ! ... enforce charge neutrality + !--------------------------------------------------------------------------------- + call charge_balance(state, pbuf) + + !=================================================== + ! Gravity wave drag + !=================================================== + call t_startf('gw_tend') + + if (trim(cam_take_snapshot_before) == "gw_tend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call gw_tend(state, pbuf, ztodt, ptend, cam_in, flx_heat) + + if ( (trim(cam_take_snapshot_after) == "gw_tend") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + if ( ptend%lu ) then + call outfld( 'UTEND_GWDTOT', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_GWDTOT', ptend%v, pcols, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + + if (trim(cam_take_snapshot_after) == "gw_tend") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + ! Check energy integrals + call check_energy_cam_chng(state, tend, "gwdrag", nstep, ztodt, zero, & + zero, zero, flx_heat) + call t_stopf('gw_tend') + + ! QBO relaxation + + if (trim(cam_take_snapshot_before) == "qbo_relax") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call qbo_relax(state, pbuf, ptend) + if ( (trim(cam_take_snapshot_after) == "qbo_relax") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + if ( ptend%lu ) then + call outfld( 'UTEND_QBORLX', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_QBORLX', ptend%v, pcols, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + + if (trim(cam_take_snapshot_after) == "qbo_relax") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + ! Check energy integrals + call check_energy_cam_chng(state, tend, "qborelax", nstep, ztodt, zero, zero, zero, zero) + + ! Lunar tides + call lunar_tides_tend( state, ptend ) + if ( ptend%lu ) then + call outfld( 'UTEND_LUNART', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_LUNART', ptend%v, pcols, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + ! Check energy integrals + call check_energy_cam_chng(state, tend, "lunar_tides", nstep, ztodt, zero, zero, zero, zero) + + ! Ion drag calculation + call t_startf ( 'iondrag' ) + + if (trim(cam_take_snapshot_before) == "iondrag_calc_section") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + if ( do_waccm_ions ) then + call iondrag_calc( lchnk, ncol, state, ptend, pbuf, ztodt ) + else + call iondrag_calc( lchnk, ncol, state, ptend) + endif + !---------------------------------------------------------------------------- + ! Call ionosphere routines for extended model if mode is set to ionosphere + !---------------------------------------------------------------------------- + if( waccmx_is('ionosphere') ) then + call waccmx_phys_ion_elec_temp_tend(state, ptend, pbuf, ztodt) + endif + + if ( (trim(cam_take_snapshot_after) == "iondrag_calc_section") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + if ( ptend%lu ) then + call outfld( 'UTEND_IONDRG', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_IONDRG', ptend%v, pcols, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + + if (trim(cam_take_snapshot_after) == "iondrag_calc_section") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + call tot_energy_phys(state, 'phAP') + call tot_energy_phys(state, 'dyAP',vc=vc_dycore) + + !--------------------------------------------------------------------------------- + ! Enforce charge neutrality after O+ change from ionos_tend + !--------------------------------------------------------------------------------- + if( waccmx_is('ionosphere') ) then + call charge_balance(state, pbuf) + endif + + ! Check energy integrals + call check_energy_cam_chng(state, tend, "iondrag", nstep, ztodt, zero, zero, zero, zero) + + call t_stopf ( 'iondrag' ) + + ! Update Nudging values, if needed + !---------------------------------- + if((Nudge_Model).and.(Nudge_ON)) then + call nudging_timestep_tend(state,ptend) + if ( ptend%lu ) then + call outfld( 'UTEND_NDG', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_NDG', ptend%v, pcols, lchnk) + end if + call physics_update(state,ptend,ztodt,tend) + call check_energy_cam_chng(state, tend, "nudging", nstep, ztodt, zero, zero, zero, zero) + endif + + !-------------- Energy budget checks vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv + ! Save total energy for global fixer in next timestep + ! + ! This call must be after the last parameterization and call to physics_update + ! + call pbuf_set_field(pbuf, teout_idx, state%te_cur(:,dyn_te_idx), (/1,itim_old/),(/pcols,1/)) + ! + ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust + ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. + moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') + ! + ! update cp/cv for energy computation based in updated water variables + ! + call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore,& + to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) + + ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. + ! So, save off tracers + if (.not.moist_mixing_ratio_dycore) then + ! + ! for dry-mixing ratio based dycores dme_adjust takes place in the dynamical core + ! + ! only compute dme_adjust for diagnostics purposes + ! + if (thermo_budget_history) then + tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) + tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) + tmp_ps(:ncol) = state%ps(:ncol) + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) + ! Restore pre-"physics_dme_adjust" tracers + state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) + state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) + state%ps(:ncol) = tmp_ps(:ncol) + end if + else + ! + ! for moist-mixing ratio based dycores + ! + ! Note: this operation will NOT be reverted with set_wet_to_dry after set_dry_to_wet call + ! + call set_dry_to_wet(state, convert_cnst_type='dry') + + if (trim(cam_take_snapshot_before) == "physics_dme_adjust") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) + if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + end if + + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) + endif + + if (vc_dycore == vc_height.or.vc_dycore == vc_dry_pressure) then + ! + ! MPAS and SE specific scaling of temperature for enforcing energy consistency + ! (and to make sure that temperature dependent diagnostic tendencies + ! are computed correctly; e.g. dtcore) + ! + scaling(1:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv_dycore(:ncol,:,lchnk) + state%T(1:ncol,:) = state%temp_ini(1:ncol,:)+& + scaling(1:ncol,:)*(state%T(1:ncol,:)-state%temp_ini(1:ncol,:)) + tend%dtdt(:ncol,:) = scaling(:ncol,:)*tend%dtdt(:ncol,:) + ! + ! else: do nothing for dycores with energy consistent with CAM physics + ! + end if + + + ! store T, U, and V in buffer for use in computing dynamics T-tendency in next timestep + do k = 1,pver + dtcore(:ncol,k) = state%t(:ncol,k) + dqcore(:ncol,k) = state%q(:ncol,k,ixq) + ducore(:ncol,k) = state%u(:ncol,k) + dvcore(:ncol,k) = state%v(:ncol,k) + end do + + !-------------- Energy budget checks ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + + if (aqua_planet) then + labort = .false. + do i=1,ncol + if (cam_in%ocnfrac(i) /= 1._r8) then + labort = .true. + if (masterproc) write(iulog,*) 'oceanfrac(',i,')=',cam_in%ocnfrac(i) + end if + end do + if (labort) then + call endrun ('TPHYSAC error: in aquaplanet mode, but grid contains non-ocean point') + endif + endif + + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, cldliqini, cldiceini) + + call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) + + ! output these here -- after updates by chem_timestep_tend or export_fields within the current time step + if (associated(cam_out%nhx_nitrogen_flx)) then + call outfld('a2x_NHXDEP', cam_out%nhx_nitrogen_flx, pcols, lchnk) + end if + if (associated(cam_out%noy_nitrogen_flx)) then + call outfld('a2x_NOYDEP', cam_out%noy_nitrogen_flx, pcols, lchnk) + end if + + end subroutine tphysac + + subroutine tphysbc (ztodt, state, & + tend, pbuf, & + cam_out, cam_in ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Evaluate and apply physical processes that are calculated BEFORE + ! coupling to land, sea, and ice models. + ! + ! Processes currently included are: + ! + ! o Resetting Negative Tracers to Positive + ! o Global Mean Total Energy Fixer + ! o Dry Adjustment + ! o Asymmetric Turbulence Scheme - Deep Convection & Shallow Convection + ! + ! Method: + ! + ! Each parameterization should be implemented with this sequence of calls: + ! 1) Call physics interface + ! 2) Check energy + ! 3) Call physics_update + ! See Interface to Column Physics and Chemistry Packages + ! http://www.ccsm.ucar.edu/models/atm-cam/docs/phys-interface/index.html + ! + !----------------------------------------------------------------------- + + use physics_buffer, only: physics_buffer_desc, pbuf_get_field + use physics_buffer, only: pbuf_get_index, pbuf_old_tim_idx + use physics_buffer, only: col_type_subcol, dyn_time_lvls + + use dadadj_cam, only: dadadj_tend + use physics_types, only: physics_update, & + physics_state_check, & + dyn_te_idx + use physconst, only: rair, gravit + use cam_diagnostics, only: diag_conv_tend_ini, diag_export, diag_state_b4_phys_write + use cam_diagnostic_utils, only: cpslec + use cam_history, only: outfld + use constituents, only: qmin + use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx + use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx + use convect_deep, only: convect_deep_tend + use time_manager, only: is_first_step, get_nstep + use convect_diagnostics,only: convect_diagnostics_calc + use check_energy, only: check_energy_cam_chng, check_energy_cam_fix + use check_energy, only: check_tracers_data, check_tracers_init + use check_energy, only: tot_energy_phys + use dycore, only: dycore_is + use radiation, only: radiation_tend + use perf_mod + use mo_gas_phase_chemdr,only: map2chm + use clybry_fam, only: clybry_fam_adj + use cam_abortutils, only: endrun + use subcol_utils, only: is_subcol_on + use qneg_module, only: qneg3 + use cam_snapshot, only: cam_snapshot_all_outfld_tphysbc + use cam_snapshot_common, only: cam_snapshot_ptend_outfld + use dyn_tests_utils, only: vc_dycore + + ! Arguments + + real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) + + type(physics_state), intent(inout) :: state + type(physics_tend ), intent(inout) :: tend + type(physics_buffer_desc), pointer :: pbuf(:) + + type(cam_out_t), intent(inout) :: cam_out + type(cam_in_t), intent(in) :: cam_in + + + ! + !---------------------------Local workspace----------------------------- + ! + + type(physics_ptend) :: ptend ! indivdual parameterization tendencies + + integer :: nstep ! current timestep number + + real(r8) :: net_flx(pcols) + + real(r8) :: zdu(pcols,pver) ! detraining mass flux from deep convection + real(r8) :: cmfmc(pcols,pverp) ! Convective mass flux--m sub c + + real(r8) cmfcme(pcols,pver) ! cmf condensation - evaporation + + real(r8) dlf(pcols,pver) ! Detraining cld H20 from shallow + deep convections + real(r8) dlf2(pcols,pver) ! Detraining cld H20 from shallow convections + real(r8) rtdt ! 1./ztodt + + integer lchnk ! chunk identifier + integer ncol ! number of atmospheric columns + + integer :: i ! column indicex + integer :: ixcldice, ixcldliq, ixq ! constituent indices for cloud liquid and ice water. + integer :: m, m_cnst + + ! physics buffer fields to compute tendencies for stratiform package + integer itim_old, ifld + real(r8), pointer, dimension(:,:) :: cld ! cloud fraction + + ! physics buffer fields for total energy and mass adjustment + real(r8), pointer, dimension(: ) :: teout + real(r8), pointer, dimension(:,:) :: qini + real(r8), pointer, dimension(:,:) :: cldliqini + real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: totliqini + real(r8), pointer, dimension(:,:) :: toticeini + real(r8), pointer, dimension(:,:) :: dtcore + real(r8), pointer, dimension(:,:) :: dqcore + real(r8), pointer, dimension(:,:) :: ducore + real(r8), pointer, dimension(:,:) :: dvcore + + real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble + + real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio. + real(r8), pointer :: rliqbc(:) ! tphysbc reserve liquid + + ! convective precipitation variables + real(r8),pointer :: prec_dp(:) ! total precipitation from ZM convection + real(r8),pointer :: snow_dp(:) ! snow from ZM convection + real(r8),pointer :: prec_sh(:) ! total precipitation from Hack convection + real(r8),pointer :: snow_sh(:) ! snow from Hack convection + + ! stratiform precipitation variables + real(r8),pointer :: prec_str(:) ! sfc flux of precip from stratiform (m/s) + real(r8),pointer :: snow_str(:) ! sfc flux of snow from stratiform (m/s) + real(r8),pointer :: prec_str_sc(:) ! sfc flux of precip from stratiform (m/s) -- for subcolumns + real(r8),pointer :: snow_str_sc(:) ! sfc flux of snow from stratiform (m/s) -- for subcolumns + real(r8),pointer :: prec_pcw(:) ! total precip from prognostic cloud scheme + real(r8),pointer :: snow_pcw(:) ! snow from prognostic cloud scheme + real(r8),pointer :: prec_sed(:) ! total precip from cloud sedimentation + real(r8),pointer :: snow_sed(:) ! snow from cloud ice sedimentation + + ! energy checking variables + real(r8) :: zero(pcols) ! array of zeros + real(r8) :: zero_sc(pcols*psubcols) ! array of zeros + real(r8) :: rliq(pcols) ! vertical integral of liquid not yet in q(ixcldliq) + real(r8) :: rice(pcols) ! vertical integral of ice not yet in q(ixcldice) + real(r8) :: rliq2(pcols) ! vertical integral of liquid from shallow scheme + real(r8) :: flx_cnd(pcols) + real(r8) :: flx_heat(pcols) + type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes + real(r8) :: zero_tracers(pcols,pcnst) + + real(r8), pointer :: psl(:) ! Sea Level Pressure + + logical :: lq(pcnst) + + !----------------------------------------------------------------------- + + call t_startf('bc_init') + + zero = 0._r8 + zero_tracers(:,:) = 0._r8 + zero_sc(:) = 0._r8 + + lchnk = state%lchnk + ncol = state%ncol + + rtdt = 1._r8/ztodt + + nstep = get_nstep() + + ! Associate pointers with physics buffer fields + itim_old = pbuf_old_tim_idx() + ifld = pbuf_get_index('CLD') + call pbuf_get_field(pbuf, ifld, cld, (/1,1,itim_old/),(/pcols,pver,1/)) + + call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) + + call pbuf_get_field(pbuf, qini_idx, qini) + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, totliqini_idx, totliqini) + call pbuf_get_field(pbuf, toticeini_idx, toticeini) + + call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, ducore_idx, ducore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, dvcore_idx, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + ifld = pbuf_get_index('FRACIS') + call pbuf_get_field(pbuf, ifld, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) + fracis (:ncol,:,1:pcnst) = 1._r8 + + ! Set physics tendencies to 0 + tend%dTdt(:ncol,:pver) = 0._r8 + tend%dudt(:ncol,:pver) = 0._r8 + tend%dvdt(:ncol,:pver) = 0._r8 + + ! Verify state coming from the dynamics + if (state_debug_checks) then + call physics_state_check(state, name="before tphysbc (dycore?)") + end if + + call clybry_fam_adj( ncol, lchnk, map2chm, state%q, pbuf ) + + ! Since clybry_fam_adj operates directly on the tracers, and has no + ! physics_update call, re-run qneg3. + call qneg3('TPHYSBCc',lchnk ,ncol ,pcols ,pver , & + 1, pcnst, qmin ,state%q ) + + ! Validate output of clybry_fam_adj. + if (state_debug_checks) then + call physics_state_check(state, name="clybry_fam_adj") + end if + ! + ! Dump out "before physics" state + ! + call diag_state_b4_phys_write (state) + + ! compute mass integrals of input tracers state + call check_tracers_init(state, tracerint) + + call t_stopf('bc_init') + + !=================================================== + ! Global mean total energy fixer + !=================================================== + call t_startf('energy_fixer') + + call tot_energy_phys(state, 'phBF') + call tot_energy_phys(state, 'dyBF',vc=vc_dycore) + + call check_energy_cam_fix(state, ptend, nstep, flx_heat) + call physics_update(state, ptend, ztodt, tend) + call check_energy_cam_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) + call outfld( 'EFIX', flx_heat , pcols, lchnk ) + + call tot_energy_phys(state, 'phBP') + call tot_energy_phys(state, 'dyBP',vc=vc_dycore) + ! Save state for convective tendency calculations. + call diag_conv_tend_ini(state, pbuf) + + call cnst_get_ind('Q', ixq) + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + qini (:ncol,:pver) = state%q(:ncol,:pver, ixq) + cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + + totliqini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_liq_num + m = thermodynamic_active_species_liq_idx(m_cnst) + totliqini(:ncol,:pver) = totliqini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do + toticeini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_ice_num + m = thermodynamic_active_species_ice_idx(m_cnst) + toticeini(:ncol,:pver) = toticeini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do + + + call outfld('TEOUT', teout , pcols, lchnk ) + call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) + call outfld('TEFIX', state%te_cur(:,dyn_te_idx), pcols, lchnk ) + + ! T, U, V tendency due to dynamics + if ( nstep > dyn_time_lvls-1 ) then + dtcore(:ncol,:pver) = (state%t(:ncol,:pver) - dtcore(:ncol,:pver))/ztodt + dqcore(:ncol,:pver) = (state%q(:ncol,:pver,ixq) - dqcore(:ncol,:pver))/ztodt + ducore(:ncol,:pver) = (state%u(:ncol,:pver) - ducore(:ncol,:pver))/ztodt + dvcore(:ncol,:pver) = (state%v(:ncol,:pver) - dvcore(:ncol,:pver))/ztodt + call outfld( 'DTCORE', dtcore, pcols, lchnk ) + call outfld( 'DQCORE', dqcore, pcols, lchnk ) + call outfld( 'UTEND_CORE', ducore, pcols, lchnk ) + call outfld( 'VTEND_CORE', dvcore, pcols, lchnk ) + end if + + call t_stopf('energy_fixer') + ! + !=================================================== + ! Dry adjustment + !=================================================== + call t_startf('dry_adjustment') + + if (trim(cam_take_snapshot_before) == "dadadj_tend") then + call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & + cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) + end if + + call dadadj_tend(ztodt, state, ptend) + + if ( (trim(cam_take_snapshot_after) == "dadadj_tend") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + + if (trim(cam_take_snapshot_after) == "dadadj_tend") then + call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & + cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) + end if + + call t_stopf('dry_adjustment') + + !=================================================== + ! Moist convection + !=================================================== + call t_startf('moist_convection') + + call t_startf ('convect_deep_tend') + + if (trim(cam_take_snapshot_before) == "convect_deep_tend") then + call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & + cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) + end if + + call convect_deep_tend( & + cmfmc, cmfcme, & + zdu, & + rliq, rice, & + ztodt, & + state, ptend, cam_in%landfrac, pbuf) + + if ( (trim(cam_take_snapshot_after) == "convect_deep_tend") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + + if ( ptend%lu ) then + call outfld( 'UTEND_DCONV', ptend%u, pcols, lchnk) + end if + if ( ptend%lv ) then + call outfld( 'VTEND_DCONV', ptend%v, pcols, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + + if (trim(cam_take_snapshot_after) == "convect_deep_tend") then + call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & + cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) + end if + + call t_stopf('convect_deep_tend') + + call pbuf_get_field(pbuf, prec_dp_idx, prec_dp ) + call pbuf_get_field(pbuf, snow_dp_idx, snow_dp ) + call pbuf_get_field(pbuf, prec_sh_idx, prec_sh ) + call pbuf_get_field(pbuf, snow_sh_idx, snow_sh ) + + call pbuf_get_field(pbuf, prec_str_idx, prec_str ) + call pbuf_get_field(pbuf, snow_str_idx, snow_str ) + call pbuf_get_field(pbuf, prec_sed_idx, prec_sed ) + call pbuf_get_field(pbuf, snow_sed_idx, snow_sed ) + call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw ) + call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw ) + + if (use_subcol_microp) then + call pbuf_get_field(pbuf, prec_str_idx, prec_str_sc, col_type=col_type_subcol) + call pbuf_get_field(pbuf, snow_str_idx, snow_str_sc, col_type=col_type_subcol) + end if + + ! Check energy integrals, including "reserved liquid" + flx_cnd(:ncol) = prec_dp(:ncol) + rliq(:ncol) + snow_dp(:ncol) = snow_dp(:ncol) + rice(:ncol) + call check_energy_cam_chng(state, tend, "convect_deep", nstep, ztodt, zero, flx_cnd, snow_dp, zero) + snow_dp(:ncol) = snow_dp(:ncol) - rice(:ncol) + + !=================================================== + ! Compute convect diagnostics + !=================================================== + + if (dlfzm_idx > 0) then + call pbuf_get_field(pbuf, dlfzm_idx, dlfzm) + dlf(:ncol,:) = dlfzm(:ncol,:) + else + dlf(:,:) = 0._r8 + end if + + if (trim(cam_take_snapshot_before) == "convect_diagnostics_calc") then + call cam_snapshot_all_outfld_tphysbc(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf, & + cmfmc, cmfcme, zdu, rliq, rice, dlf, dlf2, rliq2, net_flx) + end if + call convect_diagnostics_calc (ztodt , cmfmc, & + dlf , dlf2 , rliq , rliq2, & + state , pbuf) + if ( (trim(cam_take_snapshot_after) == "convect_diagnostics_calc") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + + ! add reserve liquid to pbuf + call pbuf_get_field(pbuf, rliqbc_idx, rliqbc) + rliqbc(:ncol) = rliq(:ncol) + + call t_stopf('moist_convection') + + if (is_first_step()) then + + !initiailize sedimentation arrays + prec_pcw = 0._r8 + snow_pcw = 0._r8 + prec_sed = 0._r8 + snow_sed = 0._r8 + prec_str = 0._r8 + snow_str = 0._r8 + + if (is_subcol_on()) then + prec_str_sc = 0._r8 + snow_str_sc = 0._r8 + end if + + !=================================================== + ! Run wet deposition routines to intialize aerosols + !=================================================== + + if (clim_modal_aero) then + call modal_aero_calcsize_diag(state, pbuf) + call modal_aero_wateruptake_dr(state, pbuf) + end if + + !=================================================== + ! Radiation computations + ! initialize fluxes only, do not update state + !=================================================== + + call radiation_tend( & + state, ptend, pbuf, cam_out, cam_in, net_flx) + + end if + + ! Save atmospheric fields to force surface models + call t_startf('cam_export') + call pbuf_get_field(pbuf, psl_idx, psl) + call cpslec(ncol, state%pmid, state%phis, state%ps, state%t, psl, gravit, rair) + call cam_export (state,cam_out,pbuf) + call t_stopf('cam_export') + + ! Write export state to history file + call t_startf('diag_export') + call diag_export(cam_out) + call t_stopf('diag_export') + + end subroutine tphysbc + +subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) +!----------------------------------------------------------------------------------- +! +! Purpose: The place for parameterizations to call per timestep initializations. +! Generally this is used to update time interpolated fields from boundary +! datasets. +! +!----------------------------------------------------------------------------------- + use chemistry, only: chem_timestep_init + use chem_surfvals, only: chem_surfvals_set + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc + use carma_intr, only: carma_timestep_init + use ghg_data, only: ghg_data_timestep_init + use aoa_tracers, only: aoa_tracers_timestep_init + use vertical_diffusion, only: vertical_diffusion_ts_init + use radheat, only: radheat_timestep_init + use solar_data, only: solar_data_advance + use qbo, only: qbo_timestep_init + use iondrag, only: do_waccm_ions, iondrag_timestep_init + use perf_mod + + use prescribed_ozone, only: prescribed_ozone_adv + use prescribed_ghg, only: prescribed_ghg_adv + use prescribed_aero, only: prescribed_aero_adv + use aerodep_flx, only: aerodep_flx_adv + use aircraft_emit, only: aircraft_emit_adv + use prescribed_volcaero, only: prescribed_volcaero_adv + use prescribed_strataero,only: prescribed_strataero_adv + use mo_apex, only: mo_apex_init + use epp_ionization, only: epp_ionization_active + use iop_forcing, only: scam_use_iop_srf + use nudging, only: Nudge_Model, nudging_timestep_init + use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_timestep_init + use phys_grid_ctem, only: phys_grid_ctem_diags + + implicit none + + type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state + type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in + type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out + + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + !----------------------------------------------------------------------------- + + if (single_column) call scam_use_iop_srf(cam_in) + + ! update geomagnetic coordinates + if (epp_ionization_active .or. do_waccm_ions) then + call mo_apex_init(phys_state) + endif + + ! Chemistry surface values + call chem_surfvals_set() + + ! Solar irradiance + call solar_data_advance() + + ! Time interpolate for chemistry. + call chem_timestep_init(phys_state, pbuf2d) + + if( waccmx_is('ionosphere') ) then + call waccmx_phys_ion_elec_temp_timestep_init(phys_state,pbuf2d) + endif + + ! Prescribed tracers + call prescribed_ozone_adv(phys_state, pbuf2d) + call prescribed_ghg_adv(phys_state, pbuf2d) + call prescribed_aero_adv(phys_state, pbuf2d) + call aircraft_emit_adv(phys_state, pbuf2d) + call prescribed_volcaero_adv(phys_state, pbuf2d) + call prescribed_strataero_adv(phys_state, pbuf2d) + + ! prescribed aerosol deposition fluxes + call aerodep_flx_adv(phys_state, pbuf2d, cam_out) + + ! Time interpolate data models of gasses in pbuf2d + call ghg_data_timestep_init(pbuf2d, phys_state) + + ! Upper atmosphere radiative processes + call radheat_timestep_init(phys_state, pbuf2d) + + ! Time interpolate for vertical diffusion upper boundary condition + call vertical_diffusion_ts_init(pbuf2d, phys_state) + + !---------------------------------------------------------------------- + ! update QBO data for this time step + !---------------------------------------------------------------------- + call qbo_timestep_init + + call iondrag_timestep_init() + + call carma_timestep_init() + + ! age of air tracers + call aoa_tracers_timestep_init(phys_state) + + ! Update Nudging values, if needed + !---------------------------------- + if(Nudge_Model) call nudging_timestep_init(phys_state) + + ! Update TEM diagnostics + call phys_grid_ctem_diags(phys_state) + +end subroutine phys_timestep_init + +end module physpkg diff --git a/src/physics/cam7/stochastic_emulated_cam.F90 b/src/physics/cam7/stochastic_emulated_cam.F90 new file mode 100644 index 0000000000..1433c940e3 --- /dev/null +++ b/src/physics/cam7/stochastic_emulated_cam.F90 @@ -0,0 +1,134 @@ +module stochastic_emulated_cam +! From Morrison (Lebo, originally TAU bin code) +! Gettelman and Chen 2018 +!the subroutines take in air density, air temperature, and the bin mass boundaries, and +!output the mass and number mixing ratio tendencies in each bin directly. +!this is then wrapped for CAM. + +use shr_kind_mod, only: cl=>shr_kind_cl +use cam_history, only: addfld +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +implicit none +private +save + +! Subroutines +public :: stochastic_emulated_readnl +public :: stochastic_emulated_init_cam + +!Module variables +integer, parameter, public :: ncd = 35 +integer, parameter, public :: ncdp = ncd + 1 + +character(len=cl) :: stochastic_emulated_filename_quantile = " " +character(len=cl) :: stochastic_emulated_filename_input_scale = " " +character(len=cl) :: stochastic_emulated_filename_output_scale = " " + +!=============================================================================== +contains +!=============================================================================== + +subroutine stochastic_emulated_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_character, masterproc + use string_utils, only: int2str + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + integer :: unitn, ierr + character(len=*), parameter :: sub = 'stochastic_emulated_readnl' + + namelist /stochastic_emulated_nl/ stochastic_emulated_filename_quantile, stochastic_emulated_filename_input_scale, & + stochastic_emulated_filename_output_scale + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'stochastic_emulated_nl', status=ierr) + if (ierr == 0) then + read(unitn, stochastic_emulated_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub // ':: ERROR reading namelist, iostat = ' // int2str(ierr)) + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(stochastic_emulated_filename_quantile, cl, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: stochastic_emulated_filename_quantile") + + call mpi_bcast(stochastic_emulated_filename_input_scale, cl, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: stochastic_emulated_filename_input_scale") + + call mpi_bcast(stochastic_emulated_filename_output_scale, cl, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: stochastic_emulated_filename_output_scale") + + write(iulog,*) 'PUMAS stochastic_emulated_readnl, stochastic_emulated_filename_quantile=',& + stochastic_emulated_filename_quantile + +end subroutine stochastic_emulated_readnl + +subroutine stochastic_emulated_init_cam(stochastic_emulated_filename_quantile_out, & + stochastic_emulated_filename_input_scale_out, & + stochastic_emulated_filename_output_scale_out) + + use cam_history_support, only: add_hist_coord + + character(len=cl),intent(out) :: stochastic_emulated_filename_quantile_out + character(len=cl),intent(out) :: stochastic_emulated_filename_input_scale_out + character(len=cl),intent(out) :: stochastic_emulated_filename_output_scale_out + + call add_hist_coord('bins_ncd', ncd, 'bins for TAU microphysics') + + call addfld('amk_c',(/'trop_cld_lev','bins_ncd '/),'A','kg','cloud liquid mass from bins', sampled_on_subcycle=.true.) + call addfld('ank_c',(/'trop_cld_lev','bins_ncd '/),'A','1/kg','cloud liquid number concentration from bins',sampled_on_subcycle=.true.) + call addfld('amk_r',(/'trop_cld_lev','bins_ncd '/),'A','kg','rain mass from bins', sampled_on_subcycle=.true.) + call addfld('ank_r',(/'trop_cld_lev','bins_ncd '/),'A','1/kg','rain number concentration from bins', sampled_on_subcycle=.true.) + call addfld('amk',(/'trop_cld_lev','bins_ncd '/),'A','kg','all liquid mass from bins', sampled_on_subcycle=.true.) + call addfld('ank',(/'trop_cld_lev','bins_ncd '/),'A','1/kg','all liquid number concentration from bins', sampled_on_subcycle=.true.) + call addfld('amk_out',(/'trop_cld_lev','bins_ncd '/),'A','kg','all liquid mass from bins', sampled_on_subcycle=.true.) + call addfld('ank_out',(/'trop_cld_lev','bins_ncd '/),'A','1/kg','all liquid number concentration from bins',sampled_on_subcycle=.true.) + + call addfld('scale_nc',(/'trop_cld_lev'/),'A','1','scaling factor for nc', sampled_on_subcycle=.true.) + call addfld('scale_nr',(/'trop_cld_lev'/),'A','1','scaling factor for nr', sampled_on_subcycle=.true.) + call addfld('scale_qc',(/'trop_cld_lev'/),'A','1','scaling factor for qc', sampled_on_subcycle=.true.) + call addfld('scale_qr',(/'trop_cld_lev'/),'A','1','scaling factor for qr', sampled_on_subcycle=.true.) + + call addfld('QC_TAU_in',(/'trop_cld_lev'/),'A','kg/kg','qc in TAU', sampled_on_subcycle=.true.) + call addfld('NC_TAU_in',(/'trop_cld_lev'/),'A','1/kg','nc in TAU', sampled_on_subcycle=.true.) + call addfld('QR_TAU_in',(/'trop_cld_lev'/),'A','kg/kg','qr in TAU', sampled_on_subcycle=.true.) + call addfld('NR_TAU_in',(/'trop_cld_lev'/),'A','1/kg','nr in TAU', sampled_on_subcycle=.true.) + call addfld('QC_TAU_out',(/'trop_cld_lev'/),'A','kg/kg','qc out TAU', sampled_on_subcycle=.true.) + call addfld('NC_TAU_out',(/'trop_cld_lev'/),'A','1/kg','nc out TAU', sampled_on_subcycle=.true.) + call addfld('QR_TAU_out',(/'trop_cld_lev'/),'A','kg/kg','qr out TAU', sampled_on_subcycle=.true.) + call addfld('NR_TAU_out',(/'trop_cld_lev'/),'A','1/kg','nr out TAU', sampled_on_subcycle=.true.) + + call addfld('qctend_TAU',(/'trop_cld_lev'/),'A','kg/kg/s','qc tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('nctend_TAU',(/'trop_cld_lev'/),'A','1/kg/s','nc tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('qrtend_TAU',(/'trop_cld_lev'/),'A','kg/kg/s','qr tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('nrtend_TAU',(/'trop_cld_lev'/),'A','1/kg/s','nr tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('qctend_TAU_diag',(/'trop_cld_lev'/),'A','kg/kg/s','qc tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('nctend_TAU_diag',(/'trop_cld_lev'/),'A','1/kg/s','nc tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('qrtend_TAU_diag',(/'trop_cld_lev'/),'A','kg/kg/s','qr tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('nrtend_TAU_diag',(/'trop_cld_lev'/),'A','1/kg/s','nr tendency due to TAU bin code', sampled_on_subcycle=.true.) + + call addfld('gmnnn_lmnnn_TAU',(/'trop_cld_lev'/),'A','1','sum of mass gain and loss from bin code', sampled_on_subcycle=.true.) + call addfld('ML_fixer',(/'trop_cld_lev'/),'A','1','frequency that ML fixer is activated', sampled_on_subcycle=.true.) + call addfld('qc_fixer',(/'trop_cld_lev'/),'A','kg/kg','delta qc due to ML fixer', sampled_on_subcycle=.true.) + call addfld('nc_fixer',(/'trop_cld_lev'/),'A','kg/kg','delta nc due to ML fixer', sampled_on_subcycle=.true.) + call addfld('qr_fixer',(/'trop_cld_lev'/),'A','kg/kg','delta qr due to ML fixer', sampled_on_subcycle=.true.) + call addfld('nr_fixer',(/'trop_cld_lev'/),'A','kg/kg','delta nr due to ML fixer', sampled_on_subcycle=.true.) + + stochastic_emulated_filename_quantile_out = stochastic_emulated_filename_quantile + stochastic_emulated_filename_input_scale_out = stochastic_emulated_filename_input_scale + stochastic_emulated_filename_output_scale_out = stochastic_emulated_filename_output_scale + +end subroutine stochastic_emulated_init_cam +end module stochastic_emulated_cam + + diff --git a/src/physics/cam7/stochastic_tau_cam.F90 b/src/physics/cam7/stochastic_tau_cam.F90 new file mode 100644 index 0000000000..0cea0201a0 --- /dev/null +++ b/src/physics/cam7/stochastic_tau_cam.F90 @@ -0,0 +1,117 @@ +module stochastic_tau_cam +! From Morrison (Lebo, originally TAU bin code) +! Gettelman and Chen 2018 +!the subroutines take in air density, air temperature, and the bin mass boundaries, and +!output the mass and number mixing ratio tendencies in each bin directly. +!this is then wrapped for CAM. + +use shr_kind_mod, only: cl=>shr_kind_cl +use cam_history, only: addfld +use cam_logfile, only: iulog + +implicit none +private +save + +! Subroutines +public :: stochastic_tau_init_cam, stochastic_tau_readnl + +!Module variables + +integer, parameter, public :: ncd = 35 +character(len=cl) :: pumas_stochastic_tau_kernel_filename ! Full filepath/filename for tau kernel file + +!=============================================================================== +contains +!=============================================================================== +subroutine stochastic_tau_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_character, masterproc + use cam_abortutils, only: endrun + use string_utils, only: int2str + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + integer :: unitn, ierr + character(len=*), parameter :: sub = 'stochastic_tau_readnl' + + namelist /pumas_stochastic_tau_nl/ pumas_stochastic_tau_kernel_filename + + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'pumas_stochastic_tau_nl', status=ierr) + if (ierr == 0) then + read(unitn, pumas_stochastic_tau_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(sub // ':: ERROR reading namelist, iostat = ' // int2str(ierr)) + end if + end if + close(unitn) + call freeunit(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(pumas_stochastic_tau_kernel_filename, cl, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: pumas_stochastic_tau_kernel_filename") + + write(iulog,*) 'PUMAS stochastic_tau_readnl, pumas_stochastic_tau_kernel_filename=',pumas_stochastic_tau_kernel_filename + +end subroutine stochastic_tau_readnl + +subroutine stochastic_tau_init_cam + + use cam_history_support, only: add_hist_coord + use pumas_stochastic_collect_tau, only: pumas_stochastic_kernel_init + + + call pumas_stochastic_kernel_init(pumas_stochastic_tau_kernel_filename) + + call add_hist_coord('bins_ncd', ncd, 'bins for TAU microphysics') + + !Note: lev needs to be trop_cld_lev for proc_rates.... + call addfld('amk_c',(/'trop_cld_lev','bins_ncd '/),'A','kg','cloud liquid mass from bins', sampled_on_subcycle=.true.) + call addfld('ank_c',(/'trop_cld_lev','bins_ncd '/),'A','1/kg','cloud liquid number concentration from bins', sampled_on_subcycle=.true.) + call addfld('amk_r',(/'trop_cld_lev','bins_ncd '/),'A','kg','rain mass from bins', sampled_on_subcycle=.true.) + call addfld('ank_r',(/'trop_cld_lev','bins_ncd '/),'A','1/kg','rain number concentration from bins', sampled_on_subcycle=.true.) + call addfld('amk',(/'trop_cld_lev','bins_ncd '/),'A','kg','all liquid mass from bins', sampled_on_subcycle=.true.) + call addfld('ank',(/'trop_cld_lev','bins_ncd '/),'A','1/kg','all liquid number concentration from bins', sampled_on_subcycle=.true.) + call addfld('amk_out',(/'trop_cld_lev','bins_ncd '/),'A','kg','all liquid mass from bins', sampled_on_subcycle=.true.) + call addfld('ank_out',(/'trop_cld_lev','bins_ncd '/),'A','1/kg','all liquid number concentration from bins', sampled_on_subcycle=.true.) + + call addfld('scale_nc',(/'trop_cld_lev'/),'A','1','scaling factor for nc', sampled_on_subcycle=.true.) + call addfld('scale_nr',(/'trop_cld_lev'/),'A','1','scaling factor for nr', sampled_on_subcycle=.true.) + call addfld('scale_qc',(/'trop_cld_lev'/),'A','1','scaling factor for qc', sampled_on_subcycle=.true.) + call addfld('scale_qr',(/'trop_cld_lev'/),'A','1','scaling factor for qr', sampled_on_subcycle=.true.) + + call addfld('QC_TAU_in',(/'trop_cld_lev'/),'A','kg/kg','qc in TAU', sampled_on_subcycle=.true.) + call addfld('NC_TAU_in',(/'trop_cld_lev'/),'A','1/kg','nc in TAU', sampled_on_subcycle=.true.) + call addfld('QR_TAU_in',(/'trop_cld_lev'/),'A','kg/kg','qr in TAU', sampled_on_subcycle=.true.) + call addfld('NR_TAU_in',(/'trop_cld_lev'/),'A','1/kg','nr in TAU', sampled_on_subcycle=.true.) + call addfld('QC_TAU_out',(/'trop_cld_lev'/),'A','kg/kg','qc out TAU', sampled_on_subcycle=.true.) + call addfld('NC_TAU_out',(/'trop_cld_lev'/),'A','1/kg','nc out TAU', sampled_on_subcycle=.true.) + call addfld('QR_TAU_out',(/'trop_cld_lev'/),'A','kg/kg','qr out TAU', sampled_on_subcycle=.true.) + call addfld('NR_TAU_out',(/'trop_cld_lev'/),'A','1/kg','nr out TAU', sampled_on_subcycle=.true.) + + call addfld('qctend_TAU',(/'trop_cld_lev'/),'A','kg/kg/s','qc tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('nctend_TAU',(/'trop_cld_lev'/),'A','1/kg/s','nc tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('qrtend_TAU',(/'trop_cld_lev'/),'A','kg/kg/s','qr tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('nrtend_TAU',(/'trop_cld_lev'/),'A','1/kg/s','nr tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('qctend_TAU_diag',(/'trop_cld_lev'/),'A','kg/kg/s','qc tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('nctend_TAU_diag',(/'trop_cld_lev'/),'A','1/kg/s','nc tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('qrtend_TAU_diag',(/'trop_cld_lev'/),'A','kg/kg/s','qr tendency due to TAU bin code', sampled_on_subcycle=.true.) + call addfld('nrtend_TAU_diag',(/'trop_cld_lev'/),'A','1/kg/s','nr tendency due to TAU bin code', sampled_on_subcycle=.true.) + + call addfld('gmnnn_lmnnn_TAU',(/'trop_cld_lev'/),'A','1','sum of mass gain and loss from bin code', sampled_on_subcycle=.true.) + call addfld('ML_fixer',(/'trop_cld_lev'/),'A','1','frequency that ML fixer is activated', sampled_on_subcycle=.true.) + call addfld('qc_fixer',(/'trop_cld_lev'/),'A','kg/kg','delta qc due to ML fixer', sampled_on_subcycle=.true.) + call addfld('nc_fixer',(/'trop_cld_lev'/),'A','kg/kg','delta nc due to ML fixer', sampled_on_subcycle=.true.) + call addfld('qr_fixer',(/'trop_cld_lev'/),'A','kg/kg','delta qr due to ML fixer', sampled_on_subcycle=.true.) + call addfld('nr_fixer',(/'trop_cld_lev'/),'A','kg/kg','delta nr due to ML fixer', sampled_on_subcycle=.true.) + +end subroutine stochastic_tau_init_cam +end module stochastic_tau_cam + + diff --git a/src/physics/camrt/radconstants.F90 b/src/physics/camrt/radconstants.F90 index 89503fd0f5..f9faf308f1 100644 --- a/src/physics/camrt/radconstants.F90 +++ b/src/physics/camrt/radconstants.F90 @@ -1,7 +1,7 @@ module radconstants ! This module contains constants that are specific to the radiative transfer -! code used in the CAM3 model. +! code used in the CAM4 model. use shr_kind_mod, only: r8 => shr_kind_r8 use cam_abortutils, only: endrun @@ -21,9 +21,6 @@ module radconstants public :: radconstants_init public :: rad_gas_index -! optics files specify a type. What length is it? -integer, parameter, public :: ot_length = 32 - ! SHORTWAVE DATA ! number of shorwave spectral intervals @@ -40,20 +37,6 @@ module radconstants integer, parameter, public :: idx_lw_diag = 2 ! index to (H20 window) LW band - -! Number of evenly spaced intervals in rh -! The globality of this mesh may not be necessary -! Perhaps it could be specific to the aerosol -! But it is difficult to see how refined it must be -! for lookup. This value was found to be sufficient -! for Sulfate and probably necessary to resolve the -! high variation near rh = 1. Alternative methods -! were found to be too slow. -! Optimal approach would be for cam to specify size of aerosol -! based on each aerosol's characteristics. Radiation -! should know nothing about hygroscopic growth! -integer, parameter, public :: nrh = 1000 - ! LONGWAVE DATA ! number of lw bands diff --git a/src/physics/camrt/radiation.F90 b/src/physics/camrt/radiation.F90 index 7b9a5ce04b..d7e0cdbac6 100644 --- a/src/physics/camrt/radiation.F90 +++ b/src/physics/camrt/radiation.F90 @@ -36,7 +36,7 @@ module radiation pio_seterrorhandling, pio_bcast_error, & pio_inq_varid, & pio_def_var, pio_def_dim, & - pio_put_var, pio_get_var + pio_put_var, pio_get_var, pio_put_att use cam_abortutils, only: endrun use error_messages, only: handle_err @@ -59,6 +59,8 @@ module radiation radiation_tend, &! compute heating rates and fluxes rad_out_t ! type for diagnostic outputs +real(r8), public, protected :: nextsw_cday ! future radiation calday for surface models + type rad_out_t real(r8) :: solin(pcols) ! Solar incident flux real(r8) :: fsntoa(pcols) ! Net solar flux at TOA @@ -142,6 +144,7 @@ module radiation type(var_desc_t), allocatable :: abstot_desc(:) type(var_desc_t) :: emstot_desc, absnxt_desc(4) +type(var_desc_t) :: nextsw_cday_desc logical :: use_rad_uniform_angle = .false. ! if true, use the namelist rad_uniform_angle for the zenith calculation real(r8) :: rad_uniform_angle = -99._r8 @@ -318,8 +321,9 @@ real(r8) function radiation_nextsw_cday() integer :: nstep ! timestep counter logical :: dosw ! true => do shosrtwave calc integer :: offset ! offset for calendar day calculation - integer :: dTime ! integer timestep size + integer :: dtime ! integer timestep size real(r8):: calday ! calendar day of + real(r8):: caldayp1 ! calendar day of next time-step !----------------------------------------------------------------------- radiation_nextsw_cday = -1._r8 @@ -338,6 +342,12 @@ real(r8) function radiation_nextsw_cday() if(radiation_nextsw_cday == -1._r8) then call endrun('error in radiation_nextsw_cday') end if + + ! determine if next radiation time-step not equal to next time-step + if (get_nstep() >= 1) then + caldayp1 = get_curr_calday(offset=int(dtime)) + if (caldayp1 /= radiation_nextsw_cday) radiation_nextsw_cday = -1._r8 + end if end function radiation_nextsw_cday @@ -394,6 +404,11 @@ subroutine radiation_init(pbuf2d) dt_avg = real(iradsw*dtime, r8) end if + ! Surface components to get radiation computed today + if (.not. is_first_restart_step()) then + nextsw_cday = get_curr_calday() + end if + ! Get physics buffer indices cld_idx = pbuf_get_index('CLD') rel_idx = pbuf_get_index('REL') @@ -567,6 +582,9 @@ subroutine radiation_define_restart(file) call pio_seterrorhandling(File, PIO_BCAST_ERROR) + ierr = pio_def_var(File, 'nextsw_cday', pio_double, nextsw_cday_desc) + ierr = pio_put_att(File, nextsw_cday_desc, 'long_name', 'future radiation calday for surface models') + if (radiation_do('aeres')) then grid_id = cam_grid_id('physgrid') @@ -625,6 +643,8 @@ subroutine radiation_write_restart(file) integer :: ncol !---------------------------------------------------------------------------- + ierr = pio_put_var(File, nextsw_cday_desc, (/ nextsw_cday /)) + if ( radiation_do('aeres') ) then physgrid = cam_grid_id('physgrid') @@ -689,6 +709,7 @@ subroutine radiation_read_restart(file) integer :: dims(3), gdims(3), nhdims integer :: vsize integer :: i + real(r8) :: temp_var type(var_desc_t) :: vardesc character(len=16) :: pname @@ -740,6 +761,10 @@ subroutine radiation_read_restart(file) end do end if + ierr = pio_inq_varid(File, 'nextsw_cday', vardesc) + ierr = pio_get_var(File, vardesc, temp_var) + nextsw_cday = temp_var + end subroutine radiation_read_restart !=============================================================================== @@ -768,7 +793,7 @@ subroutine radiation_tend( & use interpolate_data, only: vertinterp use radiation_data, only: rad_data_write use cloud_cover_diags, only: cloud_cover_diags_out - use tropopause, only: tropopause_find, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE + use tropopause, only: tropopause_find_cam, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE use orbit, only: zenith ! Arguments @@ -827,7 +852,7 @@ subroutine radiation_tend( & ! This is used by the chemistry. real(r8), pointer :: fsds(:) ! Surface solar down flux - ! This is used for the energy checker and the Eulerian dycore. + ! This is used for the energy checker. real(r8), pointer :: fsns(:) ! Surface solar absorbed flux real(r8), pointer :: fsnt(:) ! Net column abs solar flux at model top real(r8), pointer :: flns(:) ! Srf longwave cooling (up-down) flux @@ -852,7 +877,7 @@ subroutine radiation_tend( & ! Aerosol shortwave radiative properties real(r8) :: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau - real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau + real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * w * tau real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau ! Aerosol longwave absorption optical depth @@ -937,6 +962,10 @@ subroutine radiation_tend( & doabsems = radiation_do('absems') ! do absorptivity/emissivity calc this timestep? + ! Get time of next radiation calculation - albedos will need to be + ! calculated by each surface model at this time + nextsw_cday = radiation_nextsw_cday() + if (dosw .or. dolw) then ! pbuf cloud properties set in cloud_diagnostics @@ -972,7 +1001,7 @@ subroutine radiation_tend( & ! Solar radiation computation if (hist_fld_active('FSNR') .or. hist_fld_active('FLNR')) then - call tropopause_find(state, troplev, tropP=p_trop, primary=TROP_ALG_HYBSTOB, backup=TROP_ALG_CLIMATE) + call tropopause_find_cam(state, troplev, tropP=p_trop, primary=TROP_ALG_HYBSTOB, backup=TROP_ALG_CLIMATE) endif if (dosw) then diff --git a/src/physics/camrt/radlw.F90 b/src/physics/camrt/radlw.F90 index 62ec514ffc..befd69fbc9 100644 --- a/src/physics/camrt/radlw.F90 +++ b/src/physics/camrt/radlw.F90 @@ -435,11 +435,7 @@ subroutine radclwmx(lchnk ,ncol ,doabsems , & ntopcld = max(ntopcld, trop_cloud_top_lev) cldp(:ncol,1:ntopcld) = 0.0_r8 - if ( cam_physpkg_is('cam3')) then - cldp(:ncol,ntoplw:pver) = cld(:ncol,ntoplw:pver) - else - cldp(:ncol,ntopcld+1:pver) = cld(:ncol,ntopcld+1:pver) - end if + cldp(:ncol,ntopcld+1:pver) = cld(:ncol,ntopcld+1:pver) cldp(:ncol,pverp) = 0.0_r8 ! ! diff --git a/src/physics/camrt/radsw.F90 b/src/physics/camrt/radsw.F90 index e0d609a4cc..58138e4a5f 100644 --- a/src/physics/camrt/radsw.F90 +++ b/src/physics/camrt/radsw.F90 @@ -237,7 +237,7 @@ subroutine radcswmx(lchnk ,ncol , & ! real(r8),intent(in) :: E_aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth real(r8),intent(in) :: E_aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau - real(r8),intent(in) :: E_aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau + real(r8),intent(in) :: E_aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * w * tau real(r8),intent(in) :: E_aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau ! @@ -288,7 +288,7 @@ subroutine radcswmx(lchnk ,ncol , & ! real(r8):: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth real(r8):: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau - real(r8):: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau + real(r8):: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * w * tau real(r8):: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau real(r8) :: pmid(pcols,pver) ! Level pressure real(r8) :: pint(pcols,pverp) ! Interface pressure @@ -1994,7 +1994,7 @@ subroutine raddedmx(coszrs ,ndayc ,abh2o , & ! real(r8) trmin ! Minimum total transmission allowed real(r8) wray ! Rayleigh single scatter albedo - real(r8) gray ! Rayleigh asymetry parameter + real(r8) gray ! Rayleigh asymmetry parameter real(r8) fray ! Rayleigh forward scattered fraction parameter (trmin = 1.e-3_r8) diff --git a/src/physics/carma/base b/src/physics/carma/base new file mode 160000 index 0000000000..67418505b4 --- /dev/null +++ b/src/physics/carma/base @@ -0,0 +1 @@ +Subproject commit 67418505b48787bd305a50ffb581f98f0b466cba diff --git a/src/physics/carma/cam/carma_constants_mod.F90 b/src/physics/carma/cam/carma_constants_mod.F90 index 27c8055095..c29820d382 100644 --- a/src/physics/carma/cam/carma_constants_mod.F90 +++ b/src/physics/carma/cam/carma_constants_mod.F90 @@ -18,82 +18,82 @@ module carma_constants_mod !-- ! Physical constants - + ! Meter-Kilogram-Second (MKS) convention for units - ! This convention is different from CARMA's original + ! This convention is different from CARMA's original ! Centimeter-Gram-Second (CGS) convention. Be wary of ! this conversion to the new convention. - + ! Use the _f for all literal constants, e.g. 1.2e_f. ! If you omit the _f in the initialization, a compiler may cast this ! number into single precision and then store it as _f precision. - + !! Define triple-point temperature (K) real(kind=f), parameter :: T0 = SHR_CONST_TKTRIP - - ! Define constants for circles and trig - real(kind=f), parameter :: PI = p_pi + + ! Define constants for circles and trig + real(kind=f), parameter :: PI = p_pi real(kind=f), parameter :: DEG2RAD = PI / 180._f real(kind=f), parameter :: RAD2DEG = 180._f / PI - + !! Define avogadro's number [ # particles / mole ] real(kind=f), parameter :: AVG = avogad / 1000._f - + !! Define Boltzmann's constant [ erg / deg_K ] real(kind=f), parameter :: BK = boltz * 1e7_f - + !! Define Loschmidt's number [ mole / cm^3, @ STP ] real(kind=f), parameter :: ALOS = 2.68719e+19_f - + !! Define reference pressure, e.g. for potential temp calcs [ dyne / cm^2 ] real(kind=f), parameter :: PREF = 1000.e+3_f - + !! Define conversion factor for mb to cgs [ dyne / cm^2 ] units real(kind=f), parameter :: RMB2CGS = 1000.e+0_f - + !! Define conversion factor for Pa to cgs [ dyne / cm^2 ] units real(kind=f), parameter :: RPA2CGS = 10.e+0_f !! Define conversion factor for m to cgs [ cm ] units real(kind=f), parameter :: RM2CGS = 100.0_f - + !! Define universal gas constant [ erg / deg_K / mole ] real(kind=f), parameter :: RGAS = r_universal * 1e7_f / 1000._f - + !! Define number of seconds per the planet's day [ s / d ] real(kind=f), parameter :: SCDAY = SHR_CONST_CDAY - + !! Define mass density of liquid water [ g / cm^3 ] real(kind=f), parameter :: RHO_W = rhoh2o / 1000._f - + !! Define mass density of water ice [ g / cm^3 ] real(kind=f), parameter :: RHO_I = SHR_CONST_RHOICE / 1000._f !! Latent heat of evaporation for gas [cm^2/s^2] real(kind=f), parameter :: RLHE_CNST = latvap * 1e4_f - + !! Latent heat of ice melting for gas [cm^2/s^2] real(kind=f), parameter :: RLHM_CNST = latice * 1e4_f - - + + !! The dimension of THETD, ELTRMX, CSTHT, PI, TAU, SI2THT. !! IT must correspond exactly to the second dimension of ELTRMX. integer, parameter :: IT = 1 - - !! String length of names + + !! String length of names integer, parameter :: CARMA_NAME_LEN = 255 - !! String length of short names + !! String length of short names integer, parameter :: CARMA_SHORT_NAME_LEN = 6 - + !! Fill value indicating no value is being returned real(kind=f), parameter :: CAM_FILL = fillvalue - + !! Define particle number concentration [ # / cm3 ] !! used to decide whether to bypass microphysical processes. real(kind=f), parameter :: FEW_PC = 1e-6_f - + !! Define small particle number concentration !! [ # / x_units / y_units / z_units ] !! @@ -104,49 +104,47 @@ module carma_constants_mod !! !! For degree/degree/hybrid coordinates, the metric is on the !! order of 1e20. -! real(kind=f), parameter :: SMALL_PC = 1e-50_f - real(kind=f), parameter :: SMALL_PC = FEW_PC * 1e20 * 1e-30 - + real(kind=f), parameter :: SMALL_PC = FEW_PC * 1.e-30_f + !! Define core fraction (for core mass and second moment) used !! when particle number concentrations are limited to SMALL_PC real(kind=f), parameter :: FIX_COREF = 0.1_f - - !! Minimum Cloud Fraction + + !! Minimum Cloud Fraction real(kind=f), parameter :: CLDFRC_MIN = 0.009_f - + !! Incloud Cloud Fraction Threshold for statistics real(kind=f), parameter :: CLDFRC_INCLOUD = 0.01_f - + !! NWAVE should be the total number of bands CAM supports. integer, public, parameter :: NWAVE = nlwbands+nswbands ! Number of wavelength bands + !! The maximum number of diagnostic values that can be returned by + !! CARMA_CalculateCloudborneDiagnostics + integer, public, parameter :: MAXCLDAERDIAG = 16 - - - !! These are constants per CARMA's definition, but are set dynamically in CAM and thus !! can not be set as constants. They must be initialized as variables in carma_init. - + !! Acceleration of gravity near Earth surface [ cm/s^2 ] real(kind=f) :: GRAV - + !! Define planet equatorial radius [ cm ] real(kind=f) :: REARTH - + !! Define molecular weight of dry air [ g / mole ] real(kind=f) :: WTMOL_AIR - + !! Define molecular weight of water [ g / mole ] real(kind=f) :: WTMOL_H2O - + !! Define gas constant for dry air [ erg / deg_K / mole ] real(kind=f) :: R_AIR - + !! Define specific heat at constant pres of dry air [ cm^2 / s^2 / deg_K ] real(kind=f) :: CP !! Define ratio of gas constant for dry air and specific heat real(kind=f) :: RKAPPA - -end module +end module carma_constants_mod diff --git a/src/physics/carma/cam/carma_intr.F90 b/src/physics/carma/cam/carma_intr.F90 index 50bad3dffa..89f7f415d6 100644 --- a/src/physics/carma/cam/carma_intr.F90 +++ b/src/physics/carma/cam/carma_intr.F90 @@ -9,47 +9,53 @@ !! @version July 2009 module carma_intr - use carma_precision_mod - use carma_enums_mod - use carma_constants_mod - use carma_types_mod - use carma_flags_mod - use carma_model_mod - use carmaelement_mod - use carmagas_mod - use carmagroup_mod - use carmasolute_mod - use carmastate_mod - use carma_mod - + use carma_precision_mod, only: f + use carma_enums_mod, only: I_OPTICS_FIXED, I_OPTICS_MIXED_CORESHELL, I_OPTICS_MIXED_VOLUME, & + I_OPTICS_MIXED_MAXWELL, I_OPTICS_SULFATE, I_CNSTTYPE_PROGNOSTIC, I_HYBRID + use carma_constants_mod, only : GRAV, REARTH, WTMOL_AIR, WTMOL_H2O, R_AIR, CP, RKAPPA, NWAVE, & + CARMA_NAME_LEN, CARMA_SHORT_NAME_LEN, PI, CAM_FILL, RGAS, RM2CGS, RAD2DEG, CLDFRC_INCLOUD + use carma_types_mod, only : carma_type, carmastate_type + use carma_flags_mod, only : carma_flag, carma_do_fixedinit, carma_model, carma_do_wetdep, carma_do_emission, & + carma_do_pheat, carma_do_substep, carma_do_thermo, carma_do_cldice, carma_diags_file, & + carma_do_grow, carma_ndebugpkgs, carma_conmax, carma_cstick, carma_tstick, carma_vf_const, carma_sulfnuc_method, & + carma_rhcrit, carma_rad_feedback, carma_minsubsteps, carma_maxsubsteps, carma_gstickl, carma_gsticki, & + carma_maxretries, carma_dt_threshold, carma_ds_threshold, carma_do_vtran, carma_do_vdiff, carma_do_pheatatm, & + carma_do_partialinit, carma_do_optics, carma_do_incloud, carma_do_explised, carma_do_drydep, carma_do_detrain, & + carma_do_coremasscheck, carma_do_coag, carma_do_clearsky, carma_do_cldliq, carma_do_aerosol, carma_dgc_threshold + + use carma_model_mod, only : NGAS, NBIN, NELEM, NGROUP, NMIE_WTP, NREFIDX, MIE_RH, NMIE_RH, NSOLUTE + use carma_model_mod, only : mie_rh, mie_wtp, is_convtran1, CARMAMODEL_DiagnoseBulk, CARMAMODEL_DiagnoseBins, & + CARMAMODEL_Detrain, CARMAMODEL_OutputDiagnostics, CARMAMODEL_CreateOpticsFile, CARMAMODEL_WetDeposition, & + CARMAMODEL_EmitParticle, CARMAMODEL_InitializeParticle, CARMAMODEL_DefineModel, CARMAMODEL_InitializeModel + use carmaelement_mod, only : CARMAELEMENT_Get + use carmagas_mod, only : CARMAGAS_Get + use carmagroup_mod, only : CARMAGROUP_Get + use carmastate_mod, only : CARMASTATE_CreateFromReference, CARMASTATE_SetGas, CARMASTATE_Step, CARMASTATE_GetBin, & + CARMASTATE_GetGas, CARMASTATE_GetState, CARMASTATE_Get, CARMASTATE_Create, CARMASTATE_SetBin, CARMASTATE_Destroy + use carma_mod, only : CARMA_Get, CARMA_Create, CARMA_Initialize, CARMA_Destroy + use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: masterproc - use pmgrid, only: plat, plev, plevp, plon + use spmd_utils, only: masterproc, mpicom use ppgrid, only: pcols, pver, pverp use ref_pres, only: pref_mid, pref_edge, pref_mid_norm, psurf_ref use physics_types, only: physics_state, physics_ptend, physics_ptend_init, & set_dry_to_wet, physics_state_copy - use phys_grid, only: get_lat_all_p - use physconst, only: avogad, cpair + use physconst, only: cpair use constituents, only: pcnst, cnst_add, cnst_get_ind, & - cnst_name, cnst_longname, cnst_type - use chem_surfvals, only: chem_surfvals_get + cnst_name, cnst_longname use cam_abortutils, only: endrun use physics_buffer, only: physics_buffer_desc, pbuf_add_field, pbuf_old_tim_idx, & - pbuf_get_index, pbuf_get_field, dtype_r8 - + pbuf_get_index, pbuf_get_field, dtype_r8, pbuf_set_field + use pio, only: var_desc_t + use radconstants, only: nlwbands, nswbands -#if ( defined SPMD ) - use mpishorthand -#endif - implicit none - + private save ! Public interfaces - + ! CAM Physics Interface public carma_register ! register consituents public carma_is_active ! retrns true if this package is active (microphysics = .true.) @@ -60,18 +66,21 @@ module carma_intr public carma_timestep_init ! initialize timestep dependent variables public carma_timestep_tend ! interface to tendency computation public carma_accumulate_stats ! collect stats from all MPI tasks - + + ! Other Microphysics public carma_emission_tend ! calculate tendency from emission source function public carma_wetdep_tend ! calculate tendency from wet deposition - + public :: carma_restart_init + public :: carma_restart_write + public :: carma_restart_read ! Private data - + ! Particle Group Statistics - + ! Gridbox average - integer, parameter :: NGPDIAGS = 12 ! Number of particle diagnostics ... + integer, parameter :: NGPDIAGS = 13 ! Number of particle diagnostics ... integer, parameter :: GPDIAGS_ND = 1 ! Number density integer, parameter :: GPDIAGS_AD = 2 ! Surface area density integer, parameter :: GPDIAGS_MD = 3 ! Mass density @@ -84,17 +93,22 @@ module carma_intr integer, parameter :: GPDIAGS_VM = 10 ! Mass Weighted Fall Velocity integer, parameter :: GPDIAGS_PA = 11 ! Projected Area integer, parameter :: GPDIAGS_AR = 12 ! Area Ratio + integer, parameter :: GPDIAGS_VR = 13 ! Volatile Mixing Ratio ! Particle Bin (Element) Statistics - integer, parameter :: NBNDIAGS = 1 ! Number of bin surface diagnostics ... + integer, parameter :: NBNDIAGS = 5 ! Number of bin surface diagnostics ... integer, parameter :: BNDIAGS_TP = 1 ! Delta Particle Temperature [K] - + integer, parameter :: BNDIAGS_WETR = 2 ! wet radius + integer, parameter :: BNDIAGS_ND = 3 ! Number density + integer, parameter :: BNDIAGS_RO = 4 ! particle density + integer, parameter :: BNDIAGS_VR = 5 ! Volatile Mixing Ratio + ! Surface integer, parameter :: NSBDIAGS = 2 ! Number of bin surface diagnostics ... integer, parameter :: SBDIAGS_DD = 1 ! Dry deposition flux [kg/m2/s] integer, parameter :: SBDIAGS_VD = 2 ! Dry deposition velocity [cm/s] - - + + ! Gas Statistics integer, parameter :: NGSDIAGS = 5 ! Number of gas diagnostics ... integer, parameter :: GSDIAGS_SI = 1 ! saturation wrt ice @@ -102,27 +116,27 @@ module carma_intr integer, parameter :: GSDIAGS_EI = 3 ! equilibrium vp wrt ice integer, parameter :: GSDIAGS_EL = 4 ! equilibrium vp wrt water integer, parameter :: GSDIAGS_WT = 5 ! weight percent composition for aerosols - + ! Step Statistics integer, parameter :: NSPDIAGS = 2 ! Number of step diagnostics ... integer, parameter :: SPDIAGS_NSTEP = 1 ! number of substeps integer, parameter :: SPDIAGS_LNSTEP = 2 ! ln(number of substeps) - + ! Defaults not in the namelist character(len=10), parameter :: carma_mixtype = 'wet' ! mixing ratio type for CARMA constituents integer :: LUNOPRT = -1 ! lun for output - - ! Constituent Mappings + + ! Constituent Mappings integer :: icnst4elem(NELEM, NBIN) ! constituent index for a carma element integer :: icnst4gas(NGAS) ! constituent index for a carma gas character(len=16) :: btndname(NGROUP, NBIN) ! names of group per bin tendencies character(len=16) :: etndname(NELEM, NBIN) ! names of element tendencies character(len=16) :: gtndname(NGAS) ! names of gas tendencies - + ! Flags to indicate whether each constituent could have a CARMA tendency. logical :: lq_carma(pcnst) - + ! The CARMA object stores the configuration inforamtion about CARMA, only one is ! is needed per MPI task. In the future, this could potentially be turned into one ! per model to allow multiple models with different numbers of bins, ... to be @@ -133,17 +147,20 @@ module carma_intr type(carma_type), target :: carma ! the carma object - ! Physics Buffer Indicies - integer :: ipbuf4gas(NGAS) ! physics buffer index for a carma gas - integer :: ipbuf4t ! physics buffer index for a carma temperature - integer :: ipbuf4sati(NGAS) ! physics buffer index for a carma saturation over ice - integer :: ipbuf4satl(NGAS) ! physics buffer index for a carma saturation over liquid - + ! Physics Buffer Indicies + integer :: ipbuf4gas(NGAS)=-1 ! physics buffer index for a carma gas + integer :: ipbuf4t=-1 ! physics buffer index for a carma temperature + integer :: ipbuf4sati(NGAS)=-1 ! physics buffer index for a carma saturation over ice + integer :: ipbuf4satl(NGAS)=-1 ! physics buffer index for a carma saturation over liquid + ! Globals used for a reference atmosphere. - real(kind=f) :: carma_t_ref(pver) ! midpoint temperature (Pa) - real(kind=f) :: carma_h2o_ref(pver) ! h2o mmmr (kg/kg) - real(kind=f) :: carma_h2so4_ref(pver) ! h2so4 mmr (kg/kg) + real(kind=f) :: carma_t_ref(pver) = -huge(1._f) ! midpoint temperature (Pa) + real(kind=f) :: carma_h2o_ref(pver) = -huge(1._f) ! h2o mmmr (kg/kg) + real(kind=f) :: carma_h2so4_ref(pver) = -huge(1._f) ! h2so4 mmr (kg/kg) + type(var_desc_t) :: t_ref_desc + type(var_desc_t) :: h2o_ref_desc + type(var_desc_t) :: h2so4_ref_desc ! Globals used for total statistics real(kind=f) :: glob_max_nsubstep = 0._f @@ -158,7 +175,6 @@ module carma_intr real(kind=f) :: step_nsubstep = 0._f real(kind=f) :: step_nretry = 0._f - contains @@ -177,8 +193,7 @@ module carma_intr !! @author Chuck Bardeen !! @version May-2009 subroutine carma_register - use radconstants, only : nswbands, nlwbands, & - get_sw_spectral_boundaries, get_lw_spectral_boundaries + use radconstants, only : get_sw_spectral_boundaries, get_lw_spectral_boundaries use cam_logfile, only : iulog use cam_control_mod, only : initial_run use physconst, only: gravit, p_rearth=>rearth, mwdry, mwh2o @@ -209,13 +224,13 @@ subroutine carma_register ! Initialize the return code. rc = 0 - + ! Some constants are set on the fly in CAM, so initialize them and any derived "constants" here. ! Some of them are needed in CARMA_DefineModel and CARMA_Initialize. GRAV = gravit * RM2CGS - REARTH = p_rearth * RM2CGS - WTMOL_AIR = mwdry - WTMOL_H2O = mwh2o + REARTH = p_rearth * RM2CGS + WTMOL_AIR = mwdry + WTMOL_H2O = mwh2o R_AIR = RGAS / WTMOL_AIR CP = cpair * 1.e7_r8 / 1000._r8 RKAPPA = R_AIR / CP @@ -225,7 +240,7 @@ subroutine carma_register ! Find out which radiation scheme is active. call phys_getopts(radiation_scheme_out = radiation_scheme) - + ! Get the wavelength centers for the CAM longwave and shortwave bands ! from the radiation code. @@ -251,19 +266,19 @@ subroutine carma_register ! Create the CARMA object that will contain all the information about the ! how CARMA is configured. - call CARMA_Create(carma, NBIN, NELEM, NGROUP, NSOLUTE, NGAS, NWAVE, rc, & - LUNOPRT=LUNOPRT, wave=wave, dwave=dwave, do_wave_emit=do_wave_emit) + LUNOPRT=LUNOPRT, wave=wave, dwave=dwave, do_wave_emit=do_wave_emit, NREFIDX=NREFIDX) if (rc < 0) call endrun('carma_register::CARMA_Create failed.') - + ! Define the microphysical model. - call CARMA_DefineModel(carma, rc) + call CARMAMODEL_DefineModel(carma, rc) if (rc < 0) call endrun('carma_register::CARMA_DefineModel failed.') - + if (masterproc) then write(LUNOPRT,*) '' write(LUNOPRT,*) 'CARMA general settings for ', trim(carma_model), ' model : ' write(LUNOPRT,*) ' carma_do_aerosol = ', carma_do_aerosol + write(LUNOPRT,*) ' carma_do_coremasscheck = ',carma_do_coremasscheck write(LUNOPRT,*) ' carma_do_cldice = ', carma_do_cldice write(LUNOPRT,*) ' carma_do_cldliq = ', carma_do_cldliq write(LUNOPRT,*) ' carma_do_clearsky = ', carma_do_clearsky @@ -297,11 +312,11 @@ subroutine carma_register write(LUNOPRT,*) ' carma_maxretries = ', carma_maxretries write(LUNOPRT,*) ' carma_vf_const = ', carma_vf_const write(LUNOPRT,*) ' cldfrc_incloud = ', CLDFRC_INCLOUD - write(LUNOPRT,*) ' carma_reftfile = ', trim(carma_reftfile) write(LUNOPRT,*) ' carma_rad_feedback = ', carma_rad_feedback + write(LUNOPRT,*) ' carma_sulfnuc_method = ', carma_sulfnuc_method write(LUNOPRT,*) '' endif - + ! Intialize the model based upon the namelist configuration. ! ! NOTE: When used with CAM, the latents heats (of melting and evaporation) @@ -309,6 +324,8 @@ subroutine carma_register ! assumptions made in the CAM energy checking and microphysics code. call CARMA_Initialize(carma, & rc, & + sulfnucl_method = carma_sulfnuc_method, & + do_coremasscheck = carma_do_coremasscheck, & do_clearsky = carma_do_clearsky, & do_cnst_rlh = .true., & do_coag = carma_do_coag, & @@ -337,8 +354,7 @@ subroutine carma_register gstickl = carma_gstickl, & tstick = carma_tstick) if (rc < 0) call endrun('carma_register::CARMA_Initialize failed.') - - + ! The elements and gases from CARMA need to be added as constituents in ! CAM (if they don't already exist). For the elements, each radius bin ! needs to be its own constiuent in CAM. @@ -349,63 +365,61 @@ subroutine carma_register ! 2) The molecular weight is in kg/kmol. ! 3) The specific heat at constant pressure is in J/kg/K. ! 4) The consituents are added sequentially. - + ! Add a CAM constituents for each bin of each element. do ielem = 1, NELEM - + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup, shortname=shortname, name=name) if (rc < 0) call endrun('carma_register::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, r=r, rmass=rmass, maxbin=maxbin, shortname=grp_short) if (rc < 0) call endrun('carma_register::CARMAGROUP_Get failed.') - + ! For prognostic groups, all of the bins need to be represented as actual CAM ! constituents. Diagnostic groups are determined from state information that ! is already present in CAM, and thus their bins only exist in CARMA. - if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then - - do ibin = 1, NBIN - + do ibin = 1, NBIN + write(btndname(igroup, ibin), '(A, I2.2)') trim(grp_short), ibin + + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the paerent model. if (ibin <= maxbin) then - - write(btndname(igroup, ibin), '(A, I2.2)') trim(grp_short), ibin write(c_name, '(A, I2.2)') trim(shortname), ibin write(c_longname, '(A, e11.4, A)') trim(name) // ', ', r(ibin)*1.e4_r8, ' um' - + ! The molecular weight seems to be used for molecular diffusion, which - ! doesn't make sense for particles. The CAM solvers are unstable if the + ! doesn't make sense for particles. The CAM solvers are unstable if the ! mass provided is large. call cnst_add(c_name, WTMOL_AIR, cpair, 0._r8, icnst4elem(ielem, ibin), & longname=c_longname, mixtype=carma_mixtype, is_convtran1=is_convtran1(igroup)) end if - end do - end if + end if + end do end do - + ! Find the constituent for the gas or add it if not found. do igas = 1, NGAS - + call CARMAGAS_Get(carma, igas, rc, shortname=shortname, name=name, wtmol=wtmol) if (rc < 0) call endrun('carma_register::CARMAGAS_Get failed.') - + ! Is the gas already defined? call cnst_get_ind(shortname, icnst4gas(igas)) - + ! For substepping, we need to store the last mmr values for the gas. call pbuf_add_field('CG' // shortname, 'global',dtype_r8, (/pcols, pver/), ipbuf4gas(igas)) - + ! For substepping, we need to store the last supersaturations. call pbuf_add_field('CI' // shortname, 'global',dtype_r8, (/pcols, pver/), ipbuf4sati(igas)) call pbuf_add_field('CL' // shortname, 'global',dtype_r8, (/pcols, pver/), ipbuf4satl(igas)) end do - - + + ! For substepping, we need to store the temperature. call pbuf_add_field('CT', 'global',dtype_r8, (/pcols, pver/), ipbuf4t) - + ! Create the optical properties files needed for RRTMG radiative transfer ! calculations. @@ -418,7 +432,7 @@ subroutine carma_register call CARMA_CreateOpticsFile(carma, rc) if (rc < 0) call endrun('carma_register::carma_CreateOpticsFiles failed.') end if - + return end subroutine carma_register @@ -431,11 +445,11 @@ end subroutine carma_register !! @version May 2009 function carma_is_active() implicit none - + logical :: carma_is_active - + carma_is_active = carma_flag - + return end function carma_is_active @@ -448,38 +462,38 @@ end function carma_is_active !! @version May 2009 function carma_implements_cnst(name) implicit none - + character(len=*), intent(in) :: name !! constituent name logical :: carma_implements_cnst ! return value - + integer :: igroup integer :: ielem integer :: ibin integer :: igas integer :: rc - + integer :: cnsttype ! constituent type integer :: maxbin ! last prognostic bin rc = 0 - + carma_implements_cnst = .false. - + ! Check each bin to see if it this constituent. do ielem = 1, NELEM do ibin = 1, NBIN call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) - if (rc < 0) call endrun('carma_init::CARMAELEMENT_Get failed.') - + if (rc < 0) call endrun('carma_implements_cnst::CARMAELEMENT_Get failed.') + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin) - if (rc < 0) call endrun('carma_init::CARMAGROUP_Get failed.') - + if (rc < 0) call endrun('carma_implements_cnst::CARMAGROUP_Get failed.') + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then - + ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the parent model. if (ibin <= maxbin) then - + if (name == cnst_name(icnst4elem(ielem, ibin))) then carma_implements_cnst = .true. return @@ -487,8 +501,8 @@ function carma_implements_cnst(name) end if end if end do - end do - + end do + ! Check each gas to see if it this constituent. do igas = 1, NGAS if (name == cnst_name(icnst4gas(igas))) then @@ -496,10 +510,10 @@ function carma_implements_cnst(name) return end if end do - + return end function carma_implements_cnst - + !! Initialize items in CARMA that only need to be initialized once. This !! routine is called after carma_register has been called. @@ -508,16 +522,14 @@ end function carma_implements_cnst !! !! @author Chuck Bardeen !! @version May 2009 - subroutine carma_init + subroutine carma_init(pbuf2d) use cam_history, only: addfld, add_default, horiz_only - use ioFileMod, only : getfil use wrap_nf use time_manager, only: is_first_step use phys_control, only: phys_getopts - implicit none - - integer :: iz ! vertical index + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + integer :: ielem ! element index integer :: ibin ! bin index integer :: igas ! gas index @@ -529,17 +541,10 @@ subroutine carma_init integer :: maxbin ! last prognostic bin logical :: is_cloud ! is the group a cloud? logical :: do_drydep ! is dry deposition enabled? - - integer :: i - integer :: ier - integer :: ncid, dimid_lev, lev, vid_T - logical :: lexist - character(len=256) :: locfn - integer :: nlev - integer :: LUNOPRT ! logical unit number for output - logical :: do_print ! do print output? + integer :: ncore ! number of core elements in the group + logical :: history_carma - + logical :: history_carma_srf_flx 1 format(a6,4x,a11,4x,a11,4x,a11) 2 format(i6,4x,3(1pe11.3,4x)) @@ -548,38 +553,39 @@ subroutine carma_init rc = 0 call phys_getopts(history_carma_out=history_carma) + history_carma_srf_flx = .false. ! Set names of constituent sources and declare them as history variables; howver, ! only prognostic variables have. lq_carma(:) = .false. - + do ielem = 1, NELEM do ibin = 1, NBIN call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) if (rc < 0) call endrun('carma_init::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin, do_drydep=do_drydep) if (rc < 0) call endrun('carma_init::CARMAGROUP_Get failed.') - + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the parent model. if (ibin <= maxbin) then - + icnst = icnst4elem(ielem, ibin) - + ! Indicate that this is a constituent whose tendency could be changed by ! CARMA. lq_carma(icnst) = .true. - + etndname(ielem, ibin) = trim(cnst_name(icnst)) - + call addfld(cnst_name(icnst), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(icnst)) if (history_carma) then call add_default(cnst_name(icnst), 1, ' ') end if - + call addfld(trim(etndname(ielem, ibin))//'TC', (/ 'lev' /), 'A', 'kg/kg/s', & trim(cnst_name(icnst)) // ' tendency') call addfld(trim(etndname(ielem, ibin))//'SF', horiz_only, 'A', 'kg/m2/s', & @@ -591,9 +597,18 @@ subroutine carma_init call addfld(trim(etndname(ielem, ibin))//'SW', horiz_only, 'A', 'kg/m2/s', & trim(cnst_name(icnst)) // ' wet deposition flux at surface') + if (history_carma_srf_flx) then + call add_default(trim(etndname(ielem, ibin))//'EM', 1, ' ') + call add_default(trim(etndname(ielem, ibin))//'SF', 1, ' ') + call add_default(trim(etndname(ielem, ibin))//'SW', 1, ' ') + end if + if (do_drydep) then - call addfld(trim(etndname(ielem, ibin))//'DD', horiz_only, 'A', 'kg/m2/s ', & - trim(cnst_name(icnst)) // ' dry deposition') + call addfld(trim(etndname(ielem, ibin))//'DD', horiz_only, 'A', 'kg/m2/s ', & + trim(cnst_name(icnst)) // ' dry deposition') + if (history_carma_srf_flx) then + call add_default(trim(etndname(ielem, ibin))//'DD', 1, ' ') + end if end if if (carma_do_pheat) then @@ -606,9 +621,9 @@ subroutine carma_init end do do igroup = 1, NGROUP - call CARMAGROUP_Get(carma, igroup, rc, shortname=sname, is_cloud=is_cloud, do_drydep=do_drydep) + call CARMAGROUP_Get(carma, igroup, rc, shortname=sname, is_cloud=is_cloud, do_drydep=do_drydep, ncore=ncore) if (rc < 0) call endrun('carma_init::CARMAGROUP_GetGroup failed.') - + ! Gridbox average ! ! NOTE: Would like use flag_xf_fill for the reffective radius fields, but cam_history @@ -625,6 +640,7 @@ subroutine carma_init call addfld(trim(sname)//'PA', (/ 'lev' /), 'A', 'cm2', trim(sname) // ' projected area') call addfld(trim(sname)//'AR', (/ 'lev' /), 'A', ' ', trim(sname) // ' area ratio') call addfld(trim(sname)//'VM', (/ 'lev' /), 'A', 'm/s', trim(sname) // ' fall velocity') + call addfld(trim(sname)//'VR', (/ 'lev' /), 'A', 'kg/kg', trim(sname) // ' volatile mass mixing ratio') if (history_carma) then call add_default(trim(sname)//'ND', 1, ' ') @@ -638,6 +654,7 @@ subroutine carma_init call add_default(trim(sname)//'PA', 1, ' ') call add_default(trim(sname)//'AR', 1, ' ') call add_default(trim(sname)//'VM', 1, ' ') + call add_default(trim(sname)//'VR', 1, ' ') if (carma_do_grow) then call add_default(trim(sname)//'JN', 1, ' ') @@ -646,12 +663,39 @@ subroutine carma_init ! Per bin stats .. if (do_drydep) then - do ibin = 1, NBIN - call addfld(trim(btndname(igroup, ibin))//'VD', horiz_only, 'A', 'm/s', & - trim(cnst_name(icnst)) // ' dry deposition velocity') - end do + do ibin = 1, NBIN + call addfld(trim(btndname(igroup, ibin))//'VD', horiz_only, 'A', 'm/s', & + trim(btndname(igroup, ibin)) // ' dry deposition velocity') + end do end if + do ibin = 1, NBIN + call addfld(trim(btndname(igroup, ibin))//'ND', (/ 'lev' /), 'A', '#/cm3', & + trim(btndname(igroup, ibin)) // ' number density') + call addfld(trim(btndname(igroup, ibin))//'WR', (/ 'lev' /), 'A', 'um', & + trim(btndname(igroup, ibin)) // ' wet radius') + call addfld(trim(btndname(igroup, ibin))//'RO', (/ 'lev' /), 'A', 'g/cm3', & + trim(btndname(igroup, ibin)) // ' wet particle density') + call addfld(trim(btndname(igroup, ibin))//'VR', (/ 'lev' /), 'A', 'um', & + trim(btndname(igroup, ibin)) // ' volatile mixing ratio') + + + if ((carma_ndebugpkgs > 0) .and. (ncore > 0)) then + call addfld(trim(btndname(igroup, ibin))//'LCFM', horiz_only, 'A', 'kg/m2', trim(btndname(igroup, ibin)) // ' CARMA local mass fixer fail mass ') + call addfld(trim(btndname(igroup, ibin))//'LCFP', horiz_only, 'A', 'probability', trim(btndname(igroup, ibin)) // ' CARMA mass local fail PDF') + call addfld(trim(btndname(igroup, ibin))//'LCR', (/ 'lev' /), 'A', 'kg/kg', trim(btndname(igroup, ibin)) // ' CARMA local mass fix MMR') + call addfld(trim(btndname(igroup, ibin))//'LCP', (/ 'lev' /), 'A', 'probability', trim(btndname(igroup, ibin)) // ' CARMA local fix PDF') + + if (carma_diags_file > 0) then + call add_default(trim(btndname(igroup, ibin))//'LCFM', carma_diags_file, ' ') + call add_default(trim(btndname(igroup, ibin))//'LCFP', carma_diags_file, ' ') + call add_default(trim(btndname(igroup, ibin))//'LCR', carma_diags_file, ' ') + call add_default(trim(btndname(igroup, ibin))//'LCP', carma_diags_file, ' ') + end if + end if + + end do + end do do igas = 1, NGAS @@ -674,17 +718,17 @@ subroutine carma_init trim(cnst_name(icnst)) // ' equilibrium vmr wrt liquid') call addfld(trim(cnst_name(icnst))//'WT', (/ 'lev' /), 'A', '%', & trim(cnst_name(icnst)) // ' weight percent aerosol composition') - + if (history_carma) then call add_default(trim(cnst_name(icnst))//'SI', 1, ' ') call add_default(trim(cnst_name(icnst))//'SL', 1, ' ') end if end do - + if (carma_do_thermo) then call addfld('CRTT', (/ 'lev' /), 'A', 'K/s', ' CARMA temperature tendency') end if - + ! Add fields for diagnostic fields, and make them defaults on the first tape. if (carma_do_substep) then call addfld('CRNSTEP', (/ 'lev' /), 'A', ' ', 'number of carma substeps') @@ -695,8 +739,8 @@ subroutine carma_init call add_default('CRLNSTEP', 1, ' ') end if end if - - + + ! Set up the reference atmosphere that can be used for fixed initialization. This is ! an approximate atmospheric used to define average fall velocities, coagulation ! kernels, and growth parameters. @@ -705,112 +749,27 @@ subroutine carma_init ! NOTE: Reading the initial condtion file using the supplied routines must ! be done outside of masterproc, so does this in all threads before deciding ! if it will be used. The initial condition file is only opened on an initial run. - if (is_first_step()) then + if (is_first_step()) then call carma_getT(carma_t_ref) if (carma%f_igash2o /= 0) call carma_getH2O(carma_h2o_ref) if (carma%f_igash2So4 /= 0) call carma_getH2SO4(carma_h2so4_ref) end if - - if (masterproc) then - call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun('carma_init::CARMA_Get failed.') - - if (do_print) write(LUNOPRT,*) "" - if (do_print) write(LUNOPRT,*) "CARMA initializing to fixed reference state." - if (do_print) write(LUNOPRT,*) "" - - ! For temperature, get the average temperature from reference temperature file - ! if it exists or from the initial condition file if the reference temperature file - ! doesn't exist. - ! - ! NOTE: The reference temperature file will only be created for an inital run. It - ! must already exist for a restart run. - - ! Does reference temperature file already exist? - call getfil(carma_reftfile, locfn, iflag=1) - - inquire(file=locfn, exist=lexist) - - ! Read the reference temperature from the file. - if (lexist) then - - ! Open the netcdf file. - call wrap_open(trim(locfn), NF90_NOWRITE, ncid) - - ! Inquire about dimensions - call wrap_inq_dimid(ncid, 'lev', dimid_lev) - call wrap_inq_dimlen(ncid, dimid_lev, nlev) - - ! Does the number of levels match? - if (nlev /= pver) then - call endrun("carma_init::ERROR - Incompatible number of levels & - &in the CARMA reference temperature file ... " // trim(locfn)) - end if - - ! Get variable ID for reference temperature - call wrap_inq_varid(ncid, 'T', vid_T) - - ! Read in the temperature data. - call wrap_get_var_realx(ncid, vid_T, carma_T_ref) - - if (carma%f_igash2o /= 0) then - ! Get variable ID for reference temperature - call wrap_inq_varid(ncid, 'Q', vid_T) - - ! Read in the temperature data. - call wrap_get_var_realx(ncid, vid_T, carma_h2o_ref) - end if - - if (carma%f_igash2so4 /= 0) then - ! Get variable ID for reference temperature - call wrap_inq_varid(ncid, 'H2SO4', vid_T) - - ! Read in the temperature data. - call wrap_get_var_realx(ncid, vid_T, carma_h2so4_ref) - end if - - ! Close the file - call wrap_close(ncid) - - ! Is this an initial or restart run? - else if (is_first_step()) then - - if (do_print) write(LUNOPRT,*) "" - if (do_print) write(LUNOPRT,*) 'Creating CARMA reference temperature file ... ', trim(locfn) - - ! Save the average into a file to be used for restarts. - call CARMA_CreateRefTFile(carma, locfn, pref_mid(:) / 100._r8, & - carma_t_ref(:), rc, refh2o=carma_h2o_ref(:), refh2so4=carma_h2so4_ref(:)) - else - - ! The file must already exist for a restart run. - call endrun("carma_init::ERROR - Can't find the CARMA reference temperature file ... " // trim(carma_reftfile)) - - end if - - ! Write out the values that are being used. - if (do_print) write(LUNOPRT,*) "" - if (do_print) write(LUNOPRT,1) "Level","Int P (Pa)","Mid P (Pa)","Mid T (K)" - - do iz = 1, pver - if (do_print) write(LUNOPRT,2) iz, pref_edge(iz), pref_mid(iz), carma_t_ref(iz) - end do - if (do_print) write(LUNOPRT,2) iz, pref_edge(iz), 0.0_r8, 0.0_r8 - if (do_print) write(LUNOPRT,*) "" - end if - -#ifdef SPMD - - ! Communicate the settings to the other MPI tasks. - call mpi_bcast(carma_t_ref, pver, MPI_REAL8, 0, mpicom, ier) -#endif end if + if (is_first_step()) then + ! initialize physics buffer fields + do igas = 1, NGAS + call pbuf_set_field(pbuf2d, ipbuf4gas(igas), 0.0_r8) + call pbuf_set_field(pbuf2d, ipbuf4sati(igas), 0.0_r8) + call pbuf_set_field(pbuf2d, ipbuf4satl(igas), 0.0_r8) + end do + call pbuf_set_field(pbuf2d, ipbuf4t, 0.0_r8) + endif ! Do a model specific initialization. - call CARMA_InitializeModel(carma, lq_carma, rc) + call CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) if (rc < 0) call endrun('carma_init::CARMA_InitializeModel failed.') - + return end subroutine carma_init @@ -823,18 +782,18 @@ end subroutine carma_init !! @version October 2009 subroutine carma_final implicit none - + integer :: rc ! CARMA return code integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? - + 2 format(' carma_final: overall substepping statistics',/,& ' max nsubstep=',1F9.0,/,' avg nsubstep=',1F9.2,/,& ' max nretry=',1F9.0,/,' avg nretry=',1F10.4) ! Initialize the return code. rc = 0 - + ! Output the end of run statistics for CARMA if (carma_do_substep) then if (masterproc) then @@ -848,18 +807,18 @@ subroutine carma_final glob_nretry / glob_nstep else if (do_print) write(LUNOPRT,2) glob_max_nsubstep, & - 0., & + 0._r8, & glob_max_nretry, & - 0. + 0._r8 end if end if end if - - + + ! Do a model specific initialization. call CARMA_Destroy(carma, rc) if (rc < 0) call endrun('carma_final::CARMA_Destroy failed.') - + return end subroutine carma_final @@ -881,7 +840,7 @@ subroutine carma_timestep_init step_nstep = 0._f step_nsubstep = 0._f step_nretry = 0._f - + return end subroutine carma_timestep_init @@ -904,11 +863,10 @@ end subroutine carma_timestep_init !! @version May-2009 subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rliq, prec_str, snow_str, & prec_sed, snow_sed, ustar, obklen) - use time_manager, only: get_nstep, get_step_size, is_first_step + use time_manager, only: get_nstep, is_first_step use camsrfexch, only: cam_in_t, cam_out_t - use scamMod, only: single_column use planck, only: planckIntensity - + implicit none type(physics_state), intent(in) :: state !! physics state variables @@ -919,7 +877,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer real(r8), intent(in), optional :: dlf(pcols,pver) !! Detraining cld H20 from convection (kg/kg/s) real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(out), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(out), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(out), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(out), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) @@ -932,26 +890,20 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli type(carmastate_type) :: cstate ! the carma state object integer :: igroup ! group index integer :: ielem ! element index - integer :: ielem_nd ! index of numder density element in group integer :: ibin ! bin index integer :: igas ! gas index integer :: icol ! column index integer :: icnst ! constituent index integer :: icnst_q ! H2O constituent index - integer :: ncol ! number of columns integer :: rc ! CARMA return code integer :: cnsttype ! constituent type integer :: maxbin ! last prognostic bin - real(r8) :: spdiags(pcols, pver, NSPDIAGS) ! CARMA step diagnostic output - real(r8) :: gsdiags(pcols, pver, NGAS, NGSDIAGS) ! CARMA gas diagnostic output - real(r8) :: gpdiags(pcols, pver, NGROUP, NGPDIAGS) ! CARMA group diagnostic output - real(r8) :: sbdiags(pcols, NBIN, NELEM, NSBDIAGS) ! CARMA surface bin diagnostic output - real(r8) :: bndiags(pcols, pver, NBIN, NELEM, NBNDIAGS) ! CARMA bin diagnostic output + real(r8) :: spdiags(pcols, pver, NSPDIAGS) ! CARMA step diagnostic output + real(r8) :: gsdiags(pcols, pver, NGAS, NGSDIAGS) ! CARMA gas diagnostic output + real(r8) :: gpdiags(pcols, pver, NGROUP, NGPDIAGS) ! CARMA group diagnostic output + real(r8) :: sbdiags(pcols, NBIN, NELEM, NSBDIAGS) ! CARMA surface bin diagnostic output + real(r8) :: bndiags(pcols, pver, NBIN, NELEM, NBNDIAGS) ! CARMA bin diagnostic output real(r8) :: newstate(pver) ! next state for a physics state field - real(r8) :: xc(pver) ! x center - real(r8) :: dx(pver) ! x width - real(r8) :: yc(pver) ! y center - real(r8) :: dy(pver) ! y width real(r8) :: dz(pver) ! z width real(r8) :: satice(pver) ! saturation wrt ice real(r8) :: satliq(pver) ! saturation wrt liquid @@ -959,12 +911,10 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli real(r8) :: eqliq(pver) ! equil vp wrt liquid real(r8) :: wtpct(pver) ! weight percent aerosol composition real(r8) :: time ! the total elapsed time (s) - real(r8) :: dlat ! latitude spacing real(r8) :: r(NBIN) ! particle radius (cm) real(r8) :: rmass(NBIN) ! particle mass (g) real(r8) :: rrat(NBIN) ! particle maximum radius ratio () real(r8) :: arat(NBIN) ! particle area ration () - real(r8) :: rhoelem ! element density (g) real(r8) :: nd(pver) ! number density (cm-3) real(r8) :: ad(pver) ! area density (um2/cm3) real(r8) :: md(pver) ! mass density (g cm-3) @@ -976,12 +926,15 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli real(r8) :: re2(pver) ! N(r)*r^2 (cm2) real(r8) :: re3(pver) ! N(r)*r^3 (cm3) real(r8) :: pa(pver) ! Projected Area (cm2) - real(r8) :: ar(pver) ! Area Ratio + real(r8) :: ar(pver) ! Area Ratio real(r8) :: vm(pver) ! Massweighted fall velocity (cm2) real(r8) :: jn(pver) ! nucleation (cm-3) + real(r8) :: totalmmr(pver) ! total particle mmr (kg/kg) real(r8) :: numberDensity(pver) ! number density (cm-3) real(r8) :: nucleationRate(pver) ! nucleation rate (cm-3 s-1) real(r8) :: extinctionCoefficient(pver) ! extinction coefficient (cm2) + real(r8) :: r_wet(pver) ! wet radius (um) + real(r8) :: rhop_wet(pver) ! wet particle density (g/cm3) real(r8) :: dd ! dry deposition (kg/m2) real(r8) :: vd ! dry deposition velocity (cm/s) real(r8) :: vf(pverp) ! fall velocity (cm/s) @@ -997,9 +950,6 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli real(r8), pointer, dimension(:,:) :: tnd_qsnow ! external tendency on snow mass (kg/kg/s) real(r8), pointer, dimension(:,:) :: tnd_nsnow ! external tendency on snow number(#/kg/s) real(r8), pointer, dimension(:,:) :: re_ice ! ice effective radius (m) - integer :: lchnk ! chunk identifier - real(r8) :: coremmr(pver) - real(r8) :: ttlmmr(pver) integer :: iz real(r8) :: cldfrc(pver) ! cloud fraction [fraction] real(r8) :: rhcrit(pver) ! relative humidity for onset of liquid clouds [fraction] @@ -1021,51 +971,47 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli real(kind=f) :: zsubsteps(pver) logical :: is_cloud ! is the group a cloud? logical :: is_ice ! is the group ice? - integer :: ienconc logical :: grp_do_drydep ! is dry depostion enabled for group? logical :: do_drydep ! is dry depostion enabled? - logical :: do_fixedinit ! do initialization from reference atm? logical :: do_detrain ! do convective detrainment? integer :: iwvl real(r8), parameter :: zzocen = 0.0001_r8 ! Ocean aerodynamic roughness length [m] real(r8), parameter :: zzsice = 0.0400_r8 ! Sea ice aerodynamic roughness length [m] - + ! Initialize the return code. rc = 0 ! Initialize the output tendency structure. call physics_ptend_init(ptend,state%psetcols,'CARMA', ls=carma_do_thermo, lq=lq_carma) - + if (present(prec_sed)) prec_sed(:) = 0._f if (present(snow_sed)) snow_sed(:) = 0._f if (present(prec_str)) prec_str(:) = 0._f if (present(snow_str)) snow_str(:) = 0._f - + if (.not. carma_flag) return ! Determine the current time in seconds. time = dt * get_nstep() - 1 - + ! The CARMA interface assumes that mass mixing ratios are relative to a ! wet atmosphere, so convert any dry mass mixing ratios to wet. call physics_state_copy(state, state_loc) - call set_dry_to_wet(state_loc) - + call set_dry_to_wet(state_loc, convert_cnst_type='dry') + spdiags(:, :, :) = 0.0_r8 gpdiags(:, :, :, :) = 0.0_r8 gsdiags(:, :, :, :) = 0.0_r8 sbdiags(:, :, :, :) = 0.0_r8 bndiags(:, :, :, :, :) = 0.0_r8 - + ! Find the constituent index for water vapor. call cnst_get_ind('Q', icnst_q) - + ! Get pointers into pbuf ... - lchnk = state_loc%lchnk - call pbuf_get_field(pbuf, ipbuf4t, t_ptr) - + ! If doing particle heating, then get pointers to the spectral flux data provided ! by the radiation code in the physics buffer. ! @@ -1077,7 +1023,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli call pbuf_get_field(pbuf, pbuf_get_index("LU"), lu_ptr) call pbuf_get_field(pbuf, pbuf_get_index("LD"), ld_ptr) end if - + ! Cloud ice pbuf fields if (carma_do_cldice) then call pbuf_get_field(pbuf, pbuf_get_index("TND_QSNOW"), tnd_qsnow) @@ -1094,39 +1040,18 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli ! If initializing CARMASTATE from a reference state, do it before entering the main ! loop. ! - call CARMA_Get(carma, rc, do_fixedinit=do_fixedinit, do_drydep=do_drydep) + call CARMA_Get(carma, rc, do_drydep=do_drydep) if (rc < 0) call endrun('carma_timestep_tend::CARMA_Get failed.') - - if (do_fixedinit) then - - ! The latitude and longitude are arbitrary, but the dimensions need to be correct. - xc = 255._r8 - yc = 40._r8 - - ! Assume resolution is 64x128. - if (single_column) then - dx = 360._r8 / 128._r8 - dy = 180._r8 / 64._r8 - else - - ! Calculate the x and y coordinates, in degrees latitude and longitude. - dx = 360._r8 / plon - dy = 180._r8 / (plat-1) - end if + if (carma_do_fixedinit) then call CARMASTATE_CreateFromReference(cstate, & carma_ptr, & time, & dt, & pver, & I_HYBRID, & - I_LL, & 40._r8, & 255._r8, & - xc, & - dx, & - yc, & - dy, & pref_mid_norm, & pref_edge/psurf_ref, & pref_mid(:), & @@ -1135,48 +1060,17 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli rc, & qh2o=carma_h2o_ref, & qh2so4=carma_h2so4_ref) - if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_CreateFromReference failed.') + if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_CreateFromReference failed.') end if ! Process each column. do icol = 1, state_loc%ncol - - ! Haven't figured out how to get dimensions for single column. Perhaps should change - ! CARMA to work with area rather than dx and dy. For now, just hack something. - xc(:) = state_loc%lon(icol) / DEG2RAD - yc(:) = state_loc%lat(icol) / DEG2RAD - - ! Assume resolution is 64x128. - if (single_column) then - dx = 360._r8 / 128._r8 - dy = 180._r8 / 64._r8 - else - - ! Caclulate the x and y coordinates, in degrees latitude and longitude. - dx(:) = 360._r8 / plon - - dlat = 180._r8 / (plat-1) - - ! The pole points need special treatment, since the point is not the - ! center of the grid box. - ! - ! In single column mode there is just one latitude, so make it global. - if (abs(state_loc%lat(icol) / DEG2RAD) >= (90._r8 - (90._r8 / (plat-1)))) then - - ! Nudge yc toward the equator. - yc(:) = yc(:) - sign(0.25_r8,state_loc%lat(icol)) * dlat - - dy(:) = dlat / 2._r8 - else - dy(:) = dlat - endif - end if if (is_first_step()) then t_ptr(icol,:) = state_loc%t(icol,:) end if - + ! For particle heating, need to get the incoming radiative intensity from ! the radiation code. ! @@ -1184,11 +1078,11 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli ! when the compute_spectral_flux namelist variable is provided to the radiation. This ! data needs to be scaled to a radiative intensity by assuming it is isotrotropic. radint(:,:) = 0._f - + if (carma_do_pheat) then call CARMA_Get(carma, rc, dwave=dwave, wave=wave) if (rc < 0) call endrun('carma_timestep_tend::CARMA_Get failed.') - + ! CARMA may run before the radiation code for the very first time step. ! In that case, the lu, ld, su and sd values are NaN. NaN will crash ! the model, so instead substitute an approximation that is roughly a @@ -1206,17 +1100,17 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli lu_ptr(icol, iz, iwvl) = planckIntensity(wave(iwvl), state_loc%t(icol, iz)) / 1e7_f * 1e4_f * dwave(iwvl) * PI end do lu_ptr(icol, pverp, iwvl) = lu_ptr(icol, pver, iwvl) - + ld_ptr(icol, 2:pverp, iwvl) = lu_ptr(icol, 1:pver, iwvl) ld_ptr(icol, 1, iwvl) = lu_ptr(icol, 2, iwvl) end do end if - + do iwvl = 1, nlwbands radint(:, iwvl) = (lu_ptr(icol, 2:, iwvl) + ld_ptr(icol, :pver, iwvl)) / 2._r8 / PI / dwave(iwvl) end do - + do iwvl = 1, nswbands radint(:, nlwbands+iwvl) = (su_ptr(icol, 2:, iwvl) + sd_ptr(icol, :pver, iwvl)) / 2._r8 / PI / dwave(nlwbands+iwvl) end do @@ -1228,13 +1122,8 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli dt, & pver, & I_HYBRID, & - I_LL, & - state_loc%lat(icol) / DEG2RAD, & - state_loc%lon(icol) / DEG2RAD, & - xc, & - dx, & - yc, & - dy, & + state_loc%lat(icol) * RAD2DEG, & + state_loc%lon(icol) * RAD2DEG, & pref_mid_norm, & pref_edge/psurf_ref, & state_loc%pmid(icol, :), & @@ -1254,10 +1143,10 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli do ielem = 1, NELEM call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) if (rc < 0) call endrun('carma_timestep_tend::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin) if (rc < 0) call endrun('carma_timestep_tend::CARMAGROUP_Get failed.') - + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then ! For prognostic groups, set the bin from the corresponding constituent. @@ -1270,7 +1159,7 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_SetBin failed.') else newstate(:) = 0._f - + call CARMASTATE_SetBin(cstate, ielem, ibin, newstate, rc) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_SetBin failed.') end if @@ -1297,21 +1186,21 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli end do - call CARMA_DiagnoseBins(carma, cstate, state_loc, pbuf, icol, dt, rc, rliq=rliq, prec_str=prec_str, snow_str=snow_str) - if (rc < 0) call endrun('carma_timestep_tend::CARMA_DiagnoseBins failed.') - - + call CARMAMODEL_DiagnoseBins(carma, cstate, state_loc, pbuf, icol, dt, rc, rliq=rliq, prec_str=prec_str, snow_str=snow_str) + if (rc < 0) call endrun('carma_timestep_tend::CARMA_DiagnoseBins failed.') + + ! If the model supports detraining of condensed water from convection, then pass ! along the condensed H2O. call CARMA_Get(carma, rc, do_detrain=do_detrain) if (rc < 0) call endrun('CARMA_Detrain::CARMA_Get failed.') if (do_detrain) then - call CARMA_Detrain(carma, cstate, cam_in, dlf, state_loc, icol, dt, rc, rliq=rliq, prec_str=prec_str, & + call CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state_loc, icol, dt, rc, rliq=rliq, prec_str=prec_str, & snow_str=snow_str, tnd_qsnow=tnd_qsnow, tnd_nsnow=tnd_nsnow) if (rc < 0) call endrun('carma_timestep_tend::CARMA_Detrain failed.') end if - + ! Now that detrainment has happened, determine the cloud fractions. ! These will be used to scale the cloud amount to go from gridbox average to in-cloud @@ -1326,17 +1215,17 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli if (carma_rhcrit /= 0._f) then rhcrit(:) = carma_rhcrit end if - - + + ! For dry deposition, provide a surface friction velocity and an aerodynamic ! resistance for each of the land surface types. The values for the land come ! from the land model, but those for ocean and sea ice need to be calculated. if (do_drydep) then - + ! Land lndfv = cam_in%fv(icol) lndram = cam_in%ram1(icol) - + ! Ocean ocnfv = ustar(icol) ocnram = 0._r8 @@ -1363,15 +1252,15 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli iceram) end if end if - - + + ! Advance the microphysics one timestep. call CARMASTATE_Step(cstate, rc, cldfrc=cldfrc, rhcrit=rhcrit, & lndfv=lndfv, ocnfv=ocnfv, icefv=icefv, lndram=lndram, & ocnram=ocnram, iceram=iceram, lndfrac=cam_in%landfrac(icol), & ocnfrac=cam_in%ocnfrac(icol), icefrac=cam_in%icefrac(icol)) - if (rc < 0) call endrun('carma_timestep_tend::CARMA_Step failed.') - + if (rc < 0) call endrun('carma_timestep_tend::CARMA_Step failed.') + ! Get the results for the CARMA particles. @@ -1382,27 +1271,27 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli ! NOTE: To work around an XL Fortran compiler bug, the optional arguments can only ! be passed when defined. if (present(rliq)) then - call CARMA_DiagnoseBulk(carma, cstate, cam_out, state_loc, pbuf, ptend, icol, dt, rc, & + call CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state_loc, pbuf, ptend, icol, dt, rc, & rliq=rliq, prec_str=prec_str, snow_str=snow_str, prec_sed=prec_sed, & snow_sed=snow_sed, tnd_qsnow=tnd_qsnow, tnd_nsnow=tnd_nsnow, re_ice=re_ice) else - call CARMA_DiagnoseBulk(carma, cstate, cam_out, state_loc, pbuf, ptend, icol, dt, rc) + call CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state_loc, pbuf, ptend, icol, dt, rc) end if if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_DiagnoseBulk failed.') ! Calculate the group statistics for all elements. dz(:) = state_loc%zi(icol, 1:pver) - state_loc%zi(icol, 2:pverp) - + do ielem = 1, NELEM - + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) if (rc < 0) call endrun('carma_timestep_tend::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, r=r, rmass=rmass, maxbin=maxbin, & is_cloud=is_cloud, is_ice=is_ice, do_drydep=grp_do_drydep, rrat=rrat, arat=arat) if (rc < 0) call endrun('carma_timestep_tend::CARMAGROUP_Get failed.') - + ! Intialize the group totals nd(:) = 0.0_r8 ad(:) = 0.0_r8 @@ -1421,28 +1310,29 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli do ibin = 1, NBIN call CARMASTATE_GetBin(cstate, ielem, ibin, newstate(:), rc, & - numberDensity=numberDensity, nucleationRate=nucleationRate, surface=dd, vd=vd, vf=vf, dtpart=dtpart) + numberDensity=numberDensity, nucleationRate=nucleationRate, r_wet=r_wet, & + rhop_wet=rhop_wet, sedimentationflux=dd, vd=vd, vf=vf, dtpart=dtpart, totalmmr=totalmmr) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_GetBin failed.') - + ! For prognostic groups, set the tendency from the corresponding constituents. if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then - + ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the paerent model. if (ibin <= maxbin) then - + icnst = icnst4elem(ielem, ibin) - + ! Update the consituent tendency. ptend%q(icol, :, icnst) = (newstate(:) - state_loc%q(icol, :, icnst)) / dt - + if (grp_do_drydep) then - sbdiags(icol, ibin, ielem, SBDIAGS_DD) = dd / dt + sbdiags(icol, ibin, ielem, SBDIAGS_DD) = dd sbdiags(icol, ibin, ielem, SBDIAGS_VD) = - vd / 100._r8 end if end if end if - + ! Calculate the total densities. ! ! NOTE: Convert AD to um2/cm3. @@ -1452,10 +1342,10 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli re3(:) = re3(:) + numberDensity(:) * ((r(ibin)*rrat(ibin))**3) ad(:) = ad(:) + numberDensity(:) * 4.0_r8 * PI * (r(ibin)**2) * 1.0e8_r8 md(:) = md(:) + numberDensity(:) * rmass(ibin) - mr(:) = mr(:) + newstate(:) + mr(:) = mr(:) + totalmmr(:) pa(:) = pa(:) + numberDensity(:) * PI * ((r(ibin) * rrat(ibin))**2) * arat(ibin) vm(:) = vm(:) + numberDensity(:) * rmass(ibin) * vf(2:) / 100._f - + ! Calculate the optical depth and extinction. ! ! NOTE: Assume Qext = 2 for optical depth. This can be pulled out of CARMA @@ -1467,6 +1357,9 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli od(:) = od(:) + numberDensity(:) * extinctionCoefficient(:) * dz(:) * 100._r8 end if + bndiags(icol,:,ibin,ielem,BNDIAGS_VR) = bndiags(icol,:,ibin,ielem,BNDIAGS_VR) + totalmmr(:) + gpdiags(icol, :, igroup, GPDIAGS_VR) = gpdiags(icol, :, igroup, GPDIAGS_VR) + totalmmr(:) + ! Particle temperatures from particle heating. if (carma_do_pheat) then bndiags(icol, :, ibin, ielem, BNDIAGS_TP) = dtpart(:) @@ -1475,12 +1368,18 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli if (nucleationRate(1) /= CAM_FILL) then jn(:) = jn(:) + nucleationRate(:) end if + + ! Output nd and wet radius for each bin. + r_wet = r_wet * 1e4_r8 ! cm to um + bndiags(icol,:,ibin,ielem,BNDIAGS_WETR) = r_wet(:) + bndiags(icol,:,ibin,ielem,BNDIAGS_ND) = numberDensity(:) + bndiags(icol,:,ibin,ielem,BNDIAGS_RO) = rhop_wet(:) end do - + ! If this is the number element for the group, then write out the ! statistics. if (numberDensity(1) /= CAM_FILL) then - + ! Calculate the effective radius (total volume / total area). Places ! with no surface area will cause NaN values. ! @@ -1496,9 +1395,9 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli end where ! Store the statistics. - + ! Gridbox average - gpdiags(icol, :, igroup, GPDIAGS_ND) = nd + gpdiags(icol, :, igroup, GPDIAGS_ND) = nd gpdiags(icol, :, igroup, GPDIAGS_AD) = ad gpdiags(icol, :, igroup, GPDIAGS_MD) = md gpdiags(icol, :, igroup, GPDIAGS_RE) = re @@ -1509,14 +1408,14 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli gpdiags(icol, :, igroup, GPDIAGS_VM) = vm gpdiags(icol, :, igroup, GPDIAGS_PA) = pa gpdiags(icol, :, igroup, GPDIAGS_AR) = ar - + if (nucleationRate(1) /= CAM_FILL) then gpdiags(icol, :, igroup, GPDIAGS_JN) = jn end if end if end do - + ! Get the results for the CARMA gases. do igas = 1, NGAS call pbuf_get_field(pbuf, ipbuf4gas(igas), gc_ptr) @@ -1524,49 +1423,51 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli call pbuf_get_field(pbuf, ipbuf4satl(igas), satl_ptr) call CARMASTATE_GetGas(cstate, igas, newstate(:), rc, satice=satice, satliq=satliq, & - eqice=eqice, eqliq=eqliq, wtpct=wtpct) + eqice=eqice, eqliq=eqliq, wtpct=wtpct) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_GetGas failed.') - + icnst = icnst4gas(igas) ptend%q(icol, :, icnst) = (newstate(:) - state_loc%q(icol, :, icnst)) / dt - - gsdiags(icol, :, igas, GSDIAGS_SI) = satice(:) + + gsdiags(icol, :, igas, GSDIAGS_SI) = satice(:) gsdiags(icol, :, igas, GSDIAGS_SL) = satliq(:) - gsdiags(icol, :, igas, GSDIAGS_EI) = eqice(:) + gsdiags(icol, :, igas, GSDIAGS_EI) = eqice(:) gsdiags(icol, :, igas, GSDIAGS_EL) = eqliq(:) gsdiags(icol, :, igas, GSDIAGS_WT) = wtpct(:) - + ! Store the values needed for substepping in the physics buffer. gc_ptr(icol,:) = newstate(:) sati_ptr(icol, :) = satice(:) satl_ptr(icol, :) = satliq(:) end do - + ! Get the results for temperature. call CARMASTATE_GetState(cstate, rc, t=newstate(:)) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_GetState failed.') - + ! Store the values needed for substepping in the physics buffer. t_ptr(icol,:) = newstate(:) - if (carma_do_thermo) then + if (carma_do_thermo) then ptend%s(icol, :) = (newstate(:) - state_loc%t(icol, :)) * cpair / dt endif - - + + ! Get the substepping statistics if (carma_do_substep) then call CARMASTATE_Get(cstate, rc, zsubsteps=zsubsteps) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_Get failed.') - + spdiags(icol, :, SPDIAGS_NSTEP) = zsubsteps(:) - spdiags(icol, :, SPDIAGS_LNSTEP) = log(zsubsteps(:)) + where (zsubsteps/=0.0_r8) + spdiags(icol, :, SPDIAGS_LNSTEP) = log(zsubsteps(:)) + end where end if end do - - + + ! Report substep diagnostics if (carma_do_substep) then call CARMASTATE_Get(cstate, rc, max_nsubstep=max_nsubstep, max_nretry=max_nretry, & @@ -1576,27 +1477,48 @@ subroutine carma_timestep_tend(state, cam_in, cam_out, ptend, dt, pbuf, dlf, rli !$OMP CRITICAL step_max_nsubstep = max(step_max_nsubstep, real(max_nsubstep, f)) step_max_nretry = max(step_max_nretry, max_nretry) - + step_nstep = step_nstep + nstep step_nsubstep = step_nsubstep + real(nsubstep, f) step_nretry = step_nretry + nretry !$OMP END CRITICAL end if - + ! The CARMASTATE object is no longer needed. call CARMASTATE_Destroy(cstate, rc) if (rc < 0) call endrun('carma_timestep_tend::CARMASTATE_Destroy failed.') - - + ! Output diagnostic fields. - call carma_output_diagnostics(state_loc, ptend, gpdiags, sbdiags, gsdiags, spdiags, bndiags) + call carma_output_diagnostics(state_loc, ptend, pbuf, cam_in, gpdiags, sbdiags, gsdiags, spdiags, bndiags) end subroutine carma_timestep_tend - - + + + !! Get the index for the constituents array for the specified bin + !! of the specified element. + !! + !! @author Yunqian Zhu, Francis Vitt + !! @version September-2022 + subroutine carma_getcnstforbin(ielem, ibin, icnst) + implicit none + + integer, intent(in) :: ielem, ibin + integer, intent(out) :: icnst + + icnst = icnst4elem(ielem,ibin) + return + end subroutine carma_getcnstforbin + + !! Collect CARMA substep statistics from all MPI tasks. + !! + !! @author Chuck Bardeen + !! @version May-2009 subroutine carma_accumulate_stats() +#if ( defined SPMD ) + use mpishorthand +#endif implicit none - + integer :: istat integer :: rc real(kind=f) :: wrk @@ -1604,7 +1526,7 @@ subroutine carma_accumulate_stats() logical :: do_print ! do print output? ! Define formats - 1 format(' carma: max nsubstep=',1F9.0,3x,'avg nsubstep=',1F9.2,3x,'max nretry=',1F9.0,3x,'avg nretry=',1F10.4) + 1 format(' carma: max nsubstep=',1F9.0,3x,'avg nsubstep=',1F9.2,3x,'max nretry=',1F9.0,3x,'avg nretry=',1F10.4) if (carma_do_substep) then @@ -1619,7 +1541,7 @@ subroutine carma_accumulate_stats() end if step_max_nsubstep = wrk glob_max_nsubstep = max(glob_max_nsubstep, wrk) - + call mpi_allreduce(step_max_nretry, wrk, 1, mpir8, mpi_max, mpicom, istat) if( istat /= MPI_SUCCESS ) then if (do_print) write(LUNOPRT,*) 'carma_timestep_tend: MPI_ALLREDUCE for max_nsubstep failed; error = ',istat @@ -1627,7 +1549,7 @@ subroutine carma_accumulate_stats() end if step_max_nretry = wrk glob_max_nretry = max(glob_max_nretry, wrk) - + call mpi_allreduce(step_nstep, wrk, 1, mpir8, mpi_sum, mpicom, istat) if( istat /= MPI_SUCCESS ) then if (do_print) write(LUNOPRT,*) 'carma_timestep_tend: MPI_ALLREDUCE for nstep failed; error = ',istat @@ -1635,7 +1557,7 @@ subroutine carma_accumulate_stats() end if step_nstep = wrk glob_nstep = glob_nstep + wrk - + call mpi_allreduce(step_nsubstep, wrk, 1, mpir8, mpi_sum, mpicom, istat) if( istat /= MPI_SUCCESS ) then if (do_print) write(LUNOPRT,*) 'carma_timestep_tend: MPI_ALLREDUCE for nsubstep failed; error = ',istat @@ -1643,7 +1565,7 @@ subroutine carma_accumulate_stats() end if step_nsubstep = wrk glob_nsubstep = glob_nsubstep + wrk - + call mpi_allreduce(step_nretry, wrk, 1, mpir8, mpi_sum, mpicom, istat) if( istat /= MPI_SUCCESS ) then if (do_print) write(LUNOPRT,*) 'carma_timestep_tend: MPI_ALLREDUCE for nretry failed; error = ',istat @@ -1659,7 +1581,7 @@ subroutine carma_accumulate_stats() glob_nstep = glob_nstep + step_nstep glob_nsubstep = glob_nsubstep + step_nsubstep glob_nretry = glob_nretry + step_nretry - + #endif if (masterproc) then @@ -1670,9 +1592,9 @@ subroutine carma_accumulate_stats() step_nretry / step_nstep else if (do_print) write(LUNOPRT,1) step_max_nsubstep, & - 0., & + 0._r8, & step_max_nretry, & - 0. + 0._r8 end if end if end if @@ -1695,7 +1617,7 @@ subroutine carma_init_cnst(name, latvals, lonvals, mask, q) real(r8), intent(in) :: lonvals(:) !! lon in degrees (ncol) logical, intent(in) :: mask(:) !! Only initialize where .true. real(r8), intent(out) :: q(:,:) !! mass mixing ratio (gcol, lev) - + integer :: igroup ! group index integer :: ielem ! element index integer :: ilev ! level index @@ -1707,27 +1629,27 @@ subroutine carma_init_cnst(name, latvals, lonvals, mask, q) ! Initialize the return code. rc = 0 - + ! Determine the element an bin for the particle do ielem = 1, NELEM do ibin = 1, NBIN - + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) if (rc < 0) call endrun('carma_timestep_tend::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin) if (rc < 0) call endrun('carma_timestep_tend::CARMAGROUP_Get failed.') - + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the paerent model. if (ibin <= maxbin) then - + icnst = icnst4elem(ielem, ibin) - + if (cnst_name(icnst) == name) then - + ! By default, initialize all constituents to 0. do ilev = 1, size(q, 2) where(mask) @@ -1735,38 +1657,40 @@ subroutine carma_init_cnst(name, latvals, lonvals, mask, q) end where end do - call CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + call CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) if (rc < 0) call endrun('carma_init_cnst::CARMA_InitializeParticle failed.') end if end if end if end do end do - + ! NOTE: There is currently no initialization for gases, but it could be ! added here. - + return end subroutine carma_init_cnst - !! Outputs tracer tendencies and diagnositc fields to the history files. !! All the columns in the chunk should be output at the same time. !! !! @author Chuck Bardeen !! @version May-2009 - subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spdiags, bndiags) + subroutine carma_output_diagnostics(state, ptend, pbuf, cam_in, gpdiags, sbdiags, gsdiags, spdiags, bndiags) use cam_history, only: outfld + use camsrfexch, only: cam_in_t implicit none type(physics_state), intent(in) :: state !! Physics state variables - before CARMA type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies - real(r8), intent(in), dimension(pcols, pver, NGROUP, NGPDIAGS) :: gpdiags !! CARMA group diagnostic output - real(r8), intent(in), dimension(pcols, NBIN, NELEM, NSBDIAGS) :: sbdiags !! CARMA surface bin diagnostic output - real(r8), intent(in), dimension(pcols, pver, NGAS, NGSDIAGS) :: gsdiags !! CARMA gas diagnostic output - real(r8), intent(in), dimension(pcols, pver, NSPDIAGS) :: spdiags !! CARMA step diagnostic output - real(r8), intent(in), dimension(pcols, pver, NBIN, NELEM, NBNDIAGS) :: bndiags !! CARMA bin diagnostic output + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + real(r8), intent(in), dimension(pcols, pver, NGROUP, NGPDIAGS) :: gpdiags !! CARMA group diagnostic output + real(r8), intent(in), dimension(pcols, NBIN, NELEM, NSBDIAGS) :: sbdiags !! CARMA surface bin diagnostic output + real(r8), intent(in), dimension(pcols, pver, NGAS, NGSDIAGS) :: gsdiags !! CARMA gas diagnostic output + real(r8), intent(in), dimension(pcols, pver, NSPDIAGS) :: spdiags !! CARMA step diagnostic output + real(r8), intent(in), dimension(pcols, pver, NBIN, NELEM, NBNDIAGS) :: bndiags !! CARMA bin diagnostic output ! Local variables integer :: igroup ! group index @@ -1776,53 +1700,53 @@ subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spd integer :: ienconc ! element index for group's concentration element integer :: icnst ! constituent index integer :: lchnk ! chunk identifier - integer :: ncol ! number of columns integer :: rc ! CARMA return code character(len=8) :: sname ! short (CAM) name integer :: cnsttype ! constituent type integer :: maxbin ! last prognostic bin logical :: is_cloud ! is the group a cloud? logical :: do_drydep ! is dry deposition enabled? - + + character(len=*), parameter :: subname = 'carma_output_diagnostics' + ! Initialize the return code. rc = 0 - + ! Check each column int the chunk. lchnk = state%lchnk - ncol = state%ncol ! Output step diagnostics. if (carma_do_substep) then - call outfld('CRNSTEP', spdiags(:, :, SPDIAGS_NSTEP), pcols, lchnk) - call outfld('CRLNSTEP', spdiags(:, :, SPDIAGS_LNSTEP), pcols, lchnk) + call outfld('CRNSTEP', spdiags(:, :, SPDIAGS_NSTEP), pcols, lchnk) + call outfld('CRLNSTEP', spdiags(:, :, SPDIAGS_LNSTEP), pcols, lchnk) end if ! Output the particle tendencies. do ielem = 1, NELEM do ibin = 1, NBIN - + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) - if (rc < 0) call endrun('carma_timestep_tend::CARMAELEMENT_Get failed.') - + if (rc < 0) call endrun(subname//'::CARMAELEMENT_Get failed.') + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin, do_drydep=do_drydep) - if (rc < 0) call endrun('carma_timestep_tend::CARMAGROUP_Get failed.') - + if (rc < 0) call endrun(subname//'::CARMAGROUP_Get failed.') + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the paerent model. if (ibin <= maxbin) then - + icnst = icnst4elem(ielem, ibin) - - call outfld(trim(etndname(ielem, ibin))//'TC', ptend%q(:, :, icnst), pcols, lchnk) + + call outfld(trim(etndname(ielem, ibin))//'TC', ptend%q(:, :, icnst), pcols, lchnk) if (do_drydep) then call outfld(trim(etndname(ielem, ibin))//'DD', sbdiags(:, ibin, ielem, SBDIAGS_DD), pcols, lchnk) end if if (carma_do_pheat) then - + ! Only specified for the number density element of the group. if (bndiags(1, 1, ibin, ielem, BNDIAGS_TP) /= CAM_FILL) then call outfld(trim(etndname(ielem, ibin))//'TP', bndiags(:, :, ibin, ielem, BNDIAGS_TP), pcols, lchnk) @@ -1832,76 +1756,86 @@ subroutine carma_output_diagnostics(state, ptend, gpdiags, sbdiags, gsdiags, spd end if end do end do - + ! Output the particle diagnostics. - do igroup = 1, NGROUP + do igroup = 1, NGROUP call CARMAGROUP_Get(carma, igroup, rc, shortname=sname, is_cloud=is_cloud, do_drydep=do_drydep, ienconc=ienconc) - if (rc < 0) call endrun('carma_output_diagnostics::CARMAGROUP_Get failed.') - + if (rc < 0) call endrun(subname//'::CARMAGROUP_Get failed.') + ! Gridbox average - call outfld(trim(sname)//'ND', gpdiags(:, :, igroup, GPDIAGS_ND), pcols, lchnk) - call outfld(trim(sname)//'AD', gpdiags(:, :, igroup, GPDIAGS_AD), pcols, lchnk) - call outfld(trim(sname)//'MD', gpdiags(:, :, igroup, GPDIAGS_MD), pcols, lchnk) - call outfld(trim(sname)//'RE', gpdiags(:, :, igroup, GPDIAGS_RE), pcols, lchnk) - call outfld(trim(sname)//'RM', gpdiags(:, :, igroup, GPDIAGS_RM), pcols, lchnk) - call outfld(trim(sname)//'JN', gpdiags(:, :, igroup, GPDIAGS_JN), pcols, lchnk) - call outfld(trim(sname)//'MR', gpdiags(:, :, igroup, GPDIAGS_MR), pcols, lchnk) - call outfld(trim(sname)//'EX', gpdiags(:, :, igroup, GPDIAGS_EX), pcols, lchnk) - call outfld(trim(sname)//'OD', gpdiags(:, :, igroup, GPDIAGS_OD), pcols, lchnk) - call outfld(trim(sname)//'PA', gpdiags(:, :, igroup, GPDIAGS_PA), pcols, lchnk) - call outfld(trim(sname)//'AR', gpdiags(:, :, igroup, GPDIAGS_AR), pcols, lchnk) - call outfld(trim(sname)//'VM', gpdiags(:, :, igroup, GPDIAGS_VM), pcols, lchnk) - + call outfld(trim(sname)//'ND', gpdiags(:, :, igroup, GPDIAGS_ND), pcols, lchnk) + call outfld(trim(sname)//'AD', gpdiags(:, :, igroup, GPDIAGS_AD), pcols, lchnk) + call outfld(trim(sname)//'MD', gpdiags(:, :, igroup, GPDIAGS_MD), pcols, lchnk) + call outfld(trim(sname)//'RE', gpdiags(:, :, igroup, GPDIAGS_RE), pcols, lchnk) + call outfld(trim(sname)//'RM', gpdiags(:, :, igroup, GPDIAGS_RM), pcols, lchnk) + call outfld(trim(sname)//'JN', gpdiags(:, :, igroup, GPDIAGS_JN), pcols, lchnk) + call outfld(trim(sname)//'MR', gpdiags(:, :, igroup, GPDIAGS_MR), pcols, lchnk) + call outfld(trim(sname)//'EX', gpdiags(:, :, igroup, GPDIAGS_EX), pcols, lchnk) + call outfld(trim(sname)//'OD', gpdiags(:, :, igroup, GPDIAGS_OD), pcols, lchnk) + call outfld(trim(sname)//'PA', gpdiags(:, :, igroup, GPDIAGS_PA), pcols, lchnk) + call outfld(trim(sname)//'AR', gpdiags(:, :, igroup, GPDIAGS_AR), pcols, lchnk) + call outfld(trim(sname)//'VM', gpdiags(:, :, igroup, GPDIAGS_VM), pcols, lchnk) + call outfld(trim(sname)//'VR', gpdiags(:, :, igroup, GPDIAGS_VR), pcols, lchnk) + if (do_drydep) then do ibin = 1, NBIN call outfld(trim(btndname(igroup, ibin))//'VD', sbdiags(:, ibin, ienconc, SBDIAGS_VD), pcols, lchnk) end do end if + + do ibin = 1,NBIN + call outfld(trim(btndname(igroup, ibin))//'ND',bndiags(:, :, ibin, ienconc, BNDIAGS_ND), pcols, lchnk) + call outfld(trim(btndname(igroup, ibin))//'WR',bndiags(:, :, ibin, ienconc, BNDIAGS_WETR), pcols, lchnk) + call outfld(trim(btndname(igroup, ibin))//'RO',bndiags(:, :, ibin, ienconc, BNDIAGS_RO), pcols, lchnk) + call outfld(trim(btndname(igroup, ibin))//'VR',bndiags(:, :, ibin, ienconc, BNDIAGS_VR), pcols, lchnk) + end do end do - + ! Output the gas tendencies. do igas = 1, NGAS icnst = icnst4gas(igas) - - call outfld(gtndname(igas), ptend%q(:, :, icnst), pcols, lchnk) - + + call outfld(gtndname(igas), ptend%q(:, :, icnst), pcols, lchnk) + ! Output the supersaturations. - call outfld(trim(cnst_name(icnst))//'SI', gsdiags(:, :, igas, GSDIAGS_SI), pcols, lchnk) - call outfld(trim(cnst_name(icnst))//'SL', gsdiags(:, :, igas, GSDIAGS_SL), pcols, lchnk) - call outfld(trim(cnst_name(icnst))//'EI', gsdiags(:, :, igas, GSDIAGS_EI), pcols, lchnk) - call outfld(trim(cnst_name(icnst))//'EL', gsdiags(:, :, igas, GSDIAGS_EL), pcols, lchnk) - call outfld(trim(cnst_name(icnst))//'WT', gsdiags(:, :, igas, GSDIAGS_WT), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'SI', gsdiags(:, :, igas, GSDIAGS_SI), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'SL', gsdiags(:, :, igas, GSDIAGS_SL), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'EI', gsdiags(:, :, igas, GSDIAGS_EI), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'EL', gsdiags(:, :, igas, GSDIAGS_EL), pcols, lchnk) + call outfld(trim(cnst_name(icnst))//'WT', gsdiags(:, :, igas, GSDIAGS_WT), pcols, lchnk) end do - + ! Output the temperature tendency. if (carma_do_thermo) then - call outfld('CRTT', ptend%s(:, :) / cpair, pcols, lchnk) + call outfld('CRTT', ptend%s(:, :) / cpair, pcols, lchnk) end if - + + ! Allow models to output their own diagnostics + call CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + return end subroutine carma_output_diagnostics - - + !! Calculate the emissions for CARMA aerosols. This is taken from !! the routine aerosol_emis_intr in aerosol_intr.F90 and dust_emis_intr in !! dust_intr.F90 by Phil Rasch. !! !! @author Chuck Bardeen !! @version May-2009 - subroutine carma_emission_tend (state, ptend, cam_in, dt) - use cam_history, only: outfld - use camsrfexch, only: cam_in_t + subroutine carma_emission_tend (state, ptend, cam_in, dt, pbuf) + use cam_history, only: outfld + use camsrfexch, only: cam_in_t implicit none - + type(physics_state), intent(in ) :: state !! physics state type(physics_ptend), intent(inout) :: ptend !! physics state tendencies type(cam_in_t), intent(inout) :: cam_in !! surface inputs real(r8), intent(in) :: dt !! time step (s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer :: lchnk ! chunk identifier integer :: ncol ! number of columns in chunk - integer :: icol ! column index integer :: igroup ! group index integer :: ielem ! element index integer :: ibin ! bin index @@ -1923,34 +1857,34 @@ subroutine carma_emission_tend (state, ptend, cam_in, dt) ncol = state%ncol lchnk = state%lchnk - + ! Provide emissions rates for particles. ! ! NOTE: This can only be done for prognostic groups. do ielem = 1, NELEM call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) if (rc < 0) call endrun('carma_drydep_tend::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, maxbin=maxbin) if (rc < 0) call endrun('carma_drydep_tend::CARMAGROUP_Get failed.') - + if (cnsttype == I_CNSTTYPE_PROGNOSTIC) then - + do ibin = 1, NBIN ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the paerent model. if (ibin <= maxbin) then - + icnst = icnst4elem(ielem, ibin) - - call CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + + call CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) if (rc < 0) call endrun('carma_emission_tend::CARMA_EmitParticle failed.') - + ! Add any surface flux here. cam_in%cflx(:ncol, icnst) = surfaceFlux(:ncol) call outfld(trim(cnst_name(icnst))//'SF', cam_in%cflx(:ncol, icnst), ncol, lchnk) - + ! For emissions into the atmosphere, put the emission here. ptend%q(:ncol, :pver, icnst) = tendency(:ncol, :pver) call outfld(trim(cnst_name(icnst))//'EM', ptend%q(:ncol, :, icnst), ncol, lchnk) @@ -1958,18 +1892,18 @@ subroutine carma_emission_tend (state, ptend, cam_in, dt) enddo end if enddo - + ! No emissions rate is set up for gases, but it could be added here. return - end subroutine carma_emission_tend + end subroutine carma_emission_tend !! Calculate the wet deposition for the CARMA aerosols. This is taken from !! the routine aerosol_wet_int in aerosol_intr.F90 and dust_wet_intr in !! dust_intr.F90 by Phil Rasch. - !! - !! Method: + !! + !! Method: !! Use a modified version of the scavenging parameterization described in !! Barth et al, 2000, JGR (sulfur cycle paper) !! Rasch et al, 2001, JGR (INDOEX paper) @@ -1979,11 +1913,10 @@ end subroutine carma_emission_tend subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) use cam_history, only: outfld use phys_control, only: cam_physpkg_is - use phys_grid, only: get_lat_all_p, get_lon_all_p, get_rlat_all_p use wetdep, only: clddiag, wetdepa_v1, wetdepa_v2 use camsrfexch, only: cam_out_t use physconst, only: gravit - + implicit none real(r8), intent(in) :: dt !! time step (s) @@ -1997,14 +1930,11 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) real(r8) :: rainmr(pcols,pver) ! mixing ratio of rain within cloud volume real(r8) :: cldv(pcols,pver) ! cloudy volume undergoing wet chem and scavenging real(r8) :: cldvcu(pcols,pver) ! Convective precipitation area, top interface of current layer - real(r8) :: cldvst(pcols,pver) ! Stratiform precipitation area, top interface of current layer + real(r8) :: cldvst(pcols,pver) ! Stratiform precipitation area, top interface of current layer integer :: ielem ! element index integer :: igroup ! group index integer :: ibin ! bin index integer :: icnst ! constituent index - integer :: lat(pcols) ! latitude indices - real(r8) :: clat(pcols) ! latitudes - integer :: lon(pcols) ! longtitude indices real(r8) :: conicw(pcols,pver) ! convective in-cloud water real(r8) :: cmfdqr(pcols,pver) ! convective production of rain real(r8) :: cldc(pcols,pver) ! convective cloud fraction, currently empty @@ -2015,7 +1945,8 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) integer :: ixcldliq integer :: ixcldice real(r8) :: totcond(pcols, pver) ! total condensate - real(r8) :: solfac ! solubility factor + real(r8) :: solfac(pcols, pver) ! solubility factor + real(r8) :: solfac_in ! solubility factor real(r8) :: scavcoef ! scavenging Coefficient logical :: do_wetdep integer :: ncol ! number of columns @@ -2027,8 +1958,8 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) real(r8) :: sflx(pcols) ! Surface Flux (kg/m2/s) integer :: maxbin - ! physics buffer - integer itim_old, ifld + ! physics buffer + integer itim_old real(r8), pointer, dimension(:,:) :: cldn ! cloud fraction real(r8), pointer, dimension(:,:) :: cme real(r8), pointer, dimension(:,:) :: prain @@ -2045,23 +1976,19 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) ! Initialize the return code. rc = 0 - + ! Initialize the output tendency structure. call physics_ptend_init(ptend,state%psetcols, 'CARMA (wetdep)', lq=lq_carma) if (.not. carma_flag) return - if (.not. carma_do_wetdep) return + if (.not. carma_do_wetdep) return ncol = state%ncol lchnk = state%lchnk - call get_lat_all_p(lchnk, ncol, lat) - call get_lon_all_p(lchnk, ncol, lon) - call get_rlat_all_p(lchnk, ncol, clat) - ! Associate pointers with physics buffer fields itim_old = pbuf_old_tim_idx() - + call pbuf_get_field(pbuf, pbuf_get_index('CLD'), cldn, (/1,1,itim_old/),(/pcols,pver,1/)) call pbuf_get_field(pbuf, pbuf_get_index('QME'), cme ) call pbuf_get_field(pbuf, pbuf_get_index('PRAIN'), prain ) @@ -2080,14 +2007,14 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) call pbuf_get_field(pbuf, pbuf_get_index('DP_FRAC'), dp_frac ) call pbuf_get_field(pbuf, pbuf_get_index('NEVAPR_SHCU'), evapcsh ) call pbuf_get_field(pbuf, pbuf_get_index('NEVAPR_DPCU'), evapcdp ) - + cldc(:ncol,:) = dp_frac(:ncol,:) + sh_frac(:ncol,:) ! Sungsu included this. evapc(:ncol,:) = evapcsh(:ncol,:) + evapcdp(:ncol,:) ! Sungsu included this. clds(:ncol,:) = cldn(:ncol,:) - cldc(:ncol,:) ! Stratiform cloud fraction cmfdqr(:ncol,:) = rprddp(:ncol,:) + rprdsh(:ncol,:) - + ! fields needed for wet scavenging call clddiag( state%t, state%pmid, state%pdel, cmfdqr, evapc, cldn, cldc, clds, cme, evapr, prain, & cldv, cldvcu, cldvst, rainmr, ncol ) @@ -2100,33 +2027,35 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) ! Iterate over each particle and calculate a tendency from wet ! scavenging for it. do ielem = 1, NELEM - + ! NOTE: This can only be done for prognistic groups. - + call CARMAELEMENT_Get(carma, ielem, rc, igroup=igroup) if (rc < 0) call endrun('carma_wetdep_tend::CARMAELEMENT_Get failed.') - + call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, do_wetdep=do_wetdep, & - solfac=solfac, scavcoef=scavcoef, maxbin=maxbin) + solfac=solfac_in, scavcoef=scavcoef, maxbin=maxbin) if (rc < 0) call endrun('carma_wetdep_tend::CARMAGROUP_Get failed.') - + + solfac(:,:) = solfac_in + if ((do_wetdep) .and. (cnsttype == I_CNSTTYPE_PROGNOSTIC)) then - + do ibin = 1, NBIN - + ! Bins past maxbin are treated as diagnostic even if the group ! is prognostic and thus are not advected in the parent model. if (ibin <= maxbin) then - + icnst = icnst4elem(ielem, ibin) - + scavt = 0._r8 - + ! The scavenging coefficient might be calculated as a function of ! the aerosol bin at each grid point. However, for now, we will just ! use a constant value for each group. z_scavcoef(:, :) = scavcoef - + if (cam_physpkg_is('cam5') .or. cam_physpkg_is('cam6')) then call wetdepa_v2( & @@ -2142,20 +2071,20 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) cme, & evapr, & totcond, & - state%q(:, :, icnst), & + state%q(:, :, icnst), & dt, & scavt, & iscavt, & cldvcu, & cldvst, & - dlf, & - fracis(:, :, icnst), & + dlf, & + fracis(:, :, icnst), & solfac, & ncol, & z_scavcoef) - + else if (cam_physpkg_is('cam4')) then - + call wetdepa_v1(state%t, & state%pmid, & state%q, & @@ -2168,20 +2097,20 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) cme, & evapr, & totcond, & - state%q(:, :, icnst), & + state%q(:, :, icnst), & dt, & scavt, & iscavt, & cldv, & - fracis(:, :, icnst), & - solfac, & + fracis(:, :, icnst), & + solfac_in, & ncol, & z_scavcoef) else - + call endrun('carma_wetdep_tend:: No wet deposition routine is available for this configuration.') end if - + ptend%q(:, :, icnst) = scavt call outfld(trim(cnst_name(icnst))//'WD', ptend%q(:, :, icnst), pcols, lchnk) @@ -2189,7 +2118,7 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) ! ptend%q(kg/kg air/s) * pdel(Pa) / gravit (m/s2) => (kg/m2/s) ! note: 1Pa = 1 kg air * (m/s2) / m2 sflx(:) = 0._r8 - + do k = 1,pver sflx(:ncol) = sflx(:ncol) - ptend%q(:ncol, k, icnst) * state%pdel(:ncol,k) / gravit enddo @@ -2197,8 +2126,8 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) call outfld(trim(cnst_name(icnst))//'SW', sflx, pcols, lchnk) ! Add this to the surface amount of the constituent - call CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) - + call CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + end if end do end if @@ -2206,34 +2135,139 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) return end subroutine carma_wetdep_tend - - + + !! This routine creates files containing optical properties for each radiatively !! active particle type. These optical properties are used by the RRTMG radiation !! code to include the impact of CARMA particles in the radiative transfer !! calculation. !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. + !! + !! The I_OPTICS_MIXED_YU2105 and I_OPTICS_SULFATE_YU2015 optics methods are + !! designed to trop_strat models as define in the Yu et al. (2015) paper. The + !! other optics types can be applied more generically to a number of different + !! aerosol/cloud models. + !! !! NOTE: The format of this file is determined by the needs of the radiative tranfer !! code, so ideally a routine would exist in that module that could create a file !! with the proper format. Since that doesn't exist, we do it all here. subroutine CARMA_CreateOpticsFile(carma, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + integer :: igroup + logical :: do_mie + integer :: cnsttype ! constituent type + integer :: opticsType + + ! Assume success. + rc = 0 + + ! Process each group that is defined in the model. + do igroup = 1, NGROUP + + ! Get the necessary group properties. + call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, cnsttype=cnsttype, iopticstype=opticsType) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') + + ! Are we supposed to do the mie calculation for this group? + if ((do_mie) .and. (cnsttype == I_CNSTTYPE_PROGNOSTIC)) then + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + ! This is for fixed composition, but the particle may swell in response + ! to changes in RH. Only one refractive index specified at the group level. + ! + ! NOTE: This is what was used by the first CARMA models that were radiatively + ! active. + case (I_OPTICS_FIXED) + call CARMA_CreateOpticsFile_Fixed(carma, igroup, rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::CreateOpticsFile_Fixed failed.') + + ! This is similar to Yu (2015) in that handles mixed particles treated as + ! core shell particles; however the dimensions of the lookup table are the + ! the radii and the refractive indicies, so it can be used with various + ! aerosol configurations (not just as in the Yu(2015)). + case(I_OPTICS_MIXED_CORESHELL) + call endrun('carma_CreateOpticsFile mixed_coreshell has not been implemented.') + + ! This is similar to MAM4, in that a volume mixing approach is used to + ! mixed both the core and the shell together and thus only one radius and + ! one refractive index are needed in the lookup table. + case(I_OPTICS_MIXED_VOLUME) + call endrun('carma_CreateOpticsFile mixed_volume has not been implemented.') + + ! This is similar to "mixed_volume", except that Maxwell-Garnett mixing + ! is used instead of volume mixing. + case(I_OPTICS_MIXED_MAXWELL) + call endrun('carma_CreateOpticsFile mixed_maxwell has not been implemented.') + + ! This is for a pure sulfate group where the table is based upon weight + ! percent; however, unlike sulfate_Yu, the refractive index of the sulfate + ! changes with the weight percent of H2SO4. + case(I_OPTICS_SULFATE) + call CARMA_CreateOpticsFile_Sulfate(carma, igroup, rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::CreateOpticsFile_Sulfate failed.') + + ! Other types are not generically useful are are particular to the + ! specific model, so thos are handled by model specific code. These + ! include: + ! I_OPTICS_MIXED_YU2015 + ! I_OPTICS_MIXED_YU_H2O + ! I_OPTICS_SULFATE_YU2015 + case default + call CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + end select + end if + end do + + return + end subroutine CARMA_CreateOpticsFile + + + !! This routine creates files containing optical properties for each radiatively + !! active particle type. These optical properties are used by the RRTMG radiation + !! code to include the impact of CARMA particles in the radiative transfer + !! calculation. + !! + !! NOTE: The format of this file is determined by the needs of the radiative tranfer + !! code, so ideally a routine would exist in that module that could create a file + !! with the proper format. Since that doesn't exist, we do it all here. + subroutine CARMA_CreateOpticsFile_Fixed(carma, igroup, rc) use radconstants, only : nswbands, nlwbands use wrap_nf use wetr, only : getwetr - + implicit none type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group index integer, intent(out) :: rc !! return code, negative indicates failure ! Local variables - integer :: igroup, ibin, iwave, irh + integer :: ibin, iwave, irh integer :: irhswell integer :: ienconc real(kind=f) :: rho(NBIN), rhopwet real(kind=f) :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN) real(kind=f) :: wave(NWAVE) - complex(kind=f) :: refidx(NWAVE) + complex(kind=f) :: refidx(NWAVE, NREFIDX) character(len=CARMA_NAME_LEN) :: name character(len=CARMA_SHORT_NAME_LEN) :: shortname logical :: do_mie @@ -2242,16 +2276,16 @@ subroutine CARMA_CreateOpticsFile(carma, rc) integer :: rhvar, lwvar, swvar integer :: abs_lw_var integer :: ext_sw_var, ssa_sw_var, asm_sw_var - integer :: omdim, andim, namedim - integer :: omvar, anvar, namevar + integer :: omdim, andim, namedim + integer :: omvar, anvar, namevar integer :: dimids(2) integer :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar real(kind=f) :: abs_lw(NMIE_RH, nlwbands) real(kind=f) :: ext_sw(NMIE_RH, nswbands) real(kind=f) :: ssa_sw(NMIE_RH, nswbands) real(kind=f) :: asm_sw(NMIE_RH, nswbands) - character(len=8) :: c_name ! constituent name - character(len=32) :: aer_name ! long enough for both aername and name + character(len=8) :: c_name ! constituent name + character(len=32) :: aer_name ! long enough for both aername and name character(len=255) :: filepath real(kind=f) :: rwet real(kind=f) :: Qext @@ -2265,392 +2299,672 @@ subroutine CARMA_CreateOpticsFile(carma, rc) integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? integer :: ret - - + + ! Assume success. rc = 0 - + ! Get the wavelength structure. call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.') - - ! Process each group that is defined in the model. - do igroup = 1, NGROUP - - ! Get the necessary group properties. - call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, name=name, shortname=shortname, r=r, & - rlow=rlow, rup=rup, rmass=rmass, refidx=refidx, irhswell=irhswell, & - ienconc=ienconc, cnsttype=cnsttype, maxbin=maxbin) - if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') - - ! Are we supposed to do the mie calculation for this group? - if ((do_mie) .and. (cnsttype == I_CNSTTYPE_PROGNOSTIC)) then - - call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho) - if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') - - ! A file needs to be created for each bin. - do ibin = 1, NBIN - - ! Bins past maxbin are treated as diagnostic even if the group - ! is prognostic and thus are not advected in the paerent model. - if (ibin <= maxbin) then - - write(c_name, '(A, I2.2)') trim(shortname), ibin - - ! Construct the path to the file. Each model will have its own subdirectory - ! where the optical property files are stored. - filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' - - if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) - - ! Create the file. - call wrap_create(filepath, NF90_CLOBBER, fid) - - ! For non-hygroscopic, only use 1 RH value. - if (irhswell /= 0) then - nrh = NMIE_RH - else - nrh = min(NMIE_RH, 1) - end if - - ! Define the dimensions: rh, lwbands, swbands - call wrap_def_dim(fid, 'rh_idx', nrh, rhdim) - call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) - call wrap_def_dim(fid, 'sw_band', nswbands, swdim) - - write(LUNOPRT,*) "Defined rh_idx, lw_band, and sw_band dims." - - dimids(1) = rhdim - call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1:1), rhvar) - - dimids(1) = lwdim - call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1:1), lwvar) - - dimids(1) = swdim - call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1:1), swvar) - - write(LUNOPRT,*) "Defined rh_idx, lw_band, and sw_band vars." - - call wrap_put_att_text(fid, rhvar, 'units', 'fraction') - call wrap_put_att_text(fid, lwvar, 'units', 'm') - call wrap_put_att_text(fid, swvar, 'units', 'm') - - call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') - call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') - call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') - - ! Define the variables: abs_lw, ext_sw, ssa_sw, asm_sw - dimids(1) = rhdim - dimids(2) = lwdim - call wrap_def_var(fid, 'abs_lw', NF90_DOUBLE, 2, dimids, abs_lw_var) - - write(LUNOPRT,*) "Defined abs_lw." - - call wrap_put_att_text(fid, abs_lw_var, 'units', 'meter^2 kilogram^-1') - - dimids(1) = rhdim - dimids(2) = swdim - call wrap_def_var(fid, 'ext_sw', NF90_DOUBLE, 2, dimids, ext_sw_var) - call wrap_def_var(fid, 'ssa_sw', NF90_DOUBLE, 2, dimids, ssa_sw_var) - call wrap_def_var(fid, 'asm_sw', NF90_DOUBLE, 2, dimids, asm_sw_var) - - write(LUNOPRT,*) "Defined ext_sw, ssa_sw, and asm_sw." - - call wrap_put_att_text(fid, ssa_sw_var, 'units', 'fraction') - call wrap_put_att_text(fid, ext_sw_var, 'units', 'meter^2 kilogram^-1') - call wrap_put_att_text(fid, asm_sw_var, 'units', '-') - - ! Define the variables for the refractive indicies. - dimids(1) = swdim - call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1:1), sw_r_refidx_var) - call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1:1), sw_i_refidx_var) - - write(LUNOPRT,*) "Defined lw refindex." - - dimids(1) = lwdim - call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1:1), lw_r_refidx_var) - call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1:1), lw_i_refidx_var) - - write(LUNOPRT,*) "Defined sw refindex." - - call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') - call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') - call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') - call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') - - call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') - call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') - call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') - call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') - - - ! Define fields that define the aerosol properties. - call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) - dimids(1) = omdim - call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1:1), omvar) - - write(LUNOPRT,*) "Defined omdim." - - call wrap_def_dim(fid, 'namelength', 20, andim) - dimids(1) = andim - call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1:1), anvar) - - write(LUNOPRT,*) "Defined aername." - - call wrap_def_dim(fid, 'name_len', 32, namedim) - dimids(1) = namedim - call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids(1:1), namevar) - - write(LUNOPRT,*) "Defined name." - - call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1:0), denvar) - call wrap_def_var(fid, 'sigma_logr', NF90_DOUBLE, 0, dimids(1:0), slogvar) - call wrap_def_var(fid, 'dryrad', NF90_DOUBLE, 0, dimids(1:0), dryrvar) - call wrap_def_var(fid, 'radmin_aer', NF90_DOUBLE, 0, dimids(1:0), rminvar) - call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1:0), rmaxvar) - call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1:0), hygrovar) - call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1:0), ntmvar) - - call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') - call wrap_put_att_text(fid, slogvar, 'units', '-') - call wrap_put_att_text(fid, dryrvar, 'units', 'm') - call wrap_put_att_text(fid, rminvar, 'units', 'm') - call wrap_put_att_text(fid, rmaxvar, 'units', 'm') - call wrap_put_att_text(fid, hygrovar, 'units', '-') - call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') - - call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') - call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') - call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') - call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') - call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') - call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') - call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') - - - write(LUNOPRT,*) "Defined all variables." - - ! End the defintion phase of the netcdf file. - call wrap_enddef(fid) - - - ! Write out the dimensions. - call wrap_put_var_realx(fid, rhvar, mie_rh(:nrh)) - call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) - call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) - - ! Write out the refractive indicies. - call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidx(nlwbands+1:))) - call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidx(nlwbands+1:))) - call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidx(:nlwbands))) - call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidx(:nlwbands))) - - - ! Pad the names out with spaces. - aer_name = ' ' - aer_name(1:len(trim(c_name))) = c_name - - start_text(1) = 1 - count_text(1) = 32 - call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) - count_text(1) = 20 - call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) - - ! These fields control whether the particle is treated as a CCN. For now, - ! set these so that CARMA particles are not considered as CCN by the - ! CAM microphysics. - if (irhswell /= 0) then - count_text(1) = len('hygroscopic ') - call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic ' /)) + + ! Get the necessary group properties. + call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, name=name, shortname=shortname, r=r, & + rlow=rlow, rup=rup, rmass=rmass, irhswell=irhswell, & + ienconc=ienconc, cnsttype=cnsttype, maxbin=maxbin) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') + + call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho, refidx=refidx) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + + ! A file needs to be created for each bin. + do ibin = 1, NBIN + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + write(c_name, '(A, I2.2)') trim(shortname), ibin + + ! Construct the path to the file. Each model will have its own subdirectory + ! where the optical property files are stored. + filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' + + if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) + + ! Create the file. + call wrap_create(filepath, NF90_CLOBBER, fid) + + ! For non-hygroscopic, only use 1 RH value. + if (irhswell /= 0) then + nrh = NMIE_RH + else + nrh = min(NMIE_RH, 1) + end if + + ! Define the dimensions: rh, lwbands, swbands + call wrap_def_dim(fid, 'rh_idx', nrh, rhdim) + call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) + call wrap_def_dim(fid, 'sw_band', nswbands, swdim) + + write(LUNOPRT,*) "Defined rh_idx, lw_band, and sw_band dims." + + dimids(1) = rhdim + call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1:1), rhvar) + + dimids(1) = lwdim + call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1:1), lwvar) + + dimids(1) = swdim + call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1:1), swvar) + + write(LUNOPRT,*) "Defined rh_idx, lw_band, and sw_band vars." + + call wrap_put_att_text(fid, rhvar, 'units', 'fraction') + call wrap_put_att_text(fid, lwvar, 'units', 'm') + call wrap_put_att_text(fid, swvar, 'units', 'm') + + call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') + call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') + call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') + + ! Define the variables: abs_lw, ext_sw, ssa_sw, asm_sw + dimids(1) = rhdim + dimids(2) = lwdim + call wrap_def_var(fid, 'abs_lw', NF90_DOUBLE, 2, dimids, abs_lw_var) + + write(LUNOPRT,*) "Defined abs_lw." + + call wrap_put_att_text(fid, abs_lw_var, 'units', 'meter^2 kilogram^-1') + + dimids(1) = rhdim + dimids(2) = swdim + call wrap_def_var(fid, 'ext_sw', NF90_DOUBLE, 2, dimids, ext_sw_var) + call wrap_def_var(fid, 'ssa_sw', NF90_DOUBLE, 2, dimids, ssa_sw_var) + call wrap_def_var(fid, 'asm_sw', NF90_DOUBLE, 2, dimids, asm_sw_var) + + write(LUNOPRT,*) "Defined ext_sw, ssa_sw, and asm_sw." + + call wrap_put_att_text(fid, ssa_sw_var, 'units', 'fraction') + call wrap_put_att_text(fid, ext_sw_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, asm_sw_var, 'units', '-') + + ! Define the variables for the refractive indicies. + dimids(1) = swdim + call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1:1), sw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1:1), sw_i_refidx_var) + + write(LUNOPRT,*) "Defined lw refindex." + + dimids(1) = lwdim + call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1:1), lw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1:1), lw_i_refidx_var) + + write(LUNOPRT,*) "Defined sw refindex." + + call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') + + call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') + call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') + + + ! Define fields that define the aerosol properties. + call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) + dimids(1) = omdim + call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1:1), omvar) + + write(LUNOPRT,*) "Defined omdim." + + call wrap_def_dim(fid, 'namelength', 20, andim) + dimids(1) = andim + call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1:1), anvar) + + write(LUNOPRT,*) "Defined aername." + + call wrap_def_dim(fid, 'name_len', 32, namedim) + dimids(1) = namedim + call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids(1:1), namevar) + + write(LUNOPRT,*) "Defined name." + + call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1:0), denvar) + call wrap_def_var(fid, 'sigma_logr', NF90_DOUBLE, 0, dimids(1:0), slogvar) + call wrap_def_var(fid, 'dryrad', NF90_DOUBLE, 0, dimids(1:0), dryrvar) + call wrap_def_var(fid, 'radmin_aer', NF90_DOUBLE, 0, dimids(1:0), rminvar) + call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1:0), rmaxvar) + call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1:0), hygrovar) + call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1:0), ntmvar) + + call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') + call wrap_put_att_text(fid, slogvar, 'units', '-') + call wrap_put_att_text(fid, dryrvar, 'units', 'm') + call wrap_put_att_text(fid, rminvar, 'units', 'm') + call wrap_put_att_text(fid, rmaxvar, 'units', 'm') + call wrap_put_att_text(fid, hygrovar, 'units', '-') + call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') + + call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') + call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') + call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') + call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') + call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') + call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') + call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') + + + write(LUNOPRT,*) "Defined all variables." + + ! End the defintion phase of the netcdf file. + call wrap_enddef(fid) + + ! Write out the dimensions. + call wrap_put_var_realx(fid, rhvar, mie_rh(:nrh)) + call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) + call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) + + ! Write out the refractive indicies. + call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidx(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidx(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidx(:nlwbands, 1))) + call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidx(:nlwbands, 1))) + + + ! Pad the names out with spaces. + aer_name = ' ' + aer_name(1:len(trim(c_name))) = c_name + + start_text(1) = 1 + count_text(1) = 32 + call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) + count_text(1) = 20 + call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) + + ! These fields control whether the particle is treated as a CCN. For now, + ! set these so that CARMA particles are not considered as CCN by the + ! CAM microphysics. + if (irhswell /= 0) then + count_text(1) = len('hygroscopic ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic ' /)) + else + count_text(1) = len('insoluble ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'insoluble ' /)) + end if + + call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) + call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) + call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rminvar, (/ rlow(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, hygrovar, (/ 0._f /)) + call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) + + ! Iterate over a range of relative humidities, since the particle may swell + ! with relative humidity which will change its optical properties. + do irh = 1, nrh + + ! Determine the wet radius. + call getwetr(carma, igroup, mie_rh(irh), r(ibin), rwet, rho(ibin), rhopwet, rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::wetr failed.') + + ! Calculate at each wavelength. + do iwave = 1, NWAVE + + ! Using Mie code, calculate the optical properties: extinction coefficient, + ! single scattering albedo and asymmetry factor. + ! Assume the particle is homogeneous (no core). + ! + ! NOTE: nmon, df, rmon and falpha are only used for fractal particles. + call mie(carma, & + carma%f_group(igroup)%f_imiertn, & + rwet, & + carma%f_wave(iwave), & + real(carma%f_group(igroup)%f_nmon(ibin),kind=f), & + carma%f_group(igroup)%f_df(ibin), & + carma%f_group(igroup)%f_rmon, & + carma%f_group(igroup)%f_falpha, & + refidx(iwave, 1), & + 0.0_f, & + refidx(iwave, 1), & + Qext, & + Qsca, & + asym, & + rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') + + ! Calculate the shortwave and longwave properties? + ! + ! NOTE: miess is in cgs units, but the optics file needs to be in mks + ! units, so perform the necessary conversions. + if (iwave <= nlwbands) then + + ! Longwave just needs absorption: abs_lw. + abs_lw(irh, iwave) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) else - count_text(1) = len('insoluble ') - call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'insoluble ' /)) - end if - - call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) - call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) - call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) - call wrap_put_var_realx(fid, rminvar, (/ rlow(ibin) * 1e-2_f /)) - call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) - call wrap_put_var_realx(fid, hygrovar, (/ 0._f /)) - call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) - - ! Iterate over a range of relative humidities, since the particle may swell - ! with relative humidity which will change its optical properties. - do irh = 1, nrh - - ! Determine the wet radius. - call getwetr(carma, igroup, mie_rh(irh), r(ibin), rwet, rho(ibin), rhopwet, rc) - if (rc < 0) call endrun('carma_CreateOpticsFile::wetr failed.') - - ! Calculate at each wavelength. - do iwave = 1, NWAVE -write(carma%f_LUNOPRT,*) "CARMA mie calc: start ", igroup, ibin, iwave, carma%f_wave(iwave), carma%f_group(igroup)%f_nmon(ibin) - - - ! Using Mie code, calculate the optical properties: extinction coefficient, - ! single scattering albedo and asymmetry factor. - ! Assume the particle is homogeneous (no core). - ! - ! NOTE: nmon, df, rmon and falpha are only used for fractal particles. - call mie(carma, & - carma%f_group(igroup)%f_imiertn, & - rwet, & - carma%f_wave(iwave), & - carma%f_group(igroup)%f_nmon(ibin), & - carma%f_group(igroup)%f_df(ibin), & - carma%f_group(igroup)%f_rmon, & - carma%f_group(igroup)%f_falpha, & - carma%f_group(igroup)%f_refidx(iwave), & - Qext, & - Qsca, & - asym, & - rc) - if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') -write(carma%f_LUNOPRT,*) "CARMA mie calc: done ", Qext, Qsca, asym - - - ! Calculate the shortwave and longwave properties? - ! - ! NOTE: miess is in cgs units, but the optics file needs to be in mks - ! units, so perform the necessary conversions. - if (iwave <= nlwbands) then - - ! Longwave just needs absorption: abs_lw. - abs_lw(irh, iwave) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) - else - - ! Shortwave needs extinction, single scattering albedo and asymmetry factor: - ! ext_sw, ssa_sw and asm_sw. - ext_sw(irh, iwave - nlwbands) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) - ssa_sw(irh, iwave - nlwbands) = Qsca / Qext - asm_sw(irh, iwave - nlwbands) = asym - end if - end do - end do - - ! Write out the longwave fields. - ret = nf90_put_var (fid, abs_lw_var, abs_lw(:nrh, :)) - if (ret/=NF90_NOERR) then - write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', abs_lw_var - call handle_error (ret) - end if - - ! Write out the shortwave fields. - ret = nf90_put_var (fid, ext_sw_var, ext_sw(:nrh, :)) - if (ret/=NF90_NOERR) then - write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', ext_sw_var - call handle_error (ret) - end if - ret = nf90_put_var (fid, ssa_sw_var, ssa_sw(:nrh, :)) - if (ret/=NF90_NOERR) then - write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', ssa_sw_var - call handle_error (ret) - end if - ret = nf90_put_var (fid, asm_sw_var, asm_sw(:nrh, :)) - if (ret/=NF90_NOERR) then - write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', asm_sw_var - call handle_error (ret) + + ! Shortwave needs extinction, single scattering albedo and asymmetry factor: + ! ext_sw, ssa_sw and asm_sw. + ext_sw(irh, iwave - nlwbands) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + ssa_sw(irh, iwave - nlwbands) = Qsca / Qext + asm_sw(irh, iwave - nlwbands) = asym end if - - ! Close the file. - call wrap_close(fid) - end if + end do end do + + ! Write out the longwave fields. + ret = nf90_put_var (fid, abs_lw_var, abs_lw(:nrh, :)) + if (ret/=NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', abs_lw_var + call handle_error (ret) + end if + + ! Write out the shortwave fields. + ret = nf90_put_var (fid, ext_sw_var, ext_sw(:nrh, :)) + if (ret/=NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', ext_sw_var + call handle_error (ret) + end if + ret = nf90_put_var (fid, ssa_sw_var, ssa_sw(:nrh, :)) + if (ret/=NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', ssa_sw_var + call handle_error (ret) + end if + ret = nf90_put_var (fid, asm_sw_var, asm_sw(:nrh, :)) + if (ret/=NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile: error writing varid =', asm_sw_var + call handle_error (ret) + end if + + ! Close the file. + call wrap_close(fid) end if end do - + return - end subroutine CARMA_CreateOpticsFile - - - !! This routine creates a file containing a reference temperature profile - !! for use with fixed initialization. - subroutine CARMA_CreateRefTFile(carma, filepath, lev, reft, rc, refh2o, refh2so4) + end subroutine CARMA_CreateOpticsFile_Fixed + + + + !! This routine creates files containing optical properties for the pure sulfate group + !! following Yu et al. (2015). These optical properties are used by the RRTMG radiation + !! code to include the impact of CARMA particles in the radiative transfer + !! calculation. + subroutine CARMA_CreateOpticsFile_Sulfate(carma, igroup, rc) + use radconstants, only : nswbands, nlwbands use wrap_nf - + use wetr, only : getwetr + implicit none - type(carma_type), intent(inout) :: carma !! the carma object - character(len=*), intent(in) :: filepath !! the file path - real(kind=f), intent(in) :: lev(pver) !! pressure levels - real(kind=f), intent(in) :: reft(pver) !! reference temperature - integer, intent(out) :: rc !! return code, negative indicates failure - real(kind=f), optional, intent(in) :: refh2o(pver) !! reference water vapor - real(kind=f), optional, intent(in) :: refh2so4(pver) !! reference sulfuric acid + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group index + integer, intent(out) :: rc !! return code, negative indicates failure ! Local variables + integer :: ibin, iwave, iwtp + integer :: irhswell + integer :: imiertn + integer :: ienconc + real(kind=f) :: rho(NBIN), rhopwet + real(kind=f) :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN) + real(kind=f) :: wave(NWAVE) + complex(kind=f) :: refidx(NWAVE) + complex(kind=f) :: refidxS(NWAVE, NREFIDX) + complex(kind=f) :: refidxW(NWAVE) + character(len=CARMA_NAME_LEN) :: name + character(len=CARMA_SHORT_NAME_LEN) :: shortname integer :: fid - integer :: levdim - integer :: levvar, tvar, h2ovar, h2so4var + integer :: rhdim, lwdim, swdim, wtpdim + integer :: rhvar, lwvar, swvar, wtp_var + integer :: rwetvar + integer :: abs_lw_wtp_var, qabs_lw_wtp_var + integer :: ext_sw_wtp_var, ssa_sw_wtp_var, asm_sw_wtp_var, qext_sw_wtp_var + integer :: omdim, andim, namedim + integer :: omvar, anvar, namevar integer :: dimids(2) - - + integer :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar + real(kind=f) :: abs_lw_wtp(NMIE_WTP, nlwbands) + real(kind=f) :: qabs_lw_wtp(NMIE_WTP, nlwbands) + real(kind=f) :: ext_sw_wtp(NMIE_WTP, nswbands) + real(kind=f) :: qext_sw_wtp(NMIE_WTP, nswbands) + real(kind=f) :: ssa_sw_wtp(NMIE_WTP, nswbands) + real(kind=f) :: asm_sw_wtp(NMIE_WTP, nswbands) + character(len=8) :: c_name ! constituent name + character(len=32) :: aer_name ! long enough for both aername and name + character(len=255) :: filepath + real(kind=f) :: rwet + real(kind=f) :: Qext + real(kind=f) :: Qsca + real(kind=f) :: asym + integer :: start_text(2), count_text(2) + integer :: sw_r_refidx_var, sw_i_refidx_var, lw_r_refidx_var, lw_i_refidx_var + integer :: cnsttype ! constituent type + integer :: maxbin ! last prognostic bin + integer :: LUNOPRT ! logical unit number for output + logical :: do_print ! do print output? + integer :: ret + real(kind=f) :: volwater + real(kind=f) :: volsulfate + real(kind=f) :: volshell + integer :: igash2o + + ! Assume success. rc = 0 - - ! Create the file. - call wrap_create(filepath, NF90_CLOBBER, fid) - - - ! Define the dimensions: lev - call wrap_def_dim(fid, 'lev', pver, levdim) - - dimids(1) = levdim - call wrap_def_var(fid, 'lev', NF90_DOUBLE, 1, dimids(1:1), levvar) - - call wrap_put_att_text(fid, levvar, 'units', 'level') - call wrap_put_att_text(fid, levvar, 'long_name', 'hybrid level at midpoints (1000*(A+B))') - call wrap_put_att_text(fid, levvar, 'positive', 'down') - call wrap_put_att_text(fid, levvar, 'standard_name', 'atmosphere_hybrid_sigma_pressure_coordinate') - call wrap_put_att_text(fid, levvar, 'formula_terms', 'a: hyam b: hybm p0: P0 ps: PS') - - ! Define the variables: T - call wrap_def_var(fid, 'T', NF90_DOUBLE, 1, dimids(1:1), tvar) - - call wrap_put_att_text(fid, tvar, 'units', 'K') - call wrap_put_att_text(fid, tvar, 'long_name', 'Temperature') - - if ((carma%f_igash2o /= 0) .and. present(refh2o)) then - call wrap_def_var(fid, 'Q', NF90_DOUBLE, 1, dimids(1:1), h2ovar) - - call wrap_put_att_text(fid, h2ovar, 'units', 'kg/kg') - call wrap_put_att_text(fid, h2ovar, 'long_name', 'Specific Humidity') - end if - if ((carma%f_igash2so4 /= 0) .and. present(refh2so4)) then - call wrap_def_var(fid, 'H2SO4', NF90_DOUBLE, 1, dimids(1:1), h2so4var) - - call wrap_put_att_text(fid, h2so4var, 'units', 'kg/kg') - call wrap_put_att_text(fid, h2so4var, 'long_name', 'H2SO4') - end if - - ! End the defintion phase of the netcdf file. - call wrap_enddef(fid) - - - ! Write out the dimensions. - call wrap_put_var_realx(fid, levvar, lev) - - ! Write out the variables. - call wrap_put_var_realx(fid, tvar, reft) - - if ((carma%f_igash2o /= 0) .and. present(refh2o)) then - call wrap_put_var_realx(fid, h2ovar, refh2o(:)) - end if + ! Get the wavelength structure. + call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT, igash2o=igash2o) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.') + + ! Get the necessary group properties. + call CARMAGROUP_Get(carma, igroup, rc, name=name, shortname=shortname, r=r, & + rlow=rlow, rup=rup, rmass=rmass, irhswell=irhswell, & + ienconc=ienconc, cnsttype=cnsttype, maxbin=maxbin, imiertn=imiertn) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.') + + ! Get the necessary element properties. + call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho, refidx=refidxS) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.') + + ! Get the refractive index for water. + call CARMAGAS_Get(carma, igash2o, rc, refidx=refidxW) + if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGAS_Get failed.') + + ! A file needs to be created for each bin. + do ibin = 1, NBIN + + ! Bins past maxbin are treated as diagnostic even if the group + ! is prognostic and thus are not advected in the paerent model. + if (ibin <= maxbin) then + + write(c_name, '(A, I2.2)') trim(shortname), ibin + + ! Construct the path to the file. Each model will have its own subdirectory + ! where the optical property files are stored. + filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc' + + if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath) + + ! Create the file. + call wrap_create(filepath, NF90_CLOBBER, fid) + + ! Define the dimensions: rh, lwbands, swbands + call wrap_def_dim(fid, 'rh_idx', NMIE_RH, rhdim) + call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim) + call wrap_def_dim(fid, 'sw_band', nswbands, swdim) + + call wrap_def_dim(fid, 'wgtpct', NMIE_WTP, wtpdim) + + dimids(1) = rhdim + call wrap_def_var(fid, 'rh', NF90_DOUBLE, 1, dimids(1), rhvar) + call wrap_def_var(fid, 'rwet',NF90_DOUBLE, 1, dimids(1), rwetvar) + + dimids(1) = lwdim + call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1), lwvar) + + dimids(1) = swdim + call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1), swvar) + + dimids(1) = wtpdim + call wrap_def_var(fid, 'wgtpct', NF90_DOUBLE, 1, dimids(1), wtp_var) + + call wrap_put_att_text(fid, rhvar, 'units', 'fraction') + call wrap_put_att_text(fid, rwetvar, 'units', 'cm') + call wrap_put_att_text(fid, lwvar, 'units', 'm') + call wrap_put_att_text(fid, swvar, 'units', 'm') + + call wrap_put_att_text(fid, wtp_var,'units', 'unitless') + call wrap_put_att_text(fid, wtp_var,'long_name', 'weight percent') + + call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity') + call wrap_put_att_text(fid, rwetvar, 'long_name', 'wet radius') + call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands') + call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands') + + ! Define the variables: abs_lw, ext_sw, ssa_sw, asm_sw + ! Define 2-dimension (:nrh,:nswbands) LW optics properties: abs_lw, qabs_lw + dimids(1) = wtpdim + dimids(2) = lwdim + call wrap_def_var(fid, 'abs_lw_wtp', NF90_DOUBLE, 2, dimids(1:2), abs_lw_wtp_var) + call wrap_def_var(fid, 'qabs_lw_wtp',NF90_DOUBLE, 2, dimids(1:2), qabs_lw_wtp_var) + + call wrap_put_att_text(fid, abs_lw_wtp_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, qabs_lw_wtp_var,'units', '-') + + ! Define 2-dimension (:nrh,:nswbands) optics properties: ext_sw, qext_sw, ssa_sw, asm_sw + dimids(1) = wtpdim + dimids(2) = swdim + call wrap_def_var(fid, 'ext_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), ext_sw_wtp_var) + call wrap_def_var(fid, 'qext_sw_wtp',NF90_DOUBLE, 2, dimids(1:2), qext_sw_wtp_var) + call wrap_def_var(fid, 'ssa_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), ssa_sw_wtp_var) + call wrap_def_var(fid, 'asm_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), asm_sw_wtp_var) + + call wrap_put_att_text(fid, ssa_sw_wtp_var, 'units', 'fraction') + call wrap_put_att_text(fid, qext_sw_wtp_var,'units', '-') + call wrap_put_att_text(fid, ext_sw_wtp_var, 'units', 'meter^2 kilogram^-1') + call wrap_put_att_text(fid, asm_sw_wtp_var, 'units', '-') + + ! Define the variables for the refractive indicies. + dimids(1) = swdim + call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_i_refidx_var) + + dimids(1) = lwdim + call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_r_refidx_var) + call wrap_def_var(fid, 'refindex_im_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_i_refidx_var) + + call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-') + call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-') + + call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave') + call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave') + call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave') + + + ! Define fields that define the aerosol properties. + call wrap_def_dim(fid, 'opticsmethod_len', 32, omdim) + dimids(1) = omdim + call wrap_def_var(fid, 'opticsmethod', NF90_CHAR, 1, dimids(1), omvar) + + call wrap_def_dim(fid, 'namelength', 20, andim) + dimids(1) = andim + call wrap_def_var(fid, 'aername', NF90_CHAR, 1, dimids(1), anvar) + + call wrap_def_dim(fid, 'name_len', 32, namedim) + dimids(1) = namedim + call wrap_def_var(fid, 'name', NF90_CHAR, 1, dimids, namevar) + + call wrap_def_var(fid, 'density', NF90_DOUBLE, 0, dimids(1), denvar) + call wrap_def_var(fid, 'sigma_logr', NF90_DOUBLE, 0, dimids(1), slogvar) + call wrap_def_var(fid, 'dryrad', NF90_DOUBLE, 0, dimids(1), dryrvar) + call wrap_def_var(fid, 'radmin_aer', NF90_DOUBLE, 0, dimids(1), rminvar) + call wrap_def_var(fid, 'radmax_aer', NF90_DOUBLE, 0, dimids(1), rmaxvar) + call wrap_def_var(fid, 'hygroscopicity', NF90_DOUBLE, 0, dimids(1), hygrovar) + call wrap_def_var(fid, 'num_to_mass_ratio', NF90_DOUBLE, 0, dimids(1), ntmvar) + + call wrap_put_att_text(fid, denvar, 'units', 'kg m^-3') + call wrap_put_att_text(fid, slogvar, 'units', '-') + call wrap_put_att_text(fid, dryrvar, 'units', 'm') + call wrap_put_att_text(fid, rminvar, 'units', 'm') + call wrap_put_att_text(fid, rmaxvar, 'units', 'm') + call wrap_put_att_text(fid, hygrovar, 'units', '-') + call wrap_put_att_text(fid, ntmvar, 'units', 'kg^-1') + + call wrap_put_att_text(fid, denvar, 'long_name', 'aerosol material density') + call wrap_put_att_text(fid, slogvar, 'long_name', 'geometric standard deviation of aerosol') + call wrap_put_att_text(fid, dryrvar, 'long_name', 'dry number mode radius of aerosol') + call wrap_put_att_text(fid, rminvar, 'long_name', 'minimum dry radius of aerosol for bin') + call wrap_put_att_text(fid, rmaxvar, 'long_name', 'maximum dry radius of aerosol for bin') + call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol') + call wrap_put_att_text(fid, ntmvar, 'long_name', 'ratio of number to mass of aerosol') + + ! End the defintion phase of the netcdf file. + call wrap_enddef(fid) + + ! Write out the dimensions. + call wrap_put_var_realx(fid, rhvar, mie_rh(:)) + call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f) + call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f) + + call wrap_put_var_realx(fid, wtp_var, mie_wtp(:)*100._f) + + ! Write out the refractive indicies. + call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidxS(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidxS(nlwbands+1:, 1))) + call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidxS(:nlwbands, 1))) + call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidxS(:nlwbands, 1))) + + ! Pad the names out with spaces. + aer_name = ' ' + aer_name(1:len(trim(c_name))) = c_name + + start_text(1) = 1 + count_text(1) = 32 + call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /)) + count_text(1) = 20 + call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /)) + + count_text(1) = len('hygroscopic_wtp ') + call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic_wtp ' /)) + + call wrap_put_var_realx(fid, denvar, (/ rho(ibin) * 1e-3_f / 1e-6_f /)) + call wrap_put_var_realx(fid, slogvar, (/ 0._f /)) + call wrap_put_var_realx(fid, dryrvar, (/ r(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rminvar, (/ rlow(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, rmaxvar, (/ rup(ibin) * 1e-2_f /)) + call wrap_put_var_realx(fid, hygrovar, (/ 0.6_f /)) + call wrap_put_var_realx(fid, ntmvar, (/ 1._f / rmass(ibin) / 1e-3_f /)) + + ! For now, ext_sw(:nrh, :nswbands) and ext_sw_coreshell(:nrh, :nswbands, :ncoreshellratio) both are calculated + ! Since other aerosols in CAM may use ext_sw rather than ext_sw_coreshell + ! Modified by Pengfei Yu + ! April.1, 2012 + + ! calculate qext and ext for pure sulfate dependent on weight percent + ! ideally qext is based on (wgt,temp,wave), however Beyer et al. (1996) Figure 5 + ! shows sulfate density is roughly 0.006 g/cm3/k, I negelet temp dimension, assuming temp = 270 K + ! In code, sulfate density is precisely calculated to determine wet raidus + do iwtp = 1, NMIE_WTP + + ! NOTE: Weight percent is normal a result of the getwetr calculation. To build the + ! table based upon weight percent, we need to pass in the desired value and a + ! reference temperature. In that case, the RH is ignored. + call getwetr(carma, igroup, mie_rh(1), r(ibin), rwet, rho(ibin), rhopwet, rc, wgtpct=mie_wtp(iwtp)*100._f, temp=270._f) + if (rc < 0) call endrun('carma_CreateOpticsFile::wetr failed.') + + ! This is not in Yu (2015), but rather than using the refractive + ! index of H2SO4 for the shell, do a volume mix of water and H2SO4 + ! for the refractive index of the shell. + volwater = rwet**3._f - r(ibin)**3._f + volsulfate = r(ibin)**3._f + volshell = volwater + volsulfate + if (volshell > 0._f) then + refidx(:) = (volwater / volshell) * refidxW(:) + (volsulfate / volshell) * refidxS(:, 1) + else + refidx(:) = refidxS(:, 1) + end if + + ! Calculate at each wavelength. + do iwave = 1, NWAVE + + ! Using Mie code, calculate the optical properties: extinction coefficient, + ! single scattering albedo and asymmetry factor. + ! Assume the particle is homogeneous (no core). + ! + ! NOTE: The refractive index for sulfate changes with RH/weight percent, which + ! is not reflected in this code. + call mie(carma, & + imiertn, & + rwet, & + wave(iwave), & + 0._f, & + 3.0_f, & + 0.0_f, & + 1.0_f, & + refidx(iwave), & + 0.0_f, & + refidx(iwave), & + Qext, & + Qsca, & + asym, & + rc) + if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.') + + ! Calculate the shortwave and longwave properties? + ! + ! NOTE: miess is in cgs units, but the optics file needs to be in mks + ! units, so perform the necessary conversions. + if (iwave <= nlwbands) then + + ! Longwave just needs absorption: abs_lw. + qabs_lw_wtp(iwtp, iwave) = (Qext - Qsca) ! absorption per particle + abs_lw_wtp (iwtp, iwave) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + else + + ! Shortwave needs extinction, single scattering albedo and asymmetry factor: + ! ext_sw, ssa_sw and asm_sw. + qext_sw_wtp(iwtp, iwave - nlwbands) = Qext ! extinction per particle + ext_sw_wtp (iwtp, iwave - nlwbands) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f) + ssa_sw_wtp (iwtp, iwave - nlwbands) = Qsca / Qext + asm_sw_wtp (iwtp, iwave - nlwbands) = asym + end if + end do ! iwave + end do ! iwtp + + ! Write out the longwave fields. + ret = nf90_put_var(fid, abs_lw_wtp_var, abs_lw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', fid, abs_lw_wtp_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qabs_lw_wtp_var, qabs_lw_wtp(:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', qabs_lw_wtp_var + call handle_error(ret) + end if + + ! Write out the shortwave fields. + ret = nf90_put_var(fid, ext_sw_wtp_var, ext_sw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', ext_sw_wtp_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, qext_sw_wtp_var,qext_sw_wtp(:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', qext_sw_wtp_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, ssa_sw_wtp_var, ssa_sw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', ssa_sw_wtp_var + call handle_error(ret) + end if + + ret = nf90_put_var(fid, asm_sw_wtp_var, asm_sw_wtp (:, :)) + if (ret /= NF90_NOERR) then + write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', asm_sw_wtp_var + call handle_error(ret) + end if + + ! Close the file. + call wrap_close(fid) + end if + end do - if ((carma%f_igash2so4 /= 0) .and. present(refh2so4)) then - call wrap_put_var_realx(fid, h2so4var, refh2so4(:)) - end if - - ! Close the file. - call wrap_close(fid) - return - end subroutine CARMA_CreateRefTFile - - + end subroutine CARMA_CreateOpticsFile_Sulfate + + !! Calculate the aerodynamic resistance for dry deposition. !! !! This is based upon Seinfeld and Pandis (1998) page 963, and @@ -2661,10 +2975,10 @@ end subroutine CARMA_CreateRefTFile !! @author Tianyi Fan !! @version Aug 2011 subroutine CARMA_calcram(ustar, z0, pdel, pmid, tmid, obklen, ram) - use shr_const_mod, only: shr_const_karman + use shr_const_mod, only: shr_const_karman use physconst, only: rair, gravit - implicit none + implicit none ! input and output argument real(r8), intent(in) :: ustar ! friction velocity @@ -2674,31 +2988,31 @@ subroutine CARMA_calcram(ustar, z0, pdel, pmid, tmid, obklen, ram) real(r8), intent(in) :: tmid ! layer mid-point temperature [K] real(r8), intent(in) :: obklen ! Monin-Obukhov length real(r8), intent(out) :: ram ! aerodynamic resistance - + ! local varibles real(r8) :: z ! half the layer height real(r8) :: psi ! stability parameter for z real(r8) :: psi0 ! stability parameter for z0 - real(r8) :: nu ! temparory variable + real(r8) :: nu ! temparory variable real(r8) :: nu0 ! temparory variable real(r8), parameter :: xkar = shr_const_karman - - + + ! Use half the layer height like Ganzefeld and Lelieveld, 1995 z = pdel * rair * tmid / pmid / gravit / 2._r8 - + if (obklen .eq. 0._r8) then psi = 0._r8 psi0 = 0._r8 else psi = min(max(z / obklen, -1._r8), 1._r8) - psi0 = min(max(z0 / obklen, -1._r8), 1._r8) + psi0 = min(max(z0 / obklen, -1._r8), 1._r8) endif - + ! Stable if (psi > 0._r8) then ram = 1._r8 / xkar / ustar * (log(z / z0) + 4.7_r8 * (psi - psi0)) - + ! Unstable else if (psi < 0._r8) then nu = (1._r8 - 15._r8 *psi)**(.25_r8) @@ -2712,12 +3026,95 @@ subroutine CARMA_calcram(ustar, z0, pdel, pmid, tmid, obklen, ram) else ram = 0._r8 end if - + ! Neutral else ram = 1._r8 / xkar / ustar * log(z / z0) end if - - return - end subroutine CARMA_calcram + + return + end subroutine CARMA_calcram + + !--------------------------------------------------------------------------- + ! define fields for reference profiles in cam restart file + !--------------------------------------------------------------------------- + subroutine CARMA_restart_init( File ) + use cam_pio_utils, only: cam_pio_def_dim + use pio, only: file_desc_t, pio_def_var, pio_double + + ! arguments + type(file_desc_t),intent(inout) :: File ! pio File pointer + + ! local variables + integer :: levid, ierr + + if (carma_do_fixedinit) then + call cam_pio_def_dim(File, 'lev', pver, levid, existOK=.true.) + ierr = pio_def_var(File, 'CARMA_REF_T', pio_double, (/ levid /), t_ref_desc) + ierr = pio_def_var(File, 'CARMA_REF_H2O', pio_double, (/ levid /), h2o_ref_desc) + ierr = pio_def_var(File, 'CARMA_REF_H2SO4', pio_double, (/ levid /), h2so4_ref_desc) + endif + + end subroutine CARMA_restart_init + + !--------------------------------------------------------------------------- + ! write reference profiles to restart file + !--------------------------------------------------------------------------- + subroutine CARMA_restart_write(File) + use pio, only: file_desc_t, pio_put_var + + ! arguments + type(file_desc_t), intent(inout) :: File + + ! local variables + integer ::ierr + + if (carma_do_fixedinit) then + ierr = pio_put_var(File, t_ref_desc, carma_t_ref) + if (carma%f_igash2o /= 0) then + ierr = pio_put_var(File, h2o_ref_desc, carma_h2o_ref) + endif + if (carma%f_igash2So4 /= 0) then + ierr = pio_put_var(File, h2so4_ref_desc, carma_h2so4_ref) + endif + endif + + end subroutine CARMA_restart_write + + !--------------------------------------------------------------------------- + ! read reference profiles from restart file + !--------------------------------------------------------------------------- + subroutine CARMA_restart_read(File) + use pio, only: file_desc_t, pio_inq_varid, pio_get_var + + ! arguments + type(file_desc_t),intent(inout) :: File ! pio File pointer + + ! local variables + integer :: ierr, varid + character(len=*), parameter :: subname = 'CARMA_restart_read: ' + + if (carma_do_fixedinit) then + ierr = pio_inq_varid(File, 'CARMA_REF_T', varid) + if (varid>0) then + ierr = pio_get_var(File, varid, carma_t_ref) + else + call endrun(subname//'restart file must include CARMA_REF_T') + endif + ierr = pio_inq_varid(File, 'CARMA_REF_H2O', varid) + if (varid>0) then + ierr = pio_get_var(File, varid, carma_h2o_ref) + else if (carma%f_igash2o /= 0) then + call endrun(subname//'restart file must include CARMA_REF_H2O') + endif + ierr = pio_inq_varid(File, 'CARMA_REF_H2SO4', varid) + if (varid>0) then + ierr = pio_get_var(File, varid, carma_h2so4_ref) + else if (carma%f_igash2So4 /= 0) then + call endrun(subname//'restart file must include CARMA_REF_H2SO4') + endif + endif + + end subroutine CARMA_restart_read + end module carma_intr diff --git a/src/physics/carma/cam/carma_precision_mod.F90 b/src/physics/carma/cam/carma_precision_mod.F90 index db76f798c6..ae22471312 100644 --- a/src/physics/carma/cam/carma_precision_mod.F90 +++ b/src/physics/carma/cam/carma_precision_mod.F90 @@ -35,4 +35,4 @@ module carma_precision_mod !! Define smallest possible number such that ONE + ALMOST_ZERO > ONE real(kind=f), parameter :: ALMOST_ZERO = epsilon( ONE ) real(kind=f), parameter :: ALMOST_ONE = ONE - ALMOST_ZERO -end module +end module carma_precision_mod diff --git a/src/physics/carma/models/bc_strat/carma_model_mod.F90 b/src/physics/carma/models/bc_strat/carma_model_mod.F90 index 42dc276a01..e4a933dd67 100644 --- a/src/physics/carma/models/bc_strat/carma_model_mod.F90 +++ b/src/physics/carma/models/bc_strat/carma_model_mod.F90 @@ -417,4 +417,4 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) return end subroutine CARMA_WetDeposition -end module +end module carma_model_mod diff --git a/src/physics/carma/models/cirrus/carma_cloudfraction.F90 b/src/physics/carma/models/cirrus/carma_cloudfraction.F90 index 88be7373bb..0ec202041f 100644 --- a/src/physics/carma/models/cirrus/carma_cloudfraction.F90 +++ b/src/physics/carma/models/cirrus/carma_cloudfraction.F90 @@ -24,8 +24,7 @@ subroutine CARMA_CloudFraction(carma, cstate, cam_in, state, icol, cldfrc, rhcri use carma_mod use shr_kind_mod, only: r8 => shr_kind_r8 - use physics_types, only: physics_state, physics_ptend, set_wet_to_dry, & - set_dry_to_wet + use physics_types, only: physics_state, physics_ptend use constituents, only: cnst_get_ind use cam_abortutils, only: endrun diff --git a/src/physics/carma/models/cirrus/carma_model_mod.F90 b/src/physics/carma/models/cirrus/carma_model_mod.F90 index 446a17cdd8..b751221964 100644 --- a/src/physics/carma/models/cirrus/carma_model_mod.F90 +++ b/src/physics/carma/models/cirrus/carma_model_mod.F90 @@ -315,7 +315,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Read in the tables. call wrap_inq_varid(fid, 'wavelength', wave_vid) call wrap_get_var_realx(fid, wave_vid, warren_wave) - warren_wave = warren_wave * 1e-4 ! um -> cm + warren_wave = warren_wave * 1e-4_r8 ! um -> cm call wrap_inq_varid(fid, 'm_real', real_vid) call wrap_get_var_realx(fid, real_vid, warren_real) @@ -1344,7 +1344,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Now integrate the snow distribution. We know the snow amount, but need an effective radius ! to determine the snow number. sub_d = 2._f * (r(NBIN) + (dr(NBIN) / 2._f)) * shapeFactor - sub_dd = (snow_max_d * 1e-4 - sub_d) / NINTS_SNOW + sub_dd = (snow_max_d * 1e-4_r8 - sub_d) / NINTS_SNOW sub_d = sub_d + sub_dd / 2._f remainder = 0._f @@ -1361,7 +1361,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! m = aD^2.1 ! ! NOTE: This needs to match the density assumption made in the detrained ice bins. - remainder = remainder + nsnow / lambda * 4.22e-3_f * (sub_d**2.1) + remainder = remainder + nsnow / lambda * 4.22e-3_f * (sub_d**2.1_r8) sub_d = sub_d + sub_dd end do @@ -1374,7 +1374,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Now integrate the snow distribution. We know the snow amount, but need an effective radius ! to determine the snow number. snow_d = 2._f * ((r(NBIN) + dr(NBIN) / 2._f)) - sub_dd = (snow_max_d * 1e-4 - snow_d) / NINTS_SNOW + sub_dd = (snow_max_d * 1e-4_r8 - snow_d) / NINTS_SNOW sub_d = snow_d + (sub_dd / 2._f) snow_r3 = 0._f @@ -2064,4 +2064,4 @@ subroutine CARMA_CheckMassAndEnergy(carma, cstate, madeSnow, name, state, & return end subroutine CARMA_CheckMassAndEnergy -end module +end module carma_model_mod diff --git a/src/physics/carma/models/cirrus/growevapl.F90 b/src/physics/carma/models/cirrus/growevapl.F90 index e1020eb802..c6659bdbb4 100644 --- a/src/physics/carma/models/cirrus/growevapl.F90 +++ b/src/physics/carma/models/cirrus/growevapl.F90 @@ -216,7 +216,7 @@ subroutine growevapl(carma, cstate, iz, rc) if( x .lt. 1._f )then growlg(ibin,igroup) = dmdt(ibin)/pc(iz,ibin,iepart) & - * ( ar(ibin) - 0.5*dela(ibin)*x + & + * ( ar(ibin) - 0.5_r8*dela(ibin)*x + & (x/2._f - x**2/3._f)*a6(ibin) ) else growlg(ibin,igroup) = dmdt(ibin) / dm(ibin,igroup) diff --git a/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 b/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 index 88be7373bb..0ec202041f 100644 --- a/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 +++ b/src/physics/carma/models/cirrus_dust/carma_cloudfraction.F90 @@ -24,8 +24,7 @@ subroutine CARMA_CloudFraction(carma, cstate, cam_in, state, icol, cldfrc, rhcri use carma_mod use shr_kind_mod, only: r8 => shr_kind_r8 - use physics_types, only: physics_state, physics_ptend, set_wet_to_dry, & - set_dry_to_wet + use physics_types, only: physics_state, physics_ptend use constituents, only: cnst_get_ind use cam_abortutils, only: endrun diff --git a/src/physics/carma/models/cirrus_dust/carma_mod.F90 b/src/physics/carma/models/cirrus_dust/carma_mod.F90 index ab89065690..f6ac6945ae 100644 --- a/src/physics/carma/models/cirrus_dust/carma_mod.F90 +++ b/src/physics/carma/models/cirrus_dust/carma_mod.F90 @@ -1475,4 +1475,4 @@ subroutine CARMA_Get(carma, rc, LUNOPRT, NBIN, NELEM, NGAS, NGROUP, NSOLUTE, NWA return end subroutine CARMA_Get -end module +end module carma_mod diff --git a/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 b/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 index 036e1ea977..0ff512539e 100644 --- a/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 +++ b/src/physics/carma/models/cirrus_dust/carma_model_mod.F90 @@ -335,7 +335,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Read in the tables. call wrap_inq_varid(fid, 'wavelength', wave_vid) call wrap_get_var_realx(fid, wave_vid, warren_wave) - warren_wave = warren_wave * 1e-4 ! um -> cm + warren_wave = warren_wave * 1e-4_r8 ! um -> cm call wrap_inq_varid(fid, 'm_real', real_vid) call wrap_get_var_realx(fid, real_vid, warren_real) @@ -1386,7 +1386,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Now integrate the snow distribution. We know the snow amount, but need an effective radius ! to determine the snow number. sub_d = 2._f * (r(NBIN) + (dr(NBIN) / 2._f)) * shapeFactor - sub_dd = (snow_max_d * 1e-4 - sub_d) / NINTS_SNOW + sub_dd = (snow_max_d * 1e-4_r8 - sub_d) / NINTS_SNOW sub_d = sub_d + sub_dd / 2._f remainder = 0._f @@ -1403,7 +1403,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! m = aD^2.1 ! ! NOTE: This needs to match the density assumption made in the detrained ice bins. - remainder = remainder + nsnow / lambda * 4.22e-3_f * (sub_d**2.1) + remainder = remainder + nsnow / lambda * 4.22e-3_f * (sub_d**2.1_r8) sub_d = sub_d + sub_dd end do @@ -1416,7 +1416,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Now integrate the snow distribution. We know the snow amount, but need an effective radius ! to determine the snow number. snow_d = 2._f * ((r(NBIN) + dr(NBIN) / 2._f)) - sub_dd = (snow_max_d * 1e-4 - snow_d) / NINTS_SNOW + sub_dd = (snow_max_d * 1e-4_r8 - snow_d) / NINTS_SNOW sub_d = snow_d + (sub_dd / 2._f) snow_r3 = 0._f @@ -2570,7 +2570,7 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, ielem, igroup, ibin * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/(r(ibin)*2._r8)**2.5_r8) & / sqrt(1.928_r8*(1331._r8*(r(ibin)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) else - uth = uthfact*1.e-2_r8* 0.13_r8 * sqrt(rhop(ibin)*GRAV*(.75e-4_r8)*2./rhoa) & + uth = uthfact*1.e-2_r8* 0.13_r8 * sqrt(rhop(ibin)*GRAV*(.75e-4_r8)*2._r8/rhoa) & * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/((.75e-4_r8)*2._r8)**2.5_r8) & / sqrt(1.928_r8*(1331._r8*((.75e-4_r8)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) endif @@ -2703,7 +2703,7 @@ subroutine WeibullWind(u, uth, n, uwb, wbk) if (present(wbk)) then k = wbk else - k = 0.94*u**0.5_r8 ! follow Grini and Zender, 2004JGR + k = 0.94_r8*u**0.5_r8 ! follow Grini and Zender, 2004JGR ! k = 2.5_r8 ! Lansing's estimate end if @@ -2718,4 +2718,4 @@ subroutine WeibullWind(u, uth, n, uwb, wbk) end subroutine WeibullWind -end module +end module carma_model_mod diff --git a/src/physics/carma/models/cirrus_dust/growevapl.F90 b/src/physics/carma/models/cirrus_dust/growevapl.F90 index e1020eb802..c6659bdbb4 100644 --- a/src/physics/carma/models/cirrus_dust/growevapl.F90 +++ b/src/physics/carma/models/cirrus_dust/growevapl.F90 @@ -216,7 +216,7 @@ subroutine growevapl(carma, cstate, iz, rc) if( x .lt. 1._f )then growlg(ibin,igroup) = dmdt(ibin)/pc(iz,ibin,iepart) & - * ( ar(ibin) - 0.5*dela(ibin)*x + & + * ( ar(ibin) - 0.5_r8*dela(ibin)*x + & (x/2._f - x**2/3._f)*a6(ibin) ) else growlg(ibin,igroup) = dmdt(ibin) / dm(ibin,igroup) diff --git a/src/physics/carma/models/dust/carma_model_mod.F90 b/src/physics/carma/models/dust/carma_model_mod.F90 index cfd1d3f284..09c96b2bf0 100644 --- a/src/physics/carma/models/dust/carma_model_mod.F90 +++ b/src/physics/carma/models/dust/carma_model_mod.F90 @@ -17,7 +17,7 @@ !! - WeibullWind() !! !! @version July-2012 -!! @author Lin Su, Pengfei Yu, Chuck Bardeen +!! @author Lin Su, Pengfei Yu, Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -46,14 +46,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups @@ -66,6 +71,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -79,8 +88,8 @@ module carma_model_mod integer :: nClay !! Number of clay bins (r < 1 um) integer :: nSilt !! Number of silt bins - real(kind=f) :: clay_mf(NBIN) !! clay mass fraction (fraction) - real(kind=f), allocatable, dimension(:,:) :: soil_factor !! Soil Erosion Factor (fraction) + real(kind=f) :: clay_mf(NBIN) !! clay mass fraction (fraction) + real(kind=f), allocatable, dimension(:,:) :: soil_factor !! Soil Erosion Factor (fraction) contains @@ -88,27 +97,27 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? - real(kind=f), parameter :: RHO_DUST = 2.65_f ! dry density of dust particles (g/cm^3) -Lin Su + real(kind=f), parameter :: RHO_DUST = 2.65_f ! dry density of dust particles (g/cm^3) -Lin Su real(kind=f), parameter :: rmin = 1.19e-5_f ! minimum radius (cm) real(kind=f), parameter :: vmrat = 2.371_f ! volume ratio - + ! Default return code. - rc = RC_OK - + rc = RC_OK + ! Report model specific namelist configuration parameters. if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun("CARMA_DefineModel: CARMA_Get failed.") - + if (rc < 0) call endrun("CARMAMODEL_DefineModel: CARMA_Get failed.") + if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' if (do_print) write(LUNOPRT,*) ' carma_soilerosion_file = ', carma_soilerosion_file @@ -122,38 +131,38 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, 1, "dust", rmin, vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="CRDUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') + - ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="CRDUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - - + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') + + ! Define the Solutes - - + + ! Define the Gases - - + + ! Define the Processes - + return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -169,23 +178,23 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) ! Default return code. rc = RC_OK - + return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -198,32 +207,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -234,22 +243,22 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -258,16 +267,15 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Lin Su, Pengfei Yu, Chuck Bardeen !! @version Dec-2010 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state - use phys_grid, only: get_lon_all_p, get_lat_all_p use camsrfexch, only: cam_in_t use cam_history, only: outfld - + implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -277,16 +285,15 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure - - integer :: ilat(pcols) ! latitude index - integer :: ilon(pcols) ! longitude index + integer :: lchnk ! chunk identifier integer :: ncol ! number of columns in chunk integer :: icol ! column index integer :: igroup ! the index of the carma aerosol group character(len=32) :: shortname ! the shortname of the group - + ! -------- local variables added for dust model ------------ real(r8), parameter :: ch = 0.5e-9_r8 ! dimensional factor & tuning number, ! as it's model resolution dependent (kgs^2/m^5)!!! @@ -295,10 +302,9 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend real(r8) :: uv10 ! 10 m wind speed (m/s) real(r8) :: cd10 ! 10-m drag coefficient () - real(r8) :: wwd ! raw wind speed (m/s) + real(r8) :: wwd ! raw wind speed (m/s) real(r8) :: sp ! mass fraction for soil factor integer :: idustbin ! ibin to use for dust production, smallest silt bin for clay - real(r8) :: soilfact(pcols) ! soil erosion factor (for debug) ! Default return code. rc = RC_OK @@ -307,26 +313,23 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend lchnk = state%lchnk ncol = state%ncol - call get_lat_all_p(lchnk, ncol, ilat) - call get_lon_all_p(lchnk, ncol, ilon) - ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. ! ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to - ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. tendency(:ncol, :pver) = 0.0_r8 - + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) if (RC < RC_ERROR) return - + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r) if (RC < RC_ERROR) return - + if (shortname .eq. "CRDUST") then - + ! Is this clay or silt? ! ! NOTE: It is assumed that 90% of the mass will be silt and 10% will @@ -340,33 +343,31 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend idustbin = ibin else sp = 0.1_r8 / nClay - idustbin = nClay + 1 + idustbin = nClay + 1 end if ! Process each column. do icol = 1,ncol - - call CARMA_SurfaceWind(carma, state, icol, ilat(icol), ilon(icol), ielem, igroup, idustbin, cam_in, uv10, wwd, uth, rc) + + call CARMAMODEL_SurfaceWind(carma, state, icol, ielem, igroup, idustbin, cam_in, uv10, wwd, uth, rc) ! Is the wind above the threshold for dust production? if (uv10 > uth) then - surfaceFlux(icol) = ch * soil_factor(ilat(icol), ilon(icol)) * sp * & - wwd * (uv10 - uth) + surfaceFlux(icol) = ch * soil_factor(icol, lchnk) * sp * & + wwd * (uv10 - uth) endif - - ! Scale the clay bins based upon the smallest silt bin. + + ! Scale the clay bins based upon the smallest silt bin. surfaceFlux(icol) = clay_mf(ibin) * surfaceFlux(icol) - - ! Save off the soil erosion factor so it can be output. - soilfact(icol) = soil_factor(ilat(icol), ilon(icol)) end do ! For debug purposes, output the soil erosion factor. - call outfld('CRSLERFC', soilfact, pcols, lchnk) - end if - + call outfld('CRSLERFC', soil_factor(:ncol, lchnk), ncol, lchnk) + + end if + return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -374,7 +375,7 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use cam_history, only: addfld, add_default, horiz_only use constituents, only: pcnst @@ -383,6 +384,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! -------- local variables ---------- @@ -394,8 +396,8 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) character(len=32) :: shortname ! the shortname of the element integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? - - + + ! Default return code. rc = RC_OK @@ -404,15 +406,15 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! ! TBD: This should use the radii rather than being hard coded. ! nClay = 8 - ! nSilt = NBIN - nClay - do ielem = 1, NELEM + ! nSilt = NBIN - nClay + do ielem = 1, NELEM ! To get particle radius call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname) if (RC < RC_ERROR) return - + call CARMAGROUP_GET(carma, igroup, rc, r=r) if (RC < RC_ERROR) return - + if (shortname .eq. "CRDUST") then count_Silt = 0 do ibin = 1, NBIN @@ -420,27 +422,27 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) count_Silt = count_Silt + 1 else end if - end do + end do nSilt = count_Silt - nClay = NBIN - nSilt - end if + nClay = NBIN - nSilt + end if end do - + ! Read in the soil factors. - call CARMA_ReadSoilErosionFactor(carma, rc) + call CARMAMODEL_ReadSoilErosionFactor(carma, rc) if (RC < RC_ERROR) return - + ! To determine Clay Mass Fraction - do ielem = 1, NELEM + do ielem = 1, NELEM ! To get particle radius call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname) if (RC < RC_ERROR) return if (shortname .eq. "CRDUST") then - call CARMA_ClayMassFraction(carma, igroup, rc) - end if + call CARMAMODEL_ClayMassFraction(carma, igroup, rc) + end if end do - + if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") @@ -448,17 +450,17 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) if (do_print) then write(carma%f_LUNOPRT,*) 'Initializing CARMA dust model ...' write(carma%f_LUNOPRT,*) 'nClay = ', nClay, ' nSilt = ', nSilt - write(carma%f_LUNOPRT,*) 'clay_mf = ', clay_mf + write(carma%f_LUNOPRT,*) 'clay_mf = ', clay_mf write(carma%f_LUNOPRT,*) 'soil_factor = ', soil_factor - + write(carma%f_LUNOPRT,*) 'CARMA dust initialization complete' end if end if - + call addfld('CRSLERFC', horiz_only, 'A', 'fraction', 'CARMA soil erosion factor') - + return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -470,9 +472,9 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon + use pmgrid, only: plev implicit none @@ -493,19 +495,59 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. return - end subroutine CARMA_InitializeParticle - + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -513,14 +555,14 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition !! Determines the mass fraction for the clay (submicron) bins based upon @@ -533,49 +575,49 @@ end subroutine CARMA_WetDeposition !! NOTE: Should any mass go to bins smaller than the smallest one used by !! Tegen and Lacis? !! - !! @version July-2012 - !! @author Lin Su, Pengfei Yu, Chuck Bardeen - subroutine CARMA_ClayMassFraction(carma, igroup, rc) + !! @version July-2012 + !! @author Lin Su, Pengfei Yu, Chuck Bardeen + subroutine CARMAMODEL_ClayMassFraction(carma, igroup, rc) implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: igroup !! the carma group index integer, intent(inout) :: rc !! return code, negative indicates failure ! Bins and mass fraction from Tegen and Lacis. - integer, parameter :: NBIN_TEGEN = 4 + integer, parameter :: NBIN_TEGEN = 4 real(r8) :: tl_rmin(NBIN_TEGEN) = (/ 1.e-5_r8, 1.8e-5_r8, 3.e-5_r8, 6.e-5_r8 /) real(r8) :: tl_rmax(NBIN_TEGEN) = (/ 1.8e-5_r8, 3.e-5_r8, 6.e-5_r8, 1.e-4_r8 /) real(r8) :: tl_mf(NBIN_TEGEN) = (/ 0.009_r8, 0.081_r8, 0.234_r8, 0.676_r8 /) ! Local Variables - integer, parameter :: IBELOW = 1 - integer, parameter :: IABOVE = 6 + integer, parameter :: IBELOW = 1 + integer, parameter :: IABOVE = 6 integer :: tl_count(NBIN_TEGEN+2) ! count number in Tegen and Lacis ranges integer :: ind_up(NBIN_TEGEN+2) integer :: ind_low(NBIN_TEGEN+2) integer :: j ! local index number integer :: ibin ! carma bin index real(r8) :: r(carma%f_NBIN) ! CARMA bin center (cm) - + ! Default return code. rc = RC_OK - + ! Interpolate from Tegen and Lacis. call CARMAGROUP_GET(carma, igroup, rc, r=r) if (RC < RC_ERROR) return - + ! Figure out how many of the CARMA bins are in each of the Tegen and Lacis ! ranges. tl_count(:) = 0 - + do ibin = 1, NBIN - + ! Smaller than the range. if (r(ibin) < tl_rmin(1)) then tl_count(IBELOW) = tl_count(IBELOW) + 1 end if - + ! In the range do j = 1, NBIN_TEGEN if (r(ibin) < tl_rmax(j) .and. r(ibin) >= tl_rmin(j)) then @@ -586,7 +628,7 @@ subroutine CARMA_ClayMassFraction(carma, igroup, rc) ! Bigger than the range. if (r(ibin) >= tl_rmax(NBIN_TEGEN)) then tl_count(IABOVE) = tl_count(IABOVE) + 1 - end if + end if end do ! Determine where the boundaries are between the TEGEN bins and @@ -595,30 +637,30 @@ subroutine CARMA_ClayMassFraction(carma, igroup, rc) ind_low(:) = 0 ind_up (IBELOW) = tl_count(IBELOW) ind_low(IBELOW) = min(1, tl_count(IBELOW)) - + do j = 1, 5 ind_up (j+1) = ind_up(j) + tl_count(j+1) ind_low(j+1) = ind_up(j) + min(tl_count(j+1), 1) end do - + ! No mass to bins smaller than the smallest size. clay_mf(:) = 0._r8 - + ! NOTE: This won't work right if the dust bins are coarser than ! the Tegen and Lacis bins. In this case mass fraction would need - ! to be combined from the Tegen & Lacis bins into a CARMA bin. + ! to be combined from the Tegen & Lacis bins into a CARMA bin. do j = 1, NBIN_TEGEN if (tl_count(j+1) > 0) then clay_mf(ind_low(j+1):ind_up(j+1)) = tl_mf(j) / tl_count(j+1) end if - end do - + end do + clay_mf(ind_low(IABOVE):) = 1._r8 return - end subroutine CARMA_ClayMassFraction + end subroutine CARMAMODEL_ClayMassFraction + - !! Calculate the sea surface wind with a Weibull distribution. !! !! NOTE: This should be combined with a similar routine in the sea salt @@ -627,19 +669,17 @@ end subroutine CARMA_ClayMassFraction !! !! @author Lin Su, Pengfei Yu, Chuck Bardeen !! @version July-2012 - subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, ielem, igroup, ibin, cam_in, uv10, wwd, uth, rc) + subroutine CARMAMODEL_SurfaceWind(carma, state, icol, ielem, igroup, ibin, cam_in, uv10, wwd, uth, rc) use ppgrid, only: pcols, pver use physics_types, only: physics_state use camsrfexch, only: cam_in_t - + implicit none ! in and out field type(carma_type), intent(in) :: carma !! the carma object - type(physics_state), intent(in) :: state !! physics state + type(physics_state), intent(in) :: state !! physics state integer, intent(in) :: icol !! column index - integer, intent(in) :: ilat !! latitude index - integer, intent(in) :: ilon !! longitude index integer, intent(in) :: ielem !! element index integer, intent(in) :: igroup !! group index integer, intent(in) :: ibin !! bin index @@ -652,12 +692,12 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, ielem, igroup, ibin real(r8), parameter :: vk = 0.4_r8 ! von Karman constant real(r8) :: r(NBIN) ! CARMA bin center (cm) real(r8) :: rhop(NBIN) ! CARMA partile element density (g/cm3) - real(r8) :: uthfact ! + real(r8) :: uthfact ! integer :: iepart ! element in group containing the particle concentration real(r8), parameter :: rhoa = 1.25e-3_r8 ! Air density at surface - + rc = RC_OK - + ! Get the 10 meter wind speed uv10 = cam_in%u10(icol) @@ -665,11 +705,11 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, ielem, igroup, ibin ! note that in cgs units --> m/s call CARMAGROUP_GET(carma, igroup, rc, r=r) if (RC < RC_ERROR) return - + ! Define particle # concentration element index for current group call CARMAELEMENT_Get(carma, ielem, rc, rho=rhop) if (RC < RC_ERROR) return - + if (cam_in%soilw(icol) > 0._r8 .AND. cam_in%soilw(icol) < 0.5_r8) then uthfact = 1.2_r8 + 0.2_r8*log10(cam_in%soilw(icol)) if (r(ibin) > 2.825e-5_r8) then ! r(4) = 2.825e-5 cm @@ -677,19 +717,19 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, ielem, igroup, ibin * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/(r(ibin)*2._r8)**2.5_r8) & / sqrt(1.928_r8*(1331._r8*(r(ibin)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) else - uth = uthfact*1.e-2_r8* 0.13_r8 * sqrt(rhop(ibin)*GRAV*(.75e-4_r8)*2./rhoa) & + uth = uthfact*1.e-2_r8* 0.13_r8 * sqrt(rhop(ibin)*GRAV*(.75e-4_r8)*2._r8/rhoa) & * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/((.75e-4_r8)*2._r8)**2.5_r8) & / sqrt(1.928_r8*(1331._r8*((.75e-4_r8)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8) endif else uth = uv10 - endif + endif ! Use Weibull with Lansing's estimate for shape. call WeibullWind(uv10, uth, 2._r8, wwd) return - end subroutine CARMA_SurfaceWind + end subroutine CARMAMODEL_SurfaceWind !! Read in the dust source (soil) erodibility factor from a NETCDF file. In this @@ -701,12 +741,13 @@ end subroutine CARMA_SurfaceWind !! !! @author Pengfei Yu !! @version July-2012 - subroutine CARMA_ReadSoilErosionFactor(carma, rc) - use pmgrid, only: plat, plon - use ioFileMod, only: getfil + subroutine CARMAMODEL_ReadSoilErosionFactor(carma, rc) + use ppgrid, only: begchunk, endchunk, pcols + use ioFileMod, only: getfil use wrap_nf - use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish - + use interpolate_data, only: lininterp_init, lininterp, interp_type, lininterp_finish + use phys_grid, only: get_rlon_all_p, get_rlat_all_p, get_ncols_p + implicit none type(carma_type), intent(in) :: carma !! the carma object @@ -715,79 +756,81 @@ subroutine CARMA_ReadSoilErosionFactor(carma, rc) ! local variables integer :: idvar, f_nlon, f_nlat, idlat, idlon integer :: fid, fid_lon, fid_lat - real(r8), allocatable, dimension(:,:) :: ero_factor, ero_factor1 + real(r8), allocatable, dimension(:,:) :: ero_factor character(len=256) :: ero_file real(r8), allocatable, dimension(:) :: ero_lat ! latitude dimension real(r8), allocatable, dimension(:) :: ero_lon ! latitude dimension - type (interp_type) :: wgt1, wgt2 - real(r8) :: lat(plat), lon(plon) - integer :: i + type (interp_type) :: lat_wght, lon_wght + real(r8) :: lat(pcols) ! latitude index + real(r8) :: lon(pcols) ! longitude index + integer :: i, ii + integer :: lchnk ! chunk identifier + integer :: ncol ! number of columns in chunk + + real(r8), parameter :: zero=0_r8, twopi=2_r8*pi, degs2rads = pi/180._r8 rc = RC_OK ! Open the netcdf file (read only) call getfil(carma_soilerosion_file, ero_file, 0) call wrap_open(ero_file, 0, fid) - + ! Get file dimensions call wrap_inq_dimid(fid, 'plon', fid_lon) call wrap_inq_dimid(fid, 'plat', fid_lat) call wrap_inq_dimlen(fid, fid_lon, f_nlon) call wrap_inq_dimlen(fid, fid_lat, f_nlat) - + allocate(ero_lat(f_nlat)) allocate(ero_lon(f_nlon)) allocate(ero_factor (f_nlon, f_nlat)) - allocate(ero_factor1(plon, plat)) - allocate(soil_factor(plat, plon)) - + allocate(soil_factor(pcols, begchunk:endchunk)) + ! Read in the tables. call wrap_inq_varid(fid, 'new_source', idvar) i = nf90_get_var (fid, idvar, ero_factor) if (i/=NF90_NOERR) then - write(iulog,*)'CARMA_ReadSoilErosionFactor: error reading varid =', idvar + write(iulog,*)'CARMAMODEL_ReadSoilErosionFactor: error reading varid =', idvar call handle_error (i) end if call wrap_inq_varid(fid, 'plat', idlat) call wrap_get_var_realx(fid, idlat, ero_lat) call wrap_inq_varid(fid, 'plon', idlon) call wrap_get_var_realx(fid, idlon, ero_lon) - + + ero_lat(:) = ero_lat(:)*degs2rads + ero_lon(:) = ero_lon(:)*degs2rads + ! Close the file. call wrap_close(fid) - - ! NOTE: Is there a better way to get all of the dimensions - ! needed for the model grid? Seems like it shouldn't be hard - ! coded here. - do i = 1, plat - lat(i) = 180._r8 / (plat-1) * (i-1) - 90._r8 - end do - - do i = 1, plon - lon(i) = 360._r8 / plon * (i-1) + + do lchnk=begchunk, endchunk + ncol = get_ncols_p(lchnk) + + call get_rlat_all_p(lchnk, pcols, lat) + call get_rlon_all_p(lchnk, pcols, lon) + + call lininterp_init(ero_lon, f_nlon, lon, ncol, 2, lon_wght, zero, twopi) + call lininterp_init(ero_lat, f_nlat, lat, ncol, 1, lat_wght) + + call lininterp(ero_factor, f_nlon, f_nlat, soil_factor(1:ncol,lchnk), ncol, lon_wght, lat_wght) + + call lininterp_finish(lon_wght) + call lininterp_finish(lat_wght) end do - - call lininterp_init(ero_lat, f_nlat, lat, plat, 1, wgt1) - call lininterp_init(ero_lon, f_nlon, lon, plon, 1, wgt2) - call lininterp(ero_factor, f_nlon, f_nlat, ero_factor1, plon, plat, wgt2, wgt1) - call lininterp_finish(wgt1) - call lininterp_finish(wgt2) - - soil_factor(:plat, :plon) = transpose(ero_factor1(:plon, :plat)) - + deallocate(ero_lat) deallocate(ero_lon) deallocate(ero_factor) - deallocate(ero_factor1) - + return - end subroutine CARMA_ReadSoilErosionFactor + end subroutine CARMAMODEL_ReadSoilErosionFactor !! Calculate the nth mean of u using Weibull wind distribution !! considering the threshold wind velocity. This algorithm !! integrates from uth to infinite (u^n P(u)du ) - !! + !! !! @author Tianyi Fan !! @version August-2010 subroutine WeibullWind(u, uth, n, uwb, wbk) @@ -796,33 +839,121 @@ subroutine WeibullWind(u, uth, n, uwb, wbk) igamma => shr_spfn_igamma implicit none - + real(r8), intent(in) :: u ! mean wind speed real(r8), intent(in) :: uth ! threshold velocity real(r8), intent(in) :: n ! the rank of u in the integration real(r8), intent(out) :: uwb ! the Weibull distribution real(r8), intent(in), optional :: wbk ! the shape parameter - + ! local variable real(r8) :: k ! the shape parameter in Weibull distribution real(r8) :: c ! the scale parameter in Weibull distribution - + if (present(wbk)) then k = wbk else - k = 0.94*u**0.5_r8 ! follow Grini and Zender, 2004JGR + k = 0.94_r8*u**0.5_r8 ! follow Grini and Zender, 2004JGR ! k = 2.5_r8 ! Lansing's estimate - end if - + end if + ! If u is 0, then k can be 0, which makes a lot of this undefined. ! Just return 0. in this case. if (u == 0._r8) then uwb = 0._r8 - else - c = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8) + else + c = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8) uwb = c**n * igamma(n / k + 1._r8, (uth / c)**k) end if end subroutine WeibullWind - -end module + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics + +end module carma_model_mod diff --git a/src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 b/src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 index 360ddb9499..efe43af66d 100644 --- a/src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 +++ b/src/physics/carma/models/meteor_impact/carma_model_flags_mod.F90 @@ -24,16 +24,16 @@ module carma_model_flags_mod ! ! Create a public definition of any new namelist variables that you wish to have, ! and default them to an inital value. - real(r8), public :: carma_emis_dust = 0._r8 !! Total dust emission for the event (kg) - real(r8), public :: carma_emis_soot = 0._r8 !! Total soot emission for the event (kg) - integer, public :: carma_emis_startdate = 1 !! start year and day of year (yyyyddd) - integer, public :: carma_emis_stopdate = 1 !! stop year and day of year (yyyyddd) - integer, public :: carma_emis_starttime = 0 !! start time of day (s) - integer, public :: carma_emis_stoptime = 0 !! stop time of day (s) - real(r8), public :: carma_emis_minlat = -90. !! minimum latitude - real(r8), public :: carma_emis_maxlat = 90. !! maximum latitude - real(r8), public :: carma_emis_minlon = 0. !! minimum longitude - real(r8), public :: carma_emis_maxlon = 360. !! maximum longitude + real(r8), public :: carma_emis_dust = 0._r8 !! Total dust emission for the event (kg) + real(r8), public :: carma_emis_soot = 0._r8 !! Total soot emission for the event (kg) + integer, public :: carma_emis_startdate = 1 !! start year and day of year (yyyyddd) + integer, public :: carma_emis_stopdate = 1 !! stop year and day of year (yyyyddd) + integer, public :: carma_emis_starttime = 0 !! start time of day (s) + integer, public :: carma_emis_stoptime = 0 !! stop time of day (s) + real(r8), public :: carma_emis_minlat = -90._r8 !! minimum latitude + real(r8), public :: carma_emis_maxlat = 90._r8 !! maximum latitude + real(r8), public :: carma_emis_minlon = 0._r8 !! minimum longitude + real(r8), public :: carma_emis_maxlon = 360._r8 !! maximum longitude logical, public :: carma_fractal_soot = .false. !! fractal Soot contains diff --git a/src/physics/carma/models/meteor_impact/carma_model_mod.F90 b/src/physics/carma/models/meteor_impact/carma_model_mod.F90 index d60aa02bee..ecc131f0cf 100755 --- a/src/physics/carma/models/meteor_impact/carma_model_mod.F90 +++ b/src/physics/carma/models/meteor_impact/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -14,8 +14,8 @@ !! preliminary. Please talk to Chuck Bardeen (bardeenc@ucar.edu) if you are !! interested in this model. !! -!! @version Oct-2012 -!! @author Chuck Bardeen +!! @version Oct-2012 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -30,7 +30,7 @@ module carma_model_mod use carma_mod use carma_flags_mod use carma_model_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use cam_abortutils, only: endrun use physics_types, only: physics_state, physics_ptend @@ -42,15 +42,20 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition - + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition + ! Declare public constants integer, public, parameter :: NGROUP = 2 !! Number of particle groups integer, public, parameter :: NELEM = 2 !! Number of particle elements @@ -64,7 +69,11 @@ module carma_model_mod !! humidities. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) = (/ 0._f, 0.5_f, 0.7_f, 0.8_f, 0.9_f, 0.95_f, 0.98_f, 0.99_f /) - + + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -81,8 +90,8 @@ module carma_model_mod integer, public, parameter :: I_ELEM_DUST = 1 !! dust aerosol element integer, public, parameter :: I_ELEM_SOOT = 2 !! soot aerosol element - - + + integer :: carma_dustmap(NBIN) !! mapping of the CARMA dust bins to the surface dust bins. real(kind=f) :: carma_dustbinfactor(NBIN) !! bin weighting factor for dust emissions real(kind=f) :: carma_sootbinfactor(NBIN) !! bin weighting factor for soot emissions @@ -94,12 +103,12 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_DUST = 2.0_f ! density of dust particles (g/cm) real(kind=f) :: RHO_SOOT ! density of soot particles (g/cm) @@ -107,7 +116,7 @@ subroutine CARMA_DefineModel(carma, rc) real(kind=f), parameter :: dust_vmrat = 2.49_f ! dust volume ratio real(kind=f), parameter :: soot_rmin = 20.e-7_f ! dust minimum radius (cm) real(kind=f), parameter :: soot_vmrat = 2.49_f ! dust volume ratio - complex(kind=f) :: refidx(NWAVE) ! refractice indices + complex(kind=f) :: refidx(NWAVE,NREFIDX) ! refractice indices integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? @@ -121,16 +130,16 @@ subroutine CARMA_DefineModel(carma, rc) ! Adjust longitudes to be 0 to 360 rather than +- 180. if (carma_emis_minlon < 0._f) carma_emis_minlon = 360._f + carma_emis_minlon if (carma_emis_maxlon < 0._f) carma_emis_maxlon = 360._f + carma_emis_maxlon - + if (carma_emis_minlat > carma_emis_maxlat) then - if (do_print) write(LUNOPRT,*) 'CARMA_DefineModel::ERROR - carma_emis_minlat greater than carma_emis_maxlat' + if (do_print) write(LUNOPRT,*) 'CARMAMODEL_DefineModel::ERROR - carma_emis_minlat greater than carma_emis_maxlat' end if - + ! Report model specific namelist configuration parameters. if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") - + if (rc < 0) call endrun("CARMAMODEL_DefineModel: CARMA_Get failed.") + if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' if (do_print) write(LUNOPRT,*) ' carma_emis_dust = ', carma_emis_dust, ' (kg)' @@ -154,20 +163,11 @@ subroutine CARMA_DefineModel(carma, rc) ! defined. If wetdep is defined, then the optional solubility factor ! should also be defined. - ! Use the same refractive index at all wavelengths. This value is typical of soot and - ! is recommended by Toon et al. 2012. TBD Wagner et al. 2011 shows variability in the - ! real part (0.003 (IR) to 0.05 (UV)). - refidx(:) = (1.53_f, 0.008_f) - call CARMAGROUP_Create(carma, I_GRP_DUST, "Dust", dust_rmin, dust_vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & - scavcoef=0.1_f, shortname="CRDUST", refidx=refidx, do_mie=.true.) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + scavcoef=0.1_f, shortname="CRDUST", do_mie=.true.) + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') - ! Use the same refractive index at all wavelengths. This value is typical of soot and - ! is recommended by Toon et al. 2012. - refidx(:) = (1.8_f, 0.67_f) - if (carma_fractal_soot) then RHO_SOOT = 1.8_f @@ -178,60 +178,70 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, I_GRP_SOOT, "Soot", soot_rmin, soot_vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.1_f, & - scavcoef=0.1_f, shortname="CRSOOT", refidx=refidx, do_mie=.true., & + scavcoef=0.1_f, shortname="CRSOOT", do_mie=.true., & is_fractal=.true., rmon=soot_rmon, df=soot_df, falpha=soot_falpha, & imiertn=I_MIERTN_BOTET1997) else RHO_SOOT = 1.0_f call CARMAGROUP_Create(carma, I_GRP_SOOT, "Soot", soot_rmin, soot_vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.1_f, & - scavcoef=0.1_f, shortname="CRSOOT", refidx=refidx, do_mie=.true.) + scavcoef=0.1_f, shortname="CRSOOT", do_mie=.true.) end if - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - - + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') + + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. - call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="CRDUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - call CARMAELEMENT_Create(carma, I_ELEM_SOOT, I_GRP_SOOT, "Soot", RHO_SOOT, I_INVOLATILE, I_SOOT, rc, shortname="CRSOOT") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + ! Use the same refractive index at all wavelengths. This value is typical of dust and + ! is recommended by Toon et al. 2012. TBD Wagner et al. 2011 shows variability in the + ! real part (0.003 (IR) to 0.05 (UV)). + refidx(:,1) = CMPLX(1.53_f, 0.008_f, kind=f) + + call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="CRDUST", refidx=refidx) + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') + + ! Use the same refractive index at all wavelengths. This value is typical of soot and + ! is recommended by Toon et al. 2012. + refidx(:,1) = CMPLX(1.8_f, 0.67_f, kind=f) + + call CARMAELEMENT_Create(carma, I_ELEM_SOOT, I_GRP_SOOT, "Soot", RHO_SOOT, I_INVOLATILE, I_SOOT, rc, shortname="CRSOOT", refidx=refidx) + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') + - ! Define the Solutes - + ! Define the Gases - + ! Define the Processes call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') call CARMA_AddCoagulation(carma, I_GRP_SOOT, I_GRP_SOOT, I_GRP_SOOT, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -241,27 +251,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -270,32 +280,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return - end subroutine CARMA_DiagnoseBins - - + end subroutine CARMAMODEL_DiagnoseBins + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -306,14 +316,14 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + integer :: ielem ! element index integer :: ibin ! bin index real(r8) :: mmr(pver) ! mass mixing ration (kg/kg) @@ -327,19 +337,19 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, ! NOTE: Don't give the surface model negative values for the surface fluxes. ielem = I_ELEM_SOOT do ibin = 1, NBIN - + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, sedimentationFlux=sflx) - if (rc < 0) call endrun('CARMA_DiagnoseBulk::CARMA_GetBin failed.') - + if (rc < 0) call endrun('CARMAMODEL_DiagnoseBulk::CARMA_GetBin failed.') + cam_out%bcphidry(icol) = cam_out%bcphidry(icol) + max(sflx, 0._r8) end do ielem = I_ELEM_DUST do ibin = 1, NBIN - + call CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, sedimentationFlux=sflx) - if (rc < 0) call endrun('CARMA_DiagnoseBulk::CARMA_GetBin failed.') - + if (rc < 0) call endrun('CARMAMODEL_DiagnoseBulk::CARMA_GetBin failed.') + if (carma_dustmap(ibin) == 1) then cam_out%dstdry1(icol) = cam_out%dstdry1(icol) + max(sflx, 0._r8) else if (carma_dustmap(ibin) == 2) then @@ -350,9 +360,9 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, cam_out%dstdry4(icol) = cam_out%dstdry4(icol) + max(sflx, 0._r8) end if end do - + return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -361,18 +371,18 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & is_perpetual, is_first_step use camsrfexch, only: cam_in_t - use tropopause, only: tropopause_find + use tropopause, only: tropopause_find_cam use physconst, only: gravit - + implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -382,17 +392,18 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure - + real(r8), parameter :: mu_dust_gnd = 1._r8 ! width parameter, dust, ground (km) real(r8), parameter :: mu_dust_trop = 3._r8 ! width parameter, dust, tropopause (km) real(r8), parameter :: mu_soot_gnd = 1._r8 ! width parameter, soot, ground (km) real(r8), parameter :: mu_soot_trop = 3._r8 ! width parameter, soot, tropopause (km) - integer :: tropLev(pcols) ! tropopause level index - real(r8) :: tropP(pcols) ! tropopause pressure (Pa) - real(r8) :: tropT(pcols) ! tropopause temperature (K) - real(r8) :: tropZ(pcols) ! tropopause height (m) + integer :: tropLev(pcols) ! tropopause level index + real(r8) :: tropP(pcols) ! tropopause pressure (Pa) + real(r8) :: tropT(pcols) ! tropopause temperature (K) + real(r8) :: tropZ(pcols) ! tropopause height (m) real(r8) :: lon(state%ncol) ! longitude real(r8) :: lat(state%ncol) ! latitude @@ -434,14 +445,14 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! Determine the latitude and longitude of each column. ncol = state%ncol - + lat = state%lat(:ncol) * RAD2DEG lon = state%lon(:ncol) * RAD2DEG - - + + ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. ! ! Use Toon et al. [2012] as the source function for soot and dust @@ -456,13 +467,13 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! NOTE: Perhaps some of these fields should end up in the CARMA ! model namelist, so different experiments can be run more easily. tendency(:ncol, :pver) = 0.0_r8 - + ! Determine the start and stop year and day of year from the namelist ! variables. currentDate = yr * 1000 + doy startyear = carma_emis_startdate / 1000 stopyear = carma_emis_stopdate / 1000 - + startdoy = mod(carma_emis_startdate, 1000) stopdoy = mod(carma_emis_stopdate, 1000) @@ -471,48 +482,51 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ((currentDate == carma_emis_startdate) .and. (ncsec >= carma_emis_starttime))) .and. & ((currentDate < carma_emis_stopdate) .or. & ((currentDate == carma_emis_stopdate) .and. (ncsec < carma_emis_stoptime)))) then - + ! Make sure to emit for at least one timestep and in multiples of the time ! step length. ! TBD - This has a leap year problem, but works otherwise ... carma_emis_dtime = INT((((stopyear - startyear) * 365._f + (stopdoy - startdoy)) * 24._f * 3600._f + & (carma_emis_stoptime - carma_emis_starttime)) / dt) * dt - + ! For simplicity, calculate the emission function at the cell midpoint and ! assume that rate is used throughout the cell. call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) if (RC < RC_ERROR) return - + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname) if (RC < RC_ERROR) return - + if ((shortname == "CRDUST") .or. (shortname == "CRSOOT")) then ! Find the tropopause using the default algorithm backed by the climatology. - call tropopause_find(state, tropLev, tropZ=tropZ) - + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + troplev(:) = 0 + !REMOVECAM_END + call tropopause_find_cam(state, tropLev, tropZ=tropZ) + ! Loop over all of the columns. do icol = 1, ncol - + ! Is the column one of the ones over which there should be emissions> if ((lat(icol) > carma_emis_minlat) .and. (lat(icol) < carma_emis_maxlat) .and. & (((carma_emis_minlon <= carma_emis_maxlon) .and. (lon(icol) >= carma_emis_minlon) .and. & (lon(icol) <= carma_emis_maxlon)) .or. & ((carma_emis_minlon > carma_emis_maxlon) .and. & ((lon(icol) >= carma_emis_minlon) .or. (lon(icol) <= carma_emis_maxlon))))) then - + ! Set tendencies for any sources or sinks in the atmosphere. do k = 1, pver - + ! Get the cell midpoint and height zmid = state%zm(icol, k) / 1000._f - + ! Get the tropopause height. ztrop = tropZ(icol) / 1000._f - - ! Use the dust emission from Toon et al. 2012. + + ! Use the dust emission from Toon et al. 2012. if (shortname == "CRDUST") then - + ! Determine the total emission rate for this grid box using equation 2 ! from Toon et al. [2012] and also adjust for the fraction of the ! mass that goes into the specified bin based on the assumed size @@ -521,13 +535,13 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend (1._f / mu_dust_gnd * exp(-0.5_f * ((zmid / mu_dust_gnd)**2)) + & 1._f / (2._f * mu_dust_trop) * exp(-0.5_f * (((zmid - ztrop) / mu_dust_trop)**2))) * & (state%zi(icol, k) - state%zi(icol, k+1)) - + rate = carma_emis_dust * carma_dustbinfactor(ibin) end if - + ! Use the soot emissions from Toon et al. 2012. if (shortname == "CRSOOT") then - + ! Determine the total emission rate for this grid box using equation 2 ! from Toon et al. [2012] and also adjust for the fraction of the ! mass that goes into the specified bin based on the assumed size @@ -536,31 +550,31 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend (1._f / mu_soot_gnd * exp(-0.5_f * ((zmid / mu_soot_gnd)**2)) + & 1._f / (2._f * mu_soot_trop) * exp(-0.5_f * (((zmid - ztrop) / mu_soot_trop)**2))) * & (state%zi(icol, k) - state%zi(icol, k+1)) - - + + rate = carma_emis_soot * carma_sootbinfactor(ibin) end if - + ! Calculate a rate by dividing by total emission time. rate = rate * vfunc(k) / carma_emis_dtime - + ! Scale for the fraction of the total surface area that is emitting and ! convert to kg/m2/s massflux = rate / carma_emis_area - + ! Convert the mass flux to a tendency on the mass mixing ratio. tendency(icol, k) = massflux / (state%pdel(icol, k) / gravit) end do - + ! Now normalize in the vertical to preserve the total mass. tendency(icol, :) = tendency(icol, :) / sum(vfunc(:)) end if end do end if end if - + return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -571,28 +585,29 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only: pcnst - use dyn_grid, only: get_horiz_grid_dim_d, get_horiz_grid_d + use phys_grid, only: get_rlat_all_p, get_rlon_all_p, get_area_all_p, get_ncols_p + use shr_reprosum_mod, only: shr_reprosum_calc + use ppgrid, only: begchunk, endchunk + use spmd_utils, only: mpicom implicit none - + type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure - + ! NOTE: The dust distribution has not been specified yet, but it should be different ! from the soot. - real(kind=f), parameter :: rm_dust = 0.11 ! dust mean radius (um) - real(kind=f), parameter :: sigma_dust = 1.6 ! dust variance - real(kind=f), parameter :: rm_soot = 0.11 ! soot mean radius (um) - real(kind=f), parameter :: sigma_soot = 1.6 ! soot variance + real(kind=f), parameter :: rm_dust = 0.11_r8 ! dust mean radius (um) + real(kind=f), parameter :: sigma_dust = 1.6_r8 ! dust variance + real(kind=f), parameter :: rm_soot = 0.11_r8 ! soot mean radius (um) + real(kind=f), parameter :: sigma_soot = 1.6_r8 ! soot variance integer :: i - integer :: hdim1_d - integer :: hdim2_d - integer :: ngcols real(kind=f) :: r(NBIN) real(kind=f) :: dr(NBIN) real(kind=f) :: rmass(NBIN) @@ -600,12 +615,16 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) real(kind=f), allocatable :: lat(:) real(kind=f), allocatable :: lon(:) real(kind=f), allocatable :: colarea(:) + real(kind=f), allocatable :: local_carma_emis_area(:,:) character(len=32) :: shortname ! the shortname of the group - + integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? - 1 format(i3,5x,i3,4x,e10.3,4x,e10.3) + integer :: kk, lchnk, ncol + real(kind=f) :: wrk(1) + + 1 format(i3,5x,i3,4x,e10.3,4x,e10.3) ! Default return code. rc = RC_OK @@ -620,7 +639,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! 4 : 5.0 - 10.0 um call CARMAGROUP_GET(carma, I_GRP_DUST, rc, r=r) if (RC < RC_ERROR) return - + do i = 1, NBIN if (r(i) .le. 1e-4_f) then carma_dustmap(i) = 1 @@ -632,65 +651,73 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) carma_dustmap(i) = 4 end if end do - + ! Determine the weight of mass in each bin based upon the size distribution specified ! in Toon et al. [2012], for soot and dust. They are lognormal for the smaller sizes ! and dust is lognormal for larger sizes. - + call CARMAGROUP_GET(carma, I_GRP_DUST, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) if (RC < RC_ERROR) return - + dM(:) = rmass(:) * & exp(-(log(r(:) * 1e4_f / rm_dust) ** 2) / (2._f * (log(sigma_dust) ** 2))) / & log(sigma_dust) * (dr(:) / r(:)) - carma_dustbinfactor(:) = dM / sum(dM) + carma_dustbinfactor(:) = dM / sum(dM) call CARMAGROUP_GET(carma, I_GRP_SOOT, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) if (RC < RC_ERROR) return - + dM(:) = rmass(:) * & exp(-(log(r(:) * 1e4_f / rm_soot) ** 2) / (2._f * (log(sigma_soot) ** 2))) / & log(sigma_soot) * (dr(:) / r(:)) carma_sootbinfactor(:) = dM / sum(dM) - + ! Determine the total area in which debris will be emitted. This is used to scale - ! the emission per column, based upon the fraction of surface area. This assumes a - ! regular physics grid. - call get_horiz_grid_dim_d(hdim1_d, hdim2_d) - - ngcols = hdim1_d*hdim2_d - - allocate(lat(ngcols)) - allocate(lon(ngcols)) - allocate(colarea(ngcols)) - - call get_horiz_grid_d(ngcols, clat_d_out=lat, clon_d_out=lon, area_d_out=colarea) - - lat = lat * RAD2DEG - lon = lon * RAD2DEG - - ! rad2 -> m2 - colarea = colarea * REARTH * REARTH / 1e4 + ! the emission per column, based upon the fraction of surface area. + + allocate(lat(pcols)) + allocate(lon(pcols)) + allocate(colarea(pcols)) + allocate(local_carma_emis_area(pcols,begchunk:endchunk)) + + local_carma_emis_area(:,:) = 0._r8 ! Integrate surface area with same checks as in the emission routine to determine ! the area where the emissions come from (m2). Assume that the grid box is either - ! all in or all out based upon the center lat/lon. Don't include fractions of a + ! all in or all out based upon the center lat/lon. Don't include fractions of a ! grid box. - carma_emis_area = 0._f - - do i = 1, ngcols - if ((lat(i) >= carma_emis_minlat) .and. (lat(i) <= carma_emis_maxlat) .and. & - (((carma_emis_minlon <= carma_emis_maxlon) .and. (lon(i) >= carma_emis_minlon) .and. & - (lon(i) <= carma_emis_maxlon)) .or. & - ((carma_emis_minlon > carma_emis_maxlon) .and. & - ((lon(i) >= carma_emis_minlon) .or. (lon(i) <= carma_emis_maxlon))))) then - carma_emis_area = carma_emis_area + colarea(i) - end if - end do - - carma_emis_area = carma_emis_area - + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + + call get_rlat_all_p(lchnk, pcols, lat) + call get_rlon_all_p(lchnk, pcols, lon) + + ! radians -> degrees + lat(:ncol) = lat(:ncol) * RAD2DEG + lon(:ncol) = lon(:ncol) * RAD2DEG + + call get_area_all_p(lchnk, pcols, colarea) + + ! rad2 -> m2 + colarea(:ncol) = colarea(:ncol) * REARTH * REARTH / 1.e4_r8 + + do i = 1,ncol + if ((lat(i) >= carma_emis_minlat) .and. (lat(i) <= carma_emis_maxlat) .and. & + (((carma_emis_minlon <= carma_emis_maxlon) .and. (lon(i) >= carma_emis_minlon) .and. & + (lon(i) <= carma_emis_maxlon)) .or. & + ((carma_emis_minlon > carma_emis_maxlon) .and. & + ((lon(i) >= carma_emis_minlon) .or. (lon(i) <= carma_emis_maxlon))))) then + local_carma_emis_area(i,lchnk) = colarea(i) + endif + enddo + enddo + + kk = pcols*(endchunk-begchunk+1) + call shr_reprosum_calc( local_carma_emis_area, wrk,kk,kk,1, commid=mpicom ) + + carma_emis_area = wrk(1) + deallocate(lat) deallocate(lon) deallocate(colarea) @@ -699,12 +726,12 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") - - + + if (do_print) then write(LUNOPRT,*) '' write(LUNOPRT,*) 'CARMA Initialization ...' - + write(LUNOPRT,*) '' write(LUNOPRT,*) 'ibin dustmap dustfactor sootfactor' @@ -720,7 +747,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) end if return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -732,12 +759,11 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -751,21 +777,61 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, rc = RC_OK ! Add initial condition here. - + return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile - !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -773,12 +839,12 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + ! Add the wet deposition fluxes to the hydrophilic black carbon. ! ! NOTE: Don't give the surface model negative values for the surface fluxes. @@ -801,8 +867,123 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) end if end do end if - + + return + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + return - end subroutine CARMA_WetDeposition - -end module + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the after timestep cloudborne aerosol diags + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + real(r8), pointer, dimension(:,:) :: soacm !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt !! aerosol tendency due to no2 photolysis kg/kg/s + character(len=16) :: binname !! names bins + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols) !! pure sulfate (kg/m2) + real(r8) :: mixso4(pcols) !! mix sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux mix sulfate (kg/m2/s) + real(r8) :: h2so4(pcols) !! H2SO4 gas (kg/m2) + real(r8) :: so2(pcols) !! SO2 gas (kg/m2) + real(r8) :: bdbc(pcols) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols) !! Burden dust (kg/m2) + real(r8) :: bdoc(pcols) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols) !! Burden SALT sulfate (kg/m2) + real(r8) :: bdsoa(pcols) !! Burden SOA sulfate (kg/m2) + character(len=16) :: shortname + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics + +end module carma_model_mod diff --git a/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 b/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 index 5bc4787ad5..4ec2910f44 100644 --- a/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 +++ b/src/physics/carma/models/meteor_smoke/carma_model_mod.F90 @@ -9,7 +9,7 @@ !! - CARMA_InitializeModel() !! !! @version Jan-2011 -!! @author Chuck Bardeen +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -35,21 +35,26 @@ module carma_model_mod #if ( defined SPMD ) use mpishorthand -#endif +#endif implicit none private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups @@ -62,6 +67,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -81,9 +90,9 @@ module carma_model_mod integer :: carma_emis_nLevs ! number of emission levels real(r8), allocatable, dimension(:) :: carma_emis_lev ! emission levels (Pa) real(r8), allocatable, dimension(:) :: carma_emis_rate ! emission rate lookup table (# cm-3 s-1) - integer :: carma_emis_ilev_min ! index of minimum level in table - integer :: carma_emis_ilev_max ! index of maximum level in table - integer :: carma_emis_ilev_incr ! index increment to increase level + integer :: carma_emis_ilev_min ! index of minimum level in table + integer :: carma_emis_ilev_max ! index of maximum level in table + integer :: carma_emis_ilev_incr ! index increment to increase level real(r8) :: carma_emis_expected ! Expected emission rate per column (kg/m2/s) integer :: carma_escale_nLats ! number of emission scale latitudes @@ -100,12 +109,12 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_METEOR_SMOKE = 2.0_f ! density of meteor smoke particles (g/cm) real(kind=f), parameter :: rmin = 2e-8_f ! minimum radius (cm) @@ -113,15 +122,15 @@ subroutine CARMA_DefineModel(carma, rc) integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? - + ! Default return code. rc = RC_OK - + ! Report model specific namelist configuration parameters. if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") - + if (rc < 0) call endrun("CARMAMODEL_DefineModel: CARMA_Get failed.") + if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' if (do_print) write(LUNOPRT,*) ' carma_do_escale = ', carma_do_escale @@ -129,8 +138,8 @@ subroutine CARMA_DefineModel(carma, rc) if (do_print) write(LUNOPRT,*) ' carma_emis_file = ', trim(carma_emis_file) if (do_print) write(LUNOPRT,*) ' carma_escale_file= ', trim(carma_escale_file) end if - - + + ! Define the Groups ! ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be @@ -139,40 +148,40 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, I_GRP_DUST, "meteor smoke", rmin, vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') + - ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "meteor smoke", RHO_METEOR_SMOKE, & I_INVOLATILE, I_METEOR_SMOKE, rc, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - - + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') + + ! Define the Solutes - - + + ! Define the Gases - - + + ! Define the Processes call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') - + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') + return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -188,23 +197,23 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) ! Default return code. rc = RC_OK - + return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -217,32 +226,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -253,22 +262,22 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -277,16 +286,16 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version Jan-2011 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state use camsrfexch, only: cam_in_t use time_manager, only: get_curr_calday, is_perpetual, get_perp_date, get_curr_date use physconst, only: gravit - + implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -296,9 +305,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure - - integer :: ilat ! latitude index + + integer :: ilat ! latitude index integer :: iltime ! local time index integer :: ncol ! number of columns in chunk integer :: icol ! column index @@ -322,7 +332,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend integer :: ncdate real(r8) :: ltime ! local time - + ! Default return code. rc = RC_OK @@ -343,33 +353,33 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. ! ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to - ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. tendency(:ncol, :pver) = 0.0_r8 ! Only do emission for the first bin of the meteor smoke group. call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) if (RC < RC_ERROR) return - + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) if (RC < RC_ERROR) return - + ! For meteoritic dust, the source from the smoke only goes into the ! smallest bin (~1.3 nm). The depth that the micrometeorite penetrates ! is proportional to the pressure, so the emission is a function of - ! pressure. + ! pressure. if ((shortname .eq. "DUST") .and. (ibin .eq. 1)) then ! Set tendencies for any sources or sinks in the atmosphere. do k = 1, pver do icol = 1, ncol - + pressure = state%pmid(icol, k) - + ! This is roughly a log-normal approximation to the production ! rate, but only applies from about 70 to 110 km. ! @@ -386,32 +396,32 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! surrounding the pressure and do a linear interpolation on the ! rate. This linear search is kind of expensive, particularly if ! there are a lot of points. - ! + ! ! NOTE: The tendency is on a mass mixing ratio (kg/kg/s) do ilev = carma_emis_ilev_min, (carma_emis_ilev_max - carma_emis_ilev_incr), carma_emis_ilev_incr if ((pressure >= carma_emis_lev(ilev)) .and. (pressure <= carma_emis_lev(ilev+carma_emis_ilev_incr))) then rate = carma_emis_rate(ilev) - + if (pressure > carma_emis_lev(ilev)) then rate = rate + & ((carma_emis_rate(ilev+carma_emis_ilev_incr) - & carma_emis_rate(ilev)) / (carma_emis_lev(ilev+carma_emis_ilev_incr) - & carma_emis_lev(ilev))) * (pressure - carma_emis_lev(ilev)) end if - + rate = rate * (((1.3e-7_r8)**3) / (r(ibin)**3)) exit end if end do - + ! Calculate the mass flux in terms of kg/m3/s massflux = (rate * rmass(ibin) * 1.0e-3_r8 * 1.0e6_r8) - + ! Calculate a scaling if appropriate. rfScale(icol) = 1.0_r8 - + if (carma_do_escale) then - + ! Global Scaling ! ! Interpolate the global scale by latitude. @@ -435,10 +445,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if end do - if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then + if (abs((state%lat(icol) / DEG2RAD) - 90.0_r8) <= 0.00001_r8) then rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) end if - + ! Local Time Scaling ! ! Interpolate the local scale by local time. @@ -460,10 +470,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if end do endif - + ! Convert the mass flux to a tendency on the mass mixing ratio. thickness = state%zi(icol, k) - state%zi(icol, k+1) - tendency(icol, k) = (massflux * thickness) / (state%pdel(icol, k) / gravit) + tendency(icol, k) = (massflux * thickness) / (state%pdel(icol, k) / gravit) end if enddo enddo @@ -473,15 +483,15 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend do icol = 1, ncol columnMass = sum(tendency(icol, :) * (state%pdel(icol, :) / gravit)) scale = carma_emis_expected / columnMass - + ! Also apply the relative flux scaling. This needs to be done after ! the normalization tendency(icol, :) = tendency(icol, :) * scale * rfScale(icol) end do end if - + return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -489,7 +499,7 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use ioFileMod, only: getfil use constituents, only: pcnst use wrap_nf @@ -499,6 +509,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure integer :: ilev ! level index @@ -524,10 +535,10 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") - + if (rc < 0) call endrun("CARMAMODEL_InitializeModel: CARMA_Get failed.") + ! Initialize the emissions rate table. - if (carma_do_emission) then + if (carma_do_emission) then if (masterproc) then ! Open the netcdf file (read only) @@ -540,7 +551,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_dimid(fid, "lev", lev_did) call wrap_inq_dimlen(fid, lev_did, carma_emis_nLevs) endif - + #if ( defined SPMD ) call mpibcast(carma_emis_nLevs, 1, mpiint, 0, mpicom) #endif @@ -565,18 +576,18 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) carma_emis_ilev_max = carma_emis_nLevs do ilev = 1, carma_emis_nLevs - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_min = ilev + 1 else - exit + exit endif end do do ilev = carma_emis_nLevs, 1, -1 - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_max = ilev - 1 else - exit + exit endif end do @@ -586,21 +597,21 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) carma_emis_ilev_incr = -1 tmp = carma_emis_ilev_min carma_emis_ilev_min = carma_emis_ilev_max - carma_emis_iLev_max = tmp + carma_emis_iLev_max = tmp endif if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_nLevs = ', carma_emis_nLevs - if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_min = ', carma_emis_ilev_min - if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_max = ', carma_emis_ilev_max - if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_incr = ', carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_min = ', carma_emis_ilev_min + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_max = ', carma_emis_ilev_max + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_incr = ', carma_emis_ilev_incr if (do_print) write(LUNOPRT,*) '' - + if (do_print) write(LUNOPRT,*) 'level, pressure (Pa), emission rate (# cm-3 sec-1)' do ilev = carma_emis_ilev_min, carma_emis_ilev_max, carma_emis_ilev_incr if (do_print) write(LUNOPRT,*) ilev, carma_emis_lev(ilev), carma_emis_rate(ilev) enddo - + if (do_print) write(LUNOPRT, *) 'carma_init(): Total Emission = ', carma_emis_total, ' (kt/yr)' carma_emis_expected = ((carma_emis_total * 1e6_r8) / (3600.0_r8 * 24.0_r8 * 365.0_r8)) / & (4.0_r8 * PI * ((REARTH / 100._r8) ** 2)) @@ -620,10 +631,10 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) #endif endif - + ! Initialize the emissions scaling table. - if (carma_do_escale) then + if (carma_do_escale) then if (masterproc) then ! Open the netcdf file (read only) @@ -638,17 +649,17 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_dimid(fid, "time", time_did) call wrap_inq_dimlen(fid, time_did, carma_escale_nTimes) - + ! There should be one time for each day of the year, so ! quit if it isn't correct. if (carma_escale_nTimes .ne. 365) then - call endrun("CARMA_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") + call endrun("CARMAMODEL_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") endif - + call wrap_inq_dimid(fid, "ltime", ltime_did) call wrap_inq_dimlen(fid, ltime_did, carma_escale_nLTimes) endif - + #if ( defined SPMD ) call mpibcast(carma_escale_nLats, 1, mpiint, 0, mpicom) call mpibcast(carma_escale_nTimes, 1, mpiint, 0, mpicom) @@ -665,7 +676,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_varid(fid, 'SGRF', grf_vid) tmp = nf90_get_var (fid, grf_vid, carma_escale_grf) if (tmp/=NF90_NOERR) then - write(iulog,*) 'CARMA_InitializeModel: error reading varid =', grf_vid + write(iulog,*) 'CARMAMODEL_InitializeModel: error reading varid =', grf_vid call handle_error (tmp) end if @@ -677,7 +688,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_varid(fid, 'ltime', ltime_vid) call wrap_get_var_realx(fid, ltime_vid, carma_escale_ltime) - + ! Close the file. call wrap_close(fid) @@ -686,7 +697,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nTimes = ', carma_escale_nTimes if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nLTimes = ', carma_escale_nLTimes if (do_print) write(LUNOPRT,*) '' - + if (do_print) write(LUNOPRT,*) 'carma_init(): Done with emission scaling tables.' endif @@ -699,9 +710,9 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) #endif endif - + return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -713,7 +724,7 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use pmgrid, only: plat, plev, plon @@ -736,19 +747,59 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. return - end subroutine CARMA_InitializeParticle - - + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -756,13 +807,128 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + + return + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the after timestep cloudborne aerosol diags + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + real(r8), pointer, dimension(:,:) :: soacm !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt !! aerosol tendency due to no2 photolysis kg/kg/s + character(len=16) :: binname !! names bins + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols) !! pure sulfate (kg/m2) + real(r8) :: mixso4(pcols) !! mix sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux mix sulfate (kg/m2/s) + real(r8) :: h2so4(pcols) !! H2SO4 gas (kg/m2) + real(r8) :: so2(pcols) !! SO2 gas (kg/m2) + real(r8) :: bdbc(pcols) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols) !! Burden dust (kg/m2) + real(r8) :: bdoc(pcols) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols) !! Burden SALT sulfate (kg/m2) + real(r8) :: bdsoa(pcols) !! Burden SOA sulfate (kg/m2) + character(len=16) :: shortname + + ! Default return code. + rc = RC_OK + return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 b/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 index 803a37edd6..5f21fbf4d9 100644 --- a/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 +++ b/src/physics/carma/models/mixed_sulfate/carma_model_mod.F90 @@ -50,14 +50,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 2 !! Number of particle groups @@ -70,6 +75,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -121,7 +130,7 @@ module carma_model_mod !! !! @version May-2009 !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + subroutine CARMAMODEL_DefineModel(carma, rc) use ioFileMod, only: getfil use wrap_nf @@ -144,7 +153,7 @@ subroutine CARMA_DefineModel(carma, rc) rc = RC_OK call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_Get failed.') ! Report model specific configuration parameters. if (masterproc) then @@ -167,7 +176,7 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, I_GRP_DUST, "meteor smoke", rmin, 2.0_f, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be @@ -180,7 +189,7 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, I_GRP_SULFATE, "sulfate", rmin_sulfate, vmrat_sulfate, I_SPHERE, 1._f, .false., & rc, irhswell=I_WTPCT_H2SO4, do_wetdep=.true., do_drydep=.true., solfac=1.0_f, & scavcoef=0.1_f, is_sulfate=.true., shortname="SULF") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') ! Define the Elements @@ -189,15 +198,15 @@ subroutine CARMA_DefineModel(carma, rc) ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "meteor smoke", RHO_METEOR_SMOKE, & I_INVOLATILE, I_METEOR_SMOKE, rc, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') call CARMAELEMENT_Create(carma, I_ELEM_SULFATE, I_GRP_SULFATE, "sulfate", RHO_SULFATE, & I_VOLATILE, I_H2SO4, rc, shortname="SULF") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') call CARMAELEMENT_Create(carma, I_ELEM_SULCORE, I_GRP_SULFATE, "sulfate core", RHO_METEOR_SMOKE, & I_COREMASS, I_METEOR_SMOKE, rc, shortname="SFCORE") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') ! Define the Solutes ! @@ -208,40 +217,40 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, & I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q", & ds_threshold=0.2_f) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGAS_Create failed.') call CARMAGAS_Create(carma, I_GAS_H2SO4, "Sulfuric Acid", WTMOL_H2SO4, & I_VAPRTN_H2SO4_AYERS1980, I_GCOMP_H2SO4, rc, shortname = "H2SO4", & ds_threshold=-0.2_f) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGAS_Create failed.') ! Define the Processes call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') ! Set H2SO4 to be the condensing gas, water vapor is assumed to be in equilibrium ! and will be used to define the wet particle radius. call CARMA_AddGrowth(carma, I_ELEM_SULFATE, I_GAS_H2SO4, rc) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddGrowth failed.') call CARMA_AddNucleation(carma, I_ELEM_SULFATE, I_ELEM_SULFATE, I_HOMNUC, 0._f, rc, igas=I_GAS_H2SO4) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddNucleation failed.') ! Also need nucleation with meteor smoke. call CARMA_AddNucleation(carma, I_ELEM_DUST, I_ELEM_SULCORE, I_HETNUCSULF, 0._f, rc, igas=I_GAS_H2SO4, ievp2elem=I_ELEM_DUST) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddNucleation failed.') call CARMA_AddCoagulation(carma, I_GRP_SULFATE, I_GRP_SULFATE, I_GRP_SULFATE, I_COLLEC_FUCHS, rc) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') ! Dust-Sulfate Coagulation? call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_SULFATE, I_GRP_SULFATE, I_COLLEC_FUCHS, rc) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process @@ -251,7 +260,7 @@ end subroutine CARMA_DefineModel !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -276,14 +285,14 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, rc = RC_OK return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -309,14 +318,14 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! code to determine the mass in each bin from the CAM state. return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! @version July-2009 !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t @@ -347,10 +356,10 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, ! code to determine the bulk mass from the CARMA state. return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -369,6 +378,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure integer :: ilat ! latitude index @@ -508,7 +518,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if end do - if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then + if (abs((state%lat(icol) / DEG2RAD) - 90.0_r8) <= 0.00001_r8) then rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) end if @@ -560,7 +570,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -568,7 +578,7 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only: pcnst use ioFileMod, only: getfil use wrap_nf @@ -578,6 +588,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure integer :: ilev ! level index @@ -603,7 +614,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") + if (rc < 0) call endrun("CARMAMODEL_InitializeModel: CARMA_Get failed.") ! Initialize the emissions rate table. if (carma_do_emission) then @@ -644,7 +655,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) carma_emis_ilev_max = carma_emis_nLevs do ilev = 1, carma_emis_nLevs - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_min = ilev + 1 else exit @@ -652,7 +663,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) end do do ilev = carma_emis_nLevs, 1, -1 - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_max = ilev - 1 else exit @@ -721,7 +732,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! There should be one time for each day of the year, so ! quit if it isn't correct. if (carma_escale_nTimes .ne. 365) then - call endrun("CARMA_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") + call endrun("CARMAMODEL_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") endif call wrap_inq_dimid(fid, "ltime", ltime_did) @@ -744,7 +755,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_varid(fid, 'SGRF', grf_vid) tmp = nf90_get_var (fid, grf_vid, carma_escale_grf) if (tmp/=NF90_NOERR) then - write(iulog,*) 'CARMA_InitializeModel: error reading varid =', grf_vid + write(iulog,*) 'CARMAMODEL_InitializeModel: error reading varid =', grf_vid call handle_error (tmp) end if @@ -780,7 +791,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) endif return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -792,7 +803,7 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use pmgrid, only: plat, plev, plon @@ -815,15 +826,55 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! !! @version July-2011 !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none @@ -842,6 +893,121 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) rc = RC_OK return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the after timestep cloudborne aerosol diags + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + real(r8), pointer, dimension(:,:) :: soacm !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt !! aerosol tendency due to no2 photolysis kg/kg/s + character(len=16) :: binname !! names bins + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols) !! pure sulfate (kg/m2) + real(r8) :: mixso4(pcols) !! mix sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux mix sulfate (kg/m2/s) + real(r8) :: h2so4(pcols) !! H2SO4 gas (kg/m2) + real(r8) :: so2(pcols) !! SO2 gas (kg/m2) + real(r8) :: bdbc(pcols) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols) !! Burden dust (kg/m2) + real(r8) :: bdoc(pcols) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols) !! Burden SALT sulfate (kg/m2) + real(r8) :: bdsoa(pcols) !! Burden SOA sulfate (kg/m2) + character(len=16) :: shortname + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/pmc/carma_model_mod.F90 b/src/physics/carma/models/pmc/carma_model_mod.F90 index 1ddd1b1347..41ac20fffe 100644 --- a/src/physics/carma/models/pmc/carma_model_mod.F90 +++ b/src/physics/carma/models/pmc/carma_model_mod.F90 @@ -12,7 +12,7 @@ !! !! !! @version Jan-2011 -!! @author Chuck Bardeen +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -38,21 +38,26 @@ module carma_model_mod #if ( defined SPMD ) use mpishorthand -#endif +#endif implicit none private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 2 !! Number of particle groups @@ -65,6 +70,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -91,9 +100,9 @@ module carma_model_mod integer :: carma_emis_nLevs ! number of emission levels real(r8), allocatable, dimension(:) :: carma_emis_lev ! emission levels (Pa) real(r8), allocatable, dimension(:) :: carma_emis_rate ! emission rate lookup table (# cm-3 s-1) - integer :: carma_emis_ilev_min ! index of minimum level in table - integer :: carma_emis_ilev_max ! index of maximum level in table - integer :: carma_emis_ilev_incr ! index increment to increase level + integer :: carma_emis_ilev_min ! index of minimum level in table + integer :: carma_emis_ilev_max ! index of maximum level in table + integer :: carma_emis_ilev_incr ! index increment to increase level real(r8) :: carma_emis_expected ! Expected emission rate per column (kg/m2/s) integer :: carma_escale_nLats ! number of emission scale latitudes @@ -115,15 +124,15 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) use ioFileMod, only: getfil use wrap_nf type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_METEOR_SMOKE = 2.0_f ! density of meteor smoke particles (g/cm) real(kind=f), parameter :: rmin = 2e-8_f ! minimum radius (cm) @@ -137,16 +146,16 @@ subroutine CARMA_DefineModel(carma, rc) integer :: imag_vid character(len=256) :: efile ! refractive index file name real(kind=f) :: interp - complex(kind=f) :: refidx_ice(NWAVE) ! the refractive index at each CAM wavelength + complex(kind=f) :: refidx_ice(NWAVE,NREFIDX) ! the refractive index at each CAM wavelength integer :: LUNOPRT logical :: do_print - + ! Default return code. rc = RC_OK - + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT, wave=wave) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_Get failed.') + ! Report model specific configuration parameters. if (masterproc) then if (do_print) then @@ -158,8 +167,8 @@ subroutine CARMA_DefineModel(carma, rc) write(LUNOPRT,*) ' carma_mice_file = ', trim(carma_mice_file) end if end if - - + + ! Define the Groups ! ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be @@ -168,134 +177,134 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, I_GRP_DUST, "meteor smoke", rmin, 2.0_f, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="DUST") - + ! Get the refractive index for ice as a function of wavelength for particle heating ! calculations. ! ! NOTE: These values probably should be a band average, but for now just do band centers. - + ! Read the values in from Warren et al. 2008. if (carma_do_pheat) then - if (masterproc) then - + if (masterproc) then + ! Open the netcdf file (read only) call getfil(carma_mice_file, efile, fid) if (do_print) write(LUNOPRT,*) 'carma_init(): Reading ice refractive indexes from ', efile - + call wrap_open(efile, 0, fid) - + ! Alocate the table arrays call wrap_inq_dimid(fid, "wavelength", wave_did) call wrap_inq_dimlen(fid, wave_did, warren_nwave) endif - + #if ( defined SPMD ) call mpibcast(warren_nwave, 1, mpiint, 0, mpicom) #endif - + allocate(warren_wave(warren_nwave)) allocate(warren_real(warren_nwave)) allocate(warren_imag(warren_nwave)) - + if (masterproc) then - + ! Read in the tables. call wrap_inq_varid(fid, 'wavelength', wave_vid) call wrap_get_var_realx(fid, wave_vid, warren_wave) - warren_wave = warren_wave * 1e-4 ! um -> cm - + warren_wave = warren_wave * 1e-4_r8 ! um -> cm + call wrap_inq_varid(fid, 'm_real', real_vid) call wrap_get_var_realx(fid, real_vid, warren_real) - + call wrap_inq_varid(fid, 'm_imag', imag_vid) call wrap_get_var_realx(fid, imag_vid, warren_imag) - + ! Close the file. call wrap_close(fid) end if - + #if ( defined SPMD ) call mpibcast(warren_wave, warren_nwave, mpir8, 0, mpicom) call mpibcast(warren_real, warren_nwave, mpir8, 0, mpicom) call mpibcast(warren_imag, warren_nwave, mpir8, 0, mpicom) #endif - + ! Interpolate the values. do i = 1, NWAVE do j = 1, warren_nwave if (wave(i) > warren_wave(j)) then if (j > 1) then interp = (wave(i) - warren_wave(j-1)) / (warren_wave(j) - warren_wave(j-1)) - refidx_ice(i) = cmplx(warren_real(j-1) + interp*(warren_real(j) - warren_real(j-1)), & - warren_imag(j-1) + interp*(warren_imag(j) - warren_imag(j-1))) + refidx_ice(i,1) = cmplx(warren_real(j-1) + interp*(warren_real(j) - warren_real(j-1)), & + warren_imag(j-1) + interp*(warren_imag(j) - warren_imag(j-1)), kind=f) else - refidx_ice(i) = cmplx(warren_real(j), warren_imag(j)) + refidx_ice(i,1) = cmplx(warren_real(j), warren_imag(j), kind=f) endif - + exit end if end do end do end if - + call CARMAGROUP_Create(carma, I_GRP_CRICE, "ice crystal", rmin, 2.2_f, I_SPHERE, 1._f, .true., & - rc, do_mie=carma_do_pheat, refidx=refidx_ice, shortname="CRICE") - if (rc < 0) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + rc, do_mie=carma_do_pheat, shortname="CRICE") + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') + - ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, I_ELEM_DUST, I_GRP_DUST, "meteor smoke", RHO_METEOR_SMOKE, & I_INVOLATILE, I_METEOR_SMOKE, rc, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') call CARMAELEMENT_Create(carma, I_ELEM_CRICE, I_GRP_CRICE, "ice crystal", RHO_I, & - I_VOLATILE, I_ICE, rc, shortname="CRICE") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + I_VOLATILE, I_ICE, rc, shortname="CRICE", refidx=refidx_ice) + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') call CARMAELEMENT_Create(carma, I_ELEM_CRCORE, I_GRP_CRICE, "ice core", RHO_METEOR_SMOKE, & I_COREMASS, I_METEOR_SMOKE, rc, shortname="CRCORE") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - - + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') + + ! Define the Solutes - - + + ! Define the Gases call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, & I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q", ds_threshold=0.2_f) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') - - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGAS_Create failed.') + + ! Define the Processes call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_DUST, I_GRP_DUST, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') call CARMA_AddNucleation(carma, I_ELEM_DUST, I_ELEM_CRCORE, I_HETNUC, 0._f, rc, & igas=I_GAS_H2O, ievp2elem=I_ELEM_DUST) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddNucleation failed.') call CARMA_AddGrowth(carma, I_ELEM_CRICE, I_GAS_H2O, rc) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddGrowth failed.') call CARMA_AddCoagulation(carma, I_GRP_DUST, I_GRP_CRICE, I_GRP_CRICE, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') - + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') + return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -311,23 +320,23 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) ! Default return code. rc = RC_OK - + return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -340,32 +349,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -376,34 +385,34 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state use camsrfexch, only: cam_in_t use time_manager, only: get_curr_calday, is_perpetual, get_perp_date, get_curr_date use physconst, only: gravit - + implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -413,9 +422,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure - - integer :: ilat ! latitude index + + integer :: ilat ! latitude index integer :: iltime ! local time index integer :: ncol ! number of columns in chunk integer :: icol ! column index @@ -439,7 +449,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend integer :: ncdate real(r8) :: ltime ! local time - + ! Default return code. rc = RC_OK @@ -460,33 +470,33 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. ! ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to - ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. tendency(:ncol, :pver) = 0.0_r8 ! Only do emission for the first bin of the meteor smoke group. call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) if (RC < RC_ERROR) return - + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) if (RC < RC_ERROR) return - + ! For meteoritic dust, the source from the smoke only goes into the ! smallest bin (~1.3 nm). The depth that the micrometeorite penetrates ! is proportional to the pressure, so the emission is a function of - ! pressure. + ! pressure. if ((shortname .eq. "DUST") .and. (ibin .eq. 1)) then ! Set tendencies for any sources or sinks in the atmosphere. do k = 1, pver do icol = 1, ncol - + pressure = state%pmid(icol, k) - + ! This is roughly a log-normal approximation to the production ! rate, but only applies from about 70 to 110 km. ! @@ -503,32 +513,32 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! surrounding the pressure and do a linear interpolation on the ! rate. This linear search is kind of expensive, particularly if ! there are a lot of points. - ! + ! ! NOTE: The tendency is on a mass mixing ratio (kg/kg/s) do ilev = carma_emis_ilev_min, (carma_emis_ilev_max - carma_emis_ilev_incr), carma_emis_ilev_incr if ((pressure >= carma_emis_lev(ilev)) .and. (pressure <= carma_emis_lev(ilev+carma_emis_ilev_incr))) then rate = carma_emis_rate(ilev) - + if (pressure > carma_emis_lev(ilev)) then rate = rate + & ((carma_emis_rate(ilev+carma_emis_ilev_incr) - carma_emis_rate(ilev)) / & (carma_emis_lev(ilev+carma_emis_ilev_incr) - carma_emis_lev(ilev))) * & (pressure - carma_emis_lev(ilev)) end if - + rate = rate * (((1.3e-7_r8)**3) / (r(ibin)**3)) exit end if end do - + ! Calculate the mass flux in terms of kg/m3/s massflux = (rate * rmass(ibin) * 1.0e-3_r8 * 1.0e6_r8) - + ! Calculate a scaling if appropriate. rfScale(icol) = 1.0_r8 - + if (carma_do_escale) then - + ! Global Scaling ! ! Interpolate the global scale by latitude. @@ -552,10 +562,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if end do - if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then + if (abs((state%lat(icol) / DEG2RAD) - 90.0_r8) <= 0.00001_r8) then rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) end if - + ! Local Time Scaling ! ! Interpolate the local scale by local time. @@ -577,10 +587,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if end do endif - + ! Convert the mass flux to a tendency on the mass mixing ratio. thickness = state%zi(icol, k) - state%zi(icol, k+1) - tendency(icol, k) = (massflux * thickness) / (state%pdel(icol, k) / gravit) + tendency(icol, k) = (massflux * thickness) / (state%pdel(icol, k) / gravit) end if enddo enddo @@ -590,15 +600,15 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend do icol = 1, ncol columnMass = sum(tendency(icol, :) * (state%pdel(icol, :) / gravit)) scale = carma_emis_expected / columnMass - + ! Also apply the relative flux scaling. This needs to be done after ! the normalization tendency(icol, :) = tendency(icol, :) * scale * rfScale(icol) end do end if - + return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -606,7 +616,7 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use ioFileMod, only: getfil use constituents, only: pcnst use wrap_nf @@ -616,6 +626,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure integer :: ilev ! level index @@ -641,10 +652,10 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.") - + if (rc < 0) call endrun("CARMAMODEL_InitializeModel: CARMA_Get failed.") + ! Initialize the emissions rate table. - if (carma_do_emission) then + if (carma_do_emission) then if (masterproc) then ! Open the netcdf file (read only) @@ -657,7 +668,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_dimid(fid, "lev", lev_did) call wrap_inq_dimlen(fid, lev_did, carma_emis_nLevs) endif - + #if ( defined SPMD ) call mpibcast(carma_emis_nLevs, 1, mpiint, 0, mpicom) #endif @@ -682,18 +693,18 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) carma_emis_ilev_max = carma_emis_nLevs do ilev = 1, carma_emis_nLevs - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_min = ilev + 1 else - exit + exit endif end do do ilev = carma_emis_nLevs, 1, -1 - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_max = ilev - 1 else - exit + exit endif end do @@ -703,21 +714,21 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) carma_emis_ilev_incr = -1 tmp = carma_emis_ilev_min carma_emis_ilev_min = carma_emis_ilev_max - carma_emis_iLev_max = tmp + carma_emis_iLev_max = tmp endif if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_nLevs = ', carma_emis_nLevs - if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_min = ', carma_emis_ilev_min - if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_max = ', carma_emis_ilev_max - if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_incr = ', carma_emis_ilev_incr + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_min = ', carma_emis_ilev_min + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_max = ', carma_emis_ilev_max + if (do_print) write(LUNOPRT,*) 'carma_init(): carma_emis_ilev_incr = ', carma_emis_ilev_incr if (do_print) write(LUNOPRT,*) '' - + if (do_print) write(LUNOPRT,*) 'level, pressure (Pa), emission rate (# cm-3 sec-1)' do ilev = carma_emis_ilev_min, carma_emis_ilev_max, carma_emis_ilev_incr if (do_print) write(LUNOPRT,*) ilev, carma_emis_lev(ilev), carma_emis_rate(ilev) enddo - + if (do_print) write(LUNOPRT, *) 'carma_init(): Total Emission = ', carma_emis_total, ' (kt/yr)' carma_emis_expected = ((carma_emis_total * 1e6_r8) / (3600.0_r8 * 24.0_r8 * 365.0_r8)) / & (4.0_r8 * PI * ((REARTH / 100._r8) ** 2)) @@ -737,10 +748,10 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) #endif endif - + ! Initialize the emissions scaling table. - if (carma_do_escale) then + if (carma_do_escale) then if (masterproc) then ! Open the netcdf file (read only) @@ -755,17 +766,17 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_dimid(fid, "time", time_did) call wrap_inq_dimlen(fid, time_did, carma_escale_nTimes) - + ! There should be one time for each day of the year, so ! quit if it isn't correct. if (carma_escale_nTimes .ne. 365) then - call endrun("CARMA_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") + call endrun("CARMAMODEL_InitializeModel: Emission scaling file should have entries for 365 days, but doesn't.") endif - + call wrap_inq_dimid(fid, "ltime", ltime_did) call wrap_inq_dimlen(fid, ltime_did, carma_escale_nLTimes) endif - + #if ( defined SPMD ) call mpibcast(carma_escale_nLats, 1, mpiint, 0, mpicom) call mpibcast(carma_escale_nTimes, 1, mpiint, 0, mpicom) @@ -782,7 +793,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_varid(fid, 'SGRF', grf_vid) tmp = nf90_get_var (fid, grf_vid, carma_escale_grf) if (tmp/=NF90_NOERR) then - write(iulog,*) 'CARMA_InitializeModel: error reading varid =', grf_vid + write(iulog,*) 'CARMAMODEL_InitializeModel: error reading varid =', grf_vid call handle_error (tmp) end if @@ -794,7 +805,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) call wrap_inq_varid(fid, 'ltime', ltime_vid) call wrap_get_var_realx(fid, ltime_vid, carma_escale_ltime) - + ! Close the file. call wrap_close(fid) @@ -803,7 +814,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nTimes = ', carma_escale_nTimes if (do_print) write(LUNOPRT,*) 'carma_init(): carma_escale_nLTimes = ', carma_escale_nLTimes if (do_print) write(LUNOPRT,*) '' - + if (do_print) write(LUNOPRT,*) 'carma_init(): Done with emission scaling tables.' endif @@ -816,9 +827,9 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) #endif endif - + return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -830,7 +841,7 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use pmgrid, only: plat, plev, plon @@ -853,19 +864,59 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. return - end subroutine CARMA_InitializeParticle - - + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -873,13 +924,128 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + ! Default return code. rc = RC_OK - + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the after timestep cloudborne aerosol diags + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + real(r8), pointer, dimension(:,:) :: soacm !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt !! aerosol tendency due to no2 photolysis kg/kg/s + character(len=16) :: binname !! names bins + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols) !! pure sulfate (kg/m2) + real(r8) :: mixso4(pcols) !! mix sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux mix sulfate (kg/m2/s) + real(r8) :: h2so4(pcols) !! H2SO4 gas (kg/m2) + real(r8) :: so2(pcols) !! SO2 gas (kg/m2) + real(r8) :: bdbc(pcols) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols) !! Burden dust (kg/m2) + real(r8) :: bdoc(pcols) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols) !! Burden SALT sulfate (kg/m2) + real(r8) :: bdsoa(pcols) !! Burden SOA sulfate (kg/m2) + character(len=16) :: shortname + + ! Default return code. + rc = RC_OK + return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 b/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 index 4a9e08d5be..166bb66f3d 100644 --- a/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 +++ b/src/physics/carma/models/pmc_sulfate/carma_model_mod.F90 @@ -223,7 +223,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Read in the tables. call wrap_inq_varid(fid, 'wavelength', wave_vid) call wrap_get_var_realx(fid, wave_vid, warren_wave) - warren_wave = warren_wave * 1e-4 ! um -> cm + warren_wave = warren_wave * 1e-4_r8 ! um -> cm call wrap_inq_varid(fid, 'm_real', real_vid) call wrap_get_var_realx(fid, real_vid, warren_real) @@ -617,7 +617,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if end do - if (abs((state%lat(icol) / DEG2RAD) - 90.0) <= 0.00001_r8) then + if (abs((state%lat(icol) / DEG2RAD) - 90.0_r8) <= 0.00001_r8) then rfScale(icol) = carma_escale_grf(carma_escale_nLats, doy) end if @@ -753,7 +753,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) carma_emis_ilev_max = carma_emis_nLevs do ilev = 1, carma_emis_nLevs - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_min = ilev + 1 else exit @@ -761,7 +761,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) end do do ilev = carma_emis_nLevs, 1, -1 - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_max = ilev - 1 else exit @@ -953,4 +953,4 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) return end subroutine CARMA_WetDeposition -end module +end module carma_model_mod diff --git a/src/physics/carma/models/sea_salt/carma_model_mod.F90 b/src/physics/carma/models/sea_salt/carma_model_mod.F90 index d26452d58a..0f1aa889dd 100644 --- a/src/physics/carma/models/sea_salt/carma_model_mod.F90 +++ b/src/physics/carma/models/sea_salt/carma_model_mod.F90 @@ -15,7 +15,7 @@ !! - WeibullWind() !! !! @version Dec-2010 -!! @author Tianyi Fan, Chuck Bardeen +!! @author Tianyi Fan, Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -44,14 +44,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups @@ -64,6 +69,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -81,33 +90,33 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables integer :: LUNOPRT ! logical unit number for output logical :: do_print ! do print output? real(kind=f), parameter :: RHO_SALT = 2.65_f ! dry density of sea salt particles (g/cm) real(kind=f), parameter :: rmin = 1e-6_f ! minimum radius (cm) real(kind=f), parameter :: vmrat = 4.32_f ! volume ratio - + ! Default return code. rc = RC_OK - + ! Report model specific configuration parameters. if (masterproc) then call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_Get failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_Get failed.') if (do_print) write(LUNOPRT,*) '' if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :' if (do_print) write(LUNOPRT,*) ' carma_seasalt_emis = ', trim(carma_seasalt_emis) end if - - + + ! Define the Groups ! ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be @@ -117,37 +126,37 @@ subroutine CARMA_DefineModel(carma, rc) rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="SALT", irhswell=I_GERBER, & irhswcomp=I_SWG_SEA_SALT) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') + - ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "sea salt", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALT") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - - + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') + + ! Define the Solutes - - + + ! Define the Gases - - + + ! Define the Processes - + return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -163,23 +172,23 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) ! Default return code. rc = RC_OK - + return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -192,32 +201,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -228,22 +237,22 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -252,15 +261,15 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Tianyi Fan, Chuck Bardeen !! @version Dec-2010 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state use phys_grid, only: get_lon_all_p, get_lat_all_p use camsrfexch, only: cam_in_t - + implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -270,18 +279,17 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure - - integer :: ilat(pcols) ! latitude index - integer :: ilon(pcols) ! longitude index + integer :: lchnk ! chunk identifier integer :: ncol ! number of columns in chunk integer :: icol ! column index integer :: igroup ! the index of the carma aerosol group character(len=32) :: shortname ! the shortname of the group - + ! -------- local variables added for sea salt model ------------ - real(r8) :: rdrycm, rdry ! dry radius [cm], [um] + real(r8) :: rdrycm, rdry ! dry radius [cm], [um] real(r8) :: r80cm, r80 ! wet radius at relatige humidity of 80% [cm] real(r8) :: ncflx ! dF/dr [#/m2/s/um] real(r8) :: Monahan, Clarke, Smith ! dF/dr [#/m2/s/um] @@ -303,103 +311,103 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! ------------------------------------------------------------------------------------------------- real(r8), parameter :: c41 = -2.576e35_r8 real(r8), parameter :: c42 = -2.452e33_r8 - real(r8), parameter :: c43 = 1.085e29_r8 + real(r8), parameter :: c43 = 1.085e29_r8 real(r8), parameter :: c31 = 5.932e28_r8 real(r8), parameter :: c32 = 2.404e27_r8 - real(r8), parameter :: c33 = -9.841e23_r8 - real(r8), parameter :: c21 = -2.867e21_r8 - real(r8), parameter :: c22 = -8.148e20_r8 - real(r8), parameter :: c23 = 3.132e18_r8 + real(r8), parameter :: c33 = -9.841e23_r8 + real(r8), parameter :: c21 = -2.867e21_r8 + real(r8), parameter :: c22 = -8.148e20_r8 + real(r8), parameter :: c23 = 3.132e18_r8 real(r8), parameter :: c11 = -3.003e13_r8 - real(r8), parameter :: c12 = 1.183e14_r8 - real(r8), parameter :: c13 = -4.165e12_r8 + real(r8), parameter :: c12 = 1.183e14_r8 + real(r8), parameter :: c13 = -4.165e12_r8 real(r8), parameter :: c01 = -2.881e6_r8 real(r8), parameter :: c02 = -6.743e6_r8 - real(r8), parameter :: c03 = 2.181e6_r8 + real(r8), parameter :: c03 = 2.181e6_r8 real(r8), parameter :: d41 = 7.188e37_r8 real(r8), parameter :: d42 = 7.368e35_r8 - real(r8), parameter :: d43 = -2.859e31_r8 + real(r8), parameter :: d43 = -2.859e31_r8 real(r8), parameter :: d31 =-1.616e31_r8 real(r8), parameter :: d32 =-7.310e29_r8 - real(r8), parameter :: d33 = 2.601e26_r8 + real(r8), parameter :: d33 = 2.601e26_r8 real(r8), parameter :: d21 = 6.791e23_r8 real(r8), parameter :: d22 = 2.528e23_r8 - real(r8), parameter :: d23 =-8.297e20_r8 + real(r8), parameter :: d23 =-8.297e20_r8 real(r8), parameter :: d11 = 1.829e16_r8 real(r8), parameter :: d12 =-3.787e16_r8 - real(r8), parameter :: d13 = 1.105e15_r8 + real(r8), parameter :: d13 = 1.105e15_r8 real(r8), parameter :: d01 = 7.609e8_r8 real(r8), parameter :: d02 = 2.279e9_r8 real(r8), parameter :: d03 =-5.800e8_r8 - - real(r8) :: rpdry ! dry radius + + real(r8) :: rpdry ! dry radius real(r8) :: Ak1 ! Coefficient Ak in Martensson's source function - real(r8) :: Ak2 - real(r8) :: Ak3 + real(r8) :: Ak2 + real(r8) :: Ak3 real(r8) :: Bk1 ! Coefficient Bk in Martensson's source function real(r8) :: Bk2 real(r8) :: Bk3 Ak1(rpdry)= c41*(2._r8*rpdry)**4 + c31*(2._r8*rpdry) ** 3 + c21*(2._r8*rpdry)**2 + c11*(2._r8*rpdry)+ c01 Ak2(rpdry)= c42*(2._r8*rpdry)**4 + c32*(2._r8*rpdry) ** 3 + c22*(2._r8*rpdry)**2 + c12*(2._r8*rpdry)+ c02 - Ak3(rpdry)= c43*(2._r8*rpdry)**4 + c33*(2._r8*rpdry) ** 3 + c23*(2._r8*rpdry)**2 + c13*(2._r8*rpdry)+ c03 + Ak3(rpdry)= c43*(2._r8*rpdry)**4 + c33*(2._r8*rpdry) ** 3 + c23*(2._r8*rpdry)**2 + c13*(2._r8*rpdry)+ c03 Bk1(rpdry)= d41*(2._r8*rpdry)**4 + d31*(2._r8*rpdry) ** 3 + d21*(2._r8*rpdry)**2 + d11*(2._r8*rpdry)+ d01 Bk2(rpdry)= d42*(2._r8*rpdry)**4 + d32*(2._r8*rpdry) ** 3 + d22*(2._r8*rpdry)**2 + d12*(2._r8*rpdry)+ d02 Bk3(rpdry)= d43*(2._r8*rpdry)**4 + d33*(2._r8*rpdry) ** 3 + d23*(2._r8*rpdry)**2 + d13*(2._r8*rpdry)+ d03 - + ! ------------------------------------------------------------ ! ---- Clarke Source Function. Coefficients for Ai ------- ! ------------------------------------------------------------ real(r8), parameter :: beta01 =-5.001e3_r8 real(r8), parameter :: beta11 = 0.808e6_r8 - real(r8), parameter :: beta21 =-1.980e7_r8 + real(r8), parameter :: beta21 =-1.980e7_r8 real(r8), parameter :: beta31 = 2.188e8_r8 real(r8), parameter :: beta41 =-1.144e9_r8 - real(r8), parameter :: beta51 = 2.290e9_r8 + real(r8), parameter :: beta51 = 2.290e9_r8 real(r8), parameter :: beta02 = 3.854e3_r8 real(r8), parameter :: beta12 = 1.168e4_r8 real(r8), parameter :: beta22 =-6.572e4_r8 real(r8), parameter :: beta32 = 1.003e5_r8 real(r8), parameter :: beta42 =-6.407e4_r8 - real(r8), parameter :: beta52 = 1.493e4_r8 + real(r8), parameter :: beta52 = 1.493e4_r8 real(r8), parameter :: beta03 = 4.498e2_r8 real(r8), parameter :: beta13 = 0.839e3_r8 real(r8), parameter :: beta23 =-5.394e2_r8 real(r8), parameter :: beta33 = 1.218e2_r8 real(r8), parameter :: beta43 =-1.213e1_r8 - real(r8), parameter :: beta53 = 4.514e-1_r8 + real(r8), parameter :: beta53 = 4.514e-1_r8 real(r8) :: A1 ! Coefficient Ak in Clarkes's source function - real(r8) :: A2 - real(r8) :: A3 + real(r8) :: A2 + real(r8) :: A3 A1(rpdry) = beta01 + beta11*(2._r8*rpdry) + beta21*(2._r8*rpdry)**2 + & beta31*(2._r8*rpdry)**3 + beta41*(2._r8*rpdry)**4 + beta51*(2._r8*rpdry)**5 A2(rpdry) = beta02 + beta12*(2._r8*rpdry) + beta22*(2._r8*rpdry)**2 + & beta32*(2._r8*rpdry)**3 + beta42*(2._r8*rpdry)**4 + beta52*(2._r8*rpdry)**5 A3(rpdry) = beta03 + beta13*(2._r8*rpdry) + beta23*(2._r8*rpdry)**2 + & beta33*(2._r8*rpdry)**3 + beta43*(2._r8*rpdry)**4 + beta53*(2._r8*rpdry)**5 - + ! --------------------------------------------- ! coefficient A1, A2 in Andreas's Source funcion ! --------------------------------------------- - real(r8) ::A1A92 - real(r8) ::A2A92 - + real(r8) ::A1A92 + real(r8) ::A2A92 + ! --------------------------------------------- ! coefficient in Smith's Source funcion - ! --------------------------------------------- - real(r8), parameter :: f1 = 3.1_r8 + ! --------------------------------------------- + real(r8), parameter :: f1 = 3.1_r8 real(r8), parameter :: f2 = 3.3_r8 real(r8), parameter :: r1 = 2.1_r8 real(r8), parameter :: r2 = 9.2_r8 real(r8), parameter :: delta = 10._r8 - + + ! -------------------------------------------------------------------- + ! ---- constants in calculating the particle wet radius [Gerber, 1985] ! -------------------------------------------------------------------- - ! ---- constants in calculating the particle wet radius [Gerber, 1985] - ! -------------------------------------------------------------------- real(r8), parameter :: c1 = 0.7674_r8 ! . real(r8), parameter :: c2 = 3.079_r8 ! . real(r8), parameter :: c3 = 2.573e-11_r8 ! . real(r8), parameter :: c4 = -1.424_r8 ! constants in calculating the particel wet radius - + ! Default return code. rc = RC_OK @@ -407,25 +415,22 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend lchnk = state%lchnk ncol = state%ncol - call get_lat_all_p(lchnk, ncol, ilat) - call get_lon_all_p(lchnk, ncol, ilon) - ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. ! ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to - ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. + ! the bottom layer by vertical diffusion. See vertical_solver module, line 355. tendency(:ncol, :pver) = 0.0_r8 - - + + call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup) if (RC < RC_ERROR) return - + call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, r=r, dr=dr, rmass=rmass) if (RC < RC_ERROR) return - + if (shortname .eq. "SALT") then ! Are we configured for one of the known emission schemes? @@ -437,174 +442,174 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend carma_seasalt_emis .ne. "CMS" .and. & carma_seasalt_emis .ne. "NONE" .and. & carma_seasalt_emis .ne. "CONST" ) then - + call endrun('carma_EmitParticle:: Invalid sea salt emission scheme.') end if - + + !********************************** + ! wet sea salt radius at RH = 80% !********************************** - ! wet sea salt radius at RH = 80% - !********************************** - r80cm = (c1 * (r(ibin)) ** c2 / (c3 * r(ibin) ** c4 - log10(0.8)) + (r(ibin))**3) ** (1./3.) ! [cm] - rdrycm = r(ibin) ! [cm] + r80cm = (c1 * (r(ibin)) ** c2 / (c3 * r(ibin) ** c4 - log10(0.8_r8)) + (r(ibin))**3) ** (1._r8/3._r8) ! [cm] + rdrycm = r(ibin) ! [cm] r80 = r80cm *1.e4_r8 ! [um] rdry = rdrycm*1.e4_r8 ! [um] - + do icol = 1,ncol - + ! Only generate sea salt over the ocean. if (cam_in%ocnfrac(icol) > 0._r8) then - + !********************************** ! WIND for seasalt production - !********************************** - call CARMA_SurfaceWind(carma, state, icol, ilat(icol), ilon(icol), cam_in, u10in, rc) - - ! Add any surface flux here. + !********************************** + call CARMAMODEL_SurfaceWind(carma, state, icol, cam_in, u10in, rc) + + ! Add any surface flux here. ncflx = 0.0_r8 - Monahan = 0.0_r8 + Monahan = 0.0_r8 Clarke = 0.0_r8 - Smith = 0.0_r8 - + Smith = 0.0_r8 + !********************************** ! Whitecap Coverage !********************************** wcap = 3.84e-6_r8 * u10in ** 3.41_r8 ! in percent, ie., 75%, wcap = 0.75 - + !**************************************** ! Hoppel correction factor ! Smith drag coefficients and etc !**************************************** if (u10in .le. 10._r8) then - cd_smith = 1.14e-3_r8 + cd_smith = 1.14e-3_r8 else cd_smith = (0.49_r8 + 0.065_r8 * u10in) * 1.e-3_r8 end if - + ustar_smith = cd_smith **0.5_r8 * u10in - + ! We don't have vg yet, since that is calculated by CARMA. That will require ! a different interface for the emissions, storing vg in the physics buffer, ! and/or doing some duplicate calculations for vg assuming 80% RH. ! fref = (delta/state%zm(icol, pver))**(vg(icol, ibin, igelem(i))/(xkar*ustar_smith)) fref = 1.0_r8 - + !********************************** ! Source Functions !********************************** if (carma_seasalt_emis .eq. 'NONE') then ncflx = 0._r8 end if - + if (carma_seasalt_emis .eq. 'CONST') then ncflx = 1.e-5_r8 end if - + !-------Gong source function------ - if (carma_seasalt_emis == "Gong") then - sita_para = 30 + if (carma_seasalt_emis == "Gong") then + sita_para = 30 A_para = - 4.7_r8 * (1+ sita_para * r80) ** (- 0.017_r8 * r80** (-1.44_r8)) - B_para = (0.433_r8 - log10(r80)) / 0.433_r8 + B_para = (0.433_r8 - log10(r80)) / 0.433_r8 ncflx = 1.373_r8* u10in ** 3.41_r8 * r80 ** A_para * & (1._r8 + 0.057_r8 * r80**3.45_r8) * 10._r8 ** (1.607_r8 * exp(- B_para **2)) ! if (do_print) write(LUNOPRT, *) "Gong: ncflx = ", ncflx, ", u10n = ", u10in end if - + !------Martensson source function----- - if (carma_seasalt_emis == "Martensson") then + if (carma_seasalt_emis == "Martensson") then if (rdry .le. 0.0725_r8) then ncflx = (Ak1(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk1(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] - ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - elseif (rdry .gt. 0.0725_r8 .and. rdry .le. 0.2095_r8) then + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + elseif (rdry .gt. 0.0725_r8 .and. rdry .le. 0.2095_r8) then ncflx = (Ak2(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk2(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - elseif (rdry .gt. 0.2095_r8 .and. rdry .le. 1.4_r8) then + elseif (rdry .gt. 0.2095_r8 .and. rdry .le. 1.4_r8) then ncflx = (Ak3(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk3(rdry*1.0e-6_r8)) * wcap ! dF/dlogr [#/s/m2] - ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - else + ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] + else ncflx = 0._r8 end if end if - - !-------Clarke source function------- - if (carma_seasalt_emis == "Clarke")then + + !-------Clarke source function------- + if (carma_seasalt_emis == "Clarke")then if (rdry .lt. 0.066_r8) then - ncflx = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + ncflx = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - elseif (rdry .ge. 0.066_r8 .and. rdry .lt. 0.6_r8) then - ncflx = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + elseif (rdry .ge. 0.066_r8 .and. rdry .lt. 0.6_r8) then + ncflx = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] ncflx = ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - elseif (rdry .ge. 0.6_r8 .and. rdry .lt. 4.0_r8) then - ncflx = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + elseif (rdry .ge. 0.6_r8 .and. rdry .lt. 4.0_r8) then + ncflx = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] ncflx= ncflx / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] else ncflx = 0._r8 - end if + end if end if - + !-----------Caffrey source function------------ - if (carma_seasalt_emis == "Caffrey") then - - !Monahan + if (carma_seasalt_emis == "Caffrey") then + + !Monahan B_mona = (0.38_r8 - log10(r80)) / 0.65_r8 Monahan = 1.373_r8 * (u10in**3.41_r8) * r80**(-3._r8) * & - (1._r8 + 0.057 *r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(-1. * B_mona**2)) ! dF/dr - + (1._r8 + 0.057_r8 *r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(-1._r8 * B_mona**2)) ! dF/dr + !Smith u14 = u10in * (1._r8 + cd_smith**0.5_r8 / xkar * log(14._r8 / 10._r8)) ! 14 meter wind A1A92 = 10._r8 ** (0.0676_r8 * u14 + 2.430_r8) - A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) + A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) Smith = A1A92*exp(-f1 *(log(r80/r1))**2) + A2A92*exp(-f2 * (log(r80/r2))**2) ! dF/dr [#/m2/s/um] - + !Caffrey based on Monahan and Smith - W_Caff = 1.136_r8 **(-1._r8 * rdry ** (-0.855_r8))*(1._r8 + 0.2_r8/rdry) + W_Caff = 1.136_r8 **(-1._r8 * rdry ** (-0.855_r8))*(1._r8 + 0.2_r8/rdry) if (rdry .lt. 0.15_r8) then ncflx = Monahan - else + else if (u10in .le. 9._r8) then - ncflx = Monahan + ncflx = Monahan else if(Monahan .ge. Smith) then - ncflx = Monahan + ncflx = Monahan else - ncflx = Smith + ncflx = Smith end if end if end if - + ncflx = ncflx * W_Caff - + !%%%%%%%%%%%%%%%%%%%%%%%%% ! Apply Hoppel correction !%%%%%%%%%%%%%%%%%%%%%%%%% - ncflx = ncflx * fref + ncflx = ncflx * fref end if !--------CMS (Clarke, Monahan, and Smith source function)------- - if (carma_seasalt_emis == "CMS") then - - !Clarke + if (carma_seasalt_emis == "CMS") then + + !Clarke if (rdry .lt. 0.066_r8) then - Clarke = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + Clarke = A1(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] Clarke = Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - elseif ((rdry .ge. 0.066_r8) .and. (rdry .lt. 0.6_r8)) then - Clarke = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + elseif ((rdry .ge. 0.066_r8) .and. (rdry .lt. 0.6_r8)) then + Clarke = A2(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] Clarke = Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - elseif ((rdry .ge. 0.6_r8) .and. (rdry .lt. 4.0_r8)) then - Clarke = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] + elseif ((rdry .ge. 0.6_r8) .and. (rdry .lt. 4.0_r8)) then + Clarke = A3(rdry) * 1.e4_r8 * wcap ! dF/dlogr [#/s/m2] Clarke= Clarke / (2.30258509_r8 * rdry) ! dF/dr [#/s/m2/um] - end if - - !Monahan - B_Mona = (0.38_r8 - log10(r80)) / 0.65_r8 + end if + + !Monahan + B_Mona = (0.38_r8 - log10(r80)) / 0.65_r8 Monahan = 1.373_r8 * u10in ** 3.41_r8 * r80 ** (-3._r8) * & (1._r8 + 0.057_r8 * r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(- B_Mona **2)) - + !Smith u14 = u10in * (1._r8 + cd_smith**0.5_r8 / xkar*log(14._r8 / 10._r8)) ! 14 meter wind A1A92 = 10._r8 ** (0.0676_r8 * u14 + 2.430_r8) - A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) + A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8) Smith = A1A92*exp(-f1 *(log(r80 / r1))**2) + A2A92*exp(-f2 * (log(r80 / r2))**2) ! dF/dr [#/m2/s/um] - + !%%%%%%%%%%%%%%%%%%%%%%%%% ! CMS1 or CMS2 !%%%%%%%%%%%%%%%%%%%%%%%%% @@ -613,8 +618,8 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend if (rdry .lt. 1._r8) then ! cut at 1.0 um ! ***CMS2***** ! if (rdry .lt. 2._r8) then ! cut at 2.0 um - ncflx = Clarke - else + ncflx = Clarke + else if (u10in .lt. 9._r8) then ncflx = Monahan else @@ -625,14 +630,14 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend end if end if end if - + !%%%%%%%%%%%%%%%%%%%%%%%%% ! Apply Hoppel correction - !%%%%%%%%%%%%%%%%%%%%%%%%% - ncflx = ncflx * fref + !%%%%%%%%%%%%%%%%%%%%%%%%% + ncflx = ncflx * fref end if - ! convert ncflx [#/m^2/s/um] to surfaceFlx [kg/m^2/s] + ! convert ncflx [#/m^2/s/um] to surfaceFlx [kg/m^2/s] surfaceFlux(icol) = ncflx * dr(ibin) * rmass(ibin) * 10._r8 ! *1e4[um/cm] * 1.e-3[kg/g] ! if (do_print) write(LUNOPRT, *) "ibin = ", ibin, ", igroup = ", igroup @@ -640,13 +645,13 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! if (do_print) write(LUNOPRT, *) "ncflx = " , ncflx, ", surfaceFlux = ", surfaceFlux(icol) ! weighted by the ocean fraction - surfaceFlux(icol) = surfaceFlux(icol) * cam_in%ocnfrac(icol) + surfaceFlux(icol) = surfaceFlux(icol) * cam_in%ocnfrac(icol) end if end do end if - + return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -654,22 +659,23 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only: pcnst implicit none type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. rc = RC_OK ! Add initialization here. - + return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -681,7 +687,7 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use pmgrid, only: plat, plev, plon @@ -704,19 +710,59 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. return - end subroutine CARMA_InitializeParticle - + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -724,37 +770,35 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_WetDeposition !! Calculate the sea surface wind with a Weibull distribution. !! !! @author Tianyi Fan !! @version August-2010 - subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, cam_in, u10in, rc) + subroutine CARMAMODEL_SurfaceWind(carma, state, icol, cam_in, u10in, rc) use ppgrid, only: pcols, pver use physics_types, only: physics_state use camsrfexch, only: cam_in_t - + implicit none ! in and out field type(carma_type), intent(in) :: carma !! the carma object type(physics_state), intent(in) :: state !! physics state integer, intent(in) :: icol !! column index - integer, intent(in) :: ilat !! latitude index - integer, intent(in) :: ilon !! longitude index type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: u10in !! the 10m wind speed put into the source function integer, intent(out) :: rc !! return code, negative indicates failure - + ! local variables ! the nth mean wind with integration using Weibull Distribution (integrate from threshold wind velocity) real(r8) :: uWB341 @@ -763,9 +807,9 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, cam_in, u10in, rc) uWB341 = 0._r8 - ! calc. the Weibull wind distribution + ! calc. the Weibull wind distribution u10in = cam_in%u10(icol) - + call WeibullWind(u10in, uth, 3.41_r8, uWB341) ! Asked for 3.41 moment of the wind, but return the first moment of the @@ -773,13 +817,13 @@ subroutine CARMA_SurfaceWind(carma, state, icol, ilat, ilon, cam_in, u10in, rc) u10in = uWB341 ** (1._r8 / 3.41_r8) return - end subroutine CARMA_SurfaceWind + end subroutine CARMAMODEL_SurfaceWind !! Calculate the nth mean of u using Weibull wind distribution !! considering the threshold wind velocity. This algorithm !! integrates from uth to infinite (u^n P(u)du ) - !! + !! !! @author Tianyi Fan !! @version August-2010 subroutine WeibullWind(u, uth, n, uwb, wbk) @@ -788,33 +832,148 @@ subroutine WeibullWind(u, uth, n, uwb, wbk) igamma => shr_spfn_igamma implicit none - + real(r8), intent(in) :: u ! mean wind speed real(r8), intent(in) :: uth ! threshold velocity real(r8), intent(in) :: n ! the rank of u in the integration real(r8), intent(out) :: uwb ! the Weibull distribution real(r8), intent(in), optional :: wbk ! the shape parameter - + ! local variable real(r8) :: k ! the shape parameter in Weibull distribution real(r8) :: c ! the scale parameter in Weibull distribution - + if (present(wbk)) then k = wbk else - k = 0.94*u**0.5_r8 ! follow Grini and Zender, 2004JGR + k = 0.94_r8*u**0.5_r8 ! follow Grini and Zender, 2004JGR ! k = 2.5_r8 ! Lansing's estimate - end if - + end if + ! At some locations the k parameter is 0, not ocean which then ! makes the gamma functions unstable. - if (k .eq. 0._r8) then + if (k .eq. 0._r8) then c = u**n else - c = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8) + c = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8) uwb = c**n * igamma(n / k + 1._r8, (uth / c)**k) end if end subroutine WeibullWind -end module + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the after timestep cloudborne aerosol diags + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + integer :: icol !! column index + integer :: ibin !! bin index + real(r8), pointer, dimension(:,:) :: soacm !! aerosol tendency due to gas-aerosol exchange kg/kg/s + real(r8), pointer, dimension(:,:) :: soapt !! aerosol tendency due to no2 photolysis kg/kg/s + character(len=16) :: binname !! names bins + real(r8) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer :: i + integer :: icnst !! constituent index + integer :: ienconc !! concentration element index + integer :: ncore !! number of cores + integer :: icorelem(NELEM) !! core element index + real(r8) :: mair(pver) !! Mass of air column (kg/m2) + real(r8) :: pureso4(pcols) !! pure sulfate (kg/m2) + real(r8) :: mixso4(pcols) !! mix sulfate (kg/m2) + real(r8) :: cprflux(pcols) !! Surface Flux pure sulfate (kg/m2/s) + real(r8) :: cmxflux(pcols) !! Surface Flux mix sulfate (kg/m2/s) + real(r8) :: h2so4(pcols) !! H2SO4 gas (kg/m2) + real(r8) :: so2(pcols) !! SO2 gas (kg/m2) + real(r8) :: bdbc(pcols) !! Burden BC sulfate (kg/m2) + real(r8) :: bddust(pcols) !! Burden dust (kg/m2) + real(r8) :: bdoc(pcols) !! Burden OC sulfate (kg/m2) + real(r8) :: bdsalt(pcols) !! Burden SALT sulfate (kg/m2) + real(r8) :: bdsoa(pcols) !! Burden SOA sulfate (kg/m2) + character(len=16) :: shortname + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics + +end module carma_model_mod diff --git a/src/physics/carma/models/sulfate/carma_model_mod.F90 b/src/physics/carma/models/sulfate/carma_model_mod.F90 index fb410e83c9..c19e013891 100644 --- a/src/physics/carma/models/sulfate/carma_model_mod.F90 +++ b/src/physics/carma/models/sulfate/carma_model_mod.F90 @@ -11,7 +11,7 @@ !! - CARMA_EmitParticle() !! !! @version Dec-2010 -!! @author Tianyi Fan, Chuck Bardeen +!! @author Tianyi Fan, Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -38,15 +38,19 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition - + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups @@ -59,6 +63,10 @@ module carma_model_mod integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -68,7 +76,7 @@ module carma_model_mod ! should have a unique number. integer, public, parameter :: I_H2SO4 = 1 !! sulfate aerosol composition integer, public, parameter :: I_WATER = 2 !! water - + ! Define group, element, solute and gas indexes. integer, public, parameter :: I_GRP_SULFATE = 1 !! sulfate aerosol @@ -88,17 +96,17 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) use physics_buffer, only: pbuf_add_field, dtype_r8 type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_SULFATE = 1.923_f ! dry density of sulfate particles (g/cm3) -! Set radius of smallest bin such that mass is that of 2 molecules of H2SO4: +! Set radius of smallest bin such that mass is that of 2 molecules of H2SO4: real(kind=f), parameter :: rmin = 3.43230298e-8_f ! minimum radius (cm) real(kind=f), parameter :: vmrat = 2.4_f ! volume ratio integer :: LUNOPRT @@ -109,7 +117,7 @@ subroutine CARMA_DefineModel(carma, rc) call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') - + ! Report model specific configuration parameters. if (masterproc) then if (do_print) then @@ -131,7 +139,7 @@ subroutine CARMA_DefineModel(carma, rc) scavcoef=0.1_f, is_sulfate=.true., shortname="PURSUL") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names @@ -139,19 +147,19 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAELEMENT_Create(carma, I_ELEM_SULFATE, I_GRP_SULFATE, "Sulfate", RHO_SULFATE, & I_VOLATILE, I_H2SO4, rc, shortname="PURSUL") if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - + ! Define the Solutes - - + + ! Define the Gases call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, & rc, shortname = "Q", ds_threshold=-0.2_f) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') - + call CARMAGAS_Create(carma, I_GAS_H2SO4, "Sulfuric Acid", WTMOL_H2SO4, I_VAPRTN_H2SO4_AYERS1980, & I_GCOMP_H2SO4, rc, shortname = "H2SO4", ds_threshold=-0.2_f) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') - + ! Define the Processes ! Set H2SO4 to be the condensing gas, water vapor is assumed to be in equilibrium @@ -166,23 +174,23 @@ subroutine CARMA_DefineModel(carma, rc) if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') call pbuf_add_field('SADSULF', 'global', dtype_r8, (/pcols, pver/), ipbuf4sad) - + if (carma_rad_feedback) then call pbuf_add_field('VOLC_RAD_GEOM', 'global', dtype_r8, (/pcols, pver/), ipbuf4reff) call pbuf_add_field('VOLC_MMR', 'global', dtype_r8, (/pcols, pver/), ipbuf4so4mmr) endif - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair @@ -198,23 +206,23 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) ! Default return code. rc = RC_OK - + return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none @@ -227,33 +235,33 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return - end subroutine CARMA_DiagnoseBins + end subroutine CARMAMODEL_DiagnoseBins !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t use physics_buffer, only: pbuf_get_field implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -264,7 +272,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) @@ -308,11 +316,11 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, md(:) = md(:) + mmr(:) ! bin integrated stratospheric mass mixing ratio (kg/kg) end if end do - + reff(:) = reff(:) / ad(:) ! wet effective radius in cm reff(:) = reff(:) / 100.0_r8 ! cm -> m ad(:) = ad(:) * 4.0_r8 * PI ! surface area density in cm2/cm3 - + call pbuf_get_field(pbuf, ipbuf4sad, sadsulf_ptr) sadsulf_ptr(icol, :cstate%f_NZ) = ad(:cstate%f_NZ) ! stratospheric aerosol wet surface area density (cm2/cm3) @@ -325,7 +333,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, end if - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -334,16 +342,16 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Tianyi Fan, Chuck Bardeen !! @version Dec-2010 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & is_perpetual use camsrfexch, only: cam_in_t - + implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -353,19 +361,20 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure - + ! Default return code. - rc = RC_OK - + rc = RC_OK + ! Add any surface flux here. surfaceFlux = 0._r8 - + ! For emissions into the atmosphere, put the emission here. tendency = 0._r8 return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -373,20 +382,21 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst implicit none type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure - + ! Default return code. rc = RC_OK return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -398,9 +408,8 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon implicit none @@ -421,19 +430,61 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! NOTE: Initialized to 0. by the caller, so nothing needs to be done. return - end subroutine CARMA_InitializeParticle - - + end subroutine CARMAMODEL_InitializeParticle + + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile + + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -441,13 +492,101 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + ! Default return code. rc = RC_OK - + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/test_detrain/carma_model_mod.F90 b/src/physics/carma/models/test_detrain/carma_model_mod.F90 index 16e6cb431f..fde34f8b20 100644 --- a/src/physics/carma/models/test_detrain/carma_model_mod.F90 +++ b/src/physics/carma/models/test_detrain/carma_model_mod.F90 @@ -472,4 +472,4 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) return end subroutine CARMA_WetDeposition -end module +end module carma_model_mod diff --git a/src/physics/carma/models/test_growth/carma_model_mod.F90 b/src/physics/carma/models/test_growth/carma_model_mod.F90 index 24a8d958cc..5b4a2b6ac7 100644 --- a/src/physics/carma/models/test_growth/carma_model_mod.F90 +++ b/src/physics/carma/models/test_growth/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -10,13 +10,13 @@ !! the initial conditions of the particles. Each realization of CARMA !! microphysics has its own version of this file. !! -!! This file is a simple test case involving one group of dust particles and -!! 8 size bins. Optical properties are calculated, assuming a constant refractive -!! index of (1.55, 4e-3). The particles are not subject to particle swelling, but -!! do coagulate. +!! This file is a simple test case involving two groups: sulfate condensation nuclei +!! and ice particles. The sulfates are prescribed and the ice is prognostics. This +!! test exercises the nucleation and growth code. THe particles are sedimented, but +!! do not coagulate. !! -!! @version May-2009 -!! @author Chuck Bardeen +!! @version May-2009 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -30,7 +30,7 @@ module carma_model_mod use carmastate_mod use carma_mod use carma_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use radconstants, only: nswbands, nlwbands use cam_abortutils, only: endrun @@ -43,26 +43,35 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition - + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition + ! Declare public constants integer, public, parameter :: NGROUP = 2 !! Number of particle groups integer, public, parameter :: NELEM = 3 !! Number of particle elements integer, public, parameter :: NBIN = 16 !! Number of particle bins integer, public, parameter :: NSOLUTE = 1 !! Number of particle solutes integer, public, parameter :: NGAS = 1 !! Number of gases - + ! These need to be defined, but are only used when the particles are radiatively active. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) - + + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -91,12 +100,12 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_CN = 2.65_f ! dry density of sea salt particles (g/cm) real(kind=f), parameter :: rmin_ice = 5.e-5_f ! min radius for ice bins (cm) @@ -104,7 +113,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Default return code. rc = RC_OK - + ! Define the Groups ! ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. @@ -112,50 +121,50 @@ subroutine CARMA_DefineModel(carma, rc) ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be ! defined. If wetdep is defined, then the optional solubility factor ! should also be defined. - + ! Since these sulfates are prescribed, don't sediment them. This will save some ! processing time. call CARMAGROUP_Create(carma, I_GRP_CRCN, "Sulfate CN", rmin_cn, 4.0_f, I_SPHERE, 1._f, .false., & rc, shortname="CRCN", cnsttype=I_CNSTTYPE_DIAGNOSTIC, & do_vtran=.false.) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, I_GRP_CRICE, "Ice", rmin_ice, 2.8_f, I_HEXAGON, 1._f / 6._f, .true., & rc, shortname="CRICE", ifallrtn=I_FALLRTN_STD_SHAPE) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') + + - - ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, I_ELEM_CRCN, I_GRP_CRCN, "Sulfate CN", RHO_CN, & I_INVOLATILE, I_H2SO4, rc, shortname="CRCN", isolute=I_SOL_CRH2SO4) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, I_ELEM_CRICE, I_GRP_CRICE, "Ice", RHO_I, & I_VOLATILE, I_ICE, rc, shortname="CRICE") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') + call CARMAELEMENT_Create(carma, I_ELEM_CRCORE, I_GRP_CRICE, "Core Mass", RHO_CN, & I_COREMASS, I_H2SO4, rc, shortname="CRCORE", isolute=1) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') + - ! Define the Solutes call CARMASOLUTE_Create(carma, I_SOL_CRH2SO4, "Sulfuric Acid", 2, 98._f, 1.38_f, rc, shortname="CRH2SO4") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMASOLUTE_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMASOLUTE_Create failed.') + - ! Define the Gases call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, rc, shortname="Q") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGAS_Create failed.') + - ! Define the Processes call CARMA_AddGrowth(carma, I_ELEM_CRICE, I_GAS_H2O, rc) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddGrowth failed.') ! NOTE: For now, assume the latent heat for nucleation is the latent of of fusion of ! water, using the CAM constant (scaled from J/kg to erg/g). @@ -165,26 +174,26 @@ subroutine CARMA_DefineModel(carma, rc) ! the gas associated with nucleation is accounted for. call CARMA_AddNucleation(carma, I_ELEM_CRCN, I_ELEM_CRCORE, & I_AERFREEZE + I_AF_KOOP_2000, 0._f, rc, igas=I_GAS_H2O, ievp2elem=I_ELEM_CRCN) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_AddNucleation failed.') return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -194,27 +203,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -223,18 +232,18 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + integer :: igroup ! group index integer :: ielem ! element index integer :: ibin ! bin index - + ! Sulfate size distribution parameters - real(r8), parameter :: n = 100._r8 ! concentration (cm-3) + real(r8), parameter :: n = 100._r8 ! concentration (cm-3) real(r8), parameter :: r0 = 2.5e-6_r8 ! mean radius (cm) real(r8), parameter :: rsig = 1.5_r8 ! distribution width - + real(r8) :: arg1(NBIN) real(r8) :: arg2(NBIN) real(r8) :: rhop(NBIN) ! particle mass density (kg/m3) @@ -246,45 +255,45 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr ! Default return code. rc = RC_OK - + ! Get the air density. call CARMASTATE_GetState(cstate, rc, rhoa_wet=rhoa_wet) - if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_GetState failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DiagnoseBins::CARMASTATE_GetState failed.') ! Use a fixed sulfate size distribution. By doing this as a diagnostic group, ! the constituents for the sulfate bins do not need to be advected, which ! improves the speed of the model. igroup = 1 ielem = 1 - + call CARMAGROUP_Get(carma, igroup, rc, r=r, dr=dr, rmass=rmass) - if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_Get failed.') - + if (rc < RC_OK) call endrun('CARMAMODEL_DiagnoseBins::CARMAGROUP_Get failed.') + arg1(:) = n * dr(:) / (sqrt(2._f*PI) * r(:) * log(rsig)) arg2(:) = -((log(r(:)) - log(r0))**2) / (2._f*(log(rsig))**2) rhop(:) = arg1(:) * exp(arg2(:)) * rmass(:) * 1e6_f / 1e3_f - + do ibin = 1, NBIN mmr(ibin, :) = rhop(ibin) / rhoa_wet(:) call CARMASTATE_SetBin(cstate, ielem, ibin, mmr(ibin, :), rc) - if (rc < RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DiagnoseBins::CARMAGROUP_SetBin failed.') end do - + return - end subroutine CARMA_DiagnoseBins - - + end subroutine CARMAMODEL_DiagnoseBins + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -295,31 +304,31 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return - end subroutine CARMA_DiagnoseBulk - - + end subroutine CARMAMODEL_DiagnoseBulk + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no !! emission, but this routine can be overridden for models that wish to have !! an aerosol emission. !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -328,7 +337,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use camsrfexch, only: cam_in_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -338,6 +347,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure integer :: ncol ! number of columns in chunk @@ -362,15 +372,15 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend doy = floor(calday) ncol = state%ncol - + ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. tendency(:ncol, :pver) = 0.0_r8 - + return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -381,13 +391,14 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst implicit none - + type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. @@ -396,7 +407,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -408,12 +419,12 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon + use pmgrid, only: plev implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -438,22 +449,62 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 ! q(:, plev-1) = 100e-9_r8 ! bottom end where - end if - + end if + return - end subroutine CARMA_InitializeParticle - - + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -461,13 +512,101 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + ! Default return code. rc = RC_OK - + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/test_passive/carma_model_mod.F90 b/src/physics/carma/models/test_passive/carma_model_mod.F90 index d616a2066a..150f1d8a5f 100644 --- a/src/physics/carma/models/test_passive/carma_model_mod.F90 +++ b/src/physics/carma/models/test_passive/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -15,8 +15,8 @@ !! index of (1.55, 4e-3). The particles are not subject to particle swelling, but !! do coagulate. !! -!! @version May-2009 -!! @author Chuck Bardeen +!! @version May-2009 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -30,7 +30,7 @@ module carma_model_mod use carmastate_mod use carma_mod use carma_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use cam_abortutils, only: endrun use physics_types, only: physics_state, physics_ptend @@ -42,26 +42,35 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition - + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition + ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups integer, public, parameter :: NELEM = 1 !! Number of particle elements integer, public, parameter :: NBIN = 16 !! Number of particle bins integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes integer, public, parameter :: NGAS = 0 !! Number of gases - + ! These need to be defined, but are only used when the particles are radiatively active. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) - + + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -70,19 +79,19 @@ module carma_model_mod ! Define any particle compositions that are used. Each composition type ! should have a unique number. integer, public, parameter :: I_DUST = 1 !! dust composition - + contains !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_DUST = 2.0_f ! density of dust particles (g/cm) real(kind=f), parameter :: rmin = 1e-5_f ! minimum radius (cm) @@ -90,7 +99,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Default return code. rc = RC_OK - + ! Define the Groups ! ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. @@ -101,45 +110,45 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, 1, "Dust", rmin, vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.15_f, & scavcoef=0.1_f, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - - + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') + + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') + - ! Define the Solutes - + ! Define the Gases - + ! Define the Processes call CARMA_AddCoagulation(carma, 1, 1, 1, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -149,27 +158,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -178,32 +187,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return - end subroutine CARMA_DiagnoseBins - - + end subroutine CARMAMODEL_DiagnoseBins + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -214,31 +223,31 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return - end subroutine CARMA_DiagnoseBulk - - + end subroutine CARMAMODEL_DiagnoseBulk + + !! Calculates the emissions for CARMA aerosol particles. By default, there is no !! emission, but this routine can be overridden for models that wish to have !! an aerosol emission. !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -247,7 +256,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use camsrfexch, only: cam_in_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -257,6 +266,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure integer :: ncol ! number of columns in chunk @@ -281,15 +291,15 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend doy = floor(calday) ncol = state%ncol - + ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. tendency(:ncol, :pver) = 0.0_r8 - + return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -300,13 +310,14 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst implicit none - + type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. @@ -315,7 +326,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -327,12 +338,12 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon + use pmgrid, only: plev implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -357,22 +368,62 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 ! q(:, plev-1) = 100e-9_r8 ! bottom end where - end if - + end if + return - end subroutine CARMA_InitializeParticle - - + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + + return + end subroutine CARMAMODEL_CreateOpticsFile + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -380,13 +431,102 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_WetDeposition + + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + ! Default return code. rc = RC_OK - + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/test_radiative/carma_model_mod.F90 b/src/physics/carma/models/test_radiative/carma_model_mod.F90 index c394c8e220..d1b248df5a 100644 --- a/src/physics/carma/models/test_radiative/carma_model_mod.F90 +++ b/src/physics/carma/models/test_radiative/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -15,8 +15,8 @@ !! index of (1.55, 4e-3). The particles are not subject to particle swelling, but !! do coagulate. !! -!! @version May-2009 -!! @author Chuck Bardeen +!! @version May-2009 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -30,7 +30,7 @@ module carma_model_mod use carmastate_mod use carma_mod use carma_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use cam_abortutils, only: endrun use physics_types, only: physics_state, physics_ptend @@ -42,15 +42,20 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition - + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition + ! Declare public constants integer, public, parameter :: NGROUP = 1 !! Number of particle groups integer, public, parameter :: NELEM = 1 !! Number of particle elements @@ -64,7 +69,11 @@ module carma_model_mod !! humidities. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) = (/ 0._f, 0.5_f, 0.7_f, 0.8_f, 0.9_f, 0.95_f, 0.98_f, 0.99_f /) - + + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -73,32 +82,32 @@ module carma_model_mod ! Define any particle compositions that are used. Each composition type ! should have a unique number. integer, public, parameter :: I_DUST = 1 !! dust composition - + contains !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_DUST = 2.0_f ! density of dust particles (g/cm) real(kind=f), parameter :: rmin = 1e-5_f ! minimum radius (cm) real(kind=f), parameter :: vmrat = 2.0_f ! volume ratio - complex(kind=f) :: refidx(NWAVE) ! refractice indices + complex(kind=f) :: refidx(NWAVE, NREFIDX) ! refractice indices ! Default return code. rc = RC_OK - + ! Use the same refractive index at all wavelengths. This value is typical of dust in ! the visible. - refidx(:) = (1.55_f, 4e-3_f) - + refidx(:,1) = (1.55_f, 4e-3_f) + ! Define the Groups ! ! NOTE: If NWAVE > 0 then the group should have refractive indices defined. @@ -108,46 +117,46 @@ subroutine CARMA_DefineModel(carma, rc) ! should also be defined. call CARMAGROUP_Create(carma, 1, "Dust", rmin, vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.15_f, & - scavcoef=0.1_f, shortname="DUST", refidx=refidx, do_mie=.true.) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - - + scavcoef=0.1_f, shortname="DUST", do_mie=.true.) + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') + + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. - call CARMAELEMENT_Create(carma, 1, 1, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="DUST") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + call CARMAELEMENT_Create(carma, 1, 1, "Dust", RHO_DUST, I_INVOLATILE, I_DUST, rc, shortname="DUST", refidx=refidx) + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') + - ! Define the Solutes - + ! Define the Gases - + ! Define the Processes call CARMA_AddCoagulation(carma, 1, 1, 1, I_COLLEC_DATA, rc) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddCoagulation failed.') return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -157,27 +166,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -186,32 +195,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return - end subroutine CARMA_DiagnoseBins - - + end subroutine CARMAMODEL_DiagnoseBins + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -222,22 +231,22 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -246,7 +255,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -255,7 +264,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use camsrfexch, only: cam_in_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -265,6 +274,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure integer :: ncol ! number of columns in chunk @@ -289,15 +299,15 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend doy = floor(calday) ncol = state%ncol - + ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. tendency(:ncol, :pver) = 0.0_r8 - + return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -308,13 +318,14 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst implicit none - + type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. @@ -323,7 +334,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -335,12 +346,12 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon + use pmgrid, only: plev implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -365,22 +376,62 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 ! q(:, plev-1) = 100e-9_r8 ! bottom end where - end if - + end if + + return + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + return - end subroutine CARMA_InitializeParticle + end subroutine CARMAMODEL_CreateOpticsFile - !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -388,13 +439,101 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_WetDeposition - -end module + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputDiagnostics + +end module carma_model_mod diff --git a/src/physics/carma/models/test_swelling/carma_model_mod.F90 b/src/physics/carma/models/test_swelling/carma_model_mod.F90 index 901f601c8a..4e98bb5cd1 100644 --- a/src/physics/carma/models/test_swelling/carma_model_mod.F90 +++ b/src/physics/carma/models/test_swelling/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -15,8 +15,8 @@ !! index of (1.55, 4e-3). The particles are not subject to particle swelling, but !! do coagulate. !! -!! @version May-2009 -!! @author Chuck Bardeen +!! @version May-2009 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -30,7 +30,7 @@ module carma_model_mod use carmastate_mod use carma_mod use carma_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use radconstants, only: nswbands, nlwbands use cam_abortutils, only: endrun @@ -43,47 +43,56 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition - + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition + ! Declare public constants integer, public, parameter :: NGROUP = 3 !! Number of particle groups integer, public, parameter :: NELEM = 3 !! Number of particle elements integer, public, parameter :: NBIN = 16 !! Number of particle bins integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes integer, public, parameter :: NGAS = 0 !! Number of gases - + ! These need to be defined, but are only used when the particles are radiatively active. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) - + + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. logical, public :: is_convtran1(NGROUP) = .false. !! Should the group be transported in the first phase? - + ! Define any particle compositions that are used. Each composition type ! should have a unique number. integer, public, parameter :: I_SEA_SALT = 1 !! sea salt composition - + contains !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: RHO_SALT = 2.65_f ! dry density of sea salt particles (g/cm) real(kind=f), parameter :: rmin = 1e-6_f ! minimum radius (cm) @@ -91,7 +100,7 @@ subroutine CARMA_DefineModel(carma, rc) ! Default return code. rc = RC_OK - + ! Define the Groups ! ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be @@ -100,61 +109,61 @@ subroutine CARMA_DefineModel(carma, rc) call CARMAGROUP_Create(carma, 1, "None", rmin, vmrat, I_SPHERE, 1._f, .false., & rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="SALT") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') call CARMAGROUP_Create(carma, 2, "Fitzgerald", rmin, vmrat, I_SPHERE, 1._f, & .false., rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="SALTFZ", irhswell=I_FITZGERALD, & irhswcomp=I_SWF_NACL) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') call CARMAGROUP_Create(carma, 3, "Gerber", rmin, vmrat, I_SPHERE, 1._f, & .false., rc, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, & scavcoef=0.1_f, shortname="SALTGB", irhswell=I_GERBER, & irhswcomp=I_SWG_SEA_SALT) - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.') - - + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddGroup failed.') + + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "None", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALT") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') call CARMAELEMENT_Create(carma, 2, 2, "Fitz", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALTFZ") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') - + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') + call CARMAELEMENT_Create(carma, 3, 3, "Gerb", RHO_SALT, I_INVOLATILE, I_SEA_SALT, rc, shortname="SALTGB") - if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.') + if (rc < 0) call endrun('CARMAMODEL_DefineModel::CARMA_AddElement failed.') + - ! Define the Solutes - + ! Define the Gases - + ! Define the Processes return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -164,27 +173,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -193,32 +202,32 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return - end subroutine CARMA_DiagnoseBins - - + end subroutine CARMAMODEL_DiagnoseBins + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -229,22 +238,22 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + ! Default return code. rc = RC_OK ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + return - end subroutine CARMA_DiagnoseBulk + end subroutine CARMAMODEL_DiagnoseBulk !! Calculates the emissions for CARMA aerosol particles. By default, there is no @@ -253,7 +262,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -262,7 +271,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use camsrfexch, only: cam_in_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -272,6 +281,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure integer :: ncol ! number of columns in chunk @@ -296,15 +306,15 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend doy = floor(calday) ncol = state%ncol - + ! Add any surface flux here. surfaceFlux(:ncol) = 0.0_r8 - + ! For emissions into the atmosphere, put the emission here. tendency(:ncol, :pver) = 0.0_r8 - + return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -312,13 +322,14 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst implicit none - + type(carma_type), intent(in) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. @@ -327,7 +338,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) ! Add initialization here. return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -339,12 +350,12 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon + use pmgrid, only: plev implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -367,21 +378,61 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, ! q(:, 3*plev/4) = 100e-9_r8 ! 3/4 ! q(:, plev-1) = 100e-9_r8 ! bottom end where - + + return + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + return - end subroutine CARMA_InitializeParticle - - + end subroutine CARMAMODEL_CreateOpticsFile + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -389,13 +440,102 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_WetDeposition + + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + ! Default return code. rc = RC_OK - + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/test_tracers/carma_model_mod.F90 b/src/physics/carma/models/test_tracers/carma_model_mod.F90 index f357a6defd..40aa2b911c 100644 --- a/src/physics/carma/models/test_tracers/carma_model_mod.F90 +++ b/src/physics/carma/models/test_tracers/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -11,7 +11,7 @@ !! microphysics has its own version of this file. !! !! This file is a test case that uses CARMA groups and bins to implement a -!! tracer trajectory test for the Asian Monsoon region. This is the reverse of +!! tracer trajectory test for the Asian Monsoon region. This is the reverse of !! back trajectory calculations being done by John Bergman. In this model each !! group is a region of the model and each bin represents a day. Emissions !! start on the carma_launch_doy and then continue for NBINS days. @@ -20,8 +20,8 @@ !! the number of regions or days tracked, you also need to reduce the number of !! advected constituents added in configure. !! -!! @version April-2011 -!! @author Chuck Bardeen +!! @version April-2011 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -36,7 +36,7 @@ module carma_model_mod use carma_mod use carma_flags_mod use carma_model_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use radconstants, only: nswbands, nlwbands use cam_abortutils, only: endrun @@ -49,26 +49,35 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition - + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition + ! Declare public constants integer, public, parameter :: NGROUP = 6 !! Number of particle groups integer, public, parameter :: NELEM = 6 !! Number of particle elements integer, public, parameter :: NBIN = 62 !! Number of particle bins integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes integer, public, parameter :: NGAS = 0 !! Number of gases - + ! These need to be defined, but are only used when the particles are radiatively active. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) - + + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -77,10 +86,10 @@ module carma_model_mod ! Define any particle compositions that are used. Each composition type ! should have a unique number. integer, public, parameter :: I_INERT = 1 !! tracer composition - + real(kind=f), public :: rgn_minlat(NELEM-1) = (/ 0._f, 0._f, 0._f, 0._f, 0._f /) real(kind=f), public :: rgn_maxlat(NELEM-1) = (/ 40._f, 40._f, 40._f, 40._f, 40._f /) - + real(kind=f), public :: rgn_minlon(NELEM-1) = (/ 60._f, 60._f, 105._f, 60._f, 105._f /) real(kind=f), public :: rgn_maxlon(NELEM-1) = (/ 105._f, 105._f, 140._f, 105._f, 140._f /) @@ -96,24 +105,24 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: rmin = 2.5e-4_f ! minimum radius (cm) real(kind=f), parameter :: vmrat = 1.00001_f ! volume ratio integer :: LUNOPRT logical :: do_print - + ! Default return code. rc = RC_OK - + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_Get failed.') + ! Report model specific configuration parameters. if (masterproc) then if (do_print) then @@ -132,75 +141,75 @@ subroutine CARMA_DefineModel(carma, rc) ! defined. If wetdep is defined, then the optional solubility factor ! should also be defined. call CARMAGROUP_Create(carma, 1, "Region 1", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG1") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') + call CARMAGROUP_Create(carma, 2, "Region 2", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG2") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') + call CARMAGROUP_Create(carma, 3, "Region 3", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG3") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 4, "Region 4", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG4") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 5, "Region 5", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG5") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 6, "Rest of World", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG6") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') - - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') + + ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "Region 1", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG1") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') + call CARMAELEMENT_Create(carma, 2, 2, "Region 2", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG2") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') + call CARMAELEMENT_Create(carma, 3, 3, "Region 3", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG3") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 4, 4, "Region 4", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG4") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 5, 5, "Region 5", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG5") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 6, 6, "Rest of World", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG6") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') + - ! Define the Solutes - + ! Define the Gases - + ! Define the Processes return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair, cappa use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, is_perpetual implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -210,27 +219,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -239,30 +248,30 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return - end subroutine CARMA_DiagnoseBins - - + end subroutine CARMAMODEL_DiagnoseBins + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! When the tracer hits at the surface at a time other than on its launch day, !! it will be removed from the model. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver @@ -272,7 +281,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -283,14 +292,14 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + real(r8) :: calday ! current calendar day integer :: yr ! year integer :: mon ! month @@ -298,16 +307,16 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, integer :: ncsec ! time of day (seconds) integer :: doy ! day of year integer :: elapsed ! days since launch - - + + ! Default return code. rc = RC_OK ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + if (present(re_ice)) re_ice(:,:) = 0.0_f - + ! Determine the day of year. calday = get_curr_calday() if ( is_perpetual() ) then @@ -316,18 +325,18 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, call get_curr_date(yr, mon, day, ncsec) end if doy = floor(calday) - + ! Any material that has made it to the surface from a previous day should be removed. elapsed = doy - carma_launch_doy - + if (elapsed > 1) then cstate%f_pc(pver, 1:min(NBIN,elapsed-1), :NELEM) = 0._f end if - + return - end subroutine CARMA_DiagnoseBulk - - + end subroutine CARMAMODEL_DiagnoseBulk + + !! Calculates the emissions for CARMA aerosol particles. !! !! Emit particles after the specified launch day, with each bin being used @@ -352,7 +361,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -362,7 +371,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use physconst, only: gravit implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -372,6 +381,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure real(r8) :: lat(state%ncol) ! latitude (degrees) @@ -421,10 +431,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend ! Determine the region based upon latitude and longitude. The last region is ! defined to be rest of the world (i.e. all regions not in another region). doRegion = .False. - + if (ielem == NELEM) then doRegion = .True. - + do i = 1, NELEM-1 if ((rgn_minlat(i) < lat(icol)) .and. (lat(icol) <= rgn_maxlat(i)) .and. & (rgn_minlon(i) < lon(icol)) .and. (lon(icol) <= rgn_maxlon(i))) then @@ -442,7 +452,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend doPS = .False. if (rgn_ps(ielem) == 0._f) then doPS = .True. - else + else if (rgn_ps(ielem) > 0._f) then if (state%ps(icol) > rgn_ps(ielem)) then doPS = .True. @@ -450,10 +460,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend else if (state%ps(icol) <= abs(rgn_ps(ielem))) then doPS = .True. - end if + end if end if end if - + ! Calculate the emission rate as a constant mass. if (doRegion .and. doPS) then @@ -464,14 +474,14 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend else ! For mmr, calculate a tendecy to keep the surface at that emitted value, ! rather than having a constant emission rate. -! tendency(icol, pver) = -carma_emission_rate - tendency(icol, pver) = ((-carma_emission_rate * dt) - state%q(icol, pver, icnst)) / dt +! tendency(icol, pver) = -carma_emission_rate + tendency(icol, pver) = ((-carma_emission_rate * dt) - state%q(icol, pver, icnst)) / dt end if end if ! Scale with the land/ocean fraction. frac = 0._f - + if (rgn_doLand(ielem)) then frac = frac + cam_in%landfrac(icol) end if @@ -487,9 +497,9 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend tendency(icol, pver) = tendency(icol, pver) * frac end do end if - + return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -500,20 +510,22 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst + implicit none - + type(carma_type), intent(inout) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. rc = RC_OK - + return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -525,12 +537,11 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -551,21 +562,61 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q(:,i) = 0._r8 end where end do - + + return + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + return - end subroutine CARMA_InitializeParticle - - + end subroutine CARMAMODEL_CreateOpticsFile + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -573,13 +624,100 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + + return + end subroutine CARMAMODEL_WetDeposition + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/test_tracers2/carma_model_mod.F90 b/src/physics/carma/models/test_tracers2/carma_model_mod.F90 index e5595a367e..d6a74c4d12 100644 --- a/src/physics/carma/models/test_tracers2/carma_model_mod.F90 +++ b/src/physics/carma/models/test_tracers2/carma_model_mod.F90 @@ -1,4 +1,4 @@ -!! This module is used to define a particular CARMA microphysical model. For +!! This module is used to define a particular CARMA microphysical model. For !! simple cases, this may be the only code that needs to be modified. This module !! defines several constants and has three methods: !! @@ -11,7 +11,7 @@ !! microphysics has its own version of this file. !! !! This file is a test case that uses CARMA groups and bins to implement a -!! tracer trajectory test for the Guam region. This is the reverse of +!! tracer trajectory test for the Guam region. This is the reverse of !! back trajectory calculations being done by John Bergman. In this model each !! group is a region of the model and each bin represents a day. Emissions !! start on the carma_launch_doy and then continue for NBINS days. @@ -20,8 +20,8 @@ !! the number of regions or days tracked, you also need to reduce the number of !! advected constituents added in configure. !! -!! @version April-2011 -!! @author Chuck Bardeen +!! @version April-2011 +!! @author Chuck Bardeen module carma_model_mod use carma_precision_mod @@ -36,7 +36,7 @@ module carma_model_mod use carma_mod use carma_flags_mod use carma_model_flags_mod - + use shr_kind_mod, only: r8 => shr_kind_r8 use radconstants, only: nswbands, nlwbands use cam_abortutils, only: endrun @@ -49,26 +49,35 @@ module carma_model_mod private ! Declare the public methods. - public CARMA_DefineModel - public CARMA_Detrain - public CARMA_DiagnoseBins - public CARMA_DiagnoseBulk - public CARMA_EmitParticle - public CARMA_InitializeModel - public CARMA_InitializeParticle - public CARMA_WetDeposition - + public CARMAMODEL_CalculateCloudborneDiagnostics + public CARMAMODEL_CreateOpticsFile + public CARMAMODEL_DefineModel + public CARMAMODEL_Detrain + public CARMAMODEL_DiagnoseBins + public CARMAMODEL_DiagnoseBulk + public CARMAMODEL_EmitParticle + public CARMAMODEL_InitializeModel + public CARMAMODEL_InitializeParticle + public CARMAMODEL_OutputBudgetDiagnostics + public CARMAMODEL_OutputCloudborneDiagnostics + public CARMAMODEL_OutputDiagnostics + public CARMAMODEL_WetDeposition + ! Declare public constants integer, public, parameter :: NGROUP = 7 !! Number of particle groups integer, public, parameter :: NELEM = 7 !! Number of particle elements integer, public, parameter :: NBIN = 62 !! Number of particle bins integer, public, parameter :: NSOLUTE = 0 !! Number of particle solutes integer, public, parameter :: NGAS = 0 !! Number of gases - + ! These need to be defined, but are only used when the particles are radiatively active. integer, public, parameter :: NMIE_RH = 8 !! Number of relative humidities for mie calculations real(kind=f), public :: mie_rh(NMIE_RH) - + + integer, public, parameter :: NMIE_WTP = 0 !! Number of weight percents for mie calculations + real(kind=f), public :: mie_wtp(NMIE_WTP) + integer, public, parameter :: NREFIDX = 1 !! Number of refractive indices per element + ! Defines whether the groups should undergo deep convection in phase 1 or phase 2. ! Water vapor and cloud particles are convected in phase 1, while all other constituents ! are done in phase 2. @@ -78,7 +87,7 @@ module carma_model_mod ! should have a unique number. integer, public, parameter :: I_INERT = 1 !! tracer composition - ! Regions for ATTREX + ! Regions for ATTREX real(kind=f), public :: rgn_minlat(NELEM-1) = (/ 0._f, -20._f, -30._f, -20._f, -10._f, -30._f /) real(kind=f), public :: rgn_maxlat(NELEM-1) = (/ 20._f, 0._f, 20._f, 20._f, 20._f, -10._f /) @@ -97,24 +106,24 @@ module carma_model_mod !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen - subroutine CARMA_DefineModel(carma, rc) + !! @version May-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DefineModel(carma, rc) type(carma_type), intent(inout) :: carma !! the carma object integer, intent(out) :: rc !! return code, negative indicates failure - + ! Local variables real(kind=f), parameter :: rmin = 2.5e-4_f ! minimum radius (cm) real(kind=f), parameter :: vmrat = 1.00001_f ! volume ratio integer :: LUNOPRT logical :: do_print - + ! Default return code. rc = RC_OK - + call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT) - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_Get failed.') - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMA_Get failed.') + ! Report model specific configuration parameters. if (masterproc) then if (do_print) then @@ -133,81 +142,81 @@ subroutine CARMA_DefineModel(carma, rc) ! defined. If wetdep is defined, then the optional solubility factor ! should also be defined. call CARMAGROUP_Create(carma, 1, "Region 1", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG1") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') + call CARMAGROUP_Create(carma, 2, "Region 2", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG2") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') + call CARMAGROUP_Create(carma, 3, "Region 3", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG3") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 4, "Region 4", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG4") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 5, "Region 5", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG5") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 6, "Region 6", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG6") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') call CARMAGROUP_Create(carma, 7, "Rest of World", rmin, vmrat, I_SPHERE, 1._f, .True., rc, shortname="CRRG7") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGROUP_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAGROUP_Create failed.') + - ! Define the Elements ! ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names ! should be 6 characters or less and without spaces. call CARMAELEMENT_Create(carma, 1, 1, "Region 1", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG1") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') + call CARMAELEMENT_Create(carma, 2, 2, "Region 2", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG2") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') - + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') + call CARMAELEMENT_Create(carma, 3, 3, "Region 3", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG3") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 4, 4, "Region 4", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG4") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 5, 5, "Region 5", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG5") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 6, 6, "Region 6", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG6") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') call CARMAELEMENT_Create(carma, 7, 7, "Rest of World", WTMOL_AIR, I_INVOLATILE, I_INERT, rc, shortname="CRRG7") - if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAElement_Create failed.') + if (rc < RC_OK) call endrun('CARMAMODEL_DefineModel::CARMAElement_Create failed.') + - ! Define the Solutes - + ! Define the Gases - + ! Define the Processes return - end subroutine CARMA_DefineModel + end subroutine CARMAMODEL_DefineModel !! Defines all the CARMA components (groups, elements, solutes and gases) and process !! (coagulation, growth, nucleation) that will be part of the microphysical model. !! - !! @version May-2009 - !! @author Chuck Bardeen + !! @version May-2009 + !! @author Chuck Bardeen !! !! @see CARMASTATE_SetDetrain - subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & + subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, & tnd_qsnow, tnd_nsnow) use camsrfexch, only: cam_in_t use physconst, only: latice, latvap, cpair, cappa use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, is_perpetual implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_in_t), intent(in) :: cam_in !! surface input @@ -217,27 +226,27 @@ subroutine CARMA_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, real(r8), intent(in) :: dt !! time step (s) integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(out), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(out), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) - + ! Default return code. rc = RC_OK - + return - end subroutine CARMA_Detrain + end subroutine CARMAMODEL_Detrain !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str) use time_manager, only: is_first_step implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(physics_state), intent(in) :: state !! physics state variables @@ -246,30 +255,30 @@ subroutine CARMA_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, pr real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(in), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) - + real(r8) :: mmr(pver) !! elements mass mixing ratio integer :: ibin !! bin index - + ! Default return code. rc = RC_OK - + ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the mass in each bin from the CAM state. - + return - end subroutine CARMA_DiagnoseBins - - + end subroutine CARMAMODEL_DiagnoseBins + + !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins. !! !! When the tracer hits at the surface at a time other than on its launch day, !! it will be removed from the model. !! - !! @version July-2009 - !! @author Chuck Bardeen - subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & + !! @version July-2009 + !! @author Chuck Bardeen + subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, & prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver @@ -279,7 +288,7 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object type(carmastate_type), intent(inout) :: cstate !! the carma state object type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models @@ -290,14 +299,14 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, real(r8), intent(in) :: dt !! time step integer, intent(out) :: rc !! return code, negative indicates failure real(r8), intent(inout), optional :: rliq(pcols) !! vertical integral of liquid not yet in q(ixcldliq) - real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) + real(r8), intent(inout), optional :: prec_str(pcols) !! [Total] sfc flux of precip from stratiform (m/s) real(r8), intent(inout), optional :: snow_str(pcols) !! [Total] sfc flux of snow from stratiform (m/s) real(r8), intent(inout), optional :: prec_sed(pcols) !! total precip from cloud sedimentation (m/s) real(r8), intent(inout), optional :: snow_sed(pcols) !! snow from cloud ice sedimentation (m/s) real(r8), intent(inout), optional :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s) real(r8), intent(inout), optional :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s) real(r8), intent(out), optional :: re_ice(pcols,pver) !! ice effective radius (m) - + real(r8) :: calday ! current calendar day integer :: yr ! year integer :: mon ! month @@ -305,16 +314,16 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, integer :: ncsec ! time of day (seconds) integer :: doy ! day of year integer :: elapsed ! days since launch - - + + ! Default return code. rc = RC_OK ! By default, do nothing. If diagnosed groups exist, this needs to be replaced by ! code to determine the bulk mass from the CARMA state. - + if (present(re_ice)) re_ice(:,:) = 0.0_f - + ! Determine the day of year. calday = get_curr_calday() if ( is_perpetual() ) then @@ -323,18 +332,18 @@ subroutine CARMA_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, call get_curr_date(yr, mon, day, ncsec) end if doy = floor(calday) - + ! Any material that has made it to the surface from a previous day should be removed. elapsed = doy - carma_launch_doy - + if (elapsed > 1) then cstate%f_pc(pver, 1:min(NBIN,elapsed-1), :NELEM) = 0._f end if - + return - end subroutine CARMA_DiagnoseBulk - - + end subroutine CARMAMODEL_DiagnoseBulk + + !! Calculates the emissions for CARMA aerosol particles. !! !! Emit particles after the specified launch day, with each bin being used @@ -359,7 +368,7 @@ end subroutine CARMA_DiagnoseBulk !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, rc) + subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc) use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use physics_types, only: physics_state @@ -369,7 +378,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use physconst, only: gravit implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -379,6 +388,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend type(cam_in_t), intent(in) :: cam_in !! surface inputs real(r8), intent(out) :: tendency(pcols, pver) !! constituent tendency (kg/kg/s) real(r8), intent(out) :: surfaceFlux(pcols) !! constituent surface flux (kg/m^2/s) + type(physics_buffer_desc), pointer :: pbuf(:) !! physics buffer integer, intent(out) :: rc !! return code, negative indicates failure real(r8) :: lat(state%ncol) ! latitude (degrees) @@ -420,19 +430,19 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend if ((elapsed + 1) == ibin) then ! Determine the latitude and longitude of each column. - + lat = state%lat(:ncol) / DEG2RAD lon = state%lon(:ncol) / DEG2RAD - + do icol = 1, ncol ! Determine the region based upon latitude and longitude. The last region is ! defined to be rest of the world (i.e. all regions not in another region). doRegion = .False. - + if (ielem == NELEM) then doRegion = .True. - + do i = 1, NELEM-1 if ((rgn_minlat(i) < lat(icol)) .and. (lat(icol) <= rgn_maxlat(i)) .and. & (rgn_minlon(i) < lon(icol)) .and. (lon(icol) <= rgn_maxlon(i))) then @@ -450,7 +460,7 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend doPS = .False. if (rgn_ps(ielem) == 0._f) then doPS = .True. - else + else if (rgn_ps(ielem) > 0._f) then if (state%ps(icol) > rgn_ps(ielem)) then doPS = .True. @@ -458,10 +468,10 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend else if (state%ps(icol) <= abs(rgn_ps(ielem))) then doPS = .True. - end if + end if end if end if - + ! Calculate the emission rate as a constant mass. if (doRegion .and. doPS) then @@ -472,14 +482,14 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend else ! For mmr, calculate a tendecy to keep the surface at that emitted value, ! rather than having a constant emission rate. -! tendency(icol, pver) = -carma_emission_rate - tendency(icol, pver) = ((-carma_emission_rate * dt) - state%q(icol, pver, icnst)) / dt +! tendency(icol, pver) = -carma_emission_rate + tendency(icol, pver) = ((-carma_emission_rate * dt) - state%q(icol, pver, icnst)) / dt end if end if ! Scale with the land/ocean fraction. frac = 0._f - + if (rgn_doLand(ielem)) then frac = frac + cam_in%landfrac(icol) end if @@ -495,9 +505,9 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend tendency(icol, pver) = tendency(icol, pver) * frac end do end if - + return - end subroutine CARMA_EmitParticle + end subroutine CARMAMODEL_EmitParticle !! Allows the model to perform its own initialization in addition to what is done @@ -508,20 +518,21 @@ end subroutine CARMA_EmitParticle !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeModel(carma, lq_carma, rc) + subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc) use constituents, only : pcnst implicit none - + type(carma_type), intent(inout) :: carma !! the carma object logical, intent(inout) :: lq_carma(pcnst) !! flags to indicate whether the constituent !! could have a CARMA tendency + type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer, intent(out) :: rc !! return code, negative indicates failure ! Default return code. rc = RC_OK - + return - end subroutine CARMA_InitializeModel + end subroutine CARMAMODEL_InitializeModel !! Sets the initial condition for CARMA aerosol particles. By default, there are no @@ -533,12 +544,11 @@ end subroutine CARMA_InitializeModel !! !! @author Chuck Bardeen !! @version May-2009 - subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) + subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc) use shr_kind_mod, only: r8 => shr_kind_r8 - use pmgrid, only: plat, plev, plon implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -559,21 +569,61 @@ subroutine CARMA_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q(:,i) = 0._r8 end where end do - + + return + end subroutine CARMAMODEL_InitializeParticle + + !! This routine is an extension of CARMA_CreateOpticsFile() that allows for + !! model specific tables to be created in addition to the model independent + !! methods that are in carma_intr.F90. + !! + !! The opticsType that is specified for the group determines how the optical + !! properties will be generated for that group. Each group can use a different + !! optics method if needed. Refractive indices need for these calculation are + !! are specified in the group's elements rather than at the group level. This + !! allows various mixing approaches to be used to determine the refractive index + !! for the particle as a whole. If the refractive index for water is needed, + !! it is specific the the CARMAGAS object for H2O. + subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc) + + implicit none + + type(carma_type), intent(inout) :: carma !! the carma object + integer, intent(in) :: igroup !! group identifier + integer, intent(in) :: opticsType !! optics type (see I_OPTICS_... in carma_enums.F90) + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Local variables + logical :: do_mie + integer :: cnsttype ! constituent type + + ! Assume success. + rc = 0 + + ! What type of calculation is needed for this group? + ! + ! NOTE: Some of these calculations generate optical properties as single mass + ! coefficients, while others are lookup tables designed around multiple + ! dimensions. + select case (opticsType) + + case default + call endrun('carma_CreateOpticsFile:: Unknown optics type.') + end select + return - end subroutine CARMA_InitializeParticle - - + end subroutine CARMAMODEL_CreateOpticsFile + !! Called after wet deposition has been performed. Allows the specific model to add !! wet deposition of CARMA aerosols to the aerosols being communicated to the surface. !! - !! @version July-2011 - !! @author Chuck Bardeen - subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) + !! @version July-2011 + !! @author Chuck Bardeen + subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) use camsrfexch, only: cam_out_t implicit none - + type(carma_type), intent(in) :: carma !! the carma object integer, intent(in) :: ielem !! element index integer, intent(in) :: ibin !! bin index @@ -581,13 +631,101 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) type(cam_out_t), intent(inout) :: cam_out !! cam output to surface models type(physics_state), intent(in) :: state !! physics state variables integer, intent(out) :: rc !! return code, negative indicates failure - + integer :: icol - + ! Default return code. rc = RC_OK - + + return + end subroutine CARMAMODEL_WetDeposition + + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc) + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(out) :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_CalculateCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc) + use cam_history, only: outfld + use constituents, only: pcnst, cnst_get_ind + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + integer, intent(in) :: icnst4gas(NGAS) !! constituent index for a carma gas + type(physics_state), intent(in) :: state !! Physics state variables - before pname + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + real(r8) :: old_cflux(pcols,pcnst) !! cam_in%clfux from before the timestep_tend + real(r8) :: cflux(pcols,pcnst) !! cam_in%clfux from after the timestep_tend + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputBudgetDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc) + use cam_history, only: outfld + + type(carma_type), intent(in) :: carma !! the carma object + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + real(r8), intent(in) :: dt !! timestep (s) + character(*), intent(in) :: pname !! short name of the physics package + real(r8), intent(in ) :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + + return + end subroutine CARMAMODEL_OutputCloudborneDiagnostics + + !! Called at the end of the timestep after all the columns have been processed to + !! to allow additional diagnostics that have been stored in pbuf to be output. + !! + !! Stub version + subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc) + use cam_history, only: outfld + use constituents, only: cnst_get_ind + use camsrfexch, only: cam_in_t + + type(carma_type), intent(in) :: carma !! the carma object + integer, intent(in) :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element + type(physics_state), intent(in) :: state !! Physics state variables - before CARMA + type(physics_ptend), intent(in) :: ptend !! indivdual parameterization tendencies + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) !! physics buffer + type(cam_in_t), intent(in) :: cam_in !! surface inputs + integer, intent(out) :: rc !! return code, negative indicates failure + + ! Default return code. + rc = RC_OK + return - end subroutine CARMA_WetDeposition + end subroutine CARMAMODEL_OutputDiagnostics -end module +end module carma_model_mod diff --git a/src/physics/carma/models/tholin/carma_model_mod.F90 b/src/physics/carma/models/tholin/carma_model_mod.F90 index b2eb8309c3..ac5216f130 100755 --- a/src/physics/carma/models/tholin/carma_model_mod.F90 +++ b/src/physics/carma/models/tholin/carma_model_mod.F90 @@ -102,7 +102,7 @@ subroutine CARMA_DefineModel(carma, rc) integer, intent(out) :: rc !! return code, negative indicates failure ! Local variables - real(kind=f) :: RHO_THOLIN = 0.64 ! density of tholin particles (g/cm) + real(kind=f) :: RHO_THOLIN = 0.64_f ! density of tholin particles (g/cm) real(kind=f), parameter :: tholin_rmin = 1.e-7_f ! dust minimum radius (cm) real(kind=f), parameter :: tholin_vmrat = 2.5_f ! dust volume ratio @@ -293,7 +293,6 @@ subroutine CARMA_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tend use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & is_perpetual, is_first_step use camsrfexch, only: cam_in_t - use tropopause, only: tropopause_find use physconst, only: gravit implicit none @@ -510,7 +509,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) carma_emis_ilev_max = carma_emis_nLevs do ilev = 1, carma_emis_nLevs - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_min = ilev + 1 else exit @@ -518,7 +517,7 @@ subroutine CARMA_InitializeModel(carma, lq_carma, rc) end do do ilev = carma_emis_nLevs, 1, -1 - if (carma_emis_rate(ilev) <= 0.0) then + if (carma_emis_rate(ilev) <= 0.0_r8) then carma_emis_ilev_max = ilev - 1 else exit @@ -640,4 +639,4 @@ subroutine CARMA_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc) return end subroutine CARMA_WetDeposition -end module +end module carma_model_mod diff --git a/src/physics/clubb b/src/physics/clubb new file mode 160000 index 0000000000..15e802092f --- /dev/null +++ b/src/physics/clubb @@ -0,0 +1 @@ +Subproject commit 15e802092f65b3a20e5d67cb32d40f8a2771ca9b diff --git a/src/physics/cosp2/.cosp_sparse_checkout b/src/physics/cosp2/.cosp_sparse_checkout new file mode 100644 index 0000000000..4f00cd9a73 --- /dev/null +++ b/src/physics/cosp2/.cosp_sparse_checkout @@ -0,0 +1 @@ +/src/ diff --git a/src/physics/cosp2/Makefile.in b/src/physics/cosp2/Makefile.in index 69a37713fa..881a1a5679 100644 --- a/src/physics/cosp2/Makefile.in +++ b/src/physics/cosp2/Makefile.in @@ -65,10 +65,10 @@ cosp_grLidar532_interface.o: cosp_kinds.o cosp_atlid_interface.o : cosp_kinds.o cosp_cloudsat_interface.o : cosp_kinds.o cosp_config.o quickbeam.o cosp_isccp_interface.o : cosp_kinds.o icarus.o -cosp_misr_interface.o : cosp_kinds.o +cosp_misr_interface.o : cosp_kinds.o cosp_modis_interface.o : cosp_kinds.o cosp_config.o modis_simulator.o cosp_rttov_interfaceSTUB.o : cosp_kinds.o cosp_config.o cosp_rttovSTUB.o -cosp_parasol_interface.o : cosp_kinds.o +cosp_parasol_interface.o : cosp_kinds.o cosp_rttovSTUB.o : cosp_kinds.o cosp_config.o cosp_constants.o MISR_simulator.o : cosp_kinds.o cosp_config.o cosp_stats.o modis_simulator.o : cosp_kinds.o cosp_config.o cosp_stats.o @@ -82,7 +82,7 @@ scops.o : cosp_kinds.o mo_rng.o cosp_errorHandling.o prec_scops.o : cosp_kinds.o cosp_config.o cosp_optics.o : cosp_kinds.o cosp_constants.o modis_simulator.o quickbeam_optics.o : cosp_kinds.o cosp_config.o cosp_constants.o quickbeam.o \ - cosp_errorHandling.o array_lib.o math_lib.o optics_lib.o + cosp_errorHandling.o array_lib.o math_lib.o optics_lib.o optics_lib.o : cosp_kinds.o cosp_errorHandling.o array_lib.o : cosp_kinds.o cosp_errorHandling.o math_lib.o : cosp_kinds.o array_lib.o mrgrnk.o @@ -107,37 +107,37 @@ quickbeam.o: $(RS_PATH)/quickbeam.F90 MISR_simulator.o : $(MISR_PATH)/MISR_simulator.F90 $(F90) $(F90FLAGS) -c $< -modis_simulator.o : $(MODIS_PATH)/modis_simulator.F90 +modis_simulator.o : $(MODIS_PATH)/modis_simulator.F90 $(F90) $(F90FLAGS) -c $< -cosp_rttov_interfaceSTUB.o : $(COSP_PATH)/src/simulator/cosp_rttov_interfaceSTUB.F90 +cosp_rttov_interfaceSTUB.o : $(COSP_PATH)/src/src/simulator/cosp_rttov_interfaceSTUB.F90 $(F90) $(F90FLAGS) -c $< -cosp_misr_interface.o : $(COSP_PATH)/src/simulator/cosp_misr_interface.F90 +cosp_misr_interface.o : $(COSP_PATH)/src/src/simulator/cosp_misr_interface.F90 $(F90) $(F90FLAGS) -c $< -cosp_modis_interface.o : $(COSP_PATH)/src/simulator/cosp_modis_interface.F90 +cosp_modis_interface.o : $(COSP_PATH)/src/src/simulator/cosp_modis_interface.F90 $(F90) $(F90FLAGS) -c $< -cosp_isccp_interface.o : $(COSP_PATH)/src/simulator/cosp_isccp_interface.F90 +cosp_isccp_interface.o : $(COSP_PATH)/src/src/simulator/cosp_isccp_interface.F90 $(F90) $(F90FLAGS) -c $< -cosp_calipso_interface.o : $(COSP_PATH)/src/simulator/cosp_calipso_interface.F90 +cosp_calipso_interface.o : $(COSP_PATH)/src/src/simulator/cosp_calipso_interface.F90 $(F90) $(F90FLAGS) -c $< -cosp_grLidar532_interface.o : $(COSP_PATH)/src/simulator/cosp_grLidar532_interface.F90 +cosp_grLidar532_interface.o : $(COSP_PATH)/src/src/simulator/cosp_grLidar532_interface.F90 $(F90) $(F90FLAGS) -c $< -cosp_atlid_interface.o : $(COSP_PATH)/src/simulator/cosp_atlid_interface.F90 +cosp_atlid_interface.o : $(COSP_PATH)/src/src/simulator/cosp_atlid_interface.F90 $(F90) $(F90FLAGS) -c $< -cosp_cloudsat_interface.o : $(COSP_PATH)/src/simulator/cosp_cloudsat_interface.F90 +cosp_cloudsat_interface.o : $(COSP_PATH)/src/src/simulator/cosp_cloudsat_interface.F90 $(F90) $(F90FLAGS) -c $< -cosp_parasol_interface.o : $(COSP_PATH)/src/simulator/cosp_parasol_interface.F90 +cosp_parasol_interface.o : $(COSP_PATH)/src/src/simulator/cosp_parasol_interface.F90 $(F90) $(F90FLAGS) -c $< -cosp_rttovSTUB.o : $(RT_PATH)/cosp_rttovSTUB.F90 +cosp_rttovSTUB.o : $(RT_PATH)/cosp_rttovSTUB.F90 $(F90) $(F90FLAGS) -c $< lidar_simulator.o : $(CS_PATH)/lidar_simulator.F90 @@ -146,19 +146,19 @@ lidar_simulator.o : $(CS_PATH)/lidar_simulator.F90 parasol.o : $(PARASOL_PATH)/parasol.F90 $(F90) $(F90FLAGS) -c $< -cosp_constants.o : $(COSP_PATH)/src/cosp_constants.F90 +cosp_constants.o : $(COSP_PATH)/src/src/cosp_constants.F90 $(F90) $(F90FLAGS) -c $< cosp_kinds.o : $(COSP_PATH)/cosp_kinds.F90 $(F90) $(F90FLAGS) -c $< -cosp_config.o : $(COSP_PATH)/src/cosp_config.F90 +cosp_config.o : $(COSP_PATH)/src/src/cosp_config.F90 $(F90) $(F90FLAGS) -c $< -cosp.o : $(COSP_PATH)/src/cosp.F90 +cosp.o : $(COSP_PATH)/src/src/cosp.F90 $(F90) $(F90FLAGS) -c $< -cosp_stats.o : $(COSP_PATH)/src/cosp_stats.F90 +cosp_stats.o : $(COSP_PATH)/src/src/cosp_stats.F90 $(F90) $(F90FLAGS) -c $< # COSPv1.4 interface diff --git a/src/physics/cosp2/optics/cosp_optics.F90 b/src/physics/cosp2/optics/cosp_optics.F90 index c669cd50a9..7ad9c86024 100644 --- a/src/physics/cosp2/optics/cosp_optics.F90 +++ b/src/physics/cosp2/optics/cosp_optics.F90 @@ -462,11 +462,13 @@ subroutine lidar_optics(npoints,ncolumns,nlev,npart,ice_type,q_lsliq,q_lsice,q_c ! Ice betatot_ice(1:npoints,icol,1:nlev) = betatot_ice(1:npoints,icol,1:nlev)+ & kp_part(1:npoints,1:nlev,INDX_LSICE)*alpha_part(1:npoints,1:nlev,INDX_LSICE)+ & - kp_part(1:npoints,1:nlev,INDX_CVICE)*alpha_part(1:npoints,1:nlev,INDX_CVICE) + kp_part(1:npoints,1:nlev,INDX_CVICE)*alpha_part(1:npoints,1:nlev,INDX_CVICE)+ & + kp_part(1:npoints,1:nlev,INDX_LSSNOW)*alpha_part(1:npoints,1:nlev,INDX_LSSNOW) tautot_ice(1:npoints,icol,1:nlev) = tautot_ice(1:npoints,icol,1:nlev) + & tau_part(1:npoints,1:nlev,INDX_LSICE) + & - tau_part(1:npoints,1:nlev,INDX_CVICE) - + tau_part(1:npoints,1:nlev,INDX_CVICE) + & + tau_part(1:npoints,1:nlev,INDX_LSSNOW) + ! Liquid betatot_liq(1:npoints,icol,1:nlev) = betatot_liq(1:npoints,icol,1:nlev)+ & kp_part(1:npoints,1:nlev,INDX_LSLIQ)*alpha_part(1:npoints,1:nlev,INDX_LSLIQ)+ & diff --git a/src/physics/cosp2/src b/src/physics/cosp2/src new file mode 160000 index 0000000000..34d8eef3d2 --- /dev/null +++ b/src/physics/cosp2/src @@ -0,0 +1 @@ +Subproject commit 34d8eef3d231a87c0f73e565f6b5d548876b294a diff --git a/src/physics/pumas b/src/physics/pumas new file mode 160000 index 0000000000..84f27d8042 --- /dev/null +++ b/src/physics/pumas @@ -0,0 +1 @@ +Subproject commit 84f27d804207e79e344e8deec98b471207f9b1f0 diff --git a/src/physics/pumas-frozen b/src/physics/pumas-frozen new file mode 160000 index 0000000000..be3cad3a12 --- /dev/null +++ b/src/physics/pumas-frozen @@ -0,0 +1 @@ +Subproject commit be3cad3a12d25918f5016b509b15057f84aab608 diff --git a/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 index d71fa2a897..fc2ec91a53 100644 --- a/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 @@ -182,10 +182,6 @@ subroutine swdatinit ! = (9.8066)(86400)(1e-5)/(1.004) ! heatfac = 8.4391_r8 -! Modified values for consistency with CAM3: -! = (9.80616)(86400)(1e-5)/(1.00464) -! heatfac = 8.43339130434_r8 - ! Calculate heatfac directly from CAM constants: heatfac = grav * cday * 1.e-5_r8 / (cpair * 1.e-3_r8) diff --git a/src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 index d37f392025..1622e48450 100644 --- a/src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90 @@ -43,7 +43,7 @@ subroutine reftra_sw(nlayers, ncol, lrtchk, pgg, prmuz, ptau, pw, & ! lrtchk = .t. for all layers in clear profile ! lrtchk = .t. for cloudy layers in cloud profile ! = .f. for clear layers in cloud profile -! pgg = assymetry factor +! pgg = asymmetry factor ! prmuz = cosine solar zenith angle ! ptau = optical thickness ! pw = single scattering albedo diff --git a/src/physics/rrtmg/cloud_rad_props.F90 b/src/physics/rrtmg/cloud_rad_props.F90 deleted file mode 100644 index 5fa8440fb5..0000000000 --- a/src/physics/rrtmg/cloud_rad_props.F90 +++ /dev/null @@ -1,842 +0,0 @@ -module cloud_rad_props - -!------------------------------------------------------------------------------------------------ -!------------------------------------------------------------------------------------------------ - -use shr_kind_mod, only: r8 => shr_kind_r8 -use ppgrid, only: pcols, pver, pverp -use physics_types, only: physics_state -use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx -use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag -use cam_abortutils, only: endrun -use rad_constituents, only: iceopticsfile, liqopticsfile -use oldcloud, only: oldcloud_lw, old_liq_get_rad_props_lw, old_ice_get_rad_props_lw, oldcloud_init - -use ebert_curry, only: scalefactor -use cam_logfile, only: iulog - -use interpolate_data, only: interp_type, lininterp_init, lininterp, & - extrap_method_bndry, lininterp_finish - -implicit none -private -save - -public :: & - cloud_rad_props_init, & - cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols - cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols - get_ice_optics_sw, & ! return Mitchell SW ice radiative properties - ice_cloud_get_rad_props_lw, & ! Mitchell LW ice rad props - get_liquid_optics_sw, & ! return Conley SW rad props - liquid_cloud_get_rad_props_lw, & ! return Conley LW rad props - grau_cloud_get_rad_props_lw, & - get_grau_optics_sw, & - snow_cloud_get_rad_props_lw, & - get_snow_optics_sw - - -integer :: nmu, nlambda -real(r8), allocatable :: g_mu(:) ! mu samples on grid -real(r8), allocatable :: g_lambda(:,:) ! lambda scale samples on grid -real(r8), allocatable :: ext_sw_liq(:,:,:) -real(r8), allocatable :: ssa_sw_liq(:,:,:) -real(r8), allocatable :: asm_sw_liq(:,:,:) -real(r8), allocatable :: abs_lw_liq(:,:,:) - -integer :: n_g_d -real(r8), allocatable :: g_d_eff(:) ! radiative effective diameter samples on grid -real(r8), allocatable :: ext_sw_ice(:,:) -real(r8), allocatable :: ssa_sw_ice(:,:) -real(r8), allocatable :: asm_sw_ice(:,:) -real(r8), allocatable :: abs_lw_ice(:,:) - -! -! indexes into pbuf for optical parameters of MG clouds -! - integer :: i_dei, i_mu, i_lambda, i_iciwp, i_iclwp, i_des, i_icswp - integer :: i_degrau, i_icgrauwp - -! indexes into constituents for old optics - integer :: & - ixcldice, & ! cloud ice water index - ixcldliq ! cloud liquid water index - - -!============================================================================== -contains -!============================================================================== - -subroutine cloud_rad_props_init() - - use netcdf - use spmd_utils, only: masterproc - use ioFileMod, only: getfil - use error_messages, only: handle_ncerr -#if ( defined SPMD ) - use mpishorthand -#endif - use constituents, only: cnst_get_ind - use slingo, only: slingo_rad_props_init - use ebert_curry, only: ec_rad_props_init, scalefactor - - character(len=256) :: liquidfile - character(len=256) :: icefile - character(len=256) :: locfn - - integer :: ncid, dimid, f_nlwbands, f_nswbands, ierr - integer :: vdimids(NF90_MAX_VAR_DIMS), ndims, templen - ! liquid clouds - integer :: mudimid, lambdadimid - integer :: mu_id, lambda_id, ext_sw_liq_id, ssa_sw_liq_id, asm_sw_liq_id, abs_lw_liq_id - - ! ice clouds - integer :: d_dimid ! diameters - integer :: d_id, ext_sw_ice_id, ssa_sw_ice_id, asm_sw_ice_id, abs_lw_ice_id - - integer :: err - - liquidfile = liqopticsfile - icefile = iceopticsfile - - call slingo_rad_props_init - call ec_rad_props_init - call oldcloud_init - - i_dei = pbuf_get_index('DEI',errcode=err) - i_mu = pbuf_get_index('MU',errcode=err) - i_lambda = pbuf_get_index('LAMBDAC',errcode=err) - i_iciwp = pbuf_get_index('ICIWP',errcode=err) - i_iclwp = pbuf_get_index('ICLWP',errcode=err) - i_des = pbuf_get_index('DES',errcode=err) - i_icswp = pbuf_get_index('ICSWP',errcode=err) - i_icgrauwp = pbuf_get_index('ICGRAUWP',errcode=err) ! Available when using MG3 - i_degrau = pbuf_get_index('DEGRAU',errcode=err) ! Available when using MG3 - - ! old optics - call cnst_get_ind('CLDICE', ixcldice) - call cnst_get_ind('CLDLIQ', ixcldliq) - - ! read liquid cloud optics - if(masterproc) then - call getfil( trim(liquidfile), locfn, 0) - call handle_ncerr( nf90_open(locfn, NF90_NOWRITE, ncid), 'liquid optics file missing') - write(iulog,*)' reading liquid cloud optics from file ',locfn - - call handle_ncerr(nf90_inq_dimid( ncid, 'lw_band', dimid), 'getting lw_band dim') - call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nlwbands), 'getting n lw bands') - if (f_nlwbands /= nlwbands) call endrun('number of lw bands does not match') - - call handle_ncerr(nf90_inq_dimid( ncid, 'sw_band', dimid), 'getting sw_band_dim') - call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nswbands), 'getting n sw bands') - if (f_nswbands /= nswbands) call endrun('number of sw bands does not match') - - call handle_ncerr(nf90_inq_dimid( ncid, 'mu', mudimid), 'getting mu dim') - call handle_ncerr(nf90_inquire_dimension( ncid, mudimid, len=nmu), 'getting n mu samples') - - call handle_ncerr(nf90_inq_dimid( ncid, 'lambda_scale', lambdadimid), 'getting lambda dim') - call handle_ncerr(nf90_inquire_dimension( ncid, lambdadimid, len=nlambda), 'getting n lambda samples') - endif ! if (masterproc) - -#if ( defined SPMD ) - call mpibcast(nmu, 1, mpiint, 0, mpicom, ierr) - call mpibcast(nlambda, 1, mpiint, 0, mpicom, ierr) -#endif - - allocate(g_mu(nmu)) - allocate(g_lambda(nmu,nlambda)) - allocate(ext_sw_liq(nmu,nlambda,nswbands) ) - allocate(ssa_sw_liq(nmu,nlambda,nswbands)) - allocate(asm_sw_liq(nmu,nlambda,nswbands)) - allocate(abs_lw_liq(nmu,nlambda,nlwbands)) - - if(masterproc) then - call handle_ncerr( nf90_inq_varid(ncid, 'mu', mu_id),& - 'cloud optics mu get') - call handle_ncerr( nf90_get_var(ncid, mu_id, g_mu),& - 'read cloud optics mu values') - - call handle_ncerr( nf90_inq_varid(ncid, 'lambda', lambda_id),& - 'cloud optics lambda get') - call handle_ncerr( nf90_get_var(ncid, lambda_id, g_lambda),& - 'read cloud optics lambda values') - - call handle_ncerr( nf90_inq_varid(ncid, 'k_ext_sw', ext_sw_liq_id),& - 'cloud optics ext_sw_liq get') - call handle_ncerr( nf90_get_var(ncid, ext_sw_liq_id, ext_sw_liq),& - 'read cloud optics ext_sw_liq values') - - call handle_ncerr( nf90_inq_varid(ncid, 'ssa_sw', ssa_sw_liq_id),& - 'cloud optics ssa_sw_liq get') - call handle_ncerr( nf90_get_var(ncid, ssa_sw_liq_id, ssa_sw_liq),& - 'read cloud optics ssa_sw_liq values') - - call handle_ncerr( nf90_inq_varid(ncid, 'asm_sw', asm_sw_liq_id),& - 'cloud optics asm_sw_liq get') - call handle_ncerr( nf90_get_var(ncid, asm_sw_liq_id, asm_sw_liq),& - 'read cloud optics asm_sw_liq values') - - call handle_ncerr( nf90_inq_varid(ncid, 'k_abs_lw', abs_lw_liq_id),& - 'cloud optics abs_lw_liq get') - call handle_ncerr( nf90_get_var(ncid, abs_lw_liq_id, abs_lw_liq),& - 'read cloud optics abs_lw_liq values') - - call handle_ncerr( nf90_close(ncid), 'liquid optics file missing') - endif ! if masterproc - -#if ( defined SPMD ) - call mpibcast(g_mu, nmu, mpir8, 0, mpicom, ierr) - call mpibcast(g_lambda, nmu*nlambda, mpir8, 0, mpicom, ierr) - call mpibcast(ext_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) - call mpibcast(ssa_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) - call mpibcast(asm_sw_liq, nmu*nlambda*nswbands, mpir8, 0, mpicom, ierr) - call mpibcast(abs_lw_liq, nmu*nlambda*nlwbands, mpir8, 0, mpicom, ierr) -#endif - ! I forgot to convert kext from m^2/Volume to m^2/Kg - ext_sw_liq = ext_sw_liq / 0.9970449e3_r8 - abs_lw_liq = abs_lw_liq / 0.9970449e3_r8 - - ! read ice cloud optics - if(masterproc) then - call getfil( trim(icefile), locfn, 0) - call handle_ncerr( nf90_open(locfn, NF90_NOWRITE, ncid), 'ice optics file missing') - write(iulog,*)' reading ice cloud optics from file ',locfn - - call handle_ncerr(nf90_inq_dimid( ncid, 'lw_band', dimid), 'getting lw_band dim') - call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nlwbands), 'getting n lw bands') - if (f_nlwbands /= nlwbands) call endrun('number of lw bands does not match') - - call handle_ncerr(nf90_inq_dimid( ncid, 'sw_band', dimid), 'getting sw_band_dim') - call handle_ncerr(nf90_inquire_dimension( ncid, dimid, len=f_nswbands), 'getting n sw bands') - if (f_nswbands /= nswbands) call endrun('number of sw bands does not match') - - call handle_ncerr(nf90_inq_dimid( ncid, 'd_eff', d_dimid), 'getting deff dim') - call handle_ncerr(nf90_inquire_dimension( ncid, d_dimid, len=n_g_d), 'getting n deff samples') - - endif ! if (masterproc) - -#if ( defined SPMD ) - call mpibcast(n_g_d, 1, mpiint, 0, mpicom, ierr) -! call mpibcast(nswbands, 1, mpiint, 0, mpicom, ierr) -! call mpibcast(nlwbands, 1, mpiint, 0, mpicom, ierr) -#endif - - allocate(g_d_eff(n_g_d)) - allocate(ext_sw_ice(n_g_d,nswbands)) - allocate(ssa_sw_ice(n_g_d,nswbands)) - allocate(asm_sw_ice(n_g_d,nswbands)) - allocate(abs_lw_ice(n_g_d,nlwbands)) - - if(masterproc) then - call handle_ncerr( nf90_inq_varid(ncid, 'd_eff', d_id),& - 'cloud optics deff get') - call handle_ncerr( nf90_get_var(ncid, d_id, g_d_eff),& - 'read cloud optics deff values') - - call handle_ncerr( nf90_inq_varid(ncid, 'sw_ext', ext_sw_ice_id),& - 'cloud optics ext_sw_ice get') - call handle_ncerr(nf90_inquire_variable ( ncid, ext_sw_ice_id, ndims=ndims, dimids=vdimids),& - 'checking dimensions of ext_sw_ice') - call handle_ncerr(nf90_inquire_dimension( ncid, vdimids(1), len=templen),& - 'getting first dimension sw_ext') - !write(iulog,*) 'expected length',n_g_d,'actual len',templen - call handle_ncerr(nf90_inquire_dimension( ncid, vdimids(2), len=templen),& - 'getting first dimension sw_ext') - !write(iulog,*) 'expected length',nswbands,'actual len',templen - call handle_ncerr( nf90_get_var(ncid, ext_sw_ice_id, ext_sw_ice),& - 'read cloud optics ext_sw_ice values') - - call handle_ncerr( nf90_inq_varid(ncid, 'sw_ssa', ssa_sw_ice_id),& - 'cloud optics ssa_sw_ice get') - call handle_ncerr( nf90_get_var(ncid, ssa_sw_ice_id, ssa_sw_ice),& - 'read cloud optics ssa_sw_ice values') - - call handle_ncerr( nf90_inq_varid(ncid, 'sw_asm', asm_sw_ice_id),& - 'cloud optics asm_sw_ice get') - call handle_ncerr( nf90_get_var(ncid, asm_sw_ice_id, asm_sw_ice),& - 'read cloud optics asm_sw_ice values') - - call handle_ncerr( nf90_inq_varid(ncid, 'lw_abs', abs_lw_ice_id),& - 'cloud optics abs_lw_ice get') - call handle_ncerr( nf90_get_var(ncid, abs_lw_ice_id, abs_lw_ice),& - 'read cloud optics abs_lw_ice values') - - call handle_ncerr( nf90_close(ncid), 'ice optics file missing') - - endif ! if masterproc -#if ( defined SPMD ) - call mpibcast(g_d_eff, n_g_d, mpir8, 0, mpicom, ierr) - call mpibcast(ext_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) - call mpibcast(ssa_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) - call mpibcast(asm_sw_ice, n_g_d*nswbands, mpir8, 0, mpicom, ierr) - call mpibcast(abs_lw_ice, n_g_d*nlwbands, mpir8, 0, mpicom, ierr) -#endif - - return - -end subroutine cloud_rad_props_init - -!============================================================================== - -subroutine cloud_rad_props_get_sw(state, pbuf, & - tau, tau_w, tau_w_g, tau_w_f,& - diagnosticindex, oldliq, oldice) - -! return totaled (across all species) layer tau, omega, g, f -! for all spectral interval for aerosols affecting the climate - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information - - real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - logical, optional, intent(in) :: oldliq,oldice - - ! Local variables - - integer :: ncol - integer :: lchnk - integer :: k, i ! lev and daycolumn indices - integer :: iswband ! sw band indices - - ! optical props for each aerosol - real(r8), pointer :: h_ext(:,:) - real(r8), pointer :: h_ssa(:,:) - real(r8), pointer :: h_asm(:,:) - real(r8), pointer :: n_ext(:) - real(r8), pointer :: n_ssa(:) - real(r8), pointer :: n_asm(:) - - ! rad properties for liquid clouds - real(r8) :: liq_tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8) :: liq_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - ! rad properties for ice clouds - real(r8) :: ice_tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8) :: ice_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8) :: ice_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! initialize to conditions that would cause failure - tau (:,:,:) = -100._r8 - tau_w (:,:,:) = -100._r8 - tau_w_g (:,:,:) = -100._r8 - tau_w_f (:,:,:) = -100._r8 - - ! initialize layers to accumulate od's - tau (:,1:ncol,:) = 0._r8 - tau_w (:,1:ncol,:) = 0._r8 - tau_w_g(:,1:ncol,:) = 0._r8 - tau_w_f(:,1:ncol,:) = 0._r8 - - - call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f) - - call get_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f) - - tau (:,1:ncol,:) = liq_tau (:,1:ncol,:) + ice_tau (:,1:ncol,:) - tau_w (:,1:ncol,:) = liq_tau_w (:,1:ncol,:) + ice_tau_w (:,1:ncol,:) - tau_w_g(:,1:ncol,:) = liq_tau_w_g(:,1:ncol,:) + ice_tau_w_g(:,1:ncol,:) - tau_w_f(:,1:ncol,:) = liq_tau_w_f(:,1:ncol,:) + ice_tau_w_f(:,1:ncol,:) - -end subroutine cloud_rad_props_get_sw -!============================================================================== - -subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) - -! Purpose: Compute cloud longwave absorption optical depth -! cloud_rad_props_get_lw() is called by radlw() - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer:: pbuf(:) - real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer - integer, optional, intent(in) :: diagnosticindex - logical, optional, intent(in) :: oldliq ! use old liquid optics - logical, optional, intent(in) :: oldice ! use old ice optics - logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) - - ! Local variables - - integer :: bnd_idx ! LW band index - integer :: i ! column index - integer :: k ! lev index - integer :: ncol ! number of columns - integer :: lchnk - - ! rad properties for liquid clouds - real(r8) :: liq_tau_abs_od(nlwbands,pcols,pver) ! liquid cloud absorption optical depth - - ! rad properties for ice clouds - real(r8) :: ice_tau_abs_od(nlwbands,pcols,pver) ! ice cloud absorption optical depth - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! compute optical depths cld_absod - cld_abs_od = 0._r8 - - if(present(oldcloud))then - if(oldcloud) then - ! make diagnostic calls to these first to output ice and liq OD's - !call old_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.false.) - !call old_ice_get_rad_props_lw(state, pbuf, ice_tau_abs_od, oldicewp=.false.) - ! This affects climate (cld_abs_od) - call oldcloud_lw(state,pbuf,cld_abs_od,oldwp=.false.) - return - endif - endif - - if(present(oldliq))then - if(oldliq) then - call old_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.false.) - else - call liquid_cloud_get_rad_props_lw(state, pbuf, liq_tau_abs_od) - endif - else - call liquid_cloud_get_rad_props_lw(state, pbuf, liq_tau_abs_od) - endif - - if(present(oldice))then - if(oldice) then - call old_ice_get_rad_props_lw(state, pbuf, ice_tau_abs_od, oldicewp=.false.) - else - call ice_cloud_get_rad_props_lw(state, pbuf, ice_tau_abs_od) - endif - else - call ice_cloud_get_rad_props_lw(state, pbuf, ice_tau_abs_od) - endif - - cld_abs_od(:,1:ncol,:) = liq_tau_abs_od(:,1:ncol,:) + ice_tau_abs_od(:,1:ncol,:) - -end subroutine cloud_rad_props_get_lw - -!============================================================================== - -subroutine get_snow_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - - real(r8), pointer :: icswpth(:,:), des(:,:) - - ! This does the same thing as get_ice_optics_sw, except with a different - ! water path and effective diameter. - call pbuf_get_field(pbuf, i_icswp, icswpth) - call pbuf_get_field(pbuf, i_des, des) - - call interpolate_ice_optics_sw(state%ncol, icswpth, des, tau, tau_w, & - tau_w_g, tau_w_f) - -end subroutine get_snow_optics_sw - -!============================================================================== - -subroutine get_grau_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - - real(r8), pointer :: icgrauwpth(:,:), degrau(:,:) - - integer :: i,k - - ! This does the same thing as get_ice_optics_sw, except with a different - ! water path and effective diameter. - if((i_icgrauwp > 0) .and. (i_degrau > 0)) then - - call pbuf_get_field(pbuf, i_icgrauwp, icgrauwpth) - call pbuf_get_field(pbuf, i_degrau, degrau) - - call interpolate_ice_optics_sw(state%ncol, icgrauwpth, degrau, tau, tau_w, & - tau_w_g, tau_w_f) - do i = 1, pcols - do k = 1, pver - if (tau(idx_sw_diag,i,k).gt.100._r8) then - write(iulog,*) 'WARNING: SW Graupel Tau > 100 (i,k,icgrauwpth,degrau,tau):' - write(iulog,*) i,k,icgrauwpth(i,k), degrau(i,k), tau(idx_sw_diag,i,k) - end if - enddo - enddo - - else - call endrun('ERROR: Get_grau_optics_sw called when graupel properties not supported') - end if - -end subroutine get_grau_optics_sw - -!============================================================================== -! Private methods -!============================================================================== - -subroutine get_ice_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - - real(r8), pointer :: iciwpth(:,:), dei(:,:) - - ! Get relevant pbuf fields, and interpolate optical properties from - ! the lookup tables. - call pbuf_get_field(pbuf, i_iciwp, iciwpth) - call pbuf_get_field(pbuf, i_dei, dei) - - call interpolate_ice_optics_sw(state%ncol, iciwpth, dei, tau, tau_w, & - tau_w_g, tau_w_f) - -end subroutine get_ice_optics_sw - -!============================================================================== - -subroutine interpolate_ice_optics_sw(ncol, iciwpth, dei, tau, tau_w, & - tau_w_g, tau_w_f) - - integer, intent(in) :: ncol - real(r8), intent(in) :: iciwpth(pcols,pver) - real(r8), intent(in) :: dei(pcols,pver) - - real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - - type(interp_type) :: dei_wgts - - integer :: i, k, swband - real(r8) :: ext(nswbands), ssa(nswbands), asm(nswbands) - - do k = 1,pver - do i = 1,ncol - if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then - ! if ice water path is too small, OD := 0 - tau (:,i,k) = 0._r8 - tau_w (:,i,k) = 0._r8 - tau_w_g(:,i,k) = 0._r8 - tau_w_f(:,i,k) = 0._r8 - else - ! for each cell interpolate to find weights in g_d_eff grid. - call lininterp_init(g_d_eff, n_g_d, dei(i:i,k), 1, & - extrap_method_bndry, dei_wgts) - ! interpolate into grid and extract radiative properties - do swband = 1, nswbands - call lininterp(ext_sw_ice(:,swband), n_g_d, & - ext(swband:swband), 1, dei_wgts) - call lininterp(ssa_sw_ice(:,swband), n_g_d, & - ssa(swband:swband), 1, dei_wgts) - call lininterp(asm_sw_ice(:,swband), n_g_d, & - asm(swband:swband), 1, dei_wgts) - end do - tau (:,i,k) = iciwpth(i,k) * ext - tau_w (:,i,k) = tau(:,i,k) * ssa - tau_w_g(:,i,k) = tau_w(:,i,k) * asm - tau_w_f(:,i,k) = tau_w_g(:,i,k) * asm - call lininterp_finish(dei_wgts) - endif - enddo - enddo - -end subroutine interpolate_ice_optics_sw - -!============================================================================== - -subroutine get_liquid_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f) - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w - real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - - real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth - real(r8), dimension(pcols,pver) :: kext - integer i,k,swband,lchnk,ncol - - lchnk = state%lchnk - ncol = state%ncol - - - call pbuf_get_field(pbuf, i_lambda, lamc) - call pbuf_get_field(pbuf, i_mu, pgam) - call pbuf_get_field(pbuf, i_iclwp, iclwpth) - - do k = 1,pver - do i = 1,ncol - if(lamc(i,k) > 0._r8) then ! This seems to be clue from microphysics of no cloud - call gam_liquid_sw(iclwpth(i,k), lamc(i,k), pgam(i,k), & - tau(1:nswbands,i,k), tau_w(1:nswbands,i,k), tau_w_g(1:nswbands,i,k), tau_w_f(1:nswbands,i,k)) - else - tau(1:nswbands,i,k) = 0._r8 - tau_w(1:nswbands,i,k) = 0._r8 - tau_w_g(1:nswbands,i,k) = 0._r8 - tau_w_f(1:nswbands,i,k) = 0._r8 - endif - enddo - enddo - -end subroutine get_liquid_optics_sw - -!============================================================================== - -subroutine liquid_cloud_get_rad_props_lw(state, pbuf, abs_od) - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - - integer :: lchnk, ncol - real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth - - integer lwband, i, k - - abs_od = 0._r8 - - lchnk = state%lchnk - ncol = state%ncol - - call pbuf_get_field(pbuf, i_lambda, lamc) - call pbuf_get_field(pbuf, i_mu, pgam) - call pbuf_get_field(pbuf, i_iclwp, iclwpth) - - do k = 1,pver - do i = 1,ncol - if(lamc(i,k) > 0._r8) then ! This seems to be the clue for no cloud from microphysics formulation - call gam_liquid_lw(iclwpth(i,k), lamc(i,k), pgam(i,k), abs_od(1:nlwbands,i,k)) - else - abs_od(1:nlwbands,i,k) = 0._r8 - endif - enddo - enddo - -end subroutine liquid_cloud_get_rad_props_lw -!============================================================================== - -subroutine snow_cloud_get_rad_props_lw(state, pbuf, abs_od) - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - - real(r8), pointer :: icswpth(:,:), des(:,:) - - ! This does the same thing as ice_cloud_get_rad_props_lw, except with a - ! different water path and effective diameter. - call pbuf_get_field(pbuf, i_icswp, icswpth) - call pbuf_get_field(pbuf, i_des, des) - - call interpolate_ice_optics_lw(state%ncol,icswpth, des, abs_od) - -end subroutine snow_cloud_get_rad_props_lw - - -!============================================================================== - -subroutine grau_cloud_get_rad_props_lw(state, pbuf, abs_od) - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - - real(r8), pointer :: icgrauwpth(:,:), degrau(:,:) - - ! This does the same thing as ice_cloud_get_rad_props_lw, except with a - ! different water path and effective diameter. - if((i_icgrauwp > 0) .and. (i_degrau > 0)) then - call pbuf_get_field(pbuf, i_icgrauwp, icgrauwpth) - call pbuf_get_field(pbuf, i_degrau, degrau) - - call interpolate_ice_optics_lw(state%ncol,icgrauwpth, degrau, abs_od) - else - call endrun('ERROR: Grau_cloud_get_rad_props_lw called when graupel & - &properties not supported') - end if - -end subroutine grau_cloud_get_rad_props_lw - -!============================================================================== - -subroutine ice_cloud_get_rad_props_lw(state, pbuf, abs_od) - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - - real(r8), pointer :: iciwpth(:,:), dei(:,:) - - ! Get relevant pbuf fields, and interpolate optical properties from - ! the lookup tables. - call pbuf_get_field(pbuf, i_iciwp, iciwpth) - call pbuf_get_field(pbuf, i_dei, dei) - - call interpolate_ice_optics_lw(state%ncol,iciwpth, dei, abs_od) - -end subroutine ice_cloud_get_rad_props_lw - -!============================================================================== - -subroutine interpolate_ice_optics_lw(ncol, iciwpth, dei, abs_od) - - integer, intent(in) :: ncol - real(r8), intent(in) :: iciwpth(pcols,pver) - real(r8), intent(in) :: dei(pcols,pver) - - real(r8),intent(out) :: abs_od(nlwbands,pcols,pver) - - type(interp_type) :: dei_wgts - - integer :: i, k, lwband - real(r8) :: absor(nlwbands) - - do k = 1,pver - do i = 1,ncol - ! if ice water path is too small, OD := 0 - if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then - abs_od (:,i,k) = 0._r8 - else - ! for each cell interpolate to find weights in g_d_eff grid. - call lininterp_init(g_d_eff, n_g_d, dei(i:i,k), 1, & - extrap_method_bndry, dei_wgts) - ! interpolate into grid and extract radiative properties - do lwband = 1, nlwbands - call lininterp(abs_lw_ice(:,lwband), n_g_d, & - absor(lwband:lwband), 1, dei_wgts) - enddo - abs_od(:,i,k) = iciwpth(i,k) * absor - where(abs_od(:,i,k) > 50.0_r8) abs_od(:,i,k) = 50.0_r8 - call lininterp_finish(dei_wgts) - endif - enddo - enddo - -end subroutine interpolate_ice_optics_lw - -!============================================================================== - -subroutine gam_liquid_lw(clwptn, lamc, pgam, abs_od) - real(r8), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? - real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud - real(r8), intent(in) :: pgam ! prognosed value of mu for cloud - real(r8), intent(out) :: abs_od(1:nlwbands) - - integer :: lwband ! sw band index - - type(interp_type) :: mu_wgts - type(interp_type) :: lambda_wgts - - if (clwptn < 1.e-80_r8) then - abs_od = 0._r8 - return - endif - - call get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) - - do lwband = 1, nlwbands - call lininterp(abs_lw_liq(:,:,lwband), nmu, nlambda, & - abs_od(lwband:lwband), 1, mu_wgts, lambda_wgts) - enddo - - abs_od = clwptn * abs_od - - call lininterp_finish(mu_wgts) - call lininterp_finish(lambda_wgts) - -end subroutine gam_liquid_lw - -!============================================================================== - -subroutine gam_liquid_sw(clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f) - real(r8), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? - real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud - real(r8), intent(in) :: pgam ! prognosed value of mu for cloud - real(r8), intent(out) :: tau(1:nswbands), tau_w(1:nswbands), tau_w_f(1:nswbands), tau_w_g(1:nswbands) - - integer :: swband ! sw band index - - real(r8) :: ext(nswbands), ssa(nswbands), asm(nswbands) - - type(interp_type) :: mu_wgts - type(interp_type) :: lambda_wgts - - if (clwptn < 1.e-80_r8) then - tau = 0._r8 - tau_w = 0._r8 - tau_w_g = 0._r8 - tau_w_f = 0._r8 - return - endif - - call get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) - - do swband = 1, nswbands - call lininterp(ext_sw_liq(:,:,swband), nmu, nlambda, & - ext(swband:swband), 1, mu_wgts, lambda_wgts) - call lininterp(ssa_sw_liq(:,:,swband), nmu, nlambda, & - ssa(swband:swband), 1, mu_wgts, lambda_wgts) - call lininterp(asm_sw_liq(:,:,swband), nmu, nlambda, & - asm(swband:swband), 1, mu_wgts, lambda_wgts) - enddo - - ! compute radiative properties - tau = clwptn * ext - tau_w = tau * ssa - tau_w_g = tau_w * asm - tau_w_f = tau_w_g * asm - - call lininterp_finish(mu_wgts) - call lininterp_finish(lambda_wgts) - -end subroutine gam_liquid_sw - -!============================================================================== - -subroutine get_mu_lambda_weights(lamc, pgam, mu_wgts, lambda_wgts) - real(r8), intent(in) :: lamc ! prognosed value of lambda for cloud - real(r8), intent(in) :: pgam ! prognosed value of mu for cloud - ! Output interpolation weights. Caller is responsible for freeing these. - type(interp_type), intent(out) :: mu_wgts - type(interp_type), intent(out) :: lambda_wgts - - integer :: ilambda - real(r8) :: g_lambda_interp(nlambda) - - ! Make interpolation weights for mu. - ! (Put pgam in a temporary array for this purpose.) - call lininterp_init(g_mu, nmu, [pgam], 1, extrap_method_bndry, mu_wgts) - - ! Use mu weights to interpolate to a row in the lambda table. - do ilambda = 1, nlambda - call lininterp(g_lambda(:,ilambda), nmu, & - g_lambda_interp(ilambda:ilambda), 1, mu_wgts) - end do - - ! Make interpolation weights for lambda. - call lininterp_init(g_lambda_interp, nlambda, [lamc], 1, & - extrap_method_bndry, lambda_wgts) - -end subroutine get_mu_lambda_weights - -!============================================================================== - -end module cloud_rad_props diff --git a/src/physics/rrtmg/ebert_curry.F90 b/src/physics/rrtmg/ebert_curry.F90 deleted file mode 100644 index a1e1c031b1..0000000000 --- a/src/physics/rrtmg/ebert_curry.F90 +++ /dev/null @@ -1,408 +0,0 @@ -module ebert_curry - -!------------------------------------------------------------------------------------------------ -!------------------------------------------------------------------------------------------------ - -use shr_kind_mod, only: r8 => shr_kind_r8 -use ppgrid, only: pcols, pver, pverp -use physics_types, only: physics_state -use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx -use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries -use cam_abortutils, only: endrun -use cam_history, only: outfld - -implicit none -private -save - -public :: & - ec_rad_props_init, & - cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols - cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols - ec_ice_optics_sw, & - ec_ice_get_rad_props_lw - - -real(r8), public, parameter:: scalefactor = 1._r8 !500._r8/917._r8 - -! Minimum cloud amount (as a fraction of the grid-box area) to -! distinguish from clear sky -! - real(r8) cldmin - parameter (cldmin = 1.0e-80_r8) -! -! Decimal precision of cloud amount (0 -> preserve full resolution; -! 10^-n -> preserve n digits of cloud amount) -! - real(r8) cldeps - parameter (cldeps = 0.0_r8) - -! -! indexes into pbuf for optical parameters of MG clouds -! - integer :: dei_idx = 0 - integer :: mu_idx = 0 - integer :: lambda_idx = 0 - integer :: iciwp_idx = 0 - integer :: iclwp_idx = 0 - integer :: cld_idx = 0 - integer :: rei_idx = 0 - -! indexes into constituents for old optics - integer :: & - ixcldice, & ! cloud ice water index - ixcldliq ! cloud liquid water index - - -!============================================================================== -contains -!============================================================================== - -subroutine ec_rad_props_init() - -! use cam_history, only: addfld - use netcdf - use spmd_utils, only: masterproc - use ioFileMod, only: getfil - use cam_logfile, only: iulog - use error_messages, only: handle_ncerr -#if ( defined SPMD ) - use mpishorthand -#endif - use constituents, only: cnst_get_ind - - integer :: err - - iciwp_idx = pbuf_get_index('ICIWP',errcode=err) - iclwp_idx = pbuf_get_index('ICLWP',errcode=err) - cld_idx = pbuf_get_index('CLD') - rei_idx = pbuf_get_index('REI') - - ! old optics - call cnst_get_ind('CLDICE', ixcldice) - call cnst_get_ind('CLDLIQ', ixcldliq) - - !call addfld ('CLWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','old In Cloud Liquid Water Path', sampling_seq='rad_lwsw') - !call addfld ('KEXT_OLD',(/ 'lev' /),'I','m^2/kg','old extinction') - !call addfld ('CLDOD_OLD',(/ 'lev' /),'I','1','old liquid OD') - !call addfld ('REL_OLD',(/ 'lev' /),'I','1','old liquid effective radius (liquid)') - - !call addfld ('CLWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Liquid Water Path', sampling_seq='rad_lwsw') - !call addfld ('KEXT_NEW',(/ 'lev' /),'I','m^2/kg','extinction') - !call addfld ('CLDOD_NEW',(/ 'lev' /),'I','1','liquid OD') - - !call addfld('CIWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path', sampling_seq='rad_lwsw') - !call addfld('CIWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path (old)', sampling_seq='rad_lwsw') - - return - -end subroutine ec_rad_props_init - -!============================================================================== - -subroutine cloud_rad_props_get_sw(state, pbuf, & - tau, tau_w, tau_w_g, tau_w_f,& - diagnosticindex, oldliq, oldice) - -! return totaled (across all species) layer tau, omega, g, f -! for all spectral interval for aerosols affecting the climate - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information - - real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - logical, optional, intent(in) :: oldliq,oldice - - ! Local variables - - integer :: ncol - integer :: lchnk - integer :: k, i ! lev and daycolumn indices - integer :: iswband ! sw band indices - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! initialize to conditions that would cause failure - tau (:,:,:) = -100._r8 - tau_w (:,:,:) = -100._r8 - tau_w_g (:,:,:) = -100._r8 - tau_w_f (:,:,:) = -100._r8 - - ! initialize layers to accumulate od's - tau (:,1:ncol,:) = 0._r8 - tau_w (:,1:ncol,:) = 0._r8 - tau_w_g(:,1:ncol,:) = 0._r8 - tau_w_f(:,1:ncol,:) = 0._r8 - - - call ec_ice_optics_sw (state, pbuf, tau, tau_w, tau_w_g, tau_w_f, oldicewp=.true.) -! call outfld ('CI_OD_SW_OLD', ice_tau(idx_sw_diag,:,:), pcols, lchnk) - - -end subroutine cloud_rad_props_get_sw -!============================================================================== - -subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) - -! Purpose: Compute cloud longwave absorption optical depth -! cloud_rad_props_get_lw() is called by radlw() - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer - integer, optional, intent(in) :: diagnosticindex - logical, optional, intent(in) :: oldliq ! use old liquid optics - logical, optional, intent(in) :: oldice ! use old ice optics - logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) - - ! Local variables - - integer :: bnd_idx ! LW band index - integer :: i ! column index - integer :: k ! lev index - integer :: ncol ! number of columns - integer :: lchnk - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! compute optical depths cld_absod - cld_abs_od = 0._r8 - - call ec_ice_get_rad_props_lw(state, pbuf, cld_abs_od, oldicewp=.true.) - !call outfld('CI_OD_LW_OLD', ice_tau_abs_od(idx_lw_diag ,:,:), pcols, lchnk) - -end subroutine cloud_rad_props_get_lw - -!============================================================================== -! Private methods -!============================================================================== - -subroutine ec_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp) - - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - - real(r8),intent(out) :: ice_tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: ice_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: ice_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - logical, intent(in) :: oldicewp - - real(r8), pointer, dimension(:,:) :: rei - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: tmpptr - real(r8), dimension(pcols,pver) :: cicewp - real(r8), dimension(nswbands) :: wavmin - real(r8), dimension(nswbands) :: wavmax - ! - ! ice water coefficients (Ebert and Curry,1992, JGR, 97, 3831-3836) - real(r8) :: abari(4) = & ! a coefficient for extinction optical depth - (/ 3.448e-03_r8, 3.448e-03_r8,3.448e-03_r8,3.448e-03_r8/) - real(r8) :: bbari(4) = & ! b coefficient for extinction optical depth - (/ 2.431_r8 , 2.431_r8 ,2.431_r8 ,2.431_r8 /) - real(r8) :: cbari(4) = & ! c coefficient for single scat albedo - (/ 1.00e-05_r8 , 1.10e-04_r8 ,1.861e-02_r8,.46658_r8 /) - real(r8) :: dbari(4) = & ! d coefficient for single scat albedo - (/ 0.0_r8 , 1.405e-05_r8,8.328e-04_r8,2.05e-05_r8 /) - real(r8) :: ebari(4) = & ! e coefficient for asymmetry parameter - (/ 0.7661_r8 , 0.7730_r8 ,0.794_r8 ,0.9595_r8 /) - real(r8) :: fbari(4) = & ! f coefficient for asymmetry parameter - (/ 5.851e-04_r8, 5.665e-04_r8,7.267e-04_r8,1.076e-04_r8/) - - real(r8) :: abarii ! A coefficient for current spectral band - real(r8) :: bbarii ! B coefficient for current spectral band - real(r8) :: cbarii ! C coefficient for current spectral band - real(r8) :: dbarii ! D coefficient for current spectral band - real(r8) :: ebarii ! E coefficient for current spectral band - real(r8) :: fbarii ! F coefficient for current spectral band - - ! Minimum cloud amount (as a fraction of the grid-box area) to - ! distinguish from clear sky - real(r8), parameter :: cldmin = 1.0e-80_r8 - - ! Decimal precision of cloud amount (0 -> preserve full resolution; - ! 10^-n -> preserve n digits of cloud amount) - real(r8), parameter :: cldeps = 0.0_r8 - - integer :: ns, i, k, indxsl, lchnk, Nday - integer :: itim_old - real(r8) :: tmp1i, tmp2i, tmp3i, g - - Nday = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, rei_idx,rei) - - if(oldicewp) then - do k=1,pver - do i = 1,Nday - cicewp(i,k) = 1000.0_r8*state%q(i,k,ixcldice)*state%pdel(i,k) /(gravit* max(0.01_r8,cldn(i,k))) - end do - end do - else - if (iciwp_idx<=0) then - call endrun('ec_ice_optics_sw: oldicewp must be set to true since ICIWP was not found in pbuf') - endif - call pbuf_get_field(pbuf, iciwp_idx, tmpptr) - cicewp(1:pcols,1:pver) = 1000.0_r8*tmpptr(1:pcols,1:pver) - endif - - call get_sw_spectral_boundaries(wavmin,wavmax,'microns') - - do ns = 1, nswbands - - if(wavmax(ns) <= 0.7_r8) then - indxsl = 1 - else if(wavmax(ns) <= 1.25_r8) then - indxsl = 2 - else if(wavmax(ns) <= 2.38_r8) then - indxsl = 3 - else if(wavmax(ns) > 2.38_r8) then - indxsl = 4 - end if - - abarii = abari(indxsl) - bbarii = bbari(indxsl) - cbarii = cbari(indxsl) - dbarii = dbari(indxsl) - ebarii = ebari(indxsl) - fbarii = fbari(indxsl) - - do k=1,pver - do i=1,Nday - - ! note that optical properties for ice valid only - ! in range of 13 > rei > 130 micron (Ebert and Curry 92) - if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then - tmp1i = abarii + bbarii/max(13._r8,min(scalefactor*rei(i,k),130._r8)) - ice_tau(ns,i,k) = cicewp(i,k)*tmp1i - else - ice_tau(ns,i,k) = 0.0_r8 - endif - - tmp2i = 1._r8 - cbarii - dbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) - tmp3i = fbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) - ! Do not let single scatter albedo be 1. Delta-eddington solution - ! for non-conservative case has different analytic form from solution - ! for conservative case, and raddedmx is written for non-conservative case. - ice_tau_w(ns,i,k) = ice_tau(ns,i,k) * min(tmp2i,.999999_r8) - g = ebarii + tmp3i - ice_tau_w_g(ns,i,k) = ice_tau_w(ns,i,k) * g - ice_tau_w_f(ns,i,k) = ice_tau_w(ns,i,k) * g * g - - end do ! End do i=1,Nday - end do ! End do k=1,pver - end do ! nswbands - -end subroutine ec_ice_optics_sw -!============================================================================== - -subroutine ec_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - logical, intent(in) :: oldicewp - - real(r8) :: gicewp(pcols,pver) - real(r8) :: gliqwp(pcols,pver) - real(r8) :: cicewp(pcols,pver) - real(r8) :: cliqwp(pcols,pver) - real(r8) :: ficemr(pcols,pver) - real(r8) :: cwp(pcols,pver) - real(r8) :: cldtau(pcols,pver) - - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: rei - integer :: ncol, itim_old, lwband, i, k, lchnk - - real(r8) :: kabs, kabsi - - real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) - parameter (kabsl = 0.090361_r8) - - real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth - - - ncol = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - - if(oldicewp) then - do k=1,pver - do i = 1,ncol - gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. - gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. - cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. - cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. - ficemr(i,k) = state%q(i,k,ixcldice) / & - max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) - end do - end do - cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) - else - if (iclwp_idx<=0 .or. iciwp_idx<=0) then - call endrun('ec_ice_get_rad_props_lw: oldicewp must be set to true since ICIWP and/or ICLWP were not found in pbuf') - endif - call pbuf_get_field(pbuf, iclwp_idx, iclwpth) - call pbuf_get_field(pbuf, iciwp_idx, iciwpth) - do k=1,pver - do i = 1,ncol - cwp(i,k) = 1000.0_r8 *iciwpth(i,k) + 1000.0_r8 *iclwpth(i,k) - ficemr(i,k) = 1000.0_r8*iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) - end do - end do - endif - - do k=1,pver - do i=1,ncol - - ! Note from Andrew Conley: - ! Optics for RK no longer supported, This is constructed to get - ! close to bit for bit. Otherwise we could simply use ice water path - !note that optical properties for ice valid only - !in range of 13 > rei > 130 micron (Ebert and Curry 92) - kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) - kabs = kabsi*ficemr(i,k) ! kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) - !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) - cldtau(i,k) = kabs*cwp(i,k) - end do - end do -! - do lwband = 1,nlwbands - abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) - enddo - - !if(oldicewp) then - ! call outfld('CIWPTH_OLD',cicewp(:,:)/1000,pcols,lchnk) - !else - ! call outfld('CIWPTH_OLD',iciwpth(:,:),pcols,lchnk) - !endif - !call outfld('CI_OD_LW_OLD',cldtau(:,:),pcols,lchnk) - -end subroutine ec_ice_get_rad_props_lw -!============================================================================== - -end module ebert_curry diff --git a/src/physics/rrtmg/oldcloud.F90 b/src/physics/rrtmg/oldcloud.F90 deleted file mode 100644 index 609c6b4668..0000000000 --- a/src/physics/rrtmg/oldcloud.F90 +++ /dev/null @@ -1,643 +0,0 @@ -module oldcloud - -!------------------------------------------------------------------------------------------------ -!------------------------------------------------------------------------------------------------ - -use shr_kind_mod, only: r8 => shr_kind_r8 -use ppgrid, only: pcols, pver, pverp -use physics_types, only: physics_state -use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field -use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries -use cam_abortutils, only: endrun -use cam_history, only: outfld -use rad_constituents, only: iceopticsfile, liqopticsfile -use ebert_curry, only: scalefactor - -implicit none -private -save - -public :: & - oldcloud_init, oldcloud_lw, old_liq_get_rad_props_lw, old_ice_get_rad_props_lw - -integer :: nmu, nlambda -real(r8), allocatable :: g_mu(:) ! mu samples on grid -real(r8), allocatable :: g_lambda(:,:) ! lambda scale samples on grid -real(r8), allocatable :: ext_sw_liq(:,:,:) -real(r8), allocatable :: ssa_sw_liq(:,:,:) -real(r8), allocatable :: asm_sw_liq(:,:,:) -real(r8), allocatable :: abs_lw_liq(:,:,:) - -integer :: n_g_d -real(r8), allocatable :: g_d_eff(:) ! radiative effective diameter samples on grid -real(r8), allocatable :: ext_sw_ice(:,:) -real(r8), allocatable :: ssa_sw_ice(:,:) -real(r8), allocatable :: asm_sw_ice(:,:) -real(r8), allocatable :: abs_lw_ice(:,:) - -! Minimum cloud amount (as a fraction of the grid-box area) to -! distinguish from clear sky -! - real(r8) cldmin - parameter (cldmin = 1.0e-80_r8) -! -! Decimal precision of cloud amount (0 -> preserve full resolution; -! 10^-n -> preserve n digits of cloud amount) -! - real(r8) cldeps - parameter (cldeps = 0.0_r8) - -! -! indexes into pbuf for optical parameters of MG clouds -! - integer :: iciwp_idx = 0 - integer :: iclwp_idx = 0 - integer :: cld_idx = 0 - integer :: rel_idx = 0 - integer :: rei_idx = 0 - -! indexes into constituents for old optics - integer :: & - ixcldice, & ! cloud ice water index - ixcldliq ! cloud liquid water index - - -!============================================================================== -contains -!============================================================================== - -subroutine oldcloud_init() - - use constituents, only: cnst_get_ind - - integer :: err - - iciwp_idx = pbuf_get_index('ICIWP',errcode=err) - iclwp_idx = pbuf_get_index('ICLWP',errcode=err) - cld_idx = pbuf_get_index('CLD') - rel_idx = pbuf_get_index('REL') - rei_idx = pbuf_get_index('REI') - - ! old optics - call cnst_get_ind('CLDICE', ixcldice) - call cnst_get_ind('CLDLIQ', ixcldliq) - - return - -end subroutine oldcloud_init - -!============================================================================== -! Private methods -!============================================================================== - -subroutine old_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp) - - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: liq_tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: liq_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: liq_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - logical, intent(in) :: oldliqwp - - real(r8), pointer, dimension(:,:) :: rel - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: tmpptr - real(r8), dimension(pcols,pver) :: cliqwp - real(r8), dimension(nswbands) :: wavmin - real(r8), dimension(nswbands) :: wavmax - - ! Minimum cloud amount (as a fraction of the grid-box area) to - ! distinguish from clear sky - real(r8), parameter :: cldmin = 1.0e-80_r8 - - ! Decimal precision of cloud amount (0 -> preserve full resolution; - ! 10^-n -> preserve n digits of cloud amount) - real(r8), parameter :: cldeps = 0.0_r8 - - ! A. Slingo's data for cloud particle radiative properties (from 'A GCM - ! Parameterization for the Shortwave Properties of Water Clouds' JAS - ! vol. 46 may 1989 pp 1419-1427) - real(r8) :: abarl(4) = & ! A coefficient for extinction optical depth - (/ 2.817e-02_r8, 2.682e-02_r8,2.264e-02_r8,1.281e-02_r8/) - real(r8) :: bbarl(4) = & ! B coefficient for extinction optical depth - (/ 1.305_r8 , 1.346_r8 ,1.454_r8 ,1.641_r8 /) - real(r8) :: cbarl(4) = & ! C coefficient for single scat albedo - (/-5.62e-08_r8 ,-6.94e-06_r8 ,4.64e-04_r8 ,0.201_r8 /) - real(r8) :: dbarl(4) = & ! D coefficient for single scat albedo - (/ 1.63e-07_r8 , 2.35e-05_r8 ,1.24e-03_r8 ,7.56e-03_r8 /) - real(r8) :: ebarl(4) = & ! E coefficient for asymmetry parameter - (/ 0.829_r8 , 0.794_r8 ,0.754_r8 ,0.826_r8 /) - real(r8) :: fbarl(4) = & ! F coefficient for asymmetry parameter - (/ 2.482e-03_r8, 4.226e-03_r8,6.560e-03_r8,4.353e-03_r8/) - - real(r8) :: abarli ! A coefficient for current spectral band - real(r8) :: bbarli ! B coefficient for current spectral band - real(r8) :: cbarli ! C coefficient for current spectral band - real(r8) :: dbarli ! D coefficient for current spectral band - real(r8) :: ebarli ! E coefficient for current spectral band - real(r8) :: fbarli ! F coefficient for current spectral band - - ! Caution... A. Slingo recommends no less than 4.0 micro-meters nor - ! greater than 20 micro-meters - - integer :: ns, i, k, indxsl, Nday - integer :: lchnk, itim_old - real(r8) :: tmp1l, tmp2l, tmp3l, g - real(r8) :: kext(pcols,pver) - real(r8), pointer, dimension(:,:) :: iclwpth - - Nday = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, rel_idx,rel) - - if (oldliqwp) then - do k=1,pver - do i = 1,Nday - cliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/(gravit*max(0.01_r8,cldn(i,k))) - end do - end do - else - if (iclwp_idx<0) then - call endrun('old_liquid_optics_sw: oldliqwp must be set to true since ICLWP was not found in pbuf') - endif - ! The following is the eventual target specification for in cloud liquid water path. - call pbuf_get_field(pbuf, iclwp_idx, tmpptr) - cliqwp = tmpptr - endif - - call get_sw_spectral_boundaries(wavmin,wavmax,'microns') - - do ns = 1, nswbands - ! Set index for cloud particle properties based on the wavelength, - ! according to A. Slingo (1989) equations 1-3: - ! Use index 1 (0.25 to 0.69 micrometers) for visible - ! Use index 2 (0.69 - 1.19 micrometers) for near-infrared - ! Use index 3 (1.19 to 2.38 micrometers) for near-infrared - ! Use index 4 (2.38 to 4.00 micrometers) for near-infrared - if(wavmax(ns) <= 0.7_r8) then - indxsl = 1 - else if(wavmax(ns) <= 1.25_r8) then - indxsl = 2 - else if(wavmax(ns) <= 2.38_r8) then - indxsl = 3 - else if(wavmin(ns) > 2.38_r8) then - indxsl = 4 - end if - - ! Set cloud extinction optical depth, single scatter albedo, - ! asymmetry parameter, and forward scattered fraction: - abarli = abarl(indxsl) - bbarli = bbarl(indxsl) - cbarli = cbarl(indxsl) - dbarli = dbarl(indxsl) - ebarli = ebarl(indxsl) - fbarli = fbarl(indxsl) - - do k=1,pver - do i=1,Nday - - ! note that optical properties for liquid valid only - ! in range of 4.2 > rel > 16 micron (Slingo 89) - if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then - tmp1l = abarli + bbarli/min(max(4.2_r8,rel(i,k)),16._r8) - liq_tau(ns,i,k) = 1000._r8*cliqwp(i,k)*tmp1l - else - liq_tau(ns,i,k) = 0.0_r8 - endif - - tmp2l = 1._r8 - cbarli - dbarli*min(max(4.2_r8,rel(i,k)),16._r8) - tmp3l = fbarli*min(max(4.2_r8,rel(i,k)),16._r8) - ! Do not let single scatter albedo be 1. Delta-eddington solution - ! for non-conservative case has different analytic form from solution - ! for conservative case, and raddedmx is written for non-conservative case. - liq_tau_w(ns,i,k) = liq_tau(ns,i,k) * min(tmp2l,.999999_r8) - g = ebarli + tmp3l - liq_tau_w_g(ns,i,k) = liq_tau_w(ns,i,k) * g - liq_tau_w_f(ns,i,k) = liq_tau_w(ns,i,k) * g * g - - end do ! End do i=1,Nday - end do ! End do k=1,pver - end do ! nswbands - - !call outfld('CL_OD_SW_OLD',liq_tau(idx_sw_diag,:,:), pcols, lchnk) - !call outfld('REL_OLD',rel(:,:), pcols, lchnk) - !call outfld('CLWPTH_OLD',cliqwp(:,:), pcols, lchnk) - !call outfld('KEXT_OLD',kext(:,:), pcols, lchnk) - - -end subroutine old_liquid_optics_sw -!============================================================================== - -subroutine old_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp) - - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - - real(r8),intent(out) :: ice_tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: ice_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: ice_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - logical, intent(in) :: oldicewp - - real(r8), pointer, dimension(:,:) :: rei - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: tmpptr - real(r8), dimension(pcols,pver) :: cicewp - real(r8), dimension(nswbands) :: wavmin - real(r8), dimension(nswbands) :: wavmax - ! - ! ice water coefficients (Ebert and Curry,1992, JGR, 97, 3831-3836) - real(r8) :: abari(4) = & ! a coefficient for extinction optical depth - (/ 3.448e-03_r8, 3.448e-03_r8,3.448e-03_r8,3.448e-03_r8/) - real(r8) :: bbari(4) = & ! b coefficient for extinction optical depth - (/ 2.431_r8 , 2.431_r8 ,2.431_r8 ,2.431_r8 /) - real(r8) :: cbari(4) = & ! c coefficient for single scat albedo - (/ 1.00e-05_r8 , 1.10e-04_r8 ,1.861e-02_r8,.46658_r8 /) - real(r8) :: dbari(4) = & ! d coefficient for single scat albedo - (/ 0.0_r8 , 1.405e-05_r8,8.328e-04_r8,2.05e-05_r8 /) - real(r8) :: ebari(4) = & ! e coefficient for asymmetry parameter - (/ 0.7661_r8 , 0.7730_r8 ,0.794_r8 ,0.9595_r8 /) - real(r8) :: fbari(4) = & ! f coefficient for asymmetry parameter - (/ 5.851e-04_r8, 5.665e-04_r8,7.267e-04_r8,1.076e-04_r8/) - - real(r8) :: abarii ! A coefficient for current spectral band - real(r8) :: bbarii ! B coefficient for current spectral band - real(r8) :: cbarii ! C coefficient for current spectral band - real(r8) :: dbarii ! D coefficient for current spectral band - real(r8) :: ebarii ! E coefficient for current spectral band - real(r8) :: fbarii ! F coefficient for current spectral band - - ! Minimum cloud amount (as a fraction of the grid-box area) to - ! distinguish from clear sky - real(r8), parameter :: cldmin = 1.0e-80_r8 - - ! Decimal precision of cloud amount (0 -> preserve full resolution; - ! 10^-n -> preserve n digits of cloud amount) - real(r8), parameter :: cldeps = 0.0_r8 - - integer :: ns, i, k, indxsl, lchnk, Nday - integer :: itim_old - real(r8) :: tmp1i, tmp2i, tmp3i, g - - Nday = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx,cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, rei_idx,rei) - - if(oldicewp) then - do k=1,pver - do i = 1,Nday - cicewp(i,k) = 1000.0_r8*state%q(i,k,ixcldice)*state%pdel(i,k) /(gravit* max(0.01_r8,cldn(i,k))) - end do - end do - else - if (iciwp_idx<=0) then - call endrun('old_ice_optics_sw: oldicewp must be set to true since ICIWP was not found in pbuf') - endif - call pbuf_get_field(pbuf, iciwp_idx, tmpptr) - cicewp(1:pcols,1:pver) = 1000.0_r8*tmpptr - endif - - call get_sw_spectral_boundaries(wavmin,wavmax,'microns') - - do ns = 1, nswbands - - if(wavmax(ns) <= 0.7_r8) then - indxsl = 1 - else if(wavmax(ns) <= 1.25_r8) then - indxsl = 2 - else if(wavmax(ns) <= 2.38_r8) then - indxsl = 3 - else if(wavmin(ns) > 2.38_r8) then - indxsl = 4 - end if - - abarii = abari(indxsl) - bbarii = bbari(indxsl) - cbarii = cbari(indxsl) - dbarii = dbari(indxsl) - ebarii = ebari(indxsl) - fbarii = fbari(indxsl) - - do k=1,pver - do i=1,Nday - - ! note that optical properties for ice valid only - ! in range of 13 > rei > 130 micron (Ebert and Curry 92) - if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then - tmp1i = abarii + bbarii/max(13._r8,min(scalefactor*rei(i,k),130._r8)) - ice_tau(ns,i,k) = cicewp(i,k)*tmp1i - else - ice_tau(ns,i,k) = 0.0_r8 - endif - - tmp2i = 1._r8 - cbarii - dbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) - tmp3i = fbarii*min(max(13._r8,scalefactor*rei(i,k)),130._r8) - ! Do not let single scatter albedo be 1. Delta-eddington solution - ! for non-conservative case has different analytic form from solution - ! for conservative case, and raddedmx is written for non-conservative case. - ice_tau_w(ns,i,k) = ice_tau(ns,i,k) * min(tmp2i,.999999_r8) - g = ebarii + tmp3i - ice_tau_w_g(ns,i,k) = ice_tau_w(ns,i,k) * g - ice_tau_w_f(ns,i,k) = ice_tau_w(ns,i,k) * g * g - - end do ! End do i=1,Nday - end do ! End do k=1,pver - end do ! nswbands - -end subroutine old_ice_optics_sw -!============================================================================== - -subroutine oldcloud_lw(state,pbuf,cld_abs_od,oldwp) - use physconst, only: gravit - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer - logical,intent(in) :: oldwp ! use old definition of waterpath - - - real(r8) :: gicewp(pcols,pver) - real(r8) :: gliqwp(pcols,pver) - real(r8) :: cicewp(pcols,pver) - real(r8) :: cliqwp(pcols,pver) - real(r8) :: ficemr(pcols,pver) - real(r8) :: cwp(pcols,pver) - real(r8) :: cldtau(pcols,pver) - - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: rei - integer :: ncol, itim_old, lwband, i, k, lchnk - real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth - - real(r8) :: kabs, kabsi - real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) - parameter (kabsl = 0.090361_r8) - - - - ncol = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - if (oldwp) then - do k=1,pver - do i = 1,ncol - gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. - gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. - cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. - cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. - ficemr(i,k) = state%q(i,k,ixcldice) / & - max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) - end do - end do - cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) - else - if (iclwp_idx<=0 .or. iciwp_idx<=0) then - call endrun('oldcloud_lw: oldwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') - endif - call pbuf_get_field(pbuf, iclwp_idx, iclwpth) - call pbuf_get_field(pbuf, iciwp_idx, iciwpth) - do k=1,pver - do i = 1,ncol - cwp(i,k) = 1000.0_r8 *iclwpth(i,k) + 1000.0_r8 *iciwpth(i, k) - ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) - end do - end do - endif - - do k=1,pver - do i=1,ncol - - !note that optical properties for ice valid only - !in range of 13 > rei > 130 micron (Ebert and Curry 92) - kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) - kabs = kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) - !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) - cldtau(i,k) = kabs*cwp(i,k) - end do - end do -! - do lwband = 1,nlwbands - cld_abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) - enddo - -end subroutine oldcloud_lw - -!============================================================================== -subroutine old_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - logical, intent(in) :: oldliqwp - - real(r8) :: gicewp(pcols,pver) - real(r8) :: gliqwp(pcols,pver) - real(r8) :: cicewp(pcols,pver) - real(r8) :: cliqwp(pcols,pver) - real(r8) :: ficemr(pcols,pver) - real(r8) :: cwp(pcols,pver) - real(r8) :: cldtau(pcols,pver) - - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: rei - integer :: ncol, itim_old, lwband, i, k, lchnk - - real(r8) :: kabs, kabsi - real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) - parameter (kabsl = 0.090361_r8) - - real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth - - ncol=state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - if (oldliqwp) then - do k=1,pver - do i = 1,ncol - gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. - gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. - cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. - cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. - ficemr(i,k) = state%q(i,k,ixcldice) / & - max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) - end do - end do - cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) - else - if (iclwp_idx<=0 .or. iciwp_idx<=0) then - call endrun('old_liq_get_rad_props_lw: oldliqwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') - endif - call pbuf_get_field(pbuf, iclwp_idx, iclwpth) - call pbuf_get_field(pbuf, iciwp_idx, iciwpth) - do k=1,pver - do i = 1,ncol - cwp(i,k) = 1000.0_r8 *iclwpth(i,k) + 1000.0_r8 *iciwpth(i, k) - ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) - end do - end do - endif - - - do k=1,pver - do i=1,ncol - - ! Note from Andrew Conley: - ! Optics for RK no longer supported, This is constructed to get - ! close to bit for bit. Otherwise we could simply use liquid water path - !note that optical properties for ice valid only - !in range of 13 > rei > 130 micron (Ebert and Curry 92) - kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) - kabs = kabsl*(1._r8-ficemr(i,k)) ! + kabsi*ficemr(i,k) - !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) - cldtau(i,k) = kabs*cwp(i,k) - end do - end do -! - do lwband = 1,nlwbands - abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) - enddo - - -end subroutine old_liq_get_rad_props_lw -!============================================================================== - -subroutine old_ice_get_rad_props_lw(state, pbuf, abs_od, oldicewp) - use physconst, only: gravit - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - logical, intent(in) :: oldicewp - - real(r8) :: gicewp(pcols,pver) - real(r8) :: gliqwp(pcols,pver) - real(r8) :: cicewp(pcols,pver) - real(r8) :: cliqwp(pcols,pver) - real(r8) :: ficemr(pcols,pver) - real(r8) :: cwp(pcols,pver) - real(r8) :: cldtau(pcols,pver) - - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: rei - integer :: ncol, itim_old, lwband, i, k, lchnk - - real(r8) :: kabs, kabsi - - real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) - parameter (kabsl = 0.090361_r8) - - real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth - - - ncol = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - if(oldicewp) then - do k=1,pver - do i = 1,ncol - gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. - gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. - cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. - cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. - ficemr(i,k) = state%q(i,k,ixcldice) / & - max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) - end do - end do - cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) - else - if (iclwp_idx<=0 .or. iciwp_idx<=0) then - call endrun('old_ice_get_rad_props_lw: oldicewp must be set to true since ICIWP and/or ICLWP were not found in pbuf') - endif - call pbuf_get_field(pbuf, iclwp_idx, iclwpth) - call pbuf_get_field(pbuf, iciwp_idx, iciwpth) - do k=1,pver - do i = 1,ncol - cwp(i,k) = 1000.0_r8 *iciwpth(i,k) + 1000.0_r8 *iclwpth(i,k) - ficemr(i,k) = 1000.0_r8*iciwpth(i,k)/(max(1.e-18_r8,cwp(i,k))) - end do - end do - endif - - do k=1,pver - do i=1,ncol - - ! Note from Andrew Conley: - ! Optics for RK no longer supported, This is constructed to get - ! close to bit for bit. Otherwise we could simply use ice water path - !note that optical properties for ice valid only - !in range of 13 > rei > 130 micron (Ebert and Curry 92) - kabsi = 0.005_r8 + 1._r8/min(max(13._r8,scalefactor*rei(i,k)),130._r8) - kabs = kabsi*ficemr(i,k) ! kabsl*(1._r8-ficemr(i,k)) + kabsi*ficemr(i,k) - !emis(i,k) = 1._r8 - exp(-1.66_r8*kabs*clwp(i,k)) - cldtau(i,k) = kabs*cwp(i,k) - end do - end do -! - do lwband = 1,nlwbands - abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) - enddo - - !if(oldicewp) then - ! call outfld('CIWPTH_OLD',cicewp(:,:)/1000,pcols,lchnk) - !else - ! call outfld('CIWPTH_OLD',iciwpth(:,:),pcols,lchnk) - !endif - !call outfld('CI_OD_LW_OLD',cldtau(:,:),pcols,lchnk) - -end subroutine old_ice_get_rad_props_lw -!============================================================================== - -subroutine cloud_total_vis_diag_out(lchnk, nnite, idxnite, tau, radsuffix) - - ! output total aerosol optical depth for the visible band - - use cam_history, only: outfld - use cam_history_support, only : fillvalue - - integer, intent(in) :: lchnk - integer, intent(in) :: nnite ! number of night columns - integer, intent(in) :: idxnite(nnite) ! local column indices of night columns - real(r8), intent(in) :: tau(:,:) - character(len=*), intent(in) :: radsuffix ! identifies whether the radiation call - ! is for the climate calc or a diagnostic calc - - ! Local variables - integer :: i - real(r8) :: tmp(pcols) - !----------------------------------------------------------------------------- - - ! compute total aerosol optical depth output where only daylight columns - tmp(:) = sum(tau(:,:), 2) - do i = 1, nnite - tmp(idxnite(i)) = fillvalue - end do - !call outfld('cloudOD_v'//trim(radsuffix), tmp, pcols, lchnk) - -end subroutine cloud_total_vis_diag_out - -!============================================================================== - -end module oldcloud diff --git a/src/physics/rrtmg/radconstants.F90 b/src/physics/rrtmg/radconstants.F90 index f4f8c76b9c..601bcd3cf6 100644 --- a/src/physics/rrtmg/radconstants.F90 +++ b/src/physics/rrtmg/radconstants.F90 @@ -63,19 +63,6 @@ module radconstants integer, parameter, public :: rrtmg_sw_cloudsim_band = 9 ! rrtmg band for .67 micron -! Number of evenly spaced intervals in rh -! The globality of this mesh may not be necessary -! Perhaps it could be specific to the aerosol -! But it is difficult to see how refined it must be -! for lookup. This value was found to be sufficient -! for Sulfate and probably necessary to resolve the -! high variation near rh = 1. Alternative methods -! were found to be too slow. -! Optimal approach would be for cam to specify size of aerosol -! based on each aerosol's characteristics. Radiation -! should know nothing about hygroscopic growth! -integer, parameter, public :: nrh = 1000 - ! LONGWAVE DATA ! These are indices to the band for diagnostic output @@ -123,9 +110,6 @@ module radconstants real(r8), public, parameter :: minmmr(nradgas) & = epsilon(1._r8) -! Length of "optics type" string specified in optics files. -integer, parameter, public :: ot_length = 32 - public :: rad_gas_index public :: get_number_sw_bands, & diff --git a/src/physics/rrtmg/radiation.F90 b/src/physics/rrtmg/radiation.F90 index d55ca81240..a4c0cae8f8 100644 --- a/src/physics/rrtmg/radiation.F90 +++ b/src/physics/rrtmg/radiation.F90 @@ -17,7 +17,7 @@ module radiation use time_manager, only: get_nstep, is_first_restart_step, & get_curr_calday, get_step_size -use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, rad_cnst_get_info, & +use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, & rad_cnst_get_gas, rad_cnst_out, oldcldoptics, & liqcldoptics, icecldoptics @@ -33,10 +33,10 @@ module radiation use cam_history_support, only: fillvalue use pio, only: file_desc_t, var_desc_t, & - pio_int, pio_noerr, & + pio_int, pio_double, pio_noerr, & pio_seterrorhandling, pio_bcast_error, & pio_inq_varid, pio_def_var, & - pio_put_var, pio_get_var + pio_put_var, pio_get_var, pio_put_att use cam_abortutils, only: endrun use error_messages, only: handle_err @@ -61,6 +61,7 @@ module radiation integer,public, allocatable :: cosp_cnt(:) ! counter for cosp integer,public :: cosp_cnt_init = 0 !initial value for cosp counter +real(r8), public, protected :: nextsw_cday ! future radiation calday for surface models type rad_out_t real(r8) :: solin(pcols) ! Solar incident flux @@ -108,7 +109,7 @@ module radiation real(r8) :: aer_tau400(pcols,0:pver) real(r8) :: aer_tau550(pcols,0:pver) real(r8) :: aer_tau700(pcols,0:pver) - + end type rad_out_t ! Namelist variables @@ -129,20 +130,20 @@ module radiation ! Physics buffer indices -integer :: qrs_idx = 0 -integer :: qrl_idx = 0 -integer :: su_idx = 0 -integer :: sd_idx = 0 -integer :: lu_idx = 0 -integer :: ld_idx = 0 +integer :: qrs_idx = 0 +integer :: qrl_idx = 0 +integer :: su_idx = 0 +integer :: sd_idx = 0 +integer :: lu_idx = 0 +integer :: ld_idx = 0 integer :: fsds_idx = 0 integer :: fsns_idx = 0 integer :: fsnt_idx = 0 integer :: flns_idx = 0 integer :: flnt_idx = 0 -integer :: cldfsnow_idx = 0 -integer :: cld_idx = 0 -integer :: cldfgrau_idx = 0 +integer :: cldfsnow_idx = 0 +integer :: cld_idx = 0 +integer :: cldfgrau_idx = 0 character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ','_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) @@ -153,7 +154,7 @@ module radiation ! PIO descriptors (for restarts) type(var_desc_t) :: cospcnt_desc - +type(var_desc_t) :: nextsw_cday_desc !=============================================================================== contains !=============================================================================== @@ -221,7 +222,7 @@ subroutine radiation_readnl(nlfile) if (iradlw < 0) iradlw = nint((-iradlw *3600._r8)/dtime) if (irad_always < 0) irad_always = nint((-irad_always*3600._r8)/dtime) - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- ! Print runtime options to log. !----------------------------------------------------------------------- @@ -248,8 +249,8 @@ subroutine radiation_register use physics_buffer, only: pbuf_add_field, dtype_r8 use radiation_data, only: rad_data_register - call pbuf_add_field('QRS' , 'global',dtype_r8,(/pcols,pver/), qrs_idx) ! shortwave radiative heating rate - call pbuf_add_field('QRL' , 'global',dtype_r8,(/pcols,pver/), qrl_idx) ! longwave radiative heating rate + call pbuf_add_field('QRS' , 'global',dtype_r8,(/pcols,pver/), qrs_idx) ! shortwave radiative heating rate + call pbuf_add_field('QRL' , 'global',dtype_r8,(/pcols,pver/), qrl_idx) ! longwave radiative heating rate call pbuf_add_field('FSDS' , 'global',dtype_r8,(/pcols/), fsds_idx) ! Surface solar downward flux call pbuf_add_field('FSNS' , 'global',dtype_r8,(/pcols/), fsns_idx) ! Surface net shortwave flux @@ -312,15 +313,16 @@ end function radiation_do !================================================================================================ real(r8) function radiation_nextsw_cday() - + ! Return calendar day of next sw radiation calculation ! Local variables integer :: nstep ! timestep counter - logical :: dosw ! true => do shosrtwave calc + logical :: dosw ! true => do shosrtwave calc integer :: offset ! offset for calendar day calculation - integer :: dTime ! integer timestep size - real(r8):: calday ! calendar day of + integer :: dtime ! integer timestep size + real(r8):: calday ! calendar day of + real(r8):: caldayp1 ! calendar day of next time-step !----------------------------------------------------------------------- radiation_nextsw_cday = -1._r8 @@ -332,14 +334,20 @@ real(r8) function radiation_nextsw_cday() nstep = nstep + 1 offset = offset + dtime if (radiation_do('sw', nstep)) then - radiation_nextsw_cday = get_curr_calday(offset=offset) + radiation_nextsw_cday = get_curr_calday(offset=offset) dosw = .true. end if end do if(radiation_nextsw_cday == -1._r8) then call endrun('error in radiation_nextsw_cday') end if - + + ! determine if next radiation time-step not equal to next time-step + if (get_nstep() >= 1) then + caldayp1 = get_curr_calday(offset=int(dtime)) + if (caldayp1 /= radiation_nextsw_cday) radiation_nextsw_cday = -1._r8 + end if + end function radiation_nextsw_cday !================================================================================================ @@ -355,7 +363,6 @@ subroutine radiation_init(pbuf2d) use rad_solar_var, only: rad_solar_var_init use radiation_data, only: rad_data_init use cloud_rad_props, only: cloud_rad_props_init - use modal_aer_opt, only: modal_aer_opt_init use rrtmg_state, only: rrtmg_state_init use time_manager, only: is_first_step @@ -364,7 +371,7 @@ subroutine radiation_init(pbuf2d) type(physics_buffer_desc), pointer :: pbuf2d(:,:) ! local variables - integer :: icall, nmodes + integer :: icall logical :: active_calls(0:N_DIAG) integer :: nstep ! current timestep number logical :: history_amwg ! output the variables used by the AMWG diag package @@ -377,7 +384,7 @@ subroutine radiation_init(pbuf2d) integer :: dtime !----------------------------------------------------------------------- - + call rad_solar_var_init() call rrtmg_state_init() call rad_data_init(pbuf2d) ! initialize output fields for offline driver @@ -399,16 +406,16 @@ subroutine radiation_init(pbuf2d) dt_avg = iradsw*dtime end if + ! Surface components to get radiation computed today + if (.not. is_first_restart_step()) then + nextsw_cday = get_curr_calday() + end if + call phys_getopts(history_amwg_out = history_amwg, & history_vdiag_out = history_vdiag, & history_budget_out = history_budget, & history_budget_histfile_num_out = history_budget_histfile_num) - ! Determine whether modal aerosols are affecting the climate, and if so - ! then initialize the modal aerosol optics module - call rad_cnst_get_info(0, nmodes=nmodes) - if (nmodes > 0) call modal_aer_opt_init() - ! "irad_always" is number of time steps to execute radiation continuously from start of ! initial OR restart run nstep = get_nstep() @@ -418,12 +425,12 @@ subroutine radiation_init(pbuf2d) end if if (docosp) call cospsimulator_intr_init - + allocate(cosp_cnt(begchunk:endchunk)) if (is_first_restart_step()) then cosp_cnt(begchunk:endchunk) = cosp_cnt_init else - cosp_cnt(begchunk:endchunk) = 0 + cosp_cnt(begchunk:endchunk) = 0 end if call addfld('O3colAbove', horiz_only, 'A', 'DU', 'Column O3 above model top', sampling_seq='rad_lwsw') @@ -634,12 +641,14 @@ subroutine radiation_define_restart(file) call pio_seterrorhandling(File, PIO_BCAST_ERROR) + ierr = pio_def_var(File, 'nextsw_cday', pio_double, nextsw_cday_desc) + ierr = pio_put_att(File, nextsw_cday_desc, 'long_name', 'future radiation calday for surface models') if (docosp) then ierr = pio_def_var(File, 'cosp_cnt_init', pio_int, cospcnt_desc) end if end subroutine radiation_define_restart - + !=============================================================================== subroutine radiation_write_restart(file) @@ -653,12 +662,13 @@ subroutine radiation_write_restart(file) integer :: ierr !---------------------------------------------------------------------------- + ierr = pio_put_var(File, nextsw_cday_desc, (/ nextsw_cday /)) if (docosp) then ierr = pio_put_var(File, cospcnt_desc, (/cosp_cnt(begchunk)/)) end if end subroutine radiation_write_restart - + !=============================================================================== subroutine radiation_read_restart(file) @@ -672,6 +682,7 @@ subroutine radiation_read_restart(file) integer :: err_handling integer :: ierr + real(r8) :: temp_var type(var_desc_t) :: vardesc !---------------------------------------------------------------------------- @@ -687,22 +698,26 @@ subroutine radiation_read_restart(file) end if end if + ierr = pio_inq_varid(File, 'nextsw_cday', vardesc) + ierr = pio_get_var(File, vardesc, temp_var) + nextsw_cday = temp_var + end subroutine radiation_read_restart - + !=============================================================================== subroutine radiation_tend( & state, ptend, pbuf, cam_out, cam_in, net_flx, rd_out) - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Driver for radiation computation. - ! + ! ! Revision history: ! 2007-11-05 M. Iacono Install rrtmg_lw and sw as radiation model. ! 2007-12-27 M. Iacono Modify to use CAM cloud optical properties with rrtmg. !----------------------------------------------------------------------- - + use phys_grid, only: get_rlat_all_p, get_rlon_all_p use cam_control_mod, only: eccen, mvelpp, lambm0, obliqr use shr_orb_mod, only: shr_orb_decl, shr_orb_cosz @@ -713,8 +728,8 @@ subroutine radiation_tend( & ice_cloud_get_rad_props_lw, cloud_rad_props_get_lw, & grau_cloud_get_rad_props_lw, get_grau_optics_sw, & snow_cloud_get_rad_props_lw, get_snow_optics_sw - use slingo, only: slingo_liq_get_rad_props_lw, slingo_liq_optics_sw - use ebert_curry, only: ec_ice_optics_sw, ec_ice_get_rad_props_lw + use slingo_liq_optics, only: slingo_liq_get_rad_props_lw, slingo_liq_optics_sw + use ebert_curry_ice_optics, only: ec_ice_optics_sw, ec_ice_get_rad_props_lw use rad_solar_var, only: get_variability use radsw, only: rad_rrtmg_sw @@ -726,14 +741,14 @@ subroutine radiation_tend( & num_rrtmg_levs use interpolate_data, only: vertinterp - use tropopause, only: tropopause_find, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE + use tropopause, only: tropopause_find_cam, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE use cospsimulator_intr, only: docosp, cospsimulator_intr_run, cosp_nradsteps ! Arguments type(physics_state), intent(in), target :: state type(physics_ptend), intent(out) :: ptend - + type(physics_buffer_desc), pointer :: pbuf(:) type(cam_out_t), intent(inout) :: cam_out type(cam_in_t), intent(in) :: cam_in @@ -746,11 +761,10 @@ subroutine radiation_tend( & type(rad_out_t), pointer :: rd ! allow rd_out to be optional by allocating a local object ! if the argument is not present logical :: write_output - + integer :: i, k integer :: lchnk, ncol logical :: dosw, dolw - real(r8) :: calday ! current calendar day real(r8) :: delta ! Solar declination angle in radians real(r8) :: eccf ! Earth orbit eccentricity factor @@ -758,7 +772,7 @@ subroutine radiation_tend( & real(r8) :: clon(pcols) ! current longitudes(radians) real(r8) :: coszrs(pcols) ! Cosine solar zenith angle - ! Gathered indices of day and night columns + ! Gathered indices of day and night columns ! chunk_column_index = IdxDay(daylight_column_index) integer :: Nday ! Number of daylight columns integer :: Nnite ! Number of night columns @@ -770,8 +784,8 @@ subroutine radiation_tend( & real(r8), pointer :: cld(:,:) ! cloud fraction real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds- whatever they are" real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "snow clouds- whatever they are" - real(r8), pointer :: qrs(:,:) ! shortwave radiative heating rate - real(r8), pointer :: qrl(:,:) ! longwave radiative heating rate + real(r8), pointer :: qrs(:,:) ! shortwave radiative heating rate + real(r8), pointer :: qrl(:,:) ! longwave radiative heating rate real(r8), pointer :: fsds(:) ! Surface solar down flux real(r8), pointer :: fsns(:) ! Surface solar absorbed flux real(r8), pointer :: fsnt(:) ! Net column abs solar flux at model top @@ -792,36 +806,36 @@ subroutine radiation_tend( & ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: ice_tau (nswbands,pcols,pver) ! ice extinction optical depth real(r8) :: ice_tau_w (nswbands,pcols,pver) ! ice single scattering albedo * tau - real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice assymetry parameter * tau * w + real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice asymmetry parameter * tau * w real(r8) :: ice_tau_w_f(nswbands,pcols,pver) ! ice forward scattered fraction * tau * w real(r8) :: ice_lw_abs (nlwbands,pcols,pver) ! ice absorption optics depth (LW) ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: liq_tau (nswbands,pcols,pver) ! liquid extinction optical depth real(r8) :: liq_tau_w (nswbands,pcols,pver) ! liquid single scattering albedo * tau - real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid assymetry parameter * tau * w + real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid asymmetry parameter * tau * w real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! liquid forward scattered fraction * tau * w real(r8) :: liq_lw_abs (nlwbands,pcols,pver) ! liquid absorption optics depth (LW) ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: cld_tau (nswbands,pcols,pver) ! cloud extinction optical depth real(r8) :: cld_tau_w (nswbands,pcols,pver) ! cloud single scattering albedo * tau - real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud assymetry parameter * w * tau + real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud asymmetry parameter * w * tau real(r8) :: cld_tau_w_f(nswbands,pcols,pver) ! cloud forward scattered fraction * w * tau real(r8) :: cld_lw_abs (nlwbands,pcols,pver) ! cloud absorption optics depth (LW) ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: snow_tau (nswbands,pcols,pver) ! snow extinction optical depth real(r8) :: snow_tau_w (nswbands,pcols,pver) ! snow single scattering albedo * tau - real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow assymetry parameter * tau * w + real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow asymmetry parameter * tau * w real(r8) :: snow_tau_w_f(nswbands,pcols,pver) ! snow forward scattered fraction * tau * w real(r8) :: snow_lw_abs (nlwbands,pcols,pver)! snow absorption optics depth (LW) - ! Add graupel as another snow species. + ! Add graupel as another snow species. ! cloud radiative parameters are "in cloud" not "in cell" real(r8) :: grau_tau (nswbands,pcols,pver) ! graupel extinction optical depth real(r8) :: grau_tau_w (nswbands,pcols,pver) ! graupel single scattering albedo * tau - real(r8) :: grau_tau_w_g(nswbands,pcols,pver) ! graupel assymetry parameter * tau * w + real(r8) :: grau_tau_w_g(nswbands,pcols,pver) ! graupel asymmetry parameter * tau * w real(r8) :: grau_tau_w_f(nswbands,pcols,pver) ! graupel forward scattered fraction * tau * w real(r8) :: grau_lw_abs (nlwbands,pcols,pver)! graupel absorption optics depth (LW) @@ -829,7 +843,7 @@ subroutine radiation_tend( & real(r8) :: cldfprime(pcols,pver) ! combined cloud fraction (snow plus regular) real(r8) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth real(r8) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau - real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau + real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud asymmetry parameter * w * tau real(r8) :: c_cld_tau_w_f(nswbands,pcols,pver) ! combined cloud forward scattered fraction * w * tau real(r8) :: c_cld_lw_abs (nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW) @@ -841,7 +855,7 @@ subroutine radiation_tend( & ! Aerosol radiative properties real(r8) :: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau - real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau + real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * w * tau real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau real(r8) :: aer_lw_abs (pcols,pver,nlwbands) ! aerosol absorption optics depth (LW) @@ -849,7 +863,7 @@ subroutine radiation_tend( & real(r8) :: fcns(pcols,pverp) ! net clear-sky shortwave flux real(r8) :: fnl(pcols,pverp) ! net longwave flux real(r8) :: fcnl(pcols,pverp) ! net clear-sky longwave flux - + ! for COSP real(r8) :: emis(pcols,pver) ! Cloud longwave emissivity real(r8) :: gb_snow_tau(pcols,pver) ! grid-box mean snow_tau @@ -944,9 +958,17 @@ subroutine radiation_tend( & ! Find tropopause height if needed for diagnostic output if (hist_fld_active('FSNR') .or. hist_fld_active('FLNR')) then - call tropopause_find(state, troplev, tropP=p_trop, primary=TROP_ALG_HYBSTOB, backup=TROP_ALG_CLIMATE) + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + troplev(:) = 0 + p_trop(:) = 0._r8 + !REMOVECAM_END + call tropopause_find_cam(state, troplev, tropP=p_trop, primary=TROP_ALG_HYBSTOB, backup=TROP_ALG_CLIMATE) endif + ! Get time of next radiation calculation - albedos will need to be + ! calculated by each surface model at this time + nextsw_cday = radiation_nextsw_cday() + if (dosw .or. dolw) then ! construct an RRTMG state object @@ -963,7 +985,7 @@ subroutine radiation_tend( & else cldfprime(:ncol,:) = cld(:ncol,:) end if - + if (cldfgrau_idx > 0 .and. graupel_in_rad) then do k = 1, pver do i = 1, ncol @@ -971,7 +993,7 @@ subroutine radiation_tend( & end do end do end if - + if (dosw) then if (oldcldoptics) then @@ -1001,7 +1023,7 @@ subroutine radiation_tend( & cld_tau_w(:,:ncol,:) = liq_tau_w(:,:ncol,:) + ice_tau_w(:,:ncol,:) cld_tau_w_g(:,:ncol,:) = liq_tau_w_g(:,:ncol,:) + ice_tau_w_g(:,:ncol,:) cld_tau_w_f(:,:ncol,:) = liq_tau_w_f(:,:ncol,:) + ice_tau_w_f(:,:ncol,:) - + if (cldfsnow_idx > 0) then ! add in snow call get_snow_optics_sw(state, pbuf, snow_tau, snow_tau_w, snow_tau_w_g, snow_tau_w_f) @@ -1185,7 +1207,7 @@ subroutine radiation_tend( & call aer_rad_props_sw(icall, state, pbuf, nnite, idxnite, & aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f) - + rd%cld_tau_cloudsim(:ncol,:) = cld_tau(rrtmg_sw_cloudsim_band,:ncol,:) rd%aer_tau550(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag) rd%aer_tau400(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag+1) @@ -1222,7 +1244,7 @@ subroutine radiation_tend( & ! Output aerosol mmr call rad_cnst_out(0, state, pbuf) - + ! Longwave radiation computation if (dolw) then @@ -1238,7 +1260,7 @@ subroutine radiation_tend( & call rrtmg_state_update( state, pbuf, icall, r_state) call aer_rad_props_lw(icall, state, pbuf, aer_lw_abs) - + call rad_rrtmg_lw( & lchnk, ncol, num_rrtmg_levs, r_state, state%pmid, & aer_lw_abs, cldfprime, c_cld_lw_abs, qrl, rd%qrlc, & @@ -1288,7 +1310,7 @@ subroutine radiation_tend( & do i = 1, ncol do k = 1, pver if (cldfsnow(i,k) > 0._r8) then - + ! Add graupel to snow tau for cosp if (cldfgrau_idx > 0 .and. graupel_in_rad) then gb_snow_tau(i,k) = snow_tau(rrtmg_sw_cloudsim_band,i,k)*cldfsnow(i,k) + & @@ -1490,7 +1512,7 @@ subroutine radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out, freqclr, f call outfld('FLUT'//diag(icall), rd%flut, pcols, lchnk) call outfld('FLUTC'//diag(icall), rd%flutc, pcols, lchnk) - + ftem(:ncol) = rd%flutc(:ncol) - rd%flut(:ncol) call outfld('LWCF'//diag(icall), ftem, pcols, lchnk) @@ -1511,7 +1533,7 @@ end subroutine radiation_output_lw subroutine calc_col_mean(state, mmr_pointer, mean_value) - ! Compute the column mean mass mixing ratio. + ! Compute the column mean mass mixing ratio. type(physics_state), intent(in) :: state real(r8), dimension(:,:), pointer :: mmr_pointer ! mass mixing ratio (lev) @@ -1540,4 +1562,3 @@ end subroutine calc_col_mean !=============================================================================== end module radiation - diff --git a/src/physics/rrtmg/radsw.F90 b/src/physics/rrtmg/radsw.F90 index df222557dd..994d56b44e 100644 --- a/src/physics/rrtmg/radsw.F90 +++ b/src/physics/rrtmg/radsw.F90 @@ -255,7 +255,7 @@ subroutine rad_rrtmg_sw(lchnk,ncol ,rrtmg_levs ,r_state , & ! Aerosol radiative property arrays real(r8) :: tauxar(pcols,0:pver) ! aerosol extinction optical depth real(r8) :: wa(pcols,0:pver) ! aerosol single scattering albedo - real(r8) :: ga(pcols,0:pver) ! aerosol assymetry parameter + real(r8) :: ga(pcols,0:pver) ! aerosol asymmetry parameter real(r8) :: fa(pcols,0:pver) ! aerosol forward scattered fraction ! CRM diff --git a/src/physics/rrtmg/rrtmg_state.F90 b/src/physics/rrtmg/rrtmg_state.F90 index 2d1ca05985..62b7a2d997 100644 --- a/src/physics/rrtmg/rrtmg_state.F90 +++ b/src/physics/rrtmg/rrtmg_state.F90 @@ -233,7 +233,7 @@ subroutine rrtmg_state_update(pstate,pbuf,icall,rstate) chi_eff(:) = chi_eff(:) / 2.1415e-5_r8 ! O3 column above in DU endwhere - call outfld('O3colAbove', chi_eff(:ncol), pcols, lchnk) + call outfld('O3colAbove', chi_eff(:ncol), ncol, lchnk) end subroutine rrtmg_state_update diff --git a/src/physics/rrtmg/slingo.F90 b/src/physics/rrtmg/slingo.F90 deleted file mode 100644 index aedb44bcee..0000000000 --- a/src/physics/rrtmg/slingo.F90 +++ /dev/null @@ -1,409 +0,0 @@ -module slingo - -!------------------------------------------------------------------------------------------------ -! Implements Slingo Optics for MG/RRTMG for liquid clouds and -! a copy of the old cloud routine for reference -!------------------------------------------------------------------------------------------------ - -use shr_kind_mod, only: r8 => shr_kind_r8 -use ppgrid, only: pcols, pver, pverp -use physics_types, only: physics_state -use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx -use radconstants, only: nswbands, nlwbands, idx_sw_diag, ot_length, idx_lw_diag, get_sw_spectral_boundaries -use cam_abortutils, only: endrun -use cam_history, only: outfld - -implicit none -private -save - -public :: & - slingo_rad_props_init, & - cloud_rad_props_get_sw, & ! return SW optical props of total bulk aerosols - cloud_rad_props_get_lw, & ! return LW optical props of total bulk aerosols - slingo_liq_get_rad_props_lw, & - slingo_liq_optics_sw - -! Minimum cloud amount (as a fraction of the grid-box area) to -! distinguish from clear sky -! - real(r8) cldmin - parameter (cldmin = 1.0e-80_r8) -! -! Decimal precision of cloud amount (0 -> preserve full resolution; -! 10^-n -> preserve n digits of cloud amount) -! - real(r8) cldeps - parameter (cldeps = 0.0_r8) - -! -! indexes into pbuf for optical parameters of MG clouds -! - integer :: iclwp_idx = 0 - integer :: iciwp_idx = 0 - integer :: cld_idx = 0 - integer :: rel_idx = 0 - integer :: rei_idx = 0 - -! indexes into constituents for old optics - integer :: & - ixcldliq, & ! cloud liquid water index - ixcldice ! cloud liquid water index - - -!============================================================================== -contains -!============================================================================== - -subroutine slingo_rad_props_init() - -! use cam_history, only: addfld - use netcdf - use spmd_utils, only: masterproc - use ioFileMod, only: getfil - use cam_logfile, only: iulog - use error_messages, only: handle_ncerr -#if ( defined SPMD ) - use mpishorthand -#endif - use constituents, only: cnst_get_ind - - integer :: err - - iciwp_idx = pbuf_get_index('ICIWP',errcode=err) - iclwp_idx = pbuf_get_index('ICLWP',errcode=err) - cld_idx = pbuf_get_index('CLD') - rel_idx = pbuf_get_index('REL') - rei_idx = pbuf_get_index('REI') - - ! old optics - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - - !call addfld ('CLWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','old In Cloud Liquid Water Path', sampling_seq='rad_lwsw') - !call addfld ('KEXT_OLD',(/ 'lev' /),'I','m^2/kg','old extinction') - !call addfld ('CLDOD_OLD',(/ 'lev' /),'I','1','old liquid OD') - !call addfld ('REL_OLD',(/ 'lev' /),'I','1','old liquid effective radius (liquid)') - - !call addfld ('CLWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Liquid Water Path', sampling_seq='rad_lwsw') - !call addfld ('KEXT_NEW',(/ 'lev' /),'I','m^2/kg','extinction') - !call addfld ('CLDOD_NEW',(/ 'lev' /),'I','1','liquid OD') - - !call addfld('CIWPTH_NEW',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path', sampling_seq='rad_lwsw') - !call addfld('CIWPTH_OLD',(/ 'lev' /), 'I','Kg/m2','In Cloud Ice Water Path (old)', sampling_seq='rad_lwsw') - - return - -end subroutine slingo_rad_props_init - -!============================================================================== - -subroutine cloud_rad_props_get_sw(state, pbuf, & - tau, tau_w, tau_w_g, tau_w_f,& - diagnosticindex) - -! return totaled (across all species) layer tau, omega, g, f -! for all spectral interval for aerosols affecting the climate - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - integer, optional, intent(in) :: diagnosticindex ! index (if present) to radiation diagnostic information - - real(r8), intent(out) :: tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8), intent(out) :: tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8), intent(out) :: tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8), intent(out) :: tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - ! Local variables - - integer :: ncol - integer :: lchnk - integer :: k, i ! lev and daycolumn indices - integer :: iswband ! sw band indices - - real(r8) :: liq_tau (nswbands,pcols,pver) ! aerosol extinction optical depth - real(r8) :: liq_tau_w (nswbands,pcols,pver) ! aerosol single scattering albedo * tau - real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! aerosol assymetry parameter * tau * w - real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! aerosol forward scattered fraction * tau * w - - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - call slingo_liq_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f, oldliqwp=.true. ) - -end subroutine cloud_rad_props_get_sw -!============================================================================== - -subroutine cloud_rad_props_get_lw(state, pbuf, cld_abs_od, diagnosticindex, oldliq, oldice, oldcloud) - -! Purpose: Compute cloud longwave absorption optical depth -! cloud_rad_props_get_lw() is called by radlw() - - ! Arguments - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out) :: cld_abs_od(nlwbands,pcols,pver) ! [fraction] absorption optical depth, per layer - integer, optional, intent(in) :: diagnosticindex - logical, optional, intent(in) :: oldliq ! use old liquid optics - logical, optional, intent(in) :: oldice ! use old ice optics - logical, optional, intent(in) :: oldcloud ! use old optics for both (b4b) - - ! Local variables - - integer :: bnd_idx ! LW band index - integer :: i ! column index - integer :: k ! lev index - integer :: ncol ! number of columns - integer :: lchnk - - ! rad properties for liquid clouds - real(r8) :: liq_tau_abs_od(nlwbands,pcols,pver) ! liquid cloud absorption optical depth - - !----------------------------------------------------------------------------- - - ncol = state%ncol - lchnk = state%lchnk - - ! compute optical depths cld_absod - cld_abs_od = 0._r8 - - call slingo_liq_get_rad_props_lw(state, pbuf, liq_tau_abs_od, oldliqwp=.true.) - - cld_abs_od(:,1:ncol,:) = liq_tau_abs_od(:,1:ncol,:) - -end subroutine cloud_rad_props_get_lw - -!============================================================================== -! Private methods -!============================================================================== - - -subroutine slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp) - - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - - real(r8),intent(out) :: liq_tau (nswbands,pcols,pver) ! extinction optical depth - real(r8),intent(out) :: liq_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau - real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w - real(r8),intent(out) :: liq_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w - logical, intent(in) :: oldliqwp - - real(r8), pointer, dimension(:,:) :: rel - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: tmpptr - real(r8), dimension(pcols,pver) :: cliqwp - real(r8), dimension(nswbands) :: wavmin - real(r8), dimension(nswbands) :: wavmax - - ! Minimum cloud amount (as a fraction of the grid-box area) to - ! distinguish from clear sky - real(r8), parameter :: cldmin = 1.0e-80_r8 - - ! Decimal precision of cloud amount (0 -> preserve full resolution; - ! 10^-n -> preserve n digits of cloud amount) - real(r8), parameter :: cldeps = 0.0_r8 - - ! A. Slingo's data for cloud particle radiative properties (from 'A GCM - ! Parameterization for the Shortwave Properties of Water Clouds' JAS - ! vol. 46 may 1989 pp 1419-1427) - real(r8) :: abarl(4) = & ! A coefficient for extinction optical depth - (/ 2.817e-02_r8, 2.682e-02_r8,2.264e-02_r8,1.281e-02_r8/) - real(r8) :: bbarl(4) = & ! B coefficient for extinction optical depth - (/ 1.305_r8 , 1.346_r8 ,1.454_r8 ,1.641_r8 /) - real(r8) :: cbarl(4) = & ! C coefficient for single scat albedo - (/-5.62e-08_r8 ,-6.94e-06_r8 ,4.64e-04_r8 ,0.201_r8 /) - real(r8) :: dbarl(4) = & ! D coefficient for single scat albedo - (/ 1.63e-07_r8 , 2.35e-05_r8 ,1.24e-03_r8 ,7.56e-03_r8 /) - real(r8) :: ebarl(4) = & ! E coefficient for asymmetry parameter - (/ 0.829_r8 , 0.794_r8 ,0.754_r8 ,0.826_r8 /) - real(r8) :: fbarl(4) = & ! F coefficient for asymmetry parameter - (/ 2.482e-03_r8, 4.226e-03_r8,6.560e-03_r8,4.353e-03_r8/) - - real(r8) :: abarli ! A coefficient for current spectral band - real(r8) :: bbarli ! B coefficient for current spectral band - real(r8) :: cbarli ! C coefficient for current spectral band - real(r8) :: dbarli ! D coefficient for current spectral band - real(r8) :: ebarli ! E coefficient for current spectral band - real(r8) :: fbarli ! F coefficient for current spectral band - - ! Caution... A. Slingo recommends no less than 4.0 micro-meters nor - ! greater than 20 micro-meters - - integer :: ns, i, k, indxsl, Nday - integer :: i_rel, lchnk, icld, itim_old - real(r8) :: tmp1l, tmp2l, tmp3l, g - real(r8) :: kext(pcols,pver) - real(r8), pointer, dimension(:,:) :: iclwpth - - Nday = state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, rel_idx, rel) - - if (oldliqwp) then - do k=1,pver - do i = 1,Nday - cliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/(gravit*max(0.01_r8,cldn(i,k))) - end do - end do - else - if (iclwp_idx<=0) then - call endrun('slingo_liq_optics_sw: oldliqwp must be set to true since ICLWP was not found in pbuf') - endif - ! The following is the eventual target specification for in cloud liquid water path. - call pbuf_get_field(pbuf, iclwp_idx, tmpptr) - cliqwp = tmpptr - endif - - call get_sw_spectral_boundaries(wavmin,wavmax,'microns') - - do ns = 1, nswbands - ! Set index for cloud particle properties based on the wavelength, - ! according to A. Slingo (1989) equations 1-3: - ! Use index 1 (0.25 to 0.69 micrometers) for visible - ! Use index 2 (0.69 - 1.19 micrometers) for near-infrared - ! Use index 3 (1.19 to 2.38 micrometers) for near-infrared - ! Use index 4 (2.38 to 4.00 micrometers) for near-infrared - if(wavmax(ns) <= 0.7_r8) then - indxsl = 1 - else if(wavmax(ns) <= 1.25_r8) then - indxsl = 2 - else if(wavmax(ns) <= 2.38_r8) then - indxsl = 3 - else if(wavmax(ns) > 2.38_r8) then - indxsl = 4 - end if - - ! Set cloud extinction optical depth, single scatter albedo, - ! asymmetry parameter, and forward scattered fraction: - abarli = abarl(indxsl) - bbarli = bbarl(indxsl) - cbarli = cbarl(indxsl) - dbarli = dbarl(indxsl) - ebarli = ebarl(indxsl) - fbarli = fbarl(indxsl) - - do k=1,pver - do i=1,Nday - - ! note that optical properties for liquid valid only - ! in range of 4.2 > rel > 16 micron (Slingo 89) - if (cldn(i,k) >= cldmin .and. cldn(i,k) >= cldeps) then - tmp1l = abarli + bbarli/min(max(4.2_r8,rel(i,k)),16._r8) - liq_tau(ns,i,k) = 1000._r8*cliqwp(i,k)*tmp1l - else - liq_tau(ns,i,k) = 0.0_r8 - endif - - tmp2l = 1._r8 - cbarli - dbarli*min(max(4.2_r8,rel(i,k)),16._r8) - tmp3l = fbarli*min(max(4.2_r8,rel(i,k)),16._r8) - ! Do not let single scatter albedo be 1. Delta-eddington solution - ! for non-conservative case has different analytic form from solution - ! for conservative case, and raddedmx is written for non-conservative case. - liq_tau_w(ns,i,k) = liq_tau(ns,i,k) * min(tmp2l,.999999_r8) - g = ebarli + tmp3l - liq_tau_w_g(ns,i,k) = liq_tau_w(ns,i,k) * g - liq_tau_w_f(ns,i,k) = liq_tau_w(ns,i,k) * g * g - - end do ! End do i=1,Nday - end do ! End do k=1,pver - end do ! nswbands - - !call outfld('CL_OD_SW_OLD',liq_tau(idx_sw_diag,:,:), pcols, lchnk) - !call outfld('REL_OLD',rel(:,:), pcols, lchnk) - !call outfld('CLWPTH_OLD',cliqwp(:,:), pcols, lchnk) - !call outfld('KEXT_OLD',kext(:,:), pcols, lchnk) - - -end subroutine slingo_liq_optics_sw - -subroutine slingo_liq_get_rad_props_lw(state, pbuf, abs_od, oldliqwp) - use physconst, only: gravit - - type(physics_state), intent(in) :: state - type(physics_buffer_desc),pointer :: pbuf(:) - real(r8), intent(out) :: abs_od(nlwbands,pcols,pver) - logical, intent(in) :: oldliqwp - - real(r8) :: gicewp(pcols,pver) - real(r8) :: gliqwp(pcols,pver) - real(r8) :: cicewp(pcols,pver) - real(r8) :: cliqwp(pcols,pver) - real(r8) :: ficemr(pcols,pver) - real(r8) :: cwp(pcols,pver) - real(r8) :: cldtau(pcols,pver) - - real(r8), pointer, dimension(:,:) :: cldn - real(r8), pointer, dimension(:,:) :: rei - integer :: ncol, icld, itim_old, i_rei, lwband, i, k, lchnk - - real(r8) :: kabs, kabsi - real(r8) kabsl ! longwave liquid absorption coeff (m**2/g) - parameter (kabsl = 0.090361_r8) - - real(r8), pointer, dimension(:,:) :: iclwpth, iciwpth - - ncol=state%ncol - lchnk = state%lchnk - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - if (oldliqwp) then - do k=1,pver - do i = 1,ncol - gicewp(i,k) = state%q(i,k,ixcldice)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box ice water path. - gliqwp(i,k) = state%q(i,k,ixcldliq)*state%pdel(i,k)/gravit*1000.0_r8 ! Grid box liquid water path. - cicewp(i,k) = gicewp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud ice water path. - cliqwp(i,k) = gliqwp(i,k) / max(0.01_r8,cldn(i,k)) ! In-cloud liquid water path. - ficemr(i,k) = state%q(i,k,ixcldice) / & - max(1.e-10_r8,(state%q(i,k,ixcldice)+state%q(i,k,ixcldliq))) - end do - end do - cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) - else - if (iclwp_idx<=0 .or. iciwp_idx<=0) then - call endrun('slingo_liq_get_rad_props_lw: oldliqwp must be set to true since ICIWP and/or ICLWP were not found in pbuf') - endif - call pbuf_get_field(pbuf, iclwp_idx, iclwpth) - call pbuf_get_field(pbuf, iciwp_idx, iciwpth) - do k=1,pver - do i = 1,ncol - cwp (i,k) = 1000.0_r8 * iclwpth(i,k) + 1000.0_r8 * iciwpth(i, k) - ficemr(i,k) = 1000.0_r8 * iciwpth(i,k)/(max(1.e-18_r8, cwp(i,k))) - end do - end do - endif - - - do k=1,pver - do i=1,ncol - - ! Note from Andrew Conley: - ! Optics for RK no longer supported, This is constructed to get - ! close to bit for bit. Otherwise we could simply use liquid water path - !note that optical properties for ice valid only - !in range of 13 > rei > 130 micron (Ebert and Curry 92) - kabs = kabsl*(1._r8-ficemr(i,k)) - cldtau(i,k) = kabs*cwp(i,k) - end do - end do -! - do lwband = 1,nlwbands - abs_od(lwband,1:ncol,1:pver)=cldtau(1:ncol,1:pver) - enddo - - -end subroutine slingo_liq_get_rad_props_lw - -end module slingo diff --git a/src/physics/rrtmgp/data b/src/physics/rrtmgp/data new file mode 160000 index 0000000000..df02975ab9 --- /dev/null +++ b/src/physics/rrtmgp/data @@ -0,0 +1 @@ +Subproject commit df02975ab93165b34a59f0d04b4ae6148fe5127c diff --git a/src/physics/rrtmgp/ext b/src/physics/rrtmgp/ext new file mode 160000 index 0000000000..4d8c5df4c6 --- /dev/null +++ b/src/physics/rrtmgp/ext @@ -0,0 +1 @@ +Subproject commit 4d8c5df4c63434aaab854afd1b02f5986d41dfb3 diff --git a/src/physics/rrtmgp/mcica_subcol_gen.F90 b/src/physics/rrtmgp/mcica_subcol_gen.F90 new file mode 100644 index 0000000000..85bea8281c --- /dev/null +++ b/src/physics/rrtmgp/mcica_subcol_gen.F90 @@ -0,0 +1,286 @@ +module mcica_subcol_gen + +!---------------------------------------------------------------------------------------- +! +! Purpose: Create McICA stochastic arrays for cloud optical properties. +! Input cloud optical properties directly: cloud optical depth, single +! scattering albedo and asymmetry parameter. Output will be stochastic +! arrays of these variables. (longwave scattering is not yet available) +! +! Original code: From RRTMG, with the following copyright notice, +! based on Raisanen et al., QJRMS, 2004: +! -------------------------------------------------------------------------- +! | | +! | Copyright 2006-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- +! This code is a refactored version of code originally in the files +! mcica_subcol_gen_lw.F90 and mcica_subcol_gen_sw.F90 +! +! Uses the KISS random number generator. +! +! Overlap assumption: maximum-random. +! +!---------------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver +use shr_RandNum_mod, only: ShrKissRandGen +use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + +implicit none +private +save + +public :: mcica_subcol_lw, mcica_subcol_sw + +!======================================================================================== +contains +!======================================================================================== + +subroutine mcica_subcol_lw( & + kdist, nbnd, ngpt, ncol, nver, & + changeseed, pmid, cldfrac, tauc, taucmcl ) + + ! Arrays use CAM vertical index convention: index increases from top to bottom. + ! This index ordering is assumed in the maximum-random overlap algorithm which starts + ! at the top of a column and marches down, with each layer depending on the state + ! of the layer above it. + ! + ! For GCM mode, changeseed must be offset between LW and SW by at least the + ! number of subcolumns + + ! arguments + class(ty_gas_optics_rrtmgp), intent(in) :: kdist ! spectral information + integer, intent(in) :: nbnd ! number of spectral bands + integer, intent(in) :: ngpt ! number of subcolumns (g-point intervals) + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nver ! number of layers + integer, intent(in) :: changeseed ! if the subcolumn generator is called multiple times, + ! permute the seed between each call. + real(r8), intent(in) :: pmid(pcols,pver) ! layer pressures (Pa) + real(r8), intent(in) :: cldfrac(ncol,nver) ! layer cloud fraction + real(r8), intent(in) :: tauc(nbnd,ncol,nver) ! cloud optical depth + real(r8), intent(out) :: taucmcl(ngpt,ncol,nver) ! subcolumn cloud optical depth [mcica] + + ! Local variables + + integer :: i, isubcol, k, n + + real(r8), parameter :: cldmin = 1.0e-80_r8 ! min cloud fraction + real(r8) :: cldf(ncol,pver) ! cloud fraction clipped to cldmin + + type(ShrKissRandGen) :: kiss_gen ! KISS RNG object + integer :: kiss_seed(ncol,4) + real(r8) :: rand_num_1d(ncol,1) ! random number (kissvec) + real(r8) :: rand_num(ncol,nver) ! random number (kissvec) + + real(r8) :: cdf(ngpt,ncol,nver) ! random numbers + logical :: iscloudy(ngpt,ncol,nver) ! flag that says whether a gridbox is cloudy + !------------------------------------------------------------------------------------------ + + ! clip cloud fraction + cldf(:,:) = cldfrac(:ncol,:) + where (cldf(:,:) < cldmin) + cldf(:,:) = 0._r8 + end where + + ! Create a seed that depends on the state of the columns. + ! Use pmid from bottom four layers. + do i = 1, ncol + kiss_seed(i,1) = (pmid(i,pver) - int(pmid(i,pver))) * 1000000000 + kiss_seed(i,2) = (pmid(i,pver-1) - int(pmid(i,pver-1))) * 1000000000 + kiss_seed(i,3) = (pmid(i,pver-2) - int(pmid(i,pver-2))) * 1000000000 + kiss_seed(i,4) = (pmid(i,pver-3) - int(pmid(i,pver-3))) * 1000000000 + end do + + ! create the RNG object + kiss_gen = ShrKissRandGen(kiss_seed) + + ! Advance randum number generator by changeseed values + do i = 1, changeSeed + call kiss_gen%random(rand_num_1d) + end do + + ! Generate random numbers in each subcolumn at every level + do isubcol = 1,ngpt + call kiss_gen%random(rand_num) + cdf(isubcol,:,:) = rand_num(:,:) + enddo + + ! Maximum-Random overlap + ! i) pick a random number for top layer. + ! ii) walk down the column: + ! - if the layer above is cloudy, use the same random number as in the layer above + ! - if the layer above is clear, use a new random number + + do k = 2, nver + do i = 1, ncol + do isubcol = 1, ngpt + if (cdf(isubcol,i,k-1) > 1._r8 - cldf(i,k-1) ) then + cdf(isubcol,i,k) = cdf(isubcol,i,k-1) + else + cdf(isubcol,i,k) = cdf(isubcol,i,k) * (1._r8 - cldf(i,k-1)) + end if + end do + end do + end do + + do k = 1, nver + iscloudy(:,:,k) = (cdf(:,:,k) >= 1._r8 - spread(cldf(:,k), dim=1, nCopies=ngpt) ) + end do + + ! -- generate subcolumns for homogeneous clouds ----- + ! where there is a cloud, set the subcolumn cloud properties; + ! incoming tauc should be in-cloud quantites and not grid-averaged quantities + do k = 1,nver + do i = 1,ncol + do isubcol = 1,ngpt + if (iscloudy(isubcol,i,k) .and. (cldf(i,k) > 0._r8) ) then + n = kdist%convert_gpt2band(isubcol) + taucmcl(isubcol,i,k) = tauc(n,i,k) + else + taucmcl(isubcol,i,k) = 0._r8 + end if + end do + end do + end do + + call kiss_gen%finalize() + +end subroutine mcica_subcol_lw + +!======================================================================================== + +subroutine mcica_subcol_sw( & + kdist, nbnd, ngpt, ncol, nlay, nver, changeseed, & + pmid, cldfrac, tauc, ssac, asmc, & + taucmcl, ssacmcl, asmcmcl) + + ! Arrays use CAM vertical index convention: index increases from top to bottom. + ! This index ordering is assumed in the maximum-random overlap algorithm which starts + ! at the top of a column and marches down, with each layer depending on the state + ! of the layer above it. + ! + ! For GCM mode, changeseed must be offset between LW and SW by at least the + ! number of subcolumns + + ! arguments + class(ty_gas_optics_rrtmgp), intent(in) :: kdist ! spectral information + integer, intent(in) :: nbnd ! number of spectral bands + integer, intent(in) :: ngpt ! number of subcolumns (g-point intervals) + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlay ! number of vertical layers in radiation calc; + ! may include an "extra layer" + integer, intent(in) :: nver ! number of CAM's vertical layers in rad calc + integer, intent(in) :: changeseed ! if the subcolumn generator is called multiple times, + ! permute the seed between each call. + real(r8), intent(in) :: pmid(ncol,nlay) ! layer midpoint pressures (Pa) + real(r8), intent(in) :: cldfrac(ncol,nver) ! layer cloud fraction + real(r8), intent(in) :: tauc(nbnd,ncol,nver) ! cloud optical depth + real(r8), intent(in) :: ssac(nbnd,ncol,nver) ! cloud single scattering albedo (non-delta scaled) + real(r8), intent(in) :: asmc(nbnd,ncol,nver) ! cloud asymmetry parameter (non-delta scaled) + + + real(r8), intent(out) :: taucmcl(ngpt,ncol,nver) ! subcolumn cloud optical depth [mcica] + real(r8), intent(out) :: ssacmcl(ngpt,ncol,nver) ! subcolumn cloud single scattering albedo [mcica] + real(r8), intent(out) :: asmcmcl(ngpt,ncol,nver) ! subcolumn cloud asymmetry parameter [mcica] + + ! Local vars + + integer :: i, isubcol, k, n + + real(r8), parameter :: cldmin = 1.0e-80_r8 ! min cloud fraction + real(r8) :: cldf(ncol,nver) ! cloud fraction clipped to cldmin + + type(ShrKissRandGen) :: kiss_gen ! KISS RNG object + integer :: kiss_seed(ncol,4) + real(r8) :: rand_num_1d(ncol,1) ! random number (kissvec) + real(r8) :: rand_num(ncol,nver) ! random number (kissvec) + + real(r8) :: cdf(ngpt,ncol,nver) ! random numbers + logical :: iscloudy(ngpt,ncol,nver) ! flag that says whether a gridbox is cloudy + !------------------------------------------------------------------------------------------ + + ! clip cloud fraction + cldf(:,:) = cldfrac(:ncol,:) + where (cldf(:,:) < cldmin) + cldf(:,:) = 0._r8 + end where + + ! Create a seed that depends on the state of the columns. + ! Use pmid from bottom four layers. + do i = 1, ncol + kiss_seed(i,1) = (pmid(i,nlay) - int(pmid(i,nlay))) * 1000000000 + kiss_seed(i,2) = (pmid(i,nlay-1) - int(pmid(i,nlay-1))) * 1000000000 + kiss_seed(i,3) = (pmid(i,nlay-2) - int(pmid(i,nlay-2))) * 1000000000 + kiss_seed(i,4) = (pmid(i,nlay-3) - int(pmid(i,nlay-3))) * 1000000000 + end do + + ! create the RNG object + kiss_gen = ShrKissRandGen(kiss_seed) + + ! Advance randum number generator by changeseed values + do i = 1, changeSeed + call kiss_gen%random(rand_num_1d) + end do + + ! Generate random numbers in each subcolumn at every level + do isubcol = 1,ngpt + call kiss_gen%random(rand_num) + cdf(isubcol,:,:) = rand_num(:,:) + enddo + + ! Maximum-Random overlap + ! i) pick a random number for top layer. + ! ii) walk down the column: + ! - if the layer above is cloudy, use the same random number as in the layer above + ! - if the layer above is clear, use a new random number + + do k = 2, nver + do i = 1, ncol + do isubcol = 1, ngpt + if (cdf(isubcol,i,k-1) > 1._r8 - cldf(i,k-1) ) then + cdf(isubcol,i,k) = cdf(isubcol,i,k-1) + else + cdf(isubcol,i,k) = cdf(isubcol,i,k) * (1._r8 - cldf(i,k-1)) + end if + end do + end do + end do + + do k = 1, nver + iscloudy(:,:,k) = (cdf(:,:,k) >= 1._r8 - spread(cldf(:,k), dim=1, nCopies=ngpt) ) + end do + + ! -- generate subcolumns for homogeneous clouds ----- + ! where there is a cloud, set the subcolumn cloud properties; + ! incoming tauc should be in-cloud quantites and not grid-averaged quantities + do k = 1,nver + do i = 1,ncol + do isubcol = 1,ngpt + if (iscloudy(isubcol,i,k) .and. (cldf(i,k) > 0._r8) ) then + n = kdist%convert_gpt2band(isubcol) + taucmcl(isubcol,i,k) = tauc(n,i,k) + ssacmcl(isubcol,i,k) = ssac(n,i,k) + asmcmcl(isubcol,i,k) = asmc(n,i,k) + else + taucmcl(isubcol,i,k) = 0._r8 + ssacmcl(isubcol,i,k) = 1._r8 + asmcmcl(isubcol,i,k) = 0._r8 + end if + end do + end do + end do + + call kiss_gen%finalize() + +end subroutine mcica_subcol_sw + + +end module mcica_subcol_gen + diff --git a/src/physics/rrtmgp/rad_solar_var.F90 b/src/physics/rrtmgp/rad_solar_var.F90 new file mode 100644 index 0000000000..ab608db7f9 --- /dev/null +++ b/src/physics/rrtmgp/rad_solar_var.F90 @@ -0,0 +1,149 @@ +!------------------------------------------------------------------------------- +! This module uses the solar irradiance data +! to provide a spectral scaling factor +! to approximate the spectral distribution of irradiance +! when the radiation scheme might use a different solar source function +!------------------------------------------------------------------------------- +module rad_solar_var + + use shr_kind_mod , only : r8 => shr_kind_r8 + use radconstants, only : nswbands, get_sw_spectral_boundaries, band2gpt_sw + use solar_irrad_data, only : sol_irrad, we, nbins, has_spectrum, sol_tsi + use solar_irrad_data, only : do_spctrl_scaling + use cam_abortutils, only : endrun + use error_messages, only : alloc_err + + implicit none + save + + private + public :: rad_solar_var_init + public :: get_variability + + real(r8), allocatable :: irrad(:) ! solar irradiance at model timestep in each band + + real(r8), allocatable :: radbinmax(:) + real(r8), allocatable :: radbinmin(:) + +!------------------------------------------------------------------------------- +contains +!------------------------------------------------------------------------------- + + subroutine rad_solar_var_init( ) + + integer :: ierr + integer :: radmax_loc + + if ( do_spctrl_scaling ) then + + if ( .not.has_spectrum ) then + call endrun('rad_solar_var_init: solar input file must have irradiance spectrum') + endif + + allocate (radbinmax(nswbands),stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for radbinmax') + end if + + allocate (radbinmin(nswbands),stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for radbinmin') + end if + + allocate (irrad(nswbands), stat=ierr) + if (ierr /= 0) then + call endrun('rad_solar_var_init: Error allocating space for irrad') + end if + + call get_sw_spectral_boundaries(radbinmin, radbinmax, 'nm') + + ! Make sure that the far-IR is included, even if radiation grid does not + ! extend that far down. 10^5 nm corresponds to a wavenumber of + ! 100 cm^-1. + radmax_loc = maxloc(radbinmax,1) + radbinmax(radmax_loc) = max(100000._r8,radbinmax(radmax_loc)) + + endif + + end subroutine rad_solar_var_init + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + + subroutine get_variability(toa_flux, sfac) + + ! Arguments + real(r8), intent(in) :: toa_flux(:,:) ! TOA flux to be scaled (columns,gpts) + real(r8), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) + + ! Local variables + integer :: i, j, istat, gpt_start, gpt_end, ncols + real(r8), allocatable :: scale(:) + character(len=*), parameter :: sub = 'get_variability' + + if (do_spctrl_scaling) then + + ! Determine target irradiance for each band + call integrate_spectrum(nbins, nswbands, we, radbinmin, radbinmax, sol_irrad, irrad) + + ncols = size(toa_flux, 1) + allocate(scale(ncols), stat=istat) + call alloc_err(istat, sub, 'scale', ncols) + + do i = 1, nswbands + gpt_start = band2gpt_sw(1,i) + gpt_end = band2gpt_sw(2,i) + scale = spread(irrad(i), 1, ncols) / sum(toa_flux(:, gpt_start:gpt_end), dim=2) + do j = gpt_start, gpt_end + sfac(:,j) = scale + end do + end do + + else + sfac(:,:) = sol_tsi / spread(sum(toa_flux, 2), 2, size(toa_flux, 2)) + end if + end subroutine get_variability + + +!------------------------------------------------------------------------------- +! private method......... +!------------------------------------------------------------------------------- + + subroutine integrate_spectrum( nsrc, ntrg, src_x, min_trg, max_trg, src, trg ) + + use mo_util, only : rebin + + implicit none + + !--------------------------------------------------------------- + ! ... dummy arguments + !--------------------------------------------------------------- + integer, intent(in) :: nsrc ! dimension source array + integer, intent(in) :: ntrg ! dimension target array + real(r8), intent(in) :: src_x(nsrc+1) ! source coordinates + real(r8), intent(in) :: max_trg(ntrg) ! target coordinates + real(r8), intent(in) :: min_trg(ntrg) ! target coordinates + real(r8), intent(in) :: src(nsrc) ! source array + real(r8), intent(out) :: trg(ntrg) ! target array + + !--------------------------------------------------------------- + ! ... local variables + !--------------------------------------------------------------- + real(r8) :: trg_x(2), targ(1) ! target coordinates + integer :: i + + do i = 1, ntrg + + trg_x(1) = min_trg(i) + trg_x(2) = max_trg(i) + + call rebin( nsrc, 1, src_x, trg_x, src(1:nsrc), targ(:) ) + ! W/m2/nm --> W/m2 + trg( i ) = targ(1)*(trg_x(2)-trg_x(1)) + + enddo + + + end subroutine integrate_spectrum + +end module rad_solar_var diff --git a/src/physics/rrtmgp/radconstants.F90 b/src/physics/rrtmgp/radconstants.F90 new file mode 100644 index 0000000000..3d4b47d09e --- /dev/null +++ b/src/physics/rrtmgp/radconstants.F90 @@ -0,0 +1,301 @@ +module radconstants + +! This module contains constants that are specific to the radiative transfer +! code used in the RRTMGP model. + +use shr_kind_mod, only: r8 => shr_kind_r8 +use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp +use cam_abortutils, only: endrun + +implicit none +private +save + +! Number of bands in SW and LW. These values must match data in the RRTMGP coefficients datasets. +! But they are needed to allocate space in the physics buffer and need to be available before the +! RRTMGP datasets are read. So they are set as parameters here and checked in the +! set_wavenumber_bands subroutine after the datasets are read. +integer, parameter, public :: nswbands = 14 +integer, parameter, public :: nlwbands = 16 + +! Band limits (set from data in RRTMGP coefficient datasets) +real(r8), target :: wavenumber_low_shortwave(nswbands) +real(r8), target :: wavenumber_high_shortwave(nswbands) +real(r8), target :: wavenumber_low_longwave(nlwbands) +real(r8), target :: wavenumber_high_longwave(nlwbands) + +logical :: wavenumber_boundaries_set = .false. + +! First and last g-point for each band. +integer, public, protected :: band2gpt_sw(2,nswbands) + +integer, public, protected :: nswgpts ! number of SW g-points +integer, public, protected :: nlwgpts ! number of LW g-points + +! These are indices to specific bands for diagnostic output and COSP input. +integer, public, protected :: idx_sw_diag = -1 ! band contains 500-nm wave +integer, public, protected :: idx_nir_diag = -1 ! band contains 1000-nm wave +integer, public, protected :: idx_uv_diag = -1 ! band contains 400-nm wave +integer, public, protected :: idx_lw_diag = -1 ! band contains 1000 cm-1 wave (H20 window) +integer, public, protected :: idx_sw_cloudsim = -1 ! band contains 670-nm wave (for COSP) +integer, public, protected :: idx_lw_cloudsim = -1 ! band contains 10.5 micron wave (for COSP) + +! GASES TREATED BY RADIATION (line spectra) +! These names are recognized by RRTMGP. They are in the coefficients files as +! lower case strings. These upper case names are used by CAM's namelist and +! rad_constituents module. +integer, public, parameter :: gasnamelength = 5 +integer, public, parameter :: nradgas = 8 +character(len=gasnamelength), public, parameter :: gaslist(nradgas) & + = (/'H2O ','O3 ', 'O2 ', 'CO2 ', 'N2O ', 'CH4 ', 'CFC11', 'CFC12'/) + +! what is the minimum mass mixing ratio that can be supported by radiation implementation? +real(r8), public, parameter :: minmmr(nradgas) = epsilon(1._r8) + +public :: & + set_wavenumber_bands, & + get_sw_spectral_boundaries, & + get_lw_spectral_boundaries, & + get_band_index_by_value, & + rad_gas_index + +!========================================================================================= +contains +!========================================================================================= + +subroutine set_wavenumber_bands(kdist_sw, kdist_lw) + + ! Set the low and high limits of the wavenumber grid for sw and lw. + ! Values come from RRTMGP coefficients datasets, and are stored in the + ! kdist objects. + ! + ! Set band indices for bands containing specific wavelengths. + + ! Arguments + type(ty_gas_optics_rrtmgp), intent(in) :: kdist_sw + type(ty_gas_optics_rrtmgp), intent(in) :: kdist_lw + + ! Local variables + integer :: istat + real(r8), allocatable :: values(:,:) + + character(len=128) :: errmsg + character(len=*), parameter :: sub = 'set_wavenumber_bands' + !---------------------------------------------------------------------------- + + ! Check that number of sw/lw bands in gas optics files matches the parameters. + if (kdist_sw%get_nband() /= nswbands) then + write(errmsg,'(a,i4,a,i4)') 'number of sw bands in file, ', kdist_sw%get_nband(), & + ", doesn't match parameter nswbands= ", nswbands + call endrun(sub//': ERROR: '//trim(errmsg)) + end if + if (kdist_lw%get_nband() /= nlwbands) then + write(errmsg,'(a,i4,a,i4)') 'number of lw bands in file, ', kdist_lw%get_nband(), & + ", doesn't match parameter nlwbands= ", nlwbands + call endrun(sub//': ERROR: '//trim(errmsg)) + end if + + nswgpts = kdist_sw%get_ngpt() + nlwgpts = kdist_lw%get_ngpt() + + ! SW band bounds in cm^-1 + allocate( values(2,nswbands), stat=istat ) + if (istat/=0) then + call endrun(sub//': ERROR allocating array: values(2,nswbands)') + end if + values = kdist_sw%get_band_lims_wavenumber() + wavenumber_low_shortwave = values(1,:) + wavenumber_high_shortwave = values(2,:) + + ! First and last g-point for each SW band: + band2gpt_sw = kdist_sw%get_band_lims_gpoint() + + ! Indices into specific bands + idx_sw_diag = get_band_index_by_value('sw', 500.0_r8, 'nm') + idx_nir_diag = get_band_index_by_value('sw', 1000.0_r8, 'nm') + idx_uv_diag = get_band_index_by_value('sw', 400._r8, 'nm') + idx_sw_cloudsim = get_band_index_by_value('sw', 0.67_r8, 'micron') + + deallocate(values) + + ! LW band bounds in cm^-1 + allocate( values(2,nlwbands), stat=istat ) + if (istat/=0) then + call endrun(sub//': ERROR allocating array: values(2,nlwbands)') + end if + values = kdist_lw%get_band_lims_wavenumber() + wavenumber_low_longwave = values(1,:) + wavenumber_high_longwave = values(2,:) + + ! Indices into specific bands + idx_lw_diag = get_band_index_by_value('lw', 1000.0_r8, 'cm^-1') + idx_lw_cloudsim = get_band_index_by_value('lw', 10.5_r8, 'micron') + + wavenumber_boundaries_set = .true. + +end subroutine set_wavenumber_bands + +!========================================================================================= + +subroutine get_sw_spectral_boundaries(low_boundaries, high_boundaries, units) + + ! provide spectral boundaries of each shortwave band + + real(r8), intent(out) :: low_boundaries(nswbands), high_boundaries(nswbands) + character(*), intent(in) :: units ! requested units + + character(len=*), parameter :: sub = 'get_sw_spectral_boundaries' + !---------------------------------------------------------------------------- + + if (.not. wavenumber_boundaries_set) then + call endrun(sub//': ERROR, wavenumber boundaries not set. ') + end if + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenumber_low_shortwave + high_boundaries = wavenumber_high_shortwave + case('m','meter','meters') + low_boundaries = 1.e-2_r8/wavenumber_high_shortwave + high_boundaries = 1.e-2_r8/wavenumber_low_shortwave + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_r8/wavenumber_high_shortwave + high_boundaries = 1.e7_r8/wavenumber_low_shortwave + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_r8/wavenumber_high_shortwave + high_boundaries = 1.e4_r8/wavenumber_low_shortwave + case('cm','centimeter','centimeters') + low_boundaries = 1._r8/wavenumber_high_shortwave + high_boundaries = 1._r8/wavenumber_low_shortwave + case default + call endrun(sub//': ERROR, requested spectral units not recognized: '//units) + end select + +end subroutine get_sw_spectral_boundaries + +!========================================================================================= + +subroutine get_lw_spectral_boundaries(low_boundaries, high_boundaries, units) + + ! provide spectral boundaries of each longwave band + + real(r8), intent(out) :: low_boundaries(nlwbands), high_boundaries(nlwbands) + character(*), intent(in) :: units ! requested units + + character(len=*), parameter :: sub = 'get_lw_spectral_boundaries' + !---------------------------------------------------------------------------- + + if (.not. wavenumber_boundaries_set) then + call endrun(sub//': ERROR, wavenumber boundaries not set. ') + end if + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenumber_low_longwave + high_boundaries = wavenumber_high_longwave + case('m','meter','meters') + low_boundaries = 1.e-2_r8/wavenumber_high_longwave + high_boundaries = 1.e-2_r8/wavenumber_low_longwave + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_r8/wavenumber_high_longwave + high_boundaries = 1.e7_r8/wavenumber_low_longwave + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_r8/wavenumber_high_longwave + high_boundaries = 1.e4_r8/wavenumber_low_longwave + case('cm','centimeter','centimeters') + low_boundaries = 1._r8/wavenumber_high_longwave + high_boundaries = 1._r8/wavenumber_low_longwave + case default + call endrun(sub//': ERROR, requested spectral units not recognized: '//units) + end select + +end subroutine get_lw_spectral_boundaries + +!========================================================================================= + +integer function rad_gas_index(gasname) + + ! return the index in the gaslist array of the specified gasname + + character(len=*),intent(in) :: gasname + integer :: igas + + rad_gas_index = -1 + do igas = 1, nradgas + if (trim(gaslist(igas)).eq.trim(gasname)) then + rad_gas_index = igas + return + endif + enddo + call endrun ("rad_gas_index: can not find gas with name "//gasname) +end function rad_gas_index + +!========================================================================================= + +function get_band_index_by_value(swlw, targetvalue, units) result(ans) + + ! Find band index for requested wavelength/wavenumber. + + character(len=*), intent(in) :: swlw ! sw or lw bands + real(r8), intent(in) :: targetvalue + character(len=*), intent(in) :: units ! units of targetvalue + integer :: ans + + ! local + real(r8), pointer, dimension(:) :: lowboundaries, highboundaries + real(r8) :: tgt + integer :: nbnds, i + + character(len=128) :: errmsg + character(len=*), parameter :: sub = 'get_band_index_by_value' + !---------------------------------------------------------------------------- + + select case (swlw) + case ('sw','SW','shortwave') + nbnds = nswbands + lowboundaries => wavenumber_low_shortwave + highboundaries => wavenumber_high_shortwave + case ('lw', 'LW', 'longwave') + nbnds = nlwbands + lowboundaries => wavenumber_low_longwave + highboundaries => wavenumber_high_longwave + case default + call endrun('radconstants.F90: get_band_index_by_value: type of bands not recognized: '//swlw) + end select + + ! band info is in cm^-1 but target value may be other units, + ! so convert targetvalue to cm^-1 + select case (units) + case ('inv_cm','cm^-1','cm-1') + tgt = targetvalue + case('m','meter','meters') + tgt = 1.0_r8 / (targetvalue * 1.e2_r8) + case('nm','nanometer','nanometers') + tgt = 1.0_r8 / (targetvalue * 1.e-7_r8) + case('um','micrometer','micrometers','micron','microns') + tgt = 1.0_r8 / (targetvalue * 1.e-4_r8) + case('cm','centimeter','centimeters') + tgt = 1._r8/targetvalue + case default + call endrun('radconstants.F90: get_band_index_by_value: units not recognized: '//units) + end select + + ! now just loop through the array + ans = 0 + do i = 1,nbnds + if ((tgt > lowboundaries(i)) .and. (tgt <= highboundaries(i))) then + ans = i + exit + end if + end do + + if (ans == 0) then + write(errmsg,'(f10.3,a,a)') targetvalue, ' ', trim(units) + call endrun(sub//': band not found containing wave: '//trim(errmsg)) + end if + +end function get_band_index_by_value + +!========================================================================================= + +end module radconstants diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 new file mode 100644 index 0000000000..58a973a3f0 --- /dev/null +++ b/src/physics/rrtmgp/radiation.F90 @@ -0,0 +1,2506 @@ +module radiation + +!--------------------------------------------------------------------------------- +! +! CAM interface to RRTMGP radiation parameterization. +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl +use spmd_utils, only: masterproc +use ppgrid, only: pcols, pver, pverp, begchunk, endchunk +use ref_pres, only: pref_edge +use physics_types, only: physics_state, physics_ptend +use phys_control, only: phys_getopts +use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dtype_r8, pbuf_get_index, & + pbuf_set_field, pbuf_get_field, pbuf_old_tim_idx +use camsrfexch, only: cam_out_t, cam_in_t +use physconst, only: cappa, cpair, gravit + +use time_manager, only: get_nstep, is_first_step, is_first_restart_step, & + get_curr_calday, get_step_size + +use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, rad_cnst_get_gas, rad_cnst_out + +use rrtmgp_inputs, only: rrtmgp_inputs_init + +use radconstants, only: nradgas, gasnamelength, gaslist, nswbands, nlwbands, & + nswgpts, set_wavenumber_bands +use rad_solar_var, only: rad_solar_var_init, get_variability + +use cloud_rad_props, only: cloud_rad_props_init + +use cospsimulator_intr, only: docosp, cospsimulator_intr_init, & + cospsimulator_intr_run, cosp_nradsteps + +use scamMod, only: scm_crm_mode, single_column, have_cld, cldobs + +use cam_history, only: addfld, add_default, horiz_only, outfld, hist_fld_active + +use radiation_data, only: rad_data_register, rad_data_init + +use ioFileMod, only: getfil +use cam_pio_utils, only: cam_pio_openfile +use pio, only: file_desc_t, var_desc_t, & + pio_int, pio_double, PIO_NOERR, & + pio_seterrorhandling, PIO_BCAST_ERROR, & + pio_inq_dimlen, pio_inq_dimid, pio_inq_varid, & + pio_def_var, pio_put_var, pio_get_var, & + pio_put_att, PIO_NOWRITE, pio_closefile + +use mo_gas_concentrations, only: ty_gas_concs +use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp +use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str +use mo_source_functions, only: ty_source_func_lw +use mo_fluxes, only: ty_fluxes_broadband +use mo_fluxes_byband, only: ty_fluxes_byband + +use string_utils, only: to_lower +use cam_abortutils, only: endrun, handle_allocate_error +use cam_logfile, only: iulog + + +implicit none +private +save + +public :: & + radiation_readnl, &! read namelist variables + radiation_register, &! registers radiation physics buffer fields + radiation_do, &! query which radiation calcs are done this timestep + radiation_init, &! initialization + radiation_define_restart, &! define variables for restart + radiation_write_restart, &! write variables to restart + radiation_read_restart, &! read variables from restart + radiation_tend, &! compute heating rates and fluxes + rad_out_t ! type for diagnostic outputs + +integer,public, allocatable :: cosp_cnt(:) ! counter for cosp +integer,public :: cosp_cnt_init = 0 !initial value for cosp counter + +real(r8), public, protected :: nextsw_cday ! future radiation calday for surface models + +type rad_out_t + real(r8) :: solin(pcols) ! Solar incident flux + + real(r8) :: qrsc(pcols,pver) + + real(r8) :: fsnsc(pcols) ! Clear sky surface abs solar flux + real(r8) :: fsntc(pcols) ! Clear sky total column abs solar flux + real(r8) :: fsdsc(pcols) ! Clear sky surface downwelling solar flux + + real(r8) :: fsntoa(pcols) ! Net solar flux at TOA + real(r8) :: fsntoac(pcols) ! Clear sky net solar flux at TOA + real(r8) :: fsutoa(pcols) ! upwelling solar flux at TOA + + real(r8) :: fsnirt(pcols) ! Near-IR flux absorbed at toa + real(r8) :: fsnrtc(pcols) ! Clear sky near-IR flux absorbed at toa + real(r8) :: fsnirtsq(pcols) ! Near-IR flux absorbed at toa >= 0.7 microns + + real(r8) :: fsn200(pcols) ! Net SW flux interpolated to 200 mb + real(r8) :: fsn200c(pcols) ! Net clear-sky SW flux interpolated to 200 mb + real(r8) :: fsnr(pcols) ! Net SW flux interpolated to tropopause + + real(r8) :: flux_sw_up(pcols,pverp) ! upward shortwave flux on interfaces + real(r8) :: flux_sw_clr_up(pcols,pverp) ! upward shortwave clearsky flux + real(r8) :: flux_sw_dn(pcols,pverp) ! downward flux + real(r8) :: flux_sw_clr_dn(pcols,pverp) ! downward clearsky flux + + real(r8) :: flux_lw_up(pcols,pverp) ! upward longwave flux on interfaces + real(r8) :: flux_lw_clr_up(pcols,pverp) ! upward longwave clearsky flux + real(r8) :: flux_lw_dn(pcols,pverp) ! downward flux + real(r8) :: flux_lw_clr_dn(pcols,pverp) ! downward clearsky flux + + real(r8) :: qrlc(pcols,pver) + + real(r8) :: flntc(pcols) ! Clear sky lw flux at model top + real(r8) :: flut(pcols) ! Upward flux at top of model + real(r8) :: flutc(pcols) ! Upward Clear Sky flux at top of model + real(r8) :: lwcf(pcols) ! longwave cloud forcing + + real(r8) :: fln200(pcols) ! net longwave flux interpolated to 200 mb + real(r8) :: fln200c(pcols) ! net clearsky longwave flux interpolated to 200 mb + real(r8) :: flnr(pcols) ! net longwave flux interpolated to tropopause + + real(r8) :: flnsc(pcols) ! Clear sky lw flux at srf (up-down) + real(r8) :: fldsc(pcols) ! Clear sky lw flux at srf (down) + + real(r8) :: tot_cld_vistau(pcols,pver) ! gbx water+ice cloud optical depth (only during day, night = fillvalue) + real(r8) :: tot_icld_vistau(pcols,pver) ! in-cld water+ice cloud optical depth (only during day, night = fillvalue) + real(r8) :: liq_icld_vistau(pcols,pver) ! in-cld liq cloud optical depth (only during day, night = fillvalue) + real(r8) :: ice_icld_vistau(pcols,pver) ! in-cld ice cloud optical depth (only during day, night = fillvalue) + real(r8) :: snow_icld_vistau(pcols,pver) ! snow in-cloud visible sw optical depth for output on history files + real(r8) :: grau_icld_vistau(pcols,pver) ! Graupel in-cloud visible sw optical depth for output on history files +end type rad_out_t + +! Control variables set via namelist +character(len=cl) :: coefs_lw_file ! filepath for lw coefficients +character(len=cl) :: coefs_sw_file ! filepath for sw coefficients + +integer :: iradsw = -1 ! freq. of shortwave radiation calc in time steps (positive) + ! or hours (negative). +integer :: iradlw = -1 ! frequency of longwave rad. calc. in time steps (positive) + ! or hours (negative). + +integer :: irad_always = 0 ! Specifies length of time in timesteps (positive) + ! or hours (negative) SW/LW radiation will be + ! run continuously from the start of an + ! initial or restart run +logical :: use_rad_dt_cosz = .false. ! if true, use radiation dt for all cosz calculations +logical :: spectralflux = .false. ! calculate fluxes (up and down) per band. +logical :: graupel_in_rad = .false. ! graupel in radiation code +logical :: use_rad_uniform_angle = .false. ! if true, use the namelist rad_uniform_angle for the coszrs calculation + +! active_calls is set by a rad_constituents method after parsing namelist input +! for the rad_climate and rad_diag_N entries. +logical :: active_calls(0:N_DIAG) + +! Physics buffer indices +integer :: qrs_idx = 0 +integer :: qrl_idx = 0 +integer :: su_idx = 0 +integer :: sd_idx = 0 +integer :: lu_idx = 0 +integer :: ld_idx = 0 +integer :: fsds_idx = 0 +integer :: fsns_idx = 0 +integer :: fsnt_idx = 0 +integer :: flns_idx = 0 +integer :: flnt_idx = 0 +integer :: cld_idx = 0 +integer :: cldfsnow_idx = 0 +integer :: cldfgrau_idx = 0 + +character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ',& + '_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) + +! averaging time interval for zenith angle +real(r8) :: dt_avg = 0._r8 +real(r8) :: rad_uniform_angle = -99._r8 + +! Number of layers in radiation calculations. +integer :: nlay + +! Number of CAM layers in radiation calculations. Is either equal to nlay, or is +! 1 less than nlay if "extra layer" is used in the radiation calculations. +integer :: nlaycam + +! Indices for copying data between CAM/WACCM and RRTMGP arrays. Since RRTMGP is +! vertical order agnostic we can send data using the top to bottom order used +! in CAM/WACCM. But the number of layers that RRTMGP does computations for +! may not match the number of layers in CAM/WACCM for two reasons: +! 1. If the CAM model top is below 1 Pa, then RRTMGP does calculations for an +! extra layer that is added between 1 Pa and the model top. +! 2. If the WACCM model top is above 1 Pa, then RRMTGP only does calculations +! for those model layers that are below 1 Pa. +integer :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which + ! RRTMGP is active. +integer :: ktoprad ! Index in RRTMGP arrays of the layer or interface corresponding + ! to CAM's top layer or interface. + ! Note: for CAM's top to bottom indexing, the index of a given layer + ! (midpoint) and the upper interface of that layer, are the same. + +! Gas optics objects contain the data read from the coefficients files. +type(ty_gas_optics_rrtmgp) :: kdist_sw +type(ty_gas_optics_rrtmgp) :: kdist_lw + +! lower case version of gaslist for RRTMGP +character(len=gasnamelength) :: gaslist_lc(nradgas) + +type(var_desc_t) :: cospcnt_desc ! cosp +type(var_desc_t) :: nextsw_cday_desc + +!========================================================================================= +contains +!========================================================================================= + +subroutine radiation_readnl(nlfile) + + ! Read radiation_nl namelist group. + + use namelist_utils, only: find_group_name + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_logical, & + mpi_character, mpi_real8 + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + integer :: dtime ! timestep size + character(len=32) :: errmsg + character(len=*), parameter :: sub = 'radiation_readnl' + + character(len=cl) :: rrtmgp_coefs_lw_file, rrtmgp_coefs_sw_file + + namelist /radiation_nl/ & + rrtmgp_coefs_lw_file, rrtmgp_coefs_sw_file, iradsw, iradlw, & + irad_always, use_rad_dt_cosz, spectralflux, use_rad_uniform_angle, & + rad_uniform_angle, graupel_in_rad + !----------------------------------------------------------------------------- + + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'radiation_nl', status=ierr) + if (ierr == 0) then + read(unitn, radiation_nl, iostat=ierr) + if (ierr /= 0) then + write(errmsg,'(a,i5)') 'iostat =', ierr + call endrun(sub//': ERROR reading namelist: '//trim(errmsg)) + end if + end if + close(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(rrtmgp_coefs_lw_file, cl, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: rrtmgp_coefs_lw_file") + call mpi_bcast(rrtmgp_coefs_sw_file, cl, mpi_character, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: rrtmgp_coefs_sw_file") + call mpi_bcast(iradsw, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: iradsw") + call mpi_bcast(iradlw, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: iradlw") + call mpi_bcast(irad_always, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: irad_always") + call mpi_bcast(use_rad_dt_cosz, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: use_rad_dt_cosz") + call mpi_bcast(spectralflux, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: spectralflux") + call mpi_bcast(use_rad_uniform_angle, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: use_rad_uniform_angle") + call mpi_bcast(rad_uniform_angle, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: rad_uniform_angle") + call mpi_bcast(graupel_in_rad, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: graupel_in_rad") + + if (use_rad_uniform_angle .and. rad_uniform_angle == -99._r8) then + call endrun(sub//': ERROR - use_rad_uniform_angle is set to .true,' & + //' but rad_uniform_angle is not set ') + end if + + ! Set module data + coefs_lw_file = rrtmgp_coefs_lw_file + coefs_sw_file = rrtmgp_coefs_sw_file + + ! Convert iradsw, iradlw and irad_always from hours to timesteps if necessary + dtime = get_step_size() + if (iradsw < 0) iradsw = nint((-iradsw *3600._r8)/dtime) + if (iradlw < 0) iradlw = nint((-iradlw *3600._r8)/dtime) + if (irad_always < 0) irad_always = nint((-irad_always*3600._r8)/dtime) + + !----------------------------------------------------------------------- + ! Print runtime options to log. + !----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'RRTMGP radiation scheme parameters:' + write(iulog,10) trim(coefs_lw_file), trim(coefs_sw_file), nlwbands, nswbands, & + iradsw, iradlw, irad_always, use_rad_dt_cosz, spectralflux, graupel_in_rad + end if + +10 format(' LW coefficents file: ', a/, & + ' SW coefficents file: ', a/, & + ' Number of LW bands: ',i5/, & + ' Number of SW bands: ',i5/, & + ' Frequency (timesteps) of Shortwave Radiation calc: ',i5/, & + ' Frequency (timesteps) of Longwave Radiation calc: ',i5/, & + ' SW/LW calc done every timestep for first N steps. N=',i5/, & + ' Use average zenith angle: ',l5/, & + ' Output spectrally resolved fluxes: ',l5/, & + ' Graupel in Radiation Code: ',l5/) + +end subroutine radiation_readnl + +!================================================================================================ + +subroutine radiation_register + + ! Register radiation fields in the physics buffer + + call pbuf_add_field('QRS' , 'global',dtype_r8,(/pcols,pver/), qrs_idx) ! shortwave radiative heating rate + call pbuf_add_field('QRL' , 'global',dtype_r8,(/pcols,pver/), qrl_idx) ! longwave radiative heating rate + + call pbuf_add_field('FSDS' , 'global',dtype_r8,(/pcols/), fsds_idx) ! Surface solar downward flux + call pbuf_add_field('FSNS' , 'global',dtype_r8,(/pcols/), fsns_idx) ! Surface net shortwave flux + call pbuf_add_field('FSNT' , 'global',dtype_r8,(/pcols/), fsnt_idx) ! Top-of-model net shortwave flux + + call pbuf_add_field('FLNS' , 'global',dtype_r8,(/pcols/), flns_idx) ! Surface net longwave flux + call pbuf_add_field('FLNT' , 'global',dtype_r8,(/pcols/), flnt_idx) ! Top-of-model net longwave flux + + ! If the namelist has been configured for preserving the spectral fluxes, then create + ! physics buffer variables to store the results. This data is accessed by CARMA. + if (spectralflux) then + call pbuf_add_field('SU' , 'global',dtype_r8,(/pcols,pverp,nswbands/), su_idx) ! shortwave upward flux (per band) + call pbuf_add_field('SD' , 'global',dtype_r8,(/pcols,pverp,nswbands/), sd_idx) ! shortwave downward flux (per band) + call pbuf_add_field('LU' , 'global',dtype_r8,(/pcols,pverp,nlwbands/), lu_idx) ! longwave upward flux (per band) + call pbuf_add_field('LD' , 'global',dtype_r8,(/pcols,pverp,nlwbands/), ld_idx) ! longwave downward flux (per band) + end if + + ! Register fields for offline radiation driver. + call rad_data_register() + +end subroutine radiation_register + +!================================================================================================ + +function radiation_do(op, timestep) + + ! Return true if the specified operation is done this timestep. + + character(len=*), intent(in) :: op ! name of operation + integer, intent(in), optional:: timestep + logical :: radiation_do ! return value + + ! Local variables + integer :: nstep ! current timestep number + !----------------------------------------------------------------------- + + if (present(timestep)) then + nstep = timestep + else + nstep = get_nstep() + end if + + select case (op) + case ('sw') ! do a shortwave heating calc this timestep? + radiation_do = nstep == 0 .or. iradsw == 1 & + .or. (mod(nstep-1,iradsw) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + case ('lw') ! do a longwave heating calc this timestep? + radiation_do = nstep == 0 .or. iradlw == 1 & + .or. (mod(nstep-1,iradlw) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + case default + call endrun('radiation_do: unknown operation:'//op) + end select + +end function radiation_do + +!================================================================================================ + +real(r8) function radiation_nextsw_cday() + + ! If a SW radiation calculation will be done on the next time-step, then return + ! the calendar day of that time-step. Otherwise return -1.0 + + ! Local variables + integer :: nstep ! timestep counter + logical :: dosw ! true => do shosrtwave calc + integer :: offset ! offset for calendar day calculation + integer :: dtime ! integer timestep size + real(r8):: caldayp1 ! calendar day of next time-step + + !----------------------------------------------------------------------- + + radiation_nextsw_cday = -1._r8 + dosw = .false. + nstep = get_nstep() + dtime = get_step_size() + offset = 0 + do while (.not. dosw) + nstep = nstep + 1 + offset = offset + dtime + if (radiation_do('sw', nstep)) then + radiation_nextsw_cday = get_curr_calday(offset=offset) + dosw = .true. + end if + end do + if(radiation_nextsw_cday == -1._r8) then + call endrun('error in radiation_nextsw_cday') + end if + + ! determine if next radiation time-step not equal to next time-step + if (get_nstep() >= 1) then + caldayp1 = get_curr_calday(offset=int(dtime)) + if (caldayp1 /= radiation_nextsw_cday) radiation_nextsw_cday = -1._r8 + end if + +end function radiation_nextsw_cday + +!================================================================================================ + +subroutine radiation_init(pbuf2d) + + ! Initialize the radiation and cloud optics. + ! Add fields to the history buffer. + + ! arguments + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + ! local variables + character(len=128) :: errmsg + + ! names of gases that are available in the model + ! -- needed for the kdist initialization routines + type(ty_gas_concs) :: available_gases + + integer :: i, icall + integer :: nstep ! current timestep number + logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: history_vdiag ! output the variables used by the AMWG variability diag package + logical :: history_budget ! output tendencies and state variables for CAM4 + ! temperature, water vapor, cloud ice and cloud + ! liquid budgets. + integer :: history_budget_histfile_num ! history file number for budget fields + integer :: ierr, istat + + integer :: dtime + + character(len=*), parameter :: sub = 'radiation_init' + !----------------------------------------------------------------------- + + ! Number of layers in radiation calculation is capped by the number of + ! 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 + ! Top model interface is below 1 Pa. RRTMGP is active in all model layers plus + ! 1 extra layer between model top and 1 Pa. + 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. + ktopcam = pver - nlay + 1 + 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. + do i = 1, nradgas + gaslist_lc(i) = to_lower(gaslist(i)) + end do + + errmsg = available_gases%init(gaslist_lc) + call stop_on_err(errmsg, sub, 'available_gases%init') + + ! Read RRTMGP coefficients files and initialize kdist objects. + call coefs_init(coefs_sw_file, available_gases, kdist_sw) + call coefs_init(coefs_lw_file, available_gases, kdist_lw) + + ! Set the sw/lw band boundaries in radconstants. Also sets + ! indicies of specific bands for diagnostic output and COSP input. + call set_wavenumber_bands(kdist_sw, kdist_lw) + call rad_solar_var_init() + + ! The spectral band boundaries need to be set before this init is called. + call rrtmgp_inputs_init(ktopcam, ktoprad) + + ! initialize output fields for offline driver + call rad_data_init(pbuf2d) + + call cloud_rad_props_init() + + cld_idx = pbuf_get_index('CLD') + cldfsnow_idx = pbuf_get_index('CLDFSNOW', errcode=ierr) + cldfgrau_idx = pbuf_get_index('CLDFGRAU', errcode=ierr) + + if (is_first_step()) then + call pbuf_set_field(pbuf2d, qrl_idx, 0._r8) + end if + + ! Set the radiation timestep for cosz calculations if requested using + ! the adjusted iradsw value from radiation + if (use_rad_dt_cosz) then + dtime = get_step_size() + dt_avg = iradsw*dtime + end if + + ! Surface components to get radiation computed today + if (.not. is_first_restart_step()) then + nextsw_cday = get_curr_calday() + end if + + call phys_getopts(history_amwg_out = history_amwg, & + history_vdiag_out = history_vdiag, & + history_budget_out = history_budget, & + history_budget_histfile_num_out = history_budget_histfile_num) + + ! "irad_always" is number of time steps to execute radiation continuously from + ! start of initial OR restart run + nstep = get_nstep() + if (irad_always > 0) then + irad_always = irad_always + nstep + end if + + if (docosp) call cospsimulator_intr_init() + + allocate(cosp_cnt(begchunk:endchunk), stat=istat) + call handle_allocate_error(istat, sub, 'cosp_cnt') + if (is_first_restart_step()) then + cosp_cnt(begchunk:endchunk) = cosp_cnt_init + else + cosp_cnt(begchunk:endchunk) = 0 + end if + + ! Add fields to history buffer + + call addfld('TOT_CLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Total gbx cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + call addfld('TOT_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Total in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + call addfld('LIQ_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Liquid in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + call addfld('ICE_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Ice in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + + if (cldfsnow_idx > 0) then + call addfld('SNOW_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Snow in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + end if + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + call addfld('GRAU_ICLD_VISTAU', (/ 'lev' /), 'A', '1', & + 'Graupel in-cloud extinction visible sw optical depth', & + sampling_seq='rad_lwsw', flag_xyfill=.true.) + endif + + ! get list of active radiation calls + call rad_cnst_get_call_list(active_calls) + + ! Add shortwave radiation fields to history master field list. + + do icall = 0, N_DIAG + + if (active_calls(icall)) then + + call addfld('SOLIN'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Solar insolation', sampling_seq='rad_lwsw') + call addfld('QRS'//diag(icall), (/ 'lev' /), 'A', 'K/s', & + 'Solar heating rate', sampling_seq='rad_lwsw') + call addfld('QRSC'//diag(icall), (/ 'lev' /), 'A', 'K/s', & + 'Clearsky solar heating rate', sampling_seq='rad_lwsw') + call addfld('FSNT'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net solar flux at top of model', sampling_seq='rad_lwsw') + call addfld('FSNTC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net solar flux at top of model', sampling_seq='rad_lwsw') + call addfld('FSNTOA'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net solar flux at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('FSNTOAC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net solar flux at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('SWCF'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Shortwave cloud forcing', sampling_seq='rad_lwsw') + call addfld('FSUTOA'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Upwelling solar flux at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('FSNIRTOA'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('FSNRTOAC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('FSNRTOAS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net near-infrared flux (>= 0.7 microns) at top of atmosphere', sampling_seq='rad_lwsw') + call addfld('FSN200'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net shortwave flux at 200 mb', sampling_seq='rad_lwsw') + call addfld('FSN200C'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net shortwave flux at 200 mb', sampling_seq='rad_lwsw') + call addfld('FSNR'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net solar flux at tropopause', sampling_seq='rad_lwsw') + call addfld('SOLL'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Solar downward near infrared direct to surface', sampling_seq='rad_lwsw') + call addfld('SOLS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Solar downward visible direct to surface', sampling_seq='rad_lwsw') + call addfld('SOLLD'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Solar downward near infrared diffuse to surface', sampling_seq='rad_lwsw') + call addfld('SOLSD'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Solar downward visible diffuse to surface', sampling_seq='rad_lwsw') + call addfld('FSNS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net solar flux at surface', sampling_seq='rad_lwsw') + call addfld('FSNSC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net solar flux at surface', sampling_seq='rad_lwsw') + call addfld('FSDS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Downwelling solar flux at surface', sampling_seq='rad_lwsw') + call addfld('FSDSC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky downwelling solar flux at surface', sampling_seq='rad_lwsw') + + ! Fluxes on CAM grid + call addfld('FUS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Shortwave upward flux', sampling_seq='rad_lwsw') + call addfld('FDS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Shortwave downward flux', sampling_seq='rad_lwsw') + call addfld('FUSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Shortwave clear-sky upward flux', sampling_seq='rad_lwsw') + call addfld('FDSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Shortwave clear-sky downward flux', sampling_seq='rad_lwsw') + + if (history_amwg) then + call add_default('SOLIN'//diag(icall), 1, ' ') + call add_default('QRS'//diag(icall), 1, ' ') + call add_default('FSNT'//diag(icall), 1, ' ') + call add_default('FSNTC'//diag(icall), 1, ' ') + call add_default('FSNTOA'//diag(icall), 1, ' ') + call add_default('FSNTOAC'//diag(icall), 1, ' ') + call add_default('SWCF'//diag(icall), 1, ' ') + call add_default('FSNS'//diag(icall), 1, ' ') + call add_default('FSNSC'//diag(icall), 1, ' ') + call add_default('FSUTOA'//diag(icall), 1, ' ') + call add_default('FSDSC'//diag(icall), 1, ' ') + call add_default('FSDS'//diag(icall), 1, ' ') + endif + + end if + end do + + if (scm_crm_mode) then + call add_default('FUS ', 1, ' ') + call add_default('FUSC ', 1, ' ') + call add_default('FDS ', 1, ' ') + call add_default('FDSC ', 1, ' ') + endif + + ! Add longwave radiation fields to history master field list. + + do icall = 0, N_DIAG + + if (active_calls(icall)) then + call addfld('QRL'//diag(icall), (/ 'lev' /), 'A', 'K/s', & + 'Longwave heating rate', sampling_seq='rad_lwsw') + call addfld('QRLC'//diag(icall), (/ 'lev' /), 'A', 'K/s', & + 'Clearsky longwave heating rate', sampling_seq='rad_lwsw') + call addfld('FLNT'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net longwave flux at top of model', sampling_seq='rad_lwsw') + call addfld('FLNTC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net longwave flux at top of model', sampling_seq='rad_lwsw') + call addfld('FLUT'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Upwelling longwave flux at top of model', sampling_seq='rad_lwsw') + call addfld('FLUTC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky upwelling longwave flux at top of model', sampling_seq='rad_lwsw') + call addfld('LWCF'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Longwave cloud forcing', sampling_seq='rad_lwsw') + call addfld('FLN200'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net longwave flux at 200 mb', sampling_seq='rad_lwsw') + call addfld('FLN200C'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net longwave flux at 200 mb', sampling_seq='rad_lwsw') + call addfld('FLNR'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net longwave flux at tropopause', sampling_seq='rad_lwsw') + call addfld('FLNS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Net longwave flux at surface', sampling_seq='rad_lwsw') + call addfld('FLNSC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky net longwave flux at surface', sampling_seq='rad_lwsw') + call addfld('FLDS'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Downwelling longwave flux at surface', sampling_seq='rad_lwsw') + call addfld('FLDSC'//diag(icall), horiz_only, 'A', 'W/m2', & + 'Clearsky Downwelling longwave flux at surface', sampling_seq='rad_lwsw') + + ! Fluxes on CAM grid + call addfld('FUL'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Longwave upward flux', sampling_seq='rad_lwsw') + call addfld('FDL'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Longwave downward flux', sampling_seq='rad_lwsw') + call addfld('FULC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Longwave clear-sky upward flux', sampling_seq='rad_lwsw') + call addfld('FDLC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', & + 'Longwave clear-sky downward flux', sampling_seq='rad_lwsw') + + if (history_amwg) then + call add_default('QRL'//diag(icall), 1, ' ') + call add_default('FLNT'//diag(icall), 1, ' ') + call add_default('FLNTC'//diag(icall), 1, ' ') + call add_default('FLUT'//diag(icall), 1, ' ') + call add_default('FLUTC'//diag(icall), 1, ' ') + call add_default('LWCF'//diag(icall), 1, ' ') + call add_default('FLNS'//diag(icall), 1, ' ') + call add_default('FLNSC'//diag(icall), 1, ' ') + call add_default('FLDS'//diag(icall), 1, ' ') + end if + + end if + end do + + call addfld('EMIS', (/ 'lev' /), 'A', '1', 'Cloud longwave emissivity') + + if (scm_crm_mode) then + call add_default ('FUL ', 1, ' ') + call add_default ('FULC ', 1, ' ') + call add_default ('FDL ', 1, ' ') + call add_default ('FDLC ', 1, ' ') + endif + + ! Heating rate needed for d(theta)/dt computation + call addfld ('HR',(/ 'lev' /), 'A','K/s','Heating rate needed for d(theta)/dt computation') + + if ( history_budget .and. history_budget_histfile_num > 1 ) then + call add_default ('QRL ', history_budget_histfile_num, ' ') + call add_default ('QRS ', history_budget_histfile_num, ' ') + end if + + if (history_vdiag) then + call add_default('FLUT', 2, ' ') + call add_default('FLUT', 3, ' ') + end if + +end subroutine radiation_init + +!=============================================================================== + +subroutine radiation_define_restart(file) + + ! define variables to be written to restart file + + ! arguments + type(file_desc_t), intent(inout) :: file + + ! local variables + integer :: ierr + !---------------------------------------------------------------------------- + + call pio_seterrorhandling(file, PIO_BCAST_ERROR) + + ierr = pio_def_var(file, 'nextsw_cday', pio_double, nextsw_cday_desc) + ierr = pio_put_att(file, nextsw_cday_desc, 'long_name', 'future radiation calday for surface models') + if (docosp) then + ierr = pio_def_var(File, 'cosp_cnt_init', pio_int, cospcnt_desc) + end if + +end subroutine radiation_define_restart + +!=============================================================================== + +subroutine radiation_write_restart(file) + + ! write variables to restart file + + ! arguments + type(file_desc_t), intent(inout) :: file + + ! local variables + integer :: ierr + !---------------------------------------------------------------------------- + ierr = pio_put_var(File, nextsw_cday_desc, (/ nextsw_cday /)) + if (docosp) then + ierr = pio_put_var(File, cospcnt_desc, (/cosp_cnt(begchunk)/)) + end if + +end subroutine radiation_write_restart + +!=============================================================================== + +subroutine radiation_read_restart(file) + + ! read variables from restart file + + ! arguments + type(file_desc_t), intent(inout) :: file + + ! local variables + integer :: ierr + type(var_desc_t) :: vardesc + integer :: err_handling + + !---------------------------------------------------------------------------- + if (docosp) then + call pio_seterrorhandling(File, PIO_BCAST_ERROR, err_handling) + ierr = pio_inq_varid(File, 'cosp_cnt_init', vardesc) + call pio_seterrorhandling(File, err_handling) + if (ierr /= PIO_NOERR) then + cosp_cnt_init = 0 + else + ierr = pio_get_var(File, vardesc, cosp_cnt_init) + end if + end if + + ierr = pio_inq_varid(file, 'nextsw_cday', vardesc) + ierr = pio_get_var(file, vardesc, nextsw_cday) + + +end subroutine radiation_read_restart + +!=============================================================================== + +subroutine radiation_tend( & + state, ptend, pbuf, cam_out, cam_in, net_flx, rd_out) + + !----------------------------------------------------------------------- + ! + ! CAM driver for radiation computation. + ! + !----------------------------------------------------------------------- + + ! Location/Orbital Parameters for cosine zenith angle + use phys_grid, only: get_rlat_all_p, get_rlon_all_p + use cam_control_mod, only: eccen, mvelpp, lambm0, obliqr + use shr_orb_mod, only: shr_orb_decl, shr_orb_cosz + + use rrtmgp_inputs, only: rrtmgp_set_state, rrtmgp_set_gases_lw, rrtmgp_set_cloud_lw, & + rrtmgp_set_aer_lw, rrtmgp_set_gases_sw, rrtmgp_set_cloud_sw, & + rrtmgp_set_aer_sw + + ! RRTMGP drivers for flux calculations. + use mo_rte_lw, only: rte_lw + use mo_rte_sw, only: rte_sw + + use radheat, only: radheat_tend + + use radiation_data, only: rad_data_write + + use interpolate_data, only: vertinterp + use tropopause, only: tropopause_find_cam, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE + use cospsimulator_intr, only: docosp, cospsimulator_intr_run, cosp_nradsteps + + + ! Arguments + type(physics_state), intent(in), target :: state + type(physics_ptend), intent(out) :: ptend + type(physics_buffer_desc), pointer :: pbuf(:) + type(cam_out_t), intent(inout) :: cam_out + type(cam_in_t), intent(in) :: cam_in + real(r8), intent(out) :: net_flx(pcols) + + type(rad_out_t), target, optional, intent(out) :: rd_out + + + ! Local variables + type(rad_out_t), pointer :: rd ! allow rd_out to be optional by allocating a local object + ! if the argument is not present + logical :: write_output + + integer :: i, k, istat + integer :: lchnk, ncol + logical :: dosw, dolw + integer :: icall ! loop index for climate/diagnostic radiation calls + + real(r8) :: calday ! current calendar day + real(r8) :: delta ! Solar declination angle in radians + real(r8) :: eccf ! Earth orbit eccentricity factor + real(r8) :: clat(pcols) ! current latitudes(radians) + real(r8) :: clon(pcols) ! current longitudes(radians) + real(r8) :: coszrs(pcols) ! Cosine solar zenith angle + + ! Gathered indices of day and night columns + ! chunk_column_index = IdxDay(daylight_column_index) + integer :: Nday ! Number of daylight columns + integer :: Nnite ! Number of night columns + integer :: IdxDay(pcols) ! chunk indices of daylight columns + integer :: IdxNite(pcols) ! chunk indices of night columns + + integer :: itim_old + + real(r8), pointer :: cld(:,:) ! cloud fraction + real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds" + real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds" + real(r8) :: cldfprime(pcols,pver) ! combined cloud fraction + real(r8), pointer :: qrs(:,:) ! shortwave radiative heating rate + real(r8), pointer :: qrl(:,:) ! longwave radiative heating rate + real(r8), pointer :: fsds(:) ! Surface solar down flux + real(r8), pointer :: fsns(:) ! Surface solar absorbed flux + real(r8), pointer :: fsnt(:) ! Net column abs solar flux at model top + real(r8), pointer :: flns(:) ! Srf longwave cooling (up-down) flux + real(r8), pointer :: flnt(:) ! Net outgoing lw flux at model top + + real(r8), pointer, dimension(:,:,:) :: su => NULL() ! shortwave spectral flux up + real(r8), pointer, dimension(:,:,:) :: sd => NULL() ! shortwave spectral flux down + real(r8), pointer, dimension(:,:,:) :: lu => NULL() ! longwave spectral flux up + real(r8), pointer, dimension(:,:,:) :: ld => NULL() ! longwave spectral flux down + + ! tropopause diagnostic + integer :: troplev(pcols) + real(r8) :: p_trop(pcols) + + ! state data passed to radiation calc + real(r8), allocatable :: t_sfc(:) + real(r8), allocatable :: emis_sfc(:,:) + real(r8), allocatable :: t_rad(:,:) + real(r8), allocatable :: pmid_rad(:,:) + real(r8), allocatable :: pint_rad(:,:) + real(r8), allocatable :: t_day(:,:) + real(r8), allocatable :: pmid_day(:,:) + real(r8), allocatable :: pint_day(:,:) + real(r8), allocatable :: coszrs_day(:) + real(r8), allocatable :: alb_dir(:,:) + real(r8), allocatable :: alb_dif(:,:) + + ! in-cloud optical depths for COSP + real(r8) :: cld_tau_cloudsim(pcols,pver) ! liq + ice + real(r8) :: snow_tau_cloudsim(pcols,pver) ! snow + real(r8) :: grau_tau_cloudsim(pcols,pver) ! graupel + real(r8) :: cld_lw_abs_cloudsim(pcols,pver) ! liq + ice + real(r8) :: snow_lw_abs_cloudsim(pcols,pver)! snow + real(r8) :: grau_lw_abs_cloudsim(pcols,pver)! graupel + + ! Set vertical indexing in RRTMGP to be the same as CAM (top to bottom). + logical, parameter :: top_at_1 = .true. + + ! TOA solar flux on RRTMGP g-points + real(r8), allocatable :: toa_flux(:,:) + ! Scale factors based on spectral distribution from input irradiance dataset + real(r8), allocatable :: sfac(:,:) + + ! Planck sources for LW. + type(ty_source_func_lw) :: sources_lw + + ! Gas volume mixing ratios. Use separate objects for LW and SW because SW only does + ! calculations for daylight columns. + ! These objects have a final method which deallocates the internal memory when they + ! go out of scope (i.e., when radiation_tend returns), so no need for explicit deallocation. + type(ty_gas_concs) :: gas_concs_lw + type(ty_gas_concs) :: gas_concs_sw + + ! Atmosphere optics. This object is initialized with gas optics, then is incremented + ! by the aerosol optics for the clear-sky radiative flux calculations, and then + ! incremented again by the cloud optics for the all-sky radiative flux calculations. + type(ty_optical_props_1scl) :: atm_optics_lw + type(ty_optical_props_2str) :: atm_optics_sw + + ! Cloud optical properties objects (McICA sampling of cloud optical properties). + type(ty_optical_props_1scl) :: cloud_lw + type(ty_optical_props_2str) :: cloud_sw + + ! Aerosol optical properties objects. + type(ty_optical_props_1scl) :: aer_lw + type(ty_optical_props_2str) :: aer_sw + + ! Flux objects contain all fluxes computed by RRTMGP. + ! SW allsky fluxes always include spectrally resolved fluxes needed for surface models. + type(ty_fluxes_byband) :: fsw + ! LW allsky fluxes only need spectrally resolved fluxes when spectralflux=.true. + type(ty_fluxes_byband) :: flw + ! Only broadband fluxes needed for clear sky (diagnostics). + type(ty_fluxes_broadband) :: fswc, flwc + + ! Arrays for output diagnostics on CAM grid. + real(r8) :: fns(pcols,pverp) ! net shortwave flux + real(r8) :: fcns(pcols,pverp) ! net clear-sky shortwave flux + real(r8) :: fnl(pcols,pverp) ! net longwave flux + real(r8) :: fcnl(pcols,pverp) ! net clear-sky longwave flux + + ! for COSP + real(r8) :: emis(pcols,pver) ! Cloud longwave emissivity + real(r8) :: gb_snow_tau(pcols,pver) ! grid-box mean snow_tau + real(r8) :: gb_snow_lw(pcols,pver) ! grid-box mean LW snow optical depth + + real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables + + character(len=128) :: errmsg + character(len=*), parameter :: sub = 'radiation_tend' + !-------------------------------------------------------------------------------------- + + lchnk = state%lchnk + ncol = state%ncol + + if (present(rd_out)) then + rd => rd_out + write_output = .false. + else + allocate(rd, stat=istat) + call handle_allocate_error(istat, sub, 'rd') + write_output = .true. + end if + + dosw = radiation_do('sw', get_nstep()) ! do shortwave radiation calc this timestep? + dolw = radiation_do('lw', get_nstep()) ! do longwave radiation calc this timestep? + + ! Cosine solar zenith angle for current time step + calday = get_curr_calday() + call get_rlat_all_p(lchnk, ncol, clat) + call get_rlon_all_p(lchnk, ncol, clon) + + call shr_orb_decl(calday, eccen, mvelpp, lambm0, obliqr, & + delta, eccf) + + if (use_rad_uniform_angle) then + do i = 1, ncol + coszrs(i) = shr_orb_cosz(calday, clat(i), clon(i), delta, dt_avg, & + uniform_angle=rad_uniform_angle) + end do + else + do i = 1, ncol + ! if dt_avg /= 0, it triggers using avg coszrs + coszrs(i) = shr_orb_cosz(calday, clat(i), clon(i), delta, dt_avg) + end do + end if + + ! Gather night/day column indices. + Nday = 0 + Nnite = 0 + do i = 1, ncol + if ( coszrs(i) > 0.0_r8 ) then + Nday = Nday + 1 + IdxDay(Nday) = i + else + Nnite = Nnite + 1 + IdxNite(Nnite) = i + end if + end do + + ! Associate pointers to physics buffer fields + itim_old = pbuf_old_tim_idx() + nullify(cldfsnow) + if (cldfsnow_idx > 0) then + call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + end if + nullify(cldfgrau) + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + call pbuf_get_field(pbuf, cldfgrau_idx, cldfgrau, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + endif + + call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + + call pbuf_get_field(pbuf, qrs_idx, qrs) + call pbuf_get_field(pbuf, qrl_idx, qrl) + + call pbuf_get_field(pbuf, fsns_idx, fsns) + call pbuf_get_field(pbuf, fsnt_idx, fsnt) + call pbuf_get_field(pbuf, fsds_idx, fsds) + call pbuf_get_field(pbuf, flns_idx, flns) + call pbuf_get_field(pbuf, flnt_idx, flnt) + + if (spectralflux) then + call pbuf_get_field(pbuf, su_idx, su) + call pbuf_get_field(pbuf, sd_idx, sd) + call pbuf_get_field(pbuf, lu_idx, lu) + call pbuf_get_field(pbuf, ld_idx, ld) + end if + + ! Allocate the flux arrays and init to zero. + call initialize_rrtmgp_fluxes(nday, nlay+1, nswbands, fsw, do_direct=.true.) + call initialize_rrtmgp_fluxes(nday, nlay+1, nswbands, fswc, do_direct=.true.) + call initialize_rrtmgp_fluxes(ncol, nlay+1, nlwbands, flw) + call initialize_rrtmgp_fluxes(ncol, nlay+1, nlwbands, flwc) + + ! For CRM, make cloud equal to input observations: + if (scm_crm_mode .and. have_cld) then + do k = 1, pver + cld(:ncol,k)= cldobs(k) + end do + end if + + ! Find tropopause height if needed for diagnostic output + if (hist_fld_active('FSNR') .or. hist_fld_active('FLNR')) then + !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists + troplev(:) = 0 + p_trop(:) = 0._r8 + !REMOVECAM_END + call tropopause_find_cam(state, troplev, tropP=p_trop, primary=TROP_ALG_HYBSTOB, & + backup=TROP_ALG_CLIMATE) + end if + + ! Get time of next radiation calculation - albedos will need to be + ! calculated by each surface model at this time + nextsw_cday = radiation_nextsw_cday() + + if (dosw .or. dolw) then + + allocate( & + t_sfc(ncol), emis_sfc(nlwbands,ncol), toa_flux(nday,nswgpts), & + sfac(nday,nswgpts), & + t_rad(ncol,nlay), pmid_rad(ncol,nlay), pint_rad(ncol,nlay+1), & + t_day(nday,nlay), pmid_day(nday,nlay), pint_day(nday,nlay+1), & + coszrs_day(nday), alb_dir(nswbands,nday), alb_dif(nswbands,nday), & + stat=istat) + call handle_allocate_error(istat, sub, 't_sfc,..,alb_dif') + + ! Prepares state variables, daylit columns, albedos for RRTMGP + call rrtmgp_set_state( & + state, cam_in, ncol, nlay, nday, & + idxday, coszrs, kdist_sw, t_sfc, emis_sfc, & + t_rad, pmid_rad, pint_rad, t_day, pmid_day, & + pint_day, coszrs_day, alb_dir, alb_dif) + + ! Output the mass per layer, and total column burdens for gas and aerosol + ! constituents in the climate list. + call rad_cnst_out(0, state, pbuf) + + ! Modified cloud fraction accounts for radiatively active snow and/or graupel + call modified_cloud_fraction(ncol, cld, cldfsnow, cldfgrau, cldfprime) + + !========================! + ! SHORTWAVE calculations ! + !========================! + + if (dosw) then + + ! Set cloud optical properties in cloud_sw object. + call rrtmgp_set_cloud_sw( & + state, pbuf, nlay, nday, idxday, & + nnite, idxnite, pmid_day, cld, cldfsnow, & + cldfgrau, cldfprime, graupel_in_rad, kdist_sw, cloud_sw, & + rd%tot_cld_vistau, rd%tot_icld_vistau, rd%liq_icld_vistau, & + rd%ice_icld_vistau, rd%snow_icld_vistau, rd%grau_icld_vistau, & + cld_tau_cloudsim, snow_tau_cloudsim, grau_tau_cloudsim ) + + if (write_output) then + call radiation_output_cld(lchnk, rd) + end if + + ! If no daylight columns, can't create empty RRTMGP objects + if (nday > 0) then + + ! Initialize object for gas concentrations. + errmsg = gas_concs_sw%init(gaslist_lc) + call stop_on_err(errmsg, sub, 'gas_concs_sw%init') + + ! Initialize object for combined gas + aerosol + cloud optics. + ! Allocates arrays for properties represented on g-points. + errmsg = atm_optics_sw%alloc_2str(nday, nlay, kdist_sw) + call stop_on_err(errmsg, sub, 'atm_optics_sw%alloc_2str') + + ! Initialize object for SW aerosol optics. Allocates arrays + ! for properties represented by band. + errmsg = aer_sw%alloc_2str(nday, nlay, kdist_sw%get_band_lims_wavenumber()) + call stop_on_err(errmsg, sub, 'aer_sw%alloc_2str') + + end if + + ! The climate (icall==0) calculation must occur last. + do icall = N_DIAG, 0, -1 + if (active_calls(icall)) then + + if (nday > 0) then + + ! Set gas volume mixing ratios for this call in gas_concs_sw. + call rrtmgp_set_gases_sw( & + icall, state, pbuf, nlay, nday, & + idxday, gas_concs_sw) + + ! Compute the gas optics (stored in atm_optics_sw). + ! toa_flux is the reference solar source from RRTMGP data. + errmsg = kdist_sw%gas_optics( & + pmid_day, pint_day, t_day, gas_concs_sw, atm_optics_sw, & + toa_flux) + call stop_on_err(errmsg, sub, 'kdist_sw%gas_optics') + + ! Scale the solar source + call get_variability(toa_flux, sfac) + toa_flux = toa_flux * sfac * eccf + + end if + + ! Set SW aerosol optical properties in the aer_sw object. + ! This call made even when no daylight columns because it does some + ! diagnostic aerosol output. + call rrtmgp_set_aer_sw( & + icall, state, pbuf, nday, idxday, nnite, idxnite, aer_sw) + + if (nday > 0) then + + ! Increment the gas optics (in atm_optics_sw) by the aerosol optics in aer_sw. + errmsg = aer_sw%increment(atm_optics_sw) + call stop_on_err(errmsg, sub, 'aer_sw%increment') + + ! Compute clear-sky fluxes. + errmsg = rte_sw(& + atm_optics_sw, top_at_1, coszrs_day, toa_flux, & + alb_dir, alb_dif, fswc) + call stop_on_err(errmsg, sub, 'clear-sky rte_sw') + + ! Increment the aerosol+gas optics (in atm_optics_sw) by the cloud optics in cloud_sw. + errmsg = cloud_sw%increment(atm_optics_sw) + call stop_on_err(errmsg, sub, 'cloud_sw%increment') + + ! Compute all-sky fluxes. + errmsg = rte_sw(& + atm_optics_sw, top_at_1, coszrs_day, toa_flux, & + alb_dir, alb_dif, fsw) + call stop_on_err(errmsg, sub, 'all-sky rte_sw') + + end if + + ! Transform RRTMGP outputs to CAM outputs and compute heating rates. + call set_sw_diags() + + if (write_output) then + call radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) + end if + + end if ! (active_calls(icall)) + end do ! loop over diagnostic calcs (icall) + + else + ! SW calc not done. pbuf carries Q*dp across timesteps. + ! Convert to Q before calling radheat_tend. + qrs(:ncol,:) = qrs(:ncol,:) / state%pdel(:ncol,:) + end if ! if (dosw) + + !=======================! + ! LONGWAVE calculations ! + !=======================! + + if (dolw) then + + ! Initialize object for Planck sources. + errmsg = sources_lw%alloc(ncol, nlay, kdist_lw) + call stop_on_err(errmsg, sub, 'sources_lw%alloc') + + ! Set cloud optical properties in cloud_lw object. + call rrtmgp_set_cloud_lw( & + state, pbuf, ncol, nlay, nlaycam, & + cld, cldfsnow, cldfgrau, cldfprime, graupel_in_rad, & + kdist_lw, cloud_lw, cld_lw_abs_cloudsim, snow_lw_abs_cloudsim, grau_lw_abs_cloudsim) + + ! Initialize object for gas concentrations + errmsg = gas_concs_lw%init(gaslist_lc) + call stop_on_err(errmsg, sub, 'gas_concs_lw%init') + + ! Initialize object for combined gas + aerosol + cloud optics. + errmsg = atm_optics_lw%alloc_1scl(ncol, nlay, kdist_lw) + call stop_on_err(errmsg, sub, 'atm_optics_lw%alloc_1scl') + + ! Initialize object for LW aerosol optics. + errmsg = aer_lw%alloc_1scl(ncol, nlay, kdist_lw%get_band_lims_wavenumber()) + call stop_on_err(errmsg, sub, 'aer_lw%alloc_1scl') + + ! The climate (icall==0) calculation must occur last. + do icall = N_DIAG, 0, -1 + + if (active_calls(icall)) then + + ! Set gas volume mixing ratios for this call in gas_concs_lw. + call rrtmgp_set_gases_lw(icall, state, pbuf, nlay, gas_concs_lw) + + ! Compute the gas optics and Planck sources. + errmsg = kdist_lw%gas_optics( & + pmid_rad, pint_rad, t_rad, t_sfc, gas_concs_lw, & + atm_optics_lw, sources_lw) + call stop_on_err(errmsg, sub, 'kdist_lw%gas_optics') + + ! Set LW aerosol optical properties in the aer_lw object. + call rrtmgp_set_aer_lw(icall, state, pbuf, aer_lw) + + ! Increment the gas optics by the aerosol optics. + errmsg = aer_lw%increment(atm_optics_lw) + call stop_on_err(errmsg, sub, 'aer_lw%increment') + + ! Compute clear-sky LW fluxes + errmsg = rte_lw(atm_optics_lw, top_at_1, sources_lw, emis_sfc, flwc) + call stop_on_err(errmsg, sub, 'clear-sky rte_lw') + + ! Increment the gas+aerosol optics by the cloud optics. + errmsg = cloud_lw%increment(atm_optics_lw) + call stop_on_err(errmsg, sub, 'cloud_lw%increment') + + ! Compute all-sky LW fluxes + errmsg = rte_lw(atm_optics_lw, top_at_1, sources_lw, emis_sfc, flw) + call stop_on_err(errmsg, sub, 'all-sky rte_lw') + + ! Transform RRTMGP outputs to CAM outputs and compute heating rates. + call set_lw_diags() + + if (write_output) then + call radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out) + end if + + end if ! (active_calls(icall)) + end do ! loop over diagnostic calcs (icall) + + else + ! LW calc not done. pbuf carries Q*dp across timesteps. + ! Convert to Q before calling radheat_tend. + qrl(:ncol,:) = qrl(:ncol,:) / state%pdel(:ncol,:) + end if ! if (dolw) + + deallocate( & + t_sfc, emis_sfc, toa_flux, sfac, t_rad, pmid_rad, pint_rad, & + t_day, pmid_day, pint_day, coszrs_day, alb_dir, alb_dif) + + !================! + ! COSP simulator ! + !================! + + if (docosp) then + + emis(:,:) = 0._r8 + emis(:ncol,:) = 1._r8 - exp(-cld_lw_abs_cloudsim(:ncol,:)) + call outfld('EMIS', emis, pcols, lchnk) + + ! compute grid-box mean SW and LW snow optical depth for use by COSP + gb_snow_tau(:,:) = 0._r8 + gb_snow_lw(:,:) = 0._r8 + if (cldfsnow_idx > 0) then + do i = 1, ncol + do k = 1, pver + if (cldfsnow(i,k) > 0._r8) then + + ! Add graupel to snow tau for cosp + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + gb_snow_tau(i,k) = snow_tau_cloudsim(i,k)*cldfsnow(i,k) + & + grau_tau_cloudsim(i,k)*cldfgrau(i,k) + gb_snow_lw(i,k) = snow_lw_abs_cloudsim(i,k)*cldfsnow(i,k) + & + grau_lw_abs_cloudsim(i,k)*cldfgrau(i,k) + else + gb_snow_tau(i,k) = snow_tau_cloudsim(i,k)*cldfsnow(i,k) + gb_snow_lw(i,k) = snow_lw_abs_cloudsim(i,k)*cldfsnow(i,k) + end if + end if + end do + end do + end if + + ! advance counter for this timestep (chunk dimension required for thread safety) + cosp_cnt(lchnk) = cosp_cnt(lchnk) + 1 + + ! if counter is the same as cosp_nradsteps, run cosp and reset counter + if (cosp_nradsteps .eq. cosp_cnt(lchnk)) then + + ! N.B.: For snow optical properties, the GRID-BOX MEAN shortwave and longwave + ! optical depths are passed. + call cospsimulator_intr_run( & + state, pbuf, cam_in, emis, coszrs, & + cld_swtau_in=cld_tau_cloudsim, snow_tau_in=gb_snow_tau, & + snow_emis_in=gb_snow_lw) + cosp_cnt(lchnk) = 0 + end if + end if ! docosp + + else + ! Radiative flux calculations not done. The quantity Q*dp is carried by the + ! physics buffer across timesteps. It must be converted to Q (dry static energy + ! tendency) before being passed to radheat_tend. + qrs(:ncol,:) = qrs(:ncol,:) / state%pdel(:ncol,:) + qrl(:ncol,:) = qrl(:ncol,:) / state%pdel(:ncol,:) + + end if ! if (dosw .or. dolw) then + + ! Output for PORT: Parallel Offline Radiative Transport + call rad_data_write(pbuf, state, cam_in, coszrs) + + ! Compute net radiative heating tendency. Note that the WACCM version + ! of radheat_tend merges upper atmosphere heating rates with those calculated + ! by RRTMGP. + call radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, & + fsnt, flns, flnt, cam_in%asdir, net_flx) + + if (write_output) then + ! Compute heating rate for dtheta/dt + do k = 1, pver + do i = 1, ncol + ftem(i,k) = (qrs(i,k) + qrl(i,k))/cpair * (1.e5_r8/state%pmid(i,k))**cappa + end do + end do + call outfld('HR', ftem, pcols, lchnk) + end if + + ! The radiative heating rates are carried in the physics buffer across timesteps + ! as Q*dp (for energy conservation). + qrs(:ncol,:) = qrs(:ncol,:) * state%pdel(:ncol,:) + qrl(:ncol,:) = qrl(:ncol,:) * state%pdel(:ncol,:) + + if (.not. present(rd_out)) then + deallocate(rd) + end if + call free_optics_sw(atm_optics_sw) + call free_optics_sw(cloud_sw) + call free_optics_sw(aer_sw) + call free_fluxes(fsw) + call free_fluxes(fswc) + + call sources_lw%finalize() + call free_optics_lw(cloud_lw) + call free_optics_lw(aer_lw) + call free_fluxes(flw) + call free_fluxes(flwc) + + !------------------------------------------------------------------------------- + contains + !------------------------------------------------------------------------------- + + subroutine set_sw_diags() + + ! Transform RRTMGP output for CAM and compute heating rates. + ! SW fluxes from RRTMGP are on daylight columns only, so expand to + ! full chunks for output to CAM history. + + integer :: i + real(r8), dimension(size(fsw%bnd_flux_dn,1), & + size(fsw%bnd_flux_dn,2), & + size(fsw%bnd_flux_dn,3)) :: flux_dn_diffuse + !------------------------------------------------------------------------- + + ! Initialize to provide 0.0 values for night columns. + fns = 0._r8 ! net sw flux + fcns = 0._r8 ! net sw clearsky flux + fsds = 0._r8 ! downward sw flux at surface + rd%fsdsc = 0._r8 ! downward sw clearsky flux at surface + rd%fsutoa = 0._r8 ! upward sw flux at TOA + rd%fsntoa = 0._r8 ! net sw at TOA + rd%fsntoac = 0._r8 ! net sw clearsky flux at TOA + rd%solin = 0._r8 ! solar irradiance at TOA + rd%flux_sw_up = 0._r8 + rd%flux_sw_dn = 0._r8 + rd%flux_sw_clr_up = 0._r8 + rd%flux_sw_clr_dn = 0._r8 + + qrs = 0._r8 + fsns = 0._r8 + fsnt = 0._r8 + rd%qrsc = 0._r8 + rd%fsnsc = 0._r8 + rd%fsntc = 0._r8 + + do i = 1, nday + fns(idxday(i),ktopcam:) = fsw%flux_net(i, ktoprad:) + fcns(idxday(i),ktopcam:) = fswc%flux_net(i,ktoprad:) + fsds(idxday(i)) = fsw%flux_dn(i, nlay+1) + rd%fsdsc(idxday(i)) = fswc%flux_dn(i, nlay+1) + rd%fsutoa(idxday(i)) = fsw%flux_up(i, 1) + rd%fsntoa(idxday(i)) = fsw%flux_net(i, 1) + rd%fsntoac(idxday(i)) = fswc%flux_net(i, 1) + rd%solin(idxday(i)) = fswc%flux_dn(i, 1) + rd%flux_sw_up(idxday(i),ktopcam:) = fsw%flux_up(i,ktoprad:) + rd%flux_sw_dn(idxday(i),ktopcam:) = fsw%flux_dn(i,ktoprad:) + rd%flux_sw_clr_up(idxday(i),ktopcam:) = fswc%flux_up(i,ktoprad:) + rd%flux_sw_clr_dn(idxday(i),ktopcam:) = fswc%flux_dn(i,ktoprad:) + end do + + ! Compute heating rate as a dry static energy tendency. + call heating_rate('SW', ncol, fns, qrs) + call heating_rate('SW', ncol, fcns, rd%qrsc) + + fsns(:ncol) = fns(:ncol,pverp) ! net sw flux at surface + fsnt(:ncol) = fns(:ncol,ktopcam) ! net sw flux at top-of-model (w/o extra layer) + rd%fsnsc(:ncol) = fcns(:ncol,pverp) ! net sw clearsky flux at surface + rd%fsntc(:ncol) = fcns(:ncol,ktopcam) ! net sw clearsky flux at top + + cam_out%netsw(:ncol) = fsns(:ncol) + + ! Output fluxes at 200 mb + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fns, rd%fsn200) + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcns, rd%fsn200c) + if (hist_fld_active('FSNR')) then + do i = 1,ncol + call vertinterp(1, 1, pverp, state%pint(i,:), p_trop(i), fns(i,:), rd%fsnr(i)) + end do + end if + + if (spectralflux) then + su = 0._r8 + sd = 0._r8 + do i = 1, nday + su(idxday(i),ktopcam:,:) = fsw%bnd_flux_up(i,ktoprad:,:) + sd(idxday(i),ktopcam:,:) = fsw%bnd_flux_dn(i,ktoprad:,:) + end do + end if + + ! Export surface fluxes + ! sols(pcols) Direct solar rad on surface (< 0.7) + ! soll(pcols) Direct solar rad on surface (>= 0.7) + ! RRTMGP: Near-IR bands (1-10), 820-16000 cm-1, 0.625-12.195 microns + ! Put half of band 10 in each of the UV/visible and near-IR values, + ! since this band straddles 0.7 microns: + ! UV/visible bands 10-13, 16000-50000 cm-1, 0.200-0.625 micron + + ! reset fluxes + cam_out%sols = 0.0_r8 + cam_out%soll = 0.0_r8 + cam_out%solsd = 0.0_r8 + cam_out%solld = 0.0_r8 + + ! Calculate diffuse flux from total and direct + flux_dn_diffuse = fsw%bnd_flux_dn - fsw%bnd_flux_dn_dir + + do i = 1, nday + cam_out%soll(idxday(i)) = sum(fsw%bnd_flux_dn_dir(i,nlay+1,1:9)) & + + 0.5_r8 * fsw%bnd_flux_dn_dir(i,nlay+1,10) + + cam_out%sols(idxday(i)) = 0.5_r8 * fsw%bnd_flux_dn_dir(i,nlay+1,10) & + + sum(fsw%bnd_flux_dn_dir(i,nlay+1,11:14)) + + cam_out%solld(idxday(i)) = sum(flux_dn_diffuse(i,nlay+1,1:9)) & + + 0.5_r8 * flux_dn_diffuse(i,nlay+1,10) + + cam_out%solsd(idxday(i)) = 0.5_r8 * flux_dn_diffuse(i, nlay+1, 10) & + + sum(flux_dn_diffuse(i,nlay+1,11:14)) + end do + + end subroutine set_sw_diags + + !------------------------------------------------------------------------------- + + subroutine set_lw_diags() + + ! Set CAM LW diagnostics + !---------------------------------------------------------------------------- + + fnl = 0._r8 + fcnl = 0._r8 + + ! RTE-RRTMGP convention for net is (down - up) **CAM assumes (up - down) !! + fnl(:ncol,ktopcam:) = -1._r8 * flw%flux_net( :, ktoprad:) + fcnl(:ncol,ktopcam:) = -1._r8 * flwc%flux_net( :, ktoprad:) + + rd%flux_lw_up(:ncol,ktopcam:) = flw%flux_up( :, ktoprad:) + rd%flux_lw_clr_up(:ncol,ktopcam:) = flwc%flux_up(:, ktoprad:) + rd%flux_lw_dn(:ncol,ktopcam:) = flw%flux_dn( :, ktoprad:) + rd%flux_lw_clr_dn(:ncol,ktopcam:) = flwc%flux_dn(:, ktoprad:) + + call heating_rate('LW', ncol, fnl, qrl) + call heating_rate('LW', ncol, fcnl, rd%qrlc) + + flns(:ncol) = fnl(:ncol, pverp) + flnt(:ncol) = fnl(:ncol, ktopcam) + + rd%flnsc(:ncol) = fcnl(:ncol, pverp) + rd%flntc(:ncol) = fcnl(:ncol, ktopcam) ! net lw flux at top-of-model + + cam_out%flwds(:ncol) = flw%flux_dn(:, nlay+1) + rd%fldsc(:ncol) = flwc%flux_dn(:, nlay+1) + + rd%flut(:ncol) = flw%flux_up(:, ktoprad) + rd%flutc(:ncol) = flwc%flux_up(:, ktoprad) + + ! Output fluxes at 200 mb + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fnl, rd%fln200) + call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcnl, rd%fln200c) + if (hist_fld_active('FLNR')) then + do i = 1,ncol + call vertinterp(1, 1, pverp, state%pint(i,:), p_trop(i), fnl(i,:), rd%flnr(i)) + end do + end if + + if (spectralflux) then + lu = 0._r8 + ld = 0._r8 + lu(:ncol, ktopcam:, :) = flw%bnd_flux_up(:, ktoprad:, :) + ld(:ncol, ktopcam:, :) = flw%bnd_flux_dn(:, ktoprad:, :) + end if + + end subroutine set_lw_diags + + !------------------------------------------------------------------------------- + + subroutine heating_rate(type, ncol, flux_net, hrate) + + ! Compute heating rate as a dry static energy tendency + + ! arguments + character(2), intent(in) :: type ! either LW or SW + integer, intent(in) :: ncol + real(r8), intent(in) :: flux_net(pcols,pverp) ! W/m^2 + real(r8), intent(out) :: hrate(pcols,pver) ! J/kg/s + + ! local vars + integer :: k + + ! Initialize for layers where RRTMGP is not providing fluxes. + hrate = 0.0_r8 + + select case (type) + case ('LW') + + do k = ktopcam, pver + ! (flux divergence as bottom-MINUS-top) * g/dp + hrate(:ncol,k) = (flux_net(:ncol,k+1) - flux_net(:ncol,k)) * & + gravit * state%rpdel(:ncol,k) + end do + + case ('SW') + + do k = ktopcam, pver + ! top - bottom + hrate(:ncol,k) = (flux_net(:ncol,k) - flux_net(:ncol,k+1)) * & + gravit * state%rpdel(:ncol,k) + end do + + end select + + end subroutine heating_rate + + !---------------------------------------------------------------------------- + ! -- end contains statement of radiation_tend -- + !---------------------------------------------------------------------------- +end subroutine radiation_tend + +!=============================================================================== + +subroutine radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out) + + ! Dump shortwave radiation information to history buffer. + + integer , intent(in) :: lchnk + integer, intent(in) :: ncol + integer, intent(in) :: icall + type(rad_out_t), intent(in) :: rd + type(physics_buffer_desc), pointer :: pbuf(:) + type(cam_out_t), intent(in) :: cam_out + + ! local variables + real(r8), pointer :: qrs(:,:) + real(r8), pointer :: fsnt(:) + real(r8), pointer :: fsns(:) + real(r8), pointer :: fsds(:) + + real(r8) :: ftem(pcols) + !---------------------------------------------------------------------------- + + call pbuf_get_field(pbuf, qrs_idx, qrs) + call pbuf_get_field(pbuf, fsnt_idx, fsnt) + call pbuf_get_field(pbuf, fsns_idx, fsns) + call pbuf_get_field(pbuf, fsds_idx, fsds) + + call outfld('SOLIN'//diag(icall), rd%solin, pcols, lchnk) + + ! QRS is output as temperature tendency. + call outfld('QRS'//diag(icall), qrs(:ncol,:)/cpair, ncol, lchnk) + call outfld('QRSC'//diag(icall), rd%qrsc(:ncol,:)/cpair, ncol, lchnk) + + call outfld('FSNT'//diag(icall), fsnt, pcols, lchnk) + call outfld('FSNTC'//diag(icall), rd%fsntc, pcols, lchnk) + call outfld('FSNTOA'//diag(icall), rd%fsntoa, pcols, lchnk) + call outfld('FSNTOAC'//diag(icall), rd%fsntoac, pcols, lchnk) + + ftem(:ncol) = rd%fsntoa(:ncol) - rd%fsntoac(:ncol) + call outfld('SWCF'//diag(icall), ftem, pcols, lchnk) + + call outfld('FSUTOA'//diag(icall), rd%fsutoa, pcols, lchnk) + + call outfld('FSNIRTOA'//diag(icall), rd%fsnirt, pcols, lchnk) + call outfld('FSNRTOAC'//diag(icall), rd%fsnrtc, pcols, lchnk) + call outfld('FSNRTOAS'//diag(icall), rd%fsnirtsq, pcols, lchnk) + + call outfld('FSN200'//diag(icall), rd%fsn200, pcols, lchnk) + call outfld('FSN200C'//diag(icall), rd%fsn200c, pcols, lchnk) + + call outfld('FSNR'//diag(icall), rd%fsnr, pcols, lchnk) + + call outfld('SOLS'//diag(icall), cam_out%sols, pcols, lchnk) + call outfld('SOLL'//diag(icall), cam_out%soll, pcols, lchnk) + call outfld('SOLSD'//diag(icall), cam_out%solsd, pcols, lchnk) + call outfld('SOLLD'//diag(icall), cam_out%solld, pcols, lchnk) + + call outfld('FSNS'//diag(icall), fsns, pcols, lchnk) + call outfld('FSNSC'//diag(icall), rd%fsnsc, pcols, lchnk) + + call outfld('FSDS'//diag(icall), fsds, pcols, lchnk) + call outfld('FSDSC'//diag(icall), rd%fsdsc, pcols, lchnk) + + call outfld('FUS'//diag(icall), rd%flux_sw_up, pcols, lchnk) + call outfld('FUSC'//diag(icall), rd%flux_sw_clr_up, pcols, lchnk) + call outfld('FDS'//diag(icall), rd%flux_sw_dn, pcols, lchnk) + call outfld('FDSC'//diag(icall), rd%flux_sw_clr_dn, pcols, lchnk) + +end subroutine radiation_output_sw + +!=============================================================================== + +subroutine radiation_output_cld(lchnk, rd) + + ! Dump shortwave cloud optics information to history buffer. + + integer , intent(in) :: lchnk + type(rad_out_t), intent(in) :: rd + !---------------------------------------------------------------------------- + + call outfld('TOT_CLD_VISTAU', rd%tot_cld_vistau, pcols, lchnk) + call outfld('TOT_ICLD_VISTAU', rd%tot_icld_vistau, pcols, lchnk) + call outfld('LIQ_ICLD_VISTAU', rd%liq_icld_vistau, pcols, lchnk) + call outfld('ICE_ICLD_VISTAU', rd%ice_icld_vistau, pcols, lchnk) + if (cldfsnow_idx > 0) then + call outfld('SNOW_ICLD_VISTAU', rd%snow_icld_vistau, pcols, lchnk) + endif + if (cldfgrau_idx > 0 .and. graupel_in_rad) then + call outfld('GRAU_ICLD_VISTAU', rd%grau_icld_vistau , pcols, lchnk) + endif + +end subroutine radiation_output_cld + +!=============================================================================== + +subroutine radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out) + + ! Dump longwave radiation information to history buffer + + integer, intent(in) :: lchnk + integer, intent(in) :: ncol + integer, intent(in) :: icall ! icall=0 for climate diagnostics + type(rad_out_t), intent(in) :: rd + type(physics_buffer_desc), pointer :: pbuf(:) + type(cam_out_t), intent(in) :: cam_out + + ! local variables + real(r8), pointer :: qrl(:,:) + real(r8), pointer :: flnt(:) + real(r8), pointer :: flns(:) + + real(r8) :: ftem(pcols) + !---------------------------------------------------------------------------- + + call pbuf_get_field(pbuf, qrl_idx, qrl) + call pbuf_get_field(pbuf, flnt_idx, flnt) + call pbuf_get_field(pbuf, flns_idx, flns) + + call outfld('QRL'//diag(icall), qrl(:ncol,:)/cpair, ncol, lchnk) + call outfld('QRLC'//diag(icall), rd%qrlc(:ncol,:)/cpair, ncol, lchnk) + + call outfld('FLNT'//diag(icall), flnt, pcols, lchnk) + call outfld('FLNTC'//diag(icall), rd%flntc, pcols, lchnk) + + call outfld('FLUT'//diag(icall), rd%flut, pcols, lchnk) + call outfld('FLUTC'//diag(icall), rd%flutc, pcols, lchnk) + + ftem(:ncol) = rd%flutc(:ncol) - rd%flut(:ncol) + call outfld('LWCF'//diag(icall), ftem, pcols, lchnk) + + call outfld('FLN200'//diag(icall), rd%fln200, pcols, lchnk) + call outfld('FLN200C'//diag(icall), rd%fln200c, pcols, lchnk) + + call outfld('FLNR'//diag(icall), rd%flnr, pcols, lchnk) + + call outfld('FLNS'//diag(icall), flns, pcols, lchnk) + call outfld('FLNSC'//diag(icall), rd%flnsc, pcols, lchnk) + + call outfld('FLDS'//diag(icall), cam_out%flwds, pcols, lchnk) + call outfld('FLDSC'//diag(icall), rd%fldsc, pcols, lchnk) + + call outfld('FDL'//diag(icall), rd%flux_lw_dn, pcols, lchnk) + call outfld('FDLC'//diag(icall), rd%flux_lw_clr_dn, pcols, lchnk) + call outfld('FUL'//diag(icall), rd%flux_lw_up, pcols, lchnk) + call outfld('FULC'//diag(icall), rd%flux_lw_clr_up, pcols, lchnk) + +end subroutine radiation_output_lw + +!=============================================================================== + +subroutine coefs_init(coefs_file, available_gases, kdist) + + ! Read data from coefficients file. Initialize the kdist object. + ! available_gases object provides the gas names that CAM provides. + + ! arguments + character(len=*), intent(in) :: coefs_file + class(ty_gas_concs), intent(in) :: available_gases + class(ty_gas_optics_rrtmgp), intent(out) :: kdist + + ! local variables + type(file_desc_t) :: fh ! pio file handle + character(len=cl) :: locfn ! path to file on local storage + + ! File dimensions + integer :: & + absorber, & + atmos_layer, & + bnd, & + pressure, & + temperature, & + absorber_ext, & + pressure_interp, & + mixing_fraction, & + gpt, & + temperature_Planck + + integer :: i + integer :: did, vid + integer :: ierr, istat + + character(32), dimension(:), allocatable :: gas_names + integer, dimension(:,:,:), allocatable :: key_species + integer, dimension(:,:), allocatable :: band2gpt + real(r8), dimension(:,:), allocatable :: band_lims_wavenum + real(r8), dimension(:), allocatable :: press_ref, temp_ref + real(r8) :: press_ref_trop, temp_ref_t, temp_ref_p + real(r8), dimension(:,:,:), allocatable :: vmr_ref + real(r8), dimension(:,:,:,:), allocatable :: kmajor + real(r8), dimension(:,:,:), allocatable :: kminor_lower, kminor_upper + real(r8), dimension(:,:), allocatable :: totplnk + real(r8), dimension(:,:,:,:), allocatable :: planck_frac + real(r8), dimension(:), allocatable :: solar_src_quiet, solar_src_facular, solar_src_sunspot + real(r8) :: tsi_default + real(r8), dimension(:,:,:), allocatable :: rayl_lower, rayl_upper + character(len=32), dimension(:), allocatable :: gas_minor, & + identifier_minor, & + minor_gases_lower, & + minor_gases_upper, & + scaling_gas_lower, & + scaling_gas_upper + integer, dimension(:,:), allocatable :: minor_limits_gpt_lower, & + minor_limits_gpt_upper + ! Send these to RRTMGP as logicals, + ! but they have to be read from the netCDF as integers + logical, dimension(:), allocatable :: minor_scales_with_density_lower, & + minor_scales_with_density_upper + logical, dimension(:), allocatable :: scale_by_complement_lower, & + scale_by_complement_upper + integer, dimension(:), allocatable :: int2log ! use this to convert integer-to-logical. + integer, dimension(:), allocatable :: kminor_start_lower, kminor_start_upper + real(r8), dimension(:,:), allocatable :: optimal_angle_fit + real(r8) :: mg_default, sb_default + + integer :: pairs, & + minorabsorbers, & + minor_absorber_intervals_lower, & + minor_absorber_intervals_upper, & + contributors_lower, & + contributors_upper, & + fit_coeffs + + character(len=128) :: error_msg + character(len=*), parameter :: sub = 'coefs_init' + !---------------------------------------------------------------------------- + + ! Open file + call getfil(coefs_file, locfn, 0) + call cam_pio_openfile(fh, locfn, PIO_NOWRITE) + + call pio_seterrorhandling(fh, PIO_BCAST_ERROR) + + ! Get dimensions + + ierr = pio_inq_dimid(fh, 'absorber', did) + if (ierr /= PIO_NOERR) call endrun(sub//': absorber not found') + ierr = pio_inq_dimlen(fh, did, absorber) + + ierr = pio_inq_dimid(fh, 'atmos_layer', did) + if (ierr /= PIO_NOERR) call endrun(sub//': atmos_layer not found') + ierr = pio_inq_dimlen(fh, did, atmos_layer) + + ierr = pio_inq_dimid(fh, 'bnd', did) + if (ierr /= PIO_NOERR) call endrun(sub//': bnd not found') + ierr = pio_inq_dimlen(fh, did, bnd) + + ierr = pio_inq_dimid(fh, 'pressure', did) + if (ierr /= PIO_NOERR) call endrun(sub//': pressure not found') + ierr = pio_inq_dimlen(fh, did, pressure) + + ierr = pio_inq_dimid(fh, 'temperature', did) + if (ierr /= PIO_NOERR) call endrun(sub//': temperature not found') + ierr = pio_inq_dimlen(fh, did, temperature) + + ierr = pio_inq_dimid(fh, 'absorber_ext', did) + if (ierr /= PIO_NOERR) call endrun(sub//': absorber_ext not found') + ierr = pio_inq_dimlen(fh, did, absorber_ext) + + ierr = pio_inq_dimid(fh, 'pressure_interp', did) + if (ierr /= PIO_NOERR) call endrun(sub//': pressure_interp not found') + ierr = pio_inq_dimlen(fh, did, pressure_interp) + + ierr = pio_inq_dimid(fh, 'mixing_fraction', did) + if (ierr /= PIO_NOERR) call endrun(sub//': mixing_fraction not found') + ierr = pio_inq_dimlen(fh, did, mixing_fraction) + + ierr = pio_inq_dimid(fh, 'gpt', did) + if (ierr /= PIO_NOERR) call endrun(sub//': gpt not found') + ierr = pio_inq_dimlen(fh, did, gpt) + + temperature_Planck = 0 + ierr = pio_inq_dimid(fh, 'temperature_Planck', did) + if (ierr == PIO_NOERR) then + ierr = pio_inq_dimlen(fh, did, temperature_Planck) + end if + ierr = pio_inq_dimid(fh, 'pair', did) + if (ierr /= PIO_NOERR) call endrun(sub//': pair not found') + ierr = pio_inq_dimlen(fh, did, pairs) + ierr = pio_inq_dimid(fh, 'minor_absorber', did) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_absorber not found') + ierr = pio_inq_dimlen(fh, did, minorabsorbers) + ierr = pio_inq_dimid(fh, 'minor_absorber_intervals_lower', did) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_absorber_intervals_lower not found') + ierr = pio_inq_dimlen(fh, did, minor_absorber_intervals_lower) + ierr = pio_inq_dimid(fh, 'minor_absorber_intervals_upper', did) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_absorber_intervals_upper not found') + ierr = pio_inq_dimlen(fh, did, minor_absorber_intervals_upper) + ierr = pio_inq_dimid(fh, 'contributors_lower', did) + if (ierr /= PIO_NOERR) call endrun(sub//': contributors_lower not found') + ierr = pio_inq_dimlen(fh, did, contributors_lower) + ierr = pio_inq_dimid(fh, 'contributors_upper', did) + if (ierr /= PIO_NOERR) call endrun(sub//': contributors_upper not found') + ierr = pio_inq_dimlen(fh, did, contributors_upper) + + ierr = pio_inq_dimid(fh, 'fit_coeffs', did) + if (ierr == PIO_NOERR) then + ierr = pio_inq_dimlen(fh, did, fit_coeffs) + end if + + ! Get variables + + ! names of absorbing gases + allocate(gas_names(absorber), stat=istat) + call handle_allocate_error(istat, sub, 'gas_names') + ierr = pio_inq_varid(fh, 'gas_names', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': gas_names not found') + ierr = pio_get_var(fh, vid, gas_names) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading gas_names') + + ! key species pair for each band + allocate(key_species(2,atmos_layer,bnd), stat=istat) + call handle_allocate_error(istat, sub, 'key_species') + ierr = pio_inq_varid(fh, 'key_species', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': key_species not found') + ierr = pio_get_var(fh, vid, key_species) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading key_species') + + ! beginning and ending gpoint for each band + allocate(band2gpt(2,bnd), stat=istat) + call handle_allocate_error(istat, sub, 'band2gpt') + ierr = pio_inq_varid(fh, 'bnd_limits_gpt', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': bnd_limits_gpt not found') + ierr = pio_get_var(fh, vid, band2gpt) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading bnd_limits_gpt') + + ! beginning and ending wavenumber for each band + allocate(band_lims_wavenum(2,bnd), stat=istat) + call handle_allocate_error(istat, sub, 'band_lims_wavenum') + ierr = pio_inq_varid(fh, 'bnd_limits_wavenumber', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': bnd_limits_wavenumber not found') + ierr = pio_get_var(fh, vid, band_lims_wavenum) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading bnd_limits_wavenumber') + + ! pressures [hPa] for reference atmosphere; press_ref(# reference layers) + allocate(press_ref(pressure), stat=istat) + call handle_allocate_error(istat, sub, 'press_ref') + ierr = pio_inq_varid(fh, 'press_ref', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': press_ref not found') + ierr = pio_get_var(fh, vid, press_ref) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading press_ref') + + ! reference pressure separating the lower and upper atmosphere + ierr = pio_inq_varid(fh, 'press_ref_trop', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': press_ref_trop not found') + ierr = pio_get_var(fh, vid, press_ref_trop) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading press_ref_trop') + + ! temperatures [K] for reference atmosphere; temp_ref(# reference layers) + allocate(temp_ref(temperature), stat=istat) + call handle_allocate_error(istat, sub, 'temp_ref') + ierr = pio_inq_varid(fh, 'temp_ref', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': temp_ref not found') + ierr = pio_get_var(fh, vid, temp_ref) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading temp_ref') + + ! standard spectroscopic reference temperature [K] + ierr = pio_inq_varid(fh, 'absorption_coefficient_ref_T', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': absorption_coefficient_ref_T not found') + ierr = pio_get_var(fh, vid, temp_ref_t) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading absorption_coefficient_ref_T') + + ! standard spectroscopic reference pressure [hPa] + ierr = pio_inq_varid(fh, 'absorption_coefficient_ref_P', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': absorption_coefficient_ref_P not found') + ierr = pio_get_var(fh, vid, temp_ref_p) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading absorption_coefficient_ref_P') + + ! volume mixing ratios for reference atmosphere + allocate(vmr_ref(atmos_layer, absorber_ext, temperature), stat=istat) + call handle_allocate_error(istat, sub, 'vmr_ref') + ierr = pio_inq_varid(fh, 'vmr_ref', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': vmr_ref not found') + ierr = pio_get_var(fh, vid, vmr_ref) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading vmr_ref') + + ! absorption coefficients due to major absorbing gases + allocate(kmajor(gpt,mixing_fraction,pressure_interp,temperature), stat=istat) + call handle_allocate_error(istat, sub, 'kmajor') + ierr = pio_inq_varid(fh, 'kmajor', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': kmajor not found') + ierr = pio_get_var(fh, vid, kmajor) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading kmajor') + + ! absorption coefficients due to minor absorbing gases in lower part of atmosphere + allocate(kminor_lower(contributors_lower, mixing_fraction, temperature), stat=istat) + call handle_allocate_error(istat, sub, 'kminor_lower') + ierr = pio_inq_varid(fh, 'kminor_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': kminor_lower not found') + ierr = pio_get_var(fh, vid, kminor_lower) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading kminor_lower') + + ! absorption coefficients due to minor absorbing gases in upper part of atmosphere + allocate(kminor_upper(contributors_upper, mixing_fraction, temperature), stat=istat) + call handle_allocate_error(istat, sub, 'kminor_upper') + ierr = pio_inq_varid(fh, 'kminor_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': kminor_upper not found') + ierr = pio_get_var(fh, vid, kminor_upper) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading kminor_upper') + + ! integrated Planck function by band + ierr = pio_inq_varid(fh, 'totplnk', vid) + if (ierr == PIO_NOERR) then + allocate(totplnk(temperature_Planck,bnd), stat=istat) + call handle_allocate_error(istat, sub, 'totplnk') + ierr = pio_get_var(fh, vid, totplnk) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading totplnk') + end if + + ! Planck fractions + ierr = pio_inq_varid(fh, 'plank_fraction', vid) + if (ierr == PIO_NOERR) then + allocate(planck_frac(gpt,mixing_fraction,pressure_interp,temperature), stat=istat) + call handle_allocate_error(istat, sub, 'planck_frac') + ierr = pio_get_var(fh, vid, planck_frac) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading plank_fraction') + end if + + ierr = pio_inq_varid(fh, 'optimal_angle_fit', vid) + if (ierr == PIO_NOERR) then + allocate(optimal_angle_fit(fit_coeffs, bnd), stat=istat) + call handle_allocate_error(istat, sub, 'optiman_angle_fit') + ierr = pio_get_var(fh, vid, optimal_angle_fit) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading optimal_angle_fit') + end if + + ierr = pio_inq_varid(fh, 'solar_source_quiet', vid) + if (ierr == PIO_NOERR) then + allocate(solar_src_quiet(gpt), stat=istat) + call handle_allocate_error(istat, sub, 'solar_src_quiet') + ierr = pio_get_var(fh, vid, solar_src_quiet) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source_quiet') + end if + + ierr = pio_inq_varid(fh, 'solar_source_facular', vid) + if (ierr == PIO_NOERR) then + allocate(solar_src_facular(gpt), stat=istat) + call handle_allocate_error(istat, sub, 'solar_src_facular') + ierr = pio_get_var(fh, vid, solar_src_facular) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source_facular') + end if + + ierr = pio_inq_varid(fh, 'solar_source_sunspot', vid) + if (ierr == PIO_NOERR) then + allocate(solar_src_sunspot(gpt), stat=istat) + call handle_allocate_error(istat, sub, 'solar_src_sunspot') + ierr = pio_get_var(fh, vid, solar_src_sunspot) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading solar_source_sunspot') + end if + + ierr = pio_inq_varid(fh, 'tsi_default', vid) + if (ierr == PIO_NOERR) then + ierr = pio_get_var(fh, vid, tsi_default) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading tsi_default') + end if + + ierr = pio_inq_varid(fh, 'mg_default', vid) + if (ierr == PIO_NOERR) then + ierr = pio_get_var(fh, vid, mg_default) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading mg_default') + end if + + ierr = pio_inq_varid(fh, 'sb_default', vid) + if (ierr == PIO_NOERR) then + ierr = pio_get_var(fh, vid, sb_default) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading sb_default') + end if + + ! rayleigh scattering contribution in lower part of atmosphere + ierr = pio_inq_varid(fh, 'rayl_lower', vid) + if (ierr == PIO_NOERR) then + allocate(rayl_lower(gpt,mixing_fraction,temperature), stat=istat) + call handle_allocate_error(istat, sub, 'rayl_lower') + ierr = pio_get_var(fh, vid, rayl_lower) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading rayl_lower') + end if + + ! rayleigh scattering contribution in upper part of atmosphere + ierr = pio_inq_varid(fh, 'rayl_upper', vid) + if (ierr == PIO_NOERR) then + allocate(rayl_upper(gpt,mixing_fraction,temperature), stat=istat) + call handle_allocate_error(istat, sub, 'rayl_upper') + ierr = pio_get_var(fh, vid, rayl_upper) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading rayl_upper') + end if + + allocate(gas_minor(minorabsorbers), stat=istat) + call handle_allocate_error(istat, sub, 'gas_minor') + ierr = pio_inq_varid(fh, 'gas_minor', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': gas_minor not found') + ierr = pio_get_var(fh, vid, gas_minor) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading gas_minor') + + allocate(identifier_minor(minorabsorbers), stat=istat) + call handle_allocate_error(istat, sub, 'identifier_minor') + ierr = pio_inq_varid(fh, 'identifier_minor', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': identifier_minor not found') + ierr = pio_get_var(fh, vid, identifier_minor) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading identifier_minor') + + allocate(minor_gases_lower(minor_absorber_intervals_lower), stat=istat) + call handle_allocate_error(istat, sub, 'minor_gases_lower') + ierr = pio_inq_varid(fh, 'minor_gases_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_gases_lower not found') + ierr = pio_get_var(fh, vid, minor_gases_lower) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_gases_lower') + + allocate(minor_gases_upper(minor_absorber_intervals_upper), stat=istat) + call handle_allocate_error(istat, sub, 'minor_gases_upper') + ierr = pio_inq_varid(fh, 'minor_gases_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_gases_upper not found') + ierr = pio_get_var(fh, vid, minor_gases_upper) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_gases_upper') + + allocate(minor_limits_gpt_lower(pairs,minor_absorber_intervals_lower), stat=istat) + call handle_allocate_error(istat, sub, 'minor_limits_gpt_lower') + ierr = pio_inq_varid(fh, 'minor_limits_gpt_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_limits_gpt_lower not found') + ierr = pio_get_var(fh, vid, minor_limits_gpt_lower) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_limits_gpt_lower') + + allocate(minor_limits_gpt_upper(pairs,minor_absorber_intervals_upper), stat=istat) + call handle_allocate_error(istat, sub, 'minor_limits_gpt_upper') + ierr = pio_inq_varid(fh, 'minor_limits_gpt_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_limits_gpt_upper not found') + ierr = pio_get_var(fh, vid, minor_limits_gpt_upper) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_limits_gpt_upper') + + ! Read as integer and convert to logical + allocate(int2log(minor_absorber_intervals_lower), stat=istat) + call handle_allocate_error(istat, sub, 'int2log for lower') + + allocate(minor_scales_with_density_lower(minor_absorber_intervals_lower), stat=istat) + call handle_allocate_error(istat, sub, 'minor_scales_with_density_lower') + ierr = pio_inq_varid(fh, 'minor_scales_with_density_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_scales_with_density_lower not found') + ierr = pio_get_var(fh, vid, int2log) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_scales_with_density_lower') + do i = 1,minor_absorber_intervals_lower + if (int2log(i) .eq. 0) then + minor_scales_with_density_lower(i) = .false. + else + minor_scales_with_density_lower(i) = .true. + end if + end do + + allocate(scale_by_complement_lower(minor_absorber_intervals_lower), stat=istat) + call handle_allocate_error(istat, sub, 'scale_by_complement_lower') + ierr = pio_inq_varid(fh, 'scale_by_complement_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': scale_by_complement_lower not found') + ierr = pio_get_var(fh, vid, int2log) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading scale_by_complement_lower') + do i = 1,minor_absorber_intervals_lower + if (int2log(i) .eq. 0) then + scale_by_complement_lower(i) = .false. + else + scale_by_complement_lower(i) = .true. + end if + end do + + deallocate(int2log) + + ! Read as integer and convert to logical + allocate(int2log(minor_absorber_intervals_upper), stat=istat) + call handle_allocate_error(istat, sub, 'int2log for upper') + + allocate(minor_scales_with_density_upper(minor_absorber_intervals_upper), stat=istat) + call handle_allocate_error(istat, sub, 'minor_scales_with_density_upper') + ierr = pio_inq_varid(fh, 'minor_scales_with_density_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': minor_scales_with_density_upper not found') + ierr = pio_get_var(fh, vid, int2log) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading minor_scales_with_density_upper') + do i = 1,minor_absorber_intervals_upper + if (int2log(i) .eq. 0) then + minor_scales_with_density_upper(i) = .false. + else + minor_scales_with_density_upper(i) = .true. + end if + end do + + allocate(scale_by_complement_upper(minor_absorber_intervals_upper), stat=istat) + call handle_allocate_error(istat, sub, 'scale_by_complement_upper') + ierr = pio_inq_varid(fh, 'scale_by_complement_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': scale_by_complement_upper not found') + ierr = pio_get_var(fh, vid, int2log) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading scale_by_complement_upper') + do i = 1,minor_absorber_intervals_upper + if (int2log(i) .eq. 0) then + scale_by_complement_upper(i) = .false. + else + scale_by_complement_upper(i) = .true. + end if + end do + + deallocate(int2log) + + allocate(scaling_gas_lower(minor_absorber_intervals_lower), stat=istat) + call handle_allocate_error(istat, sub, 'scaling_gas_lower') + ierr = pio_inq_varid(fh, 'scaling_gas_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': scaling_gas_lower not found') + ierr = pio_get_var(fh, vid, scaling_gas_lower) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading scaling_gas_lower') + + allocate(scaling_gas_upper(minor_absorber_intervals_upper), stat=istat) + call handle_allocate_error(istat, sub, 'scaling_gas_upper') + ierr = pio_inq_varid(fh, 'scaling_gas_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': scaling_gas_upper not found') + ierr = pio_get_var(fh, vid, scaling_gas_upper) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading scaling_gas_upper') + + allocate(kminor_start_lower(minor_absorber_intervals_lower), stat=istat) + call handle_allocate_error(istat, sub, 'kminor_start_lower') + ierr = pio_inq_varid(fh, 'kminor_start_lower', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': kminor_start_lower not found') + ierr = pio_get_var(fh, vid, kminor_start_lower) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading kminor_start_lower') + + allocate(kminor_start_upper(minor_absorber_intervals_upper), stat=istat) + call handle_allocate_error(istat, sub, 'kminor_start_upper') + ierr = pio_inq_varid(fh, 'kminor_start_upper', vid) + if (ierr /= PIO_NOERR) call endrun(sub//': kminor_start_upper not found') + ierr = pio_get_var(fh, vid, kminor_start_upper) + if (ierr /= PIO_NOERR) call endrun(sub//': error reading kminor_start_upper') + + ! Close file + call pio_closefile(fh) + + ! Initialize the gas optics object with data. The calls are slightly different depending + ! on whether the radiation sources are internal to the atmosphere (longwave) or external (shortwave) + + if (allocated(totplnk) .and. allocated(planck_frac)) then + error_msg = kdist%load( & + available_gases, gas_names, key_species, & + band2gpt, band_lims_wavenum, & + press_ref, press_ref_trop, temp_ref, & + temp_ref_p, temp_ref_t, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, & + totplnk, planck_frac, rayl_lower, rayl_upper, & + optimal_angle_fit) + else if (allocated(solar_src_quiet)) then + error_msg = kdist%load( & + available_gases, gas_names, key_species, & + band2gpt, band_lims_wavenum, & + press_ref, press_ref_trop, temp_ref, & + temp_ref_p, temp_ref_t, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, & + scale_by_complement_upper, & + kminor_start_lower, & + kminor_start_upper, & + solar_src_quiet, solar_src_facular, solar_src_sunspot, & + tsi_default, mg_default, sb_default, & + rayl_lower, rayl_upper) + else + error_msg = 'must supply either totplnk and planck_frac, or solar_src_[*]' + end if + + call stop_on_err(error_msg, sub, 'kdist%load') + + deallocate( & + gas_names, key_species, & + band2gpt, band_lims_wavenum, & + press_ref, temp_ref, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, & + minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scale_by_complement_lower, & + scale_by_complement_upper, & + scaling_gas_lower, scaling_gas_upper, & + kminor_start_lower, kminor_start_upper) + + if (allocated(totplnk)) deallocate(totplnk) + if (allocated(planck_frac)) deallocate(planck_frac) + if (allocated(optimal_angle_fit)) deallocate(optimal_angle_fit) + if (allocated(solar_src_quiet)) deallocate(solar_src_quiet) + if (allocated(solar_src_facular)) deallocate(solar_src_facular) + if (allocated(solar_src_sunspot)) deallocate(solar_src_sunspot) + if (allocated(rayl_lower)) deallocate(rayl_lower) + if (allocated(rayl_upper)) deallocate(rayl_upper) + +end subroutine coefs_init + +!========================================================================================= + +subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) + + ! Allocate flux arrays and set values to zero. + + ! Arguments + integer, intent(in) :: ncol, nlevels, nbands + class(ty_fluxes_broadband), intent(inout) :: fluxes + logical, optional, intent(in) :: do_direct + + ! Local variables + logical :: do_direct_local + integer :: istat + character(len=*), parameter :: sub = 'initialize_rrtmgp_fluxes' + !---------------------------------------------------------------------------- + + if (present(do_direct)) then + do_direct_local = .true. + else + do_direct_local = .false. + end if + + ! Broadband fluxes + allocate(fluxes%flux_up(ncol, nlevels), stat=istat) + call handle_allocate_error(istat, sub, 'fluxes%flux_up') + allocate(fluxes%flux_dn(ncol, nlevels), stat=istat) + call handle_allocate_error(istat, sub, 'fluxes%flux_dn') + allocate(fluxes%flux_net(ncol, nlevels), stat=istat) + call handle_allocate_error(istat, sub, 'fluxes%flux_net') + if (do_direct_local) then + allocate(fluxes%flux_dn_dir(ncol, nlevels), stat=istat) + call handle_allocate_error(istat, sub, 'fluxes%flux_dn_dir') + end if + + select type (fluxes) + type is (ty_fluxes_byband) + ! Fluxes by band always needed for SW. Only allocate for LW + ! when spectralflux is true. + if (nbands == nswbands .or. spectralflux) then + allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands), stat=istat) + call handle_allocate_error(istat, sub, 'fluxes%bnd_flux_up') + allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands), stat=istat) + call handle_allocate_error(istat, sub, 'fluxes%bnd_flux_dn') + allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands), stat=istat) + call handle_allocate_error(istat, sub, 'fluxes%bnd_flux_net') + if (do_direct_local) then + allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands), stat=istat) + call handle_allocate_error(istat, sub, 'fluxes%bnd_flux_dn_dir') + end if + end if + end select + + ! Initialize + call reset_fluxes(fluxes) + +end subroutine initialize_rrtmgp_fluxes + +!========================================================================================= + +subroutine reset_fluxes(fluxes) + + ! Reset flux arrays to zero. + + class(ty_fluxes_broadband), intent(inout) :: fluxes + !---------------------------------------------------------------------------- + + ! Reset broadband fluxes + fluxes%flux_up(:,:) = 0._r8 + fluxes%flux_dn(:,:) = 0._r8 + fluxes%flux_net(:,:) = 0._r8 + if (associated(fluxes%flux_dn_dir)) fluxes%flux_dn_dir(:,:) = 0._r8 + + select type (fluxes) + type is (ty_fluxes_byband) + ! Reset band-by-band fluxes + if (associated(fluxes%bnd_flux_up)) fluxes%bnd_flux_up(:,:,:) = 0._r8 + if (associated(fluxes%bnd_flux_dn)) fluxes%bnd_flux_dn(:,:,:) = 0._r8 + if (associated(fluxes%bnd_flux_net)) fluxes%bnd_flux_net(:,:,:) = 0._r8 + if (associated(fluxes%bnd_flux_dn_dir)) fluxes%bnd_flux_dn_dir(:,:,:) = 0._r8 + end select + +end subroutine reset_fluxes + +!========================================================================================= + +subroutine free_optics_sw(optics) + + type(ty_optical_props_2str), intent(inout) :: optics + + if (allocated(optics%tau)) deallocate(optics%tau) + if (allocated(optics%ssa)) deallocate(optics%ssa) + if (allocated(optics%g)) deallocate(optics%g) + call optics%finalize() + +end subroutine free_optics_sw + +!========================================================================================= + +subroutine free_optics_lw(optics) + + type(ty_optical_props_1scl), intent(inout) :: optics + + if (allocated(optics%tau)) deallocate(optics%tau) + call optics%finalize() + +end subroutine free_optics_lw + +!========================================================================================= + +subroutine free_fluxes(fluxes) + + class(ty_fluxes_broadband), intent(inout) :: fluxes + + if (associated(fluxes%flux_up)) deallocate(fluxes%flux_up) + if (associated(fluxes%flux_dn)) deallocate(fluxes%flux_dn) + if (associated(fluxes%flux_net)) deallocate(fluxes%flux_net) + if (associated(fluxes%flux_dn_dir)) deallocate(fluxes%flux_dn_dir) + + select type (fluxes) + type is (ty_fluxes_byband) + if (associated(fluxes%bnd_flux_up)) deallocate(fluxes%bnd_flux_up) + if (associated(fluxes%bnd_flux_dn)) deallocate(fluxes%bnd_flux_dn) + if (associated(fluxes%bnd_flux_net)) deallocate(fluxes%bnd_flux_net) + if (associated(fluxes%bnd_flux_dn_dir)) deallocate(fluxes%bnd_flux_dn_dir) + end select + +end subroutine free_fluxes + +!========================================================================================= + +subroutine modified_cloud_fraction(ncol, cld, cldfsnow, cldfgrau, cldfprime) + + ! Compute modified cloud fraction, cldfprime. + ! 1. initialize as cld + ! 2. modify for snow if cldfsnow is available. use max(cld, cldfsnow) + ! 3. modify for graupel if cldfgrau is available and graupel_in_rad is true. + ! use max(cldfprime, cldfgrau) + + ! Arguments + integer, intent(in) :: ncol + real(r8), pointer :: cld(:,:) ! cloud fraction + real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds" + real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds" + real(r8), intent(out) :: cldfprime(:,:) ! modified cloud fraction + + ! Local variables + integer :: i, k + !---------------------------------------------------------------------------- + + if (associated(cldfsnow)) then + do k = 1, pver + do i = 1, ncol + cldfprime(i,k) = max(cld(i,k), cldfsnow(i,k)) + end do + end do + else + cldfprime(:ncol,:) = cld(:ncol,:) + end if + + if (associated(cldfgrau) .and. graupel_in_rad) then + do k = 1, pver + do i = 1, ncol + cldfprime(i,k) = max(cldfprime(i,k), cldfgrau(i,k)) + end do + end do + end if + +end subroutine modified_cloud_fraction + +!========================================================================================= + +subroutine stop_on_err(errmsg, sub, info) + +! call endrun if RRTMGP function returns non-empty error message. + + character(len=*), intent(in) :: errmsg ! return message from RRTMGP function + character(len=*), intent(in) :: sub ! name of calling subroutine + character(len=*), intent(in) :: info ! name of called function + + if (len_trim(errmsg) > 0) then + call endrun(trim(sub)//': ERROR: '//trim(info)//': '//trim(errmsg)) + end if + +end subroutine stop_on_err + +!========================================================================================= + +end module radiation + diff --git a/src/physics/rrtmgp/rrtmgp_inputs.F90 b/src/physics/rrtmgp/rrtmgp_inputs.F90 new file mode 100644 index 0000000000..4f73ae9029 --- /dev/null +++ b/src/physics/rrtmgp/rrtmgp_inputs.F90 @@ -0,0 +1,1012 @@ +module rrtmgp_inputs + +!-------------------------------------------------------------------------------- +! Transform data for inputs from CAM's data structures to those used by +! RRTMGP. Subset the number of model levels if CAM's top exceeds RRTMGP's +! valid domain. Add an extra layer if CAM's top is below 1 Pa. +! The vertical indexing increases from top to bottom of atmosphere in both +! CAM and RRTMGP arrays. +!-------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use ppgrid, only: pcols, pver, pverp + +use physconst, only: stebol, pi + +use physics_types, only: physics_state +use physics_buffer, only: physics_buffer_desc +use camsrfexch, only: cam_in_t + +use radconstants, only: nradgas, gaslist, nswbands, nlwbands, nswgpts, nlwgpts, & + get_sw_spectral_boundaries, idx_sw_diag, idx_sw_cloudsim, & + idx_lw_cloudsim + +use rad_constituents, only: rad_cnst_get_gas + +use cloud_rad_props, only: get_liquid_optics_sw, liquid_cloud_get_rad_props_lw, & + get_ice_optics_sw, ice_cloud_get_rad_props_lw, & + get_snow_optics_sw, snow_cloud_get_rad_props_lw, & + get_grau_optics_sw, grau_cloud_get_rad_props_lw + +use mcica_subcol_gen, only: mcica_subcol_sw, mcica_subcol_lw + +use aer_rad_props, only: aer_rad_props_sw, aer_rad_props_lw + +use mo_gas_concentrations, only: ty_gas_concs +use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp +use mo_optical_props, only: ty_optical_props_2str, ty_optical_props_1scl + +use cam_history_support, only: fillvalue +use cam_logfile, only: iulog +use cam_abortutils, only: endrun +use error_messages, only: alloc_err + +implicit none +private +save + +public :: & + rrtmgp_inputs_init, & + rrtmgp_set_state, & + rrtmgp_set_gases_lw, & + rrtmgp_set_gases_sw, & + rrtmgp_set_cloud_lw, & + rrtmgp_set_cloud_sw, & + rrtmgp_set_aer_lw, & + rrtmgp_set_aer_sw + + +! This value is to match the arbitrary small value used in RRTMG to decide +! when a quantity is effectively zero. +real(r8), parameter :: tiny = 1.0e-80_r8 + +! Indices for copying data between cam and rrtmgp arrays +integer :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which + ! RRTMGP is active. +integer :: ktoprad ! Index in RRTMGP arrays of the layer or interface corresponding + ! to CAM's top layer or interface + +! wavenumber (cm^-1) boundaries of shortwave bands +real(r8) :: sw_low_bounds(nswbands), sw_high_bounds(nswbands) + +! Mapping from RRTMG shortwave bands to RRTMGP. Currently needed to continue using +! the SW optics datasets from RRTMG (even thought there is a slight mismatch in the +! band boundaries of the 2 bands that overlap with the LW bands). +integer, parameter, dimension(14) :: rrtmg_to_rrtmgp_swbands = & + [ 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 ] + +!================================================================================================== +contains +!================================================================================================== + +subroutine rrtmgp_inputs_init(ktcam, ktrad) + + ! Note that this routine must be called after the calls to set_wavenumber_bands which set + ! the sw/lw band boundaries in the radconstants module. + + integer, intent(in) :: ktcam + integer, intent(in) :: ktrad + + ktopcam = ktcam + ktoprad = ktrad + + ! Initialize the module data containing the SW band boundaries. + call get_sw_spectral_boundaries(sw_low_bounds, sw_high_bounds, 'cm^-1') + +end subroutine rrtmgp_inputs_init + +!========================================================================================= + +subroutine rrtmgp_set_state( & + state, cam_in, ncol, nlay, nday, & + idxday, coszrs, kdist_sw, t_sfc, emis_sfc, & + t_rad, pmid_rad, pint_rad, t_day, pmid_day, & + pint_day, coszrs_day, alb_dir, alb_dif) + + ! arguments + type(physics_state), intent(in) :: state ! CAM physics state + type(cam_in_t), intent(in) :: cam_in ! CAM import state + integer, intent(in) :: ncol ! # cols in CAM chunk + integer, intent(in) :: nlay ! # layers in rrtmgp grid + integer, intent(in) :: nday ! # daylight columns + integer, intent(in) :: idxday(:) ! chunk indicies of daylight columns + real(r8), intent(in) :: coszrs(:) ! cosine of solar zenith angle + class(ty_gas_optics_rrtmgp), intent(in) :: kdist_sw ! spectral information + + real(r8), intent(out) :: t_sfc(ncol) ! surface temperature [K] + real(r8), intent(out) :: emis_sfc(nlwbands,ncol) ! emissivity at surface [] + real(r8), intent(out) :: t_rad(ncol,nlay) ! layer midpoint temperatures [K] + real(r8), intent(out) :: pmid_rad(ncol,nlay) ! layer midpoint pressures [Pa] + real(r8), intent(out) :: pint_rad(ncol,nlay+1) ! layer interface pressures [Pa] + real(r8), intent(out) :: t_day(nday,nlay) ! layer midpoint temperatures [K] + real(r8), intent(out) :: pmid_day(nday,nlay) ! layer midpoint pressure [Pa] + real(r8), intent(out) :: pint_day(nday,nlay+1) ! layer interface pressures [Pa] + real(r8), intent(out) :: coszrs_day(nday) ! cosine of solar zenith angle + real(r8), intent(out) :: alb_dir(nswbands,nday) ! surface albedo, direct radiation + real(r8), intent(out) :: alb_dif(nswbands,nday) ! surface albedo, diffuse radiation + + ! local variables + integer :: i, k, iband + + real(r8) :: tref_min, tref_max + + character(len=*), parameter :: sub='rrtmgp_set_state' + character(len=512) :: errmsg + !-------------------------------------------------------------------------------- + + t_sfc = sqrt(sqrt(cam_in%lwup(:ncol)/stebol)) ! Surface temp set based on longwave up flux. + + ! Set surface emissivity to 1.0. + ! The land model *does* have its own surface emissivity, but is not spectrally resolved. + ! The LW upward flux is calculated with that land emissivity, and the "radiative temperature" + ! t_sfc is derived from that flux. We assume, therefore, that the emissivity is unity + ! to be consistent with t_sfc. + emis_sfc(:,:) = 1._r8 + + ! Level ordering is the same for both CAM and RRTMGP (top to bottom) + t_rad(:,ktoprad:) = state%t(:ncol,ktopcam:) + pmid_rad(:,ktoprad:) = state%pmid(:ncol,ktopcam:) + pint_rad(:,ktoprad:) = state%pint(:ncol,ktopcam:) + + ! Add extra layer values if needed. + if (nlay == pverp) then + 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 + ! is within the valid pressure range of RRTMGP (otherwise RRTMGP issues an error). Then + ! set the midpoint pressure halfway between the interfaces. + pint_rad(:,1) = 1.01_r8 + pmid_rad(:,1) = 0.5_r8 * (pint_rad(:,1) + pint_rad(:,2)) + end if + + ! Limit temperatures to be within the limits of RRTMGP validity. + tref_min = kdist_sw%get_temp_min() + tref_max = kdist_sw%get_temp_max() + t_rad = merge(t_rad, tref_min, t_rad > tref_min) + t_rad = merge(t_rad, tref_max, t_rad < tref_max) + + ! Construct arrays containing only daylight columns + do i = 1, nday + t_day(i,:) = t_rad(idxday(i),:) + pmid_day(i,:) = pmid_rad(idxday(i),:) + pint_day(i,:) = pint_rad(idxday(i),:) + coszrs_day(i) = coszrs(idxday(i)) + end do + + ! Assign albedos to the daylight columns (from E3SM implementation) + ! Albedos are imported from the surface models as broadband (visible, and near-IR), + ! and we need to map these to appropriate narrower bands used in RRTMGP. Bands + ! are categorized broadly as "visible/UV" or "infrared" based on wavenumber. + ! Loop over bands, and determine for each band whether it is broadly in the + ! visible or infrared part of the spectrum based on a dividing line of + ! 0.7 micron, or 14286 cm^-1 + do iband = 1,nswbands + if (is_visible(sw_low_bounds(iband)) .and. & + is_visible(sw_high_bounds(iband))) then + + ! Entire band is in the visible + do i = 1, nday + alb_dir(iband,i) = cam_in%asdir(idxday(i)) + alb_dif(iband,i) = cam_in%asdif(idxday(i)) + end do + + else if (.not.is_visible(sw_low_bounds(iband)) .and. & + .not.is_visible(sw_high_bounds(iband))) then + ! Entire band is in the longwave (near-infrared) + do i = 1, nday + alb_dir(iband,i) = cam_in%aldir(idxday(i)) + alb_dif(iband,i) = cam_in%aldif(idxday(i)) + end do + else + ! Band straddles the visible to near-infrared transition, so we take + ! the albedo to be the average of the visible and near-infrared + ! broadband albedos + do i = 1, nday + alb_dir(iband,i) = 0.5_r8 * (cam_in%aldir(idxday(i)) + cam_in%asdir(idxday(i))) + alb_dif(iband,i) = 0.5_r8 * (cam_in%aldif(idxday(i)) + cam_in%asdif(idxday(i))) + end do + end if + end do + + ! Strictly enforce albedo bounds + where (alb_dir < 0) + alb_dir = 0.0_r8 + end where + where (alb_dir > 1) + alb_dir = 1.0_r8 + end where + where (alb_dif < 0) + alb_dif = 0.0_r8 + end where + where (alb_dif > 1) + alb_dif = 1.0_r8 + end where + +end subroutine rrtmgp_set_state + +!========================================================================================= + +pure logical function is_visible(wavenumber) + + ! Wavenumber is in the visible if it is above the visible threshold + ! wavenumber, and in the infrared if it is below the threshold + ! This function doesn't distinquish between visible and UV. + + ! wavenumber in inverse cm (cm^-1) + real(r8), intent(in) :: wavenumber + + ! Set threshold between visible and infrared to 0.7 micron, or 14286 cm^-1 + real(r8), parameter :: visible_wavenumber_threshold = 14286._r8 ! cm^-1 + + if (wavenumber > visible_wavenumber_threshold) then + is_visible = .true. + else + is_visible = .false. + end if + +end function is_visible + +!========================================================================================= + +function get_molar_mass_ratio(gas_name) result(massratio) + + ! return the molar mass ratio of dry air to gas based on gas_name + + character(len=*),intent(in) :: gas_name + real(r8) :: massratio + + ! local variables + real(r8), parameter :: amdw = 1.607793_r8 ! Molecular weight of dry air / water vapor + real(r8), parameter :: amdc = 0.658114_r8 ! Molecular weight of dry air / carbon dioxide + real(r8), parameter :: amdo = 0.603428_r8 ! Molecular weight of dry air / ozone + real(r8), parameter :: amdm = 1.805423_r8 ! Molecular weight of dry air / methane + real(r8), parameter :: amdn = 0.658090_r8 ! Molecular weight of dry air / nitrous oxide + real(r8), parameter :: amdo2 = 0.905140_r8 ! Molecular weight of dry air / oxygen + real(r8), parameter :: amdc1 = 0.210852_r8 ! Molecular weight of dry air / CFC11 + real(r8), parameter :: amdc2 = 0.239546_r8 ! Molecular weight of dry air / CFC12 + + character(len=*), parameter :: sub='get_molar_mass_ratio' + !---------------------------------------------------------------------------- + + select case (trim(gas_name)) + case ('H2O') + massratio = amdw + case ('CO2') + massratio = amdc + case ('O3') + massratio = amdo + case ('CH4') + massratio = amdm + case ('N2O') + massratio = amdn + case ('O2') + massratio = amdo2 + case ('CFC11') + massratio = amdc1 + case ('CFC12') + massratio = amdc2 + case default + call endrun(sub//": Invalid gas: "//trim(gas_name)) + end select + +end function get_molar_mass_ratio + +!========================================================================================= + +subroutine rad_gas_get_vmr(icall, gas_name, state, pbuf, nlay, numactivecols, gas_concs, idxday) + + ! Set volume mixing ratio in gas_concs object. + ! The gas_concs%set_vmr method copies data into internally allocated storage. + + integer, intent(in) :: icall ! index of climate/diagnostic radiation call + character(len=*), intent(in) :: gas_name + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nlay ! number of layers in radiation calculation + integer, intent(in) :: numactivecols ! number of columns, ncol for LW, nday for SW + + type(ty_gas_concs), intent(inout) :: gas_concs ! the result is VRM inside gas_concs + + integer, optional, intent(in) :: idxday(:) ! indices of daylight columns in a chunk + + ! Local variables + integer :: i, idx(numactivecols) + integer :: istat + real(r8), pointer :: gas_mmr(:,:) + real(r8), allocatable :: gas_vmr(:,:) + real(r8), allocatable :: mmr(:,:) + real(r8) :: massratio + + ! For ozone profile above model + real(r8) :: P_top, P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff + + character(len=128) :: errmsg + character(len=*), parameter :: sub = 'rad_gas_get_vmr' + !---------------------------------------------------------------------------- + + ! set the column indices; when idxday is provided (e.g. daylit columns) use them, otherwise just count. + do i = 1, numactivecols + if (present(idxday)) then + idx(i) = idxday(i) + else + idx(i) = i + end if + end do + + ! gas_mmr points to a "chunk" in either the state or pbuf objects. That storage is + ! dimensioned (pcols,pver). + call rad_cnst_get_gas(icall, gas_name, state, pbuf, gas_mmr) + + ! Copy into storage for RRTMGP + allocate(mmr(numactivecols, nlay), stat=istat) + call alloc_err(istat, sub, 'mmr', numactivecols*nlay) + allocate(gas_vmr(numactivecols, nlay), stat=istat) + call alloc_err(istat, sub, 'gas_vmr', numactivecols*nlay) + + do i = 1, numactivecols + mmr(i,ktoprad:) = gas_mmr(idx(i),ktopcam:) + end do + + ! If an extra layer is being used, copy mmr from the top layer of CAM to the extra layer. + if (nlay == pverp) then + mmr(:,1) = mmr(:,2) + end if + + ! special case: H2O is specific humidity, not mixing ratio. Use r = q/(1-q): + if (gas_name == 'H2O') then + mmr = mmr / (1._r8 - mmr) + end if + + ! convert MMR to VMR, multipy by ratio of dry air molar mas to gas molar mass. + massratio = get_molar_mass_ratio(gas_name) + gas_vmr = mmr * massratio + + ! special case: Setting O3 in the extra layer: + ! + ! For the purpose of attenuating solar fluxes above the CAM model top, we assume that ozone + ! mixing decreases linearly in each column from the value in the top layer of CAM to zero at + ! the pressure level set by P_top. P_top has been set to 50 Pa (0.5 hPa) based on model tuning + ! to produce temperatures at the top of CAM that are most consistent with WACCM at similar pressure levels. + + if ((gas_name == 'O3') .and. (nlay == pverp)) then + P_top = 50.0_r8 + do i = 1, numactivecols + P_int = state%pint(idx(i),1) ! pressure (Pa) at upper interface of CAM + P_mid = state%pmid(idx(i),1) ! pressure (Pa) at midpoint of top layer of CAM + alpha = log(P_int/P_top) + beta = log(P_mid/P_int)/log(P_mid/P_top) + + a = ( (1._r8 + alpha) * exp(-alpha) - 1._r8 ) / alpha + b = 1._r8 - exp(-alpha) + + if (alpha .gt. 0) then ! only apply where top level is below 80 km + chi_mid = gas_vmr(i,1) ! molar mixing ratio of O3 at midpoint of top layer + chi_0 = chi_mid / (1._r8 + beta) + chi_eff = chi_0 * (a + b) + gas_vmr(i,1) = chi_eff + end if + end do + end if + + errmsg = gas_concs%set_vmr(gas_name, gas_vmr) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR, gas_concs%set_vmr: '//trim(errmsg)) + end if + + deallocate(gas_vmr) + deallocate(mmr) + +end subroutine rad_gas_get_vmr + +!================================================================================================== + +subroutine rrtmgp_set_gases_lw(icall, state, pbuf, nlay, gas_concs) + + ! Set gas vmr for the gases in the radconstants module's gaslist. + + ! The memory management for the gas_concs object is internal. The arrays passed to it + ! are copied to the internally allocated memory. Each call to the set_vmr method checks + ! whether the gas already has memory allocated, and if it does that memory is deallocated + ! and new memory is allocated. + + ! arguments + integer, intent(in) :: icall ! index of climate/diagnostic radiation call + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nlay + type(ty_gas_concs), intent(inout) :: gas_concs + + ! local variables + integer :: i, ncol + character(len=*), parameter :: sub = 'rrtmgp_set_gases_lw' + !-------------------------------------------------------------------------------- + + ncol = state%ncol + do i = 1, nradgas + call rad_gas_get_vmr(icall, gaslist(i), state, pbuf, nlay, ncol, gas_concs) + end do +end subroutine rrtmgp_set_gases_lw + +!================================================================================================== + +subroutine rrtmgp_set_gases_sw( & + icall, state, pbuf, nlay, nday, & + idxday, gas_concs) + + ! Return gas_concs with gas volume mixing ratio on DAYLIT columns. + ! Set all gases in radconstants gaslist. + + ! arguments + integer, intent(in) :: icall ! index of climate/diagnostic radiation call + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nlay + integer, intent(in) :: nday + integer, intent(in) :: idxday(:) + type(ty_gas_concs), intent(inout) :: gas_concs + + ! local variables + integer :: i + character(len=*), parameter :: sub = 'rrtmgp_set_gases_sw' + !---------------------------------------------------------------------------- + + ! use the optional argument idxday to specify which columns are sunlit + do i = 1,nradgas + call rad_gas_get_vmr(icall, gaslist(i), state, pbuf, nlay, nday, gas_concs, idxday=idxday) + end do + +end subroutine rrtmgp_set_gases_sw + +!================================================================================================== + +subroutine rrtmgp_set_cloud_lw( & + state, pbuf, ncol, nlay, nlaycam, & + cld, cldfsnow, cldfgrau, cldfprime, graupel_in_rad, & + kdist_lw, cloud_lw, cld_lw_abs_cloudsim, snow_lw_abs_cloudsim, grau_lw_abs_cloudsim) + + ! Compute combined cloud optical properties. + ! Create MCICA stochastic arrays for cloud LW optical properties. + ! Initialize optical properties object (cloud_lw) and load with MCICA columns. + + ! arguments + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: ncol ! number of columns in CAM chunk + integer, intent(in) :: nlay ! number of layers in radiation calculation (may include "extra layer") + integer, intent(in) :: nlaycam ! number of CAM layers in radiation calculation + real(r8), pointer :: cld(:,:) ! cloud fraction (liq+ice) + real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds" + real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds" + real(r8), intent(in) :: cldfprime(pcols,pver) ! combined cloud fraction + + logical, intent(in) :: graupel_in_rad ! use graupel in radiation code + class(ty_gas_optics_rrtmgp), intent(in) :: kdist_lw + type(ty_optical_props_1scl), intent(out) :: cloud_lw + + ! Diagnostic outputs + real(r8), intent(out) :: cld_lw_abs_cloudsim(pcols,pver) ! in-cloud liq+ice optical depth (for COSP) + real(r8), intent(out) :: snow_lw_abs_cloudsim(pcols,pver)! in-cloud snow optical depth (for COSP) + real(r8), intent(out) :: grau_lw_abs_cloudsim(pcols,pver)! in-cloud Graupel optical depth (for COSP) + + ! Local variables + + integer :: i, k + + ! cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: liq_lw_abs(nlwbands,pcols,pver) ! liquid absorption optics depth (LW) + real(r8) :: ice_lw_abs(nlwbands,pcols,pver) ! ice absorption optics depth (LW) + real(r8) :: cld_lw_abs(nlwbands,pcols,pver) ! cloud absorption optics depth (LW) + real(r8) :: snow_lw_abs(nlwbands,pcols,pver) ! snow absorption optics depth (LW) + real(r8) :: grau_lw_abs(nlwbands,pcols,pver) ! graupel absorption optics depth (LW) + real(r8) :: c_cld_lw_abs(nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW) + + ! Arrays for converting from CAM chunks to RRTMGP inputs. + real(r8) :: cldf(ncol,nlaycam) + real(r8) :: tauc(nlwbands,ncol,nlaycam) + real(r8) :: taucmcl(nlwgpts,ncol,nlaycam) + + character(len=128) :: errmsg + character(len=*), parameter :: sub = 'rrtmgp_set_cloud_lw' + !-------------------------------------------------------------------------------- + + ! Combine the cloud optical properties. These calculations are done on CAM "chunks". + + ! gammadist liquid optics + call liquid_cloud_get_rad_props_lw(state, pbuf, liq_lw_abs) + ! Mitchell ice optics + call ice_cloud_get_rad_props_lw(state, pbuf, ice_lw_abs) + + cld_lw_abs(:,:ncol,:) = liq_lw_abs(:,:ncol,:) + ice_lw_abs(:,:ncol,:) + + if (associated(cldfsnow)) then + ! add in snow + call snow_cloud_get_rad_props_lw(state, pbuf, snow_lw_abs) + do i = 1, ncol + do k = 1, pver + if (cldfprime(i,k) > 0._r8) then + c_cld_lw_abs(:,i,k) = ( cldfsnow(i,k)*snow_lw_abs(:,i,k) & + + cld(i,k)*cld_lw_abs(:,i,k) )/cldfprime(i,k) + else + c_cld_lw_abs(:,i,k) = 0._r8 + end if + end do + end do + else + c_cld_lw_abs(:,:ncol,:) = cld_lw_abs(:,:ncol,:) + end if + + ! add in graupel + if (associated(cldfgrau) .and. graupel_in_rad) then + call grau_cloud_get_rad_props_lw(state, pbuf, grau_lw_abs) + do i = 1, ncol + do k = 1, pver + if (cldfprime(i,k) > 0._r8) then + c_cld_lw_abs(:,i,k) = ( cldfgrau(i,k)*grau_lw_abs(:,i,k) & + + cld(i,k)*c_cld_lw_abs(:,i,k) )/cldfprime(i,k) + else + c_cld_lw_abs(:,i,k) = 0._r8 + end if + end do + end do + end if + + ! Cloud optics for COSP + cld_lw_abs_cloudsim = cld_lw_abs(idx_lw_cloudsim,:,:) + snow_lw_abs_cloudsim = snow_lw_abs(idx_lw_cloudsim,:,:) + grau_lw_abs_cloudsim = grau_lw_abs(idx_lw_cloudsim,:,:) + + ! Extract just the layers of CAM where RRTMGP does calculations. + + ! Subset "chunk" data so just the number of CAM layers in the + ! radiation calculation are used by MCICA to produce subcolumns. + cldf = cldfprime(:ncol, ktopcam:) + tauc = c_cld_lw_abs(:, :ncol, ktopcam:) + + ! Enforce tauc >= 0. + tauc = merge(tauc, 0.0_r8, tauc > 0.0_r8) + + ! MCICA uses spectral data (on bands) to construct subcolumns (one per g-point) + call mcica_subcol_lw( & + kdist_lw, nlwbands, nlwgpts, ncol, nlaycam, & + nlwgpts, state%pmid, cldf, tauc, taucmcl ) + + errmsg =cloud_lw%alloc_1scl(ncol, nlay, kdist_lw) + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: cloud_lw%alloc_1scalar: '//trim(errmsg)) + end if + + ! If there is an extra layer in the radiation then this initialization + ! will provide zero optical depths there. + cloud_lw%tau = 0.0_r8 + + ! Set the properties on g-points. + do i = 1, nlwgpts + cloud_lw%tau(:,ktoprad:,i) = taucmcl(i,:,:) + end do + + ! validate checks that: tau > 0 + errmsg = cloud_lw%validate() + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: cloud_lw%validate: '//trim(errmsg)) + end if + +end subroutine rrtmgp_set_cloud_lw + +!================================================================================================== + +subroutine rrtmgp_set_cloud_sw( & + state, pbuf, nlay, nday, idxday, & + nnite, idxnite, pmid, cld, cldfsnow, & + cldfgrau, cldfprime, graupel_in_rad, kdist_sw, cloud_sw, & + tot_cld_vistau, tot_icld_vistau, liq_icld_vistau, ice_icld_vistau, snow_icld_vistau, & + grau_icld_vistau, cld_tau_cloudsim, snow_tau_cloudsim, grau_tau_cloudsim) + + ! Compute combined cloud optical properties. + ! Create MCICA stochastic arrays for cloud SW optical properties. + ! Initialize optical properties object (cloud_sw) and load with MCICA columns. + + ! arguments + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nlay ! number of layers in radiation calculation (may include "extra layer") + integer, intent(in) :: nday ! number of daylight columns + integer, intent(in) :: idxday(pcols) ! indices of daylight columns in the chunk + integer, intent(in) :: nnite ! number of night columns + integer, intent(in) :: idxnite(pcols) ! indices of night columns in the chunk + + real(r8), intent(in) :: pmid(nday,nlay)! pressure at layer midpoints (Pa) used to seed RNG. + + real(r8), pointer :: cld(:,:) ! cloud fraction (liq+ice) + real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds" + real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds" + real(r8), intent(in) :: cldfprime(pcols,pver) ! combined cloud fraction + + logical, intent(in) :: graupel_in_rad ! graupel in radiation code + class(ty_gas_optics_rrtmgp), intent(in) :: kdist_sw ! shortwave gas optics object + type(ty_optical_props_2str), intent(out) :: cloud_sw ! SW cloud optical properties object + + ! Diagnostic outputs + real(r8), intent(out) :: tot_cld_vistau(pcols,pver) ! gbx total cloud optical depth + real(r8), intent(out) :: tot_icld_vistau(pcols,pver) ! in-cld total cloud optical depth + real(r8), intent(out) :: liq_icld_vistau(pcols,pver) ! in-cld liq cloud optical depth + real(r8), intent(out) :: ice_icld_vistau(pcols,pver) ! in-cld ice cloud optical depth + real(r8), intent(out) :: snow_icld_vistau(pcols,pver) ! snow in-cloud visible sw optical depth + real(r8), intent(out) :: grau_icld_vistau(pcols,pver) ! Graupel in-cloud visible sw optical depth + real(r8), intent(out) :: cld_tau_cloudsim(pcols,pver) ! in-cloud liq+ice optical depth (for COSP) + real(r8), intent(out) :: snow_tau_cloudsim(pcols,pver)! in-cloud snow optical depth (for COSP) + real(r8), intent(out) :: grau_tau_cloudsim(pcols,pver)! in-cloud Graupel optical depth (for COSP) + + ! Local variables + + integer :: i, k, ncol + integer :: igpt, nver + integer :: istat + integer, parameter :: changeseed = 1 + + ! cloud radiative parameters are "in cloud" not "in cell" + real(r8) :: ice_tau (nswbands,pcols,pver) ! ice extinction optical depth + real(r8) :: ice_tau_w (nswbands,pcols,pver) ! ice single scattering albedo * tau + real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice asymmetry parameter * tau * w + real(r8) :: liq_tau (nswbands,pcols,pver) ! liquid extinction optical depth + real(r8) :: liq_tau_w (nswbands,pcols,pver) ! liquid single scattering albedo * tau + real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid asymmetry parameter * tau * w + real(r8) :: cld_tau (nswbands,pcols,pver) ! cloud extinction optical depth + real(r8) :: cld_tau_w (nswbands,pcols,pver) ! cloud single scattering albedo * tau + real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud asymmetry parameter * w * tau + real(r8) :: snow_tau (nswbands,pcols,pver) ! snow extinction optical depth + real(r8) :: snow_tau_w (nswbands,pcols,pver) ! snow single scattering albedo * tau + real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow asymmetry parameter * tau * w + real(r8) :: grau_tau (nswbands,pcols,pver) ! graupel extinction optical depth + real(r8) :: grau_tau_w (nswbands,pcols,pver) ! graupel single scattering albedo * tau + real(r8) :: grau_tau_w_g(nswbands,pcols,pver) ! graupel asymmetry parameter * tau * w + real(r8) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth + real(r8) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau + real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud asymmetry parameter * w * tau + + ! RRTMGP does not use this property in its 2-stream calculations. + real(r8) :: sw_tau_w_f(nswbands,pcols,pver) ! Forward scattered fraction * tau * w. + + ! Arrays for converting from CAM chunks to RRTMGP inputs. + real(r8), allocatable :: cldf(:,:) + real(r8), allocatable :: tauc(:,:,:) + real(r8), allocatable :: ssac(:,:,:) + real(r8), allocatable :: asmc(:,:,:) + real(r8), allocatable :: taucmcl(:,:,:) + real(r8), allocatable :: ssacmcl(:,:,:) + real(r8), allocatable :: asmcmcl(:,:,:) + real(r8), allocatable :: day_cld_tau(:,:,:) + real(r8), allocatable :: day_cld_tau_w(:,:,:) + real(r8), allocatable :: day_cld_tau_w_g(:,:,:) + + character(len=128) :: errmsg + character(len=*), parameter :: sub = 'rrtmgp_set_cloud_sw' + !-------------------------------------------------------------------------------- + + ncol = state%ncol + + ! Combine the cloud optical properties. These calculations are done on CAM "chunks". + + ! gammadist liquid optics + call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f) + ! Mitchell ice optics + call get_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, sw_tau_w_f) + + cld_tau(:,:ncol,:) = liq_tau(:,:ncol,:) + ice_tau(:,:ncol,:) + cld_tau_w(:,:ncol,:) = liq_tau_w(:,:ncol,:) + ice_tau_w(:,:ncol,:) + cld_tau_w_g(:,:ncol,:) = liq_tau_w_g(:,:ncol,:) + ice_tau_w_g(:,:ncol,:) + + ! add in snow + if (associated(cldfsnow)) then + call get_snow_optics_sw(state, pbuf, snow_tau, snow_tau_w, snow_tau_w_g, sw_tau_w_f) + do i = 1, ncol + do k = 1, pver + if (cldfprime(i,k) > 0._r8) then + c_cld_tau(:,i,k) = ( cldfsnow(i,k)*snow_tau(:,i,k) & + + cld(i,k)*cld_tau(:,i,k) )/cldfprime(i,k) + c_cld_tau_w(:,i,k) = ( cldfsnow(i,k)*snow_tau_w(:,i,k) & + + cld(i,k)*cld_tau_w(:,i,k) )/cldfprime(i,k) + c_cld_tau_w_g(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_g(:,i,k) & + + cld(i,k)*cld_tau_w_g(:,i,k) )/cldfprime(i,k) + else + c_cld_tau(:,i,k) = 0._r8 + c_cld_tau_w(:,i,k) = 0._r8 + c_cld_tau_w_g(:,i,k) = 0._r8 + end if + end do + end do + else + c_cld_tau(:,:ncol,:) = cld_tau(:,:ncol,:) + c_cld_tau_w(:,:ncol,:) = cld_tau_w(:,:ncol,:) + c_cld_tau_w_g(:,:ncol,:) = cld_tau_w_g(:,:ncol,:) + end if + + ! add in graupel + if (associated(cldfgrau) .and. graupel_in_rad) then + call get_grau_optics_sw(state, pbuf, grau_tau, grau_tau_w, grau_tau_w_g, sw_tau_w_f) + do i = 1, ncol + do k = 1, pver + if (cldfprime(i,k) > 0._r8) then + c_cld_tau(:,i,k) = ( cldfgrau(i,k)*grau_tau(:,i,k) & + + cld(i,k)*c_cld_tau(:,i,k) )/cldfprime(i,k) + c_cld_tau_w(:,i,k) = ( cldfgrau(i,k)*grau_tau_w(:,i,k) & + + cld(i,k)*c_cld_tau_w(:,i,k) )/cldfprime(i,k) + c_cld_tau_w_g(:,i,k) = ( cldfgrau(i,k)*grau_tau_w_g(:,i,k) & + + cld(i,k)*c_cld_tau_w_g(:,i,k) )/cldfprime(i,k) + else + c_cld_tau(:,i,k) = 0._r8 + c_cld_tau_w(:,i,k) = 0._r8 + c_cld_tau_w_g(:,i,k) = 0._r8 + end if + end do + end do + end if + + ! cloud optical properties need to be re-ordered from the RRTMG spectral bands + ! (assumed in the optics datasets) to RRTMGP's + ice_tau(:,:ncol,:) = ice_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + liq_tau(:,:ncol,:) = liq_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + c_cld_tau(:,:ncol,:) = c_cld_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + c_cld_tau_w(:,:ncol,:) = c_cld_tau_w(rrtmg_to_rrtmgp_swbands,:ncol,:) + c_cld_tau_w_g(:,:ncol,:) = c_cld_tau_w_g(rrtmg_to_rrtmgp_swbands,:ncol,:) + if (associated(cldfsnow)) then + snow_tau(:,:ncol,:) = snow_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + end if + if (associated(cldfgrau) .and. graupel_in_rad) then + grau_tau(:,:ncol,:) = grau_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + end if + + ! Set arrays for diagnostic output. + ! cloud optical depth fields for the visible band + tot_icld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:) + liq_icld_vistau(:ncol,:) = liq_tau(idx_sw_diag,:ncol,:) + ice_icld_vistau(:ncol,:) = ice_tau(idx_sw_diag,:ncol,:) + if (associated(cldfsnow)) then + snow_icld_vistau(:ncol,:) = snow_tau(idx_sw_diag,:ncol,:) + endif + if (associated(cldfgrau) .and. graupel_in_rad) then + grau_icld_vistau(:ncol,:) = grau_tau(idx_sw_diag,:ncol,:) + endif + + ! multiply by total cloud fraction to get gridbox value + tot_cld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:)*cldfprime(:ncol,:) + + ! overwrite night columns with fillvalue + do i = 1, Nnite + tot_cld_vistau(IdxNite(i),:) = fillvalue + tot_icld_vistau(IdxNite(i),:) = fillvalue + liq_icld_vistau(IdxNite(i),:) = fillvalue + ice_icld_vistau(IdxNite(i),:) = fillvalue + if (associated(cldfsnow)) then + snow_icld_vistau(IdxNite(i),:) = fillvalue + end if + if (associated(cldfgrau) .and. graupel_in_rad) then + grau_icld_vistau(IdxNite(i),:) = fillvalue + end if + end do + + ! Cloud optics for COSP + cld_tau_cloudsim = cld_tau(idx_sw_cloudsim,:,:) + snow_tau_cloudsim = snow_tau(idx_sw_cloudsim,:,:) + grau_tau_cloudsim = grau_tau(idx_sw_cloudsim,:,:) + + ! if no daylight columns the cloud_sw object isn't initialized + if (nday > 0) then + + ! number of CAM's layers in radiation calculation. Does not include the "extra layer". + nver = pver - ktopcam + 1 + + allocate( & + cldf(nday,nver), & + day_cld_tau(nswbands,nday,nver), & + day_cld_tau_w(nswbands,nday,nver), & + day_cld_tau_w_g(nswbands,nday,nver), & + tauc(nswbands,nday,nver), taucmcl(nswgpts,nday,nver), & + ssac(nswbands,nday,nver), ssacmcl(nswgpts,nday,nver), & + asmc(nswbands,nday,nver), asmcmcl(nswgpts,nday,nver), stat=istat) + call alloc_err(istat, sub, 'cldf,..,asmcmcl', 9*nswgpts*nday*nver) + + ! Subset "chunk" data so just the daylight columns, and the number of CAM layers in the + ! radiation calculation are used by MCICA to produce subcolumns. + cldf = cldfprime( idxday(1:nday), ktopcam:) + day_cld_tau = c_cld_tau( :, idxday(1:nday), ktopcam:) + day_cld_tau_w = c_cld_tau_w( :, idxday(1:nday), ktopcam:) + day_cld_tau_w_g = c_cld_tau_w_g(:, idxday(1:nday), ktopcam:) + + ! Compute the optical properties needed for the 2-stream calculations. These calculations + ! are the same as the RRTMG version. + + ! set cloud optical depth, clip @ zero + tauc = merge(day_cld_tau, 0.0_r8, day_cld_tau > 0.0_r8) + ! set value of asymmetry + asmc = merge(day_cld_tau_w_g / max(day_cld_tau_w, tiny), 0.0_r8, day_cld_tau_w > 0.0_r8) + ! set value of single scattering albedo + ssac = merge(max(day_cld_tau_w, tiny) / max(tauc, tiny), 1.0_r8 , tauc > 0.0_r8) + ! set asymmetry to zero when tauc = 0 + asmc = merge(asmc, 0.0_r8, tauc > 0.0_r8) + + ! MCICA uses spectral data (on bands) to construct subcolumns (one per g-point) + call mcica_subcol_sw( & + kdist_sw, nswbands, nswgpts, nday, nlay, & + nver, changeseed, pmid, cldf, tauc, & + ssac, asmc, taucmcl, ssacmcl, asmcmcl) + + ! Initialize object for SW cloud optical properties. + errmsg = cloud_sw%alloc_2str(nday, nlay, kdist_sw) + if (len_trim(errmsg) > 0) then + call endrun(trim(sub)//': ERROR: cloud_sw%alloc_2str: '//trim(errmsg)) + end if + + ! If there is an extra layer in the radiation then this initialization + ! will provide the optical properties there. + cloud_sw%tau = 0.0_r8 + cloud_sw%ssa = 1.0_r8 + cloud_sw%g = 0.0_r8 + + ! Set the properties on g-points. + do igpt = 1,nswgpts + cloud_sw%g (:,ktoprad:,igpt) = asmcmcl(igpt,:,:) + cloud_sw%ssa(:,ktoprad:,igpt) = ssacmcl(igpt,:,:) + cloud_sw%tau(:,ktoprad:,igpt) = taucmcl(igpt,:,:) + end do + + ! validate checks that: tau > 0, ssa is in range [0,1], and g is in range [-1,1]. + errmsg = cloud_sw%validate() + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: cloud_sw%validate: '//trim(errmsg)) + end if + + ! delta scaling adjusts for forward scattering + errmsg = cloud_sw%delta_scale() + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: cloud_sw%delta_scale: '//trim(errmsg)) + end if + + ! All information is in cloud_sw, now deallocate local vars. + deallocate( & + cldf, tauc, ssac, asmc, & + taucmcl, ssacmcl, asmcmcl,& + day_cld_tau, day_cld_tau_w, day_cld_tau_w_g ) + + end if + +end subroutine rrtmgp_set_cloud_sw + +!================================================================================================== + +subroutine rrtmgp_set_aer_lw(icall, state, pbuf, aer_lw) + + ! Load LW aerosol optical properties into the RRTMGP object. + + ! Arguments + integer, intent(in) :: icall + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + + type(ty_optical_props_1scl), intent(inout) :: aer_lw + + ! Local variables + integer :: ncol + + ! Aerosol LW absorption optical depth + real(r8) :: aer_lw_abs (pcols,pver,nlwbands) + + character(len=*), parameter :: sub = 'rrtmgp_set_aer_lw' + character(len=128) :: errmsg + !-------------------------------------------------------------------------------- + + ncol = state%ncol + + ! Get aerosol longwave optical properties. + call aer_rad_props_lw(icall, state, pbuf, aer_lw_abs) + + ! If there is an extra layer in the radiation then this initialization + ! will provide zero optical depths there. + aer_lw%tau = 0.0_r8 + + aer_lw%tau(:ncol, ktoprad:, :) = aer_lw_abs(:ncol, ktopcam:, :) + + errmsg = aer_lw%validate() + if (len_trim(errmsg) > 0) then + call endrun(sub//': ERROR: aer_lw%validate: '//trim(errmsg)) + end if +end subroutine rrtmgp_set_aer_lw + +!================================================================================================== + +subroutine rrtmgp_set_aer_sw( & + icall, state, pbuf, nday, idxday, nnite, idxnite, aer_sw) + + ! Load SW aerosol optical properties into the RRTMGP object. + + ! Arguments + integer, intent(in) :: icall + type(physics_state), target, intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + integer, intent(in) :: nday + integer, intent(in) :: idxday(:) + integer, intent(in) :: nnite ! number of night columns + integer, intent(in) :: idxnite(pcols) ! indices of night columns in the chunk + + type(ty_optical_props_2str), intent(inout) :: aer_sw + + ! local variables + integer :: i + + ! The optical arrays dimensioned in the vertical as 0:pver. + ! The index 0 is for the extra layer used in the radiation + ! calculation. The index ktopcam assumes the CAM vertical indices are + ! in the range 1:pver, so using this index correctly ignores vertical + ! index 0. If an "extra" layer is used in the calculations, it is + ! provided and set in the RRTMGP aerosol object aer_sw. + real(r8) :: aer_tau (pcols,0:pver,nswbands) ! extinction optical depth + real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! single scattering albedo * tau + real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! asymmetry parameter * w * tau + real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! forward scattered fraction * w * tau + ! aer_tau_w_f is not used by RRTMGP. + character(len=*), parameter :: sub = 'rrtmgp_set_aer_sw' + !-------------------------------------------------------------------------------- + + ! Get aerosol shortwave optical properties. + ! Make outfld calls for aerosol optical property diagnostics. + call aer_rad_props_sw( & + icall, state, pbuf, nnite, idxnite, & + aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f) + + ! The aer_sw object is only initialized if nday > 0. + if (nday > 0) then + + ! aerosol optical properties need to be re-ordered from the RRTMG spectral bands + ! (as assumed in the optics datasets) to the RRTMGP band order. + aer_tau(:,:,:) = aer_tau( :,:,rrtmg_to_rrtmgp_swbands) + aer_tau_w(:,:,:) = aer_tau_w( :,:,rrtmg_to_rrtmgp_swbands) + aer_tau_w_g(:,:,:) = aer_tau_w_g(:,:,rrtmg_to_rrtmgp_swbands) + + ! If there is an extra layer in the radiation then this initialization + ! will provide default values. + aer_sw%tau = 0.0_r8 + aer_sw%ssa = 1.0_r8 + aer_sw%g = 0.0_r8 + + ! CAM fields are products tau, tau*ssa, tau*ssa*asy + ! Fields expected by RRTMGP are computed by + ! aer_sw%tau = aer_tau + ! aer_sw%ssa = aer_tau_w / aer_tau + ! aer_sw%g = aer_tau_w_g / aer_taw_w + ! aer_sw arrays have dimensions of (nday,nlay,nswbands) + + do i = 1, nday + ! set aerosol optical depth, clip to zero + aer_sw%tau(i,ktoprad:,:) = max(aer_tau(idxday(i),ktopcam:,:), 0._r8) + ! set value of single scattering albedo + aer_sw%ssa(i,ktoprad:,:) = merge(aer_tau_w(idxday(i),ktopcam:,:)/aer_tau(idxday(i),ktopcam:,:), & + 1._r8, aer_tau(idxday(i),ktopcam:,:) > 0._r8) + ! set value of asymmetry + aer_sw%g(i,ktoprad:,:) = merge(aer_tau_w_g(idxday(i),ktopcam:,:)/aer_tau_w(idxday(i),ktopcam:,:), & + 0._r8, aer_tau_w(idxday(i),ktopcam:,:) > tiny) + end do + + ! impose limits on the components + aer_sw%ssa = min(max(aer_sw%ssa, 0._r8), 1._r8) + aer_sw%g = min(max(aer_sw%g, -1._r8), 1._r8) + + end if + +end subroutine rrtmgp_set_aer_sw + +!================================================================================================== + +end module rrtmgp_inputs diff --git a/src/physics/simple/frierson.F90 b/src/physics/simple/frierson.F90 new file mode 100644 index 0000000000..08e524bbdc --- /dev/null +++ b/src/physics/simple/frierson.F90 @@ -0,0 +1,1174 @@ +module frierson +!------------------------------------------------------------------------------------ +! +! Purpose: Implement idealized forcings described in +! Frierson, et al. (2006), "A Gray-Radiation +! Aquaplanet Moist GCM. Part I. Static Stability and Eddy Scale" +! J. Atmos. Sci., Vol. 63, 2548-2566. +! +! DOI: https://doi.org/10.1175/JAS3753.1 +! +!==================================================================================== + ! + ! The only modules that are permitted + !-------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_const_mod, only: pi => shr_const_pi + + ! Set all Global values and routine to private by default + ! and then explicitly set their exposure + !--------------------------------------------------------- + implicit none + private + save + + public:: frierson_set_const + public:: frierson_condensate_NONE + public:: frierson_condensate + public:: frierson_condensate_TJ16 + public:: frierson_condensate_USER + public:: frierson_pbl + public:: frierson_pbl_USER + public:: frierson_radiation + public:: frierson_radiation_USER + + ! Global Tuning Parameters: + ! T0 and E0 are the temperature and saturation vapor pressure used + ! to calculate qsat values, the saturation value for Q (kg/kg) + !-------------------------------------------------------------------- + real(r8):: T0 + real(r8):: E0 + real(r8):: Erad + real(r8):: Wind_min + real(r8):: Z0 + real(r8):: Ri_c + real(r8):: Karman + real(r8):: Fb + real(r8):: Rs0 + real(r8):: DeltaS + real(r8):: Tau_eqtr + real(r8):: Tau_pole + real(r8):: LinFrac + real(r8):: Boltz + real(r8):: C_ocn + + ! Private data + !---------------------- + real(r8),private :: gravit ! g: gravitational acceleration (m/s2) + real(r8),private :: cappa ! Rd/cp + real(r8),private :: rair ! Rd: dry air gas constant (J/K/kg) + real(r8),private :: cpair ! cp: specific heat of dry air (J/K/kg) + real(r8),private :: latvap ! L: latent heat of vaporization (J/kg) + real(r8),private :: rh2o ! Rv: water vapor gas constant (J/K/kg) + real(r8),private :: epsilo ! Rd/Rv: ratio of h2o to dry air molecular weights + real(r8),private :: rhoh2o ! density of liquid water (kg/m3) + real(r8),private :: zvir ! (rh2o/rair) - 1, needed for virtual temperature + real(r8),private :: ps0 ! Base state surface pressure (Pa) + + real(r8),private :: latvap_div_cpair ! latvap/cpair + real(r8),private :: latvap_div_rh2o ! latvap/rh2o + + real(r8),private,allocatable:: etamid(:) ! hybrid coordinate - midpoints + + +contains + !======================================================================= + subroutine frierson_set_const(I_gravit,I_cappa ,I_rair ,I_cpair ,I_latvap , & + I_rh2o ,I_epsilo ,I_rhoh2o ,I_zvir ,I_ps0 , & + I_etamid,I_T0 ,I_E0 ,I_Erad ,I_Wind_min, & + I_Z0 ,I_Ri_c ,I_Karman ,I_Fb ,I_Rs0 , & + I_DeltaS,I_Tau_eqtr,I_Tau_pole,I_LinFrac,I_Boltz , & + I_Cocn ) + ! + ! frierson_set_const: Set parameters and constants for the Frierson + ! Model fomulation. Optional inputs can be provided + ! to over-ride the model defaults. + !===================================================================== + + use cam_abortutils, only: handle_allocate_error + + ! + ! Passed Variables + !------------------- + real(r8),intent(in):: I_gravit + real(r8),intent(in):: I_cappa + real(r8),intent(in):: I_rair + real(r8),intent(in):: I_cpair + real(r8),intent(in):: I_latvap + real(r8),intent(in):: I_rh2o + real(r8),intent(in):: I_epsilo + real(r8),intent(in):: I_rhoh2o + real(r8),intent(in):: I_zvir + real(r8),intent(in):: I_ps0 + real(r8),intent(in):: I_etamid(:) + + real(r8),intent(in) :: I_T0 + real(r8),intent(in) :: I_E0 + real(r8),intent(in) :: I_Erad + real(r8),intent(in) :: I_Wind_min + real(r8),intent(in) :: I_Z0 + real(r8),intent(in) :: I_Ri_c + real(r8),intent(in) :: I_Karman + real(r8),intent(in) :: I_Fb + real(r8),intent(in) :: I_Rs0 + real(r8),intent(in) :: I_DeltaS + real(r8),intent(in) :: I_Tau_eqtr + real(r8),intent(in) :: I_Tau_pole + real(r8),intent(in) :: I_LinFrac + real(r8),intent(in) :: I_Boltz + real(r8),intent(in) :: I_Cocn + + integer :: ierr + + ! Set global constants for later use + !------------------------------------ + gravit = I_gravit + cappa = I_cappa + rair = I_rair + cpair = I_cpair + latvap = I_latvap + rh2o = I_rh2o + epsilo = I_epsilo + rhoh2o = I_rhoh2o + zvir = I_zvir + ps0 = I_ps0 + T0 = I_T0 + E0 = I_E0 + Erad = I_Erad + Wind_min = I_Wind_min + Z0 = I_Z0 + Ri_c = I_Ri_c + Karman = I_Karman + Fb = I_Fb + Rs0 = I_Rs0 + DeltaS = I_DeltaS + Tau_eqtr = I_Tau_eqtr + Tau_pole = I_Tau_pole + LinFrac = I_LinFrac + Boltz = I_Boltz + C_ocn = I_Cocn + + latvap_div_cpair = latvap/cpair + latvap_div_rh2o = latvap/rh2o + + ! allocate space and set the level information + !---------------------------------------------- + allocate(etamid(size(I_etamid)),stat=ierr) + if (ierr /= 0) then + call handle_allocate_error(ierr, 'frierson_set_const', 'etamid') + end if + + etamid = I_etamid + + end subroutine frierson_set_const + !======================================================================= + + + !======================================================================= + subroutine frierson_condensate_NONE(ncol,pver,pmid,T,qv,relhum,precl) + ! + ! Precip_process: Implement NO large-scale condensation/precipitation + !======================================================================= + ! + ! Passed Variables + !--------------------- + integer ,intent(in) :: ncol ! number of columns + integer ,intent(in) :: pver ! number of vertical levels + real(r8),intent(in) :: pmid (ncol,pver) ! mid-point pressure (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) + ! + ! Local Values + !------------- + real(r8):: qsat + integer :: i, k + + ! Set large scale precipitation rates to zero + !-------------------------------------------------------------------------- + precl(:) = 0.0_r8 + + ! Large-Scale Condensation and Precipitation without cloud stage + !--------------------------------------------------------------- + do k = 1, pver + do i = 1, ncol + ! calculate saturation value for Q + !---------------------------------- + qsat = epsilo*E0/pmid(i,k)*exp(-latvap_div_rh2o*((1._r8/T(i,k))-1._r8/T0)) + + ! Set percent relative humidity + !------------------------------- + relhum(i,k) = (qv(i,k)/qsat)*100._r8 + end do + end do + + end subroutine frierson_condensate_NONE + !======================================================================= + + + !======================================================================= + subroutine frierson_condensate(ncol,pver,dtime,pmid,pdel,T,qv,relhum,precl,evapdt,evapdq) + ! + ! Precip_process: Implement large-scale condensation/precipitation + ! from Frierson 2006. + ! + !======================================================================= + ! + ! Passed Variables + !--------------------- + 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) :: evapdt(ncol,pver) ! T tendency due to re-evaporation + real(r8),intent(out) :: evapdq(ncol,pver) ! Q tendency due to re-evaporation + ! + ! Local Values + !------------- + logical,parameter :: do_evap = .true. + + real(r8):: esat (ncol,pver) + real(r8):: qsat (ncol,pver) + real(r8):: dqsat(ncol,pver) + real(r8):: qdel (ncol,pver) + real(r8):: tdel (ncol,pver) + real(r8):: qnew (ncol,pver) + real(r8):: tnew (ncol,pver) + real(r8):: qext (ncol) + real(r8):: qdef (ncol) + + integer :: i, k + + ! Large-Scale Condensation and Precipitation + !-------------------------------------------- + do k = 1,pver + + ! calculate saturation vapor pressure + !------------------------------------- + esat(:,k) = E0*exp(-(latvap_div_rh2o)*((1._r8/T(:,k))-1._r8/T0)) + + ! calculate saturation value for Q + !---------------------------------- + do i = 1,ncol + if(pmid(i,k) > (1._r8-epsilo)*esat(i,k)) then + qsat (i,k) = epsilo*esat(i,k)/pmid(i,k) + dqsat(i,k) = (latvap_div_rh2o)*qsat(i,k)/(T(i,k)**2) + else + qsat (i,k) = 0._r8 + dqsat(i,k) = 0._r8 + endif + end do + + ! if > 100% relative humidity, rain falls out + !--------------------------------------------- + where(((qv(:,k)-qsat(:,k))*qsat(:,k)) > 0._r8) + qdel (:,k) = (qsat(:,k)-qv(:,k))/(1._r8+(latvap_div_cpair)*dqsat(:,k)) + tdel (:,k) = -(latvap_div_cpair)*qdel(:,k) + else where + qdel (:,k) = 0._r8 + tdel (:,k) = 0._r8 + end where + + ! Update temperature and water vapor + !----------------------------------- + qnew(:,k) = qv(:,k) + qdel(:,k) + tnew(:,k) = T(:,k) + tdel(:,k) + end do + + ! optionally allow for re-evaporation of falling precip + !------------------------------------------------------- + if(do_evap) then + ! Initialize work array for excess Q + !-------------------------------------- + qext(:) = 0._r8 + + ! Loop down thru the model levels + !--------------------------------- + do k = 1, pver + + ! Add qdel for the current level to the excess + !---------------------------------------------- + where(qdel(:,k) < 0._r8) qext(:) = qext(:) - qdel(:,k)*pdel(:,k)/gravit + + ! Evaporate excess Q where needed + !---------------------------------- + qdef(:) = 0._r8 + where((qdel(:,k) >= 0._r8).and.(qext(:) > 0._r8)) + qext(:) = qext(:)*gravit/pdel(:,k) + qdef(:) = (qsat(:,k)-qv(:,k))/(1._r8+(latvap_div_cpair)*dqsat(:,k)) + qdef(:) = min(qext(:),max(qdef(:),0._r8)) + qdel(:,k) = qdel(:,k) + qdef(:) + tdel(:,k) = tdel(:,k) -(latvap_div_cpair)*qdef(:) + qext(:) = (qext(:)-qdef(:))*pdel(:,k)/gravit + + ! Update temperature and water vapor + !----------------------------------- + qnew(:,k) = qv(:,k) + qdel(:,k) + tnew(:,k) = T(:,k) + tdel(:,k) + end where + + ! Save T/Q tendencies due to re-evaporation + !-------------------------------------------- + evapdq(:,k) = qdef(:)/dtime + evapdt(:,k) = -qdef(:)*latvap_div_cpair/dtime + end do ! k = 1, pver + else + ! Set T/Q re-evaporation tendencies to 0 + !-------------------------------------------- + evapdt(:,:) = 0._r8 + evapdq(:,:) = 0._r8 + endif + + ! Set large scale precipitation rates to zero + !-------------------------------------------------------------------------- + precl(:) = 0.0_r8 + + ! Calculate resulting precip value and relative humidity + !-------------------------------------------------------- + do k = 1, pver + precl (:) = precl(:) - (qdel(:,k)*pdel(:,k))/(gravit*rhoh2o) + qsat (:,k) = (epsilo/pmid(:,k))*E0*exp(-latvap_div_rh2o*((1._r8/tnew(:,k))-1._r8/T0)) + relhum(:,k) = (qnew(:,k)/qsat (:,k))*100._r8 + end do + precl(:) = max(precl(:),0._r8)/dtime + + ! Update T and qv values due to precipitation + !-------------------------------------------- + qv(:,:) = qnew(:,:) + T (:,:) = tnew(:,:) + + end subroutine frierson_condensate + !======================================================================= + + + !======================================================================= + subroutine frierson_condensate_TJ16(ncol,pver,dtime,pmid,pdel,T,qv,relhum,precl) + ! + ! Precip_process: Implement large-scale condensation/precipitation + ! from TJ16. + ! + !======================================================================= + ! + ! Passed Variables + !--------------------- + 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) + ! + ! Local Values + !------------- + real(r8):: qsat + real(r8):: Crate + integer :: i, k + + ! Set large scale precipitation rates to zero + !-------------------------------------------------------------------------- + precl(:) = 0.0_r8 + + ! Large-Scale Condensation and Precipitation without cloud stage + !--------------------------------------------------------------- + do k = 1, pver + do i = 1, ncol + ! calculate saturation value for Q + !---------------------------------- + qsat = epsilo*E0/pmid(i,k)*exp(-latvap_div_rh2o*((1._r8/T(i,k))-1._r8/T0)) + + ! if > 100% relative humidity rain falls out + !------------------------------------------- + if(qv(i,k) > qsat) then + ! calc the condensation and large-scale precipitation(m/s) rates + !------------------------------------------------------------------- + Crate = ((qv(i,k)-qsat)/dtime) & + /(1._r8+(latvap_div_cpair)*(epsilo*latvap*qsat/(rair*T(i,k)**2))) + precl(i) = precl(i) + (Crate*pdel(i,k))/(gravit*rhoh2o) + + ! Update T and qv values due to precipitation + !-------------------------------------------- + T (i,k) = T (i,k) + Crate*(latvap_div_cpair)*dtime + qv(i,k) = qv(i,k) - Crate*dtime + + ! recompute qsat with updated T + !------------------------------- + qsat = epsilo*E0/pmid(i,k)*exp(-latvap_div_rh2o*((1._r8/T(i,k))-1._r8/T0)) + endif + + ! Set percent relative humidity + !------------------------------- + relhum(i,k) = (qv(i,k)/qsat)*100._r8 + end do + end do + + end subroutine frierson_condensate_TJ16 + !======================================================================= + + + !======================================================================= + subroutine frierson_condensate_USER(ncol,pver,dtime,pmid,pdel,T,qv,relhum,precl) + ! + ! frierson_condensate_USER: This routine is a stub which users can use + ! to develop and test their own large scale + ! condensation scheme + !======================================================================= + ! + ! Passed Variables + !--------------------- + 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) + ! + ! Local Values + !------------- + real(r8):: qsat + integer :: i, k + + ! Set large scale precipitation rates to zero + !-------------------------------------------------------------------------- + precl(:) = 0.0_r8 + + ! Large-Scale Condensation and Precipitation without cloud stage + !--------------------------------------------------------------- + do k = 1, pver + do i = 1, ncol + ! calculate saturation value for Q + !---------------------------------- + qsat = epsilo*E0/pmid(i,k)*exp(-latvap_div_rh2o*((1._r8/T(i,k))-1._r8/T0)) + + ! Set percent relative humidity + !------------------------------- + relhum(i,k) = (qv(i,k)/qsat)*100._r8 + end do + end do + + end subroutine frierson_condensate_USER + !======================================================================= + + + !======================================================================= + subroutine frierson_pbl(ncol, pver, dtime, pmid, pint, Zm, Zi, & + Psfc, Tsfc, Qsfc, T, U, V, Q, Fsw, Fdn, & + Cdrag, Km, Ke, VSE, Z_pbl, Rf, dQa, dTa, dUa, dVa, & + LHflux, SHflux, TUflux, TVflux ) + ! + ! The implicit PBL parameterization based on Frierson, et al. 2006. + ! + ! frierson_pbl: This is an implementation of the implicit computation + ! derived from the code of the Frierson model. The + ! calculations are roughly divided up into sections of + ! the model where they should be carried out. + ! + !========================================================================== + ! + ! Passed Variables + !------------------ + integer ,intent(in) :: ncol ! Number of columns + integer ,intent(in) :: pver ! Number of levels + real(r8),intent(in) :: dtime ! Time Step + real(r8),intent(in) :: pmid (ncol,pver) ! Pressure at model levels + real(r8),intent(in) :: pint (ncol,pver+1) ! Pressure at interface levels. + real(r8),intent(in) :: Zm (ncol,pver) ! Height at model levels. + real(r8),intent(in) :: Zi (ncol,pver) ! Height at interface levels. + real(r8),intent(in) :: Psfc (ncol) ! Surface Pressure. + real(r8),intent(inout):: Tsfc (ncol) ! SST temperature K + real(r8),intent(inout):: Qsfc (ncol) ! sea surface water vapor (kg/kg) + real(r8),intent(inout):: T (ncol,pver) ! ATM Temperature values. + real(r8),intent(inout):: U (ncol,pver) ! ATM Zonal Wind values. + real(r8),intent(inout):: V (ncol,pver) ! ATM Meridional Wind values. + real(r8),intent(inout):: Q (ncol,pver) ! ATM Water vapor values. + real(r8),intent(in) :: Fdn (ncol) ! Downward LW flux at surface + real(r8),intent(in) :: Fsw (ncol) ! Net SW flux at surface from gray radiation + real(r8),intent(out) :: Cdrag (ncol) ! Surface drage coef. + real(r8),intent(out) :: Km (ncol,pver+1) ! Eddy diffusivity for PBL (momentum) + real(r8),intent(out) :: Ke (ncol,pver+1) ! Eddy diffusivity for PBL + real(r8),intent(out) :: VSE (ncol,pver) ! Virtual-Dry Static energy + real(r8),intent(out) :: Z_pbl (ncol) ! Height of PBL layer. + real(r8),intent(out) :: Rf (ncol,pver) + real(r8),intent(out) :: dTa (ncol,pver) + real(r8),intent(out) :: dQa (ncol,pver) + real(r8),intent(out) :: dUa (ncol,pver) + real(r8),intent(out) :: dVa (ncol,pver) + real(r8),intent(out) :: LHflux(ncol) ! Latent Heat Flux + real(r8),intent(out) :: SHflux(ncol) ! Sensible Heat Flux + real(r8),intent(out) :: TUflux(ncol) ! U Surface stress + real(r8),intent(out) :: TVflux(ncol) ! V Surface stress + ! + ! Local Values + !--------------- + real(r8):: Tv (ncol,pver) + real(r8):: Thv (ncol,pver) + real(r8):: Ws (ncol,pver) + real(r8):: rho (ncol) ! Air density near the ground (kg/m3) + real(r8):: Z_sfc (ncol) + real(r8):: Rf_sfc(ncol) + real(r8):: Ri_a (ncol) + real(r8):: Ri (ncol,pver) + integer :: K_sfc (ncol) + integer :: K_pbl (ncol) + real(r8):: Ke_pbl(ncol) + real(r8):: Km_pbl(ncol) + real(r8):: Z_a (ncol) ! Height at midpoint of the lowest model level (m) + real(r8):: Ws_a (ncol) ! wind speed at the lowest model level (m/s) + real(r8):: Thv_a (ncol) + real(r8):: Thv_s (ncol) + real(r8):: Ustar (ncol) + real(r8):: Bstar (ncol) + real(r8):: ZETA,PHI + + real(r8):: MU (ncol,pver) + real(r8):: NUe(ncol,pver) + real(r8):: NUm(ncol,pver) + real(r8):: Am (ncol,pver) + real(r8):: Bm (ncol,pver) + real(r8):: Cm (ncol,pver) + real(r8):: Ae (ncol,pver) + real(r8):: Be (ncol,pver) + real(r8):: Ce (ncol,pver) + real(r8):: FLu(ncol,pver) + real(r8):: FLv(ncol,pver) + real(r8):: FLq(ncol,pver) + real(r8):: FLt(ncol,pver) + real(r8):: Et (ncol,pver) + real(r8):: Eq (ncol,pver) + real(r8):: Eu (ncol,pver) + real(r8):: Ev (ncol,pver) + + real(r8):: Fval_t(ncol,pver) + real(r8):: Fval_q(ncol,pver) + real(r8):: Fval_u(ncol,pver) + real(r8):: Fval_v(ncol,pver) + real(r8):: Eval_m(ncol,pver) + real(r8):: Eval_e(ncol,pver) + integer :: i, k + + real(r8):: Su(ncol,pver) + real(r8):: Sv(ncol,pver) + real(r8):: St(ncol,pver) + real(r8):: Sq(ncol,pver) + + real(r8):: Estar_u(ncol) + real(r8):: Estar_v(ncol) + real(r8):: Estar_q(ncol) + real(r8):: Estar_t(ncol) + real(r8):: dFa_dTa(ncol) + real(r8):: dFa_dQa(ncol) + real(r8):: dFa_dUa(ncol) + real(r8):: dFa_dVa(ncol) + + real(r8):: Th_a (ncol) + real(r8):: Th_s (ncol) + real(r8):: Ft (ncol) + real(r8):: dFt_dTa (ncol) + real(r8):: dFt_dTs (ncol) + real(r8):: Fq (ncol) + real(r8):: dFq_dQa (ncol) + real(r8):: dFq_dTs (ncol) + real(r8):: Fu (ncol) + real(r8):: dFu_dUa (ncol) + real(r8):: Fv (ncol) + real(r8):: dFv_dVa (ncol) + real(r8):: Fup (ncol) + real(r8):: dFup_dTs(ncol) + + real(r8):: FN_u (ncol) + real(r8):: FN_v (ncol) + real(r8):: EN_t (ncol) + real(r8):: FN_t (ncol) + real(r8):: EN_q (ncol) + real(r8):: FN_q (ncol) + real(r8):: Flux (ncol) + real(r8):: dFlux(ncol) + real(r8):: dTs (ncol) + + real(r8):: Tsfc_bc(ncol) + + !============================================================================ + ! tphysbc(): + ! + ! Required Values: + ! T(:,:),Q(:,:),U(:,:),V(:,:) + ! Pmid(:,:),Pint(:,:),Zm(:,:),Zi(:,:) + ! Tsfc(:),Qsfc(:),Psfc(:) + !============================================================================ + + ! Sx() values allow for explicit source tendencies to be passed to + ! implicit PBL calculation. Set all values to 0. for now. + !------------------------------------------------------------------------- + Su(:,:) = 0._r8 + Sv(:,:) = 0._r8 + St(:,:) = 0._r8 + Sq(:,:) = 0._r8 + + ! Calc some values we will need later on + !------------------------------------------ + do k = 1, pver + Ws (:,k) = sqrt(U(:,k)**2 + V(:,k)**2 + Wind_min) + Tv (:,k) = T (:,k)*(1._r8+zvir*Q(:,k)) + Thv(:,k) = Tv(:,k)*((ps0/pmid(:,k))**cappa) + VSE(:,k) = Tv(:,k)+gravit*Zm(:,k)/cpair + end do + + ! Calculate Drag Coef and related values + !----------------------------------------- + do i = 1,ncol + Z_a (i) = Zm (i,pver) + Ws_a (i) = Ws (i,pver) + Thv_a(i) = Thv(i,pver) + Thv_s(i) = Tsfc(i)*(1._r8+zvir*Qsfc(i) )*((ps0/Psfc(i))**cappa) + Ri_a (i) = (gravit*Z_a(i)/(Ws_a(i)**2))*(Thv_a(i)-Thv_s(i))/Thv_s(i) + if(Ri_a(i) <= 0._r8) then + Cdrag(i) = (Karman/log((Z_a(i)/Z0)))**2 + elseif(Ri_a(i) >= Ri_c) then + Cdrag(i) = 0._r8 + else + Cdrag(i) = ((1._r8-(Ri_a(i)/Ri_c))*Karman/log((Z_a(i)/Z0)))**2 + endif + Ustar(i) = sqrt(Cdrag(i))*Ws_a(i) + Bstar(i) = sqrt(Cdrag(i))*(gravit*(Thv_a(i)-Thv_s(i))/Thv_s(i)) + end do + + ! Calculate a bulk Richardson number and determine + ! depths of boundary/surface layers. + !---------------------------------------------------- + do k = 1,pver + Ri(:,k) = (gravit*Zm(:,k)/(Ws(:,k)**2))*(VSE(:,k)-VSE(:,pver))/VSE(:,pver) + Rf(:,k) = Ri(:,k)/Ri_c + end do + + do i =1,ncol + Z_pbl(i) = Zm(i,pver) + K_pbl(i) = pver + do k = (pver-1),1,-1 + if(Rf(i,k) > 1._r8) then + K_pbl(i) = k + 1 + Z_pbl(i) = (Zm(i,k+1)*(Rf(i,k)- 1._r8 ) & + +Zm(i,k )*( 1._r8 - Rf(i,k+1)))/(Rf(i,k)-Rf(i,k+1)) + exit + endif + end do + + ! surface layer height is a fixed fraction of the PBL + ! determine the corresponding level index and Rf value + !----------------------------------------------------- + Z_sfc(i) = Fb*Z_pbl(i) + K_sfc(i) = pver + do k = (pver-1),1,-1 + if(Zm(i,k) > Z_sfc(i)) then + K_sfc (i) = k + 1 + Rf_sfc(i) = (Rf(i,k+1)*(Zm(i,k) - Z_sfc(i) ) & + + Rf(i,k )*(Z_sfc(i) - Zm(i,k+1)))/(Zm(i,k)-Zm(i,k+1)) + exit + endif + end do + end do ! i =1,ncol + + ! Compute diffusion coefs + !------------------------- + Ke(:,:) = 0._r8 + Ke_pbl(:) = 0._r8 + do i = 1,ncol + if (Cdrag(i) /= 0._r8) then + do k = pver,K_pbl(i),-1 + ZETA = Zi(i,k)*Karman*Bstar(i)/(Ustar(i)*Ustar(i)) + if(ZETA < 0._r8) then + if(k >= K_sfc(i)) then + Ke(i,k) = Karman*Ustar(i)*Zi(i,k) + else + Ke(i,k) = Karman*Ustar(i)*Zi(i,k) & + *(((Z_pbl(i)-Zi(i,k))/(Z_pbl(i)-Z_sfc(i)))**2) + endif + elseif (ZETA < Ri_c) then + PHI = 1._r8 + ZETA + if(k >= K_sfc(i)) then + Ke(i,k) = Karman*Ustar(i)*Zi(i,k)/PHI + else + Ke(i,k) = Karman*Ustar(i)*Zi(i,k) & + *(((Z_pbl(i)-Zi(i,k))/(Z_pbl(i)-Z_sfc(i)))**2)/PHI + endif + endif + end do + Ke_pbl(i) = Ke(i,K_sfc(i))*Z_sfc(i)/Zi(i,K_sfc(i)) + endif + end do + + ! The Same coefs used for momentum + !----------------------------------- + Km(:,:) = Ke(:,:) + Km_pbl(:) = Ke_pbl(:) + + ! Compute downward values for the implicit PBL scheme + !----------------------------------------------------- + do k = 1,pver + MU (:,k) = gravit*dtime/(Pint(:,k+1) - Pint(:,k)) + end do + + NUe(:,:) = 0._r8 + NUm(:,:) = 0._r8 + do k = 2,pver + rho(:) = 2._r8*Pint(:,k)/(rair*(Tv(:,k)+Tv(:,k-1))) + NUe(:,k) = rho(:)*Ke(:,k)/(Zm(:,k)-Zm(:,k-1)) + NUm(:,k) = rho(:)*Km(:,k)/(Zm(:,k)-Zm(:,k-1)) + end do + + Am(:,1 ) = MU(:,1)*NUm(:,2) + Cm(:,1 ) = 0._r8 + Am(:,pver) = 0._r8 + Cm(:,pver) = MU(:,pver)*NUm(:,pver) + Ae(:,1 ) = MU(:,1 )*NUe(:,2) + Ce(:,1 ) = 0._r8 + Ae(:,pver) = 0._r8 + Ce(:,pver) = MU(:,pver)*NUe(:,pver) + do k = 2,(pver-1) + Am(:,k) = MU(:,k)*NUm(:,k+1) + Cm(:,k) = MU(:,k)*NUm(:,k ) + Ae(:,k) = MU(:,k)*NUe(:,k+1) + Ce(:,k) = MU(:,k)*NUe(:,k ) + end do + Bm(:,:) = 1._r8 - Am(:,:) - Cm(:,:) + Be(:,:) = 1._r8 - Ae(:,:) - Ce(:,:) + + FLu(:,1) = 0._r8 + FLv(:,1) = 0._r8 + FLq(:,1) = 0._r8 + FLt(:,1) = 0._r8 + do k = 2,pver + FLu(:,k) = NUm(:,k)*(U (:,k)-U (:,k-1)) + FLv(:,k) = NUm(:,k)*(V (:,k)-V (:,k-1)) + FLq(:,k) = NUe(:,k)*(Q (:,k)-Q (:,k-1)) + FLt(:,k) = NUe(:,k)*(VSE(:,k)-VSE(:,k-1)) + end do + do k = 1,(pver-1) + Eu(:,k) = Su(:,k) + MU(:,k)*(FLu(:,k)-FLu(:,k+1)) + Ev(:,k) = Sv(:,k) + MU(:,k)*(FLv(:,k)-FLv(:,k+1)) + Eq(:,k) = Sq(:,k) + MU(:,k)*(FLq(:,k)-FLq(:,k+1)) + Et(:,k) = St(:,k) + MU(:,k)*(FLt(:,k)-FLt(:,k+1)) + end do + Eu(:,pver) = Su(:,pver) + MU(:,pver)*FLu(:,pver) + Ev(:,pver) = Sv(:,pver) + MU(:,pver)*FLv(:,pver) + Eq(:,pver) = Sq(:,pver) + MU(:,pver)*FLq(:,pver) + Et(:,pver) = St(:,pver) + MU(:,pver)*FLt(:,pver) + + Eval_m(:,1) = -Am(:,1)/Bm(:,1) + Eval_e(:,1) = -Ae(:,1)/Be(:,1) + Fval_u(:,1) = Eu(:,1)/Bm(:,1) + Fval_v(:,1) = Ev(:,1)/Bm(:,1) + Fval_q(:,1) = Eq(:,1)/Be(:,1) + Fval_t(:,1) = Et(:,1)/Be(:,1) + do k = 2,(pver-1) + Eval_m(:,k) = -Am(:,k)/(Bm(:,k)+Cm(:,k)*Eval_m(:,k-1)) + Eval_e(:,k) = -Ae(:,k)/(Be(:,k)+Ce(:,k)*Eval_e(:,k-1)) + Fval_u(:,k) = (Eu(:,k)-Cm(:,k)*Fval_u(:,k-1)) & + /(Bm(:,k)+Cm(:,k)*Eval_m(:,k-1)) + Fval_v(:,k) = (Ev(:,k)-Cm(:,k)*Fval_v(:,k-1)) & + /(Bm(:,k)+Cm(:,k)*Eval_m(:,k-1)) + Fval_q(:,k) = (Eq(:,k)-Ce(:,k)*Fval_q(:,k-1)) & + /(Be(:,k)+Ce(:,k)*Eval_e(:,k-1)) + Fval_t(:,k) = (Et(:,k)-Ce(:,k)*Fval_t(:,k-1)) & + /(Be(:,k)+Ce(:,k)*Eval_e(:,k-1)) + end do + Eval_m(:,pver) = 0._r8 + Eval_e(:,pver) = 0._r8 + Fval_u(:,pver) = 0._r8 + Fval_v(:,pver) = 0._r8 + Fval_q(:,pver) = 0._r8 + Fval_t(:,pver) = 0._r8 + + Estar_u(:) = (Eu(:,pver)-Cm(:,pver)*Fval_u(:,pver-1)) + Estar_v(:) = (Ev(:,pver)-Cm(:,pver)*Fval_v(:,pver-1)) + Estar_q(:) = (Eq(:,pver)-Ce(:,pver)*Fval_q(:,pver-1)) + Estar_t(:) = (Et(:,pver)-Ce(:,pver)*Fval_t(:,pver-1)) + + dFa_dTa(:) = NUe(:,pver)*(1._r8-Eval_e(:,pver-1)) + dFa_dQa(:) = NUe(:,pver)*(1._r8-Eval_e(:,pver-1)) + dFa_dUa(:) = NUm(:,pver)*(1._r8-Eval_m(:,pver-1)) + dFa_dVa(:) = NUm(:,pver)*(1._r8-Eval_m(:,pver-1)) + + !============================================================================ + ! flux calculation(): + ! + ! Required Values: + ! Passed from : + ! T(:,pver),Q(:,pver),U(:,pver),V(:,pver),Cdrag(:),Pmid(:,pver) + ! MU(:,pver),dFa_dTa(:),dFa_dQa(:),dFa_dUa(:),dFa_dVa(:) + ! Estar_t(:),Estar_q(:),Estar_u(:),Estar_v(:) + ! Passed from : + ! Tsfc(:),Qsfc(:),Psfc(:) + ! + !============================================================================ + + ! Calculate Surface flux values and their derivatives + !-------------------------------------------------------- + do i = 1, ncol + Th_a(i) = T (i,pver)*((ps0/pmid(i,pver))**cappa) + Th_s(i) = Tsfc(i) *((ps0/Psfc (i) )**cappa) + rho (i) = pmid (i,pver)/(rair*Tv(i,pver)) + + Ft (i) = rho(i)*Cdrag(i)*Ws_a(i)*(Th_s (i) - Th_a(i)) + Fq (i) = rho(i)*Cdrag(i)*Ws_a(i)*(Qsfc(i) - Q(i,pver)) + Fu (i) = -rho(i)*Cdrag(i)*Ws_a(i)*U(i,pver) + Fv (i) = -rho(i)*Cdrag(i)*Ws_a(i)*V(i,pver) + Fup (i) = Boltz*Tsfc(i)**4 + + dFt_dTa(i) = -rho(i)*Cdrag(i)*Ws_a(i)*((ps0/pmid(i,pver))**cappa) + dFq_dQa(i) = -rho(i)*Cdrag(i)*Ws_a(i) + dFu_dUa(i) = -rho(i)*Cdrag(i)*Ws_a(i) + dFv_dVa(i) = -rho(i)*Cdrag(i)*Ws_a(i) + + dFt_dTs(i) = rho(i)*Cdrag(i)*Ws_a(i)*((ps0/Psfc (i) )**cappa) + dFq_dTs(i) = rho(i)*Cdrag(i)*Ws_a(i)*Qsfc(i)*latvap/(rh2o*(Tsfc(i)**2)) + dFup_dTs(i) = 4._r8*Boltz*Tsfc(i)**3 + end do + + ! Incorporate surface fluxes into implicit scheme, then + ! update flux values and derivatives + !------------------------------------------ + FN_u (:) = (Estar_u(:) + MU(:,pver)*Fu(:)) & + /(1._r8-MU(:,pver)*(dFa_dUa(:)+dFu_dUa(:))) + FN_v (:) = (Estar_v(:) + MU(:,pver)*Fv(:)) & + /(1._r8-MU(:,pver)*(dFa_dVa(:)+dFv_dVa(:))) + FN_t (:) = (Estar_t(:) + MU(:,pver)*Ft(:)) & + /(1._r8-MU(:,pver)*(dFa_dTa(:)+dFt_dTa(:))) + FN_q (:) = (Estar_q(:) + MU(:,pver)*Fq(:)) & + /(1._r8-MU(:,pver)*(dFa_dQa(:)+dFq_dQa(:))) + + EN_t (:) = ( MU(:,pver)*dFt_dTs(:) ) & + /(1._r8-MU(:,pver)*(dFa_dTa(:)+dFt_dTa(:))) + EN_q (:) = ( MU(:,pver)*dFq_dTs(:) ) & + /(1._r8-MU(:,pver)*(dFa_dQa(:)+dFq_dQa(:))) + + Ft (:) = Ft(:) + dFt_dTa(:)*FN_t(:) + Fq (:) = Fq(:) + dFq_dQa(:)*FN_q(:) + + dFt_dTs(:) = dFt_dTs(:) + dFt_dTa(:)*EN_t(:) + dFq_dTs(:) = dFq_dTs(:) + dFq_dQa(:)*EN_q(:) + + !============================================================================ + ! surface calculation(): + ! + ! Required Values: + ! Passed from : + ! Fup(:),Ft(:),Fq(:) + ! dFup_dTs(:),dFt_dTs(:),dFq_dTs(:) + ! Fsw(:) + ! Passed from : + ! Fdn(:) + ! + !============================================================================ + + ! Update surface values + !----------------------- + Tsfc_bc(:) = Tsfc(:) + + Flux (:) = (dtime/C_ocn)*(Fdn(:) - Fup(:) + Fsw(:) & + -cpair*Ft(:) -latvap*Fq(:) ) + dFlux(:) = (dtime/C_ocn)*(-dFup_dTs(:) -cpair*dFt_dTs(:) -latvap*dFq_dTs(:)) + Tsfc (:) = Tsfc(:) + (Flux(:)/(1._r8-dFlux(:))) + Qsfc (:) = epsilo*E0/Psfc(:)*exp(-latvap_div_rh2o*((1._r8/Tsfc(:))-1._r8/T0)) + dTs (:) = Tsfc(:) - Tsfc_bc(:) + + LHflux(:) = latvap*Fq(:) + SHflux(:) = cpair *Ft(:) + TUflux(:) = Fu(:) + TVflux(:) = Fv(:) + + !============================================================================ + ! tphysac(): + ! + ! Required Values: + ! Passed from : + ! FN_t(:),FN_q(:),FN_u(:),FN_v(:) + ! EN_t(:),EN_q(:),dTs(:) + ! Passed from : + ! Fval_t(:),Fval_q(:),Fval_u(:),Fval_v(:) + ! Eval_e(:),Eval_m(:) + ! + !============================================================================ + + ! Compute upward values for the implicit PBL scheme + !----------------------------------------------------- + dTa(:,pver) = FN_t(:) + EN_t(:)*dTs(:) + dQa(:,pver) = FN_q(:) + EN_q(:)*dTs(:) + dUa(:,pver) = FN_u(:) + dVa(:,pver) = FN_v(:) + do k=(pver-1),1,-1 + dTa(:,k) = Fval_t(:,k) + Eval_e(:,k)*dTa(:,k+1) + dQa(:,k) = Fval_q(:,k) + Eval_e(:,k)*dQa(:,k+1) + dUa(:,k) = Fval_u(:,k) + Eval_m(:,k)*dUa(:,k+1) + dVa(:,k) = Fval_v(:,k) + Eval_m(:,k)*dVa(:,k+1) + end do + + ! Update atmosphere values + !-------------------------- + U(:,:) = U(:,:) + dUa(:,:) + V(:,:) = V(:,:) + dVa(:,:) + Q(:,:) = Q(:,:) + dQa(:,:) + T(:,:) = T(:,:) + dTa(:,:) + + ! Return resulting Tendency values + !---------------------------------- + dUa(:,:) = dUa(:,:)/dtime + dVa(:,:) = dVa(:,:)/dtime + dQa(:,:) = dQa(:,:)/dtime + dTa(:,:) = dTa(:,:)/dtime + + end subroutine frierson_pbl + !======================================================================= + + + !======================================================================= + subroutine frierson_pbl_USER(ncol, pver, dtime, pmid, pint, Zm, Zi, & + Psfc, Tsfc, Qsfc, T, U, V, Q, Fsw, Fdn, & + Cdrag, Km, Ke, VSE, Z_pbl, Rf, dQa, dTa, dUa, dVa, & + LHflux, SHflux, TUflux, TVflux ) + ! + ! frierson_pbl_USER: This routine is a stub which users can use + ! to develop and test their own PBL scheme + !========================================================================== + ! + ! Passed Variables + !------------------ + integer ,intent(in) :: ncol ! Number of columns + integer ,intent(in) :: pver ! Number of levels + real(r8),intent(in) :: dtime ! Time Step + real(r8),intent(in) :: pmid (ncol,pver) ! Pressure at model levels + real(r8),intent(in) :: pint (ncol,pver+1) ! Pressure at interface levels. + real(r8),intent(in) :: Zm (ncol,pver) ! Height at model levels. + real(r8),intent(in) :: Zi (ncol,pver) ! Height at interface levels. + real(r8),intent(in) :: Psfc (ncol) ! Surface Pressure. + real(r8),intent(inout):: Tsfc (ncol) ! SST temperature K + real(r8),intent(inout):: Qsfc (ncol) ! sea surface water vapor (kg/kg) + real(r8),intent(inout):: T (ncol,pver) ! ATM Temperature values. + real(r8),intent(inout):: U (ncol,pver) ! ATM Zonal Wind values. + real(r8),intent(inout):: V (ncol,pver) ! ATM Meridional Wind values. + real(r8),intent(inout):: Q (ncol,pver) ! ATM Water vapor values. + real(r8),intent(in) :: Fdn (ncol) ! Downward LW flux at surface + real(r8),intent(in) :: Fsw (ncol) ! Net SW flux at surface from gray radiation + real(r8),intent(out) :: Cdrag (ncol) ! Surface drage coef. + real(r8),intent(out) :: Km (ncol,pver+1) ! Eddy diffusivity for PBL + real(r8),intent(out) :: Ke (ncol,pver+1) ! Eddy diffusivity for PBL + real(r8),intent(out) :: VSE (ncol,pver) ! Virtual-Dry Static energy.(huh?) + real(r8),intent(out) :: Z_pbl (ncol) ! Height of PBL layer. + real(r8),intent(out) :: Rf (ncol,pver) + real(r8),intent(out) :: dTa (ncol,pver) + real(r8),intent(out) :: dQa (ncol,pver) + real(r8),intent(out) :: dUa (ncol,pver) + real(r8),intent(out) :: dVa (ncol,pver) + real(r8),intent(out) :: LHflux(ncol) ! Latent Heat Flux + real(r8),intent(out) :: SHflux(ncol) ! Sensible Heat Flux + real(r8),intent(out) :: TUflux(ncol) ! U Surface stress + real(r8),intent(out) :: TVflux(ncol) ! V Surface stress + ! + ! Local Values + !--------------- + + + Cdrag = 0._r8 + Km = 0._r8 + Ke = 0._r8 + VSE = 0._r8 + Z_pbl = 0._r8 + Rf = 0._r8 + dTa = 0._r8 + dQa = 0._r8 + dUa = 0._r8 + dVa = 0._r8 + LHflux = 0._r8 + SHflux = 0._r8 + TUflux = 0._r8 + TVflux = 0._r8 + + end subroutine frierson_pbl_USER + !======================================================================= + + + !======================================================================= + subroutine frierson_radiation(ncol,pver,dtime,clat,pint,pmid, & + Psfc,Tsfc,Qsfc,T,qv,dtdt_rad, & + Fsolar,Fup_s,Fdown_s,Fup_toa,Fdown_toa) + ! + ! The gray radiation parameterization based on Frierson, et al. 2006. + ! + ! frierson_radiation: This is an implementation of the gray radiation + ! scheme used in the Frierson model. + !========================================================================== + ! + ! Passed Variables + !------------------- + 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) :: pint (ncol,pver+1) ! mid-point pressure (Pa) + real(r8),intent(in) :: pmid (ncol,pver) ! mid-point pressure (Pa) + real(r8),intent(in) :: Psfc (ncol) ! surface pressure + real(r8),intent(in) :: Tsfc (ncol) ! surface temperature (K) + real(r8),intent(in) :: Qsfc (ncol) + real(r8),intent(inout):: T (ncol,pver) ! temperature (K) + real(r8),intent(in) :: qv (ncol,pver) ! Q (kg/kg) + real(r8),intent(out) :: dtdt_rad(ncol,pver) ! temperature tendency in K/s from relaxation + real(r8),intent(out) :: Fsolar (ncol) ! + real(r8),intent(out) :: Fup_s (ncol) ! + real(r8),intent(out) :: Fdown_toa(ncol) ! + real(r8),intent(out) :: Fup_toa (ncol) ! + real(r8),intent(out) :: Fdown_s (ncol) ! + ! + ! Local Values + !------------- + real(r8):: sinsq (ncol) ! sinlat**2 + real(r8):: Tv_srf (ncol) + real(r8):: Tv (ncol,pver ) + real(r8):: Zm (ncol,pver ) + real(r8):: Zscl (ncol) + real(r8):: Tbar (ncol) + real(r8):: Tdif (ncol) + real(r8):: Zfrac (ncol) + real(r8):: Pfrac (ncol) + real(r8):: Tau_lat(ncol) + real(r8):: Tau (ncol,pver+1) + real(r8):: Zi (ncol,pver+1) + real(r8):: Fup (ncol,pver+1) + real(r8):: Fdown (ncol,pver+1) + real(r8):: Bval (ncol,pver) + real(r8):: Etau (ncol,pver) + integer :: k + + ! Calc current Tv values + !--------------------------------- + Tv_srf(:) = Tsfc(:)*(1._r8+zvir*Qsfc(:)) + do k = 1, pver + Tv(:,k) = T(:,k)*(1._r8+zvir*qv(:,k)) + end do + + ! Calc Geopotential Heights at model interface + ! levels and at model layer levels + !---------------------------------------------- + Zi(:,pver+1) = 0._r8 + Zm(:,pver ) = rair*((Tv(:,pver)+Tv_srf(:))/2._r8)*log(Psfc(:)/pmid(:,pver))/gravit + do k = pver-1,1,-1 + Zscl (:) = rair*log(pmid(:,k+1)/pmid(:,k))/gravit + Tbar (:) = (Tv(:,k)+Tv(:,k+1))/2._r8 + Tdif (:) = (Tv(:,k)-Tv(:,k+1))/2._r8 + Zfrac (:) = log(pint(:,k+1)/pmid(:,k+1))/log(pmid(:,k)/pmid(:,k+1)) + Zm(:,k ) = Zm(:,k+1) + Zscl(:)*Tbar(:) + Zi(:,k+1) = Zm(:,k+1) + Zscl(:)*((Tv(:,k+1)-2._r8*Tdif(:))*Zfrac(:) & + + Tdif(:) *Zfrac(:)**2) + end do + Zfrac(:) = log(pint(:,1)/pmid(:,2))/log(pmid(:,1)/pmid(:,2)) + Zi(:,1) = Zm(:,2) + Zscl(:)*((Tv(:,2)-2._r8*Tdif(:))*Zfrac(:) & + + Tdif(:) *Zfrac(:)**2) + + ! Set Solar flux + !------------------------ + sinsq (:) = sin(clat(:))*sin(clat(:)) + Fsolar(:) = (Rs0/4._r8)*(1._r8 + DeltaS*(1._r8 - 3._r8*sinsq(:))/4._r8) + + ! Calc optical depths + !------------------------ + Tau_lat(:) = Tau_eqtr + (Tau_pole-Tau_eqtr)*sinsq(:) + do k = 1,pver+1 + Pfrac(:) = pint(:,k)/Psfc(:) + Tau(:,k) = Tau_lat(:)*(LinFrac*Pfrac(:) + (1._r8-LinFrac)*Pfrac(:)**4) + end do + + ! Lowest order solution for up/down flux assumes B is constant for the layer + !---------------------------------------------------------------------------- + do k=1,pver + Bval(:,k) = Boltz*T(:,k)**4 + Etau(:,k) = exp(Tau(:,k)-Tau(:,k+1)) + end do + + Fup(:,pver+1) = Boltz*Tsfc(:)**4 + do k=pver,1,-1 + Fup(:,k) = Fup(:,k+1)*Etau(:,k) + Bval(:,k)*(1._r8-Etau(:,k)) + end do + + Fdown(:,1) = 0._r8 + do k=1,pver + Fdown(:,k+1) = Fdown(:,k)*Etau(:,k) + Bval(:,k)*(1._r8-Etau(:,k)) + end do + + ! Calc Radiative heating + !------------------------- + do k=1,pver + dtdt_rad(:,k) = -(cappa*Tv(:,k)/pmid(:,k)) & + *((Fup(:,k+1)-Fdown(:,k+1)) - (Fup(:,k)-Fdown(:,k))) & + /( Zi(:,k+1) - Zi(:,k) ) + end do + + ! Return Upward/Downward long wave radiation at Surface and TOA + !---------------------------------------------------------- + Fup_s (:) = Fup (:,pver+1) + Fdown_s(:) = Fdown(:,pver+1) + Fup_toa (:) = Fup (:,1) + Fdown_toa(:) = Fdown(:,1) + + ! Update T values + !------------------- + do k=1,pver + T(:,k) = T(:,k) + dtdt_rad(:,k)*dtime + end do + + end subroutine frierson_radiation + !======================================================================= + + + !======================================================================= + subroutine frierson_radiation_USER(ncol,pver,dtime,clat,pint,pmid, & + Psfc,Tsfc,Qsfc,T,qv,dtdt_rad, & + Fsolar,Fup_s,Fdown_s,Fup_toa,Fdown_toa) + ! + ! frierson_radiation_USER: This routine is a stub which users can use + ! to develop and test their own radiation scheme + !========================================================================== + ! + ! Passed Variables + !------------------- + 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) :: pint (ncol,pver+1) ! mid-point pressure (Pa) + real(r8),intent(in) :: pmid (ncol,pver) ! mid-point pressure (Pa) + real(r8),intent(in) :: Psfc (ncol) ! surface pressure + real(r8),intent(in) :: Tsfc (ncol) ! surface temperature (K) + real(r8),intent(in) :: Qsfc (ncol) + real(r8),intent(inout):: T (ncol,pver) ! temperature (K) + real(r8),intent(in) :: qv (ncol,pver) ! Q (kg/kg) + real(r8),intent(out) :: dtdt_rad(ncol,pver) ! temperature tendency in K/s from relaxation + real(r8),intent(out) :: Fsolar (ncol) ! + real(r8),intent(out) :: Fup_s (ncol) ! + real(r8),intent(out) :: Fdown_s (ncol) ! + real(r8),intent(out) :: Fup_toa (ncol) ! + real(r8),intent(out) :: Fdown_toa(ncol) ! + ! + ! Local Values + !------------- + + dtdt_rad = 0._r8 + Fsolar = 0._r8 + Fup_s = 0._r8 + Fdown_s = 0._r8 + Fup_toa = 0._r8 + Fdown_toa = 0._r8 + + + end subroutine frierson_radiation_USER + !======================================================================= + +end module frierson diff --git a/src/physics/simple/frierson_cam.F90 b/src/physics/simple/frierson_cam.F90 new file mode 100644 index 0000000000..0fe9d824bb --- /dev/null +++ b/src/physics/simple/frierson_cam.F90 @@ -0,0 +1,1046 @@ +module frierson_cam +!----------------------------------------------------------------------- +! +! Purpose: Implement idealized forcings described in +! Frierson, et al. (2006), " A Gray-Radiation Aquaplanet +! Moist GCM, Part I. Static Stability and Eddy Scale" +! J. Atmos. Sci, Vol 63, 2548-2566. +! doi: 10.1175/JAS3753.1 +! +!============================================================================ + ! Useful modules + !------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_const_mod, only: pi => shr_const_pi + use physconst, only: gravit, cappa, rair, cpair, latvap, rh2o, epsilo, rhoh2o, zvir + use ppgrid, only: pcols, pver, pverp, begchunk, endchunk + use constituents, only: pcnst + use physics_buffer, only: dtype_r8, pbuf_add_field, physics_buffer_desc, & + pbuf_set_field, pbuf_get_field + use camsrfexch, only: cam_in_t,cam_out_t + use cam_history, only: outfld + use time_manager, only: is_first_step + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use hycoef, only: ps0, etamid + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_real8 + + use pio ,only: file_desc_t, var_desc_t, io_desc_t, pio_double, pio_def_var + use pio ,only: pio_write_darray, pio_read_darray, pio_inq_varid + use cam_grid_support,only: cam_grid_id, cam_grid_dimensions, cam_grid_get_decomp + use shr_const_mod, only: SHR_CONST_STEBOL, SHR_CONST_REARTH, SHR_CONST_KARMAN, SHR_CONST_TKTRIP + + ! Set all Global values and routines to private by default + ! and then explicitly set their exposure. + !--------------------------------------------------------- + implicit none + private + save + + public :: frierson_register + public :: frierson_readnl + public :: frierson_init + public :: frierson_condensate_tend + public :: frierson_pbl_tend + public :: frierson_radiative_tend + public :: frierson_restart_init + public :: frierson_restart_write + public :: frierson_restart_read + + private :: frierson_surface_init + + ! PBL Configuatons + !------------------ + integer,parameter :: PBL_FRIERSON = 0 ! Implementation of Frierson PBL + integer,parameter :: PBL_USER = 1 ! Optional call for user defined PBL + + ! Tags to identify optional model formulations + !------------------------------------------------ + integer,parameter :: CONDENSATE_NONE = 0 ! No Condensation, PRECL=0 + integer,parameter :: CONDENSATE_FRIERSON = 1 ! Frierson condensation w/ re-evaporation + integer,parameter :: CONDENSATE_TJ16 = 2 ! Condensation from TJ2016 model. + integer,parameter :: CONDENSATE_USER = 3 ! Optional user defined Condensation scheme + + integer,parameter :: RADIATION_FRIERSON = 0 ! Frierson Gray radiation. + integer,parameter :: RADIATION_USER = 1 ! Optional user defined Radiation scheme + + ! Options selecting which PRECIP, PBL, RADIATION, etc.. formulations to use. + !--------------------------------------------------------------------------------- + integer,parameter :: PBL_OPT = PBL_FRIERSON + integer,parameter :: CONDENSATE_OPT = CONDENSATE_FRIERSON + integer,parameter :: RADIATION_OPT = RADIATION_FRIERSON + + ! Global Constants + !--------------------- + real(r8),parameter :: frierson_T0 = SHR_CONST_TKTRIP ! Reference Temperature for E0 + real(r8),parameter :: frierson_E0 = 610.78_r8 ! Saturation Vapor pressure @ T0 + real(r8),parameter :: frierson_Rs0 = 1360.0_r8 ! Solar Constant + real(r8),parameter :: frierson_Erad = SHR_CONST_REARTH ! Earth Radius + real(r8),parameter :: frierson_Karman = SHR_CONST_KARMAN ! Von Karman constant + real(r8),parameter :: frierson_Boltz = SHR_CONST_STEBOL ! Stefan-Boltzmann constant + + ! Some Physics buffer indices + !------------------------------- + integer :: prec_pcw_idx = 0 + integer :: prec_dp_idx = 0 + integer :: relhum_idx = 0 + + ! Global values for Surface Temp, surface fluxes, and radiative heating + !---------------------------------------------------------------------- + type(var_desc_t) :: Tsurf_desc ! Vardesc for restarts + type(var_desc_t) :: Qsurf_desc ! Vardesc for restarts + real(r8),allocatable :: Tsurf (:,:) ! Surface Temp + real(r8),allocatable :: Qsurf (:,:) ! Surface Q + real(r8),allocatable :: Fsolar(:,:) ! Net Solar Heating + real(r8),allocatable :: Fup (:,:) ! Upward Longwave flux + real(r8),allocatable :: Fdown (:,:) ! Downward Longwave flux + real(r8),allocatable :: Fup_toa (:,:) ! Upward Longwave flux at TOA + real(r8),allocatable :: Fdown_toa(:,:) ! Downward Longwave flux at TOA + real(r8),allocatable :: SHflux(:,:) ! Sensible Heat flux + real(r8),allocatable :: LHflux(:,:) ! Latent Heat Flux + real(r8),allocatable :: TUflux(:,:) ! U stress momentum flux + real(r8),allocatable :: TVflux(:,:) ! V stress momentum flux + real(r8),allocatable :: Cd (:,:) ! Surface Drag + real(r8),allocatable :: clat (:,:) ! latitudes(radians) for columns + real(r8),allocatable :: Fnet (:,:) ! Net Radiative Surface Heating + real(r8),allocatable :: Fnet_toa(:,:) ! Net Radiative Surface Heating at TOA + + real(r8), parameter :: unset_r8 = huge(1.0_r8) + + ! Global Tuning values + !------------------------ + real(r8) :: frierson_Wind_min = unset_r8 ! Minimum wind threshold + real(r8) :: frierson_Z0 = unset_r8 ! Roughness Length + real(r8) :: frierson_Ri_c = unset_r8 ! Crit. Richardson # for stable mixing + real(r8) :: frierson_Fb = unset_r8 ! Surface layer Fraction + real(r8) :: frierson_Albedo = unset_r8 ! Frierson Albedo + real(r8) :: frierson_DeltaS = unset_r8 ! Lat variation of shortwave radiation + real(r8) :: frierson_Tau_eqtr = unset_r8 ! Longwave optical depth at Equator + real(r8) :: frierson_Tau_pole = unset_r8 ! Longwave optical depth at poles. + real(r8) :: frierson_LinFrac = unset_r8 ! Stratosphere Linear optical depth param + real(r8) :: frierson_C0 = unset_r8 ! Ocean mixed layer heat capacity + real(r8) :: frierson_WetDryCoef = unset_r8 ! E0 Scale factor to control moisture + real(r8) :: frierson_Tmin = unset_r8 ! IC: Minimum sst (K) + real(r8) :: frierson_Tdlt = unset_r8 ! IC: eq-polar difference sst (K) + real(r8) :: frierson_Twidth = unset_r8 ! IC: Latitudinal width parameter for sst (degrees latitude) + +contains + !============================================================================== + subroutine frierson_register() + ! + ! frierson_register: Register physics buffer values + !===================================================================== + + call pbuf_add_field('PREC_PCW','physpkg',dtype_r8, (/pcols/), prec_pcw_idx) + call pbuf_add_field('PREC_DP' ,'physpkg',dtype_r8, (/pcols/), prec_dp_idx ) + call pbuf_add_field('RELHUM' ,'physpkg',dtype_r8, (/pcols,pver/),relhum_idx ) + + end subroutine frierson_register + !============================================================================== + + + !============================================================================== + subroutine frierson_readnl(nlfile) + ! + ! frierson_readnl: Read in parameters controlling Frierson parameterizations. + !===================================================================== + use namelist_utils,only: find_group_name + use units ,only: getunit, freeunit + ! + ! Passed Variables + !------------------ + character(len=*),intent(in):: nlfile + ! + ! Local Values + !-------------- + integer:: ierr,unitn + + character(len=*), parameter :: sub = 'frierson_readnl' + + namelist /frierson_nl/ frierson_Wind_min, frierson_Z0 , frierson_Ri_c , & + frierson_Fb , frierson_Albedo , frierson_DeltaS , & + frierson_Tau_eqtr, frierson_Tau_pole , frierson_LinFrac, & + frierson_C0 , frierson_WetDryCoef, frierson_Tmin , & + frierson_Tdlt , frierson_Twidth + + ! Read in namelist values + !------------------------- + if(masterproc) then + unitn = getunit() + open(unitn,file=trim(nlfile),status='old') + call find_group_name(unitn,'frierson_nl',status=ierr) + if(ierr == 0) then + read(unitn,frierson_nl,iostat=ierr) + if(ierr /= 0) then + call endrun(sub//': ERROR reading namelist') + endif + endif + close(unitn) + call freeunit(unitn) + endif + + ! Broadcast namelist values + !--------------------------- + call mpi_bcast(frierson_Wind_min , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_Wind_min") + call mpi_bcast(frierson_Z0 , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_Z0") + call mpi_bcast(frierson_Ri_c , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_Ri_c") + call mpi_bcast(frierson_Fb , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_Fb") + call mpi_bcast(frierson_Albedo , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_Albedo") + call mpi_bcast(frierson_DeltaS , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_DeltaS") + call mpi_bcast(frierson_Tau_eqtr , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_Tau_eqtr") + call mpi_bcast(frierson_Tau_pole , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_Tau_pole") + call mpi_bcast(frierson_LinFrac , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_LinFrac") + call mpi_bcast(frierson_C0 , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_C0") + call mpi_bcast(frierson_Tmin , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_Tmin") + call mpi_bcast(frierson_Tdlt , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_Tdlt") + call mpi_bcast(frierson_Twidth , 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_Twidth") + call mpi_bcast(frierson_WetDryCoef, 1, mpi_real8 , mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frierson_WetDryCoef") + + end subroutine frierson_readnl + !============================================================================== + + + !============================================================================== + subroutine frierson_init(phys_state,pbuf2d) + ! + ! frierson_init: allocate space for global arrays and initialize values. + ! Add variables to history outputs + !===================================================================== + use physics_types, only: physics_state + use error_messages,only: alloc_err + use cam_history, only: addfld, add_default,horiz_only + use phys_grid, only: get_ncols_p, get_rlat_p + use frierson, only: frierson_set_const + ! + ! Passed Variables + !------------------ + type(physics_state) ,pointer:: phys_state(:) + type(physics_buffer_desc),pointer:: pbuf2d (:,:) + ! + ! Local Values + !--------------- + integer :: istat,lchnk,icol,ncol + real(r8):: adjusted_E0 + real(r8):: frierson_Rs + + ! Initialize constants in Frierson module + !------------------------------------------ + adjusted_E0 = frierson_WetDryCoef*frierson_E0 + frierson_Rs = frierson_Rs0*(1._r8-frierson_Albedo) + call frierson_set_const(gravit,cappa,rair,cpair,latvap,rh2o,epsilo,rhoh2o,zvir,ps0,etamid, & + frierson_T0 ,adjusted_E0 ,frierson_Erad ,frierson_Wind_min, & + frierson_Z0 ,frierson_Ri_c ,frierson_Karman ,frierson_Fb , & + frierson_Rs ,frierson_DeltaS,frierson_Tau_eqtr,frierson_Tau_pole, & + frierson_LinFrac,frierson_Boltz ,frierson_C0 ) + + ! Add values for history output + !--------------------------------- + call addfld('gray_QRL' ,(/'lev' /),'A','K/s' ,'Longwave heating rate for gray atmosphere' ) + call addfld('gray_QRS' ,(/'lev' /),'A','K/s' ,'Solar heating rate for gray atmosphere' ) + call addfld('gray_DTCOND',(/'lev' /),'A','K/s' ,'T tendency - gray atmosphere moist process' ) + call addfld('gray_DQCOND',(/'lev' /),'A','kg/kg/s','Q tendency - gray atmosphere moist process' ) + call addfld('gray_EVAPDT',(/'lev' /),'A','K/s' ,'T tendency due to re-evaporation' ) + call addfld('gray_EVAPDQ',(/'lev' /),'A','kg/kg/s','Q tendency due to re-evaporation' ) + call addfld('gray_KVH' ,(/'ilev'/),'A','m2/s' ,'Vertical diffusion diffusivities (heat/moisture)') + call addfld('gray_KVM' ,(/'ilev'/),'A','m2/s' ,'Vertical diffusion diffusivities (momentum)' ) + call addfld('gray_VSE' ,(/'lev' /),'A','K' ,'VSE: (Tv + gZ/Cp)' ) + call addfld('gray_Zm' ,(/'lev' /),'A','m' ,'Geopotential height' ) + call addfld('gray_Rf' ,(/'lev' /),'A','1' ,'Bulk Richardson number (Frierson et al 2006, eq 16) / Ri_c' ) + call addfld('gray_DTV' ,(/'lev' /),'A','K/s' ,'T tendency due to vertical diffusion' ) + call addfld('gray_DUV' ,(/'lev' /),'A','m/s2' ,'U tendency due to vertical diffusion' ) + call addfld('gray_DVV' ,(/'lev' /),'A','m/s2' ,'V tendency due to vertical diffusion' ) + call addfld('gray_VD01' ,(/'lev' /),'A','kg/kg/s','Q tendency (vertical diffusion)' ) + call addfld('gray_PRECL' ,horiz_only,'A','m/s' ,'Large-scale precipitation rate' ) + call addfld('gray_PRECC' ,horiz_only,'A','m/s' ,'Convective precipitation rate' ) + call addfld('gray_Tsurf ',horiz_only,'I','K' ,'Surface Temperature' ) + call addfld('gray_Qsurf ',horiz_only,'I','kg/kg' ,'Surface Water Vapor' ) + call addfld('gray_Cdrag' ,horiz_only,'A','1' ,'Surface Drag Coefficient' ) + call addfld('gray_Zpbl' ,horiz_only,'I','m' ,'PBL Height' ) + call addfld('gray_SWflux',horiz_only,'I','W/m2' ,'SW Solar Flux' ) + call addfld('gray_LUflux',horiz_only,'I','W/m2' ,'LW Upward Radiative Flux at Surface' ) + call addfld('gray_LDflux',horiz_only,'I','W/m2' ,'LW Downward Radiative Flux at Surface' ) + call addfld('gray_LWflux',horiz_only,'I','W/m2' ,'LW Net Radiative Flux at Surface' ) + call addfld('gray_LUflux_TOA',horiz_only,'I','W/m2' ,'LW Upward Radiative Flux at TOA' ) + call addfld('gray_LDflux_TOA',horiz_only,'I','W/m2' ,'LW Downward Radiative Flux at TOA' ) + call addfld('gray_LWflux_TOA',horiz_only,'I','W/m2' ,'LW Net Radiative Flux at TOA' ) + call addfld('gray_SHflux',horiz_only,'I','W/m2' , 'Sensible Heat Flux' ) + call addfld('gray_LHflux',horiz_only,'I','W/m2' , 'Latent Heat Flux' ) + call addfld('gray_TauU' ,horiz_only,'I','N/m2' , 'U Surface Stress' ) + call addfld('gray_TauV' ,horiz_only,'I','N/m2' , 'V Surface Stress' ) + + call add_default('gray_QRL' ,1,' ') + call add_default('gray_QRS' ,1,' ') + call add_default('gray_DTCOND',1,' ') + call add_default('gray_DQCOND',1,' ') + call add_default('gray_EVAPDT',1,' ') + call add_default('gray_EVAPDQ',1,' ') + call add_default('gray_KVH' ,1,' ') + call add_default('gray_KVM' ,1,' ') + call add_default('gray_VSE' ,1,' ') + call add_default('gray_Zm' ,1,' ') + call add_default('gray_Rf' ,1,' ') + call add_default('gray_DTV' ,1,' ') + call add_default('gray_DUV' ,1,' ') + call add_default('gray_DVV' ,1,' ') + call add_default('gray_VD01' ,1,' ') + call add_default('gray_PRECC' ,1,' ') + call add_default('gray_PRECL' ,1,' ') + call add_default('gray_Tsurf' ,1,' ') + call add_default('gray_Qsurf' ,1,' ') + call add_default('gray_Cdrag' ,1,' ') + call add_default('gray_Zpbl' ,1,' ') + call add_default('gray_SWflux',1,' ') + call add_default('gray_LUflux',1,' ') + call add_default('gray_LDflux',1,' ') + call add_default('gray_LWflux',1,' ') + call add_default('gray_LUflux_TOA',1,' ') + call add_default('gray_LDflux_TOA',1,' ') + call add_default('gray_LWflux_TOA',1,' ') + call add_default('gray_SHflux',1,' ') + call add_default('gray_LHflux',1,' ') + call add_default('gray_TauU' ,1,' ') + call add_default('gray_TauV' ,1,' ') + + ! Allocate Global arrays + !------------------------- + allocate(Fsolar(pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','Fsolar',pcols*(endchunk-begchunk+1)) + allocate(Fup (pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','Fup' ,pcols*(endchunk-begchunk+1)) + allocate(Fdown (pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','Fdown' ,pcols*(endchunk-begchunk+1)) + allocate(Fup_toa (pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','Fup_toa' ,pcols*(endchunk-begchunk+1)) + allocate(Fdown_toa (pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','Fdown_toa' ,pcols*(endchunk-begchunk+1)) + allocate(Fnet(pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','Fnet',pcols*(endchunk-begchunk+1)) + allocate(Fnet_toa(pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','Fnet_toa' ,pcols*(endchunk-begchunk+1)) + + allocate(SHflux(pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','SHflux',pcols*(endchunk-begchunk+1)) + allocate(LHflux(pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','LHflux',pcols*(endchunk-begchunk+1)) + allocate(TUflux(pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','TUflux',pcols*(endchunk-begchunk+1)) + allocate(TVflux(pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','TVflux',pcols*(endchunk-begchunk+1)) + allocate(Cd (pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','Cd' ,pcols*(endchunk-begchunk+1)) + allocate(clat (pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','clat' ,pcols*(endchunk-begchunk+1)) + + ! Initialize time indices and latitudes + !---------------------------------------- + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + do icol = 1,ncol + clat(icol,lchnk) = get_rlat_p(lchnk,icol) + end do + end do + + ! At first model step, initialize some values + !----------------------------------------------- + if(is_first_step()) then + ! Initialize physics buffer values + !---------------------------------- + call pbuf_set_field(pbuf2d, prec_pcw_idx, 0._r8) + call pbuf_set_field(pbuf2d, prec_dp_idx , 0._r8) + + ! Allocate Surface fields + !------------------------- + allocate(Tsurf (pcols,begchunk:endchunk),stat=istat) + call alloc_err(istat,'Frierson INIT','Tsurf' ,pcols*(endchunk-begchunk+1)) + allocate(Qsurf (pcols,begchunk:endchunk) ,stat=istat) + call alloc_err(istat,'Frierson INIT','Qsurf' ,pcols*(endchunk-begchunk+1)) + + ! Initialize Surface temperatures and Q + !----------------------------------------------------------------------- + do lchnk = begchunk,endchunk + ncol = get_ncols_p(lchnk) + + ! Set to reference values for initialization + !------------------------------------------------------------ + phys_state(lchnk)%ps(:ncol) = ps0 + + call frierson_surface_init(ncol, clat(:ncol,lchnk), & + phys_state(lchnk)%ps(:ncol), & + Tsurf(:ncol,lchnk), & + Qsurf(:ncol,lchnk) ) + end do + endif + + ! Initialize radiation and flux values to 0.0 + !--------------------------------------------------------------------------- + do lchnk = begchunk,endchunk + Fsolar(:,lchnk) = 0._r8 + Fup (:,lchnk) = 0._r8 + Fdown (:,lchnk) = 0._r8 + Fup_toa (:,lchnk) = 0._r8 + Fdown_toa (:,lchnk) = 0._r8 + SHflux(:,lchnk) = 0._r8 + LHflux(:,lchnk) = 0._r8 + TUflux(:,lchnk) = 0._r8 + TVflux(:,lchnk) = 0._r8 + Cd (:,lchnk) = 0._r8 + Fnet (:,lchnk) = 0._r8 + end do + + ! Informational Output + !---------------------- + if(masterproc) then + write(iulog,*) ' ' + write(iulog,*) '-----------------------------------------------------------' + write(iulog,*) ' FRIERSON MODULE INITIALIZED WITH THE FOLLOWING SETTINGS: ' + write(iulog,*) '-----------------------------------------------------------' + write(iulog,*) 'FRIERSON: gravit=' , gravit + write(iulog,*) 'FRIERSON: cappa=' , cappa + write(iulog,*) 'FRIERSON: rair =' , rair + write(iulog,*) 'FRIERSON: cpair=' , cpair + write(iulog,*) 'FRIERSON: latvap=' , latvap + write(iulog,*) 'FRIERSON: rh2o=' , rh2o + write(iulog,*) 'FRIERSON: epsilo=' , epsilo + write(iulog,*) 'FRIERSON: rhoh2o=' , rhoh2o + write(iulog,*) 'FRIERSON: zvir=' , zvir + write(iulog,*) 'FRIERSON: ps0=' , ps0 + write(iulog,*) 'FRIERSON: etamid=' , etamid + write(iulog,*) 'FRIERSON: T0=' , frierson_T0 + write(iulog,*) 'FRIERSON: E0=' , frierson_E0 + write(iulog,*) 'FRIERSON: Erad=' , frierson_Erad + write(iulog,*) 'FRIERSON: Wind_min=' , frierson_Wind_min + write(iulog,*) 'FRIERSON: Z0=' , frierson_Z0 + write(iulog,*) 'FRIERSON: Ri_c=' , frierson_Ri_c + write(iulog,*) 'FRIERSON: Karman=' , frierson_Karman + write(iulog,*) 'FRIERSON: Fb=' , frierson_Fb + write(iulog,*) 'FRIERSON: Rs0=' , frierson_Rs0 + write(iulog,*) 'FRIERSON: Albedo=' , frierson_Albedo + write(iulog,*) 'FRIERSON: Rs=' , frierson_Rs + write(iulog,*) 'FRIERSON: DeltaS=' , frierson_DeltaS + write(iulog,*) 'FRIERSON: Tau_eqtr=' , frierson_Tau_eqtr + write(iulog,*) 'FRIERSON: Tau_pole=' , frierson_Tau_pole + write(iulog,*) 'FRIERSON: LinFrac=' , frierson_LinFrac + write(iulog,*) 'FRIERSON: Boltz=' , frierson_Boltz + write(iulog,*) 'FRIERSON: C0=' , frierson_C0 + write(iulog,*) 'FRIERSON: Tmin=' , frierson_Tmin + write(iulog,*) 'FRIERSON: Tdlt=' , frierson_Tdlt + write(iulog,*) 'FRIERSON: Twidth=' , frierson_Twidth + write(iulog,*) 'FRIERSON: WetDryCoef=', frierson_WetDryCoef + write(iulog,*) ' ' + endif + + end subroutine frierson_init + !============================================================================== + + + !============================================================================== + + + !============================================================================== + subroutine frierson_condensate_tend(state, ptend, ztodt, pbuf) + ! + ! frierson_condensate_tend: Run the selected process to compute precipitation + ! due to large scale condensation. + !===================================================================== + use physics_types,only: physics_state, physics_ptend + use physics_types,only: physics_ptend_init + use frierson, only: frierson_condensate_NONE,frierson_condensate + use frierson, only: frierson_condensate_USER,frierson_condensate_TJ16 + ! + ! Passed Variables + !------------------ + type(physics_state) ,intent(inout):: state + real(r8) ,intent(in) :: ztodt + type(physics_ptend) ,intent(out) :: ptend + type(physics_buffer_desc),pointer :: pbuf(:) + ! + ! Local Values + !----------------- + real(r8),pointer:: relhum (:,:) + real(r8),pointer:: prec_pcw(:) ! large scale precip + real(r8) :: prec_cnv(state%ncol) ! Convective Precip + real(r8) :: evapdt(state%ncol, pver) ! T tendency due to re-evaporation of condensation + real(r8) :: evapdq(state%ncol, pver) ! Q tendency due to re-evaporation of condensation + real(r8) :: dtcond(state%ncol, pver) ! Temperature tendency due to condensation + real(r8) :: dqcond(state%ncol, pver) ! Q tendency due to condensation + real(r8) :: T (state%ncol, pver) ! T temporary + real(r8) :: qv (state%ncol, pver) ! Q temporary + logical :: lq(pcnst) ! Calc tendencies? + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: k + + ! Set local copies of values + !--------------------------------- + lchnk = state%lchnk + ncol = state%ncol + T (:ncol,:) = state%T(:ncol,:) + qv(:ncol,:) = state%Q(:ncol,:,1) + + ! initialize individual parameterization tendencies + !--------------------------------------------------- + lq = .false. + lq(1) = .true. + call physics_ptend_init(ptend, state%psetcols, 'Frierson condensate', & + ls=.true., lu=.true., lv=.true., lq=lq) + + ! Get values from the physics buffer + !------------------------------------ + call pbuf_get_field(pbuf,prec_pcw_idx,prec_pcw) + call pbuf_get_field(pbuf, relhum_idx,relhum ) + + ! Initialize values for condensate tendencies + !--------------------------------------------- + do k = 1, pver + dtcond(:ncol,k) = state%T(:ncol,k) + dqcond(:ncol,k) = state%q(:ncol,k,1) + end do + + ! Call the Selected condensation routine ~~DEVO style~~ + !-------------------------------------------------------- + if(CONDENSATE_OPT == CONDENSATE_NONE) then + prec_cnv(:ncol) = 0._r8 + evapdt (:ncol,:) = 0._r8 + evapdq (:ncol,:) = 0._r8 + call frierson_condensate_NONE(ncol,pver,state%pmid(:ncol,:), & + T(:ncol,:), & + qv(:ncol,:), & + relhum(:ncol,:), & + prec_pcw(:ncol) ) + elseif(CONDENSATE_OPT == CONDENSATE_FRIERSON) then + prec_cnv(:ncol) = 0._r8 + call frierson_condensate(ncol,pver,ztodt,state%pmid(:ncol,:), & + state%pdel(:ncol,:), & + T(:ncol,:), & + qv(:ncol,:), & + relhum(:ncol,:), & + prec_pcw(:ncol) , & + evapdt(:ncol,:), & + evapdq(:ncol,:) ) + elseif(CONDENSATE_OPT == CONDENSATE_TJ16) then + prec_cnv(:ncol) = 0._r8 + evapdt (:ncol,:) = 0._r8 + evapdq (:ncol,:) = 0._r8 + call frierson_condensate_TJ16(ncol,pver,ztodt,state%pmid(:ncol,:), & + state%pdel(:ncol,:), & + T(:ncol,:), & + qv(:ncol,:), & + relhum(:ncol,:), & + prec_pcw(:ncol) ) + elseif(CONDENSATE_OPT == CONDENSATE_USER) then + prec_cnv(:ncol) = 0._r8 + evapdt (:ncol,:) = 0._r8 + evapdq (:ncol,:) = 0._r8 + call frierson_condensate_USER(ncol,pver,ztodt,state%pmid(:ncol,:), & + state%pdel(:ncol,:), & + T(:ncol,:), & + qv(:ncol,:), & + relhum(:ncol,:), & + prec_pcw(:ncol) ) + else + ! ERROR: Unknown CONDENSATE_OPT value + !------------------------------------- + write(iulog,*) 'ERROR: unknown CONDENSATE_OPT=',CONDENSATE_OPT + call endrun('frierson_condensate_tend() CONDENSATE_OPT ERROR') + endif + + ! Back out temperature and 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 + + ! Output condensate tendencies + !------------------------------ + do k = 1, pver + dtcond(:ncol,k) = (T (:ncol,k) - dtcond(:ncol,k))/ztodt + dqcond(:ncol,k) = (qv(:ncol,k) - dqcond(:ncol,k))/ztodt + end do + call outfld('gray_EVAPDT',evapdt ,ncol,lchnk) + call outfld('gray_EVAPDQ',evapdq ,ncol,lchnk) + call outfld('gray_DTCOND',dtcond ,ncol,lchnk) + call outfld('gray_DQCOND',dqcond ,ncol,lchnk) + call outfld('gray_PRECL' ,prec_pcw,ncol,lchnk) + call outfld('gray_PRECC' ,prec_cnv,ncol,lchnk) + + end subroutine frierson_condensate_tend + !============================================================================== + + + !============================================================================ + subroutine frierson_pbl_tend(state, ptend, ztodt, cam_in) + ! + ! frierson_pbl_tend: Run the selected PBL process. + !========================================================================= + use physics_types,only: physics_state, physics_ptend + use physics_types,only: physics_ptend_init + use phys_grid, only: get_rlat_all_p + use frierson, only: frierson_pbl,frierson_pbl_USER + ! + ! Passed Variables + !------------------- + type(physics_state),intent(in) :: state + real(r8), intent(in) :: ztodt + type(physics_ptend),intent(out) :: ptend + type(cam_in_t), intent(inout):: cam_in + ! + ! Local Values + !---------------- + 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 + real(r8) :: V (state%ncol,pver) ! V temporary + real(r8) :: dqdt_vdiff(state%ncol,pver) ! PBL Q vertical diffusion tend kg/kg/s + real(r8) :: dtdt_vdiff(state%ncol,pver) ! PBL T vertical diffusion tend K/s + real(r8) :: dudt_vdiff(state%ncol,pver) ! PBL U vertical diffusion tend m/s/s + real(r8) :: dvdt_vdiff(state%ncol,pver) ! PBL V vertical diffusion tend m/s/s + real(r8) :: Km (state%ncol,pverp) ! Eddy diffusivity at layer interfaces (m2/s) + real(r8) :: Ke (state%ncol,pverp) ! Eddy diffusivity at layer interfaces (m2/s) + real(r8) :: VSE (state%ncol,pver) ! Dry Static Energy divided by Cp (K) + real(r8) :: Zm (state%ncol,pver) ! + real(r8) :: Zi (state%ncol,pver) ! + real(r8) :: Z_pbl (state%ncol) ! + real(r8) :: Rf (state%ncol,pver) ! + real(r8) :: Tsfc (state%ncol) ! Surface T + real(r8) :: Qsfc (state%ncol) ! Surface Q (saturated) + real(r8) :: Cdrag (state%ncol) ! Cdrag coef from surface calculation + + logical :: lq (pcnst) ! Calc tendencies? + real(r8) :: dTs (state%ncol) + real(r8) :: dUa (state%ncol,pver) + real(r8) :: dVa (state%ncol,pver) + real(r8) :: dTa (state%ncol,pver) + real(r8) :: dQa (state%ncol,pver) + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: kk ! loop index + + ! Set local copies of values + !--------------------------------- + lchnk = state%lchnk + ncol = state%ncol + Zm (:ncol,:) = state%zm (:ncol,:) + Zi (:ncol,1:pver) = state%zi (:ncol,1:pver) + T (:ncol,:) = state%T (:ncol,:) + U (:ncol,:) = state%U (:ncol,:) + V (:ncol,:) = state%V (:ncol,:) + qv (:ncol,:) = state%Q (:ncol,:,1) + + ! Initialize individual parameterization tendencies + !----------------------------------------------------- + lq = .false. + lq(1) = .true. + call physics_ptend_init(ptend,state%psetcols,'Frierson pbl_tend', & + ls=.true., lu=.true., lv=.true., lq=lq) + + ! Call the Selected PBL routine + !-------------------------------------------------------- + Tsfc(:ncol) = Tsurf(:ncol,lchnk) + Qsfc(:ncol) = Qsurf(:ncol,lchnk) + if(PBL_OPT == PBL_FRIERSON) then + ! Call Frierson PBL scheme + !-------------------------------------------------- + call frierson_pbl(ncol, pver, ztodt,state%pmid (:ncol,:), & + state%pint (:ncol,:), & + Zm(:ncol,:), & + Zi(:ncol,:), & + state%ps(:ncol) , & + Tsfc(:ncol) , & + Qsfc(:ncol) , & + T(:ncol,:), & + U(:ncol,:), & + V(:ncol,:), & + qv(:ncol,:), & + Fsolar(:ncol,lchnk), & + Fdown(:ncol,lchnk), & + Cdrag(:ncol) , & + Km(:ncol,:), & + Ke(:ncol,:), & + VSE(:ncol,:), & + Z_pbl(:ncol) , & + Rf(:ncol,:), & + dqdt_vdiff(:ncol,:), & + dtdt_vdiff(:ncol,:), & + dudt_vdiff(:ncol,:), & + dvdt_vdiff(:ncol,:), & + LHflux(:ncol,lchnk), & + SHflux(:ncol,lchnk), & + TUflux(:ncol,lchnk), & + TVflux(:ncol,lchnk) ) + elseif(PBL_OPT == PBL_USER) then + ! Call USER implemented routine in frierson module + !-------------------------------------------------- + call frierson_pbl_USER(ncol, pver, ztodt,state%pmid (:ncol,:), & + state%pint (:ncol,:), & + Zm(:ncol,:), & + Zi(:ncol,:), & + state%ps(:ncol) , & + Tsfc(:ncol) , & + Qsfc(:ncol) , & + T(:ncol,:), & + U(:ncol,:), & + V(:ncol,:), & + qv(:ncol,:), & + Fsolar(:ncol,lchnk), & + Fdown(:ncol,lchnk), & + Cdrag(:ncol) , & + Km(:ncol,:), & + Ke(:ncol,:), & + VSE(:ncol,:), & + Z_pbl(:ncol) , & + Rf(:ncol,:), & + dqdt_vdiff(:ncol,:), & + dtdt_vdiff(:ncol,:), & + dudt_vdiff(:ncol,:), & + dvdt_vdiff(:ncol,:), & + LHflux(:ncol,lchnk), & + SHflux(:ncol,lchnk), & + TUflux(:ncol,lchnk), & + TVflux(:ncol,lchnk) ) + else + ! ERROR: Unknown PBL_OPT value + !------------------------------------- + write(iulog,*) 'ERROR: unknown PBL_OPT=',PBL_OPT + call endrun('frierson_pbl_tend() PBL_OPT ERROR') + endif + Tsurf(:ncol,lchnk) = Tsfc (:ncol) + Qsurf(:ncol,lchnk) = Qsfc (:ncol) + Cd (:ncol,lchnk) = Cdrag(:ncol) + + ! Back out tendencies from updated fields + !----------------------------------------- + do kk = 1, pver + ptend%s(:ncol,kk ) = (T (:,kk)-state%T(:ncol,kk ))/ztodt*cpair + ptend%u(:ncol,kk ) = (U (:,kk)-state%U(:ncol,kk ))/ztodt + ptend%v(:ncol,kk ) = (V (:,kk)-state%V(:ncol,kk ))/ztodt + ptend%q(:ncol,kk,1) = (qv(:,kk)-state%q(:ncol,kk,1))/ztodt + end do + + ! Archive diagnostic fields + !---------------------------- + call outfld('gray_Tsurf' ,Tsurf(:ncol,lchnk) ,ncol,lchnk) + call outfld('gray_Qsurf' ,Qsurf(:ncol,lchnk) ,ncol,lchnk) + call outfld('gray_Cdrag' ,Cd (:ncol,lchnk) ,ncol,lchnk) + call outfld('gray_Zpbl' ,Z_pbl ,ncol,lchnk) ! + call outfld('gray_KVH' ,Ke ,ncol,lchnk) ! Eddy diffusivity (heat and moisture,m2/s) + call outfld('gray_KVM' ,Km ,ncol,lchnk) ! Eddy diffusivity (momentum, m2/s) + call outfld('gray_VSE' ,VSE ,ncol,lchnk) ! Virtual Dry Static Energy divided by Cp (K) + call outfld('gray_Zm' ,Zm ,ncol,lchnk) ! + call outfld('gray_Rf' ,Rf ,ncol,lchnk) ! + call outfld('gray_DTV' ,dtdt_vdiff ,ncol,lchnk) ! PBL + surface flux T tendency (K/s) + call outfld('gray_DUV' ,dudt_vdiff ,ncol,lchnk) ! PBL u tendency (m/s2) + call outfld('gray_DVV' ,dvdt_vdiff ,ncol,lchnk) ! PBL v tendency (m/s2) + call outfld('gray_VD01' ,dqdt_vdiff ,ncol,lchnk) ! PBL + surface flux Q tendency (kg/kg/s) + call outfld('gray_SHflux',SHflux(:ncol,lchnk),ncol,lchnk) ! Sensible Heat Flux + call outfld('gray_LHflux',LHflux(:ncol,lchnk),ncol,lchnk) ! Latent Heat Flux + call outfld('gray_TauU' ,TUflux(:ncol,lchnk),ncol,lchnk) ! U Surface Stress + call outfld('gray_TauV' ,TVflux(:ncol,lchnk),ncol,lchnk) ! V Surface Stress + + end subroutine frierson_pbl_tend + !============================================================================ + + + !============================================================================ + subroutine frierson_radiative_tend(state, ptend, ztodt,cam_in,cam_out) + ! + ! frierson_radiative_tend: Run the radiative process + !========================================================================= + use physics_types,only: physics_state, physics_ptend + use physics_types,only: physics_ptend_init + use phys_grid, only: get_rlat_all_p + use frierson, only: frierson_radiation,frierson_radiation_USER + ! + ! Passed Variables + !------------------ + type(physics_state),intent(in) :: state + real(r8) ,intent(in) :: ztodt + type(physics_ptend),intent(out) :: ptend + type(cam_in_t), intent(inout):: cam_in + type(cam_out_t), intent(inout):: cam_out + ! + ! Local Values + !--------------- + real(r8):: T (state%ncol,pver) ! T temporary + real(r8):: qv (state%ncol,pver) ! Q temporary + real(r8):: dtdt_heating(state%ncol,pver) ! Longwave heating tendency K/s + real(r8):: dtdt_solar (state%ncol,pver) ! Shortwave heating tendency K/s + real(r8):: Tsfc (state%ncol) ! Surface T + real(r8):: Qsfc (state%ncol) ! Surface Q (saturated) + logical :: lq(pcnst) ! Calc tendencies? + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: k ! loop index + + ! Copy to local values + !------------------------------------------------- + lchnk = state%lchnk + ncol = state%ncol + T (:ncol,:) = state%T(:ncol,:) + qv (:ncol,:) = state%Q(:ncol,:,1) + + !-------------------------------------- + Tsfc(:ncol) = Tsurf(:ncol,lchnk) + Qsfc(:ncol) = Qsurf(:ncol,lchnk) + + ! initialize individual parameterization tendencies + !--------------------------------------------------- + lq(:) = .false. + call physics_ptend_init(ptend, state%psetcols, 'Frierson radiative_tend', & + ls=.true., lu=.false., lv=.false., lq=lq) + + ! Call the Selected radiative routine + !-------------------------------------------------------- + if(RADIATION_OPT == RADIATION_FRIERSON) then + call frierson_radiation(ncol,pver,ztodt,clat(:ncol,lchnk), & + state%pint(:ncol,:), & + state%pmid(:ncol,:), & + state%ps(:ncol), & + Tsfc(:ncol), & + Qsfc(:ncol), & + T(:ncol,:), & + qv(:ncol,:), & + dtdt_heating(:ncol,:), & + Fsolar(:ncol,lchnk), & + Fup(:ncol,lchnk), & + Fdown(:ncol,lchnk), & + Fup_toa(:ncol,lchnk), & + Fdown_toa(:ncol,lchnk) ) + dtdt_solar(:ncol,:) = 0._r8 + elseif(RADIATION_OPT == RADIATION_USER) then + call frierson_radiation_USER(ncol,pver,ztodt,clat(:ncol,lchnk), & + state%pint(:ncol,:), & + state%pmid(:ncol,:), & + state%ps(:ncol), & + Tsfc(:ncol), & + Qsfc(:ncol), & + T(:ncol,:), & + qv(:ncol,:), & + dtdt_heating(:ncol,:), & + Fsolar(:ncol,lchnk), & + Fup(:ncol,lchnk), & + Fdown(:ncol,lchnk), & + Fup_toa(:ncol,lchnk), & + Fdown_toa(:ncol,lchnk) ) + dtdt_solar(:ncol,:) = 0._r8 + else + ! ERROR: Unknown RADIATION_OPT value + !------------------------------------- + write(iulog,*) 'ERROR: unknown RADIATION_OPT=',RADIATION_OPT + call endrun('frierson_pbl_tend() RADIATION_OPT ERROR') + endif + + Fnet (:ncol,lchnk) = Fup(:ncol,lchnk) - Fdown (:ncol,lchnk) + Fnet_toa (:ncol,lchnk) = Fup_toa(:ncol,lchnk) - Fdown_toa (:ncol,lchnk) + + ! Copy downward LW radiative heating values to cam_out% + !--------------------------------------------------------- + cam_out%flwds(:ncol) = Fdown (:ncol,lchnk) + cam_out%netsw(:ncol) = Fsolar(:ncol,lchnk) + cam_out%sols (:ncol) = Fsolar(:ncol,lchnk) + cam_out%solsd(:ncol) = Fsolar(:ncol,lchnk) + cam_out%soll (:ncol) = Fsolar(:ncol,lchnk) + cam_out%solld(:ncol) = Fsolar(:ncol,lchnk) + + ! Back out tendencies from updated T field + !-------------------------------------------- + do k = 1, pver + ptend%s(:ncol,k) = (T(:,k)-state%T(:ncol,k))/ztodt*cpair + end do + + ! Archive T tendency from temperature relaxation (mimics radiation, K/s) + !----------------------------------------------------------------------- + call outfld('gray_QRL' ,dtdt_heating, ncol,lchnk) + call outfld('gray_QRS' ,dtdt_solar , ncol,lchnk) + call outfld('gray_SWflux',Fsolar(:ncol,lchnk) , ncol,lchnk) + call outfld('gray_LUflux',Fup(:ncol,lchnk) , ncol,lchnk) + call outfld('gray_LDflux',Fdown(:ncol,lchnk) , ncol,lchnk) + call outfld('gray_LWflux',Fnet(:ncol,lchnk) , ncol,lchnk) + call outfld('gray_LUflux_TOA',Fup_toa(:ncol,lchnk) , ncol,lchnk) + call outfld('gray_LDflux_TOA',Fdown_toa(:ncol,lchnk) , ncol,lchnk) + call outfld('gray_LWflux_TOA',Fnet_toa(:ncol,lchnk) , ncol,lchnk) + + end subroutine frierson_radiative_tend + !============================================================================ + + + !======================================================================= + subroutine frierson_surface_init(ncol, clat, PS, Tsfc, Qsfc) + ! + ! + !========================================================================== + ! + ! Passed variables + !-------------------- + integer ,intent(in) :: ncol + real(r8),intent(in) :: clat (ncol) + real(r8),intent(in) :: PS (ncol) + real(r8),intent(out):: Tsfc(ncol) + real(r8),intent(out):: Qsfc(ncol) + ! + ! Local values + !-------------- + integer :: ii + real(r8):: T_width + + ! set SST profile + !------------------ + T_width = frierson_Twidth*pi/180.0_r8 + do ii = 1, ncol + Tsfc(ii) = frierson_Tmin + frierson_Tdlt*exp(-((clat(ii)/T_width)**2)/2.0_r8) + Qsfc(ii) = epsilo*frierson_E0/PS(ii) & + *exp(-latvap/rh2o*((1._r8/Tsfc(ii))-1._r8/frierson_T0)) + end do + + end subroutine frierson_surface_init + !======================================================================= + + + !======================================================================= + subroutine frierson_restart_init(File,hdimids,hdimcnt) + ! + ! frierson_restart_init: + !========================================================================== + ! + ! Passed variables + !-------------------- + type(file_desc_t),intent(inout):: File + integer ,intent(in) :: hdimcnt + integer ,intent(in) :: hdimids(1:hdimcnt) + ! + ! Local values + !-------------- + integer:: ierr + + ierr = pio_def_var(File,'Frierson_Tsfc',pio_double, hdimids, Tsurf_desc) + if (ierr /= 0) then + call endrun('frierson_restart_init: ERROR defining Frierson_Tsfc') + end if + + ierr = pio_def_var(File,'Frierson_Qsfc',pio_double, hdimids, Qsurf_desc) + if (ierr /= 0) then + call endrun('frierson_restart_init: ERROR defining Frierson_Qsfc') + end if + + end subroutine frierson_restart_init + !======================================================================= + + + !======================================================================= + subroutine frierson_restart_write(File) + ! + ! frierson_restart_write: + !========================================================================== + ! + ! Passed variables + !-------------------- + type(file_desc_t),intent(inout):: File + ! + ! Local values + !-------------- + type(io_desc_t),pointer:: iodesc + integer:: dims(3),gdims(3),nhdims + integer:: physgrid + integer:: ierr + + ! Get the iodesc for write calls + !--------------------------------- + dims(1) = pcols + dims(2) = endchunk - begchunk + 1 + physgrid = cam_grid_id('physgrid') + call cam_grid_dimensions(physgrid, gdims(1:2), nhdims) + call cam_grid_get_decomp(physgrid, dims(1:2), gdims(1:nhdims), pio_double, iodesc) + + ! Write Surface values + !--------------------- + call pio_write_darray(File, Tsurf_desc, iodesc, Tsurf, ierr) + if (ierr /= 0) then + call endrun('frierson_restart_write: ERROR writing Tsurf') + end if + + call pio_write_darray(File, Qsurf_desc, iodesc, Qsurf, ierr) + if (ierr /= 0) then + call endrun('frierson_restart_write: ERROR writing Qsurf') + end if + + end subroutine frierson_restart_write + !======================================================================= + + + !======================================================================= + subroutine frierson_restart_read(File) + ! + ! frierson_restart_read: + !========================================================================== + use error_messages,only: alloc_err + ! + ! Passed variables + !-------------------- + type(file_desc_t),intent(inout):: File + ! + ! Local values + !-------------- + type( io_desc_t),pointer:: iodesc + type(var_desc_t) :: vardesc + integer:: dims(3),gdims(3),nhdims + integer:: physgrid + integer:: ierr + + ! Allocate space for the restart fields + !----------------------------------------- + allocate(Tsurf (pcols,begchunk:endchunk),stat=ierr) + call alloc_err(ierr,'Frierson RESTART','Tsurf' ,pcols*(endchunk-begchunk+1)) + allocate(Qsurf (pcols,begchunk:endchunk) ,stat=ierr) + call alloc_err(ierr,'Frierson RESTART','Qsurf' ,pcols*(endchunk-begchunk+1)) + + ! Get the iodesc for read calls + !--------------------------------- + dims(1) = pcols + dims(2) = endchunk - begchunk + 1 + physgrid = cam_grid_id('physgrid') + call cam_grid_dimensions(physgrid, gdims(1:2), nhdims) + call cam_grid_get_decomp(physgrid, dims(1:2), gdims(1:nhdims), pio_double, iodesc) + + ! Read Surface values + !--------------------- + ierr = pio_inq_varid(File,'Frierson_Tsfc',vardesc) + if (ierr /= 0) then + call endrun('frierson_restart_read: ERROR PIO unable to find variable Frierson_Tsfc') + end if + + call pio_read_darray(File, vardesc, iodesc, Tsurf, ierr) + if (ierr /= 0) then + call endrun('frierson_restart_read: ERROR PIO unable to read variable Tsurf') + end if + + ierr = pio_inq_varid(File,'Frierson_Qsfc',vardesc) + if (ierr /= 0) then + call endrun('frierson_restart_read: ERROR PIO unable to find variable Frierson_Qsfc') + end if + + call pio_read_darray(File, vardesc, iodesc, Qsurf, ierr) + if (ierr /= 0) then + call endrun('frierson_restart_read: ERROR PIO unable to read variable Qsurf') + end if + + end subroutine frierson_restart_read + !======================================================================= + +end module frierson_cam + diff --git a/src/physics/simple/held_suarez.F90 b/src/physics/simple/held_suarez.F90 deleted file mode 100644 index f9c728b455..0000000000 --- a/src/physics/simple/held_suarez.F90 +++ /dev/null @@ -1,167 +0,0 @@ -module held_suarez - !----------------------------------------------------------------------- - ! - ! Purpose: Implement idealized Held-Suarez forcings - ! 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. - ! - !----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none - private - save - - public :: held_suarez_1994_init - public :: held_suarez_1994 - - !! - !! Forcing parameters - !! - real(r8), parameter :: efoldf = 1._r8 ! efolding time for wind dissipation - real(r8), parameter :: efolda = 40._r8 ! efolding time for T dissipation - real(r8), parameter :: efolds = 4._r8 ! efolding time for T dissipation - real(r8), parameter :: sigmab = 0.7_r8 ! threshold sigma level - real(r8), parameter :: t00 = 200._r8 ! minimum reference temperature - real(r8), parameter :: kf = 1._r8/(86400._r8*efoldf) ! 1./efolding_time for wind dissipation - - real(r8), parameter :: onemsig = 1._r8 - sigmab ! 1. - sigma_reference - - real(r8), parameter :: ka = 1._r8/(86400._r8 * efolda) ! 1./efolding_time for temperature diss. - real(r8), parameter :: ks = 1._r8/(86400._r8 * efolds) - - !! - !! Model constants, reset in init call - !! - real(r8) :: cappa = 2.0_r8 / 7.0_r8 ! R/Cp - real(r8) :: cpair = 1004.0_r8 ! specific heat of dry air (J/K/kg) - real(r8) :: psurf_ref = 0.0_r8 ! Surface pressure - ! pref_mid_norm are layer midpoints normalized by surface pressure ('eta' coordinate) - real(r8), allocatable :: pref_mid_norm(:) - integer :: pver ! Num vertical levels - - - -!======================================================================= -contains -!======================================================================= - - subroutine held_suarez_1994_init(cappa_in, cpair_in, psurf_ref_in, pref_mid_norm_in) - !! Dummy arguments - real(r8), intent(in) :: cappa_in - real(r8), intent(in) :: cpair_in - real(r8), intent(in) :: psurf_ref_in - real(r8), intent(in) :: pref_mid_norm_in(:) - - pver = size(pref_mid_norm_in) - allocate(pref_mid_norm(pver)) - cappa = cappa_in - cpair = cpair_in - psurf_ref = psurf_ref_in - pref_mid_norm = pref_mid_norm_in - - end subroutine held_suarez_1994_init - - subroutine held_suarez_1994(pcols, ncol, clat, pmid, & - u, v, t, du, dv, s) - - ! - ! Input arguments - ! - integer, intent(in) :: pcols ! Size of column dimension - integer, intent(in) :: ncol ! Num active columns - real(r8), intent(in) :: clat(pcols) ! latitudes(radians) for columns - real(r8), intent(in) :: pmid(pcols,pver) ! mid-point pressure - real(r8), intent(in) :: u(pcols,pver) ! Zonal wind (m/s) - real(r8), intent(in) :: v(pcols,pver) ! Meridional wind (m/s) - real(r8), intent(in) :: t(pcols,pver) ! Temperature (K) - ! - ! Output arguments - ! - real(r8), intent(out) :: du(pcols,pver) ! Zonal wind tend - real(r8), intent(out) :: dv(pcols,pver) ! Meridional wind tend - real(r8), intent(out) :: s(pcols,pver) ! Heating rate - ! - !---------------------------Local workspace----------------------------- - ! - integer :: i, k ! Longitude, level indices - - real(r8) :: kv ! 1./efolding_time (normalized) for wind - real(r8) :: kt ! 1./efolding_time for temperature diss. - real(r8) :: trefa ! "radiative equilibrium" T - real(r8) :: trefc ! used in calc of "radiative equilibrium" T - real(r8) :: cossq(ncol) ! coslat**2 - real(r8) :: cossqsq(ncol) ! coslat**4 - real(r8) :: sinsq(ncol) ! sinlat**2 - real(r8) :: coslat(ncol) ! cosine(latitude) - ! - !----------------------------------------------------------------------- - ! - - 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 - - ! - !----------------------------------------------------------------------- - ! - ! Held/Suarez IDEALIZED physics algorithm: - ! - ! 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. - ! - !----------------------------------------------------------------------- - ! - ! Compute idealized radiative heating rates (as dry static energy) - ! - ! - do k = 1, pver - if (pref_mid_norm(k) > sigmab) then - do i = 1, ncol - kt = ka + (ks - ka)*cossqsq(i)*(pref_mid_norm(k) - sigmab)/onemsig - trefc = 315._r8 - (60._r8 * sinsq(i)) - trefa = (trefc - 10._r8*cossq(i)*log((pmid(i,k)/psurf_ref)))*(pmid(i,k)/psurf_ref)**cappa - trefa = max(t00,trefa) - s(i,k) = (trefa - t(i,k))*kt*cpair - end do - else - do i = 1, ncol - trefc = 315._r8 - 60._r8*sinsq(i) - trefa = (trefc - 10._r8*cossq(i)*log((pmid(i,k)/psurf_ref)))*(pmid(i,k)/psurf_ref)**cappa - trefa = max(t00,trefa) - s(i,k) = (trefa - t(i,k))*ka*cpair - end do - end if - end do - ! - ! Add diffusion near the surface for the wind fields - ! - do k = 1, pver - do i = 1, pcols - du(i,k) = 0._r8 - dv(i,k) = 0._r8 - end do - end do - - ! - do k = 1, pver - if (pref_mid_norm(k) > sigmab) then - kv = kf*(pref_mid_norm(k) - sigmab)/onemsig - do i = 1, ncol - du(i,k) = -kv*u(i,k) - dv(i,k) = -kv*v(i,k) - end do - end if - end do - - end subroutine held_suarez_1994 - -end module held_suarez diff --git a/src/physics/simple/held_suarez_cam.F90 b/src/physics/simple/held_suarez_cam.F90 index 8040d2b3a2..78def4b354 100644 --- a/src/physics/simple/held_suarez_cam.F90 +++ b/src/physics/simple/held_suarez_cam.F90 @@ -1,13 +1,13 @@ module held_suarez_cam - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: Implement idealized Held-Suarez forcings ! 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. - ! + ! !----------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 @@ -31,21 +31,22 @@ module held_suarez_cam real(r8), parameter :: ka = 1._r8/(86400._r8 * efolda) ! 1./efolding_time for temperature diss. real(r8), parameter :: ks = 1._r8/(86400._r8 * efolds) -!======================================================================= +!======================================================================= contains -!======================================================================= +!======================================================================= - subroutine held_suarez_init(pbuf2d) + subroutine held_suarez_init() use physics_buffer, only: physics_buffer_desc use cam_history, only: addfld, add_default - use physconst, only: cappa, cpair - use ref_pres, only: pref_mid_norm, psurf_ref - use held_suarez, only: held_suarez_1994_init + use ref_pres, only: psurf_ref + use held_suarez_1994, only: held_suarez_1994_init - type(physics_buffer_desc), pointer :: pbuf2d(:,:) + ! Local variables + character(len=512) :: errmsg + integer :: errflg ! Set model constant values - call held_suarez_1994_init(cappa, cpair, psurf_ref, pref_mid_norm) + call held_suarez_1994_init(psurf_ref, errmsg, errflg) ! This field is added by radiation when full physics is used call addfld('QRS', (/ 'lev' /), 'A', 'K/s', & @@ -54,13 +55,14 @@ subroutine held_suarez_init(pbuf2d) end subroutine held_suarez_init subroutine held_suarez_tend(state, ptend, ztodt) - use physconst, only: cpairv + use air_composition, only: cappav, cpairv + use ref_pres, only: pref_mid_norm use phys_grid, only: get_rlat_all_p use physics_types, only: physics_state, physics_ptend use physics_types, only: physics_ptend_init use cam_abortutils, only: endrun use cam_history, only: outfld - use held_suarez, only: held_suarez_1994 + use held_suarez_1994, only: held_suarez_1994_run ! ! Input arguments @@ -81,6 +83,10 @@ subroutine held_suarez_tend(state, ptend, ztodt) real(r8) :: pmid(pcols,pver) ! mid-point pressure integer :: i, k ! Longitude, level indices + character(len=64) :: scheme_name ! CCPP-required variables (not used in CAM) + character(len=512) :: errmsg + integer :: errflg + ! !----------------------------------------------------------------------- ! @@ -98,8 +104,11 @@ subroutine held_suarez_tend(state, ptend, ztodt) ! initialize individual parameterization tendencies call physics_ptend_init(ptend, state%psetcols, 'held_suarez', ls=.true., lu=.true., lv=.true.) - call held_suarez_1994(pcols, ncol, clat, state%pmid, & - state%u, state%v, state%t, ptend%u, ptend%v, ptend%s) + call held_suarez_1994_run(pver, ncol, pref_mid_norm, clat, cappav(1:ncol,:,lchnk), & + cpairv(1:ncol,:,lchnk), state%pmid(1:ncol,:), & + state%u(1:ncol,:), state%v(1:ncol,:), state%t(1:ncol,:), & + ptend%u(1:ncol,:), ptend%v(1:ncol,:), ptend%s(1:ncol,:), & + scheme_name, errmsg, errflg) ! Note, we assume that there are no subcolumns in simple physics pmid(:ncol,:) = ptend%s(:ncol, :)/cpairv(:ncol,:,lchnk) diff --git a/src/physics/simple/kessler_cam.F90 b/src/physics/simple/kessler_cam.F90 index d6319962f1..93e961cd97 100644 --- a/src/physics/simple/kessler_cam.F90 +++ b/src/physics/simple/kessler_cam.F90 @@ -39,22 +39,26 @@ end subroutine kessler_register !======================================================================================== - subroutine kessler_cam_init(pbuf2d) + subroutine kessler_cam_init() - use physconst, only: cpair, latvap,pstd, rair, rhoh2o + use physconst, only: latvap, rhoh2o + use ref_pres, only: psurf_ref use constituents, only: cnst_name, cnst_longname, bpcnst, apcnst - use cam_history, only: addfld, add_default, horiz_only + use cam_history, only: addfld, add_default use cam_abortutils, only: endrun - use state_converters, only: pres_to_density_dry_init - use kessler, only: kessler_init - use state_converters, only: calc_exner_init + use kessler, only: kessler_init - integer :: errflg - character(len=512) :: errmsg + ! + !---------------------------Local workspace----------------------------- + ! + integer :: errflg + character(len=512) :: errmsg - type(physics_buffer_desc), pointer :: pbuf2d(:,:) + ! + !----------------------------------------------------------------------- + ! errflg = 0 @@ -68,52 +72,43 @@ subroutine kessler_cam_init(pbuf2d) call add_default(cnst_name(ixrain), 1, ' ') ! Initialize Kessler with CAM physical constants - - if (errflg == 0) then - call kessler_init(cpair, latvap, pstd, rair, rhoh2o, errmsg, errflg) - if (errflg /=0) then - call endrun('kessler_cam_init error: Error returned from kessler_init: '//trim(errmsg)) - end if - end if - if (errflg == 0) then - call pres_to_density_dry_init(cpair, rair, errmsg, errflg) - if (errflg /=0) then - call endrun('kessler_cam_init error: Error returned from pres_to_density_dry_init: '//trim(errmsg)) - end if - end if - if (errflg == 0) then - call calc_exner_init(errmsg, errflg) - if (errflg /=0) then - call endrun('kessler_cam_init error: Error returned from calc_exner_init: '//trim(errmsg)) - end if - end if + call kessler_init(latvap, psurf_ref, rhoh2o, errmsg, errflg) + if (errflg /=0) then + call endrun('kessler_cam_init error: Error returned from kessler_init: '//trim(errmsg)) + end if end subroutine kessler_cam_init !======================================================================================== subroutine kessler_tend(state, ptend, ztodt, pbuf) - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: Run Kessler physics (see kessler.F90) - ! + ! !----------------------------------------------------------------------- - use shr_kind_mod, only: SHR_KIND_CM - use physconst, only: cpair, rair, zvir - use physics_types, only: physics_state, physics_ptend - use physics_types, only: physics_ptend_init - use constituents, only: pcnst, cnst_name, cnst_type + use shr_kind_mod, only: SHR_KIND_CM + use ref_pres, only: psurf_ref + use physconst, only: rh2o + use air_composition, only: cpairv, rairv + use physics_types, only: physics_state, physics_ptend + use physics_types, only: physics_ptend_init + use constituents, only: pcnst, cnst_name, cnst_type use kessler, only: kessler_run - use state_converters, only: wet_to_dry_run - use state_converters, only: dry_to_wet_run - use state_converters, only: pres_to_density_dry_run + use state_converters, only: wet_to_dry_water_vapor_run + use state_converters, only: wet_to_dry_cloud_liquid_water_run + use state_converters, only: wet_to_dry_rain_run + use state_converters, only: dry_to_wet_water_vapor_run + use state_converters, only: dry_to_wet_cloud_liquid_water_run + use state_converters, only: dry_to_wet_rain_run use state_converters, only: temp_to_potential_temp_run use state_converters, only: calc_exner_run + use state_converters, only: calc_dry_air_ideal_gas_density_run use state_converters, only: potential_temp_to_temp_run - use cam_abortutils, only: endrun - use cam_history, only: outfld + use cam_abortutils, only: endrun + use cam_history, only: outfld ! arguments @@ -122,28 +117,36 @@ subroutine kessler_tend(state, ptend, ztodt, pbuf) type(physics_ptend), intent(out) :: ptend ! Package tendencies type(physics_buffer_desc), pointer :: pbuf(:) + ! !---------------------------Local workspace----------------------------- ! - integer :: lchnk ! chunk identifier - integer :: ncol ! number of atmospheric columns + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns integer :: lyr_surf integer :: lyr_toa - real(r8) :: rho(pcols,pver) ! Dry air density - real(r8) :: pk(pcols,pver) ! exner func. - real(r8) :: th(pcols,pver) ! Potential temp. - real(r8) :: temp(pcols,pver) ! temperature - real(r8) :: qv(pcols,pver) ! Water vapor - real(r8) :: qc(pcols,pver) ! Cloud water - real(r8) :: qr(pcols,pver) ! Rain water - integer :: k,rk ! vert. indices - logical :: lq(pcnst) ! Calc tendencies? - character(len=SHR_KIND_CM) :: errmsg + real(r8) :: zvirv(pcols,pver) ! ratio of water vapor to dry air constants - 1 + real(r8) :: rho(pcols,pver) ! Dry air density + real(r8) :: pk(pcols,pver) ! exner func. + real(r8) :: th(pcols,pver) ! Potential temp. + real(r8) :: temp(pcols,pver) ! temperature + real(r8) :: qv(pcols,pver) ! Water vapor mixing ratio wrt moist air + real(r8) :: qc(pcols,pver) ! Cloud water mixing ratio wrt moist air + real(r8) :: qr(pcols,pver) ! Rain mixing ratio wrt moist air + real(r8) :: qv_dry(pcols,pver) ! Water vapor mixing ratio wrt dry air + real(r8) :: qc_dry(pcols,pver) ! Cloud water mixing ratio wrt dry air + real(r8) :: qr_dry(pcols,pver) ! Rain mixing ratio wrt dry air - integer :: errflg + integer :: k,rk ! vert. indices + logical :: lq(pcnst) ! Calc tendencies? + character(len=SHR_KIND_CM) :: errmsg ! CCPP physics scheme error message + + integer :: errflg ! CCPP physics scheme error flag - real(r8), pointer :: prec_sed(:) ! total precip from cloud sedimentation - real(r8), pointer :: relhum(:,:) ! relative humidity + character(len=64) :: scheme_name ! CCPP physics scheme name (not used in CAM) + + real(r8), pointer :: prec_sed(:) ! total precip from cloud sedimentation + real(r8), pointer :: relhum(:,:) ! relative humidity integer :: i @@ -169,63 +172,110 @@ subroutine kessler_tend(state, ptend, ztodt, pbuf) call pbuf_get_field(pbuf, relhum_idx, relhum) do k = 1, pver - ! Create temporaries for state variables changed by Kessler routine - temp(:ncol,k) = state%t(:ncol,k) - qv(:ncol,k) = state%q(:ncol,k,1) - qc(:ncol,k) = state%q(:ncol,k,ixcldliq) - qr(:ncol,k) = state%q(:ncol,k,ixrain) + ! Create temporaries for state variables changed by Kessler routine + temp(:ncol,k) = state%t(:ncol,k) + qv(:ncol,k) = state%q(:ncol,k,1) + qc(:ncol,k) = state%q(:ncol,k,ixcldliq) + qr(:ncol,k) = state%q(:ncol,k,ixrain) + + !Also calculate gas constant ratio: + zvirv(:ncol,k) = rh2o/rairv(:ncol,k, lchnk) - 1._r8 end do - - if (errflg == 0) then - call calc_exner_run(ncol, pver, cpair, rair, state%pmid, pk, errmsg, errflg) - if (errflg /=0) then - call endrun('kessler_tend error: Error returned from calc_exner_run: '//trim(errmsg)) - end if + + ! Calculate Exner function: + call calc_exner_run(ncol, pver, cpairv(1:ncol,:,lchnk), rairv(1:ncol,:,lchnk), & + psurf_ref, state%pmid(1:ncol,:), pk(1:ncol,:), errmsg, errflg) + if (errflg /=0) then + call endrun('kessler_tend error: Error returned from calc_exner_run: '//trim(errmsg)) + end if + + ! Calculate potential temperature: + call temp_to_potential_temp_run(ncol, pver, temp(1:ncol,:), pk(1:ncol,:), & + th(1:ncol,:), errmsg, errflg) + if (errflg /=0) then + call endrun('kessler_tend error: Error returned from temp_to_potential_temp_run: '//trim(errmsg)) end if - if (errflg == 0) then - call temp_to_potential_temp_run(ncol, pver, temp, pk, th, errmsg, errflg) - if (errflg /=0) then - call endrun('kessler_tend error: Error returned from temp_to_potential_temp_run: '//trim(errmsg)) - end if + + ! Calculate density using ideal gas law: + call calc_dry_air_ideal_gas_density_run(ncol, pver, rairv(1:ncol,:,lchnk), & + state%pmiddry(1:ncol,:), temp(1:ncol,:), & + rho(1:ncol,:), errmsg, errflg) + if (errflg /=0) then + call endrun('kessler_tend error: Error returned from pres_to_density_dry_run: '//trim(errmsg)) end if - if (errflg == 0) then - call pres_to_density_dry_run(ncol, pver, state%pmiddry, temp, rho, errmsg, errflg) - if (errflg /=0) then - call endrun('kessler_tend error: Error returned from pres_to_density_dry_run: '//trim(errmsg)) - end if + + ! Convert moist air mixing ratios to dry air mixing ratios: + !--------------------------------------------------------- + call wet_to_dry_water_vapor_run(ncol, pver, state%pdel(1:ncol,:), & + state%pdeldry(1:ncol,:), qv(1:ncol,:), & + qv_dry(1:ncol,:), errmsg, errflg) + if (errflg /=0) then + call endrun('kessler_tend error: Error returned from wet_to_dry_water_vapor_run: '//trim(errmsg)) end if - if (errflg == 0) then - call wet_to_dry_run(ncol, pver, state%pdel, state%pdeldry, qv, qc, qr, errmsg, errflg) - if (errflg /=0) then - call endrun('kessler_tend error: Error returned from wet_to_dry_run: '//trim(errmsg)) - end if + + call wet_to_dry_cloud_liquid_water_run(ncol, pver, state%pdel(1:ncol,:), & + state%pdeldry(1:ncol,:), qc(1:ncol,:), & + qc_dry(1:ncol,:), errmsg, errflg) + if (errflg /=0) then + call endrun('kessler_tend error: Error returned from wet_to_dry_cloud_liquid_water_run: '//trim(errmsg)) end if - if (errflg == 0) then - call kessler_run(ncol, pver, ztodt, lyr_surf, lyr_toa, & - rho, state%zm, pk, th, qv, qc, qr, prec_sed, relhum, errmsg, errflg) - if (errflg /=0) then - call endrun('kessler_tend error: Error returned from kessler_run: '//trim(errmsg)) - end if + + call wet_to_dry_rain_run(ncol, pver, state%pdel(1:ncol,:), & + state%pdeldry(1:ncol,:), qr(1:ncol,:), & + qr_dry(1:ncol,:), errmsg, errflg) + if (errflg /=0) then + call endrun('kessler_tend error: Error returned from wet_to_dry_rain_run: '//trim(errmsg)) end if - if (errflg == 0) then - call potential_temp_to_temp_run(ncol, pver, th, pk, temp, errmsg, errflg) - if (errflg /=0) then - call endrun('kessler_tend error: Error returned from potential_temp_to_temp_run: '//trim(errmsg)) - end if + !--------------------------------------------------------- + + ! Run Kessler physics scheme: + call kessler_run(ncol, pver, ztodt, lyr_surf, lyr_toa, cpairv(1:ncol,:,lchnk), & + rairv(1:ncol,:,lchnk), rho(1:ncol,:), state%zm(1:ncol,:), & + pk(1:ncol,:), th(1:ncol,:), qv_dry(1:ncol,:), qc_dry(1:ncol,:), & + qr_dry(1:ncol,:), prec_sed(1:ncol), relhum(1:ncol,:), & + scheme_name, errmsg, errflg) + if (errflg /=0) then + call endrun('kessler_tend error: Error returned from kessler_run: '//trim(errmsg)) end if - if (errflg == 0) then - call dry_to_wet_run(ncol, pver, state%pdel, state%pdeldry, qv, qc, qr, errmsg, errflg) - if (errflg /=0) then - call endrun('kessler_tend error: Error returned from dry_to_wet_run: '//trim(errmsg)) - end if + + ! Calculate air temperature from potential temperature: + call potential_temp_to_temp_run(ncol, pver, th(1:ncol,:), pk(1:ncol,:), & + temp(1:ncol,:), errmsg, errflg) + if (errflg /=0) then + call endrun('kessler_tend error: Error returned from potential_temp_to_temp_run: '//trim(errmsg)) + end if + + ! Convert dry air mixing ratios to moist air mixing ratios: + !--------------------------------------------------------- + call dry_to_wet_water_vapor_run(ncol, pver, state%pdel(1:ncol,:), & + state%pdeldry(1:ncol,:), qv_dry(1:ncol,:), & + qv(1:ncol,:), errmsg, errflg) + if (errflg /=0) then + call endrun('kessler_tend error: Error returned from dry_to_wet_water_vapor_run: '//trim(errmsg)) + end if + + call dry_to_wet_cloud_liquid_water_run(ncol, pver, state%pdel(1:ncol,:), & + state%pdeldry(1:ncol,:), & + qc_dry(1:ncol,:), qc(1:ncol,:), errmsg, & + errflg) + if (errflg /=0) then + call endrun('kessler_tend error: Error returned from dry_to_wet_cloud_liquid_water_run: '//trim(errmsg)) + end if + + call dry_to_wet_rain_run(ncol, pver, state%pdel(1:ncol,:), & + state%pdeldry(1:ncol,:), qr_dry(1:ncol,:), & + qr(1:ncol,:), errmsg, errflg) + if (errflg /=0) then + call endrun('kessler_tend error: Error returned from dry_to_wet_rain_run: '//trim(errmsg)) end if + !--------------------------------------------------------- ! Back out tendencies from updated fields do k = 1, pver - ptend%s(:ncol,k) = (th(:ncol,k)*pk(:ncol,k) - state%t(:ncol,k)) * cpair / ztodt - ptend%q(:ncol,k,1) = (qv(:ncol,k) - state%q(:ncol,k,1)) / ztodt - ptend%q(:ncol,k,ixcldliq) = (qc(:ncol,k) - state%q(:ncol,k,ixcldliq)) / ztodt - ptend%q(:ncol,k,ixrain) = (qr(:ncol,k) - state%q(:ncol,k,ixrain)) / ztodt + ptend%s(:ncol,k) = (th(:ncol,k)*pk(:ncol,k) - state%t(:ncol,k)) * cpairv(:ncol,k,lchnk) / ztodt + ptend%q(:ncol,k,1) = (qv(:ncol,k) - state%q(:ncol,k,1)) / ztodt + ptend%q(:ncol,k,ixcldliq) = (qc(:ncol,k) - state%q(:ncol,k,ixcldliq)) / ztodt + ptend%q(:ncol,k,ixrain) = (qr(:ncol,k) - state%q(:ncol,k,ixrain)) / ztodt end do ! Output liquid tracers diff --git a/src/physics/simple/physpkg.F90 b/src/physics/simple/physpkg.F90 index 0440b54e07..0bbb63dd7e 100644 --- a/src/physics/simple/physpkg.F90 +++ b/src/physics/simple/physpkg.F90 @@ -19,12 +19,13 @@ module physpkg use camsrfexch, only: cam_out_t, cam_in_t, cam_export ! Note: ideal_phys is true for Held-Suarez (1994) physics - use cam_control_mod, only: moist_physics, adiabatic, ideal_phys, kessler_phys, tj2016_phys + use cam_control_mod, only: moist_physics, adiabatic, ideal_phys, kessler_phys, tj2016_phys, frierson_phys use phys_control, only: phys_getopts use perf_mod, only: t_barrierf, t_startf, t_stopf, t_adj_detailf use cam_logfile, only: iulog use cam_abortutils, only: endrun use shr_sys_mod, only: shr_sys_flush + use dyn_tests_utils, only: vc_dycore implicit none private @@ -46,6 +47,8 @@ module physpkg integer :: qini_idx = 0 integer :: cldliqini_idx = 0 integer :: cldiceini_idx = 0 + integer :: totliqini_idx = 0 + integer :: toticeini_idx = 0 logical :: state_debug_checks ! Debug physics_state. @@ -77,6 +80,7 @@ subroutine phys_register use check_energy, only: check_energy_register use kessler_cam, only: kessler_register use tj2016_cam, only: thatcher_jablonowski_register + use frierson_cam, only: frierson_register !---------------------------Local variables----------------------------- ! @@ -108,6 +112,8 @@ subroutine phys_register call kessler_register() else if (tj2016_phys) then call thatcher_jablonowski_register() + else if (frierson_phys) then + call frierson_register() end if ! Fields for physics package diagnostics @@ -116,6 +122,8 @@ subroutine phys_register if (moist_physics) then call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) + call pbuf_add_field('TOTLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), totliqini_idx) + call pbuf_add_field('TOTICEINI', 'physpkg', dtype_r8, (/pcols,pver/), toticeini_idx) end if ! check energy package @@ -183,7 +191,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) !----------------------------------------------------------------------- use physics_buffer, only: physics_buffer_desc, pbuf_initialize, pbuf_get_index - use physconst, only: physconst_init + use cam_thermo, only: cam_thermo_init use cam_control_mod, only: initial_run use check_energy, only: check_energy_init @@ -192,11 +200,18 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use held_suarez_cam, only: held_suarez_init use kessler_cam, only: kessler_cam_init use tj2016_cam, only: thatcher_jablonowski_init + use frierson_cam, only: frierson_init use tracers, only: tracers_init use wv_saturation, only: wv_sat_init use phys_debug_util, only: phys_debug_init use qneg_module, only: qneg_init + use nudging, only: Nudge_Model, nudging_init use cam_snapshot, only: cam_snapshot_init + use cam_budget, only: cam_budget_init + use constituents, only: cnst_get_ind + + + use ccpp_constituent_prop_mod, only: ccpp_const_props_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -207,7 +222,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) type(cam_out_t),intent(inout) :: cam_out(begchunk:endchunk) ! local variables - integer :: lchnk + integer :: lchnk, ixq !----------------------------------------------------------------------- call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols) @@ -220,7 +235,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! Initialize any variables in physconst which are not temporally and/or ! spatially constant !--------------------------------------------------------------------------- - call physconst_init() + call cam_thermo_init() ! Initialize debugging a physics column call phys_debug_init() @@ -237,7 +252,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! wv_saturation is relatively independent of everything else and ! low level, so init it early. Must at least do this before radiation. - if (kessler_phys .or. tj2016_phys) then + if (kessler_phys .or. tj2016_phys .or. frierson_phys) then call wv_sat_init() end if @@ -248,24 +263,38 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) end if if (ideal_phys) then - call held_suarez_init(pbuf2d) + call held_suarez_init() else if (kessler_phys) then - call kessler_cam_init(pbuf2d) + call kessler_cam_init() else if (tj2016_phys) then call thatcher_jablonowski_init(pbuf2d) + else if (frierson_phys) then + call frierson_init(phys_state,pbuf2d) end if + ! Initialize Nudging Parameters + !-------------------------------- + if(Nudge_Model) call nudging_init + if (chem_is_active()) then ! Prognostic chemistry. call chem_init(phys_state,pbuf2d) end if + ! Initialize CAM CCPP constituent properties array + ! for use in CCPP-ized physics schemes: + call cnst_get_ind('Q', ixq) + call ccpp_const_props_init(ixq) + ! Initialize qneg3 and qneg4 call qneg_init() ! Initialize the snapshot capability call cam_snapshot_init(cam_in, cam_out, pbuf2d, begchunk) + ! Initialize energy budgets + call cam_budget_init() + end subroutine phys_init !====================================================================================== @@ -467,11 +496,17 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) use constituents, only: cnst_get_ind, pcnst use cam_diagnostics, only: diag_phys_tend_writeout, diag_surf use tj2016_cam, only: thatcher_jablonowski_sfc_pbl_hs_tend + use frierson_cam, only: frierson_pbl_tend use dycore, only: dycore_is - use check_energy, only: calc_te_and_aam_budgets + use check_energy, only: tot_energy_phys use cam_history, only: hist_fld_active - use cam_snapshot, only: cam_snapshot_all_outfld - use cam_snapshot, only: cam_snapshot_ptend_outfld + use cam_thermo, only: cam_thermo_water_update + use cam_budget, only: thermo_budget_history + use dyn_tests_utils, only: vc_dycore, vc_height, vc_dry_pressure + use air_composition, only: cpairv, cp_or_cv_dycore + use time_manager, only: get_nstep + use nudging, only: Nudge_Model, Nudge_ON, nudging_timestep_tend + use check_energy, only: check_energy_cam_chng ! Arguments ! @@ -485,6 +520,9 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) !---------------------------Local workspace----------------------------- + integer :: nstep ! current timestep number + real(r8):: zero(pcols) ! array of zeros + type(physics_ptend) :: ptend ! indivdual parameterization tendencies real(r8) :: tmp_q(pcols, pver) real(r8) :: tmp_cldliq(pcols, pver) @@ -493,19 +531,28 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) real(r8), pointer :: qini(:,:) real(r8), pointer :: cldliqini(:,:) real(r8), pointer :: cldiceini(:,:) + real(r8), pointer :: totliqini(:,:) + real(r8), pointer :: toticeini(:,:) integer :: ixcldliq integer :: ixcldice integer :: k - integer :: ncol + integer :: ncol, lchnk integer :: itim_old + logical :: moist_mixing_ratio_dycore real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space real(r8) :: tmp_pdel (pcols,pver) ! tmp space real(r8) :: tmp_ps (pcols) ! tmp space + real(r8) :: scaling(pcols,pver) !-------------------------------------------------------------------------- + ! get nstep and zero array for energy checker + zero = 0._r8 + nstep = get_nstep() + ! number of active atmospheric columns ncol = state%ncol + lchnk = state%lchnk ! Associate pointers with physics buffer fields itim_old = pbuf_old_tim_idx() @@ -518,15 +565,19 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) if (moist_physics) then call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, totliqini_idx, totliqini) + call pbuf_get_field(pbuf, toticeini_idx, toticeini) else allocate(cldliqini(pcols, pver)) cldliqini = 0.0_r8 allocate(cldiceini(pcols, pver)) cldiceini = 0.0_r8 + allocate(totliqini(pcols, pver)) + totliqini = 0.0_r8 + allocate(toticeini(pcols, pver)) + toticeini = 0.0_r8 end if - call calc_te_and_aam_budgets(state, 'pAP') - !========================= ! Compute physics tendency !========================= @@ -536,16 +587,36 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) call physics_update(state, ptend, ztodt, tend) end if + if (frierson_phys) then + ! Update surface, PBL + call frierson_pbl_tend(state, ptend, ztodt, cam_in) + call physics_update(state, ptend, ztodt, tend) + end if + + ! Update Nudging values, if needed + !---------------------------------- + if (Nudge_Model .and. Nudge_ON) then + call nudging_timestep_tend(state,ptend) + call physics_update(state, ptend, ztodt, tend) + call check_energy_cam_chng(state, tend, "nudging", nstep, ztodt, zero, zero, zero, zero) + endif + + call tot_energy_phys(state, 'phAP') + call tot_energy_phys(state, 'dyAP',vc=vc_dycore) + ! FV: convert dry-type mixing ratios to moist here because ! physics_dme_adjust assumes moist. This is done in p_d_coupling for ! other dynamics. Bundy, Feb 2004. ! - if (moist_physics .and. (dycore_is('LR') .or. dycore_is('FV3'))) then - call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist - end if + moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') + ! + ! update cp/cv for energy computation based in updated water variables + ! + call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore,& + to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) if (moist_physics) then - ! Scale dry mass and energy (does nothing if dycore is EUL or SLD) + ! Scale dry mass and energy call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) call cnst_get_ind('CLDICE', ixcldice, abort=.false.) tmp_q (:ncol,:pver) = state%q(:ncol,:pver,1) @@ -559,48 +630,59 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) else tmp_cldice(:ncol,:pver) = 0.0_r8 end if - - ! For not 'FV'|'FV3', physics_dme_adjust is called for energy diagnostic purposes only. + ! + ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers - if (.not.(dycore_is('FV').or.dycore_is('FV3')) .and. & - (hist_fld_active('SE_pAM').or.hist_fld_active('KE_pAM').or.hist_fld_active('WV_pAM').or.& - hist_fld_active('WL_pAM').or.hist_fld_active('WI_pAM'))) then - tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) - tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) - tmp_ps(:ncol) = state%ps(:ncol) + if (.not.moist_mixing_ratio_dycore) then ! - ! pint, lnpint,rpdel are altered by dme_adjust but not used for tendencies in dynamics of SE - ! we do not reset them to pre-dme_adjust values + ! for dry-mixing ratio based dycores dme_adjust takes place in the dynamical core ! - if (dycore_is('SE')) call set_dry_to_wet(state) - - if (trim(cam_take_snapshot_before) == "physics_dme_adjust") then - call cam_snapshot_all_outfld(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf) - end if - - call physics_dme_adjust(state, tend, qini, ztodt) - - if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then - call cam_snapshot_all_outfld(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf) + ! only compute dme_adjust for diagnostics purposes + ! + if (thermo_budget_history) then + tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) + tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) + tmp_ps(:ncol) = state%ps(:ncol) + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) + ! Restore pre-"physics_dme_adjust" tracers + state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) + state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) + state%ps(:ncol) = tmp_ps(:ncol) end if - - call calc_te_and_aam_budgets(state, 'pAM') - ! Restore pre-"physics_dme_adjust" tracers - state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) - state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) - state%ps(:ncol) = tmp_ps(:ncol) - end if - - if (dycore_is('LR') .or. dycore_is('FV3')) then - call physics_dme_adjust(state, tend, qini, ztodt) - call calc_te_and_aam_budgets(state, 'pAM') + else + ! + ! for moist-mixing ratio based dycores + ! + ! Note: this operation will NOT be reverted with set_wet_to_dry after set_dry_to_wet call + ! + call set_dry_to_wet(state, convert_cnst_type='dry') + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) + endif + if (vc_dycore == vc_height.or.vc_dycore == vc_dry_pressure) then + ! + ! MPAS and SE specific scaling of temperature for enforcing energy consistency + ! (and to make sure that temperature dependent diagnostic tendencies + ! are computed correctly; e.g. dtcore) + ! + scaling(1:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv_dycore(:ncol,:,lchnk) + state%T(1:ncol,:) = state%temp_ini(1:ncol,:)+& + scaling(1:ncol,:)*(state%T(1:ncol,:)-state%temp_ini(1:ncol,:)) + tend%dtdt(:ncol,:) = scaling(:ncol,:)*tend%dtdt(:ncol,:) + ! + ! else: do nothing for dycores with energy consistent with CAM physics + ! end if else tmp_q (:ncol,:pver) = 0.0_r8 tmp_cldliq(:ncol,:pver) = 0.0_r8 tmp_cldice(:ncol,:pver) = 0.0_r8 - call calc_te_and_aam_budgets(state, 'pAM') + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM',vc=vc_dycore) end if ! store T in buffer for use in computing dynamics T-tendency in next timestep @@ -611,13 +693,15 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) end do call diag_phys_tend_writeout (state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + qini, cldliqini, cldiceini) call diag_surf(cam_in, cam_out, state, pbuf) if (.not. moist_physics) then deallocate(cldliqini) deallocate(cldiceini) + deallocate(totliqini) + deallocate(toticeini) end if end subroutine tphysac @@ -647,17 +731,22 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) use cam_diagnostics, only: diag_conv_tend_ini, diag_conv, diag_export use cam_history, only: outfld use time_manager, only: get_nstep - use check_energy, only: check_energy_chng, check_energy_fix, check_energy_timestep_init + use check_energy, only: check_energy_cam_chng, check_energy_cam_fix + use check_energy, only: check_energy_timestep_init use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng - use check_energy, only: calc_te_and_aam_budgets + use check_energy, only: tot_energy_phys use chemistry, only: chem_is_active, chem_timestep_tend use held_suarez_cam, only: held_suarez_tend use kessler_cam, only: kessler_tend use tj2016_cam, only: thatcher_jablonowski_precip_tend + use frierson_cam, only: frierson_condensate_tend + use frierson_cam, only: frierson_radiative_tend use dycore, only: dycore_is - use cam_snapshot, only: cam_snapshot_all_outfld - use cam_snapshot, only: cam_snapshot_ptend_outfld - + use cam_snapshot_common,only: cam_snapshot_all_outfld + use cam_snapshot_common,only: cam_snapshot_ptend_outfld + use physics_types, only: dyn_te_idx + use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx + use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx ! Arguments real(r8), intent(in) :: ztodt ! model time increment @@ -678,12 +767,15 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) integer :: itim_old integer :: ixcldliq integer :: ixcldice + integer :: m, m_cnst ! physics buffer fields for total energy and mass adjustment real(r8), pointer :: teout(:) real(r8), pointer :: qini(:,:) real(r8), pointer :: cldliqini(:,:) real(r8), pointer :: cldiceini(:,:) + real(r8), pointer :: totliqini(:,:) + real(r8), pointer :: toticeini(:,:) real(r8), pointer :: dtcore(:,:) real(r8) :: zero(pcols) ! array of zeros @@ -711,6 +803,8 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) if (moist_physics) then call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, totliqini_idx, totliqini) + call pbuf_get_field(pbuf, toticeini_idx, toticeini) end if ! Set accumulated physics tendencies to 0 @@ -735,20 +829,22 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) !=================================================== ! Global mean total energy fixer and AAM diagnostics !=================================================== - call calc_te_and_aam_budgets(state, 'pBF') + call tot_energy_phys(state, 'phBF') + call tot_energy_phys(state, 'dyBF',vc=vc_dycore) call t_startf('energy_fixer') - if (adiabatic .and. (.not. dycore_is('EUL')) .and. (.not. dycore_is('MPAS'))) then - call check_energy_fix(state, ptend, nstep, flx_heat) + if (adiabatic) then + call check_energy_cam_fix(state, ptend, nstep, flx_heat) call physics_update(state, ptend, ztodt, tend) - call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) + call check_energy_cam_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) call outfld( 'EFIX', flx_heat , pcols, lchnk ) end if call t_stopf('energy_fixer') - call calc_te_and_aam_budgets(state, 'pBP') + call tot_energy_phys(state, 'phBP') + call tot_energy_phys(state, 'dyBP',vc=vc_dycore) ! Save state for convective tendency calculations. call diag_conv_tend_ini(state, pbuf) @@ -764,11 +860,20 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) if (ixcldice > 0) then cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) end if + totliqini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_liq_num + m = thermodynamic_active_species_liq_idx(m_cnst) + totliqini(:ncol,:pver) = totliqini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do + toticeini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_ice_num + m = thermodynamic_active_species_ice_idx(m_cnst) + toticeini(:ncol,:pver) = toticeini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do end if - call outfld('TEOUT', teout , pcols, lchnk ) - call outfld('TEINP', state%te_ini, pcols, lchnk ) - call outfld('TEFIX', state%te_cur, pcols, lchnk ) + call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) + call outfld('TEFIX', state%te_cur(:,dyn_te_idx), pcols, lchnk ) ! T tendency due to dynamics if( nstep > dyn_time_lvls-1 ) then @@ -830,13 +935,44 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) if (trim(cam_take_snapshot_after) == "thatcher_jablonowski_precip_tend") then call cam_snapshot_all_outfld(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf) end if + else if (frierson_phys) then + ! Compute the large-scale precipitation + !---------------------------------------- + if (trim(cam_take_snapshot_before) == "frierson_condensate_tend") then + call cam_snapshot_all_outfld(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf) + end if + call frierson_condensate_tend(state, ptend, ztodt, pbuf) + if ( (trim(cam_take_snapshot_after) == "frierson_condensate_tend") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + if (trim(cam_take_snapshot_after) == "frierson_condensate_tend") then + call cam_snapshot_all_outfld(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf) + end if + + ! Compute the radiative tendencies + !----------------------------------- + if (trim(cam_take_snapshot_before) == "frierson_radiative_tend") then + call cam_snapshot_all_outfld(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf) + end if + call frierson_radiative_tend(state, ptend, ztodt, cam_in, cam_out) + if ( (trim(cam_take_snapshot_after) == "frierson_radiative_tend") .and. & + (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then + call cam_snapshot_ptend_outfld(ptend, lchnk) + end if + call physics_update(state, ptend, ztodt, tend) + if (trim(cam_take_snapshot_after) == "frierson_radiative_tend") then + call cam_snapshot_all_outfld(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf) + end if + end if ! Can't turn on conservation error messages unless the appropriate heat ! surface flux is computed and supplied as an argument to ! check_energy_chng to account for how the simplified physics forcings are ! changing the total exnergy. - call check_energy_chng(state, tend, "tphysidl", nstep, ztodt, zero, zero, zero, zero) + call check_energy_cam_chng(state, tend, "tphysidl", nstep, ztodt, zero, zero, zero, zero) if (chem_is_active()) then call t_startf('simple_chem') @@ -871,7 +1007,7 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) call t_stopf('bc_history_write') ! Save total enery after physics for energy conservation checks - teout = state%te_cur + teout = state%te_cur(:,dyn_te_idx) call cam_export(state, cam_out, pbuf) @@ -889,6 +1025,7 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) !-------------------------------------------------------------------------- use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc + use nudging, only: Nudge_Model, nudging_timestep_init implicit none @@ -900,6 +1037,10 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) !-------------------------------------------------------------------------- + ! Update Nudging values, if needed + !---------------------------------- + if(Nudge_Model) call nudging_timestep_init(phys_state) + end subroutine phys_timestep_init !====================================================================================== diff --git a/src/physics/simple/radconstants.F90 b/src/physics/simple/radconstants.F90 index 0649a6f730..4476dc6669 100644 --- a/src/physics/simple/radconstants.F90 +++ b/src/physics/simple/radconstants.F90 @@ -15,10 +15,9 @@ module radconstants integer, parameter, public :: idx_lw_diag = 1 integer, parameter, public :: idx_nir_diag = 1 integer, parameter, public :: idx_uv_diag = 1 -integer, parameter, public :: nrh = 1 -integer, parameter, public :: ot_length = 32 public :: rad_gas_index +public :: get_lw_spectral_boundaries, get_sw_spectral_boundaries integer, public, parameter :: gasnamelength = 1 integer, public, parameter :: nradgas = 1 @@ -37,4 +36,30 @@ integer function rad_gas_index(gasname) end function rad_gas_index +!------------------------------------------------------------------------------ + +subroutine get_lw_spectral_boundaries(low_boundaries, high_boundaries, units) + ! stub should not be called + + real(r8), intent(out) :: low_boundaries(nlwbands), high_boundaries(nlwbands) + character(*), intent(in) :: units ! requested units + + call endrun('get_lw_spectral_boundaries: ERROR: this is a stub') + +end subroutine get_lw_spectral_boundaries + +!------------------------------------------------------------------------------ + +subroutine get_sw_spectral_boundaries(low_boundaries, high_boundaries, units) + ! stub should not be called + + real(r8), intent(out) :: low_boundaries(nswbands), high_boundaries(nswbands) + character(*), intent(in) :: units ! requested units + + call endrun('get_sw_spectral_boundaries: ERROR: this is a stub') + +end subroutine get_sw_spectral_boundaries + +!------------------------------------------------------------------------------ + end module radconstants diff --git a/src/physics/simple/radiation.F90 b/src/physics/simple/radiation.F90 index 63dcb9eac0..aa4fc2cec7 100644 --- a/src/physics/simple/radiation.F90 +++ b/src/physics/simple/radiation.F90 @@ -10,9 +10,10 @@ module radiation public :: & radiation_readnl, & - radiation_nextsw_cday, & radiation_do +real(r8), public, protected :: nextsw_cday = -1._r8 ! future radiation calday for surface models + !======================================================================================== contains !======================================================================================== @@ -42,16 +43,5 @@ end function radiation_do !======================================================================================== -real(r8) function radiation_nextsw_cday() - - ! Returns calendar day of next sw radiation calculation - !--------------------------------------------------------------------------- - - radiation_nextsw_cday = -1._r8 - -end function radiation_nextsw_cday - -!======================================================================================== - end module radiation diff --git a/src/physics/simple/restart_physics.F90 b/src/physics/simple/restart_physics.F90 index ef8f8795ef..fb40c5921b 100644 --- a/src/physics/simple/restart_physics.F90 +++ b/src/physics/simple/restart_physics.F90 @@ -13,6 +13,9 @@ module restart_physics pio_inq_varid, pio_def_var, pio_def_dim, & pio_put_var, pio_get_var + use cam_control_mod, only: frierson_phys + use frierson_cam,only: frierson_restart_init, frierson_restart_write, frierson_restart_read + implicit none private save @@ -59,6 +62,10 @@ subroutine init_restart_physics ( File, pbuf2d) call pbuf_init_restart(File, pbuf2d) + if (frierson_phys) then + call frierson_restart_init(File,hdimids,hdimcnt) + end if + end subroutine init_restart_physics subroutine write_restart_physics (File, cam_in, cam_out, pbuf2d) @@ -85,6 +92,10 @@ subroutine write_restart_physics (File, cam_in, cam_out, pbuf2d) ! Physics buffer call pbuf_write_restart(File, pbuf2d) + if (frierson_phys) then + call frierson_restart_write(File) + end if + end subroutine write_restart_physics !####################################################################### @@ -110,6 +121,9 @@ subroutine read_restart_physics(File, cam_in, cam_out, pbuf2d) call pbuf_read_restart(File, pbuf2d) + if (frierson_phys) then + call frierson_restart_read(File) + end if end subroutine read_restart_physics end module restart_physics 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/crm/ADV_MPDATA/crmx_advect_scalar.F90 b/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar.F90 deleted file mode 100644 index df9574cf4b..0000000000 --- a/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar.F90 +++ /dev/null @@ -1,47 +0,0 @@ - -subroutine advect_scalar (f,fadv,flux,f2leadv,f2legrad,fwleadv,doit) - -! positively definite monotonic advection with non-oscillatory option - -use crmx_grid -use crmx_vars, only: u, v, w, rho, rhow -use crmx_params, only: docolumn - -implicit none - -real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) -real flux(nz), fadv(nz) -real f2leadv(nz),f2legrad(nz),fwleadv(nz) -logical doit - -real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) -integer i,j,k - -if(docolumn) then - flux = 0. - return -end if - -!call t_startf ('advect_scalars') - - df(:,:,:) = f(:,:,:) - -if(RUN3D) then - call advect_scalar3D(f, u, v, w, rho, rhow, flux) -else - call advect_scalar2D(f, u, w, rho, rhow, flux) -endif - - do k=1,nzm - fadv(k)=0. - do j=1,ny - do i=1,nx - fadv(k)=fadv(k)+f(i,j,k)-df(i,j,k) - end do - end do - end do - -!call t_stopf ('advect_scalars') - -end subroutine advect_scalar - diff --git a/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar2D.F90 b/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar2D.F90 deleted file mode 100644 index a3773aa1ca..0000000000 --- a/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar2D.F90 +++ /dev/null @@ -1,182 +0,0 @@ - -subroutine advect_scalar2D (f, u, w, rho, rhow, flux) - -! positively definite monotonic advection with non-oscillatory option - -use crmx_grid -use crmx_params, only: dowallx -implicit none - - -real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) -real u(dimx1_u:dimx2_u, dimy1_u:dimy2_u, nzm) -real w(dimx1_w:dimx2_w, dimy1_w:dimy2_w, nz ) -real rho(nzm) -real rhow(nz) -real flux(nz) - -real mx (0:nxp1,1,nzm) -real mn (0:nxp1,1,nzm) -real uuu(-1:nxp3,1,nzm) -real www(-1:nxp2,1,nz) - -real eps, dd -integer i,j,k,ic,ib,kc,kb -logical nonos -real iadz(nzm),irho(nzm),irhow(nzm) - -real x1, x2, a, b, a1, a2, y -real andiff,across,pp,pn -andiff(x1,x2,a,b)=(abs(a)-a*a*b)*0.5*(x2-x1) -across(x1,a1,a2)=0.03125*a1*a2*x1 -pp(y)= max(0.,y) -pn(y)=-min(0.,y) - -nonos = .true. -eps = 1.e-10 - -j=1 - -www(:,:,nz)=0. - -if(dowallx) then - - if(mod(rank,nsubdomains_x).eq.0) then - do k=1,nzm - do i=dimx1_u,1 - u(i,j,k) = 0. - end do - end do - end if - if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then - do k=1,nzm - do i=nx+1,dimx2_u - u(i,j,k) = 0. - end do - end do - end if - -end if - -!----------------------------------------- - -if(nonos) then - - do k=1,nzm - kc=min(nzm,k+1) - kb=max(1,k-1) - do i=0,nxp1 - ib=i-1 - ic=i+1 - mx(i,j,k)=max(f(ib,j,k),f(ic,j,k),f(i,j,kb),f(i,j,kc),f(i,j,k)) - mn(i,j,k)=min(f(ib,j,k),f(ic,j,k),f(i,j,kb),f(i,j,kc),f(i,j,k)) - end do - end do - -end if ! nonos - -do k=1,nzm - kb=max(1,k-1) - do i=-1,nxp3 - uuu(i,j,k)=max(0.,u(i,j,k))*f(i-1,j,k)+min(0.,u(i,j,k))*f(i,j,k) - end do - do i=-1,nxp2 - www(i,j,k)=max(0.,w(i,j,k))*f(i,j,kb)+min(0.,w(i,j,k))*f(i,j,k) - end do - flux(k) = 0. - do i=1,nx - flux(k) = flux(k) + www(i,j,k) - end do -end do - -do k=1,nzm - irho(k) = 1./rho(k) - iadz(k) = 1./adz(k) - do i=-1,nxp2 - f(i,j,k) = f(i,j,k) - (uuu(i+1,j,k)-uuu(i,j,k) & - + (www(i,j,k+1)-www(i,j,k))*iadz(k))*irho(k) - end do -end do - - -do k=1,nzm - kc=min(nzm,k+1) - kb=max(1,k-1) - dd=2./(kc-kb)/adz(k) - irhow(k)=1./(rhow(k)*adz(k)) - do i=0,nxp2 - ib=i-1 - uuu(i,j,k)=andiff(f(ib,j,k),f(i,j,k),u(i,j,k),irho(k)) & - - across(dd*(f(ib,j,kc)+f(i,j,kc)-f(ib,j,kb)-f(i,j,kb)), & - u(i,j,k), w(ib,j,k)+w(ib,j,kc)+w(i,j,k)+w(i,j,kc)) *irho(k) - end do - - - do i=0,nxp1 - ib=i-1 - ic=i+1 - www(i,j,k)=andiff(f(i,j,kb),f(i,j,k),w(i,j,k),irhow(k)) & - -across(f(ic,j,kb)+f(ic,j,k)-f(ib,j,kb)-f(ib,j,k), & - w(i,j,k), u(i,j,kb)+u(i,j,k)+u(ic,j,k)+u(ic,j,kb)) *irho(k) - end do -end do -www(:,:,1) = 0. -!---------- non-osscilatory option --------------- - -if(nonos) then - - do k=1,nzm - kc=min(nzm,k+1) - kb=max(1,k-1) - do i=0,nxp1 - ib=i-1 - ic=i+1 - mx(i,j,k)=max(f(ib,j,k),f(ic,j,k),f(i,j,kb),f(i,j,kc),f(i,j,k),mx(i,j,k)) - mn(i,j,k)=min(f(ib,j,k),f(ic,j,k),f(i,j,kb),f(i,j,kc),f(i,j,k),mn(i,j,k)) - end do - end do - - do k=1,nzm - kc=min(nzm,k+1) - do i=0,nxp1 - ic=i+1 - mx(i,j,k)=rho(k)*(mx(i,j,k)-f(i,j,k))/(pn(uuu(ic,j,k)) + pp(uuu(i,j,k))+& - iadz(k)*(pn(www(i,j,kc)) + pp(www(i,j,k)))+eps) - mn(i,j,k)=rho(k)*(f(i,j,k)-mn(i,j,k))/(pp(uuu(ic,j,k)) + pn(uuu(i,j,k))+& - iadz(k)*(pp(www(i,j,kc)) + pn(www(i,j,k)))+eps) - end do - end do - - do k=1,nzm - kb=max(1,k-1) - do i=1,nxp1 - ib=i-1 - uuu(i,j,k)= pp(uuu(i,j,k))*min(1.,mx(i,j,k), mn(ib,j,k)) & - - pn(uuu(i,j,k))*min(1.,mx(ib,j,k),mn(i,j,k)) - end do - do i=1,nx - www(i,j,k)= pp(www(i,j,k))*min(1.,mx(i,j,k), mn(i,j,kb)) & - - pn(www(i,j,k))*min(1.,mx(i,j,kb),mn(i,j,k)) - flux(k) = flux(k) + www(i,j,k) - end do - end do - - -endif ! nonos - - - do k=1,nzm - kc=k+1 - do i=1,nx - ! MK: added fix for very small negative values (relative to positive values) - ! especially when such large numbers as - ! hydrometeor concentrations are advected. The reason for negative values is - ! most likely truncation error. - f(i,j,k)= max(0., f(i,j,k) - (uuu(i+1,j,k)-uuu(i,j,k) & - +(www(i,j,k+1)-www(i,j,k))*iadz(k))*irho(k)) - end do - end do - -end subroutine advect_scalar2D - - diff --git a/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar3D.F90 b/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar3D.F90 deleted file mode 100644 index cd66086006..0000000000 --- a/src/physics/spcam/crm/ADV_MPDATA/crmx_advect_scalar3D.F90 +++ /dev/null @@ -1,302 +0,0 @@ - -subroutine advect_scalar3D (f, u, v, w, rho, rhow, flux) - -! positively definite monotonic advection with non-oscillatory option - -use crmx_grid -use crmx_params, only: dowallx, dowally -implicit none - - -real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) -real u(dimx1_u:dimx2_u, dimy1_u:dimy2_u, nzm) -real v(dimx1_v:dimx2_v, dimy1_v:dimy2_v, nzm) -real w(dimx1_w:dimx2_w, dimy1_w:dimy2_w, nz ) -real rho(nzm) -real rhow(nz) -real flux(nz) - -real mx (0:nxp1,0:nyp1,nzm) -real mn (0:nxp1,0:nyp1,nzm) -real uuu(-1:nxp3,-1:nyp2,nzm) -real vvv(-1:nxp2,-1:nyp3,nzm) -real www(-1:nxp2,-1:nyp2,nz) - -real eps, dd -real iadz(nzm),irho(nzm),irhow(nzm) -integer i,j,k,ic,ib,jc,jb,kc,kb -logical nonos - -real x1, x2, a, b, a1, a2, y -real andiff,across,pp,pn -andiff(x1,x2,a,b)=(abs(a)-a*a*b)*0.5*(x2-x1) -across(x1,a1,a2)=0.03125*a1*a2*x1 -pp(y)= max(0.,y) -pn(y)=-min(0.,y) - -nonos = .true. -eps = 1.e-10 - -www(:,:,nz)=0. - -if(dowallx) then - - if(mod(rank,nsubdomains_x).eq.0) then - do k=1,nzm - do j=dimy1_u,dimy2_u - do i=dimx1_u,1 - u(i,j,k) = 0. - end do - end do - end do - end if - if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then - do k=1,nzm - do j=dimy1_u,dimy2_u - do i=nx+1,dimx2_u - u(i,j,k) = 0. - end do - end do - end do - end if - -end if - -if(dowally) then - - if(rank.lt.nsubdomains_x) then - do k=1,nzm - do j=dimy1_v,1 - do i=dimx1_v,dimx2_v - v(i,j,k) = 0. - end do - end do - end do - end if - if(rank.gt.nsubdomains-nsubdomains_x-1) then - do k=1,nzm - do j=ny+1,dimy2_v - do i=dimx1_v,dimx2_v - v(i,j,k) = 0. - end do - end do - end do - end if - -end if - -!----------------------------------------- - -if(nonos) then - - do k=1,nzm - kc=min(nzm,k+1) - kb=max(1,k-1) - do j=0,nyp1 - jb=j-1 - jc=j+1 - do i=0,nxp1 - ib=i-1 - ic=i+1 - mx(i,j,k)=max(f(ib,j,k),f(ic,j,k),f(i,jb,k), & - f(i,jc,k),f(i,j,kb),f(i,j,kc),f(i,j,k)) - mn(i,j,k)=min(f(ib,j,k),f(ic,j,k),f(i,jb,k), & - f(i,jc,k),f(i,j,kb),f(i,j,kc),f(i,j,k)) - end do - end do - end do - -end if ! nonos - - do k=1,nzm - do j=-1,nyp2 - do i=-1,nxp3 - uuu(i,j,k)=max(0.,u(i,j,k))*f(i-1,j,k)+min(0.,u(i,j,k))*f(i,j,k) - end do - end do - end do - - do k=1,nzm - do j=-1,nyp3 - do i=-1,nxp2 - vvv(i,j,k)=max(0.,v(i,j,k))*f(i,j-1,k)+min(0.,v(i,j,k))*f(i,j,k) - end do - end do - end do - - do k=1,nzm - kb=max(1,k-1) - do j=-1,nyp2 - do i=-1,nxp2 - www(i,j,k)=max(0.,w(i,j,k))*f(i,j,kb)+min(0.,w(i,j,k))*f(i,j,k) - end do - end do - flux(k) = 0. - do j=1,ny - do i=1,nx - flux(k) = flux(k) + www(i,j,k) - end do - end do - end do - - - do k=1,nzm - irho(k) = 1./rho(k) - iadz(k) = 1./adz(k) - do j=-1,nyp2 - do i=-1,nxp2 - f(i,j,k)=f(i,j,k) -(uuu(i+1,j,k)-uuu(i,j,k)+vvv(i,j+1,k)-vvv(i,j,k) & - +(www(i,j,k+1)-www(i,j,k))*iadz(k))*irho(k) - end do - end do - end do - - - do k=1,nzm - kc=min(nzm,k+1) - kb=max(1,k-1) - dd=2./(kc-kb)/adz(k) - do j=0,nyp1 - jb=j-1 - jc=j+1 - do i=0,nxp2 - ib=i-1 - uuu(i,j,k)=andiff(f(ib,j,k),f(i,j,k),u(i,j,k),irho(k)) & - -(across(f(ib,jc,k)+f(i,jc,k)-f(ib,jb,k)-f(i,jb,k), & - u(i,j,k), v(ib,j,k)+v(ib,jc,k)+v(i,jc,k)+v(i,j,k)) & - +across(dd*(f(ib,j,kc)+f(i,j,kc)-f(ib,j,kb)-f(i,j,kb)), & - u(i,j,k), w(ib,j,k)+w(ib,j,kc)+w(i,j,k)+w(i,j,kc))) *irho(k) - end do - end do - end do - - do k=1,nzm - kc=min(nzm,k+1) - kb=max(1,k-1) - dd=2./(kc-kb)/adz(k) - do j=0,nyp2 - jb=j-1 - do i=0,nxp1 - ib=i-1 - ic=i+1 - vvv(i,j,k)=andiff(f(i,jb,k),f(i,j,k),v(i,j,k),irho(k)) & - -(across(f(ic,jb,k)+f(ic,j,k)-f(ib,jb,k)-f(ib,j,k), & - v(i,j,k), u(i,jb,k)+u(i,j,k)+u(ic,j,k)+u(ic,jb,k)) & - +across(dd*(f(i,jb,kc)+f(i,j,kc)-f(i,jb,kb)-f(i,j,kb)), & - v(i,j,k), w(i,jb,k)+w(i,j,k)+w(i,j,kc)+w(i,jb,kc))) *irho(k) - end do - end do - end do - - do k=1,nzm - kb=max(1,k-1) - irhow(k)=1./(rhow(k)*adz(k)) - do j=0,nyp1 - jb=j-1 - jc=j+1 - do i=0,nxp1 - ib=i-1 - ic=i+1 - www(i,j,k)=andiff(f(i,j,kb),f(i,j,k),w(i,j,k),irhow(k)) & - -(across(f(ic,j,kb)+f(ic,j,k)-f(ib,j,kb)-f(ib,j,k), & - w(i,j,k), u(i,j,kb)+u(i,j,k)+u(ic,j,k)+u(ic,j,kb)) & - +across(f(i,jc,k)+f(i,jc,kb)-f(i,jb,k)-f(i,jb,kb), & - w(i,j,k), v(i,j,kb)+v(i,jc,kb)+v(i,jc,k)+v(i,j,k))) *irho(k) - end do - end do - end do - -www(:,:,1) = 0. - -!---------- non-osscilatory option --------------- - -if(nonos) then - - do k=1,nzm - kc=min(nzm,k+1) - kb=max(1,k-1) - do j=0,nyp1 - jb=j-1 - jc=j+1 - do i=0,nxp1 - ib=i-1 - ic=i+1 - mx(i,j,k)=max(f(ib,j,k),f(ic,j,k),f(i,jb,k), & - f(i,jc,k),f(i,j,kb),f(i,j,kc),f(i,j,k),mx(i,j,k)) - mn(i,j,k)=min(f(ib,j,k),f(ic,j,k),f(i,jb,k), & - f(i,jc,k),f(i,j,kb),f(i,j,kc),f(i,j,k),mn(i,j,k)) - end do - end do - end do - - do k=1,nzm - kc=min(nzm,k+1) - do j=0,nyp1 - jc=j+1 - do i=0,nxp1 - ic=i+1 - mx(i,j,k)=rho(k)*(mx(i,j,k)-f(i,j,k))/ & - (pn(uuu(ic,j,k)) + pp(uuu(i,j,k))+ & - pn(vvv(i,jc,k)) + pp(vvv(i,j,k))+ & - iadz(k)*(pn(www(i,j,kc)) + pp(www(i,j,k)))+eps) - mn(i,j,k)=rho(k)*(f(i,j,k)-mn(i,j,k))/ & - (pp(uuu(ic,j,k)) + pn(uuu(i,j,k))+ & - pp(vvv(i,jc,k)) + pn(vvv(i,j,k))+ & - iadz(k)*(pp(www(i,j,kc)) + pn(www(i,j,k)))+eps) - end do - end do - end do - - do k=1,nzm - do j=1,ny - do i=1,nxp1 - ib=i-1 - uuu(i,j,k)=pp(uuu(i,j,k))*min(1.,mx(i,j,k), mn(ib,j,k)) & - - pn(uuu(i,j,k))*min(1.,mx(ib,j,k),mn(i,j,k)) - end do - end do - end do - - do k=1,nzm - do j=1,nyp1 - jb=j-1 - do i=1,nx - vvv(i,j,k)=pp(vvv(i,j,k))*min(1.,mx(i,j,k), mn(i,jb,k)) & - - pn(vvv(i,j,k))*min(1.,mx(i,jb,k),mn(i,j,k)) - end do - end do - end do - - do k=1,nzm - kb=max(1,k-1) - do j=1,ny - do i=1,nx - www(i,j,k)=pp(www(i,j,k))*min(1.,mx(i,j,k), mn(i,j,kb)) & - - pn(www(i,j,k))*min(1.,mx(i,j,kb),mn(i,j,k)) - flux(k) = flux(k) + www(i,j,k) - end do - end do - end do - - -endif ! nonos - - -do k=1,nzm - kc=k+1 - do j=1,ny - do i=1,nx - ! MK: added fix for very small negative values (relative to positive values) - ! especially when such large numbers as - ! hydrometeor concentrations are advected. The reason for negative values is - ! most likely truncation error. - - f(i,j,k)=max(0.,f(i,j,k) -(uuu(i+1,j,k)-uuu(i,j,k)+vvv(i,j+1,k)-vvv(i,j,k) & - +(www(i,j,k+1)-www(i,j,k))*iadz(k))*irho(k)) - end do - end do -end do - -end subroutine advect_scalar3D - - diff --git a/src/physics/spcam/crm/ADV_MPDATA/crmx_advection.F90 b/src/physics/spcam/crm/ADV_MPDATA/crmx_advection.F90 deleted file mode 100644 index 04b1f60d9c..0000000000 --- a/src/physics/spcam/crm/ADV_MPDATA/crmx_advection.F90 +++ /dev/null @@ -1,3 +0,0 @@ -module crmx_advection - integer, parameter :: NADV = 0, NADVS=0 ! add'l boundary points -end module crmx_advection diff --git a/src/physics/spcam/crm/CLUBB/crmx_Skw_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_Skw_module.F90 deleted file mode 100644 index 2f49672025..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_Skw_module.F90 +++ /dev/null @@ -1,71 +0,0 @@ -!$Id: Skw_module.F90 5999 2012-12-18 23:53:13Z raut@uwm.edu $ -!------------------------------------------------------------------------------- -module crmx_Skw_module - - implicit none - - private ! Default Scope - - public :: Skw_func - - contains - -!------------------------------------------------------------------------------- - elemental function Skw_func( wp2, wp3 ) & - result( Skw ) - -! Description: -! Calculate the skewness of w, Skw. - -! References: -! None -!------------------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - w_tol_sqd, &! Constant for w_{_tol}^2, i.e. threshold for vertical velocity - Skw_max_mag ! Max magnitude of skewness - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: min, max - - ! Parameter Constants - ! Factor to decrease sensitivity in the denominator of Skw calculation - real( kind = core_rknd ), parameter :: & - Skw_denom_coef = 8.0_core_rknd ! [-] - - ! Whether to apply clipping to the final result - logical, parameter :: & - l_clipping_kluge = .false. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - wp2, & ! w'^2 [m^2/s^2] - wp3 ! w'^3 [m^3/s^3] - - ! Output Variable - real( kind = core_rknd ) :: & - Skw ! Result Skw [-] - - ! ---- Begin Code ---- - - !Skw = wp3 / ( max( wp2, w_tol_sqd ) )**1.5_core_rknd - ! Calculation of skewness to help reduce the sensitivity of this value to - ! small values of wp2. - Skw = wp3 / ( wp2 + Skw_denom_coef * w_tol_sqd )**1.5_core_rknd - - ! This is no longer needed since clipping is already - ! imposed on wp2 and wp3 elsewhere in the code - if ( l_clipping_kluge ) then - Skw = min( max( Skw, -Skw_max_mag ), Skw_max_mag ) - end if - - return - end function Skw_func -!----------------------------------------------------------------------- - -end module crmx_Skw_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_T_in_K_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_T_in_K_module.F90 deleted file mode 100644 index 971bccc073..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_T_in_K_module.F90 +++ /dev/null @@ -1,86 +0,0 @@ -! $Id: T_in_K_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ - -module crmx_T_in_K_module - - implicit none - - private ! Default scope - - public :: thlm2T_in_K, T_in_K2thlm - - contains - -!------------------------------------------------------------------------------- - elemental function thlm2T_in_K( thlm, exner, rcm ) & - result( T_in_K ) - -! Description: -! Calculates absolute temperature from liquid water potential -! temperature. (Does not include ice.) - -! References: -! Cotton and Anthes (1989), "Storm and Cloud Dynamics", Eqn. (2.51). -!------------------------------------------------------------------------------- - use crmx_constants_clubb, only: & - ! Variable(s) - Cp, & ! Dry air specific heat at constant p [J/kg/K] - Lv ! Latent heat of vaporization [J/kg] - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input - real( kind = core_rknd ), intent(in) :: & - thlm, & ! Liquid potential temperature [K] - exner, & ! Exner function [-] - rcm ! Liquid water mixing ratio [kg/kg] - - real( kind = core_rknd ) :: & - T_in_K ! Result temperature [K] - - ! ---- Begin Code ---- - - T_in_K = thlm * exner + Lv * rcm / Cp - - return - end function thlm2T_in_K -!------------------------------------------------------------------------------- - elemental function T_in_K2thlm( T_in_K, exner, rcm ) & - result( thlm ) - -! Description: -! Calculates liquid water potential temperature from absolute temperature - -! References: -! None -!------------------------------------------------------------------------------- - use crmx_constants_clubb, only: & - ! Variable(s) - Cp, & ! Dry air specific heat at constant p [J/kg/K] - Lv ! Latent heat of vaporization [J/kg] - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input - real( kind = core_rknd ), intent(in) :: & - T_in_K, &! Result temperature [K] - exner, & ! Exner function [-] - rcm ! Liquid water mixing ratio [kg/kg] - - real( kind = core_rknd ) :: & - thlm ! Liquid potential temperature [K] - - ! ---- Begin Code ---- - - thlm = ( T_in_K - Lv/Cp * rcm ) / exner - - return - end function T_in_K2thlm -!------------------------------------------------------------------------------- - -end module crmx_T_in_K_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_advance_helper_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_advance_helper_module.F90 deleted file mode 100644 index 4f1d8b53a0..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_advance_helper_module.F90 +++ /dev/null @@ -1,136 +0,0 @@ -!------------------------------------------------------------------------- -! $Id: advance_helper_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -module crmx_advance_helper_module - -! Description: -! This module contains helper methods for the advance_* modules. -!------------------------------------------------------------------------ - - implicit none - - public :: set_boundary_conditions_lhs, set_boundary_conditions_rhs - - private ! Set Default Scope - - contains - - !--------------------------------------------------------------------------- - subroutine set_boundary_conditions_lhs( diag_index, low_bound, high_bound, lhs, & - diag_index2, low_bound2, high_bound2 ) - - ! Description: - ! Sets the boundary conditions for a left-hand side LAPACK matrix. - ! - ! References: - ! none - !--------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - integer, intent(in) :: & - diag_index, low_bound, high_bound ! boundary indexes for the first variable - - integer, intent(in), optional :: & - diag_index2, low_bound2, high_bound2 ! boundary indexes for the second variable - - real( kind = core_rknd ), dimension(:,:), intent(inout) :: & - lhs ! left hand side of the LAPACK matrix equation - - ! --------------------- BEGIN CODE ---------------------- - - if( ( present(low_bound2) .or. present(high_bound2) ) .and. & - ( .not. present(diag_index2) ) ) then - - stop "Boundary index provided without diag_index." - - end if - - ! Set the lower boundaries for the first variable - lhs(:,low_bound) = 0.0_core_rknd - lhs(diag_index,low_bound) = 1.0_core_rknd - - ! Set the upper boundaries for the first variable - lhs(:,high_bound) = 0.0_core_rknd - lhs(diag_index,high_bound) = 1.0_core_rknd - - ! Set the lower boundaries for the second variable, if it is provided - if( present(low_bound2) ) then - - lhs(:,low_bound2) = 0.0_core_rknd - lhs(diag_index2,low_bound2) = 1.0_core_rknd - - end if - - ! Set the upper boundaries for the second variable, if it is provided - if( present(high_bound2) ) then - - lhs(:,high_bound2) = 0.0_core_rknd - lhs(diag_index2,high_bound2) = 1.0_core_rknd - - end if - - end subroutine set_boundary_conditions_lhs - - !-------------------------------------------------------------------------- - subroutine set_boundary_conditions_rhs( & - low_value, low_bound, high_value, high_bound, & - rhs, & - low_value2, low_bound2, high_value2, high_bound2 ) - - ! Description: - ! Sets the boundary conditions for a right-hand side LAPACK vector. - ! - ! References: - ! none - !--------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! The values for the first variable - real( kind = core_rknd ), intent(in) :: low_value, high_value - - ! The bounds for the first variable - integer, intent(in) :: low_bound, high_bound - - ! The values for the second variable - real( kind = core_rknd ), intent(in), optional :: low_value2, high_value2 - - ! The bounds for the second variable - integer, intent(in), optional :: low_bound2, high_bound2 - - ! The right-hand side vector - real( kind = core_rknd ), dimension(:), intent(inout) :: rhs - - ! -------------------- BEGIN CODE ------------------------ - - ! Stop execution if a boundary was provided without a value - if( (present(low_bound2) .and. (.not. present(low_value2))) .or. & - (present(high_bound2) .and. (.not. present(high_value2))) ) then - - stop "Boundary condition provided without value." - - end if - - ! Set the lower and upper bounds for the first variable - rhs(low_bound) = low_value - rhs(high_bound) = high_value - - ! If a lower bound was given for the second variable, set it - if( present(low_bound2) ) then - rhs(low_bound2) = low_value2 - end if - - ! If an upper bound was given for the second variable, set it - if( present(high_bound2) ) then - rhs(high_bound2) = high_value2 - end if - - end subroutine set_boundary_conditions_rhs - -end module crmx_advance_helper_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_advance_windm_edsclrm_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_advance_windm_edsclrm_module.F90 deleted file mode 100644 index 57799743cb..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_advance_windm_edsclrm_module.F90 +++ /dev/null @@ -1,1909 +0,0 @@ -!------------------------------------------------------------------------ -! $Id: advance_windm_edsclrm_module.F90 5960 2012-10-18 20:34:59Z janhft@uwm.edu $ -!=============================================================================== -module crmx_advance_windm_edsclrm_module - - implicit none - - private ! Set Default Scope - - public :: advance_windm_edsclrm, xpwp_fnc - - private :: windm_edsclrm_solve, & - compute_uv_tndcy, & - windm_edsclrm_lhs, & - windm_edsclrm_rhs - - - ! Private named constants to avoid string comparisons - integer, parameter, private :: & - windm_edsclrm_um = 1, & ! Named constant to handle um solves - windm_edsclrm_vm = 2, & ! Named constant to handle vm solves - windm_edsclrm_scalar = 3, & ! Named constant to handle scalar solves - clip_upwp = 10, & ! Named constant for upwp clipping - ! NOTE: This must be the same as the clip_upwp - ! declared in clip_explicit! - clip_vpwp = 11 ! Named constant for vpwp clipping - ! NOTE: This must be the same as the clip_vpwp - ! declared in clip_explicit! - - contains - - !============================================================================= - subroutine advance_windm_edsclrm & - ( dt, wm_zt, Kh_zm, ug, vg, um_ref, vm_ref, & - wp2, up2, vp2, um_forcing, vm_forcing, & - edsclrm_forcing, & - rho_ds_zm, invrs_rho_ds_zt, & - fcor, l_implemented, & - um, vm, edsclrm, & - upwp, vpwp, wpedsclrp, err_code ) - - ! Description: - ! Solves for both mean horizontal wind components, um and vm, and for the - ! eddy-scalars (passive scalars that don't use the high-order closure). - - ! Uses the LAPACK tridiagonal solver subroutine with 2 + # of scalar(s) - ! back substitutions (since the left hand side matrix is the same for all - ! input variables). - - ! References: - ! Eqn. 8 & 9 on p. 3545 of - ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: - ! Method and Model Description'' Golaz, et al. (2002) - ! JAS, Vol. 59, pp. 3540--3551. - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variables(s) - - use crmx_parameters_model, only: & - ts_nudge, & ! Variable(s) - edsclr_dim - - use crmx_parameters_tunable, only: & - nu10_vert_res_dep ! Constant - - use crmx_model_flags, only: & - l_uv_nudge, & ! Variable(s) - l_tke_aniso - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_stats_type, only: & - stat_begin_update, & ! Subroutines - stat_end_update, & - stat_update_var - - use crmx_stats_variables, only: & - ium_ref, & ! Variables - ivm_ref, & - ium_sdmp, & - ivm_sdmp, & - ium_ndg, & - ivm_ndg, & - iwindm_matrix_condt_num, & - zt, & - l_stats_samp - - use crmx_clip_explicit, only: & - clip_covar ! Procedure(s) - - use crmx_error_code, only: & - clubb_at_least_debug_level, & ! Procedure(s) - fatal_error - - use crmx_error_code, only: & - clubb_no_error, & ! Constant(s) - clubb_singular_matrix - - use crmx_constants_clubb, only: & - fstderr, & ! Constant(s) - eps - - use crmx_sponge_layer_damping, only: & - uv_sponge_damp_settings, & - uv_sponge_damp_profile, & - sponge_damp_xm ! Procedure(s) - - implicit none - - ! External - intrinsic :: real - - ! Constant Parameters - real( kind = core_rknd ), dimension(gr%nz) :: & - dummy_nu ! Used to feed zero values into function calls - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Model timestep [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - wm_zt, & ! w wind component on thermodynamic levels [m/s] - Kh_zm, & ! Eddy diffusivity on momentum levels [m^2/s] - ug, & ! u (west-to-east) geostrophic wind comp. [m/s] - vg, & ! v (south-to-north) geostrophic wind comp. [m/s] - um_ref, & ! Reference u wind component for nudging [m/s] - vm_ref, & ! Reference v wind component for nudging [m/s] - wp2, & ! w'^2 (momentum levels) [m^2/s^2] - up2, & ! u'^2 (momentum levels) [m^2/s^2] - vp2, & ! v'^2 (momentum levels) [m^2/s^2] - um_forcing, & ! u forcing [m/s/s] - vm_forcing, & ! v forcing [m/s/s] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - invrs_rho_ds_zt ! Inv. dry, static density at thermo. levels [m^3/kg] - - real( kind = core_rknd ), dimension(gr%nz,edsclr_dim), intent(in) :: & - edsclrm_forcing ! Eddy scalar large-scale forcing [{units vary}/s] - - real( kind = core_rknd ), intent(in) :: & - fcor ! Coriolis parameter [s^-1] - - logical, intent(in) :: & - l_implemented ! Flag for CLUBB being implemented in a larger model. - - ! Input/Output Variables - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - um, & ! Mean u (west-to-east) wind component [m/s] - vm ! Mean v (south-to-north) wind component [m/s] - - ! Input/Output Variable for eddy-scalars - real( kind = core_rknd ), dimension(gr%nz,edsclr_dim), intent(inout) :: & - edsclrm ! Mean eddy scalar quantity [units vary] - - ! Output Variables - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - upwp, & ! u'w' (momentum levels) [m^2/s^2] - vpwp ! v'w' (momentum levels) [m^2/s^2] - - ! Output Variable for eddy-scalars - real( kind = core_rknd ), dimension(gr%nz,edsclr_dim), intent(inout) :: & - wpedsclrp ! w'edsclr' (momentum levels) [units vary] - - integer, intent(inout) :: & - err_code ! clubb_singular_matrix when matrix is singular - - ! Local Variables - real( kind = core_rknd ), dimension(gr%nz) :: & - um_tndcy, & ! u wind component tendency [m/s^2] - vm_tndcy ! v wind component tendency [m/s^2] - - real( kind = core_rknd ), dimension(gr%nz) :: & - upwp_chnge, & ! Net change of u'w' due to clipping [m^2/s^2] - vpwp_chnge ! Net change of v'w' due to clipping [m^2/s^2] - - real( kind = core_rknd ), dimension(3,gr%nz) :: & - lhs ! The implicit part of the tridiagonal matrix [units vary] - - real( kind = core_rknd ), dimension(gr%nz,max(2,edsclr_dim)) :: & - rhs, &! The explicit part of the tridiagonal matrix [units vary] - solution ! The solution to the tridiagonal matrix [units vary] - - real( kind = core_rknd ), dimension(gr%nz) :: & - wind_speed ! wind speed; sqrt(u^2 + v^2) [m/s] - - real( kind = core_rknd ) :: & - u_star_sqd ! Surface friction velocity, u_star, squared [m/s] - - logical :: & - l_imp_sfc_momentum_flux ! Flag for implicit momentum surface fluxes. - - integer :: & - err_code_windm, err_code_edsclrm, & ! Error code for each LAPACK solve - nrhs ! Number of right hand side terms - - integer :: i ! Array index - - logical :: l_first_clip_ts, l_last_clip_ts ! flags for clip_covar - - !--------------------------- Begin Code ------------------------------------ - - ! Initialize to no errors - err_code_windm = clubb_no_error - err_code_edsclrm = clubb_no_error - - dummy_nu = 0._core_rknd - - !---------------------------------------------------------------- - ! Prepare tridiagonal system for horizontal winds, um and vm - !---------------------------------------------------------------- - - ! Compute Coriolis, geostrophic, and other prescribed wind forcings for um. - call compute_uv_tndcy( windm_edsclrm_um, fcor, vm, vg, um_forcing, & ! in - l_implemented, & ! in - um_tndcy ) ! out - - ! Compute Coriolis, geostrophic, and other prescribed wind forcings for vm. - call compute_uv_tndcy( windm_edsclrm_vm, fcor, um, ug, vm_forcing, & ! in - l_implemented, & ! in - vm_tndcy ) ! out - - ! Momentum surface fluxes, u'w'|_sfc and v'w'|_sfc, are applied to through - ! an implicit method, such that: - ! x'w'|_sfc = - ( u_star(t)^2 / wind_speed(t) ) * xm(t+1). - l_imp_sfc_momentum_flux = .true. - ! Compute wind speed (use threshold "eps" to prevent divide-by-zero error). - wind_speed = max( sqrt( um**2 + vm**2 ), eps ) - ! Compute u_star_sqd according to the definition of u_star. - u_star_sqd = sqrt( upwp(1)**2 + vpwp(1)**2 ) - - ! Compute the explicit portion of the um equation. - ! Build the right-hand side vector. - rhs(1:gr%nz,windm_edsclrm_um) & - = windm_edsclrm_rhs( windm_edsclrm_um, dt, nu10_vert_res_dep, Kh_zm, um, & ! in - um_tndcy, & ! in - rho_ds_zm, invrs_rho_ds_zt, & ! in - l_imp_sfc_momentum_flux, upwp(1) ) ! in - - ! Compute the explicit portion of the vm equation. - ! Build the right-hand side vector. - rhs(1:gr%nz,windm_edsclrm_vm) & - = windm_edsclrm_rhs( windm_edsclrm_vm, dt, nu10_vert_res_dep, Kh_zm, vm, & ! in - vm_tndcy, & ! in - rho_ds_zm, invrs_rho_ds_zt, & ! in - l_imp_sfc_momentum_flux, vpwp(1) ) ! in - - - ! Store momentum flux (explicit component) - - ! The surface flux, x'w'(1) = x'w'|_sfc, is set elsewhere in the model. -! upwp(1) = upwp_sfc -! vpwp(1) = vpwp_sfc - - ! Solve for x'w' at all intermediate model levels. - ! A Crank-Nicholson timestep is used. - - upwp(2:gr%nz-1) = - 0.5_core_rknd * xpwp_fnc( Kh_zm(2:gr%nz-1)+ & - nu10_vert_res_dep(2:gr%nz-1), & ! in - um(2:gr%nz-1), um(3:gr%nz), & ! in - gr%invrs_dzm(2:gr%nz-1) ) - - vpwp(2:gr%nz-1) = - 0.5_core_rknd * xpwp_fnc( Kh_zm(2:gr%nz-1)+ & - nu10_vert_res_dep(2:gr%nz-1), & ! in - vm(2:gr%nz-1), vm(3:gr%nz), & ! in - gr%invrs_dzm(2:gr%nz-1) ) - - ! A zero-flux boundary condition at the top of the model, d(xm)/dz = 0, - ! means that x'w' at the top model level is 0, - ! since x'w' = - K_zm * d(xm)/dz. - upwp(gr%nz) = 0._core_rknd - vpwp(gr%nz) = 0._core_rknd - - - ! Compute the implicit portion of the um and vm equations. - ! Build the left-hand side matrix. - call windm_edsclrm_lhs( dt, nu10_vert_res_dep, wm_zt, Kh_zm, wind_speed, u_star_sqd, & ! in - rho_ds_zm, invrs_rho_ds_zt, & ! in - l_implemented, l_imp_sfc_momentum_flux, & ! in - lhs ) ! out - - ! Decompose and back substitute for um and vm - nrhs = 2 - call windm_edsclrm_solve( nrhs, iwindm_matrix_condt_num, & ! in - lhs, rhs, & ! in/out - solution, err_code_windm ) ! out - - !---------------------------------------------------------------- - ! Update zonal (west-to-east) component of mean wind, um - !---------------------------------------------------------------- - um(1:gr%nz) = solution(1:gr%nz,windm_edsclrm_um) - - !---------------------------------------------------------------- - ! Update meridional (south-to-north) component of mean wind, vm - !---------------------------------------------------------------- - vm(1:gr%nz) = solution(1:gr%nz,windm_edsclrm_vm) - - if ( l_stats_samp ) then - - ! Implicit contributions to um and vm - call windm_edsclrm_implicit_stats( windm_edsclrm_um, um ) ! in - - call windm_edsclrm_implicit_stats( windm_edsclrm_vm, vm ) ! in - - endif ! l_stats_samp - - ! The values of um(1) and vm(1) are located below the model surface and do - ! not effect the rest of the model. The values of um(1) or vm(1) are simply - ! set to the values of um(2) and vm(2), respectively, after the equation - ! matrices has been solved. Even though um and vm would sharply decrease - ! to a value of 0 at the surface, this is done to avoid confusion on plots - ! of the vertical profiles of um and vm. - um(1) = um(2) - vm(1) = vm(2) - - - if ( uv_sponge_damp_settings%l_sponge_damping ) then - if( l_stats_samp ) then - call stat_begin_update( ium_sdmp, um/real( dt, kind = core_rknd ), zt ) - call stat_begin_update( ivm_sdmp, vm/real( dt, kind = core_rknd ), zt ) - endif - - um(1:gr%nz) = sponge_damp_xm( dt, um_ref(1:gr%nz), um(1:gr%nz), & - uv_sponge_damp_profile ) - vm(1:gr%nz) = sponge_damp_xm( dt, vm_ref(1:gr%nz), vm(1:gr%nz), & - uv_sponge_damp_profile ) - if( l_stats_samp ) then - call stat_end_update( ium_sdmp, um/real( dt, kind = core_rknd ), zt ) - call stat_end_update( ivm_sdmp, vm/real( dt, kind = core_rknd ), zt ) - endif - - endif - - ! Second part of momentum (implicit component) - - ! Solve for x'w' at all intermediate model levels. - ! A Crank-Nicholson timestep is used. - - upwp(2:gr%nz-1) = upwp(2:gr%nz-1) & - - 0.5_core_rknd * xpwp_fnc( Kh_zm(2:gr%nz-1)+nu10_vert_res_dep(2:gr%nz-1), & - um(2:gr%nz-1), um(3:gr%nz), gr%invrs_dzm(2:gr%nz-1) ) !in - - vpwp(2:gr%nz-1) = vpwp(2:gr%nz-1) & - - 0.5_core_rknd * xpwp_fnc( Kh_zm(2:gr%nz-1)+nu10_vert_res_dep(2:gr%nz-1), & - vm(2:gr%nz-1), vm(3:gr%nz), gr%invrs_dzm(2:gr%nz-1) ) !in - - - ! Adjust um and vm if nudging is turned on. - if ( l_uv_nudge ) then - - ! Reflect nudging in budget - if( l_stats_samp ) then - call stat_begin_update( ium_ndg, um / real( dt, kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - call stat_begin_update( ivm_ndg, vm / real( dt, kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - end if - - um(1:gr%nz) = um(1:gr%nz) & - - ((um(1:gr%nz) - um_ref(1:gr%nz)) * (real( dt, kind = core_rknd )/ts_nudge)) - vm(1:gr%nz) = vm(1:gr%nz) & - - ((vm(1:gr%nz) - vm_ref(1:gr%nz)) * (real( dt, kind = core_rknd )/ts_nudge)) - endif - - if( l_stats_samp ) then - - ! Reflect nudging in budget - if ( l_uv_nudge ) then - call stat_end_update( ium_ndg, um / real( dt, kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - call stat_end_update( ivm_ndg, vm / real( dt, kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - end if - - call stat_update_var( ium_ref, um_ref, zt ) - call stat_update_var( ivm_ref, vm_ref, zt ) - end if - - if ( l_tke_aniso ) then - - ! Clipping for u'w' - ! - ! Clipping u'w' at each vertical level, based on the - ! correlation of u and w at each vertical level, such that: - ! corr_(u,w) = u'w' / [ sqrt(u'^2) * sqrt(w'^2) ]; - ! -1 <= corr_(u,w) <= 1. - ! - ! Since u'^2, w'^2, and u'w' are each advanced in different subroutines from - ! each other in advance_clubb_core, clipping for u'w' has to be done three - ! times during each timestep (once after each variable has been updated). - ! This is the third instance of u'w' clipping. - l_first_clip_ts = .false. - l_last_clip_ts = .true. - call clip_covar( clip_upwp, l_first_clip_ts, & ! intent(in) - l_last_clip_ts, dt, wp2, up2, & ! intent(in) - upwp, upwp_chnge ) ! intent(inout) - - ! Clipping for v'w' - ! - ! Clipping v'w' at each vertical level, based on the - ! correlation of v and w at each vertical level, such that: - ! corr_(v,w) = v'w' / [ sqrt(v'^2) * sqrt(w'^2) ]; - ! -1 <= corr_(v,w) <= 1. - ! - ! Since v'^2, w'^2, and v'w' are each advanced in different subroutines from - ! each other in advance_clubb_core, clipping for v'w' has to be done three - ! times during each timestep (once after each variable has been updated). - ! This is the third instance of v'w' clipping. - l_first_clip_ts = .false. - l_last_clip_ts = .true. - call clip_covar( clip_vpwp, l_first_clip_ts, & ! intent(in) - l_last_clip_ts, dt, wp2, vp2, & ! intent(in) - vpwp, vpwp_chnge ) ! intent(inout) - - else - - ! In this case, it is assumed that - ! u'^2 == v'^2 == w'^2, and the variables `up2' and `vp2' do not interact with - ! any other variables. - l_first_clip_ts = .false. - l_last_clip_ts = .true. - call clip_covar( clip_upwp, l_first_clip_ts, & ! intent(in) - l_last_clip_ts, dt, wp2, wp2, & ! intent(in) - upwp, upwp_chnge ) ! intent(inout) - - call clip_covar( clip_vpwp, l_first_clip_ts, & ! intent(in) - l_last_clip_ts, dt, wp2, wp2, & ! intent(in) - vpwp, vpwp_chnge ) ! intent(inout) - - endif ! l_tke_aniso - - - !---------------------------------------------------------------- - ! Prepare tridiagonal system for eddy-scalars - !---------------------------------------------------------------- - - if ( edsclr_dim > 0 ) then - - ! Eddy-scalar surface fluxes, x'w'|_sfc, are applied through an explicit - ! method. - l_imp_sfc_momentum_flux = .false. - - ! Compute the explicit portion of eddy scalar equation. - ! Build the right-hand side vector. - ! Because of statistics, we have to use a DO rather than a FORALL here - ! -dschanen 7 Oct 2008 -!HPF$ INDEPENDENT - do i = 1, edsclr_dim - rhs(1:gr%nz,i) & - = windm_edsclrm_rhs( windm_edsclrm_scalar, dt, dummy_nu, Kh_zm, & ! in - edsclrm(:,i), edsclrm_forcing, & ! in - rho_ds_zm, invrs_rho_ds_zt, & ! in - l_imp_sfc_momentum_flux, wpedsclrp(1,i) ) ! in - enddo - - - ! Store momentum flux (explicit component) - - ! The surface flux, x'w'(1) = x'w'|_sfc, is set elsewhere in the model. -! wpedsclrp(1,1:edsclr_dim) = wpedsclrp_sfc(1:edsclr_dim) - - ! Solve for x'w' at all intermediate model levels. - ! A Crank-Nicholson timestep is used. - ! Here we use a forall and high performance fortran directive to try to - ! parallelize this computation. Note that FORALL is more restrictive than DO. -!HPF$ INDEPENDENT, REDUCTION(wpedsclrp) - forall( i = 1:edsclr_dim ) - wpedsclrp(2:gr%nz-1,i) = & - - 0.5_core_rknd * xpwp_fnc( Kh_zm(2:gr%nz-1), edsclrm(2:gr%nz-1,i), & ! in - edsclrm(3:gr%nz,i), gr%invrs_dzm(2:gr%nz-1) ) ! in - end forall - - ! A zero-flux boundary condition at the top of the model, d(xm)/dz = 0, - ! means that x'w' at the top model level is 0, - ! since x'w' = - K_zm * d(xm)/dz. - wpedsclrp(gr%nz,1:edsclr_dim) = 0._core_rknd - - - ! Compute the implicit portion of the xm (eddy-scalar) equations. - ! Build the left-hand side matrix. - call windm_edsclrm_lhs( dt, dummy_nu, wm_zt, Kh_zm, wind_speed, u_star_sqd, & ! in - rho_ds_zm, invrs_rho_ds_zt, & ! in - l_implemented, l_imp_sfc_momentum_flux, & ! in - lhs ) ! out - - ! Decompose and back substitute for all eddy-scalar variables - call windm_edsclrm_solve( edsclr_dim, 0, & ! in - lhs, rhs, & ! in/out - solution, err_code_edsclrm ) ! out - - !---------------------------------------------------------------- - ! Update Eddy-diff. Passive Scalars - !---------------------------------------------------------------- - edsclrm(1:gr%nz,1:edsclr_dim) = solution(1:gr%nz,1:edsclr_dim) - - ! The value of edsclrm(1) is located below the model surface and does not - ! effect the rest of the model. The value of edsclrm(1) is simply set to - ! the value of edsclrm(2) after the equation matrix has been solved. - forall( i=1:edsclr_dim ) - edsclrm(1,i) = edsclrm(2,i) - end forall - - ! Second part of momentum (implicit component) - - ! Solve for x'w' at all intermediate model levels. - ! A Crank-Nicholson timestep is used. -!HPF$ INDEPENDENT, REDUCTION(wpedsclrp) - forall( i = 1:edsclr_dim ) - wpedsclrp(2:gr%nz-1,i) = wpedsclrp(2:gr%nz-1,i) & - - 0.5_core_rknd * xpwp_fnc( Kh_zm(2:gr%nz-1), edsclrm(2:gr%nz-1,i), & ! in - edsclrm(3:gr%nz,i), gr%invrs_dzm(2:gr%nz-1) ) ! in - end forall - - ! Note that the w'edsclr' terms are not clipped, since we don't compute the - ! variance of edsclr anywhere. -dschanen 7 Oct 2008 - - endif - - ! Check for singular matrices and bad LAPACK arguments - if ( fatal_error( err_code_windm ) ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) "Fatal error solving for um/vm" - end if - err_code = err_code_windm - end if - - if ( fatal_error( err_code_edsclrm ) ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) "Fatal error solving for eddsclrm" - end if - err_code = err_code_edsclrm - end if - - ! Error report - ! Joshua Fasching February 2008 - if ( ( fatal_error( err_code_windm ) .or. fatal_error( err_code_edsclrm ) ) .and. & - clubb_at_least_debug_level( 1 ) ) then - - write(fstderr,*) "Error in advance_windm_edsclrm" - - write(fstderr,*) "Intent(in)" - - write(fstderr,*) "dt = ", dt - write(fstderr,*) "wm_zt = ", wm_zt - write(fstderr,*) "Kh_zm = ", Kh_zm - write(fstderr,*) "ug = ", ug - write(fstderr,*) "vg = ", vg - write(fstderr,*) "um_ref = ", um_ref - write(fstderr,*) "vm_ref = ", vm_ref - write(fstderr,*) "wp2 = ", wp2 - write(fstderr,*) "up2 = ", up2 - write(fstderr,*) "vp2 = ", vp2 - write(fstderr,*) "um_forcing = ", um_forcing - write(fstderr,*) "vm_forcing = ", vm_forcing - do i = 1, edsclr_dim - write(fstderr,*) "edsclrm_forcing # = ", i, edsclrm_forcing - end do - write(fstderr,*) "fcor = ", fcor - write(fstderr,*) "l_implemented = ", l_implemented - - write(fstderr,*) "Intent(inout)" - - write(fstderr,*) "um = ", um - write(fstderr,*) "vm = ", vm - do i = 1, edsclr_dim - write(fstderr,*) "edsclrm # ", i, "=", edsclrm(:,i) - end do - write(fstderr,*) "upwp = ", upwp - write(fstderr,*) "vpwp = ", vpwp - write(fstderr,*) "wpedsclrp = ", wpedsclrp - - !write(fstderr,*) "Intent(out)" - - return - - end if - - return - end subroutine advance_windm_edsclrm - - !============================================================================= - subroutine windm_edsclrm_solve( nrhs, ixm_matrix_condt_num, & - lhs, rhs, solution, err_code ) - - ! Note: In the "Description" section of this subroutine, the variable - ! "invrs_dzm" will be written as simply "dzm", and the variable - ! "invrs_dzt" will be written as simply "dzt". This is being done as - ! as device to save space and to make some parts of the description - ! more readable. This change does not pertain to the actual code. - - ! Description: - ! Solves the horizontal wind or eddy-scalar time-tendency equation, and - ! diagnoses the turbulent flux. A Crank-Nicholson time-stepping algorithm - ! is used in solving the turbulent advection term and in diagnosing the - ! turbulent flux. - ! - ! The rate of change of an eddy-scalar quantity, xm, is: - ! - ! d(xm)/dt = - w * d(xm)/dz - (1/rho_ds) * d( rho_ds * x'w' )/dz - ! + xm_forcings. - ! - ! - ! The Turbulent Advection Term - ! ---------------------------- - ! - ! The above equation contains a turbulent advection term: - ! - ! - (1/rho_ds) * d( rho_ds * x'w' )/dz; - ! - ! where the momentum flux, x'w', is closed using a down gradient approach: - ! - ! x'w' = - K_zm * d(xm)/dz. - ! - ! The turbulent advection term becomes: - ! - ! + (1/rho_ds) * d [ rho_ds * K_zm * d(xm)/dz ] / dz; - ! - ! which is the same as a standard eddy-diffusion term (if "rho_ds * K_zm" in - ! the term above is substituted for "K_zm" in a standard eddy-diffusion - ! term, and if the standard eddy-diffusion term is multiplied by - ! "1/rho_ds"). Thus, the turbulent advection term is treated and solved in - ! the same way that a standard eddy-diffusion term would be solved. The - ! term is discretized as follows: - ! - ! The values of xm are found on the thermodynamic levels, while the values - ! of K_zm are found on the momentum levels. Additionally, the values of - ! rho_ds_zm are found on the momentum levels, and the values of - ! invrs_rho_ds_zt are found on the thermodynamic levels. The - ! derivatives (d/dz) of xm are taken over the intermediate momentum levels. - ! At the intermediate momentum levels, d(xm)/dz is multiplied by K_zm and by - ! rho_ds_zm. Then, the derivative of the whole mathematical expression is - ! taken over the central thermodynamic level, where it is multiplied by - ! invrs_rho_ds_zt, which yields the desired result. - ! - ! ---xm(kp1)----------------------------------------------------- t(k+1) - ! - ! ===========d(xm)/dz===K_zm(k)=====rho_ds_zm(k)================= m(k) - ! - ! ---xm(k)---invrs_rho_ds_zt---d[rho_ds_zm*K_zm*d(xm)/dz]/dz----- t(k) - ! - ! ===========d(xm)/dz===K_zm(km1)===rho_ds_zm(km1)=============== m(k-1) - ! - ! ---xm(km1)----------------------------------------------------- t(k-1) - ! - ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond - ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively. - ! The letter "t" is used for thermodynamic levels and the letter "m" is used - ! for momentum levels. - ! - ! dzt(k) = 1 / ( zm(k) - zm(k-1) ) - ! dzm(k) = 1 / ( zt(k+1) - zt(k) ) - ! dzm(k-1) = 1 / ( zt(k) - zt(k-1) ) - ! - ! The vertically discretized form of the turbulent advection term (treated - ! as an eddy diffusion term) is written out as: - ! - ! + invrs_rho_ds_zt(k) - ! * dzt(k) - ! * [ rho_ds_zm(k) * K_zm(k) * dzm(k) * ( xm(k+1) - xm(k) ) - ! - rho_ds_zm(k-1) * K_zm(k-1) * dzm(k-1) * ( xm(k) - xm(k-1) ) ]. - ! - ! For this equation, a Crank-Nicholson (semi-implicit) diffusion scheme is - ! used to solve the (1/rho_ds) * d [ rho_ds * K_zm * d(xm)/dz ] / dz - ! eddy-diffusion term. The discretized implicit portion of the term is - ! written out as: - ! - ! + (1/2) * invrs_rho_ds_zt(k) - ! * dzt(k) - ! * [ rho_ds_zm(k) * K_zm(k) - ! * dzm(k) * ( xm(k+1,) - xm(k,) ) - ! - rho_ds_zm(k-1) * K_zm(k-1) - ! * dzm(k-1) * ( xm(k,) - xm(k-1,) ) ]. - ! - ! Note: When the implicit term is brought over to the left-hand side, - ! the sign is reversed and the leading "+" in front of the term - ! is changed to a "-". - ! - ! The discretized explicit portion of the term is written out as: - ! - ! + (1/2) * invrs_rho_ds_zt(k) - ! * dzt(k) - ! * [ rho_ds_zm(k) * K_zm(k) - ! * dzm(k) * ( xm(k+1,) - xm(k,) ) - ! - rho_ds_zm(k-1) * K_zm(k-1) - ! * dzm(k-1) * ( xm(k,) - xm(k-1,) ) ]. - ! - ! Timestep index (t) stands for the index of the current timestep, while - ! timestep index (t+1) stands for the index of the next timestep, which is - ! being advanced to in solving the d(xm)/dt equation. - ! - ! - ! Boundary Conditions: - ! - ! An eddy-scalar quantity is not allowed to flux out the upper boundary. - ! Thus, a zero-flux boundary condition is used for the upper boundary in the - ! eddy-diffusion equation. - ! - ! The lower boundary condition is much more complicated. It is neither a - ! zero-flux nor a fixed-point boundary condition. Rather, it is a - ! fixed-flux boundary condition. This term is a turbulent advection term, - ! but with the eddy-scalars, the only value of x'w' relevant in solving the - ! d(xm)/dt equation is the value of x'w' at the surface (the first momentum - ! level), which is written as x'w'|_sfc. - ! - ! 1) x'w' surface flux; generalized explicit form - ! - ! The x'w' surface flux is applied to the d(xm)/dt equation through the - ! turbulent advection term, which is: - ! - ! - (1/rho_ds) * d( rho_ds * x'w' )/dz. - ! - ! At most vertical levels, a substitution can be made for x'w', such - ! that: - ! - ! x'w' = - K_zm * d(xm)/dz. - ! - ! However, the same substitution cannot be made at the surface (momentum - ! level 1), as x'w'|_sfc is a surface flux that is explicitly computed - ! elsewhere in the model code. - ! - ! The lower boundary condition, which in this case needs to be applied to - ! the d(xm)/dt equation at level 2, is discretized as follows: - ! - ! --xm(3)------------------------------------------------------- t(3) - ! - ! ========[x'w'(2) = -K_zm(2)*d(xm)/dz]===rho_ds_zm(2)========== m(2) - ! - ! --xm(2)---invrs_rho_ds_zt(2)---d[rho_ds_zm*K_zm*d(xm)/dz]/dz-- t(2) - ! - ! ========[x'w'|_sfc]=====================rho_ds_zm(1)========== m(1) sfc - ! - ! --xm(1)-------(below surface; not applicable)----------------- t(1) - ! - ! where "sfc" is the level of the model surface or lower boundary. - ! - ! The vertically discretized form of the turbulent advection term - ! (treated as an eddy diffusion term), with the explicit surface flux, - ! x'w'|_sfc, in place, is written out as: - ! - ! - invrs_rho_ds_zt(2) - ! * dzt(2) * [ rho_ds_zm(2) * x'w'(2) - rho_ds_zm(1) * x'w'|_sfc ]; - ! - ! which can be re-written as: - ! - ! + invrs_rho_ds_zt(2) - ! * dzt(2) - ! * [ rho_ds_zm(2) * K_zm(2) * dzm(2) * ( xm(3) - xm(2) ) - ! + rho_ds_zm(1) * x'w'|_sfc ]; - ! - ! which can be re-written again as: - ! - ! + invrs_rho_ds_zt(2) - ! * dzt(2) - ! * rho_ds_zm(2) * K_zm(2) * dzm(2) * ( xm(3) - xm(2) ) - ! + invrs_rho_ds_zt(2) - ! * dzt(2) - ! * rho_ds_zm(1) * x'w'|_sfc. - ! - ! For this equation, a Crank-Nicholson (semi-implicit) diffusion scheme - ! is used to solve the (1/rho_ds) * d [ rho_ds * K_zm * d(xm)/dz ] / dz - ! eddy-diffusion term. The discretized implicit portion of the term is - ! written out as: - ! - ! + (1/2) * invrs_rho_ds_zt(2) - ! * dzt(2) - ! * [ rho_ds_zm(2) * K_zm(2) - ! * dzm(2) * ( xm(3,) - xm(2,) ) ]. - ! - ! Note: When the implicit term is brought over to the left-hand side, - ! the sign is reversed and the leading "+" in front of the term - ! is changed to a "-". - ! - ! The discretized explicit portion of the term is written out as: - ! - ! + (1/2) * invrs_rho_ds_zt(2) - ! * dzt(2) - ! * [ rho_ds_zm(2) * K_zm(2) - ! * dzm(2) * ( xm(3,) - xm(2,) ) ] - ! + invrs_rho_ds_zt(2) - ! * dzt(2) - ! * rho_ds_zm(1) * x'w'|_sfc. - ! - ! Note: The x'w'|_sfc portion of the term written above has been pulled - ! away from the rest of the explicit form written above because - ! the (1/2) factor due to Crank-Nicholson time_stepping does not - ! apply to it, as there isn't an implicit portion for x'w'|_sfc. - ! - ! Timestep index (t) stands for the index of the current timestep, while - ! timestep index (t+1) stands for the index of the next timestep, which - ! is being advanced to in solving the d(xm)/dt equation. - ! - ! 2) x'w' surface flux; implicit form for momentum fluxes u'w' and v'w' - ! - ! The x'w' surface flux is applied to the d(xm)/dt equation through the - ! turbulent advection term, which is: - ! - ! - (1/rho_ds) * d( rho_ds * x'w' )/dz. - ! - ! At most vertical levels, a substitution can be made for x'w', such - ! that: - ! - ! x'w' = - K_zm * d(xm)/dz. - ! - ! However, the same substitution cannot be made at the surface (momentum - ! level 1), as x'w'|_sfc is a surface momentum flux that is found by the - ! following equation: - ! - ! x'w'|_sfc = - [ u_star^2 / sqrt( um^2 + vm^2 ) ] * xm; - ! - ! where x'w'|_sfc and xm are either u'w'|_sfc and um, respectively, or - ! v'w'|_sfc and vm, respectively (um and vm are located at the first - ! thermodynamic level above the surface, which is thermodynamic level 2), - ! sqrt( um^2 + vm^2 ) is the wind speed (also at thermodynamic level 2), - ! and u_star is defined as: - ! - ! u_star = ( u'w'|_sfc^2 + v'w'|_sfc^2 )^(1/4); - ! - ! and thus u_star^2 is defined as: - ! - ! u_star^2 = sqrt( u'w'|_sfc^2 + v'w'|_sfc^2 ). - ! - ! The value of u_star is either set to a constant value or computed - ! (through function diag_ustar) based on the surface wind speed, the - ! height above surface of the surface wind speed (as compared to the - ! roughness height), and the buoyancy flux at the surface. Either way, - ! u_star is computed elsewhere in the model, and the values of u'w'|_sfc - ! and v'w'|_sfc are based on it and computed along with it. The values - ! of u'w'|_sfc and v'w'|_sfc are then passed into advance_clubb_core, - ! and are eventually passed into advance_windm_edsclrm. In subroutine - ! advance_windm_edsclrm, the value of u_star_sqd is then recomputed - ! based on u'w'|_sfc and v'w'|_sfc. The value of sqrt( u_star_sqd ) is - ! consistent with the value of the original computation of u_star. - ! - ! The equation listed above is substituted for x'w'|_sfc. The lower - ! boundary condition, which in this case needs to be applied to the - ! d(xm)/dt equation at level 2, is discretized as follows: - ! - ! --xm(3)------------------------------------------------------- t(3) - ! - ! ===[x'w'(2) = -K_zm(2)*d(xm)/dz]=================rho_ds_zm(2)= m(2) - ! - ! --xm(2)---invrs_rho_ds_zt(2)---d[rho_ds_zm*K_zm*d(xm)/dz]/dz-- t(2) - ! - ! ===[x'w'|_sfc = -[u_star^2/sqrt(um^2+vm^2)]*xm]==rho_ds_zm(1)= m(1) sfc - ! - ! --xm(1)-------(below surface; not applicable)----------------- t(1) - ! - ! where "sfc" is the level of the model surface or lower boundary. - ! - ! The vertically discretized form of the turbulent advection term - ! (treated as an eddy diffusion term), with the implicit surface momentum - ! flux in place, is written out as: - ! - ! - invrs_rho_ds_zt(2) - ! * dzt(2) * [ rho_ds_zm(2) * x'w'(2) - rho_ds_zm(1) * x'w'|_sfc ]; - ! - ! which can be re-written as: - ! - ! - invrs_rho_ds_zt(2) - ! * dzt(2) - ! * [ rho_ds_zm(2) - ! * { - K_zm(2) * dzm(2) * ( xm(3) - xm(2) ) } - ! - rho_ds_zm(1) - ! * { - [ u_star^2 / sqrt( um(2)^2 + vm(2)^2 ) ] * xm(2) } ]; - ! - ! which can be re-written as: - ! - ! + invrs_rho_ds_zt(2) - ! * dzt(2) - ! * rho_ds_zm(2) * K_zm(2) * dzm(2) * ( xm(3) - xm(2) ) - ! - invrs_rho_ds_zt(2) - ! * dzt(2) - ! * rho_ds_zm(1) * [ u_star^2 / sqrt( um(2)^2 + vm(2)^2 ) ] * xm(2). - ! - ! For this equation, a Crank-Nicholson (semi-implicit) diffusion scheme - ! is used to solve the (1/rho_ds) * d [ rho_ds * K_zm * d(xm)/dz ] / dz - ! eddy-diffusion term. The discretized implicit portion of the term is - ! written out as: - ! - ! + (1/2) * invrs_rho_ds_zt(2) - ! * dzt(2) - ! * [ rho_ds_zm(2) * K_zm(2) - ! * dzm(2) * ( xm(3,) - xm(2,) ) ] - ! - invrs_rho_ds_zt(2) - ! * dzt(2) - ! * rho_ds_zm(1) - ! * [u_star^2/sqrt( um(2,)^2 + vm(2,)^2 )] * xm(2,). - ! - ! Note: When the implicit term is brought over to the left-hand side, - ! the signs are reversed and the leading "+" in front of the first - ! part of the term is changed to a "-", while the leading "-" in - ! front of the second part of the term is changed to a "+". - ! - ! Note: The x'w'|_sfc portion of the term written above has been pulled - ! away from the rest of the implicit form written above because - ! the (1/2) factor due to Crank-Nicholson time_stepping does not - ! apply to it. The x'w'|_sfc portion of the term is treated - ! completely implicitly in order to enhance numerical stability. - ! - ! The discretized explicit portion of the term is written out as: - ! - ! + (1/2) * invrs_rho_ds_zt(2) - ! * dzt(2) - ! * [ rho_ds_zm(2) * K_zm(2) - ! * dzm(2) * ( xm(3,) - xm(2,) ) ]. - ! - ! Timestep index (t) stands for the index of the current timestep, while - ! timestep index (t+1) stands for the index of the next timestep, which - ! is being advanced to in solving the d(xm)/dt equation. - ! - ! - ! The lower boundary condition for the implicit and explicit portions of the - ! turbulent advection term, without the x'w'|_sfc portion of the term, can - ! easily be invoked by using the zero-flux boundary conditions found in the - ! generalized diffusion function (function diffusion_zt_lhs), which is used - ! for many other equations in this model. Either the generalized explicit - ! surface flux needs to be added onto the explicit term after the diffusion - ! function has been called from subroutine windm_edsclrm_rhs, or the - ! implicit momentum surface flux needs to be added onto the implicit term - ! after the diffusion function has been called from subroutine - ! windm_edsclrm_lhs. However, all other equations in this model that use - ! zero-flux diffusion have level 1 as the level to which the lower boundary - ! condition needs to be applied. Thus, an adjuster will have to be used at - ! level 2 to call diffusion_zt_lhs with level 1 as the input level (the last - ! variable being passed in during the function call). However, the other - ! variables passed in (rho_ds_zm*K_zm, gr%dzt, and gr%dzm variables) will - ! have to be passed in as solving for level 2. - ! - ! The value of xm(1) is located below the model surface and does not effect - ! the rest of the model. Since xm can be either a horizontal wind component - ! or a generic eddy scalar quantity, the value of xm(1) is simply set to the - ! value of xm(2) after the equation matrix has been solved. - ! - ! - ! Conservation Properties: - ! - ! When a fixed-flux lower boundary condition is used (combined with a - ! zero-flux upper boundary condition), this technique of discretizing the - ! turbulent advection term (treated as an eddy-diffusion term) leads to - ! conservative differencing. When the implicit momentum surface flux is - ! either zero or not used, the column totals for each column in the - ! left-hand side matrix (for the turbulent advection term) should be equal - ! to 0. Otherwise, the column total for the second column will be equal to - ! rho_ds_zm(1) * x'w'|_sfc. When the generalized explicit surface - ! flux is either zero or not used, the column total for the right-hand side - ! vector (for the turbulent advection term) should be equal to 0. - ! Otherwise, the column total for the right-hand side vector (for the - ! turbulent advection term) will be equal to rho_ds_zm(1) * x'w'|_sfc. - ! This ensures that the total amount of quantity xm over the entire vertical - ! domain is only changed by the surface flux (neglecting any forcing terms). - ! The total amount of change is equal to rho_ds_zm(1) * x'w'|_sfc. - ! - ! To see that this conservation law is satisfied by the left-hand side - ! matrix, compute the turbulent advection (treated as eddy diffusion) of xm, - ! neglecting any implicit momentum surface flux, multiply by rho_ds_zt, and - ! integrate vertically. In discretized matrix notation (where "i" stands - ! for the matrix column and "j" stands for the matrix row): - ! - ! 0 = Sum_j Sum_i - ! (rho_ds_zt)_i ( 1/dzt )_i - ! ( 0.5_core_rknd * (1/rho_ds_zt) * dzt * (rho_ds_zm*K_zm*dzm) )_ij (xm)_j. - ! - ! The left-hand side matrix, - ! ( 0.5_core_rknd * (1/rho_ds_zt) * dzt * (rho_ds_zm*K_zm*dzm) )_ij, is partially - ! written below. The sum over i in the above equation removes (1/rho_ds_zt) - ! and dzt everywhere from the matrix below. The sum over j leaves the - ! column totals that are desired, which are 0. - ! - ! Left-hand side matrix contributions from the turbulent advection term - ! (treated as an eddy-diffusion term using a Crank-Nicholson timestep); - ! first five vertical levels: - ! - ! -------------------------------------------------------------------------------> - !k=1 | 0 0 0 0 - ! | - !k=2 | 0 +0.5* -0.5* 0 - ! | (1/rho_ds_zt(k))* (1/rho_ds_zt(k))* - ! | dzt(k)* dzt(k)* - ! | rho_ds_zm(k)* rho_ds_zm(k)* - ! | K_zm(k)*dzm(k) K_zm(k)*dzm(k) - ! | - !k=3 | 0 -0.5* +0.5* -0.5* - ! | (1/rho_ds_zt(k))* (1/rho_ds_zt(k))* (1/rho_ds_zt(k))* - ! | dzt(k)* dzt(k)* dzt(k)* - ! | rho_ds_zm(k-1)* [ rho_ds_zm(k)* rho_ds_zm(k)* - ! | K_zm(k-1)*dzm(k-1) K_zm(k)*dzm(k) K_zm(k)*dzm(k) - ! | +rho_ds_zm(k-1)* - ! | K_zm(k-1)*dzm(k-1) ] - ! | - !k=4 | 0 0 -0.5* +0.5* - ! | (1/rho_ds_zt(k))* (1/rho_ds_zt(k))* - ! | dzt(k)* dzt(k)* - ! | rho_ds_zm(k-1)* [ rho_ds_zm(k)* - ! | K_zm(k-1)*dzm(k-1) K_zm(k)*dzm(k) - ! | +rho_ds_zm(k-1)* - ! | K_zm(k-1)*dzm(k-1) ] - ! | - !k=5 | 0 0 0 -0.5* - ! | (1/rho_ds_zt(k))* - ! | dzt(k)* - ! | rho_ds_zm(k-1)* - ! | K_zm(k-1)*dzm(k-1) - ! \ / - ! - ! Note: The superdiagonal term from level 4 and both the main diagonal and - ! superdiagonal terms from level 5 are not shown on this diagram. - ! - ! Note: If an implicit momentum surface flux is used, an additional term, - ! + (1/rho_ds_zt(2)) * dzt(2) * rho_ds_zm(1) - ! * [ u_star^2 / sqrt( um(2,)^2 + vm(2,)^2 ) ], is added to - ! row 2 (k=2), column 2. - ! - ! To see that the above conservation law is satisfied by the right-hand side - ! vector, compute the turbulent advection (treated as eddy diffusion) of xm, - ! neglecting any generalized explicit surface flux, multiply by rho_ds_zt, - ! and integrate vertically. In discretized matrix notation (where "i" - ! stands for the matrix column and "j" stands for the matrix row): - ! - ! 0 = Sum_j Sum_i (rho_ds_zt)_i ( 1/dzt )_i ( rhs_vector )_j. - ! - ! The right-hand side vector, ( rhs_vector )_j, is partially written below. - ! The sum over i in the above equation removes (1/rho_ds_zt) and dzt - ! everywhere from the vector below. The sum over j leaves the column total - ! that is desired, which is 0. - ! - ! Right-hand side vector contributions from the turbulent advection term - ! (treated as an eddy-diffusion term using a Crank-Nicholson timestep); - ! first five vertical levels: - ! - ! -------------------------------------------- - !k=1 | 0 | - ! | | - ! | | - !k=2 | +0.5*(1/rho_ds_zt(k))* | - ! | dzt(k)* | - ! | [ rho_ds_zm(k)*K_zm(k)* | - ! | dzm(k)*(xm(k+1,)-xm(k,)) ] | - ! | | - !k=3 | +0.5*(1/rho_ds_zt(k))* | - ! | dzt(k)* | - ! | [ rho_ds_zm(k)*K_zm(k)* | - ! | dzm(k)*(xm(k+1,)-xm(k,)) | - ! | -rho_ds_zm(k-1)*K_zm(k-1)* | - ! | dzm(k-1)*(xm(k,)-xm(k-1,)) ] | - ! | | - !k=4 | +0.5*(1/rho_ds_zt(k))* | - ! | dzt(k)* | - ! | [ rho_ds_zm(k)*K_zm(k)* | - ! | dzm(k)*(xm(k+1,)-xm(k,)) | - ! | -rho_ds_zm(k-1)*K_zm(k-1)* | - ! | dzm(k-1)*(xm(k,)-xm(k-1,)) ] | - ! | | - !k=5 | +0.5*(1/rho_ds_zt(k))* | - ! | dzt(k)* | - ! | [ rho_ds_zm(k)*K_zm(k)* | - ! | dzm(k)*(xm(k+1,)-xm(k,)) | - ! | -rho_ds_zm(k-1)*K_zm(k-1)* | - ! | dzm(k-1)*(xm(k,)-xm(k-1,)) ] | - ! \ / \ / - ! - ! Note: If a generalized explicit surface flux is used, an additional term, - ! + (1/rho_ds_zt(2)) * dzt(2) * rho_ds_zm(1) * x'w'|_sfc, is added to - ! row 2 (k=2). - ! - ! Note: Only the contributions by the turbulent advection term are shown - ! for both the left-hand side matrix and the right-hand side vector. - ! There are more terms in the equation, and thus more factors to be - ! added to both the left-hand side matrix (such as time tendency and - ! mean advection) and the right-hand side vector (such as xm - ! forcings). The left-hand side matrix is set-up so that a singular - ! matrix is not encountered. - - ! References: - ! Eqn. 8 & 9 on p. 3545 of - ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: - ! Method and Model Description'' Golaz, et al. (2002) - ! JAS, Vol. 59, pp. 3540--3551. - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_lapack_wrap, only: & - tridag_solve, & ! Procedure(s) - tridag_solvex - - use crmx_stats_variables, only: & - sfc, & ! Variable(s) - l_stats_samp - - use crmx_stats_type, only: & - stat_update_var_pt ! Subroutine - - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - - integer, parameter :: & - kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. - k_tdiag = 2, & ! Thermodynamic main diagonal index. - km1_tdiag = 3 ! Thermodynamic subdiagonal index. - - ! Input Variables - - integer, intent(in) :: & - nrhs ! Number of right-hand side (explicit) vectors & Number of solution vectors. - - integer, intent(in) :: & - ixm_matrix_condt_num ! Stats index of the condition numbers - - real( kind = core_rknd ), dimension(3,gr%nz), intent(inout) :: & - lhs ! Implicit contributions to um, vm, and eddy scalars [units vary] - - real( kind = core_rknd ), dimension(gr%nz,nrhs), intent(inout) :: & - rhs ! Right-hand side (explicit) contributions. - - real( kind = core_rknd ), dimension(gr%nz,nrhs), intent(out) :: & - solution ! Solution to the system of equations [units vary] - - integer, intent(out) :: & - err_code ! clubb_singular_matrix when matrix is singular - - ! Local variables - real( kind = core_rknd ) :: & - rcond ! Estimate of the reciprocal of the condition number on the LHS matrix - - ! Solve tridiagonal system for xm. - if ( l_stats_samp .and. ixm_matrix_condt_num > 0 ) then - call tridag_solvex & - ( "windm_edsclrm", gr%nz, nrhs, & ! Intent(in) - lhs(kp1_tdiag,:), lhs(k_tdiag,:), lhs(km1_tdiag,:), rhs, & ! Intent(inout) - solution, rcond, err_code ) ! Intent(out) - - ! Est. of the condition number of the variance LHS matrix - call stat_update_var_pt( ixm_matrix_condt_num, 1, 1.0_core_rknd/rcond, & ! Intent(in) - sfc ) ! Intent(inout) - else - - call tridag_solve( "windm_edsclrm", gr%nz, nrhs, & ! In - lhs(kp1_tdiag,:), lhs(k_tdiag,:), lhs(km1_tdiag,:), rhs, & ! Inout - solution, err_code ) ! Out - end if - - return - end subroutine windm_edsclrm_solve - - !============================================================================= - subroutine windm_edsclrm_implicit_stats( solve_type, xm ) - - ! Description: - ! Compute implicit contributions to um and vm - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_stats_variables, only: & - ium_ma, & ! Variables - ium_ta, & - ivm_ma, & - ivm_ta, & - ztscr01, & - ztscr02, & - ztscr03, & - ztscr04, & - ztscr05, & - ztscr06, & - zt - - use crmx_stats_type, only: & - stat_end_update_pt, & ! Subroutines - stat_update_var_pt - - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_grid_class, only: & - gr ! Derived type variable - - implicit none - - ! Input variables - integer, intent(in) :: & - solve_type ! Desc. of what is being solved for - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - xm ! Computed value um or vm at [m/s] - - ! Local variables - integer :: k, kp1, km1 ! Array indices - - ! Budget indices - integer :: ixm_ma, ixm_ta - - select case ( solve_type ) - case ( windm_edsclrm_um ) - ixm_ma = ium_ma - ixm_ta = ium_ta - - case ( windm_edsclrm_vm ) - ixm_ma = ivm_ma - ixm_ta = ivm_ta - - case default - ixm_ma = 0 - ixm_ta = 0 - - end select - - - ! Finalize implicit contributions for xm - - do k = 2, gr%nz-1, 1 - - km1 = max( k-1, 1 ) - kp1 = min( k+1, gr%nz ) - - ! xm mean advection - ! xm term ma is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( ixm_ma, k, & - ztscr01(k) * xm(km1) & - + ztscr02(k) * xm(k) & - + ztscr03(k) * xm(kp1), zt ) - - ! xm turbulent transport (implicit component) - ! xm term ta has both implicit and explicit components; - ! call stat_end_update_pt. - call stat_end_update_pt( ixm_ta, k, & - ztscr04(k) * xm(km1) & - + ztscr05(k) * xm(k) & - + ztscr06(k) * xm(kp1), zt ) - - enddo - - - ! Upper boundary conditions - k = gr%nz - km1 = max( k-1, 1 ) - - ! xm mean advection - ! xm term ma is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( ixm_ma, k, & - ztscr01(k) * xm(km1) & - + ztscr02(k) * xm(k), zt ) - - ! xm turbulent transport (implicit component) - ! xm term ta has both implicit and explicit components; - ! call stat_end_update_pt. - call stat_end_update_pt( ixm_ta, k, & - ztscr04(k) * xm(km1) & - + ztscr05(k) * xm(k), zt ) - - - return - end subroutine windm_edsclrm_implicit_stats - - !============================================================================= - subroutine compute_uv_tndcy( solve_type, fcor, perp_wind_m, perp_wind_g, xm_forcing, & - l_implemented, xm_tndcy ) - - ! Description: - ! Computes the explicit tendency for the um and vm wind components. - ! - ! The only explicit tendency that is involved in the d(um)/dt or d(vm)/dt - ! equations is the Coriolis tendency. - ! - ! The d(um)/dt equation contains the term: - ! - ! - f * ( v_g - vm ); - ! - ! where f is the Coriolis parameter and v_g is the v component of the - ! geostrophic wind. - ! - ! Likewise, the d(vm)/dt equation contains the term: - ! - ! + f * ( u_g - um ); - ! - ! where u_g is the u component of the geostrophic wind. - ! - ! This term is treated completely explicitly. The values of um, vm, u_g, - ! and v_g are all found on the thermodynamic levels. - ! - ! Wind forcing from the GCSS cases is also added here. - ! - ! References: - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr - - use crmx_stats_type, only: & - stat_update_var - - use crmx_stats_variables, only: & - ium_gf, & - ium_cf, & - ivm_gf, & - ivm_cf, & - ium_f, & - ivm_f, & - zt, & - l_stats_samp - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - integer, intent(in) :: & - solve_type ! Description of what is being solved for - - real( kind = core_rknd ), intent(in) :: & - fcor ! Coriolis parameter [s^-1] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - perp_wind_m, & ! Perpendicular component of the mean wind (e.g. v, for the u-eqn) [m/s] - perp_wind_g, & ! Perpendicular component of the geostropic wind (e.g. vg) [m/s] - xm_forcing ! Prescribed wind forcing [m/s/s] - - logical, intent(in) :: & - l_implemented ! Flag for CLUBB being implemented in a larger model. - - ! Output Variables - real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & - xm_tndcy ! xm tendency [m/s^2] - - ! Local Variables - integer :: & - ixm_gf, & - ixm_cf, & - ixm_f - - real( kind = core_rknd ), dimension(gr%nz) :: & - xm_gf, & - xm_cf - - ! --- Begin Code --- - - if ( .not. l_implemented ) then - ! Only compute the Coriolis term if the model is running on it's own, - ! and is not part of a larger, host model. - - select case ( solve_type ) - - case ( windm_edsclrm_um ) - - ixm_gf = ium_gf - ixm_cf = ium_cf - ixm_f = ium_f - - xm_gf = - fcor * perp_wind_g(1:gr%nz) - - xm_cf = fcor * perp_wind_m(1:gr%nz) - - case ( windm_edsclrm_vm ) - - ixm_gf = ivm_gf - ixm_cf = ivm_cf - ixm_f = ivm_f - - xm_gf = fcor * perp_wind_g(1:gr%nz) - - xm_cf = -fcor * perp_wind_m(1:gr%nz) - - case default - - ixm_gf = 0 - ixm_cf = 0 - ixm_f = 0 - - xm_gf = 0._core_rknd - - - xm_cf = 0._core_rknd - - end select - - xm_tndcy(1:gr%nz) = xm_gf(1:gr%nz) + xm_cf(1:gr%nz) & - + xm_forcing(1:gr%nz) - - if ( l_stats_samp ) then - - ! xm term gf is completely explicit; call stat_update_var. - call stat_update_var( ixm_gf, xm_gf, zt ) - - ! xm term cf is completely explicit; call stat_update_var. - call stat_update_var( ixm_cf, xm_cf, zt ) - - ! xm term F - call stat_update_var( ixm_f, xm_forcing, zt ) - endif - - else ! implemented in a host model. - - xm_tndcy = 0.0_core_rknd - - endif - - - return - end subroutine compute_uv_tndcy - -!=============================================================================== - subroutine windm_edsclrm_lhs( dt, nu, wm_zt, Kh_zm, wind_speed, u_star_sqd, & - rho_ds_zm, invrs_rho_ds_zt, & - l_implemented, l_imp_sfc_momentum_flux, & - lhs ) - - ! Description: - ! Calculate the implicit portion of the horizontal wind or eddy-scalar - ! time-tendency equation. See the description in subroutine - ! windm_edsclrm_solve for more details. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_diffusion, only: & - diffusion_zt_lhs ! Procedure(s) - - use crmx_mean_adv, only: & - term_ma_zt_lhs ! Procedures - - use crmx_stats_variables, only: & - ium_ma, & ! Variable(s) - ium_ta, & - ivm_ma, & - ivm_ta, & - ztscr01, & - ztscr02, & - ztscr03, & - ztscr04, & - ztscr05, & - ztscr06, & - l_stats_samp - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. - k_tdiag = 2, & ! Thermodynamic main diagonal index. - km1_tdiag = 3 ! Thermodynamic subdiagonal index. - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Model timestep [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - nu ! Background constant coef. of eddy diffusivity [m^2/s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - wm_zt, & ! w wind component on thermodynamic levels [m/s] - Kh_zm, & ! Eddy diffusivity on momentum levels [m^2/s] - wind_speed, & ! wind speed; sqrt( u^2 + v^2 ) [m/s] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - invrs_rho_ds_zt ! Inv. dry, static density at thermo. levels [m^3/kg] - - real( kind = core_rknd ), intent(in) :: & - u_star_sqd ! Surface friction velocity, u_*, squared [m/s] - - logical, intent(in) :: & - l_implemented, & ! Flag for CLUBB being implemented in a larger model. - l_imp_sfc_momentum_flux ! Flag for implicit momentum surface fluxes. - - ! Output Variable - real( kind = core_rknd ), dimension(3,gr%nz), intent(out) :: & - lhs ! Implicit contributions to xm (tridiagonal matrix) - - ! Local Variables - integer :: k, km1 ! Array indices - integer :: diff_k_in - - real( kind = core_rknd ), dimension(3) :: tmp - - ! --- Begin Code --- - - ! Initialize the LHS array to zero. - lhs = 0.0_core_rknd - - do k = 2, gr%nz, 1 - - ! Define index - km1 = max( k-1, 1 ) - - ! LHS mean advection term. - if ( .not. l_implemented ) then - - lhs(kp1_tdiag:km1_tdiag,k) & - = lhs(kp1_tdiag:km1_tdiag,k) & - + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) - - else - ! The host model is assumed to apply the advection term to the mean elsewhere in this case. - lhs(kp1_tdiag:km1_tdiag,k) & - = lhs(kp1_tdiag:km1_tdiag,k) + 0.0_core_rknd - - endif - - ! LHS turbulent advection term (solved as an eddy-diffusion term). - if ( k == 2 ) then - ! The lower boundary condition needs to be applied here at level 2. - ! The lower boundary condition is a "fixed flux" boundary condition. - ! The coding is the same as for a zero-flux boundary condition, but with - ! an extra term added on the right-hand side at the boundary level. For - ! the rest of the model code, a zero-flux boundary condition is applied - ! at level 1, and thus subroutine diffusion_zt_lhs is set-up to do that. - ! In order to apply the same boundary condition code here at level 2, an - ! adjuster needs to be used to tell diffusion_zt_lhs to use the code at - ! level 2 that it normally uses at level 1. - diff_k_in = 1 - else - diff_k_in = k - endif - lhs(kp1_tdiag:km1_tdiag,k) & - = lhs(kp1_tdiag:km1_tdiag,k) & - + 0.5_core_rknd * invrs_rho_ds_zt(k) & - * diffusion_zt_lhs( rho_ds_zm(k) * Kh_zm(k), & - rho_ds_zm(km1) * Kh_zm(km1), nu, & - gr%invrs_dzm(km1), gr%invrs_dzm(k), & - gr%invrs_dzt(k), diff_k_in ) - - ! LHS time tendency. - lhs(k_tdiag,k) & - = lhs(k_tdiag,k) + 1.0_core_rknd / real( dt, kind = core_rknd ) - - if ( l_stats_samp ) then - - ! Statistics: implicit contributions for um or vm. - ! Note: we don't track these budgets for the eddy scalar variables - - if ( ium_ma + ivm_ma > 0 ) then - if ( .not. l_implemented ) then - tmp(1:3) & - = term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) - ztscr01(k) = -tmp(3) - ztscr02(k) = -tmp(2) - ztscr03(k) = -tmp(1) - else - ztscr01(k) = 0.0_core_rknd - ztscr02(k) = 0.0_core_rknd - ztscr03(k) = 0.0_core_rknd - endif - endif - - if ( ium_ta + ivm_ta > 0 ) then - tmp(1:3) & - = 0.5_core_rknd * invrs_rho_ds_zt(k) & - * diffusion_zt_lhs( rho_ds_zm(k) * Kh_zm(k), & - rho_ds_zm(km1) * Kh_zm(km1), nu, & - gr%invrs_dzm(km1), gr%invrs_dzm(k), & - gr%invrs_dzt(k), diff_k_in ) - ztscr04(k) = -tmp(3) - ztscr05(k) = -tmp(2) - ztscr06(k) = -tmp(1) - endif - - endif ! l_stats_samp - - enddo ! k = 2 .. gr%nz - - - ! Boundary Conditions - - ! Lower Boundary - - ! The lower boundary condition is a fixed-flux boundary condition, which - ! gets added into the time-tendency equation at level 2. - ! The value of xm(1) is located below the model surface and does not effect - ! the rest of the model. Since xm can be either a horizontal wind component - ! or a generic eddy scalar quantity, the value of xm(1) is simply set to the - ! value of xm(2) after the equation matrix has been solved. - - ! k = 1 - lhs(k_tdiag,1) = 1.0_core_rknd - - ! k = 2; add implicit momentum surface flux. - if ( l_imp_sfc_momentum_flux ) then - - ! LHS momentum surface flux. - lhs(k_tdiag,2) & - = lhs(k_tdiag,2) & - + invrs_rho_ds_zt(2) & - * gr%invrs_dzt(2) & - * rho_ds_zm(1) * ( u_star_sqd / wind_speed(2) ) - - if ( l_stats_samp ) then - - ! Statistics: implicit contributions for um or vm. - - ! xm term ta is modified at level 2 to include the effects of the - ! surface flux. In this case, this effects the implicit portion of - ! the term (after zmscr05, which handles the main diagonal for the - ! turbulent advection term, has already been called at level 2). - ! Modify zmscr05 accordingly. - if ( ium_ta + ivm_ta > 0 ) then - ztscr05(2) & - = ztscr05(2) & - - invrs_rho_ds_zt(2) & - * gr%invrs_dzt(2) & - * rho_ds_zm(1) * ( u_star_sqd / wind_speed(2) ) - endif - - endif ! l_stats_samp - - endif ! l_imp_sfc_momentum_flux - - - return - end subroutine windm_edsclrm_lhs - - !============================================================================= - function windm_edsclrm_rhs( solve_type, dt, nu, Kh_zm, xm, xm_tndcy, & - rho_ds_zm, invrs_rho_ds_zt, & - l_imp_sfc_momentum_flux, xpwp_sfc ) & - result( rhs ) - - ! Description: - ! Calculate the explicit portion of the horizontal wind or eddy-scalar - ! time-tendency equation. See the description in subroutine - ! windm_edsclrm_solve for more details. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_diffusion, only: & - diffusion_zt_lhs ! Procedure(s) - - use crmx_stats_variables, only: & - ium_ta, & ! Variable(s) - ivm_ta, & - zt, & - l_stats_samp - - use crmx_stats_type, only: & - stat_begin_update_pt, & ! Procedure(s) - stat_modify_pt - - use crmx_grid_class, only: & - gr ! Variable(s) - - implicit none - - ! External - intrinsic :: max, min, real, trim - - ! Input Variables - integer, intent(in) :: & - solve_type ! Description of what is being solved for - - real(kind=time_precision), intent(in) :: & - dt ! Model timestep [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - nu ! Background constant coef. of eddy diffusivity [m^2/s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - Kh_zm, & ! Eddy diffusivity on momentum levels [m^2/s] - xm, & ! Eddy-scalar variable, xm (thermo. levels) [units vary] - xm_tndcy, & ! The explicit time-tendency acting on xm [units vary] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - invrs_rho_ds_zt ! Inv. dry, static density at thermo. levels [m^3/kg] - - real( kind = core_rknd ), intent(in) :: & - xpwp_sfc ! x'w' at the surface [units vary] - - logical, intent(in) :: & - l_imp_sfc_momentum_flux ! Flag for implicit momentum surface fluxes. - - ! Output Variable - real( kind = core_rknd ), dimension(gr%nz) :: & - rhs ! Right-hand side (explicit) contributions. - - ! Local Variables - integer :: k, kp1, km1 ! Array indices - integer :: diff_k_in - - ! For use in Crank-Nicholson eddy diffusion. - real( kind = core_rknd ), dimension(3) :: rhs_diff - - integer :: ixm_ta - - ! --- Begin Code --- - - select case ( solve_type ) - case ( windm_edsclrm_um ) - ixm_ta = ium_ta - case ( windm_edsclrm_vm ) - ixm_ta = ivm_ta - case default ! Eddy scalars - ixm_ta = 0 - end select - - - ! Initialize the RHS vector. - rhs = 0.0_core_rknd - - do k = 2, gr%nz-1, 1 - - ! Define indices - km1 = max( k-1, 1 ) - kp1 = min( k+1, gr%nz ) - - ! RHS turbulent advection term (solved as an eddy-diffusion term). - if ( k == 2 ) then - ! The lower boundary condition needs to be applied here at level 2. - ! The lower boundary condition is a "fixed flux" boundary condition. - ! The coding is the same as for a zero-flux boundary condition, but with - ! an extra term added on the right-hand side at the boundary level. For - ! the rest of the model code, a zero-flux boundary condition is applied - ! at level 1, and thus subroutine diffusion_zt_lhs is set-up to do that. - ! In order to apply the same boundary condition code here at level 2, an - ! adjuster needs to be used to tell diffusion_zt_lhs to use the code at - ! level 2 that it normally uses at level 1. - diff_k_in = 1 - else - diff_k_in = k - endif - rhs_diff(1:3) & - = 0.5_core_rknd * invrs_rho_ds_zt(k) & - * diffusion_zt_lhs( rho_ds_zm(k) * Kh_zm(k), & - rho_ds_zm(km1) * Kh_zm(km1), nu, & - gr%invrs_dzm(km1), gr%invrs_dzm(k), & - gr%invrs_dzt(k), diff_k_in ) - rhs(k) = rhs(k) & - - rhs_diff(3) * xm(km1) & - - rhs_diff(2) * xm(k) & - - rhs_diff(1) * xm(kp1) - - ! RHS forcings. - rhs(k) = rhs(k) + xm_tndcy(k) - - ! RHS time tendency - rhs(k) = rhs(k) + 1.0_core_rknd / real ( dt, kind = core_rknd ) * xm(k) - - if ( l_stats_samp ) then - - ! Statistics: explicit contributions for um or vm. - - ! xm term ta has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on right-hand side - ! turbulent advection component. - if ( ixm_ta > 0 ) then - call stat_begin_update_pt( ixm_ta, k, & - rhs_diff(3) * xm(km1) & - + rhs_diff(2) * xm(k) & - + rhs_diff(1) * xm(kp1), zt ) - endif - - endif ! l_stats_samp - - enddo ! 2..gr%nz-1 - - - ! Boundary Conditions - - ! Lower Boundary - - ! The lower boundary condition is a fixed-flux boundary condition, which - ! gets added into the time-tendency equation at level 2. - ! The value of xm(1) is located below the model surface and does not effect - ! the rest of the model. Since xm can be either a horizontal wind component - ! or a generic eddy scalar quantity, the value of xm(1) is simply set to the - ! value of xm(2) after the equation matrix has been solved. For purposes of - ! the matrix equation, rhs(1) is simply set to 0. - - ! k = 1 - rhs(1) = 0.0_core_rknd - - ! k = 2; add generalized explicit surface flux. - if ( .not. l_imp_sfc_momentum_flux ) then - - ! RHS generalized surface flux. - rhs(2) & - = rhs(2) & - + invrs_rho_ds_zt(2) & - * gr%invrs_dzt(2) & - * rho_ds_zm(1) * xpwp_sfc - - if ( l_stats_samp ) then - - ! Statistics: explicit contributions for um or vm. - - ! xm term ta is modified at level 2 to include the effects of the - ! surface flux. In this case, this effects the explicit portion of - ! the term (after stat_begin_update_pt has already been called at - ! level 2); call stat_modify_pt. - if ( ixm_ta > 0 ) then - call stat_modify_pt( ixm_ta, 2, & - + invrs_rho_ds_zt(2) & - * gr%invrs_dzt(2) & - * rho_ds_zm(1) * xpwp_sfc, & - zt ) - endif - - endif ! l_stats_samp - - endif ! l_imp_sfc_momentum_flux - - ! Upper Boundary - - ! A zero-flux boundary condition is used at the upper boundary, meaning that - ! xm is not allowed to exit the model through the upper boundary. This - ! boundary condition is invoked by calling diffusion_zt_lhs at the uppermost - ! level. - k = gr%nz - km1 = max( k-1, 1 ) - - ! RHS turbulent advection term (solved as an eddy-diffusion term) at the - ! upper boundary. - rhs_diff(1:3) & - = 0.5_core_rknd * invrs_rho_ds_zt(k) & - * diffusion_zt_lhs( rho_ds_zm(k) * Kh_zm(k), & - rho_ds_zm(km1) * Kh_zm(km1), nu, & - gr%invrs_dzm(km1), gr%invrs_dzm(k), & - gr%invrs_dzt(k), k ) - rhs(k) = rhs(k) & - - rhs_diff(3) * xm(km1) & - - rhs_diff(2) * xm(k) - - ! RHS forcing term at the upper boundary. - rhs(k) = rhs(k) + xm_tndcy(k) - - ! RHS time tendency term at the upper boundary. - rhs(k) = rhs(k) + 1.0_core_rknd / real( dt, kind = core_rknd ) * xm(k) - - if ( l_stats_samp ) then - - ! Statistics: explicit contributions for um or vm. - - ! xm term ta has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on right-hand side - ! turbulent advection component. - if ( ixm_ta > 0 ) then - call stat_begin_update_pt( ixm_ta, k, & - rhs_diff(3) * xm(km1) & - + rhs_diff(2) * xm(k), zt ) - endif - - endif ! l_stats_samp - - - return - end function windm_edsclrm_rhs - -!=============================================================================== - elemental function xpwp_fnc( Kh_zm, xm, xmp1, invrs_dzm ) - - ! Description: - ! Compute x'w' from x, x, Kh and invrs_dzm - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input variables - real( kind = core_rknd ), intent(in) :: & - Kh_zm, & ! Eddy diff. (k momentum level) [m^2/s] - xm, & ! x (k thermo level) [units vary] - xmp1, & ! x (k+1 thermo level) [units vary] - invrs_dzm ! Inverse of the grid spacing (k thermo level) [1/m] - - ! Output variable - real( kind = core_rknd ) :: & - xpwp_fnc ! x'w' [(units vary)(m/s)] - - !----------------------------------------------------------------------- - ! --- Begin Code --- - - ! Solve for x'w' at all intermediate model levels. - xpwp_fnc = Kh_zm * invrs_dzm * ( xmp1 - xm ) - - return - end function xpwp_fnc - -!=============================================================================== - -end module crmx_advance_windm_edsclrm_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_advance_wp2_wp3_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_advance_wp2_wp3_module.F90 deleted file mode 100644 index cefd03f334..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_advance_wp2_wp3_module.F90 +++ /dev/null @@ -1,4427 +0,0 @@ -!------------------------------------------------------------------------ -! $Id: advance_wp2_wp3_module.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ -!=============================================================================== -module crmx_advance_wp2_wp3_module - - implicit none - - private ! Default Scope - - public :: advance_wp2_wp3 - - private :: wp23_solve, & - wp23_lhs, & - wp23_rhs, & - wp2_term_ta_lhs, & - wp2_terms_ac_pr2_lhs, & - wp2_term_dp1_lhs, & - wp2_term_pr1_lhs, & - wp2_terms_bp_pr2_rhs, & - wp2_term_dp1_rhs, & - wp2_term_pr3_rhs, & - wp2_term_pr1_rhs, & - wp3_terms_ta_tp_lhs, & - wp3_terms_ac_pr2_lhs, & - wp3_term_pr1_lhs, & - wp3_terms_bp1_pr2_rhs, & - wp3_term_pr1_rhs, & - wp3_term_bp2_rhs - -! private :: wp3_terms_ta_tp_rhs - - ! Private named constants to avoid string comparisons - integer, parameter, private :: & - clip_wp2 = 12 ! Named constant for wp2 clipping. - ! NOTE: This must be the same as the clip_wp2 declared in - ! clip_explicit! - - contains - - !============================================================================= - subroutine advance_wp2_wp3( dt, sfc_elevation, sigma_sqd_w, wm_zm, wm_zt, & - a3, a3_zt, wp3_on_wp2, & - wpthvp, wp2thvp, um, vm, upwp, vpwp, & - up2, vp2, Kh_zm, Kh_zt, tau_zm, tau_zt, & - Skw_zm, Skw_zt, rho_ds_zm, rho_ds_zt, & - invrs_rho_ds_zm, invrs_rho_ds_zt, radf, & - thv_ds_zm, thv_ds_zt, mixt_frac, & - wp2, wp3, wp3_zm, wp2_zt, err_code ) - - ! Description: - ! Advance w'^2 and w'^3 one timestep. - - ! References: - ! Eqn. 12 & 18 on p. 3545--3546 of - ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: - ! Method and Model Description'' Golaz, et al. (2002) - ! JAS, Vol. 59, pp. 3540--3551. - - ! See also - ! ``Equations for CLUBB'', Section 6: - ! /Implict solution for the vertical velocity moments/ - !------------------------------------------------------------------------ - - use crmx_grid_class, only: & - gr, & ! Variable(s) - zt2zm, & ! Procedure(s) - zm2zt - - use crmx_parameters_tunable, only: & - C11c, & ! Variable(s) - C11b, & - C11, & - C1c, & - C1b, & - C1, & - c_K1, & - c_K8 - - use crmx_stats_type, only: & - stat_update_var - - use crmx_stats_variables, only: & - iC1_Skw_fnc, & - iC11_Skw_fnc, & - zm, & - zt, & - l_stats_samp - - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - use crmx_model_flags, only: & - l_hyper_dfsn ! Variable(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_error_code, only: & - fatal_error, & ! Procedure(s) - clubb_at_least_debug_level - - use crmx_error_code, only: & - clubb_var_out_of_range ! Constant(s) - - implicit none - - intrinsic :: exp - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Model timestep [s] - - real( kind = core_rknd ), intent(in) :: & - sfc_elevation ! Elevation of ground level [m AMSL] - - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - sigma_sqd_w, & ! sigma_sqd_w (momentum levels) [-] - wm_zm, & ! w wind component on momentum levels [m/s] - wm_zt, & ! w wind component on thermodynamic levels [m/s] - a3, & ! a_3 (momentum levels); See eqn. 25 in `Equations for CLUBB' [-] - a3_zt, & ! a_3 interpolated to thermodynamic levels [-] - wp3_on_wp2, & ! Smoothed version of wp3 / wp2 [m/s] - wpthvp, & ! w'th_v' (momentum levels) [K m/s] - wp2thvp, & ! w'^2th_v' (thermodynamic levels) [K m^2/s^2] - um, & ! u wind component (thermodynamic levels) [m/s] - vm, & ! v wind component (thermodynamic levels) [m/s] - upwp, & ! u'w' (momentum levels) [m^2/s^2] - vpwp, & ! v'w' (momentum levels) [m^2/s^2] - up2, & ! u'^2 (momentum levels) [m^2/s^2] - vp2, & ! v'^2 (momentum levels) [m^2/s^2] - Kh_zm, & ! Eddy diffusivity on momentum levels [m^2/s] - Kh_zt, & ! Eddy diffusivity on thermodynamic levels [m^2/s] - tau_zm, & ! Time-scale tau on momentum levels [s] - tau_zt, & ! Time-scale tau on thermodynamic levels [s] - Skw_zm, & ! Skewness of w on momentum levels [-] - Skw_zt, & ! Skewness of w on thermodynamic levels [-] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] - invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] - radf, & ! Buoyancy production at the CL top [m^2/s^3] - thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K] - thv_ds_zt, & ! Dry, base-state theta_v on thermo. levs. [K] - mixt_frac ! Weight of 1st normal distribution [-] - - ! Input/Output - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - wp2, & ! w'^2 (momentum levels) [m^2/s^2] - wp3, & ! w'^3 (thermodynamic levels) [m^3/s^3] - wp3_zm ! w'^3 interpolated to momentum levels [m^3/s^3] - - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - wp2_zt ! w'^2 interpolated to thermodyamic levels [m^2/s^2] - - integer, intent(inout) :: err_code ! Diagnostic - - ! Local Variables - real( kind = core_rknd ), dimension(gr%nz) :: & - tauw3t ! Currently just tau_zt [s] - - ! Eddy Diffusion for w'^2 and w'^3. - real( kind = core_rknd ), dimension(gr%nz) :: Kw1 ! w'^2 coef. eddy diff. [m^2/s] - real( kind = core_rknd ), dimension(gr%nz) :: Kw8 ! w'^3 coef. eddy diff. [m^2/s] - - ! Internal variables for C11 function, Vince Larson 13 Mar 2005 - ! Brian added C1 function. - real( kind = core_rknd ), dimension(gr%nz) :: & - C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-] - C11_Skw_fnc ! C_11 parameter with Sk_w applied [-] - ! End Vince Larson's addition. - - integer :: & - nsub, & ! Number of subdiagonals in the LHS matrix. - nsup ! Number of superdiagonals in the LHS matrix. - - integer :: k ! Array indices - - integer :: wp2_wp3_err_code ! Error code from solving for wp2/wp3 - - - !----------------------------------------------------------------------- - - - -! Define tauw - -! tauw3t = tau_zt -! . / ( 1. -! . + 3.0_core_rknd * max( -! . min(1.-(mixt_frac-0.01_core_rknd)/(0.05_core_rknd-0.01_core_rknd) -! . ,1.) -! . ,0.) -! . + 3.0_core_rknd * max( -! . min(1.-(mixt_frac-0.99_core_rknd)/(0.95_core_rknd-0.99_core_rknd) -! . ,1.) -! . ,0.) -! . ) - -! do k=1,gr%nz -! -! Skw = abs( wp3(k)/max(wp2(k),1.e-8)**1.5_core_rknd ) -! Skw = min( 5.0_core_rknd, Skw ) -! tauw3t(k) = tau_zt(k) / ( 0.005_core_rknd*Skw**4 + 1.0_core_rknd ) -! -! end do - - tauw3t = tau_zt - - ! Vince Larson added code to make C11 function of Skw. 13 Mar 2005 - ! If this code is used, C11 is no longer relevant, i.e. constants - ! are hardwired. - - ! Calculate C_{1} and C_{11} as functions of skewness of w. - ! The if..then here is only for computational efficiency -dschanen 2 Sept 08 - if ( C11 /= C11b ) then - C11_Skw_fnc(1:gr%nz) = & - C11b + (C11-C11b)*EXP( -(1.0_core_rknd/2.0_core_rknd) * (Skw_zt(1:gr%nz)/C11c)**2 ) - else - C11_Skw_fnc(1:gr%nz) = C11b - end if - - ! The if..then here is only for computational efficiency -dschanen 2 Sept 08 - if ( C1 /= C1b ) then - C1_Skw_fnc(1:gr%nz) = & - C1b + (C1-C1b)*EXP( -(1.0_core_rknd/2.0_core_rknd) * (Skw_zm(1:gr%nz)/C1c)**2 ) - else - C1_Skw_fnc(1:gr%nz) = C1b - end if - - !C11_Skw_fnc = C11 - !C1_Skw_fnc = C1 - - if ( clubb_at_least_debug_level( 2 ) ) then - ! Assertion check for C11_Skw_fnc - if ( any( C11_Skw_fnc(:) > 1._core_rknd ) .or. any( C11_Skw_fnc(:) < 0._core_rknd ) ) then - write(fstderr,*) "The C11_Skw_fnc is outside the valid range for this variable" - err_code = clubb_var_out_of_range - return - end if - end if - - if ( l_stats_samp ) then - call stat_update_var( iC11_Skw_fnc, C11_Skw_fnc, zt ) - call stat_update_var( iC1_Skw_fnc, C1_Skw_fnc, zm ) - endif - - ! Define the Coefficent of Eddy Diffusivity for the wp2 and wp3. - do k = 1, gr%nz, 1 - - ! Kw1 is used for wp2, which is located on momentum levels. - ! Kw1 is located on thermodynamic levels. - ! Kw1 = c_K1 * Kh_zt - Kw1(k) = c_K1 * Kh_zt(k) - - ! Kw8 is used for wp3, which is located on thermodynamic levels. - ! Kw8 is located on momentum levels. - ! Note: Kw8 is usually defined to be 1/2 of Kh_zm. - ! Kw8 = c_K8 * Kh_zm - Kw8(k) = c_K8 * Kh_zm(k) - - enddo - - ! Declare the number of subdiagonals and superdiagonals in the LHS matrix. - if ( l_hyper_dfsn ) then - ! There are nine overall diagonals (including four subdiagonals - ! and four superdiagonals). - nsub = 4 - nsup = 4 - else - ! There are five overall diagonals (including two subdiagonals - ! and two superdiagonals). - nsub = 2 - nsup = 2 - endif - - ! Solve semi-implicitly - call wp23_solve( dt, sfc_elevation, sigma_sqd_w, wm_zm, wm_zt, & ! Intent(in) - a3, a3_zt, wp3_on_wp2, & ! Intent(in) - wpthvp, wp2thvp, um, vm, upwp, vpwp, & ! Intent(in) - up2, vp2, Kw1, Kw8, Kh_zt, Skw_zt, tau_zm, tauw3t, & ! Intent(in) - C1_Skw_fnc, C11_Skw_fnc, rho_ds_zm, rho_ds_zt, & ! Intent(in) - invrs_rho_ds_zm, invrs_rho_ds_zt, radf, thv_ds_zm, & ! Intent(in) - thv_ds_zt, nsub, nsup, & ! Intent(in) - wp2, wp3, wp3_zm, wp2_zt, wp2_wp3_err_code ) ! Intent(inout) - -! Error output -! Joshua Fasching Feb 2008 - if ( fatal_error( wp2_wp3_err_code ) ) then - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) "Errors in advance_wp2_wp3" - - write(fstderr,*) "Intent(in)" - - write(fstderr,*) "dt = ", dt - write(fstderr,*) "sfc_elevation = ", sfc_elevation - write(fstderr,*) "sigma_sqd_w = ", sigma_sqd_w - write(fstderr,*) "wm_zm = ", wm_zm - write(fstderr,*) "wm_zt = ", wm_zt - write(fstderr,*) "wpthvp = ", wpthvp - write(fstderr,*) "wp2thvp = ", wp2thvp - write(fstderr,*) "um = ", um - write(fstderr,*) "vm = ", vm - write(fstderr,*) "upwp = ", upwp - write(fstderr,*) "vpwp = ", vpwp - write(fstderr,*) "up2 = ", up2 - write(fstderr,*) "vp2 = ", vp2 - write(fstderr,*) "Kh_zm = ", Kh_zm - write(fstderr,*) "Kh_zt = ", Kh_zt - write(fstderr,*) "tau_zm = ", tau_zm - write(fstderr,*) "tau_zt = ", tau_zt - write(fstderr,*) "Skw_zm = ", Skw_zm - write(fstderr,*) "Skw_zt = ", Skw_zt - write(fstderr,*) "mixt_frac = ", mixt_frac - write(fstderr,*) "wp2zt = ", wp2_zt - - write(fstderr,*) "Intent(in/out)" - - write(fstderr,*) "wp2 = ", wp2 - write(fstderr,*) "wp3 = ", wp3 - - end if - - err_code = wp2_wp3_err_code - end if ! fatal error - - return - - end subroutine advance_wp2_wp3 - - !============================================================================= - subroutine wp23_solve( dt, sfc_elevation, sigma_sqd_w, wm_zm, wm_zt, & - a3, a3_zt, wp3_on_wp2, & - wpthvp, wp2thvp, um, vm, upwp, vpwp, & - up2, vp2, Kw1, Kw8, Kh_zt, Skw_zt, tau1m, tauw3t, & - C1_Skw_fnc, C11_Skw_fnc, rho_ds_zm, rho_ds_zt, & - invrs_rho_ds_zm, invrs_rho_ds_zt, radf, thv_ds_zm, & - thv_ds_zt, nsub, nsup, & - wp2, wp3, wp3_zm, wp2_zt, err_code ) - - ! Description: - ! Decompose, and back substitute the matrix for wp2/wp3 - - ! References: - ! _Equations for CLUBB_ section 6.3 - !------------------------------------------------------------------------ - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_grid_class, only: & - zm2zt, & ! Function(s) - zt2zm, & - ddzt - - use crmx_constants_clubb, only: & - w_tol_sqd, & ! Variables(s) - eps, & - zero_threshold, & - fstderr - - use crmx_model_flags, only: & - l_tke_aniso, & ! Variable(s) - l_hyper_dfsn, & - l_hole_fill, & - l_gmres - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_lapack_wrap, only: & - band_solve, & ! Procedure(s) - band_solvex - - use crmx_fill_holes, only: & - fill_holes_driver - - use crmx_clip_explicit, only: & - clip_variance, & ! Procedure(s) - clip_skewness - - use crmx_stats_type, only: & - stat_begin_update, & ! Procedure(s) - stat_update_var_pt, & - stat_end_update, & - stat_end_update_pt - - use crmx_stats_variables, only: & - zm, & ! Variable(s) - zt, & - sfc, & - l_stats_samp, & - iwp2_ta, & - iwp2_ma, & - iwp2_pd, & - iwp2_ac, & - iwp2_dp1, & - iwp2_dp2, & - iwp2_pr1, & - iwp2_pr2, & - iwp2_4hd, & - iwp3_ta, & - iwp3_ma, & - iwp3_tp, & - iwp3_ac, & - iwp3_dp1, & - iwp3_pr1, & - iwp3_pr2, & - iwp3_4hd, & - iwp23_matrix_condt_num - - use crmx_stats_variables, only: & - zmscr01, & - zmscr02, & - zmscr03, & - zmscr04, & - zmscr05, & - zmscr06, & - zmscr07, & - zmscr08, & - zmscr09, & - zmscr10, & - zmscr11, & - zmscr12, & - zmscr13, & - zmscr14, & - zmscr15, & - zmscr16, & - zmscr17, & - ztscr01, & - ztscr02 - - use crmx_stats_variables, only: & - ztscr03, & - ztscr04, & - ztscr05, & - ztscr06, & - ztscr07, & - ztscr08, & - ztscr09, & - ztscr10, & - ztscr11, & - ztscr12, & - ztscr13, & - ztscr14, & - ztscr15, & - ztscr16, & - ztscr17, & - ztscr18, & - ztscr19, & - ztscr20, & - ztscr21 - - implicit none - - ! External - intrinsic :: max, min, sqrt - - ! Parameter Constants - integer, parameter :: & - nrhs = 1 ! Number of RHS vectors - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Timestep [s] - - real( kind = core_rknd ), intent(in) :: & - sfc_elevation ! Elevation of ground level [m AMSL] - - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - sigma_sqd_w, & ! sigma_sqd_w (momentum levels) [-] - wm_zm, & ! w wind component on momentum levels [m/s] - wm_zt, & ! w wind component on thermodynamic levels [m/s] - a3, & ! a_3 (momentum levels); See eqn. 25 in `Equations for CLUBB' [-] - a3_zt, & ! a_3 interpolated to thermodynamic levels [-] - wp3_on_wp2, & ! Smoothed version of wp3 / wp2 [m/s] - wpthvp, & ! w'th_v' (momentum levels) [K m/s] - wp2thvp, & ! w'^2th_v' (thermodynamic levels) [K m^2/s^2] - um, & ! u wind component (thermodynamic levels) [m/s] - vm, & ! v wind component (thermodynamic levels) [m/s] - upwp, & ! u'w' (momentum levels) [m^2/s^2] - vpwp, & ! v'w' (momentum levels) [m^2/s^2] - up2, & ! u'^2 (momentum levels) [m^2/s^2] - vp2, & ! v'^2 (momentum levels) [m^2/s^2] - Kw1, & ! Coefficient of eddy diffusivity for w'^2 [m^2/s] - Kw8, & ! Coefficient of eddy diffusivity for w'^3 [m^2/s] - Kh_zt, & ! Eddy diffusivity on thermodynamic levels [m^2/s] - Skw_zt, & ! Skewness of w on thermodynamic levels [-] - tau1m, & ! Time-scale tau on momentum levels [s] - tauw3t, & ! Time-scale tau on thermodynamic levels [s] - C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-] - C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] - invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] - radf, & ! Buoyancy production at CL top [m^2/s^3] - thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K] - thv_ds_zt ! Dry, base-state theta_v on thermo. levs. [K] - - integer, intent(in) :: & - nsub, & ! Number of subdiagonals in the LHS matrix. - nsup ! Number of superdiagonals in the LHS matrix. - - ! Input/Output Variables - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - wp2, & ! w'^2 (momentum levels) [m^2/s^2] - wp3, & ! w'^3 (thermodynamic levels) [m^3/s^3] - wp3_zm ! w'^3 interpolated to momentum levels [m^3/s^3] - - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - wp2_zt ! w'^2 interpolated to thermodyamic levels [m^2/s^2] - - integer, intent(inout) :: err_code ! Have any errors occured? - - ! Local Variables - real( kind = core_rknd ), dimension(nsup+nsub+1,2*gr%nz) :: & - lhs ! Implicit contributions to wp2/wp3 (band diag. matrix) - - real( kind = core_rknd ), dimension(2*gr%nz) :: & - rhs ! RHS of band matrix - -! real, target, dimension(2*gr%nz) :: - real( kind = core_rknd ), dimension(2*gr%nz) :: & - solut ! Solution to band diagonal system. - - real( kind = core_rknd ), dimension(gr%nz) :: & - a1, & ! a_1 (momentum levels); See eqn. 23 in `Equations for CLUBB' [-] - a1_zt ! a_1 interpolated to thermodynamic levels [-] - -! real, dimension(gr%nz) :: & -! wp2_n ! w'^2 at the previous timestep [m^2/s^2] - - real( kind = core_rknd ) :: & - rcond ! Est. of the reciprocal of the condition # - - ! Array indices - integer :: k, km1, km2, kp1, kp2, k_wp2, k_wp3 - - ! Set logical to true for Crank-Nicholson diffusion scheme - ! or to false for completely implicit diffusion scheme. - ! Note: Although Crank-Nicholson diffusion has usually been used for wp2 - ! and wp3 in the past, we found that using completely implicit - ! diffusion stabilized the deep convective cases more while having - ! almost no effect on the boundary layer cases. Brian; 1/4/2008. -! logical, parameter :: l_crank_nich_diff = .true. - logical, parameter :: l_crank_nich_diff = .false. - - ! Define a_1 and a_3 (both are located on momentum levels). - ! They are variables that are both functions of sigma_sqd_w (where - ! sigma_sqd_w is located on momentum levels). - - a1 = 1.0_core_rknd / ( 1.0_core_rknd - sigma_sqd_w ) - - ! Interpolate a_1 from momentum levels to thermodynamic - ! levels. This will be used for the w'^3 turbulent advection - ! (ta) and turbulent production (tp) combined term. - a1_zt = max( zm2zt( a1 ), zero_threshold ) ! Positive definite quantity - - ! Compute the explicit portion of the w'^2 and w'^3 equations. - ! Build the right-hand side vector. - call wp23_rhs( dt, wp2, wp3, a1, a1_zt, & - a3, a3_zt, wp3_on_wp2, wpthvp, wp2thvp, um, vm, & - upwp, vpwp, up2, vp2, Kw1, Kw8, Kh_zt, & - Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & - C11_Skw_fnc, rho_ds_zm, invrs_rho_ds_zt, radf, & - thv_ds_zm, thv_ds_zt, l_crank_nich_diff, & - rhs ) - - if (l_gmres) then - call wp23_gmres( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & - wp3_on_wp2, & - Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & - C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, l_crank_nich_diff, nsup, nsub, nrhs, & - rhs, & - solut, err_code ) - else - ! Compute the implicit portion of the w'^2 and w'^3 equations. - ! Build the left-hand side matrix. - call wp23_lhs( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & - wp3_on_wp2, & - Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & - C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, l_crank_nich_diff, nsub, nsup, & - lhs ) - - ! Solve the system with LAPACK - if ( l_stats_samp .and. iwp23_matrix_condt_num > 0 ) then - - ! Perform LU decomp and solve system (LAPACK with diagnostics) - ! Note that this can change the answer slightly - call band_solvex( "wp2_wp3", nsup, nsub, 2*gr%nz, nrhs, & - lhs, rhs, solut, rcond, err_code ) - - ! Est. of the condition number of the w'^2/w^3 LHS matrix - call stat_update_var_pt( iwp23_matrix_condt_num, 1, 1.0_core_rknd / rcond, sfc ) - - else - ! Perform LU decomp and solve system (LAPACK) - call band_solve( "wp2_wp3", nsup, nsub, 2*gr%nz, nrhs, & - lhs, rhs, solut, err_code ) - end if - - end if ! l_gmres - - ! Copy result into output arrays and clip - - do k = 1, gr%nz - - km1 = max( k-1, 1 ) - kp1 = min( k+1, gr%nz ) - - k_wp3 = 2*k - 1 - k_wp2 = 2*k - - ! wp2_n(k) = wp2(k) ! For the positive definite scheme - - wp2(k) = solut(k_wp2) - wp3(k) = solut(k_wp3) - - end do - - if (l_stats_samp) then - - ! Finalize implicit contributions for wp2 - - do k = 2, gr%nz-1 - - km1 = max( k-1, 1 ) - km2 = max( k-2, 1 ) - kp1 = min( k+1, gr%nz ) - kp2 = min( k+2, gr%nz ) - - ! w'^2 term dp1 has both implicit and explicit components; - ! call stat_end_update_pt. - call stat_end_update_pt( iwp2_dp1, k, & - zmscr01(k) * wp2(k), zm ) - - ! w'^2 term dp2 has both implicit and explicit components (if the - ! Crank-Nicholson scheme is selected); call stat_end_update_pt. - ! If Crank-Nicholson diffusion is not selected, then w'^3 term dp1 is - ! completely implicit; call stat_update_var_pt. - if ( l_crank_nich_diff ) then - call stat_end_update_pt( iwp2_dp2, k, & - zmscr02(k) * wp2(km1) & - + zmscr03(k) * wp2(k) & - + zmscr04(k) * wp2(kp1), zm ) - else - call stat_update_var_pt( iwp2_dp2, k, & - zmscr02(k) * wp2(km1) & - + zmscr03(k) * wp2(k) & - + zmscr04(k) * wp2(kp1), zm ) - endif - - ! w'^2 term ta is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( iwp2_ta, k, & - zmscr05(k) * wp3(k) & - + zmscr06(k) * wp3(kp1), zm ) - - ! w'^2 term ma is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( iwp2_ma, k, & - zmscr07(k) * wp2(km1) & - + zmscr08(k) * wp2(k) & - + zmscr09(k) * wp2(kp1), zm ) - - ! w'^2 term ac is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( iwp2_ac, k, & - zmscr10(k) * wp2(k), zm ) - - ! w'^2 term pr1 has both implicit and explicit components; - ! call stat_end_update_pt. - if ( l_tke_aniso ) then - call stat_end_update_pt( iwp2_pr1, k, & - zmscr12(k) * wp2(k), zm ) - endif - - ! w'^2 term pr2 has both implicit and explicit components; - ! call stat_end_update_pt. - call stat_end_update_pt( iwp2_pr2, k, & - zmscr11(k) * wp2(k), zm ) - - ! w'^2 term 4hd is completely implicit; call stat_update_var_pt. - if ( l_hyper_dfsn ) then - call stat_update_var_pt( iwp2_4hd, k, & - zmscr13(k) * wp2(km2) & - + zmscr14(k) * wp2(km1) & - + zmscr15(k) * wp2(k) & - + zmscr16(k) * wp2(kp1) & - + zmscr17(k) * wp2(kp2), zm ) - endif - enddo - - ! Finalize implicit contributions for wp3 - - do k = 2, gr%nz-1, 1 - - km1 = max( k-1, 1 ) - km2 = max( k-2, 1 ) - kp1 = min( k+1, gr%nz ) - kp2 = min( k+2, gr%nz ) - - ! w'^3 term pr1 has both implicit and explicit components; - ! call stat_end_update_pt. - call stat_end_update_pt( iwp3_pr1, k, & - ztscr01(k) * wp3(k), zt ) - - ! w'^3 term dp1 has both implicit and explicit components (if the - ! Crank-Nicholson scheme is selected); call stat_end_update_pt. - ! If Crank-Nicholson diffusion is not selected, then w'^3 term dp1 is - ! completely implicit; call stat_update_var_pt. - if ( l_crank_nich_diff ) then - call stat_end_update_pt( iwp3_dp1, k, & - ztscr02(k) * wp3(km1) & - + ztscr03(k) * wp3(k) & - + ztscr04(k) * wp3(kp1), zt ) - else - call stat_update_var_pt( iwp3_dp1, k, & - ztscr02(k) * wp3(km1) & - + ztscr03(k) * wp3(k) & - + ztscr04(k) * wp3(kp1), zt ) - endif - - ! w'^3 term ta has both implicit and explicit components; - ! call stat_end_update_pt. - call stat_end_update_pt( iwp3_ta, k, & - ztscr05(k) * wp3(km1) & - + ztscr06(k) * wp2(km1) & - + ztscr07(k) * wp3(k) & - + ztscr08(k) * wp2(k) & - + ztscr09(k) * wp3(kp1), zt ) - - ! w'^3 term tp has both implicit and explicit components; - ! call stat_end_update_pt. - call stat_end_update_pt( iwp3_tp, k, & - ztscr10(k) * wp2(km1) & - + ztscr11(k) * wp2(k), zt ) - - ! w'^3 term ma is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( iwp3_ma, k, & - ztscr12(k) * wp3(km1) & - + ztscr13(k) * wp3(k) & - + ztscr14(k) * wp3(kp1), zt ) - - ! w'^3 term ac is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( iwp3_ac, k, & - ztscr15(k) * wp3(k), zt ) - - ! w'^3 term pr2 has both implicit and explicit components; - ! call stat_end_update_pt. - call stat_end_update_pt( iwp3_pr2, k, & - ztscr16(k) * wp3(k), zt ) - - ! w'^3 term 4hd is completely implicit; call stat_update_var_pt. - if ( l_hyper_dfsn ) then - call stat_update_var_pt( iwp3_4hd, k, & - ztscr17(k) * wp3(km2) & - + ztscr18(k) * wp3(km1) & - + ztscr19(k) * wp3(k) & - + ztscr20(k) * wp3(kp1) & - + ztscr21(k) * wp3(kp2), zt ) - endif - enddo - - endif ! l_stats_samp - - - if ( l_stats_samp ) then - ! Store previous value for effect of the positive definite scheme - call stat_begin_update( iwp2_pd, wp2 / real( dt, kind = core_rknd ), zm ) - endif - - if ( l_hole_fill .and. any( wp2 < w_tol_sqd ) ) then - - ! Use a simple hole filling algorithm - call fill_holes_driver( 2, w_tol_sqd, "zm", & - rho_ds_zt, rho_ds_zm, & - wp2 ) - - endif ! wp2 - - ! Here we attempt to clip extreme values of wp2 to prevent a crash of the - ! type found on the Climate Process Team ticket #49. Chris Golaz found that - ! instability caused by large wp2 in CLUBB led unrealistic results in AM3. - ! -dschanen 11 Apr 2011 - where ( wp2 > 1000._core_rknd ) wp2 = 1000._core_rknd - - if ( l_stats_samp ) then - ! Store updated value for effect of the positive definite scheme - call stat_end_update( iwp2_pd, wp2 / real( dt, kind = core_rknd ), zm ) - endif - - - ! Clip w'^2 at a minimum threshold. - call clip_variance( clip_wp2, dt, w_tol_sqd, wp2 ) - - ! Interpolate w'^2 from momentum levels to thermodynamic levels. - ! This is used for the clipping of w'^3 according to the value - ! of Sk_w now that w'^2 and w'^3 have been advanced one timestep. - wp2_zt = max( zm2zt( wp2 ), w_tol_sqd ) ! Positive definite quantity - - ! Clip w'^3 by limiting skewness. - call clip_skewness( dt, sfc_elevation, wp2_zt, wp3 ) - - ! Compute wp3_zm for output purposes - wp3_zm = zt2zm( wp3 ) - - return - end subroutine wp23_solve - - subroutine wp23_gmres( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & - wp3_on_wp2, & - Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & - C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, l_crank_nich_diff, nsup, nsub, nrhs, & - rhs, & - solut, err_code ) - ! Description: - ! Perform all GMRES-specific matrix generation and solving for the - ! wp2/wp3 matrices. - ! - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - -#ifdef MKL - use crmx_error_code, only: & - fatal_error ! Procedure(s) - - use crmx_stats_variables, only: & - iwp23_matrix_condt_num, & ! Variable(s) - l_stats_samp, & - sfc - - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - use crmx_lapack_wrap, only: & - band_solve, & ! Procedure(s) - band_solvex - - use crmx_stats_type, only: & - stat_update_var_pt ! Procedure(s) - - use crmx_csr_matrix_class, only: & - csr_intlc_5b_5b_ia, & ! Variables - csr_intlc_5b_5b_ja, & - intlc_5d_5d_ja_size - - use crmx_gmres_wrap, only: & - gmres_solve ! Subroutine - - use crmx_gmres_cache, only: & - gmres_cache_soln, & ! Subroutine - gmres_prev_soln, & ! Variables - gmres_prev_precond_a, & - l_gmres_soln_ok, & - gmres_idx_wp2wp3, & - gmres_temp_intlc, & - gmres_tempsize_intlc -#endif /* MKL */ - - implicit none - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Timestep [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - wp2 ! w'^2 (momentum levels) [m^2/s^2] - - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - wm_zm, & ! w wind component on momentum levels [m/s] - wm_zt, & ! w wind component on thermodynamic levels [m/s] - a1, & ! a_1 (momentum levels); See eqn. 23 in `Equations for CLUBB' [-] - a1_zt, & ! a_1 interpolated to thermodynamic levels [-] - a3, & ! a_3 (momentum levels); See eqn. 25 in `Equations for CLUBB' [-] - a3_zt, & ! a_3 interpolated to thermodynamic levels [-] - wp3_on_wp2, & ! Smoothed version of wp3 / wp2 [m/s] - Kw1, & ! Coefficient of eddy diffusivity for w'^2 [m^2/s] - Kw8, & ! Coefficient of eddy diffusivity for w'^3 [m^2/s] - Skw_zt, & ! Skewness of w on thermodynamic levels [-] - tau1m, & ! Time-scale tau on momentum levels [s] - tauw3t, & ! Time-scale tau on thermodynamic levels [s] - C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-] - C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] - invrs_rho_ds_zt ! Inv. dry, static density @ thermo. levs. [m^3/kg] - - logical, intent(in) :: & - l_crank_nich_diff ! Turns on/off Crank-Nicholson diffusion. - - integer, intent(in) :: & - nsub, & ! Number of subdiagonals in the LHS matrix. - nsup, & ! Number of superdiagonals in the LHS matrix. - nrhs ! Number of right-hand side vectors - ! (GMRES currently only supports 1) - - ! Input/Output variables - real( kind = core_rknd ), dimension(2*gr%nz), intent(inout) :: & - rhs ! Right hand side vector - - ! Output variables - real( kind = core_rknd ), dimension(2*gr%nz), intent(out) :: & - solut ! Solution to band diagonal system - - integer, intent(out) :: err_code ! Have any errors occured? - -#ifdef MKL - ! Local variables - real( kind = core_rknd ), dimension(nsup+nsub+1,2*gr%nz) :: & - lhs, & ! Implicit contributions to wp2/wp3 (band diag. matrix) - lhs_cache ! Backup cache of LHS matrix - - real( kind = core_rknd ), dimension(intlc_5d_5d_ja_size) :: & - lhs_a_csr ! Implicit contributions to wp2/wp3 (CSR format) - - real( kind = core_rknd ), dimension(2*gr%nz) :: & - rhs_cache ! Backup cache of RHS vector - - real( kind = core_rknd ):: & - rcond ! Est. of the reciprocal of the condition # - - ! Begin code - - if (nsup > 2) then - write (fstderr, *) "WARNING: CSR-format solvers currently do not", & - "support solving with hyper diffusion", & - "at this time. l_hyper_dfsn ignored." - end if - call wp23_lhs_csr( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & - wp3_on_wp2, & - Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & - C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, l_crank_nich_diff, & - lhs_a_csr ) - - if ( .not. l_gmres_soln_ok(gmres_idx_wp2wp3) ) then - call wp23_lhs( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & - wp3_on_wp2, & - Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & - C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, l_crank_nich_diff, nsub, nsup, & - lhs ) - - ! Solve system with LAPACK to give us our first solution vector - lhs_cache = lhs - rhs_cache = rhs - call band_solve( "wp2_wp3", nsup, nsub, 2*gr%nz, nrhs, & - lhs, rhs, solut, err_code ) - - ! Use gmres_cache_wp2wp3_soln to set cache this solution for GMRES - call gmres_cache_soln( gr%nz * 2, gmres_idx_wp2wp3, solut ) - lhs = lhs_cache - rhs = rhs_cache - end if ! .not. l_gmres_soln_ok(gmres_idx_wp2wp3) - - call gmres_solve( intlc_5d_5d_ja_size, (gr%nz * 2), & - lhs_a_csr, csr_intlc_5b_5b_ia, csr_intlc_5b_5b_ja, & - gmres_tempsize_intlc, & - gmres_prev_soln(:,gmres_idx_wp2wp3), & - gmres_prev_precond_a(:,gmres_idx_wp2wp3), rhs, & - gmres_temp_intlc, & - solut, err_code ) - ! Fall back to LAPACK if GMRES returned any errors - if ( fatal_error( err_code ) ) then - write(fstderr,*) "Errors encountered in GMRES solve." - write(fstderr,*) "Falling back to LAPACK solver." - - ! Generate the LHS in LAPACK format - call wp23_lhs( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & - wp3_on_wp2, & - Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & - C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, l_crank_nich_diff, nsub, nsup, & - lhs ) - - ! Note: The RHS does not need to be re-generated. - - ! Solve the system with LAPACK as a fall-back. - if ( l_stats_samp .and. iwp23_matrix_condt_num > 0 ) then - - ! Perform LU decomp and solve system (LAPACK with diagnostics) - ! Note that this can change the answer slightly - call band_solvex( "wp2_wp3", nsup, nsub, 2*gr%nz, nrhs, & - lhs, rhs, solut, rcond, err_code ) - - ! Est. of the condition number of the w'^2/w^3 LHS matrix - call stat_update_var_pt( iwp23_matrix_condt_num, 1, 1.0_core_rknd / rcond, sfc ) - - else - ! Perform LU decomp and solve system (LAPACK) - call band_solve( "wp2_wp3", nsup, nsub, 2*gr%nz, nrhs, & - lhs, rhs, solut, err_code ) - end if - - end if ! fatal_error - -#else - stop "This build was not compiled with PARDISO/GMRES support." - - ! These prevent compiler warnings when -DMKL not set. - if ( l_crank_nich_diff .or. .true. ) print *, "This should be unreachable" - solut = rhs - solut(1:gr%nz) = a1 - solut(1:gr%nz) = a1_zt - solut(1:gr%nz) = a3 - solut(1:gr%nz) = a3_zt - solut(1:gr%nz) = C11_Skw_fnc - solut(1:gr%nz) = C1_Skw_fnc - solut(1:gr%nz) = invrs_rho_ds_zm - solut(1:gr%nz) = invrs_rho_ds_zt - solut(1:gr%nz) = rho_ds_zm - solut(1:gr%nz) = rho_ds_zt - solut(1:gr%nz) = Kw1 - solut(1:gr%nz) = Kw8 - solut(1:gr%nz) = Skw_zt - solut(1:gr%nz) = tau1m - solut(1:gr%nz) = tauw3t - solut(1:gr%nz) = wm_zt - solut(1:gr%nz) = wm_zm - solut(1:gr%nz) = wp2 - solut(1:gr%nz) = wp3_on_wp2 - err_code = int( dt ) - err_code = nsup - err_code = nsub - err_code = nrhs - -#endif /* MKL */ - - end subroutine wp23_gmres - - !============================================================================= - subroutine wp23_lhs( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & - wp3_on_wp2, & - Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & - C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, l_crank_nich_diff, nsub, nsup, & - lhs ) - - ! Description: - ! Compute LHS band diagonal matrix for w'^2 and w'^3. - ! This subroutine computes the implicit portion - ! of the w'^2 and w'^3 equations. - ! - ! NOTE: If changes are made to this subroutine, ensure that the CSR - ! version of the subroutine is updated as well! If the two are different, - ! the results will be inconsistent between LAPACK and PARDISO/GMRES! - - ! References: - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable - - use crmx_parameters_tunable, only: & - C4, & ! Variables - C5, & - C8, & - C8b, & - C12, & - nu1_vert_res_dep, & - nu8_vert_res_dep, & - nu_hd_vert_res_dep - - use crmx_constants_clubb, only: & - eps, & ! Variable(s) - three_halves, & - gamma_over_implicit_ts - - use crmx_model_flags, only: & - l_tke_aniso, & ! Variable(s) - l_hyper_dfsn - - use crmx_diffusion, only: & - diffusion_zm_lhs, & ! Procedures - diffusion_zt_lhs - - use crmx_mean_adv, only: & - term_ma_zm_lhs, & ! Procedures - term_ma_zt_lhs - - use crmx_hyper_diffusion_4th_ord, only: & - hyper_dfsn_4th_ord_zm_lhs, & - hyper_dfsn_4th_ord_zt_lhs - - use crmx_clubb_precision, only: & - time_precision, & - core_rknd - - use crmx_stats_variables, only: & - zmscr01, & - zmscr02, & - zmscr03, & - zmscr04, & - zmscr05, & - zmscr06, & - zmscr07, & - zmscr08, & - zmscr09, & - zmscr11, & - zmscr10, & - zmscr12, & - zmscr13, & - zmscr14, & - zmscr15, & - zmscr16, & - zmscr17, & - ztscr01, & - ztscr02 - - use crmx_stats_variables, only: & - ztscr03, & - ztscr04, & - ztscr05, & - ztscr06, & - ztscr07, & - ztscr08, & - ztscr09, & - ztscr10, & - ztscr11, & - ztscr12, & - ztscr13, & - ztscr14, & - ztscr15, & - ztscr16, & - ztscr17, & - ztscr18, & - ztscr19, & - ztscr20, & - ztscr21 - - use crmx_stats_variables, only: & - l_stats_samp, & - iwp2_dp1, & - iwp2_dp2, & - iwp2_ta, & - iwp2_ma, & - iwp2_ac, & - iwp2_pr2, & - iwp2_pr1, & - iwp2_4hd, & - iwp3_ta, & - iwp3_tp, & - iwp3_ma, & - iwp3_ac, & - iwp3_pr2, & - iwp3_pr1, & - iwp3_dp1, & - iwp3_4hd - - use crmx_advance_helper_module, only: set_boundary_conditions_lhs ! Procedure(s) - - implicit none - - ! Parameter Constants - ! Left-hand side matrix diagonal identifiers for - ! momentum-level variable, w'^2. - integer, parameter :: & - m_kp2_mdiag = 1, & ! Momentum super-super diagonal index for w'^2. - !m_kp2_tdiag = 2, & ! Thermodynamic super-super diagonal index for w'^2. - m_kp1_mdiag = 3, & ! Momentum super diagonal index for w'^2. - m_kp1_tdiag = 4, & ! Thermodynamic super diagonal index for w'^2. - m_k_mdiag = 5, & ! Momentum main diagonal index for w'^2. - m_k_tdiag = 6, & ! Thermodynamic sub diagonal index for w'^2. - m_km1_mdiag = 7, & ! Momentum sub diagonal index for w'^2. - !m_km1_tdiag = 8, & ! Thermodynamic sub-sub diagonal index for w'^2. - m_km2_mdiag = 9 ! Momentum sub-sub diagonal index for w'^2. - - ! Left-hand side matrix diagonal identifiers for - ! thermodynamic-level variable, w'^3. - integer, parameter :: & - t_kp2_tdiag = 1, & ! Thermodynamic super-super diagonal index for w'^3. - !t_kp1_mdiag = 2, & ! Momentum super-super diagonal index for w'^3. - t_kp1_tdiag = 3, & ! Thermodynamic super diagonal index for w'^3. - !t_k_mdiag = 4, & ! Momentum super diagonal index for w'^3. - t_k_tdiag = 5, & ! Thermodynamic main diagonal index for w'^3. - !t_km1_mdiag = 6, & ! Momentum sub diagonal index for w'^3. - t_km1_tdiag = 7, & ! Thermodynamic sub diagonal index for w'^3. - !t_km2_mdiag = 8, & ! Momentum sub-sub diagonal index for w'^3. - t_km2_tdiag = 9 ! Thermodynamic sub-sub diagonal index for w'^3. - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Timestep length [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - wp2, & ! w'^2 (momentum levels) [m^2/s^2] - wm_zm, & ! w wind component on momentum levels [m/s] - wm_zt, & ! w wind component on thermodynamic levels [m/s] - a1, & ! sigma_sqd_w term a_1 (momentum levels) [-] - a1_zt, & ! a_1 interpolated to thermodynamic levels [-] - a3, & ! sigma_sqd_w term a_3 (momentum levels) [-] - a3_zt, & ! a_3 interpolated to thermodynamic levels [-] - wp3_on_wp2, & ! Smoothed version of wp3 / wp2 [m/s] - Kw1, & ! Coefficient of eddy diffusivity for w'^2 [m^2/s] - Kw8, & ! Coefficient of eddy diffusivity for w'^3 [m^2/s] - Skw_zt, & ! Skewness of w on thermodynamic levels [-] - tau1m, & ! Time-scale tau on momentum levels [s] - tauw3t, & ! Time-scale tau on thermodynamic levels [s] - C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-] - C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] - invrs_rho_ds_zt ! Inv. dry, static density @ thermo. levs. [m^3/kg] - - logical, intent(in) :: & - l_crank_nich_diff ! Turns on/off Crank-Nicholson diffusion. - - integer, intent(in) :: & - nsub, & ! Number of subdiagonals in the LHS matrix. - nsup ! Number of superdiagonals in the LHS matrix. - - ! Output Variable - real( kind = core_rknd ), dimension(5-nsup:5+nsub,2*gr%nz), intent(out) :: & - lhs ! Implicit contributions to wp2/wp3 (band diag. matrix) - - ! Local Variables - - ! Array indices - integer :: k, km1, km2, kp1, kp2, k_wp2, k_wp3, k_wp2_low, k_wp2_high, & - k_wp3_low, k_wp3_high - - real( kind = core_rknd ), dimension(5) :: tmp - - - ! Initialize the left-hand side matrix to 0. - lhs = 0.0_core_rknd - - do k = 2, gr%nz-1, 1 - - ! Define indices - - km1 = max( k-1, 1 ) - km2 = max( k-2, 1 ) - kp1 = min( k+1, gr%nz ) - kp2 = min( k+2, gr%nz ) - - k_wp3 = 2*k - 1 - k_wp2 = 2*k - - - !!!!!***** w'^2 *****!!!!! - - ! w'^2: Left-hand side (implicit w'^2 portion of the code). - ! - ! Momentum sub-sub diagonal (lhs index: m_km2_mdiag) - ! [ x wp2(k-2,) ] - ! Thermodynamic sub-sub diagonal (lhs index: m_km1_tdiag) - ! [ x wp3(k-1,) ] - ! Momentum sub diagonal (lhs index: m_km1_mdiag) - ! [ x wp2(k-1,) ] - ! Thermodynamic sub diagonal (lhs index: m_k_tdiag) - ! [ x wp3(k,) ] - ! Momentum main diagonal (lhs index: m_k_mdiag) - ! [ x wp2(k,) ] - ! Thermodynamic super diagonal (lhs index: m_kp1_tdiag) - ! [ x wp3(k+1,) ] - ! Momentum super diagonal (lhs index: m_kp1_mdiag) - ! [ x wp2(k+1,) ] - ! Thermodynamic super-super diagonal (lhs index: m_kp2_tdiag) - ! [ x wp3(k+2,) ] - ! Momentum super-super diagonal (lhs index: m_kp2_mdiag) - ! [ x wp2(k+2,) ] - - ! LHS time tendency. - lhs(m_k_mdiag,k_wp2) & - = + 1.0_core_rknd / real( dt, kind = core_rknd ) - - ! LHS mean advection (ma) term. - lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wp2) & - = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wp2) & - + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) - - ! LHS turbulent advection (ta) term. - lhs((/m_kp1_tdiag,m_k_tdiag/),k_wp2) & - = lhs((/m_kp1_tdiag,m_k_tdiag/),k_wp2) & - + wp2_term_ta_lhs( rho_ds_zt(kp1), rho_ds_zt(k), & - invrs_rho_ds_zm(k), gr%invrs_dzm(k) ) - - ! LHS accumulation (ac) term and pressure term 2 (pr2). - lhs(m_k_mdiag,k_wp2) & - = lhs(m_k_mdiag,k_wp2) & - + wp2_terms_ac_pr2_lhs( C5, wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) - - ! LHS dissipation term 1 (dp1). - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the term - ! more numerically stable (see note below for w'^3 LHS turbulent - ! advection (ta) and turbulent production (tp) terms). - lhs(m_k_mdiag,k_wp2) & - = lhs(m_k_mdiag,k_wp2) & - + gamma_over_implicit_ts & - * wp2_term_dp1_lhs( C1_Skw_fnc(k), tau1m(k) ) - - ! LHS eddy diffusion term: dissipation term 2 (dp2). - if ( l_crank_nich_diff ) then - ! Eddy diffusion for wp2 using a Crank-Nicholson time step. - lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wp2) & - = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wp2) & - + (1.0_core_rknd/2.0_core_rknd) & - * diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(k), k ) - else - ! Eddy diffusion for wp2 using a completely implicit time step. - lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wp2) & - = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wp2) & - + diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(k), k ) - endif - - ! LHS pressure term 1 (pr1). - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the term - ! more numerically stable (see note below for w'^3 LHS turbulent - ! advection (ta) and turbulent production (tp) terms). - if ( l_tke_aniso ) then - ! Add in this term if we're not assuming tke = 1.5 * wp2 - lhs(m_k_mdiag,k_wp2) & - = lhs(m_k_mdiag,k_wp2) & - + gamma_over_implicit_ts & - * wp2_term_pr1_lhs( C4, tau1m(k) ) - endif - - ! LHS 4th-order hyper-diffusion (4hd). - if ( l_hyper_dfsn ) then - ! Note: w'^2 uses fixed-point boundary conditions. - lhs( (/m_kp2_mdiag,m_kp1_mdiag,m_k_mdiag,m_km1_mdiag,m_km2_mdiag/), & - k_wp2 ) & - = lhs( (/m_kp2_mdiag,m_kp1_mdiag,m_k_mdiag,m_km1_mdiag,m_km2_mdiag/), & - k_wp2 ) & - + hyper_dfsn_4th_ord_zm_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzm(k), & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(kp1), gr%invrs_dzm(km1), & - gr%invrs_dzt(kp2), gr%invrs_dzt(km1), k ) - endif - - if ( l_stats_samp ) then - - ! Statistics: implicit contributions for wp2. - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note below for w'^3 LHS - ! turbulent advection (ta) and turbulent production (tp) terms). - if ( iwp2_dp1 > 0 ) then - zmscr01(k) & - = - gamma_over_implicit_ts & - * wp2_term_dp1_lhs( C1_Skw_fnc(k), tau1m(k) ) - endif - - if ( iwp2_dp2 > 0 ) then - if ( l_crank_nich_diff ) then - ! Eddy diffusion for wp2 using a Crank-Nicholson time step. - tmp(1:3) & - = (1.0_core_rknd/2.0_core_rknd) & - * diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(k), k ) - else - ! Eddy diffusion for wp2 using a completely implicit time step. - tmp(1:3) & - = diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(k), k ) - endif - - zmscr02(k) = -tmp(3) - zmscr03(k) = -tmp(2) - zmscr04(k) = -tmp(1) - - endif - - if ( iwp2_ta > 0 ) then - tmp(1:2) = & - + wp2_term_ta_lhs( rho_ds_zt(kp1), rho_ds_zt(k), & - invrs_rho_ds_zm(k), gr%invrs_dzm(k) ) - zmscr05(k) = -tmp(2) - zmscr06(k) = -tmp(1) - endif - - if ( iwp2_ma > 0 ) then - tmp(1:3) = & - + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) - zmscr07(k) = -tmp(3) - zmscr08(k) = -tmp(2) - zmscr09(k) = -tmp(1) - endif - - ! Note: To find the contribution of w'^2 term ac, substitute 0 for the - ! C_5 input to function wp2_terms_ac_pr2_lhs. - if ( iwp2_ac > 0 ) then - zmscr10(k) = & - - wp2_terms_ac_pr2_lhs( 0.0_core_rknd, wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) - endif - - ! Note: To find the contribution of w'^2 term pr2, add 1 to the - ! C_5 input to function wp2_terms_ac_pr2_lhs. - if ( iwp2_pr2 > 0 ) then - zmscr11(k) = & - - wp2_terms_ac_pr2_lhs( (1.0_core_rknd+C5), wm_zt(kp1), wm_zt(k), & - gr%invrs_dzm(k) ) - endif - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note below for w'^3 LHS - ! turbulent advection (ta) and turbulent production (tp) terms). - if ( iwp2_pr1 > 0 .and. l_tke_aniso ) then - zmscr12(k) & - = - gamma_over_implicit_ts & - * wp2_term_pr1_lhs( C4, tau1m(k) ) - endif - - if ( iwp2_4hd > 0 .and. l_hyper_dfsn ) then - tmp(1:5) = & - hyper_dfsn_4th_ord_zm_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzm(k), & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(kp1), gr%invrs_dzm(km1), & - gr%invrs_dzt(kp2), gr%invrs_dzt(km1), k ) - zmscr13(k) = -tmp(5) - zmscr14(k) = -tmp(4) - zmscr15(k) = -tmp(3) - zmscr16(k) = -tmp(2) - zmscr17(k) = -tmp(1) - endif - - endif - - - - !!!!!***** w'^3 *****!!!!! - - ! w'^3: Left-hand side (implicit w'^3 portion of the code). - ! - ! Thermodynamic sub-sub diagonal (lhs index: t_km2_tdiag) - ! [ x wp3(k-2,) ] - ! Momentum sub-sub diagonal (lhs index: t_km2_mdiag) - ! [ x wp2(k-2,) ] - ! Thermodynamic sub diagonal (lhs index: t_km1_tdiag) - ! [ x wp3(k-1,) ] - ! Momentum sub diagonal (lhs index: t_km1_mdiag) - ! [ x wp2(k-1,) ] - ! Thermodynamic main diagonal (lhs index: t_k_tdiag) - ! [ x wp3(k,) ] - ! Momentum super diagonal (lhs index: t_k_mdiag) - ! [ x wp2(k,) ] - ! Thermodynamic super diagonal (lhs index: t_kp1_tdiag) - ! [ x wp3(k+1,) ] - ! Momentum super-super diagonal (lhs index: t_kp1_mdiag) - ! [ x wp2(k+1,) ] - ! Thermodynamic super-super diagonal (lhs index: t_kp2_tdiag) - ! [ x wp3(k+2,) ] - - ! LHS time tendency. - lhs(t_k_tdiag,k_wp3) & - = + 1.0_core_rknd / real( dt, kind = core_rknd ) - - ! LHS mean advection (ma) term. - lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_wp3) & - = lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_wp3) & - + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(k-1) ) - - ! LHS turbulent advection (ta) and turbulent production (tp) terms. - ! Note: An "over-implicit" weighted time step is applied to these terms. - ! The weight of the implicit portion of these terms is controlled - ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the - ! expression below). A factor is added to the right-hand side of - ! the equation in order to balance a weight that is not equal to 1, - ! such that: - ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; - ! where X is the variable that is being solved for in a predictive - ! equation (w'^3 in this case), y(t) is the linearized portion of - ! the terms that gets treated implicitly, and RHS is the portion of - ! the terms that is always treated explicitly. A weight of greater - ! than 1 can be applied to make the terms more numerically stable. - lhs(t_kp1_tdiag:t_km1_tdiag,k_wp3) & - = lhs(t_kp1_tdiag:t_km1_tdiag,k_wp3) & - + gamma_over_implicit_ts & - * wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & - a1(k), a1_zt(k), a1(km1), & - a3(k), a3_zt(k), a3(km1), & - wp3_on_wp2(k), wp3_on_wp2(km1), & - rho_ds_zm(k), rho_ds_zm(km1), & - invrs_rho_ds_zt(k), & - three_halves, & - gr%invrs_dzt(k), k ) - - ! LHS accumulation (ac) term and pressure term 2 (pr2). - lhs(t_k_tdiag,k_wp3) & - = lhs(t_k_tdiag,k_wp3) & - + wp3_terms_ac_pr2_lhs( C11_Skw_fnc(k), & - wm_zm(k), wm_zm(km1), gr%invrs_dzt(k) ) - - ! LHS pressure term 1 (pr1). - ! Note: An "over-implicit" weighted time step is applied to this term. - lhs(t_k_tdiag,k_wp3) & - = lhs(t_k_tdiag,k_wp3) & - + gamma_over_implicit_ts & - * wp3_term_pr1_lhs( C8, C8b, tauw3t(k), Skw_zt(k) ) - - ! LHS eddy diffusion term: dissipation term 1 (dp1). - ! Added a new constant, C12. - ! Initially, this new constant will be set to 1.0 -dschanen 9/19/05 - if ( l_crank_nich_diff ) then - ! Eddy diffusion for wp3 using a Crank-Nicholson time step. - lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_wp3) & - = lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_wp3) & - + C12 * (1.0_core_rknd/2.0_core_rknd) & - * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & - gr%invrs_dzm(km1), gr%invrs_dzm(k), & - gr%invrs_dzt(k), k ) - else - ! Eddy diffusion for wp3 using a completely implicit time step. - lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_wp3) & - = lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_wp3) & - + C12 & - * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & - gr%invrs_dzm(km1), gr%invrs_dzm(k), & - gr%invrs_dzt(k), k ) - endif - - ! LHS 4th-order hyper-diffusion (4hd). - if ( l_hyper_dfsn ) then - ! Note: w'^3 uses fixed-point boundary conditions. - lhs( (/t_kp2_tdiag,t_kp1_tdiag,t_k_tdiag,t_km1_tdiag,t_km2_tdiag/), & - k_wp3 ) & - = lhs( (/t_kp2_tdiag,t_kp1_tdiag,t_k_tdiag,t_km1_tdiag,t_km2_tdiag/), & - k_wp3 ) & - + hyper_dfsn_4th_ord_zt_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzt(k), & - gr%invrs_dzm(k), gr%invrs_dzm(km1), & - gr%invrs_dzt(kp1), gr%invrs_dzt(km1), & - gr%invrs_dzm(kp1), gr%invrs_dzm(km2), k ) - endif - - if ( l_stats_samp ) then - - ! Statistics: implicit contributions for wp3. - - ! Note: To find the contribution of w'^3 term ta, add 3 to all of - ! the a_3 inputs and substitute 0 for the three_halves input to - ! function wp3_terms_ta_tp_lhs. - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for LHS turbulent - ! advection (ta) and turbulent production (tp) terms). - if ( iwp3_ta > 0 ) then - tmp(1:5) & - = gamma_over_implicit_ts & - * wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & - a1(k), a1_zt(k), a1(km1), & - a3(k)+3.0_core_rknd, a3_zt(k)+3.0_core_rknd, & - a3(km1)+3.0_core_rknd, & - wp3_on_wp2(k), wp3_on_wp2(km1), & - rho_ds_zm(k), rho_ds_zm(km1), & - invrs_rho_ds_zt(k), & - 0.0_core_rknd, & - gr%invrs_dzt(k), k ) - ztscr05(k) = -tmp(5) - ztscr06(k) = -tmp(4) - ztscr07(k) = -tmp(3) - ztscr08(k) = -tmp(2) - ztscr09(k) = -tmp(1) - endif - - ! Note: To find the contribution of w'^3 term tp, substitute 0 for all - ! of the a_1 and a_3 inputs and subtract 3 from all of the a_3 - ! inputs to function wp3_terms_ta_tp_lhs. - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for LHS turbulent - ! advection (ta) and turbulent production (tp) terms). - if ( iwp3_tp > 0 ) then - tmp(1:5) & - = gamma_over_implicit_ts & - * wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & - 0.0_core_rknd, 0.0_core_rknd, 0.0_core_rknd, & - 0.0_core_rknd-3.0_core_rknd, 0.0_core_rknd-3.0_core_rknd, & - 0.0_core_rknd-3.0_core_rknd, & - 0.0_core_rknd, 0.0_core_rknd, & - rho_ds_zm(k), rho_ds_zm(km1), & - invrs_rho_ds_zt(k), & - three_halves, & - gr%invrs_dzt(k), k ) - ztscr10(k) = -tmp(4) - ztscr11(k) = -tmp(2) - endif - - if ( iwp3_ma > 0 ) then - tmp(1:3) = & - term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) - ztscr12(k) = -tmp(3) - ztscr13(k) = -tmp(2) - ztscr14(k) = -tmp(1) - endif - - ! Note: To find the contribution of w'^3 term ac, substitute 0 for the - ! C_ll skewness function input to function wp3_terms_ac_pr2_lhs. - if ( iwp3_ac > 0 ) then - ztscr15(k) = & - - wp3_terms_ac_pr2_lhs( 0.0_core_rknd, & - wm_zm(k), wm_zm(km1), gr%invrs_dzt(k) ) - endif - - ! Note: To find the contribution of w'^3 term pr2, add 1 to the - ! C_ll skewness function input to function wp3_terms_ac_pr2_lhs. - if ( iwp3_pr2 > 0 ) then - ztscr16(k) = & - - wp3_terms_ac_pr2_lhs( (1.0_core_rknd+C11_Skw_fnc(k)), & - wm_zm(k), wm_zm(km1), gr%invrs_dzt(k) ) - endif - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for LHS turbulent - ! advection (ta) and turbulent production (tp) terms). - if ( iwp3_pr1 > 0 ) then - ztscr01(k) & - = - gamma_over_implicit_ts & - * wp3_term_pr1_lhs( C8, C8b, tauw3t(k), Skw_zt(k) ) - endif - - if ( iwp3_dp1 > 0 ) then - if ( l_crank_nich_diff ) then - ! Eddy diffusion for wp3 using a Crank-Nicholson time step. - tmp(1:3) & - = C12 * (1.0_core_rknd/2.0_core_rknd) & - * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & - gr%invrs_dzm(km1), gr%invrs_dzm(k), & - gr%invrs_dzt(k), k ) - else - ! Eddy diffusion for wp3 using a completely implicit time step. - tmp(1:3) & - = C12 & - * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & - gr%invrs_dzm(km1), gr%invrs_dzm(k), & - gr%invrs_dzt(k), k ) - endif - - ztscr02(k) = -tmp(3) - ztscr03(k) = -tmp(2) - ztscr04(k) = -tmp(1) - - endif - - if ( iwp3_4hd > 0 .and. l_hyper_dfsn ) then - tmp(1:5) = & - hyper_dfsn_4th_ord_zt_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzt(k), & - gr%invrs_dzm(k), gr%invrs_dzm(km1), & - gr%invrs_dzt(kp1), gr%invrs_dzt(km1), & - gr%invrs_dzm(kp1), gr%invrs_dzm(km2), k ) - ztscr17(k) = -tmp(5) - ztscr18(k) = -tmp(4) - ztscr19(k) = -tmp(3) - ztscr20(k) = -tmp(2) - ztscr21(k) = -tmp(1) - endif - - endif - - enddo ! k = 2, gr%nz-1, 1 - - - ! Boundary conditions - - ! Both wp2 and wp3 used fixed-point boundary conditions. - ! Therefore, anything set in the above loop at both the upper - ! and lower boundaries would be overwritten here. However, the - ! above loop does not extend to the boundary levels. An array - ! with a value of 1 at the main diagonal on the left-hand side - ! and with values of 0 at all other diagonals on the left-hand - ! side will preserve the right-hand side value at that level. - ! - ! wp3(1) wp2(1) ... wp3(nzmax) wp2(nzmax) - ! [ 0.0 0.0 0.0 0.0 ] - ! [ 0.0 0.0 0.0 0.0 ] - ! [ 1.0 1.0 ... 1.0 1.0 ] - ! [ 0.0 0.0 0.0 0.0 ] - ! [ 0.0 0.0 0.0 0.0 ] - - ! Lower boundary - k = 1 - k_wp3_low = 2*k - 1 - k_wp2_low = 2*k - - ! Upper boundary - k = gr%nz - k_wp3_high = 2*k - 1 - k_wp2_high = 2*k - - ! t_k_tdiag and m_k_mdiag need to be adjusted because the dimensions of lhs - ! are offset - call set_boundary_conditions_lhs( t_k_tdiag - nsup, k_wp3_low, k_wp3_high, lhs, & - m_k_mdiag - nsup, k_wp2_low, k_wp2_high) - - return - - end subroutine wp23_lhs - -#ifdef MKL - !============================================================================= - subroutine wp23_lhs_csr( dt, wp2, wm_zm, wm_zt, a1, a1_zt, a3, a3_zt, & - wp3_on_wp2, & - Kw1, Kw8, Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & - C11_Skw_fnc, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, l_crank_nich_diff, & - lhs_a_csr ) - - ! Description: - ! Compute LHS band diagonal matrix for w'^2 and w'^3. - ! This subroutine computes the implicit portion - ! of the w'^2 and w'^3 equations. - ! - ! This version of the subroutine computes the LHS in CSR (compressed - ! sparse row) format. - ! NOTE: This subroutine must be kept up to date with the non CSR version - ! of the subroutine! If the two are different, the results will be - ! inconsistent between LAPACK and PARDISO/GMRES results! - - ! References: - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable - - use crmx_parameters_tunable, only: & - C4, & ! Variables - C5, & - C8, & - C8b, & - C12, & - nu1_vert_res_dep, & - nu8_vert_res_dep, & - nu_hd_vert_res_dep - - use crmx_constants_clubb, only: & - eps, & ! Variable(s) - three_halves, & - gamma_over_implicit_ts - - use crmx_model_flags, only: & - l_tke_aniso, & ! Variable(s) - l_hyper_dfsn - - use crmx_diffusion, only: & - diffusion_zm_lhs, & ! Procedures - diffusion_zt_lhs - - use crmx_mean_adv, only: & - term_ma_zm_lhs, & ! Procedures - term_ma_zt_lhs - - use crmx_hyper_diffusion_4th_ord, only: & - hyper_dfsn_4th_ord_zm_lhs, & - hyper_dfsn_4th_ord_zt_lhs - - use crmx_clubb_precision, only: & - time_precision, & - core_rknd - - use crmx_stats_variables, only: & - zmscr01, & - zmscr02, & - zmscr03, & - zmscr04, & - zmscr05, & - zmscr06, & - zmscr07, & - zmscr08, & - zmscr09, & - zmscr11, & - zmscr10, & - zmscr12, & - zmscr13, & - zmscr14, & - zmscr15, & - zmscr16, & - zmscr17, & - ztscr01, & - ztscr02 - - use crmx_stats_variables, only: & - ztscr03, & - ztscr04, & - ztscr05, & - ztscr06, & - ztscr07, & - ztscr08, & - ztscr09, & - ztscr10, & - ztscr11, & - ztscr12, & - ztscr13, & - ztscr14, & - ztscr15, & - ztscr16, & - ztscr17, & - ztscr18, & - ztscr19, & - ztscr20, & - ztscr21 - - use crmx_stats_variables, only: & - l_stats_samp, & - iwp2_dp1, & - iwp2_dp2, & - iwp2_ta, & - iwp2_ma, & - iwp2_ac, & - iwp2_pr2, & - iwp2_pr1, & - iwp2_4hd, & - iwp3_ta, & - iwp3_tp, & - iwp3_ma, & - iwp3_ac, & - iwp3_pr2, & - iwp3_pr1, & - iwp3_dp1, & - iwp3_4hd - - use crmx_csr_matrix_class, only: & - intlc_5d_5d_ja_size ! Variable - - implicit none - - ! Left-hand side matrix diagonal identifiers for - ! momentum-level variable, w'^2. - ! These are updated for each diagonal of the matrix as the - ! LHS of the matrix is created. - integer :: & - !m_kp2_mdiag, & ! Momentum super-super diagonal index for w'^2. - !m_kp2_tdiag, & ! Thermodynamic super-super diagonal index for w'^2. - m_kp1_mdiag, & ! Momentum super diagonal index for w'^2. - m_kp1_tdiag, & ! Thermodynamic super diagonal index for w'^2. - m_k_mdiag , & ! Momentum main diagonal index for w'^2. - m_k_tdiag , & ! Thermodynamic sub diagonal index for w'^2. - m_km1_mdiag ! Momentum sub diagonal index for w'^2. - !m_km1_tdiag, & ! Thermodynamic sub-sub diagonal index for w'^2. - !m_km2_mdiag ! Momentum sub-sub diagonal index for w'^2. - - ! Left-hand side matrix diagonal identifiers for - ! thermodynamic-level variable, w'^3. - ! These are updated for each diagonal of the matrix as the - ! LHS of the matrix is created - integer :: & - !t_kp2_tdiag, & ! Thermodynamic super-super diagonal index for w'^3. - !t_kp1_mdiag, & ! Momentum super-super diagonal index for w'^3. - t_kp1_tdiag, & ! Thermodynamic super diagonal index for w'^3. - !t_k_mdiag , & ! Momentum super diagonal index for w'^3. - t_k_tdiag , & ! Thermodynamic main diagonal index for w'^3. - !t_km1_mdiag, & ! Momentum sub diagonal index for w'^3. - t_km1_tdiag ! Thermodynamic sub diagonal index for w'^3. - !t_km2_mdiag, & ! Momentum sub-sub diagonal index for w'^3. - !t_km2_tdiag ! Thermodynamic sub-sub diagonal index for w'^3. - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Timestep length [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - wp2, & ! w'^2 (momentum levels) [m^2/s^2] - wm_zm, & ! w wind component on momentum levels [m/s] - wm_zt, & ! w wind component on thermodynamic levels [m/s] - a1, & ! sigma_sqd_w term a_1 (momentum levels) [-] - a1_zt, & ! a_1 interpolated to thermodynamic levels [-] - a3, & ! sigma_sqd_w term a_3 (momentum levels) [-] - a3_zt, & ! a_3 interpolated to thermodynamic levels [-] - wp3_on_wp2, & ! Smoothed version of wp3 / wp2 [m/s] - Kw1, & ! Coefficient of eddy diffusivity for w'^2 [m^2/s] - Kw8, & ! Coefficient of eddy diffusivity for w'^3 [m^2/s] - Skw_zt, & ! Skewness of w on thermodynamic levels [-] - tau1m, & ! Time-scale tau on momentum levels [s] - tauw3t, & ! Time-scale tau on thermodynamic levels [s] - C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-] - C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] - invrs_rho_ds_zt ! Inv. dry, static density @ thermo. levs. [m^3/kg] - - logical, intent(in) :: & - l_crank_nich_diff ! Turns on/off Crank-Nicholson diffusion. - -! integer, intent(in) :: & -! nsub, & ! Number of subdiagonals in the LHS matrix. -! nsup ! Number of superdiagonals in the LHS matrix. - - ! Output Variable - real( kind = core_rknd ), dimension(intlc_5d_5d_ja_size), intent(out) :: & - lhs_a_csr ! Implicit contributions to wp2/wp3 (band diag. matrix) - - ! Local Variables - - ! Array indices - integer :: k, km1, km2, kp1, kp2, k_wp2, k_wp3, wp2_cur_row, wp3_cur_row - - real( kind = core_rknd ), dimension(5) :: tmp - - - ! Initialize the left-hand side matrix to 0. - lhs_a_csr = 0.0_core_rknd - - do k = 2, gr%nz-1, 1 - - ! Define indices - - km1 = max( k-1, 1 ) - km2 = max( k-2, 1 ) - kp1 = min( k+1, gr%nz ) - kp2 = min( k+2, gr%nz ) - - k_wp3 = 2*k - 1 - k_wp2 = 2*k - - wp2_cur_row = ((k_wp2 - 3) * 5) + 8 - wp3_cur_row = ((k_wp3 - 3) * 5) + 8 - - !!!!!***** w'^2 *****!!!!! - - ! w'^2: Left-hand side (implicit w'^2 portion of the code). - ! - ! Momentum sub-sub diagonal (lhs index: m_km2_mdiag) - ! [ x wp2(k-2,) ] - ! Thermodynamic sub-sub diagonal (lhs index: m_km1_tdiag) - ! [ x wp3(k-1,) ] - ! Momentum sub diagonal (lhs index: m_km1_mdiag) - ! [ x wp2(k-1,) ] - ! Thermodynamic sub diagonal (lhs index: m_k_tdiag) - ! [ x wp3(k,) ] - ! Momentum main diagonal (lhs index: m_k_mdiag) - ! [ x wp2(k,) ] - ! Thermodynamic super diagonal (lhs index: m_kp1_tdiag) - ! [ x wp3(k+1,) ] - ! Momentum super diagonal (lhs index: m_kp1_mdiag) - ! [ x wp2(k+1,) ] - ! Thermodynamic super-super diagonal (lhs index: m_kp2_tdiag) - ! [ x wp3(k+2,) ] - ! Momentum super-super diagonal (lhs index: m_kp2_mdiag) - ! [ x wp2(k+2,) ] - - ! NOTES FOR CSR-FORMAT MATRICES - ! The various diagonals are referenced through the following - ! array indices: - ! (m_kp1_mdiag, k_wp2) ==> (wp2_cur_row + 4) - ! (m_kp1_tdiag, k_wp2) ==> (wp2_cur_row + 3) - ! (m_k_mdiag, k_wp2) ==> (wp2_cur_row + 2) - ! (m_k_tdiag, k_wp2) ==> (wp2_cur_row + 1) - ! (m_km1_mdiag, k_wp2) ==> (wp2_cur_row) - ! For readability, these values are updated here. - ! This means that to update the CSR version of the LHS subroutine, - ! all that must be done is remove the ,k_wp2 from the array indices, - ! as the CSR-format matrix is one-dimensional. - - ! NOTE: All references to lhs will need to be changed to lhs_a_csr - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! WARNING: If you have array indices that go from m_kp1_mdiag to - ! m_km1_mdiag, you will need to set it to span by -1. This is because - ! in the CSR-format arrays, the indices descend as you go from m_kp1_mdiag - ! to m_km1_mdiag! - ! - ! EXAMPLE: lhs((m_kp1_mdiag:m_km1_mdiag),wp2) would become - ! lhs_a_csr((m_kp1_mdiag:m_km1_mdiag:-1)) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - m_kp1_mdiag = wp2_cur_row + 4 - m_kp1_tdiag = wp2_cur_row + 3 - m_k_mdiag = wp2_cur_row + 2 - m_k_tdiag = wp2_cur_row + 1 - m_km1_mdiag = wp2_cur_row - - ! LHS time tendency. - lhs_a_csr(m_k_mdiag) & - = real( + 1.0_core_rknd / dt ) - - ! LHS mean advection (ma) term. - lhs_a_csr((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/)) & - = lhs_a_csr((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/)) & - + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) - - ! LHS turbulent advection (ta) term. - lhs_a_csr((/m_kp1_tdiag,m_k_tdiag/)) & - = lhs_a_csr((/m_kp1_tdiag,m_k_tdiag/)) & - + wp2_term_ta_lhs( rho_ds_zt(kp1), rho_ds_zt(k), & - invrs_rho_ds_zm(k), gr%invrs_dzm(k) ) - - ! LHS accumulation (ac) term and pressure term 2 (pr2). - lhs_a_csr(m_k_mdiag) & - = lhs_a_csr(m_k_mdiag) & - + wp2_terms_ac_pr2_lhs( C5, wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) - - ! LHS dissipation term 1 (dp1). - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the term - ! more numerically stable (see note below for w'^3 LHS turbulent - ! advection (ta) and turbulent production (tp) terms). - lhs_a_csr(m_k_mdiag) & - = lhs_a_csr(m_k_mdiag) & - + gamma_over_implicit_ts & - * wp2_term_dp1_lhs( C1_Skw_fnc(k), tau1m(k) ) - - ! LHS eddy diffusion term: dissipation term 2 (dp2). - if ( l_crank_nich_diff ) then - ! Eddy diffusion for wp2 using a Crank-Nicholson time step. - lhs_a_csr((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/)) & - = lhs_a_csr((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/)) & - + (1.0_core_rknd/2.0_core_rknd) & - * diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(k), k ) - else - ! Eddy diffusion for wp2 using a completely implicit time step. - lhs_a_csr((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/)) & - = lhs_a_csr((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/)) & - + diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(k), k ) - endif - - ! LHS pressure term 1 (pr1). - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the term - ! more numerically stable (see note below for w'^3 LHS turbulent - ! advection (ta) and turbulent production (tp) terms). - if ( l_tke_aniso ) then - ! Add in this term if we're not assuming tke = 1.5 * wp2 - lhs_a_csr(m_k_mdiag) & - = lhs_a_csr(m_k_mdiag) & - + gamma_over_implicit_ts & - * wp2_term_pr1_lhs( C4, tau1m(k) ) - endif - - ! LHS 4th-order hyper-diffusion (4hd). - ! NOTE: 4th-order hyper-diffusion is not yet supported in CSR-format. - ! As such, this needs to remain commented out. - !if ( l_hyper_dfsn ) then - ! ! Note: w'^2 uses fixed-point boundary conditions. - ! lhs( (/m_kp2_mdiag,m_kp1_mdiag,m_k_mdiag,m_km1_mdiag,m_km2_mdiag/), & - ! k_wp2) & - ! = lhs( (/m_kp2_mdiag,m_kp1_mdiag,m_k_mdiag,m_km1_mdiag,m_km2_mdiag/), & - ! k_wp2) & - ! + hyper_dfsn_4th_ord_zm_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzm(k), & - ! gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - ! gr%invrs_dzm(kp1), gr%invrs_dzm(km1), & - ! gr%invrs_dzt(kp2), gr%invrs_dzt(km1), k ) - !endif - - if ( l_stats_samp ) then - - ! Statistics: implicit contributions for wp2. - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note below for w'^3 LHS - ! turbulent advection (ta) and turbulent production (tp) terms). - if ( iwp2_dp1 > 0 ) then - zmscr01(k) & - = - gamma_over_implicit_ts & - * wp2_term_dp1_lhs( C1_Skw_fnc(k), tau1m(k) ) - endif - - if ( iwp2_dp2 > 0 ) then - if ( l_crank_nich_diff ) then - ! Eddy diffusion for wp2 using a Crank-Nicholson time step. - tmp(1:3) & - = (1.0_core_rknd/2.0_core_rknd) & - * diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(k), k ) - else - ! Eddy diffusion for wp2 using a completely implicit time step. - tmp(1:3) & - = diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(k), k ) - endif - - zmscr02(k) = -tmp(3) - zmscr03(k) = -tmp(2) - zmscr04(k) = -tmp(1) - - endif - - if ( iwp2_ta > 0 ) then - tmp(1:2) = & - + wp2_term_ta_lhs( rho_ds_zt(kp1), rho_ds_zt(k), & - invrs_rho_ds_zm(k), gr%invrs_dzm(k) ) - zmscr05(k) = -tmp(2) - zmscr06(k) = -tmp(1) - endif - - if ( iwp2_ma > 0 ) then - tmp(1:3) = & - + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) - zmscr07(k) = -tmp(3) - zmscr08(k) = -tmp(2) - zmscr09(k) = -tmp(1) - endif - - ! Note: To find the contribution of w'^2 term ac, substitute 0 for the - ! C_5 input to function wp2_terms_ac_pr2_lhs. - if ( iwp2_ac > 0 ) then - zmscr10(k) = & - - wp2_terms_ac_pr2_lhs( 0.0_core_rknd, wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) - endif - - ! Note: To find the contribution of w'^2 term pr2, add 1 to the - ! C_5 input to function wp2_terms_ac_pr2_lhs. - if ( iwp2_pr2 > 0 ) then - zmscr11(k) = & - - wp2_terms_ac_pr2_lhs( (1.0_core_rknd+C5), wm_zt(kp1), wm_zt(k), & - gr%invrs_dzm(k) ) - endif - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note below for w'^3 LHS - ! turbulent advection (ta) and turbulent production (tp) terms). - if ( iwp2_pr1 > 0 .and. l_tke_aniso ) then - zmscr12(k) & - = - gamma_over_implicit_ts & - * wp2_term_pr1_lhs( C4, tau1m(k) ) - endif - - if ( iwp2_4hd > 0 .and. l_hyper_dfsn ) then - tmp(1:5) = & - hyper_dfsn_4th_ord_zm_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzm(k), & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(kp1), gr%invrs_dzm(km1), & - gr%invrs_dzt(kp2), gr%invrs_dzt(km1), k ) - zmscr13(k) = -tmp(5) - zmscr14(k) = -tmp(4) - zmscr15(k) = -tmp(3) - zmscr16(k) = -tmp(2) - zmscr17(k) = -tmp(1) - endif - - endif - - - - !!!!!***** w'^3 *****!!!!! - - ! w'^3: Left-hand side (implicit w'^3 portion of the code). - ! - ! Thermodynamic sub-sub diagonal (lhs index: t_km2_tdiag) - ! [ x wp3(k-2,) ] - ! Momentum sub-sub diagonal (lhs index: t_km2_mdiag) - ! [ x wp2(k-2,) ] - ! Thermodynamic sub diagonal (lhs index: t_km1_tdiag) - ! [ x wp3(k-1,) ] - ! Momentum sub diagonal (lhs index: t_km1_mdiag) - ! [ x wp2(k-1,) ] - ! Thermodynamic main diagonal (lhs index: t_k_tdiag) - ! [ x wp3(k,) ] - ! Momentum super diagonal (lhs index: t_k_mdiag) - ! [ x wp2(k,) ] - ! Thermodynamic super diagonal (lhs index: t_kp1_tdiag) - ! [ x wp3(k+1,) ] - ! Momentum super-super diagonal (lhs index: t_kp1_mdiag) - ! [ x wp2(k+1,) ] - ! Thermodynamic super-super diagonal (lhs index: t_kp2_tdiag) - ! [ x wp3(k+2,) ] - - ! NOTES FOR CSR-FORMAT MATRICES - ! The various diagonals are referenced through the following - ! array indices: - ! (t_kp1_tdiag, k_wp3) ==> (wp3_cur_row + 4) - ! (t_kp1_mdiag, k_wp3) ==> (wp3_cur_row + 3) - ! (t_k_tdiag, k_wp3) ==> (wp3_cur_row + 2) - ! (t_k_mdiag, k_wp3) ==> (wp3_cur_row + 1) - ! (t_km1_tdiag, k_wp3) ==> (wp3_cur_row) - ! For readability, these values are updated here. - ! This means that to update the CSR version of the LHS subroutine, - ! all that must be done is remove the ,k_wp2 from the array indices, - ! as the CSR-format matrix is one-dimensional. - - ! NOTE: All references to lhs will need to be changed to lhs_a_csr - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! WARNING: If you have array indices that go from t_kp1_tdiag to - ! t_km1_tdiag, you will need to set it to span by -1. This is because - ! in the CSR-format arrays, the indices descend as you go from t_kp1_tdiag - ! to t_km1_tdiag! - ! - ! EXAMPLE: lhs((t_kp1_tdiag:t_km1_tdiag),wp3) would become - ! lhs_a_csr((t_kp1_tdiag:t_km1_tdiag:-1)) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - t_kp1_tdiag = wp3_cur_row + 4 - !t_kp1_mdiag = wp3_cur_row + 3 - t_k_tdiag = wp3_cur_row + 2 - !t_k_mdiag = wp3_cur_row + 1 - t_km1_tdiag = wp3_cur_row - - ! LHS time tendency. - lhs_a_csr(t_k_tdiag) & - = real( + 1.0_core_rknd / dt ) - - ! LHS mean advection (ma) term. - lhs_a_csr((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/)) & - = lhs_a_csr((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/)) & - + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) - - ! LHS turbulent advection (ta) and turbulent production (tp) terms. - ! Note: An "over-implicit" weighted time step is applied to these terms. - ! The weight of the implicit portion of these terms is controlled - ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the - ! expression below). A factor is added to the right-hand side of - ! the equation in order to balance a weight that is not equal to 1, - ! such that: - ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; - ! where X is the variable that is being solved for in a predictive - ! equation (w'^3 in this case), y(t) is the linearized portion of - ! the terms that gets treated implicitly, and RHS is the portion of - ! the terms that is always treated explicitly. A weight of greater - ! than 1 can be applied to make the terms more numerically stable. - lhs_a_csr(t_kp1_tdiag:t_km1_tdiag:-1) & - = lhs_a_csr(t_kp1_tdiag:t_km1_tdiag:-1) & - + gamma_over_implicit_ts & - * wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & - a1(k), a1_zt(k), a1(km1), & - a3(k), a3_zt(k), a3(km1), & - wp3_on_wp2(k), wp3_on_wp2(km1), & - rho_ds_zm(k), rho_ds_zm(km1), & - invrs_rho_ds_zt(k), & - three_halves, & - gr%invrs_dzt(k), k ) - - ! LHS accumulation (ac) term and pressure term 2 (pr2). - lhs_a_csr(t_k_tdiag) & - = lhs_a_csr(t_k_tdiag) & - + wp3_terms_ac_pr2_lhs( C11_Skw_fnc(k), & - wm_zm(k), wm_zm(km1), gr%invrs_dzt(k) ) - - ! LHS pressure term 1 (pr1). - ! Note: An "over-implicit" weighted time step is applied to this term. - lhs_a_csr(t_k_tdiag) & - = lhs_a_csr(t_k_tdiag) & - + gamma_over_implicit_ts & - * wp3_term_pr1_lhs( C8, C8b, tauw3t(k), Skw_zt(k) ) - - ! LHS eddy diffusion term: dissipation term 1 (dp1). - ! Added a new constant, C12. - ! Initially, this new constant will be set to 1.0 -dschanen 9/19/05 - if ( l_crank_nich_diff ) then - ! Eddy diffusion for wp3 using a Crank-Nicholson time step. - lhs_a_csr((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/)) & - = lhs_a_csr((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/)) & - + C12 * (1.0_core_rknd/2.0_core_rknd) & - * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & - gr%invrs_dzm(km1), gr%invrs_dzm(k), & - gr%invrs_dzt(k), k ) - else - ! Eddy diffusion for wp3 using a completely implicit time step. - lhs_a_csr((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/)) & - = lhs_a_csr((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/)) & - + C12 & - * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & - gr%invrs_dzm(km1), gr%invrs_dzm(k), & - gr%invrs_dzt(k), k ) - endif - - ! LHS 4th-order hyper-diffusion (4hd). - ! NOTE: 4th-order hyper-diffusion is not yet supported in CSR-format. - ! As such, this needs to remain commented out. - !if ( l_hyper_dfsn ) then - ! ! Note: w'^3 uses fixed-point boundary conditions. - ! lhs( (/t_kp2_tdiag,t_kp1_tdiag,t_k_tdiag,t_km1_tdiag,t_km2_tdiag/), & - ! k_wp3) & - ! = lhs( (/t_kp2_tdiag,t_kp1_tdiag,t_k_tdiag,t_km1_tdiag,t_km2_tdiag/), & - ! k_wp3) & - ! + hyper_dfsn_4th_ord_zt_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzt(k), & - ! gr%invrs_dzm(k), gr%invrs_dzm(km1), & - ! gr%invrs_dzt(kp1), gr%invrs_dzt(km1), & - ! gr%invrs_dzm(kp1), gr%invrs_dzm(km2), k ) - !endif - - if (l_stats_samp) then - - ! Statistics: implicit contributions for wp3. - - ! Note: To find the contribution of w'^3 term ta, add 3 to all of - ! the a_3 inputs and substitute 0 for the three_halves input to - ! function wp3_terms_ta_tp_lhs. - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for LHS turbulent - ! advection (ta) and turbulent production (tp) terms). - if ( iwp3_ta > 0 ) then - tmp(1:5) & - = gamma_over_implicit_ts & - * wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & - a1(k), a1_zt(k), a1(km1), & - a3(k)+3.0_core_rknd, a3_zt(k)+3.0_core_rknd, & - a3(km1)+3.0_core_rknd, & - wp3_on_wp2(k), wp3_on_wp2(km1), & - rho_ds_zm(k), rho_ds_zm(km1), & - invrs_rho_ds_zt(k), & - 0.0_core_rknd, & - gr%invrs_dzt(k), k ) - ztscr05(k) = -tmp(5) - ztscr06(k) = -tmp(4) - ztscr07(k) = -tmp(3) - ztscr08(k) = -tmp(2) - ztscr09(k) = -tmp(1) - endif - - ! Note: To find the contribution of w'^3 term tp, substitute 0 for all - ! of the a_1 and a_3 inputs and subtract 3 from all of the a_3 - ! inputs to function wp3_terms_ta_tp_lhs. - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for LHS turbulent - ! advection (ta) and turbulent production (tp) terms). - if ( iwp3_tp > 0 ) then - tmp(1:5) & - = gamma_over_implicit_ts & - * wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & - 0.0_core_rknd, 0.0_core_rknd, 0.0_core_rknd, & - 0.0_core_rknd-3.0_core_rknd, 0.0_core_rknd-3.0_core_rknd, & - 0.0_core_rknd-3.0_core_rknd, & - 0.0_core_rknd, 0.0_core_rknd, & - rho_ds_zm(k), rho_ds_zm(km1), & - invrs_rho_ds_zt(k), & - three_halves, & - gr%invrs_dzt(k), k ) - ztscr10(k) = -tmp(4) - ztscr11(k) = -tmp(2) - endif - - if ( iwp3_ma > 0 ) then - tmp(1:3) = & - term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) - ztscr12(k) = -tmp(3) - ztscr13(k) = -tmp(2) - ztscr14(k) = -tmp(1) - endif - - ! Note: To find the contribution of w'^3 term ac, substitute 0 for the - ! C_ll skewness function input to function wp3_terms_ac_pr2_lhs. - if ( iwp3_ac > 0 ) then - ztscr15(k) = & - - wp3_terms_ac_pr2_lhs( 0.0_core_rknd, & - wm_zm(k), wm_zm(km1), gr%invrs_dzt(k) ) - endif - - ! Note: To find the contribution of w'^3 term pr2, add 1 to the - ! C_ll skewness function input to function wp3_terms_ac_pr2_lhs. - if ( iwp3_pr2 > 0 ) then - ztscr16(k) = & - - wp3_terms_ac_pr2_lhs( (1.0_core_rknd+C11_Skw_fnc(k)), & - wm_zm(k), wm_zm(km1), gr%invrs_dzt(k) ) - endif - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for LHS turbulent - ! advection (ta) and turbulent production (tp) terms). - if ( iwp3_pr1 > 0 ) then - ztscr01(k) & - = - gamma_over_implicit_ts & - * wp3_term_pr1_lhs( C8, C8b, tauw3t(k), Skw_zt(k) ) - endif - - if ( iwp3_dp1 > 0 ) then - if ( l_crank_nich_diff ) then - ! Eddy diffusion for wp3 using a Crank-Nicholson time step. - tmp(1:3) & - = C12 * (1.0_core_rknd/2.0_core_rknd) & - * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & - gr%invrs_dzm(km1), gr%invrs_dzm(k), & - gr%invrs_dzt(k), k ) - else - ! Eddy diffusion for wp3 using a completely implicit time step. - tmp(1:3) & - = C12 & - * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & - gr%invrs_dzm(km1), gr%invrs_dzm(k), & - gr%invrs_dzt(k), k ) - endif - - ztscr02(k) = -tmp(3) - ztscr03(k) = -tmp(2) - ztscr04(k) = -tmp(1) - - endif - - if ( iwp3_4hd > 0 .and. l_hyper_dfsn ) then - tmp(1:5) = & - hyper_dfsn_4th_ord_zt_lhs( 'fixed-point', nu_hd_vert_res_dep, gr%invrs_dzt(k), & - gr%invrs_dzm(k), gr%invrs_dzm(km1), & - gr%invrs_dzt(kp1), gr%invrs_dzt(km1), & - gr%invrs_dzm(kp1), gr%invrs_dzm(km2), k ) - ztscr17(k) = -tmp(5) - ztscr18(k) = -tmp(4) - ztscr19(k) = -tmp(3) - ztscr20(k) = -tmp(2) - ztscr21(k) = -tmp(1) - endif - - endif - - enddo ! k = 2, gr%nz-1, 1 - - - ! Boundary conditions - - ! Both wp2 and wp3 used fixed-point boundary conditions. - ! Therefore, anything set in the above loop at both the upper - ! and lower boundaries would be overwritten here. However, the - ! above loop does not extend to the boundary levels. An array - ! with a value of 1 at the main diagonal on the left-hand side - ! and with values of 0 at all other diagonals on the left-hand - ! side will preserve the right-hand side value at that level. - ! - ! wp3(1) wp2(1) ... wp3(nzmax) wp2(nzmax) - ! [ 0.0 0.0 0.0 0.0 ] - ! [ 0.0 0.0 0.0 0.0 ] - ! [ 1.0 1.0 ... 1.0 1.0 ] - ! [ 0.0 0.0 0.0 0.0 ] - ! [ 0.0 0.0 0.0 0.0 ] - - ! Lower boundary - k = 1 - k_wp3 = 2*k - 1 - k_wp2 = 2*k - - wp3_cur_row = 1 - wp2_cur_row = 4 - - ! w'^2 - lhs_a_csr(wp2_cur_row:wp2_cur_row + 3) = 0.0_core_rknd - lhs_a_csr(wp2_cur_row + 1) = 1.0_core_rknd - - ! w'^3 - lhs_a_csr(wp3_cur_row:wp3_cur_row + 2) = 0.0_core_rknd - lhs_a_csr(wp3_cur_row) = 1.0_core_rknd - - ! w'^2 - !lhs(:,k_wp2) = 0.0_core_rknd - !lhs(m_k_mdiag,k_wp2) = 1.0_core_rknd - ! w'^3 - !lhs(:,k_wp3) = 0.0_core_rknd - !lhs(t_k_tdiag,k_wp3) = 1.0_core_rknd - - ! Upper boundary - k = gr%nz - k_wp3 = 2*k - 1 - k_wp2 = 2*k - - ! w'^2 - lhs_a_csr(intlc_5d_5d_ja_size - 2:intlc_5d_5d_ja_size) = 0.0_core_rknd - lhs_a_csr(intlc_5d_5d_ja_size) = 1.0_core_rknd - - ! w'^3 - lhs_a_csr(intlc_5d_5d_ja_size - 6:intlc_5d_5d_ja_size - 3) = 0.0_core_rknd - lhs_a_csr(intlc_5d_5d_ja_size - 4) = 1.0_core_rknd - - ! w'^2 - !lhs(:,k_wp2) = 0.0_core_rknd - !lhs(m_k_mdiag,k_wp2) = 1.0_core_rknd - ! w'^3 - !lhs(:,k_wp3) = 0.0_core_rknd - !lhs(t_k_tdiag,k_wp3) = 1.0_core_rknd - - - return - end subroutine wp23_lhs_csr -#endif /* MKL */ - - !============================================================================= - subroutine wp23_rhs( dt, wp2, wp3, a1, a1_zt, & - a3, a3_zt, wp3_on_wp2, wpthvp, wp2thvp, um, vm, & - upwp, vpwp, up2, vp2, Kw1, Kw8, Kh_zt, & - Skw_zt, tau1m, tauw3t, C1_Skw_fnc, & - C11_Skw_fnc, rho_ds_zm, invrs_rho_ds_zt, radf, & - thv_ds_zm, thv_ds_zt, l_crank_nich_diff, & - rhs ) - - ! Description: - ! Compute RHS vector for w'^2 and w'^3. - ! This subroutine computes the explicit portion of - ! the w'^2 and w'^3 equations. - - ! References: - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable - - use crmx_grid_class, only: & - ddzt ! Procedure - - use crmx_parameters_tunable, only: & - C4, & ! Variables - C5, & - C8, & - C8b, & - C12, & - C15, & - nu1_vert_res_dep, & - nu8_vert_res_dep - - use crmx_constants_clubb, only: & - w_tol_sqd, & ! Variable(s) - eps, & - three_halves, & - gamma_over_implicit_ts - - use crmx_model_flags, only: & - l_tke_aniso ! Variable - - use crmx_diffusion, only: & - diffusion_zm_lhs, & ! Procedures - diffusion_zt_lhs - - use crmx_clubb_precision, only: & - time_precision, & ! Variable - core_rknd - - use crmx_stats_variables, only: & - l_stats_samp, iwp2_dp1, iwp2_dp2, zm, iwp2_bp, & ! Variable(s) - iwp2_pr1, iwp2_pr2, iwp2_pr3, iwp3_ta, zt, & - iwp3_tp, iwp3_bp1, iwp3_pr2, iwp3_pr1, iwp3_dp1, iwp3_bp2 - - use crmx_stats_type, only: & - stat_update_var_pt, & ! Procedure(s) - stat_begin_update_pt, & - stat_modify_pt - - use crmx_advance_helper_module, only: set_boundary_conditions_rhs - - - implicit none - - ! Constant parameters - logical, parameter :: & - l_wp3_2nd_buoyancy_term = .true. - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Timestep length [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - wp2, & ! w'^2 (momentum levels) [m^2/s^2] - wp3, & ! w'^3 (thermodynamic levels) [m^3/s^3] - a1, & ! sigma_sqd_w term a_1 (momentum levels) [-] - a1_zt, & ! a_1 interpolated to thermodynamic levels [-] - a3, & ! sigma_sqd_w term a_3 (momentum levels) [-] - a3_zt, & ! a_3 interpolated to thermodynamic levels [-] - wp3_on_wp2, & ! Smoothed version of wp3 / wp2 [m/s] - wpthvp, & ! w'th_v' (momentum levels) [K m/s] - wp2thvp, & ! w'^2th_v' (thermodynamic levels) [K m^2/s^2] - um, & ! u wind component (thermodynamic levels) [m/s] - vm, & ! v wind component (thermodynamic levels) [m/s] - upwp, & ! u'w' (momentum levels) [m^2/s^2] - vpwp, & ! v'w' (momentum levels) [m^2/s^2] - up2, & ! u'^2 (momentum levels) [m^2/s^2] - vp2, & ! v'^2 (momentum levels) [m^2/s^2] - Kw1, & ! Coefficient of eddy diffusivity for w'^2 [m^2/s] - Kw8, & ! Coefficient of eddy diffusivity for w'^3 [m^2/s] - Kh_zt, & ! Eddy diffusivity on thermodynamic levels [m^2/s] - Skw_zt, & ! Skewness of w on thermodynamic levels [-] - tau1m, & ! Time-scale tau on momentum levels [s] - tauw3t, & ! Time-scale tau on thermodynamic levels [s] - C1_Skw_fnc, & ! C_1 parameter with Sk_w applied [-] - C11_Skw_fnc, & ! C_11 parameter with Sk_w applied [-] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] - radf, & ! Buoyancy production at the CL top [m^2/s^3] - thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K] - thv_ds_zt ! Dry, base-state theta_v on thermo. levs. [K] - - logical, intent(in) :: & - l_crank_nich_diff ! Turns on/off Crank-Nicholson diffusion. - - ! Output Variable - real( kind = core_rknd ), dimension(2*gr%nz), intent(out) :: & - rhs ! RHS of band matrix - - ! Local Variables - real( kind = core_rknd ), dimension(gr%nz) :: & - dum_dz, dvm_dz ! Vertical derivatives of um and vm - - ! Array indices - integer :: k, km1, kp1, k_wp2, k_wp3, k_wp2_low, k_wp2_high, & - k_wp3_low, k_wp3_high - - ! For "over-implicit" weighted time step. - ! This vector holds output from the LHS (implicit) portion of a term at a - ! given vertical level. This output is weighted and applied to the RHS. - ! This is used if the implicit portion of the term is "over-implicit", which - ! means that the LHS contribution is given extra weight (>1) in order to - ! increase numerical stability. A weighted factor must then be applied to - ! the RHS in order to balance the weight. - real( kind = core_rknd ), dimension(5) :: lhs_fnc_output - - real( kind = core_rknd ), dimension(3) :: & - rhs_diff ! For use in Crank-Nicholson eddy diffusion. - - real( kind = core_rknd ) :: temp - - - ! Initialize the right-hand side vector to 0. - rhs = 0.0_core_rknd - - if ( l_wp3_2nd_buoyancy_term ) then - ! Compute the vertical derivative of the u and v winds - dum_dz = ddzt( um ) - dvm_dz = ddzt( vm ) - else - dum_dz = -999._core_rknd - dvm_dz = -999._core_rknd - end if - - do k = 2, gr%nz-1, 1 - - - ! Define indices - - km1 = max( k-1, 1 ) - kp1 = min( k+1, gr%nz ) - - k_wp3 = 2*k - 1 - k_wp2 = 2*k - - - !!!!!***** w'^2 *****!!!!! - - ! w'^2: Right-hand side (explicit w'^2 portion of the code). - - ! RHS time tendency. - rhs(k_wp2) & - = + ( 1.0_core_rknd / real( dt, kind = core_rknd ) ) * wp2(k) - - ! RHS buoyancy production (bp) term and pressure term 2 (pr2). - rhs(k_wp2) & - = rhs(k_wp2) & - + wp2_terms_bp_pr2_rhs( C5, thv_ds_zm(k), wpthvp(k) ) - - ! RHS buoyancy production at CL top due to LW radiative cooling - rhs(k_wp2) = rhs(k_wp2) + radf(k) - - ! RHS pressure term 3 (pr3). - rhs(k_wp2) & - = rhs(k_wp2) & - + wp2_term_pr3_rhs( C5, thv_ds_zm(k), wpthvp(k), upwp(k), um(kp1), & - um(k), vpwp(k), vm(kp1), vm(k), gr%invrs_dzm(k) ) - - ! RHS dissipation term 1 (dp1). - rhs(k_wp2) & - = rhs(k_wp2) & - + wp2_term_dp1_rhs( C1_Skw_fnc(k), tau1m(k), w_tol_sqd ) - - ! RHS contribution from "over-implicit" weighted time step - ! for LHS dissipation term 1 (dp1). - ! - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the term - ! more numerically stable (see note below for w'^3 RHS turbulent - ! advection (ta) and turbulent production (tp) terms). - lhs_fnc_output(1) & - = wp2_term_dp1_lhs( C1_Skw_fnc(k), tau1m(k) ) - rhs(k_wp2) & - = rhs(k_wp2) & - + ( 1.0_core_rknd - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * wp2(k) ) - - ! RHS eddy diffusion term: dissipation term 2 (dp2). - if ( l_crank_nich_diff ) then - ! These lines are for the diffusional term with a Crank-Nicholson - ! time step. They are not used for completely implicit diffusion. - rhs_diff(1:3) & - = (1.0_core_rknd/2.0_core_rknd) & - * diffusion_zm_lhs( Kw1(k), Kw1(kp1), nu1_vert_res_dep, & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(k), k ) - rhs(k_wp2) = rhs(k_wp2) & - - rhs_diff(3) * wp2(km1) & - - rhs_diff(2) * wp2(k) & - - rhs_diff(1) * wp2(kp1) - endif - - ! RHS pressure term 1 (pr1). - if ( l_tke_aniso ) then - - rhs(k_wp2) & - = rhs(k_wp2) & - + wp2_term_pr1_rhs( C4, up2(k), vp2(k), tau1m(k) ) - - ! RHS contribution from "over-implicit" weighted time step - ! for LHS dissipation term 1 (dp1). - ! - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note below for w'^3 RHS - ! turbulent advection (ta) and turbulent production (tp) terms). - lhs_fnc_output(1) & - = wp2_term_pr1_lhs( C4, tau1m(k) ) - rhs(k_wp2) & - = rhs(k_wp2) & - + ( 1.0_core_rknd - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * wp2(k) ) - - endif - - if ( l_stats_samp ) then - - ! Statistics: explicit contributions for wp2. - - ! w'^2 term dp2 has both implicit and explicit components (if the - ! Crank-Nicholson scheme is selected); call stat_begin_update_pt. - ! Since stat_begin_update_pt automatically subtracts the value sent in, - ! reverse the sign on right-hand side diffusion component. If - ! Crank-Nicholson diffusion is not selected, the stat_begin_update_pt - ! will not be called. - if ( l_crank_nich_diff ) then - call stat_begin_update_pt( iwp2_dp2, k, & - rhs_diff(3) * wp2(km1) & - + rhs_diff(2) * wp2(k) & - + rhs_diff(1) * wp2(kp1), zm ) - endif - - ! w'^2 term bp is completely explicit; call stat_update_var_pt. - ! Note: To find the contribution of w'^2 term bp, substitute 0 for the - ! C_5 input to function wp2_terms_bp_pr2_rhs. - call stat_update_var_pt( iwp2_bp, k, & - wp2_terms_bp_pr2_rhs( 0.0_core_rknd, thv_ds_zm(k), wpthvp(k) ), zm ) - - ! w'^2 term pr1 has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on wp2_term_pr1_rhs. - if ( l_tke_aniso ) then - call stat_begin_update_pt( iwp2_pr1, k, & - -wp2_term_pr1_rhs( C4, up2(k), vp2(k), tau1m(k) ), zm ) - - ! Note: An "over-implicit" weighted time step is applied to this - ! term. A weighting factor of greater than 1 may be used to - ! make the term more numerically stable (see note below for - ! w'^3 RHS turbulent advection (ta) and turbulent - ! production (tp) terms). - lhs_fnc_output(1) & - = wp2_term_pr1_lhs( C4, tau1m(k) ) - call stat_modify_pt( iwp2_pr1, k, & - + ( 1.0_core_rknd - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * wp2(k) ), zm ) - endif - - ! w'^2 term pr2 has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on wp2_terms_bp_pr2_rhs. - ! Note: To find the contribution of w'^2 term pr2, add 1 to the - ! C_5 input to function wp2_terms_bp_pr2_rhs. - call stat_begin_update_pt( iwp2_pr2, k, & - -wp2_terms_bp_pr2_rhs( (1.0_core_rknd+C5), thv_ds_zm(k), wpthvp(k) ), zm ) - - ! w'^2 term dp1 has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on wp2_term_dp1_rhs. - call stat_begin_update_pt( iwp2_dp1, k, & - -wp2_term_dp1_rhs( C1_Skw_fnc(k), tau1m(k), w_tol_sqd ), zm ) - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note below for w'^3 RHS - ! turbulent advection (ta) and turbulent production (tp) terms). - lhs_fnc_output(1) & - = wp2_term_dp1_lhs( C1_Skw_fnc(k), tau1m(k) ) - call stat_modify_pt( iwp2_dp1, k, & - + ( 1.0_core_rknd - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * wp2(k) ), zm ) - - ! w'^2 term pr3 is completely explicit; call stat_update_var_pt. - call stat_update_var_pt( iwp2_pr3, k, & - wp2_term_pr3_rhs( C5, thv_ds_zm(k), wpthvp(k), upwp(k), um(kp1), & - um(k), vpwp(k), vm(kp1), vm(k), gr%invrs_dzm(k) ), & - zm ) - - endif - - - - !!!!!***** w'^3 *****!!!!! - - ! w'^3: Right-hand side (explicit w'^3 portion of the code). - - ! RHS time tendency. - rhs(k_wp3) = & - + ( 1.0_core_rknd / real( dt, kind = core_rknd ) * wp3(k) ) - - ! RHS turbulent advection (ta) and turbulent production (tp) terms. -! rhs(k_wp3) & -! = rhs(k_wp3) & -! + wp3_terms_ta_tp_rhs( wp3_zm(k), wp3_zm(km1), & -! wp2(k), wp2(km1), & -! a1(k), a1_zt(k), a1(km1), & -! a3(k), a3_zt(k), a3(km1), & -! wp3_on_wp2(k), wp3_on_wp2(km1), & -! rho_ds_zm(k), rho_ds_zm(km1), & -! invrs_rho_ds_zt(k), & -! three_halves, & -! gr%invrs_dzt(k) ) - - ! RHS contribution from "over-implicit" weighted time step - ! for LHS turbulent advection (ta) and turbulent production (tp) terms. - ! - ! Note: An "over-implicit" weighted time step is applied to these terms. - ! The weight of the implicit portion of these terms is controlled - ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the - ! expression below). A factor is added to the right-hand side of - ! the equation in order to balance a weight that is not equal to 1, - ! such that: - ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; - ! where X is the variable that is being solved for in a predictive - ! equation (w'^3 in this case), y(t) is the linearized portion of - ! the terms that gets treated implicitly, and RHS is the portion of - ! the terms that is always treated explicitly. A weight of greater - ! than 1 can be applied to make the terms more numerically stable. - lhs_fnc_output(1:5) & - = wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & - a1(k), a1_zt(k), a1(km1), & - a3(k), a3_zt(k), a3(km1), & - wp3_on_wp2(k), wp3_on_wp2(km1), & - rho_ds_zm(k), rho_ds_zm(km1), & - invrs_rho_ds_zt(k), & - three_halves, & - gr%invrs_dzt(k), k ) - rhs(k_wp3) & - = rhs(k_wp3) & - + ( 1.0_core_rknd - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * wp3(kp1) & - - lhs_fnc_output(2) * wp2(k) & - - lhs_fnc_output(3) * wp3(k) & - - lhs_fnc_output(4) * wp2(km1) & - - lhs_fnc_output(5) * wp3(km1) ) - - ! RHS buoyancy production (bp) term and pressure term 2 (pr2). - rhs(k_wp3) & - = rhs(k_wp3) & - + wp3_terms_bp1_pr2_rhs( C11_Skw_fnc(k), thv_ds_zt(k), wp2thvp(k) ) - - ! RHS pressure term 1 (pr1). - rhs(k_wp3) & - = rhs(k_wp3) & - + wp3_term_pr1_rhs( C8, C8b, tauw3t(k), Skw_zt(k), wp3(k) ) - - ! RHS contribution from "over-implicit" weighted time step - ! for LHS pressure term 1 (pr1). - ! - ! Note: An "over-implicit" weighted time step is applied to this term. - lhs_fnc_output(1) & - = wp3_term_pr1_lhs( C8, C8b, tauw3t(k), Skw_zt(k) ) - rhs(k_wp3) & - = rhs(k_wp3) & - + ( 1.0_core_rknd - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * wp3(k) ) - - ! RHS eddy diffusion term: dissipation term 1 (dp1). - if ( l_crank_nich_diff ) then - ! These lines are for the diffusional term with a Crank-Nicholson - ! time step. They are not used for completely implicit diffusion. - rhs_diff(1:3) & - = C12 * (1.0_core_rknd/2.0_core_rknd) & - * diffusion_zt_lhs( Kw8(k), Kw8(km1), nu8_vert_res_dep, & - gr%invrs_dzm(km1), gr%invrs_dzm(k), & - gr%invrs_dzt(k), k ) - rhs(k_wp3) = rhs(k_wp3) & - - rhs_diff(3) * wp3(km1) & - - rhs_diff(2) * wp3(k) & - - rhs_diff(1) * wp3(kp1) - endif - - if ( l_wp3_2nd_buoyancy_term ) then - ! RHS 2nd bouyancy term - rhs(k_wp3) = rhs(k_wp3) & - + wp3_term_bp2_rhs( C15, Kh_zt(k), wpthvp(k), wpthvp(km1), & - dum_dz(k), dum_dz(km1), dvm_dz(k), dvm_dz(km1), & - upwp(k), upwp(km1), vpwp(k), vpwp(km1), & - thv_ds_zt(k), gr%invrs_dzt(k) ) - end if - - if ( l_stats_samp ) then - - ! Statistics: explicit contributions for wp3. - - ! w'^3 term ta has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on wp3_terms_ta_tp_rhs. - ! Note: To find the contribution of w'^3 term ta, add 3 to all of the - ! a_3 inputs and substitute 0 for the three_halves input to - ! function wp3_terms_ta_tp_rhs. -! call stat_begin_update_pt( iwp3_ta, k, & -! -wp3_terms_ta_tp_rhs( wp3_zm(k), wp3_zm(km1), & -! wp2(k), wp2(km1), & -! a1(k), a1_zt(k), a1(km1), & -! a3(k)+3.0_core_rknd, a3_zt(k)+3.0_core_rknd, -! a3(km1)+3.0_core_rknd, & -! wp3_on_wp2(k), wp3_on_wp2(km1), & -! rho_ds_zm(k), rho_ds_zm(km1), & -! invrs_rho_ds_zt(k), & -! 0.0_core_rknd, & -! gr%invrs_dzt(k) ), & -! zt ) - call stat_begin_update_pt( iwp3_ta, k, 0.0_core_rknd, zt ) - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for RHS turbulent - ! advection (ta) and turbulent production (tp) terms). - lhs_fnc_output(1:5) & - = wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & - a1(k), a1_zt(k), a1(km1), & - a3(k)+3.0_core_rknd, a3_zt(k)+3.0_core_rknd, & - a3(km1)+3.0_core_rknd, & - wp3_on_wp2(k), wp3_on_wp2(km1), & - rho_ds_zm(k), rho_ds_zm(km1), & - invrs_rho_ds_zt(k), & - 0.0_core_rknd, & - gr%invrs_dzt(k), k ) - call stat_modify_pt( iwp3_ta, k, & - + ( 1.0_core_rknd - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * wp3(kp1) & - - lhs_fnc_output(2) * wp2(k) & - - lhs_fnc_output(3) * wp3(k) & - - lhs_fnc_output(4) * wp2(km1) & - - lhs_fnc_output(5) * wp3(km1) ), zt ) - - ! w'^3 term tp has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on wp3_terms_ta_tp_rhs. - ! Note: To find the contribution of w'^3 term tp, substitute 0 for all - ! of the a_1 and a_3 inputs and subtract 3 from all of the a_3 - ! inputs to function wp3_terms_ta_tp_rhs. -! call stat_begin_update_pt( iwp3_tp, k, & -! -wp3_terms_ta_tp_rhs( wp3_zm(k), wp3_zm(km1), & -! wp2(k), wp2(km1), & -! 0.0_core_rknd, 0.0_core_rknd, 0.0_core_rknd, & -! 0.0_core_rknd-3.0_core_rknd, 0.0_core_rknd-3.0_core_rknd, -! 0.0_core_rknd-3.0_core_rknd, & -! 0.0_core_rknd, 0.0_core_rknd, & -! rho_ds_zm(k), rho_ds_zm(km1), & -! invrs_rho_ds_zt(k), & -! three_halves, & -! gr%invrs_dzt(k) ), & -! zt ) - call stat_begin_update_pt( iwp3_tp, k, 0.0_core_rknd, zt ) - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for RHS turbulent - ! advection (ta) and turbulent production (tp) terms). - lhs_fnc_output(1:5) & - = wp3_terms_ta_tp_lhs( wp2(k), wp2(km1), & - 0.0_core_rknd, 0.0_core_rknd, 0.0_core_rknd, & - 0.0_core_rknd-3.0_core_rknd, 0.0_core_rknd-3.0_core_rknd, & - 0.0_core_rknd-3.0_core_rknd, & - 0.0_core_rknd, 0.0_core_rknd, & - rho_ds_zm(k), rho_ds_zm(km1), & - invrs_rho_ds_zt(k), & - three_halves, & - gr%invrs_dzt(k), k ) - call stat_modify_pt( iwp3_tp, k, & - + ( 1.0_core_rknd - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(2) * wp2(k) & - - lhs_fnc_output(4) * wp2(km1) ), zt ) - - ! w'^3 term bp is completely explicit; call stat_update_var_pt. - ! Note: To find the contribution of w'^3 term bp, substitute 0 for the - ! C_11 skewness function input to function wp3_terms_bp1_pr2_rhs. - call stat_update_var_pt( iwp3_bp1, k, & - wp3_terms_bp1_pr2_rhs( 0.0_core_rknd, thv_ds_zt(k), wp2thvp(k) ), zt ) - - ! w'^3 term pr2 has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on wp3_terms_bp1_pr2_rhs. - ! Note: To find the contribution of w'^3 term pr2, add 1 to the - ! C_11 skewness function input to function wp3_terms_bp1_pr2_rhs. - call stat_begin_update_pt( iwp3_pr2, k, & - -wp3_terms_bp1_pr2_rhs( (1.0_core_rknd+C11_Skw_fnc(k)), thv_ds_zt(k), & - wp2thvp(k) ), & - zt ) - - ! w'^3 term pr1 has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on wp3_term_pr1_rhs. - call stat_begin_update_pt( iwp3_pr1, k, & - -wp3_term_pr1_rhs( C8, C8b, tauw3t(k), Skw_zt(k), wp3(k) ), & - zt ) - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for RHS turbulent - ! advection (ta) and turbulent production (tp) terms). - lhs_fnc_output(1) & - = wp3_term_pr1_lhs( C8, C8b, tauw3t(k), Skw_zt(k) ) - call stat_modify_pt( iwp3_pr1, k, & - + ( 1.0_core_rknd - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * wp3(k) ), zt ) - - ! w'^3 term dp1 has both implicit and explicit components (if the - ! Crank-Nicholson scheme is selected); call stat_begin_update_pt. - ! Since stat_begin_update_pt automatically subtracts the value sent in, - ! reverse the sign on right-hand side diffusion component. If - ! Crank-Nicholson diffusion is not selected, the stat_begin_update_pt - ! will not be called. - if ( l_crank_nich_diff ) then - call stat_begin_update_pt( iwp3_dp1, k, & - rhs_diff(3) * wp3(km1) & - + rhs_diff(2) * wp3(k) & - + rhs_diff(1) * wp3(kp1), zt ) - endif - - if ( l_wp3_2nd_buoyancy_term ) then - temp = wp3_term_bp2_rhs( C15, Kh_zt(k), wpthvp(k), wpthvp(km1), & - dum_dz(k), dum_dz(km1), dvm_dz(k), dvm_dz(km1), & - upwp(k), upwp(km1), vpwp(k), vpwp(km1), & - thv_ds_zt(k), gr%invrs_dzt(k) ) - call stat_update_var_pt( iwp3_bp2, k, temp, zt ) - end if - - endif ! l_stats_samp - - enddo ! k = 2..gr%nz-1 - - - ! Boundary conditions - - ! Both wp2 and wp3 used fixed-point boundary conditions. - ! Therefore, anything set in the above loop at both the upper - ! and lower boundaries would be overwritten here. However, the - ! above loop does not extend to the boundary levels. An array - ! with a value of 1 at the main diagonal on the left-hand side - ! and with values of 0 at all other diagonals on the left-hand - ! side will preserve the right-hand side value at that level. - - ! Lower boundary - k = 1 - k_wp3_low = 2*k - 1 - k_wp2_low = 2*k - - ! Upper boundary - k = gr%nz - k_wp3_high = 2*k - 1 - k_wp2_high = 2*k - - - ! The value of w'^2 at the lower boundary will remain the same. - ! When the lower boundary is at the surface, the surface value of - ! w'^2 is set in subroutine surface_varnce (surface_varnce_module.F). - - ! The value of w'^3 at the lower boundary will be 0. - - ! The value of w'^2 at the upper boundary will be set to the threshold - ! minimum value of w_tol_sqd. - - ! The value of w'^3 at the upper boundary will be set to 0. - call set_boundary_conditions_rhs( & - wp2(1), k_wp2_low, w_tol_sqd, k_wp2_high, & ! Intent(in) - rhs, & ! Intent(inout) - 0.0_core_rknd, k_wp3_low, 0.0_core_rknd, k_wp3_high ) - - return - - end subroutine wp23_rhs - - !============================================================================= - pure function wp2_term_ta_lhs( rho_ds_ztp1, rho_ds_zt, & - invrs_rho_ds_zm, invrs_dzm ) & - result( lhs ) - - ! Description: - ! Turbulent advection term for w'^2: implicit portion of the code. - ! - ! The d(w'^2)/dt equation contains a turbulent advection term: - ! - ! - (1/rho_ds) * d( rho_ds * w'^3 )/dz. - ! - ! The term is solved for completely implicitly, such that: - ! - ! - (1/rho_ds) * d( rho_ds * w'^3(t+1) )/dz. - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed - ! to a "+". - ! - ! The timestep index (t+1) means that the value of w'^3 being used is from - ! the next timestep, which is being advanced to in solving the d(w'^2)/dt - ! and d(w'^3)/dt equations. - ! - ! This term is discretized as follows: - ! - ! While the values of w'^2 are found on the momentum levels, the values of - ! w'^3 are found on the thermodynamic levels. Additionally, the values of - ! rho_ds_zt are found on the thermodynamic levels, and the values of - ! invrs_rho_ds_zm are found on the momentum levels. On the thermodynamic - ! levels, the values of rho_ds_zt are multiplied by the values of w'^3. The - ! derivative of (rho_ds_zt * w'^3) is taken over the intermediate (central) - ! momentum level, where it is multiplied by invrs_rho_ds_zm, yielding the - ! desired results. - ! - ! -----rho_ds_ztp1--------wp3p1---------------------------- t(k+1) - ! - ! ========invrs_rho_ds_zm==========d(rho_ds*wp3)/dz======== m(k) - ! - ! -----rho_ds_zt----------wp3------------------------------ t(k) - ! - ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes - ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for - ! thermodynamic levels and the letter "m" is used for momentum levels. - ! - ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. - k_tdiag = 2 ! Thermodynamic subdiagonal index. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - rho_ds_ztp1, & ! Dry, static density at thermo. level (k+1) [kg/m^3] - rho_ds_zt, & ! Dry, static density at thermo. level (k) [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. lev. (k) [m^3/kg] - invrs_dzm ! Inverse of grid spacing (k) [1/m] - - ! Return Variable - real( kind = core_rknd ), dimension(2) :: lhs - - ! Thermodynamic superdiagonal: [ x wp3(k+1,) ] - lhs(kp1_tdiag) & - = + invrs_rho_ds_zm * invrs_dzm * rho_ds_ztp1 - - ! Thermodynamic subdiagonal: [ x wp3(k,) ] - lhs(k_tdiag) & - = - invrs_rho_ds_zm * invrs_dzm * rho_ds_zt - - return - - end function wp2_term_ta_lhs - - !============================================================================= - pure function wp2_terms_ac_pr2_lhs( C5, wm_ztp1, wm_zt, invrs_dzm ) & - result( lhs ) - - ! Description: - ! Accumulation of w'^2 and w'^2 pressure term 2: implicit portion of the - ! code. - ! - ! The d(w'^2)/dt equation contains an accumulation term: - ! - ! - 2 w'^2 dw/dz; - ! - ! and pressure term 2: - ! - ! - C_5 ( -2 w'^2 dw/dz + 2 (g/th_0) w'th_v' ). - ! - ! The w'^2 accumulation term is completely implicit, while w'^2 pressure - ! term 2 has both implicit and explicit components. The accumulation term - ! and the implicit portion of pressure term 2 are combined and solved - ! together as: - ! - ! + ( 1 - C_5 ) ( -2 w'^2(t+1) dw/dz ). - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the "2" is changed - ! to a "+". - ! - ! The timestep index (t+1) means that the value of w'^2 being used is from - ! the next timestep, which is being advanced to in solving the d(w'^2)/dt - ! equation. - ! - ! The terms are discretized as follows: - ! - ! The values of w'^2 are found on the momentum levels, while the values of - ! wm_zt (mean vertical velocity on thermodynamic levels) are found on the - ! thermodynamic levels. The vertical derivative of wm_zt is taken over the - ! intermediate (central) momentum level. It is then multiplied by w'^2 - ! (implicitly calculated at timestep (t+1)) and the coefficients to yield - ! the desired results. - ! - ! -------wm_ztp1------------------------------------------- t(k+1) - ! - ! ===============d(wm_zt)/dz============wp2================ m(k) - ! - ! -------wm_zt--------------------------------------------- t(k) - ! - ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes - ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for - ! thermodynamic levels and the letter "m" is used for momentum levels. - ! - ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C5, & ! Model parameter C_5 [-] - wm_ztp1, & ! w wind component at t:hermodynamic levels (k+1) [m/s] - wm_zt, & ! w wind component at thermodynamic levels (k) [m/s] - invrs_dzm ! Inverse of grid spacing (k) [1/m] - - ! Return Variable - real( kind = core_rknd ) :: lhs - - ! Momentum main diagonal: [ x wp2(k,) ] - lhs & - = + ( 1.0_core_rknd - C5 ) * 2.0_core_rknd * invrs_dzm * ( wm_ztp1 - wm_zt ) - - return - - end function wp2_terms_ac_pr2_lhs - - !============================================================================= - pure function wp2_term_dp1_lhs( C1_Skw_fnc, tau1m ) & - result( lhs ) - - ! Description: - ! Dissipation term 1 for w'^2: implicit portion of the code. - ! - ! The d(w'^2)/dt equation contains dissipation term 1: - ! - ! - ( C_1 / tau_1m ) w'^2. - ! - ! Since w'^2 has a minimum threshold, the term should be damped only to that - ! threshold. The term becomes: - ! - ! - ( C_1 / tau_1m ) * ( w'^2 - threshold ). - ! - ! This term is broken into implicit and explicit portions. The implicit - ! portion of this term is: - ! - ! - ( C_1 / tau_1m ) w'^2(t+1). - ! - ! Note: When the implicit term is brought over to the left-hand side, the - ! sign is reversed and the leading "-" in front of the term is - ! changed to a "+". - ! - ! The timestep index (t+1) means that the value of w'^2 being used is from - ! the next timestep, which is being advanced to in solving the d(w'^2)/dt - ! equation. - ! - ! The values of w'^2 are found on the momentum levels. The values of the - ! C_1 skewness function and time-scale tau1m are also found on the momentum - ! levels. - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C1_Skw_fnc, & ! C_1 parameter with Sk_w applied (k) [-] - tau1m ! Time-scale tau at momentum levels (k) [s] - - ! Return Variable - real( kind = core_rknd ) :: lhs - - ! Momentum main diagonal: [ x wp2(k,) ] - lhs & - = + C1_Skw_fnc / tau1m - - return - end function wp2_term_dp1_lhs - - !============================================================================= - pure function wp2_term_pr1_lhs( C4, tau1m ) & - result( lhs ) - - ! Description - ! Pressure term 1 for w'^2: implicit portion of the code. - ! - ! The d(w'^2)/dt equation contains pressure term 1: - ! - ! - ( C_4 / tau_1m ) * ( w'^2 - (2/3)*em ), - ! - ! where em = (1/2) * ( w'^2 + u'^2 + v'^2 ). - ! - ! This simplifies to: - ! - ! - ( C_4 / tau_1m ) * (2/3) * w'^2 - ! + ( C_4 / tau_1m ) * (1/3) * ( u'^2 + v'^2 ). - ! - ! Pressure term 1 has both implicit and explicit components. The implicit - ! portion is: - ! - ! - ( C_4 / tau_1m ) * (2/3) * w'^2(t+1); - ! - ! and is computed in this function. - ! - ! Note: When the implicit term is brought over to the left-hand side, the - ! sign is reversed and the leading "-" in front of the term is - ! changed to a "+". - ! - ! The timestep index (t+1) means that the value of w'^2 being used is from - ! the next timestep, which is being advanced to in solving the d(w'^2)/dt - ! equation. - ! - ! The values of w'^2 are found on momentum levels, as are the values of tau1m. - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C4, & ! Model parameter C_4 [-] - tau1m ! Time-scale tau at momentum levels (k) [s] - - ! Return Variable - real( kind = core_rknd ) :: lhs - - ! Momentum main diagonal: [ x wp2(k,) ] - lhs & - = + ( 2.0_core_rknd * C4 ) / ( 3.0_core_rknd * tau1m ) - - return - end function wp2_term_pr1_lhs - - !============================================================================= - pure function wp2_terms_bp_pr2_rhs( C5, thv_ds_zm, wpthvp ) & - result( rhs ) - - ! Description: - ! Buoyancy production of w'^2 and w'^2 pressure term 2: explicit portion of - ! the code. - ! - ! The d(w'^2)/dt equation contains a buoyancy production term: - ! - ! + 2 (g/thv_ds) w'th_v'; - ! - ! and pressure term 2: - ! - ! - C_5 ( -2 w'^2 dw/dz + 2 (g/thv_ds) w'th_v' ). - ! - ! The w'^2 buoyancy production term is completely explicit, while w'^2 - ! pressure term 2 has both implicit and explicit components. The buoyancy - ! production term and the explicit portion of pressure term 2 are combined - ! and solved together as: - ! - ! + ( 1 - C_5 ) ( 2 (g/thv_ds) w'th_v' ). - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_constants_clubb, only: & - ! Variable(s) - grav ! Gravitational acceleration [m/s^2] - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C5, & ! Model parameter C_5 [-] - thv_ds_zm, & ! Dry, base-state theta_v at momentum level (k) [K] - wpthvp ! w'th_v'(k) [K m/s] - - ! Return Variable - real( kind = core_rknd ) :: rhs - - rhs & - = + ( 1.0_core_rknd - C5 ) * 2.0_core_rknd * ( grav / thv_ds_zm ) * wpthvp - - return - end function wp2_terms_bp_pr2_rhs - - !============================================================================= - pure function wp2_term_dp1_rhs( C1_Skw_fnc, tau1m, threshold ) & - result( rhs ) - - ! Description: - ! Dissipation term 1 for w'^2: explicit portion of the code. - ! - ! The d(w'^2)/dt equation contains dissipation term 1: - ! - ! - ( C_1 / tau_1m ) w'^2. - ! - ! Since w'^2 has a minimum threshold, the term should be damped only to that - ! threshold. The term becomes: - ! - ! - ( C_1 / tau_1m ) * ( w'^2 - threshold ). - ! - ! This term is broken into implicit and explicit portions. The explicit - ! portion of this term is: - ! - ! + ( C_1 / tau_1m ) * threshold. - ! - ! The values of the C_1 skewness function, time-scale tau1m, and the - ! threshold are found on the momentum levels. - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C1_Skw_fnc, & ! C_1 parameter with Sk_w applied (k) [-] - tau1m, & ! Time-scale tau at momentum levels (k) [s] - threshold ! Minimum allowable value of w'^2 [m^2/s^2] - - ! Return Variable - real( kind = core_rknd ) :: rhs - - rhs & - = + ( C1_Skw_fnc / tau1m ) * threshold - - return - end function wp2_term_dp1_rhs - - !============================================================================= - pure function wp2_term_pr3_rhs( C5, thv_ds_zm, wpthvp, upwp, ump1, & - um, vpwp, vmp1, vm, invrs_dzm ) & - result( rhs ) - - ! Description: - ! Pressure term 3 for w'^2: explicit portion of the code. - ! - ! The d(w'^2)/dt equation contains pressure term 3: - ! - ! + (2/3) C_5 [ (g/thv_ds) w'th_v' - u'w' du/dz - v'w' dv/dz ]. - ! - ! This term is solved for completely explicitly and is discretized as - ! follows: - ! - ! The values of w'th_v', u'w', and v'w' are found on the momentum levels, - ! whereas the values of um and vm are found on the thermodynamic levels. - ! Additionally, the values of thv_ds_zm are found on the momentum levels. - ! The derivatives of both um and vm are taken over the intermediate - ! (central) momentum level. All the remaining mathematical operations take - ! place at the central momentum level, yielding the desired result. - ! - ! -----ump1------------vmp1-------------------------------------- t(k+1) - ! - ! =upwp====d(um)/dz========d(vm)/dz==vpwp===thv_ds_zm==wpthvp==== m(k) - ! - ! -----um--------------vm---------------------------------------- t(k) - ! - ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes - ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for - ! thermodynamic levels and the letter "m" is used for momentum levels. - ! - ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_constants_clubb, only: & ! Variables - grav, & ! Gravitational acceleration [m/s^2] - zero_threshold - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C5, & ! Model parameter C_5 [-] - thv_ds_zm, & ! Dry, base-state theta_v at momentum level (k) [K] - wpthvp, & ! w'th_v'(k) [K m/s] - upwp, & ! u'w'(k) [m^2/s^2] - ump1, & ! um(k+1) [m/s] - um, & ! um(k) [m/s] - vpwp, & ! v'w'(k) [m^2/s^2] - vmp1, & ! vm(k+1) [m/s] - vm, & ! vm(k) [m/s] - invrs_dzm ! Inverse of grid spacing (k) [1/m] - - ! Return Variable - real( kind = core_rknd ) :: rhs - - rhs & - ! Michael Falk, 2 August 2007 - ! Use the following code for standard mixing, with c_k=0.548: - = + (2.0_core_rknd/3.0_core_rknd) * C5 & - * ( ( grav / thv_ds_zm ) * wpthvp & - - upwp * invrs_dzm * ( ump1 - um ) & - - vpwp * invrs_dzm * ( vmp1 - vm ) & - ) - ! Use the following code for alternate mixing, with c_k=0.1 or 0.2 -! = + (2.0_core_rknd/3.0_core_rknd) * C5 & -! * ( ( grav / thv_ds_zm ) * wpthvp & -! - 0. * upwp * invrs_dzm * ( ump1 - um ) & -! - 0. * vpwp * invrs_dzm * ( vmp1 - vm ) & -! ) -! eMFc - - ! Added by dschanen for ticket #36 - ! We have found that when shear generation is zero this term will only be - ! offset by hole-filling (wp2_pd) and reduces turbulence - ! unrealistically at lower altitudes to make up the difference. - rhs = max( rhs, zero_threshold ) - - return - end function wp2_term_pr3_rhs - - !============================================================================= - pure function wp2_term_pr1_rhs( C4, up2, vp2, tau1m ) & - result( rhs ) - - ! Description: - ! Pressure term 1 for w'^2: explicit portion of the code. - ! - ! The d(w'^2)/dt equation contains pressure term 1: - ! - ! - ( C_4 / tau_1m ) * ( w'^2 - (2/3)*em ); - ! - ! where em = (1/2) * ( w'^2 + u'^2 + v'^2 ). - ! - ! This simplifies to: - ! - ! - ( C_4 / tau_1m ) * (2/3) * w'^2 - ! + ( C_4 / tau_1m ) * (1/3) * ( u'^2 + v'^2 ). - ! - ! Pressure term 1 has both implicit and explicit components. - ! The explicit portion is: - ! - ! + ( C_4 / tau_1m ) * (1/3) * ( u'^2 + v'^2 ); - ! - ! and is computed in this function. - ! - ! The values of u'^2 and v'^2 are found on momentum levels, as are the - ! values of tau1m. - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C4, & ! Model parameter C_4 [-] - up2, & ! u'^2(k) [m^2/s^2] - vp2, & ! v'^2(k) [m^2/s^2] - tau1m ! Time-scale tau at momentum levels (k) [s] - - ! Return Variable - real( kind = core_rknd ) :: rhs - - rhs & - = + ( C4 * ( up2 + vp2 ) ) / ( 3.0_core_rknd * tau1m ) - - return - end function wp2_term_pr1_rhs - - !============================================================================= - pure function wp3_terms_ta_tp_lhs( wp2, wp2m1, & - a1, a1_zt, a1m1, & - a3, a3_zt, a3m1, & - wp3_on_wp2, wp3_on_wp2_m1, & - rho_ds_zm, rho_ds_zmm1, & - invrs_rho_ds_zt, & - const_three_halves, & - invrs_dzt, level ) & - result( lhs ) - - ! Description: - ! Turbulent advection and turbulent production of w'^3: implicit portion of - ! the code. - ! - ! The d(w'^3)/dt equation contains a turbulent advection term: - ! - ! - (1/rho_ds) * d( rho_ds * w'^4 )/dz; - ! - ! and a turbulent production term: - ! - ! + 3 * ( w'^2 / rho_ds ) * d( rho_ds * w'^2 )/dz. - ! - ! A substitution is made in order to close the turbulent advection term, - ! such that: - ! - ! w'^4 = coef_sig_sqd_w * (w'^2)^2 + a_1 * ( (w'^3)^2 / w'^2 ); - ! - ! where both a_1 and coef_sig_sqd_w are variables that are functions of - ! sigma_sqd_w, such that: - ! - ! coef_sig_sqd_w = 3*(sigma_sqd_w)^2 + 6*(1 - sigma_sqd_w)*sigma_sqd_w - ! + (1 - sigma_sqd_w)^2; and - ! - ! a_1 = 1 / (1 - sigma_sqd_w). - ! - ! Since the turbulent advection and turbulent production terms are being - ! combined, a further substitution is made, such that: - ! - ! a_3 = coef_sig_sqd_w - 3; - ! - ! and thus: - ! - ! w'^4 = (a_3 + 3) * (w'^2)^2 + a_1 * ( (w'^3)^2 / w'^2 ). - ! - ! The turbulent production term is rewritten as: - ! - ! + 3 * ( w'^2 / rho_ds ) * d[ rho_ds * w'^2 ]/dz - ! = + (3/rho_ds) * d[ rho_ds * (w'^2)^2 ]/dz - (3/2) * d[ (w'^2)^2 ]/dz. - ! - ! The turbulent advection and turbulent production terms are combined as: - ! - ! - (1/rho_ds) * d [ rho_ds * a_3 * (w'^2)^2 ] / dz - ! - (1/rho_ds) * d [ rho_ds * a_1 * ( (w'^3)^2 / w'^2 ) ] / dz - ! - (3/2) * d [ (w'^2)^2 ] / dz. - ! - ! The (w'^2)^2 and (w'^3)^2 terms are both linearized, such that: - ! - ! ( w'^2(t+1) )^2 = - ( w'^2(t) )^2 + 2 * w'^2(t) * w'^2(t+1); - ! ( w'^3(t+1) )^2 = - ( w'^3(t) )^2 + 2 * w'^3(t) * w'^3(t+1); - ! - ! which produces implicit and explicit portions of these terms. The - ! implicit portion of these terms is: - ! - ! - (1/rho_ds) * d [ rho_ds * a_3 * 2 * w'^2(t) * w'^2(t+1) ] / dz - ! - (1/rho_ds) * d [ rho_ds * a_1 - ! * ( 2 * w'^3(t) * w'^3(t+1) ) / w'^2(t) ] / dz - ! - (3/2) * d [ 2 * w'^2(t) * w'^2(t+1) ] /dz. - ! - ! Note: When the term is brought over to the left-hand side, the sign is - ! reversed and the leading "-" in front of all d[ ] / dz terms is - ! changed to a "+". - ! - ! Timestep index (t) stands for the index of the current timestep, while - ! timestep index (t+1) stands for the index of the next timestep, which is - ! being advanced to in solving the d(w'^3)/dt and d(w'^2)/dt equations. - ! - ! The implicit portion of these terms is discretized as follows: - ! - ! The values of w'^3 are found on the thermodynamic levels, while the values - ! of w'^2, a_1, and a_3 are found on the momentum levels. Additionally, the - ! values of rho_ds_zm are found on the momentum levels, and the values of - ! invrs_rho_ds_zt are found on the thermodynamic levels. The variable w'^3 - ! is interpolated to the intermediate momentum levels. The values of the - ! mathematical expressions (called F, G, and H here) within the dF/dz, - ! dG/dz, and dH/dz terms are computed on the momentum levels. Then, the - ! derivatives (d/dz) of the expressions (F, G, and H) are taken over the - ! central thermodynamic level, where dF/dz and dG/dz are multiplied by - ! invrs_rho_ds_zt, and where dH/dz is multiplied by 3/2. This yields the - ! desired results. In this function, the values of F, G, and H are as - ! follows: - ! - ! F = rho_ds_zm * a_3(t) * 2 * w'^2(t) * w'^2(t+1); - ! - ! G = rho_ds_zm * a_1(t) * ( 2 * w'^3(t) * w'^3(t+1) ) / w'^2(t); and - ! - ! H = 2 * w'^2(t) * w'^2(t+1). - ! - ! - ! ------------------------------------------------wp3p1-------------- t(k+1) - ! - ! ===a3====wp2====rho_ds_zm====a1======================wp3(interp)=== m(k) - ! - ! ---dH/dz---dF/dz----invrs_rho_ds_zt----dG/dz----wp3---------------- t(k) - ! - ! ===a3m1==wp2m1==rho_ds_zmm1==a1m1====================wp3(interp)=== m(k-1) - ! - ! ------------------------------------------------wp3m1-------------- t(k-1) - ! - ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond - ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively. - ! The letter "t" is used for thermodynamic levels and the letter "m" is - ! used for momentum levels. - ! - ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_grid_class, only: & - gr ! Variable gr%weights_zt2zm - - use crmx_constants_clubb, only: & - w_tol_sqd - - use crmx_model_flags, only: & - l_standard_term_ta - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. - k_mdiag = 2, & ! Momentum superdiagonal index. - k_tdiag = 3, & ! Thermodynamic main diagonal index. - km1_mdiag = 4, & ! Momentum subdiagonal index. - km1_tdiag = 5 ! Thermodynamic subdiagonal index. - - integer, parameter :: & - t_above = 1, & ! Index for upper thermodynamic level grid weight. - t_below = 2 ! Index for lower thermodynamic level grid weight. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - wp2, & ! w'^2(k) [m^2/s^2] - wp2m1, & ! w'^2(k-1) [m^2/s^2] - a1, & ! a_1(k) [-] - a1_zt, & ! a_1 interpolated to thermo. level (k) [-] - a1m1, & ! a_1(k-1) [-] - a3, & ! a_3(k) [-] - a3_zt, & ! a_3 interpolated to thermo. level (k) [-] - a3m1, & ! a_3(k-1) [-] - wp3_on_wp2, & ! wp3 / wp2 (k) [m/s] - wp3_on_wp2_m1, & ! wp3 / wp2 (k-1) [m/s] - rho_ds_zm, & ! Dry, static density at moment. lev (k) [kg/m^3] - rho_ds_zmm1, & ! Dry, static density at moment. lev (k-1) [kg/m^3] - invrs_rho_ds_zt, & ! Inv dry, static density @ thermo lev (k) [m^3/kg] - const_three_halves, & ! "3/2" ("0" is sent in for wp3_ta budget) [-] - invrs_dzt ! Inverse of grid spacing (k) [1/m] - - integer, intent(in) :: & - level ! Central thermodynamic level (on which calculation occurs). - - ! Return Variable - real( kind = core_rknd ), dimension(5) :: lhs - - ! Local Variables - integer :: & - mk, & ! Momentum level directly above central thermodynamic level. - mkm1 ! Momentum level directly below central thermodynamic level. - - - ! Momentum level (k) is between thermodynamic level (k+1) - ! and thermodynamic level (k). - mk = level - - ! Momentum level (k-1) is between thermodynamic level (k) - ! and thermodynamic level (k-1). - mkm1 = level - 1 - - if ( l_standard_term_ta ) then - - ! The turbulent advection term is discretized normally, in accordance - ! with the model equations found in the documentation and the description - ! listed above. - - ! Thermodynamic superdiagonal: [ x wp3(k+1,) ] - lhs(kp1_tdiag) & - = + invrs_rho_ds_zt & - * invrs_dzt & - * rho_ds_zm * a1 & - * wp3_on_wp2 & - * gr%weights_zt2zm(t_above,mk) - - ! Momentum superdiagonal: [ x wp2(k,) ] - lhs(k_mdiag) & - = + invrs_rho_ds_zt & - * invrs_dzt * rho_ds_zm * a3 * wp2 & - + const_three_halves & - * invrs_dzt * wp2 - - ! Thermodynamic main diagonal: [ x wp3(k,) ] - lhs(k_tdiag) & - = + invrs_rho_ds_zt & - * invrs_dzt & - * ( rho_ds_zm * a1 & - * wp3_on_wp2 & - * gr%weights_zt2zm(t_below,mk) & - - rho_ds_zmm1 * a1m1 & - * wp3_on_wp2_m1 & - * gr%weights_zt2zm(t_above,mkm1) & - ) - - ! Momentum subdiagonal: [ x wp2(k-1,) ] - lhs(km1_mdiag) & - = - invrs_rho_ds_zt & - * invrs_dzt * rho_ds_zmm1 * a3m1 * wp2m1 & - - const_three_halves & - * invrs_dzt * wp2m1 - - ! Thermodynamic subdiagonal: [ x wp3(k-1,) ] - lhs(km1_tdiag) & - = - invrs_rho_ds_zt & - * invrs_dzt & - * rho_ds_zmm1 * a1m1 & - * wp3_on_wp2_m1 & - * gr%weights_zt2zm(t_below,mkm1) - - else - - ! Brian tried a new discretization for the turbulent advection term, - ! which contains the term: - ! - (1/rho_ds) * d [ rho_ds * a_1 * (w'^3)^2 / w'^2 ] / dz. In order - ! to help stabilize w'^3, a_1 has been pulled outside of the derivative. - ! On the left-hand side of the equation, this effects the thermodynamic - ! superdiagonal (kp1_tdiag), the thermodynamic main diagonal (k_tdiag), - ! and the thermodynamic subdiagonal (km1_tdiag). - - ! Additionally, the discretization of the turbulent advection term, which - ! contains the term: - ! - (1/rho_ds) * d [ rho_ds * (a_3 + 3) * (w'^2)^2 ] / dz, has been - ! altered to pull (a_3 + 3) outside of the derivative. This was done in - ! order to help stabilize w'^3. On the left-hand side of the equation, - ! this effects the momentum superdiagonal (k_mdiag) and the momentum - ! subdiagonal (km1_mdiag). - - ! Thermodynamic superdiagonal: [ x wp3(k+1,) ] - lhs(kp1_tdiag) & - = + invrs_rho_ds_zt & - * a1_zt * invrs_dzt & - * rho_ds_zm & - * wp3_on_wp2 & - * gr%weights_zt2zm(t_above,mk) - - ! Momentum superdiagonal: [ x wp2(k,) ] - lhs(k_mdiag) & - = + invrs_rho_ds_zt & - * a3_zt * invrs_dzt * rho_ds_zm * wp2 & - + const_three_halves & - * invrs_dzt * wp2 - - ! Thermodynamic main diagonal: [ x wp3(k,) ] - lhs(k_tdiag) & - = + invrs_rho_ds_zt & - * a1_zt * invrs_dzt & - * ( rho_ds_zm & - * wp3_on_wp2 & - * gr%weights_zt2zm(t_below,mk) & - - rho_ds_zmm1 & - * wp3_on_wp2_m1 & - * gr%weights_zt2zm(t_above,mkm1) & - ) - - ! Momentum subdiagonal: [ x wp2(k-1,) ] - lhs(km1_mdiag) & - = - invrs_rho_ds_zt & - * a3_zt * invrs_dzt * rho_ds_zmm1 * wp2m1 & - - const_three_halves & - * invrs_dzt * wp2m1 - - ! Thermodynamic subdiagonal: [ x wp3(k-1,) ] - lhs(km1_tdiag) & - = - invrs_rho_ds_zt & - * a1_zt * invrs_dzt & - * rho_ds_zmm1 & - * wp3_on_wp2_m1 & - * gr%weights_zt2zm(t_below,mkm1) - - ! End of code that pulls out a3. - ! End of Brian's a1 change. Feb. 14, 2008. - - end if ! l_standard_term_ta - - - return - end function wp3_terms_ta_tp_lhs - - !============================================================================= - pure function wp3_terms_ac_pr2_lhs( C11_Skw_fnc, & - wm_zm, wm_zmm1, invrs_dzt ) & - result( lhs ) - - ! Description: - ! Accumulation of w'^3 and w'^3 pressure term 2: implicit portion of the - ! code. - ! - ! The d(w'^3)/dt equation contains an accumulation term: - ! - ! - 3 w'^3 dw/dz; - ! - ! and pressure term 2: - ! - ! - C_11 ( -3 w'^3 dw/dz + 3 (g/th_0) w'^2th_v' ). - ! - ! The w'^3 accumulation term is completely implicit, while w'^3 pressure - ! term 2 has both implicit and explicit components. The accumulation term - ! and the implicit portion of pressure term 2 are combined and solved - ! together as: - ! - ! + ( 1 - C_11 ) ( -3 w'^3(t+1) dw/dz ). - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the "3" is changed - ! to a "+". - ! - ! The timestep index (t+1) means that the value of w'^3 being used is from - ! the next timestep, which is being advanced to in solving the d(w'^3)/dt - ! equation. - ! - ! The terms are discretized as follows: - ! - ! The values of w'^3 are found on thermodynamic levels, while the values of - ! wm_zm (mean vertical velocity on momentum levels) are found on momentum - ! levels. The vertical derivative of wm_zm is taken over the intermediate - ! (central) thermodynamic level. It is then multiplied by w'^3 (implicitly - ! calculated at timestep (t+1)) and the coefficients to yield the desired - ! results. - ! - ! =======wm_zm============================================= m(k) - ! - ! ---------------d(wm_zm)/dz------------wp3---------------- t(k) - ! - ! =======wm_zmm1=========================================== m(k-1) - ! - ! The vertical indices m(k), t(k), and m(k-1) correspond with altitudes - ! zm(k), zt(k), and zm(k-1), respectively. The letter "t" is used for - ! thermodynamic levels and the letter "m" is used for momentum levels. - ! - ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C11_Skw_fnc, & ! C_11 parameter with Sk_w applied (k) [-] - wm_zm, & ! w wind component at momentum levels (k) [m/s] - wm_zmm1, & ! w wind component at momentum levels (k-1) [m/s] - invrs_dzt ! Inverse of grid spacing (k) [1/m] - - ! Return Variable - real( kind = core_rknd ) :: lhs - - ! Thermodynamic main diagonal: [ x wp3(k,) ] - lhs & - = + ( 1.0_core_rknd - C11_Skw_fnc ) & - * 3.0_core_rknd * invrs_dzt * ( wm_zm - wm_zmm1 ) - - return - end function wp3_terms_ac_pr2_lhs - - !============================================================================= - pure function wp3_term_pr1_lhs( C8, C8b, tauw3t, Skw_zt ) & - result( lhs ) - - ! Description: - ! Pressure term 1 for w'^3: implicit portion of the code. - ! - ! Pressure term 1 is the term: - ! - ! - (C_8/tau_w3t) * ( C_8b * Sk_wt^4 + 1 ) * w'^3; - ! - ! where Sk_wt = w'^3 / (w'^2)^(3/2). - ! - ! This term needs to be linearized, so function L(w'^3) is defined to be - ! equal to this term (pressure term 1), such that: - ! - ! L(w'^3) = - (C_8/tau_w3t) * ( C_8b * (w'^3)^5 / (w'^2)^6 + w'^3 ). - ! - ! A Taylor Series expansion (truncated after the first derivative term) of - ! L(w'^3) around w'^3 = w'^3(t) is used to linearize pressure term 1. - ! Evaluating L(w'^3) at w'^3(t+1): - ! - ! L( w'^3(t+1) ) = L( w'^3(t) ) - ! + ( d L(w'^3) / d w'^3 )|_(w'^3=w'^3(t)) - ! * ( w'^3(t+1) - w'^3(t) ). - ! - ! After evaluating the expression above, the term has become linearized. It - ! is broken down into implicit (LHS) and explicit (RHS) components. - ! The implicit portion is: - ! - ! - (C_8/tau_w3t) * ( 5 * C_8b * Sk_wt^4 + 1 ) * w'^3(t+1). - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed - ! to a "+". - ! - ! Timestep index (t) stands for the index of the current timestep, while - ! timestep index (t+1) stands for the index of the next timestep, which is - ! being advanced to in solving the d(w'^3)/dt equation. - ! - ! The values of w'^3 are found on the thermodynamic levels, as are the - ! values of tau_w3t and Sk_wt (in Sk_wt, w'^3 is found on thermodynamic - ! levels and w'^2 is interpolated to thermodynamic levels). - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C8, & ! Model parameter C_8 [-] - C8b, & ! Model parameter C_8b [-] - tauw3t, & ! Time-scale tau at thermodynamic levels (k) [s] - Skw_zt ! Skewness of w at thermodynamic levels (k) [-] - - ! Return Variable - real( kind = core_rknd ) :: lhs - - ! Thermodynamic main diagonal: [ x wp3(k,) ] - lhs & - = + ( C8 / tauw3t ) * ( 5.0_core_rknd * C8b * Skw_zt**4 + 1.0_core_rknd ) - - return - end function wp3_term_pr1_lhs - - !============================================================================= -! pure function wp3_terms_ta_tp_rhs( wp3_zm, wp3_zmm1, & -! wp2, wp2m1, & -! a1, a1_zt, a1m1, & -! a3, a3_zt, a3m1, & -! wp3_on_wp2, wp3_on_wp2_m1, & -! rho_ds_zm, rho_ds_zmm1, & -! invrs_rho_ds_zt, & -! const_three_halves, & -! invrs_dzt ) & -! result( rhs ) - - ! Description: - ! Turbulent advection and turbulent production of wp3: explicit portion of - ! the code. - ! - ! The d(w'^3)/dt equation contains a turbulent advection term: - ! - ! - (1/rho_ds) * d( rho_ds * w'^4 )/dz; - ! - ! and a turbulent production term: - ! - ! + 3 * ( w'^2 / rho_ds ) * d( rho_ds * w'^2 )/dz. - ! - ! A substitution is made in order to close the turbulent advection term, - ! such that: - ! - ! w'^4 = coef_sig_sqd_w * (w'^2)^2 + a_1 * ( (w'^3)^2 / w'^2 ); - ! - ! where both a_1 and coef_sig_sqd_w are variables that are functions of - ! sigma_sqd_w, such that: - ! - ! coef_sig_sqd_w = 3*(sigma_sqd_w)^2 + 6*(1 - sigma_sqd_w)*sigma_sqd_w - ! + (1 - sigma_sqd_w)^2; and - ! - ! a_1 = 1 / (1 - sigma_sqd_w). - ! - ! Since the turbulent advection and turbulent production terms are being - ! combined, a further substitution is made, such that: - ! - ! a_3 = coef_sig_sqd_w - 3; - ! - ! and thus: - ! - ! w'^4 = (a_3 + 3) * (w'^2)^2 + a_1 * ( (w'^3)^2 / w'^2 ). - ! - ! The turbulent production term is rewritten as: - ! - ! + 3 * ( w'^2 / rho_ds ) * d[ rho_ds * w'^2 ]/dz - ! = + (3/rho_ds) * d[ rho_ds * (w'^2)^2 ]/dz - (3/2) * d[ (w'^2)^2 ]/dz. - ! - ! The turbulent advection and turbulent production terms are combined as: - ! - ! - (1/rho_ds) * d [ rho_ds * a_3 * (w'^2)^2 ] / dz - ! - (1/rho_ds) * d [ rho_ds * a_1 * ( (w'^3)^2 / w'^2 ) ] / dz - ! - (3/2) * d [ (w'^2)^2 ] / dz. - ! - ! The (w'^2)^2 and (w'^3)^2 terms are both linearized, such that: - ! - ! ( w'^2(t+1) )^2 = - ( w'^2(t) )^2 + 2 * w'^2(t) * w'^2(t+1); - ! ( w'^3(t+1) )^2 = - ( w'^3(t) )^2 + 2 * w'^3(t) * w'^3(t+1); - ! - ! which produces implicit and explicit portions of these terms. The - ! explicit portion of these terms is: - ! - ! + (1/rho_ds) * d [ rho_ds * a_3 * ( w'^2(t) )^2 ] / dz - ! + (1/rho_ds) * d [ rho_ds * a_1 * ( w'^3(t) )^2 / w'^2(t) ] / dz - ! + (3/2) * d [ ( w'^2(t) )^2 ] / dz. - ! - ! Timestep index (t) stands for the index of the current timestep, while - ! timestep index (t+1) stands for the index of the next timestep, which is - ! being advanced to in solving the d(w'^3)/dt and d(w'^2)/dt equations. - ! - ! The explicit portion of these terms is discretized as follows: - ! - ! The values of w'^3 are found on the thermodynamic levels, while the values - ! of w'^2, a_1, and a_3 are found on the momentum levels. Additionally, the - ! values of rho_ds_zm are found on the momentum levels, and the values of - ! invrs_rho_ds_zt are found on the thermodynamic levels. The variable w'^3 - ! is interpolated to the intermediate momentum levels. The values of the - ! mathematical expressions (called F, G, and H here) within the dF/dz, - ! dG/dz, and dH/dz terms are computed on the momentum levels. Then, the - ! derivatives (d/dz) of the expressions (F, G, and H) are taken over the - ! central thermodynamic level, where dF/dz and dG/dz are multiplied by - ! invrs_rho_ds_zt, and where dH/dz is multiplied by 3/2. This yields the - ! desired results. In this function, the values of F, G, and H are as - ! follows: - ! - ! F = rho_ds_zm * a_3(t) * ( w'^2(t) )^2; - ! - ! G = rho_ds_zm * a_1(t) * ( w'^3(t) )^2 / w'^2(t); and - ! - ! H = ( w'^2(t) )^2. - ! - ! - ! ------------------------------------------------wp3p1-------------- t(k+1) - ! - ! ===a3====wp2====rho_ds_zm====a1======================wp3(interp)=== m(k) - ! - ! ---dH/dz---dF/dz----invrs_rho_ds_zt----dG/dz----wp3---------------- t(k) - ! - ! ===a3m1==wp2m1==rho_ds_zmm1==a1m1====================wp3(interp)=== m(k-1) - ! - ! ------------------------------------------------wp3m1-------------- t(k-1) - ! - ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond - ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively. - ! The letter "t" is used for thermodynamic levels and the letter "m" is used - ! for momentum levels. - ! - ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) - - ! References: - !----------------------------------------------------------------------- - -! use constants_clubb, only: & -! w_tol_sqd - -! use model_flags, only: & -! l_standard_term_ta - -! implicit none - - ! Input Variables -! real, intent(in) :: & -! wp3_zm, & ! w'^3 interpolated to momentum lev. (k) [m^3/s^3] -! wp3_zmm1, & ! w'^3 interpolated to momentum lev. (k-1) [m^3/s^3] -! wp2, & ! w'^2(k) [m^2/s^2] -! wp2m1, & ! w'^2(k-1) [m^2/s^2] -! a1, & ! a_1(k) [-] -! a1_zt, & ! a_1 interpolated to thermo. level (k) [-] -! a1m1, & ! a_1(k-1) [-] -! a3, & ! a_3(k) [-] -! a3_zt, & ! a_3 interpolated to thermo. level (k) [-] -! a3m1, & ! a_3(k-1) [-] -! wp3_on_wp2, & ! (k) [m/s] -! wp3_on_wp2_m1, & ! (k-1) [m/s] -! rho_ds_zm, & ! Dry, static density at moment. lev (k) [kg/m^3] -! rho_ds_zmm1, & ! Dry, static density at moment. lev (k-1) [kg/m^3] -! invrs_rho_ds_zt, & ! Inv dry, static density @ thermo lev (k) [m^3/kg] -! const_three_halves, & ! "3/2" ("0" is sent in for wp3_ta budget) [-] -! invrs_dzt ! Inverse of grid spacing (k) [1/m] - - ! Return Variable -! real :: rhs - - -! if ( l_standard_term_ta ) then - - ! The turbulent advection term is discretized normally, in accordance - ! with the model equations found in the documentation and the description - ! listed above. - -! rhs & -! = + invrs_rho_ds_zt & -! * invrs_dzt & -! * ( rho_ds_zm * a3 * wp2**2 & -! - rho_ds_zmm1 * a3m1 * wp2m1**2 & -! ) & -! + invrs_rho_ds_zt & -! * invrs_dzt & -! * ( rho_ds_zm * a1 & -! * wp3_zm * wp3_on_wp2 & -! - rho_ds_zmm1 * a1m1 & -! * wp3_zmm1 * wp3_on_wp2_m1 & -! ) & -! + const_three_halves & -! * invrs_dzt * ( wp2**2 - wp2m1**2 ) - -! else - - ! Brian tried a new discretization for the turbulent advection term, - ! which contains the term: - ! - (1/rho_ds) * d [ rho_ds * a_1 * (w'^3)^2 / w'^2 ] / dz. In order - ! to help stabilize w'^3, a_1 has been pulled outside of the derivative. - ! This effects the right-hand side of the equation, as well as the - ! left-hand side. - - ! Additionally, the discretization of the turbulent advection term, which - ! contains the term: - ! - (1/rho_ds) * d [ rho_ds * (a_3 + 3) * (w'^2)^2 ] / dz, has been - ! altered to pull (a_3 + 3) outside of the derivative. This was done in - ! order to help stabilize w'^3. This effects the right-hand side of the - ! equation, as well as the left-hand side. - -! rhs & -! = + invrs_rho_ds_zt & -! * a3_zt * invrs_dzt & -! * ( rho_ds_zm * wp2**2 & -! - rho_ds_zmm1 * wp2m1**2 ) & -! + invrs_rho_ds_zt & -! * a1_zt * invrs_dzt & -! * ( rho_ds_zm & -! * ( wp3_zm * wp3_on_wp2 ) & -! - rho_ds_zmm1 & -! * ( wp3_zmm1 * wp3_on_wp2_m1 ) & -! ) & -! + const_three_halves & -! * invrs_dzt * ( wp2**2 - wp2m1**2 ) - - ! End of code that pulls out a3. - ! End of Brian's a1 change. Feb. 14, 2008. - -! endif ! l_standard_term_ta - - -! return -! end function wp3_terms_ta_tp_rhs - - !============================================================================= - pure function wp3_terms_bp1_pr2_rhs( C11_Skw_fnc, thv_ds_zt, wp2thvp ) & - result( rhs ) - - ! Description: - ! Buoyancy production of w'^3 and w'^3 pressure term 2: explicit portion of - ! the code. - ! - ! The d(w'^3)/dt equation contains a buoyancy production term: - ! - ! + 3 (g/thv_ds) w'^2th_v'; - ! - ! and pressure term 2: - ! - ! - C_11 ( -3 w'^3 dw/dz + 3 (g/thv_ds) w'^2th_v' ). - ! - ! The w'^3 buoyancy production term is completely explicit, while w'^3 - ! pressure term 2 has both implicit and explicit components. The buoyancy - ! production term and the explicit portion of pressure term 2 are combined - ! and solved together as: - ! - ! + ( 1 - C_ll ) ( 3 (g/thv_ds) w'^2th_v' ). - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_constants_clubb, only: & ! Constant(s) - grav ! Gravitational acceleration [m/s^2] - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C11_Skw_fnc, & ! C_11 parameter with Sk_w applied (k) [-] - thv_ds_zt, & ! Dry, base-state theta_v at thermo. lev. (k) [K] - wp2thvp ! w'^2th_v'(k) [K m^2/s^2] - - ! Return Variable - real( kind = core_rknd ) :: rhs - - rhs & - = + ( 1.0_core_rknd - C11_Skw_fnc ) * 3.0_core_rknd * ( grav / thv_ds_zt ) * wp2thvp - - return - end function wp3_terms_bp1_pr2_rhs - - !============================================================================= - pure function wp3_term_bp2_rhs( C15, Kh_zt, wpthvp, wpthvp_m1, & - dum_dz, dum_dz_m1, dvm_dz, dvm_dz_m1, & - upwp, upwp_m1, vpwp, vpwp_m1, & - thv_ds_zt, invrs_dzt ) & - result( rhs ) - - ! Description: - ! Experimental term from CLUBB TRAC ticket #411. The derivative here is of - ! the form: - ! - C_15 * Kh * ∂{ grav / thv_ds * [w'th_v'(k) - w'th_v'(k-1)] - ! -[ u'w'(k) * ∂u(k)/∂z - u'w'(k-1) * ∂u(k-1)/∂z ] - ! -[ v'w'(k) * ∂v(k)/∂z - v'w'(k-1) * ∂v(k-1)/∂z ] }/∂z. - ! - ! This does not appear in Andre et al. 1976 or Bougeault et al. 1981, but - ! is based on experiments in matching LES data. - ! - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_constants_clubb, only: & ! Constant(s) - grav ! Gravitational acceleration [m/s^2] - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C15, & ! Model parameter C15 [-] - Kh_zt, & ! Eddy-diffusivity on moment. levels [m^2/s] - wpthvp, & ! w'th_v'(k) [K m/s] - wpthvp_m1, & ! w'th_v'(k-1) [K m/s] - dum_dz, & ! d u wind dz (k) [m/s] - dvm_dz, & ! d v wind dz (k) [m/s] - dum_dz_m1, & ! d u wind dz (k-1) [m/s] - dvm_dz_m1, & ! d v wind dz (k-1) [m/s] - upwp, & ! u'v'(k) [m^2/s^2] - upwp_m1, & ! u'v'(k-1) [m^2/s^2] - vpwp, & ! v'w'(k) [m^2/s^2] - vpwp_m1, & ! v'w'(k-1) [m^2/s^2] - thv_ds_zt, & ! Dry, base-state theta_v at thermo. lev. (k) [K] - invrs_dzt ! Inverse of grid spacing (k) [1/m] - - ! Return Variable - real( kind = core_rknd ) :: rhs - - ! ---- Begin Code ---- - -! rhs = - C15 * Kh_zt * invrs_dzt * grav / thv_ds_zt * ( wpthvp - wpthvp_m1 ) - - rhs = - C15 * Kh_zt * invrs_dzt * & - ( grav / thv_ds_zt * ( wpthvp - wpthvp_m1 ) & - - ( upwp * dum_dz - upwp_m1 * dum_dz_m1 ) & - - ( vpwp * dvm_dz - vpwp_m1 * dvm_dz_m1 ) ) - - return - end function wp3_term_bp2_rhs - - - !============================================================================= - pure function wp3_term_pr1_rhs( C8, C8b, tauw3t, Skw_zt, wp3 ) & - result( rhs ) - - ! Description: - ! Pressure term 1 for w'^3: explicit portion of the code. - ! - ! Pressure term 1 is the term: - ! - ! - (C_8/tau_w3t) * ( C_8b * Sk_wt^4 + 1 ) * w'^3; - ! - ! where Sk_wt = w'^3 / (w'^2)^(3/2). - ! - ! This term needs to be linearized, so function L(w'^3) is defined to be - ! equal to this term (pressure term 1), such that: - ! - ! L(w'^3) = - (C_8/tau_w3t) * ( C_8b * (w'^3)^5 / (w'^2)^6 + w'^3 ). - ! - ! A Taylor Series expansion (truncated after the first derivative term) of - ! L(w'^3) around w'^3 = w'^3(t) is used to linearize pressure term 1. - ! Evaluating L(w'^3) at w'^3(t+1): - ! - ! L( w'^3(t+1) ) = L( w'^3(t) ) - ! + ( d L(w'^3) / d w'^3 )|_(w'^3=w'^3(t)) - ! * ( w'^3(t+1) - w'^3(t) ). - ! - ! After evaluating the expression above, the term has become linearized. It - ! is broken down into implicit (LHS) and explicit (RHS) components. - ! The explicit portion is: - ! - ! + (C_8/tau_w3t) * ( 4 * C_8b * Sk_wt^4 + 1 ) * w'^3(t). - ! - ! Timestep index (t) stands for the index of the current timestep, while - ! timestep index (t+1) stands for the index of the next timestep, which is - ! being advanced to in solving the d(w'^3)/dt equation. - ! - ! The values of w'^3 are found on the thermodynamic levels, as are the - ! values of tau_w3t and Sk_wt (in Sk_wt, w'^3 is found on thermodynamic - ! levels and w'^2 is interpolated to thermodynamic levels). - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C8, & ! Model parameter C_8 [-] - C8b, & ! Model parameter C_8b [-] - tauw3t, & ! Time-scale tau at thermodynamic levels (k) [s] - Skw_zt, & ! Skewness of w at thermodynamic levels (k) [-] - wp3 ! w'^3(k) [m^3/s^3] - - ! Return Variable - real( kind = core_rknd ) :: rhs - - rhs & - = + ( C8 / tauw3t ) * ( 4.0_core_rknd * C8b * Skw_zt**4 ) * wp3 - - return - end function wp3_term_pr1_rhs - -!=============================================================================== - -end module crmx_advance_wp2_wp3_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_advance_xm_wpxp_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_advance_xm_wpxp_module.F90 deleted file mode 100644 index 160755b817..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_advance_xm_wpxp_module.F90 +++ /dev/null @@ -1,3213 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: advance_xm_wpxp_module.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ -!=============================================================================== -module crmx_advance_xm_wpxp_module - - ! Description: - ! Contains the CLUBB advance_xm_wpxp_module scheme. - - ! References: - ! None - !----------------------------------------------------------------------- - - implicit none - - private ! Default scope - - public :: advance_xm_wpxp - - private :: xm_wpxp_lhs, & - xm_wpxp_rhs, & - xm_wpxp_solve, & - xm_wpxp_clipping_and_stats, & - xm_term_ta_lhs, & - wpxp_term_ta_lhs, & - wpxp_term_tp_lhs, & - wpxp_terms_ac_pr2_lhs, & - wpxp_term_pr1_lhs, & - wpxp_terms_bp_pr3_rhs, & - xm_correction_wpxp_cl, & - damp_coefficient - - ! Parameter Constants - integer, parameter, private :: & - nsub = 2, & ! Number of subdiagonals in the LHS matrix - nsup = 2, & ! Number of superdiagonals in the LHS matrix - xm_wpxp_thlm = 1, & ! Named constant for thlm solving - xm_wpxp_rtm = 2, & ! Named constant for rtm solving - xm_wpxp_scalar = 3 ! Named constant for scalar solving - - contains - - !============================================================================= - subroutine advance_xm_wpxp( dt, sigma_sqd_w, wm_zm, wm_zt, wp2, & - Lscale, wp3_on_wp2, wp3_on_wp2_zt, Kh_zt, & - tau_zm, Skw_zm, rtpthvp, rtm_forcing, & - wprtp_forcing, rtm_ref, thlpthvp, & - thlm_forcing, wpthlp_forcing, thlm_ref, & - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, thv_ds_zm, rtp2, thlp2, & - w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & - mixt_frac_zm, l_implemented, & - sclrpthvp, sclrm_forcing, sclrp2, & - rtm, wprtp, thlm, wpthlp, & - err_code, & - sclrm, wpsclrp ) - - ! Description: - ! Advance the mean and flux terms by one timestep. - - ! References: - ! Eqn. 16 & 17 on p. 3546 of - ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: - ! Method and Model Description'' Golaz, et al. (2002) - ! JAS, Vol. 59, pp. 3540--3551. - - ! See Also - ! ``Equations for CLUBB'' Section 5: - ! /Implicit solutions for the means and fluxes/ - !----------------------------------------------------------------------- - - use crmx_parameters_tunable, only: & - C6rt, & ! Variable(s) - C6rtb, & - C6rtc, & - C6thl, & - C6thlb, & - C6thlc, & - C7, & - C7b, & - C7c, & - c_K6, & - C6rt_Lscale0, & - C6thl_Lscale0, & - C7_Lscale0, & - wpxp_L_thresh - - use crmx_constants_clubb, only: & - fstderr, & ! Constant - rt_tol, & - thl_tol, & - thl_tol_mfl, & - rt_tol_mfl, & - max_mag_correlation, & - one, & - one_half, & - zero, & - zero_threshold - - use crmx_parameters_model, only: & - sclr_dim, & ! Variable(s) - sclr_tol - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_grid_class, only: & - zm2zt, & ! Procedure(s) - zt2zm - - use crmx_model_flags, only: & - l_clip_semi_implicit ! Variable(s) - - use crmx_mono_flux_limiter, only: & - calc_turb_adv_range ! Procedure(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_error_code, only: & - clubb_at_least_debug_level, & ! Procedure(s) - reportError, & - fatal_error - - use crmx_error_code, only: & - clubb_var_out_of_range ! Constant(s) - - use crmx_stats_type, only: & - stat_begin_update, & ! Procedure(s) - stat_end_update, & - stat_update_var - - use crmx_stats_variables, only: & - zt, & - zm, & - irtm_matrix_condt_num, & ! Variables - ithlm_matrix_condt_num, & - irtm_sdmp, ithlm_sdmp, & - l_stats_samp, & - iC7_Skw_fnc, & - iC6rt_Skw_fnc, & - iC6thl_Skw_fnc, & - l_stats_samp - - use crmx_sponge_layer_damping, only: & - rtm_sponge_damp_settings, & - thlm_sponge_damp_settings, & - rtm_sponge_damp_profile, & - thlm_sponge_damp_profile, & - sponge_damp_xm ! Procedure(s) - - implicit none - - ! External - intrinsic :: exp, sqrt - - ! Parameter Constants - logical, parameter :: & - l_iter = .true. ! True when the means and fluxes are prognosed - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Timestep [s] - - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - sigma_sqd_w, & ! sigma_sqd_w on momentum levels [-] - wm_zm, & ! w wind component on momentum levels [m/s] - wm_zt, & ! w wind component on thermodynamic levels [m/s] - wp2, & ! w'^2 (momentum levels) [m^2/s^2] - Lscale, & ! Turbulent mixing length [m] - wp3_on_wp2, & ! Smoothed wp3 / wp2 on momentum levels [m/s] - wp3_on_wp2_zt, & ! Smoothed wp3 / wp2 on thermo. levels [m/s] - Kh_zt, & ! Eddy diffusivity on thermodynamic levels [m^2/s] - tau_zm, & ! Time-scale tau on momentum levels [s] - Skw_zm, & ! Skewness of w on momentum levels [-] - rtpthvp, & ! r_t'th_v' (momentum levels) [(kg/kg) K] - rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] - wprtp_forcing, & ! forcing (momentum levels) [(kg/kg)/s^2] - rtm_ref, & ! rtm for nudging [kg/kg] - thlpthvp, & ! th_l'th_v' (momentum levels) [K^2] - thlm_forcing, & ! th_l forcing (thermodynamic levels) [K/s] - wpthlp_forcing, & ! forcing (momentum levels) [K/s^2] - thlm_ref, & ! thlm for nudging [K] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg] - invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] - thv_ds_zm, & ! Dry, base-state theta_v on moment. levs. [K] - ! Added for clipping by Vince Larson 29 Sep 2007 - rtp2, & ! r_t'^2 (momentum levels) [(kg/kg)^2] - thlp2, & ! th_l'^2 (momentum levels) [K^2] - ! End of Vince Larson's addition. - w1_zm, & ! Mean w (1st PDF component) [m/s] - w2_zm, & ! Mean w (2nd PDF component) [m/s] - varnce_w1_zm, & ! Variance of w (1st PDF component) [m^2/s^2] - varnce_w2_zm, & ! Variance of w (2nd PDF component) [m^2/s^2] - mixt_frac_zm ! Weight of 1st PDF component (Sk_w dependent) [-] - - logical, intent(in) :: & - l_implemented ! Flag for CLUBB being implemented in a larger model. - - - ! Additional variables for passive scalars - ! Input Variables - real( kind = core_rknd ), intent(in), dimension(gr%nz,sclr_dim) :: & - sclrpthvp, sclrm_forcing, & ! [Units vary] - sclrp2 ! For clipping Vince Larson [Units vary] - - ! Input/Output Variables - real( kind = core_rknd ), intent(inout), dimension(gr%nz) :: & - rtm, & ! r_t (total water mixing ratio) [kg/kg] - wprtp, & ! w'r_t' [(kg/kg) m/s] - thlm, & ! th_l (liquid water potential temperature) [K] - wpthlp ! w'th_l' [K m/s] - - integer, intent(inout) :: err_code ! Error code for the model's status - - ! Input/Output Variables - real( kind = core_rknd ), intent(inout), dimension(gr%nz,sclr_dim) :: & - sclrm, wpsclrp ! [Units vary] - - ! Local variables - real( kind = core_rknd ), dimension(nsup+nsub+1,2*gr%nz) :: & - lhs ! Implicit contributions to wpxp/xm (band diag. matrix) (LAPACK) - - real( kind = core_rknd ), dimension(gr%nz) :: & - C6rt_Skw_fnc, C6thl_Skw_fnc, C7_Skw_fnc - - ! Eddy Diffusion for wpthlp and wprtp. - real( kind = core_rknd ), dimension(gr%nz) :: Kw6 ! wpxp eddy diff. [m^2/s] - - real( kind = core_rknd ), dimension(gr%nz) :: & - a1, & ! a_1 (momentum levels); See eqn. 24 in `Equations for CLUBB' [-] - a1_zt ! a_1 interpolated to thermodynamic levels [-] - - ! Variables used as part of the monotonic turbulent advection scheme. - ! Find the lowermost and uppermost grid levels that can have an effect - ! on the central thermodynamic level during the course of a time step, - ! due to the effects of turbulent advection only. - integer, dimension(gr%nz) :: & - low_lev_effect, & ! Index of the lowest level that has an effect. - high_lev_effect ! Index of the highest level that has an effect. - - ! Variables used for clipping of w'x' due to correlation - ! of w with x, such that: - ! corr_(w,x) = w'x' / [ sqrt(w'^2) * sqrt(x'^2) ]; - ! -1 <= corr_(w,x) <= 1. - real( kind = core_rknd ), dimension(gr%nz) :: & - wpxp_upper_lim, & ! Keeps correlations from becoming greater than 1. - wpxp_lower_lim ! Keeps correlations from becoming less than -1. - - real( kind = core_rknd ), dimension(gr%nz) :: dummy_1d ! Unreferenced array - - real( kind = core_rknd ), allocatable, dimension(:,:) :: & - rhs, &! Right-hand sides of band diag. matrix. (LAPACK) - solution ! solution vectors of band diag. matrix. (LAPACK) - - ! Constant parameters as a function of Skw. - - integer :: & - nrhs, & ! Number of RHS vectors - err_code_xm_wpxp ! Error code - - real( kind = core_rknd ) :: rcond - - ! Indices - integer :: i - - !--------------------------------------------------------------------------- - - ! ----- Begin Code ----- - if ( l_clip_semi_implicit ) then - nrhs = 1 - else - nrhs = 2+sclr_dim - endif - - ! Allocate rhs and solution vector - allocate( rhs(2*gr%nz,nrhs) ) - allocate( solution(2*gr%nz,nrhs) ) - - ! This is initialized solely for the purpose of avoiding a compiler - ! warning about uninitialized variables. - dummy_1d = zero - - ! Compute C6 and C7 as a function of Skw - ! The if...then is just here to save compute time - if ( C6rt /= C6rtb ) then - C6rt_Skw_fnc(1:gr%nz) = C6rtb + (C6rt-C6rtb) & - *EXP( -one_half * (Skw_zm(1:gr%nz)/C6rtc)**2 ) - else - C6rt_Skw_fnc(1:gr%nz) = C6rtb - endif - - if ( C6thl /= C6thlb ) then - C6thl_Skw_fnc(1:gr%nz) = C6thlb + (C6thl-C6thlb) & - *EXP( -one_half * (Skw_zm(1:gr%nz)/C6thlc)**2 ) - else - C6thl_Skw_fnc(1:gr%nz) = C6thlb - endif - - if ( C7 /= C7b ) then - C7_Skw_fnc(1:gr%nz) = C7b + (C7-C7b) & - *EXP( -one_half * (Skw_zm(1:gr%nz)/C7c)**2 ) - else - C7_Skw_fnc(1:gr%nz) = C7b - endif - - ! Damp C6 and C7 as a function of Lscale in stably stratified regions - C7_Skw_fnc = damp_coefficient( C7, C7_Skw_fnc, & - C7_Lscale0, wpxp_L_thresh, Lscale ) - C6rt_Skw_fnc = damp_coefficient( C6rt, C6rt_Skw_fnc, & - C6rt_Lscale0, wpxp_L_thresh, Lscale ) - C6thl_Skw_fnc = damp_coefficient( C6thl, C6thl_Skw_fnc, & - C6thl_Lscale0, wpxp_L_thresh, Lscale ) - - ! C6rt_Skw_fnc = C6rt - ! C6thl_Skw_fnc = C6thl - ! C7_Skw_fnc = C7 - - if ( l_stats_samp ) then - - call stat_update_var( iC7_Skw_fnc, C7_Skw_fnc, zm ) - call stat_update_var( iC6rt_Skw_fnc, C6rt_Skw_fnc, zm ) - call stat_update_var( iC6thl_Skw_fnc, C6thl_Skw_fnc, zm ) - - end if - - if ( clubb_at_least_debug_level( 2 ) ) then - ! Assertion check for C7_Skw_fnc - if ( any( C7_Skw_fnc(:) > one ) .or. any( C7_Skw_fnc(:) < zero ) ) then - write(fstderr,*) "The C7_Skw_fnc variable is outside the valid range" - err_code = clubb_var_out_of_range - return - end if - end if - - ! Define the Coefficent of Eddy Diffusivity for the wpthlp and wprtp. - ! Kw6 is used for wpthlp and wprtp, which are located on momentum levels. - ! Kw6 is located on thermodynamic levels. - ! Kw6 = c_K6 * Kh_zt - - Kw6(1:gr%nz) = c_K6 * Kh_zt(1:gr%nz) - - ! Find the number of grid levels, both upwards and downwards, that can - ! have an effect on the central thermodynamic level during the course of - ! one time step due to turbulent advection. This is used as part of the - ! monotonic turbulent advection scheme. - call calc_turb_adv_range( dt, w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & ! In - mixt_frac_zm, & ! In - low_lev_effect, high_lev_effect ) ! Out - - - ! Define a_1 (located on momentum levels). - ! It is a variable that is a function of sigma_sqd_w (where sigma_sqd_w is - ! located on momentum levels). - a1(1:gr%nz) = one / ( one - sigma_sqd_w(1:gr%nz) ) - - ! Interpolate a_1 from momentum levels to thermodynamic levels. This will - ! be used for the w'x' turbulent advection (ta) term. - a1_zt = max( zm2zt( a1 ), zero_threshold ) ! Positive definite quantity - - ! Setup and decompose matrix for each variable. - - if ( l_clip_semi_implicit ) then - - ! Compute the upper and lower limits of w'r_t' at every level, - ! based on the correlation of w and r_t, such that: - ! corr_(w,r_t) = w'r_t' / [ sqrt(w'^2) * sqrt(r_t'^2) ]; - ! -1 <= corr_(w,r_t) <= 1. - if ( l_clip_semi_implicit ) then - wpxp_upper_lim = max_mag_correlation * sqrt( wp2 * rtp2 ) - wpxp_lower_lim = -wpxp_upper_lim - endif - - ! Compute the implicit portion of the r_t and w'r_t' equations. - ! Build the left-hand side matrix. - call xm_wpxp_lhs( l_iter, dt, wprtp, a1, a1_zt, wm_zm, wm_zt, & ! Intent(in) - wp2, wp3_on_wp2, wp3_on_wp2_zt, & ! Intent(in) - Kw6, tau_zm, C7_Skw_fnc, & ! Intent(in) - C6rt_Skw_fnc, rho_ds_zm, rho_ds_zt, & ! Intent(in) - invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) - wpxp_upper_lim, wpxp_lower_lim, l_implemented, & ! Intent(in) - lhs ) ! Intent(out) - - ! Compute the explicit portion of the r_t and w'r_t' equations. - ! Build the right-hand side vector. - call xm_wpxp_rhs( xm_wpxp_rtm, l_iter, dt, rtm, wprtp, & ! Intent(in) - rtm_forcing, wprtp_forcing, C7_Skw_fnc, & ! Intent(in) - rtpthvp, C6rt_Skw_fnc, tau_zm, a1, a1_zt, & ! Intent(in) - wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & ! Intent(in) - rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & ! Intent(in) - wpxp_upper_lim, wpxp_lower_lim, & ! Intent(in) - rhs(:,1) ) ! Intent(out) - - ! Solve r_t / w'r_t' - if ( l_stats_samp .and. irtm_matrix_condt_num > 0 ) then - call xm_wpxp_solve( nrhs, & ! Intent(in) - lhs, rhs, & ! Intent(inout) - solution, err_code_xm_wpxp, rcond ) ! Intent(out) - else - call xm_wpxp_solve( nrhs, & ! Intent(in) - lhs, rhs, & ! Intent(inout) - solution, err_code_xm_wpxp ) ! Intent(out) - endif - - if ( fatal_error( err_code_xm_wpxp ) ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,'(a)') "Mean total water & total water flux LU decomp. failed" - call reportError( err_code_xm_wpxp ) - end if - - ! Overwrite the current error status with the new fatal error - err_code = err_code_xm_wpxp - - end if - - call xm_wpxp_clipping_and_stats & - ( xm_wpxp_rtm, dt, wp2, rtp2, wm_zt, & ! Intent(in) - rtm_forcing, rho_ds_zm, rho_ds_zt, & ! Intent(in) - invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) - rt_tol**2, rt_tol, rcond, & ! Intent(in) - low_lev_effect, high_lev_effect, & ! Intent(in) - l_implemented, solution(:,1), & ! Intent(in) - rtm, rt_tol_mfl, wprtp, & ! Intent(inout) - err_code_xm_wpxp ) ! Intent(out) - - if ( fatal_error( err_code_xm_wpxp ) ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,'(a)') "rtm monotonic flux limiter: tridag failed" - call reportError( err_code_xm_wpxp ) - end if - - ! Overwrite the current error status with the new fatal error - err_code = err_code_xm_wpxp - - end if - - - ! Compute the upper and lower limits of w'th_l' at every level, - ! based on the correlation of w and th_l, such that: - ! corr_(w,th_l) = w'th_l' / [ sqrt(w'^2) * sqrt(th_l'^2) ]; - ! -1 <= corr_(w,th_l) <= 1. - if ( l_clip_semi_implicit ) then - wpxp_upper_lim = max_mag_correlation * sqrt( wp2 * thlp2 ) - wpxp_lower_lim = -wpxp_upper_lim - endif - - ! Compute the implicit portion of the th_l and w'th_l' equations. - ! Build the left-hand side matrix. - call xm_wpxp_lhs( l_iter, dt, wpthlp, a1, a1_zt, wm_zm, wm_zt, & ! Intent(in) - wp2, wp3_on_wp2, wp3_on_wp2_zt, & ! Intent(in) - Kw6, tau_zm, C7_Skw_fnc, & ! Intent(in) - C6thl_Skw_fnc, rho_ds_zm, rho_ds_zt, & ! Intent(in) - invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) - wpxp_upper_lim, wpxp_lower_lim, l_implemented, & ! Intent(in) - lhs ) ! Intent(out) - - ! Compute the explicit portion of the th_l and w'th_l' equations. - ! Build the right-hand side vector. - call xm_wpxp_rhs( xm_wpxp_thlm, l_iter, dt, thlm, wpthlp, & ! Intent(in) - thlm_forcing, wpthlp_forcing, C7_Skw_fnc, & ! Intent(in) - thlpthvp, C6thl_Skw_fnc, tau_zm, a1, a1_zt, & ! Intent(in) - wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & ! Intent(in) - rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & ! Intent(in) - wpxp_upper_lim, wpxp_lower_lim, & ! Intent(in) - rhs(:,1) ) ! Intent(out) - - ! Solve for th_l / w'th_l' - if ( l_stats_samp .and. ithlm_matrix_condt_num > 0 ) then - call xm_wpxp_solve( nrhs, & ! Intent(in) - lhs, rhs, & ! Intent(inout) - solution, err_code_xm_wpxp, rcond ) ! Intent(out) - else - call xm_wpxp_solve( nrhs, & ! Intent(in) - lhs, rhs, & ! Intent(inout) - solution, err_code_xm_wpxp ) ! Intent(out) - endif - - if ( fatal_error( err_code_xm_wpxp ) ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,'(a)') "Liquid pot. temp & thetal flux LU decomp. failed" - call reportError( err_code_xm_wpxp ) - end if - - ! Overwrite the current error status with the new fatal error - err_code = err_code_xm_wpxp - - end if - - call xm_wpxp_clipping_and_stats & - ( xm_wpxp_thlm, dt, wp2, thlp2, wm_zt, & ! Intent(in) - thlm_forcing, rho_ds_zm, rho_ds_zt, & ! Intent(in) - invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) - thl_tol**2, thl_tol, rcond, & ! Intent(in) - low_lev_effect, high_lev_effect, & ! Intent(in) - l_implemented, solution(:,1), & ! Intent(in) - thlm, thl_tol_mfl, wpthlp, & ! Intent(inout) - err_code_xm_wpxp ) ! Intent(out) - - if ( fatal_error( err_code_xm_wpxp ) ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,'(a)') "thlm monotonic flux limiter: tridag failed" - call reportError( err_code_xm_wpxp ) - end if - - ! Overwrite the current error status with the new fatal error - err_code = err_code_xm_wpxp - - end if - - ! Solve sclrm / wpsclrp - ! If sclr_dim is 0, then this loop will execute 0 times. -! ---> h1g, 2010-06-15 -! scalar transport, e.g, droplet and ice number concentration -! are handled in " advance_sclrm_Nd_module.F90 " -#ifdef GFDL - do i = 1, 0, 1 -#else - do i = 1, sclr_dim, 1 -#endif -! <--- h1g, 2010-06-15 - - ! Compute the upper and lower limits of w'sclr' at every level, - ! based on the correlation of w and sclr, such that: - ! corr_(w,sclr) = w'sclr' / [ sqrt(w'^2) * sqrt(sclr'^2) ]; - ! -1 <= corr_(w,sclr) <= 1. - if ( l_clip_semi_implicit ) then - wpxp_upper_lim(:) = max_mag_correlation * sqrt( wp2(:) * sclrp2(:,i) ) - wpxp_lower_lim(:) = -wpxp_upper_lim(:) - endif - - ! Compute the implicit portion of the sclr and w'sclr' equations. - ! Build the left-hand side matrix. - call xm_wpxp_lhs( l_iter, dt, wpsclrp(:,i), a1, a1_zt, wm_zm, wm_zt, & ! Intent(in) - wp2, wp3_on_wp2, wp3_on_wp2_zt, & ! Intent(in) - Kw6, tau_zm, C7_Skw_fnc, & ! Intent(in) - C6rt_Skw_fnc, rho_ds_zm, rho_ds_zt, & ! Intent(in) - invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) - wpxp_upper_lim, wpxp_lower_lim, l_implemented, & ! Intent(in) - lhs ) ! Intent(out) - - ! Compute the explicit portion of the sclrm and w'sclr' equations. - ! Build the right-hand side vector. - call xm_wpxp_rhs( xm_wpxp_scalar, l_iter, dt, sclrm(:,i), wpsclrp(:,i), & ! Intent(in) - sclrm_forcing(:,i), dummy_1d, C7_Skw_fnc, & ! Intent(in) - sclrpthvp(:,i), C6rt_Skw_fnc, tau_zm, a1, a1_zt, & ! Intent(in) - wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & ! Intent(in) - rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & ! Intent(in) - wpxp_upper_lim, wpxp_lower_lim, & ! Intent(in) - rhs(:,1) ) ! Intent(out) - - ! Solve for sclrm / w'sclr' - call xm_wpxp_solve( nrhs, & ! Intent(in) - lhs, rhs, & ! Intent(inout) - solution, err_code_xm_wpxp ) ! Intent(out) - - if ( fatal_error( err_code_xm_wpxp ) ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) "Passive scalar # ", i, " LU decomp. failed." - call reportError( err_code_xm_wpxp ) - end if - - ! Overwrite the current error status with the new fatal error - err_code = err_code_xm_wpxp - - end if - - call xm_wpxp_clipping_and_stats & - ( xm_wpxp_scalar, dt, wp2, sclrp2(:,i), & ! Intent(in) - wm_zt, sclrm_forcing(:,i), & ! Intent(in) - rho_ds_zm, rho_ds_zt, & ! Intent(in) - invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) - sclr_tol(i)**2, sclr_tol(i), rcond, & ! Intent(in) - low_lev_effect, high_lev_effect, & ! Intent(in) - l_implemented, solution(:,1), & ! Intent(in) - sclrm(:,i), sclr_tol(i), wpsclrp(:,i), & ! Intent(inout) - err_code_xm_wpxp ) ! Intent(out) - - if ( fatal_error( err_code_xm_wpxp ) ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) "sclrm # ", i, "monotonic flux limiter: tridag failed" - call reportError( err_code_xm_wpxp ) - end if - - ! Overwrite the current error status with the new fatal error - err_code = err_code_xm_wpxp - - end if - - enddo ! passive scalars - - else ! Simple case, where l_clip_semi_implicit is false - - ! Create the lhs once - call xm_wpxp_lhs( l_iter, dt, dummy_1d, a1, a1_zt, wm_zm, wm_zt, & ! Intent(in) - wp2, wp3_on_wp2, wp3_on_wp2_zt, & ! Intent(in) - Kw6, tau_zm, C7_Skw_fnc, & ! Intent(in) - C6rt_Skw_fnc, rho_ds_zm, rho_ds_zt, & ! Intent(in) - invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) - dummy_1d, dummy_1d, l_implemented, & ! Intent(in) - lhs ) ! Intent(out) - - ! Compute the explicit portion of the r_t and w'r_t' equations. - ! Build the right-hand side vector. - call xm_wpxp_rhs( xm_wpxp_rtm, l_iter, dt, rtm, wprtp, & ! Intent(in) - rtm_forcing, wprtp_forcing, C7_Skw_fnc, & ! Intent(in) - rtpthvp, C6rt_Skw_fnc, tau_zm, a1, a1_zt, & ! Intent(in) - wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & ! Intent(in) - rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & ! Intent(in) - wpxp_upper_lim, wpxp_lower_lim, & ! Intent(in) - rhs(:,1) ) ! Intent(out) - - ! Compute the explicit portion of the th_l and w'th_l' equations. - ! Build the right-hand side vector. - call xm_wpxp_rhs( xm_wpxp_thlm, l_iter, dt, thlm, wpthlp, & ! Intent(in) - thlm_forcing, wpthlp_forcing, C7_Skw_fnc, & ! Intent(in) - thlpthvp, C6thl_Skw_fnc, tau_zm, a1, a1_zt, & ! Intent(in) - wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & ! Intent(in) - rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & ! Intent(in) - wpxp_upper_lim, wpxp_lower_lim, & ! Intent(in) - rhs(:,2) ) ! Intent(out) - -! ---> h1g, 2010-06-15 -! scalar transport, e.g, droplet and ice number concentration -! are handled in " advance_sclrm_Nd_module.F90 " -#ifdef GFDL - do i = 1, 0, 1 -#else - do i = 1, sclr_dim, 1 -#endif -! <--- h1g, 2010-06-15 - - call xm_wpxp_rhs( xm_wpxp_scalar, l_iter, dt, sclrm(:,i), wpsclrp(:,i), & ! Intent(in) - sclrm_forcing(:,i), dummy_1d, C7_Skw_fnc, & ! Intent(in) - sclrpthvp(:,i), C6rt_Skw_fnc, tau_zm, a1, a1_zt, & ! Intent(in) - wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & ! Intent(in) - rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & ! Intent(in) - wpxp_upper_lim, wpxp_lower_lim, & ! Intent(in) - rhs(:,2+i) ) ! Intent(out) - - enddo - - ! Solve for all fields - if ( l_stats_samp .and. ithlm_matrix_condt_num + irtm_matrix_condt_num > 0 ) then - call xm_wpxp_solve( nrhs, & ! Intent(in) - lhs, rhs, & ! Intent(inout) - solution, err_code_xm_wpxp, rcond ) ! Intent(out) - else - call xm_wpxp_solve( nrhs, & ! Intent(in) - lhs, rhs, & ! Intent(inout) - solution, err_code_xm_wpxp ) ! Intent(out) - endif - - if ( fatal_error( err_code_xm_wpxp ) ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,'(a)') "xm_wpxp matrix LU decomp. failed" - call reportError( err_code_xm_wpxp ) - end if - - ! Overwrite the current error status with the new fatal error - err_code = err_code_xm_wpxp - - end if - - call xm_wpxp_clipping_and_stats & - ( xm_wpxp_rtm, dt, wp2, rtp2, wm_zt, & ! Intent(in) - rtm_forcing, rho_ds_zm, rho_ds_zt, & ! Intent(in) - invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) - rt_tol**2, rt_tol, rcond, & ! Intent(in) - low_lev_effect, high_lev_effect, & ! Intent(in) - l_implemented, solution(:,1), & ! Intent(in) - rtm, rt_tol_mfl, wprtp, & ! Intent(inout) - err_code_xm_wpxp ) ! Intent(out) - - if ( fatal_error( err_code_xm_wpxp ) ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,'(a)') "rtm monotonic flux limiter: tridag failed" - call reportError( err_code_xm_wpxp ) - end if - - ! Overwrite the current error status with the new fatal error - err_code = err_code_xm_wpxp - - end if - - call xm_wpxp_clipping_and_stats & - ( xm_wpxp_thlm, dt, wp2, thlp2, wm_zt, & ! Intent(in) - thlm_forcing, rho_ds_zm, rho_ds_zt, & ! Intent(in) - invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) - thl_tol**2, thl_tol, rcond, & ! Intent(in) - low_lev_effect, high_lev_effect, & ! Intent(in) - l_implemented, solution(:,2), & ! Intent(in) - thlm, thl_tol_mfl, wpthlp, & ! Intent(inout) - err_code_xm_wpxp ) ! Intent(out) - - if ( fatal_error( err_code_xm_wpxp ) ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,'(a)') "thlm monotonic flux limiter: tridag failed" - call reportError( err_code_xm_wpxp ) - end if - - ! Overwrite the current error status with the new fatal error - err_code = err_code_xm_wpxp - - end if - -! ---> h1g, 2010-06-15 -! scalar transport, e.g, droplet and ice number concentration -! are handled in " advance_sclrm_Nd_module.F90 " -#ifdef GFDL - do i = 1, 0, 1 -#else - do i = 1, sclr_dim, 1 -#endif -! <--- h1g, 2010-06-15 - - call xm_wpxp_clipping_and_stats & - ( xm_wpxp_scalar, dt, wp2, sclrp2(:,i), & ! Intent(in) - wm_zt, sclrm_forcing(:,i), & ! Intent(in) - rho_ds_zm, rho_ds_zt, & ! Intent(in) - invrs_rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) - sclr_tol(i)**2, sclr_tol(i), rcond, & ! Intent(in) - low_lev_effect, high_lev_effect, & ! Intent(in) - l_implemented, solution(:,2+i), & ! Intent(in) - sclrm(:,i), sclr_tol(i), wpsclrp(:,i), & ! Intent(inout) - err_code_xm_wpxp ) ! Intent(out) - - if ( fatal_error( err_code_xm_wpxp ) ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) "sclrm # ", i, "monotonic flux limiter: tridag failed" - call reportError( err_code_xm_wpxp ) - end if - - ! Overwrite the current error status with the new fatal error - err_code = err_code_xm_wpxp - - end if - - end do ! 1..sclr_dim - - end if ! l_clip_semi_implicit - - ! De-allocate memory - deallocate( rhs, solution ) - - ! Error Report - ! Joshua Fasching Feb 2008 - if ( fatal_error( err_code ) .and. clubb_at_least_debug_level( 1 ) ) then - - write(fstderr,*) "Error in advance_xm_wpxp" - - write(fstderr,*) "Intent(in)" - - write(fstderr,*) "dt = ", dt - write(fstderr,*) "sigma_sqd_w = ", sigma_sqd_w - write(fstderr,*) "wm_zm = ", wm_zm - write(fstderr,*) "wm_zt = ", wm_zt - write(fstderr,*) "wp2 = ", wp2 - write(fstderr,*) "wp3_on_wp2 = ", wp3_on_wp2 - write(fstderr,*) "wp3_on_wp2_zt = ", wp3_on_wp2_zt - write(fstderr,*) "Kh_zt = ", Kh_zt - write(fstderr,*) "tau_zm = ", tau_zm - write(fstderr,*) "Skw_zm = ", Skw_zm - write(fstderr,*) "rtpthvp = ", rtpthvp - write(fstderr,*) "rtm_forcing = ", rtm_forcing - write(fstderr,*) "wprtp_forcing = ", wprtp_forcing - write(fstderr,*) "rtm_ref = ", rtm_ref - write(fstderr,*) "thlpthvp = ", thlpthvp - write(fstderr,*) "thlm_forcing = ", thlm_forcing - write(fstderr,*) "wpthlp_forcing = ", wpthlp_forcing - write(fstderr,*) "thlm_ref = ", thlm_ref - write(fstderr,*) "rho_ds_zm = ", rho_ds_zm - write(fstderr,*) "rho_ds_zt = ", rho_ds_zt - write(fstderr,*) "invrs_rho_ds_zm = ", invrs_rho_ds_zm - write(fstderr,*) "invrs_rho_ds_zt = ", invrs_rho_ds_zt - write(fstderr,*) "thv_ds_zm = ", thv_ds_zm - write(fstderr,*) "rtp2 = ", rtp2 - write(fstderr,*) "thlp2 = ", thlp2 - write(fstderr,*) "w1_zm = ", w1_zm - write(fstderr,*) "w2_zm = ", w2_zm - write(fstderr,*) "varnce_w1_zm = ", varnce_w1_zm - write(fstderr,*) "varnce_w2_zm = ", varnce_w2_zm - write(fstderr,*) "mixt_frac_zm = ", mixt_frac_zm - write(fstderr,*) "l_implemented = ", l_implemented - - if ( sclr_dim > 0 ) then - write(fstderr,*) "sclrp2 = ", sclrp2 - write(fstderr,*) "sclrpthvp = ", sclrpthvp - write(fstderr,*) "sclrm_forcing = ", sclrm_forcing - end if - - write(fstderr,*) "Intent(inout)" - - write(fstderr,*) "rtm = ", rtm - write(fstderr,*) "wprtp = ", wprtp - write(fstderr,*) "thlm = ", thlm - write(fstderr,*) "wpthlp =", wpthlp - - if ( sclr_dim > 0 ) then - write(fstderr,*) "sclrm = ", sclrm - write(fstderr,*) "wpsclrp = ", wpsclrp - end if - - end if ! Fatal error and debug_level >= 1 - - if ( rtm_sponge_damp_settings%l_sponge_damping ) then - if( l_stats_samp ) then - call stat_begin_update( irtm_sdmp, rtm / real( dt, kind = core_rknd ), zt ) - end if - rtm(1:gr%nz) = sponge_damp_xm( dt, rtm_ref(1:gr%nz), rtm(1:gr%nz), & - rtm_sponge_damp_profile ) - - if( l_stats_samp ) then - call stat_end_update( irtm_sdmp, rtm / real( dt, kind = core_rknd ), zt ) - end if - endif - - if ( thlm_sponge_damp_settings%l_sponge_damping ) then - if( l_stats_samp ) then - call stat_begin_update( ithlm_sdmp, thlm / real( dt, kind = core_rknd ), zt ) - end if - thlm(1:gr%nz) = sponge_damp_xm( dt, thlm_ref(1:gr%nz), thlm(1:gr%nz), & - thlm_sponge_damp_profile ) - if( l_stats_samp ) then - call stat_end_update( ithlm_sdmp, thlm / real( dt, kind = core_rknd ), zt ) - end if - endif - - return - - end subroutine advance_xm_wpxp - - !============================================================================= - subroutine xm_wpxp_lhs( l_iter, dt, wpxp, a1, a1_zt, wm_zm, wm_zt, & - wp2, wp3_on_wp2, wp3_on_wp2_zt, & - Kw6, tau_zm, C7_Skw_fnc, & - C6x_Skw_fnc, rho_ds_zm, rho_ds_zt, & - invrs_rho_ds_zm, invrs_rho_ds_zt, & - wpxp_upper_lim, wpxp_lower_lim, l_implemented, & - lhs ) - - ! Description: - ! Compute LHS band diagonal matrix for xm and w'x'. - ! This subroutine computes the implicit portion of - ! the xm and w'x' equations. - - ! References: - ! None - !------------------------------------------------------------------------ - - use crmx_parameters_tunable, only: & - nu6_vert_res_dep ! Variable(s) - - use crmx_grid_class, only: & - gr, & ! Variable(s) - zm2zt ! Procedure(s) - - use crmx_constants_clubb, only: & - gamma_over_implicit_ts, & ! Constant(s) - one, & - zero - - use crmx_model_flags, only: & - l_clip_semi_implicit, & ! Variable(s) - l_upwind_wpxp_ta - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_diffusion, only: & - diffusion_zm_lhs ! Procedure(s) - - use crmx_mean_adv, only: & - term_ma_zt_lhs, & ! Procedure(s) - term_ma_zm_lhs - - use crmx_clip_semi_implicit, only: & - clip_semi_imp_lhs ! Procedure(s) - - use crmx_stats_variables, only: & - ztscr01, & ! Variable(s) - ztscr02, & - ztscr03, & - ztscr04, & - ztscr05, & - zmscr01, & - zmscr02, & - zmscr03, & - zmscr04, & - zmscr05, & - zmscr06, & - zmscr07, & - zmscr08, & - zmscr09, & - zmscr10, & - zmscr11, & - zmscr12, & - zmscr13, & - zmscr14, & - zmscr15 - - use crmx_stats_variables, only: & - l_stats_samp, & - ithlm_ma, & - ithlm_ta, & - irtm_ma, & - irtm_ta, & - iwpthlp_ma, & - iwpthlp_ta, & - iwpthlp_tp, & - iwpthlp_ac, & - iwpthlp_pr1, & - iwpthlp_pr2, & - iwpthlp_dp1, & - iwpthlp_sicl, & - iwprtp_ma, & - iwprtp_ta, & - iwprtp_tp, & - iwprtp_ac, & - iwprtp_pr1, & - iwprtp_pr2, & - iwprtp_dp1, & - iwprtp_sicl - - use crmx_advance_helper_module, only: set_boundary_conditions_lhs ! Procedure(s) - - - implicit none - - ! External - intrinsic :: min, max - - ! Constant parameters - ! Left-hand side matrix diagonal identifiers for - ! momentum-level variable, w'x'. - integer, parameter :: & - m_kp1_mdiag = 1, & ! Momentum superdiagonal index for w'x'. - m_kp1_tdiag = 2, & ! Thermodynamic superdiagonal index for w'x'. - m_k_mdiag = 3, & ! Momentum main diagonal index for w'x'. - m_k_tdiag = 4, & ! Thermodynamic subdiagonal index for w'x'. - m_km1_mdiag = 5 ! Momentum subdiagonal index for w'x'. - - ! Left-hand side matrix diagonal identifiers for - ! thermodynamic-level variable, xm. - integer, parameter :: & - t_kp1_tdiag = 1, & ! Thermodynamic superdiagonal index for xm. - t_k_mdiag = 2, & ! Momentum superdiagonal index for xm. - t_k_tdiag = 3, & ! Thermodynamic main diagonal index for xm. - t_km1_mdiag = 4, & ! Momentum subdiagonal index for xm. - t_km1_tdiag = 5 ! Thermodynamic subdiagonal index for xm. - - ! Input variables - logical, intent(in) :: l_iter - - real(kind=time_precision), intent(in) :: & - dt ! Timestep [s] - - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - wpxp, & ! w'x' (momentum levels) at timestep (t) [{xm units} m/s] - a1, & ! a_1 (momentum levels) [-] - a1_zt, & ! a_1 interpolated to thermodynamic levels [-] - wm_zm, & ! w wind component on momentum levels [m/s] - wm_zt, & ! w wind component on thermodynamic levels [m/s] - wp2, & ! w'^2 (momentum levels) [m^2/s^2] - wp3_on_wp2, & ! Smoothed wp3 / wp2 on momentum levels [m/s] - wp3_on_wp2_zt, & ! Smoothed wp3 / wp2 on thermo. levels [m/s] - Kw6, & ! Coefficient of eddy diffusivity for w'x' [m^2/s] - tau_zm, & ! Time-scale tau on momentum levels [s] - C7_Skw_fnc, & ! C_7 parameter with Sk_w applied [-] - C6x_Skw_fnc, & ! C_6x parameter with Sk_w applied [-] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg] - invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] - wpxp_upper_lim, & ! Keeps correlations from becoming > 1. [units vary] - wpxp_lower_lim ! Keeps correlations from becoming < -1. [units vary] - - logical, intent(in) :: & - l_implemented ! Flag for CLUBB being implemented in a larger model. - - ! Output Variable - real( kind = core_rknd ), intent(out), dimension(nsup+nsub+1,2*gr%nz) :: & - lhs ! Implicit contributions to wpxp/xm (band diag. matrix) (LAPACK) - - ! Local Variables - - ! Indices - integer :: k, kp1, km1 - integer :: k_xm, k_wpxp - integer :: k_wpxp_low, k_wpxp_high - - real( kind = core_rknd ), dimension(3) :: tmp - - logical :: l_upper_thresh, l_lower_thresh ! flags for clip_semi_imp_lhs - - - ! Initialize the left-hand side matrix to 0. - lhs = zero - - ! The xm loop runs between k = 2 and k = gr%nz. The value of xm at - ! level k = 1, which is below the model surface, is simply set equal to the - ! value of xm at level k = 2 after the solve has been completed. - - do k = 2, gr%nz, 1 - - ! Define indices - - km1 = max( k-1, 1 ) - - k_xm = 2*k - 1 - ! k_wpxp is 2*k - - - !!!!!***** xm *****!!!!! - - ! xm: Left-hand side (implicit xm portion of the code). - ! - ! Thermodynamic subdiagonal (lhs index: t_km1_tdiag) - ! [ x xm(k-1,) ] - ! Momentum subdiagonal (lhs index: t_km1_mdiag) - ! [ x wpxp(k-1,) ] - ! Thermodynamic main diagonal (lhs index: t_k_tdiag) - ! [ x xm(k,) ] - ! Momentum superdiagonal (lhs index: t_k_mdiag) - ! [ x wpxp(k,) ] - ! Thermodynamic superdiagonal (lhs index: t_kp1_tdiag) - ! [ x xm(k+1,) ] - - ! LHS mean advection (ma) term. - if ( .not. l_implemented ) then - - lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_xm) & - = lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_xm) & - + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) - - else - - lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_xm) & - = lhs((/t_kp1_tdiag,t_k_tdiag,t_km1_tdiag/),k_xm) + zero - - endif - - ! LHS turbulent advection (ta) term. - lhs((/t_k_mdiag,t_km1_mdiag/),k_xm) & - = lhs((/t_k_mdiag,t_km1_mdiag/),k_xm) & - + xm_term_ta_lhs( rho_ds_zm(k), rho_ds_zm(km1), & - invrs_rho_ds_zt(k), gr%invrs_dzt(k) ) - - ! LHS time tendency. - lhs(t_k_tdiag,k_xm) & - = lhs(t_k_tdiag,k_xm) + one / real( dt, kind = core_rknd ) - - if (l_stats_samp) then - - ! Statistics: implicit contributions for rtm or thlm. - - if ( irtm_ma > 0 .or. ithlm_ma > 0 ) then - if ( .not. l_implemented ) then - tmp(1:3) = & - + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) - ztscr01(k) = - tmp(3) - ztscr02(k) = - tmp(2) - ztscr03(k) = - tmp(1) - else - ztscr01(k) = zero - ztscr02(k) = zero - ztscr03(k) = zero - endif - endif - - if ( irtm_ta > 0 .or. ithlm_ta > 0 ) then - tmp(1:2) = & - + xm_term_ta_lhs( rho_ds_zm(k), rho_ds_zm(km1), & - invrs_rho_ds_zt(k), gr%invrs_dzt(k) ) - ztscr04(k) = - tmp(2) - ztscr05(k) = - tmp(1) - endif - - endif - - enddo ! xm loop: 2..gr%nz - - - ! The wpxp loop runs between k = 2 and k = gr%nz-1. The value of wpxp - ! is set to specified values at both the lowest level, k = 1, and the - ! highest level, k = gr%nz. - - do k = 2, gr%nz-1, 1 - - ! Define indices - - kp1 = min( k+1, gr%nz ) - km1 = max( k-1, 1 ) - - ! k_xm is 2*k - 1 - k_wpxp = 2*k - - - !!!!!***** w'x' *****!!!!! - - ! w'x': Left-hand side (implicit w'x' portion of the code). - ! - ! Momentum subdiagonal (lhs index: m_km1_mdiag) - ! [ x wpxp(k-1,) ] - ! Thermodynamic subdiagonal (lhs index: m_k_tdiag) - ! [ x xm(k,) ] - ! Momentum main diagonal (lhs index: m_k_mdiag) - ! [ x wpxp(k,) ] - ! Thermodynamic superdiagonal (lhs index: m_kp1_tdiag) - ! [ x xm(k+1,) ] - ! Momentum superdiagonal (lhs index: m_kp1_mdiag) - ! [ x wpxp(k+1,) ] - - ! LHS mean advection (ma) term. - lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & - = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & - + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) - - ! LHS turbulent advection (ta) term. - ! Note: An "over-implicit" weighted time step is applied to this term. - ! The weight of the implicit portion of this term is controlled - ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the - ! the equation in order to balance a weight that is not equal to 1, - ! such that: - ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; - ! where X is the variable that is being solved for in a predictive - ! equation (w'x' in this case), y(t) is the linearized portion of - ! the term that gets treated implicitly, and RHS is the portion of - ! the term that is always treated explicitly (in the case of the - ! w'x' turbulent advection term, RHS = 0). A weight of greater - ! than 1 can be applied to make the term more numerically stable. - if ( .not. l_upwind_wpxp_ta ) then - lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & - = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & - + gamma_over_implicit_ts & - * wpxp_term_ta_lhs( a1_zt(kp1), a1_zt(k), & - wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), & - invrs_rho_ds_zm(k), & - gr%invrs_dzm(k), k ) - else - lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & - = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & - + gamma_over_implicit_ts & - * wpxp_term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & - wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & - gr%invrs_dzt(k), gr%invrs_dzt(kp1), & - invrs_rho_ds_zm(k), & - rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1) ) - end if - - ! LHS turbulent production (tp) term. - lhs((/m_kp1_tdiag,m_k_tdiag/),k_wpxp) & - = lhs((/m_kp1_tdiag,m_k_tdiag/),k_wpxp) & - + wpxp_term_tp_lhs( wp2(k), gr%invrs_dzm(k) ) - - ! LHS accumulation (ac) term and pressure term 2 (pr2). - lhs(m_k_mdiag,k_wpxp) & - = lhs(m_k_mdiag,k_wpxp) & - + wpxp_terms_ac_pr2_lhs( C7_Skw_fnc(k), & - wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) - - ! LHS pressure term 1 (pr1). - ! Note: An "over-implicit" weighted time step is applied to this term. - lhs(m_k_mdiag,k_wpxp) & - = lhs(m_k_mdiag,k_wpxp) & - + gamma_over_implicit_ts & - * wpxp_term_pr1_lhs( C6x_Skw_fnc(k), tau_zm(k) ) - - ! LHS eddy diffusion term: dissipation term 1 (dp1). - lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & - = lhs((/m_kp1_mdiag,m_k_mdiag,m_km1_mdiag/),k_wpxp) & - + diffusion_zm_lhs( Kw6(k), Kw6(kp1), nu6_vert_res_dep, & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(k), k ) - - ! LHS time tendency. - if ( l_iter ) then - lhs(m_k_mdiag,k_wpxp) & - = lhs(m_k_mdiag,k_wpxp) + one / real(dt, kind = core_rknd) - endif - - ! LHS portion of semi-implicit clipping term. - if ( l_clip_semi_implicit ) then - l_upper_thresh = .true. - l_lower_thresh = .true. - - lhs(m_k_mdiag,k_wpxp) & - = lhs(m_k_mdiag,k_wpxp) & - + clip_semi_imp_lhs( dt, wpxp(k), & - l_upper_thresh, wpxp_upper_lim(k), & - l_lower_thresh, wpxp_lower_lim(k) ) - - endif - - if ( l_stats_samp ) then - - ! Statistics: implicit contributions for wprtp or wpthlp. - - if ( iwprtp_ma > 0 .or. iwpthlp_ma > 0 ) then - tmp(1:3) = & - + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) - zmscr01(k) = - tmp(3) - zmscr02(k) = - tmp(2) - zmscr03(k) = - tmp(1) - endif - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for LHS turbulent - ! advection (ta) term). - if ( iwprtp_ta > 0 .or. iwpthlp_ta > 0 ) then - if ( .not. l_upwind_wpxp_ta ) then - tmp(1:3) & - = gamma_over_implicit_ts & - * wpxp_term_ta_lhs( a1_zt(kp1), a1_zt(k), & - wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), & - invrs_rho_ds_zm(k), & - gr%invrs_dzm(k), k ) - else - tmp(1:3) & - = gamma_over_implicit_ts & - * wpxp_term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & - wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & - gr%invrs_dzt(k), gr%invrs_dzt(kp1), & - invrs_rho_ds_zm(k), & - rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1) ) - end if - - zmscr04(k) = - tmp(3) - zmscr05(k) = - tmp(2) - zmscr06(k) = - tmp(1) - endif - - if ( iwprtp_tp > 0 .or. iwpthlp_tp > 0 ) then - tmp(1:2) = & - + wpxp_term_tp_lhs( wp2(k), gr%invrs_dzm(k) ) - zmscr07(k) = - tmp(2) - zmscr08(k) = - tmp(1) - endif - - ! Note: To find the contribution of w'x' term ac, substitute 0 for the - ! C_7 skewness function input to function wpxp_terms_ac_pr2_lhs. - if ( iwprtp_ac > 0 .or. iwpthlp_ac > 0 ) then - zmscr09(k) = & - - wpxp_terms_ac_pr2_lhs( zero, & - wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) - endif - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for LHS turbulent - ! advection (ta) term). - if ( iwprtp_pr1 > 0 .or. iwpthlp_pr1 > 0 ) then - zmscr10(k) & - = - gamma_over_implicit_ts & - * wpxp_term_pr1_lhs( C6x_Skw_fnc(k), tau_zm(k) ) - endif - - ! Note: To find the contribution of w'x' term pr2, add 1 to the - ! C_7 skewness function input to function wpxp_terms_ac_pr2_lhs. - if ( iwprtp_pr2 > 0 .or. iwpthlp_pr2 > 0 ) then - zmscr11(k) = & - - wpxp_terms_ac_pr2_lhs( (one+C7_Skw_fnc(k)), & - wm_zt(kp1), wm_zt(k), gr%invrs_dzm(k) ) - endif - - if ( iwprtp_dp1 > 0 .or. iwpthlp_dp1 > 0 ) then - tmp(1:3) = & - + diffusion_zm_lhs( Kw6(k), Kw6(kp1), nu6_vert_res_dep, & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(k), k ) - zmscr12(k) = - tmp(3) - zmscr13(k) = - tmp(2) - zmscr14(k) = - tmp(1) - endif - - if ( l_clip_semi_implicit ) then - if ( iwprtp_sicl > 0 .or. iwpthlp_sicl > 0 ) then - l_upper_thresh = .true. - l_lower_thresh = .true. - zmscr15(k) = & - - clip_semi_imp_lhs( dt, wpxp(k), & - l_upper_thresh, wpxp_upper_lim(k), & - l_lower_thresh, wpxp_lower_lim(k) ) - endif - endif - - endif - - enddo ! wpxp loop: 2..gr%nz-1 - - - ! Boundary conditions - - ! The turbulent flux (wpxp) use fixed-point boundary conditions at both the - ! upper and lower boundaries. Therefore, anything set in the wpxp loop - ! at both the upper and lower boundaries would be overwritten here. - ! However, the wpxp loop does not extend to the boundary levels. An array - ! with a value of 1 at the main diagonal on the left-hand side and with - ! values of 0 at all other diagonals on the left-hand side will preserve the - ! right-hand side value at that level. The value of xm at level k = 1, - ! which is below the model surface, is preserved and then overwritten to - ! match the new value of xm at level k = 2. - ! - ! xm(1) wpxp(1) ... wpxp(nzmax) - ! [ 0.0 0.0 0.0 ] - ! [ 0.0 0.0 0.0 ] - ! [ 1.0 1.0 ... 1.0 ] - ! [ 0.0 0.0 0.0 ] - ! [ 0.0 0.0 0.0 ] - - ! Lower boundary - k = 1 - k_xm = 2*k - 1 - k_wpxp_low = 2*k - - ! Upper boundary - k = gr%nz - !k_xm is 2*k - 1 - k_wpxp_high = 2*k - - call set_boundary_conditions_lhs( m_k_mdiag, k_wpxp_low, k_wpxp_high, lhs, & - t_k_tdiag, k_xm) - - return - - end subroutine xm_wpxp_lhs - - !============================================================================= - subroutine xm_wpxp_rhs( solve_type, l_iter, dt, xm, wpxp, & - xm_forcing, wpxp_forcing, C7_Skw_fnc, & - xpthvp, C6x_Skw_fnc, tau_zm, a1, a1_zt, & - wp3_on_wp2, wp3_on_wp2_zt, rho_ds_zt, & - rho_ds_zm, invrs_rho_ds_zm, thv_ds_zm, & - wpxp_upper_lim, wpxp_lower_lim, & - rhs ) - - ! Description: - ! Compute RHS vector for xm and w'x'. - ! This subroutine computes the explicit portion of - ! the xm and w'x' equations. - - ! References: - !------------------------------------------------------------------------ - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_constants_clubb, only: & - gamma_over_implicit_ts, & ! Constant(s) - one, & - zero - - use crmx_model_flags, only: & - l_clip_semi_implicit, & ! Variable(s) - l_upwind_wpxp_ta - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_clip_semi_implicit, only: & - clip_semi_imp_rhs ! Procedure(s) - - use crmx_stats_type, only: & - stat_update_var_pt, & - stat_begin_update_pt - - use crmx_stats_variables, only: & - zt, & ! Variable(s) - zm, & - irtm_forcing, & - ithlm_forcing, & - iwprtp_bp, & - iwprtp_pr3, & - iwprtp_sicl, & - iwprtp_ta, & - iwprtp_pr1, & - iwprtp_forcing, & - iwpthlp_bp, & - iwpthlp_pr3, & - iwpthlp_sicl, & - iwpthlp_ta, & - iwpthlp_pr1, & - iwpthlp_forcing, & - l_stats_samp - - use crmx_advance_helper_module, only: set_boundary_conditions_rhs - - implicit none - - ! Input Variables - integer, intent(in) :: & - solve_type ! Variables being solved for. - - logical, intent(in) :: l_iter - - real(kind=time_precision), intent(in) :: & - dt ! Timestep [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - xm, & ! xm (thermodynamic levels) [{xm units}] - wpxp, & ! (momentum levels) [{xm units} m/s] - xm_forcing, & ! xm forcings (thermodynamic levels) [{xm units}/s] - wpxp_forcing, & ! forcing (momentum levels) [{xm units} m/s^2] - C7_Skw_fnc, & ! C_7 parameter with Sk_w applied [-] - xpthvp, & ! x'th_v' (momentum levels) [{xm units} K] - C6x_Skw_fnc, & ! C_6x parameter with Sk_w applied [-] - tau_zm, & ! Time-scale tau on momentum levels [s] - a1_zt, & ! a_1 interpolated to thermodynamic levels [-] - a1, & ! a_1 [-] - wp3_on_wp2, & ! Smoothed wp3 / wp2 on moment. levels [m/s] - wp3_on_wp2_zt, & ! Smoothed wp3 / wp2 on thermo. levels [m/s] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - rho_ds_zm, & ! Dry, static density on moment. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg] - thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K] - wpxp_upper_lim, & ! Keeps correlations from becoming > 1. [units vary] - wpxp_lower_lim ! Keeps correlations from becoming < -1. [units vary] - - ! Output Variable - real( kind = core_rknd ), intent(out), dimension(2*gr%nz) :: & - rhs ! Right-hand side of band diag. matrix. (LAPACK) - - ! Local Variables. - - ! For "over-implicit" weighted time step. - ! This vector holds output from the LHS (implicit) portion of a term at a - ! given vertical level. This output is weighted and applied to the RHS. - ! This is used if the implicit portion of the term is "over-implicit", which - ! means that the LHS contribution is given extra weight (>1) in order to - ! increase numerical stability. A weighted factor must then be applied to - ! the RHS in order to balance the weight. - real( kind = core_rknd ), dimension(3) :: lhs_fnc_output - - ! Indices - integer :: k, km1, kp1, k_xm, k_wpxp, k_xm_low, k_wpxp_low, k_wpxp_high - - - integer :: & - ixm_f, & - iwpxp_bp, & - iwpxp_pr3, & - iwpxp_f, & - iwpxp_sicl, & - iwpxp_ta, & - iwpxp_pr1 - - logical :: l_upper_thresh, l_lower_thresh ! flags for clip_semi_imp_lhs - - ! ---- Begin Code ---- - - select case ( solve_type ) - case ( xm_wpxp_rtm ) ! rtm/wprtp budget terms - ixm_f = irtm_forcing - iwpxp_bp = iwprtp_bp - iwpxp_pr3 = iwprtp_pr3 - iwpxp_f = iwprtp_forcing - iwpxp_sicl = iwprtp_sicl - iwpxp_ta = iwprtp_ta - iwpxp_pr1 = iwprtp_pr1 - case ( xm_wpxp_thlm ) ! thlm/wpthlp budget terms - ixm_f = ithlm_forcing - iwpxp_bp = iwpthlp_bp - iwpxp_pr3 = iwpthlp_pr3 - iwpxp_f = iwpthlp_forcing - iwpxp_sicl = iwpthlp_sicl - iwpxp_ta = iwpthlp_ta - iwpxp_pr1 = iwpthlp_pr1 - case default ! this includes the sclrm case - ixm_f = 0 - iwpxp_bp = 0 - iwpxp_pr3 = 0 - iwpxp_f = 0 - iwpxp_sicl = 0 - iwpxp_ta = 0 - iwpxp_pr1 = 0 - end select - - - ! Initialize the right-hand side vector to 0. - rhs = zero - - ! The xm loop runs between k = 2 and k = gr%nz. The value of xm at - ! level k = 1, which is below the model surface, is simply set equal to the - ! value of xm at level k = 2 after the solve has been completed. - - do k = 2, gr%nz, 1 - - ! Define indices - - k_xm = 2*k - 1 - ! k_wpxp is 2*k - - - !!!!!***** xm *****!!!!! - - ! xm: Right-hand side (explicit xm portion of the code). - - ! RHS time tendency. - rhs(k_xm) = rhs(k_xm) + xm(k) / real( dt, kind = core_rknd ) - - ! RHS xm forcings. - ! Note: xm forcings include the effects of microphysics, - ! cloud water sedimentation, radiation, and any - ! imposed forcings on xm. - rhs(k_xm) = rhs(k_xm) + xm_forcing(k) - - if ( l_stats_samp ) then - - ! Statistics: explicit contributions for xm - ! (including microphysics/radiation). - - ! xm forcings term is completely explicit; call stat_update_var_pt. - call stat_update_var_pt( ixm_f, k, xm_forcing(k), zt ) - - endif ! l_stats_samp - - enddo ! xm loop: 2..gr%nz - - - ! The wpxp loop runs between k = 2 and k = gr%nz-1. The value of wpxp - ! is set to specified values at both the lowest level, k = 1, and the - ! highest level, k = gr%nz. - - do k = 2, gr%nz-1, 1 - - ! Define indices - - km1 = max( k-1, 1 ) - kp1 = min( k+1, gr%nz ) - - ! k_xm is 2*k - 1 - k_wpxp = 2*k - - - !!!!!***** w'x' *****!!!!! - - ! w'x': Right-hand side (explicit w'x' portion of the code). - - ! RHS buoyancy production (bp) term and pressure term 3 (pr3). - rhs(k_wpxp) & - = rhs(k_wpxp) & - + wpxp_terms_bp_pr3_rhs( C7_Skw_fnc(k), thv_ds_zm(k), xpthvp(k) ) - - ! RHS time tendency. - if ( l_iter ) then - rhs(k_wpxp) = rhs(k_wpxp) + wpxp(k) / real( dt, kind = core_rknd ) - end if - - ! RHS forcing. - ! Note: forcing includes the effects of microphysics on . - rhs(k_wpxp) = rhs(k_wpxp) + wpxp_forcing(k) - - ! RHS portion of semi-implicit clipping (sicl) term. - if ( l_clip_semi_implicit ) then - l_upper_thresh = .true. - l_lower_thresh = .true. - - rhs(k_wpxp) & - = rhs(k_wpxp) & - + clip_semi_imp_rhs( dt, wpxp(k), & - l_upper_thresh, wpxp_upper_lim(k), & - l_lower_thresh, wpxp_lower_lim(k) ) - - endif - - if( .not. l_upwind_wpxp_ta ) then ! Only do this when not using Upwind Differencing - ! RHS contribution from "over-implicit" weighted time step - ! for LHS turbulent advection (ta) term. - ! - ! Note: An "over-implicit" weighted time step is applied to this term. - ! The weight of the implicit portion of this term is controlled - ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the - ! expression below). A factor is added to the right-hand side of - ! the equation in order to balance a weight that is not equal to 1, - ! such that: - ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; - ! where X is the variable that is being solved for in a predictive - ! equation (w'x' in this case), y(t) is the linearized portion of - ! the term that gets treated implicitly, and RHS is the portion of - ! the term that is always treated explicitly (in the case of the - ! w'x' turbulent advection term, RHS = 0). A weight of greater - ! than 1 can be applied to make the term more numerically stable. - lhs_fnc_output(1:3) & - = wpxp_term_ta_lhs( a1_zt(kp1), a1_zt(k), & - wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), & - invrs_rho_ds_zm(k), & - gr%invrs_dzm(k), k ) - else - lhs_fnc_output(1:3) & - = wpxp_term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & - wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & - gr%invrs_dzt(k), gr%invrs_dzt(kp1), & - invrs_rho_ds_zm(k), & - rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1) ) - endif - - rhs(k_wpxp) & - = rhs(k_wpxp) & - + ( one - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * wpxp(kp1) & - - lhs_fnc_output(2) * wpxp(k) & - - lhs_fnc_output(3) * wpxp(km1) ) - - ! RHS contribution from "over-implicit" weighted time step - ! for LHS pressure term 1 (pr1). - ! - ! Note: An "over-implicit" weighted time step is applied to this term. - lhs_fnc_output(1) & - = wpxp_term_pr1_lhs( C6x_Skw_fnc(k), tau_zm(k) ) - rhs(k_wpxp) & - = rhs(k_wpxp) & - + ( one - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * wpxp(k) ) - - - if ( l_stats_samp ) then - - ! Statistics: explicit contributions for wpxp. - - ! w'x' term bp is completely explicit; call stat_update_var_pt. - ! Note: To find the contribution of w'x' term bp, substitute 0 for the - ! C_7 skewness function input to function wpxp_terms_bp_pr3_rhs. - call stat_update_var_pt( iwpxp_bp, k, & - wpxp_terms_bp_pr3_rhs( zero, thv_ds_zm(k), xpthvp(k) ), zm ) - - ! w'x' term pr3 is completely explicit; call stat_update_var_pt. - ! Note: To find the contribution of w'x' term pr3, add 1 to the - ! C_7 skewness function input to function wpxp_terms_bp_pr2_rhs. - call stat_update_var_pt( iwpxp_pr3, k, & - wpxp_terms_bp_pr3_rhs( (one+C7_Skw_fnc(k)), thv_ds_zm(k), & - xpthvp(k) ), & - zm ) - - ! w'x' forcing term is completely explicit; call stat_update_var_pt. - call stat_update_var_pt( iwpxp_f, k, wpxp_forcing(k), zm ) - - ! w'x' term sicl has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on clip_semi_imp_rhs. - if ( l_clip_semi_implicit ) then - l_upper_thresh = .true. - l_lower_thresh = .true. - call stat_begin_update_pt( iwpxp_sicl, k, & - -clip_semi_imp_rhs( dt, wpxp(k), & - l_upper_thresh, wpxp_upper_lim(k), & - l_lower_thresh, wpxp_lower_lim(k) ), zm ) - endif - - if ( l_upwind_wpxp_ta ) then ! Use upwind differencing - lhs_fnc_output(1:3) & - = wpxp_term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & - wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & - gr%invrs_dzt(k), gr%invrs_dzt(kp1), & - invrs_rho_ds_zm(k), & - rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1) ) - - else - ! w'x' term ta is normally completely implicit. However, there is a - ! RHS contribution from the "over-implicit" weighted time step. A - ! weighting factor of greater than 1 may be used to make the term more - ! numerically stable (see note above for RHS contribution from - ! "over-implicit" weighted time step for LHS turbulent advection (ta) - ! term). Therefore, w'x' term ta has both implicit and explicit - ! components; call stat_begin_update_pt. Since stat_begin_update_pt - ! automatically subtracts the value sent in, reverse the sign on the - ! input value. - lhs_fnc_output(1:3) & - = wpxp_term_ta_lhs( a1_zt(kp1), a1_zt(k), & - wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), & - invrs_rho_ds_zm(k), & - gr%invrs_dzm(k), k ) - endif - - call stat_begin_update_pt( iwpxp_ta, k, & - - ( one - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * wpxp(kp1) & - - lhs_fnc_output(2) * wpxp(k) & - - lhs_fnc_output(3) * wpxp(km1) ), zm ) - - ! w'x' term pr1 is normally completely implicit. However, there is a - ! RHS contribution from the "over-implicit" weighted time step. A - ! weighting factor of greater than 1 may be used to make the term more - ! numerically stable (see note above for RHS contribution from - ! "over-implicit" weighted time step for LHS turbulent advection (ta) - ! term). Therefore, w'x' term pr1 has both implicit and explicit - ! components; call stat_begin_update_pt. Since stat_begin_update_pt - ! automatically subtracts the value sent in, reverse the sign on the - ! input value. - lhs_fnc_output(1) & - = wpxp_term_pr1_lhs( C6x_Skw_fnc(k), tau_zm(k) ) - call stat_begin_update_pt( iwpxp_pr1, k, & - - ( one - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * wpxp(k) ), zm ) - - - endif ! l_stats_samp - - enddo ! wpxp loop: 2..gr%nz-1 - - - ! Boundary conditions - - ! The turbulent flux (wpxp) use fixed-point boundary conditions at both the - ! upper and lower boundaries. Therefore, anything set in the wpxp loop - ! at both the upper and lower boundaries would be overwritten here. - ! However, the wpxp loop does not extend to the boundary levels. An array - ! with a value of 1 at the main diagonal on the left-hand side and with - ! values of 0 at all other diagonals on the left-hand side will preserve the - ! right-hand side value at that level. The value of xm at level k = 1, - ! which is below the model surface, is preserved and then overwritten to - ! match the new value of xm at level k = 2. - - ! Lower boundary - k = 1 - k_xm_low = 2*k - 1 - k_wpxp_low = 2*k - - ! Upper boundary - k = gr%nz - !k_xm is 2*k - 1 - k_wpxp_high = 2*k - - - ! The value of xm at the lower boundary will remain the same. - ! However, the value of xm at the lower boundary gets overwritten - ! after the matrix is solved for the next timestep, such - ! that xm(1) = xm(2). - - ! The value of w'x' at the lower boundary will remain the same. - ! The surface value of w'x' is set elsewhere - ! (case-specific information). - - ! The value of w'x' at the upper boundary will be 0. - call set_boundary_conditions_rhs( & - wpxp(1), k_wpxp_low, zero, k_wpxp_high, & - rhs, & - xm(1), k_xm_low ) - - - end subroutine xm_wpxp_rhs - - !============================================================================= - subroutine xm_wpxp_solve( nrhs, lhs, rhs, solution, err_code, rcond ) - - ! Description: - ! Solve for xm / w'x' using the band diagonal solver. - - ! References: - ! None - !------------------------------------------------------------------------ - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_lapack_wrap, only: & - band_solve, & ! Procedure(s) - band_solvex - - use crmx_error_code, only: & - clubb_no_error ! Constant - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - integer, intent(in) :: & - nrhs ! Number of rhs vectors - - ! Input/Output Variables - real( kind = core_rknd ), intent(inout), dimension(nsup+nsub+1,2*gr%nz) :: & - lhs ! Implicit contributions to wpxp/xm (band diag. matrix in LAPACK storage) - - real( kind = core_rknd ), intent(inout), dimension(2*gr%nz,nrhs) :: & - rhs ! Right-hand side of band diag. matrix. (LAPACK storage) - - real( kind = core_rknd ), intent(out), dimension(2*gr%nz,nrhs) :: & - solution ! Solution to band diagonal system (LAPACK storage) - - ! Output Variables - integer, intent(out) :: err_code - - real( kind = core_rknd ), optional, intent(out) :: & - rcond ! Est. of the reciprocal of the condition # - - err_code = clubb_no_error ! Initialize to the value for no errors - - if ( present( rcond ) ) then - ! Perform LU decomp and solve system (LAPACK with diagnostics) - call band_solvex( "xm_wpxp", nsup, nsub, 2*gr%nz, nrhs, & - lhs, rhs, solution, rcond, err_code ) - - - else - ! Perform LU decomp and solve system (LAPACK) - call band_solve( "xm_wpxp", nsup, nsub, 2*gr%nz, nrhs, & - lhs, rhs, solution, err_code ) - end if - - - return - end subroutine xm_wpxp_solve - -!=============================================================================== - subroutine xm_wpxp_clipping_and_stats & - ( solve_type, dt, wp2, xp2, wm_zt, & - xm_forcing, rho_ds_zm, rho_ds_zt, & - invrs_rho_ds_zm, invrs_rho_ds_zt, & - xp2_threshold, xm_threshold, rcond, & - low_lev_effect, high_lev_effect, & - l_implemented, solution, & - xm, xm_tol, wpxp, err_code ) - - ! Description: - ! Clips and computes implicit stats for an artitrary xm and wpxp - ! - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_model_flags, only: & - l_clip_semi_implicit ! Variable(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_mono_flux_limiter, only: & - monotonic_turbulent_flux_limit ! Procedure(s) - - use crmx_pos_definite_module, only: & - pos_definite_adj ! Procedure(s) - - use crmx_clip_explicit, only: & - clip_covar, & ! Procedure(s) - clip_wprtp, & ! Variable(s) - clip_wpthlp, & - clip_wpsclrp - - use crmx_model_flags, only: & - l_pos_def, & ! Logical for whether to apply the positive definite scheme to rtm - l_hole_fill, & ! Logical for whether to apply the hole filling scheme to thlm/rtm - l_clip_turb_adv ! Logical for whether to clip xm when wpxp is clipped - - use crmx_constants_clubb, only: & - fstderr, & ! Constant(s) - one, & - zero - - use crmx_fill_holes, only: & - fill_holes_driver ! Procedure - - use crmx_error_code, only: & - clubb_at_least_debug_level, & ! Procedure(s) - clubb_no_error ! Constant - - use crmx_stats_type, only: & - stat_begin_update, & ! Procedure(s) - stat_update_var_pt, & - stat_end_update_pt, & - stat_end_update, & - stat_update_var, & - stat_modify - - use crmx_stats_variables, only: & - zt, & ! Variable(s) - zm, & - sfc, & - irtm_ta, & - irtm_ma, & - irtm_matrix_condt_num, & - irtm_pd, & - irtm_cl, & - iwprtp_bt, & - iwprtp_ma, & - iwprtp_ta, & - iwprtp_tp, & - iwprtp_ac, & - iwprtp_pr1, & - iwprtp_pr2, & - iwprtp_dp1, & - iwprtp_pd, & - iwprtp_sicl, & - ithlm_ta - - use crmx_stats_variables, only: & - ithlm_ma, & - ithlm_cl, & - ithlm_matrix_condt_num, & - iwpthlp_bt, & - iwpthlp_ma, & - iwpthlp_ta, & - iwpthlp_tp, & - iwpthlp_ac, & - iwpthlp_pr1, & - iwpthlp_pr2, & - iwpthlp_dp1, & - iwpthlp_sicl - - use crmx_stats_variables, only: & - l_stats_samp, & - ztscr01, & - ztscr02, & - ztscr03, & - ztscr04, & - ztscr05, & - zmscr01, & - zmscr02, & - zmscr03, & - zmscr04, & - zmscr05, & - zmscr06, & - zmscr07, & - zmscr08, & - zmscr09, & - zmscr10, & - zmscr11, & - zmscr12, & - zmscr13, & - zmscr14, & - zmscr15 - - implicit none - - ! Constant Parameters - logical, parameter :: & - l_mono_flux_lim = .true., & ! Flag for monotonic turbulent flux limiter - l_enable_relaxed_clipping = .true., & ! Flag to relax clipping - l_first_clip_ts = .true., & - l_last_clip_ts = .false. - - ! Input Variables - integer, intent(in) :: & - solve_type ! Variables being solved for. - - real(kind=time_precision), intent(in) :: & - dt ! Timestep [s] - - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - wp2, & ! w'^2 (momentum levels) [m^2/s^2] - xp2, & ! x'^2 (momentum levels) [{xm units}^2] - wm_zt, & ! w wind component on thermodynamic levels [m/s] - xm_forcing, & ! xm forcings (thermodynamic levels) [units vary] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg] - invrs_rho_ds_zt ! Inv. dry, static density @ thermo. levs. [m^3/kg] - - real( kind = core_rknd ), intent(in) :: & - xp2_threshold, & ! Minimum allowable value of x'^2 [units vary] - xm_threshold, & ! Minimum allowable value of xm [units vary] - xm_tol, & ! Minimum allowable deviation of xm [units vary] - rcond ! Reciprocal of the estimated condition number (from computing A^-1) - - ! Variables used as part of the monotonic turbulent advection scheme. - ! Find the lowermost and uppermost grid levels that can have an effect - ! on the central thermodynamic level during the course of a time step, - ! due to the effects of turbulent advection only. - integer, dimension(gr%nz), intent(in) :: & - low_lev_effect, & ! Index of the lowest level that has an effect. - high_lev_effect ! Index of the highest level that has an effect. - - logical, intent(in) :: & - l_implemented ! Flag for CLUBB being implemented in a larger model. - - real( kind = core_rknd ), intent(in), dimension(2*gr%nz) :: & - solution ! The value of xm and wpxp [units vary] - - ! Input/Output Variables - real( kind = core_rknd ), intent(inout), dimension(gr%nz) :: & - xm, & ! The mean x field [units vary] - wpxp ! The flux of x [units vary m/s] - - ! Output Variable - integer, intent(out) :: & - err_code ! Returns an error code in the event of a singular matrix - - ! Local Variables - integer :: & - solve_type_cl ! solve_type used for clipping statistics. - - character(len=10) :: & - solve_type_str ! solve_type as a string for debug output purposes - - real( kind = core_rknd ), dimension(gr%nz) :: & - xm_n ! Old value of xm for positive definite scheme [units vary] - - real( kind = core_rknd ), dimension(gr%nz) :: & - wpxp_pd, xm_pd ! Change in xm and wpxp due to the pos. def. scheme - - real( kind = core_rknd ), dimension(gr%nz) :: & - wpxp_chnge, & ! Net change in w'x' due to clipping [units vary] - xp2_relaxed ! Value of x'^2 * clip_factor [units vary] - - ! Indices - integer :: & - k, km1, kp1, & - k_xm, k_wpxp - - integer :: & - ixm_ta, & - ixm_ma, & - ixm_matrix_condt_num, & - ixm_pd, & - ixm_cl, & - iwpxp_bt, & - iwpxp_ma, & - iwpxp_ta, & - iwpxp_tp, & - iwpxp_ac, & - iwpxp_pr1, & - iwpxp_pr2, & - iwpxp_dp1, & - iwpxp_pd, & - iwpxp_sicl - - ! ----- Begin code ------ - err_code = clubb_no_error ! Initialize to the value for no errors - - select case ( solve_type ) - case ( xm_wpxp_rtm ) ! rtm/wprtp budget terms - ixm_ta = irtm_ta - ixm_ma = irtm_ma - ixm_pd = irtm_pd - ixm_cl = irtm_cl - iwpxp_bt = iwprtp_bt - iwpxp_ma = iwprtp_ma - iwpxp_ta = iwprtp_ta - iwpxp_tp = iwprtp_tp - iwpxp_ac = iwprtp_ac - iwpxp_pr1 = iwprtp_pr1 - iwpxp_pr2 = iwprtp_pr2 - iwpxp_dp1 = iwprtp_dp1 - iwpxp_pd = iwprtp_pd - iwpxp_sicl = iwprtp_sicl - - ! This is a diagnostic from inverting the matrix, not a budget - ixm_matrix_condt_num = irtm_matrix_condt_num - case ( xm_wpxp_thlm ) ! thlm/wpthlp budget terms - ixm_ta = ithlm_ta - ixm_ma = ithlm_ma - ixm_pd = 0 - ixm_cl = ithlm_cl - iwpxp_bt = iwpthlp_bt - iwpxp_ma = iwpthlp_ma - iwpxp_ta = iwpthlp_ta - iwpxp_tp = iwpthlp_tp - iwpxp_ac = iwpthlp_ac - iwpxp_pr1 = iwpthlp_pr1 - iwpxp_pr2 = iwpthlp_pr2 - iwpxp_dp1 = iwpthlp_dp1 - iwpxp_pd = 0 - iwpxp_sicl = iwpthlp_sicl - - ! This is a diagnostic from inverting the matrix, not a budget - ixm_matrix_condt_num = ithlm_matrix_condt_num - - case default ! this includes the sclrm case - ixm_ta = 0 - ixm_ma = 0 - ixm_pd = 0 - ixm_cl = 0 - iwpxp_bt = 0 - iwpxp_ma = 0 - iwpxp_ta = 0 - iwpxp_tp = 0 - iwpxp_ac = 0 - iwpxp_pr1 = 0 - iwpxp_pr2 = 0 - iwpxp_dp1 = 0 - iwpxp_pd = 0 - iwpxp_sicl = 0 - - ixm_matrix_condt_num = 0 - end select - - ! Copy result into output arrays - - do k=1, gr%nz, 1 - - k_xm = 2 * k - 1 - k_wpxp = 2 * k - - xm_n(k) = xm(k) - - xm(k) = solution(k_xm) - wpxp(k) = solution(k_wpxp) - - end do ! k=1..gr%nz - - ! Lower boundary condition on xm - xm(1) = xm(2) - - - if ( l_stats_samp ) then - - - if ( ixm_matrix_condt_num > 0 ) then - ! Est. of the condition number of the mean/flux LHS matrix - call stat_update_var_pt( ixm_matrix_condt_num, 1, one / rcond, sfc ) - end if - - - ! The xm loop runs between k = 2 and k = gr%nz. The value of xm at - ! level k = 1, which is below the model surface, is simply set equal to - ! the value of xm at level k = 2 after the solve has been completed. - ! Thus, the statistical code will run from levels 2 through gr%nz. - - do k = 2, gr%nz - - km1 = max( k-1, 1 ) - kp1 = min( k+1, gr%nz ) - - ! Finalize implicit contributions for xm - - ! xm term ma is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( ixm_ma, k, & - ztscr01(k) * xm(km1) & - + ztscr02(k) * xm(k) & - + ztscr03(k) * xm(kp1), zt ) - - ! xm term ta is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( ixm_ta, k, & - ztscr04(k) * wpxp(km1) & - + ztscr05(k) * wpxp(k), zt ) - - enddo ! xm loop: 2..gr%nz - - - ! The wpxp loop runs between k = 2 and k = gr%nz-1. The value of wpxp - ! is set to specified values at both the lowest level, k = 1, and the - ! highest level, k = gr%nz. Thus, the statistical code will run from - ! levels 2 through gr%nz-1. - - do k = 2, gr%nz-1 - - km1 = max( k-1, 1 ) - kp1 = min( k+1, gr%nz ) - - ! Finalize implicit contributions for wpxp - - ! w'x' term ma is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( iwpxp_ma, k, & - zmscr01(k) * wpxp(km1) & - + zmscr02(k) * wpxp(k) & - + zmscr03(k) * wpxp(kp1), zm ) - -! if( .not. l_upwind_wpxp_ta ) then - ! w'x' term ta is normally completely implicit. However, due to the - ! RHS contribution from the "over-implicit" weighted time step, - ! w'x' term ta has both implicit and explicit components; - ! call stat_end_update_pt. - call stat_end_update_pt( iwpxp_ta, k, & - zmscr04(k) * wpxp(km1) & - + zmscr05(k) * wpxp(k) & - + zmscr06(k) * wpxp(kp1), zm ) -! endif - - ! w'x' term tp is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( iwpxp_tp, k, & - zmscr07(k) * xm(k) & - + zmscr08(k) * xm(kp1), zm ) - - ! w'x' term ac is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( iwpxp_ac, k, & - zmscr09(k) * wpxp(k), zm ) - - ! w'x' term pr1 is normally completely implicit. However, due to the - ! RHS contribution from the "over-implicit" weighted time step, - ! w'x' term pr1 has both implicit and explicit components; - ! call stat_end_update_pt. - call stat_end_update_pt( iwpxp_pr1, k, & - zmscr10(k) * wpxp(k), zm ) - - ! w'x' term pr2 is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( iwpxp_pr2, k, & - zmscr11(k) * wpxp(k), zm ) - - ! w'x' term dp1 is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( iwpxp_dp1, k, & - zmscr12(k) * wpxp(km1) & - + zmscr13(k) * wpxp(k) & - + zmscr14(k) * wpxp(kp1), zm ) - - ! w'x' term sicl has both implicit and explicit components; - ! call stat_end_update_pt. - if ( l_clip_semi_implicit ) then - call stat_end_update_pt( iwpxp_sicl, k, & - zmscr15(k) * wpxp(k), zm ) - endif - - enddo ! wpxp loop: 2..gr%nz-1 - - - endif ! l_stats_samp - - - ! Apply a monotonic turbulent flux limiter to xm/w'x'. - if ( l_mono_flux_lim ) then - call monotonic_turbulent_flux_limit( solve_type, dt, xm_n, & - xp2, wm_zt, xm_forcing, & - rho_ds_zm, rho_ds_zt, & - invrs_rho_ds_zm, invrs_rho_ds_zt, & - xp2_threshold, l_implemented, & - low_lev_effect, high_lev_effect, & - xm, xm_tol, wpxp, err_code ) - end if ! l_mono_flux_lim - - ! Apply a flux limiting positive definite scheme if the solution - ! for the mean field is negative and we're determining total water - if ( solve_type == xm_wpxp_rtm .and. l_pos_def .and. any( xm < zero ) ) then - - call pos_definite_adj( dt, "zt", xm, wpxp, & - xm_n, xm_pd, wpxp_pd ) - - else - ! For stats purposes - xm_pd = zero - wpxp_pd = zero - - end if ! l_pos_def and solve_type == "rtm" and rtm less than 0 - - if ( l_stats_samp ) then - - call stat_update_var( iwpxp_pd, wpxp_pd(1:gr%nz), zm ) - - call stat_update_var( ixm_pd, xm_pd(1:gr%nz), zt ) - - end if - - ! Computed value before clipping - if ( l_stats_samp ) then - call stat_begin_update( ixm_cl, xm / real( dt, kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - end if - - if ( any( xm < xm_threshold ) .and. l_hole_fill ) then - - select case ( solve_type ) - case ( xm_wpxp_rtm ) - solve_type_str = "rtm" - case ( xm_wpxp_thlm ) - solve_type_str = "thlm" - case default - solve_type_str = "scalars" - end select - - if ( clubb_at_least_debug_level( 1 ) ) then - do k = 1, gr%nz - if ( xm(k) < zero ) then - write(fstderr,*) solve_type_str//" < ", xm_threshold, & - " in advance_xm_wpxp_module at k= ", k - end if - end do - end if - - call fill_holes_driver( 2, xm_threshold, "zt", & - rho_ds_zt, rho_ds_zm, & - xm ) - - end if ! any( xm < xm_threshold ) .and. l_hole_fill - - if ( l_stats_samp ) then - call stat_end_update( ixm_cl, xm / real( dt, kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - end if - - ! Use solve_type to find solve_type_cl, which is used - ! in subroutine clip_covar. - select case ( solve_type ) - case ( xm_wpxp_rtm ) - solve_type_cl = clip_wprtp - case ( xm_wpxp_thlm ) - solve_type_cl = clip_wpthlp - case default - solve_type_cl = clip_wpsclrp - end select - - ! Clipping for w'x' - ! Clipping w'x' at each vertical level, based on the - ! correlation of w and x at each vertical level, such that: - ! corr_(w,x) = w'x' / [ sqrt(w'^2) * sqrt(x'^2) ]; - ! -1 <= corr_(w,x) <= 1. - ! Since w'^2, x'^2, and w'x' are updated in different places - ! from each other, clipping for w'x' has to be done three times - ! (three times each for w'r_t', w'th_l', and w'sclr'). This is - ! the second instance of w'x' clipping. - - ! Compute a slightly larger value of rt'^2 for clipping purposes. This was - ! added to prevent a situation in which both the variance and flux are small - ! and the simulation gets "stuck" at the rt_tol^2 value. - ! See ticket #389 on the CLUBB TRAC for further details. - ! -dschanen 10 Jan 2011 - if ( l_enable_relaxed_clipping ) then - if ( solve_type == xm_wpxp_rtm ) then - xp2_relaxed = max( 1e-7_core_rknd , xp2 ) - - else if ( solve_type == xm_wpxp_thlm ) then - xp2_relaxed = max( 0.01_core_rknd, xp2 ) - - else ! This includes the passive scalars - xp2_relaxed = max( 1e-7_core_rknd , xp2 ) - - end if - - else ! Don't relax clipping - xp2_relaxed = xp2 - - end if - - call clip_covar( solve_type_cl, l_first_clip_ts, & ! In - l_last_clip_ts, dt, wp2, xp2_relaxed, & ! In - wpxp, wpxp_chnge ) ! In/Out - - ! Adjusting xm based on clipping for w'x'. - if ( any( wpxp_chnge /= zero ) .and. l_clip_turb_adv ) then - call xm_correction_wpxp_cl( solve_type, dt, wpxp_chnge, gr%invrs_dzt, & - xm ) - endif - - if ( l_stats_samp ) then - - ! wpxp time tendency - call stat_modify( iwpxp_bt, wpxp / real( dt, kind = core_rknd ), zm ) - ! Brian Griffin; July 5, 2008. - - endif - - return - end subroutine xm_wpxp_clipping_and_stats - - !============================================================================= - pure function xm_term_ta_lhs( rho_ds_zm, rho_ds_zmm1, & - invrs_rho_ds_zt, invrs_dzt ) & - result( lhs ) - - ! Description: - ! Turbulent advection of xm: implicit portion of the code. - ! - ! The d(xm)/dt equation contains a turbulent advection term: - ! - ! - (1/rho_ds) * d( rho_ds * w'x' )/dz. - ! - ! This term is solved for completely implicitly, such that: - ! - ! - (1/rho_ds) * d( rho_ds * w'x'(t+1) )/dz. - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed - ! to a "+". - ! - ! The timestep index (t+1) means that the value of w'x' being used is from - ! the next timestep, which is being advanced to in solving the d(xm)/dt and - ! d(w'x')/dt equations. - ! - ! This term is discretized as follows: - ! - ! While the values of xm are found on the thermodynamic levels, the values - ! of w'x' are found on the momentum levels. Additionally, the values of - ! rho_ds_zm are found on the momentum levels, and the values of - ! invrs_rho_ds_zt are found on the thermodynamic levels. On the momentum - ! levels, the values of rho_ds_zm are multiplied by the values of w'x'. The - ! derivative of (rho_ds_zm * w'x') is taken over the intermediate (central) - ! thermodynamic level, where it is multiplied by invrs_rho_ds_zt, yielding - ! the desired results. - ! - ! =====rho_ds_zm=====wpxp================================== m(k) - ! - ! ------invrs_rho_ds_zt--------d(rho_ds*wpxp)/dz----------- t(k) - ! - ! =====rho_ds_zmm1===wpxpm1================================ m(k-1) - ! - ! The vertical indices m(k), t(k), and m(k-1) correspond with altitudes - ! zm(k), zt(k), and zm(k-1), respectively. The letter "t" is used for - ! thermodynamic levels and the letter "m" is used for momentum levels. - ! - ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - integer, parameter :: & - k_mdiag = 1, & ! Momentum superdiagonal index. - km1_mdiag = 2 ! Momentum subdiagonal index. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - rho_ds_zm, & ! Dry, static density at momentum level (k) [kg/m^3] - rho_ds_zmm1, & ! Dry, static density at momentum level (k+1) [kg/m^3] - invrs_rho_ds_zt, & ! Inverse dry, static density @ thermo lev (k) [m^3/kg] - invrs_dzt ! Inverse of grid spacing (k) [1/m] - - ! Return Variable - real( kind = core_rknd ), dimension(2) :: lhs - - - ! Momentum superdiagonal [ x wpxp(k,) ] - lhs(k_mdiag) & - = + invrs_rho_ds_zt * invrs_dzt * rho_ds_zm - - ! Momentum subdiagonal [ x wpxp(k-1,) ] - lhs(km1_mdiag) & - = - invrs_rho_ds_zt * invrs_dzt * rho_ds_zmm1 - - - return - end function xm_term_ta_lhs - - !============================================================================= - pure function wpxp_term_ta_lhs( wp3_on_wp2_ztp1, wp3_on_wp2_zt, & - a1_ztp1, a1_zt, & - rho_ds_ztp1, rho_ds_zt, & - invrs_rho_ds_zm, & - invrs_dzm, level ) & - result( lhs ) - - ! Description: - ! Turbulent advection of w'x': implicit portion of the code. - ! - ! The d(w'x')/dt equation contains a turbulent advection term: - ! - ! - (1/rho_ds) * d( rho_ds * w'^2x' )/dz. - ! - ! A substitution is made in order to close the turbulent advection term, - ! such that: - ! - ! w'^2x' = a_1 * ( w'^3 / w'^2 ) * w'x', - ! - ! where a_1 is a variable that is a function of sigma_sqd_w. The turbulent - ! advection term becomes: - ! - ! - (1/rho_ds) * d [ rho_ds * a_1 * ( w'^3 / w'^2 ) * w'x' ] / dz. - ! - ! This term is solved for completely implicitly, such that: - ! - ! - (1/rho_ds) * d [ rho_ds * a_1 * ( w'^3 / w'^2 ) * w'x'(t+1) ] / dz. - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed - ! to a "+". - ! - ! The timestep index (t+1) means that the value of w'x' being used is from - ! the next timestep, which is being advanced to in solving the d(w'x')/dt - ! equation. - ! - ! This term is discretized as follows: - ! - ! The values of w'x', w'^2, and a_1 are found on the momentum levels, while - ! the values of w'^3 are found on the thermodynamic levels. Additionally, - ! the values of rho_ds_zt are found on the thermodynamic levels, and the - ! values of invrs_rho_ds_zm are found on the momentum levels. Each of the - ! variables w'x', w'^2, and a_1 are interpolated to the intermediate - ! thermodynamic levels. The values of the mathematical expression (called F - ! here) within the dF/dz term are computed on the thermodynamic levels. - ! Then, the derivative (d/dz) of the expression (F) is taken over the - ! central momentum level, where it is multiplied by invrs_rho_ds_zm, - ! yielding the desired result. In this function, the values of F are as - ! follows: - ! - ! F = rho_ds_zt * a_1(t) * ( w'^3(t) / w'^2(t) ) * w'x'(t+1); - ! - ! where the timestep index (t) stands for the index of the current timestep. - ! - ! - ! =a1p1========wp2p1========wpxpp1=================================== m(k+1) - ! - ! -----a1(interp)---wp2(interp)---wpxp(interp)---wp3p1---rho_ds_ztp1- t(k+1) - ! - ! =a1==========wp2==========wpxp=======invrs_rho_ds_zm=======dF/dz=== m(k) - ! - ! -----a1(interp)---wp2(interp)---wpxp(interp)---wp3-----rho_ds_zt--- t(k) - ! - ! =a1m1========wp2m1========wpxpm1=================================== m(k-1) - ! - ! The vertical indices m(k+1), t(k+1), m(k), t(k), and m(k-1) correspond - ! with altitudes zm(k+1), zt(k+1), zm(k), zt(k), and zm(k-1), respectively. - ! The letter "t" is used for thermodynamic levels and the letter "m" is used - ! for momentum levels. - ! - ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_grid_class, only: & - gr ! Variable; gr%weights_zm2zt - -! use model_flags, only: & -! l_standard_term_ta - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_mdiag = 1, & ! Momentum superdiagonal index. - k_mdiag = 2, & ! Momentum main diagonal index. - km1_mdiag = 3 ! Momentum subdiagonal index. - - integer, parameter :: & - m_above = 1, & ! Index for upper momentum level grid weight. - m_below = 2 ! Index for lower momentum level grid weight. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - wp3_on_wp2_ztp1, & ! Smoothed wp3 / wp2 on thermo. levels (k+1) [m/s] - wp3_on_wp2_zt, & ! Smoothed wp3 / wp2 on thermo. levels (k) [m/s] -! a1, & ! a_1 interpolated to thermo. level (k+1) [-] - a1_ztp1, & ! a_1 interpolated to thermo. level (k+1) [-] - a1_zt, & ! a_1 interpolated to thermo. level (k) [-] - rho_ds_ztp1, & ! Dry, static density at thermo. level (k+1) [kg/m^3] - rho_ds_zt, & ! Dry, static density at thermo. level (k) [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum lev (k) [m^3/kg] - invrs_dzm ! Inverse of grid spacing (k) [1/m] - - integer, intent(in) :: & - level ! Central momentum level (on which calculation occurs). - - ! Return Variable - real( kind = core_rknd ), dimension(3) :: lhs - - ! Local Variables - integer :: & - tkp1, & ! Thermodynamic level directly above central momentum level. - tk ! Thermodynamic level directly below central momentum level. - - ! Thermodynamic level (k+1) is between momentum level (k+1) - ! and momentum level (k). - tkp1 = level + 1 - - ! Thermodynamic level (k) is between momentum level (k) - ! and momentum level (k-1). - tk = level - - ! Note: The w'x' turbulent advection term, which is - ! - (1/rho_ds) * d [ rho_ds * a_1 * ( w'^3 / w'^2 ) * w'x' ] / dz, - ! still keeps the a_1 term inside the derivative, unlike the w'^3 - ! equation (found in advance_wp2_wp3_module.F90) and the equations for - ! r_t'^2, th_l'^2, r_t'th_l', u'^2, v'^2, sclr'r_t', sclr'th_l', and - ! sclr'^2 (found in advance_xp2_xpyp_module.F90). Brian. - -! if ( l_standard_term_ta ) then - - ! Always use the standard discretization for the w'x' turbulent advection - ! term. Brian. - - ! The turbulent advection term is discretized normally, in accordance - ! with the model equations found in the documentation and the description - ! listed above. - ! The w'x' turbulent advection term is - ! - (1/rho_ds) * d [ rho_ds * a_1 * ( w'^3 / w'^2 ) * w'x' ] / dz - - ! Momentum superdiagonal: [ x wpxp(k+1,) ] - lhs(kp1_mdiag) & - = + invrs_rho_ds_zm & - * invrs_dzm & - * rho_ds_ztp1 * a1_ztp1 & - * wp3_on_wp2_ztp1 & - * gr%weights_zm2zt(m_above,tkp1) - - ! Momentum main diagonal: [ x wpxp(k,) ] - lhs(k_mdiag) & - = + invrs_rho_ds_zm & - * invrs_dzm & - * ( rho_ds_ztp1 * a1_ztp1 & - * wp3_on_wp2_ztp1 & - * gr%weights_zm2zt(m_below,tkp1) & - - rho_ds_zt * a1_zt & - * wp3_on_wp2_zt & - * gr%weights_zm2zt(m_above,tk) & - ) - - ! Momentum subdiagonal: [ x wpxp(k-1,) ] - lhs(km1_mdiag) & - = - invrs_rho_ds_zm & - * invrs_dzm & - * rho_ds_zt * a1_zt & - * wp3_on_wp2_zt & - * gr%weights_zm2zt(m_below,tk) - -! else - - ! This discretization very similar to what Brian did for the xp2_ta terms - ! and is intended to stabilize the simulation by pulling a1 out of the - ! derivative. It didn't seem to work very well. -dschanen 17 Jan 2010 - - ! Momentum superdiagonal: [ x wpxp(k+1,) ] -! lhs(kp1_mdiag) & -! = + invrs_rho_ds_zm * a1 & -! * invrs_dzm & -! * rho_ds_ztp1 & -! * wp3_on_wp2_ztp1 & -! * gr%weights_zm2zt(m_above,tkp1) - - ! Momentum main diagonal: [ x wpxp(k,) ] -! lhs(k_mdiag) & -! = + invrs_rho_ds_zm * a1 & -! * invrs_dzm & -! * ( rho_ds_ztp1 & -! * wp3_on_wp2_ztp1 & -! * gr%weights_zm2zt(m_below,tkp1) & -! - rho_ds_zt & -! * wp3_on_wp2_zt & -! * gr%weights_zm2zt(m_above,tk) & -! ) - -! ! Momentum subdiagonal: [ x wpxp(k-1,) ] -! lhs(km1_mdiag) & -! = - invrs_rho_ds_zm * a1 & -! * invrs_dzm & -! * rho_ds_zt & -! * wp3_on_wp2_zt & -! * gr%weights_zm2zt(m_below,tk) - -! endif ! l_standard_term_ta - - - return - end function wpxp_term_ta_lhs - - !============================================================================= - pure function wpxp_term_ta_lhs_upwind( a1_zm, a1_zm_p1, a1_zm_m1, & - wp3_on_wp2_p1, wp3_on_wp2, wp3_on_wp2_m1, & - invrs_dzt, invrs_dztkp1, & - invrs_rho_ds_zm, & - rho_ds_zmp1, rho_ds_zm, rho_ds_zmm1 ) & - result( lhs ) - - ! Description: - ! Upwind Differencing for the wpxp term - ! References: - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - zero ! Constant(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_mdiag = 1, & ! Momentum superdiagonal index. - k_mdiag = 2, & ! Momentum main diagonal index. - km1_mdiag = 3 ! Momentum subdiagonal index. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - a1_zm, & ! a_1(k) on momentum levels [-] - a1_zm_p1, & ! a_1(k+1) on momentum levels [-] - a1_zm_m1, & ! a_1(k-1) on momentum levels [-] - wp3_on_wp2_p1, & ! Smoothed wp3 / wp2 on moment. levels (k+1) [m/s] - wp3_on_wp2, & ! Smoothed wp3 / wp2 on moment. levels (k) [m/s] - wp3_on_wp2_m1, & ! Smoothed wp3 / wp2 on moment. levels (k-1) [m/s] - invrs_dzt, & ! Inverse of grid spacing (k) [1/m] - invrs_dztkp1, & ! Inverse of grid spacing (k+1) [1/m] - invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum lev (k) [m^3/kg] - rho_ds_zm, & ! Density of air (k) [kg/m^3] - rho_ds_zmp1, & ! Density of air (k+1) [kg/m^3] - rho_ds_zmm1 ! Density of air (k-1) [kg/m^3] - - ! Return Variable - real( kind = core_rknd ), dimension(3) :: lhs - - - if ( wp3_on_wp2 > zero ) then - - ! "Wind" is blowing upwards (a1_zm > 0 and wp2 > 0 always) - lhs(kp1_mdiag) = zero - - lhs(k_mdiag) & - = + invrs_dzt * invrs_rho_ds_zm & - * rho_ds_zm * a1_zm * wp3_on_wp2 - - lhs(km1_mdiag) & - = - invrs_dzt * invrs_rho_ds_zm & - * rho_ds_zmm1 * a1_zm_m1 * wp3_on_wp2_m1 - - else ! "Wind" is blowing downward - - lhs(kp1_mdiag) & - = + invrs_dztkp1 * invrs_rho_ds_zm & - * rho_ds_zmp1 * a1_zm_p1 * wp3_on_wp2_p1 - - lhs(k_mdiag) & - = - invrs_dztkp1 * invrs_rho_ds_zm & - * rho_ds_zm * a1_zm * wp3_on_wp2 - - lhs(km1_mdiag) = zero - - endif - - - return - end function wpxp_term_ta_lhs_upwind - - !============================================================================= - pure function wpxp_term_tp_lhs( wp2, invrs_dzm ) & - result( lhs ) - - ! Description: - ! Turbulent production of w'x': implicit portion of the code. - ! - ! The d(w'x')/dt equation contains a turbulent production term: - ! - ! - w'^2 d(xm)/dz. - ! - ! This term is solved for completely implicitly, such that: - ! - ! - w'^2 * d( xm(t+1) )/dz. - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed - ! to a "+". - ! - ! The timestep index (t+1) means that the value of xm being used is from the - ! next timestep, which is being advanced to in solving the d(w'x')/dt and - ! d(xm)/dt equations. - ! - ! This term is discretized as follows: - ! - ! The values of xm are found on thermodynamic levels, while the values of - ! w'^2 are found on momentum levels. The derivative of xm is taken over the - ! intermediate (central) momentum level, where it is multiplied by w'^2, - ! yielding the desired result. - ! - ! ---------------------------xmp1-------------------------- t(k+1) - ! - ! ==========wp2=====================d(xm)/dz=============== m(k) - ! - ! ---------------------------xm---------------------------- t(k) - ! - ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes - ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for - ! thermodynamic levels and the letter "m" is used for momentum levels. - ! - ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. - k_tdiag = 2 ! Thermodynamic subdiagonal index. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - wp2, & ! w'^2(k) [m^2/s^2] - invrs_dzm ! Inverse of grid spacing (k) [1/m] - - ! Return Variable - real( kind = core_rknd ), dimension(2) :: lhs - - - ! Thermodynamic superdiagonal [ x xm(k+1,) ] - lhs(kp1_tdiag) & - = + wp2 * invrs_dzm - - ! Thermodynamic subdiagonal [ x xm(k,) ] - lhs(k_tdiag) & - = - wp2 * invrs_dzm - - - return - end function wpxp_term_tp_lhs - - !============================================================================= - pure function wpxp_terms_ac_pr2_lhs( C7_Skw_fnc, & - wm_ztp1, wm_zt, invrs_dzm ) & - result( lhs ) - - ! Description: - ! Accumulation of w'x' and w'x' pressure term 2: implicit portion of the - ! code. - ! - ! The d(w'x')/dt equation contains an accumulation term: - ! - ! - w'x' dw/dz; - ! - ! and pressure term 2: - ! - ! + C_7 w'x' dw/dz. - ! - ! Both the w'x' accumulation term and pressure term 2 are completely - ! implicit. The accumulation term and pressure term 2 are combined and - ! solved together as: - ! - ! - ( 1 - C_7 ) * w'x'(t+1) * dw/dz. - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed - ! to a "+". - ! - ! The timestep index (t+1) means that the value of w'x' being used is from - ! the next timestep, which is being advanced to in solving the d(w'x')/dt - ! equation. - ! - ! The terms are discretized as follows: - ! - ! The values of w'x' are found on momentum levels, while the values of wm_zt - ! (mean vertical velocity on thermodynamic levels) are found on - ! thermodynamic levels. The vertical derivative of wm_zt is taken over the - ! intermediate (central) momentum level. It is then multiplied by w'x' - ! (implicitly calculated at timestep (t+1)) and the coefficients to yield - ! the desired results. - ! - ! -------wm_ztp1------------------------------------------- t(k+1) - ! - ! ===============d(wm_zt)/dz============wpxp=============== m(k) - ! - ! -------wm_zt--------------------------------------------- t(k) - ! - ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes - ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for - ! thermodynamic levels and the letter "m" is used for momentum levels. - ! - ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - one ! Constant(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C7_Skw_fnc, & ! C_7 parameter with Sk_w applied (k) [-] - wm_ztp1, & ! w wind component on thermodynamic level (k+1) [m/s] - wm_zt, & ! w wind component on thermodynamic level (k) [m/s] - invrs_dzm ! Inverse of grid spacing (k) [1/m] - - - ! Return Variable - real( kind = core_rknd ) :: lhs - - - ! Momentum main diagonal: [ x wpxp(k,) ] - lhs = ( one - C7_Skw_fnc ) * invrs_dzm * ( wm_ztp1 - wm_zt ) - - - return - end function wpxp_terms_ac_pr2_lhs - - !============================================================================= - pure function wpxp_term_pr1_lhs( C6x_Skw_fnc, tau_zm ) & - result( lhs ) - - ! Description - ! Pressure term 1 for w'x': implicit portion of the code. - ! - ! The d(w'x')/dt equation contains pressure term 1: - ! - ! - ( C_6 / tau_m ) w'x'. - ! - ! This term is solved for completely implicitly, such that: - ! - ! - ( C_6 / tau_m ) w'x'(t+1) - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed - ! to a "+". - ! - ! The timestep index (t+1) means that the value of w'x' being used is from - ! the next timestep, which is being advanced to in solving the d(w'x')/dt - ! equation. - ! - ! The values of w'x' are found on the momentum levels. The values of the - ! C_6 skewness function and time-scale tau_m are also found on the momentum - ! levels. - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C6x_Skw_fnc, & ! C_6x parameter with Sk_w applied (k) [-] - tau_zm ! Time-scale tau at momentum level (k) [s] - - ! Return Variable - real( kind = core_rknd ) :: lhs - - - ! Momentum main diagonal: [ x wpxp(k,) ] - lhs = C6x_Skw_fnc / tau_zm - - - return - end function wpxp_term_pr1_lhs - - !============================================================================= - pure function wpxp_terms_bp_pr3_rhs( C7_Skw_fnc, thv_ds_zm, xpthvp ) & - result( rhs ) - - ! Description: - ! Buoyancy production of w'x' and w'x' pressure term 3: explicit portion of - ! the code. - ! - ! The d(w'x')/dt equation contains a buoyancy production term: - ! - ! + (g/thv_ds) x'th_v'; - ! - ! and pressure term 3: - ! - ! - C_7 (g/thv_ds) x'th_v'. - ! - ! Both the w'x' buoyancy production term and pressure term 3 are completely - ! explicit. The buoyancy production term and pressure term 3 are combined - ! and solved together as: - ! - ! + ( 1 - C_7 ) * (g/thv_ds) * x'th_v'. - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_constants_clubb, only: & ! Constants(s) - grav, & ! Gravitational acceleration [m/s^2] - one - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C7_Skw_fnc, & ! C_7 parameter with Sk_w applied (k) [-] - thv_ds_zm, & ! Dry, base-state theta_v on mom. lev. (k) [K] - xpthvp ! x'th_v'(k) [K {xm units}] - - ! Return Variable - real( kind = core_rknd ) :: rhs - - - rhs = ( grav / thv_ds_zm ) * ( one - C7_Skw_fnc ) * xpthvp - - - return - end function wpxp_terms_bp_pr3_rhs - - !============================================================================= - subroutine xm_correction_wpxp_cl( solve_type, dt, wpxp_chnge, invrs_dzt, & - xm ) - - ! Description: - ! Corrects the value of xm if w'x' needed to be clipped, for xm is partially - ! based on the derivative of w'x' with respect to altitude. - ! - ! The time-tendency equation for xm is: - ! - ! d(xm)/dt = -w d(xm)/dz - d(w'x')/dz + d(xm)/dt|_ls; - ! - ! where d(xm)/dt|_ls is the rate of change of xm over time due to radiation, - ! microphysics, and/or any other large-scale forcing(s). - ! - ! The time-tendency equation for xm is solved in conjunction with the - ! time-tendency equation for w'x'. Both equations are solved together in a - ! semi-implicit manner. However, after both equations have been solved (and - ! thus both xm and w'x' have been advanced to the next timestep with - ! timestep index {t+1}), the value of covariance w'x' may be clipped at any - ! level in order to prevent the correlation of w and x from becoming greater - ! than 1 or less than -1. - ! - ! The correlation between w and x is: - ! - ! corr_(w,x) = w'x' / [ sqrt(w'^2) * sqrt(x'^2) ]. - ! - ! The correlation must always have a value between -1 and 1, such that: - ! - ! -1 <= corr_(w,x) <= 1. - ! - ! Therefore, there is an upper limit on w'x', such that: - ! - ! w'x' <= [ sqrt(w'^2) * sqrt(x'^2) ]; - ! - ! and a lower limit on w'x', such that: - ! - ! w'x' >= -[ sqrt(w'^2) * sqrt(x'^2) ]. - ! - ! The aforementioned time-tendency equation for xm is based on the value of - ! w'x' without being clipped (w'x'{t+1}_unclipped), such that: - ! - ! d(xm)/dt = -w d(xm{t+1})/dz - d(w'x'{t+1}_unclipped)/dz + d(xm{t})/dt|_ls; - ! - ! where the both the mean advection term, -w d(xm{t+1})/dz, and the - ! turbulent advection term, -d(w'x'{t+1}_unclipped)/dz, are solved - ! completely implicitly. The xm forcing term, +d(xm{t})/dt|_ls, is solved - ! completely explicitly. - ! - ! However, if w'x' needs to be clipped after being advanced one timestep, - ! then xm needs to be altered to reflect the fact that w'x' has a different - ! value than the value used while both were being solved together. Ideally, - ! the xm time-tendency equation that should be used is: - ! - ! d(xm)/dt = -w d(xm{t+1})/dz - d(w'x'{t+1}_clipped)/dz + d(xm{t})/dt|_ls. - ! - ! However, w'x'{t+1}_clipped isn't known until after the w'x' and xm - ! equations have been solved together. However, a proper adjuster can be - ! applied to xm through the use of the following relationship: - ! - ! w'x'{t+1}_clipped = w'x'{t+1}_unclipped + w'x'{t+1}_amount_clipped; - ! - ! at any given vertical level. - ! - ! When the expression above is substituted into the preceeding xm - ! time-tendency equation, the resulting equation for xm time-tendency is: - ! - ! d(xm)/dt = -w d(xm{t+1})/dz - d(w'x'{t+1}_unclipped)/dz - ! - d(w'x'{t+1}_amount_clipped)/dz + d(xm{t})/dt|_ls. - ! - ! Thus, the resulting xm time-tendency equation is the same as the original - ! xm time-tendency equation, but with added adjuster term: - ! - ! -d(w'x'{t+1}_amount_clipped)/dz. - ! - ! Since the adjuster term needs to be applied after xm has already been - ! solved, it needs to be multiplied by the timestep length and added on to - ! xm{t+1}, such that: - ! - ! xm{t+1}_after_adjustment = - ! xm{t+1}_before_adjustment + ( -d(w'x'{t+1}_amount_clipped)/dz ) * dt. - ! - ! The adjuster term is discretized as follows: - ! - ! The values of w'x' are located on the momentum levels. Thus, the values - ! of w'x'_amount_clipped are also located on the momentum levels. The - ! values of xm are located on the thermodynamic levels. The derivatives - ! (d/dz) of w'x'_amount_clipped are taken over the intermediate - ! thermodynamic levels, where they are applied to xm. - ! - ! =======wpxp_amount_clipped=============================== m(k) - ! - ! -----------------------------d(wpxp_amount_clipped)/dz--- t(k) - ! - ! =======wpxpm1_amount_clipped============================= m(k-1) - ! - ! The vertical indices m(k), t(k), and m(k-1) correspond with altitudes - ! zm(k), zt(k), and zm(k-1), respectively. The letter "t" is used for - ! thermodynamic levels and the letter "m" is used for momentum levels. - ! - ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) - - ! Note: The results of this xm adjustment are highly dependent on the - ! numerical stability and the smoothness of the w'^2 and x'^2 fields. - ! An unstable "sawtooth" profile for w'^2 and/or x'^2 causes an - ! unstable "sawtooth" profile for the upper and lower limits on w'x'. - ! In turn, this causes an unstable "sawtooth" profile for - ! w'x'_amount_clipped. Taking the derivative of that such a "noisy" - ! field and applying the results to xm causes the xm field to become - ! more "noisy" and unstable. - - ! References: - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s); gr%nz only. - - use crmx_clubb_precision, only: & - time_precision, & - core_rknd - - use crmx_stats_type, only: & - stat_update_var ! Procedure(s) - - use crmx_stats_variables, only: & - l_stats_samp, & ! Variable(s) - zt, & - ithlm_tacl, & - irtm_tacl - - implicit none - - ! Input Variables - integer, intent(in) :: & - solve_type ! Variable that is being solved for. - - real(kind=time_precision), intent(in) :: & - dt ! Model timestep [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - wpxp_chnge, & ! Amount of change in w'x' due to clipping [m/s {xm units}] - invrs_dzt ! Inverse of grid spacing [1/m] - - ! Input/Output Variable - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - xm ! xm (thermodynamic levels) [{xm units}] - - ! Local Variables - real( kind = core_rknd ), dimension(gr%nz) :: & - xm_tndcy_wpxp_cl ! d(xm)/dt due to clipping of w'x' [{xm units}/s] - - integer :: k ! Array index - - integer :: ixm_tacl ! Statistical index - - - select case ( solve_type ) - case ( xm_wpxp_rtm ) - ixm_tacl = irtm_tacl - case ( xm_wpxp_thlm ) - ixm_tacl = ithlm_tacl - case default - ixm_tacl = 0 - end select - - ! Adjusting xm based on clipping for w'x'. - ! Loop over all thermodynamic levels between the second-lowest and the - ! highest. - do k = 2, gr%nz, 1 - xm_tndcy_wpxp_cl(k) = - invrs_dzt(k) * ( wpxp_chnge(k) - wpxp_chnge(k-1) ) - xm(k) = xm(k) + xm_tndcy_wpxp_cl(k) * real( dt, kind = core_rknd ) - enddo - - if ( l_stats_samp ) then - ! The adjustment to xm due to turbulent advection term clipping - ! (xm term tacl) is completely explicit; call stat_update_var. - call stat_update_var( ixm_tacl, xm_tndcy_wpxp_cl, zt ) - endif - - - return - - end subroutine xm_correction_wpxp_cl - - - !============================================================================= - pure function damp_coefficient( coefficient, Cx_Skw_fnc, max_coeff_value, & - threshold, Lscale ) & - result( damped_value ) - - ! Description: - ! Damps a given coefficient linearly based on the value of Lscale. - ! For additional information see CLUBB ticket #431. - - use crmx_constants_clubb, only: & - one_hundred ! Constant(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_grid_class, only: & - gr ! Variable(s) - - implicit none - - ! Input variables - real( kind = core_rknd ), intent(in) :: & - coefficient, & ! The coefficient to be damped - max_coeff_value, & ! Maximum value the damped coefficient should have - threshold ! Value of Lscale below which the damping should occur - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - Lscale, & ! Current value of Lscale - Cx_Skw_fnc ! Initial skewness function before damping - - ! Local variables - real( kind = core_rknd ), parameter :: & - ! Added to prevent large damping at low altitudes where Lscale is small - altitude_threshold = one_hundred ! Altitude above which damping should occur - - ! Return Variable - real( kind = core_rknd ), dimension(gr%nz) :: damped_value - - damped_value = Cx_Skw_fnc - - where( Lscale < threshold .and. gr%zt > altitude_threshold) - damped_value = max_coeff_value & - + ( ( coefficient - max_coeff_value ) / threshold ) & - * Lscale - end where - - return - - end function damp_coefficient -!=============================================================================== - -end module crmx_advance_xm_wpxp_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_advance_xp2_xpyp_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_advance_xp2_xpyp_module.F90 deleted file mode 100644 index c4f490df6f..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_advance_xp2_xpyp_module.F90 +++ /dev/null @@ -1,3417 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: advance_xp2_xpyp_module.F90 6149 2013-04-08 21:45:56Z storer@uwm.edu $ -!=============================================================================== -module crmx_advance_xp2_xpyp_module - - ! Description: - ! Contains the subroutine advance_xp2_xpyp and ancillary functions. - !----------------------------------------------------------------------- - - implicit none - - public :: advance_xp2_xpyp, & - update_xp2_mc_tndcy - - private :: xp2_xpyp_lhs, & - xp2_xpyp_solve, & - xp2_xpyp_uv_rhs, & - xp2_xpyp_rhs, & - xp2_xpyp_implicit_stats, & - term_ta_lhs, & - term_ta_lhs_upwind, & - term_ta_rhs, & - term_tp, & - term_dp1_lhs, & - term_dp1_rhs, & - term_pr1, & - term_pr2 - - private ! Set default scope - - ! Private named constants to avoid string comparisons - integer, parameter, private :: & - xp2_xpyp_rtp2 = 1, & ! Named constant for rtp2 solves - xp2_xpyp_thlp2 = 2, & ! Named constant for thlp2 solves - xp2_xpyp_rtpthlp = 3, & ! Named constant for rtpthlp solves - xp2_xpyp_up2_vp2 = 4, & ! Named constant for up2_vp2 solves - xp2_xpyp_up2 = 5, & ! Named constant for up2 solves - xp2_xpyp_vp2 = 6, & ! Named constant for vp2 solves - xp2_xpyp_scalars = 7, & ! Named constant for scalar solves - xp2_xpyp_sclrp2 = 8, & ! Named constant for sclrp2 solves - xp2_xpyp_sclrprtp = 9, & ! Named constant for sclrprtp solves - xp2_xpyp_sclrpthlp = 10 ! Named constant for sclrpthlp solves - - contains - - !============================================================================= - subroutine advance_xp2_xpyp( tau_zm, wm_zm, rtm, wprtp, thlm, & - wpthlp, wpthvp, um, vm, wp2, wp2_zt, & - wp3, upwp, vpwp, sigma_sqd_w, Skw_zm, & - Kh_zt, rtp2_forcing, thlp2_forcing, & - rtpthlp_forcing, rho_ds_zm, rho_ds_zt, & - invrs_rho_ds_zm, thv_ds_zm, & - Lscale, wp3_on_wp2, wp3_on_wp2_zt, & - l_iter, dt, & - sclrm, wpsclrp, & - rtp2, thlp2, rtpthlp, up2, vp2, & - err_code, & - sclrp2, sclrprtp, sclrpthlp ) - - ! Description: - ! Subprogram to diagnose variances by solving steady-state equations - - ! References: - ! Eqn. 13, 14, 15 on p. 3545 of - ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: - ! Method and Model Description'' Golaz, et al. (2002) - ! JAS, Vol. 59, pp. 3540--3551. - - ! See also: - ! ``Equations for CLUBB'', Section 4: - ! /Steady-state solution for the variances/ - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - w_tol_sqd, & ! Constant(s) - rt_tol, & - thl_tol, & - w_tol_sqd, & - fstderr, & - one, & - two_thirds, & - one_half, & - one_third, & - zero, & - zero_threshold - - use crmx_model_flags, only: & - l_hole_fill, & ! logical constants - l_single_C2_Skw - - use crmx_parameters_tunable, only: & - C2rt, & ! Variable(s) - C2thl, & - C2rtthl, & - c_K2, & - nu2_vert_res_dep, & - c_K9, & - nu9_vert_res_dep, & - beta, & - C4, & - C14, & - C5, & - C2, & - C2b, & - C2c - - use crmx_parameters_model, only: & - sclr_dim, & ! Variable(s) - sclr_tol - - use crmx_grid_class, only: & - gr, & ! Variable(s) - zm2zt ! Procedure(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_clip_explicit, only: & - clip_covar, & ! Procedure(s) - clip_variance, & - clip_rtp2, & ! Variable(s) - clip_thlp2, & - clip_rtpthlp, & - clip_up2, & - clip_vp2, & - clip_sclrp2, & - clip_sclrprtp, & - clip_sclrpthlp - - use crmx_stats_type, only: & - stat_modify - - use crmx_error_code, only: & - clubb_no_error, & ! Variable(s) - clubb_var_out_of_range, & - clubb_singular_matrix - - use crmx_error_code, only: & - fatal_error, & ! Procedure(s) - clubb_at_least_debug_level - - use crmx_stats_variables, only: & - zm, & - irtp2_cl, & - l_stats_samp - - use crmx_array_index, only: & - iisclr_rt, & - iisclr_thl - - implicit none - - ! Intrinsic functions - intrinsic :: & - exp, sqrt, min - - ! Constant parameters - logical, parameter :: & - l_clip_large_rtp2 = .true. ! Clip rtp2 to be < rtm^2 * coef - - real( kind = core_rknd ), parameter :: & - rtp2_clip_coef = one_half ! Coefficient appled the clipping threshold on rtp2 [-] - - ! Input variables - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - tau_zm, & ! Time-scale tau on momentum levels [s] - wm_zm, & ! w-wind component on momentum levels [m/s] - rtm, & ! Total water mixing ratio (t-levs) [kg/kg] - wprtp, & ! (momentum levels) [(m/s)(kg/kg)] - thlm, & ! Liquid potential temp. (t-levs) [K] - wpthlp, & ! (momentum levels) [(m K)/s] - wpthvp, & ! (momentum levels) [(m K)/s] - um, & ! u wind (thermodynamic levels) [m/s] - vm, & ! v wind (thermodynamic levels) [m/s] - wp2, & ! (momentum levels) [m^2/s^2] - wp2_zt, & ! interpolated to thermo. levels [m^2/s^2] - wp3, & ! (thermodynamic levels) [m^3/s^3] - upwp, & ! (momentum levels) [m^2/s^2] - vpwp, & ! (momentum levels) [m^2/s^2] - sigma_sqd_w, & ! sigma_sqd_w (momentum levels) [-] - Skw_zm, & ! Skewness of w on momentum levels [-] - Kh_zt, & ! Eddy diffusivity on thermo. levels [m^2/s] - rtp2_forcing, & ! forcing (momentum levels) [(kg/kg)^2/s] - thlp2_forcing, & ! forcing (momentum levels) [K^2/s] - rtpthlp_forcing, & ! forcing (momentum levels) [(kg/kg)K/s] - rho_ds_zm, & ! Dry, static density on momentum levs. [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ mom. levs. [m^3/kg] - thv_ds_zm, & ! Dry, base-state theta_v on mom. levs. [K] - Lscale, & ! Mixing length [m] - wp3_on_wp2, & ! Smoothed version of / zm [m/s] - wp3_on_wp2_zt ! Smoothed version of / zt [m/s] - - logical, intent(in) :: l_iter ! Whether variances are prognostic - - real(kind=time_precision), intent(in) :: & - dt ! Model timestep [s] - - ! Passive scalar input - real( kind = core_rknd ), intent(in), dimension(gr%nz, sclr_dim) :: & - sclrm, wpsclrp - - ! Input/Output variables - ! An attribute of (inout) is also needed to import the value of the variances - ! at the surface. Brian. 12/18/05. - real( kind = core_rknd ), intent(inout), dimension(gr%nz) :: & - rtp2, & ! [(kg/kg)^2] - thlp2, & ! [K^2] - rtpthlp, & ! [(kg K)/kg] - up2, & ! [m^2/s^2] - vp2 ! [m^2/s^2] - - ! Output variable for singular matrices - integer, intent(inout) :: err_code - - ! Passive scalar output - real( kind = core_rknd ), intent(inout), dimension(gr%nz, sclr_dim) :: & - sclrp2, sclrprtp, sclrpthlp - - ! Local Variables - real( kind = core_rknd ), dimension(gr%nz) :: & - C2sclr_1d, C2rt_1d, C2thl_1d, C2rtthl_1d, & - C4_C14_1d ! Parameters C4 and C14 combined for simplicity - - real( kind = core_rknd ), dimension(gr%nz) :: & - a1 ! a_1 (momentum levels); See eqn. 24 in `Equations for CLUBB' [-] - - real( kind = core_rknd ), dimension(gr%nz) :: & - upwp_zt, & ! interpolated to thermodynamic levels [m^2/s^2] - vpwp_zt, & ! interpolated to thermodynamic levels [m^2/s^2] - wpsclrp_zt ! interp. to thermo. levels [m/s {sclrm units}] - - real( kind = core_rknd ) :: & - threshold ! Minimum value for variances [units vary] - - real( kind = core_rknd ), dimension(3,gr%nz) :: & - lhs ! Tridiagonal matrix - - real( kind = core_rknd ), dimension(gr%nz,1) :: & - rhs ! RHS vector of tridiagonal matrix - - real( kind = core_rknd ), dimension(gr%nz,2) :: & - uv_rhs, &! RHS vectors of tridiagonal system for up2/vp2 - uv_solution ! Solution to the tridiagonal system for up2/vp2 - - real( kind = core_rknd ), dimension(gr%nz,sclr_dim*3) :: & - sclr_rhs, & ! RHS vectors of tridiagonal system for the passive scalars - sclr_solution ! Solution to tridiagonal system for the passive scalars - - integer, dimension(5+1) :: & - err_code_array ! Array containing the error codes for each variable - - ! Eddy Diffusion for Variances and Covariances. - real( kind = core_rknd ), dimension(gr%nz) :: & - Kw2, & ! For rtp2, thlp2, rtpthlp, and passive scalars [m^2/s] - Kw9 ! For up2 and vp2 [m^2/s] - - real( kind = core_rknd ), dimension(gr%nz) :: & - a1_zt, & ! a_1 interpolated to thermodynamic levels [-] - wprtp_zt, & ! w'r_t' interpolated to thermodynamic levels [(kg/kg) m/s] - wpthlp_zt ! w'th_l' interpolated to thermodyamnic levels [K m/s] - - real( kind = core_rknd ), dimension(gr%nz) :: & - rtpthlp_chnge ! Net change in r_t'th_l' due to clipping [(kg/kg) K] - - real( kind = core_rknd ), dimension(gr%nz,sclr_dim) :: & - sclrprtp_chnge, & ! Net change in sclr'r_t' due to clipping [{units vary}] - sclrpthlp_chnge ! Net change in sclr'th_l' due to clipping [{units vary}] - - real( kind = core_rknd ), dimension(gr%nz) :: & - sclrp2_forcing, & ! forcing (momentum levels) [units vary] - sclrprtp_forcing, & ! forcing (momentum levels) [units vary] - sclrpthlp_forcing ! forcing (momentum levels) [units vary] - - logical :: l_scalar_calc, l_first_clip_ts, l_last_clip_ts - - ! Loop indices - integer :: i, k - - !---------------------------- Begin Code ---------------------------------- - - if ( clubb_at_least_debug_level( 2 ) ) then - ! Assertion check for C5 - if ( C5 > one .or. C5 < zero ) then - write(fstderr,*) "The C5 variable is outside the valid range" - err_code = clubb_var_out_of_range - return - end if - end if - - if ( l_single_C2_Skw ) then - ! Use a single value of C2 for all equations. - C2rt_1d(1:gr%nz) & - = C2b + (C2-C2b) *exp( -one_half * (Skw_zm(1:gr%nz)/C2c)**2 ) - - C2thl_1d = C2rt_1d - C2rtthl_1d = C2rt_1d - - C2sclr_1d = C2rt_1d - else - ! Use 3 different values of C2 for rtp2, thlp2, rtpthlp. - C2rt_1d(1:gr%nz) = C2rt - C2thl_1d(1:gr%nz) = C2thl - C2rtthl_1d(1:gr%nz) = C2rtthl - - C2sclr_1d(1:gr%nz) = C2rt ! Use rt value for now - end if - - ! Combine C4 and C14 for simplicity - C4_C14_1d(1:gr%nz) = ( two_thirds * C4 ) + ( one_third * C14 ) - - ! Are we solving for passive scalars as well? - if ( sclr_dim > 0 ) then - l_scalar_calc = .true. - else - l_scalar_calc = .false. - end if - - - ! Define a_1 (located on momentum levels). - ! It is a variable that is a function of sigma_sqd_w (where sigma_sqd_w is - ! located on the momentum levels). - a1(1:gr%nz) = one / ( one - sigma_sqd_w(1:gr%nz) ) - - - ! Interpolate a_1, w'r_t', w'th_l', u'w', and v'w' from the momentum levels - ! to the thermodynamic levels. These will be used for the turbulent - ! advection (ta) terms in each equation. - a1_zt = max( zm2zt( a1 ), zero_threshold ) ! Positive definite quantity - wprtp_zt = zm2zt( wprtp ) - wpthlp_zt = zm2zt( wpthlp ) - upwp_zt = zm2zt( upwp ) - vpwp_zt = zm2zt( vpwp ) - - ! Initialize tridiagonal solutions to valid - - err_code_array(:) = clubb_no_error - - - ! Define the Coefficent of Eddy Diffusivity for the variances - ! and covariances. - do k = 1, gr%nz, 1 - - ! Kw2 is used for variances and covariances rtp2, thlp2, rtpthlp, and - ! passive scalars. The variances and covariances are located on the - ! momentum levels. Kw2 is located on the thermodynamic levels. - ! Kw2 = c_K2 * Kh_zt - Kw2(k) = c_K2 * Kh_zt(k) - - ! Kw9 is used for variances up2 and vp2. The variances are located on - ! the momentum levels. Kw9 is located on the thermodynamic levels. - ! Kw9 = c_K9 * Kh_zt - Kw9(k) = c_K9 * Kh_zt(k) - - enddo - - !!!!!***** r_t'^2 *****!!!!! - - ! Implicit contributions to term rtp2 - call xp2_xpyp_lhs( dt, l_iter, wp3_on_wp2_zt, wp3_on_wp2, & ! Intent(in) - a1, a1_zt, tau_zm, wm_zm, Kw2, & ! Intent(in) - rho_ds_zt, rho_ds_zm, invrs_rho_ds_zm, & ! Intent(in) - C2rt_1d, nu2_vert_res_dep, beta, & ! Intent(in) - lhs ) ! Intent(out) - - - call xp2_xpyp_rhs( xp2_xpyp_rtp2, dt, l_iter, a1, a1_zt, & ! Intent(in) - wp2_zt, wprtp, wprtp_zt, wp3_on_wp2, & ! Intent(in) - wp3_on_wp2_zt, wprtp, wprtp_zt, & ! Intent(in) - rtm, rtm, rtp2, rtp2_forcing, & ! Intent(in) - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! Intent(in) - C2rt_1d, tau_zm, rt_tol**2, beta, & ! Intent(in) - rhs ) ! Intent(out) - - ! Solve the tridiagonal system - call xp2_xpyp_solve( xp2_xpyp_rtp2, 1, & ! Intent(in) - rhs, lhs, rtp2, & ! Intent(inout) - err_code_array(1) ) ! Intent(out) - - if ( l_stats_samp ) then - call xp2_xpyp_implicit_stats( xp2_xpyp_rtp2, rtp2 ) ! Intent(in) - end if - - !!!!!***** th_l'^2 *****!!!!! - - ! Implicit contributions to term thlp2 - call xp2_xpyp_lhs( dt, l_iter, wp3_on_wp2_zt, wp3_on_wp2, & ! Intent(in) - a1, a1_zt, tau_zm, wm_zm, Kw2, & ! Intent(in) - rho_ds_zt, rho_ds_zm, invrs_rho_ds_zm, & ! Intent(in) - C2thl_1d, nu2_vert_res_dep, beta, & ! Intent(in) - lhs ) ! Intent(out) - - ! Explicit contributions to thlp2 - call xp2_xpyp_rhs( xp2_xpyp_thlp2, dt, l_iter, a1, a1_zt, & ! Intent(in) - wp2_zt, wpthlp, wpthlp_zt, wp3_on_wp2, & ! Intent(in) - wp3_on_wp2_zt, wpthlp, wpthlp_zt, & ! Intent(in) - thlm, thlm, thlp2, thlp2_forcing, & ! Intent(in) - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! Intent(in) - C2thl_1d, tau_zm, thl_tol**2, beta, & ! Intent(in) - rhs ) ! Intent(out) - - ! Solve the tridiagonal system - call xp2_xpyp_solve( xp2_xpyp_thlp2, 1, & ! Intent(in) - rhs, lhs, thlp2, & ! Intent(inout) - err_code_array(2) ) ! Intent(out) - - if ( l_stats_samp ) then - call xp2_xpyp_implicit_stats( xp2_xpyp_thlp2, thlp2 ) ! Intent(in) - end if - - - !!!!!***** r_t'th_l' *****!!!!! - - ! Implicit contributions to term rtpthlp - call xp2_xpyp_lhs( dt, l_iter, wp3_on_wp2_zt, wp3_on_wp2, & ! Intent(in) - a1, a1_zt, tau_zm, wm_zm, Kw2, & ! Intent(in) - rho_ds_zt, rho_ds_zm, invrs_rho_ds_zm, & ! Intent(in) - C2rtthl_1d, nu2_vert_res_dep, beta, & ! Intent(in) - lhs ) ! Intent(out) - - ! Explicit contributions to rtpthlp - call xp2_xpyp_rhs( xp2_xpyp_rtpthlp, dt, l_iter, a1, a1_zt, & ! Intent(in) - wp2_zt, wprtp, wprtp_zt, wp3_on_wp2, & ! Intent(in) - wp3_on_wp2_zt, wpthlp, wpthlp_zt, & ! Intent(in) - rtm, thlm, rtpthlp, rtpthlp_forcing, & ! Intent(in) - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! Intent(in) - C2rtthl_1d, tau_zm, zero_threshold, beta, & ! Intent(in) - rhs ) ! Intent(out) - - ! Solve the tridiagonal system - call xp2_xpyp_solve( xp2_xpyp_rtpthlp, 1, & ! Intent(in) - rhs, lhs, rtpthlp, & ! Intent(inout) - err_code_array(3) ) ! Intent(out) - - if ( l_stats_samp ) then - call xp2_xpyp_implicit_stats( xp2_xpyp_rtpthlp, rtpthlp ) ! Intent(in) - end if - - - !!!!!***** u'^2 / v'^2 *****!!!!! - - ! Implicit contributions to term up2/vp2 - call xp2_xpyp_lhs( dt, l_iter, wp3_on_wp2_zt, wp3_on_wp2, & ! Intent(in) - a1, a1_zt, tau_zm, wm_zm, Kw9, & ! Intent(in) - rho_ds_zt, rho_ds_zm, invrs_rho_ds_zm, & ! Intent(in) - C4_C14_1d, nu9_vert_res_dep, beta, & ! Intent(in) - lhs ) ! Intent(out) - - ! Explicit contributions to up2 - call xp2_xpyp_uv_rhs( xp2_xpyp_up2, dt, l_iter, a1, a1_zt, wp2, & ! Intent(in) - wp2_zt, wpthvp, Lscale, wp3_on_wp2_zt, & ! Intent(in) - wp3_on_wp2, C4_C14_1d, tau_zm, & ! Intent(in) - um, vm, upwp, upwp_zt, vpwp, vpwp_zt, & ! Intent(in) - up2, vp2, rho_ds_zt, invrs_rho_ds_zm, & ! Intent(in) - rho_ds_zm, & ! Intent(in) - thv_ds_zm, C4, C5, C14, beta, & ! Intent(in) - uv_rhs(:,1) ) ! Intent(out) - - ! Explicit contributions to vp2 - call xp2_xpyp_uv_rhs( xp2_xpyp_vp2, dt, l_iter, a1, a1_zt, wp2, & ! Intent(in) - wp2_zt, wpthvp, Lscale, wp3_on_wp2_zt, & ! Intent(in) - wp3_on_wp2, C4_C14_1d, tau_zm, & ! Intent(in) - vm, um, vpwp, vpwp_zt, upwp, upwp_zt, & ! Intent(in) - vp2, up2, rho_ds_zt, invrs_rho_ds_zm, & ! Intent(in) - rho_ds_zm, & ! Intent(in) - thv_ds_zm, C4, C5, C14, beta, & ! Intent(in) - uv_rhs(:,2) ) ! Intent(out) - - ! Solve the tridiagonal system - call xp2_xpyp_solve( xp2_xpyp_up2_vp2, 2, & ! Intent(in) - uv_rhs, lhs, & ! Intent(inout) - uv_solution, err_code_array(4) ) ! Intent(out) - - up2(1:gr%nz) = uv_solution(1:gr%nz,1) - vp2(1:gr%nz) = uv_solution(1:gr%nz,2) - - if ( l_stats_samp ) then - call xp2_xpyp_implicit_stats( xp2_xpyp_up2, up2 ) ! Intent(in) - call xp2_xpyp_implicit_stats( xp2_xpyp_vp2, vp2 ) ! Intent(in) - end if - - - ! Apply the positive definite scheme to variances - if ( l_hole_fill ) then - call pos_definite_variances( xp2_xpyp_rtp2, dt, rt_tol**2, & ! Intent(in) - rho_ds_zm, rho_ds_zt, & ! Intent(in) - rtp2 ) ! Intent(inout) - call pos_definite_variances( xp2_xpyp_thlp2, dt, thl_tol**2, & ! Intent(in) - rho_ds_zm, rho_ds_zt, & ! Intent(in) - thlp2 ) ! Intent(inout) - call pos_definite_variances( xp2_xpyp_up2, dt, w_tol_sqd, & ! Intent(in) - rho_ds_zm, rho_ds_zt, & ! Intent(in) - up2 ) ! Intent(inout) - call pos_definite_variances( xp2_xpyp_vp2, dt, w_tol_sqd, & ! Intent(in) - rho_ds_zm, rho_ds_zt, & ! Intent(in) - vp2 ) ! Intent(inout) - endif - - - ! Clipping for r_t'^2 - - !threshold = zero_threshold - ! - !where ( wp2 >= w_tol_sqd ) & - ! threshold = rt_tol*rt_tol - - threshold = rt_tol**2 - - call clip_variance( xp2_xpyp_rtp2, dt, threshold, & ! Intent(in) - rtp2 ) ! Intent(inout) - - ! Special clipping on the variance of rt to prevent a large variance at - ! higher altitudes. This is done because we don't want the PDF to extend - ! into the negative, and found that for latin hypercube sampling a large - ! variance aloft leads to negative samples of total water. - ! -dschanen 8 Dec 2010 - if ( l_clip_large_rtp2 ) then - - ! This overwrites stats clipping data from clip_variance - if ( l_stats_samp ) then - call stat_modify( irtp2_cl, -rtp2 / real( dt, kind = core_rknd ), zm ) - endif - - do k = 1, gr%nz - threshold = rtp2_clip_coef * rtm(k)**2 - if ( rtp2(k) > threshold ) then - rtp2(k) = threshold - end if - end do ! k = 1..gr%nz - - if ( l_stats_samp ) then - call stat_modify( irtp2_cl, rtp2 / real( dt, kind = core_rknd ), zm ) - endif - - end if ! l_clip_large_rtp2 - - - - ! Clipping for th_l'^2 - - !threshold = zero_threshold - ! - !where ( wp2 >= w_tol_sqd ) & - ! threshold = thl_tol*thl_tol - - threshold = thl_tol**2 - - call clip_variance( xp2_xpyp_thlp2, dt, threshold, & ! Intent(in) - thlp2 ) ! Intent(inout) - - - ! Clipping for u'^2 - - !threshold = zero_threshold - threshold = w_tol_sqd - - call clip_variance( xp2_xpyp_up2, dt, threshold, & ! Intent(in) - up2 ) ! Intent(inout) - - - ! Clipping for v'^2 - - !threshold = zero_threshold - threshold = w_tol_sqd - - call clip_variance( xp2_xpyp_vp2, dt, threshold, & ! Intent(in) - vp2 ) ! Intent(inout) - - - ! Clipping for r_t'th_l' - ! Clipping r_t'th_l' at each vertical level, based on the - ! correlation of r_t and th_l at each vertical level, such that: - ! corr_(r_t,th_l) = r_t'th_l' / [ sqrt(r_t'^2) * sqrt(th_l'^2) ]; - ! -1 <= corr_(r_t,th_l) <= 1. - ! Since r_t'^2, th_l'^2, and r_t'th_l' are all computed in the - ! same place, clipping for r_t'th_l' only has to be done once. - l_first_clip_ts = .true. - l_last_clip_ts = .true. - call clip_covar( xp2_xpyp_rtpthlp, l_first_clip_ts, & ! Intent(in) - l_last_clip_ts, dt, rtp2, thlp2, & ! Intent(in) - rtpthlp, rtpthlp_chnge ) ! Intent(inout) - - if ( l_scalar_calc ) then - - ! Implicit contributions to passive scalars - - !!!!!***** sclr'^2, sclr'r_t', sclr'th_l' *****!!!!! - - call xp2_xpyp_lhs( dt, l_iter, wp3_on_wp2_zt, wp3_on_wp2, & ! Intent(in) - a1, a1_zt, tau_zm, wm_zm, Kw2, & ! Intent(in) - rho_ds_zt, rho_ds_zm, invrs_rho_ds_zm, & ! Intent(in) - C2sclr_1d, nu2_vert_res_dep, beta, & ! Intent(in) - lhs ) ! Intent(out) - - - ! Explicit contributions to passive scalars - - do i = 1, sclr_dim, 1 - - ! Interpolate w'sclr' from momentum levels to thermodynamic - ! levels. These will be used for the turbulent advection (ta) - ! terms in each equation. - wpsclrp_zt = zm2zt( wpsclrp(:,i) ) - - ! Forcing for . - sclrp2_forcing = zero - - !!!!!***** sclr'^2 *****!!!!! - - call xp2_xpyp_rhs( xp2_xpyp_sclrp2, dt, l_iter, a1, a1_zt, & ! In - wp2_zt, wpsclrp(:,i), wpsclrp_zt, wp3_on_wp2, & ! In - wp3_on_wp2_zt, wpsclrp(:,i), wpsclrp_zt, & ! In - sclrm(:,i), sclrm(:,i), sclrp2(:,i), sclrp2_forcing, & ! In - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! In - C2sclr_1d, tau_zm, sclr_tol(i)**2, beta, & ! In - sclr_rhs(:,i) ) ! Out - - - !!!!!***** sclr'r_t' *****!!!!! - if ( i == iisclr_rt ) then - ! In this case we're trying to emulate rt'^2 with sclr'rt', so we - ! handle this as we would a variance, even though generally speaking - ! the scalar is not rt - sclrprtp_forcing = rtp2_forcing - threshold = rt_tol**2 - else - sclrprtp_forcing = zero - threshold = zero_threshold - endif - - call xp2_xpyp_rhs( xp2_xpyp_sclrprtp, dt, l_iter, a1, a1_zt, & ! In - wp2_zt, wpsclrp(:,i), wpsclrp_zt, wp3_on_wp2, & ! In - wp3_on_wp2_zt, wprtp, wprtp_zt, & ! In - sclrm(:,i), rtm, sclrprtp(:,i), sclrprtp_forcing, & ! In - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! In - C2sclr_1d, tau_zm, threshold, beta, & ! In - sclr_rhs(:,i+sclr_dim) ) ! Out - - - !!!!!***** sclr'th_l' *****!!!!! - - if ( i == iisclr_thl ) then - ! In this case we're trying to emulate thl'^2 with sclr'thl', so we - ! handle this as we did with sclr_rt, above. - sclrpthlp_forcing = thlp2_forcing - threshold = thl_tol**2 - else - sclrpthlp_forcing = zero - threshold = zero_threshold - endif - - call xp2_xpyp_rhs( xp2_xpyp_sclrpthlp, dt, l_iter, a1, a1_zt, & ! In - wp2_zt, wpsclrp(:,i), wpsclrp_zt, wp3_on_wp2, & ! In - wp3_on_wp2_zt, wpthlp, wpthlp_zt, & ! In - sclrm(:,i), thlm, sclrpthlp(:,i), sclrpthlp_forcing, & ! In - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! In - C2sclr_1d, tau_zm, threshold, beta, & ! In - sclr_rhs(:,i+2*sclr_dim) ) ! Out - - - enddo ! 1..sclr_dim - - - ! Solve the tridiagonal system - - call xp2_xpyp_solve( xp2_xpyp_scalars, 3*sclr_dim, & ! Intent(in) - sclr_rhs, lhs, sclr_solution, & ! Intent(inout) - err_code_array(6) ) ! Intent(out) - - sclrp2(:,1:sclr_dim) = sclr_solution(:,1:sclr_dim) - - sclrprtp(:,1:sclr_dim) = sclr_solution(:,sclr_dim+1:2*sclr_dim) - - sclrpthlp(:,1:sclr_dim) = sclr_solution(:,2*sclr_dim+1:3*sclr_dim) - - ! Apply hole filling algorithm to the scalar variance terms - if ( l_hole_fill ) then - do i = 1, sclr_dim, 1 - call pos_definite_variances( xp2_xpyp_sclrp2, dt, sclr_tol(i)**2, & ! Intent(in) - rho_ds_zm, rho_ds_zt, & ! Intent(in) - sclrp2(:,i) ) ! Intent(inout) - if ( i == iisclr_rt ) then - ! Here again, we do this kluge here to make sclr'rt' == rt'^2 - call pos_definite_variances( xp2_xpyp_sclrprtp, dt, sclr_tol(i)**2, & ! Intent(in) - rho_ds_zm, rho_ds_zt, & ! Intent(in) - sclrprtp(:,i) ) ! Intent(inout) - end if - if ( i == iisclr_thl ) then - ! As with sclr'rt' above, but for sclr'thl' - call pos_definite_variances( xp2_xpyp_sclrpthlp, dt, sclr_tol(i)**2, & ! Intent(in) - rho_ds_zm, rho_ds_zt, & ! Intent(in) - sclrpthlp(:,i) ) ! Intent(inout) - end if - enddo - endif - - - ! Clipping for sclr'^2 - do i = 1, sclr_dim, 1 - -! threshold = zero_threshold -! -! where ( wp2 >= w_tol_sqd ) & -! threshold = sclr_tol(i)*sclr_tol(i) - - threshold = sclr_tol(i)**2 - - call clip_variance( clip_sclrp2, dt, threshold, & ! Intent(in) - sclrp2(:,i) ) ! Intent(inout) - - enddo - - - ! Clipping for sclr'r_t' - ! Clipping sclr'r_t' at each vertical level, based on the - ! correlation of sclr and r_t at each vertical level, such that: - ! corr_(sclr,r_t) = sclr'r_t' / [ sqrt(sclr'^2) * sqrt(r_t'^2) ]; - ! -1 <= corr_(sclr,r_t) <= 1. - ! Since sclr'^2, r_t'^2, and sclr'r_t' are all computed in the - ! same place, clipping for sclr'r_t' only has to be done once. - do i = 1, sclr_dim, 1 - - if ( i == iisclr_rt ) then - ! Treat this like a variance if we're emulating rt - threshold = sclr_tol(i) * rt_tol - - call clip_variance( clip_sclrprtp, dt, threshold, & ! Intent(in) - sclrprtp(:,i) ) ! Intent(inout) - else - l_first_clip_ts = .true. - l_last_clip_ts = .true. - call clip_covar( clip_sclrprtp, l_first_clip_ts, & ! Intent(in) - l_last_clip_ts, dt, sclrp2(:,i), rtp2(:), & ! Intent(in) - sclrprtp(:,i), sclrprtp_chnge(:,i) ) ! Intent(inout) - end if - enddo - - - ! Clipping for sclr'th_l' - ! Clipping sclr'th_l' at each vertical level, based on the - ! correlation of sclr and th_l at each vertical level, such that: - ! corr_(sclr,th_l) = sclr'th_l' / [ sqrt(sclr'^2) * sqrt(th_l'^2) ]; - ! -1 <= corr_(sclr,th_l) <= 1. - ! Since sclr'^2, th_l'^2, and sclr'th_l' are all computed in the - ! same place, clipping for sclr'th_l' only has to be done once. - do i = 1, sclr_dim, 1 - if ( i == iisclr_thl ) then - ! As above, but for thl - threshold = sclr_tol(i) * thl_tol - call clip_variance( clip_sclrpthlp, dt, threshold, & ! Intent(in) - sclrpthlp(:,i) ) ! Intent(inout) - else - l_first_clip_ts = .true. - l_last_clip_ts = .true. - call clip_covar( clip_sclrpthlp, l_first_clip_ts, & ! Intent(in) - l_last_clip_ts, dt, sclrp2(:,i), thlp2(:), & ! Intent(in) - sclrpthlp(:,i), sclrpthlp_chnge(:,i) ) ! Intent(inout) - end if - enddo - - endif ! l_scalar_calc - - - ! Check for singular matrices and bad LAPACK arguments - if ( any( fatal_error( err_code_array ) ) ) then - err_code = clubb_singular_matrix - end if - - if ( fatal_error( err_code ) .and. & - clubb_at_least_debug_level( 1 ) ) then - - write(fstderr,*) "Error in advance_xp2_xpyp" - - write(fstderr,*) "Intent(in)" - - write(fstderr,*) "tau_zm = ", tau_zm - write(fstderr,*) "wm_zm = ", wm_zm - write(fstderr,*) "rtm = ", rtm - write(fstderr,*) "wprtp = ", wprtp - write(fstderr,*) "thlm = ", thlm - write(fstderr,*) "wpthlp = ", wpthlp - write(fstderr,*) "wpthvp = ", wpthvp - write(fstderr,*) "um = ", um - write(fstderr,*) "vm = ", vm - write(fstderr,*) "wp2 = ", wp2 - write(fstderr,*) "wp3 = ", wp3 - write(fstderr,*) "upwp = ", upwp - write(fstderr,*) "vpwp = ", vpwp - write(fstderr,*) "sigma_sqd_w = ", sigma_sqd_w - write(fstderr,*) "Skw_zm = ", Skw_zm - write(fstderr,*) "Kh_zt = ", Kh_zt - write(fstderr,*) "rtp2_forcing = ", rtp2_forcing - write(fstderr,*) "thlp2_forcing = ", thlp2_forcing - write(fstderr,*) "rtpthlp_forcing = ", rtpthlp_forcing - write(fstderr,*) "rho_ds_zm = ", rho_ds_zm - write(fstderr,*) "rho_ds_zt = ", rho_ds_zt - write(fstderr,*) "invrs_rho_ds_zm = ", invrs_rho_ds_zm - write(fstderr,*) "thv_ds_zm = ", thv_ds_zm - write(fstderr,*) "wp2_zt = ", wp2_zt - - do i = 1, sclr_dim - write(fstderr,*) "sclrm = ", i, sclrm(:,i) - write(fstderr,*) "wpsclrp = ", i, wpsclrp(:,i) - enddo - - write(fstderr,*) "Intent(In/Out)" - - write(fstderr,*) "rtp2 = ", rtp2 - write(fstderr,*) "thlp2 = ", thlp2 - write(fstderr,*) "rtpthlp = ", rtpthlp - write(fstderr,*) "up2 = ", up2 - write(fstderr,*) "vp2 = ", vp2 - - do i = 1, sclr_dim - write(fstderr,*) "sclrp2 = ", i, sclrp2(:,i) - write(fstderr,*) "sclrprtp = ", i, sclrprtp(:,i) - write(fstderr,*) "sclrthlp = ", i, sclrpthlp(:,i) - enddo - - endif - - return - end subroutine advance_xp2_xpyp - - !============================================================================= - subroutine xp2_xpyp_lhs( dt, l_iter, wp3_on_wp2_zt, wp3_on_wp2, & - a1, a1_zt, tau_zm, wm_zm, Kw, & - rho_ds_zt, rho_ds_zm, invrs_rho_ds_zm, & - Cn, nu, beta, lhs ) - - ! Description: - ! Compute LHS tridiagonal matrix for a variance or covariance term - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_constants_clubb, only: & - gamma_over_implicit_ts, & ! Constant(s) - one, & - zero - - use crmx_model_flags, only: & - l_upwind_xpyp_ta ! Constant(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_diffusion, only: & - diffusion_zm_lhs ! Procedure(s) - - use crmx_mean_adv, only: & - term_ma_zm_lhs ! Procedure(s) - - use crmx_stats_variables, only: & - zmscr01, & - zmscr02, & - zmscr03, & - zmscr04, & - zmscr05, & - zmscr06, & - zmscr07, & - zmscr08, & - zmscr09, & - zmscr10, & - l_stats_samp, & - irtp2_ma, & - irtp2_ta, & - irtp2_dp1, & - irtp2_dp2, & - ithlp2_ma, & - ithlp2_ta, & - ithlp2_dp1, & - ithlp2_dp2, & - irtpthlp_ma, & - irtpthlp_ta, & - irtpthlp_dp1, & - irtpthlp_dp2, & - iup2_ma, & - iup2_ta, & - iup2_dp2, & - ivp2_ma, & - ivp2_ta, & - ivp2_dp2 - - use crmx_advance_helper_module, only: set_boundary_conditions_lhs - - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_mdiag = 1, & ! Momentum superdiagonal index. - k_mdiag = 2, & ! Momentum main diagonal index. - km1_mdiag = 3 ! Momentum subdiagonal index. - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Timestep length [s] - - logical, intent(in) :: & - l_iter ! Whether the variances are prognostic (T/F) - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - wp3_on_wp2, & ! Smoothed w'^3 / w'^2 (moment. levels) [m/s] - wp3_on_wp2_zt, & ! Smoothed w'^3 / w'^2 (thermo. levels) [m/s] - a1, & ! sigma_sqd_w term a_1 (momentum levels) [-] - a1_zt, & ! a_1 interpolated to thermodynamic levels [-] - tau_zm, & ! Time-scale tau on momentum levels [s] - wm_zm, & ! w wind component on momentum levels [m/s] - Kw, & ! Coefficient of eddy diffusivity (all vars.) [m^2/s] - rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levs. [m^3/kg] - Cn ! Coefficient C_n [-] - - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - nu ! Background constant coef. of eddy diff. [-] - real( kind = core_rknd ), intent(in) :: & - beta ! Constant model parameter beta [-] - - ! Output Variables - real( kind = core_rknd ), dimension(3,gr%nz), intent(out) :: & - lhs ! Implicit contributions to the term - - ! Local Variables - - ! Array indices - integer :: k, kp1, km1, low_bound, high_bound - - real( kind = core_rknd ), dimension(3) :: & - tmp - - ! Initialize LHS matrix to 0. - lhs = zero - - ! Setup LHS of the tridiagonal system - do k = 2, gr%nz-1, 1 - - km1 = max( k-1, 1 ) - kp1 = min( k+1, gr%nz ) - - ! LHS mean advection (ma) term. - lhs(kp1_mdiag:km1_mdiag,k) & - = lhs(kp1_mdiag:km1_mdiag,k) & - + term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) - - ! LHS turbulent advection (ta) term. - ! Note: An "over-implicit" weighted time step is applied to this term. - ! The weight of the implicit portion of this term is controlled - ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the - ! expression below). A factor is added to the right-hand side of - ! the equation in order to balance a weight that is not equal to 1, - ! such that: - ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; - ! where X is the variable that is being solved for in a predictive - ! equation (x'^2 or x'y' in this case), y(t) is the linearized - ! portion of the term that gets treated implicitly, and RHS is the - ! portion of the term that is always treated explicitly. A weight - ! of greater than 1 can be applied to make the term more - ! numerically stable. - if ( .not. l_upwind_xpyp_ta ) then - lhs(kp1_mdiag:km1_mdiag,k) & - = lhs(kp1_mdiag:km1_mdiag,k) & - + gamma_over_implicit_ts & - * term_ta_lhs( wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & - a1_zt(kp1), a1(k), a1_zt(k), gr%invrs_dzm(k), beta, k ) - else - lhs(kp1_mdiag:km1_mdiag,k) & - = lhs(kp1_mdiag:km1_mdiag,k) & - + gamma_over_implicit_ts & - * term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & - wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & - gr%invrs_dzt(k), gr%invrs_dzt(kp1), & - invrs_rho_ds_zm(k), & - rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1), beta ) - end if - - ! LHS dissipation term 1 (dp1) - ! (combined with pressure term 1 (pr1) for u'^2 and v'^2). - ! Note: An "over-implicit" weighted time step is applied to this term - ! (and to pressure term 1 for u'^2 and v'^2). - lhs(k_mdiag,k) & - = lhs(k_mdiag,k) & - + gamma_over_implicit_ts & - * term_dp1_lhs( Cn(k), tau_zm(k) ) - - ! LHS eddy diffusion term: dissipation term 2 (dp2). - lhs(kp1_mdiag:km1_mdiag,k) & - = lhs(kp1_mdiag:km1_mdiag,k) & - + diffusion_zm_lhs( Kw(k), Kw(kp1), nu, & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(k), k ) - - ! LHS time tendency. - if ( l_iter ) then - lhs(k_mdiag,k) = lhs(k_mdiag,k) + ( one / real( dt, kind = core_rknd ) ) - endif - - if ( l_stats_samp ) then - - ! Statistics: implicit contributions for rtp2, thlp2, - ! rtpthlp, up2, or vp2. - - if ( irtp2_dp1 + ithlp2_dp1 + irtpthlp_dp1 > 0 ) then - ! Note: The statistical implicit contribution to term dp1 - ! (as well as to term pr1) for up2 and vp2 is recorded - ! in xp2_xpyp_uv_rhs because up2 and vp2 use a special - ! dp1/pr1 combined term. - ! Note: An "over-implicit" weighted time step is applied to this - ! term. A weighting factor of greater than 1 may be used to - ! make the term more numerically stable (see note above for - ! LHS turbulent advection (ta) term). - tmp(1) & - = gamma_over_implicit_ts & - * term_dp1_lhs( Cn(k), tau_zm(k) ) - zmscr01(k) = -tmp(1) - endif - - if ( irtp2_dp2 + ithlp2_dp2 + irtpthlp_dp2 + & - iup2_dp2 + ivp2_dp2 > 0 ) then - tmp(1:3) & - = diffusion_zm_lhs( Kw(k), Kw(kp1), nu, & - gr%invrs_dzt(kp1), gr%invrs_dzt(k), & - gr%invrs_dzm(k), k ) - zmscr02(k) = -tmp(3) - zmscr03(k) = -tmp(2) - zmscr04(k) = -tmp(1) - endif - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for LHS turbulent - ! advection (ta) term). - if ( irtp2_ta + ithlp2_ta + irtpthlp_ta + & - iup2_ta + ivp2_ta > 0 ) then - if ( .not. l_upwind_xpyp_ta ) then - tmp(1:3) & - = gamma_over_implicit_ts & - * term_ta_lhs( wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & - a1_zt(kp1), a1(k), a1_zt(k), gr%invrs_dzm(k), beta, k ) - else - tmp(1:3) & - = gamma_over_implicit_ts & - * term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & - wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & - gr%invrs_dzt(k), gr%invrs_dzt(kp1), & - invrs_rho_ds_zm(k), & - rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1), beta ) - end if - - zmscr05(k) = -tmp(3) - zmscr06(k) = -tmp(2) - zmscr07(k) = -tmp(1) - endif - - if ( irtp2_ma + ithlp2_ma + irtpthlp_ma + & - iup2_ma + ivp2_ma > 0 ) then - tmp(1:3) & - = term_ma_zm_lhs( wm_zm(k), gr%invrs_dzm(k), k ) - zmscr08(k) = -tmp(3) - zmscr09(k) = -tmp(2) - zmscr10(k) = -tmp(1) - endif - - endif ! l_stats_samp - - enddo ! k=2..gr%nz-1 - - - ! Boundary Conditions - ! These are set so that the surface_varnce value of the variances and - ! covariances can be used at the lowest boundary and the values of those - ! variables can be set to their respective threshold minimum values at the - ! top boundary. Fixed-point boundary conditions are used for both the - ! variances and the covariances. - low_bound = 1 - high_bound = gr%nz - - call set_boundary_conditions_lhs( k_mdiag, low_bound, high_bound, lhs ) - - return - - end subroutine xp2_xpyp_lhs - - !============================================================================= - subroutine xp2_xpyp_solve( solve_type, nrhs, rhs, lhs, xapxbp, err_code ) - - ! Description: - ! Solve a tridiagonal system - ! - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - one ! Constant(s) - - use crmx_lapack_wrap, only: & - tridag_solve, & ! Variable(s) - tridag_solvex !, & -! band_solve - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_stats_type, only: & - stat_update_var_pt ! Procedure(s) - - use crmx_stats_variables, only: & - sfc, & ! Derived type - irtp2_matrix_condt_num, & ! Stat index Variables - ithlp2_matrix_condt_num, & - irtpthlp_matrix_condt_num, & - iup2_vp2_matrix_condt_num, & - l_stats_samp ! Logical - - use crmx_error_code, only: & - clubb_no_error ! Constant - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: trim - - ! Constant parameters - integer, parameter :: & - kp1_mdiag = 1, & ! Momentum superdiagonal index. - k_mdiag = 2, & ! Momentum main diagonal index. - km1_mdiag = 3 ! Momentum subdiagonal index. - - ! Input variables - integer, intent(in) :: & - nrhs ! Number of right hand side vectors - - integer, intent(in) :: & - solve_type ! Variable(s) description - - ! Input/Ouput variables - real( kind = core_rknd ), dimension(gr%nz,nrhs), intent(inout) :: & - rhs ! Explicit contributions to x variance/covariance term [units vary] - - real( kind = core_rknd ), dimension(3,gr%nz), intent(inout) :: & - lhs ! Implicit contributions to x variance/covariance term [units vary] - - ! Output Variables - real( kind = core_rknd ), dimension(gr%nz,nrhs), intent(out) :: & - xapxbp ! Computed value of the variable(s) at [units vary] - - integer, intent(out) :: & - err_code ! Returns an error code in the event of a singular matrix - - ! Local variables - real( kind = core_rknd ) :: rcond ! Est. of the reciprocal of the condition # on the matrix - - integer :: ixapxbp_matrix_condt_num ! Stat index - - character(len=10) :: & - solve_type_str ! solve_type in string format for debug output purposes - - ! --- Begin Code --- - err_code = clubb_no_error ! Initialize to the value for no errors - - select case ( solve_type ) - !------------------------------------------------------------------------ - ! Note that these are diagnostics from inverting the matrix, not a budget - !------------------------------------------------------------------------ - case ( xp2_xpyp_rtp2 ) - ixapxbp_matrix_condt_num = irtp2_matrix_condt_num - solve_type_str = "rtp2" - case ( xp2_xpyp_thlp2 ) - ixapxbp_matrix_condt_num = ithlp2_matrix_condt_num - solve_type_str = "thlp2" - case ( xp2_xpyp_rtpthlp ) - ixapxbp_matrix_condt_num = irtpthlp_matrix_condt_num - solve_type_str = "rtpthlp" - case ( xp2_xpyp_up2_vp2 ) - ixapxbp_matrix_condt_num = iup2_vp2_matrix_condt_num - solve_type_str = "up2_vp2" - case default - ! No condition number is setup for the passive scalars - ixapxbp_matrix_condt_num = 0 - solve_type_str = "scalar" - end select - - if ( l_stats_samp .and. ixapxbp_matrix_condt_num > 0 ) then - call tridag_solvex & - ( solve_type_str, gr%nz, nrhs, & ! Intent(in) - lhs(kp1_mdiag,:), lhs(k_mdiag,:), lhs(km1_mdiag,:), rhs(:,1:nrhs), & ! Intent(inout) - xapxbp(:,1:nrhs), rcond, err_code ) ! Intent(out) - - ! Est. of the condition number of the variance LHS matrix - call stat_update_var_pt( ixapxbp_matrix_condt_num, 1, one / rcond, & ! Intent(in) - sfc ) ! Intent(inout) - - else - call tridag_solve & - ( solve_type_str, gr%nz, nrhs, lhs(kp1_mdiag,:), & ! Intent(in) - lhs(k_mdiag,:), lhs(km1_mdiag,:), rhs(:,1:nrhs), & ! Intent(inout) - xapxbp(:,1:nrhs), err_code ) ! Intent(out) - end if - - return - end subroutine xp2_xpyp_solve - - !============================================================================= - subroutine xp2_xpyp_implicit_stats( solve_type, xapxbp ) - - ! Description: - ! Finalize implicit contributions for r_t'^2, th_l'^2, r_t'th_l', - ! u'^2, and v'^2. - ! - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Derived type variable - - use crmx_stats_type, only: & - stat_end_update_pt, & ! Procedure(s) - stat_update_var_pt - - use crmx_stats_variables, only: & - zm, & ! Variable(s) - irtp2_dp1, & - irtp2_dp2, & - irtp2_ta, & - irtp2_ma, & - ithlp2_dp1, & - ithlp2_dp2, & - ithlp2_ta, & - ithlp2_ma, & - irtpthlp_dp1, & - irtpthlp_dp2, & - irtpthlp_ta, & - irtpthlp_ma, & - iup2_dp1, & - iup2_dp2, & - iup2_ta, & - iup2_ma, & - iup2_pr1, & - ivp2_dp1 - - use crmx_stats_variables, only: & - ivp2_dp2, & - ivp2_ta, & - ivp2_ma, & - ivp2_pr1, & - zmscr01, & - zmscr02, & - zmscr03, & - zmscr04, & - zmscr05, & - zmscr06, & - zmscr07, & - zmscr08, & - zmscr09, & - zmscr10, & - zmscr11 - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: max, min, trim - - ! Input variables - integer, intent(in) :: & - solve_type ! Variable(s) description - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - xapxbp ! Computed value of the variable at [units vary] - - ! Local variables - integer :: k, kp1, km1 ! Array indices - - ! Budget indices - integer :: & - ixapxbp_dp1, & - ixapxbp_dp2, & - ixapxbp_ta, & - ixapxbp_ma, & - ixapxbp_pr1 - - ! --- Begin Code --- - - select case ( solve_type ) - case ( xp2_xpyp_rtp2 ) - ixapxbp_dp1 = irtp2_dp1 - ixapxbp_dp2 = irtp2_dp2 - ixapxbp_ta = irtp2_ta - ixapxbp_ma = irtp2_ma - ixapxbp_pr1 = 0 - - case ( xp2_xpyp_thlp2 ) - ixapxbp_dp1 = ithlp2_dp1 - ixapxbp_dp2 = ithlp2_dp2 - ixapxbp_ta = ithlp2_ta - ixapxbp_ma = ithlp2_ma - ixapxbp_pr1 = 0 - - case ( xp2_xpyp_rtpthlp ) - ixapxbp_dp1 = irtpthlp_dp1 - ixapxbp_dp2 = irtpthlp_dp2 - ixapxbp_ta = irtpthlp_ta - ixapxbp_ma = irtpthlp_ma - ixapxbp_pr1 = 0 - - case ( xp2_xpyp_up2 ) - ixapxbp_dp1 = iup2_dp1 - ixapxbp_dp2 = iup2_dp2 - ixapxbp_ta = iup2_ta - ixapxbp_ma = iup2_ma - ixapxbp_pr1 = iup2_pr1 - - case ( xp2_xpyp_vp2 ) - ixapxbp_dp1 = ivp2_dp1 - ixapxbp_dp2 = ivp2_dp2 - ixapxbp_ta = ivp2_ta - ixapxbp_ma = ivp2_ma - ixapxbp_pr1 = ivp2_pr1 - - case default ! No budgets are setup for the passive scalars - ixapxbp_dp1 = 0 - ixapxbp_dp2 = 0 - ixapxbp_ta = 0 - ixapxbp_ma = 0 - ixapxbp_pr1 = 0 - - end select - - do k = 2, gr%nz-1 - - km1 = max( k-1, 1 ) - kp1 = min( k+1, gr%nz ) - - ! x'y' term dp1 has both implicit and explicit components; - ! call stat_end_update_pt. - call stat_end_update_pt( ixapxbp_dp1, k, & ! Intent(in) - zmscr01(k) * xapxbp(k), & ! Intent(in) - zm ) ! Intent(inout) - - ! x'y' term dp2 is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( ixapxbp_dp2, k, & ! Intent(in) - zmscr02(k) * xapxbp(km1) & ! Intent(in) - + zmscr03(k) * xapxbp(k) & - + zmscr04(k) * xapxbp(kp1), & - zm ) ! Intent(inout) - - ! x'y' term ta has both implicit and explicit components; - ! call stat_end_update_pt. - call stat_end_update_pt( ixapxbp_ta, k, & ! Intent(in) - zmscr05(k) * xapxbp(km1) & ! Intent(in) - + zmscr06(k) * xapxbp(k) & - + zmscr07(k) * xapxbp(kp1), & - zm ) ! Intent(inout) - - ! x'y' term ma is completely implicit; call stat_update_var_pt. - call stat_update_var_pt( ixapxbp_ma, k, & ! Intent(in) - zmscr08(k) * xapxbp(km1) & ! Intent(in) - + zmscr09(k) * xapxbp(k) & - + zmscr10(k) * xapxbp(kp1), & - zm ) ! Intent(inout) - - ! x'y' term pr1 has both implicit and explicit components; - ! call stat_end_update_pt. - call stat_end_update_pt( ixapxbp_pr1, k, & ! Intent(in) - zmscr11(k) * xapxbp(k), & ! Intent(in) - zm ) ! Intent(inout) - - end do ! k=2..gr%nz-1 - - return - end subroutine xp2_xpyp_implicit_stats - - !============================================================================= - subroutine xp2_xpyp_uv_rhs( solve_type, dt, l_iter, a1, a1_zt, wp2, & - wp2_zt, wpthvp, Lscale, wp3_on_wp2_zt, & - wp3_on_wp2, C4_C14_1d, tau_zm, & - xam, xbm, wpxap, wpxap_zt, wpxbp, wpxbp_zt, & - xap2, xbp2, rho_ds_zt, invrs_rho_ds_zm, & - rho_ds_zm, & - thv_ds_zm, C4, C5, C14, beta, & - rhs ) - - ! Description: - ! Explicit contributions to u'^2 or v'^2 - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_constants_clubb, only: & - gamma_over_implicit_ts, & ! Constant(s) - w_tol_sqd, & - one, & - two_thirds, & - one_third, & - zero - - use crmx_model_flags, only: & - l_upwind_xpyp_ta ! Constant(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_stats_type, only: & - stat_begin_update_pt, & ! Procedure(s) - stat_update_var_pt, & - stat_modify_pt - - use crmx_stats_variables, only: & - ivp2_ta, & ! Variable(s) - ivp2_tp, & - ivp2_dp1, & - ivp2_pr1, & - ivp2_pr2, & - iup2_ta, & - iup2_tp, & - iup2_dp1, & - iup2_pr1, & - iup2_pr2, & - zm, & - zmscr01, & - zmscr11, & - l_stats_samp - - implicit none - - ! Input Variables - integer, intent(in) :: solve_type - - real(kind=time_precision), intent(in) :: & - dt ! Model timestep [s] - - logical, intent(in) :: & - l_iter ! Whether x is prognostic (T/F) - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - a1, & ! sigma_sqd_w term a_1 (momentum levels) [-] - a1_zt, & ! a_1 interpolated to thermodynamic levels [-] - wp2, & ! w'^2 (momentum levels) [m^2/s^2] - wp2_zt, & ! w'^2 interpolated to thermodynamic levels [m^2/s^2] - wpthvp, & ! w'th_v' (momentum levels) [K m/s] - Lscale, & ! Mixing Length [m] - wp3_on_wp2, & ! Smoothed w'^3 / w'^2 on momentum levels [m/s] - wp3_on_wp2_zt, & ! Smoothed w'^3 / w'^2 on thermo. levels [m/s] - C4_C14_1d, & ! Combination of model params. C_4 and C_14 [-] - tau_zm, & ! Time-scale tau on momentum levels [s] - xam, & ! x_am (thermodynamic levels) [m/s] - xbm, & ! x_bm (thermodynamic levels) [m/s] - wpxap, & ! w'x_a' (momentum levels) [m^2/s^2] - wpxap_zt, & ! w'x_a' interpolated to thermodynamic levels [m^2/s^2] - wpxbp, & ! w'x_b' (momentum levels) [m^2/s^2] - wpxbp_zt, & ! w'x_b' interpolated to thermodynamic levels [m^2/s^2] - xap2, & ! x_a'^2 (momentum levels) [m^2/s^2] - xbp2, & ! x_b'^2 (momentum levels) [m^2/s^2] - rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levs. [m^3/kg] - thv_ds_zm ! Dry, base-state theta_v on momentum levels [K] - - real( kind = core_rknd ), intent(in) :: & - C4, & ! Model parameter C_4 [-] - C5, & ! Model parameter C_5 [-] - C14, & ! Model parameter C_{14} [-] - beta ! Model parameter beta [-] - - ! Output Variable - real( kind = core_rknd ), dimension(gr%nz,1), intent(out) :: & - rhs ! Explicit contributions to x variance/covariance terms - - ! Local Variables - - ! Array indices - integer :: k, kp1, km1 - - ! For "over-implicit" weighted time step. - ! This vector holds output from the LHS (implicit) portion of a term at a - ! given vertical level. This output is weighted and applied to the RHS. - ! This is used if the implicit portion of the term is "over-implicit", which - ! means that the LHS contribution is given extra weight (>1) in order to - ! increase numerical stability. A weighted factor must then be applied to - ! the RHS in order to balance the weight. - real( kind = core_rknd ), dimension(3) :: lhs_fnc_output - - real( kind = core_rknd ) :: tmp - - integer :: & - ixapxbp_ta, & - ixapxbp_tp, & - ixapxbp_dp1, & - ixapxbp_pr1, & - ixapxbp_pr2 - - !----------------------------- Begin Code ---------------------------------- - - select case ( solve_type ) - case ( xp2_xpyp_vp2 ) - ixapxbp_ta = ivp2_ta - ixapxbp_tp = ivp2_tp - ixapxbp_dp1 = ivp2_dp1 - ixapxbp_pr1 = ivp2_pr1 - ixapxbp_pr2 = ivp2_pr2 - case ( xp2_xpyp_up2 ) - ixapxbp_ta = iup2_ta - ixapxbp_tp = iup2_tp - ixapxbp_dp1 = iup2_dp1 - ixapxbp_pr1 = iup2_pr1 - ixapxbp_pr2 = iup2_pr2 - case default ! No budgets for passive scalars - ixapxbp_ta = 0 - ixapxbp_tp = 0 - ixapxbp_dp1 = 0 - ixapxbp_pr1 = 0 - ixapxbp_pr2 = 0 - end select - - - ! Initialize RHS vector to 0. - rhs = zero - - do k = 2, gr%nz-1, 1 - - km1 = max( k-1, 1 ) - kp1 = min( k+1, gr%nz ) - - ! RHS turbulent advection (ta) term. - rhs(k,1) & - = rhs(k,1) & - + term_ta_rhs( wp2_zt(kp1), wp2_zt(k), & - wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & - a1_zt(kp1), a1(k), a1_zt(k), wpxbp_zt(kp1), wpxbp_zt(k), & - wpxap_zt(kp1), wpxap_zt(k), gr%invrs_dzm(k), beta ) - - ! RHS contribution from "over-implicit" weighted time step - ! for LHS turbulent advection (ta) term. - ! - ! Note: An "over-implicit" weighted time step is applied to this term. - ! The weight of the implicit portion of this term is controlled - ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the - ! expression below). A factor is added to the right-hand side of - ! the equation in order to balance a weight that is not equal to 1, - ! such that: - ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; - ! where X is the variable that is being solved for in a predictive - ! equation (x'^2 or x'y' in this case), y(t) is the linearized - ! portion of the term that gets treated implicitly, and RHS is the - ! portion of the term that is always treated explicitly. A weight - ! of greater than 1 can be applied to make the term more - ! numerically stable. - if ( .not. l_upwind_xpyp_ta ) then - lhs_fnc_output(1:3) & - = term_ta_lhs( wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & - a1_zt(kp1), a1(k), a1_zt(k), gr%invrs_dzm(k), beta, k ) - else - lhs_fnc_output(1:3) & - = term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & - wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & - gr%invrs_dzt(k), gr%invrs_dzt(kp1), & - invrs_rho_ds_zm(k), & - rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1), beta ) - end if - - rhs(k,1) & - = rhs(k,1) & - + ( one - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * xap2(kp1) & - - lhs_fnc_output(2) * xap2(k) & - - lhs_fnc_output(3) * xap2(km1) ) - - ! RHS turbulent production (tp) term. - rhs(k,1) & - = rhs(k,1) & - + ( one - C5 ) & - * term_tp( xam(kp1), xam(k), xam(kp1), xam(k), & - wpxap(k), wpxap(k), gr%invrs_dzm(k) ) - - ! RHS pressure term 1 (pr1) (and dissipation term 1 (dp1)). - rhs(k,1) & - = rhs(k,1) & - + term_pr1( C4, C14, xbp2(k), wp2(k), tau_zm(k) ) - - ! RHS contribution from "over-implicit" weighted time step - ! for LHS dissipation term 1 (dp1) and pressure term 1 (pr1). - ! - ! Note: An "over-implicit" weighted time step is applied to these terms. - lhs_fnc_output(1) & - = term_dp1_lhs( C4_C14_1d(k), tau_zm(k) ) - rhs(k,1) & - = rhs(k,1) & - + ( one - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * xap2(k) ) - - ! RHS pressure term 2 (pr2). - rhs(k,1) & - = rhs(k,1) & - + term_pr2( C5, thv_ds_zm(k), wpthvp(k), wpxap(k), wpxbp(k), & - xam, xbm, gr%invrs_dzm(k), kp1, k, & - Lscale(kp1), Lscale(k), wp2_zt(kp1), wp2_zt(k) ) - - ! RHS time tendency. - if ( l_iter ) then - rhs(k,1) = rhs(k,1) + one/real( dt, kind = core_rknd ) * xap2(k) - endif - - if ( l_stats_samp ) then - - ! Statistics: explicit contributions for up2 or vp2. - - ! x'y' term ta has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on term_ta_rhs. - call stat_begin_update_pt( ixapxbp_ta, k, & ! Intent(in) - -term_ta_rhs( wp2_zt(kp1), wp2_zt(k), & ! Intent(in) - wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & - a1_zt(kp1), a1(k), a1_zt(k), wpxbp_zt(kp1), wpxbp_zt(k), & - wpxap_zt(kp1), wpxap_zt(k), gr%invrs_dzm(k), beta ), & - zm ) ! Intent(inout) - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for RHS turbulent - ! advection (ta) term). - if ( .not. l_upwind_xpyp_ta ) then - lhs_fnc_output(1:3) & - = term_ta_lhs( wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & - a1_zt(kp1), a1(k), a1_zt(k), gr%invrs_dzm(k), beta, k ) - else ! turbulent advection is using an upwind discretization - lhs_fnc_output(1:3) & - = term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & - wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & - gr%invrs_dzt(k), gr%invrs_dzt(kp1), & - invrs_rho_ds_zm(k), & - rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1), beta ) - end if ! ~l_upwind_xpyp_ta - - call stat_modify_pt( ixapxbp_ta, k, & ! Intent(in) - + ( one - gamma_over_implicit_ts ) & ! Intent(in) - * ( - lhs_fnc_output(1) * xap2(kp1) & - - lhs_fnc_output(2) * xap2(k) & - - lhs_fnc_output(3) * xap2(km1) ), & - zm ) ! Intent(inout) - - if ( ixapxbp_dp1 > 0 ) then - ! Note: The function term_pr1 is the explicit component of a - ! semi-implicit solution to dp1 and pr1. - ! Record the statistical contribution of the implicit component of - ! term dp1 for up2 or vp2. This will overwrite anything set - ! statistically in xp2_xpyp_lhs for this term. - ! Note: To find the contribution of x'y' term dp1, substitute - ! (2/3)*C_4 for the C_n input to function term_dp1_lhs. - ! Note: An "over-implicit" weighted time step is applied to this - ! term. A weighting factor of greater than 1 may be used to - ! make the term more numerically stable (see note above for - ! RHS turbulent advection (ta) term). - tmp & - = gamma_over_implicit_ts & - * term_dp1_lhs( two_thirds*C4, tau_zm(k) ) - zmscr01(k) = -tmp - ! Statistical contribution of the explicit component of term dp1 for - ! up2 or vp2. - ! x'y' term dp1 has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on term_pr1. - ! Note: To find the contribution of x'y' term dp1, substitute 0 for - ! the C_14 input to function term_pr1. - call stat_begin_update_pt( ixapxbp_dp1, k, & ! Intent(in) - -term_pr1( C4, zero, xbp2(k), wp2(k), tau_zm(k) ), & ! Intent(in) - zm ) ! Intent(inout) - - ! Note: An "over-implicit" weighted time step is applied to this - ! term. A weighting factor of greater than 1 may be used to - ! make the term more numerically stable (see note above for - ! RHS turbulent advection (ta) term). - lhs_fnc_output(1) & - = term_dp1_lhs( two_thirds*C4, tau_zm(k) ) - call stat_modify_pt( ixapxbp_dp1, k, & ! Intent(in) - + ( one - gamma_over_implicit_ts ) & ! Intent(in) - * ( - lhs_fnc_output(1) * xap2(k) ), & ! Intent(in) - zm ) ! Intent(inout) - - endif - - if ( ixapxbp_pr1 > 0 ) then - ! Note: The function term_pr1 is the explicit component of a - ! semi-implicit solution to dp1 and pr1. - ! Statistical contribution of the implicit component of term pr1 for - ! up2 or vp2. - ! Note: To find the contribution of x'y' term pr1, substitute - ! (1/3)*C_14 for the C_n input to function term_dp1_lhs. - ! Note: An "over-implicit" weighted time step is applied to this - ! term. A weighting factor of greater than 1 may be used to - ! make the term more numerically stable (see note above for - ! RHS turbulent advection (ta) term). - tmp & - = gamma_over_implicit_ts & - * term_dp1_lhs( one_third*C14, tau_zm(k) ) - zmscr11(k) = -tmp - ! Statistical contribution of the explicit component of term pr1 for - ! up2 or vp2. - ! x'y' term pr1 has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on term_pr1. - ! Note: To find the contribution of x'y' term pr1, substitute 0 for - ! the C_4 input to function term_pr1. - call stat_begin_update_pt( ixapxbp_pr1, k, & ! Intent(in) - -term_pr1( zero, C14, xbp2(k), wp2(k), tau_zm(k) ), & ! Intent(in) - zm ) ! Intent(inout) - - ! Note: An "over-implicit" weighted time step is applied to this - ! term. A weighting factor of greater than 1 may be used to - ! make the term more numerically stable (see note above for - ! RHS turbulent advection (ta) term). - lhs_fnc_output(1) & - = term_dp1_lhs( one_third*C14, tau_zm(k) ) - call stat_modify_pt( ixapxbp_pr1, k, & ! Intent(in) - + ( one - gamma_over_implicit_ts ) & ! Intent(in) - * ( - lhs_fnc_output(1) * xap2(k) ), & ! Intent(in) - zm ) ! Intent(inout) - - endif - - ! x'y' term pr2 is completely explicit; call stat_update_var_pt. - call stat_update_var_pt( ixapxbp_pr2, k, & ! Intent(in) - term_pr2( C5, thv_ds_zm(k), wpthvp(k), wpxap(k), wpxbp(k), & ! Intent(in) - xam, xbm, gr%invrs_dzm(k), kp1, k, & - Lscale(kp1), Lscale(k), wp2_zt(kp1), wp2_zt(k) ), & - zm ) ! Intent(inout) - - ! x'y' term tp is completely explicit; call stat_update_var_pt. - call stat_update_var_pt( ixapxbp_tp, k, & ! Intent(in) - ( one - C5 ) & ! Intent(in) - * term_tp( xam(kp1), xam(k), xam(kp1), xam(k), & - wpxap(k), wpxap(k), gr%invrs_dzm(k) ), & - zm ) ! Intent(inout) - - endif ! l_stats_samp - - enddo ! k=2..gr%nz-1 - - - ! Boundary Conditions - ! These are set so that the surface_varnce value of u'^2 or v'^2 can be - ! used at the lowest boundary and the values of those variables can be - ! set to their respective threshold minimum values at the top boundary. - ! Fixed-point boundary conditions are used for the variances. - - rhs(1,1) = xap2(1) - ! The value of u'^2 or v'^2 at the upper boundary will be set to the - ! threshold minimum value of w_tol_sqd. - rhs(gr%nz,1) = w_tol_sqd - - return - end subroutine xp2_xpyp_uv_rhs - - !============================================================================= - subroutine xp2_xpyp_rhs( solve_type, dt, l_iter, a1, a1_zt, & - wp2_zt, wpxap, wpxap_zt, wp3_on_wp2, & - wp3_on_wp2_zt, wpxbp, wpxbp_zt, & - xam, xbm, xapxbp, xapxbp_forcing, & - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - Cn, tau_zm, threshold, beta, & - rhs ) - - ! Description: - ! Explicit contributions to r_t'^2, th_l'^2, r_t'th_l', sclr'r_t', - ! sclr'th_l', or sclr'^2. - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_constants_clubb, only: & - gamma_over_implicit_ts, & ! Constant(s) - one, & - zero - - use crmx_model_flags, only: & - l_upwind_xpyp_ta ! Constant(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_stats_type, only: & - stat_begin_update_pt, & ! Procedure(s) - stat_update_var_pt, & - stat_modify_pt - - use crmx_stats_variables, only: & - irtp2_ta, & ! Variable(s) - irtp2_tp, & - irtp2_dp1, & - irtp2_forcing, & - ithlp2_ta, & - ithlp2_tp, & - ithlp2_dp1, & - ithlp2_forcing, & - irtpthlp_ta, & - irtpthlp_tp1, & - irtpthlp_tp2, & - irtpthlp_dp1, & - irtpthlp_forcing, & - zm, & - l_stats_samp - - use crmx_advance_helper_module, only: set_boundary_conditions_rhs - - implicit none - - ! Input Variables - integer, intent(in) :: solve_type - - real(kind=time_precision), intent(in) :: & - dt ! Model timestep [s] - - logical, intent(in) :: & - l_iter ! Whether x is prognostic (T/F) - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - a1, & ! sigma_sqd_w term a_1 (momentum levels) [-] - a1_zt, & ! a_1 interpolated to thermodynamic levels [-] - wp2_zt, & ! w'^2 interpolated to thermodynamic levels [m^2/s^2] - wpxap, & ! w'x_a' (momentum levels) [m/s {x_am units}] - wpxap_zt, & ! w'x_a' interpolated to thermodynamic levels [m/s {x_am units}] - wp3_on_wp2, & ! w'^3 / w'^2 on momentum levels [m/s] - wp3_on_wp2_zt, & ! w'^3 / w'^2 on thermodynamic levels [m/s] - wpxbp, & ! w'x_b' (momentum levels) [m/s {x_bm units}] - wpxbp_zt, & ! w'x_b' interpolated to thermodynamic levels [m/s {x_bm units}] - xam, & ! x_am (thermodynamic levels) [{x_am units}] - xbm, & ! x_bm (thermodynamic levels) [{x_bm units}] - xapxbp, & ! x_a'x_b' (momentum levels) [{x_am units}*{x_bm units}] - xapxbp_forcing, & ! x_a'x_b' forcing (momentum levels) [{x_am units}*{x_bm units}/s] - rho_ds_zm, & ! Dry, static density on moment. levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levs. [m^3/kg] - tau_zm, & ! Time-scale tau on momentum levels [s] - Cn ! Coefficient C_n [-] - - real( kind = core_rknd ), intent(in) :: & - threshold, & ! Smallest allowable mag. value for x_a'x_b' [{x_am units} - ! *{x_bm units}] - beta ! Model parameter beta [-] - - ! Output Variable - real( kind = core_rknd ), dimension(gr%nz,1), intent(out) :: & - rhs ! Explicit contributions to x variance/covariance terms - - ! Local Variables - - ! Array indices - integer :: k, kp1, km1, k_low, k_high - - ! For "over-implicit" weighted time step. - ! This vector holds output from the LHS (implicit) portion of a term at a - ! given vertical level. This output is weighted and applied to the RHS. - ! This is used if the implicit portion of the term is "over-implicit", which - ! means that the LHS contribution is given extra weight (>1) in order to - ! increase numerical stability. A weighted factor must then be applied to - ! the RHS in order to balance the weight. - real( kind = core_rknd ), dimension(3) :: lhs_fnc_output - - integer :: & - ixapxbp_ta, & - ixapxbp_tp, & - ixapxbp_tp1, & - ixapxbp_tp2, & - ixapxbp_dp1, & - ixapxbp_f - - !------------------------------ Begin Code --------------------------------- - - select case ( solve_type ) - case ( xp2_xpyp_rtp2 ) - ixapxbp_ta = irtp2_ta - ixapxbp_tp = irtp2_tp - ixapxbp_tp1 = 0 - ixapxbp_tp2 = 0 - ixapxbp_dp1 = irtp2_dp1 - ixapxbp_f = irtp2_forcing - case ( xp2_xpyp_thlp2 ) - ixapxbp_ta = ithlp2_ta - ixapxbp_tp = ithlp2_tp - ixapxbp_tp1 = 0 - ixapxbp_tp2 = 0 - ixapxbp_dp1 = ithlp2_dp1 - ixapxbp_f = ithlp2_forcing - case ( xp2_xpyp_rtpthlp ) - ixapxbp_ta = irtpthlp_ta - ixapxbp_tp = 0 - ixapxbp_tp1 = irtpthlp_tp1 - ixapxbp_tp2 = irtpthlp_tp2 - ixapxbp_dp1 = irtpthlp_dp1 - ixapxbp_f = irtpthlp_forcing - case default ! No budgets for passive scalars - ixapxbp_ta = 0 - ixapxbp_tp = 0 - ixapxbp_tp1 = 0 - ixapxbp_tp2 = 0 - ixapxbp_dp1 = 0 - ixapxbp_f = 0 - end select - - - ! Initialize RHS vector to 0. - rhs = zero - - do k = 2, gr%nz-1, 1 - - km1 = max( k-1, 1 ) - kp1 = min( k+1, gr%nz ) - - ! RHS turbulent advection (ta) term. - rhs(k,1) & - = rhs(k,1) & - + term_ta_rhs( wp2_zt(kp1), wp2_zt(k), & - wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & - a1_zt(kp1), a1(k), a1_zt(k), wpxbp_zt(kp1), wpxbp_zt(k), & - wpxap_zt(kp1), wpxap_zt(k), gr%invrs_dzm(k), beta ) - - ! RHS contribution from "over-implicit" weighted time step - ! for LHS turbulent advection (ta) term. - ! - ! Note: An "over-implicit" weighted time step is applied to this term. - ! The weight of the implicit portion of this term is controlled - ! by the factor gamma_over_implicit_ts (abbreviated "gamma" in the - ! expression below). A factor is added to the right-hand side of - ! the equation in order to balance a weight that is not equal to 1, - ! such that: - ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; - ! where X is the variable that is being solved for in a predictive - ! equation (x'^2 or x'y' in this case), y(t) is the linearized - ! portion of the term that gets treated implicitly, and RHS is the - ! portion of the term that is always treated explicitly. A weight - ! of greater than 1 can be applied to make the term more - ! numerically stable. - if ( .not. l_upwind_xpyp_ta ) then - lhs_fnc_output(1:3) & - = term_ta_lhs( wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & - a1_zt(kp1), a1(k), a1_zt(k), gr%invrs_dzm(k), beta, k ) - else - lhs_fnc_output(1:3) & - = term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & - wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & - gr%invrs_dzt(k), gr%invrs_dzt(kp1), & - invrs_rho_ds_zm(k), & - rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1), beta ) - endif - - rhs(k,1) & - = rhs(k,1) & - + ( one - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * xapxbp(kp1) & - - lhs_fnc_output(2) * xapxbp(k) & - - lhs_fnc_output(3) * xapxbp(km1) ) - - ! RHS turbulent production (tp) term. - rhs(k,1) & - = rhs(k,1) & - + term_tp( xam(kp1), xam(k), xbm(kp1), xbm(k), & - wpxbp(k), wpxap(k), gr%invrs_dzm(k) ) - - ! RHS dissipation term 1 (dp1) - rhs(k,1) & - = rhs(k,1) + term_dp1_rhs( Cn(k), tau_zm(k), threshold ) - - ! RHS contribution from "over-implicit" weighted time step - ! for LHS dissipation term 1 (dp1). - ! - ! Note: An "over-implicit" weighted time step is applied to this term. - lhs_fnc_output(1) & - = term_dp1_lhs( Cn(k), tau_zm(k) ) - rhs(k,1) & - = rhs(k,1) & - + ( one - gamma_over_implicit_ts ) & - * ( - lhs_fnc_output(1) * xapxbp(k) ) - - ! RHS time tendency. - if ( l_iter ) then - rhs(k,1) = rhs(k,1) + one/real( dt, kind = core_rknd ) * xapxbp(k) - endif - - ! RHS forcing. - ! Note: forcing includes the effects of microphysics on . - rhs(k,1) = rhs(k,1) + xapxbp_forcing(k) - - - if ( l_stats_samp ) then - - ! Statistics: explicit contributions for rtp2, thlp2, or rtpthlp. - - ! x'y' term ta has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on term_ta_rhs. - call stat_begin_update_pt( ixapxbp_ta, k, & ! Intent(in) - -term_ta_rhs( wp2_zt(kp1), wp2_zt(k), & ! Intent(in) - wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & - a1_zt(kp1), a1(k), a1_zt(k), wpxbp_zt(kp1), wpxbp_zt(k), & - wpxap_zt(kp1), wpxap_zt(k), gr%invrs_dzm(k), beta ), & - zm ) ! Intent(inout) - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for RHS turbulent - ! advection (ta) term). - if ( .not. l_upwind_xpyp_ta ) then - lhs_fnc_output(1:3) & - = term_ta_lhs( wp3_on_wp2_zt(kp1), wp3_on_wp2_zt(k), & - rho_ds_zt(kp1), rho_ds_zt(k), invrs_rho_ds_zm(k), & - a1_zt(kp1), a1(k), a1_zt(k), gr%invrs_dzm(k), beta, k ) - else - lhs_fnc_output(1:3) & - = term_ta_lhs_upwind( a1(k), a1(kp1), a1(km1), & - wp3_on_wp2(kp1), wp3_on_wp2(k), wp3_on_wp2(km1), & - gr%invrs_dzt(k), gr%invrs_dzt(kp1), & - invrs_rho_ds_zm(k), & - rho_ds_zm(kp1), rho_ds_zm(k), rho_ds_zm(km1), beta ) - end if - call stat_modify_pt( ixapxbp_ta, k, & ! Intent(in) - + ( one - gamma_over_implicit_ts ) & ! Intent(in) - * ( - lhs_fnc_output(1) * xapxbp(kp1) & - - lhs_fnc_output(2) * xapxbp(k) & - - lhs_fnc_output(3) * xapxbp(km1) ), & - zm ) ! Intent(inout) - - ! x'y' term dp1 has both implicit and explicit components; call - ! stat_begin_update_pt. Since stat_begin_update_pt automatically - ! subtracts the value sent in, reverse the sign on term_dp1_rhs. - call stat_begin_update_pt( ixapxbp_dp1, k, & ! Intent(in) - -term_dp1_rhs( Cn(k), tau_zm(k), threshold ), & ! Intent(in) - zm ) ! Intent(inout) - - ! Note: An "over-implicit" weighted time step is applied to this term. - ! A weighting factor of greater than 1 may be used to make the - ! term more numerically stable (see note above for RHS turbulent - ! advection (ta) term). - lhs_fnc_output(1) & - = term_dp1_lhs( Cn(k), tau_zm(k) ) - call stat_modify_pt( ixapxbp_dp1, k, & ! Intent(in) - + ( one - gamma_over_implicit_ts ) & ! Intent(in) - * ( - lhs_fnc_output(1) * xapxbp(k) ), & ! Intent(in) - zm ) ! Intent(inout) - - ! rtp2/thlp2 case (1 turbulent production term) - ! x'y' term tp is completely explicit; call stat_update_var_pt. - call stat_update_var_pt( ixapxbp_tp, k, & ! Intent(in) - term_tp( xam(kp1), xam(k), xbm(kp1), xbm(k), & ! Intent(in) - wpxbp(k), wpxap(k), gr%invrs_dzm(k) ), & - zm ) ! Intent(inout) - - ! rtpthlp case (2 turbulent production terms) - ! x'y' term tp1 is completely explicit; call stat_update_var_pt. - ! Note: To find the contribution of x'y' term tp1, substitute 0 for all - ! the xam inputs and the wpxbp input to function term_tp. - call stat_update_var_pt( ixapxbp_tp1, k, & ! Intent(in) - term_tp( zero, zero, xbm(kp1), xbm(k), & ! Intent(in) - zero, wpxap(k), gr%invrs_dzm(k) ), & - zm ) ! Intent(inout) - - ! x'y' term tp2 is completely explicit; call stat_update_var_pt. - ! Note: To find the contribution of x'y' term tp2, substitute 0 for all - ! the xbm inputs and the wpxap input to function term_tp. - call stat_update_var_pt( ixapxbp_tp2, k, & ! Intent(in) - term_tp( xam(kp1), xam(k), zero, zero, & ! Intent(in) - wpxbp(k), zero, gr%invrs_dzm(k) ), & - zm ) ! Intent(inout) - - ! x'y' forcing term is completely explicit; call stat_update_var_pt. - call stat_update_var_pt( ixapxbp_f, k, xapxbp_forcing(k), zm ) - - endif ! l_stats_samp - - enddo ! k=2..gr%nz-1 - - - ! Boundary Conditions - ! These are set so that the surface_varnce value of rtp2, thlp2, or rtpthlp - ! (or sclrp2, sclrprtp, or sclrpthlp) can be used at the lowest boundary and the - ! values of those variables can be set to their respective threshold minimum - ! values (which is 0 in the case of the covariances) at the top boundary. - ! Fixed-point boundary conditions are used for both the variances and the - ! covariances. - - k_low = 1 - k_high = gr%nz - - ! The value of the field at the upper boundary will be set to it's threshold - ! minimum value, as contained in the variable 'threshold'. - call set_boundary_conditions_rhs( & - xapxbp(1), k_low, threshold, k_high, & - rhs(:,1) ) - - return - end subroutine xp2_xpyp_rhs - - !============================================================================= - pure function term_ta_lhs( wp3_on_wp2_ztp1, wp3_on_wp2_zt, & - rho_ds_ztp1, rho_ds_zt, invrs_rho_ds_zm, & - a1_ztp1, a1, a1_zt, invrs_dzm, beta, level ) & - result( lhs ) - - ! Description: - ! Turbulent advection of x_a'x_b': implicit portion of the code. - ! - ! The d(x_a'x_b')/dt equation contains a turbulent advection term: - ! - ! - (1/rho_ds) * d( rho_ds * w'x_a'x_b' )/dz. - ! - ! A substitution is made in order to close the turbulent advection term, - ! such that: - ! - ! w'x_a'x_b' = (1/3)*beta * a_1 * ( w'^3 / w'^2 ) * x_a'x_b' - ! + (1-(1/3)*beta) * (a_1)^2 * ( w'^3 / (w'^2)^2 ) - ! * w'x_a' * w'x_b'; - ! - ! where a_1 is a variable that is a function of sigma_sqd_w. The turbulent - ! advection term is rewritten as: - ! - ! - (1/rho_ds) - ! * d [ rho_ds * { (1/3)*beta * a_1 * ( w'^3 / w'^2 ) * x_a'x_b' - ! + (1-(1/3)*beta) * (a_1)^2 * ( w'^3 / (w'^2)^2 ) - ! * w'x_a' * w'x_b' } ] - ! / dz; - ! - ! which produces an implicit and an explicit portion of this term. The - ! implicit portion of this term is: - ! - ! - (1/rho_ds) - ! * d [ rho_ds * (1/3)*beta * a_1 * ( w'^3 / w'^2 ) * x_a'x_b'(t+1) ] - ! / dz. - ! - ! Since (1/3)*beta is a constant, it can be pulled outside of the - ! derivative. The implicit portion of this term becomes: - ! - ! - (1/3)*beta/rho_ds - ! * d [ rho_ds * a_1 * ( w'^3 / w'^2 ) * x_a'x_b'(t+1) ] / dz. - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed - ! to a "+". - ! - ! The timestep index (t+1) means that the value of x_a'x_b' being used is - ! from the next timestep, which is being advanced to in solving the - ! d(x_a'x_b')/dt equation. - ! - ! The implicit portion of this term is discretized as follows: - ! - ! The values of x_a'x_b' are found on the momentum levels, as are the values - ! of w'^2 and a_1. The values of w'^3 are found on the thermodynamic - ! levels. Additionally, the values of rho_ds_zt are found on the - ! thermodynamic levels, and the values of invrs_rho_ds_zm are found on the - ! momentum levels. The variables x_a'x_b', w'^2, and a_1 are each - ! interpolated to the intermediate thermodynamic levels. The values of the - ! mathematical expression (called F here) within the dF/dz term are computed - ! on the thermodynamic levels. Then the derivative (d/dz) of the - ! expression (F) is taken over the central momentum level, where it is - ! multiplied by (1/3)*beta and by invrs_rho_ds_zm, yielding the desired - ! result. In this function, the values of F are as follows: - ! - ! F = rho_ds_zt * a_1(t) * ( w'^3(t) / w'^2(t) ) * x_a'x_b'(t+1); - ! - ! where the timestep index (t) stands for the index of the current timestep. - ! - ! - ! ==a1p1========wp2p1========xapxbpp1================================ m(k+1) - ! - ! ----a1(interp)--wp2(interp)--xapxbp(interp)--wp3p1---rho_ds_ztp1--- t(k+1) - ! - ! ==a1==========wp2==========xapxbp=======dF/dz====invrs_rho_ds_zm=== m(k) - ! - ! ----a1(interp)--wp2(interp)--xapxbp(interp)--wp3-----rho_ds_zt----- t(k) - ! - ! ==a1m1========wp2m1========xapxbpm1================================ m(k-1) - ! - ! The vertical indices m(k+1), t(k+1), m(k), t(k), and m(k-1) correspond - ! with altitudes zm(k+1), zt(k+1), zm(k), zt(k), and zm(k-1), respectively. - ! The letter "t" is used for thermodynamic levels and the letter "m" is used - ! for momentum levels. - ! - ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & ! gr%weights_zm2zt - gr ! Variable(s) - - use crmx_constants_clubb, only: & - one_third ! Constant(s) - - use crmx_model_flags, only: & - l_standard_term_ta - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: max - - ! Constant parameters - integer, parameter :: & - kp1_mdiag = 1, & ! Momentum superdiagonal index. - k_mdiag = 2, & ! Momentum main diagonal index. - km1_mdiag = 3 ! Momentum subdiagonal index. - - integer, parameter :: & - m_above = 1, & ! Index for upper momentum level grid weight. - m_below = 2 ! Index for lower momentum level grid weight. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - wp3_on_wp2_ztp1, & ! w'^3 / w'^2 (k+1) [m/s] - wp3_on_wp2_zt, & ! w'^3 / w'^2 (k) [m/s] - rho_ds_ztp1, & ! Dry, static density at thermo. level (k+1) [kg/m^3] - rho_ds_zt, & ! Dry, static density at thermo. level (k) [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum lev (k) [m^3/kg] - a1_ztp1, & ! a_1 interpolated to thermo. level (k+1) [-] - a1, & ! a_1(k) [-] - a1_zt, & ! a_1 interpolated to thermo. level (k) [-] - invrs_dzm, & ! Inverse of grid spacing [1/m] - beta ! Model parameter [-] - - integer, intent(in) :: & - level ! Central momentum level (on which calculation occurs). - - ! Return Variable - real( kind = core_rknd ), dimension(3) :: lhs - - ! Local Variables - integer :: & - tkp1, & ! Thermodynamic level directly above central momentum level. - tk ! Thermodynamic level directly below central momentum level. - - - ! Thermodynamic level (k+1) is between momentum level (k+1) - ! and momentum level (k). - tkp1 = level + 1 - - ! Thermodynamic level (k) is between momentum level (k) - ! and momentum level (k-1). - tk = level - - if ( l_standard_term_ta ) then - - ! The turbulent advection term is discretized normally, in accordance - ! with the model equations found in the documentation and the description - ! listed above. - - ! Momentum superdiagonal: [ x xapxbp(k+1,) ] - lhs(kp1_mdiag) & - = + one_third * beta & - * invrs_rho_ds_zm & - * invrs_dzm & - * rho_ds_ztp1 * a1_ztp1 & - * wp3_on_wp2_ztp1 & - * gr%weights_zm2zt(m_above,tkp1) - - ! Momentum main diagonal: [ x xapxbp(k,) ] - lhs(k_mdiag) & - = + one_third * beta & - * invrs_rho_ds_zm & - * invrs_dzm & - * ( rho_ds_ztp1 * a1_ztp1 & - * wp3_on_wp2_ztp1 & - * gr%weights_zm2zt(m_below,tkp1) & - - rho_ds_zt * a1_zt & - * wp3_on_wp2_zt & - * gr%weights_zm2zt(m_above,tk) & - ) - - ! Momentum subdiagonal: [ x xapxbp(k-1,) ] - lhs(km1_mdiag) & - = - one_third * beta & - * invrs_rho_ds_zm & - * invrs_dzm & - * rho_ds_zt * a1_zt & - * wp3_on_wp2_zt & - * gr%weights_zm2zt(m_below,tk) - - else - - ! Brian tried a new discretization for the turbulent advection term, for - ! which the implicit portion of the term is: - ! - (1/rho_ds) - ! * d [ rho_ds * a_1 * (1/3)*beta * ( w'^3 / w'^2 ) * x_a'x_b' ] / dz. - ! In order to help stabilize x_a'x_b', a_1 has been pulled outside the - ! derivative. - - ! Momentum superdiagonal: [ x xapxbp(k+1,) ] - lhs(kp1_mdiag) & - = + one_third * beta & - * invrs_rho_ds_zm * a1 & - * invrs_dzm & - * rho_ds_ztp1 & - * wp3_on_wp2_ztp1 & - * gr%weights_zm2zt(m_above,tkp1) - - ! Momentum main diagonal: [ x xapxbp(k,) ] - lhs(k_mdiag) & - = + one_third * beta & - * invrs_rho_ds_zm * a1 & - * invrs_dzm & - * ( rho_ds_ztp1 & - * wp3_on_wp2_ztp1 & - * gr%weights_zm2zt(m_below,tkp1) & - - rho_ds_zt & - * wp3_on_wp2_zt & - * gr%weights_zm2zt(m_above,tk) & - ) - - ! Momentum subdiagonal: [ x xapxbp(k-1,) ] - lhs(km1_mdiag) & - = - one_third * beta & - * invrs_rho_ds_zm * a1 & - * invrs_dzm & - * rho_ds_zt & - * wp3_on_wp2_zt & - * gr%weights_zm2zt(m_below,tk) - - ! End of Brian's a1 change. 14 Feb 2008. - - endif - - - return - end function term_ta_lhs - - !----------------------------------------------------------------------------- - pure function term_ta_lhs_upwind( a1_zm, a1_zm_p1, a1_zm_m1, & - wp3_on_wp2_p1, wp3_on_wp2, wp3_on_wp2_m1, & - invrs_dzt, invrs_dzt_p1, & - invrs_rho_ds_zm, & - rho_ds_zm_p1, rho_ds_zm, rho_ds_zm_m1, beta ) & - result( lhs ) - - ! Description: - ! Turbulent advection of x_a'x_b' using an upwind differencing - ! approximation rather than a centered difference. - ! References: - ! None - !----------------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - one_third, & ! Constant(s) - zero - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_mdiag = 1, & ! Momentum superdiagonal index. - k_mdiag = 2, & ! Momentum main diagonal index. - km1_mdiag = 3 ! Momentum subdiagonal index. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - a1_zm, & ! a_1(k) on momentum levels [-] - a1_zm_p1, & ! a_1(k+1) on momentum levels [-] - a1_zm_m1, & ! a_1(k-1) on momentum levels [-] - wp3_on_wp2_p1, & ! Smoothed wp3 / wp2 on moment. levels (k+1) [m/s] - wp3_on_wp2, & ! Smoothed wp3 / wp2 on moment. levels (k) [m/s] - wp3_on_wp2_m1, & ! Smoothed wp3 / wp2 on moment. levels (k-1) [m/s] - invrs_dzt, & ! Inverse of grid spacing (k) [1/m] - invrs_dzt_p1, & ! Inverse of grid spacing (k+1) [1/m] - invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum lev (k) [m^3/kg] - rho_ds_zm, & ! Density of air (k) [kg/m^3] - rho_ds_zm_p1, & ! Density of air (k+1) [kg/m^3] - rho_ds_zm_m1, & ! Density of air (k-1) [kg/m^3] - beta ! Model parameter [-] - - ! Return Variable - real( kind = core_rknd ), dimension(3) :: lhs - - - if ( wp3_on_wp2 > zero ) then - - ! Momentum main diagonal: [ x xapxbp(k+1,) ] - lhs(kp1_mdiag) = zero - - ! Momentum main diagonal: [ x xapxbp(k,) ] - lhs(k_mdiag) & - = + one_third * beta & - * invrs_dzt * invrs_rho_ds_zm & - * rho_ds_zm * a1_zm * wp3_on_wp2 - - ! Momentum subdiagonal: [ x xapxbp(k-1,) ] - lhs(km1_mdiag) & - = - one_third * beta & - * invrs_dzt * invrs_rho_ds_zm & - * rho_ds_zm_m1 * a1_zm_m1 * wp3_on_wp2_m1 - - else ! "Wind" is blowing downward - - ! Momentum main diagonal: [ x xapxbp(k+1,) ] - lhs(kp1_mdiag) & - = + one_third * beta & - * invrs_dzt_p1 * invrs_rho_ds_zm & - * rho_ds_zm_p1 * a1_zm_p1 * wp3_on_wp2_p1 - - ! Momentum main diagonal: [ x xapxbp(k,) ] - lhs(k_mdiag) & - = - one_third * beta & - * invrs_dzt_p1 * invrs_rho_ds_zm & - * rho_ds_zm * a1_zm * wp3_on_wp2 - - ! Momentum subdiagonal: [ x xapxbp(k-1,) ] - lhs(km1_mdiag) = zero - - end if - - return - end function term_ta_lhs_upwind - - !============================================================================= - pure function term_ta_rhs( wp2_ztp1, wp2_zt, & - wp3_on_wp2_ztp1, wp3_on_wp2_zt, & - rho_ds_ztp1, rho_ds_zt, invrs_rho_ds_zm, & - a1_ztp1, a1, a1_zt, wpxbp_ztp1, wpxbp_zt, & - wpxap_ztp1, wpxap_zt, invrs_dzm, beta ) & - result( rhs ) - - ! Description: - ! Turbulent advection of x_a'x_b': explicit portion of the code. - ! - ! The d(x_a'x_b')/dt equation contains a turbulent advection term: - ! - ! - (1/rho_ds) * d( rho_ds * w'x_a'x_b' )/dz. - ! - ! A substitution is made in order to close the turbulent advection term, - ! such that: - ! - ! w'x_a'x_b' = (1/3)*beta * a_1 * ( w'^3 / w'^2 ) * x_a'x_b' - ! + (1-(1/3)*beta) * (a_1)^2 * ( w'^3 / (w'^2)^2 ) - ! * w'x_a' * w'x_b'; - ! - ! where a_1 is a variable that is a function of sigma_sqd_w. The turbulent - ! advection term is rewritten as: - ! - ! - (1/rho_ds) - ! * d [ rho_ds * { (1/3)*beta * a_1 * ( w'^3 / w'^2 ) * x_a'x_b' - ! + (1-(1/3)*beta) * (a_1)^2 * ( w'^3 / (w'^2)^2 ) - ! * w'x_a' * w'x_b' } ] - ! / dz; - ! - ! which produces an implicit and an explicit portion of this term. The - ! explicit portion of this term is: - ! - ! - (1/rho_ds) - ! * d [ rho_ds * (1-(1/3)*beta) * (a_1)^2 * ( w'^3 / (w'^2)^2 ) - ! * w'x_a' * w'x_b' ] / dz. - ! - ! Since (1-(1/3)*beta) is a constant, it can be pulled outside of the - ! derivative. The explicit portion of this term becomes: - ! - ! - (1-(1/3)*beta)/rho_ds - ! * d [ rho_ds * (a_1)^2 * ( w'^3 / (w'^2)^2 ) * w'x_a' * w'x_b' ] / dz. - ! - ! The explicit portion of this term is discretized as follows: - ! - ! The values of w'x_a', w'x_b', w'^2, and a_1 are found on the momentum - ! levels. The values of w'^3 are found on the thermodynamic levels. - ! Additionally, the values of rho_ds_zt are found on the thermodynamic - ! levels, and the values of invrs_rho_ds_zm are found on the momentum - ! levels. The variables w'x_a', w'x_b', w'^2, and a_1 are each interpolated - ! to the intermediate thermodynamic levels. The values of the mathematical - ! expression (called F here) within the dF/dz term are computed on the - ! thermodynamic levels. Then the derivative (d/dz) of the expression (F) is - ! taken over the central momentum level, where it is multiplied by - ! (1-(1/3)*beta), and by invrs_rho_ds_zm, yielding the desired result. In - ! this function, the values of F are as follows: - ! - ! F = rho_ds_zt * ( a_1(t) )^2 * ( w'^3(t) / ( w'^2(t) )^2 ) - ! * w'x_a'(t) * w'x_b'(t); - ! - ! where the timestep index (t) stands for the index of the current timestep. - ! - ! - ! =a1p1=======wp2p1=======wpxapp1=======wpxbpp1========================= m(k+1) - ! - ! -a1(interp)-wp2(interp)-wpxap(interp)-wpxbp(interp)-wp3p1-rho_ds_ztp1- t(k+1) - ! - ! =a1=========wp2=========wpxap=========wpxbp===dF/dz===invrs_rho_ds_zm= m(k) - ! - ! -a1(interp)-wp2(interp)-wpxap(interp)-wpxbp(interp)-wp3---rho_ds_zt--- t(k) - ! - ! =a1m1=======wp2m1=======wpxapm1=======wpxbpm1========================= m(k-1) - ! - ! The vertical indices m(k+1), t(k+1), m(k), t(k), and m(k-1) correspond - ! with altitudes zm(k+1), zt(k+1), zm(k), zt(k), and zm(k-1), respectively. - ! The letter "t" is used for thermodynamic levels and the letter "m" is used - ! for momentum levels. - ! - ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - one, & ! Constant(s) - one_third - - use crmx_model_flags, only: & - l_standard_term_ta - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: max - - ! Input variables - real( kind = core_rknd ), intent(in) :: & - wp2_ztp1, & ! w'^2 interpolated to thermo. level (k+1) [m^2/s^2] - wp2_zt, & ! w'^2 interpolated to thermo. level (k) [m^2/s^2] - wp3_on_wp2_ztp1, & ! Smoothed w'^3 / w'^2 on thermo. level (k+1)[m^2/s^2] - wp3_on_wp2_zt, & ! Smoothed w'^3 / w'^2 on thermo. level (k) [m^2/s^2] - rho_ds_ztp1, & ! Dry, static density at thermo. level (k+1) [kg/m^3] - rho_ds_zt, & ! Dry, static density at thermo. level (k) [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ mome. lev (k) [m^3/kg] - a1_ztp1, & ! a_1 interpolated to thermo. level (k+1) [-] - a1, & ! a_1(k) [-] - a1_zt, & ! a_1 interpolated to thermo. level (k) [-] - wpxbp_ztp1, & ! w'x_b' interpolated to thermo. level (k+1) [m/s {x_bm units}] - wpxbp_zt, & ! w'x_b' interpolated to thermo. level (k) [m/s {x_bm units}] - wpxap_ztp1, & ! w'x_a' interpolated to thermo. level (k+1) [m/s {x_am units}] - wpxap_zt, & ! w'x_a' interpolated to thermo. level (k) [m/s {x_am units}] - invrs_dzm, & ! Inverse of grid spacing [1/m] - beta ! Model parameter [-] - - ! Return Variable - real( kind = core_rknd ) :: rhs - - - if ( l_standard_term_ta ) then - - ! The turbulent advection term is discretized normally, in accordance - ! with the model equations found in the documentation and the description - ! listed above. - - rhs & - = - ( one - one_third * beta ) & - * invrs_rho_ds_zm & - * invrs_dzm & - * ( rho_ds_ztp1 * a1_ztp1**2 & - * wp3_on_wp2_ztp1 / wp2_ztp1 & - * wpxap_ztp1 * wpxbp_ztp1 & - - rho_ds_zt * a1_zt**2 & - * wp3_on_wp2_zt / wp2_zt & - * wpxap_zt * wpxbp_zt & - ) - - else - - ! Brian tried a new discretization for the turbulent advection term, for - ! which the explicit portion of the term is: - ! - (1/rho_ds) - ! * d [ rho_ds * (a_1)^2 * (1-(1/3)*beta) * ( w'^3 / (w'^2)^2 ) - ! * w'x_a' * w'x_b' ] / dz. - ! In order to help stabilize x_a'x_b', (a_1)^2 has been pulled outside - ! the derivative. - - rhs & - = - ( one - one_third * beta ) & - * invrs_rho_ds_zm * a1**2 & - * invrs_dzm & - * ( rho_ds_ztp1 & - * wp3_on_wp2_ztp1 / wp2_ztp1 & - * wpxap_ztp1 * wpxbp_ztp1 & - - rho_ds_zt & - * wp3_on_wp2_zt / wp2_zt & - * wpxap_zt * wpxbp_zt & - ) - - ! End of Brian's a1 change. 14 Feb 2008. - - endif - - - return - end function term_ta_rhs - - !============================================================================= - pure function term_tp( xamp1, xam, xbmp1, xbm, & - wpxbp, wpxap, invrs_dzm ) & - result( rhs ) - - ! Description: - ! Turbulent production of x_a'x_b': explicit portion of the code. - ! - ! The d(x_a'x_b')/dt equation contains a turbulent production term: - ! - ! - w'x_b' d(x_am)/dz - w'x_a' d(x_bm)/dz. - ! - ! This term is solved for completely explicitly and is discretized as - ! follows: - ! - ! The values of w'x_a' and w'x_b' are found on the momentum levels, whereas - ! the values of x_am and x_bm are found on the thermodynamic levels. The - ! derivatives of both x_am and x_bm are taken over the intermediate - ! (central) momentum level. All of the remaining mathematical operations - ! take place at the central momentum level, yielding the desired result. - ! - ! ---------xamp1------------xbmp1-------------------------- t(k+1) - ! - ! ===wpxap======d(xam)/dz=========d(xbm)/dz===wpxbp======== m(k) - ! - ! ---------xam--------------xbm---------------------------- t(k) - ! - ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes - ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for - ! thermodynamic levels and the letter "m" is used for momentum levels. - ! - ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input variables - real( kind = core_rknd ), intent(in) :: & - xam, & ! x_am(k) [{x_am units}] - xamp1, & ! x_am(k+1) [{x_am units}] - xbm, & ! x_bm(k) [{x_bm units}] - xbmp1, & ! x_bm(k+1) [{x_bm units}] - wpxbp, & ! w'x_b'(k) [m/s {x_bm units}] - wpxap, & ! w'x_a'(k) [m/s {x_am units}] - invrs_dzm ! Inverse of grid spacing (k) [1/m] - - ! Return Variable - real( kind = core_rknd ) :: rhs - - rhs & - = - wpxbp * invrs_dzm * ( xamp1 - xam ) & - - wpxap * invrs_dzm * ( xbmp1 - xbm ) - - return - end function term_tp - - !============================================================================= - pure function term_dp1_lhs( Cn, tau_zm ) & - result( lhs ) - - ! Description: - ! Dissipation term 1 for x_a'x_b': implicit portion of the code. - ! - ! The d(x_a'x_b')/dt equation contains dissipation term 1: - ! - ! - ( C_n / tau_zm ) x_a'x_b'. - ! - ! For cases where x_a'x_b' is a variance (in other words, where x_a and x_b - ! are the same variable), the term is damped to a certain positive - ! threshold, such that: - ! - ! - ( C_n / tau_zm ) * ( x_a'x_b' - threshold ). - ! - ! However, if x_a'x_b' is u'^2 or v'^2, damping to a minimum threshold value - ! is part of pressure term 1 and is handled as part of function 'term_pr1'. - ! Thus, for u'^2 and v'^2, function 'term_dp1_lhs' is called, but function - ! 'term_dp1_rhs' is not called, as function 'term_pr1' is called instead. - ! - ! For cases where x_a'x_b' is a covariance (in other words, where x_a and - ! x_b are different variables), threshold is set to 0, and the expression - ! reverts to the form found in the first equation. - ! - ! This term is broken into implicit and explicit portions. The equations - ! for u'^2, v'^2, and any covariances only include the implicit portion. - ! The implicit portion of this term is: - ! - ! - ( C_n / tau_zm ) x_a'x_b'(t+1). - ! - ! Note: When the implicit term is brought over to the left-hand side, - ! the sign is reversed and the leading "-" in front of the term - ! is changed to a "+". - ! - ! The timestep index (t+1) means that the value of x_a'x_b' being used is - ! from the next timestep, which is being advanced to in solving the - ! d(x_a'x_b')/dt equation. - ! - ! The values of x_a'x_b' are found on momentum levels. The values of - ! time-scale tau_zm are also found on momentum levels. - ! - ! Note: For equations that use pressure term 1 (such as the equations for - ! u'^2 and v'^2), C_n = ( 2*C_4 + C_14 ) / 3; which combines the - ! implicit contributions for dissipation term 1 and pressure term 1 - ! into one expression. Otherwise, C_n = C_2. - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - Cn, & ! Coefficient C_n [-] - tau_zm ! Time-scale tau at momentum levels (k) [s] - - ! Return Variable - real( kind = core_rknd ) :: lhs - - ! Momentum main diagonal: [ x xapxbp(k,) ] - lhs & - = + Cn / tau_zm - - return - end function term_dp1_lhs - - !============================================================================= - pure function term_dp1_rhs( Cn, tau_zm, threshold ) & - result( rhs ) - - ! Description: - ! Dissipation term 1 for x_a'x_b': explicit portion of the code. - ! - ! The d(x_a'x_b')/dt equation contains dissipation term 1: - ! - ! - ( C_n / tau_zm ) x_a'x_b'. - ! - ! For cases where x_a'x_b' is a variance (in other words, where x_a and x_b - ! are the same variable), the term is damped to a certain positive - ! threshold, such that: - ! - ! - ( C_n / tau_zm ) * ( x_a'x_b' - threshold ). - ! - ! However, if x_a'x_b' is u'^2 or v'^2, damping to a minimum threshold value - ! is part of pressure term 1 and is handled as part of function 'term_pr1'. - ! Thus, for u'^2 and v'^2, function 'term_dp1_lhs' is called, but function - ! 'term_dp1_rhs' is not called, as function 'term_pr1' is called instead. - ! - ! For cases where x_a'x_b' is a covariance (in other words, where x_a and - ! x_b are different variables), threshold is set to 0, and the expression - ! reverts to the form found in the first equation. - ! - ! This term is broken into implicit and explicit portions. The equations - ! for u'^2, v'^2, and any covariances only include the implicit portion. - ! The explicit portion of this term is: - ! - ! + ( C_n / tau_zm ) * threshold. - ! - ! The values of time-scale tau_zm and the threshold are found on the - ! momentum levels. - ! - ! Note: The equations that use pressure term 1 (such as the equations for - ! u'^2 and v'^2) do not call this function. Thus, within this - ! function, C_n = C_2. - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - Cn, & ! Coefficient C_n [-] - tau_zm, & ! Time-scale tau at momentum levels (k) [s] - threshold ! Minimum allowable magnitude value of x_a'x_b' [units vary] - - ! Return Variable - real( kind = core_rknd ) :: rhs - - rhs & - = + ( Cn / tau_zm ) * threshold - - return - end function term_dp1_rhs - - !============================================================================= - pure function term_pr1( C4, C14, xbp2, wp2, tau_zm ) & - result( rhs ) - - ! Description: - ! Pressure term 1 for x_a'x_b': explicit portion of the code. - ! - ! Note: Pressure term 1 is only used when x_a'x_b' is either u'^2 or v'^2. - ! For the following description, pressure term 2 for u'^2 is used as - ! the example. Pressure term 2 for v'^2 is the same as pressure - ! term 2 for u'^2, except that the v'^2 and u'^2 variables are - ! switched. - ! - ! The d(u'^2)/dt equation contains dissipation term 1: - ! - ! - ( C_4 / tau_zm ) * ( u'^2 - (2/3)*em ); - ! - ! where em = (1/2) * ( u'^2 + v'^2 + w'^2 ); - ! - ! and with the substitution applied, dissipation term 1 becomes: - ! - ! - ( C_4 / tau_zm ) * ( u'^2 - (1/3) * ( u'^2 + v'^2 + w'^2 ) ). - ! - ! The d(u'^2)/dt equation also contains pressure term 1: - ! - ! - (2/3) * epsilon; - ! - ! where epsilon = C_14 * ( em / tau_zm ). - ! - ! Additionally, since pressure term 1 is a damping term, em is damped only - ! to it's minimum threshold value, em_min, where: - ! - ! em_min = (1/2) * ( u'^2|_min + v'^2|_min + w'^2|_min ) - ! = (1/2) * ( w_tol^2 + w_tol^2 + w_tol^2 ) - ! = (3/2) * w_tol^2. - ! - ! With the damping threshold applied, epsilon becomes: - ! - ! epsilon = C_14 * ( ( em - em_min ) / tau_zm ); - ! - ! and with all substitutions applied, pressure term 1 becomes: - ! - ! - (2/3) * ( C_14 / tau_zm ) - ! * [ (1/2) * ( u'^2 + v'^2 + w'^2 ) - (3/2) * w_tol^2 ]. - ! - ! Dissipation term 1 and pressure term 1 are combined and simplify to: - ! - ! - [ ( 2*C_4 + C_14 ) / ( 3 * tau_zm ) ] * u'^2 - ! + [ ( C_4 - C_14 ) / ( 3 * tau_zm ) ] * ( v'^2 + w'^2 ) - ! + ( C_14 / tau_zm ) * w_tol^2. - ! - ! The combined term has both implicit and explicit components. - ! The implicit component is: - ! - ! - [ ( 2*C_4 + C_14 ) / ( 3 * tau_zm ) ] * u'^2(t+1). - ! - ! Note: When the implicit term is brought over to the left-hand side, - ! the sign is reversed and the leading "-" in front of the term - ! is changed to a "+". - ! - ! Timestep index (t) stands for the index of the current timestep, while - ! timestep index (t+1) stands for the index of the next timestep, which is - ! being advanced to in solving the d(x_a'x_b')/dt equation. - ! - ! The implicit component of the combined dp1 and pr1 term is solved in - ! function "term_dp1_lhs" above, where "( 2*C_4 + C_14 ) / 3" is sent in - ! as "C_n". - ! - ! The explicit component of the combined dp1 and pr1 term is: - ! - ! + [ ( C_4 - C_14 ) / ( 3 * tau_zm ) ] * ( v'^2(t) + w'^2(t) ) - ! + ( C_14 / tau_zm ) * w_tol^2; - ! - ! and is discretized as follows: - ! - ! The values for v'^2 and w'^2, as well as for tau_zm, are found on the - ! momentum levels. The mathematical operations all take place on the - ! momentum levels, yielding the desired result. - - ! References: - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - w_tol_sqd, & ! Constant(s) - one_third - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C4, & ! Model parameter C_4 [-] - C14, & ! Model parameter C_14 [-] - xbp2, & ! v'^2(k) (if solving for u'^2) or vice versa [m^2/s^2] - wp2, & ! w'^2(k) [m^2/s^2] - tau_zm ! Time-scale tau at momentum levels (k) [s] - - ! Return Variable - real( kind = core_rknd ) :: rhs - - rhs = + one_third * ( C4 - C14 ) * ( xbp2 + wp2 ) / tau_zm & - + ( C14 / tau_zm ) * w_tol_sqd - - return - end function term_pr1 - - !============================================================================= - pure function term_pr2( C5, thv_ds_zm, wpthvp, upwp, vpwp, & - um, vm, invrs_dzm, kp1, k, & - Lscalep1, Lscale, wp2_ztp1, wp2_zt ) & - result( rhs ) - - ! Description: - ! Pressure term 2 for x_a'x_b': explicit portion of the code. - ! - ! Note: Pressure term 2 is only used when x_a'x_b' is either u'^2 or v'^2. - ! For the following description, pressure term 2 for u'^2 is used as - ! the example. Pressure term 2 for v'^2 is the exact same as - ! pressure term 2 for u'^2. - ! - ! The d(u'^2)/dt equation contains pressure term 2: - ! - ! + (2/3) C_5 [ (g/thv_ds) w'th_v' - u'w' du/dz - v'w' dv/dz ]. - ! - ! This term is solved for completely explicitly and is discretized as - ! follows: - ! - ! The values of w'th_v', u'w', and v'w' are found on the momentum levels, - ! whereas the values of um and vm are found on the thermodynamic levels. - ! Additionally, the values of thv_ds_zm are found on the momentum levels. - ! The derivatives of both um and vm are taken over the intermediate - ! (central) momentum level. All the remaining mathematical operations take - ! place at the central momentum level, yielding the desired result. - ! - ! -----ump1------------vmp1-------------------------------------- t(k+1) - ! - ! =upwp====d(um)/dz========d(vm)/dz==vpwp===thv_ds_zm==wpthvp==== m(k) - ! - ! -----um--------------vm---------------------------------------- t(k) - ! - ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes - ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for - ! thermodynamic levels and the letter "m" is used for momentum levels. - ! - ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & ! Constants - grav, & ! Gravitational acceleration [m/s^2] - one, & - two_thirds, & - zero, & - zero_threshold - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: abs, max - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - C5, & ! Model parameter C_5 [-] - thv_ds_zm, & ! Dry, base-state theta_v at momentum level (k) [K] - wpthvp, & ! w'th_v'(k) [m/K/s] - upwp, & ! u'w'(k) [m^2/s^2] - vpwp, & ! v'w'(k) [m^2/s^2] - invrs_dzm, & ! Inverse of the grid spacing (k) [1/m] - Lscalep1, & ! Mixing length (k+1) [m] - Lscale, & ! Mixing length (k) [m] - wp2_ztp1, & ! w'^2(k+1) (thermo. levels) [m^2/s^2] - wp2_zt ! w'^2(k) (thermo. levels) [m^2/s^2] - - ! Note: Entire arrays of um and vm are now required rather than um and vm - ! only at levels k and k+1. The entire array is necessary when a vertical - ! average calculation of d(um)/dz and d(vm)/dz is used. --ldgrant March 2010 - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - um, & ! mean zonal wind [m/s] - vm ! mean meridional wind [m/s] - - integer, intent(in) :: & - kp1, & ! current level+1 in xp2_xpyp_uv_rhs loop - k ! current level in xp2_xpyp_uv_rhs loop - - ! Return Variable - real( kind = core_rknd ) :: rhs - - ! Local Variable(s) --ldgrant, March 2010 - real( kind = core_rknd ), parameter :: & - ! Constants empirically determined for experimental version of term_pr2 - ! ldgrant March 2010 - constant1 = one, & ! [m/s] - constant2 = 1000.0_core_rknd, & ! [m] - vert_avg_depth = 200.0_core_rknd ! Depth over which to average d(um)/dz and d(vm)/dz [m] - - real( kind = core_rknd ) :: & - zt_high, & ! altitude above current altitude zt(k) [m] - um_high, & ! um at altitude zt_high [m/s] - vm_high, & ! vm at altitude zt_high [m/s] - zt_low, & ! altitude below (or at) current altitude zt(k) [m] - um_low, & ! um at altitude zt_low [m/s] - vm_low ! vm at altitude zt_low [m/s] - - logical, parameter :: & - l_use_experimental_term_pr2 = .false., & ! If true, use experimental version - ! of term_pr2 calculation - l_use_vert_avg_winds = .true. ! If true, use vert_avg_depth average - ! calculation for d(um)/dz and d(vm)/dz - - !------ Begin code ------------ - - if( .not. l_use_experimental_term_pr2 ) then - ! use original version of term_pr2 - - ! As applied to w'2 - rhs = + two_thirds * C5 & - * ( ( grav / thv_ds_zm ) * wpthvp & - - upwp * invrs_dzm * ( um(kp1) - um(k) ) & - - vpwp * invrs_dzm * ( vm(kp1) - vm(k) ) & - ) - - else ! use experimental version of term_pr2 --ldgrant March 2010 - - if( l_use_vert_avg_winds ) then - ! We found that using a 200m running average of d(um)/dz and d(vm)/dz - ! produces larger spikes in up2 and vp2 near the inversion for - ! the stratocumulus cases. - call find_endpts_for_vert_avg_winds & - ( vert_avg_depth, k, um, vm, & ! intent(in) - zt_high, um_high, vm_high, & ! intent(out) - zt_low, um_low, vm_low ) ! intent(out) - - else ! Do not use a vertical average calculation for d(um)/dz and d(vm)/dz - zt_high = gr%zt(kp1) - um_high = um(kp1) - vm_high = vm(kp1) - - zt_low = gr%zt(k) - um_low = um(k) - vm_low = vm(k) - end if ! l_use_vert_avg_winds - - ! *****NOTES on experimental version***** - ! Leah Grant and Vince Larson eliminated the contribution from wpthvp - ! because terms with d(wp2)/dz include buoyancy effects and seem to - ! produce better results. - ! - ! We also eliminated the contribution from the momentum flux terms - ! because they didn't contribute to the results. - ! - ! The constant1 line does not depend on shear. This is important for - ! up2 and vp2 generation in cases that have little shear such as FIRE. - ! We also made the constant1 line proportional to d(Lscale)/dz to account - ! for higher spikes in up2 and vp2 near a stronger inversion. This - ! increases up2 and vp2 near the inversion for the stratocumulus cases, - ! but overpredicts up2 and vp2 near cloud base in cumulus cases such - ! as BOMEX where d(Lscale)/dz is large. Therefore, the d(Lscale)/dz - ! contribution is commented out for now. - ! - ! The constant2 line includes the possibility of shear generation of - ! up2 and vp2, which is important for some cases. The current functional - ! form used is: - ! constant2 * |d(wp2)/dz| * |d(vm)/dz| - ! We use |d(vm)/dz| instead of |d(um)/dz| + |d(vm)/dz| here because - ! this allows for different profiles of up2 and vp2, which occur for - ! many cases. In addition, we found that in buoyant cases, up2 is - ! more related to d(vm)/dz and vp2 is more related to d(um)/dz. This - ! occurs if horizontal rolls are oriented in the direction of the shear - ! vector. However, in stably stratified cases, the opposite relation is - ! true (horizontal rolls caused by shear are perpendicular to the shear - ! vector). This effect is not yet accounted for. - ! - ! For better results, we reduced the value of C5 from 5.2 to 3.0 and - ! changed the eddy diffusivity coefficient Kh so that it is - ! proportional to 1.5*wp2 rather than to em. - rhs = + two_thirds * C5 & - * ( constant1 * abs( wp2_ztp1 - wp2_zt ) * invrs_dzm & - ! * abs( Lscalep1 - Lscale ) * invrs_dzm & - + constant2 * abs( wp2_ztp1 - wp2_zt ) * invrs_dzm & - * abs( vm_high - vm_low ) / ( zt_high - zt_low ) & - + ( Lscalep1 + Lscale ) * zero & - ! This line eliminates an Intel compiler - ) ! warning that Lscalep1/Lscale are not - ! used. -meyern - end if ! .not. l_use_experimental_term_pr2 - - ! Added by dschanen for ticket #36 - ! We have found that when shear generation is zero this term will only be - ! offset by hole-filling (up2_pd/vp2_pd) and reduces turbulence - ! unrealistically at lower altitudes to make up the difference. - rhs = max( rhs, zero_threshold ) - - return - end function term_pr2 - - !============================================================================= - pure subroutine find_endpts_for_vert_avg_winds & - ( vert_avg_depth, k, um, vm, & ! intent(in) - zt_high, um_high, vm_high, & ! intent(out) - zt_low, um_low, vm_low ) ! intent(out) - ! Description: - ! This subroutine determines values of um and vm which are - ! +/- [vert_avg_depth/2] m above and below the current altitude zt(k). - ! This is for the purpose of using a running vertical average - ! calculation of d(um)/dz and d(vm)/dz in term_pr2 (over a depth - ! vert_avg_depth). E.g. If a running average over 200m is desired, - ! then this subroutine will determine the values of um and vm which - ! are 100m above and below the current level. - ! ldgrant March 2010 - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - two ! Constant(s) - - use crmx_interpolation, only : & - binary_search, lin_int ! Function(s) - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - vert_avg_depth ! Depth over which to average d(um)/dz - ! and d(vm)/dz in term_pr2 [m] - - integer, intent(in) :: & - k ! current level in xp2_xpyp_uv_rhs loop - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - um, & ! mean zonal wind [m/s] - vm ! mean meridional wind [m/s] - - ! Output Variables - real( kind = core_rknd ), intent(out) :: & - zt_high, & ! current altitude zt(k) + depth [m] - um_high, & ! um at altitude zt_high [m/s] - vm_high, & ! vm at altitude zt_high [m/s] - zt_low, & ! current altitude zt(k) - depth [m] - um_low, & ! um at altitude zt_low [m/s] - vm_low ! vm at altitude zt_low [m/s] - - ! Local Variables - real( kind = core_rknd ) :: depth ! vert_avg_depth/2 [m] - - integer :: k_high, k_low - ! Number of levels above (below) the current level where altitude is - ! [depth] greater (less) than the current altitude - ! [unless zt(k) < [depth] from an upper/lower boundary] - - !------ Begin code ------------ - - depth = vert_avg_depth / two - - ! Find the grid level that contains the altitude greater than or - ! equal to the current altitude + depth - k_high = binary_search( gr%nz, gr%zt, gr%zt(k)+depth ) - ! If the current altitude + depth is greater than the highest - ! altitude, binary_search returns a value of -1 - if ( k_high == -1 ) k_high = gr%nz - - if ( k_high == gr%nz ) then - ! Current altitude + depth is higher than or exactly at the top grid level. - ! Since this is a ghost point, use the altitude at grid level nzmax-1 - k_high = gr%nz-1 - zt_high = gr%zt(k_high) - um_high = um(k_high) - vm_high = vm(k_high) - else if ( gr%zt(k_high) == gr%zt(k)+depth ) then - ! Current altitude + depth falls exactly on another grid level. - ! In this case, no interpolation is necessary. - zt_high = gr%zt(k_high) - um_high = um(k_high) - vm_high = vm(k_high) - else ! Do an interpolation to find um & vm at current altitude + depth. - zt_high = gr%zt(k)+depth - um_high = lin_int( zt_high, gr%zt(k_high), gr%zt(k_high-1), & - um(k_high), um(k_high-1) ) - vm_high = lin_int( zt_high, gr%zt(k_high), gr%zt(k_high-1), & - vm(k_high), vm(k_high-1) ) - end if ! k_high ... - - - ! Find the grid level that contains the altitude less than or - ! equal to the current altitude - depth - k_low = binary_search( gr%nz, gr%zt, gr%zt(k)-depth ) - ! If the current altitude - depth is less than the lowest - ! altitude, binary_search returns a value of -1 - if ( k_low == -1 ) k_low = 2 - - if ( k_low == 2 ) then - ! Current altitude - depth is less than or exactly at grid level 2. - ! Since grid level 1 is a ghost point, use the altitude at grid level 2 - zt_low = gr%zt(k_low) - um_low = um(k_low) - vm_low = vm(k_low) - else if ( gr%zt(k_low) == gr%zt(k)-depth ) then - ! Current altitude - depth falls exactly on another grid level. - ! In this case, no interpolation is necessary. - zt_low = gr%zt(k_low) - um_low = um(k_low) - vm_low = vm(k_low) - else ! Do an interpolation to find um at current altitude - depth. - zt_low = gr%zt(k)-depth - um_low = lin_int( zt_low, gr%zt(k_low), gr%zt(k_low-1), & - um(k_low), um(k_low-1) ) - vm_low = lin_int( zt_low, gr%zt(k_low), gr%zt(k_low-1), & - vm(k_low), vm(k_low-1) ) - end if ! k_low ... - - return - end subroutine find_endpts_for_vert_avg_winds - - !============================================================================= - subroutine pos_definite_variances( solve_type, dt, tolerance, & - rho_ds_zm, rho_ds_zt, & - xp2_np1 ) - - ! Description: - ! Use the hole filling code to make a variance term positive definite - !----------------------------------------------------------------------- - - use crmx_fill_holes, only: fill_holes_driver - use crmx_grid_class, only: gr - use crmx_clubb_precision, only: time_precision, core_rknd - - use crmx_stats_variables, only: & - zm, l_stats_samp, & - irtp2_pd, ithlp2_pd, iup2_pd, ivp2_pd ! variables - use crmx_stats_type, only: & - stat_begin_update, stat_end_update ! subroutines - - - implicit none - - ! External - intrinsic :: any, real, trim - - ! Input variables - integer, intent(in) :: & - solve_type - - real(kind=time_precision), intent(in) :: & - dt ! Model timestep [s] - - real( kind = core_rknd ), intent(in) :: & - tolerance ! Threshold for xp2_np1 [units vary] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt ! Dry, static density on thermodynamic levels [kg/m^3] - - ! Input/Output variables - real( kind = core_rknd ), intent(inout), dimension(gr%nz) :: & - xp2_np1 ! Variance for [units vary] - - ! Local variables - integer :: & - ixp2_pd - - select case( solve_type ) - case ( xp2_xpyp_rtp2 ) - ixp2_pd = irtp2_pd - case ( xp2_xpyp_thlp2 ) - ixp2_pd = ithlp2_pd - case ( xp2_xpyp_up2 ) - ixp2_pd = iup2_pd - case ( xp2_xpyp_vp2 ) - ixp2_pd = ivp2_pd - case default - ixp2_pd = 0 ! This includes the passive scalars - end select - - if ( l_stats_samp ) then - ! Store previous value for effect of the positive definite scheme - call stat_begin_update( ixp2_pd, xp2_np1 / real( dt, kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - endif - - - if ( any( xp2_np1 < tolerance ) ) then - - ! Call the hole-filling scheme. - ! The first pass-through should draw from only two levels on either side - ! of the hole. - call fill_holes_driver( 2, tolerance, "zm", & ! Intent(in) - rho_ds_zt, rho_ds_zm, & ! Intent(in) - xp2_np1 ) ! Intent(inout) - - endif - - if ( l_stats_samp ) then - ! Store previous value for effect of the positive definite scheme - call stat_end_update( ixp2_pd, xp2_np1 / real( dt, kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - endif - - - return - end subroutine pos_definite_variances - - !============================================================================ - subroutine update_xp2_mc_tndcy( nz, dt, cloud_frac, rcm, rvm, thlm, & - exner, rrainm_evap, pdf_params, & - rtp2_mc_tndcy, thlp2_mc_tndcy ) - !Description: - !This subroutine is for use when l_morr_xp2_mc_tndcy = .true. - !The effects of rain evaporation on rtp2 and thlp2 are included by - !assuming rain falls through the moist (cold) portion of the pdf. - !This is accomplished by defining a precip_fraction and assuming a double - !delta shaped pdf, such that the evaporation makes the moist component - !moister and the colder component colder. --storer - - use crmx_pdf_parameter_module, only: pdf_parameter - - use crmx_constants_clubb, only: & - cloud_frac_min, & !Variables - Cp, & - Lv - - use crmx_clubb_precision, only: & - core_rknd, & ! Variable(s) - time_precision - - implicit none - - !input parameters - integer, intent(in) :: nz ! Points in the Vertical [-] - - real( kind = time_precision ), intent(in) :: dt ! Model timestep [s] - - real( kind = core_rknd ), dimension(nz), intent(in) :: & - cloud_frac, & !Cloud fraction [-] - rcm, & !Cloud water mixing ratio [kg/kg] - rvm, & !Vapor water mixing ratio [kg/kg] - thlm, & !Liquid potential temperature [K] - exner, & !Exner function [-] - rrainm_evap !Evaporation of rain [kg/kg/s] - - type(pdf_parameter), target, dimension(nz), intent(in) :: & - pdf_params ! PDF parameters - - !input/output variables - real( kind = core_rknd ), dimension(nz), intent(inout) :: & - rtp2_mc_tndcy, & !Tendency of rtp2 due to evaporation [(kg/kg)^2/s] - thlp2_mc_tndcy !Tendency of thlp2 due to evaporation [K^2/s] - - !local variables - real( kind = core_rknd ), dimension(nz) :: & - temp_rtp2, & !Used only to calculate rtp2_mc_tndcy [(kg/kg)^2] - temp_thlp2, & !Used to calculate thlp2_mc_tndcy [K^2/s] - precip_frac, & !Precipitation fraction [-] - pf_const ! ( 1 - pf )/( pf ) [-] - - integer :: k - - ! ---- Begin Code ---- - - ! Calculate precip_frac - precip_frac(nz) = 0.0_core_rknd - do k = nz-1, 1, -1 - if ( cloud_frac(k) > cloud_frac_min ) then - precip_frac(k) = cloud_frac(k) - else - precip_frac(k) = precip_frac(k+1) - end if - end do - - !Calculate increased variance (rtp2 and thlp2) due to rain evaporation - - where ( precip_frac > cloud_frac_min ) - pf_const = ( 1.0_core_rknd - precip_frac ) / precip_frac - else where - pf_const = 0.0_core_rknd - end where - - ! Include effects of rain evaporation on rtp2 - temp_rtp2 = pdf_params%mixt_frac * ( ( pdf_params%rt1 - ( rcm + rvm ) )**2 & - + pdf_params%varnce_rt1 ) + ( 1.0_core_rknd - pdf_params%mixt_frac ) & - * ( ( pdf_params%rt2 - ( rcm + rvm ) )**2 + pdf_params%varnce_rt2 ) - - rtp2_mc_tndcy = rrainm_evap**2 * pf_const * dt & - + 2.0_core_rknd * abs(rrainm_evap) * sqrt(temp_rtp2 * pf_const) - !use absolute value of evaporation, as evaporation will add - !to rt1 - - !Include the effects of rain evaporation on thlp2 - temp_thlp2 = pdf_params%mixt_frac * ( ( pdf_params%thl1 - thlm )**2 & - + pdf_params%varnce_thl1 ) + ( 1.0_core_rknd - pdf_params%mixt_frac ) & - * ( ( pdf_params%thl2 - thlm )**2 + pdf_params%varnce_thl2 ) - - thlp2_mc_tndcy = ( rrainm_evap * Lv / ( Cp * exner) )**2 * pf_const * dt & - + 2.0_core_rknd * rrainm_evap * Lv / ( Cp * exner ) & - * sqrt(temp_thlp2 * pf_const) - - end subroutine update_xp2_mc_tndcy - -!=============================================================================== - -end module crmx_advance_xp2_xpyp_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_anl_erf.F90 b/src/physics/spcam/crm/CLUBB/crmx_anl_erf.F90 deleted file mode 100644 index 4298620c1d..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_anl_erf.F90 +++ /dev/null @@ -1,228 +0,0 @@ -! $Id: anl_erf.F90 5324 2011-07-27 21:05:45Z dschanen@uwm.edu $ -module crmx_anl_erf - - implicit none - - public :: erf - - interface erf - module procedure dp_erf, sp_erf - end interface - - private :: dp_erf, sp_erf - - private ! Default Scope - - contains - - function dp_erf( x ) result( erfx ) -!----------------------------------------------------------------------- -! Description: -! DP_ERF evaluates the error function DP_ERF(X). -! -! Original Author: -! William Cody, -! Mathematics and Computer Science Division, -! Argonne National Laboratory, -! Argonne, Illinois, 60439. -! -! References: -! William Cody, -! "Rational Chebyshev approximations for the error function", -! Mathematics of Computation, -! 1969, pages 631-638. -! -! Arguments: -! Input, real ( kind = 8 ) X, the argument of ERF. -! Output, real ( kind = 8 ) ERFX, the value of ERF(X). -!----------------------------------------------------------------------- - - implicit none - - ! Input Variables(s) - double precision, intent(in) :: x - - ! External - intrinsic :: epsilon, exp, aint - - ! Local Constants - real( kind = 8 ), parameter, dimension( 5 ) :: & - a = (/ 3.16112374387056560D+00, & - 1.13864154151050156D+02, & - 3.77485237685302021D+02, & - 3.20937758913846947D+03, & - 1.85777706184603153D-01 /) - real( kind = 8 ), parameter, dimension( 4 ) :: & - b = (/ 2.36012909523441209D+01, & - 2.44024637934444173D+02, & - 1.28261652607737228D+03, & - 2.84423683343917062D+03 /) - real( kind = 8 ), parameter, dimension( 9 ) :: & - c = (/ 5.64188496988670089D-01, & - 8.88314979438837594D+00, & - 6.61191906371416295D+01, & - 2.98635138197400131D+02, & - 8.81952221241769090D+02, & - 1.71204761263407058D+03, & - 2.05107837782607147D+03, & - 1.23033935479799725D+03, & - 2.15311535474403846D-08 /) - real( kind = 8 ), parameter, dimension( 8 ) :: & - d = (/ 1.57449261107098347D+01, & - 1.17693950891312499D+02, & - 5.37181101862009858D+02, & - 1.62138957456669019D+03, & - 3.29079923573345963D+03, & - 4.36261909014324716D+03, & - 3.43936767414372164D+03, & - 1.23033935480374942D+03 /) - real( kind = 8 ), parameter, dimension( 6 ) :: & - p = (/ 3.05326634961232344D-01, & - 3.60344899949804439D-01, & - 1.25781726111229246D-01, & - 1.60837851487422766D-02, & - 6.58749161529837803D-04, & - 1.63153871373020978D-02 /) - - real( kind = 8 ), parameter, dimension( 5 ) :: & - q = (/ 2.56852019228982242D+00, & - 1.87295284992346047D+00, & - 5.27905102951428412D-01, & - 6.05183413124413191D-02, & - 2.33520497626869185D-03 /) - - real( kind = 8 ), parameter :: & - SQRPI = 0.56418958354775628695D+00, & - THRESH = 0.46875D+00, & - XBIG = 26.543D+00 - - ! Return type - real( kind = 8 ) :: erfx - - ! Local variables - real( kind = 8 ) :: & - del, & - xabs, & - xden, & - xnum, & - xsq - - integer :: i ! Index - -!------------------------------------------------------------------------------- - xabs = abs( x ) - - ! - ! Evaluate ERF(X) for |X| <= 0.46875. - ! - if ( xabs <= THRESH ) then - - if ( epsilon( xabs ) < xabs ) then - xsq = xabs * xabs - else - xsq = 0.0D+00 - end if - - xnum = a(5) * xsq - xden = xsq - do i = 1, 3 - xnum = ( xnum + a(i) ) * xsq - xden = ( xden + b(i) ) * xsq - end do - - erfx = x * ( xnum + a(4) ) / ( xden + b(4) ) - ! - ! Evaluate ERFC(X) for 0.46875 <= |X| <= 4.0. - ! - else if ( xabs <= 4.0D+00 ) then - - xnum = c(9) * xabs - xden = xabs - do i = 1, 7 - xnum = ( xnum + c(i) ) * xabs - xden = ( xden + d(i) ) * xabs - end do - - erfx = ( xnum + c(8) ) / ( xden + d(8) ) - xsq = aint( xabs * 16.0D+00 ) / 16.0D+00 - del = ( xabs - xsq ) * ( xabs + xsq ) - ! xsq * xsq in the exponential was changed to xsq**2. - ! This seems to decrease runtime by about a half a percent. - ! ~~EIHoppe//20090622 - erfx = exp( - xsq**2 ) * exp( - del ) * erfx - - erfx = ( 0.5D+00 - erfx ) + 0.5D+00 - - if ( x < 0.0D+00 ) then - erfx = - erfx - end if - ! - ! Evaluate ERFC(X) for 4.0 < |X|. - ! - else - - if ( XBIG <= xabs ) then - - if ( 0.0D+00 < x ) then - erfx = 1.0D+00 - else - erfx = -1.0D+00 - end if - - else - - xsq = 1.0D+00 / ( xabs * xabs ) - - xnum = p(6) * xsq - xden = xsq - do i = 1, 4 - xnum = ( xnum + p(i) ) * xsq - xden = ( xden + q(i) ) * xsq - end do - - erfx = xsq * ( xnum + p(5) ) / ( xden + q(5) ) - erfx = ( SQRPI - erfx ) / xabs - xsq = aint( xabs * 16.0D+00 ) / 16.0D+00 - del = ( xabs - xsq ) * ( xabs + xsq ) - erfx = exp( - xsq * xsq ) * exp( - del ) * erfx - - erfx = ( 0.5D+00 - erfx ) + 0.5D+00 - if ( x < 0.0D+00 ) then - erfx = - erfx - end if - - end if - - end if - - return - end function dp_erf - -!----------------------------------------------------------------------- - function sp_erf( x ) result( erfx ) - -! Description: -! Return a truncation of the 64bit approx. of the error function. -! Ideally we would probably use a 32bit table for our approx. - -! References: -! None -!----------------------------------------------------------------------- - - implicit none - - ! External - intrinsic :: real - - ! Input Variables - real( kind=4 ), intent(in) :: x - - ! Return type - real( kind=4 ) :: erfx - - erfx = real( dp_erf( real(x, kind=8) ), kind=4 ) - - return - end function sp_erf - -end module crmx_anl_erf diff --git a/src/physics/spcam/crm/CLUBB/crmx_array_index.F90 b/src/physics/spcam/crm/CLUBB/crmx_array_index.F90 deleted file mode 100644 index 41c5b7f38d..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_array_index.F90 +++ /dev/null @@ -1,37 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: array_index.F90 5216 2011-06-06 18:58:41Z dschanen@uwm.edu $ -!----------------------------------------------------------------------- -module crmx_array_index - -! Description: -! Contains indices to variables in larger arrays. -! Note that the 'ii' is necessary because 'i' is used in -! statistics to track locations in the zt/zm/sfc derived types. - -! References: -! None -!----------------------------------------------------------------------- - implicit none - - ! Variables - ! Microphysics mixing ratios - integer, public :: & - iirrainm, iirsnowm, iiricem, iirgraupelm ! [kg/kg] -!$omp threadprivate(iirrainm, iirsnowm, iiricem, iirgraupelm) - - ! Microphysics number concentration - integer, public :: & - iiNrm, iiNsnowm, iiNim, iiNgraupelm, iiNcm ! [#/kg] -!$omp threadprivate(iiNrm, iiNsnowm, iiNim, iiNgraupelm, iiNcm) - - ! Scalar quantities - integer, public :: & - iisclr_rt, iisclr_thl, iisclr_CO2, & ! [kg/kg]/[K]/[1e6 mol/mol] - iiedsclr_rt, iiedsclr_thl, iiedsclr_CO2 ! " " -!$omp threadprivate(iisclr_rt, iisclr_thl, iisclr_CO2, & -!$omp iiedsclr_rt, iiedsclr_thl, iiedsclr_CO2) - - private ! Default Scope - -end module crmx_array_index -!----------------------------------------------------------------------- diff --git a/src/physics/spcam/crm/CLUBB/crmx_calendar.F90 b/src/physics/spcam/crm/CLUBB/crmx_calendar.F90 deleted file mode 100644 index 28d7987614..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_calendar.F90 +++ /dev/null @@ -1,250 +0,0 @@ -!$Id: calendar.F90 5867 2012-07-03 21:06:44Z dschanen@uwm.edu $ -module crmx_calendar - - implicit none - - public :: gregorian2julian_date, julian2gregorian_date, & - leap_year, compute_current_date, & - gregorian2julian_day - - private ! Default Scope - - ! Constant Parameters - - ! 3 Letter Month Abbreviations - character(len=3), dimension(12), public, parameter :: & - month_names = (/'JAN','FEB','MAR','APR','MAY','JUN', & - 'JUL','AUG','SEP','OCT','NOV','DEC'/) - - ! Number of days per month (Jan..Dec) for a non leap year - integer, public, dimension(12), parameter :: & - days_per_month = (/31, 28, 31, 30, 31, 30, & - 31, 31, 30, 31, 30, 31/) - - contains -!----------------------------------------------------------------------- - integer function gregorian2julian_date( day, month, year ) -! -! Description: -! Computes the Julian Date (gregorian2julian), or the number of days since -! 1 January 4713 BC, given a Gregorian Calender date (day, month, year). -! -! Reference: -! Fliegel, H. F. and van Flandern, T. C., -! Communications of the ACM, Vol. 11, No. 10 (October, 1968) -!---------------------------------------------------------------------- - - implicit none - - ! Input Variables - integer, intent(in) :: & - day, & ! Gregorian Calendar Day for given Month [dd] - month, & ! Gregorian Calendar Month for given Year [mm] - year ! Gregorian Calendar Year [yyyy] - - ! Local Variables - integer :: I,J,K - - I = year - J = month - K = day - - gregorian2julian_date = K-32075+1461*(I+4800+(J-14)/12)/4+367* & - (J-2-(J-14)/12*12)/12-3*((I+4900+(J-14)/12)/100)/4 - - return - end function gregorian2julian_date - -!------------------------------------------------------------------ - subroutine julian2gregorian_date & - ( julian_date, day, month, year ) -! -! Description: -! Computes the Gregorina Calendar date (day, month, year) -! given the Julian date (julian_date). -! -! Reference: -! Fliegel, H. F. and van Flandern, T. C., -! Communications of the ACM, Vol. 11, No. 10 (October, 1968) -! http://portal.acm.org/citation.cfm?id=364097 -!------------------------------------------------------------------ - implicit none - - ! Input Variable(s) - integer, intent(in) :: julian_date ! Julian date being converted from - - ! Output Variable(s) - integer, intent(out):: & - day, & ! Gregorian calender day for given Month [dd] - month, & ! Gregorian calender month for given Year [mm] - year ! Gregorian calender year [yyyy] - - ! Local Variables - integer :: i, j, k, n, l - - ! ---- Begin Code ---- - - L = julian_date+68569 ! Known magic number - N = 4*L/146097 ! Known magic number - L = L-(146097*N+3)/4 ! Known magic number - I = 4000*(L+1)/1461001 ! Known magic number - L = L-1461*I/4+31 ! Known magic number - J = 80*L/2447 ! Known magic number - K = L-2447*J/80 ! Known magic number - L = J/11 ! Known magic number - J = J+2-12*L ! Known magic number - I = 100*(N-49)+I+L ! Known magic number - - year = I - month = J - day = K - - return - - end subroutine julian2gregorian_date - -!----------------------------------------------------------------------------- - logical function leap_year( year ) -! -! Description: -! Determines if the given year is a leap year. -! -! References: -! None -!----------------------------------------------------------------------------- - implicit none - - ! External - intrinsic :: mod - - ! Input Variable(s) - integer, intent(in) :: year ! Gregorian Calendar Year [yyyy] - - ! ---- Begin Code ---- - - leap_year = ( (mod( year, 4 ) == 0) .and. & - (.not.( mod( year, 100 ) == 0 .and. mod( year, 400 ) /= 0 ) ) ) - - return - end function leap_year - -!---------------------------------------------------------------------------- - subroutine compute_current_date( previous_day, previous_month, & - previous_year, & - seconds_since_previous_date, & - current_day, current_month, & - current_year, & - seconds_since_current_date ) -! -! Description: -! Computes the current Gregorian date from a previous date and -! the seconds that have transpired since that date. -! -! References: -! None -!---------------------------------------------------------------------------- - use crmx_clubb_precision, only: & - time_precision ! Variable(s) - - use crmx_constants_clubb, only: & - sec_per_day ! Variable(s) - - implicit none - - ! Input Variable(s) - - ! Previous date - integer, intent(in) :: & - previous_day, & ! Day of the month [dd] - previous_month, & ! Month of the year [mm] - previous_year ! Year [yyyy] - - real(kind=time_precision), intent(in) :: & - seconds_since_previous_date ! [s] - - ! Output Variable(s) - - ! Current date - integer, intent(out) :: & - current_day, & ! Day of the month [dd] - current_month, & ! Month of the year [mm] - current_year ! Year [yyyy] - - real(kind=time_precision), intent(out) :: & - seconds_since_current_date - - integer :: & - days_since_1jan4713bc, & - days_since_start - - ! ---- Begin Code ---- - - ! Using Julian dates we are able to add the days that the model - ! has been running - - ! Determine the Julian Date of the starting date, - ! written in Gregorian (day, month, year) form - days_since_1jan4713bc = gregorian2julian_date( previous_day, & - previous_month, previous_year ) - - ! Determine the amount of days that have passed since start date - days_since_start = & - floor( seconds_since_previous_date / sec_per_day ) - - ! Set days_since_1jan4713 to the present Julian date - days_since_1jan4713bc = days_since_1jan4713bc + days_since_start - - ! Set Present time to be seconds since the Julian date - seconds_since_current_date = seconds_since_previous_date & - - ( real( days_since_start, kind=time_precision ) * sec_per_day ) - - call julian2gregorian_date & - ( days_since_1jan4713bc, & - current_day, current_month, current_year ) - - return - end subroutine compute_current_date - -!------------------------------------------------------------------------------------- - integer function gregorian2julian_day( day, month, year ) -! -! Description: -! This subroutine determines the Julian day (1-366) -! for a given Gregorian calendar date(e.g. July 1, 2008). -! -! References: -! None -!------------------------------------------------------------------------------------- - - implicit none - - ! External - intrinsic :: sum - - ! Input Variable(s) - integer, intent(in) :: & - day, & ! Day of the Month [dd] - month, & ! Month of the Year [mm] - year ! Year [yyyy] - - ! ---- Begin Code ---- - - ! Add the days from the previous months - gregorian2julian_day = day + sum( days_per_month(1:month-1) ) - - ! Kluge for a leap year - ! If the date were 29 Feb 2000 this would not increment julian_day - ! However 01 March 2000 would need the 1 day bump - if ( leap_year( year ) .and. month > 2 ) then - gregorian2julian_day = gregorian2julian_day + 1 - end if - - if ( ( leap_year( year ) .and. gregorian2julian_day > 366 ) .or. & - ( .not. leap_year( year ) .and. gregorian2julian_day > 365 ) ) then - stop "Problem with Julian day conversion in gregorian2julian_day." - end if - - return - end function gregorian2julian_day - -end module crmx_calendar diff --git a/src/physics/spcam/crm/CLUBB/crmx_clip_explicit.F90 b/src/physics/spcam/crm/CLUBB/crmx_clip_explicit.F90 deleted file mode 100644 index ce73c9c88a..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_clip_explicit.F90 +++ /dev/null @@ -1,859 +0,0 @@ -!------------------------------------------------------------------------------- -! $Id: clip_explicit.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -!=============================================================================== -module crmx_clip_explicit - - implicit none - - private - - public :: clip_covars_denom, & - clip_covar, & - clip_variance, & - clip_skewness, & - clip_skewness_core - - ! Named constants to avoid string comparisons - integer, parameter, public :: & - clip_rtp2 = 1, & ! Named constant for rtp2 clipping - clip_thlp2 = 2, & ! Named constant for thlp2 clipping - clip_rtpthlp = 3, & ! Named constant for rtpthlp clipping - clip_up2 = 5, & ! Named constant for up2 clipping - clip_vp2 = 6, & ! Named constant for vp2 clipping -! clip_scalar = 7, & ! Named constant for scalar clipping - clip_wprtp = 8, & ! Named constant for wprtp clipping - clip_wpthlp = 9, & ! Named constant for wpthlp clipping - clip_upwp = 10, & ! Named constant for upwp clipping - clip_vpwp = 11, & ! Named constant for vpwp clipping - clip_wp2 = 12, & ! Named constant for wp2 clipping - clip_wpsclrp = 13, & ! Named constant for wp scalar clipping - clip_sclrp2 = 14, & ! Named constant for sclrp2 clipping - clip_sclrprtp = 15, & ! Named constant for sclrprtp clipping - clip_sclrpthlp = 16 ! Named constant for sclrpthlp clipping - - contains - - !============================================================================= - subroutine clip_covars_denom( dt, rtp2, thlp2, up2, vp2, wp2, & - sclrp2, wprtp_cl_num, wpthlp_cl_num, & - wpsclrp_cl_num, upwp_cl_num, vpwp_cl_num, & - wprtp, wpthlp, upwp, vpwp, wpsclrp ) - - ! Description: - ! Some of the covariances found in the CLUBB model code need to be clipped - ! multiple times during each timestep to ensure that the correlation between - ! the two relevant variables stays between -1 and 1 at all times during the - ! model run. The covariances that need to be clipped multiple times are - ! w'r_t', w'th_l', w'sclr', u'w', and v'w'. One of the times that each one - ! of these covariances is clipped is immediately after each one is set. - ! However, each covariance still needs to be clipped two more times during - ! each timestep (once after advance_xp2_xpyp is called and once after - ! advance_wp2_wp3 is called). This subroutine handles the times that the - ! covariances are clipped away from the time that they are set. In other - ! words, this subroutine clips the covariances after the denominator terms - ! in the relevant correlation equation have been altered, ensuring that - ! all correlations will remain between -1 and 1 at all times. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_parameters_model, only: & - sclr_dim ! Variable(s) - - use crmx_model_flags, only: & - l_tke_aniso ! Logical - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_stats_type, only: & - stat_modify ! Procedure(s) - - use crmx_stats_variables, only: & - iwprtp_bt, & ! Variable(s) - iwpthlp_bt, & - zm, & - l_stats_samp - - implicit none - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Timestep [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - rtp2, & ! r_t'^2 [(kg/kg)^2] - thlp2, & ! theta_l'^2 [K^2] - up2, & ! u'^2 [m^2/s^2] - vp2, & ! v'^2 [m^2/s^2] - wp2 ! w'^2 [m^2/s^2] - - real( kind = core_rknd ), dimension(gr%nz,sclr_dim), intent(in) :: & - sclrp2 ! sclr'^2 [{units vary}^2] - - integer, intent(in) :: & - wprtp_cl_num, & - wpthlp_cl_num, & - wpsclrp_cl_num, & - upwp_cl_num, & - vpwp_cl_num - - ! Input/Output Variables - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - wprtp, & ! w'r_t' [(kg/kg) m/s] - wpthlp, & ! w'theta_l' [K m/s] - upwp, & ! u'w' [m^2/s^2] - vpwp ! v'w' [m^2/s^2] - - real( kind = core_rknd ), dimension(gr%nz,sclr_dim), intent(inout) :: & - wpsclrp ! w'sclr' [units m/s] - - ! Local Variables - logical :: & - l_first_clip_ts, & ! First instance of clipping in a timestep. - l_last_clip_ts ! Last instance of clipping in a timestep. - - real( kind = core_rknd ), dimension(gr%nz) :: & - wprtp_chnge, & ! Net change in w'r_t' due to clipping [(kg/kg) m/s] - wpthlp_chnge, & ! Net change in w'th_l' due to clipping [K m/s] - upwp_chnge, & ! Net change in u'w' due to clipping [m^2/s^2] - vpwp_chnge ! Net change in v'w' due to clipping [m^2/s^2] - - real( kind = core_rknd ), dimension(gr%nz,sclr_dim) :: & - wpsclrp_chnge ! Net change in w'sclr' due to clipping [{units vary}] - - integer :: i ! scalar array index. - - ! ---- Begin Code ---- - - !!! Clipping for w'r_t' - ! - ! Clipping w'r_t' at each vertical level, based on the - ! correlation of w and r_t at each vertical level, such that: - ! corr_(w,r_t) = w'r_t' / [ sqrt(w'^2) * sqrt(r_t'^2) ]; - ! -1 <= corr_(w,r_t) <= 1. - ! - ! Since w'^2, r_t'^2, and w'r_t' are each advanced in different - ! subroutines from each other in advance_clubb_core, clipping for w'r_t' - ! is done three times during each timestep (once after each variable has - ! been updated). - ! - ! This subroutine handles the first and third instances of - ! w'r_t' clipping. - ! The first instance of w'r_t' clipping takes place after - ! r_t'^2 is updated in advance_xp2_xpyp. - ! The third instance of w'r_t' clipping takes place after - ! w'^2 is updated in advance_wp2_wp3. - - ! Include effect of clipping in wprtp time tendency budget term. - if ( l_stats_samp ) then - - ! if wprtp_cl_num == 1 do nothing since - ! iwprtp_bt stat_begin_update is called outside of this method - - if ( wprtp_cl_num == 2 ) then - ! wprtp total time tendency (effect of clipping) - call stat_modify( iwprtp_bt, -wprtp / real( dt, kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - elseif ( wprtp_cl_num == 3 ) then - ! wprtp total time tendency (effect of clipping) - call stat_modify( iwprtp_bt, -wprtp / real( dt, kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - endif - endif - - ! Used within subroutine clip_covar. - if ( wprtp_cl_num == 1 ) then - l_first_clip_ts = .true. - l_last_clip_ts = .false. - elseif ( wprtp_cl_num == 2 ) then - l_first_clip_ts = .false. - l_last_clip_ts = .false. - elseif ( wprtp_cl_num == 3 ) then - l_first_clip_ts = .false. - l_last_clip_ts = .true. - endif - - ! Clip w'r_t' - call clip_covar( clip_wprtp, l_first_clip_ts, & ! intent(in) - l_last_clip_ts, dt, wp2, rtp2, & ! intent(in) - wprtp, wprtp_chnge ) ! intent(inout) - - if ( l_stats_samp ) then - if ( wprtp_cl_num == 1 ) then - ! wprtp total time tendency (effect of clipping) - call stat_modify( iwprtp_bt, wprtp / real( dt, kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - elseif ( wprtp_cl_num == 2 ) then - ! wprtp total time tendency (effect of clipping) - call stat_modify( iwprtp_bt, wprtp / real( dt, kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - ! if wprtp_cl_num == 3 do nothing since - ! iwprtp_bt stat_end_update is called outside of this method - - endif - endif - - - !!! Clipping for w'th_l' - ! - ! Clipping w'th_l' at each vertical level, based on the - ! correlation of w and th_l at each vertical level, such that: - ! corr_(w,th_l) = w'th_l' / [ sqrt(w'^2) * sqrt(th_l'^2) ]; - ! -1 <= corr_(w,th_l) <= 1. - ! - ! Since w'^2, th_l'^2, and w'th_l' are each advanced in different - ! subroutines from each other in advance_clubb_core, clipping for w'th_l' - ! is done three times during each timestep (once after each variable has - ! been updated). - ! - ! This subroutine handles the first and third instances of - ! w'th_l' clipping. - ! The first instance of w'th_l' clipping takes place after - ! th_l'^2 is updated in advance_xp2_xpyp. - ! The third instance of w'th_l' clipping takes place after - ! w'^2 is updated in advance_wp2_wp3. - - ! Include effect of clipping in wpthlp time tendency budget term. - if ( l_stats_samp ) then - - ! if wpthlp_cl_num == 1 do nothing since - ! iwpthlp_bt stat_begin_update is called outside of this method - - if ( wpthlp_cl_num == 2 ) then - ! wpthlp total time tendency (effect of clipping) - call stat_modify( iwpthlp_bt, -wpthlp / real( dt, kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - elseif ( wpthlp_cl_num == 3 ) then - ! wpthlp total time tendency (effect of clipping) - call stat_modify( iwpthlp_bt, -wpthlp / real( dt, kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - endif - endif - - ! Used within subroutine clip_covar. - if ( wpthlp_cl_num == 1 ) then - l_first_clip_ts = .true. - l_last_clip_ts = .false. - elseif ( wpthlp_cl_num == 2 ) then - l_first_clip_ts = .false. - l_last_clip_ts = .false. - elseif ( wpthlp_cl_num == 3 ) then - l_first_clip_ts = .false. - l_last_clip_ts = .true. - endif - - ! Clip w'th_l' - call clip_covar( clip_wpthlp, l_first_clip_ts, & ! intent(in) - l_last_clip_ts, dt, wp2, thlp2, & ! intent(in) - wpthlp, wpthlp_chnge ) ! intent(inout) - - - if ( l_stats_samp ) then - if ( wpthlp_cl_num == 1 ) then - ! wpthlp total time tendency (effect of clipping) - call stat_modify( iwpthlp_bt, wpthlp / real( dt, kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - elseif ( wpthlp_cl_num == 2 ) then - ! wpthlp total time tendency (effect of clipping) - call stat_modify( iwpthlp_bt, wpthlp / real( dt, kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - - ! if wpthlp_cl_num == 3 do nothing since - ! iwpthlp_bt stat_end_update is called outside of this method - - endif - endif - - - !!! Clipping for w'sclr' - ! - ! Clipping w'sclr' at each vertical level, based on the - ! correlation of w and sclr at each vertical level, such that: - ! corr_(w,sclr) = w'sclr' / [ sqrt(w'^2) * sqrt(sclr'^2) ]; - ! -1 <= corr_(w,sclr) <= 1. - ! - ! Since w'^2, sclr'^2, and w'sclr' are each advanced in different - ! subroutines from each other in advance_clubb_core, clipping for w'sclr' - ! is done three times during each timestep (once after each variable has - ! been updated). - ! - ! This subroutine handles the first and third instances of - ! w'sclr' clipping. - ! The first instance of w'sclr' clipping takes place after - ! sclr'^2 is updated in advance_xp2_xpyp. - ! The third instance of w'sclr' clipping takes place after - ! w'^2 is updated in advance_wp2_wp3. - - ! Used within subroutine clip_covar. - if ( wpsclrp_cl_num == 1 ) then - l_first_clip_ts = .true. - l_last_clip_ts = .false. - elseif ( wpsclrp_cl_num == 2 ) then - l_first_clip_ts = .false. - l_last_clip_ts = .false. - elseif ( wpsclrp_cl_num == 3 ) then - l_first_clip_ts = .false. - l_last_clip_ts = .true. - endif - - ! Clip w'sclr' - do i = 1, sclr_dim, 1 - call clip_covar( clip_wpsclrp, l_first_clip_ts, & ! intent(in) - l_last_clip_ts, dt, wp2(:), sclrp2(:,i), & ! intent(in) - wpsclrp(:,i), wpsclrp_chnge(:,i) ) ! intent(inout) - enddo - - - !!! Clipping for u'w' - ! - ! Clipping u'w' at each vertical level, based on the - ! correlation of u and w at each vertical level, such that: - ! corr_(u,w) = u'w' / [ sqrt(u'^2) * sqrt(w'^2) ]; - ! -1 <= corr_(u,w) <= 1. - ! - ! Since w'^2, u'^2, and u'w' are each advanced in different - ! subroutines from each other in advance_clubb_core, clipping for u'w' - ! is done three times during each timestep (once after each variable has - ! been updated). - ! - ! This subroutine handles the first and second instances of - ! u'w' clipping. - ! The first instance of u'w' clipping takes place after - ! u'^2 is updated in advance_xp2_xpyp. - ! The second instance of u'w' clipping takes place after - ! w'^2 is updated in advance_wp2_wp3. - - ! Used within subroutine clip_covar. - if ( upwp_cl_num == 1 ) then - l_first_clip_ts = .true. - l_last_clip_ts = .false. - elseif ( upwp_cl_num == 2 ) then - l_first_clip_ts = .false. - l_last_clip_ts = .false. - elseif ( upwp_cl_num == 3 ) then - l_first_clip_ts = .false. - l_last_clip_ts = .true. - endif - - ! Clip u'w' - if ( l_tke_aniso ) then - call clip_covar( clip_upwp, l_first_clip_ts, & ! intent(in) - l_last_clip_ts, dt, wp2, up2, & ! intent(in) - upwp, upwp_chnge ) ! intent(inout) - else - ! In this case, up2 = wp2, and the variable `up2' does not interact - call clip_covar( clip_upwp, l_first_clip_ts, & ! intent(in) - l_last_clip_ts, dt, wp2, wp2, & ! intent(in) - upwp, upwp_chnge ) ! intent(inout) - end if - - - - !!! Clipping for v'w' - ! - ! Clipping v'w' at each vertical level, based on the - ! correlation of v and w at each vertical level, such that: - ! corr_(v,w) = v'w' / [ sqrt(v'^2) * sqrt(w'^2) ]; - ! -1 <= corr_(v,w) <= 1. - ! - ! Since w'^2, v'^2, and v'w' are each advanced in different - ! subroutines from each other in advance_clubb_core, clipping for v'w' - ! is done three times during each timestep (once after each variable has - ! been updated). - ! - ! This subroutine handles the first and second instances of - ! v'w' clipping. - ! The first instance of v'w' clipping takes place after - ! v'^2 is updated in advance_xp2_xpyp. - ! The second instance of v'w' clipping takes place after - ! w'^2 is updated in advance_wp2_wp3. - - ! Used within subroutine clip_covar. - if ( vpwp_cl_num == 1 ) then - l_first_clip_ts = .true. - l_last_clip_ts = .false. - elseif ( vpwp_cl_num == 2 ) then - l_first_clip_ts = .false. - l_last_clip_ts = .false. - elseif ( vpwp_cl_num == 3 ) then - l_first_clip_ts = .false. - l_last_clip_ts = .true. - endif - - if ( l_tke_aniso ) then - call clip_covar( clip_vpwp, l_first_clip_ts, & ! intent(in) - l_last_clip_ts, dt, wp2, vp2, & ! intent(in) - vpwp, vpwp_chnge ) ! intent(inout) - else - ! In this case, vp2 = wp2, and the variable `vp2' does not interact - call clip_covar( clip_vpwp, l_first_clip_ts, & ! intent(in) - l_last_clip_ts, dt, wp2, wp2, & ! intent(in) - vpwp, vpwp_chnge ) ! intent(inout) - end if - - - return - end subroutine clip_covars_denom - - !============================================================================= - subroutine clip_covar( solve_type, l_first_clip_ts, & - l_last_clip_ts, dt, xp2, yp2, & - xpyp, xpyp_chnge ) - - ! Description: - ! Clipping the value of covariance x'y' based on the correlation between x - ! and y. - ! - ! The correlation between variables x and y is: - ! - ! corr_(x,y) = x'y' / [ sqrt(x'^2) * sqrt(y'^2) ]; - ! - ! where x'^2 is the variance of x, y'^2 is the variance of y, and x'y' is - ! the covariance of x and y. - ! - ! The correlation of two variables must always have a value between -1 - ! and 1, such that: - ! - ! -1 <= corr_(x,y) <= 1. - ! - ! Therefore, there is an upper limit on x'y', such that: - ! - ! x'y' <= [ sqrt(x'^2) * sqrt(y'^2) ]; - ! - ! and a lower limit on x'y', such that: - ! - ! x'y' >= -[ sqrt(x'^2) * sqrt(y'^2) ]. - ! - ! The values of x'y', x'^2, and y'^2 are all found on momentum levels. - ! - ! The value of x'y' may need to be clipped whenever x'y', x'^2, or y'^2 is - ! updated. - ! - ! The following covariances are found in the code: - ! - ! w'r_t', w'th_l', w'sclr', (computed in advance_xm_wpxp); - ! r_t'th_l', sclr'r_t', sclr'th_l', (computed in advance_xp2_xpyp); - ! u'w', v'w', w'edsclr' (computed in advance_windm_edsclrm). - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_constants_clubb, only: & - max_mag_correlation ! Constant(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_stats_type, only: & - stat_begin_update, & ! Procedure(s) - stat_modify, & - stat_end_update - - use crmx_stats_variables, only: & - zm, & ! Variable(s) - iwprtp_cl, & - iwpthlp_cl, & - irtpthlp_cl, & - l_stats_samp - - implicit none - - ! Input Variables - integer, intent(in) :: & - solve_type ! Variable being solved; used for STATS. - - logical, intent(in) :: & - l_first_clip_ts, & ! First instance of clipping in a timestep. - l_last_clip_ts ! Last instance of clipping in a timestep. - - real(kind=time_precision), intent(in) :: & - dt ! Model timestep; used here for STATS [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - xp2, & ! Variance of x, x'^2 (momentum levels) [{x units}^2] - yp2 ! Variance of y, y'^2 (momentum levels) [{y units}^2] - - ! Output Variable - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - xpyp ! Covariance of x and y, x'y' (momentum levels) [{x units}*{y units}] - - real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & - xpyp_chnge ! Net change in x'y' due to clipping [{x units}*{y units}] - - - ! Local Variable - integer :: k ! Array index - - integer :: & - ixpyp_cl - - ! ---- Begin Code ---- - - select case ( solve_type ) - case ( clip_wprtp ) ! wprtp clipping budget term - ixpyp_cl = iwprtp_cl - case ( clip_wpthlp ) ! wpthlp clipping budget term - ixpyp_cl = iwpthlp_cl - case ( clip_rtpthlp ) ! rtpthlp clipping budget term - ixpyp_cl = irtpthlp_cl - case default ! scalars (or upwp/vpwp) are involved - ixpyp_cl = 0 - end select - - - if ( l_stats_samp ) then - if ( l_first_clip_ts ) then - call stat_begin_update( ixpyp_cl, xpyp / real( dt, kind = core_rknd ), zm ) - else - call stat_modify( ixpyp_cl, -xpyp / real( dt, kind = core_rknd ), zm ) - endif - endif - - ! The value of x'y' at the surface (or lower boundary) is a set value that - ! is either specified or determined elsewhere in a surface subroutine. It - ! is ensured elsewhere that the correlation between x and y at the surface - ! (or lower boundary) is between -1 and 1. Thus, the covariance clipping - ! code does not need to be invoked at the lower boundary. Likewise, the - ! value of x'y' is set at the upper boundary, so the covariance clipping - ! code does not need to be invoked at the upper boundary. - ! Note that if clipping were applied at the lower boundary, momentum will - ! not be conserved, therefore it should never be added. - do k = 2, gr%nz-1, 1 - - ! Clipping for xpyp at an upper limit corresponding with a correlation - ! between x and y of max_mag_correlation. - if ( xpyp(k) > max_mag_correlation * sqrt( xp2(k) * yp2(k) ) ) then - - xpyp_chnge(k) = max_mag_correlation * sqrt( xp2(k) * yp2(k) ) - xpyp(k) - - xpyp(k) = max_mag_correlation * sqrt( xp2(k) * yp2(k) ) - - ! Clipping for xpyp at a lower limit corresponding with a correlation - ! between x and y of -max_mag_correlation. - elseif ( xpyp(k) < -max_mag_correlation * sqrt( xp2(k) * yp2(k) ) ) then - - xpyp_chnge(k) = -max_mag_correlation * sqrt( xp2(k) * yp2(k) ) - xpyp(k) - - xpyp(k) = -max_mag_correlation * sqrt( xp2(k) * yp2(k) ) - - else - - xpyp_chnge(k) = 0.0_core_rknd - - endif - - enddo ! k = 2..gr%nz - - ! Since there is no covariance clipping at the upper or lower boundaries, - ! the change in x'y' due to covariance clipping at those levels is 0. - xpyp_chnge(1) = 0.0_core_rknd - xpyp_chnge(gr%nz) = 0.0_core_rknd - - if ( l_stats_samp ) then - if ( l_last_clip_ts ) then - call stat_end_update( ixpyp_cl, xpyp / real( dt, kind = core_rknd ), zm ) - else - call stat_modify( ixpyp_cl, xpyp / real( dt, kind = core_rknd ), zm ) - endif - endif - - - return - end subroutine clip_covar - - !============================================================================= - subroutine clip_variance( solve_type, dt, threshold, & - xp2 ) - - ! Description: - ! Clipping the value of variance x'^2 based on a minimum threshold value. - ! The threshold value must be greater than or equal to 0. - ! - ! The values of x'^2 are found on the momentum levels. - ! - ! The following variances are found in the code: - ! - ! r_t'^2, th_l'^2, u'^2, v'^2, sclr'^2, (computed in advance_xp2_xpyp); - ! w'^2 (computed in advance_wp2_wp3). - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_stats_type, only: & - stat_begin_update, & ! Procedure(s) - stat_end_update - - use crmx_stats_variables, only: & - zm, & ! Variable(s) - iwp2_cl, & - irtp2_cl, & - ithlp2_cl, & - iup2_cl, & - ivp2_cl, & - l_stats_samp - - implicit none - - ! Input Variables - integer, intent(in) :: & - solve_type ! Variable being solved; used for STATS. - - real(kind=time_precision), intent(in) :: & - dt ! Model timestep; used here for STATS [s] - - real( kind = core_rknd ), intent(in) :: & - threshold ! Minimum value of x'^2 [{x units}^2] - - ! Output Variable - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - xp2 ! Variance of x, x'^2 (momentum levels) [{x units}^2] - - ! Local Variables - integer :: k ! Array index - - - integer :: & - ixp2_cl - - ! ---- Begin Code ---- - - select case ( solve_type ) - case ( clip_wp2 ) ! wp2 clipping budget term - ixp2_cl = iwp2_cl - case ( clip_rtp2 ) ! rtp2 clipping budget term - ixp2_cl = irtp2_cl - case ( clip_thlp2 ) ! thlp2 clipping budget term - ixp2_cl = ithlp2_cl - case ( clip_up2 ) ! up2 clipping budget term - ixp2_cl = iup2_cl - case ( clip_vp2 ) ! vp2 clipping budget term - ixp2_cl = ivp2_cl - case default ! scalars are involved - ixp2_cl = 0 - end select - - - if ( l_stats_samp ) then - call stat_begin_update( ixp2_cl, xp2 / real( dt, kind = core_rknd ), zm ) - endif - - ! Limit the value of x'^2 at threshold. - ! The value of x'^2 at the surface (or lower boundary) is a set value that - ! is determined elsewhere in a surface subroutine. Thus, the variance - ! clipping code does not need to be invoked at the lower boundary. - ! Likewise, the value of x'^2 is set at the upper boundary, so the variance - ! clipping code does not need to be invoked at the upper boundary. - do k = 2, gr%nz-1, 1 - if ( xp2(k) < threshold ) then - xp2(k) = threshold - endif - enddo - - if ( l_stats_samp ) then - call stat_end_update( ixp2_cl, xp2 / real( dt, kind = core_rknd ), zm ) - endif - - - return - end subroutine clip_variance - - !============================================================================= - subroutine clip_skewness( dt, sfc_elevation, wp2_zt, wp3 ) - - ! Description: - ! Clipping the value of w'^3 based on the skewness of w, Sk_w. - ! - ! Aditionally, to prevent possible crashes due to wp3 growing too large, - ! abs(wp3) will be clipped to 100. - ! - ! The skewness of w is: - ! - ! Sk_w = w'^3 / (w'^2)^(3/2). - ! - ! The value of Sk_w is limited to a range between an upper limit and a lower - ! limit. The values of the limits depend on whether the level altitude is - ! within 100 meters of the surface. - ! - ! For altitudes less than or equal to 100 meters above ground level (AGL): - ! - ! -0.2_core_rknd*sqrt(2) <= Sk_w <= 0.2_core_rknd*sqrt(2); - ! - ! while for all altitudes greater than 100 meters AGL: - ! - ! -4.5_core_rknd <= Sk_w <= 4.5_core_rknd. - ! - ! Therefore, there is an upper limit on w'^3, such that: - ! - ! w'^3 <= threshold_magnitude * (w'^2)^(3/2); - ! - ! and a lower limit on w'^3, such that: - ! - ! w'^3 >= -threshold_magnitude * (w'^2)^(3/2). - ! - ! The values of w'^3 are found on the thermodynamic levels, while the values - ! of w'^2 are found on the momentum levels. Therefore, the values of w'^2 - ! are interpolated to the thermodynamic levels before being used to - ! calculate the upper and lower limits for w'^3. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_stats_type, only: & - stat_begin_update, & ! Procedure(s) - stat_end_update - - use crmx_stats_variables, only: & - zt, & ! Variable(s) - iwp3_cl, & - l_stats_samp - - implicit none - - ! External - intrinsic :: sign, sqrt, real - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Model timestep; used here for STATS [s] - - real( kind = core_rknd ), intent(in) :: & - sfc_elevation ! Elevation of ground level [m AMSL] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - wp2_zt ! w'^2 interpolated to thermodyamic levels [m^2/s^2] - - ! Input/Output Variables - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - wp3 ! w'^3 (thermodynamic levels) [m^3/s^3] - - ! ---- Begin Code ---- - - if ( l_stats_samp ) then - call stat_begin_update( iwp3_cl, wp3 / real( dt, kind = core_rknd ), zt ) - endif - - call clip_skewness_core( sfc_elevation, wp2_zt, wp3 ) - - if ( l_stats_samp ) then - call stat_end_update( iwp3_cl, wp3 / real( dt, kind = core_rknd ), zt ) - endif - - return - end subroutine clip_skewness - -!============================================================================= - subroutine clip_skewness_core( sfc_elevation, wp2_zt, wp3 ) -! - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_constants_clubb, only: & - Skw_max_mag_sqd ! [-] - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: sign, sqrt, real - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - sfc_elevation ! Elevation of ground level [m AMSL] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - wp2_zt ! w'^2 interpolated to thermodyamic levels [m^2/s^2] - - ! Input/Output Variables - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - wp3 ! w'^3 (thermodynamic levels) [m^3/s^3] - - ! Local Variables - real( kind = core_rknd ), dimension(gr%nz) :: & - wp2_zt_cubed, & ! Variance of vertical velocity cubed (w^2_{zt}^3) [m^6/s^6] - wp3_lim_sqd ! Keeps absolute value of Sk_w from becoming > limit [m^6/s^6] - - integer :: k ! Vertical array index. - - real( kind = core_rknd ), parameter :: & - wp3_max = 100._core_rknd ! Threshold for wp3 [m^3/s^3] - - ! ---- Begin Code ---- - - ! Compute the upper and lower limits of w'^3 at every level, - ! based on the skewness of w, Sk_w, such that: - ! Sk_w = w'^3 / (w'^2)^(3/2); - ! -4.5 <= Sk_w <= 4.5; - ! or, if the level altitude is within 100 meters of the surface, - ! -0.2*sqrt(2) <= Sk_w <= 0.2*sqrt(2). - - ! The normal magnitude limit of skewness of w in the CLUBB code is 4.5. - ! However, according to Andre et al. (1976b & 1978), wp3 should not exceed - ! [2*(wp2^3)]^(1/2) at any level. However, this term should be multiplied - ! by 0.2 close to the surface to include surface effects. There already is - ! a wp3 clipping term in place for all other altitudes, but this term will - ! be included for the surface layer only. Therefore, the lowest level wp3 - ! should not exceed 0.2 * sqrt(2) * wp2^(3/2). Brian Griffin. 12/18/05. - - ! To lower compute time, we squared both sides of the equation and compute - ! wp2^3 only once. -dschanen 9 Oct 2008 - - wp2_zt_cubed(1:gr%nz) = wp2_zt(1:gr%nz)**3 - - do k = 1, gr%nz, 1 - if ( gr%zt(k) - sfc_elevation <= 100.0_core_rknd ) then ! Clip for 100 m. AGL. - !wp3_upper_lim(k) = 0.2_core_rknd * sqrt_2 * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd) - !wp3_lower_lim(k) = -0.2_core_rknd * sqrt_2 * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd) - wp3_lim_sqd(k) = 0.08_core_rknd * wp2_zt_cubed(k) ! Where 0.08_core_rknd - ! == (sqrt(2)*0.2_core_rknd)**2 known magic number - else ! Clip skewness consistently with a. - !wp3_upper_lim(k) = 4.5_core_rknd * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd) - !wp3_lower_lim(k) = -4.5_core_rknd * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd) - wp3_lim_sqd(k) = Skw_max_mag_sqd * wp2_zt_cubed(k) ! Skw_max_mag = 4.5_core_rknd^2 - endif - enddo - - ! Clipping for w'^3 at an upper and lower limit corresponding with - ! the appropriate value of Sk_w. - where ( wp3**2 > wp3_lim_sqd ) & - ! Set the magnitude to the wp3 limit and apply the sign of the current wp3 - wp3 = sign( sqrt( wp3_lim_sqd ), wp3 ) - - ! Clipping abs(wp3) to 100. This keeps wp3 from growing too large in some - ! deep convective cases, which helps prevent these cases from blowing up. - where ( abs(wp3) > wp3_max ) & - wp3 = sign( wp3_max , wp3 ) ! Known magic number - - end subroutine clip_skewness_core - -!=============================================================================== - -end module crmx_clip_explicit diff --git a/src/physics/spcam/crm/CLUBB/crmx_clip_semi_implicit.F90 b/src/physics/spcam/crm/CLUBB/crmx_clip_semi_implicit.F90 deleted file mode 100644 index 4447d88325..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_clip_semi_implicit.F90 +++ /dev/null @@ -1,660 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: clip_semi_implicit.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -!=============================================================================== -module crmx_clip_semi_implicit - - ! Description of the semi-implicit clipping code: - ! The semi-implicit clipping code is based on an upper threshold and/or a - ! lower threshold value for variable f. - ! - ! The semi-implicit clipping code is used when the value of variable f should - ! not exceed the designated threshold(s) when it is advanced to timestep - ! index (t+1). - ! - ! - ! Clipping at an Upper Threshold: - ! - ! When there is an upper threshold to be applied, the equation for the clipped - ! value of the variable f, f_clipped, is: - ! - ! f_clipped(t+1) = MIN( f_unclipped(t+1), upper_threshold ) - ! = ( f_unclipped(t+1) - upper_threshold ) - ! * H(upper_threshold-f_unclipped(t+1)) - ! + upper_threshold; - ! - ! where f_unclipped is the value of the variable f without clipping, and - ! H(upper_threshold-f_unclipped(t+1)) is the Heaviside Step function. The - ! clipping term is turned into a time tendency term, such that: - ! - ! (df/dt)_clipping = (1/dt_clip) - ! * ( f_clipped(t+1) - f_unclipped(t+1) ); - ! - ! where dt_clip is the time scale for the clipping term. The difference - ! between the threshold value and f_unclipped is defined as f_diff: - ! - ! f_diff = upper_threshold - f_unclipped. - ! - ! The clipping time tendency is now simplified as: - ! - ! (df/dt)_clipping = + (1/dt_clip) - ! * { f_diff(t+1) * [ 1 - H(f_diff(t+1)) ] }. - ! - ! Function R(f_diff) is defined as: - ! - ! R(f_diff) = { f_diff * [ 1 - H(f_diff) ] }. - ! - ! The clipping time tendency is now written as: - ! - ! (df/dt)_clipping = + (1/dt_clip) * R(f_diff(t+1)). - ! - ! In order to solve for f_unclipped (and f_diff) at timestep index (t+1), the - ! clipping term must be linearized. A Taylor Series expansion (truncated - ! after the first derivative term) of R(f_diff) around f_diff = f_diff(t) is - ! used to linearize the term. However, the Heaviside Step function, - ! H(f_diff), is not differentiable when f_diff(t) = 0, as the function jumps - ! at that point. Likewise, the function R(f_diff) is not differentiable when - ! f_diff(t) = 0, as the function has a corner at that point. Therefore, a new - ! function, F_R(f_diff) is used as an approximation of R(f_diff). Function - ! F_R(f_diff) is a three-piece function that has the exact same value as - ! R(f_diff) when f_diff <= -sigma or f_diff >= sigma (sigma is an arbitrarily - ! declared value). However, when -sigma < f_diff < sigma, a parabolic - ! function is used to approximate the corner found in R(f_diff). The - ! parabolic function needs to have the same values at f_diff = -sigma and - ! f_diff = sigma as does R(f_diff). Furthermore, the derivative of the - ! parabolic function (with respect to f_diff) needs to have the same values at - ! f_diff = -sigma and f_diff = sigma as does d(R)/d(f_diff). The parabolic - ! function that satisfies these properities is: - ! f_diff - (sigma/4) * [ 1 + (f_diff/sigma) ]^2. - ! Therefore: - ! - ! | f_diff; where f_diff <= -sigma - ! | - ! F_R(f_diff) = | f_diff - (sigma/4) * [ 1 + (f_diff/sigma) ]^2; - ! | where -sigma < f_diff < sigma - ! | - ! | 0; where f_diff >= sigma; and - ! - ! | 1; where f_diff <= -sigma - ! | - ! ( d F_R / d f_diff ) = | 1 - (1/2) * [ 1 + (f_diff/sigma) ]; - ! | where -sigma < f_diff < sigma - ! | - ! | 0; where f_diff >= sigma. - ! - ! Since, R(f_diff(t+1)) approx.= F_R(f_diff(t+1)), the Taylor Series expansion - ! is done for F_R(f_diff) around f_diff = f_diff(t) in order to linearize the - ! term: - ! - ! F_R(f_diff(t+1)) approx.= - ! A_fnc + B_fnc * ( f_diff(t+1) - f_diff(t) ); - ! - ! where A_fnc is defined as F_R(f_diff(t)) and B_fnc is defined as - ! ( d F_R / d f_diff )|_(f_diff=f_diff(t)). - ! - ! The approximation is substituted into the (df/dt)_clipping equation. The - ! rate of change of variable f due to clipping with the upper threshold is: - ! - ! (df/dt)_clipping - ! = + (1/dt_clip) - ! * { A_fnc - B_fnc * f_diff(t) - ! + B_fnc * upper_threshold - B_fnc * f_unclipped(t+1) }. - ! - ! The implicit (LHS) portion of the equation for clipping with the upper - ! threshold is: - ! - ! - (1/dt_clip) * B_fnc * f_unclipped(t+1). - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed - ! to a "+". - ! - ! The explicit (RHS) portion of the equation for clipping with the upper - ! threshold is: - ! - ! + (1/dt_clip) - ! * { A_fnc - B_fnc * f_diff(t) + B_fnc * upper_threshold }. - ! - ! Timestep index (t) stands for the index of the current timestep, while - ! timestep index (t+1) stands for the index of the next timestep, which is - ! being advanced to in solving the d(f)/dt equation. - ! - ! - ! Clipping at a Lower Threshold: - ! - ! When there is a lower threshold to be applied, the equation for the clipped - ! value of the variable f, f_clipped, is: - ! - ! f_clipped(t+1) = MAX( f_unclipped(t+1), lower_threshold ) - ! = ( f_unclipped(t+1) - lower_threshold ) - ! * H(f_unclipped(t+1)-lower_threshold) - ! + lower_threshold; - ! - ! where f_unclipped is the value of the variable f without clipping, and - ! H(f_unclipped(t+1)-lower_threshold) is the Heaviside Step function. The - ! clipping term is turned into a time tendency term, such that: - ! - ! (df/dt)_clipping = (1/dt_clip) - ! * ( f_clipped(t+1) - f_unclipped(t+1) ); - ! - ! where dt_clip is the time scale for the clipping term. The difference - ! between f_unclipped and the threshold value is defined as f_diff: - ! - ! f_diff = f_unclipped - lower_threshold. - ! - ! The clipping time tendency is now simplified as: - ! - ! (df/dt)_clipping = - (1/dt_clip) - ! * { f_diff(t+1) * [ 1 - H(f_diff(t+1)) ] }. - ! - ! Function R(f_diff) is defined as: - ! - ! R(f_diff) = { f_diff * [ 1 - H(f_diff) ] }. - ! - ! The clipping time tendency is now written as: - ! - ! (df/dt)_clipping = - (1/dt_clip) * R(f_diff(t+1)). - ! - ! The linearization process is the same for the lower threshold as it is for - ! the upper threshold. The formulas for A_fnc and B_fnc are the same, but the - ! values (based on a different f_diff) are different. The rate of change of - ! variable f due to clipping with the lower threshold is: - ! - ! (df/dt)_clipping - ! = - (1/dt_clip) - ! * { A_fnc - B_fnc * f_diff(t) - ! - B_fnc * lower_threshold + B_fnc * f_unclipped(t+1) }. - ! - ! The implicit (LHS) portion of the equation for clipping with the lower - ! threshold is: - ! - ! - (1/dt_clip) * B_fnc * f_unclipped(t+1). - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed - ! to a "+". - ! - ! The explicit (RHS) portion of the equation for clipping with the lower - ! threshold is: - ! - ! - (1/dt_clip) - ! * { A_fnc - B_fnc * f_diff(t) - B_fnc * lower_threshold }. - ! - ! All variables in these equations are on the same vertical levels as the - ! variable f. - ! - ! - ! Adjustable parameters: - ! - ! sigma: sigma is the amount on either side of the threshold value to which - ! the parabolic function portion of F_R(f_diff) is applied. The value - ! of sigma must be greater than 0. A proportionally larger value of - ! sigma can be used to effect values of f that are near the threshold, - ! but not to it or over it. The close-to-threshold values will be - ! nudged away from the threshold. - ! - ! dt_clip: dt_clip is the clipping time scale. It can be set equal to the - ! model timestep, dt, but it doesn't have to be. Smaller values of - ! dt_clip produce a greater effect on the clipping term. - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - implicit none - - private - - public :: clip_semi_imp_lhs, & - clip_semi_imp_rhs - - private :: compute_clip_lhs, & - compute_fncts_A_B - - ! Constant parameters. - - ! sigma coefficient: A coefficient with dimensionless units that must have a - ! value greater than 0. The value should be kept below 1. - ! The larger the value of sigma_coef, the larger the value - ! of sigma, and the larger the range of close-to-threshold - ! values that will be effected (nudged away from the - ! threshold) by the semi-implicit clipping. - real( kind = core_rknd ), parameter :: sigma_coef = 0.15_core_rknd - - ! dt_clip coefficient: A coefficient with dimensionless units that must have - ! a value greater than 0. A value of 1 will set the - ! clipping time scale, dt_clip, equal to the model - ! timestep, dt. The smaller the value of dt_clip_coef, - ! the smaller the value of dt_clip, and the larger the - ! magnitude of (df/dt)_clipping. - real(kind=time_precision), parameter :: dt_clip_coef = 1.0_time_precision - - contains - - !============================================================================= - function clip_semi_imp_lhs( dt, f_unclipped, & - l_upper_thresh, upper_threshold, & - l_lower_thresh, lower_threshold ) & - result( lhs ) - - ! Description: - ! The implicit portion of the semi-implicit clipping code. - ! - ! The implicit (LHS) portion of the equation for clipping with the upper - ! threshold is: - ! - ! - (1/dt_clip) * B_fnc * f_unclipped(t+1). - ! - ! The implicit (LHS) portion of the equation for clipping with the lower - ! threshold is: - ! - ! - (1/dt_clip) * B_fnc * f_unclipped(t+1). - ! - ! Note: When either term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of either term is changed - ! to a "+". - ! - ! The timestep index (t+1) means that the value of f being used is from the - ! next timestep, which is being advanced to in solving the d(f)/dt equation. - ! - ! While the formulas are the same for both the upper threshold and the lower - ! threshold, the values of A_fnc, B_fnc, and f_diff will differ between the - ! two thresholds. - ! - ! The overall implicit (LHS) portion for the clipping term is the sum of the - ! implicit portion from the upper threshold and the implicit portion from - ! the lower threshold. - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s)implicit none - - implicit none - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Model timestep. [s] - - real( kind = core_rknd ), intent(in) :: & - f_unclipped, & ! The unclipped value of variable f at timestep (t). [f units] - upper_threshold, & ! Greatest allowable value of variable f. [f units] - lower_threshold ! Smallest allowable value of variable f. [f units] - - logical, intent(in) :: & - l_upper_thresh, & ! Flag for having an upper threshold value. - l_lower_thresh ! Flag for having a lower threshold value. - - ! Return Variable - real( kind = core_rknd ) :: lhs - - ! Local Variables - real(kind=time_precision) :: & - dt_clip ! Time scale for semi-implicit clipping term. [s] - - real( kind = core_rknd ) :: & - f_diff, & ! Difference between the threshold value and f_unclipped. [f units] - A_fnc, & ! Function that approximates { f_diff * [ 1 - H(f_diff) ] }. [f units] - B_fnc, & ! Derivative w/ respect to f_diff of function A_fnc. [] - lhs_upper, & ! Contribution of upper threshold to implicit portion (LHS). [s^-1] - lhs_lower ! Contribution of lower threshold to implicit portion (LHS). [s^-1] - - - ! Compute the clipping time scale, dt_clip. - dt_clip = dt_clip_coef * dt - - - ! Upper Threshold - if ( l_upper_thresh ) then - - ! f_diff is the difference between the threshold value and f_unclipped. - ! In regards to the upper threshold, it is defined as - ! upper_threshold - f_unclipped. - f_diff = upper_threshold - f_unclipped - - ! Compute the values of functions A_fnc and B_fnc evaluated at f_diff(t) - ! for the upper threshold. - call compute_fncts_A_B( l_upper_thresh, upper_threshold, & - l_lower_thresh, lower_threshold, & - f_diff, A_fnc, B_fnc ) - - ! Compute the implicit (LHS) contribution from clipping for the upper - ! threshold. - lhs_upper = compute_clip_lhs( dt_clip, B_fnc ) - - else - - lhs_upper = 0.0_core_rknd - - endif - - - ! Lower Threshold - if ( l_lower_thresh ) then - - ! f_diff is the difference between the threshold value and f_unclipped. - ! In regards to the lower threshold, it is defined as - ! f_unclipped - lower_threshold. - f_diff = f_unclipped - lower_threshold - - ! Compute the values of functions A_fnc and B_fnc evaluated at f_diff(t) - ! for the lower threshold. - call compute_fncts_A_B( l_upper_thresh, upper_threshold, & - l_lower_thresh, lower_threshold, & - f_diff, A_fnc, B_fnc ) - - ! Compute the implicit (LHS) contribution from clipping for the lower - ! threshold. - lhs_lower = compute_clip_lhs( dt_clip, B_fnc ) - - else - - lhs_lower = 0.0_core_rknd - - endif - - - ! Total implicit (LHS) contribution to clipping. - ! Main diagonal: [ x f_unclipped(k,) ] - lhs = lhs_upper + lhs_lower - - - end function clip_semi_imp_lhs - - !============================================================================= - pure function compute_clip_lhs( dt_clip, B_fnc ) & - result( lhs_contribution ) - - ! Description: - ! Calculation of the implicit portion of the semi-implicit clipping term. - ! - ! The implicit portion of the semi-implicit clipping term is: - ! - ! - (1/dt_clip) * B_fnc * f_unclipped(t+1). - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed - ! to a "+". - ! - ! The timestep index (t+1) means that the value of f being used is from the - ! next timestep, which is being advanced to in solving the d(f)/dt equation. - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt_clip ! Time scale for semi-implicit clipping term. [s] - - real( kind = core_rknd ), intent(in) :: & - B_fnc ! Derivative w/ respect to f_diff of function A_fnc. [] - - ! Return Variable - real( kind = core_rknd ) :: lhs_contribution - - - ! Main diagonal: [ x f_unclipped(k,) ] - lhs_contribution & - = + (1.0_core_rknd/real( dt_clip, kind = core_rknd ) * B_fnc ) - - - end function compute_clip_lhs - - !============================================================================= - function clip_semi_imp_rhs( dt, f_unclipped, & - l_upper_thresh, upper_threshold, & - l_lower_thresh, lower_threshold ) & - result( rhs ) - - ! Description: - ! The explicit portion of the semi-implicit clipping code. - ! - ! The explicit (RHS) portion of the equation for clipping with the upper - ! threshold is: - ! - ! + (1/dt_clip) - ! * { A_fnc - B_fnc * f_diff(t) + B_fnc * upper_threshold }. - ! - ! The explicit (RHS) portion of the equation for clipping with the lower - ! threshold is: - ! - ! - (1/dt_clip) - ! * { A_fnc - B_fnc * f_diff(t) - B_fnc * lower_threshold }. - ! - ! Timestep index (t) stands for the index of the current timestep. - ! - ! The values of A_fnc, B_fnc, and f_diff will differ between the two - ! thresholds. - ! - ! The overall explicit (RHS) portion for the clipping term is the sum of the - ! explicit portion from the upper threshold and the explicit portion from - ! the lower threshold. - - ! References: - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Model timestep. [s] - - real( kind = core_rknd ), intent(in) :: & - f_unclipped, & ! The unclipped value of variable f at timestep (t). [f units] - upper_threshold, & ! Greatest allowable value of variable f. [f units] - lower_threshold ! Smallest allowable value of variable f. [f units] - - logical, intent(in) :: & - l_upper_thresh, & ! Flag for having an upper threshold value. - l_lower_thresh ! Flag for having a lower threshold value. - - ! Return Variable - real( kind = core_rknd ) :: rhs - - ! Local Variables - real(kind=time_precision) :: & - dt_clip ! Time scale for semi-implicit clipping term. [s] - - real( kind = core_rknd ) :: & - f_diff, & ! Difference between the threshold value and f_unclipped. [f units] - A_fnc, & ! Function that approximates { f_diff * [ 1 - H(f_diff) ] }. [f units] - B_fnc, & ! Derivative w/ respect to f_diff of function A_fnc. [] - rhs_upper, & ! Contribution of upper threshold to explicit portion (RHS). [s^-1] - rhs_lower ! Contribution of lower threshold to explicit portion (RHS). [s^-1] - - - ! Compute the clipping time scale, dt_clip. - dt_clip = dt_clip_coef * dt - - - ! Upper Threshold - if ( l_upper_thresh ) then - - ! f_diff is the difference between the threshold value and f_unclipped. - ! In regards to the upper threshold, it is defined as - ! upper_threshold - f_unclipped. - f_diff = upper_threshold - f_unclipped - - ! Compute the values of functions A_fnc and B_fnc evaluated at f_diff(t) - ! for the upper threshold. - call compute_fncts_A_B( l_upper_thresh, upper_threshold, & - l_lower_thresh, lower_threshold, & - f_diff, A_fnc, B_fnc ) - - ! Compute the explicit (RHS) contribution from clipping for the upper - ! threshold. - rhs_upper & - = + (1.0_core_rknd/real( dt_clip, kind = core_rknd ) & - * ( A_fnc - B_fnc * f_diff + B_fnc * upper_threshold ) ) - - else - - rhs_upper = 0.0_core_rknd - - endif - - - ! Lower Threshold - if ( l_lower_thresh ) then - - ! f_diff is the difference between the threshold value and f_unclipped. - ! In regards to the lower threshold, it is defined as - ! f_unclipped - lower_threshold. - f_diff = f_unclipped - lower_threshold - - ! Compute the values of functions A_fnc and B_fnc evaluated at f_diff(t) - ! for the lower threshold. - call compute_fncts_A_B( l_upper_thresh, upper_threshold, & - l_lower_thresh, lower_threshold, & - f_diff, A_fnc, B_fnc ) - - ! Compute the explicit (RHS) contribution from clipping for the lower - ! threshold. - rhs_lower & - = - (1.0_core_rknd/ real( dt_clip, kind = core_rknd )) & - * ( A_fnc - B_fnc * f_diff - B_fnc * lower_threshold ) - - else - - rhs_lower = 0.0_core_rknd - - endif - - - ! Total explicit (RHS) contribution to clipping. - rhs = rhs_upper + rhs_lower - - - end function clip_semi_imp_rhs - - !============================================================================= - subroutine compute_fncts_A_B( l_upper_thresh, upper_threshold, & - l_lower_thresh, lower_threshold, & - f_diff, A_fnc, B_fnc ) - - ! Description: - ! This subroutine computes the values of two functions used in semi-implicit - ! clipping. Both of the functions are based on the values of f_diff(t) and - ! the parameter sigma. One function is A_fnc, which is F_R(f_diff) - ! evaluated at f_diff = f_diff(t). F_R(f_diff) is a three-piece function - ! that is used to approximate function R(f_diff). The other function is - ! B_fnc, the derivative with respect to f_diff of function A_fnc. In other - ! words, B_fnc is ( d F_R / d f_diff ) evaluated at f_diff = f_diff(t). - ! - ! The equation for A_fnc is: - ! - ! | f_diff(t); where f_diff(t) <= -sigma - ! | - ! A_fnc = | f_diff(t) - (sigma/4) * [ 1 + (f_diff(t)/sigma) ]^2; - ! | where -sigma < f_diff(t) < sigma - ! | - ! | 0; where f_diff(t) >= sigma; - ! - ! while the equation for B_fnc is: - ! - ! | 1; where f_diff(t) <= -sigma - ! | - ! B_fnc = | 1 - (1/2) * [ 1 + (f_diff(t)/sigma) ]; - ! | where -sigma < f_diff(t) < sigma - ! | - ! | 0; where f_diff(t) >= sigma; - ! - ! where timestep index (t) stands for the index of the current timestep. - - ! References: - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: eps ! Variable(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variable - real( kind = core_rknd ), intent(in) :: & - f_diff, & ! Difference between the threshold value and f_unclipped. [f units] - upper_threshold, & ! Greatest allowable value of variable f. [f units] - lower_threshold ! Smallest allowable value of variable f. [f units] - - logical, intent(in) :: & - l_upper_thresh, & ! Flag for having an upper threshold value. - l_lower_thresh ! Flag for having a lower threshold value. - - ! Output Variables - real( kind = core_rknd ), intent(out) :: & - A_fnc, & ! Function that approximates { f_diff * [ 1 - H(f_diff) ] }. [f units] - B_fnc ! Derivative w/ respect to f_diff of function A_fnc. [] - - ! Local Variables - real( kind = core_rknd ) :: sigma_val, & ! Value of parameter sigma. [f units] - thresh_avg_mag ! Average magnitude of threshold(s). [f units] - - thresh_avg_mag = 0.0_core_rknd ! Default Initialization - - ! Find the average magnitude of the threshold. - ! In cases where only one threshold applies, the average magnitude of the - ! threshold must be greater than 0. - ! Note: The constant eps is there in case only one threshold applies, and - ! it has a value of 0 (or very close to 0). However, eps is a very - ! small number, and therefore it will not start curbing values until - ! they get extremely close to the threshold. A larger constant value - ! may work better. - if ( l_upper_thresh .and. l_lower_thresh ) then - ! Both thresholds apply. - thresh_avg_mag = 0.5_core_rknd * ( abs(upper_threshold) & - + abs(lower_threshold) ) - elseif ( l_upper_thresh ) then - ! Only the upper threshold applies. - thresh_avg_mag = max( abs(upper_threshold), eps ) - elseif ( l_lower_thresh ) then - ! Only the lower threshold applies. - thresh_avg_mag = max( abs(lower_threshold), eps ) - endif - - ! Compute the value of sigma based on the magnitude of the threshold(s) for - ! variable f and the sigma coefficient. The value of sigma must always be - ! positive. - sigma_val = sigma_coef * thresh_avg_mag - - ! A_fnc is a three-piece function that approximates function - ! R(f_diff(t)) = { f_diff(t) * [ 1 - H(f_diff(t)) ] }. This is needed - ! because the R(f_diff(t)) is not differentiable at point f_diff(t) = 0, as - ! the function has a corner at that point. Function A_fnc is differentiable - ! at all points. It is evaluated for f_diff at timestep index (t). - if ( f_diff <= -sigma_val ) then - A_fnc = f_diff - elseif ( f_diff >= sigma_val ) then - A_fnc = 0.0_core_rknd - else ! -sigma_val < f_diff < sigma_val - A_fnc = f_diff - ( (sigma_val/4.0_core_rknd) & - * ( 1.0_core_rknd + f_diff/sigma_val )**2 ) - endif - - ! B_fnc is the derivative with respect to f_diff of function A_fnc. It is - ! evaluated for f_diff at timestep index (t). - if ( f_diff <= -sigma_val ) then - B_fnc = 1.0_core_rknd - elseif ( f_diff >= sigma_val ) then - B_fnc = 0.0_core_rknd - else ! -sigma_val < f_diff < sigma_val - B_fnc = 1.0_core_rknd - (1.0_core_rknd/2.0_core_rknd)*( 1.0_core_rknd + f_diff/sigma_val ) - endif - - - end subroutine compute_fncts_A_B - -!=============================================================================== - -end module crmx_clip_semi_implicit diff --git a/src/physics/spcam/crm/CLUBB/crmx_clubb_core.F90 b/src/physics/spcam/crm/CLUBB/crmx_clubb_core.F90 deleted file mode 100644 index 3e768ff032..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_clubb_core.F90 +++ /dev/null @@ -1,3105 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: clubb_core.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ -!----------------------------------------------------------------------- -module crmx_clubb_core - -! Description: -! The module containing the `core' of the CLUBB parameterization. -! A host model implementing CLUBB should only require this subroutine -! and the functions and subroutines it calls. -! -! References: -! ``A PDF-Based Model for Boundary Layer Clouds. Part I: -! Method and Model Description'' Golaz, et al. (2002) -! JAS, Vol. 59, pp. 3540--3551. -! -! Copyright Notice: -! -! This code and the source code it references are (C) 2006-2013 -! Jean-Christophe Golaz, Vincent E. Larson, Brian M. Griffin, -! David P. Schanen, Adam J. Smith, and Michael J. Falk. -! -! The distribution of this code and derived works thereof -! should include this notice. -! -! Portions of this code derived from other sources (Hugh Morrison, -! ACM TOMS, Numerical Recipes, et cetera) are the intellectual -! property of their respective authors as noted and are also subject -! to copyright. -!----------------------------------------------------------------------- - - implicit none - - public :: & - setup_clubb_core, & - advance_clubb_core, & - cleanup_clubb_core, & - set_Lscale_max - - private ! Default Scope - - contains - - !----------------------------------------------------------------------- - - !####################################################################### - !####################################################################### - ! If you change the argument list of advance_clubb_core you also have to - ! change the calls to this function in the host models CAM, WRF, SAM - ! and GFDL. - !####################################################################### - !####################################################################### - subroutine advance_clubb_core & - ( l_implemented, dt, fcor, sfc_elevation, & - thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & - sclrm_forcing, edsclrm_forcing, wprtp_forcing, & - wpthlp_forcing, rtp2_forcing, thlp2_forcing, & - rtpthlp_forcing, wm_zm, wm_zt, & - wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & - wpsclrp_sfc, wpedsclrp_sfc, & - p_in_Pa, rho_zm, rho, exner, & - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & - rfrzm, radf, & - um, vm, upwp, vpwp, up2, vp2, & - thlm, rtm, wprtp, wpthlp, & - wp2, wp3, rtp2, thlp2, rtpthlp, & - sclrm, & -#ifdef GFDL - sclrm_trsport_only, & ! h1g, 2010-06-16 -#endif - sclrp2, sclrprtp, sclrpthlp, & - wpsclrp, edsclrm, err_code, & -#ifdef GFDL - RH_crit, do_liquid_only_in_clubb, & ! h1g, 2010-06-16 -#endif - rcm, wprcp, cloud_frac, ice_supersat_frac, & - rcm_in_layer, cloud_cover, & -#if defined(CLUBB_CAM) || defined(GFDL) || defined(CLUBB_SAM) - khzm, khzt, qclvar, & -#endif - pdf_params ) - - ! Description: - ! Subroutine to advance the model one timestep - - ! References: - ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: - ! Method and Model Description'' Golaz, et al. (2002) - ! JAS, Vol. 59, pp. 3540--3551. - !----------------------------------------------------------------------- - - ! Modules to be included - - use crmx_constants_clubb, only: & - w_tol, & ! Variable(s) - em_min, & - thl_tol, & - rt_tol, & - w_tol_sqd, & - ep2, & - Cp, & - Lv, & - ep1, & - eps, & - p0, & - kappa, & - fstderr, & - zero_threshold, & - three_halves - - use crmx_parameters_tunable, only: & - gamma_coefc, & ! Variable(s) - gamma_coefb, & - gamma_coef, & - taumax, & - c_K, & - mu, & - Lscale_mu_coef, & - Lscale_pert_coef - - use crmx_parameters_model, only: & - sclr_dim, & ! Variable(s) - edsclr_dim, & - sclr_tol, & - ts_nudge, & - rtm_min, & - rtm_nudge_max_altitude - - use crmx_model_flags, only: & - l_tke_aniso, & ! Variable(s) - l_gamma_Skw, & - l_trapezoidal_rule_zt, & - l_trapezoidal_rule_zm, & - l_call_pdf_closure_twice, & - l_host_applies_sfc_fluxes, & - l_use_cloud_cover, & - l_rtm_nudge - - use crmx_grid_class, only: & - gr, & ! Variable(s) - zm2zt, & ! Procedure(s) - zt2zm, & - ddzm - - use crmx_numerical_check, only: & - parameterization_check, & ! Procedure(s) - calculate_spurious_source - - use crmx_variables_diagnostic_module, only: & - Skw_zt, & ! Variable(s) - Skw_zm, & - sigma_sqd_w_zt, & - wp4, & - thlpthvp, & - rtpthvp, & - rtprcp, & - thlprcp, & - rcp2, & - rsat, & - pdf_params_zm, & - wprtp2, & - wp2rtp, & - wpthlp2, & - wp2thlp, & - wprtpthlp, & - wpthvp, & - wp2thvp, & - wp2rcp - - use crmx_variables_diagnostic_module, only: & - thvm, & - em, & - Lscale, & - Lscale_up, & - Lscale_down, & - tau_zm, & - tau_zt, & - Kh_zm, & - Kh_zt, & - vg, & - ug, & - um_ref, & - vm_ref - - use crmx_variables_diagnostic_module, only: & - wp2_zt, & - thlp2_zt, & - wpthlp_zt, & - wprtp_zt, & - rtp2_zt, & - rtpthlp_zt, & - up2_zt, & - vp2_zt, & - upwp_zt, & - vpwp_zt, & - rtm_ref, & - thlm_ref - - use crmx_variables_diagnostic_module, only: & - wpedsclrp, & - sclrpthvp, & ! sclr'th_v' - sclrprcp, & ! sclr'rc' - wp2sclrp, & ! w'^2 sclr' - wpsclrp2, & ! w'sclr'^2 - wpsclrprtp, & ! w'sclr'rt' - wpsclrpthlp, & ! w'sclr'thl' - wp3_zm, & ! wp3 interpolated to momentum levels - Skw_velocity, & ! Skewness velocity [m/s] - a3_coef, & ! The a3 coefficient [-] - a3_coef_zt ! The a3 coefficient interp. to the zt grid [-] - - use crmx_variables_diagnostic_module, only: & - wp3_on_wp2, & ! Variable(s) - wp3_on_wp2_zt - - use crmx_pdf_parameter_module, only: & - pdf_parameter ! Type - -#ifdef GFDL - use advance_sclrm_Nd_module, only: & ! h1g, 2010-06-16 begin mod - advance_sclrm_Nd_diffusion_OG, & - advance_sclrm_Nd_upwind, & - advance_sclrm_Nd_semi_implicit ! h1g, 2010-06-16 end mod -#endif - - use crmx_advance_xm_wpxp_module, only: & - ! Variable(s) - advance_xm_wpxp ! Compute mean/flux terms - - use crmx_advance_xp2_xpyp_module, only: & - ! Variable(s) - advance_xp2_xpyp ! Computes variance terms - - use crmx_surface_varnce_module, only: & - surface_varnce ! Procedure - - use crmx_pdf_closure_module, only: & - ! Procedure - pdf_closure ! Prob. density function - - use crmx_mixing_length, only: & - compute_length ! Procedure - - use crmx_advance_windm_edsclrm_module, only: & - advance_windm_edsclrm ! Procedure(s) - - use crmx_saturation, only: & - ! Procedure - sat_mixrat_liq ! Saturation mixing ratio - - use crmx_advance_wp2_wp3_module, only: & - advance_wp2_wp3 ! Procedure - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_error_code, only : & - clubb_no_error ! Constant(s) - - use crmx_error_code, only : & - clubb_at_least_debug_level, & ! Procedure(s) - reportError, & - fatal_error - - use crmx_Skw_module, only: & - Skw_func ! Procedure - - use crmx_clip_explicit, only: & - clip_covars_denom ! Procedure(s) - - use crmx_T_in_K_module, only: & - ! Read values from namelist - thlm2T_in_K ! Procedure - - use crmx_stats_subs, only: & - stats_accumulate ! Procedure - - use crmx_stats_type, only: & - stat_update_var_pt, & ! Procedure(s) - stat_update_var, & - stat_begin_update, & - stat_begin_update_pt, & - stat_end_update, & - stat_end_update_pt - - use crmx_stats_variables, only: & - irtp2_bt, & ! Variable(s) - ithlp2_bt, & - irtpthlp_bt, & - iwp2_bt, & - iwp3_bt, & - ivp2_bt, & - iup2_bt, & - iwprtp_bt, & - iwpthlp_bt, & - irtm_bt, & - ithlm_bt, & - ivm_bt, & - ium_bt, & - ircp2, & - iwp4, & - irsat, & - irvm, & - irel_humidity, & - iwpthlp_zt - - use crmx_stats_variables, only: & - iwprtp_zt, & - iup2_zt, & - ivp2_zt, & - iupwp_zt, & - ivpwp_zt, & - ithlp2_sf, & - irtp2_sf, & - irtpthlp_sf, & - iup2_sf, & - ivp2_sf, & - iwp2_sf, & - l_stats_samp, & - l_stats, & - zt, & - zm, & - sfc, & - irtm_spur_src, & - ithlm_spur_src - - use crmx_stats_variables, only: & - irfrzm ! Variable(s) - - use crmx_stats_variables, only: & - iSkw_velocity, & ! Variable(s) - igamma_Skw_fnc, & - iLscale_pert_1, & - iLscale_pert_2 - - use crmx_fill_holes, only: & - vertical_integral ! Procedure(s) - - use crmx_sigma_sqd_w_module, only: & - compute_sigma_sqd_w ! Procedure(s) - - implicit none - - !!! External - intrinsic :: sqrt, min, max, exp, mod, real - - ! Constant Parameters - logical, parameter :: & - l_avg_Lscale = .true., & ! Lscale is calculated in subroutine compute_length; if l_avg_Lscale - ! is true, compute_length is called two additional times with - ! perturbed values of rtm and thlm. An average value of Lscale - ! from the three calls to compute_length is then calculated. - ! This reduces temporal noise in RICO, BOMEX, LBA, and other cases. - l_Lscale_plume_centered = .false. ! Alternate that uses the PDF to - ! compute the perturbed values - - logical, parameter :: & - l_use_ice_latent = .false. !Includes the effects of ice latent heating in turbulence terms -! l_use_ice_latent = .true. !Includes the effects of ice latent heating in turbulence terms +++mhwang test - - logical, parameter :: & - l_iter_xp2_xpyp = .true. ! Set to true when rtp2/thlp2/rtpthlp, et cetera are prognostic - - !!! Input Variables - logical, intent(in) :: & - l_implemented ! Is this part of a larger host model (T/F) ? - - real(kind=time_precision), intent(in) :: & - dt ! Current timestep duration [s] - - real( kind = core_rknd ), intent(in) :: & - fcor, & ! Coriolis forcing [s^-1] - sfc_elevation ! Elevation of ground level [m AMSL] - - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s] - rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] - um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s] - vm_forcing, & ! v wind forcing (thermodynamic levels) [m/s/s] - wprtp_forcing, & ! forcing (momentum levels) [m*K/s^2] - wpthlp_forcing, & ! forcing (momentum levels) [m*(kg/kg)/s^2] - rtp2_forcing, & ! forcing (momentum levels) [(kg/kg)^2/s] - thlp2_forcing, & ! forcing (momentum levels) [K^2/s] - rtpthlp_forcing, & ! forcing (momentum levels) [K*(kg/kg)/s] - wm_zm, & ! w mean wind component on momentum levels [m/s] - wm_zt, & ! w mean wind component on thermo. levels [m/s] - p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa] - rho_zm, & ! Air density on momentum levels [kg/m^3] - rho, & ! Air density on thermodynamic levels [kg/m^3] - exner, & ! Exner function (thermodynamic levels) [-] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] - invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] - thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K] - thv_ds_zt, & ! Dry, base-state theta_v on thermo. levs. [K] - rfrzm ! Total ice-phase water mixing ratio [kg/kg] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - radf ! Buoyancy production at the CL top due to LW radiative cooling [m^2/s^3] - - real( kind = core_rknd ), intent(in) :: & - wpthlp_sfc, & ! w' theta_l' at surface [(m K)/s] - wprtp_sfc, & ! w' r_t' at surface [(kg m)/( kg s)] - upwp_sfc, & ! u'w' at surface [m^2/s^2] - vpwp_sfc ! v'w' at surface [m^2/s^2] - - ! Passive scalar variables - real( kind = core_rknd ), intent(in), dimension(gr%nz,sclr_dim) :: & - sclrm_forcing ! Passive scalar forcing [{units vary}/s] - - real( kind = core_rknd ), intent(in), dimension(sclr_dim) :: & - wpsclrp_sfc ! Scalar flux at surface [{units vary} m/s] - - ! Eddy passive scalar variables - real( kind = core_rknd ), intent(in), dimension(gr%nz,edsclr_dim) :: & - edsclrm_forcing ! Eddy passive scalar forcing [{units vary}/s] - - real( kind = core_rknd ), intent(in), dimension(edsclr_dim) :: & - wpedsclrp_sfc ! Eddy-Scalar flux at surface [{units vary} m/s] - - !!! Input/Output Variables - ! These are prognostic or are planned to be in the future - real( kind = core_rknd ), intent(inout), dimension(gr%nz) :: & - um, & ! u mean wind component (thermodynamic levels) [m/s] - upwp, & ! u'w' (momentum levels) [m^2/s^2] - vm, & ! v mean wind component (thermodynamic levels) [m/s] - vpwp, & ! v'w' (momentum levels) [m^2/s^2] - up2, & ! u'^2 (momentum levels) [m^2/s^2] - vp2, & ! v'^2 (momentum levels) [m^2/s^2] - rtm, & ! total water mixing ratio, r_t (thermo. levels) [kg/kg] - wprtp, & ! w' r_t' (momentum levels) [(kg/kg) m/s] - thlm, & ! liq. water pot. temp., th_l (thermo. levels) [K] - wpthlp, & ! w' th_l' (momentum levels) [(m/s) K] - rtp2, & ! r_t'^2 (momentum levels) [(kg/kg)^2] - thlp2, & ! th_l'^2 (momentum levels) [K^2] - rtpthlp, & ! r_t' th_l' (momentum levels) [(kg/kg) K] - wp2, & ! w'^2 (momentum levels) [m^2/s^2] - wp3 ! w'^3 (thermodynamic levels) [m^3/s^3] - - ! Passive scalar variables - real( kind = core_rknd ), intent(inout), dimension(gr%nz,sclr_dim) :: & - sclrm, & ! Passive scalar mean (thermo. levels) [units vary] - wpsclrp, & ! w'sclr' (momentum levels) [{units vary} m/s] - sclrp2, & ! sclr'^2 (momentum levels) [{units vary}^2] - sclrprtp, & ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] - sclrpthlp ! sclr'thl' (momentum levels) [{units vary} K] - -#ifdef GFDL - real( kind = core_rknd ), intent(inout), dimension(gr%nz,sclr_dim) :: & ! h1g, 2010-06-16 - sclrm_trsport_only ! Passive scalar concentration due to pure transport [{units vary}/s] -#endif - - ! Eddy passive scalar variable - real( kind = core_rknd ), intent(inout), dimension(gr%nz,edsclr_dim) :: & - edsclrm ! Eddy passive scalar mean (thermo. levels) [units vary] - - ! Variables that need to be output for use in other parts of the CLUBB - ! code, such as microphysics (rcm, pdf_params), forcings (rcm), and/or - ! BUGSrad (cloud_cover). - real( kind = core_rknd ), intent(out), dimension(gr%nz) :: & - rcm, & ! cloud water mixing ratio, r_c (thermo. levels) [kg/kg] - rcm_in_layer, & ! rcm in cloud layer [kg/kg] - cloud_cover ! cloud cover [-] - - type(pdf_parameter), dimension(gr%nz), intent(out) :: & - pdf_params ! PDF parameters [units vary] - - ! Variables that need to be output for use in host models - real( kind = core_rknd ), intent(out), dimension(gr%nz) :: & - wprcp, & ! w'r_c' (momentum levels) [(kg/kg) m/s] - cloud_frac, & ! cloud fraction (thermodynamic levels) [-] - ice_supersat_frac ! ice cloud fraction (thermodynamic levels) [-] - - ! Eric Raut declared this variable solely for output to disk - real( kind = core_rknd ), dimension(gr%nz) :: & - rc_coef ! Coefficient of X' R_l' in Eq. (34) [-] - -#if defined(CLUBB_CAM) || defined(GFDL) || defined(CLUBB_SAM) - real( kind = core_rknd ), intent(out), dimension(gr%nz) :: & - khzt, & ! eddy diffusivity on thermo levels - khzm, & ! eddy diffusivity on momentum levels - qclvar ! cloud water variance -#endif - - !!! Output Variable - ! Diagnostic, for if some calculation goes amiss. - integer, intent(inout) :: err_code - -#ifdef GFDL - ! hlg, 2010-06-16 - real( kind = core_rknd ), intent(inOUT), dimension(gr%nz, min(1,sclr_dim) , 2) :: & - RH_crit ! critical relative humidity for droplet and ice nucleation -! ---> h1g, 2012-06-14 - logical, intent(in) :: do_liquid_only_in_clubb -! <--- h1g, 2012-06-14 -#endif - - !!! Local Variables - integer :: i, k, & - err_code_pdf_closure, err_code_surface - - real( kind = core_rknd ), dimension(gr%nz) :: & - sigma_sqd_w, & ! PDF width parameter (momentum levels) [-] - sqrt_em_zt, & ! sqrt( em ) on zt levels; where em is TKE [m/s] - gamma_Skw_fnc, & ! Gamma as a function of skewness [???] - Lscale_pert_1, Lscale_pert_2, & ! For avg. calculation of Lscale [m] - thlm_pert_1, thlm_pert_2, & ! For avg. calculation of Lscale [K] - rtm_pert_1, rtm_pert_2, & ! For avg. calculation of Lscale [kg/kg] - thlm_pert_pos_rt, thlm_pert_neg_rt, & ! For avg. calculation of Lscale [K] - rtm_pert_pos_rt, rtm_pert_neg_rt ! For avg. calculation of Lscale [kg/kg] - !Lscale_weight Uncomment this if you need to use this vairable at some point. - - ! For pdf_closure - real( kind = core_rknd ), dimension(gr%nz,sclr_dim) :: & - wpsclrp_zt, & ! w' sclr' on thermo. levels - sclrp2_zt, & ! sclr'^2 on thermo. levels - sclrprtp_zt, & ! sclr' r_t' on thermo. levels - sclrpthlp_zt ! sclr' th_l' on thermo. levels - - real( kind = core_rknd ), dimension(gr%nz) :: & - p_in_Pa_zm, & ! Pressure interpolated to momentum levels [Pa] - exner_zm, & ! Exner interpolated to momentum levels [-] - w1_zm, & ! Mean w (1st PDF component) [m/s] - w2_zm, & ! Mean w (2nd PDF component) [m/s] - varnce_w1_zm, & ! Variance of w (1st PDF component) [m^2/s^2] - varnce_w2_zm, & ! Variance of w (2nd PDF component) [m^2/s^2] - mixt_frac_zm ! Weight of 1st PDF component (Sk_w dependent) [-] - - integer :: & - wprtp_cl_num, & ! Instance of w'r_t' clipping (1st or 3rd). - wpthlp_cl_num, & ! Instance of w'th_l' clipping (1st or 3rd). - wpsclrp_cl_num, & ! Instance of w'sclr' clipping (1st or 3rd). - upwp_cl_num, & ! Instance of u'w' clipping (1st or 2nd). - vpwp_cl_num ! Instance of v'w' clipping (1st or 2nd). - - ! These local variables are declared because they originally belong on the momentum - ! grid levels, but pdf_closure outputs them on the thermodynamic grid levels. - real( kind = core_rknd ), dimension(gr%nz) :: & - wp4_zt, & ! w'^4 (on thermo. grid) [m^4/s^4] - wpthvp_zt, & ! Buoyancy flux (on thermo. grid) [(K m)/s] - rtpthvp_zt, & ! r_t' th_v' (on thermo. grid) [(kg K)/kg] - thlpthvp_zt, & ! th_l' th_v' (on thermo. grid) [K^2] - wprcp_zt, & ! w' r_c' (on thermo. grid) [(m kg)/(s kg)] - rtprcp_zt, & ! r_t' r_c' (on thermo. grid) [(kg^2)/(kg^2)] - thlprcp_zt, & ! th_l' r_c' (on thermo. grid) [(K kg)/kg] - rcp2_zt, & ! r_c'^2 (on thermo. grid) [(kg^2)/(kg^2)] - rc_coef_zt ! X'R_l' coef. (on thermo. grid) [-] - - real( kind = core_rknd ), dimension(gr%nz, sclr_dim) :: & - sclrpthvp_zt, & ! sclr'th_v' (on thermo. grid) - sclrprcp_zt ! sclr'rc' (on thermo. grid) - - real( kind = core_rknd ), dimension(gr%nz) :: & - wprtp2_zm, & ! w'rt'^2 on momentum grid [m kg^2/kg^2] - wp2rtp_zm, & ! w'^2 rt' on momentum grid [m^2 kg/kg] - wpthlp2_zm, & ! w'thl'^2 on momentum grid [m K^2/s] - wp2thlp_zm, & ! w'^2 thl' on momentum grid [m^2 K/s^2] - wprtpthlp_zm, & ! w'rt'thl' on momentum grid [m kg K/kg s] - cloud_frac_zm, & ! Cloud Fraction on momentum grid [-] - ice_supersat_frac_zm, & ! Ice Cloud Fraction on momentum grid [-] - rtm_zm, & ! Total water mixing ratio [kg/kg] - thlm_zm, & ! Liquid potential temperature [kg/kg] - rcm_zm, & ! Liquid water mixing ratio on momentum grid [kg/kg] - wp2thvp_zm, & ! w'^2 th_v' on momentum grid [m^2 K/s^2] - wp2rcp_zm, & ! w'^2 rc' on momentum grid [m^2 kg/kg s^2] - sign_rtpthlp ! sign of the covariance rtpthlp [-] - - real( kind = core_rknd ), dimension(gr%nz,sclr_dim) :: & - wpsclrprtp_zm, & ! w'sclr'rt' on momentum grid - wpsclrp2_zm, & ! w'sclr'^2 on momentum grid - wpsclrpthlp_zm, & ! w'sclr'thl' on momentum grid - wp2sclrp_zm, & ! w'^2 sclr' on momentum grid - sclrm_zm ! Passive scalar mean on momentum grid - - real( kind = core_rknd ) :: & - rtm_integral_before, & - rtm_integral_after, & - rtm_integral_forcing, & - rtm_flux_top, & - rtm_flux_sfc, & - rtm_spur_src, & - thlm_integral_before, & - thlm_integral_after, & - thlm_integral_forcing, & - thlm_flux_top, & - thlm_flux_sfc, & - thlm_spur_src, & - mu_pert_1, mu_pert_2, & ! For l_avg_Lscale - mu_pert_pos_rt, mu_pert_neg_rt ! For l_Lscale_plume_centered - - !The following variables are defined for use when l_use_ice_latent = .true. - type(pdf_parameter), dimension(gr%nz) :: & - pdf_params_frz, & - pdf_params_zm_frz - - - real( kind = core_rknd ), dimension(gr%nz) :: & - rtm_frz, & - thlm_frz, & - wp4_zt_frz, & - wprtp2_frz, & - wp2rtp_frz, & - wpthlp2_frz, & - wp2thlp_frz, & - wprtpthlp_frz, & - cloud_frac_frz, & - ice_supersat_frac_frz, & - rcm_frz, & - wpthvp_frz, & - wpthvp_zt_frz, & - wp2thvp_frz, & - wp2thvp_zm_frz, & - rtpthvp_frz, & - rtpthvp_zt_frz, & - thlpthvp_frz, & - thlpthvp_zt_frz, & - wprcp_zt_frz, & - wp2rcp_frz - - real( kind = core_rknd ), dimension(gr%nz) :: & - rtprcp_zt_frz, & - thlprcp_zt_frz, & - rcp2_zt_frz, & - rc_coef_zt_frz, & - wp4_frz, & - wprtp2_zm_frz, & - wp2rtp_zm_frz, & - wpthlp2_zm_frz, & - wp2thlp_zm_frz, & - wprtpthlp_zm_frz, & - cloud_frac_zm_frz, & - ice_supersat_frac_zm_frz, & - rcm_zm_frz, & - wprcp_frz, & - wp2rcp_zm_frz, & - rtprcp_frz, & - thlprcp_frz, & - rcp2_frz, & - rtm_zm_frz, & - thlm_zm_frz, & - rc_coef_frz - - real( kind = core_rknd ), dimension(gr%nz,sclr_dim) :: & - wpsclrprtp_frz, & - wpsclrp2_frz, & - sclrpthvp_zt_frz, & - wpsclrpthlp_frz, & - sclrprcp_zt_frz, & - wp2sclrp_frz, & - wpsclrprtp_zm_frz, & - wpsclrp2_zm_frz, & - sclrpthvp_frz, & - wpsclrpthlp_zm_frz, & - sclrprcp_frz, & - wp2sclrp_zm_frz - - - !----- Begin Code ----- - - if ( l_stats .and. l_stats_samp ) then - ! Spurious source will only be calculated if rtm_ma and thlm_ma are zero. - ! Therefore, wm must be zero or l_implemented must be true. - if ( l_implemented .or. ( all( wm_zt == 0._core_rknd ) .and. & - all( wm_zm == 0._core_rknd ) ) ) then - ! Get the vertical integral of rtm and thlm before this function begins - ! so that spurious source can be calculated - rtm_integral_before & - = vertical_integral( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & - rtm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) - - thlm_integral_before & - = vertical_integral( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & - thlm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) - end if - end if - - !---------------------------------------------------------------- - ! Test input variables - !---------------------------------------------------------------- - if ( clubb_at_least_debug_level( 2 ) ) then - call parameterization_check & - ( thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & ! intent(in) - wm_zm, wm_zt, p_in_Pa, rho_zm, rho, exner, & ! intent(in) - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! intent(in) - invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & ! intent(in) - wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & ! intent(in) - um, upwp, vm, vpwp, up2, vp2, & ! intent(in) - rtm, wprtp, thlm, wpthlp, & ! intent(in) - wp2, wp3, rtp2, thlp2, rtpthlp, & ! intent(in) - "beginning of ", & ! intent(in) - wpsclrp_sfc, wpedsclrp_sfc, & ! intent(in) - sclrm, wpsclrp, sclrp2, sclrprtp, sclrpthlp, & ! intent(in) - sclrm_forcing, edsclrm, edsclrm_forcing, & ! intent(in) - err_code ) ! Intent(inout) - end if - !----------------------------------------------------------------------- - - if ( l_stats_samp ) then - call stat_update_var( irfrzm, rfrzm, & ! In - zt ) ! Out - end if - - ! Set up budget stats variables. - if ( l_stats_samp ) then - - call stat_begin_update( iwp2_bt, wp2 / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - call stat_begin_update( ivp2_bt, vp2 / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - call stat_begin_update( iup2_bt, up2 / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - call stat_begin_update( iwprtp_bt, wprtp / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - call stat_begin_update( iwpthlp_bt, wpthlp / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - call stat_begin_update( irtp2_bt, rtp2 / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - call stat_begin_update( ithlp2_bt, thlp2 / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - call stat_begin_update( irtpthlp_bt, rtpthlp / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - - call stat_begin_update( irtm_bt, rtm / real( dt , kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - call stat_begin_update( ithlm_bt, thlm / real( dt , kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - call stat_begin_update( ium_bt, um / real( dt , kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - call stat_begin_update( ivm_bt, vm / real( dt , kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - call stat_begin_update( iwp3_bt, wp3 / real( dt , kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - - end if - - ! SET SURFACE VALUES OF FLUXES (BROUGHT IN) - ! We only do this for host models that do not apply the flux - ! elsewhere in the code (e.g. WRF). In other cases the _sfc variables will - ! only be used to compute the variance at the surface. -dschanen 8 Sept 2009 - if ( .not. l_host_applies_sfc_fluxes ) then - - wpthlp(1) = wpthlp_sfc - wprtp(1) = wprtp_sfc - upwp(1) = upwp_sfc - vpwp(1) = vpwp_sfc - - ! Set fluxes for passive scalars (if enabled) - if ( sclr_dim > 0 ) then - wpsclrp(1,1:sclr_dim) = wpsclrp_sfc(1:sclr_dim) - end if - - if ( edsclr_dim > 0 ) then - wpedsclrp(1,1:edsclr_dim) = wpedsclrp_sfc(1:edsclr_dim) - end if - - else - - wpthlp(1) = 0.0_core_rknd - wprtp(1) = 0.0_core_rknd - upwp(1) = 0.0_core_rknd - vpwp(1) = 0.0_core_rknd - - ! Set fluxes for passive scalars (if enabled) - if ( sclr_dim > 0 ) then - wpsclrp(1,1:sclr_dim) = 0.0_core_rknd - end if - - if ( edsclr_dim > 0 ) then - wpedsclrp(1,1:edsclr_dim) = 0.0_core_rknd - end if - - end if ! ~l_host_applies_sfc_fluxes - - !--------------------------------------------------------------------------- - ! Interpolate wp3 to momentum levels, and wp2 to thermodynamic levels - ! and then compute Skw for m & t grid - !--------------------------------------------------------------------------- - - wp2_zt = max( zm2zt( wp2 ), w_tol_sqd ) ! Positive definite quantity - wp3_zm = zt2zm( wp3 ) - - Skw_zt(1:gr%nz) = Skw_func( wp2_zt(1:gr%nz), wp3(1:gr%nz) ) - Skw_zm(1:gr%nz) = Skw_func( wp2(1:gr%nz), wp3_zm(1:gr%nz) ) - - ! The right hand side of this conjunction is only for reducing cpu time, - ! since the more complicated formula is mathematically equivalent - if ( l_gamma_Skw .and. ( gamma_coef /= gamma_coefb ) ) then - !---------------------------------------------------------------- - ! Compute gamma as a function of Skw - 14 April 06 dschanen - !---------------------------------------------------------------- - - gamma_Skw_fnc = gamma_coefb + (gamma_coef-gamma_coefb) & - *exp( -(1.0_core_rknd/2.0_core_rknd) * (Skw_zm/gamma_coefc)**2 ) - - else - - gamma_Skw_fnc = gamma_coef - - end if - - ! Compute sigma_sqd_w (dimensionless PDF width parameter) - sigma_sqd_w = compute_sigma_sqd_w( gamma_Skw_fnc, wp2, thlp2, rtp2, wpthlp, wprtp ) - - if ( l_stats_samp ) then - call stat_update_var( igamma_Skw_fnc, gamma_Skw_fnc, zm ) - endif - - ! Smooth in the vertical - sigma_sqd_w = zt2zm( zm2zt( sigma_sqd_w ) ) - - ! Interpolate the the zt grid - sigma_sqd_w_zt = max( zm2zt( sigma_sqd_w ), zero_threshold ) ! Pos. def. quantity - - ! Compute the a3 coefficient (formula 25 in `Equations for CLUBB') -! a3_coef = 3.0_core_rknd * sigma_sqd_w*sigma_sqd_w & -! + 6.0_core_rknd*(1.0_core_rknd-sigma_sqd_w)*sigma_sqd_w & -! + (1.0_core_rknd-sigma_sqd_w)*(1.0_core_rknd-sigma_sqd_w) & -! - 3.0_core_rknd - - ! This is a simplified version of the formula above. - a3_coef = -2._core_rknd * ( 1._core_rknd - sigma_sqd_w )**2 - - ! We found we obtain fewer spikes in wp3 when we clip a3 to be no greater - ! than -1.4 -dschanen 4 Jan 2011 - a3_coef = max( a3_coef, -1.4_core_rknd ) ! Known magic number - - a3_coef_zt = zm2zt( a3_coef ) - - !--------------------------------------------------------------------------- - ! Interpolate thlp2, rtp2, and rtpthlp to thermodynamic levels, - !--------------------------------------------------------------------------- - - ! Iterpolate variances to the zt grid (statistics and closure) - thlp2_zt = max( zm2zt( thlp2 ), thl_tol**2 ) ! Positive def. quantity - rtp2_zt = max( zm2zt( rtp2 ), rt_tol**2 ) ! Positive def. quantity - rtpthlp_zt = zm2zt( rtpthlp ) - - ! Compute skewness velocity for stats output purposes - if ( iSkw_velocity > 0 ) then - Skw_velocity = ( 1.0_core_rknd / ( 1.0_core_rknd - sigma_sqd_w(1:gr%nz) ) ) & - * ( wp3_zm(1:gr%nz) / max( wp2(1:gr%nz), w_tol_sqd ) ) - end if - - ! Compute wp3 / wp2 on zt levels. Always use the interpolated value in the - ! denominator since it's less likely to create spikes - wp3_on_wp2_zt = ( wp3(1:gr%nz) / max( wp2_zt(1:gr%nz), w_tol_sqd ) ) - - ! Clip wp3_on_wp2_zt if it's too large - do k=1, gr%nz - if( wp3_on_wp2_zt(k) < 0._core_rknd ) then - wp3_on_wp2_zt = max( -1000._core_rknd, wp3_on_wp2_zt ) - else - wp3_on_wp2_zt = min( 1000._core_rknd, wp3_on_wp2_zt ) - end if - end do - - ! Compute wp3_on_wp2 by interpolating wp3_on_wp2_zt - wp3_on_wp2 = zt2zm( wp3_on_wp2_zt ) - - ! Smooth again as above - wp3_on_wp2_zt = zm2zt( wp3_on_wp2 ) - - !---------------------------------------------------------------- - ! Call closure scheme - !---------------------------------------------------------------- - - ! Put passive scalar input on the t grid for the PDF - do i = 1, sclr_dim, 1 - wpsclrp_zt(:,i) = zm2zt( wpsclrp(:,i) ) - sclrp2_zt(:,i) = max( zm2zt( sclrp2(:,i) ), zero_threshold ) ! Pos. def. quantity - sclrprtp_zt(:,i) = zm2zt( sclrprtp(:,i) ) - sclrpthlp_zt(:,i) = zm2zt( sclrpthlp(:,i) ) - end do ! i = 1, sclr_dim, 1 - - - do k = 1, gr%nz, 1 - - call pdf_closure & - ( p_in_Pa(k), exner(k), thv_ds_zt(k), wm_zt(k), & ! intent(in) - wp2_zt(k), wp3(k), sigma_sqd_w_zt(k), & ! intent(in) - Skw_zt(k), rtm(k), rtp2_zt(k), & ! intent(in) - zm2zt( wprtp, k ), thlm(k), thlp2_zt(k), & ! intent(in) - zm2zt( wpthlp, k ), rtpthlp_zt(k), sclrm(k,:), & ! intent(in) - wpsclrp_zt(k,:), sclrp2_zt(k,:), sclrprtp_zt(k,:), & ! intent(in) - sclrpthlp_zt(k,:), k, & ! intent(in) -#ifdef GFDL - RH_crit(k, : , :), do_liquid_only_in_clubb, & ! intent(in) h1g, 2010-06-16 -#endif - wp4_zt(k), wprtp2(k), wp2rtp(k), & ! intent(out) - wpthlp2(k), wp2thlp(k), wprtpthlp(k), & ! intent(out) - cloud_frac(k), ice_supersat_frac(k), & ! intent(out) - rcm(k), wpthvp_zt(k), wp2thvp(k), rtpthvp_zt(k), & ! intent(out) - thlpthvp_zt(k), wprcp_zt(k), wp2rcp(k), rtprcp_zt(k),& ! intent(out) - thlprcp_zt(k), rcp2_zt(k), pdf_params(k), & ! intent(out) - err_code_pdf_closure, & ! intent(out) - wpsclrprtp(k,:), wpsclrp2(k,:), sclrpthvp_zt(k,:), & ! intent(out) - wpsclrpthlp(k,:), sclrprcp_zt(k,:), wp2sclrp(k,:), & ! intent(out) - rc_coef_zt(k) ) ! intent(out) - - ! Subroutine may produce NaN values, and if so, exit - ! gracefully. - ! Joshua Fasching March 2008 - - if ( fatal_error( err_code_pdf_closure ) ) then - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) "At grid level = ",k - end if - - err_code = err_code_pdf_closure - end if - - end do ! k = 1, gr%nz, 1 - - if( l_rtm_nudge ) then - ! Nudge rtm to prevent excessive drying - where( rtm < rtm_min .and. gr%zt < rtm_nudge_max_altitude ) - rtm = rtm + (rtm_ref - rtm) * ( real( dt, kind = core_rknd ) / ts_nudge ) - end where - end if - - - if ( l_call_pdf_closure_twice ) then - ! Call pdf_closure a second time on momentum levels, to - ! output (rather than interpolate) the variables which - ! belong on the momentum levels. - - ! Interpolate sclrm to the momentum level for use in - ! the second call to pdf_closure - do i = 1, sclr_dim - sclrm_zm(:,i) = zt2zm( sclrm(:,i) ) - ! Clip if extrap. causes sclrm_zm to be less than sclr_tol - sclrm_zm(gr%nz,i) = max( sclrm_zm(gr%nz,i), sclr_tol(i) ) - end do ! i = 1, sclr_dim - - ! Interpolate pressure, p_in_Pa, to momentum levels. - ! The pressure at thermodynamic level k = 1 has been set to be the surface - ! (or model lower boundary) pressure. Since the surface (or model lower - ! boundary) is located at momentum level k = 1, the pressure there is - ! p_sfc, which is p_in_Pa(1). Thus, p_in_Pa_zm(1) = p_in_Pa(1). - p_in_Pa_zm(:) = zt2zm( p_in_Pa ) - p_in_Pa_zm(1) = p_in_Pa(1) - - ! Clip pressure if the extrapolation leads to a negative value of pressure - p_in_Pa_zm(gr%nz) = max( p_in_Pa_zm(gr%nz), 0.5_core_rknd*p_in_Pa(gr%nz) ) - ! Set exner at momentum levels, exner_zm, based on p_in_Pa_zm. - exner_zm(:) = (p_in_Pa_zm(:)/p0)**kappa - - rtm_zm = zt2zm( rtm ) - ! Clip if extrapolation at the top level causes rtm_zm to be < rt_tol - rtm_zm(gr%nz) = max( rtm_zm(gr%nz), rt_tol ) - thlm_zm = zt2zm( thlm ) - ! Clip if extrapolation at the top level causes thlm_zm to be < thl_tol - thlm_zm(gr%nz) = max( thlm_zm(gr%nz), thl_tol ) - - ! Call pdf_closure to output the variables which belong on the momentum grid. - do k = 1, gr%nz, 1 - - call pdf_closure & - ( p_in_Pa_zm(k), exner_zm(k), thv_ds_zm(k), wm_zm(k), & ! intent(in) - wp2(k), wp3_zm(k), sigma_sqd_w(k), & ! intent(in) - Skw_zm(k), rtm_zm(k), rtp2(k), & ! intent(in) - wprtp(k), thlm_zm(k), thlp2(k), & ! intent(in) - wpthlp(k), rtpthlp(k), sclrm_zm(k,:), & ! intent(in) - wpsclrp(k,:), sclrp2(k,:), sclrprtp(k,:), & ! intent(in) - sclrpthlp(k,:), k, & ! intent(in) -#ifdef GFDL - RH_crit(k, : , :), do_liquid_only_in_clubb, & ! intent(in) h1g, 2010-06-16 -#endif - wp4(k), wprtp2_zm(k), wp2rtp_zm(k), & ! intent(out) - wpthlp2_zm(k), wp2thlp_zm(k), wprtpthlp_zm(k), & ! intent(out) - cloud_frac_zm(k), ice_supersat_frac_zm(k), & ! intent(out) - rcm_zm(k), wpthvp(k), wp2thvp_zm(k), rtpthvp(k), & ! intent(out) - thlpthvp(k), wprcp(k), wp2rcp_zm(k), rtprcp(k), & ! intent(out) - thlprcp(k), rcp2(k), pdf_params_zm(k), & ! intent(out) - err_code_pdf_closure, & ! intent(out) - wpsclrprtp_zm(k,:), wpsclrp2_zm(k,:), sclrpthvp(k,:), & ! intent(out) - wpsclrpthlp_zm(k,:), sclrprcp(k,:), wp2sclrp_zm(k,:), & ! intent(out) - rc_coef(k) ) ! intent(out) - - ! Subroutine may produce NaN values, and if so, exit - ! gracefully. - ! Joshua Fasching March 2008 - - - if ( fatal_error( err_code_pdf_closure ) ) then - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) "At grid level = ",k - end if - - err_code = err_code_pdf_closure - end if - - end do ! k = 1, gr%nz, 1 - - else ! l_call_pdf_closure_twice is false - - ! Interpolate momentum variables output from the first call to - ! pdf_closure back to momentum grid. - ! Since top momentum level is higher than top thermo level, - ! Set variables at top momentum level to 0. - - ! Only do this for wp4 and rcp2 if we're saving stats, since they are not - ! used elsewhere in the parameterization - if ( iwp4 > 0 ) then - wp4 = max( zt2zm( wp4_zt ), zero_threshold ) ! Pos. def. quantity - wp4(gr%nz) = 0.0_core_rknd - end if - -#ifndef CLUBB_SAM - if ( ircp2 > 0 ) then -#endif - rcp2 = max( zt2zm( rcp2_zt ), zero_threshold ) ! Pos. def. quantity -#ifndef CLUBB_SAM - rcp2(gr%nz) = 0.0_core_rknd - end if -#endif - - wpthvp = zt2zm( wpthvp_zt ) - wpthvp(gr%nz) = 0.0_core_rknd - thlpthvp = zt2zm( thlpthvp_zt ) - thlpthvp(gr%nz) = 0.0_core_rknd - rtpthvp = zt2zm( rtpthvp_zt ) - rtpthvp(gr%nz) = 0.0_core_rknd - wprcp = zt2zm( wprcp_zt ) - wprcp(gr%nz) = 0.0_core_rknd - rc_coef = zt2zm( rc_coef_zt ) - rc_coef(gr%nz) = 0.0_core_rknd - rtprcp = zt2zm( rtprcp_zt ) - rtprcp(gr%nz) = 0.0_core_rknd - thlprcp = zt2zm( thlprcp_zt ) - thlprcp(gr%nz) = 0.0_core_rknd - - ! Interpolate passive scalars back onto the m grid - do i = 1, sclr_dim - sclrpthvp(:,i) = zt2zm( sclrpthvp_zt(:,i) ) - sclrpthvp(gr%nz,i) = 0.0_core_rknd - sclrprcp(:,i) = zt2zm( sclrprcp_zt(:,i) ) - sclrprcp(gr%nz,i) = 0.0_core_rknd - end do ! i=1, sclr_dim - - end if ! l_call_pdf_closure_twice - - ! If l_trapezoidal_rule_zt is true, call trapezoidal_rule_zt for - ! thermodynamic-level variables output from pdf_closure. - ! ldgrant June 2009 - if ( l_trapezoidal_rule_zt ) then - call trapezoidal_rule_zt & - ( l_call_pdf_closure_twice, & ! intent(in) - wprtp2, wpthlp2, & ! intent(inout) - wprtpthlp, cloud_frac, ice_supersat_frac, & ! intent(inout) - rcm, wp2thvp, wpsclrprtp, wpsclrp2, & ! intent(inout) - wpsclrpthlp, pdf_params, & ! intent(inout) - wprtp2_zm, wpthlp2_zm, & ! intent(inout) - wprtpthlp_zm, cloud_frac_zm, & ! intent(inout) - ice_supersat_frac_zm, rcm_zm, wp2thvp_zm, & ! intent(inout) - wpsclrprtp_zm, wpsclrp2_zm, wpsclrpthlp_zm, & ! intent(inout) - pdf_params_zm ) ! intent(inout) - end if ! l_trapezoidal_rule_zt - - ! If l_trapezoidal_rule_zm is true, call trapezoidal_rule_zm for - ! the important momentum-level variabes output from pdf_closure. - ! ldgrant Feb. 2010 - if ( l_trapezoidal_rule_zm ) then - call trapezoidal_rule_zm & - ( wpthvp_zt, thlpthvp_zt, rtpthvp_zt, & ! intent(in) - wpthvp, thlpthvp, rtpthvp ) ! intent(inout) - end if ! l_trapezoidal_rule_zm - - ! Vince Larson clipped rcm in order to prevent rvm < 0. 5 Apr 2008. - ! This code won't work unless rtm >= 0 !!! - ! We do not clip rcm_in_layer because rcm_in_layer only influences - ! radiation, and we do not want to bother recomputing it. - ! Code is duplicated from below to ensure that relative humidity - ! is calculated properly. 3 Sep 2009 - call clip_rcm( rtm, 'rtm < rcm after pdf_closure', & ! intent (in) - rcm ) ! intent (inout) - - ! Compute variables cloud_cover and rcm_in_layer. - ! Added July 2009 - call compute_cloud_cover & - ( pdf_params, cloud_frac, rcm, & ! intent(in) - cloud_cover, rcm_in_layer ) ! intent(out) - - ! Use cloud_cover and rcm_in_layer to help boost cloud_frac and rcm to help - ! increase cloudiness at coarser grid resolutions. - if ( l_use_cloud_cover ) then - cloud_frac = cloud_cover - !ice_supersat_frac = cloud_cover !?-mark - rcm = rcm_in_layer - end if - - ! Clip cloud fraction here if it still exceeds 1.0 due to round off - cloud_frac = min( 1.0_core_rknd, cloud_frac ) - ! Ditto with ice cloud fraction - ice_supersat_frac = min( 1.0_core_rknd, ice_supersat_frac ) - - if (l_use_ice_latent) then - !A third call to pdf_closure, with terms modified to include the effects - !of latent heating due to ice. Thlm and rtm add the effects of ice, and - !the terms are all renamed with "_frz" appended. The modified terms will - !be fed into the calculations of the turbulence terms. storer-3/14/13 - - thlm_frz = thlm - (Lv / (Cp*exner) ) * rfrzm ! Add effects of ice latent heat - ! Ice is treated as liquid water here - rtm_frz = rtm + rfrzm - - - do k = 1, gr%nz, 1 - - call pdf_closure & - ( p_in_Pa(k), exner(k), thv_ds_zt(k), wm_zt(k), & ! intent(in) - wp2_zt(k), wp3(k), sigma_sqd_w_zt(k), & ! intent(in) - Skw_zt(k), rtm_frz(k), rtp2_zt(k), & ! intent(in) - zm2zt( wprtp, k ), thlm_frz(k), thlp2_zt(k), & ! intent(in) - zm2zt( wpthlp, k ), rtpthlp_zt(k), sclrm(k,:), & ! intent(in) - wpsclrp_zt(k,:), sclrp2_zt(k,:), sclrprtp_zt(k,:), & ! intent(in) - sclrpthlp_zt(k,:), k, & ! intent(in) -#ifdef GFDL - RH_crit(k, : , :), do_liquid_only_in_clubb, & ! intent(in) h1g, 2010-06-16 -#endif - wp4_zt_frz(k), wprtp2_frz(k), wp2rtp_frz(k), & ! intent(out) - wpthlp2_frz(k), wp2thlp_frz(k), wprtpthlp_frz(k), & ! intent(out) - cloud_frac_frz(k), ice_supersat_frac_frz(k), & ! intent(out) - rcm_frz(k), wpthvp_zt_frz(k), wp2thvp_frz(k), rtpthvp_zt_frz(k), & ! intent(out) - thlpthvp_zt_frz(k), wprcp_zt_frz(k), wp2rcp_frz(k), rtprcp_zt_frz(k), & ! intent(out) - thlprcp_zt_frz(k), rcp2_zt_frz(k), pdf_params_frz(k), & ! intent(out) - err_code_pdf_closure, & ! intent(out) - wpsclrprtp_frz(k,:), wpsclrp2_frz(k,:), sclrpthvp_zt_frz(k,:), & ! intent(out) - wpsclrpthlp_frz(k,:), sclrprcp_zt_frz(k,:), wp2sclrp_frz(k,:), & ! intent(out) - rc_coef_zt_frz(k) ) ! intent(out) - - ! Subroutine may produce NaN values, and if so, exit gracefully. - ! Joshua Fasching March 2008 - - if ( fatal_error( err_code_pdf_closure ) ) then - - if ( clubb_at_least_debug_level ( 1 ) )then - write(fstderr,*) "At grid level = ", k - end if - - err_code = err_code_pdf_closure - end if - - end do !k=1, gr%nz, 1 - - - if( l_rtm_nudge ) then - ! Nudge rtm to prevent excessive drying - where( rtm < rtm_min .and. gr%zt < rtm_nudge_max_altitude ) - rtm = rtm + (rtm_ref - rtm) * ( real( dt, kind = core_rknd ) / ts_nudge ) - end where - end if - - rtm_zm_frz = zt2zm( rtm_frz ) - ! Clip if extrapolation at the top level causes rtm_zm to be < rt_tol - rtm_zm_frz(gr%nz) = max( rtm_zm_frz(gr%nz), rt_tol ) - thlm_zm_frz = zt2zm( thlm_frz ) - ! Clip if extrapolation at the top level causes thlm_zm to be < thl_tol - thlm_zm_frz(gr%nz) = max( thlm_zm_frz(gr%nz), thl_tol ) - - if ( l_call_pdf_closure_twice ) then - ! Call pdf_closure again to output the variables which belong on the momentum grid. - do k=1, gr%nz, 1 - call pdf_closure & - ( p_in_Pa_zm(k), exner_zm(k), thv_ds_zm(k), wm_zm(k), & ! intent(in) - wp2(k), wp3_zm(k), sigma_sqd_w(k), & ! intent(in) - Skw_zm(k), rtm_zm_frz(k), rtp2(k), & ! intent(in) - wprtp(k), thlm_zm_frz(k), thlp2(k), & ! intent(in) - wpthlp(k), rtpthlp(k), sclrm_zm(k,:), & ! intent(in) - wpsclrp(k,:), sclrp2(k,:), sclrprtp(k,:), & ! intent(in) - sclrpthlp(k,:), k, & ! intent(in) -#ifdef GFDL - RH_crit(k, : , :), do_liquid_only_in_clubb, & ! intent(in) h1g, 2010-06-16 -#endif - wp4_frz(k), wprtp2_zm_frz(k), wp2rtp_zm_frz(k), & ! intent(out) - wpthlp2_zm_frz(k), wp2thlp_zm_frz(k), wprtpthlp_zm_frz(k), & ! intent(out) - cloud_frac_zm_frz(k), ice_supersat_frac_zm_frz(k), & ! intent(out) - rcm_zm_frz(k), wpthvp_frz(k), wp2thvp_zm_frz(k), rtpthvp_frz(k), & ! intent(out) - thlpthvp_frz(k), wprcp_frz(k), wp2rcp_zm_frz(k), rtprcp_frz(k), & ! intent(out) - thlprcp_frz(k), rcp2_frz(k), pdf_params_zm_frz(k), & ! intent(out) - err_code_pdf_closure, & ! intent(out) - wpsclrprtp_zm_frz(k,:), wpsclrp2_zm_frz(k,:), sclrpthvp_frz(k,:), & ! intent(out) - wpsclrpthlp_zm_frz(k,:), sclrprcp_frz(k,:), wp2sclrp_zm_frz(k,:), & ! intent(out) - rc_coef_frz(k) ) ! intent(out) - - ! Subroutine may produce NaN values, and if so, exit - ! gracefully. - ! Joshua Fasching March 2008 - - - if ( fatal_error( err_code_pdf_closure ) ) then - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) "At grid level = ",k - end if - - err_code = err_code_pdf_closure - end if - - end do ! k = 1, gr%nz, 1 - else ! l_call_pdf_closure_twice is false - - wpthvp_frz = zt2zm( wpthvp_zt_frz ) - wpthvp_frz(gr%nz) = 0.0_core_rknd - thlpthvp_frz = zt2zm( thlpthvp_zt_frz ) - thlpthvp_frz(gr%nz) = 0.0_core_rknd - rtpthvp_frz = zt2zm( rtpthvp_zt_frz ) - rtpthvp_frz(gr%nz) = 0.0_core_rknd - - end if ! l_call_pdf_closure_twice - - if ( l_trapezoidal_rule_zt ) then - call trapezoidal_rule_zt & - ( l_call_pdf_closure_twice, & ! intent(in) - wprtp2_frz, wpthlp2_frz, & ! intent(inout) - wprtpthlp_frz, cloud_frac_frz, ice_supersat_frac_frz, & ! intent(inout) - rcm_frz, wp2thvp_frz, wpsclrprtp_frz, wpsclrp2_frz, & ! intent(inout) - wpsclrpthlp_frz, pdf_params_frz, & ! intent(inout) - wprtp2_zm_frz, wpthlp2_zm_frz, & ! intent(inout) - wprtpthlp_zm_frz, cloud_frac_zm_frz, & ! intent(inout) - ice_supersat_frac_zm_frz, rcm_zm_frz, wp2thvp_zm_frz, & ! intent(inout) - wpsclrprtp_zm_frz, wpsclrp2_zm_frz, wpsclrpthlp_zm_frz, & ! intent(inout) - pdf_params_zm_frz ) ! intent(inout) - end if ! l_trapezoidal_rule_zt - - ! If l_trapezoidal_rule_zm is true, call trapezoidal_rule_zm for - ! the important momentum-level variabes output from pdf_closure. - ! ldgrant Feb. 2010 - if ( l_trapezoidal_rule_zm ) then - call trapezoidal_rule_zm & - ( wpthvp_zt_frz, thlpthvp_zt_frz, rtpthvp_zt_frz, & ! intent(in) - wpthvp_frz, thlpthvp_frz, rtpthvp_frz ) ! intent(inout) - end if ! l_trapezoidal_rule_zm - - end if ! l_use_ice_latent = .true. - - - - - - !---------------------------------------------------------------- - ! Compute thvm - !---------------------------------------------------------------- - - thvm = thlm + ep1 * thv_ds_zt * rtm & - + ( Lv/(Cp*exner) - ep2 * thv_ds_zt ) * rcm - - !---------------------------------------------------------------- - ! Compute tke (turbulent kinetic energy) - !---------------------------------------------------------------- - - if ( .not. l_tke_aniso ) then - ! tke is assumed to be 3/2 of wp2 - em = three_halves * wp2 ! Known magic number - else - em = 0.5_core_rknd * ( wp2 + vp2 + up2 ) - end if - - !---------------------------------------------------------------- - ! Compute mixing length - !---------------------------------------------------------------- - - if ( l_avg_Lscale .and. .not. l_Lscale_plume_centered ) then - ! Call compute length two additional times with perturbed values - ! of rtm and thlm so that an average value of Lscale may be calculated. - if ( l_use_ice_latent ) then - !Include the effects of ice in the length scale calculation - - thlm_pert_1 = thlm_frz + Lscale_pert_coef * sqrt( max( thlp2, thl_tol**2 ) ) - rtm_pert_1 = rtm_frz + Lscale_pert_coef * sqrt( max( rtp2, rt_tol**2 ) ) - mu_pert_1 = mu / Lscale_mu_coef - - thlm_pert_2 = thlm_frz - Lscale_pert_coef * sqrt( max( thlp2, thl_tol**2 ) ) - rtm_pert_2 = rtm_frz - Lscale_pert_coef * sqrt( max( rtp2, rt_tol**2 ) ) - mu_pert_2 = mu * Lscale_mu_coef - else - thlm_pert_1 = thlm + Lscale_pert_coef * sqrt( max( thlp2, thl_tol**2 ) ) - rtm_pert_1 = rtm + Lscale_pert_coef * sqrt( max( rtp2, rt_tol**2 ) ) - mu_pert_1 = mu / Lscale_mu_coef - - thlm_pert_2 = thlm - Lscale_pert_coef * sqrt( max( thlp2, thl_tol**2 ) ) - rtm_pert_2 = rtm - Lscale_pert_coef * sqrt( max( rtp2, rt_tol**2 ) ) - mu_pert_2 = mu * Lscale_mu_coef - end if - - call compute_length( thvm, thlm_pert_1, rtm_pert_1, em, & ! intent(in) - p_in_Pa, exner, thv_ds_zt, mu_pert_1, l_implemented, & ! intent(in) - err_code, & ! intent(inout) - Lscale_pert_1, Lscale_up, Lscale_down ) ! intent(out) - - call compute_length( thvm, thlm_pert_2, rtm_pert_2, em, & ! intent(in) - p_in_Pa, exner, thv_ds_zt, mu_pert_2, l_implemented, & ! intent(in) - err_code, & ! intent(inout) - Lscale_pert_2, Lscale_up, Lscale_down ) ! intent(out) - - else if ( l_avg_Lscale .and. l_Lscale_plume_centered ) then - ! Take the values of thl and rt based one 1st or 2nd plume - - do k = 1, gr%nz, 1 - sign_rtpthlp(k) = sign(1.0_core_rknd, rtpthlp(k)) - end do - - if ( l_use_ice_latent ) then - where ( pdf_params_frz%rt1 > pdf_params_frz%rt2 ) - rtm_pert_pos_rt = pdf_params_frz%rt1 & - + Lscale_pert_coef * sqrt( max( pdf_params_frz%varnce_rt1, rt_tol**2 ) ) - thlm_pert_pos_rt = pdf_params_frz%thl1 + ( sign_rtpthlp * Lscale_pert_coef & - * sqrt( max( pdf_params_frz%varnce_thl1, thl_tol**2 ) ) ) - thlm_pert_neg_rt = pdf_params_frz%thl2 - ( sign_rtpthlp * Lscale_pert_coef & - * sqrt( max( pdf_params_frz%varnce_thl2, thl_tol**2 ) ) ) - rtm_pert_neg_rt = pdf_params_frz%rt2 & - - Lscale_pert_coef * sqrt( max( pdf_params_frz%varnce_rt2, rt_tol**2 ) ) - !Lscale_weight = pdf_params%mixt_frac - else where - rtm_pert_pos_rt = pdf_params_frz%rt2 & - + Lscale_pert_coef * sqrt( max( pdf_params_frz%varnce_rt2, rt_tol**2 ) ) - thlm_pert_pos_rt = pdf_params_frz%thl2 + ( sign_rtpthlp * Lscale_pert_coef & - * sqrt( max( pdf_params_frz%varnce_thl2, thl_tol**2 ) ) ) - thlm_pert_neg_rt = pdf_params_frz%thl1 - ( sign_rtpthlp * Lscale_pert_coef & - * sqrt( max( pdf_params_frz%varnce_thl1, thl_tol**2 ) ) ) - rtm_pert_neg_rt = pdf_params_frz%rt1 & - - Lscale_pert_coef * sqrt( max( pdf_params_frz%varnce_rt1, rt_tol**2 ) ) - !Lscale_weight = 1.0_core_rknd - pdf_params%mixt_frac - end where - else - where ( pdf_params%rt1 > pdf_params%rt2 ) - rtm_pert_pos_rt = pdf_params%rt1 & - + Lscale_pert_coef * sqrt( max( pdf_params%varnce_rt1, rt_tol**2 ) ) - thlm_pert_pos_rt = pdf_params%thl1 + ( sign_rtpthlp * Lscale_pert_coef & - * sqrt( max( pdf_params%varnce_thl1, thl_tol**2 ) ) ) - thlm_pert_neg_rt = pdf_params%thl2 - ( sign_rtpthlp * Lscale_pert_coef & - * sqrt( max( pdf_params%varnce_thl2, thl_tol**2 ) ) ) - rtm_pert_neg_rt = pdf_params%rt2 & - - Lscale_pert_coef * sqrt( max( pdf_params%varnce_rt2, rt_tol**2 ) ) - !Lscale_weight = pdf_params%mixt_frac - else where - rtm_pert_pos_rt = pdf_params%rt2 & - + Lscale_pert_coef * sqrt( max( pdf_params%varnce_rt2, rt_tol**2 ) ) - thlm_pert_pos_rt = pdf_params%thl2 + ( sign_rtpthlp * Lscale_pert_coef & - * sqrt( max( pdf_params%varnce_thl2, thl_tol**2 ) ) ) - thlm_pert_neg_rt = pdf_params%thl1 - ( sign_rtpthlp * Lscale_pert_coef & - * sqrt( max( pdf_params%varnce_thl1, thl_tol**2 ) ) ) - rtm_pert_neg_rt = pdf_params%rt1 & - - Lscale_pert_coef * sqrt( max( pdf_params%varnce_rt1, rt_tol**2 ) ) - !Lscale_weight = 1.0_core_rknd - pdf_params%mixt_frac - end where - end if - mu_pert_pos_rt = mu / Lscale_mu_coef - mu_pert_neg_rt = mu * Lscale_mu_coef - - ! Call length with perturbed values of thl and rt - call compute_length( thvm, thlm_pert_pos_rt, rtm_pert_pos_rt, em, & ! intent(in) - p_in_Pa, exner, thv_ds_zt, mu_pert_pos_rt, l_implemented, & ! intent(in) - err_code, & ! intent(inout) - Lscale_pert_1, Lscale_up, Lscale_down ) ! intent(out) - - call compute_length( thvm, thlm_pert_neg_rt, rtm_pert_neg_rt, em, & ! intent(in) - p_in_Pa, exner, thv_ds_zt, mu_pert_neg_rt, l_implemented, & ! intent(in) - err_code, & ! intent(inout) - Lscale_pert_2, Lscale_up, Lscale_down ) ! intent(out) - else - Lscale_pert_1 = -999._core_rknd - Lscale_pert_2 = -999._core_rknd - - end if ! l_avg_Lscale - - if ( l_stats_samp ) then - call stat_update_var( iLscale_pert_1, Lscale_pert_1, zt ) - call stat_update_var( iLscale_pert_2, Lscale_pert_2, zt ) - end if ! l_stats_samp - - ! ********** NOTE: ********** - ! This call to compute_length must be last. Otherwise, the values of - ! Lscale_up and Lscale_down in stats will be based on perturbation length scales - ! rather than the mean length scale. - call compute_length( thvm, thlm, rtm, em, & ! intent(in) - p_in_Pa, exner, thv_ds_zt, mu, l_implemented, & ! intent(in) - err_code, & ! intent(inout) - Lscale, Lscale_up, Lscale_down ) ! intent(out) - - if ( l_avg_Lscale ) then - if ( l_Lscale_plume_centered ) then - ! Weighted average of mean, pert_1, & pert_2 -! Lscale = 0.5_core_rknd * ( Lscale + Lscale_weight*Lscale_pert_1 & -! + (1.0_core_rknd-Lscale_weight)*Lscale_pert_2 ) - - ! Weighted average of just the perturbed values -! Lscale = Lscale_weight*Lscale_pert_1 + (1.0_core_rknd-Lscale_weight)*Lscale_pert_2 - - ! Un-weighted average of just the perturbed values - Lscale = 0.5_core_rknd*( Lscale_pert_1 + Lscale_pert_2 ) - else - Lscale = (1.0_core_rknd/3.0_core_rknd) * ( Lscale + Lscale_pert_1 + Lscale_pert_2 ) - end if - end if - - !---------------------------------------------------------------- - ! Dissipation time - !---------------------------------------------------------------- -! Vince Larson replaced the cutoff of em_min by w_tol**2. 7 Jul 2007 -! This is to prevent tau from being too large (producing little damping) -! in stably stratified layers with little turbulence. -! sqrt_em_zt = SQRT( MAX( em_min, zm2zt( em ) ) ) -! tau_zt = MIN( Lscale / sqrt_em_zt, taumax ) -! tau_zm & -! = MIN( ( zt2zm( Lscale ) / SQRT( MAX( em_min, em ) ) ), taumax ) -! Addition by Brian: Model constant em_min is now set to (3/2)*w_tol_sqd. -! Thus, em_min can replace w_tol_sqd here. - sqrt_em_zt = SQRT( MAX( em_min, zm2zt( em ) ) ) - - tau_zt = MIN( Lscale / sqrt_em_zt, taumax ) - tau_zm = MIN( ( MAX( zt2zm( Lscale ), zero_threshold ) & - / SQRT( MAX( em_min, em ) ) ), taumax ) -! End Vince Larson's replacement. - - ! Modification to damp noise in stable region -! Vince Larson commented out because it may prevent turbulence from -! initiating in unstable regions. 7 Jul 2007 -! do k = 1, gr%nz -! if ( wp2(k) <= 0.005_core_rknd ) then -! tau_zt(k) = taumin -! tau_zm(k) = taumin -! end if -! end do -! End Vince Larson's commenting. - - !---------------------------------------------------------------- - ! Eddy diffusivity coefficient - !---------------------------------------------------------------- - ! c_K is 0.548 usually (Duynkerke and Driedonks 1987) - ! CLUBB uses a smaller value to better fit empirical data. - - Kh_zt = c_K * Lscale * sqrt_em_zt - Kh_zm = c_K * max( zt2zm( Lscale ), zero_threshold ) & - * sqrt( max( em, em_min ) ) - -#if defined(CLUBB_CAM) || defined(GFDL) || defined (CLUBB_SAM) - khzt(:) = Kh_zt(:) - khzm(:) = Kh_zm(:) - qclvar(:) = rcp2_zt(:) -#endif - - !---------------------------------------------------------------- - ! Set Surface variances - !---------------------------------------------------------------- - - ! Surface variances should be set here, before the call to either - ! advance_xp2_xpyp or advance_wp2_wp3. - ! Surface effects should not be included with any case where the lowest - ! level is not the ground level. Brian Griffin. December 22, 2005. - if ( gr%zm(1) == sfc_elevation ) then - - ! Reflect surface varnce changes in budget - if ( l_stats_samp ) then - call stat_begin_update_pt( ithlp2_sf, 1, & ! intent(in) - thlp2(1) / real( dt , kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - call stat_begin_update_pt( irtp2_sf, 1, & ! intent(in) - rtp2(1) / real( dt , kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - call stat_begin_update_pt( irtpthlp_sf, 1, & ! intent(in) - rtpthlp(1) / real( dt , kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - call stat_begin_update_pt( iup2_sf, 1, & ! intent(in) - up2(1) / real( dt , kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - call stat_begin_update_pt( ivp2_sf, 1, & ! intent(in) - vp2(1) / real( dt , kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - call stat_begin_update_pt( iwp2_sf, 1, & ! intent(in) - wp2(1) / real( dt , kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - end if - - call surface_varnce( upwp_sfc, vpwp_sfc, wpthlp_sfc, wprtp_sfc, & ! intent(in) - um(2), vm(2), wpsclrp_sfc, & ! intent(in) - wp2(1), up2(1), vp2(1), & ! intent(out) - thlp2(1), rtp2(1), rtpthlp(1), err_code_surface,& ! intent(out) - sclrp2(1,1:sclr_dim), & ! intent(out) - sclrprtp(1,1:sclr_dim), & ! intent(out) - sclrpthlp(1,1:sclr_dim) ) ! intent(out) - - if ( fatal_error( err_code_surface ) ) then - call reportError( err_code_surface ) - err_code = err_code_surface - end if - - ! Update surface stats - if ( l_stats_samp ) then - call stat_end_update_pt( ithlp2_sf, 1, & ! intent(in) - thlp2(1) / real( dt , kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - call stat_end_update_pt( irtp2_sf, 1, & ! intent(in) - rtp2(1) / real( dt , kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - call stat_end_update_pt( irtpthlp_sf, 1, & ! intent(in) - rtpthlp(1) / real( dt , kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - call stat_end_update_pt( iup2_sf, 1, & ! intent(in) - up2(1) / real( dt , kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - call stat_end_update_pt( ivp2_sf, 1, & ! intent(in) - vp2(1) / real( dt , kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - call stat_end_update_pt( iwp2_sf, 1, & ! intent(in) - wp2(1) / real( dt , kind = core_rknd ), & ! intent(in) - zm ) ! intent(inout) - end if - - else - - ! Variances for cases where the lowest level is not at the surface. - ! Eliminate surface effects on lowest level variances. - wp2(1) = w_tol_sqd - up2(1) = w_tol_sqd - vp2(1) = w_tol_sqd - thlp2(1) = thl_tol**2 - rtp2(1) = rt_tol**2 - rtpthlp(1) = 0.0_core_rknd - - do i = 1, sclr_dim, 1 - sclrp2(1,i) = 0.0_core_rknd - sclrprtp(1,i) = 0.0_core_rknd - sclrpthlp(1,i) = 0.0_core_rknd - end do - - end if ! gr%zm(1) == sfc_elevation - - - !####################################################################### - !############## ADVANCE PROGNOSTIC VARIABLES ONE TIMESTEP ############## - !####################################################################### - - ! Store the saturation mixing ratio for output purposes. Brian - ! Compute rsat if either rsat or rel_humidity is to be saved. ldgrant - if ( ( irsat > 0 ) .or. ( irel_humidity > 0 ) ) then - rsat = sat_mixrat_liq( p_in_Pa, thlm2T_in_K( thlm, exner, rcm ) ) - end if - - - if ( l_stats_samp ) then - call stat_update_var( irvm, rtm - rcm, zt ) - - ! Output relative humidity (q/q∗ where q∗ is the saturation mixing ratio over liquid) - ! Added an extra check for irel_humidity > 0; otherwise, if both irsat = 0 and - ! irel_humidity = 0, rsat is not computed, leading to a floating-point exception - ! when stat_update_var is called for rel_humidity. ldgrant - if ( irel_humidity > 0 ) then - call stat_update_var( irel_humidity, (rtm - rcm) / rsat, zt) - end if ! irel_humidity > 0 - end if ! l_stats_samp - - !---------------------------------------------------------------- - ! Advance rtm/wprtp and thlm/wpthlp one time step - !---------------------------------------------------------------- - if ( l_call_pdf_closure_twice ) then - w1_zm = pdf_params_zm%w1 - w2_zm = pdf_params_zm%w2 - varnce_w1_zm = pdf_params_zm%varnce_w1 - varnce_w2_zm = pdf_params_zm%varnce_w2 - mixt_frac_zm = pdf_params_zm%mixt_frac - else - w1_zm = zt2zm( pdf_params%w1 ) - w2_zm = zt2zm( pdf_params%w2 ) - varnce_w1_zm = zt2zm( pdf_params%varnce_w1 ) - varnce_w2_zm = zt2zm( pdf_params%varnce_w2 ) - mixt_frac_zm = zt2zm( pdf_params%mixt_frac ) - end if - - if ( l_use_ice_latent ) then - !calculate turbulence with terms including ice latent heating - call advance_xm_wpxp( dt, sigma_sqd_w, wm_zm, wm_zt, wp2, & ! intent(in) - Lscale, wp3_on_wp2, wp3_on_wp2_zt, Kh_zt, & ! intent(in) - tau_zm, Skw_zm, rtpthvp_frz, rtm_forcing, & ! intent(in) - wprtp_forcing, rtm_ref, thlpthvp_frz, & ! intent(in) - thlm_forcing, wpthlp_forcing, thlm_ref, & ! intent(in) - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! intent(in) - invrs_rho_ds_zt, thv_ds_zm, rtp2, thlp2, & ! intent(in) - w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & ! intent(in) - mixt_frac_zm, l_implemented, & ! intent(in) - sclrpthvp, sclrm_forcing, sclrp2, & ! intent(in) - rtm, wprtp, thlm, wpthlp, & ! intent(inout) - err_code, & ! intent(inout) - sclrm, wpsclrp ) ! intent(inout) - else - call advance_xm_wpxp( dt, sigma_sqd_w, wm_zm, wm_zt, wp2, & ! intent(in) - Lscale, wp3_on_wp2, wp3_on_wp2_zt, Kh_zt, & ! intent(in) - tau_zm, Skw_zm, rtpthvp, rtm_forcing, & ! intent(in) - wprtp_forcing, rtm_ref, thlpthvp, & ! intent(in) - thlm_forcing, wpthlp_forcing, thlm_ref, & ! intent(in) - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! intent(in) - invrs_rho_ds_zt, thv_ds_zm, rtp2, thlp2, & ! intent(in) - w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & ! intent(in) - mixt_frac_zm, l_implemented, & ! intent(in) - sclrpthvp, sclrm_forcing, sclrp2, & ! intent(in) - rtm, wprtp, thlm, wpthlp, & ! intent(inout) - err_code, & ! intent(inout) - sclrm, wpsclrp ) ! intent(inout) - end if - - ! Vince Larson clipped rcm in order to prevent rvm < 0. 5 Apr 2008. - ! This code won't work unless rtm >= 0 !!! - ! We do not clip rcm_in_layer because rcm_in_layer only influences - ! radiation, and we do not want to bother recomputing it. 6 Aug 2009 - call clip_rcm( rtm, 'rtm < rcm in advance_xm_wpxp', & ! intent(in) - rcm ) ! intent(inout) - -#ifdef GFDL - call advance_sclrm_Nd_diffusion_OG( dt, sclrm, & ! h1g, 2010-06-16 - sclrm_trsport_only, Kh_zm, cloud_frac, err_code ) -#endif - - !---------------------------------------------------------------- - ! Compute some of the variances and covariances. These include the variance of - ! total water (rtp2), liquid potential termperature (thlp2), their - ! covariance (rtpthlp), and the variance of horizontal wind (up2 and vp2). - ! The variance of vertical velocity is computed later. - !---------------------------------------------------------------- - - ! We found that certain cases require a time tendency to run - ! at shorter timesteps so these are prognosed now. - - ! We found that if we call advance_xp2_xpyp first, we can use a longer timestep. - if ( l_use_ice_latent) then - ! calculate turbulence with terms including ice latent heating - call advance_xp2_xpyp( tau_zm, wm_zm, rtm, wprtp, thlm, & ! intent(in) - wpthlp, wpthvp_frz, um, vm, wp2, wp2_zt, & ! intent(in) - wp3, upwp, vpwp, sigma_sqd_w, Skw_zm, & ! intent(in) - Kh_zt, rtp2_forcing, thlp2_forcing, & ! intent(in) - rtpthlp_forcing, rho_ds_zm, rho_ds_zt, & ! intent(in) - invrs_rho_ds_zm, thv_ds_zm, & ! intent(in) - Lscale, wp3_on_wp2, wp3_on_wp2_zt, & ! intent(in) - l_iter_xp2_xpyp, dt, & ! intent(in) - sclrm, wpsclrp, & ! intent(in) - rtp2, thlp2, rtpthlp, up2, vp2, & ! intent(inout) - err_code, & ! intent(inout) - sclrp2, sclrprtp, sclrpthlp ) ! intent(inout) - else - call advance_xp2_xpyp( tau_zm, wm_zm, rtm, wprtp, thlm, & ! intent(in) - wpthlp, wpthvp, um, vm, wp2, wp2_zt, & ! intent(in) - wp3, upwp, vpwp, sigma_sqd_w, Skw_zm, & ! intent(in) - Kh_zt, rtp2_forcing, thlp2_forcing, & ! intent(in) - rtpthlp_forcing, rho_ds_zm, rho_ds_zt, & ! intent(in) - invrs_rho_ds_zm, thv_ds_zm, & ! intent(in) - Lscale, wp3_on_wp2, wp3_on_wp2_zt, & ! intent(in) - l_iter_xp2_xpyp, dt, & ! intent(in) - sclrm, wpsclrp, & ! intent(in) - rtp2, thlp2, rtpthlp, up2, vp2, & ! intent(inout) - err_code, & ! intent(inout) - sclrp2, sclrprtp, sclrpthlp ) ! intent(inout) - end if - - !---------------------------------------------------------------- - ! Covariance clipping for wprtp, wpthlp, wpsclrp, upwp, and vpwp - ! after subroutine advance_xp2_xpyp updated xp2. - !---------------------------------------------------------------- - - wprtp_cl_num = 2 ! Second instance of w'r_t' clipping. - wpthlp_cl_num = 2 ! Second instance of w'th_l' clipping. - wpsclrp_cl_num = 2 ! Second instance of w'sclr' clipping. - upwp_cl_num = 1 ! First instance of u'w' clipping. - vpwp_cl_num = 1 ! First instance of v'w' clipping. - - call clip_covars_denom( dt, rtp2, thlp2, up2, vp2, wp2, & ! intent(in) - sclrp2, wprtp_cl_num, wpthlp_cl_num, & ! intent(in) - wpsclrp_cl_num, upwp_cl_num, vpwp_cl_num, & ! intent(in) - wprtp, wpthlp, upwp, vpwp, wpsclrp ) ! intent(inout) - - - !---------------------------------------------------------------- - ! Advance 2nd and 3rd order moment of vertical velocity (wp2 / wp3) - ! by one timestep - !---------------------------------------------------------------- - - if ( l_use_ice_latent) then - call advance_wp2_wp3 & - ( dt, sfc_elevation, sigma_sqd_w, wm_zm, wm_zt, & ! intent(in) - a3_coef, a3_coef_zt, wp3_on_wp2, & ! intent(in) - wpthvp_frz, wp2thvp_frz, um, vm, upwp, vpwp, & ! intent(in) - up2, vp2, Kh_zm, Kh_zt, tau_zm, tau_zt, & ! intent(in) - Skw_zm, Skw_zt, rho_ds_zm, rho_ds_zt, & ! intent(in) - invrs_rho_ds_zm, invrs_rho_ds_zt, radf, & ! intent(in) - thv_ds_zm, thv_ds_zt, pdf_params%mixt_frac, & ! intent(in) - wp2, wp3, wp3_zm, wp2_zt, err_code ) ! intent(inout) - else - call advance_wp2_wp3 & - ( dt, sfc_elevation, sigma_sqd_w, wm_zm, wm_zt, & ! intent(in) - a3_coef, a3_coef_zt, wp3_on_wp2, & ! intent(in) - wpthvp, wp2thvp, um, vm, upwp, vpwp, & ! intent(in) - up2, vp2, Kh_zm, Kh_zt, tau_zm, tau_zt, & ! intent(in) - Skw_zm, Skw_zt, rho_ds_zm, rho_ds_zt, & ! intent(in) - invrs_rho_ds_zm, invrs_rho_ds_zt, radf, & ! intent(in) - thv_ds_zm, thv_ds_zt, pdf_params%mixt_frac, & ! intent(in) - wp2, wp3, wp3_zm, wp2_zt, err_code ) ! intent(inout) - end if - - !---------------------------------------------------------------- - ! Covariance clipping for wprtp, wpthlp, wpsclrp, upwp, and vpwp - ! after subroutine advance_wp2_wp3 updated wp2. - !---------------------------------------------------------------- - - wprtp_cl_num = 3 ! Third instance of w'r_t' clipping. - wpthlp_cl_num = 3 ! Third instance of w'th_l' clipping. - wpsclrp_cl_num = 3 ! Third instance of w'sclr' clipping. - upwp_cl_num = 2 ! Second instance of u'w' clipping. - vpwp_cl_num = 2 ! Second instance of v'w' clipping. - - call clip_covars_denom( dt, rtp2, thlp2, up2, vp2, wp2, & ! intent(in) - sclrp2, wprtp_cl_num, wpthlp_cl_num, & ! intent(in) - wpsclrp_cl_num, upwp_cl_num, vpwp_cl_num, & ! intent(in) - wprtp, wpthlp, upwp, vpwp, wpsclrp ) ! intent(inout) - - !---------------------------------------------------------------- - ! Advance the horizontal mean of the wind in the x-y directions - ! (i.e. um, vm) and the mean of the eddy-diffusivity scalars - ! (i.e. edsclrm) by one time step - !---------------------------------------------------------------- - - call advance_windm_edsclrm( dt, wm_zt, Kh_zm, ug, vg, um_ref, vm_ref, & ! Intent(in) - wp2, up2, vp2, um_forcing, vm_forcing, & ! Intent(in) - edsclrm_forcing, & ! Intent(in) - rho_ds_zm, invrs_rho_ds_zt, & ! Intent(in) - fcor, l_implemented, & ! Intent(in) - um, vm, edsclrm, & ! Intent(inout) - upwp, vpwp, wpedsclrp, & ! Intent(inout) - err_code ) ! Intent(inout) - - !####################################################################### - !############# ACCUMULATE STATISTICS ############# - !####################################################################### - - if ( l_stats_samp ) then - - call stat_end_update( iwp2_bt, wp2 / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - call stat_end_update( ivp2_bt, vp2 / real( dt , kind = core_rknd ),& ! Intent(in) - zm ) ! Intent(inout) - call stat_end_update( iup2_bt, up2 / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - call stat_end_update( iwprtp_bt, wprtp / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - call stat_end_update( iwpthlp_bt, wpthlp / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - call stat_end_update( irtp2_bt, rtp2 / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - call stat_end_update( ithlp2_bt, thlp2 / real( dt , kind = core_rknd ), & ! Intent(in) - zm ) ! Intent(inout) - call stat_end_update( irtpthlp_bt, rtpthlp / real( dt , kind = core_rknd ), &! Intent(in) - zm ) ! Intent(inout) - - call stat_end_update( irtm_bt, rtm / real( dt , kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - call stat_end_update( ithlm_bt, thlm / real( dt , kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - call stat_end_update( ium_bt, um / real( dt , kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - call stat_end_update( ivm_bt, vm / real( dt , kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - call stat_end_update( iwp3_bt, wp3 / real( dt , kind = core_rknd ), & ! Intent(in) - zt ) ! Intent(inout) - - end if ! l_stats_samp - - - if ( iwpthlp_zt > 0 ) then - wpthlp_zt = zm2zt( wpthlp ) - end if - - if ( iwprtp_zt > 0 ) then - wprtp_zt = zm2zt( wprtp ) - end if - - if ( iup2_zt > 0 ) then - up2_zt = max( zm2zt( up2 ), w_tol_sqd ) - end if - - if (ivp2_zt > 0 ) then - vp2_zt = max( zm2zt( vp2 ), w_tol_sqd ) - end if - - if ( iupwp_zt > 0 ) then - upwp_zt = zm2zt( upwp ) - end if - - if ( ivpwp_zt > 0 ) then - vpwp_zt = zm2zt( vpwp ) - end if - - call stats_accumulate & - ( um, vm, upwp, vpwp, up2, vp2, & ! intent(in) - thlm, rtm, wprtp, wpthlp, & ! intent(in) - wp2, wp3, rtp2, thlp2, rtpthlp, & ! intent(in) - p_in_Pa, exner, rho, rho_zm, & ! intent(in) - rho_ds_zm, rho_ds_zt, thv_ds_zm, & ! intent(in) - thv_ds_zt, wm_zt, wm_zm, rcm, wprcp, rc_coef, & ! intent(in) - rcm_zm, rtm_zm, thlm_zm, cloud_frac, ice_supersat_frac,& ! intent(in) - cloud_frac_zm, ice_supersat_frac_zm, rcm_in_layer, & ! intent(in) - cloud_cover, sigma_sqd_w, pdf_params, & ! intent(in) - sclrm, sclrp2, sclrprtp, sclrpthlp, sclrm_forcing, & ! intent(in) - wpsclrp, edsclrm, edsclrm_forcing ) ! intent(in) - - - if ( clubb_at_least_debug_level( 2 ) ) then - call parameterization_check & - ( thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & ! intent(in) - wm_zm, wm_zt, p_in_Pa, rho_zm, rho, exner, & ! intent(in) - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & ! intent(in) - invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & ! intent(in) - wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & ! intent(in) - um, upwp, vm, vpwp, up2, vp2, & ! intent(in) - rtm, wprtp, thlm, wpthlp, & ! intent(in) - wp2, wp3, rtp2, thlp2, rtpthlp, & ! intent(in) - "end of ", & ! intent(in) - wpsclrp_sfc, wpedsclrp_sfc, & ! intent(in) - sclrm, wpsclrp, sclrp2, sclrprtp, sclrpthlp, & ! intent(in) - sclrm_forcing, edsclrm, edsclrm_forcing, & ! intent(in) - err_code ) ! intent(inout) - end if - - if ( l_stats .and. l_stats_samp ) then - ! Spurious source will only be calculated if rtm_ma and thlm_ma are zero. - ! Therefore, wm must be zero or l_implemented must be true. - if ( l_implemented .or. ( all( wm_zt == 0._core_rknd ) .and. & - all( wm_zm == 0._core_rknd ) ) ) then - ! Calculate the spurious source for rtm - rtm_flux_top = rho_ds_zm(gr%nz) * wprtp(gr%nz) - - if ( .not. l_host_applies_sfc_fluxes ) then - rtm_flux_sfc = rho_ds_zm(1) * wprtp_sfc - else - rtm_flux_sfc = 0.0_core_rknd - end if - - rtm_integral_after & - = vertical_integral( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & - rtm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) - - rtm_integral_forcing & - = vertical_integral( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & - rtm_forcing(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) - - rtm_spur_src & - = calculate_spurious_source( rtm_integral_after, & - rtm_integral_before, & - rtm_flux_top, rtm_flux_sfc, & - rtm_integral_forcing, & - real( dt , kind = core_rknd ) ) - - ! Calculate the spurious source for thlm - thlm_flux_top = rho_ds_zm(gr%nz) * wpthlp(gr%nz) - - if ( .not. l_host_applies_sfc_fluxes ) then - thlm_flux_sfc = rho_ds_zm(1) * wpthlp_sfc - else - thlm_flux_sfc = 0.0_core_rknd - end if - - thlm_integral_after & - = vertical_integral( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & - thlm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) - - thlm_integral_forcing & - = vertical_integral( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & - thlm_forcing(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) - - thlm_spur_src & - = calculate_spurious_source( thlm_integral_after, & - thlm_integral_before, & - thlm_flux_top, thlm_flux_sfc, & - thlm_integral_forcing, & - real( dt , kind = core_rknd ) ) - else ! If l_implemented is false, we don't want spurious source output - rtm_spur_src = -9999.0_core_rknd - thlm_spur_src = -9999.0_core_rknd - end if - - ! Write the var to stats - call stat_update_var_pt( irtm_spur_src, 1, & - rtm_spur_src, sfc ) - call stat_update_var_pt( ithlm_spur_src, 1, & - thlm_spur_src, sfc ) - end if - - return - end subroutine advance_clubb_core - - !----------------------------------------------------------------------- - subroutine setup_clubb_core & - ( nzmax, T0_in, ts_nudge_in, & ! In - hydromet_dim_in, sclr_dim_in, & ! In - sclr_tol_in, edsclr_dim_in, params, & ! In - l_host_applies_sfc_fluxes, & ! In - l_uv_nudge, saturation_formula, & ! In -#ifdef GFDL - I_sat_sphum, & ! intent(in) h1g, 2010-06-16 -#endif - l_implemented, grid_type, deltaz, zm_init, zm_top, & ! In - momentum_heights, thermodynamic_heights, & ! In - host_dx, host_dy, sfc_elevation, & ! In -#ifdef GFDL - cloud_frac_min , & ! intent(in) h1g, 2010-06-16 -#endif - err_code ) ! Out - ! - ! Description: - ! Subroutine to set up the model for execution. - ! - ! References: - ! None - !------------------------------------------------------------------------- - use crmx_grid_class, only: & - setup_grid, & ! Procedure - gr ! Variable(s) - - use crmx_parameter_indices, only: & - nparams ! Variable(s) - - use crmx_parameters_tunable, only: & - setup_parameters ! Procedure - - use crmx_parameters_model, only: & - setup_parameters_model ! Procedure - - use crmx_variables_diagnostic_module, only: & - setup_diagnostic_variables ! Procedure - - use crmx_variables_prognostic_module, only: & - setup_prognostic_variables ! Procedure - - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - use crmx_error_code, only: & - clubb_no_error ! Constant(s) - - use crmx_model_flags, only: & - setup_model_flags, & ! Subroutine - l_gmres ! Variable - -#ifdef MKL - use crmx_csr_matrix_class, only: & - initialize_csr_class, & ! Subroutine - intlc_5d_5d_ja_size ! Variable - - use crmx_gmres_wrap, only: & - gmres_init ! Subroutine - - use crmx_gmres_cache, only: & - gmres_cache_temp_init, & ! Subroutine - gmres_idx_wp2wp3 ! Variable -#endif /* MKL */ - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - - ! Grid definition - integer, intent(in) :: nzmax ! Vertical grid levels [#] - ! Only true when used in a host model - ! CLUBB determines what nzmax should be - ! given zm_init and zm_top when - ! running in standalone mode. - - real( kind = core_rknd ), intent(in) :: & - sfc_elevation ! Elevation of ground level [m AMSL] - - ! Flag to see if CLUBB is running on it's own, - ! or if it's implemented as part of a host model. - logical, intent(in) :: l_implemented ! (T/F) - - ! If CLUBB is running on it's own, this option determines - ! if it is using: - ! 1) an evenly-spaced grid, - ! 2) a stretched (unevenly-spaced) grid entered on the - ! thermodynamic grid levels (with momentum levels set - ! halfway between thermodynamic levels), or - ! 3) a stretched (unevenly-spaced) grid entered on the - ! momentum grid levels (with thermodynamic levels set - ! halfway between momentum levels). - integer, intent(in) :: grid_type - - ! If the CLUBB model is running by itself, and is using an - ! evenly-spaced grid (grid_type = 1), it needs the vertical - ! grid spacing, momentum-level starting altitude, and maximum - ! altitude as input. - real( kind = core_rknd ), intent(in) :: & - deltaz, & ! Change in altitude per level [m] - zm_init, & ! Initial grid altitude (momentum level) [m] - zm_top ! Maximum grid altitude (momentum level) [m] - - ! If the CLUBB parameterization is implemented in a host model, - ! it needs to use the host model's momentum level altitudes - ! and thermodynamic level altitudes. - ! If the CLUBB model is running by itself, but is using a - ! stretched grid entered on thermodynamic levels (grid_type = 2), - ! it needs to use the thermodynamic level altitudes as input. - ! If the CLUBB model is running by itself, but is using a - ! stretched grid entered on momentum levels (grid_type = 3), - ! it needs to use the momentum level altitudes as input. - real( kind = core_rknd ), intent(in), dimension(nzmax) :: & - momentum_heights, & ! Momentum level altitudes (input) [m] - thermodynamic_heights ! Thermodynamic level altitudes (input) [m] - - ! Host model horizontal grid spacing, if part of host model. - real( kind = core_rknd ), intent(in) :: & - host_dx, & ! East-West horizontal grid spacing [m] - host_dy ! North-South horizontal grid spacing [m] - - ! Model parameters - real( kind = core_rknd ), intent(in) :: & - T0_in, ts_nudge_in - - integer, intent(in) :: & - hydromet_dim_in, & ! Number of hydrometeor species - sclr_dim_in, & ! Number of passive scalars - edsclr_dim_in ! Number of eddy-diff. passive scalars - - real( kind = core_rknd ), intent(in), dimension(sclr_dim_in) :: & - sclr_tol_in ! Thresholds for passive scalars - - real( kind = core_rknd ), intent(in), dimension(nparams) :: & - params ! Including C1, nu1, nu2, etc. - - ! Flags - logical, intent(in) :: & - l_uv_nudge, & ! Wind nudging - l_host_applies_sfc_fluxes ! Whether to apply for the surface flux - - character(len=*), intent(in) :: & - saturation_formula ! Approximation for saturation vapor pressure - -#ifdef GFDL - logical, intent(in) :: & ! h1g, 2010-06-16 begin mod - I_sat_sphum - - real( kind = core_rknd ), intent(in) :: & - cloud_frac_min ! h1g, 2010-06-16 end mod -#endif - - ! Output variables - integer, intent(out) :: & - err_code ! Diagnostic for a problem with the setup - - ! Local variables - real( kind = core_rknd ) :: Lscale_max - integer :: begin_height, end_height - - !----- Begin Code ----- - - ! Sanity check for the saturation formula - select case ( trim( saturation_formula ) ) - case ( "bolton", "Bolton" ) - ! Using the Bolton 1980 approximations for SVP over vapor/ice - - case ( "flatau", "Flatau" ) - ! Using the Flatau, et al. polynomial approximation for SVP over vapor/ice - - case ( "gfdl", "GFDL" ) ! h1g, 2010-06-16 - ! Using the GFDL SVP formula (Goff-Gratch) - - ! Add new saturation formulas after this - - case default - write(fstderr,*) "Error in setup_clubb_core." - write(fstderr,*) "Unknown approx. of saturation vapor pressure: "// & - trim( saturation_formula ) - stop - end select - - ! Setup grid - call setup_grid( nzmax, sfc_elevation, l_implemented, & ! intent(in) - grid_type, deltaz, zm_init, zm_top, & ! intent(in) - momentum_heights, thermodynamic_heights, & ! intent(in) - begin_height, end_height ) ! intent(out) - - ! Setup flags -#ifdef GFDL - call setup_model_flags & - ( l_host_applies_sfc_fluxes, & ! intent(in) - l_uv_nudge, saturation_formula, & ! intent(in) - I_sat_sphum ) ! intent(in) h1g, 2010-06-16 - -#else - call setup_model_flags & - ( l_host_applies_sfc_fluxes, & ! intent(in) - l_uv_nudge, saturation_formula ) ! intent(in) -#endif - - ! Determine the maximum allowable value for Lscale (in meters). - call set_Lscale_max( l_implemented, host_dx, host_dy, & ! Intent(in) - Lscale_max ) ! Intent(out) - - ! Define model constant parameters -#ifdef GFDL - call setup_parameters_model( T0_in, ts_nudge_in, & ! In - hydromet_dim_in, & ! in - sclr_dim_in, sclr_tol_in, edsclr_dim_in, &! In - Lscale_max, cloud_frac_min ) ! In h1g, 2010-06-16 -#else - call setup_parameters_model( T0_in, ts_nudge_in, & ! In - hydromet_dim_in, & ! in - sclr_dim_in, sclr_tol_in, edsclr_dim_in, &! In - Lscale_max ) ! In -#endif - - ! Define tunable constant parameters - call setup_parameters & - ( deltaz, params, gr%nz, & ! intent(in) - grid_type, momentum_heights(begin_height:end_height), & ! intent(in) - thermodynamic_heights(begin_height:end_height), & ! intent(in) - err_code ) ! intent(out) - - ! Error Report - ! Joshua Fasching February 2008 - if ( err_code /= clubb_no_error ) then - - write(fstderr,*) "Error in setup_clubb_core" - - write(fstderr,*) "Intent(in)" - - write(fstderr,*) "deltaz = ", deltaz - write(fstderr,*) "zm_init = ", zm_init - write(fstderr,*) "zm_top = ", zm_top - write(fstderr,*) "momentum_heights = ", momentum_heights - write(fstderr,*) "thermodynamic_heights = ", & - thermodynamic_heights - write(fstderr,*) "T0_in = ", T0_in - write(fstderr,*) "ts_nudge_in = ", ts_nudge_in - write(fstderr,*) "params = ", params - - return - - end if - -#ifdef GFDL -! setup prognostic_variables - call setup_prognostic_variables( gr%nz ) ! intent(in) h1g, 2010-06-16 -#else - if ( .not. l_implemented ) then - call setup_prognostic_variables( gr%nz ) ! intent(in) - end if -#endif - - ! The diagnostic variables need to be - ! declared, allocated, initialized, and deallocated whether CLUBB - ! is part of a larger model or not. - call setup_diagnostic_variables( gr%nz ) - -#ifdef MKL - ! Initialize the CSR matrix class. - if ( l_gmres ) then - call initialize_csr_class - end if - - if ( l_gmres ) then - call gmres_cache_temp_init( gr%nz ) - call gmres_init( (2 * gr%nz), intlc_5d_5d_ja_size ) - end if -#endif /* MKL */ - - return - end subroutine setup_clubb_core - - !---------------------------------------------------------------------------- - subroutine cleanup_clubb_core( l_implemented ) - ! - ! Description: - ! Frees memory used by the model itself. - ! - ! References: - ! None - !--------------------------------------------------------------------------- - use crmx_parameters_model, only: sclr_tol ! Variable - - use crmx_variables_diagnostic_module, only: & - cleanup_diagnostic_variables ! Procedure - - use crmx_variables_prognostic_module, only: & - cleanup_prognostic_variables ! Procedure - - use crmx_grid_class, only: & - cleanup_grid ! Procedure - - use crmx_parameters_tunable, only: & - cleanup_nu ! Procedure - - implicit none - - ! Flag to see if CLUBB is running on it's own, - ! or if it's implemented as part of a host model. - logical, intent(in) :: l_implemented ! (T/F) - - !----- Begin Code ----- -#ifdef GFDL - ! cleanup prognostic_variables - call cleanup_prognostic_variables( ) ! h1g, 2010-06-16 -#else - if ( .not. l_implemented ) then - call cleanup_prognostic_variables( ) - end if -#endif - - ! The diagnostic variables need to be - ! declared, allocated, initialized, and deallocated whether CLUBB - ! is part of a larger model or not. - call cleanup_diagnostic_variables( ) - - ! De-allocate the array for the passive scalar tolerances - deallocate( sclr_tol ) - - ! De-allocate the arrays for the grid - call cleanup_grid( ) - - ! De-allocate the arrays for nu - call cleanup_nu( ) - - return - end subroutine cleanup_clubb_core - - !----------------------------------------------------------------------- - subroutine trapezoidal_rule_zt & - ( l_call_pdf_closure_twice, & ! intent(in) - wprtp2, wpthlp2, & ! intent(inout) - wprtpthlp, cloud_frac, ice_supersat_frac, & ! intent(inout) - rcm, wp2thvp, wpsclrprtp, wpsclrp2, & ! intent(inout) - wpsclrpthlp, pdf_params, & ! intent(inout) - wprtp2_zm, wpthlp2_zm, & ! intent(inout) - wprtpthlp_zm, cloud_frac_zm, & ! intent(inout) - ice_supersat_frac_zm, rcm_zm, wp2thvp_zm, & ! intent(inout) - wpsclrprtp_zm, wpsclrp2_zm, wpsclrpthlp_zm, & ! intent(inout) - pdf_params_zm ) ! intent(inout) - ! - ! Description: - ! This subroutine takes the output variables on the thermo. - ! grid and either: interpolates them to the momentum grid, or uses the - ! values output from the second call to pdf_closure on momentum levels if - ! l_call_pdf_closure_twice is true. It then calls the function - ! trapezoid_zt to recompute the variables on the thermo. grid. - ! - ! ldgrant June 2009 - ! - ! Note: - ! The argument variables in the last 5 lines of the subroutine - ! (wprtp2_zm through pdf_params_zm) are declared intent(inout) because - ! if l_call_pdf_closure_twice is true, these variables will already have - ! values from pdf_closure on momentum levels and will not be altered in - ! this subroutine. However, if l_call_pdf_closure_twice is false, these - ! variables will not have values yet and will be interpolated to - ! momentum levels in this subroutine. - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_stats_variables, only: & - iwprtp2, & ! Varibles - iwprtpthlp, & - iwpthlp2, & - iwprtp2, & - iwpsclrp2, & - iwpsclrprtp, & - iwpsclrpthlp, & - l_stats - - use crmx_grid_class, only: & - gr, & ! Variable - zt2zm ! Procedure - - use crmx_parameters_model, only: & - sclr_dim ! Number of passive scalar variables - - use crmx_pdf_parameter_module, only: & - pdf_parameter ! Derived data type - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - logical, parameter :: & - l_apply_rule_to_pdf_params = .false. ! Apply the trapezoidal rule to pdf_params - - ! Input variables - logical, intent(in) :: l_call_pdf_closure_twice - - ! Input/Output variables - ! Thermodynamic level variables output from the first call to pdf_closure - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - wprtp2, & ! w'rt'^2 [m kg^2/kg^2] - wpthlp2, & ! w'thl'^2 [m K^2/s] - wprtpthlp, & ! w'rt'thl' [m kg K/kg s] - cloud_frac, & ! Cloud Fraction [-] - ice_supersat_frac, & ! Ice Cloud Fraction [-] - rcm, & ! Liquid water mixing ratio [kg/kg] - wp2thvp ! w'^2 th_v' [m^2 K/s^2] - - real( kind = core_rknd ), dimension(gr%nz,sclr_dim), intent(inout) :: & - wpsclrprtp, & ! w'sclr'rt' - wpsclrp2, & ! w'sclr'^2 - wpsclrpthlp ! w'sclr'thl' - - type (pdf_parameter), dimension(gr%nz), intent(inout) :: & - pdf_params ! PDF parameters [units vary] - - ! Thermo. level variables brought to momentum levels either by - ! interpolation (in subroutine trapezoidal_rule_zt) or by - ! the second call to pdf_closure (in subroutine advance_clubb_core) - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - wprtp2_zm, & ! w'rt'^2 on momentum grid [m kg^2/kg^2] - wpthlp2_zm, & ! w'thl'^2 on momentum grid [m K^2/s] - wprtpthlp_zm, & ! w'rt'thl' on momentum grid [m kg K/kg s] - cloud_frac_zm, & ! Cloud Fraction on momentum grid [-] - ice_supersat_frac_zm, & ! Ice Cloud Fraction on momentum grid [-] - rcm_zm, & ! Liquid water mixing ratio on momentum grid [kg/kg] - wp2thvp_zm ! w'^2 th_v' on momentum grid [m^2 K/s^2] - - real( kind = core_rknd ), dimension(gr%nz,sclr_dim), intent(inout) :: & - wpsclrprtp_zm, & ! w'sclr'rt' on momentum grid - wpsclrp2_zm, & ! w'sclr'^2 on momentum grid - wpsclrpthlp_zm ! w'sclr'thl' on momentum grid - - type (pdf_parameter), dimension(gr%nz), intent(inout) :: & - pdf_params_zm ! PDF parameters on momentum grid [units vary] - - ! Local variables - - ! Components of PDF_parameters on the momentum grid (_zm) and on the thermo. grid (_zt) - real( kind = core_rknd ), dimension(gr%nz) :: & - w1_zt, & ! Mean of w for 1st normal distribution [m/s] - w1_zm, & ! Mean of w for 1st normal distribution [m/s] - w2_zm, & ! Mean of w for 2nd normal distribution [m/s] - w2_zt, & ! Mean of w for 2nd normal distribution [m/s] - varnce_w1_zm, & ! Variance of w for 1st normal distribution [m^2/s^2] - varnce_w1_zt, & ! Variance of w for 1st normal distribution [m^2/s^2] - varnce_w2_zm, & ! Variance of w for 2nd normal distribution [m^2/s^2] - varnce_w2_zt, & ! Variance of w for 2nd normal distribution [m^2/s^2] - rt1_zm, & ! Mean of r_t for 1st normal distribution [kg/kg] - rt1_zt, & ! Mean of r_t for 1st normal distribution [kg/kg] - rt2_zm, & ! Mean of r_t for 2nd normal distribution [kg/kg] - rt2_zt, & ! Mean of r_t for 2nd normal distribution [kg/kg] - varnce_rt1_zm, & ! Variance of r_t for 1st normal distribution [kg^2/kg^2] - varnce_rt1_zt, & ! Variance of r_t for 1st normal distribution [kg^2/kg^2] - varnce_rt2_zm, & ! Variance of r_t for 2nd normal distribution [kg^2/kg^2] - varnce_rt2_zt, & ! Variance of r_t for 2nd normal distribution [kg^2/kg^2] - crt1_zm, & ! Coefficient for s' [-] - crt1_zt, & ! Coefficient for s' [-] - crt2_zm ! Coefficient for s' [-] - - real( kind = core_rknd ), dimension(gr%nz) :: & - crt2_zt, & ! Coefficient for s' [-] - cthl1_zm, & ! Coefficient for s' [1/K] - cthl1_zt, & ! Coefficient for s' [1/K] - cthl2_zm, & ! Coefficient for s' [1/K] - cthl2_zt, & ! Coefficient for s' [1/K] - thl1_zm, & ! Mean of th_l for 1st normal distribution [K] - thl1_zt, & ! Mean of th_l for 1st normal distribution [K] - thl2_zm, & ! Mean of th_l for 2nd normal distribution [K] - thl2_zt, & ! Mean of th_l for 2nd normal distribution - varnce_thl1_zm, & ! Variance of th_l for 1st normal distribution [K^2] - varnce_thl1_zt, & ! Variance of th_l for 1st normal distribution [K^2] - varnce_thl2_zm, & ! Variance of th_l for 2nd normal distribution [K^2] - varnce_thl2_zt ! Variance of th_l for 2nd normal distribution [K^2] - - real( kind = core_rknd ), dimension(gr%nz) :: & - mixt_frac_zm, & ! Weight of 1st normal distribution (Sk_w dependent) [-] - mixt_frac_zt, & ! Weight of 1st normal distribution (Sk_w dependent) [-] - rc1_zm, & ! Mean of r_c for 1st normal distribution [kg/kg] - rc1_zt, & ! Mean of r_c for 1st normal distribution [kg/kg] - rc2_zm, & ! Mean of r_c for 2nd normal distribution [kg/kg] - rc2_zt, & ! Mean of r_c for 2nd normal distribution [kg/kg] - rsl1_zm, & ! Mean of r_sl for 1st normal distribution [kg/kg] - rsl1_zt, & ! Mean of r_sl for 1st normal distribution [kg/kg] - rsl2_zm, & ! Mean of r_sl for 2nd normal distribution [kg/kg] - rsl2_zt, & ! Mean of r_sl for 2nd normal distribution [kg/kg] - cloud_frac1_zm, & ! Cloud fraction for 1st normal distribution [-] - cloud_frac1_zt, & ! Cloud fraction for 1st normal distribution [-] - cloud_frac2_zm, & ! Cloud fraction for 2nd normal distribution [-] - cloud_frac2_zt, & ! Cloud fraction for 2nd normal distribution [-] - s1_zm, & ! Mean of s for 1st normal distribution [kg/kg] - s1_zt, & ! Mean of s for 1st normal distribution [kg/kg] - s2_zm, & ! Mean of s for 2nd normal distribution [kg/kg] - s2_zt, & ! Mean of s for 2nd normal distribution [kg/kg] - stdev_s1_zm ! Standard deviation of s for 1st normal distribution [kg/kg] - - real( kind = core_rknd ), dimension(gr%nz) :: & - stdev_s1_zt, & ! Standard deviation of s for 1st normal distribution [kg/kg] - stdev_s2_zm, & ! Standard deviation of s for 2nd normal distribution [kg/kg] - stdev_s2_zt, & ! Standard deviation of s for 2nd normal distribution [kg/kg] - stdev_t1_zm, & ! Standard deviation of t for 1st normal distribution [kg/kg] - stdev_t1_zt, & ! Standard deviation of t for 1st normal distribution [kg/kg] - stdev_t2_zm, & ! Standard deviation of t for 2nd normal distribution [kg/kg] - stdev_t2_zt, & ! Standard deviation of t for 2nd normal distribution [kg/kg] - rrtthl_zm, & ! Within-a-normal correlation of r_t and th_l [-] - rrtthl_zt, & ! Within-a-normal correlation of r_t and th_l [-] - alpha_thl_zm, & ! Factor relating to normalized variance for th_l [-] - alpha_thl_zt, & ! Factor relating to normalized variance for th_l [-] - alpha_rt_zm, & ! Factor relating to normalized variance for r_t [-] - alpha_rt_zt ! Factor relating to normalized variance for r_t [-] - - integer :: i - - !----------------------- Begin Code ----------------------------- - - ! Store components of pdf_params in the locally declared variables - ! We only apply the trapezoidal rule to these when - ! l_apply_rule_to_pdf_params is true. This is because when we apply the - ! rule to the final result of pdf_closure rather than the intermediate - ! results it can lead to an inconsistency in how we determine which - ! PDF component a point is in and whether the point is in or out of cloud, - ! which is turn will break the latin hypercube code that samples - ! preferentially in cloud. -dschanen 13 Feb 2012 - - if ( l_apply_rule_to_pdf_params ) then - w1_zt = pdf_params%w1 - w2_zt = pdf_params%w2 - varnce_w1_zt = pdf_params%varnce_w1 - varnce_w2_zt = pdf_params%varnce_w2 - rt1_zt = pdf_params%rt1 - rt2_zt = pdf_params%rt2 - varnce_rt1_zt = pdf_params%varnce_rt1 - varnce_rt2_zt = pdf_params%varnce_rt2 - crt1_zt = pdf_params%crt1 - crt2_zt = pdf_params%crt2 - cthl1_zt = pdf_params%cthl1 - cthl2_zt = pdf_params%cthl2 - thl1_zt = pdf_params%thl1 - thl2_zt = pdf_params%thl2 - varnce_thl1_zt = pdf_params%varnce_thl1 - varnce_thl2_zt = pdf_params%varnce_thl2 - mixt_frac_zt = pdf_params%mixt_frac - rc1_zt = pdf_params%rc1 - rc2_zt = pdf_params%rc2 - rsl1_zt = pdf_params%rsl1 - rsl2_zt = pdf_params%rsl2 - cloud_frac1_zt = pdf_params%cloud_frac1 - cloud_frac2_zt = pdf_params%cloud_frac2 - s1_zt = pdf_params%s1 - s2_zt = pdf_params%s2 - stdev_s1_zt = pdf_params%stdev_s1 - stdev_s2_zt = pdf_params%stdev_s2 - stdev_t1_zt = pdf_params%stdev_t1 - stdev_t2_zt = pdf_params%stdev_t2 - rrtthl_zt = pdf_params%rrtthl - alpha_thl_zt = pdf_params%alpha_thl - alpha_rt_zt = pdf_params%alpha_rt - end if - - ! If l_call_pdf_closure_twice is true, the _zm variables already have - ! values from the second call to pdf_closure in advance_clubb_core. - ! If it is false, the variables are interpolated to the _zm levels. - if ( l_call_pdf_closure_twice ) then - - ! Store, in locally declared variables, the pdf_params output - ! from the second call to pdf_closure - if ( l_apply_rule_to_pdf_params ) then - w1_zm = pdf_params_zm%w1 - w2_zm = pdf_params_zm%w2 - varnce_w1_zm = pdf_params_zm%varnce_w1 - varnce_w2_zm = pdf_params_zm%varnce_w2 - rt1_zm = pdf_params_zm%rt1 - rt2_zm = pdf_params_zm%rt2 - varnce_rt1_zm = pdf_params_zm%varnce_rt1 - varnce_rt2_zm = pdf_params_zm%varnce_rt2 - crt1_zm = pdf_params_zm%crt1 - crt2_zm = pdf_params_zm%crt2 - cthl1_zm = pdf_params_zm%cthl1 - cthl2_zm = pdf_params_zm%cthl2 - thl1_zm = pdf_params_zm%thl1 - thl2_zm = pdf_params_zm%thl2 - varnce_thl1_zm = pdf_params_zm%varnce_thl1 - varnce_thl2_zm = pdf_params_zm%varnce_thl2 - mixt_frac_zm = pdf_params_zm%mixt_frac - rc1_zm = pdf_params_zm%rc1 - rc2_zm = pdf_params_zm%rc2 - rsl1_zm = pdf_params_zm%rsl1 - rsl2_zm = pdf_params_zm%rsl2 - cloud_frac1_zm = pdf_params_zm%cloud_frac1 - cloud_frac2_zm = pdf_params_zm%cloud_frac2 - s1_zm = pdf_params_zm%s1 - s2_zm = pdf_params_zm%s2 - stdev_s1_zm = pdf_params_zm%stdev_s1 - stdev_s2_zm = pdf_params_zm%stdev_s2 - stdev_t1_zm = pdf_params_zm%stdev_t1 - stdev_t2_zm = pdf_params_zm%stdev_t2 - rrtthl_zm = pdf_params_zm%rrtthl - alpha_thl_zm = pdf_params_zm%alpha_thl - alpha_rt_zm = pdf_params_zm%alpha_rt - end if - - else - - ! Interpolate thermodynamic variables to the momentum grid. - ! Since top momentum level is higher than top thermo. level, - ! set variables at top momentum level to 0. - wprtp2_zm = zt2zm( wprtp2 ) - wprtp2_zm(gr%nz) = 0.0_core_rknd - wpthlp2_zm = zt2zm( wpthlp2 ) - wpthlp2_zm(gr%nz) = 0.0_core_rknd - wprtpthlp_zm = zt2zm( wprtpthlp ) - wprtpthlp_zm(gr%nz) = 0.0_core_rknd - cloud_frac_zm = zt2zm( cloud_frac ) - cloud_frac_zm(gr%nz) = 0.0_core_rknd - ice_supersat_frac_zm = zt2zm( ice_supersat_frac ) - ice_supersat_frac_zm(gr%nz) = 0.0_core_rknd - rcm_zm = zt2zm( rcm ) - rcm_zm(gr%nz) = 0.0_core_rknd - wp2thvp_zm = zt2zm( wp2thvp ) - wp2thvp_zm(gr%nz) = 0.0_core_rknd - - do i = 1, sclr_dim - wpsclrprtp_zm(:,i) = zt2zm( wpsclrprtp(:,i) ) - wpsclrprtp_zm(gr%nz,i) = 0.0_core_rknd - wpsclrp2_zm(:,i) = zt2zm( wpsclrp2(:,i) ) - wpsclrp2_zm(gr%nz,i) = 0.0_core_rknd - wpsclrpthlp_zm(:,i) = zt2zm( wpsclrpthlp(:,i) ) - wpsclrpthlp_zm(gr%nz,i) = 0.0_core_rknd - end do ! i = 1, sclr_dim - - if ( l_apply_rule_to_pdf_params ) then - w1_zm = zt2zm( pdf_params%w1 ) - w1_zm(gr%nz) = 0.0_core_rknd - w2_zm = zt2zm( pdf_params%w2 ) - w2_zm(gr%nz) = 0.0_core_rknd - varnce_w1_zm = zt2zm( pdf_params%varnce_w1 ) - varnce_w1_zm(gr%nz) = 0.0_core_rknd - varnce_w2_zm = zt2zm( pdf_params%varnce_w2 ) - varnce_w2_zm(gr%nz) = 0.0_core_rknd - rt1_zm = zt2zm( pdf_params%rt1 ) - rt1_zm(gr%nz) = 0.0_core_rknd - rt2_zm = zt2zm( pdf_params%rt2 ) - rt2_zm(gr%nz) = 0.0_core_rknd - varnce_rt1_zm = zt2zm( pdf_params%varnce_rt1 ) - varnce_rt1_zm(gr%nz) = 0.0_core_rknd - varnce_rt2_zm = zt2zm( pdf_params%varnce_rt2 ) - varnce_rt2_zm(gr%nz) = 0.0_core_rknd - crt1_zm = zt2zm( pdf_params%crt1 ) - crt1_zm(gr%nz) = 0.0_core_rknd - crt2_zm = zt2zm( pdf_params%crt2 ) - crt2_zm(gr%nz) = 0.0_core_rknd - cthl1_zm = zt2zm( pdf_params%cthl1 ) - cthl1_zm(gr%nz) = 0.0_core_rknd - cthl2_zm = zt2zm( pdf_params%cthl2 ) - cthl2_zm(gr%nz) = 0.0_core_rknd - thl1_zm = zt2zm( pdf_params%thl1 ) - thl1_zm(gr%nz) = 0.0_core_rknd - thl2_zm = zt2zm( pdf_params%thl2 ) - thl2_zm(gr%nz) = 0.0_core_rknd - varnce_thl1_zm = zt2zm( pdf_params%varnce_thl1 ) - varnce_thl1_zm(gr%nz) = 0.0_core_rknd - varnce_thl2_zm = zt2zm( pdf_params%varnce_thl2 ) - varnce_thl2_zm(gr%nz) = 0.0_core_rknd - mixt_frac_zm = zt2zm( pdf_params%mixt_frac ) - mixt_frac_zm(gr%nz) = 0.0_core_rknd - rc1_zm = zt2zm( pdf_params%rc1 ) - rc1_zm(gr%nz) = 0.0_core_rknd - rc2_zm = zt2zm( pdf_params%rc2 ) - rc2_zm(gr%nz) = 0.0_core_rknd - rsl1_zm = zt2zm( pdf_params%rsl1 ) - rsl1_zm(gr%nz) = 0.0_core_rknd - rsl2_zm = zt2zm( pdf_params%rsl2 ) - rsl2_zm(gr%nz) = 0.0_core_rknd - cloud_frac1_zm = zt2zm( pdf_params%cloud_frac1 ) - cloud_frac1_zm(gr%nz) = 0.0_core_rknd - cloud_frac2_zm = zt2zm( pdf_params%cloud_frac2 ) - cloud_frac2_zm(gr%nz) = 0.0_core_rknd - s1_zm = zt2zm( pdf_params%s1 ) - s1_zm(gr%nz) = 0.0_core_rknd - s2_zm = zt2zm( pdf_params%s2 ) - s2_zm(gr%nz) = 0.0_core_rknd - stdev_s1_zm = zt2zm( pdf_params%stdev_s1 ) - stdev_s1_zm(gr%nz) = 0.0_core_rknd - stdev_s2_zm = zt2zm( pdf_params%stdev_s2 ) - stdev_s2_zm(gr%nz) = 0.0_core_rknd - stdev_t1_zm = zt2zm( pdf_params%stdev_t1 ) - stdev_t1_zm(gr%nz) = 0.0_core_rknd - stdev_t2_zm = zt2zm( pdf_params%stdev_t2 ) - stdev_t2_zm(gr%nz) = 0.0_core_rknd - rrtthl_zm = zt2zm( pdf_params%rrtthl ) - rrtthl_zm(gr%nz) = 0.0_core_rknd - alpha_thl_zm = zt2zm( pdf_params%alpha_thl ) - alpha_thl_zm(gr%nz) = 0.0_core_rknd - alpha_rt_zm = zt2zm( pdf_params%alpha_rt ) - alpha_rt_zm(gr%nz) = 0.0_core_rknd - end if - end if ! l_call_pdf_closure_twice - - if ( l_stats ) then - ! Use the trapezoidal rule to recompute the variables on the zt level - if ( iwprtp2 > 0 ) then - wprtp2 = trapezoid_zt( wprtp2, wprtp2_zm ) - end if - if ( iwpthlp2 > 0 ) then - wpthlp2 = trapezoid_zt( wpthlp2, wpthlp2_zm ) - end if - if ( iwprtpthlp > 0 ) then - wprtpthlp = trapezoid_zt( wprtpthlp, wprtpthlp_zm ) - end if - - do i = 1, sclr_dim - if ( iwpsclrprtp(i) > 0 ) then - wpsclrprtp(:,i) = trapezoid_zt( wpsclrprtp(:,i), wpsclrprtp_zm(:,i) ) - end if - if ( iwpsclrpthlp(i) > 0 ) then - wpsclrpthlp(:,i) = trapezoid_zt( wpsclrpthlp(:,i), wpsclrpthlp_zm(:,i) ) - end if - if ( iwpsclrp2(i) > 0 ) then - wpsclrp2(:,i) = trapezoid_zt( wpsclrp2(:,i), wpsclrp2_zm(:,i) ) - end if - end do ! i = 1, sclr_dim - end if ! l_stats - - cloud_frac = trapezoid_zt( cloud_frac, cloud_frac_zm ) - ice_supersat_frac = trapezoid_zt( ice_supersat_frac, ice_supersat_frac_zm ) - rcm = trapezoid_zt( rcm, rcm_zm ) - - wp2thvp = trapezoid_zt( wp2thvp, wp2thvp_zm ) - - if ( l_apply_rule_to_pdf_params ) then - pdf_params%w1 = trapezoid_zt( w1_zt, w1_zm ) - pdf_params%w2 = trapezoid_zt( w2_zt, w2_zm ) - pdf_params%varnce_w1 = trapezoid_zt( varnce_w1_zt, varnce_w1_zm ) - pdf_params%varnce_w2 = trapezoid_zt( varnce_w2_zt, varnce_w2_zm ) - pdf_params%rt1 = trapezoid_zt( rt1_zt, rt1_zm ) - pdf_params%rt2 = trapezoid_zt( rt2_zt, rt2_zm ) - pdf_params%varnce_rt1 = trapezoid_zt( varnce_rt1_zt, varnce_rt1_zm ) - pdf_params%varnce_rt2 = trapezoid_zt( varnce_rt2_zt, varnce_rt2_zm ) - pdf_params%crt1 = trapezoid_zt( crt1_zt, crt1_zm ) - pdf_params%crt2 = trapezoid_zt( crt2_zt, crt2_zm ) - pdf_params%cthl1 = trapezoid_zt( cthl1_zt, cthl1_zm ) - pdf_params%cthl2 = trapezoid_zt( cthl2_zt, cthl2_zm ) - pdf_params%thl1 = trapezoid_zt( thl1_zt, thl1_zm ) - pdf_params%thl2 = trapezoid_zt( thl2_zt, thl2_zm ) - pdf_params%varnce_thl1 = trapezoid_zt( varnce_thl1_zt, varnce_thl1_zm ) - pdf_params%varnce_thl2 = trapezoid_zt( varnce_thl2_zt, varnce_thl2_zm ) - pdf_params%mixt_frac = trapezoid_zt( mixt_frac_zt, mixt_frac_zm ) - pdf_params%rc1 = trapezoid_zt( rc1_zt, rc1_zm ) - pdf_params%rc2 = trapezoid_zt( rc2_zt, rc2_zm ) - pdf_params%rsl1 = trapezoid_zt( rsl1_zt, rsl1_zm ) - pdf_params%rsl2 = trapezoid_zt( rsl2_zt, rsl2_zm ) - pdf_params%cloud_frac1 = trapezoid_zt( cloud_frac1_zt, cloud_frac1_zm ) - pdf_params%cloud_frac2 = trapezoid_zt( cloud_frac2_zt, cloud_frac2_zm ) - pdf_params%s1 = trapezoid_zt( s1_zt, s1_zm ) - pdf_params%s2 = trapezoid_zt( s2_zt, s2_zm ) - pdf_params%rrtthl = trapezoid_zt( rrtthl_zt, rrtthl_zm ) - pdf_params%alpha_thl = trapezoid_zt( alpha_thl_zt, alpha_thl_zm ) - pdf_params%alpha_rt = trapezoid_zt( alpha_rt_zt, alpha_rt_zm ) - pdf_params%stdev_s1 = trapezoid_zt( stdev_s1_zt, stdev_s1_zm ) - pdf_params%stdev_s2 = trapezoid_zt( stdev_s2_zt, stdev_s2_zm ) - pdf_params%stdev_t1 = trapezoid_zt( stdev_t1_zt, stdev_t1_zm ) - pdf_params%stdev_t2 = trapezoid_zt( stdev_t2_zt, stdev_t2_zm ) - end if - - ! End of trapezoidal rule - - return - end subroutine trapezoidal_rule_zt - - !----------------------------------------------------------------------- - subroutine trapezoidal_rule_zm & - ( wpthvp_zt, thlpthvp_zt, rtpthvp_zt, & ! intent(in) - wpthvp, thlpthvp, rtpthvp ) ! intent(inout) - ! - ! Description: - ! This subroutine recomputes three variables on the - ! momentum grid from pdf_closure -- wpthvp, thlpthvp, and - ! rtpthvp -- by calling the function trapezoid_zm. Only these three - ! variables are used in this subroutine because they are the only - ! pdf_closure momentum variables used elsewhere in CLUBB. - ! - ! The _zt variables are output from the first call to pdf_closure. - ! The _zm variables are output from the second call to pdf_closure - ! on the momentum levels. - ! This is done before the call to this subroutine. - ! - ! ldgrant Feb. 2010 - ! - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_grid_class, only: gr ! Variable - - use crmx_clubb_precision, only: & - core_rknd ! variable(s) - - implicit none - - ! Input variables - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - wpthvp_zt, & ! Buoyancy flux (on thermo. grid) [(K m)/s] - thlpthvp_zt, & ! th_l' th_v' (on thermo. grid) [K^2] - rtpthvp_zt ! r_t' th_v' (on thermo. grid) [(kg K)/kg] - - ! Input/Output variables - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - wpthvp, & ! Buoyancy flux [(K m)/s] - thlpthvp, & ! th_l' th_v' [K^2] - rtpthvp ! r_t' th_v' [(kg K)/kg] - - !----------------------- Begin Code ----------------------------- - - ! Use the trapezoidal rule to recompute the variables on the zm level - wpthvp = trapezoid_zm( wpthvp, wpthvp_zt ) - thlpthvp = trapezoid_zm( thlpthvp, thlpthvp_zt ) - rtpthvp = trapezoid_zm( rtpthvp, rtpthvp_zt ) - - return - end subroutine trapezoidal_rule_zm - - !----------------------------------------------------------------------- - pure function trapezoid_zt( variable_zt, variable_zm ) - ! - ! Description: - ! Function which uses the trapezoidal rule from calculus - ! to recompute the values for the variables on the thermo. grid which - ! are output from the first call to pdf_closure in module clubb_core. - ! - ! ldgrant June 2009 - !-------------------------------------------------------------------- - - use crmx_grid_class, only: gr ! Variable - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - variable_zt, & ! Variable on the zt grid - variable_zm ! Variable on the zm grid - - ! Result - real( kind = core_rknd ), dimension(gr%nz) :: trapezoid_zt - - ! Local Variable - integer :: k ! Loop index - - !------------ Begin Code -------------- - - ! Boundary condition: trapezoidal rule not valid at zt level 1 - trapezoid_zt(1) = variable_zt(1) - - do k = 2, gr%nz - ! Trapezoidal rule from calculus - trapezoid_zt(k) = 0.5_core_rknd * ( variable_zm(k) + variable_zt(k) ) & - * ( gr%zm(k) - gr%zt(k) ) * gr%invrs_dzt(k) & - + 0.5_core_rknd * ( variable_zt(k) + variable_zm(k-1) ) & - * ( gr%zt(k) - gr%zm(k-1) ) * gr%invrs_dzt(k) - end do ! k = 2, gr%nz - - return - end function trapezoid_zt - - !----------------------------------------------------------------------- - pure function trapezoid_zm( variable_zm, variable_zt ) - ! - ! Description: - ! Function which uses the trapezoidal rule from calculus - ! to recompute the values for the important variables on the momentum - ! grid which are output from pdf_closure in module clubb_core. - ! These momentum variables only include wpthvp, thlpthvp, and rtpthvp. - ! - ! ldgrant Feb. 2010 - !-------------------------------------------------------------------- - - use crmx_grid_class, only: gr ! Variable - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - variable_zm, & ! Variable on the zm grid - variable_zt ! Variable on the zt grid - - ! Result - real( kind = core_rknd ), dimension(gr%nz) :: trapezoid_zm - - ! Local Variable - integer :: k ! Loop index - - !------------ Begin Code -------------- - - ! Boundary conditions: trapezoidal rule not valid at top zm level, nzmax. - ! Trapezoidal rule also not used at zm level 1. - trapezoid_zm(1) = variable_zm(1) - trapezoid_zm(gr%nz) = variable_zm(gr%nz) - - do k = 2, gr%nz-1 - ! Trapezoidal rule from calculus - trapezoid_zm(k) = 0.5_core_rknd * ( variable_zt(k+1) + variable_zm(k) ) & - * ( gr%zt(k+1) - gr%zm(k) ) * gr%invrs_dzm(k) & - + 0.5_core_rknd * ( variable_zm(k) + variable_zt(k) ) & - * ( gr%zm(k) - gr%zt(k) ) * gr%invrs_dzm(k) - end do ! k = 2, gr%nz-1 - - return - end function trapezoid_zm - - !----------------------------------------------------------------------- - subroutine compute_cloud_cover & - ( pdf_params, cloud_frac, rcm, & ! intent(in) - cloud_cover, rcm_in_layer ) ! intent(out) - ! - ! Description: - ! Subroutine to compute cloud cover (the amount of sky - ! covered by cloud) and rcm in layer (liquid water mixing ratio in - ! the portion of the grid box filled by cloud). - ! - ! References: - ! Definition of 's' comes from: - ! ``The Gaussian Cloud Model Relations'' G. L. Mellor (1977) - ! JAS, Vol. 34, pp. 356--358. - ! - ! Notes: - ! Added July 2009 - !--------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - rc_tol, & ! Variable(s) - fstderr - - use crmx_grid_class, only: gr ! Variable - - use crmx_pdf_parameter_module, only: & - pdf_parameter ! Derived data type - - use crmx_error_code, only: & - clubb_at_least_debug_level ! Procedure - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External functions - intrinsic :: abs, min, max - - ! Input variables - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - cloud_frac, & ! Cloud fraction [-] - rcm ! Liquid water mixing ratio [kg/kg] - - type (pdf_parameter), dimension(gr%nz), intent(in) :: & - pdf_params ! PDF Parameters [units vary] - - ! Output variables - real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & - cloud_cover, & ! Cloud cover [-] - rcm_in_layer ! Liquid water mixing ratio in cloud layer [kg/kg] - - ! Local variables - real( kind = core_rknd ), dimension(gr%nz) :: & - s_mean, & ! Mean extended cloud water mixing ratio of the - ! two Gaussian distributions - vert_cloud_frac_upper, & ! Fraction of cloud in top half of grid box - vert_cloud_frac_lower, & ! Fraction of cloud in bottom half of grid box - vert_cloud_frac ! Fraction of cloud filling the grid box in the vertical - - integer :: k - - ! ------------ Begin code --------------- - - do k = 1, gr%nz - - s_mean(k) = pdf_params(k)%mixt_frac * pdf_params(k)%s1 + & - (1.0_core_rknd-pdf_params(k)%mixt_frac) * pdf_params(k)%s2 - - end do - - do k = 2, gr%nz-1, 1 - - if ( rcm(k) < rc_tol ) then ! No cloud at this level - - cloud_cover(k) = cloud_frac(k) - rcm_in_layer(k) = rcm(k) - - else if ( ( rcm(k+1) >= rc_tol ) .and. ( rcm(k-1) >= rc_tol ) ) then - ! There is cloud above and below, - ! so assume cloud fills grid box from top to bottom - - cloud_cover(k) = cloud_frac(k) - rcm_in_layer(k) = rcm(k) - - else if ( ( rcm(k+1) < rc_tol ) .or. ( rcm(k-1) < rc_tol) ) then - ! Cloud may fail to reach gridbox top or base or both - - ! First let the cloud fill the entire grid box, then overwrite - ! vert_cloud_frac_upper(k) and/or vert_cloud_frac_lower(k) - ! for a cloud top, cloud base, or one-point cloud. - vert_cloud_frac_upper(k) = 0.5_core_rknd - vert_cloud_frac_lower(k) = 0.5_core_rknd - - if ( rcm(k+1) < rc_tol ) then ! Cloud top - - vert_cloud_frac_upper(k) = & - ( ( 0.5_core_rknd / gr%invrs_dzm(k) ) / ( gr%zm(k) - gr%zt(k) ) ) & - * ( rcm(k) / ( rcm(k) + abs( s_mean(k+1) ) ) ) - - vert_cloud_frac_upper(k) = min( 0.5_core_rknd, vert_cloud_frac_upper(k) ) - - ! Make the transition in cloudiness more gradual than using - ! the above min statement alone. - vert_cloud_frac_upper(k) = vert_cloud_frac_upper(k) + & - ( ( rcm(k+1)/rc_tol )*( 0.5_core_rknd -vert_cloud_frac_upper(k) ) ) - - else - - vert_cloud_frac_upper(k) = 0.5_core_rknd - - end if - - if ( rcm(k-1) < rc_tol ) then ! Cloud base - - vert_cloud_frac_lower(k) = & - ( ( 0.5_core_rknd / gr%invrs_dzm(k-1) ) / ( gr%zt(k) - gr%zm(k-1) ) ) & - * ( rcm(k) / ( rcm(k) + abs( s_mean(k-1) ) ) ) - - vert_cloud_frac_lower(k) = min( 0.5_core_rknd, vert_cloud_frac_lower(k) ) - - ! Make the transition in cloudiness more gradual than using - ! the above min statement alone. - vert_cloud_frac_lower(k) = vert_cloud_frac_lower(k) + & - ( ( rcm(k-1)/rc_tol )*( 0.5_core_rknd -vert_cloud_frac_lower(k) ) ) - - else - - vert_cloud_frac_lower(k) = 0.5_core_rknd - - end if - - vert_cloud_frac(k) = & - vert_cloud_frac_upper(k) + vert_cloud_frac_lower(k) - - vert_cloud_frac(k) = & - max( cloud_frac(k), min( 1.0_core_rknd, vert_cloud_frac(k) ) ) - - cloud_cover(k) = cloud_frac(k) / vert_cloud_frac(k) - rcm_in_layer(k) = rcm(k) / vert_cloud_frac(k) - - else - - if ( clubb_at_least_debug_level( 1 ) ) then - - write(fstderr,*) & - "Error: Should not arrive here in computation of cloud_cover" - - write(fstderr,*) "At grid level k = ", k - write(fstderr,*) "pdf_params(k)%mixt_frac = ", pdf_params(k)%mixt_frac - write(fstderr,*) "pdf_params(k)%s1 = ", pdf_params(k)%s1 - write(fstderr,*) "pdf_params(k)%s2 = ", pdf_params(k)%s2 - write(fstderr,*) "cloud_frac(k) = ", cloud_frac(k) - write(fstderr,*) "rcm(k) = ", rcm(k) - write(fstderr,*) "rcm(k+1) = ", rcm(k+1) - write(fstderr,*) "rcm(k-1) = ", rcm(k-1) - - end if - - return - - end if ! rcm(k) < rc_tol - - end do ! k = 2, gr%nz-1, 1 - - cloud_cover(1) = cloud_frac(1) - cloud_cover(gr%nz) = cloud_frac(gr%nz) - - rcm_in_layer(1) = rcm(1) - rcm_in_layer(gr%nz) = rcm(gr%nz) - - return - end subroutine compute_cloud_cover - !----------------------------------------------------------------------- - subroutine clip_rcm & - ( rtm, message, & ! intent(in) - rcm ) ! intent(inout) - ! - ! Description: - ! Subroutine that reduces cloud water (rcm) whenever - ! it exceeds total water (rtm = vapor + liquid). - ! This avoids negative values of rvm = water vapor mixing ratio. - ! However, it will not ensure that rcm <= rtm if rtm <= 0. - ! - ! References: - ! None - !--------------------------------------------------------------------- - - - use crmx_grid_class, only: gr ! Variable - - use crmx_error_code, only : & - clubb_at_least_debug_level ! Procedure(s) - - use crmx_constants_clubb, only: & - fstderr, & ! Variable(s) - zero_threshold - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External functions - intrinsic :: max, epsilon - - ! Input variables - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - rtm ! Total water mixing ratio [kg/kg] - - character(len= * ), intent(in) :: message - - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - rcm ! Cloud water mixing ratio [kg/kg] - - integer :: k - - ! ------------ Begin code --------------- - - ! Vince Larson clipped rcm in order to prevent rvm < 0. 5 Apr 2008. - ! This code won't work unless rtm >= 0 !!! - ! We do not clip rcm_in_layer because rcm_in_layer only influences - ! radiation, and we do not want to bother recomputing it. 6 Aug 2009 - do k = 1, gr%nz - if ( rtm(k) < rcm(k) ) then - - if ( clubb_at_least_debug_level(1) ) then - write(fstderr,*) message, ' at k=', k, 'rcm(k) = ', rcm(k), & - 'rtm(k) = ', rtm(k), '.', ' Clipping rcm.' - - end if ! clubb_at_least_debug_level(1) - - rcm(k) = max( zero_threshold, rtm(k) - epsilon( rtm(k) ) ) - - end if ! rtm(k) < rcm(k) - - end do ! k=1..gr%nz - - return - end subroutine clip_rcm - - !----------------------------------------------------------------------------- - subroutine set_Lscale_max( l_implemented, host_dx, host_dy, & - Lscale_max ) - - ! Description: - ! This subroutine sets the value of Lscale_max, which is the maximum - ! allowable value of Lscale. For standard CLUBB, it is set to a very large - ! value so that Lscale will not be limited. However, when CLUBB is running - ! as part of a host model, the value of Lscale_max is dependent on the size - ! of the host model's horizontal grid spacing. The smaller the host model's - ! horizontal grid spacing, the smaller the value of Lscale_max. When Lscale - ! is limited to a small value, the value of time-scale Tau is reduced, which - ! in turn produces greater damping on CLUBB's turbulent parameters. This - ! is the desired effect on turbulent parameters for a host model with small - ! horizontal grid spacing, for small areas usually contain much less - ! variation in meteorological quantities than large areas. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - logical, intent(in) :: & - l_implemented ! Flag to see if CLUBB is running on it's own, - ! or if it's implemented as part of a host model. - - real( kind = core_rknd ), intent(in) :: & - host_dx, & ! Host model's east-west horizontal grid spacing [m] - host_dy ! Host model's north-south horizontal grid spacing [m] - - ! Output Variable - real( kind = core_rknd ), intent(out) :: & - Lscale_max ! Maximum allowable value for Lscale [m] - - ! ---- Begin Code ---- - - ! Determine the maximum allowable value for Lscale (in meters). - if ( l_implemented ) then - Lscale_max = 0.25_core_rknd * min( host_dx, host_dy ) - else - Lscale_max = 1.0e5_core_rknd - end if - - return - end subroutine set_Lscale_max - -!=============================================================================== - - end module crmx_clubb_core -! vim: set expandtab tabstop=2 shiftwidth=2 textwidth=100 autoindent: diff --git a/src/physics/spcam/crm/CLUBB/crmx_clubb_precision.F90 b/src/physics/spcam/crm/CLUBB/crmx_clubb_precision.F90 deleted file mode 100644 index b594d17061..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_clubb_precision.F90 +++ /dev/null @@ -1,24 +0,0 @@ -!------------------------------------------------------------------------------- -! $Id: clubb_precision.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -module crmx_clubb_precision - - implicit none - - public :: stat_nknd, stat_rknd, time_precision, dp, sp, core_rknd - - private ! Default scope - - ! The precisions below are arbitrary, and could be adjusted as - ! needed for long simulations or time averaging. Note that on - ! most machines 12 digits of precision will use a data type - ! which is 8 bytes long. - integer, parameter :: & - stat_nknd = selected_int_kind( 8 ), & - stat_rknd = selected_real_kind( p=12 ), & - time_precision = selected_real_kind( p=12 ), & - dp = selected_real_kind( p=12 ), & ! double precision - sp = selected_real_kind( p=5 ), & ! single precision - core_rknd = CLUBB_REAL_TYPE ! Value from the preprocessor directive - -end module crmx_clubb_precision -!------------------------------------------------------------------------------- diff --git a/src/physics/spcam/crm/CLUBB/crmx_constants_clubb.F90 b/src/physics/spcam/crm/CLUBB/crmx_constants_clubb.F90 deleted file mode 100644 index a6108f6419..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_constants_clubb.F90 +++ /dev/null @@ -1,375 +0,0 @@ -!----------------------------------------------------------------------------- -! $Id: constants_clubb.F90 6132 2013-03-28 13:09:40Z vlarson@uwm.edu $ -!============================================================================= -module crmx_constants_clubb - - ! Description: - ! Contains frequently occuring model constants - - ! References: - ! None - !--------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - dp, & - core_rknd - -!#ifdef CLUBB_CAM /* Set constants as they're set in CAM */ -#if defined(CLUBB_CAM) || defined(CRM) /* set constants as they' are set in CAM for CLUBB_CAM or MMF */ - use shr_const_mod, only: shr_const_rdair, shr_const_cpdair, shr_const_latvap, & - shr_const_latice, shr_const_latsub, shr_const_rgas, & - shr_const_mwwv, shr_const_stebol, shr_const_tkfrz, & - shr_const_mwdair, shr_const_g, shr_const_karman, & - shr_const_rhofw -#elif GFDL - ! use GFDL constants, and then rename them to avoid confusion in case - ! that the constants share the same names between GFDL and CLUBB - use constants_mod, only: pi_gfdl => PI, & - radians_per_deg_dp_gfdl => DEG_TO_RAD, & - Cp_gfdl => CP_AIR, & - Lv_gfdl => HLV, & - Ls_gfdl => HLS, & - Lf_gfdl => HLF, & - Rd_gfdl => RDGAS, & - Rv_gfdl => RVGAS, & - stefan_boltzmann_gfdl => STEFAN, & - T_freeze_K_gfdl => TFREEZE, & - grav_gfdl => GRAV, & - vonk_gfdl => VONKARM, & - rho_lw_gfdl => DENS_H2O -#endif - - implicit none - - private ! Default scope - - !----------------------------------------------------------------------------- - ! Numerical/Arbitrary Constants - !----------------------------------------------------------------------------- - - ! Fortran file unit I/O constants - integer, parameter, public :: & - fstderr = 0, fstdin = 5, fstdout = 6 - - ! Maximum variable name length in CLUBB GrADS or netCDF output - integer, parameter, public :: & - var_length = 30 - ! The parameter parab_cyl_max_input is the largest magnitude that the input to - ! the parabolic cylinder function is allowed to have. When the value of the - ! input to the parabolic cylinder function is too large in magnitude - ! (depending on the order of the parabolic cylinder function), overflow - ! occurs, and the output of the parabolic cylinder function is +/-Inf. The - ! parameter parab_cyl_max_input places a limit on the absolute value of the - ! input to the parabolic cylinder function. When the value of the potential - ! input exceeds this parameter (usually due to a very large ratio of ith PDF - ! component mean of x to ith PDF component standard deviation of x), the - ! variable x is considered to be constant and a different version of the - ! equation called. - ! - ! The largest allowable magnitude of the input to the parabolic cylinder - ! function (before overflow occurs) is dependent on the order of parabolic - ! cylinder function. However, after a lot of testing, it was determined that - ! an absolute value of 49 works well for an order of 12 or less. - real( kind = core_rknd ), parameter, public :: & - parab_cyl_max_input = 49.0_core_rknd ! Largest allowable input to parab. cyl. fnct. - - ! "Over-implicit" weighted time step. - ! - ! The weight of the implicit portion of a term is controlled by the factor - ! gamma_over_implicit_ts (abbreviated "gamma" in the expression below). A - ! factor is added to the right-hand side of the equation in order to balance a - ! weight that is not equal to 1, such that: - ! - ! -y(t) * [ gamma * X(t+1) + ( 1 - gamma ) * X(t) ] + RHS; - ! - ! where X is the variable that is being solved for in a predictive equation - ! (such as w'^3, w'th_l', r_t'^2, etc), y(t) is the linearized portion of the - ! term that gets treated implicitly, and RHS is the portion of the term that - ! is always treated explicitly. A weight of greater than 1 can be applied to - ! make the term more numerically stable. - ! - ! gamma_over_implicit_ts Effect on term - ! - ! 0.0 Term becomes completely explicit - ! - ! 1.0 Standard implicit portion of the term; - ! as it was without the weighting factor. - ! - ! 1.5 Strongly weighted implicit portion of the term; - ! increased numerical stability. - ! - ! 2.0 More strongly weighted implicit portion of the - ! term; increased numerical stability. - ! - ! Note: The "over-implicit" weighted time step is only applied to terms that - ! tend to significantly decrease the amount of numerical stability for - ! variable X. - ! The "over-implicit" weighted time step is applied to the turbulent - ! advection term for the following variables: - ! w'^3 (also applied to the turbulent production term), found in - ! module advance_wp2_wp3_module; - ! w'r_t', w'th_l', and w'sclr', found in - ! module advance_xm_wpxp_module; and - ! r_t'^2, th_l'^2, r_t'th_l', u'^2, v'^2, sclr'^2, sclr'r_t', - ! and sclr'th_l', found in module advance_xp2_xpyp_module. - real( kind = core_rknd ), parameter, public :: & - gamma_over_implicit_ts = 1.50_core_rknd - - !----------------------------------------------------------------------------- - ! Mathematical Constants - !----------------------------------------------------------------------------- - real( kind = dp ), parameter, public :: & - pi_dp = 3.14159265358979323846_dp - -#ifdef GFDL - real( kind = core_rknd ), parameter, public :: & - pi = pi_gfdl ! The ratio of radii to their circumference - - real( kind = dp ), parameter, public :: & - radians_per_deg_dp = radians_per_deg_dp_gfdl -#else - - real( kind = core_rknd ), parameter, public :: & - pi = 3.141592654_core_rknd ! The ratio of radii to their circumference - - real( kind = dp ), parameter, public :: & - radians_per_deg_dp = pi_dp / 180._dp -#endif - - real( kind = core_rknd ), parameter, public :: & - sqrt_2pi = 2.5066282746310005024_core_rknd, & ! sqrt(2*pi) - sqrt_2 = 1.4142135623730950488_core_rknd ! sqrt(2) - - real( kind = dp ), parameter, public:: & - two_dp = 2.0_dp, & ! 2 - one_dp = 1.0_dp, & ! 1 - one_half_dp = 0.5_dp, & ! 1/2 - one_fourth_dp = 0.25_dp, & ! 1/4 - zero_dp = 0.0_dp ! 0 - - real( kind = core_rknd ), parameter, public :: & - one_hundred = 100.0_core_rknd, & ! 100 - fifty = 50.0_core_rknd, & ! 50 - twenty = 20.0_core_rknd, & ! 20 - ten = 10.0_core_rknd, & ! 10 - five = 5.0_core_rknd, & ! 5 - four = 4.0_core_rknd, & ! 4 - three = 3.0_core_rknd, & ! 3 - two = 2.0_core_rknd, & ! 2 - three_halves = 3.0_core_rknd/2.0_core_rknd, & ! 3/2 - four_thirds = 4.0_core_rknd/3.0_core_rknd, & ! 4/3 - one = 1.0_core_rknd, & ! 1 - three_fourths = 0.75_core_rknd, & ! 3/4 - two_thirds = 2.0_core_rknd/3.0_core_rknd, & ! 2/3 - one_half = 0.5_core_rknd, & ! 1/2 - one_third = 1.0_core_rknd/3.0_core_rknd, & ! 1/3 - one_fourth = 0.25_core_rknd, & ! 1/4 - zero = 0.0_core_rknd ! 0 - - !----------------------------------------------------------------------------- - ! Physical constants - !----------------------------------------------------------------------------- - -!#ifdef CLUBB_CAM -#if defined(CLUBB_CAM) || defined(CRM) /* set constants as they' are set in CAM for CLUBB_CAM or MMF */ - - real( kind = core_rknd ), parameter, public :: & - Cp = shr_const_cpdair, & ! Dry air specific heat at constant p [J/kg/K] - Lv = shr_const_latvap, & ! Latent heat of vaporization [J/kg] - Lf = shr_const_latice, & ! Latent heat of fusion [J/kg] - Ls = shr_const_latsub, & ! Latent heat of sublimation [J/kg] - Rd = shr_const_rdair, & ! Dry air gas constant [J/kg/K] - Rv = shr_const_rgas/shr_const_mwwv ! Water vapor gas constant [J/kg/K] - - real( kind = core_rknd ), parameter, public :: & - stefan_boltzmann = shr_const_stebol ! Stefan-Boltzmann constant [W/(m^2 K^4)] - - real( kind = core_rknd ), parameter, public :: & - T_freeze_K = shr_const_tkfrz ! Freezing point of water [K] - - ! Useful combinations of Rd and Rv - real( kind = core_rknd ), parameter, public :: & - ep = shr_const_mwwv/shr_const_mwdair, & ! ep = 0.622 [-] - ep1 = (1.0-ep)/ep,& ! ep1 = 0.61 [-] - ep2 = 1.0/ep ! ep2 = 1.61 [-] - - real( kind = core_rknd ), parameter, public :: & - kappa = (shr_const_rgas/shr_const_mwdair)/shr_const_cpdair ! kappa [-] - - real( kind = core_rknd ), parameter, public :: & - grav = shr_const_g, & ! Gravitational acceleration [m/s^2] - p0 = 1.0e5 ! Reference pressure [Pa] - - ! Von Karman's constant - ! Constant of the logarithmic wind profile in the surface layer - real( kind = core_rknd ), parameter, public :: & - vonk = shr_const_karman, & ! Accepted value is 0.40 (+/-) 0.01 [-] - rho_lw = shr_const_rhofw ! Density of liquid water [kg/m^3] - - -#elif GFDL - real( kind = core_rknd ), parameter, public :: & - Cp = Cp_gfdl, & ! Dry air specific heat at constant p [J/kg/K] - Lv = Lv_gfdl, & ! Latent heat of vaporization [J/kg] - Ls = Ls_gfdl, & ! Latent heat of sublimation [J/kg] - Lf = Lf_gfdl, & ! Latent heat of fusion [J/kg] - Rd = Rd_gfdl, & ! Dry air gas constant [J/kg/K] - Rv = Rv_gfdl ! Water vapor gas constant [J/kg/K] - - - real( kind = core_rknd ), parameter, public :: & - stefan_boltzmann = stefan_boltzmann_gfdl ! Stefan-Boltzmann constant [W/(m^2 K^4)] - - real( kind = core_rknd ), parameter, public :: & - T_freeze_K = T_freeze_K_gfdl ! Freezing point of water [K] - - ! Useful combinations of Rd and Rv - real( kind = core_rknd ), parameter, public :: & - ep = Rd / Rv, & ! ep = 0.622 [-] - ep1 = (1.0-ep)/ep,& ! ep1 = 0.61 [-] - ep2 = 1.0/ep ! ep2 = 1.61 [-] - - real( kind = core_rknd ), parameter, public :: & - kappa = Rd / Cp ! kappa [-] - - ! Changed g to grav to make it easier to find in the code 5/25/05 - ! real, parameter :: grav = 9.80665 ! Gravitational acceleration [m/s^2] - real( kind = core_rknd ), parameter, public :: & - grav = grav_gfdl, & ! Gravitational acceleration [m/s^2] - p0 = 1.0e5 ! Reference pressure [Pa] - - ! Von Karman's constant - ! Constant of the logarithmic wind profile in the surface layer - real( kind = core_rknd ), parameter, public :: & - vonk = vonk_gfdl, & ! Accepted value is 0.40 (+/-) 0.01 [-] - rho_lw = rho_lw_gfdl ! Density of liquid water [kg/m^3] - - -#else - - real( kind = core_rknd ), parameter, public :: & - Cp = 1004.67_core_rknd, & ! Dry air specific heat at constant p [J/kg/K] - Lv = 2.5e6_core_rknd, & ! Latent heat of vaporization [J/kg] - Ls = 2.834e6_core_rknd, & ! Latent heat of sublimation [J/kg] - Lf = 3.33e5_core_rknd, & ! Latent heat of fusion [J/kg] - Rd = 287.04_core_rknd, & ! Dry air gas constant [J/kg/K] - Rv = 461.5_core_rknd ! Water vapor gas constant [J/kg/K] - - - real( kind = core_rknd ), parameter, public :: & - stefan_boltzmann = 5.6704e-8_core_rknd ! Stefan-Boltzmann constant [W/(m^2 K^4)] - - real( kind = core_rknd ), parameter, public :: & - T_freeze_K = 273.15_core_rknd ! Freezing point of water [K] - - ! Useful combinations of Rd and Rv - real( kind = core_rknd ), parameter, public :: & - ep = Rd / Rv, & ! ep = 0.622_core_rknd [-] - ep1 = (1.0_core_rknd-ep)/ep,& ! ep1 = 0.61_core_rknd [-] - ep2 = 1.0_core_rknd/ep ! ep2 = 1.61_core_rknd [-] - - real( kind = core_rknd ), parameter, public :: & - kappa = Rd / Cp ! kappa [-] - - ! Changed g to grav to make it easier to find in the code 5/25/05 - ! real, parameter, public :: grav = 9.80665_core_rknd ! Gravitational acceleration [m/s^2] - real( kind = core_rknd ), parameter, public :: & - grav = 9.81_core_rknd, & ! Gravitational acceleration [m/s^2] - p0 = 1.0e5_core_rknd ! Reference pressure [Pa] - - ! Von Karman's constant - ! Constant of the logarithmic wind profile in the surface layer - real( kind = core_rknd ), parameter, public :: & - vonk = 0.4_core_rknd, & ! Accepted value is 0.40 (+/-) 0.01 [-] - rho_lw = 1000.0_core_rknd ! Density of liquid water [kg/m^3] - -#endif - - ! Tolerances below which we consider moments to be zero - real( kind = core_rknd ), parameter, public :: & - w_tol = 2.e-2_core_rknd, & ! [m/s] - thl_tol = 1.e-2_core_rknd, & ! [K] - rt_tol = 1.e-8_core_rknd, & ! [kg/kg] - s_mellor_tol = 1.e-8_core_rknd, & ! [kg/kg] - t_mellor_tol = s_mellor_tol ! [kg/kg] - - ! Tolerances for use by the monatonic flux limiter. - ! rt_tol_mfl is larger than rt_tol. rt_tol is extremely small - ! (1e-8) to prevent spurious cloud formation aloft in LBA. - ! rt_tol_mfl is larger (1e-4) to prevent the mfl from - ! depositing moisture at the top of the domain. - real( kind = core_rknd ), parameter, public :: & - thl_tol_mfl = 1.e-2_core_rknd, & ! [K] - rt_tol_mfl = 1.e-4_core_rknd ! [kg/kg] - - ! The tolerance for w'^2 is the square of the tolerance for w. - real( kind = core_rknd ), parameter, public :: & - w_tol_sqd = w_tol**2 ! [m^2/s^2] - - real( kind = core_rknd ), parameter, public :: & - Skw_max_mag = 4.5_core_rknd ! Max magnitude of skewness [-] - - real( kind = core_rknd ), parameter, public :: & - Skw_max_mag_sqd = Skw_max_mag**2 ! Max mag. of Skw squared [-] - - ! Set tolerances for Khairoutdinov and Kogan rain microphysics to insure - ! against numerical errors. The tolerance values for Nc, rr, and Nr insure - ! against underflow errors in computing the PDF for l_kk_rain. Basically, - ! they insure that those values squared won't be less then 10^-38, which is - ! the lowest number that can be numerically represented. However, the - ! tolerance value for rc doubles as the lowest mixing ratio there can be to - ! still officially have a cloud at that level. This is figured to be about - ! 1.0_core_rknd x 10^-7 kg/kg. Brian; February 10, 2007. - real( kind = core_rknd ), parameter, public :: & - rc_tol = 1.0E-6_core_rknd, & ! [kg/kg] - Nc_tol = 1.0E-10_core_rknd, & ! [#/kg] - rr_tol = 1.0E-10_core_rknd, & ! [kg/kg] - Nr_tol = 1.0E-10_core_rknd ! [#/kg] - - ! Minimum value for em (turbulence kinetic energy) - ! If anisotropic TKE is enabled, em = (1/2) * ( up2 + vp2 + wp2 ); - ! otherwise, em = (3/2) * wp2. Since up2, vp2, and wp2 all have - ! the same minimum threshold value of w_tol_sqd, em cannot be less - ! than (3/2) * w_tol_sqd. Thus, em_min = (3/2) * w_tol_sqd. - real( kind = core_rknd ), parameter, public :: em_min = 1.5_core_rknd * w_tol_sqd ! [m^2/s^2] - - real( kind = core_rknd ), parameter, public :: & - eps = 1.0e-10_core_rknd ! Small value to prevent a divide by zero - - real( kind = core_rknd ), parameter, public :: & - zero_threshold = 0.0_core_rknd ! Defining a threshold on a physical quantity to be 0. - - ! The maximum absolute value (or magnitude) that a correlation is allowed to - ! have. Statistically, a correlation is not allowed to be less than -1 or - ! greater than 1, so the maximum magnitude would be 1. - real( kind = core_rknd ), parameter, public :: & - max_mag_correlation = 0.99_core_rknd - - real( kind = core_rknd ), parameter, public :: & - cloud_frac_min = 0.005_core_rknd ! Threshold for cloud fractions - - !----------------------------------------------------------------------------- - ! Useful conversion factors. - !----------------------------------------------------------------------------- - real(kind=time_precision), parameter, public :: & - sec_per_day = 86400.0_time_precision, & ! Seconds in a day. - sec_per_hr = 3600.0_time_precision, & ! Seconds in an hour. - sec_per_min = 60.0_time_precision, & ! Seconds in a minute. - min_per_hr = 60.0_time_precision ! Minutes in an hour. - - real( kind = core_rknd ), parameter, public :: & - g_per_kg = 1000.0_core_rknd ! Grams in a kilogram. - - real( kind = core_rknd ), parameter, public :: & - pascal_per_mb = 100.0_core_rknd ! Pascals per Millibar - - real( kind = core_rknd ), parameter, public :: & - cm3_per_m3 = 1.e6_core_rknd, & ! Cubic centimeters per cubic meter - micron_per_m = 1.e6_core_rknd, & ! Micrometers per meter - cm_per_m = 100._core_rknd, & ! Centimeters per meter - mm_per_m = 1000._core_rknd ! Millimeters per meter - -!============================================================================= - -end module crmx_constants_clubb diff --git a/src/physics/spcam/crm/CLUBB/crmx_corr_matrix_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_corr_matrix_module.F90 deleted file mode 100644 index 1a9eaafd0b..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_corr_matrix_module.F90 +++ /dev/null @@ -1,181 +0,0 @@ -!$Id: corr_matrix_module.F90 5997 2012-12-18 20:47:09Z raut@uwm.edu $ -!--------------------------------------------------------------------------------------------------- -module crmx_corr_matrix_module - - implicit none - - ! Latin hypercube indices / Correlation array indices - integer, public :: & - iiLH_s_mellor = -1, & - iiLH_t_mellor = -1, & - iiLH_w = -1 -!$omp threadprivate(iiLH_s_mellor, iiLH_t_mellor, iiLH_w) - - integer, public :: & - iiLH_rrain = -1, & - iiLH_rsnow = -1, & - iiLH_rice = -1, & - iiLH_rgraupel = -1 -!$omp threadprivate(iiLH_rrain, iiLH_rsnow, iiLH_rice, iiLH_rgraupel) - - integer, public :: & - iiLH_Nr = -1, & - iiLH_Nsnow = -1, & - iiLH_Ni = -1, & - iiLH_Ngraupel = -1, & - iiLH_Nc = -1 -!$omp threadprivate(iiLH_Nr, iiLH_Nsnow, iiLH_Ni, iiLH_Ngraupel, iiLH_Nc) - - public :: read_correlation_matrix - - private :: get_corr_var_index - - private - - contains - - !----------------------------------------------------------------------------- - subroutine read_correlation_matrix( iunit, input_file, d_variables, & - corr_array ) - - ! Description: - ! Reads a correlation variance array from a file and stores it in an array. - !----------------------------------------------------------------------------- - - use crmx_input_reader, only: & - one_dim_read_var, & ! Variable(s) - read_one_dim_file, deallocate_one_dim_vars, count_columns ! Procedure(s) - - use crmx_matrix_operations, only: set_lower_triangular_matrix ! Procedure(s) - - use crmx_constants_clubb, only: fstderr ! Variable(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variable(s) - integer, intent(in) :: & - iunit, & ! File I/O unit - d_variables ! number of variables in the array - - character(len=*), intent(in) :: input_file ! Path to the file - - ! Input/Output Variable(s) - real( kind = core_rknd ), dimension(d_variables,d_variables), intent(inout) :: & - corr_array ! Correlation variance array - - ! Local Variable(s) - - type(one_dim_read_var), allocatable, dimension(:) :: & - retVars ! stores the variables read in from the corr_varnce.in file - - integer :: & - var_index1, & ! variable index - var_index2, & ! variable index - nCols, & ! the number of columns in the file - i, j ! Loop index - - - !--------------------------- BEGIN CODE ------------------------- - - nCols = count_columns( iunit, input_file ) - - ! Allocate all arrays based on d_variables - allocate( retVars(1:nCols) ) - - ! Initializing to zero means that correlations we don't have - ! (e.g. Nc and any variable other than s_mellor ) are assumed to be 0. - corr_array(:,:) = 0.0_core_rknd - - ! Set main diagonal to 1 - do i=1, d_variables - corr_array(i,i) = 1.0_core_rknd - end do - - ! Read the values from the specified file - call read_one_dim_file( iunit, nCols, input_file, retVars ) - - if( size( retVars(1)%values ) /= nCols ) then - write(fstderr, *) "Correlation matrix must have an equal number of rows and cols in file ", & - input_file - stop "Bad data in correlation file." - end if - - ! Start at 2 because the first index is always just 1.0 in the first row - ! and the rest of the rows are ignored - do i=2, nCols - var_index1 = get_corr_var_index( retVars(i)%name ) - if( var_index1 > -1 ) then - do j=1, (i-1) - var_index2 = get_corr_var_index( retVars(j)%name ) - if( var_index2 > -1 ) then - call set_lower_triangular_matrix & - ( d_variables, var_index1, var_index2, retVars(i)%values(j), & - corr_array ) - end if - end do - end if - end do - - call deallocate_one_dim_vars( nCols, retVars ) - - return - end subroutine read_correlation_matrix - - !-------------------------------------------------------------------------- - function get_corr_var_index( var_name ) result( i ) - - ! Definition: - ! Returns the index for a variable based on its name. - !-------------------------------------------------------------------------- - - implicit none - - character(len=*), intent(in) :: var_name ! The name of the variable - - ! Output variable - integer :: i - - !------------------ BEGIN CODE ----------------------------- - i = -1 - - select case( trim(var_name) ) - - case( "s" ) - i = iiLH_s_mellor - - case( "t" ) - i = iiLH_t_mellor - - case( "w" ) - i = iiLH_w - - case( "Nc" ) - i = iiLH_Nc - - case( "rrain" ) - i = iiLH_rrain - - case( "Nr" ) - i = iiLH_Nr - - case( "rice" ) - i = iiLH_rice - - case( "Ni" ) - i = iiLH_Ni - - case( "rsnow" ) - i = iiLH_rsnow - - case( "Nsnow" ) - i = iiLH_Nsnow - - end select - - return - - end function get_corr_var_index -end module crmx_corr_matrix_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_csr_matrix_class_3array.F90 b/src/physics/spcam/crm/CLUBB/crmx_csr_matrix_class_3array.F90 deleted file mode 100644 index 1891bd6945..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_csr_matrix_class_3array.F90 +++ /dev/null @@ -1,522 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: csr_matrix_class_3array.F90 5529 2011-11-29 19:49:15Z connork@uwm.edu $ -!=============================================================================== -module crmx_csr_matrix_class - - ! Description: - ! This module contains some of the matrix description arrays required by - ! PARDISO, GMRES, and other sparse matrix solvers. The format is called CSR - ! (compressed sparse row) format, and is currently leveraged through PARDISO - ! and GMRES. - ! These are all 1 dimensional arrays that describe a matrix that - ! will be passed to the solver. The _ja arrays describe which - ! columns in the matrix have nonzero values--for our purposes, all the - ! elements on the appropriate diagonals have values. The _ia arrays describe - ! which _ja array elements correspond to new rows. - ! Further description of this format can be found in the PARDISO manual, or - ! alternately, in Intel MKL's documentation. - ! For our purposes, the _ia and _ja arrays will be fixed for the types - ! of matrices we have, so we calculate these initially using - ! initialize_csr_class and simply use the pointers, similar to how - ! the grid pointers are initialized. This should save a fair amount of time, - ! as we do not have to recalculate the arrays. - ! - ! A description of the CSR matrix format: - ! The CSR matrix format requires three arrays--an a array, - ! a ja array, and an ia array. - ! - ! The a array stores, in sequential order, the actual values in the matrix. - ! Essentially, just copy the matrix into a 1-dimensional array as you move - ! from left to right, top down through the matrix. The a array changes - ! frequently for our purposes in CLUBB, and is not useful to be initialized - ! here. - ! - ! The ja array stores, in sequential order, the columns of each element in - ! the matrix that is nonzero. Essentially, you take the column of each - ! element that is nonzero as you move from left to right, top down through - ! the matrix. - ! - ! An example follows to illustrate the point: - ! [3.0 2.0 0.0 0.0 0.0 0.0 - ! 2.5 1.7 3.6 0.0 0.0 0.0 - ! 0.0 5.2 1.7 3.6 0.0 0.0 - ! 0.0 0.0 4.7 2.9 0.6 0.0 - ! 0.0 0.0 0.0 8.9 4.6 1.2 - ! 0.0 0.0 0.0 0.0 5.8 3.7] - ! - ! Our ja array would look like the following--a pipe denotes a new row: - ! [1 2 | 1 2 3 | 2 3 4 | 3 4 5 | 4 5 6 | 5 6] - ! - ! The ia array stores the indices of the ja array that correspond to new rows - ! in the matrix, with a final entry just beyond the end of the ja matrix - ! that signifies the end of the matrix. - ! In our example, the ia array would look like this: - ! - ! [1 3 6 9 12 15 17] - ! - ! Similar principles can be applied to find the ia and ja matrices for all - ! of the general cases CLUBB uses. In addition, because CLUBB typically - ! uses similar matrices for its calculations, we can simply initialize - ! the ia and ja matrices in this module rather than repeatedly initialize - ! them. This should save on compute time and provide a centralized location - ! to acquire ia and ja arrays. - - implicit none - - public :: csr_tridiag_ia, csr_tridiag_ja, & - csr_banddiag5_135_ia, csr_banddiag5_135_ja, & - csr_banddiag5_12345_ia, csr_banddiag5_12345_ja, & - initialize_csr_class, & - ia_size, tridiag_ja_size, band12345_ja_size, band135_ja_size, & - csr_intlc_s3b_f5b_ia, csr_intlc_s3b_f5b_ja, & - csr_intlc_trid_5b_ia, csr_intlc_trid_5b_ja, & - csr_intlc_5b_5b_ia, csr_intlc_5b_5b_ja, & - intlc_ia_size, intlc_s3d_5d_ja_size, intlc_5d_5d_ja_size, & - intlc_td_5d_ja_size - - private ! Default scope - - integer, pointer, dimension(:) :: & - csr_tridiag_ia, & !_ia array description for a tridiagonal matrix - csr_tridiag_ja, & !_ja array description for a tridiagonal matrix - csr_banddiag5_135_ia, & !_ia array description for a 5-band matrix - ! with the first upper and lower bands as 0. - csr_banddiag5_135_ja, & !_ja array description for a 5-band matrix - ! with the first upper and lower bands as 0. - csr_banddiag5_12345_ia, & !_ia array description for a 5-band matrix - csr_banddiag5_12345_ja, & !_ja array description for a 5-band matrix - csr_intlc_s3b_f5b_ia, & !_ia array description for interlaced 5-band - ! matrix ("spaced 3-band, full 5-band") - csr_intlc_s3b_f5b_ja, & !_ja array description for interlaced 5-band - ! matrix ("spaced 3-band, full 5-band") - csr_intlc_trid_5b_ia, & !_ia array description for interlaced tridiag - ! and 5-band matrix (tridiag, 5-band) - csr_intlc_trid_5b_ja, & !_ja array description for interlaced tridiag - ! and 5-band matrix (tridiag, 5-band) - csr_intlc_5b_5b_ia, & !_ia array description for "interlaced" - ! 5-band and 5-band matrix (double-size 5-band) - csr_intlc_5b_5b_ja !_ja array description for "interlaced" - ! 5-band and 5-band matrix (double-size 5-band) - - integer :: & - ia_size, & ! Size of the _ia arrays. - tridiag_ja_size, & ! Size of the tridiagonal ja array. - band12345_ja_size, & ! Size of the 5-band-with-first-bands-0 ja array. - band135_ja_size, & ! Size of the 5-band ja array. - intlc_ia_size, & ! Size of the interlaced _ia arrays. - intlc_s3d_5d_ja_size, & ! Size of the interlaced spaced - ! 3-diag+5-diag ja arrays. - intlc_5d_5d_ja_size, & ! Size of the interlaced 5-diag+5-diag ja arrays. - intlc_td_5d_ja_size ! Size of the interlaced tridiag+5-diag ja arrays. - - contains - - !============================================================================ - subroutine initialize_csr_class - - ! Description: - ! PARDISO matrix array initialization - ! - ! This subroutine creates the _ia and _ja arrays, and calculates their - ! required values for the current gr%nz. - ! - ! References: - ! None - !------------------------------------------------------------------------ - - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - use crmx_grid_class, only: & - gr ! Variable(s) - - implicit none - - ! Local variables - integer :: & - i, j, & ! Loop indices - error, & ! Status for allocation - num_bands, & ! Number of diagonals for allocation - num_diags, & ! Number of non-empty diagonals for allocation - cur_row, & ! Current row--used in initialization - cur_diag, & ! Current diagonal--num_diags/2 + 1 is the main diagonal - ! Note: At the boundaries, less diagonals are in scope. - ! At the lower boundaries, the subdiagonals aren't in scope. - ! At the upper boundaries, the superdiagonals aren't in scope. - counter ! Counter used to initialize the interlaced matrices - - logical :: l_print_ia_ja ! Debug flag to print the ia and ja arrays after - ! initialization is complete. - - ! ---- Begin Code ---- - - ! Define the array sizes - ia_size = gr%nz + 1 - intlc_ia_size = (2 * gr%nz) + 1 - - ! Tridiagonal case and 5-band with 2 empty diagonals have 3 full diagonals - num_diags = 3 - tridiag_ja_size = (gr%nz * num_diags) - 2 - band135_ja_size = (gr%nz * num_diags) - 4 - - ! 5-band with all diagonals has 5 full diagonals - num_diags = 5 - band12345_ja_size = (gr%nz * num_diags) - 6 - - ! Interlaced arrays are tricky--there is an average of 4 diagonals for - ! the 3/5band, but we need to take into account the fact that the - ! tridiagonal and spaced 3-band will have different boundary indices. - num_diags = 4 - intlc_td_5d_ja_size = (gr%nz * 2 * num_diags) - 4 - intlc_s3d_5d_ja_size = (gr%nz * 2 * num_diags) - 5 - - ! The double-sized "interlaced" 5-band is similar to the standard 5-band - num_diags = 5 - intlc_5d_5d_ja_size = (gr%nz * 2 * num_diags) - 6 - - ! Allocate the correct amount of space for the actual _ia and _ja arrays - allocate( csr_tridiag_ia(1:ia_size), & - csr_tridiag_ja(1:tridiag_ja_size), & - csr_banddiag5_12345_ia(1:ia_size), & - csr_banddiag5_12345_ja(1:band12345_ja_size), & - csr_banddiag5_135_ia(1:ia_size), & - csr_banddiag5_135_ja(1:band135_ja_size), & - csr_intlc_s3b_f5b_ia(1:intlc_ia_size), & - csr_intlc_s3b_f5b_ja(1:intlc_s3d_5d_ja_size), & - csr_intlc_trid_5b_ia(1:intlc_ia_size), & - csr_intlc_trid_5b_ja(1:intlc_td_5d_ja_size), & - csr_intlc_5b_5b_ia(1:intlc_ia_size), & - csr_intlc_5b_5b_ja(1:intlc_5d_5d_ja_size), & - stat=error ) - - if ( error /= 0 ) then - write(fstderr,*) "Allocation of CSR matrix arrays failed." - stop "Fatal error--allocation of CSR matrix arrays failed." - end if - - ! Initialize the tridiagonal matrix arrays - num_bands = 3 - do i = 2, (gr%nz - 1), 1 - cur_row = (i - 1) * num_bands - do j = 1, num_bands, 1 - cur_diag = j - 1 - csr_tridiag_ja(cur_row + cur_diag) = i + j - 2 - end do - csr_tridiag_ia(i) = cur_row - end do ! i = 2...gr%nz-1 - - ! Handle boundary conditions for the tridiagonal matrix arrays - ! These conditions have been hand-calculated bearing in mind that the - ! matrix in question is tridiagonal. - - ! Make sure we don't crash if someone sets up gr%nz as 1. - if ( gr%nz > 1 ) then - ! Lower boundaries - csr_tridiag_ja(1) = 1 - csr_tridiag_ja(2) = 2 - csr_tridiag_ia(1) = 1 - - ! Upper boundaries - csr_tridiag_ja(tridiag_ja_size - 1) = gr%nz - 1 - csr_tridiag_ja(tridiag_ja_size) = gr%nz - csr_tridiag_ia(ia_size - 1) = tridiag_ja_size - 1 - - ! This final boundary is to signify the end of the matrix, and is - ! intended to be beyond the bound of the ja array. - csr_tridiag_ia(ia_size) = tridiag_ja_size + 1 - end if ! gr%nz > 1 - - ! Initialize the 5-band matrix arrays - num_bands = 5 - do i = 3, (gr%nz - 2), 1 - - ! Full 5-band matrix has 5 diagonals to initialize - num_diags = 5 - cur_row = num_diags * (i - 1) - do j = 1, num_diags, 1 - cur_diag = j - 3 - csr_banddiag5_12345_ja(cur_row + cur_diag) = i + cur_diag - end do - - csr_banddiag5_12345_ia(i) = cur_row - 2 - - ! 5-band matrix with 2 zero bands has 3 diagonals to initialize - num_diags = 3 - cur_row = num_diags * (i - 1) - do j = 1, num_diags, 1 - cur_diag = j - 2 - ! The first upper and first lower bands are zero, so there needs to be - ! special handling to account for this. The j * 2 takes into account - ! the spaces between diagonals. - csr_banddiag5_135_ja(cur_row + cur_diag) = i + ((j * 2) - 1) - num_diags - end do - - csr_banddiag5_135_ia(i) = cur_row - 1 - - end do ! i = 3...gr%nz-2 - - ! Handle boundary conditions for the 5-band matrix arrays - ! These values have been hand-calculated bearing in mind the two different - ! types of 5-band matrices. - - ! Make sure we don't crash if someone sets up gr%nz as less than 3. - if ( gr%nz > 2 ) then - - ! -------------- (full) 5-band matrix boundaries --------------- - - ! Lower boundaries for the (full) 5-band matrix. - do i = 1, 3, 1 - csr_banddiag5_12345_ja(i) = i - end do - do i = 1, 4, 1 - csr_banddiag5_12345_ja(i + 3) = i - end do - csr_banddiag5_12345_ia(1) = 1 - csr_banddiag5_12345_ia(2) = 4 - - ! Upper boundaries for the (full) 5-band matrix. - ! 7 and 3 are the number of elements from the "end" of the matrix if we - ! travel right to left, bottom up. Because the ja matrices correspond to - ! the column the element is in, we go 3 or 4 elements from the end for the - ! second to last row (both superdiagonals absent on last row), - ! and 3 for the last row (both superdiagonals absent). The indices are - ! similarly calculated, except that in the case of the second to last - ! row, it is necessary to offset for the last row as well (hence, - ! 7 = 4+3). - do i = 1, 4, 1 - csr_banddiag5_12345_ja(band12345_ja_size - 7 + i) = gr%nz + i - 4 - end do - do i = 1, 3, 1 - csr_banddiag5_12345_ja(band12345_ja_size - 3 + i) = gr%nz + i - 3 - end do - csr_banddiag5_12345_ia(ia_size - 2) = band12345_ja_size - 6 - csr_banddiag5_12345_ia(ia_size - 1) = band12345_ja_size - 2 - - ! This final boundary is to signify the end of the matrix, and is - ! intended to be beyond the bound of the ja array. - csr_banddiag5_12345_ia(ia_size) = band12345_ja_size + 1 - - ! ------------ end (full) 5-band matrix boundaries --------------- - - ! --------- 5-band matrix w/ empty first bands boundaries ---------- - - ! Lower boundaries for the 5-band w/ empty first bands matrix - ! The 2 * i is present because of the space between the main diagonal - ! and the superdiagonal that actually have nonzero values. - do i = 1, 2, 1 - csr_banddiag5_135_ja(i) = (2 * i) - 1 - csr_banddiag5_135_ja(i + 2) = (2 * i) - csr_banddiag5_135_ia(i) = (2 * i) - 1 - end do - - ! Upper boundaries for the 5-band w/ empty first bands matrix - ! The values for the boundaries are tricky, as the indices and values - ! are not equal. The indices are 2 and 4 away from the end, as there are - ! only two nonzero values at the two final rows. - ! The values, on the other hand, are different, because of the - ! aforementioned space, this time between the main and subdiagonal. - do i = 1, 2, 1 - csr_banddiag5_135_ja(band135_ja_size - 4 + i) = gr%nz + (i * 2) - 5 - csr_banddiag5_135_ja(band135_ja_size - 2 + i) = gr%nz + (i * 2) - 4 - end do - csr_banddiag5_135_ia(ia_size - 2) = band135_ja_size - 3 - csr_banddiag5_135_ia(ia_size - 1) = band135_ja_size + 1 - - ! This final boundary is to signify the end of the matrix, and is - ! intended to be beyond the bound of the ja array. - csr_banddiag5_135_ia(ia_size) = band135_ja_size + 1 - - ! ------- end 5-band matrix w/ empty first bands boundaries -------- - - end if ! gr%nz > 2 - - ! Initialize the interlaced arrays--all of them are 5-band right now. - num_bands = 5 - - ! Our counter starts at 2--this is used for the 3/5 interlaced matrices. - ! We start at 2 so when we enter the odd row and increment by 5, - ! it becomes 7. - counter = 2 - - do i = 3, ((gr%nz * 2) - 2), 1 - if (mod( i,2 ) == 1) then - ! Odd row, this is the potentially non 5-band row. - ! Increment counter. Last row was an even row, so we'll need to add 5. - counter = counter + 5 - - ! For our tridiag and spaced 3-band arrays, this will be a - ! 3-diagonal row. - num_diags = 3 - cur_row = counter + 1 - do j = 1, num_diags, 1 - cur_diag = j - 2 - csr_intlc_s3b_f5b_ja(cur_row + cur_diag) & - = i + ((j * 2) - 1) - num_diags - csr_intlc_trid_5b_ja(cur_row + cur_diag) = i + cur_diag - end do - csr_intlc_s3b_f5b_ia(i) = counter - csr_intlc_trid_5b_ia(i) = counter - - ! For our 5-band interlaced-size array, this will be a - ! 5-diagonal row (obviously!). - num_diags = 5 - cur_row = num_diags * (i - 1) - do j = 1, num_diags, 1 - cur_diag = j - 3 - csr_intlc_5b_5b_ja(cur_row + cur_diag) = i + cur_diag - end do - - csr_intlc_5b_5b_ia(i) = cur_row - 2 - - else - ! Even row, this is the "guaranteed" 5-band row. - ! Increment counter. Last row was an odd row, so we'll need to add 3. - counter = counter + 3 - - ! For our tridiag and spaced 3-band arrays, this will be a - ! 5-diagonal row. - num_diags = 5 - cur_row = counter + 2 - do j = 1, num_diags, 1 - cur_diag = j - 3 - csr_intlc_s3b_f5b_ja(cur_row + cur_diag) = i + cur_diag - csr_intlc_trid_5b_ja(cur_row + cur_diag) = i + cur_diag - end do - - csr_intlc_s3b_f5b_ia(i) = counter - csr_intlc_trid_5b_ia(i) = counter - - ! For our 5-band "interlaced" array, this will also be a - ! 5-diagonal row. However, we need to change the cur_row to match - ! what we're expecting for the 5-band. - num_diags = 5 - cur_row = num_diags * (i - 1) - do j = 1, num_diags, 1 - cur_diag = j - 3 - csr_intlc_5b_5b_ja(cur_row + cur_diag) = i + cur_diag - end do - - csr_intlc_5b_5b_ia(i) = cur_row - 2 - - end if ! mod(i,2) == 1 - end do ! i = 3...(gr%nz*2)-2 - - ! Handle boundary conditions for the interlaced matrix arrays - ! These conditions have been hand-calculated bearing in mind - ! the structure of the interlaced matrices. - - ! Make sure we don't crash if someone sets up gr%nz as less than 3. - if (gr%nz > 2) then - ! Lower boundaries - - ! First row - do i = 1, 2, 1 - csr_intlc_s3b_f5b_ja(i) = (i * 2) - 1 - csr_intlc_trid_5b_ja(i) = i - end do - do i = 1, 3, 1 - csr_intlc_5b_5b_ja(i) = i - end do - csr_intlc_s3b_f5b_ia(1) = 1 - csr_intlc_trid_5b_ia(1) = 1 - csr_intlc_5b_5b_ia(1) = 1 - - ! Second row - do i = 1, 4, 1 - csr_intlc_s3b_f5b_ja(i + 2) = i - csr_intlc_trid_5b_ja(i + 2) = i - csr_intlc_5b_5b_ja(i + 3) = i - end do - csr_intlc_s3b_f5b_ia(2) = 3 - csr_intlc_trid_5b_ia(2) = 3 - csr_intlc_5b_5b_ia(2) = 4 - - ! Upper boundaries - - ! Last two rows - ! Note that in comparison to the other upper boundaries, we have to use - ! intlc_ia_size - 1 for our upper index limit as the matrix is - ! double-sized. - - ! Second-to-last row - do i = 1, 2, 1 - csr_intlc_s3b_f5b_ja(intlc_s3d_5d_ja_size - 5 + i) & - = intlc_ia_size - 1 + (i * 2) - 5 - end do - do i = 1, 3, 1 - csr_intlc_trid_5b_ja(intlc_td_5d_ja_size - 6 + i) & - = intlc_ia_size - 1 + i - 3 - end do - do i = 1, 4, 1 - csr_intlc_5b_5b_ja(intlc_5d_5d_ja_size - 7 + i) & - = intlc_ia_size-1 + i - 4 - end do - - ! Last row - do i = 1, 3, 1 - csr_intlc_s3b_f5b_ja(intlc_s3d_5d_ja_size - 3 + i) & - = intlc_ia_size-1 + i - 3 - csr_intlc_trid_5b_ja(intlc_td_5d_ja_size - 3 + i) & - = intlc_ia_size-1 + i - 3 - csr_intlc_5b_5b_ja(intlc_5d_5d_ja_size - 3 + i) & - = intlc_ia_size-1 + i - 3 - end do - - ! Lastly, take care of the ia arrays. - csr_intlc_s3b_f5b_ia(intlc_ia_size - 2) = intlc_s3d_5d_ja_size - 4 - csr_intlc_s3b_f5b_ia(intlc_ia_size - 1) = intlc_s3d_5d_ja_size - 2 - csr_intlc_s3b_f5b_ia(intlc_ia_size) = intlc_s3d_5d_ja_size + 1 - - csr_intlc_trid_5b_ia(intlc_ia_size - 2) = intlc_td_5d_ja_size - 5 - csr_intlc_trid_5b_ia(intlc_ia_size - 1) = intlc_td_5d_ja_size - 2 - csr_intlc_trid_5b_ia(intlc_ia_size) = intlc_td_5d_ja_size + 1 - - csr_intlc_5b_5b_ia(intlc_ia_size - 2) = intlc_5d_5d_ja_size - 6 - csr_intlc_5b_5b_ia(intlc_ia_size - 1) = intlc_5d_5d_ja_size - 2 - csr_intlc_5b_5b_ia(intlc_ia_size) = intlc_5d_5d_ja_size + 1 - - - end if ! gr%nz > 2 - - ! Enable printing the ia/ja arrays for debug purposes - l_print_ia_ja = .false. - if (l_print_ia_ja) then - do i = 1, ia_size, 1 - print *, "tridiag ia idx", i, "=", csr_tridiag_ia(i) - print *, "banddiag12345 ia idx", i, "=", csr_banddiag5_12345_ia(i) - print *, "banddiag135 ia idx", i, "=", csr_banddiag5_135_ia(i) - end do - do i = 1, intlc_ia_size, 1 - print *, "interlaced tridiag w/ 5-band ia idx", i, & - "=", csr_intlc_trid_5b_ia(i) - print *, "interlaced spaced-3-band+5-band ia idx", i, & - "=", csr_intlc_s3b_f5b_ia(i) - print *, "interlaced 5-band w/ 5-band ia idx", i, "=", & - csr_intlc_5b_5b_ia(i) - end do - do i = 1, tridiag_ja_size, 1 - print *, "tridiag ja idx", i, "=", csr_tridiag_ja(i) - end do - do i = 1, band12345_ja_size, 1 - print *, "band12345 ja idx", i, "=", csr_banddiag5_12345_ja(i) - end do - do i = 1, band135_ja_size, 1 - print *, "band135 ja idx", i, "=", csr_banddiag5_135_ja(i) - end do - do i = 1, intlc_td_5d_ja_size, 1 - print *, "interlaced tridiag w/ 5-band ja idx", i, & - "=", csr_intlc_trid_5b_ja(i) - end do - do i = 1, intlc_s3d_5d_ja_size, 1 - print *, "interlaced spaced-3-band+5-band ja idx", i, & - "=", csr_intlc_s3b_f5b_ja(i) - end do - do i = 1, intlc_5d_5d_ja_size, 1 - print *, "interlaced 5-band w/ 5-band ja idx", i, "=", & - csr_intlc_5b_5b_ja(i) - end do - end if ! l_print_ia_ja - - end subroutine initialize_csr_class - -end module crmx_csr_matrix_class diff --git a/src/physics/spcam/crm/CLUBB/crmx_diagnose_correlation_module.f90 b/src/physics/spcam/crm/CLUBB/crmx_diagnose_correlation_module.f90 deleted file mode 100644 index 1160134ab3..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_diagnose_correlation_module.f90 +++ /dev/null @@ -1,489 +0,0 @@ -! $Id$ -module crmx_diagnose_correlations_module - - use crmx_clubb_precision, only: & - core_rknd - - implicit none - - public :: diagnose_KK_corr, diagnose_LH_corr, & - calc_mean, calc_varnce, calc_w_corr - - - private :: diagnose_corr - - - contains - -!----------------------------------------------------------------------- - subroutine diagnose_KK_corr( Ncm, rrainm, Nrm, & ! intent(in) - Ncp2_on_Ncm2, rrp2_on_rrm2, Nrp2_on_Nrm2, & - corr_ws, corr_wrr, corr_wNr, corr_wNc, & - pdf_params, & - corr_rrNr_p, corr_srr_p, corr_sNr_p, corr_sNc_p, & - corr_rrNr, corr_srr, corr_sNr, corr_sNc ) ! intent(inout) - - ! Description: - ! This subroutine diagnoses the correlation matrix in order to feed it - ! into KK microphysics. - - ! References: - ! Larson et al. (2011), J. of Geophysical Research, Vol. 116, D00T02 - ! (see CLUBB-Trac:ticket:514) - !----------------------------------------------------------------------- - - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_pdf_parameter_module, only: & - pdf_parameter ! Type - - use crmx_constants_clubb, only: & - w_tol, & ! [m/s] - s_mellor_tol, & ! [kg/kg] - Nc_tol, & ! [num/kg] - rr_tol, & ! [kg/kg] - Nr_tol ! [num/kg] - - use crmx_stats_type, only: & - stat_update_var_pt ! Procedure(s) - - implicit none - - intrinsic :: sqrt - - ! Local Constants - integer, parameter :: & - n_variables = 5 - - ! Input Variables - - real( kind = core_rknd ), intent(in) :: & - Ncm, & ! Cloud droplet number conc. [num/kg] - rrainm, & ! rain water mixing ratio [kg/kg] - Nrm, & ! Mean rain drop concentration [num/kg] - Ncp2_on_Ncm2, & ! Variance of Nc divided by Ncm^2 [-] - rrp2_on_rrm2, & ! Variance of rrain divided by rrainm^2 [-] - Nrp2_on_Nrm2, & ! Variance of Nr divided by Nrm^2 [-] - corr_ws, & ! Correlation between s_mellor and w [-] - corr_wrr, & ! Correlation between rrain and w [-] - corr_wNr, & ! Correlation between Nr and w [-] - corr_wNc, & ! Correlation between Nc and w [-] - corr_rrNr_p, & ! Prescribed correlation between rrain and Nr [-] - corr_srr_p, & ! Prescribed correlation between s and rrain [-] - corr_sNr_p, & ! Prescribed correlation between s and Nr [-] - corr_sNc_p ! Prescribed correlation between s and Nc [-] - - type(pdf_parameter), intent(in) :: & - pdf_params ! PDF parameters [units vary] - - ! Input/Output Variables - real( kind = core_rknd ), intent(inout) :: & - corr_rrNr, & ! Correlation between rrain and Nr [-] - corr_srr, & ! Correlation between s and rrain [-] - corr_sNr, & ! Correlation between s and Nr [-] - corr_sNc ! Correlation between s and Nc [-] - - - - ! Local Variables - real( kind = core_rknd ), dimension(n_variables, n_variables) :: & - corr_matrix_approx, & ! [-] - corr_matrix_prescribed ! [-] - - real( kind = core_rknd ), dimension(n_variables) :: & - sqrt_xp2_on_xm2, & ! sqrt of x_variance / x_mean^2 [units vary] - xm ! means of the hydrometeors [units vary] - - ! Indices of the hydrometeors - integer :: & - ii_w = 1, & - ii_s = 2, & - ii_rrain = 3, & - ii_Nr = 4, & - ii_Nc = 5 - - integer :: i, j ! Loop Iterators - - - !-------------------- Begin code -------------------- - - ! set up xp2_on_xm2 - - ! TODO Why is wp2_on_wm2=1 - ! S_i is set to 1 for s_mellor and w, because s_mellorm could be 0 - sqrt_xp2_on_xm2(ii_w) = 1._core_rknd - sqrt_xp2_on_xm2(ii_s) = 1._core_rknd - - sqrt_xp2_on_xm2(ii_rrain) = sqrt(rrp2_on_rrm2) - sqrt_xp2_on_xm2(ii_Nr) = sqrt(Nrp2_on_Nrm2) - sqrt_xp2_on_xm2(ii_Nc) = sqrt(Ncp2_on_Ncm2) - - ! initialize the correlation matrix with 0 - do i=1, n_variables - do j=1, n_variables - corr_matrix_approx(i,j) = 0._core_rknd - corr_matrix_prescribed(i,j) = 0._core_rknd - end do - end do - - ! set diagonal of the correlation matrix to 1 - do i = 1, n_variables - corr_matrix_approx(i,i) = 1._core_rknd - corr_matrix_prescribed(i,i) = 1._core_rknd - end do - - - ! set the first row to the corresponding prescribed correlations - corr_matrix_approx(ii_s,1) = corr_ws - corr_matrix_approx(ii_rrain,1) = corr_wrr - corr_matrix_approx(ii_Nr,1) = corr_wNr - corr_matrix_approx(ii_Nc,1) = corr_wNc - - !corr_matrix_prescribed = corr_matrix_approx - - ! set up the prescribed correlation matrix - if( ii_rrain > ii_Nr ) then - corr_matrix_prescribed(ii_rrain, ii_Nr) = corr_rrNr_p - else - corr_matrix_prescribed(ii_Nr, ii_rrain) = corr_rrNr_p - end if - - if ( ii_s > ii_rrain ) then - corr_matrix_prescribed(ii_s, ii_rrain) = corr_srr_p - else - corr_matrix_prescribed(ii_rrain, ii_s) = corr_srr_p - end if - - if ( ii_s > ii_Nr ) then - corr_matrix_prescribed(ii_s, ii_Nr) = corr_sNr_p - else - corr_matrix_prescribed(ii_Nr, ii_s) = corr_sNr_p - end if - - if ( ii_s > ii_Nc ) then - corr_matrix_prescribed(ii_s, ii_Nc) = corr_sNc_p - else - corr_matrix_prescribed(ii_Nc, ii_s) = corr_sNc_p - end if - - call diagnose_corr( n_variables, sqrt_xp2_on_xm2, corr_matrix_prescribed, & !intent(in) - corr_matrix_approx ) ! intent(inout) - - if( ii_rrain > ii_Nr ) then - corr_rrNr = corr_matrix_approx(ii_rrain, ii_Nr) - else - corr_rrNr = corr_matrix_approx(ii_Nr, ii_rrain) - end if - - if ( ii_s > ii_rrain ) then - corr_srr = corr_matrix_approx(ii_s, ii_rrain) - else - corr_srr = corr_matrix_approx(ii_rrain, ii_s) - end if - - if ( ii_s > ii_Nr ) then - corr_sNr = corr_matrix_approx(ii_s, ii_Nr) - else - corr_sNr = corr_matrix_approx(ii_Nr, ii_s) - end if - - if ( ii_s > ii_Nc ) then - corr_sNc = corr_matrix_approx(ii_s, ii_Nc) - else - corr_sNc = corr_matrix_approx(ii_Nc, ii_s) - end if - - end subroutine diagnose_KK_corr - -!----------------------------------------------------------------------- - subroutine diagnose_LH_corr( xp2_on_xm2, d_variables, corr_matrix_prescribed, & !intent(in) - corr_array ) ! intent(inout) - - ! Description: - ! This subroutine diagnoses the correlation matrix in order to feed it - ! into SILHS microphysics. - - ! References: - ! Larson et al. (2011), J. of Geophysical Research, Vol. 116, D00T02 - ! (see CLUBB Trac ticket#514) - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_corr_matrix_module, only: & - iiLH_w ! Variable(s) - - implicit none - - intrinsic :: max, sqrt, transpose - - ! Input Variables - integer, intent(in) :: d_variables - - real( kind = core_rknd ), dimension(d_variables, d_variables), intent(in) :: & - corr_matrix_prescribed - - real( kind = core_rknd ), dimension(d_variables), intent(in) :: & - xp2_on_xm2 ! ratios of x_variance over x_mean^2 - - ! Input/Output variables - real( kind = core_rknd ), dimension(d_variables, d_variables), intent(inout) :: & - corr_array - - ! Local Variables - real( kind = core_rknd ), dimension(d_variables, d_variables) :: & - corr_matrix_pre_swapped - - real( kind = core_rknd ), dimension(d_variables) :: & - swap_array - - !-------------------- Begin code -------------------- - - ! Swap the w-correlations to the first row - swap_array = corr_array(:, 1) - corr_array(1:iiLH_w, 1) = corr_array(iiLH_w, iiLH_w:1:-1) - corr_array((iiLH_w+1):d_variables, 1) = corr_array((iiLH_w+1):d_variables, iiLH_w) - corr_array(iiLH_w, 1:iiLH_w) = swap_array(iiLH_w:1:-1) - corr_array((iiLH_w+1):d_variables, iiLH_w) = swap_array((iiLH_w+1):d_variables) - - corr_matrix_pre_swapped = corr_matrix_prescribed - swap_array = corr_matrix_pre_swapped (:,1) - corr_matrix_pre_swapped(1:iiLH_w, 1) = corr_matrix_pre_swapped(iiLH_w, iiLH_w:1:-1) - corr_matrix_pre_swapped((iiLH_w+1):d_variables, 1) = corr_matrix_pre_swapped( & - (iiLH_w+1):d_variables, iiLH_w) - corr_matrix_pre_swapped(iiLH_w, 1:iiLH_w) = swap_array(iiLH_w:1:-1) - corr_matrix_pre_swapped((iiLH_w+1):d_variables, iiLH_w) = swap_array((iiLH_w+1):d_variables) - - ! diagnose correlations - call diagnose_corr( d_variables, sqrt(xp2_on_xm2), corr_matrix_pre_swapped, & - corr_array) - - ! Swap rows back - swap_array = corr_array(:, 1) - corr_array(1:iiLH_w, 1) = corr_array(iiLH_w, iiLH_w:1:-1) - corr_array((iiLH_w+1):d_variables, 1) = corr_array((iiLH_w+1):d_variables, iiLH_w) - corr_array(iiLH_w, 1:iiLH_w) = swap_array(iiLH_w:1:-1) - corr_array((iiLH_w+1):d_variables, iiLH_w) = swap_array((iiLH_w+1):d_variables) - - end subroutine diagnose_LH_corr - -!----------------------------------------------------------------------- - subroutine diagnose_corr( n_variables, sqrt_xp2_on_xm2, corr_matrix_prescribed, & !intent(in) - corr_matrix_approx ) ! intent(inout) - - ! Description: - ! This subroutine diagnoses the correlation matrix for each timestep. - - ! References: - ! Larson et al. (2011), J. of Geophysical Research, Vol. 116, D00T02 - ! (see CLUBB Trac ticket#514) - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_parameters_tunable, only: & - alpha_corr ! Constant(s) - - use crmx_constants_clubb, only: & - max_mag_correlation - - implicit none - - intrinsic :: & - sqrt, abs, sign - - ! Input Variables - integer, intent(in) :: & - n_variables ! number of variables in the correlation matrix [-] - - real( kind = core_rknd ), dimension(n_variables), intent(in) :: & - sqrt_xp2_on_xm2 ! sqrt of x_variance / x_mean^2 [units vary] - - real( kind = core_rknd ), dimension(n_variables,n_variables), intent(in) :: & - corr_matrix_prescribed ! correlation matrix [-] - - ! Input/Output Variables - real( kind = core_rknd ), dimension(n_variables,n_variables), intent(inout) :: & - corr_matrix_approx ! correlation matrix [-] - - - ! Local Variables - integer :: i, j ! Loop iterator - - real( kind = core_rknd ) :: & - f_ij, & - f_ij_o - - real( kind = core_rknd ), dimension(n_variables) :: & - s_1j ! s_1j = sqrt(1-c_1j^2) - - - !-------------------- Begin code -------------------- - - ! calculate all square roots - do i = 1, n_variables - - s_1j(i) = sqrt(1._core_rknd-corr_matrix_approx(i,1)**2) - - end do - - - ! Diagnose the missing correlations (upper triangle) - do j = 2, (n_variables-1) - do i = (j+1), n_variables - - ! formula (16) in the ref. paper (Larson et al. (2011)) - !f_ij = alpha_corr * sqrt_xp2_on_xm2(i) * sqrt_xp2_on_xm2(j) & - ! * sign(1.0_core_rknd,corr_matrix_approx(1,i)*corr_matrix_approx(1,j)) - - ! If the predicting c1i's are small then cij will be closer to the prescribed value. If - ! the c1i's are bigger, then cij will be closer to formular (15) from the ref. paper. See - ! clubb:ticket:514:comment:61 for details. - !f_ij = (1-abs(corr_matrix_approx(1,i)*corr_matrix_approx(1,j)))*corr_matrix_prescribed(i,j) & - ! + abs(corr_matrix_approx(1,i)*corr_matrix_approx(1,j))*f_ij_o - - f_ij = corr_matrix_prescribed(i,j) - - ! make sure -1 < f_ij < 1 - if ( f_ij < -max_mag_correlation ) then - - f_ij = -max_mag_correlation - - else if ( f_ij > max_mag_correlation ) then - - f_ij = max_mag_correlation - - end if - - - ! formula (15) in the ref. paper (Larson et al. (2011)) - corr_matrix_approx(i,j) = corr_matrix_approx(i,1) * corr_matrix_approx(j,1) & - + f_ij * s_1j(i) * s_1j(j) - - end do ! do j - end do ! do i - - end subroutine diagnose_corr - - !----------------------------------------------------------------------- - function calc_w_corr( wpxp, stdev_w, stdev_x, w_tol, x_tol ) - ! Description: - ! Compute the correlations of w with the hydrometeors. - - ! References: - ! clubb:ticket:514 - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_constants_clubb, only: & - max_mag_correlation - - implicit none - - intrinsic :: max - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - stdev_w, & ! standard deviation of w [m/s] - stdev_x, & ! standard deviation of x [units vary] - wpxp, & ! Covariances of w with the hydrometeors [units vary] - w_tol, & ! tolerance for w [m/s] - x_tol ! tolerance for x [units vary] - - real( kind = core_rknd ) :: & - calc_w_corr - - ! --- Begin Code --- - - calc_w_corr = wpxp / ( max(stdev_x, x_tol) * max(stdev_w, w_tol) ) - - ! Make sure the correlation is in [-1,1] - if ( calc_w_corr < -max_mag_correlation ) then - - calc_w_corr = -max_mag_correlation - - else if ( calc_w_corr > max_mag_correlation ) then - - calc_w_corr = max_mag_correlation - - end if - - end function calc_w_corr - - - !----------------------------------------------------------------------- - function calc_varnce( mixt_frac, x1, x2, xm, x1p2, x2p2 ) - - ! Description: - ! Calculate the variance xp2 from the components x1, x2. - - ! References: - ! Larson et al. (2011), J. of Geophysical Research, Vol. 116, D00T02, - ! page 3535 - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - mixt_frac, & ! mixing ratio [-] - x1, & ! first component of the double gaussian [units vary] - x2, & ! second component of the double gaussian [units vary] - xm, & ! mean of x [units vary] - x1p2, & ! variance of the first component [units vary] - x2p2 ! variance of the second component [units vary] - - ! Return Variable - real( kind = core_rknd ) :: & - calc_varnce ! variance of x (both components) [units vary] - - ! --- Begin Code --- - - calc_varnce = mixt_frac * ((x1 - xm)**2 + x1p2) + (1.0_core_rknd - mixt_frac) * ((x2 - xm)**2 + x2p2) - - return - end function calc_varnce - - !----------------------------------------------------------------------- - function calc_mean( mixt_frac, x1, x2 ) - - ! Description: - ! Calculate the mean xm from the components x1, x2. - - ! References: - ! Larson et al. (2011), J. of Geophysical Research, Vol. 116, D00T02, - ! page 3535 - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - mixt_frac, & ! mixing ratio [-] - x1, & ! first component of the double gaussian [units vary] - x2 ! second component of the double gaussian [units vary] - - ! Return Variable - real( kind = core_rknd ) :: & - calc_mean ! mean of x (both components) [units vary] - - ! --- Begin Code --- - - calc_mean = mixt_frac * x1 + (1.0_core_rknd - mixt_frac) * x2 - - return - end function calc_mean - -end module crmx_diagnose_correlations_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_diffusion.F90 b/src/physics/spcam/crm/CLUBB/crmx_diffusion.F90 deleted file mode 100644 index 75956e82d6..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_diffusion.F90 +++ /dev/null @@ -1,800 +0,0 @@ -! $Id: diffusion.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -!=============================================================================== -module crmx_diffusion - - ! Description: - ! Module diffusion computes the eddy diffusion terms for all of the - ! time-tendency (prognostic) equations in the CLUBB parameterization. Most of - ! the eddy diffusion terms are solved for completely implicitly, and therefore - ! become part of the left-hand side of their respective equations. However, - ! wp2 and wp3 have an option to use a Crank-Nicholson eddy diffusion scheme, - ! which has both implicit and explicit components. - ! - ! Function diffusion_zt_lhs handles the eddy diffusion terms for the variables - ! located at thermodynamic grid levels. These variables are: wp3 and all - ! hydrometeor species. The variables um and vm also use the Crank-Nicholson - ! eddy-diffusion scheme for their turbulent advection term. - ! - ! Function diffusion_zm_lhs handles the eddy diffusion terms for the variables - ! located at momentum grid levels. The variables are: wprtp, wpthlp, wp2, - ! rtp2, thlp2, rtpthlp, up2, vp2, wpsclrp, sclrprtp, sclrpthlp, and sclrp2. - - implicit none - - private ! Default Scope - - public :: diffusion_zt_lhs, & - diffusion_cloud_frac_zt_lhs, & - diffusion_zm_lhs - - contains - - !============================================================================= - pure function diffusion_zt_lhs( K_zm, K_zmm1, nu, & - invrs_dzmm1, invrs_dzm, & - invrs_dzt, level ) & - result( lhs ) - - ! Description: - ! Vertical eddy diffusion of var_zt: implicit portion of the code. - ! - ! The variable "var_zt" stands for a variable that is located at - ! thermodynamic grid levels. - ! - ! The d(var_zt)/dt equation contains an eddy diffusion term: - ! - ! + d [ ( K_zm + nu ) * d(var_zt)/dz ] / dz. - ! - ! This term is usually solved for completely implicitly, such that: - ! - ! + d [ ( K_zm + nu ) * d( var_zt(t+1) )/dz ] / dz. - ! - ! However, when a Crank-Nicholson scheme is used, the eddy diffusion term - ! has both implicit and explicit components, such that: - ! - ! + (1/2) * d [ ( K_zm + nu ) * d( var_zt(t+1) )/dz ] / dz - ! + (1/2) * d [ ( K_zm + nu ) * d( var_zt(t) )/dz ] / dz; - ! - ! for which the implicit component is: - ! - ! + (1/2) * d [ ( K_zm + nu ) * d( var_zt(t+1) )/dz ] / dz. - ! - ! Note: When the implicit term is brought over to the left-hand side, - ! the sign is reversed and the leading "+" in front of the term - ! is changed to a "-". - ! - ! Timestep index (t) stands for the index of the current timestep, while - ! timestep index (t+1) stands for the index of the next timestep, which is - ! being advanced to in solving the d(var_zt)/dt equation. - ! - ! The implicit portion of this term is discretized as follows: - ! - ! The values of var_zt are found on the thermodynamic levels, while the - ! values of K_zm are found on the momentum levels. The derivatives (d/dz) - ! of var_zt are taken over the intermediate momentum levels. At the - ! intermediate momentum levels, d(var_zt)/dz is multiplied by ( K_zm + nu ). - ! Then, the derivative of the whole mathematical expression is taken over - ! the central thermodynamic level, which yields the desired result. - ! - ! --var_ztp1----------------------------------------------- t(k+1) - ! - ! ==========d(var_zt)/dz==(K_zm+nu)======================== m(k) - ! - ! --var_zt-------------------d[(K_zm+nu)*d(var_zt)/dz]/dz-- t(k) - ! - ! ==========d(var_zt)/dz==(K_zmm1+nu)====================== m(k-1) - ! - ! --var_ztm1----------------------------------------------- t(k-1) - ! - ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond - ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively. - ! The letter "t" is used for thermodynamic levels and the letter "m" is used - ! for momentum levels. - ! - ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) - ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) - ! invrs_dzm(k-1) = 1 / ( zt(k) - zt(k-1) ) - ! - ! Note: This function only computes the general implicit form: - ! + d [ ( K_zm + nu ) * d( var_zt(t+1) )/dz ] / dz. - ! For a Crank-Nicholson scheme, the left-hand side result of this - ! function will have to be multiplied by (1/2). For a - ! Crank-Nicholson scheme, the right-hand side (explicit) component - ! needs to be computed by multiplying the left-hand side results by - ! (1/2), reversing the sign on each left-hand side element, and then - ! multiplying each element by the appropriate var_zt(t) value from - ! the appropriate vertical level. - ! - ! - ! Boundary Conditions: - ! - ! 1) Zero-flux boundary conditions. - ! This function is set up to use zero-flux boundary conditions at both - ! the lower boundary level and the upper boundary level. The flux, F, - ! is the amount of var_zt flowing normal through the boundary per unit - ! time per unit surface area. The derivative of the flux effects the - ! time-tendency of var_zt, such that: - ! - ! d(var_zt)/dt = -dF/dz. - ! - ! For the 2nd-order eddy-diffusion term, +d[(K_zm+nu)*d(var_zt)/dz]/dz, - ! the flux is: - ! - ! F = -(K_zm+nu)*d(var_zt)/dz. - ! - ! In order to have zero-flux boundary conditions, the derivative of - ! var_zt, d(var_zt)/dz, needs to equal 0 at both the lower boundary and - ! the upper boundary. - ! - ! In order to discretize the lower boundary condition, consider a new - ! level outside the model (thermodynamic level 0) just below the lower - ! boundary level (thermodynamic level 1). The value of var_zt at the - ! level just outside the model is defined to be the same as the value of - ! var_zt at the lower boundary level. Therefore, the value of - ! d(var_zt)/dz between the level just outside the model and the lower - ! boundary level is 0, satisfying the zero-flux boundary condition. The - ! other value for d(var_zt)/dz (between thermodynamic level 2 and - ! thermodynamic level 1) is taken over the intermediate momentum level - ! (momentum level 1), where it is multiplied by the factor - ! ( K_zm(1) + nu ). Then, the derivative of the whole expression is - ! taken over the central thermodynamic level. - ! - ! -var_zt(2)-------------------------------------------- t(2) - ! - ! ==========d(var_zt)/dz==(K_zm(1)+nu)================== m(1) - ! - ! -var_zt(1)---------------d[(K_zm+nu)*d(var_zt)/dz]/dz- t(1) Boundary - ! - ! [d(var_zt)/dz = 0] - ! - ! -[var_zt(0) = var_zt(1)]-----(level outside model)---- t(0) - ! - ! The result is dependent only on values of K_zm found at momentum - ! level 1 and values of var_zt found at thermodynamic levels 1 and 2. - ! Thus, it only affects 2 diagonals on the left-hand side matrix. - ! - ! The same method can be used to discretize the upper boundary by - ! considering a new level outside the model just above the upper boundary - ! level. - ! - ! 2) Fixed-point boundary conditions. - ! Many equations in the model use fixed-point boundary conditions rather - ! than zero-flux boundary conditions. This means that the value of - ! var_zt stays the same over the course of the timestep at the lower - ! boundary, as well as at the upper boundary. - ! - ! In order to discretize the boundary conditions for equations requiring - ! fixed-point boundary conditions, either: - ! a) in the parent subroutine or function (that calls this function), - ! loop over all vertical levels from the second-lowest to the - ! second-highest, ignoring the boundary levels. Then set the values - ! at the boundary levels in the parent subroutine; or - ! b) in the parent subroutine or function, loop over all vertical levels - ! and then overwrite the results at the boundary levels. - ! - ! Either way, at the boundary levels, an array with a value of 1 at the - ! main diagonal on the left-hand side and with values of 0 at all other - ! diagonals on the left-hand side will preserve the right-hand side value - ! at that level, thus satisfying the fixed-point boundary conditions. - ! - ! - ! Conservation Properties: - ! - ! When zero-flux boundary conditions are used, this technique of - ! discretizing the eddy diffusion term leads to conservative differencing. - ! When conservative differencing is in place, the column totals for each - ! column in the left-hand side matrix (for the eddy diffusion term) should - ! be equal to 0. This ensures that the total amount of the quantity var_zt - ! over the entire vertical domain is being conserved, meaning that nothing - ! is lost due to diffusional effects. - ! - ! To see that this conservation law is satisfied, compute the eddy diffusion - ! of var_zt and integrate vertically. In discretized matrix notation (where - ! "i" stands for the matrix column and "j" stands for the matrix row): - ! - ! 0 = Sum_j Sum_i ( 1/invrs_dzt )_i - ! ( invrs_dzt * ((K_zm+nu)*invrs_dzm) )_ij (var_zt)_j. - ! - ! The left-hand side matrix, ( invrs_dzt * ((K_zm+nu)*invrs_dzm) )_ij, is - ! partially written below. The sum over i in the above equation removes - ! invrs_dzt everywhere from the matrix below. The sum over j leaves the - ! column totals that are desired. - ! - ! Left-hand side matrix contributions from eddy diffusion term; first four - ! vertical levels: - ! - ! --------------------------------------------------------------------------> - !k=1 | +invrs_dzt(k) -invrs_dzt(k) 0 - ! | *(K_zm(k)+nu) *(K_zm(k)+nu) - ! | *invrs_dzm(k) *invrs_dzm(k) - ! | - !k=2 | -invrs_dzt(k) +invrs_dzt(k) -invrs_dzt(k) - ! | *(K_zm(k-1)+nu) *[ (K_zm(k)+nu) *(K_zm(k)+nu) - ! | *invrs_dzm(k-1) *invrs_dzm(k) *invrs_dzm(k) - ! | +(K_zm(k-1)+nu) - ! | *invrs_dzm(k-1) ] - ! | - !k=3 | 0 -invrs_dzt(k) +invrs_dzt(k) - ! | *(K_zm(k-1)+nu) *[ (K_zm(k)+nu) - ! | *invrs_dzm(k-1) *invrs_dzm(k) - ! | +(K_zm(k-1)+nu) - ! | *invrs_dzm(k-1) ] - ! | - !k=4 | 0 0 -invrs_dzt(k) - ! | *(K_zm(k-1)+nu) - ! | *invrs_dzm(k-1) - ! \ / - ! - ! Note: The superdiagonal term from level 3 and both the main diagonal and - ! superdiagonal terms from level 4 are not shown on this diagram. - ! - ! Note: The matrix shown is a tridiagonal matrix. For a band diagonal - ! matrix (with 5 diagonals), there would be an extra row between each - ! of the rows shown and an extra column between each of the columns - ! shown. However, for the purposes of the var_zt eddy diffusion - ! term, those extra row and column values are all 0, and the - ! conservation properties of the matrix aren't effected. - ! - ! If fixed-point boundary conditions are used, the matrix entries at - ! level 1 (k=1) read: 1 0 0; which means that conservative differencing - ! is not in play. The total amount of var_zt over the entire vertical - ! domain is not being conserved, as amounts of var_zt may be fluxed out - ! through the upper boundary or lower boundary through the effects of - ! diffusion. - ! - ! Brian Griffin. April 26, 2008. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. - k_tdiag = 2, & ! Thermodynamic main diagonal index. - km1_tdiag = 3 ! Thermodynamic subdiagonal index. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - K_zm, & ! Coef. of eddy diffusivity at momentum level (k) [m^2/s] - K_zmm1, & ! Coef. of eddy diffusivity at momentum level (k-1) [m^2/s - invrs_dzt, & ! Inverse of grid spacing over thermo. level (k) [1/m] - invrs_dzm, & ! Inverse of grid spacing over momentum level (k) [1/m] - invrs_dzmm1 ! Inverse of grid spacing over momentum level (k-1) [1/m] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - nu ! Background constant coef. of eddy diffusivity [m^2/s] - - integer, intent(in) :: & - level ! Thermodynamic level where calculation occurs. [-] - - ! Return Variable - real( kind = core_rknd ), dimension(3) :: lhs - - if ( level == 1 ) then - - ! k = 1 (bottom level); lower boundary level. - ! Only relevant if zero-flux boundary conditions are used. - - ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) = - invrs_dzt * (K_zm+nu(1)) * invrs_dzm - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) = + invrs_dzt * (K_zm+nu(1)) * invrs_dzm - - ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) = 0.0_core_rknd - - - elseif ( level > 1 .and. level < gr%nz ) then - - ! Most of the interior model; normal conditions. - - ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) = - invrs_dzt * (K_zm+nu(level)) * invrs_dzm - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) = + invrs_dzt * ( (K_zm+nu(level))*invrs_dzm & - + (K_zmm1+nu(level))*invrs_dzmm1 ) - - ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) = - invrs_dzt * (K_zmm1+nu(level)) * invrs_dzmm1 - - elseif ( level == gr%nz ) then - - ! k = gr%nz (top level); upper boundary level. - ! Only relevant if zero-flux boundary conditions are used. - - ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) = 0.0_core_rknd - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) = + invrs_dzt * (K_zmm1+nu(gr%nz)) * invrs_dzmm1 - - ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) = - invrs_dzt * (K_zmm1+nu(gr%nz)) * invrs_dzmm1 - - - endif - - end function diffusion_zt_lhs - - !============================================================================= - pure function diffusion_cloud_frac_zt_lhs & - ( K_zm, K_zmm1, cloud_frac_zt, cloud_frac_ztm1, & - cloud_frac_ztp1, cloud_frac_zm, & - cloud_frac_zmm1, & - nu, invrs_dzmm1, invrs_dzm, invrs_dzt, level ) & - result( lhs ) - - ! Description: - ! This function adds a weight of cloud fraction to the existing diffusion - ! function for number concentration variables (e.g. cloud droplet number - ! concentration). This code should be considered experimental and may - ! contain bugs. - ! References: - ! This algorithm uses equations derived from Guo, et al. 2009. - !----------------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: min - - ! Constant parameters - real( kind = core_rknd ), parameter :: & - cf_ratio = 10._core_rknd ! Maximum cloud-fraction coefficient applied to Kh_zm - - integer, parameter :: & - kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. - k_tdiag = 2, & ! Thermodynamic main diagonal index. - km1_tdiag = 3 ! Thermodynamic subdiagonal index. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - K_zm, & ! Coef. of eddy diffusivity at mom. level (k) [m^2/s] - K_zmm1, & ! Coef. of eddy diffusivity at mom. level (k-1) [m^2/s] - cloud_frac_zt, & ! Cloud fraction at the thermo. level (k) [-] - cloud_frac_ztm1, & ! Cloud fraction at the thermo. level (k-1) [-] - cloud_frac_ztp1, & ! Cloud fraction at the thermo. level (k+1) [-] - cloud_frac_zm, & ! Cloud fraction at the momentum level (k) [-] - cloud_frac_zmm1, & ! Cloud fraction at the momentum level (k-1) [-] - invrs_dzt, & ! Inverse of grid spacing over thermo. lev. (k) [1/m] - invrs_dzm, & ! Inverse of grid spacing over mom. level (k) [1/m] - invrs_dzmm1 ! Inverse of grid spacing over mom. level (k-1) [1/m] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - nu ! Background constant coef. of eddy diffusivity [m^2/s] - - integer, intent(in) :: & - level ! Thermodynamic level where calculation occurs. [-] - - ! Return Variable - real( kind = core_rknd ), dimension(3) :: lhs - - ! ---- Begin Code ---- - - if ( level == 1 ) then - - ! k = 1 (bottom level); lower boundary level. - ! Only relevant if zero-flux boundary conditions are used. - - ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] -! lhs(kp1_tdiag) = - invrs_dzt & -! * (K_zm+nu) & -! * ( cloud_frac_zm / cloud_frac_ztp1 ) * invrs_dzm - lhs(kp1_tdiag) = - invrs_dzt & - * (K_zm & - * min( cloud_frac_zm / cloud_frac_ztp1, cf_ratio ) & - + nu(1)) * invrs_dzm - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] -! lhs(k_tdiag) = + invrs_dzt & -! * (K_zm+nu) & -! * ( cloud_frac_zm / cloud_frac_ztp1 ) * invrs_dzm - lhs(k_tdiag) = + invrs_dzt & - * (K_zm & - * min( cloud_frac_zm / cloud_frac_ztp1, cf_ratio ) & - + nu(1)) * invrs_dzm - - ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) = 0.0_core_rknd - - - else if ( level > 1 .and. level < gr%nz ) then - - ! Most of the interior model; normal conditions. - - ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] -! lhs(kp1_tdiag) = - invrs_dzt & -! * (K_zm+nu) & -! * ( cloud_frac_zm / cloud_frac_ztp1 ) * invrs_dzm -! lhs(kp1_tdiag) = - invrs_dzt & -! * (K_zm & -! * ( cloud_frac_zm / cloud_frac_ztp1 ) & -! + nu ) * invrs_dzm - lhs(kp1_tdiag) = - invrs_dzt & - * (K_zm & - * min( cloud_frac_zm / cloud_frac_ztp1, cf_ratio ) & - + nu(level) ) * invrs_dzm - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] -! lhs(k_tdiag) = + invrs_dzt & -! * ( ((K_zm+nu)*cloud_frac_zm)*invrs_dzm & -! + ((K_zmm1+nu)*cloud_frac_zmm1)*invrs_dzmm1 ) & -! / cloud_frac_zt -! lhs(k_tdiag) = + invrs_dzt & -! * ( nu*(invrs_dzm+invrs_dzmm1) + & -! ( ((K_zm*cloud_frac_zm)*invrs_dzm + -! (K_zmm1*cloud_frac_zmm1)*invrs_dzmm1)& -! / cloud_frac_zt & -! ) & -! ) - lhs(k_tdiag) = + invrs_dzt & - * ( nu(level)*(invrs_dzm+invrs_dzmm1) + & - ( K_zm*invrs_dzm* & - min( cloud_frac_zm / cloud_frac_zt, & - cf_ratio ) & - + K_zmm1*invrs_dzmm1* & - min( cloud_frac_zmm1 / cloud_frac_zt, & - cf_ratio ) & - ) & - ) - - ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] -! lhs(km1_tdiag) = - invrs_dzt * (K_zmm1+nu) * & -! ( cloud_frac_zmm1 / cloud_frac_ztm1 ) * invrs_dzmm1 - lhs(km1_tdiag) = - invrs_dzt & - * (K_zmm1 & - * min( cloud_frac_zmm1 / cloud_frac_ztm1, & - cf_ratio ) & - + nu(level) ) * invrs_dzmm1 - - else if ( level == gr%nz ) then - - ! k = gr%nz (top level); upper boundary level. - ! Only relevant if zero-flux boundary conditions are used. - - ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) = 0.0_core_rknd - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] -! lhs(k_tdiag) = + invrs_dzt & -! *(K_zmm1+nu) & -! *( cloud_frac_zmm1 / cloud_frac_ztm1 ) * invrs_dzmm1 - lhs(k_tdiag) = + invrs_dzt & - * (K_zmm1 & - * min( cloud_frac_zmm1 / cloud_frac_ztm1, & - cf_ratio ) & - + nu(gr%nz)) * invrs_dzmm1 - - ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] -! lhs(km1_tdiag) = - invrs_dzt * (K_zmm1+nu) * & -! ( cloud_frac_zmm1 / cloud_frac_ztm1 ) * invrs_dzmm1 - lhs(km1_tdiag) = - invrs_dzt & - * (K_zmm1 & - * min( cloud_frac_zmm1 / cloud_frac_ztm1, & - cf_ratio ) & - + nu(gr%nz)) * invrs_dzmm1 - - end if - - return - end function diffusion_cloud_frac_zt_lhs - - !============================================================================= - pure function diffusion_zm_lhs( K_zt, K_ztp1, nu, & - invrs_dztp1, invrs_dzt, & - invrs_dzm, level ) & - result( lhs ) - - ! Description: - ! Vertical eddy diffusion of var_zm: implicit portion of the code. - ! - ! The variable "var_zm" stands for a variable that is located at momentum - ! grid levels. - ! - ! The d(var_zm)/dt equation contains an eddy diffusion term: - ! - ! + d [ ( K_zt + nu ) * d(var_zm)/dz ] / dz. - ! - ! This term is usually solved for completely implicitly, such that: - ! - ! + d [ ( K_zt + nu ) * d( var_zm(t+1) )/dz ] / dz. - ! - ! However, when a Crank-Nicholson scheme is used, the eddy diffusion term - ! has both implicit and explicit components, such that: - ! - ! + (1/2) * d [ ( K_zt + nu ) * d( var_zm(t+1) )/dz ] / dz - ! + (1/2) * d [ ( K_zt + nu ) * d( var_zm(t) )/dz ] / dz; - ! - ! for which the implicit component is: - ! - ! + (1/2) * d [ ( K_zt + nu ) * d( var_zm(t+1) )/dz ] / dz. - ! - ! Note: When the implicit term is brought over to the left-hand side, - ! the sign is reversed and the leading "+" in front of the term - ! is changed to a "-". - ! - ! Timestep index (t) stands for the index of the current timestep, while - ! timestep index (t+1) stands for the index of the next timestep, which is - ! being advanced to in solving the d(var_zm)/dt equation. - ! - ! The implicit portion of this term is discretized as follows: - ! - ! The values of var_zm are found on the momentum levels, while the values of - ! K_zt are found on the thermodynamic levels. The derivatives (d/dz) of - ! var_zm are taken over the intermediate thermodynamic levels. At the - ! intermediate thermodynamic levels, d(var_zm)/dz is multiplied by - ! ( K_zt + nu ). Then, the derivative of the whole mathematical expression - ! is taken over the central momentum level, which yields the desired result. - ! - ! ==var_zmp1=============================================== m(k+1) - ! - ! ----------d(var_zm)/dz--(K_ztp1+nu)---------------------- t(k+1) - ! - ! ==var_zm===================d[(K_zt+nu)*d(var_zm)/dz]/dz== m(k) - ! - ! ----------d(var_zm)/dz--(K_zt+nu)------------------------ t(k) - ! - ! ==var_zmm1=============================================== m(k-1) - ! - ! The vertical indices m(k+1), t(k+1), m(k), t(k), and m(k-1) correspond - ! with altitudes zm(k+1), zt(k+1), zm(k), zt(k), and zm(k-1), respectively. - ! The letter "t" is used for thermodynamic levels and the letter "m" is used - ! for momentum levels. - ! - ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) - ! invrs_dzt(k+1) = 1 / ( zm(k+1) - zm(k) ) - ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) - ! - ! Note: This function only computes the general implicit form: - ! + d [ ( K_zt + nu ) * d( var_zm(t+1) )/dz ] / dz. - ! For a Crank-Nicholson scheme, the left-hand side result of this - ! function will have to be multiplied by (1/2). For a - ! Crank-Nicholson scheme, the right-hand side (explicit) component - ! needs to be computed by multiplying the left-hand side results by - ! (1/2), reversing the sign on each left-hand side element, and then - ! multiplying each element by the appropriate var_zm(t) value from - ! the appropriate vertical level. - ! - ! - ! Boundary Conditions: - ! - ! 1) Zero-flux boundary conditions. - ! This function is set up to use zero-flux boundary conditions at both - ! the lower boundary level and the upper boundary level. The flux, F, - ! is the amount of var_zm flowing normal through the boundary per unit - ! time per unit surface area. The derivative of the flux effects the - ! time-tendency of var_zm, such that: - ! - ! d(var_zm)/dt = -dF/dz. - ! - ! For the 2nd-order eddy-diffusion term, +d[(K_zt+nu)*d(var_zm)/dz]/dz, - ! the flux is: - ! - ! F = -(K_zt+nu)*d(var_zm)/dz. - ! - ! In order to have zero-flux boundary conditions, the derivative of - ! var_zm, d(var_zm)/dz, needs to equal 0 at both the lower boundary and - ! the upper boundary. - ! - ! In order to discretize the lower boundary condition, consider a new - ! level outside the model (momentum level 0) just below the lower - ! boundary level (momentum level 1). The value of var_zm at the level - ! just outside the model is defined to be the same as the value of var_zm - ! at the lower boundary level. Therefore, the value of d(var_zm)/dz - ! between the level just outside the model and the lower boundary level - ! is 0, satisfying the zero-flux boundary condition. The other value for - ! d(var_zm)/dz (between momentum level 2 and momentum level 1) is taken - ! over the intermediate thermodynamic level (thermodynamic level 2), - ! where it is multiplied by the factor ( K_zt(2) + nu ). Then, the - ! derivative of the whole expression is taken over the central momentum - ! level. - ! - ! =var_zm(2)============================================ m(2) - ! - ! ----------d(var_zm)/dz==(K_zt(2)+nu)------------------ t(2) - ! - ! =var_zm(1)===============d[(K_zt+nu)*d(var_zm)/dz]/dz= m(1) Boundary - ! - ! ----------[d(var_zm)/dz = 0]-------------------------- t(1) - ! - ! =[var_zm(0) = var_zm(1)]=====(level outside model)==== m(0) - ! - ! The result is dependent only on values of K_zt found at thermodynamic - ! level 2 and values of var_zm found at momentum levels 1 and 2. Thus, - ! it only affects 2 diagonals on the left-hand side matrix. - ! - ! The same method can be used to discretize the upper boundary by - ! considering a new level outside the model just above the upper boundary - ! level. - ! - ! 2) Fixed-point boundary conditions. - ! Many equations in the model use fixed-point boundary conditions rather - ! than zero-flux boundary conditions. This means that the value of - ! var_zm stays the same over the course of the timestep at the lower - ! boundary, as well as at the upper boundary. - ! - ! In order to discretize the boundary conditions for equations requiring - ! fixed-point boundary conditions, either: - ! a) in the parent subroutine or function (that calls this function), - ! loop over all vertical levels from the second-lowest to the - ! second-highest, ignoring the boundary levels. Then set the values - ! at the boundary levels in the parent subroutine; or - ! b) in the parent subroutine or function, loop over all vertical levels - ! and then overwrite the results at the boundary levels. - ! - ! Either way, at the boundary levels, an array with a value of 1 at the - ! main diagonal on the left-hand side and with values of 0 at all other - ! diagonals on the left-hand side will preserve the right-hand side value - ! at that level, thus satisfying the fixed-point boundary conditions. - ! - ! - ! Conservation Properties: - ! - ! When zero-flux boundary conditions are used, this technique of - ! discretizing the eddy diffusion term leads to conservative differencing. - ! When conservative differencing is in place, the column totals for each - ! column in the left-hand side matrix (for the eddy diffusion term) should - ! be equal to 0. This ensures that the total amount of the quantity var_zm - ! over the entire vertical domain is being conserved, meaning that nothing - ! is lost due to diffusional effects. - ! - ! To see that this conservation law is satisfied, compute the eddy diffusion - ! of var_zm and integrate vertically. In discretized matrix notation (where - ! "i" stands for the matrix column and "j" stands for the matrix row): - ! - ! 0 = Sum_j Sum_i ( 1/invrs_dzm )_i - ! ( invrs_dzm * ((K_zt+nu)*invrs_dzt) )_ij (var_zm)_j. - ! - ! The left-hand side matrix, ( invrs_dzm * ((K_zt+nu)*invrs_dzt) )_ij, is - ! partially written below. The sum over i in the above equation removes - ! invrs_dzm everywhere from the matrix below. The sum over j leaves the - ! column totals that are desired. - ! - ! Left-hand side matrix contributions from eddy diffusion term; first four - ! vertical levels: - ! - ! ----------------------------------------------------------------------> - !k=1 | +invrs_dzm(k) -invrs_dzm(k) 0 - ! | *(K_zt(k+1)+nu) *(K_zt(k+1)+nu) - ! | *invrs_dzt(k+1) *invrs_dzt(k+1) - ! | - !k=2 | -invrs_dzm(k) +invrs_dzm(k) -invrs_dzm(k) - ! | *(K_zt(k)+nu) *[ (K_zt(k+1)+nu) *(K_zt(k+1)+nu) - ! | *invrs_dzt(k) *invrs_dzt(k+1) *invrs_dzt(k+1) - ! | +(K_zt(k)+nu) - ! | *invrs_dzt(k) ] - ! | - !k=3 | 0 -invrs_dzm(k) +invrs_dzm(k) - ! | *(K_zt(k)+nu) *[ (K_zt(k+1)+nu) - ! | *invrs_dzt(k) *invrs_dzt(k+1) - ! | +(K_zt(k)+nu) - ! | *invrs_dzt(k) ] - ! | - !k=4 | 0 0 -invrs_dzm(k) - ! | *(K_zt(k)+nu) - ! | *invrs_dzt(k) - ! \ / - ! - ! Note: The superdiagonal term from level 3 and both the main diagonal and - ! superdiagonal terms from level 4 are not shown on this diagram. - ! - ! Note: The matrix shown is a tridiagonal matrix. For a band diagonal - ! matrix (with 5 diagonals), there would be an extra row between each - ! of the rows shown and an extra column between each of the columns - ! shown. However, for the purposes of the var_zm eddy diffusion - ! term, those extra row and column values are all 0, and the - ! conservation properties of the matrix aren't effected. - ! - ! If fixed-point boundary conditions are used, the matrix entries at - ! level 1 (k=1) read: 1 0 0; which means that conservative differencing - ! is not in play. The total amount of var_zm over the entire vertical - ! domain is not being conserved, as amounts of var_zm may be fluxed out - ! through the upper boundary or lower boundary through the effects of - ! diffusion. - ! - ! Brian Griffin. April 26, 2008. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_mdiag = 1, & ! Momentum superdiagonal index. - k_mdiag = 2, & ! Momentum main diagonal index. - km1_mdiag = 3 ! Momentum subdiagonal index. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - K_zt, & ! Coef. of eddy diffusivity at thermo. level (k) [m^2/s] - K_ztp1, & ! Coef. of eddy diffusivity at thermo. level (k+1) [m^2/s] - invrs_dzm, & ! Inverse of grid spacing over momentum level (k) [1/m] - invrs_dzt, & ! Inverse of grid spacing over thermo. level (k) [1/m] - invrs_dztp1 ! Inverse of grid spacing over thermo. level (k+1) [1/m] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - nu ! Background constant coef. of eddy diffusivity [m^2/s] - - integer, intent(in) :: & - level ! Momentum level where calculation occurs. [-] - - ! Return Variable - real( kind = core_rknd ), dimension(3) :: lhs - - if ( level == 1 ) then - - ! k = 1; lower boundary level at surface. - ! Only relevant if zero-flux boundary conditions are used. - - ! Momentum superdiagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) = - invrs_dzm * (K_ztp1+nu(2)) * invrs_dztp1 - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) = + invrs_dzm * (K_ztp1+nu(2)) * invrs_dztp1 - - ! Momentum subdiagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) = 0.0_core_rknd - - - elseif ( level > 1 .and. level < gr%nz ) then - - ! Most of the interior model; normal conditions. - - ! Momentum superdiagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) = - invrs_dzm * (K_ztp1+nu(level+1)) * invrs_dztp1 - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) = + invrs_dzm * ( (K_ztp1+nu(level+1))*invrs_dztp1 & - + (K_zt+nu(level))*invrs_dzt ) - - ! Momentum subdiagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) = - invrs_dzm * (K_zt+nu(level)) * invrs_dzt - - - elseif ( level == gr%nz ) then - - ! k = gr%nz (top level); upper boundary level. - ! Only relevant if zero-flux boundary conditions are used. - - ! Momentum superdiagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) = 0.0_core_rknd - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) = + invrs_dzm * (K_zt+nu(gr%nz)) * invrs_dzt - - ! Momentum subdiagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) = - invrs_dzm * (K_zt+nu(gr%nz)) * invrs_dzt - - - endif - - end function diffusion_zm_lhs - -!=============================================================================== - -end module crmx_diffusion diff --git a/src/physics/spcam/crm/CLUBB/crmx_endian.F90 b/src/physics/spcam/crm/CLUBB/crmx_endian.F90 deleted file mode 100644 index 6886f158a1..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_endian.F90 +++ /dev/null @@ -1,173 +0,0 @@ -!---------------------------------------------------------------------- -! $Id: endian.F90 3784 2009-07-14 21:29:16Z dschanen@uwm.edu $ - -!---------------------------------------------------------------------- -module crmx_endian - -! Description: -! big_endian and little_endian are parameters set at compile time -! based on whether the architecture is big or little endian. - -! native_4byte_real is a portable byte re-ordering subroutine -! native_8byte_real is a knock off of the other routine for 8 bytes -! References: -! big_endian, little_endian from: -! -!---------------------------------------------------------------------- - - implicit none - - interface byte_order_swap - module procedure native_4byte_real, native_8byte_real - end interface - - public :: big_endian, little_endian, byte_order_swap - private :: native_4byte_real, native_8byte_real - - private ! Default scope - ! External - intrinsic :: selected_int_kind, ichar, transfer - - ! Parameters - integer, parameter :: & - i4 = 4, & ! 4 byte long integer - ich = ichar( transfer( 1_i4, "a" ) ) - - logical, parameter :: & - big_endian = ich == 0, & - little_endian = .not. big_endian - - contains - -!------------------------------------------------------------------------------- -! SUBPROGRAM: native_4byte_real -! -! AUTHOR: David Stepaniak, NCAR/CGD/CAS -! DATE INITIATED: 29 April 2003 -! LAST MODIFIED: 19 April 2005 -! -! SYNOPSIS: Converts a 32 bit, 4 byte, REAL from big Endian to -! little Endian, or conversely from little Endian to big -! Endian. -! -! DESCRIPTION: This subprogram allows one to convert a 32 bit, 4 byte, -! REAL data element that was generated with, say, a big -! Endian processor (e.g. Sun/sparc, SGI/R10000, etc.) to its -! equivalent little Endian representation for use on little -! Endian processors (e.g. PC/Pentium running Linux). The -! converse, little Endian to big Endian, also holds. -! This conversion is accomplished by writing the 32 bits of -! the REAL data element into a generic 32 bit INTEGER space -! with the TRANSFER intrinsic, reordering the 4 bytes with -! the MVBITS intrinsic, and writing the reordered bytes into -! a new 32 bit REAL data element, again with the TRANSFER -! intrinsic. The following schematic illustrates the -! reordering process -! -! -! -------- -------- -------- -------- -! | D | | C | | B | | A | 4 Bytes -! -------- -------- -------- -------- -! | -! -> 1 bit -! || -! MVBITS -! || -! \/ -! -! -------- -------- -------- -------- -! | A | | B | | C | | D | 4 Bytes -! -------- -------- -------- -------- -! | | | | -! 24 16 8 0 <- bit -! position -! -! INPUT: realIn, a single 32 bit, 4 byte REAL data element. -! OUTPUT: realOut, a single 32 bit, 4 byte REAL data element, with -! reverse byte order to that of realIn. -! RESTRICTION: It is assumed that the default REAL data element is -! 32 bits / 4 bytes. -! -!----------------------------------------------------------------------- - SUBROUTINE native_4byte_real( realInOut ) - - IMPLICIT NONE - - REAL(KIND=4), INTENT(INOUT):: realInOut ! a single 32 bit, 4 byte - ! REAL data element -! Modified 8/1/05 -! I found transfer does not work on pgf90 when -r8 is used and the mold -! is a literal constant real; Changed the mold "0.0" to "readInOut" -! -dschanen -! -! REAL, INTENT(IN):: realInOut -! REAL, INTENT(OUT) :: realOut -! ! a single 32 bit, 4 byte -! ! REAL data element, with -! ! reverse byte order to -! ! that of realIn -!---------------------------------------------------------------------- -! Local variables (generic 32 bit INTEGER spaces): - - INTEGER(KIND=4) :: i_element - INTEGER(KIND=4) :: i_element_br -!---------------------------------------------------------------------- -! Transfer 32 bits of realIn to generic 32 bit INTEGER space: - i_element = TRANSFER( realInOut, i_element ) -!---------------------------------------------------------------------- -! Reverse order of 4 bytes in 32 bit INTEGER space: - CALL MVBITS( i_element, 24, 8, i_element_br, 0 ) - CALL MVBITS( i_element, 16, 8, i_element_br, 8 ) - CALL MVBITS( i_element, 8, 8, i_element_br, 16 ) - CALL MVBITS( i_element, 0, 8, i_element_br, 24 ) -!---------------------------------------------------------------------- -! Transfer reversed order bytes to 32 bit REAL space (realOut): - realInOut = TRANSFER( i_element_br, realInOut ) - - RETURN - END SUBROUTINE native_4byte_real - -!------------------------------------------------------------------------------- - subroutine native_8byte_real( realInOut ) - -! Description: -! This is just a modification of the above routine for 64 bit data -!------------------------------------------------------------------------------- - - implicit none - - ! External - intrinsic :: mvbits, transfer - - real(kind=8), intent(inout) :: realInOut ! a single 64 bit, 8 byte - ! REAL data element - ! Local variables (generic 64 bit INTEGER spaces): - - integer(kind=8) :: i_element - integer(kind=8) :: i_element_br - -!------------------------------------------------------------------------------- - - ! Transfer 64 bits of realIn to generic 64 bit INTEGER space: - i_element = transfer( realInOut, i_element ) - - ! Reverse order of 8 bytes in 64 bit INTEGER space: - call mvbits( i_element, 56, 8, i_element_br, 0 ) - call mvbits( i_element, 48, 8, i_element_br, 8 ) - call mvbits( i_element, 40, 8, i_element_br, 16 ) - call mvbits( i_element, 32, 8, i_element_br, 24 ) - call mvbits( i_element, 24, 8, i_element_br, 32 ) - call mvbits( i_element, 16, 8, i_element_br, 40 ) - call mvbits( i_element, 8, 8, i_element_br, 48 ) - call mvbits( i_element, 0, 8, i_element_br, 56 ) - - ! Transfer reversed order bytes to 64 bit REAL space (realOut): - realInOut = transfer( i_element_br, realInOut ) - - return - end subroutine native_8byte_real -!------------------------------------------------------------------------------- - -end module crmx_endian - -!------------------------------------------------------------------------------- diff --git a/src/physics/spcam/crm/CLUBB/crmx_error_code.F90 b/src/physics/spcam/crm/CLUBB/crmx_error_code.F90 deleted file mode 100644 index bddf1c39b2..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_error_code.F90 +++ /dev/null @@ -1,227 +0,0 @@ -!------------------------------------------------------------------------------- -! $Id: error_code.F90 5906 2012-08-10 23:20:05Z dschanen@uwm.edu $ -!------------------------------------------------------------------------------- - -module crmx_error_code - -! Description: -! Since f90/95 lacks enumeration, we're stuck numbering each -! error code by hand like this. - -! We are "enumerating" error codes to be used with CLUBB. Adding -! additional codes is as simple adding an additional integer -! parameter. The error codes are ranked by severity, the higher -! number being more servere. When two errors occur, assign the -! most servere to the output. - -! This code also handles subroutines related to debug_level. See -! the 'set_clubb_debug_level' description for more detail. - -! References: -! None -!------------------------------------------------------------------------------- - - implicit none - - private ! Default Scope - - public :: & - reportError, & - fatal_error, & - lapack_error, & - clubb_at_least_debug_level, & - set_clubb_debug_level, & - clubb_debug - - private :: clubb_debug_level - - ! Model-Wide Debug Level - integer, save :: clubb_debug_level = 0 - -!$omp threadprivate(clubb_debug_level) - - ! Error Code Values - integer, parameter, public :: & - clubb_no_error = 0, & - clubb_var_less_than_zero = 1, & - clubb_var_equals_NaN = 2, & - clubb_singular_matrix = 3, & - clubb_bad_lapack_arg = 4, & - clubb_rtm_level_not_found = 5, & - clubb_var_out_of_bounds = 6, & - clubb_var_out_of_range = 7 - - contains - -!------------------------------------------------------------------------------- - subroutine reportError( err_code ) -! -! Description: -! Reports meaning of error code to console. -! -!------------------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - implicit none - - ! Input Variable - integer, intent(in) :: err_code ! Error Code being examined - - ! ---- Begin Code ---- - - select case ( err_code ) - - case ( clubb_no_error ) - write(fstderr,*) "No errors reported." - - case ( clubb_var_less_than_zero ) - write(fstderr,*) "Variable in CLUBB is less than zero." - - case ( clubb_singular_matrix ) - write(fstderr,*) "Singular Matrix in CLUBB." - - case ( clubb_var_equals_NaN ) - write(fstderr,*) "Variable in CLUBB is NaN." - - case ( clubb_bad_lapack_arg ) - write(fstderr,*) "Argument passed to a LAPACK procedure is invalid." - - case ( clubb_rtm_level_not_found ) - write(fstderr,*) "rtm level not found" - - case ( clubb_var_out_of_bounds ) - write(fstderr,*) "Input variable is out of bounds." - - case ( clubb_var_out_of_range ) - write(fstderr,*) "A CLUBB variable had a value outside the valid range." - - case default - write(fstderr,*) "Unknown error: ", err_code - - end select - - return - end subroutine reportError -!------------------------------------------------------------------------------- - elemental function lapack_error( err_code ) -! -! Description: -! Checks to see if the err_code is equal to one -! caused by an error encountered using LAPACK. -! Reference: -! None -!------------------------------------------------------------------------------- - implicit none - - ! Input variable - integer,intent(in) :: err_code ! Error Code being examined - - ! Output variable - logical :: lapack_error - - ! ---- Begin Code ---- - - lapack_error = (err_code == clubb_singular_matrix .or. & - err_code == clubb_bad_lapack_arg ) - - return - end function lapack_error - -!------------------------------------------------------------------------------- - elemental function fatal_error( err_code ) -! -! Description: Checks to see if the err_code is one that usually -! causes an exit in other parts of CLUBB. -! References: -! None -!------------------------------------------------------------------------------- - implicit none - - ! Input Variable - integer, intent(in) :: err_code ! Error Code being examined - - ! Output variable - logical :: fatal_error - - ! ---- Begin Code ---- - - fatal_error = err_code /= clubb_no_error .and. & - err_code /= clubb_var_less_than_zero - return - end function fatal_error - -!------------------------------------------------------------------ - logical function clubb_at_least_debug_level( level ) -! -! Description: -! Checks to see if clubb has been set to a specified debug level -!------------------------------------------------------------------ - implicit none - - ! Input variable - integer, intent(in) :: level ! The debug level being checked against the current setting - - ! ---- Begin Code ---- - - clubb_at_least_debug_level = ( level <= clubb_debug_level ) - - return - end function clubb_at_least_debug_level - -!------------------------------------------------------------------------------- - subroutine set_clubb_debug_level( level ) -! -! Description: -! Accessor for clubb_debug_level -! -! 0 => Print no debug messages to the screen -! 1 => Print lightweight debug messages, e.g. print statements -! 2 => Print debug messages that require extra testing, -! e.g. checks for NaNs and spurious negative values. -! References: -! None -!------------------------------------------------------------------------------- - implicit none - - ! Input variable - integer, intent(in) :: level ! The debug level being checked against the current setting - - ! ---- Begin Code ---- - - clubb_debug_level = level - - return - end subroutine set_clubb_debug_level - -!------------------------------------------------------------------------------- - subroutine clubb_debug( level, str ) -! -! Description: -! Prints a message to file unit fstderr if the level is greater -! than or equal to the current debug level. -!------------------------------------------------------------------------------- - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - implicit none - - ! Input Variable(s) - - character(len=*), intent(in) :: str ! The message being reported - - ! The debug level being checked against the current setting - integer, intent(in) :: level - - ! ---- Begin Code ---- - - if ( level <= clubb_debug_level ) then - write(fstderr,*) str - end if - - return - end subroutine clubb_debug - -end module crmx_error_code -!------------------------------------------------------------------------------- diff --git a/src/physics/spcam/crm/CLUBB/crmx_extrapolation.F90 b/src/physics/spcam/crm/CLUBB/crmx_extrapolation.F90 deleted file mode 100644 index 38c4837bd9..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_extrapolation.F90 +++ /dev/null @@ -1,90 +0,0 @@ -!$Id: extrapolation.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -module crmx_extrapolation - - implicit none - - public :: lin_ext_zm_bottom, lin_ext_zt_bottom - - private ! Default scope - - contains -!=============================================================================== - pure function lin_ext_zm_bottom( var_zmp2, var_zmp1, & - zmp2, zmp1, zm ) & - result( var_zm ) - - ! Description: - ! This function computes the value of a momentum-level variable at a bottom - ! grid level by using a linear extension of the values of the variable at - ! the two levels immediately above the level where the result value is - ! needed. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - var_zmp2, & ! Momentum level variable at level (k+2) [units vary] - var_zmp1, & ! Momentum level variable at level (k+1) [units vary] - zmp2, & ! Altitude at momentum level (k+2) [m] - zmp1, & ! Altitude at momentum level (k+1) [m] - zm ! Altitude at momentum level (k) [m] - - ! Return Variable - real( kind = core_rknd ) :: var_zm ! Momentum level variable at level (k) [units vary] - - ! ---- Begin Code ----- - - var_zm = ( ( var_zmp2 - var_zmp1 ) / ( zmp2 - zmp1 ) ) & - * ( zm - zmp1 ) + var_zmp1 - - return - end function lin_ext_zm_bottom - -!=============================================================================== - pure function lin_ext_zt_bottom( var_ztp2, var_ztp1, & - ztp2, ztp1, zt ) & - result( var_zt ) - - ! Description: - ! This function computes the value of a thermodynamic-level variable at a - ! bottom grid level by using a linear extension of the values of the - ! variable at the two levels immediately above the level where the result - ! value is needed. - ! - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - var_ztp2, & ! Thermodynamic level variable at level (k+2) [units vary] - var_ztp1, & ! Thermodynamic level variable at level (k+1) [units vary] - ztp2, & ! Altitude at thermodynamic level (k+2) [m] - ztp1, & ! Altitude at thermodynamic level (k+1) [m] - zt ! Altitude at thermodynamic level (k) [m] - - ! Return Variable - real( kind = core_rknd ) :: var_zt ! Thermodynamic level variable at level (k) [units vary] - - ! ---- Begin Code ----- - - var_zt = ( ( var_ztp2 - var_ztp1 ) / ( ztp2 - ztp1 ) ) & - * ( zt - ztp1 ) + var_ztp1 - - return - end function lin_ext_zt_bottom - -end module crmx_extrapolation diff --git a/src/physics/spcam/crm/CLUBB/crmx_file_functions.F90 b/src/physics/spcam/crm/CLUBB/crmx_file_functions.F90 deleted file mode 100644 index 82d1eb1d10..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_file_functions.F90 +++ /dev/null @@ -1,156 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: file_functions.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -!=============================================================================== -module crmx_file_functions - - implicit none - - public :: file_read_1d, file_read_2d - - private ! Default Scope - - contains - -!=============================================================================== - subroutine file_read_1d( file_unit, path_and_filename, & - num_datapts, entries_per_line, variable ) - -! Description: -! This subroutine reads in values from a data file with a number of -! rows and a declared number of columns (entries_per_line) of data. -! It reads in the data in the form of: -! 1 ==> (row 1, column 1); 2 ==> (row 1, column 2); etc. -! -! Example: a diagram of a data file with 18 total data points -! (DP1 to DP18), with 4 data points per row. -! -! i = 1 i = 2 i = 3 i = 4 -! --------------------------------------- -! k = 1 | DP1 DP2 DP3 DP4 -! | -! k = 2 | DP5 DP6 DP7 DP8 -! | -! k = 3 | DP9 DP10 DP11 DP12 -! | -! k = 4 | DP13 DP14 DP15 DP16 -! | -! k = 5 | DP17 DP18 -! -! See Michael Falk's comments below for more information. -!----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_constants_clubb, only: fstderr ! Constant(s) - - implicit none - - integer, intent(in) :: & - file_unit, & ! Unit number of file being read. - num_datapts, & ! Total number of data points being read in. - entries_per_line ! Number of data points - ! on one line of the file being read. - - character(*), intent(in) :: & - path_and_filename ! Path to file and filename of file being read. - - real( kind = core_rknd ), dimension(num_datapts), intent(out) :: & - variable ! Data values output into variable - - integer :: k ! Data file row number. - integer :: i ! Data file column number. - integer :: ierr - - ! ---- Begin Code ---- - - ! Open data file. - open( unit=file_unit, file=path_and_filename, action='read', status='old', & - iostat=ierr ) - if ( ierr /= 0 ) then - write(fstderr,*) "CLUBB encountered an error trying to open "//path_and_filename - stop "Error opening forcings file" - end if - - ! Michael Falk wrote this routine to read data files in a particular format for mpace_a. - ! Each line has a specific number of values, until the last line in the file, which - ! has the last few values and then ends. This reads the correct number of values on - ! each line. 24 September 2007 - - ! Loop over each full line of the input file. - do k = 1, (num_datapts/entries_per_line), 1 - read(file_unit,*) ( variable( ((k-1)*entries_per_line) + i ), & - i=1,entries_per_line ) - enddo - ! Read any partial line remaining. - if ( mod(num_datapts,entries_per_line) /= 0 ) then - k = (num_datapts/entries_per_line) - read(file_unit,*) ( variable( (k*entries_per_line) + i ), & - i=1,(mod(num_datapts,entries_per_line)) ) - endif - - ! Close data file. - close( file_unit ) - - return - - end subroutine file_read_1d - -!=============================================================================== - subroutine file_read_2d( device, file_path, file_dimension1, & - file_dimension2, file_per_line, variable ) - -! Description: -! Michael Falk wrote this routine to read data files in a particular format for mpace_a. -! The 2d mpace_a files list the (file_dimension2) values on a given vertical level, then -! moves to the next level to list its values. -! Each line has a specific number of values, until the last line on a level, which -! is short-- it has the last few values and then a line break. The next line, beginning -! the next level, is full-sized again. 24 September 2007 -! -! References: -! None -!------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - integer, intent(in) :: & - device, & - file_dimension1, & - file_dimension2, & - file_per_line - - character(*), intent(in) :: & - file_path - - real( kind = core_rknd ), dimension(file_dimension1,file_dimension2), intent(out) :: & - variable - - integer i, j, k - - ! ---- Begin Code ---- - - variable = -999._core_rknd ! Initialize to nonsense values - - open(device,file=file_path,action='read') - - do k=1,(file_dimension1) ! For each level in the data file, - do j=0,((file_dimension2/file_per_line)-1) - read(device,*) (variable(k,(j*file_per_line)+i), & ! read file_per_line values in, - i=1,file_per_line) - end do - read (device,*) (variable(k,(j*file_per_line)+i), & ! then read the partial line - i=1,(mod(file_dimension2,file_per_line))) - end do ! and then start over at the next level. - - close(device) - - return - end subroutine file_read_2d - -!=============================================================================== - -end module crmx_file_functions diff --git a/src/physics/spcam/crm/CLUBB/crmx_fill_holes.F90 b/src/physics/spcam/crm/CLUBB/crmx_fill_holes.F90 deleted file mode 100644 index 8e17d3bc53..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_fill_holes.F90 +++ /dev/null @@ -1,487 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: fill_holes.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -!=============================================================================== -module crmx_fill_holes - - implicit none - - public :: fill_holes_driver, & - vertical_avg, & - vertical_integral - - private :: fill_holes_multiplicative - - private ! Set Default Scope - - contains - - !============================================================================= - subroutine fill_holes_driver( num_pts, threshold, field_grid, & - rho_ds, rho_ds_zm, & - field ) - - ! Description: - ! This subroutine clips values of 'field' that are below 'threshold' as much - ! as possible (i.e. "fills holes"), but conserves the total integrated mass - ! of 'field'. This prevents clipping from acting as a spurious source. - ! - ! Mass is conserved by reducing the clipped field everywhere by a constant - ! multiplicative coefficient. - ! - ! This subroutine does not guarantee that the clipped field will exceed - ! threshold everywhere; blunt clipping is needed for that. - - ! References: - ! ``Numerical Methods for Wave Equations in Geophysical Fluid - ! Dynamics'', Durran (1999), p. 292. - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input variables - integer, intent(in) :: & - num_pts ! The number of points on either side of the hole; - ! Mass is drawn from these points to fill the hole. [] - - real( kind = core_rknd ), intent(in) :: & - threshold ! A threshold (e.g. w_tol*w_tol) below which field must not - ! fall [Units vary; same as field] - - character(len=2), intent(in) :: & - field_grid ! The grid of the field, either zt or zm - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - rho_ds, & ! Dry, static density on thermodynamic levels [kg/m^3] - rho_ds_zm ! Dry, static density on momentum levels [kg/m^3] - - ! Input/Output variable - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - field ! The field (e.g. wp2) that contains holes [Units same as threshold] - - ! Local Variables - integer :: & - k, & ! Loop index for absolute grid level [] - begin_idx, & ! Lower grid level of local hole-filling range [] - end_idx, & ! Upper grid level of local hole-filling range [] - upper_hf_level ! Upper grid level of global hole-filling range [] - - !----------------------------------------------------------------------- - - ! Check whether any holes exist in the entire profile. - ! The lowest level (k=1) should not be included, as the hole-filling scheme - ! should not alter the set value of 'field' at the surface (for momentum - ! level variables), or consider the value of 'field' at a level below the - ! surface (for thermodynamic level variables). For momentum level variables - ! only, the hole-filling scheme should not alter the set value of 'field' at - ! the upper boundary level (k=gr%nz). - - if ( field_grid == "zt" ) then - ! 'field' is on the zt (thermodynamic level) grid - upper_hf_level = gr%nz - elseif ( field_grid == "zm" ) then - ! 'field' is on the zm (momentum level) grid - upper_hf_level = gr%nz-1 - endif - - if ( any( field( 2:upper_hf_level ) < threshold ) ) then - - ! Make one pass up the profile, filling holes as much as we can using - ! nearby mass. - ! The lowest level (k=1) should not be included in the loop, as the - ! hole-filling scheme should not alter the set value of 'field' at the - ! surface (for momentum level variables), or consider the value of - ! 'field' at a level below the surface (for thermodynamic level - ! variables). For momentum level variables only, the hole-filling scheme - ! should not alter the set value of 'field' at the upper boundary - ! level (k=gr%nz). - do k = 2+num_pts, upper_hf_level-num_pts, 1 - - begin_idx = k - num_pts - end_idx = k + num_pts - - if ( any( field( begin_idx:end_idx ) < threshold ) ) then - - ! 'field' is on the zt (thermodynamic level) grid - if ( field_grid == "zt" ) then - call fill_holes_multiplicative & - ( begin_idx, end_idx, threshold, & - rho_ds(begin_idx:end_idx), gr%invrs_dzt(begin_idx:end_idx), & - field(begin_idx:end_idx) ) - - ! 'field' is on the zm (momentum level) grid - elseif ( field_grid == "zm" ) then - call fill_holes_multiplicative & - ( begin_idx, end_idx, threshold, & - rho_ds_zm(begin_idx:end_idx), gr%invrs_dzm(begin_idx:end_idx), & - field(begin_idx:end_idx) ) - endif - - endif - - enddo - - ! Fill holes globally, to maximize the chance that all holes are filled. - ! The lowest level (k=1) should not be included, as the hole-filling - ! scheme should not alter the set value of 'field' at the surface (for - ! momentum level variables), or consider the value of 'field' at a level - ! below the surface (for thermodynamic level variables). For momentum - ! level variables only, the hole-filling scheme should not alter the set - ! value of 'field' at the upper boundary level (k=gr%nz). - if ( any( field( 2:upper_hf_level ) < threshold ) ) then - - ! 'field' is on the zt (thermodynamic level) grid - if ( field_grid == "zt" ) then - call fill_holes_multiplicative & - ( 2, upper_hf_level, threshold, & - rho_ds(2:upper_hf_level), gr%invrs_dzt(2:upper_hf_level), & - field(2:upper_hf_level) ) - - ! 'field' is on the zm (momentum level) grid - elseif ( field_grid == "zm" ) then - call fill_holes_multiplicative & - ( 2, upper_hf_level, threshold, & - rho_ds_zm(2:upper_hf_level), gr%invrs_dzm(2:upper_hf_level), & - field(2:upper_hf_level) ) - endif - - endif - - endif ! End overall check for existence of holes - - return - - end subroutine fill_holes_driver - - !============================================================================= - subroutine fill_holes_multiplicative & - ( begin_idx, end_idx, threshold, & - rho, invrs_dz, & - field ) - - ! Description: - ! This subroutine clips values of 'field' that are below 'threshold' as much - ! as possible (i.e. "fills holes"), but conserves the total integrated mass - ! of 'field'. This prevents clipping from acting as a spurious source. - ! - ! Mass is conserved by reducing the clipped field everywhere by a constant - ! multiplicative coefficient. - ! - ! This subroutine does not guarantee that the clipped field will exceed - ! threshold everywhere; blunt clipping is needed for that. - - ! References: - ! ``Numerical Methods for Wave Equations in Geophysical Fluid - ! Dynamics", Durran (1999), p. 292. - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input variables - integer, intent(in) :: & - begin_idx, & ! The beginning index (e.g. k=2) of the range of hole-filling - end_idx ! The end index (e.g. k=gr%nz) of the range of hole-filling - - real( kind = core_rknd ), intent(in) :: & - threshold ! A threshold (e.g. w_tol*w_tol) below which field must not fall - ! [Units vary; same as field] - - real( kind = core_rknd ), dimension(end_idx-begin_idx+1), intent(in) :: & - rho, & ! Dry, static density on either thermodynamic or momentum levels [kg/m^3] - invrs_dz ! Reciprocal of thermodynamic or momentum level thickness depending on whether - ! we're on zt or zm grid. - - ! Input/Output variable - real( kind = core_rknd ), dimension(end_idx-begin_idx+1), intent(inout) :: & - field ! The field (e.g. wp2) that contains holes - ! [Units same as threshold] - - ! Local Variables - real( kind = core_rknd ), dimension(end_idx-begin_idx+1) :: & - field_clipped ! The raw field (e.g. wp2) that contains no holes - ! [Units same as threshold] - - real( kind = core_rknd ) :: & - field_avg, & ! Vertical average of field [Units of field] - field_clipped_avg, & ! Vertical average of clipped field [Units of field] - mass_fraction ! Coefficient that multiplies clipped field - ! in order to conserve mass. [] - - !----------------------------------------------------------------------- - - ! Compute the field's vertical average, which we must conserve. - field_avg = vertical_avg( (end_idx-begin_idx+1), rho, & - field, invrs_dz ) - - ! Clip small or negative values from field. - if ( field_avg >= threshold ) then - ! We know we can fill in holes completely - field_clipped = max( threshold, field ) - else - ! We can only fill in holes partly; - ! to do so, we remove all mass above threshold. - field_clipped = min( threshold, field ) - endif - - ! Compute the clipped field's vertical integral. - ! clipped_total_mass >= original_total_mass - field_clipped_avg = vertical_avg( (end_idx-begin_idx+1), rho, & - field_clipped, invrs_dz ) - - ! If the difference between the field_clipped_avg and the threshold is so - ! small that it falls within numerical round-off, return to the parent - ! subroutine without altering the field in order to avoid divide-by-zero - ! error. - !if ( abs(field_clipped_avg - threshold) & - ! < threshold*epsilon(threshold) ) then - if ( abs(field_clipped_avg - threshold) == 0.0_core_rknd ) then - return - endif - - ! Compute coefficient that makes the clipped field have the same mass as the - ! original field. We should always have mass_fraction > 0. - mass_fraction = ( field_avg - threshold ) / & - ( field_clipped_avg - threshold ) - - ! Output normalized, filled field - field = mass_fraction * ( field_clipped - threshold ) & - + threshold - - - return - - end subroutine fill_holes_multiplicative - - !============================================================================= - function vertical_avg( total_idx, rho_ds, & - field, invrs_dz ) - - ! Description: - ! Computes the density-weighted vertical average of a field. - ! - ! The average value of a function, f, over a set domain, [a,b], is - ! calculated by the equation: - ! - ! f_avg = ( INT(a:b) f*g ) / ( INT(a:b) g ); - ! - ! as long as f is continous and g is nonnegative and integrable. Therefore, - ! the density-weighted (by dry, static, base-static density) vertical - ! average value of any model field, x, is calculated by the equation: - ! - ! x_avg|_z = ( INT(z_bot:z_top) x rho_ds dz ) - ! / ( INT(z_bot:z_top) rho_ds dz ); - ! - ! where z_bot is the bottom of the vertical domain, and z_top is the top of - ! the vertical domain. - ! - ! This calculation is done slightly differently depending on whether x is a - ! thermodynamic-level or a momentum-level variable. - ! - ! Thermodynamic-level computation: - - ! - ! For numerical purposes, INT(z_bot:z_top) x rho_ds dz, which is the - ! numerator integral, is calculated as: - ! - ! SUM(k_bot:k_top) x(k) rho_ds(k) delta_z(k); - ! - ! where k is the index of the given thermodynamic level, x and rho_ds are - ! both thermodynamic-level variables, and delta_z(k) = zm(k) - zm(k-1). The - ! indices k_bot and k_top are the indices of the respective lower and upper - ! thermodynamic levels involved in the integration. - ! - ! Likewise, INT(z_bot:z_top) rho_ds dz, which is the denominator integral, - ! is calculated as: - ! - ! SUM(k_bot:k_top) rho_ds(k) delta_z(k). - ! - ! The first (k=1) thermodynamic level is below ground (or below the - ! official lower boundary at the first momentum level), so it should not - ! count in a vertical average, whether that vertical average is used for - ! the hole-filling scheme or for statistical purposes. Begin no lower - ! than level k=2, which is the first thermodynamic level above ground (or - ! above the model lower boundary). - ! - ! For cases where hole-filling over the entire (global) vertical domain - ! is desired, or where statistics over the entire (global) vertical - ! domain are desired, the lower (thermodynamic-level) index of k = 2 and - ! the upper (thermodynamic-level) index of k = gr%nz, means that the - ! overall vertical domain will be gr%zm(gr%nz) - gr%zm(1). - ! - ! - ! Momentum-level computation: - ! - ! For numerical purposes, INT(z_bot:z_top) x rho_ds dz, which is the - ! numerator integral, is calculated as: - ! - ! SUM(k_bot:k_top) x(k) rho_ds(k) delta_z(k); - ! - ! where k is the index of the given momentum level, x and rho_ds are both - ! momentum-level variables, and delta_z(k) = zt(k+1) - zt(k). The indices - ! k_bot and k_top are the indices of the respective lower and upper momentum - ! levels involved in the integration. - ! - ! Likewise, INT(z_bot:z_top) rho_ds dz, which is the denominator integral, - ! is calculated as: - ! - ! SUM(k_bot:k_top) rho_ds(k) delta_z(k). - ! - ! The first (k=1) momentum level is right at ground level (or right at - ! the official lower boundary). The momentum level variables that call - ! the hole-filling scheme have set values at the surface (or lower - ! boundary), and those set values should not be changed. Therefore, the - ! vertical average (for purposes of hole-filling) should not include the - ! surface level (or lower boundary level). For hole-filling purposes, - ! begin no lower than level k=2, which is the second momentum level above - ! ground (or above the model lower boundary). Likewise, the value at the - ! model upper boundary (k=gr%nz) is also set for momentum level - ! variables. That value should also not be changed. - ! - ! However, this function is also used to keep track (for statistical - ! purposes) of the vertical average of certain variables. In that case, - ! the vertical average needs to be taken over the entire vertical domain - ! (level 1 to level gr%nz). - ! - ! - ! In both the thermodynamic-level computation and the momentum-level - ! computation, the numerator integral is divided by the denominator integral - ! in order to find the average value (over the vertical domain) of x. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input variables - integer, intent(in) :: & - total_idx ! The total numer of indices within the range of averaging - - real( kind = core_rknd ), dimension(total_idx), intent(in) :: & - rho_ds, & ! Dry, static density on either thermodynamic or momentum levels [kg/m^3] - field, & ! The field (e.g. wp2) to be vertically averaged [Units vary] - invrs_dz ! Reciprocal of thermodynamic or momentum level thickness [1/m] - ! depending on whether we're on zt or zm grid. - ! Note: The rho_ds and field points need to be arranged from - ! lowest to highest in altitude, with rho_ds(1) and - ! field(1) actually their respective values at level k = 1. - - ! Output variable - real( kind = core_rknd ) :: & - vertical_avg ! Vertical average of field [Units of field] - - ! Local variables - real( kind = core_rknd ) :: & - numer_integral, & ! Integral in the numerator (see description) - denom_integral ! Integral in the denominator (see description) - - real( kind = core_rknd ), dimension(total_idx) :: & - denom_field ! When computing the vertical integral in the denominator - ! there is no field variable, so create a "dummy" variable - ! with value of 1 to pass as an argument - - !----------------------------------------------------------------------- - - ! Fill array with 1's (see variable description) - denom_field = 1.0_core_rknd - - ! Initializing vertical_avg to avoid a compiler warning. - vertical_avg = 0.0_core_rknd - - - ! Compute the numerator integral. - ! Multiply the variable 'field' at level k by rho_ds at level k and by - ! the level thickness at level k. Then, sum over all vertical levels. - ! Note: The level thickness at level k is the distance between either - ! momentum level k and momentum level k-1, or - ! thermodynamic level k+1 and thermodynamic level k, depending - ! on which field grid is being analyzed. Thus, 1.0/invrs_dz(k) - ! is the level thickness for level k. - ! Note: The values of 'field' and rho_ds are passed into this function - ! so that field(1) and rho_ds(1) are actually 'field' and rho_ds - ! at the level k = 1. - - numer_integral = vertical_integral( total_idx, rho_ds(1:total_idx), & - field(1:total_idx), invrs_dz(1:total_idx) ) - - ! Compute the denominator integral. - ! Multiply rho_ds at level k by the level thickness - ! at level k. Then, sum over all vertical levels. - denom_integral = vertical_integral( total_idx, rho_ds(1:total_idx), & - denom_field(1:total_idx), invrs_dz(1:total_idx) ) - - ! Find the vertical average of 'field'. - vertical_avg = numer_integral / denom_integral - - return - end function vertical_avg - - !============================================================================= - pure function vertical_integral( total_idx, rho_ds, & - field, invrs_dz ) - - ! Description: - ! Computes the vertical integral. rho_ds, field, and invrs_dz must all be - ! of size total_idx and should all start at the same index. - ! - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input variables - integer, intent(in) :: & - total_idx ! The total numer of indices within the range of averaging - - real( kind = core_rknd ), dimension(total_idx), intent(in) :: & - rho_ds, & ! Dry, static density [kg/m^3] - field, & ! The field to be vertically averaged [Units vary] - invrs_dz ! Level thickness [1/m] - ! Note: The rho_ds and field points need to be arranged from - ! lowest to highest in altitude, with rho_ds(1) and - ! field(1) actually their respective values at level k = begin_idx. - - ! Local variables - real( kind = core_rknd ) :: & - vertical_integral ! Integral in the numerator (see description) - - !----------------------------------------------------------------------- - - ! Assertion checks: that begin_idx <= gr%nz - 1 - ! that end_idx >= 2 - ! that begin_idx <= end_idx - - - ! Initializing vertical_integral to avoid a compiler warning. - vertical_integral = 0.0_core_rknd - - ! Compute the integral. - ! Multiply the field at level k by rho_ds at level k and by - ! the level thickness at level k. Then, sum over all vertical levels. - ! Note: The values of the field and rho_ds are passed into this function - ! so that field(1) and rho_ds(1) are actually the field and rho_ds - ! at level k_start. - vertical_integral = sum( field * rho_ds / invrs_dz ) - - return - end function vertical_integral - -!=============================================================================== - -end module crmx_fill_holes diff --git a/src/physics/spcam/crm/CLUBB/crmx_gmres_cache.F90 b/src/physics/spcam/crm/CLUBB/crmx_gmres_cache.F90 deleted file mode 100644 index 008ce4925d..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_gmres_cache.F90 +++ /dev/null @@ -1,171 +0,0 @@ -!---------------------------------------------------------------------------- -! $Id: gmres_cache.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -!============================================================================== -module crmx_gmres_cache - -#ifdef MKL - - use crmx_clubb_precision, only: & - dp ! double precision - - ! Description: - ! This module contains cache data structures for the GMRES wrapper class. - ! - ! This is mostly to allow us to get around some...odd errors when it was - ! integrated into the gmres_wrap module. The cache variables are public, as - ! they will need to be passed in whenever gmres_solve is called. - - implicit none - - public :: gmres_cache_matrix_init, gmres_cache_soln, & - gmres_cache_temp_init - - private ! Default scope - - real( kind = dp ), public, pointer, dimension(:,:) :: & - gmres_prev_soln, & ! Stores the previous solution vectors from earlier - ! GMRES solve runs. The first dimension is for the - ! actual vector; the second dimension is to determine - ! which cache to access--this is done via the GMRES - ! indices for each of the different matrices. - gmres_prev_precond_a ! Stores the previous preconditioner matrix from - ! earlier GMRES solve runs. The first dimension is - ! for the a-array itself; the second dimension is to - ! determine which cached array to access--this is - ! done via the GMRES indices for each of the - ! different matrices. - - real( kind = dp ), public, pointer, dimension(:) :: & - gmres_temp_intlc, & ! Temporary array that stores GMRES internal values - ! for the interlaced matrices (2 x gr%nz grid - ! levels) - gmres_temp_norm ! Temporary array that stores GMRES internal values - ! for the non-interlaced matrices (gr%nz grid - ! levels) - - integer, public :: & - gmres_tempsize_norm, & ! Size of the temporary array for - ! non-interlaced matrices - gmres_tempsize_intlc ! Size of the temporary array for - ! interlaced matrices - - integer, public, parameter :: & - maximum_gmres_idx = 1 ! Maximum number of different types of solves the - ! wrapper can keep memory for. If new matrices are - ! added that GMRES is to be used for, increase this - ! number and add a public parameter corresponding to - ! the matrix below: - - integer, public, parameter :: & - gmres_idx_wp2wp3 = 1 ! GMRES wrapper index for the wp2_wp3 matrices - - logical, public, dimension(maximum_gmres_idx) :: & - l_gmres_soln_ok ! Stores if the current solution is "okay"--that is, if an - ! initial solution has been passed in for that particular - ! cache index. This defaults to false and is set to true - ! when a solution is updated. - - contains - - subroutine gmres_cache_temp_init(numeqns) ! Intent(in) - ! Description: - ! Initialization subroutine for the temporary arrays for GMRES - ! - ! This subroutine initializes the temporary arrays that are used to work - ! the GMRES solver. - ! - ! These temporary arrays are used for all GMRES solves. - ! - ! References: - ! None - - implicit none - - ! Input Variables - integer, intent(in) :: & - numeqns ! Number of equations for non-interlaced matrices (gr%nz) - - integer :: & - numeqns_intlc ! Number of equations for interlaced matrices - - numeqns_intlc = numeqns * 2 - - ! Figure out the sizes of the temporary arrays - ! The equations were lifted from the Intel documentation of dfgmres: - ! http://www.intel.com/software/products/mkl/docs/webhelp/ssr/functn_rci_dfgmres.html - ! All of the ipar(15)s have been replaced with "numeqns", as the code - ! examples seemed to use N (numeqns) in place of ipar(15). - gmres_tempsize_norm = ((((2*numeqns + 1)*numeqns) & - + (numeqns*(numeqns+9))/2) + 1) ! Known magic number - - gmres_tempsize_intlc = ((((2*numeqns_intlc + 1)*numeqns_intlc) & - + (numeqns_intlc*(numeqns_intlc+9))/2) + 1) ! Known magic number - - ! Allocate the temporary arrays - allocate( gmres_temp_intlc(1:gmres_tempsize_intlc), & - gmres_temp_norm(1:gmres_tempsize_norm) ) - - end subroutine gmres_cache_temp_init - - subroutine gmres_cache_matrix_init(max_numeqns, max_elements, & ! Intent(in) - max_gmres_idx) ! Intent(in) - ! Description: - ! Initialization subroutine for the caches for GMRES. - ! - ! This initializes the cache that stores the previous solution and - ! previous preconditioner values for all GMRES solves. - ! - ! References: - ! None - - implicit none - - ! Input Variables - integer, intent(in) :: & - max_numeqns, & ! Maximum number of equations for a matrix that will be - ! solved with GMRES - max_elements, & ! Maximum number of non-zero elements for a matrix that - ! will be solved with GMRES - max_gmres_idx ! Maximum number of distinct matrices that will be solved - ! with GMRES - - allocate( gmres_prev_soln(1:max_numeqns,1:max_gmres_idx), & - gmres_prev_precond_a(1:max_elements,1:max_gmres_idx) ) - - l_gmres_soln_ok = .false. - - end subroutine gmres_cache_matrix_init - - subroutine gmres_cache_soln(numeqns, gmres_idx, solution) ! Intent(in) - ! Description: - ! Subroutine that caches a previous solution for a particular GMRES-solved - ! matrix. - ! - ! Stores the current solution in the cache so it can be referenced for - ! the next GMRES solve. This subroutine will also set the solution_ok - ! flag for that particular GMRES index. - ! - ! References: - ! None - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - integer, intent(in) :: & - numeqns, & ! The number of equations in the solution vector - gmres_idx ! The index for the particular matrix solved by GMRES - - real( kind = core_rknd ), dimension(numeqns), intent(in) :: & - solution ! The solution vector to be cached - - gmres_prev_soln(1:numeqns,gmres_idx) = solution - - l_gmres_soln_ok(gmres_idx) = .true. - - end subroutine gmres_cache_soln - -#endif /* MKL */ - -end module crmx_gmres_cache diff --git a/src/physics/spcam/crm/CLUBB/crmx_gmres_wrap.F90 b/src/physics/spcam/crm/CLUBB/crmx_gmres_wrap.F90 deleted file mode 100644 index bcab38cdb4..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_gmres_wrap.F90 +++ /dev/null @@ -1,391 +0,0 @@ -!---------------------------------------------------------------------------- -! $Id: gmres_wrap.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -!============================================================================== - -module crmx_gmres_wrap - -#ifdef MKL - - ! Description: - ! This module wraps the MKL version of GMRES, an iterative solver. Note that - ! this will only work for the MKL-specific version of GMRES--any other GMRES - ! implementations will require retooling of this code! - ! - ! The primary subroutine, gmres_solve utilizes GMRES to solve a given matrix. - ! - ! There is also a gmres_init, which initializes some of the internal data - ! used for the wrapper. - ! - ! This wrapper automatically keeps prior solutions to use the previous data - ! to speed up the solves. For the purposes of allowing this solver to be used - ! with more than one matrix type, the wrapper has a "solve index" variable. - ! Pass in the proper solve index variable to associate your solve with - ! previous solves of the same matrix. - - use crmx_gmres_cache, only: & - maximum_gmres_idx ! Variable - - implicit none - - public :: gmres_solve, gmres_init - - private ! Default scope - - contains - - subroutine gmres_init(max_numeqns, max_elements) ! Intent(in) - - ! Description: - ! Initialization subroutine for the GMRES iterative matrix equation solver - ! - ! This subroutine initializes the previous memory handles for the GMRES - ! routines, for the purpose of speeding up calculations. - ! These handles are initialized to a size specified by the number of - ! equations specified in this subroutine. - ! - ! WARNING: Once initialized, only use the specified gmres_idx for that - ! particular matrix! Failure to do so could result in greatly decreased - ! performance, incorrect solutions, or both! - ! - ! Once this is called, the proper prev_soln_ and prev_lu_ - ! handles in the gmres_cache module can be used, and will need to be passed - ! in to gmres_solve for that matrix. - ! - ! References: - ! None - - use crmx_gmres_cache, only: & - gmres_cache_matrix_init ! Subroutines - - implicit none - - ! Input Variables - integer, intent(in) :: & - max_numeqns, & ! Maximum number of equations for a matrix that will be - ! solved with GMRES - max_elements ! Maximum number of non-zero elements for a matrix that - ! will be solved with GMRES - - call gmres_cache_matrix_init( max_numeqns, max_elements, maximum_gmres_idx ) - - end subroutine gmres_init - - subroutine gmres_solve(elements, numeqns, & !Intent(in) - csr_a, csr_ia, csr_ja, tempsize, & !Intent(in) - prev_soln, prev_lu, rhs, temp, & !Intent(in/out) - solution, err_code) !Intent(out) - - ! Description: - ! Solves a matrix equation using GMRES. On the first timestep and every - ! fifth timestep afterward, a preconditioner is computed for the matrix - ! and stored. In addition, on the first timestep the matrix is solved using - ! LAPACK, which is used as the estimate for GMRES for the first timestep. - ! After this, the previous solution found is used as the estimate. - ! - ! To use the proper cached preconditioner and solution, make sure you pass - ! the proper gmres_idx corresponding to the matrix you're solving--using a - ! value different than what has been used in the past will cause, at best, - ! a slower solve, and at worst, an incorrect one. - ! - ! References: - ! None - - use crmx_clubb_precision, only: & - dp, & ! double precision - core_rknd - - implicit none - - include "mkl_rci.fi" - - ! Input variables - integer, intent(in) :: & - elements, & ! Number of elements in the csr_a/csr_ja arrays - numeqns ! Number of equations in the matrix - - real( kind = core_rknd ), dimension(elements), intent(in) :: & - csr_a ! A-array description of the matrix in CSR format. This - ! will be converted to double precision for the purposes - ! of running GMRES. - - integer, dimension(numeqns + 1), intent(in) :: & - csr_ia ! IA-array portion of the matrix description in CSR format. - ! This describes the indices of the JA-array that start - ! new rows. For more details, check the documentation in - ! the csr_matrix_class module. - - integer, dimension(elements), intent(in) :: & - csr_ja ! JA-array portion of the matrix description in CSR format. - ! This describes which columns of a are nonzero. For more - ! details, check the documentation in the csr_matrix_class - ! module. - - integer, intent(in) :: & - tempsize ! Denotes the size of the temporary array used for GMRES - ! calculations. - - ! Input/Output variables - real( kind = core_rknd ), dimension(numeqns), intent(inout) :: & - rhs ! Right-hand-side vectors to solve the equation for. - - real( kind = dp ), dimension(numeqns), intent(inout) :: & - prev_soln ! Previous solution cache vector for the matrix to be solved - ! for--pass the proper handle from the gmres_cache module - - real( kind = dp ), dimension(elements), intent(inout) :: & - prev_lu ! Previous LU-decomposition a-array for the matrix to be - ! solved for--pass the proper handle from the gmres_cache - ! module - - real( kind = dp ), dimension(tempsize), intent(inout) :: & - temp ! Temporary array that stores working values while the GMRES - ! solver iterates - - ! Output variables - real( kind = core_rknd ), dimension(numeqns), intent(out) :: & - solution ! Solution vector, output of solver routine - - integer, intent(out) :: & - err_code ! Error code, nonzero if errors occurred. - - ! Local variables - logical :: l_gmres_run ! Variable denoting if we need to loop and run - ! a GMRES iteration again. - - integer :: & - rci_req, & ! RCI_Request for GMRES--allows us to take action based - ! on what the iterative solver requests to be done. - iters ! Total number of iterations GMRES has run. - - integer, dimension(128) :: & - ipar ! Parameter array for the GMRES iterative solver - - real( kind = dp ), dimension(128) :: & - dpar ! Parameter array for the GMRES iterative solver - - ! The following local variables are double-precision so we can use GMRES - ! as there is only double-precision support for GMRES. - ! We will need to convert our single-precision numbers to double precision - ! for the duration of the calculations. - real( kind = dp ), dimension(elements) :: & - csr_dbl_a ! Double-precision version of the CSR-format A array - - real( kind = dp ), dimension(numeqns) :: & - dbl_rhs, & ! Double-precision version of the rhs vector - dbl_soln, & ! Double-precision version of the solution vector - tempvec ! Temporary vector for applying inverse LU-decomp matrix - !tmp_rhs - - ! Variables used to solve the preconditioner the first time with PARDISO. - !integer, parameter :: & - !pardiso_size_arrays = 64, & - !real_nonsymm = 11 - - !integer(kind=8), dimension(pardiso_size_arrays) :: & - ! pt ! PARDISO internal pointer array - - !integer(kind=4), dimension(pardiso_size_arrays) :: & - ! iparm - - !integer(kind=4), dimension(numeqns) :: & - ! perm - - ! integer :: i, j - - ! We want to be running, initially. - l_gmres_run = .true. - - ! Set the default error code to 0 (no errors) - ! This is to make the default explicit; Fortran initializes - ! values to 0. - err_code = 0 - - ! Convert our A array and rhs vector to double precision... - csr_dbl_a = dble(csr_a) - dbl_rhs = dble(rhs) - - ! DEBUG: Set our a_array so it represents the identity matrix, and - ! set the RHS so we can get a meaningful answer. -! csr_dbl_a = 1_dp -! csr_dbl_a(1) = 1D1 -! csr_dbl_a(5) = 1D1 -! csr_dbl_a(elements) = 1D1 -! csr_dbl_a(elements - 4) = 1D1 -! do i=10,elements - 9,5 -! csr_dbl_a(i) = 1D1 -! end do -! do i=1,numeqns,1 -! dbl_rhs(i) = i * 1_dp -! end do -! dbl_rhs = 9D3 -! dbl_rhs = 1D1 - - ! DEBUG: Make sure our a_array isn't wrong -! do i=1,elements,1 -! print *, "csr_dbl_a idx",i,"=",csr_dbl_a(i) -! end do - - ! Figure out the default value for ipar(15) and put it in our ipar_15 int. - !ip_15 = min(150, numeqns) - - ! Figure out the size of the temp array. - !tempsize = ((((2*numeqns + 1)*numeqns)+(numeqns*(numeqns+9))/2) + 1) - ! This ugly equation was lifted from the Intel documentation of dfgmres: - ! http://www.intel.com/software/products/mkl/docs/webhelp/ssr/functn_rci_dfgmres.html - ! All of the ipar(15)s have been replaced with "numeqns", as the code - ! examples seemed to use N (numeqns) in place of ipar(15). - - ! Allocate the temp array. - !allocate(temp(1:tempsize)) - - ! Generate our preconditioner matrix with the ILU0 subroutine. - call dcsrilu0( numeqns, csr_dbl_a, csr_ia, csr_ja, & - prev_lu, ipar, dpar, err_code ) - - ! On the first timestep we need to solve our preconditioner to give us - ! our first solution estimate. After this, the previous solution will - ! suffice as an estimate. -! if (iteration_num(gmres_idx) == 0) then - !solve with precond_a, csr_ia, csr_ja. - !One thing to test, too: try just setting the solution vector to 1 - ! for the first timestep and see if it's not too unreasonably slow? -! call pardisoinit( pt, real_nonsymm, iparm ) -#ifdef _OPENMP -! iparm(3) = omp_get_max_threads() -#else -! iparm(3) = 1 -#endif - -! call pardiso( pt, 1, 1, real_nonsymm, 13, numeqns, & !Intent(in) -! prev_lu, csr_ia, csr_ja, perm, 1, iparm, 0, & !Intent(in) -! dbl_rhs, & !Intent(inout) -! prev_soln, err_code ) !Intent(out) -! end if !iteration_num == 1 - - !DEBUG: Set apporximate solution vector to 0.9 (?) for now - !prev_soln(:) = 0.9_dp - - !do i=1,numeqns,1 - ! print *, "Current approximate solution idx",i,"=",prev_soln(i) - !end do - - ! Initialize our solution vector to the previous solution passed in - dbl_soln = prev_soln - - ! Set up the GMRES solver. - call dfgmres_init( numeqns, dbl_soln, dbl_rhs, & - rci_req, ipar, dpar, temp ) - - ! Set the parameters that tell GMRES to handle stopping tests - ipar(9) = 1 - ipar(10) = 0 - ipar(12) = 1 - - ! Set the parameter that tells GMRES to use a preconditioner - ipar(11) = 1 - - ! Check our GMRES settings. - call dfgmres_check( numeqns, dbl_soln, dbl_rhs, & - rci_req, ipar, dpar, temp ) - - ! Start the GMRES solver. We set up a while loop which will be broken when - ! the GMRES solver indicates that a solution has been found. - do while(l_gmres_run) - !print *, "********************************************************" - !print *, "BEGINNING ANOTHER ITERATION..." - !print *, "========================================================" - ! Run a GMRES iteration. - call dfgmres( numeqns, dbl_soln, dbl_rhs, & - rci_req, ipar, dpar, temp ) - - select case(rci_req) - case (0) - l_gmres_run = .false. - case (1) - ! Multiply our left-hand side by the vector placed in the temp array, - ! at ipar(22), and place the result in the temp array at ipar(23). - ! Display temp(ipar(22)) - ! print *, "------------------------------------------------" - ! print *, "RCI_REQ=1: MULTIPLY VECTOR BY A MATRIX" - ! do i=1,numeqns,1 - ! print *, "Tempvec before, idx",i,"=",temp(ipar(22)+i-1) - ! end do - call mkl_dcsrgemv( 'N', numeqns, csr_dbl_a, csr_ia, csr_ja, & - temp(ipar(22)), temp(ipar(23)) ) ! Known magic number - ! do i=1,numeqns,1 - ! print *, "Tempvec after, idx",i,"=",temp(ipar(23)+i-1) - ! end do - ! print *, "------------------------------------------------" - case (2) - ! Ignore this for now, see if GMRES ever escapes. - case (3) - ! Apply the inverse of the preconditioner to the vector placed in the - ! temp array at ipar(22), and place the result in the temp array at - ! ipar(23). - !print *, "------------------------------------------------" - !print *, "RCI_REQ=3: APPLY PRECONDITION TO VECTOR" - !do i=1,numeqns,1 - ! print *, "Tempvec before, idx",i,"=",temp(ipar(22)+i-1) - !end do - call mkl_dcsrtrsv( 'L', 'N', 'U', numeqns, & - prev_lu, csr_ia, csr_ja, & - temp(ipar(22)), tempvec ) ! Known magic number - call mkl_dcsrtrsv( 'U', 'N', 'N', numeqns, & - prev_lu, csr_ia, csr_ja, & - tempvec, temp(ipar(23)) ) ! Known magic number - !do i=1,numeqns,1 - ! print *, "Tempvec after, idx",i,"=",temp(ipar(23)+i-1) - !end do - !print *, "------------------------------------------------" - - case (4) -! if (dpar(7) < GMRES_TOL) then -! l_gmres_run = .false. -! else -! ! Keep running, we aren't there yet. -! l_gmres_run = .true. -! end if - case default - ! We got a response we weren't expecting. This is probably bad. - ! (Then again, maybe it's just not something we accounted for?) - ! Regardless, let's set an error code and break out of here. - print *, "Unknown rci_request returned from GMRES:", rci_req - l_gmres_run = .false. - err_code = -1 - end select - ! Report current iteration -! call dfgmres_get( numeqns, dbl_soln, dbl_rhs, rci_req, & -! ipar, dpar, temp, iters ) -! print *, "========================================================" -! print *, "END OF LOOP: REPORTING INFORMATION" -! print *, "Current number of GMRES iterations: ", iters -! do i=1,numeqns,1 -! print *, "double value of soln so far, idx",i,"=",dbl_soln(i) -! end do -! print *, "========================================================" -! print *, "********************************************************" - end do - !if (err_code == 0) then - - ! Get the answer, convert it to single-precision - call dfgmres_get( numeqns, dbl_soln, dbl_rhs, rci_req, & - ipar, dpar, temp, iters ) - - !print *, "Total iterations for GMRES:",iters - - !do i=1,numeqns,1 - ! print *, "double value of soln, idx",i,"=",dbl_soln(i) - !end do - - ! Store our solution as the previous solution for use in the next - ! simulation timestep. - prev_soln = dbl_soln - - solution = real(dbl_soln) - !end if - - end subroutine gmres_solve - -#endif /* MKL */ - -end module crmx_gmres_wrap diff --git a/src/physics/spcam/crm/CLUBB/crmx_grid_class.F90 b/src/physics/spcam/crm/CLUBB/crmx_grid_class.F90 deleted file mode 100644 index 26d1a8c86a..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_grid_class.F90 +++ /dev/null @@ -1,2036 +0,0 @@ -!------------------------------------------------------------------------ -! $Id: grid_class.F90 6116 2013-03-22 00:37:40Z bmg2@uwm.edu $ -!=============================================================================== -module crmx_grid_class - - ! Description: - ! - ! Definition of a grid class and associated functions - ! - ! The grid specification is as follows: - ! - ! + ================== zm(nzmax) =========GP======= - ! | - ! | - ! 1/dzt(nzmax) + ------------------ zt(nzmax) ---------GP------- - ! | | - ! | | - ! + 1/dzm(nzmax-1) ================== zm(nzmax-1) ================ - ! | - ! | - ! + ------------------ zt(nzmax-1) ---------------- - ! - ! . - ! . - ! . - ! . - ! - ! ================== zm(k+1) =================== - ! - ! - ! + ------------------ zt(k+1) ------------------- - ! | - ! | - ! + 1/dzm(k) ================== zm(k) ===================== - ! | | - ! | | - ! 1/dzt(k) + ------------------ zt(k) --------------------- - ! | - ! | - ! + ================== zm(k-1) =================== - ! - ! - ! ------------------ zt(k-1) ------------------- - ! - ! . - ! . - ! . - ! . - ! - ! + ================== zm(2) ===================== - ! | - ! | - ! 1/dzt(2) + ------------------ zt(2) --------------------- - ! | | - ! | | - ! + 1/dzm(1) ================== zm(1) ============GP======= zm_init - ! | ////////////////////////////////////////////// surface - ! | - ! + ------------------ zt(1) ------------GP------- - ! - ! - ! The variable zm(k) stands for the momentum level altitude at momentum - ! level k; the variable zt(k) stands for the thermodynamic level altitude at - ! thermodynamic level k; the variable invrs_dzt(k) is the inverse distance - ! between momentum levels (over a central thermodynamic level k); and the - ! variable invrs_dzm(k) is the inverse distance between thermodynamic levels - ! (over a central momentum level k). Please note that in the above diagram, - ! "invrs_dzt" is denoted "dzt", and "invrs_dzm" is denoted "dzm", such that - ! 1/dzt is the distance between successive momentum levels k-1 and k (over a - ! central thermodynamic level k), and 1/dzm is the distance between successive - ! thermodynamic levels k and k+1 (over a central momentum level k). - ! - ! The grid setup is compatible with a stretched (unevely-spaced) grid. Thus, - ! the distance between successive grid levels may not always be constant. - ! - ! The following diagram is an example of a stretched grid that is defined on - ! momentum levels. The thermodynamic levels are placed exactly halfway - ! between the momentum levels. However, the momentum levels do not fall - ! halfway between the thermodynamic levels. - ! - ! =============== zm(k+1) =============== - ! - ! - ! - ! --------------- zt(k+1) --------------- - ! - ! - ! - ! =============== zm(k) =============== - ! - ! --------------- zt(k) --------------- - ! - ! =============== zm(k-1) =============== - ! - ! The following diagram is an example of a stretched grid that is defined on - ! thermodynamic levels. The momentum levels are placed exactly halfway - ! between the thermodynamic levels. However, the thermodynamic levels do not - ! fall halfway between the momentum levels. - ! - ! --------------- zt(k+1) --------------- - ! - ! - ! - ! =============== zm(k) =============== - ! - ! - ! - ! --------------- zt(k) --------------- - ! - ! =============== zm(k-1) =============== - ! - ! --------------- zt(k-1) --------------- - ! - ! NOTE: Any future code written for use in the CLUBB parameterization should - ! use interpolation formulas consistent with a stretched grid. The - ! simplest way to do so is to call the appropriate interpolation - ! function from this module. Interpolations should *not* be handled in - ! the form of: ( var_zm(k) + var_zm(k-1) ) / 2; *nor* in the form of: - ! 0.5_core_rknd*( var_zt(k+1) + var_zt(k) ). Rather, all explicit interpolations - ! should call zt2zm or zm2zt; while interpolations for a variable being - ! solved for implicitly in the code should use gr%weights_zt2zm (which - ! refers to interp_weights_zt2zm_imp), or gr%weights_zm2zt (which - ! refers to interp_weights_zm2zt_imp). - ! - ! Momentum level 1 is placed at altitude zm_init, which is usually at the - ! surface. However, in general, zm_init can be at any altitude defined by the - ! user. - ! - ! GP indicates ghost points. Variables located at those levels are not - ! prognosed, but only used for boundary conditions. - ! - ! Chris Golaz, 7/17/99 - ! modified 9/10/99 - - ! References: - - ! Section 3c, p. 3548 /Numerical discretization/ of: - ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: - ! Method and Model Description'' Golaz, et al. (2002) - ! JAS, Vol. 59, pp. 3540--3551. - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - public :: gr, grid, zt2zm, interp_weights_zt2zm_imp, zm2zt, & - interp_weights_zm2zt_imp, ddzm, ddzt, & - setup_grid, cleanup_grid, setup_grid_heights, & - read_grid_heights, flip, zt2zm_linear, zm2zt_linear - - private :: linear_interpolated_azm, linear_interpolated_azmk, & - interpolated_azmk_imp, linear_interpolated_azt, & - linear_interpolated_aztk, interpolated_aztk_imp, & - gradzm, gradzt, t_above, t_below, m_above, m_below, & - cubic_interpolated_azmk, cubic_interpolated_aztk, & - cubic_interpolated_azm, cubic_interpolated_azt - - private ! Default Scoping - - ! Constant parameters - integer, parameter :: & - t_above = 1, & ! Upper thermodynamic level index (gr%weights_zt2zm). - t_below = 2, & ! Lower thermodynamic level index (gr%weights_zt2zm). - m_above = 1, & ! Upper momentum level index (gr%weights_zm2zt). - m_below = 2 ! Lower momentum level index (gr%weights_zm2zt). - - - type grid - - integer :: nz ! Number of points in the grid - ! Note: Fortran 90/95 prevents an allocatable array from appearing - ! within a derived type. However, a pointer can be used in the same - ! manner as an allocatable array, as we have done here (the grid - ! pointers are always allocated rather than assigned and nullified - ! like real pointers). Note that these must be de-allocated to prevent - ! memory leaks. - real( kind = core_rknd ), pointer, dimension(:) :: & - zm, & ! Momentum grid - zt ! Thermo grid - real( kind = core_rknd ), pointer, dimension(:) :: & - invrs_dzm, & ! The inverse spacing between thermodynamic grid - ! levels; centered over momentum grid levels. - invrs_dzt ! The inverse spacing between momentum grid levels; - ! centered over thermodynamic grid levels. - - real( kind = core_rknd ), pointer, dimension(:) :: & - dzm, & ! Spacing between thermodynamic grid levels; centered over - ! momentum grid levels - dzt ! Spcaing between momentum grid levels; centered over - ! thermodynamic grid levels - - ! These weights are normally used in situations - ! where a momentum level variable is being - ! solved for implicitly in an equation and - ! needs to be interpolated to the thermodynamic grid levels. - real( kind = core_rknd ), pointer, dimension(:,:) :: weights_zm2zt, & - ! These weights are normally used in situations where a - ! thermodynamic level variable is being solved for implicitly in an equation - ! and needs to be interpolated to the momentum grid levels. - weights_zt2zm - - end type grid - - ! The grid is defined here so that it is common throughout the module. - ! The implication is that only one grid can be defined ! - - type (grid) gr - -! Modification for using CLUBB in a host model (i.e. one grid per column) -!$omp threadprivate(gr) - - ! Interfaces provided for function overloading - - ! Interpolation/extension functions - interface zt2zm_linear - ! This performs a linear extension at the highest grid level and therefore - ! does not guarantee, for positive definite quantities (e.g. wp2), that the - ! extended point is indeed positive definite. Positive definiteness can be - ! ensured with a max statement. - ! In the future, we could add a flag (lposdef) and, when needed, apply the - ! max statement directly within interpolated_azm and interpolated_azmk. - module procedure linear_interpolated_azmk, linear_interpolated_azm - end interface - - interface zm2zt_linear - ! This performs a linear extension at the lowest grid level and therefore - ! does not guarantee, for positive definite quantities (e.g. wp2), that the - ! extended point is indeed positive definite. Positive definiteness can be - ! ensured with a max statement. - ! In the future, we could add a flag (lposdef) and, when needed, apply the - ! max statement directly within interpolated_azt and interpolated_aztk. - module procedure linear_interpolated_azt, linear_interpolated_aztk - end interface - - interface zt2zm - ! This version uses cublic spline interpolation of Stefen (1990). - module procedure cubic_interpolated_azmk, cubic_interpolated_azm - end interface - - interface zm2zt - ! As above, but for interpolating zm to zt levels. - module procedure cubic_interpolated_aztk, cubic_interpolated_azt - end interface - - interface interp_weights_zt2zm_imp - module procedure interpolated_azmk_imp - end interface - - - interface interp_weights_zm2zt_imp - module procedure interpolated_aztk_imp - end interface - - ! Vertical derivative functions - interface ddzm - module procedure gradzm - end interface - - interface ddzt - module procedure gradzt - end interface - - contains - - !============================================================================= - subroutine setup_grid( nzmax, sfc_elevation, l_implemented, & - grid_type, deltaz, zm_init, zm_top, & - momentum_heights, thermodynamic_heights, & - begin_height, end_height ) - - ! Description: - ! Grid Constructor - ! - ! This subroutine sets up the CLUBB vertical grid. - ! - ! References: - ! ``Equations for CLUBB'', Sec. 8, Grid Configuration. - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - use crmx_error_code, only: & - clubb_at_least_debug_level ! Procedure(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - integer, parameter :: & - NWARNING = 250 ! Issue a warning if nzmax exceeds this number. - - ! Input Variables - integer, intent(in) :: & - nzmax ! Number of vertical levels in grid [#] - - real( kind = core_rknd ), intent(in) :: & - sfc_elevation ! Elevation of ground level [m AMSL] - - ! Flag to see if CLUBB is running on it's own, - ! or if it's implemented as part of a host model. - logical, intent(in) :: l_implemented - - ! If CLUBB is running on it's own, this option determines if it is using: - ! 1) an evenly-spaced grid; - ! 2) a stretched (unevenly-spaced) grid entered on the thermodynamic grid - ! levels (with momentum levels set halfway between thermodynamic levels); - ! or - ! 3) a stretched (unevenly-spaced) grid entered on the momentum grid levels - ! (with thermodynamic levels set halfway between momentum levels). - integer, intent(in) :: grid_type - - ! If the CLUBB model is running by itself, and is using an evenly-spaced - ! grid (grid_type = 1), it needs the vertical grid spacing and - ! momentum-level starting altitude as input. - real( kind = core_rknd ), intent(in) :: & - deltaz, & ! Vertical grid spacing [m] - zm_init, & ! Initial grid altitude (momentum level) [m] - zm_top ! Maximum grid altitude (momentum level) [m] - - ! If the CLUBB parameterization is implemented in a host model, it needs to - ! use the host model's momentum level altitudes and thermodynamic level - ! altitudes. - ! If the CLUBB model is running by itself, but is using a stretched grid - ! entered on thermodynamic levels (grid_type = 2), it needs to use the - ! thermodynamic level altitudes as input. - ! If the CLUBB model is running by itself, but is using a stretched grid - ! entered on momentum levels (grid_type = 3), it needs to use the momentum - ! level altitudes as input. - real( kind = core_rknd ), intent(in), dimension(nzmax) :: & - momentum_heights, & ! Momentum level altitudes (input) [m] - thermodynamic_heights ! Thermodynamic level altitudes (input) [m] - - integer, intent(out) :: & - begin_height, & ! Lower bound for *_heights arrays [-] - end_height ! Upper bound for *_heights arrays [-] - - ! Local Variables - integer :: ierr, & ! Allocation stat - i ! Loop index - - - ! ---- Begin Code ---- - - ! Define the grid size - - if ( nzmax > NWARNING .and. clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) "Warning: running with vertical grid "// & - "which is larger than", NWARNING, "levels." - write(fstderr,*) "This may take a lot of CPU time and memory." - end if - - gr%nz = nzmax - - ! Default bounds - begin_height = 1 - - end_height = gr%nz - - !--------------------------------------------------- - if ( .not. l_implemented ) then - - if ( grid_type == 1 ) then - - ! Determine the number of grid points given the spacing - ! to fit within the bounds without going over. - gr%nz = floor( ( zm_top - zm_init + deltaz ) / deltaz ) - - else if( grid_type == 2 ) then! Thermo - - ! Find begin_height (lower bound) - - i = gr%nz - - do while( thermodynamic_heights(i) >= zm_init .and. i > 1 ) - - i = i - 1 - - end do - - if( thermodynamic_heights(i) >= zm_init ) then - - stop "Stretched zt grid cannot fulfill zm_init requirement" - - else - - begin_height = i - - end if - - ! Find end_height (upper bound) - - i = gr%nz - - do while( thermodynamic_heights(i) > zm_top .and. i > 1 ) - - i = i - 1 - - end do - - if( zm_top < thermodynamic_heights(i) ) then - - stop "Stretched zt grid cannot fulfill zm_top requirement" - - else - - end_height = i - - gr%nz = size( thermodynamic_heights(begin_height:end_height) ) - - end if - - else if( grid_type == 3 ) then ! Momentum - - ! Find begin_height (lower bound) - - i = 1 - - do while( momentum_heights(i) < zm_init .and. i < gr%nz ) - - i = i + 1 - - end do - - if( momentum_heights(i) < zm_init ) then - - stop "Stretched zm grid cannot fulfill zm_init requirement" - - else - - begin_height = i - - end if - - ! Find end_height (lower bound) - - i = gr%nz - - do while( momentum_heights(i) > zm_top .and. i > 1 ) - - i = i - 1 - - end do - - if( momentum_heights(i) > zm_top ) then - - stop "Stretched zm grid cannot fulfill zm_top requirement" - - else - - end_height = i - - gr%nz = size( momentum_heights(begin_height:end_height) ) - - end if - - endif ! grid_type - - endif ! l_implemented - - !--------------------------------------------------- - - ! Allocate memory for the grid levels - allocate( gr%zm(gr%nz), gr%zt(gr%nz), & - gr%dzm(gr%nz), gr%dzt(gr%nz), & - gr%invrs_dzm(gr%nz), gr%invrs_dzt(gr%nz), & - gr%weights_zm2zt(m_above:m_below,gr%nz), & - gr%weights_zt2zm(t_above:t_below,gr%nz), & - stat=ierr ) - - if ( ierr /= 0 ) then - write(fstderr,*) "In setup_grid: allocation of grid variables failed." - stop "Fatal error." - end if - - ! Set the values for the derived types used for heights, derivatives, and - ! interpolation from the momentum/thermodynamic grid - call setup_grid_heights & - ( l_implemented, grid_type, & - deltaz, zm_init, & - momentum_heights(begin_height:end_height), & - thermodynamic_heights(begin_height:end_height) ) - - if ( sfc_elevation > gr%zm(1) ) then - write(fstderr,*) "The altitude of the lowest momentum level, " & - // "gr%zm(1), must be at or above the altitude of " & - // "the surface, sfc_elevation. The lowest model " & - // "momentum level cannot be below the surface." - write(fstderr,*) "Altitude of lowest momentum level =", gr%zm(1) - write(fstderr,*) "Altitude of the surface =", sfc_elevation - stop "Fatal error." - endif - - return - - end subroutine setup_grid - - !============================================================================= - subroutine cleanup_grid - - ! Description: - ! De-allocates the memory for the grid - ! - ! References: - ! None - !------------------------------------------------------------------------------ - use crmx_constants_clubb, only: & - fstderr ! Constant - - implicit none - - ! Local Variable(s) - integer :: ierr - - ! ----- Begin Code ----- - - ! Allocate memory for grid levels - deallocate( gr%zm, gr%zt, & - gr%dzm, gr%dzt, & - gr%invrs_dzm, gr%invrs_dzt, & - gr%weights_zm2zt, gr%weights_zt2zm, & - stat=ierr ) - - if ( ierr /= 0 ) then - write(fstderr,*) "Grid deallocation failed." - end if - - return - end subroutine cleanup_grid - - !============================================================================= - subroutine setup_grid_heights & - ( l_implemented, grid_type, & - deltaz, zm_init, momentum_heights, & - thermodynamic_heights ) - - ! Description: - ! Sets the heights and interpolation weights of the column. - ! This is seperated from setup_grid for those host models that have heights - ! that vary with time. - ! References: - ! None - !------------------------------------------------------------------------------ - - use crmx_constants_clubb, only: fstderr ! Constant - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - - ! Flag to see if CLUBB is running on it's own, - ! or if it's implemented as part of a host model. - logical, intent(in) :: l_implemented - - ! If CLUBB is running on it's own, this option determines if it is using: - ! 1) an evenly-spaced grid; - ! 2) a stretched (unevenly-spaced) grid entered on the thermodynamic grid - ! levels (with momentum levels set halfway between thermodynamic levels); - ! or - ! 3) a stretched (unevenly-spaced) grid entered on the momentum grid levels - ! (with thermodynamic levels set halfway between momentum levels). - integer, intent(in) :: grid_type - - ! If the CLUBB model is running by itself, and is using an evenly-spaced - ! grid (grid_type = 1), it needs the vertical grid spacing and - ! momentum-level starting altitude as input. - real( kind = core_rknd ), intent(in) :: & - deltaz, & ! Vertical grid spacing [m] - zm_init ! Initial grid altitude (momentum level) [m] - - - ! If the CLUBB parameterization is implemented in a host model, it needs to - ! use the host model's momentum level altitudes and thermodynamic level - ! altitudes. - ! If the CLUBB model is running by itself, but is using a stretched grid - ! entered on thermodynamic levels (grid_type = 2), it needs to use the - ! thermodynamic level altitudes as input. - ! If the CLUBB model is running by itself, but is using a stretched grid - ! entered on momentum levels (grid_type = 3), it needs to use the momentum - ! level altitudes as input. - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - momentum_heights, & ! Momentum level altitudes (input) [m] - thermodynamic_heights ! Thermodynamic level altitudes (input) [m] - - integer :: k - - ! ---- Begin Code ---- - - if ( .not. l_implemented ) then - - - if ( grid_type == 1 ) then - - ! Evenly-spaced grid. - ! Momentum level altitudes are defined based on the grid starting - ! altitude, zm_init, the constant grid-spacing, deltaz, and the number - ! of grid levels, gr%nz. - - ! Define momentum level altitudes. The first momentum level is at - ! altitude zm_init. - do k = 1, gr%nz, 1 - gr%zm(k) = zm_init + real( k-1, kind = core_rknd ) * deltaz - enddo - - ! Define thermodynamic level altitudes. Thermodynamic level altitudes - ! are located at the central altitude levels, exactly halfway between - ! momentum level altitudes. The lowermost thermodynamic level is - ! found by taking 1/2 the altitude difference between the bottom two - ! momentum levels and subtracting that value from the bottom momentum - ! level. The first thermodynamic level is below zm_init. - gr%zt(1) = zm_init - ( 0.5_core_rknd * deltaz ) - do k = 2, gr%nz, 1 - gr%zt(k) = 0.5_core_rknd * ( gr%zm(k) + gr%zm(k-1) ) - enddo - - - elseif ( grid_type == 2 ) then - - ! Stretched (unevenly-spaced) grid: stretched thermodynamic levels. - ! Thermodynamic levels are defined according to a stretched grid that - ! is entered through the use of an input file. This is similar to a - ! SAM-style stretched grid. - - ! Define thermodynamic level altitudes. - do k = 1, gr%nz, 1 - gr%zt(k) = thermodynamic_heights(k) - enddo - - ! Define momentum level altitudes. Momentum level altitudes are - ! located at the central altitude levels, exactly halfway between - ! thermodynamic level altitudes. The uppermost momentum level - ! altitude is found by taking 1/2 the altitude difference between the - ! top two thermodynamic levels and adding that value to the top - ! thermodynamic level. - do k = 1, gr%nz-1, 1 - gr%zm(k) = 0.5_core_rknd * ( gr%zt(k+1) + gr%zt(k) ) - enddo - gr%zm(gr%nz) = gr%zt(gr%nz) + & - 0.5_core_rknd * ( gr%zt(gr%nz) - gr%zt(gr%nz-1) ) - - elseif ( grid_type == 3 ) then - - ! Stretched (unevenly-spaced) grid: stretched momentum levels. - ! Momentum levels are defined according to a stretched grid that is - ! entered through the use of an input file. This is similar to a - ! WRF-style stretched grid. - - ! Define momentum level altitudes. - do k = 1, gr%nz, 1 - gr%zm(k) = momentum_heights(k) - enddo - - ! Define thermodynamic level altitudes. Thermodynamic level altitudes - ! are located at the central altitude levels, exactly halfway between - ! momentum level altitudes. The lowermost thermodynamic level - ! altitude is found by taking 1/2 the altitude difference between the - ! bottom two momentum levels and subtracting that value from the - ! bottom momentum level. - gr%zt(1) = gr%zm(1) - 0.5_core_rknd * ( gr%zm(2) - gr%zm(1) ) - do k = 2, gr%nz, 1 - gr%zt(k) = 0.5_core_rknd * ( gr%zm(k) + gr%zm(k-1) ) - enddo - - - else - - ! Invalid grid type. - write(fstderr,*) "Invalid grid type: ", grid_type, & - ". Valid options are 1, 2, or 3." - stop "Fatal error." - - - endif - - - else - - ! The CLUBB parameterization is implemented in a host model. - ! Use the host model's momentum level altitudes and thermodynamic level - ! altitudes to set up the CLUBB grid. - - ! Momentum level altitudes from host model. - do k = 1, gr%nz, 1 - gr%zm(k) = momentum_heights(k) - enddo - - ! Thermodynamic level altitudes from host model after possible grid-index - ! adjustment for CLUBB interface. - do k = 1, gr%nz, 1 - gr%zt(k) = thermodynamic_heights(k) - enddo - - - endif ! not l_implemented - - - ! Define dzm, the spacing between thermodynamic grid levels; centered over - ! momentum grid levels - do k=1,gr%nz-1 - gr%dzm(k) = gr%zt(k+1) - gr%zt(k) - enddo - gr%dzm(gr%nz) = gr%dzm(gr%nz-1) - - ! Define dzt, the spacing between momentum grid levels; centered over - ! thermodynamic grid levels - do k=2,gr%nz - gr%dzt(k) = gr%zm(k) - gr%zm(k-1) - enddo - gr%dzt(1) = gr%dzt(2) - - ! Define invrs_dzm, which is the inverse spacing between thermodynamic grid - ! levels; centered over momentum grid levels. - do k=1,gr%nz-1 - gr%invrs_dzm(k) = 1._core_rknd / ( gr%zt(k+1) - gr%zt(k) ) - enddo - gr%invrs_dzm(gr%nz) = gr%invrs_dzm(gr%nz-1) - - - ! Define invrs_dzt, which is the inverse spacing between momentum grid - ! levels; centered over thermodynamic grid levels. - do k=2,gr%nz - gr%invrs_dzt(k) = 1._core_rknd / ( gr%zm(k) - gr%zm(k-1) ) - enddo - gr%invrs_dzt(1) = gr%invrs_dzt(2) - - - ! Interpolation Weights: zm grid to zt grid. - ! The grid index (k) is the index of the level on the thermodynamic (zt) - ! grid. The result is the weights of the upper and lower momentum levels - ! (that sandwich the thermodynamic level) applied to that thermodynamic - ! level. These weights are normally used in situations where a momentum - ! level variable is being solved for implicitly in an equation, and the - ! aforementioned variable needs to be interpolated from three successive - ! momentum levels (the central momentum level, as well as one momentum level - ! above and below the central momentum level) to the intermediate - ! thermodynamic grid levels that sandwich the central momentum level. - ! For more information, see the comments in function interpolated_aztk_imp. - do k = 1, gr%nz, 1 - gr%weights_zm2zt(m_above:m_below,k) & - = interp_weights_zm2zt_imp( k ) - enddo - - - ! Interpolation Weights: zt grid to zm grid. - ! The grid index (k) is the index of the level on the momentum (zm) grid. - ! The result is the weights of the upper and lower thermodynamic levels - ! (that sandwich the momentum level) applied to that momentum level. These - ! weights are normally used in situations where a thermodynamic level - ! variable is being solved for implicitly in an equation, and the - ! aforementioned variable needs to be interpolated from three successive - ! thermodynamic levels (the central thermodynamic level, as well as one - ! thermodynamic level above and below the central thermodynamic level) to - ! the intermediate momentum grid levels that sandwich the central - ! thermodynamic level. - ! For more information, see the comments in function interpolated_azmk_imp. - - do k = 1, gr%nz, 1 - gr%weights_zt2zm(t_above:t_below,k) & - = interp_weights_zt2zm_imp( k ) - enddo - - return - end subroutine setup_grid_heights - - !============================================================================= - subroutine read_grid_heights( nzmax, grid_type, & - zm_grid_fname, zt_grid_fname, & - file_unit, & - momentum_heights, & - thermodynamic_heights ) - - ! Description: - ! This subroutine is used foremost in cases where the grid_type corresponds - ! with the stretched (unevenly-spaced) grid options (either grid_type = 2 or - ! grid_type = 3). This subroutine reads in the values of the stretched grid - ! altitude levels for either the thermodynamic level grid or the momentum - ! level grid. This subroutine also handles basic error checking for all - ! three grid types. - !------------------------------------------------------------------------ - - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - use crmx_file_functions, only: & - file_read_1d ! Procedure(s) - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables. - - ! Declared number of vertical levels. - integer, intent(in) :: & - nzmax - - ! If CLUBB is running on it's own, this option determines if it is using: - ! 1) an evenly-spaced grid; - ! 2) a stretched (unevenly-spaced) grid entered on the thermodynamic grid - ! levels (with momentum levels set halfway between thermodynamic levels); - ! or - ! 3) a stretched (unevenly-spaced) grid entered on the momentum grid levels - ! (with thermodynamic levels set halfway between momentum levels). - integer, intent(in) :: & - grid_type - - character(len=*), intent(in) :: & - zm_grid_fname, & ! Path and filename of file for momentum level altitudes - zt_grid_fname ! Path and filename of file for thermodynamic level altitudes - - integer, intent(in) :: & - file_unit ! Unit number for zt_grid_fname & zm_grid_fname (based on the OpenMP thread) - - ! Output Variables. - - ! If the CLUBB model is running by itself, but is using a stretched grid - ! entered on thermodynamic levels (grid_type = 2), it needs to use the - ! thermodynamic level altitudes as input. - ! If the CLUBB model is running by itself, but is using a stretched grid - ! entered on momentum levels (grid_type = 3), it needs to use the momentum - ! level altitudes as input. - real( kind = core_rknd ), dimension(nzmax), intent(out) :: & - momentum_heights, & ! Momentum level altitudes (file input) [m] - thermodynamic_heights ! Thermodynamic level altitudes (file input) [m] - - ! Local Variables. - - integer :: & - zt_level_count, & ! Number of altitudes found in zt_grid_fname - zm_level_count ! Number of altitudes found in zm_grid_fname - - integer :: input_status ! Status of file being read: - ! > 0 ==> error reading file. - ! = 0 ==> no error and more file to be read. - ! < 0 ==> end of file indicator. - - ! Generic variable for storing file data while counting the number - ! of file entries. - real( kind = core_rknd ) :: generic_input_item - - integer :: k ! Loop index - - ! ---- Begin Code ---- - - ! Declare the momentum level altitude array and the thermodynamic level - ! altitude array to be 0 until overwritten. - momentum_heights(1:nzmax) = 0.0_core_rknd - thermodynamic_heights(1:nzmax) = 0.0_core_rknd - - ! Avoid uninitialized memory - generic_input_item = 0.0_core_rknd - - - if ( grid_type == 1 ) then - - ! Evenly-spaced grid. - ! Grid level altitudes are based on a constant distance between them and - ! a starting point for the bottom of the grid. - - ! As a way of error checking, make sure that there isn't any file entry - ! for either momentum level altitudes or thermodynamic level altitudes. - if ( zm_grid_fname /= '' ) then - write(fstderr,*) & - "An evenly-spaced grid has been selected. " & - // " Please reset zm_grid_fname to ''." - stop - endif - if ( zt_grid_fname /= '' ) then - write(fstderr,*) & - "An evenly-spaced grid has been selected. " & - // " Please reset zt_grid_fname to ''." - stop - endif - - - elseif ( grid_type == 2 ) then - - ! Stretched (unevenly-spaced) grid: stretched thermodynamic levels. - ! Thermodynamic levels are defined according to a stretched grid that is - ! entered through the use of an input file. Momentum levels are set - ! halfway between thermodynamic levels. This is similar to a SAM-style - ! stretched grid. - - ! As a way of error checking, make sure that there isn't any file entry - ! for momentum level altitudes. - if ( zm_grid_fname /= '' ) then - write(fstderr,*) & - "Thermodynamic level altitudes have been selected " & - // "for use in a stretched (unevenly-spaced) grid. " & - // " Please reset zm_grid_fname to ''." - stop - endif - - ! Open the file zt_grid_fname. - open( unit=file_unit, file=zt_grid_fname, & - status='old', action='read' ) - - ! Find the number of thermodynamic level altitudes listed - ! in file zt_grid_fname. - zt_level_count = 0 - do - read( unit=file_unit, fmt=*, iostat=input_status ) & - generic_input_item - if ( input_status < 0 ) exit ! end of file indicator - if ( input_status > 0 ) stop & ! error reading input - "Error reading thermodynamic level input file." - zt_level_count = zt_level_count + 1 - enddo - - ! Close the file zt_grid_fname. - close( unit=file_unit ) - - ! Check that the number of thermodynamic grid altitudes in the input file - ! matches the declared number of CLUBB grid levels (nzmax). - if ( zt_level_count /= nzmax ) then - write(fstderr,*) & - "The number of thermodynamic grid altitudes " & - // "listed in file " // trim(zt_grid_fname) & - // " does not match the number of CLUBB grid " & - // "levels specified in the model.in file." - write(fstderr,*) & - "Number of thermodynamic grid altitudes listed: ", & - zt_level_count - write(fstderr,*) & - "Number of CLUBB grid levels specified: ", nzmax - stop - endif - - ! Read the thermodynamic level altitudes from zt_grid_fname. - call file_read_1d( file_unit, zt_grid_fname, nzmax, 1, & - thermodynamic_heights ) - - ! Check that each thermodynamic level altitude increases - ! in height as the thermodynamic level grid index increases. - do k = 2, nzmax, 1 - if ( thermodynamic_heights(k) & - <= thermodynamic_heights(k-1) ) then - write(fstderr,*) & - "The declared thermodynamic level grid " & - // "altitudes are not increasing in height " & - // "as grid level index increases." - write(fstderr,*) & - "Grid index: ", k-1, ";", & - " Thermodynamic level altitude: ", & - thermodynamic_heights(k-1) - write(fstderr,*) & - "Grid index: ", k, ";", & - " Thermodynamic level altitude: ", & - thermodynamic_heights(k) - stop - endif - enddo - - - elseif ( grid_type == 3 ) then - - ! Stretched (unevenly-spaced) grid: stretched momentum levels. - ! Momentum levels are defined according to a stretched grid that is - ! entered through the use of an input file. Thermodynamic levels are set - ! halfway between momentum levels. This is similar to a WRF-style - ! stretched grid. - - ! As a way of error checking, make sure that there isn't any file entry - ! for thermodynamic level altitudes. - if ( zt_grid_fname /= '' ) then - write(fstderr,*) & - "Momentum level altitudes have been selected " & - // "for use in a stretched (unevenly-spaced) grid. " & - // " Please reset zt_grid_fname to ''." - stop - endif - - ! Open the file zm_grid_fname. - open( unit=file_unit, file=zm_grid_fname, & - status='old', action='read' ) - - ! Find the number of momentum level altitudes - ! listed in file zm_grid_fname. - zm_level_count = 0 - do - read( unit=file_unit, fmt=*, iostat=input_status ) & - generic_input_item - if ( input_status < 0 ) exit ! end of file indicator - if ( input_status > 0 ) stop & ! error reading input - "Error reading momentum level input file." - zm_level_count = zm_level_count + 1 - enddo - - ! Close the file zm_grid_fname. - close( unit=file_unit ) - - ! Check that the number of momentum grid altitudes in the input file - ! matches the declared number of CLUBB grid levels (nzmax). - if ( zm_level_count /= nzmax ) then - write(fstderr,*) & - "The number of momentum grid altitudes " & - // "listed in file " // trim(zm_grid_fname) & - // " does not match the number of CLUBB grid " & - // "levels specified in the model.in file." - write(fstderr,*) & - "Number of momentum grid altitudes listed: ", & - zm_level_count - write(fstderr,*) & - "Number of CLUBB grid levels specified: ", nzmax - stop - endif - - ! Read the momentum level altitudes from zm_grid_fname. - call file_read_1d( file_unit, zm_grid_fname, nzmax, 1, & - momentum_heights ) - - ! Check that each momentum level altitude increases in height as the - ! momentum level grid index increases. - do k = 2, nzmax, 1 - if ( momentum_heights(k) & - <= momentum_heights(k-1) ) then - write(fstderr,*) & - "The declared momentum level grid " & - // "altitudes are not increasing in height " & - // "as grid level index increases." - write(fstderr,*) & - "Grid index: ", k-1, ";", & - " Momentum level altitude: ", & - momentum_heights(k-1) - write(fstderr,*) & - "Grid index: ", k, ";", & - " Momentum level altitude: ", & - momentum_heights(k) - stop - endif - enddo - - - endif - - - ! The purpose of this if statement is to avoid a compiler warning. - if ( generic_input_item > 0.0_core_rknd ) then - ! Do nothing - endif - ! Joshua Fasching June 2008 - - return - - end subroutine read_grid_heights - - !============================================================================= - pure function linear_interpolated_azm( azt ) - - ! Description: - ! Function to interpolate a variable located on the thermodynamic grid - ! levels (azt) to the momentum grid levels (azm). This function inputs the - ! entire azt array and outputs the results as an azm array. The - ! formulation used is compatible with a stretched (unevenly-spaced) grid. - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_interpolation, only: linear_interp_factor - - implicit none - - ! Input Variable - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azt - - ! Return Variable - real( kind = core_rknd ), dimension(gr%nz) :: linear_interpolated_azm - - ! Local Variable - integer :: k - - ! ---- Begin Code ---- - - ! Do the actual interpolation. - ! Use linear interpolation. - forall( k = 1 : gr%nz-1 : 1 ) - linear_interpolated_azm(k) = & - linear_interp_factor( gr%weights_zt2zm(1, k), azt(k+1), azt(k) ) - end forall - -! ! Set the value of azm at level gr%nz (the uppermost level in the model) -! ! to the value of azt at level gr%nz. -! linear_interpolated_azm(gr%nz) = azt(gr%nz) - ! Use a linear extension based on the values of azt at levels gr%nz and - ! gr%nz-1 to find the value of azm at level gr%nz (the uppermost level - ! in the model). - linear_interpolated_azm(gr%nz) = & - ( ( azt(gr%nz)-azt(gr%nz-1) ) & - / ( gr%zt(gr%nz)-gr%zt(gr%nz-1) ) ) & - * ( gr%zm(gr%nz)-gr%zt(gr%nz) ) + azt(gr%nz) - - return - - end function linear_interpolated_azm - - !============================================================================= - pure function linear_interpolated_azmk( azt, k ) - - ! Description: - ! Function to interpolate a variable located on the thermodynamic grid - ! levels (azt) to the momentum grid levels (azm). This function outputs the - ! value of azm at a single grid level (k) after interpolating using values - ! of azt at two grid levels. The formulation used is compatible with a - ! stretched (unevenly-spaced) grid. - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_interpolation, only: linear_interp_factor - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azt - - integer, intent(in) :: k - - ! Return Variable - real( kind = core_rknd ) :: linear_interpolated_azmk - - ! ---- Begin Code ---- - - ! Do the actual interpolation. - ! Use a linear interpolation. - if ( k /= gr%nz ) then - - linear_interpolated_azmk = & - linear_interp_factor( gr%weights_zt2zm(1, k), azt(k+1), azt(k) ) - - else - -! ! Set the value of azm at level gr%nz (the uppermost level in the -! ! model) to the value of azt at level gr%nz. -! linear_interpolated_azmk = azt(gr%nz) - ! Use a linear extension based on the values of azt at levels gr%nz and - ! gr%nz-1 to find the value of azm at level gr%nz (the uppermost - ! level in the model). - linear_interpolated_azmk = & - ( ( azt(gr%nz)-azt(gr%nz-1) ) & - / ( gr%zt(gr%nz)-gr%zt(gr%nz-1) ) ) & - * ( gr%zm(gr%nz)-gr%zt(gr%nz) ) + azt(gr%nz) - - endif - - return - - end function linear_interpolated_azmk - - !============================================================================= - pure function cubic_interpolated_azm( azt ) - - ! Description: - ! Function to interpolate a variable located on the thermodynamic grid - ! levels (azt) to the momentum grid levels (azm). This function outputs the - ! value of azt at a all grid levels using Steffen's monotonic cubic - ! interpolation implemented by Tak Yamaguchi. - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - azt - - ! Return Variable - real( kind = core_rknd ), dimension(gr%nz) :: & - cubic_interpolated_azm - - ! Local Variable(s) - real( kind = core_rknd ), dimension(gr%nz) :: & - tmp ! This is needed for variables that self-reference - integer :: & - k - - ! ---- Begin Code ---- - - forall( k = 1 : gr%nz ) - tmp(k) = cubic_interpolated_azmk( azt, k ) - end forall - - cubic_interpolated_azm = tmp - - return - - end function cubic_interpolated_azm - - !============================================================================= - pure function cubic_interpolated_azmk( azt, k ) - - ! Description: - ! Function to interpolate a variable located on the thermodynamic grid - ! levels (azt) to the momentum grid levels (azm). This function outputs the - ! value of azm at a single grid level (k) using Steffen's monotonic cubic - ! interpolation implemented by Tak Yamaguchi. - !----------------------------------------------------------------------- - - use crmx_interpolation, only: mono_cubic_interp - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azt - - integer, intent(in) :: k - - ! Return Variable - real( kind = core_rknd ) :: cubic_interpolated_azmk - - ! Local Variable(s) - integer :: km1, k00, kp1, kp2 - - ! ---- Begin Code ---- - - ! Special case for a very small domain - if ( gr%nz < 3 ) then - cubic_interpolated_azmk = linear_interpolated_azmk( azt, k ) - return - end if - - ! k levels are based on Tak's find_indices subroutine -dschanen 24 Oct 2011 - if ( k == gr%nz-1 ) then - km1 = gr%nz-2 - kp1 = gr%nz - kp2 = gr%nz - k00 = gr%nz-1 - else if ( k == gr%nz ) then ! Extrapolation - km1 = gr%nz - kp1 = gr%nz - kp2 = gr%nz - k00 = gr%nz-1 - else if ( k == 1 ) then - km1 = 1 - kp1 = 2 - kp2 = 3 - k00 = 1 - else - km1 = k-1 - kp1 = k+1 - kp2 = k+2 - k00 = k - end if - - ! Do the actual interpolation. - ! Use a cubic monotonic spline interpolation. - cubic_interpolated_azmk = & - mono_cubic_interp( gr%zm(k), km1, k00, kp1, kp2, & - gr%zt(km1), gr%zt(k00), gr%zt(kp1), gr%zt(kp2), & - azt(km1), azt(k00), azt(kp1), azt(kp2) ) - - return - - end function cubic_interpolated_azmk - - !============================================================================= - pure function interpolated_azmk_imp( m_lev ) & - result( azt_weight ) - - ! Description: - ! Function used to help in an interpolation of a variable (var_zt) located - ! on the thermodynamic grid levels (azt) to the momentum grid levels (azm). - ! This function computes a weighting factor for both the upper thermodynamic - ! level (k+1) and the lower thermodynamic level (k) applied to the central - ! momentum level (k). For the uppermost momentum grid level (k=gr%nz), a - ! weighting factor for both the thermodynamic level at gr%nz and the - ! thermodynamic level at gr%nz-1 are calculated based on the use of a - ! linear extension. This function outputs the weighting factors at a single - ! momentum grid level (k). The formulation used is compatible with a - ! stretched (unevenly-spaced) grid. The weights are defined as follows: - ! - ! ---var_zt(k+1)------------------------------------------- t(k+1) - ! azt_weight(t_above) = factor - ! ===========var_zt(interp)================================ m(k) - ! azt_weight(t_below) = 1 - factor - ! ---var_zt(k)--------------------------------------------- t(k) - ! - ! The vertical indices t(k+1), m(k), and t(k) correspond with altitudes - ! zt(k+1), zm(k), and zt(k), respectively. The letter "t" is used for - ! thermodynamic levels and the letter "m" is used for momentum levels. - ! - ! For all levels k < gr%nz: - ! - ! The formula for a linear interpolation is given by: - ! - ! var_zt( interp to zm(k) ) - ! = [ ( var_zt(k+1) - var_zt(k) ) / ( zt(k+1) - zt(k) ) ] - ! * ( zm(k) - zt(k) ) + var_zt(k); - ! - ! which can be rewritten as: - ! - ! var_zt( interp to zm(k) ) - ! = [ ( zm(k) - zt(k) ) / ( zt(k+1) - zt(k) ) ] - ! * ( var_zt(k+1) - var_zt(k) ) + var_zt(k). - ! - ! Furthermore, the formula can be rewritten as: - ! - ! var_zt( interp to zm(k) ) - ! = factor * var_zt(k+1) + ( 1 - factor ) * var_zt(k); - ! - ! where: - ! - ! factor = ( zm(k) - zt(k) ) / ( zt(k+1) - zt(k) ). - ! - ! One of the important uses of this function is in situations where the - ! variable to be interpolated is being treated IMPLICITLY in an equation. - ! Usually, the variable to be interpolated is involved in a derivative (such - ! as d(var_zt)/dz in the diagram below). For the term of the equation - ! containing the derivative, grid weights are needed for two interpolations, - ! rather than just one interpolation. Thus, four grid weights (labeled - ! A(k), B(k), C(k), and D(k) in the diagram below) are needed. - ! - ! ---var_zt(k+1)------------------------------------------- t(k+1) - ! A(k) - ! ===========var_zt(interp)================================ m(k) - ! B(k) = 1 - A(k) - ! ---var_zt(k)-----------d(var_zt)/dz---------------------- t(k) - ! C(k) - ! ===========var_zt(interp)================================ m(k-1) - ! D(k) = 1 - C(k) - ! ---var_zt(k-1)------------------------------------------- t(k-1) - ! - ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond - ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively. - ! The letter "t" is used for thermodynamic levels and the letter "m" is used - ! for momentum levels. - ! - ! The grid weights, indexed around the central thermodynamic level (k), are - ! defined as follows: - ! - ! A(k) = ( zm(k) - zt(k) ) / ( zt(k+1) - zt(k) ); - ! - ! which is the same as "factor" for the interpolation to momentum - ! level (k). In the code, this interpolation is referenced as - ! gr%weights_zt2zm(t_above,mk), which can be read as "grid weight in a zt2zm - ! interpolation of the thermodynamic level above momentum level (k) (applied - ! to momentum level (k))". - ! - ! B(k) = 1 - [ ( zm(k) - zt(k) ) / ( zt(k+1) - zt(k) ) ] - ! = 1 - A(k); - ! - ! which is the same as "1 - factor" for the interpolation to momentum - ! level (k). In the code, this interpolation is referenced as - ! gr%weights_zt2zm(t_below,mk), which can be read as "grid weight in a zt2zm - ! interpolation of the thermodynamic level below momentum level (k) (applied - ! to momentum level (k))". - ! - ! C(k) = ( zm(k-1) - zt(k-1) ) / ( zt(k) - zt(k-1) ); - ! - ! which is the same as "factor" for the interpolation to momentum - ! level (k-1). In the code, this interpolation is referenced as - ! gr%weights_zt2zm(t_above,mkm1), which can be read as "grid weight in a - ! zt2zm interpolation of the thermodynamic level above momentum level (k-1) - ! (applied to momentum level (k-1))". - ! - ! D(k) = 1 - [ ( zm(k-1) - zt(k-1) ) / ( zt(k) - zt(k-1) ) ] - ! = 1 - C(k); - ! - ! which is the same as "1 - factor" for the interpolation to momentum - ! level (k-1). In the code, this interpolation is referenced as - ! gr%weights_zt2zm(t_below,mkm1), which can be read as "grid weight in a - ! zt2zm interpolation of the thermodynamic level below momentum level (k-1) - ! (applied to momentum level (k-1))". - ! - ! Additionally, as long as the central thermodynamic level (k) in the above - ! scenario is not the uppermost thermodynamic level or the lowermost - ! thermodynamic level (k /= gr%nz and k /= 1), the four weighting factors - ! have the following relationships: A(k) = C(k+1) and B(k) = D(k+1). - ! - ! - ! Special condition for uppermost grid level, k = gr%nz: - ! - ! The uppermost momentum grid level is above the uppermost thermodynamic - ! grid level. Thus, a linear extension is used at this level. - ! - ! For level k = gr%nz: - ! - ! The formula for a linear extension is given by: - ! - ! var_zt( extend to zm(k) ) - ! = [ ( var_zt(k) - var_zt(k-1) ) / ( zt(k) - zt(k-1) ) ] - ! * ( zm(k) - zt(k-1) ) + var_zt(k-1); - ! - ! which can be rewritten as: - ! - ! var_zt( extend to zm(k) ) - ! = [ ( zm(k) - zt(k-1) ) / ( zt(k) - zt(k-1) ) ] - ! * ( var_zt(k) - var_zt(k-1) ) + var_zt(k-1). - ! - ! Furthermore, the formula can be rewritten as: - ! - ! var_zt( extend to zm(k) ) - ! = factor * var_zt(k) + ( 1 - factor ) * var_zt(k-1); - ! - ! where: - ! - ! factor = ( zm(k) - zt(k-1) ) / ( zt(k) - zt(k-1) ). - ! - ! Due to the fact that a linear extension is being used, the value of factor - ! will be greater than 1. The weight of thermodynamic level k = gr%nz on - ! momentum level k = gr%nz equals the value of factor. The weight of - ! thermodynamic level k = gr%nz-1 on momentum level k = gr%nz equals - ! 1 - factor, which is less than 0. However, the sum of the two weights - ! equals 1. - ! - ! - ! Brian Griffin; September 12, 2008. - ! - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - integer, parameter :: & - t_above = 1, & ! Upper thermodynamic level. - t_below = 2 ! Lower thermodynamic level. - - ! Input - integer, intent(in) :: m_lev ! Momentum level index - - ! Output - real( kind = core_rknd ), dimension(2) :: azt_weight ! Weights of the thermodynamic levels. - - ! Local Variables - real( kind = core_rknd ) :: factor - integer :: k - - ! ---- Begin Code ---- - - ! Compute the weighting factors at momentum level k. - k = m_lev - - if ( k /= gr%nz ) then - ! At most levels, the momentum level is found in-between two - ! thermodynamic levels. Linear interpolation is used. - factor = ( gr%zm(k)-gr%zt(k) ) / ( gr%zt(k+1)-gr%zt(k) ) - else - ! The top model level (gr%nz) is formulated differently because the top - ! momentum level is above the top thermodynamic level. A linear - ! extension is required, rather than linear interpolation. - ! Note: Variable "factor" will be greater than 1 in this situation. - factor = & - ( gr%zm(gr%nz)-gr%zt(gr%nz-1) ) & - / ( gr%zt(gr%nz)-gr%zt(gr%nz-1) ) - endif - - ! Weight of upper thermodynamic level on momentum level. - azt_weight(t_above) = factor - ! Weight of lower thermodynamic level on momentum level. - azt_weight(t_below) = 1.0_core_rknd - factor - - return - - end function interpolated_azmk_imp - - !============================================================================= - pure function linear_interpolated_azt( azm ) - - ! Description: - ! Function to interpolate a variable located on the momentum grid levels - ! (azm) to the thermodynamic grid levels (azt). This function inputs the - ! entire azm array and outputs the results as an azt array. The formulation - ! used is compatible with a stretched (unevenly-spaced) grid. - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_interpolation, only: linear_interp_factor - - implicit none - - ! Input Variable - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azm - - ! Output Variable - real( kind = core_rknd ), dimension(gr%nz) :: linear_interpolated_azt - - ! Local Variable - integer :: k ! Index - - ! ---- Begin Code ---- - - ! Do actual interpolation. - ! Use a linear interpolation. - forall( k = gr%nz : 2 : -1 ) - linear_interpolated_azt(k) = & - linear_interp_factor( gr%weights_zm2zt(1, k), azm(k), azm(k-1) ) - end forall ! gr%nz .. 2 -! ! Set the value of azt at level 1 (the lowermost level in the model) to the -! ! value of azm at level 1. -! interpolated_azt(1) = azm(1) - ! Use a linear extension based on the values of azm at levels 1 and 2 to - ! find the value of azt at level 1 (the lowermost level in the model). - linear_interpolated_azt(1) = & - ( ( azm(2)-azm(1) ) / ( gr%zm(2)-gr%zm(1) ) ) & - * ( gr%zt(1)-gr%zm(1) ) + azm(1) - - return - - end function linear_interpolated_azt - - !============================================================================= - pure function linear_interpolated_aztk( azm, k ) - - ! Description: - ! Function to interpolate a variable located on the momentum grid levels - ! (azm) to the thermodynamic grid levels (azt). This function outputs the - ! value of azt at a single grid level (k) after interpolating using values - ! of azm at two grid levels. The formulation used is compatible with a - ! stretched (unevenly-spaced) grid. - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_interpolation, only: linear_interp_factor - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azm - - integer, intent(in) :: k - - ! Return Variables - real( kind = core_rknd ) :: linear_interpolated_aztk - - ! ---- Begin Code ---- - - ! Do actual interpolation. - ! Use a linear interpolation. - if ( k /= 1 ) then - - linear_interpolated_aztk = & - linear_interp_factor( gr%weights_zm2zt(1, k), azm(k), azm(k-1) ) - - else - -! ! Set the value of azt at level 1 (the lowermost level in the model) to -! ! the value of azm at level 1. -! linear_interpolated_aztk = azm(1) - ! Use a linear extension based on the values of azm at levels 1 and 2 to - ! find the value of azt at level 1 (the lowermost level in the model). - linear_interpolated_aztk = & - ( ( azm(2)-azm(1) ) / ( gr%zm(2)-gr%zm(1) ) ) & - * ( gr%zt(1)-gr%zm(1) ) + azm(1) - - endif - - return - - end function linear_interpolated_aztk - - !============================================================================= - pure function cubic_interpolated_azt( azm ) - - ! Description: - ! Function to interpolate a variable located on the momentum grid - ! levels (azm) to the thermodynamic grid levels (azt). This function outputs the - ! value of azt at a all grid levels using Steffen's monotonic cubic - ! interpolation implemented by Tak Yamaguchi. - ! - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - azm - - ! Return Variable - real( kind = core_rknd ), dimension(gr%nz) :: & - cubic_interpolated_azt - - ! Local Variable(s) - real( kind = core_rknd ), dimension(gr%nz) :: & - tmp ! This is needed for variables that self-reference - integer :: & - k - - ! ---- Begin Code ---- - - forall ( k = 1 : gr%nz ) - tmp(k) = cubic_interpolated_aztk( azm, k ) - end forall - - cubic_interpolated_azt = tmp - - return - - end function cubic_interpolated_azt - - - !============================================================================= - pure function cubic_interpolated_aztk( azm, k ) - - ! Description: - ! Function to interpolate a variable located on the momentum grid - ! levels (azm) to the thermodynamic grid levels (azt). This function outputs the - ! value of azt at a single grid level (k) using Steffen's monotonic cubic - ! interpolation implemented by Tak Yamaguchi. - ! - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_interpolation, only: mono_cubic_interp - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azm - - integer, intent(in) :: k - - ! Return Variable - real( kind = core_rknd ) :: cubic_interpolated_aztk - - ! Local Variable(s) - integer :: km1, k00, kp1, kp2 - - ! ---- Begin Code ---- - - ! Special case for a very small domain - if ( gr%nz < 3 ) then - cubic_interpolated_aztk = linear_interpolated_aztk( azm, k ) - return - end if - - ! k levels are based on Tak's find_indices subroutine -dschanen 24 Oct 2011 - if ( k == gr%nz ) then - km1 = gr%nz-2 - kp1 = gr%nz - kp2 = gr%nz - k00 = gr%nz-1 - else if ( k == 2 ) then - km1 = 1 - kp1 = 2 - kp2 = 3 - k00 = 1 - else if ( k == 1 ) then ! Extrapolation for the ghost point - km1 = gr%nz - k00 = 1 - kp1 = 2 - kp2 = 3 - else - km1 = k-2 - kp1 = k - kp2 = k+1 - k00 = k-1 - end if - ! Do the actual interpolation. - ! Use a cubic monotonic spline interpolation. - cubic_interpolated_aztk = & - mono_cubic_interp( gr%zt(k), km1, k00, kp1, kp2, & - gr%zm(km1), gr%zm(k00), gr%zm(kp1), gr%zm(kp2), & - azm(km1), azm(k00), azm(kp1), azm(kp2) ) - - return - - end function cubic_interpolated_aztk - - !============================================================================= - pure function interpolated_aztk_imp( t_lev ) & - result( azm_weight ) - - ! Description: - ! Function used to help in an interpolation of a variable (var_zm) located - ! on the momentum grid levels (azm) to the thermodynamic grid levels (azt). - ! This function computes a weighting factor for both the upper momentum - ! level (k) and the lower momentum level (k-1) applied to the central - ! thermodynamic level (k). For the lowermost thermodynamic grid - ! level (k=1), a weighting factor for both the momentum level at 1 and the - ! momentum level at 2 are calculated based on the use of a linear extension. - ! This function outputs the weighting factors at a single thermodynamic grid - ! level (k). The formulation used is compatible with a stretched - ! (unevenly-spaced) grid. The weights are defined as follows: - ! - ! ===var_zm(k)============================================= m(k) - ! azm_weight(m_above) = factor - ! -----------var_zm(interp)-------------------------------- t(k) - ! azm_weight(m_below) = 1 - factor - ! ===var_zm(k-1)=========================================== m(k-1) - ! - ! The vertical indices m(k), t(k), and m(k-1) correspond with altitudes - ! zm(k), zt(k), and zm(k-1), respectively. The letter "t" is used for - ! thermodynamic levels and the letter "m" is used for momentum levels. - ! - ! For all levels k > 1: - ! - ! The formula for a linear interpolation is given by: - ! - ! var_zm( interp to zt(k) ) - ! = [ ( var_zm(k) - var_zm(k-1) ) / ( zm(k) - zm(k-1) ) ] - ! * ( zt(k) - zm(k-1) ) + var_zm(k-1); - ! - ! which can be rewritten as: - ! - ! var_zm( interp to zt(k) ) - ! = [ ( zt(k) - zm(k-1) ) / ( zm(k) - zm(k-1) ) ] - ! * ( var_zm(k) - var_zm(k-1) ) + var_zm(k-1). - ! - ! Furthermore, the formula can be rewritten as: - ! - ! var_zm( interp to zt(k) ) - ! = factor * var_zm(k) + ( 1 - factor ) * var_zm(k-1); - ! - ! where: - ! - ! factor = ( zt(k) - zm(k-1) ) / ( zm(k) - zm(k-1) ). - ! - ! One of the important uses of this function is in situations where the - ! variable to be interpolated is being treated IMPLICITLY in an equation. - ! Usually, the variable to be interpolated is involved in a derivative (such - ! as d(var_zm)/dz in the diagram below). For the term of the equation - ! containing the derivative, grid weights are needed for two interpolations, - ! rather than just one interpolation. Thus, four grid weights (labeled - ! A(k), B(k), C(k), and D(k) in the diagram below) are needed. - ! - ! ===var_zm(k+1)=========================================== m(k+1) - ! A(k) - ! -----------var_zm(interp)-------------------------------- t(k+1) - ! B(k) = 1 - A(k) - ! ===var_zm(k)===========d(var_zm)/dz====================== m(k) - ! C(k) - ! -----------var_zm(interp)-------------------------------- t(k) - ! D(k) = 1 - C(k) - ! ===var_zm(k-1)=========================================== m(k-1) - ! - ! The vertical indices m(k+1), t(k+1), m(k), t(k), and m(k-1) correspond - ! with altitudes zm(k+1), zt(k+1), zm(k), zt(k), and zm(k-1), respectively. - ! The letter "t" is used for thermodynamic levels and the letter "m" is used - ! for momentum levels. - ! - ! The grid weights, indexed around the central momentum level (k), are - ! defined as follows: - ! - ! A(k) = ( zt(k+1) - zm(k) ) / ( zm(k+1) - zm(k) ); - ! - ! which is the same as "factor" for the interpolation to thermodynamic - ! level (k+1). In the code, this interpolation is referenced as - ! gr%weights_zm2zt(m_above,tkp1), which can be read as "grid weight in a - ! zm2zt interpolation of the momentum level above thermodynamic - ! level (k+1) (applied to thermodynamic level (k+1))". - ! - ! B(k) = 1 - [ ( zt(k+1) - zm(k) ) / ( zm(k+1) - zm(k) ) ] - ! = 1 - A(k); - ! - ! which is the same as "1 - factor" for the interpolation to thermodynamic - ! level (k+1). In the code, this interpolation is referenced as - ! gr%weights_zm2zt(m_below,tkp1), which can be read as "grid weight in a - ! zm2zt interpolation of the momentum level below thermodynamic - ! level (k+1) (applied to thermodynamic level (k+1))". - ! - ! C(k) = ( zt(k) - zm(k-1) ) / ( zm(k) - zm(k-1) ); - ! - ! which is the same as "factor" for the interpolation to thermodynamic - ! level (k). In the code, this interpolation is referenced as - ! gr%weights_zm2zt(m_above,tk), which can be read as "grid weight in a zm2zt - ! interpolation of the momentum level above thermodynamic level (k) (applied - ! to thermodynamic level (k))". - ! - ! D(k) = 1 - [ ( zt(k) - zm(k-1) ) / ( zm(k) - zm(k-1) ) ] - ! = 1 - C(k); - ! - ! which is the same as "1 - factor" for the interpolation to thermodynamic - ! level (k). In the code, this interpolation is referenced as - ! gr%weights_zm2zt(m_below,tk), which can be read as "grid weight in a zm2zt - ! interpolation of the momentum level below thermodynamic level (k) (applied - ! to thermodynamic level (k))". - ! - ! Additionally, as long as the central momentum level (k) in the above - ! scenario is not the lowermost momentum level or the uppermost momentum - ! level (k /= 1 and k /= gr%nz), the four weighting factors have the - ! following relationships: A(k) = C(k+1) and B(k) = D(k+1). - ! - ! - ! Special condition for lowermost grid level, k = 1: - ! - ! The lowermost thermodynamic grid level is below the lowermost momentum - ! grid level. Thus, a linear extension is used at this level. It should - ! be noted that the thermodynamic level k = 1 is considered to be below the - ! model lower boundary, which is defined to be at momentum level k = 1. - ! Thus, the values of most variables at thermodynamic level k = 1 are not - ! often needed or referenced. - ! - ! For level k = 1: - ! - ! The formula for a linear extension is given by: - ! - ! var_zm( extend to zt(k) ) - ! = [ ( var_zm(k+1) - var_zm(k) ) / ( zm(k+1) - zm(k) ) ] - ! * ( zt(k) - zm(k) ) + var_zm(k); - ! - ! which can be rewritten as: - ! - ! var_zm( extend to zt(k) ) - ! = [ ( zt(k) - zm(k) ) / ( zm(k+1) - zm(k) ) ] - ! * ( var_zm(k+1) - var_zm(k) ) + var_zm(k). - ! - ! Furthermore, the formula can be rewritten as: - ! - ! var_zm( extend to zt(k) ) - ! = factor * var_zm(k+1) + ( 1 - factor ) * var_zm(k); - ! - ! where: - ! - ! factor = ( zt(k) - zm(k) ) / ( zm(k+1) - zm(k) ). - ! - ! Due to the fact that a linear extension is being used, the value of factor - ! will be less than 0. The weight of the upper momentum level, which is - ! momentum level k = 2, on thermodynamic level k = 1 equals the value of - ! factor. The weight of the lower momentum level, which is momentum level - ! k = 1, on thermodynamic level k = 1 equals 1 - factor, which is greater - ! than 1. However, the sum of the weights equals 1. - ! - ! - ! Brian Griffin; September 12, 2008. - ! - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - integer, parameter :: & - m_above = 1, & ! Upper momentum level. - m_below = 2 ! Lower momentum level. - - ! Input - integer, intent(in) :: t_lev ! Thermodynamic level index. - - ! Output - real( kind = core_rknd ), dimension(2) :: azm_weight ! Weights of the momentum levels. - - ! Local Variables - real( kind = core_rknd ) :: factor - integer :: k - - ! ---- Begin Code ---- - - ! Compute the weighting factors at thermodynamic level k. - k = t_lev - - if ( k /= 1 ) then - ! At most levels, the thermodynamic level is found in-between two - ! momentum levels. Linear interpolation is used. - factor = ( gr%zt(k)-gr%zm(k-1) ) / ( gr%zm(k)-gr%zm(k-1) ) - else - ! The bottom model level (1) is formulated differently because the bottom - ! thermodynamic level is below the bottom momentum level. A linear - ! extension is required, rather than linear interpolation. - ! Note: Variable "factor" will have a negative sign in this situation. - factor = ( gr%zt(1)-gr%zm(1) ) / ( gr%zm(2)-gr%zm(1) ) - endif - - ! Weight of upper momentum level on thermodynamic level. - azm_weight(m_above) = factor - ! Weight of lower momentum level on thermodynamic level. - azm_weight(m_below) = 1.0_core_rknd - factor - - return - - end function interpolated_aztk_imp - - !============================================================================= - pure function gradzm( azm ) - - ! Description: - ! Function to compute the vertical derivative of a variable (azm) located on - ! the momentum grid. The results are returned in an array defined on the - ! thermodynamic grid. - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variable - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azm - - ! Return Variable - real( kind = core_rknd ), dimension(gr%nz) :: gradzm - - ! Local Variable - integer :: k - - ! ---- Begin Code ---- - - ! Compute vertical derivatives. - forall( k = gr%nz : 2 : -1 ) - ! Take derivative of momentum-level variable azm over the central - ! thermodynamic level (k). - gradzm(k) = ( azm(k) - azm(k-1) ) * gr%invrs_dzt(k) - end forall ! gr%nz .. 2 -! ! Thermodynamic level 1 is located below momentum level 1, so there is not -! ! enough information to calculate the derivative over thermodynamic -! ! level 1. Thus, the value of the derivative at thermodynamic level 1 is -! ! set equal to 0. This formulation is consistent with setting the value of -! ! the variable azm below the model grid to the value of the variable azm at -! ! the lowest grid level. -! gradzm(1) = 0. - ! Thermodynamic level 1 is located below momentum level 1, so there is not - ! enough information to calculate the derivative over thermodynamic level 1. - ! Thus, the value of the derivative at thermodynamic level 1 is set equal to - ! the value of the derivative at thermodynamic level 2. This formulation is - ! consistent with using a linear extension to find the values of the - ! variable azm below the model grid. - gradzm(1) = gradzm(2) - - return - - end function gradzm - - !============================================================================= - pure function gradzt( azt ) - - ! Description: - ! Function to compute the vertical derivative of a variable (azt) located on - ! the thermodynamic grid. The results are returned in an array defined on - ! the momentum grid. - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variable - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: azt - - ! Output Variable - real( kind = core_rknd ), dimension(gr%nz) :: gradzt - - ! Local Variable - integer :: k - - ! ---- Begin Code ---- - - ! Compute vertical derivative. - forall( k = 1 : gr%nz-1 : 1 ) - ! Take derivative of thermodynamic-level variable azt over the central - ! momentum level (k). - gradzt(k) = ( azt(k+1) - azt(k) ) * gr%invrs_dzm(k) - end forall ! 1 .. gr%nz-1 -! ! Momentum level gr%nz is located above thermodynamic level gr%nz, so -! ! there is not enough information to calculate the derivative over momentum -! ! level gr%nz. Thus, the value of the derivative at momentum level -! ! gr%nz is set equal to 0. This formulation is consistent with setting -! ! the value of the variable azt above the model grid to the value of the -! ! variable azt at the highest grid level. -! gradzt(gr%nz) = 0. - ! Momentum level gr%nz is located above thermodynamic level gr%nz, so - ! there is not enough information to calculate the derivative over momentum - ! level gr%nz. Thus, the value of the derivative at momentum level - ! gr%nz is set equal to the value of the derivative at momentum level - ! gr%nz-1. This formulation is consistent with using a linear extension - ! to find the values of the variable azt above the model grid. - gradzt(gr%nz) = gradzt(gr%nz-1) - - return - - end function gradzt - - !============================================================================= - pure function flip( x, xdim ) - - ! Description: - ! Flips a single dimension array (i.e. a vector), so the first element - ! becomes the last and vice versa for the whole column. This is a - ! necessary part of the code because BUGSrad and CLUBB store altitudes in - ! reverse order. - ! - ! References: - ! None - !------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - dp ! double precision - - implicit none - - ! Input Variables - integer, intent(in) :: xdim - - real(kind = dp), dimension(xdim), intent(in) :: x - - ! Output Variables - real(kind = dp), dimension(xdim) :: flip - - ! Local Variables - real(kind = dp), dimension(xdim) :: tmp - - integer :: indx - - ! ---- Begin Code ---- - - forall ( indx = 1 : xdim ) - tmp(indx) = x((xdim+1) - (indx)) - end forall - - flip = tmp - - return - end function flip - -!=============================================================================== - -end module crmx_grid_class diff --git a/src/physics/spcam/crm/CLUBB/crmx_hydrostatic_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_hydrostatic_module.F90 deleted file mode 100644 index 48231ba015..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_hydrostatic_module.F90 +++ /dev/null @@ -1,746 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: hydrostatic_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -!=============================================================================== -module crmx_hydrostatic_module - - implicit none - - private ! Default Scope - - public :: hydrostatic, & - inverse_hydrostatic - - private :: calc_exner_const_thvm, & - calc_exner_linear_thvm, & - calc_z_linear_thvm - - contains - -!=============================================================================== - subroutine hydrostatic( thvm, p_sfc, & - p_in_Pa, p_in_Pa_zm, & - exner, exner_zm, & - rho, rho_zm ) - - ! Description: - ! This subroutine integrates the hydrostatic equation. - ! - ! The hydrostatic equation is of the form: - ! - ! dp/dz = - rho * grav. - ! - ! This equation can be re-written in terms of d(exner)/dz, such that: - ! - ! [ { p0^(R_d/C_p) * p^(C_v/C_p) } / { R_d * rho } ] * d(exner)/dz - ! = - grav / C_p; - ! - ! which can also be expressed as: - ! - ! [ { p0^(R_d/C_p) * p^(C_v/C_p) } / { R_d * rho_d * ( 1 + r_v + r_c ) } ] - ! * d(exner)/dz - ! = - grav / C_p. - ! - ! Furthermore, the moist equation of state can be written as: - ! - ! theta = - ! [ { p0^(R_d/C_p) * p^(C_v/C_p) } - ! / { R_d * rho_d * ( 1 + (R_v/R_d)*r_v ) } ]. - ! - ! The relationship between theta and theta_v (including water vapor and - ! cloud water) is: - ! - ! theta_v = theta * [ ( 1 + (R_v/R_d)*r_v ) / ( 1 + r_v + r_c ) ]; - ! - ! which, when substituted into the above equation, changes the equation of - ! state to: - ! - ! theta_v = - ! [ { p0^(R_d/C_p) * p^(C_v/C_p) } - ! / { R_d * rho_d * ( 1 + r_v + r_c ) } ]. - ! - ! This equation is substituted into the d(exner)/dz form of the hydrostatic - ! equation, resulting in: - ! - ! theta_v * d(exner)/dz = - grav / C_p; - ! - ! which can be re-written as: - ! - ! d(exner)/dz = - grav / ( C_p * theta_v ). - ! - ! This subroutine integrates the above equation to solve for exner, such - ! that: - ! - ! INT(exner_1:exner_2) d(exner) = - ! - ( grav / C_p ) * INT(z_1:z_2) ( 1 / theta_v ) dz. - ! - ! - ! The resulting value of exner is used to calculate pressure. Then, the - ! values of pressure, exner, and theta_v can be used to calculate density. - - ! References: - ! - !------------------------------------------------------------------------ - - use crmx_constants_clubb, only: & - kappa, & ! Variable(s) - p0, & - Rd, & - zero_threshold - - use crmx_grid_class, only: & - gr, & ! Variable(s) - zm2zt, & ! Procedure(s) - zt2zm - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - p_sfc ! Pressure at the surface [Pa] - - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - thvm ! Virtual potential temperature [K] - - ! Output Variables - real( kind = core_rknd ), intent(out), dimension(gr%nz) :: & - p_in_Pa, & ! Pressure (thermodynamic levels) [Pa] - p_in_Pa_zm, & ! Pressure on momentum levels [Pa] - exner, & ! Exner function (thermodynamic levels) [-] - exner_zm, & ! Exner function on momentum levels [-] - rho, & ! Density (thermodynamic levels) [kg/m^3] - rho_zm ! Density on momentum levels [kg/m^3] - - ! Local Variables - real( kind = core_rknd ), dimension(gr%nz) :: & - thvm_zm ! Theta_v interpolated to momentum levels [K] - - real( kind = core_rknd ) :: & - dthvm_dz ! Constant d(thvm)/dz between successive levels [K/m] - - integer :: k - - ! Interpolate thvm from thermodynamic to momentum levels. Linear - ! interpolation is used, except for the uppermost momentum level, where a - ! linear extension is used. Since thvm is considered to either be constant - ! or vary linearly over the depth of a grid level, this interpolation is - ! consistent with the rest of this code. - thvm_zm = zt2zm( thvm ) - - ! Exner is defined on thermodynamic grid levels except for the value at - ! index 1. Since thermodynamic level 1 is below the surface, it is - ! disregarded, and the value of exner(1) corresponds to surface value, which - ! is actually at momentum level 1. - exner(1) = ( p_sfc/p0 )**kappa - exner_zm(1) = ( p_sfc/p0 )**kappa - - ! Consider the value of exner at thermodynamic level (2) to be based on - ! a constant thvm between thermodynamic level (2) and momentum level (1), - ! which is the surface or model lower boundary. Since thlm(1) is set equal - ! to thlm(2), the values of thvm are considered to be basically constant - ! near the ground. - exner(2) & - = calc_exner_const_thvm( thvm(2), gr%zt(2), gr%zm(1), exner(1) ) - - ! Given the value of exner at thermodynamic level k-1, and considering - ! thvm to vary linearly between its values at thermodynamic levels k - ! and k-1, the value of exner can be found at thermodynamic level k, - ! as well as at intermediate momentum level k-1. - do k = 3, gr%nz - - dthvm_dz = gr%invrs_dzm(k-1) * ( thvm(k) - thvm(k-1) ) - - if ( dthvm_dz /= 0.0_core_rknd ) then - - exner(k) & - = calc_exner_linear_thvm( thvm(k-1), dthvm_dz, & - gr%zt(k-1), gr%zt(k), exner(k-1) ) - - exner_zm(k-1) & - = calc_exner_linear_thvm( thvm(k-1), dthvm_dz, & - gr%zt(k-1), gr%zm(k-1), exner(k-1) ) - - else ! dthvm_dz = 0 - - exner(k) & - = calc_exner_const_thvm & - ( thvm(k), gr%zt(k), gr%zt(k-1), exner(k-1) ) - - exner_zm(k-1) & - = calc_exner_const_thvm & - ( thvm(k), gr%zm(k-1), gr%zt(k-1), exner(k-1) ) - - endif - - enddo ! k = 3, gr%nz - - ! Find the value of exner_zm at momentum level gr%nz by using a linear - ! extension of thvm from the two thermodynamic level immediately below - ! momentum level gr%nz. - dthvm_dz = ( thvm_zm(gr%nz) - thvm(gr%nz) ) & - / ( gr%zm(gr%nz) - gr%zt(gr%nz) ) - - if ( dthvm_dz /= 0.0_core_rknd ) then - - exner_zm(gr%nz) & - = calc_exner_linear_thvm & - ( thvm(gr%nz), dthvm_dz, & - gr%zt(gr%nz), gr%zm(gr%nz), exner(gr%nz) ) - - else ! dthvm_dz = 0 - - exner_zm(gr%nz) & - = calc_exner_const_thvm & - ( thvm(gr%nz), gr%zm(gr%nz), gr%zt(gr%nz), exner(gr%nz) ) - - endif - - ! Calculate pressure based on the values of exner. - - do k = 1, gr%nz - p_in_Pa(k) = p0 * exner(k)**( 1._core_rknd/kappa ) - p_in_Pa_zm(k) = p0 * exner_zm(k)**( 1._core_rknd/kappa ) - enddo - - ! Calculate density based on pressure, exner, and thvm. - - do k = 1, gr%nz - rho(k) = p_in_Pa(k) / ( Rd * thvm(k) * exner(k) ) - rho_zm(k) = p_in_Pa_zm(k) / ( Rd * thvm_zm(k) * exner_zm(k) ) - enddo - - - return - end subroutine hydrostatic - -!=============================================================================== - subroutine inverse_hydrostatic( p_sfc, zm_init, nlevels, thvm, exner, & - z ) - - ! Description: - ! Subprogram to integrate the inverse of hydrostatic equation - - ! References: - ! - !------------------------------------------------------------------------ - - use crmx_constants_clubb, only: & - p0, & ! Constant(s) - kappa, & - fstderr - - use crmx_interpolation, only: & - binary_search ! Procedure(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - p_sfc, & ! Pressure at the surface [Pa] - zm_init ! Altitude at the surface [m] - - integer, intent(in) :: & - nlevels ! Number of levels in the sounding [-] - - real( kind = core_rknd ), intent(in), dimension(nlevels) :: & - thvm, & ! Virtual potential temperature [K] - exner ! Exner function [-] - - ! Output Variables - real( kind = core_rknd ), intent(out), dimension(nlevels) :: & - z ! Height [m] - - ! Local Variables - integer :: k - - real( kind = core_rknd ), dimension(nlevels) :: & - ref_z_snd ! Altitude minus altitude of the lowest sounding level [m] - - real( kind = core_rknd ), dimension(nlevels) :: & - exner_reverse_array ! Array of exner snd. values in reverse order [-] - - real( kind = core_rknd ) :: & - exner_sfc, & ! Value of exner at the surface [-] - ref_z_sfc, & ! Alt. diff between surface and lowest snd. level [m] - z_snd_bottom, & ! Altitude of the bottom of the input sounding [m] - dthvm_dexner ! Constant rate of change of thvm with respect to - ! exner between sounding levels k-1 and k [K] - - integer :: & - rev_low_idx, & - low_idx, & - high_idx - - - ! Variable ref_z_sfc is initialized to 0.0 to avoid a compiler warning. - ref_z_sfc = 0.0_core_rknd - - ! The variable ref_z_snd is the altitude of each sounding level compared to - ! the altitude of the lowest sounding level. Thus, the value of ref_z_snd - ! at sounding level 1 is 0. The lowest sounding level may or may not be - ! right at the surface, and therefore an adjustment may be required to find - ! the actual altitude above ground. - ref_z_snd(1) = 0.0_core_rknd - - do k = 2, nlevels - - ! The value of thvm is given at two successive sounding levels. For - ! purposes of achieving a quality estimate of altitude at each pressure - ! sounding level, the value of thvm is considered to vary linearly - ! with respect to exner between two successive sounding levels. Thus, - ! there is a constant d(thvm)/d(exner) between the two successive - ! sounding levels. If thvm is constant, then d(thvm)/d(exner) is 0. - dthvm_dexner = ( thvm(k) - thvm(k-1) ) / ( exner(k) - exner(k-1) ) - - ! Calculate the value of the reference height at sounding level k, based - ! the value of thvm at sounding level k-1, the constant value of - ! d(thvm)/d(exner), the value of exner at sounding levels k-1 and k, and - ! the reference altitude at sounding level k-1. - ref_z_snd(k) & - = calc_z_linear_thvm( thvm(k-1), dthvm_dexner, & - exner(k-1), exner(k), ref_z_snd(k-1) ) - - enddo - - ! Find the actual (above ground) altitude of the sounding levels from the - ! reference altitudes. - - ! The pressure at the surface (or model lower boundary), p_sfc, is found at - ! the altitude of the surface (or model lower boundary), zm_init. - - ! Find the value of exner at the surface from the pressure at the surface. - exner_sfc = ( p_sfc / p0 )**kappa - - ! Find the value of exner_sfc compared to the values of exner in the exner - ! sounding profile. - - if ( exner_sfc < exner(nlevels) ) then - - ! Since the values of exner decrease monotonically with height (and thus - ! with sounding level), the value of exner_sfc is less than all the - ! values of exner in the sounding (and thus the surface is located above - ! all the levels of the sounding), then there is insufficient information - ! to run the model. Stop the run. - - write(fstderr,*) "The entire sounding is below the model surface." - stop - - elseif ( exner_sfc > exner(1) ) then - - ! Since the values of exner decrease monotonically with height (and thus - ! with sounding level), the value of exner_sfc is greater than all the - ! values of exner in the sounding (and thus the surface is located below - ! all the levels of the sounding), use a linear extension of thvm to find - ! thvm at the surface. Thus, d(thvm)/d(exner) is the same as its value - ! between sounding levels 1 and 2. If the surface is so far below the - ! sounding that gr%zt(2) is below the first sounding level, the code in - ! subroutine read_sounding (found in sounding.F90) will stop the run. - - ! Calculate the appropriate d(thvm)/d(exner). - dthvm_dexner = ( thvm(2) - thvm(1) ) / ( exner(2) - exner(1) ) - - ! Calculate the difference between the altitude of the surface (or model - ! lower boundary) and the altitude of the lowest level of the sounding. - ref_z_sfc & - = calc_z_linear_thvm( thvm(1), dthvm_dexner, & - exner(1), exner_sfc, ref_z_snd(1) ) - - else ! exner(nlevels) < exner_sfc < exner(1) - - ! Since the values of exner decrease monotonically with height (and thus - ! with sounding level), the value of exner_sfc is between two values of - ! exner (at some levels k-1 and k) in the sounding, and the value of - ! d(thvm)/d(exner) is the same as between those two levels in the above - ! calculation. - - ! The value of exner_sfc is between two levels of the exner sounding. - ! Find the index of the lower level. - - ! In order to use the binary search, the array must be sorted from least - ! value to greatest value. Since exner decreases with altitude (and - ! vertical level), the array that is sent to function binary_search must - ! be the exact reverse of exner. - ! Thus, exner(1) becomes exner_reverse_array(nlevels), exner(nlevels) - ! becomes exner_reverse_array(1), etc. - do k = 1, nlevels, 1 - exner_reverse_array(k) = exner(nlevels-k+1) - enddo - ! The output from the binary search yields the first value in the - ! exner_reverse_array that is greater than or equal to exner_sfc. Thus, - ! in regards to the regular exner array, this is the reverse index of - ! the lower sounding level for exner_sfc. For example, if exner_sfc - ! is found between exner(1) and exner(2), the binary search for exner_sfc - ! in regards to exner_reverse_index will return a value of nlevels. - ! Once the actual lower level index is calculated, the result will be 1. - rev_low_idx = binary_search( nlevels, exner_reverse_array, exner_sfc ) - - ! Find the lower level index for the regular exner profile from the - ! lower level index for the reverse exner profile. - low_idx = nlevels - rev_low_idx + 1 - - ! Find the index of the upper level. - high_idx = low_idx + 1 - - ! Calculate the appropriate d(thvm)/d(exner). - dthvm_dexner = ( thvm(high_idx) - thvm(low_idx) ) & - / ( exner(high_idx) - exner(low_idx) ) - - ! Calculate the difference between the altitude of the surface (or model - ! lower boundary) and the altitude of the lowest level of the sounding. - ref_z_sfc & - = calc_z_linear_thvm( thvm(low_idx), dthvm_dexner, & - exner(low_idx), exner_sfc, ref_z_snd(low_idx) ) - - endif ! exner_sfc - - ! Find the altitude of the bottom of the sounding. - z_snd_bottom = zm_init - ref_z_sfc - - ! Calculate the sounding altitude profile based - ! on z_snd_bottom and ref_z_snd. - do k = 1, nlevels, 1 - z(k) = z_snd_bottom + ref_z_snd(k) - enddo - - - return - end subroutine inverse_hydrostatic - -!=============================================================================== - pure function calc_exner_const_thvm( thvm, z_2, z_1, exner_1 ) & - result( exner_2 ) - - ! Description: - ! This function solves for exner at a level, given exner at another level, - ! the altitudes of both levels, and a constant thvm over the depth of the - ! level. - ! - ! The derivative of exner is given by the following equation: - ! - ! d(exner)/dz = - grav / (Cp * thvm). - ! - ! This equation is integrated to solve for exner, such that: - ! - ! INT(exner_1:exner_2) d(exner) - ! = - ( grav / Cp ) INT(z_1:z_2) (1/thvm) dz. - ! - ! Since thvm is considered to be a constant over the depth of the layer - ! between z_1 and z_2, the equation can be written as: - ! - ! INT(exner_1:exner_2) d(exner) = - grav / ( Cp * thvm ) INT(z_1:z_2) dz. - ! - ! Solving the integral: - ! - ! exner_2 = exner_1 - [ grav / ( Cp * thvm ) ] * ( z_2 - z_1 ). - - ! References: - !------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - grav, & ! Gravitational acceleration [m/s^2] - Cp ! Specific heat of dry air at const. pressure [J/(kg*K)] - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - thvm, & ! Constant value of thvm over the layer [K] - z_2, & ! Altitude at the top of the layer [m] - z_1, & ! Altitude at the bottom of the layer [m] - exner_1 ! Exner at the bottom of the layer [-] - - ! Return Variable - real( kind = core_rknd ) :: exner_2 ! Exner at the top of the layer [-] - - ! Calculate exner at top of the layer. - exner_2 = exner_1 - ( grav / ( Cp * thvm ) ) * ( z_2 - z_1 ) - - return - end function calc_exner_const_thvm - -!=============================================================================== - pure function calc_exner_linear_thvm( thvm_km1, dthvm_dz, & - z_km1, z_2, exner_km1 ) & - result( exner_2 ) - - ! Description: - ! This function solves for exner at a level, given exner at another level, - ! the altitudes of both levels, and a value of thvm that is considered to - ! vary linearly over the depth of the level. - ! - ! The derivative of exner is given by the following equation: - ! - ! d(exner)/dz = - grav / (Cp * thvm). - ! - ! This equation is integrated to solve for exner, such that: - ! - ! INT(exner_1:exner_2) d(exner) - ! = - ( grav / Cp ) INT(z_1:z_2) (1/thvm) dz. - ! - ! The value of thvm is considered to vary linearly (with respect to height) - ! over the depth of the level (resulting in a constant d(thvm)/dz over the - ! depth of the level). The entire level between z_1 and z_2 must be - ! encompassed between two levels with two known values of thvm. The value - ! of thvm at the upper level (z_up) is called thvm_up, and the value of thvm - ! at the lower level (z_low) is called thvm_low. Again, the values of thvm - ! at all interior altitudes, z_low <= z_1 < z <= z_2 <= z_up, behave - ! linearly between thvm_low and thvm_up, such that: - ! - ! thvm(z) - ! = [ ( thvm_up - thvm_low ) / ( z_up - z_low ) ] * ( z - z_low) - ! + thvm_low - ! = [ d(thvm)/dz ] * ( z - z_low ) + thvm_low - ! = C_a*z + C_b; - ! - ! where: - ! - ! C_a - ! = ( thvm_up - thvm_low ) / ( z_up - z_low ) - ! = d(thvm)/dz; - ! - ! and: - ! - ! C_b - ! = thvm_low - [ ( thvm_up - thvm_low ) / ( z_up - z_low ) ] * z_low - ! = thvm_low - [ d(thvm)/dz ] * z_low. - ! - ! The integral becomes: - ! - ! INT(exner_1:exner_2) d(exner) - ! = - ( grav / Cp ) INT(z_1:z_2) [ 1 / ( C_a*z + C_b ) ] dz. - ! - ! Performing a u-substitution ( u = C_a*z + C_b ), the equation becomes: - ! - ! INT(exner_1:exner_2) d(exner) - ! = - ( grav / Cp ) * ( 1 / C_a ) INT(z=z_1:z=z_2) (1/u) du. - ! - ! Solving the integral, and then re-substituting for u: - ! - ! exner_2 = exner_1 - ! - ( grav / Cp ) * ( 1 / C_a ) - ! * ln [ ( C_a*z_2 + C_b ) / ( C_a*z_1 + C_b ) ]. - ! - ! Re-substituting for C_a and C_b: - ! - ! exner_2 - ! = exner_1 - ! - ( grav / Cp ) * ( 1 / {d(thvm)/dz} ) - ! * ln [ ( {d(thvm)/dz}*z_2 + thvm_low - {d(thvm)/dz}*z_low ) - ! / ( {d(thvm)/dz}*z_1 + thvm_low - {d(thvm)/dz}*z_low ) ]. - ! - ! This equation is used to calculate exner_2 using exner_1, which is at the - ! same level as z_1. Furthermore, thvm_low and z_low are taken from the - ! same level as z_1 and exner_1. Thus, z_1 = z_low. Therefore: - ! - ! exner_2 - ! = exner_low - ! - ( grav / Cp ) * ( 1 / {d(thvm)/dz} ) - ! * ln [ ( thvm_low + {d(thvm)/dz}*(z_2-z_low) ) / thvm_low ]. - ! - ! Considering either a thermodynamic or sounding level k-1 as the low level - ! in the integration, and that thvm varies linearly between level k-1 and - ! level k: - ! - ! exner_2 - ! = exner(k-1) - ! - ( grav / Cp ) * ( 1 / {d(thvm)/dz} ) - ! * ln [ ( thvm(k-1) + {d(thvm)/dz}*(z_2-z(k-1)) ) / thvm(k-1) ]; - ! - ! where: - ! - ! d(thvm)/dz = ( thvm(k) - thvm(k-1) ) / ( z(k) - z(k-1) ); - ! - ! and where z(k-1) < z_2 <= z(k); and {d(thvm)/dz} /= 0. If the value of - ! {d(thvm)/dz} is 0, then thvm is considered to be a constant over the depth - ! of the level. The appropriate equation is found in pure function - ! calc_exner_const_thvm. - - ! References: - !------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_constants_clubb, only: & - grav, & ! Gravitational acceleration [m/s^2] - Cp ! Specific heat of dry air at const. pressure [J/(kg*K)] - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - thvm_km1, & ! Value of thvm at level k-1 [K] - dthvm_dz, & ! Constant d(thvm)/dz between levels k-1 and k [K/m] - z_km1, & ! Altitude at level k-1 [m] - z_2, & ! Altitude at the top of the layer [m] - exner_km1 ! Exner at level k-1 [-] - - ! Return Variable - real( kind = core_rknd ) :: exner_2 ! Exner at the top of the layer [-] - - ! Calculate exner at the top of the layer. - exner_2 & - = exner_km1 & - - ( grav / Cp ) * ( 1.0_core_rknd / dthvm_dz ) & - * log( ( thvm_km1 + dthvm_dz * ( z_2 - z_km1 ) ) / thvm_km1 ) - - return - end function calc_exner_linear_thvm - -!=============================================================================== - pure function calc_z_linear_thvm( thvm_km1, dthvm_dexner, & - exner_km1, exner_2, z_km1 ) & - result( z_2 ) - - ! Description: - ! This function solves for z (altitude) at a level, given altitude at - ! another level, the values of exner at both levels, and a value of thvm - ! that is considered to vary linearly over the depth of the level. - ! - ! The derivative of exner is given by the following equation: - ! - ! d(exner)/dz = - grav / (Cp * thvm). - ! - ! This equation is integrated to solve for z, such that: - ! - ! INT(exner_1:exner_2) thvm d(exner) = - ( grav / Cp ) INT(z_1:z_2) dz. - ! - ! The value of thvm is considered to vary linearly (with respect to exner) - ! over the depth of the level (resulting in a constant d(thvm)/d(exner) over - ! the depth of the level). The entire level between exner_1 and exner_2 - ! must be encompassed between two levels with two known values of thvm. The - ! value of thvm at the upper level (exner_up) is called thvm_up, and the - ! value of thvm at the lower level (exner_low) is called thvm_low. Again, - ! the values of thvm at all interior exner levels, - ! exner_low >= exner_1 > exner >= exner_2 >= exner_up, behave linearly - ! between thvm_low and thvm_up, such that: - ! - ! thvm(exner) - ! = [ ( thvm_up - thvm_low ) / ( exner_up - exner_low ) ] - ! * ( exner - exner_low ) - ! + thvm_low - ! = [ d(thvm)/d(exner) ] * ( exner - exner_low ) + thvm_low - ! = C_a*z + C_b; - ! - ! where: - ! - ! C_a - ! = ( thvm_up - thvm_low ) / ( exner_up - exner_low ) - ! = d(thvm)/d(exner); - ! - ! and: - ! - ! C_b - ! = thvm_low - ! - [ ( thvm_up - thvm_low ) / ( exner_up - exner_low ) ] * exner_low - ! = thvm_low - [ d(thvm)/d(exner) ] * exner_low. - ! - ! The integral becomes: - ! - ! INT(exner_1:exner_2) ( C_a*exner + C_b ) d(exner) - ! = - ( grav / Cp ) INT(z_1:z_2) dz. - ! - ! Solving the integral: - ! - ! z_2 - ! = z_1 - ! - ( Cp / grav ) - ! * [ (1/2) * {d(thvm)/d(exner)} * ( {exner_2}^2 - {exner_1}^2 ) - ! + ( thvm_low - {d(thvm)/d(exner)} * exner_low ) - ! * ( exner_2 - exner_1 ) ]. - ! - ! This equation is used to calculate z_2 using z_1, which is at the same - ! level as exner_1. Furthermore, thvm_low and exner_low are taken from the - ! same level as exner_1 and z_1. Thus, exner_1 = exner_low. Therefore: - ! - ! z_2 - ! = z_low - ! - ( Cp / grav ) - ! * [ (1/2) * {d(thvm)/d(exner)} * ( {exner_2}^2 - {exner_low}^2 ) - ! + ( thvm_low - {d(thvm)/d(exner)} * exner_low ) - ! * ( exner_2 - exner_low ) ]. - ! - ! Considering a sounding level k-1 as the low level in the integration, and - ! that thvm varies linearly (with respect to exner) between level k-1 and - ! level k: - ! - ! z_2 - ! = z(k-1) - ! - ( Cp / grav ) - ! * [ (1/2) * {d(thvm)/d(exner)} * ( {exner_2}^2 - {exner(k-1)}^2 ) - ! + ( thvm(k-1) - {d(thvm)/d(exner)} * exner(k-1) ) - ! * ( exner_2 - exner(k-1) ) ]; - ! - ! where: - ! - ! d(thvm)/d(exner) - ! = ( thvm(k) - thvm(k-1) ) / ( exner(k) - exner(k-1) ); - ! - ! and where exner(k-1) > exner_2 >= exner(k). If the value of - ! d(thvm)/d(exner) is 0, then thvm is considered to be a constant over the - ! depth of the level, and the equation will reduce to: - ! - ! z_2 = z(k-1) - ( Cp / grav ) * thvm(k-1) * ( exner_2 - exner(k-1) ). - ! - ! - ! IMPORTANT NOTE: - ! - ! CLUBB is an altitude-based model. All linear interpolations (and - ! extensions) are based on considering a variable to change linearly with - ! respect to altitude, rather than with respect to exner. An exception is - ! made here to calculate the altitude of a sounding level based on a - ! sounding given in terms of a pressure coordinate rather than a height - ! coordinate. After the altitude of the sounding level has been calculated, - ! the values of the sounding variables are interpolated onto the model grid - ! linearly with respect to altitude. Therefore, considering a variable to - ! change linearly with respect to exner is not consistent with the rest of - ! the model code, but provides for a better estimation of the altitude of - ! the sounding levels (than simply considering thvm to be constant over the - ! depth of the sounding level). - - ! References: - !------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_constants_clubb, only: & - grav, & ! Gravitational acceleration [m/s^2] - Cp ! Specific heat of dry air at const. pressure [J/(kg*K)] - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - thvm_km1, & ! Value of thvm at sounding level k-1 [K] - dthvm_dexner, & ! Constant d(thvm)/d(exner) between levels k-1 and k [K] - exner_km1, & ! Value of exner at sounding level k-1 [-] - exner_2, & ! Value of exner at the top of the layer [-] - z_km1 ! Altitude at sounding level k-1 [m] - - ! Return Variable - real( kind = core_rknd ) :: z_2 ! Altitude at the top of the layer [m] - - ! Calculate z_2 at the top of the layer. - z_2 & - = z_km1 & - - ( Cp / grav ) & - * ( 0.5_core_rknd * dthvm_dexner * ( exner_2**2 - exner_km1**2 ) & - + ( thvm_km1 - dthvm_dexner * exner_km1 ) & - * ( exner_2 - exner_km1 ) & - ) - - return - end function calc_z_linear_thvm - -!=============================================================================== - -end module crmx_hydrostatic_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_hyper_diffusion_4th_ord.F90 b/src/physics/spcam/crm/CLUBB/crmx_hyper_diffusion_4th_ord.F90 deleted file mode 100644 index a59714a42b..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_hyper_diffusion_4th_ord.F90 +++ /dev/null @@ -1,1685 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: hyper_diffusion_4th_ord.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -!=============================================================================== -module crmx_hyper_diffusion_4th_ord - - ! Description: - ! Module hyper_diffusion_4th_ord computes the 4th-order numerical diffusion - ! for any equation to which it is applied. Hyper-diffusion will only be - ! called if the model flag l_hyper_dfsn is set to true. Function - ! hyper_dfsn_4th_ord_zt_lhs handles 4th-order hyper-diffusion for variables - ! that reside on thermodynamic levels. Function hyper_dfsn_4th_ord_zm_lhs - ! handles 4th-order hyper-diffusion for variables that reside on momentum - ! levels. A special constant coefficient of 4th-order numerical diffusion, - ! nu_hd (which is sent in this module as nu), is used and has units of m^4/s. - - implicit none - - private ! Default Scope - - public :: hyper_dfsn_4th_ord_zt_lhs, & - hyper_dfsn_4th_ord_zm_lhs - - contains - - !============================================================================= - pure function hyper_dfsn_4th_ord_zt_lhs( boundary_cond, nu, invrs_dzt, & - invrs_dzm, invrs_dzmm1, & - invrs_dztp1, invrs_dztm1, & - invrs_dzmp1, invrs_dzmm2, level ) & - result( lhs ) - - ! Note: In the "Description" section of this function, the variable - ! "invrs_dzm" will be written as simply "dzm", and the variable - ! "invrs_dzt" will be written as simply "dzt". This is being done as - ! as device to save space and to make some parts of the description - ! more readable. This change does not pertain to the actual code. - - ! Description: - ! Vertical 4th-order numerical diffusion of var_zt: implicit portion of the - ! code. - ! - ! Fourth-order numerical diffusion, or fourth-order hyper-diffusion, is used - ! to help eliminate small-scale noise without altering larger-scale - ! features. - ! - ! The variable "var_zt" stands for a variable that is located at - ! thermodynamic grid levels. - ! - ! The d(var_zt)/dt equation contains a 4th-order numerical diffusion term: - ! - ! - nu * d^4(var_zt)/dz^4. - ! - ! This term is solved for completely implicitly, such that: - ! - ! - nu * d^4( var_zt(t+1) )/dz^4. - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed - ! to a "+". - ! - ! The timestep index (t+1) means that the value of var_zt being used is from - ! the next timestep, which is being advanced to in solving the d(var_zt)/dt - ! equation. - ! - ! The term is discretized as follows: - ! - ! The five values of var_zt are found on the thermodynamic levels. All four - ! derivatives (d/dz) of var_zt are taken over all the intermediate momentum - ! levels. Then, all three derivatives (d/dz) of d(var_zt)/dz are taken over - ! all the intermediate thermodynamic levels, which results in the second - ! derivatives. Then, both derivatives (d/dz) of d^2(var_zt)/dz^2 are taken - ! over the intermediate momentum levels, which results in the third - ! derivatives. Finally, the derivative (d/dz) of d^3(var_zt)/dz^3 is taken - ! over the intermediate (central) thermodynamic level, which results in the - ! fourth derivative. At the central thermodynamic level, d^4(var_zt)/dz^4 - ! is multiplied by constant coefficient nu. - ! - ! --var_ztp2----------------------------------------------- t(k+2) - ! - ! ======d(var_zt)/dz======================================= m(k+1) - ! - ! --var_ztp1----d^2(var_zt)/dz^2--------------------------- t(k+1) - ! - ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(k) - ! - ! --var_zt------d^2(var_zt)/dz^2--------d^4(var_zt)/dz^4--- t(k) - ! - ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(k-1) - ! - ! --var_ztm1----d^2(var_zt)/dz^2--------------------------- t(k-1) - ! - ! ======d(var_zt)/dz======================================= m(k-2) - ! - ! --var_ztm2----------------------------------------------- t(k-2) - ! - ! The vertical indices t(k+2), m(k+1), t(k+1), m(k), t(k), m(k-1), t(k-1), - ! m(k-2), and t(k-2) correspond with altitudes zt(k+2), zm(k+1), zt(k+1), - ! zm(k), zt(k), zm(k-1), zt(k-1), zm(k-2), and zt(k-2) respectively. The - ! letter "t" is used for thermodynamic levels and the letter "m" is used for - ! momentum levels. - ! - ! dzt(k) = 1 / ( zm(k) - zm(k-1) ) - ! dzm(k) = 1 / ( zt(k+1) - zt(k) ) - ! dzm(k-1) = 1 / ( zt(k) - zt(k-1) ) - ! dzt(k+1) = 1 / ( zm(k+1) - zm(k) ) - ! dzt(k-1) = 1 / ( zm(k-1) - zm(k-2) ) - ! dzm(k+1) = 1 / ( zt(k+2) - zt(k+1) ) - ! dzm(k-2) = 1 / ( zt(k-1) - zt(k-2) ) - ! - ! The discretization of -nu*d^4(var_zt)/dz^4 at thermodynamic level (k) - ! is written out as follows: - ! - ! -nu - ! *dzt(k)*[ dzm(k)*{ dzt(k+1)*( dzm(k+1)*(var_zt(k+2)-var_zt(k+1)) - ! -dzm(k)*(var_zt(k+1)-var_zt(k)) ) - ! -dzt(k)*( dzm(k)*(var_zt(k+1)-var_zt(k)) - ! -dzm(k-1)*(var_zt(k)-var_zt(k-1)) ) } - ! -dzm(k-1)*{ dzt(k)*( dzm(k)*(var_zt(k+1)-var_zt(k)) - ! -dzm(k-1)*(var_zt(k)-var_zt(k-1)) ) - ! -dzt(k-1)*( dzm(k-1)*(var_zt(k)-var_zt(k-1)) - ! -dzm(k-2)*(var_zt(k-1)-var_zt(k-2)) ) } ]. - ! - ! Again, the term is treated completely implicitly, so the leading "-" sign - ! changes to a "+" sign when the term is brought over to the left-hand side, - ! and var_zt is considered to be at timestep (t+1). - ! - ! - ! Boundary Conditions: - ! - ! 1) Zero-flux boundary conditions. - ! This function is set up to use zero-flux boundary conditions at both - ! the lower boundary level and the upper boundary level. The flux, F, - ! is the amount of var_zt flowing normal through the boundary per unit - ! time per unit surface area. The derivative of the flux effects the - ! time-tendency of var_zt, such that: - ! - ! d(var_zt)/dt = -dF/dz. - ! - ! For the 4th-order numerical diffusion term, -nu*d^4(var_zt)/dz^4 (which - ! is actually -d[nu*d^3(var_zt)/dz^3]/dz with a constant coefficient, - ! nu), the flux is: - ! - ! F = +nu*d^3(var_zt)/dz^3. - ! - ! In order to have zero-flux boundary conditions, the third derivative of - ! var_zt, d^3(var_zt)/dz^3, needs to equal 0 at both the lower boundary - ! and the upper boundary. - ! - ! Fourth-order numerical diffusion is used in conjunction with - ! second-order eddy diffusion, +d[(K_zm+nu)*d(var_zt)/dz]/dz, where the - ! coefficient of eddy diffusivity, (K_zm+nu), varies in the vertical. - ! Both 4th-order numerical diffusion and 2nd-order eddy diffusion use the - ! same boundary condition type at all times, which in this case is - ! zero-flux boundary conditions. For 2nd-order eddy diffusion, the flux - ! is: F = -(K_zm+nu)*d(var_zt)/dz. In order to have zero-flux boundary - ! conditions, the derivative of var_zt, d(var_zt)/dz, needs to equal 0 at - ! both the lower boundary and the upper boundary. - ! - ! Thus, the boundary conditions used for 4th-order numerical diffusion - ! are: d^3(var_zt)/dz^3 = 0 and d(var_zt)/dz = 0 at both the upper - ! boundary and the lower boundary, resulting in four boundary conditions, - ! which is the number of boundary conditions needed for a 4th-order term. - ! - ! In order to discretize the lower boundary condition, consider a new - ! level outside the model (thermodynamic level 0) just below the lower - ! boundary level (thermodynamic level 1). The value of var_zt at the - ! level just outside the model is defined to be the same as the value of - ! var_zt at the lower boundary level. Therefore, the value of - ! d(var_zt)/dz between the level just outside the model and the lower - ! boundary level is 0, satisfying one of the boundary conditions. The - ! boundary condition d^3(var_zt)/dz^3 = 0 is also set at this level. The - ! rest of the levels involved are discretized normally, as listed above. - ! - ! Since the normal discretization includes two levels on either side of - ! the central level, the lower boundary begins to effect the - ! discretization at thermodynamic level 2. - ! - ! -var_zt(4)----------------------------------------------- t(4) - ! - ! ======d(var_zt)/dz======================================= m(3) - ! - ! -var_zt(3)----d^2(var_zt)/dz^2--------------------------- t(3) - ! - ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(2) - ! - ! -var_zt(2)----d^2(var_zt)/dz^2--------d^4(var_zt)/dz^4--- t(2) - ! - ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(1) - ! - ! -var_zt(1)----d^2(var_zt)/dz^2--------------------------- t(1) Boundary - ! - ! ======[d(var_zt)/dz = 0]================================= m(0) - ! - ! -[var_zt(0) = var_zt(1)]-----(level outside model)------- t(0) - ! - ! The discretization of -nu*d^4(var_zt)/dz^4 at thermodynamic level (k=2) - ! is written out as follows: - ! - ! -nu - ! *dzt(k)*[ dzm(k)*{ dzt(k+1)*( dzm(k+1)*(var_zt(k+2)-var_zt(k+1)) - ! -dzm(k)*(var_zt(k+1)-var_zt(k)) ) - ! -dzt(k)*( dzm(k)*(var_zt(k+1)-var_zt(k)) - ! -dzm(k-1)*(var_zt(k)-var_zt(k-1)) ) } - ! -dzm(k-1)*{ dzt(k)*( dzm(k)*(var_zt(k+1)-var_zt(k)) - ! -dzm(k-1)*(var_zt(k)-var_zt(k-1)) ) - ! -dzt(k-1)*dzm(k-1)*(var_zt(k)-var_zt(k-1)) } ]. - ! - ! Again, the term is treated completely implicitly, so the leading "-" - ! sign changes to a "+" sign when the term is brought over to the - ! left-hand side, and var_zt is considered to be at timestep (t+1). - ! - ! The result is dependent only on values of var_zt found at thermodynamic - ! levels 1, 2, 3, and 4. Thus, it only affects 4 diagonals on the - ! left-hand side matrix. - ! - ! The lower boundary also effects the discretization at thermodynamic - ! level 1. - ! - ! -var_zt(3)----------------------------------------------- t(3) - ! - ! ======d(var_zt)/dz======================================= m(2) - ! - ! -var_zt(2)----d^2(var_zt)/dz^2--------------------------- t(2) - ! - ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(1) - ! - ! -var_zt(1)----d^2(var_zt)/dz^2--------d^4(var_zt)/dz^4--- t(1) Boundary - ! - ! ======[d(var_zt)/dz = 0]==[d^3(var_zt)/dz^3 = 0]========= m(0) - ! - ! -[var_zt(0) = var_zt(1)]-----(level outside model)------- t(0) - ! - ! The discretization of -nu*d^4(var_zt)/dz^4 at thermodynamic level (k=1) - ! is written out as follows: - ! - ! -nu - ! *dzt(k)*[ dzm(k)*{ dzt(k+1)*( dzm(k+1)*(var_zt(k+2)-var_zt(k+1)) - ! -dzm(k)*(var_zt(k+1)-var_zt(k)) ) - ! -dzt(k)*dzm(k)*(var_zt(k+1)-var_zt(k)) } ]. - ! - ! Again, the term is treated completely implicitly, so the leading "-" - ! sign changes to a "+" sign when the term is brought over to the - ! left-hand side, and var_zt is considered to be at timestep (t+1). - ! - ! The result is dependent only on values of var_zt found at thermodynamic - ! levels 1, 2, and 3. Thus, it only affects 3 diagonals on the left-hand - ! side matrix. - ! - ! The same method can be used to discretize the upper boundary by - ! considering a new level outside the model just above the upper boundary - ! level. - ! - ! 2) Fixed-point boundary conditions. - ! Many equations in the model use fixed-point boundary conditions rather - ! than zero-flux boundary conditions. This means that the value of - ! var_zt stays the same over the course of the timestep at the lower - ! boundary, as well as at the upper boundary. - ! - ! For a 4th-order term, four boundary conditions are needed. Two - ! boundary conditions are applied at each boundary. For the case of - ! fixed-point boundary conditions, one of those two conditions is setting - ! var_zt = A, where A is a constant value. One more condition is needed. - ! Setting the values of d(var_zt)/dz and d^3(var_zt)/dz^3 are inherently - ! used for zero-flux (or perhaps fixed-flux) boundary conditions. - ! Fixed-point and zero-flux boundary conditions inherently should not be - ! invoked at the same time. The only remaining choice for a second - ! boundary condition for the fixed-point case is setting - ! d^2(var_zt)/dz^2. As it turns out, setting d^2(var_zt)/dz^2 = 0 is the - ! appropriate condition to use because it prevents values of var_zt at - ! levels outside the model from being involved in the discretization of - ! -nu*d^4(var_zt)/dz^4 at thermodynamic level 2. Setting - ! d^3(var_zt)/dz^3 = 0 does not accomplish the same thing for the - ! discretization of -nu*d^4(var_zt)/dz^4 at thermodynamic level 2. Also, - ! as stated above, fourth-order numerical diffusion is used in - ! conjunction with second-order eddy diffusion, - ! +d[(K_zm+nu)*d(var_zt)/dz]/dz, where the coefficient of eddy - ! diffusivity, (K_zm+nu), varies in the vertical. Both 4th-order - ! numerical diffusion and 2nd-order eddy diffusion use the same boundary - ! condition type at all times, which in this case is fixed-point boundary - ! conditions. For 2nd-order eddy diffusion, fixed-point boundary - ! conditions set var_zt = A, and do not set d(var_zt)/dz. Thus, - ! d(var_zt)/dz cannot be set for fixed-point boundary conditions. As - ! previously stated, the only other boundary condition that can be - ! invoked for a fixed-point boundary case is d^2(var_zt)/dz^2 = 0. - ! - ! Since the normal discretization includes two levels on either side of - ! the central level, the lower boundary begins to effect the - ! discretization at thermodynamic level 2. - ! - ! -var_zt(4)----------------------------------------------- t(4) - ! - ! ======d(var_zt)/dz======================================= m(3) - ! - ! -var_zt(3)----d^2(var_zt)/dz^2--------------------------- t(3) - ! - ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(2) - ! - ! -var_zt(2)----d^2(var_zt)/dz^2--------d^4(var_zt)/dz^4--- t(2) - ! - ! ======d(var_zt)/dz========d^3(var_zt)/dz^3=============== m(1) - ! - ! -var_zt(1)----[d^2(var_zt)/dz^2 = 0]--------------------- t(1) Boundary - ! - ! ======d(var_zt)/dz======================================= m(0) - ! - ! -var_zt(0)-------------------(level outside model)------- t(0) - ! - ! The discretization of -nu*d^4(var_zt)/dz^4 at thermodynamic level (k=2) - ! is written out as follows: - ! - ! -nu - ! *dzt(k)*[ dzm(k)*{ dzt(k+1)*( dzm(k+1)*(var_zt(k+2)-var_zt(k+1)) - ! -dzm(k)*(var_zt(k+1)-var_zt(k)) ) - ! -dzt(k)*( dzm(k)*(var_zt(k+1)-var_zt(k)) - ! -dzm(k-1)*(var_zt(k)-var_zt(k-1)) ) } - ! -dzm(k-1)*{ dzt(k)*( dzm(k)*(var_zt(k+1)-var_zt(k)) - ! -dzm(k-1)*(var_zt(k)-var_zt(k-1)) ) } ]. - ! - ! Again, the term is treated completely implicitly, so the leading "-" - ! sign changes to a "+" sign when the term is brought over to the - ! left-hand side, and var_zt is considered to be at timestep (t+1). - ! - ! The result is dependent only on values of var_zt found at thermodynamic - ! levels 1, 2, 3, and 4. Thus, it only affects 4 diagonals on the - ! left-hand side matrix. - ! - ! The same method can be used to discretize -nu*d^4(var_zt)/dz^4 at the - ! second-highest thermodynamic level (k=top-1) by setting - ! d^2(var_zt)/dz^2 = 0 at the highest thermodynamic level. - ! - ! The discretization at thermodynamic level (k=1) is written to simply - ! set the value var_zt(1) = A. Likewise, the discretization at - ! thermodynamic level (k=top) is written to simply set the value - ! var_zt(top) = B. In order to discretize the boundary conditions at the - ! lowest and highest vertical levels for equations requiring fixed-point - ! boundary conditions, either: - ! a) in the parent subroutine or function (that calls this function), - ! loop over all vertical levels from the second-lowest to the - ! second-highest, ignoring the lowest and highest levels. Then set - ! the values at the lowest and highest levels in the parent - ! subroutine; or - ! b) in the parent subroutine or function, loop over all vertical levels - ! and then overwrite the results at the lowest and highest levels. - ! - ! Either way, at the lowest and highest levels, an array with a value - ! of 1 at the main diagonal on the left-hand side and with values of 0 at - ! all other diagonals on the left-hand side will preserve the right-hand - ! side value at that level, thus satisfying the fixed-point boundary - ! conditions. - ! - ! - ! Conservation Properties: - ! - ! When zero-flux boundary conditions are used, this technique of - ! discretizing the 4th-order numerical diffusion term leads to conservative - ! differencing. When conservative differencing is in place, the column - ! totals for each column in the left-hand side matrix (for the 4th-order - ! numerical diffusion term) should be equal to 0. This ensures that the - ! total amount of the quantity var_zt over the entire vertical domain is - ! being conserved, meaning that nothing is lost due to diffusional effects. - ! - ! To see that this conservation law is satisfied, compute the 4th-order - ! numerical diffusion of var_zt and integrate vertically. In discretized - ! matrix notation (where "i" stands for the matrix column and "j" stands for - ! the matrix row): - ! - ! 0 = Sum_j Sum_i ( 1/dzt )_i ( nu*dzt*dzm*dzt*dzm )_ij (var_zt)_j. - ! - ! The left-hand side matrix, ( nu*dzt*dzm*dzt*dzm )_ij, is partially written - ! below. The sum over i in the above equation removes the first dzt(k) - ! everywhere from the matrix below. The sum over j leaves the column totals - ! that are desired. - ! - ! Left-hand side matrix contributions from 4th-order numerical diffusion - ! (or hyper-diffusion) term; first five vertical levels: - ! - ! column 1 || column 2 || column 3 || column 4 || column 5 - ! ------------------------------------------------------------------------------------------> - ! | +nu -nu +nu - ! | *dzt(k) *dzt(k) *dzt(k) - ! | *[ dzm(k) *[ dzm(k) *dzm(k) - !k=1| *{ dzt(k+1) *{ dzt(k+1) *dzt(k+1) 0 0 - ! | *dzm(k) *( dzm(k+1) *dzm(k+1) - ! | +dzt(k) +dzm(k) ) - ! | *dzm(k) } ] +dzt(k) - ! | *dzm(k) } ] - ! | - ! | -nu +nu -nu +nu - ! | *dzt(k) *dzt(k) *dzt(k) *dzt(k) - ! | *[ dzm(k) *[ dzm(k) *[ dzm(k) *dzm(k) - ! | *dzt(k) *{ dzt(k+1) *{ dzt(k+1) *dzt(k+1) - ! | *dzm(k-1) *dzm(k) *( dzm(k+1) *dzm(k+1) - ! | +dzm(k-1) +dzt(k) +dzm(k) ) - ! | *{ dzt(k) *( dzm(k) +dzt(k) - !k=2| *dzm(k-1) +dzm(k-1) ) *dzm(k) } 0 - ! | +dzt(k-1) } +dzm(k-1) - ! | *dzm(k-1) +dzm(k-1) *dzt(k) - ! | } ] *{ dzt(k) *dzm(k) ] - ! | *( dzm(k) - ! | +dzm(k-1) ) - ! | +dzt(k-1) - ! | *dzm(k-1) } ] - ! | - ! | +nu -nu +nu -nu +nu - ! | *dzt(k) *dzt(k) *dzt(k) *dzt(k) *dzt(k) - ! | *dzm(k-1) *[ dzm(k) *[ dzm(k) *[ dzm(k) *dzm(k) - ! | *dzt(k-1) *dzt(k) *{ dzt(k+1) *{ dzt(k+1) *dzt(k+1) - ! | *dzm(k-2) *dzm(k-1) *dzm(k) *( dzm(k+1) *dzm(k+1) - ! | +dzm(k-1) +dzt(k) +dzm(k) ) - ! | *{ dzt(k) *( dzm(k) +dzt(k) - !k=3| *dzm(k-1) +dzm(k-1) ) *dzm(k) } - ! | +dzt(k-1) } +dzm(k-1) - ! | *( dzm(k-1) +dzm(k-1) *dzt(k) - ! | +dzm(k-2) ) *{ dzt(k) *dzm(k) ] - ! | } ] *( dzm(k) - ! | +dzm(k-1) ) - ! | +dzt(k-1) - ! | *dzm(k-1) } ] - ! | - ! | +nu -nu +nu -nu - ! | *dzt(k) *dzt(k) *dzt(k) *dzt(k) - ! | *dzm(k-1) *[ dzm(k) *[ dzm(k) *[ dzm(k) - ! | *dzt(k-1) *dzt(k) *{ dzt(k+1) *{ dzt(k+1) - ! | *dzm(k-2) *dzm(k-1) *dzm(k) *( dzm(k+1) - ! | +dzm(k-1) +dzt(k) +dzm(k) ) - ! | *{ dzt(k) *( dzm(k) +dzt(k) - !k=4| 0 *dzm(k-1) +dzm(k-1) ) *dzm(k) } - ! | +dzt(k-1) } +dzm(k-1) - ! | *( dzm(k-1) +dzm(k-1) *dzt(k) - ! | +dzm(k-2) ) *{ dzt(k) *dzm(k) ] - ! | } ] *( dzm(k) - ! | +dzm(k-1) ) - ! | +dzt(k-1) - ! | *dzm(k-1) } ] - ! | - ! | +nu -nu +nu - ! | *dzt(k) *dzt(k) *dzt(k) - ! | *dzm(k-1) *[ dzm(k) *[ dzm(k) - ! | *dzt(k-1) *dzt(k) *{ dzt(k+1) - ! | *dzm(k-2) *dzm(k-1) *dzm(k) - ! | +dzm(k-1) +dzt(k) - ! | *{ dzt(k) *( dzm(k) - !k=5| 0 0 *dzm(k-1) +dzm(k-1) ) - ! | +dzt(k-1) } - ! | *( dzm(k-1) +dzm(k-1) - ! | +dzm(k-2) ) *{ dzt(k) - ! | } ] *( dzm(k) - ! | +dzm(k-1) ) - ! | +dzt(k-1) - ! | *dzm(k-1) } ] - ! \ / - ! - ! Note: The super-super diagonal term from level 4 and both the super - ! diagonal and super-super diagonal terms from level 5 are not shown - ! on this diagram. - ! - ! Note: The matrix shown is a five-diagonal matrix. For a nine-diagonal - ! matrix, there would be an extra row between each of the rows shown - ! and an extra column between each of the columns shown. However, - ! for the purposes of the var_zt 4th-order hyper-diffusion term, - ! those extra row and column values are all 0, and the conservation - ! properties of the matrix aren't effected. - ! - ! For the case of fixed-point boundary conditions, the contributions of the - ! 4th-order hyper-diffusion term are as follows (only the top 2 levels - ! differ from the matrix diagram above): - ! - ! column 1 || column 2 || column 3 || column 4 || column 5 - ! ------------------------------------------------------------------------------------------> - !k=1| 0 0 0 0 0 - ! | - ! | -nu +nu -nu +nu - ! | *dzt(k) *dzt(k) *dzt(k) *dzt(k) - ! | *[ dzm(k) *[ dzm(k) *[ dzm(k) *dzm(k) - ! | *dzt(k) *{ dzt(k+1) *{ dzt(k+1) *dzt(k+1) - ! | *dzm(k-1) *dzm(k) *( dzm(k+1) *dzm(k+1) - ! | +dzm(k-1) +dzt(k) +dzm(k) ) - !k=2| *dzt(k) *( dzm(k) +dzt(k) 0 - ! | *dzm(k-1) ] +dzm(k-1) ) *dzm(k) } - ! | } +dzm(k-1) - ! | +dzm(k-1) *dzt(k) - ! | *{ dzt(k) *dzm(k) ] - ! | *( dzm(k) - ! | +dzm(k-1) ) - ! | } ] - ! \ / - ! - ! For the left-hand side matrix as a whole, the matrix entries at level 1 - ! (k=1) read: 1 0 0 0 0. For the case of fixed-point boundary - ! conditions, conservative differencing is not in play. The total amount of - ! var_zt over the entire vertical domain is not being conserved, as amounts - ! of var_zt may be fluxed out through the upper boundary or lower boundary - ! through the effects of diffusion. - ! - ! Brian Griffin. October 7, 2008. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_grid_class, only: & - gr ! Variable(s) gr%nz - - implicit none - - ! Constant parameters - integer, parameter :: & - kp2_tdiag = 1, & ! Thermodynamic super-super diagonal index. - kp1_tdiag = 2, & ! Thermodynamic super diagonal index. - k_tdiag = 3, & ! Thermodynamic main diagonal index. - km1_tdiag = 4, & ! Thermodynamic sub diagonal index. - km2_tdiag = 5 ! Thermodynamic sub-sub diagonal index. - - ! Input Variables - character (len=*), intent(in) :: & - boundary_cond ! Type of boundary conditions being used - ! ('zero-flux' or 'fixed-point'). - - real( kind = core_rknd ), intent(in) :: & - nu, & ! Constant coef. of 4th-order numerical diffusion [m^4/s] - invrs_dzt, & ! Inverse of grid spacing over thermo. level (k) [1/m] - invrs_dzm, & ! Inverse of grid spacing over momentum level (k) [1/m] - invrs_dzmm1, & ! Inverse of grid spacing over momentum level (k-1) [1/m] - invrs_dztp1, & ! Inverse of grid spacing over thermo. level (k+1) [1/m] - invrs_dztm1, & ! Inverse of grid spacing over thermo. level (k-1) [1/m] - invrs_dzmp1, & ! Inverse of grid spacing over momentum level (k+1) [1/m] - invrs_dzmm2 ! Inverse of grid spacing over momentum level (k-2) [1/m] - - integer, intent(in) :: & - level ! Thermodynamic level where calculation occurs. [-] - - ! Return Variable - real( kind = core_rknd ), dimension(5) :: lhs - - - if ( level == 1 ) then - - ! Lowest level - ! k = 1; lower boundery level at surface. - ! Only relevant if zero-flux boundary conditions are used. - - if ( trim( boundary_cond ) == 'zero-flux' ) then - - ! Zero-flux boundary conditions - - ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] - lhs(km2_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = +nu*invrs_dzt & - *invrs_dzm*(invrs_dztp1*invrs_dzm + invrs_dzt*invrs_dzm) - - ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = -nu*invrs_dzt & - *invrs_dzm*( invrs_dztp1*(invrs_dzmp1 + invrs_dzm) & - +invrs_dzt*invrs_dzm ) - - ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] - lhs(kp2_tdiag) & - = +nu*invrs_dzt & - *invrs_dzm*invrs_dztp1*invrs_dzmp1 - - elseif ( trim( boundary_cond ) == 'fixed-point' ) then - - ! Fixed-point boundary conditions - ! The left-hand side matrix contributions from level 1 are - ! over-written or set in the parent subroutine. - - ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] - lhs(km2_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] - lhs(kp2_tdiag) & - = 0.0_core_rknd - - endif - - - elseif ( level == 2 ) then - - ! Second-lowest level - - if ( trim( boundary_cond ) == 'zero-flux' ) then - - ! Zero-flux boundary conditions - - ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] - lhs(km2_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = -nu*invrs_dzt & - *( invrs_dzm*invrs_dzt*invrs_dzmm1 & - +invrs_dzmm1*( invrs_dzt*invrs_dzmm1 & - +invrs_dztm1*invrs_dzmm1 ) ) - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = +nu*invrs_dzt & - *( invrs_dzm*( invrs_dztp1*invrs_dzm & - +invrs_dzt*(invrs_dzm + invrs_dzmm1) ) & - +invrs_dzmm1*( invrs_dzt*(invrs_dzm + invrs_dzmm1) & - +invrs_dztm1*invrs_dzmm1 ) ) - - ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = -nu*invrs_dzt & - *( invrs_dzm*( invrs_dztp1*(invrs_dzmp1 + invrs_dzm) & - +invrs_dzt*invrs_dzm ) & - +invrs_dzmm1*invrs_dzt*invrs_dzm ) - - ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] - lhs(kp2_tdiag) & - = +nu*invrs_dzt & - *invrs_dzm*invrs_dztp1*invrs_dzmp1 - - elseif ( trim( boundary_cond ) == 'fixed-point' ) then - - ! Fixed-point boundary conditions - - ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] - lhs(km2_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = -nu*invrs_dzt & - *( invrs_dzm*invrs_dzt*invrs_dzmm1 & - +invrs_dzmm1*invrs_dzt*invrs_dzmm1 ) - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = +nu*invrs_dzt & - *( invrs_dzm*( invrs_dztp1*invrs_dzm & - +invrs_dzt*(invrs_dzm + invrs_dzmm1) ) & - +invrs_dzmm1*( invrs_dzt*(invrs_dzm + invrs_dzmm1) ) ) - - ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = -nu*invrs_dzt & - *( invrs_dzm*( invrs_dztp1*(invrs_dzmp1 + invrs_dzm) & - +invrs_dzt*invrs_dzm ) & - +invrs_dzmm1*invrs_dzt*invrs_dzm ) - - ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] - lhs(kp2_tdiag) & - = +nu*invrs_dzt & - *invrs_dzm*invrs_dztp1*invrs_dzmp1 - - endif - - - elseif ( level > 2 .and. level < gr%nz-1 ) then - - ! k > 2 and k < num_levels-1 - ! These interior level are not effected by boundary conditions. - - ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] - lhs(km2_tdiag) & - = +nu*invrs_dzt & - *invrs_dzmm1*invrs_dztm1*invrs_dzmm2 - - ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = -nu*invrs_dzt & - *( invrs_dzm*invrs_dzt*invrs_dzmm1 & - +invrs_dzmm1*( invrs_dzt*invrs_dzmm1 & - +invrs_dztm1*(invrs_dzmm1 + invrs_dzmm2) ) ) - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = +nu*invrs_dzt & - *( invrs_dzm*( invrs_dztp1*invrs_dzm & - +invrs_dzt*(invrs_dzm + invrs_dzmm1) ) & - +invrs_dzmm1*( invrs_dzt*(invrs_dzm + invrs_dzmm1) & - +invrs_dztm1*invrs_dzmm1 ) ) - - ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = -nu*invrs_dzt & - *( invrs_dzm*( invrs_dztp1*(invrs_dzmp1 + invrs_dzm) & - +invrs_dzt*invrs_dzm ) & - +invrs_dzmm1*invrs_dzt*invrs_dzm ) - - ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] - lhs(kp2_tdiag) & - = +nu*invrs_dzt & - *invrs_dzm*invrs_dztp1*invrs_dzmp1 - - - elseif ( level == gr%nz-1 ) then - - ! Second-highest level - - if ( trim( boundary_cond ) == 'zero-flux' ) then - - ! Zero-flux boundary conditions - - ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] - lhs(km2_tdiag) & - = +nu*invrs_dzt & - *invrs_dzmm1*invrs_dztm1*invrs_dzmm2 - - ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = -nu*invrs_dzt & - *( invrs_dzm*invrs_dzt*invrs_dzmm1 & - +invrs_dzmm1*( invrs_dzt*invrs_dzmm1 & - +invrs_dztm1*(invrs_dzmm1 + invrs_dzmm2) ) ) - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = +nu*invrs_dzt & - *( invrs_dzm*( invrs_dztp1*invrs_dzm & - +invrs_dzt*(invrs_dzm + invrs_dzmm1) ) & - +invrs_dzmm1*( invrs_dzt*(invrs_dzm + invrs_dzmm1) & - +invrs_dztm1*invrs_dzmm1 ) ) - - ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = -nu*invrs_dzt & - *( invrs_dzm*( invrs_dztp1*invrs_dzm & - +invrs_dzt*invrs_dzm ) & - +invrs_dzmm1*invrs_dzt*invrs_dzm ) - - ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] - lhs(kp2_tdiag) & - = 0.0_core_rknd - - elseif ( trim( boundary_cond ) == 'fixed-point' ) then - - ! Fixed-point boundary conditions - - ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] - lhs(km2_tdiag) & - = +nu*invrs_dzt & - *invrs_dzmm1*invrs_dztm1*invrs_dzmm2 - - ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = -nu*invrs_dzt & - *( invrs_dzm*invrs_dzt*invrs_dzmm1 & - +invrs_dzmm1*( invrs_dzt*invrs_dzmm1 & - +invrs_dztm1*(invrs_dzmm1 + invrs_dzmm2) ) ) - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = +nu*invrs_dzt & - *( invrs_dzm*( invrs_dzt*(invrs_dzm + invrs_dzmm1) ) & - +invrs_dzmm1*( invrs_dzt*(invrs_dzm + invrs_dzmm1) & - +invrs_dztm1*invrs_dzmm1 ) ) - - ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = -nu*invrs_dzt & - *( invrs_dzm*invrs_dzt*invrs_dzm & - +invrs_dzmm1*invrs_dzt*invrs_dzm ) - - ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] - lhs(kp2_tdiag) & - = 0.0_core_rknd - - endif - - - elseif ( level == gr%nz ) then - - ! Highest level - ! k = gr%nz; upper boundery level at model top. - ! Only relevant if zero-flux boundary conditions are used. - - if ( trim( boundary_cond ) == 'zero-flux' ) then - - ! Zero-flux boundary conditions - - ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] - lhs(km2_tdiag) & - = +nu*invrs_dzt & - *invrs_dzmm1*invrs_dztm1*invrs_dzmm2 - - ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = -nu*invrs_dzt & - *invrs_dzmm1*( invrs_dzt*invrs_dzmm1 & - +invrs_dztm1*(invrs_dzmm1 + invrs_dzmm2) ) - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = +nu*invrs_dzt & - *invrs_dzmm1*(invrs_dzt*invrs_dzmm1 + invrs_dztm1*invrs_dzmm1) - - ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] - lhs(kp2_tdiag) & - = 0.0_core_rknd - - elseif ( trim( boundary_cond ) == 'fixed-point' ) then - - ! Fixed-point boundary conditions - ! The left-hand side matrix contributions from level gr%nz are - ! over-written or set in the parent subroutine. - - ! Thermodynamic sub-sub diagonal: [ x var_zt(k-2,) ] - lhs(km2_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic sub diagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic super diagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic super-super diagonal: [ x var_zt(k+2,) ] - lhs(kp2_tdiag) & - = 0.0_core_rknd - - endif - - endif - - return - - end function hyper_dfsn_4th_ord_zt_lhs - - !============================================================================= - pure function hyper_dfsn_4th_ord_zm_lhs( boundary_cond, nu, invrs_dzm, & - invrs_dztp1, invrs_dzt, & - invrs_dzmp1, invrs_dzmm1, & - invrs_dztp2, invrs_dztm1, level ) & - result( lhs ) - - ! Note: In the "Description" section of this function, the variable - ! "invrs_dzm" will be written as simply "dzm", and the variable - ! "invrs_dzt" will be written as simply "dzt". This is being done as - ! as device to save space and to make some parts of the description - ! more readable. This change does not pertain to the actual code. - - ! Description: - ! Vertical 4th-order numerical diffusion of var_zm: implicit portion of the - ! code. - ! - ! Fourth-order numerical diffusion, or fourth-order hyper-diffusion, is used - ! to help eliminate small-scale noise without altering larger-scale - ! features. - ! - ! The variable "var_zm" stands for a variable that is located at momentum - ! grid levels. - ! - ! The d(var_zm)/dt equation contains a 4th-order numerical diffusion term: - ! - ! - nu * d^4(var_zm)/dz^4. - ! - ! This term is solved for completely implicitly, such that: - ! - ! - nu * d^4( var_zm(t+1) )/dz^4. - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed - ! to a "+". - ! - ! The timestep index (t+1) means that the value of var_zm being used is from - ! the next timestep, which is being advanced to in solving the d(var_zm)/dt - ! equation. - ! - ! The term is discretized as follows: - ! - ! The five values of var_zm are found on the momentum levels. All four - ! derivatives (d/dz) of var_zm are taken over all the intermediate - ! thermodynamic levels. Then, all three derivatives (d/dz) of d(var_zm)/dz - ! are taken over all the intermediate momentum levels, which results in the - ! second derivatives. Then, both derivatives (d/dz) of d^2(var_zm)/dz^2 are - ! taken over the intermediate thermodynamic levels, which results in the - ! third derivatives. Finally, the derivative (d/dz) of d^3(var_zm)/dz^3 is - ! taken over the intermediate (central) momentum level, which results in the - ! fourth derivative. At the central momentum level, d^4(var_zm)/dz^4 is - ! multiplied by constant coefficient nu. - ! - ! ==var_zmp2=============================================== m(k+2) - ! - ! ------d(var_zm)/dz--------------------------------------- t(k+2) - ! - ! ==var_zmp1====d^2(var_zm)/dz^2=========================== m(k+1) - ! - ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(k+1) - ! - ! ==var_zm======d^2(var_zm)/dz^2========d^4(var_zm)/dz^4=== m(k) - ! - ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(k) - ! - ! ==var_zmm1====d^2(var_zm)/dz^2=========================== m(k-1) - ! - ! ------d(var_zm)/dz--------------------------------------- t(k-1) - ! - ! ==var_zmm2=============================================== m(k-2) - ! - ! The vertical indices m(k+2), t(k+2), m(k+1), t(k+1), m(k), t(k), m(k-1), - ! t(k-1), and m(k-2) correspond with altitudes zm(k+2), zt(k+2), zm(k+1), - ! zt(k+1), zm(k), zt(k), zm(k-1), zt(k-1), and zm(k-2) respectively. The - ! letter "t" is used for thermodynamic levels and the letter "m" is used for - ! momentum levels. - ! - ! dzm(k) = 1 / ( zt(k+1) - zt(k) ) - ! dzt(k+1) = 1 / ( zm(k+1) - zm(k) ) - ! dzt(k) = 1 / ( zm(k) - zm(k-1) ) - ! dzm(k+1) = 1 / ( zt(k+2) - zt(k+1) ) - ! dzm(k-1) = 1 / ( zt(k) - zt(k-1) ) - ! dzt(k+2) = 1 / ( zm(k+2) - zm(k+1) ) - ! dzt(k-1) = 1 / ( zm(k-1) - zm(k-2) ) - ! - ! The discretization of -nu*d^4(var_zm)/dz^4 at momentum level (k) is - ! written out as follows: - ! - ! -nu*dzm(k)*[ dzt(k+1)*{ dzm(k+1)*( dzt(k+2)*(var_zm(k+2)-var_zm(k+1)) - ! -dzt(k+1)*(var_zm(k+1)-var_zm(k)) ) - ! -dzm(k)*( dzt(k+1)*(var_zm(k+1)-var_zm(k)) - ! -dzt(k)*(var_zm(k)-var_zm(k-1)) ) } - ! -dzt(k)*{ dzm(k)*( dzt(k+1)*(var_zm(k+1)-var_zm(k)) - ! -dzt(k)*(var_zm(k)-var_zm(k-1)) ) - ! -dzm(k-1)*( dzt(k)*(var_zm(k)-var_zm(k-1)) - ! -dzt(k-1)*(var_zm(k-1)-var_zm(k-2)) ) } ]. - ! - ! Again, the term is treated completely implicitly, so the leading "-" sign - ! changes to a "+" sign when the term is brought over to the left-hand side, - ! and var_zm is considered to be at timestep (t+1). - ! - ! - ! Boundary Conditions: - ! - ! 1) Zero-flux boundary conditions. - ! This function is set up to use zero-flux boundary conditions at both - ! the lower boundary level and the upper boundary level. The flux, F, - ! is the amount of var_zm flowing normal through the boundary per unit - ! time per unit surface area. The derivative of the flux effects the - ! time-tendency of var_zm, such that: - ! - ! d(var_zm)/dt = -dF/dz. - ! - ! For the 4th-order numerical diffusion term, -nu*d^4(var_zm)/dz^4 (which - ! is actually -d[nu*d^3(var_zm)/dz^3]/dz with a constant coefficient, - ! nu), the flux is: - ! - ! F = +nu*d^3(var_zm)/dz^3. - ! - ! In order to have zero-flux boundary conditions, the third derivative of - ! var_zm, d^3(var_zm)/dz^3, needs to equal 0 at both the lower boundary - ! and the upper boundary. - ! - ! Fourth-order numerical diffusion is used in conjunction with - ! second-order eddy diffusion, +d[(K_zt+nu)*d(var_zm)/dz]/dz, where the - ! coefficient of eddy diffusivity, (K_zt+nu), varies in the vertical. - ! Both 4th-order numerical diffusion and 2nd-order eddy diffusion use the - ! same boundary condition type at all times, which in this case is - ! zero-flux boundary conditions. For 2nd-order eddy diffusion, the flux - ! is: F = -(K_zt+nu)*d(var_zm)/dz. In order to have zero-flux boundary - ! conditions, the derivative of var_zm, d(var_zm)/dz, needs to equal 0 at - ! both the lower boundary and the upper boundary. - ! - ! Thus, the boundary conditions used for 4th-order numerical diffusion - ! are: d^3(var_zm)/dz^3 = 0 and d(var_zm)/dz = 0 at both the upper - ! boundary and the lower boundary, resulting in four boundary conditions, - ! which is the number of boundary conditions needed for a 4th-order term. - ! - ! In order to discretize the lower boundary condition, consider a new - ! level outside the model (momentum level 0) just below the lower - ! boundary level (momentum level 1). The value of var_zm at the level - ! just outside the model is defined to be the same as the value of var_zm - ! at the lower boundary level. Therefore, the value of d(var_zm)/dz - ! between the level just outside the model and the lower boundary level - ! is 0, satisfying one of the boundary conditions. The boundary - ! condition d^3(var_zm)/dz^3 = 0 is also set at this level. The rest of - ! the levels involved are discretized normally, as listed above. - ! - ! Since the normal discretization includes two levels on either side of - ! the central level, the lower boundary begins to effect the - ! discretization at momentum level 2. - ! - ! =var_zm(4)=============================================== m(4) - ! - ! ------d(var_zm)/dz--------------------------------------- t(4) - ! - ! =var_zm(3)====d^2(var_zm)/dz^2=========================== m(3) - ! - ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(3) - ! - ! =var_zm(2)====d^2(var_zm)/dz^2========d^4(var_zm)/dz^4=== m(2) - ! - ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(2) - ! - ! =var_zm(1)====d^2(var_zm)/dz^2=========================== m(1) Boundary - ! - ! ------[d(var_zm)/dz = 0]--------------------------------- t(1) - ! - ! =[var_zm(0) = var_zm(1)]=====(level outside model)======= m(0) - ! - ! The discretization of -nu*d^4(var_zm)/dz^4 at momentum level (k=2) is - ! written out as follows: - ! - ! -nu*dzm(k)*[ dzt(k+1)*{ dzm(k+1)*( dzt(k+2)*(var_zm(k+2)-var_zm(k+1)) - ! -dzt(k+1)*(var_zm(k+1)-var_zm(k)) ) - ! -dzm(k)*( dzt(k+1)*(var_zm(k+1)-var_zm(k)) - ! -dzt(k)*(var_zm(k)-var_zm(k-1)) ) } - ! -dzt(k)*{ dzm(k)*( dzt(k+1)*(var_zm(k+1)-var_zm(k)) - ! -dzt(k)*(var_zm(k)-var_zm(k-1)) ) - ! -dzm(k-1)*dzt(k)*(var_zm(k)-var_zm(k-1)) } ]. - ! - ! Again, the term is treated completely implicitly, so the leading "-" - ! sign changes to a "+" sign when the term is brought over to the - ! left-hand side, and var_zm is considered to be at timestep (t+1). - ! - ! The result is dependent only on values of var_zm found at momentum - ! levels 1, 2, 3, and 4. Thus, it only affects 4 diagonals on the - ! left-hand side matrix. - ! - ! The lower boundary also effects the discretization at momentum - ! level 1. - ! - ! =var_zm(3)=============================================== m(3) - ! - ! ------d(var_zm)/dz--------------------------------------- t(3) - ! - ! =var_zm(2)====d^2(var_zm)/dz^2=========================== m(2) - ! - ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(2) - ! - ! =var_zm(1)====d^2(var_zm)/dz^2========d^4(var_zm)/dz^4=== m(1) Boundary - ! - ! ------[d(var_zm)/dz = 0]--[d^3(var_zm)/dz^3 = 0]--------- t(1) - ! - ! =[var_zm(0) = var_zm(1)]=====(level outside model)======= m(0) - ! - ! The discretization of -nu*d^4(var_zm)/dz^4 at momentum level (k=1) is - ! written out as follows: - ! - ! -nu*dzm(k)*[dzt(k+1)*{ dzm(k+1)*( dzt(k+2)*(var_zm(k+2)-var_zm(k+1)) - ! -dzt(k+1)*(var_zm(k+1)-var_zm(k)) ) - ! -dzm(k)*dzt(k+1)*(var_zm(k+1)-var_zm(k)) } ]. - ! - ! Again, the term is treated completely implicitly, so the leading "-" - ! sign changes to a "+" sign when the term is brought over to the - ! left-hand side, and var_zm is considered to be at timestep (t+1). - ! - ! The result is dependent only on values of var_zm found at momentum - ! levels 1, 2, and 3. Thus, it only affects 3 diagonals on the left-hand - ! side matrix. - ! - ! The same method can be used to discretize the upper boundary by - ! considering a new level outside the model just above the upper boundary - ! level. - ! - ! 2) Fixed-point boundary conditions. - ! Many equations in the model use fixed-point boundary conditions rather - ! than zero-flux boundary conditions. This means that the value of - ! var_zm stays the same over the course of the timestep at the lower - ! boundary, as well as at the upper boundary. - ! - ! For a 4th-order term, four boundary conditions are needed. Two - ! boundary conditions are applied at each boundary. For the case of - ! fixed-point boundary conditions, one of those two conditions is setting - ! var_zm = A, where A is a constant value. One more condition is needed. - ! Setting the values of d(var_zm)/dz and d^3(var_zm)/dz^3 are inherently - ! used for zero-flux (or perhaps fixed-flux) boundary conditions. - ! Fixed-point and zero-flux boundary conditions inherently should not be - ! invoked at the same time. The only remaining choice for a second - ! boundary condition for the fixed-point case is setting - ! d^2(var_zm)/dz^2. As it turns out, setting d^2(var_zm)/dz^2 = 0 is the - ! appropriate condition to use because it prevents values of var_zm at - ! levels outside the model from being involved in the discretization of - ! -nu*d^4(var_zm)/dz^4 at momentum level 2. Setting d^3(var_zm)/dz^3 = 0 - ! does not accomplish the same thing for the discretization of - ! -nu*d^4(var_zm)/dz^4 at momentum level 2. Also, as stated above, - ! fourth-order numerical diffusion is used in conjunction with - ! second-order eddy diffusion, +d[(K_zt+nu)*d(var_zm)/dz]/dz, where the - ! coefficient of eddy diffusivity, (K_zt+nu), varies in the vertical. - ! Both 4th-order numerical diffusion and 2nd-order eddy diffusion use the - ! same boundary condition type at all times, which in this case is - ! fixed-point boundary conditions. For 2nd-order eddy diffusion, - ! fixed-point boundary conditions set var_zm = A, and do not set - ! d(var_zm)/dz. Thus, d(var_zm)/dz cannot be set for fixed-point - ! boundary conditions. As previously stated, the only other boundary - ! condition that can be invoked for a fixed-point boundary case is - ! d^2(var_zm)/dz^2 = 0. - ! - ! Since the normal discretization includes two levels on either side of - ! the central level, the lower boundary begins to effect the - ! discretization at momentum level 2. - ! - ! =var_zm(4)=============================================== m(4) - ! - ! ------d(var_zm)/dz--------------------------------------- t(4) - ! - ! =var_zm(3)====d^2(var_zm)/dz^2=========================== m(3) - ! - ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(3) - ! - ! =var_zm(2)====d^2(var_zm)/dz^2========d^4(var_zm)/dz^4=== m(2) - ! - ! ------d(var_zm)/dz--------d^3(var_zm)/dz^3--------------- t(2) - ! - ! =var_zm(1)====[d^2(var_zm)/dz^2 = 0]===================== m(1) Boundary - ! - ! ------d(var_zm)/dz--------------------------------------- t(1) - ! - ! =var_zm(0)===================(level outside model)======= m(0) - ! - ! The discretization of -nu*d^4(var_zm)/dz^4 at momentum level (k=2) is - ! written out as follows: - ! - ! -nu*dzm(k)*[ dzt(k+1)*{ dzm(k+1)*( dzt(k+2)*(var_zm(k+2)-var_zm(k+1)) - ! -dzt(k+1)*(var_zm(k+1)-var_zm(k)) ) - ! -dzm(k)*( dzt(k+1)*(var_zm(k+1)-var_zm(k)) - ! -dzt(k)*(var_zm(k)-var_zm(k-1)) ) } - ! -dzt(k)*{ dzm(k)*( dzt(k+1)*(var_zm(k+1)-var_zm(k)) - ! -dzt(k)*(var_zm(k)-var_zm(k-1)) ) } ]. - ! - ! Again, the term is treated completely implicitly, so the leading "-" - ! sign changes to a "+" sign when the term is brought over to the - ! left-hand side, and var_zm is considered to be at timestep (t+1). - ! - ! The result is dependent only on values of var_zm found at momentum - ! levels 1, 2, 3, and 4. Thus, it only affects 4 diagonals on the - ! left-hand side matrix. - ! - ! The same method can be used to discretize -nu*d^4(var_zm)/dz^4 at the - ! second-highest momentum level (k=top-1) by setting d^2(var_zm)/dz^2 = 0 - ! at the highest momentum level. - ! - ! The discretization at momentum level (k=1) is written to simply set the - ! value var_zm(1) = A. Likewise, the discretization at momentum level - ! (k=top) is written to simply set the value var_zm(top) = B. In order - ! to discretize the boundary conditions at the lowest and highest - ! vertical levels for equations requiring fixed-point boundary - ! conditions, either: - ! a) in the parent subroutine or function (that calls this function), - ! loop over all vertical levels from the second-lowest to the - ! second-highest, ignoring the lowest and highest levels. Then set - ! the values at the lowest and highest levels in the parent - ! subroutine; or - ! b) in the parent subroutine or function, loop over all vertical levels - ! and then overwrite the results at the lowest and highest levels. - ! - ! Either way, at the lowest and highest levels, an array with a value - ! of 1 at the main diagonal on the left-hand side and with values of 0 at - ! all other diagonals on the left-hand side will preserve the right-hand - ! side value at that level, thus satisfying the fixed-point boundary - ! conditions. - ! - ! - ! Conservation Properties: - ! - ! When zero-flux boundary conditions are used, this technique of - ! discretizing the 4th-order numerical diffusion term leads to conservative - ! differencing. When conservative differencing is in place, the column - ! totals for each column in the left-hand side matrix (for the 4th-order - ! numerical diffusion term) should be equal to 0. This ensures that the - ! total amount of the quantity var_zm over the entire vertical domain is - ! being conserved, meaning that nothing is lost due to diffusional effects. - ! - ! To see that this conservation law is satisfied, compute the 4th-order - ! numerical diffusion of var_zm and integrate vertically. In discretized - ! matrix notation (where "i" stands for the matrix column and "j" stands for - ! the matrix row): - ! - ! 0 = Sum_j Sum_i ( 1/dzm )_i ( nu*dzm*dzt*dzm*dzt )_ij (var_zm)_j. - ! - ! The left-hand side matrix, ( nu*dzm*dzt*dzm*dzt )_ij, is partially written - ! below. The sum over i in the above equation removes the first dzm(k) - ! everywhere from the matrix below. The sum over j leaves the column totals - ! that are desired. - ! - ! Left-hand side matrix contributions from 4th-order numerical diffusion - ! (or hyper-diffusion) term; first five vertical levels: - ! - ! column 1 || column 2 || column 3 || column 4 || column 5 - ! ------------------------------------------------------------------------------------------> - ! | +nu -nu +nu - ! | *dzm(k) *dzm(k) *dzm(k) - ! | *[ dzt(k+1) *[ dzt(k+1) *dzt(k+1) - ! | *{ dzm(k+1) *{ dzm(k+1) *dzm(k+1) - !k=1| *dzt(k+1) *( dzt(k+2) *dzt(k+2) 0 0 - ! | +dzm(k) +dzt(k+1) ) - ! | *dzt(k+1) } +dzm(k) - ! | ] *dzt(k+1) } ] - ! | - ! | -nu +nu -nu +nu - ! | *dzm(k) *dzm(k) *dzm(k) *dzm(k) - ! | *[ dzt(k+1) *[ dzt(k+1) *[ dzt(k+1) *dzt(k+1) - ! | *dzm(k) *{ dzm(k+1) *{ dzm(k+1) *dzm(k+1) - ! | *dzt(k) *dzt(k+1) *( dzt(k+2) *dzt(k+2) - ! | +dzt(k) +dzm(k) +dzt(k+1) ) - !k=2| *{ dzm(k) *( dzt(k+1) +dzm(k) 0 - ! | *dzt(k) +dzt(k) ) } *dzt(k+1) } - ! | +dzm(k-1) +dzt(k) +dzt(k) - ! | *dzt(k) } ] *{ dzm(k) *dzm(k) - ! | *( dzt(k+1) *dzt(k+1) ] - ! | +dzt(k) ) - ! | +dzm(k-1) - ! | *dzt(k) } ] - ! | - ! | +nu -nu +nu -nu +nu - ! | *dzm(k) *dzm(k) *dzm(k) *dzm(k) *dzm(k) - ! | *dzt(k) *[ dzt(k+1) *[ dzt(k+1) *[ dzt(k+1) *dzt(k+1) - ! | *dzm(k-1) *dzm(k) *{ dzm(k+1) *{ dzm(k+1) *dzm(k+1) - ! | *dzt(k-1) *dzt(k) *dzt(k+1) *( dzt(k+2) *dzt(k+2) - ! | +dzt(k) +dzm(k) +dzt(k+1) ) - !k=3| *{ dzm(k) *( dzt(k+1) +dzm(k) - ! | *dzt(k) +dzt(k) ) } *dzt(k+1) } - ! | +dzm(k-1) +dzt(k) +dzt(k) - ! | *( dzt(k) *{ dzm(k) *dzm(k) - ! | +dzt(k-1) ) *( dzt(k+1) *dzt(k+1) ] - ! | } ] +dzt(k) ) - ! | +dzm(k-1) - ! | *dzt(k) } ] - ! | - ! | +nu -nu +nu -nu - ! | *dzm(k) *dzm(k) *dzm(k) *dzm(k) - ! | *dzt(k) *[ dzt(k+1) *[ dzt(k+1) *[ dzt(k+1) - ! | *dzm(k-1) *dzm(k) *{ dzm(k+1) *{ dzm(k+1) - ! | *dzt(k-1) *dzt(k) *dzt(k+1) *( dzt(k+2) - ! | +dzt(k) +dzm(k) +dzt(k+1) ) - !k=4| 0 *{ dzm(k) *( dzt(k+1) +dzm(k) - ! | *dzt(k) +dzt(k) ) } *dzt(k+1) } - ! | +dzm(k-1) +dzt(k) +dzt(k) - ! | *( dzt(k) *{ dzm(k) *dzm(k) - ! | +dzt(k-1) ) *( dzt(k+1) *dzt(k+1) ] - ! | } ] +dzt(k) ) - ! | +dzm(k-1) - ! | *dzt(k) } ] - ! | - ! | +nu -nu +nu - ! | *dzm(k) *dzm(k) *dzm(k) - ! | *dzt(k) *[ dzt(k+1) *[ dzt(k+1) - ! | *dzm(k-1) *dzm(k) *{ dzm(k+1) - ! | *dzt(k-1) *dzt(k) *dzt(k+1) - ! | +dzt(k) +dzm(k) - !k=5| 0 0 *{ dzm(k) *( dzt(k+1) - ! | *dzt(k) +dzt(k) ) } - ! | +dzm(k-1) +dzt(k) - ! | *( dzt(k) *{ dzm(k) - ! | +dzt(k-1) ) *( dzt(k+1) - ! | } ] +dzt(k) ) - ! | +dzm(k-1) - ! | *dzt(k) } ] - ! \ / - ! - ! Note: The super-super diagonal term from level 4 and both the super - ! diagonal and super-super diagonal terms from level 5 are not shown - ! on this diagram. - ! - ! Note: The matrix shown is a five-diagonal matrix. For a nine-diagonal - ! matrix, there would be an extra row between each of the rows shown - ! and an extra column between each of the columns shown. However, - ! for the purposes of the var_zm 4th-order hyper-diffusion term, - ! those extra row and column values are all 0, and the conservation - ! properties of the matrix aren't effected. - ! - ! For the case of fixed-point boundary conditions, the contributions of the - ! 4th-order hyper-diffusion term are as follows (only the top 2 levels - ! differ from the matrix diagram above): - ! - ! column 1 || column 2 || column 3 || column 4 || column 5 - ! ------------------------------------------------------------------------------------------> - !k=1| 0 0 0 0 0 - ! | - ! | -nu +nu -nu +nu - ! | *dzm(k) *dzm(k) *dzm(k) *dzm(k) - ! | *[ dzt(k+1) *[ dzt(k+1) *[ dzt(k+1) *dzt(k+1) - ! | *dzm(k) *{ dzm(k+1) *{ dzm(k+1) *dzm(k+1) - ! | *dzt(k) *dzt(k+1) *( dzt(k+2) *dzt(k+2) - !k=2| +dzt(k) +dzm(k) +dzt(k+1) ) 0 - ! | *dzm(k) *( dzt(k+1) +dzm(k) - ! | *dzt(k) ] +dzt(k) ) } *dzt(k+1) } - ! | +dzt(k) +dzt(k) - ! | *dzm(k) *dzm(k) - ! | *( dzt(k+1) *dzt(k+1) ] - ! | +dzt(k) ) ] - ! \ / - ! - ! For the left-hand side matrix as a whole, the matrix entries at level 1 - ! (k=1) read: 1 0 0 0 0. For the case of fixed-point boundary - ! conditions, conservative differencing is not in play. The total amount of - ! var_zm over the entire vertical domain is not being conserved, as amounts - ! of var_zm may be fluxed out through the upper boundary or lower boundary - ! through the effects of diffusion. - ! - ! Brian Griffin. September 28, 2008. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_grid_class, only: & - gr ! Variable(s) gr%nz - - implicit none - - ! Constant parameters - integer, parameter :: & - kp2_mdiag = 1, & ! Momentum super-super diagonal index. - kp1_mdiag = 2, & ! Momentum super diagonal index. - k_mdiag = 3, & ! Momentum main diagonal index. - km1_mdiag = 4, & ! Momentum sub diagonal index. - km2_mdiag = 5 ! Momentum sub-sub diagonal index. - - ! Input Variables - character (len=*), intent(in) :: & - boundary_cond ! Type of boundary conditions being used - ! ('zero-flux' or 'fixed-point'). - - real( kind = core_rknd ), intent(in) :: & - nu, & ! Constant coef. of 4th-order numerical diffusion [m^4/s] - invrs_dzm, & ! Inverse of grid spacing over momentum level (k) [1/m] - invrs_dztp1, & ! Inverse of grid spacing over thermo. level (k+1) [1/m] - invrs_dzt, & ! Inverse of grid spacing over thermo. level (k) [1/m] - invrs_dzmp1, & ! Inverse of grid spacing over momentum level (k+1) [1/m] - invrs_dzmm1, & ! Inverse of grid spacing over momentum level (k-1) [1/m] - invrs_dztp2, & ! Inverse of grid spacing over thermo. level (k+2) [1/m] - invrs_dztm1 ! Inverse of grid spacing over thermo. level (k-1) [1/m] - - integer, intent(in) :: & - level ! Momentum level where calculation occurs. [-] - - ! Return Variable - real( kind = core_rknd ), dimension(5) :: lhs - - - if ( level == 1 ) then - - ! Lowest level - ! k = 1; lower boundery level at surface. - ! Only relevant if zero-flux boundary conditions are used. - - if ( trim( boundary_cond ) == 'zero-flux' ) then - - ! Zero-flux boundary conditions - - ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] - lhs(km2_mdiag) & - = 0.0_core_rknd - - ! Momentum sub diagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) & - = 0.0_core_rknd - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) & - = +nu*invrs_dzm & - *invrs_dztp1*(invrs_dzmp1*invrs_dztp1 + invrs_dzm*invrs_dztp1) - - ! Momentum super diagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) & - = -nu*invrs_dzm & - *invrs_dztp1*( invrs_dzmp1*(invrs_dztp2 + invrs_dztp1) & - +invrs_dzm*invrs_dztp1 ) - - ! Momentum super-super diagonal: [ x var_zm(k+2,) ] - lhs(kp2_mdiag) & - = +nu*invrs_dzm & - *invrs_dztp1*invrs_dzmp1*invrs_dztp2 - - elseif ( trim( boundary_cond ) == 'fixed-point' ) then - - ! Fixed-point boundary conditions - ! The left-hand side matrix contributions from level 1 are - ! over-written or set in the parent subroutine. - - ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] - lhs(km2_mdiag) & - = 0.0_core_rknd - - ! Momentum sub diagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) & - = 0.0_core_rknd - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) & - = 0.0_core_rknd - - ! Momentum super diagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) & - = 0.0_core_rknd - - ! Momentum super-super diagonal: [ x var_zm(k+2,) ] - lhs(kp2_mdiag) & - = 0.0_core_rknd - - endif - - - elseif ( level == 2 ) then - - ! Second-lowest level - - if ( trim( boundary_cond ) == 'zero-flux' ) then - - ! Zero-flux boundary conditions - - ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] - lhs(km2_mdiag) & - = 0.0_core_rknd - - ! Momentum sub diagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) & - = -nu*invrs_dzm & - *( invrs_dztp1*invrs_dzm*invrs_dzt & - +invrs_dzt*( invrs_dzm*invrs_dzt & - +invrs_dzmm1*invrs_dzt ) ) - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) & - = +nu*invrs_dzm & - *( invrs_dztp1*( invrs_dzmp1*invrs_dztp1 & - +invrs_dzm*(invrs_dztp1 + invrs_dzt) ) & - +invrs_dzt*( invrs_dzm*(invrs_dztp1 + invrs_dzt) & - +invrs_dzmm1*invrs_dzt ) ) - - ! Momentum super diagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) & - = -nu*invrs_dzm & - *( invrs_dztp1*( invrs_dzmp1*(invrs_dztp2 + invrs_dztp1) & - +invrs_dzm*invrs_dztp1 ) & - +invrs_dzt*invrs_dzm*invrs_dztp1 ) - - ! Momentum super-super diagonal: [ x var_zm(k+2,) ] - lhs(kp2_mdiag) & - = +nu*invrs_dzm & - *invrs_dztp1*invrs_dzmp1*invrs_dztp2 - - elseif ( trim( boundary_cond ) == 'fixed-point' ) then - - ! Fixed-point boundary conditions - - ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] - lhs(km2_mdiag) & - = 0.0_core_rknd - - ! Momentum sub diagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) & - = -nu*invrs_dzm & - *( invrs_dztp1*invrs_dzm*invrs_dzt & - +invrs_dzt*invrs_dzm*invrs_dzt ) - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) & - = +nu*invrs_dzm & - *( invrs_dztp1*( invrs_dzmp1*invrs_dztp1 & - +invrs_dzm*(invrs_dztp1 + invrs_dzt) ) & - +invrs_dzt*invrs_dzm*(invrs_dztp1 + invrs_dzt) ) - - ! Momentum super diagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) & - = -nu*invrs_dzm & - *( invrs_dztp1*( invrs_dzmp1*(invrs_dztp2 + invrs_dztp1) & - +invrs_dzm*invrs_dztp1 ) & - +invrs_dzt*invrs_dzm*invrs_dztp1 ) - - ! Momentum super-super diagonal: [ x var_zm(k+2,) ] - lhs(kp2_mdiag) & - = +nu*invrs_dzm & - *invrs_dztp1*invrs_dzmp1*invrs_dztp2 - - endif - - - elseif ( level > 2 .and. level < gr%nz-1 ) then - - ! k > 2 and k < num_levels-1 - ! These interior level are not effected by boundary conditions. - - ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] - lhs(km2_mdiag) & - = +nu*invrs_dzm & - *invrs_dzt*invrs_dzmm1*invrs_dztm1 - - ! Momentum sub diagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) & - = -nu*invrs_dzm & - *( invrs_dztp1*invrs_dzm*invrs_dzt & - +invrs_dzt*( invrs_dzm*invrs_dzt & - +invrs_dzmm1*(invrs_dzt + invrs_dztm1) ) ) - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) & - = +nu*invrs_dzm & - *( invrs_dztp1*( invrs_dzmp1*invrs_dztp1 & - +invrs_dzm*(invrs_dztp1 + invrs_dzt) ) & - +invrs_dzt*( invrs_dzm*(invrs_dztp1 + invrs_dzt) & - +invrs_dzmm1*invrs_dzt ) ) - - ! Momentum super diagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) & - = -nu*invrs_dzm & - *( invrs_dztp1*( invrs_dzmp1*(invrs_dztp2 + invrs_dztp1) & - +invrs_dzm*invrs_dztp1 ) & - +invrs_dzt*invrs_dzm*invrs_dztp1 ) - - ! Momentum super-super diagonal: [ x var_zm(k+2,) ] - lhs(kp2_mdiag) & - = +nu*invrs_dzm & - *invrs_dztp1*invrs_dzmp1*invrs_dztp2 - - - elseif ( level == gr%nz-1 ) then - - ! Second-highest level - - if ( trim( boundary_cond ) == 'zero-flux' ) then - - ! Zero-flux boundary conditions - - ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] - lhs(km2_mdiag) & - = +nu*invrs_dzm & - *invrs_dzt*invrs_dzmm1*invrs_dztm1 - - ! Momentum sub diagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) & - = -nu*invrs_dzm & - *( invrs_dztp1*invrs_dzm*invrs_dzt & - +invrs_dzt*( invrs_dzm*invrs_dzt & - +invrs_dzmm1*(invrs_dzt + invrs_dztm1) ) ) - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) & - = +nu*invrs_dzm & - *( invrs_dztp1*( invrs_dzmp1*invrs_dztp1 & - +invrs_dzm*(invrs_dztp1 + invrs_dzt) ) & - +invrs_dzt*( invrs_dzm*(invrs_dztp1 + invrs_dzt) & - +invrs_dzmm1*invrs_dzt ) ) - - ! Momentum super diagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) & - = -nu*invrs_dzm & - *( invrs_dztp1*( invrs_dzmp1*invrs_dztp1 & - +invrs_dzm*invrs_dztp1 ) & - +invrs_dzt*invrs_dzm*invrs_dztp1 ) - - ! Momentum super-super diagonal: [ x var_zm(k+2,) ] - lhs(kp2_mdiag) & - = 0.0_core_rknd - - elseif ( trim( boundary_cond ) == 'fixed-point' ) then - - ! Fixed-point boundary conditions - - ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] - lhs(km2_mdiag) & - = +nu*invrs_dzm & - *invrs_dzt*invrs_dzmm1*invrs_dztm1 - - ! Momentum sub diagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) & - = -nu*invrs_dzm & - *( invrs_dztp1*invrs_dzm*invrs_dzt & - +invrs_dzt*( invrs_dzm*invrs_dzt & - +invrs_dzmm1*(invrs_dzt + invrs_dztm1) ) ) - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) & - = +nu*invrs_dzm & - *( invrs_dztp1*( invrs_dzm*(invrs_dztp1 + invrs_dzt) ) & - +invrs_dzt*( invrs_dzm*(invrs_dztp1 + invrs_dzt) & - +invrs_dzmm1*invrs_dzt ) ) - - ! Momentum super diagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) & - = -nu*invrs_dzm & - *( invrs_dztp1*invrs_dzm*invrs_dztp1 & - +invrs_dzt*invrs_dzm*invrs_dztp1 ) - - ! Momentum super-super diagonal: [ x var_zm(k+2,) ] - lhs(kp2_mdiag) & - = 0.0_core_rknd - - endif - - - elseif ( level == gr%nz ) then - - ! Highest level - ! k = gr%nz; upper boundery level at model top. - ! Only relevant if zero-flux boundary conditions are used. - - if ( trim( boundary_cond ) == 'zero-flux' ) then - - ! Zero-flux boundary conditions - - ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] - lhs(km2_mdiag) & - = +nu*invrs_dzm & - *invrs_dzt*invrs_dzmm1*invrs_dztm1 - - ! Momentum sub diagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) & - = -nu*invrs_dzm & - *invrs_dzt*( invrs_dzm*invrs_dzt & - +invrs_dzmm1*(invrs_dzt + invrs_dztm1) ) - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) & - = +nu*invrs_dzm & - *invrs_dzt*(invrs_dzm*invrs_dzt + invrs_dzmm1*invrs_dzt) - - ! Momentum super diagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) & - = 0.0_core_rknd - - ! Momentum super-super diagonal: [ x var_zm(k+2,) ] - lhs(kp2_mdiag) & - = 0.0_core_rknd - - elseif ( trim( boundary_cond ) == 'fixed-point' ) then - - ! Fixed-point boundary conditions - ! The left-hand side matrix contributions from level gr%nz are - ! over-written or set in the parent subroutine. - - ! Momentum sub-sub diagonal: [ x var_zm(k-2,) ] - lhs(km2_mdiag) & - = 0.0_core_rknd - - ! Momentum sub diagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) & - = 0.0_core_rknd - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) & - = 0.0_core_rknd - - ! Momentum super diagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) & - = 0.0_core_rknd - - ! Momentum super-super diagonal: [ x var_zm(k+2,) ] - lhs(kp2_mdiag) & - = 0.0_core_rknd - - endif - - - endif - - - return - - end function hyper_dfsn_4th_ord_zm_lhs - -!=============================================================================== - -end module crmx_hyper_diffusion_4th_ord diff --git a/src/physics/spcam/crm/CLUBB/crmx_input_names.F90 b/src/physics/spcam/crm/CLUBB/crmx_input_names.F90 deleted file mode 100644 index d628d09b6f..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_input_names.F90 +++ /dev/null @@ -1,81 +0,0 @@ -!$Id: input_names.F90 5378 2011-08-22 20:19:16Z connork@uwm.edu $ -module crmx_input_names -! -! Description: This module contains all of the strings used to define the -! headers for input_reader.F90 compatable files. -! -!--------------------------------------------------------------------------------------------------- - implicit none - ! Column identifiers - character(len=*), public, parameter :: & - z_name = 'z[m]' - - character(len=*), public, parameter :: & - pressure_name = 'Press[Pa]', & - press_mb_name = "Press[mb]" - - character(len=*), public, parameter :: & - temperature_name = 'T[K]', & - theta_name = 'thm[K]', & - thetal_name = 'thlm[K]' - - character(len=*), public, parameter :: & - temperature_f_name = 'T_f[K\s]', & - thetal_f_name = 'thlm_f[K\s]', & - theta_f_name = 'thm_f[K\s]' - - character(len=*), public, parameter :: & - rt_name = 'rt[kg\kg]', & - sp_humidity_name = "sp_hmdty[kg\kg]" - - character(len=*), public, parameter :: & - rt_f_name = 'rtm_f[kg\kg\s]', & - sp_humidity_f_name = 'sp_hmdty_f[kg\kg\s]' - - character(len=*), public, parameter :: & - um_name = 'u[m\s]', & - vm_name = 'v[m\s]' - - character(len=*), public, parameter :: & - ug_name = 'ug[m\s]', & - vg_name = 'vg[m\s]' - - character(len=*), public, parameter :: & - um_ref_name = 'um_ref[m\s]', & - vm_ref_name = 'vm_ref[m\s]' - - character(len=*), public, parameter :: & - um_f_name = 'um_f[m\s^2]', & - vm_f_name = 'vm_f[m\s^2]' - - character(len=*), public, parameter :: & - wm_name = 'w[m\s]', & - omega_name = 'omega[Pa\s]', & - omega_mb_hr_name = 'omega[mb\hr]' - - character(len=*), public, parameter :: & - CO2_name = 'CO2[ppmv]', & - CO2_umol_name = 'CO2[umol\m^2\s]', & - ozone_name = "o3[kg\kg]" - - character(len=*), public, parameter :: & - time_name = 'Time[s]' - - character(len=*), public, parameter :: & - latent_ht_name = 'latent_ht[W\m^2]', & - sens_ht_name = 'sens_ht[W\m^2]' - - character(len=*), public, parameter :: & - upwp_sfc_name = 'upwp_sfc[(m\s)^2]', & - vpwp_sfc_name = 'vpwp_sfc[(m\s)^2]' - - character(len=*), public, parameter :: & - T_sfc_name = 'T_sfc[K]' - - character(len=*), public, parameter :: & - wpthlp_sfc_name = 'wpthlp_sfc[mK\s]', & - wpqtp_sfc_name = 'wpqtp_sfc[(kg\kg)m\s]' - - private ! Default Scope - -end module crmx_input_names diff --git a/src/physics/spcam/crm/CLUBB/crmx_input_reader.F90 b/src/physics/spcam/crm/CLUBB/crmx_input_reader.F90 deleted file mode 100644 index a516a90063..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_input_reader.F90 +++ /dev/null @@ -1,857 +0,0 @@ -!$Id: input_reader.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -module crmx_input_reader -! -! This module is respondsible for the procedures and structures necessary to -! read in "SAM-Like" case specific files. Currently only the -! _sounding.in file is formatted to be used by this module. -! -!--------------------------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - private - - public :: one_dim_read_var, & - read_one_dim_file, & - two_dim_read_var, & - read_two_dim_file, & - fill_blanks_one_dim_vars, & - fill_blanks_two_dim_vars, & - deallocate_one_dim_vars, & - deallocate_two_dim_vars, & - read_x_table, & - read_x_profile, & - get_target_index, & - count_columns - - ! Derived type for representing a rank 1 variable that has been read in by one - ! of the procedures. - type one_dim_read_var - - character(len=30) :: name ! Name of the variable - - character(len=30) :: dim_name ! Name of the dimension that the - ! variable varies along - - real( kind = core_rknd ), dimension(:), pointer :: values ! Values of that variable - - end type one_dim_read_var - - ! Derived type for representing a rank 2 variable that has been read in by one - ! of the procedures. - type two_dim_read_var - - character(len=30) :: name ! Name of the variable - - character(len=30) :: dim1_name ! Name of one of the dimensions - ! that the variable varies along - - character(len=30) :: dim2_name ! Name of the other variable that - ! the variable varies along - - real( kind = core_rknd ), dimension(:,:), pointer :: values ! Values of that variable - - end type two_dim_read_var - - - ! Constant Parameter(s) - real( kind = core_rknd ), parameter, private :: & - blank_value = -999.9_core_rknd ! Used to denote if a value is missing from the file - - contains - - !------------------------------------------------------------------------------------------------- - subroutine read_two_dim_file( iunit, nCol, filename, read_vars, other_dim ) - ! - ! Description: This subroutine reads from a file containing data that varies - ! in two dimensions. These are dimensions are typically height - ! and time. - ! - !----------------------------------------------------------------------------------------------- - use crmx_constants_clubb, only: & - fstderr ! Constant(s) - - use crmx_input_names, only: & - time_name ! Constant(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: trim, index - - ! Input Variable(s) - - integer, intent(in) :: iunit ! File I/O unit - - integer, intent(in) :: nCol ! Number of columns expected in the data file - - - character(len=*), intent(in) :: filename ! Name of the file being read from - - ! Output Variable(s) - type (two_dim_read_var), dimension(nCol),intent(out) :: read_vars ! Structured information - ! from the file - - type (one_dim_read_var), intent(out) :: other_dim ! Structured information - ! on the dimesion not stored in read_vars - - ! Local Variables - character(len=30),dimension(nCol) :: names ! Names of variables - - integer nRowI ! Inner row - - integer nRowO ! Outer row - - integer :: k, j, i - - logical :: isComment - - character(len=200) :: tmpline - - real( kind = core_rknd ), dimension(nCol) :: tmp - - integer :: input_status ! The status of a read statement - - ! ---- Begin Code ---- - - ! First run through, take names and determine how large the data file is. - open(unit=iunit, file=trim( filename ), status = 'old', action='read' ) - - isComment = .true. - - ! Skip all the comments at the top of the file - do while ( isComment ) - read(iunit,fmt='(A)') tmpline - k = index( tmpline, "!" ) - isComment = .false. - if ( k > 0 ) then - isComment = .true. - end if - end do - - ! Go back to the line that wasn't a comment. - backspace(iunit) - - read(iunit, fmt=*) names - - nRowO = 0 - do while(.true.) - read(iunit, *, iostat=input_status) tmp(1), nRowI - - ! If input_status shows an end of data, then exit the loop - if( input_status < 0 ) then - exit - else if ( input_status > 0 ) then - write(fstderr,*) "Error reading data from file: " //trim( filename ) - stop "Fatal error input_reader" - end if - - if( nRowI < 1 ) then - stop "Number of elements must be an integer and greater than zero in two-dim input file." - end if - - do k =1, nRowI - read(iunit, *) tmp - end do - nRowO = nRowO + 1 - end do - - do i=1, nRowO - - backspace(iunit) - - do j=1, nRowI - - backspace(iunit) - - end do - - end do - - backspace(iunit) - - ! Store the names into the structure and allocate accordingly - do k =1, nCol - read_vars(k)%name = names(k) - read_vars(k)%dim1_name = time_name - read_vars(k)%dim2_name = names(1) - - allocate( read_vars(k)%values(nRowI, nRowO) ) - end do - - other_dim%name = time_name - other_dim%dim_name = time_name - - allocate( other_dim%values(nRowO) ) - - ! Read in the data again to the newly allocated arrays - do k=1, nRowO - read(iunit,*) other_dim%values(k) - do j=1, nRowI - read(iunit,*) ( read_vars(i)%values(j,k), i=1, nCol) - end do - end do - - close(iunit) - - ! Eliminate a compiler warning - if ( .false. ) print *, tmp - - return - end subroutine read_two_dim_file - - !------------------------------------------------------------------------------------------------ - subroutine read_one_dim_file( iunit, nCol, filename, read_vars ) - ! - ! Description: - ! This subroutine reads from a file containing data that varies - ! in one dimension. The dimension is typically time. - ! - ! References: - ! None - !---------------------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - - intrinsic :: trim, index - - ! Input Variable(s) - - integer, intent(in) :: iunit ! I/O unit - - integer, intent(in) :: nCol ! Number of columns expected in the data file - - character(len=*), intent(in) :: filename ! Name of the file being read from - - ! Output Variable(s) - - type (one_dim_read_var), dimension(nCol),intent(out) :: & - read_vars ! Structured information from the file - - ! Local Variable(s) - character(len=30),dimension(nCol) :: names - - character(len=200) :: tmpline - - integer nRow - - integer :: k, j - - real( kind = core_rknd ), dimension(nCol) :: tmp - - logical :: isComment - - integer :: input_status ! The status of a read statement - - ! ---- Begin Code ---- - - isComment = .true. - - ! First run through, take names and determine how large the data file is. - open(unit=iunit, file=trim( filename ), status = 'old' ) - - ! Skip all the comments at the top of the file - do while(isComment) - read(iunit,fmt='(A)') tmpline - k = index( tmpline, "!" ) - isComment = .false. - if(k > 0) then - isComment = .true. - end if - end do - - ! Go back to the line that wasn't a comment. - backspace(iunit) - - read(iunit, fmt=*) names - - ! Count up the number of rows - nRow = 0 - do while(.true.) - read(iunit, *, iostat=input_status) tmp - - ! If input_status shows an end of file, exit the loop - if( input_status < 0 ) then - exit - end if - - nRow = nRow+1 - end do - - ! Rewind that many rows - do k = 0, nRow - backspace(iunit) - end do - - ! Store the names into the structure and allocate accordingly - do k = 1, nCol - read_vars(k)%name = names(k) - read_vars(k)%dim_name = names(1) - allocate( read_vars(k)%values(nRow) ) - end do - - ! Read in the data again to the newly allocated arrays - do k=1, nRow - read(iunit,*) ( read_vars(j)%values(k), j=1, nCol) - end do - - close(iunit) - - ! Avoiding compiler warning - if ( .false. ) print *, tmp - - return - - end subroutine read_one_dim_file - - !------------------------------------------------------------------------------------------------ - subroutine fill_blanks_one_dim_vars( num_vars, one_dim_vars ) - ! - ! Description: - ! This subroutine fills in the blank spots (signified by constant blank_value) - ! with values linearly interpolated using the first element of the array as a - ! guide. - ! - ! References: - ! None - !---------------------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: size - - ! Input Variable(s) - integer, intent(in) :: num_vars ! Number of elements in one_dim_vars - - ! Input/Output Variable(s) - type(one_dim_read_var), dimension(num_vars), intent(inout) :: & - one_dim_vars ! Read data that may have gaps. - - ! Local variable(s) - integer :: i - - ! ---- Begin Code ---- - - do i=1, num_vars - one_dim_vars(i)%values = linear_fill_blanks( size( one_dim_vars(i)%values ), & - one_dim_vars(1)%values, one_dim_vars(i)%values, & - 0.0_core_rknd ) - end do - - return - - end subroutine fill_blanks_one_dim_vars - - !------------------------------------------------------------------------------------------------ - subroutine fill_blanks_two_dim_vars( num_vars, other_dim, two_dim_vars ) - ! - ! Description: - ! This subroutine fills in the blank spots (signified by the - ! constant blank_value with values linearly interpolated using the first - ! element of the array and the values in the other_dim argument as a guide. - ! - ! This is a two step process. First we assume that the other_dim values - ! have no holes, but there are blanks for that variable across that - ! dimension. Then we fill holes across the dimension whose values are first - ! in the array of two_dim_vars. - ! - ! Ex. Time is the 'other_dim' and Height in meters is the first element in - ! two_dim_vars. - ! - ! References: - ! None - !---------------------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: size - - ! Input Variable(s) - integer, intent(in) :: num_vars ! Number of elements in one_dim_vars - - ! Input/Output Variable(s) - type(one_dim_read_var), intent(in) :: other_dim ! Read data - - type(two_dim_read_var), dimension(num_vars), intent(inout) :: & - two_dim_vars ! Read data that may have gaps. - - ! Local variables - integer :: i,j ! Loop iterators - - integer :: & - dim_size, & ! 1st dimension size - other_dim_size ! 2nd dimension size - - ! ---- Begin Code ---- - - dim_size = size( two_dim_vars(1)%values, 1 ) - - other_dim_size = size( other_dim%values ) - - do i=2, num_vars - ! Interpolate along main dim - do j=1, other_dim_size - two_dim_vars(i)%values(:,j) = linear_fill_blanks( dim_size, & - two_dim_vars(1)%values(:,j), & - two_dim_vars(i)%values(:,j), blank_value ) - end do ! j = 1 .. other_dim_size - - ! Interpolate along other dim - do j=1, dim_size - two_dim_vars(i)%values(j,:) = linear_fill_blanks( other_dim_size, & - other_dim%values, & - two_dim_vars(i)%values(j,:), blank_value ) - end do ! j = 1 .. dim_size - - end do ! i = 2 .. num_vars - - return - - end subroutine fill_blanks_two_dim_vars - - - !------------------------------------------------------------------------------------------------ - function linear_fill_blanks( dim_grid, grid, var, default_value ) & - ! - ! Description: - ! This function fills blanks in array var using the grid - ! as a guide. Blank values in var are signified by being - ! less than or equal to the constant blank_value. - ! - ! References: - ! None - !----------------------------------------------------------------------------------------------- - result( var_out ) - - use crmx_interpolation, only: zlinterp_fnc - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variable(s) - integer, intent(in) :: dim_grid ! Size of grid - - real( kind = core_rknd ), dimension(dim_grid), intent(in) :: & - grid ! Array that var is being interpolated to. - - real( kind = core_rknd ), dimension(dim_grid), intent(in) :: & - var ! Array that may contain gaps. - - real( kind = core_rknd ), intent(in) :: & - default_value ! Default value if entire profile == blank_value - - ! Output Variable(s) - real( kind = core_rknd ), dimension(dim_grid) :: & - var_out ! Return variable - - ! Local Variables - real( kind = core_rknd ), dimension(dim_grid) :: temp_grid - real( kind = core_rknd ), dimension(dim_grid) :: temp_var - - integer :: i - integer :: amt - - logical :: reversed - - ! ---- Begin Code ---- - - reversed = .false. - - ! Essentially this code leverages the previously written zlinterp function. - ! A smaller temporary grid and var variable are being created to pass to - ! zlinterp. zlinterp then performs the work of taking the temporary var - ! array and interpolating it to the actual grid array. - - amt = 0 - do i=1, dim_grid - if ( var(i) > blank_value ) then - amt = amt + 1 - temp_var(amt) = var(i) - temp_grid(amt) = grid(i) - end if - if ( i > 1 ) then - if ( grid(i) < grid(i-1) ) then - reversed = .true. - end if - end if - end do - - - if ( amt == 0 ) then - var_out = default_value - else if (amt < dim_grid) then - if ( reversed ) then - var_out = zlinterp_fnc( dim_grid, amt, -grid, -temp_grid(1:amt), temp_var(1:amt) ) - else - var_out = zlinterp_fnc( dim_grid, amt, grid, temp_grid(1:amt), temp_var(1:amt) ) - end if - else - var_out = var - end if - - return - end function linear_fill_blanks - !---------------------------------------------------------------------------- - subroutine deallocate_one_dim_vars( num_vars, one_dim_vars ) - ! - ! Description: - ! This subroutine deallocates the pointer stored in - ! one_dim_vars%value for the whole array. - ! - !------------------------------------------------------------------------------ - implicit none - - ! External functions - intrinsic :: associated - - ! Input Variable(s) - integer, intent(in) :: num_vars ! Number of elements in one_dim_vars - - type(one_dim_read_var), dimension(num_vars), intent(inout) :: & - one_dim_vars ! Read data that may have gaps. - - ! Local Variable(s) - integer :: i - - ! Begin Code - - do i=1, num_vars - - if ( associated( one_dim_vars(i)%values ) ) then - - deallocate( one_dim_vars(i)%values ) - - end if - - end do ! 1 .. num_vars - - return - end subroutine deallocate_one_dim_vars - - !------------------------------------------------------------------------------------------------ - subroutine deallocate_two_dim_vars( num_vars, two_dim_vars, other_dim ) - ! - ! Description: - ! This subroutine deallocates the pointer stored in - ! two_dim_vars%value for the whole array - ! - ! References: - ! None - !---------------------------------------------------------------------------------------------- - implicit none - - ! External Functions - intrinsic :: associated - - ! Input Variable(s) - integer, intent(in) :: num_vars ! Number of elements in one_dim_vars - - ! Input/Output Variables - type(one_dim_read_var), intent(inout) :: other_dim - - type(two_dim_read_var), dimension(num_vars), intent(inout) :: & - two_dim_vars ! Read data that may have gaps. - - ! Local Variable(s) - integer :: i - - ! ---- Begin Code ---- - - do i=1, num_vars - - if ( associated( two_dim_vars(i)%values ) ) then - - deallocate(two_dim_vars(i)%values) - - end if - - end do - - if ( associated( other_dim%values ) ) then - - deallocate(other_dim%values) - - end if - - return - end subroutine deallocate_two_dim_vars - !------------------------------------------------------------------------------------------------ - function read_x_table( nvar, xdim, ydim, target_name, retVars ) result( x ) - ! - ! Description: - ! Searches for the variable specified by target_name in the - ! collection of retVars. If the function finds the variable then it returns - ! it. If it does not the program using this function will exit gracefully - ! with a warning message. - ! - ! References: - ! None - !----------------------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_constants_clubb, only: & - fstderr ! Constant(s) - - implicit none - - ! Input Variable(s) - integer, intent(in) :: nvar ! Number of variables in retVars - - integer, intent(in) :: xdim, ydim - - character(len=*), intent(in) :: & - target_name ! Name of the variable that is being searched for - - type(two_dim_read_var), dimension(nvar), intent(in) :: & - retVars ! Collection of data being searched through - - ! Output Variable(s) - real( kind = core_rknd ), dimension( xdim, ydim ) :: x - - ! Local Variables - integer :: i ! Loop iterator - - logical :: l_found - - ! ---- Begin Code ---- - - l_found = .false. - - i = 1 - - do while( i <= nvar .and. .not. l_found) - - if( retVars(i)%name == target_name ) then - - l_found = .true. - - x = retVars(i)%values - - end if - - i=i+1 - - end do ! i <= nvar .and. not l_found - - if ( .not. l_found ) then - - write(fstderr,*) trim( target_name )//" could not be found." - - stop "Fatal error in function read_x_table" - - end if - - return - - end function read_x_table - - - !------------------------------------------------------------------------------------------------ - function read_x_profile( nvar, dim_size, target_name, retVars, & - input_file ) result( x ) - ! - ! Description: - ! Searches for the variable specified by target_name in the - ! collection of retVars. If the function finds the variable then it returns - ! it. If it does not the program using this function will exit gracefully - ! with a warning message. - ! - ! Modified by Cavyn, June 2010 - !---------------------------------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Variable for writing to error stream - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External Functions - intrinsic :: present, size - - ! Input Variable(s) - integer, intent(in) :: & - nvar, & ! Number of variables in retVars - dim_size ! Size of the array returned - - character(len=*), intent(in) :: & - target_name ! Name of the variable that is being searched for - - type(one_dim_read_var), dimension(nvar), intent(in) :: & - retVars ! Collection being searched - - character(len=*), optional, intent(in) :: & - input_file ! Name of the input file containing the variables - - ! Output Variable(s) - real( kind = core_rknd ), dimension(dim_size) :: x - - ! Local Variables - integer :: i - - ! ---- Begin Code ---- - - i = get_target_index( nvar, target_name, retVars ) - - if ( i > 0 ) then - x(1:size(retVars(i)%values)) = retVars(i)%values - - else - if( present( input_file ) ) then - write(fstderr,*) trim( target_name ), ' could not be found. Check the file ', input_file - else - write(fstderr,*) trim( target_name ), ' could not be found. Check your sounding.in file.' - end if ! present( input_file ) - stop "Fatal error in read_x_profile" - - end if ! target_exists_in_array - - return - - end function read_x_profile - - !------------------------------------------------------------------------------ - function get_target_index( nvar, target_name, retVars) result( i ) - ! - ! Description: - ! Returns the index of the variable specified by target_name in the - ! collection of retVars. Returns -1 if variable does not exist in retVars - ! - ! References: - ! None - ! - ! Created by Cavyn, July 2010 - !---------------------------------------------------------------------------------------------- - - implicit none - - ! Input Variable(s) - integer, intent(in) :: nvar ! Number of variables in retVars - character(len=*), intent(in) :: target_name ! Variable being searched for - type(one_dim_read_var), dimension(nvar), intent(in) :: retVars ! Collection being searched - - ! Output Variable - integer :: i - - ! Local Variable(s) - logical :: l_found - - !----------------BEGIN CODE------------------ - - l_found = .false. - - i = 0 - do while ( i < nvar .and. .not. l_found ) - i = i+1 - if( retVars(i)%name == target_name ) then - l_found = .true. - end if - end do - - if( .not. l_found ) then - i = -1 - end if - - return - - end function get_target_index - - !============================================================================= - function count_columns( iunit, filename ) result( nCols ) - ! Description: - ! This function counts the number of columns in a file, assuming that the - ! first line of the file contains only column headers. (Comments are OK) - - ! References: - ! None - - ! Created by Cavyn, July 2010 - !----------------------------------------------------------------------------- - - implicit none - - ! Input Variables - integer, intent(in) :: iunit ! I/O unit - character(len=*), intent(in) :: filename ! Name of the file being read from - - ! Output Variable - integer :: nCols ! The number of data columns in the selected file - - ! Local Variables - integer :: i, k ! Loop Counter - character(len=200) :: tmp ! Temporary char buffer - character(len=200), dimension(50) :: colArray ! Max of 50 columns - logical :: isComment - integer :: status_var ! IO status for read statement - - - ! -------------------------BEGIN CODE------------------------------------- - - isComment = .true. - - open(unit=iunit, file=trim(filename), status = 'old' ) - - ! Skip all the comments at the top of the file - do while(isComment) - read(iunit,fmt='(A)') tmp - k = index(tmp, "!") - isComment = .false. - if(k > 0) then - isComment = .true. - end if - end do - - ! Go back to the line that wasn't a comment. - backspace(iunit) - - ! Count the number of columns - nCols = 0 - colArray = "" - read(iunit,fmt='(A)',iostat=status_var) tmp - ! Only continue if there was no IO error or end of data - if( status_var == 0 ) then - ! Move all words into an array - read(tmp,*,iostat=status_var) (colArray(i), i=1,size( colArray )) - - else if ( status_var > 0 ) then - ! Handle the case where we have an error before the EOF marker is found - stop "Fatal error reading data in time_dependent_input function count_columns" - - end if - - do i=1,size(colArray) - if( colArray(i) /= "" ) then ! Increment number of columns until array is blank - nCols = nCols+1 - end if - end do - - close(iunit) - - end function count_columns - -!------------------------------------------------------------------------------ -end module crmx_input_reader diff --git a/src/physics/spcam/crm/CLUBB/crmx_interpolation.F90 b/src/physics/spcam/crm/CLUBB/crmx_interpolation.F90 deleted file mode 100644 index 7a69a4e9f6..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_interpolation.F90 +++ /dev/null @@ -1,620 +0,0 @@ -!------------------------------------------------------------------------------- -!$Id: interpolation.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -module crmx_interpolation - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - private ! Default Scope - - public :: lin_int, binary_search, zlinterp_fnc, & - linear_interpolation, linear_interp_factor, mono_cubic_interp, plinterp_fnc - - contains - -!------------------------------------------------------------------------------- - pure function lin_int( height_int, height_high, height_low, & - var_high, var_low ) - -! Description: -! This function computes a linear interpolation of the value of variable. -! Given two known values of a variable at two height values, the value -! of that variable at a height between those two height levels (rather -! than a height outside of those two height levels) is computed. -! -! Here is a diagram: -! -! ################################ Height high, know variable value -! -! -! -! -------------------------------- Height to be interpolated to; linear interpolation -! -! -! -! -! -! ################################ Height low, know variable value -! -! -! FORMULA: -! -! variable(@ Height interpolation) = -! -! [ (variable(@ Height high) - variable(@ Height low)) / (Height high - Height low) ] -! * (Height interpolation - Height low) + variable(@ Height low) - -! Comments from WRF-HOC, Brian Griffin. - -! References: -! None -!------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - - real( kind = core_rknd ), intent(in) :: & - height_int, & ! Height to be interpolated to [m] - height_high, & ! Height above the interpolation [m] - height_low, & ! Height below the interpolation [m] - var_high, & ! Variable above the interpolation [units vary] - var_low ! Variable below the interpolation [units vary] - - ! Output Variables - real( kind = core_rknd ) :: lin_int - - ! Compute linear interpolation - - lin_int = ( ( height_int - height_low )/( height_high - height_low ) ) & - * ( var_high - var_low ) + var_low - - return - end function lin_int - - !------------------------------------------------------------------------------------------------- - elemental real( kind = core_rknd ) function linear_interp_factor( factor, var_high, var_low ) - ! Description: - ! Determines the coefficient for a linear interpolation - ! - ! References: - ! None - !------------------------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - real( kind = core_rknd ), intent(in) :: & - factor, & ! Factor [units vary] - var_high, & ! Variable above the interpolation [units vary] - var_low ! Variable below the interpolation [units vary] - - linear_interp_factor = factor * ( var_high - var_low ) + var_low - - return - end function linear_interp_factor - !------------------------------------------------------------------------------------------------- - pure function mono_cubic_interp & - ( z_in, km1, k00, kp1, kp2, zm1, z00, zp1, zp2, fm1, f00, fp1, fp2 ) result ( f_out ) - - ! Description: - ! Steffen's monotone cubic interpolation method - ! Returns monotone cubic interpolated value between x00 and xp1 - - ! Original Author: - ! Takanobu Yamaguchi - ! tak.yamaguchi@noaa.gov - ! - ! This version has been modified slightly for CLUBB's coding standards and - ! adds the 3/2 from eqn 21. -dschanen 26 Oct 2011 - ! We have also added a quintic polynomial option. - ! - ! References: - ! M. Steffen, Astron. Astrophys. 239, 443-450 (1990) - !------------------------------------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - three_halves, & ! Constant(s) - eps - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_model_flags, only: & - l_quintic_poly_interp ! Variable(s) - - implicit none - - ! Constant Parameters - logical, parameter :: & - l_equation_21 = .true. - - ! External - intrinsic :: sign, abs, min - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - z_in ! The altitude to be interpolated to [m] - - ! k-levels; their meaning depends on whether we're extrapolating or interpolating - integer, intent(in) :: & - km1, k00, kp1, kp2 - - real( kind = core_rknd ), intent(in) :: & - zm1, z00, zp1, zp2, & ! The altitudes for km1, k00, kp1, kp2 [m] - fm1, f00, fp1, fp2 ! The field at km1, k00, kp1, and kp2 [units vary] - - ! Output Variables - real( kind = core_rknd ) :: f_out ! The interpolated field - - ! Local Variables - real( kind = core_rknd ) :: & - hm1, h00, hp1, & - sm1, s00, sp1, & - p00, pp1, & - dfdx00, dfdxp1, & - c1, c2, c3, c4, & - w00, wp1, & - coef1, coef2, & - zprime, beta, alpha, zn - - ! ---- Begin Code ---- - - if ( l_equation_21 ) then - ! Use the formula from Steffen (1990), which should make the interpolation - ! less restrictive - coef1 = three_halves - coef2 = 1.0_core_rknd/three_halves - else - coef1 = 1.0_core_rknd - coef2 = 1.0_core_rknd - end if - - if ( km1 <= k00 ) then - hm1 = z00 - zm1 - h00 = zp1 - z00 - hp1 = zp2 - zp1 - - if ( km1 == k00 ) then - s00 = ( fp1 - f00 ) / ( zp1 - z00 ) - sp1 = ( fp2 - fp1 ) / ( zp2 - zp1 ) - dfdx00 = s00 - pp1 = ( s00 * hp1 + sp1 * h00 ) / ( h00 + hp1 ) - dfdxp1 = coef1*( sign( 1.0_core_rknd, s00 ) + sign( 1.0_core_rknd, sp1 ) ) & - * min( abs( s00 ), abs( sp1 ), coef2*0.5_core_rknd*abs( pp1 ) ) - - else if ( kp1 == kp2 ) then - sm1 = ( f00 - fm1 ) / ( z00 - zm1 ) - s00 = ( fp1 - f00 ) / ( zp1 - z00 ) - p00 = ( sm1 * h00 + s00 * hm1 ) / ( hm1 + h00 ) - dfdx00 = coef1*( sign( 1.0_core_rknd, sm1 ) + sign( 1.0_core_rknd, s00 ) ) & - * min( abs( sm1 ), abs( s00 ), coef2*0.5_core_rknd*abs( p00 ) ) - dfdxp1 = s00 - - else - sm1 = ( f00 - fm1 ) / ( z00 - zm1 ) - s00 = ( fp1 - f00 ) / ( zp1 - z00 ) - sp1 = ( fp2 - fp1 ) / ( zp2 - zp1 ) - p00 = ( sm1 * h00 + s00 * hm1 ) / ( hm1 + h00 ) - pp1 = ( s00 * hp1 + sp1 * h00 ) / ( h00 + hp1 ) - dfdx00 = coef1*( sign( 1.0_core_rknd, sm1 ) + sign( 1.0_core_rknd, s00 ) ) & - * min( abs( sm1 ), abs( s00 ), coef2*0.5_core_rknd*abs( p00 ) ) - dfdxp1 = coef1*( sign( 1.0_core_rknd, s00 ) + sign( 1.0_core_rknd, sp1 ) ) & - * min( abs( s00 ), abs( sp1 ), coef2*0.5_core_rknd*abs( pp1 ) ) - - end if - - c1 = ( dfdx00 + dfdxp1 - 2._core_rknd * s00 ) / ( h00 ** 2 ) - c2 = ( 3._core_rknd * s00 - 2._core_rknd * dfdx00 - dfdxp1 ) / h00 - c3 = dfdx00 - c4 = f00 - - if ( .not. l_quintic_poly_interp ) then - - ! Old formula - !f_out = c1 * ( (z_in - z00)**3 ) + c2 * ( (z_in - z00)**2 ) + c3 * (z_in - z00) + c4 - - ! Faster nested multiplication - zprime = z_in - z00 - f_out = c4 + zprime*( c3 + zprime*( c2 + ( zprime*c1 ) ) ) - - else - - ! Use a quintic polynomial interpolation instead instead of the Steffen formula. - ! Unlike the formula above, this formula does not guarantee monotonicity. - - beta = 120._core_rknd * ( (fp1-f00) - 0.5_core_rknd * h00 * (dfdx00 + dfdxp1) ) - - ! Prevent an underflow by using a linear interpolation - if ( abs( beta ) < eps ) then - f_out = lin_int( z00, zp1, zm1, & - fp1, fm1 ) - - else - alpha = (6._core_rknd/beta) * h00 * (dfdxp1-dfdx00) + 0.5_core_rknd - zn = (z_in-z00)/h00 - - f_out = ( & - (( (beta/20._core_rknd)*zn - (beta*(1._core_rknd+alpha) & - / 12._core_rknd)) * zn + (beta*alpha/6._core_rknd)) & - * zn**2 + dfdx00*h00 & - ) * zn + f00 - end if ! beta < eps - end if ! ~quintic_polynomial - - else - ! Linear extrapolation - wp1 = ( z_in - z00 ) / ( zp1 - z00 ) - w00 = 1._core_rknd - wp1 - f_out = wp1 * fp1 + w00 * f00 - - end if - - return - end function mono_cubic_interp - -!------------------------------------------------------------------------------- - pure integer function binary_search( n, array, var ) & - result( i ) - - ! Description: - ! This subroutine performs a binary search to find the closest value greater - ! than or equal to var in the array. This function returns the index of the - ! closest value of array that is greater than or equal to var. It returns a - ! value of -1 if var is outside the bounds of array. - ! - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - - ! Size of the array - integer, intent(in) :: n - - ! The array being searched (must be sorted from least value to greatest - ! value). - real( kind = core_rknd ), dimension(n), intent(in) :: array - - ! The value being searched for - real( kind = core_rknd ), intent(in) :: var - - ! Local Variables - - ! Has an index been found? - logical :: l_found - - ! Bounds of the search - integer :: high - integer :: low - - ! Initialize local variables - - l_found = .false. - - ! The initial value of low has been changed from 1 to 2 due to a problem - ! that was occuring when var was close to the lower bound. - ! - ! The lowest value in the array (which is sorted by increasing values) is - ! found at index 1, while the highest value in the array is found at - ! index n. Unless the value of var exactly corresponds with one of the - ! values found in the array, or unless the value of var is found outside of - ! the array, the value of var will be found between two levels of the array. - ! In this scenario, the output of function binary_search is the index of the - ! HIGHER level. For example, if the value of var is found between array(1) - ! and array(2), the output of function binary_search will be 2. - ! - ! Therefore, the lowest index of a HIGHER level in an interpolation is 2. - ! Thus, the initial value of low has been changed to 2. This will prevent - ! the value of variable "i" below from becoming 1. If the value of "i" - ! becomes 1, the code below tries to access array(0) (which is array(i-1) - ! when i = 1) and produces an error. - - low = 2 - - high = n - - ! This line is here to avoid a false compiler warning about "i" being used - ! uninitialized in this function. - i = (low + high) / 2 - - do while( .not. l_found .and. low <= high ) - - i = (low + high) / 2 - - if ( var > array( i - 1 ) .and. var <= array( i ) ) then - - l_found = .true. - - elseif ( var == array(1) ) then - - ! Special case where var falls exactly on the lowest value in the - ! array, which is array(1). This case is not covered by the statement - ! above. - l_found = .true. - ! The value of "i" must be set to 2 because an interpolation is - ! performed in the subroutine that calls this function that uses - ! indices "i" and "i-1". - i = 2 - - elseif ( var < array( i ) ) then - - high = i - 1 - - elseif ( var > array( i ) ) then - - low = i + 1 - - endif - - enddo ! while ( ~l_found & low <= high ) - - if ( .not. l_found ) i = -1 - - return - - end function binary_search - -!------------------------------------------------------------------------------- - function plinterp_fnc( dim_out, dim_src, grid_out, & - grid_src, var_src ) & - result( var_out ) -! Description: -! Do a linear interpolation in the vertical with pressures. Assumes -! values that are less than lowest source point are zero and above the -! highest source point are zero. Also assumes altitude increases linearly. -! This function just calls zlinterp_fnc, but negates grid_out and grid_src. - -! References: -! function LIN_INT from WRF-HOC -!----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input variables - integer, intent(in) :: dim_out, dim_src - - real( kind = core_rknd ), dimension(dim_src), intent(in) :: & - grid_src, & ! [m] - var_src ! [units vary] - - real( kind = core_rknd ), dimension(dim_out), intent(in) :: & - grid_out ! [m] - - ! Output variable - real( kind = core_rknd ), dimension(dim_out) :: & - var_out ! [units vary] - - ! ---- Begin Code ---- - - var_out = zlinterp_fnc( dim_out, dim_src, -grid_out, & - -grid_src, var_src ) - - return - end function plinterp_fnc -!------------------------------------------------------------------------------- - function zlinterp_fnc( dim_out, dim_src, grid_out, & - grid_src, var_src ) & - result( var_out ) -! Description: -! Do a linear interpolation in the vertical. Assumes values that -! are less than lowest source point are zero and above the highest -! source point are zero. Also assumes altitude increases linearly. - -! References: -! function LIN_INT from WRF-HOC -!----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input variables - integer, intent(in) :: dim_out, dim_src - - real( kind = core_rknd ), dimension(dim_src), intent(in) :: & - grid_src, & ! [m] - var_src ! [units vary] - - real( kind = core_rknd ), dimension(dim_out), intent(in) :: & - grid_out ! [m] - - ! Output variable - real( kind = core_rknd ), dimension(dim_out) :: & - var_out ! [units vary] - - ! Local variables - integer :: k, kint, km1 - -! integer :: tst, kp1 - - ! ---- Begin Code ---- - - k = 1 - - do kint = 1, dim_out, 1 - - ! Set to 0 if we're below the input data's lowest point - if ( grid_out(kint) < grid_src(1) ) then - var_out(kint) = 0.0_core_rknd - cycle - end if - - ! Increment k until the level is correct -! do while ( grid_out(kint) > grid_src(k) -! . .and. k < dim_src ) -! k = k + 1 -! end do - - ! Changed so a binary search is used instead of a sequential search -! tst = binary_search(dim_src, grid_src, grid_out(kint)) - k = binary_search(dim_src, grid_src, grid_out(kint)) - ! Joshua Fasching April 2008 - -! print *, "k = ", k -! print *, "tst = ", tst -! print *, "dim_src = ", dim_src -! print *,"------------------------------" - - ! If the increment leads to a level above the data, set this - ! point and all those above it to zero - !if( k > dim_src ) then - if ( k == -1 ) then - var_out(kint:dim_out) = 0.0_core_rknd - exit - end if - - km1 = max( 1, k-1 ) - !kp1 = min( k+1, dim_src ) - - ! Interpolate - var_out(kint) = lin_int( grid_out(kint), grid_src(k), & - grid_src(km1), var_src(k), var_src(km1) ) - -! ( var_src(k) - var_src(km1) ) / & -! ( grid_src(k) - grid_src(km1) ) & -! * ( grid_out(kint) - grid_src(km1) ) + var_src(km1) & -! Changed to use a standard function for interpolation - - !! Note this ends up changing the results slightly because - !the placement of variables has been changed. - -! Joshua Fasching April 2008 - - end do ! kint = 1..dim_out - - return - end function zlinterp_fnc - -!------------------------------------------------------------------------------- - subroutine linear_interpolation & - ( nparam, xlist, tlist, xvalue, tvalue ) - -! Description: -! Linear interpolation for 25 June 1996 altocumulus case. - -! For example, to interpolate between two temperatures in space, put -! your spatial coordinates in x-list and your temperature values in -! tlist. The point in question should have its spatial value stored -! in xvalue, and tvalue will be the temperature at that point. - -! Author: Michael Falk for COAMPS. -!------------------------------------------------------------------------------- - - use crmx_error_code, only: clubb_debug ! Procedure - - use crmx_constants_clubb, only: fstderr ! Constant - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - integer, intent(in) :: nparam ! Number of parameters in xlist and tlist - - ! Input/Output Variables - real( kind = core_rknd ), intent(inout), dimension(nparam) :: & - xlist, & ! List of x-values (independent variable) - tlist ! List of t-values (dependent variable) - - real( kind = core_rknd ), intent(in) :: & - xvalue ! x-value at which to interpolate - - real( kind = core_rknd ), intent(inout) :: & - tvalue ! t-value solved by interpolation - - ! Local variables - integer :: & - i, & ! Loop control variable for bubble sort- number of the - ! lowest yet-unsorted data point. - j ! Loop control variable for bubble sort- index of value - ! currently being tested - integer :: & - bottombound, & ! Index of the smaller value in the linear interpolation - topbound, & ! Index of the larger value in the linear interpolation - smallest ! Index of the present smallest value, for bubble sort - - real( kind = core_rknd ) :: temp ! A temporary variable used for the bubble sort swap - -!------------------------------------------------------------------------------- -! -! Bubble Sort algorithm, assuring that the elements are in order so -! that the interpolation is between the two closest points to the -! point in question. -! -!------------------------------------------------------------------------------- - - do i=1,nparam - smallest = i - do j=i,nparam - if ( xlist(j) < xlist(smallest) ) then - smallest = j - end if - end do - - temp = xlist(i) - xlist(i) = xlist(smallest) - xlist(smallest) = temp - - temp = tlist(i) - tlist(i) = tlist(smallest) - tlist(smallest) = temp - end do - -!------------------------------------------------------------------------------- -! -! If the point in question is larger than the largest x-value or -! smaller than the smallest x-value, crash. -! -!------------------------------------------------------------------------------- - - if ( (xvalue < xlist(1)) .or. (xvalue > xlist(nparam)) ) then - write(fstderr,*) "linear_interpolation: Value out of range" - stop - end if - -!------------------------------------------------------------------------------- -! -! Find the correct top and bottom bounds, do the interpolation, return c -! the value. -! -!------------------------------------------------------------------------------- - - topbound = -1 - bottombound = -1 - - do i=2,nparam - if ( (xvalue >= xlist(i-1)) .and. (xvalue <= xlist(i)) ) then - bottombound = i-1 - topbound = i - end if - end do - - if ( topbound == -1 .or. bottombound == -1 ) then - call clubb_debug( 1, "Sanity check failed! xlist is not properly sorted" ) - call clubb_debug( 1, "in linear_interpolation.") - end if - - tvalue = & - lin_int( xvalue, xlist(topbound), xlist(bottombound), & - tlist(topbound), tlist(bottombound) ) - - return - end subroutine linear_interpolation - -end module crmx_interpolation diff --git a/src/physics/spcam/crm/CLUBB/crmx_lapack_wrap.F90 b/src/physics/spcam/crm/CLUBB/crmx_lapack_wrap.F90 deleted file mode 100644 index c70a7876a0..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_lapack_wrap.F90 +++ /dev/null @@ -1,740 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: lapack_wrap.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -module crmx_lapack_wrap - -! Description: -! Wrappers for the band diagonal and tridiagonal direct matrix -! solvers contained in the LAPACK library. - -! References: -! LAPACK--Linear Algebra PACKage -! URL: -!----------------------------------------------------------------------- - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - use crmx_error_code, only: & - clubb_singular_matrix, & ! Variable(s) - clubb_bad_lapack_arg, & - clubb_var_equals_NaN, & - clubb_no_error - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Simple routines - public :: tridag_solve, band_solve - - ! Expert routines - public :: tridag_solvex, band_solvex - - private :: lapack_isnan - - ! A best guess for what the precision of a single precision and double - ! precision float is in LAPACK. Hopefully this will work more portably on - ! architectures like Itanium than the old code -dschanen 11 Aug 2011 - integer, parameter, private :: & - sp = selected_real_kind( precision( 0.0_core_rknd ) ), & - dp = selected_real_kind( precision( 0.d0 ) ) - - private ! Set Default Scope - - contains - -!----------------------------------------------------------------------- - subroutine tridag_solvex( solve_type, ndim, nrhs, & - supd, diag, subd, rhs, & - solution, rcond, err_code ) - -! Description: -! Solves a tridiagonal system of equations (expert routine). - -! References: -! -! - -! Notes: -! More expensive than the simple routine, but tridiagonal -! decomposition is still relatively cheap. -!----------------------------------------------------------------------- - use crmx_error_code, only: & - clubb_at_least_debug_level ! Logical function - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - external :: & - sgtsvx, & ! Single-prec. General Tridiagonal Solver eXpert - dgtsvx ! Double-prec. General Tridiagonal Solver eXpert - - intrinsic :: kind - - ! Input variables - character(len=*), intent(in) :: & - solve_type ! Used to write a message if this fails - - integer, intent(in) :: & - ndim, & ! N-dimension of matrix - nrhs ! # of right hand sides to back subst. after LU-decomp. - - ! Input/Output variables - real( kind = core_rknd ), intent(inout), dimension(ndim) :: & - diag, & ! Main diagonal - subd, supd ! Sub and super diagonal - - real( kind = core_rknd ), intent(inout), dimension(ndim,nrhs) :: & - rhs ! RHS input - - ! The estimate of the reciprocal of the condition number on the LHS matrix. - ! If rcond is < machine precision the matrix is singular to working - ! precision, and info == ndim+1. If rcond == 0, then the LHS matrix - ! is singular. This condition is indicated by a return code of info > 0. - real( kind = core_rknd ), intent(out) :: rcond - - integer, intent(out) :: & - err_code ! Used to determine when a decomp. failed - - ! Output variables - real( kind = core_rknd ), intent(out), dimension(ndim,nrhs) :: & - solution ! Solution - - ! Local Variables - ! These contain the decomposition of the matrix - real( kind = core_rknd ), dimension(ndim-1) :: dlf, duf - real( kind = core_rknd ), dimension(ndim) :: df - real( kind = core_rknd ), dimension(ndim-2) :: du2 - - integer, dimension(ndim) :: & - ipivot ! Index of pivots done during decomposition - - integer, dimension(ndim) :: & - iwork ! `scrap' array - - - real( kind = core_rknd ), dimension(nrhs) :: & - ferr, & ! Forward error estimate - berr ! Backward error estimate - - real( kind = core_rknd ), dimension(3*ndim) :: & - work ! `Scrap' array - - integer :: info ! Diagnostic output - - integer :: i ! Array index - -!----------------------------------------------------------------------- -! *** The LAPACK Routine *** -! SUBROUTINE SGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, -! $ DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, -! $ WORK, IWORK, INFO ) -!----------------------------------------------------------------------- - - if ( kind( diag(1) ) == dp ) then - call dgtsvx( "Not Factored", "No Transpose lhs", ndim, nrhs, & - subd(2:ndim), diag, supd(1:ndim-1), & - dlf, df, duf, du2, ipivot, & - rhs, ndim, solution, ndim, rcond, & - ferr, berr, work, iwork, info ) - - else if ( kind( diag(1) ) == sp ) then - call sgtsvx( "Not Factored", "No Transpose lhs", ndim, nrhs, & - subd(2:ndim), diag, supd(1:ndim-1), & - dlf, df, duf, du2, ipivot, & - rhs, ndim, solution, ndim, rcond, & - ferr, berr, work, iwork, info ) - - else - stop "tridag_solvex: Cannot resolve the precision of real datatype" - - end if - - ! Print diagnostics for when ferr is large - if ( clubb_at_least_debug_level( 2 ) .and. any( ferr > 1.e-3_core_rknd ) ) then - - write(fstderr,*) "Warning, large error est. for: " // trim( solve_type ) - - do i = 1, nrhs, 1 - write(fstderr,*) "rhs # ", i, "tridag forward error est. =", ferr(i) - write(fstderr,*) "rhs # ", i, "tridag backward error est. =", berr(i) - end do - - write(fstderr,'(2(a20,e15.6))') "rcond est. = ", rcond, & - "machine epsilon = ", epsilon( diag(1) ) - end if - - select case( info ) - case( :-1 ) - write(fstderr,*) trim( solve_type )// & - "illegal value in argument", -info - err_code = clubb_bad_lapack_arg - - case( 0 ) - ! Success! - if ( lapack_isnan( ndim, nrhs, solution ) ) then - err_code = clubb_var_equals_NaN - else - err_code = clubb_no_error - end if - - case( 1: ) - if ( info == ndim+1 ) then - write(fstderr,*) trim( solve_type) // & - " Warning: matrix is singular to working precision." - write(fstderr,'(a,e12.5)') & - "Estimate of the reciprocal of the condition number: ", rcond - err_code = clubb_no_error - else - write(fstderr,*) solve_type// & - " singular matrix." - err_code = clubb_singular_matrix - end if - - end select - - return - end subroutine tridag_solvex - -!----------------------------------------------------------------------- - subroutine tridag_solve & - ( solve_type, ndim, nrhs, & - supd, diag, subd, rhs, & - solution, err_code ) - -! Description: -! Solves a tridiagonal system of equations (simple routine) - -! References: -! -! -!----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - external :: & - sgtsv, & ! Single-prec. General Tridiagonal Solver eXpert - dgtsv ! Double-prec. General Tridiagonal Solver eXpert - - intrinsic :: kind - - ! Input variables - character(len=*), intent(in) :: & - solve_type ! Used to write a message if this fails - - integer, intent(in) :: & - ndim, & ! N-dimension of matrix - nrhs ! # of right hand sides to back subst. after LU-decomp. - - ! Input/Output variables - real( kind = core_rknd ), intent(inout), dimension(ndim) :: & - diag, & ! Main diagonal - subd, supd ! Sub and super diagonal - - real( kind = core_rknd ), intent(inout), dimension(ndim,nrhs) :: & - rhs ! RHS input - - ! Output variables - real( kind = core_rknd ), intent(out), dimension(ndim,nrhs) :: & - solution ! Solution - - - integer, intent(out) :: & - err_code ! Used to determine when a decomp. failed - - ! Local Variables - - integer :: info ! Diagnostic output - -!----------------------------------------------------------------------- -! *** The LAPACK Routine *** -! SUBROUTINE DGTSV( N, NRHS, DL, D, DU, B, LDB, INFO ) -!----------------------------------------------------------------------- - - if ( kind( diag(1) ) == dp ) then - call dgtsv( ndim, nrhs, subd(2:ndim), diag, supd(1:ndim-1), & - rhs, ndim, info ) - - else if ( kind( diag(1) ) == sp ) then - call sgtsv( ndim, nrhs, subd(2:ndim), diag, supd(1:ndim-1), & - rhs, ndim, info ) - - else - stop "tridag_solve: Cannot resolve the precision of real datatype" - - end if - - select case( info ) - case( :-1 ) - write(fstderr,*) trim( solve_type )// & - " illegal value in argument", -info - err_code = clubb_bad_lapack_arg - - solution = -999._core_rknd - - case( 0 ) - ! Success! - if ( lapack_isnan( ndim, nrhs, rhs ) ) then - err_code = clubb_var_equals_NaN - else - err_code = clubb_no_error - end if - - solution = rhs - - case( 1: ) - write(fstderr,*) trim( solve_type )//" singular matrix." - err_code = clubb_singular_matrix - - solution = -999._core_rknd - - end select - - return - end subroutine tridag_solve - -!----------------------------------------------------------------------- - subroutine band_solvex( solve_type, nsup, nsub, ndim, nrhs, & - lhs, rhs, solution, rcond, err_code ) -! Description: -! Restructure and then solve a band diagonal system, with -! diagnostic output - -! References: -! -! - -! Notes: -! I found that due to the use of sgbcon/dgbcon it is much -! more expensive to use this on most systems than the simple -! driver. Use this version only if you don't case about compute time. -! Also note that this version equilibrates the lhs and does an iterative -! refinement of the solutions, which results in a slightly different answer -! than the simple driver does. -dschanen 24 Sep 2008 -!----------------------------------------------------------------------- - use crmx_error_code, only: & - clubb_at_least_debug_level ! Logical function - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - external :: & - sgbsvx, & ! Single-prec. General Band Solver eXpert - dgbsvx ! Double-prec. General Band Solver eXpert - - intrinsic :: eoshift, kind, trim - - ! Input Variables - character(len=*), intent(in) :: solve_type - - integer, intent(in) :: & - nsup, & ! Number of superdiagonals - nsub, & ! Number of subdiagonals - ndim, & ! The order of the LHS Matrix, i.e. the # of linear equations - nrhs ! Number of RHS's to back substitute for - - real( kind = core_rknd ), dimension(nsup+nsub+1,ndim), intent(inout) :: & - lhs ! Left hand side - real( kind = core_rknd ), dimension(ndim,nrhs), intent(inout) :: & - rhs ! Right hand side(s) - - ! Output Variables - real( kind = core_rknd ), dimension(ndim,nrhs), intent(out) :: & - solution - - ! The estimate of the reciprocal condition number of matrix - ! after equilibration (if done). - real( kind = core_rknd ), intent(out) :: & - rcond - - integer, intent(out) :: err_code ! Valid calculation? - - ! Local Variables - - ! Workspaces - real( kind = core_rknd ), dimension(3*ndim) :: work - integer, dimension(ndim) :: iwork - - real( kind = core_rknd ), dimension(2*nsub+nsup+1,ndim) :: & - lulhs ! LU Decomposition of the LHS - - integer, dimension(ndim) :: & - ipivot - - real( kind = core_rknd ), dimension(nrhs) :: & - ferr, berr ! Forward and backward error estimate - - real( kind = core_rknd ), dimension(ndim) :: & - rscale, cscale ! Row and column scale factors for the LHS - - integer :: & - info, & ! If this doesn't come back as 0, something went wrong - offset, & ! Loop iterator - imain, & ! Main diagonal of the matrix - i ! Loop iterator - - character :: & - equed ! Row equilibration status - - -!----------------------------------------------------------------------- -! Reorder Matrix to use LAPACK band matrix format (5x6) - -! Shift example: - -! [ * * lhs(1,1) lhs(1,2) lhs(1,3) lhs(1,4) ] (2)=> -! [ * lhs(2,1) lhs(2,2) lhs(2,3) lhs(2,4) lhs(2,5) ] (1)=> -! [ lhs(3,1) lhs(3,2) lhs(3,3) lhs(3,4) lhs(3,5) lhs(3,6) ] -! <=(1) [ lhs(4,2) lhs(4,3) lhs(4,4) lhs(4,5) lhs(4,6) * ] -! <=(2) [ lhs(5,3) lhs(5,4) lhs(5,5) lhs(5,6) * * ] - -! The '*' indicates unreferenced elements. -! For additional bands above and below the main diagonal, the -! shifts to the left or right increases by the distance from the -! main diagonal of the matrix. -!----------------------------------------------------------------------- - - imain = nsup + 1 - - ! For the offset, (+) is left, and (-) is right - - ! Sub diagonals - do offset = 1, nsub, 1 - lhs(imain+offset, 1:ndim) & - = eoshift( lhs(imain+offset, 1:ndim), offset ) - end do - - ! Super diagonals - do offset = 1, nsup, 1 - lhs(imain-offset, 1:ndim) & - = eoshift( lhs(imain-offset, 1:ndim), -offset ) - end do - -!----------------------------------------------------------------------- -! *** The LAPACK Routine *** -! SUBROUTINE SGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, -! $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, -! $ RCOND, FERR, BERR, WORK, IWORK, INFO ) -!----------------------------------------------------------------------- - - if ( kind( lhs(1,1) ) == dp ) then - call dgbsvx( 'Equilibrate lhs', 'No Transpose lhs', & - ndim, nsub, nsup, nrhs, & - lhs, nsup+nsub+1, lulhs, 2*nsub+nsup+1, & - ipivot, equed, rscale, cscale, & - rhs, ndim, solution, ndim, & - rcond, ferr, berr, work, iwork, info ) - - else if ( kind( lhs(1,1) ) == sp ) then - call sgbsvx( 'Equilibrate lhs', 'No Transpose lhs', & - ndim, nsub, nsup, nrhs, & - lhs, nsup+nsub+1, lulhs, 2*nsub+nsup+1, & - ipivot, equed, rscale, cscale, & - rhs, ndim, solution, ndim, & - rcond, ferr, berr, work, iwork, info ) - - else - stop "band_solvex: Cannot resolve the precision of real datatype" - ! One implication of this is that CLUBB cannot be used with quad - ! precision variables without a quad precision band diagonal solver - end if - -! %% debug -! select case ( equed ) -! case ('N') -! print *, "No equilib. was required for lhs." -! case ('R') -! print *, "Row equilib. was done on lhs." -! case ('C') -! print *, "Column equilib. was done on lhs." -! case ('B') -! print *, "Row and column equilib. was done on lhs." -! end select - -! write(*,'(a,e12.5)') "Row scale : ", rscale -! write(*,'(a,e12.5)') "Column scale: ", cscale -! write(*,'(a,e12.5)') "Estimate of the reciprocal of the "// -! "condition number: ", rcond -! write(*,'(a,e12.5)') "Forward Error Estimate: ", ferr -! write(*,'(a,e12.5)') "Backward Error Estimate: ", berr -! %% end debug - - ! Diagnostic information - if ( clubb_at_least_debug_level( 2 ) .and. any( ferr > 1.e-3_core_rknd ) ) then - - write(fstderr,*) "Warning, large error est. for: " // trim( solve_type ) - - do i = 1, nrhs, 1 - write(fstderr,*) "rhs # ", i, "band_solvex forward error est. =", ferr(i) - write(fstderr,*) "rhs # ", i, "band_solvex backward error est. =", berr(i) - end do - - write(fstderr,'(2(a20,e15.6))') "rcond est. = ", rcond, & - "machine epsilon = ", epsilon( lhs(1,1) ) - end if - - select case( info ) - - case( :-1 ) - write(fstderr,*) trim( solve_type )// & - " illegal value for argument", -info - err_code = clubb_bad_lapack_arg - - case( 0 ) - ! Success! - if ( lapack_isnan( ndim, nrhs, solution ) ) then - err_code = clubb_var_equals_NaN - else - err_code = clubb_no_error - end if - - case( 1: ) - if ( info == ndim+1 ) then - write(fstderr,*) trim( solve_type )// & - " Warning: matrix singular to working precision." - write(fstderr,'(a,e12.5)') & - "Estimate of the reciprocal of the"// & - " condition number: ", rcond - err_code = clubb_no_error - else - write(fstderr,*) trim( solve_type )// & - " band solver: singular matrix" - err_code = clubb_singular_matrix - end if - - end select - - return - end subroutine band_solvex - -!----------------------------------------------------------------------- - subroutine band_solve( solve_type, nsup, nsub, ndim, nrhs, & - lhs, rhs, solution, err_code ) -! Description: -! Restructure and then solve a band diagonal system - -! References: -! -! -!----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - external :: & - sgbsv, & ! Single-prec. General Band Solver - dgbsv ! Double-prec. General Band Solver - - intrinsic :: eoshift, kind, trim - - ! Input Variables - character(len=*), intent(in) :: solve_type - - integer, intent(in) :: & - nsup, & ! Number of superdiagonals - nsub, & ! Number of subdiagonals - ndim, & ! The order of the LHS Matrix, i.e. the # of linear equations - nrhs ! Number of RHS's to solve for - - ! Note: matrix lhs is intent(in), not intent(inout) - ! as in the subroutine band_solvex( ) - real( kind = core_rknd ), dimension(nsup+nsub+1,ndim), intent(in) :: & - lhs ! Left hand side - real( kind = core_rknd ), dimension(ndim,nrhs), intent(inout) :: & - rhs ! Right hand side(s) - - ! Output Variables - real( kind = core_rknd ), dimension(ndim,nrhs), intent(out) :: solution - - integer, intent(out) :: err_code ! Valid calculation? - - ! Local Variables - - ! Workspaces - real( kind = core_rknd ), dimension(2*nsub+nsup+1,ndim) :: & - lulhs ! LU Decomposition of the LHS - - integer, dimension(ndim) :: & - ipivot - - integer :: & - info, & ! If this doesn't come back as 0, something went wrong - offset, & ! Loop iterator - imain ! Main diagonal of the matrix - - ! Copy LHS into Decomposition scratch space - - lulhs(nsub+1:2*nsub+nsup+1, 1:ndim) = lhs(1:nsub+nsup+1, 1:ndim) - -!----------------------------------------------------------------------- -! Reorder LU Matrix to use LAPACK band matrix format - -! Shift example for lulhs matrix (note the extra bands): - -! [ + + + + + + ] -! [ + + + + + + ] -! [ * * lhs(1,1) lhs(1,2) lhs(1,3) lhs(1,4) ] (2)=> -! [ * lhs(2,1) lhs(2,2) lhs(2,3) lhs(2,4) lhs(2,5) ] (1)=> -! [ lhs(3,1) lhs(3,2) lhs(3,3) lhs(3,4) lhs(3,5) lhs(3,6) ] -! <=(1) [ lhs(4,2) lhs(4,3) lhs(4,4) lhs(4,5) lhs(4,6) * ] -! <=(2) [ lhs(5,3) lhs(5,4) lhs(5,5) lhs(5,6) * * ] -! [ + + + + + + ] -! [ + + + + + + ] - -! The '*' indicates unreferenced elements. -! The '+' indicates an element overwritten during decomposition. -! For additional bands above and below the main diagonal, the -! shifts to the left or right increases by the distance from the -! main diagonal of the matrix. -!----------------------------------------------------------------------- - - ! Reorder lulhs, omitting the additional 2*nsub bands - ! that are used for the LU decomposition of the matrix. - - imain = nsub + nsup + 1 - - ! For the offset, (+) is left, and (-) is right - - ! Sub diagonals - do offset = 1, nsub, 1 - lulhs(imain+offset, 1:ndim) & - = eoshift( lulhs(imain+offset, 1:ndim), offset ) - end do - - ! Super diagonals - do offset = 1, nsup, 1 - lulhs(imain-offset, 1:ndim) & - = eoshift( lulhs(imain-offset, 1:ndim), -offset ) - end do - -!----------------------------------------------------------------------- -! *** LAPACK routine *** -! SUBROUTINE DGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO ) -!----------------------------------------------------------------------- - - if ( kind( lhs(1,1) ) == dp ) then - call dgbsv( ndim, nsub, nsup, nrhs, lulhs, nsub*2+nsup+1, & - ipivot, rhs, ndim, info ) - - else if ( kind( lhs(1,1) ) == sp ) then - call sgbsv( ndim, nsub, nsup, nrhs, lulhs, nsub*2+nsup+1, & - ipivot, rhs, ndim, info ) - - else - stop "band_solve: Cannot resolve the precision of real datatype" - ! One implication of this is that CLUBB cannot be used with quad - ! precision variables without a quad precision band diagonal solver - - end if - - select case( info ) - - case( :-1 ) - write(fstderr,*) trim( solve_type )// & - " illegal value for argument ", -info - err_code = clubb_bad_lapack_arg - - solution = -999._core_rknd - - case( 0 ) - ! Success! - if ( lapack_isnan( ndim, nrhs, rhs ) ) then - err_code = clubb_var_equals_NaN - else - err_code = clubb_no_error - end if - - solution = rhs - - case( 1: ) - write(fstderr,*) trim( solve_type )//" band solver: singular matrix" - err_code = clubb_singular_matrix - - solution = -999._core_rknd - - end select - - return - end subroutine band_solve - -!----------------------------------------------------------------------- - logical function lapack_isnan( ndim, nrhs, variable ) - -! Description: -! Check for NaN values in a variable using the LAPACK subroutines - -! References: -! -! -!----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none -#ifdef NO_LAPACK_ISNAN /* Used for older LAPACK libraries that don't have sisnan/disnan */ - - intrinsic :: any - - integer, intent(in) :: & - ndim, & ! Size of variable - nrhs ! Number of right hand sides - - real( kind = core_rknd ), dimension(ndim,nrhs), intent(in) :: & - variable ! Variable to check - - lapack_isnan = any( variable(:,1:nrhs) /= variable(:,1:nrhs) ) -#else - logical, external :: sisnan, disnan - - integer, intent(in) :: & - ndim, & ! Size of variable - nrhs ! Number of right hand sides - - real( kind = core_rknd ), dimension(ndim,nrhs), intent(in) :: & - variable ! Variable to check - - integer :: k, j - - ! ---- Begin Code ---- - - lapack_isnan = .false. - - if ( kind( variable ) == dp ) then - do k = 1, ndim - do j = 1, nrhs - lapack_isnan = disnan( variable(k,j) ) - if ( lapack_isnan ) exit - end do - if ( lapack_isnan ) exit - end do - else if ( kind( variable ) == sp ) then - do k = 1, ndim - do j = 1, nrhs - lapack_isnan = sisnan( variable(k,j) ) - if ( lapack_isnan ) exit - end do - if ( lapack_isnan ) exit - end do - else - stop "lapack_isnan: Cannot resolve the precision of real datatype" - end if -#endif /* NO_LAPACK_ISNAN */ - - return - end function lapack_isnan - -end module crmx_lapack_wrap diff --git a/src/physics/spcam/crm/CLUBB/crmx_matrix_operations.F90 b/src/physics/spcam/crm/CLUBB/crmx_matrix_operations.F90 deleted file mode 100644 index ce8ef95a3c..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_matrix_operations.F90 +++ /dev/null @@ -1,540 +0,0 @@ -! $Id: matrix_operations.F90 5690 2012-02-02 02:53:16Z dschanen@uwm.edu $ -module crmx_matrix_operations - - implicit none - - - public :: symm_covar_matrix_2_corr_matrix, Cholesky_factor, & - row_mult_lower_tri_matrix, print_lower_triangular_matrix, & - get_lower_triangular_matrix, set_lower_triangular_matrix_dp, & - set_lower_triangular_matrix - - private :: Symm_matrix_eigenvalues - - private ! Default scope - - contains - -!----------------------------------------------------------------------- - subroutine symm_covar_matrix_2_corr_matrix( ndim, covar, corr ) - -! Description: -! Convert a matrix of covariances in to a matrix of correlations. -! This only does the computation the lower triangular portion of the -! matrix. -! References: -! None -!----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - dp ! double precision - - implicit none - - ! External - intrinsic :: sqrt - - ! Input Variables - integer, intent(in) :: ndim - - real( kind = dp ), dimension(ndim,ndim), intent(in) :: & - covar ! Covariance Matrix [units vary] - - ! Output Variables - real( kind = dp ), dimension(ndim,ndim), intent(out) :: & - corr ! Correlation Matrix [-] - - ! Local Variables - integer :: i, j - - ! ---- Begin Code ---- - - corr = 0._dp ! Initialize to 0 - - do i = 1, ndim - do j = 1, i - corr(i,j) = covar(i,j) / sqrt( covar(i,i) * covar(j,j) ) - end do - end do - - return - end subroutine symm_covar_matrix_2_corr_matrix -!----------------------------------------------------------------------- - subroutine row_mult_lower_tri_matrix( ndim, xvector, tmatrix_in, tmatrix_out ) - -! Description: -! Do a row-wise multiply of the elements of a lower triangular matrix. -! References: -! None -!----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - dp ! double precision - - implicit none - - - ! Input Variables - integer, intent(in) :: ndim - - real( kind = dp ), dimension(ndim), intent(in) :: & - xvector ! Factors to be multiplied across a row [units vary] - - ! Input Variables - real( kind = dp ), dimension(ndim,ndim), intent(inout) :: & - tmatrix_in ! nxn matrix (usually a correlation matrix) [units vary] - - ! Output Variables - real( kind = dp ), dimension(ndim,ndim), intent(inout) :: & - tmatrix_out ! nxn matrix (usually a covariance matrix) [units vary] - - ! Local Variables - integer :: i, j - - ! ---- Begin Code ---- - - do i = 1, ndim - do j = 1, i - tmatrix_out(i,j) = tmatrix_in(i,j) * xvector(i) - end do - end do - - return - end subroutine row_mult_lower_tri_matrix - -!------------------------------------------------------------------------------- - subroutine Cholesky_factor( ndim, a_input, a_scaling, a_Cholesky, l_scaled ) -! Description: -! Create a Cholesky factorization of a_input. -! If the factorization fails we use a modified a_input matrix and attempt -! to factorize again. -! -! References: -! dpotrf -! dpoequ -! dlaqsy -!------------------------------------------------------------------------------- - use crmx_error_code, only: & - clubb_at_least_debug_level ! Procedure - - use crmx_constants_clubb, only: & - fstderr ! Constant - - use crmx_clubb_precision, only: & - dp, & ! double precision - core_rknd - - implicit none - - ! External - external :: dpotrf, dpoequ, dlaqsy ! LAPACK subroutines - - ! Constant Parameters - integer, parameter :: itermax = 10 ! Max iterations of the modified method - - real( kind = core_rknd), parameter :: d_coef = 0.1_core_rknd - ! Coefficient applied if the decomposition doesn't work - - ! Input Variables - integer, intent(in) :: ndim - - real( kind = dp ), dimension(ndim,ndim), intent(in) :: a_input - - ! Output Variables - real( kind = dp ), dimension(ndim), intent(out) :: a_scaling - - real( kind = dp ), dimension(ndim,ndim), intent(out) :: a_Cholesky - - logical, intent(out) :: l_scaled - - ! Local Variables - real( kind = dp ), dimension(ndim) :: a_eigenvalues - real( kind = dp ), dimension(ndim,ndim) :: a_corr, a_scaled - - real( kind = dp ) :: tau, d_smallest - - real( kind = dp ) :: amax, scond - integer :: info - integer :: i, j, iter - - character :: equed - - ! ---- Begin code ---- - - a_scaled = a_input ! Copy input array into output array - -! do i = 1, n -! do j = 1, n -! write(6,'(e10.3)',advance='no') a(i,j) -! end do -! write(6,*) "" -! end do -! pause - - equed = 'N' - - ! Compute scaling for a_input - call dpoequ( ndim, a_input, ndim, a_scaling, scond, amax, info ) - - if ( info == 0 ) then - ! Apply scaling to a_input - call dlaqsy( 'Lower', ndim, a_scaled, ndim, a_scaling, scond, amax, equed ) - end if - - ! Determine if scaling was necessary - if ( equed == 'Y' ) then - l_scaled = .true. - a_Cholesky = a_scaled - else - l_scaled = .false. - a_Cholesky = a_input - end if - - do iter = 1, itermax - call dpotrf( 'Lower', ndim, a_Cholesky, ndim, info ) - - select case( info ) - case( :-1 ) - write(fstderr,*) "Cholesky_factor " // & - " illegal value for argument ", -info - stop - case( 0 ) - ! Success! - if ( clubb_at_least_debug_level( 1 ) .and. iter > 1 ) then - write(fstderr,*) "a_factored (worked)=" - do i = 1, ndim - do j = 1, i - write(fstderr,'(g10.3)',advance='no') a_Cholesky(i,j) - end do - write(fstderr,*) "" - end do - end if - exit - case( 1: ) - if ( clubb_at_least_debug_level( 1 ) ) then - ! This shouldn't happen now that the s and t Mellor elements have been - ! modified to never be perfectly correlated, but it's here just in case. - ! -dschanen 10 Sept 2010 - write(fstderr,*) "Cholesky_factor: leading minor of order ", & - info, " is not positive definite." - write(fstderr,*) "factorization failed." - write(fstderr,*) "a_input=" - do i = 1, ndim - do j = 1, i - write(fstderr,'(g10.3)',advance='no') a_input(i,j) - end do - write(fstderr,*) "" - end do - write(fstderr,*) "a_Cholesky=" - do i = 1, ndim - do j = 1, i - write(fstderr,'(g10.3)',advance='no') a_Cholesky(i,j) - end do - write(fstderr,*) "" - end do - end if - - if ( clubb_at_least_debug_level( 2 ) ) then - call Symm_matrix_eigenvalues( ndim, a_input, a_eigenvalues ) - write(fstderr,*) "a_eigenvalues=" - do i = 1, ndim - write(fstderr,'(g10.3)',advance='no') a_eigenvalues(i) - end do - write(fstderr,*) "" - - call symm_covar_matrix_2_corr_matrix( ndim, a_input, a_corr ) - write(fstderr,*) "a_correlations=" - do i = 1, ndim - do j = 1, i - write(fstderr,'(g10.3)',advance='no') a_corr(i,j) - end do - write(fstderr,*) "" - end do - end if - - if ( iter == itermax ) then - write(fstderr,*) "iteration =", iter, "itermax =", itermax - stop "Fatal error in Cholesky_factor" - else if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) "Attempting to modify matrix to allow factorization." - end if - - if ( l_scaled ) then - a_Cholesky = a_scaled - else - a_Cholesky = a_input - end if - ! The number used for tau here is case specific to the Sigma covariance - ! matrix in the latin hypercube code and is not at all general. - ! Tau should be a number that is small relative to the other diagonal - ! elements of the matrix to have keep the error caused by modifying 'a' low. - ! -dschanen 30 Aug 2010 - d_smallest = a_Cholesky(1,1) - do i = 2, ndim - if ( d_smallest > a_Cholesky(i,i) ) d_smallest = a_Cholesky(i,i) - end do - ! Use the smallest element * d_coef * iteration - tau = d_smallest * real(d_coef, kind = dp) * real( iter, kind=dp ) - -! print *, "tau =", tau, "d_smallest = ", d_smallest - - do i = 1, ndim - do j = 1, ndim - if ( i == j ) then - a_Cholesky(i,j) = a_Cholesky(i,j) + tau ! Add tau to the diagonal - else - a_Cholesky(i,j) = a_Cholesky(i,j) - end if - end do - end do - - if ( clubb_at_least_debug_level( 2 ) ) then - call Symm_matrix_eigenvalues( ndim, a_Cholesky, a_eigenvalues ) - write(fstderr,*) "a_modified eigenvalues=" - do i = 1, ndim - write(fstderr,'(e10.3)',advance='no') a_eigenvalues(i) - end do - write(fstderr,*) "" - end if - - end select ! info - end do ! 1..itermax - - return - end subroutine Cholesky_factor - -!---------------------------------------------------------------------- - subroutine Symm_matrix_eigenvalues( ndim, a_input, a_eigenvalues ) -! Description: -! References: -!----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Constant - - use crmx_clubb_precision, only: & - dp ! double precision - - implicit none - - ! External - external :: dsyev ! LAPACK subroutine - - ! Parameters - integer, parameter :: & - lwork = 180 ! This is the optimal value I obtained for an n of 5 -dschanen 31 Aug 2010 - - ! Input Variables - integer, intent(in) :: ndim - - real( kind = dp ), dimension(ndim,ndim), intent(in) :: a_input - - ! Output Variables - real( kind = dp ), dimension(ndim), intent(out) :: a_eigenvalues - - ! Local Variables - real( kind = dp ), dimension(ndim,ndim) :: a_scratch - - real( kind = dp ), dimension(lwork) :: work - - integer :: info -! integer :: i, j - ! ---- Begin code ---- - - a_scratch = a_input - -! do i = 1, ndim -! do j = 1, ndim -! write(6,'(e10.3)',advance='no') a(i,j) -! end do -! write(6,*) "" -! end do -! pause - - call dsyev( 'No eigenvectors', 'Lower', ndim, a_scratch, ndim, & - a_eigenvalues, work, lwork, info ) - - select case( info ) - case( :-1 ) - write(fstderr,*) "Symm_matrix_eigenvalues:" // & - " illegal value for argument ", -info - stop - case( 0 ) - ! Success! - - case( 1: ) - write(fstderr,*) "Symm_matrix_eigenvalues: Algorithm failed to converge." - stop - end select - - return - end subroutine Symm_matrix_eigenvalues -!------------------------------------------------------------------------------- - subroutine set_lower_triangular_matrix( d_variables, index1, index2, xpyp, & - matrix ) -! Description: -! Set a value for the lower triangular portion of a matrix. -! References: -! None -!------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! user defined precision - - implicit none - - ! External - intrinsic :: max, min - - ! Input Variables - integer, intent(in) :: & - d_variables, & ! Number of variates - index1, index2 ! Indices for 2 variates (the order doesn't matter) - - real( kind = core_rknd ), intent(in) :: & - xpyp ! Value for the matrix (usually a correlation or covariance) [units vary] - - ! Input/Output Variables - real( kind = core_rknd ), dimension(d_variables,d_variables), intent(inout) :: & - matrix ! The lower triangular matrix - - integer :: i,j - - ! ---- Begin Code ---- - - ! Reverse these to set the values of upper triangular matrix - i = max( index1, index2 ) - j = min( index1, index2 ) - - if( i > 0 .and. j > 0 ) then - matrix(i,j) = xpyp - end if - - return - end subroutine set_lower_triangular_matrix - -!------------------------------------------------------------------------------- - subroutine set_lower_triangular_matrix_dp( d_variables, index1, index2, xpyp, & - matrix ) -! Description: -! Set a value for the lower triangular portion of a matrix. -! References: -! None -!------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - dp ! double precision - - implicit none - - ! External - intrinsic :: max, min - - ! Input Variables - integer, intent(in) :: & - d_variables, & ! Number of variates - index1, index2 ! Indices for 2 variates (the order doesn't matter) - - real( kind = dp ), intent(in) :: & - xpyp ! Value for the matrix (usually a correlation or covariance) [units vary] - - ! Input/Output Variables - real( kind = dp ), dimension(d_variables,d_variables), intent(inout) :: & - matrix ! The lower triangular matrix - - integer :: i,j - - ! ---- Begin Code ---- - - ! Reverse these to set the values of upper triangular matrix - i = max( index1, index2 ) - j = min( index1, index2 ) - - if( i > 0 .and. j > 0 ) then - matrix(i,j) = xpyp - end if - - return - end subroutine set_lower_triangular_matrix_dp - -!------------------------------------------------------------------------------- - subroutine get_lower_triangular_matrix( d_variables, index1, index2, matrix, & - xpyp ) -! Description: -! Returns a value from the lower triangular portion of a matrix. -! References: -! None -!------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd - - implicit none - - ! External - intrinsic :: max, min - - ! Input Variables - integer, intent(in) :: & - d_variables, & ! Number of variates - index1, index2 ! Indices for 2 variates (the order doesn't matter) - - ! Input/Output Variables - real( kind = core_rknd ), dimension(d_variables,d_variables), intent(in) :: & - matrix ! The covariance matrix - - real( kind = core_rknd ), intent(out) :: & - xpyp ! Value from the matrix (usually a correlation or covariance) [units vary] - - integer :: i,j - - ! ---- Begin Code ---- - - ! Reverse these to set the values of upper triangular matrix - i = max( index1, index2 ) - j = min( index1, index2 ) - - xpyp = matrix(i,j) - - return - end subroutine get_lower_triangular_matrix - -!----------------------------------------------------------------------- - subroutine print_lower_triangular_matrix( iunit, ndim, matrix ) - -! Description: -! Print the values of lower triangular matrix to a file or console. - -! References: -! None -!----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - integer, intent(in) :: & - iunit, & ! File I/O logical unit (usually 6 for stdout and 0 for stderr) - ndim ! Dimension of the matrix - - real( kind = core_rknd ), dimension(ndim,ndim), intent(in) :: & - matrix ! Lower triangular matrix [units vary] - - ! Local Variables - integer :: i, j - - ! ---- Begin Code ---- - - do i = 1, ndim - do j = 1, i - write(iunit,fmt='(g15.6)',advance='no') matrix(i,j) - end do - write(iunit,fmt=*) "" ! newline - end do - - return - end subroutine print_lower_triangular_matrix - -end module crmx_matrix_operations diff --git a/src/physics/spcam/crm/CLUBB/crmx_mean_adv.F90 b/src/physics/spcam/crm/CLUBB/crmx_mean_adv.F90 deleted file mode 100644 index 792ac5325f..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_mean_adv.F90 +++ /dev/null @@ -1,505 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: mean_adv.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -!=============================================================================== -module crmx_mean_adv - - ! Description: - ! Module mean_adv computes the mean advection terms for all of the - ! time-tendency (prognostic) equations in the CLUBB parameterization. All of - ! the mean advection terms are solved for completely implicitly, and therefore - ! become part of the left-hand side of their respective equations. - ! - ! Function term_ma_zt_lhs handles the mean advection terms for the variables - ! located at thermodynamic grid levels. These variables are: rtm, thlm, wp3, - ! all hydrometeor species, and sclrm. - ! - ! Function term_ma_zm_lhs handles the mean advection terms for the variables - ! located at momentum grid levels. The variables are: wprtp, wpthlp, wp2, - ! rtp2, thlp2, rtpthlp, up2, vp2, wpsclrp, sclrprtp, sclrpthlp, and sclrp2. - - implicit none - - private ! Default scope - - public :: term_ma_zt_lhs, & - term_ma_zm_lhs - - contains - - !============================================================================= - pure function term_ma_zt_lhs( wm_zt, invrs_dzt, level, invrs_dzm_k, invrs_dzm_km1 ) & - result( lhs ) - - ! Description: - ! Mean advection of var_zt: implicit portion of the code. - ! - ! The variable "var_zt" stands for a variable that is located at - ! thermodynamic grid levels. - ! - ! The d(var_zt)/dt equation contains a mean advection term: - ! - ! - w * d(var_zt)/dz. - ! - ! This term is solved for completely implicitly, such that: - ! - ! - w * d( var_zt(t+1) )/dz. - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed to - ! a "+". - ! - ! The timestep index (t+1) means that the value of var_zt being used is from - ! the next timestep, which is being advanced to in solving the d(var_zt)/dt - ! equation. - ! - ! This term is discretized as follows: - ! - ! The values of var_zt are found on the thermodynamic levels, as are the - ! values of wm_zt (mean vertical velocity on thermodynamic levels). The - ! variable var_zt is interpolated to the intermediate momentum levels. The - ! derivative of the interpolated values is taken over the central - ! thermodynamic level. The derivative is multiplied by wm_zt at the central - ! thermodynamic level to get the desired result. - ! - ! -----var_zt(kp1)----------------------------------------- t(k+1) - ! - ! =================var_zt(interp)========================== m(k) - ! - ! -----var_zt(k)------------------d(var_zt)/dz-----wm_zt--- t(k) - ! - ! =================var_zt(interp)========================== m(k-1) - ! - ! -----var_zt(km1)----------------------------------------- t(k-1) - ! - ! The vertical indices t(k+1), m(k), t(k), m(k-1), and t(k-1) correspond - ! with altitudes zt(k+1), zm(k), zt(k), zm(k-1), and zt(k-1), respectively. - ! The letter "t" is used for thermodynamic levels and the letter "m" is used - ! for momentum levels. - ! - ! invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ) - ! - ! - ! Special discretization for upper boundary level: - ! - ! Method 1: Constant derivative method (or "one-sided" method). - ! - ! The values of var_zt are found on the thermodynamic levels, as are the - ! values of wm_zt (mean vertical velocity on the thermodynamic levels). The - ! variable var_zt is interpolated to momentum level gr%nz-1, based on - ! the values of var_zt at thermodynamic levels gr%nz and gr%nz-1. - ! However, the variable var_zt cannot be interpolated to momentum level - ! gr%nz. Rather, a linear extension is used to find the value of var_zt - ! at momentum level gr%nz, based on the values of var_zt at thermodynamic - ! levels gr%nz and gr%nz-1. The derivative of the extended and - ! interpolated values, d(var_zt)/dz, is taken over the central thermodynamic - ! level. Of course, this derivative will be the same as the derivative of - ! var_zt between thermodynamic levels gr%nz and gr%nz-1. The derivative - ! is multiplied by wm_zt at the central thermodynamic level to get the - ! desired result. - ! - ! For the following diagram, k = gr%nz, which is the uppermost level of - ! the model: - ! - ! =================var_zt(extend)========================== m(k) Boundary - ! - ! -----var_zt(k)------------------d(var_zt)/dz-----wm_zt--- t(k) - ! - ! =================var_zt(interp)========================== m(k-1) - ! - ! -----var_zt(km1)----------------------------------------- t(k-1) - ! - ! - ! Method 2: Zero derivative method: - ! the derivative d(var_zt)/dz over the model top is set to 0. - ! - ! This method corresponds with the "zero-flux" boundary condition option - ! for eddy diffusion, where d(var_zt)/dz is set to 0 across the upper - ! boundary. - ! - ! In order to discretize the upper boundary condition, consider a new level - ! outside the model (thermodynamic level gr%nz+1) just above the upper - ! boundary level (thermodynamic level gr%nz). The value of var_zt at the - ! level just outside the model is defined to be the same as the value of - ! var_zt at thermodynamic level gr%nz. Therefore, the value of - ! d(var_zt)/dz between the level just outside the model and the uppermost - ! thermodynamic level is 0, staying consistent with the zero-flux boundary - ! condition option for the eddy diffusion portion of the code. Therefore, - ! the value of var_zt at momentum level gr%nz, which is the upper boundary - ! of the model, would be the same as the value of var_zt at the uppermost - ! thermodynamic level. - ! - ! The values of var_zt are found on the thermodynamic levels, as are the - ! values of wm_zt (mean vertical velocity on the thermodynamic levels). The - ! variable var_zt is interpolated to momentum level gr%nz-1, based on - ! the values of var_zt at thermodynamic levels gr%nz and gr%nz-1. The - ! value of var_zt at momentum level gr%nz is set equal to the value of - ! var_zt at thermodynamic level gr%nz, as described above. The derivative - ! of the set and interpolated values, d(var_zt)/dz, is taken over the - ! central thermodynamic level. The derivative is multiplied by wm_zt at the - ! central thermodynamic level to get the desired result. - ! - ! For the following diagram, k = gr%nz, which is the uppermost level of - ! the model: - ! - ! --[var_zt(kp1) = var_zt(k)]----(level outside model)----- t(k+1) - ! - ! ==[var_zt(top) = var_zt(k)]===[d(var_zt)/dz|_(top) = 0]== m(k) Boundary - ! - ! -----var_zt(k)------------------d(var_zt)/dz-----wm_zt--- t(k) - ! - ! =================var_zt(interp)========================== m(k-1) - ! - ! -----var_zt(km1)----------------------------------------- t(k-1) - ! - ! where (top) stands for the grid index of momentum level k = gr%nz, which - ! is the upper boundary of the model. - ! - ! This method of boundary discretization is also similar to the method - ! currently employed at the lower boundary for most thermodynamic-level - ! variables. Since thermodynamic level k = 1 is below the model bottom, - ! mean advection is not applied. Thus, thermodynamic level k = 2 becomes - ! the lower boundary level. Now, the mean advection term at thermodynamic - ! level 2 takes into account var_zt from levels 1, 2, and 3. However, in - ! most cases, the value of var_zt(1) is set equal to var_zt(2) after the - ! matrix of equations has been solved. Therefore, the derivative, - ! d(var_zt)/dz, over the model bottom (momentum level k = 1) becomes 0. - ! Thus, the method of setting d(var_zt)/dz to 0 over the model top keeps - ! the way the upper and lower boundaries are handled consistent with each - ! other. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_model_flags, only: & - l_upwind_xm_ma ! Variable(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. - k_tdiag = 2, & ! Thermodynamic main diagonal index. - km1_tdiag = 3 ! Thermodynamic subdiagonal index. - - integer, parameter :: & - t_above = 1, & ! Index for upper thermodynamic level grid weight. - t_below = 2 ! Index for lower thermodynamic level grid weight. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - wm_zt, & ! wm_zt(k) [m/s] - invrs_dzt, & ! Inverse of grid spacing (k) [1/m] - invrs_dzm_k, & ! Inverse of grid spacing (k) [1/m] - invrs_dzm_km1 ! Inverse of grid spacing (k-1) [1/m] - - - integer, intent(in) :: & - level ! Central thermodynamic level (on which calculation occurs). - - ! Return Variable - real( kind = core_rknd ), dimension(3) :: lhs - - ! Local Variables - logical, parameter :: & - l_ub_const_deriv = .true. ! Flag to use the "one-sided" upper boundary. - - integer :: & - mk, & ! Momentum level directly above central thermodynamic level. - mkm1 ! Momentum level directly below central thermodynamic level. - - ! Momentum level (k) is between thermodynamic level (k+1) - ! and thermodynamic level (k). - mk = level - - ! Momentum level (k-1) is between thermodynamic level (k) - ! and thermodynamic level (k-1). - mkm1 = level - 1 - - if ( level == 1 ) then - - ! k = 1 (bottom level); lower boundary level. - ! Thermodynamic level k = 1 is below the model bottom, so all effects - ! are shut off. - - ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = 0.0_core_rknd - - - elseif ( level > 1 .and. level < gr%nz ) then - - ! Most of the interior model; normal conditions. - - if( .not. l_upwind_xm_ma ) then ! Use centered differencing - - ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = + wm_zt * invrs_dzt * gr%weights_zt2zm(t_above,mk) - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = + wm_zt * invrs_dzt * ( gr%weights_zt2zm(t_below,mk) & - - gr%weights_zt2zm(t_above,mkm1) ) - - ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = - wm_zt * invrs_dzt * gr%weights_zt2zm(t_below,mkm1) - - else ! l_upwind_xm_ma == .true. Use upwind differencing - - if ( wm_zt > 0._core_rknd ) then ! Wind is in upward direction - - ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = + wm_zt * invrs_dzm_km1 - - ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = - wm_zt * invrs_dzm_km1 - - - else ! wm_zt < 0 Wind is in downward direction - - ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = + wm_zt * invrs_dzm_k - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = - wm_zt * invrs_dzm_k - - ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = 0.0_core_rknd - - end if ! wm_zt >0 - - end if ! l_upwind_xm_ma - - elseif ( level == gr%nz ) then - - ! k = gr%nz (top level); upper boundary level. - - if ( l_ub_const_deriv ) then - - ! Special discretization for constant derivative method (or "one-sided" - ! derivative method). - - ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = + wm_zt * invrs_dzt * ( gr%weights_zt2zm(t_above,mk) & - - gr%weights_zt2zm(t_above,mkm1) ) - - ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = + wm_zt * invrs_dzt * ( gr%weights_zt2zm(t_below,mk) & - - gr%weights_zt2zm(t_below,mkm1) ) - - else - - ! Special discretization for zero derivative method, where the - ! derivative d(var_zt)/dz over the model top is set to 0, in order to - ! stay consistent with the zero-flux boundary condition option in the - ! eddy diffusion code. - - ! Thermodynamic superdiagonal: [ x var_zt(k+1,) ] - lhs(kp1_tdiag) & - = 0.0_core_rknd - - ! Thermodynamic main diagonal: [ x var_zt(k,) ] - lhs(k_tdiag) & - = + wm_zt * invrs_dzt * ( 1.0_core_rknd - gr%weights_zt2zm(t_above,mkm1) ) - - ! Thermodynamic subdiagonal: [ x var_zt(k-1,) ] - lhs(km1_tdiag) & - = - wm_zt * invrs_dzt * gr%weights_zt2zm(t_below,mkm1) - - endif - - - endif ! level = gr%nz - - - return - end function term_ma_zt_lhs - - !============================================================================= - pure function term_ma_zm_lhs( wm_zm, invrs_dzm, level ) & - result( lhs ) - - ! Description: - ! Mean advection of var_zm: implicit portion of the code. - ! - ! The variable "var_zm" stands for a variable that is located at momentum - ! grid levels. - ! - ! The d(var_zm)/dt equation contains a mean advection term: - ! - ! - w * d(var_zm)/dz. - ! - ! This term is solved for completely implicitly, such that: - ! - ! - w * d( var_zm(t+1) )/dz. - ! - ! Note: When the term is brought over to the left-hand side, the sign - ! is reversed and the leading "-" in front of the term is changed to - ! a "+". - ! - ! The timestep index (t+1) means that the value of var_zm being used is from - ! the next timestep, which is being advanced to in solving the d(var_zm)/dt - ! equation. - ! - ! This term is discretized as follows: - ! - ! The values of var_zm are found on the momentum levels, as are the values - ! of wm_zm (mean vertical velocity on momentum levels). The variable var_zm - ! is interpolated to the intermediate thermodynamic levels. The derivative - ! of the interpolated values is taken over the central momentum level. The - ! derivative is multiplied by wm_zm at the central momentum level to get the - ! desired result. - ! - ! =====var_zm(kp1)========================================= m(k+1) - ! - ! -----------------var_zm(interp)-------------------------- t(k+1) - ! - ! =====var_zm(k)==================d(var_zm)/dz=====wm_zm=== m(k) - ! - ! -----------------var_zm(interp)-------------------------- t(k) - ! - ! =====var_zm(km1)========================================= m(k-1) - ! - ! The vertical indices m(k+1), t(k+1), m(k), t(k), and m(k-1) correspond - ! with altitudes zm(k+1), zt(k+1), zm(k), zt(k), and zm(k-1), respectively. - ! The letter "t" is used for thermodynamic levels and the letter "m" is used - ! for momentum levels. - ! - ! invrs_dzm(k) = 1 / ( zt(k+1) - zt(k) ) - - ! References: - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_mdiag = 1, & ! Momentum superdiagonal index. - k_mdiag = 2, & ! Momentum main diagonal index. - km1_mdiag = 3 ! Momentum subdiagonal index. - - integer, parameter :: & - m_above = 1, & ! Index for upper momentum level grid weight. - m_below = 2 ! Index for lower momentum level grid weight. - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - wm_zm, & ! wm_zm(k) [m/s] - invrs_dzm ! Inverse of grid spacing (k) [1/m] - - integer, intent(in) :: & - level ! Central momentum level (on which calculation occurs). - - ! Return Variable - real( kind = core_rknd ), dimension(3) :: lhs - - ! Local Variables - integer :: & - tkp1, & ! Thermodynamic level directly above central momentum level. - tk ! Thermodynamic level directly below central momentum level. - - ! Thermodynamic level (k+1) is between momentum level (k+1) - ! and momentum level (k). - tkp1 = level + 1 - - ! Thermodynamic level (k) is between momentum level (k) - ! and momentum level (k-1). - tk = level - - if ( level == 1 ) then - - ! k = 1; lower boundery level at surface. - - ! Momentum superdiagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) & - = 0.0_core_rknd - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) & - = 0.0_core_rknd - - ! Momentum subdiagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) & - = 0.0_core_rknd - - - elseif ( level > 1 .and. level < gr%nz ) then - - ! Most of the interior model; normal conditions. - - ! Momentum superdiagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) & - = + wm_zm * invrs_dzm * gr%weights_zm2zt(m_above,tkp1) - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) & - = + wm_zm * invrs_dzm * ( gr%weights_zm2zt(m_below,tkp1) & - - gr%weights_zm2zt(m_above,tk) ) - - ! Momentum subdiagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) & - = - wm_zm * invrs_dzm * gr%weights_zm2zt(m_below,tk) - - - elseif ( level == gr%nz ) then - - ! k = gr%nz (top level); upper boundary level. - - ! Momentum superdiagonal: [ x var_zm(k+1,) ] - lhs(kp1_mdiag) & - = 0.0_core_rknd - - ! Momentum main diagonal: [ x var_zm(k,) ] - lhs(k_mdiag) & - = 0.0_core_rknd - - ! Momentum subdiagonal: [ x var_zm(k-1,) ] - lhs(km1_mdiag) & - = 0.0_core_rknd - - - endif - - return - end function term_ma_zm_lhs - -!=============================================================================== - -end module crmx_mean_adv diff --git a/src/physics/spcam/crm/CLUBB/crmx_mixing_length.F90 b/src/physics/spcam/crm/CLUBB/crmx_mixing_length.F90 deleted file mode 100644 index 1418835d6e..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_mixing_length.F90 +++ /dev/null @@ -1,817 +0,0 @@ -! $Id: mixing_length.F90 5779 2012-04-02 16:59:10Z dschanen@uwm.edu $ -!=============================================================================== -module crmx_mixing_length - - implicit none - - private ! Default Scope - - public :: compute_length - - contains - - !============================================================================= - subroutine compute_length( thvm, thlm, rtm, em, & - p_in_Pa, exner, thv_ds, mu, l_implemented, & - err_code, & - Lscale, Lscale_up, Lscale_down ) - ! Description: - ! Larson's 5th moist, nonlocal length scale - - ! References: - ! Section 3b ( /Eddy length formulation/ ) of - ! ``A PDF-Based Model for Boundary Layer Clouds. Part I: - ! Method and Model Description'' Golaz, et al. (2002) - ! JAS, Vol. 59, pp. 3540--3551. - - !----------------------------------------------------------------------- - - ! mu = (1/M) dM/dz > 0. mu=0 for no entrainment. - ! Siebesma recommends mu=2e-3, although most schemes use mu=1e-4 - ! When mu was fixed, we used the value mu = 6.e-4 - - use crmx_constants_clubb, only: & ! Variable(s) - Cp, & ! Dry air specific heat at constant pressure [J/kg/K] - Rd, & ! Dry air gas constant [J/kg/K] - ep, & ! Rd / Rv [-] - ep1, & ! (1-ep)/ep [-] - ep2, & ! 1/ep [-] - Lv, & ! Latent heat of vaporiztion [J/kg/K] - grav, & ! Gravitational acceleration [m/s^2] - fstderr, & - zero_threshold - - use crmx_parameters_tunable, only: & ! Variable(s) - lmin ! Minimum value for Lscale [m] - - use crmx_parameters_model, only: & - Lscale_max ! Maximum value for Lscale [m] - - use crmx_grid_class, only: & - gr, & ! Variable(s) - zm2zt ! Procedure(s) - - use crmx_numerical_check, only: & - length_check ! Procedure(s) - - use crmx_saturation, only: & - sat_mixrat_liq, & ! Procedure(s) - sat_mixrat_liq_lookup - - use crmx_error_code, only: & - clubb_at_least_debug_level, & ! Procedure(s) - fatal_error - - use crmx_error_code, only: & - clubb_no_error ! Constant - - use crmx_model_flags, only: & - l_sat_mixrat_lookup ! Variable(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: min, max, sqrt - - ! Constant Parameters - real( kind = core_rknd ), parameter :: & - zlmin = 0.1_core_rknd, & ! Minimum value for Lscale [m] - Lscale_sfclyr_depth = 500._core_rknd ! [m] - - ! Input Variables - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - thvm, & ! Virtual potential temp. on themodynamic level [K] - thlm, & ! Liquid potential temp. on themodynamic level [K] - rtm, & ! Total water mixing ratio on themodynamic level [kg/kg] - em, & ! em = 3/2 * w'^2; on momentum level [m^2/s^2] - exner, & ! Exner function on thermodynamic level [-] - p_in_Pa, & ! Pressure on thermodynamic level [Pa] - thv_ds ! Dry, base-state theta_v on thermodynamic level [K] - ! Note: thv_ds used as a reference theta_l here - - real( kind = core_rknd ), intent(in) :: & - mu ! mu Fractional extrainment rate per unit altitude [1/m] - - logical, intent(in) :: & - l_implemented ! Flag for CLUBB being implemented in a larger model - - ! Output Variables - integer, intent(inout) :: & - err_code - - real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & - Lscale, & ! Mixing length [m] - Lscale_up, & ! Mixing length up [m] - Lscale_down ! Mixing length down [m] - - ! Local Variables - - integer :: i, j, & - err_code_Lscale - - real( kind = core_rknd ) :: tke_i, CAPE_incr - - real( kind = core_rknd ) :: dCAPE_dz_j, dCAPE_dz_j_minus_1, dCAPE_dz_j_plus_1 - - ! Temporary arrays to store calculations to speed runtime - real( kind = core_rknd ), dimension(gr%nz) :: exp_mu_dzm, invrs_dzm_on_mu - - ! Minimum value for Lscale that will taper off with height - real( kind = core_rknd ) :: lminh - - ! Parcel quantities at grid level j - real( kind = core_rknd ) :: thl_par_j, rt_par_j, rc_par_j, thv_par_j - - ! Used in latent heating calculation - real( kind = core_rknd ) :: tl_par_j, rsl_par_j, beta_par_j, & - s_par_j - - ! Parcel quantities at grid level j-1 - real( kind = core_rknd ) :: thl_par_j_minus_1, rt_par_j_minus_1 - - ! Parcel quantities at grid level j+1 - real( kind = core_rknd ) :: thl_par_j_plus_1, rt_par_j_plus_1 - - ! Variables to make L nonlocal - real( kind = core_rknd ) :: Lscale_up_max_alt, Lscale_down_min_alt - - ! ---- Begin Code ---- - - err_code_Lscale = clubb_no_error - - !---------- Mixing length computation ---------------------------------- - - ! Avoid uninitialized memory (these values are not used in Lscale) - ! -dschanen 12 March 2008 - Lscale_up(1) = 0.0_core_rknd - Lscale_down(1) = 0.0_core_rknd - - ! Initialize exp_mu_dzm--sets each exp_mu_dzm value to its corresponding - ! exp(-mu/gr%invrs_dzm) value. In theory, this saves 11 computations of - ! exp(-mu/gr%invrs_dzm) used below. - ! ~~EIHoppe//20090615 - exp_mu_dzm(:) = exp( -mu/gr%invrs_dzm(:) ) - - ! Initialize invrs_dzm_on_mu -- sets each invrs_dzm_on_mu value to its - ! corresponding (gr%invrs_dzm/mu) value. This will save computations of - ! this value below. - ! ~EIHoppe//20100728 - invrs_dzm_on_mu(:) = (gr%invrs_dzm(:))/mu - - !!!!! Compute Lscale_up for every vertical level. - - ! Upwards loop - - Lscale_up_max_alt = 0._core_rknd - do i = 2, gr%nz, 1 - - tke_i = zm2zt( em, i ) ! TKE interpolated to thermodynamic level - - Lscale_up(i) = zlmin - j = i + 1 - - thl_par_j_minus_1 = thlm(i) - rt_par_j_minus_1 = rtm(i) - dCAPE_dz_j_minus_1 = 0.0_core_rknd - - do while ((tke_i > 0._core_rknd) .and. (j < gr%nz)) - - ! thl, rt of parcel are conserved except for entrainment - - ! theta_l of the parcel at grid level j. - ! - ! The equation for the rate of change of theta_l of the parcel with - ! respect to height, due to entrainment, is: - ! - ! d(thl_par)/dz = - mu * ( thl_par - thl_env ); - ! - ! where thl_par is theta_l of the parcel, thl_env is theta_l of the - ! ambient (or environmental) air, and mu is the entrainment rate, - ! such that: - ! - ! mu = (1/m)*(dm/dz); - ! - ! where m is the mass of the parcel. The value of mu is set to be a - ! constant. - ! - ! The differential equation is solved for thl_par_j (thl_par at - ! height gr%zt(j)) given the boundary condition thl_par_j_minus_1 - ! (thl_par at height gr%zt(j-1)), and given the fact that the value - ! of thl_env is treated as changing linearly for a parcel of air - ! ascending from level j-1 (where thl_env has the value thlm(j-1)) to - ! level j (where thl_env has the value thlm(j)). - ! - ! For the special case where entrainment rate, mu, is set to 0, - ! thl_par remains constant as the parcel ascends. - - if ( mu /= 0.0_core_rknd ) then - - ! The ascending parcel is entraining at rate mu. - - ! Calculation changed to use pre-calculated exp(-mu/gr%invrs_dzm) - ! values. ~~EIHoppe//20090615 - - ! Calculation changed to use pre-calculated mu/gr%invrs_dzm values. - ! ~EIHoppe//20100728 - - thl_par_j = thlm(j) - thlm(j-1)*exp_mu_dzm(j-1) & - - ( 1.0_core_rknd - exp_mu_dzm(j-1)) & - * ( (thlm(j) - thlm(j-1)) & - * invrs_dzm_on_mu(j-1) ) & -! / (mu/gr%invrs_dzm(j-1)) ) & - + thl_par_j_minus_1 * exp_mu_dzm(j-1) - - else - - ! The ascending parcel is not entraining. - - thl_par_j = thl_par_j_minus_1 - - endif - - ! r_t of the parcel at grid level j. - ! - ! The equation for the rate of change of r_t of the parcel with - ! respect to height, due to entrainment, is: - ! - ! d(rt_par)/dz = - mu * ( rt_par - rt_env ); - ! - ! where rt_par is r_t of the parcel, rt_env is r_t of the ambient (or - ! environmental) air, and mu is the entrainment rate, such that: - ! - ! mu = (1/m)*(dm/dz); - ! - ! where m is the mass of the parcel. The value of mu is set to be a - ! constant. - ! - ! The differential equation is solved for rt_par_j (rt_par at height - ! gr%zt(j)) given the boundary condition rt_par_j_minus_1 (rt_par at - ! height gr%zt(j-1)), and given the fact that the value of rt_env is - ! treated as changing linearly for a parcel of air ascending from - ! level j-1 (where rt_env has the value rtm(j-1)) to level j (where - ! rt_env has the value rtm(j)). - ! - ! For the special case where entrainment rate, mu, is set to 0, - ! rt_par remains constant as the parcel ascends. - - if ( mu /= 0.0_core_rknd ) then - - ! The ascending parcel is entraining at rate mu. - - ! Calculation changed to use pre-calculated exp(-mu/gr%invrs_dzm) - ! values. ~~EIHoppe//20090615 - - ! Calculation changed to use pre-calculated mu/gr%invrs_dzm values. - ! ~EIHoppe//20100728 - - rt_par_j = rtm(j) - rtm(j-1)*exp_mu_dzm(j-1) & - - ( 1.0_core_rknd - exp_mu_dzm(j-1)) & - * ( (rtm(j) - rtm(j-1)) & - * invrs_dzm_on_mu(j-1) ) & -! / (mu/gr%invrs_dzm(j-1)) ) & - + rt_par_j_minus_1 * exp_mu_dzm(j-1) - - else - - ! The ascending parcel is not entraining. - - rt_par_j = rt_par_j_minus_1 - - endif - - ! Include effects of latent heating on Lscale_up 6/12/00 - ! Use thermodynamic formula of Bougeault 1981 JAS Vol. 38, 2416 - ! Probably should use properties of bump 1 in Gaussian, not mean!!! - - ! Calculate r_c of the parcel at grid level j based on the values of - ! theta_l of the parcel and r_t of the parcel at grid level j. - tl_par_j = thl_par_j*exner(j) - if ( l_sat_mixrat_lookup ) then - rsl_par_j = sat_mixrat_liq_lookup( p_in_Pa(j), tl_par_j ) - else - rsl_par_j = sat_mixrat_liq( p_in_Pa(j), tl_par_j ) - end if - ! SD's beta (eqn. 8) - beta_par_j = ep*(Lv/(Rd*tl_par_j))*(Lv/(cp*tl_par_j)) - ! s from Lewellen and Yoh 1993 (LY) eqn. 1 - s_par_j = (rt_par_j-rsl_par_j)/(1._core_rknd+beta_par_j*rsl_par_j) - rc_par_j = max( s_par_j, zero_threshold ) - - ! theta_v of entraining parcel at grid level j. - thv_par_j = thl_par_j + ep1 * thv_ds(j) * rt_par_j & - + ( Lv / (exner(j)*cp) - ep2 * thv_ds(j) ) * rc_par_j - - ! Lscale_up and CAPE increment. - ! - ! The equation for Lscale_up is: - ! - ! INT(z_i:z_i+Lscale_up) g * ( thv_par - thvm ) / thvm dz = -em(z_i); - ! - ! where thv_par is theta_v of the parcel, thvm is the mean - ! environmental value of theta_v, z_i is the altitude that the parcel - ! started its ascent from, and em is the mean value of TKE at - ! altitude z_i (which gives the parcel its initial upward boost). - ! - ! The increment of CAPE for any two successive vertical levels (z_0 - ! and z_1, such that z_0 < z_1, and where z_0 is gr%zt(j-1) and z_1 - ! is gr%zt(j)) is: - ! - ! CAPE_incr = INT(z_0:z_1) g * ( thv_par - thvm ) / thvm dz. - ! - ! Thus, the derivative of CAPE with respect to height is: - ! - ! dCAPE/dz = g * ( thv_par - thvm ) / thvm. - ! - ! A purely trapezoidal rule is used between levels z_0 and z_1, such - ! that dCAPE/dz is evaluated at levels z_0 and z_1, and is considered - ! to vary linearly at all altitudes z_0 <= z <= z_1. Thus, dCAPE/dz - ! is considered to be of the form: A * (z-zo) + dCAPE/dz|_(z_0), - ! where A = ( dCAPE/dz|_(z_1) - dCAPE/dz|_(z_0) ) / ( z_1 - z_0 ). - ! - ! The integral is evaluated to find the CAPE increment between two - ! successive vertical levels. The result either adds to or depletes - ! from the total amount of energy that keeps the parcel ascending. - - dCAPE_dz_j = ( grav/thvm(j) ) * ( thv_par_j - thvm(j) ) - - CAPE_incr = 0.5_core_rknd * ( dCAPE_dz_j + dCAPE_dz_j_minus_1 ) & - / gr%invrs_dzm(j-1) - - if ( tke_i + CAPE_incr > 0.0_core_rknd ) then - - ! The total amount of CAPE increment has not exhausted the initial - ! TKE (plus any additions by CAPE increments due to upward - ! buoyancy) that boosted and carried the parcel upward. The - ! thickness of the full grid level is added to Lscale_up. - - Lscale_up(i) = Lscale_up(i) + gr%zt(j) - gr%zt(j-1) - - else - - ! The total amount of CAPE increment has exhausted the initial TKE - ! (plus any additions by CAPE increments due to upward buoyancy) - ! that boosted and carried the parcel upward. Add the thickness - ! z - z_0 (where z_0 < z <= z_1) to Lscale_up. The calculation of - ! Lscale_up is complete. - - if ( dCAPE_dz_j == dCAPE_dz_j_minus_1 ) then - - ! Special case where dCAPE/dz|_(z_1) - dCAPE/dz|_(z_0) = 0, - ! thus making factor A (above) equal to 0. Find the remaining - ! distance z - z_0 that it takes to exhaust the remaining TKE - ! (tke_i). - - Lscale_up(i) & - = Lscale_up(i) & - + ( - tke_i / dCAPE_dz_j ) - - else - - ! Case used for most scenarios where dCAPE/dz|_(z_1) - ! /= dCAPE/dz|_(z_0), thus making factor A /= 0. Find the - ! remaining distance z - z_0 that it takes to exhaust the - ! remaining TKE (tke_i), using the quadratic formula (only the - ! negative (-) root works in this scenario). - - Lscale_up(i) & - = Lscale_up(i) & - + ( - dCAPE_dz_j_minus_1 / & - ( dCAPE_dz_j - dCAPE_dz_j_minus_1 ) ) & - / gr%invrs_dzm(j-1) & - - sqrt( dCAPE_dz_j_minus_1**2 & - - 2.0_core_rknd * tke_i * gr%invrs_dzm(j-1) & - * ( dCAPE_dz_j - dCAPE_dz_j_minus_1 ) ) & - / ( dCAPE_dz_j - dCAPE_dz_j_minus_1 ) & - / gr%invrs_dzm(j-1) - - endif - - endif - - ! Reset values for use during the next vertical level up. - - thl_par_j_minus_1 = thl_par_j - rt_par_j_minus_1 = rt_par_j - dCAPE_dz_j_minus_1 = dCAPE_dz_j - - tke_i = tke_i + CAPE_incr - j = j + 1 - - enddo - - ! Make Lscale_up nonlocal - ! - ! This code makes the value of Lscale_up nonlocal. Thus, if a parcel - ! starting from a lower altitude can ascend to altitude - ! Lscale_up_max_alt, then a parcel starting from a higher altitude should - ! also be able to ascend to at least altitude Lscale_up_max_alt, even if - ! the local result of Lscale_up for the parcel that started at a higher - ! altitude is not sufficient for the parcel to reach altitude - ! Lscale_up_max_alt. - ! - ! For example, if it was found that a parcel starting at an altitude of - ! 100 m. ascended to an altitude of 2100 m. (an Lscale_up value of - ! 2000 m.), then a parcel starting at an altitude of 200 m. should also - ! be able to ascend to an altitude of at least 2100 m. If Lscale_up - ! was found to be only 1800 m. for the parcel starting at 200 m. - ! (resulting in the parcel only being able to ascend to an altitude of - ! 2000 m.), then this code will overwrite the 1800 m. value with a - ! Lscale_up value of 1900 m. (so that the parcel reaches an altitude of - ! 2100 m.). - ! - ! This feature insures that the profile of Lscale_up will be very smooth, - ! thus reducing numerical instability in the model. - - Lscale_up_max_alt = max( Lscale_up_max_alt, Lscale_up(i)+gr%zt(i) ) - - if ( ( gr%zt(i) + Lscale_up(i) ) < Lscale_up_max_alt ) then - Lscale_up(i) = Lscale_up_max_alt - gr%zt(i) - endif - - enddo - - - !!!!! Compute Lscale_down for every vertical level. - - ! Do it again for downwards particle motion. - ! For now, do not include latent heat - - ! Chris Golaz modification to include effects on latent heating - ! on Lscale_down - - Lscale_down_min_alt = gr%zt(gr%nz) - do i = gr%nz, 2, -1 - - tke_i = zm2zt( em, i ) ! TKE interpolated to thermodynamic level - - Lscale_down(i) = zlmin - j = i - 1 - - thl_par_j_plus_1 = thlm(i) - rt_par_j_plus_1 = rtm(i) - dCAPE_dz_j_plus_1 = 0.0_core_rknd - - do while ( (tke_i > 0._core_rknd) .and. (j >= 2) ) - - ! thl, rt of parcel are conserved except for entrainment - - ! theta_l of the parcel at grid level j. - ! - ! The equation for the rate of change of theta_l of the parcel with - ! respect to height, due to entrainment, is: - ! - ! d(thl_par)/dz = - mu * ( thl_par - thl_env ); - ! - ! where thl_par is theta_l of the parcel, thl_env is theta_l of the - ! ambient (or environmental) air, and mu is the entrainment rate, - ! such that: - ! - ! mu = (1/m)*(dm/dz); - ! - ! where m is the mass of the parcel. The value of mu is set to be a - ! constant. - ! - ! NOTE: For an entraining, descending parcel, parcel mass will - ! increase as height decreases. Thus dm/dz < 0, and therefore - ! mu < 0. However, in the equation for thl_par_j, mu is always - ! multiplied by the delta_z factor ( gr%zt(j) - gr%zt(j+1) ), - ! which always has the propery delta_z < 0 for a descending - ! parcel. Thus, mu*delta_z > 0, just as for an entraining, - ! ascending parcel. Therefore, the same general form of the - ! entrainment equation (only with differing grid level indices) - ! can be used for both the ascending and descending parcels. - ! - ! The differential equation is solved for thl_par_j (thl_par at - ! height gr%zt(j)) given the boundary condition thl_par_j_plus_1 - ! (thl_par at height gr%zt(j+1)), and given the fact that the value - ! of thl_env is treated as changing linearly for a parcel of air - ! descending from level j+1 (where thl_env has the value thlm(j+1)) to - ! level j (where thl_env has the value thlm(j)). - ! - ! For the special case where entrainment rate, mu, is set to 0, - ! thl_par remains constant as the parcel descends. - - if ( mu /= 0.0_core_rknd ) then - - ! The descending parcel is entraining at rate mu. - - ! Calculation changed to use pre-calculated exp(-mu/gr%invrs_dzm) - ! values. ~~EIHoppe//20090615 - - ! Calculation changed to use pre-calculated mu/gr%invrs_dzm values. - ! ~EIHoppe//20100728 - - thl_par_j = thlm(j) - thlm(j+1)*exp_mu_dzm(j) & - - ( 1.0_core_rknd - exp_mu_dzm(j)) & - * ( (thlm(j) - thlm(j+1)) & - * invrs_dzm_on_mu(j) ) & -! / (mu/gr%invrs_dzm(j)) ) & - + thl_par_j_plus_1 * exp_mu_dzm(j) - - else - - ! The descending parcel is not entraining. - - thl_par_j = thl_par_j_plus_1 - - endif - - ! r_t of the parcel at grid level j. - ! - ! The equation for the rate of change of r_t of the parcel with - ! respect to height, due to entrainment, is: - ! - ! d(rt_par)/dz = - mu * ( rt_par - rt_env ); - ! - ! where rt_par is r_t of the parcel, rt_env is r_t of the ambient (or - ! environmental) air, and mu is the entrainment rate, such that: - ! - ! mu = (1/m)*(dm/dz); - ! - ! where m is the mass of the parcel. The value of mu is set to be a - ! constant. - ! - ! NOTE: For an entraining, descending parcel, parcel mass will - ! increase as height decreases. Thus dm/dz < 0, and therefore - ! mu < 0. However, in the equation for rt_par_j, mu is always - ! multiplied by the delta_z factor ( gr%zt(j) - gr%zt(j+1) ), - ! which always has the propery delta_z < 0 for a descending - ! parcel. Thus, mu*delta_z > 0, just as for an entraining, - ! ascending parcel. Therefore, the same general form of the - ! entrainment equation (only with differing grid level indices) - ! can be used for both the ascending and descending parcels. - ! - ! The differential equation is solved for rt_par_j (rt_par at height - ! gr%zt(j)) given the boundary condition rt_par_j_plus_1 (rt_par at - ! height gr%zt(j+1)), and given the fact that the value of rt_env is - ! treated as changing linearly for a parcel of air descending from - ! level j+1 (where rt_env has the value rtm(j+1)) to level j (where - ! rt_env has the value rtm(j)). - ! - ! For the special case where entrainment rate, mu, is set to 0, - ! rt_par remains constant as the parcel descends. - - if ( mu /= 0.0_core_rknd ) then - - ! The descending parcel is entraining at rate mu. - - ! Calculation changed to use pre-calculated exp(-mu/gr%invrs_dzm) - ! values. ~~EIHoppe//20090615 - - ! Calculation changed to use pre-calculated mu/gr%invrs_dzm values. - ! ~EIHoppe//20100728 - - rt_par_j = rtm(j) - rtm(j+1)*exp_mu_dzm(j) & - - ( 1.0_core_rknd - exp_mu_dzm(j) ) & - * ( (rtm(j) - rtm(j+1)) & -! / (mu/gr%invrs_dzm(j)) ) & - * invrs_dzm_on_mu(j) ) & - + rt_par_j_plus_1 * exp_mu_dzm(j) - - else - - ! The descending parcel is not entraining. - - rt_par_j = rt_par_j_plus_1 - - endif - - ! Include effects of latent heating on Lscale_down - ! Use thermodynamic formula of Bougeault 1981 JAS Vol. 38, 2416 - ! Probably should use properties of bump 1 in Gaussian, not mean!!! - - ! Calculate r_c of the parcel at grid level j based on the values of - ! theta_l of the parcel and r_t of the parcel at grid level j. - tl_par_j = thl_par_j*exner(j) - if ( l_sat_mixrat_lookup ) then - rsl_par_j = sat_mixrat_liq_lookup( p_in_Pa(j), tl_par_j ) - else - rsl_par_j = sat_mixrat_liq( p_in_Pa(j), tl_par_j ) - end if - ! SD's beta (eqn. 8) - beta_par_j = ep*(Lv/(Rd*tl_par_j))*(Lv/(cp*tl_par_j)) - ! s from Lewellen and Yoh 1993 (LY) eqn. 1 - s_par_j = (rt_par_j-rsl_par_j)/(1._core_rknd+beta_par_j*rsl_par_j) - rc_par_j = max( s_par_j, zero_threshold ) - - ! theta_v of the entraining parcel at grid level j. - thv_par_j = thl_par_j + ep1 * thv_ds(j) * rt_par_j & - + ( Lv / (exner(j)*cp) - ep2 * thv_ds(j) ) * rc_par_j - - ! Lscale_down and CAPE increment. - ! - ! The equation for Lscale_down (where Lscale_down is the absolute - ! value of downward distance) is: - ! - ! INT(z_i-Lscale_down:z_i) g * ( thv_par - thvm ) / thvm dz = em(z_i); - ! - ! where thv_par is theta_v of the parcel, thvm is the mean - ! environmental value of theta_v, z_i is the altitude that the parcel - ! started its descent from, and em is the mean value of TKE at - ! altitude z_i (which gives the parcel its initial downward boost). - ! - ! The increment of CAPE for any two successive vertical levels (z_0 - ! and z_(-1), such that z_(-1) < z_0, and where z_0 is gr%zt(j+1) and - ! z_(-1) is gr%zt(j)) is: - ! - ! CAPE_incr = INT(z_(-1):z_0) g * ( thv_par - thvm ) / thvm dz. - ! - ! Thus, the derivative of CAPE with respect to height is: - ! - ! dCAPE/dz = g * ( thv_par - thvm ) / thvm. - ! - ! A purely trapezoidal rule is used between levels z_(-1) and z_0, - ! such that dCAPE/dz is evaluated at levels z_(-1) and z_0, and is - ! considered to vary linearly at all altitudes z_(-1) <= z <= z_0. - ! Thus, dCAPE/dz is considered to be of the form: - ! A * (z-zo) + dCAPE/dz|_(z_0), where - ! A = ( dCAPE/dz|_(z_(-1)) - dCAPE/dz|_(z_0) ) / ( z_(-1) - z_0 ). - ! - ! The integral is evaluated to find the CAPE increment between two - ! successive vertical levels. The result either adds to or depletes - ! from the total amount of energy that keeps the parcel descending. - - dCAPE_dz_j = ( grav/thvm(j) ) * ( thv_par_j - thvm(j) ) - - CAPE_incr = 0.5_core_rknd * ( dCAPE_dz_j + dCAPE_dz_j_plus_1 ) / gr%invrs_dzm(j) - - if ( tke_i - CAPE_incr > 0.0_core_rknd ) then - - ! The total amount of CAPE increment has not exhausted the initial - ! TKE (plus any additions by CAPE increments due to downward - ! buoyancy) that boosted and carried the parcel downward. The - ! thickness of the full grid level is added to Lscale_down. - - Lscale_down(i) = Lscale_down(i) + gr%zt(j+1) - gr%zt(j) - - else - - ! The total amount of CAPE increment has exhausted the initial TKE - ! (plus any additions by CAPE increments due to downward buoyancy) - ! that boosted and carried the parcel downward. Add the thickness - ! z_0 - z (where z_(-1) <= z < z_0) to Lscale_down. The - ! calculation of Lscale_down is complete. - - if ( dCAPE_dz_j == dCAPE_dz_j_plus_1 ) then - - ! Special case where dCAPE/dz|_(z_(-1)) - dCAPE/dz|_(z_0) = 0, - ! thus making factor A (above) equal to 0. Find the remaining - ! distance z_0 - z that it takes to exhaust the remaining TKE - ! (tke_i). - - Lscale_down(i) & - = Lscale_down(i) & - + ( tke_i / dCAPE_dz_j ) - - else - - ! Case used for most scenarios where dCAPE/dz|_(z_(-1)) - ! /= dCAPE/dz|_(z_0), thus making factor A /= 0. Find the - ! remaining distance z_0 - z that it takes to exhaust the - ! remaining TKE (tke_i), using the quadratic formula (only the - ! negative (-) root works in this scenario -- however, the - ! negative (-) root is divided by another negative (-) factor, - ! which results in an overall plus (+) sign in front of the - ! square root term in the equation below). - - Lscale_down(i) & - = Lscale_down(i) & - + ( - dCAPE_dz_j_plus_1 / & - ( dCAPE_dz_j - dCAPE_dz_j_plus_1 ) ) & - / gr%invrs_dzm(j) & - + sqrt( dCAPE_dz_j_plus_1**2 & - + 2.0_core_rknd * tke_i * gr%invrs_dzm(j) & - * ( dCAPE_dz_j - dCAPE_dz_j_plus_1 ) ) & - / ( dCAPE_dz_j - dCAPE_dz_j_plus_1 ) & - / gr%invrs_dzm(j) - - endif - - endif - - ! Reset values for use during the next vertical level down. - - thl_par_j_plus_1 = thl_par_j - rt_par_j_plus_1 = rt_par_j - dCAPE_dz_j_plus_1 = dCAPE_dz_j - - tke_i = tke_i - CAPE_incr - j = j - 1 - - enddo - - ! Make Lscale_down nonlocal - ! - ! This code makes the value of Lscale_down nonlocal. Thus, if a parcel - ! starting from a higher altitude can descend to altitude - ! Lscale_down_min_alt, then a parcel starting from a lower altitude - ! should also be able to descend to at least altitude - ! Lscale_down_min_alt, even if the local result of Lscale_down for the - ! parcel that started at a lower altitude is not sufficient for the - ! parcel to reach altitude Lscale_down_min_alt. - ! - ! For example, if it was found that a parcel starting at an altitude of - ! 1100 m. descended to an altitude of 100 m. (an Lscale_down value of - ! 1000 m.), then a parcel starting at an altitude of 1000 m. should also - ! be able to descend to an altitude of at least 100 m. If Lscale_down - ! was found to be only 800 m. for the parcel starting at 1000 m. - ! (resulting in the parcel only being able to descend to an altitude of - ! 200 m.), then this code will overwrite the 800 m. value with a - ! Lscale_down value of 900 m. (so that the parcel reaches an altitude of - ! 100 m.). - ! - ! This feature insures that the profile of Lscale_down will be very - ! smooth, thus reducing numerical instability in the model. - - Lscale_down_min_alt = min( Lscale_down_min_alt, gr%zt(i)-Lscale_down(i) ) - - if ( (gr%zt(i)-Lscale_down(i)) > Lscale_down_min_alt ) then - Lscale_down(i) = gr%zt(i) - Lscale_down_min_alt - endif - - enddo - - - !!!!! Compute Lscale for every vertical level. - - do i = 2, gr%nz, 1 - - ! The equation for Lscale is: - ! - ! Lscale = sqrt( Lscale_up * Lscale_down ). - - ! Make lminh a linear function starting at value lmin at the bottom - ! and going to zero at 500 meters in altitude. - ! -dschanen 27 April 2007 - if( l_implemented ) then - ! Within a host model, increase mixing length in 500 m layer above *ground* - lminh = max( zero_threshold, Lscale_sfclyr_depth - (gr%zt(i) - gr%zm(1)) ) & - * ( lmin / Lscale_sfclyr_depth ) - else - ! In standalone mode, increase mixing length in 500 m layer above *mean sea level* - lminh = max( zero_threshold, Lscale_sfclyr_depth - gr%zt(i) ) & - * ( lmin / Lscale_sfclyr_depth ) - end if - - Lscale_up(i) = max( lminh, Lscale_up(i) ) - Lscale_down(i) = max( lminh, Lscale_down(i) ) - - Lscale(i) = sqrt( Lscale_up(i)*Lscale_down(i) ) - - enddo - - ! Set the value of Lscale at the upper and lower boundaries. - Lscale(1) = Lscale(2) - Lscale(gr%nz) = Lscale(gr%nz-1) - - ! Vince Larson limited Lscale to allow host - ! model to take over deep convection. 13 Feb 2008. - - !Lscale = min( Lscale, 1e5 ) - Lscale = min( Lscale, Lscale_max ) - - if( clubb_at_least_debug_level( 2 ) ) then - - ! Ensure that the output from this subroutine is valid. - call length_check( Lscale, Lscale_up, Lscale_down, err_code_Lscale ) - ! Joshua Fasching January 2008 - - ! Error Reporting - ! Joshua Fasching February 2008 - - if ( fatal_error( err_code_Lscale ) ) then - - write(fstderr,*) "Errors in length subroutine" - - write(fstderr,*) "Intent(in)" - - write(fstderr,*) "thvm = ", thvm - write(fstderr,*) "thlm = ", thlm - write(fstderr,*) "rtm = ", rtm - write(fstderr,*) "em = ", em - write(fstderr,*) "exner = ", exner - write(fstderr,*) "p_in_Pa = ", p_in_Pa - write(fstderr,*) "thv_ds = ", thv_ds - - write(fstderr,*) "Intent(out)" - - write(fstderr,*) "Lscale = ", Lscale - write(fstderr,*) "Lscale_up = ", Lscale_up - - ! Overwrite the last error code with this new fatal error - err_code = err_code_Lscale - - endif ! Fatal error - - endif ! clubb_debug_level - - return - - end subroutine compute_length - -!=============================================================================== - -end module crmx_mixing_length diff --git a/src/physics/spcam/crm/CLUBB/crmx_model_flags.F90 b/src/physics/spcam/crm/CLUBB/crmx_model_flags.F90 deleted file mode 100644 index b3fdc118f7..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_model_flags.F90 +++ /dev/null @@ -1,401 +0,0 @@ -!=============================================================================== -! $Id: model_flags.F90 6148 2013-04-08 21:45:15Z storer@uwm.edu $ - -module crmx_model_flags - -! Description: -! Various model options that can be toggled off and on as desired. - -! References: -! None -!------------------------------------------------------------------------------- - - implicit none - - public :: setup_model_flags, read_model_flags_from_file, setup_configurable_model_flags, & - get_configurable_model_flags, write_model_flags_to_file - - private ! Default Scope - - logical, parameter, public :: & - l_hyper_dfsn = .false., & ! 4th-order hyper-diffusion - l_pos_def = .false., & ! Flux limiting pos. def. scheme on rtm - l_hole_fill = .true., & ! Hole filling pos. def. scheme on wp2,up2,rtp2,etc - l_clip_semi_implicit = .false., & ! Semi-implicit clipping scheme on wpthlp and wprtp - l_clip_turb_adv = .false., & ! Corrects thlm/rtm when w'th_l'/w'r_t' is clipped - l_gmres = .false., & ! Use GMRES iterative solver rather than LAPACK - l_sat_mixrat_lookup = .false. ! Use a lookup table for mixing length - ! saturation vapor pressure calculations - - logical, parameter, public :: & -#ifdef BYTESWAP_IO - l_byteswap_io = .true., & ! Don't use the native byte ordering in GrADS output -#else - l_byteswap_io = .false., & ! Use the native byte ordering in GrADS output -#endif - l_gamma_Skw = .true. ! Use a Skw dependent gamma parameter - - logical, parameter, public :: & - l_use_boussinesq = .false. ! Flag to use the Boussinesq form of the - ! predictive equations. The predictive - ! equations are anelastic by default. - - logical, parameter, public :: & - l_use_precip_frac = .false. ! Flag to use precipitation fraction in KK - ! microphysics. The precipitation fraction - ! is automatically set to 1 when this flag - ! is turned off. - - logical, parameter, public :: & - l_morr_xp2_mc_tndcy = .false. !Flag to include the effects of rain evaporation - !on rtp2 and thlp2. The moister (rt1 or rt2) - !and colder (thl1 or thl2) will be fed into - !the morrison micro, and rain evaporation will - !be allowed to increase variances - - - ! These are the integer constants that represent the various saturation - ! formulas. To add a new formula, add an additional constant here, - ! add the logic to check the strings for the new formula in clubb_core and - ! this module, and add logic in saturation to call the proper function-- - ! the control logic will be based on these named constants. - - integer, parameter, public :: & - saturation_bolton = 1, & ! Constant for Bolton approximations of saturation - saturation_gfdl = 2, & ! Constant for the GFDL approximation of saturation - saturation_flatau = 3 ! Constant for Flatau approximations of saturation - - !----------------------------------------------------------------------------- - ! Options that can be changed at runtime - ! The default values are chosen below and overwritten if desired by the user - !----------------------------------------------------------------------------- - - ! These flags determine whether we want to use an upwind differencing approximation - ! rather than a centered differencing for turbulent or mean advection terms. - ! wpxp_ta affects wprtp, wpthlp, & wpsclrp - ! xpyp_ta affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, & sclrpthlp - ! xm_ma affects rtm, thlm, sclrm, um and vm. - logical, public :: & - l_upwind_wpxp_ta = .false., & - l_upwind_xpyp_ta = .true., & - l_upwind_xm_ma = .true. - -!$omp threadprivate(l_upwind_wpxp_ta, l_upwind_xpyp_ta, l_upwind_xm_ma) - - logical, public :: & - l_quintic_poly_interp = .false. ! Use a quintic polynomial in mono_cubic_interp - -!$omp threadprivate(l_quintic_poly_interp) - - - logical, public :: & - l_uv_nudge = .false., & ! For wind speed nudging. - Michael Falk - l_rtm_nudge = .false., & ! For rtm nudging - l_tke_aniso = .true. ! For anisotropic turbulent kinetic energy, - ! i.e. TKE = 1/2 (u'^2 + v'^2 + w'^2) -! OpenMP directives. -!$omp threadprivate(l_uv_nudge, l_tke_aniso, l_rtm_nudge) - - ! Use 2 calls to pdf_closure and the trapezoidal rule to compute the - ! varibles that are output from high order closure - logical, private :: & - l_vert_avg_closure = .true. -!$omp threadprivate(l_vert_avg_closure) - - ! These are currently set based on l_vert_avg_closure - logical, public :: & - l_trapezoidal_rule_zt = .true., & ! If true, the trapezoidal rule is called for - ! the thermodynamic-level variables output - ! from pdf_closure. - l_trapezoidal_rule_zm = .true., & ! If true, the trapezoidal rule is called for - ! three momentum-level variables - wpthvp, - ! thlpthvp, and rtpthvp - output from pdf_closure. - l_call_pdf_closure_twice = .true., & ! This logical flag determines whether or not to - ! call subroutine pdf_closure twice. If true, - ! pdf_closure is called first on thermodynamic levels - ! and then on momentum levels so that each variable is - ! computed on its native level. If false, pdf_closure - ! is only called on thermodynamic levels, and variables - ! which belong on momentum levels are interpolated. - l_single_C2_Skw = .false. ! Use a single Skewness dependent C2 for rtp2, thlp2, and rtpthlp - -!$omp threadprivate(l_trapezoidal_rule_zt, l_trapezoidal_rule_zm, & -!$omp l_call_pdf_closure_twice, l_single_C2_Skw) - - logical, public :: & - l_standard_term_ta = .false. ! Use the standard discretization for the - ! turbulent advection terms. Setting to - ! .false. means that a_1 and a_3 are pulled - ! outside of the derivative in advance_wp2_wp3_module.F90 - ! and in advance_xp2_xpyp_module.F90. -!$omp threadprivate(l_standard_term_ta) - - ! Use to determine whether a host model has already applied the surface flux, - ! to avoid double counting. - logical, public :: & - l_host_applies_sfc_fluxes = .false. - -!$omp threadprivate(l_host_applies_sfc_fluxes) - - ! Use cloud_cover and rcm_in_layer to help boost cloud_frac and rcm to help increase cloudiness - ! at coarser grid resolutions. - logical, public :: & - l_use_cloud_cover = .true. -!$omp threadprivate(l_use_cloud_cover) - - integer, public :: & - saturation_formula = saturation_flatau ! Integer that stores the saturation formula to be used - -!$omp threadprivate(saturation_formula) - - ! See clubb:ticket:514 for details - logical, public :: & - l_diagnose_correlations, & ! Diagnose correlations instead of using fixed ones - l_calc_w_corr ! Calculate the correlations between w and the hydrometeors - -!$omp threadprivate(l_diagnose_correlations, l_calc_w_corr) - -#ifdef GFDL - logical, public :: & - I_sat_sphum ! h1g, 2010-06-15 -#endif - - namelist /configurable_model_flags/ & - l_upwind_wpxp_ta, l_upwind_xpyp_ta, l_upwind_xm_ma, l_quintic_poly_interp, & - l_tke_aniso, l_vert_avg_closure, l_single_C2_Skw, l_standard_term_ta, & - l_use_cloud_cover - - contains - -!=============================================================================== - subroutine setup_model_flags & - ( l_host_applies_sfc_fluxes_in, & - l_uv_nudge_in, saturation_formula_in & -#ifdef GFDL - , I_sat_sphum_in & ! h1g, 2010-06-15 -#endif - ) - -! Description: -! Setup flags that influence the numerics, etc. of CLUBB core - -! References: -! None -!------------------------------------------------------------------------------- - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - implicit none - - ! External - intrinsic :: trim - - ! Input Variables - logical, intent(in) :: & - l_host_applies_sfc_fluxes_in, & - l_uv_nudge_in - - character(len=*), intent(in) :: & - saturation_formula_in - -#ifdef GFDL - logical, intent(in) :: & - I_sat_sphum_in ! h1g, 2010-06-15 -#endif - - !---- Begin Code ---- - - ! Logicals - - l_uv_nudge = l_uv_nudge_in - - l_host_applies_sfc_fluxes = l_host_applies_sfc_fluxes_in - - ! Integers - - ! Set up the saturation formula value - select case ( trim( saturation_formula_in ) ) - case ( "bolton", "Bolton" ) - saturation_formula = saturation_bolton - - case ( "flatau", "Flatau" ) - saturation_formula = saturation_flatau - - case ( "gfdl", "GFDL" ) - saturation_formula = saturation_gfdl - - ! Add new saturation formulas after this. - end select - -#ifdef GFDL - I_sat_sphum = I_sat_sphum_in ! h1g, 2010-06-15 -#endif - return - end subroutine setup_model_flags - -!=============================================================================== - subroutine read_model_flags_from_file( iunit, filename ) - -! Description: -! Read in some of the model flags of interest from a namelist file. If the -! variable isn't in the file it will just be the default value. -! -! References: -! None -!------------------------------------------------------------------------------- - - implicit none - - integer, intent(in) :: & - iunit ! File I/O unit to use - - character(len=*), intent(in) :: & - filename ! Name of the file with the namelist - - ! Read the namelist - open(unit=iunit, file=filename, status='old', action='read') - - read(unit=iunit, nml=configurable_model_flags) - - close(unit=iunit) - - if ( l_vert_avg_closure ) then - l_trapezoidal_rule_zt = .true. - l_trapezoidal_rule_zm = .true. - l_call_pdf_closure_twice = .true. - else - l_trapezoidal_rule_zt = .false. - l_trapezoidal_rule_zm = .false. - l_call_pdf_closure_twice = .false. - end if - - return - end subroutine read_model_flags_from_file - -!=============================================================================== - subroutine write_model_flags_to_file( iunit, filename ) - -! Description: -! Write a new namelist for the configurable model flags -! -! References: -! None -!------------------------------------------------------------------------------- - - implicit none - - integer, intent(in) :: & - iunit ! File I/O unit to use - - character(len=*), intent(in) :: & - filename ! Name of the file with the namelist - - ! Read the namelist - open(unit=iunit, file=filename, status='unknown', action='write') - - write(unit=iunit, nml=configurable_model_flags) - - close(unit=iunit) - - return - end subroutine write_model_flags_to_file -!=============================================================================== - subroutine setup_configurable_model_flags & - ( l_upwind_wpxp_ta_in, l_upwind_xpyp_ta_in, & - l_upwind_xm_ma_in, l_quintic_poly_interp_in, & - l_vert_avg_closure_in, & - l_single_C2_Skw_in, l_standard_term_ta_in, & - l_tke_aniso_in, l_use_cloud_cover_in ) - -! Description: -! Set a model flag based on the input arguments for the purposes of trying -! all possible combinations in the clubb_tuner. -! -! References: -! None -!------------------------------------------------------------------------------- - - implicit none - - ! Input Variables - logical, intent(in) :: & - l_upwind_wpxp_ta_in, & ! Model flags - l_upwind_xpyp_ta_in, & - l_upwind_xm_ma_in, & - l_quintic_poly_interp_in, & - l_vert_avg_closure_in, & - l_single_C2_Skw_in, & - l_standard_term_ta_in, & - l_tke_aniso_in, & - l_use_cloud_cover_in - - ! ---- Begin Code ---- - - l_upwind_wpxp_ta = l_upwind_wpxp_ta_in - l_upwind_xpyp_ta = l_upwind_xpyp_ta_in - l_upwind_xm_ma = l_upwind_xm_ma_in - l_quintic_poly_interp = l_quintic_poly_interp_in - l_vert_avg_closure = l_vert_avg_closure_in - l_single_C2_Skw = l_single_C2_Skw_in - l_standard_term_ta = l_standard_term_ta_in - l_tke_aniso = l_tke_aniso_in - l_use_cloud_cover = l_use_cloud_cover_in - - if ( l_vert_avg_closure ) then - l_trapezoidal_rule_zt = .true. - l_trapezoidal_rule_zm = .true. - l_call_pdf_closure_twice = .true. - else - l_trapezoidal_rule_zt = .false. - l_trapezoidal_rule_zm = .false. - l_call_pdf_closure_twice = .false. - end if - - return - end subroutine setup_configurable_model_flags - -!=============================================================================== - subroutine get_configurable_model_flags & - ( l_upwind_wpxp_ta_out, l_upwind_xpyp_ta_out, & - l_upwind_xm_ma_out, l_quintic_poly_interp_out, & - l_vert_avg_closure_out, & - l_single_C2_Skw_out, l_standard_term_ta_out, & - l_tke_aniso_out, l_use_cloud_cover_out ) - -! Description: -! Get the current model flags. -! -! References: -! None -!------------------------------------------------------------------------------- - - implicit none - - ! Input Variables - logical, intent(out) :: & - l_upwind_wpxp_ta_out, & ! Model flags - l_upwind_xpyp_ta_out, & - l_upwind_xm_ma_out, & - l_quintic_poly_interp_out, & - l_vert_avg_closure_out, & - l_single_C2_Skw_out, & - l_standard_term_ta_out, & - l_tke_aniso_out, & - l_use_cloud_cover_out - - ! ---- Begin Code ---- - - l_upwind_wpxp_ta_out = l_upwind_wpxp_ta - l_upwind_xpyp_ta_out = l_upwind_xpyp_ta - l_upwind_xm_ma_out = l_upwind_xm_ma - l_quintic_poly_interp_out = l_quintic_poly_interp - l_vert_avg_closure_out = l_vert_avg_closure - l_single_C2_Skw_out = l_single_C2_Skw - l_standard_term_ta_out = l_standard_term_ta - l_tke_aniso_out = l_tke_aniso - l_use_cloud_cover_out = l_use_cloud_cover - - return - end subroutine get_configurable_model_flags - -end module crmx_model_flags diff --git a/src/physics/spcam/crm/CLUBB/crmx_mono_flux_limiter.F90 b/src/physics/spcam/crm/CLUBB/crmx_mono_flux_limiter.F90 deleted file mode 100644 index 6ce1f60ece..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_mono_flux_limiter.F90 +++ /dev/null @@ -1,1838 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: mono_flux_limiter.F90 5715 2012-02-14 00:36:17Z dschanen@uwm.edu $ -!=============================================================================== -module crmx_mono_flux_limiter - - implicit none - - private ! Default Scope - - public :: monotonic_turbulent_flux_limit, & - calc_turb_adv_range - - private :: mfl_xm_lhs, & - mfl_xm_rhs, & - mfl_xm_solve, & - mean_vert_vel_up_down - - ! Private named constants to avoid string comparisons - ! NOTE: These values must match the values for xm_wpxp_thlm - ! and xm_wpxp_rtm given in advance_xm_wpxp_module! - integer, parameter, private :: & - mono_flux_thlm = 1, & ! Named constant for thlm mono_flux calls - mono_flux_rtm = 2 ! Named constant for rtm mono_flux calls - - contains - - !============================================================================= - subroutine monotonic_turbulent_flux_limit( solve_type, dt, xm_old, & - xp2, wm_zt, xm_forcing, & - rho_ds_zm, rho_ds_zt, & - invrs_rho_ds_zm, invrs_rho_ds_zt, & - xp2_threshold, l_implemented, & - low_lev_effect, high_lev_effect, & - xm, xm_tol, wpxp, err_code ) - - ! Description: - ! Limits the value of w'x' and corrects the value of xm when the xm turbulent - ! advection term is not monotonic. A monotonic turbulent advection scheme - ! will not create new extrema for variable x, based only on turbulent - ! advection (not considering mean advection and xm forcings). - ! - ! Montonic turbulent advection - ! ---------------------------- - ! - ! A monotonic turbulent advection scheme does not allow new extrema for - ! variable x to be created (by means of turbulent advection). In a - ! monotonic turbulent advection scheme, when only the effects of turbulent - ! advection are considered (neglecting forcings and mean advection), the - ! value of variable x at a given point should not increase above the - ! greatest value of variable x at nearby points, nor decrease below the - ! smallest value of variable x at nearby points. Nearby points are points - ! that are close enough to the given point so that the value of variable x - ! at the given point is effected by the values of variable x at the nearby - ! points by means of transfer by turbulent winds during a time step. Again, - ! a monotonic scheme insures that advection only transfers around values of - ! variable x and does not create new extrema for variable x. A monotonic - ! turbulent advection scheme is useful because the turbulent advection term - ! (w'x') may go numerically unstable, resulting in large instabilities in - ! the mean field (xm). A monotonic turbulent advection scheme will limit - ! the change in xm, and also in w'x'. - ! - ! The following example illustrates the concept of monotonic turbulent - ! advection. Three successive vertical grid levels are shown (k-1, k, and - ! k+1). Three point values of theta-l are listed at every vertical grid - ! level. All three vertical levels have a mean theta-l (thlm) of 288.0 K. - ! A circulation is occuring (in the direction of the arrows) in the vertical - ! (w wind component) and in the horizontal (u and/or v wind components), - ! such that the mean value of vertical velocity (wmm) is 0, but there is a - ! turbulent component such that w'^2 > 0. - ! - ! level = k+1 || --- 287.0 K --- 288.0 K --- 289.0 K --- || thlm = 288.0 - ! || / \--------------------->| || - ! || | | || wmm = 0; wp2 > 0 - ! || |<---------------------\ / || - ! level = k || --- 288.0 K --- 288.0 K --- 288.0 K --- || thlm = 288.0 - ! || |<---------------------/ \ || - ! || | | || wmm = 0; wp2 > 0 - ! || \ /--------------------->| || - ! level = k-1 || --- 287.5 K --- 288.0 K --- 288.5 K --- || thlm = 288.0 - ! - ! Neglecting any contributions from thlm forcings (effects of radiation, - ! microphysics, large-scale horizontal advection, etc.), the values of - ! theta-l as shown will be altered by only turbulent advection. As a side - ! note, the contribution of mean advection will be 0 since wmm = 0. The - ! diagram shows that the value of theta-l at the point on the right at level - ! k will increase. However, the values of theta-l at the other two points - ! at level k will remain the same. Thus, the value of thlm at level k will - ! become greater than 288.0 K. In the same manner, the values of thlm at - ! the other two vertical levels (k-1 and k+1) will become smaller than - ! 288.0 K. However, the monotonic turbulent advection scheme insures that - ! any theta-l point value cannot become smaller than the smallest theta-l - ! point value (287.0 K) or larger than the largest theta-l point value - ! (289.0 K). Since all theta-l point values must fall between 287.0 K and - ! 289.0 K, the level averages of theta-l (thlm) must fall between 287.0 K - ! and 289.0 K. Thus, any values of the turbulent flux, w'th_l', that would - ! cause thlm to rise above 289.0 K or fall below 287.0 K, not considering - ! the effect of other terms on thlm (such as forcings), are faulty and need - ! to be limited appropriately. The values of thlm also need to be corrected - ! appropriately. - ! - ! Formula for the limitation of w'x' and xm - ! ----------------------------------------- - ! - ! The equation for change in the mean field, xm, over time is: - ! - ! d(xm)/dt = -w*d(xm)/dz - (1/rho_ds) * d( rho_ds * w'x' )/dz + xm_forcing; - ! - ! where w*d(xm)/dz is the mean advection component, - ! (1/rho_ds) * d( rho_ds * w'x' )/dz is the turbulent advection component, - ! and xm_forcing is the xm forcing component. The d(xm)/dt time tendency - ! component is discretized as: - ! - ! xm(k,)/dt = xm(k,)/dt - w*d(xm)/dz - ! - (1/rho_ds) * d( rho_ds * w'x' )/dz + xm_forcing. - ! - ! The value of xm after it has been advanced to timestep (t+1) must be in an - ! appropriate range based on the values of xm at timestep (t), the amount of - ! xm forcings applied over the ensuing time step, and the amount of mean - ! advection applied over the ensuing time step. This is exactly the same - ! thing as saying that the value of xm(k,), with the contribution of - ! turbulent advection included, must fall into a certain range based on the - ! value of xm(k,) without the contribution of the turbulent advection - ! component over the last time step. The following inequality is used to - ! limit the value of xm(k,): - ! - ! MIN{ xm(k-1,) + dt*xm_forcing(k-1) - dt*wm_zt(k-1)*d(xm)/dz|_(k-1) - ! - x_max_dev_low(k-1,), - ! xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) - ! - x_max_dev_low(k,), - ! xm(k+1,) + dt*xm_forcing(k+1) - dt*wm_zt(k+1)*d(xm)/dz|_(k+1) - ! - x_max_dev_low(k+1,) } - ! <= xm(k,) <= - ! MAX{ xm(k-1,) + dt*xm_forcing(k-1) - dt*wm_zt(k-1)*d(xm)/dz|_(k-1) - ! + x_max_dev_high(k-1,), - ! xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) - ! + x_max_dev_high(k,), - ! xm(k+1,) + dt*xm_forcing(k+1) - dt*wm_zt(k+1)*d(xm)/dz|_(k+1) - ! + x_max_dev_high(k+1,) }; - ! - ! where x_max_dev_low is the absolute value of the deviation from the mean - ! of the smallest point value of variable x at the given vertical level and - ! timestep; and where x_max_dev_high is the deviation from the mean of the - ! largest point value of variable x at the given vertical level and - ! timestep. For example, at vertical level (k+1) and timestep (t): - ! - ! x_max_dev_low(k+1,) = | MIN( x(k+1,) ) - xm(k+1,) |; - ! x_max_dev_high(k+1,) = MAX( x(k+1,) ) - xm(k+1,). - ! - ! The inequality shown above only takes into account values from the central - ! level, one-level-below the central level, and one-level-above the central - ! level. This is the minimal amount of vertical levels that can have their - ! values taken into consideration. Any vertical level that can have it's - ! properties advect to the given level during the course of a single time - ! step can be taken into consideration. However, only three levels will be - ! considered in this example for the sake of simplicity. - ! - ! The inequality will be written in more simple terms: - ! - ! xm_lower_lim_allowable(k) <= xm(k,) <= xm_upper_lim_allowable(k). - ! - ! The inequality can now be related to the turbulent flux, w'x'(k,), - ! through a substitution that is made for xm(k,), such that: - ! - ! xm(k,) = xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) - ! - dt * (1/rho_ds) * d( rho_ds * w'x' )/dz|_(k). - ! - ! The inequality becomes: - ! - ! xm_lower_lim_allowable(k) - ! <= - ! xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) - ! - dt * (1/rho_ds) * d( rho_ds * w'x' )/dz|_(k) - ! <= - ! xm_upper_lim_allowable(k). - ! - ! The inequality is rearranged, and the turbulent advection term, - ! d(w'x')/dz, is discretized: - ! - ! xm_lower_lim_allowable(k) - ! - [ xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) ] - ! <= - ! - dt * (1/rho_ds_zt(k)) - ! * invrs_dzt(k) - ! * [ rho_ds_zm(k) * w'x'(k,) - ! - rho_ds_zm(k-1) * w'x'(k-1,) ] - ! <= - ! xm_upper_lim_allowable(k) - ! - [ xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) ]; - ! - ! where invrs_dzt(k) = 1 / ( zm(k) - zm(k-1) ). - ! - ! Multiplying the inequality by -rho_ds_zt(k)/(dz*invrs_dzt(k)): - ! - ! rho_ds_zt(k)/(dz*invrs_dzt(k)) - ! * [ xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) - ! - xm_lower_lim_allowable(k) ] - ! >= - ! rho_ds_zm(k) * w'x'(k,) - rho_ds_zm(k-1) * w'x'(k-1,) - ! >= - ! rho_ds_zt(k)/(dz*invrs_dzt(k)) - ! * [ xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) - ! - xm_upper_lim_allowable(k) ]. - ! - ! Note: The inequality symbols have been flipped due to multiplication - ! involving a (-) sign. - ! - ! Adding rho_ds_zm(k-1) * w'x'(k-1,) to the inequality: - ! - ! rho_ds_zt(k)/(dz*invrs_dzt(k)) - ! * [ xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) - ! - xm_lower_lim_allowable(k) ] - ! + rho_ds_zm(k-1) * w'x'(k-1,) - ! >= rho_ds_zm(k) * w'x'(k,) >= - ! rho_ds_zt(k)/(dz*invrs_dzt(k)) - ! * [ xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) - ! - xm_upper_lim_allowable(k) ] - ! + rho_ds_zm(k-1) * w'x'(k-1,). - ! - ! The inequality is then rearranged to be based around w'x'(k,): - ! - ! (1/rho_ds_zm(k)) - ! * [ rho_ds_zt(k)/(dt*invrs_dzt(k)) - ! * { xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) - ! - xm_lower_lim_allowable(k) } - ! + rho_ds_zm(k-1) * w'x'(k-1,) ] - ! >= w'x'(k,) >= - ! (1/rho_ds_zm(k)) - ! * [ rho_ds_zt(k)/(dt*invrs_dzt(k)) - ! * { xm(k,) + dt*xm_forcing(k) - dt*wm_zt(k)*d(xm)/dz|_(k) - ! - xm_upper_lim_allowable(k) } - ! + rho_ds_zm(k-1) * w'x'(k-1,) ]. - ! - ! The values of w'x' are found on the momentum levels, while the values of - ! xm are found on the thermodynamic levels. Additionally, the values of - ! rho_ds_zm are found on the momentum levels, and the values of rho_ds_zt - ! are found on the thermodynamic levels. The inequality is applied to - ! w'x'(k,) from vertical levels 2 through the second-highest level - ! (gr%nz-1). The value of w'x' at level 1 is a set surface (or lowest - ! level) flux. The value of w'x' at the highest level is also a set value, - ! and therefore is not altered. - ! - ! Approximating maximum and minimum values of x at any given vertical level - ! ------------------------------------------------------------------------- - ! - ! The CLUBB code provides means, variances, and covariances for certain - ! variables at all vertical levels. However, there is no way to find the - ! maximum or minimum point value of any variable on any vertical level. - ! Without that information, x_max_dev_low and x_max_dev_high can't be found, - ! and the inequality above is useless. However, there is a way to - ! approximate the maximum and minimum point values at any given vertical - ! level. The maximum and minimum point values can be approximated through - ! the use of the variance, x'^2. - ! - ! Just as the mean value of x, which is xm, and the turbulent flux of x, - ! which is w'x', are known, so is the variance of x, which is x'^2. The - ! standard deviation of x is the square root of the variance of x. The - ! distribution of x along the horizontal plane (at vertical level k) is - ! approximated to be the sum of two normal (or Gaussian) distributions. - ! Most of the values in a normal distribution are found within 2 standard - ! deviations from the mean. Thus, the maximum point value of x along the - ! horizontal plance at any vertical level can be approximated as: - ! xm + 2*sqrt(x'^2). Likewise, the minimum value of x along the horizontal - ! plane at any vertical level can be approximated as: xm - 2*sqrt(x'^2). - ! - ! The values of x'^2 are found on the momentum levels. The values of xm - ! are found on the thermodynamic levels. Thus, the values of x'^2 are - ! interpolated to the thermodynamic levels in order to find the maximum - ! and minimum point values of variable x. - ! - ! The one downfall of this method is that instabilities can arise in the - ! model where unphysically large values of x'^2 are produced. Thus, this - ! allows for an unphysically large deviation of xm from its values at the - ! previous time step due to turbulent advection. Thus, for purposes of - ! determining the maximum and minimum point values of x, a upper limit - ! is placed on x'^2, in order to limit the standard deviation of x. This - ! limit is only applied in this subroutine, and is not applied to x'^2 - ! elsewhere in the model code. - - ! References: - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr, & ! Variable(s) - zm2zt ! Procedure(s) - - use crmx_constants_clubb, only: & - zero_threshold, & - eps, & - fstderr - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_error_code, only: & - fatal_error, & ! Procedure(s) - clubb_no_error ! Constant - - use crmx_fill_holes, only: & - vertical_integral ! Procedure(s) - - use crmx_stats_type, only: & - stat_begin_update, & ! Procedure(s) - stat_end_update, & - stat_update_var - - use crmx_stats_variables, only: & - zm, & ! Variable(s) - zt, & - iwprtp_mfl, & - irtm_mfl, & - iwpthlp_mfl, & - ithlm_mfl, & - ithlm_old, & - ithlm_without_ta, & - ithlm_mfl_min, & - ithlm_mfl_max, & - irtm_old, & - irtm_without_ta, & - irtm_mfl_min, & - irtm_mfl_max, & - ithlm_enter_mfl, & - ithlm_exit_mfl, & - irtm_enter_mfl, & - irtm_exit_mfl, & - iwpthlp_mfl_min, & - iwpthlp_mfl_max, & - iwpthlp_entermfl, & - iwpthlp_exit_mfl, & - iwprtp_mfl_min, & - iwprtp_mfl_max, & - iwprtp_enter_mfl, & - iwprtp_exit_mfl, & - l_stats_samp - - implicit none - - ! Constant Parameters - - ! Flag for using a semi-implicit, tridiagonal method to solve for xm(t+1) - ! when xm(t+1) needs to be changed. - logical, parameter :: l_mfl_xm_imp_adj = .true. - - ! Input Variables - integer, intent(in) :: & - solve_type ! Variables being solved for. - - real(kind=time_precision), intent(in) :: & - dt ! Model timestep length [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - xm_old, & ! xm at previous time step (thermo. levs.) [units vary] - xp2, & ! x'^2 (momentum levels) [units vary] - wm_zt, & ! w wind component on thermodynamic levels [m/s] - xm_forcing, & ! xm forcings (thermodynamic levels) [units vary] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ moment. levs. [m^3/kg] - invrs_rho_ds_zt ! Inv. dry, static density @ thermo. levs. [m^3/kg] - - real( kind = core_rknd ), intent(in) :: & - xp2_threshold, & ! Lower limit of x'^2 [units vary] - xm_tol ! Lower limit of maxdev [units vary] - - logical, intent(in) :: & - l_implemented ! Flag for CLUBB being implemented in a larger model. - - integer, dimension(gr%nz), intent(in) :: & - low_lev_effect, & ! Index of lowest level that has an effect (for lev. k) - high_lev_effect ! Index of highest level that has an effect (for lev. k) - - ! Input/Output Variables - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - xm, & ! xm at current time step (thermodynamic levels) [units vary] - wpxp ! w'x' (momentum levels) [units vary] - - ! Output Variable - integer, intent(out) :: & - err_code ! Returns an error code in the event of a singular matrix - - ! Local Variables - real( kind = core_rknd ), dimension(gr%nz) :: & - xp2_zt, & ! x'^2 interpolated to thermodynamic levels [units vary] - xm_enter_mfl, & ! xm as it enters the MFL [units vary] - xm_without_ta, & ! Value of xm without turb. adv. contrib. [units vary] - wpxp_net_adjust, & ! Net amount of adjustment needed on w'x' [units vary] - dxm_dt_mfl_adjust ! Rate of change of adjustment to xm [units vary] - - real( kind = core_rknd ), dimension(gr%nz) :: & - min_x_allowable_lev, & ! Smallest usuable value of x at lev k [units vary] - max_x_allowable_lev, & ! Largest usuable value of x at lev k [units vary] - min_x_allowable, & ! Smallest usuable x within k +/- num_levs [units vary] - max_x_allowable, & ! Largest usuable x within k +/- num_levs [units vary] - wpxp_mfl_max, & ! Upper limit on w'x'(k) [units vary] - wpxp_mfl_min ! Lower limit on w'x'(k) [units vary] - - real( kind = core_rknd ) :: & - max_xp2, & ! Maximum allowable x'^2 [units vary] - stnd_dev_x, & ! Standard deviation of x [units vary] - max_dev, & ! Determines approximate upper/lower limit of x [units vary] - m_adv_term, & ! Contribution of mean advection to d(xm)/dt [units vary] - xm_density_weighted, & ! Density weighted xm at domain top [units vary] - xm_adj_coef, & ! Coeffecient to eliminate spikes at domain top [units vary] - xm_vert_integral, & ! Vertical integral of xm [units_vary] - dz ! zm grid spacing at top of domain [m] - - real( kind = core_rknd ), dimension(3,gr%nz) :: & - lhs_mfl_xm ! Left hand side of tridiagonal matrix - - real( kind = core_rknd ), dimension(gr%nz) :: & - rhs_mfl_xm ! Right hand side of tridiagonal matrix equation - - integer :: & - k, km1 ! Array indices - -! integer, parameter :: & -! num_levs = 10 ! Number of levels above and below level k to look for -! ! maxima and minima of variable x. - - integer :: & - low_lev, & ! Lowest level (from level k) to look for x minima and maxima - high_lev ! Highest level (from level k) to look for x minima and maxima - - integer :: & - iwpxp_mfl, & - ixm_mfl - - !--- Begin Code --- - err_code = clubb_no_error ! Initialize to the value for no errors - - ! Default Initialization required due to G95 compiler warning - max_xp2 = 0.0_core_rknd - dz = 0.0_core_rknd - - select case( solve_type ) - case ( mono_flux_rtm ) ! rtm/wprtp - iwpxp_mfl = iwprtp_mfl - ixm_mfl = irtm_mfl - max_xp2 = 5.0e-6_core_rknd - case ( mono_flux_thlm ) ! thlm/wpthlp - iwpxp_mfl = iwpthlp_mfl - ixm_mfl = ithlm_mfl - max_xp2 = 5.0_core_rknd - case default ! passive scalars are involved - iwpxp_mfl = 0 - ixm_mfl = 0 - max_xp2 = 5.0_core_rknd - end select - - - if ( l_stats_samp ) then - call stat_begin_update( iwpxp_mfl, wpxp / real( dt, kind = core_rknd ), zm ) - call stat_begin_update( ixm_mfl, xm / real( dt, kind = core_rknd ), zt ) - endif - if ( l_stats_samp .and. solve_type == mono_flux_thlm ) then - call stat_update_var( ithlm_enter_mfl, xm, zt ) - call stat_update_var( ithlm_old, xm_old, zt ) - call stat_update_var( iwpthlp_entermfl, xm, zm ) - elseif ( l_stats_samp .and. solve_type == mono_flux_rtm ) then - call stat_update_var( irtm_enter_mfl, xm, zt ) - call stat_update_var( irtm_old, xm_old, zt ) - call stat_update_var( iwprtp_enter_mfl, xm, zm ) - endif - - ! Initialize arrays. - wpxp_net_adjust = 0.0_core_rknd - dxm_dt_mfl_adjust = 0.0_core_rknd - - ! Store the value of xm as it enters the mfl - xm_enter_mfl = xm - - ! Interpolate x'^2 to thermodynamic levels. - xp2_zt = max( zm2zt( xp2 ), xp2_threshold ) - - ! Place an upper limit on xp2_zt. - ! For purposes of this subroutine, an upper limit has been placed on the - ! variance, x'^2. This does not effect the value of x'^2 anywhere else in - ! the model code. The upper limit is a reasonable upper limit. This is - ! done to prevent unphysically large standard deviations caused by numerical - ! instabilities in the x'^2 profile. - xp2_zt = min( xp2_zt, max_xp2 ) - - ! Find the maximum and minimum usuable values of variable x at each - ! vertical level. Start from level 2, which is the first level above - ! the ground (or above the model surface). This computation needs to be - ! performed for all vertical levels above the ground (or model surface). - do k = 2, gr%nz, 1 - - km1 = max( k-1, 1 ) - !kp1 = min( k+1, gr%nz ) - - ! Standard deviation is the square root of the variance. - stnd_dev_x = sqrt( xp2_zt(k) ) - - ! Most values are found within +/- 2 standard deviations from the mean. - ! Use +/- 2 standard deviations from the mean as the maximum/minimum - ! values. - ! max_dev = 2.0_core_rknd*stnd_dev_x - - ! Set a minimum on max_dev - max_dev = max(2.0_core_rknd * stnd_dev_x, xm_tol) - - ! Calculate the contribution of the mean advection term: - ! m_adv_term = -wm_zt(k)*d(xm)/dz|_(k). - ! Note: mean advection is not applied to xm at level gr%nz. - !if ( .not. l_implemented .and. k < gr%nz ) then - ! tmp(1:3) = term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k ) - ! m_adv_term = - tmp(1) * xm(kp1) & - ! - tmp(2) * xm(k) & - ! - tmp(3) * xm(km1) - !else - ! m_adv_term = 0.0_core_rknd - !endif - - ! Shut off to avoid using new, possibly corrupt mean advection term - m_adv_term = 0.0_core_rknd - - ! Find the value of xm without the contribution from the turbulent - ! advection term. - ! Note: the contribution of xm_forcing at level gr%nz should be 0. - xm_without_ta(k) = xm_old(k) + real( dt, kind = core_rknd )*xm_forcing(k) & - + real( dt, kind = core_rknd )*m_adv_term - - ! Find the minimum usuable value of variable x at each vertical level. - ! Since variable x must be one of theta_l, r_t, or a scalar, all of - ! which are positive definite quantities, the value must be >= 0. - min_x_allowable_lev(k) & - = max( xm_without_ta(k) - max_dev, zero_threshold ) - - ! Find the maximum usuable value of variable x at each vertical level. - max_x_allowable_lev(k) = xm_without_ta(k) + max_dev - - enddo - - ! Boundary condition on xm_without_ta - k = 1 - xm_without_ta(k) = xm(k) - min_x_allowable_lev(k) = min_x_allowable_lev(k+1) - max_x_allowable_lev(k) = max_x_allowable_lev(k+1) - - ! Find the maximum and minimum usuable values of x that can effect the value - ! of x at level k. Then, find the upper and lower limits of w'x'. Reset - ! the value of w'x' if it is outside of those limits, and store the amount - ! of adjustment that was needed to w'x'. - ! The values of w'x' at level 1 and at level gr%nz are set values and - ! are not altered. - do k = 2, gr%nz-1, 1 - - km1 = max( k-1, 1 ) - - low_lev = max( low_lev_effect(k), 2 ) - high_lev = min( high_lev_effect(k), gr%nz ) - !low_lev = max( k-num_levs, 2 ) - !high_lev = min( k+num_levs, gr%nz ) - - ! Find the smallest value of all relevant level minima for variable x. - min_x_allowable(k) = minval( min_x_allowable_lev(low_lev:high_lev) ) - - ! Find the largest value of all relevant level maxima for variable x. - max_x_allowable(k) = maxval( max_x_allowable_lev(low_lev:high_lev) ) - - ! Find the upper limit for w'x' for a monotonic turbulent flux. - wpxp_mfl_max(k) & - = invrs_rho_ds_zm(k) & - * ( ( rho_ds_zt(k) / (real( dt, kind = core_rknd )*gr%invrs_dzt(k)) ) & - * ( xm_without_ta(k) - min_x_allowable(k) ) & - + rho_ds_zm(km1) * wpxp(km1) ) - - ! Find the lower limit for w'x' for a monotonic turbulent flux. - wpxp_mfl_min(k) & - = invrs_rho_ds_zm(k) & - * ( ( rho_ds_zt(k) / (real( dt, kind = core_rknd )*gr%invrs_dzt(k)) ) & - * ( xm_without_ta(k) - max_x_allowable(k) ) & - + rho_ds_zm(km1) * wpxp(km1) ) - - if ( wpxp(k) > wpxp_mfl_max(k) ) then - - ! This block of print statements can be uncommented for debugging. - !print *, "k = ", k - !print *, "wpxp too large (mfl)" - !print *, "xm(t) = ", xm_old(k) - !print *, "xm(t+1) entering mfl = ", xm(k) - !print *, "xm(t+1) without ta = ", xm_without_ta(k) - !print *, "max x allowable = ", max_x_allowable(k) - !print *, "min x allowable = ", min_x_allowable(k) - !print *, "1/rho_ds_zm(k) = ", invrs_rho_ds_zm(k) - !print *, "rho_ds_zt(k) = ", rho_ds_zt(k) - !print *, "rho_ds_zt(k)*(delta_zt/dt) = ", & - ! real( rho_ds_zt(k) / (dt*gr%invrs_dzt(k)) ) - !print *, "xm without ta - min x allow = ", & - ! xm_without_ta(k) - min_x_allowable(k) - !print *, "rho_ds_zm(km1) = ", rho_ds_zm(km1) - !print *, "wpxp(km1) = ", wpxp(km1) - !print *, "rho_ds_zm(km1) * wpxp(km1) = ", rho_ds_zm(km1) * wpxp(km1) - !print *, "wpxp upper lim = ", wpxp_mfl_max(k) - !print *, "wpxp before adjustment = ", wpxp(k) - - ! Determine the net amount of adjustment needed for w'x'. - wpxp_net_adjust(k) = wpxp_mfl_max(k) - wpxp(k) - - ! Reset the value of w'x' to the upper limit allowed by the - ! monotonic flux limiter. - wpxp(k) = wpxp_mfl_max(k) - - elseif ( wpxp(k) < wpxp_mfl_min(k) ) then - - ! This block of print statements can be uncommented for debugging. - !print *, "k = ", k - !print *, "wpxp too small (mfl)" - !print *, "xm(t) = ", xm_old(k) - !print *, "xm(t+1) entering mfl = ", xm(k) - !print *, "xm(t+1) without ta = ", xm_without_ta(k) - !print *, "max x allowable = ", max_x_allowable(k) - !print *, "min x allowable = ", min_x_allowable(k) - !print *, "1/rho_ds_zm(k) = ", invrs_rho_ds_zm(k) - !print *, "rho_ds_zt(k) = ", rho_ds_zt(k) - !print *, "rho_ds_zt(k)*(delta_zt/dt) = ", & - ! real( rho_ds_zt(k) / (dt*gr%invrs_dzt(k)) ) - !print *, "xm without ta - max x allow = ", & - ! xm_without_ta(k) - max_x_allowable(k) - !print *, "rho_ds_zm(km1) = ", rho_ds_zm(km1) - !print *, "wpxp(km1) = ", wpxp(km1) - !print *, "rho_ds_zm(km1) * wpxp(km1) = ", rho_ds_zm(km1) * wpxp(km1) - !print *, "wpxp lower lim = ", wpxp_mfl_min(k) - !print *, "wpxp before adjustment = ", wpxp(k) - - ! Determine the net amount of adjustment needed for w'x'. - wpxp_net_adjust(k) = wpxp_mfl_min(k) - wpxp(k) - - ! Reset the value of w'x' to the lower limit allowed by the - ! monotonic flux limiter. - wpxp(k) = wpxp_mfl_min(k) - - ! This block of code can be uncommented for debugging. - !else - ! - ! ! wpxp(k) is okay. - ! if ( wpxp_net_adjust(km1) /= 0.0_core_rknd ) then - ! print *, "k = ", k - ! print *, "wpxp is in an acceptable range (mfl)" - ! print *, "xm(t) = ", xm_old(k) - ! print *, "xm(t+1) entering mfl = ", xm(k) - ! print *, "xm(t+1) without ta = ", xm_without_ta(k) - ! print *, "max x allowable = ", max_x_allowable(k) - ! print *, "min x allowable = ", min_x_allowable(k) - ! print *, "1/rho_ds_zm(k) = ", invrs_rho_ds_zm(k) - ! print *, "rho_ds_zt(k) = ", rho_ds_zt(k) - ! print *, "rho_ds_zt(k)*(delta_zt/dt) = ", & - ! real( rho_ds_zt(k) / (dt*gr%invrs_dzt(k)) ) - ! print *, "xm without ta - min x allow = ", & - ! xm_without_ta(k) - min_x_allowable(k) - ! print *, "xm without ta - max x allow = ", & - ! xm_without_ta(k) - max_x_allowable(k) - ! print *, "rho_ds_zm(km1) = ", rho_ds_zm(km1) - ! print *, "wpxp(km1) = ", wpxp(km1) - ! print *, "rho_ds_zm(km1) * wpxp(km1) = ", & - ! rho_ds_zm(km1) * wpxp(km1) - ! print *, "wpxp upper lim = ", wpxp_mfl_max(k) - ! print *, "wpxp lower lim = ", wpxp_mfl_min(k) - ! print *, "wpxp (stays the same) = ", wpxp(k) - ! endif - ! - endif - - enddo - - ! Boundary conditions - min_x_allowable(1) = 0._core_rknd - max_x_allowable(1) = 0._core_rknd - - min_x_allowable(gr%nz) = 0._core_rknd - max_x_allowable(gr%nz) = 0._core_rknd - - wpxp_mfl_min(1) = 0._core_rknd - wpxp_mfl_max(1) = 0._core_rknd - - wpxp_mfl_min(gr%nz) = 0._core_rknd - wpxp_mfl_max(gr%nz) = 0._core_rknd - - if ( l_stats_samp .and. solve_type == mono_flux_thlm ) then - call stat_update_var( ithlm_without_ta, xm_without_ta, zt ) - call stat_update_var( ithlm_mfl_min, min_x_allowable, zt ) - call stat_update_var( ithlm_mfl_max, max_x_allowable, zt ) - call stat_update_var( iwpthlp_mfl_min, wpxp_mfl_min, zm ) - call stat_update_var( iwpthlp_mfl_max, wpxp_mfl_max, zm ) - elseif ( l_stats_samp .and. solve_type == mono_flux_rtm ) then - call stat_update_var( irtm_without_ta, xm_without_ta, zt ) - call stat_update_var( irtm_mfl_min, min_x_allowable, zt ) - call stat_update_var( irtm_mfl_max, max_x_allowable, zt ) - call stat_update_var( iwprtp_mfl_min, wpxp_mfl_min, zm ) - call stat_update_var( iwprtp_mfl_max, wpxp_mfl_max, zm ) - endif - - - if ( any( wpxp_net_adjust(:) /= 0.0_core_rknd ) ) then - - ! Reset the value of xm to compensate for the change to w'x'. - - if ( l_mfl_xm_imp_adj ) then - - ! A tridiagonal matrix is used to semi-implicitly re-solve for the - ! values of xm at timestep index (t+1). - - ! Set up the left-hand side of the tridiagonal matrix equation. - call mfl_xm_lhs( dt, wm_zt, l_implemented, & - lhs_mfl_xm ) - - ! Set up the right-hand side of tridiagonal matrix equation. - call mfl_xm_rhs( dt, xm_old, wpxp, xm_forcing, & - rho_ds_zm, invrs_rho_ds_zt, & - rhs_mfl_xm ) - - ! Solve the tridiagonal matrix equation. - call mfl_xm_solve( solve_type, lhs_mfl_xm, rhs_mfl_xm, & - xm, err_code ) - - ! Check for errors - if ( fatal_error( err_code ) ) return - - else ! l_mfl_xm_imp_adj = .false. - - ! An explicit adjustment is made to the values of xm at timestep - ! index (t+1), which is based upon the array of the amounts of w'x' - ! adjustments. - - do k = 2, gr%nz, 1 - - km1 = max( k-1, 1 ) - - ! The rate of change of the adjustment to xm due to the monotonic - ! flux limiter. - dxm_dt_mfl_adjust(k) & - = - invrs_rho_ds_zt(k) & - * gr%invrs_dzt(k) & - * ( rho_ds_zm(k) * wpxp_net_adjust(k) & - - rho_ds_zm(km1) * wpxp_net_adjust(km1) ) - - ! The net change to xm due to the monotonic flux limiter is the - ! rate of change multiplied by the time step length. Add the - ! product to xm to find the new xm resulting from the monotonic - ! flux limiter. - xm(k) = xm(k) + dxm_dt_mfl_adjust(k) * real( dt, kind = core_rknd ) - - enddo - - ! Boundary condition on xm - xm(1) = xm(2) - - endif ! l_mfl_xm_imp_adj - - ! This code can be uncommented for debugging. - !do k = 1, gr%nz, 1 - ! print *, "k = ", k, "xm(t) = ", xm_old(k), "new xm(t+1) = ", xm(k) - !enddo - - !Ensure there are no spikes at the top of the domain - if (abs( xm(gr%nz) - xm_enter_mfl(gr%nz) ) > 10._core_rknd * xm_tol) then - dz = gr%zm(gr%nz) - gr%zm(gr%nz - 1) - - xm_density_weighted = rho_ds_zt(gr%nz) & - * (xm(gr%nz) - xm_enter_mfl(gr%nz)) & - * dz - - xm_vert_integral & - = vertical_integral & - ( ((gr%nz - 1) - 2 + 1), rho_ds_zt(2:gr%nz - 1), & - xm(2:gr%nz - 1), gr%invrs_dzt(2:gr%nz - 1) ) - - !Check to ensure the vertical integral is not zero to avoid a divide - !by zero error - if (xm_vert_integral < eps) then - write(fstderr,*) "Vertical integral of xm is zero;", & - "mfl will remove spike at top of domain,", & - "but it will not conserve xm." - - !Remove the spike at the top of the domain - xm(gr%nz) = xm_enter_mfl(gr%nz) - else - xm_adj_coef = xm_density_weighted / xm_vert_integral - - !xm_adj_coef can not be smaller than -1 - if (xm_adj_coef < -0.99_core_rknd) then - write(fstderr,*) "xm_adj_coef in mfl less than -0.99, " & - // "mx_adj_coef set to -0.99" - xm_adj_coef = -0.99_core_rknd - endif - - !Apply the adjustment - xm = xm * (1._core_rknd + xm_adj_coef) - - !Remove the spike at the top of the domain - xm(gr%nz) = xm_enter_mfl(gr%nz) - - !This code can be uncommented to ensure conservation - !if (abs(sum(rho_ds_zt(2:gr%nz) * xm(2:gr%nz) / gr%invrs_dzt(2:gr%nz)) - & - ! sum(rho_ds_zt(2:gr%nz) * xm_enter_mfl(2:gr%nz) / gr%invrs_dzt(2:gr%nz)))& - ! > (1000 * xm_tol)) then - ! write(fstderr,*) "NON-CONSERVATION in MFL", trim( solve_type ), & - ! abs(sum(rho_ds_zt(2:gr%nz) * xm(2:gr%nz) / gr%invrs_dzt(2:gr%nz)) - & - ! sum(rho_ds_zt(2:gr%nz) * xm_enter_mfl(2:gr%nz) / & - ! gr%invrs_dzt(2:gr%nz))) - ! - ! write(fstderr,*) "XM_ENTER_MFL=", xm_enter_mfl - ! write(fstderr,*) "XM_AFTER_SPIKE_REMOVAL", xm - ! write(fstderr,*) "XM_TOL", xm_tol - ! write(fstderr,*) "XM_ADJ_COEF", xm_adj_coef - !endif - - endif ! xm_vert_integral < eps - endif ! spike at domain top - - endif ! any( wpxp_net_adjust(:) /= 0.0_core_rknd ) - - - if ( l_stats_samp ) then - - call stat_end_update( iwpxp_mfl, wpxp / real( dt, kind = core_rknd ), zm ) - - call stat_end_update( ixm_mfl, xm / real( dt, kind = core_rknd ), zt ) - - if ( solve_type == mono_flux_thlm ) then - call stat_update_var( ithlm_exit_mfl, xm, zt ) - call stat_update_var( iwpthlp_exit_mfl, xm, zm ) - elseif ( solve_type == mono_flux_rtm ) then - call stat_update_var( irtm_exit_mfl, xm, zt ) - call stat_update_var( iwprtp_exit_mfl, xm, zm ) - endif - - endif - - - return - end subroutine monotonic_turbulent_flux_limit - - !============================================================================= - subroutine mfl_xm_lhs( dt, wm_zt, l_implemented, & - lhs ) - - ! Description: - ! This subroutine is part of the process of re-solving for xm at timestep - ! index (t+1). This is done because the original solving process produced - ! values outside of what is deemed acceptable by the monotonic flux limiter. - ! Unlike the original formulation for advancing xm one timestep, which - ! combines w'x' and xm in a band-diagonal solver, this formulation uses a - ! tridiagonal solver to solve for only the value of xm(t+1), for w'x'(t+1) - ! is known. - ! - ! Subroutine mfl_xm_lhs sets up the left-hand side of the matrix equation. - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_mean_adv, only: & - term_ma_zt_lhs ! Procedure(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. - k_tdiag = 2, & ! Thermodynamic main diagonal index. - km1_tdiag = 3 ! Thermodynamic subdiagonal index. - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Model timestep length [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - wm_zt ! w wind component on thermodynamic levels [m/s] - - logical, intent(in) :: & - l_implemented ! Flag for CLUBB being implemented in a larger model. - - ! Output Variables - real( kind = core_rknd ), dimension(3,gr%nz), intent(out) :: & - lhs ! Left hand side of tridiagonal matrix - - ! Local Variables - integer :: k, km1 ! Array index - - - !----------------------------------------------------------------------- - - ! Initialize the left-hand side matrix to 0. - lhs = 0.0_core_rknd - - - ! The xm loop runs between k = 2 and k = gr%nz. The value of xm at - ! level k = 1, which is below the model surface, is simply set equal to the - ! value of xm at level k = 2 after the solve has been completed. - - ! Setup LHS of the tridiagonal system - do k = 2, gr%nz, 1 - - km1 = max( k-1,1 ) - - ! LHS xm mean advection (ma) term. - if ( .not. l_implemented ) then - - lhs(kp1_tdiag:km1_tdiag,k) & - = lhs(kp1_tdiag:km1_tdiag,k) & - + term_ma_zt_lhs( wm_zt(k), gr%invrs_dzt(k), k, gr%invrs_dzm(k), gr%invrs_dzm(km1) ) - - else - - lhs(kp1_tdiag:km1_tdiag,k) & - = lhs(kp1_tdiag:km1_tdiag,k) + 0.0_core_rknd - - endif - - ! LHS xm time tendency. - lhs(k_tdiag,k) & - = lhs(k_tdiag,k) + 1.0_core_rknd / real( dt, kind = core_rknd ) - - enddo ! xm loop: 2..gr%nz - - ! Boundary conditions. - - ! Lower boundary - k = 1 - lhs(:,k) = 0.0_core_rknd - lhs(k_tdiag,k) = 1.0_core_rknd - - return - end subroutine mfl_xm_lhs - - !============================================================================= - subroutine mfl_xm_rhs( dt, xm_old, wpxp, xm_forcing, & - rho_ds_zm, invrs_rho_ds_zt, & - rhs ) - - ! Description: - ! This subroutine is part of the process of re-solving for xm at timestep - ! index (t+1). This is done because the original solving process produced - ! values outside of what is deemed acceptable by the monotonic flux limiter. - ! Unlike the original formulation for advancing xm one timestep, which - ! combines w'x' and xm in a band-diagonal solver, this formulation uses a - ! tridiagonal solver to solve for only the value of xm(t+1), for w'x'(t+1) - ! is known. - ! - ! Subroutine mfl_xm_rhs sets up the right-hand side of the matrix equation. - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - implicit none - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Model timestep length [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - xm_old, & ! xm; timestep (t) (thermodynamic levels) [units vary] - wpxp, & ! w'x'; timestep (t+1); limited (m-levs.) [units vary] - xm_forcing, & ! xm forcings (thermodynamic levels) [units vary] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - invrs_rho_ds_zt ! Inv. dry, static density @ thermo. levs. [m^3/kg] - - ! Output Variable - real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & - rhs ! Right hand side of tridiagonal matrix equation - - ! Local Variables - integer :: k, km1 ! Array indices - - !----------------------------------------------------------------------- - - ! Initialize the right-hand side vector to 0. - rhs = 0.0_core_rknd - - - ! The xm loop runs between k = 2 and k = gr%nz. The value of xm at - ! level k = 1, which is below the model surface, is simply set equal to the - ! value of xm at level k = 2 after the solve has been completed. - - do k = 2, gr%nz, 1 - - ! Define indices - km1 = max( k-1, 1 ) - - ! RHS xm time tendency. - rhs(k) = rhs(k) + xm_old(k) / real( dt, kind = core_rknd ) - - ! RHS xm turbulent advection (ta) term. - ! Note: Normally, the turbulent advection (ta) term is treated - ! implicitly when advancing xm one timestep, as both xm and w'x' - ! are advanced together from timestep index (t) to timestep - ! index (t+1). However, in this case, both xm and w'x' have - ! already been advanced one timestep. However, w'x'(t+1) has been - ! limited after the fact, and therefore it's values at timestep - ! index (t+1) are known. Thus, in re-solving for xm(t+1), the - ! derivative of w'x'(t+1) can be placed on the right-hand side of - ! the d(xm)/dt equation. - rhs(k) & - = rhs(k) & - - invrs_rho_ds_zt(k) & - * gr%invrs_dzt(k) & - * ( rho_ds_zm(k) * wpxp(k) - rho_ds_zm(km1) * wpxp(km1) ) - - ! RHS xm forcings. - ! Note: xm forcings include the effects of microphysics, - ! cloud water sedimentation, radiation, and any - ! imposed forcings on xm. - rhs(k) = rhs(k) + xm_forcing(k) - - enddo ! xm loop: 2..gr%nz - - ! Boundary conditions - - ! Lower Boundary - k = 1 - ! The value of xm at the lower boundary will remain the same. However, the - ! value of xm at the lower boundary gets overwritten after the matrix is - ! solved for the next timestep, such that xm(1) = xm(2). - rhs(k) = xm_old(k) - - return - end subroutine mfl_xm_rhs - - !============================================================================= - subroutine mfl_xm_solve( solve_type, lhs, rhs, & - xm, err_code ) - - ! Description: - ! This subroutine is part of the process of re-solving for xm at timestep - ! index (t+1). This is done because the original solving process produced - ! values outside of what is deemed acceptable by the monotonic flux limiter. - ! Unlike the original formulation for advancing xm one timestep, which - ! combines w'x' and xm in a band-diagonal solver, this formulation uses a - ! tridiagonal solver to solve for only the value of xm(t+1), for w'x'(t+1) - ! is known. - ! - ! Subroutine mfl_xm_solve solves the tridiagonal matrix equation for xm at - ! timestep index (t+1). - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_lapack_wrap, only: & - tridag_solve ! Procedure(s) - - use crmx_error_code, only: & - fatal_error, & ! Procedure(s) - clubb_no_error ! Constant - - use crmx_clubb_precision, only: & - core_rknd - - implicit none - - ! Constant parameters - integer, parameter :: & - kp1_tdiag = 1, & ! Thermodynamic superdiagonal index. - k_tdiag = 2, & ! Thermodynamic main diagonal index. - km1_tdiag = 3 ! Thermodynamic subdiagonal index. - - ! Input Variables - integer, intent(in) :: & - solve_type ! Variables being solved for. - - real( kind = core_rknd ), dimension(3,gr%nz), intent(inout) :: & - lhs ! Left hand side of tridiagonal matrix - - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - rhs ! Right hand side of tridiagonal matrix equation - - ! Output Variables - real( kind = core_rknd ), dimension(gr%nz), intent(inout) :: & - xm ! Value of variable being solved for at timestep (t+1) [units vary] - - integer, intent(out) :: & - err_code ! Returns an error code in the event of a singular matrix - - ! Local variable - character(len=10) :: & - solve_type_str ! solve_type as a string for debug output purposes - - !----------------------------------------------------------------------- - - err_code = clubb_no_error ! Initialize to the value for no errors - - select case( solve_type ) - case ( mono_flux_rtm ) - solve_type_str = "rtm" - case ( mono_flux_thlm ) - solve_type_str = "thlm" - case default - solve_type_str = "scalars" - end select - - ! Solve for xm at timestep index (t+1) using the tridiagonal solver. - call tridag_solve & - ( solve_type_str, gr%nz, 1, lhs(kp1_tdiag,:), & ! Intent(in) - lhs(k_tdiag,:), lhs(km1_tdiag,:), rhs, & ! Intent(inout) - xm, err_code ) ! Intent(out) - - ! Check for errors - if ( fatal_error( err_code ) ) return - - ! Boundary condition on xm - xm(1) = xm(2) - - return - end subroutine mfl_xm_solve - - !============================================================================= - subroutine calc_turb_adv_range( dt, w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & - mixt_frac_zm, & - low_lev_effect, high_lev_effect ) - - ! Description: - ! Calculates the lowermost and uppermost thermodynamic grid levels that can - ! effect the base (or central) thermodynamic level through the effects of - ! turbulent advection over the course of one time step. This is used as - ! part of the monotonic turbulent advection scheme. - ! - ! One method is to use the vertical velocity at each level to determine the - ! amount of time that it takes to travel across that particular grid level. - ! The method is to keep on advancing one grid level until either (a) the - ! total sum of time taken reaches or exceeds the model time step length, - ! (b) the top or bottom of the model is reached, or (c) a level is reached - ! where the vertical velocity component (with turbulence included) is - ! oriented completely opposite of the direction of travel towards the base - ! (or central) thermodynamic level. An example of situation (c) would be, - ! while starting from a higher altitude and searching downward for all - ! upward vertical velocity components, encountering a strong downdraft - ! where the vertical velocity at every single point is oriented downward. - ! Such a situation would occur when the mean vertical velocity (wm_zm) - ! exceeds any turbulent component (w') that would be oriented upwards. - ! - ! Another method is to simply set the thickness (in meters) of the layer - ! that turbulent advection is allowed to act over, for purposes of the - ! monotonic turbulent advection scheme. The lowermost and uppermost - ! grid level that can effect the base (or central) thermodynamic level - ! is computed based on the thickness and altitude of each level. - - ! References: - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - implicit none - - ! Constant parameters - logical, parameter :: & - l_constant_thickness = .false. ! Toggle constant or variable thickness. - - real( kind = core_rknd ), parameter :: & - const_thick = 150.0_core_rknd ! Constant thickness value [m] - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt ! Model timestep length [s] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - w1_zm, & ! Mean w (1st PDF component) [m/s] - w2_zm, & ! Mean w (2nd PDF component) [m/s] - varnce_w1_zm, & ! Variance of w (1st PDF component) [m^2/s^2] - varnce_w2_zm, & ! Variance of w (2nd PDF component) [m^2/s^2] - mixt_frac_zm ! Weight of 1st PDF component (Sk_w dependent) [-] - - ! Output Variables - integer, dimension(gr%nz), intent(out) :: & - low_lev_effect, & ! Index of lowest level that has an effect (for lev. k) - high_lev_effect ! Index of highest level that has an effect (for lev. k) - - ! Local Variables - real( kind = core_rknd ), dimension(gr%nz) :: & - vert_vel_up, & ! Average upwards vertical velocity component [m/s] - vert_vel_down ! Average downwards vertical velocity component [m/s] - - real(kind=time_precision) :: & - dt_one_grid_lev, & ! Amount of time to travel one grid box [s] - dt_all_grid_levs ! Running count of amount of time taken to travel [s] - - integer :: k, j - - ! ---- Begin Code ---- - - if ( l_constant_thickness ) then ! thickness is a constant value. - - ! The value of w'x' may only be altered between levels 3 and gr%nz-2. - do k = 3, gr%nz-2, 1 - - ! Compute the number of levels that effect the central thermodynamic - ! level through upwards motion (traveling from lower levels to reach - ! the central thermodynamic level). - - ! Start with the index of the thermodynamic level immediately below - ! the central thermodynamic level. - j = k - 1 - - do ! loop downwards until answer is found. - - if ( gr%zt(k) - gr%zt(j) >= const_thick ) then - - ! Stop, the current grid level is the lowest level that can - ! be considered. - low_lev_effect(k) = j - - exit - - else - - ! Thermodynamic level 1 cannot be considered because it is - ! located below the surface or below the bottom of the model. - ! The lowest level that can be considered is thermodynamic - ! level 2. - if ( j == 2 ) then - - ! The current level (level 2) is the lowest level that can - ! be considered. - low_lev_effect(k) = j - - exit - - else - - ! Increment to the next vertical level down. - j = j - 1 - - endif - - endif - - enddo ! downwards loop - - - ! Compute the number of levels that effect the central thermodynamic - ! level through downwards motion (traveling from higher levels to - ! reach the central thermodynamic level). - - ! Start with the index of the thermodynamic level immediately above - ! the central thermodynamic level. - j = k + 1 - - do ! loop upwards until answer is found. - - if ( gr%zt(j) - gr%zt(k) >= const_thick ) then - - ! Stop, the current grid level is the highest level that can - ! be considered. - high_lev_effect(k) = j - - exit - - else - - ! The highest level that can be considered is thermodynamic - ! level gr%nz. - if ( j == gr%nz ) then - - ! The current level (level gr%nz) is the highest level - ! that can be considered. - high_lev_effect(k) = j - - exit - - else - - ! Increment to the next vertical level up. - j = j + 1 - - endif - - endif - - enddo ! upwards loop - - enddo ! k = 3, gr%nz-2 - - - else ! thickness based on vertical velocity and time step length. - - ! Find the average upwards vertical velocity and the average downwards - ! vertical velocity. - ! Note: A level that has all vertical wind moving downwards will have a - ! vert_vel_up value that is 0, and vice versa. - call mean_vert_vel_up_down( w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & ! In - mixt_frac_zm, 0.0_core_rknd, & ! In - vert_vel_down, vert_vel_up ) - - ! The value of w'x' may only be altered between levels 3 and gr%nz-2. - do k = 3, gr%nz-2, 1 - - ! Compute the number of levels that effect the central thermodynamic - ! level through upwards motion (traveling from lower levels to reach - ! the central thermodynamic level). - - ! Start with the index of the thermodynamic level immediately below - ! the central thermodynamic level. - j = k - 1 - - ! Initialize the overall delta t counter to 0. - dt_all_grid_levs = 0.0_time_precision - - do ! loop downwards until answer is found. - - ! Continue if there is some component of upwards vertical velocity. - if ( vert_vel_up(j) > 0.0_core_rknd ) then - - ! Compute the amount of time it takes to travel one grid level - ! upwards: delta_t = delta_z / vert_vel_up. - dt_one_grid_lev = real( (1.0_core_rknd/gr%invrs_dzm(j)) / vert_vel_up(j), & - kind=time_precision ) - - ! Total time elapsed for crossing all grid levels that have been - ! passed, thus far. - dt_all_grid_levs = dt_all_grid_levs + dt_one_grid_lev - - ! Stop if has taken more than one model time step (overall) to - ! travel the entire extent of the current vertical grid level. - if ( dt_all_grid_levs >= dt ) then - - ! The current level is the lowest level that can be - ! considered. - low_lev_effect(k) = j - - exit - - ! Continue if the total elapsed time has not reached or exceeded - ! one model time step. - else - - ! Thermodynamic level 1 cannot be considered because it is - ! located below the surface or below the bottom of the model. - ! The lowest level that can be considered is thermodynamic - ! level 2. - if ( j == 2 ) then - - ! The current level (level 2) is the lowest level that can - ! be considered. - low_lev_effect(k) = j - - exit - - else - - ! Increment to the next vertical level down. - j = j - 1 - - endif - - endif - - ! Stop if there isn't a component of upwards vertical velocity. - else - - ! The current level cannot be considered. The lowest level that - ! can be considered is one-level-above the current level. - low_lev_effect(k) = j + 1 - - exit - - endif - - enddo ! downwards loop - - - ! Compute the number of levels that effect the central thermodynamic - ! level through downwards motion (traveling from higher levels to - ! reach the central thermodynamic level). - - ! Start with the index of the thermodynamic level immediately above - ! the central thermodynamic level. - j = k + 1 - - ! Initialize the overall delta t counter to 0. - dt_all_grid_levs = 0.0_time_precision - - do ! loop upwards until answer is found. - - ! Continue if there is some component of downwards vertical velocity. - if ( vert_vel_down(j-1) < 0.0_core_rknd ) then - - ! Compute the amount of time it takes to travel one grid level - ! downwards: delta_t = - delta_z / vert_vel_down. - ! Note: There is a (-) sign in front of delta_z because the - ! distance traveled is downwards. Since vert_vel_down - ! has a negative value, dt_one_grid_lev will be a - ! positive value. - dt_one_grid_lev = real( -(1.0_core_rknd/gr%invrs_dzm(j-1)) / vert_vel_down(j-1), & - kind=time_precision ) - - ! Total time elapsed for crossing all grid levels that have been - ! passed, thus far. - dt_all_grid_levs = real( dt_all_grid_levs + dt_one_grid_lev, kind=time_precision ) - - ! Stop if has taken more than one model time step (overall) to - ! travel the entire extent of the current vertical grid level. - if ( dt_all_grid_levs >= dt ) then - - ! The current level is the highest level that can be - ! considered. - high_lev_effect(k) = j - - exit - - ! Continue if the total elapsed time has not reached or exceeded - ! one model time step. - else - - ! The highest level that can be considered is thermodynamic - ! level gr%nz. - if ( j == gr%nz ) then - - ! The current level (level gr%nz) is the highest level - ! that can be considered. - high_lev_effect(k) = j - - exit - - else - - ! Increment to the next vertical level up. - j = j + 1 - - endif - - endif - - ! Stop if there isn't a component of downwards vertical velocity. - else - - ! The current level cannot be considered. The highest level - ! that can be considered is one-level-below the current level. - high_lev_effect(k) = j - 1 - - exit - - endif - - enddo ! upwards loop - - enddo ! k = 3, gr%nz-2 - - endif ! l_constant_thickness - - - ! Information for levels 1, 2, gr%nz-1, and gr%nz is not needed. - ! However, set the values at these levels for purposes of not having odd - ! values in the arrays. - low_lev_effect(1) = 1 - high_lev_effect(1) = 1 - low_lev_effect(2) = 2 - high_lev_effect(2) = 2 - low_lev_effect(gr%nz-1) = gr%nz-1 - high_lev_effect(gr%nz-1) = gr%nz - low_lev_effect(gr%nz) = gr%nz - high_lev_effect(gr%nz) = gr%nz - - - return - end subroutine calc_turb_adv_range - - !============================================================================= - subroutine mean_vert_vel_up_down( w1_zm, w2_zm, varnce_w1_zm, varnce_w2_zm, & - mixt_frac_zm, w_ref, & - mean_w_down, mean_w_up ) - - ! Description - ! The values of vertical velocity, along a horizontal plane at any given - ! vertical level, are not allowed by CLUBB to be uniform. In other words, - ! there must be some variance in vertical velocity. This subroutine - ! calculates the mean of all values of vertical velocity, at any given - ! vertical level, that are greater than a certain reference velocity. This - ! subroutine also calculates the mean of all values of vertical velocity, at - ! any given vertical level, that are less than a certain reference velocity. - ! The reference velocity is usually 0 m/s, in which case this subroutine - ! calculates the average positive (upward) velocity and the average negative - ! (downward) velocity. However, the reference velocity may be other values, - ! such as wm_zm, which is the overall mean vertical velocity. If the - ! reference velocity is wm_zm, this subroutine calculates the average of all - ! values of w that are on the positive ("upward") side of the mean and the - ! average of all values of w that are on the negative ("downward") side of - ! the mean. These mean positive and negative vertical velocities are useful - ! in determining how long, on average, it takes a parcel of air, being - ! driven by subgrid updrafts or downdrafts, to traverse the length of the - ! vertical grid level. - ! - ! Method - ! ------ - ! - ! The CLUBB model uses a joint PDF of vertical velocity, liquid water - ! potential temperature, and total water mixing ratio to determine subgrid - ! variability. - ! - ! The values of vertical velocity, w, along an undefined horizontal plane - ! at any vertical level, are considered to approximately follow a - ! distribution that is a mixture of two normal (or Gaussian) distributions. - ! The values of w that are a part of the 1st normal distribution are - ! referred to as w1, and the values of w that are part of the 2nd normal - ! distribution are referred to as w2. Note that these distributions - ! overlap, and there are many values of w that are found in both w1 and w2. - ! - ! The probability density function (PDF) for w, P(w), is: - ! - ! P(w) = mixt_frac*P(w1) + (1-mixt_frac)*P(w2); - ! - ! where "mixt_frac" is the weight of the 1st normal distribution, and P(w1) and - ! P(w2) are the equations for the 1st and 2nd normal distributions, - ! respectively: - ! - ! P(w1) = 1 / ( sigma_w1 * sqrt(2*PI) ) - ! * EXP[ -(w1-mu_w1)^2 / (2*sigma_w1^2) ]; and - ! - ! P(w2) = 1 / ( sigma_w2 * sqrt(2*PI) ) - ! * EXP[ -(w2-mu_w2)^2 / (2*sigma_w2^2) ]. - ! - ! The mean of the 1st normal distribution is mu_w1, and the standard - ! deviation of the 1st normal distribution is sigma_w1. The mean of the - ! 2nd normal distribution is mu_w2, and the standard deviation of the 2nd - ! normal distribution is sigma_w2. - ! - ! The average value of w, distributed according to the probability - ! distribution, between limits alpha and beta, is: - ! - ! = INT(alpha:beta) w P(w) dw. - ! - ! The average value of w over a certain domain is used to determine the - ! average positive and negative (as compared to the reference velocity) - ! values of w at any vertical level. - ! - ! Average Negative Vertical Velocity - ! ---------------------------------- - ! - ! The average of all values of w in the distribution that are below the - ! reference velocity, w|_ref, is the mean value of w over the domain - ! -inf <= w <= w|_ref, such that: - ! - ! = INT(-inf:w|_ref) w P(w) dw. - ! = mixt_frac * INT(-inf:w|_ref) w1 P(w1) dw1 - ! + (1-mixt_frac) * INT(-inf:w|_ref) w2 P(w2) dw2. - ! - ! For each normal distribution in the mixture of normal distribution, i - ! (where "i" can be 1 or 2): - ! - ! INT(-inf:w|_ref) wi P(wi) dwi = - ! - ( sigma_wi / sqrt(2*PI) ) * EXP[ -(w|_ref-mu_wi)^2 / (2*sigma_wi^2) ] - ! + mu_wi * (1/2)*[ 1 + erf( (w|_ref-mu_wi) / (sqrt(2)*sigma_wi) ) ]; - ! - ! where mu_wi is the mean of w for the ith normal distribution, sigma_wi is - ! the standard deviations of w for the ith normal distribution, and erf( ) - ! is the error function. - ! - ! The mean of all values of w <= w|_ref is: - ! - ! = - ! mixt_frac * { - ( sigma_w1 / sqrt(2*PI) ) - ! * EXP[ -(w|_ref-mu_w1)^2 / (2*sigma_w1^2) ] - ! + mu_w1 * (1/2) - ! *[1 + erf( (w|_ref-mu_w1) / (sqrt(2)*sigma_w1) )] } - ! + (1-mixt_frac) * { - ( sigma_w2 / sqrt(2*PI) ) - ! * EXP[ -(w|_ref-mu_w2)^2 / (2*sigma_w2^2) ] - ! + mu_w2 * (1/2) - ! *[1 + erf( (w|_ref-mu_w2) / (sqrt(2)*sigma_w2) )] }. - ! - ! Average Positive Vertical Velocity - ! ---------------------------------- - ! - ! The average of all values of w in the distribution that are above the - ! reference velocity, w|_ref, is the mean value of w over the domain - ! w|_ref <= w <= inf, such that: - ! - ! = INT(w|_ref:inf) w P(w) dw. - ! = mixt_frac * INT(w|_ref:inf) w1 P(w1) dw1 - ! + (1-mixt_frac) * INT(w|_ref:inf) w2 P(w2) dw2. - ! - ! For each normal distribution in the mixture of normal distribution, i - ! (where "i" can be 1 or 2): - ! - ! INT(w|_ref:inf) wi P(wi) dwi = - ! ( sigma_wi / sqrt(2*PI) ) * EXP[ -(w|_ref-mu_wi)^2 / (2*sigma_wi^2) ] - ! + mu_wi * (1/2)*[ 1 - erf( (w|_ref-mu_wi) / (sqrt(2)*sigma_wi) ) ]; - ! - ! where mu_wi is the mean of w for the ith normal distribution, sigma_wi is - ! the standard deviations of w for the ith normal distribution, and erf( ) - ! is the error function. - ! - ! The mean of all values of w >= w|_ref is: - ! - ! = - ! mixt_frac * { ( sigma_w1 / sqrt(2*PI) ) - ! * EXP[ -(w|_ref-mu_w1)^2 / (2*sigma_w1^2) ] - ! + mu_w1 * (1/2) - ! *[1 - erf( (w|_ref-mu_w1) / (sqrt(2)*sigma_w1) )] } - ! + (1-mixt_frac) * { ( sigma_w2 / sqrt(2*PI) ) - ! * EXP[ -(w|_ref-mu_w2)^2 / (2*sigma_w2^2) ] - ! + mu_w2 * (1/2) - ! *[1 - erf( (w|_ref-mu_w2) / (sqrt(2)*sigma_w2) )] }. - ! - ! Special Limitations: - ! -------------------- - ! - ! A normal distribution has a domain from -inf to inf. However, the mixture - ! of normal distributions is an approximation of the distribution of values - ! of w along a horizontal plane at any given vertical level. Vertical - ! velocity, w, has absolute minimum and maximum values (that cannot be - ! predicted by the PDF). The absolute maximum and minimum for each normal - ! distribution is most likely found within 2 or 3 standard deviations of the - ! mean for the relevant normal distribution. In other words, for each - ! normal distribution in the mixture of normal distributions, all the values - ! of w are found within 2 or 3 standard deviations on both sides of the - ! mean. Therefore, if one (or both) of the normal distributions has a mean - ! that is more than 3 standard deviations away from the reference velocity, - ! then that entire w distribution is found on ONE side of the reference - ! velocity. - ! - ! Therefore: - ! - ! a) where mu_wi + 3*sigma_wi <= w|_ref: - ! - ! The entire ith normal distribution of w is on the negative side of - ! w|_ref; and - ! - ! INT(-inf:w|_ref) wi P(wi) dwi = mu_wi; and - ! INT(inf:w|_ref) wi P(wi) dwi = 0. - ! - ! b) where mu_wi - 3*sigma_wi >= w|_ref: - ! - ! The entire ith normal distribution of w is on the positive side of - ! w|_ref; and - ! - ! INT(-inf:w|_ref) wi P(wi) dwi = 0; and - ! INT(inf:w|_ref) wi P(wi) dwi = mu_wi. - ! - ! Note: A value of 3 standard deviations above and below the mean of the - ! ith normal distribution was chosen for the approximate maximum and - ! minimum values of the ith normal distribution because 99.7% of - ! values in a normal distribution are found within 3 standard - ! deviations from the mean (compared to 95.4% for 2 standard - ! deviations). The value of 3 standard deviations provides for a - ! reasonable estimate of the absolute maximum and minimum of w, while - ! covering a great majority of the normal distribution. - - ! References: - !----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr, & ! Variable(s) - zt2zm ! Procedure(s) - - use crmx_constants_clubb, only: & - sqrt_2pi, & - sqrt_2 - - use crmx_anl_erf, only: & - erf ! Procedure(s) - ! The error function - - use crmx_stats_type, only: & - stat_update_var_pt ! Procedure(s) - - use crmx_stats_variables, only: & - zm, & ! Variable(s) - imean_w_up, & - imean_w_down, & - l_stats_samp - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - w1_zm, & ! Mean w (1st PDF component) [m/s] - w2_zm, & ! Mean w (2nd PDF component) [m/s] - varnce_w1_zm, & ! Variance of w (1st PDF component) [m^2/s^2] - varnce_w2_zm, & ! Variance of w (2nd PDF component) [m^2/s^2] - mixt_frac_zm ! Weight of 1st PDF component (Sk_w dependent) [-] - - real( kind = core_rknd ), intent(in) :: & - w_ref ! Reference velocity, w|_ref (normally = 0) [m/s] - - ! Output Variables - real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & - mean_w_down, & ! Overall mean w (<= w|_ref) [m/s] - mean_w_up ! Overall mean w (>= w|_ref) [m/s] - - ! Local Variables - - real( kind = core_rknd ) :: & - sigma_w1, & ! Standard deviation of w for 1st normal distribution [m/s] - sigma_w2, & ! Standard deviation of w for 2nd normal distribution [m/s] - mean_w_down_1st, & ! Mean w (<= w|_ref) from 1st normal distribution [m/s] - mean_w_down_2nd, & ! Mean w (<= w|_ref) from 2nd normal distribution [m/s] - mean_w_up_1st, & ! Mean w (>= w|_ref) from 1st normal distribution [m/s] - mean_w_up_2nd, & ! Mean w (>= w|_ref) from 2nd normal distribution [m/s] - exp_cache, & ! Cache of exponential calculations to reduce runtime - erf_cache ! Cache of error function calculations to reduce runtime - - integer :: k ! Vertical loop index - - ! ---- Begin Code ---- - - ! Loop over momentum levels from 2 to gr%nz-1. Levels 1 and gr%nz - ! are not needed. - do k = 2, gr%nz-1, 1 - - ! Standard deviation of w for the 1st normal distribution. - sigma_w1 = sqrt( varnce_w1_zm(k) ) - - ! Standard deviation of w for the 2nd normal distribution. - sigma_w2 = sqrt( varnce_w2_zm(k) ) - - - ! Contributions from the 1st normal distribution. - if ( w1_zm(k) + 3._core_rknd*sigma_w1 <= w_ref ) then - - ! The entire 1st normal is on the negative side of w|_ref. - mean_w_down_1st = w1_zm(k) - mean_w_up_1st = 0.0_core_rknd - - elseif ( w1_zm(k) - 3._core_rknd*sigma_w1 >= w_ref ) then - - ! The entire 1st normal is on the positive side of w|_ref. - mean_w_down_1st = 0.0_core_rknd - mean_w_up_1st = w1_zm(k) - - else - - ! The exponential calculation is pulled out as it is reused in both - ! equations. This should save one calculation of the - ! exp( -(w_ref-w1_zm(k))**2 ... etc. part of the formula. - ! ~~EIHoppe//20090618 - exp_cache = exp( -(w_ref-w1_zm(k))**2 / (2.0_core_rknd*sigma_w1**2) ) - - ! Added cache of the error function calculations. - ! This should save one calculation of the erf(...) part - ! of the formula. - ! ~~EIHoppe//20090623 - erf_cache = erf( (w_ref-w1_zm(k)) / (sqrt_2*sigma_w1) ) - - ! The 1st normal has values on both sides of w_ref. - mean_w_down_1st = & - - (sigma_w1/sqrt_2pi) & -! * exp( -(w_ref-w1_zm(k))**2 / (2.0_core_rknd*sigma_w1**2) ) & - * exp_cache & -! + w1(k) * 0.5_core_rknd*( 1.0_core_rknd + erf( (w_ref-w1(k)) / (sqrt_2*sigma_w1) ) ) - + w1_zm(k) * 0.5_core_rknd*( 1.0_core_rknd + erf_cache) - - mean_w_up_1st = & - + (sigma_w1/sqrt_2pi) & -! * exp( -(w_ref-w1(k))**2 / (2.0_core_rknd*sigma_w1**2) ) & - * exp_cache & -! + w1(k) * 0.5_core_rknd*( 1.0_core_rknd - erf( (w_ref-w1(k)) / (sqrt_2*sigma_w1) ) ) - + w1_zm(k) * 0.5_core_rknd*( 1.0_core_rknd - erf_cache) - - ! /EIHoppe changes - - endif - - - ! Contributions from the 2nd normal distribution. - if ( w2_zm(k) + 3._core_rknd*sigma_w2 <= w_ref ) then - - ! The entire 2nd normal is on the negative side of w|_ref. - mean_w_down_2nd = w2_zm(k) - mean_w_up_2nd = 0.0_core_rknd - - elseif ( w2_zm(k) - 3._core_rknd*sigma_w2 >= w_ref ) then - - ! The entire 2nd normal is on the positive side of w|_ref. - mean_w_down_2nd = 0.0_core_rknd - mean_w_up_2nd = w2_zm(k) - - else - - ! The exponential calculation is pulled out as it is reused in both - ! equations. This should save one calculation of the - ! exp( -(w_ref-w1(k))**2 ... etc. part of the formula. - ! ~~EIHoppe//20090618 - exp_cache = exp( -(w_ref-w2_zm(k))**2 / (2.0_core_rknd*sigma_w2**2) ) - - ! Added cache of the error function calculations. - ! This should save one calculation of the erf(...) part - ! of the formula. - ! ~~EIHoppe//20090623 - erf_cache = erf( (w_ref-w2_zm(k)) / (sqrt_2*sigma_w2) ) - - ! The 2nd normal has values on both sides of w_ref. - mean_w_down_2nd = & - - (sigma_w2/sqrt_2pi) & -! * exp( -(w_ref-w2_zm(k))**2 / (2.0_core_rknd*sigma_w2**2) ) & - * exp_cache & -! + w2_zm(k) * 0.5_core_rknd*( 1.0_core_rknd + erf( (w_ref-w2(k)) / (sqrt_2*sigma_w2) ) ) - + w2_zm(k) * 0.5_core_rknd*( 1.0_core_rknd + erf_cache) - - mean_w_up_2nd = & - + (sigma_w2/sqrt_2pi) & -! * exp( -(w_ref-w2(k))**2 / (2.0_core_rknd*sigma_w2**2) ) & - * exp_cache & -! + w2(k) * 0.5_core_rknd*( 1.0_core_rknd - erf( (w_ref-w2(k)) / (sqrt_2*sigma_w2) ) ) - + w2_zm(k) * 0.5_core_rknd*( 1.0_core_rknd - erf_cache) - - ! /EIHoppe changes - - endif - - ! Overall mean of downwards w. - mean_w_down(k) = mixt_frac_zm(k) * mean_w_down_1st & - + ( 1.0_core_rknd - mixt_frac_zm(k) ) * mean_w_down_2nd - - ! Overall mean of upwards w. - mean_w_up(k) = mixt_frac_zm(k) * mean_w_up_1st & - + ( 1.0_core_rknd - mixt_frac_zm(k) ) * mean_w_up_2nd - - if ( l_stats_samp ) then - - call stat_update_var_pt( imean_w_up, k, mean_w_up(k), zm ) - - call stat_update_var_pt( imean_w_down, k, mean_w_down(k), zm ) - - endif ! l_stats_samp - - enddo ! k = 2, gr%nz, 1 - - - return - end subroutine mean_vert_vel_up_down - -!=============================================================================== - -end module crmx_mono_flux_limiter diff --git a/src/physics/spcam/crm/CLUBB/crmx_mt95.f90 b/src/physics/spcam/crm/CLUBB/crmx_mt95.f90 deleted file mode 100644 index 14d75bc733..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_mt95.f90 +++ /dev/null @@ -1,1317 +0,0 @@ -! A C-program for MT19937, with initialization improved 2002/1/26. -! Coded by Takuji Nishimura and Makoto Matsumoto. - -! Code converted to Fortran 95 by Jos Rui Faustino de Sousa -! Date: 2002-02-01 - -! Enhanced version by Jos Rui Faustino de Sousa -! Date: 2003-04-30 - -! Interface: -! -! Kinds: -! genrand_intg -! Integer kind used must be at least 32 bits. -! genrand_real -! Real kind used -! -! Types: -! genrand_state -! Internal representation of the RNG state. -! genrand_srepr -! Public representation of the RNG state. Should be used to save the RNG state. -! -! Procedures: -! assignment(=) -! Converts from type genrand_state to genrand_srepr and vice versa. -! genrand_init -! Internal RNG state initialization subroutine accepts either an genrand_intg integer -! or a vector as seed or a new state using "put=" returns the present state using -! "get=". If it is called with "get=" before being seeded with "put=" returns a state -! initialized with a default seed. -! genrand_int32 -! Subroutine returns an array or scalar whose elements are random integer on the -! [0,0xffffffff] interval. -! genrand_int31 -! Subroutine returns an array or scalar whose elements are random integer on the -! [0,0x7fffffff] interval. -! genrand_real1 -! Subroutine returns an array or scalar whose elements are random real on the -! [0,1] interval. -! genrand_real2 -! Subroutine returns an array or scalar whose elements are random real on the -! [0,1[ interval. -! genrand_real3 -! Subroutine returns an array or scalar whose elements are random real on the -! ]0,1[ interval. -! genrand_res53 -! Subroutine returns an array or scalar whose elements are random real on the -! [0,1[ interval with 53-bit resolution. - -! Before using, initialize the state by using genrand_init( put=seed ) - -! This library is free software. -! This library is distributed in the hope that it will be useful, -! but WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -! Copyright (C) 1997, 2002 Makoto Matsumoto and Takuji Nishimura. -! Any feedback is very welcome. -! http://www.math.keio.ac.jp/matumoto/emt.html -! email: matumoto@math.keio.ac.jp -module crmx_mt95 - - implicit none - - public :: genrand_init, assignment(=) - public :: genrand_int32, genrand_int31, genrand_real1 - public :: genrand_real2, genrand_real3, genrand_res53 - private :: uiadd, uisub, uimlt, uidiv, uimod - private :: init_by_type, init_by_scalar, init_by_array, next_state - private :: genrand_encode, genrand_decode, genrand_load_state, genrand_dump_state - private :: genrand_int32_0d, genrand_int32_1d, genrand_int32_2d, genrand_int32_3d - private :: genrand_int32_4d, genrand_int32_5d, genrand_int32_6d, genrand_int32_7d - private :: genrand_int31_0d, genrand_int31_1d, genrand_int31_2d, genrand_int31_3d - private :: genrand_int31_4d, genrand_int31_5d, genrand_int31_6d, genrand_int31_7d - private :: genrand_real1_0d, genrand_real1_1d, genrand_real1_2d, genrand_real1_3d - private :: genrand_real1_4d, genrand_real1_5d, genrand_real1_6d, genrand_real1_7d - private :: genrand_real2_0d, genrand_real2_1d, genrand_real2_2d, genrand_real2_3d - private :: genrand_real2_4d, genrand_real2_5d, genrand_real2_6d, genrand_real2_7d - private :: genrand_real3_0d, genrand_real3_1d, genrand_real3_2d, genrand_real3_3d - private :: genrand_real3_4d, genrand_real3_5d, genrand_real3_6d, genrand_real3_7d - private :: genrand_res53_0d, genrand_res53_1d, genrand_res53_2d, genrand_res53_3d - private :: genrand_res53_4d, genrand_res53_5d, genrand_res53_6d, genrand_res53_7d - - intrinsic :: selected_int_kind, selected_real_kind - - integer, public, parameter :: genrand_intg = selected_int_kind( 9 ) - integer, public, parameter :: genrand_real = selected_real_kind( 15 ) - - integer, private, parameter :: wi = genrand_intg - integer, private, parameter :: wr = genrand_real - - ! Period parameters - integer(kind=wi), private, parameter :: n = 624_wi - integer(kind=wi), private, parameter :: m = 397_wi - - integer(kind=wi), private, parameter :: default_seed = 5489_wi - - integer(kind=wi), private, parameter :: fbs = 32_wi - integer(kind=wi), private, parameter :: hbs = fbs / 2_wi - integer(kind=wi), private, parameter :: qbs = hbs / 2_wi - integer(kind=wi), private, parameter :: tbs = 3_wi * qbs - - real(kind=wr), private, parameter :: p231 = 2147483648.0_wr - real(kind=wr), private, parameter :: p232 = 4294967296.0_wr - real(kind=wr), private, parameter :: p232_1 = p232 - 1.0_wr - real(kind=wr), private, parameter :: pi232 = 1.0_wr / p232 - real(kind=wr), private, parameter :: pi232_1 = 1.0_wr / p232_1 - real(kind=wr), private, parameter :: pi227 = 1.0_wr / 134217728.0_wr - real(kind=wr), private, parameter :: pi253 = 1.0_wr / 9007199254740992.0_wr - real(kind=wr), private, parameter :: p231d232_1 = p231 / p232_1 - real(kind=wr), private, parameter :: p231_5d232 = ( p231 + 0.5_wr ) / p232 - - character(len=*), private, parameter :: alph = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" - character(len=*), private, parameter :: sepr = "&" - integer(kind=wi), private, parameter :: alps = 62_wi - integer(kind=wi), private, parameter :: clen = ( n + 1_wi ) * 7_wi !n * ( ceiling( fbs * log( 2.0_core_rknd ) / log( alps ) ) + 1 ) - - type, public :: genrand_state - private - logical(kind=wi) :: ini = .false._wi - integer(kind=wi) :: cnt = n+1_wi - integer(kind=wi), dimension(n) :: val = 0_wi - end type genrand_state - - type, public :: genrand_srepr - character(len=clen) :: repr - end type genrand_srepr - - type(genrand_state), private, save :: state - - interface assignment( = ) - module procedure genrand_load_state - module procedure genrand_dump_state - end interface assignment( = ) - - interface genrand_init - module procedure init_by_type - module procedure init_by_scalar - module procedure init_by_array - end interface genrand_init - - interface genrand_int32 - module procedure genrand_int32_0d - module procedure genrand_int32_1d - module procedure genrand_int32_2d - module procedure genrand_int32_3d - module procedure genrand_int32_4d - module procedure genrand_int32_5d - module procedure genrand_int32_6d - module procedure genrand_int32_7d - end interface genrand_int32 - - interface genrand_int31 - module procedure genrand_int31_0d - module procedure genrand_int31_1d - module procedure genrand_int31_2d - module procedure genrand_int31_3d - module procedure genrand_int31_4d - module procedure genrand_int31_5d - module procedure genrand_int31_6d - module procedure genrand_int31_7d - end interface genrand_int31 - - interface genrand_real1 - module procedure genrand_real1_0d - module procedure genrand_real1_1d - module procedure genrand_real1_2d - module procedure genrand_real1_3d - module procedure genrand_real1_4d - module procedure genrand_real1_5d - module procedure genrand_real1_6d - module procedure genrand_real1_7d - end interface genrand_real1 - - interface genrand_real2 - module procedure genrand_real2_0d - module procedure genrand_real2_1d - module procedure genrand_real2_2d - module procedure genrand_real2_3d - module procedure genrand_real2_4d - module procedure genrand_real2_5d - module procedure genrand_real2_6d - module procedure genrand_real2_7d - end interface genrand_real2 - - interface genrand_real3 - module procedure genrand_real3_0d - module procedure genrand_real3_1d - module procedure genrand_real3_2d - module procedure genrand_real3_3d - module procedure genrand_real3_4d - module procedure genrand_real3_5d - module procedure genrand_real3_6d - module procedure genrand_real3_7d - end interface genrand_real3 - - interface genrand_res53 - module procedure genrand_res53_0d - module procedure genrand_res53_1d - module procedure genrand_res53_2d - module procedure genrand_res53_3d - module procedure genrand_res53_4d - module procedure genrand_res53_5d - module procedure genrand_res53_6d - module procedure genrand_res53_7d - end interface genrand_res53 - - contains - - elemental function uiadd( a, b ) result( c ) - - intrinsic :: ibits, ior, ishft - - integer( kind = wi ), intent( in ) :: a, b - - integer( kind = wi ) :: c - - integer( kind = wi ) :: a1, a2, b1, b2, s1, s2 - - a1 = ibits( a, 0, hbs ) - a2 = ibits( a, hbs, hbs ) - b1 = ibits( b, 0, hbs ) - b2 = ibits( b, hbs, hbs ) - s1 = a1 + b1 - s2 = a2 + b2 + ibits( s1, hbs, hbs ) - c = ior( ishft( s2, hbs ), ibits( s1, 0, hbs ) ) - return - - end function uiadd - - elemental function uisub( a, b ) result( c ) - - intrinsic :: ibits, ior, ishft - - integer( kind = wi ), intent( in ) :: a, b - - integer( kind = wi ) :: c - - integer( kind = wi ) :: a1, a2, b1, b2, s1, s2 - - a1 = ibits( a, 0, hbs ) - a2 = ibits( a, hbs, hbs ) - b1 = ibits( b, 0, hbs ) - b2 = ibits( b, hbs, hbs ) - s1 = a1 - b1 - s2 = a2 - b2 + ibits( s1, hbs, hbs ) - c = ior( ishft( s2, hbs ), ibits( s1, 0, hbs ) ) - return - - end function uisub - - elemental function uimlt( a, b ) result( c ) - - intrinsic :: ibits, ior, ishft - - integer(kind=wi), intent(in) :: a, b - - integer(kind=wi) :: c - - integer(kind=wi) :: a0, a1, a2, a3 - integer(kind=wi) :: b0, b1, b2, b3 - integer(kind=wi) :: p0, p1, p2, p3 - - a0 = ibits( a, 0, qbs ) - a1 = ibits( a, qbs, qbs ) - a2 = ibits( a, hbs, qbs ) - a3 = ibits( a, tbs, qbs ) - b0 = ibits( b, 0, qbs ) - b1 = ibits( b, qbs, qbs ) - b2 = ibits( b, hbs, qbs ) - b3 = ibits( b, tbs, qbs ) - p0 = a0 * b0 - p1 = a1 * b0 + a0 * b1 + ibits( p0, qbs, tbs ) - p2 = a2 * b0 + a1 * b1 + a0 * b2 + ibits( p1, qbs, tbs ) - p3 = a3 * b0 + a2 * b1 + a1 * b2 + a0 * b3 + ibits( p2, qbs, tbs ) - c = ior( ishft( p1, qbs ), ibits( p0, 0, qbs ) ) - c = ior( ishft( p2, hbs ), ibits( c, 0, hbs ) ) - c = ior( ishft( p3, tbs ), ibits( c, 0, tbs ) ) - return - - end function uimlt - - elemental function uidiv( a, b ) result( c ) - - intrinsic :: btest, ishft - - integer(kind=wi), intent(in) :: a, b - - integer(kind=wi) :: c - - integer(kind=wi) :: dl, rl - - if ( btest( a, fbs-1 ) ) then - if ( btest( b, fbs-1 ) ) then - if ( a < b ) then - c = 0 - else - c = 1 - end if - else - dl = ishft( ishft( a, -1 ) / b, 1 ) - rl = uisub( a, uimlt( b, dl ) ) - if ( rl < b ) then - c = dl - else - c = uiadd( dl, 1 ) - end if - end if - else - if ( btest( b, fbs-1 ) ) then - c = 0 - else - c = a / b - end if - end if - return - - end function uidiv - - elemental function uimod( a, b ) result( c ) - - intrinsic :: modulo, btest, ishft - - integer(kind=wi), intent(in) :: a, b - - integer(kind=wi) :: c - - integer(kind=wi) :: dl, rl - - if ( btest( a, fbs-1 ) ) then - if ( btest( b, fbs-1 ) ) then - if ( a < b ) then - c = a - else - c = uisub( a, b ) - end if - else - dl = ishft( ishft( a, -1 ) / b, 1 ) - rl = uisub( a, uimlt( b, dl ) ) - if ( rl < b ) then - c = rl - else - c = uisub( rl, b ) - end if - end if - else - if ( btest( b, fbs-1 ) ) then - c = a - else - c = modulo( a, b ) - end if - end if - return - - end function uimod - - subroutine init_by_type( put, get ) - - intrinsic :: present - - type(genrand_state), optional, intent(in ) :: put - type(genrand_state), optional, intent(out) :: get - - if ( present( put ) ) then - if ( put%ini ) state = put - else if ( present( get ) ) then - if ( .not. state%ini ) call init_by_scalar( default_seed ) - get = state - else - call init_by_scalar( default_seed ) - end if - return - - end subroutine init_by_type - - ! initializes mt[N] with a seed - subroutine init_by_scalar( put ) - - intrinsic :: ishft, ieor, ibits - - integer(kind=wi), parameter :: mult_a = 1812433253_wi !z'6C078965' - - integer(kind=wi), intent(in) :: put - - integer(kind=wi) :: i - - state%ini = .true._wi - state%val(1) = ibits( put, 0, fbs ) - do i = 2, n, 1 - state%val(i) = ieor( state%val(i-1), ishft( state%val(i-1), -30 ) ) - state%val(i) = uimlt( state%val(i), mult_a ) - state%val(i) = uiadd( state%val(i), i-1_wi ) - ! See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. - ! In the previous versions, MSBs of the seed affect - ! only MSBs of the array mt[]. - ! 2002/01/09 modified by Makoto Matsumoto - state%val(i) = ibits( state%val(i), 0, fbs ) - ! for >32 bit machines - end do - state%cnt = n + 1_wi - return - - end subroutine init_by_scalar - - ! initialize by an array with array-length - ! init_key is the array for initializing keys - ! key_length is its length - subroutine init_by_array( put ) - - intrinsic :: size, max, ishft, ieor, ibits - - integer(kind=wi), parameter :: seed_d = 19650218_wi !z'12BD6AA' - integer(kind=wi), parameter :: mult_a = 1664525_wi !z'19660D' - integer(kind=wi), parameter :: mult_b = 1566083941_wi !z'5D588B65' - integer(kind=wi), parameter :: msb1_d = ishft( 1_wi, fbs-1 ) !z'80000000' - - integer(kind=wi), dimension(:), intent(in) :: put - - integer(kind=wi) :: i, j, k, tp, key_length - - call init_by_scalar( seed_d ) - key_length = size( put, dim=1 ) - i = 2_wi - j = 1_wi - do k = max( n, key_length ), 1, -1 - tp = ieor( state%val(i-1), ishft( state%val(i-1), -30 ) ) - tp = uimlt( tp, mult_a ) - state%val(i) = ieor( state%val(i), tp ) - state%val(i) = uiadd( state%val(i), uiadd( put(j), j-1_wi ) ) ! non linear - state%val(i) = ibits( state%val(i), 0, fbs ) ! for WORDSIZE > 32 machines - i = i + 1_wi - j = j + 1_wi - if ( i > n ) then - state%val(1) = state%val(n) - i = 2_wi - end if - if ( j > key_length) j = 1_wi - end do - do k = n-1, 1, -1 - tp = ieor( state%val(i-1), ishft( state%val(i-1), -30 ) ) - tp = uimlt( tp, mult_b ) - state%val(i) = ieor( state%val(i), tp ) - state%val(i) = uisub( state%val(i), i-1_wi ) ! non linear - state%val(i) = ibits( state%val(i), 0, fbs ) ! for WORDSIZE > 32 machines - i = i + 1_wi - if ( i > n ) then - state%val(1) = state%val(n) - i = 2_wi - end if - end do - state%val(1) = msb1_d ! MSB is 1; assuring non-zero initial array - return - - end subroutine init_by_array - - subroutine next_state( ) - - intrinsic :: ishft, ieor, btest, ibits, mvbits - - integer(kind=wi), parameter :: matrix_a = -1727483681_wi !z'9908b0df' - - integer(kind=wi) :: i, mld - - if ( .not. state%ini ) call init_by_scalar( default_seed ) - do i = 1, n-m, 1 - mld = ibits( state%val(i+1), 0, 31 ) - call mvbits( state%val(i), 31, 1, mld, 31 ) - state%val(i) = ieor( state%val(i+m), ishft( mld, -1 ) ) - if ( btest( state%val(i+1), 0 ) ) state%val(i) = ieor( state%val(i), matrix_a ) - end do - do i = n-m+1, n-1, 1 - mld = ibits( state%val(i+1), 0, 31 ) - call mvbits( state%val(i), 31, 1, mld, 31 ) - state%val(i) = ieor( state%val(i+m-n), ishft( mld, -1 ) ) - if ( btest( state%val(i+1), 0 ) ) state%val(i) = ieor( state%val(i), matrix_a ) - end do - mld = ibits( state%val(1), 0, 31 ) - call mvbits( state%val(n), 31, 1, mld, 31 ) - state%val(n) = ieor( state%val(m), ishft( mld, -1 ) ) - if ( btest( state%val(1), 0 ) ) state%val(n) = ieor( state%val(n), matrix_a ) - state%cnt = 1_wi - return - - end subroutine next_state - - elemental subroutine genrand_encode( chr, val ) - - intrinsic :: len - - character(len=*), intent(out) :: chr - integer(kind=wi), intent(in ) :: val - - integer(kind=wi) :: i, m, d - - d = val - chr = "" - do i = 1, len( chr ), 1 - m = uimod( d, alps ) + 1 - chr(i:i) = alph(m:m) - d = uidiv( d, alps ) - if ( d == 0 ) exit - end do - return - - end subroutine genrand_encode - - elemental subroutine genrand_decode( val, chr ) - - intrinsic :: len, len_trim, trim, adjustl, scan - - integer(kind=wi), intent(out) :: val - character(len=*), intent(in ) :: chr - - integer(kind=wi) :: i, e, p - character(len=len(chr)) :: c - - e = 1 - c = trim( adjustl( chr ) ) - val = 0 - do i = 1, len_trim( c ), 1 - p = scan( alph, c(i:i) ) - 1 - if( p >= 0 ) then - val = uiadd( val, uimlt( p, e ) ) - e = uimlt( e, alps ) - end if - end do - return - - end subroutine genrand_decode - - elemental subroutine genrand_load_state( stt, rpr ) - - intrinsic :: scan - - type(genrand_state), intent(out) :: stt - type(genrand_srepr), intent(in ) :: rpr - - integer(kind=wi) :: i, j - character(len=clen) :: c - - i = 1 - c = rpr%repr - do - j = scan( c, sepr ) - if ( j /= 0 ) then - call genrand_decode( stt%val(i), c(:j-1) ) - i = i + 1 - c = c(j+1:) - else - exit - end if - end do - call genrand_decode( stt%cnt, c ) - stt%ini = .true._wi - return - - end subroutine genrand_load_state - - elemental subroutine genrand_dump_state( rpr, stt ) - - intrinsic :: len_trim - - type(genrand_srepr), intent(out) :: rpr - type(genrand_state), intent(in ) :: stt - - integer(kind=wi) :: i, j - - j = 1 - rpr%repr = "" - do i = 1, n, 1 - call genrand_encode( rpr%repr(j:), stt%val(i) ) - j = len_trim( rpr%repr ) + 1 - rpr%repr(j:j) = sepr - j = j + 1 - end do - call genrand_encode( rpr%repr(j:), stt%cnt ) - return - - end subroutine genrand_dump_state - - ! generates a random number on [0,0xffffffff]-interval - subroutine genrand_int32_0d( y ) - - intrinsic :: ieor, iand, ishft - - integer(kind=wi), parameter :: temper_a = -1658038656_wi !z'9D2C5680' - integer(kind=wi), parameter :: temper_b = -272236544_wi !z'EFC60000' - - integer(kind=wi), intent(out) :: y - - if ( state%cnt > n ) call next_state( ) - y = state%val(state%cnt) - state%cnt = state%cnt + 1_wi - ! Tempering - y = ieor( y, ishft( y, -11 ) ) - y = ieor( y, iand( ishft( y, 7 ), temper_a ) ) - y = ieor( y, iand( ishft( y, 15 ), temper_b ) ) - y = ieor( y, ishft( y, -18 ) ) - return - - end subroutine genrand_int32_0d - - subroutine genrand_int32_1d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 1 ), 1 - call genrand_int32_0d( y(i) ) - end do - return - - end subroutine genrand_int32_1d - - subroutine genrand_int32_2d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:,:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 2 ), 1 - call genrand_int32_1d( y(:,i) ) - end do - return - - end subroutine genrand_int32_2d - - subroutine genrand_int32_3d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:,:,:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 3 ), 1 - call genrand_int32_2d( y(:,:,i) ) - end do - return - - end subroutine genrand_int32_3d - - subroutine genrand_int32_4d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:,:,:,:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 4 ), 1 - call genrand_int32_3d( y(:,:,:,i) ) - end do - return - - end subroutine genrand_int32_4d - - subroutine genrand_int32_5d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:,:,:,:,:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 5 ), 1 - call genrand_int32_4d( y(:,:,:,:,i) ) - end do - return - - end subroutine genrand_int32_5d - - subroutine genrand_int32_6d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:,:,:,:,:,:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 6 ), 1 - call genrand_int32_5d( y(:,:,:,:,:,i) ) - end do - return - - end subroutine genrand_int32_6d - - subroutine genrand_int32_7d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:,:,:,:,:,:,:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 7 ), 1 - call genrand_int32_6d( y(:,:,:,:,:,:,i) ) - end do - return - - end subroutine genrand_int32_7d - - ! generates a random number on [0,0x7fffffff]-interval - subroutine genrand_int31_0d( y ) - - intrinsic :: ishft - - integer(kind=wi), intent(out) :: y - - call genrand_int32_0d( y ) - y = ishft( y, -1 ) - return - - end subroutine genrand_int31_0d - - subroutine genrand_int31_1d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 1 ), 1 - call genrand_int31_0d( y(i) ) - end do - return - - end subroutine genrand_int31_1d - - subroutine genrand_int31_2d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:,:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 2 ), 1 - call genrand_int31_1d( y(:,i) ) - end do - return - - end subroutine genrand_int31_2d - - subroutine genrand_int31_3d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:,:,:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 3 ), 1 - call genrand_int31_2d( y(:,:,i) ) - end do - return - - end subroutine genrand_int31_3d - - subroutine genrand_int31_4d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:,:,:,:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 4 ), 1 - call genrand_int31_3d( y(:,:,:,i) ) - end do - return - - end subroutine genrand_int31_4d - - subroutine genrand_int31_5d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:,:,:,:,:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 5 ), 1 - call genrand_int31_4d( y(:,:,:,:,i) ) - end do - return - - end subroutine genrand_int31_5d - - subroutine genrand_int31_6d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:,:,:,:,:,:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 6 ), 1 - call genrand_int31_5d( y(:,:,:,:,:,i) ) - end do - return - - end subroutine genrand_int31_6d - - subroutine genrand_int31_7d( y ) - - intrinsic :: size - - integer(kind=wi), dimension(:,:,:,:,:,:,:), intent(out) :: y - - integer(kind=wi) :: i - - do i = 1, size( y, 7 ), 1 - call genrand_int31_6d( y(:,:,:,:,:,:,i) ) - end do - return - - end subroutine genrand_int31_7d - - ! generates a random number on [0,1]-real-interval - subroutine genrand_real1_0d( r ) - - intrinsic :: real - - real(kind=wr), intent(out) :: r - - integer(kind=wi) :: a - - call genrand_int32_0d( a ) - r = real( a, kind=wr ) * pi232_1 + p231d232_1 - ! divided by 2^32-1 - return - - end subroutine genrand_real1_0d - - subroutine genrand_real1_1d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 1 ), 1 - call genrand_real1_0d( r(i) ) - end do - return - - end subroutine genrand_real1_1d - - subroutine genrand_real1_2d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 2 ), 1 - call genrand_real1_1d( r(:,i) ) - end do - return - - end subroutine genrand_real1_2d - - subroutine genrand_real1_3d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 3 ), 1 - call genrand_real1_2d( r(:,:,i) ) - end do - return - - end subroutine genrand_real1_3d - - subroutine genrand_real1_4d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 4 ), 1 - call genrand_real1_3d( r(:,:,:,i) ) - end do - return - - end subroutine genrand_real1_4d - - subroutine genrand_real1_5d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 5 ), 1 - call genrand_real1_4d( r(:,:,:,:,i) ) - end do - return - - end subroutine genrand_real1_5d - - subroutine genrand_real1_6d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 6 ), 1 - call genrand_real1_5d( r(:,:,:,:,:,i) ) - end do - return - - end subroutine genrand_real1_6d - - subroutine genrand_real1_7d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 7 ), 1 - call genrand_real1_6d( r(:,:,:,:,:,:,i) ) - end do - return - - end subroutine genrand_real1_7d - - ! generates a random number on [0,1)-real-interval - subroutine genrand_real2_0d( r ) - - intrinsic :: real - - real(kind=wr), intent(out) :: r - - integer(kind=wi) :: a - - call genrand_int32_0d( a ) - r = real( a, kind=wr ) * pi232 + 0.5_wr - ! divided by 2^32 - return - - end subroutine genrand_real2_0d - - subroutine genrand_real2_1d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 1 ), 1 - call genrand_real2_0d( r(i) ) - end do - return - - end subroutine genrand_real2_1d - - subroutine genrand_real2_2d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 2 ), 1 - call genrand_real2_1d( r(:,i) ) - end do - return - - end subroutine genrand_real2_2d - - subroutine genrand_real2_3d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 3 ), 1 - call genrand_real2_2d( r(:,:,i) ) - end do - return - - end subroutine genrand_real2_3d - - subroutine genrand_real2_4d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 4 ), 1 - call genrand_real2_3d( r(:,:,:,i) ) - end do - return - - end subroutine genrand_real2_4d - - subroutine genrand_real2_5d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 5 ), 1 - call genrand_real2_4d( r(:,:,:,:,i) ) - end do - return - - end subroutine genrand_real2_5d - - subroutine genrand_real2_6d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 6 ), 1 - call genrand_real2_5d( r(:,:,:,:,:,i) ) - end do - return - - end subroutine genrand_real2_6d - - subroutine genrand_real2_7d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 7 ), 1 - call genrand_real2_6d( r(:,:,:,:,:,:,i) ) - end do - return - - end subroutine genrand_real2_7d - - ! generates a random number on (0,1)-real-interval - subroutine genrand_real3_0d( r ) - - intrinsic :: real - - real(kind=wr), intent(out) :: r - - integer(kind=wi) :: a - - call genrand_int32_0d( a ) - r = real( a, kind=wr ) * pi232 + p231_5d232 - ! divided by 2^32 - return - - end subroutine genrand_real3_0d - - subroutine genrand_real3_1d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 1 ), 1 - call genrand_real3_0d( r(i) ) - end do - return - - end subroutine genrand_real3_1d - - subroutine genrand_real3_2d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 2 ), 1 - call genrand_real3_1d( r(:,i) ) - end do - return - - end subroutine genrand_real3_2d - - subroutine genrand_real3_3d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 3 ), 1 - call genrand_real3_2d( r(:,:,i) ) - end do - return - - end subroutine genrand_real3_3d - - subroutine genrand_real3_4d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 4 ), 1 - call genrand_real3_3d( r(:,:,:,i) ) - end do - return - - end subroutine genrand_real3_4d - - subroutine genrand_real3_5d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 5 ), 1 - call genrand_real3_4d( r(:,:,:,:,i) ) - end do - return - - end subroutine genrand_real3_5d - - subroutine genrand_real3_6d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 6 ), 1 - call genrand_real3_5d( r(:,:,:,:,:,i) ) - end do - return - - end subroutine genrand_real3_6d - - subroutine genrand_real3_7d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 7 ), 1 - call genrand_real3_6d( r(:,:,:,:,:,:,i) ) - end do - return - - end subroutine genrand_real3_7d - - ! generates a random number on [0,1) with 53-bit resolution - subroutine genrand_res53_0d( r ) - - intrinsic :: ishft, real - - real(kind=wr), intent(out) :: r - - integer(kind=wi) :: a, b - - call genrand_int32_0d( a ) - call genrand_int32_0d( b ) - a = ishft( a, -5 ) - b = ishft( b, -6 ) - r = real( a, kind=wr ) * pi227 + real( b, kind=wr ) * pi253 - return - - end subroutine genrand_res53_0d - - subroutine genrand_res53_1d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 1 ), 1 - call genrand_res53_0d( r(i) ) - end do - return - - end subroutine genrand_res53_1d - - subroutine genrand_res53_2d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 2 ), 1 - call genrand_res53_1d( r(:,i) ) - end do - return - - end subroutine genrand_res53_2d - - subroutine genrand_res53_3d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 3 ), 1 - call genrand_res53_2d( r(:,:,i) ) - end do - return - - end subroutine genrand_res53_3d - - subroutine genrand_res53_4d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 4 ), 1 - call genrand_res53_3d( r(:,:,:,i) ) - end do - return - - end subroutine genrand_res53_4d - - subroutine genrand_res53_5d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 5 ), 1 - call genrand_res53_4d( r(:,:,:,:,i) ) - end do - return - - end subroutine genrand_res53_5d - - subroutine genrand_res53_6d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 6 ), 1 - call genrand_res53_5d( r(:,:,:,:,:,i) ) - end do - return - - end subroutine genrand_res53_6d - - subroutine genrand_res53_7d( r ) - - intrinsic :: size - - real(kind=wr), dimension(:,:,:,:,:,:,:), intent(out) :: r - - integer(kind=wi) :: i - - do i = 1, size( r, 7 ), 1 - call genrand_res53_6d( r(:,:,:,:,:,:,i) ) - end do - return - - end subroutine genrand_res53_7d - ! These real versions are due to Isaku Wada, 2002/01/09 added - ! Altered by Jos Sousa genrand_real[1-3] will not return exactely - ! the same values but should have the same properties and are faster - -end module crmx_mt95 - diff --git a/src/physics/spcam/crm/CLUBB/crmx_numerical_check.F90 b/src/physics/spcam/crm/CLUBB/crmx_numerical_check.F90 deleted file mode 100644 index c6650f4a99..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_numerical_check.F90 +++ /dev/null @@ -1,1072 +0,0 @@ -!------------------------------------------------------------------------ -! $Id: numerical_check.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -module crmx_numerical_check - - implicit none - -! Made is_nan_2d public so it may be used -! for finding code that cause NaNs -! Joshua Fasching November 2007 - -! *_check subroutines were added to ensure that the -! subroutines they are checking perform correctly -! Joshua Fasching February 2008 - -! rad_clipping has been replaced by rad_check as the new -! subroutine only reports if there are invalid values. -! Joshua Fasching March 2008 - - private ! Default scope - - public :: invalid_model_arrays, is_nan_2d, & - rad_check, parameterization_check, & - surface_varnce_check, pdf_closure_check, & - length_check, is_nan_sclr, calculate_spurious_source - - private :: check_negative, check_nan - - - ! Abstraction of check_nan - interface check_nan - module procedure check_nan_sclr, check_nan_2d - end interface - - ! Abstraction of check_negative - interface check_negative - module procedure check_negative_total, check_negative_index - end interface - - - contains -!--------------------------------------------------------------------------------- - subroutine length_check( Lscale, Lscale_up, Lscale_down, err_code ) -! -! Description: This subroutine determines if any of the output -! variables for the length_new subroutine carry values that -! are NaNs. -! -! Joshua Fasching February 2008 -!--------------------------------------------------------------------------------- - use crmx_grid_class, only: & - gr ! Variable - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant Parameters - character(*), parameter :: proc_name = "compute_length" - - ! Input Variables - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - Lscale, & ! Mixing length [m] - Lscale_up, & ! Upward mixing length [m] - Lscale_down ! Downward mixing length [m] - - ! Output Variable - integer, intent(inout) :: & - err_code - -!----------------------------------------------------------------------------- - - call check_nan( Lscale, "Lscale", proc_name, err_code ) - call check_nan( Lscale_up, "Lscale_up", proc_name, err_code ) - call check_nan( Lscale_down, "Lscale_down", proc_name, err_code ) - - return - end subroutine length_check - -!--------------------------------------------------------------------------- - subroutine pdf_closure_check( wp4, wprtp2, wp2rtp, wpthlp2, & - wp2thlp, cloud_frac, rcm, wpthvp, wp2thvp, & - rtpthvp, thlpthvp, wprcp, wp2rcp, & - rtprcp, thlprcp, rcp2, wprtpthlp, & - crt1, crt2, cthl1, cthl2, pdf_params, & - err_code, & - sclrpthvp, sclrprcp, wpsclrp2, & - wpsclrprtp, wpsclrpthlp, wp2sclrp ) - -! Description: This subroutine determines if any of the output -! variables for the pdf_closure subroutine carry values that -! are NaNs. -! -! Joshua Fasching February 2008 -!--------------------------------------------------------------------------- - - use crmx_parameters_model, only: & - sclr_dim ! Variable - - use crmx_pdf_parameter_module, only: & - pdf_parameter ! type - - use crmx_stats_variables, only: & - iwp4, & ! Variables - ircp2, & - iwprtp2, & - iwprtpthlp, & - iwpthlp2 - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Parameter Constants - character(len=*), parameter :: proc_name = & - "pdf_closure" - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - wp4, & ! w'^4 [m^4/s^4] - wprtp2, & ! w' r_t' [(m kg)/(s kg)] - wp2rtp, & ! w'^2 r_t' [(m^2 kg)/(s^2 kg)] - wpthlp2, & ! w' th_l'^2 [(m K^2)/s] - wp2thlp, & ! w'^2 th_l' [(m^2 K)/s^2] - cloud_frac, & ! Cloud fraction [-] - rcm, & ! Mean liquid water [kg/kg] - wpthvp, & ! Buoyancy flux [(K m)/s] - wp2thvp, & ! w'^2 th_v' [(m^2 K)/s^2] - rtpthvp, & ! r_t' th_v' [(kg K)/kg] - thlpthvp, & ! th_l' th_v' [K^2] - wprcp, & ! w' r_c' [(m kg)/(s kg)] - wp2rcp, & ! w'^2 r_c' [(m^2 kg)/(s^2 kg)] - rtprcp, & ! r_t' r_c' [(kg^2)/(kg^2)] - thlprcp, & ! th_l' r_c' [(K kg)/kg] - rcp2, & ! r_c'^2 [(kg^2)/(kg^2)] - wprtpthlp, & ! w' r_t' th_l' [(m kg K)/(s kg)] - crt1, crt2, & - cthl1, cthl2 - - type(pdf_parameter), intent(in) :: & - pdf_params ! PDF parameters [units vary] - - ! Input (Optional passive scalar variables) - real( kind = core_rknd ), dimension(sclr_dim), intent(in) :: & - sclrpthvp, & - sclrprcp, & - wpsclrp2, & - wpsclrprtp, & - wpsclrpthlp, & - wp2sclrp - - ! Output Variable - integer, intent(inout) :: & - err_code ! Returns appropriate error code - -!------------------------------------------------------------------------------- - - ! ---- Begin Code ---- - - if ( iwp4 > 0 ) call check_nan( wp4,"wp4", proc_name, err_code ) - if ( iwprtp2 > 0 ) call check_nan( wprtp2,"wprtp2", proc_name, err_code ) - call check_nan( wp2rtp,"wp2rtp", proc_name, err_code ) - if ( iwpthlp2 > 0 ) call check_nan( wpthlp2,"wpthlp2", proc_name, err_code ) - call check_nan( wp2thlp,"wp2thlp", proc_name, err_code ) - call check_nan( cloud_frac,"cloud_frac", proc_name, err_code ) - call check_nan( rcm,"rcm", proc_name, err_code ) - call check_nan( wpthvp, "wpthvp", proc_name, err_code ) - call check_nan( wp2thvp, "wp2thvp", proc_name, err_code ) - call check_nan( rtpthvp, "rtpthvp", proc_name, err_code ) - call check_nan( thlpthvp, "thlpthvp", proc_name, err_code ) - call check_nan( wprcp, "wprcp", proc_name, err_code ) - call check_nan( wp2rcp, "wp2rcp", proc_name, err_code ) - call check_nan( rtprcp, "rtprcp", proc_name, err_code ) - call check_nan( thlprcp, "thlprcp", proc_name, err_code ) - if ( ircp2 > 0 ) call check_nan( rcp2, "rcp2", proc_name, err_code) - if ( iwprtpthlp > 0 ) call check_nan( wprtpthlp, "wprtpthlp", proc_name, err_code ) - call check_nan( crt1, "crt1", proc_name, err_code ) - call check_nan( crt2, "crt2", proc_name, err_code ) - call check_nan( cthl1, "cthl1", proc_name, err_code ) - call check_nan( cthl2, "cthl2", proc_name, err_code ) - ! Check each PDF parameter at the grid level sent in. - call check_nan( pdf_params%w1, "pdf_params%w1", proc_name, err_code ) - call check_nan( pdf_params%w2, "pdf_params%w2", proc_name, err_code ) - call check_nan( pdf_params%varnce_w1, "pdf_params%varnce_w1", proc_name, err_code ) - call check_nan( pdf_params%varnce_w2, "pdf_params%varnce_w2", proc_name, err_code ) - call check_nan( pdf_params%rt1, "pdf_params%rt1", proc_name, err_code ) - call check_nan( pdf_params%rt2, "pdf_params%rt2", proc_name, err_code ) - call check_nan( pdf_params%varnce_rt1, "pdf_params%varnce_rt1", proc_name, err_code ) - call check_nan( pdf_params%varnce_rt2, "pdf_params%varnce_rt2", proc_name, err_code ) - call check_nan( pdf_params%thl1, "pdf_params%thl1", proc_name, err_code ) - call check_nan( pdf_params%thl2, "pdf_params%thl2", proc_name, err_code ) - call check_nan( pdf_params%varnce_thl1, "pdf_params%varnce_thl1", proc_name, err_code ) - call check_nan( pdf_params%varnce_thl2, "pdf_params%varnce_thl2", proc_name, err_code ) - call check_nan( pdf_params%mixt_frac, "pdf_params%mixt_frac", proc_name, err_code ) - call check_nan( pdf_params%rrtthl, "pdf_params%rrtthl", proc_name, err_code ) - call check_nan( pdf_params%rc1, "pdf_params%rc1", proc_name, err_code ) - call check_nan( pdf_params%rc2, "pdf_params%rc2", proc_name, err_code ) - call check_nan( pdf_params%rsl1, "pdf_params%rsl1", proc_name, err_code ) - call check_nan( pdf_params%rsl2, "pdf_params%rsl2", proc_name, err_code ) - call check_nan( pdf_params%cloud_frac1, "pdf_params%cloud_frac1", proc_name, err_code ) - call check_nan( pdf_params%cloud_frac2, "pdf_params%cloud_frac2", proc_name, err_code ) - call check_nan( pdf_params%s1, "pdf_params%s1", proc_name, err_code ) - call check_nan( pdf_params%s2, "pdf_params%s2", proc_name, err_code ) - call check_nan( pdf_params%stdev_s1, "pdf_params%stdev_s1", proc_name, err_code ) - call check_nan( pdf_params%stdev_s2, "pdf_params%stdev_s2", proc_name, err_code ) - call check_nan( pdf_params%alpha_thl, "pdf_params%alpha_thl", proc_name, err_code ) - call check_nan( pdf_params%alpha_rt, "pdf_params%alpha_rt", proc_name, err_code ) - - if ( sclr_dim > 0 ) then - call check_nan( sclrpthvp,"sclrpthvp", & - proc_name, err_code) - call check_nan( sclrprcp, "sclrprcp", & - proc_name, err_code ) - call check_nan( wpsclrprtp, "wpsclrprtp", & - proc_name, err_code ) - call check_nan( wpsclrp2, "wpsclrp2", & - proc_name, err_code ) - call check_nan( wpsclrpthlp, "wpsclrtlp", & - proc_name, err_code ) - call check_nan( wp2sclrp, "wp2sclrp", & - proc_name, err_code ) - end if - - return - end subroutine pdf_closure_check - -!------------------------------------------------------------------------------- - subroutine parameterization_check & - ( thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & - wm_zm, wm_zt, p_in_Pa, rho_zm, rho, exner, & - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & - wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & - um, upwp, vm, vpwp, up2, vp2, & - rtm, wprtp, thlm, wpthlp, & - wp2, wp3, rtp2, thlp2, rtpthlp, & - prefix, & - wpsclrp_sfc, wpedsclrp_sfc, & - sclrm, wpsclrp, sclrp2, sclrprtp, sclrpthlp, & - sclrm_forcing, edsclrm, edsclrm_forcing, err_code ) -! -! Description: -! This subroutine determines what input variables may have NaN values. -! In addition it checks to see if rho_zm, rho, exner, up2, vp2, rtm, thlm, -! wp2, rtp2, thlp2, or tau_zm have negative values. -!------------------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr ! Variable - - use crmx_parameters_model, only: & - sclr_dim, & ! Variable - edsclr_dim - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant Parameters - ! Name of the procedure using parameterization_check - character(len=25), parameter :: & - proc_name = "parameterization_timestep" - - ! Input variables - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s] - rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] - um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s] - vm_forcing, & ! v wind forcing (thermodynamic levels) [m/s/s] - wm_zm, & ! w mean wind component on momentum levels [m/s] - wm_zt, & ! w mean wind component on thermo. levels [m/s] - p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa] - rho_zm, & ! Air density on momentum levels [kg/m^3] - rho, & ! Air density on thermodynamic levels [kg/m^3] - exner, & ! Exner function (thermodynamic levels) [-] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermo. levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density @ momentum levs. [m^3/kg] - invrs_rho_ds_zt, & ! Inv. dry, static density @ thermo. levs. [m^3/kg] - thv_ds_zm, & ! Dry, base-state theta_v on momentum levs. [K] - thv_ds_zt ! Dry, base-state theta_v on thermo. levs. [K] - - real( kind = core_rknd ), intent(in) :: & - wpthlp_sfc, & ! w' theta_l' at surface. [(m K)/s] - wprtp_sfc, & ! w' r_t' at surface. [(kg m)/( kg s)] - upwp_sfc, & ! u'w' at surface. [m^2/s^2] - vpwp_sfc ! v'w' at surface. [m^2/s^2] - - ! These are prognostic or are planned to be in the future - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - um, & ! u mean wind component (thermodynamic levels) [m/s] - upwp, & ! u'w' (momentum levels) [m^2/s^2] - vm, & ! v mean wind component (thermodynamic levels) [m/s] - vpwp, & ! v'w' (momentum levels) [m^2/s^2] - up2, & ! u'^2 (momentum levels) [m^2/s^2] - vp2, & ! v'^2 (momentum levels) [m^2/s^2] - rtm, & ! total water mixing ratio, r_t (thermo. levels) [kg/kg] - wprtp, & ! w' r_t' (momentum levels) [(kg/kg) m/s] - thlm, & ! liq. water pot. temp., th_l (thermo. levels) [K] - wpthlp, & ! w' th_l' (momentum levels) [(m/s) K] - rtp2, & ! r_t'^2 (momentum levels) [(kg/kg)^2] - thlp2, & ! th_l'^2 (momentum levels) [K^2] - rtpthlp, & ! r_t' th_l' (momentum levels) [(kg/kg) K] - wp2, & ! w'^2 (momentum levels) [m^2/s^2] - wp3 ! w'^3 (thermodynamic levels) [m^3/s^3] - - character(len=*), intent(in) :: prefix ! Location where subroutine is called - - real( kind = core_rknd ), intent(in), dimension(sclr_dim) :: & - wpsclrp_sfc ! Scalar flux at surface [units m/s] - - real( kind = core_rknd ), intent(in), dimension(edsclr_dim) :: & - wpedsclrp_sfc ! Eddy-Scalar flux at surface [units m/s] - - real( kind = core_rknd ), intent(in),dimension(gr%nz,sclr_dim) :: & - sclrm, & ! Passive scalar mean [units vary] - wpsclrp, & ! w'sclr' [units vary] - sclrp2, & ! sclr'^2 [units vary] - sclrprtp, & ! sclr'rt' [units vary] - sclrpthlp, & ! sclr'thl' [units vary] - sclrm_forcing ! Passive scalar forcing [units / s] - - real( kind = core_rknd ), intent(in),dimension(gr%nz,edsclr_dim) :: & - edsclrm, & ! Eddy passive scalar mean [units vary] - edsclrm_forcing ! Eddy passive scalar forcing [units / s] - - ! In / Out Variables - integer, intent(inout) :: & - err_code ! Error code - - ! Local Variables - integer :: i ! Loop iterator for the scalars - -!-------- Input Nan Check ---------------------------------------------- - - call check_nan( thlm_forcing, "thlm_forcing", prefix//proc_name, err_code) - call check_nan( rtm_forcing,"rtm_forcing", prefix//proc_name, err_code ) - call check_nan( um_forcing,"um_forcing", prefix//proc_name, err_code ) - call check_nan( vm_forcing,"vm_forcing", prefix//proc_name, err_code ) - - call check_nan( wm_zm, "wm_zm", prefix//proc_name, err_code ) - call check_nan( wm_zt, "wm_zt", prefix//proc_name, err_code ) - call check_nan( p_in_Pa, "p_in_Pa", prefix//proc_name, err_code ) - call check_nan( rho_zm, "rho_zm", prefix//proc_name, err_code ) - call check_nan( rho, "rho", prefix//proc_name, err_code ) - call check_nan( exner, "exner", prefix//proc_name, err_code ) - call check_nan( rho_ds_zm, "rho_ds_zm", prefix//proc_name, err_code ) - call check_nan( rho_ds_zt, "rho_ds_zt", prefix//proc_name, err_code ) - call check_nan( invrs_rho_ds_zm, "invrs_rho_ds_zm", prefix//proc_name, err_code ) - call check_nan( invrs_rho_ds_zt, "invrs_rho_ds_zt", prefix//proc_name, err_code ) - call check_nan( thv_ds_zm, "thv_ds_zm", prefix//proc_name, err_code ) - call check_nan( thv_ds_zt, "thv_ds_zt", prefix//proc_name, err_code ) - - call check_nan( um, "um", prefix//proc_name, err_code ) - call check_nan( upwp, "upwp", prefix//proc_name, err_code ) - call check_nan( vm, "vm", prefix//proc_name, err_code ) - call check_nan( vpwp, "vpwp", prefix//proc_name, err_code ) - call check_nan( up2, "up2", prefix//proc_name, err_code ) - call check_nan( vp2, "vp2", prefix//proc_name, err_code ) - call check_nan( rtm, "rtm", prefix//proc_name, err_code ) - call check_nan( wprtp, "wprtp", prefix//proc_name, err_code ) - call check_nan( thlm, "thlm", prefix//proc_name, err_code ) - call check_nan( wpthlp, "wpthlp", prefix//proc_name, err_code ) - call check_nan( wp2, "wp2", prefix//proc_name, err_code ) - call check_nan( wp3, "wp3", prefix//proc_name, err_code ) - call check_nan( rtp2, "rtp2", prefix//proc_name, err_code ) - call check_nan( thlp2, "thlp2", prefix//proc_name, err_code ) - call check_nan( rtpthlp, "rtpthlp", prefix//proc_name, err_code ) - - call check_nan( wpthlp_sfc, "wpthlp_sfc", prefix//proc_name, err_code ) - call check_nan( wprtp_sfc, "wprtp_sfc", prefix//proc_name, err_code ) - call check_nan( upwp_sfc, "upwp_sfc", prefix//proc_name, err_code ) - call check_nan( vpwp_sfc, "vpwp_sfc", prefix//proc_name, err_code ) - - do i = 1, sclr_dim - - call check_nan( sclrm_forcing(:,i),"sclrm_forcing", & - prefix//proc_name, err_code ) - - call check_nan( wpsclrp_sfc(i),"wpsclrp_sfc", & - prefix//proc_name, err_code ) - - call check_nan( sclrm(:,i),"sclrm", prefix//proc_name, err_code ) - call check_nan( wpsclrp(:,i),"wpsclrp", prefix//proc_name, err_code ) - call check_nan( sclrp2(:,i),"sclrp2", prefix//proc_name, err_code ) - call check_nan( sclrprtp(:,i),"sclrprtp", prefix//proc_name, err_code ) - call check_nan( sclrpthlp(:,i),"sclrpthlp", prefix//proc_name, err_code ) - - end do - - - do i = 1, edsclr_dim - - call check_nan( edsclrm_forcing(:,i),"edsclrm_forcing", prefix//proc_name, err_code ) - - call check_nan( wpedsclrp_sfc(i),"wpedsclrp_sfc", & - prefix//proc_name, err_code ) - - call check_nan( edsclrm(:,i),"edsclrm", prefix//proc_name, err_code ) - - enddo - -!--------------------------------------------------------------------- - - - call check_negative( rtm, gr%nz ,"rtm", prefix//proc_name, err_code ) - call check_negative( p_in_Pa, gr%nz ,"p_in_Pa", prefix//proc_name, err_code ) - call check_negative( rho, gr%nz ,"rho", prefix//proc_name, err_code ) - call check_negative( rho_zm, gr%nz ,"rho_zm", prefix//proc_name, err_code ) - call check_negative( exner, gr%nz ,"exner", prefix//proc_name, err_code ) - call check_negative( rho_ds_zm, gr%nz ,"rho_ds_zm", prefix//proc_name, err_code ) - call check_negative( rho_ds_zt, gr%nz ,"rho_ds_zt", prefix//proc_name, err_code ) - call check_negative( invrs_rho_ds_zm, gr%nz ,"invrs_rho_ds_zm", & - prefix//proc_name, err_code ) - call check_negative( invrs_rho_ds_zt, gr%nz ,"invrs_rho_ds_zt", & - prefix//proc_name, err_code ) - call check_negative( thv_ds_zm, gr%nz ,"thv_ds_zm", prefix//proc_name, err_code ) - call check_negative( thv_ds_zt, gr%nz ,"thv_ds_zt", prefix//proc_name, err_code ) - call check_negative( up2, gr%nz ,"up2", prefix//proc_name, err_code ) - call check_negative( vp2, gr%nz ,"vp2", prefix//proc_name, err_code ) - call check_negative( wp2, gr%nz ,"wp2", prefix//proc_name, err_code ) - call check_negative( rtm, gr%nz ,"rtm", prefix//proc_name, err_code ) - call check_negative( thlm, gr%nz ,"thlm", prefix//proc_name, err_code ) - call check_negative( rtp2, gr%nz ,"rtp2", prefix//proc_name, err_code ) - call check_negative( thlp2, gr%nz ,"thlp2", prefix//proc_name, err_code ) - - return - end subroutine parameterization_check - -!----------------------------------------------------------------------- - subroutine surface_varnce_check( wp2_sfc, up2_sfc, vp2_sfc, thlp2_sfc, & - rtp2_sfc, rtpthlp_sfc, err_code, & - sclrp2_sfc, sclrprtp_sfc, sclrpthlp_sfc ) -! -! Description:This subroutine determines if any of the output -! variables for the surface_varnce subroutine carry values that -! are nans. -! -! Joshua Fasching February 2008 -! -! -!----------------------------------------------------------------------- - use crmx_parameters_model, only: & - sclr_dim ! Variable - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant Parameters - ! Name of the subroutine calling the check - character(len=*), parameter :: & - proc_name = "surface_varnce" - - ! Input Variables - real( kind = core_rknd ),intent(in) :: & - wp2_sfc, & ! Vertical velocity variance [m^2/s^2] - up2_sfc, & ! u'^2 [m^2/s^2] - vp2_sfc, & ! u'^2 [m^2/s^2] - thlp2_sfc, & ! thetal variance [K^2] - rtp2_sfc, & ! rt variance [(kg/kg)^2] - rtpthlp_sfc ! thetal rt covariance [kg K/kg] - - - real( kind = core_rknd ), dimension(sclr_dim), intent(in) :: & - sclrp2_sfc, & ! Passive scalar variance [units^2] - sclrprtp_sfc, & ! Passive scalar r_t covariance [units kg/kg] - sclrpthlp_sfc ! Passive scalar theta_l covariance [units K] - - ! Input/Output Variable - integer, intent(inout) :: err_code ! Are these outputs valid? - -!----------------------------------------------------------------------- - - ! ---- Begin Code ---- - - call check_nan( wp2_sfc, "wp2_sfc", proc_name, err_code) - call check_nan( up2_sfc, "up2_sfc", proc_name, err_code) - call check_nan( vp2_sfc, "vp2_sfc", proc_name, err_code) - call check_nan( thlp2_sfc, "thlp2_sfc", proc_name, err_code) - call check_nan( rtp2_sfc, "rtp2_sfc", proc_name, err_code) - call check_nan( rtpthlp_sfc, "rtpthlp_sfc", & - proc_name, err_code) - - if ( sclr_dim > 0 ) then - call check_nan( sclrp2_sfc, "sclrp2_sfc", & - proc_name, err_code ) - - call check_nan( sclrprtp_sfc, "sclrprtp_sfc", & - proc_name, err_code ) - - call check_nan( sclrpthlp_sfc, "sclrpthlp_sfc", & - proc_name, err_code ) - end if - - return - end subroutine surface_varnce_check - -!----------------------------------------------------------------------- - subroutine rad_check( thlm, rcm, rtm, ricem, & - cloud_frac, p_in_Pa, exner, rho_zm ) -! Description: -! Checks radiation input variables. If they are < 0 it reports -! to the console. -!------------------------------------------------------------------------ - - use crmx_constants_clubb, only: & - fstderr ! Variable - - use crmx_grid_class, only: & - gr ! Variable - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant Parameters - character(len=*), parameter :: & - proc_name = "Before BUGSrad." - - ! Input/Output variables - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - thlm, & ! Liquid Water Potential Temperature [K/s] - rcm, & ! Liquid Water Mixing Ratio [kg/kg] - rtm, & ! Total Water Mixing Ratio [kg/kg] - ricem, & ! Ice Water Mixing Ratio [kg/kg] - cloud_frac, & ! Cloud Fraction [-] - p_in_Pa, & ! Pressure [Pa] - exner, & ! Exner Function [-] - rho_zm ! Air Density [kg/m^3] - - ! Local variables - real( kind = core_rknd ),dimension(gr%nz) :: rvm - -!------------------------------------------------------------------------- - - rvm = rtm - rcm - - call check_negative( thlm, gr%nz ,"thlm", proc_name ) - call check_negative( rcm, gr%nz ,"rcm", proc_name ) - call check_negative( rtm, gr%nz ,"rtm", proc_name ) - call check_negative( rvm, gr%nz ,"rvm", proc_name ) - call check_negative( ricem, gr%nz ,"ricem", proc_name ) - call check_negative( cloud_frac, gr%nz ,"cloud_frac", proc_name ) - call check_negative( p_in_Pa, gr%nz ,"p_in_Pa", proc_name ) - call check_negative( exner, gr%nz ,"exner", proc_name ) - call check_negative( rho_zm, gr%nz ,"rho_zm", proc_name ) - - return - - end subroutine rad_check - -!----------------------------------------------------------------------- - logical function invalid_model_arrays( ) - -! Description: -! Checks for invalid floating point values in select model arrays. - -! References: -! None -!------------------------------------------------------------------------ - - use crmx_variables_diagnostic_module, only: & - hydromet, & ! Variable(s) - wp2thvp, & - rtpthvp, & - thlpthvp - - use crmx_variables_prognostic_module, only: & - um, & ! Variable(s) - vm, & - wp2, & - wp3, & - rtm, & - thlm, & - rtp2, & - thlp2, & - wprtp, & - wpthlp, & - rtpthlp, & - sclrm, & - edsclrm - - use crmx_constants_clubb, only: & - fstderr ! Constant(s) - - use crmx_parameters_model, only: & - sclr_dim, & ! Variable(s) - edsclr_dim, & - hydromet_dim - - use crmx_parameters_microphys, only: & - hydromet_list ! Variable(s) - - implicit none - - ! Local Variables - integer :: i - - invalid_model_arrays = .false. - - ! Check whether any variable array contains a NaN for - ! um, vm, thlm, rtm, rtp2, thlp2, wprtp, wpthlp, rtpthlp, - ! wp2, & wp3. - if ( is_nan_2d( um ) ) then - write(fstderr,*) "NaN in um model array" -! write(fstderr,*) "um= ", um - invalid_model_arrays = .true. -! return - end if - - if ( is_nan_2d( vm ) ) then - write(fstderr,*) "NaN in vm model array" -! write(fstderr,*) "vm= ", vm - invalid_model_arrays = .true. -! return - end if - - if ( is_nan_2d( wp2 ) ) then - write(fstderr,*) "NaN in wp2 model array" -! write(fstderr,*) "wp2= ", wp2 - invalid_model_arrays = .true. -! return - end if - - if ( is_nan_2d( wp3 ) ) then - write(fstderr,*) "NaN in wp3 model array" -! write(fstderr,*) "wp3= ", wp3 - invalid_model_arrays = .true. -! return - end if - - if ( is_nan_2d( rtm ) ) then - write(fstderr,*) "NaN in rtm model array" -! write(fstderr,*) "rtm= ", rtm - invalid_model_arrays = .true. -! return - end if - - if ( is_nan_2d( thlm ) ) then - write(fstderr,*) "NaN in thlm model array" -! write(fstderr,*) "thlm= ", thlm - invalid_model_arrays = .true. -! return - end if - - if ( is_nan_2d( rtp2 ) ) then - write(fstderr,*) "NaN in rtp2 model array" -! write(fstderr,*) "rtp2= ", rtp2 - invalid_model_arrays = .true. -! return - end if - - if ( is_nan_2d( thlp2 ) ) then - write(fstderr,*) "NaN in thlp2 model array" -! write(fstderr,*) "thlp2= ", thlp2 - invalid_model_arrays = .true. -! return - end if - - if ( is_nan_2d( wprtp ) ) then - write(fstderr,*) "NaN in wprtp model array" -! write(fstderr,*) "wprtp= ", wprtp - invalid_model_arrays = .true. -! return - end if - - if ( is_nan_2d( wpthlp ) ) then - write(fstderr,*) "NaN in wpthlp model array" -! write(fstderr,*) "wpthlp= ", wpthlp - invalid_model_arrays = .true. -! return - end if - - if ( is_nan_2d( rtpthlp ) ) then - write(fstderr,*) "NaN in rtpthlp model array" -! write(fstderr,*) "rtpthlp= ", rtpthlp - invalid_model_arrays = .true. -! return - end if - - if ( hydromet_dim > 0 ) then - do i = 1, hydromet_dim, 1 - if ( is_nan_2d( hydromet(:,i) ) ) then - write(fstderr,*) "NaN in a hydrometeor model array "// & - trim( hydromet_list(i) ) -! write(fstderr,*) "hydromet= ", hydromet - invalid_model_arrays = .true. -! return - end if - end do - end if - -! if ( is_nan_2d( wm_zt ) ) then -! write(fstderr,*) "NaN in wm_zt model array" -! write(fstderr,*) "wm_zt= ", wm_zt -! invalid_model_arrays = .true. -! return -! end if - - if ( is_nan_2d( wp2thvp ) ) then - write(fstderr,*) "NaN in wp2thvp model array" -! write(fstderr,*) "wp2thvp = ", wp2thvp - invalid_model_arrays = .true. -! return - end if - - if ( is_nan_2d( rtpthvp ) ) then - write(fstderr,*) "NaN in rtpthvp model array" -! write(fstderr,*) "rtpthvp = ", rtpthvp - invalid_model_arrays = .true. - end if - - if ( is_nan_2d( thlpthvp ) ) then - write(fstderr,*) "NaN in thlpthvp model array" -! write(fstderr,*) "thlpthvp = ", thlpthvp - invalid_model_arrays = .true. - end if - - do i = 1, sclr_dim, 1 - if ( is_nan_2d( sclrm(:,i) ) ) then - write(fstderr,*) "NaN in sclrm", i, "model array" -! write(fstderr,'(a6,i2,a1)') "sclrm(", i, ")" -! write(fstderr,*) sclrm(:,i) - invalid_model_arrays = .true. - end if - end do - - do i = 1, edsclr_dim, 1 - if ( is_nan_2d( edsclrm(:,i) ) ) then - write(fstderr,*) "NaN in edsclrm", i, "model array" -! write(fstderr,'(a8,i2,a1)') "edsclrm(", i, ")" -! write(fstderr,*) edsclrm(:,i) - invalid_model_arrays = .true. - end if - end do - - return - end function invalid_model_arrays - -!------------------------------------------------------------------------ - logical function is_nan_sclr( xarg ) - -! Description: -! Checks if a given scalar real is a NaN, +inf or -inf. - -! Notes: -! I was advised by Andy Vaught to use a data statement and the transfer( ) -! intrinsic rather than using a hex number in a parameter for portability. - -! Certain compiler optimizations may cause variables with invalid -! results to flush to zero. Avoid these! -! -dschanen 16 Dec 2010 - -!------------------------------------------------------------------------ - -#ifndef __GFORTRAN__ - use crmx_parameters_model, only: & - PosInf ! Variable(s) -#endif - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: xarg - -#ifdef __GFORTRAN__ /* if the isnan extension is available, we use it here */ - is_nan_sclr = isnan( xarg ) -#else - ! ---- Begin Code --- - - ! This works on compilers with standardized floating point, - ! because the IEEE 754 spec defines that subnormals and nans - ! should not equal themselves. - ! However, all compilers do not seem to follow this. - if (xarg /= xarg ) then - is_nan_sclr = .true. - - ! This a second check, assuming the above does not work as - ! expected. - else if ( xarg == PosInf ) then - is_nan_sclr = .true. - - else - is_nan_sclr = .false. ! Our result should be a standard float - - end if -#endif - - return - end function is_nan_sclr -!------------------------------------------------------------------------ - -!------------------------------------------------------------------------ - logical function is_nan_2d( x2d ) - -! Description: -! Checks if a given real vector is a NaN, +inf or -inf. - -!------------------------------------------------------------------------ - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: any - - ! Input Variables - real( kind = core_rknd ), dimension(:), intent(in) :: x2d - - ! Local Variables - integer :: k - - ! ---- Begin Code ---- - - is_nan_2d = .false. - - do k = 1, size( x2d ) - if ( is_nan_sclr( x2d(k) ) ) then - is_nan_2d = .true. - exit - end if - end do - - return - - end function is_nan_2d - -!------------------------------------------------------------------------ - subroutine check_negative_total & - ( var, varname, operation, err_code ) -! -! Description: -! Checks for negative values in the var array and reports them. -! -!----------------------------------------------------------------------- - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - use crmx_error_code, only: & - clubb_var_less_than_zero ! Variable(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: any, present - - ! Input Variables - real( kind = core_rknd ), intent(in), dimension(:) :: var - - character(len=*), intent(in):: & - varname, & ! Varible being examined - operation ! Procedure calling check_zero - - ! Optional In/Out Variable - integer, optional, intent(inout) :: err_code - - if ( any( var < 0.0_core_rknd ) ) then - - write(fstderr,*) varname, " < 0 in ", operation - if ( present( err_code ) ) then - if (err_code < clubb_var_less_than_zero ) then - err_code = clubb_var_less_than_zero - end if - end if - - end if ! any ( var < 0 ) - - return - - end subroutine check_negative_total - - -!------------------------------------------------------------------------ - subroutine check_negative_index & - ( var, ndim, varname, operation, err_code ) -! -! Description: -! Checks for negative values in the var array and reports -! the index in which the negative values occur. -! -!----------------------------------------------------------------------- - use crmx_constants_clubb, only: & - fstderr ! Variable - - use crmx_error_code, only: & - clubb_var_less_than_zero ! Variable - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: any, present - - ! Input Variables - integer, intent(in) :: ndim - - real( kind = core_rknd ), intent(in), dimension(ndim) :: var - - character(len=*), intent(in):: & - varname, & ! Varible being examined - operation ! Procedure calling check_zero - - ! Optional In/Out Variable - integer, optional, intent(inout) :: err_code - - ! Local Variable - integer :: k ! Loop iterator - - do k=1,ndim,1 - - if ( var(k) < 0.0_core_rknd ) then - - write(fstderr,*) varname, " < 0 in ", operation, & - " at k = ", k - - if ( present( err_code ) ) then - if (err_code < clubb_var_less_than_zero ) then - err_code = clubb_var_less_than_zero - end if - end if - - end if - - end do ! 1..n - - return - - end subroutine check_negative_index - - -!------------------------------------------------------------------------ - subroutine check_nan_2d( var, varname, operation, err_code ) -! -! Description: -! Checks for a NaN in the var array and reports it. -! -! -!------------------------------------------------------------------------ - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - use crmx_error_code, only: & - clubb_var_equals_NaN ! Variable(s) - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: present - - ! Input variables - real( kind = core_rknd ), intent(in), dimension(:) :: var ! Variable being examined - - character(len=*), intent(in):: & - varname, & ! Name of variable - operation ! Procedure calling check_nan - - ! Optional In/Out Variable - integer, optional, intent(inout) :: err_code - - if ( is_nan_2d( var ) ) then - write(fstderr,*) varname, " is NaN in ",operation - if ( present( err_code ) ) then - if( err_code < clubb_var_equals_NaN ) then - err_code = clubb_var_equals_NaN - end if - end if - end if - - return - end subroutine check_nan_2d - -!----------------------------------------------------------------------- - subroutine check_nan_sclr( var, varname, operation, err_code ) -! -! Description: -! Checks for a NaN in the scalar var then reports it. -! -!----------------------------------------------------------------------- - use crmx_constants_clubb, only: & - fstderr ! Variable - use crmx_error_code, only: & - clubb_var_equals_NaN ! Variable - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: present - - ! Input Variables - real( kind = core_rknd ), intent(in) :: var ! Variable being examined - - character(len=*), intent(in):: & - varname, & ! Name of variable being examined - operation ! Procedure calling check_nan - - ! Optional In/Out variable - integer, optional, intent(inout) :: err_code -!-------------------------------------------------------------------- - if ( is_nan_sclr( var ) ) then - write(fstderr,*) varname, " is NaN in ",operation - if ( present( err_code ) ) then - if( err_code < clubb_var_equals_NaN ) then - err_code = clubb_var_equals_NAN - end if - end if - end if - - return - - end subroutine check_nan_sclr -!------------------------------------------------------------------------- - -!----------------------------------------------------------------------- - pure function calculate_spurious_source( integral_after, integral_before, & - flux_top, flux_sfc, & - integral_forcing, dt ) & - result( spurious_source ) -! -! Description: -! Checks whether there is conservation within the column and returns any -! imbalance as spurious_source where spurious_source is defined negative -! for a spurious sink. -! -!----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - integral_after, & ! Vertically-integrated quantity after dt time [units vary] - integral_before, & ! Vertically-integrated quantity before dt time [units vary] - flux_top, & ! Total flux at the top of the domain [units vary] - flux_sfc, & ! Total flux at the bottom of the domain [units vary] - integral_forcing, & ! Vertically-integrated forcing [units vary] - dt ! Timestep size [s] - - ! Return Variable - real( kind = core_rknd ) :: spurious_source ! [units vary] - -!-------------------------------------------------------------------- - - ! ---- Begin Code ---- - - spurious_source = (integral_after - integral_before) / dt & - + flux_top - flux_sfc - integral_forcing - - return - - end function calculate_spurious_source -!------------------------------------------------------------------------- -end module crmx_numerical_check diff --git a/src/physics/spcam/crm/CLUBB/crmx_output_grads.F90 b/src/physics/spcam/crm/CLUBB/crmx_output_grads.F90 deleted file mode 100644 index af4f37e25c..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_output_grads.F90 +++ /dev/null @@ -1,754 +0,0 @@ -!------------------------------------------------------------------------------- -! $Id: output_grads.F90 5867 2012-07-03 21:06:44Z dschanen@uwm.edu $ -module crmx_output_grads - - -! Description: -! This module contains structure and subroutine definitions to -! create GrADS output data files for one dimensional arrays. -! -! The structure type (stat_file) contains all necessay information -! to generate a GrADS file and a list of variables to be output -! in the data file. -! -! References: -! None -! -! Original Author: -! Chris Golaz, updated 2/18/2003 -!------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - public :: open_grads, write_grads - - private :: format_date, check_grads, & - determine_time_inc - - ! Undefined value - real( kind = core_rknd ), private, parameter :: undef = -9.99e33_core_rknd - - private ! Default scope - - contains - -!------------------------------------------------------------------------------- - subroutine open_grads( iunit, fdir, fname, & - ia, iz, z, & - day, month, year, rlat, rlon, & - time, dtwrite, & - nvar, grads_file ) -! Description: -! Opens and initialize variable components for derived type 'grads_file' -! If the GrADS file already exists, open_grads will overwrite it. - -! References: -! None -!------------------------------------------------------------------------------- - use crmx_constants_clubb, only: & - fstderr, & ! Variable - fstdout - - use crmx_stat_file_module, only: & - stat_file ! Type - - use crmx_clubb_precision, only: & - time_precision ! Variable - - implicit none - - ! Input Variables - - integer, intent(in) :: iunit ! File unit being written to [-] - - character(len=*), intent(in) :: & - fdir, & ! Directory where file is stored [-] - fname ! Name of file [-] - - integer, intent(in) :: & - ia, & ! Lower Bound of z [-] - iz ! Upper Bound of z [-] - - real( kind = core_rknd ), dimension(:), intent(in) :: z - - integer, intent(in) :: & - day, & ! Day of Month at Model Start [dd] - month, & ! Month of Year at Model start [mm] - year ! Year at Model Start [yyyy] - - real( kind = core_rknd ), dimension(1), intent(in) :: & - rlat, rlon ! Latitude and Longitude [Degrees N/E] - - real(kind=time_precision), intent(in) :: & - time, & ! Time since Model start [s] - dtwrite ! Time interval for output [s] - - ! Number of GrADS variables to store [#] - integer, intent(in) :: nvar - - ! Input/Output Variables - type (stat_file), intent(inout) :: & - grads_file ! File data [-] - - ! Local Variables - - integer :: k - logical :: l_ctl, l_dat, l_error - - ! ---- Begin Code ---- - - ! Define parameters for the GrADS ctl and dat files - - grads_file%iounit = iunit - grads_file%fdir = fdir - grads_file%fname = fname - grads_file%ia = ia - grads_file%iz = iz - - ! Determine if the altitudes are ascending or descending and setup the - ! variable z accordingly. - if ( ia <= iz ) then - do k=1,iz-ia+1 - grads_file%z(k) = z(ia+k-1) - end do - else - do k=1,ia-iz+1 - grads_file%z(k) = z(ia-k+1) - end do - end if - - grads_file%day = day - grads_file%month = month - grads_file%year = year - - allocate( grads_file%rlat(1), grads_file%rlon(1) ) - - grads_file%rlat = rlat - grads_file%rlon = rlon - - grads_file%dtwrite = dtwrite - - grads_file%nvar = nvar - - ! Check whether GrADS files already exists - - ! We don't use this feature for the single-column model. The - ! clubb_standalone program will simply overwrite existing data files if they - ! exist. The restart function will create a new GrADS file starting from - ! the restart time in the output directory. - - ! inquire( file=trim(fdir)//trim(fname)//'.ctl', exist=l_ctl ) - ! inquire( file=trim(fdir)//trim(fname)//'.dat', exist=l_dat ) - - l_ctl = .false. - l_dat = .false. - - ! If none of the files exist, set ntimes and nrecord and - ! to initial values and return - - if ( .not.l_ctl .and. .not.l_dat ) then - - grads_file%time = time - grads_file%ntimes = 0 - grads_file%nrecord = 1 - return - - ! If both files exists, attempt to append to existing files - - else if ( l_ctl .and. l_dat ) then - - ! Check existing ctl file - - call check_grads( iunit, fdir, fname, & - ia, iz, & - day, month, year, time, dtwrite, & - nvar, & - l_error, grads_file%ntimes, grads_file%nrecord, & - grads_file%time ) - - if ( l_error ) then - write(unit=fstderr,fmt=*) "Error in open_grads:" - write(unit=fstderr,fmt=*) & - "Attempt to append to existing files failed" -! call stopcode('open_grads') - stop 'open_grads' - end if - - return - -! If one file exists, but not the other, give up - - else - write(unit=fstderr,fmt=*) 'Error in open_grads:' - write(unit=fstderr,fmt=*) & - "Attempt to append to existing files failed,"// & - " because only one of the two GrADS files was found." - stop "open_grads" - - end if - - return - end subroutine open_grads - -!------------------------------------------------------------------------------- - subroutine check_grads( iunit, fdir, fname, & - ia, iz, & - day, month, year, time, dtwrite, & - nvar, & - l_error, ntimes, nrecord, time_grads ) -! Description: -! Given a GrADS file that already exists, this subroutine will attempt -! to determine whether data can be safely appended to existing file. -! References: -! None -!------------------------------------------------------------------------------- - use crmx_stat_file_module, only: & - variable ! Type - - use crmx_clubb_precision, only: & - time_precision ! Variable - - use crmx_constants_clubb, only: & - fstderr, & ! Variable - fstdout, & - sec_per_hr, & - sec_per_min - - implicit none - - ! Input Variables - - integer, intent(in) :: & - iunit, & ! Fortran file unit - ia, iz, & ! First and last level - day, month, year, & ! Day, month and year numbers - nvar ! Number of variables in the file - - character(len=*), intent(in) :: & - fdir, fname ! File directory and name - - real(kind=time_precision), intent(in) :: & - time ! Current model time [s] - - real(kind=time_precision), intent(in) :: & - dtwrite ! Time interval between writes to the file [s] - - ! Output Variables - logical, intent(out) :: & - l_error - - integer, intent(out) :: & - ntimes, nrecord - - real(kind=time_precision), intent(out) :: time_grads - - ! Local Variables - logical :: l_done - integer :: ierr - character(len = 256) :: line, tmp, date, dt - - integer :: & - i, nx, ny, nzmax, & - ihour, imin, & - ia_in, iz_in, ntimes_in, nvar_in, & - day_in, month_in, year_in - - real(kind=time_precision) :: dtwrite_in - - real( kind = core_rknd ), dimension(:), allocatable :: z_in - - type (variable), dimension(:), pointer :: var_in - -!------------------------------------------------------------------------------- - - ! ---- Begin Code ---- - - ! Initialize logical variables - l_error = .false. - l_done = .false. - - ! Open control file - open( unit = iunit, & - file = trim( fdir )//trim( fname )//'.ctl', & - status = 'old', iostat = ierr ) - if ( ierr < 0 ) l_done = .true. - - ! Read and process it - - read(unit=iunit,iostat=ierr,fmt='(a256)') line - if ( ierr < 0 ) l_done = .true. - - do while ( .not. l_done ) - - if ( index(line,'XDEF') > 0 ) then - - read(unit=line,fmt=*) tmp, nx - if ( nx /= 1 ) then - write(unit=fstderr,fmt=*) 'Error: XDEF can only be 1' - l_error = .true. - end if - - else if ( index(line,'YDEF') > 0 ) then - - read(unit=line,fmt=*) tmp, ny - if ( ny /= 1 ) then - write(unit=fstderr,fmt=*) "Error: YDEF can only be 1" - l_error = .true. - end if - - else if ( index(line,'ZDEF') > 0 ) then - - read(unit=line,fmt=*) tmp, iz_in - - if ( index(line,'LEVELS') > 0 ) then - ia_in = 1 - allocate( z_in(ia_in:iz_in) ) - read(unit=iunit,fmt=*) (z_in(i),i=ia_in,iz_in) - end if - - else if ( index(line,'TDEF') > 0 ) then - - read(unit=line,fmt=*) tmp, ntimes_in, tmp, date, dt - read(unit=date(1:2),fmt=*) ihour - read(unit=date(4:5),fmt=*) imin - time_grads = real( ihour, kind=time_precision ) * sec_per_hr & - + real( imin, kind=time_precision ) * sec_per_min - read(unit=date(7:8),fmt=*) day_in - read(unit=date(12:15),fmt=*) year_in - - select case( date(9:11) ) - case( 'JAN' ) - month_in = 1 - case( 'FEB' ) - month_in = 2 - case( 'MAR' ) - month_in = 3 - case( 'APR' ) - month_in = 4 - case( 'MAY' ) - month_in = 5 - case( 'JUN' ) - month_in = 6 - case( 'JUL' ) - month_in = 7 - case( 'AUG' ) - month_in = 8 - case( 'SEP' ) - month_in = 9 - case( 'OCT' ) - month_in = 10 - case( 'NOV' ) - month_in = 11 - case( 'DEC' ) - month_in = 12 - case default - write(unit=fstderr,fmt=*) "Unknown month: "//date(9:11) - l_error = .true. - end select - - read(unit=dt(1:len_trim(dt)-2),fmt=*) dtwrite_in - dtwrite_in = dtwrite_in * sec_per_min - - else if ( index(line,'ENDVARS') > 0 ) then - - l_done = .true. - - else if ( index(line,'VARS') > 0 ) then - - read(line,*) tmp, nvar_in - allocate( var_in(nvar_in) ) - do i=1, nvar_in - read(unit=iunit,iostat=ierr,fmt='(a256)') line - read(unit=line,fmt=*) var_in(i)%name, nzmax - if ( nzmax /= iz_in ) then - write(unit=fstderr,fmt=*) & - "Error reading ", trim( var_in(i)%name ) - l_error = .true. - end if ! nzmax /= iz_in - end do ! 1..nvar_in - end if - - read(unit=iunit,iostat=ierr,fmt='(a256)') line - if ( ierr < 0 ) l_done = .true. - - end do ! while ( .not. l_done ) - - close( unit=iunit ) - - ! Perform some error check - - if ( abs(ia_in - iz_in) /= abs(ia - iz) ) then - write(unit=fstderr,fmt=*) "check_grads: size mismatch" - l_error = .true. - end if - - if ( day_in /= day ) then - write(unit=fstderr,fmt=*) "check_grads: day mismatch" - l_error = .true. - end if - - if ( month_in /= month ) then - write(unit=fstderr,fmt=*) "check_grads: month mismatch" - l_error = .true. - end if - - if ( year_in /= year ) then - write(unit=fstderr,fmt=*) "check_grads: year mismatch" - l_error = .true. - end if - - if ( int( time_grads ) + ntimes_in*int( dtwrite_in ) & - /= int( time ) ) then - write(unit=fstderr,fmt=*) "check_grads: time mismatch" - l_error = .true. - end if - - if ( int( dtwrite_in ) /= int( dtwrite) ) then - write(unit=fstderr,fmt=*) 'check_grads: dtwrite mismatch' - l_error = .true. - end if - - if ( nvar_in /= nvar ) then - write(unit=fstderr,fmt=*) 'check_grads: nvar mismatch' - l_error = .true. - end if - - if ( l_error ) then - write(unit=fstderr,fmt=*) "check_grads diagnostic" - write(unit=fstderr,fmt=*) "ia = ", ia_in, ia - write(unit=fstderr,fmt=*) "iz = ", iz_in, iz - write(unit=fstderr,fmt=*) "day = ", day_in, day - write(unit=fstderr,fmt=*) "month = ", month_in, month - write(unit=fstderr,fmt=*) "year = ", year_in, year - write(unit=fstderr,fmt=*) "time_grads / time = ", time_grads, time - write(unit=fstderr,fmt=*) "dtwrite = ", dtwrite_in, dtwrite - write(unit=fstderr,fmt=*) "nvar = ", nvar_in, nvar - end if - - ! Set ntimes and nrecord to append to existing files - - ntimes = ntimes_in - nrecord = ntimes_in * nvar_in * iz_in + 1 - - deallocate( z_in ) - - ! The purpose of this statement is to avoid a compiler warning - ! for tmp - if (tmp =="") then - end if - ! Joshua Fasching June 2008 - - return - end subroutine check_grads - -!------------------------------------------------------------------------------- - subroutine write_grads( grads_file ) - -! Description: -! Write part of a GrADS file to data (.dat) file update control file (.ctl. -! Can be called as many times as necessary -! References: -! None -!------------------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - use crmx_model_flags, only: & - l_byteswap_io ! Variable - - use crmx_endian, only: & - big_endian, & ! Variable - little_endian - - use crmx_stat_file_module, only: & - stat_file ! Type - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - implicit none - - ! External - intrinsic :: selected_real_kind - - ! Constant parameters - integer, parameter :: & - r4 = selected_real_kind( p=5 ) ! Specify 5 decimal digits of precision - - ! Input Variables - type (stat_file), intent(inout) :: & - grads_file ! Contains all information on the files to be written to - - ! Local Variables - integer :: & - i, & ! Loop indices - ios ! I/O status - - character(len=15) :: date - - integer :: dtwrite_ctl ! Time increment for the ctl file - character(len=2) :: dtwrite_units ! Units on dtwrite_ctl - - ! ---- Begin Code ---- - ! Check number of variables and write nothing if less than 1 - - if ( grads_file%nvar < 1 ) return - -#include "recl.inc" - - ! Output data to file - open( unit=grads_file%iounit, & - file=trim( grads_file%fdir )//trim( grads_file%fname )//'.dat', & - form='unformatted', access='direct', & - recl=F_RECL*abs( grads_file%iz-grads_file%ia+1 ), & - status='unknown', iostat=ios ) - if ( ios /= 0 ) then - write(unit=fstderr,fmt=*) & - "write_grads: error opening binary file" - write(unit=fstderr,fmt=*) "iostat = ", ios - stop - end if - - if ( grads_file%ia <= grads_file%iz ) then - do i=1,grads_file%nvar - write(grads_file%iounit,rec=grads_file%nrecord) & - real( grads_file%var(i)%ptr(1,1,grads_file%ia:grads_file%iz), kind=r4) - grads_file%nrecord = grads_file%nrecord + 1 - end do - - else - do i=1, grads_file%nvar - write(grads_file%iounit,rec=grads_file%nrecord) & - real( grads_file%var(i)%ptr(1,1,grads_file%ia:grads_file%iz:-1), kind=r4) - grads_file%nrecord = grads_file%nrecord + 1 - end do - - end if ! grads_file%ia <= grads_file%iz - - close( unit=grads_file%iounit, iostat = ios ) - - if ( ios /= 0 ) then - write(unit=fstderr,fmt=*) & - "write_grads: error closing binary file" - write(unit=fstderr,fmt=*) "iostat = ", ios - stop - end if - - grads_file%ntimes = grads_file%ntimes + 1 - - ! Write control file - - open(unit=grads_file%iounit, & - file=trim( grads_file%fdir )//trim( grads_file%fname )//'.ctl', & - status='unknown', iostat=ios) - if ( ios > 0 ) then - write(unit=fstderr,fmt=*) & - "write_grads: error opening control file" - write(unit=fstderr,fmt=*) "iostat = ", ios - stop - end if - - ! Write file header - if ( ( big_endian .and. .not. l_byteswap_io ) & - .or. ( little_endian .and. l_byteswap_io ) ) then - write(unit=grads_file%iounit,fmt='(a)') 'OPTIONS BIG_ENDIAN' - - else - write(unit=grads_file%iounit,fmt='(a)') 'OPTIONS LITTLE_ENDIAN' - - end if - - write(unit=grads_file%iounit,fmt='(a)') 'DSET ^'//trim( grads_file%fname )//'.dat' - write(unit=grads_file%iounit,fmt='(a,e11.5)') 'UNDEF ',undef - write(unit=grads_file%iounit,fmt='(a,f8.3,a)') 'XDEF 1 LINEAR ', grads_file%rlon, ' 1.' - write(unit=grads_file%iounit,fmt='(a,f8.3,a)') 'YDEF 1 LINEAR ', grads_file%rlat, ' 1.' - if ( grads_file%ia == grads_file%iz ) then - write(unit=grads_file%iounit,fmt='(a)') 'ZDEF 1 LEVELS 0.' - else if ( grads_file%ia < grads_file%iz ) then - write(unit=grads_file%iounit,fmt='(a,i5,a)') & - 'ZDEF', abs(grads_file%iz-grads_file%ia)+1,' LEVELS ' - write(unit=grads_file%iounit,fmt='(6f13.4)') & - (grads_file%z(i-grads_file%ia+1),i=grads_file%ia,grads_file%iz) - else - write(unit=grads_file%iounit,fmt='(a,i5,a)') & - 'ZDEF',abs(grads_file%iz-grads_file%ia)+1,' LEVELS ' - write(grads_file%iounit,'(6f13.4)') (grads_file%z(grads_file%ia-i+1), & - i=grads_file%ia,grads_file%iz,-1) - end if - - call format_date( grads_file%day, grads_file%month, grads_file%year, grads_file%time, & ! In - date ) ! Out - - call determine_time_inc( grads_file%dtwrite, & ! In - dtwrite_ctl, dtwrite_units ) ! Out - - write(unit=grads_file%iounit,fmt='(a,i6,a,a,i5,a)') 'TDEF ', & - grads_file%ntimes, ' LINEAR ', date, dtwrite_ctl, dtwrite_units - - ! Variables description - write(unit=grads_file%iounit,fmt='(a,i5)') 'VARS', grads_file%nvar - - do i=1, grads_file%nvar, 1 - write(unit=grads_file%iounit,fmt='(a,i5,a,a)') & - grads_file%var(i)%name(1:len_trim(grads_file%var(i)%name)), & - abs(grads_file%iz-grads_file%ia)+1,' 99 ', & - grads_file%var(i)%description(1:len_trim(grads_file%var(i)%description)) - end do - - write(unit=grads_file%iounit,fmt='(a)') 'ENDVARS' - - close( unit=grads_file%iounit, iostat=ios ) - if ( ios > 0 ) then - write(unit=fstderr,fmt=*) & - "write_grads: error closing control file" - write(unit=fstderr,fmt=*) "iostat = ",ios - stop - end if - - return - end subroutine write_grads - -!--------------------------------------------------------- - subroutine format_date( day_in, month_in, year_in, time_in, & - date ) -! -! Description: -! This subroutine formats the current time of the model (given in seconds -! since the start time) to a date format usable as GrADS output. -! References: -! None -!--------------------------------------------------------- - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_calendar, only: & - compute_current_date ! Procedure(s) - - use crmx_calendar, only: & - month_names ! Variable(s) - - use crmx_constants_clubb, only: & - sec_per_hr, & ! Variable(s) - min_per_hr - - implicit none - - ! Input Variables - integer, intent(in) :: & - day_in, & ! Day of the Month at Model Start [dd] - month_in, & ! Month of the Year at Model Start [mm] - year_in ! Year at Model Start [yyyy] - - real(kind=time_precision), intent(in) :: & - time_in ! Time since Model Start [s] - - ! Output Variables - character(len=15), intent(out) :: & - date ! Current Date in format 'hh:mmZddmmmyyyy' - - ! Local Variables - integer :: iday, imonth, iyear ! Day, month, year - real(kind=time_precision) :: time ! time [s] - - ! ---- Begin Code ---- - - ! Copy input arguments into local variables - - iday = day_in - imonth = month_in - iyear = year_in - time = time_in - - call compute_current_date( day_in, month_in, & ! In - year_in, & ! In - time_in, & ! In - iday, imonth, & ! Out - iyear, & ! Out - time ) ! Out - - date = 'hh:mmZddmmmyyyy' - write(unit=date(7:8),fmt='(i2.2)') iday - write(unit=date(9:11),fmt='(a3)') month_names(imonth) - write(unit=date(12:15),fmt='(i4.4)') iyear - write(unit=date(1:2),fmt='(i2.2)') floor( time/sec_per_hr ) - write(unit=date(4:5),fmt='(i2.2)') & - int( mod( nint( time ), nint(sec_per_hr) ) / nint(min_per_hr) ) - - return - end subroutine format_date - -!------------------------------------------------------------------------------- - subroutine determine_time_inc( dtwrite_sec, & - dtwrite_ctl, units ) -! Description: -! Determine the units on the time increment, since GrADS only allows a 2 digit -! time increment. -! References: -! None -!------------------------------------------------------------------------------- - use crmx_constants_clubb, only: & - sec_per_day, & ! Constants - sec_per_hr, & - sec_per_min - - use crmx_clubb_precision, only: & - time_precision ! Variable(s) - - implicit none - - ! External - intrinsic :: max, floor - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dtwrite_sec ! Time increment in GrADS [s] - - ! Output Variables - integer, intent(out) :: & - dtwrite_ctl ! Time increment in GrADS [units vary] - - character(len=2), intent(out) :: units ! Units on dtwrite_ctl - - ! Local variables - real(kind=time_precision) :: & - dtwrite_min, & ! Time increment [minutes] - dtwrite_hrs, & ! Time increment [hours] - dtwrite_days ! Time increment [days] - - ! ---- Begin Code ---- - - ! Since GrADs can't handle a time increment of less than a minute we assume - ! 1 minute output for an output frequency of less than a minute. - dtwrite_min = real( floor( dtwrite_sec/sec_per_min ), kind=time_precision ) - dtwrite_min = max( 1._time_precision, dtwrite_min ) - - if ( dtwrite_min <= 99._time_precision ) then - dtwrite_ctl = int( dtwrite_min ) - units = 'mn' - else - dtwrite_hrs = dtwrite_sec / sec_per_hr - if ( dtwrite_hrs <= 99._time_precision ) then - dtwrite_ctl = int( dtwrite_hrs ) - units = 'hr' - else - dtwrite_days = dtwrite_sec / sec_per_day - if ( dtwrite_days <= 99._time_precision ) then - dtwrite_ctl = int( dtwrite_days ) - units = 'dy' - else - stop "Fatal error in determine_time_inc" - end if ! dwrite_days <= 99. - end if ! dtwrite_hrs <= 99. - end if ! dtwrite_min <= 99. - - return - end subroutine determine_time_inc - -end module crmx_output_grads -!------------------------------------------------------------------------------- diff --git a/src/physics/spcam/crm/CLUBB/crmx_output_netcdf.F90 b/src/physics/spcam/crm/CLUBB/crmx_output_netcdf.F90 deleted file mode 100644 index cf5157e524..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_output_netcdf.F90 +++ /dev/null @@ -1,835 +0,0 @@ -! $Id: output_netcdf.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -!------------------------------------------------------------------------------- -module crmx_output_netcdf -#ifdef NETCDF - -! Description: -! Functions and subroutines for writing NetCDF files - -! References: -! -!------------------------------------------------------------------------------- - - implicit none - - public :: open_netcdf, write_netcdf, close_netcdf - - private :: define_netcdf, write_grid, first_write, format_date - - ! Constant parameters - ! This will truncate all timesteps smaller than 1 mn to a minute for - ! the purposes of viewing the data in grads - logical, parameter, private :: & - l_grads_kludge = .true. - - private ! Default scope - - contains -!------------------------------------------------------------------------------- - subroutine open_netcdf( nlat, nlon, fdir, fname, ia, iz, zgrid, & - day, month, year, rlat, rlon, & - time, dtwrite, nvar, ncf ) - -! Description: -! Defines the structure used to reference the file `ncf' - -! References: -! None -!------------------------------------------------------------------------------- - use netcdf, only: & - NF90_CLOBBER, & ! Variable(s) - NF90_NOERR, & - nf90_create, & ! Procedure - nf90_strerror - - use crmx_stat_file_module, only: & - stat_file ! Type - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - implicit none - - ! Input Variables - character(len=*), intent(in) :: & - fdir, & ! Directory name of file - fname ! File name - - integer, intent(in) :: & - nlat, nlon, & ! Number of points in the X and Y - day, month, year, & ! Time - ia, iz, & ! First and last grid point - nvar ! Number of variables - - real( kind = core_rknd ), dimension(nlat), intent(in) :: & - rlat ! Latitudes [degrees_E] - - real( kind = core_rknd ), dimension(nlon), intent(in) :: & - rlon ! Longitudes [degrees_N] - - real(kind=time_precision), intent(in) :: & - dtwrite ! Time between write intervals [s] - - real(kind=time_precision), intent(in) :: & - time ! Current time [s] - - real( kind = core_rknd ), dimension(:), intent(in) :: & - zgrid ! The model grid [m] - - ! Input/output Variables - type (stat_file), intent(inout) :: ncf - - ! Local Variables - integer :: stat ! Error status - integer :: k ! Array index - - ! ---- Begin Code ---- - - ncf%nvar = nvar - - ! If there is no data to write, then return - if ( ncf%nvar == 0 ) then - return - end if - - ! Initialization for NetCDF - ncf%l_defined = .false. - - ! Define file (compatability with GrADS writing) - ncf%fdir = fdir - ncf%fname = fname - ncf%ia = ia - ncf%iz = iz - ncf%day = day - ncf%month = month - ncf%year = year - ncf%nlat = nlat - ncf%nlon = nlon - ncf%time = time - - ncf%dtwrite = dtwrite - - ! From open_grads. - ! This probably for the case of a reversed grid as in COAMPS - if ( ia <= iz ) then - do k=1,iz-ia+1 - ncf%z(k) = zgrid(ia+k-1) - end do - else ! Always this for CLUBB - do k=1,ia-iz+1 - ncf%z(k) = zgrid(ia-k+1) - end do - end if - - allocate( ncf%rlat(1:nlat), ncf%rlon(1:nlon) ) - - ncf%rlat = rlat - ncf%rlon = rlon - - ! Create NetCDF dataset: enter define mode - stat = nf90_create( path = trim( fdir )//trim( fname )//'.nc', & - cmode = NF90_CLOBBER, & ! overwrite existing file - ncid = ncf%iounit ) - if ( stat /= NF90_NOERR ) then - write(unit=fstderr,fmt=*) "Error opening file: ", & - trim( fdir )//trim( fname )//'.nc', & - trim( nf90_strerror( stat ) ) - stop - end if - - call define_netcdf( ncf%iounit, ncf%nlat, ncf%nlon, ncf%iz, & ! In - ncf%day, ncf%month, ncf%year, ncf%time, & ! In - ncf%LatDimId, ncf%LongDimId, ncf%AltDimId, ncf%TimeDimId, & ! Out - ncf%LatVarId, ncf%LongVarId, ncf%AltVarId, ncf%TimeVarId ) ! Out - - return - end subroutine open_netcdf - -!------------------------------------------------------------------------------- - - subroutine write_netcdf( ncf ) - -! Description: -! Writes some data to the NetCDF dataset, but doesn't close it. -! -! References: -! None -!------------------------------------------------------------------------------- - - use netcdf, only: & - NF90_NOERR, & ! Variable(s) - nf90_put_var, & ! Procedure - nf90_strerror - - use crmx_stat_file_module, only: & - stat_file ! Variable - - use crmx_constants_clubb, only: & - fstderr, & ! Variable - sec_per_min - - use crmx_clubb_precision, only: & - time_precision ! Constant(s) - - implicit none - - ! Input - type (stat_file), intent(inout) :: ncf ! The file - - ! Local Variables - integer, dimension(:), allocatable :: stat ! Error status - real(kind=8), dimension(1) :: time ! Time [s] - - integer :: i ! Array index - - ! ---- Begin Code ---- - - ! If there is no data to write, then return - if ( ncf%nvar == 0 ) then - return - end if - - ncf%ntimes = ncf%ntimes + 1 - - if ( .not. ncf%l_defined ) then - call first_write( ncf ) ! finalize the variable definitions - call write_grid( ncf ) ! define lat., long., and grid - ncf%l_defined = .true. - end if - - allocate( stat( ncf%nvar ) ) - if ( l_grads_kludge ) then - time = real( nint( real( ncf%ntimes, kind=time_precision ) & - * ncf%dtwrite / sec_per_min ), kind=time_precision ) ! minutes(rounded) - else - time = real( ncf%ntimes, kind=time_precision ) * ncf%dtwrite ! seconds - end if - - stat(1) = nf90_put_var( ncid=ncf%iounit, varid=ncf%TimeVarId, & - values=time(1), start=(/ncf%ntimes/) ) - if ( stat(1) /= NF90_NOERR ) then - stop "time variable nf90_put_var failed" - end if - - do i = 1, ncf%nvar, 1 - stat(i) & - = nf90_put_var( ncid=ncf%iounit, varid=ncf%var(i)%indx, & - values=ncf%var(i)%ptr(:,:,ncf%ia:ncf%iz), & - start=(/1,1,1,ncf%ntimes/), & - count=(/ncf%nlon,ncf%nlat,ncf%iz,1/) ) - - end do ! i=1..nvar - - if ( any (stat /= NF90_NOERR ) ) then - do i=1,ncf%nvar,1 - if( stat(i) /= NF90_NOERR ) then - write(unit=fstderr,fmt=*) ncf%var(i)%name, & - trim( nf90_strerror( stat(i) ) ) - end if - end do - stop "nf90_put_var error" - end if - - - deallocate( stat ) - - return - end subroutine write_netcdf - -!------------------------------------------------------------------------------- - subroutine define_netcdf( ncid, nlat, nlon, iz, & - day, month, year, time, & - LatDimId, LongDimId, AltDimId, TimeDimId, & - LatVarId, LongVarId, AltVarId, TimeVarId ) - -! Description: -! Used internally to create a definition for the NetCDF dataset -! -! References: -! None -!------------------------------------------------------------------------------- - use netcdf, only: & - NF90_NOERR, & ! Constants - NF90_FLOAT, & - NF90_DOUBLE, & - NF90_UNLIMITED - - use netcdf, only: & - nf90_def_dim, & ! Functions - nf90_strerror, & - nf90_def_var, & - nf90_put_att - - use crmx_clubb_precision, only: & - time_precision ! Variable(s) - - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - implicit none - - integer, intent(in) :: & - nlat, & ! Number of points in the N/S direction - nlon ! Number of points in the E/W direction - - ! Input Variables - integer, intent(in) :: & - day, month, year, & ! Time of year - ncid, & ! Number used by NetCDF for ref. the file - iz ! Dimension in z - - real(kind=time_precision), intent(in) :: & - time ! Current model time [s] - - ! Output Variables - integer, intent(out) :: & - LatDimId, LongDimId, AltDimId, TimeDimId ! NetCDF id's for dimensions - - ! NetCDF id's for data (e.g. longitude) associated with each dimension - integer, intent(out) :: & - LatVarId, LongVarId, AltVarId, TimeVarId - - ! Local variables - integer :: stat - character(len=35) :: TimeUnits - - ! ---- Begin Code ---- - - ! Define the dimensions for the variables - stat = nf90_def_dim( ncid, "longitude", nlon, LongDimId ) - - if ( stat /= NF90_NOERR ) then - write(fstderr,*) "Error defining longitude: ", & - trim( nf90_strerror( stat ) ) - stop - end if - - stat = nf90_def_dim( ncid, "latitude", nlat, LatDimId ) - if ( stat /= NF90_NOERR ) then - write(fstderr,*) "Error defining latitude: ", & - trim( nf90_strerror( stat ) ) - stop - end if - - stat = nf90_def_dim( ncid, "altitude", iz, AltDimId ) - if ( stat /= NF90_NOERR ) then - write(fstderr,*) "Error defining altitude: ", & - trim( nf90_strerror( stat ) ) - stop - end if - - stat = nf90_def_dim( ncid, "time", NF90_UNLIMITED, TimeDimId ) - if ( stat /= NF90_NOERR ) then - write(fstderr,*) "Error defining time: ", & - trim( nf90_strerror( stat ) ) - stop - end if - - ! Define the initial variables for the dimensions - ! Longitude = deg_E = X - stat = nf90_def_var( ncid, "longitude", NF90_FLOAT, & - (/LongDimId/), LongVarId ) - - ! Latitude = deg_N = Y - stat = nf90_def_var( ncid, "latitude", NF90_FLOAT, & - (/LatDimId/), LatVarId ) - - ! Altitude = meters above the surfac3 = Z - stat = nf90_def_var( ncid, "altitude", NF90_FLOAT, & - (/AltDimId/), AltVarId ) - - ! grads2nc stores time as a double prec. value, so we follow that - stat = nf90_def_var( ncid, "time", NF90_DOUBLE, & - (/TimeDimId/), TimeVarId ) - - ! Assign attribute values - - ! Time attribute - stat = nf90_put_att( ncid, TimeVarId, "cartesian_axis", "T" ) - if ( stat /= NF90_NOERR ) then - write(fstderr,*) "Error defining time: ", trim( nf90_strerror( stat ) ) - stop - end if - - call format_date( day, month, year, time, TimeUnits ) - - stat = nf90_put_att( ncid, TimeVarId, "units", TimeUnits ) - if ( stat /= NF90_NOERR ) then - write(fstderr,*) "Error defining time: ", trim( nf90_strerror( stat ) ) - stop - end if - - stat = nf90_put_att( ncid, TimeVarId, "ipositive", 1 ) - if ( stat /= NF90_NOERR ) then - write(fstderr,*) "Error defining time: ", trim( nf90_strerror( stat ) ) - stop - end if - - stat = nf90_put_att( ncid, TimeVarId, "calendar_type", "Gregorian" ) - if ( stat /= NF90_NOERR ) then - write(fstderr,*) "Error defining time", trim( nf90_strerror( stat ) ) - stop - end if - - ! Define Location - ! X & Y coordinates - stat = nf90_put_att( ncid, LongVarId, "cartesian_axis", "X" ) - - stat = nf90_put_att( ncid, LongVarId, "units", "degrees_E" ) - - stat = nf90_put_att( ncid, LongVarId, "ipositive", 1 ) - - stat = nf90_put_att( ncid, LatVarId, "cartesian_axis", "Y" ) - - stat = nf90_put_att( ncid, LatVarId, "units", "degrees_N" ) - - stat = nf90_put_att( ncid, LatVarId, "ipositive", 1 ) - - ! Altitude, Z coordinate - stat = nf90_put_att( ncid, AltVarId, "cartesian_axis", "Z" ) - - stat = nf90_put_att( ncid, AltVarId, "units", "meters" ) - - stat = nf90_put_att( ncid, AltVarId, "positive", "up" ) - - stat = nf90_put_att( ncid, AltVarId, "ipositive", 1 ) - - return - end subroutine define_netcdf - -!------------------------------------------------------------------------------- - subroutine close_netcdf( ncf ) - -! Description: -! Close a previously opened stats file. - -! Notes: -! I assume nf90_close() exists so that the NetCDF libraries can do a -! form of buffered I/O, but I don't know the implementation -! details. -dschanen -!------------------------------------------------------------------------------- - - use crmx_stat_file_module, only: & - stat_file ! Type - - use netcdf, only: & - NF90_NOERR, & ! Variable - nf90_close, & ! Procedure(s) - nf90_strerror - - use crmx_constants_clubb, only: & - fstderr ! Variable - - implicit none - - ! Input/Output Variables - type (stat_file), intent(inout) :: ncf - - ! Local Variables - integer :: stat - - ! ---- Begin Code ---- - - ! If there is no data to write, then return - if ( ncf%nvar == 0 ) then - return - end if - - stat = nf90_close( ncf%iounit ) - if ( stat /= NF90_NOERR ) then - write(fstderr,*) "Error closing file "// & - trim( ncf%fname )//": ", trim( nf90_strerror( stat ) ) - stop - end if - - return - end subroutine close_netcdf - -!------------------------------------------------------------------------------- - subroutine first_write( ncf ) - -! Description: -! Used on the first call to write_nc to finalize definitions -! for the dataset, including the attributes for variable records. -! References: -! None -!------------------------------------------------------------------------------- - - use netcdf, only: & - NF90_NOERR, & ! Constants - NF90_FLOAT, & - NF90_GLOBAL, & - nf90_def_var, & ! Procedure(s) - nf90_strerror, & - nf90_put_att, & - nf90_enddef - - use crmx_stat_file_module, only: & - stat_file ! Derived type - - use crmx_constants_clubb, only: & - fstderr ! Variable - - use crmx_parameters_model, only: & - T0, & ! Real variables - ts_nudge, & - sclr_tol ! Real array variable - - use crmx_parameters_tunable, only: & - params_list ! Variable names (characters) - - use crmx_parameters_tunable, only: & - get_parameters ! Subroutine - - use crmx_parameter_indices, only: & - nparams ! Integer - - use crmx_model_flags, only: & - l_pos_def, & - l_hole_fill, & - l_clip_semi_implicit, & - l_standard_term_ta, & - l_single_C2_Skw, & - l_gamma_Skw, & - l_uv_nudge, & - l_tke_aniso - - use crmx_parameters_microphys, only: & - micro_scheme, & ! Variable(s) - l_local_kk, & ! Logicals - l_cloud_sed - - use crmx_parameters_radiation, only: & - rad_scheme - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input/Output Variables - type (stat_file), intent(inout) :: ncf - - ! Local Variables - integer, dimension(:), allocatable :: stat - - real( kind = core_rknd ), dimension(nparams) :: params ! Tunable parameters - - integer :: i ! Array index - logical :: l_error ! Error stat - - character(len=10) :: current_time - character(len=8) :: current_date - ! Range for NetCDF variables - real(kind=4), dimension(2) :: var_range - - ! Dimensions for variables - integer, dimension(4) :: var_dim - -!------------------------------------------------------------------------------- -! Typical valid ranges (IEEE 754) - -! real(kind=4): +/- 3.4028235E+38 -! real(kind=8): +/- 1.797693134862316E+308 -! real(kind=16):+/- 1.189731495357231765085759326628007E+4932 - -! We use a 4 byte data model for NetCDF and GrADS to save disk space -!------------------------------------------------------------------------------- - var_range(1) = -huge( var_range(1) ) - var_range(2) = huge( var_range(2) ) - -! var_range = (/ -1.e31, 1.e31 /) - -! Explanation: The NetCDF documentation claims the NF90_UNLIMITED -! variable should be the first dimension, but def_var is somehow -! inverted and requires the opposite. After writing, these -! dimensions are all in the opposite order of this in the file. -! -dschanen - - var_dim(1) = ncf%LongDimId ! X - var_dim(2) = ncf%LatDimId ! Y - var_dim(3) = ncf%AltDimId ! Z - var_dim(4) = ncf%TimeDimId ! The NF90_UNLIMITED dimension - - allocate( stat( ncf%nvar ) ) - - l_error = .false. - - do i = 1, ncf%nvar, 1 -! stat(i) = nf90_def_var( ncf%iounit, trim( ncf%var(i)%name ), & -! NF90_FLOAT, (/ncf%TimeDimId, ncf%AltDimId, & -! ncf%LatDimId, ncf%LongDimId/), ncf%var(i)%indx ) - stat(i) = nf90_def_var( ncf%iounit, trim( ncf%var(i)%name ), & - NF90_FLOAT, var_dim(:), ncf%var(i)%indx ) - if ( stat(i) /= NF90_NOERR ) then - write(fstderr,*) "Error defining variable ", & - ncf%var(i)%name //": ", trim( nf90_strerror( stat(i) ) ) - l_error = .true. - end if - - stat(i) = nf90_put_att( ncf%iounit, ncf%var(i)%indx, & - "valid_range", var_range(1:2) ) - if ( stat(i) /= NF90_NOERR ) then - write(fstderr,*) "Error defining valid range", & - trim( nf90_strerror( stat(i) ) ) - l_error = .true. - end if - - stat(i) = nf90_put_att( ncf%iounit, ncf%var(i)%indx, "long_name", & - trim( ncf%var(i)%description ) ) - if ( stat(i) /= NF90_NOERR ) then - write(fstderr,*) "Error in description", & - trim( nf90_strerror( stat(i) ) ) - l_error = .true. - end if - - stat(i) = nf90_put_att( ncf%iounit, ncf%var(i)%indx, "units", & - trim( ncf%var(i)%units ) ) - if ( stat(i) /= NF90_NOERR ) then - write(fstderr,*) "Error in units", & - trim( nf90_strerror( stat(i) ) ) - l_error = .true. - end if - end do - - if ( l_error ) stop "Error in definition" - - deallocate( stat ) - - allocate( stat(5) ) - - ! Define global attributes of the file, for reproducing the results and - ! determining how a run was configured - stat(1) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "Conventions", "COARDS" ) - stat(2) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "model", "CLUBB" ) - - ! Figure out when the model is producing this file - call date_and_time( current_date, current_time ) - - stat(3) = nf90_put_att( & - ncf%iounit, NF90_GLOBAL, "created_on", & - current_date(1:4)//'-'//current_date(5:6)//'-'// & - current_date(7:8)//' '// & - current_time(1:2)//':'//current_time(3:4) ) - - stat(4) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "micro_scheme", & - trim( micro_scheme ) ) - - stat(5) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "rad_scheme", & - trim( rad_scheme ) ) - - if ( any( stat /= NF90_NOERR ) ) then - write(fstderr,*) "Error writing model information" - do i = 1, size( stat ), 1 - write(fstderr,*) trim( nf90_strerror( stat(i) ) ) - end do - stop - end if - - ! Write the model flags to the file - deallocate( stat ) - allocate( stat(10) ) ! # of model flags - - stat(1) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_local_kk", lchar( l_local_kk ) ) - stat(2) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_pos_def", lchar( l_pos_def ) ) - stat(3) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_hole_fill", lchar( l_hole_fill ) ) - stat(4) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_clip_semi_implicit", & - lchar( l_clip_semi_implicit ) ) - stat(5) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_standard_term_ta", & - lchar( l_standard_term_ta ) ) - stat(6) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_single_C2_Skw", & - lchar( l_single_C2_Skw ) ) - stat(7) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_gamma_Skw", lchar( l_gamma_Skw ) ) - stat(8) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_cloud_sed", lchar( l_cloud_sed ) ) - stat(9) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_uv_nudge", lchar( l_uv_nudge ) ) - stat(10) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "l_tke_aniso", lchar( l_tke_aniso ) ) - - if ( any( stat /= NF90_NOERR ) ) then - write(fstderr,*) "Error writing model flags" - do i = 1, size( stat ), 1 - write(fstderr,*) i, trim( nf90_strerror( stat(i) ) ) - end do - stop - end if - - ! Write model parameter values to the file - deallocate( stat ) - allocate( stat(nparams) ) - - stat(1) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "T0", T0 ) - stat(2) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "ts_nudge", ts_nudge ) - stat(3) = nf90_put_att( ncf%iounit, NF90_GLOBAL, "sclr_tol", sclr_tol ) - - call get_parameters( params ) - - do i = 1, nparams, 1 - stat(i) = nf90_put_att( ncf%iounit, NF90_GLOBAL, params_list(i), params(i) ) - end do - - if ( any( stat /= NF90_NOERR ) ) then - write(fstderr,*) "Error writing parameters" - do i = 1, nparams, 1 - write(fstderr,*) i, trim( nf90_strerror( stat(i) ) ) - end do - stop - end if - - stat(1) = nf90_enddef( ncf%iounit ) ! end definitions - if ( stat(1) /= NF90_NOERR ) then - write(fstderr,*) "Error finalizing definitions", & - trim( nf90_strerror( stat(1) ) ) - stop - end if - - deallocate( stat ) - - return - end subroutine first_write - -!------------------------------------------------------------------------------- - subroutine write_grid( ncf ) - -! Description: -! Writes inforation about latitude, longitude and the grid -! References: -! None -!------------------------------------------------------------------------------- - - use netcdf, only: & - NF90_NOERR, & ! Variable(s) - nf90_put_var, & ! Procedure(s) - nf90_strerror - use crmx_stat_file_module, only: & - stat_file ! Type - use crmx_constants_clubb, only: & - fstderr ! Variable - - implicit none - - ! Input Variable(s) - type (stat_file), intent(inout) :: ncf - - integer :: stat - - ! ---- Begin Code ---- - - stat = nf90_put_var( ncid=ncf%iounit, varid=ncf%AltVarId, & - values=ncf%z(ncf%ia:ncf%iz) ) - if ( stat /= NF90_NOERR ) then - write(fstderr,*) "Error entering grid: ", & - trim( nf90_strerror( stat ) ) - stop - end if - - stat = nf90_put_var( ncid=ncf%iounit, varid=ncf%LongVarId, & - values=ncf%rlon ) - if ( stat /= NF90_NOERR ) then - write(fstderr,*) "Error entering longitude: ", & - trim( nf90_strerror( stat ) ) - stop - end if - - stat = nf90_put_var( ncid=ncf%iounit, varid=ncf%LatVarId, & - values=ncf%rlat ) - if ( stat /= NF90_NOERR ) then - write(fstderr,*) "Error entering latitude: ", & - trim( nf90_strerror( stat ) ) - stop - end if - - return - end subroutine write_grid - -!------------------------------------------------------------------------------- - - subroutine format_date & - ( day_in, month_in, year_in, time_in, date ) - -! Description: -! Put the model date in a format that udunits and NetCDF can easily -! handle. GrADSnc is dumb and apparently cannot handle time -! intervals < 1 minute. - -! Notes: -! Adapted from the original GrADS version written by Chris Golaz. -! Uses Fortran `internal' files to write the string output. -!------------------------------------------------------------------------------- - - use crmx_calendar, only: & - compute_current_date ! Procedure(s) - - use crmx_clubb_precision, only: & - time_precision ! Variable(s) - - implicit none - - ! External - intrinsic :: floor, int, mod, nint - - ! Input Variables - integer, intent(in) :: & - day_in, & ! Day of Month at Model Start [dd] - month_in, & ! Month of Year at Model Start [mm] - year_in ! Year at Model Start [yyyy] - - real(kind=time_precision), intent(in) :: time_in ! Start time [s] - - ! Output Variables - character(len=35), intent(out) :: date - - integer:: & - iday, imonth, iyear ! Integer for day, month and year. - - real(kind=time_precision) :: st_time ! Start time [s] - - call compute_current_date( day_in, month_in, & - year_in, & - time_in, & - iday, imonth, & - iyear, & - st_time ) - - if ( .not. l_grads_kludge ) then - date = "seconds since YYYY-MM-DD HH:MM:00.0" - else - date = "minutes since YYYY-MM-DD HH:MM:00.0" - end if - write(date(15:18),'(i4.4)') iyear - write(date(20:21),'(i2.2)') imonth - write(date(23:24),'(i2.2)') iday - write(date(26:27),'(i2.2)') floor( st_time / 3600._time_precision ) - write(date(29:30),'(i2.2)') int( mod( nint( st_time ),3600 ) / 60 ) - - return - end subroutine format_date - -!=============================================================================== - character function lchar( l_input ) -! Description: -! Cast a logical to a character data type -! -! References: -! None -!------------------------------------------------------------------------------- - - implicit none - - logical, intent(in) :: l_input - - ! ---- Begin Code ---- - - if ( l_input ) then - lchar = 'T' - else - lchar = 'F' - end if - - return - end function lchar - -#endif /*NETCDF*/ -end module crmx_output_netcdf diff --git a/src/physics/spcam/crm/CLUBB/crmx_parameter_indices.F90 b/src/physics/spcam/crm/CLUBB/crmx_parameter_indices.F90 deleted file mode 100644 index a4aefca91f..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_parameter_indices.F90 +++ /dev/null @@ -1,108 +0,0 @@ -!------------------------------------------------------------------------------- -! $Id: parameter_indices.F90 5929 2012-09-07 18:09:59Z bmg2@uwm.edu $ -module crmx_parameter_indices - -! Description: -! Since f90/95 lacks enumeration, we're stuck numbering each -! parameter by hand like this. - -! Adding new parameters is relatively simple. First, the -! parameter should be added in the common block of the parameters -! module so it can be used in other parts of the code. Each -! variable needs a unique number in this module, and nparams must -! be incremented for the new variable. Next, the params_list -! variable in module parameters should have new variable added to -! it. The subroutines pack_parameters and uppack_parameters will -! need to have the variable added to their list, but the order -! doesn't actually matter, since the i variables in here determine -! where in the params vector the number is placed. -! Finally, the namelists initvars and initspread will need to -! have the parameter added to them. -!------------------------------------------------------------------------------- - - implicit none - - private ! Default Scope - - integer, parameter, public :: & - nparams = 61 ! Total tunable parameters - -!*************************************************************** -! ***** IMPORTANT ***** -! If you change the order of these parameters, you will need to -! change the order of params_list as well or the tuner will -! break! -! ***** IMPORTANT ***** -!*************************************************************** - - integer, parameter, public :: & - iC1 = 1, & - iC1b = 2, & - iC1c = 3, & - iC2 = 4, & - iC2b = 5, & - iC2c = 6, & - iC2rt = 7, & - iC2thl = 8, & - iC2rtthl = 9, & - iC4 = 10, & - iC5 = 11, & - iC6rt = 12, & - iC6rtb = 13, & - iC6rtc = 14, & - iC6thl = 15, & - iC6thlb = 16, & - iC6thlc = 17, & - iC7 = 18, & - iC7b = 19, & - iC7c = 20, & - iC8 = 21, & - iC8b = 22, & - iC10 = 23, & - iC11 = 24, & - iC11b = 25, & - iC11c = 26, & - iC12 = 27, & - iC13 = 28, & - iC14 = 29, & - iC15 = 30 - - integer, parameter, public :: & - iC6rt_Lscale0 = 31, & - iC6thl_Lscale0 = 32, & - iC7_Lscale0 = 33, & - iwpxp_L_thresh = 34 - - integer, parameter, public :: & - ic_K = 35, & - ic_K1 = 36, & - inu1 = 37, & - ic_K2 = 38, & - inu2 = 39, & - ic_K6 = 40, & - inu6 = 41, & - ic_K8 = 42, & - inu8 = 43, & - ic_K9 = 44, & - inu9 = 45, & - inu10 = 46, & - ic_Krrainm = 47, & - inu_r = 48, & - inu_hd = 49 - - integer, parameter, public :: & - igamma_coef = 50, & - igamma_coefb = 51, & - igamma_coefc = 52, & - imu = 53, & - ibeta = 54, & - ilmin_coef = 55, & - imult_coef = 56, & - itaumin = 57, & - itaumax = 58, & - iLscale_mu_coef = 59, & - iLscale_pert_coef = 60, & - ialpha_corr = 61 - -end module crmx_parameter_indices -!----------------------------------------------------------------------- diff --git a/src/physics/spcam/crm/CLUBB/crmx_parameters_microphys.F90 b/src/physics/spcam/crm/CLUBB/crmx_parameters_microphys.F90 deleted file mode 100644 index e6fe31957b..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_parameters_microphys.F90 +++ /dev/null @@ -1,191 +0,0 @@ -! $Id: parameters_microphys.F90 6063 2013-02-12 18:01:12Z dschanen@uwm.edu $ -!=============================================================================== -module crmx_parameters_microphys - -! Description: -! Parameters for microphysical schemes - -! References: -! None -!------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - time_precision, & - core_rknd - - use crmx_mt95, only: & - genrand_intg - - implicit none - - ! Constant Parameters - integer, parameter, public :: & - LH_microphys_interactive = 1, & ! Feed the samples into the microphysics and allow feedback - LH_microphys_non_interactive = 2, & ! Feed the samples into the microphysics with no feedback - LH_microphys_disabled = 3 ! Disable Latin hypercube entirely - - ! Morrison aerosol parameters - integer, parameter, public :: & - morrison_no_aerosol = 0, & - morrison_power_law = 1, & - morrison_lognormal = 2 - - ! Local Variables - logical, public :: & - l_cloud_sed, & ! Cloud water sedimentation (K&K/No microphysics) - l_ice_micro, & ! Compute ice (COAMPS/Morrison) - l_upwind_diff_sed, & ! Use upwind differencing approx. for sedimentation (K&K/COAMPS) - l_graupel, & ! Compute graupel (COAMPS/Morrison) - l_hail, & ! Assumption about graupel/hail? (Morrison) - l_seifert_beheng, & ! Use Seifert and Behneng warm drizzle (Morrison) - l_predictnc, & ! Predict cloud droplet conconcentration (Morrison) - l_const_Nc_in_cloud, & ! Use a constant cloud droplet conc. within cloud (K&K) - l_subgrid_w, & ! Use subgrid w (Morrison) - l_arctic_nucl, & ! Use MPACE observations (Morrison) - l_fix_pgam, & ! Fix pgam (Morrison) - l_in_cloud_Nc_diff, & ! Use in cloud values of Nc for diffusion - l_var_covar_src ! Flag for using upscaled microphysics source terms - ! for predictive variances and covariances (KK micro) - -!$omp threadprivate( l_cloud_sed, l_ice_micro, l_graupel, l_hail, & -!$omp l_upwind_diff_sed, l_seifert_beheng, l_predictnc, & -!$omp l_const_Nc_in_cloud, l_subgrid_w, l_arctic_nucl, & -!$omp l_fix_pgam, l_in_cloud_Nc_diff, l_var_covar_src ) - - logical, public :: & - l_cloud_edge_activation, & ! Activate on cloud edges (Morrison) - l_local_kk ! Local drizzle for Khairoutdinov & Kogan microphysics - -!$omp threadprivate(l_cloud_edge_activation, l_local_kk) - - character(len=30), public :: & - specify_aerosol ! Specify aerosol (Morrison) - - ! Flags for the Latin Hypercube sampling code - logical, public :: & - l_fix_s_t_correlations, & ! Use a fixed correlation for s and t Mellor - l_lh_cloud_weighted_sampling, & ! Limit noise by sampling in-cloud - l_lh_vert_overlap ! Assume maximum overlap for s_mellor - -!$omp threadprivate( l_fix_s_t_correlations, l_lh_cloud_weighted_sampling, & -!$omp l_lh_vert_overlap ) - - integer, public :: & - LH_microphys_calls, & ! Number of latin hypercube samples to call the microphysics with - LH_sequence_length ! Number of timesteps before the latin hypercube seq. repeats - - integer(kind=genrand_intg), public :: & - LH_seed ! Seed for the Mersenne - -!$omp threadprivate( LH_microphys_calls, LH_sequence_length, LH_seed ) - - ! Determines how the latin hypercube samples should be used with the microphysics - integer, public :: & - LH_microphys_type - -!$omp threadprivate( LH_microphys_type ) - - character(len=50), public :: & - micro_scheme ! khairoutdinv_kogan, simplified_ice, coamps, etc. - -!$omp threadprivate( micro_scheme ) - - character(len=10), dimension(:), allocatable, public :: & - hydromet_list - -!$omp threadprivate( hydromet_list ) - - real(kind=time_precision), public :: & - microphys_start_time ! When to start the microphysics [s] - -!$omp threadprivate( microphys_start_time ) - - real( kind = core_rknd ), public :: & - Ncm_initial ! Initial cloud droplet number concentration [#/m^3] - -!$omp threadprivate( Ncm_initial ) - - real( kind = core_rknd ), public :: & - sigma_g ! Geometric std. dev. of cloud droplets falling in a stokes regime. - -!$omp threadprivate( sigma_g ) - - ! Statistical rain parameters . - - ! Parameters for in-cloud (from SAM RF02 DO). - real( kind = core_rknd ), public :: & ! RF02 value - rrp2_on_rrm2_cloud, & ! 0.766 - Nrp2_on_Nrm2_cloud, & ! 0.429 - Ncp2_on_Ncm2_cloud ! 0.003 - -!$omp threadprivate( rrp2_on_rrm2_cloud, Nrp2_on_Nrm2_cloud, & -!$omp Ncp2_on_Ncm2_cloud ) - - ! Parameters for below-cloud (from SAM RF02 DO). - real( kind = core_rknd ), public :: & ! RF02 value - rrp2_on_rrm2_below, & ! 8.97 - Nrp2_on_Nrm2_below, & ! 12.03 - Ncp2_on_Ncm2_below ! 0.00 ! Not applicable below cloud. - -!$omp threadprivate( rrp2_on_rrm2_below, Nrp2_on_Nrm2_below, & -!$omp Ncp2_on_Ncm2_below ) - - ! Other needed parameters - real( kind = core_rknd ), public :: C_evap ! 0.86 ! Khairoutdinov and Kogan (2000) ratio of - ! drizzle drop mean geometric radius to - ! drizzle drop mean volume radius. - ! Khairoutdinov and Kogan (2000); p. 233. - !real, public :: C_evap = 0.86*0.2 ! COAMPS value of KK C_evap - !real, public :: C_evap = 0.55 ! KK 2000, Marshall-Palmer (1948) value. - - real( kind = core_rknd ), public :: r_0 ! 25.0e-6 ! Assumed radius of all new drops; m. - ! Value specified in KK (2000); p. 235. - ! Vince Larson set r_0=28mum to agree with COAMPS-LES formula. 15 April 2005 - !REAL, PARAMETER:: r_0 = 28.0e-6 ! Assumed radius of all new drops; m. - ! ! Value that COAMPS LES has in it. - !REAL, PARAMETER:: r_0 = 30.0e-6 ! Assumed radius of all new drops; m. - ! ! Khairoutdinov said it was okay! - ! End Vince Larson's change. - -!$omp threadprivate( C_evap, r_0 ) - - ! Values of exponents in KK microphysics - real( kind = core_rknd ), public :: & - KK_evap_Supersat_exp, & ! Exponent on Supersaturation (S) in KK evap. eq.; 1 - KK_evap_rr_exp, & ! Exponent on r_r in KK evaporation eq.; 1/3 - KK_evap_Nr_exp, & ! Exponent on N_r in KK evaporation eq.; 2/3 - KK_auto_rc_exp, & ! Exponent on r_c in KK autoconversion eq.; 2.47 - KK_auto_Nc_exp, & ! Exponent on N_c in KK autoconversion eq.; -1.79 - KK_accr_rc_exp, & ! Exponent on r_c in KK accretion eq.; 1.15 - KK_accr_rr_exp, & ! Exponent on r_r in KK accretion eq.; 1.15 - KK_mvr_rr_exp, & ! Exponent on r_r in KK mean volume radius eq.; 1/3 - KK_mvr_Nr_exp ! Exponent on N_r in KK mean volume radius eq.; -1/3 - -!$omp threadprivate( KK_evap_Supersat_exp, KK_evap_rr_exp, KK_evap_Nr_exp, & -!$omp KK_auto_rc_exp, KK_auto_Nc_exp, KK_accr_rc_exp, & -!$omp KK_accr_rr_exp, KK_mvr_rr_exp, KK_mvr_Nr_exp ) - - ! Parameters added for ice microphysics and latin hypercube sampling - - real( kind = core_rknd ), public :: & - rsnowp2_on_rsnowm2_cloud, & - Nsnowp2_on_Nsnowm2_cloud, & - ricep2_on_ricem2_cloud, & - Nicep2_on_Nicem2_cloud - -!$omp threadprivate( rsnowp2_on_rsnowm2_cloud, Nsnowp2_on_Nsnowm2_cloud, & -!$omp ricep2_on_ricem2_cloud, Nicep2_on_Nicem2_cloud ) - - real( kind = core_rknd ), public :: & - rsnowp2_on_rsnowm2_below, & - Nsnowp2_on_Nsnowm2_below, & - ricep2_on_ricem2_below, & - Nicep2_on_Nicem2_below - -!$omp threadprivate( rsnowp2_on_rsnowm2_below, Nsnowp2_on_Nsnowm2_below, & -!$omp ricep2_on_ricem2_below, Nicep2_on_Nicem2_below ) - - private ! Default Scope - - -end module crmx_parameters_microphys diff --git a/src/physics/spcam/crm/CLUBB/crmx_parameters_model.F90 b/src/physics/spcam/crm/CLUBB/crmx_parameters_model.F90 deleted file mode 100644 index 4af1f55c36..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_parameters_model.F90 +++ /dev/null @@ -1,160 +0,0 @@ -!------------------------------------------------------------------------------- -! $Id: parameters_model.F90 5723 2012-02-15 17:20:44Z meyern@uwm.edu $ -!=============================================================================== -module crmx_parameters_model - -! Description: -! Contains model parameters that are determined at run time rather than -! compile time. -! -! References: -! None -!------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd - - implicit none - - private ! Default scope - - ! Maximum allowable value for Lscale [m]. - ! Value depends on whether the model is run by itself or as part of a - ! host model. - real( kind = core_rknd ), public :: Lscale_max - -!$omp threadprivate(Lscale_max) - - ! Maximum magnitude of PDF parameter 'mixt_frac'. - real( kind = core_rknd ), public :: mixt_frac_max_mag - -!$omp threadprivate(mixt_frac_max_mag) - - ! Model parameters and constraints setup in the namelists - real( kind = core_rknd ), public :: & - T0, & ! Reference temperature (usually 300) [K] - ts_nudge ! Timescale of u/v nudging [s] - -#ifdef GFDL - real( kind = core_rknd ), public :: & ! h1g, 2010-06-15 - cloud_frac_min ! minimum cloud fraction for droplet # -#endif - - -!$omp threadprivate(T0, ts_nudge) - - real( kind = core_rknd), public :: & - rtm_min, & ! Value below which rtm will be nudged [kg/kg] - rtm_nudge_max_altitude ! Highest altitude at which to nudge rtm [m] - - integer, public :: & - sclr_dim, & ! Number of passive scalars - edsclr_dim, & ! Number of eddy-diff. passive scalars - hydromet_dim ! Number of hydrometeor species - -!$omp threadprivate(sclr_dim, edsclr_dim, hydromet_dim) - - real( kind = core_rknd ), dimension(:), allocatable, public :: & - sclr_tol ! Threshold(s) on the passive scalars [units vary] - -!$omp threadprivate(sclr_tol) - - real( kind = 4 ), public :: PosInf - -!$omp threadprivate(PosInf) - - public :: setup_parameters_model - - contains - -!------------------------------------------------------------------------------- - subroutine setup_parameters_model & - ( T0_in, ts_nudge_in, & - hydromet_dim_in, & - sclr_dim_in, sclr_tol_in, edsclr_dim_in, & - Lscale_max_in & - -#ifdef GFDL - , cloud_frac_min_in & ! hlg, 2010-6-15 -#endif - - ) - -! Description: -! Sets parameters to their initial values -! -! References: -! None -!------------------------------------------------------------------------------- - use crmx_constants_clubb, only: Skw_max_mag, Skw_max_mag_sqd - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: sqrt, allocated, transfer - - ! Constants - integer(kind=4), parameter :: nanbits = 2139095040 - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - T0_in, & ! Ref. temperature [K] - ts_nudge_in, & ! Timescale for u/v nudging [s] - Lscale_max_in ! Largest value for Lscale [m] - -#ifdef GFDL - real( kind = core_rknd ), intent(in) :: cloud_frac_min_in ! h1g, 2010-06-15 -#endif - - - integer, intent(in) :: & - hydromet_dim_in, & ! Number of hydrometeor species - sclr_dim_in, & ! Number of passive scalars - edsclr_dim_in ! Number of eddy-diff. passive scalars - - real( kind = core_rknd ), intent(in), dimension(sclr_dim_in) :: & - sclr_tol_in ! Threshold on passive scalars - - ! --- Begin Code --- - - ! Formula from subroutine pdf_closure, where sigma_sqd_w = 0.4 and Skw = - ! Skw_max_mag in this formula. Note that this is constant, but can't appear - ! with a Fortran parameter attribute, so we define it here. - mixt_frac_max_mag = 1.0_core_rknd & - - ( 0.5_core_rknd * ( 1.0_core_rknd - Skw_max_mag / & - sqrt( 4.0_core_rknd * ( 1.0_core_rknd - 0.4_core_rknd )**3 & - + Skw_max_mag_sqd ) ) ) ! Known magic number - - Lscale_max = Lscale_max_in - - T0 = T0_in - ts_nudge = ts_nudge_in - - hydromet_dim = hydromet_dim_in - sclr_dim = sclr_dim_in - edsclr_dim = edsclr_dim_in - - ! In a tuning run, this array has the potential to be allocated already - if ( .not. allocated( sclr_tol ) ) then - allocate( sclr_tol(1:sclr_dim) ) - else - deallocate( sclr_tol ) - allocate( sclr_tol(1:sclr_dim) ) - end if - - sclr_tol(1:sclr_dim) = sclr_tol_in(1:sclr_dim) - - PosInf = transfer( nanbits, PosInf ) - -#ifdef GFDL - cloud_frac_min = cloud_frac_min_in ! h1g, 2010-06-15 -#endif - - return - end subroutine setup_parameters_model -!------------------------------------------------------------------------------- - -end module crmx_parameters_model diff --git a/src/physics/spcam/crm/CLUBB/crmx_parameters_radiation.F90 b/src/physics/spcam/crm/CLUBB/crmx_parameters_radiation.F90 deleted file mode 100644 index 7ade0432e1..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_parameters_radiation.F90 +++ /dev/null @@ -1,78 +0,0 @@ -!------------------------------------------------------------------------------- -! $Id: parameters_radiation.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -module crmx_parameters_radiation - -! Description: -! Parameters for radiation schemes - -! References: -! None -!------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - dp, & ! double precision - core_rknd - - implicit none - - character(len=20), public :: & - rad_scheme ! Either BUGSrad, simplified, or simplied_bomex - - real( kind = dp ), dimension(1), public :: & - sol_const ! Solar constant - - real( kind = core_rknd ), public :: & - radiation_top ! The top of the atmosphere fed into a radiation scheme. - ! The computational grid should be extended to reach this - ! altitude. - - ! Albedo values (alvdr is used in the simplifed schemes as well) - real( kind = dp ), public :: & - alvdr, & !Visible direct surface albedo [-] - alndr, & !Near-IR direct surface albedo [-] - alvdf, & !Visible diffuse surface albedo [-] - alndf !Near-IR diffuse surface albedo [-] - - - ! Long-wave constants (simplified radiation) - real( kind = core_rknd ), public :: & - kappa, & ! A constant (Duynkerke eqn. 5) [m^2/kg] - F0, & ! Coefficient for cloud top heating (see Stevens) [W/m^2] - F1 ! Coefficient for cloud base heating (see Stevens)[W/m^2] - - ! Short-wave constants - real( kind = core_rknd ), public :: & - eff_drop_radius, & ! Effective droplet radius [m] - gc, & ! Asymmetry parameter, "g" in Duynkerke [-] - omega ! Single-scattering albedo [-] - - real( kind = dp ), public :: & - slr ! Fraction of daylight - - real( kind = core_rknd ), public, dimension(20) :: & - Fs_values, & ! List of Fs0 values for simplified radiation - cos_solar_zen_times, & ! List of cosine of the solar zenith angle times - cos_solar_zen_values ! List of cosine of the solar zenith angle values - - logical, public :: & - l_fix_cos_solar_zen, l_sw_radiation - - logical, public :: & - l_rad_above_cloud ! Use DYCOMS II RF02 heaviside step function - - integer, public :: & - nparam - - ! Flag to signal the use of the U.S. Standard Atmosphere Profile, 1976 - logical, public :: l_use_default_std_atmosphere - - private ! Default Scope - -! OpenMP directives. The first column of these cannot be indented. -!$omp threadprivate(rad_scheme, sol_const, alvdr, alvdf, alndr, alndf, & -!$omp kappa, F0, F1, eff_drop_radius, gc, omega, radiation_top, Fs_values, & -!$omp l_rad_above_cloud, cos_solar_zen_times, cos_solar_zen_values, & -!$omp l_fix_cos_solar_zen, nparam, & -!$omp l_sw_radiation, l_use_default_std_atmosphere) - -end module crmx_parameters_radiation diff --git a/src/physics/spcam/crm/CLUBB/crmx_parameters_tunable.F90 b/src/physics/spcam/crm/CLUBB/crmx_parameters_tunable.F90 deleted file mode 100644 index 818985e39d..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_parameters_tunable.F90 +++ /dev/null @@ -1,1246 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: parameters_tunable.F90 5997 2012-12-18 20:47:09Z raut@uwm.edu $ -!=============================================================================== -module crmx_parameters_tunable - - ! Description: - ! This module contains tunable model parameters. The purpose of the module is to make it - ! easier for the clubb_tuner code to use the params vector without "knowing" any information - ! about the individual parameters contained in the vector itself. It makes it easier to add - ! new parameters to be tuned for, but does not make the CLUBB_core code itself any simpler. - ! The parameters within the vector do not need to be the same variables used in the rest of - ! CLUBB_core (see for e.g. nu1_vert_res_dep or lmin_coef). - ! The parameters in the params vector only need to be those parameters for which we're not - ! sure the correct value and we'd like to tune for. - ! - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_parameter_indices, only: nparams ! Variable(s) - - use crmx_grid_class, only: gr ! Variable(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Default to private - private - - public :: setup_parameters, read_parameters, read_param_spread, & - get_parameters, adj_low_res_nu, cleanup_nu - - ! Model constant parameters - real( kind = core_rknd ), public :: & - C1 = 2.500000_core_rknd, & ! Low Skewness in C1 Skewness Function. - C1b = 2.500000_core_rknd, & ! High Skewness in C1 Skewness Function. - C1c = 1.000000_core_rknd, & ! Degree of Slope of C1 Skewness Function. - C2 = 1.300000_core_rknd, & ! Low Skewness in C2 Skewness Function. - C2rt = 1.500000_core_rknd, & ! C2 coefficient for the rtp2_dp1 term. - C2thl = 1.000000_core_rknd, & ! C2 coefficient for the thlp2_dp1 term. - C2rtthl = 2.000000_core_rknd, & ! C2 coefficient for the rtpthlp_dp1 term. - C2b = 1.300000_core_rknd, & ! High Skewness in C2 Skewness Function. - C2c = 5.000000_core_rknd, & ! Degree of Slope of C2 Skewness Function. - C4 = 5.200000_core_rknd, & ! Used only when l_tke_aniso is true. - C5 = 0.300000_core_rknd, & ! Coefficient in pressure terms in the w'^2 eqn. - C6rt = 2.300000_core_rknd, & ! Low Skewness in C6rt Skewness Function. - C6rtb = 6.000000_core_rknd, & ! High Skewness in C6rt Skewness Function. - C6rtc = 1.000000_core_rknd, & ! Degree of Slope of C6rt Skewness Function. - C6thl = 4.000000_core_rknd, & ! Low Skewness in C6thl Skewness Function. - C6thlb = 6.000000_core_rknd, & ! High Skewness in C6thl Skewness Function. - C6thlc = 1.000000_core_rknd, & ! Degree of Slope of C6thl Skewness Function. - C7 = 0.320000_core_rknd, & ! Low Skewness in C7 Skewness Function. - C7b = 0.800000_core_rknd, & ! High Skewness in C7 Skewness Function. - C7c = 0.500000_core_rknd, & ! Degree of Slope of C7 Skewness Function. - C8 = 3.000000_core_rknd, & ! Coefficient #1 in C8 Skewness Equation. - C8b = 0.000000_core_rknd, & ! Coefficient #2 in C8 Skewness Equation. - C10 = 3.300000_core_rknd, & ! Currently Not Used in the Model. - C11 = 0.80000_core_rknd, & ! Low Skewness in C11 Skewness Function. - C11b = 0.350000_core_rknd, & ! High Skewness in C11 Skewness Function. - C11c = 0.500000_core_rknd, & ! Degree of Slope of C11 Skewness Function. - C12 = 1.000000_core_rknd, & ! Constant in w'^3 Crank-Nicholson diffusional term. - C13 = 0.100000_core_rknd, & ! Not currently used in model. - C14 = 1.000000_core_rknd, & ! Constant for u'^2 and v'^2 terms. - C15 = 0.4_core_rknd ! Coefficient for the wp3_bp2 term - - real( kind = core_rknd ), public :: & - C6rt_Lscale0 = 14.0_core_rknd, & ! Damp C6rt as a function of Lscale - C6thl_Lscale0 = 14.0_core_rknd, & ! Damp C6thl as a function of Lscale - C7_Lscale0 = 0.8500000_core_rknd, & ! Damp C7 as a function of Lscale - wpxp_L_thresh = 60.0_core_rknd ! Lscale threshold for damping C6 and C7 coefficients - - real( kind = core_rknd ), public :: & - c_K = 0.200000_core_rknd, & ! Constant C_mu^(1/4) in Duynkerke & Driedonks 1987. - c_K1 = 0.750000_core_rknd, & ! Coefficient of Eddy Diffusion for wp2. - c_K2 = 0.125000_core_rknd, & ! Coefficient of Eddy Diffusion for xp2. - c_K6 = 0.375000_core_rknd, & ! Coefficient of Eddy Diffusion for wpthlp and wprtp. - c_K8 = 1.250000_core_rknd, & ! Coefficient of Eddy Diffusion for wp3. - c_K9 = 0.250000_core_rknd, & ! Coefficient of Eddy Diffusion for up2 and vp2. - c_Krrainm = 0.200000_core_rknd, & ! Coefficient of Eddy Diffusion for hydrometeors. - gamma_coef = 0.320000_core_rknd, & ! Low Skewness in gamma coefficient Skewness Function. - gamma_coefb = 0.320000_core_rknd, & ! High Skewness in gamma coefficient Skewness Function. - gamma_coefc = 5.000000_core_rknd, & ! Degree of Slope of gamma coefficient Skewness Function. - mu = 1.000E-3_core_rknd, & ! Fractional entrainment rate per unit altitude. - mult_coef = 1.500000_core_rknd, & ! Coefficient applied to log( avg dz / threshold ) - taumin = 90.00000_core_rknd, & ! Minimum allowable value of time-scale tau. - taumax = 3600.000_core_rknd, & ! Maximum allowable value of time-scale tau. - lmin ! Minimum value for the length scale. - - real( kind = core_rknd ), public :: & - Lscale_mu_coef = 2.0_core_rknd, & ! Coefficient to perturb mu for an avg calculation of Lscale - Lscale_pert_coef = 0.1_core_rknd ! Coeff to perturb thlm and rtm for an avg calc of Lscale. - - real( kind = core_rknd ), public :: & - alpha_corr = 0.15_core_rknd ! Coefficient for the correlation diagnosis algoritm - - real( kind = core_rknd ), private :: & - nu1 = 20.00000_core_rknd, & ! Background Coefficient of Eddy Diffusion for wp2. - nu2 = 5.000000_core_rknd, & ! Background Coefficient of Eddy Diffusion for xp2. - nu6 = 5.000000_core_rknd, & ! Background Coefficient of Eddy Diffusion for wpxp. - nu8 = 20.00000_core_rknd, & ! Background Coefficient of Eddy Diffusion for wp3. - nu9 = 20.00000_core_rknd, & ! Background Coefficient of Eddy Diffusion for up2 and vp2. - nu10 = 0.00000_core_rknd,&! Background Coef of Eddy Dfsn for edsclrm, um, vm, upwp, vpwp - nu_r = 1.500000_core_rknd,& ! Background Coefficient of Eddy Diffusion for hydrometeors. - nu_hd = 20000.00_core_rknd ! Constant coefficient for 4th-order hyper-diffusion. - -!$omp threadprivate(C1, C1b, C1c, C2, C2b, C2c, & -!$omp C2rt, C2thl, C2rtthl, C4, C5, C6rt, C6rtb, C6rtc, & -!$omp C6thl, C6thlb, C6thlc, & -!$omp C7, C7b, C7c, C8, C8b, C10, C11, C11b, C11c, C12, & -!$omp C13, C14, C15, & -!$omp c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & -!$omp c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, nu_hd, & -!$omp gamma_coef, gamma_coefb, gamma_coefc, mult_coef, & -!$omp taumin, taumax, mu, lmin, Lscale_mu_coef, Lscale_pert_coef) - - real( kind = core_rknd ), public, allocatable, dimension(:) :: & - nu1_vert_res_dep, & ! Background Coefficient of Eddy Diffusion for wp2. - nu2_vert_res_dep, & ! Background Coefficient of Eddy Diffusion for xp2. - nu6_vert_res_dep, & ! Background Coefficient of Eddy Diffusion for wpxp. - nu8_vert_res_dep, & ! Background Coefficient of Eddy Diffusion for wp3. - nu9_vert_res_dep, & ! Background Coefficient of Eddy Diffusion for up2 and vp2. - nu10_vert_res_dep, & ! Background Coef of Eddy Dfsn for edsclrm,um,vm,upwp,vpwp. - nu_r_vert_res_dep ! Background Coefficient of Eddy Diffusion for hydrometeors. - - real( kind = core_rknd ), public :: & - nu_hd_vert_res_dep ! Constant coefficient for 4th-order hyper-diffusion. - -!$omp threadprivate(nu1_vert_res_dep, nu2_vert_res_dep, nu6_vert_res_dep, & -!$omp nu8_vert_res_dep, nu9_vert_res_dep, nu10_vert_res_dep, nu_r_vert_res_dep, & -!$omp nu_hd_vert_res_dep ) - - ! Vince Larson added a constant to set plume widths for theta_l and rt - ! beta should vary between 0 and 3, with 1.5 the standard value - - real( kind = core_rknd ), public :: beta = 1.750000_core_rknd - -!$omp threadprivate(beta) - - real( kind = core_rknd ), private :: lmin_coef = 0.500000_core_rknd ! Coefficient of lmin - -!$omp threadprivate(lmin_coef) - - ! used in adj_low_res_nu. If .true., avg_deltaz = deltaz -#ifdef GFDL - logical, public :: l_prescribed_avg_deltaz = .true. -#else - logical, public :: l_prescribed_avg_deltaz = .false. -#endif - -!$omp threadprivate(l_prescribed_avg_deltaz) - - ! Since we lack a devious way to do this just once, this namelist - ! must be changed as well when a new parameter is added. - namelist /initvars/ & - C1, C1b, C1c, C2, C2b, C2c, & - C2rt, C2thl, C2rtthl, C4, C5, & - C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & - C7, C7b, C7c, C8, C8b, C10, C11, C11b, C11c, & - C12, C13, C14, C15, C6rt_Lscale0, C6thl_Lscale0, & - C7_Lscale0, wpxp_L_thresh, c_K, c_K1, nu1, c_K2, nu2, & - c_K6, nu6, c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & - nu_hd, beta, gamma_coef, gamma_coefb, gamma_coefc, lmin_coef, & - mult_coef, taumin, taumax, mu, Lscale_mu_coef, Lscale_pert_coef, & - alpha_corr - - ! These are referenced together often enough that it made sense to - ! make a list of them. Note that lmin_coef is the input parameter, - ! while the actual lmin model constant is computed from this. - !*************************************************************** - ! ***** IMPORTANT ***** - ! If you change the order of the parameters in the parameter_indices, - ! you will need to change the order of this list as well or the - ! tuner will break! - ! ***** IMPORTANT ***** - !*************************************************************** - character(len=16), dimension(nparams), parameter, public :: & - params_list = & - (/"C1 ", "C1b ", "C1c ", "C2 ", & - "C2b ", "C2c ", "C2rt ", "C2thl ", & - "C2rtthl ", "C4 ", "C5 ", "C6rt ", & - "C6rtb ", "C6rtc ", "C6thl ", "C6thlb ", & - "C6thlc ", "C7 ", "C7b ", "C7c ", & - "C8 ", "C8b ", "C10 ", "C11 ", & - "C11b ", "C11c ", "C12 ", "C13 ", & - "C14 ", "C15 ", "C6rt_Lscale0 ", "C6thl_Lscale0 ", & - "C7_Lscale0 ", "wpxp_L_thresh ", "c_K ", "c_K1 ", & - "nu1 ", "c_K2 ", "nu2 ", "c_K6 ", & - "nu6 ", "c_K8 ", "nu8 ", "c_K9 ", & - "nu9 ", "nu10 ", "c_Krrainm ", "nu_r ", & - "nu_hd ", "gamma_coef ", "gamma_coefb ", "gamma_coefc ", & - "mu ", "beta ", "lmin_coef ", "mult_coef ", & - "taumin ", "taumax ", "Lscale_mu_coef ", "Lscale_pert_coef", & - "alpha_corr " /) - - real( kind = core_rknd ), parameter :: & - init_value = -999._core_rknd ! Initial value for the parameters, used to detect missing values - - contains - - !============================================================================= - subroutine setup_parameters & - ( deltaz, params, nzmax, & - grid_type, momentum_heights, thermodynamic_heights, & - err_code ) - - ! Description: - ! Subroutine to setup model parameters - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Variable(s) - - use crmx_error_code, only: & - clubb_var_out_of_bounds, & ! Variable(s) - clubb_no_error - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - deltaz ! Change per height level [m] - - real( kind = core_rknd ), intent(in), dimension(nparams) :: & - params ! Tuneable model parameters [-] - - ! Grid definition - integer, intent(in) :: nzmax ! Vertical grid levels [#] - - ! If CLUBB is running on its own, this option determines - ! if it is using: - ! 1) an evenly-spaced grid, - ! 2) a stretched (unevenly-spaced) grid entered on the - ! thermodynamic grid levels (with momentum levels set - ! halfway between thermodynamic levels), or - ! 3) a stretched (unevenly-spaced) grid entered on the - ! momentum grid levels (with thermodynamic levels set - ! halfway between momentum levels). - integer, intent(in) :: grid_type - - ! If the CLUBB parameterization is implemented in a host model, - ! it needs to use the host model's momentum level altitudes - ! and thermodynamic level altitudes. - ! If the CLUBB model is running by itself, but is using a - ! stretched grid entered on thermodynamic levels (grid_type = 2), - ! it needs to use the thermodynamic level altitudes as input. - ! If the CLUBB model is running by itself, but is using a - ! stretched grid entered on momentum levels (grid_type = 3), - ! it needs to use the momentum level altitudes as input. - real( kind = core_rknd ), intent(in), dimension(nzmax) :: & - momentum_heights, & ! Momentum level altitudes (input) [m] - thermodynamic_heights ! Thermodynamic level altitudes (input) [m] - - ! Output Variables - integer, intent(out) :: & - err_code ! Error condition - - ! Local Variables - real( kind = core_rknd ), parameter :: & - lmin_deltaz = 40.0_core_rknd ! Fixed value for minimum value for the length scale. - - !-------------------- Begin code -------------------- - - call unpack_parameters( params, & - C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & - C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & - C7, C7b, C7c, C8, C8b, C10, & - C11, C11b, C11c, C12, C13, C14, C15, & - C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & - c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & - c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & - nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & - mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & - Lscale_pert_coef, alpha_corr ) - - - ! It was decided after some experimentation, that the best - ! way to produce grid independent results is to set lmin to be - ! some fixed value. -dschanen 21 May 2007 - !lmin = lmin_coef * deltaz ! Old - lmin = lmin_coef * lmin_deltaz ! New fixed value - - ! ### Adjust Constant Diffusivity Coefficients Based On Grid Spacing ### - call adj_low_res_nu & - ( nzmax, grid_type, deltaz, & ! Intent(in) - momentum_heights, thermodynamic_heights ) ! Intent(in) - - ! Sanity check - if ( beta < 0.0_core_rknd .or. beta > 3.0_core_rknd ) then - - ! Constraints on beta - write(fstderr,*) "beta = ", beta - write(fstderr,*) "beta cannot be < 0 or > 3" - err_code = clubb_var_out_of_bounds - - else if ( mu < 0.0_core_rknd ) then - - ! Constraints on entrainment rate, mu. - write(fstderr,*) "mu = ", mu - write(fstderr,*) "mu cannot be < 0" - err_code = clubb_var_out_of_bounds - - else if ( lmin < 4.0_core_rknd ) then - - ! Constraints on mixing length - write(fstderr,*) "lmin = ", lmin - write(fstderr,*) "lmin is < 4.0_core_rknd" - err_code = clubb_var_out_of_bounds - - else - - err_code = clubb_no_error - - end if ! A parameter is outside the acceptable range - -! write(*,nml=initvars) ! %% debug - - - return - - end subroutine setup_parameters - - !============================================================================= - subroutine adj_low_res_nu & - ( nzmax, grid_type, deltaz, & ! Intent(in) - momentum_heights, thermodynamic_heights ) ! Intent(in) - - ! Description: - ! Adjust the values of background eddy diffusivity based on - ! vertical grid spacing. - ! This code was made into a public subroutine so that it may be - ! called multiple times per model run in scenarios where grid - ! altitudes, and hence average grid spacing, change through space - ! and/or time. This occurs, for example, when CLUBB is - ! implemented in WRF. --ldgrant Jul 2010 - !---------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Constant(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant Parameters - - ! Flag for adjusting the values of the constant background eddy diffusivity - ! coefficients based on the average vertical grid spacing. If this flag is - ! turned off, the values of the various nu coefficients will remain as they - ! are declared in the tunable_parameters.in file. - logical, parameter :: l_adj_low_res_nu = .true. - - ! The size of the average vertical grid spacing that serves as a threshold - ! for when to increase the size of the background eddy diffusivity - ! coefficients (nus) by a certain factor above what the background - ! coefficients are specified to be in tunable_parameters.in. At any average - ! grid spacing at or below this value, the values of the background - ! diffusivities remain the same. However, at any average vertical grid - ! spacing above this value, the values of the background eddy diffusivities - ! are increased. Traditionally, the threshold grid spacing has been set to - ! 40.0 meters. This is only relevant if l_adj_low_res_nu is turned on. - real( kind = core_rknd ), parameter :: & - grid_spacing_thresh = 40.0_core_rknd ! grid spacing threshold [m] - - ! Input Variables - - ! Grid definition - integer, intent(in) :: nzmax ! Vertical grid levels [#] - - ! If CLUBB is running on it's own, this option determines - ! if it is using: - ! 1) an evenly-spaced grid, - ! 2) a stretched (unevenly-spaced) grid entered on the - ! thermodynamic grid levels (with momentum levels set - ! halfway between thermodynamic levels), or - ! 3) a stretched (unevenly-spaced) grid entered on the - ! momentum grid levels (with thermodynamic levels set - ! halfway between momentum levels). - integer, intent(in) :: grid_type - - real( kind = core_rknd ), intent(in) :: & - deltaz ! Change per height level [m] - - ! If the CLUBB parameterization is implemented in a host model, - ! it needs to use the host model's momentum level altitudes - ! and thermodynamic level altitudes. - ! If the CLUBB model is running by itself, but is using a - ! stretched grid entered on thermodynamic levels (grid_type = 2), - ! it needs to use the thermodynamic level altitudes as input. - ! If the CLUBB model is running by itself, but is using a - ! stretched grid entered on momentum levels (grid_type = 3), - ! it needs to use the momentum level altitudes as input. - real( kind = core_rknd ), intent(in), dimension(nzmax) :: & - momentum_heights, & ! Momentum level altitudes (input) [m] - thermodynamic_heights ! Thermodynamic level altitudes (input) [m] - - ! Local Variables - real( kind = core_rknd ) :: avg_deltaz ! Average grid box height [m] - - ! The factor by which to multiply the coefficients of background eddy - ! diffusivity if the grid spacing threshold is exceeded and l_adj_low_res_nu - ! is turned on. - real( kind = core_rknd ),dimension(gr%nz) :: & - mult_factor_zt, & ! Uses gr%dzt for nu values on zt levels - mult_factor_zm ! Uses gr%dzm for nu values on zm levels - - ! Flag to enable nu values that are a function of grid spacing - logical, parameter :: l_nu_grid_dependent = .false. - - integer :: k ! Loop variable - - !--------------- Begin code ------------------------- - - if ( .not. allocated( nu1_vert_res_dep ) ) then - allocate( nu1_vert_res_dep(1:gr%nz) ) - end if - if ( .not. allocated( nu2_vert_res_dep ) ) then - allocate( nu2_vert_res_dep(1:gr%nz) ) - end if - if ( .not. allocated( nu6_vert_res_dep ) ) then - allocate( nu6_vert_res_dep(1:gr%nz) ) - end if - if ( .not. allocated( nu8_vert_res_dep ) ) then - allocate( nu8_vert_res_dep(1:gr%nz) ) - end if - if ( .not. allocated( nu9_vert_res_dep ) ) then - allocate( nu9_vert_res_dep(1:gr%nz) ) - end if - if ( .not. allocated( nu10_vert_res_dep ) ) then - allocate( nu10_vert_res_dep(1:gr%nz) ) - end if - if ( .not. allocated( nu_r_vert_res_dep ) ) then - allocate( nu_r_vert_res_dep(1:gr%nz) ) - end if - - ! Flag for adjusting the values of the constant diffusivity coefficients - ! based on the grid spacing. If this flag is turned off, the values of the - ! various nu coefficients will remain as they are declared in the - ! parameters.in file. - if ( l_adj_low_res_nu ) then - - ! ### Adjust Constant Diffusivity Coefficients Based On Grid Spacing ### - - ! All of the background coefficients of eddy diffusivity, as well as the - ! constant coefficient for 4th-order hyper-diffusion, must be adjusted - ! based on the size of the grid spacing. For a case that uses an - ! evenly-spaced grid, the adjustment is based on the constant grid - ! spacing deltaz. For a case that uses a stretched grid, the adjustment - ! is based on avg_deltaz, which is the average grid spacing over the - ! vertical domain. - - if ( l_prescribed_avg_deltaz ) then - - avg_deltaz = deltaz - - else if ( grid_type == 3 ) then - - ! CLUBB is implemented in a host model, or is using grid_type = 3 - - ! Find the average deltaz over the grid based on momentum level - ! inputs. - - avg_deltaz & - = ( momentum_heights(nzmax) - momentum_heights(1) ) & - / real( nzmax - 1, kind = core_rknd ) - - else if ( grid_type == 1 ) then - - ! Evenly-spaced grid. - - avg_deltaz = deltaz - - else if ( grid_type == 2 ) then - - ! Stretched (unevenly-spaced) grid: stretched thermodynamic level - ! input. - - ! Find the average deltaz over the stretched grid based on - ! thermodynamic level inputs. - - avg_deltaz & - = ( thermodynamic_heights(nzmax) - thermodynamic_heights(1) ) & - / real( nzmax - 1, kind = core_rknd ) - else - ! Eric Raut added to remove compiler warning. (Obviously, this value is not used) - avg_deltaz = 0.0_core_rknd - write(fstderr,*) "Invalid grid_type:", grid_type - stop "Fatal error" - - end if ! grid_type - - ! The nu's are chosen for deltaz <= 40 m. Looks like they must - ! be adjusted for larger grid spacings (Vince Larson) - if( .not. l_nu_grid_dependent ) then - ! Use a constant mult_factor so nu does not depend on grid spacing - if( avg_deltaz > grid_spacing_thresh ) then - mult_factor_zt = 1.0_core_rknd + mult_coef * log( avg_deltaz / grid_spacing_thresh ) - mult_factor_zm = mult_factor_zt - else - mult_factor_zt = 1.0_core_rknd - mult_factor_zm = 1.0_core_rknd - end if - else ! l_nu_grid_dependent = .true. - ! mult_factor will vary to create nu values that vary with grid spacing - do k = 1, gr%nz - if( gr%dzm(k) > grid_spacing_thresh ) then - mult_factor_zm(k) = 1.0_core_rknd + mult_coef * log( gr%dzm(k) / grid_spacing_thresh ) - else - mult_factor_zm(k) = 1.0_core_rknd - end if - - if( gr%dzt(k) > grid_spacing_thresh ) then - mult_factor_zt(k) = 1.0_core_rknd + mult_coef * log( gr%dzt(k) / grid_spacing_thresh ) - else - mult_factor_zt(k) = 1.0_core_rknd - end if - end do - end if ! l_nu_grid_dependent - - !mult_factor = 1.0_core_rknd + mult_coef * log( avg_deltaz / grid_spacing_thresh ) - nu1_vert_res_dep = nu1 * mult_factor_zm - nu2_vert_res_dep = nu2 * mult_factor_zm - nu6_vert_res_dep = nu6 * mult_factor_zm - nu8_vert_res_dep = nu8 * mult_factor_zt - nu9_vert_res_dep = nu9 * mult_factor_zm - nu10_vert_res_dep = nu10 * mult_factor_zt !We're unsure of the grid - nu_r_vert_res_dep = nu_r * mult_factor_zt - - ! The value of nu_hd is based on an average grid box spacing of - ! 40 m. The value of nu_hd should be adjusted proportionally to - ! the average grid box size, whether the average grid box size is - ! less than 40 m. or greater than 40 m. - ! Since nu_hd should be very large for large grid boxes, but - ! substantially smaller for small grid boxes, the grid spacing - ! adjuster is squared. - - nu_hd_vert_res_dep = nu_hd * ( avg_deltaz / grid_spacing_thresh )**2 - - else ! nu values are not adjusted - - nu1_vert_res_dep = nu1 - nu2_vert_res_dep = nu2 - nu6_vert_res_dep = nu6 - nu8_vert_res_dep = nu8 - nu9_vert_res_dep = nu9 - nu10_vert_res_dep = nu10 - nu_r_vert_res_dep = nu_r - nu_hd_vert_res_dep = nu_hd - - end if ! l_adj_low_res_nu - - return - end subroutine adj_low_res_nu - - !============================================================================= - subroutine read_parameters( iunit, filename, params ) - - ! Description: - ! Read a namelist containing the model parameters - - ! References: - ! None - !----------------------------------------------------------------------- - use crmx_constants_clubb, only: fstderr ! Constant - - implicit none - - ! Input variables - integer, intent(in) :: iunit - - character(len=*), intent(in) :: filename - - ! Output variables - real( kind = core_rknd ), intent(out), dimension(nparams) :: params - - ! Local variables - integer :: i - - logical :: l_error - - ! ---- Begin Code ---- - - ! If the filename is empty, assume we're using a `working' set of - ! parameters that are set statically here (handy for host models). - ! Read the namelist - if ( filename /= "" ) then - ! Read the namelist - open(unit=iunit, file=filename, status='old', action='read') - - read(unit=iunit, nml=initvars) - - close(unit=iunit) - - end if - - ! Put the variables in the output array - call pack_parameters( C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & - C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & - C7, C7b, C7c, C8, C8b, C10, & - C11, C11b, C11c, C12, C13, C14, C15, & - C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & - c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & - c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & - nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & - mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & - Lscale_pert_coef, alpha_corr, params ) - - l_error = .false. - - do i = 1, nparams - if ( params(i) == init_value ) then - write(fstderr,*) "Tuning parameter "//trim( params_list(i) )// & - " was missing from "//trim( filename ) - l_error = .true. - end if - end do - - if ( l_error ) stop "Fatal error." - - return - - end subroutine read_parameters - - !============================================================================= - subroutine read_param_spread & - ( iunit, filename, nindex, param_spread, ndim ) - - ! Description: - ! Read a namelist containing the amount to vary model parameters. - ! Used by the downhill simplex / simulated annealing algorithm. - - ! References: - ! None - !----------------------------------------------------------------------- - use crmx_constants_clubb, only: fstderr ! Constant - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input variables - integer, intent(in) :: iunit - - character(len=*), intent(in) :: filename - - ! Output variables - - ! An array of array indices (i.e. which elements of the array `params' - ! are contained within the simplex and the spread variable) - integer, intent(out), dimension(nparams) :: nindex - - real( kind = core_rknd ), intent(out), dimension(nparams) :: & - param_spread ! Amount to vary the parameter in the initial simplex - - integer, intent(out) :: ndim ! Dimension of the init simplex - - ! Local variables - integer :: i - - logical :: l_error - - ! Amount to change each parameter for the initial simplex - ! This MUST be changed to match the initvars namelist if parameters are added! - namelist /initspread/ & - C1, C1b, C1c, C2, C2b, C2c, & - C2rt, C2thl, C2rtthl, C4, C5, & - C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & - C7, C7b, C7c, C8, C8b, C10, C11, C11b, C11c, & - C12, C13, C14, C15, C6rt_Lscale0, C6thl_Lscale0, & - C7_Lscale0, wpxp_L_thresh, c_K, c_K1, nu1, c_K2, nu2, & - c_K6, nu6, c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & - nu_hd, beta, gamma_coef, gamma_coefb, gamma_coefc, & - lmin_coef, mult_coef, taumin, taumax, mu, Lscale_mu_coef, & - Lscale_pert_coef, alpha_corr - - ! Initialize values to -999. - call init_parameters_999( ) - - ! Read the namelist - open(unit=iunit, file=filename, status='old', action='read') - - read(unit=iunit, nml=initspread) - - close(unit=iunit) - - ! Put the variables in the output array - call pack_parameters( C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & - C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & - C7, C7b, C7c, C8, C8b, C10, & - C11, C11b, C11c, C12, C13, C14, C15, & - C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & - c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & - c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & - nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & - mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & - Lscale_pert_coef, alpha_corr, param_spread ) - - l_error = .false. - - do i = 1, nparams - if ( param_spread(i) == init_value ) then - write(fstderr,*) "A spread parameter "//trim( params_list(i) )// & - " was missing from "//trim( filename ) - l_error = .true. - end if - end do - - if ( l_error ) stop "Fatal error." - - ! Initialize to zero - nindex(1:nparams) = 0 - ndim = 0 - - ! Determine how many variables are being changed - do i = 1, nparams, 1 - - if ( param_spread(i) /= 0.0_core_rknd ) then - ndim = ndim + 1 ! Increase the total - nindex(ndim) = i ! Set the next array index - endif - - enddo - - return - - end subroutine read_param_spread - - !============================================================================= - subroutine pack_parameters & - ( C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & - C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & - C7, C7b, C7c, C8, C8b, C10, & - C11, C11b, C11c, C12, C13, C14, C15, & - C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & - c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & - c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & - nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & - mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & - Lscale_pert_coef, alpha_corr, params ) - - ! Description: - ! Takes the list of scalar variables and puts them into a 1D vector. - ! It is here for the purpose of keeping the code generalized - ! when new variables are added. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_parameter_indices, only: & - iC1, & ! Variable(s) - iC1b, & - iC1c, & - iC2, & - iC2b, & - iC2c, & - iC2rt, & - iC2thl, & - iC2rtthl, & - iC4, & - iC5, & - iC6rt, & - iC6rtb, & - iC6rtc, & - iC6thl, & - iC6thlb, & - iC6thlc, & - iC7, & - iC7b, & - iC7c, & - iC8, & - iC8b, & - iC10, & - iC11, & - iC11b, & - iC11c, & - iC12, & - iC13, & - iC14, & - iC15 - - use crmx_parameter_indices, only: & - iC6rt_Lscale0, & - iC6thl_Lscale0, & - iC7_Lscale0, & - iwpxp_L_thresh - - use crmx_parameter_indices, only: & - ic_K, & - ic_K1, & - inu1, & - ic_K2, & - inu2, & - ic_K6, & - inu6, & - ic_K8, & - inu8, & - ic_K9, & - inu9, & - inu10, & - ic_Krrainm, & - inu_r, & - inu_hd, & - igamma_coef, & - igamma_coefb, & - igamma_coefc, & - imu, & - ibeta, & - ilmin_coef, & - imult_coef, & - itaumin, & - itaumax, & - iLscale_mu_coef, & - iLscale_pert_coef, & - ialpha_corr, & - nparams - - implicit none - - ! Input variables - real( kind = core_rknd ), intent(in) :: & - C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & - C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & - C7, C7b, C7c, C8, C8b, C10, & - C11, C11b, C11c, C12, C13, C14, C15, & - C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & - c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & - c_K9, nu9, nu10, c_Krrainm, nu_r, nu_hd, gamma_coef, & - gamma_coefb, gamma_coefc, mu, beta, lmin_coef, mult_coef, & - taumin, taumax, Lscale_mu_coef, Lscale_pert_coef, alpha_corr - - ! Output variables - real( kind = core_rknd ), intent(out), dimension(nparams) :: params - - params(iC1) = C1 - params(iC1b) = C1b - params(iC1c) = C1c - params(iC2) = C2 - params(iC2b) = C2b - params(iC2c) = C2c - params(iC2rt) = C2rt - params(iC2thl) = C2thl - params(iC2rtthl) = C2rtthl - params(iC4) = C4 - params(iC5) = C5 - params(iC6rt) = C6rt - params(iC6rtb) = C6rtb - params(iC6rtc) = C6rtc - params(iC6thl) = C6thl - params(iC6thlb) = C6thlb - params(iC6thlc) = C6thlc - params(iC7) = C7 - params(iC7b) = C7b - params(iC7c) = C7c - params(iC8) = C8 - params(iC8b) = C8b - params(iC10) = C10 - params(iC11) = C11 - params(iC11b) = C11b - params(iC11c) = C11c - params(iC12) = C12 - params(iC13) = C13 - params(iC14) = C14 - params(iC15) = C15 - - params(iC6rt_Lscale0) = C6rt_Lscale0 - params(iC6thl_Lscale0) = C6thl_Lscale0 - params(iC7_Lscale0) = C7_Lscale0 - params(iwpxp_L_thresh) = wpxp_L_thresh - - params(ic_K) = c_K - params(ic_K1) = c_K1 - params(inu1) = nu1 - params(ic_K2) = c_K2 - params(inu2) = nu2 - params(ic_K6) = c_K6 - params(inu6) = nu6 - params(ic_K8) = c_K8 - params(inu8) = nu8 - params(ic_K9) = c_K9 - params(inu9) = nu9 - params(inu10) = nu10 - params(ic_Krrainm) = c_Krrainm - params(inu_r) = nu_r - params(inu_hd) = nu_hd - - params(igamma_coef) = gamma_coef - params(igamma_coefb) = gamma_coefb - params(igamma_coefc) = gamma_coefc - - params(imu) = mu - - params(ibeta) = beta - - params(ilmin_coef) = lmin_coef - params(imult_coef) = mult_coef - - params(itaumin) = taumin - params(itaumax) = taumax - - params(iLscale_mu_coef) = Lscale_mu_coef - params(iLscale_pert_coef) = Lscale_pert_coef - params(ialpha_corr) = alpha_corr - - return - end subroutine pack_parameters - - !============================================================================= - subroutine unpack_parameters & - ( params, & - C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & - C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & - C7, C7b, C7c, C8, C8b, C10, & - C11, C11b, C11c, C12, C13, C14, C15, & - C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & - c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & - c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & - nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & - mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & - Lscale_pert_coef, alpha_corr ) - - ! Description: - ! Takes the 1D vector and returns the list of scalar variables. - ! Here for the purposes of keeping the code generalized - ! when new variables are added. - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_parameter_indices, only: & - iC1, & ! Variable(s) - iC1b, & - iC1c, & - iC2, & - iC2b, & - iC2c, & - iC2rt, & - iC2thl, & - iC2rtthl, & - iC4, & - iC5, & - iC6rt, & - iC6rtb, & - iC6rtc, & - iC6thl, & - iC6thlb, & - iC6thlc, & - iC7, & - iC7b, & - iC7c, & - iC8, & - iC8b, & - iC10, & - iC11, & - iC11b, & - iC11c, & - iC12, & - iC13, & - iC14, & - iC15 - - use crmx_parameter_indices, only: & - iC6rt_Lscale0, & - iC6thl_Lscale0, & - iC7_Lscale0, & - iwpxp_L_thresh - - use crmx_parameter_indices, only: & - ic_K, & - ic_K1, & - inu1, & - ic_K2, & - inu2, & - ic_K6, & - inu6, & - ic_K8, & - inu8, & - ic_K9, & - inu9, & - inu10, & - ic_Krrainm, & - inu_r, & - inu_hd, & - igamma_coef, & - igamma_coefb, & - igamma_coefc, & - imu, & - ibeta, & - ilmin_coef, & - imult_coef, & - itaumin, & - itaumax, & - iLscale_mu_coef, & - iLscale_pert_coef, & - ialpha_corr, & - nparams - - implicit none - - ! Input variables - real( kind = core_rknd ), intent(in), dimension(nparams) :: params - - ! Output variables - real( kind = core_rknd ), intent(out) :: & - C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & - C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & - C7, C7b, C7c, C8, C8b, C10, & - C11, C11b, C11c, C12, C13, C14, C15, & - C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & - c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & - c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & - nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & - mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & - Lscale_pert_coef, alpha_corr - - C1 = params(iC1) - C1b = params(iC1b) - C1c = params(iC1c) - C2 = params(iC2) - C2b = params(iC2b) - C2c = params(iC2c) - C2rt = params(iC2rt) - C2thl = params(iC2thl) - C2rtthl = params(iC2rtthl) - C4 = params(iC4) - C5 = params(iC5) - C6rt = params(iC6rt) - C6rtb = params(iC6rtb) - C6rtc = params(iC6rtc) - C6thl = params(iC6thl) - C6thlb = params(iC6thlb) - C6thlc = params(iC6thlc) - C7 = params(iC7) - C7b = params(iC7b) - C7c = params(iC7c) - C8 = params(iC8) - C8b = params(iC8b) - C10 = params(iC10) - C11 = params(iC11) - C11b = params(iC11b) - C11c = params(iC11c) - C12 = params(iC12) - C13 = params(iC13) - C14 = params(iC14) - C15 = params(iC15) - - C6rt_Lscale0 = params(iC6rt_Lscale0) - C6thl_Lscale0 = params(iC6thl_Lscale0) - C7_Lscale0 = params(iC7_Lscale0) - wpxp_L_thresh = params(iwpxp_L_thresh) - - c_K = params(ic_K) - c_K1 = params(ic_K1) - nu1 = params(inu1) - c_K2 = params(ic_K2) - nu2 = params(inu2) - c_K6 = params(ic_K6) - nu6 = params(inu6) - c_K8 = params(ic_K8) - nu8 = params(inu8) - c_K9 = params(ic_K9) - nu9 = params(inu9) - nu10 = params(inu10) - c_Krrainm = params(ic_Krrainm) - nu_r = params(inu_r) - nu_hd = params(inu_hd) - - gamma_coef = params(igamma_coef) - gamma_coefb = params(igamma_coefb) - gamma_coefc = params(igamma_coefc) - - mu = params(imu) - - beta = params(ibeta) - - lmin_coef = params(ilmin_coef) - mult_coef = params(imult_coef) - - taumin = params(itaumin) - taumax = params(itaumax) - - Lscale_mu_coef = params(iLscale_mu_coef) - Lscale_pert_coef = params(iLscale_pert_coef) - alpha_corr = params(ialpha_corr) - - return - end subroutine unpack_parameters - - !============================================================================= - subroutine get_parameters( params ) - - ! Description: - ! Return an array of all tunable parameters - - ! References: - ! None - !----------------------------------------------------------------------- - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(out), dimension(nparams) :: params - - call pack_parameters( C1, C1b, C1c, C2, C2b, C2c, C2rt, C2thl, C2rtthl, & - C4, C5, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & - C7, C7b, C7c, C8, C8b, C10, & - C11, C11b, C11c, C12, C13, C14, C15, & - C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & - c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, & - c_K8, nu8, c_K9, nu9, nu10, c_Krrainm, nu_r, & - nu_hd, gamma_coef, gamma_coefb, gamma_coefc, & - mu, beta, lmin_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & - Lscale_pert_coef, alpha_corr, params ) - - return - - end subroutine get_parameters - - !============================================================================= - subroutine init_parameters_999( ) - - ! Description: - ! Set all tunable parameters to NaN - - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! --- Begin Code --- - - C1 = init_value - C1b = init_value - C1c = init_value - C2rt = init_value - C2thl = init_value - C2rtthl = init_value - C2 = init_value - C2b = init_value - C2c = init_value - C4 = init_value - C5 = init_value - C6rt = init_value - C6rtb = init_value - C6rtc = init_value - C6thl = init_value - C6thlb = init_value - C6thlc = init_value - C7 = init_value - C7b = init_value - C7c = init_value - C8 = init_value - C8b = init_value - C10 = init_value - C11 = init_value - C11b = init_value - C11c = init_value - C12 = init_value - C13 = init_value - C14 = init_value - C15 = init_value - C6rt_Lscale0 = init_value - C6thl_Lscale0 = init_value - C7_Lscale0 = init_value - wpxp_L_thresh = init_value - c_K = init_value - c_K1 = init_value - nu1 = init_value - c_K2 = init_value - nu2 = init_value - c_K6 = init_value - nu6 = init_value - c_K8 = init_value - nu8 = init_value - c_K9 = init_value - nu9 = init_value - nu10 = init_value - c_Krrainm = init_value - nu_r = init_value - nu_hd = init_value - beta = init_value - gamma_coef = init_value - gamma_coefb = init_value - gamma_coefc = init_value - mult_coef = init_value - taumin = init_value - taumax = init_value - lmin_coef = init_value - mu = init_value - Lscale_mu_coef = init_value - Lscale_pert_coef = init_value - alpha_corr = init_value - nu_hd_vert_res_dep = init_value - - return - end subroutine init_parameters_999 - - !============================================================================= - subroutine cleanup_nu( ) - - ! Description: - ! De-allocates memory used for the nu arrays - ! - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Constant - - implicit none - - ! Local Variable(s) - integer :: ierr - - ! ----- Begin Code ----- - - deallocate( nu1_vert_res_dep, nu2_vert_res_dep, nu6_vert_res_dep, & - nu8_vert_res_dep, nu9_vert_res_dep, nu10_vert_res_dep, & - nu_r_vert_res_dep, stat = ierr ) - - if ( ierr /= 0 ) then - write(fstderr,*) "Nu deallocation failed." - end if - - return - - end subroutine cleanup_nu - -!=============================================================================== - -end module crmx_parameters_tunable diff --git a/src/physics/spcam/crm/CLUBB/crmx_pdf_closure_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_pdf_closure_module.F90 deleted file mode 100644 index 44e2f4f90a..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_pdf_closure_module.F90 +++ /dev/null @@ -1,1208 +0,0 @@ -! $Id: pdf_closure_module.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ -module crmx_pdf_closure_module - - implicit none - - public :: pdf_closure - - private ! Set Default Scope - - contains -!------------------------------------------------------------------------ - - !####################################################################### - !####################################################################### - ! If you change the argument list of pdf_closure you also have to - ! change the calls to this function in the host models CAM, WRF, SAM - ! and GFDL. - !####################################################################### - !####################################################################### - subroutine pdf_closure & - ( p_in_Pa, exner, thv_ds, wm, & - wp2, wp3, sigma_sqd_w, & - Skw, rtm, rtp2, & - wprtp, thlm, thlp2, & - wpthlp, rtpthlp, sclrm, & - wpsclrp, sclrp2, sclrprtp, & - sclrpthlp, level, & -#ifdef GFDL - RH_crit, do_liquid_only_in_clubb,& ! h1g, 2010-06-15 -#endif - wp4, wprtp2, wp2rtp, & - wpthlp2, wp2thlp, wprtpthlp, & - cloud_frac, ice_supersat_frac, & - rcm, wpthvp, wp2thvp, rtpthvp, & - thlpthvp, wprcp, wp2rcp, rtprcp, & - thlprcp, rcp2, pdf_params, & - err_code, & - wpsclrprtp, wpsclrp2, sclrpthvp, & - wpsclrpthlp, sclrprcp, wp2sclrp, & - rc_coef ) - - -! Description: -! Subroutine that computes pdf parameters analytically. - -! Based of the original formulation, but with some tweaks -! to remove some of the less realistic assumptions and -! improve transport terms. - -! Corrected version that should remove inconsistency - -! References: -! Eqn. 29, 30, 31, 32 & 33 on p. 3547 of -! ``A PDF-Based Model for Boundary Layer Clouds. Part I: -! Method and Model Description'' Golaz, et al. (2002) -! JAS, Vol. 59, pp. 3540--3551. -!------------------------------------------------------------------------ - - use crmx_constants_clubb, only: & - ! Constants - sqrt_2pi, & ! sqrt(2*pi) - sqrt_2, & ! sqrt(2) - pi, & ! The ratio of radii to their circumference - two, & ! 2 - zero, & ! 0 - Cp, & ! Dry air specific heat at constant p [J/kg/K] - Lv, & ! Latent heat of vaporization [J/kg] - Rd, & ! Dry air gas constant [J/kg/K] - Rv, & ! Water vapor gas constant [J/kg/K] - ep, & ! Rd / Rv; ep = 0.622 [-] - ep1, & ! (1.0-ep)/ep; ep1 = 0.61 [-] - ep2, & ! 1.0/ep; ep2 = 1.61 [-] - w_tol_sqd, & ! Tolerance for w'^2 [m^2/s^2] - rt_tol, & ! Tolerance for r_t [kg/kg] - thl_tol, & ! Tolerance for th_l [K] - s_mellor_tol, & ! Tolerance for pdf parameter s [kg/kg] - T_freeze_K, & ! Freezing point of water [K] - fstderr, & - zero_threshold - - use crmx_parameters_model, only: & - sclr_tol, & ! Array of passive scalar tolerances [units vary] - sclr_dim, & ! Number of passive scalar variables - mixt_frac_max_mag ! Maximum values for PDF parameter 'mixt_frac' - - use crmx_parameters_tunable, only: & - beta ! Variable(s) - ! Plume widths for th_l and r_t [-] - - use crmx_pdf_parameter_module, only: & - pdf_parameter ! type - - use crmx_anl_erf, only: & - erf ! Procedure(s) - ! The error function - - use crmx_numerical_check, only: & - pdf_closure_check ! Procedure(s) - - use crmx_saturation, only: & - sat_mixrat_liq, & ! Procedure(s) - sat_mixrat_ice - - use crmx_error_code, only: & - clubb_no_error ! Constant(s) - - use crmx_error_code, only: & - clubb_at_least_debug_level, & ! Procedure(s) - fatal_error - - use crmx_stats_variables, only: & - iwp4, & ! Variables - ircp2, & - iwprtp2, & - iwprtpthlp, & - iwpthlp2 - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - -#ifdef sam1mom - use crmx_micro_params, only: tbgmin, tbgmax -#endif - - implicit none - - intrinsic :: sqrt, exp, min, max, abs, present - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - p_in_Pa, & ! Pressure [Pa] - exner, & ! Exner function [-] - thv_ds, & ! Dry, base-state theta_v (ref. th_l here) [K] - wm, & ! mean w-wind component (vertical velocity) [m/s] - wp2, & ! w'^2 [m^2/s^2] - wp3, & ! w'^3 [m^3/s^3] - sigma_sqd_w, & ! Width of individual w plumes [-] - Skw, & ! Skewness of w [-] - rtm, & ! Mean total water mixing ratio [kg/kg] - rtp2, & ! r_t'^2 [(kg/kg)^2] - wprtp, & ! w'r_t' [(kg/kg)(m/s)] - thlm, & ! Mean liquid water potential temperature [K] - thlp2, & ! th_l'^2 [K^2] - wpthlp, & ! w'th_l' [K(m/s)] - rtpthlp ! r_t'th_l' [K(kg/kg)] - - real( kind = core_rknd ), dimension(sclr_dim), intent(in) :: & - sclrm, & ! Mean passive scalar [units vary] - wpsclrp, & ! w' sclr' [units vary] - sclrp2, & ! sclr'^2 [units vary] - sclrprtp, & ! sclr' r_t' [units vary] - sclrpthlp ! sclr' th_l' [units vary] - -#ifdef GFDL - ! critial relative humidity for nucleation - real( kind = core_rknd ), dimension( min(1,sclr_dim), 2 ), intent(in) :: & ! h1g, 2010-06-15 - RH_crit ! critical relative humidity for droplet and ice nucleation -! ---> h1g, 2012-06-14 - logical, intent(in) :: do_liquid_only_in_clubb -! <--- h1g, 2012-06-14 -#endif - - integer, intent(in) :: & - level ! Thermodynamic level for which calculations are taking place. - - ! Output Variables - - real( kind = core_rknd ), intent(out) :: & - wp4, & ! w'^4 [m^4/s^4] - wprtp2, & ! w' r_t' [(m kg)/(s kg)] - wp2rtp, & ! w'^2 r_t' [(m^2 kg)/(s^2 kg)] - wpthlp2, & ! w' th_l'^2 [(m K^2)/s] - wp2thlp, & ! w'^2 th_l' [(m^2 K)/s^2] - cloud_frac, & ! Cloud fraction [-] - ice_supersat_frac, & ! Ice cloud fracion [-] - rcm, & ! Mean liquid water [kg/kg] - wpthvp, & ! Buoyancy flux [(K m)/s] - wp2thvp, & ! w'^2 th_v' [(m^2 K)/s^2] - rtpthvp, & ! r_t' th_v' [(kg K)/kg] - thlpthvp, & ! th_l' th_v' [K^2] - wprcp, & ! w' r_c' [(m kg)/(s kg)] - wp2rcp, & ! w'^2 r_c' [(m^2 kg)/(s^2 kg)] - rtprcp, & ! r_t' r_c' [(kg^2)/(kg^2)] - thlprcp, & ! th_l' r_c' [(K kg)/kg] - rcp2, & ! r_c'^2 [(kg^2)/(kg^2)] - wprtpthlp ! w' r_t' th_l' [(m kg K)/(s kg)] - - type(pdf_parameter), intent(out) :: & - pdf_params ! pdf paramters [units vary] - - integer, intent(out) :: & - err_code ! Are the outputs usable numbers? - - ! Output (passive scalar variables) - - real( kind = core_rknd ), intent(out), dimension(sclr_dim) :: & - sclrpthvp, & - sclrprcp, & - wpsclrp2, & - wpsclrprtp, & - wpsclrpthlp, & - wp2sclrp - - ! Local Variables - - real( kind = core_rknd ) :: & - w1_n, w2_n -! thl1_n, thl2_n, -! rt1_n, rt2_n - - ! Variables that are stored in derived data type pdf_params. - real( kind = core_rknd ) :: & - w1, & ! Mean of w (1st PDF component) [m/s] - w2, & ! Mean of w (2nd PDF component) [m/s] - varnce_w1, & ! Variance of w (1st PDF component) [m^2/s^2] - varnce_w2, & ! Variance of w (2nd PDF component) [m^2/s^2] - rt1, & ! Mean of r_t (1st PDF component) [kg/kg] - rt2, & ! Mean of r_t (2nd PDF component) [kg/kg] - varnce_rt1, & ! Variance of r_t (1st PDF component) [kg^2/kg^2] - varnce_rt2, & ! Variance of r_t (2nd PDF component) [kg^2/kg^2] - thl1, & ! Mean of th_l (1st PDF component) [K] - thl2, & ! Mean of th_l (2nd PDF component) [K] - varnce_thl1, & ! Variance of th_l (1st PDF component) [K^2] - varnce_thl2, & ! Variance of th_l (2nd PDF component) [K^2] - rrtthl, & ! Correlation between r_t and th_l (both components) [-] - alpha_thl, & ! Factor relating to normalized variance for th_l [-] - alpha_rt, & ! Factor relating to normalized variance for r_t [-] - crt1, & ! Coef. on r_t in s/t eqns. (1st PDF comp.) [-] - crt2, & ! Coef. on r_t in s/t eqns. (2nd PDF comp.) [-] - cthl1, & ! Coef. on th_l in s/t eqns. (1st PDF comp.) [(kg/kg)/K] - cthl2 ! Coef. on th_l in s/t eqns. (2nd PDF comp.) [(kg/kg)/K] - - real( kind = core_rknd ) :: & - s1, & ! Mean of s (1st PDF component) [kg/kg] - s2, & ! Mean of s (2nd PDF component) [kg/kg] - stdev_s1, & ! Standard deviation of s (1st PDF component) [kg/kg] - stdev_s2, & ! Standard deviation of s (2nd PDF component) [kg/kg] - stdev_t1, & ! Standard deviation of t (1st PDF component) [kg/kg] - stdev_t2, & ! Standard deviation of t (2nd PDF component) [kg/kg] - covar_st_1, & ! Covariance of s and t (1st PDF component) [kg^2/kg^2] - covar_st_2, & ! Covariance of s and t (2nd PDF component) [kg^2/kg^2] - corr_st_1, & ! Correlation between s and t (1st PDF component) [-] - corr_st_2, & ! Correlation between s and t (2nd PDF component) [-] - rsl1, & ! Mean of r_sl (1st PDF component) [kg/kg] - rsl2, & ! Mean of r_sl (2nd PDF component) [kg/kg] - rc1, & ! Mean of r_c (1st PDF component) [kg/kg] - rc2, & ! Mean of r_c (2nd PDF component) [kg/kg] - cloud_frac1, & ! Cloud fraction (1st PDF component) [-] - cloud_frac2, & ! Cloud fraction (2nd PDF component) [-] - mixt_frac ! Weight of 1st PDF component (Sk_w dependent) [-] - - ! Note: alpha coefficients = 0.5 * ( 1 - correlations^2 ). - ! These are used to calculate the scalar widths - ! varnce_thl1, varnce_thl2, varnce_rt1, and varnce_rt2 as in Eq. (34) of - ! Larson and Golaz (2005) - - ! Passive scalar local variables - - real( kind = core_rknd ), dimension(sclr_dim) :: & - sclr1, sclr2, & - varnce_sclr1, varnce_sclr2, & - alpha_sclr, & - rsclrthl, rsclrrt -! sclr1_n, sclr2_n, - - logical :: & - l_scalar_calc, & ! True if sclr_dim > 0 - l_calc_ice_supersat_frac ! True if we should calculate ice_supersat_frac - - ! Quantities needed to predict higher order moments - real( kind = core_rknd ) :: & - tl1, tl2, & - beta1, beta2 - - real( kind = core_rknd ) :: sqrt_wp2 - - ! Thermodynamic quantity - - real( kind = core_rknd ), intent(out) :: rc_coef - - ! variables for a generalization of Chris Golaz' closure - ! varies width of plumes in theta_l, rt - real( kind = core_rknd ) :: width_factor_1, width_factor_2 - - ! variables for computing ice cloud fraction - real( kind = core_rknd) :: & - ice_supersat_frac1, & ! first pdf component of ice_supersat_frac - ice_supersat_frac2, & ! second pdf component of ice_supersat_frac - rt_at_ice_sat1, rt_at_ice_sat2, & - s_at_ice_sat1, s_at_ice_sat2 - - - real( kind = core_rknd ), parameter :: & - s_at_liq_sat = 0.0_core_rknd ! Always zero - - integer :: i ! Index - -#ifdef GFDL - real ( kind = core_rknd ), parameter :: t1_combined = 273.16, & - t2_combined = 268.16, & - t3_combined = 238.16 -#endif -#ifdef sam1mom - real ( kind = core_rknd ), parameter :: t1_combined = tbgmax, & - t2_combined = tbgmin -#endif - -!------------------------ Code Begins ---------------------------------- - - ! Check whether the passive scalars are present. - - if ( sclr_dim > 0 ) then - l_scalar_calc = .true. - else - l_scalar_calc = .false. - end if - - err_code = clubb_no_error ! Initialize to the value for no errors - - ! If there is no velocity, then use single delta fnc. as pdf - ! Otherwise width parameters (e.g. varnce_w1, varnce_w2, etc.) are non-zero. - if ( wp2 <= w_tol_sqd ) then - - mixt_frac = 0.5_core_rknd - w1 = wm - w2 = wm - varnce_w1 = 0._core_rknd - varnce_w2 = 0._core_rknd - rt1 = rtm - rt2 = rtm - alpha_rt = 0.5_core_rknd - varnce_rt1 = 0._core_rknd - varnce_rt2 = 0._core_rknd - thl1 = thlm - thl2 = thlm - alpha_thl = 0.5_core_rknd - varnce_thl1 = 0._core_rknd - varnce_thl2 = 0._core_rknd - rrtthl = 0._core_rknd - - if ( l_scalar_calc ) then - do i = 1, sclr_dim, 1 - sclr1(i) = sclrm(i) - sclr2(i) = sclrm(i) - varnce_sclr1(i) = 0.0_core_rknd - varnce_sclr2(i) = 0.0_core_rknd - alpha_sclr(i) = 0.5_core_rknd - rsclrrt(i) = 0.0_core_rknd - rsclrthl(i) = 0.0_core_rknd - end do ! 1..sclr_dim - end if - - else ! Width (standard deviation) parameters are non-zero - - ! The variable "mixt_frac" is the weight of Gaussian "plume" 1. The weight of - ! Gaussian "plume" 2 is "1-mixt_frac". If there isn't any skewness of w - ! (Sk_w = 0 because w'^3 = 0), mixt_frac = 0.5, and both Gaussian "plumes" are - ! equally weighted. If there is positive skewness of w (Sk_w > 0 because - ! w'^3 > 0), 0 < mixt_frac < 0.5, and Gaussian "plume" 2 has greater weight than - ! does Gaussian "plume" 1. If there is negative skewness of w (Sk_w < 0 - ! because w'^3 < 0), 0.5 < mixt_frac < 1, and Gaussian "plume" 1 has greater - ! weight than does Gaussian "plume" 2. - if ( abs( Skw ) <= 1e-5_core_rknd ) then - mixt_frac = 0.5_core_rknd - else - mixt_frac = 0.5_core_rknd * ( 1.0_core_rknd - Skw/ & - sqrt( 4.0_core_rknd*( 1.0_core_rknd - sigma_sqd_w )**3 + Skw**2 ) ) - endif - - ! Determine sqrt( wp2 ) here to avoid re-computing it - sqrt_wp2 = sqrt( wp2 ) - - ! Clip mixt_frac, 1-mixt_frac, to avoid dividing by zero - ! Formula for mixt_frac_max_mag = - ! 1 - ( 1/2 * ( 1 - Skw_max/sqrt( 4*( 1 - sigma_sqd_w )^3 + Skw_max^2 ) ) ) - ! Where sigma_sqd_w is fixed at 0.4_core_rknd - mixt_frac = min( max( mixt_frac, 1.0_core_rknd-mixt_frac_max_mag ), mixt_frac_max_mag ) - - ! The normalized mean of w for Gaussian "plume" 1 is w1_n. It's value - ! will always be greater than 0. As an example, a value of 1.0 would - ! indicate that the actual mean of w for Gaussian "plume" 1 is found - ! 1.0 standard deviation above the overall mean for w. - w1_n = sqrt( ( (1._core_rknd-mixt_frac)/mixt_frac )*(1._core_rknd-sigma_sqd_w) ) - ! The normalized mean of w for Gaussian "plume" 2 is w2_n. It's value - ! will always be less than 0. As an example, a value of -0.5 would - ! indicate that the actual mean of w for Gaussian "plume" 2 is found - ! 0.5 standard deviations below the overall mean for w. - w2_n = -sqrt( ( mixt_frac/(1._core_rknd-mixt_frac) )*(1._core_rknd-sigma_sqd_w) ) - ! The mean of w for Gaussian "plume" 1 is w1. - w1 = wm + sqrt_wp2*w1_n - ! The mean of w for Gaussian "plume" 2 is w2. - w2 = wm + sqrt_wp2*w2_n - - ! The variance of w for Gaussian "plume" 1 for varnce_w1. - varnce_w1 = sigma_sqd_w*wp2 - ! The variance of w for Gaussian "plume" 2 for varnce_w2. - ! The variance in both Gaussian "plumes" is defined to be the same. - varnce_w2 = sigma_sqd_w*wp2 - - - ! The normalized variance for thl, rt, and sclr for "plume" 1 is: - ! - ! { 1 - [1/(1-sigma_sqd_w)]*[ (w'x')^2 / (w'^2 * x'^2) ] / mixt_frac } - ! * { (1/3)*beta + mixt_frac*( 1 - (2/3)*beta ) }; - ! - ! where "x" stands for thl, rt, or sclr; "mixt_frac" is the weight of Gaussian - ! "plume" 1, and 0 <= beta <= 3. - ! - ! The factor { (1/3)*beta + mixt_frac*( 1 - (2/3)*beta ) } does not depend on - ! which varable "x" stands for. The factor is multiplied by 2 and defined - ! as width_factor_1. - ! - ! The factor { 1 - [1/(1-sigma_sqd_w)]*[ (w'x')^2 / (w'^2 * x'^2) ] / mixt_frac } - ! depends on which variable "x" stands for. It is multiplied by 0.5_core_rknd and - ! defined as alpha_x, where "x" stands for thl, rt, or sclr. - - ! Vince Larson added a dimensionless factor so that the - ! width of plumes in theta_l, rt can vary. - ! beta is a constant defined in module parameters_tunable - ! Set 0 0._core_rknd .and. & - varnce_rt2*varnce_thl2 > 0._core_rknd ) then - rrtthl = ( rtpthlp - mixt_frac * ( rt1-rtm ) * ( thl1-thlm ) & - - (1._core_rknd-mixt_frac) * ( rt2-rtm ) * ( thl2-thlm ) ) & - / ( mixt_frac*sqrt( varnce_rt1*varnce_thl1 ) & - + (1._core_rknd-mixt_frac)*sqrt( varnce_rt2*varnce_thl2 ) ) - if ( rrtthl < -1.0_core_rknd ) then - rrtthl = -1.0_core_rknd - end if - if ( rrtthl > 1.0_core_rknd ) then - rrtthl = 1.0_core_rknd - end if - else - rrtthl = 0.0_core_rknd - end if ! varnce_rt1*varnce_thl1 > 0 .and. varnce_rt2*varnce_thl2 > 0 - - ! Sub-plume correlation, rsclrthl, between passive scalar and theta_l. - if ( l_scalar_calc ) then - do i=1, sclr_dim - if ( varnce_sclr1(i)*varnce_thl1 > 0._core_rknd .and. & - varnce_sclr2(i)*varnce_thl2 > 0._core_rknd ) then - rsclrthl(i) = ( sclrpthlp(i) & - - mixt_frac * ( sclr1(i)-sclrm(i) ) * ( thl1-thlm ) & - - (1._core_rknd-mixt_frac) * ( sclr2(i)-sclrm(i) ) * ( thl2-thlm ) ) & - / ( mixt_frac*sqrt( varnce_sclr1(i)*varnce_thl1 ) & - + (1._core_rknd-mixt_frac)*sqrt( varnce_sclr2(i)*varnce_thl2 ) ) - if ( rsclrthl(i) < -1.0_core_rknd ) then - rsclrthl(i) = -1.0_core_rknd - end if - if ( rsclrthl(i) > 1.0_core_rknd ) then - rsclrthl(i) = 1.0_core_rknd - end if - else - rsclrthl(i) = 0.0_core_rknd - end if - - ! Sub-plume correlation, rsclrrt, between passive scalar - ! and total water. - - if ( varnce_sclr1(i)*varnce_rt1 > 0._core_rknd .and. & - varnce_sclr2(i)*varnce_rt2 > 0._core_rknd ) then - rsclrrt(i) = ( sclrprtp(i) - mixt_frac * ( sclr1(i)-sclrm(i) ) * ( rt1-rtm )& - - (1._core_rknd-mixt_frac) * ( sclr2(i)-sclrm(i) ) * ( rt2-rtm ) ) & - / ( mixt_frac*sqrt( varnce_sclr1(i)*varnce_rt1 ) & - + (1._core_rknd-mixt_frac)*sqrt( varnce_sclr2(i)*varnce_rt2 ) ) - if ( rsclrrt(i) < -1.0_core_rknd ) then - rsclrrt(i) = -1.0_core_rknd - end if - if ( rsclrrt(i) > 1.0_core_rknd ) then - rsclrrt(i) = 1.0_core_rknd - end if - else - rsclrrt(i) = 0.0_core_rknd - end if - end do ! i=1, sclr_dim - end if ! l_scalar_calc - - end if ! Widths non-zero - - ! Compute higher order moments (these are interactive) - wp2rtp = mixt_frac * ( (w1-wm)**2+varnce_w1 ) * ( rt1-rtm ) & - + (1._core_rknd-mixt_frac) * ( (w2-wm)**2+varnce_w2 ) * ( rt2-rtm ) - - wp2thlp = mixt_frac * ( (w1-wm)**2+varnce_w1 ) * ( thl1-thlm ) & - + (1._core_rknd-mixt_frac) * ( (w2-wm)**2+varnce_w2 ) * ( thl2-thlm ) - - ! Compute higher order moments (these are non-interactive diagnostics) - if ( iwp4 > 0 ) then - wp4 = mixt_frac * ( 3._core_rknd*varnce_w1**2 + & - 6._core_rknd*((w1-wm)**2)*varnce_w1 + (w1-wm)**4 ) & - + (1._core_rknd-mixt_frac) * ( 3._core_rknd*varnce_w2**2 + & - 6._core_rknd*((w2-wm)**2)*varnce_w2 + (w2-wm)**4 ) - end if - - if ( iwprtp2 > 0 ) then - wprtp2 = mixt_frac * ( w1-wm )*( (rt1-rtm)**2 + varnce_rt1 ) & - + (1._core_rknd-mixt_frac) * ( w2-wm )*( (rt2-rtm)**2 + varnce_rt2) - end if - - if ( iwpthlp2 > 0 ) then - wpthlp2 = mixt_frac * ( w1-wm )*( (thl1-thlm)**2 + varnce_thl1 ) & - + (1._core_rknd-mixt_frac) * ( w2-wm )*( (thl2-thlm)**2+varnce_thl2 ) - end if - - if ( iwprtpthlp > 0 ) then - wprtpthlp = mixt_frac * ( w1-wm )*( (rt1-rtm)*(thl1-thlm) & - + rrtthl*sqrt( varnce_rt1*varnce_thl1 ) ) & - + ( 1._core_rknd-mixt_frac ) * ( w2-wm )*( (rt2-rtm)*(thl2-thlm) & - + rrtthl*sqrt( varnce_rt2*varnce_thl2 ) ) - end if - - - ! Scalar Addition to higher order moments - if ( l_scalar_calc ) then - do i=1, sclr_dim - - wp2sclrp(i) = mixt_frac * ( (w1-wm)**2+varnce_w1 )*( sclr1(i)-sclrm(i) ) & - + (1._core_rknd-mixt_frac) * ( (w2-wm)**2+varnce_w2 ) * ( sclr2(i)-sclrm(i) ) - - wpsclrp2(i) = mixt_frac * ( w1-wm ) * ( (sclr1(i)-sclrm(i))**2 + varnce_sclr1(i) ) & - + (1._core_rknd-mixt_frac) * ( w2-wm ) * & - ( (sclr2(i)-sclrm(i))**2 + varnce_sclr2(i) ) - - wpsclrprtp(i) = mixt_frac * ( w1-wm ) * ( ( rt1-rtm )*( sclr1(i)-sclrm(i) ) & - + rsclrrt(i)*sqrt( varnce_rt1*varnce_sclr1(i) ) ) & - + ( 1._core_rknd-mixt_frac )*( w2-wm ) * & - ( ( rt2-rtm )*( sclr2(i)-sclrm(i) ) + rsclrrt(i)*sqrt( varnce_rt2*varnce_sclr2(i) ) ) - - wpsclrpthlp(i) = mixt_frac * ( w1-wm ) * ( ( sclr1(i)-sclrm(i) )*( thl1-thlm ) & - + rsclrthl(i)*sqrt( varnce_sclr1(i)*varnce_thl1 ) ) & - + ( 1._core_rknd-mixt_frac ) * ( w2-wm ) * & - ( ( sclr2(i)-sclrm(i) )*( thl2-thlm ) & - + rsclrthl(i)*sqrt( varnce_sclr2(i)*varnce_thl2 ) ) - - end do ! i=1, sclr_dim - end if ! l_scalar_calc - - ! Compute higher order moments that include theta_v. - - ! First compute some preliminary quantities. - ! "1" denotes first Gaussian; "2" denotes 2nd Gaussian - ! liq water temp (Sommeria & Deardorff 1977 (SD), eqn. 3) - - tl1 = thl1*exner - tl2 = thl2*exner - -#ifdef GFDL - if( sclr_dim > 0 .and. (.not. do_liquid_only_in_clubb) ) then ! h1g, 2010-06-16 begin mod - - if( tl1 > t1_combined ) then - rsl1 = sat_mixrat_liq( p_in_Pa, tl1 ) - elseif( tl1 > t2_combined ) then - rsl1 = sat_mixrat_liq( p_in_Pa, tl1 ) * (tl1 - t2_combined)/(t1_combined - t2_combined) & - + sat_mixrat_ice( p_in_Pa, tl1 ) * (t1_combined - tl1)/(t1_combined - t2_combined) - elseif( tl1 > t3_combined ) then - rsl1 = sat_mixrat_ice( p_in_Pa, tl1 ) & - + sat_mixrat_ice( p_in_Pa, tl1 ) * (RH_crit(1, 1) -1._core_rknd ) & - * ( t2_combined -tl1)/(t2_combined - t3_combined) - else - rsl1 = sat_mixrat_ice( p_in_Pa, tl1 ) * RH_crit(1, 1) - endif - - if( tl2 > t1_combined ) then - rsl2 = sat_mixrat_liq( p_in_Pa, tl2 ) - elseif( tl2 > t2_combined ) then - rsl2 = sat_mixrat_liq( p_in_Pa, tl2 ) * (tl2 - t2_combined)/(t1_combined - t2_combined) & - + sat_mixrat_ice( p_in_Pa, tl2 ) * (t1_combined - tl2)/(t1_combined - t2_combined) - elseif( tl2 > t3_combined ) then - rsl2 = sat_mixrat_ice( p_in_Pa, tl2 ) & - + sat_mixrat_ice( p_in_Pa, tl2 )* (RH_crit(1, 2) -1._core_rknd) & - * ( t2_combined -tl2)/(t2_combined - t3_combined) - else - rsl2 = sat_mixrat_ice( p_in_Pa, tl2 ) * RH_crit(1, 2) - endif - - else !sclr_dim <= 0 or do_liquid_only_in_clubb = .T. - rsl1 = sat_mixrat_liq( p_in_Pa, tl1 ) - rsl2 = sat_mixrat_liq( p_in_Pa, tl2 ) - - endif !sclr_dim > 0 - -#elif sam1mom -! For sinlge moment microphysics in SAM_CLUBB - if(tl1 > t1_combined) then - rsl1 = sat_mixrat_liq( p_in_Pa, tl1 ) - else if (tl1 < t2_combined) then - rsl1 = sat_mixrat_ice( p_in_Pa, tl1 ) - else - rsl1 = sat_mixrat_liq( p_in_Pa, tl1 ) * (tl1-t2_combined)/(t1_combined-t2_combined) & - + sat_mixrat_ice( p_in_Pa, tl1 ) * (t1_combined-tl1)/(t1_combined-t2_combined) - endif - if(tl2 > t1_combined) then - rsl2 = sat_mixrat_liq( p_in_Pa, tl2 ) - else if (tl2 < t2_combined) then - rsl2 = sat_mixrat_ice( p_in_Pa, tl2 ) - else - rsl2 = sat_mixrat_liq( p_in_Pa, tl2 ) * (tl2-t2_combined)/(t1_combined-t2_combined) & - + sat_mixrat_ice( p_in_Pa, tl2 ) * (t1_combined-tl2)/(t1_combined-t2_combined) - endif -#else - rsl1 = sat_mixrat_liq( p_in_Pa, tl1 ) - rsl2 = sat_mixrat_liq( p_in_Pa, tl2 ) ! h1g, 2010-06-16 end mod -#endif - - ! SD's beta (eqn. 8) - beta1 = ep * ( Lv/(Rd*tl1) ) * ( Lv/(Cp*tl1) ) - beta2 = ep * ( Lv/(Rd*tl2) ) * ( Lv/(Cp*tl2) ) - - ! s from Lewellen and Yoh 1993 (LY) eqn. 1 - s1 = ( rt1 - rsl1 ) / ( 1._core_rknd + beta1 * rsl1 ) - s2 = ( rt2 - rsl2 ) / ( 1._core_rknd + beta2 * rsl2 ) - - ! Coefficients for s' - ! For each normal distribution in the sum of two normal distributions, - ! s' = crt * rt' + cthl * thl'; - ! therefore, x's' = crt * x'rt' + cthl * x'thl'. - ! Larson et al. May, 2001. - - crt1 = 1._core_rknd/( 1._core_rknd + beta1*rsl1) - crt2 = 1._core_rknd/( 1._core_rknd + beta2*rsl2) - - cthl1 = ( (1._core_rknd + beta1 * rt1) / ( 1._core_rknd + beta1*rsl1)**2 ) & - * ( Cp/Lv ) * beta1 * rsl1 * exner - cthl2 = ( (1._core_rknd + beta2 * rt2) / ( 1._core_rknd + beta2*rsl2 )**2 ) & - * ( Cp/Lv ) * beta2 * rsl2 * exner - - ! Standard deviation of s for each component. - ! Include subplume correlation of qt, thl - ! Because of round-off error, - ! stdev_s1 (and probably stdev_s2) can become negative when rrtthl=1 - ! One could also write this as a squared term - ! plus a postive correction; this might be a neater format - stdev_s1 = sqrt( max( crt1**2 * varnce_rt1 & - - two * rrtthl * crt1 * cthl1 & - * sqrt( varnce_rt1 * varnce_thl1 ) & - + cthl1**2 * varnce_thl1, & - zero_threshold ) ) - - stdev_s2 = sqrt( max( crt2**2 * varnce_rt2 & - - two * rrtthl * crt2 * cthl2 & - * sqrt( varnce_rt2 * varnce_thl2 ) & - + cthl2**2 * varnce_thl2, & - zero_threshold ) ) - - ! Standard deviation of t for each component. - stdev_t1 = sqrt( max( crt1**2 * varnce_rt1 & - + two * rrtthl * crt1 * cthl1 & - * sqrt( varnce_rt1 * varnce_thl1 ) & - + cthl1**2 * varnce_thl1, & - zero_threshold ) ) - - stdev_t2 = sqrt( max( crt2**2 * varnce_rt2 & - + two * rrtthl * crt2 * cthl2 & - * sqrt( varnce_rt2 * varnce_thl2 ) & - + cthl2**2 * varnce_thl2, & - zero_threshold ) ) - - ! Covariance of s and t for each component. - covar_st_1 = crt1**2 * varnce_rt1 - cthl1**2 * varnce_thl1 - - covar_st_2 = crt2**2 * varnce_rt2 - cthl2**2 * varnce_thl2 - - ! Correlation between s and t for each component. - if ( stdev_s1 * stdev_t1 > zero ) then - corr_st_1 = covar_st_1 / ( stdev_s1 * stdev_t1 ) - else - corr_st_1 = zero - endif - - if ( stdev_s2 * stdev_t2 > zero ) then - corr_st_2 = covar_st_2 / ( stdev_s2 * stdev_t2 ) - else - corr_st_2 = zero - endif - - ! Determine whether to compute ice_supersat_frac. We do not compute - ! ice_supersat_frac for GFDL (unless do_liquid_only_in_clubb is true), - ! because liquid and ice are both fed into rtm, ruining the calculation. -#ifdef GFDL - if (do_liquid_only_in_clubb) then - l_calc_ice_supersat_frac = .true. - else - l_calc_ice_supersat_frac = .false. - end if -#elif sam1mom - l_calc_ice_supersat_frac = .false. -#else - l_calc_ice_supersat_frac = .true. -#endif - - ! We need to introduce a threshold value for the variance of s - - ! Calculate cloud_frac1 and rc1 - call calc_cloud_frac_component(s1, stdev_s1, s_at_liq_sat, cloud_frac1, rc1) - - ! Calculate cloud_frac2 and rc2 - call calc_cloud_frac_component(s2, stdev_s2, s_at_liq_sat, cloud_frac2, rc2) - - if (l_calc_ice_supersat_frac) then - ! We must compute s_at_ice_sat1 and s_at_ice_sat2 - if (tl1 <= T_freeze_K) then - rt_at_ice_sat1 = sat_mixrat_ice( p_in_Pa, tl1 ) - s_at_ice_sat1 = ( rt_at_ice_sat1 - rsl1 ) / ( 1._core_rknd + beta1 * rsl1 ) - else - ! If the temperature is warmer than freezing (> 0C) then ice_supersat_frac - ! is not defined, so we use s_at_liq_sat - s_at_ice_sat1 = s_at_liq_sat - end if - - if (tl2 <= T_freeze_K) then - rt_at_ice_sat2 = sat_mixrat_ice( p_in_Pa, tl2 ) - s_at_ice_sat2 = ( rt_at_ice_sat2 - rsl2 ) / ( 1._core_rknd + beta2 * rsl2 ) - else - ! If the temperature is warmer than freezing (> 0C) then ice_supersat_frac - ! is not defined, so we use s_at_liq_sat - s_at_ice_sat2 = s_at_liq_sat - end if - - ! Calculate ice_supersat_frac1 - call calc_cloud_frac_component(s1, stdev_s1, s_at_ice_sat1, ice_supersat_frac1) - - ! Calculate ice_supersat_frac2 - call calc_cloud_frac_component(s2, stdev_s2, s_at_ice_sat2, ice_supersat_frac2) - end if - - ! Compute moments that depend on theta_v - ! - ! The moments that depend on th_v' are calculated based on an approximated - ! and linearized form of the theta_v equation: - ! - ! theta_v = theta_l + { (R_v/R_d) - 1 } * thv_ds * r_t - ! + [ {L_v/(C_p*exner)} - (R_v/R_d) * thv_ds ] * r_c; - ! - ! and therefore: - ! - ! th_v' = th_l' + { (R_v/R_d) - 1 } * thv_ds * r_t' - ! + [ {L_v/(C_p*exner)} - (R_v/R_d) * thv_ds ] * r_c'; - ! - ! where thv_ds is used as a reference value to approximate theta_l. - - rc_coef = Lv / (exner*Cp) - ep2 * thv_ds - - wp2rcp = mixt_frac * ((w1-wm)**2 + varnce_w1)*rc1 & - + (1._core_rknd-mixt_frac) * ((w2-wm)**2 + varnce_w2)*rc2 & - - wp2 * (mixt_frac*rc1+(1._core_rknd-mixt_frac)*rc2) - - wp2thvp = wp2thlp + ep1*thv_ds*wp2rtp + rc_coef*wp2rcp - - wprcp = mixt_frac * (w1-wm)*rc1 + (1._core_rknd-mixt_frac) * (w2-wm)*rc2 - - wpthvp = wpthlp + ep1*thv_ds*wprtp + rc_coef*wprcp - - ! Account for subplume correlation in qt-thl - thlprcp = mixt_frac * ( (thl1-thlm)*rc1 - (cthl1*varnce_thl1)*cloud_frac1 ) & - + (1._core_rknd-mixt_frac) * ( (thl2-thlm)*rc2 - (cthl2*varnce_thl2)*cloud_frac2 ) & - + mixt_frac*rrtthl*crt1*sqrt( varnce_rt1*varnce_thl1 )*cloud_frac1 & - + (1._core_rknd-mixt_frac)*rrtthl*crt2*sqrt( varnce_rt2*varnce_thl2 )*cloud_frac2 - thlpthvp = thlp2 + ep1*thv_ds*rtpthlp + rc_coef*thlprcp - - ! Account for subplume correlation in qt-thl - rtprcp = mixt_frac * ( (rt1-rtm)*rc1 + (crt1*varnce_rt1)*cloud_frac1 ) & - + (1._core_rknd-mixt_frac) * ( (rt2-rtm)*rc2 + (crt2*varnce_rt2)*cloud_frac2 ) & - - mixt_frac*rrtthl*cthl1*sqrt( varnce_rt1*varnce_thl1 )*cloud_frac1 & - - (1._core_rknd-mixt_frac)*rrtthl*cthl2*sqrt( varnce_rt2*varnce_thl2 )*cloud_frac2 - - rtpthvp = rtpthlp + ep1*thv_ds*rtp2 + rc_coef*rtprcp - - ! Account for subplume correlation between scalar, theta_v. - ! See Eqs. A13, A8 from Larson et al. (2002) ``Small-scale...'' - ! where the ``scalar'' in this paper is w. - if ( l_scalar_calc ) then - do i=1, sclr_dim - sclrprcp(i) & - = mixt_frac * ( ( sclr1(i)-sclrm(i) ) * rc1 ) & - + (1._core_rknd-mixt_frac) * ( ( sclr2(i)-sclrm(i) ) * rc2 ) & - + mixt_frac*rsclrrt(i) * crt1 & - * sqrt( varnce_sclr1(i) * varnce_rt1 ) * cloud_frac1 & - + (1._core_rknd-mixt_frac) * rsclrrt(i) * crt2 & - * sqrt( varnce_sclr2(i) * varnce_rt2 ) * cloud_frac2 & - - mixt_frac * rsclrthl(i) * cthl1 & - * sqrt( varnce_sclr1(i) * varnce_thl1 ) * cloud_frac1 & - - (1._core_rknd-mixt_frac) * rsclrthl(i) * cthl2 & - * sqrt( varnce_sclr2(i) * varnce_thl2 ) * cloud_frac2 - - sclrpthvp(i) = sclrpthlp(i) + ep1*thv_ds*sclrprtp(i) + rc_coef*sclrprcp(i) - end do ! i=1, sclr_dim - end if ! l_scalar_calc - - ! Compute mean cloud fraction and cloud water - cloud_frac = calc_cloud_frac(cloud_frac1, cloud_frac2, mixt_frac) - rcm = mixt_frac * rc1 + (1._core_rknd-mixt_frac) * rc2 - - rcm = max( zero_threshold, rcm ) - - if (l_calc_ice_supersat_frac) then - ! Compute ice cloud fraction, ice_supersat_frac - ice_supersat_frac = calc_cloud_frac(ice_supersat_frac1, ice_supersat_frac2, mixt_frac) - else - ! ice_supersat_frac will be garbage if computed as above - ice_supersat_frac = 0.0_core_rknd - if (clubb_at_least_debug_level( 1 )) then - write(fstderr,*) "Warning: ice_supersat_frac has garbage values if & - & do_liquid_only_in_clubb = .false." - end if - end if - ! Compute variance of liquid water mixing ratio. - ! This is not needed for closure. Statistical Analysis only. -#ifndef CLUBB_SAM ! in SAM, rcp2 is needed for Morrison microphysics - if ( ircp2 > 0 ) then -#endif - - rcp2 = mixt_frac * ( s1*rc1 + cloud_frac1*stdev_s1**2 ) & - + ( 1._core_rknd-mixt_frac ) * ( s2*rc2 + cloud_frac2*stdev_s2**2 ) - rcm**2 - rcp2 = max( zero_threshold, rcp2 ) - -#ifndef CLUBB_SAM ! in SAM, rcp2 is needed for Morrison microphysics - end if -#endif - - - ! Save PDF parameters - pdf_params%w1 = w1 - pdf_params%w2 = w2 - pdf_params%varnce_w1 = varnce_w1 - pdf_params%varnce_w2 = varnce_w2 - pdf_params%rt1 = rt1 - pdf_params%rt2 = rt2 - pdf_params%varnce_rt1 = varnce_rt1 - pdf_params%varnce_rt2 = varnce_rt2 - pdf_params%thl1 = thl1 - pdf_params%thl2 = thl2 - pdf_params%varnce_thl1 = varnce_thl1 - pdf_params%varnce_thl2 = varnce_thl2 - pdf_params%rrtthl = rrtthl - pdf_params%alpha_thl = alpha_thl - pdf_params%alpha_rt = alpha_rt - pdf_params%crt1 = crt1 - pdf_params%crt2 = crt2 - pdf_params%cthl1 = cthl1 - pdf_params%cthl2 = cthl2 - pdf_params%s1 = s1 - pdf_params%s2 = s2 - pdf_params%stdev_s1 = stdev_s1 - pdf_params%stdev_s2 = stdev_s2 - pdf_params%stdev_t1 = stdev_t1 - pdf_params%stdev_t2 = stdev_t2 - pdf_params%covar_st_1 = covar_st_1 - pdf_params%covar_st_2 = covar_st_2 - pdf_params%corr_st_1 = corr_st_1 - pdf_params%corr_st_2 = corr_st_2 - pdf_params%rsl1 = rsl1 - pdf_params%rsl2 = rsl2 - pdf_params%rc1 = rc1 - pdf_params%rc2 = rc2 - pdf_params%cloud_frac1 = cloud_frac1 - pdf_params%cloud_frac2 = cloud_frac2 - pdf_params%mixt_frac = mixt_frac - - - if ( clubb_at_least_debug_level( 2 ) ) then - - call pdf_closure_check & - ( wp4, wprtp2, wp2rtp, wpthlp2, & - wp2thlp, cloud_frac, rcm, wpthvp, wp2thvp, & - rtpthvp, thlpthvp, wprcp, wp2rcp, & - rtprcp, thlprcp, rcp2, wprtpthlp, & - crt1, crt2, cthl1, cthl2, pdf_params, & - err_code, & - sclrpthvp, sclrprcp, wpsclrp2, & - wpsclrprtp, wpsclrpthlp, wp2sclrp ) - - ! Error Reporting - ! Joshua Fasching February 2008 - - if ( fatal_error( err_code ) ) then - - write(fstderr,*) "Error in pdf_closure_new" - - write(fstderr,*) "Intent(in)" - - write(fstderr,*) "p_in_Pa = ", p_in_Pa - write(fstderr,*) "exner = ", exner - write(fstderr,*) "thv_ds = ", thv_ds - write(fstderr,*) "wm = ", wm - write(fstderr,*) "wp2 = ", wp2 - write(fstderr,*) "wp3 = ", wp3 - write(fstderr,*) "sigma_sqd_w = ", sigma_sqd_w - write(fstderr,*) "rtm = ", rtm - write(fstderr,*) "rtp2 = ", rtp2 - write(fstderr,*) "wprtp = ", wprtp - write(fstderr,*) "thlm = ", thlm - write(fstderr,*) "thlp2 = ", thlp2 - write(fstderr,*) "wpthlp = ", wpthlp - write(fstderr,*) "rtpthlp = ", rtpthlp - - if ( sclr_dim > 0 ) then - write(fstderr,*) "sclrm = ", sclrm - write(fstderr,*) "wpsclrp = ", wpsclrp - write(fstderr,*) "sclrp2 = ", sclrp2 - write(fstderr,*) "sclrprtp = ", sclrprtp - write(fstderr,*) "sclrpthlp = ", sclrpthlp - end if - - write(fstderr,*) "level = ", level - - write(fstderr,*) "Intent(out)" - - write(fstderr,*) "wp4 = ", wp4 - write(fstderr,*) "wprtp2 = ", wprtp2 - write(fstderr,*) "wp2rtp = ", wp2rtp - write(fstderr,*) "wpthlp2 = ", wpthlp2 - write(fstderr,*) "cloud_frac = ", cloud_frac - write(fstderr,*) "ice_supersat_frac = ", ice_supersat_frac - write(fstderr,*) "rcm = ", rcm - write(fstderr,*) "wpthvp = ", wpthvp - write(fstderr,*) "wp2thvp = ", wp2thvp - write(fstderr,*) "rtpthvp = ", rtpthvp - write(fstderr,*) "thlpthvp = ", thlpthvp - write(fstderr,*) "wprcp = ", wprcp - write(fstderr,*) "wp2rcp = ", wp2rcp - write(fstderr,*) "rtprcp = ", rtprcp - write(fstderr,*) "thlprcp = ", thlprcp - write(fstderr,*) "rcp2 = ", rcp2 - write(fstderr,*) "wprtpthlp = ", wprtpthlp - write(fstderr,*) "pdf_params%w1 = ", pdf_params%w1 - write(fstderr,*) "pdf_params%w2 = ", pdf_params%w2 - write(fstderr,*) "pdf_params%varnce_w1 = ", pdf_params%varnce_w1 - write(fstderr,*) "pdf_params%varnce_w2 = ", pdf_params%varnce_w2 - write(fstderr,*) "pdf_params%rt1 = ", pdf_params%rt1 - write(fstderr,*) "pdf_params%rt2 = ", pdf_params%rt2 - write(fstderr,*) "pdf_params%varnce_rt1 = ", pdf_params%varnce_rt1 - write(fstderr,*) "pdf_params%varnce_rt2 = ", pdf_params%varnce_rt2 - write(fstderr,*) "pdf_params%thl1 = ", pdf_params%thl1 - write(fstderr,*) "pdf_params%thl2 = ", pdf_params%thl2 - write(fstderr,*) "pdf_params%varnce_thl1 = ", pdf_params%varnce_thl1 - write(fstderr,*) "pdf_params%varnce_thl2 = ", pdf_params%varnce_thl2 - write(fstderr,*) "pdf_params%rrtthl = ", pdf_params%rrtthl - write(fstderr,*) "pdf_params%alpha_thl = ", pdf_params%alpha_thl - write(fstderr,*) "pdf_params%alpha_rt = ", pdf_params%alpha_rt - write(fstderr,*) "pdf_params%crt1 = ", pdf_params%crt1 - write(fstderr,*) "pdf_params%crt2 = ", pdf_params%crt2 - write(fstderr,*) "pdf_params%cthl1 = ", pdf_params%cthl1 - write(fstderr,*) "pdf_params%cthl2 = ", pdf_params%cthl2 - write(fstderr,*) "pdf_params%s1 = ", pdf_params%s1 - write(fstderr,*) "pdf_params%s2 = ", pdf_params%s2 - write(fstderr,*) "pdf_params%stdev_s1 = ", pdf_params%stdev_s1 - write(fstderr,*) "pdf_params%stdev_s2 = ", pdf_params%stdev_s2 - write(fstderr,*) "pdf_params%stdev_t1 = ", pdf_params%stdev_t1 - write(fstderr,*) "pdf_params%stdev_t2 = ", pdf_params%stdev_t2 - write(fstderr,*) "pdf_params%covar_st_1 = ", pdf_params%covar_st_1 - write(fstderr,*) "pdf_params%covar_st_2 = ", pdf_params%covar_st_2 - write(fstderr,*) "pdf_params%corr_st_1 = ", pdf_params%corr_st_1 - write(fstderr,*) "pdf_params%corr_st_2 = ", pdf_params%corr_st_2 - write(fstderr,*) "pdf_params%rsl1 = ", pdf_params%rsl1 - write(fstderr,*) "pdf_params%rsl2 = ", pdf_params%rsl2 - write(fstderr,*) "pdf_params%rc1 = ", pdf_params%rc1 - write(fstderr,*) "pdf_params%rc2 = ", pdf_params%rc2 - write(fstderr,*) "pdf_params%cloud_frac1 = ", pdf_params%cloud_frac1 - write(fstderr,*) "pdf_params%cloud_frac2 = ", pdf_params%cloud_frac2 - write(fstderr,*) "pdf_params%mixt_frac = ", pdf_params%mixt_frac - - if ( sclr_dim > 0 )then - write(fstderr,*) "sclrpthvp = ", sclrpthvp - write(fstderr,*) "sclrprcp = ", sclrprcp - write(fstderr,*) "wpsclrp2 = ", wpsclrp2 - write(fstderr,*) "wpsclrprtp = ", wpsclrprtp - write(fstderr,*) "wpsclrpthlp = ", wpsclrpthlp - write(fstderr,*) "wp2sclrp = ", wp2sclrp - end if - - end if ! Fatal error - - end if ! clubb_at_least_debug_level - - return - end subroutine pdf_closure - - !----------------------------------------------------------------------- - subroutine calc_cloud_frac_component(s, stdev_s, s_at_sat, cloud_fracN, rcN) - ! Description: - ! Given the mean and standard deviation of 's', this subroutine - ! calculates cloud_frac, where n is the PDF component (either 1 or - ! 2). In addition, the subroutine can also optionally calculate rc, - ! the mean of r_c - ! - ! References: - ! See ticket#529 - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - s_mellor_tol,&! Tolerance for pdf parameter s [kg/kg] - sqrt_2pi, &! sqrt(2*pi) - sqrt_2 ! sqrt(2) - - use crmx_clubb_precision, only: & - core_rknd ! Precision - - use crmx_anl_erf, only: & - erf ! Procedure(s) - ! The error function - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - s, & ! Mean of 's' component - stdev_s, & ! Standard deviation of s - s_at_sat ! Value of 's' at exact saturation with respect to ice - ! Negative (or zero for liquid) - - ! Output Variables - real( kind = core_rknd ), intent(out) :: & - cloud_fracN ! Component of cloud_frac - - ! Output Variable - ! Note: this parameter can be optionally computed. - real( kind = core_rknd), intent(out), optional :: & - rcN ! Mean of r_c - - ! Local Variables - real( kind = core_rknd) :: zetaN - - !----------------------------------------------------------------------- - !----- Begin Code ----- - if ( stdev_s > s_mellor_tol ) then - zetaN = (s - s_at_sat) / stdev_s - cloud_fracN = 0.5_core_rknd*( 1._core_rknd + erf( zetaN/sqrt_2 ) ) - if (present(rcN)) & - rcN = s*cloud_fracN + stdev_s*exp( -0.5_core_rknd*zetaN**2 )/( sqrt_2pi ) - else - if ( s < 0.0_core_rknd ) then - cloud_fracN = 0.0_core_rknd - if (present(rcN)) & - rcN = 0.0_core_rknd - else - cloud_fracN = 1.0_core_rknd - if (present(rcN)) & - rcN = s - end if ! s < 0 - end if ! stdev_s > s_mellor_tol - - - end subroutine calc_cloud_frac_component - !----------------------------------------------------------------------- - - !----------------------------------------------------------------------- - function calc_cloud_frac(cloud_frac1, cloud_frac2, mixt_frac) - ! Description: - ! Given the the two pdf components of a cloud fraction, and the weight - ! of the first component, this fuction calculates the cloud fraction, - ! cloud_frac - ! - ! References: - ! See ticket#530 - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr, &! Standard error output - zero_threshold ! A physical quantity equal to zero - - use crmx_clubb_precision, only: & - core_rknd ! Precision - - use crmx_error_code, only: & - clubb_at_least_debug_level ! Function to check whether clubb is in - ! at least the specified debug level - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - cloud_frac1, & ! First PDF component of cloud_frac - cloud_frac2, & ! Second PDF component of cloud_frac - mixt_frac ! Weight of 1st PDF component (Sk_w dependent) - - ! Output Variables - real( kind = core_rknd) :: & - calc_cloud_frac ! Cloud fraction - - ! Local Variables - real( kind = core_rknd) :: & - cloud_frac ! Cloud fraction (used as a holding variable for - ! output) - - !----------------------------------------------------------------------- - !----- Begin Code ----- - cloud_frac = mixt_frac * cloud_frac1 + (1.0_core_rknd-mixt_frac) * cloud_frac2 - - ! Note: Brian added the following lines to ensure that there - ! are never any negative liquid water values (or any negative - ! cloud fraction values, for that matter). According to - ! Vince Larson, the analytic formula should not produce any - ! negative results, but such computer-induced errors such as - ! round-off error may produce such a value. This has been - ! corrected because Brian found a small negative value of - ! rcm in the first timestep of the FIRE case. - - cloud_frac = max( zero_threshold, cloud_frac ) - if ( clubb_at_least_debug_level( 2 ) ) then - if ( cloud_frac > 1.0_core_rknd ) then - write(fstderr,*) "Cloud fraction > 1" - end if - end if - cloud_frac = min( 1.0_core_rknd, cloud_frac ) - - calc_cloud_frac = cloud_frac - return - - end function calc_cloud_frac - !----------------------------------------------------------------------- - -end module crmx_pdf_closure_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_pdf_parameter_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_pdf_parameter_module.F90 deleted file mode 100644 index bc62a8bdd5..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_pdf_parameter_module.F90 +++ /dev/null @@ -1,58 +0,0 @@ -! $Id: pdf_parameter_module.F90 5668 2012-01-29 03:40:28Z bmg2@uwm.edu $ -module crmx_pdf_parameter_module -! Description: -! This module defines the derived type pdf_parameter. -! References: -! None -!------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd - - implicit none - - private ! Default scope - - public :: pdf_parameter - - type pdf_parameter - real( kind = core_rknd ) :: & - w1, & ! Mean of w (1st PDF component) [m/s] - w2, & ! Mean of w (2nd PDF component) [m/s] - varnce_w1, & ! Variance of w (1st PDF component) [m^2/s^2] - varnce_w2, & ! Variance of w (2nd PDF component) [m^2/s^2] - rt1, & ! Mean of r_t (1st PDF component) [kg/kg] - rt2, & ! Mean of r_t (2nd PDF component) [kg/kg] - varnce_rt1, & ! Variance of r_t (1st PDF component) [kg^2/kg^2] - varnce_rt2, & ! Variance of r_t (2nd PDF component) [kg^2/kg^2] - thl1, & ! Mean of th_l (1st PDF component) [K] - thl2, & ! Mean of th_l (2nd PDF component) [K] - varnce_thl1, & ! Variance of th_l (1st PDF component) [K^2] - varnce_thl2, & ! Variance of th_l (2nd PDF component) [K^2] - rrtthl, & ! Correlation between r_t and th_l (both components) [-] - alpha_thl, & ! Factor relating to normalized variance for th_l [-] - alpha_rt, & ! Factor relating to normalized variance for r_t [-] - crt1, & ! Coef. on r_t in s/t eqns. (1st PDF comp.) [-] - crt2, & ! Coef. on r_t in s/t eqns. (2nd PDF comp.) [-] - cthl1, & ! Coef. on th_l in s/t eqns. (1st PDF comp.) [(kg/kg)/K] - cthl2, & ! Coef. on th_l in s/t eqns. (2nd PDF comp.) [(kg/kg)/K] - s1, & ! Mean of s (1st PDF component) [kg/kg] - s2, & ! Mean of s (2nd PDF component) [kg/kg] - stdev_s1, & ! Standard deviation of s (1st PDF component) [kg/kg] - stdev_s2, & ! Standard deviation of s (2nd PDF component) [kg/kg] - stdev_t1, & ! Standard deviation of t (1st PDF component) [kg/kg] - stdev_t2, & ! Standard deviation of t (2nd PDF component) [kg/kg] - covar_st_1, & ! Covariance of s and t (1st PDF component) [kg^2/kg^2] - covar_st_2, & ! Covariance of s and t (2nd PDF component) [kg^2/kg^2] - corr_st_1, & ! Correlation between s and t (1st PDF component) [-] - corr_st_2, & ! Correlation between s and t (2nd PDF component) [-] - rsl1, & ! Mean of r_sl (1st PDF component) [kg/kg] - rsl2, & ! Mean of r_sl (2nd PDF component) [kg/kg] - rc1, & ! Mean of r_c (1st PDF component) [kg/kg] - rc2, & ! Mean of r_c (2nd PDF component) [kg/kg] - cloud_frac1, & ! Cloud fraction (1st PDF component) [-] - cloud_frac2, & ! Cloud fraction (2nd PDF component) [-] - mixt_frac ! Weight of 1st PDF component (Sk_w dependent) [-] - end type pdf_parameter - -end module crmx_pdf_parameter_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_pos_definite_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_pos_definite_module.F90 deleted file mode 100644 index 65471a4345..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_pos_definite_module.F90 +++ /dev/null @@ -1,220 +0,0 @@ -!$Id: pos_definite_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -module crmx_pos_definite_module - - implicit none - - public :: pos_definite_adj - - private ! Default Scope - - contains -!----------------------------------------------------------------------- - subroutine pos_definite_adj & - ( dt, field_grid, field_np1, & - flux_np1, field_n, field_pd, flux_pd ) -! Description: -! Applies a flux conservative positive definite scheme to a variable - -! There are two possible grids: -! (1) flux on zm field on zt -! then -! flux_zt(k) = ( flux_zm(k) + flux_zm(k-1) ) / 2 - -! CLUBB grid Smolarkiewicz grid -! m +-- flux zm(k) --+ flux k + 1/2 -! t +-- field zt(k) --+ field, fout k -! m +-- flux zm(k-1) --+ flux k - 1/2 -! t +-- field zt(k-1) --+ - -! (1) flux on zt field on zm -! then -! flux_zm(k) = ( flux_zt(k) + flux_zt(k+1) ) / 2 - -! CLUBB grid Smolarkiewicz grid -! m +-- field (k+1) --+ -! t +-- flux (k+1) --+ flux k + 1/2 -! m +-- field (k) --+ field, fout k -! t +-- flux (k) --+ flux k - 1/2 - - -! References: -! ``A Positive Definite Advection Scheme Obtained by -! Nonlinear Renormalization of the Advective Fluxes'' Smolarkiewicz (1989) -! Monthly Weather Review, Vol. 117, pp. 2626--2632 -!----------------------------------------------------------------------- - - use crmx_grid_class, only: & - gr, & ! Variable(s) - ddzt, & ! Function - ddzm ! Function - - use crmx_constants_clubb, only : & - eps, & ! Variable(s) - zero_threshold - - use crmx_clubb_precision, only: & - time_precision, & ! Variable(s) - core_rknd - - use crmx_error_code, only: & - clubb_at_least_debug_level - - implicit none - - ! External - intrinsic :: eoshift, kind, any, min, max - - ! Input variables - real(kind=time_precision), intent(in) :: & - dt ! Timestep [s] - - character(len=2), intent(in) :: & - field_grid ! The grid of the field, either zt or zm - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - field_n ! The field (e.g. rtm) at n, prior to n+1 - - real( kind = core_rknd ), dimension(gr%nz), intent(out) :: & - flux_pd, & ! Budget of the change in the flux term due to the scheme - field_pd ! Budget of the change in the mean term due to the scheme - - ! Output Variables - - real( kind = core_rknd ), intent(inout), dimension(gr%nz) :: & - field_np1, & ! Field at n+1 (e.g. rtm in [kg/kg]) - flux_np1 ! Flux applied to field - - ! Local Variables - integer :: & - kabove, & ! # of vertical levels the flux higher point resides - kbelow ! # of vertical levels the flux lower point resides - - integer :: & - k, kmhalf, kp1, kphalf ! Loop indices - - real( kind = core_rknd ), dimension(gr%nz) :: & - flux_plus, flux_minus, & ! [F_i+1/2]^+ [F_i+1/2]^- in Smolarkiewicz - fout, & ! (A4) F_i{}^OUT, or the sum flux_plus+flux_minus - flux_lim, & ! Correction applied to flux at n+1 - field_nonlim ! Temporary variable for calculation - - real( kind = core_rknd ), dimension(gr%nz) :: & - dz_over_dt ! Conversion factor [m/s] - - -!----------------------------------------------------------------------- - - ! If all the values are positive or the values at the previous - ! timestep were negative, then just return - if ( .not. any( field_np1 < 0._core_rknd ) .or. any( field_n < 0._core_rknd ) ) then - flux_pd = 0._core_rknd - field_pd = 0._core_rknd - return - end if - - if ( field_grid == "zm" ) then - kabove = 0 - kbelow = 1 - else if ( field_grid == "zt" ) then - kabove = 1 - kbelow = 0 - else - ! This is only necessary to avoid a compiler warning in g95 - kabove = -1 - kbelow = -1 - ! Joshua Fasching June 2008 - - stop "Error in pos_def_adj" - end if - - if ( clubb_at_least_debug_level( 1 ) ) then - print *, "Correcting flux" - end if - - do k = 1, gr%nz, 1 - - ! Def. of F+ and F- from eqn 2 Smolarkowicz - flux_plus(k) = max( zero_threshold, flux_np1(k) ) ! defined on flux levels - flux_minus(k) = -min( zero_threshold, flux_np1(k) ) ! defined on flux levels - - if ( field_grid == "zm" ) then - dz_over_dt(k) = ( 1._core_rknd/gr%invrs_dzm(k) ) / real( dt, kind = core_rknd ) - - else if ( field_grid == "zt" ) then - dz_over_dt(k) = ( 1._core_rknd/gr%invrs_dzt(k) ) / real( dt, kind = core_rknd ) - - end if - - end do - - do k = 1, gr%nz, 1 - ! If the scalar variable is on the kth t-level, then - ! Smolarkowicz's k+1/2 flux level is the kth m-level in CLUBB. - - ! If the scalar variable is on the kth m-level, then - ! Smolarkowicz's k+1/2 flux level is the k+1 t-level in CLUBB. - - kphalf = min( k+kabove, gr%nz ) ! k+1/2 flux level - kmhalf = max( k-kbelow, 1 ) ! k-1/2 flux level - - ! Eqn A4 from Smolarkowicz - ! We place a limiter of eps to prevent a divide by zero, and - ! after this calculation fout is on the scalar level, and - ! fout is the total outward flux for the scalar level k. - - fout(k) = max( flux_plus(kphalf) + flux_minus(kmhalf), eps ) - - end do - - - do k = 1, gr%nz, 1 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! FIXME: - ! We haven't tested this for negative values at the gr%nz level - ! -dschanen 13 June 2008 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - kphalf = min( k+kabove, gr%nz ) ! k+1/2 flux level - kp1 = min( k+1, gr%nz ) ! k+1 scalar level - - ! Eqn 10 from Smolarkowicz (1989) - - flux_lim(kphalf) & - = max( min( flux_np1(kphalf), & - ( flux_plus(kphalf)/fout(k) ) * field_n(k) & - * dz_over_dt(k) & - ), & - -( ( flux_minus(kphalf)/fout(kp1) ) * field_n(kp1) & - * dz_over_dt(k) ) & - ) - end do - - ! Boundary conditions - flux_lim(1) = flux_np1(1) - flux_lim(gr%nz) = flux_np1(gr%nz) - - flux_pd = ( flux_lim - flux_np1 ) / real( dt, kind = core_rknd ) - - field_nonlim = field_np1 - - ! Apply change to field at n+1 - if ( field_grid == "zt" ) then - - field_np1 = -real( dt, kind = core_rknd ) * ddzm( flux_lim - flux_np1 ) + field_np1 - - else if ( field_grid == "zm" ) then - - field_np1 = -real( dt, kind = core_rknd ) * ddzt( flux_lim - flux_np1 ) + field_np1 - - end if - - ! Determine the total time tendency in field due to this calculation - ! (for diagnostic purposes) - field_pd = ( field_np1 - field_nonlim ) / real( dt, kind = core_rknd ) - - ! Replace the non-limited flux with the limited flux - flux_np1 = flux_lim - - return - end subroutine pos_definite_adj - -end module crmx_pos_definite_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_saturation.F90 b/src/physics/spcam/crm/CLUBB/crmx_saturation.F90 deleted file mode 100644 index a99bfce9fc..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_saturation.F90 +++ /dev/null @@ -1,789 +0,0 @@ -!$Id: saturation.F90 5997 2012-12-18 20:47:09Z raut@uwm.edu $ -!----------------------------------------------------------------------- -module crmx_saturation - -! Description: -! Contains functions that compute saturation with respect -! to liquid or ice. -!----------------------------------------------------------------------- - -#ifdef GFDL - use crmx_model_flags, only: & ! h1g, 2010-06-18 - I_sat_sphum -#endif - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - private ! Change default so all items private - - public :: sat_mixrat_liq, sat_mixrat_liq_lookup, sat_mixrat_ice, rcm_sat_adj, & - sat_vapor_press_liq - - private :: sat_vapor_press_liq_flatau, sat_vapor_press_liq_bolton - private :: sat_vapor_press_ice_flatau, sat_vapor_press_ice_bolton - - ! Lookup table of values for saturation - real( kind = core_rknd ), private, dimension(188:343) :: & - svp_liq_lookup_table - - data svp_liq_lookup_table(188:343) / & - 0.049560547_core_rknd, 0.059753418_core_rknd, 0.070129395_core_rknd, 0.083618164_core_rknd, & - 0.09814453_core_rknd, 0.11444092_core_rknd, 0.13446045_core_rknd, 0.15686035_core_rknd, & - 0.18218994_core_rknd, 0.21240234_core_rknd, 0.24725342_core_rknd, 0.28668213_core_rknd, & - 0.33184814_core_rknd, 0.3826294_core_rknd, 0.4416504_core_rknd, 0.50775146_core_rknd, & - 0.58343506_core_rknd, 0.6694946_core_rknd, 0.7668457_core_rknd, 0.87750244_core_rknd, & - 1.0023804_core_rknd, 1.1434937_core_rknd, 1.3028564_core_rknd, 1.482544_core_rknd, & - 1.6847534_core_rknd, 1.9118042_core_rknd, 2.1671143_core_rknd, 2.4535522_core_rknd, & - 2.774231_core_rknd, 3.1330566_core_rknd, 3.5343628_core_rknd, 3.9819336_core_rknd, & - 4.480713_core_rknd, 5.036072_core_rknd, 5.6540527_core_rknd, 6.340088_core_rknd, & - 7.1015015_core_rknd, 7.9450684_core_rknd, 8.8793335_core_rknd, 9.91217_core_rknd, & - 11.053528_core_rknd, 12.313049_core_rknd, 13.70166_core_rknd, 15.231018_core_rknd, & - 16.91394_core_rknd, 18.764038_core_rknd, 20.795898_core_rknd, 23.025574_core_rknd, & - 25.470093_core_rknd, 28.147766_core_rknd, 31.078003_core_rknd, 34.282043_core_rknd, & - 37.782593_core_rknd, 41.60382_core_rknd, 45.771606_core_rknd, 50.31366_core_rknd, & - 55.259644_core_rknd, 60.641174_core_rknd, 66.492004_core_rknd, 72.84802_core_rknd, & - 79.74756_core_rknd, 87.23126_core_rknd, 95.34259_core_rknd, 104.12747_core_rknd, & - 113.634796_core_rknd, 123.91641_core_rknd, 135.02725_core_rknd, 147.02563_core_rknd, & - 159.97308_core_rknd, 173.93488_core_rknd, 188.97995_core_rknd, 205.18109_core_rknd, & - 222.61517_core_rknd, 241.36334_core_rknd, 261.51108_core_rknd, 283.14853_core_rknd, & - 306.37054_core_rknd, 331.27698_core_rknd, 357.97278_core_rknd, 386.56842_core_rknd, & - 417.17978_core_rknd, 449.9286_core_rknd, 484.94254_core_rknd, 522.3556_core_rknd, & - 562.30804_core_rknd, 604.947_core_rknd, 650.42645_core_rknd, 698.9074_core_rknd, & - 750.55835_core_rknd, 805.55554_core_rknd, 864.0828_core_rknd, 926.3325_core_rknd, & - 992.5052_core_rknd, 1062.8102_core_rknd, 1137.4657_core_rknd, 1216.6995_core_rknd, & - 1300.7483_core_rknd, 1389.8594_core_rknd, 1484.2896_core_rknd, 1584.3064_core_rknd, & - 1690.1881_core_rknd, 1802.224_core_rknd, 1920.7146_core_rknd, 2045.9724_core_rknd, & - 2178.3218_core_rknd, 2318.099_core_rknd, 2465.654_core_rknd, 2621.3489_core_rknd, & - 2785.5596_core_rknd, 2958.6758_core_rknd, 3141.101_core_rknd, 3333.2534_core_rknd, & - 3535.5657_core_rknd, 3748.4863_core_rknd, 3972.4792_core_rknd, 4208.024_core_rknd, & - 4455.616_core_rknd, 4715.7686_core_rknd, 4989.0127_core_rknd, 5275.8945_core_rknd, & - 5576.9795_core_rknd, 5892.8535_core_rknd, 6224.116_core_rknd, 6571.3926_core_rknd, & - 6935.3213_core_rknd, 7316.5674_core_rknd, 7715.8105_core_rknd, 8133.755_core_rknd, & - 8571.125_core_rknd, 9028.667_core_rknd, 9507.15_core_rknd, 10007.367_core_rknd, & - 10530.132_core_rknd, 11076.282_core_rknd, 11646.683_core_rknd, 12242.221_core_rknd, & - 12863.808_core_rknd, 13512.384_core_rknd, 14188.913_core_rknd, 14894.385_core_rknd, & - 15629.823_core_rknd, 16396.268_core_rknd, 17194.799_core_rknd, 18026.516_core_rknd, & - 18892.55_core_rknd, 19794.07_core_rknd, 20732.262_core_rknd, 21708.352_core_rknd, & - 22723.592_core_rknd, 23779.273_core_rknd, 24876.709_core_rknd, 26017.258_core_rknd, & - 27202.3_core_rknd, 28433.256_core_rknd, 29711.578_core_rknd, 31038.766_core_rknd / - - contains - -!------------------------------------------------------------------------- - elemental real( kind = core_rknd ) function sat_mixrat_liq( p_in_Pa, T_in_K ) - -! Description: -! Used to compute the saturation mixing ratio of liquid water. - -! References: -! Formula from Emanuel 1994, 4.4.14 -!------------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - ep, & ! Variable - fstderr - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - p_in_Pa, & ! Pressure [Pa] - T_in_K ! Temperature [K] - - ! Local Variables - real( kind = core_rknd ) :: esatv - - ! --- Begin Code --- - - ! Calculate the SVP for water vapor. - esatv = sat_vapor_press_liq( T_in_K ) - - ! If esatv exceeds the air pressure, then assume esatv~=0.5*pressure - ! and set rsat = ep = 0.622 - if ( p_in_Pa-esatv < 1.0_core_rknd ) then - sat_mixrat_liq = ep - else - -#ifdef GFDL - - ! GFDL uses specific humidity - ! Formula for Saturation Specific Humidity - if( I_sat_sphum ) then ! h1g, 2010-06-18 begin mod - sat_mixrat_liq = ep * ( esatv / ( p_in_Pa - (1.0_core_rknd-ep) * esatv ) ) - else - sat_mixrat_liq = ep * ( esatv / ( p_in_Pa - esatv ) ) - endif ! h1g, 2010-06-18 end mod -#else - ! Formula for Saturation Mixing Ratio: - ! - ! rs = (epsilon) * [ esat / ( p - esat ) ]; - ! where epsilon = R_d / R_v - sat_mixrat_liq = ep * ( esatv / ( p_in_Pa - esatv ) ) -#endif - - end if - - return - end function sat_mixrat_liq - -!------------------------------------------------------------------------- - elemental real( kind = core_rknd ) function sat_mixrat_liq_lookup( p_in_Pa, T_in_K ) - -! Description: -! Used to compute the saturation mixing ratio of liquid water. -! This function utilizes sat_vapor_press_liq_lookup; the SVP is found -! using a lookup table rather than calculating it using various -! approximations. - -! References: -! Formula from Emanuel 1994, 4.4.14 -!------------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - ep, & ! Variable - fstderr - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - p_in_Pa, & ! Pressure [Pa] - T_in_K ! Temperature [K] - - ! Local Variables - real( kind = core_rknd ) :: esatv - - ! --- Begin Code --- - - ! Calculate the SVP for water vapor using a lookup table. - esatv = sat_vapor_press_liq_lookup( T_in_K ) - - ! If esatv exceeds the air pressure, then assume esatv~=0.5*pressure - ! and set rsat = ep = 0.622 - if ( p_in_Pa-esatv < 1.0_core_rknd ) then - sat_mixrat_liq_lookup = ep - else - -#ifdef GFDL - - ! GFDL uses specific humidity - ! Formula for Saturation Specific Humidity - if( I_sat_sphum ) then ! h1g, 2010-06-18 begin mod - sat_mixrat_liq_lookup = ep * ( esatv / ( p_in_Pa - (1.0_core_rknd-ep) * esatv ) ) - else - sat_mixrat_liq_lookup = ep * ( esatv / ( p_in_Pa - esatv ) ) - endif ! h1g, 2010-06-18 end mod -#else - ! Formula for Saturation Mixing Ratio: - ! - ! rs = (epsilon) * [ esat / ( p - esat ) ]; - ! where epsilon = R_d / R_v - sat_mixrat_liq_lookup = ep * ( esatv / ( p_in_Pa - esatv ) ) -#endif - - end if - - return - end function sat_mixrat_liq_lookup - -!----------------------------------------------------------------- - elemental function sat_vapor_press_liq( T_in_K ) result ( esat ) - -! Description: -! Computes SVP for water vapor. Calls one of the other functions -! that calculate an approximation to SVP. - -! References: -! None - - use crmx_model_flags, only: & - saturation_formula, & ! Variable - saturation_bolton, & - saturation_gfdl, & - saturation_flatau - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] - - ! Output Variables - real( kind = core_rknd ) :: esat ! Saturation Vapor Pressure over Water [Pa] - - ! Undefined approximation - esat = -99999.999_core_rknd - - ! Saturation Vapor Pressure, esat, can be found to be approximated - ! in many different ways. - select case ( saturation_formula ) - case ( saturation_bolton ) - ! Using the Bolton 1980 approximations for SVP over vapor - esat = sat_vapor_press_liq_bolton( T_in_K ) - - case ( saturation_flatau ) - ! Using the Flatau, et al. polynomial approximation for SVP over vapor - esat = sat_vapor_press_liq_flatau( T_in_K ) - -! ---> h1g - case ( saturation_gfdl ) - ! Using GFDL polynomial approximation for SVP with respect to liquid - esat = sat_vapor_press_liq_gfdl( T_in_K ) -! <--- h1g - - ! Add new cases after this - - end select - - return - - end function sat_vapor_press_liq - -!------------------------------------------------------------------------ - elemental function sat_vapor_press_liq_lookup( T_in_K ) result ( esat ) - -! Description: -! Computes SVP for water vapor, using a lookup table. -! -! The lookup table was constructed using the Flatau approximation. - -! References: -! ``Polynomial Fits to Saturation Vapor Pressure'' Falatau, Walko, -! and Cotton. (1992) Journal of Applied Meteorology, Vol. 31, -! pp. 1507--1513 -!------------------------------------------------------------------------ - - implicit none - - ! External - intrinsic :: max, min, int, anint - - ! Input Variables - real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] - - ! Output Variables - real( kind = core_rknd ) :: esat ! Saturation vapor pressure over water [Pa] - - ! Local Variables - integer :: T_in_K_int - - ! ---- Begin Code ---- - - T_in_K_int = int( anint( T_in_K ) ) - - ! Since this approximation is only good out to -85 degrees Celsius we - ! truncate the result here - T_in_K_int = min( max( T_in_K_int, 188 ), 343 ) - - ! Use the lookup table to determine the saturation vapor pressure. - esat = svp_liq_lookup_table( T_in_K_int ) - - return - end function sat_vapor_press_liq_lookup - -!------------------------------------------------------------------------ - elemental function sat_vapor_press_liq_flatau( T_in_K ) result ( esat ) - -! Description: -! Computes SVP for water vapor. - -! References: -! ``Polynomial Fits to Saturation Vapor Pressure'' Falatau, Walko, -! and Cotton. (1992) Journal of Applied Meteorology, Vol. 31, -! pp. 1507--1513 -!------------------------------------------------------------------------ - - use crmx_constants_clubb, only: T_freeze_K - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Constant parameters - - ! Relative error norm expansion (-50 to 50 deg_C) from - ! Table 3 of pp. 1510 of Flatau et al. 1992 (Water Vapor) - ! (The 100 coefficient converts from mb to Pa) -! real, dimension(7), parameter :: a = & -! 100.* (/ 6.11176750, 0.443986062, 0.143053301E-01, & -! 0.265027242E-03, 0.302246994E-05, 0.203886313E-07, & -! 0.638780966E-10 /) - - ! Relative error norm expansion (-85 to 70 deg_C) from - ! Table 4 of pp. 1511 of Flatau et al. - real( kind = core_rknd ), dimension(9), parameter :: a = & - 100._core_rknd * & - (/ 6.11583699_core_rknd, 0.444606896_core_rknd, 0.143177157E-01_core_rknd, & - 0.264224321E-03_core_rknd, 0.299291081E-05_core_rknd, 0.203154182E-07_core_rknd, & - 0.702620698E-10_core_rknd, 0.379534310E-13_core_rknd,-0.321582393E-15_core_rknd /) - - real( kind = core_rknd ), parameter :: min_T_in_C = -85._core_rknd ! [deg_C] - - ! Input Variables - real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] - - ! Output Variables - real( kind = core_rknd ) :: esat ! Saturation vapor pressure over water [Pa] - - ! Local Variables - real( kind = core_rknd ) :: T_in_C -! integer :: i ! Loop index - - ! ---- Begin Code ---- - - ! Determine deg K - 273.15 - T_in_C = T_in_K - T_freeze_K - - ! Since this approximation is only good out to -85 degrees Celsius we - ! truncate the result here (Flatau, et al. 1992) - T_in_C = max( T_in_C, min_T_in_C ) - - ! Polynomial approx. (Flatau, et al. 1992) - - ! This is the generalized formula but is not computationally efficient. - ! Based on Wexler's expressions(2.1)-(2.4) (See Flatau et al. p 1508) - ! e_{sat} = a_1 + a_2 ( T - T_0 ) + ... + a_{n+1} ( T - T_0 )^n - -! esat = a(1) - -! do i = 2, size( a ) , 1 -! esat = esat + a(i) * ( T_in_C )**(i-1) -! end do - - ! The 8th order polynomial fit. When running deep - ! convective cases I noticed that absolute temperature often dips below - ! -50 deg_C at higher altitudes, where the 6th order approximation is - ! not accurate. -dschanen 20 Nov 2008 - esat = a(1) + T_in_C*( a(2) + T_in_C*( a(3) + T_in_C*( a(4) + T_in_C & - *( a(5) + T_in_C*( a(6) + T_in_C*( a(7) + T_in_C*( a(8) + T_in_C*( a(9) ) ) ) ) ) ) ) ) - - return - end function sat_vapor_press_liq_flatau - - -!------------------------------------------------------------------------ - elemental function sat_vapor_press_liq_bolton( T_in_K ) result ( esat ) -! Description: -! Computes SVP for water vapor. -! References: -! Bolton 1980 -!------------------------------------------------------------------------ - - use crmx_constants_clubb, only: T_freeze_K - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: exp - - ! Input Variables - real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] - - ! Output Variables - real( kind = core_rknd ) :: esat ! Saturation vapor pressure over water [Pa] - - ! (Bolton 1980) approx. - ! Generally this more computationally expensive than the Flatau polnomial expansion - esat = 611.2_core_rknd * exp( (17.67_core_rknd*(T_in_K-T_freeze_K)) / & - (T_in_K-29.65_core_rknd) ) ! Known magic number - - return - end function sat_vapor_press_liq_bolton - - -! ---> h1g, 2010-06-16 -!------------------------------------------------------------------------ - elemental function sat_vapor_press_liq_gfdl( T_in_K ) result ( esat ) -! Description: -! copy from "GFDL polysvp.F90" -! Compute saturation vapor pressure with respect to liquid by using -! function from Goff and Gatch (1946) - -! Polysvp returned in units of pa. -! T_in_K is input in units of K. -!------------------------------------------------------------------------ - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] - - ! Output Variables - real( kind = core_rknd ) :: esat ! Saturation vapor pressure over water [Pa] - -! Goff Gatch equation, uncertain below -70 C - - esat = 10._core_rknd**(-7.90298_core_rknd*(373.16_core_rknd/T_in_K-1._core_rknd)+ & - 5.02808_core_rknd*log10(373.16_core_rknd/T_in_K)- & - 1.3816e-7_core_rknd*(10._core_rknd**(11.344_core_rknd & - *(1._core_rknd-T_in_K/373.16_core_rknd))-1._core_rknd)+ & - 8.1328e-3_core_rknd*(10._core_rknd**(-3.49149_core_rknd & - *(373.16_core_rknd/T_in_K-1._core_rknd))-1._core_rknd)+ & - log10(1013.246_core_rknd))*100._core_rknd ! Known magic number - - return - end function sat_vapor_press_liq_gfdl -! <--- h1g, 2010-06-16 - -!------------------------------------------------------------------------ - elemental real( kind = core_rknd ) function sat_mixrat_ice( p_in_Pa, T_in_K ) - -! Description: -! Used to compute the saturation mixing ratio of ice. - -! References: -! Formula from Emanuel 1994, 4.4.15 -!------------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - ep ! Variable(s) - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: trim - - ! Input Variables - - real( kind = core_rknd ), intent(in) :: & - p_in_Pa, & ! Pressure [Pa] - T_in_K ! Temperature [K] - - ! Local Variables - - real( kind = core_rknd ) :: esat_ice - - ! --- Begin Code --- - - ! Determine the SVP for the given temperature - esat_ice = sat_vapor_press_ice( T_in_K ) - - ! If esat_ice exceeds the air pressure, then assume esat_ice~=0.5*pressure - ! and set rsat = ep = 0.622 - if ( p_in_Pa-esat_ice < 1.0_core_rknd ) then - sat_mixrat_ice = ep - else - -#ifdef GFDL - ! GFDL uses specific humidity - ! Formula for Saturation Specific Humidity - if( I_sat_sphum ) then ! h1g, 2010-06-18 begin mod - sat_mixrat_ice = ep * ( esat_ice / ( p_in_Pa - (1.0_core_rknd-ep) * esat_ice ) ) - else - sat_mixrat_ice = ep * ( esat_ice / ( p_in_Pa - esat_ice ) ) - endif ! h1g, 2010-06-18 end mod -#else - ! Formula for Saturation Mixing Ratio: - ! - ! rs = (epsilon) * [ esat / ( p - esat ) ]; - ! where epsilon = R_d / R_v - - sat_mixrat_ice = ep * ( esat_ice / ( p_in_Pa - esat_ice ) ) -#endif - - end if - - return - end function sat_mixrat_ice - -!------------------------------------------------------------------------ - elemental function sat_vapor_press_ice( T_in_K ) result ( esat_ice ) -! -! Description: -! Computes SVP for ice, using one of the various approximations. -! -! References: -! None -!------------------------------------------------------------------------ - - use crmx_model_flags, only: & - saturation_formula, & ! Variable(s) - saturation_bolton, & - saturation_gfdl, & - saturation_flatau - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variable - real( kind = core_rknd ), intent(in) :: & - T_in_K ! Temperature [K] - - ! Output Variable - real( kind = core_rknd ) :: esat_ice ! Saturation Vapor Pressure over Ice [Pa] - - ! Undefined approximation - esat_ice = -99999.999_core_rknd - - select case ( saturation_formula ) - case ( saturation_bolton ) - ! Using the Bolton 1980 approximations for SVP over ice - esat_ice = sat_vapor_press_ice_bolton( T_in_K ) - - case ( saturation_flatau ) - ! Using the Flatau, et al. polynomial approximation for SVP over ice - esat_ice = sat_vapor_press_ice_flatau( T_in_K ) - -! ---> h1g, 2010-06-16 - case ( saturation_gfdl ) - ! Using GFDL polynomial approximation for SVP with respect to ice - esat_ice = sat_vapor_press_ice_gfdl( T_in_K ) -! <--- h1g, 2010-06-16 - - ! Add new cases after this - - end select - - return - - end function sat_vapor_press_ice - -!------------------------------------------------------------------------ - elemental function sat_vapor_press_ice_flatau( T_in_K ) result ( esati ) -! -! Description: -! Computes SVP for ice. -! -! References: -! ``Polynomial Fits to Saturation Vapor Pressure'' Falatau, Walko, -! and Cotton. (1992) Journal of Applied Meteorology, Vol. 31, -! pp. 1507--1513 -!------------------------------------------------------------------------ - use crmx_constants_clubb, only: T_freeze_K - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: max - - ! Relative error norm expansion (-90 to 0 deg_C) from - ! Table 4 of pp. 1511 of Flatau et al. 1992 (Ice) - real( kind = core_rknd ), dimension(9), parameter :: a = & - 100._core_rknd * (/ 6.09868993_core_rknd, 0.499320233_core_rknd, 0.184672631E-01_core_rknd, & - 0.402737184E-03_core_rknd, 0.565392987E-05_core_rknd, 0.521693933E-07_core_rknd, & - 0.307839583E-09_core_rknd, 0.105785160E-11_core_rknd, 0.161444444E-14_core_rknd /) - - real( kind = core_rknd ), parameter :: min_T_in_C = -90._core_rknd ! [deg_C] - - - ! Input Variables - real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [deg_K] - - ! Output Variables - real( kind = core_rknd ) :: esati ! Saturation vapor pressure over ice [Pa] - - ! Local Variables - real( kind = core_rknd ) :: T_in_C ! Temperature [deg_C] -! integer :: i - - ! ---- Begin Code ---- - - ! Determine deg K - 273.15 - T_in_C = T_in_K - T_freeze_K - - ! Since this approximation is only good out to -90 degrees Celsius we - ! truncate the result here (Flatau, et al. 1992) - T_in_C = max( T_in_C, min_T_in_C ) - - ! Polynomial approx. (Flatau, et al. 1992) -! esati = a(1) - -! do i = 2, size( a ), 1 -! esati = esati + a(i) * ( T_in_C )**(i-1) -! end do - - esati = a(1) + T_in_C*( a(2) + T_in_C*( a(3) + T_in_C*( a(4) + T_in_C & - *( a(5) + T_in_C*( a(6) + T_in_C*( a(7) + T_in_C*( a(8) + T_in_C*( a(9) ) ) ) ) ) ) ) ) - - return - - end function sat_vapor_press_ice_flatau - -!------------------------------------------------------------------------ - elemental function sat_vapor_press_ice_bolton( T_in_K ) result ( esati ) -! -! Description: -! Computes SVP for ice. -! -! References: -! Bolton 1980 -!------------------------------------------------------------------------ - use crmx_constants_clubb, only: T_freeze_K - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: exp, log - - ! Input Variables - real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] - - ! Output Variables - real( kind = core_rknd ) :: esati ! Saturation vapor pressure over ice [Pa] - - ! Exponential approx. - esati = 100.0_core_rknd * exp( 23.33086_core_rknd - & - (6111.72784_core_rknd/T_in_K) + (0.15215_core_rknd*log( T_in_K )) ) - - return - - end function sat_vapor_press_ice_bolton - - -! ---> h1g, 2010-06-16 -!------------------------------------------------------------------------ - elemental function sat_vapor_press_ice_gfdl( T_in_K ) result ( esati ) -! Description: -! copy from "GFDL polysvp.F90" -! Compute saturation vapor pressure with respect to liquid by using -! function from Goff and Gatch (1946) -! -! Polysvp returned in units of pa. -! T_in_K is input in units of K. -!------------------------------------------------------------------------ - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), intent(in) :: T_in_K ! Temperature [K] - - ! Output Variables - real( kind = core_rknd ) :: esati ! Saturation vapor pressure over ice [Pa] - -! Goff Gatch equation (good down to -100 C) - - esati = 10._core_rknd**(-9.09718_core_rknd* & - (273.16_core_rknd/T_in_k-1._core_rknd)-3.56654_core_rknd* & - log10(273.16_core_rknd/T_in_k)+0.876793_core_rknd* & - (1._core_rknd-T_in_k/273.16_core_rknd)+ & - log10(6.1071_core_rknd))*100._core_rknd ! Known magic number - - return - - end function sat_vapor_press_ice_gfdl -! <--- h1g, 2010-06-16 - -!------------------------------------------------------------------------- - FUNCTION rcm_sat_adj( thlm, rtm, p_in_Pa, exner ) result ( rcm ) - - ! Description: - ! - ! This function uses an iterative method to find the value of rcm - ! from an initial profile that has saturation at some point. - ! - ! References: - ! None - !------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - use crmx_constants_clubb, only: & - Cp, & ! Variable(s) - Lv, & - zero_threshold - - implicit none - - ! Local Constant(s) - real( kind = core_rknd ), parameter :: & - tolerance = 0.001_core_rknd ! Tolerance on theta calculation [K] - - integer, parameter :: & - itermax = 1000000 ! Maximum interations - - ! External - intrinsic :: max, abs - - ! Input Variable(s) - real( kind = core_rknd ), intent(in) :: & - thlm, & ! Liquid Water Potential Temperature [K] - rtm, & ! Total Water Mixing Ratio [kg/kg] - p_in_Pa, & ! Pressure [Pa] - exner ! Exner function [-] - - ! Output Variable(s) - real( kind = core_rknd ) :: rcm ! Cloud water mixing ratio [kg/kg] - - ! Local Variable(s) - real( kind = core_rknd ) :: & - theta, answer, too_low, too_high ! [K] - - integer :: iteration - - ! ----- Begin Code ----- - - ! Default initialization - theta = thlm - too_high = 0.0_core_rknd - too_low = 0.0_core_rknd - - DO iteration = 1, itermax, 1 - - answer = & - theta - (Lv/(Cp*exner)) & - *(MAX( rtm - sat_mixrat_liq(p_in_Pa,theta*exner), zero_threshold )) - - IF ( ABS(answer - thlm) <= tolerance ) THEN - EXIT - ELSEIF ( answer - thlm > tolerance ) THEN - too_high = theta - ELSEIF ( thlm - answer > tolerance ) THEN - too_low = theta - ENDIF - - ! For the first timestep, be sure to set a "too_high" - ! that is "way too high." - IF ( iteration == 1 ) THEN - too_high = theta + 20.0_core_rknd - ENDIF - - theta = (too_low + too_high)/2.0_core_rknd - - END DO ! 1..itermax - - if ( iteration == itermax ) then - ! Magic Eric Raut added to remove compiler warning (clearly this value is not used) - rcm = 0.0_core_rknd - - stop "Error in rcm_sat_adj: could not determine rcm" - else - rcm = MAX( rtm - sat_mixrat_liq( p_in_Pa, theta*exner), zero_threshold ) - return - end if - - END FUNCTION rcm_sat_adj - -end module crmx_saturation diff --git a/src/physics/spcam/crm/CLUBB/crmx_sigma_sqd_w_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_sigma_sqd_w_module.F90 deleted file mode 100644 index a10a868cdb..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_sigma_sqd_w_module.F90 +++ /dev/null @@ -1,64 +0,0 @@ -! $Id: sigma_sqd_w_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -module crmx_sigma_sqd_w_module - - implicit none - - public :: compute_sigma_sqd_w - - private ! Default scope - - contains -!--------------------------------------------------------------------------------------------------- - elemental function compute_sigma_sqd_w( gamma_Skw_fnc, wp2, thlp2, rtp2, wpthlp, wprtp ) & - result( sigma_sqd_w ) -! Description: -! Compute the variable sigma_sqd_w (PDF width parameter) -! -! References: -! Eqn 22 in ``Equations for CLUBB'' -!--------------------------------------------------------------------------------------------------- - use crmx_constants_clubb, only: & - w_tol, & ! Constant(s) - rt_tol, & - thl_tol - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: min, max, sqrt - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - gamma_Skw_fnc, & ! Gamma as a function of skewness [-] - wp2, & ! Variance of vertical velocity [m^2/s^2] - thlp2, & ! Variance of liquid pot. temp. [K^2] - rtp2, & ! Variance of total water [kg^2/kg^2] - wpthlp, & ! Flux of liquid pot. temp. [m/s K] - wprtp ! Flux of total water [m/s kg/kg] - - ! Output Variable - real( kind = core_rknd ) :: sigma_sqd_w ! PDF width parameter [-] - - ! ---- Begin Code ---- - - !---------------------------------------------------------------- - ! Compute sigma_sqd_w with new formula from Vince - !---------------------------------------------------------------- - - sigma_sqd_w = gamma_Skw_fnc * & - ( 1.0_core_rknd - min( & - max( ( wpthlp / ( sqrt( wp2 * thlp2 ) & - + 0.01_core_rknd * w_tol * thl_tol ) )**2, & - ( wprtp / ( sqrt( wp2 * rtp2 ) & - + 0.01_core_rknd * w_tol * rt_tol ) )**2 & - ), & ! max - 1.0_core_rknd ) & ! min - Known magic number (eq. 22 from "Equations for CLUBB") - ) - - return - end function compute_sigma_sqd_w - -end module crmx_sigma_sqd_w_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_sponge_layer_damping.F90 b/src/physics/spcam/crm/CLUBB/crmx_sponge_layer_damping.F90 deleted file mode 100644 index 5f13049ebe..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_sponge_layer_damping.F90 +++ /dev/null @@ -1,211 +0,0 @@ -!$Id: sponge_layer_damping.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -module crmx_sponge_layer_damping -! Description: -! This module is used for damping variables in upper altitudes of the grid. -! -! References: -! None -!--------------------------------------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - public :: sponge_damp_xm, initialize_tau_sponge_damp, finalize_tau_sponge_damp, & - sponge_damp_settings, sponge_damp_profile - - - type sponge_damp_settings - - real( kind = core_rknd ) :: & - tau_sponge_damp_min, & ! Minimum damping time-scale (at the top) [s] - tau_sponge_damp_max, & ! Maximum damping time-scale (base of damping layer) [s] - sponge_damp_depth ! damping depth as a fraction of domain height [-] - - logical :: & - l_sponge_damping ! True if damping is being used - - end type sponge_damp_settings - - type sponge_damp_profile - real( kind = core_rknd ), pointer, dimension(:) :: & - tau_sponge_damp ! Damping factor - - integer :: & - n_sponge_damp ! Number of levels damped - - end type sponge_damp_profile - - - type(sponge_damp_settings), public :: & - thlm_sponge_damp_settings, & - rtm_sponge_damp_settings, & - uv_sponge_damp_settings - - type(sponge_damp_profile), public :: & - thlm_sponge_damp_profile, & - rtm_sponge_damp_profile, & - uv_sponge_damp_profile - - - private - - contains - - !--------------------------------------------------------------------------------------------- - function sponge_damp_xm( dt, xm_ref, xm, damping_profile ) result( xm_p ) - ! - ! Description: - ! Damps specified variable. The module must be initialized for - ! this function to work. Otherwise a stop is issued. - ! - ! References: - ! None - !------------------------------------------------------------------------------------------- - - ! "Sponge"-layer damping at the domain top region - - use crmx_grid_class, only: gr ! Variable(s) - - use crmx_clubb_precision, only: time_precision, core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: associated - - ! Input Variable(s) - real(kind=time_precision), intent(in) :: dt ! Model Timestep - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - xm_ref ! Reference to damp to [-] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - xm ! Variable being damped [-] - - type(sponge_damp_profile), intent(in) :: & - damping_profile - - ! Output Variable(s) - real( kind = core_rknd ), dimension(gr%nz) :: xm_p ! Variable damped [-] - - real( kind = core_rknd ) :: dt_on_tau ! Ratio of timestep to damping timescale [-] - - integer :: k - - ! ---- Begin Code ---- - - if ( associated( damping_profile%tau_sponge_damp ) ) then - - xm_p = xm - - do k = gr%nz, gr%nz-damping_profile%n_sponge_damp, -1 - -! Vince Larson used implicit discretization in order to -! reduce noise in rtm in cloud_feedback_s12 (CGILS) -! xm_p(k) = xm(k) - real( ( ( xm(k) - xm_ref(k) ) / & -! damping_profile%tau_sponge_damp(k) ) * dt ) - dt_on_tau = real( dt, kind = core_rknd ) / damping_profile%tau_sponge_damp(k) - -! Really, we should be using xm_ref at time n+1 rather than n. -! However, for steady profiles of xm_ref, it won't matter. - xm_p(k) = ( xm(k) + dt_on_tau * xm_ref(k) ) / & - ( 1.0_core_rknd + dt_on_tau ) -! End Vince Larson's change - end do ! k - - else - - stop "tau_sponge_damp in damping used before initialization" - - end if - - return - end function sponge_damp_xm - - !--------------------------------------------------------------------------------------------- - subroutine initialize_tau_sponge_damp( dt, settings, damping_profile ) - ! - ! Description: - ! Initialize tau_sponge_damp used for damping - ! - ! References: - ! None - !------------------------------------------------------------------------------------------- - use crmx_clubb_precision, only: time_precision, core_rknd ! Variable(s) - - use crmx_constants_clubb, only: fstderr ! Constant(s) - - use crmx_grid_class, only: gr ! Variable(s) - - use crmx_interpolation, only: lin_int ! function - - implicit none - - ! Input Variable(s) - real(kind=time_precision), intent(in) :: dt ! Model Timestep [s] - - type(sponge_damp_settings), intent(in) :: & - settings - - type(sponge_damp_profile), intent(out) :: & - damping_profile - - integer :: k ! Loop iterator - - ! ---- Begin Code ---- - - allocate( damping_profile%tau_sponge_damp(1:gr%nz)) - - if( settings%tau_sponge_damp_min < 2._core_rknd * real( dt, kind = core_rknd ) ) then - write(fstderr,*) 'Error: in damping() tau_sponge_damp_min is too small!' - stop - end if - - do k=gr%nz,1,-1 - if(gr%zt(gr%nz)-gr%zt(k) < settings%sponge_damp_depth*gr%zt(gr%nz)) then - damping_profile%n_sponge_damp=gr%nz-k+1 - endif - end do - - do k=gr%nz,gr%nz-damping_profile%n_sponge_damp,-1 -! Vince Larson added code to use standard linear interpolation. -! damping_profile%tau_sponge_damp(k) = settings%tau_sponge_damp_min *& -! (settings%tau_sponge_damp_max/settings%tau_sponge_damp_min)** & -! ( ( gr%zt(gr%nz)-gr%zt(k) ) / & -! (gr%zt(gr%nz) - gr%zt( gr%nz-damping_profile%n_sponge_damp ) ) ) - damping_profile%tau_sponge_damp(k) = & - lin_int( gr%zt(k), gr%zt(gr%nz), & - gr%zt(gr%nz) - gr%zt( gr%nz-damping_profile%n_sponge_damp ) , & - settings%tau_sponge_damp_min, settings%tau_sponge_damp_max ) -! End Vince Larson's change - end do - - return - end subroutine initialize_tau_sponge_damp - - !--------------------------------------------------------------------------------------------- - subroutine finalize_tau_sponge_damp( damping_profile ) - ! - ! Description: - ! Frees memory allocated in initialize_tau_sponge_damp - ! - ! References: - ! None - !------------------------------------------------------------------------------------------- - implicit none - - ! Input/Output Variable(s) - type(sponge_damp_profile), intent(inout) :: & - damping_profile ! Information for damping the profile - - ! ---- Begin Code ---- - - deallocate( damping_profile%tau_sponge_damp ) - - return - end subroutine finalize_tau_sponge_damp - - -end module crmx_sponge_layer_damping diff --git a/src/physics/spcam/crm/CLUBB/crmx_stat_file_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_stat_file_module.F90 deleted file mode 100644 index 0818ecf1bd..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_stat_file_module.F90 +++ /dev/null @@ -1,94 +0,0 @@ -!------------------------------------------------------------------------------- -! $Id: stat_file_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -module crmx_stat_file_module - - -! Description: -! Contains two derived types for describing the contents and location of -! either NetCDF or GrADS files. -!------------------------------------------------------------------------------- - use crmx_clubb_precision, only: & - stat_rknd, & ! Variable - time_precision, & - core_rknd - - implicit none - - public :: variable, stat_file - - private ! Default scope - - ! Structure to hold the description of a variable - - type variable - ! Pointer to the array - real(kind=stat_rknd), dimension(:,:,:), pointer :: ptr - - character(len = 30) :: name ! Variable name - character(len = 100) :: description ! Variable description - character(len = 20) :: units ! Variable units - - integer :: indx ! NetCDF module Id for var / GrADS index - end type variable - - ! Structure to hold the description of a NetCDF output file - ! This makes the new code as compatible as possible with the - ! GrADS output code - - type stat_file - - ! File information - - character(len = 200) :: & - fname, & ! File name without suffix - fdir ! Path where fname resides - - integer :: iounit ! This number is used internally by the - ! NetCDF module to track the data set, or by - ! GrADS to track the actual file unit. - integer :: & - nrecord, & ! Number of records written - ntimes ! Number of times written - - logical :: & - l_defined, & ! Whether nf90_enddef() has been called - l_byte_swapped ! Is this a file in the opposite byte ordering? - - ! NetCDF datafile dimensions indices - integer :: & - LatDimId, LongDimId, AltDimId, TimeDimId, & - LatVarId, LongVarId, AltVarId, TimeVarId - - ! Grid information - - integer :: ia, iz ! Vertical extent - - integer :: nlat, nlon ! The number of points in the X and Y - - real( kind = core_rknd ), dimension(:), pointer :: & - z ! Height of vertical levels [m] - - ! Time information - - integer :: day, month, year ! Date of starting time - - real( kind = core_rknd ), dimension(:), pointer :: & - rlat, & ! Latitude [Degrees N] - rlon ! Longitude [Degrees E] - - real(kind=time_precision) :: & - dtwrite ! Interval between output [Seconds] - - real(kind=time_precision) :: & - time ! Start time [Seconds] - - ! Statistical Variables - - integer :: nvar ! Number of variables for this file - - type (variable), dimension(:), pointer :: & - var ! List and variable description - - end type stat_file - - end module crmx_stat_file_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_LH_sfc.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_LH_sfc.F90 deleted file mode 100644 index f25a867d2a..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_stats_LH_sfc.F90 +++ /dev/null @@ -1,106 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: stats_LH_sfc.F90 6100 2013-03-08 17:53:44Z dschanen@uwm.edu $ - -module crmx_stats_LH_sfc - - - implicit none - - private ! Set Default Scope - - public :: stats_init_LH_sfc - - ! Constant parameters - integer, parameter, public :: nvarmax_LH_sfc = 10 ! Maximum variables allowed - - contains - -!----------------------------------------------------------------------- - subroutine stats_init_LH_sfc( vars_LH_sfc, l_error ) - -! Description: -! Initializes array indices for LH_sfc -! References: -! None -!----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Constant(s) - - use crmx_stats_variables, only: & - LH_sfc ! Variable(s) - - use crmx_stats_variables, only: & - iLH_morr_rain_rate, & ! Variable(s) - iLH_morr_snow_rate, & - iLH_vwp, & - iLH_lwp - - use crmx_stats_type, only: & - stat_assign ! Procedure - - implicit none - - ! Input Variable - character(len= * ), dimension(nvarmax_LH_sfc), intent(in) :: vars_LH_sfc - - ! Output Variable - logical, intent(inout) :: l_error - - ! Local Varables - integer :: i, k - - ! ---- Begin Code ---- - - ! Default initialization for array indices for sfc - - iLH_morr_rain_rate = 0 - iLH_morr_snow_rate = 0 - iLH_vwp = 0 - iLH_lwp = 0 - - ! Assign pointers for statistics variables sfc - - k = 1 - do i=1,LH_sfc%nn - - select case ( trim( vars_LH_sfc(i) ) ) - - case ( 'LH_morr_rain_rate' ) - iLH_morr_rain_rate = k - call stat_assign( iLH_morr_rain_rate, "LH_morr_rain_rate", & - "Total precip fallout rate from Morrison scheme [mm/day]","mm/day", LH_sfc ) - k = k + 1 - - case ( 'LH_morr_snow_rate' ) - iLH_morr_snow_rate = k - call stat_assign( iLH_morr_snow_rate, "LH_morr_snow_rate", & - "Snow+Ice+Graupel fallout rate from Morrison scheme [mm/day]","mm/day", LH_sfc ) - k = k + 1 - - case ( 'LH_vwp' ) - iLH_vwp = k - call stat_assign( iLH_vwp, "LH_vwp", & - "Vapor water path [kg/m^2]","kg/m^2", LH_sfc ) - k = k + 1 - - case ( 'LH_lwp' ) - iLH_lwp = k - call stat_assign( iLH_lwp, "LH_lwp", & - "Liquid water path [kg/m^2]","kg/m^2", LH_sfc ) - k = k + 1 - - case default - write(fstderr,*) 'Error: unrecognized variable in vars_LH_sfc: ', & - trim( vars_LH_sfc(i) ) - l_error = .true. ! This will stop the run. - - end select - - end do - - return - end subroutine stats_init_LH_sfc - -end module crmx_stats_LH_sfc - diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_LH_zt.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_LH_zt.F90 deleted file mode 100644 index 9e48d884d6..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_stats_LH_zt.F90 +++ /dev/null @@ -1,478 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: stats_LH_zt.F90 5997 2012-12-18 20:47:09Z raut@uwm.edu $ - -module crmx_stats_LH_zt - - implicit none - - private ! Default Scope - - public :: stats_init_LH_zt - -! Constant parameters - integer, parameter, public :: nvarmax_LH_zt = 100 ! Maximum variables allowed - - contains - -!----------------------------------------------------------------------- - subroutine stats_init_LH_zt( vars_LH_zt, l_error ) - -! Description: -! Initializes array indices for zt - -! Note: -! All code that is within subroutine stats_init_zt, including variable -! allocation code, is not called if l_stats is false. This subroutine is -! called only when l_stats is true. - -!----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Constant(s) - - use crmx_stats_variables, only: & - LH_zt ! Variable - - use crmx_stats_variables, only: & - iAKm, & ! Variable(s) - iLH_AKm, & - iAKstd, & - iAKstd_cld, & - iAKm_rcm, & - iAKm_rcc - - use crmx_stats_variables, only: & - iLH_thlm_mc, & ! Variable(s) - iLH_rvm_mc, & - iLH_rcm_mc, & - iLH_Ncm_mc, & - iLH_rrainm_mc, & - iLH_Nrm_mc, & - iLH_rsnowm_mc, & - iLH_Nsnowm_mc, & - iLH_rgraupelm_mc, & - iLH_Ngraupelm_mc, & - iLH_ricem_mc, & - iLH_Nim_mc, & - iLH_Vrr, & - iLH_VNr, & - iLH_rcm_avg - - use crmx_stats_variables, only: & - iLH_rrainm, & ! Variable(s) - iLH_Nrm, & - iLH_ricem, & - iLH_Nim, & - iLH_rsnowm, & - iLH_Nsnowm, & - iLH_rgraupelm, & - iLH_Ngraupelm, & - iLH_thlm, & - iLH_rcm, & - iLH_Ncm, & - iLH_rvm, & - iLH_wm, & - iLH_wp2_zt, & - iLH_rcp2_zt, & - iLH_rtp2_zt, & - iLH_thlp2_zt, & - iLH_rrainp2_zt, & - iLH_Nrp2_zt, & - iLH_Ncp2_zt, & - iLH_cloud_frac, & - iLH_rrainm_auto, & - iLH_rrainm_accr - - - use crmx_stats_type, only: & - stat_assign ! Procedure - - implicit none - - ! Input Variable - character(len= * ), dimension(nvarmax_LH_zt), intent(in) :: vars_LH_zt - - ! Output Variable - logical, intent(inout) :: l_error - - ! Local Varables - integer :: i, k - - ! ---- Begin Code ---- - - ! Default initialization for array indices for LH_zt - - iAKm = 0 ! analytic Kessler. Vince Larson 22 May 2005 - iLH_AKm = 0 ! LH Kessler. Vince Larson 22 May 2005 - iAKstd = 0 - iAKstd_cld = 0 - iAKm_rcm = 0 - iAKm_rcc = 0 - - iLH_thlm_mc = 0 - iLH_rvm_mc = 0 - iLH_rcm_mc = 0 - iLH_Ncm_mc = 0 - iLH_rrainm_mc = 0 - iLH_Nrm_mc = 0 - iLH_rsnowm_mc = 0 - iLH_Nsnowm_mc = 0 - iLH_rgraupelm_mc = 0 - iLH_Ngraupelm_mc = 0 - iLH_ricem_mc = 0 - iLH_Nim_mc = 0 - - iLH_rcm_avg = 0 - - iLH_Vrr = 0 - iLH_VNr = 0 - - iLH_rrainm = 0 - iLH_ricem = 0 - iLH_rsnowm = 0 - iLH_rgraupelm = 0 - - iLH_Nrm = 0 - iLH_Nim = 0 - iLH_Nsnowm = 0 - iLH_Ngraupelm = 0 - - iLH_thlm = 0 - iLH_rcm = 0 - iLH_rvm = 0 - iLH_wm = 0 - iLH_cloud_frac = 0 - - iLH_wp2_zt = 0 - iLH_rcp2_zt = 0 - iLH_rtp2_zt = 0 - iLH_thlp2_zt = 0 - iLH_rrainp2_zt = 0 - iLH_Nrp2_zt = 0 - iLH_Ncp2_zt = 0 - - iLH_rrainm_auto = 0 - iLH_rrainm_accr = 0 - - ! Assign pointers for statistics variables zt - - k = 1 - do i=1,LH_zt%nn - - select case ( trim(vars_LH_zt(i)) ) - case ( 'AKm' ) ! Vince Larson 22 May 2005 - iAKm = k - call stat_assign( iAKm, "AKm", & - "Analytic Kessler ac [kg/kg]", "kg/kg", LH_zt ) - k = k + 1 - - case ( 'LH_AKm' ) ! Vince Larson 22 May 2005 - iLH_AKm = k - - call stat_assign( iLH_AKm, "LH_AKm", & - "LH Kessler estimate [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'AKstd' ) - iAKstd = k - - call stat_assign( iAKstd, "AKstd", & - "Exact standard deviation of gba Kessler [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'AKstd_cld' ) - iAKstd_cld = k - - call stat_assign( iAKstd_cld, "AKstd_cld", & - "Exact w/in cloud std of gba Kessler [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'AKm_rcm' ) - iAKm_rcm = k - - call stat_assign( iAKm_rcm, "AKm_rcm", & - "Exact local gba auto based on rcm [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'AKm_rcc' ) - iAKm_rcc = k - - call stat_assign( iAKm_rcc, "AKm_rcc", & - "Exact local gba based on w/in cloud rc [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'LH_rvm_mc' ) - iLH_rvm_mc = k - - call stat_assign( iLH_rvm_mc, "LH_rvm_mc", & - "Latin hypercube estimate of rvm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'LH_thlm_mc' ) - iLH_thlm_mc = k - - call stat_assign( iLH_thlm_mc, "LH_thlm_mc", & - "Latin hypercube estimate of thlm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'LH_rcm_mc' ) - iLH_rcm_mc = k - - call stat_assign( iLH_rcm_mc, "LH_rcm_mc", & - "Latin hypercube estimate of rcm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'LH_Ncm_mc' ) - iLH_Ncm_mc = k - - call stat_assign( iLH_Ncm_mc, "LH_Ncm_mc", & - "Latin hypercube estimate of Ncm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'LH_rrainm_mc' ) - iLH_rrainm_mc = k - - call stat_assign( iLH_rrainm_mc, "LH_rrainm_mc", & - "Latin hypercube estimate of rrainm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'LH_Nrm_mc' ) - iLH_Nrm_mc = k - - call stat_assign( iLH_Nrm_mc, "LH_Nrm_mc", & - "Latin hypercube estimate of Nrm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case('LH_rsnowm_mc') - iLH_rsnowm_mc = k - - call stat_assign( iLH_rsnowm_mc, "LH_rsnowm_mc", & - "Latin hypercube estimate of rsnowm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'LH_Nsnowm_mc' ) - iLH_Nsnowm_mc = k - - call stat_assign( iLH_Nsnowm_mc, "LH_Nsnowm_mc", & - "Latin hypercube estimate of Nsnowm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'LH_rgraupelm_mc' ) - iLH_rgraupelm_mc = k - - call stat_assign( iLH_rgraupelm_mc, "LH_rgraupelm_mc", & - "Latin hypercube estimate of rgraupelm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'LH_Ngraupelm_mc' ) - iLH_Ngraupelm_mc = k - - call stat_assign( iLH_Ngraupelm_mc, "LH_Ngraupelm_mc", & - "Latin hypercube estimate of Ngraupelm_mc [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'LH_ricem_mc' ) - iLH_ricem_mc = k - - call stat_assign( iLH_ricem_mc, "LH_ricem_mc", & - "Latin hypercube estimate of ricem_mc [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'LH_Nim_mc' ) - iLH_Nim_mc = k - - call stat_assign( iLH_Nim_mc, "LH_Nim_mc", & - "Latin hypercube estimate of Nim_mc [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'LH_Vrr' ) - iLH_Vrr = k - - call stat_assign( iLH_Vrr, "LH_Vrr", & - "Latin hypercube estimate of rrainm sedimentation velocity [m/s]", "m/s", LH_zt ) - k = k + 1 - - case ( 'LH_VNr' ) - iLH_VNr = k - - call stat_assign( iLH_VNr, "LH_VNr", & - "Latin hypercube estimate of Nrm sedimentation velocity [m/s]", "m/s", LH_zt ) - k = k + 1 - - case ( 'LH_rcm_avg' ) - iLH_rcm_avg = k - - call stat_assign( iLH_rcm_avg, "LH_rcm_avg", & - "Latin hypercube average estimate of rcm [kg/kg]", "kg/kg", LH_zt ) - - k = k + 1 - - case ( 'LH_rrainm' ) - iLH_rrainm = k - - call stat_assign( iLH_rrainm, "LH_rrainm", & - "Latin hypercube estimate of rrainm [kg/kg]", "kg/kg", LH_zt ) - k = k + 1 - - case ( 'LH_Nrm' ) - iLH_Nrm = k - - call stat_assign( iLH_Nrm, "LH_Nrm", & - "Latin hypercube estimate of Nrm [count/kg]", "count/kg", LH_zt ) - k = k + 1 - - case ( 'LH_ricem' ) - iLH_ricem = k - - call stat_assign( iLH_ricem, "LH_ricem", & - "Latin hypercube estimate of ricem [kg/kg]", "kg/kg", LH_zt ) - k = k + 1 - - case ( 'LH_Nim' ) - iLH_Nim = k - - call stat_assign( iLH_Nim, "LH_Nim", & - "Latin hypercube estimate of Nim [count/kg]", "count/kg", LH_zt ) - k = k + 1 - - case ( 'LH_rsnowm' ) - iLH_rsnowm = k - - call stat_assign( iLH_rsnowm, "LH_rsnowm", & - "Latin hypercube estimate of rsnowm [kg/kg]", "kg/kg", LH_zt ) - k = k + 1 - - case ( 'LH_Nsnowm' ) - iLH_Nsnowm = k - - call stat_assign( iLH_Nsnowm, "LH_Nsnowm", & - "Latin hypercube estimate of Nsnowm [count/kg]", "count/kg", LH_zt ) - k = k + 1 - - - case ( 'LH_rgraupelm' ) - iLH_rgraupelm = k - - call stat_assign( iLH_rgraupelm, "LH_rgraupelm", & - "Latin hypercube estimate of rgraupelm [kg/kg]", "kg/kg", LH_zt ) - k = k + 1 - - case ( 'LH_Ngraupelm' ) - iLH_Ngraupelm = k - - call stat_assign( iLH_Ngraupelm, "LH_Ngraupelm", & - "Latin hypercube estimate of Ngraupelm [kg/kg]", "kg/kg", LH_zt ) - k = k + 1 - - case ( 'LH_thlm' ) - iLH_thlm = k - - call stat_assign( iLH_thlm, "LH_thlm", & - "Latin hypercube estimate of thlm [K]", "K", LH_zt ) - k = k + 1 - - case ( 'LH_rcm' ) - iLH_rcm = k - - call stat_assign( iLH_rcm, "LH_rcm", & - "Latin hypercube estimate of rcm [kg/kg]", "kg/kg", LH_zt ) - k = k + 1 - - case ( 'LH_Ncm' ) - iLH_Ncm = k - - call stat_assign( iLH_Ncm, "LH_Ncm", & - "Latin hypercube estimate of Ncm [count/kg]", "count/kg", LH_zt ) - k = k + 1 - - - case ( 'LH_rvm' ) - iLH_rvm = k - - call stat_assign( iLH_rvm, "LH_rvm", & - "Latin hypercube estimate of rvm [kg/kg]", "kg/kg", LH_zt ) - k = k + 1 - - case ( 'LH_wm' ) - iLH_wm = k - - call stat_assign( iLH_wm, "LH_wm", & - "Latin hypercube estimate of vertical velocity [m/s]", "m/s", LH_zt ) - k = k + 1 - - case ( 'LH_cloud_frac' ) - iLH_cloud_frac = k - - ! Note: count is the udunits compatible unit - call stat_assign( iLH_cloud_frac, "LH_cloud_frac", & - "Latin hypercube estimate of cloud fraction [count]", "count", LH_zt ) - k = k + 1 - - case ( 'LH_wp2_zt' ) - iLH_wp2_zt = k - call stat_assign( iLH_wp2_zt, "LH_wp2_zt", & - "Variance of the latin hypercube estimate of w [m^2/s^2]", "m^2/s^2", LH_zt ) - k = k + 1 - - case ( 'LH_Ncp2_zt' ) - iLH_Ncp2_zt = k - call stat_assign( iLH_Ncp2_zt, "LH_Ncp2_zt", & - "Variance of the latin hypercube estimate of Nc [count^2/kg^2]", "count^2/kg^2", LH_zt ) - k = k + 1 - - case ( 'LH_Nrp2_zt' ) - iLH_Nrp2_zt = k - call stat_assign( iLH_Nrp2_zt, "LH_Nrp2_zt", & - "Variance of the latin hypercube estimate of Nr [count^2/kg^2]", "count^2/kg^2", LH_zt ) - k = k + 1 - - case ( 'LH_rcp2_zt' ) - iLH_rcp2_zt = k - call stat_assign( iLH_rcp2_zt, "LH_rcp2_zt", & - "Variance of the latin hypercube estimate of rc [kg^2/kg^2]", "kg^2/kg^2", LH_zt ) - k = k + 1 - - case ( 'LH_rtp2_zt' ) - iLH_rtp2_zt = k - call stat_assign( iLH_rtp2_zt, "LH_rtp2_zt", & - "Variance of the latin hypercube estimate of rt [kg^2/kg^2]", "kg^2/kg^2", LH_zt ) - k = k + 1 - - case ( 'LH_thlp2_zt' ) - iLH_thlp2_zt = k - call stat_assign( iLH_thlp2_zt, "LH_thlp2_zt", & - "Variance of the latin hypercube estimate of thl [K^2]", "K^2", LH_zt ) - k = k + 1 - - case ( 'LH_rrainp2_zt' ) - iLH_rrainp2_zt = k - call stat_assign( iLH_rrainp2_zt, "LH_rrainp2_zt", & - "Variance of the latin hypercube estimate of rrain [kg^2/kg^2]", "kg^2/kg^2", LH_zt ) - k = k + 1 - - case ( 'LH_rrainm_auto' ) - iLH_rrainm_auto = k - call stat_assign( iLH_rrainm_auto, "LH_rrainm_auto", & - "Latin hypercube estimate of autoconversion [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case ( 'LH_rrainm_accr' ) - iLH_rrainm_accr = k - call stat_assign( iLH_rrainm_accr, "LH_rrainm_accr", & - "Latin hypercube estimate of accretion [kg/kg/s]", "kg/kg/s", LH_zt ) - k = k + 1 - - case default - - write(fstderr,*) 'Error: unrecognized variable in vars_LH_zt: ', trim( vars_LH_zt(i) ) - - l_error = .true. ! This will stop the run. - - end select - - end do - - return - end subroutine stats_init_LH_zt - -end module crmx_stats_LH_zt diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zm.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zm.F90 deleted file mode 100644 index 8e12d00fd7..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zm.F90 +++ /dev/null @@ -1,157 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: stats_rad_zm.F90 4032 2009-08-17 21:45:29Z senkbeil@uwm.edu $ - -module crmx_stats_rad_zm - - implicit none - - private ! Default Scope - - public :: stats_init_rad_zm - -! Constant parameters - integer, parameter, public :: nvarmax_rad_zm = 250 ! Maximum variables allowed - - contains - -!----------------------------------------------------------------------- - subroutine stats_init_rad_zm( vars_rad_zm, l_error ) - -! Description: -! Initializes array indices for rad_zm variables -!----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Constant(s) - - use crmx_stats_variables, only: & - rad_zm, & - iFrad_LW_rad, & ! Variable(s) - iFrad_SW_rad, & - iFrad_SW_up_rad, & - iFrad_LW_up_rad, & - iFrad_SW_down_rad, & - iFrad_LW_down_rad - - use crmx_stats_variables, only: & - ifulwcl, ifdlwcl, ifdswcl, ifuswcl ! Variable(s) - - use crmx_stats_type, only: & - stat_assign ! Procedure - - - implicit none - - ! Input Variable - character(len= * ), dimension(nvarmax_rad_zm), intent(in) :: vars_rad_zm - - ! Input/Output Variable - logical, intent(inout) :: l_error - - ! Local Varables - integer :: i, k - - ! ---- Begin Code ---- - - ! Default initialization for array indices for rad_zm - - iFrad_LW_rad = 0 - iFrad_SW_rad = 0 - iFrad_SW_up_rad = 0 - iFrad_LW_up_rad = 0 - iFrad_SW_down_rad = 0 - iFrad_LW_down_rad = 0 - - ifulwcl = 0 - ifdlwcl = 0 - ifdswcl = 0 - ifuswcl = 0 - -! Assign pointers for statistics variables rad_zm - - k = 1 - do i=1,rad_zm%nn - - select case ( trim(vars_rad_zm(i)) ) - - case('fulwcl') - ifulwcl = k - call stat_assign( ifulwcl, "fulwcl", & - "Upward clear-sky LW flux [W/m^2]", "W/m^2", rad_zm ) - k = k + 1 - - case( 'fdlwcl' ) - ifdlwcl = k - call stat_assign( ifdlwcl, "fdlwcl", & - "Downward clear-sky LW flux [W/m^2]", "W/m^2", rad_zm ) - k = k + 1 - - case( 'fdswcl' ) - ifdswcl = k - call stat_assign( ifdswcl, "fdswcl", & - "Downward clear-sky SW flux [W/m^2]", "W/m^2", rad_zm ) - k = k + 1 - - case( 'fuswcl' ) - ifuswcl = k - call stat_assign( ifuswcl, "fuswcl", & - "Upward clear-sky SW flux [W/m^2]", "W/m^2", rad_zm ) - k = k + 1 - - case ('Frad_LW_rad') - iFrad_LW_rad = k - - call stat_assign( iFrad_LW_rad, "Frad_LW_rad", & - "Net long-wave radiative flux [W/m^2]", "W/m^2", rad_zm ) - k = k + 1 - - case ('Frad_SW_rad') - iFrad_SW_rad = k - - call stat_assign( iFrad_SW_rad, "Frad_SW_rad", & - "Net short-wave radiative flux [W/m^2]", "W/m^2", rad_zm ) - k = k + 1 - - case ('Frad_SW_up_rad') - iFrad_SW_up_rad = k - - call stat_assign( iFrad_SW_up_rad, "Frad_SW_up_rad", & - "Short-wave upwelling radiative flux [W/m^2]", "W/m^2", rad_zm ) - k = k + 1 - - case ('Frad_LW_up_rad') - iFrad_LW_up_rad = k - - call stat_assign( iFrad_LW_up_rad, "Frad_LW_up_rad", & - "Long-wave upwelling radiative flux [W/m^2]", "W/m^2", rad_zm ) - k = k + 1 - - case ('Frad_SW_down_rad') - iFrad_SW_down_rad = k - - call stat_assign( iFrad_SW_down_rad, "Frad_SW_down_rad", & - "Short-wave downwelling radiative flux [W/m^2]", "W/m^2", rad_zm ) - k = k + 1 - - case ('Frad_LW_down_rad') - iFrad_LW_down_rad = k - - call stat_assign( iFrad_LW_down_rad, "Frad_LW_down_rad", & - "Long-wave downwelling radiative flux [W/m^2]", "W/m^2", rad_zm ) - k = k + 1 - - case default - - write(fstderr,*) 'Error: unrecognized variable in vars_rad_zm: ', trim( vars_rad_zm(i) ) - - l_error = .true. ! This will stop the run. - - - end select - - end do - - return - end subroutine stats_init_rad_zm - -end module crmx_stats_rad_zm diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zt.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zt.F90 deleted file mode 100644 index 541fc2442b..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_stats_rad_zt.F90 +++ /dev/null @@ -1,163 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: stats_rad_zt.F90 4032 2009-08-17 21:45:29Z senkbeil@uwm.edu $ - -module crmx_stats_rad_zt - - implicit none - - private ! Default Scope - - public :: stats_init_rad_zt - - ! Constant parameters - integer, parameter, public :: nvarmax_rad_zt = 250 ! Maximum variables allowed - - contains - -!----------------------------------------------------------------------- - subroutine stats_init_rad_zt( vars_rad_zt, l_error ) - -! Description: -! Initializes array indices for zt -! -! References: -! None -!----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Constant(s) - - use crmx_stats_variables, only: & - rad_zt, & - iT_in_K_rad, & ! Variable(s) - ircil_rad, & - io3l_rad, & - irsnowm_rad, & - ircm_in_cloud_rad, & - icloud_frac_rad, & - iice_supersat_frac_rad, & - iradht_rad, & - iradht_LW_rad, & - iradht_SW_rad - - use crmx_stats_type, only: & - stat_assign ! Procedure - - implicit none - - ! Input Variable - character(len= * ), dimension(nvarmax_rad_zt), intent(in) :: vars_rad_zt - - ! Input/Output Variable - logical, intent(inout) :: l_error - - ! Local Varables - integer :: i, k - - ! ---- Begin Code ---- - - ! Default initialization for array indices for rad_zt - - iT_in_K_rad = 0 - ircil_rad = 0 - io3l_rad = 0 - irsnowm_rad = 0 - ircm_in_cloud_rad = 0 - icloud_frac_rad = 0 - iice_supersat_frac_rad = 0 - iradht_rad = 0 - iradht_LW_rad = 0 - iradht_SW_rad = 0 - - ! Assign pointers for statistics variables rad_zt - - k = 1 - do i=1,rad_zt%nn - - select case ( trim(vars_rad_zt(i)) ) - - case ('T_in_K_rad') - iT_in_K_rad = k - - call stat_assign( iT_in_K_rad, "T_in_K_rad", & - "Temperature [K]", "K", rad_zt ) - k = k + 1 - - case ('rcil_rad') - ircil_rad = k - - call stat_assign( ircil_rad, "rcil_rad", & - "Ice mixing ratio [kg/kg]", "kg/kg", rad_zt ) - k = k + 1 - - case ('o3l_rad') - io3l_rad = k - - call stat_assign( io3l_rad, "o3l_rad", & - "Ozone mixing ratio [kg/kg]", "kg/kg", rad_zt ) - k = k + 1 - - case ('rsnowm_rad') - irsnowm_rad = k - - call stat_assign( irsnowm_rad, "rsnowm_rad", & - "Snow water mixing ratio [kg/kg]", "kg/kg", rad_zt ) - k = k + 1 - - case ('rcm_in_cloud_rad') - ircm_in_cloud_rad = k - - call stat_assign( ircm_in_cloud_rad, "rcm_in_cloud_rad", & - "rcm in cloud layer [kg/kg]", "kg/kg", rad_zt ) - k = k + 1 - - case ('cloud_frac_rad') - icloud_frac_rad = k - - call stat_assign( icloud_frac_rad, "cloud_frac_rad", & - "Cloud fraction (between 0 and 1) [-]", "count", rad_zt ) - k = k + 1 - - case ('ice_supersat_frac_rad') - iice_supersat_frac_rad = k - - call stat_assign( iice_supersat_frac_rad, "ice_supersat_frac_rad", & - "Ice cloud fraction (between 0 and 1) [-]", "count", rad_zt ) - k = k + 1 - - case ('radht_rad') - iradht_rad = k - - call stat_assign( iradht_rad, "radht_rad", & - "Total radiative heating rate [K/s]", "K/s", rad_zt ) - k = k + 1 - - case ('radht_LW_rad') - iradht_LW_rad = k - - call stat_assign( iradht_LW_rad, "radht_LW_rad", & - "Long-wave radiative heating rate [K/s]", "K/s", rad_zt ) - k = k + 1 - - case ('radht_SW_rad') - iradht_SW_rad = k - - call stat_assign( iradht_SW_rad, "radht_SW_rad", & - "Short-wave radiative heating rate [K/s]", "K/s", rad_zt ) - k = k + 1 - - case default - - write(fstderr,*) 'Error: unrecognized variable in vars_rad_zt: ', trim( vars_rad_zt(i) ) - - l_error = .true. ! This will stop the run. - - - end select - - end do - - return - end subroutine stats_init_rad_zt - -end module crmx_stats_rad_zt diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_sfc.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_sfc.F90 deleted file mode 100644 index fdea934be5..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_stats_sfc.F90 +++ /dev/null @@ -1,469 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: stats_sfc.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ - -module crmx_stats_sfc - - - implicit none - - private ! Set Default Scope - - public :: stats_init_sfc - - ! Constant parameters - integer, parameter, public :: nvarmax_sfc = 250 ! Maximum variables allowed - - contains - -!----------------------------------------------------------------------- - subroutine stats_init_sfc( vars_sfc, l_error ) - -! Description: -! Initializes array indices for sfc -! References: -! None -!----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Constant(s) - - use crmx_stats_variables, only: & - sfc, & ! Variables - iustar, & - isoil_heat_flux, & - iveg_T_in_K, & - isfc_soil_T_in_K,& - ideep_soil_T_in_K, & - ilh, & - ish, & - icc, & - ilwp, & - ivwp, & - iiwp, & - iswp, & - irwp, & - iz_cloud_base, & - iz_inversion, & - irain_rate_sfc, & - irain_flux_sfc, & - irrainm_sfc - - use crmx_stats_variables, only: & - iwpthlp_sfc, & - iwprtp_sfc, & - iupwp_sfc, & - ivpwp_sfc, & - ithlm_vert_avg, & - irtm_vert_avg, & - ium_vert_avg, & - ivm_vert_avg, & - iwp2_vert_avg, & - iup2_vert_avg, & - ivp2_vert_avg, & - irtp2_vert_avg, & - ithlp2_vert_avg, & - iT_sfc - - use crmx_stats_variables, only: & - iwp23_matrix_condt_num, & - irtm_matrix_condt_num, & - ithlm_matrix_condt_num, & - irtp2_matrix_condt_num, & - ithlp2_matrix_condt_num, & - irtpthlp_matrix_condt_num, & - iup2_vp2_matrix_condt_num, & - iwindm_matrix_condt_num - - use crmx_stats_variables, only: & - imorr_rain_rate, & - imorr_snow_rate - - use crmx_stats_variables, only: & - irtm_spur_src, & - ithlm_spur_src - - use crmx_stats_type, only: & - stat_assign ! Procedure - - implicit none - - ! Input Variable - character(len= * ), dimension(nvarmax_sfc), intent(in) :: vars_sfc - - ! Output Variable - logical, intent(inout) :: l_error - - ! Local Varables - integer :: i, k - - ! ---- Begin Code ---- - - ! Default initialization for array indices for sfc - - isoil_heat_flux = 0 - iveg_T_in_K = 0 - isfc_soil_T_in_K = 0 - ideep_soil_T_in_K = 0 - - iustar = 0 - ilh = 0 - ish = 0 - icc = 0 - ilwp = 0 - irwp = 0 - ivwp = 0 ! nielsenb - iiwp = 0 ! nielsenb - iswp = 0 ! nielsenb - iz_cloud_base = 0 - iz_inversion = 0 - irain_rate_sfc = 0 ! Brian - irain_flux_sfc = 0 ! Brian - irrainm_sfc = 0 ! Brian - iwpthlp_sfc = 0 - iwprtp_sfc = 0 - iupwp_sfc = 0 - ivpwp_sfc = 0 - ithlm_vert_avg = 0 - irtm_vert_avg = 0 - ium_vert_avg = 0 - ivm_vert_avg = 0 - iwp2_vert_avg = 0 ! nielsenb - iup2_vert_avg = 0 - ivp2_vert_avg = 0 - irtp2_vert_avg = 0 - ithlp2_vert_avg = 0 - iT_sfc = 0 ! kcwhite - - ! These are estimates of the condition number on each LHS - ! matrix, and not located at the surface of the domain. - iwp23_matrix_condt_num = 0 - irtm_matrix_condt_num = 0 - ithlm_matrix_condt_num = 0 - irtp2_matrix_condt_num = 0 - ithlp2_matrix_condt_num = 0 - irtpthlp_matrix_condt_num = 0 - iup2_vp2_matrix_condt_num = 0 - iwindm_matrix_condt_num = 0 - - imorr_rain_rate = 0 - imorr_snow_rate = 0 - - irtm_spur_src = 0 - ithlm_spur_src = 0 - - ! Assign pointers for statistics variables sfc - - k = 1 - do i=1,sfc%nn - - select case ( trim(vars_sfc(i)) ) - case ('soil_heat_flux') - isoil_heat_flux = k - - call stat_assign(isoil_heat_flux, "soil_heat_flux", & - "soil_heat_flux[W/m^2]","W/m^2",sfc ) - k = k + 1 - case ('ustar') - iustar = k - - call stat_assign(iustar,"ustar", & - "Friction velocity [m/s]","m/s",sfc) - k = k + 1 - case ('veg_T_in_K') - iveg_T_in_K = k - - call stat_assign(iveg_T_in_K,"veg_T_in_K", & - "Surface Vegetation Temperature [K]","K",sfc) - k = k + 1 - case ('sfc_soil_T_in_K') - isfc_soil_T_in_K = k - - call stat_assign(isfc_soil_T_in_K,"sfc_soil_T_in_K", & - "Surface soil temperature [K]","K",sfc) - k = k + 1 - case ('deep_soil_T_in_K') - ideep_soil_T_in_K = k - - call stat_assign(ideep_soil_T_in_K,"deep_soil_T_in_K", & - "Deep soil Temperature [K]","K",sfc) - k = k + 1 - - case ('lh') - ilh = k - call stat_assign(ilh,"lh", & - "Surface latent heating [W/m^2]","W/m2",sfc) - k = k + 1 - - case ('sh') - ish = k - call stat_assign(ish,"sh", & - "Surface sensible heating [W/m^2]","W/m2",sfc) - k = k + 1 - - case ('cc') - icc = k - call stat_assign(icc,"cc", & - "Cloud cover [count]","count",sfc) - k = k + 1 - - case ('lwp') - ilwp = k - call stat_assign(ilwp,"lwp", & - "Liquid water path [kg/m^2]","kg/m2",sfc) - k = k + 1 - - case ('vwp') - ivwp = k - call stat_assign(ivwp,"vwp", & - "Vapor water path [kg/m^2]","kg/m2",sfc) - k = k + 1 - - case ('iwp') - iiwp = k - call stat_assign(iiwp,"iwp", & - "Ice water path [kg/m^2]","kg/m2",sfc) - k = k + 1 - - case ('swp') - iswp = k - call stat_assign(iswp,"swp", & - "Snow water path [kg/m^2]","kg/m2",sfc) - k = k + 1 - - case ('rwp') - irwp = k - call stat_assign(irwp,"rwp", & - "Rain water path [kg/m^2]","kg/m2",sfc) - k = k + 1 - - case ('z_cloud_base') - iz_cloud_base = k - call stat_assign(iz_cloud_base,"z_cloud_base", & - "Cloud base altitude [m]","m",sfc) - k = k + 1 - - case ('z_inversion') - iz_inversion = k - call stat_assign(iz_inversion,"z_inversion", & - "Inversion altitude [m]","m",sfc) - k = k + 1 - - case ('rain_rate_sfc') ! Brian - irain_rate_sfc = k - call stat_assign(irain_rate_sfc,"rain_rate_sfc", & - "Surface rainfall rate [mm/day]","mm/day",sfc) - k = k + 1 - - case ('rain_flux_sfc') ! Brian - irain_flux_sfc = k - - call stat_assign( irain_flux_sfc,"rain_flux_sfc", & - "Surface rain flux [W/m^2]", "W/m^2", sfc ) - k = k + 1 - - case ('rrainm_sfc') ! Brian - irrainm_sfc = k - - call stat_assign(irrainm_sfc,"rrainm_sfc", & - "Surface rain water mixing ratio [kg/kg]","kg/kg",sfc) - k = k + 1 - - case ( 'morr_rain_rate' ) - imorr_rain_rate = k - call stat_assign( imorr_rain_rate, "morr_rain_rate", & - "Total precip fallout rate from Morrison scheme [mm/day]","mm/day", sfc ) - k = k + 1 - - case ( 'morr_snow_rate' ) - imorr_snow_rate = k - call stat_assign( imorr_snow_rate, "morr_snow_rate", & - "Snow+Ice+Graupel fallout rate from Morrison scheme [mm/day]","mm/day", sfc ) - k = k + 1 - - case ('wpthlp_sfc') - iwpthlp_sfc = k - - call stat_assign(iwpthlp_sfc,"wpthlp_sfc", & - "wpthlp surface flux [K m/s]","K m/s",sfc) - k = k + 1 - - case ('wprtp_sfc') - iwprtp_sfc = k - - call stat_assign(iwprtp_sfc,"wprtp_sfc", & - "wprtp surface flux [kg/kg]","(kg/kg) m/s",sfc) - k = k + 1 - - case ('upwp_sfc') - iupwp_sfc = k - - call stat_assign(iupwp_sfc,"upwp_sfc", & - "upwp surface flux [m^2/s^2]","m^2/s^2",sfc) - k = k + 1 - - case ('vpwp_sfc') - ivpwp_sfc = k - - call stat_assign(ivpwp_sfc,"vpwp_sfc", & - "vpwp surface flux [m^2/s^2]","m^2/s^2",sfc) - k = k + 1 - - case ('thlm_vert_avg') - ithlm_vert_avg = k - - call stat_assign( ithlm_vert_avg, "thlm_vert_avg", & - "Vertical average (density-weighted) of thlm [K]", "K", sfc ) - k = k + 1 - - case ('rtm_vert_avg') - irtm_vert_avg = k - - call stat_assign( irtm_vert_avg, "rtm_vert_avg", & - "Vertical average (density-weighted) of rtm [kg/kg]", "kg/kg", sfc ) - k = k + 1 - - case ('um_vert_avg') - ium_vert_avg = k - - call stat_assign( ium_vert_avg, "um_vert_avg", & - "Vertical average (density-weighted) of um [m/s]", "m/s", sfc ) - k = k + 1 - - case ('vm_vert_avg') - ivm_vert_avg = k - - call stat_assign( ivm_vert_avg, "vm_vert_avg", & - "Vertical average (density-weighted) of vm [m/s]", "m/s", sfc ) - k = k + 1 - - case ('wp2_vert_avg') - iwp2_vert_avg = k - - call stat_assign( iwp2_vert_avg, "wp2_vert_avg", & - "Vertical average (density-weighted) of wp2 [m^2/s^2]", "m^2/s^2", & - sfc ) - k = k + 1 - - case ('up2_vert_avg') - iup2_vert_avg = k - - call stat_assign( iup2_vert_avg, "up2_vert_avg", & - "Vertical average (density-weighted) of up2 [m^2/s^2]", "m^2/s^2", & - sfc ) - k = k + 1 - - case ('vp2_vert_avg') - ivp2_vert_avg = k - - call stat_assign( ivp2_vert_avg, "vp2_vert_avg", & - "Vertical average (density-weighted) of vp2 [m^2/s^2]", "m^2/s^2", & - sfc ) - k = k + 1 - - case ('rtp2_vert_avg') - irtp2_vert_avg = k - - call stat_assign( irtp2_vert_avg, "rtp2_vert_avg", & - "Vertical average (density-weighted) of rtp2 [kg^2/kg^2]", & - "kg^2/kg^2", sfc ) - k = k + 1 - - case ('thlp2_vert_avg') - ithlp2_vert_avg = k - - call stat_assign( ithlp2_vert_avg, "thlp2_vert_avg", & - "Vertical average (density-weighted) of thlp2 [K^2]", "K^2", sfc ) - k = k + 1 - - case ('T_sfc') - iT_sfc = k - - call stat_assign( iT_sfc, "T_sfc", "Surface Temperature [K]", "K", sfc ) - k = k + 1 - - case ('wp23_matrix_condt_num') - iwp23_matrix_condt_num = k - call stat_assign(iwp23_matrix_condt_num,"wp23_matrix_condt_num", & - "Estimate of the condition number for wp2/3 [count]","count",sfc) - k = k + 1 - - case ('thlm_matrix_condt_num') - ithlm_matrix_condt_num = k - call stat_assign(ithlm_matrix_condt_num,"thlm_matrix_condt_num", & - "Estimate of the condition number for thlm/wpthlp [count]", & - "count",sfc) - k = k + 1 - - case ('rtm_matrix_condt_num') - irtm_matrix_condt_num = k - - call stat_assign(irtm_matrix_condt_num,"rtm_matrix_condt_num", & - "Estimate of the condition number for rtm/wprtp [count]", & - "count",sfc) - k = k + 1 - - case ('thlp2_matrix_condt_num') - ithlp2_matrix_condt_num = k - - call stat_assign(ithlp2_matrix_condt_num,"thlp2_matrix_condt_num", & - "Estimate of the condition number for thlp2 [count]", & - "count",sfc) - k = k + 1 - - case ('rtp2_matrix_condt_num') - irtp2_matrix_condt_num = k - call stat_assign(irtp2_matrix_condt_num,"rtp2_matrix_condt_num", & - "Estimate of the condition number for rtp2 [count]", & - "count",sfc) - k = k + 1 - - case ('rtpthlp_matrix_condt_num') - irtpthlp_matrix_condt_num = k - call stat_assign(irtpthlp_matrix_condt_num,"rtpthlp_matrix_condt_num", & - "Estimate of the condition number for rtpthlp [count]", & - "count",sfc) - k = k + 1 - - case ('up2_vp2_matrix_condt_num') - iup2_vp2_matrix_condt_num = k - call stat_assign(iup2_vp2_matrix_condt_num,"up2_vp2_matrix_condt_num", & - "Estimate of the condition number for up2/vp2 [count]","count",sfc) - k = k + 1 - - case ('windm_matrix_condt_num') - iwindm_matrix_condt_num = k - call stat_assign(iwindm_matrix_condt_num,"windm_matrix_condt_num", & - "Estimate of the condition number for the mean wind [count]","count",sfc) - - k = k + 1 - - case ('rtm_spur_src') - irtm_spur_src = k - - call stat_assign(irtm_spur_src, "rtm_spur_src", & - "rtm spurious source [kg/(m^2 s)]", "kg/(m^2 s)",sfc ) - k = k + 1 - - case ('thlm_spur_src') - ithlm_spur_src = k - - call stat_assign(ithlm_spur_src, "thlm_spur_src", & - "thlm spurious source [(K kg) / (m^2 s)]", "(K kg) / (m^2 s)",sfc ) - k = k + 1 - - case default - write(fstderr,*) 'Error: unrecognized variable in vars_sfc: ', & - trim( vars_sfc(i) ) - l_error = .true. ! This will stop the run. - - end select - - end do - - return - - end subroutine stats_init_sfc - - -end module crmx_stats_sfc - diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_subs.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_subs.F90 deleted file mode 100644 index 8245c378db..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_stats_subs.F90 +++ /dev/null @@ -1,2679 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: stats_subs.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ -module crmx_stats_subs - - implicit none - - private ! Set Default Scope - - public :: stats_init, stats_begin_timestep, stats_end_timestep, & - stats_accumulate, stats_finalize, stats_accumulate_hydromet, & - stats_accumulate_LH_tend - - private :: stats_zero, stats_avg - - contains - - !----------------------------------------------------------------------- - subroutine stats_init( iunit, fname_prefix, fdir, l_stats_in, & - stats_fmt_in, stats_tsamp_in, stats_tout_in, fnamelist, & - nzmax, gzt, gzm, nnrad_zt, & - grad_zt, nnrad_zm, grad_zm, day, month, year, & - rlat, rlon, time_current, delt ) - ! - ! Description: - ! Initializes the statistics saving functionality of the CLUBB model. - ! - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_stats_variables, only: & - zt, & ! Variables - ztscr01, & - ztscr02, & - ztscr03, & - ztscr04, & - ztscr05, & - ztscr06, & - ztscr07, & - ztscr08, & - ztscr09, & - ztscr10, & - ztscr11, & - ztscr12, & - ztscr13, & - ztscr14, & - ztscr15, & - ztscr16, & - ztscr17, & - ztscr18, & - ztscr19, & - ztscr20, & - ztscr21 - - use crmx_stats_variables, only: & - LH_zt, & ! Variable(s) - LH_sfc - - use crmx_stats_variables, only: & - zm, & ! Variables - zmscr01, & - zmscr02, & - zmscr03, & - zmscr04, & - zmscr05, & - zmscr06, & - zmscr07, & - zmscr08, & - zmscr09, & - zmscr10, & - zmscr11, & - zmscr12, & - zmscr13, & - zmscr14, & - zmscr15, & - zmscr16, & - zmscr17, & - rad_zt - - use crmx_stats_variables, only: & - rad_zm, & - sfc, & - l_stats, & - l_output_rad_files, & - stats_tsamp, & - stats_tout, & - l_stats_samp, & - l_stats_last, & - fname_zt, & - fname_LH_zt, & - fname_LH_sfc, & - fname_zm, & - fname_rad_zt, & - fname_rad_zm, & - fname_sfc, & - l_netcdf, & - l_grads - - use crmx_clubb_precision, only: & - time_precision, & ! Constant(s) - core_rknd - - use crmx_output_grads, only: & - open_grads ! Procedure - -#ifdef NETCDF - use crmx_output_netcdf, only: & - open_netcdf ! Procedure -#endif - - use crmx_stats_zm, only: & - nvarmax_zm, & ! Constant(s) - stats_init_zm ! Procedure(s) - - use crmx_stats_zt, only: & - nvarmax_zt, & ! Constant(s) - stats_init_zt ! Procedure(s) - - use crmx_stats_LH_zt, only: & - nvarmax_LH_zt, & ! Constant(s) - stats_init_LH_zt ! Procedure(s) - - use crmx_stats_LH_sfc, only: & - nvarmax_LH_sfc, & ! Constant(s) - stats_init_LH_sfc ! Procedure(s) - - use crmx_stats_rad_zt, only: & - nvarmax_rad_zt, & ! Constant(s) - stats_init_rad_zt ! Procedure(s) - - use crmx_stats_rad_zm, only: & - nvarmax_rad_zm, & ! Constant(s) - stats_init_rad_zm ! Procedure(s) - - use crmx_stats_sfc, only: & - nvarmax_sfc, & ! Constant(s) - stats_init_sfc ! Procedure(s) - - use crmx_error_code, only: & - clubb_at_least_debug_level ! Function - - use crmx_constants_clubb, only: & - fstdout, fstderr, var_length ! Constants - - use crmx_parameters_microphys, only: & - LH_microphys_disabled, & ! Constant - LH_microphys_type ! Variable - - implicit none - - ! Input Variables - - integer, intent(in) :: iunit ! File unit for fnamelist - - character(len=*), intent(in) :: & - fname_prefix, & ! Start of the stats filenames - fdir ! Directory to output to - - logical, intent(in) :: l_stats_in ! Stats on? T/F - - character(len=*), intent(in) :: & - stats_fmt_in ! Format of the stats file output - - real(kind=time_precision), intent(in) :: & - stats_tsamp_in, & ! Sampling interval [s] - stats_tout_in ! Output interval [s] - - character(len=*), intent(in) :: & - fnamelist ! Filename holding the &statsnl - - integer, intent(in) :: nzmax ! Grid points in the vertical [count] - - real( kind = core_rknd ), intent(in), dimension(nzmax) :: & - gzt, gzm ! Thermodynamic and momentum levels [m] - - integer, intent(in) :: nnrad_zt ! Grid points in the radiation grid [count] - - real( kind = core_rknd ), intent(in), dimension(nnrad_zt) :: grad_zt ! Radiation levels [m] - - integer, intent(in) :: nnrad_zm ! Grid points in the radiation grid [count] - - real( kind = core_rknd ), intent(in), dimension(nnrad_zm) :: grad_zm ! Radiation levels [m] - - integer, intent(in) :: day, month, year ! Time of year - - real( kind = core_rknd ), dimension(1), intent(in) :: & - rlat, rlon ! Latitude and Longitude [Degrees N/E] - - real(kind=time_precision), intent(in) :: & - time_current ! Model time [s] - - real(kind=time_precision), intent(in) :: & - delt ! Timestep (dt_main in CLUBB) [s] - - - ! Local Variables - logical :: l_error - - character(len=200) :: fname - - integer :: i, ntot, read_status - - ! Namelist Variables - - character(len=10) :: stats_fmt ! File storage convention - - character(len=var_length), dimension(nvarmax_zt) :: & - vars_zt ! Variables on the thermodynamic levels - - character(len=var_length), dimension(nvarmax_LH_zt) :: & - vars_LH_zt ! Latin Hypercube variables on the thermodynamic levels - - character(len=var_length), dimension(nvarmax_LH_sfc) :: & - vars_LH_sfc ! Latin Hypercube variables at the surface - - character(len=var_length), dimension(nvarmax_zm) :: & - vars_zm ! Variables on the momentum levels - - character(len=var_length), dimension(nvarmax_rad_zt) :: & - vars_rad_zt ! Variables on the radiation levels - - character(len=var_length), dimension(nvarmax_rad_zm) :: & - vars_rad_zm ! Variables on the radiation levels - - character(len=var_length), dimension(nvarmax_sfc) :: & - vars_sfc ! Variables at the model surface - - namelist /statsnl/ & - vars_zt, & - vars_zm, & - vars_LH_zt, & - vars_LH_sfc, & - vars_rad_zt, & - vars_rad_zm, & - vars_sfc - - ! ---- Begin Code ---- - - ! Initialize - l_error = .false. - - ! Set stats_variables variables with inputs from calling subroutine - l_stats = l_stats_in - - stats_tsamp = stats_tsamp_in - stats_tsamp = stats_tsamp_in - stats_tout = stats_tout_in - stats_fmt = trim( stats_fmt_in ) - - if ( .not. l_stats ) then - l_stats_samp = .false. - l_stats_last = .false. - return - end if - - ! Initialize namelist variables - - vars_zt = '' - vars_zm = '' - vars_LH_zt = '' - vars_LH_sfc = '' - vars_rad_zt = '' - vars_rad_zm = '' - vars_sfc = '' - - ! Reads list of variables that should be output to GrADS/NetCDF (namelist &statsnl) - - open(unit=iunit, file=fnamelist) - read(unit=iunit, nml=statsnl, iostat=read_status, end=100) - if ( read_status /= 0 ) then - if ( read_status > 0 ) then - write(fstderr,*) "Error reading stats namelist in file ", & - trim( fnamelist ) - else ! Read status < 0 - write(fstderr,*) "End of file marker reached while reading stats namelist in file ", & - trim( fnamelist ) - end if - write(fstderr,*) "One cause is having more statistical variables ", & - "listed in the namelist for var_zt, var_zm, or ", & - "var_sfc than allowed by nvarmax_zt, nvarmax_zm, ", & - "or nvarmax_sfc, respectively." - write(fstderr,*) "Maximum variables allowed for var_zt = ", nvarmax_zt - write(fstderr,*) "Maximum variables allowed for var_zm = ", nvarmax_zm - write(fstderr,*) "Maximum variables allowed for var_rad_zt = ", nvarmax_rad_zt - write(fstderr,*) "Maximum variables allowed for var_rad_zm = ", nvarmax_rad_zm - write(fstderr,*) "Maximum variables allowed for var_sfc = ", nvarmax_sfc - stop "stats_init: Error reading stats namelist." - end if ! read_status /= 0 - - close(unit=iunit) - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstdout,*) "--------------------------------------------------" - - write(fstdout,*) "Statistics" - - write(fstdout,*) "--------------------------------------------------" - write(fstdout,*) "vars_zt = " - i = 1 - do while ( vars_zt(i) /= '' ) - write(fstdout,*) vars_zt(i) - i = i + 1 - end do - - write(fstdout,*) "vars_zm = " - i = 1 - do while ( vars_zm(i) /= '' ) - write(fstdout,*) vars_zm(i) - i = i + 1 - end do - - if ( LH_microphys_type /= LH_microphys_disabled ) then - write(fstdout,*) "vars_LH_zt = " - i = 1 - do while ( vars_LH_zt(i) /= '' ) - write(fstdout,*) vars_LH_zt(i) - i = i + 1 - end do - - write(fstdout,*) "vars_LH_sfc = " - i = 1 - do while ( vars_LH_sfc(i) /= '' ) - write(fstdout,*) vars_LH_sfc(i) - i = i + 1 - end do - end if ! LH_microphys_type /= LH_microphys_disabled - - if ( l_output_rad_files ) then - write(fstdout,*) "vars_rad_zt = " - i = 1 - do while ( vars_rad_zt(i) /= '' ) - write(fstdout,*) vars_rad_zt(i) - i = i + 1 - end do - - write(fstdout,*) "vars_rad_zm = " - i = 1 - do while ( vars_rad_zm(i) /= '' ) - write(fstdout,*) vars_rad_zm(i) - i = i + 1 - end do - end if ! l_output_rad_files - - write(fstdout,*) "vars_sfc = " - i = 1 - do while ( vars_sfc(i) /= '' ) - write(fstdout,*) vars_sfc(i) - i = i + 1 - end do - - write(fstdout,*) "--------------------------------------------------" - end if ! clubb_at_least_debug_level 1 - - ! Determine file names for GrADS or NetCDF files - fname_zt = trim( fname_prefix )//"_zt" - fname_zm = trim( fname_prefix )//"_zm" - fname_LH_zt = trim( fname_prefix )//"_LH_zt" - fname_LH_sfc = trim( fname_prefix )//"_LH_sfc" - fname_rad_zt = trim( fname_prefix )//"_rad_zt" - fname_rad_zm = trim( fname_prefix )//"_rad_zm" - fname_sfc = trim( fname_prefix )//"_sfc" - - ! Parse the file type for stats output. Currently only GrADS and - ! netCDF > version 3.5 are supported by this code. - select case ( trim( stats_fmt ) ) - case ( "GrADS", "grads", "gr" ) - l_netcdf = .false. - l_grads = .true. - - case ( "NetCDF", "netcdf", "nc" ) - l_netcdf = .true. - l_grads = .false. - - case default - write(fstderr,*) "In module stats_subs subroutine stats_init: " - write(fstderr,*) "Invalid stats output format "//trim( stats_fmt ) - stop "Fatal error" - - end select - - ! Check sampling and output frequencies - - ! The model time step length, delt (which is dt_main), should multiply - ! evenly into the statistical sampling time step length, stats_tsamp. - if ( abs( stats_tsamp/delt - real( floor( stats_tsamp/delt ), kind=time_precision ) ) & - > 1.e-8_time_precision ) then - l_error = .true. ! This will cause the run to stop. - write(fstderr,*) 'Error: stats_tsamp should be an even multiple of ', & - 'delt (which is dt_main). Check the appropriate ', & - 'model.in file.' - write(fstderr,*) 'stats_tsamp = ', stats_tsamp - write(fstderr,*) 'delt = ', delt - end if - - ! The statistical sampling time step length, stats_tsamp, should multiply - ! evenly into the statistical output time step length, stats_tout. - if ( abs( stats_tout/stats_tsamp & - - real( floor( stats_tout/stats_tsamp ), kind=time_precision ) ) & - > 1.e-8_time_precision ) then - l_error = .true. ! This will cause the run to stop. - write(fstderr,*) 'Error: stats_tout should be an even multiple of ', & - 'stats_tsamp. Check the appropriate model.in file.' - write(fstderr,*) 'stats_tout = ', stats_tout - write(fstderr,*) 'stats_tsamp = ', stats_tsamp - end if - - ! Initialize zt (mass points) - - i = 1 - do while ( ichar(vars_zt(i)(1:1)) /= 0 & - .and. len_trim(vars_zt(i)) /= 0 & - .and. i <= nvarmax_zt ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_zt ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "vars_zt than allowed for by nvarmax_zt." - write(fstderr,*) "Check the number of variables listed for vars_zt ", & - "in the stats namelist, or change nvarmax_zt." - write(fstderr,*) "nvarmax_zt = ", nvarmax_zt - stop "stats_init: number of zt statistical variables exceeds limit" - end if - - zt%nn = ntot - zt%kk = nzmax - - allocate( zt%z( zt%kk ) ) - zt%z = gzt - - allocate( zt%x( 1, 1, zt%kk, zt%nn ) ) - allocate( zt%n( 1, 1, zt%kk, zt%nn ) ) - allocate( zt%l_in_update( 1, 1, zt%kk, zt%nn ) ) - call stats_zero( zt%kk, zt%nn, zt%x, zt%n, zt%l_in_update ) - - allocate( zt%f%var( zt%nn ) ) - allocate( zt%f%z( zt%kk ) ) - - ! Allocate scratch space - - allocate( ztscr01(zt%kk) ) - allocate( ztscr02(zt%kk) ) - allocate( ztscr03(zt%kk) ) - allocate( ztscr04(zt%kk) ) - allocate( ztscr05(zt%kk) ) - allocate( ztscr06(zt%kk) ) - allocate( ztscr07(zt%kk) ) - allocate( ztscr08(zt%kk) ) - allocate( ztscr09(zt%kk) ) - allocate( ztscr10(zt%kk) ) - allocate( ztscr11(zt%kk) ) - allocate( ztscr12(zt%kk) ) - allocate( ztscr13(zt%kk) ) - allocate( ztscr14(zt%kk) ) - allocate( ztscr15(zt%kk) ) - allocate( ztscr16(zt%kk) ) - allocate( ztscr17(zt%kk) ) - allocate( ztscr18(zt%kk) ) - allocate( ztscr19(zt%kk) ) - allocate( ztscr20(zt%kk) ) - allocate( ztscr21(zt%kk) ) - - ztscr01 = 0.0_core_rknd - ztscr02 = 0.0_core_rknd - ztscr03 = 0.0_core_rknd - ztscr04 = 0.0_core_rknd - ztscr05 = 0.0_core_rknd - ztscr06 = 0.0_core_rknd - ztscr07 = 0.0_core_rknd - ztscr08 = 0.0_core_rknd - ztscr09 = 0.0_core_rknd - ztscr10 = 0.0_core_rknd - ztscr11 = 0.0_core_rknd - ztscr12 = 0.0_core_rknd - ztscr13 = 0.0_core_rknd - ztscr14 = 0.0_core_rknd - ztscr15 = 0.0_core_rknd - ztscr16 = 0.0_core_rknd - ztscr17 = 0.0_core_rknd - ztscr18 = 0.0_core_rknd - ztscr19 = 0.0_core_rknd - ztscr20 = 0.0_core_rknd - ztscr21 = 0.0_core_rknd - - fname = trim( fname_zt ) - - if ( l_grads ) then - - ! Open GrADS file - call open_grads( iunit, fdir, fname, & - 1, zt%kk, zt%z, & - day, month, year, rlat, rlon, & - time_current+stats_tout, stats_tout, & - zt%nn, zt%f ) - - else ! Open NetCDF file -#ifdef NETCDF - call open_netcdf( 1, 1, fdir, fname, 1, zt%kk, zt%z, & ! In - day, month, year, rlat, rlon, & ! In - time_current+stats_tout, stats_tout, zt%nn, & ! In - zt%f ) ! InOut -#else - stop "This CLUBB program was not compiled with netCDF support." -#endif - - end if - - ! Default initialization for array indices for zt - - call stats_init_zt( vars_zt, l_error ) - - - ! Setup output file for LH_zt (Latin Hypercube stats) - - if ( LH_microphys_type /= LH_microphys_disabled ) then - - i = 1 - do while ( ichar(vars_LH_zt(i)(1:1)) /= 0 & - .and. len_trim(vars_LH_zt(i)) /= 0 & - .and. i <= nvarmax_LH_zt ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_LH_zt ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "vars_zt than allowed for by nvarmax_LH_zt." - write(fstderr,*) "Check the number of variables listed for vars_LH_zt ", & - "in the stats namelist, or change nvarmax_LH_zt." - write(fstderr,*) "nvarmax_LH_zt = ", nvarmax_LH_zt - stop "stats_init: number of LH_zt statistical variables exceeds limit" - end if - - LH_zt%nn = ntot - LH_zt%kk = nzmax - - allocate( LH_zt%z( LH_zt%kk ) ) - LH_zt%z = gzt - - allocate( LH_zt%x( 1, 1, LH_zt%kk, LH_zt%nn ) ) - allocate( LH_zt%n( 1, 1, LH_zt%kk, LH_zt%nn ) ) - allocate( LH_zt%l_in_update( 1, 1, LH_zt%kk, LH_zt%nn ) ) - call stats_zero( LH_zt%kk, LH_zt%nn, LH_zt%x, LH_zt%n, LH_zt%l_in_update ) - - allocate( LH_zt%f%var( LH_zt%nn ) ) - allocate( LH_zt%f%z( LH_zt%kk ) ) - - - fname = trim( fname_LH_zt ) - - if ( l_grads ) then - - ! Open GrADS file - call open_grads( iunit, fdir, fname, & - 1, LH_zt%kk, LH_zt%z, & - day, month, year, rlat, rlon, & - time_current+stats_tout, stats_tout, & - LH_zt%nn, LH_zt%f ) - - else ! Open NetCDF file -#ifdef NETCDF - call open_netcdf( 1, 1, fdir, fname, 1, LH_zt%kk, LH_zt%z, & ! In - day, month, year, rlat, rlon, & ! In - time_current+stats_tout, stats_tout, LH_zt%nn, & ! In - LH_zt%f ) ! InOut -#else - stop "This CLUBB program was not compiled with netCDF support." -#endif - - end if - - call stats_init_LH_zt( vars_LH_zt, l_error ) - - i = 1 - do while ( ichar(vars_LH_sfc(i)(1:1)) /= 0 & - .and. len_trim(vars_LH_sfc(i)) /= 0 & - .and. i <= nvarmax_LH_sfc ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_LH_sfc ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "vars_zt than allowed for by nvarmax_LH_sfc." - write(fstderr,*) "Check the number of variables listed for vars_LH_sfc ", & - "in the stats namelist, or change nvarmax_LH_sfc." - write(fstderr,*) "nvarmax_LH_sfc = ", nvarmax_LH_sfc - stop "stats_init: number of LH_sfc statistical variables exceeds limit" - end if - - LH_sfc%nn = ntot - LH_sfc%kk = 1 - - allocate( LH_sfc%z( LH_sfc%kk ) ) - LH_sfc%z = gzm(1) - - allocate( LH_sfc%x( 1, 1, LH_sfc%kk, LH_sfc%nn ) ) - allocate( LH_sfc%n( 1, 1, LH_sfc%kk, LH_sfc%nn ) ) - allocate( LH_sfc%l_in_update( 1, 1, LH_sfc%kk, LH_sfc%nn ) ) - - call stats_zero( LH_sfc%kk, LH_sfc%nn, LH_sfc%x, LH_sfc%n, LH_sfc%l_in_update ) - - allocate( LH_sfc%f%var( LH_sfc%nn ) ) - allocate( LH_sfc%f%z( LH_sfc%kk ) ) - - fname = trim( fname_LH_sfc ) - - if ( l_grads ) then - - ! Open GrADS file - call open_grads( iunit, fdir, fname, & - 1, LH_sfc%kk, LH_sfc%z, & - day, month, year, rlat, rlon, & - time_current+stats_tout, stats_tout, & - LH_sfc%nn, LH_sfc%f ) - - else ! Open NetCDF file -#ifdef NETCDF - call open_netcdf( 1, 1, fdir, fname, 1, LH_sfc%kk, LH_sfc%z, & ! In - day, month, year, rlat, rlon, & ! In - time_current+stats_tout, stats_tout, LH_sfc%nn, & ! In - LH_sfc%f ) ! InOut -#else - stop "This CLUBB program was not compiled with netCDF support." -#endif - - end if - - call stats_init_LH_sfc( vars_LH_sfc, l_error ) - - end if ! LH_microphys_type /= LH_microphys_disabled - - ! Initialize zm (momentum points) - - i = 1 - do while ( ichar(vars_zm(i)(1:1)) /= 0 & - .and. len_trim(vars_zm(i)) /= 0 & - .and. i <= nvarmax_zm ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_zm ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "vars_zm than allowed for by nvarmax_zm." - write(fstderr,*) "Check the number of variables listed for vars_zm ", & - "in the stats namelist, or change nvarmax_zm." - write(fstderr,*) "nvarmax_zm = ", nvarmax_zm - stop "stats_init: number of zm statistical variables exceeds limit" - end if - - zm%nn = ntot - zm%kk = nzmax - - allocate( zm%z( zm%kk ) ) - zm%z = gzm - - allocate( zm%x( 1, 1, zm%kk, zm%nn ) ) - allocate( zm%n( 1, 1, zm%kk, zm%nn ) ) - allocate( zm%l_in_update( 1, 1, zm%kk, zm%nn ) ) - - call stats_zero( zm%kk, zm%nn, zm%x, zm%n, zm%l_in_update ) - - allocate( zm%f%var( zm%nn ) ) - allocate( zm%f%z( zm%kk ) ) - - ! Allocate scratch space - - allocate( zmscr01(zm%kk) ) - allocate( zmscr02(zm%kk) ) - allocate( zmscr03(zm%kk) ) - allocate( zmscr04(zm%kk) ) - allocate( zmscr05(zm%kk) ) - allocate( zmscr06(zm%kk) ) - allocate( zmscr07(zm%kk) ) - allocate( zmscr08(zm%kk) ) - allocate( zmscr09(zm%kk) ) - allocate( zmscr10(zm%kk) ) - allocate( zmscr11(zm%kk) ) - allocate( zmscr12(zm%kk) ) - allocate( zmscr13(zm%kk) ) - allocate( zmscr14(zm%kk) ) - allocate( zmscr15(zm%kk) ) - allocate( zmscr16(zm%kk) ) - allocate( zmscr17(zm%kk) ) - - ! Initialize to 0 - zmscr01 = 0.0_core_rknd - zmscr02 = 0.0_core_rknd - zmscr03 = 0.0_core_rknd - zmscr04 = 0.0_core_rknd - zmscr05 = 0.0_core_rknd - zmscr06 = 0.0_core_rknd - zmscr07 = 0.0_core_rknd - zmscr08 = 0.0_core_rknd - zmscr09 = 0.0_core_rknd - zmscr10 = 0.0_core_rknd - zmscr11 = 0.0_core_rknd - zmscr12 = 0.0_core_rknd - zmscr13 = 0.0_core_rknd - zmscr14 = 0.0_core_rknd - zmscr15 = 0.0_core_rknd - zmscr16 = 0.0_core_rknd - zmscr17 = 0.0_core_rknd - - - fname = trim( fname_zm ) - if ( l_grads ) then - - ! Open GrADS files - call open_grads( iunit, fdir, fname, & - 1, zm%kk, zm%z, & - day, month, year, rlat, rlon, & - time_current+stats_tout, stats_tout, & - zm%nn, zm%f ) - - else ! Open NetCDF file -#ifdef NETCDF - call open_netcdf( 1, 1, fdir, fname, 1, zm%kk, zm%z, & ! In - day, month, year, rlat, rlon, & ! In - time_current+stats_tout, stats_tout, zm%nn, & ! In - zm%f ) ! InOut - -#else - stop "This CLUBB program was not compiled with netCDF support." -#endif - end if - - call stats_init_zm( vars_zm, l_error ) - - ! Initialize rad_zt (radiation points) - - if (l_output_rad_files) then - - i = 1 - do while ( ichar(vars_rad_zt(i)(1:1)) /= 0 & - .and. len_trim(vars_rad_zt(i)) /= 0 & - .and. i <= nvarmax_rad_zt ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_rad_zt ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "vars_rad_zt than allowed for by nvarmax_rad_zt." - write(fstderr,*) "Check the number of variables listed for vars_rad_zt ", & - "in the stats namelist, or change nvarmax_rad_zt." - write(fstderr,*) "nvarmax_rad_zt = ", nvarmax_rad_zt - stop "stats_init: number of rad_zt statistical variables exceeds limit" - end if - - rad_zt%nn = ntot - rad_zt%kk = nnrad_zt - - allocate( rad_zt%z( rad_zt%kk ) ) - rad_zt%z = grad_zt - - allocate( rad_zt%x( 1, 1, rad_zt%kk, rad_zt%nn ) ) - allocate( rad_zt%n( 1, 1, rad_zt%kk, rad_zt%nn ) ) - allocate( rad_zt%l_in_update( 1, 1, rad_zt%kk, rad_zt%nn ) ) - - call stats_zero( rad_zt%kk, rad_zt%nn, rad_zt%x, rad_zt%n, rad_zt%l_in_update ) - - allocate( rad_zt%f%var( rad_zt%nn ) ) - allocate( rad_zt%f%z( rad_zt%kk ) ) - - ! Allocate scratch space - - !allocate( radscr01(rad%kk) ) - !allocate( radscr02(rad%kk) ) - !allocate( radscr03(rad%kk) ) - !allocate( radscr04(rad%kk) ) - !allocate( radscr05(rad%kk) ) - !allocate( radscr06(rad%kk) ) - !allocate( radscr07(rad%kk) ) - !allocate( radscr08(rad%kk) ) - !allocate( radscr09(rad%kk) ) - !allocate( radscr10(rad%kk) ) - !allocate( radscr11(rad%kk) ) - !allocate( radscr12(rad%kk) ) - !allocate( radscr13(rad%kk) ) - !allocate( radscr14(rad%kk) ) - !allocate( radscr15(rad%kk) ) - !allocate( radscr16(rad%kk) ) - !allocate( radscr17(rad%kk) ) - - !radscr01 = 0.0_core_rknd - !radscr02 = 0.0_core_rknd - !radscr03 = 0.0_core_rknd - !radscr04 = 0.0_core_rknd - !radscr05 = 0.0_core_rknd - !radscr06 = 0.0_core_rknd - !radscr07 = 0.0_core_rknd - !radscr08 = 0.0_core_rknd - !radscr09 = 0.0_core_rknd - !radscr10 = 0.0_core_rknd - !radscr11 = 0.0_core_rknd - !radscr12 = 0.0_core_rknd - !radscr13 = 0.0_core_rknd - !radscr14 = 0.0_core_rknd - !radscr15 = 0.0_core_rknd - !radscr16 = 0.0_core_rknd - !radscr17 = 0.0_core_rknd - - - fname = trim( fname_rad_zt ) - if ( l_grads ) then - - ! Open GrADS files - call open_grads( iunit, fdir, fname, & - 1, rad_zt%kk, rad_zt%z, & - day, month, year, rlat, rlon, & - time_current+stats_tout, stats_tout, & - rad_zt%nn, rad_zt%f ) - - else ! Open NetCDF file -#ifdef NETCDF - call open_netcdf( 1, 1, fdir, fname, & - 1, rad_zt%kk, rad_zt%z, & - day, month, year, rlat, rlon, & - time_current+stats_tout, stats_tout, & - rad_zt%nn, rad_zt%f ) - -#else - stop "This CLUBB program was not compiled with netCDF support." -#endif - end if - - call stats_init_rad_zt( vars_rad_zt, l_error ) - - ! Initialize rad_zm (radiation points) - - i = 1 - do while ( ichar(vars_rad_zm(i)(1:1)) /= 0 & - .and. len_trim(vars_rad_zm(i)) /= 0 & - .and. i <= nvarmax_rad_zm ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_rad_zm ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "vars_rad_zm than allowed for by nvarmax_rad_zm." - write(fstderr,*) "Check the number of variables listed for vars_rad_zm ", & - "in the stats namelist, or change nvarmax_rad_zm." - write(fstderr,*) "nvarmax_rad_zm = ", nvarmax_rad_zm - stop "stats_init: number of rad_zm statistical variables exceeds limit" - end if - - rad_zm%nn = ntot - rad_zm%kk = nnrad_zm - - allocate( rad_zm%z( rad_zm%kk ) ) - rad_zm%z = grad_zm - - allocate( rad_zm%x( 1, 1, rad_zm%kk, rad_zm%nn ) ) - allocate( rad_zm%n( 1, 1, rad_zm%kk, rad_zm%nn ) ) - allocate( rad_zm%l_in_update( 1, 1, rad_zm%kk, rad_zm%nn ) ) - - call stats_zero( rad_zm%kk, rad_zm%nn, rad_zm%x, rad_zm%n, rad_zm%l_in_update ) - - allocate( rad_zm%f%var( rad_zm%nn ) ) - allocate( rad_zm%f%z( rad_zm%kk ) ) - - ! Allocate scratch space - - !allocate( radscr01(rad%kk) ) - !allocate( radscr02(rad%kk) ) - !allocate( radscr03(rad%kk) ) - !allocate( radscr04(rad%kk) ) - !allocate( radscr05(rad%kk) ) - !allocate( radscr06(rad%kk) ) - !allocate( radscr07(rad%kk) ) - !allocate( radscr08(rad%kk) ) - !allocate( radscr09(rad%kk) ) - !allocate( radscr10(rad%kk) ) - !allocate( radscr11(rad%kk) ) - !allocate( radscr12(rad%kk) ) - !allocate( radscr13(rad%kk) ) - !allocate( radscr14(rad%kk) ) - !allocate( radscr15(rad%kk) ) - !allocate( radscr16(rad%kk) ) - !allocate( radscr17(rad%kk) ) - - !radscr01 = 0.0_core_rknd - !radscr02 = 0.0_core_rknd - !radscr03 = 0.0_core_rknd - !radscr04 = 0.0_core_rknd - !radscr05 = 0.0_core_rknd - !radscr06 = 0.0_core_rknd - !radscr07 = 0.0_core_rknd - !radscr08 = 0.0_core_rknd - !radscr09 = 0.0_core_rknd - !radscr10 = 0.0_core_rknd - !radscr11 = 0.0_core_rknd - !radscr12 = 0.0_core_rknd - !radscr13 = 0.0_core_rknd - !radscr14 = 0.0_core_rknd - !radscr15 = 0.0_core_rknd - !radscr16 = 0.0_core_rknd - !radscr17 = 0.0_core_rknd - - - fname = trim( fname_rad_zm ) - if ( l_grads ) then - - ! Open GrADS files - call open_grads( iunit, fdir, fname, & - 1, rad_zm%kk, rad_zm%z, & - day, month, year, rlat, rlon, & - time_current+stats_tout, stats_tout, & - rad_zm%nn, rad_zm%f ) - - else ! Open NetCDF file -#ifdef NETCDF - call open_netcdf( 1, 1, fdir, fname, & - 1, rad_zm%kk, rad_zm%z, & - day, month, year, rlat, rlon, & - time_current+stats_tout, stats_tout, & - rad_zm%nn, rad_zm%f ) - -#else - stop "This CLUBB program was not compiled with netCDF support." -#endif - end if - - call stats_init_rad_zm( vars_rad_zm, l_error ) - end if ! l_output_rad_files - - - ! Initialize sfc (surface point) - - i = 1 - do while ( ichar(vars_sfc(i)(1:1)) /= 0 & - .and. len_trim(vars_sfc(i)) /= 0 & - .and. i <= nvarmax_sfc ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_sfc ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "vars_sfc than allowed for by nvarmax_sfc." - write(fstderr,*) "Check the number of variables listed for vars_sfc ", & - "in the stats namelist, or change nvarmax_sfc." - write(fstderr,*) "nvarmax_sfc = ", nvarmax_sfc - stop "stats_init: number of sfc statistical variables exceeds limit" - end if - - sfc%nn = ntot - sfc%kk = 1 - - allocate( sfc%z( sfc%kk ) ) - sfc%z = gzm(1) - - allocate( sfc%x( 1, 1, sfc%kk, sfc%nn ) ) - allocate( sfc%n( 1, 1, sfc%kk, sfc%nn ) ) - allocate( sfc%l_in_update( 1, 1, sfc%kk, sfc%nn ) ) - - call stats_zero( sfc%kk, sfc%nn, sfc%x, sfc%n, sfc%l_in_update ) - - allocate( sfc%f%var( sfc%nn ) ) - allocate( sfc%f%z( sfc%kk ) ) - - fname = trim( fname_sfc ) - - if ( l_grads ) then - - ! Open GrADS files - call open_grads( iunit, fdir, fname, & - 1, sfc%kk, sfc%z, & - day, month, year, rlat, rlon, & - time_current+stats_tout, stats_tout, & - sfc%nn, sfc%f ) - - else ! Open NetCDF files -#ifdef NETCDF - call open_netcdf( 1, 1, fdir, fname, 1, sfc%kk, sfc%z, & ! In - day, month, year, rlat, rlon, & ! In - time_current+stats_tout, stats_tout, sfc%nn, & ! In - sfc%f ) ! InOut - -#else - stop "This CLUBB program was not compiled with netCDF support." -#endif - end if - - call stats_init_sfc( vars_sfc, l_error ) - - ! Check for errors - - if ( l_error ) then - write(fstderr,*) 'stats_init: errors found' - stop "Fatal error" - endif - - return - - ! If namelist was not found in input file, turn off statistics - - 100 continue - write(fstderr,*) 'Error with statsnl, statistics is turned off' - l_stats = .false. - l_stats_samp = .false. - l_stats_last = .false. - - return - end subroutine stats_init - !----------------------------------------------------------------------- - subroutine stats_zero( kk, nn, x, n, l_in_update ) - - ! Description: - ! Initialize stats to zero - ! References: - ! None - !----------------------------------------------------------------------- - use crmx_clubb_precision, only: & - stat_rknd, & ! Variable(s) - stat_nknd - - implicit none - - ! Input Variable(s) - integer, intent(in) :: kk, nn - - ! Output Variable(s) - real(kind=stat_rknd), dimension(1,1,kk,nn), intent(out) :: x - integer(kind=stat_nknd), dimension(1,1,kk,nn), intent(out) :: n - logical, dimension(1,1,kk,nn), intent(out) :: l_in_update - - ! Zero out arrays - - if ( nn > 0 ) then - x(:,:,:,:) = 0.0_stat_rknd - n(:,:,:,:) = 0_stat_nknd - l_in_update(:,:,:,:) = .false. - end if - - return - end subroutine stats_zero - - !----------------------------------------------------------------------- - subroutine stats_avg( kk, nn, x, n ) - - ! Description: - ! Compute the average of stats fields - ! References: - ! None - !----------------------------------------------------------------------- - use crmx_clubb_precision, only: & - stat_rknd, & ! Variable(s) - stat_nknd - - implicit none - - ! External - intrinsic :: real - - ! Input Variable(s) - integer, intent(in) :: & - kk, & ! Number of levels in vertical (i.e. Z) dimension - nn ! Number of variables being sampled in x - - integer(kind=stat_nknd), dimension(1,1,kk,nn), intent(in) :: & - n ! The variable n is the number of samples per x per kk - - ! Output Variable(s) - real(kind=stat_rknd), dimension(1,1,kk,nn), intent(inout) :: & - x ! The variable x is a set of nn variables being averaged over n - - ! ---- Begin Code ---- - - ! Compute averages - where ( n(1,1,1:kk,1:nn) > 0 ) - x(1,1,1:kk,1:nn) = x(1,1,1:kk,1:nn) / real( n(1,1,1:kk,1:nn), kind=stat_rknd ) - end where - - return - end subroutine stats_avg - - !----------------------------------------------------------------------- - subroutine stats_begin_timestep( time_elapsed ) - - ! Description: - ! Given the elapsed time, set flags determining specifics such as - ! if this time set should be sampled or if this is the first or - ! last time step. - !----------------------------------------------------------------------- - - use crmx_stats_variables, only: & - l_stats, & ! Variable(s) - l_stats_samp, & - l_stats_last, & - stats_tsamp, & - stats_tout - - use crmx_clubb_precision, only: & - time_precision ! Variable(s) - - implicit none - - ! External - intrinsic :: mod - - ! Input Variable(s) - real(kind=time_precision), intent(in) :: & - time_elapsed ! Elapsed model time [s] - - if ( .not. l_stats ) return - - ! Only sample time steps that are multiples of "stats_tsamp" - ! in a case's "model.in" file to shorten length of run - if ( mod( time_elapsed, stats_tsamp ) < 1.e-8_time_precision ) then - l_stats_samp = .true. - else - l_stats_samp = .false. - end if - - ! Indicates the end of the sampling time period. Signals to start writing to the file - if ( mod( time_elapsed, stats_tout ) < 1.e-8_time_precision ) then - l_stats_last = .true. - else - l_stats_last = .false. - end if - - return - - end subroutine stats_begin_timestep - - !----------------------------------------------------------------------- - subroutine stats_end_timestep( ) - - ! Description: - ! Called when the stats timestep has ended. This subroutine - ! is responsible for calling statistics to be written to the output - ! format. - ! - ! References: - ! None - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Constant(s) - - use crmx_stats_variables, only: & - zt, & ! Variable(s) - LH_zt, & - LH_sfc, & - zm, & - rad_zt, & - rad_zm, & - sfc, & - l_stats_last, & - stats_tsamp, & - stats_tout, & - l_output_rad_files, & - l_grads - - use crmx_clubb_precision, only: & - time_precision ! Variable(s) - - use crmx_output_grads, only: & - write_grads ! Procedure(s) - - use crmx_error_code, only: & - clubb_at_least_debug_level ! Procedure(s) - - use crmx_parameters_microphys, only: & - LH_microphys_disabled ! Constant - - use crmx_parameters_microphys, only: & - LH_microphys_type, & ! Variable(s) - LH_microphys_calls - -#ifdef NETCDF - use crmx_output_netcdf, only: & - write_netcdf ! Procedure(s) -#endif - - implicit none - - ! External - intrinsic :: floor - - ! Local Variables - - integer :: i, k - - logical :: l_error - - ! ---- Begin Code ---- - - ! Check if it is time to write to file - - if ( .not. l_stats_last ) return - - ! Initialize - l_error = .false. - - ! Look for errors by checking the number of sampling points - ! for each variable in the zt statistics at each vertical level. - do i = 1, zt%nn - do k = 1, zt%kk - - if ( zt%n(1,1,k,i) /= 0 .and. & - zt%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(zt%f%var(i)%name), ' in zt ', & - 'at k = ', k, & - '; zt%n(',k,',',i,') = ', zt%n(1,1,k,i) - end if ! clubb_at_lest_debug_level 1 - - end if ! n /= 0 and n /= stats_tout/stats_tsamp - - end do ! k = 1 .. zt%kk - end do ! i = 1 .. zt%nn - - ! Look for errors by checking the number of sampling points - ! for each variable in the zm statistics at each vertical level. - do i = 1, zm%nn - do k = 1, zm%kk - - if ( zm%n(1,1,k,i) /= 0 .and. & - zm%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(zm%f%var(i)%name), ' in zm ', & - 'at k = ', k, & - '; zm%n(',k,',',i,') = ', zm%n(1,1,k,i) - end if ! clubb_at_least_debug_level 1 - - end if ! n /= 0 and n /= stats_tout/stats_tsamp - - end do ! k = 1 .. zm%kk - end do ! i = 1 .. zm%nn - - if ( LH_microphys_type /= LH_microphys_disabled ) then - ! Look for errors by checking the number of sampling points - ! for each variable in the LH_zt statistics at each vertical level. - do i = 1, LH_zt%nn - do k = 1, LH_zt%kk - - if ( LH_zt%n(1,1,k,i) /= 0 .and. & - LH_zt%n(1,1,k,i) /= floor( stats_tout/stats_tsamp ) .and. & - LH_zt%n(1,1,k,i) /= LH_microphys_calls * floor( stats_tout/stats_tsamp ) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(LH_zt%f%var(i)%name), ' in LH_zt ', & - 'at k = ', k, & - '; LH_zt%n(',k,',',i,') = ', LH_zt%n(1,1,k,i) - end if ! clubb_at_lest_debug_level 1 - - end if ! n /= 0 and n /= LH_microphys_calls * stats_tout/stats_tsamp - - end do ! k = 1 .. LH_zt%kk - end do ! i = 1 .. LH_zt%nn - - ! Look for errors by checking the number of sampling points - ! for each variable in the LH_zt statistics at each vertical level. - do i = 1, LH_sfc%nn - do k = 1, LH_sfc%kk - - if ( LH_sfc%n(1,1,k,i) /= 0 .and. & - LH_sfc%n(1,1,k,i) /= floor( stats_tout/stats_tsamp ) .and. & - LH_sfc%n(1,1,k,i) /= LH_microphys_calls * floor( stats_tout/stats_tsamp ) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(LH_sfc%f%var(i)%name), ' in LH_sfc ', & - 'at k = ', k, & - '; LH_sfc%n(',k,',',i,') = ', LH_sfc%n(1,1,k,i) - end if ! clubb_at_lest_debug_level 1 - - end if ! n /= 0 and n /= LH_microphys_calls * stats_tout/stats_tsamp - - end do ! k = 1 .. LH_sfc%kk - end do ! i = 1 .. LH_sfc%nn - end if ! LH_microphys_type /= LH_microphys_disabled - - - if ( l_output_rad_files ) then - ! Look for errors by checking the number of sampling points - ! for each variable in the rad_zt statistics at each vertical level. - do i = 1, rad_zt%nn - do k = 1, rad_zt%kk - - if ( rad_zt%n(1,1,k,i) /= 0 .and. & - rad_zt%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(rad_zt%f%var(i)%name), ' in rad_zt ', & - 'at k = ', k, & - '; rad_zt%n(',k,',',i,') = ', rad_zt%n(1,1,k,i) - end if ! clubb_at_lest_debug_level 1 - - end if ! n /= 0 and n /= stats_tout/stats_tsamp - - end do ! k = 1 .. rad_zt%kk - end do ! i = 1 .. rad_zt%nn - - ! Look for errors by checking the number of sampling points - ! for each variable in the rad_zm statistics at each vertical level. - do i = 1, rad_zm%nn - do k = 1, rad_zm%kk - - if ( rad_zm%n(1,1,k,i) /= 0 .and. & - rad_zm%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(rad_zm%f%var(i)%name), ' in rad_zm ', & - 'at k = ', k, & - '; rad_zm%n(',k,',',i,') = ', rad_zm%n(1,1,k,i) - end if ! clubb_at_lest_debug_level 1 - - end if ! n /= 0 and n /= stats_tout/stats_tsamp - - end do ! k = 1 .. rad_zm%kk - end do ! i = 1 .. rad_zm%nn - - end if ! l_output_rad_files - - ! Look for errors by checking the number of sampling points - ! for each variable in the sfc statistics at each vertical level. - do i = 1, sfc%nn - do k = 1, sfc%kk - - if ( sfc%n(1,1,k,i) /= 0 .and. & - sfc%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(sfc%f%var(i)%name), ' in sfc ', & - 'at k = ', k, & - '; sfc%n(',k,',',i,') = ', sfc%n(1,1,k,i) - end if ! clubb_at_lest_debug_level 1 - - end if ! n /= 0 and n /= stats_tout/stats_tsamp - - end do ! k = 1 .. sfc%kk - end do ! i = 1 .. sfc%nn - - ! Stop the run if errors are found. - if ( l_error ) then - write(fstderr,*) 'Possible statistical sampling error' - write(fstderr,*) 'For details, set debug_level to a value of at ', & - 'least 1 in the appropriate model.in file.' - stop 'stats_end_timestep: error(s) found' - end if ! l_error - - ! Compute averages - call stats_avg( zt%kk, zt%nn, zt%x, zt%n ) - call stats_avg( zm%kk, zm%nn, zm%x, zm%n ) - if ( LH_microphys_type /= LH_microphys_disabled ) then - call stats_avg( LH_zt%kk, LH_zt%nn, LH_zt%x, LH_zt%n ) - call stats_avg( LH_sfc%kk, LH_sfc%nn, LH_sfc%x, LH_sfc%n ) - end if - if ( l_output_rad_files ) then - call stats_avg( rad_zt%kk, rad_zt%nn, rad_zt%x, rad_zt%n ) - call stats_avg( rad_zm%kk, rad_zm%nn, rad_zm%x, rad_zm%n ) - end if - call stats_avg( sfc%kk, sfc%nn, sfc%x, sfc%n ) - - ! Write to file - if ( l_grads ) then - call write_grads( zt%f ) - call write_grads( zm%f ) - if ( LH_microphys_type /= LH_microphys_disabled ) then - call write_grads( LH_zt%f ) - call write_grads( LH_sfc%f ) - end if - if ( l_output_rad_files ) then - call write_grads( rad_zt%f ) - call write_grads( rad_zm%f ) - end if - call write_grads( sfc%f ) - else ! l_netcdf -#ifdef NETCDF - call write_netcdf( zt%f ) - call write_netcdf( zm%f ) - if ( LH_microphys_type /= LH_microphys_disabled ) then - call write_netcdf( LH_zt%f ) - call write_netcdf( LH_sfc%f ) - end if - if ( l_output_rad_files ) then - call write_netcdf( rad_zt%f ) - call write_netcdf( rad_zm%f ) - end if - call write_netcdf( sfc%f ) -#else - stop "This program was not compiled with netCDF support" -#endif /* NETCDF */ - end if ! l_grads - - ! Reset sample fields - call stats_zero( zt%kk, zt%nn, zt%x, zt%n, zt%l_in_update ) - call stats_zero( zm%kk, zm%nn, zm%x, zm%n, zm%l_in_update ) - if ( LH_microphys_type /= LH_microphys_disabled ) then - call stats_zero( LH_zt%kk, LH_zt%nn, LH_zt%x, LH_zt%n, LH_zt%l_in_update ) - call stats_zero( LH_sfc%kk, LH_sfc%nn, LH_sfc%x, LH_sfc%n, LH_sfc%l_in_update ) - end if - if ( l_output_rad_files ) then - call stats_zero( rad_zt%kk, rad_zt%nn, rad_zt%x, rad_zt%n, rad_zt%l_in_update ) - call stats_zero( rad_zm%kk, rad_zm%nn, rad_zm%x, rad_zm%n, rad_zm%l_in_update ) - end if - call stats_zero( sfc%kk, sfc%nn, sfc%x, sfc%n, sfc%l_in_update ) - - - return - end subroutine stats_end_timestep - - !---------------------------------------------------------------------- - subroutine stats_accumulate & - ( um, vm, upwp, vpwp, up2, vp2, & - thlm, rtm, wprtp, wpthlp, & - wp2, wp3, rtp2, thlp2, rtpthlp, & - p_in_Pa, exner, rho, rho_zm, & - rho_ds_zm, rho_ds_zt, thv_ds_zm, & - thv_ds_zt, wm_zt, wm_zm, rcm, wprcp, rc_coef, & - rcm_zm, rtm_zm, thlm_zm, cloud_frac, ice_supersat_frac, & - cloud_frac_zm, ice_supersat_frac_zm, rcm_in_layer, & - cloud_cover, sigma_sqd_w, pdf_params, & - sclrm, sclrp2, sclrprtp, sclrpthlp, sclrm_forcing, & - wpsclrp, edsclrm, edsclrm_forcing ) - - ! Description: - ! Accumulate those stats variables that are preserved in CLUBB from timestep to - ! timestep, but not those stats that are not, (e.g. budget terms, longwave and - ! shortwave components, etc.) - ! - ! References: - ! None - !---------------------------------------------------------------------- - - use crmx_stats_variables, only: & - zt, & ! Variables - zm, & - sfc, & - l_stats_samp, & - ithlm, & - iT_in_K, & - ithvm, & - irtm, & - ircm, & - ium, & - ivm, & - iwm_zt, & - iwm_zm, & - iug, & - ivg, & - icloud_frac, & - iice_supersat_frac, & - ircm_in_layer, & - icloud_cover - - use crmx_stats_variables, only: & - ip_in_Pa, & - iexner, & - irho_ds_zt, & - ithv_ds_zt, & - iLscale, & - iwp3, & - iwp3_zm, & - iwpthlp2, & - iwp2thlp, & - iwprtp2, & - iwp2rtp, & - iLscale_up, & - iLscale_down, & - itau_zt, & - iKh_zt - - use crmx_stats_variables, only: & - iwp2thvp, & ! Variable(s) - iwp2rcp, & - iwprtpthlp, & - isigma_sqd_w_zt, & - irho, & - irsat, & - irsati - - use crmx_stats_variables, only: & - imixt_frac, & ! Variable(s) - iw1, & - iw2, & - ivarnce_w1, & - ivarnce_w2, & - ithl1, & - ithl2, & - ivarnce_thl1, & - ivarnce_thl2, & - irt1, & - irt2, & - ivarnce_rt1, & - ivarnce_rt2, & - irc1, & - irc2, & - irsl1, & - irsl2, & - icloud_frac1, & - icloud_frac2 - - use crmx_stats_variables, only: & - is1, & - is2, & - istdev_s1, & - istdev_s2, & - istdev_t1, & - istdev_t2, & - icovar_st_1, & - icovar_st_2, & - icorr_st_1, & - icorr_st_2, & - icrt1, & - icrt2, & - icthl1, & - icthl2, & - irrtthl, & - is_mellor - - use crmx_stats_variables, only: & - iwp2_zt, & ! Variable(s) - ithlp2_zt, & - iwpthlp_zt, & - iwprtp_zt, & - irtp2_zt, & - irtpthlp_zt, & - iup2_zt, & - ivp2_zt, & - iupwp_zt, & - ivpwp_zt, & - iwp2, & - irtp2, & - ithlp2, & - irtpthlp, & - iwprtp, & - iwpthlp, & - iwp4, & - iwpthvp, & - irtpthvp - - use crmx_stats_variables, only: & - ithlpthvp, & - itau_zm, & - iKh_zm, & - iwprcp, & - irc_coef, & - ithlprcp, & - irtprcp, & - ircp2, & - iupwp, & - ivpwp, & - iup2, & - ivp2, & - irho_zm, & - isigma_sqd_w, & - irho_ds_zm, & - ithv_ds_zm, & - iem - - use crmx_stats_variables, only: & - ishear, & ! Variable(s) - iFrad, & - icc, & - iz_cloud_base, & - ilwp, & - ivwp, & - ithlm_vert_avg, & - irtm_vert_avg, & - ium_vert_avg, & - ivm_vert_avg, & - iwp2_vert_avg, & - iup2_vert_avg, & - ivp2_vert_avg, & - irtp2_vert_avg, & - ithlp2_vert_avg - - use crmx_stats_variables, only: & - isclrm, & ! Variable(s) - isclrm_f, & - iedsclrm, & - iedsclrm_f, & - isclrprtp, & - isclrp2, & - isclrpthvp, & - isclrpthlp, & - isclrprcp, & - iwpsclrp, & - iwp2sclrp, & - iwpsclrp2, & - iwpsclrprtp, & - iwpsclrpthlp, & - iwpedsclrp - - use crmx_stats_variables, only: & - icloud_frac_zm, & - iice_supersat_frac_zm, & - ircm_zm, & - irtm_zm, & - ithlm_zm - - use crmx_stats_variables, only: & - iwp3_on_wp2, & - iwp3_on_wp2_zt, & - iSkw_velocity - - use crmx_stats_variables, only: & - ia3_coef, & ! Variables - ia3_coef_zt - - use crmx_grid_class, only: & - gr ! Variable - - use crmx_grid_class, only: & - zt2zm ! Procedure(s) - - use crmx_variables_diagnostic_module, only: & - thvm, & ! Variable(s) - ug, & - vg, & - Lscale, & - wpthlp2, & - wp2thlp, & - wprtp2, & - wp2rtp, & - Lscale_up, & - Lscale_down, & - tau_zt, & - Kh_zt, & - wp2thvp, & - wp2rcp, & - wprtpthlp, & - sigma_sqd_w_zt, & - rsat - - use crmx_variables_diagnostic_module, only: & - wp2_zt, & ! Variable(s) - thlp2_zt, & - wpthlp_zt, & - wprtp_zt, & - rtp2_zt, & - rtpthlp_zt, & - up2_zt, & - vp2_zt, & - upwp_zt, & - vpwp_zt, & - wp4, & - rtpthvp, & - thlpthvp, & - wpthvp, & - tau_zm, & - Kh_zm, & - thlprcp, & - rtprcp, & - rcp2, & - em, & - Frad, & - sclrpthvp, & - sclrprcp, & - wp2sclrp, & - wpsclrp2, & - wpsclrprtp, & - wpsclrpthlp, & - wpedsclrp - - use crmx_variables_diagnostic_module, only: & - a3_coef, & ! Variable(s) - a3_coef_zt, & - wp3_zm, & - wp3_on_wp2, & - wp3_on_wp2_zt, & - Skw_velocity - - use crmx_pdf_parameter_module, only: & - pdf_parameter ! Type - - use crmx_T_in_K_module, only: & - thlm2T_in_K ! Procedure - - use crmx_constants_clubb, only: & - rc_tol, & ! Constant(s) - w_tol_sqd - - use crmx_parameters_model, only: & - sclr_dim, & ! Variable(s) - edsclr_dim - - use crmx_stats_type, only: & - stat_update_var, & ! Procedure(s) - stat_update_var_pt - - use crmx_fill_holes, only: & - vertical_avg, & ! Procedure(s) - vertical_integral - - use crmx_interpolation, only: & - lin_int ! Procedure - - use crmx_saturation, only: & - sat_mixrat_ice ! Procedure - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variable(s) - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - um, & ! u wind [m/s] - vm, & ! v wind [m/s] - upwp, & ! vertical u momentum flux [m^2/s^2] - vpwp, & ! vertical v momentum flux [m^2/s^2] - up2, & ! u'^2 [m^2/s^2] - vp2, & ! v'^2 [m^2/s^2] - thlm, & ! liquid potential temperature [K] - rtm, & ! total water mixing ratio [kg/kg] - wprtp, & ! w'rt' [(kg/kg) m/s] - wpthlp, & ! w'thl' [m K /s] - wp2, & ! w'^2 [m^2/s^2] - wp3, & ! w'^3 [m^3/s^3] - rtp2, & ! rt'^2 [(kg/kg)^2] - thlp2, & ! thl'^2 [K^2] - rtpthlp ! rt'thl' [kg/kg K] - - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - p_in_Pa, & ! Pressure (Pa) on thermodynamic points [Pa] - exner, & ! Exner function = ( p / p0 ) ** kappa [-] - rho, & ! Density [kg/m^3] - rho_zm, & ! Density [kg/m^3] - rho_ds_zm, & ! Dry, static density (momentum levels) [kg/m^3] - rho_ds_zt, & ! Dry, static density (thermo. levs.) [kg/m^3] - thv_ds_zm, & ! Dry, base-state theta_v (momentum levs.) [K] - thv_ds_zt, & ! Dry, base-state theta_v (thermo. levs.) [K] - wm_zt, & ! w on thermodynamic levels [m/s] - wm_zm ! w on momentum levels [m/s] - - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - rcm_zm, & ! Total water mixing ratio [kg/kg] - rtm_zm, & ! Total water mixing ratio [kg/kg] - thlm_zm, & ! Liquid potential temperature [K] - rcm, & ! Cloud water mixing ratio [kg/kg] - wprcp, & ! w'rc' [(kg/kg) m/s] - rc_coef, & ! Coefficient of X' R_l' in Eq. (34) [-] - cloud_frac, & ! Cloud fraction [-] - ice_supersat_frac, & ! Ice cloud fracion [-] - cloud_frac_zm, & ! Cloud fraction on zm levels [-] - ice_supersat_frac_zm, & ! Ice cloud fraction on zm levels [-] - rcm_in_layer, & ! Cloud water mixing ratio in cloud layer [kg/kg] - cloud_cover ! Cloud cover [-] - - real( kind = core_rknd ), intent(in), dimension(gr%nz) :: & - sigma_sqd_w ! PDF width parameter (momentum levels) [-] - - type(pdf_parameter), dimension(gr%nz), intent(in) :: & - pdf_params ! PDF parameters [units vary] - - real( kind = core_rknd ), intent(in), dimension(gr%nz,sclr_dim) :: & - sclrm, & ! High-order passive scalar [units vary] - sclrp2, & ! High-order passive scalar variance [units^2] - sclrprtp, & ! High-order passive scalar covariance [units kg/kg] - sclrpthlp, & ! High-order passive scalar covariance [units K] - sclrm_forcing, & ! Large-scale forcing of scalar [units/s] - wpsclrp ! w'sclr' [units m/s] - - real( kind = core_rknd ), intent(in), dimension(gr%nz,edsclr_dim) :: & - edsclrm, & ! Eddy-diff passive scalar [units vary] - edsclrm_forcing ! Large-scale forcing of edscalar [units vary] - - ! Local Variables - - integer :: i, k - - real( kind = core_rknd ), dimension(gr%nz) :: & - T_in_K, & ! Absolute temperature [K] - rsati, & ! Saturation w.r.t ice [kg/kg] - shear, & ! Wind shear production term [m^2/s^3] - s_mellor ! Mellor's 's' [kg/kg] - - real( kind = core_rknd ) :: xtmp - - ! ---- Begin Code ---- - - ! Sample fields - - if ( l_stats_samp ) then - - ! zt variables - - - if ( iT_in_K > 0 .or. irsati > 0 ) then - T_in_K = thlm2T_in_K( thlm, exner, rcm ) - else - T_in_K = -999._core_rknd - end if - - call stat_update_var( iT_in_K, T_in_K, zt ) - - call stat_update_var( ithlm, thlm, zt ) - call stat_update_var( ithvm, thvm, zt ) - call stat_update_var( irtm, rtm, zt ) - call stat_update_var( ircm, rcm, zt ) - call stat_update_var( ium, um, zt ) - call stat_update_var( ivm, vm, zt ) - call stat_update_var( iwm_zt, wm_zt, zt ) - call stat_update_var( iwm_zm, wm_zm, zm ) - call stat_update_var( iug, ug, zt ) - call stat_update_var( ivg, vg, zt ) - call stat_update_var( icloud_frac, cloud_frac, zt ) - call stat_update_var( iice_supersat_frac, ice_supersat_frac, zt) - call stat_update_var( ircm_in_layer, rcm_in_layer, zt ) - call stat_update_var( icloud_cover, cloud_cover, zt ) - call stat_update_var( ip_in_Pa, p_in_Pa, zt ) - call stat_update_var( iexner, exner, zt ) - call stat_update_var( irho_ds_zt, rho_ds_zt, zt ) - call stat_update_var( ithv_ds_zt, thv_ds_zt, zt ) - call stat_update_var( iLscale, Lscale, zt ) - call stat_update_var( iwp3, wp3, zt ) - call stat_update_var( iwpthlp2, wpthlp2, zt ) - call stat_update_var( iwp2thlp, wp2thlp, zt ) - call stat_update_var( iwprtp2, wprtp2, zt ) - call stat_update_var( iwp2rtp, wp2rtp, zt ) - call stat_update_var( iLscale_up, Lscale_up, zt ) - call stat_update_var( iLscale_down, Lscale_down, zt ) - call stat_update_var( itau_zt, tau_zt, zt ) - call stat_update_var( iKh_zt, Kh_zt, zt ) - call stat_update_var( iwp2thvp, wp2thvp, zt ) - call stat_update_var( iwp2rcp, wp2rcp, zt ) - call stat_update_var( iwprtpthlp, wprtpthlp, zt ) - call stat_update_var( isigma_sqd_w_zt, sigma_sqd_w_zt, zt ) - call stat_update_var( irho, rho, zt ) - call stat_update_var( irsat, rsat, zt ) - if ( irsati > 0 ) then - rsati = sat_mixrat_ice( p_in_Pa, T_in_K ) - call stat_update_var( irsati, rsati, zt ) - end if - - call stat_update_var( imixt_frac, pdf_params%mixt_frac, zt ) - call stat_update_var( iw1, pdf_params%w1, zt ) - call stat_update_var( iw2, pdf_params%w2, zt ) - call stat_update_var( ivarnce_w1, pdf_params%varnce_w1, zt ) - call stat_update_var( ivarnce_w2, pdf_params%varnce_w2, zt ) - call stat_update_var( ithl1, pdf_params%thl1, zt ) - call stat_update_var( ithl2, pdf_params%thl2, zt ) - call stat_update_var( ivarnce_thl1, pdf_params%varnce_thl1, zt ) - call stat_update_var( ivarnce_thl2, pdf_params%varnce_thl2, zt ) - call stat_update_var( irt1, pdf_params%rt1, zt ) - call stat_update_var( irt2, pdf_params%rt2, zt ) - call stat_update_var( ivarnce_rt1, pdf_params%varnce_rt1, zt ) - call stat_update_var( ivarnce_rt2, pdf_params%varnce_rt2, zt ) - call stat_update_var( irc1, pdf_params%rc1, zt ) - call stat_update_var( irc2, pdf_params%rc2, zt ) - call stat_update_var( irsl1, pdf_params%rsl1, zt ) - call stat_update_var( irsl2, pdf_params%rsl2, zt ) - call stat_update_var( icloud_frac1, pdf_params%cloud_frac1, zt ) - call stat_update_var( icloud_frac2, pdf_params%cloud_frac2, zt ) - call stat_update_var( is1, pdf_params%s1, zt ) - call stat_update_var( is2, pdf_params%s2, zt ) - call stat_update_var( istdev_s1, pdf_params%stdev_s1, zt ) - call stat_update_var( istdev_s2, pdf_params%stdev_s2, zt ) - call stat_update_var( istdev_t1, pdf_params%stdev_t1, zt ) - call stat_update_var( istdev_t2, pdf_params%stdev_t2, zt ) - call stat_update_var( icovar_st_1, pdf_params%covar_st_1, zt ) - call stat_update_var( icovar_st_2, pdf_params%covar_st_2, zt ) - call stat_update_var( icorr_st_1, pdf_params%corr_st_1, zt ) - call stat_update_var( icorr_st_2, pdf_params%corr_st_2, zt ) - call stat_update_var( irrtthl, pdf_params%rrtthl, zt ) - call stat_update_var( icrt1, pdf_params%crt1, zt ) - call stat_update_var( icrt2, pdf_params%crt2, zt ) - call stat_update_var( icthl1, pdf_params%cthl1, zt ) - call stat_update_var( icthl2, pdf_params%cthl2, zt ) - call stat_update_var( iwp2_zt, wp2_zt, zt ) - call stat_update_var( ithlp2_zt, thlp2_zt, zt ) - call stat_update_var( iwpthlp_zt, wpthlp_zt, zt ) - call stat_update_var( iwprtp_zt, wprtp_zt, zt ) - call stat_update_var( irtp2_zt, rtp2_zt, zt ) - call stat_update_var( irtpthlp_zt, rtpthlp_zt, zt ) - call stat_update_var( iup2_zt, up2_zt, zt ) - call stat_update_var( ivp2_zt, vp2_zt, zt ) - call stat_update_var( iupwp_zt, upwp_zt, zt ) - call stat_update_var( ivpwp_zt, vpwp_zt, zt ) - call stat_update_var( ia3_coef_zt, a3_coef_zt, zt ) - call stat_update_var( iwp3_on_wp2_zt, wp3_on_wp2_zt, zt ) - - if ( is_mellor > 0 ) then - ! Determine 's' from Mellor (1977) (extended liquid water) - s_mellor(:) = pdf_params%mixt_frac * pdf_params%s1 & - + (1.0_core_rknd-pdf_params%mixt_frac) * pdf_params%s2 - call stat_update_var( is_mellor, s_mellor, zt ) - end if - - if ( sclr_dim > 0 ) then - do i=1, sclr_dim - call stat_update_var( isclrm(i), sclrm(:,i), zt ) - call stat_update_var( isclrm_f(i), sclrm_forcing(:,i), zt ) - end do - end if - - if ( edsclr_dim > 0 ) then - do i=1, edsclr_dim - call stat_update_var( iedsclrm(i), edsclrm(:,i), zt ) - call stat_update_var( iedsclrm_f(i), edsclrm_forcing(:,i), zt ) - end do - end if - - ! zm variables - - call stat_update_var( iwp2, wp2, zm ) - call stat_update_var( iwp3_zm, wp3_zm, zm ) - call stat_update_var( irtp2, rtp2, zm ) - call stat_update_var( ithlp2, thlp2, zm ) - call stat_update_var( irtpthlp, rtpthlp, zm ) - call stat_update_var( iwprtp, wprtp, zm ) - call stat_update_var( iwpthlp, wpthlp, zm ) - call stat_update_var( iwp4, wp4, zm ) - call stat_update_var( iwpthvp, wpthvp, zm ) - call stat_update_var( irtpthvp, rtpthvp, zm ) - call stat_update_var( ithlpthvp, thlpthvp, zm ) - call stat_update_var( itau_zm, tau_zm, zm ) - call stat_update_var( iKh_zm, Kh_zm, zm ) - call stat_update_var( iwprcp, wprcp, zm ) - call stat_update_var( irc_coef, rc_coef, zm ) - call stat_update_var( ithlprcp, thlprcp, zm ) - call stat_update_var( irtprcp, rtprcp, zm ) - call stat_update_var( ircp2, rcp2, zm ) - call stat_update_var( iupwp, upwp, zm ) - call stat_update_var( ivpwp, vpwp, zm ) - call stat_update_var( ivp2, vp2, zm ) - call stat_update_var( iup2, up2, zm ) - call stat_update_var( irho_zm, rho_zm, zm ) - call stat_update_var( isigma_sqd_w, sigma_sqd_w, zm ) - call stat_update_var( irho_ds_zm, rho_ds_zm, zm ) - call stat_update_var( ithv_ds_zm, thv_ds_zm, zm ) - call stat_update_var( iem, em, zm ) - call stat_update_var( iFrad, Frad, zm ) - - call stat_update_var( iSkw_velocity, Skw_velocity, zm ) - call stat_update_var( ia3_coef, a3_coef, zm ) - call stat_update_var( iwp3_on_wp2, wp3_on_wp2, zm ) - - call stat_update_var( icloud_frac_zm, cloud_frac_zm, zm ) - call stat_update_var( iice_supersat_frac_zm, ice_supersat_frac_zm, zm ) - call stat_update_var( ircm_zm, rcm_zm, zm ) - call stat_update_var( irtm_zm, rtm_zm, zm ) - call stat_update_var( ithlm_zm, thlm_zm, zm ) - - if ( sclr_dim > 0 ) then - do i=1, sclr_dim - call stat_update_var( isclrp2(i), sclrp2(:,i), zm ) - call stat_update_var( isclrprtp(i), sclrprtp(:,i), zm ) - call stat_update_var( isclrpthvp(i), sclrpthvp(:,i), zm ) - call stat_update_var( isclrpthlp(i), sclrpthlp(:,i), zm ) - call stat_update_var( isclrprcp(i), sclrprcp(:,i), zm ) - call stat_update_var( iwpsclrp(i), wpsclrp(:,i), zm ) - call stat_update_var( iwp2sclrp(i), wp2sclrp(:,i), zm ) - call stat_update_var( iwpsclrp2(i), wpsclrp2(:,i), zm ) - call stat_update_var( iwpsclrprtp(i), wpsclrprtp(:,i), zm ) - call stat_update_var( iwpsclrpthlp(i), wpsclrpthlp(:,i), zm ) - end do - end if - if ( edsclr_dim > 0 ) then - do i=1, edsclr_dim - call stat_update_var( iwpedsclrp(i), wpedsclrp(:,i), zm ) - end do - end if - - ! Calculate shear production - if ( ishear > 0 ) then - do k = 1, gr%nz-1, 1 - shear(k) = - upwp(k) * ( um(k+1) - um(k) ) * gr%invrs_dzm(k) & - - vpwp(k) * ( vm(k+1) - vm(k) ) * gr%invrs_dzm(k) - enddo - shear(gr%nz) = 0.0_core_rknd - end if - call stat_update_var( ishear, shear, zm ) - - ! sfc variables - - ! Cloud cover - call stat_update_var_pt( icc, 1, maxval( cloud_frac(1:gr%nz) ), sfc ) - - ! Cloud base - if ( iz_cloud_base > 0 ) then - - k = 1 - do while ( rcm(k) < rc_tol .and. k < gr%nz ) - k = k + 1 - enddo - - if ( k > 1 .and. k < gr%nz) then - - ! Use linear interpolation to find the exact height of the - ! rc_tol kg/kg level. Brian. - call stat_update_var_pt( iz_cloud_base, 1, lin_int( rc_tol, rcm(k), & - rcm(k-1), gr%zt(k), gr%zt(k-1) ), sfc ) - - else - - ! Set the cloud base output to -10m, if it's clear. - call stat_update_var_pt( iz_cloud_base, 1, -10.0_core_rknd , sfc ) ! Known magic number - - end if ! k > 1 and k < gr%nz - - end if ! iz_cloud_base > 0 - - ! Liquid Water Path - if ( ilwp > 0 ) then - - xtmp & - = vertical_integral & - ( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & - rcm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ) - - call stat_update_var_pt( ilwp, 1, xtmp, sfc ) - - end if - - ! Vapor Water Path (Preciptable Water) - if ( ivwp > 0 ) then - - xtmp & - = vertical_integral & - ( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & - ( rtm(2:gr%nz) - rcm(2:gr%nz) ), gr%invrs_dzt(2:gr%nz) ) - - call stat_update_var_pt( ivwp, 1, xtmp, sfc ) - - end if - - - ! Vertical average of thermodynamic level variables. - - ! Find the vertical average of thermodynamic level variables, averaged from - ! level 2 (the first thermodynamic level above model surface) through - ! level gr%nz (the top of the model). Use the vertical averaging function - ! found in fill_holes.F90. - - ! Vertical average of thlm. - call stat_update_var_pt( ithlm_vert_avg, 1, & - vertical_avg( (gr%nz-2+1), rho_ds_zt(2:gr%nz), & - thlm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ), & - sfc ) - - ! Vertical average of rtm. - call stat_update_var_pt( irtm_vert_avg, 1, & - vertical_avg( (gr%nz-2+1), rho_ds_zt(2:gr%nz), & - rtm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ), & - sfc ) - - ! Vertical average of um. - call stat_update_var_pt( ium_vert_avg, 1, & - vertical_avg( (gr%nz-2+1), rho_ds_zt(2:gr%nz), & - um(2:gr%nz), gr%invrs_dzt(2:gr%nz) ), & - sfc ) - - ! Vertical average of vm. - call stat_update_var_pt( ivm_vert_avg, 1, & - vertical_avg( (gr%nz-2+1), rho_ds_zt(2:gr%nz), & - vm(2:gr%nz), gr%invrs_dzt(2:gr%nz) ), & - sfc ) - - ! Vertical average of momentum level variables. - - ! Find the vertical average of momentum level variables, averaged over the - ! entire vertical profile (level 1 through level gr%nz). Use the vertical - ! averaging function found in fill_holes.F90. - - ! Vertical average of wp2. - call stat_update_var_pt( iwp2_vert_avg, 1, & - vertical_avg( (gr%nz-1+1), rho_ds_zm(1:gr%nz), & - wp2(1:gr%nz), gr%invrs_dzm(1:gr%nz) ), & - sfc ) - - ! Vertical average of up2. - call stat_update_var_pt( iup2_vert_avg, 1, & - vertical_avg( (gr%nz-1+1), rho_ds_zm(1:gr%nz), & - up2(1:gr%nz), gr%invrs_dzm(1:gr%nz) ), & - sfc ) - - ! Vertical average of vp2. - call stat_update_var_pt( ivp2_vert_avg, 1, & - vertical_avg( (gr%nz-1+1), rho_ds_zm(1:gr%nz), & - vp2(1:gr%nz), gr%invrs_dzm(1:gr%nz) ), & - sfc ) - - ! Vertical average of rtp2. - call stat_update_var_pt( irtp2_vert_avg, 1, & - vertical_avg( (gr%nz-1+1), rho_ds_zm(1:gr%nz), & - rtp2(1:gr%nz), gr%invrs_dzm(1:gr%nz) ), & - sfc ) - - ! Vertical average of thlp2. - call stat_update_var_pt( ithlp2_vert_avg, 1, & - vertical_avg( (gr%nz-1+1), rho_ds_zm(1:gr%nz), & - thlp2(1:gr%nz), gr%invrs_dzm(1:gr%nz) ), & - sfc ) - - - end if ! l_stats_samp - - - return - end subroutine stats_accumulate -!------------------------------------------------------------------------------ - subroutine stats_accumulate_hydromet( hydromet, rho_ds_zt ) -! Description: -! Compute stats related the hydrometeors - -! References: -! None -!------------------------------------------------------------------------------ - use crmx_parameters_model, only: & - hydromet_dim ! Variable(s) - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_array_index, only: & - iirrainm, iirsnowm, iiricem, iirgraupelm, & ! Variable(s) - iiNrm, iiNsnowm, iiNim, iiNgraupelm - - use crmx_stats_variables, only: & - sfc, & ! Variable(s) - irrainm, & - irsnowm, & - iricem, & - irgraupelm, & - iNim, & - iNrm, & - iNsnowm, & - iNgraupelm, & - iswp, & - irwp, & - iiwp - - use crmx_fill_holes, only: & - vertical_integral ! Procedure(s) - - use crmx_stats_type, only: & - stat_update_var, & ! Procedure(s) - stat_update_var_pt - - use crmx_stats_variables, only: & - zt, & ! Variables - l_stats_samp - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), dimension(gr%nz,hydromet_dim), intent(in) :: & - hydromet ! All hydrometeors except for rcm [units vary] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - rho_ds_zt ! Dry, static density (thermo. levs.) [kg/m^3] - - ! Local Variables - real(kind=core_rknd) :: xtmp - - ! ---- Begin Code ---- - - if ( l_stats_samp ) then - - if ( iirrainm > 0 ) then - call stat_update_var( irrainm, hydromet(:,iirrainm), zt ) - end if - - if ( iirsnowm > 0 ) then - call stat_update_var( irsnowm, hydromet(:,iirsnowm), zt ) - end if - - if ( iiricem > 0 ) then - call stat_update_var( iricem, hydromet(:,iiricem), zt ) - end if - - if ( iirgraupelm > 0 ) then - call stat_update_var( irgraupelm, & - hydromet(:,iirgraupelm), zt ) - end if - - if ( iiNim > 0 ) then - call stat_update_var( iNim, hydromet(:,iiNim), zt ) - end if - - if ( iiNrm > 0 ) then - call stat_update_var( iNrm, hydromet(:,iiNrm), zt ) - end if - - if ( iiNsnowm > 0 ) then - call stat_update_var( iNsnowm, hydromet(:,iiNsnowm), zt ) - end if - - if ( iiNgraupelm > 0 ) then - call stat_update_var( iNgraupelm, hydromet(:,iiNgraupelm), zt ) - end if - - ! Snow Water Path - if ( iswp > 0 .and. iirsnowm > 0 ) then - - ! Calculate snow water path - xtmp & - = vertical_integral & - ( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & - hydromet(2:gr%nz,iirsnowm), gr%invrs_dzt(2:gr%nz) ) - - call stat_update_var_pt( iswp, 1, xtmp, sfc ) - - end if ! iswp > 0 .and. iirsnowm > 0 - - ! Ice Water Path - if ( iiwp > 0 .and. iiricem > 0 ) then - - xtmp & - = vertical_integral & - ( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & - hydromet(2:gr%nz,iiricem), gr%invrs_dzt(2:gr%nz) ) - - call stat_update_var_pt( iiwp, 1, xtmp, sfc ) - - end if - - ! Rain Water Path - if ( irwp > 0 .and. iirrainm > 0 ) then - - xtmp & - = vertical_integral & - ( (gr%nz - 2 + 1), rho_ds_zt(2:gr%nz), & - hydromet(2:gr%nz,iirrainm), gr%invrs_dzt(2:gr%nz) ) - - call stat_update_var_pt( irwp, 1, xtmp, sfc ) - - end if ! irwp > 0 .and. irrainm > 0 - end if ! l_stats_samp - - return - end subroutine stats_accumulate_hydromet -!------------------------------------------------------------------------------ - subroutine stats_accumulate_LH_tend( LH_hydromet_mc, LH_thlm_mc, LH_rvm_mc, LH_rcm_mc ) -! Description: -! Compute stats for the tendency of latin hypercube sample points. - -! References: -! None -!------------------------------------------------------------------------------ - use crmx_parameters_model, only: & - hydromet_dim ! Variable(s) - - use crmx_grid_class, only: & - gr ! Variable(s) - - use crmx_array_index, only: & - iirrainm, iirsnowm, iiricem, iirgraupelm, & ! Variable(s) - iiNrm, iiNsnowm, iiNim, iiNgraupelm, iiNcm - - use crmx_stats_variables, only: & - iLH_rrainm_mc, & ! Variable(s) - iLH_rsnowm_mc, & - iLH_ricem_mc, & - iLH_rgraupelm_mc, & - iLH_Ncm_mc, & - iLH_Nim_mc, & - iLH_Nrm_mc, & - iLH_Nsnowm_mc, & - iLH_Ngraupelm_mc, & - iLH_rcm_mc, & - iLH_rvm_mc, & - iLH_thlm_mc - - use crmx_stats_variables, only: & - iAKstd, & ! Variable(s) - iAKstd_cld, & - iAKm_rcm, & - iAKm_rcc, & - iAKm, & - iLH_AKm, & - iLH_rcm_avg - - use crmx_variables_diagnostic_module, only: & - AKm, & ! Variable(s) - lh_AKm, & - AKstd, & - lh_rcm_avg, & - AKstd_cld, & - AKm_rcm, & - AKm_rcc - - use crmx_stats_type, only: & - stat_update_var ! Procedure(s) - - use crmx_stats_variables, only: & - LH_zt, & ! Variables - l_stats_samp - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - real( kind = core_rknd ), dimension(gr%nz,hydromet_dim), intent(in) :: & - LH_hydromet_mc ! Tendency of hydrometeors except for rvm/rcm [units vary] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - LH_thlm_mc, & ! Tendency of liquid potential temperature [kg/kg/s] - LH_rcm_mc, & ! Tendency of cloud water [kg/kg/s] - LH_rvm_mc ! Tendency of vapor [kg/kg/s] - - if ( l_stats_samp ) then - - call stat_update_var( iLH_thlm_mc, LH_thlm_mc, LH_zt ) - call stat_update_var( iLH_rcm_mc, LH_rcm_mc, LH_zt ) - call stat_update_var( iLH_rvm_mc, LH_rvm_mc, LH_zt ) - - if ( iiNcm > 0 ) then - call stat_update_var( iLH_Ncm_mc, LH_hydromet_mc(:,iiNcm), LH_zt ) - end if - - if ( iirrainm > 0 ) then - call stat_update_var( iLH_rrainm_mc, LH_hydromet_mc(:,iirrainm), LH_zt ) - end if - - if ( iirsnowm > 0 ) then - call stat_update_var( iLH_rsnowm_mc, LH_hydromet_mc(:,iirsnowm), LH_zt ) - end if - - if ( iiricem > 0 ) then - call stat_update_var( iLH_ricem_mc, LH_hydromet_mc(:,iiricem), LH_zt ) - end if - - if ( iirgraupelm > 0 ) then - call stat_update_var( iLH_rgraupelm_mc, LH_hydromet_mc(:,iirgraupelm), LH_zt ) - end if - - if ( iiNim > 0 ) then - call stat_update_var( iLH_Nim_mc, LH_hydromet_mc(:,iiNim), LH_zt ) - end if - - if ( iiNrm > 0 ) then - call stat_update_var( iLH_Nrm_mc, LH_hydromet_mc(:,iiNrm), LH_zt ) - end if - - if ( iiNsnowm > 0 ) then - call stat_update_var( iLH_Nsnowm_mc, LH_hydromet_mc(:,iiNsnowm), LH_zt ) - end if - - if ( iiNgraupelm > 0 ) then - call stat_update_var( iLH_Ngraupelm_mc, LH_hydromet_mc(:,iiNgraupelm), LH_zt ) - end if - - call stat_update_var( iAKm, AKm, LH_zt ) - call stat_update_var( iLH_AKm, lh_AKm, LH_zt) - call stat_update_var( iLH_rcm_avg, lh_rcm_avg, LH_zt ) - call stat_update_var( iAKstd, AKstd, LH_zt ) - call stat_update_var( iAKstd_cld, AKstd_cld, LH_zt ) - - call stat_update_var( iAKm_rcm, AKm_rcm, LH_zt) - call stat_update_var( iAKm_rcc, AKm_rcc, LH_zt ) - - end if ! l_stats_samp - - return - end subroutine stats_accumulate_LH_tend - - !----------------------------------------------------------------------- - subroutine stats_finalize( ) - - ! Description: - ! Close NetCDF files and deallocate scratch space and - ! stats file structures. - !----------------------------------------------------------------------- - - use crmx_stats_variables, only: & - zt, & ! Variable(s) - LH_zt, & - LH_sfc, & - zm, & - rad_zt, & - rad_zm, & - sfc, & - l_netcdf, & - l_stats, & - l_output_rad_files - - use crmx_stats_variables, only: & - ztscr01, & ! Variable(s) - ztscr02, & - ztscr03, & - ztscr04, & - ztscr05, & - ztscr06, & - ztscr07, & - ztscr08, & - ztscr09, & - ztscr10, & - ztscr11, & - ztscr12, & - ztscr13, & - ztscr14, & - ztscr15, & - ztscr16, & - ztscr17, & - ztscr18, & - ztscr19, & - ztscr20, & - ztscr21 - - use crmx_stats_variables, only: & - zmscr01, & ! Variable(s) - zmscr02, & - zmscr03, & - zmscr04, & - zmscr05, & - zmscr06, & - zmscr07, & - zmscr08, & - zmscr09, & - zmscr10, & - zmscr11, & - zmscr12, & - zmscr13, & - zmscr14, & - zmscr15, & - zmscr16, & - zmscr17 - - !use stats_variables, only: & - ! radscr01, & ! Variable(s) - ! radscr02, & - ! radscr03, & - ! radscr04, & - ! radscr05, & - ! radscr06, & - ! radscr07, & - ! radscr08, & - ! radscr09, & - ! radscr10, & - ! radscr11, & - ! radscr12, & - ! radscr13, & - ! radscr14, & - ! radscr15, & - ! radscr16, & - ! radscr17 - - use crmx_stats_variables, only: & - isclrm, & - isclrm_f, & - iedsclrm, & - iedsclrm_f, & - isclrprtp, & - isclrp2, & - isclrpthvp, & - isclrpthlp, & - isclrprcp, & - iwpsclrp, & - iwp2sclrp, & - iwpsclrp2, & - iwpsclrprtp, & - iwpsclrpthlp, & - iwpedsclrp - - use crmx_parameters_microphys, only: & - LH_microphys_disabled ! Constant(s) - - use crmx_parameters_microphys, only: & - LH_microphys_type ! Variable(s) - -#ifdef NETCDF - use crmx_output_netcdf, only: & - close_netcdf ! Procedure -#endif - - implicit none - - if ( l_stats .and. l_netcdf ) then -#ifdef NETCDF - call close_netcdf( zt%f ) - call close_netcdf( LH_zt%f ) - call close_netcdf( LH_sfc%f ) - call close_netcdf( zm%f ) - call close_netcdf( rad_zt%f ) - call close_netcdf( rad_zm%f ) - call close_netcdf( sfc%f ) -#else - stop "This program was not compiled with netCDF support" -#endif - end if - - if ( l_stats ) then - ! De-allocate all zt variables - deallocate( zt%z ) - - deallocate( zt%x ) - - deallocate( zt%n ) - deallocate( zt%l_in_update ) - - - deallocate( zt%f%var ) - deallocate( zt%f%z ) - deallocate( zt%f%rlat ) - deallocate( zt%f%rlon ) - - deallocate ( ztscr01 ) - deallocate ( ztscr02 ) - deallocate ( ztscr03 ) - deallocate ( ztscr04 ) - deallocate ( ztscr05 ) - deallocate ( ztscr06 ) - deallocate ( ztscr07 ) - deallocate ( ztscr08 ) - deallocate ( ztscr09 ) - deallocate ( ztscr10 ) - deallocate ( ztscr11 ) - deallocate ( ztscr12 ) - deallocate ( ztscr13 ) - deallocate ( ztscr14 ) - deallocate ( ztscr15 ) - deallocate ( ztscr16 ) - deallocate ( ztscr17 ) - deallocate ( ztscr18 ) - deallocate ( ztscr19 ) - deallocate ( ztscr20 ) - deallocate ( ztscr21 ) - - if ( LH_microphys_type /= LH_microphys_disabled ) then - ! De-allocate all LH_zt variables - deallocate( LH_zt%z ) - - deallocate( LH_zt%x ) - - deallocate( LH_zt%n ) - deallocate( LH_zt%l_in_update ) - - - deallocate( LH_zt%f%var ) - deallocate( LH_zt%f%z ) - deallocate( LH_zt%f%rlat ) - deallocate( LH_zt%f%rlon ) - - ! De-allocate all LH_sfc variables - deallocate( LH_sfc%z ) - - deallocate( LH_sfc%x ) - - deallocate( LH_sfc%n ) - deallocate( LH_sfc%l_in_update ) - - - deallocate( LH_sfc%f%var ) - deallocate( LH_sfc%f%z ) - deallocate( LH_sfc%f%rlat ) - deallocate( LH_sfc%f%rlon ) - end if - - ! De-allocate all zm variables - deallocate( zm%z ) - - deallocate( zm%x ) - deallocate( zm%n ) - - deallocate( zm%f%var ) - deallocate( zm%f%z ) - deallocate( zm%f%rlat ) - deallocate( zm%f%rlon ) - deallocate( zm%l_in_update ) - - deallocate ( zmscr01 ) - deallocate ( zmscr02 ) - deallocate ( zmscr03 ) - deallocate ( zmscr04 ) - deallocate ( zmscr05 ) - deallocate ( zmscr06 ) - deallocate ( zmscr07 ) - deallocate ( zmscr08 ) - deallocate ( zmscr09 ) - deallocate ( zmscr10 ) - deallocate ( zmscr11 ) - deallocate ( zmscr12 ) - deallocate ( zmscr13 ) - deallocate ( zmscr14 ) - deallocate ( zmscr15 ) - deallocate ( zmscr16 ) - deallocate ( zmscr17 ) - - if (l_output_rad_files) then - ! De-allocate all rad_zt variables - deallocate( rad_zt%z ) - - deallocate( rad_zt%x ) - deallocate( rad_zt%n ) - - deallocate( rad_zt%f%var ) - deallocate( rad_zt%f%z ) - deallocate( rad_zt%f%rlat ) - deallocate( rad_zt%f%rlon ) - deallocate( rad_zt%l_in_update ) - - ! De-allocate all rad_zm variables - deallocate( rad_zm%z ) - - deallocate( rad_zm%x ) - deallocate( rad_zm%n ) - - deallocate( rad_zm%f%var ) - deallocate( rad_zm%f%z ) - deallocate( rad_zm%l_in_update ) - - !deallocate ( radscr01 ) - !deallocate ( radscr02 ) - !deallocate ( radscr03 ) - !deallocate ( radscr04 ) - !deallocate ( radscr05 ) - !deallocate ( radscr06 ) - !deallocate ( radscr07 ) - !deallocate ( radscr08 ) - !deallocate ( radscr09 ) - !deallocate ( radscr10 ) - !deallocate ( radscr11 ) - !deallocate ( radscr12 ) - !deallocate ( radscr13 ) - !deallocate ( radscr14 ) - !deallocate ( radscr15 ) - !deallocate ( radscr16 ) - !deallocate ( radscr17 ) - end if ! l_output_rad_files - - ! De-allocate all sfc variables - deallocate( sfc%z ) - - deallocate( sfc%x ) - deallocate( sfc%n ) - deallocate( sfc%l_in_update ) - - deallocate( sfc%f%var ) - deallocate( sfc%f%z ) - deallocate( sfc%f%rlat ) - deallocate( sfc%f%rlon ) - - ! De-allocate scalar indices - deallocate( isclrm ) - deallocate( isclrm_f ) - deallocate( iedsclrm ) - deallocate( iedsclrm_f ) - deallocate( isclrprtp ) - deallocate( isclrp2 ) - deallocate( isclrpthvp ) - deallocate( isclrpthlp ) - deallocate( isclrprcp ) - deallocate( iwpsclrp ) - deallocate( iwp2sclrp ) - deallocate( iwpsclrp2 ) - deallocate( iwpsclrprtp ) - deallocate( iwpsclrpthlp ) - deallocate( iwpedsclrp ) - - end if ! l_stats - - - return - end subroutine stats_finalize - -!=============================================================================== - -end module crmx_stats_subs diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_type.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_type.F90 deleted file mode 100644 index f9c27a287e..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_stats_type.F90 +++ /dev/null @@ -1,524 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: stats_type.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -!=============================================================================== -module crmx_stats_type - - ! Description: - ! Contains derived data type 'stats'. - ! Used for storing output statistics to disk. - !----------------------------------------------------------------------- - - use crmx_stat_file_module, only: & - stat_file ! Type - - use crmx_clubb_precision, only: & - stat_rknd, & ! Variable(s) - stat_nknd, & - core_rknd - - implicit none - - private ! Set Default Scope - - public :: stats, & - stat_assign, & - stat_update_var, & - stat_update_var_pt, & - stat_begin_update, & - stat_begin_update_pt, & - stat_end_update, & - stat_end_update_pt, & - stat_modify, & - stat_modify_pt - - ! Derived data types to store GrADS/netCDF statistics - type stats - - ! Number of fields to sample - integer :: nn - - ! Vertical extent of variable - integer :: kk - - ! Vertical levels - real( kind = core_rknd ), pointer, dimension(:) :: z - - ! Array to store sampled fields - - real(kind=stat_rknd), pointer, dimension(:,:,:,:) :: x - - integer(kind=stat_nknd), pointer, dimension(:,:,:,:) :: n - - ! Tracks if a field is in the process of an update - logical, pointer, dimension(:,:,:,:) :: l_in_update - - ! Data for GrADS / netCDF output - - type (stat_file) f - - end type stats - - contains - - !============================================================================= - subroutine stat_assign( var_index, var_name, & - var_description, var_units, grid_kind ) - - ! Description: - ! Assigns pointers for statistics variables in grid. - !----------------------------------------------------------------------- - - implicit none - - ! Input Variables - - integer,intent(in) :: var_index ! Variable index [#] - character(len = *), intent(in) :: var_name ! Variable name [] - character(len = *), intent(in) :: var_description ! Variable description [] - character(len = *), intent(in) :: var_units ! Variable units [] - - ! Output Variable - - ! Which grid the variable is located on (zt, zm, or sfc ) - type(stats), intent(inout) :: grid_kind - - grid_kind%f%var(var_index)%ptr => grid_kind%x(:,:,:,var_index) - grid_kind%f%var(var_index)%name = var_name - grid_kind%f%var(var_index)%description = var_description - grid_kind%f%var(var_index)%units = var_units - - !Example of the old format - !changed by Joshua Fasching 23 August 2007 - - !zt%f%var(ithlm)%ptr => zt%x(:,k) - !zt%f%var(ithlm)%name = "thlm" - !zt%f%var(ithlm)%description = "thetal (K)" - !zt%f%var(ithlm)%units = "K" - - return - - end subroutine stat_assign - - !============================================================================= - subroutine stat_update_var( var_index, value, grid_kind ) - - ! Description: - ! This updates the value of a statistics variable located at var_index - ! associated with grid type 'grid_kind' (zt, zm, or sfc). - ! - ! This subroutine is used when a statistical variable needs to be updated - ! only once during a model timestep. - ! - ! In regards to budget terms, this subroutine is used for variables that - ! are either completely implicit (e.g. wprtp_ma) or completely explicit - ! (e.g. wp2_pr3). For completely implicit terms, once the variable has been - ! solved for, the implicit contribution can be finalized. The finalized - ! implicit contribution is sent into stat_update_var_pt. For completely - ! explicit terms, the explicit contribution is sent into stat_update_var_pt - ! once it has been calculated. - !--------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - stat_rknd ! Constant - - implicit none - - ! Input Variables(s) - - integer, intent(in) :: & - var_index ! The index at which the variable is stored [] - - ! Input/Output Variable(s) - type(stats), intent(inout) :: & - grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc ) - - ! Input Variable(s) NOTE: Due to the implicit none above, these must - ! be declared below to allow the use of grid_kind - - real( kind = core_rknd ), dimension(grid_kind%kk), intent(in) :: & - value ! Value of field being added to the statistic [Units Vary] - - integer :: k - - if ( var_index > 0 ) then - do k = 1, grid_kind%kk - grid_kind%x(1,1,k,var_index) = & - grid_kind%x(1,1,k,var_index) + real( value(k), kind=stat_rknd ) - grid_kind%n(1,1,k,var_index) = & - grid_kind%n(1,1,k,var_index) + 1 - end do - endif - - return - end subroutine stat_update_var - - !============================================================================= - subroutine stat_update_var_pt( var_index, grid_level, value, grid_kind ) - - ! Description: - ! This updates the value of a statistics variable located at var_index - ! associated with grid type 'grid_kind' at a specific grid_level. - ! - ! See the description of stat_update_var for more details. - !--------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - stat_rknd ! Constant - - implicit none - - ! Input Variables(s) - - integer, intent(in) :: & - var_index, & ! The index at which the variable is stored [] - grid_level ! The level at which the variable is to be modified [] - - real( kind = core_rknd ), intent(in) :: & - value ! Value of field being added to the statistic [Units Vary] - - ! Input/Output Variable(s) - type(stats), intent(inout) :: & - grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). - - if ( var_index > 0 ) then - - grid_kind%x(1,1,grid_level,var_index) = grid_kind%x(1,1,grid_level,var_index) & - + real( value, kind=stat_rknd ) - - grid_kind%n(1,1,grid_level,var_index) = grid_kind%n(1,1,grid_level,var_index) + 1 - - endif - - return - end subroutine stat_update_var_pt - - !============================================================================= - subroutine stat_begin_update( var_index, value, & - grid_kind ) - - ! Description: - ! This begins an update of the value of a statistics variable located at - ! var_index on the (zt, zm, or sfc) grid. It is used in conjunction with - ! subroutine stat_end_update. - ! - ! This subroutine is used when a statistical variable needs to be updated - ! more than one time during a model timestep. Commonly, this is used for - ! beginning a budget term calculation. - ! - ! In this type of stats calculation, we first subtract the field - ! (e.g. rtm / dt ) from the statistic, then update rtm by a term - ! (e.g. clip rtm), and then re-add the field (e.g. rtm / dt) to the - ! statistic. - ! - ! Example: - ! - ! call stat_begin_update( irtm_bt, real(rtm / dt), zt ) - ! - ! !!! Perform clipping of rtm !!! - ! - ! call stat_end_update( irtm_bt, real(rtm / dt), zt ) - ! - ! This subroutine is often used with stats budget terms for variables that - ! have both implicit and explicit components (e.g. wp3_ta). The explicit - ! component is sent into stat_begin_update_pt (with the sign reversed - ! because stat_begin_update_pt automatically subtracts the value sent into - ! it). Then, once the variable has been solved for, the implicit - ! statistical contribution can be finalized. The finalized implicit - ! component is sent into stat_end_update_pt. - !--------------------------------------------------------------------- - - use crmx_grid_class, only: gr ! Variable(s) - - implicit none - - ! Input Variables(s) - - integer, intent(in) :: & - var_index ! The index at which the variable is stored [] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - value ! Value of field being added to the statistic [Units Vary] - - ! Input/Output Variable(s) - type(stats), intent(inout) :: & - grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). - - integer :: i - - do i = 1, gr%nz - - call stat_begin_update_pt & - ( var_index, i, value(i), grid_kind ) - - enddo - - return - end subroutine stat_begin_update - - !============================================================================= - subroutine stat_begin_update_pt & - ( var_index, grid_level, value, grid_kind ) - - ! Description: - ! This begins an update of the value of a statistics variable located at - ! var_index associated with the grid type (grid_kind) at a specific - ! grid_level. It is used in conjunction with subroutine stat_end_update_pt. - ! - ! Notes: - ! Commonly this is used for beginning a budget. See the description of - ! stat_begin_update for more details. - ! - ! References: - ! None - !--------------------------------------------------------------------- - - use crmx_error_code, only: clubb_debug ! Procedure(s) - - use crmx_clubb_precision, only: & - stat_rknd ! Constant - - implicit none - - ! Input Variables(s) - - integer, intent(in) :: & - var_index, & ! The index at which the variable is stored [] - grid_level ! The level at which the variable is to be modified [] - - real( kind = core_rknd ), intent(in) :: & - value ! Value of field being added to the statistic [Units Vary] - - ! Input/Output Variable(s) - type(stats), intent(inout) :: & - grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). - - ! ---- Begin Code ---- - - if ( var_index > 0 ) then ! Are we storing this variable? - - if ( .not. grid_kind%l_in_update(1,1,grid_level,var_index) ) then ! Can we begin an update? - - grid_kind%x(1,1,grid_level, var_index) = & - grid_kind%x(1,1,grid_level, var_index) - real( value, kind=stat_rknd ) - - grid_kind%l_in_update(1,1,grid_level, var_index) = .true. ! Start Record - - else - - call clubb_debug( 1, & - "Beginning an update before finishing previous for variable: "// & - trim( grid_kind%f%var(var_index)%name ) ) - endif - - endif - - return - end subroutine stat_begin_update_pt - - !============================================================================= - subroutine stat_end_update( var_index, value, grid_kind ) - - ! Description: - ! This ends an update of the value of a statistics variable located at - ! var_index on the (zt, zm, or sfc) grid. It is used in conjunction with - ! subroutine stat_begin_update. - ! - ! This subroutine is used when a statistical variable needs to be updated - ! more than one time during a model timestep. Commonly, this is used for - ! finishing a budget term calculation. - ! - ! In this type of stats calculation, we first subtract the field - ! (e.g. rtm / dt ) from the statistic, then update rtm by a term - ! (e.g. clip rtm), and then re-add the field (e.g. rtm / dt) to the - ! statistic. - ! - ! Example: - ! - ! call stat_begin_update( irtm_bt, real(rtm / dt), zt ) - ! - ! !!! Perform clipping of rtm !!! - ! - ! call stat_end_update( irtm_bt, real(rtm / dt), zt ) - ! - ! This subroutine is often used with stats budget terms for variables that - ! have both implicit and explicit components (e.g. wp3_ta). The explicit - ! component is sent into stat_begin_update_pt (with the sign reversed - ! because stat_begin_update_pt automatically subtracts the value sent into - ! it). Then, once the variable has been solved for, the implicit - ! statistical contribution can be finalized. The finalized implicit - ! component is sent into stat_end_update_pt. - !--------------------------------------------------------------------- - - use crmx_grid_class, only: gr ! Variable(s) - - implicit none - - ! Input Variables(s) - - integer, intent(in) :: & - var_index ! The index at which the variable is stored [] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - value ! Value of field being added to the statistic [Units Vary] - - ! Input/Output Variable(s) - type(stats), intent(inout) :: & - grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). - - integer :: i - - ! ---- Begin Code ---- - - do i = 1,gr%nz - call stat_end_update_pt & - ( var_index, i, value(i), grid_kind ) - enddo - - return - end subroutine stat_end_update - - !============================================================================= - subroutine stat_end_update_pt & - ( var_index, grid_level, value, grid_kind ) - - ! Description: - ! This ends an update of the value of a statistics variable located at - ! var_index associated with the grid type (grid_kind) at a specific - ! grid_level. It is used in conjunction with subroutine - ! stat_begin_update_pt. - ! - ! Commonly this is used for finishing a budget. See the description of - ! stat_end_update for more details. - !--------------------------------------------------------------------- - - use crmx_error_code, only: clubb_debug ! Procedure(s) - - implicit none - - ! Input Variables(s) - - integer, intent(in) :: & - var_index, & ! The index at which the variable is stored [] - grid_level ! The level at which the variable is to be modified [] - - real( kind = core_rknd ), intent(in) :: & - value ! Value of field being added to the statistic [Units Vary] - - ! Input/Output Variable(s) - type(stats), intent(inout) :: & - grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). - - ! ---- Begin Code ---- - - if ( var_index > 0 ) then ! Are we storing this variable? - - if ( grid_kind%l_in_update(1,1,grid_level,var_index) ) then ! Can we end an update? - - call stat_update_var_pt & - ( var_index, grid_level, value, grid_kind ) - - grid_kind%l_in_update(1,1,grid_level,var_index) = .false. ! End Record - - else - - call clubb_debug( 1, "Ending before beginning update. For variable "// & - grid_kind%f%var(var_index)%name ) - - endif - - endif - - return - end subroutine stat_end_update_pt - - !============================================================================= - subroutine stat_modify( var_index, value, & - grid_kind ) - - ! Description: - ! This modifies the value of a statistics variable located at var_index on - ! the (zt, zm, or sfc) grid. It does not increment the sampling count. - ! - ! This subroutine is normally used when a statistical variable needs to be - ! updated more than twice during a model timestep. Commonly, this is used - ! if a budget term calculation needs an intermediate modification between - ! stat_begin_update and stat_end_update. - !--------------------------------------------------------------------- - - use crmx_grid_class, only: gr ! Variable(s) - - implicit none - - ! Input Variables(s) - - integer, intent(in) :: & - var_index ! The index at which the variable is stored [] - - real( kind = core_rknd ), dimension(gr%nz), intent(in) :: & - value ! Value of field being added to the statistic [Units Vary] - - ! Input/Output Variable(s) - type(stats), intent(inout) :: & - grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). - - integer :: i - - ! ---- Begin Code ---- - - do i = 1, gr%nz - - call stat_modify_pt( var_index, i, value(i), grid_kind ) - - enddo - - return - end subroutine stat_modify - - !============================================================================= - subroutine stat_modify_pt( var_index, grid_level, value, & - grid_kind ) - - ! Description: - ! This modifies the value of a statistics variable located at var_index on - ! the grid at a specific point. It does not increment the sampling count. - ! - ! Commonly this is used for intermediate updates to a budget. See the - ! description of stat_modify for more details. - !--------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - stat_rknd ! Constant - - implicit none - - ! Input Variables(s) - - integer, intent(in) :: & - var_index ! The index at which the variable is stored [] - - - real( kind = core_rknd ), intent(in) :: & - value ! Value of field being added to the statistic [Units Vary] - - integer, intent(in) :: & - grid_level ! The level at which the variable is to be modified [] - - ! Input/Output Variable(s) - type(stats), intent(inout) :: & - grid_kind ! Which grid the variable is located on (zt, zm, rad, or sfc). - - ! ---- Begin Code ---- - - if ( var_index > 0 ) then - - grid_kind%x(1,1,grid_level,var_index ) & - = grid_kind%x(1,1,grid_level,var_index ) + real( value, kind=stat_rknd ) - - end if - - return - end subroutine stat_modify_pt - -!=============================================================================== - -end module crmx_stats_type diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_variables.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_variables.F90 deleted file mode 100644 index d571408e67..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_stats_variables.F90 +++ /dev/null @@ -1,1116 +0,0 @@ -!------------------------------------------------------------------------------- -! $Id: stats_variables.F90 6153 2013-04-09 22:13:27Z bmg2@uwm.edu $ -!------------------------------------------------------------------------------- - -! Description: -! Holds pointers and other variables for statistics to be written to -! GrADS files and netCDF files. -!------------------------------------------------------------------------------- -module crmx_stats_variables - - - use crmx_stats_type, only: & - stats ! Type - - use crmx_clubb_precision, only: & - time_precision, & ! Variable - core_rknd - - implicit none - - private ! Set Default Scope - - ! Sampling and output frequencies - real(kind=time_precision), public :: & - stats_tsamp, & ! Sampling interval [s] - stats_tout ! Output interval [s] - -!$omp threadprivate(stats_tsamp, stats_tout) - - logical, public :: & - l_stats, & ! Main flag to turn statistics on/off - l_output_rad_files, & ! Flag to turn off radiation statistics output - l_netcdf, & ! Output to NetCDF format - l_grads ! Output to GrADS format - -!$omp threadprivate(l_stats, l_netcdf, l_grads) - - logical, public :: & - l_stats_samp, & ! Sample flag for current time step - l_stats_last ! Last time step of output period - -!$omp threadprivate(l_stats_samp, l_stats_last) - - character(len=200), public :: & - fname_zt, & ! Name of the stats file for thermodynamic grid fields - fname_LH_zt, & ! Name of the stats file for LH variables on the zt grid - fname_LH_sfc, & ! Name of the stats file for LH variables on the zt grid - fname_zm, & ! Name of the stats file for momentum grid fields - fname_rad_zt, & ! Name of the stats file for the zt radiation grid fields - fname_rad_zm, & ! Name of the stats file for the zm radiation grid fields - fname_sfc ! Name of the stats file for surface only fields - -!$omp threadprivate(fname_zt, fname_zm, fname_LH_zt, fname_LH_sfc, fname_rad_zt, & -!$omp fname_rad_zm, fname_sfc) - -! Indices for statistics in zt file - - integer, public :: & - ithlm, & - ithvm, & - irtm, & - ircm, & - irvm, & - ium, & - ivm, & - iwm_zt, & - iwm_zm, & - ium_ref,& - ivm_ref, & - iug, & - ivg, & - icloud_frac, & - iice_supersat_frac, & - ircm_in_layer, & - ircm_in_cloud, & - icloud_cover, & - ip_in_Pa, & - iexner, & - irho_ds_zt, & - ithv_ds_zt, & - iLscale, & - iwp3, & - iwpthlp2, & - iwp2thlp, & - iwprtp2, & - iwp2rtp - - integer, public :: & - iLscale_up, & - iLscale_down, & - iLscale_pert_1, & - iLscale_pert_2, & - itau_zt, & - iKh_zt, & - iwp2thvp, & - iwp2rcp, & - iwprtpthlp, & - isigma_sqd_w_zt, & - irho - - integer, public :: & - irr1, & - irr2, & - iNr1, & - iNr2, & - iLWP1, & - iLWP2, & - iprecip_frac, & - iprecip_frac_1, & - iprecip_frac_2 - - integer, public :: & - imu_rr_1, & - imu_rr_2, & - imu_Nr_1, & - imu_Nr_2, & - imu_Nc_1, & - imu_Nc_2, & - imu_rr_1_n, & - imu_rr_2_n, & - imu_Nr_1_n, & - imu_Nr_2_n, & - imu_Nc_1_n, & - imu_Nc_2_n, & - isigma_rr_1, & - isigma_rr_2, & - isigma_Nr_1, & - isigma_Nr_2, & - isigma_Nc_1, & - isigma_Nc_2, & - isigma_rr_1_n, & - isigma_rr_2_n, & - isigma_Nr_1_n, & - isigma_Nr_2_n, & - isigma_Nc_1_n, & - isigma_Nc_2_n - - integer, public :: & - icorr_srr_1, & - icorr_srr_2, & - icorr_sNr_1, & - icorr_sNr_2, & - icorr_sNc_1, & - icorr_sNc_2, & - icorr_trr_1, & - icorr_trr_2, & - icorr_tNr_1, & - icorr_tNr_2, & - icorr_tNc_1, & - icorr_tNc_2, & - icorr_rrNr_1, & - icorr_rrNr_2, & - icorr_srr_1_n, & - icorr_srr_2_n, & - icorr_sNr_1_n, & - icorr_sNr_2_n, & - icorr_sNc_1_n, & - icorr_sNc_2_n, & - icorr_trr_1_n, & - icorr_trr_2_n, & - icorr_tNr_1_n, & - icorr_tNr_2_n, & - icorr_tNc_1_n, & - icorr_tNc_2_n, & - icorr_rrNr_1_n, & - icorr_rrNr_2_n - - integer, public :: & ! janhft 09/25/12 - icorr_sw, & - icorr_wrr, & - icorr_wNr, & - icorr_wNc - - integer, public :: & - iNcm, & ! Brian - iNcnm, & - iNcm_in_cloud, & - iNc_activated, & - isnowslope, & ! Adam Smith, 22 April 2008 - ised_rcm, & ! Brian - irsat, & ! Brian - irsati, & - irrainm, & ! Brian - im_vol_rad_rain, & ! Brian - im_vol_rad_cloud, & ! COAMPS only. dschanen 6 Dec 2006 - irain_rate_zt, & ! Brian - iAKm, & ! analytic Kessler. Vince Larson 22 May 2005 - iLH_AKm, & ! LH Kessler. Vince Larson 22 May 2005 - iradht, & ! Radiative heating. - iradht_LW, & ! " " Long-wave component - iradht_SW, & ! " " Short-wave component - irel_humidity - - integer, public :: & - iAKstd, & - iAKstd_cld, & - iAKm_rcm, & - iAKm_rcc - -!$omp threadprivate(ithlm, ithvm, irtm, ircm, irvm, ium, ivm, ium_ref, ivm_ref, & -!$omp iwm_zt, iwm_zm, iug, ivg, icloud_frac, ircm_in_layer, ircm_in_cloud, icloud_cover, & -!$omp ip_in_Pa, iexner, irho_ds_zt, ithv_ds_zt, iLscale, iwp3, & -!$omp iwpthlp2, iwp2thlp, iwprtp2, iwp2rtp, iLscale_up, iLscale_down, & -!$omp iLscale_pert_1, iLscale_pert_2, & -!$omp itau_zt, iKh_zt, iwp2thvp, iwp2rcp, iwprtpthlp, isigma_sqd_w_zt, irho, & -!$omp irr1, irr2, iNr1, iNr2, iLWP1, iLWP2, & -!$omp iprecip_frac, iprecip_frac_1, iprecip_frac_2, & -!$omp irel_humidity, iNcm, iNcnm, isnowslope, & -!$omp ised_rcm, irsat, irsati, irrainm, & -!$omp im_vol_rad_rain, im_vol_rad_cloud, & -!$omp irain_rate_zt, iAKm, iLH_AKm, & -!$omp iradht, iradht_LW, iradht_SW, & -!$omp iAKstd, iAKstd_cld, iAKm_rcm, iAKm_rcc ) - -!$omp threadprivate( imu_rr_1, imu_rr_2, imu_Nr_1, imu_Nr_2, & -!$omp imu_Nc_1, imu_Nc_2, imu_rr_1_n, imu_rr_2_n, imu_Nr_1_n, imu_Nr_2_n, & -!$omp imu_Nc_1_n, imu_Nc_2_n, isigma_rr_1, isigma_rr_2, isigma_Nr_1, & -!$omp isigma_Nr_2, isigma_Nc_1, isigma_Nc_2, isigma_rr_1_n, isigma_rr_2_n, & -!$omp isigma_Nr_1_n, isigma_Nr_2_n, isigma_Nc_1_n, isigma_Nc_2_n, & -!$omp icorr_srr_1, icorr_srr_2, icorr_sNr_1, icorr_sNr_2, & -!$omp icorr_sNc_1, icorr_sNc_2, icorr_trr_1, icorr_trr_2, & -!$omp icorr_tNr_1, icorr_tNr_2, icorr_tNc_1, icorr_tNc_2, & -!$omp icorr_rrNr_1, icorr_rrNr_2, icorr_srr_1_n, icorr_srr_2_n, & -!$omp icorr_sNr_1_n, icorr_sNr_2_n, icorr_sNc_1_n, icorr_sNc_2_n, & -!$omp icorr_trr_1_n, icorr_trr_2_n, icorr_tNr_1_n, icorr_tNr_2_n, & -!$omp icorr_tNc_1_n, icorr_tNc_2_n, icorr_rrNr_1_n, icorr_rrNr_2_n, & -!$omp icorr_sw, icorr_wrr, icorr_wNr, icorr_wNc ) - - integer, public :: & - irfrzm -!$omp threadprivate(irfrzm) - - ! Skewness functions on zt grid - integer, public :: & - iC11_Skw_fnc - -!$omp threadprivate(iC11_Skw_fnc) - - integer, public :: & - icloud_frac_zm, & - iice_supersat_frac_zm, & - ircm_zm, & - irtm_zm, & - ithlm_zm - -!$omp threadprivate(icloud_frac_zm, ircm_zm, irtm_zm, ithlm_zm) - - integer, public :: & - iLH_rcm_avg - -!$omp threadprivate(iLH_rcm_avg) - - integer, public :: & - iNrm, & ! Rain droplet number concentration - iNim, & ! Ice number concentration - iNsnowm, & ! Snow number concentration - iNgraupelm ! Graupel number concentration -!$omp threadprivate(iNrm, iNim, iNsnowm, iNgraupelm) - - integer, public :: & - iT_in_K ! Absolute temperature -!$omp threadprivate(iT_in_K) - - integer, public :: & - ieff_rad_cloud, & - ieff_rad_ice, & - ieff_rad_snow, & - ieff_rad_rain, & - ieff_rad_graupel - -!$omp threadprivate(ieff_rad_cloud, ieff_rad_ice, ieff_rad_snow) -!$omp threadprivate(ieff_rad_rain, ieff_rad_graupel) - - integer, public :: & - irsnowm, & - irgraupelm, & - iricem, & - idiam, & ! Diameter of ice crystal [m] - imass_ice_cryst, & ! Mass of a single ice crystal [kg] - ircm_icedfs, & ! Change in liquid water due to ice [kg/kg/s] - iu_T_cm ! Fallspeed of ice crystal in cm/s [cm s^{-1}] - -!$omp threadprivate(irsnowm, irgraupelm, iricem, idiam) -!$omp threadprivate(imass_ice_cryst, ircm_icedfs, iu_T_cm) - - - ! thlm/rtm budget terms - integer, public :: & - irtm_bt, & ! rtm total time tendency - irtm_ma, & ! rtm mean advect. term - irtm_ta, & ! rtm turb. advect. term - irtm_forcing, & ! rtm large scale forcing term - irtm_mc, & ! rtm change from microphysics - irtm_sdmp, & ! rtm change from sponge damping - irvm_mc, & ! rvm change from microphysics - ircm_mc, & ! rcm change from microphysics - ircm_sd_mg_morr, & ! rcm sedimentation tendency - irtm_mfl, & ! rtm change due to monotonic flux limiter - irtm_tacl, & ! rtm correction from turbulent advection (wprtp) clipping - irtm_cl, & ! rtm clipping term - irtm_pd, & ! thlm postive definite adj term - ithlm_bt, & ! thlm total time tendency - ithlm_ma, & ! thlm mean advect. term - ithlm_ta, & ! thlm turb. advect. term - ithlm_forcing, & ! thlm large scale forcing term - ithlm_sdmp, & ! thlm change from sponge damping - ithlm_mc, & ! thlm change from microphysics - ithlm_mfl, & ! thlm change due to monotonic flux limiter - ithlm_tacl, & ! thlm correction from turbulent advection (wpthlp) clipping - ithlm_cl ! thlm clipping term - -!$omp threadprivate(irtm_bt, irtm_ma, irtm_ta, irtm_forcing, & -!$omp irtm_mc, irtm_sdmp, irtm_mfl, irtm_tacl, irtm_cl, irtm_pd, & -!$omp irvm_mc, ircm_mc, ircm_sd_mg_morr, & -!$omp ithlm_bt, ithlm_ma, ithlm_ta, ithlm_forcing, & -!$omp ithlm_mc, ithlm_sdmp, ithlm_mfl, ithlm_tacl, ithlm_cl) - - !monatonic flux limiter diagnostic terms - integer, public :: & - ithlm_mfl_min, & - ithlm_mfl_max, & - iwpthlp_entermfl, & - iwpthlp_exit_mfl, & - iwpthlp_mfl_min, & - iwpthlp_mfl_max, & - irtm_mfl_min, & - irtm_mfl_max, & - iwprtp_enter_mfl, & - iwprtp_exit_mfl, & - iwprtp_mfl_min, & - iwprtp_mfl_max, & - ithlm_enter_mfl, & - ithlm_exit_mfl, & - ithlm_old, & - ithlm_without_ta, & - irtm_enter_mfl, & - irtm_exit_mfl, & - irtm_old, & - irtm_without_ta - -!$omp threadprivate(ithlm_mfl_min, ithlm_mfl_max, iwpthlp_entermfl) -!$omp threadprivate(iwpthlp_exit_mfl, iwpthlp_mfl_min, iwpthlp_mfl_max) -!$omp threadprivate(irtm_mfl_min, irtm_mfl_max, iwprtp_enter_mfl) -!$omp threadprivate(iwprtp_exit_mfl, iwprtp_mfl_min, iwprtp_mfl_max) -!$omp threadprivate(ithlm_enter_mfl, ithlm_exit_mfl, ithlm_old, ithlm_without_ta) -!$omp threadprivate(irtm_enter_mfl, irtm_exit_mfl, irtm_old, irtm_without_ta) - - integer, public :: & - iwp3_bt, & - iwp3_ma, & - iwp3_ta, & - iwp3_tp, & - iwp3_ac, & - iwp3_bp1, & - iwp3_bp2, & - iwp3_pr1, & - iwp3_pr2, & - iwp3_dp1, & - iwp3_4hd, & - iwp3_cl - -!$omp threadprivate(iwp3_bt, iwp3_ma, iwp3_ta, iwp3_tp, iwp3_ac, iwp3_bp1) -!$omp threadprivate(iwp3_bp2, iwp3_pr1, iwp3_pr2, iwp3_dp1, iwp3_4hd, iwp3_cl) - - ! Rain mixing ratio budgets - integer, public :: & - irrainm_bt, & - irrainm_ma, & - irrainm_sd, & - irrainm_ts, & - irrainm_sd_morr, & - irrainm_dff, & - irrainm_cond, & - irrainm_auto, & - irrainm_accr, & - irrainm_cond_adj, & - irrainm_src_adj, & - irrainm_tsfl, & - irrainm_mc, & - irrainm_hf, & - irrainm_wvhf, & - irrainm_cl - -!$omp threadprivate(irrainm_bt, irrainm_ma, irrainm_sd, irrainm_ts) -!$omp threadprivate(irrainm_sd_morr, irrainm_dff) -!$omp threadprivate(irrainm_cond, irrainm_auto, irrainm_accr) -!$omp threadprivate(irrainm_cond_adj, irrainm_src_adj, irrainm_tsfl) -!$omp threadprivate(irrainm_mc, irrainm_hf, irrainm_wvhf, irrainm_cl) - - integer, public :: & - iNrm_bt, & - iNrm_ma, & - iNrm_sd, & - iNrm_ts, & - iNrm_dff, & - iNrm_cond, & - iNrm_auto, & - iNrm_cond_adj, & - iNrm_src_adj, & - iNrm_tsfl, & - iNrm_mc, & - iNrm_cl - -!$omp threadprivate(iNrm_bt, iNrm_ma, iNrm_sd, iNrm_ts, iNrm_dff, iNrm_cond) -!$omp threadprivate(iNrm_auto, iNrm_cond_adj, iNrm_src_adj, iNrm_tsfl) -!$omp threadprivate(iNrm_mc, iNrm_cl) - - - ! Snow/Ice/Graupel mixing ratio budgets - integer, public :: & - irsnowm_bt, & - irsnowm_ma, & - irsnowm_sd, & - irsnowm_sd_morr, & - irsnowm_dff, & - irsnowm_mc, & - irsnowm_hf, & - irsnowm_wvhf, & - irsnowm_cl - -!$omp threadprivate(irsnowm_bt, irsnowm_ma, irsnowm_sd, irsnowm_sd_morr, irsnowm_dff) -!$omp threadprivate(irsnowm_mc, irsnowm_hf, irsnowm_wvhf, irsnowm_cl) - - integer, public :: & - irgraupelm_bt, & - irgraupelm_ma, & - irgraupelm_sd, & - irgraupelm_sd_morr, & - irgraupelm_dff, & - irgraupelm_mc, & - irgraupelm_hf, & - irgraupelm_wvhf, & - irgraupelm_cl - -!$omp threadprivate(irgraupelm_bt, irgraupelm_ma, irgraupelm_sd, irgraupelm_sd_morr) -!$omp threadprivate(irgraupelm_dff, irgraupelm_mc) -!$omp threadprivate(irgraupelm_hf, irgraupelm_wvhf, irgraupelm_cl) - - integer, public :: & - iricem_bt, & - iricem_ma, & - iricem_sd, & - iricem_sd_mg_morr, & - iricem_dff, & - iricem_mc, & - iricem_hf, & - iricem_wvhf, & - iricem_cl - -!$omp threadprivate(iricem_bt, iricem_ma, iricem_sd, iricem_sd_mg_morr, iricem_dff) -!$omp threadprivate(iricem_mc, iricem_hf, iricem_wvhf, iricem_cl) - - integer, public :: & - iNsnowm_bt, & - iNsnowm_ma, & - iNsnowm_sd, & - iNsnowm_dff, & - iNsnowm_mc, & - iNsnowm_cl - -!$omp threadprivate(iNsnowm_bt, iNsnowm_ma, iNsnowm_sd, iNsnowm_dff, & -!$omp iNsnowm_mc, iNsnowm_cl) - - integer, public :: & - iNgraupelm_bt, & - iNgraupelm_ma, & - iNgraupelm_sd, & - iNgraupelm_dff, & - iNgraupelm_mc, & - iNgraupelm_cl - -!$omp threadprivate(iNgraupelm_bt, iNgraupelm_ma, iNgraupelm_sd, & -!$omp iNgraupelm_dff, iNgraupelm_mc, iNgraupelm_cl) - - integer, public :: & - iNim_bt, & - iNim_ma, & - iNim_sd, & - iNim_dff, & - iNim_mc, & - iNim_cl - -!$omp threadprivate(iNim_bt, iNim_ma, iNim_sd, iNim_dff, & -!$omp iNim_mc, iNim_cl) - - integer, public :: & - iNcm_bt, & - iNcm_ma, & - iNcm_dff, & - iNcm_mc, & - iNcm_cl, & - iNcm_act - -!$omp threadprivate(iNcm_bt, iNcm_ma, iNcm_dff, & -!$omp iNcm_mc, iNcm_cl) - - ! Covariances between w, r_t, theta_l and KK microphysics tendencies. - ! Additionally, covariances between r_r and N_r and KK rain drop mean - ! volume radius. These are all calculated on thermodynamic grid levels. - integer, public :: & - iw_KK_evap_covar_zt, & ! Covariance of w and KK evaporation tendency. - irt_KK_evap_covar_zt, & ! Covariance of r_t and KK evaporation tendency. - ithl_KK_evap_covar_zt, & ! Covariance of theta_l and KK evap. tendency. - iw_KK_auto_covar_zt, & ! Covariance of w and KK autoconversion tendency. - irt_KK_auto_covar_zt, & ! Covariance of r_t and KK autoconversion tendency. - ithl_KK_auto_covar_zt, & ! Covariance of theta_l and KK autoconv. tendency. - iw_KK_accr_covar_zt, & ! Covariance of w and KK accretion tendency. - irt_KK_accr_covar_zt, & ! Covariance of r_t and KK accretion tendency. - ithl_KK_accr_covar_zt, & ! Covariance of theta_l and KK accretion tendency. - irr_KK_mvr_covar_zt, & ! Covariance of r_r and KK mean volume radius. - iNr_KK_mvr_covar_zt ! Covariance of N_r and KK mean volume radius. - -!$omp threadprivate( iw_KK_evap_covar_zt, irt_KK_evap_covar_zt, & -!$omp ithl_KK_evap_covar_zt, iw_KK_auto_covar_zt, irt_KK_auto_covar_zt, & -!$omp ithl_KK_auto_covar_zt, iw_KK_accr_covar_zt, irt_KK_accr_covar_zt, & -!$omp ithl_KK_accr_covar_zt, irr_KK_mvr_covar_zt, iNr_KK_mvr_covar_zt ) - - ! Wind budgets - integer, public :: & - ivm_bt, & - ivm_ma, & - ivm_ta, & - ivm_gf, & - ivm_cf, & - ivm_f, & - ivm_sdmp, & - ivm_ndg - -!$omp threadprivate(ivm_bt, ivm_ma, ivm_ta, ivm_gf, ivm_cf, ivm_f, ivm_sdmp, ivm_ndg) - - integer, public :: & - ium_bt, & - ium_ma, & - ium_ta, & - ium_gf, & - ium_cf, & - ium_f, & - ium_sdmp, & - ium_ndg - -!$omp threadprivate(ium_bt, ium_ma, ium_ta, ium_gf, ium_cf, ium_f, ium_sdmp, ium_ndg) - - - ! PDF parameters - integer, public :: & - imixt_frac, & - iw1, & - iw2, & - ivarnce_w1, & - ivarnce_w2, & - ithl1, & - ithl2, & - ivarnce_thl1, & - ivarnce_thl2, & - irt1, & - irt2, & - ivarnce_rt1, & - ivarnce_rt2, & - irc1, & - irc2, & - irsl1, & - irsl2, & - icloud_frac1, & - icloud_frac2 - - integer, public :: & - is1, & - is2, & - istdev_s1, & - istdev_s2, & - istdev_t1, & - istdev_t2, & - icovar_st_1, & - icovar_st_2, & - icorr_st_1, & - icorr_st_2, & - irrtthl, & - icrt1, & - icrt2, & - icthl1, & - icthl2 - -!$omp threadprivate(imixt_frac, iw1, iw2, ivarnce_w1, ivarnce_w2, ithl1, ithl2, ivarnce_thl1, & -!$omp ivarnce_thl2, irt1, irt2, ivarnce_rt1, ivarnce_rt2, irc1, irc2, & -!$omp irsl1, irsl2, icloud_frac1, icloud_frac2, is1, is2, istdev_s1, istdev_s2, & -!$omp istdev_t1, istdev_t2, icovar_st_1, icovar_st_2, icorr_st_1, icorr_st_2, irrtthl, & -!$omp icrt1, icrt2, icthl1, icthl2 ) - - integer, public :: & - iwp2_zt, & - ithlp2_zt, & - iwpthlp_zt, & - iwprtp_zt, & - irtp2_zt, & - irtpthlp_zt, & - iup2_zt, & - ivp2_zt, & - iupwp_zt, & - ivpwp_zt - -!$omp threadprivate(iwp2_zt, ithlp2_zt, iwpthlp_zt, iwprtp_zt, irtp2_zt, irtpthlp_zt, & -!$omp iup2_zt, ivp2_zt, iupwp_zt, ivpwp_zt) - - integer, public :: & - is_mellor -!$omp threadprivate(is_mellor) - - integer, target, allocatable, dimension(:), public :: & - isclrm, & ! Passive scalar mean (1) - isclrm_f ! Passive scalar forcing (1) - -! Used to calculate clear-sky radiative fluxes. - integer, public :: & - ifulwcl, ifdlwcl, ifdswcl, ifuswcl - -!$omp threadprivate(isclrm, isclrm_f) - - integer, target, allocatable, dimension(:), public :: & - iedsclrm, & ! Eddy-diff. scalar term (1) - iedsclrm_f ! Eddy-diffusivity scalar forcing (1) - -!$omp threadprivate(iedsclrm, iedsclrm_f) - - integer, public :: & - iLH_thlm_mc, & ! Latin hypercube estimate of thlm_mc - iLH_rvm_mc, & ! Latin hypercube estimate of rvm_mc - iLH_rcm_mc, & ! Latin hypercube estimate of rcm_mc - iLH_Ncm_mc, & ! Latin hypercube estimate of Ncm_mc - iLH_rrainm_mc, & ! Latin hypercube estimate of rrainm_mc - iLH_Nrm_mc, & ! Latin hypercube estimate of Nrm_mc - iLH_rsnowm_mc, & ! Latin hypercube estimate of rsnowm_mc - iLH_Nsnowm_mc, & ! Latin hypercube estimate of Nsnowm_mc - iLH_rgraupelm_mc, & ! Latin hypercube estimate of rgraupelm_mc - iLH_Ngraupelm_mc, & ! Latin hypercube estimate of Ngraupelm_mc - iLH_ricem_mc, & ! Latin hypercube estimate of ricem_mc - iLH_Nim_mc ! Latin hypercube estimate of Nim_mc -!$omp threadprivate( iLH_thlm_mc, iLH_rvm_mc, iLH_rcm_mc, iLH_Ncm_mc, & -!$omp iLH_rrainm_mc, iLH_Nrm_mc, iLH_rsnowm_mc, iLH_Nsnowm_mc, & -!$omp iLH_rgraupelm_mc, iLH_Ngraupelm_mc, iLH_ricem_mc, iLH_Nim_mc ) - - integer, public :: & - iLH_rrainm_auto, & ! Latin hypercube estimate of autoconversion - iLH_rrainm_accr ! Latin hypercube estimate of accretion -!$omp threadprivate( iLH_rrainm_auto, iLH_rrainm_accr ) - - integer, public :: & - iLH_Vrr, & ! Latin hypercube estimate of rrainm sedimentation velocity - iLH_VNr ! Latin hypercube estimate of Nrm sedimentation velocity -!$omp threadprivate(iLH_Vrr, iLH_VNr) - - integer, public :: & - iLH_rrainm, & - iLH_Nrm, & - iLH_ricem, & - iLH_Nim, & - iLH_rsnowm, & - iLH_Nsnowm, & - iLH_rgraupelm, & - iLH_Ngraupelm, & - iLH_thlm, & - iLH_rcm, & - iLH_Ncm, & - iLH_rvm, & - iLH_wm, & - iLH_cloud_frac - -!$omp threadprivate(iLH_rrainm, iLH_Nrm, iLH_ricem, iLH_Nim, iLH_rsnowm, iLH_Nsnowm, & -!$omp iLH_rgraupelm, iLH_Ngraupelm, & -!$omp iLH_thlm, iLH_rcm, iLH_Ncm, iLH_rvm, iLH_wm, iLH_cloud_frac ) - - integer, public :: & - iLH_wp2_zt, & - iLH_Nrp2_zt, & - iLH_Ncp2_zt, & - iLH_rcp2_zt, & - iLH_rtp2_zt, & - iLH_thlp2_zt, & - iLH_rrainp2_zt - -!$omp threadprivate(iLH_wp2_zt, iLH_Nrp2_zt, iLH_Ncp2_zt, iLH_rcp2_zt, iLH_rtp2_zt, & -!$omp iLH_thlp2_zt, iLH_rrainp2_zt) - - ! Indices for statistics in zm file - integer, public :: & - iwp2, & - irtp2, & - ithlp2, & - irtpthlp, & - iwprtp, & - iwpthlp, & - iwp4, & - iwpthvp, & - irtpthvp, & - ithlpthvp, & - itau_zm, & - iKh_zm, & - iwprcp, & - irc_coef, & - ithlprcp, & - irtprcp, & - ircp2, & - iupwp, & - ivpwp - - integer, public :: & - irho_zm, & - isigma_sqd_w, & - irho_ds_zm, & - ithv_ds_zm, & - iem, & - ishear, & ! Brian - imean_w_up, & - imean_w_down, & - iFrad, & - iFrad_LW, & ! Brian - iFrad_SW, & ! Brian - iFrad_LW_up, & - iFrad_SW_up, & - iFrad_LW_down, & - iFrad_SW_down, & - iFprec, & ! Brian - iFcsed ! Brian - -!$omp threadprivate(iwp2, irtp2, ithlp2, irtpthlp, iwprtp, iwpthlp) -!$omp threadprivate(iwp4, iwpthvp, irtpthvp, ithlpthvp, itau_zm, iKh_zm) -!$omp threadprivate(iwprcp, irc_coef, ithlprcp, irtprcp, ircp2, iupwp, ivpwp) -!$omp threadprivate(irho_zm, isigma_sqd_w, irho_ds_zm, ithv_ds_zm, iem, ishear) -!$omp threadprivate(iFrad, iFrad_LW, iFrad_SW, iFrad_SW_up, iFrad_SW_down) -!$omp threadprivate(iFrad_LW_up, iFrad_LW_down, iFprec, iFcsed) - - ! Skewness Functions on zm grid - integer, public :: & - igamma_Skw_fnc, & - iC6rt_Skw_fnc, & - iC6thl_Skw_fnc, & - iC7_Skw_fnc, & - iC1_Skw_fnc - -!$omp threadprivate(igamma_Skw_fnc, iC6rt_Skw_fnc, iC6thl_Skw_fnc) -!$omp threadprivate(iC7_Skw_fnc, iC1_Skw_fnc) - - ! Sedimentation velocities - integer, public :: & - iVNr, & - iVrr, & - iVNc, & - iVrc, & - iVNsnow, & - iVrsnow, & - iVNice, & - iVrice, & - iVrgraupel - - ! Covariance of sedimentation velocity and hydrometeor, . - integer, public :: & - iVrrprrp, & - iVNrpNrp, & - iVrrprrp_net, & - iVNrpNrp_net - - -!$omp threadprivate(iVNr, iVrr, iVNc, iVrc, iVNsnow, iVrsnow, iVNice, iVrice, iVrgraupel) -!$omp threadprivate(iVrrprrp, iVNrpNrp, iVrrprrp_net, iVNrpNrp_net) - - integer, public :: & - iwp2_bt, & - iwp2_ma, & - iwp2_ta, & - iwp2_ac, & - iwp2_bp, & - iwp2_pr1, & - iwp2_pr2, & - iwp2_pr3, & - iwp2_dp1, & - iwp2_dp2, & - iwp2_4hd, & - iwp2_pd, & - iwp2_cl, & - iwp2_sf - -!$omp threadprivate(iwp2_bt, iwp2_ma, iwp2_ta, iwp2_ac, iwp2_bp) -!$omp threadprivate(iwp2_pr1, iwp2_pr2, iwp2_pr3) -!$omp threadprivate(iwp2_dp1, iwp2_dp2, iwp2_4hd) -!$omp threadprivate(iwp2_pd, iwp2_cl) - - integer, public :: & - iwprtp_bt, & - iwprtp_ma, & - iwprtp_ta, & - iwprtp_tp, & - iwprtp_ac, & - iwprtp_bp, & - iwprtp_pr1, & - iwprtp_pr2, & - iwprtp_pr3, & - iwprtp_dp1, & - iwprtp_mfl, & - iwprtp_cl, & - iwprtp_sicl, & - iwprtp_pd, & - iwprtp_forcing, & - iwprtp_mc - -!$omp threadprivate(iwprtp_bt, iwprtp_ma, iwprtp_ta, iwprtp_tp) -!$omp threadprivate(iwprtp_ac, iwprtp_bp, iwprtp_pr1, iwprtp_pr2) -!$omp threadprivate(iwprtp_pr3, iwprtp_dp1, iwprtp_mfl, iwprtp_cl) -!$omp threadprivate(iwprtp_sicl, iwprtp_pd, iwprtp_forcing, iwprtp_mc) - - integer, public :: & - iwpthlp_bt, & - iwpthlp_ma, & - iwpthlp_ta, & - iwpthlp_tp, & - iwpthlp_ac, & - iwpthlp_bp, & - iwpthlp_pr1, & - iwpthlp_pr2, & - iwpthlp_pr3, & - iwpthlp_dp1, & - iwpthlp_mfl, & - iwpthlp_cl, & - iwpthlp_sicl, & - iwpthlp_forcing, & - iwpthlp_mc - -!$omp threadprivate(iwpthlp_bt, iwpthlp_ma, iwpthlp_ta, iwpthlp_tp) -!$omp threadprivate(iwpthlp_ac, iwpthlp_bp, iwpthlp_pr1, iwpthlp_pr2) -!$omp threadprivate(iwpthlp_pr3, iwpthlp_dp1, iwpthlp_mfl, iwpthlp_cl) -!$omp threadprivate(iwpthlp_sicl, iwpthlp_forcing, iwpthlp_mc) - -! Dr. Golaz's new variance budget terms -! qt was changed to rt to avoid confusion - - integer, public :: & - irtp2_bt, & - irtp2_ma, & - irtp2_ta, & - irtp2_tp, & - irtp2_dp1, & - irtp2_dp2, & - irtp2_pd, & - irtp2_cl, & - irtp2_sf, & - irtp2_forcing, & - irtp2_mc - -!$omp threadprivate(irtp2_bt, irtp2_ma, irtp2_ta, irtp2_tp, irtp2_dp1) -!$omp threadprivate(irtp2_dp2, irtp2_pd, irtp2_cl, irtp2_sf, irtp2_forcing) -!$omp threadprivate(irtp2_mc) - - integer, public :: & - ithlp2_bt, & - ithlp2_ma, & - ithlp2_ta, & - ithlp2_tp, & - ithlp2_dp1, & - ithlp2_dp2, & - ithlp2_pd, & - ithlp2_cl, & - ithlp2_sf, & - ithlp2_forcing, & - ithlp2_mc - -!$omp threadprivate(ithlp2_bt, ithlp2_ma, ithlp2_ta, ithlp2_tp, ithlp2_dp1) -!$omp threadprivate(ithlp2_dp2, ithlp2_pd, ithlp2_cl, ithlp2_sf) -!$omp threadprivate(ithlp2_forcing, ithlp2_mc) - - integer, public :: & - irtpthlp_bt, & - irtpthlp_ma, & - irtpthlp_ta, & - irtpthlp_tp1, & - irtpthlp_tp2, & - irtpthlp_dp1, & - irtpthlp_dp2, & - irtpthlp_cl, & - irtpthlp_sf, & - irtpthlp_forcing, & - irtpthlp_mc - -!$omp threadprivate(irtpthlp_bt, irtpthlp_ma, irtpthlp_ta) -!$omp threadprivate(irtpthlp_tp1, irtpthlp_tp2, irtpthlp_dp1) -!$omp threadprivate(irtpthlp_dp2, irtpthlp_cl, irtpthlp_sf, irtpthlp_forcing) -!$omp threadprivate(irtpthlp_mc) - - integer, public :: & - iup2, & - ivp2 - -!$omp threadprivate(iup2, ivp2) - - integer, public :: & - iup2_bt, & - iup2_ta, & - iup2_tp, & - iup2_ma, & - iup2_dp1, & - iup2_dp2, & - iup2_pr1, & - iup2_pr2, & - iup2_pd, & - iup2_cl, & - iup2_sf, & - ivp2_bt, & - ivp2_ta, & - ivp2_tp, & - ivp2_ma, & - ivp2_dp1, & - ivp2_dp2, & - ivp2_pr1, & - ivp2_pr2, & - ivp2_pd, & - ivp2_cl, & - ivp2_sf - -!$omp threadprivate(iup2_bt, iup2_ta, iup2_tp, iup2_ma, iup2_dp1) -!$omp threadprivate(iup2_dp2, iup2_pr1, iup2_pr2, iup2_cl) -!$omp threadprivate(ivp2_bt, ivp2_ta, ivp2_tp, ivp2_ma, ivp2_dp1) -!$omp threadprivate(ivp2_dp2, ivp2_pr1, ivp2_pr2, ivp2_cl) -!$omp threadprivate(iup2_pd, ivp2_pd) - -! Passive scalars. Note that floating point roundoff may make -! mathematically equivalent variables different values. - integer,target, allocatable, dimension(:), public :: & - isclrprtp, & ! sclr'(1)rt' / rt'^2 - isclrp2, & ! sclr'(1)^2 / rt'^2 - isclrpthvp, & ! sclr'(1)th_v' / rt'th_v' - isclrpthlp, & ! sclr'(1)th_l' / rt'th_l' - isclrprcp, & ! sclr'(1)rc' / rt'rc' - iwpsclrp, & ! w'slcr'(1) / w'rt' - iwp2sclrp, & ! w'^2 sclr'(1) / w'^2 rt' - iwpsclrp2, & ! w'sclr'(1)^2 / w'rt'^2 - iwpsclrprtp, & ! w'sclr'(1)rt' / w'rt'^2 - iwpsclrpthlp ! w'sclr'(1)th_l' / w'rt'th_l' - -!$omp threadprivate(isclrprtp, isclrp2, isclrpthvp, isclrpthlp) -!$omp threadprivate(isclrprcp, iwpsclrp, iwp2sclrp, iwpsclrp2) -!$omp threadprivate(iwpsclrprtp, iwpsclrpthlp) - - integer, target, allocatable, dimension(:), public :: & - iwpedsclrp ! eddy sclr'(1)w' - -!$omp threadprivate(iwpedsclrp) - ! Indices for statistics in rad_zt file - integer, public :: & - iT_in_K_rad, & - ircil_rad, & - io3l_rad, & - irsnowm_rad, & - ircm_in_cloud_rad, & - icloud_frac_rad, & - iice_supersat_frac_rad, & - iradht_rad, & - iradht_LW_rad, & - iradht_SW_rad - -!$omp threadprivate(iT_in_K_rad, ircil_rad, io3l_rad) -!$omp threadprivate(irsnowm_rad, ircm_in_cloud_rad, icloud_frac_rad) -!$omp threadprivate(iradht_rad, iradht_LW_rad, iradht_SW_rad) - - ! Indices for statistics in rad_zm file - integer, public :: & - iFrad_LW_rad, & - iFrad_SW_rad, & - iFrad_SW_up_rad, & - iFrad_LW_up_rad, & - iFrad_SW_down_rad, & - iFrad_LW_down_rad - -!$omp threadprivate(iFrad_LW_rad, iFrad_SW_rad, iFrad_SW_up_rad) -!$omp threadprivate(iFrad_LW_up_rad, iFrad_SW_down_rad, iFrad_LW_down_rad) - - ! Indices for statistics in sfc file - - integer, public :: & - iustar, & - isoil_heat_flux,& - iveg_T_in_K,& - isfc_soil_T_in_K, & - ideep_soil_T_in_K,& - ilh, & - ish, & - icc, & - ilwp, & - ivwp, & ! nielsenb - iiwp, & ! nielsenb - iswp, & ! nielsenb - irwp, & - iz_cloud_base, & - iz_inversion, & - irain_rate_sfc, & ! Brian - irain_flux_sfc, & ! Brian - irrainm_sfc, & ! Brian - iwpthlp_sfc - - integer, public :: & - iwprtp_sfc, & - iupwp_sfc, & - ivpwp_sfc, & - ithlm_vert_avg, & - irtm_vert_avg, & - ium_vert_avg, & - ivm_vert_avg, & - iwp2_vert_avg, & ! nielsenb - iup2_vert_avg, & - ivp2_vert_avg, & - irtp2_vert_avg, & - ithlp2_vert_avg, & - iT_sfc ! kcwhite - - integer, public :: & - iwp23_matrix_condt_num, & - irtm_matrix_condt_num, & - ithlm_matrix_condt_num, & - irtp2_matrix_condt_num, & - ithlp2_matrix_condt_num, & - irtpthlp_matrix_condt_num, & - iup2_vp2_matrix_condt_num, & - iwindm_matrix_condt_num - - integer, public :: & - imorr_rain_rate, & - imorr_snow_rate - - integer, public :: & - irtm_spur_src, & - ithlm_spur_src -!$omp threadprivate(iustar, isoil_heat_flux, iveg_T_in_K, isfc_soil_T_in_K, ideep_soil_T_in_K, & -!$omp ilh, ish, icc, ilwp, ivwp, iiwp, iswp, irwp, iz_cloud_base, iz_inversion, & -!$omp irain_rate_sfc, irain_flux_sfc, irrainm_sfc, & -!$omp iwpthlp_sfc, iwprtp_sfc, iupwp_sfc, ivpwp_sfc, & -!$omp ithlm_vert_avg, irtm_vert_avg, ium_vert_avg, ivm_vert_avg, & -!$omp iwp2_vert_avg, iup2_vert_avg, ivp2_vert_avg, irtp2_vert_avg, ithlp2_vert_avg, iT_sfc, & -!$omp iwp23_matrix_condt_num, irtm_matrix_condt_num, ithlm_matrix_condt_num, & -!$omp irtp2_matrix_condt_num, ithlp2_matrix_condt_num, irtpthlp_matrix_condt_num, & -!$omp iup2_vp2_matrix_condt_num, iwindm_matrix_condt_num, & -!$omp imorr_rain_rate, imorr_snow_rate) - - integer, public :: & - iSkw_velocity, & ! Skewness velocity - iwp3_zm, & - ia3_coef, & - ia3_coef_zt -!$omp threadprivate(iSkw_velocity, iwp3_zm, ia3_coef, ia3_coef_zt) - - integer, public :: & - iwp3_on_wp2, & ! w'^3 / w'^2 [m/s] - iwp3_on_wp2_zt ! w'^3 / w'^2 [m/s] -!$omp threadprivate(iwp3_on_wp2, iwp3_on_wp2_zt) - - integer, public :: & - iLH_morr_rain_rate, & - iLH_morr_snow_rate -!$omp threadprivate( iLH_morr_rain_rate, iLH_morr_snow_rate ) - - integer, public :: & - iLH_vwp, & - iLH_lwp -!$omp threadprivate( iLH_vwp, iLH_lwp ) - - ! Variables that contains all the statistics - - type (stats), target, public :: zt, & ! zt grid - zm, & ! zm grid - LH_zt, & ! LH_zt grid - LH_sfc, & ! LH_sfc grid - rad_zt, & ! rad_zt grid - rad_zm, & ! rad_zm grid - sfc ! sfc - -!$omp threadprivate(zt, zm, rad_zt, rad_zm, sfc) - - ! Scratch space - - real( kind = core_rknd ), dimension(:), allocatable, public :: & - ztscr01, ztscr02, ztscr03, & - ztscr04, ztscr05, ztscr06, & - ztscr07, ztscr08, ztscr09, & - ztscr10, ztscr11, ztscr12, & - ztscr13, ztscr14, ztscr15, & - ztscr16, ztscr17, ztscr18, & - ztscr19, ztscr20, ztscr21 - -!$omp threadprivate(ztscr01, ztscr02, ztscr03, ztscr04, ztscr05) -!$omp threadprivate(ztscr06, ztscr07, ztscr08, ztscr09, ztscr10) -!$omp threadprivate(ztscr11, ztscr12, ztscr13, ztscr14, ztscr15) -!$omp threadprivate(ztscr16, ztscr17, ztscr18, ztscr19, ztscr20) -!$omp threadprivate(ztscr21) - - real( kind = core_rknd ), dimension(:), allocatable, public :: & - zmscr01, zmscr02, zmscr03, & - zmscr04, zmscr05, zmscr06, & - zmscr07, zmscr08, zmscr09, & - zmscr10, zmscr11, zmscr12, & - zmscr13, zmscr14, zmscr15, & - zmscr16, zmscr17 - -!$omp threadprivate(zmscr01, zmscr02, zmscr03, zmscr04, zmscr05) -!$omp threadprivate(zmscr06, zmscr07, zmscr08, zmscr09, zmscr10) -!$omp threadprivate(zmscr11, zmscr12, zmscr13, zmscr14, zmscr15) -!$omp threadprivate(zmscr16, zmscr17) - - real( kind = core_rknd ), dimension(:), allocatable, public :: & - radscr01, radscr02, radscr03, & - radscr04, radscr05, radscr06, & - radscr07, radscr08, radscr09, & - radscr10, radscr11, radscr12, & - radscr13, radscr14, radscr15, & - radscr16, radscr17 - -!$omp threadprivate(radscr01, radscr02, radscr03, radscr04, radscr05) -!$omp threadprivate(radscr06, radscr07, radscr08, radscr09, radscr10) -!$omp threadprivate(radscr11, radscr12, radscr13, radscr14, radscr15) -!$omp threadprivate(radscr16, radscr17) - -end module crmx_stats_variables diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_zm.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_zm.F90 deleted file mode 100644 index a762e43cf0..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_stats_zm.F90 +++ /dev/null @@ -1,1724 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: stats_zm.F90 6146 2013-04-05 18:02:22Z raut@uwm.edu $ -module crmx_stats_zm - - implicit none - - private ! Default Scope - - public :: stats_init_zm - - ! Constant parameters - integer, parameter, public :: nvarmax_zm = 250 ! Maximum variables allowed - - contains - -!----------------------------------------------------------------------- - subroutine stats_init_zm( vars_zm, l_error ) - -! Description: -! Initializes array indices for zm - -! Note: -! All code that is within subroutine stats_init_zm, including variable -! allocation code, is not called if l_stats is false. This subroutine is -! called only when l_stats is true. - -!----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Constant(s) - - use crmx_stats_variables, only: & - zm, & - iwp2, & - irtp2, & - ithlp2, & - irtpthlp, & - iwprtp, & - iwpthlp, & - iwp3_zm, & - iwp4, & - iwpthvp, & - irtpthvp, & - ithlpthvp, & - itau_zm, & - iKh_zm, & - iwprcp, & - irc_coef, & - ithlprcp, & - irtprcp, & - ircp2 - - use crmx_stats_variables, only: & - iupwp, & - ivpwp, & - irho_zm, & - isigma_sqd_w, & - irho_ds_zm, & - ithv_ds_zm, & - iem, & - ishear, & - imean_w_up, & - imean_w_down, & - iFrad, & - iFrad_LW, & - iFrad_SW, & - iFrad_LW_up, & - iFrad_SW_up, & - iFrad_LW_down, & - iFrad_SW_down, & - iFprec, & - iFcsed - - use crmx_stats_variables, only: & - iup2, & - ivp2, & - iup2_bt, & - iup2_ta, & - iup2_tp, & - iup2_ma, & - iup2_dp1, & - iup2_dp2, & - iup2_pr1, & - iup2_pr2, & - iup2_cl, & - iup2_pd, & - iup2_sf, & - ivp2_bt, & - ivp2_ta, & - ivp2_tp, & - ivp2_ma, & - ivp2_dp1, & - ivp2_dp2, & - ivp2_pr1, & - ivp2_pr2, & - ivp2_cl, & - ivp2_pd, & - ivp2_sf - - use crmx_stats_variables, only: & - iVNr, & - iVrr, & - iVNc, & - iVrc, & - iVNice, & - iVrice, & - iVNsnow, & - iVrsnow, & - iVrgraupel, & - iVrrprrp, & - iVNrpNrp, & - iVrrprrp_net, & - iVNrpNrp_net - - use crmx_stats_variables, only: & - iwp2_bt, & - iwp2_ma, & - iwp2_ta, & - iwp2_ac, & - iwp2_bp, & - iwp2_pr1, & - iwp2_pr2, & - iwp2_pr3, & - iwp2_dp1, & - iwp2_dp2, & - iwp2_4hd, & - iwp2_cl, & - iwp2_pd, & - iwp2_sf - - use crmx_stats_variables, only: & - iwprtp_bt, & - iwprtp_ma, & - iwprtp_ta, & - iwprtp_tp, & - iwprtp_ac, & - iwprtp_bp, & - iwprtp_pr1, & - iwprtp_pr2, & - iwprtp_pr3, & - iwprtp_dp1, & - iwprtp_mfl, & - iwprtp_cl, & - iwprtp_sicl, & - iwprtp_pd, & - iwprtp_forcing, & - iwprtp_mc, & - iwpthlp_bt, & - iwpthlp_ma, & - iwpthlp_ta - - use crmx_stats_variables, only: & - iwpthlp_tp, & - iwpthlp_ac, & - iwpthlp_bp, & - iwpthlp_pr1, & - iwpthlp_pr2, & - iwpthlp_pr3, & - iwpthlp_dp1, & - iwpthlp_mfl, & - iwpthlp_cl, & - iwpthlp_sicl, & - iwpthlp_forcing, & - iwpthlp_mc - - use crmx_stats_variables, only: & - irtp2_bt, & - irtp2_ma, & - irtp2_ta, & - irtp2_tp, & - irtp2_dp1, & - irtp2_dp2, & - irtp2_cl, & - irtp2_pd, & - irtp2_sf, & - irtp2_forcing, & - irtp2_mc, & - ithlp2_bt, & - ithlp2_ma, & - ithlp2_ta, & - ithlp2_tp, & - ithlp2_dp1, & - ithlp2_dp2, & - ithlp2_cl, & - ithlp2_pd - - use crmx_stats_variables, only: & - ithlp2_sf, & - ithlp2_forcing, & - ithlp2_mc, & - irtpthlp_bt, & - irtpthlp_ma, & - irtpthlp_ta, & - irtpthlp_tp1, & - irtpthlp_tp2, & - irtpthlp_dp1, & - irtpthlp_dp2, & - irtpthlp_cl, & - irtpthlp_sf, & - irtpthlp_forcing, & - irtpthlp_mc - - use crmx_stats_variables, only: & - iwpthlp_entermfl, & ! Variable(s) - iwpthlp_exit_mfl, & - iwpthlp_mfl_min, & - iwpthlp_mfl_max, & - iwprtp_enter_mfl, & - iwprtp_exit_mfl, & - iwprtp_mfl_min, & - iwprtp_mfl_max - - use crmx_stats_variables, only: & - iwm_zm, & ! Variable - icloud_frac_zm, & - iice_supersat_frac_zm, & - ircm_zm, & - irtm_zm, & - ithlm_zm - - use crmx_stats_variables, only: & - isclrprtp, & - isclrp2, & - isclrpthvp, & - isclrpthlp, & - isclrprcp, & - iwpsclrp, & - iwp2sclrp, & - iwpsclrp2, & - iwpsclrprtp, & - iwpsclrpthlp, & - iwpedsclrp - - use crmx_stats_variables, only: & - ia3_coef, & - iwp3_on_wp2, & - iSkw_velocity, & - igamma_Skw_fnc, & - iC6rt_Skw_fnc, & - iC6thl_Skw_fnc, & - iC7_Skw_fnc, & - iC1_Skw_fnc - - use crmx_stats_type, only: & - stat_assign ! Procedure - - use crmx_parameters_model, only: & - sclr_dim, & - edsclr_dim - -! use error_code, only: & -! clubb_at_least_debug_level ! Function - - implicit none - - ! Input Variable - ! zm variable names - - character(len= * ), dimension(nvarmax_zm), intent(in) :: vars_zm - - ! Output Variable - logical, intent(inout) :: l_error - - ! Local Varables - integer :: i,j, k - - logical :: l_found - - character(len=50) :: sclr_idx - -! Default initialization for array indices for zm - - iwp2 = 0 - irtp2 = 0 - ithlp2 = 0 - irtpthlp = 0 - iwprtp = 0 - iwpthlp = 0 - iwp3_zm = 0 - iwp4 = 0 - iwpthvp = 0 - irtpthvp = 0 - ithlpthvp = 0 - itau_zm = 0 - iKh_zm = 0 - iwprcp = 0 - irc_coef = 0 - ithlprcp = 0 - irtprcp = 0 - ircp2 = 0 - iupwp = 0 - ivpwp = 0 - irho_zm = 0 - isigma_sqd_w = 0 - irho_ds_zm = 0 - ithv_ds_zm = 0 - iem = 0 - ishear = 0 ! Brian - imean_w_up = 0 - imean_w_down = 0 - iFrad = 0 - iFrad_LW = 0 ! Brian - iFrad_SW = 0 ! Brian - iFrad_LW_up = 0 ! Brian - iFrad_SW_up = 0 ! Brian - iFrad_LW_down = 0 ! Brian - iFrad_SW_down = 0 ! Brian - iFprec = 0 ! Brian - iFcsed = 0 ! Brian - - - iup2 = 0 - ivp2 = 0 - - iup2_bt = 0 - iup2_ta = 0 - iup2_tp = 0 - iup2_ma = 0 - iup2_dp1 = 0 - iup2_dp2 = 0 - iup2_pr1 = 0 - iup2_pr2 = 0 - iup2_cl = 0 - iup2_sf = 0 - - ivp2_bt = 0 - ivp2_ta = 0 - ivp2_tp = 0 - ivp2_ma = 0 - ivp2_dp1 = 0 - ivp2_dp2 = 0 - ivp2_pr1 = 0 - ivp2_pr2 = 0 - ivp2_cl = 0 - ivp2_sf = 0 - - ! Sedimentation velocities - iVNr = 0 - iVrr = 0 - iVNc = 0 - iVrc = 0 - iVNice = 0 - iVrice = 0 - iVrgraupel = 0 - iVNsnow = 0 - iVrsnow = 0 - - ! Covariance of sedimentation velocity and hydrometeor, - iVrrprrp = 0 - iVNrpNrp = 0 - iVrrprrp_net = 0 - iVNrpNrp_net = 0 - - ! Vertical velocity budgets - iwp2_bt = 0 - iwp2_ma = 0 - iwp2_ta = 0 - iwp2_ac = 0 - iwp2_bp = 0 - iwp2_pr1 = 0 - iwp2_pr2 = 0 - iwp2_pr3 = 0 - iwp2_dp1 = 0 - iwp2_dp2 = 0 - iwp2_4hd = 0 - iwp2_cl = 0 - iwp2_pd = 0 - iwp2_sf = 0 - - ! Flux budgets - iwprtp_bt = 0 - iwprtp_ma = 0 - iwprtp_ta = 0 - iwprtp_tp = 0 - iwprtp_ac = 0 - iwprtp_bp = 0 - iwprtp_pr1 = 0 - iwprtp_pr2 = 0 - iwprtp_pr3 = 0 - iwprtp_dp1 = 0 - iwprtp_mfl = 0 - iwprtp_cl = 0 - iwprtp_sicl = 0 - iwprtp_pd = 0 - iwprtp_forcing = 0 - iwprtp_mc = 0 - - iwpthlp_bt = 0 - iwpthlp_ma = 0 - iwpthlp_ta = 0 - iwpthlp_tp = 0 - iwpthlp_ac = 0 - iwpthlp_bp = 0 - iwpthlp_pr1 = 0 - iwpthlp_pr2 = 0 - iwpthlp_pr3 = 0 - iwpthlp_dp1 = 0 - iwpthlp_mfl = 0 - iwpthlp_cl = 0 - iwpthlp_sicl = 0 - iwpthlp_forcing = 0 - iwpthlp_mc = 0 - - ! Variance budgets - irtp2_bt = 0 - irtp2_ma = 0 - irtp2_ta = 0 - irtp2_tp = 0 - irtp2_dp1 = 0 - irtp2_dp2 = 0 - irtp2_cl = 0 - irtp2_pd = 0 - irtp2_sf = 0 - irtp2_forcing = 0 - irtp2_mc = 0 - - ithlp2_bt = 0 - ithlp2_ma = 0 - ithlp2_ta = 0 - ithlp2_tp = 0 - ithlp2_dp1 = 0 - ithlp2_dp2 = 0 - ithlp2_cl = 0 - ithlp2_pd = 0 - ithlp2_sf = 0 - ithlp2_forcing = 0 - ithlp2_mc = 0 - - irtpthlp_bt = 0 - irtpthlp_ma = 0 - irtpthlp_ta = 0 - irtpthlp_tp1 = 0 - irtpthlp_tp2 = 0 - irtpthlp_dp1 = 0 - irtpthlp_dp2 = 0 - irtpthlp_cl = 0 - irtpthlp_sf = 0 - irtpthlp_forcing = 0 - irtpthlp_mc = 0 - - !Monatonic flux limiter diagnostic output - iwpthlp_mfl_min = 0 - iwpthlp_mfl_max = 0 - iwpthlp_entermfl = 0 - iwpthlp_exit_mfl = 0 - iwprtp_mfl_min = 0 - iwprtp_mfl_max = 0 - iwprtp_enter_mfl = 0 - iwprtp_exit_mfl = 0 - - ! Skewness velocity - iSkw_velocity = 0 - - ! Skewness function - igamma_Skw_fnc = 0 - iC6rt_Skw_fnc = 0 - iC6thl_Skw_fnc = 0 - iC7_Skw_fnc = 0 - iC1_Skw_fnc = 0 - - ia3_coef = 0 - iwp3_on_wp2 = 0 - - allocate(isclrprtp(1:sclr_dim)) - allocate(isclrp2(1:sclr_dim)) - allocate(isclrpthvp(1:sclr_dim)) - allocate(isclrpthlp(1:sclr_dim)) - allocate(isclrprcp(1:sclr_dim)) - allocate(iwpsclrp(1:sclr_dim)) - allocate(iwp2sclrp(1:sclr_dim)) - allocate(iwpsclrp2(1:sclr_dim)) - allocate(iwpsclrprtp(1:sclr_dim)) - allocate(iwpsclrpthlp(1:sclr_dim)) - - allocate(iwpedsclrp(1:edsclr_dim)) - -! Assign pointers for statistics variables zm - - isclrprtp = 0 - isclrp2 = 0 - isclrpthvp = 0 - isclrpthlp = 0 - isclrprcp = 0 - iwpsclrp = 0 - iwp2sclrp = 0 - iwpsclrp2 = 0 - iwpsclrprtp = 0 - iwpsclrpthlp = 0 - - iwpedsclrp = 0 - -! Assign pointers for statistics variables zm - - k = 1 - do i=1,zm%nn - - select case ( trim(vars_zm(i)) ) - - case ('wp2') - iwp2 = k - call stat_assign(iwp2,"wp2", & - "w'^2, Variance of vertical air velocity [m^2/s^2]","m^2/s^2",zm) - k = k + 1 - - case ('rtp2') - irtp2 = k - call stat_assign(irtp2,"rtp2", & - "rt'^2, Variance of rt [(kg/kg)^2]","(kg/kg)^2",zm) - k = k + 1 - - case ('thlp2') - ithlp2 = k - call stat_assign(ithlp2,"thlp2", & - "thl'^2, Variance of thl [K^2]","K^2",zm) - k = k + 1 - - case ('rtpthlp') - irtpthlp = k - call stat_assign(irtpthlp,"rtpthlp", & - "rt'thl', Covariance of rt and thl [(kg K)/kg]","(kg K)/kg",zm) - k = k + 1 - - case ('wprtp') - iwprtp = k - - call stat_assign(iwprtp,"wprtp", & - "w'rt', Vertical turbulent flux of rt [(kg/kg) m/s]","(m kg)/(s kg)",zm) - k = k + 1 - - case ('wpthlp') - iwpthlp = k - - call stat_assign(iwpthlp,"wpthlp", & - "w'thl', Vertical turbulent flux of thl [K m/s]","(m K)/s",zm) - k = k + 1 - - case ('wp3_zm') - iwp3_zm = k - call stat_assign( iwp3_zm, "wp3_zm", & - "w'^3 interpolated to moment. levels [m^3/s^3]", "(m^3)/(s^3)", zm ) - k = k + 1 - - case ('wp4') - iwp4 = k - call stat_assign(iwp4,"wp4", & - "w'^4 [m^4/s^4]","(m^4)/(s^4)",zm) - k = k + 1 - - case ('wpthvp') - iwpthvp = k - call stat_assign(iwpthvp,"wpthvp", & - "Buoyancy flux [K m/s]","K m/s",zm) - k = k + 1 - - case ('rtpthvp') - irtpthvp = k - call stat_assign(irtpthvp,"rtpthvp", & - "rt'thv' [(kg/kg) K]","(kg/kg) K",zm) - k = k + 1 - - case ('thlpthvp') - ithlpthvp = k - call stat_assign(ithlpthvp,"thlpthvp", & - "thl'thv' [K^2]","K^2",zm) - k = k + 1 - - case ('tau_zm') - itau_zm = k - - call stat_assign(itau_zm,"tau_zm", & - "Time-scale tau on momentum levels [s]","s",zm) - k = k + 1 - - case ('Kh_zm') - iKh_zm = k - - call stat_assign(iKh_zm,"Kh_zm", & - "Eddy diffusivity on momentum levels [m^2/s]","m^2/s",zm) - k = k + 1 - - case ('wprcp') - iwprcp = k - call stat_assign(iwprcp,"wprcp", & - "w' rc' [(m/s) (kg/kg)]","(m/s) (kg/kg)",zm) - k = k + 1 - - case ('rc_coef') - irc_coef = k - call stat_assign(irc_coef, "rc_coef", & - "Coefficient of X' R_l' in Eq. (34)", "[-]", zm) - k = k + 1 - - case ('thlprcp') - ithlprcp = k - call stat_assign(ithlprcp,"thlprcp", & - "thl' rc' [K (kg/kg)]","K (kg/kg)",zm) - k = k + 1 - - case ('rtprcp') - irtprcp = k - - call stat_assign(irtprcp,"rtprcp", & - "rt'rc' [(kg^2)/(kg^2)]","(kg^2)/(kg^2)",zm) - k = k + 1 - - case ('rcp2') - ircp2 = k - call stat_assign(ircp2,"rcp2", & - "rc'^2 [(kg^2)/(kg^2)]","(kg^2)/(kg^2)",zm) - k = k + 1 - case ('upwp') - iupwp = k - call stat_assign(iupwp,"upwp", & - "u'w', Vertical east-west momentum flux [m^2/s^2]","m^2/s^2",zm) - k = k + 1 - case ('vpwp') - ivpwp = k - call stat_assign(ivpwp,"vpwp", & - "v'w', Vertical north-south momentum flux [m^2/s^2]","m^2/s^2",zm) - k = k + 1 - case ('rho_zm') - irho_zm = k - call stat_assign(irho_zm,"rho_zm", & - "Density on momentum levels [kg/m^3]","kg m^{-3}",zm) - k = k + 1 - case ('sigma_sqd_w') - isigma_sqd_w = k - call stat_assign(isigma_sqd_w,"sigma_sqd_w", & - "Nondimensionalized w variance of Gaussian component [-]","-",zm) - k = k + 1 - case ('rho_ds_zm') - irho_ds_zm = k - call stat_assign(irho_ds_zm,"rho_ds_zm", & - "Dry, static, base-state density [kg/m^3]","kg m^{-3}",zm) - k = k + 1 - case ('thv_ds_zm') - ithv_ds_zm = k - call stat_assign(ithv_ds_zm,"thv_ds_zm", & - "Dry, base-state theta_v [K]","K",zm) - k = k + 1 - case ('em') - iem = k - call stat_assign(iem,"em", & - "Turbulent kinetic energy, usu. 0.5*(u'^2+v'^2+w'^2) [m^2/s^2]","m^2/s^2",zm) - k = k + 1 - case ('shear') ! Brian - ishear = k - call stat_assign(ishear,"shear", & - "Wind shear production term [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - case ('mean_w_up') - imean_w_up = k - call stat_assign(imean_w_up, "mean_w_up", & - "Mean w >= w_ref [m/s]", "m/s", zm) - k = k + 1 - case ('mean_w_down') - imean_w_down = k - call stat_assign(imean_w_down, "mean_w_down", & - "Mean w <= w_ref [m/s]", "m/s", zm) - k = k + 1 - case ('Frad') - iFrad = k - call stat_assign(iFrad,"Frad", & - "Total (sw+lw) net (up+down) radiative flux [W/m^2]","W/m^2",zm) - k = k + 1 - case ('Frad_LW') ! Brian - iFrad_LW = k - call stat_assign(iFrad_LW,"Frad_LW", & - "Net long-wave radiative flux [W/m^2]","W/m^2",zm) - k = k + 1 - case ('Frad_SW') ! Brian - iFrad_SW = k - - call stat_assign(iFrad_SW,"Frad_SW", & - "Net short-wave radiative flux [W/m^2]","W/m^2",zm) - k = k + 1 - - case ('Frad_LW_up') ! Brian - iFrad_LW_up = k - call stat_assign(iFrad_LW_up,"Frad_LW_up", & - "Long-wave upwelling radiative flux [W/m^2]","W/m^2",zm) - k = k + 1 - case ('Frad_SW_up') ! Brian - iFrad_SW_up = k - - call stat_assign(iFrad_SW_up,"Frad_SW_up", & - "Short-wave upwelling radiative flux [W/m^2]","W/m^2",zm) - k = k + 1 - - case ('Frad_LW_down') ! Brian - iFrad_LW_down = k - call stat_assign(iFrad_LW_down,"Frad_LW_down", & - "Long-wave downwelling radiative flux [W/m^2]", "W/m^2", zm ) - k = k + 1 - case ('Frad_SW_down') ! Brian - iFrad_SW_down = k - - call stat_assign(iFrad_SW_down,"Frad_SW_down", & - "Short-wave downwelling radiative flux [W/m^2]", "W/m^2", zm ) - k = k + 1 - - - case ('Fprec') ! Brian - iFprec = k - - call stat_assign(iFprec,"Fprec", & - "Rain flux [W/m^2]","W/m^2",zm) - k = k + 1 - - case ('Fcsed') ! Brian - iFcsed = k - - call stat_assign(iFcsed,"Fcsed", & - "cloud water sedimentation flux [kg/(s*m^2)]", & - "kg/(s*m^2)",zm) - k = k + 1 - - case ('VNr') - iVNr = k - - call stat_assign(iVNr,"VNr", & - "rrainm concentration fallspeed [m/s]","m/s",zm) - k = k + 1 - - case ('Vrr') - iVrr = k - - call stat_assign(iVrr,"Vrr", & - "rrainm mixing ratio fallspeed [m/s]","m/s",zm) - k = k + 1 - - case ('VNc') - iVNc = k - - call stat_assign(iVNc,"VNc", & - "Nrm concentration fallspeed [m/s]","m/s",zm) - k = k + 1 - - case ('Vrc') - iVrc = k - - call stat_assign(iVrc,"Vrc", & - "Nrm mixing ratio fallspeed [m/s]","m/s",zm) - k = k + 1 - - case ('VNsnow') - iVNsnow = k - - call stat_assign(iVNsnow,"VNsnow", & - "Snow concentration fallspeed [m/s]","m/s",zm) - k = k + 1 - - case ('Vrsnow') - iVrsnow = k - - call stat_assign(iVrsnow,"Vrsnow", & - "Snow mixing ratio fallspeed [m/s]","m/s",zm) - k = k + 1 - - case ('Vrgraupel') - iVrgraupel = k - - call stat_assign(iVrgraupel,"Vrgraupel", & - "Graupel sedimentation velocity [m/s]","m/s",zm) - k = k + 1 - - case ('VNice') - iVNice = k - - call stat_assign(iVNice,"VNice", & - "Cloud ice concentration fallspeed [m/s]","m/s",zm) - k = k + 1 - - case ('Vrice') - iVrice = k - - call stat_assign(iVrice,"Vrice", & - "Cloud ice mixing ratio fallspeed [m/s]","m/s",zm) - k = k + 1 - - case ('Vrrprrp') - iVrrprrp = k - - call stat_assign( iVrrprrp, "Vrrprrp", & - "Covariance of V_rr (r_r sed. vel.) and r_r [(m/s)(kg/kg)]", & - "(m/s)(kg/kg)", zm ) - k = k + 1 - - case ('VNrpNrp') - iVNrpNrp = k - - call stat_assign( iVNrpNrp, "VNrpNrp", & - "Covariance of V_Nr (N_r sed. vel.) and N_r [(m/s)(num/kg)]", & - "(m/s)(num/kg)", zm ) - k = k + 1 - - case ('Vrrprrp_net') - iVrrprrp_net = k - - call stat_assign( iVrrprrp_net, "Vrrprrp_net", & - "Adjusted value of < V_rr'r_r' > (turb. sed. flux limiter)" & - //" [(m/s)(kg/kg)]", "(m/s)(kg/kg)", zm ) - k = k + 1 - - case ('VNrpNrp_net') - iVNrpNrp_net = k - - call stat_assign( iVNrpNrp_net, "VNrpNrp_net", & - "Adjusted value of < V_Nr'N_r' > (turb. sed. flux limiter)" & - //" [(m/s)(num/kg)]", "(m/s)(num/kg)", zm ) - k = k + 1 - - case ('wp2_bt') - iwp2_bt = k - - call stat_assign(iwp2_bt,"wp2_bt", & - "wp2 budget: wp2 time tendency [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('wp2_ma') - iwp2_ma = k - - call stat_assign(iwp2_ma,"wp2_ma", & - "wp2 budget: wp2 vertical mean advection [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('wp2_ta') - iwp2_ta = k - - call stat_assign(iwp2_ta,"wp2_ta", & - "wp2 budget: wp2 turbulent advection [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('wp2_ac') - iwp2_ac = k - - call stat_assign(iwp2_ac,"wp2_ac", & - "wp2 budget: wp2 accumulation term [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('wp2_bp') - iwp2_bp = k - - call stat_assign(iwp2_bp,"wp2_bp", & - "wp2 budget: wp2 buoyancy production [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('wp2_pr1') - iwp2_pr1 = k - - call stat_assign(iwp2_pr1,"wp2_pr1", & - "wp2 budget: wp2 pressure term 1 [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('wp2_pr2') - iwp2_pr2 = k - call stat_assign(iwp2_pr2,"wp2_pr2", & - "wp2 budget: wp2 pressure term 2 [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('wp2_pr3') - iwp2_pr3 = k - call stat_assign(iwp2_pr3,"wp2_pr3", & - "wp2 budget: wp2 pressure term 3 [m^2/s^3]","m^2/s^3",zm) - - k = k + 1 - - case ('wp2_dp1') - iwp2_dp1 = k - call stat_assign(iwp2_dp1,"wp2_dp1", & - "wp2 budget: wp2 dissipation term 1 [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('wp2_dp2') - iwp2_dp2 = k - call stat_assign(iwp2_dp2,"wp2_dp2", & - "wp2 budget: wp2 dissipation term 2 [m^2/s^3]","m^2/s^3",zm) - - k = k + 1 - - case ('wp2_4hd') - iwp2_4hd = k - call stat_assign(iwp2_4hd,"wp2_4hd", & - "wp2 budget: wp2 4th-order hyper-diffusion [m^2/s^3]","m^2/s^3",zm) - - k = k + 1 - - case ('wp2_cl') - iwp2_cl = k - - call stat_assign(iwp2_cl,"wp2_cl", & - "wp2 budget: wp2 clipping term [m^2/s^3]","m^2/s^3",zm) - - k = k + 1 - - case ('wp2_pd') - iwp2_pd = k - - call stat_assign(iwp2_pd,"wp2_pd", & - "wp2 budget: wp2 positive definite adjustment [m^2/s^3]","m2/s3",zm) - - k = k + 1 - - case ('wp2_sf') - iwp2_sf = k - - call stat_assign( iwp2_sf, "wp2_sf", & - "wp2 budget: wp2 surface variance [m^2/s^3]","m2/s3",zm) - - k = k + 1 - - case ('wprtp_bt') - iwprtp_bt = k - call stat_assign(iwprtp_bt,"wprtp_bt", & - "wprtp budget: wprtp time tendency [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_ma') - iwprtp_ma = k - - call stat_assign(iwprtp_ma,"wprtp_ma", & - "wprtp budget: wprtp mean advection [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_ta') - iwprtp_ta = k - - call stat_assign(iwprtp_ta,"wprtp_ta", & - "wprtp budget: wprtp turbulent advection [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_tp') - iwprtp_tp = k - - call stat_assign(iwprtp_tp,"wprtp_tp", & - "wprtp budget: wprtp turbulent production [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_ac') - iwprtp_ac = k - - call stat_assign(iwprtp_ac,"wprtp_ac", & - "wprtp budget: wprtp accumulation term [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_bp') - iwprtp_bp = k - - call stat_assign(iwprtp_bp,"wprtp_bp", & - "wprtp budget: wprtp buoyancy production [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_pr1') - iwprtp_pr1 = k - - call stat_assign(iwprtp_pr1,"wprtp_pr1", & - "wprtp budget: wprtp pressure term 1 [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_pr2') - iwprtp_pr2 = k - - call stat_assign(iwprtp_pr2,"wprtp_pr2", & - "wprtp budget: wprtp pressure term 2 [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_pr3') - iwprtp_pr3 = k - - call stat_assign(iwprtp_pr3,"wprtp_pr3", & - "wprtp budget: wprtp pressure term 3 [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_dp1') - iwprtp_dp1 = k - - call stat_assign(iwprtp_dp1,"wprtp_dp1", & - "wprtp budget: wprtp dissipation term 1 [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_mfl') - iwprtp_mfl = k - - call stat_assign(iwprtp_mfl,"wprtp_mfl", & - "wprtp budget: wprtp monotonic flux limiter [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_cl') - iwprtp_cl = k - - call stat_assign(iwprtp_cl,"wprtp_cl", & - "wprtp budget: wprtp clipping term [(m kg)/(s^2 kg)]","(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_sicl') - iwprtp_sicl = k - - call stat_assign(iwprtp_sicl,"wprtp_sicl", & - "wprtp budget: wprtp semi-implicit clipping term [(m kg)/(s^2 kg)]", & - "(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_pd') - iwprtp_pd = k - - call stat_assign(iwprtp_pd,"wprtp_pd", & - "wprtp budget: wprtp flux corrected trans. term [(m kg)/(s^2 kg)]", & - "(m kg)/(s^2 kg)",zm) - k = k + 1 - - case ('wprtp_forcing') - iwprtp_forcing = k - - call stat_assign( iwprtp_forcing, "wprtp_forcing", & - "wprtp budget: wprtp forcing (includes microphysics tendency) [(m kg/kg)/s^2]", & - "(m kg/kg)/s^2", zm ) - k = k + 1 - - case ('wprtp_mc') - iwprtp_mc = k - - call stat_assign( iwprtp_mc, "wprtp_mc", & - "Microphysics tendency for wprtp (not in budget) [(m kg/kg)/s^2]", & - "(m kg/kg)/s^2", zm ) - k = k + 1 - - case ('wpthlp_bt') - iwpthlp_bt = k - - call stat_assign(iwpthlp_bt,"wpthlp_bt", & - "wpthlp budget: [(m K)/s^2]","(m K)/s^2",zm) - k = k + 1 - - case ('wpthlp_ma') - iwpthlp_ma = k - call stat_assign(iwpthlp_ma,"wpthlp_ma", & - "wpthlp budget: wpthlp mean advection [(m K)/s^2]","(m K)/s^2",zm) - - k = k + 1 - - case ('wpthlp_ta') - iwpthlp_ta = k - call stat_assign(iwpthlp_ta,"wpthlp_ta", & - "wpthlp budget: wpthlp turbulent advection [(m K)/s^2]","(m K)/s^2",zm) - - k = k + 1 - - case ('wpthlp_tp') - iwpthlp_tp = k - call stat_assign(iwpthlp_tp,"wpthlp_tp", & - "wpthlp budget: wpthlp turbulent production [(m K)/s^2]","(m K)/s^2",zm) - - k = k + 1 - - case ('wpthlp_ac') - iwpthlp_ac = k - call stat_assign(iwpthlp_ac,"wpthlp_ac", & - "wpthlp budget: wpthlp accumulation term [(m K)/s^2]","(m K)/s^2",zm) - - k = k + 1 - - case ('wpthlp_bp') - iwpthlp_bp = k - call stat_assign(iwpthlp_bp,"wpthlp_bp", & - "wpthlp budget: wpthlp buoyancy production [(m K)/s^2]","(m K)/s^2",zm) - k = k + 1 - - case ('wpthlp_pr1') - iwpthlp_pr1 = k - - call stat_assign(iwpthlp_pr1,"wpthlp_pr1", & - "wpthlp budget: wpthlp pressure term 1 [(m K)/s^2]","(m K)/s^2",zm) - k = k + 1 - - case ('wpthlp_pr2') - iwpthlp_pr2 = k - - call stat_assign(iwpthlp_pr2,"wpthlp_pr2", & - "wpthlp budget: wpthlp pressure term 2 [(m K)/s^2]","(m K)/s^2",zm) - k = k + 1 - - case ('wpthlp_pr3') - iwpthlp_pr3 = k - call stat_assign(iwpthlp_pr3,"wpthlp_pr3", & - "wpthlp budget: wpthlp pressure term 3 [(m K)/s^2]","(m K)/s^2",zm) - k = k + 1 - - case ('wpthlp_dp1') - iwpthlp_dp1 = k - call stat_assign(iwpthlp_dp1,"wpthlp_dp1", & - "wpthlp budget: wpthlp dissipation term 1 [(m K)/s^2]","(m K)/s^2",zm) - k = k + 1 - - case ('wpthlp_mfl') - iwpthlp_mfl = k - call stat_assign(iwpthlp_mfl,"wpthlp_mfl", & - "wpthlp budget: wpthlp monotonic flux limiter [(m K)/s^2]","(m K)/s^2",zm) - k = k + 1 - - case ('wpthlp_cl') - iwpthlp_cl = k - call stat_assign(iwpthlp_cl,"wpthlp_cl", & - "wpthlp budget: wpthlp clipping term [(m K)/s^2]","(m K)/s^2",zm) - k = k + 1 - - case ('wpthlp_sicl') - iwpthlp_sicl = k - call stat_assign(iwpthlp_sicl,"wpthlp_sicl", & - "wpthlp budget: wpthlp semi-implicit clipping term [(m K)/s^2]","(m K)/s^2",zm) - k = k + 1 - - case ('wpthlp_forcing') - iwpthlp_forcing = k - - call stat_assign( iwpthlp_forcing, "wpthlp_forcing", & - "wpthlp budget: wpthlp forcing (includes microphysics tendency) [(m K)/s^2]", & - "(m K)/s^2", zm ) - k = k + 1 - - case ('wpthlp_mc') - iwpthlp_mc = k - - call stat_assign( iwpthlp_mc, "wpthlp_mc", & - "Microphysics tendency for wpthlp (not in budget) [(m K)/s^2]", & - "(m K)/s^2", zm ) - k = k + 1 - - ! Variance budgets - case ('rtp2_bt') - irtp2_bt = k - call stat_assign(irtp2_bt,"rtp2_bt", & - "rtp2 budget: rtp2 time tendency [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) - k = k + 1 - case ('rtp2_ma') - irtp2_ma = k - call stat_assign(irtp2_ma,"rtp2_ma", & - "rtp2 budget: rtp2 mean advection [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) - k = k + 1 - case ('rtp2_ta') - irtp2_ta = k - call stat_assign(irtp2_ta,"rtp2_ta", & - "rtp2 budget: rtp2 turbulent advection [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) - k = k + 1 - case ('rtp2_tp') - irtp2_tp = k - call stat_assign(irtp2_tp,"rtp2_tp", & - "rtp2 budget: rtp2 turbulent production [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) - k = k + 1 - case ('rtp2_dp1') - irtp2_dp1 = k - call stat_assign(irtp2_dp1,"rtp2_dp1", & - "rtp2 budget: rtp2 dissipation term 1 [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) - k = k + 1 - case ('rtp2_dp2') - irtp2_dp2 = k - call stat_assign(irtp2_dp2,"rtp2_dp2", & - "rtp2 budget: rtp2 dissipation term 2 [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) - k = k + 1 - case ('rtp2_cl') - irtp2_cl = k - call stat_assign(irtp2_cl,"rtp2_cl", & - "rtp2 budget: rtp2 clipping term [(kg^2)/(kg^2 s)]","(kg^2)/(kg^2 s)",zm) - k = k + 1 - - case ('rtp2_pd') - irtp2_pd = k - call stat_assign( irtp2_pd, "rtp2_pd", & - "rtp2 budget: rtp2 positive definite adjustment [(kg^2)/(kg^2 s)]", & - "(kg^2)/(kg^2 s)", zm ) - k = k + 1 - - case ('rtp2_sf') - irtp2_sf = k - call stat_assign( irtp2_sf, "rtp2_sf", & - "rtp2 budget: rtp2 surface variance [(kg^2)/(kg^2 s)]", & - "(kg^2)/(kg^2 s)", zm ) - k = k + 1 - - case ('rtp2_forcing') - irtp2_forcing = k - - call stat_assign( irtp2_forcing, "rtp2_forcing", & - "rtp2 budget: rtp2 forcing (includes microphysics tendency) [(kg/kg)^2/s]", & - "(kg/kg)^2/s", zm ) - k = k + 1 - - case ('rtp2_mc') - irtp2_mc = k - - call stat_assign( irtp2_mc, "rtp2_mc", & - "Microphysics tendency for rtp2 (not in budget) [(kg/kg)^2/s]", & - "(kg/kg)^2/s", zm ) - k = k + 1 - - case ('thlp2_bt') - ithlp2_bt = k - call stat_assign(ithlp2_bt,"thlp2_bt", & - "thlp2 budget: thlp2 time tendency [(K^2)/s]","(K^2)/s",zm) - k = k + 1 - case ('thlp2_ma') - ithlp2_ma = k - call stat_assign(ithlp2_ma,"thlp2_ma", & - "thlp2 budget: thlp2 mean advection [(K^2)/s]","(K^2)/s",zm) - k = k + 1 - case ('thlp2_ta') - ithlp2_ta = k - call stat_assign(ithlp2_ta,"thlp2_ta", & - "thlp2 budget: thlp2 turbulent advection [(K^2)/s]","(K^2)/s",zm) - k = k + 1 - case ('thlp2_tp') - ithlp2_tp = k - call stat_assign(ithlp2_tp,"thlp2_tp", & - "thlp2 budget: thlp2 turbulent production [(K^2)/s]","(K^2)/s",zm) - k = k + 1 - case ('thlp2_dp1') - ithlp2_dp1 = k - call stat_assign(ithlp2_dp1,"thlp2_dp1", & - "thlp2 budget: thlp2 dissipation term 1 [(K^2)/s]","(K^2)/s",zm) - k = k + 1 - case ('thlp2_dp2') - ithlp2_dp2 = k - call stat_assign(ithlp2_dp2,"thlp2_dp2", & - "thlp2 budget: thlp2 dissipation term 2 [(K^2)/s]","(K^2)/s",zm) - k = k + 1 - case ('thlp2_cl') - ithlp2_cl = k - call stat_assign(ithlp2_cl,"thlp2_cl", & - "thlp2 budget: thlp2 clipping term [(K^2)/s]","(K^2)/s",zm) - k = k + 1 - - case ('thlp2_pd') - ithlp2_pd = k - call stat_assign( ithlp2_pd, "thlp2_pd", & - "thlp2 budget: thlp2 positive definite adjustment [(K^2)/s]", "K^2/s", zm ) - k = k + 1 - - case ('thlp2_sf') - ithlp2_sf = k - call stat_assign( ithlp2_sf, "thlp2_sf", & - "thlp2 budget: thlp2 surface variance [(K^2)/s]", "K^2/s", zm ) - k = k + 1 - case ('thlp2_forcing') - ithlp2_forcing = k - call stat_assign( ithlp2_forcing, "thlp2_forcing", & - "thlp2 budget: thlp2 forcing (includes microphysics tendency) [K^2/s]", & - "K^2/s", zm ) - k = k + 1 - case ('thlp2_mc') - ithlp2_mc = k - call stat_assign( ithlp2_mc, "thlp2_mc", & - "Microphysics tendency for thlp2 (not in budget) [K^2/s]", & - "K^2/s", zm ) - k = k + 1 - - case ('rtpthlp_bt') - irtpthlp_bt = k - call stat_assign(irtpthlp_bt,"rtpthlp_bt", & - "rtpthlp budget: rtpthlp time tendency [(kg K)/(kg s)]","(kg K)/(kg s)",zm) - k = k + 1 - case ('rtpthlp_ma') - irtpthlp_ma = k - call stat_assign(irtpthlp_ma,"rtpthlp_ma", & - "rtpthlp budget: rtpthlp mean advection [(kg K)/(kg s)]","(kg K)/(kg s)",zm) - k = k + 1 - case ('rtpthlp_ta') - irtpthlp_ta = k - call stat_assign(irtpthlp_ta,"rtpthlp_ta", & - "rtpthlp budget: rtpthlp turbulent advection [](kg K)/(kg s)","(kg K)/(kg s)",zm) - k = k + 1 - case ('rtpthlp_tp1') - irtpthlp_tp1 = k - call stat_assign(irtpthlp_tp1,"rtpthlp_tp1", & - "rtpthlp budget: rtpthlp turbulent production 1 [(kg K)/(kg s)]","(kg K)/(kg s)",zm) - k = k + 1 - case ('rtpthlp_tp2') - irtpthlp_tp2 = k - call stat_assign(irtpthlp_tp2,"rtpthlp_tp2", & - "rtpthlp budget: rtpthlp turbulent production 2 [(kg K)/(kg s)]","(kg K)/(kg s)",zm) - k = k + 1 - case ('rtpthlp_dp1') - irtpthlp_dp1 = k - call stat_assign(irtpthlp_dp1,"rtpthlp_dp1", & - "rtpthlp budget: rtpthlp dissipation term 1 [(kg K)/(kg s)]","(kg K)/(kg s)",zm) - k = k + 1 - case ('rtpthlp_dp2') - irtpthlp_dp2 = k - call stat_assign(irtpthlp_dp2,"rtpthlp_dp2", & - "rtpthlp budget: rtpthlp dissipation term 2 [(kg K)/(kg s)]","(kg K)/(kg s)",zm) - k = k + 1 - case ('rtpthlp_cl') - irtpthlp_cl = k - call stat_assign(irtpthlp_cl,"rtpthlp_cl", & - "rtpthlp budget: rtpthlp clipping term [(kg K)/(kg s)]","(kg K)/(kg s)",zm) - k = k + 1 - case ('rtpthlp_sf') - irtpthlp_sf = k - call stat_assign(irtpthlp_sf,"rtpthlp_sf", & - "rtpthlp budget: rtpthlp surface variance [(kg K)/(kg s)]","(kg K)/(kg s)",zm) - k = k + 1 - case ('rtpthlp_forcing') - irtpthlp_forcing = k - call stat_assign( irtpthlp_forcing, "rtpthlp_forcing", & - "rtpthlp budget: rtpthlp forcing (includes microphysics tendency) [(K kg/kg)/s]", & - "(K kg/kg)/s", zm ) - k = k + 1 - case ('rtpthlp_mc') - irtpthlp_mc = k - call stat_assign( irtpthlp_mc, "rtpthlp_mc", & - "Microphysics tendency for rtpthlp (not in budget) [(K kg/kg)/s]", & - "(K kg/kg)/s", zm ) - k = k + 1 - - case ('up2') - iup2 = k - call stat_assign(iup2,"up2", & - "u'^2 (momentum levels) [m^2/s^2]","m^2/s^2",zm) - k = k + 1 - - case ('vp2') - ivp2 = k - call stat_assign(ivp2,"vp2", & - "v'^2 (momentum levels) [m^2/s^2]","m^2/s^2",zm) - k = k + 1 - - case ('up2_bt') - iup2_bt = k - call stat_assign(iup2_bt,"up2_bt", & - "up2 budget: up2 time tendency [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('up2_ma') - iup2_ma = k - call stat_assign(iup2_ma,"up2_ma", & - "up2 budget: up2 mean advection [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('up2_ta') - iup2_ta = k - call stat_assign(iup2_ta,"up2_ta", & - "up2 budget: up2 turbulent advection [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('up2_tp') - iup2_tp = k - call stat_assign(iup2_tp,"up2_tp", & - "up2 budget: up2 turbulent production [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('up2_dp1') - iup2_dp1 = k - call stat_assign(iup2_dp1,"up2_dp1", & - "up2 budget: up2 dissipation term 1 [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('up2_dp2') - iup2_dp2 = k - call stat_assign(iup2_dp2,"up2_dp2", & - "up2 budget: up2 dissipation term 2 [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('up2_pr1') - iup2_pr1 = k - call stat_assign(iup2_pr1,"up2_pr1", & - "up2 budget: up2 pressure term 1 [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('up2_pr2') - iup2_pr2 = k - call stat_assign(iup2_pr2,"up2_pr2", & - "up2 budget: up2 pressure term 2 [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('up2_cl') - iup2_cl = k - call stat_assign(iup2_cl,"up2_cl", & - "up2 budget: up2 clipping [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('up2_pd') - iup2_pd = k - call stat_assign( iup2_pd, "up2_pd", & - "up2 budget: up2 positive definite adjustment [m^2/s^3]", "m^2/s^3", zm ) - k = k + 1 - - case ('up2_sf') - iup2_sf = k - call stat_assign(iup2_sf,"up2_sf", & - "up2 budget: up2 surface variance [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('vp2_bt') - ivp2_bt = k - call stat_assign(ivp2_bt,"vp2_bt", & - "vp2 budget: vp2 time tendency [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('vp2_ma') - ivp2_ma = k - call stat_assign(ivp2_ma,"vp2_ma", & - "vp2 budget: vp2 mean advection [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('vp2_ta') - ivp2_ta = k - call stat_assign(ivp2_ta,"vp2_ta", & - "vp2 budget: vp2 turbulent advection [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('vp2_tp') - ivp2_tp = k - call stat_assign(ivp2_tp,"vp2_tp", & - "vp2 budget: vp2 turbulent production [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('vp2_dp1') - ivp2_dp1 = k - call stat_assign(ivp2_dp1,"vp2_dp1", & - "vp2 budget: vp2 dissipation term 1 [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('vp2_dp2') - ivp2_dp2 = k - call stat_assign(ivp2_dp2,"vp2_dp2", & - "vp2 budget: vp2 dissipation term 2 [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('vp2_pr1') - ivp2_pr1 = k - call stat_assign(ivp2_pr1,"vp2_pr1", & - "vp2 budget: vp2 pressure term 1 [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('vp2_pr2') - ivp2_pr2 = k - call stat_assign(ivp2_pr2,"vp2_pr2", & - "vp2 budget: vp2 pressure term 2 [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('vp2_cl') - ivp2_cl = k - call stat_assign(ivp2_cl,"vp2_cl", & - "vp2 budget: vp2 clipping [m^2/s^3]","m^2/s^3",zm) - k = k + 1 - - case ('vp2_pd') - ivp2_pd = k - call stat_assign( ivp2_pd, "vp2_pd", & - "vp2 budget: vp2 positive definite adjustment [m^2/s^3]", "m^2/s^3", zm ) - k = k + 1 - - case ('vp2_sf') - ivp2_sf = k - call stat_assign( ivp2_sf, "vp2_sf", & - "vp2 budget: vp2 surface variance [m^2/s^3]", "m^2/s^3", zm ) - k = k + 1 - - case ('wpthlp_entermfl') - iwpthlp_entermfl = k - call stat_assign( iwpthlp_entermfl, "wpthlp_entermfl", & - "Wpthlp entering flux limiter [(m K)/s]", "(m K)/s", zm ) - k = k + 1 - - case ('wpthlp_exit_mfl') - iwpthlp_exit_mfl = k - call stat_assign( iwpthlp_exit_mfl, "wpthlp_exit_mfl", & - "Wpthlp exiting flux limiter [](m K)/s", "(m K)/s", zm ) - k = k + 1 - - case ('wpthlp_mfl_min') - iwpthlp_mfl_min = k - call stat_assign( iwpthlp_mfl_min, "wpthlp_mfl_min", & - "Minimum allowable wpthlp [(m K)/s]", "(m K)/s", zm ) - k = k + 1 - - case ('wpthlp_mfl_max') - iwpthlp_mfl_max = k - call stat_assign( iwpthlp_mfl_max, "wpthlp_mfl_max", & - "Maximum allowable wpthlp ((m K)/s) [(m K)/s]", "(m K)/s", zm ) - k = k + 1 - - case ('wprtp_mfl_min') - iwprtp_mfl_min = k - call stat_assign( iwprtp_mfl_min, "wprtp_mfl_min", & - "Minimum allowable wprtp [(m kg)/(s kg)]", "(m kg)/(s kg)", zm ) - k = k + 1 - - case ('wprtp_mfl_max') - iwprtp_mfl_max = k - call stat_assign( iwprtp_mfl_max, "wprtp_mfl_max", & - "Maximum allowable wprtp [(m kg)/(s kg)]", "(m kg)/(s kg)", zm ) - k = k + 1 - - case ('wprtp_enter_mfl') - iwprtp_enter_mfl = k - call stat_assign( iwprtp_enter_mfl, "wprtp_enter_mfl", & - "Wprtp entering flux limiter [(m kg)/(s kg)]", "(m kg)/(s kg)", zm ) - k = k + 1 - - case ('wprtp_exit_mfl') - iwprtp_exit_mfl = k - call stat_assign( iwprtp_exit_mfl, "wprtp_exit_mfl", & - "Wprtp exiting flux limiter [(m kg)/(s kg)]", "(m kg)/(s kg)", zm ) - k = k + 1 - - case ('wm_zm') - iwm_zm = k - call stat_assign( iwm_zm, "wm_zm", & - "Vertical (w) wind [m/s]", "m/s", zm ) - k = k + 1 - - case ('cloud_frac_zm') - icloud_frac_zm = k - call stat_assign( icloud_frac_zm, "cloud_frac_zm", & - "Cloud fraction", "count", zm ) - k = k + 1 - - case ('ice_supersat_frac_zm') - iice_supersat_frac_zm = k - call stat_assign( iice_supersat_frac_zm, "ice_supersat_frac_zm", & - "Ice cloud fraction", "count", zm ) - k = k + 1 - - case ('rcm_zm') - ircm_zm = k - call stat_assign( ircm_zm, "rcm_zm", & - "Total water mixing ratio [kg/kg]", "kg/kg", zm ) - k = k + 1 - - case ('rtm_zm') - irtm_zm = k - call stat_assign( irtm_zm, "rtm_zm", & - "Total water mixing ratio [kg/kg]", "kg/kg", zm ) - k = k + 1 - - case ('thlm_zm') - ithlm_zm = k - call stat_assign( ithlm_zm, "thlm_zm", & - "Liquid potential temperature [K]", "K", zm ) - k = k + 1 - - case ( 'Skw_velocity' ) - iSkw_velocity = k - call stat_assign( iSkw_velocity, "Skw_velocity", & - "Skewness velocity [m/s]", "m/s", zm ) - k = k + 1 - - case ( 'gamma_Skw_fnc' ) - igamma_Skw_fnc = k - call stat_assign( igamma_Skw_fnc, "gamma_Skw_fnc", & - "Gamma as a function of skewness [-]", "count", zm ) - k = k + 1 - - case ( 'C6rt_Skw_fnc' ) - iC6rt_Skw_fnc = k - call stat_assign( iC6rt_Skw_fnc, "C6rt_Skw_fnc", & - "C_6rt parameter with Sk_w applied [-]", "count", zm ) - k = k + 1 - - case ( 'C6thl_Skw_fnc' ) - iC6thl_Skw_fnc = k - call stat_assign( iC6thl_Skw_fnc, "C6thl_Skw_fnc", & - "C_6thl parameter with Sk_w applied [-]", "count", zm ) - k = k + 1 - - case ( 'C7_Skw_fnc' ) - iC7_Skw_fnc = k - call stat_assign( iC7_Skw_fnc, "C7_Skw_fnc", & - "C_7 parameter with Sk_w applied [-]", "count", zm ) - k = k + 1 - - case ( 'C1_Skw_fnc' ) - iC1_Skw_fnc = k - call stat_assign( iC1_Skw_fnc, "C1_Skw_fnc", & - "C_1 parameter with Sk_w applied [-]", "count", zm ) - k = k + 1 - - case ( 'a3_coef' ) - ia3_coef = k - call stat_assign( ia3_coef, "a3_coef", & - "Quantity in formula 25 from Equations for CLUBB [-]", "count", zm ) - k = k + 1 - - case ( 'wp3_on_wp2' ) - iwp3_on_wp2 = k - call stat_assign( iwp3_on_wp2, "wp3_on_wp2", & - "Smoothed version of wp3 / wp2 [m/s]", "m/s", zm ) - k = k + 1 - - case default - l_found = .false. - - j = 1 - - do while( j <= sclr_dim .and. .not. l_found ) - write( sclr_idx, * ) j - sclr_idx = adjustl(sclr_idx) - - if( trim(vars_zm(i)) == 'sclr'//trim(sclr_idx)//'prtp'.and. .not. l_found ) then - isclrprtp(j) = k - - call stat_assign(isclrprtp(j),"sclr"//trim(sclr_idx)//"prtp", & - "scalar("//trim(sclr_idx)//")'rt'","unknown",zm) - k = k + 1 - l_found = .true. - end if - if( trim(vars_zm(i)) == 'sclr'//trim(sclr_idx)//'p2'.and. .not. l_found ) then - isclrp2(j) = k - call stat_assign(isclrp2(j) ,"sclr"//trim(sclr_idx)//"p2", & - "scalar("//trim(sclr_idx)//")'^2'","unknown",zm) - k = k + 1 - l_found = .true. - end if - if( trim(vars_zm(i)) == 'sclr'//trim(sclr_idx)//'pthvp'.and. .not. l_found ) then - isclrpthvp(j) = k - call stat_assign(isclrpthvp(j),"sclr"//trim(sclr_idx)//"pthvp", & - "scalar("//trim(sclr_idx)//")'th_v'","unknown",zm) - k = k + 1 - l_found = .true. - end if - if( trim(vars_zm(i)) == 'sclr'//trim(sclr_idx)//'pthlp'.and. .not. l_found ) then - isclrpthlp(j) = k - - call stat_assign(isclrpthlp(j),"sclr"//trim(sclr_idx)//"pthlp", & - "scalar("//trim(sclr_idx)//")'th_l'","unknown",zm) - k = k + 1 - l_found = .true. - end if - if( trim(vars_zm(i)) == 'sclr'//trim(sclr_idx)//'prcp'.and. .not. l_found ) then - - isclrprcp(j) = k - - call stat_assign(isclrprcp(j),"sclr"//trim(sclr_idx)//"prcp", & - "scalar("//trim(sclr_idx)//")'rc'","unknown",zm) - k = k + 1 - l_found = .true. - end if - if( trim(vars_zm(i)) == 'wpsclr'//trim(sclr_idx)//'p'.and. .not. l_found ) then - iwpsclrp(j) = k - - call stat_assign(iwpsclrp(j),"wpsclr"//trim(sclr_idx)//"p", & - "'w'scalar("//trim(sclr_idx)//")","unknown",zm) - k = k + 1 - l_found = .true. - end if - if( trim(vars_zm(i)) == 'wpsclr'//trim(sclr_idx)//'p2'.and. .not. l_found ) then - - iwpsclrp2(j) = k - - call stat_assign(iwpsclrp2(j),"wpsclr"//trim(sclr_idx)//"p2", & - "'w'scalar("//trim(sclr_idx)//")'^2'","unknown",zm) - k = k + 1 - l_found = .true. - end if - if( trim(vars_zm(i)) == 'wp2sclr'//trim(sclr_idx)//'p'.and. .not. l_found ) then - - iwp2sclrp(j) = k - - call stat_assign(iwp2sclrp(j) ,"wp2sclr"//trim(sclr_idx)//"p", & - "'w'^2 scalar("//trim(sclr_idx)//")","unknown",zm) - k = k + 1 - l_found = .true. - end if - if( trim(vars_zm(i)) == 'wpsclr'//trim(sclr_idx)//'prtp'.and. .not. l_found ) then - iwpsclrprtp(j) = k - - call stat_assign( iwpsclrprtp(j),"wpsclr"//trim(sclr_idx)//"prtp", & - "'w' scalar("//trim(sclr_idx)//")'rt'","unknown",zm ) - k = k + 1 - l_found = .true. - end if - if( trim(vars_zm(i)) == 'wpsclr'//trim(sclr_idx)//'pthlp'.and. .not. l_found ) then - iwpsclrpthlp(j) = k - - call stat_assign(iwpsclrpthlp(j),"wpsclr"//trim(sclr_idx)//"pthlp", & - "'w' scalar("//trim(sclr_idx)//")'th_l'","unknown",zm) - k = k + 1 - l_found = .true. - end if - j = j + 1 - end do - - j = 1 - - do while( j <= edsclr_dim .and. .not. l_found ) - - write( sclr_idx, * ) j - sclr_idx = adjustl(sclr_idx) - - if( trim(vars_zm(i)) == 'wpedsclr'//trim(sclr_idx)//'p'.and. .not. l_found ) then - iwpedsclrp(j) = k - - call stat_assign(iwpedsclrp(j),"wpedsclr"//trim(sclr_idx)//"p", & - "eddy scalar("//trim(sclr_idx)//")'w'","unknown",zm) - k = k + 1 - l_found = .true. - end if - - j = j + 1 - - end do - - if( .not. l_found ) then - write(fstderr,*) 'Error: unrecognized variable in vars_zm: ', trim(vars_zm(i)) - l_error = .true. ! This will stop the run. - end if - end select - - end do - -! Non-interative diagnostics (zm) -! iwp4, ircp2 - -! if ( .not. clubb_at_least_debug_level( 1 ) ) then -! if ( iwp4 + ircp2 + ishear > 0 ) then -! write(fstderr,'(a)') & -! "Warning: at debug level 0. Non-interactive diagnostics will not be computed, " -! write(fstderr,'(a)') "but some appear in the stats_zm namelist variable." -! end if -! end if - - return - end subroutine stats_init_zm - -end module crmx_stats_zm diff --git a/src/physics/spcam/crm/CLUBB/crmx_stats_zt.F90 b/src/physics/spcam/crm/CLUBB/crmx_stats_zt.F90 deleted file mode 100644 index ea9ee63fea..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_stats_zt.F90 +++ /dev/null @@ -1,3221 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: stats_zt.F90 6153 2013-04-09 22:13:27Z bmg2@uwm.edu $ - -module crmx_stats_zt - - implicit none - - private ! Default Scope - - public :: stats_init_zt - -! Constant parameters - integer, parameter, public :: nvarmax_zt = 350 ! Maximum variables allowed - - contains - -!----------------------------------------------------------------------- - subroutine stats_init_zt( vars_zt, l_error ) - -! Description: -! Initializes array indices for zt - -! Note: -! All code that is within subroutine stats_init_zt, including variable -! allocation code, is not called if l_stats is false. This subroutine is -! called only when l_stats is true. - -!----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Constant(s) - - use crmx_stats_variables, only: & - ithlm, & ! Variable(s) - iT_in_K, & - ithvm, & - irtm, & - ircm, & - irfrzm, & - irvm, & - ium, & - ivm, & - iwm_zt, & - ium_ref, & - ivm_ref, & - iug, & - ivg, & - icloud_frac, & - iice_supersat_frac, & - ircm_in_layer, & - ircm_in_cloud, & - icloud_cover, & - ip_in_Pa, & - iexner, & - irho_ds_zt, & - ithv_ds_zt, & - iLscale - - use crmx_stats_variables, only: & - iwp3, & ! Variable(s) - iwpthlp2, & - iwp2thlp, & - iwprtp2, & - iwp2rtp, & - iLscale_up, & - iLscale_down, & - itau_zt, & - iKh_zt, & - iwp2thvp, & - iwp2rcp, & - iwprtpthlp, & - isigma_sqd_w_zt - - use crmx_stats_variables, only: & - irr1, & ! Variable(s) - irr2, & - iNr1, & - iNr2, & - iLWP1, & - iLWP2, & - iprecip_frac, & - iprecip_frac_1, & - iprecip_frac_2 - - use crmx_stats_variables, only: & - imu_rr_1, & ! Variable(s) - imu_rr_2, & - imu_Nr_1, & - imu_Nr_2, & - imu_Nc_1, & - imu_Nc_2, & - imu_rr_1_n, & - imu_rr_2_n, & - imu_Nr_1_n, & - imu_Nr_2_n, & - imu_Nc_1_n, & - imu_Nc_2_n, & - isigma_rr_1, & - isigma_rr_2, & - isigma_Nr_1, & - isigma_Nr_2, & - isigma_Nc_1, & - isigma_Nc_2, & - isigma_rr_1_n, & - isigma_rr_2_n, & - isigma_Nr_1_n, & - isigma_Nr_2_n, & - isigma_Nc_1_n, & - isigma_Nc_2_n - - use crmx_stats_variables, only: & - icorr_srr_1, & ! Variable(s) - icorr_srr_2, & - icorr_sNr_1, & - icorr_sNr_2, & - icorr_sNc_1, & - icorr_sNc_2, & - icorr_trr_1, & - icorr_trr_2, & - icorr_tNr_1, & - icorr_tNr_2, & - icorr_tNc_1, & - icorr_tNc_2, & - icorr_rrNr_1, & - icorr_rrNr_2, & - icorr_srr_1_n, & - icorr_srr_2_n, & - icorr_sNr_1_n, & - icorr_sNr_2_n, & - icorr_sNc_1_n, & - icorr_sNc_2_n, & - icorr_trr_1_n, & - icorr_trr_2_n, & - icorr_tNr_1_n, & - icorr_tNr_2_n, & - icorr_tNc_1_n, & - icorr_tNc_2_n, & - icorr_rrNr_1_n, & - icorr_rrNr_2_n - - use crmx_stats_variables, only: & ! janhft 09/25/12 - icorr_sw, & ! Variable(s) - icorr_wrr, & - icorr_wNr, & - icorr_wNc - - use crmx_stats_variables, only: & - irel_humidity, & - irho, & - iNcm, & - iNcm_in_cloud, & - iNc_activated, & - iNcnm, & - isnowslope, & - ised_rcm, & - irsat, & - irsati, & - irrainm, & - iNrm, & - irain_rate_zt, & - iradht, & - iradht_LW, & - iradht_SW, & - idiam, & - imass_ice_cryst, & - ircm_icedfs, & - iu_T_cm, & - im_vol_rad_rain, & - im_vol_rad_cloud, & - irsnowm, & - irgraupelm, & - iricem - - use crmx_stats_variables, only: & - ieff_rad_cloud, & - ieff_rad_ice, & - ieff_rad_snow, & - ieff_rad_rain, & - ieff_rad_graupel - - use crmx_stats_variables, only: & - irtm_bt, & - irtm_ma, & - irtm_ta, & - irtm_forcing, & - irtm_mc, & - irtm_sdmp, & - ircm_mc, & - ircm_sd_mg_morr, & - irvm_mc, & - irtm_mfl, & - irtm_tacl, & - irtm_cl, & - irtm_pd, & - ithlm_bt, & - ithlm_ma, & - ithlm_ta, & - ithlm_forcing, & - ithlm_mc, & - ithlm_sdmp - - use crmx_stats_variables, only: & - ithlm_mfl, & - ithlm_tacl, & - ithlm_cl, & - iwp3_bt, & - iwp3_ma, & - iwp3_ta, & - iwp3_tp, & - iwp3_ac, & - iwp3_bp1, & - iwp3_bp2, & - iwp3_pr1, & - iwp3_pr2, & - iwp3_dp1, & - iwp3_4hd, & - iwp3_cl - - ! Monotonic flux limiter diagnostic variables - use crmx_stats_variables, only: & - ithlm_mfl_min, & - ithlm_mfl_max, & - irtm_mfl_min, & - irtm_mfl_max, & - ithlm_enter_mfl, & - ithlm_exit_mfl, & - ithlm_old, & - ithlm_without_ta, & - irtm_enter_mfl, & - irtm_exit_mfl, & - irtm_old, & - irtm_without_ta - - use crmx_stats_variables, only: & - irrainm_bt, & - irrainm_ma, & - irrainm_sd, & - irrainm_ts, & - irrainm_sd_morr, & - irrainm_dff, & - irrainm_cond, & - irrainm_auto, & - irrainm_accr, & - irrainm_cond_adj, & - irrainm_src_adj, & - irrainm_tsfl, & - irrainm_mc, & - irrainm_hf - - use crmx_stats_variables, only: & - irrainm_wvhf, & - irrainm_cl, & - iNrm_bt, & - iNrm_ma, & - iNrm_sd, & - iNrm_ts, & - iNrm_dff, & - iNrm_cond, & - iNrm_auto, & - iNrm_cond_adj, & - iNrm_src_adj, & - iNrm_tsfl, & - iNrm_mc, & - iNrm_cl - - use crmx_stats_variables, only: & - irsnowm_bt, & - irsnowm_ma, & - irsnowm_sd, & - irsnowm_sd_morr, & - irsnowm_dff, & - irsnowm_mc, & - irsnowm_hf, & - irsnowm_wvhf, & - irsnowm_cl, & - irgraupelm_bt, & - irgraupelm_ma, & - irgraupelm_sd, & - irgraupelm_sd_morr, & - irgraupelm_dff, & - irgraupelm_mc - - use crmx_stats_variables, only: & - irgraupelm_hf, & - irgraupelm_wvhf, & - irgraupelm_cl, & - iricem_bt, & - iricem_ma, & - iricem_sd, & - iricem_sd_mg_morr, & - iricem_dff, & - iricem_mc, & - iricem_hf, & - iricem_wvhf, & - iricem_cl - - use crmx_stats_variables, only: & - ivm_bt, & - ivm_ma, & - ivm_gf, & - ivm_cf, & - ivm_ta, & - ivm_f, & - ivm_sdmp, & - ivm_ndg, & - ium_bt, & - ium_ma, & - ium_gf, & - ium_cf, & - ium_ta, & - ium_f, & - ium_sdmp, & - ium_ndg - - use crmx_stats_variables, only: & - imixt_frac, & ! Variable(s) - iw1, & - iw2, & - ivarnce_w1, & - ivarnce_w2, & - ithl1, & - ithl2, & - ivarnce_thl1, & - ivarnce_thl2, & - irt1, & - irt2, & - ivarnce_rt1, & - ivarnce_rt2, & - irc1, & - irc2, & - irsl1, & - irsl2, & - icloud_frac1, & - icloud_frac2 - - use crmx_stats_variables, only: & - is1, & - is2, & - istdev_s1, & - istdev_s2, & - istdev_t1, & - istdev_t2, & - icovar_st_1, & - icovar_st_2, & - icorr_st_1, & - icorr_st_2, & - irrtthl, & - icrt1, & - icrt2, & - icthl1, & - icthl2 - - - use crmx_stats_variables, only: & - iwp2_zt, & - ithlp2_zt, & - iwpthlp_zt, & - iwprtp_zt, & - irtp2_zt, & - irtpthlp_zt, & - iup2_zt, & - ivp2_zt, & - iupwp_zt, & - ivpwp_zt - - use crmx_stats_variables, only: & - zt, & - isclrm, & - isclrm_f, & - iedsclrm, & - iedsclrm_f - - use crmx_stats_variables, only: & - iNsnowm, & ! Variable(s) - iNrm, & - iNgraupelm, & - iNim, & - iNsnowm_bt, & - iNsnowm_mc, & - iNsnowm_ma, & - iNsnowm_dff, & - iNsnowm_sd, & - iNsnowm_cl, & - iNgraupelm_bt, & - iNgraupelm_mc, & - iNgraupelm_ma, & - iNgraupelm_dff, & - iNgraupelm_sd, & - iNgraupelm_cl, & - iNim_bt, & - iNim_mc, & - iNim_ma, & - iNim_dff, & - iNim_sd, & - iNim_cl - - use crmx_stats_variables, only: & - iNcm_bt, & - iNcm_mc, & - iNcm_ma, & - iNcm_dff, & - iNcm_cl, & - iNcm_act - - use crmx_stats_variables, only: & - iw_KK_evap_covar_zt, & - irt_KK_evap_covar_zt, & - ithl_KK_evap_covar_zt, & - iw_KK_auto_covar_zt, & - irt_KK_auto_covar_zt, & - ithl_KK_auto_covar_zt, & - iw_KK_accr_covar_zt, & - irt_KK_accr_covar_zt, & - ithl_KK_accr_covar_zt, & - irr_KK_mvr_covar_zt, & - iNr_KK_mvr_covar_zt - - use crmx_stats_variables, only: & - ieff_rad_cloud, & - ieff_rad_ice, & - ieff_rad_snow, & - ieff_rad_rain, & - ieff_rad_graupel - - use crmx_stats_variables, only: & - iC11_Skw_fnc, & ! Variable(s) - is_mellor, & - iwp3_on_wp2_zt, & - ia3_coef_zt - - use crmx_stats_variables, only: & - iLscale_pert_1, & ! Variable(s) - iLscale_pert_2 - - use crmx_stats_type, only: & - stat_assign ! Procedure - - use crmx_parameters_model, only: & - sclr_dim,& ! Variable(s) - edsclr_dim - -!use error_code, only: & -! clubb_at_least_debug_level ! Function - - - implicit none - - ! Input Variable - character(len= * ), dimension(nvarmax_zt), intent(in) :: vars_zt - - ! Output Variable - logical, intent(inout) :: l_error - - ! Local Varables - integer :: i, j, k - - logical :: l_found - - character(len=50) :: sclr_idx - -! Default initialization for array indices for zt - - ithlm = 0 - iT_in_K = 0 - ithvm = 0 - irtm = 0 - ircm = 0 - irfrzm = 0 - irvm = 0 - ium = 0 - ivm = 0 - iwm_zt = 0 - ium_ref = 0 - ivm_ref = 0 - iug = 0 - ivg = 0 - icloud_frac = 0 - iice_supersat_frac = 0 - ircm_in_layer = 0 - ircm_in_cloud = 0 - icloud_cover = 0 - ip_in_Pa = 0 - iexner = 0 - irho_ds_zt = 0 - ithv_ds_zt = 0 - iLscale = 0 - iwp3 = 0 - iwpthlp2 = 0 - iwp2thlp = 0 - iwprtp2 = 0 - iwp2rtp = 0 - iLscale_up = 0 - iLscale_down = 0 - itau_zt = 0 - iKh_zt = 0 - iwp2thvp = 0 - iwp2rcp = 0 - iwprtpthlp = 0 - isigma_sqd_w_zt = 0 - irho = 0 - irel_humidity = 0 - iNcm = 0 ! Brian - iNcm_in_cloud = 0 - iNc_activated = 0 - iNcnm = 0 - iNim = 0 - isnowslope = 0 ! Adam Smith, 22 April 2008 - ised_rcm = 0 ! Brian - irsat = 0 ! Brian - irrainm = 0 ! Brian - irain_rate_zt = 0 ! Brian - iradht = 0 - iradht_LW = 0 - iradht_SW = 0 - - ! Number concentrations - iNsnowm = 0 ! Adam Smith, 22 April 2008 - iNrm = 0 ! Brian - iNgraupelm = 0 - iNim = 0 - - idiam = 0 - imass_ice_cryst = 0 - ircm_icedfs = 0 - iu_T_cm = 0 - - irr1 = 0 - irr2 = 0 - iNr1 = 0 - iNr2 = 0 - iLWP1 = 0 - iLWP2 = 0 - iprecip_frac = 0 - iprecip_frac_1 = 0 - iprecip_frac_2 = 0 - - imu_rr_1 = 0 - imu_rr_2 = 0 - imu_Nr_1 = 0 - imu_Nr_2 = 0 - imu_Nc_1 = 0 - imu_Nc_2 = 0 - imu_rr_1_n = 0 - imu_rr_2_n = 0 - imu_Nr_1_n = 0 - imu_Nr_2_n = 0 - imu_Nc_1_n = 0 - imu_Nc_2_n = 0 - isigma_rr_1 = 0 - isigma_rr_2 = 0 - isigma_Nr_1 = 0 - isigma_Nr_2 = 0 - isigma_Nc_1 = 0 - isigma_Nc_2 = 0 - isigma_rr_1_n = 0 - isigma_rr_2_n = 0 - isigma_Nr_1_n = 0 - isigma_Nr_2_n = 0 - isigma_Nc_1_n = 0 - isigma_Nc_2_n = 0 - icorr_srr_1 = 0 - icorr_srr_2 = 0 - icorr_sNr_1 = 0 - icorr_sNr_2 = 0 - icorr_sNc_1 = 0 - icorr_sNc_2 = 0 - icorr_trr_1 = 0 - icorr_trr_2 = 0 - icorr_tNr_1 = 0 - icorr_tNr_2 = 0 - icorr_tNc_1 = 0 - icorr_tNc_2 = 0 - icorr_rrNr_1 = 0 - icorr_rrNr_2 = 0 - icorr_srr_1_n = 0 - icorr_srr_2_n = 0 - icorr_sNr_1_n = 0 - icorr_sNr_2_n = 0 - icorr_sNc_1_n = 0 - icorr_sNc_2_n = 0 - icorr_trr_1_n = 0 - icorr_trr_2_n = 0 - icorr_tNr_1_n = 0 - icorr_tNr_2_n = 0 - icorr_tNc_1_n = 0 - icorr_tNc_2_n = 0 - icorr_rrNr_1_n = 0 - icorr_rrNr_2_n = 0 - - ! Correlations - icorr_sw = 0 - icorr_wrr = 0 - icorr_wNr = 0 - icorr_wNc = 0 - - ! From K&K microphysics - im_vol_rad_rain = 0 ! Brian - im_vol_rad_cloud = 0 - - ! From Morrison microphysics - ieff_rad_cloud = 0 - ieff_rad_ice = 0 - ieff_rad_snow = 0 - ieff_rad_rain = 0 - ieff_rad_graupel = 0 - - irsnowm = 0 - irgraupelm = 0 - iricem = 0 - - irtm_bt = 0 - irtm_ma = 0 - irtm_ta = 0 - irtm_forcing = 0 - irtm_sdmp = 0 - irtm_mc = 0 - ircm_mc = 0 ! For the change due to COAMPS/Morrison microphysics - ircm_sd_mg_morr = 0 - irvm_mc = 0 ! For the change due to COAMPS/Morrison microphysics - irtm_mfl = 0 - irtm_tacl = 0 - irtm_cl = 0 ! Josh - irtm_pd = 0 - ithlm_bt = 0 - ithlm_ma = 0 - ithlm_ta = 0 - ithlm_forcing = 0 - ithlm_mc = 0 - ithlm_sdmp = 0 - ithlm_mfl = 0 - ithlm_tacl = 0 - ithlm_cl = 0 ! Josh - - ithlm_mfl_min = 0 - ithlm_mfl_max = 0 - irtm_mfl_min = 0 - irtm_mfl_max = 0 - ithlm_enter_mfl = 0 - ithlm_exit_mfl = 0 - ithlm_old = 0 - ithlm_without_ta = 0 - irtm_enter_mfl = 0 - irtm_exit_mfl = 0 - irtm_old = 0 - irtm_without_ta = 0 - - iwp3_bt = 0 - iwp3_ma = 0 - iwp3_ta = 0 - iwp3_tp = 0 - iwp3_ac = 0 - iwp3_bp1 = 0 - iwp3_bp2 = 0 - iwp3_pr1 = 0 - iwp3_pr2 = 0 - iwp3_dp1 = 0 - iwp3_4hd = 0 - iwp3_cl = 0 - - irrainm_bt = 0 - irrainm_ma = 0 - irrainm_sd = 0 - irrainm_ts = 0 - irrainm_sd_morr = 0 - irrainm_dff = 0 - irrainm_cond = 0 - irrainm_auto = 0 - irrainm_accr = 0 - irrainm_cond_adj = 0 - irrainm_src_adj = 0 - irrainm_tsfl = 0 - irrainm_mc = 0 - irrainm_hf = 0 - irrainm_wvhf = 0 - irrainm_cl = 0 - - iNrm_bt = 0 - iNrm_ma = 0 - iNrm_sd = 0 - iNrm_ts = 0 - iNrm_dff = 0 - iNrm_cond = 0 - iNrm_auto = 0 - iNrm_cond_adj = 0 - iNrm_src_adj = 0 - iNrm_tsfl = 0 - iNrm_mc = 0 - iNrm_cl = 0 - - iNsnowm_bt = 0 - iNsnowm_ma = 0 - iNsnowm_sd = 0 - iNsnowm_dff = 0 - iNsnowm_mc = 0 - iNsnowm_cl = 0 - - iNim_bt = 0 - iNim_ma = 0 - iNim_sd = 0 - iNim_dff = 0 - iNim_mc = 0 - iNim_cl = 0 - - iNcm_bt = 0 - iNcm_ma = 0 - iNcm_dff = 0 - iNcm_mc = 0 - iNcm_cl = 0 - iNcm_act = 0 - - irsnowm_bt = 0 - irsnowm_ma = 0 - irsnowm_sd = 0 - irsnowm_sd_morr = 0 - irsnowm_dff = 0 - irsnowm_mc = 0 - irsnowm_hf = 0 - irsnowm_wvhf = 0 - irsnowm_cl = 0 - - irgraupelm_bt = 0 - irgraupelm_ma = 0 - irgraupelm_sd = 0 - irgraupelm_sd_morr = 0 - irgraupelm_dff = 0 - irgraupelm_mc = 0 - irgraupelm_hf = 0 - irgraupelm_wvhf = 0 - irgraupelm_cl = 0 - - iricem_bt = 0 - iricem_ma = 0 - iricem_sd = 0 - iricem_sd_mg_morr = 0 - iricem_dff = 0 - iricem_mc = 0 - iricem_hf = 0 - iricem_wvhf = 0 - iricem_cl = 0 - - iw_KK_evap_covar_zt = 0 - irt_KK_evap_covar_zt = 0 - ithl_KK_evap_covar_zt = 0 - iw_KK_auto_covar_zt = 0 - irt_KK_auto_covar_zt = 0 - ithl_KK_auto_covar_zt = 0 - iw_KK_accr_covar_zt = 0 - irt_KK_accr_covar_zt = 0 - ithl_KK_accr_covar_zt = 0 - irr_KK_mvr_covar_zt = 0 - iNr_KK_mvr_covar_zt = 0 - - ivm_bt = 0 - ivm_ma = 0 - ivm_gf = 0 - ivm_cf = 0 - ivm_ta = 0 - ivm_f = 0 - ivm_sdmp = 0 - ivm_ndg = 0 - - ium_bt = 0 - ium_ma = 0 - ium_gf = 0 - ium_cf = 0 - ium_ta = 0 - ium_f = 0 - ium_sdmp = 0 - ium_ndg = 0 - - imixt_frac = 0 - iw1 = 0 - iw2 = 0 - ivarnce_w1 = 0 - ivarnce_w2 = 0 - ithl1 = 0 - ithl2 = 0 - ivarnce_thl1 = 0 - ivarnce_thl2 = 0 - irt1 = 0 - irt2 = 0 - ivarnce_rt1 = 0 - ivarnce_rt2 = 0 - irc1 = 0 - irc2 = 0 - irsl1 = 0 - irsl2 = 0 - icloud_frac1 = 0 - icloud_frac2 = 0 - is1 = 0 - is2 = 0 - istdev_s1 = 0 - istdev_s2 = 0 - istdev_t1 = 0 - istdev_t2 = 0 - icovar_st_1 = 0 - icovar_st_2 = 0 - icorr_st_1 = 0 - icorr_st_2 = 0 - irrtthl = 0 - icrt1 = 0 - icrt2 = 0 - icthl1 = 0 - icthl2 = 0 - - is_mellor = 0 - - iwp2_zt = 0 - ithlp2_zt = 0 - iwpthlp_zt = 0 - iwprtp_zt = 0 - irtp2_zt = 0 - irtpthlp_zt = 0 - iup2_zt = 0 - ivp2_zt = 0 - iupwp_zt = 0 - ivpwp_zt = 0 - - iC11_Skw_fnc = 0 - ia3_coef_zt = 0 - iwp3_on_wp2_zt = 0 - - iLscale_pert_1 = 0 - iLscale_pert_2 = 0 - - allocate( isclrm(1:sclr_dim) ) - allocate( isclrm_f(1:sclr_dim) ) - - isclrm = 0 - isclrm_f = 0 - - allocate( iedsclrm(1:edsclr_dim) ) - allocate( iedsclrm_f(1:edsclr_dim) ) - - iedsclrm = 0 - - iedsclrm_f = 0 - -! Assign pointers for statistics variables zt - - k = 1 - do i=1,zt%nn - - select case ( trim(vars_zt(i)) ) - case ('thlm') - ithlm = k - call stat_assign( ithlm, "thlm", & - "Liquid water potential temperature (theta_l) [K]", "K", zt) - k = k + 1 - - case ('T_in_K') - iT_in_K = k - call stat_assign( iT_in_K, "T_in_K", & - "Absolute temperature [K]", "K", zt ) - k = k + 1 - - case ('thvm') - ithvm = k - call stat_assign( ithvm, "thvm", & - "Virtual potential temperature [K]", "K", zt ) - k = k + 1 - - case ('rtm') - irtm = k - - call stat_assign( irtm, "rtm", & - "Total (vapor+liquid) water mixing ratio [kg/kg]", "kg/kg", zt ) - - !zt%f%var(irtm)%ptr => zt%x(:,k) - !zt%f%var(irtm)%name = "rtm" - !zt%f%var(irtm)%description - != "total water mixing ratio (kg/kg)" - !zt%f%var(irtm)%units = "kg/kg" - - k = k + 1 - - case ('rcm') - ircm = k - call stat_assign( ircm, "rcm", & - "Cloud water mixing ratio [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rfrzm') - irfrzm = k - call stat_assign( irfrzm, "rfrzm", & - "Total ice phase water mixing ratio [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rvm') - irvm = k - call stat_assign( irvm, "rvm", & - "Vapor water mixing ratio [kg/kg]", "kg/kg", zt ) - k = k + 1 - case ('rel_humidity') - irel_humidity = k - call stat_assign( irel_humidity, "rel_humidity", & - "Relative humidity w.r.t. liquid (range [0,1]) [-]", "[-]", zt ) - k = k + 1 - case ('um') - ium = k - call stat_assign( ium, "um", & - "East-west (u) wind [m/s]", "m/s", zt ) - k = k + 1 - case ('vm') - ivm = k - call stat_assign( ivm, "vm", & - "North-south (v) wind [m/s]", "m/s", zt ) - k = k + 1 - case ('wm_zt') - iwm_zt = k - call stat_assign( iwm_zt, "wm", & - "Vertical (w) wind [m/s]", "m/s", zt ) - k = k + 1 - case ('um_ref') - ium_ref = k - call stat_assign( ium_ref, "um_ref", & - "reference u wind (m/s) [m/s]", "m/s", zt) - k = k + 1 - case ('vm_ref') - ivm_ref = k - call stat_assign( ivm_ref, "vm_ref", & - "reference v wind (m/s) [m/s]", "m/s", zt) - k = k + 1 - case ('ug') - iug = k - call stat_assign( iug, "ug", & - "u geostrophic wind [m/s]", "m/s", zt) - k = k + 1 - case ('vg') - ivg = k - call stat_assign( ivg, "vg", & - "v geostrophic wind [m/s]", "m/s", zt ) - k = k + 1 - case ('cloud_frac') - icloud_frac = k - call stat_assign( icloud_frac, "cloud_frac", & - "Cloud fraction (between 0 and 1) [-]", "count", zt ) - k = k + 1 - - case ('ice_supersat_frac') - iice_supersat_frac = k - call stat_assign( iice_supersat_frac, "ice_supersat_frac", & - "Ice cloud fraction (between 0 and 1) [-]", "count", zt ) - k = k + 1 - - case ('rcm_in_layer') - ircm_in_layer = k - call stat_assign( ircm_in_layer, "rcm_in_layer", & - "rcm in cloud layer [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rcm_in_cloud') - ircm_in_cloud = k - call stat_assign( ircm_in_cloud, "rcm_in_cloud", & - "in-cloud value of rcm (for microphysics) [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('cloud_cover') - icloud_cover = k - call stat_assign( icloud_cover, "cloud_cover", & - "Cloud cover (between 0 and 1) [-]", "count", zt ) - k = k + 1 - case ('p_in_Pa') - ip_in_Pa = k - call stat_assign( ip_in_Pa, "p_in_Pa", & - "Pressure [Pa]", "Pa", zt ) - k = k + 1 - case ('exner') - iexner = k - call stat_assign( iexner, "exner", & - "Exner function = (p/p0)**(rd/cp) [-]", "count", zt ) - k = k + 1 - case ('rho_ds_zt') - irho_ds_zt = k - call stat_assign( irho_ds_zt, "rho_ds_zt", & - "Dry, static, base-state density [kg/m^3]", "kg m^{-3}", zt ) - k = k + 1 - case ('thv_ds_zt') - ithv_ds_zt = k - call stat_assign( ithv_ds_zt, "thv_ds_zt", & - "Dry, base-state theta_v [K]", "K", zt ) - k = k + 1 - case ('Lscale') - iLscale = k - call stat_assign( iLscale, "Lscale", & - "Mixing length [m]", "m", zt ) - k = k + 1 - case ('thlm_forcing') - ithlm_forcing = k - call stat_assign( ithlm_forcing, "thlm_forcing", & - "thlm budget: thetal forcing (includes thlm_mc and radht) [K s^{-1}]", "K s^{-1}", zt ) - k = k + 1 - case ('thlm_mc') - ithlm_mc = k - call stat_assign( ithlm_mc, "thlm_mc", & - "Change in thlm due to microphysics (not in budget) [K s^{-1}]", "K s^{-1}", zt ) - k = k + 1 - case ('rtm_forcing') - irtm_forcing = k - call stat_assign( irtm_forcing, "rtm_forcing", & - "rtm budget: rt forcing (includes rtm_mc) [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", & - zt ) - k = k + 1 - - case ('rtm_mc') - irtm_mc = k - call stat_assign( irtm_mc, "rtm_mc", & - "Change in rt due to microphysics (not in budget) [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rvm_mc') - irvm_mc = k - call stat_assign( irvm_mc, "rvm_mc", & - "Time tendency of vapor mixing ratio due to microphysics [kg/kg/s]", "kg/(kg s)", zt ) - k = k + 1 - - case ('rcm_mc') - ircm_mc = k - call stat_assign( ircm_mc, "rcm_mc", & - "Time tendency of liquid water mixing ratio due microphysics [kg/kg/s]", & - "kg/kg/s", zt ) - k = k + 1 - - case ('rcm_sd_mg_morr') - ircm_sd_mg_morr = k - call stat_assign( ircm_sd_mg_morr, "rcm_sd_mg_morr", & - "rcm sedimentation when using morrision or MG microphysics (not in budget," & - // " included in rcm_mc) [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('thlm_mfl_min') - ithlm_mfl_min = k - call stat_assign( ithlm_mfl_min, "thlm_mfl_min", & - "Minimum allowable thlm [K]", "K", zt ) - k = k + 1 - - case ('thlm_mfl_max') - ithlm_mfl_max = k - call stat_assign( ithlm_mfl_max, "thlm_mfl_max", & - "Maximum allowable thlm [K]", "K", zt ) - k = k + 1 - - case ('thlm_enter_mfl') - ithlm_enter_mfl = k - call stat_assign( ithlm_enter_mfl, "thlm_enter_mfl", & - "Thlm before flux-limiter [K]", "K", zt ) - k = k + 1 - - case ('thlm_exit_mfl') - ithlm_exit_mfl = k - call stat_assign( ithlm_exit_mfl, "thlm_exit_mfl", & - "Thlm exiting flux-limiter [K]", "K", zt ) - k = k + 1 - - case ('thlm_old') - ithlm_old = k - call stat_assign( ithlm_old, "thlm_old", & - "Thlm at previous timestep [K]", "K", zt ) - k = k + 1 - - case ('thlm_without_ta') - ithlm_without_ta = k - call stat_assign( ithlm_without_ta, "thlm_without_ta", & - "Thlm without turbulent advection contribution [K]", "K", zt ) - k = k + 1 - - case ('rtm_mfl_min') - irtm_mfl_min = k - call stat_assign( irtm_mfl_min, "rtm_mfl_min", & - "Minimum allowable rtm [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rtm_mfl_max') - irtm_mfl_max = k - call stat_assign( irtm_mfl_max, "rtm_mfl_max", & - "Maximum allowable rtm [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rtm_enter_mfl') - irtm_enter_mfl = k - call stat_assign( irtm_enter_mfl, "rtm_enter_mfl", & - "Rtm before flux-limiter [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rtm_exit_mfl') - irtm_exit_mfl = k - call stat_assign( irtm_exit_mfl, "rtm_exit_mfl", & - "Rtm exiting flux-limiter [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rtm_old') - irtm_old = k - call stat_assign( irtm_old, "rtm_old", & - "Rtm at previous timestep [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rtm_without_ta') - irtm_without_ta = k - call stat_assign( irtm_without_ta, "rtm_without_ta", & - "Rtm without turbulent advection contribution [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('wp3') - iwp3 = k - call stat_assign( iwp3, "wp3", & - "w third order moment [m^3/s^3]", "m^3/s^3", zt ) - k = k + 1 - - case ('wpthlp2') - iwpthlp2 = k - call stat_assign( iwpthlp2, "wpthlp2", & - "w'thl'^2 [(m K^2)/s]", "(m K^2)/s", zt ) - k = k + 1 - - case ('wp2thlp') - iwp2thlp = k - call stat_assign( iwp2thlp, "wp2thlp", & - "w'^2thl' [(m^2 K)/s^2]", "(m^2 K)/s^2", zt ) - k = k + 1 - - case ('wprtp2') - iwprtp2 = k - call stat_assign( iwprtp2, "wprtp2", & - "w'rt'^2 [(m kg)/(s kg)]", "(m kg)/(s kg)", zt ) - k = k + 1 - - case ('wp2rtp') - iwp2rtp = k - call stat_assign( iwp2rtp, "wp2rtp", & - "w'^2rt' [(m^2 kg)/(s^2 kg)]", "(m^2 kg)/(s^2 kg)", zt ) - k = k + 1 - - case ('Lscale_up') - iLscale_up = k - call stat_assign( iLscale_up, "Lscale_up", & - "Upward mixing length [m]", "m", zt ) - k = k + 1 - - case ('Lscale_down') - iLscale_down = k - call stat_assign( iLscale_down, "Lscale_down", & - "Downward mixing length [m]", "m", zt ) - k = k + 1 - - case ('Lscale_pert_1') - iLscale_pert_1 = k - call stat_assign( iLscale_pert_1, "Lscale_pert_1", & - "Mixing length using a perturbed value of rtm/thlm [m]", "m", zt ) - k = k + 1 - - case ('Lscale_pert_2') - iLscale_pert_2 = k - call stat_assign( iLscale_pert_2, "Lscale_pert_2", & - "Mixing length using a perturbed value of rtm/thlm [m]", "m", zt ) - k = k + 1 - - case ('tau_zt') - itau_zt = k - call stat_assign( itau_zt, "tau_zt", & - "Dissipation time [s]", "s", zt ) - k = k + 1 - - case ('Kh_zt') - iKh_zt = k - call stat_assign( iKh_zt, "Kh_zt", & - "Eddy diffusivity [m^2/s]", "m^2/s", zt ) - k = k + 1 - - case ('wp2thvp') - iwp2thvp = k - call stat_assign( iwp2thvp, "wp2thvp", & - "w'^2thv' [K m^2/s^2]", "K m^2/s^2", zt ) - k = k + 1 - - case ('wp2rcp') - iwp2rcp = k - call stat_assign( iwp2rcp, "wp2rcp", & - "w'^2rc' [(m^2 kg)/(s^2 kg)]", "(m^2 kg)/(s^2 kg)", zt ) - k = k + 1 - - case ('wprtpthlp') - iwprtpthlp = k - call stat_assign( iwprtpthlp, "wprtpthlp", & - "w'rt'thl' [(m kg K)/(s kg)]", "(m kg K)/(s kg)", zt ) - k = k + 1 - - case ('sigma_sqd_w_zt') - isigma_sqd_w_zt = k - call stat_assign( isigma_sqd_w_zt, "sigma_sqd_w_zt", & - "Nondimensionalized w variance of Gaussian component [-]", "-", zt ) - k = k + 1 - - case ('rho') - irho = k - call stat_assign( irho, "rho", & - "Air density [kg/m^3]", "kg m^{-3}", zt ) - k = k + 1 - - case ('Ncm') ! Brian - iNcm = k - call stat_assign( iNcm, "Ncm", & - "Cloud droplet number concentration [num/kg]", & - "num/kg", zt ) - k = k + 1 - - case ('Ncm_in_cloud') - iNcm_in_cloud = k - - call stat_assign( iNcm_in_cloud, "Ncm_in_cloud", & - "In cloud droplet concentration [num/kg]", "num/kg", zt ) - - k = k + 1 - - case ('Nc_activated') - iNc_activated = k - - call stat_assign( iNc_activated, "Nc_activated", & - "Droplets activated by GFDL activation [num/kg]", "num/kg", zt ) - - k = k + 1 - - case ('Ncnm') - iNcnm = k - call stat_assign( iNcnm, "Ncnm", & - "Cloud nuclei number concentration [num/kg]", & - "num/kg", zt ) - k = k + 1 - - case ('Nim') ! Brian - iNim = k - call stat_assign( iNim, "Nim", & - "Ice crystal number concentration [num/kg]", & - "num/kg", zt ) - k = k + 1 - - case ('snowslope') ! Adam Smith, 22 April 2008 - isnowslope = k - call stat_assign( isnowslope, "snowslope", & - "COAMPS microphysics snow slope parameter [1/m]", & - "1/m", zt ) - k = k + 1 - - case ('Nsnowm') ! Adam Smith, 22 April 2008 - iNsnowm = k - call stat_assign( iNsnowm, "Nsnowm", & - "Snow particle number concentration [num/kg]", & - "num/kg", zt ) - k = k + 1 - - case ('Ngraupelm') - iNgraupelm = k - call stat_assign( iNgraupelm, "Ngraupelm", & - "Graupel number concentration [num/kg]", & - "num/kg", zt ) - k = k + 1 - - case ('sed_rcm') ! Brian - ised_rcm = k - call stat_assign( ised_rcm, "sed_rcm", & - "d(rcm)/dt due to cloud sedimentation [kg / (m^2 s)]", & - "kg / [m^2 s]", zt ) - k = k + 1 - - case ('rsat') ! Brian - irsat = k - call stat_assign( irsat, "rsat", & - "Saturation mixing ratio over liquid [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rsati') - irsati = k - call stat_assign( irsati, "rsati", & - "Saturation mixing ratio over ice [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rrainm') ! Brian - irrainm = k - call stat_assign( irrainm, "rrainm", & - "Rain water mixing ratio [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rsnowm') - irsnowm = k - call stat_assign( irsnowm, "rsnowm", & - "Snow water mixing ratio [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('ricem') - iricem = k - call stat_assign( iricem, "ricem", & - "Pristine ice water mixing ratio [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rgraupelm') - irgraupelm = k - call stat_assign( irgraupelm, "rgraupelm", & - "Graupel water mixing ratio [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('Nrm') ! Brian - iNrm = k - call stat_assign( iNrm, "Nrm", & - "Rain drop number concentration [num/kg]", & - "num/kg", zt ) - k = k + 1 - - case ('m_vol_rad_rain') ! Brian - im_vol_rad_rain = k - call stat_assign( im_vol_rad_rain, "mvrr", & - "Rain drop mean volume radius [m]", "m", zt ) - k = k + 1 - - case ('m_vol_rad_cloud') - im_vol_rad_cloud = k - call stat_assign( im_vol_rad_cloud, "m_vol_rad_cloud", & - "Cloud drop mean volume radius [m]", "m", zt ) - k = k + 1 - - case ('eff_rad_cloud') - ieff_rad_cloud = k - call stat_assign( ieff_rad_cloud, "eff_rad_cloud", & - "Cloud drop effective volume radius [microns]", "microns", zt ) - k = k + 1 - - case ('eff_rad_ice') - ieff_rad_ice = k - - call stat_assign( ieff_rad_ice, "eff_rad_ice", & - "Ice effective volume radius [microns]", "microns", zt ) - k = k + 1 - - case ('eff_rad_snow') - ieff_rad_snow = k - call stat_assign( ieff_rad_snow, "eff_rad_snow", & - "Snow effective volume radius [microns]", "microns", zt ) - k = k + 1 - - case ('eff_rad_rain') - ieff_rad_rain = k - call stat_assign( ieff_rad_rain, "eff_rad_rain", & - "Rain drop effective volume radius [microns]", "microns", zt ) - k = k + 1 - - case ('eff_rad_graupel') - ieff_rad_graupel = k - call stat_assign( ieff_rad_graupel, "eff_rad_graupel", & - "Graupel effective volume radius [microns]", "microns", zt ) - k = k + 1 - - case ('rain_rate_zt') ! Brian - irain_rate_zt = k - - call stat_assign( irain_rate_zt, "rain_rate_zt", & - "Rain rate [mm/day]", "mm/day", zt ) - k = k + 1 - - case ('radht') - iradht = k - - call stat_assign( iradht, "radht", & - "Total (sw+lw) radiative heating rate [K/s]", "K/s", zt ) - k = k + 1 - - case ('radht_LW') - iradht_LW = k - - call stat_assign( iradht_LW, "radht_LW", & - "Long-wave radiative heating rate [K/s]", "K/s", zt ) - - k = k + 1 - - case ('radht_SW') - iradht_SW = k - call stat_assign( iradht_SW, "radht_SW", & - "Short-wave radiative heating rate [K/s]", "K/s", zt ) - k = k + 1 - - case ('diam') - idiam = k - - call stat_assign( idiam, "diam", & - "Ice crystal diameter [m]", "m", zt ) - k = k + 1 - - case ('mass_ice_cryst') - imass_ice_cryst = k - call stat_assign( imass_ice_cryst, "mass_ice_cryst", & - "Mass of a single ice crystal [kg]", "kg", zt ) - k = k + 1 - - case ('rcm_icedfs') - - ircm_icedfs = k - call stat_assign( ircm_icedfs, "rcm_icedfs", & - "Change in liquid due to ice [kg/kg/s]", "kg/kg/s", zt ) - k = k + 1 - - case ('u_T_cm') - iu_T_cm = k - call stat_assign( iu_T_cm, "u_T_cm", & - "Ice crystal fallspeed [cm s^{-1}]", "cm s^{-1}", zt ) - k = k + 1 - - case ('rtm_bt') - irtm_bt = k - - call stat_assign( irtm_bt, "rtm_bt", & - "rtm budget: rtm time tendency [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt) - k = k + 1 - - case ('rtm_ma') - irtm_ma = k - - call stat_assign( irtm_ma, "rtm_ma", & - "rtm budget: rtm vertical mean advection [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt) - k = k + 1 - - case ('rtm_ta') - irtm_ta = k - - call stat_assign( irtm_ta, "rtm_ta", & - "rtm budget: rtm turbulent advection [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt) - k = k + 1 - - case ('rtm_mfl') - irtm_mfl = k - - call stat_assign( irtm_mfl, "rtm_mfl", & - "rtm budget: rtm correction due to monotonic flux limiter [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt) - k = k + 1 - - case ('rtm_tacl') - irtm_tacl = k - - call stat_assign( irtm_tacl, "rtm_tacl", & - "rtm budget: rtm correction due to ta term (wprtp) clipping [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt) - - k = k + 1 - - case ('rtm_cl') - irtm_cl = k - - call stat_assign( irtm_cl, "rtm_cl", & - "rtm budget: rtm clipping [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt) - - k = k + 1 - case ('rtm_sdmp') - irtm_sdmp = k - - call stat_assign( irtm_sdmp, "rtm_sdmp", & - "rtm budget: rtm correction due to sponge damping [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt) - k = k + 1 - - - case ('rtm_pd') - irtm_pd = k - - call stat_assign( irtm_pd, "rtm_pd", & - "rtm budget: rtm positive definite adjustment [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt) - - k = k + 1 - - case ('thlm_bt') - ithlm_bt = k - - call stat_assign( ithlm_bt, "thlm_bt", & - "thlm budget: thlm time tendency [K s^{-1}]", "K s^{-1}", zt) - k = k + 1 - - case ('thlm_ma') - ithlm_ma = k - - call stat_assign( ithlm_ma, "thlm_ma", & - "thlm budget: thlm vertical mean advection [K s^{-1}]", "K s^{-1}", zt) - k = k + 1 - - case ('thlm_sdmp') - ithlm_sdmp = k - - call stat_assign( ithlm_sdmp, "thlm_sdmp", & - "thlm budget: thlm correction due to sponge damping [K s^{-1}]", "K s^{-1}", zt) - k = k + 1 - - - case ('thlm_ta') - ithlm_ta = k - - call stat_assign( ithlm_ta, "thlm_ta", & - "thlm budget: thlm turbulent advection [K s^{-1}]", "K s^{-1}", zt) - k = k + 1 - - case ('thlm_mfl') - ithlm_mfl = k - - call stat_assign( ithlm_mfl, "thlm_mfl", & - "thlm budget: thlm correction due to monotonic flux limiter [K s^{-1}]", & - "K s^{-1}", zt) - k = k + 1 - - case ('thlm_tacl') - ithlm_tacl = k - - call stat_assign( ithlm_tacl, "thlm_tacl", & - "thlm budget: thlm correction due to ta term (wpthlp) clipping [K s^{-1}]", & - "K s^{-1}", zt) - k = k + 1 - - case ('thlm_cl') - ithlm_cl = k - - call stat_assign( ithlm_cl, "thlm_cl", & - "thlm budget: thlm_cl [K s^{-1}]", "K s^{-1}", zt) - k = k + 1 - - case ('wp3_bt') - iwp3_bt = k - - call stat_assign( iwp3_bt, "wp3_bt", & - "wp3 budget: wp3 time tendency [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) - k = k + 1 - - case ('wp3_ma') - iwp3_ma = k - - call stat_assign( iwp3_ma, "wp3_ma", & - "wp3 budget: wp3 vertical mean advection [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) - k = k + 1 - - case ('wp3_ta') - iwp3_ta = k - - call stat_assign( iwp3_ta, "wp3_ta", & - "wp3 budget: wp3 turbulent advection [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) - - k = k + 1 - - case ('wp3_tp') - iwp3_tp = k - call stat_assign( iwp3_tp, "wp3_tp", & - "wp3 budget: wp3 turbulent transport [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) - k = k + 1 - - case ('wp3_ac') - iwp3_ac = k - call stat_assign( iwp3_ac, "wp3_ac", & - "wp3 budget: wp3 accumulation term [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) - k = k + 1 - - case ('wp3_bp1') - iwp3_bp1 = k - call stat_assign( iwp3_bp1, "wp3_bp1", & - "wp3 budget: wp3 buoyancy production [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) - k = k + 1 - - case ('wp3_bp2') - iwp3_bp2 = k - call stat_assign( iwp3_bp2, "wp3_bp2", & - "wp3 budget: wp3 2nd buoyancy production term [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) - k = k + 1 - - case ('wp3_pr1') - iwp3_pr1 = k - call stat_assign( iwp3_pr1, "wp3_pr1", & - "wp3 budget: wp3 pressure term 1 [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) - k = k + 1 - - case ('wp3_pr2') - iwp3_pr2 = k - call stat_assign( iwp3_pr2, "wp3_pr2", & - "wp3 budget: wp3 pressure term 2 [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) - - k = k + 1 - - case ('wp3_dp1') - iwp3_dp1 = k - call stat_assign( iwp3_dp1, "wp3_dp1", & - "wp3 budget: wp3 dissipation term 1 [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) - k = k + 1 - - case ('wp3_4hd') - iwp3_4hd = k - call stat_assign( iwp3_4hd, "wp3_4hd", & - "wp3 budget: wp3 4th-order hyper-diffusion [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) - k = k + 1 - - case ('wp3_cl') - iwp3_cl = k - call stat_assign( iwp3_cl, "wp3_cl", & - "wp3 budget: wp3 clipping term [m^{3} s^{-4}]", "m^{3} s^{-4}", zt ) - k = k + 1 - - case ('rrainm_bt') - irrainm_bt = k - call stat_assign( irrainm_bt, "rrainm_bt", & - "rrainm budget: rrainm time tendency [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_ma') - irrainm_ma = k - - call stat_assign( irrainm_ma, "rrainm_ma", & - "rrainm budget: rrainm vertical mean advection [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_sd') - irrainm_sd = k - - call stat_assign( irrainm_sd, "rrainm_sd", & - "rrainm budget: rrainm sedimentation [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_ts') - irrainm_ts = k - - call stat_assign( irrainm_ts, "rrainm_ts", & - "rrainm budget: rrainm turbulent sedimentation" & - //" [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_sd_morr') - irrainm_sd_morr = k - - call stat_assign( irrainm_sd_morr, "rrainm_sd_morr", & - "rrainm sedimentation when using morrision microphysics (not in budget, included" & - // " in rrainm_mc) [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_dff') - irrainm_dff = k - - call stat_assign( irrainm_dff, "rrainm_dff", & - "rrainm budget: rrainm diffusion [kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_cond') - irrainm_cond = k - - call stat_assign( irrainm_cond, "rrainm_cond", & - "rrainm evaporation rate [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_auto') - irrainm_auto = k - - call stat_assign( irrainm_auto, "rrainm_auto", & - "rrainm autoconversion rate [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_accr') - irrainm_accr = k - call stat_assign( irrainm_accr, "rrainm_accr", & - "rrainm accretion rate [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_cond_adj') - irrainm_cond_adj = k - - call stat_assign( irrainm_cond_adj, "rrainm_cond_adj", & - "rrainm evaporation adjustment due to over-evaporation " // & - "[kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_src_adj') - irrainm_src_adj = k - - call stat_assign( irrainm_src_adj, "rrainm_src_adj", & - "rrainm source term adjustment due to over-depletion " // & - "[kg kg^{-1} s^{-1}]", "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_tsfl') - irrainm_tsfl = k - - call stat_assign( irrainm_tsfl, "rrainm_tsfl", & - "rrainm budget: rrainm turbulent sedimentation flux limiter" & - //" [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_hf') - irrainm_hf = k - call stat_assign( irrainm_hf, "rrainm_hf", & - "rrainm budget: rrainm hole-filling term [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_wvhf') - irrainm_wvhf = k - call stat_assign( irrainm_wvhf, "rrainm_wvhf", & - "rrainm budget: rrainm water vapor hole-filling term [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_cl') - irrainm_cl = k - call stat_assign( irrainm_cl, "rrainm_cl", & - "rrainm budget: rrainm clipping term [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('rrainm_mc') - irrainm_mc = k - - call stat_assign( irrainm_mc, "rrainm_mc", & - "rrainm budget: Change in rrainm due to microphysics [kg kg^{-1} s^{-1}]", & - "kg kg^{-1} s^{-1}", zt ) - k = k + 1 - - case ('Nrm_bt') - iNrm_bt = k - call stat_assign( iNrm_bt, "Nrm_bt", & - "Nrm budget: Nrm time tendency [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Nrm_ma') - iNrm_ma = k - - call stat_assign( iNrm_ma, "Nrm_ma", & - "Nrm budget: Nrm vertical mean advection [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('Nrm_sd') - iNrm_sd = k - - call stat_assign( iNrm_sd, "Nrm_sd", & - "Nrm budget: Nrm sedimentation [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Nrm_ts') - iNrm_ts = k - - call stat_assign( iNrm_ts, "Nrm_ts", & - "Nrm budget: Nrm turbulent sedimentation [(num/kg)/s]", & - "(num/kg)/s", zt ) - k = k + 1 - - case ('Nrm_dff') - iNrm_dff = k - call stat_assign( iNrm_dff, "Nrm_dff", & - "Nrm budget: Nrm diffusion [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Nrm_cond') - iNrm_cond = k - - call stat_assign( iNrm_cond, "Nrm_cond", & - "Nrm evaporation rate [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('Nrm_auto') - iNrm_auto = k - - call stat_assign( iNrm_auto, "Nrm_auto", & - "Nrm autoconversion rate [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Nrm_cond_adj') - iNrm_cond_adj = k - - call stat_assign( iNrm_cond_adj, "Nrm_cond_adj", & - "Nrm evaporation adjustment due to over-evaporation [(num/kg)/s]", & - "(num/kg)/s", zt ) - k = k + 1 - - case ('Nrm_src_adj') - iNrm_src_adj = k - - call stat_assign( iNrm_src_adj, "Nrm_src_adj", & - "Nrm source term adjustment due to over-depletion [(num/kg)/s]", & - "(num/kg)/s", zt ) - k = k + 1 - - case ('Nrm_tsfl') - iNrm_tsfl = k - - call stat_assign( iNrm_tsfl, "Nrm_tsfl", & - "Nrm budget: Nrm turbulent sedimentation flux limiter" & - //" [(num/kg)/s]", & - "(num/kg)/s", zt ) - k = k + 1 - - case ('Nrm_cl') - iNrm_cl = k - call stat_assign( iNrm_cl, "Nrm_cl", & - "Nrm budget: Nrm clipping term [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('Nrm_mc') - iNrm_mc = k - call stat_assign( iNrm_mc, "Nrm_mc", & - "Nrm budget: Change in Nrm due to microphysics (Not in budget) [(num/kg)/s]", & - "(num/kg)/s", zt ) - k = k + 1 - - case ('rsnowm_bt') - irsnowm_bt = k - call stat_assign( irsnowm_bt, "rsnowm_bt", & - "rsnowm budget: rsnowm time tendency [(kg/kg)/s]", "(kg/kg)/s", zt ) - - k = k + 1 - - case ('rsnowm_ma') - irsnowm_ma = k - - call stat_assign( irsnowm_ma, "rsnowm_ma", & - "rsnowm budget: rsnowm vertical mean advection [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('rsnowm_sd') - irsnowm_sd = k - call stat_assign( irsnowm_sd, "rsnowm_sd", & - "rsnowm budget: rsnowm sedimentation [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('rsnowm_sd_morr') - irsnowm_sd_morr = k - call stat_assign( irsnowm_sd_morr, "rsnowm_sd_morr", & - "rsnowm sedimentation when using morrison microphysics (Not in budget, included in" & - // " rsnowm_mc) [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('rsnowm_dff') - irsnowm_dff = k - - call stat_assign( irsnowm_dff, "rsnowm_dff", & - "rsnowm budget: rsnowm diffusion [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('rsnowm_mc') - irsnowm_mc = k - - call stat_assign( irsnowm_mc, "rsnowm_mc", & - "rsnowm budget: Change in rsnowm due to microphysics [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('rsnowm_hf') - irsnowm_hf = k - - call stat_assign( irsnowm_hf, "rsnowm_hf", & - "rsnowm budget: rsnowm hole-filling term [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('rsnowm_wvhf') - irsnowm_wvhf = k - - call stat_assign( irsnowm_wvhf, "rsnowm_wvhf", & - "rsnowm budget: rsnowm water vapor hole-filling term [(kg/kg)/s]", & - "(kg/kg)/s", zt ) - k = k + 1 - - case ('rsnowm_cl') - irsnowm_cl = k - - call stat_assign( irsnowm_cl, "rsnowm_cl", & - "rsnowm budget: rsnowm clipping term [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('Nsnowm_bt') - iNsnowm_bt = k - call stat_assign( iNsnowm_bt, "Nsnowm_bt", & - "Nsnowm budget: [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Nsnowm_ma') - iNsnowm_ma = k - - call stat_assign( iNsnowm_ma, "Nsnowm_ma", & - "Nsnowm budget: Nsnowm mean advection [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('Nsnowm_sd') - iNsnowm_sd = k - - call stat_assign( iNsnowm_sd, "Nsnowm_sd", & - "Nsnowm budget: Nsnowm sedimentation [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Nsnowm_dff') - iNsnowm_dff = k - call stat_assign( iNsnowm_dff, "Nsnowm_dff", & - "Nsnowm budget: Nsnowm diffusion [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Nsnowm_mc') - iNsnowm_mc = k - call stat_assign( iNsnowm_mc, "Nsnowm_mc", & - "Nsnowm budget: Nsnowm microphysics [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Nsnowm_cl') - iNsnowm_cl = k - - call stat_assign( iNsnowm_cl, "Nsnowm_cl", & - "Nsnowm budget: Nsnowm clipping term [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('ricem_bt') - iricem_bt = k - - call stat_assign( iricem_bt, "ricem_bt", & - "ricem budget: ricem time tendency [(kg/kg)/s]", "(kg/kg)/s", zt ) - - k = k + 1 - - case ('ricem_ma') - iricem_ma = k - - call stat_assign( iricem_ma, "ricem_ma", & - "ricem budget: ricem vertical mean advection [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('ricem_sd') - iricem_sd = k - - call stat_assign( iricem_sd, "ricem_sd", & - "ricem budget: ricem sedimentation [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('ricem_sd_mg_morr') - iricem_sd_mg_morr = k - - call stat_assign( iricem_sd_mg_morr, "ricem_sd_mg_morr", & - "ricem sedimentation when using morrison or MG microphysics (not in budget," & - // " included in ricem_mc) [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('ricem_dff') - iricem_dff = k - - call stat_assign( iricem_dff, "ricem_dff", & - "ricem budget: ricem diffusion [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('ricem_mc') - iricem_mc = k - - call stat_assign( iricem_mc, "ricem_mc", & - "ricem budget: Change in ricem due to microphysics [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('ricem_hf') - iricem_hf = k - - call stat_assign( iricem_hf, "ricem_hf", & - "ricem budget: ricem hole-filling term [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('ricem_wvhf') - iricem_wvhf = k - - call stat_assign( iricem_wvhf, "ricem_wvhf", & - "ricem budget: ricem water vapor hole-filling term [(kg/kg)/s]", & - "(kg/kg)/s", zt ) - k = k + 1 - - case ('ricem_cl') - iricem_cl = k - - call stat_assign( iricem_cl, "ricem_cl", & - "ricem budget: ricem clipping term [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('rgraupelm_bt') - irgraupelm_bt = k - - call stat_assign( irgraupelm_bt, "rgraupelm_bt", & - "rgraupelm budget: rgraupelm time tendency [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('rgraupelm_ma') - irgraupelm_ma = k - - call stat_assign( irgraupelm_ma, "rgraupelm_ma", & - "rgraupelm budget: rgraupelm vertical mean advection [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('rgraupelm_sd') - irgraupelm_sd = k - - call stat_assign( irgraupelm_sd, "rgraupelm_sd", & - "rgraupelm budget: rgraupelm sedimentation [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('rgraupelm_sd_morr') - irgraupelm_sd_morr = k - - call stat_assign( irgraupelm_sd_morr, "rgraupelm_sd_morr", & - "rgraupelm sedimentation when using morrison microphysics (not in budget, included" & - // " in rgraupelm_mc) [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('rgraupelm_dff') - irgraupelm_dff = k - - call stat_assign( irgraupelm_dff, "rgraupelm_dff", & - "rgraupelm budget: rgraupelm diffusion [(kg/kg)/s]", "(kg/kg)/s", zt ) - k = k + 1 - - case ('rgraupelm_mc') - irgraupelm_mc = k - - call stat_assign( irgraupelm_mc, "rgraupelm_mc", & - "rgraupelm budget: Change in rgraupelm due to microphysics [(kg/kg)/s]", & - "(kg/kg)/s", zt ) - k = k + 1 - - case ('rgraupelm_hf') - irgraupelm_hf = k - - call stat_assign( irgraupelm_hf, "rgraupelm_hf", & - "rgraupelm budget: rgraupelm hole-filling term [(kg/kg)/s]", & - "(kg/kg)/s", zt ) - k = k + 1 - - case ('rgraupelm_wvhf') - irgraupelm_wvhf = k - - call stat_assign( irgraupelm_wvhf, "rgraupelm_wvhf", & - "rgraupelm budget: rgraupelm water vapor hole-filling term [(kg/kg)/s]", & - "(kg/kg)/s", zt ) - k = k + 1 - - case ('rgraupelm_cl') - irgraupelm_cl = k - - call stat_assign( irgraupelm_cl, "rgraupelm_cl", & - "rgraupelm budget: rgraupelm clipping term [(kg/kg)/s]", & - "(kg/kg)/s", zt ) - k = k + 1 - - case ('Ngraupelm_bt') - iNgraupelm_bt = k - call stat_assign( iNgraupelm_bt, "Ngraupelm_bt", & - "Ngraupelm budget: [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Ngraupelm_ma') - iNgraupelm_ma = k - - call stat_assign( iNgraupelm_ma, "Ngraupelm_ma", & - "Ngraupelm budget: Ngraupelm mean advection [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('Ngraupelm_sd') - iNgraupelm_sd = k - - call stat_assign( iNgraupelm_sd, "Ngraupelm_sd", & - "Ngraupelm budget: Ngraupelm sedimentation [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Ngraupelm_dff') - iNgraupelm_dff = k - call stat_assign( iNgraupelm_dff, "Ngraupelm_dff", & - "Ngraupelm budget: Ngraupelm diffusion [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Ngraupelm_mc') - iNgraupelm_mc = k - - call stat_assign( iNgraupelm_mc, "Ngraupelm_mc", & - "Ngraupelm budget: Ngraupelm microphysics term [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('Ngraupelm_cl') - iNgraupelm_cl = k - - call stat_assign( iNgraupelm_cl, "Ngraupelm_cl", & - "Ngraupelm budget: Ngraupelm clipping term [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('Nim_bt') - iNim_bt = k - call stat_assign( iNim_bt, "Nim_bt", & - "Nim budget: [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Nim_ma') - iNim_ma = k - - call stat_assign( iNim_ma, "Nim_ma", & - "Nim budget: Nim mean advection [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('Nim_sd') - iNim_sd = k - - call stat_assign( iNim_sd, "Nim_sd", & - "Nim budget: Nim sedimentation [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Nim_dff') - iNim_dff = k - call stat_assign( iNim_dff, "Nim_dff", & - "Nim budget: Nim diffusion [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Nim_mc') - iNim_mc = k - - call stat_assign( iNim_mc, "Nim_mc", & - "Nim budget: Nim microphysics term [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('Nim_cl') - iNim_cl = k - - call stat_assign( iNim_cl, "Nim_cl", & - "Nim budget: Nim clipping term [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('Ncm_bt') - iNcm_bt = k - call stat_assign( iNcm_bt, "Ncm_bt", & - "Ncm budget: Cloud droplet number concentration budget [(num/kg)/s]", & - "(num/kg)/s", zt ) - - k = k + 1 - - case ('Ncm_ma') - iNcm_ma = k - - call stat_assign( iNcm_ma, "Ncm_ma", & - "Ncm budget: Ncm vertical mean advection [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('Ncm_act') - iNcm_act = k - - call stat_assign( iNcm_act, "Ncm_act", & - "Ncm budget: Change in Ncm due to activation [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Ncm_dff') - iNcm_dff = k - call stat_assign( iNcm_dff, "Ncm_dff", & - "Ncm budget: Ncm diffusion [(num/kg)/s]", "(num/kg)/s", zt ) - - k = k + 1 - - case ('Ncm_mc') - iNcm_mc = k - - call stat_assign( iNcm_mc, "Ncm_mc", & - "Ncm budget: Change in Ncm due to microphysics [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('Ncm_cl') - iNcm_cl = k - - call stat_assign( iNcm_cl, "Ncm_cl", & - "Ncm budget: Ncm clipping term [(num/kg)/s]", "(num/kg)/s", zt ) - k = k + 1 - - case ('w_KK_evap_covar_zt') - iw_KK_evap_covar_zt = k - - call stat_assign( iw_KK_evap_covar_zt, "w_KK_evap_covar_zt", & - "Covariance of w and KK evaporation rate", "m*(kg/kg)/s^2", zt ) - k = k + 1 - - case ('rt_KK_evap_covar_zt') - irt_KK_evap_covar_zt = k - - call stat_assign( irt_KK_evap_covar_zt, "rt_KK_evap_covar_zt", & - "Covariance of r_t and KK evaporation rate", "(kg/kg)^2/s", zt ) - k = k + 1 - - case ('thl_KK_evap_covar_zt') - ithl_KK_evap_covar_zt = k - - call stat_assign( ithl_KK_evap_covar_zt, "thl_KK_evap_covar_zt", & - "Covariance of theta_l and KK evaporation rate", "K*(kg/kg)/s", zt ) - k = k + 1 - - case ('w_KK_auto_covar_zt') - iw_KK_auto_covar_zt = k - - call stat_assign( iw_KK_auto_covar_zt, "w_KK_auto_covar_zt", & - "Covariance of w and KK autoconversion rate", "m*(kg/kg)/s^2", zt ) - k = k + 1 - - case ('rt_KK_auto_covar_zt') - irt_KK_auto_covar_zt = k - - call stat_assign( irt_KK_auto_covar_zt, "rt_KK_auto_covar_zt", & - "Covariance of r_t and KK autoconversion rate", "(kg/kg)^2/s", zt ) - k = k + 1 - - case ('thl_KK_auto_covar_zt') - ithl_KK_auto_covar_zt = k - - call stat_assign( ithl_KK_auto_covar_zt, "thl_KK_auto_covar_zt", & - "Covariance of theta_l and KK autoconversion rate", "K*(kg/kg)/s", & - zt ) - k = k + 1 - - case ('w_KK_accr_covar_zt') - iw_KK_accr_covar_zt = k - - call stat_assign( iw_KK_accr_covar_zt, "w_KK_accr_covar_zt", & - "Covariance of w and KK accretion rate", "m*(kg/kg)/s^2", zt ) - k = k + 1 - - case ('rt_KK_accr_covar_zt') - irt_KK_accr_covar_zt = k - - call stat_assign( irt_KK_accr_covar_zt, "rt_KK_accr_covar_zt", & - "Covariance of r_t and KK accretion rate", "(kg/kg)^2/s", zt ) - k = k + 1 - - case ('thl_KK_accr_covar_zt') - ithl_KK_accr_covar_zt = k - - call stat_assign( ithl_KK_accr_covar_zt, "thl_KK_accr_covar_zt", & - "Covariance of theta_l and KK accretion rate", "K*(kg/kg)/s", zt ) - k = k + 1 - - case ('rr_KK_mvr_covar_zt') - irr_KK_mvr_covar_zt = k - - call stat_assign( irr_KK_mvr_covar_zt, "rr_KK_mvr_covar_zt", & - "Covariance of r_r and KK rain drop mean volume radius [(kg/kg)m]", & - "(kg/kg)m", zt ) - k = k + 1 - - case ('Nr_KK_mvr_covar_zt') - iNr_KK_mvr_covar_zt = k - - call stat_assign( iNr_KK_mvr_covar_zt, "Nr_KK_mvr_covar_zt", & - "Covariance of N_r and KK rain drop mean volume radius [(num/kg)m]", & - "(num/kg)m", zt ) - k = k + 1 - - case ('vm_bt') - ivm_bt = k - - call stat_assign( ivm_bt, "vm_bt", & - "vm budget: vm time tendency [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('vm_ma') - ivm_ma = k - call stat_assign( ivm_ma, "vm_ma", & - "vm budget: vm vertical mean advection [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('vm_gf') - ivm_gf = k - - call stat_assign( ivm_gf, "vm_gf", & - "vm budget: vm geostrophic forcing [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('vm_cf') - ivm_cf = k - - call stat_assign( ivm_cf, "vm_cf", & - "vm budget: vm coriolis forcing [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('vm_ta') - ivm_ta = k - - call stat_assign( ivm_ta, "vm_ta", & - "vm budget: vm turbulent transport [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('vm_f') - ivm_f = k - call stat_assign( ivm_f, "vm_f", & - "vm budget: vm forcing [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('vm_sdmp') - ivm_sdmp = k - call stat_assign( ivm_sdmp, "vm_sdmp", & - "vm budget: vm sponge damping [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('vm_ndg') - ivm_ndg = k - call stat_assign( ivm_ndg, "vm_ndg", & - "vm budget: vm nudging [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('um_bt') - ium_bt = k - - call stat_assign( ium_bt, "um_bt", & - "um budget: um time tendency [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('um_ma') - ium_ma = k - - call stat_assign( ium_ma, "um_ma", & - "um budget: um vertical mean advection [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('um_gf') - ium_gf = k - call stat_assign( ium_gf, "um_gf", & - "um budget: um geostrophic forcing [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('um_cf') - ium_cf = k - call stat_assign( ium_cf, "um_cf", & - "um budget: um coriolis forcing [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('um_ta') - ium_ta = k - call stat_assign( ium_ta, "um_ta", & - "um budget: um turbulent advection [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('um_f') - ium_f = k - call stat_assign( ium_f, "um_f", & - "um budget: um forcing [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('um_sdmp') - ium_sdmp = k - call stat_assign( ium_sdmp, "um_sdmp", & - "um budget: um sponge damping [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('um_ndg') - ium_ndg = k - call stat_assign( ium_ndg, "um_ndg", & - "um budget: um nudging [m s^{-2}]", "m s^{-2}", zt ) - k = k + 1 - - case ('mixt_frac') - imixt_frac = k - call stat_assign( imixt_frac, "mixt_frac", & - "pdf parameter: mixture fraction [count]", "count", zt ) - k = k + 1 - - case ('w1') - iw1 = k - call stat_assign( iw1, "w1", & - "pdf parameter: mean w of component 1 [m/s]", "m/s", zt ) - - k = k + 1 - - case ('w2') - iw2 = k - - call stat_assign( iw2, "w2", & - "pdf paramete: mean w of component 2 [m/s]", "m/s", zt ) - k = k + 1 - - case ('varnce_w1') - ivarnce_w1 = k - call stat_assign( ivarnce_w1, "varnce_w1", & - "pdf parameter: w variance of component 1 [m^2/s^2]", "m^2/s^2", zt ) - - k = k + 1 - - case ('varnce_w2') - ivarnce_w2 = k - - call stat_assign( ivarnce_w2, "varnce_w2", & - "pdf parameter: w variance of component 2 [m^2/s^2]", "m^2/s^2", zt ) - k = k + 1 - - case ('thl1') - ithl1 = k - - call stat_assign( ithl1, "thl1", & - "pdf parameter: mean thl of component 1 [K]", "K", zt ) - - k = k + 1 - - case ('thl2') - ithl2 = k - - call stat_assign( ithl2, "thl2", & - "pdf parameter: mean thl of component 2 [K]", "K", zt ) - k = k + 1 - - case ('varnce_thl1') - ivarnce_thl1 = k - - call stat_assign( ivarnce_thl1, "varnce_thl1", & - "pdf parameter: thl variance of component 1 [K^2]", "K^2", zt ) - - k = k + 1 - - case ('varnce_thl2') - ivarnce_thl2 = k - call stat_assign( ivarnce_thl2, "varnce_thl2", & - "pdf parameter: thl variance of component 2 [K^2]", "K^2", zt ) - - k = k + 1 - - case ('rt1') - irt1 = k - call stat_assign( irt1, "rt1", & - "pdf parameter: mean rt of component 1 [kg/kg]", "kg/kg", zt ) - - k = k + 1 - - case ('rt2') - irt2 = k - - call stat_assign( irt2, "rt2", & - "pdf parameter: mean rt of component 2 [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('varnce_rt1') - ivarnce_rt1 = k - call stat_assign( ivarnce_rt1, "varnce_rt1", & - "pdf parameter: rt variance of component 1 [(kg^2)/(kg^2)]", "(kg^2)/(kg^2)", zt ) - k = k + 1 - - case ('varnce_rt2') - ivarnce_rt2 = k - - call stat_assign( ivarnce_rt2, "varnce_rt2", & - "pdf parameter: rt variance of component 2 [(kg^2)/(kg^2)]", "(kg^2)/(kg^2)", zt ) - k = k + 1 - - case ('rc1') - irc1 = k - - call stat_assign( irc1, "rc1", & - "pdf parameter: mean rc of component 1 [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rc2') - irc2 = k - - call stat_assign( irc2, "rc2", & - "pdf parameter: mean rc of component 2 [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rsl1') - irsl1 = k - - call stat_assign( irsl1, "rsl1", & - "pdf parameter: sat mix rat based on tl1 [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('rsl2') - irsl2 = k - - call stat_assign( irsl2, "rsl2", & - "pdf parameter: sat mix rat based on tl2 [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('cloud_frac1') - icloud_frac1 = k - call stat_assign( icloud_frac1, "cloud_frac1", & - "pdf parameter cloud_frac1 [count]", "count", zt ) - k = k + 1 - - case ('cloud_frac2') - icloud_frac2 = k - - call stat_assign( icloud_frac2, "cloud_frac2", & - "pdf parameter cloud_frac2 [count]", "count", zt ) - k = k + 1 - - case ('s1') - is1 = k - - call stat_assign( is1, "s1", & - "pdf parameter: Mellor's s (extended liq) for component 1 [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('s2') - is2 = k - - call stat_assign( is2, "s2", & - "pdf parameter: Mellor's s (extended liq) for component 2 [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('stdev_s1') - istdev_s1 = k - - call stat_assign( istdev_s1, "stdev_s1", & - "pdf parameter: Std dev of s1 [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('stdev_s2') - istdev_s2 = k - - call stat_assign( istdev_s2, "stdev_s2", & - "pdf parameter: Std dev of s2 [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('stdev_t1') - istdev_t1 = k - - call stat_assign( istdev_t1, "stdev_t1", & - "Standard dev. of t (1st PDF component) [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('stdev_t2') - istdev_t2 = k - - call stat_assign( istdev_t2, "stdev_t2", & - "Standard dev. of t (2nd PDF component) [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ('covar_st_1') - icovar_st_1 = k - - call stat_assign( icovar_st_1, "covar_st_1", & - "Covariance of s and t (1st PDF component) [kg^2/kg^2]", "kg^2/kg^2", zt ) - k = k + 1 - - case ('covar_st_2') - icovar_st_2 = k - - call stat_assign( icovar_st_2, "covar_st_2", & - "Covariance of s and t (2nd PDF component) [kg^2/kg^2]", "kg^2/kg^2", zt ) - k = k + 1 - - case ('corr_st_1') - icorr_st_1 = k - - call stat_assign( icorr_st_1, "corr_st_1", & - "Correlation btw. s and t (1st PDF component) [-]", "-", zt ) - k = k + 1 - - case ('corr_st_2') - icorr_st_2 = k - - call stat_assign( icorr_st_2, "corr_st_2", & - "Correlation btw. s and t (2nd PDF component) [-]", "-", zt ) - k = k + 1 - - case ('rrtthl') - irrtthl = k - - call stat_assign( irrtthl, "rrtthl", & - "Correlation btw. rt and thl (both components) [-]", "-", zt ) - k = k + 1 - - case ('crt1') - icrt1 = k - - call stat_assign( icrt1, "crt1", & - " Coef. on r_t in s/t eqns. (1st PDF comp.) [-]", "count", zt ) - k = k + 1 - - case ('crt2') - icrt2 = k - - call stat_assign( icrt2, "crt2", & - " Coef. on r_t in s/t eqns. (2nd PDF comp.) [-]", "count", zt ) - k = k + 1 - - case ('cthl1') - icthl1 = k - - call stat_assign( icthl1, "cthl1", & - " Coef. on theta_l in s/t eqns. (1st PDF comp.) [kg/kg/K]", "kg/kg/K", zt ) - k = k + 1 - - case ('cthl2') - icthl2 = k - - call stat_assign( icthl2, "cthl2", & - " Coef. on theta_l in s/t eqns. (2nd PDF comp.) [kg/kg/K]", "kg/kg/K", zt ) - k = k + 1 - - - case('wp2_zt') - iwp2_zt = k - - call stat_assign( iwp2_zt, "wp2_zt", & - "w'^2 interpolated to thermodyamic levels [m^2/s^2]", "m^2/s^2", zt ) - k = k + 1 - - case('thlp2_zt') - ithlp2_zt = k - - call stat_assign( ithlp2_zt, "thlp2_zt", & - "thl'^2 interpolated to thermodynamic levels [K^2]", "K^2", zt ) - k = k + 1 - - case('wpthlp_zt') - iwpthlp_zt = k - - call stat_assign( iwpthlp_zt, "wpthlp_zt", & - "w'thl' interpolated to thermodynamic levels [(m K)/s]", "(m K)/s", zt ) - k = k + 1 - - case('wprtp_zt') - iwprtp_zt = k - - call stat_assign( iwprtp_zt, "wprtp_zt", & - "w'rt' interpolated to thermodynamic levels [(m kg)/(s kg)]", "(m kg)/(s kg)", zt ) - k = k + 1 - - case('rtp2_zt') - irtp2_zt = k - - call stat_assign( irtp2_zt, "rtp2_zt", & - "rt'^2 interpolated to thermodynamic levels [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case('rtpthlp_zt') - irtpthlp_zt = k - - call stat_assign( irtpthlp_zt, "rtpthlp_zt", & - "rt'thl' interpolated to thermodynamic levels [(kg K)/kg]", "(kg K)/kg", zt ) - k = k + 1 - - case ('up2_zt') - iup2_zt = k - call stat_assign( iup2_zt, "up2_zt", & - "u'^2 interpolated to thermodynamic levels [m^2/s^2]", "m^2/s^2", zt ) - k = k + 1 - - case ('vp2_zt') - ivp2_zt = k - call stat_assign( ivp2_zt, "vp2_zt", & - "v'^2 interpolated to thermodynamic levels [m^2/s^2]", "m^2/s^2", zt ) - k = k + 1 - - case ('upwp_zt') - iupwp_zt = k - call stat_assign( iupwp_zt, "upwp_zt", & - "u'w' interpolated to thermodynamic levels [m^2/s^2]", "m^2/s^2", zt ) - k = k + 1 - - case ('vpwp_zt') - ivpwp_zt = k - call stat_assign( ivpwp_zt, "vpwp_zt", & - "v'w' interpolated to thermodynamic levels [m^2/s^2]", "m^2/s^2", zt ) - k = k + 1 - - case ('C11_Skw_fnc') - iC11_Skw_fnc = k - - call stat_assign( iC11_Skw_fnc, "C11_Skw_fnc", & - "C_11 parameter with Sk_w applied [-]", "count", zt ) - k = k + 1 - - case ('s_mellor') - is_mellor = k - - call stat_assign( is_mellor, "s_mellor", & - "Mellor's s (extended liq) [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ( 'a3_coef_zt' ) - ia3_coef_zt = k - call stat_assign( ia3_coef_zt, "a3_coef_zt", & - "The a3 coefficient interpolated the the zt grid [-]", "count", zt ) - k = k + 1 - - case ( 'wp3_on_wp2_zt' ) - iwp3_on_wp2_zt = k - call stat_assign( iwp3_on_wp2_zt, "wp3_on_wp2_zt", & - "Smoothed version of wp3 / wp2 [m/s]", "m/s", zt ) - k = k + 1 - - case ( 'rr1' ) - irr1 = k - call stat_assign( irr1, "rr1", & - "Mean of r_r (1st PDF component) [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ( 'rr2' ) - irr2 = k - call stat_assign( irr2, "rr2", & - "Mean of r_r (2nd PDF component) [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ( 'Nr1' ) - iNr1 = k - call stat_assign( iNr1, "Nr1", & - "Mean of N_r (1st PDF component) [num/kg]", "num/kg", zt ) - k = k + 1 - - case ( 'Nr2' ) - iNr2 = k - call stat_assign( iNr2, "Nr2", & - "Mean of N_r (2nd PDF component) [num/kg]", "num/kg", zt ) - k = k + 1 - - case ( 'LWP1' ) - iLWP1 = k - call stat_assign( iLWP1, "LWP1", & - "Liquid water path (1st PDF component) [kg/m^2]", "kg/m^2", zt ) - k = k + 1 - - case ( 'LWP2' ) - iLWP2 = k - call stat_assign( iLWP2, "LWP2", & - "Liquid water path (2nd PDF component) [kg/m^2]", "kg/m^2", zt ) - k = k + 1 - - case ( 'precip_frac' ) - iprecip_frac = k - call stat_assign( iprecip_frac, "precip_frac", & - "Precipitation Fraction [-]", "-", zt ) - k = k + 1 - - case ( 'precip_frac_1' ) - iprecip_frac_1 = k - call stat_assign( iprecip_frac_1, "precip_frac_1", & - "Precipitation Fraction (1st PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'precip_frac_2' ) - iprecip_frac_2 = k - call stat_assign( iprecip_frac_2, "precip_frac_2", & - "Precipitation Fraction (2nd PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'mu_rr_1' ) - imu_rr_1 = k - call stat_assign( imu_rr_1, "mu_rr_1", & - "Mean (in-precip) of r_r (1st PDF component) [kg/kg]", & - "kg/kg", zt ) - k = k + 1 - - case ( 'mu_rr_2' ) - imu_rr_2 = k - call stat_assign( imu_rr_2, "mu_rr_2", & - "Mean (in-precip) of r_r (2nd PDF component) [kg/kg]", & - "kg/kg", zt ) - k = k + 1 - - case ( 'mu_Nr_1' ) - imu_Nr_1 = k - call stat_assign( imu_Nr_1, "mu_Nr_1", & - "Mean (in-precip) of N_r (1st PDF component) [num/kg]", & - "num/kg", zt ) - k = k + 1 - - case ( 'mu_Nr_2' ) - imu_Nr_2 = k - call stat_assign( imu_Nr_2, "mu_Nr_2", & - "Mean (in-precip) of N_r (2nd PDF component) [num/kg]", & - "num/kg", zt ) - k = k + 1 - - case ( 'mu_Nc_1' ) - imu_Nc_1 = k - call stat_assign( imu_Nc_1, "mu_Nc_1", & - "Mean of N_c (1st PDF component) [num/kg]", "num/kg", zt ) - k = k + 1 - - case ( 'mu_Nc_2' ) - imu_Nc_2 = k - call stat_assign( imu_Nc_2, "mu_Nc_2", & - "Mean of N_c (2nd PDF component) [num/kg]", "num/kg", zt ) - k = k + 1 - - case ( 'mu_rr_1_n' ) - imu_rr_1_n = k - call stat_assign( imu_rr_1_n, "mu_rr_1_n", & - "Mean (in-precip) of ln r_r (1st PDF component) [ln(kg/kg)]", & - "ln(kg/kg)", zt ) - k = k + 1 - - case ( 'mu_rr_2_n' ) - imu_rr_2_n = k - call stat_assign( imu_rr_2_n, "mu_rr_2_n", & - "Mean (in-precip) of ln r_r (2nd PDF component) [ln(kg/kg)]", & - "ln(kg/kg)", zt ) - k = k + 1 - - case ( 'mu_Nr_1_n' ) - imu_Nr_1_n = k - call stat_assign( imu_Nr_1_n, "mu_Nr_1_n", & - "Mean (in-precip) of ln N_r (1st PDF component) [ln(num/kg)]", & - "ln(num/kg)", zt ) - k = k + 1 - - case ( 'mu_Nr_2_n' ) - imu_Nr_2_n = k - call stat_assign( imu_Nr_2_n, "mu_Nr_2_n", & - "Mean (in-precip) of ln N_r (2nd PDF component) [ln(num/kg)]", & - "ln(num/kg)", zt ) - k = k + 1 - - case ( 'mu_Nc_1_n' ) - imu_Nc_1_n = k - call stat_assign( imu_Nc_1_n, "mu_Nc_1_n", & - "Mean of ln N_c (1st PDF component) [ln(num/kg)]", & - "ln(num/kg)", zt ) - k = k + 1 - - case ( 'mu_Nc_2_n' ) - imu_Nc_2_n = k - call stat_assign( imu_Nc_2_n, "mu_Nc_2_n", & - "Mean of ln N_c (2nd PDF component) [ln(num/kg)]", & - "ln(num/kg)", zt ) - k = k + 1 - - case ( 'sigma_rr_1' ) - isigma_rr_1 = k - call stat_assign( isigma_rr_1, "sigma_rr_1", & - "Standard deviation (in-precip) of r_r (1st PDF component)" & - //" [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ( 'sigma_rr_2' ) - isigma_rr_2 = k - call stat_assign( isigma_rr_2, "sigma_rr_2", & - "Standard deviation (in-precip) of r_r (2nd PDF component)" & - //" [kg/kg]", "kg/kg", zt ) - k = k + 1 - - case ( 'sigma_Nr_1' ) - isigma_Nr_1 = k - call stat_assign( isigma_Nr_1, "sigma_Nr_1", & - "Standard deviation (in-precip) of N_r (1st PDF component)" & - //" [num/kg]", "num/kg", zt ) - k = k + 1 - - case ( 'sigma_Nr_2' ) - isigma_Nr_2 = k - call stat_assign( isigma_Nr_2, "sigma_Nr_2", & - "Standard deviation (in-precip) of N_r (2nd PDF component)" & - //" [num/kg]", "num/kg", zt ) - k = k + 1 - - case ( 'sigma_Nc_1' ) - isigma_Nc_1 = k - call stat_assign( isigma_Nc_1, "sigma_Nc_1", & - "Standard deviation of N_c (1st PDF component) [num/kg]", & - "num/kg", zt ) - k = k + 1 - - case ( 'sigma_Nc_2' ) - isigma_Nc_2 = k - call stat_assign( isigma_Nc_2, "sigma_Nc_2", & - "Standard deviation of N_c (2nd PDF component) [num/kg]", & - "num/kg", zt ) - k = k + 1 - - case ( 'sigma_rr_1_n' ) - isigma_rr_1_n = k - call stat_assign( isigma_rr_1_n, "sigma_rr_1_n", & - "Standard deviation (in-precip) of ln r_r (1st PDF component)" & - //" [ln(kg/kg)]", "ln(kg/kg)", zt ) - k = k + 1 - - case ( 'sigma_rr_2_n' ) - isigma_rr_2_n = k - call stat_assign( isigma_rr_2_n, "sigma_rr_2_n", & - "Standard deviation (in-precip) of ln r_r (2nd PDF component)" & - //" [ln(kg/kg)]", "ln(kg/kg)", zt ) - k = k + 1 - - case ( 'sigma_Nr_1_n' ) - isigma_Nr_1_n = k - call stat_assign( isigma_Nr_1_n, "sigma_Nr_1_n", & - "Standard deviation (in-precip) of ln N_r (1st PDF component)" & - //" [ln(num/kg)]", "ln(num/kg)", zt ) - k = k + 1 - - case ( 'sigma_Nr_2_n' ) - isigma_Nr_2_n = k - call stat_assign( isigma_Nr_2_n, "sigma_Nr_2_n", & - "Standard deviation (in-precip) of ln N_r (2nd PDF component)" & - //" [ln(num/kg)]", "ln(num/kg)", zt ) - k = k + 1 - - case ( 'sigma_Nc_1_n' ) - isigma_Nc_1_n = k - call stat_assign( isigma_Nc_1_n, "sigma_Nc_1_n", & - "Standard deviation of ln N_c (1st PDF component) [ln(num/kg)]", & - "ln(num/kg)", zt ) - k = k + 1 - - case ( 'sigma_Nc_2_n' ) - isigma_Nc_2_n = k - call stat_assign( isigma_Nc_2_n, "sigma_Nc_2_n", & - "Standard deviation of ln N_c (2nd PDF component) [ln(num/kg)]", & - "ln(num/kg)", zt ) - k = k + 1 - - case ( 'corr_srr_1' ) - icorr_srr_1 = k - call stat_assign( icorr_srr_1, "corr_srr_1", & - "Correlation (in-precip) between s and r_r (1st PDF component)" & - //" [-]", "-", zt ) - k = k + 1 - - case ( 'corr_srr_2' ) - icorr_srr_2 = k - call stat_assign( icorr_srr_2, "corr_srr_2", & - "Correlation (in-precip) between s and r_r (2nd PDF component)" & - //" [-]", "-", zt ) - k = k + 1 - - case ( 'corr_sNr_1' ) - icorr_sNr_1 = k - call stat_assign( icorr_sNr_1, "corr_sNr_1", & - "Correlation (in-precip) between s and N_r (1st PDF component)" & - //" [-]", "-", zt ) - k = k + 1 - - case ( 'corr_sNr_2' ) - icorr_sNr_2 = k - call stat_assign( icorr_sNr_2, "corr_sNr_2", & - "Correlation (in-precip) between s and N_r (2nd PDF component)" & - //" [-]", "-", zt ) - k = k + 1 - - case ( 'corr_sNc_1' ) - icorr_sNc_1 = k - call stat_assign( icorr_sNc_1, "corr_sNc_1", & - "Correlation between s and N_c (1st PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'corr_sNc_2' ) - icorr_sNc_2 = k - call stat_assign( icorr_sNc_2, "corr_sNc_2", & - "Correlation between s and N_c (2nd PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'corr_trr_1' ) - icorr_trr_1 = k - call stat_assign( icorr_trr_1, "corr_trr_1", & - "Correlation (in-precip) between t and r_r (1st PDF component)" & - //" [-]", "-", zt ) - k = k + 1 - - case ( 'corr_trr_2' ) - icorr_trr_2 = k - call stat_assign( icorr_trr_2, "corr_trr_2", & - "Correlation (in-precip) between t and r_r (2nd PDF component)" & - //" [-]", "-", zt ) - k = k + 1 - - case ( 'corr_tNr_1' ) - icorr_tNr_1 = k - call stat_assign( icorr_tNr_1, "corr_tNr_1", & - "Correlation (in-precip) between t and N_r (1st PDF component)" & - //" [-]", "-", zt ) - k = k + 1 - - case ( 'corr_tNr_2' ) - icorr_tNr_2 = k - call stat_assign( icorr_tNr_2, "corr_tNr_2", & - "Correlation (in-precip) between t and N_r (2nd PDF component)" & - //" [-]", "-", zt ) - k = k + 1 - - case ( 'corr_tNc_1' ) - icorr_tNc_1 = k - call stat_assign( icorr_tNc_1, "corr_tNc_1", & - "Correlation between t and N_c (1st PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'corr_tNc_2' ) - icorr_tNc_2 = k - call stat_assign( icorr_tNc_2, "corr_tNc_2", & - "Correlation between t and N_c (2nd PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'corr_rrNr_1' ) - icorr_rrNr_1 = k - call stat_assign( icorr_rrNr_1, "corr_rrNr_1", & - "Correlation (in-precip) between r_r and N_r (1st PDF component)" & - //" [-]", "-", zt ) - k = k + 1 - - case ( 'corr_rrNr_2' ) - icorr_rrNr_2 = k - call stat_assign( icorr_rrNr_2, "corr_rrNr_2", & - "Correlation (in-precip) between r_r and N_r (2nd PDF component)" & - //" [-]", "-", zt ) - k = k + 1 - - case ( 'corr_srr_1_n' ) - icorr_srr_1_n = k - call stat_assign( icorr_srr_1_n, "corr_srr_1_n", & - "Correlation (in-precip) between s and ln r_r" & - //" (1st PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'corr_srr_2_n' ) - icorr_srr_2_n = k - call stat_assign( icorr_srr_2_n, "corr_srr_2_n", & - "Correlation (in-precip) between s and ln r_r" & - //" (2nd PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'corr_sNr_1_n' ) - icorr_sNr_1_n = k - call stat_assign( icorr_sNr_1_n, "corr_sNr_1_n", & - "Correlation (in-precip) between s and ln N_r" & - //" (1st PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'corr_sNr_2_n' ) - icorr_sNr_2_n = k - call stat_assign( icorr_sNr_2_n, "corr_sNr_2_n", & - "Correlation (in-precip) between s and ln N_r" & - //" (2nd PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'corr_sNc_1_n' ) - icorr_sNc_1_n = k - call stat_assign( icorr_sNc_1_n, "corr_sNc_1_n", & - "Correlation between s and ln N_c (1st PDF component) [-]", & - "-", zt ) - k = k + 1 - - case ( 'corr_sNc_2_n' ) - icorr_sNc_2_n = k - call stat_assign( icorr_sNc_2_n, "corr_sNc_2_n", & - "Correlation between s and ln N_c (2nd PDF component) [-]", & - "-", zt ) - k = k + 1 - - case ( 'corr_trr_1_n' ) - icorr_trr_1_n = k - call stat_assign( icorr_trr_1_n, "corr_trr_1_n", & - "Correlation (in-precip) between t and ln r_r" & - //" (1st PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'corr_trr_2_n' ) - icorr_trr_2_n = k - call stat_assign( icorr_trr_2_n, "corr_trr_2_n", & - "Correlation (in-precip) between t and ln r_r" & - //" (2nd PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'corr_tNr_1_n' ) - icorr_tNr_1_n = k - call stat_assign( icorr_tNr_1_n, "corr_tNr_1_n", & - "Correlation (in-precip) between t and ln N_r" & - //" (1st PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'corr_tNr_2_n' ) - icorr_tNr_2_n = k - call stat_assign( icorr_tNr_2_n, "corr_tNr_2_n", & - "Correlation (in-precip) between t and ln N_r" & - //" (2nd PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'corr_tNc_1_n' ) - icorr_tNc_1_n = k - call stat_assign( icorr_tNc_1_n, "corr_tNc_1_n", & - "Correlation between t and ln N_c (1st PDF component) [-]", & - "-", zt ) - k = k + 1 - - case ( 'corr_tNc_2_n' ) - icorr_tNc_2_n = k - call stat_assign( icorr_tNc_2_n, "corr_tNc_2_n", & - "Correlation between t and ln N_c (2nd PDF component) [-]", & - "-", zt ) - k = k + 1 - - case ( 'corr_rrNr_1_n' ) - icorr_rrNr_1_n = k - call stat_assign( icorr_rrNr_1_n, "corr_rrNr_1_n", & - "Correlation (in-precip) between ln r_r and ln N_r" & - //" (1st PDF component) [-]", "-", zt ) - k = k + 1 - - case ( 'corr_rrNr_2_n' ) - icorr_rrNr_2_n = k - call stat_assign( icorr_rrNr_2_n, "corr_rrNr_2_n", & - "Correlation (in-precip) between ln r_r and ln N_r" & - //" (2nd PDF component) [-]", "-", zt ) - k = k + 1 - - - ! changes by janhft 09/25/12 - case ('corr_sw') - icorr_sw = k - call stat_assign( icorr_sw, "corr_sw", & - "Correlation between s and w [-]", "-", zt ) - k = k + 1 - - case ('corr_wrr') - icorr_wrr = k - call stat_assign( icorr_wrr, "corr_wrr", & - "Correlation between w and rrain [-]", "-", zt ) - k = k + 1 - - case ('corr_wNr') - icorr_wNr = k - call stat_assign( icorr_wNr, "corr_wNr", & - "Correlation between w and Nr [-]", "-", zt ) - k = k + 1 - - case ('corr_wNc') - icorr_wNc = k - call stat_assign( icorr_wNc, "corr_wNc", & - "Correlation between w and Nc [-]", "-", zt ) - k = k + 1 - ! end changes by janhft 09/25/12 - - case default - - l_found =.false. - - j=1 - - do while( j <= sclr_dim .and. .not. l_found) - write(sclr_idx, * ) j - - sclr_idx = adjustl(sclr_idx) - - if(trim(vars_zt(i)) == "sclr"//trim(sclr_idx)//"m" .and. .not. l_found) then - - isclrm(j) = k - - call stat_assign( isclrm(j) , "sclr"//trim(sclr_idx)//"m",& - "passive scalar "//trim(sclr_idx), "unknown", zt ) - - k = k + 1 - - l_found = .true. - - else if(trim(vars_zt(i)) == "sclr"//trim(sclr_idx)//"m_f" .and. .not. l_found) then - - isclrm_f(j) = k - - call stat_assign( isclrm_f(j) , "sclr"//trim(sclr_idx)//"m_f", & - "passive scalar forcing "//trim(sclr_idx), "unknown", zt ) - - k = k + 1 - - l_found = .true. - - endif - - j = j + 1 - end do - - j = 1 - - do while( j <= edsclr_dim .and. .not. l_found) - - write(sclr_idx, * ) j - - sclr_idx = adjustl(sclr_idx) - - if(trim(vars_zt(i)) == "edsclr"//trim(sclr_idx)//"m" .and. .not. l_found ) then - - iedsclrm(j) = k - - call stat_assign( iedsclrm(j) , "edsclr"//trim(sclr_idx)//"m", & - "passive scalar "//trim(sclr_idx), "unknown", zt ) - - k = k + 1 - - l_found = .true. - - else if(trim(vars_zt(i)) == "edsclr"//trim(sclr_idx)//"m_f" .and. .not. l_found) then - - iedsclrm_f(j) = k - - call stat_assign( iedsclrm_f(j) , "edsclr"//trim(sclr_idx)//"m_f", & - "passive scalar forcing "//trim(sclr_idx), "unknown", zt ) - - k = k + 1 - - l_found = .true. - - endif - - j = j + 1 - - end do - - if (.not. l_found ) then - - write(fstderr,*) 'Error: unrecognized variable in vars_zt: ', trim( vars_zt(i) ) - - l_error = .true. ! This will stop the run. - - end if - - end select - - end do - - return - end subroutine stats_init_zt - -end module crmx_stats_zt diff --git a/src/physics/spcam/crm/CLUBB/crmx_surface_varnce_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_surface_varnce_module.F90 deleted file mode 100644 index 3ca35d19be..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_surface_varnce_module.F90 +++ /dev/null @@ -1,409 +0,0 @@ -! $Id: surface_varnce_module.F90 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -!=============================================================================== -module crmx_surface_varnce_module - - implicit none - - private ! Default to private - - public :: surface_varnce - - contains - -!============================================================================= - subroutine surface_varnce( upwp_sfc, vpwp_sfc, wpthlp_sfc, wprtp_sfc, & - um_sfc, vm_sfc, wpsclrp_sfc, & - wp2_sfc, up2_sfc, vp2_sfc, & - thlp2_sfc, rtp2_sfc, rtpthlp_sfc, err_code, & - sclrp2_sfc, & - sclrprtp_sfc, & - sclrpthlp_sfc ) - -! Description: -! This subroutine computes estimate of the surface thermodynamic -! second order moments. - -! References: -! None -!------------------------------------------------------------------------------- - - use crmx_parameters_model, only: & - T0 ! Variable(s) - - use crmx_constants_clubb, only: & - grav, & ! Variable(s) - eps, & - fstderr - - use crmx_parameters_model, only: & - sclr_dim ! Variable(s) - - use crmx_numerical_check, only: & - surface_varnce_check ! Procedure - - use crmx_error_code, only: & - clubb_var_equals_NaN, & ! Variable(s) - clubb_at_least_debug_level, & - clubb_no_error ! Constant - - use crmx_array_index, only: & - iisclr_rt, & ! Index for a scalar emulating rt - iisclr_thl ! Index for a scalar emulating thetal - - use crmx_stats_type, only: & - stat_end_update_pt, & ! Procedure(s) - stat_update_var_pt - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! External - intrinsic :: sqrt, max - - ! Constant Parameters - - ! Logical for Andre et al., 1978 parameterization. - logical, parameter :: l_andre_1978 = .false. - - real( kind = core_rknd ), parameter :: & - a_const = 1.8_core_rknd, & - z_const = 1.0_core_rknd, & - ! Vince Larson increased ufmin to stabilize arm_97. 24 Jul 2007 -! ufmin = 0.0001_core_rknd, & - ufmin = 0.01_core_rknd, & - ! End Vince Larson's change. - ! Vince Larson changed in order to make correlations between [-1,1]. 31 Jan 2008. -! sclr_var_coef = 0.25_core_rknd, & ! This value is made up! - Vince Larson 12 Jul 2005 - sclr_var_coef = 0.4_core_rknd, & ! This value is made up! - Vince Larson 12 Jul 2005 - ! End Vince Larson's change - ! Vince Larson reduced surface spike in scalar variances associated - ! w/ Andre et al. 1978 scheme - reduce_coef = 0.2_core_rknd - - ! Input Variables - real( kind = core_rknd ), intent(in) :: & - upwp_sfc, & ! Surface u momentum flux [m^2/s^2] - vpwp_sfc, & ! Surface v momentum flux [m^2/s^2] - wpthlp_sfc, & ! Surface thetal flux [K m/s] - wprtp_sfc, & ! Surface moisture flux [kg/kg m/s] - um_sfc, & ! Surface u wind component [m/s] - vm_sfc ! Surface v wind component [m/s] - - real( kind = core_rknd ), intent(in), dimension(sclr_dim) :: & - wpsclrp_sfc ! Passive scalar flux [units m/s] - - ! Output Variables - real( kind = core_rknd ), intent(out) :: & - wp2_sfc, & ! Vertical velocity variance [m^2/s^2] - up2_sfc, & ! u'^2 [m^2/s^2] - vp2_sfc, & ! v'^2 [m^2/s^2] - thlp2_sfc, & ! thetal variance [K^2] - rtp2_sfc, & ! rt variance [(kg/kg)^2] - rtpthlp_sfc ! thetal rt covariance [kg K/kg] - - integer, intent(out) :: & - err_code - - real( kind = core_rknd ), intent(out), dimension(sclr_dim) :: & - sclrp2_sfc, & ! Passive scalar variance [units^2] - sclrprtp_sfc, & ! Passive scalar r_t covariance [units kg/kg] - sclrpthlp_sfc ! Passive scalar theta_l covariance [units K] - - ! Local Variables - real( kind = core_rknd ) :: ustar2, wstar - real( kind = core_rknd ) :: uf - - ! Variables for Andre et al., 1978 parameterization. - real( kind = core_rknd ) :: & - um_sfc_sqd, & ! Surface value of ^2 [m^2/s^2] - vm_sfc_sqd, & ! Surface value of ^2 [m^2/s^2] - usp2_sfc, & ! u_s (vector oriented w/ mean sfc. wind) variance [m^2/s^2] - vsp2_sfc ! v_s (vector perpen. to mean sfc. wind) variance [m^2/s^2] - - real( kind = core_rknd ) :: ustar - real( kind = core_rknd ) :: Lngth - real( kind = core_rknd ) :: zeta - - integer :: i ! Loop index - - ! ---- Begin Code ---- - - err_code = clubb_no_error - - if ( l_andre_1978 ) then - - ! Calculate ^2 and ^2. - um_sfc_sqd = um_sfc**2 - vm_sfc_sqd = vm_sfc**2 - - ! Calculate surface friction velocity, u*. - ustar = MAX( ( upwp_sfc**2 + vpwp_sfc**2 )**(1.0_core_rknd/4.0_core_rknd), ufmin ) - - ! Find Monin-Obukhov Length (Andre et al., 1978, p. 1866). - Lngth = - ( ustar**3 ) / & - ( 0.35_core_rknd * (1.0_core_rknd/T0) * grav * wpthlp_sfc ) ! Known magic number - - ! Find the value of dimensionless height zeta - ! (Andre et al., 1978, p. 1866). - zeta = z_const / Lngth - - ! Andre et al, 1978, Eq. 29. - ! Notes: 1) "reduce_coef" is a reduction coefficient intended to make - ! the values of rtp2, thlp2, and rtpthlp smaller at the - ! surface. - ! 2) With the reduction coefficient having a value of 0.2, the - ! surface correlations of both w & rt and w & thl have a value - ! of about 0.845. These correlations are greater if zeta < 0. - ! The correlations have a value greater than 1 if - ! zeta <= -0.212. - ! 3) The surface correlation of rt & thl is 1. - ! Brian Griffin; February 2, 2008. - if ( zeta < 0.0_core_rknd ) then - thlp2_sfc = reduce_coef & - * ( wpthlp_sfc**2 / ustar**2 ) & - * 4.0_core_rknd * ( 1.0_core_rknd - 8.3_core_rknd*zeta )**& - (-2.0_core_rknd/3.0_core_rknd) ! Known magic number - rtp2_sfc = reduce_coef & - * ( wprtp_sfc**2 / ustar**2 ) & - * 4.0_core_rknd * ( 1.0_core_rknd - 8.3_core_rknd*zeta )**& - (-2.0_core_rknd/3.0_core_rknd) ! Known magic number - rtpthlp_sfc = reduce_coef & - * ( wprtp_sfc*wpthlp_sfc / ustar**2 ) & - * 4.0_core_rknd * ( 1.0_core_rknd - 8.3_core_rknd*zeta )**& - (-2.0_core_rknd/3.0_core_rknd) ! Known magic number - wp2_sfc = ( ustar**2 ) & - * ( 1.75_core_rknd + 2.0_core_rknd*(-zeta)**& - (2.0_core_rknd/3.0_core_rknd) ) ! Known magic number - else - thlp2_sfc = reduce_coef & - * 4.0_core_rknd * ( wpthlp_sfc**2 / ustar**2 ) ! Known magic number - rtp2_sfc = reduce_coef & - * 4.0_core_rknd * ( wprtp_sfc**2 / ustar**2 ) ! Known magic number - rtpthlp_sfc = reduce_coef & - * 4.0_core_rknd * ( wprtp_sfc*wpthlp_sfc / ustar**2 ) ! Known magic number - wp2_sfc = 1.75_core_rknd * ustar**2 ! Known magic number - end if - - ! Calculate wstar following Andre et al., 1978, p. 1866. - wstar = ( (1.0_core_rknd/T0) * grav * wpthlp_sfc * z_const )**(1.0_core_rknd/3.0_core_rknd) - - ! Andre et al., 1978, Eq. 29. - ! Andre et al. (1978) defines horizontal wind surface variances in terms - ! of orientation with the mean surface wind. The vector u_s is the wind - ! vector oriented with the mean surface wind. The vector v_s is the wind - ! vector oriented perpendicular to the mean surface wind. Thus, is - ! equal to the mean surface wind (both in speed and direction), and - ! is 0. Equation 29 gives the formula for the variance of u_s, which is - ! (usp2_sfc in the code), and the formula for the variance of - ! v_s, which is (vsp2_sfc in the code). - if ( wpthlp_sfc > 0.0_core_rknd ) then - usp2_sfc = 4.0_core_rknd * ustar**2 + 0.3_core_rknd * wstar**2 ! Known magic number - vsp2_sfc = 1.75_core_rknd * ustar**2 + 0.3_core_rknd * wstar**2 ! Known magic number - else - usp2_sfc = 4.0_core_rknd * ustar**2 ! Known magic number - vsp2_sfc = 1.75_core_rknd * ustar**2 ! Known magic number - end if - - ! Variance of u, , at the surface can be found from , - ! , and mean winds (at the surface) and , such that: - ! |_sfc = * [ ^2 / ( ^2 + ^2 ) ] - ! + * [ ^2 / ( ^2 + ^2 ) ]; - ! where ^2 + ^2 /= 0. - up2_sfc & - = usp2_sfc * ( um_sfc_sqd / max( um_sfc_sqd + vm_sfc_sqd , eps ) ) & - + vsp2_sfc * ( vm_sfc_sqd / max( um_sfc_sqd + vm_sfc_sqd , eps ) ) - - ! Variance of v, , at the surface can be found from , - ! , and mean winds (at the surface) and , such that: - ! |_sfc = * [ ^2 / ( ^2 + ^2 ) ] - ! + * [ ^2 / ( ^2 + ^2 ) ]; - ! where ^2 + ^2 /= 0. - vp2_sfc & - = vsp2_sfc * ( um_sfc_sqd / max( um_sfc_sqd + vm_sfc_sqd , eps ) ) & - + usp2_sfc * ( vm_sfc_sqd / max( um_sfc_sqd + vm_sfc_sqd , eps ) ) - - ! Passive scalars - if ( sclr_dim > 0 ) then - do i = 1, sclr_dim - ! Notes: 1) "reduce_coef" is a reduction coefficient intended to - ! make the values of sclrprtp, sclrpthlp, and sclrp2 - ! smaller at the surface. - ! 2) With the reduction coefficient having a value of 0.2, - ! the surface correlation of w & sclr has a value of - ! about 0.845. The correlation is greater if zeta < 0. - ! The correlation has a value greater than 1 if - ! zeta <= -0.212. - ! 3) The surface correlations of both rt & sclr and - ! thl & sclr are 1. - ! Brian Griffin; February 2, 2008. - if ( zeta < 0.0_core_rknd ) then - sclrprtp_sfc(i) & - = reduce_coef & - * ( wpsclrp_sfc(i)*wprtp_sfc / ustar**2 ) & - * 4.0_core_rknd * ( 1.0_core_rknd - 8.3_core_rknd*zeta )**& - (-2.0_core_rknd/3.0_core_rknd) ! Known magic number - sclrpthlp_sfc(i) & - = reduce_coef & - * ( wpsclrp_sfc(i)*wpthlp_sfc / ustar**2 ) & - * 4.0_core_rknd * ( 1.0_core_rknd - 8.3_core_rknd*zeta )**& - (-2.0_core_rknd/3.0_core_rknd) ! Known magic number - sclrp2_sfc(i) & - = reduce_coef & - * ( wpsclrp_sfc(i)**2 / ustar**2 ) & - * 4.0_core_rknd * ( 1.0_core_rknd - 8.3_core_rknd*zeta )**& - (-2.0_core_rknd/3.0_core_rknd) ! Known magic number - else - sclrprtp_sfc(i) & - = reduce_coef & - * 4.0_core_rknd * ( wpsclrp_sfc(i)*wprtp_sfc / ustar**2 ) ! Known magic number - sclrpthlp_sfc(i) & - = reduce_coef & - * 4.0_core_rknd * ( wpsclrp_sfc(i)*wpthlp_sfc / ustar**2 ) ! Known magic number - sclrp2_sfc(i) & - = reduce_coef & - * 4.0_core_rknd * ( wpsclrp_sfc(i)**2 / ustar**2 ) ! Known magic number - end if - end do ! 1,...sclr_dim - end if - - else ! Previous code. - - ! Compute ustar^2 - - ustar2 = sqrt( upwp_sfc * upwp_sfc + vpwp_sfc * vpwp_sfc ) - - ! Compute wstar following Andre et al., 1976 - - if ( wpthlp_sfc > 0._core_rknd ) then - wstar = ( 1.0_core_rknd/T0 * grav * wpthlp_sfc * z_const ) ** (1._core_rknd/3._core_rknd) - else - wstar = 0._core_rknd - end if - - ! Surface friction velocity following Andre et al. 1978 - - uf = sqrt( ustar2 + 0.3_core_rknd * wstar * wstar ) ! Known magic number - uf = max( ufmin, uf ) - - ! Compute estimate for surface second order moments - - wp2_sfc = a_const * uf**2 - up2_sfc = 2.0_core_rknd * a_const * uf**2 ! From Andre, et al. 1978 - vp2_sfc = 2.0_core_rknd * a_const * uf**2 ! " " - ! Vince Larson changed to make correlations between [-1,1] 31 Jan 2008 -! thlp2_sfc = 0.1 * a * ( wpthlp_sfc / uf )**2 -! rtp2_sfc = 0.4 * a * ( wprtp_sfc / uf )**2 -! rtpthlp_sfc = a * ( wpthlp_sfc / uf ) * ( wprtp_sfc / uf ) - ! Notes: 1) With "a" having a value of 1.8, the surface correlations of - ! both w & rt and w & thl have a value of about 0.878. - ! 2) The surface correlation of rt & thl is 0.5. - ! Brian Griffin; February 2, 2008. - - thlp2_sfc = 0.4_core_rknd * a_const * ( wpthlp_sfc / uf )**2 ! Known magic number - - rtp2_sfc = 0.4_core_rknd * a_const * ( wprtp_sfc / uf )**2 ! Known magic number - - rtpthlp_sfc = 0.2_core_rknd * a_const * ( wpthlp_sfc / uf ) & - * ( wprtp_sfc / uf )! Known magic number - - ! End Vince Larson's change. - - ! Passive scalars - if ( sclr_dim > 0 ) then - do i=1, sclr_dim - ! Vince Larson changed coeffs to make correlations between [-1,1]. 31 Jan 2008 -! sclrprtp_sfc(i) & -! = a * (wprtp_sfc / uf) * (wpsclrp_sfc(i) / uf) -! sclrpthlp_sfc(i) & -! = a * (wpthlp_sfc / uf) * (wpsclrp_sfc(i) / uf) -! sclrp2_sfc(i) & -! = sclr_var_coef * a * ( wpsclrp_sfc(i) / uf )**2 - ! Notes: 1) With "a" having a value of 1.8 and "sclr_var_coef" - ! having a value of 0.4, the surface correlation of - ! w & sclr has a value of about 0.878. - ! 2) With "sclr_var_coef" having a value of 0.4, the - ! surface correlations of both rt & sclr and - ! thl & sclr are 0.5. - ! Brian Griffin; February 2, 2008. - - ! We use the following if..then's to make sclr_rt and sclr_thl close to - ! the actual thlp2/rtp2 at the surface. -dschanen 25 Sep 08 - if ( i == iisclr_rt ) then - ! If we are trying to emulate rt with the scalar, then we - ! use the variance coefficient from above - sclrprtp_sfc(i) = 0.4_core_rknd * a_const * (wprtp_sfc / uf) * & - (wpsclrp_sfc(i) / uf)!Known magic number - else - sclrprtp_sfc(i) = 0.2_core_rknd * a_const * (wprtp_sfc / uf) * & - (wpsclrp_sfc(i) / uf)!Known magic number - end if - - if ( i == iisclr_thl ) then - ! As above, but for thetal - sclrpthlp_sfc(i) = 0.4_core_rknd * a_const * (wpthlp_sfc / uf) & - * (wpsclrp_sfc(i) / uf) ! Known magic number - else - sclrpthlp_sfc(i) = 0.2_core_rknd * a_const * (wpthlp_sfc / uf) & - * (wpsclrp_sfc(i) / uf) ! Known magic number - end if - - sclrp2_sfc(i) = sclr_var_coef * a_const * ( wpsclrp_sfc(i) / uf )**2 - - ! End Vince Larson's change. - - end do ! 1,...sclr_dim - end if ! sclr_dim > 0 - - end if - - if ( clubb_at_least_debug_level( 2 ) ) then - - call surface_varnce_check( wp2_sfc, up2_sfc, vp2_sfc, & - thlp2_sfc, rtp2_sfc, rtpthlp_sfc, & - err_code, & - sclrp2_sfc, sclrprtp_sfc, sclrpthlp_sfc ) - -! Error reporting -! Joshua Fasching February 2008 - if ( err_code == clubb_var_equals_NaN ) then - - write(fstderr,*) "Error in surface_varnce" - write(fstderr,*) "Intent(in)" - - write(fstderr,*) "upwp_sfc = ", upwp_sfc - write(fstderr,*) "vpwp_sfc = ", vpwp_sfc - write(fstderr,*) "wpthlp_sfc = ", wpthlp_sfc - write(fstderr,*) "wprtp_sfc = ", wprtp_sfc - - if ( sclr_dim > 0 ) then - write(fstderr,*) "wpsclrp_sfc = ", wpsclrp_sfc - end if - - write(fstderr,*) "Intent(out)" - - write(fstderr,*) "wp2_sfc = ", wp2_sfc - write(fstderr,*) "up2_sfc = ", up2_sfc - write(fstderr,*) "vp2_sfc = ", vp2_sfc - write(fstderr,*) "thlp2_sfc = ", thlp2_sfc - write(fstderr,*) "rtp2_sfc = ", rtp2_sfc - write(fstderr,*) "rtpthlp_sfc = ", rtpthlp_sfc - - if ( sclr_dim > 0 ) then - write(fstderr,*) "sclrp2_sfc = ", sclrp2_sfc - write(fstderr,*) "sclrprtp_sfc = ", sclrprtp_sfc - write(fstderr,*) "sclrpthlp_sfc = ", sclrpthlp_sfc - end if - - end if ! err_code == clubb_var_equals_NaN - - end if ! clubb_at_least_debug_level ( 2 ) - - return - - end subroutine surface_varnce - -!=============================================================================== - -end module crmx_surface_varnce_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_variables_diagnostic_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_variables_diagnostic_module.F90 deleted file mode 100644 index ce5d06c6fe..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_variables_diagnostic_module.F90 +++ /dev/null @@ -1,654 +0,0 @@ -! $Id: variables_diagnostic_module.F90 6118 2013-03-25 19:16:42Z storer@uwm.edu $ -module crmx_variables_diagnostic_module - -! Description: -! This module contains definitions of all diagnostic -! arrays used in the single column model, as well as subroutines -! to allocate, deallocate and initialize them. - -! Note that while these are all same dimension, there is a -! thermodynamic and momentum grid and they have different levels -!----------------------------------------------------------------------- - - use crmx_pdf_parameter_module, only: & - pdf_parameter ! derived type - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - private ! Set default scope - - public :: setup_diagnostic_variables, & - cleanup_diagnostic_variables - - - ! Diagnostic variables - - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - sigma_sqd_w_zt, & ! PDF width parameter interpolated to t-levs. [-] - Skw_zm, & ! Skewness of w on momentum levels [-] - Skw_zt, & ! Skewness of w on thermodynamic levels [-] - ug, & ! u geostrophic wind [m/s] - vg, & ! v geostrophic wind [m/s] - um_ref, & ! Initial u wind; Michael Falk [m/s] - vm_ref, & ! Initial v wind; Michael Falk [m/s] - thlm_ref, & ! Initial liquid water potential temperature [K] - rtm_ref, & ! Initial total water mixing ratio [kg/kg] - thvm ! Virtual potential temperature [K] - -!!! Important Note !!! -! Do not indent the omp comments, they need to be in the first 4 columns -!!! End Important Note !!! -!$omp threadprivate(sigma_sqd_w_zt, Skw_zm, Skw_zt, ug, vg, & -!$omp um_ref, vm_ref, thlm_ref, rtm_ref, thvm ) - - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - rsat ! Saturation mixing ratio ! Brian - -!$omp threadprivate(rsat) - - type(pdf_parameter), allocatable, dimension(:), target, public :: & - pdf_params_zm, & ! pdf_params on momentum levels [units vary] - pdf_params_zm_frz !used when l_use_ice_latent = .true. - -!$omp threadprivate(pdf_params_zm) - - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - Frad, & ! Radiative flux (momentum point) [W/m^2] - radht, & ! SW + LW heating rate [K/s] - Frad_SW_up, & ! SW radiative upwelling flux [W/m^2] - Frad_LW_up, & ! LW radiative upwelling flux [W/m^2] - Frad_SW_down, & ! SW radiative downwelling flux [W/m^2] - Frad_LW_down ! LW radiative downwelling flux [W/m^2] - -!$omp threadprivate(Frad, radht, Frad_SW_up, Frad_SW_down, Frad_LW_up, Frad_LW_down) - -! Second order moments - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - thlprcp, & ! thl'rc' [K kg/kg] - rtprcp, & ! rt'rc' [kg^2/kg^2] - rcp2 ! rc'^2 [kg^2/kg^2] - -!$omp threadprivate(thlprcp, rtprcp, rcp2) - -! Third order moments - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - wpthlp2, & ! w'thl'^2 [m K^2/s] - wp2thlp, & ! w'^2 thl' [m^2 K/s^2] - wprtp2, & ! w'rt'^2 [m kg^2/kg^2] - wp2rtp, & ! w'^2rt' [m^2 kg/kg] - wprtpthlp, & ! w'rt'thl' [m kg K/kg s] - wp2rcp, & ! w'^2 rc' [m^2 kg/kg s^2] - wp3_zm ! w'^3 [m^3/s^3] - -!$omp threadprivate(wpthlp2, wp2thlp, wprtp2, wp2rtp, & -!$omp wprtpthlp, wp2rcp, wp3_zm ) - -! Fourth order moments - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - wp4 ! w'^4 [m^4/s^4] - -!$omp threadprivate(wp4) - -! Buoyancy related moments - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - rtpthvp, & ! rt'thv' [K kg/kg] - thlpthvp, & ! thl'thv' [K^2] - wpthvp, & ! w'thv' [K m/s] - wp2thvp ! w'^2thv' [K m^2/s^2] - -!$omp threadprivate(rtpthvp, thlpthvp, wpthvp, wp2thvp) - - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - Kh_zt, & ! Eddy diffusivity coefficient on thermodynamic levels [m^2/s] - Kh_zm ! Eddy diffusivity coefficient on momentum levels [m^2/s] - -!$omp threadprivate(Kh_zt, Kh_zm) - -! Mixing lengths - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - Lscale, Lscale_up, Lscale_down ! [m] - -!$omp threadprivate(Lscale, Lscale_up, Lscale_down) - - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - em, & ! Turbulent Kinetic Energy (TKE) [m^2/s^2] - tau_zm, & ! Eddy dissipation time scale on momentum levels [s] - tau_zt ! Eddy dissipation time scale on thermodynamic levels [s] - -!$omp threadprivate(em, tau_zm, tau_zt) - -! hydrometeors variable array - real( kind = core_rknd ), allocatable, dimension(:,:), public :: hydromet -!$omp threadprivate(hydromet) - - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - Ncnm ! Cloud nuclei number concentration [num/m^3] -!$omp threadprivate(Ncnm) - - -! Surface data - real( kind = core_rknd ), public :: ustar ! Average value of friction velocity [m/s] - - real( kind = core_rknd ), public :: soil_heat_flux ! Soil Heat Flux [W/m^2] -!$omp threadprivate(ustar, soil_heat_flux) - -! Passive scalar variables - - real( kind = core_rknd ), target, allocatable, dimension(:,:), public :: & - wpedsclrp ! w'edsclr' -!$omp threadprivate(wpedsclrp) - - real( kind = core_rknd ), target, allocatable, dimension(:,:), public :: & - sclrpthvp, & ! sclr'th_v' - sclrprcp, & ! sclr'rc' - wp2sclrp, & ! w'^2 sclr' - wpsclrp2, & ! w'sclr'^2 - wpsclrprtp, & ! w'sclr'rt' - wpsclrpthlp ! w'sclr'thl' - -!$omp threadprivate(sclrpthvp, sclrprcp, & -!$omp wp2sclrp, wpsclrp2, wpsclrprtp, wpsclrpthlp ) - -! Interpolated variables for tuning -! - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - wp2_zt, & ! w'^2 on thermo. grid [m^2/s^2] - thlp2_zt, & ! thl'^2 on thermo. grid [K^2] - wpthlp_zt, & ! w'thl' on thermo. grid [m K/s] - wprtp_zt, & ! w'rt' on thermo. grid [m kg/(kg s)] - rtp2_zt, & ! rt'^2 on therm. grid [(kg/kg)^2] - rtpthlp_zt, & ! rt'thl' on thermo. grid [kg K/kg] - up2_zt, & ! u'^2 on thermo. grid [m^2/s^2] - vp2_zt, & ! v'^2 on thermo. grid [m^2/s^2] - upwp_zt, & ! u'w' on thermo. grid [m^2/s^2] - vpwp_zt ! v'w' on thermo. grid [m^2/s^2] - -!$omp threadprivate(wp2_zt, thlp2_zt, wpthlp_zt, wprtp_zt, & -!$omp rtp2_zt, rtpthlp_zt, & -!$omp up2_zt, vp2_zt, upwp_zt, vpwp_zt) - - -! Latin Hypercube arrays. Vince Larson 22 May 2005 - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - lh_AKm, & ! Kessler ac estimate [kg/kg/s] - AKm, & ! Exact Kessler ac [kg/kg/s] - AKstd, & ! St dev of exact Kessler ac [kg/kg/s] - AKstd_cld, & ! Stdev of exact w/in cloud ac [kg/kg/s] - lh_rcm_avg, & ! Monte Carlo rcm estimate [kg/kg] - AKm_rcm, & ! Kessler ac based on rcm [kg/kg/s] - AKm_rcc ! Kessler ac based on rcm/cloud_frac [kg/kg/s] - -!$omp threadprivate(lh_AKm, AKm, AKstd, AKstd_cld, lh_rcm_avg, AKm_rcm, & -!$omp AKm_rcc) - - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - Skw_velocity, & ! Skewness velocity [m/s] - a3_coef, & ! The a3 coefficient from CLUBB eqns [-] - a3_coef_zt ! The a3 coefficient interpolated to the zt grid [-] - -!$omp threadprivate(Skw_velocity, a3_coef, a3_coef_zt) - - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - wp3_on_wp2, & ! w'^3 / w'^2 on the zm grid [m/s] - wp3_on_wp2_zt ! w'^3 / w'^2 on the zt grid [m/s] - -!$omp threadprivate(wp3_on_wp2, wp3_on_wp2_zt) - - contains - -!----------------------------------------------------------------------- - subroutine setup_diagnostic_variables( nz ) -! Description: -! Allocates and initializes prognostic scalar and array variables -! for the CLUBB model code -!----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - em_min, & ! Constant(s) - zero - - use crmx_parameters_model, only: & - hydromet_dim, & ! Variables - sclr_dim, & - edsclr_dim - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - integer, intent(in) :: nz ! Nunber of grid levels [-] - - ! Local Variables - integer :: i - -! --- Allocation --- - - ! Diagnostic variables - - allocate( sigma_sqd_w_zt(1:nz) ) ! PDF width parameter interp. to t-levs. - allocate( Skw_zm(1:nz) ) ! Skewness of w on momentum levels - allocate( Skw_zt(1:nz) ) ! Skewness of w on thermodynamic levels - allocate( ug(1:nz) ) ! u geostrophic wind - allocate( vg(1:nz) ) ! v geostrophic wind - allocate( um_ref(1:nz) ) ! Reference u wind for nudging; Michael Falk, 17 Oct 2007 - allocate( vm_ref(1:nz) ) ! Reference v wind for nudging; Michael Falk, 17 Oct 2007 - allocate( thlm_ref(1:nz) ) ! Reference liquid water potential for nudging - allocate( rtm_ref(1:nz) ) ! Reference total water mixing ratio for nudging - allocate( thvm(1:nz) ) ! Virtual potential temperature - - allocate( rsat(1:nz) ) ! Saturation mixing ratio ! Brian - - allocate( Frad(1:nz) ) ! radiative flux (momentum point) - allocate( Frad_SW_up(1:nz) ) - allocate( Frad_LW_up(1:nz) ) - allocate( Frad_SW_down(1:nz) ) - allocate( Frad_LW_down(1:nz) ) - - allocate( radht(1:nz) ) ! SW + LW heating rate - - ! pdf_params on momentum levels - allocate( pdf_params_zm(1:nz) ) - allocate( pdf_params_zm_frz(1:nz) ) - - ! Second order moments - - allocate( thlprcp(1:nz) ) ! thl'rc' - allocate( rtprcp(1:nz) ) ! rt'rc' - allocate( rcp2(1:nz) ) ! rc'^2 - - ! Third order moments - - allocate( wpthlp2(1:nz) ) ! w'thl'^2 - allocate( wp2thlp(1:nz) ) ! w'^2thl' - allocate( wprtp2(1:nz) ) ! w'rt'^2 - allocate( wp2rtp(1:nz) ) ! w'^2rt' - allocate( wprtpthlp(1:nz) ) ! w'rt'thl' - allocate( wp2rcp(1:nz) ) ! w'^2rc' - - allocate( wp3_zm(1:nz) ) ! w'^3 - - ! Fourth order moments - - allocate( wp4(1:nz) ) - - ! Buoyancy related moments - - allocate( rtpthvp(1:nz) ) ! rt'thv' - allocate( thlpthvp(1:nz) ) ! thl'thv' - allocate( wpthvp(1:nz) ) ! w'thv' - allocate( wp2thvp(1:nz) ) ! w'^2thv' - - allocate( Kh_zt(1:nz) ) ! Eddy diffusivity coefficient: thermo. levels - allocate( Kh_zm(1:nz) ) ! Eddy diffusivity coefficient: momentum levels - - allocate( em(1:nz) ) - allocate( Lscale(1:nz) ) - allocate( Lscale_up(1:nz) ) - allocate( Lscale_down(1:nz) ) - - allocate( tau_zm(1:nz) ) ! Eddy dissipation time scale: momentum levels - allocate( tau_zt(1:nz) ) ! Eddy dissipation time scale: thermo. levels - - - ! Interpolated Variables - allocate( wp2_zt(1:nz) ) ! w'^2 on thermo. grid - allocate( thlp2_zt(1:nz) ) ! thl'^2 on thermo. grid - allocate( wpthlp_zt(1:nz) ) ! w'thl' on thermo. grid - allocate( wprtp_zt(1:nz) ) ! w'rt' on thermo. grid - allocate( rtp2_zt(1:nz) ) ! rt'^2 on thermo. grid - allocate( rtpthlp_zt(1:nz) ) ! rt'thl' on thermo. grid - allocate( up2_zt(1:nz) ) ! u'^2 on thermo. grid - allocate( vp2_zt(1:nz) ) ! v'^2 on thermo. grid - allocate( upwp_zt(1:nz) ) ! u'w' on thermo. grid - allocate( vpwp_zt(1:nz) ) ! v'w' on thermo. grid - - - ! Microphysics Variables - allocate( Ncnm(1:nz) ) - allocate( hydromet(1:nz,1:hydromet_dim) ) ! All hydrometeor fields - - ! Variables for Latin hypercube microphysics. Vince Larson 22 May 2005 - allocate( lh_AKm(1:nz) ) ! Kessler ac estimate - allocate( AKm(1:nz) ) ! Exact Kessler ac - allocate( AKstd(1:nz) ) ! St dev of exact Kessler ac - allocate( AKstd_cld(1:nz) ) ! St dev of exact w/in cloud Kessler ac - allocate( lh_rcm_avg(1:nz) ) ! Monte Carlo rcm estimate - allocate( AKm_rcm(1:nz) ) ! Kessler ac based on rcm - allocate( AKm_rcc(1:nz) ) ! Kessler ac based on rcm/cloud_frac - ! End of variables for Latin hypercube. - - ! High-order passive scalars - allocate( sclrpthvp(1:nz, 1:sclr_dim) ) - allocate( sclrprcp(1:nz, 1:sclr_dim) ) - - allocate( wp2sclrp(1:nz, 1:sclr_dim) ) - allocate( wpsclrp2(1:nz, 1:sclr_dim) ) - allocate( wpsclrprtp(1:nz, 1:sclr_dim) ) - allocate( wpsclrpthlp(1:nz, 1:sclr_dim) ) - - ! Eddy Diff. Scalars - allocate( wpedsclrp(1:nz, 1:edsclr_dim) ) - - allocate( Skw_velocity(1:nz) ) - - allocate( a3_coef(1:nz) ) - allocate( a3_coef_zt(1:nz) ) - - allocate( wp3_on_wp2(1:nz) ) - allocate( wp3_on_wp2_zt(1:nz) ) - - ! --- Initializaton --- - - ! Diagnostic variables - - sigma_sqd_w_zt = 0.0_core_rknd ! PDF width parameter interp. to t-levs. - Skw_zm = 0.0_core_rknd ! Skewness of w on momentum levels - Skw_zt = 0.0_core_rknd ! Skewness of w on thermodynamic levels - ug = 0.0_core_rknd ! u geostrophic wind - vg = 0.0_core_rknd ! v geostrophic wind - um_ref = 0.0_core_rknd - vm_ref = 0.0_core_rknd - thlm_ref = 0.0_core_rknd - rtm_ref = 0.0_core_rknd - - thvm = 0.0_core_rknd ! Virtual potential temperature - rsat = 0.0_core_rknd ! Saturation mixing ratio ! Brian - - radht = 0.0_core_rknd ! Heating rate - Frad = 0.0_core_rknd ! Radiative flux - Frad_SW_up = 0.0_core_rknd - Frad_LW_up = 0.0_core_rknd - Frad_SW_down = 0.0_core_rknd - Frad_LW_down = 0.0_core_rknd - - - ! pdf_params on momentum levels - pdf_params_zm(:)%w1 = zero - pdf_params_zm(:)%w2 = zero - pdf_params_zm(:)%varnce_w1 = zero - pdf_params_zm(:)%varnce_w2 = zero - pdf_params_zm(:)%rt1 = zero - pdf_params_zm(:)%rt2 = zero - pdf_params_zm(:)%varnce_rt1 = zero - pdf_params_zm(:)%varnce_rt2 = zero - pdf_params_zm(:)%thl1 = zero - pdf_params_zm(:)%thl2 = zero - pdf_params_zm(:)%varnce_thl1 = zero - pdf_params_zm(:)%varnce_thl2 = zero - pdf_params_zm(:)%rrtthl = zero - pdf_params_zm(:)%alpha_thl = zero - pdf_params_zm(:)%alpha_rt = zero - pdf_params_zm(:)%crt1 = zero - pdf_params_zm(:)%crt2 = zero - pdf_params_zm(:)%cthl1 = zero - pdf_params_zm(:)%cthl2 = zero - pdf_params_zm(:)%s1 = zero - pdf_params_zm(:)%s2 = zero - pdf_params_zm(:)%stdev_s1 = zero - pdf_params_zm(:)%stdev_s2 = zero - pdf_params_zm(:)%stdev_t1 = zero - pdf_params_zm(:)%stdev_t2 = zero - pdf_params_zm(:)%covar_st_1 = zero - pdf_params_zm(:)%covar_st_2 = zero - pdf_params_zm(:)%corr_st_1 = zero - pdf_params_zm(:)%corr_st_2 = zero - pdf_params_zm(:)%rsl1 = zero - pdf_params_zm(:)%rsl2 = zero - pdf_params_zm(:)%rc1 = zero - pdf_params_zm(:)%rc2 = zero - pdf_params_zm(:)%cloud_frac1 = zero - pdf_params_zm(:)%cloud_frac2 = zero - pdf_params_zm(:)%mixt_frac = zero - - pdf_params_zm_frz(:)%w1 = zero - pdf_params_zm_frz(:)%w2 = zero - pdf_params_zm_frz(:)%varnce_w1 = zero - pdf_params_zm_frz(:)%varnce_w2 = zero - pdf_params_zm_frz(:)%rt1 = zero - pdf_params_zm_frz(:)%rt2 = zero - pdf_params_zm_frz(:)%varnce_rt1 = zero - pdf_params_zm_frz(:)%varnce_rt2 = zero - pdf_params_zm_frz(:)%thl1 = zero - pdf_params_zm_frz(:)%thl2 = zero - pdf_params_zm_frz(:)%varnce_thl1 = zero - pdf_params_zm_frz(:)%varnce_thl2 = zero - pdf_params_zm_frz(:)%rrtthl = zero - pdf_params_zm_frz(:)%alpha_thl = zero - pdf_params_zm_frz(:)%alpha_rt = zero - pdf_params_zm_frz(:)%crt1 = zero - pdf_params_zm_frz(:)%crt2 = zero - pdf_params_zm_frz(:)%cthl1 = zero - pdf_params_zm_frz(:)%cthl2 = zero - pdf_params_zm_frz(:)%s1 = zero - pdf_params_zm_frz(:)%s2 = zero - pdf_params_zm_frz(:)%stdev_s1 = zero - pdf_params_zm_frz(:)%stdev_s2 = zero - pdf_params_zm_frz(:)%stdev_t1 = zero - pdf_params_zm_frz(:)%stdev_t2 = zero - pdf_params_zm_frz(:)%covar_st_1 = zero - pdf_params_zm_frz(:)%covar_st_2 = zero - pdf_params_zm_frz(:)%corr_st_1 = zero - pdf_params_zm_frz(:)%corr_st_2 = zero - pdf_params_zm_frz(:)%rsl1 = zero - pdf_params_zm_frz(:)%rsl2 = zero - pdf_params_zm_frz(:)%rc1 = zero - pdf_params_zm_frz(:)%rc2 = zero - pdf_params_zm_frz(:)%cloud_frac1 = zero - pdf_params_zm_frz(:)%cloud_frac2 = zero - pdf_params_zm_frz(:)%mixt_frac = zero - - ! Second order moments - thlprcp = 0.0_core_rknd - rtprcp = 0.0_core_rknd - rcp2 = 0.0_core_rknd - - ! Third order moments - wpthlp2 = 0.0_core_rknd - wp2thlp = 0.0_core_rknd - wprtp2 = 0.0_core_rknd - wp2rtp = 0.0_core_rknd - wp2rcp = 0.0_core_rknd - wprtpthlp = 0.0_core_rknd - - wp3_zm = 0.0_core_rknd - - ! Fourth order moments - wp4 = 0.0_core_rknd - - ! Buoyancy related moments - rtpthvp = 0.0_core_rknd ! rt'thv' - thlpthvp = 0.0_core_rknd ! thl'thv' - wpthvp = 0.0_core_rknd ! w'thv' - wp2thvp = 0.0_core_rknd ! w'^2thv' - - ! Eddy diffusivity - Kh_zt = 0.0_core_rknd ! Eddy diffusivity coefficient: thermo. levels - Kh_zm = 0.0_core_rknd ! Eddy diffusivity coefficient: momentum levels - - ! TKE - em = em_min - - ! Length scale - Lscale = 0.0_core_rknd - Lscale_up = 0.0_core_rknd - Lscale_down = 0.0_core_rknd - - ! Dissipation time - tau_zm = 0.0_core_rknd ! Eddy dissipation time scale: momentum levels - tau_zt = 0.0_core_rknd ! Eddy dissipation time scale: thermo. levels - - ! Hydrometer types - Ncnm(1:nz) = 0.0_core_rknd ! Cloud nuclei number concentration (COAMPS) - - do i = 1, hydromet_dim, 1 - hydromet(1:nz,i) = 0.0_core_rknd - end do - - - ! Variables for Latin hypercube microphysics. Vince Larson 22 May 2005 - lh_AKm = 0.0_core_rknd ! Kessler ac estimate - AKm = 0.0_core_rknd ! Exact Kessler ac - AKstd = 0.0_core_rknd ! St dev of exact Kessler ac - AKstd_cld = 0.0_core_rknd ! St dev of exact w/in cloud Kessler ac - lh_rcm_avg = 0.0_core_rknd ! Monte Carlo rcm estimate - AKm_rcm = 0.0_core_rknd ! Kessler ac based on rcm - AKm_rcc = 0.0_core_rknd ! Kessler ac based on rcm/cloud_frac - - ! Passive scalars - if ( sclr_dim > 0 ) then - sclrpthvp(:,:) = 0.0_core_rknd - sclrprcp(:,:) = 0.0_core_rknd - - wp2sclrp(:,:) = 0.0_core_rknd - wpsclrp2(:,:) = 0.0_core_rknd - wpsclrprtp(:,:) = 0.0_core_rknd - wpsclrpthlp(:,:) = 0.0_core_rknd - - end if - - if ( edsclr_dim > 0 ) then - wpedsclrp(:,:) = 0.0_core_rknd - end if - - Skw_velocity = 0.0_core_rknd - - a3_coef = 0.0_core_rknd - a3_coef_zt = 0.0_core_rknd - - wp3_on_wp2 = 0.0_core_rknd - wp3_on_wp2_zt = 0.0_core_rknd - - return - end subroutine setup_diagnostic_variables - -!------------------------------------------------------------------------ - subroutine cleanup_diagnostic_variables( ) - -! Description: -! Subroutine to deallocate variables defined in module global -!------------------------------------------------------------------------ - - implicit none - - - ! --- Deallocate --- - - deallocate( sigma_sqd_w_zt ) ! PDF width parameter interp. to t-levs. - deallocate( Skw_zm ) ! Skewness of w on momentum levels - deallocate( Skw_zt ) ! Skewness of w on thermodynamic levels - deallocate( ug ) ! u geostrophic wind - deallocate( vg ) ! v geostrophic wind - deallocate( um_ref ) ! u initial - deallocate( vm_ref ) ! v initial - deallocate( thlm_ref ) - deallocate( rtm_ref ) - - deallocate( thvm ) ! virtual potential temperature - deallocate( rsat ) ! saturation mixing ratio ! Brian - - deallocate( Frad ) ! radiative flux (momentum point) - - deallocate( Frad_SW_up ) ! upwelling shortwave radiative flux - deallocate( Frad_LW_up ) ! upwelling longwave radiative flux - deallocate( Frad_SW_down ) ! downwelling shortwave radiative flux - deallocate( Frad_LW_down ) ! downwelling longwave radiative flux - - deallocate( radht ) ! SW + LW heating rate - - deallocate( pdf_params_zm ) - deallocate( pdf_params_zm_frz ) - - ! Second order moments - - deallocate( thlprcp ) ! thl'rc' - deallocate( rtprcp ) ! rt'rc' - deallocate( rcp2 ) ! rc'^2 - - ! Third order moments - - deallocate( wpthlp2 ) ! w'thl'^2 - deallocate( wp2thlp ) ! w'^2thl' - deallocate( wprtp2 ) ! w'rt'^2 - deallocate( wp2rtp ) ! w'^2rt' - deallocate( wprtpthlp ) ! w'rt'thl' - deallocate( wp2rcp ) ! w'^2rc' - - deallocate( wp3_zm ) - - ! Fourth order moments - - deallocate( wp4 ) - - ! Buoyancy related moments - - deallocate( rtpthvp ) ! rt'thv' - deallocate( thlpthvp ) ! thl'thv' - deallocate( wpthvp ) ! w'thv' - deallocate( wp2thvp ) ! w'^2thv' - - deallocate( Kh_zt ) ! Eddy diffusivity coefficient: thermo. levels - deallocate( Kh_zm ) ! Eddy diffusivity coefficient: momentum levels - - deallocate( em ) - deallocate( Lscale ) - deallocate( Lscale_up ) - deallocate( Lscale_down ) - deallocate( tau_zm ) ! Eddy dissipation time scale: momentum levels - deallocate( tau_zt ) ! Eddy dissipation time scale: thermo. levels - - ! Cloud water variables - - deallocate( Ncnm ) - - deallocate( hydromet ) ! Hydrometeor fields - - - ! Interpolated variables for tuning - deallocate( wp2_zt ) ! w'^2 on thermo. grid - deallocate( thlp2_zt ) ! th_l'^2 on thermo. grid - deallocate( wpthlp_zt ) ! w'th_l' on thermo. grid - deallocate( wprtp_zt ) ! w'rt' on thermo. grid - deallocate( rtp2_zt ) ! rt'^2 on thermo. grid - deallocate( rtpthlp_zt ) ! rt'th_l' on thermo. grid - deallocate( up2_zt ) ! u'^2 on thermo. grid - deallocate( vp2_zt ) ! v'^2 on thermo. grid - deallocate( upwp_zt ) ! u'w' on thermo. grid - deallocate( vpwp_zt ) ! v'w' on thermo. grid - - ! Variables for Latin hypercube microphysics. Vince Larson 22 May 2005 - deallocate( lh_AKm ) ! Kessler ac estimate - deallocate( AKm ) ! Exact Kessler ac - deallocate( AKstd ) ! St dev of exact Kessler ac - deallocate( AKstd_cld ) ! St dev of exact w/in cloud Kessler ac - deallocate( lh_rcm_avg ) ! Monte Carlo rcm estimate - deallocate( AKm_rcm ) ! Kessler ac based on rcm - deallocate( AKm_rcc ) ! Kessler ac based on rcm/cloud_frac - - ! Passive scalars - deallocate( sclrpthvp ) - deallocate( sclrprcp ) - - deallocate( wp2sclrp ) - deallocate( wpsclrp2 ) - deallocate( wpsclrprtp ) - deallocate( wpsclrpthlp ) - - deallocate( wpedsclrp ) - - deallocate( Skw_velocity ) - - deallocate( a3_coef ) - deallocate( a3_coef_zt ) - - deallocate( wp3_on_wp2 ) - deallocate( wp3_on_wp2_zt ) - - return - end subroutine cleanup_diagnostic_variables - -end module crmx_variables_diagnostic_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_variables_prognostic_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_variables_prognostic_module.F90 deleted file mode 100644 index 40b9a3163d..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_variables_prognostic_module.F90 +++ /dev/null @@ -1,560 +0,0 @@ -!----------------------------------------------------------------------- -! $Id: variables_prognostic_module.F90 6117 2013-03-25 19:16:04Z storer@uwm.edu $ -module crmx_variables_prognostic_module - -! This module contains definitions of all prognostic -! arrays used in the single column model, as well as subroutines -! to allocate, deallocate and initialize them. - -! Note that while these are all same dimension, there is a -! thermodynamic grid and a momentum grid, and the grids have -! different points. -!----------------------------------------------------------------------- - use crmx_pdf_parameter_module, only: & - pdf_parameter ! Derived type - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - private ! Set Default Scoping - - public :: & - setup_prognostic_variables, & - cleanup_prognostic_variables - - ! Prognostic variables -! ---> h1g, 2010-06-16 -#ifdef GFDL - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - um, & ! u wind [m/s] - vm, & ! v wind [m/s] - upwp, & ! vertical u momentum flux [m^2/s^2] - vpwp, & ! vertical v momentum flux [m^2/s^2] - up2, & ! u'^2 [m^2/s^2] - vp2, & ! v'^2 [m^2/s^2] - thlm, & ! liquid potential temperature [K] -!---> h1g - temp_clubb, & ! air temperature [K] -!<--- h1g - rtm, & ! total water mixing ratio [kg/kg] - wprtp, & ! w'rt' [(kg/kg) m/s] - wpthlp, & ! w'thl' [m K/s] - wprcp, & ! w'rc' [(kg/kg) m/s] - wp2, & ! w'^2 [m^2/s^2] - wp3, & ! w'^3 [m^3/s^3] - rtp2, & ! rt'^2 [(kg/kg)^2] - thlp2, & ! thl'^2 [K^2] - rtpthlp ! rt'thl' [kg/kg K] -#else - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - um, & ! u wind [m/s] - vm, & ! v wind [m/s] - upwp, & ! vertical u momentum flux [m^2/s^2] - vpwp, & ! vertical v momentum flux [m^2/s^2] - up2, & ! u'^2 [m^2/s^2] - vp2, & ! v'^2 [m^2/s^2] - thlm, & ! liquid potential temperature [K] - rtm, & ! total water mixing ratio [kg/kg] - wprtp, & ! w'rt' [(kg/kg) m/s] - wpthlp, & ! w'thl' [m K/s] - wprcp, & ! w'rc' [(kg/kg) m/s] - wp2, & ! w'^2 [m^2/s^2] - wp3, & ! w'^3 [m^3/s^3] - rtp2, & ! rt'^2 [(kg/kg)^2] - thlp2, & ! thl'^2 [K^2] - rtpthlp ! rt'thl' [kg/kg K] -#endif -! <--- h1g, 2010-06-16 - -!$omp threadprivate(um, vm, upwp, vpwp, up2, vp2) -!$omp threadprivate(thlm, rtm, wprtp, wpthlp, wprcp) -!$omp threadprivate(wp2, wp3, rtp2, thlp2, rtpthlp) - - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - p_in_Pa, & ! Pressure (Pa) (thermodynamic levels) [Pa] - exner, & ! Exner function = ( p / p0 ) ** kappa [-] - rho, & ! Density (thermodynamic levels) [kg/m^3] - rho_zm, & ! Density on momentum levels [kg/m^3] - rho_ds_zm, & ! Dry, static density (momentum levels) [kg/m^3] - rho_ds_zt, & ! Dry, static density (thermodynamic levels) [kg/m^3] - invrs_rho_ds_zm, & ! Inverse dry, static density (momentum levs.) [m^3/kg] - invrs_rho_ds_zt, & ! Inverse dry, static density (thermo. levs.) [m^3/kg] - thv_ds_zm, & ! Dry, base-state theta_v (momentum levels) [K] - thv_ds_zt, & ! Dry, base-state theta_v (thermodynamic levs.) [K] - thlm_forcing, & ! thlm large-scale forcing [K/s] - rtm_forcing, & ! rtm large-scale forcing [kg/kg/s] - um_forcing, & ! u wind forcing [m/s/s] - vm_forcing, & ! v wind forcing [m/s/s] - wprtp_forcing, & ! forcing (momentum levels) [m*K/s^2] - wpthlp_forcing, & ! forcing (momentum levels) [m*(kg/kg)/s^2] - rtp2_forcing, & ! forcing (momentum levels) [(kg/kg)^2/s] - thlp2_forcing, & ! forcing (momentum levels) [K^2/s] - rtpthlp_forcing ! forcing (momentum levels) [K*(kg/kg)/s] - -!$omp threadprivate( p_in_Pa, exner, rho, rho_zm, rho_ds_zm, rho_ds_zt, & -!$omp invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & -!$omp thlm_forcing, rtm_forcing, um_forcing, vm_forcing, wprtp_forcing, & -!$omp wpthlp_forcing, rtp2_forcing, thlp2_forcing, rtpthlp_forcing ) - - ! Imposed large scale w - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - wm_zm, & ! w on momentum levels [m/s] - wm_zt ! w on thermodynamic levels [m/s] - -!$omp threadprivate(wm_zm, wm_zt) - - ! Cloud water variables - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - rcm, & ! Cloud water mixing ratio [kg/kg] - cloud_frac, & ! Cloud fraction [-] - ice_supersat_frac, & ! Ice cloud fraction [-] - rcm_in_layer, & ! Cloud water mixing ratio in cloud layer [kg/kg] - cloud_cover ! Cloud cover [-] - -!$omp threadprivate(rcm, cloud_frac, rcm_in_layer, cloud_cover) - - ! Surface fluxes - real( kind = core_rknd ), public :: & - wpthlp_sfc, & ! w'thl' [m K/s] - wprtp_sfc, & ! w'rt' [m kg/(kg s)] - upwp_sfc, vpwp_sfc ! u'w' & v'w' [m^2/s^2] - -!$omp threadprivate(wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc) - - ! Surface fluxes for passive scalars - real( kind = core_rknd ), dimension(:), allocatable, public :: & - wpsclrp_sfc, & ! w'sclr' at surface [units m/s] - wpedsclrp_sfc ! w'edsclr' at surface [units m/s] - -!$omp threadprivate(wpsclrp_sfc, wpedsclrp_sfc) - - ! More surface data - real( kind = core_rknd ), public :: & - T_sfc, & ! surface temperature [K] - p_sfc, & ! surface pressure [Pa] - sens_ht, & ! sensible heat flux [K m/s] - latent_ht ! latent heat flux [m/s] - -!$omp threadprivate(T_sfc, p_sfc, sens_ht, latent_ht) - - ! Passive scalars - real( kind = core_rknd ), target, allocatable, dimension(:,:), public :: & - sclrm, & ! Mean passive scalars [units vary] - sclrp2, & ! sclr'^2 [units^2] - sclrprtp, & ! sclr'rt' [units kg/kg] - sclrpthlp, & ! sclr'th_l' [units K] - sclrm_forcing, & ! Scalars' forcing [units/s] - edsclrm, & ! Mean eddy-diffusivity scalars [units vary] - edsclrm_forcing, & ! Eddy-diff. scalars forcing [units/s] - wpsclrp ! w'sclr' [units vary m/s] - -!---> h1g, 2010-06-16 -#ifdef GFDL - real( kind = core_rknd ), target, allocatable, dimension( : , : , : ), public :: & - RH_crit ! critical relative humidity for droplet and ice nucleation -#endif -!<--- h1g, 2010-06-16 - -!$omp threadprivate(sclrm, sclrp2, sclrprtp, sclrpthlp, sclrm_forcing, & -!$omp edsclrm, edsclrm_forcing, wpsclrp) - - ! PDF parameters - real( kind = core_rknd ), target, allocatable, dimension(:), public :: & - sigma_sqd_w ! PDF width parameter (momentum levels) [-] - -!$omp threadprivate(sigma_sqd_w) - - type(pdf_parameter), target, allocatable, dimension(:), public :: & - pdf_params, & - pdf_params_frz !for use when l_use_ice_latent = .true. - -!$omp threadprivate(pdf_params) - - contains -!----------------------------------------------------------------------- - subroutine setup_prognostic_variables( nz ) - -! Description: -! Allocates and Initializes prognostic scalar and array variables -! for the CLUBB parameterization. Variables contained within this module -! will be arguments to the advance_clubb_core subroutine rather than brought -! in through a use statement. - -! References: -! None -!----------------------------------------------------------------------- - use crmx_constants_clubb, only: & - rt_tol, & ! Constant(s) - thl_tol, & - w_tol_sqd, & - zero - - use crmx_parameters_model, only: & - sclr_dim, & ! Variable(s) - edsclr_dim - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - integer, intent(in) :: nz ! Number of grid levels [-] - - integer :: i - -! --- Allocation --- - -! Prognostic variables - - allocate( um(1:nz) ) ! u wind - allocate( vm(1:nz) ) ! v wind - - allocate( upwp(1:nz) ) ! vertical u momentum flux - allocate( vpwp(1:nz) ) ! vertical v momentum flux - - allocate( up2(1:nz) ) - allocate( vp2(1:nz) ) - - allocate( thlm(1:nz) ) ! liquid potential temperature -!---> h1g, 2010-06-16 -#ifdef GFDL - allocate( temp_clubb(1:nz) ) ! air temperature -#endif -!<--- h1g, 2010-06-16 - - allocate( rtm(1:nz) ) ! total water mixing ratio - allocate( wprtp(1:nz) ) ! w'rt' - allocate( wpthlp(1:nz) ) ! w'thl' - allocate( wprcp(1:nz) ) ! w'rc' - allocate( wp2(1:nz) ) ! w'^2 - allocate( wp3(1:nz) ) ! w'^3 - allocate( rtp2(1:nz) ) ! rt'^2 - allocate( thlp2(1:nz) ) ! thl'^2 - allocate( rtpthlp(1:nz) ) ! rt'thlp' - - allocate( p_in_Pa(1:nz) ) ! pressure (pascals) - allocate( exner(1:nz) ) ! exner function - allocate( rho(1:nz) ) ! density: t points - allocate( rho_zm(1:nz) ) ! density: m points - allocate( rho_ds_zm(1:nz) ) ! dry, static density: m-levs - allocate( rho_ds_zt(1:nz) ) ! dry, static density: t-levs - allocate( invrs_rho_ds_zm(1:nz) ) ! inv. dry, static density: m-levs - allocate( invrs_rho_ds_zt(1:nz) ) ! inv. dry, static density: t-levs - allocate( thv_ds_zm(1:nz) ) ! dry, base-state theta_v: m-levs - allocate( thv_ds_zt(1:nz) ) ! dry, base-state theta_v: t-levs - - allocate( thlm_forcing(1:nz) ) ! thlm ls forcing - allocate( rtm_forcing(1:nz) ) ! rtm ls forcing - allocate( um_forcing(1:nz) ) ! u forcing - allocate( vm_forcing(1:nz) ) ! v forcing - allocate( wprtp_forcing(1:nz) ) ! forcing (microphysics) - allocate( wpthlp_forcing(1:nz) ) ! forcing (microphysics) - allocate( rtp2_forcing(1:nz) ) ! forcing (microphysics) - allocate( thlp2_forcing(1:nz) ) ! forcing (microphysics) - allocate( rtpthlp_forcing(1:nz) ) ! forcing (microphysics) - - ! Imposed large scale w - - allocate( wm_zm(1:nz) ) ! momentum levels - allocate( wm_zt(1:nz) ) ! thermodynamic levels - - ! Cloud water variables - - allocate( rcm(1:nz) ) - allocate( cloud_frac(1:nz) ) - allocate( ice_supersat_frac(1:nz) ) - allocate( rcm_in_layer(1:nz) ) - allocate( cloud_cover(1:nz) ) - - ! Passive scalar variables - ! Note that sclr_dim can be 0 - allocate( wpsclrp_sfc(1:sclr_dim) ) - allocate( sclrm(1:nz, 1:sclr_dim) ) - allocate( sclrp2(1:nz, 1:sclr_dim) ) - allocate( sclrm_forcing(1:nz, 1:sclr_dim) ) - allocate( sclrprtp(1:nz, 1:sclr_dim) ) - allocate( sclrpthlp(1:nz, 1:sclr_dim) ) - - allocate( wpedsclrp_sfc(1:edsclr_dim) ) - allocate( edsclrm_forcing(1:nz, 1:edsclr_dim) ) - - allocate( edsclrm(1:nz, 1:edsclr_dim) ) - allocate( wpsclrp(1:nz, 1:sclr_dim) ) - -!---> h1g, 2010-06-16 -#ifdef GFDL - allocate( RH_crit(1:nz, 1:min(1,sclr_dim), 2) ) -#endif -!<--- h1g, 2010-06-16 - - allocate( sigma_sqd_w(1:nz) ) ! PDF width parameter (momentum levels) - - ! Variables for pdf closure scheme - allocate( pdf_params(1:nz) ) - allocate( pdf_params_frz(1:nz) ) - -!--------- Set initial values for array variables --------- - - ! Prognostic variables - - um(1:nz) = 0.0_core_rknd ! u wind - vm (1:nz) = 0.0_core_rknd ! v wind - - upwp(1:nz) = 0.0_core_rknd ! vertical u momentum flux - vpwp(1:nz) = 0.0_core_rknd ! vertical v momentum flux - - up2(1:nz) = w_tol_sqd ! u'^2 - vp2(1:nz) = w_tol_sqd ! v'^2 - wp2(1:nz) = w_tol_sqd ! w'^2 - - thlm(1:nz) = 0.0_core_rknd ! liquid potential temperature - rtm(1:nz) = 0.0_core_rknd ! total water mixing ratio - wprtp(1:nz) = 0.0_core_rknd ! w'rt' - wpthlp(1:nz) = 0.0_core_rknd ! w'thl' - wprcp(1:nz) = 0.0_core_rknd ! w'rc' - wp3(1:nz) = 0.0_core_rknd ! w'^3 - rtp2(1:nz) = rt_tol**2 ! rt'^2 - thlp2(1:nz) = thl_tol**2 ! thl'^2 - rtpthlp(1:nz) = 0.0_core_rknd ! rt'thl' - - p_in_Pa(1:nz)= 0.0_core_rknd ! pressure (Pa) - exner(1:nz) = 0.0_core_rknd ! exner - rho(1:nz) = 0.0_core_rknd ! density on thermo. levels - rho_zm(1:nz) = 0.0_core_rknd ! density on moment. levels - rho_ds_zm(1:nz) = 0.0_core_rknd ! dry, static density: m-levs - rho_ds_zt(1:nz) = 0.0_core_rknd ! dry, static density: t-levs - invrs_rho_ds_zm(1:nz) = 0.0_core_rknd ! inv. dry, static density: m-levs - invrs_rho_ds_zt(1:nz) = 0.0_core_rknd ! inv. dry, static density: t-levs - thv_ds_zm(1:nz) = 0.0_core_rknd ! dry, base-state theta_v: m-levs - thv_ds_zt(1:nz) = 0.0_core_rknd ! dry, base-state theta_v: t-levs - - thlm_forcing(1:nz) = zero ! thlm large-scale forcing - rtm_forcing(1:nz) = zero ! rtm large-scale forcing - um_forcing(1:nz) = zero ! u forcing - vm_forcing(1:nz) = zero ! v forcing - wprtp_forcing(1:nz) = zero ! forcing (microphysics) - wpthlp_forcing(1:nz) = zero ! forcing (microphysics) - rtp2_forcing(1:nz) = zero ! forcing (microphysics) - thlp2_forcing(1:nz) = zero ! forcing (microphysics) - rtpthlp_forcing(1:nz) = zero ! forcing (microphysics) - - ! Imposed large scale w - - wm_zm(1:nz) = 0.0_core_rknd ! Momentum levels - wm_zt(1:nz) = 0.0_core_rknd ! Thermodynamic levels - - ! Cloud water variables - - rcm(1:nz) = 0.0_core_rknd - cloud_frac(1:nz) = 0.0_core_rknd - ice_supersat_frac(1:nz) = 0.0_core_rknd - rcm_in_layer(1:nz) = 0.0_core_rknd - cloud_cover(1:nz) = 0.0_core_rknd - - sigma_sqd_w = 0.0_core_rknd ! PDF width parameter (momentum levels) - - ! Variables for PDF closure scheme - pdf_params(:)%w1 = zero - pdf_params(:)%w2 = zero - pdf_params(:)%varnce_w1 = zero - pdf_params(:)%varnce_w2 = zero - pdf_params(:)%rt1 = zero - pdf_params(:)%rt2 = zero - pdf_params(:)%varnce_rt1 = zero - pdf_params(:)%varnce_rt2 = zero - pdf_params(:)%thl1 = zero - pdf_params(:)%thl2 = zero - pdf_params(:)%varnce_thl1 = zero - pdf_params(:)%varnce_thl2 = zero - pdf_params(:)%rrtthl = zero - pdf_params(:)%alpha_thl = zero - pdf_params(:)%alpha_rt = zero - pdf_params(:)%crt1 = zero - pdf_params(:)%crt2 = zero - pdf_params(:)%cthl1 = zero - pdf_params(:)%cthl2 = zero - pdf_params(:)%s1 = zero - pdf_params(:)%s2 = zero - pdf_params(:)%stdev_s1 = zero - pdf_params(:)%stdev_s2 = zero - pdf_params(:)%stdev_t1 = zero - pdf_params(:)%stdev_t2 = zero - pdf_params(:)%covar_st_1 = zero - pdf_params(:)%covar_st_2 = zero - pdf_params(:)%corr_st_1 = zero - pdf_params(:)%corr_st_2 = zero - pdf_params(:)%rsl1 = zero - pdf_params(:)%rsl2 = zero - pdf_params(:)%rc1 = zero - pdf_params(:)%rc2 = zero - pdf_params(:)%cloud_frac1 = zero - pdf_params(:)%cloud_frac2 = zero - pdf_params(:)%mixt_frac = zero - - pdf_params_frz(:)%w1 = zero - pdf_params_frz(:)%w2 = zero - pdf_params_frz(:)%varnce_w1 = zero - pdf_params_frz(:)%varnce_w2 = zero - pdf_params_frz(:)%rt1 = zero - pdf_params_frz(:)%rt2 = zero - pdf_params_frz(:)%varnce_rt1 = zero - pdf_params_frz(:)%varnce_rt2 = zero - pdf_params_frz(:)%thl1 = zero - pdf_params_frz(:)%thl2 = zero - pdf_params_frz(:)%varnce_thl1 = zero - pdf_params_frz(:)%varnce_thl2 = zero - pdf_params_frz(:)%rrtthl = zero - pdf_params_frz(:)%alpha_thl = zero - pdf_params_frz(:)%alpha_rt = zero - pdf_params_frz(:)%crt1 = zero - pdf_params_frz(:)%crt2 = zero - pdf_params_frz(:)%cthl1 = zero - pdf_params_frz(:)%cthl2 = zero - pdf_params_frz(:)%s1 = zero - pdf_params_frz(:)%s2 = zero - pdf_params_frz(:)%stdev_s1 = zero - pdf_params_frz(:)%stdev_s2 = zero - pdf_params_frz(:)%stdev_t1 = zero - pdf_params_frz(:)%stdev_t2 = zero - pdf_params_frz(:)%covar_st_1 = zero - pdf_params_frz(:)%covar_st_2 = zero - pdf_params_frz(:)%corr_st_1 = zero - pdf_params_frz(:)%corr_st_2 = zero - pdf_params_frz(:)%rsl1 = zero - pdf_params_frz(:)%rsl2 = zero - pdf_params_frz(:)%rc1 = zero - pdf_params_frz(:)%rc2 = zero - pdf_params_frz(:)%cloud_frac1 = zero - pdf_params_frz(:)%cloud_frac2 = zero - pdf_params_frz(:)%mixt_frac = zero - - ! Surface fluxes - wpthlp_sfc = 0.0_core_rknd - wprtp_sfc = 0.0_core_rknd - upwp_sfc = 0.0_core_rknd - vpwp_sfc = 0.0_core_rknd - -! ---> h1g, 2010-06-16 -! initialize critical relative humidity for liquid and ice nucleation -#ifdef GFDL - RH_crit = 1.0_core_rknd -#endif -!<--- h1g, 2010-06-16 - - ! Passive scalars - do i = 1, sclr_dim, 1 - wpsclrp_sfc(i) = 0.0_core_rknd - - sclrm(1:nz,i) = 0.0_core_rknd - sclrp2(1:nz,i) = 0.0_core_rknd - sclrprtp(1:nz,i) = 0.0_core_rknd - sclrpthlp(1:nz,i) = 0.0_core_rknd - sclrm_forcing(1:nz,i) = 0.0_core_rknd - wpsclrp(1:nz,i) = 0.0_core_rknd - end do - - do i = 1, edsclr_dim, 1 - wpedsclrp_sfc(i) = 0.0_core_rknd - - edsclrm(1:nz,i) = 0.0_core_rknd - edsclrm_forcing(1:nz,i) = 0.0_core_rknd - end do - - return - end subroutine setup_prognostic_variables -!----------------------------------------------------------------------- - subroutine cleanup_prognostic_variables - implicit none - - ! Prognostic variables - - deallocate( um ) ! u wind - deallocate( vm ) ! v wind - - deallocate( upwp ) ! vertical u momentum flux - deallocate( vpwp ) ! vertical v momentum flux - - deallocate( up2, vp2 ) - - deallocate( thlm ) ! liquid potential temperature - -!---> h1g, 2010-06-16 -#ifdef GFDL - deallocate( temp_clubb ) -#endif -!<--- h1g, 2010-06-16 - - deallocate( rtm ) ! total water mixing ratio - deallocate( wprtp ) ! w'rt' - deallocate( wpthlp ) ! w'thl' - deallocate( wprcp ) ! w'rc' - deallocate( wp2 ) ! w'^2 - deallocate( wp3 ) ! w'^3 - deallocate( rtp2 ) ! rt'^2 - deallocate( thlp2 ) ! thl'^2 - deallocate( rtpthlp ) ! rt'thl' - - deallocate( p_in_Pa ) ! pressure - deallocate( exner ) ! exner - deallocate( rho ) ! density: t points - deallocate( rho_zm ) ! density: m points - deallocate( rho_ds_zm ) ! dry, static density: m-levs - deallocate( rho_ds_zt ) ! dry, static density: t-levs - deallocate( invrs_rho_ds_zm ) ! inv. dry, static density: m-levs - deallocate( invrs_rho_ds_zt ) ! inv. dry, static density: t-levs - deallocate( thv_ds_zm ) ! dry, base-state theta_v: m-levs - deallocate( thv_ds_zt ) ! dry, base-state theta_v: t-levs - - deallocate( thlm_forcing ) ! thlm large-scale forcing - deallocate( rtm_forcing ) ! rtm large-scale forcing - deallocate( um_forcing ) ! u forcing - deallocate( vm_forcing ) ! v forcing - deallocate( wprtp_forcing ) ! forcing (microphysics) - deallocate( wpthlp_forcing ) ! forcing (microphysics) - deallocate( rtp2_forcing ) ! forcing (microphysics) - deallocate( thlp2_forcing ) ! forcing (microphysics) - deallocate( rtpthlp_forcing ) ! forcing (microphysics) - - ! Imposed large scale w - - deallocate( wm_zm ) ! momentum levels - deallocate( wm_zt ) ! thermodynamic levels - - ! Cloud water variables - - deallocate( rcm ) - deallocate( cloud_frac ) - deallocate( ice_supersat_frac ) - deallocate( rcm_in_layer ) - deallocate( cloud_cover ) - - deallocate( sigma_sqd_w ) ! PDF width parameter (momentum levels) - - ! Variable for pdf closure scheme - deallocate( pdf_params ) - deallocate( pdf_params_frz ) - - ! Passive scalars - deallocate( wpsclrp_sfc, wpedsclrp_sfc ) - deallocate( sclrm ) - deallocate( sclrp2 ) - deallocate( sclrprtp ) - deallocate( sclrpthlp ) - deallocate( sclrm_forcing ) - deallocate( wpsclrp ) - - deallocate( edsclrm ) - deallocate( edsclrm_forcing ) - -!---> h1g, 2010-06-16 -#ifdef GFDL - deallocate( RH_crit ) -#endif -! <--- h1g, 2010-06-16 - - return - end subroutine cleanup_prognostic_variables - -end module crmx_variables_prognostic_module diff --git a/src/physics/spcam/crm/CLUBB/crmx_variables_radiation_module.F90 b/src/physics/spcam/crm/CLUBB/crmx_variables_radiation_module.F90 deleted file mode 100644 index 3b1886cbae..0000000000 --- a/src/physics/spcam/crm/CLUBB/crmx_variables_radiation_module.F90 +++ /dev/null @@ -1,203 +0,0 @@ -!--------------------------------------------------------------- -! $Id: variables_radiation_module.F90 5982 2012-11-21 19:20:12Z raut@uwm.edu $ -module crmx_variables_radiation_module - -! This module contains definitions of all radiation arrays -! used in the single column model, as well as subroutines to -! allocate, deallocate, and initialize them. -!--------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - - public :: & - setup_radiation_variables, & - cleanup_radiation_variables - - private ! Set Default Scoping - - integer, private, parameter :: dp = selected_real_kind( p=12 ) - - real( kind = core_rknd ), public, dimension(:), allocatable :: & - radht_LW, & ! LW heating rate [K/s] - radht_SW, & ! SW heating rate [K/s] - Frad_SW, & ! SW radiative flux [W/m^2] - Frad_LW ! LW radiative flux [W/m^2] - -!$omp threadprivate(radht_LW, radht_SW, Frad_SW, Frad_LW) - - real(kind = dp), public, dimension(:,:), allocatable :: & - T_in_K, & ! Temperature [K] - rcil, & ! Ice mixing ratio [kg/kg] - o3l ! Ozone mixing ratio [kg/kg] - -!$omp threadprivate(T_in_K, rcil, o3l) - - real(kind = dp), public, dimension(:,:), allocatable :: & - rsnowm_2d,& ! Two-dimensional copies of the input parameters - rcm_in_cloud_2d, & - cloud_frac_2d, & - ice_supersat_frac_2d - -!$omp threadprivate(rsnowm_2d, rcm_in_cloud_2d, cloud_frac_2d) - - real(kind = dp), public, dimension(:,:), allocatable :: & - radht_SW_2d, & ! SW Radiative heating rate [W/m^2] - radht_LW_2d ! LW Radiative heating rate [W/m^2] - -!$omp threadprivate(radht_SW_2d, radht_LW_2d) - - real(kind = dp), public, dimension(:,:), allocatable :: & - Frad_uLW, & ! LW upwelling flux [W/m^2] - Frad_dLW, & ! LW downwelling flux [W/m^2] - Frad_uSW, & ! SW upwelling flux [W/m^2] - Frad_dSW ! SW downwelling flux [W/m^2] - -!$omp threadprivate(Frad_uLW, Frad_dLW, Frad_uSW, Frad_dSW) - - real(kind = dp), public, dimension(:,:), allocatable :: & - fdswcl, & !Downward clear-sky SW flux (W/m^-2). - fuswcl, & !Upward clear-sky SW flux (W/m^-2). - fdlwcl, & !Downward clear-sky LW flux (W/m^-2). - fulwcl !Upward clear-sky LW flux (W/m^-2). - -!$omp threadprivate(fdswcl, fuswcl, fdlwcl, fulwcl) - - ! Constant parameters - integer, private, parameter :: & - nlen = 1, & ! Length of the total domain - slen = 1 ! Length of the sub domain - - contains - - !--------------------------------------------------------------------- - subroutine setup_radiation_variables( nzmax, lin_int_buffer, & - extend_atmos_range_size ) - ! Description: - ! Allocates and initializes prognostic scalar and array variables - ! for the CLUBB model code. - !--------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - core_rknd ! Variable(s) - - implicit none - - ! Input Variables - integer, intent(in) :: & - nzmax, & ! Number of grid levels [-] - lin_int_buffer,& ! Number of interpolated levels between the computational - ! grid and the extended atmosphere [-] - extend_atmos_range_size ! The number of levels in the extended atmosphere [-] - - ! Local Variables - - integer :: rad_zt_dim, rad_zm_dim ! Dimensions of the radiation grid - - !----------------------------BEGIN CODE------------------------------- - - rad_zt_dim = (nzmax-1)+lin_int_buffer+extend_atmos_range_size - rad_zm_dim = (nzmax-1)+lin_int_buffer+extend_atmos_range_size+1 - - - ! --- Allocation --- - - allocate( radht_SW(1:nzmax) ) - allocate( radht_LW(1:nzmax) ) - allocate( Frad_SW(1:nzmax) ) - allocate( Frad_LW(1:nzmax) ) - - allocate( T_in_K(nlen, rad_zt_dim ) ) - allocate( rcil(nlen, rad_zt_dim ) ) - allocate( o3l(nlen, rad_zt_dim ) ) - - allocate( rsnowm_2d(nlen, rad_zt_dim ) ) - allocate( rcm_in_cloud_2d(nlen, rad_zt_dim ) ) - allocate( cloud_frac_2d(nlen, rad_zt_dim ) ) - allocate( ice_supersat_frac_2d(nlen, rad_zt_dim ) ) - - allocate( radht_SW_2d(nlen, rad_zt_dim ) ) - allocate( radht_LW_2d(nlen, rad_zt_dim ) ) - - allocate( Frad_uLW(nlen, rad_zm_dim ) ) - allocate( Frad_dLW(nlen, rad_zm_dim ) ) - allocate( Frad_uSW(nlen, rad_zm_dim ) ) - allocate( Frad_dSW(nlen, rad_zm_dim ) ) - - allocate( fdswcl(slen, rad_zm_dim ) ) - allocate( fuswcl(slen, rad_zm_dim ) ) - allocate( fdlwcl(slen, rad_zm_dim ) ) - allocate( fulwcl(slen, rad_zm_dim ) ) - - - ! --- Initialization --- - - radht_SW = 0.0_core_rknd - radht_LW = 0.0_core_rknd - Frad_SW = 0.0_core_rknd - Frad_LW = 0.0_core_rknd - T_in_K = 0.0_dp - rcil = 0.0_dp - o3l = 0.0_dp - rsnowm_2d = 0.0_dp - rcm_in_cloud_2d = 0.0_dp - cloud_frac_2d = 0.0_dp - ice_supersat_frac_2d = 0.0_dp - radht_SW_2d = 0.0_dp - radht_LW_2d = 0.0_dp - Frad_uLW = 0.0_dp - Frad_dLW = 0.0_dp - Frad_uSW = 0.0_dp - Frad_dSW = 0.0_dp - fdswcl = 0.0_dp - fuswcl = 0.0_dp - fdlwcl = 0.0_dp - fulwcl = 0.0_dp - - end subroutine setup_radiation_variables - - !--------------------------------------------------------------------- - subroutine cleanup_radiation_variables( ) - - ! Description: - ! Subroutine to deallocate variables defined in module global - !--------------------------------------------------------------------- - - implicit none - - ! --- Deallocate --- - - deallocate( radht_SW ) - deallocate( radht_LW ) - deallocate( Frad_SW ) - deallocate( Frad_LW ) - - deallocate( T_in_K ) - deallocate( rcil ) - deallocate( o3l ) - - deallocate( rsnowm_2d ) - deallocate( rcm_in_cloud_2d ) - deallocate( cloud_frac_2d ) - deallocate( ice_supersat_frac_2d ) - - deallocate( radht_SW_2d ) - deallocate( radht_LW_2d ) - - deallocate( Frad_uLW ) - deallocate( Frad_dLW ) - deallocate( Frad_uSW ) - deallocate( Frad_dSW ) - - deallocate( fdswcl ) - deallocate( fuswcl ) - deallocate( fdlwcl ) - deallocate( fulwcl ) - - end subroutine cleanup_radiation_variables - - -end module crmx_variables_radiation_module diff --git a/src/physics/spcam/crm/CLUBB/recl.inc b/src/physics/spcam/crm/CLUBB/recl.inc deleted file mode 100644 index 267b70e4db..0000000000 --- a/src/physics/spcam/crm/CLUBB/recl.inc +++ /dev/null @@ -1,26 +0,0 @@ -!------------------------------------------------------------------------------- -! $Id: recl.inc 5623 2012-01-17 17:55:26Z connork@uwm.edu $ -! Description: -! Preprocessing rules for determining how large an unformatted -! data record is when using Fortran write. This does not affect -! netCDF output at all. - -! Notes: -! New directives will need to be added to port CLUBB GrADS output -! to new compilers that do not use byte size record lengths. - -! Early Alpha processors lacked the ability to work with anything -! smaller than a 32 bit word, so DEC Fortran and its successors -! (Compaq Visual Fortran, newer Intel Fortran, etc.) all use 4 -! byte records. Note that specifying byterecl on Alpha still -! results in a performance hit, even on newer chips. -!------------------------------------------------------------------------------- -#if defined GFDL /* F_RECL should be 4 for the GFDL SCM-CLUBB */ -# define F_RECL 4 -#elif defined __INTEL_COMPILER && __INTEL_COMPILER >= 800 /* Versions of Intel fortran > 8.0_core_rknd */ -# define F_RECL 1 -#elif defined(__alpha) /* Assume 4 byte word on Alpha processors */ -# define F_RECL 1 -#else -# define F_RECL 4 /* Most compilers and computers */ -#endif diff --git a/src/physics/spcam/crm/MICRO_M2005/README.MICRO_M2005 b/src/physics/spcam/crm/MICRO_M2005/README.MICRO_M2005 deleted file mode 100644 index 5caa0589b0..0000000000 --- a/src/physics/spcam/crm/MICRO_M2005/README.MICRO_M2005 +++ /dev/null @@ -1,121 +0,0 @@ -README for Morrison et al (2005) microphysics. - -The two-moment, five-class bulk microphysical scheme of Morrison et al -(2005) has been ported to SAM through the addition of an interface to -the WRF implementation of Morrison's scheme. Here, SAM directly -interfaces with the 1D version of the scheme in the WRF -implementation. Several microphysical options in the WRF -implementation are accessible here, through the specification of -parameters in the namelist MICRO_M2005, which should be placed in the -prm file and are listed below. The scheme will use an increasing -number of microphysical variables, depending on the options specified -in the PARAMETERS and MICRO_M2005 namelists. - - - QT, total water (vapor + cloud liquid) mass mixing ratio (units: kg/kg) - - NC, cloud water number mixing ratio (units: #/kg), used if dopredictNc=.true. - - QR, rain mass mixing ratio (units: kg/kg), used if doprecip=.true. - - NR, rain number mixing ratio (units: #/kg), used if doprecip=.true. - - QI, cloud ice mass mixing ratio (units: kg/kg), used if doicemicro=.true. - - NI, cloud ice number mixing ratio (units: #/kg), used if doicemicro=.true. - - QS, snow mass mixing ratio (units: kg/kg), used if doicemicro=.true. - - NS, snow number mixing ratio (units: #/kg), used if doicemicro=.true. - - QG, graupel mass mixing ratio (units: kg/kg), used if doicemicro=.true. - - NG, graupel number mixing ratio (units: #/kg), used if doicemicro=.true. - -The scheme will not run for the following combinations of parameters: - - + doprecip=.false. and doicemicro=.true. (doprecip=.false. only works for water clouds) - + dograupel=.true. and doicemicro=.false. (Need ice to make graupel) - + dohail=.true. and dograupel=.false. (Hail is an option for the graupel species) - -Note that the options docloud and doprecip appear in the PARAMETERS -namelist. Other options are in the MICRO_M2005 namelist and are -discussed below. - -MICRO_M2005 namelist options: - -doicemicro (logical, default=.true.): Add cloud ice and snow - microphysical species. Each species will be represented by two - prognostic variables: a mass mixing ratio and a number concentration. - -dograupel (logical, default=.true.): Add graupel as a microphysical - species. Prognostic variables for mass mixing ratio and number - concentration. - -dosb_warm_rain (logical, default=.false.): If true, use Seifert & - Beheng (2001) warm rain parameterization in place of the default - Khairoutdinov & Kogan (2000) scheme. - -dopredictNc (logical, default=.true.): Predict cloud water droplet - number concentration. Manner of droplet activation is controlled by - dospecifyaerosol. - -Nc0 (real, default=100.): If dopredictNc=.false., Nc0 is the cloud - droplet number concentration for all time. If dopredictNc=.true., Nc0 - is the initial cloud droplet number concentration if cloud exists in - the initial sounding. - -dospecifyaerosol (logical, default=.false.): If true, two modes of - aerosol (from which the cloud water droplets will be activated) can be - specified. Otherwise, a power-law activaton scheme is used. - -If dospecifyaerosol=.false., cloud droplet activation is controlled by - (defaults come from maritime values adapted from Rasmussen et al 2002 - by Hugh Morrison, suggested continental values are 1000., 0.5): - - ccnconst (real, default=120.): constant in N_{ccn} = C*S^K - where S is supersaturation. Units are cm^{-3}, I believe. - ccnexpnt (real, default=0.4): exponent in N_{ccn} = C*S^K. - -If dospecifyaerosol=.true., cloud droplet activation is controlled by - (defaults from MPACE, note that aerosol properties are currently set - up for ammonium sulfate): - - aer_rm1 (real, default=0.052): geometric mean radius (in microns) of - aerosol size distribution of aerosol mode 1. - aer_sig1 (real, default=2.04): geometric standard deviation of mode 1. - aer_n1 (real, default=72.2): number concentration (in #/cm3) of mode 1. - - aer_rm2 (real, default=1.3): geometric mean radius (in microns) of - aerosol size distribution of aerosol mode 2. - aer_sig2 (real, default=2.5): geometric standard deviation of mode 2. - aer_n2 (real, default=1.8): number concentration (in #/cm3) of mode 2. - -dosubgridw (logical, default=.false.): NOT IMPLEMENTED YET. In large - grid spacing simulations, this option would allow cloud droplet - activation to incorporate information about subgrid variations in - vertical velocity. - -doarcticicenucl (logical, default=.false): If true, use MPACE - observations for ice nucleation conditions. If false, use - mid-latitude formula from Rasmussen et al (2002). - -docloudedgeactivation (logical, default=.false.): Explanation from - Hugh Morrison in the code: - - If true, neglect droplet activation at lateral cloud edges due to - unresolved entrainment and mixing. Activate at cloud base - or in region with little cloud water using non-equlibrium - supersaturation assuming no initial cloud water. In cloud - interior activate using equilibrium supersaturation - - - If false, assume droplet activation at lateral cloud edges due to - unresolved entrainment and mixing dominates. Activate - droplets everywhere in the cloud using non-equilibrium - supersaturation assuming no initial cloud water, based on - the local sub-grid and/or grid-scale vertical velocity at - the grid point. - -dofix_pgam (logical, default=.false.): Fix the exponent in the Gamma - distribution approximation to the cloud water droplet size - distribution. If true, the value from pgam_fixed is used. If - false, a diagnostic relationship from observations that expressed - the exponent as a function of the number concentration is used: - - pgam = 0.2714 + 0.00057145*Nc where Nc has units of #/cm3 - -pgam_fixed (real, default=5.): Value of exponent used if - dofix_pgam=.true. - - diff --git a/src/physics/spcam/crm/MICRO_M2005/crmx_drop_activation.F90 b/src/physics/spcam/crm/MICRO_M2005/crmx_drop_activation.F90 deleted file mode 100644 index bdbf3b2f5e..0000000000 --- a/src/physics/spcam/crm/MICRO_M2005/crmx_drop_activation.F90 +++ /dev/null @@ -1,373 +0,0 @@ -module crmx_drop_activation -#ifdef MODAL_AERO -!---------------------------------------------------------------------------------------------------- -! -! Purposes: calcualte dropelt number concentration activated from aerosol particle, used -! in Morrison's two-moment microphysics in SAM. It treats multimode aerosol population, -! and aerosol fields are taken from the modal aerosol treatment in CAM. -! -! Method: This module is adopted from the module of ndrop used in CAM, originally writted by -! Steven Ghan. -! -! Revision history: -! July, 2009: adopted from the module of ndrop used in CAM. -! -!---------------------------------------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use modal_aero_data, only: ntot_amode - - implicit none - private - save - - public :: drop_activation_init, drop_activation_Ghan - - real(r8),allocatable :: npv(:) ! number per volume concentration - real(r8),allocatable :: alogsig(:) ! natl log of geometric standard dev of aerosol - real(r8),allocatable :: exp45logsig(:) - real(r8),allocatable :: argfactor(:) - real(r8),allocatable :: f1(:),f2(:) ! abdul-razzak functions of width - - real(r8) :: t0 ! reference temperature - real(r8) :: aten - real(r8) :: surften ! surface tension of water w/respect to air (N/m) - real(r8) :: alogten,alog2,alog3,alogaten - real(r8) :: third, twothird, sixth, zero - real(r8) :: sq2, sqpi, pi - -contains -!---------------------------------------------------------------------------------- - -!================================================================================== -subroutine drop_activation_init -!------------------------------------------------------------------------ -! Initialize constants, and prescribed parameters. -!----------------------------------------------------------------------- - use modal_aero_data - use physconst, only: rhoh2o, mwh2o, r_universal - implicit none - - integer l,m - real(r8) arg - -! mathematical constants - - zero=0._r8 - third=1./3._r8 - twothird=2.*third - sixth=1./6._r8 - sq2=sqrt(2._r8) - pi=4._r8*atan(1.0_r8) - sqpi=sqrt(pi) - - t0=273. - surften=0.076_r8 - aten=2.*mwh2o*surften/(r_universal*t0*rhoh2o) - alogaten=log(aten) - alog2=log(2._r8) - alog3=log(3._r8) - - if (.not. allocated(npv)) allocate (npv(ntot_amode)) - if (.not. allocated(alogsig)) allocate (alogsig(ntot_amode)) - if (.not. allocated(exp45logsig)) allocate (exp45logsig(ntot_amode)) - if (.not. allocated(argfactor)) allocate (argfactor(ntot_amode)) - if (.not. allocated(f1)) allocate (f1(ntot_amode)) - if (.not. allocated(f2)) allocate (f2(ntot_amode)) - - do m=1,ntot_amode -! use only if width of size distribution is prescribed - alogsig(m)=log(sigmag_amode(m)) - exp45logsig(m)=exp(4.5*alogsig(m)*alogsig(m)) - argfactor(m)=2./(3.*sqrt(2.)*alogsig(m)) - f1(m)=0.5*exp(2.5*alogsig(m)*alogsig(m)) - f2(m)=1.+0.25*alogsig(m) - end do - - return -end subroutine drop_activation_init -!------------------------------------------------------------------------------------------------------- - -!======================================================================================================= -subroutine drop_activation_Ghan(wnuc4, tair4, rhoair4, & - ndrop4, ines, smaxinout4, k) -!------------------------------------------------------------------------------------------------------- -! -! Purpose and method: calculates number, surface, and mass fraction of aerosols activated as CCN -! calculates flux of cloud droplets, surface area, and aerosol mass into cloud -! assumes an internal mixture within each of up to pmode multiple aerosol modes -! a gaussiam spectrum of updrafts can be treated. - -! mks units - -! Abdul-Razzak and Ghan, A parameterization of aerosol activation. -! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844. -! -! Revision history: -! 2009-07-17: Originally written by Gteven Ghan, and adopted by Minghuai Wang. -! -!------------------------------------------------------------------------------------------------------------ - - use physconst, only: rair, epsilo, cpair, rh2o, latvap, gravit, & - rhoh2o, mwh2o, r_universal - use wv_saturation, only: estblf - use physconst, only: epsqs => epsilo - use shr_spfn_mod, only: erf => shr_spfn_erf - use modal_aero_data - use crmx_vars, only: naer, vaer, hgaer - - implicit none - - -! Input - real, intent (in) :: wnuc4 ! updraft velocity (m/s) - real, intent (in) :: tair4 ! air temperature (K) - real, intent (in) :: rhoair4 ! air density (kg/m3) - integer, intent(in) :: ines ! whether non-equillium saturation is used (ines=1: used). - real, intent (inout) :: smaxinout4 ! For ines=1, it is non-equlibrium saturation ratio (input) - ! for ines=0, it is smax calculted from the activation parameterizaiton (output). - integer, intent(in) :: k ! the index of vertical levels. - -! Output - real, intent (out) :: ndrop4 ! activated droplet number concentration - - -! Local - real(r8) :: wnuc ! updraft velocity (m/s) - real(r8) :: tair ! air temperature (K) - real(r8) :: rhoair ! air density (kg/m3) - real(r8) na(ntot_amode) ! aerosol number concentration (/m3) - integer nmode ! number of aerosol modes - real(r8) volume(ntot_amode) ! aerosol volume concentration (m3/m3) - real(r8) hygro(ntot_amode) ! hygroscopicity of aerosol mode - - real(r8) fn(ntot_amode) ! number fraction of aerosols activated - real(r8) fm(ntot_amode) ! mass fraction of aerosols activated - real(r8) fluxn(ntot_amode) ! flux of activated aerosol number fraction into cloud (cm/s) - real(r8) fluxm(ntot_amode) ! flux of activated aerosol mass fraction into cloud (cm/s) - real(r8) flux_fullact ! flux of activated aerosol fraction assuming 100% activation (cm/s) - ! rce-comment - ! used for consistency check -- this should match (ekd(k)*zs(k)) - ! also, fluxm/flux_fullact gives fraction of aerosol mass flux - ! that is activated -! local - - real(r8), parameter :: p0 = 1013.25e2_r8 ! reference pressure (Pa) - real(r8) sign(ntot_amode) ! geometric standard deviation of size distribution - real(r8) pres ! pressure (Pa) - real(r8) diff0 ! diffusivity (m2/s) - real(r8) conduct0 ! thermal conductivity (Joule/m/sec/deg) - real(r8) es ! saturation vapor pressure - real(r8) qs ! water vapor saturation mixing ratio - real(r8) dqsdt ! change in qs with temperature - real(r8) dqsdp ! change in qs with pressure - real(r8) g ! thermodynamic function (m2/s) - real(r8) zeta(ntot_amode), eta(ntot_amode) - real(r8) lnsmax ! ln(smax) - real(r8) alpha - real(r8) gamma - real(r8) beta - real(r8) sqrtg(ntot_amode) - real(r8) :: amcube(ntot_amode) ! cube of dry mode radius (m) - real(r8) :: lnsm(ntot_amode) ! ln(smcrit) - real(r8) smc(ntot_amode) ! critical supersaturation for number mode radius - real(r8) alw,sqrtalw - real(r8) smax - real(r8) x,arg - real(r8) xmincoeff - real(r8) z - real(r8) etafactor1,etafactor2(ntot_amode),etafactor2max - real(r8) wmaxf ! maximum update velocity [m/s] - real ndrop_act - integer m,n -! numerical integration parameters - real(r8), parameter :: eps=0.3_r8,fmax=0.99_r8,sds=3._r8 - - real(r8), parameter :: namin=1.e6_r8 ! minimum aerosol number concentration (/m3) - - wnuc = wnuc4 - tair = tair4 - rhoair = rhoair4 - -! Set aerosol fields - na = naer(k, :) - volume = vaer(k, :) - hygro = hgaer(k, :) - - nmode = ntot_amode - wmaxf = 10.0 - - fn(:)=0._r8 - fm(:)=0._r8 - fluxn(:)=0._r8 - fluxm(:)=0._r8 - flux_fullact=0._r8 - ndrop4 = 0. - ndrop_act = 0. - - if(nmode.eq.1.and.na(1).lt.1.e-20_r8)return - - pres=rair*rhoair*tair - diff0=0.211e-4_r8*(p0/pres)*(tair/t0)**1.94 - conduct0=(5.69_r8+0.017_r8*(tair-t0))*4.186e2_r8*1.e-5_r8 ! convert to J/m/s/deg - es = estblf(tair) - qs = epsilo*es/(pres-(1.0_r8 - epsqs)*es) - dqsdt=latvap/(rh2o*tair*tair)*qs - alpha=gravit*(latvap/(cpair*rh2o*tair*tair)-1./(rair*tair)) - gamma=(1+latvap/cpair*dqsdt)/(rhoair*qs) - etafactor2max=1.e10/(alpha*wmaxf)**1.5 ! this should make eta big if na is very small. - - do m=1,nmode - if(volume(m).gt.1.e-39_r8.and.na(m).gt.1.e-39_r8)then -! number mode radius (m) -! write(6,*)'alogsig,volc,na=',alogsig(m),volc(m),na(m) - amcube(m)=(3.*volume(m)/(4.*pi*exp45logsig(m)*na(m))) ! only if variable size dist -! growth coefficent Abdul-Razzak & Ghan 1998 eqn 16 -! should depend on mean radius of mode to account for gas kinetic effects -! see Fountoukis and Nenes, JGR2005 and Meskhidze et al., JGR2006 -! for approriate size to use for effective diffusivity. - g=1._r8/(rhoh2o/(diff0*rhoair*qs) & - +latvap*rhoh2o/(conduct0*tair)*(latvap/(rh2o*tair)-1._r8)) - sqrtg(m)=sqrt(g) - beta=2._r8*pi*rhoh2o*g*gamma - etafactor2(m)=1._r8/(na(m)*beta*sqrtg(m)) - if(hygro(m).gt.1.e-10)then - smc(m)=2.*aten*sqrt(aten/(27.*hygro(m)*amcube(m))) ! only if variable size dist - else - smc(m)=100. - endif -! write(6,*)'sm,hygro,amcube=',smcrit(m),hygro(m),amcube(m) - else - g=1._r8/(rhoh2o/(diff0*rhoair*qs) & - +latvap*rhoh2o/(conduct0*tair)*(latvap/(rh2o*tair)-1._r8)) - sqrtg(m)=sqrt(g) - smc(m)=1._r8 - etafactor2(m)=etafactor2max ! this should make eta big if na is very small. - endif - lnsm(m)=log(smc(m)) ! only if variable size dist -! write(6,'(a,i4,4g12.2)')'m,na,amcube,hygro,sm,lnsm=', & -! m,na(m),amcube(m),hygro(m),sm(m),lnsm(m) - enddo - -! single updraft - - if(wnuc.gt.0._r8)then - - alw=alpha*wnuc - sqrtalw=sqrt(alw) - etafactor1=alw*sqrtalw - - do m=1,nmode - eta(m)=etafactor1*etafactor2(m) - zeta(m)=twothird*sqrtalw*aten/sqrtg(m) - enddo - - call maxsat(zeta,eta,nmode,smc,smax) - - lnsmax=log(smax) - xmincoeff=alogaten-twothird*(lnsmax-alog2)-alog3 - - do m=1,nmode -! modal - x=twothird*(lnsm(m)-lnsmax)/(sq2*alogsig(m)) - fn(m)=0.5_r8*(1._r8-erf(x)) - arg=x-1.5_r8*sq2*alogsig(m) - fm(m)=0.5_r8*(1._r8-erf(arg)) - if(wnuc.gt.0._r8)then - fluxn(m)=fn(m)*wnuc - fluxm(m)=fm(m)*wnuc - endif - ndrop_act = ndrop_act + fn(m) * na (m) - enddo - flux_fullact = wnuc - - if(ines.eq.0) then - ndrop4 = ndrop_act - smaxinout4 = smax - else if(ines.eq.1) then -! for non-equlibrium ss - smax = smaxinout4 - lnsmax=log(smax) - xmincoeff=alogaten-twothird*(lnsmax-alog2)-alog3 - - do m=1,nmode -! modal - x=twothird*(lnsm(m)-lnsmax)/(sq2*alogsig(m)) - fn(m)=0.5_r8*(1._r8-erf(x)) - arg=x-1.5_r8*sq2*alogsig(m) - fm(m)=0.5_r8*(1._r8-erf(arg)) - if(wnuc.gt.0._r8)then - fluxn(m)=fn(m)*wnuc - fluxm(m)=fm(m)*wnuc - endif - ndrop4 = ndrop4 + fn(m) * na (m) - enddo - flux_fullact = wnuc - ndrop4 = min(ndrop4, ndrop_act) - end if - - endif - -! sensitivity tests: -! ndrop4 = max(ndrop4, 100.*1.0e6) ! the minimum activated droplet number is 100 /cm3 - - return -end subroutine drop_activation_Ghan -!---------------------------------------------------------------------------------------- - -!======================================================================================= - subroutine maxsat(zeta,eta,nmode,smc,smax) - -! calculates maximum supersaturation for multiple -! competing aerosol modes. - -! Abdul-Razzak and Ghan, A parameterization of aerosol activation. -! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844. - - implicit none - - integer nmode ! number of modes - real(r8) smc(ntot_amode) ! critical supersaturation for number mode radius - real(r8) zeta(ntot_amode), eta(ntot_amode) - real(r8) smax ! maximum supersaturation - integer m ! mode index - real(r8) sum, g1, g2, g1sqrt, g2sqrt - - do m=1,nmode - if(zeta(m).gt.1.e5_r8*eta(m).or.smc(m)*smc(m).gt.1.e5_r8*eta(m))then -! weak forcing. essentially none activated - smax=1.e-20_r8 - else -! significant activation of this mode. calc activation all modes. - go to 1 - endif - enddo - - return - - 1 continue - - sum=0 - do m=1,nmode - if(eta(m).gt.1.e-20_r8)then - g1=zeta(m)/eta(m) - g1sqrt=sqrt(g1) - g1=g1sqrt*g1 - g2=smc(m)/sqrt(eta(m)+3._r8*zeta(m)) - g2sqrt=sqrt(g2) - g2=g2sqrt*g2 - sum=sum+(f1(m)*g1+f2(m)*g2)/(smc(m)*smc(m)) - else - sum=1.e20_r8 - endif - enddo - - smax=1._r8/sqrt(sum) - - return - -end subroutine maxsat -!-------------------------------------------------------------------------------------- - -#endif -end module crmx_drop_activation - diff --git a/src/physics/spcam/crm/MICRO_M2005/crmx_microphysics.F90 b/src/physics/spcam/crm/MICRO_M2005/crmx_microphysics.F90 deleted file mode 100644 index 851ecafaf1..0000000000 --- a/src/physics/spcam/crm/MICRO_M2005/crmx_microphysics.F90 +++ /dev/null @@ -1,1660 +0,0 @@ -module crmx_microphysics - -! main interface to Morrison microphysics. -! original implementation by Peter Blossey, UW - -use crmx_params, only: lcond, lsub, fac_cond, fac_sub, ggr - -use crmx_grid, only: nx,ny,nzm,nz, & !grid dimensions; nzm = nz-1 # of scalar lvls - dimx1_s,dimx2_s,dimy1_s,dimy2_s, & ! actual scalar-array dimensions in x,y - dz, adz, dostatis, masterproc, & - doSAMconditionals, dosatupdnconditionals - -use crmx_vars, only: pres, rho, dt, dtn, w, t, tlatqi, condavg_mask, & - ncondavg, condavgname, condavglongname -use crmx_vars, only: tke2, tk2 -use crmx_params, only: doprecip, docloud, doclubb - -use crmx_module_mp_GRAUPEL, only: GRAUPEL_INIT, M2005MICRO_GRAUPEL, & - doicemicro, & ! use ice species (snow/cloud ice/graupel) - dograupel, & ! use graupel - dohail, & ! use graupel - dosb_warm_rain, & ! use Seifert & Beheng (2001) warm rain parameterization - dopredictNc, & ! prediction of cloud droplet number - aerosol_mode, & ! specify two modes of (sulfate) aerosol -#if (defined CRM && defined MODAL_AERO) - domodal_aero, & ! use modal aerosol from the CAM -#endif -#ifdef CLUBB_CRM - doclubb_tb, & ! use CLUBB as turbulence scheme only, but not cloud scheme, - ! so liquid water is diagnosed from saturation adjustment - doclubb_gridmean, & ! feed grid-mean CLUBB values into Morrision microphysics - doclubb_autoin, & ! use in-cloud values for autoconversion calculations -#endif - dosubgridw, & ! input estimate of subgrid w to microphysics - doarcticicenucl,& ! use arctic parameter values for ice nucleation - docloudedgeactivation,&! activate droplets at cloud edges as well as base - Nc0, & ! initial/specified cloud droplet number conc (#/cm3) - ccnconst, ccnexpnt, & ! parameters for aerosol_mode=1 (powerlaw CCN) - aer_rm1, aer_rm2, & ! two modes of aerosol for aerosol_mode=2 - aer_n1, aer_n2, & ! rm=geometric mean radius (um), n=aerosol conc. (#/cm3) - aer_sig1, aer_sig2, & ! sig=geom standard deviation of aerosol size distn. - dofix_pgam, pgam_fixed ! option to specify pgam (exponent of cloud water's gamma distn) - -#ifdef CRM - use cam_abortutils, only: endrun -#endif - -implicit none - -logical :: isallocatedMICRO = .false. - -integer :: nmicro_fields ! total number of prognostic water vars - -real, allocatable, dimension(:,:,:,:) :: micro_field ! holds mphys quantities - -! indices of water quantities in micro_field, e.g. qv = micro_field(:,:,:,iqv) -integer :: iqv, iqci, iqr, iqs, iqg, incl, inci, inr, ins, ing -integer :: index_water_vapor ! separate water vapor index used by SAM - -real, allocatable, dimension(:) :: lfac -integer, allocatable, dimension(:) :: flag_wmass, flag_precip, flag_number -integer, allocatable, dimension(:) :: flag_micro3Dout - -integer, parameter :: index_cloud_ice = -1 ! historical variable (don't change) - -real, allocatable, dimension(:,:,:) :: fluxbmk, fluxtmk !surface/top fluxes -real, allocatable, dimension(:,:,:) :: reffc, reffi -real, allocatable, dimension(:,:,:) :: cloudliq - -real, allocatable, dimension(:,:) :: & ! statistical arrays - mkwle, & ! resolved vertical flux - mkwsb, & ! SGS vertical flux - mksed, & ! sedimentation vertical flux - mkadv, & ! tendency due to vertical advection - mkdiff, &! tendency due to vertical diffusion - mklsadv, & ! tendency due to large-scale vertical advection - mfrac, & ! fraction of domain with microphysical quantity > 1.e-6 - stend, & ! tendency due to sedimentation - mtend, & ! tendency due to microphysical processes (other than sedimentation) - mstor, & ! storage terms of microphysical variables - trtau ! optical depths of various species - -real, allocatable, dimension(:) :: tmtend - -real :: sfcpcp, sfcicepcp - -! arrays with names/units for microphysical outputs in statistics. -character*3, allocatable, dimension(:) :: mkname -character*80, allocatable, dimension(:) :: mklongname -character*10, allocatable, dimension(:) :: mkunits -real, allocatable, dimension(:) :: mkoutputscale -logical douse_reffc, douse_reffi - -! You can also have some additional, diagnostic, arrays, for example, total -! nonprecipitating cloud water, etc: - -!bloss: array which holds temperature tendency due to microphysics -real, allocatable, dimension(:,:,:), SAVE :: tmtend3d - -#ifdef CRM -real, allocatable, dimension(:) :: qpevp !sink of precipitating water due to evaporation (set to zero here) -real, allocatable, dimension(:) :: qpsrc !source of precipitation microphysical processes (set to mtend) -#endif - -real, allocatable, dimension(:,:,:) :: wvar ! the vertical velocity variance from subgrid-scale motion, - ! which is needed in droplet activation. -#ifdef CRM -! hm 7/26/11 new output -real, public, allocatable, dimension(:,:,:) :: aut1 ! -real, public, allocatable, dimension(:,:,:) :: acc1 ! -real, public, allocatable, dimension(:,:,:) :: evpc1 ! -real, public, allocatable, dimension(:,:,:) :: evpr1 ! -real, public, allocatable, dimension(:,:,:) :: mlt1 ! -real, public, allocatable, dimension(:,:,:) :: sub1 ! -real, public, allocatable, dimension(:,:,:) :: dep1 ! -real, public, allocatable, dimension(:,:,:) :: con1 ! - -real, public, allocatable, dimension(:,:,:) :: aut1a ! -real, public, allocatable, dimension(:,:,:) :: acc1a ! -real, public, allocatable, dimension(:,:,:) :: evpc1a ! -real, public, allocatable, dimension(:,:,:) :: evpr1a ! -real, public, allocatable, dimension(:,:,:) :: mlt1a ! -real, public, allocatable, dimension(:,:,:) :: sub1a ! -real, public, allocatable, dimension(:,:,:) :: dep1a ! -real, public, allocatable, dimension(:,:,:) :: con1a ! -#endif - -!+++mhwangtest -! test water conservation -real, public, allocatable, dimension(:, :) :: sfcpcp2D ! surface precipitation -!---mhwangtest - -CONTAINS - -!---------------------------------------------------------------------- -!!! Read microphysical options from prm file and allocate variables -! -subroutine micro_setparm() - use crmx_vars -#ifdef CLUBB_CRM - use crmx_module_mp_graupel, only: NNUCCD_REDUCE_COEF, NNUCCC_REDUCE_COEF -#endif - implicit none - - integer ierr, ios, ios_missing_namelist, place_holder - - NAMELIST /MICRO_M2005/ & -#ifdef CLUBB_CRM - NNUCCD_REDUCE_COEF, NNUCCC_REDUCE_COEF, & -#endif - doicemicro, & ! use ice species (snow/cloud ice/graupel) - dograupel, & ! use graupel - dohail, & ! graupel species has qualities of hail - dosb_warm_rain, & ! use Seifert & Beheng (2001) warm rain parameterization in place of KK(2000) - dopredictNc, & ! prediction of cloud droplet number - aerosol_mode, & ! specify two modes of (sulfate) aerosol - dosubgridw, & ! input estimate of subgrid w to microphysics - doarcticicenucl,& ! use arctic parameter values for ice nucleation - docloudedgeactivation,&! activate droplets at cloud edges as well as base - Nc0, & ! initial/specified cloud droplet number conc (#/cm3) - ccnconst, ccnexpnt, & ! parameters for aerosol_mode=1 (powerlaw CCN) - aer_rm1, aer_rm2, & ! two modes of aerosol for aerosol_mode=2 - aer_n1, aer_n2, & ! rm=geometric mean radius (um), n=aerosol conc. (#/cm3) - aer_sig1, aer_sig2, & ! sig=geom standard deviation of aerosol size distn. - dofix_pgam, pgam_fixed, & ! option to specify pgam (exponent of cloud water's gamma distn) - douse_reffc, & ! use computed effective radius in radiation computation - douse_reffi ! use computed effective ice size in radiation computation - - !bloss: Create dummy namelist, so that we can figure out error code - ! for a mising namelist. This lets us differentiate between - ! missing namelists and those with an error within the namelist. - NAMELIST /BNCUIODSBJCB/ place_holder - - ! define default values for namelist variables - doicemicro = .true. ! use ice - dograupel = .true. ! use graupel - dohail = .false. ! graupel species has properties of graupel - dosb_warm_rain = .false. ! use KK (2000) warm rain scheme by default - dopredictNc = .true. ! prognostic cloud droplet number -#if (defined CRM && defined MODAL_AERO) - domodal_aero = .true. ! use modal aerosol -#endif -#ifdef CLUBB_CRM - dosubgridw = .true. ! Use clubb's w'^2 for sgs w - aerosol_mode = 2 ! use lognormal CCN relationship - doarcticicenucl = .false. ! use mid-latitude parameters - docloudedgeactivation = .false. ! activate droplets at cloud base, and edges - doclubb_tb = .false. - doclubb_gridmean = .true. - doclubb_autoin = .false. -#else - aerosol_mode = 2 - dosubgridw = .true. - doarcticicenucl = .false. ! use mid-latitude parameters - docloudedgeactivation = .true. -#endif /*CLUBB_CRM*/ - douse_reffc = .false. ! use computed effective radius in rad computations? - douse_reffi = .false. ! use computed effective radius in rad computations? - - Nc0 = 100. ! default droplet number concentration - - ccnconst = 120. ! maritime value (/cm3), adapted from Rasmussen - ccnexpnt = 0.4 ! et al (2002) by Hugh Morrison et al. Values - ! of 1000. and 0.5 suggested for continental -! aer_rm1 = 0.052 ! two aerosol mode defaults from MPACE (from Hugh) -! aer_sig1 = 2.04 -! aer_n1 = 72.2 -! aer_rm2 = 1.3 -! aer_sig2 = 2.5 -! aer_n2 = 1.8 - - aer_rm1 = 0.052 ! two aerosol mode defaults (from mhwang for testing in global models) - aer_sig1 = 2.04 - aer_n1 = 2500 - aer_rm2 = 1.3 - aer_sig2 = 2.5 - aer_n2 = 1.8 - - dofix_pgam = .false. - pgam_fixed = 5. ! middle range value -- corresponds to radius dispersion ~ 0.4 - - !---------------------------------- - ! Read namelist for microphysics options from prm file: - !------------ -! open(55,file='./'//trim(case)//'/prm', status='old',form='formatted') - - !bloss: get error code for missing namelist (by giving the name for - ! a namelist that doesn't exist in the prm file). -! read (UNIT=55,NML=BNCUIODSBJCB,IOSTAT=ios_missing_namelist) -! rewind(55) !note that one must rewind before searching for new namelists - - !bloss: read in MICRO_M2005 namelist -! read (55,MICRO_M2005,IOSTAT=ios) - -! if (ios.ne.0) then -! !namelist error checking -! if(ios.ne.ios_missing_namelist) then -! write(*,*) '****** ERROR: bad specification in MICRO_M2005 namelist' -! call task_abort() -! elseif(masterproc) then -! write(*,*) '****************************************************' -! write(*,*) '****** No MICRO_M2005 namelist in prm file *********' -! write(*,*) '****************************************************' -! end if -! end if -! close(55) - - if(.not.doicemicro) dograupel=.false. - - if(dohail.and..NOT.dograupel) then - if(masterproc) write(*,*) 'dograupel must be .true. for dohail to be used.' - call task_abort() - end if - - ! write namelist values out to file for documentation -! if(masterproc) then -! open(unit=55,file='./'//trim(case)//'/'//trim(case)//'_'//trim(caseid)//'.options_namelist', form='formatted', position='append') -! write (unit=55,nml=MICRO_M2005,IOSTAT=ios) -! write(55,*) ' ' -! close(unit=55) -! end if - - ! scale values of parameters for m2005micro - aer_rm1 = 1.e-6*aer_rm1 ! convert from um to m - aer_rm2 = 1.e-6*aer_rm2 - aer_n1 = 1.e6*aer_n1 ! convert from #/cm3 to #/m3 - aer_n2 = 1.e6*aer_n2 - - nmicro_fields = 1 ! start with water vapor and cloud water mass mixing ratio -#ifdef CLUBB_CRM - if(docloud.or.doclubb) then -#else - if(docloud) then -#endif -!bloss/qt nmicro_fields = nmicro_fields + 1 ! add cloud water mixing ratio - if(dopredictNc) nmicro_fields = nmicro_fields + 1 ! add cloud water number concentration (if desired) - end if - if(doprecip) nmicro_fields = nmicro_fields + 2 ! add rain mass and number (if desired) - if(doicemicro) nmicro_fields = nmicro_fields + 4 ! add snow and cloud ice number and mass (if desired) - if(dograupel) nmicro_fields = nmicro_fields + 2 ! add graupel mass and number (if desired) - - ! specify index of various quantities in micro_field array - ! *** note that not all of these may be used if(.not.doicemicro) *** - iqv = 1 ! total water (vapor + cloud liq) mass mixing ratio [kg H2O / kg dry air] -!bloss/qt iqcl = 2 ! cloud water mass mixing ratio [kg H2O / kg dry air] - -!bloss/qt: cloud liquid water no longer prognosed - if(dopredictNc) then - incl = 2 ! cloud water number mixing ratio [#/kg dry air] - iqr = 3 ! rain mass mixing ratio [kg H2O / kg dry air] - inr = 4 ! rain number mixing ratio [#/kg dry air] - iqci = 5 ! cloud ice mass mixing ratio [kg H2O / kg dry air] - inci = 6 ! cloud ice number mixing ratio [#/kg dry air] - iqs = 7 ! snow mass mixing ratio [kg H2O / kg dry air] - ins = 8 ! snow number mixing ratio [#/kg dry air] - iqg = 9 ! graupel mass mixing ratio [kg H2O / kg dry air] - ing = 10 ! graupel number mixing ratio [#/kg dry air] - else - iqr = 2 ! rain mass mixing ratio [kg H2O / kg dry air] - inr = 3 ! rain number mixing ratio [#/kg dry air] - iqci = 4 ! cloud ice mass mixing ratio [kg H2O / kg dry air] - inci = 5 ! cloud ice number mixing ratio [#/kg dry air] - iqs = 6 ! snow mass mixing ratio [kg H2O / kg dry air] - ins = 7 ! snow number mixing ratio [#/kg dry air] - iqg = 8 ! graupel mass mixing ratio [kg H2O / kg dry air] - ing = 9 ! graupel number mixing ratio [#/kg dry air] - end if - - ! stop if icemicro is specified without precip -- we don't support this right now. - if((doicemicro).and.(.not.doprecip)) then - if(masterproc) write(*,*) 'Morrison 2005 Microphysics does not support both doice and .not.doprecip' - call task_abort() - end if - index_water_vapor = iqv ! set SAM water vapor flag - - if(.not.isallocatedMICRO) then - ! allocate microphysical variables - allocate(micro_field(dimx1_s:dimx2_s,dimy1_s:dimy2_s,nzm,nmicro_fields), & - fluxbmk(nx,ny,nmicro_fields), fluxtmk(nx,ny,nmicro_fields), & - reffc(nx,ny,nzm), reffi(nx,ny,nzm), & - mkwle(nz,nmicro_fields), mkwsb(nz,nmicro_fields), & - mkadv(nz,nmicro_fields), mkdiff(nz,nmicro_fields), & - mklsadv(nz,nmicro_fields), & - stend(nzm,nmicro_fields), mtend(nzm,nmicro_fields), & - mfrac(nzm,nmicro_fields), trtau(nzm,nmicro_fields), & - mksed(nzm,nmicro_fields), tmtend(nzm), & - mstor(nzm,nmicro_fields), & - cloudliq(nx,ny,nzm), & - tmtend3d(nx,ny,nzm), flag_micro3Dout(nmicro_fields), & - flag_wmass(nmicro_fields), flag_precip(nmicro_fields), & - flag_number(nmicro_fields), lfac(nmicro_fields), & - mkname(nmicro_fields), mklongname(nmicro_fields), & - mkunits(nmicro_fields), mkoutputscale(nmicro_fields), STAT=ierr) - -#ifdef CRM - allocate (qpevp(nz), qpsrc(nz), STAT=ierr) -#endif - allocate (wvar(nx,ny,nzm), STAT=ierr) - -#ifdef CRM -! hm 7/26/11, add new output - allocate (aut1(nx,ny,nzm), STAT=ierr) - allocate (acc1(nx,ny,nzm), STAT=ierr) - allocate (evpc1(nx,ny,nzm), STAT=ierr) - allocate (evpr1(nx,ny,nzm), STAT=ierr) - allocate (mlt1(nx,ny,nzm), STAT=ierr) - allocate (sub1(nx,ny,nzm), STAT=ierr) - allocate (dep1(nx,ny,nzm), STAT=ierr) - allocate (con1(nx,ny,nzm), STAT=ierr) - - allocate (aut1a(nx,ny,nzm), STAT=ierr) - allocate (acc1a(nx,ny,nzm), STAT=ierr) - allocate (evpc1a(nx,ny,nzm), STAT=ierr) - allocate (evpr1a(nx,ny,nzm), STAT=ierr) - allocate (mlt1a(nx,ny,nzm), STAT=ierr) - allocate (sub1a(nx,ny,nzm), STAT=ierr) - allocate (dep1a(nx,ny,nzm), STAT=ierr) - allocate (con1a(nx,ny,nzm), STAT=ierr) -#endif - -!+++mhwangtest - allocate (sfcpcp2D(nx,ny), STAT=ierr) -!---mhwangtest - - if(ierr.ne.0) then - write(*,*) 'Failed to allocate microphysical arrays on proc ', rank - call task_abort() - else - isallocatedMICRO = .true. - end if - - ! zero out statistics variables associated with cloud ice sedimentation - ! in Marat's default SAM microphysics - tlatqi = 0. - - ! initialize these arrays - micro_field = 0. - cloudliq = 0. !bloss/qt: auxially cloud liquid water variable, analogous to qn in MICRO_SAM1MOM - fluxbmk = 0. - fluxtmk = 0. - mkwle = 0. - mkwsb = 0. - mkadv = 0. - mkdiff = 0. - mklsadv = 0. - mstor =0. - - wvar = 0. - -#ifdef CRM -! hm 7/26/11, new output - aut1 = 0. - acc1 = 0. - evpc1 = 0. - evpr1 = 0. - mlt1 = 0. - sub1 = 0. - dep1 = 0. - con1 = 0. - aut1a = 0. - acc1a = 0. - evpc1a = 0. - evpr1a = 0. - mlt1a = 0. - sub1a = 0. - dep1a = 0. - con1a = 0. -#endif - - ! initialize flag arrays to all mass, no number, no precip - flag_wmass = 1 - flag_number = 0 - flag_precip = 0 - flag_micro3Dout = 0 - - end if - - compute_reffc = douse_reffc - compute_reffi = douse_reffi - -end subroutine micro_setparm - -!---------------------------------------------------------------------- -!!! Initialize microphysics: -! -! this one is guaranteed to be called by SAM at the -! beginning of each run, initial or restart: -subroutine micro_init() - - use crmx_vars -#if (defined CRM && defined MODAL_AERO) - use crmx_drop_activation, only: drop_activation_init -#endif - - implicit none - - real, dimension(nzm) :: qc0, qi0 - -! Commented out by dschanen UWM 23 Nov 2009 to avoid a linking error -! real, external :: satadj_water - integer :: k - - ! initialize flag arrays - if(dopredictNc) then - ! Cloud droplet number concentration is a prognostic variable - if(doicemicro) then - if(dograupel) then - !bloss/qt: qt, Nc, qr, Nr, qi, Ni, qs, Ns, qg, Ng - flag_wmass = (/1,0,1,0,1,0,1,0,1,0/) - flag_precip = (/0,0,1,1,0,0,1,1,1,1/) - flag_number = (/0,1,0,1,0,1,0,1,0,1/) - else - !bloss/qt: qt, Nc, qr, Nr, qi, Ni, qs, Ns - flag_wmass = (/1,0,1,0,1,0,1,0/) - flag_precip = (/0,0,1,1,0,0,1,1/) - flag_number = (/0,1,0,1,0,1,0,1/) - end if - else - if(doprecip) then - !bloss/qt: qt, Nc, qr, Nr - flag_wmass = (/1,0,1,0/) - flag_precip = (/0,0,1,1/) - flag_number = (/0,1,0,1/) - else - !bloss/qt: qt, Nc - flag_wmass = (/1,0/) - flag_precip = (/0,0/) - flag_number = (/0,1/) - end if - end if - else - ! Cloud droplet number concentration is NOT a prognostic variable - if(doicemicro) then - if(dograupel) then - !bloss/qt: qt, qr, Nr, qi, Ni, qs, Ns, qg, Ng - flag_wmass = (/1,1,0,1,0,1,0,1,0/) - flag_precip = (/0,1,1,0,0,1,1,1,1/) - flag_number = (/0,0,1,0,1,0,1,0,1/) - else - !bloss/qt: qt, qr, Nr, qi, Ni, qs, Ns - flag_wmass = (/1,1,0,1,0,1,0/) - flag_precip = (/0,1,1,0,0,1,1/) - flag_number = (/0,0,1,0,1,0,1/) - end if - else - if(doprecip) then - !bloss/qt: qt, qr, Nr - flag_wmass = (/1,1,0/) - flag_precip = (/0,1,1/) - flag_number = (/0,0,1/) - else - !bloss/qt: only total water variable is needed for no-precip, - ! fixed droplet number, warm cloud and no cloud simulations. - flag_wmass = (/1/) - flag_precip = (/0/) - flag_number = (/0/) - end if - end if - end if - - ! output all microphysical fields to 3D output files if using more than - ! just docloud. Otherwise, rely on basic SAM outputs -#ifdef CLUBB_CRM - if((docloud.OR.doclubb).AND.(doprecip.OR.dopredictNc)) then -#else - if(docloud.AND.(doprecip.OR.dopredictNc)) then -#endif - flag_micro3Dout = 1 - end if - - ! initialize factor for latent heat - lfac(:) = 1. ! use one as default for number species - lfac(iqv) = lcond -!bloss/qt if(docloud) lfac(iqcl) = lcond - if(doprecip) lfac(iqr) = lcond - if(doicemicro) then - lfac(iqci) = lsub - lfac(iqs) = lsub - if(dograupel) lfac(iqg) = lsub - end if - - call graupel_init() ! call initialization routine within mphys module -#if (defined CRM && defined MODAL_AERO) - call drop_activation_init -#endif - - if(nrestart.eq.0) then - -! In SPCAM, do not need this part. -#ifndef CRM - ! compute initial profiles of liquid water - M.K. - call satadj_liquid(nzm,tabs0,q0,qc0,pres*100.) - - ! initialize microphysical quantities - q0 = q0 + qc0 - do k = 1,nzm - micro_field(:,:,k,iqv) = q0(k) - cloudliq(:,:,k) = qc0(k) - tabs(:,:,k) = tabs0(k) - end do - if(dopredictNc) then ! initialize concentration somehow... - do k = 1,nzm - if(q0(k).gt.0.) then - micro_field(:,:,k,incl) = 0.5*ccnconst*1.e6 - end if - end do - end if -#endif ! CRM - -#ifdef CLUBB_CRM - if(docloud.or.doclubb) call micro_diagnose() ! leave this line here -#else - if(docloud) call micro_diagnose() ! leave this here -#endif - - - end if - -end subroutine micro_init - -!---------------------------------------------------------------------- -!!! fill-in surface and top boundary fluxes: -! -! Obviously, for liquid/ice water variables those fluxes are zero. They are not zero -! only for water vapor variable and, possibly, for CCN and IN if you have those. - -subroutine micro_flux() - -use crmx_vars, only: fluxbq, fluxtq -#ifdef CLUBB_CRM -use crmx_params, only: doclubb, doclubb_sfc_fluxes, docam_sfc_fluxes -#endif - -fluxbmk(:,:,:) = 0. ! initialize all fluxes at surface to zero -fluxtmk(:,:,:) = 0. ! initialize all fluxes at top of domain to zero -#ifdef CLUBB_CRM -if ( doclubb .and. (doclubb_sfc_fluxes.or.docam_sfc_fluxes) ) then - fluxbmk(:,:,index_water_vapor) = 0.0 ! surface qv (latent heat) flux -else - fluxbmk(:,:,index_water_vapor) = fluxbq(:,:) ! surface qv (latent heat) flux -end if -#else -fluxbmk(:,:,index_water_vapor) = fluxbq(:,:) ! surface qv (latent heat) flux -#endif -fluxtmk(:,:,index_water_vapor) = fluxtq(:,:) ! top of domain qv flux - -end subroutine micro_flux - -!---------------------------------------------------------------------- -!!! compute local microphysics processes (beyond advection and SGS diffusion): -! -! This is the place where the condensation/sublimation, accretion, coagulation, freezing, -! melting, etc., that is all the microphysics processes except for the spatial transport happen. - -! IMPORTANT: You need to use the thermodynamic constants like specific heat, or -! specific heat of condensation, gas constant, etc, the same as in file params.f90 -! Also, you should assume that the conservative thermodynamic variable during these -! proceses is the liquid/ice water static energy: t = tabs + gz - Lc (qc+qr) - Ls (qi+qs+qg) -! It should not be changed during all of your point microphysical processes! - -subroutine micro_proc() - -use crmx_params, only: fac_cond, fac_sub, rgas -use crmx_grid, only: z, zi - -#ifdef CRM -use crmx_vars, only: t, gamaz, precsfc, precssfc, precflux, qpfall, tlat, prec_xy, & -#else -use crmx_vars, only: t, gamaz, precsfc, precflux, qpfall, tlat, prec_xy, & -#endif /*CRM*/ - nstep, nstatis, icycle, total_water_prec - -#ifdef ECPP -use crmx_ecppvars, only: qlsink, qlsink_bf, prain, precr, precsolid, rh, qcloud_bf -#endif - -#ifdef CLUBB_CRM -use crmx_params, only: doclubb, docloud, dosmoke -use crmx_grid, only: nz -use crmx_error_code, only: clubb_at_least_debug_level -use crmx_fill_holes, only: fill_holes_driver -use crmx_clubbvars, only: wp2, cloud_frac, rho_ds_zt, rho_ds_zm, relvarg, accre_enhang ! are used, but not modified here -use crmx_vars, only: qcl ! Used here and updated in micro_diagnose -use crmx_vars, only: prespot ! exner^-1 -use crmx_module_mp_GRAUPEL, only: & - cloud_frac_thresh ! Threshold for using sgs cloud fraction to weight - ! microphysical quantities [%] -use crmx_clubb_precision, only: core_rknd -use crmx_constants_clubb, only: T_freeze_K -use crmx_vars, only: CF3D -#endif - - -real, dimension(nzm) :: & - tmpqcl, tmpqci, tmpqr, tmpqs, tmpqg, tmpqv, & - tmpncl, tmpnci, tmpnr, tmpns, tmpng, & - tmpw, tmpwsub, tmppres, tmpdz, tmptabs, & -! hm 7/26/11, new output - tmpaut,tmpacc,tmpevpc,tmpevpr,tmpmlt, & - tmpsub,tmpdep,tmpcon, & - tmtend1d, & - mtendqcl, mtendqci, mtendqr, mtendqs, mtendqg, mtendqv, & - mtendncl, mtendnci, mtendnr, mtendns, mtendng, & - stendqcl, stendqci, stendqr, stendqs, stendqg, stendqv, & - stendncl, stendnci, stendnr, stendns, stendng, & - effg1d, effr1d, effs1d, effc1d, effi1d - -#ifdef ECPP -real, dimension(nzm) :: C2PREC,QSINK_TMP, CSED,ISED,SSED,GSED,RSED,RH3D ! used for cloud chemistry and wet deposition in ECPP -#endif - -#ifdef CLUBB_CRM -real(kind=core_rknd), dimension(nz) :: & - qv_clip, qcl_clip -real, dimension(nzm) :: cloud_frac_in, ice_cldfrac -real, dimension(nzm) :: liq_cldfrac -real, dimension(nzm) :: relvar ! relative cloud water variance -real, dimension(nzm) :: accre_enhan ! optional accretion enhancement factor for MG -#endif /*CLUBB_CRM*/ - -real, dimension(nzm,nmicro_fields) :: stend1d, mtend1d -real :: tmpc, tmpr, tmpi, tmps, tmpg -integer :: i1, i2, j1, j2, i, j, k, m, n - -real(kind=selected_real_kind(12)) :: tmp_total, tmptot - -! call t_startf ('micro_proc') - -#ifndef CRM -if(mod(nstep-1,nstatis).eq.0.and.icycle.eq.1) then - do j=1,ny - do i=1,nx - precsfc(i,j)=0. ! in SPCAM, done in crm.F90 - end do - end do - do k=1,nzm - precflux(k) = 0. ! in SPCAM, done in crm.F90 - end do -end if -#endif ! end CRM - -if(dostatis) then ! initialize arrays for statistics - mfrac(:,:) = 0. - mtend(:,:) = 0. - trtau(:,:) = 0. -! qpfall(:)=0. ! in SPCAM, done in crm.F90 - tlat(:) = 0. - tmtend3d(:,:,:) = 0. -end if -stend(:,:) = 0. -mksed(:,:) = 0. - -!!$if(doprecip) total_water_prec = total_water_prec + total_water() - -do j = 1,ny - do i = 1,nx - - ! zero out mixing ratios of microphysical species - tmpqv(:) = 0. - tmpqcl(:) = 0. - tmpncl(:) = 0. - tmpqr(:) = 0. - tmpnr(:) = 0. - tmpqci(:) = 0. - tmpnci(:) = 0. - tmpqs(:) = 0. - tmpns(:) = 0. - tmpqg(:) = 0. - tmpng(:) = 0. - - ! get microphysical quantities in this grid column - tmpqv(:) = micro_field(i,j,:,iqv) !bloss/qt: This is total water (qv+qcl) -!bloss/qt: compute below from saturation adjustment. -!bloss/qt tmpqcl(:) = micro_field(i,j,:,iqcl) - if(dopredictNc) tmpncl(:) = micro_field(i,j,:,incl) - if(doprecip) then - tmpqr(:) = micro_field(i,j,:,iqr) - tmpnr(:) = micro_field(i,j,:,inr) - end if - - if(doicemicro) then - tmpqci(:) = micro_field(i,j,:,iqci) - tmpnci(:) = micro_field(i,j,:,inci) - tmpqs(:) = micro_field(i,j,:,iqs) - tmpns(:) = micro_field(i,j,:,ins) - if(dograupel) then - tmpqg(:) = micro_field(i,j,:,iqg) - tmpng(:) = micro_field(i,j,:,ing) - end if - end if - - ! get absolute temperature in this column - !bloss/qt: before saturation adjustment for liquid, - ! this is Tcl = T - (L/Cp)*qcl (the cloud liquid water temperature) - tmptabs(:) = t(i,j,:) & ! liquid water-ice static energy over Cp - - gamaz(:) & ! potential energy - + fac_cond * (tmpqr(:)) & ! bloss/qt: liquid latent energy due to rain only - + fac_sub * (tmpqci(:) + tmpqs(:) + tmpqg(:)) ! ice latent energy - - tmpdz = adz(:)*dz -! tmpw = 0.5*(w(i,j,1:nzm) + w(i,j,2:nz)) ! MK: changed for stretched grids - tmpw = ((zi(2:nz)-z(1:nzm))*w(i,j,1:nzm)+ & - (z(1:nzm)-zi(1:nzm))*w(i,j,2:nz))/(zi(2:nz)-zi(1:nzm)) -#ifdef CLUBB_CRM - ! Added by dschanen on 4 Nov 2008 to account for w_sgs - if ( doclubb .and. dosubgridw ) then - ! Compute w_sgs. Formula is consistent with that used with - ! TKE from MYJ pbl scheme in WRF (see module_mp_graupel.f90). - tmpwsub = sqrt( LIN_INT( real( wp2(i,j,2:nz) ), real( wp2(i,j,1:nzm) ), & - zi(2:nz), zi(1:nzm), z(1:nzm) ) ) - else -! tmpwsub = 0. -! diagnose tmpwsub from tke. -! Notes: tke has to be already prognsotic or diagnostic. - tmpwsub = sqrt(tke2(i,j,:)/3.) ! diagnosed tmpwsub from tke -! diagnose tmpwsub from tk -! tmpwsub = sqrt(2*3.141593)*tk(i,j,:)/(dz*adz(:)) ! from Ghan et al. (1997, JGR). - end if - - if ( doclubb ) then - cloud_frac_in(1:nzm) = cloud_frac(i,j,2:nz) - liq_cldfrac(1:nzm) = cloud_frac(i,j,2:nz) - else - cloud_frac_in(1:nzm) = 0.0 - end if - -#else /* Old code */ -! tmpwsub = 0. -! diagnose tmpwsub from tke. -! Notes: tke has to be already prognsotic or diagnostic. - tmpwsub = sqrt(tke2(i,j,:)/3.) ! diagnosed tmpwsub from tke -! diagnose tmpwsub from tk -! tmpwsub = sqrt(2*3.141593)*tk(i,j,:)/(dz*adz(:)) ! from Ghan et al. (1997, JGR). -#endif - wvar(i,j,:) = tmpwsub(:) - - tmppres(:) = 100.*pres(1:nzm) - - !bloss/qt: saturation adjustment to compute cloud liquid water content. - ! Note: tmpqv holds qv+qcl on input, qv on output. - ! tmptabs hold T-(L/Cp)*qcl on input, T on output. - ! tmpqcl hold qcl on output. - ! tmppres is unchanged on output, should be in Pa. -#ifdef CLUBB_CRM - ! In the CLUBB case, we want to call the microphysics on sub-saturated grid - ! boxes and weight by cloud fraction, therefore we use the CLUBB value of - ! liquid water. -dschanen 23 Nov 2009 - if ( .not. ( docloud .or. dosmoke ) ) then - if(.not.doclubb_tb) then - tmpqcl = cloudliq(i,j,:) ! Liquid updated by CLUBB just prior to this - tmpqv = tmpqv - tmpqcl ! Vapor - tmptabs = tmptabs + fac_cond * tmpqcl ! Update temperature - if(doclubb_gridmean) then - cloud_frac_in(1:nzm) = 0.0 ! to use grid mean for Morrison microphysics, just - ! simply set cloud_frac_in to be zero. - liq_cldfrac(1:nzm) = cloud_frac(i,j,2:nz) - - CF3D(i, j, 1:nzm) = cloud_frac(i, j, 2:nz) - ice_cldfrac(:)= 0.0 - if(doicemicro) then - do k=1, nzm - if(tmpqci(k).gt.1.0e-8) then - ice_cldfrac(k) = 1.0 - end if - if((tmpqcl(k) + tmpqci(k)).gt.1.0e-9) then - CF3D(i,j,k) = (CF3D(i,j,k) * tmpqcl(k) + ice_cldfrac(k) * tmpqci(k)) & - / (tmpqcl(k) + tmpqci(k)) - else - CF3D(i,j,k) = 0.0 - end if - ice_cldfrac(k) = max(CF3D(i,j,k), liq_cldfrac(k)) - end do - endif - end if - else - call satadj_liquid(nzm,tmptabs,tmpqv,tmpqcl,tmppres) - cloudliq(i,j,:) = tmpqcl - cloud_frac_in(1:nzm) = 0.0 - end if - else - call satadj_liquid(nzm,tmptabs,tmpqv,tmpqcl,tmppres) - end if -#else - call satadj_liquid(nzm,tmptabs,tmpqv,tmpqcl,tmppres) -#endif - - -#ifdef ECPP -! save cloud water before microphysics process for the calculation -! of qlsink in ECPP - qcloud_bf(i,j,:) = tmpqcl(:) -#endif /*ECPP*/ - - i1 = 1 ! dummy variables used by WRF convention in subroutine call - i2 = 1 - j1 = 1 - j2 = 1 - -! hm 7/26/11, initialize new output - tmpaut=0. - tmpacc=0. - tmpevpc=0. - tmpevpr=0. - tmpmlt=0. - tmpsub=0. - tmpdep=0. - tmpcon=0. - - mtendqv = 0. - mtendqcl = 0. - mtendqr = 0. - mtendqci = 0. - mtendqs = 0. - mtendqg = 0. - mtendncl = 0. - mtendnr = 0. - mtendnci = 0. - mtendns = 0. - mtendng = 0. - - tmtend1d = 0. - - sfcpcp = 0. - sfcicepcp = 0. - - sfcpcp2D = 0.0 !+++mhwangtest - - effc1d(:) = 10. ! default liquid and ice effective radii - effi1d(:) = 75. - -#ifdef CLUBB_CRM - relvar(:) = 8. - accre_enhan(:) = 1. - if ( doclubb ) then - if ( any( tmpqv < 0. ) ) then - qv_clip(2:nz) = tmpqv(1:nzm) - qv_clip(1) = 0.0_core_rknd - if ( clubb_at_least_debug_level( 1 ) ) then - write(0,*) "M2005 has received a negative water vapor" - end if - call fill_holes_driver( 2, 0._core_rknd, "zt", rho_ds_zt, rho_ds_zm, qv_clip ) - tmpqv = qv_clip(2:nz) - end if - if ( any( tmpqcl < 0. ) ) then - qcl_clip(2:nz) = tmpqcl(1:nzm) - qcl_clip(1) = 0.0_core_rknd - if ( clubb_at_least_debug_level( 1 ) ) then - write(0,*) "M2005 has received a negative liquid water" - end if - call fill_holes_driver( 2, 0._core_rknd, "zt", rho_ds_zt, rho_ds_zm, qcl_clip ) - tmpqcl = qcl_clip(2:nz) - end if - - ! ------------------------------------------------- ! - ! Diagnose relative cloud water variance ! - ! ------------------------------------------------- ! -! relvar(:) = 1.0 ! default -! where (tmpqcl(:) /= 0. .and. qclvar(i,j, :) /= 0.) & -! relvar(:) = min(8.0, max(0.35,tmpqcl(:)**2/qclvar(i,j,:))) -! relvar(:) = min(8.0, max(0.35,tmpqcl(:)**2/qclvar(i,j,:))) - - ! ------------------------------------------------- ! - ! Optional Accretion enhancement factor ! - ! ------------------------------------------------- ! -! accre_enhan(:) = 1.+0.65*(1.0/relvar(:)) - relvar(:) = relvarg(i,j,:) - accre_enhan(:) = accre_enhang(i,j,:) - end if ! doclubb - - ! explanation of variable names: - ! mtend1d: array of 1d profiles of microphysical tendencies (w/o sed.) - ! stend1d: array of 1d profiles of sedimentation tendencies for q* - ! tmp**: on input, current value of **. On output, new value of **. - ! eff*1d: one-dim. profile of effective raduis for * - call m2005micro_graupel(& - mtendqcl,mtendqci,mtendqs,mtendqr, & - mtendncl,mtendnci,mtendns,mtendnr, & - tmpqcl,tmpqci,tmpqs,tmpqr, & - tmpncl,tmpnci,tmpns,tmpnr, & - tmtend1d,mtendqv, & - tmptabs,tmpqv,tmppres,rho,tmpdz,tmpw,tmpwsub, & -! hm 7/26/11, new output - tmpacc,tmpaut,tmpevpc,tmpevpr,tmpmlt, & - tmpsub,tmpdep,tmpcon, & - sfcpcp, sfcicepcp, & - effc1d,effi1d,effs1d,effr1d, & - dtn, & - i1,i2, j1,j2, 1,nzm, i1,i2, j1,j2, 1,nzm, & - mtendqg,mtendng,tmpqg,tmpng,effg1d,stendqg, & - stendqr,stendqci,stendqs,stendqcl,cloud_frac_in, liq_cldfrac, ice_cldfrac, relvar, accre_enhan & ! cloud_frac added by dschanen UWM -#ifdef ECPP - ,C2PREC,QSINK_TMP,CSED,ISED,SSED,GSED,RSED,RH3D & ! mhwang add, for ECPP -#endif - ) - - if ( doclubb ) then - if ( any( tmpqv < 0. ) ) then - qv_clip(2:nz) = tmpqv(1:nzm) - qv_clip(1) = 0.0_core_rknd - if ( clubb_at_least_debug_level( 1 ) ) then - write(0,*) "M2005 has produced a negative water vapor" - end if - call fill_holes_driver( 2, 0._core_rknd, "zt", rho_ds_zt, rho_ds_zm, qv_clip ) - tmpqv = qv_clip(2:nz) - end if - if ( any( tmpqcl < 0. ) ) then - qcl_clip(2:nz) = tmpqcl(1:nzm) - qcl_clip(1) = 0.0_core_rknd - if ( clubb_at_least_debug_level( 1 ) ) then - write(0,*) "M2005 has produced a negative liquid water" - end if - call fill_holes_driver( 2, 0._core_rknd, "zt", rho_ds_zt, rho_ds_zm, qcl_clip ) - tmpqcl = qcl_clip(2:nz) - end if - end if ! doclubb -#else - ! explanation of variable names: - ! mtend1d: array of 1d profiles of microphysical tendencies (w/o sed.) - ! stend1d: array of 1d profiles of sedimentation tendencies for q* - ! tmp**: on input, current value of **. On output, new value of **. - ! eff*1d: one-dim. profile of effective raduis for * - call m2005micro_graupel(& - mtendqcl,mtendqci,mtendqs,mtendqr, & - mtendncl,mtendnci,mtendns,mtendnr, & - tmpqcl,tmpqci,tmpqs,tmpqr, & - tmpncl,tmpnci,tmpns,tmpnr, & - tmtend1d,mtendqv, & - tmptabs,tmpqv,tmppres,rho,tmpdz,tmpw,tmpwsub, & -! hm 7/26/11, new output - tmpacc,tmpaut,tmpevpc,tmpevpr,tmpmlt, & - tmpsub,tmpdep,tmpcon, & - sfcpcp, sfcicepcp, & - effc1d,effi1d,effs1d,effr1d, & - dtn, & - i1,i2, j1,j2, 1,nzm, i1,i2, j1,j2, 1,nzm, & - mtendqg,mtendng,tmpqg,tmpng,effg1d,stendqg, & - stendqr,stendqci,stendqs,stendqcl & -#ifdef ECPP - ,C2PREC,QSINK_TMP,CSED,ISED,SSED,GSED,RSED,RH3D & ! mhwang add, for ECPP -#endif - ) -#endif - -#ifdef CRM -! hm 7/26/11, new output - aut1(i,j,:) = tmpaut(:) - acc1(i,j,:) = tmpacc(:) - evpc1(i,j,:) = tmpevpc(:) - evpr1(i,j,:) = tmpevpr(:) - mlt1(i,j,:) = tmpmlt(:) - sub1(i,j,:) = tmpsub(:) - dep1(i,j,:) = tmpdep(:) - con1(i,j,:) = tmpcon(:) - -! hm 8/31/11, new output for gcm-grid and time-step avg -! rates are summed here over the icycle loop -! note: rates are multiplied by time step, and then -! divided by dt in crm.F90 to get mean rates - aut1a(i,j,:) = aut1a(i,j,:) + aut1(i,j,:)*dtn - acc1a(i,j,:) = acc1a(i,j,:) + acc1(i,j,:)*dtn - evpc1a(i,j,:) = evpc1a(i,j,:) + evpc1(i,j,:)*dtn - evpr1a(i,j,:) = evpr1a(i,j,:) + evpr1(i,j,:)*dtn - mlt1a(i,j,:) = mlt1a(i,j,:) + mlt1(i,j,:)*dtn - sub1a(i,j,:) = sub1a(i,j,:) + sub1(i,j,:)*dtn - dep1a(i,j,:) = dep1a(i,j,:) + dep1(i,j,:)*dtn - con1a(i,j,:) = con1a(i,j,:) + con1(i,j,:)*dtn -#endif - - ! update microphysical quantities in this grid column - if(doprecip) then - total_water_prec = total_water_prec + sfcpcp - - ! take care of surface precipitation - precsfc(i,j) = precsfc(i,j) + sfcpcp/dz - prec_xy(i,j) = prec_xy(i,j) + sfcpcp/dtn/dz -!+++mhwang - sfcpcp2D(i,j) = sfcpcp/dtn/dz -!---mhwang -#ifdef CRM - precssfc(i,j) = precssfc(i,j) + sfcicepcp/dz ! the corect unit of precssfc should be mm/dz +++mhwang -#endif - ! update rain - micro_field(i,j,:,iqr) = tmpqr(:) - micro_field(i,j,:,inr) = tmpnr(:) - else - ! add rain to cloud - tmpqcl(:) = tmpqcl(:) + tmpqr(:) ! add rain mass back to cloud water - tmpncl(:) = tmpncl(:) + tmpnr(:) ! add rain number back to cloud water - - ! zero out rain - tmpqr(:) = 0. - tmpnr(:) = 0. - - ! add rain tendencies to cloud - stendqcl(:) = stendqcl(:) + stendqr(:) - mtendqcl(:) = mtendqcl(:) + mtendqr(:) - mtendncl(:) = mtendncl(:) + mtendnr(:) - - ! zero out rain tendencies - stendqr(:) = 0. - mtendqr(:) = 0. - mtendnr(:) = 0. - end if - - !bloss/qt: update total water and cloud liquid. - ! Note: update of total water moved to after if(doprecip), - ! since no precip moves rain --> cloud liq. - micro_field(i,j,:,iqv) = tmpqv(:) + tmpqcl(:) !bloss/qt: total water - cloudliq(i,j,:) = tmpqcl(:) !bloss/qt: auxilliary cloud liquid water variable - if(dopredictNc) micro_field(i,j,:,incl) = tmpncl(:) - - reffc(i,j,:) = effc1d(:) - - if(doicemicro) then - micro_field(i,j,:,iqci) = tmpqci(:) - micro_field(i,j,:,inci) = tmpnci(:) - micro_field(i,j,:,iqs) = tmpqs(:) - micro_field(i,j,:,ins) = tmpns(:) - if(dograupel) then - micro_field(i,j,:,iqg) = tmpqg(:) - micro_field(i,j,:,ing) = tmpng(:) - end if - reffi(i,j,:) = effi1d(:) - end if - - !===================================================== - ! update liquid-ice static energy due to precipitation - t(i,j,:) = t(i,j,:) & - - dtn*fac_cond*(stendqcl+stendqr) & - - dtn*fac_sub*(stendqci+stendqs+stendqg) - !===================================================== - - if(dostatis) then -!bloss/qt: total water microphysical tendency includes qv and qcl - mtend(:,iqv) = mtend(:,iqv) + mtendqv + mtendqcl -!bloss/qt mtend(:,iqcl) = mtend(:,iqcl) + mtendqcl - if(dopredictNc) mtend(:,incl) = mtend(:,incl) + mtendncl - if(doprecip) then - mtend(:,iqr) = mtend(:,iqr) + mtendqr - mtend(:,inr) = mtend(:,inr) + mtendnr - end if - - if(doicemicro) then - mtend(:,iqci) = mtend(:,iqci) + mtendqci - mtend(:,inci) = mtend(:,inci) + mtendnci - !bloss stend(:,inci) = stend(:,inci) + stendnci - - mtend(:,iqs) = mtend(:,iqs) + mtendqs - mtend(:,ins) = mtend(:,ins) + mtendns - !bloss stend(:,ins) = stend(:,ins) + stendns - - if(dograupel) then - mtend(:,iqg) = mtend(:,iqg) + mtendqg - mtend(:,ing) = mtend(:,ing) + mtendng - !bloss stend(:,ing) = stend(:,ing) + stendng - end if - end if - - do n = 1,nmicro_fields - do k = 1,nzm - if(micro_field(i,j,k,n).ge.1.e-6) mfrac(k,n) = mfrac(k,n)+1. - end do - end do - - ! approximate optical depth = 0.0018*lwp/effrad - ! integrated up to level at which output - tmpc = 0. - tmpr = 0. - tmpi = 0. - tmps = 0. - tmpg = 0. - - do k = 1,nzm - tmpc = tmpc + 0.0018*rho(k)*dz*adz(k)*tmpqcl(k)/(1.e-20+1.e-6*effc1d(k)) - tmpr = tmpr + 0.0018*rho(k)*dz*adz(k)*tmpqr(k)/(1.e-20+1.e-6*effr1d(k)) - !bloss/qt: put cloud liquid optical depth in trtau(:,iqv) - trtau(k,iqv) = trtau(k,iqv) + tmpc - if(doprecip) trtau(k,iqr) = trtau(k,iqr) + tmpr - - if(doicemicro) then - tmpi = tmpi + 0.0018*rho(k)*dz*adz(k)*tmpqci(k)/(1.e-20+1.e-6*effi1d(k)) - tmps = tmps + 0.0018*rho(k)*dz*adz(k)*tmpqs(k)/(1.e-20+1.e-6*effs1d(k)) - tmpg = tmpg + 0.0018*rho(k)*dz*adz(k)*tmpqg(k)/(1.e-20+1.e-6*effg1d(k)) - - trtau(k,iqci) = trtau(k,iqci) + tmpi - trtau(k,iqs) = trtau(k,iqs) + tmps -#ifdef CLUBB_CRM /* Bug fix -dschanen 9 Mar 2012 */ - if ( dograupel ) then - trtau(k,iqg) = trtau(k,iqg) + tmpg - end if -#else - trtau(k,iqg) = trtau(k,iqg) + tmpg -#endif /* CLUBB */ - end if - end do - - tlat(1:nzm) = tlat(1:nzm) & - - dtn*fac_cond*(stendqcl+stendqr) & - - dtn*fac_sub*(stendqci+stendqs+stendqg) - qpfall(1:nzm) = qpfall(1:nzm) + dtn*(stendqr+stendqs+stendqg) - -#ifdef CRM - qpsrc(1:nzm) = qpsrc(1:nzm) + dtn*(mtendqr+mtendqs+mtendqg) - qpevp(1:nzm) = 0.0 -#endif - - !bloss: temperature tendency (sensible heating) due to phase changes - tmtend3d(i,j,1:nzm) = tmtend1d(1:nzm) - - end if ! dostatis - - stend(:,iqv) = stend(:,iqv) + stendqcl !bloss/qt: iqcl --> iqv - if(doprecip) then - stend(:,iqr) = stend(:,iqr) + stendqr - end if - - if(doicemicro) then - stend(:,iqci) = stend(:,iqci) + stendqci - stend(:,iqs) = stend(:,iqs) + stendqs - if(dograupel) stend(:,iqg) = stend(:,iqg) + stendqg - end if - -#ifdef ECPP - do k=1, nzm - qlsink_bf(i,j,k) = min(1.0/dt, QSINK_TMP(k)) ! /s - rh(i,j,k) = RH3D(k) !0-1 - prain(i,j,k) = C2PREC(K) ! kg/kg/s - if(cloudliq(i,j,k).gt.1.0e-10) then - qlsink(i,j,k) = min(1.0/dt, C2PREC(k)/cloudliq(i,j,k)) - else - qlsink(i,j,k) = 0.0 - end if - end do - precr(i,j,:)=(RSED(:)) ! kg/m2/s - precsolid(i,j,:)=(SSED(:)+GSED(:)) !kg/m2/s leave ISED out for the momenent, and we may want to - ! test it effects in the future. +++mhwang -#endif /*ECPP*/ - - end do ! i = 1,nx -end do ! j = 1,ny - -! back sedimentation flux out from sedimentation tendencies -tmpc = 0. -do k = 1,nzm - m = nz-k - tmpc = tmpc + stend(m,iqv)*rho(m)*dz*adz(m) !bloss/qt: iqcl --> iqv - mksed(m,iqv) = tmpc -end do -precflux(1:nzm) = precflux(1:nzm) - mksed(:,iqv)*dtn/dz - -if(doprecip) then - tmpr = 0. - do k = 1,nzm - m = nz-k - tmpr = tmpr + stend(m,iqr)*rho(m)*dz*adz(m) - mksed(m,iqr) = tmpr - end do - precflux(1:nzm) = precflux(1:nzm) - mksed(:,iqr)*dtn/dz -end if - -if(doicemicro) then - tmpi = 0. - tmps = 0. - tmpg = 0. - do k = 1,nzm - m = nz-k - tmpi = tmpi + stend(m,iqci)*rho(m)*dz*adz(m) - tmps = tmps + stend(m,iqs)*rho(m)*dz*adz(m) -#ifdef CLUBB_CRM /* Bug fix -dschanen 9 Mar 2012 */ - if ( dograupel ) then - tmpg = tmpg + stend(m,iqg)*rho(m)*dz*adz(m) - else - tmpg = 0. - end if -#else - tmpg = tmpg + stend(m,iqg)*rho(m)*dz*adz(m) -#endif - mksed(m,iqci) = tmpi - mksed(m,iqs) = tmps -#ifdef CLUBB_CRM /* Bug fix -dschanen 9 Mar 2012 */ - if ( dograupel ) then - mksed(m,iqg) = tmpg - end if -#else - mksed(m,iqg) = tmpg -#endif - end do -#ifdef CLUBB_CRM /* Bug fix -dschanen 9 Mar 2012 */ - if ( dograupel ) then - precflux(1:nzm) = precflux(1:nzm) & - - (mksed(:,iqci) + mksed(:,iqs) + mksed(:,iqg))*dtn/dz - else - precflux(1:nzm) = precflux(1:nzm) & - - (mksed(:,iqci) + mksed(:,iqs))*dtn/dz - end if -#else - precflux(1:nzm) = precflux(1:nzm) & - - (mksed(:,iqci) + mksed(:,iqs) + mksed(:,iqg))*dtn/dz -#endif -end if - -!!$if(doprecip) total_water_prec = total_water_prec - total_water() - -#ifdef CLUBB_CRM -if (docloud.or.doclubb) call micro_diagnose() ! leave this line here -if(doclubb) then - CF3D(1:nx, 1:ny, 1:nzm) = cloud_frac(1:nx, 1:ny, 2:nzm+1) - if(doicemicro) then - do i=1, nx - do j=1, ny - ice_cldfrac(:) = 0.0 - do k=1, nzm -! Ice cloud fraction: 0 at 0 C, and 100% at -35C. -! ice_cldfrac(k) = -(tmptabs(k)-T_freeze_K)/35.0 -! ice_cldfrac(k) = min(1.0, max(ice_cldfrac(k), 0.0)) - if(micro_field(i,j,k,iqci) .gt. 1.0e-8) then - ice_cldfrac(k) = 1.0 - end if - if(cloudliq(i,j,k) + micro_field(i,j,k,iqci) .gt.1.0e-9) then - CF3D(i,j,k) = (CF3D(i,j,k)* cloudliq(i,j,k) + ice_cldfrac(k) * micro_field(i,j,k,iqci)) & - / (cloudliq(i,j,k) + micro_field(i,j,k,iqci)) - else - CF3D(i,j,k) = 0.0 - end if - end do - end do - end do - endif -endif -#else -if (docloud) call micro_diagnose() ! leave this line here -#endif - -! call t_stopf ('micro_proc') - -end subroutine micro_proc - -!---------------------------------------------------------------------- -!!! Diagnose arrays nessesary for dynamical core and radiation: -! -! This is the pace where the microphysics field that SAM actually cares about -! are diagnosed. - -subroutine micro_diagnose() - -use crmx_vars -#ifdef CLUBB_CRM -use crmx_error_code, only: clubb_at_least_debug_level ! Procedure -use crmx_constants_clubb, only: fstderr, zero_threshold -implicit none -#endif - -real omn, omp -integer i,j,k - -! water vapor = total water - cloud liquid -qv(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqv) & - - cloudliq(1:nx,1:ny,1:nzm) - -#ifdef CLUBB_CRM -do i = 1, nx - do j = 1, ny - do k = 1, nzm - ! Apply local hole-filling to vapor by converting liquid to vapor. Moist - ! static energy should be conserved, so updating temperature is not - ! needed here. -dschanen 31 August 2011 - if ( qv(i,j,k) < zero_threshold ) then - cloudliq(i,j,k) = cloudliq(i,j,k) + qv(i,j,k) - qv(i,j,k) = zero_threshold - if ( cloudliq(i,j,k) < zero_threshold ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) "Total water at", "i =", i, "j =", j, "k =", k, "is negative.", & - "Applying non-conservative hard clipping." - end if - cloudliq(i,j,k) = zero_threshold - end if ! cloud_liq < 0 - end if ! qv < 0 - end do ! 1.. nzm - end do ! 1.. ny -end do ! 1.. nx -#endif /* CLUBB_CRM */ -! cloud liquid water -qcl(1:nx,1:ny,1:nzm) = cloudliq(1:nx,1:ny,1:nzm) - -! rain water -if(doprecip) qpl(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqr) - -! cloud ice -if(doicemicro) then - qci(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqci) - - if(dograupel) then - qpi(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqs) & - + micro_field(1:nx,1:ny,1:nzm,iqg) - else - qpi(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqs) - end if -end if - -end subroutine micro_diagnose - -#ifdef CLUBB_CRM -!--------------------------------------------------------------------- -subroutine micro_update() - -! Description: -! This subroutine essentially does what micro_proc does but does not -! call any microphysics subroutines. We need to do this for the -! single-moment bulk microphysics (SAM1MOM) so that CLUBB gets a -! properly updated value of ice fed in. -! -! -dschanen UWM -!--------------------------------------------------------------------- - - ! Update the dynamical core variables (e.g. qv, qcl) with the value in - ! micro_field. Diffusion, advection, and other processes are applied to - ! micro_field but not the variables in vars.f90 - call micro_diagnose() - - return -end subroutine micro_update - -!--------------------------------------------------------------------- -subroutine micro_adjust( new_qv, new_qc ) -! Description: -! Adjust total water in SAM based on values from CLUBB. -! References: -! None -!--------------------------------------------------------------------- - - use crmx_vars, only: qci - - implicit none - - real, dimension(nx,ny,nzm), intent(in) :: & - new_qv, & ! Water vapor mixing ratio that has been adjusted by CLUBB [kg/kg] - new_qc ! Cloud water mixing ratio that has been adjusted by CLUBB [kg/kg] - - ! Total water mixing ratio - micro_field(1:nx,1:ny,1:nzm,iqv) = new_qv(1:nx,1:ny,1:nzm) & - + new_qc(1:nx,1:ny,1:nzm) - - ! Cloud water mixing ratio - cloudliq(1:nx,1:ny,1:nzm) = new_qc(1:nx,1:ny,1:nzm) - - return -end subroutine micro_adjust - -#endif /*CLUBB_CRM*/ - -!---------------------------------------------------------------------- -!!! functions to compute terminal velocity for precipitating variables: -! -! you need supply functions to compute terminal velocity for all of your -! precipitating prognostic variables. Note that all functions should -! compute vertical velocity given two microphysics parameters var1, var2, -! and temperature, and water vapor (single values, not arrays). Var1 and var2 -! are some microphysics variables like water content and concentration. -! Don't change the number of arguments or their meaning! - -!!$real function term_vel_qr(qr,nr,tabs,rho) -!!$! ....... -!!$end function term_vel_qr -!!$ -!!$real function term_vel_Nr(qr,nr,tabs,rho) -!!$! ....... -!!$end function term_vel_Nr -!!$ -!!$real function term_vel_qs(qs,ns,tabs,rho) -!!$! ....... -!!$end function term_vel_qs - -! etc. - -!---------------------------------------------------------------------- -!!! compute sedimentation -! -! The perpose of this subroutine is to prepare variables needed to call -! the precip_all() for each of the falling hydrometeor varibles -subroutine micro_precip_fall() - -! before calling precip_fall() for each of falling prognostic variables, -! you need to set hydro_type and omega(:,:,:) variables. -! hydro_type can have four values: -! 0 - variable is liquid water mixing ratio -! 1 - hydrometeor is ice mixing ratio -! 2 - hydrometeor is mixture-of-liquid-and-ice mixing ratio. (As in original SAM microphysics). -! 3 - variable is not mixing ratio, but, for example, rain drop concentration -! OMEGA(:,:,:) is used only for hydro_type=2, and is the fraction of liquid phase (0-1). -! for hour hypothetical case, there is no mixed hydrometeor, so omega is not actually used. - -integer hydro_type -real omega(nx,ny,nzm) - -integer i,j,k - -return ! do not need this routine -- sedimentation done in m2005micro. - -!!$! Initialize arrays that accumulate surface precipitation flux -!!$ -!!$ if(mod(nstep-1,nstatis).eq.0.and.icycle.eq.1) then -!!$ do j=1,ny -!!$ do i=1,nx -!!$ precsfc(i,j)=0. -!!$ end do -!!$ end do -!!$ do k=1,nzm -!!$ precflux(k) = 0. -!!$ end do -!!$ end if -!!$ -!!$ do k = 1,nzm ! Initialize arrays which hold precipitation fluxes for stats. -!!$ qpfall(k)=0. -!!$ tlat(k) = 0. -!!$ end do -!!$ -!!$! Compute sedimentation of falling variables: -!!$ -!!$ hydro_type=0 -!!$ call precip_fall(qr, term_vel_qr, hydro_type, omega) -!!$ hydro_type=3 -!!$ call precip_fall(Nr, term_vel_Nr, hydro_type, omega) -!!$ hydro_type=1 -!!$ call precip_fall(qs, term_vel_qs, hydro_type, omega) -!!$ hydro_type=3 -!!$ call precip_fall(Ns, term_vel_Ns, hydro_type, omega) -!!$ hydro_type=1 -!!$ call precip_fall(qg, term_vel_qg, hydro_type, omega) -!!$ hydro_type=3 -!!$ call precip_fall(Ng, term_vel_Ng, hydro_type, omega) -!!$ - - -end subroutine micro_precip_fall - -!---------------------------------------------------------------------- -! called when stepout() called - -subroutine micro_print() - implicit none - integer :: k - - ! print out min/max values of all microphysical variables - do k=1,nmicro_fields - call fminmax_print(trim(mkname(k))//':', & - micro_field(:,:,:,k),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm) - end do - -end subroutine micro_print - -!----------------------------------------- -subroutine satadj_liquid(nzm,tabs,qt,qc,pres) - !bloss/qt: Utility routine based on cloud.f90 in - ! MICRO_SAM1MOM that was written by Marat Khairoutdinov. - ! This routine performs a saturation adjustment for - ! cloud liquid water only using a Newton method. - ! While 20 iterations are allowed, most often this - ! routine should exit in five iterations or less. - ! Only a single calculation of the saturation vapor - ! pressure is required in subsaturated air. - - use crmx_module_mp_GRAUPEL, only: polysvp - use crmx_params, only: cp, lcond, rv, fac_cond - implicit none - - integer, intent(in) :: nzm - real, intent(inout), dimension(nzm) :: tabs ! absolute temperature, K - real, intent(inout), dimension(nzm) :: qt ! on input: qt; on output: qv - real, intent(out), dimension(nzm) :: qc ! cloud liquid water, kg/kg - real, intent(in), dimension(nzm) :: pres ! pressure, Pa - - real tabs1, dtabs, thresh, esat1, qsat1, fff, dfff - integer k, niter - - integer, parameter :: maxiter = 20 - - !bloss/qt: quick saturation adjustment to compute cloud liquid water content. - do k = 1,nzm - tabs1 = tabs(k) - esat1 = polysvp(tabs1,0) - qsat1 = 0.622*esat1/ (pres(k) - esat1) - qc(k) = 0. ! no cloud unless qt > qsat - - if (qt(k).gt.qsat1) then - - ! if unsaturated, nothing to do (i.e., qv=qt, T=Tl) --> just exit. - ! if saturated, do saturation adjustment - ! (modeled after Marat's cloud.f90). - - ! generate initial guess based on above calculation of qsat - dtabs = + fac_cond*MAX(0.,qt(k) - qsat1) & - / ( 1. + lcond**2*qsat1/(cp*rv*tabs1**2) ) - tabs1 = tabs1 + dtabs - niter = 1 - - ! convergence threshold: min of 0.01K and latent heating due to - ! condensation of 1% of saturation mixing ratio. - thresh = MIN(0.01, 0.01*fac_cond*qsat1) - - ! iterate while temperature increment > thresh and niter < maxiter - do while((ABS(dtabs).GT.thresh) .AND. (niter.lt.maxiter)) - - esat1 = polysvp(tabs1,0) - qsat1 = 0.622*esat1/ (pres(k) - esat1) ! saturation mixing ratio - - fff = tabs(k) - tabs1 + fac_cond*MAX(0.,qt(k) - qsat1) - dfff = 1. + lcond**2*qsat1/(cp*rv*tabs1**2) - dtabs = fff/dfff - tabs1 = tabs1 + dtabs - - niter = niter + 1 - - end do - - qc(k) = MAX( 0.,tabs1 - tabs(k) )/fac_cond ! cloud liquid mass mixing ratio - qt(k) = qt(k) - qc(k) ! This now holds the water vapor mass mixing ratio. - tabs(k) = tabs1 ! update temperature. - - if(niter.gt.maxiter-1) write(*,*) 'Reached iteration limit in satadj_liquid' - - end if ! qt_in > qsat - - end do ! k = 1,nzm - -end subroutine satadj_liquid - -!----------------------------------------------------------------------- -! Supply function that computes total water in a domain: -! -real(kind=selected_real_kind(12)) function total_water() - - use crmx_vars, only : nstep,nprint,adz,dz,rho - real(kind=selected_real_kind(12)) tmp - integer i,j,k,m - - total_water = 0. - do m=1,nmicro_fields - if(flag_wmass(m).eq.1) then - do k=1,nzm - tmp = 0. - do j=1,ny - do i=1,nx - tmp = tmp + micro_field(i,j,k,m) - end do - end do - total_water = total_water + tmp*adz(k)*dz*rho(k) - end do - end if - end do - -end function total_water - -function Get_reffc() ! liquid water - real, dimension(nx,ny,nzm) :: Get_reffc - Get_reffc = reffc -end function Get_reffc - -function Get_reffi() ! ice - real, dimension(nx,ny,nzm) :: Get_reffi - Get_reffi = reffi -end function Get_reffi -#ifdef CLUBB_CRM -!------------------------------------------------------------------------------- -ELEMENTAL FUNCTION LIN_INT( var_high, var_low, height_high, height_low, height_int ) - -! This function computes a linear interpolation of the value of variable. -! Given two known values of a variable at two height values, the value -! of that variable at a height between those two height levels (rather -! than a height outside of those two height levels) is computed. -! -! Here is a diagram: -! -! ################################ Height high, know variable value -! -! -! -! -------------------------------- Height to be interpolated to; linear interpolation -! -! -! -! -! -! ################################ Height low, know variable value -! -! -! FORMULA: -! -! variable(@ Height interpolation) = -! -! [ (variable(@ Height high) - variable(@ Height low)) / (Height high - Height low) ] -! * (Height interpolation - Height low) + variable(@ Height low) - -! Author: Brian Griffin, UW-Milwaukee -! Modifications: Dave Schanen added the elemental attribute 4 Nov 2008 -! References: None - -IMPLICIT NONE - -! Input Variables -REAL, INTENT(IN):: var_high -REAL, INTENT(IN):: var_low -REAL, INTENT(IN):: height_high -REAL, INTENT(IN):: height_low -REAL, INTENT(IN):: height_int - -! Output Variable -REAL:: LIN_INT - -LIN_INT = ( var_high - var_low ) / ( height_high - height_low ) & - * ( height_int - height_low ) + var_low - - -END FUNCTION LIN_INT -#endif /*CLUBB_CRM*/ -!------------------------------------------------------------------------------ - -end module crmx_microphysics - - - diff --git a/src/physics/spcam/crm/MICRO_M2005/crmx_module_mp_graupel.F90 b/src/physics/spcam/crm/MICRO_M2005/crmx_module_mp_graupel.F90 deleted file mode 100644 index fd945c4a89..0000000000 --- a/src/physics/spcam/crm/MICRO_M2005/crmx_module_mp_graupel.F90 +++ /dev/null @@ -1,6884 +0,0 @@ -!WRF:MODEL_LAYER:PHYSICS -!HM: This is version 2 of Hugh Morrison's two moment, five class scheme. -! - -! THIS MODULE CONTAINS THE TWO-MOMENT MICROPHYSICS CODE DESCRIBED BY -! MORRISON ET AL. (2009, MWR) -! recent changes with respect to V1.4 - -! V1.5 -! 1) more pathways to allow hail to form (only affects IHAIL=1 option), from collisions of snow/cloud water -! 2) bug fix to PGAM calculation (multiplication instead of division by air density) - -! V1.6 -! 1) added parameter TMELT for all calculations involving melting point -! 2) replaced hard-wired gas constant for air with parameter value 'R' - -! V1.7 -! 1) modification to minimum mixing ratio in dry conditions, change from 10^-6 to 10^-8 kg/kg -! to improve reflectivity at low mixing ratio amounts -! 2) bug fix to prevent possible division by zero error involving LAMI -! 3) change for liquid saturation vapor pressure, replace old formula with Flatau et al. 1992 - -! V2 -! 1) bug fix to maximum-allowed particle fallspeeds (air density correction factor considered) -! 2) change to comments - -! *** Changes incorporated from WRF: *** -! CHANGES FOR V3.2, RELATIVE TO MOST RECENT (BUG-FIX) CODE FOR V3.1 - -! 1) ADDED ACCELERATED MELTING OF GRAUPEL/SNOW DUE TO COLLISION WITH RAIN, FOLLOWING LIN ET AL. (1983) -! 2) INCREASED MINIMUM LAMBDA FOR RAIN, AND ADDED RAIN DROP BREAKUP FOLLOWING MODIFIED VERSION -! OF VERLINDE AND COTTON (1993) -! 3) CHANGE MINIMUM ALLOWED MIXING RATIOS IN DRY CONDITIONS (RH < 90%), THIS IMPROVES RADAR REFLECTIIVITY -! IN LOW REFLECTIVITY REGIONS -! 4) BUG FIX TO MAXIMUM ALLOWED PARTICLE FALLSPEEDS AS A FUNCTION OF AIR DENSITY -! 5) BUG FIX TO CALCULATION OF LIQUID WATER SATURATION VAPOR PRESSURE (CHANGE IS VERY MINOR) - -! bug fix, 5/12/10 -! 6) bug fix for saturation vapor pressure in low pressure, to avoid division by zero - -! CHANGES FOR V3.3 -! 1) MODIFY FALLSPEED BELOW THE LOWEST LEVEL OF PRECIPITATION, WHICH PREVENTS -! POTENTIAL FOR SPURIOUS ACCUMULATION OF PRECIPITATION DURING SUB-STEPPING FOR SEDIMENTATION -! 2) BUG FIX TO LATENT HEAT RELEASE DUE TO COLLISIONS OF CLOUD ICE WITH RAIN -! 3) CLEAN UP OF COMMENTS IN THE CODE -! additional minor bug fixes and small changes, 5/30/2011 (CLUBB/SAM-CLUBB as of 5 Oct 2011) -! minor revisions by A. Ackerman April 2011: -! 1) replaced kinematic with dynamic viscosity -! 2) replaced scaling by air density for cloud droplet sedimentation -! with viscosity-dependent Stokes expression -! 3) use Ikawa and Saito (1991) air-density scaling for cloud ice -! 4) corrected typo in 2nd digit of ventilation constant F2R - -! Additional fixes -! 5) TEMPERATURE FOR ACCELERATED MELTING DUE TO COLLIIONS OF SNOW AND GRAUPEL -! WITH RAIN SHOULD USE CELSIUS, NOT KELVIN (BUG REPORTED BY K. VAN WEVERBERG) -! 6) NPRACS IS NO SUBTRACTED SUBTRACTED FROM SNOW NUMBER CONCENTRATION, SINCE -! DECREASE IN SNOW NUMBER IS ALREADY ACCOUNTED FOR BY NSMLTS -! 7) MODIFY FALLSPEED BELOW THE LOWEST LEVEL OF PRECIPITATION, WHICH PREVENTS -! POTENTIAL FOR SPURIOUS ACCUMULATION OF PRECIPITATION DURING SUB-STEPPING FOR SEDIMENTATION -! 8) BUG FIX TO LATENT HEAT RELEASE DUE TO COLLISIONS OF CLOUD ICE WITH RAIN -! 9) BUG FIX TO IGRAUP SWITCH FOR NO GRAUPEL/HAIL - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! THIS SCHEME IS A BULK DOUBLE-MOMENT SCHEME THAT PREDICTS MIXING -! RATIOS AND NUMBER CONCENTRATIONS OF FIVE HYDROMETEOR SPECIES: -! CLOUD DROPLETS, CLOUD (SMALL) ICE, RAIN, SNOW, AND GRAUPEL. - -MODULE crmx_module_mp_GRAUPEL -!bloss USE module_wrf_error -!bloss USE module_utility, ONLY: WRFU_Clock, WRFU_Alarm ! GT -!bloss USE module_domain, ONLY : HISTORY_ALARM, Is_alarm_tstep ! GT - -! USE module_state_description -#ifdef CLUBB_CRM - use crmx_constants_clubb, only: Lv, Ls, Cp, Rv, Rd, T_freeze_K, rho_lw, grav, EP_2 => ep -#else - ! parameters from SAM and options from wrapper routine. - use crmx_params, only: lcond, lsub, cp, rgas, rv -#endif /*CLUBB_CRM*/ - -#if (defined CRM && defined MODAL_AERO) - use crmx_drop_activation, only: drop_activation_ghan - use cam_abortutils, only: endrun -#endif - - IMPLICIT NONE - -! Adding coefficient term for clex9_oct14 case. This will reduce NNUCCD and NNUCCC -! by some factor to allow cloud to persist at realistic time intervals. - -#ifdef CLUBB_CRM -! REAL, SAVE :: NNUCCD_REDUCE_COEF = 1.0, NNUCCC_REDUCE_COEF = 1.0 - REAL, SAVE :: NNUCCD_REDUCE_COEF = 1.0, NNUCCC_REDUCE_COEF = 1.0e-2 -#endif - -! Change by Marc Pilon on 11/16/11 - - - REAL, PARAMETER :: PI = 3.1415926535897932384626434 - REAL, PARAMETER :: SQRTPI = 0.9189385332046727417803297 - - PUBLIC :: MP_GRAUPEL - PUBLIC :: POLYSVP - - PRIVATE :: GAMMA, DERF1 - PRIVATE :: PI, SQRTPI - PUBLIC :: M2005MICRO_GRAUPEL !bloss - - !bloss: added options that may be set in prm file namelist - ! -- initialized in micrphysics.f90 - logical, public :: & - doicemicro, & ! use ice species (snow/cloud ice/graupel) - dograupel, & ! use graupel - dohail, & ! make graupel species have properties of hail - dosb_warm_rain, & ! use Seifert & Beheng (2001) warm rain parameterization - dopredictNc, & ! prediction of cloud droplet number - dosubgridw, & ! input estimate of subgrid w to microphysics - doarcticicenucl, & ! use arctic parameter values for ice nucleation - docloudedgeactivation,& ! activate cloud droplets throughout the cloud - dofix_pgam ! option to fix value of pgam (exponent in cloud water gamma distn) - -#ifdef CLUBB_CRM - logical, public :: doclubb_tb ! use clubb as a turbulence scheme only +++mhwang - ! so liquid water is diagnosed based on saturaiton adjustment - logical, public :: doclubb_gridmean ! if .true., grid-mean values from CLUBB feeds into - ! Morrison microphysics - logical, public :: doclubb_autoin ! in-cloud values for autoconversion -#endif - - integer, public :: & - aerosol_mode ! determines aerosol mode used - ! 0 = no aerosol mode - ! 1 = power-law - ! 2 = lognormal -#if (defined CRM && defined MODAL_AERO) - logical, public :: domodal_aero ! use modal aerosol from the CAM -#endif - - real, public :: & - Nc0, & ! specified cloud droplet number conc (#/cm3) - ccnconst, ccnexpnt, & ! dospecifyaerosol=.false. params (powerlaw CCN) - aer_rm1, aer_rm2, & ! two modes of aerosol for dospecifyaer...=.true. - aer_n1, aer_n2, & ! rm=geom mean radius (um), n=aer conc. (#/cm3) - aer_sig1, aer_sig2, & ! sig=geom standard deviation of aer size distn. - pgam_fixed ! fixed value of pgam used if dofix_pgam=.true. - -! SWITCHES FOR MICROPHYSICS SCHEME -! IACT = 1, USE POWER-LAW CCN SPECTRA, NCCN = CS^K -! IACT = 2, USE LOGNORMAL AEROSOL SIZE DIST TO DERIVE CCN SPECTRA -! There's no IACT = 3 in SAM / SAM-CLUBB as per WRF -#if (defined CRM && defined MODAL_AERO) -! IACT = 3, USE MULTIMODE AEROSOL SIZE DIST to DERIVER CCN SPECTRA -#endif - - INTEGER, PRIVATE :: IACT - -! INUM = 0, PREDICT DROPLET CONCENTRATION -! INUM = 1, ASSUME CONSTANT DROPLET CONCENTRATION - - INTEGER, PRIVATE :: INUM - -! FOR INUM = 1, SET CONSTANT DROPLET CONCENTRATION (CM-3) - REAL, PRIVATE :: NDCNST - -! SWITCH FOR LIQUID-ONLY RUN -! ILIQ = 0, INCLUDE ICE -! ILIQ = 1, LIQUID ONLY, NO ICE - - INTEGER, PRIVATE :: ILIQ - -! SWITCH FOR ICE NUCLEATION -! INUC = 0, USE FORMULA FROM RASMUSSEN ET AL. 2002 (MID-LATITUDE) -! = 1, USE MPACE OBSERVATIONS - - INTEGER, PRIVATE :: INUC - -! IBASE = 1, NEGLECT DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO -! UNRESOLVED ENTRAINMENT AND MIXING, ACTIVATE -! AT CLOUD BASE OR IN REGION WITH LITTLE CLOUD WATER USING -! NON-EQULIBRIUM SUPERSATURATION, -! IN CLOUD INTERIOR ACTIVATE USING EQUILIBRIUM SUPERSATURATION -! IBASE = 2, ASSUME DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO -! UNRESOLVED ENTRAINMENT AND MIXING DOMINATES, -! ACTIVATE DROPLETS EVERYWHERE IN THE CLOUD USING NON-EQUILIBRIUM -! SUPERSATURATION, BASED ON THE -! LOCAL SUB-GRID AND/OR GRID-SCALE VERTICAL VELOCITY -! AT THE GRID POINT - -! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0) - - INTEGER, PRIVATE :: IBASE - -! INCLUDE SUB-GRID VERTICAL VELOCITY IN DROPLET ACTIVATION -! ISUB = 0, INCLUDE SUB-GRID W (RECOMMENDED FOR LOWER RESOLUTION) -! ISUB = 1, EXCLUDE SUB-GRID W, ONLY USE GRID-SCALE W - - INTEGER, PRIVATE :: ISUB - -! SWITCH FOR GRAUPEL/NO GRAUPEL -! IGRAUP = 0, INCLUDE GRAUPEL -! IGRAUP = 1, NO GRAUPEL - - INTEGER, PRIVATE :: IGRAUP - -! HM ADDED NEW OPTION FOR HAIL V1.3 -! SWITCH FOR HAIL/GRAUPEL -! IHAIL = 0, DENSE PRECIPITATING ICE IS GRAUPEL -! IHAIL = 1, DENSE PRECIPITATING GICE IS HAIL - - INTEGER, PRIVATE :: IHAIL - -! HM ADDED 8/1/08, v1.4 -! SWITCH FOR WARM RAIN SCHEME -! IRAIN = 0, WARM RAIN (AUTO, ACC, SELF-COLL) FROM KHAIROUTIDNOV AND KOGAN (2000) -! IRAIN = 1, WARM RAIN (AUTO, ACC, SELF-COLL) FROM SEIFERT AND BEHENG (2001) - - INTEGER, PRIVATE :: IRAIN - -! PB ADDED 4/13/09 -! SWITCH TO TURN ON/OFF CLOUD LIQUID WATER SATURATION ADJUSTMENT -! WHEN USING TOTAL WATER FORMULATION IN SAM, THE SATURATION -! ADJUSTMENT IS PERFORMED BEFORE CALLING M2005MICRO_GRAUPEL. -! THIS OPTION ALLOWS US TO AVOID PERFORMING IT IN M2005MICRO_GRAUPEL -! UNDER THE THEORY THAT THE OTHER MICROPHYSICAL PROCESSES WILL NOT -! DRIVE IT FAR FROM SATURATION. -! ISATADJ = 0, SATURATION ADJUSTMENT PEROFORMED IN M2005MICRO_GRAUPEL -! ISATADJ = 1, SATURATION ADJUSTMENT _NOT_ PEROFORMED IN M2005MICRO_GRAUPEL - - INTEGER, PRIVATE :: ISATADJ - -! CLOUD MICROPHYSICS CONSTANTS - - REAL, PRIVATE :: AI,AC,AS,AR,AG ! 'A' PARAMETER IN FALLSPEED-DIAM RELATIONSHIP - REAL, PRIVATE :: BI,BC,BS,BR,BG ! 'B' PARAMETER IN FALLSPEED-DIAM RELATIONSHIP - REAL, PRIVATE :: R ! GAS CONSTANT FOR AIR -!bloss REAL, PRIVATE :: RV ! GAS CONSTANT FOR WATER VAPOR -!bloss REAL, PRIVATE :: CP ! SPECIFIC HEAT AT CONSTANT PRESSURE FOR DRY AIR - REAL, PRIVATE :: RHOSU ! STANDARD AIR DENSITY AT 850 MB - REAL, PRIVATE :: RHOW ! DENSITY OF LIQUID WATER - REAL, PRIVATE :: RHOI ! BULK DENSITY OF CLOUD ICE - REAL, PRIVATE :: RHOSN ! BULK DENSITY OF SNOW - REAL, PRIVATE :: RHOG ! BULK DENSITY OF GRAUPEL - REAL, PRIVATE :: AIMM ! PARAMETER IN BIGG IMMERSION FREEZING - REAL, PRIVATE :: BIMM ! PARAMETER IN BIGG IMMERSION FREEZING - REAL, PRIVATE :: ECR ! COLLECTION EFFICIENCY BETWEEN DROPLETS/RAIN AND SNOW/RAIN - REAL, PRIVATE :: DCS ! THRESHOLD SIZE FOR CLOUD ICE AUTOCONVERSION - REAL, PRIVATE :: MI0 ! INITIAL SIZE OF NUCLEATED CRYSTAL - REAL, PRIVATE :: MG0 ! MASS OF EMBRYO GRAUPEL - REAL, PRIVATE :: F1S ! VENTILATION PARAMETER FOR SNOW - REAL, PRIVATE :: F2S ! VENTILATION PARAMETER FOR SNOW - REAL, PRIVATE :: F1R ! VENTILATION PARAMETER FOR RAIN - REAL, PRIVATE :: F2R ! VENTILATION PARAMETER FOR RAIN - REAL, PRIVATE :: G ! GRAVITATIONAL ACCELERATION - REAL, PRIVATE :: QSMALL ! SMALLEST ALLOWED HYDROMETEOR MIXING RATIO - REAL, PRIVATE :: CI,DI,CS,DS,CG,DG ! SIZE DISTRIBUTION PARAMETERS FOR CLOUD ICE, SNOW, GRAUPEL - REAL, PRIVATE :: EII ! COLLECTION EFFICIENCY, ICE-ICE COLLISIONS - REAL, PRIVATE :: ECI ! COLLECTION EFFICIENCY, ICE-DROPLET COLLISIONS - REAL, PRIVATE :: RIN ! RADIUS OF CONTACT NUCLEI (M) -! V1.6 - REAL, PRIVATE :: TMELT ! melting temp (K) -! hm, add for V2.1 - REAL, PRIVATE :: CPW ! SPECIFIC HEAT OF LIQUID WATER - -! CCN SPECTRA FOR IACT = 1 - - REAL, PRIVATE :: C1 ! 'C' IN NCCN = CS^K (CM-3) - REAL, PRIVATE :: K1 ! 'K' IN NCCN = CS^K - -! AEROSOL PARAMETERS FOR IACT = 2 - - REAL, PRIVATE :: MW ! MOLECULAR WEIGHT WATER (KG/MOL) - REAL, PRIVATE :: OSM ! OSMOTIC COEFFICIENT - REAL, PRIVATE :: VI ! NUMBER OF ION DISSOCIATED IN SOLUTION - REAL, PRIVATE :: EPSM ! AEROSOL SOLUBLE FRACTION - REAL, PRIVATE :: RHOA ! AEROSOL BULK DENSITY (KG/M3) - REAL, PRIVATE :: MAP ! MOLECULAR WEIGHT AEROSOL (KG/MOL) - REAL, PRIVATE :: MA ! MOLECULAR WEIGHT OF 'AIR' (KG/MOL) - REAL, PRIVATE :: RR ! UNIVERSAL GAS CONSTANT - REAL, PRIVATE :: BACT ! ACTIVATION PARAMETER - REAL, PRIVATE :: RM1 ! GEOMETRIC MEAN RADIUS, MODE 1 (M) - REAL, PRIVATE :: RM2 ! GEOMETRIC MEAN RADIUS, MODE 2 (M) - REAL, PRIVATE :: NANEW1 ! TOTAL AEROSOL CONCENTRATION, MODE 1 (M^-3) - REAL, PRIVATE :: NANEW2 ! TOTAL AEROSOL CONCENTRATION, MODE 2 (M^-3) - REAL, PRIVATE :: SIG1 ! STANDARD DEVIATION OF AEROSOL S.D., MODE 1 - REAL, PRIVATE :: SIG2 ! STANDARD DEVIATION OF AEROSOL S.D., MODE 2 - REAL, PRIVATE :: F11 ! CORRECTION FACTOR FOR ACTIVATION, MODE 1 - REAL, PRIVATE :: F12 ! CORRECTION FACTOR FOR ACTIVATION, MODE 1 - REAL, PRIVATE :: F21 ! CORRECTION FACTOR FOR ACTIVATION, MODE 2 - REAL, PRIVATE :: F22 ! CORRECTION FACTOR FOR ACTIVATION, MODE 2 - REAL, PRIVATE :: MMULT ! MASS OF SPLINTERED ICE PARTICLE - REAL, PRIVATE :: LAMMAXI,LAMMINI,LAMMAXR,LAMMINR,LAMMAXS,LAMMINS,LAMMAXG,LAMMING - -! CONSTANTS TO IMPROVE EFFICIENCY - - REAL, PRIVATE :: CONS1,CONS2,CONS3,CONS4,CONS5,CONS6,CONS7,CONS8,CONS9,CONS10 - REAL, PRIVATE :: CONS11,CONS12,CONS13,CONS14,CONS15,CONS16,CONS17,CONS18,CONS19,CONS20 - REAL, PRIVATE :: CONS21,CONS22,CONS23,CONS24,CONS25,CONS26,CONS27,CONS28,CONS29,CONS30 - REAL, PRIVATE :: CONS31,CONS32,CONS33,CONS34,CONS35,CONS36,CONS37,CONS38,CONS39,CONS40 - REAL, PRIVATE :: CONS41 - -! v1.4 - REAL, PRIVATE :: dnu(16) - -!..Various radar related variables, from GT - -!..Lookup table dimensions - INTEGER, PARAMETER, PRIVATE:: nbins = 100 - INTEGER, PARAMETER, PRIVATE:: nbr = nbins - INTEGER, PARAMETER, PRIVATE:: nbs = nbins - INTEGER, PARAMETER, PRIVATE:: nbg = nbins - REAL(kind=selected_real_kind(12)), DIMENSION(nbins+1):: ddx - REAL(kind=selected_real_kind(12)), DIMENSION(nbr):: Dr, dtr - REAL(kind=selected_real_kind(12)), DIMENSION(nbs):: Dds, dts - REAL(kind=selected_real_kind(12)), DIMENSION(nbg):: Ddg, dtg - REAL(kind=selected_real_kind(12)), PARAMETER, PRIVATE:: lamda_radar = 0.10 ! in meters - REAL(kind=selected_real_kind(12)), PRIVATE:: K_w, PI5, lamda4 - COMPLEX*16, PRIVATE:: m_w_0, m_i_0 - REAL(kind=selected_real_kind(12)), DIMENSION(nbins+1), PRIVATE:: simpson - REAL(kind=selected_real_kind(12)), DIMENSION(3), PARAMETER, PRIVATE:: basis = & - (/1.d0/3.d0, 4.d0/3.d0, 1.d0/3.d0/) - - INTEGER, PARAMETER, PRIVATE:: slen = 20 - CHARACTER(len=slen), PRIVATE:: & - mixingrulestring_s, matrixstring_s, inclusionstring_s, & - hoststring_s, hostmatrixstring_s, hostinclusionstring_s, & - mixingrulestring_g, matrixstring_g, inclusionstring_g, & - hoststring_g, hostmatrixstring_g, hostinclusionstring_g - - REAL, PARAMETER, PRIVATE:: D0r = 50.E-6 - REAL, PARAMETER, PRIVATE:: D0s = 100.E-6 - REAL, PARAMETER, PRIVATE:: D0g = 100.E-6 - CHARACTER*256:: mp_debug -#ifdef CLUBB_CRM - REAL, PARAMETER, PUBLIC :: cloud_frac_thresh = 0.005 -#endif /* CLUBB_CRM */ - -CONTAINS - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -SUBROUTINE GRAUPEL_INIT -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! THIS SUBROUTINE INITIALIZES ALL PHYSICAL CONSTANTS AMND PARAMETERS -! NEEDED BY THE MICROPHYSICS SCHEME. -! NEEDS TO BE CALLED AT FIRST TIME STEP, PRIOR TO CALL TO MAIN MICROPHYSICS INTERFACE -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - IMPLICIT NONE - - integer n,i - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! THE FOLLOWING PARAMETERS ARE USER-DEFINED SWITCHES AND NEED TO BE -! SET PRIOR TO CODE COMPILATION - -! INUM = 0, PREDICT DROPLET CONCENTRATION -! INUM = 1, ASSUME CONSTANT DROPLET CONCENTRATION - - INUM = 1 !bloss: use flag in prm file - if(dopredictNc) then - INUM = 0 - end if - -! FOR INUM = 1, SET CONSTANT DROPLET CONCENTRATION (UNITS OF CM-3) - - NDCNST = Nc0 !bloss: use value from prm file (default=100.) - -! IACT = 1, USE POWER-LAW CCN SPECTRA, NCCN = CS^K -! IACT = 2, USE LOGNORMAL AEROSOL SIZE DIST TO DERIVE CCN SPECTRA -! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0) -#if (defined CRM && defined MODAL_AERO) -! IACT = 3, USE MULTIMODE AEROSOL SIZE DIST to DERIVER CCN SPECTRA -#endif - - if( aerosol_mode == 2 ) then !bloss: specify using flag from prm file -#if (defined CRM && defined MODAL_AERO) - if(domodal_aero) then - IACT = 3 - else -#endif - IACT = 2 -#if (defined CRM && defined MODAL_AERO) - endif -#endif - else if( aerosol_mode == 1 ) then - IACT = 1 - else - IACT = 0 - end if - -! IBASE = 1, NEGLECT DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO -! UNRESOLVED ENTRAINMENT AND MIXING, ACTIVATE -! AT CLOUD BASE OR IN REGION WITH LITTLE CLOUD WATER USING -! NON-EQULIBRIUM SUPERSATURATION ASSUMING NO INITIAL CLOUD WATER, -! IN CLOUD INTERIOR ACTIVATE USING EQUILIBRIUM SUPERSATURATION -! IBASE = 2, ASSUME DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO -! UNRESOLVED ENTRAINMENT AND MIXING DOMINATES, -! ACTIVATE DROPLETS EVERYWHERE IN THE CLOUD USING NON-EQUILIBRIUM -! SUPERSATURATION ASSUMING NO INITIAL CLOUD WATER, BASED ON THE -! LOCAL SUB-GRID AND/OR GRID-SCALE VERTICAL VELOCITY -! AT THE GRID POINT - -! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0) - - if(docloudedgeactivation) then - IBASE = 2 - else - IBASE = 1 - end if - -! INCLUDE SUB-GRID VERTICAL VELOCITY IN DROPLET ACTIVATION -! ISUB = 0, INCLUDE SUB-GRID W (RECOMMENDED FOR LOWER RESOLUTION) -! ISUB = 1, EXCLUDE SUB-GRID W, ONLY USE GRID-SCALE W - -! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0) - - if(dosubgridw) then - ISUB = 0 - else - ISUB = 1 - end if - -! SWITCH FOR LIQUID-ONLY RUN -! ILIQ = 0, INCLUDE ICE -! ILIQ = 1, LIQUID ONLY, NO ICE - - if(doicemicro) then !bloss: specify using flag from prm file - ILIQ = 0 - else - ILIQ = 1 - end if - -! SWITCH FOR ICE NUCLEATION -! INUC = 0, USE FORMULA FROM RASMUSSEN ET AL. 2002 (MID-LATITUDE) -! = 1, USE MPACE OBSERVATIONS (ARCTIC ONLY) - - if(doarcticicenucl) then !bloss: specify using flag from prm file - INUC = 1 - else - INUC = 0 - end if - -! SWITCH FOR GRAUPEL/NO GRAUPEL -! IGRAUP = 0, INCLUDE GRAUPEL -! IGRAUP = 1, NO GRAUPEL - - if(dograupel) then - IGRAUP = 0 - else - IGRAUP = 1 - end if - -! HM ADDED 11/7/07, V1.3 -! SWITCH FOR HAIL/GRAUPEL -! IHAIL = 0, DENSE PRECIPITATING ICE IS GRAUPEL -! IHAIL = 1, DENSE PRECIPITATING ICE IS HAIL - - if(dohail) then - IHAIL = 1 - else - IHAIL = 0 - end if - -! HM ADDED 8/1/08, v1.4 -! SWITCH FOR WARM RAIN SCHEME -! IRAIN = 0, WARM RAIN (AUTO, ACC, SELF-COLL) FROM KHAIROUTIDNOV AND KOGAN (2000) -! IRAIN = 1, WARM RAIN (AUTO, ACC, SELF-COLL) FROM SEIFERT AND BEHENG (2001) - - if(dosb_warm_rain) then - IRAIN = 1 - else - IRAIN = 0 - end if - -! PB ADDED 4/13/09. TURN OFF SATURATION ADJUSTMENT WITHIN M2005MICRO_GRAUPEL -! IN TOTAL WATER VERSION. IT NOW TAKES PLACE BEFORE M2005MICRO_GRAUPEL IS CALLED. - -#ifdef CLUBB_CRM -! ISATADJ = 0 ! Enable for CLUBB - ISATADJ = 1 ! When CLUBB is called, saturation adjustment is done in CLUBB, - ! so should we set ISATADJ=1 here? test by Minghuai Wang +++mhwang -#else - ISATADJ = 1 -#endif - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! SET PHYSICAL CONSTANTS - -! FALLSPEED PARAMETERS (V=AD^B) - AI = 700. - AC = 3.E7 - AS = 11.72 - AR = 841.99667 - BI = 1. - BC = 2. - BS = 0.41 - BR = 0.8 -! V1.3 - IF (IHAIL.EQ.0) THEN - AG = 19.3 - BG = 0.37 - ELSE ! (MATSUN AND HUGGINS 1980) - AG = 114.5 - BG = 0.5 - END IF - -#ifdef CLUBB_CRM - ! Use CLUBB values for constants - R = Rd - RHOW = rho_lw - TMELT = T_freeze_K - RHOSU = 85000./(R*TMELT) -#else -! CONSTANTS AND PARAMETERS - !bloss: use values from params module - R = rgas -!bloss R = 287.15 -!bloss RV = 465.5 -!bloss CP = 1005. -! V1.6 - TMELT = 273.15 -#endif -! V1.6 - RHOSU = 85000./(R*TMELT) - RHOW = 997. - RHOI = 500. - RHOSN = 100. -! V1.3 - IF (IHAIL.EQ.0) THEN - RHOG = 400. - ELSE - RHOG = 900. - END IF - AIMM = 0.66 - BIMM = 100. - ECR = 1. - DCS = 125.E-6 - MI0 = 4./3.*PI*RHOI*(10.E-6)**3 - MG0 = 1.6E-10 - F1S = 0.86 - F2S = 0.28 - F1R = 0.78 -! V3 5/27/11 -! F2R = 0.32 -! AA revision 4/1/11 - F2R = 0.308 - -#ifdef CLUBB_CRM - G = grav - ! Should this be set to SAM's ggr if CLUBB is not defined? -#else - G = 9.806 -#endif - QSMALL = 1.E-14 - EII = 0.1 - ECI = 0.7 -! HM, ADD FOR V3.2 - CPW = 4218. - -! SIZE DISTRIBUTION PARAMETERS - - CI = RHOI*PI/6. - DI = 3. - CS = RHOSN*PI/6. - DS = 3. - CG = RHOG*PI/6. - DG = 3. - -! RADIUS OF CONTACT NUCLEI - RIN = 0.1E-6 - - MMULT = 4./3.*PI*RHOI*(5.E-6)**3 - -! SIZE LIMITS FOR LAMBDA - - LAMMAXI = 1./1.E-6 - LAMMINI = 1./(2.*DCS+100.E-6) - LAMMAXR = 1./20.E-6 -! LAMMINR = 1./500.E-6 - LAMMINR = 1./2800.E-6 - LAMMAXS = 1./10.E-6 - LAMMINS = 1./2000.E-6 - LAMMAXG = 1./20.E-6 - LAMMING = 1./2000.E-6 - -! CCN SPECTRA FOR IACT = 1 - -! MARITIME -! MODIFIED FROM RASMUSSEN ET AL. 2002 -! NCCN = C*S^K, NCCN IS IN CM-3, S IS SUPERSATURATION RATIO IN % - - K1 = ccnexpnt !bloss: specify using values from prm file - C1 = ccnconst !bloss - -!bloss K1 = 0.4 -!bloss C1 = 120. - -! CONTINENTAL - -! K1 = 0.5 -! C1 = 1000. - -! AEROSOL ACTIVATION PARAMETERS FOR IACT = 2 -! PARAMETERS CURRENTLY SET FOR AMMONIUM SULFATE - - MW = 0.018 - OSM = 1. - VI = 3. - EPSM = 0.7 - RHOA = 1777. - MAP = 0.132 - MA = 0.0284 - RR = 8.3187 - BACT = VI*OSM*EPSM*MW*RHOA/(MAP*RHOW) - -! AEROSOL SIZE DISTRIBUTION PARAMETERS CURRENTLY SET FOR MPACE -! (see morrison et al. 2007, JGR) -! MODE 1 - - RM1 = aer_rm1 !bloss: specify using values from prm file - SIG1 = aer_sig1 - NANEW1 = aer_n1 -!bloss RM1 = 0.052E-6 -!bloss SIG1 = 2.04 -!bloss NANEW1 = 100.0E6 - F11 = 0.5*EXP(2.5*(LOG(SIG1))**2) - F21 = 1.+0.25*LOG(SIG1) - -! MODE 2 - - RM2 = aer_rm2 !bloss: specify using values from prm file - SIG2 = aer_sig2 - NANEW2 = aer_n2 -!bloss RM2 = 1.3E-6 -!bloss SIG2 = 2.5 -!bloss NANEW2 = 1.E6 - F12 = 0.5*EXP(2.5*(LOG(SIG2))**2) - F22 = 1.+0.25*LOG(SIG2) - -! CONSTANTS FOR EFFICIENCY - - CONS1=GAMMA(1.+DS)*CS - CONS2=GAMMA(1.+DG)*CG - CONS3=GAMMA(4.+BS)/6. - CONS4=GAMMA(4.+BR)/6. - CONS5=GAMMA(1.+BS) - CONS6=GAMMA(1.+BR) - CONS7=GAMMA(4.+BG)/6. - CONS8=GAMMA(1.+BG) - CONS9=GAMMA(5./2.+BR/2.) - CONS10=GAMMA(5./2.+BS/2.) - CONS11=GAMMA(5./2.+BG/2.) - CONS12=GAMMA(1.+DI)*CI - CONS13=GAMMA(BS+3.)*PI/4.*ECI - CONS14=GAMMA(BG+3.)*PI/4.*ECI - CONS15=-1108.*EII*PI**((1.-BS)/3.)*RHOSN**((-2.-BS)/3.)/(4.*720.) - CONS16=GAMMA(BI+3.)*PI/4.*ECI - CONS17=4.*2.*3.*RHOSU*PI*ECI*ECI*GAMMA(2.*BS+2.)/(8.*(RHOG-RHOSN)) - CONS18=RHOSN*RHOSN - CONS19=RHOW*RHOW - CONS20=20.*PI*PI*RHOW*BIMM - CONS21=4./(DCS*RHOI) - CONS22=PI*RHOI*DCS**3/6. - CONS23=PI/4.*EII*GAMMA(BS+3.) - CONS24=PI/4.*ECR*GAMMA(BR+3.) - CONS25=PI*PI/24.*RHOW*ECR*GAMMA(BR+6.) - CONS26=PI/6.*RHOW - CONS27=GAMMA(1.+BI) - CONS28=GAMMA(4.+BI)/6. - CONS29=4./3.*PI*RHOW*(25.E-6)**3 - CONS30=4./3.*PI*RHOW - CONS31=PI*PI*ECR*RHOSN - CONS32=PI/2.*ECR - CONS33=PI*PI*ECR*RHOG - CONS34=5./2.+BR/2. - CONS35=5./2.+BS/2. - CONS36=5./2.+BG/2. - CONS37=4.*PI*1.38E-23/(6.*PI*RIN) - CONS38=PI*PI/3.*RHOW - CONS39=PI*PI/36.*RHOW*BIMM - CONS40=PI/6.*BIMM - CONS41=PI*PI*ECR*RHOW - -! v1.4 - dnu(1) = -0.557 - dnu(2) = -0.557 - dnu(3) = -0.430 - dnu(4) = -0.307 - dnu(5) = -0.186 - dnu(6) = -0.067 - dnu(7) = 0.050 - dnu(8) = 0.167 - dnu(9) = 0.282 - dnu(10) = 0.397 - dnu(11) = 0.512 - dnu(12) = 0.626 - dnu(13) = 0.739 - dnu(14) = 0.853 - dnu(15) = 0.966 - dnu(16) = 0.966 - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! variables for radar reflecitivity calculations -!..Create bins of rain (from min diameter up to 5 mm). - ddx(1) = D0r*1.0d0 - ddx(nbr+1) = 0.005d0 - do n = 2, nbr - ddx(n) = DEXP(REAL(n-1,kind=kind(0d0))/REAL(nbr,kind=kind(0d0)) & - *DLOG(ddx(nbr+1)/ddx(1)) +DLOG(ddx(1))) - enddo - do n = 1, nbr - Dr(n) = DSQRT(ddx(n)*ddx(n+1)) - dtr(n) = ddx(n+1) - ddx(n) - enddo - -!..Create bins of snow (from min diameter up to 2 cm). - Ddx(1) = D0s*1.0d0 - Ddx(nbs+1) = 0.02d0 - do n = 2, nbs - Ddx(n) = DEXP(REAL(n-1,kind=kind(0d0))/REAL(nbs,kind=kind(0d0)) & - *DLOG(Ddx(nbs+1)/Ddx(1)) +DLOG(Ddx(1))) - enddo - do n = 1, nbs - Dds(n) = DSQRT(Ddx(n)*Ddx(n+1)) - dts(n) = Ddx(n+1) - Ddx(n) - enddo - -!..Create bins of graupel (from min diameter up to 5 cm). - Ddx(1) = D0g*1.0d0 - Ddx(nbg+1) = 0.05d0 - do n = 2, nbg - Ddx(n) = DEXP(REAL(n-1,kind=kind(0d0))/REAL(nbg,kind=kind(0d0)) & - *DLOG(Ddx(nbg+1)/Ddx(1)) +DLOG(Ddx(1))) - enddo - do n = 1, nbg - Ddg(n) = DSQRT(Ddx(n)*Ddx(n+1)) - dtg(n) = Ddx(n+1) - Ddx(n) - enddo - - do i = 1, 256 - mp_debug(i:i) = char(0) - enddo - - call radar_init -#ifndef CLUBB_CRM -! WRITE(0,*) "WARNING: This version of the Morrison microphysics ", & -! "incorporates changes from WRF V3.3 not found in standard SAM." -! STOP "Comment out this stop if you want to run this code anyway." -#endif /* not CLUBB_CRM */ - -END SUBROUTINE GRAUPEL_INIT - -!interface copied from new thompson interface -!and added NC, NS, NR, and NG variables. - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! THIS SUBROUTINE IS MAIN INTERFACE WITH THE TWO-MOMENT MICROPHYSICS SCHEME -! THIS INTERFACE TAKES IN 3D VARIABLES FROM DRIVER MODEL, CONVERTS TO 1D FOR -! CALL TO THE MAIN MICROPHYSICS SUBROUTINE (SUBROUTINE M2005MICRO_GRAUPEL) -! WHICH OPERATES ON 1D VERTICAL COLUMNS. -! 1D VARIABLES FROM THE MAIN MICROPHYSICS SUBROUTINE ARE THEN REASSIGNED BACK TO 3D FOR OUTPUT -! BACK TO DRIVER MODEL USING THIS INTERFACE - -! ******IMPORTANT****** -! THIS CODE ASSUMES THE DRIVER MODEL USES PROCESS-SPLITTING FOR SOLVING THE TIME-DEPENDENT EQS. -! THUS, MODEL VARIABLES ARE UPDATED WITH MICROPHYSICS TENDENCIES INSIDE OF THE MICROPHYSICS -! SCHEME. THESE UPDATED VARIABLES ARE PASSED BACK TO DRIVER MODEL. THIS IS WHY THERE -! ARE NO TENDENCIES PASSED BACK AND FORTH BETWEEN DRIVER AND THE INTERFACE SUBROUTINE - -! AN EXCEPTION IS THE TURBULENT MIXING TENDENCIES FOR DROPLET AND CLOUD ICE NUMBER CONCENTRATIONS -! (NCTEND, NITEND BELOW). FOR APPLICATION IN MODELS OTHER THAN WRF, TURBULENT MIXING TENDENCIES -! CAN BE ADDED TO THE VARIABLES ELSEWHERE (IN DRIVER OR PBL ROUTINE), AND THEN DON'T -! NEED TO BE PASSED INTO THE SUBROUTINE HERE..... - -! FOR QUESTIONS, CONTACT: HUGH MORRISON, E-MAIL: MORRISON@UCAR.EDU, PHONE:303-497-8916 - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SUBROUTINE MP_GRAUPEL(ITIMESTEP, & - TH, QV, QC, QR, QI, QS, QG, NI, NC, NS, NR, NG, TKE, NCTEND, & - NITEND,KZH, & - RHO, PII, P, DT_IN, DZ, HT, W, & - RAINNC, RAINNCV, SR & - ,EFFCS,EFFIS & ! HM ADD 4/13/07 - ,refl_10cm & ! GT -!bloss ,grid_clock & ! GT -!bloss ,grid_alarms & ! GT - ,IDS,IDE, JDS,JDE, KDS,KDE & ! domain dims - ,IMS,IME, JMS,JME, KMS,KME & ! memory dims - ,ITS,ITE, JTS,JTE, KTS,KTE & ! tile dims ) - ) - -! QV - water vapor mixing ratio (kg/kg) -! QC - cloud water mixing ratio (kg/kg) -! QR - rain water mixing ratio (kg/kg) -! QI - cloud ice mixing ratio (kg/kg) -! QS - snow mixing ratio (kg/kg) -! QG - graupel mixing ratio (KG/KG) -! NI - cloud ice number concentration (1/kg) -! NC - Droplet Number concentration (1/kg) -! NS - Snow Number concentration (1/kg) -! NR - Rain Number concentration (1/kg) -! NG - Graupel number concentration (1/kg) -! NOTE: RHO AND HT NOT USED BY THIS SCHEME AND DO NOT NEED TO BE PASSED INTO SCHEME!!!! -! P - AIR PRESSURE (PA) -! W - VERTICAL AIR VELOCITY (M/S) -! TH - POTENTIAL TEMPERATURE (K) -! PII - exner function - used to convert potential temp to temp -! DZ - difference in height over interface (m) -! DT_IN - model time step (sec) -! ITIMESTEP - time step counter -! RAINNC - accumulated grid-scale precipitation (mm) -! RAINNCV - one time step grid scale precipitation (mm/time step) -! SR - one time step mass ratio of snow to total precip -! TKE - turbulence kinetic energy (m^2 s-2), NEEDED FOR DROPLET ACTIVATION (SEE CODE BELOW) -! NCTEND - droplet concentration tendency from pbl (kg-1 s-1) -! NCTEND - CLOUD ICE concentration tendency from pbl (kg-1 s-1) -! KZH - heat eddy diffusion coefficient from YSU scheme (M^2 S-1), NEEDED FOR DROPLET ACTIVATION (SEE CODE BELOW) -! EFFCS - CLOUD DROPLET EFFECTIVE RADIUS OUTPUT TO RADIATION CODE (micron) -! EFFIS - CLOUD DROPLET EFFECTIVE RADIUS OUTPUT TO RADIATION CODE (micron) -! REFL_10CM - CALCULATED RADAR REFLECTIVITY AT 10 CM (DBZ) -!................................ -! GRID_CLOCK, GRID_ALARMS - parameters to limit radar reflectivity calculation only when needed -! otherwise radar reflectivity calculation every time step is too slow -! only needed for coupling with WRF, see code below for details - -! EFFC - DROPLET EFFECTIVE RADIUS (MICRON) -! EFFR - RAIN EFFECTIVE RADIUS (MICRON) -! EFFS - SNOW EFFECTIVE RADIUS (MICRON) -! EFFI - CLOUD ICE EFFECTIVE RADIUS (MICRON) - -! ADDITIONAL OUTPUT FROM MICRO - SEDIMENTATION TENDENCIES, NEEDED FOR LIQUID-ICE STATIC ENERGY - -! QGSTEN - GRAUPEL SEDIMENTATION TEND (KG/KG/S) -! QRSTEN - RAIN SEDIMENTATION TEND (KG/KG/S) -! QISTEN - CLOUD ICE SEDIMENTATION TEND (KG/KG/S) -! QNISTEN - SNOW SEDIMENTATION TEND (KG/KG/S) -! QCSTEN - CLOUD WATER SEDIMENTATION TEND (KG/KG/S) - -! ADDITIONAL INPUT NEEDED BY MICRO -! ********NOTE: WVAR IS SHOULD BE USED IN DROPLET ACTIVATION -! FOR CASES WHEN UPDRAFT IS NOT RESOLVED, EITHER BECAUSE OF -! LOW MODEL RESOLUTION OR CLOUD TYPE - -! WVAR - STANDARD DEVIATION OF SUB-GRID VERTICAL VELOCITY (M/S) - - IMPLICIT NONE - - INTEGER, INTENT(IN ) :: ids, ide, jds, jde, kds, kde , & - ims, ime, jms, jme, kms, kme , & - its, ite, jts, jte, kts, kte -! Temporary changed from INOUT to IN - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & - qv, qc, qr, qi, qs, qg, ni, nc, ns, nr, TH, NG, effcs, effis - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN):: & - pii, p, dz, rho, w, tke, nctend, nitend,kzh - REAL, INTENT(IN):: dt_in - INTEGER, INTENT(IN):: ITIMESTEP - - REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: & - RAINNC, RAINNCV, SR - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & ! GT - refl_10cm - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: ht - -!bloss TYPE (WRFU_Clock):: grid_clock ! GT -!bloss TYPE (WRFU_Alarm), POINTER:: grid_alarms(:) ! GT - - ! LOCAL VARIABLES - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme):: & - effi, effs, effr, EFFG - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme):: & - T, WVAR, EFFC - - REAL, DIMENSION(kts:kte) :: & - QC_TEND1D, QI_TEND1D, QNI_TEND1D, QR_TEND1D, NC_TEND1D, & - NI_TEND1D, NS_TEND1D, NR_TEND1D, & - QC1D, QI1D, QR1D, NC1D,NI1D, NS1D, NR1D, QS1D, & - T_TEND1D,QV_TEND1D, T1D, QV1D, P1D, RHO1D, W1D, WVAR1D, & - EFFC1D, EFFI1D, EFFS1D, EFFR1D,DZ1D, & - ! HM ADD GRAUPEL - QG_TEND1D, NG_TEND1D, QG1D, NG1D, EFFG1D, & - -! ADD SEDIMENTATION TENDENCIES (UNITS OF KG/KG/S) - QGSTEN,QRSTEN, QISTEN, QNISTEN, QCSTEN, & - -! HM add reflectivity - dbz - - REAL PRECPRT1D, SNOWRT1D - - INTEGER I,K,J - - REAL DT - LOGICAL:: dBZ_tstep ! GT - -! set dbz logical based on grid_clock -!+---+ -! only calculate reflectivity when it is needed for output -! in this instance, logical dbz_tstep is set to .true. -! *******NOTE: FOR COUPLING WITH DRIVER MODEL OTHER THAN WRF, -! THIS BLOCK OF CODE WILL NEED TO BE MODIFIED TO CORRECTLY -! SET WHEN REFLECTIVIITY CALCULATION IS MADE - - dBZ_tstep = .false. -!bloss if ( Is_alarm_tstep(grid_clock, grid_alarms(HISTORY_ALARM)) ) then -!bloss dBZ_tstep = .true. -!bloss endif - - ! Initialize tendencies (all set to 0) and transfer - ! array to local variables - DT = DT_IN - do I=ITS,ITE - do J=JTS,JTE - DO K=KTS,KTE - T(I,K,J) = TH(i,k,j)*PII(i,k,j) - -! wvar is the ST. DEV. OF sub-grid vertical velocity, used for calculating droplet -! activation rates. -! WVAR BE DERIVED EITHER FROM PREDICTED TKE (AS IN MYJ PBL SCHEME), -! OR FROM EDDY DIFFUSION COEFFICIENT KZH (AS IN YSU PBL SCHEME), -! DEPENDING ON THE PARTICULAR pbl SCHEME DRIVER MODEL IS COUPLED WITH -! NOTE: IF MODEL HAS HIGH ENOUGH RESOLUTION TO RESOLVE UPDRAFTS, WVAR IS -! PROBABLY NOT NEEDED - -! for MYJ pbl scheme: -! WVAR(I,K,J) = (0.667*tke(i,k,j))**0.5 -! for YSU pbl scheme: - WVAR(I,K,J) = KZH(I,K,J)/20. - WVAR(I,K,J) = MAX(0.1,WVAR(I,K,J)) - WVAR(I,K,J) = MIN(4.,WVAR(I,K,J)) - -! add tendency from pbl to droplet and cloud ice concentration -! NEEDED FOR WRF TEMPORARILY!!!! -! OTHER DRIVER MODELS MAY ADD TURBULENT DIFFUSION TENDENCY FOR -! SCALARS SOMEWHERE ELSE IN THE MODEL (I.E, NOT IN THE MICROPHYSICS) -! IN THIS CASE THESE 2 LINES BELOW MAY BE REMOVED - nc(i,k,j) = nc(i,k,j)+nctend(i,k,j)*dt - ni(i,k,j) = ni(i,k,j)+nitend(i,k,j)*dt - END DO - END DO - END DO - - do i=its,ite ! i loop (east-west) - do j=jts,jte ! j loop (north-south) - ! - ! Transfer 3D arrays into 1D for microphysical calculations - ! - -! hm , initialize 1d tendency arrays to zero - - do k=kts,kte ! k loop (vertical) - - QC_TEND1D(k) = 0. - QI_TEND1D(k) = 0. - QNI_TEND1D(k) = 0. - QR_TEND1D(k) = 0. - NC_TEND1D(k) = 0. - NI_TEND1D(k) = 0. - NS_TEND1D(k) = 0. - NR_TEND1D(k) = 0. - T_TEND1D(k) = 0. - QV_TEND1D(k) = 0. - - QC1D(k) = QC(i,k,j) - QI1D(k) = QI(i,k,j) - QS1D(k) = QS(i,k,j) - QR1D(k) = QR(i,k,j) - - NC1D(k) = NC(i,k,j) - NI1D(k) = NI(i,k,j) - - NS1D(k) = NS(i,k,j) - NR1D(k) = NR(i,k,j) -! HM ADD GRAUPEL - QG1D(K) = QG(I,K,j) - NG1D(K) = NG(I,K,j) - QG_TEND1D(K) = 0. - NG_TEND1D(K) = 0. - - T1D(k) = T(i,k,j) - QV1D(k) = QV(i,k,j) - P1D(k) = P(i,k,j) - RHO1D(k) = P1D(K)/(R*T1D(K)) - DZ1D(k) = DZ(i,k,j) - W1D(k) = W(i,k,j) - WVAR1D(k) = WVAR(i,k,j) - end do - - !bloss: add extra argument for rho for consistency with below subroutine. - ! done by repeating p1z. - ! diable routine to make sure it is not used. - STOP 'in mp_graupel wrapper routine. Only use m2005micro_graupel()' - -#ifndef CLUBB_CRM -! call m2005micro_graupel(QC_TEND1D, QI_TEND1D, QNI_TEND1D, QR_TEND1D, NC_TEND1D, & -! NI_TEND1D, NS_TEND1D, NR_TEND1D, & -! QC1D, QI1D, QS1D, QR1D, NC1D,NI1D, NS1D, NR1D, & -! T_TEND1D,QV_TEND1D, T1D, QV1D, P1D, RHO1D, DZ1D, W1D, WVAR1D, & -! PRECPRT1D,SNOWRT1D, & -! EFFC1D,EFFI1D,EFFS1D,EFFR1D,DT, & -! IMS,IME, JMS,JME, KMS,KME, & -! ITS,ITE, JTS,JTE, KTS,KTE, & ! HM ADD GRAUPEL -! QG_TEND1D,NG_TEND1D,QG1D,NG1D,EFFG1D, & -! ADD SEDIMENTATION TENDENCIES -! QGSTEN,QRSTEN,QISTEN,QNISTEN,QCSTEN) -#endif /*CLUBB_CRM*/ - ! - ! Transfer 1D arrays back into 3D arrays - ! - do k=kts,kte - -! hm, add tendencies to update global variables -! HM, TENDENCIES FOR Q AND N NOW ADDED IN M2005MICRO, SO WE -! ONLY NEED TO TRANSFER 1D VARIABLES BACK TO 3D - - QC(i,k,j) = QC1D(k) - QI(i,k,j) = QI1D(k) - QS(i,k,j) = QS1D(k) - QR(i,k,j) = QR1D(k) - NC(i,k,j) = NC1D(k) - NI(i,k,j) = NI1D(k) - NS(i,k,j) = NS1D(k) - NR(i,k,j) = NR1D(k) - QG(I,K,j) = QG1D(K) - NG(I,K,j) = NG1D(K) - - T(i,k,j) = T1D(k) - TH(I,K,J) = T(i,k,j)/PII(i,k,j) ! CONVERT TEMP BACK TO POTENTIAL TEMP - QV(i,k,j) = QV1D(k) - - EFFC(i,k,j) = EFFC1D(k) - EFFI(i,k,j) = EFFI1D(k) - EFFS(i,k,j) = EFFS1D(k) - EFFR(i,k,j) = EFFR1D(k) - EFFG(I,K,j) = EFFG1D(K) - -! EFFECTIVE RADIUS FOR RADIATION CODE -! HM, ADD LIMIT TO PREVENT BLOWING UP OPTICAL PROPERTIES, 8/18/07 -! LIMITS ARE FROM THE CAM MODEL APPLIED BY ANDREW GETTELMAN - EFFCS(I,K,J) = MIN(EFFC(I,K,J),16.) - EFFCS(I,K,J) = MAX(EFFCS(I,K,J),4.) - EFFIS(I,K,J) = MIN(EFFI(I,K,J),130.) - EFFIS(I,K,J) = MAX(EFFIS(I,K,J),13.) - - end do - -! hm modified so that m2005 precip variables correctly match wrf precip variables - RAINNC(i,j) = RAINNC(I,J)+PRECPRT1D - RAINNCV(i,j) = PRECPRT1D - SR(i,j) = SNOWRT1D/(PRECPRT1D+1.E-12) - -! add reflectivity calculations -! only calculate if logical parameter dbz_tstep = .true. - - if (dBZ_tstep) then - call calc_refl10cm (qv1d, qr1d, qs1d, qg1d, t1d, p1d, dBZ, & - kts, kte, i, j, nr1d, ns1d, ng1d) - do k = kts, kte - refl_10cm(i,k,j) = dBZ(k) - enddo - endif - - end do - end do - -END SUBROUTINE MP_GRAUPEL - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -#ifdef CLUBB_CRM - SUBROUTINE M2005MICRO_GRAUPEL(QC3DTEN,QI3DTEN,QNI3DTEN,QR3DTEN,NC3DTEN, & - NI3DTEN,NS3DTEN,NR3DTEN,QC3D,QI3D,QNI3D,QR3D,NC3D,NI3D,NS3D,NR3D, & - T3DTEN,QV3DTEN,T3D,QV3D,PRES,RHO,DZQ,W3D,WVAR, & -! hm 7/26/11, new output - acc1d,aut1d,evpc1d,evpr1d,mlt1d,sub1d,dep1d,con1d, & - PRECRT,SNOWRT, & - EFFC,EFFI,EFFS,EFFR,DT, & - IMS,IME, JMS,JME, KMS,KME, & - ITS,ITE, JTS,JTE, KTS,KTE, & ! ADD GRAUPEL - QG3DTEN,NG3DTEN,QG3D,NG3D,EFFG,QGSTEN,QRSTEN,QISTEN,QNISTEN,QCSTEN, & - CF3D, CFL3D, CFI3D, RELVAR, ACCRE_ENHAN & ! Cloud fraction from clubb -#ifdef ECPP - ,C2PREC,QSINK,CSED,ISED,SSED,GSED,RSED, RH3D & ! mhwang added, for ECPP -#endif /*ECPP*/ - ) -#else - SUBROUTINE M2005MICRO_GRAUPEL(QC3DTEN,QI3DTEN,QNI3DTEN,QR3DTEN,NC3DTEN, & - NI3DTEN,NS3DTEN,NR3DTEN,QC3D,QI3D,QNI3D,QR3D,NC3D,NI3D,NS3D,NR3D, & - T3DTEN,QV3DTEN,T3D,QV3D,PRES,RHO,DZQ,W3D,WVAR, & -! hm 7/26/11, new output - acc1d,aut1d,evpc1d,evpr1d,mlt1d,sub1d,dep1d,con1d, & - PRECRT,SNOWRT, & - EFFC,EFFI,EFFS,EFFR,DT, & - IMS,IME, JMS,JME, KMS,KME, & - ITS,ITE, JTS,JTE, KTS,KTE, & ! ADD GRAUPEL - QG3DTEN,NG3DTEN,QG3D,NG3D,EFFG,QGSTEN,QRSTEN,QISTEN,QNISTEN,QCSTEN & -#ifdef ECPP - ,C2PREC,QSINK,CSED,ISED,SSED,GSED,RSED, RH3D & ! mhwang added, for ECPP -#endif /*ECPP*/ - ) -#endif /*CLUBB_CRM*/ -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! THIS PROGRAM IS THE MAIN TWO-MOMENT MICROPHYSICS SUBROUTINE DESCRIBED BY -! MORRISON ET AL. 2005 JAS; MORRISON AND PINTO 2005 JAS. -! ADDITIONAL CHANGE IS ADDITION OF GRAUPEL MICROPHYSICS. -! SCHEME IS DESCRIBED IN DETAIL BY MORRISON ET AL. (MONTHLY WEATHER REVIEW, IN PREP.) - -! THIS SCHEME IS A BULK DOUBLE-MOMENT SCHEME THAT PREDICTS MIXING -! RATIOS AND NUMBER CONCENTRATIONS OF FIVE HYDROMETEOR SPECIES: -! CLOUD DROPLETS, CLOUD (SMALL) ICE, RAIN, SNOW, AND GRAUPEL. - -! CODE STRUCTURE: MAIN SUBROUTINE IS 'M2005MICRO_GRAUPEL'. ALSO INCLUDED IN THIS FILE IS -! 'FUNCTION POLYSVP', 'FUNCTION DERF1', AND -! 'FUNCTION GAMMA'. - -! NOTE: THIS SUBROUTINE USES 1D ARRAY IN VERTICAL (COLUMN), EVEN THOUGH VARIABLES ARE CALLED '3D'...... - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - -! DECLARATIONS - - IMPLICIT NONE - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! THESE VARIABLES BELOW MUST BE LINKED WITH THE MAIN MODEL. -! DEFINE ARRAY SIZES - -! INPUT NUMBER OF GRID CELLS - -! INPUT/OUTPUT PARAMETERS ! DESCRIPTION (UNITS) - INTEGER, INTENT( IN) :: IMS,IME, JMS,JME, KMS,KME, & - ITS,ITE, JTS,JTE, KTS,KTE - - REAL, DIMENSION(KMS:KME) :: QC3DTEN ! CLOUD WATER MIXING RATIO TENDENCY (KG/KG/S) - REAL, DIMENSION(KMS:KME) :: QI3DTEN ! CLOUD ICE MIXING RATIO TENDENCY (KG/KG/S) - REAL, DIMENSION(KMS:KME) :: QNI3DTEN ! SNOW MIXING RATIO TENDENCY (KG/KG/S) - REAL, DIMENSION(KMS:KME) :: QR3DTEN ! RAIN MIXING RATIO TENDENCY (KG/KG/S) - REAL, DIMENSION(KMS:KME) :: NC3DTEN ! CLOUD DROPLET NUMBER CONCENTRATION (1/KG/S) - REAL, DIMENSION(KMS:KME) :: NI3DTEN ! CLOUD ICE NUMBER CONCENTRATION (1/KG/S) - REAL, DIMENSION(KMS:KME) :: NS3DTEN ! SNOW NUMBER CONCENTRATION (1/KG/S) - REAL, DIMENSION(KMS:KME) :: NR3DTEN ! RAIN NUMBER CONCENTRATION (1/KG/S) - REAL, DIMENSION(KMS:KME) :: QC3D ! CLOUD WATER MIXING RATIO (KG/KG) - REAL, DIMENSION(KMS:KME) :: QI3D ! CLOUD ICE MIXING RATIO (KG/KG) - REAL, DIMENSION(KMS:KME) :: QNI3D ! SNOW MIXING RATIO (KG/KG) - REAL, DIMENSION(KMS:KME) :: QR3D ! RAIN MIXING RATIO (KG/KG) - REAL, DIMENSION(KMS:KME) :: NC3D ! CLOUD DROPLET NUMBER CONCENTRATION (1/KG) - REAL, DIMENSION(KMS:KME) :: NI3D ! CLOUD ICE NUMBER CONCENTRATION (1/KG) - REAL, DIMENSION(KMS:KME) :: NS3D ! SNOW NUMBER CONCENTRATION (1/KG) - REAL, DIMENSION(KMS:KME) :: NR3D ! RAIN NUMBER CONCENTRATION (1/KG) - REAL, DIMENSION(KMS:KME) :: T3DTEN ! TEMPERATURE TENDENCY (K/S) - REAL, DIMENSION(KMS:KME) :: QV3DTEN ! WATER VAPOR MIXING RATIO TENDENCY (KG/KG/S) - REAL, DIMENSION(KMS:KME) :: T3D ! TEMPERATURE (K) - REAL, DIMENSION(KMS:KME) :: QV3D ! WATER VAPOR MIXING RATIO (KG/KG) - REAL, DIMENSION(KMS:KME) :: PRES ! ATMOSPHERIC PRESSURE (PA) -!bloss: make rho an input argument - REAL, DIMENSION(KMS:KME), INTENT(IN) :: RHO ! AIR DENSITY - REAL, DIMENSION(KMS:KME) :: DZQ ! DIFFERENCE IN HEIGHT ACROSS LEVEL (m) - REAL, DIMENSION(KMS:KME) :: W3D ! GRID-SCALE VERTICAL VELOCITY (M/S) - REAL, DIMENSION(KMS:KME) :: WVAR ! SUB-GRID VERTICAL VELOCITY (M/S) - -! hm 7/26/11, new output - REAL, DIMENSION(KMS:KME) :: aut1d ! - REAL, DIMENSION(KMS:KME) :: acc1d ! - REAL, DIMENSION(KMS:KME) :: evpc1d ! - REAL, DIMENSION(KMS:KME) :: evpr1d ! - REAL, DIMENSION(KMS:KME) :: mlt1d ! - REAL, DIMENSION(KMS:KME) :: sub1d ! - REAL, DIMENSION(KMS:KME) :: dep1d ! - REAL, DIMENSION(KMS:KME) :: con1d ! - -! HM ADDED GRAUPEL VARIABLES - REAL, DIMENSION(KMS:KME) :: QG3DTEN ! GRAUPEL MIX RATIO TENDENCY (KG/KG/S) - REAL, DIMENSION(KMS:KME) :: NG3DTEN ! GRAUPEL NUMB CONC TENDENCY (1/KG/S) - REAL, DIMENSION(KMS:KME) :: QG3D ! GRAUPEL MIX RATIO (KG/KG) - REAL, DIMENSION(KMS:KME) :: NG3D ! GRAUPEL NUMBER CONC (1/KG) - -! HM, ADD 1/16/07, SEDIMENTATION TENDENCIES FOR MIXING RATIO - - REAL, DIMENSION(KMS:KME) :: QGSTEN ! GRAUPEL SED TEND (KG/KG/S) - REAL, DIMENSION(KMS:KME) :: QRSTEN ! RAIN SED TEND (KG/KG/S) - REAL, DIMENSION(KMS:KME) :: QISTEN ! CLOUD ICE SED TEND (KG/KG/S) - REAL, DIMENSION(KMS:KME) :: QNISTEN ! SNOW SED TEND (KG/KG/S) - REAL, DIMENSION(KMS:KME) :: QCSTEN ! CLOUD WAT SED TEND (KG/KG/S) - - REAL, DIMENSION(KMS:KME) :: NGSTEN ! GRAUPEL SED TEND (#KG/S) - REAL, DIMENSION(KMS:KME) :: NRSTEN ! RAIN SED TEND (#/KG/S) - REAL, DIMENSION(KMS:KME) :: NISTEN ! CLOUD ICE SED TEND (#/KG/S) - REAL, DIMENSION(KMS:KME) :: NSSTEN ! SNOW SED TEND (#/KG/S) - REAL, DIMENSION(KMS:KME) :: NCSTEN ! CLOUD WAT SED TEND (#/KG/S) - -#ifdef CLUBB_CRM -! ADDED BY UWM JAN 7 2008 - REAL, INTENT(IN), DIMENSION(KMS:KME) :: CF3D ! SUBGRID SCALE CLOUD FRACTION - REAL, INTENT(IN), DIMENSION(KMS:KME) :: CFL3D ! SUBGRID SCALE LIQUID CLOUD FRACTION - REAL, INTENT(IN), DIMENSION(KMS:KME) :: CFI3D ! SUBGRID SCALE ICE CLOUD FRACTION (total cloud fraction here) - REAL, INTENT(IN), DIMENSION(KMS:KME) :: RELVAR ! RELATIVE LIQUID WATER VARIANCE - REAL, INTENT(IN), DIMENSION(KMS:KME) :: ACCRE_ENHAN ! ACCRETION ENHANCEMENT FACTOR -#endif -! OUTPUT VARIABLES - - REAL PRECRT ! TOTAL PRECIP PER TIME STEP (mm) - REAL SNOWRT ! SNOW PER TIME STEP (mm) - - REAL, DIMENSION(KMS:KME) :: EFFC ! DROPLET EFFECTIVE RADIUS (MICRON) - REAL, DIMENSION(KMS:KME) :: EFFI ! CLOUD ICE EFFECTIVE RADIUS (MICRON) - REAL, DIMENSION(KMS:KME) :: EFFS ! SNOW EFFECTIVE RADIUS (MICRON) - REAL, DIMENSION(KMS:KME) :: EFFR ! RAIN EFFECTIVE RADIUS (MICRON) - REAL, DIMENSION(KMS:KME) :: EFFG ! GRAUPEL EFFECTIVE RADIUS (MICRON) - -! MODEL INPUT PARAMETERS (FORMERLY IN COMMON BLOCKS) - - REAL DT ! MODEL TIME STEP (SEC) - -#ifdef ECPP - REAL, DIMENSION(KMS:KME) :: C2PREC ! CLOUD WATER SINK rate FROM PRECIPITATION (kg/kg/s) - REAL, DIMENSION(KMS:KME) :: QSINK ! CLOUD WATER SINK rate FROM PRECIPITATION (/s) - REAL, DIMENSION(KMS:KME) :: CSED ! sedimentation flux of cloud water (kg/m2/s) - REAL, DIMENSION(KMS:KME) :: ISED ! sedimentation flux of cloud ice (kg/m2/s) - REAL, DIMENSION(KMS:KME) :: SSED ! sedimentation flux of snow (kg/m2/s) - REAL, DIMENSION(KMS:KME) :: GSED ! sedimentation flux of graupel (kg/m2/s) - REAL, DIMENSION(KMS:KME) :: RSED ! sedimentation flux of rain (kg/m2/s) - REAL, DIMENSION(KMS:KME) :: RH3D ! relative humidity w.r.t water. -#endif /*ECPP*/ - -!..................................................................................................... -! LOCAL VARIABLES: ALL PARAMETERS BELOW ARE LOCAL TO SCHEME AND DON'T NEED TO COMMUNICATE WITH THE -! REST OF THE MODEL. - -! SIZE PARAMETER VARIABLES - - REAL, DIMENSION(KMS:KME) :: LAMC ! SLOPE PARAMETER FOR DROPLETS (M-1) - REAL, DIMENSION(KMS:KME) :: LAMI ! SLOPE PARAMETER FOR CLOUD ICE (M-1) - REAL, DIMENSION(KMS:KME) :: LAMS ! SLOPE PARAMETER FOR SNOW (M-1) - REAL, DIMENSION(KMS:KME) :: LAMR ! SLOPE PARAMETER FOR RAIN (M-1) - REAL, DIMENSION(KMS:KME) :: LAMG ! SLOPE PARAMETER FOR GRAUPEL (M-1) - REAL, DIMENSION(KMS:KME) :: CDIST1 ! PSD PARAMETER FOR DROPLETS - REAL, DIMENSION(KMS:KME) :: N0I ! INTERCEPT PARAMETER FOR CLOUD ICE (KG-1 M-1) - REAL, DIMENSION(KMS:KME) :: N0S ! INTERCEPT PARAMETER FOR SNOW (KG-1 M-1) - REAL, DIMENSION(KMS:KME) :: N0RR ! INTERCEPT PARAMETER FOR RAIN (KG-1 M-1) - REAL, DIMENSION(KMS:KME) :: N0G ! INTERCEPT PARAMETER FOR GRAUPEL (KG-1 M-1) - REAL, DIMENSION(KMS:KME) :: PGAM ! SPECTRAL SHAPE PARAMETER FOR DROPLETS - -! MICROPHYSICAL PROCESSES - - REAL, DIMENSION(KMS:KME) :: NSUBC ! LOSS OF NC DURING EVAP - REAL, DIMENSION(KMS:KME) :: NSUBI ! LOSS OF NI DURING SUB. - REAL, DIMENSION(KMS:KME) :: NSUBS ! LOSS OF NS DURING SUB. - REAL, DIMENSION(KMS:KME) :: NSUBR ! LOSS OF NR DURING EVAP - REAL, DIMENSION(KMS:KME) :: PRD ! DEP CLOUD ICE - REAL, DIMENSION(KMS:KME) :: PRE ! EVAP OF RAIN - REAL, DIMENSION(KMS:KME) :: PRDS ! DEP SNOW - REAL, DIMENSION(KMS:KME) :: NNUCCC ! CHANGE N DUE TO CONTACT FREEZ DROPLETS - REAL, DIMENSION(KMS:KME) :: MNUCCC ! CHANGE Q DUE TO CONTACT FREEZ DROPLETS - REAL, DIMENSION(KMS:KME) :: PRA ! ACCRETION DROPLETS BY RAIN - REAL, DIMENSION(KMS:KME) :: PRC ! AUTOCONVERSION DROPLETS - REAL, DIMENSION(KMS:KME) :: PCC ! COND/EVAP DROPLETS - REAL, DIMENSION(KMS:KME) :: NNUCCD ! CHANGE N FREEZING AEROSOL (PRIM ICE NUCLEATION) - REAL, DIMENSION(KMS:KME) :: MNUCCD ! CHANGE Q FREEZING AEROSOL (PRIM ICE NUCLEATION) - REAL, DIMENSION(KMS:KME) :: MNUCCR ! CHANGE Q DUE TO CONTACT FREEZ RAIN - REAL, DIMENSION(KMS:KME) :: NNUCCR ! CHANGE N DUE TO CONTACT FREEZ RAIN - REAL, DIMENSION(KMS:KME) :: NPRA ! CHANGE IN N DUE TO DROPLET ACC BY RAIN - REAL, DIMENSION(KMS:KME) :: NRAGG ! SELF-COLLECTION OF RAIN - REAL, DIMENSION(KMS:KME) :: NSAGG ! SELF-COLLECTION OF SNOW - REAL, DIMENSION(KMS:KME) :: NPRC ! CHANGE NC AUTOCONVERSION DROPLETS - REAL, DIMENSION(KMS:KME) :: NPRC1 ! CHANGE NR AUTOCONVERSION DROPLETS - REAL, DIMENSION(KMS:KME) :: PRAI ! CHANGE Q ACCRETION CLOUD ICE - REAL, DIMENSION(KMS:KME) :: PRCI ! CHANGE Q AUTOCONVERSION CLOUD ICE BY SNOW - REAL, DIMENSION(KMS:KME) :: PSACWS ! CHANGE Q DROPLET ACCRETION BY SNOW - REAL, DIMENSION(KMS:KME) :: NPSACWS ! CHANGE N DROPLET ACCRETION BY SNOW - REAL, DIMENSION(KMS:KME) :: PSACWI ! CHANGE Q DROPLET ACCRETION BY CLOUD ICE - REAL, DIMENSION(KMS:KME) :: NPSACWI ! CHANGE N DROPLET ACCRETION BY CLOUD ICE - REAL, DIMENSION(KMS:KME) :: NPRCI ! CHANGE N AUTOCONVERSION CLOUD ICE BY SNOW - REAL, DIMENSION(KMS:KME) :: NPRAI ! CHANGE N ACCRETION CLOUD ICE - REAL, DIMENSION(KMS:KME) :: NMULTS ! ICE MULT DUE TO RIMING DROPLETS BY SNOW - REAL, DIMENSION(KMS:KME) :: NMULTR ! ICE MULT DUE TO RIMING RAIN BY SNOW - REAL, DIMENSION(KMS:KME) :: QMULTS ! CHANGE Q DUE TO ICE MULT DROPLETS/SNOW - REAL, DIMENSION(KMS:KME) :: QMULTR ! CHANGE Q DUE TO ICE RAIN/SNOW - REAL, DIMENSION(KMS:KME) :: PRACS ! CHANGE Q RAIN-SNOW COLLECTION - REAL, DIMENSION(KMS:KME) :: NPRACS ! CHANGE N RAIN-SNOW COLLECTION - REAL, DIMENSION(KMS:KME) :: PCCN ! CHANGE Q DROPLET ACTIVATION - REAL, DIMENSION(KMS:KME) :: PSMLT ! CHANGE Q MELTING SNOW TO RAIN - REAL, DIMENSION(KMS:KME) :: EVPMS ! CHNAGE Q MELTING SNOW EVAPORATING - REAL, DIMENSION(KMS:KME) :: NSMLTS ! CHANGE N MELTING SNOW - REAL, DIMENSION(KMS:KME) :: NSMLTR ! CHANGE N MELTING SNOW TO RAIN -! HM ADDED 12/13/06 - REAL, DIMENSION(KMS:KME) :: PIACR ! CHANGE QR, ICE-RAIN COLLECTION - REAL, DIMENSION(KMS:KME) :: NIACR ! CHANGE N, ICE-RAIN COLLECTION - REAL, DIMENSION(KMS:KME) :: PRACI ! CHANGE QI, ICE-RAIN COLLECTION - REAL, DIMENSION(KMS:KME) :: PIACRS ! CHANGE QR, ICE RAIN COLLISION, ADDED TO SNOW - REAL, DIMENSION(KMS:KME) :: NIACRS ! CHANGE N, ICE RAIN COLLISION, ADDED TO SNOW - REAL, DIMENSION(KMS:KME) :: PRACIS ! CHANGE QI, ICE RAIN COLLISION, ADDED TO SNOW - REAL, DIMENSION(KMS:KME) :: EPRD ! SUBLIMATION CLOUD ICE - REAL, DIMENSION(KMS:KME) :: EPRDS ! SUBLIMATION SNOW -! HM ADDED GRAUPEL PROCESSES - REAL, DIMENSION(KMS:KME) :: PRACG ! CHANGE IN Q COLLECTION RAIN BY GRAUPEL - REAL, DIMENSION(KMS:KME) :: PSACWG ! CHANGE IN Q COLLECTION DROPLETS BY GRAUPEL - REAL, DIMENSION(KMS:KME) :: PGSACW ! CONVERSION Q TO GRAUPEL DUE TO COLLECTION DROPLETS BY SNOW - REAL, DIMENSION(KMS:KME) :: PGRACS ! CONVERSION Q TO GRAUPEL DUE TO COLLECTION RAIN BY SNOW - REAL, DIMENSION(KMS:KME) :: PRDG ! DEP OF GRAUPEL - REAL, DIMENSION(KMS:KME) :: EPRDG ! SUB OF GRAUPEL - REAL, DIMENSION(KMS:KME) :: EVPMG ! CHANGE Q MELTING OF GRAUPEL AND EVAPORATION - REAL, DIMENSION(KMS:KME) :: PGMLT ! CHANGE Q MELTING OF GRAUPEL - REAL, DIMENSION(KMS:KME) :: NPRACG ! CHANGE N COLLECTION RAIN BY GRAUPEL - REAL, DIMENSION(KMS:KME) :: NPSACWG ! CHANGE N COLLECTION DROPLETS BY GRAUPEL - REAL, DIMENSION(KMS:KME) :: NSCNG ! CHANGE N CONVERSION TO GRAUPEL DUE TO COLLECTION DROPLETS BY SNOW - REAL, DIMENSION(KMS:KME) :: NGRACS ! CHANGE N CONVERSION TO GRAUPEL DUE TO COLLECTION RAIN BY SNOW - REAL, DIMENSION(KMS:KME) :: NGMLTG ! CHANGE N MELTING GRAUPEL - REAL, DIMENSION(KMS:KME) :: NGMLTR ! CHANGE N MELTING GRAUPEL TO RAIN - REAL, DIMENSION(KMS:KME) :: NSUBG ! CHANGE N SUB/DEP OF GRAUPEL - REAL, DIMENSION(KMS:KME) :: PSACR ! CONVERSION DUE TO COLL OF SNOW BY RAIN - REAL, DIMENSION(KMS:KME) :: NMULTG ! ICE MULT DUE TO ACC DROPLETS BY GRAUPEL - REAL, DIMENSION(KMS:KME) :: NMULTRG ! ICE MULT DUE TO ACC RAIN BY GRAUPEL - REAL, DIMENSION(KMS:KME) :: QMULTG ! CHANGE Q DUE TO ICE MULT DROPLETS/GRAUPEL - REAL, DIMENSION(KMS:KME) :: QMULTRG ! CHANGE Q DUE TO ICE MULT RAIN/GRAUPEL - -! TIME-VARYING ATMOSPHERIC PARAMETERS - - REAL, DIMENSION(KMS:KME) :: KAP ! THERMAL CONDUCTIVITY OF AIR - REAL, DIMENSION(KMS:KME) :: EVS ! SATURATION VAPOR PRESSURE - REAL, DIMENSION(KMS:KME) :: EIS ! ICE SATURATION VAPOR PRESSURE - REAL, DIMENSION(KMS:KME) :: QVS ! SATURATION MIXING RATIO - REAL, DIMENSION(KMS:KME) :: QVI ! ICE SATURATION MIXING RATIO - REAL, DIMENSION(KMS:KME) :: QVQVS ! SAUTRATION RATIO - REAL, DIMENSION(KMS:KME) :: QVQVSI! ICE SATURAION RATIO - REAL, DIMENSION(KMS:KME) :: DV ! DIFFUSIVITY OF WATER VAPOR IN AIR - REAL, DIMENSION(KMS:KME) :: XXLS ! LATENT HEAT OF SUBLIMATION - REAL, DIMENSION(KMS:KME) :: XXLV ! LATENT HEAT OF VAPORIZATION - REAL, DIMENSION(KMS:KME) :: CPM ! SPECIFIC HEAT AT CONST PRESSURE FOR MOIST AIR - REAL, DIMENSION(KMS:KME) :: MU ! VISCOCITY OF AIR - REAL, DIMENSION(KMS:KME) :: SC ! SCHMIDT NUMBER - REAL, DIMENSION(KMS:KME) :: XLF ! LATENT HEAT OF FREEZING -!bloss REAL, DIMENSION(KMS:KME) :: RHO ! AIR DENSITY - REAL, DIMENSION(KMS:KME) :: AB ! CORRECTION TO CONDENSATION RATE DUE TO LATENT HEATING - REAL, DIMENSION(KMS:KME) :: ABI ! CORRECTION TO DEPOSITION RATE DUE TO LATENT HEATING - -! TIME-VARYING MICROPHYSICS PARAMETERS - - REAL, DIMENSION(KMS:KME) :: DAP ! DIFFUSIVITY OF AEROSOL - REAL NACNT ! NUMBER OF CONTACT IN - REAL FMULT ! TEMP.-DEP. PARAMETER FOR RIME-SPLINTERING - REAL COFFI ! ICE AUTOCONVERSION PARAMETER - -! FALL SPEED WORKING VARIABLES (DEFINED IN CODE) - - REAL, DIMENSION(KMS:KME) :: DUMI,DUMR,DUMFNI,DUMG,DUMFNG - REAL UNI, UMI,UMR - REAL, DIMENSION(KMS:KME) :: FR, FI, FNI,FG,FNG - REAL RGVM - REAL, DIMENSION(KMS:KME) :: FALOUTR,FALOUTI,FALOUTNI - REAL FALTNDR,FALTNDI,FALTNDNI,RHO2 - REAL, DIMENSION(KMS:KME) :: DUMQS,DUMFNS - REAL UMS,UNS - REAL, DIMENSION(KMS:KME) :: FS,FNS, FALOUTS,FALOUTNS,FALOUTG,FALOUTNG - REAL FALTNDS,FALTNDNS,UNR,FALTNDG,FALTNDNG - REAL, DIMENSION(KMS:KME) :: DUMC,DUMFNC - REAL UNC,UMC,UNG,UMG - REAL, DIMENSION(KMS:KME) :: FC,FALOUTC,FALOUTNC - REAL FALTNDC,FALTNDNC - REAL, DIMENSION(KMS:KME) :: FNC,DUMFNR,FALOUTNR - REAL FALTNDNR - REAL, DIMENSION(KMS:KME) :: FNR - -! FALL-SPEED PARAMETER 'A' WITH AIR DENSITY CORRECTION - - REAL, DIMENSION(KMS:KME) :: AIN,ARN,ASN,ACN,AGN - -! EXTERNAL FUNCTION CALL RETURN VARIABLES - -! REAL GAMMA, ! EULER GAMMA FUNCTION -! REAL POLYSVP, ! SAT. PRESSURE FUNCTION -! REAL DERF1 ! ERROR FUNCTION - -! DUMMY VARIABLES - - REAL DUM,DUM1,DUM2,DUMT,DUMQV,DUMQSS,DUMQSI,DUMS - -! PROGNOSTIC SUPERSATURATION - - REAL DQSDT ! CHANGE OF SAT. MIX. RAT. WITH TEMPERATURE - REAL DQSIDT ! CHANGE IN ICE SAT. MIXING RAT. WITH T - REAL EPSI ! 1/PHASE REL. TIME (SEE M2005), ICE - REAL EPSS ! 1/PHASE REL. TIME (SEE M2005), SNOW - REAL EPSR ! 1/PHASE REL. TIME (SEE M2005), RAIN - REAL EPSG ! 1/PHASE REL. TIME (SEE M2005), GRAUPEL - -! NEW DROPLET ACTIVATION VARIABLES - REAL TAUC ! PHASE REL. TIME (SEE M2005), DROPLETS - REAL TAUR ! PHASE REL. TIME (SEE M2005), RAIN - REAL TAUI ! PHASE REL. TIME (SEE M2005), CLOUD ICE - REAL TAUS ! PHASE REL. TIME (SEE M2005), SNOW - REAL TAUG ! PHASE REL. TIME (SEE M2005), GRAUPEL - REAL DUMACT,DUM3 - -! COUNTING/INDEX VARIABLES - - INTEGER K,NSTEP,N ! ,I - -! LTRUE IS ONLY USED TO SPEED UP THE CODE !! -! LTRUE, SWITCH = 0, NO HYDROMETEORS IN COLUMN, -! = 1, HYDROMETEORS IN COLUMN - - INTEGER LTRUE - -! DROPLET ACTIVATION/FREEZING AEROSOL - - - REAL CT ! DROPLET ACTIVATION PARAMETER - REAL TEMP1 ! DUMMY TEMPERATURE - REAL SAT1 ! DUMMY SATURATION - REAL SIGVL ! SURFACE TENSION LIQ/VAPOR - REAL KEL ! KELVIN PARAMETER - REAL KC2 ! TOTAL ICE NUCLEATION RATE - - REAL CRY,KRY ! AEROSOL ACTIVATION PARAMETERS - -! MORE WORKING/DUMMY VARIABLES - - REAL DUMQI,DUMNI,DC0,DS0,DG0 - REAL DUMQC,DUMQR,RATIO,SUM_DEP,FUDGEF - -! EFFECTIVE VERTICAL VELOCITY (M/S) - REAL WEF - -! WORKING PARAMETERS FOR ICE NUCLEATION - - REAL ANUC,BNUC - -! WORKING PARAMETERS FOR AEROSOL ACTIVATION - - REAL AACT,GAMM,GG,PSI,ETA1,ETA2,SM1,SM2,SMAX,UU1,UU2,ALPHA - -! DUMMY SIZE DISTRIBUTION PARAMETERS - - REAL DLAMS,DLAMR,DLAMI,DLAMC,DLAMG,LAMMAX,LAMMIN - - INTEGER IDROP - -#if (defined CRM && defined MODAL_AERO) - INTEGER INES -#endif - -! v1.4 -! new variables for seifert and beheng warm rain scheme - REAL, DIMENSION(KMS:KME) :: nu - integer dumii - -#ifdef CLUBB_CRM - REAL :: QV_INIT ! Temporary variable for vapor - REAL :: QSAT_INIT ! Temporary variable for saturation - REAL :: TMPQSMALL ! Temporary variable for QSMALL (a lower bound in kg/kg) - REAL :: T3D_INIT ! Temporary variable for T3D (absolute temperature in [K] ) - REAL :: CLDMAXR(KMS:KME) ! Maximum cloudoverlap for rain water - REAL :: CLDMAXALL(KMS:KME) ! Maximum cloudoverlap for all hydrometers -#else - REAL ::EP_2 ! Dry air gas constant over water vapor gas constant [-] - EP_2 = rgas / rv -#endif - - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - -! SET LTRUE INITIALLY TO 0 - - LTRUE = 0 - -! V.13 initialize effective radii to default values (from P. Blossey) - effc(kts:kte) = 25. - effi(kts:kte) = 25. - effs(kts:kte) = 25. - effr(kts:kte) = 25. - effg(kts:kte) = 25. - -! 09/19/2011 mhwang Initialize the micropysics process rate for output - acc1d(kms:kme) = 0.0 - aut1d(kms:kme) = 0.0 - evpc1d(kms:kme) = 0.0 - evpr1d(kms:kme) = 0.0 - mlt1d(kms:kme) = 0.0 - sub1d(kms:kme) = 0.0 - dep1d(kms:kme) = 0.0 - con1d(kms:kme) = 0.0 - - PRC(KMS:KME) = 0. - NPRC(KMS:KME) = 0. - NPRC1(KMS:KME) = 0. - PRA(KMS:KME) = 0. - NPRA(KMS:KME) = 0. - NRAGG(KMS:KME) = 0. - PSMLT(KMS:KME) = 0. - NSMLTS(KMS:KME) = 0. - NSMLTR(KMS:KME) = 0. - EVPMS(KMS:KME) = 0. - PCC(KMS:KME) = 0. - PRE(KMS:KME) = 0. - NSUBC(KMS:KME) = 0. - NSUBR(KMS:KME) = 0. - PRACG(KMS:KME) = 0. - NPRACG(KMS:KME) = 0. - PSMLT(KMS:KME) = 0. - EVPMS(KMS:KME) = 0. - PGMLT(KMS:KME) = 0. - EVPMG(KMS:KME) = 0. - PRACS(KMS:KME) = 0. - NPRACS(KMS:KME) = 0. - NGMLTG(KMS:KME) = 0. - NGMLTR(KMS:KME) = 0. - -#ifdef CLUBB_CRM - if(doclubb_gridmean) then -! calculate rain fraction based on the maximum cloud overlap -! This follows Morrison and Gettelman scheme in CAM5 - CLDMAXR(KTE)=CFL3D(KTE) - DO K=KTE-1,KTS,-1 - ! if rain, is smaller than threshold, set cldmax - ! to cloud fraction at current level - if(QR3D(K+1).ge.QSMALL) then - CLDMAXR(K) = max(CLDMAXR(K+1), CFL3D(K)) - else - CLDMAXR(K) = CFL3D(K) - end if - END DO - - CLDMAXALL(KTE)=CFI3D(KTE) - DO K=KTE-1,KTS,-1 - ! if rain, is smaller than threshold, set cldmax - ! to cloud fraction at current level - if(QR3D(K+1).ge.QSMALL.OR.QNI3D(K+1).ge.QSMALL.OR.QG3D(K+1).ge.QSMALL ) then - CLDMAXALL(K) = max(CLDMAXALL(K+1), CFI3D(K)) - else - CLDMAXALL(K) = CFI3D(K) - end if - END DO - endif -#endif - -! ATMOSPHERIC PARAMETERS THAT VARY IN TIME AND HEIGHT - DO K = KTS,KTE - -#ifdef ECPP -! INITIALIZE VARIABLES FOR ECPP OUTPUT TO ZERO - C2PREC(K)=0. - QSINK(K)=0. - CSED(K)=0. - ISED(K)=0. - SSED(K)=0. - GSED(K)=0. - RSED(K)=0. - RH3D(K)=0. -#endif /*ECPP*/ - -#ifdef CLUBB_CRM - XXLV = Lv - XXLS(K) = Ls - CPM(K) = Cp -#else -! LATENT HEAT OF VAPORATION - - XXLV(K) = lcond !bloss 3.1484E6-2370.*T3D(K) - -! LATENT HEAT OF SUBLIMATION - - XXLS(K) = lsub !bloss 3.15E6-2370.*T3D(K)+0.3337E6 - - CPM(K) = cp !bloss CP*(1.+0.887*QV3D(K)) - -#endif -! SATURATION VAPOR PRESSURE AND MIXING RATIO - -! hm, add fix for low pressure, 5/12/10 - EVS(K) = min(0.99*pres(k),POLYSVP(T3D(K),0)) ! PA - EIS(K) = min(0.99*pres(k),POLYSVP(T3D(K),1)) ! PA - -! MAKE SURE ICE SATURATION DOESN'T EXCEED WATER SAT. NEAR FREEZING - - IF (EIS(K).GT.EVS(K)) EIS(K) = EVS(K) - - QVS(K) = EP_2*EVS(K)/(PRES(K)-EVS(K)) - QVI(K) = EP_2*EIS(K)/(PRES(K)-EIS(K)) - -#ifdef CLUBB_CRM -! ADDITION BY UWM TO WEIGHT BY SGS CLOUD FRACTION -! We assume that Morrison microphysics only acts within cloud - IF ( CF3D(K) > cloud_frac_thresh ) THEN - T3D_INIT = T3D(K) ! SAVE TEMPERATURE - QV_INIT = QV3D(K) ! SAVE VAPOR - - ! We now set QV3D to be saturated w.r.t liquid at all - ! temperatures -dschanen 15 May 2009 -! IF ( T3D(K) < 273.15 ) THEN -! QV3D(K) = QVI(K) ! SET VAPOR TO ICE SATURATION WITHIN CLOUD -! TMPQSAT = QVI(K) ! Save value -! ELSE - QV3D(K) = QVS(K) ! SET VAPOR TO LIQUID SATURATION WITHIN CLOUD - QSAT_INIT = QVS(K) ! Save value -! END IF - - QC3D(K) = QC3D(K) / CF3D(K) ! Within cloud cloud water mix ratio - - IF ( INUM == 0 ) THEN - NC3D(K) = NC3D(K) / CF3D(K) ! Cloud drop num conc - END IF - - QR3D(K) = QR3D(K) / CF3D(K) ! Rain mix ratio - NR3D(K) = NR3D(K) / CF3D(K) ! Rain num conc - - IF ( ILIQ == 0 ) THEN - QI3D(K) = QI3D(K) / CF3D(K) ! Ice mix ratio - NI3D(K) = NI3D(K) / CF3D(K) ! Ice num conc - QNI3D(K) = QNI3D(K) / CF3D(K) ! Snow mix ratio - NS3D(K) = NS3D(K) / CF3D(K) ! Snow num conc - END IF - IF ( IGRAUP == 0 ) THEN - QG3D(K) = QG3D(K) / CF3D(K) ! Graupel mix ratio - NG3D(K) = NG3D(K) / CF3D(K) ! Graupel num conc - END IF - END IF -#endif - - QVQVS(K) = QV3D(K)/QVS(K) - QVQVSI(K) = QV3D(K)/QVI(K) - -! AT SUBSATURATION, REMOVE SMALL AMOUNTS OF CLOUD/PRECIP WATER -! V1.3, change limit from 10^-7 to 10^-6 -! V1.7 7/9/09 change limit from 10^-6 to 10^-8 -! this improves reflectivity at low mixing ratios - - IF (QVQVS(K).LT.0.9) THEN - IF (QR3D(K).LT.1.E-8) THEN - QV3D(K)=QV3D(K)+QR3D(K) - T3D(K)=T3D(K)-QR3D(K)*XXLV(K)/CPM(K) - QR3D(K)=0. - END IF - IF (QC3D(K).LT.1.E-8) THEN - QV3D(K)=QV3D(K)+QC3D(K) - T3D(K)=T3D(K)-QC3D(K)*XXLV(K)/CPM(K) - QC3D(K)=0. - END IF - END IF - - IF (QVQVSI(K).LT.0.9) THEN - IF (QI3D(K).LT.1.E-8) THEN - QV3D(K)=QV3D(K)+QI3D(K) - T3D(K)=T3D(K)-QI3D(K)*XXLS(K)/CPM(K) - QI3D(K)=0. - END IF - IF (QNI3D(K).LT.1.E-8) THEN - QV3D(K)=QV3D(K)+QNI3D(K) - T3D(K)=T3D(K)-QNI3D(K)*XXLS(K)/CPM(K) - QNI3D(K)=0. - END IF - IF (QG3D(K).LT.1.E-8) THEN - QV3D(K)=QV3D(K)+QG3D(K) - T3D(K)=T3D(K)-QG3D(K)*XXLS(K)/CPM(K) - QG3D(K)=0. - END IF - END IF - -! AIR DENSITY - -!bloss: now an input argument RHO(K) = PRES(K)/(R*T3D(K)) - -! HEAT OF FUSION - - XLF(K) = XXLS(K)-XXLV(K) - -!.................................................................. -! IF MIXING RATIO < QSMALL SET MIXING RATIO AND NUMBER CONC TO ZERO - - IF (QC3D(K).LT.QSMALL) THEN -!+++mhwang - QV3D(K)=QV3D(K)+QC3D(K) - T3D(K)=T3D(K)-QC3D(K)*XXLV(K)/CPM(K) -!---mhwang - QC3D(K) = 0. - NC3D(K) = 0. - EFFC(K) = 0. - END IF - IF (QR3D(K).LT.QSMALL) THEN -!+++mhwang - QV3D(K)=QV3D(K)+QR3D(K) - T3D(K)=T3D(K)-QR3D(K)*XXLV(K)/CPM(K) -!---mhwang - QR3D(K) = 0. - NR3D(K) = 0. - EFFR(K) = 0. - END IF - IF (QI3D(K).LT.QSMALL) THEN -!+++mhwang - QV3D(K)=QV3D(K)+QI3D(K) - T3D(K)=T3D(K)-QI3D(K)*XXLS(K)/CPM(K) -!+++mhwang - QI3D(K) = 0. - NI3D(K) = 0. - EFFI(K) = 0. - END IF - IF (QNI3D(K).LT.QSMALL) THEN -!+++mhwang - QV3D(K)=QV3D(K)+QNI3D(K) - T3D(K)=T3D(K)-QNI3D(K)*XXLS(K)/CPM(K) -!+++mhwang - QNI3D(K) = 0. - NS3D(K) = 0. - EFFS(K) = 0. - END IF - IF (QG3D(K).LT.QSMALL) THEN -!+++mhwang - QV3D(K)=QV3D(K)+QG3D(K) - T3D(K)=T3D(K)-QG3D(K)*XXLS(K)/CPM(K) -!+++mhwang - QG3D(K) = 0. - NG3D(K) = 0. - EFFG(K) = 0. - END IF - -! INITIALIZE SEDIMENTATION TENDENCIES FOR MIXING RATIO - - QRSTEN(K) = 0. - QISTEN(K) = 0. - QNISTEN(K) = 0. - QCSTEN(K) = 0. - QGSTEN(K) = 0. - - NRSTEN(K) = 0. - NISTEN(K) = 0. - NSSTEN(K) = 0. - NCSTEN(K) = 0. - NGSTEN(K) = 0. - -!.................................................................. -! MICROPHYSICS PARAMETERS VARYING IN TIME/HEIGHT - -! DYNAMIC VISCOSITY OF AIR -! fix 053011 - MU(K) = 1.496E-6*T3D(K)**1.5/(T3D(K)+120.) - -! FALL SPEED WITH DENSITY CORRECTION (HEYMSFIELD AND BENSSEMER 2006) - - DUM = (RHOSU/RHO(K))**0.54 - -! fix 053011 -! AIN(K) = DUM*AI -! AA revision 4/1/11: Ikawa and Saito 1991 air-density correction -! AIN(K) = (RHOSU/RHO(K))**0.35 -! HM bug fix 10/32/2011 - AIN(K) = (RHOSU/RHO(K))**0.35*AI - ARN(K) = DUM*AR - ASN(K) = DUM*AS -! ACN(K) = DUM*AC -! AA revision 4/1/11: temperature-dependent Stokes fall speed - ACN(K) = G*RHOW/(18.*MU(K)) -! HM ADD GRAUPEL 8/28/06 - AGN(K) = DUM*AG - -! V1.7 -! bug fix 7/10/09 -!hm 4/15/09 bug fix, initialize lami to prevent later division by zero - LAMI(K)=0. - -!.................................. -! IF THERE IS NO CLOUD/PRECIP WATER, AND IF SUBSATURATED, THEN SKIP MICROPHYSICS -! FOR THIS LEVEL - - IF (QC3D(K).LT.QSMALL.AND.QI3D(K).LT.QSMALL.AND.QNI3D(K).LT.QSMALL & - .AND.QR3D(K).LT.QSMALL.AND.QG3D(K).LT.QSMALL) THEN - IF (T3D(K).LT.TMELT.AND.QVQVSI(K).LT.0.999) GOTO 200 - IF (T3D(K).GE.TMELT.AND.QVQVS(K).LT.0.999) GOTO 200 - END IF - -! THERMAL CONDUCTIVITY FOR AIR - -! fix 053011 - KAP(K) = 1.414E3*MU(K) - -! DIFFUSIVITY OF WATER VAPOR - - DV(K) = 8.794E-5*T3D(K)**1.81/PRES(K) - -! SCHMIT NUMBER - -! fix 053011 - SC(K) = MU(K)/(RHO(K)*DV(K)) - -! PSYCHOMETIC CORRECTIONS - -! RATE OF CHANGE SAT. MIX. RATIO WITH TEMPERATURE - - DUM = (RV*T3D(K)**2) - - DQSDT = XXLV(K)*QVS(K)/DUM - DQSIDT = XXLS(K)*QVI(K)/DUM - - ABI(K) = 1.+DQSIDT*XXLS(K)/CPM(K) - AB(K) = 1.+DQSDT*XXLV(K)/CPM(K) - -! -!..................................................................... -!..................................................................... -! CASE FOR TEMPERATURE ABOVE FREEZING - - IF (T3D(K).GE.TMELT) THEN - -!...................................................................... -!HM ADD, ALLOW FOR CONSTANT DROPLET NUMBER -! INUM = 0, PREDICT DROPLET NUMBER -! INUM = 1, SET CONSTANT DROPLET NUMBER - - IF (INUM.EQ.1) THEN -! CONVERT NDCNST FROM CM-3 TO KG-1 - NC3D(K)=NDCNST*1.E6/RHO(K) - END IF - -! GET SIZE DISTRIBUTION PARAMETERS - -! MELT VERY SMALL SNOW AND GRAUPEL MIXING RATIOS, ADD TO RAIN - IF (QNI3D(K).LT.1.E-6) THEN - QR3D(K)=QR3D(K)+QNI3D(K) - NR3D(K)=NR3D(K)+NS3D(K) - T3D(K)=T3D(K)-QNI3D(K)*XLF(K)/CPM(K) - QNI3D(K) = 0. - NS3D(K) = 0. - END IF - IF (QG3D(K).LT.1.E-6) THEN - QR3D(K)=QR3D(K)+QG3D(K) - NR3D(K)=NR3D(K)+NG3D(K) - T3D(K)=T3D(K)-QG3D(K)*XLF(K)/CPM(K) - QG3D(K) = 0. - NG3D(K) = 0. - END IF - - IF (QC3D(K).LT.QSMALL.AND.QNI3D(K).LT.1.E-8.AND.QR3D(K).LT.QSMALL.AND.QG3D(K).LT.1.E-8) GOTO 300 - -! MAKE SURE NUMBER CONCENTRATIONS AREN'T NEGATIVE - - NS3D(K) = MAX(0.,NS3D(K)) - NC3D(K) = MAX(0.,NC3D(K)) - NR3D(K) = MAX(0.,NR3D(K)) - NG3D(K) = MAX(0.,NG3D(K)) - -!...................................................................... -! RAIN - - IF (QR3D(K).GE.QSMALL) THEN - LAMR(K) = (PI*RHOW*NR3D(K)/QR3D(K))**(1./3.) - N0RR(K) = NR3D(K)*LAMR(K) - -! CHECK FOR SLOPE - -! ADJUST VARS - - IF (LAMR(K).LT.LAMMINR) THEN - - LAMR(K) = LAMMINR - - N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW) - - NR3D(K) = N0RR(K)/LAMR(K) - ELSE IF (LAMR(K).GT.LAMMAXR) THEN - LAMR(K) = LAMMAXR - N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW) - - NR3D(K) = N0RR(K)/LAMR(K) - END IF - END IF - -!...................................................................... -! CLOUD DROPLETS - -! MARTIN ET AL. (1994) FORMULA FOR PGAM - - IF (QC3D(K).GE.QSMALL) THEN - - !bloss: option for fixing pgam - if(dofix_pgam) then - pgam(k) = pgam_fixed - else - -! DUM = PRES(K)/(R*T3D(K)) -! V1.5 -#ifndef CLUBB_CRM - PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K))+0.2714 -#else - if(doclubb_autoin) then - PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K)/max(CFL3D(K), cloud_frac_thresh))+0.2714 - else - PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K))+0.2714 - end if -#endif - - PGAM(K)=1./(PGAM(K)**2)-1. - PGAM(K)=MAX(PGAM(K),2.) - PGAM(K)=MIN(PGAM(K),10.) - - end if -! v1.4 -! interpolate - dumii=int(pgam(k)) - nu(k)=dnu(dumii)+(dnu(dumii+1)-dnu(dumii))* & - (pgam(k)-real(dumii)) - -! CALCULATE LAMC - - LAMC(K) = (CONS26*NC3D(K)*GAMMA(PGAM(K)+4.)/ & - (QC3D(K)*GAMMA(PGAM(K)+1.)))**(1./3.) - -! LAMMIN, 60 MICRON DIAMETER -! LAMMAX, 1 MICRON - - LAMMIN = (PGAM(K)+1.)/60.E-6 - LAMMAX = (PGAM(K)+1.)/1.E-6 - - IF (LAMC(K).LT.LAMMIN) THEN - LAMC(K) = LAMMIN - -#ifndef CLUBB_CRM - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 -#else - if(doclubb_autoin) then - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K)/max(CFL3D(K), cloud_frac_thresh))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 * max(CFL3D(K), cloud_frac_thresh) - else - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 - endif -#endif - ELSE IF (LAMC(K).GT.LAMMAX) THEN - LAMC(K) = LAMMAX - -#ifndef CLUBB_CRM - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 -#else - if(doclubb_autoin) then - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K)/max(CFL3D(K), cloud_frac_thresh))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 * max(CFL3D(K), cloud_frac_thresh) - else - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 - end if -#endif - - END IF - - END IF - -!...................................................................... -! SNOW - - IF (QNI3D(K).GE.QSMALL) THEN - LAMS(K) = (CONS1*NS3D(K)/QNI3D(K))**(1./DS) - N0S(K) = NS3D(K)*LAMS(K) - -! CHECK FOR SLOPE - -! ADJUST VARS - - IF (LAMS(K).LT.LAMMINS) THEN - LAMS(K) = LAMMINS - N0S(K) = LAMS(K)**(DS+1.)*QNI3D(K)/CONS1 - - NS3D(K) = N0S(K)/LAMS(K) - - ELSE IF (LAMS(K).GT.LAMMAXS) THEN - - LAMS(K) = LAMMAXS - N0S(K) = LAMS(K)**(DS+1.)*QNI3D(K)/CONS1 - - NS3D(K) = N0S(K)/LAMS(K) - END IF - END IF - -!...................................................................... -! GRAUPEL - - IF (QG3D(K).GE.QSMALL) THEN - LAMG(K) = (CONS2*NG3D(K)/QG3D(K))**(1./DG) - N0G(K) = NG3D(K)*LAMG(K) - -! ADJUST VARS - - IF (LAMG(K).LT.LAMMING) THEN - LAMG(K) = LAMMING - N0G(K) = LAMG(K)**(DG+1.)*QG3D(K)/CONS2 - - NG3D(K) = N0G(K)/LAMG(K) - - ELSE IF (LAMG(K).GT.LAMMAXG) THEN - - LAMG(K) = LAMMAXG - N0G(K) = LAMG(K)**(DG+1.)*QG3D(K)/CONS2 - - NG3D(K) = N0G(K)/LAMG(K) - END IF - END IF - -!..................................................................... -! ZERO OUT PROCESS RATES - - PRC(K) = 0. - NPRC(K) = 0. - NPRC1(K) = 0. - PRA(K) = 0. - NPRA(K) = 0. - NRAGG(K) = 0. - PSMLT(K) = 0. - NSMLTS(K) = 0. - NSMLTR(K) = 0. - EVPMS(K) = 0. - PCC(K) = 0. - PRE(K) = 0. - NSUBC(K) = 0. - NSUBR(K) = 0. - PRACG(K) = 0. - NPRACG(K) = 0. - PSMLT(K) = 0. - EVPMS(K) = 0. - PGMLT(K) = 0. - EVPMG(K) = 0. - PRACS(K) = 0. - NPRACS(K) = 0. - NGMLTG(K) = 0. - NGMLTR(K) = 0. - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! CALCULATION OF MICROPHYSICAL PROCESS RATES, T > 273.15 K - -!................................................................. -!....................................................................... -! AUTOCONVERSION OF CLOUD LIQUID WATER TO RAIN -! FORMULA FROM BEHENG (1994) -! USING NUMERICAL SIMULATION OF STOCHASTIC COLLECTION EQUATION -! AND INITIAL CLOUD DROPLET SIZE DISTRIBUTION SPECIFIED -! AS A GAMMA DISTRIBUTION - -! USE MINIMUM VALUE OF 1.E-6 TO PREVENT FLOATING POINT ERROR - - IF (QC3D(K).GE.1.E-6) THEN - -! HM ADD 12/13/06, REPLACE WITH NEWER FORMULA -! FROM KHAIROUTDINOV AND KOGAN 2000, MWR - - IF (IRAIN.EQ.0) THEN - - PRC(K)=1350.*QC3D(K)**2.47* & - (NC3D(K)/1.e6*RHO(K))**(-1.79) - -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - PRC(K)=PRC(K) * gamma(RELVAR(K)+2.47)/(gamma(RELVAR(K))*RELVAR(K)**2.47) - PRC(K)=PRC(K) * CFL3D(K)**0.32 ! CFL3D**(1.79-2.47+1) - end if -#endif - -! note: nprc1 is change in Nr, -! nprc is change in Nc - - NPRC1(K) = PRC(K)/CONS29 - NPRC(K) = PRC(K)/(QC3D(k)/NC3D(K)) - - NPRC(K) = MIN(NPRC(K),NC3D(K)/DT) - - ELSE IF (IRAIN.EQ.1) THEN - -! v1.4 -! replace with seifert and beheng - - dum = 1.-qc3d(k)/(qc3d(k)+qr3d(k)) - dum1 = 600.*dum**0.68*(1.-dum**0.68)**3 - - prc(k) = 9.44e9/(20.*2.6e-7)* & - (nu(k)+2.)*(nu(k)+4.)/(nu(k)+1.)**2* & - (rho(k)*qc3d(k)/1000.)**4/(rho(k)*nc3d(k)/1.e6)**2* & - (1.+dum1/(1.-dum)**2)*1000./rho(k) - - nprc(k) = prc(k)*2./2.6e-7*1000. - nprc1(k) = 0.5*nprc(k) - - END IF - END IF - -!....................................................................... -! HM ADD 12/13/06, COLLECTION OF SNOW BY RAIN ABOVE FREEZING -! FORMULA FROM IKAWA AND SAITO (1991) - - IF (QR3D(K).GE.1.E-8.AND.QNI3D(K).GE.1.E-8) THEN - - UMS = ASN(K)*CONS3/(LAMS(K)**BS) - UMR = ARN(K)*CONS4/(LAMR(K)**BR) - UNS = ASN(K)*CONS5/LAMS(K)**BS - UNR = ARN(K)*CONS6/LAMR(K)**BR - -! SET REASLISTIC LIMITS ON FALLSPEEDS - -! bug fix, 10/08/09 - dum=(rhosu/rho(k))**0.54 - UMS=MIN(UMS,1.2*dum) - UNS=MIN(UNS,1.2*dum) - UMR=MIN(UMR,9.1*dum) - UNR=MIN(UNR,9.1*dum) - - PRACS(K) = CONS31*(((1.2*UMR-0.95*UMS)**2+ & - 0.08*UMS*UMR)**0.5*RHO(K)* & - N0RR(K)*N0S(K)/LAMS(K)**3* & - (5./(LAMS(K)**3*LAMR(K))+ & - 2./(LAMS(K)**2*LAMR(K)**2)+ & - 0.5/(LAMS(K)*LAMR(K)**3))) - -! fix 053011, npracs no longer subtracted from snow -! NPRACS(K) = CONS32*RHO(K)*(1.7*(UNR-UNS)**2+ & -! 0.3*UNR*UNS)**0.5*N0RR(K)*N0S(K)* & -! (1./(LAMR(K)**3*LAMS(K))+ & -! 1./(LAMR(K)**2*LAMS(K)**2)+ & -! 1./(LAMR(K)*LAMS(K)**3)) - - END IF - -! ADD COLLECTION OF GRAUPEL BY RAIN ABOVE FREEZING -! ASSUME ALL RAIN COLLECTION BY GRAUPEL ABOVE FREEZING IS SHED -! ASSUME SHED DROPS ARE 1 MM IN SIZE - - IF (QR3D(K).GE.1.E-8.AND.QG3D(K).GE.1.E-8) THEN - - UMG = AGN(K)*CONS7/(LAMG(K)**BG) - UMR = ARN(K)*CONS4/(LAMR(K)**BR) - UNG = AGN(K)*CONS8/LAMG(K)**BG - UNR = ARN(K)*CONS6/LAMR(K)**BR - -! SET REASLISTIC LIMITS ON FALLSPEEDS -! bug fix, 10/08/09 - dum=(rhosu/rho(k))**0.54 - UMG=MIN(UMG,20.*dum) - UNG=MIN(UNG,20.*dum) - UMR=MIN(UMR,9.1*dum) - UNR=MIN(UNR,9.1*dum) - -! PRACG IS MIXING RATIO OF RAIN PER SEC COLLECTED BY GRAUPEL/HAIL - PRACG(K) = CONS41*(((1.2*UMR-0.95*UMG)**2+ & - 0.08*UMG*UMR)**0.5*RHO(K)* & - N0RR(K)*N0G(K)/LAMR(K)**3* & - (5./(LAMR(K)**3*LAMG(K))+ & - 2./(LAMR(K)**2*LAMG(K)**2)+ & - 0.5/(LAMR(k)*LAMG(k)**3))) - -! ASSUME 1 MM DROPS ARE SHED, GET NUMBER CONC (KG-1) SHED PER SEC - - DUM = PRACG(K)/5.2E-7 - -! GET NUMBER CONC OF RAIN DROPS COLLECTED - - NPRACG(K) = CONS32*RHO(K)*(1.7*(UNR-UNG)**2+ & - 0.3*UNR*UNG)**0.5*N0RR(K)*N0G(K)* & - (1./(LAMR(K)**3*LAMG(K))+ & - 1./(LAMR(K)**2*LAMG(K)**2)+ & - 1./(LAMR(K)*LAMG(K)**3)) - - NPRACG(K)=MAX(NPRACG(K)-DUM,0.) - - END IF - -!....................................................................... -! ACCRETION OF CLOUD LIQUID WATER BY RAIN -! CONTINUOUS COLLECTION EQUATION WITH -! GRAVITATIONAL COLLECTION KERNEL, DROPLET FALL SPEED NEGLECTED - - IF (QR3D(K).GE.1.E-8 .AND. QC3D(K).GE.1.E-8) THEN - -! 12/13/06 HM ADD, REPLACE WITH NEWER FORMULA FROM -! KHAIROUTDINOV AND KOGAN 2000, MWR - - IF (IRAIN.EQ.0) THEN - - DUM=(QC3D(K)*QR3D(K)) - PRA(K) = 67.*(DUM)**1.15 -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - PRA(K)=PRA(K) * accre_enhan(K)*gamma(RELVAR(K)+1.15)/(gamma(RELVAR(K))*RELVAR(K)**1.15) - PRA(K) = PRA(K) /(max(CLDMAXR(K), cloud_frac_thresh))**1.15 ! PRA = (QC3D/CFL3D * QR3D/CLDMAXR * CFL3D)**1.15 - end if -#endif - NPRA(K) = PRA(K)/(QC3D(K)/NC3D(K)) - - ELSE IF (IRAIN.EQ.1) THEN - -! v1.4 -! seifert and beheng (2001) formulation - - dum = 1.-qc3d(k)/(qc3d(k)+qr3d(k)) - dum1 = (dum/(dum+5.e-4))**4 - pra(k) = 5.78e3*rho(k)/1000.*qc3d(k)*qr3d(k)*dum1 - npra(k) = pra(k)*rho(k)/1000.*(nc3d(k)*rho(k)/1.e6)/ & - (qc3d(k)*rho(k)/1000.)*1.e6/rho(k) - - END IF - END IF -!....................................................................... -! SELF-COLLECTION OF RAIN DROPS -! FROM BEHENG(1994) -! FROM NUMERICAL SIMULATION OF THE STOCHASTIC COLLECTION EQUATION -! AS DESCRINED ABOVE FOR AUTOCONVERSION - -! v1.4, replace with seifert and beheng (2001) - - IF (QR3D(K).GE.1.E-8) THEN -! include breakup add 10/09/09 - dum1=300.e-6 - if (1./lamr(k).lt.dum1) then - dum=1. - else if (1./lamr(k).ge.dum1) then - dum=2.-exp(2300.*(1./lamr(k)-dum1)) - end if -! NRAGG(K) = -8.*NR3D(K)*QR3D(K)*RHO(K) - NRAGG(K) = -5.78*dum*NR3D(K)*QR3D(K)*RHO(K) - END IF - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! CALCULATE EVAP OF RAIN (RUTLEDGE AND HOBBS 1983) - - IF (QR3D(K).GE.QSMALL) THEN - EPSR = 2.*PI*N0RR(K)*RHO(K)*DV(K)* & - (F1R/(LAMR(K)*LAMR(K))+ & - F2R*(ARN(K)*RHO(K)/MU(K))**0.5* & - SC(K)**(1./3.)*CONS9/ & - (LAMR(K)**CONS34)) - ELSE - EPSR = 0. - END IF - -! NO CONDENSATION ONTO RAIN, ONLY EVAP ALLOWED - - IF (QV3D(K).LT.QVS(K)) THEN - PRE(K) = EPSR*(QV3D(K)-QVS(K))/AB(K) - PRE(K) = MIN(PRE(K),0.) - ELSE - PRE(K) = 0. - END IF -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - PRE(K) = PRE(K) * max(CLDMAXR(K)-CFL3D(K), 0.0)/max(CLDMAXR(K), cloud_frac_thresh) - if(CFL3D(K).gt.0.10) then ! when there is enough liquid present, no evaporation is allowed - PRE(K) = 0.0 - end if - end if -#endif - -!....................................................................... -! MELTING OF SNOW - -! SNOW MAY PERSITS ABOVE FREEZING, FORMULA FROM RUTLEDGE AND HOBBS, 1984 -! IF WATER SUPERSATURATION, SNOW MELTS TO FORM RAIN - - IF (QNI3D(K).GE.1.E-8) THEN - -! fix 053011 -! HM, MODIFY FOR V3.2, ADD ACCELERATED MELTING DUE TO COLLISION WITH RAIN -! DUM = -CPW/XLF(K)*T3D(K)*PRACS(K) -! DUM = -CPW/XLF(K)*(T3D(K)-TMELT)*PRACS(K) - DUM = -CPW/XLF(K)*max(T3D(K)-TMELT, 0.0)*PRACS(K) !+++mhwang 09/20/2011 - -! PSMLT(K)=2.*PI*N0S(K)*KAP(K)*(TMELT-T3D(K))/ & - PSMLT(K)=2.*PI*N0S(K)*KAP(K)*min(TMELT-T3D(K), 0.0)/ & !+++mhwang 09/20/2011 - XLF(K)*RHO(K)*(F1S/(LAMS(K)*LAMS(K))+ & - F2S*(ASN(K)*RHO(K)/MU(K))**0.5* & - SC(K)**(1./3.)*CONS10/ & - (LAMS(K)**CONS35))+DUM - -! IN WATER SUBSATURATION, SNOW MELTS AND EVAPORATES - - IF (QVQVS(K).LT.1.) THEN - EPSS = 2.*PI*N0S(K)*RHO(K)*DV(K)* & - (F1S/(LAMS(K)*LAMS(K))+ & - F2S*(ASN(K)*RHO(K)/MU(K))**0.5* & - SC(K)**(1./3.)*CONS10/ & - (LAMS(K)**CONS35)) -! bug fix V1.4 - EVPMS(K) = (QV3D(K)-QVS(K))*EPSS/AB(K) - EVPMS(K) = MAX(EVPMS(K),PSMLT(K)) - PSMLT(K) = PSMLT(K)-EVPMS(K) - END IF - END IF - -!....................................................................... -! MELTING OF GRAUPEL - -! GRAUPEL MAY PERSITS ABOVE FREEZING, FORMULA FROM RUTLEDGE AND HOBBS, 1984 -! IF WATER SUPERSATURATION, GRAUPEL MELTS TO FORM RAIN - - IF (QG3D(K).GE.1.E-8) THEN - -! fix 053011 -! HM, MODIFY FOR V3.2, ADD ACCELERATED MELTING DUE TO COLLISION WITH RAIN -! DUM = -CPW/XLF(K)*T3D(K)*PRACG(K) -! DUM = -CPW/XLF(K)*(T3D(K)-273.15)*PRACG(K) - DUM = -CPW/XLF(K)*max(T3D(K)-TMELT, 0.0)*PRACG(K) !+++mhwang 10/17/2011 - - PGMLT(K)=2.*PI*N0G(K)*KAP(K)*(TMELT-T3D(K))/ & - XLF(K)*RHO(K)*(F1S/(LAMG(K)*LAMG(K))+ & - F2S*(AGN(K)*RHO(K)/MU(K))**0.5* & - SC(K)**(1./3.)*CONS11/ & - (LAMG(K)**CONS36))+DUM - -! IN WATER SUBSATURATION, GRAUPEL MELTS AND EVAPORATES - - IF (QVQVS(K).LT.1.) THEN - EPSG = 2.*PI*N0G(K)*RHO(K)*DV(K)* & - (F1S/(LAMG(K)*LAMG(K))+ & - F2S*(AGN(K)*RHO(K)/MU(K))**0.5* & - SC(K)**(1./3.)*CONS11/ & - (LAMG(K)**CONS36)) -! bug fix V1.4 - EVPMG(K) = (QV3D(K)-QVS(K))*EPSG/AB(K) - EVPMG(K) = MAX(EVPMG(K),PGMLT(K)) - PGMLT(K) = PGMLT(K)-EVPMG(K) - END IF - END IF - -! HM, V3.2 -! RESET PRACG AND PRACS TO ZERO, THIS IS DONE BECAUSE THERE IS NO -! TRANSFER OF MASS FROM SNOW AND GRAUPEL TO RAIN DIRECTLY FROM COLLECTION -! ABOVE FREEZING, IT IS ONLY USED FOR ENHANCEMENT OF MELTING AND SHEDDING - - PRACG(K) = 0. - PRACS(K) = 0. - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - -! FOR CLOUD ICE, ONLY PROCESSES OPERATING AT T > 273.15 IS -! MELTING, WHICH IS ALREADY CONSERVED DURING PROCESS -! CALCULATION - -! CONSERVATION OF QC - - DUM = (PRC(K)+PRA(K))*DT - - IF (DUM.GT.QC3D(K).AND.QC3D(K).GE.QSMALL) THEN - - RATIO = QC3D(K)/DUM - - PRC(K) = PRC(K)*RATIO - PRA(K) = PRA(K)*RATIO - - END IF - -! CONSERVATION OF SNOW - - DUM = (-PSMLT(K)-EVPMS(K)+PRACS(K))*DT - - IF (DUM.GT.QNI3D(K).AND.QNI3D(K).GE.QSMALL) THEN - -! NO SOURCE TERMS FOR SNOW AT T > FREEZING - RATIO = QNI3D(K)/DUM - - PSMLT(K) = PSMLT(K)*RATIO - EVPMS(K) = EVPMS(K)*RATIO - PRACS(K) = PRACS(K)*RATIO - - END IF - -! CONSERVATION OF GRAUPEL - - DUM = (-PGMLT(K)-EVPMG(K)+PRACG(K))*DT - - IF (DUM.GT.QG3D(K).AND.QG3D(K).GE.QSMALL) THEN - -! NO SOURCE TERM FOR GRAUPEL ABOVE FREEZING - RATIO = QG3D(K)/DUM - - PGMLT(K) = PGMLT(K)*RATIO - EVPMG(K) = EVPMG(K)*RATIO - PRACG(K) = PRACG(K)*RATIO - - END IF - -! CONSERVATION OF QR -! HM 12/13/06, ADDED CONSERVATION OF RAIN SINCE PRE IS NEGATIVE - - DUM = (-PRACS(K)-PRACG(K)-PRE(K)-PRA(K)-PRC(K)+PSMLT(K)+PGMLT(K))*DT - - IF (DUM.GT.QR3D(K).AND.QR3D(K).GE.QSMALL) THEN - - RATIO = (QR3D(K)/DT+PRACS(K)+PRACG(K)+PRA(K)+PRC(K)-PSMLT(K)-PGMLT(K))/ & - (-PRE(K)) - PRE(K) = PRE(K)*RATIO - - END IF - -!.................................... - - QV3DTEN(K) = QV3DTEN(K)+(-PRE(K)-EVPMS(K)-EVPMG(K)) - - T3DTEN(K) = T3DTEN(K)+(PRE(K)*XXLV(K)+(EVPMS(K)+EVPMG(K))*XXLS(K)+& - (PSMLT(K)+PGMLT(K)-PRACS(K)-PRACG(K))*XLF(K))/CPM(K) - - QC3DTEN(K) = QC3DTEN(K)+(-PRA(K)-PRC(K)) - QR3DTEN(K) = QR3DTEN(K)+(PRE(K)+PRA(K)+PRC(K)-PSMLT(K)-PGMLT(K)+PRACS(K)+PRACG(K)) - QNI3DTEN(K) = QNI3DTEN(K)+(PSMLT(K)+EVPMS(K)-PRACS(K)) - QG3DTEN(K) = QG3DTEN(K)+(PGMLT(K)+EVPMG(K)-PRACG(K)) -! fix 053011 -! NS3DTEN(K) = NS3DTEN(K)-NPRACS(K) -! HM, bug fix 5/12/08, npracg is subtracted from nr not ng -! NG3DTEN(K) = NG3DTEN(K) - NC3DTEN(K) = NC3DTEN(K)+ (-NPRA(K)-NPRC(K)) - NR3DTEN(K) = NR3DTEN(K)+ (NPRC1(K)+NRAGG(K)-NPRACG(K)) -#ifdef ECPP -! HM ADD, WRF-CHEM, ADD TENDENCIES FOR C2PREC - C2PREC(K) = PRA(K)+PRC(K) - if(QC3D(K).gt.1.0e-10) then - QSINK(K) = min(1.0, C2PREC(K)/QC3D(K)) - else - QSINK(K) = 0.0 - end if -#endif - - IF (PRE(K).LT.0.) THEN - DUM = PRE(K)*DT/QR3D(K) - DUM = MAX(-1.,DUM) - NSUBR(K) = DUM*NR3D(K)/DT - END IF - -! V1.3 move code below to before saturation adjustment - IF (EVPMS(K)+PSMLT(K).LT.0.) THEN - DUM = (EVPMS(K)+PSMLT(K))*DT/QNI3D(K) - DUM = MAX(-1.,DUM) - NSMLTS(K) = DUM*NS3D(K)/DT - END IF - IF (PSMLT(K).LT.0.) THEN - DUM = PSMLT(K)*DT/QNI3D(K) - DUM = MAX(-1.0,DUM) - NSMLTR(K) = DUM*NS3D(K)/DT - END IF - IF (EVPMG(K)+PGMLT(K).LT.0.) THEN - DUM = (EVPMG(K)+PGMLT(K))*DT/QG3D(K) - DUM = MAX(-1.,DUM) - NGMLTG(K) = DUM*NG3D(K)/DT - END IF - IF (PGMLT(K).LT.0.) THEN - DUM = PGMLT(K)*DT/QG3D(K) - DUM = MAX(-1.0,DUM) - NGMLTR(K) = DUM*NG3D(K)/DT - END IF - -! nsubr(k)=0. -! nsubs(k)=0. -! nsubg(k)=0. - - NS3DTEN(K) = NS3DTEN(K)+(NSMLTS(K)) - NG3DTEN(K) = NG3DTEN(K)+(NGMLTG(K)) - NR3DTEN(K) = NR3DTEN(K)+(NSUBR(K)-NSMLTR(K)-NGMLTR(K)) - - 300 CONTINUE - - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - IF(ISATADJ.EQ.0) THEN !PB 4/13/09 - -! NOW CALCULATE SATURATION ADJUSTMENT TO CONDENSE EXTRA VAPOR ABOVE -! WATER SATURATION - - DUMT = T3D(K)+DT*T3DTEN(K) - DUMQV = QV3D(K)+DT*QV3DTEN(K) -! hm, add fix for low pressure, 5/12/10 - dum=min(0.99*pres(k),POLYSVP(DUMT,0)) - DUMQSS = EP_2*dum/(PRES(K)-dum) - DUMQC = QC3D(K)+DT*QC3DTEN(K) - DUMQC = MAX(DUMQC,0.) - -! SATURATION ADJUSTMENT FOR LIQUID - - DUMS = DUMQV-DUMQSS - PCC(K) = DUMS/(1.+XXLV(K)**2*DUMQSS/(CPM(K)*RV*DUMT**2))/DT -! IF (PCC(K)*DT+DUMQC.LT.0.) THEN -! PCC(K) = -DUMQC/DT -! END IF -!+++mhwang - IF (PCC(K)*DT+QC3D(K)+DT*QC3DTEN(K).LT.0.) THEN - PCC(K) = -(QC3D(K)+DT*QC3DTEN(K))/DT - END IF -!---mhwang - - QV3DTEN(K) = QV3DTEN(K)-PCC(K) - T3DTEN(K) = T3DTEN(K)+PCC(K)*XXLV(K)/CPM(K) - QC3DTEN(K) = QC3DTEN(K)+PCC(K) - - END IF - -! hm 7/26/11, new output - - aut1d(k)=prc(k) - acc1d(k)=pra(k) - mlt1d(k)=-PSMLT(K)-PGMLT(K)+PRACS(K)+PRACG(K) - evpr1d(k)=-PRE(K)-EVPMS(K)-EVPMG(K) - if (pcc(k).lt.0.) then - evpc1d(k)=-pcc(k) - else if (pcc(k).gt.0.) then - con1d(k)=pcc(k) - end if - -!....................................................................... -! ACTIVATION OF CLOUD DROPLETS - -!bloss: only do activation if droplet number is predicted -!bloss IF (QC3D(K)+QC3DTEN(K)*DT.GE.QSMALL) THEN - IF (QC3D(K)+QC3DTEN(K)*DT.GE.QSMALL.AND.INUM.EQ.0) THEN - -! EFFECTIVE VERTICAL VELOCITY (M/S) - - IF (ISUB.EQ.0) THEN -! ADD SUB-GRID VERTICAL VELOCITY - DUM = W3D(K)+WVAR(K) - -! ASSUME MINIMUM EFF. SUB-GRID VELOCITY 0.10 M/S -#ifdef CLUBB_CRM - DUM = MAX(DUM,0.01) -#else - DUM = MAX(DUM,0.10) -#endif - - - ELSE IF (ISUB.EQ.1) THEN - DUM=W3D(K) - END IF - -! ONLY ACTIVATE IN REGIONS OF UPWARD MOTION - IF (DUM.GE.0.001) THEN - - IF (IBASE.EQ.1) THEN - -! ACTIVATE ONLY IF THERE IS LITTLE CLOUD WATER -! OR IF AT CLOUD BASE, OR AT LOWEST MODEL LEVEL (K=1) - - IDROP=0 - -! V1.3 USE CURRENT VALUE OF QC FOR IDROP - IF (QC3D(K).LE.0.05E-3/RHO(K)) THEN - IDROP=1 - END IF - IF (K.EQ.1) THEN - IDROP=1 - ELSE IF (K.GE.2) THEN - IF (QC3D(K).GT.0.05E-3/RHO(K).AND. & - QC3D(K-1).LE.0.05E-3/RHO(K-1)) THEN - IDROP=1 - END IF - END IF - - IF (IDROP.EQ.1) THEN -! ACTIVATE AT CLOUD BASE OR REGIONS WITH VERY LITTLE LIQ WATER - - IF (IACT.EQ.1) THEN -! USE ROGERS AND YAU (1989) TO RELATE NUMBER ACTIVATED TO W -! BASED ON TWOMEY 1959 - - DUM=DUM*100. ! CONVERT FROM M/S TO CM/S - DUM2 = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.)) - DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3 - DUM2=DUM2/RHO(K) ! CONVERT FROM M-3 TO KG-1 -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0.,DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 - - ELSE IF (IACT.EQ.2) THEN -! DROPLET ACTIVATION FROM ABDUL-RAZZAK AND GHAN (2000) - - SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) - AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) - ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K)) - GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K)) - - GG = 1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+ XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ & - (T3D(K)*RR)-1.)) - - PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT - - ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1) - ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2) - - SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 - SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 - - DUM1 = 1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75) - DUM2 = 1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75) - - SMAX = 1./(DUM1+DUM2)**0.5 - - UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) - UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) - DUM1 = NANEW1/2.*(1.-DERF1(UU1)) - DUM2 = NANEW2/2.*(1.-DERF1(UU2)) - - DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 - -! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL - - DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0.,DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 -#if (defined CRM && defined MODAL_AERO) - ELSE if (IACT.EQ.3) then - INES = 0 - CALL DROP_ACTIVATION_GHAN(DUM, T3D(k), RHO(k), & - DUM2, INES, SMAX, K) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0., DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 -#endif - END IF ! IACT - -!............................................................................. - ELSE IF (IDROP.EQ.0) THEN -! ACTIVATE IN CLOUD INTERIOR -! FIND EQUILIBRIUM SUPERSATURATION - - TAUC=1./(2.*PI*RHO(k)*DV(K)*NC3D(K)*(PGAM(K)+1.)/LAMC(K)) - IF (EPSR.GT.1.E-8) THEN - TAUR=1./EPSR - ELSE - TAUR=1.E8 - END IF - - DUM3=(QVS(K)*RHO(K)/(PRES(K)-EVS(K))+DQSDT/CP)*G*DUM - DUM3=DUM3*TAUC*TAUR/(TAUC+TAUR) - - IF (DUM3/QVS(K).GE.1.E-6) THEN - IF (IACT.EQ.1) THEN - -! FIND MAXIMUM ALLOWED ACTIVATION WITH NON-EQULIBRIUM SS - - DUM=DUM*100. ! CONVERT FROM M/S TO CM/S - DUMACT = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.)) - -! USE POWER LAW CCN SPECTRA - -! CONVERT FROM ABSOLUTE SUPERSATURATION TO SUPERSATURATION RATIO IN % - DUM3=DUM3/QVS(K)*100. - - DUM2=C1*DUM3**K1 -! MAKE SURE VALUE DOESN'T EXCEED THAT FOR NON-EQUILIBRIUM SS - DUM2=MIN(DUM2,DUMACT) - DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3 - DUM2=DUM2/RHO(K) ! CONVERT FROM M-3 TO KG-1 -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0.,DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 - - ELSE IF (IACT.EQ.2) THEN - -! FIND MAXIMUM ALLOWED ACTIVATION WITH NON-EQULIBRIUM SS - - SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) - AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) - ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K)) - GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K)) - - GG = 1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+ XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ & - (T3D(K)*RR)-1.)) - - PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT - - ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1) - ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2) - - SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 - SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 - - DUM1 = 1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75) - DUM2 = 1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75) - - SMAX = 1./(DUM1+DUM2)**0.5 - - UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) - UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) - DUM1 = NANEW1/2.*(1.-DERF1(UU1)) - DUM2 = NANEW2/2.*(1.-DERF1(UU2)) - - DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 - -! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL - - DUMACT = MIN((NANEW1+NANEW2)/RHO(K),DUM2) - -! USE LOGNORMAL AEROSOL - SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) - AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) - - SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 - SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 - -! GET SUPERSATURATION RATIO FROM ABSOLUTE SUPERSATURATION - SMAX = DUM3/QVS(K) - - UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) - UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) - DUM1 = NANEW1/2.*(1.-DERF1(UU1)) - DUM2 = NANEW2/2.*(1.-DERF1(UU2)) - - DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 - -! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL - - DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2) - -! MAKE SURE ISN'T GREATER THAN NON-EQUIL. SS - DUM2=MIN(DUM2,DUMACT) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0.,DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 -#if (defined CRM && defined MODAL_AERO) - ELSE if (IACT.EQ.3) then - INES =1 -! GET SUPERSATURATION RATIO FROM ABSOLUTE SUPERSATURATION - SMAX = DUM3/QVS(K) - CALL DROP_ACTIVATION_GHAN(DUM, T3D(k), RHO(k), & - DUM2, INES, SMAX, K) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0., DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 -#endif - END IF ! IACT - END IF ! DUM3/QVS > 1.E-6 - END IF ! IDROP = 1 - -!....................................................................... - ELSE IF (IBASE.EQ.2) THEN - - IF (IACT.EQ.1) THEN -! USE ROGERS AND YAU (1989) TO RELATE NUMBER ACTIVATED TO W -! BASED ON TWOMEY 1959 - - DUM=DUM*100. ! CONVERT FROM M/S TO CM/S - DUM2 = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.)) - DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3 - DUM2=DUM2/RHO(K) ! CONVERT FROM M-3 TO KG-1 -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0.,DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 - - ELSE IF (IACT.EQ.2) THEN - - SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) - AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) - ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K)) - GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K)) - - GG = 1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+ XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ & - (T3D(K)*RR)-1.)) - - PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT - - ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1) - ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2) - - SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 - SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 - - DUM1 = 1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75) - DUM2 = 1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75) - - SMAX = 1./(DUM1+DUM2)**0.5 - - UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) - UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) - DUM1 = NANEW1/2.*(1.-DERF1(UU1)) - DUM2 = NANEW2/2.*(1.-DERF1(UU2)) - - DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 - -! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL - - DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0.,DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 -#if (defined CRM && defined MODAL_AERO) - ELSE if (IACT.EQ.3) then - INES = 0 - CALL DROP_ACTIVATION_GHAN(DUM, T3D(k), RHO(k), & - DUM2, INES, SMAX, K) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0., DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 -#endif - END IF ! IACT - END IF ! IBASE - END IF ! W > 0.001 - END IF ! QC3D > QSMALL - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! SUBLIMATE, MELT, OR EVAPORATE NUMBER CONCENTRATION -! THIS FORMULATION ASSUMES 1:1 RATIO BETWEEN MASS LOSS AND -! LOSS OF NUMBER CONCENTRATION - -! IF (PCC(K).LT.0.) THEN -! DUM = PCC(K)*DT/QC3D(K) -! DUM = MAX(-1.,DUM) -! NSUBC(K) = DUM*NC3D(K)/DT -! END IF - -! UPDATE TENDENCIES - -! NC3DTEN(K) = NC3DTEN(K)+NSUBC(K) - -!..................................................................... -!..................................................................... - ELSE ! TEMPERATURE < 273.15 - -!...................................................................... -!HM ADD, ALLOW FOR CONSTANT DROPLET NUMBER -! INUM = 0, PREDICT DROPLET NUMBER -! INUM = 1, SET CONSTANT DROPLET NUMBER - - IF (INUM.EQ.1) THEN -! CONVERT NDCNST FROM CM-3 TO KG-1 - NC3D(K)=NDCNST*1.E6/RHO(K) - END IF - -! CALCULATE SIZE DISTRIBUTION PARAMETERS -! MAKE SURE NUMBER CONCENTRATIONS AREN'T NEGATIVE - - NI3D(K) = MAX(0.,NI3D(K)) - NS3D(K) = MAX(0.,NS3D(K)) - NC3D(K) = MAX(0.,NC3D(K)) - NR3D(K) = MAX(0.,NR3D(K)) - NG3D(K) = MAX(0.,NG3D(K)) - -!...................................................................... -! CLOUD ICE - - IF (QI3D(K).GE.QSMALL) THEN - LAMI(K) = (CONS12* & - NI3D(K)/QI3D(K))**(1./DI) - N0I(K) = NI3D(K)*LAMI(K) - -! CHECK FOR SLOPE - -! ADJUST VARS - - IF (LAMI(K).LT.LAMMINI) THEN - - LAMI(K) = LAMMINI - - N0I(K) = LAMI(K)**(DI+1.)*QI3D(K)/CONS12 - - NI3D(K) = N0I(K)/LAMI(K) - ELSE IF (LAMI(K).GT.LAMMAXI) THEN - LAMI(K) = LAMMAXI - N0I(K) = LAMI(K)**(DI+1.)*QI3D(K)/CONS12 - - NI3D(K) = N0I(K)/LAMI(K) - END IF - END IF - -!...................................................................... -! RAIN - - IF (QR3D(K).GE.QSMALL) THEN - LAMR(K) = (PI*RHOW*NR3D(K)/QR3D(K))**(1./3.) - N0RR(K) = NR3D(K)*LAMR(K) - -! CHECK FOR SLOPE - -! ADJUST VARS - - IF (LAMR(K).LT.LAMMINR) THEN - - LAMR(K) = LAMMINR - - N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW) - - NR3D(K) = N0RR(K)/LAMR(K) - ELSE IF (LAMR(K).GT.LAMMAXR) THEN - LAMR(K) = LAMMAXR - N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW) - - NR3D(K) = N0RR(K)/LAMR(K) - END IF - END IF - -!...................................................................... -! CLOUD DROPLETS - -! MARTIN ET AL. (1994) FORMULA FOR PGAM - - IF (QC3D(K).GE.QSMALL) THEN - - !bloss: option for fixing pgam - if(dofix_pgam) then - pgam(k) = pgam_fixed - else - -! DUM = PRES(K)/(R*T3D(K)) -! V1.5 -#ifndef CLUBB_CRM - PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K))+0.2714 -#else - if(doclubb_autoin) then - PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K)/max(CFL3D(K), cloud_frac_thresh))+0.2714 - else - PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K))+0.2714 - end if -#endif - - PGAM(K)=1./(PGAM(K)**2)-1. - PGAM(K)=MAX(PGAM(K),2.) - PGAM(K)=MIN(PGAM(K),10.) - - end if -! v1.4 -! interpolate - dumii=int(pgam(k)) - nu(k)=dnu(dumii)+(dnu(dumii+1)-dnu(dumii))* & - (pgam(k)-real(dumii)) - -! CALCULATE LAMC - - LAMC(K) = (CONS26*NC3D(K)*GAMMA(PGAM(K)+4.)/ & - (QC3D(K)*GAMMA(PGAM(K)+1.)))**(1./3.) - -! LAMMIN, 60 MICRON DIAMETER -! LAMMAX, 1 MICRON - - LAMMIN = (PGAM(K)+1.)/60.E-6 - LAMMAX = (PGAM(K)+1.)/1.E-6 - - IF (LAMC(K).LT.LAMMIN) THEN - LAMC(K) = LAMMIN - -#ifndef CLUBB_CRM - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 -#else - if(doclubb_autoin) then - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K)/max(CFL3D(K), cloud_frac_thresh))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 * max(CFL3D(K), cloud_frac_thresh) - else - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 - endif -#endif - - ELSE IF (LAMC(K).GT.LAMMAX) THEN - LAMC(K) = LAMMAX -#ifndef CLUBB_CRM - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 -#else - if(doclubb_autoin) then - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K)/max(CFL3D(K), cloud_frac_thresh))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 * max(CFL3D(K), cloud_frac_thresh) - else - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 - end if -#endif - - END IF - -! TO CALCULATE DROPLET FREEZING - - CDIST1(K) = NC3D(K)/GAMMA(PGAM(K)+1.) - - END IF - -!...................................................................... -! SNOW - - IF (QNI3D(K).GE.QSMALL) THEN - LAMS(K) = (CONS1*NS3D(K)/QNI3D(K))**(1./DS) - N0S(K) = NS3D(K)*LAMS(K) - -! CHECK FOR SLOPE - -! ADJUST VARS - - IF (LAMS(K).LT.LAMMINS) THEN - LAMS(K) = LAMMINS - N0S(K) = LAMS(K)**(DS+1.)*QNI3D(K)/CONS1 - - NS3D(K) = N0S(K)/LAMS(K) - - ELSE IF (LAMS(K).GT.LAMMAXS) THEN - - LAMS(K) = LAMMAXS - N0S(K) = LAMS(K)**(DS+1.)*QNI3D(K)/CONS1 - - NS3D(K) = N0S(K)/LAMS(K) - END IF - END IF - -!...................................................................... -! GRAUPEL - - IF (QG3D(K).GE.QSMALL) THEN - LAMG(K) = (CONS2*NG3D(K)/QG3D(K))**(1./DG) - N0G(K) = NG3D(K)*LAMG(K) - -! CHECK FOR SLOPE - -! ADJUST VARS - - IF (LAMG(K).LT.LAMMING) THEN - LAMG(K) = LAMMING - N0G(K) = LAMG(K)**(DG+1.)*QG3D(K)/CONS2 - - NG3D(K) = N0G(K)/LAMG(K) - - ELSE IF (LAMG(K).GT.LAMMAXG) THEN - - LAMG(K) = LAMMAXG - N0G(K) = LAMG(K)**(DG+1.)*QG3D(K)/CONS2 - - NG3D(K) = N0G(K)/LAMG(K) - END IF - END IF - -!..................................................................... -! ZERO OUT PROCESS RATES - - MNUCCC(K) = 0. - NNUCCC(K) = 0. - PRC(K) = 0. - NPRC(K) = 0. - NPRC1(K) = 0. - NSAGG(K) = 0. - PSACWS(K) = 0. - NPSACWS(K) = 0. - PSACWI(K) = 0. - NPSACWI(K) = 0. - PRACS(K) = 0. - NPRACS(K) = 0. - NMULTS(K) = 0. - QMULTS(K) = 0. - NMULTR(K) = 0. - QMULTR(K) = 0. - NMULTG(K) = 0. - QMULTG(K) = 0. - NMULTRG(K) = 0. - QMULTRG(K) = 0. - MNUCCR(K) = 0. - NNUCCR(K) = 0. - PRA(K) = 0. - NPRA(K) = 0. - NRAGG(K) = 0. - PRCI(K) = 0. - NPRCI(K) = 0. - PRAI(K) = 0. - NPRAI(K) = 0. - NNUCCD(K) = 0. - MNUCCD(K) = 0. - PCC(K) = 0. - PRE(K) = 0. - PRD(K) = 0. - PRDS(K) = 0. - EPRD(K) = 0. - EPRDS(K) = 0. - NSUBC(K) = 0. - NSUBI(K) = 0. - NSUBS(K) = 0. - NSUBR(K) = 0. - PIACR(K) = 0. - NIACR(K) = 0. - PRACI(K) = 0. - PIACRS(K) = 0. - NIACRS(K) = 0. - PRACIS(K) = 0. -! HM: ADD GRAUPEL PROCESSES - PRACG(K) = 0. - PSACR(K) = 0. - PSACWG(K) = 0. - PGSACW(K) = 0. - PGRACS(K) = 0. - PRDG(K) = 0. - EPRDG(K) = 0. - NPRACG(K) = 0. - NPSACWG(K) = 0. - NSCNG(K) = 0. - NGRACS(K) = 0. - NSUBG(K) = 0. - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! CALCULATION OF MICROPHYSICAL PROCESS RATES -! ACCRETION/AUTOCONVERSION/FREEZING/MELTING/COAG. -!....................................................................... -! FREEZING OF CLOUD DROPLETS -! ONLY ALLOWED BELOW -4 C - IF (QC3D(K).GE.QSMALL .AND. T3D(K).LT.269.15) THEN - -! NUMBER OF CONTACT NUCLEI (M^-3) FROM MEYERS ET AL., 1992 -! FACTOR OF 1000 IS TO CONVERT FROM L^-1 TO M^-3 - -! MEYERS CURVE - - NACNT = EXP(-2.80+0.262*(TMELT-T3D(K)))*1000. - -! COOPER CURVE -! NACNT = 5.*EXP(0.304*(TMELT-T3D(K))) - -! FLECTHER -! NACNT = 0.01*EXP(0.6*(TMELT-T3D(K))) - -! CONTACT FREEZING - -! MEAN FREE PATH - - DUM = 7.37*T3D(K)/(288.*10.*PRES(K))/100. - -! EFFECTIVE DIFFUSIVITY OF CONTACT NUCLEI -! BASED ON BROWNIAN DIFFUSION - - DAP(K) = CONS37*T3D(K)*(1.+DUM/RIN)/MU(K) - - MNUCCC(K) = CONS38*DAP(K)*NACNT*EXP(LOG(CDIST1(K))+ & - LOG(GAMMA(PGAM(K)+5.))-4.*LOG(LAMC(K))) - NNUCCC(K) = 2.*PI*DAP(K)*NACNT*CDIST1(K)* & - GAMMA(PGAM(K)+2.)/ & - LAMC(K) - -! IMMERSION FREEZING (BIGG 1953) - - MNUCCC(K) = MNUCCC(K)+CONS39* & - EXP(LOG(CDIST1(K))+LOG(GAMMA(7.+PGAM(K)))-6.*LOG(LAMC(K)))* & - EXP(AIMM*(TMELT-T3D(K))) - - NNUCCC(K) = NNUCCC(K)+ & - CONS40*EXP(LOG(CDIST1(K))+LOG(GAMMA(PGAM(K)+4.))-3.*LOG(LAMC(K))) & - *EXP(AIMM*(TMELT-T3D(K))) - -! PUT IN A CATCH HERE TO PREVENT DIVERGENCE BETWEEN NUMBER CONC. AND -! MIXING RATIO, SINCE STRICT CONSERVATION NOT CHECKED FOR NUMBER CONC - - NNUCCC(K) = MIN(NNUCCC(K),NC3D(K)/DT) - - END IF - -#ifdef CLUBB_CRM -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! For the case of clex9_oct14, we need to decrease the ice ! -! nucleation in order for the cloud to persist for realistic ! -! lengths. It is suggested to reduce by a factor of 100 ! -! This coefficient can be changed in the subroutine ! -! init_microphys of the microphys_driver subroutine ! -! ! - NNUCCC(K)=NNUCCC(K)*NNUCCC_REDUCE_COEF -! ! -! Change made by Marc Pilon on 11/16/11 ! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -#endif /* CLUBB_CRM */ - - - - -!................................................................. -!....................................................................... -! AUTOCONVERSION OF CLOUD LIQUID WATER TO RAIN -! FORMULA FROM BEHENG (1994) -! USING NUMERICAL SIMULATION OF STOCHASTIC COLLECTION EQUATION -! AND INITIAL CLOUD DROPLET SIZE DISTRIBUTION SPECIFIED -! AS A GAMMA DISTRIBUTION - -! USE MINIMUM VALUE OF 1.E-6 TO PREVENT FLOATING POINT ERROR - - IF (QC3D(K).GE.1.E-6) THEN - -! HM ADD 12/13/06, REPLACE WITH NEWER FORMULA -! FROM KHAIROUTDINOV AND KOGAN 2000, MWR - - IF (IRAIN.EQ.0) THEN - PRC(K)=1350.*QC3D(K)**2.47* & - (NC3D(K)/1.e6*RHO(K))**(-1.79) - -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - PRC(K)=PRC(K) * gamma(RELVAR(K)+2.47)/(gamma(RELVAR(K))*RELVAR(K)**2.47) - PRC(K)=PRC(K) * CFL3D(K)**0.32 ! CFL3D**(1.79-2.47+1) - end if -#endif - -! note: nprc1 is change in Nr, -! nprc is change in Nc - - NPRC1(K) = PRC(K)/CONS29 - NPRC(K) = PRC(K)/(QC3D(K)/NC3D(K)) - - NPRC(K) = MIN(NPRC(K),NC3D(K)/DT) - - ELSE IF (IRAIN.EQ.1) THEN - -! v1.4 -! replace with seifert and beheng - - dum = 1.-qc3d(k)/(qc3d(k)+qr3d(k)) - dum1 = 600.*dum**0.68*(1.-dum**0.68)**3 - - prc(k) = 9.44e9/(20.*2.6e-7)* & - (nu(k)+2.)*(nu(k)+4.)/(nu(k)+1.)**2* & - (rho(k)*qc3d(k)/1000.)**4/(rho(k)*nc3d(k)/1.e6)**2* & - (1.+dum1/(1.-dum)**2)*1000./rho(k) - - nprc(k) = prc(k)*2./2.6e-7*1000. - nprc1(k) = 0.5*nprc(k) - - END IF - END IF - -!....................................................................... -! SELF-COLLECTION OF DROPLET NOT INCLUDED IN KK2000 SCHEME - -! SNOW AGGREGATION FROM PASSARELLI, 1978, USED BY REISNER, 1998 -! THIS IS HARD-WIRED FOR BS = 0.4 FOR NOW - - IF (QNI3D(K).GE.1.E-8) THEN - NSAGG(K) = CONS15*ASN(K)*RHO(K)** & - ((2.+BS)/3.)*QNI3D(K)**((2.+BS)/3.)* & - (NS3D(K)*RHO(K))**((4.-BS)/3.)/ & - (RHO(K)) - END IF - -!....................................................................... -! ACCRETION OF CLOUD DROPLETS ONTO SNOW/GRAUPEL -! HERE USE CONTINUOUS COLLECTION EQUATION WITH -! SIMPLE GRAVITATIONAL COLLECTION KERNEL IGNORING - -! SNOW - - IF (QNI3D(K).GE.1.E-8 .AND. QC3D(K).GE.QSMALL) THEN - - PSACWS(K) = CONS13*ASN(K)*QC3D(K)*RHO(K)* & - N0S(K)/ & - LAMS(K)**(BS+3.) - NPSACWS(K) = CONS13*ASN(K)*NC3D(K)*RHO(K)* & - N0S(K)/ & - LAMS(K)**(BS+3.) - - END IF - -!............................................................................ -! COLLECTION OF CLOUD WATER BY GRAUPEL - - IF (QG3D(K).GE.1.E-8 .AND. QC3D(K).GE.QSMALL) THEN - - PSACWG(K) = CONS14*AGN(K)*QC3D(K)*RHO(K)* & - N0G(K)/ & - LAMG(K)**(BG+3.) - NPSACWG(K) = CONS14*AGN(K)*NC3D(K)*RHO(K)* & - N0G(K)/ & - LAMG(K)**(BG+3.) - END IF - -!....................................................................... -! HM, ADD 12/13/06 -! CLOUD ICE COLLECTING DROPLETS, ASSUME THAT CLOUD ICE MEAN DIAM > 100 MICRON -! BEFORE RIMING CAN OCCUR -! ASSUME THAT RIME COLLECTED ON CLOUD ICE DOES NOT LEAD -! TO HALLET-MOSSOP SPLINTERING - - IF (QI3D(K).GE.1.E-8 .AND. QC3D(K).GE.QSMALL) THEN - -! PUT IN SIZE DEPENDENT COLLECTION EFFICIENCY BASED ON STOKES LAW -! FROM THOMPSON ET AL. 2004, MWR - - IF (1./LAMI(K).GE.100.E-6) THEN - - PSACWI(K) = CONS16*AIN(K)*QC3D(K)*RHO(K)* & - N0I(K)/ & - LAMI(K)**(BI+3.) - NPSACWI(K) = CONS16*AIN(K)*NC3D(K)*RHO(K)* & - N0I(K)/ & - LAMI(K)**(BI+3.) - END IF - END IF - -!....................................................................... -! ACCRETION OF RAIN WATER BY SNOW -! FORMULA FROM IKAWA AND SAITO, 1991, USED BY REISNER ET AL, 1998 - - IF (QR3D(K).GE.1.E-8.AND.QNI3D(K).GE.1.E-8) THEN - - UMS = ASN(K)*CONS3/(LAMS(K)**BS) - UMR = ARN(K)*CONS4/(LAMR(K)**BR) - UNS = ASN(K)*CONS5/LAMS(K)**BS - UNR = ARN(K)*CONS6/LAMR(K)**BR - -! SET REASLISTIC LIMITS ON FALLSPEEDS -! bug fix, 10/08/09 - dum=(rhosu/rho(k))**0.54 - UMS=MIN(UMS,1.2*dum) - UNS=MIN(UNS,1.2*dum) - UMR=MIN(UMR,9.1*dum) - UNR=MIN(UNR,9.1*dum) - - PRACS(K) = CONS41*(((1.2*UMR-0.95*UMS)**2+ & - 0.08*UMS*UMR)**0.5*RHO(K)* & - N0RR(K)*N0S(K)/LAMR(K)**3* & - (5./(LAMR(K)**3*LAMS(K))+ & - 2./(LAMR(K)**2*LAMS(K)**2)+ & - 0.5/(LAMR(k)*LAMS(k)**3))) - - NPRACS(K) = CONS32*RHO(K)*(1.7*(UNR-UNS)**2+ & - 0.3*UNR*UNS)**0.5*N0RR(K)*N0S(K)* & - (1./(LAMR(K)**3*LAMS(K))+ & - 1./(LAMR(K)**2*LAMS(K)**2)+ & - 1./(LAMR(K)*LAMS(K)**3)) - -! MAKE SURE PRACS DOESN'T EXCEED TOTAL RAIN MIXING RATIO -! AS THIS MAY OTHERWISE RESULT IN TOO MUCH TRANSFER OF WATER DURING -! RIME-SPLINTERING - - PRACS(K) = MIN(PRACS(K),QR3D(K)/DT) - -! COLLECTION OF SNOW BY RAIN - NEEDED FOR GRAUPEL CONVERSION CALCULATIONS -! ONLY CALCULATE IF SNOW AND RAIN MIXING RATIOS EXCEED 0.1 G/KG - -! V1.3 -! ASSUME COLLECTION OF SNOW BY RAIN PRODUCES GRAUPEL NOT HAIL - -! V1.5 -! IF (IHAIL.EQ.0) THEN - IF (QNI3D(K).GE.0.1E-3.AND.QR3D(K).GE.0.1E-3) THEN - PSACR(K) = CONS31*(((1.2*UMR-0.95*UMS)**2+ & - 0.08*UMS*UMR)**0.5*RHO(K)* & - N0RR(K)*N0S(K)/LAMS(K)**3* & - (5./(LAMS(K)**3*LAMR(K))+ & - 2./(LAMS(K)**2*LAMR(K)**2)+ & - 0.5/(LAMS(K)*LAMR(K)**3))) - END IF -! END IF - - END IF - -!....................................................................... - -! COLLECTION OF RAINWATER BY GRAUPEL, FROM IKAWA AND SAITO 1990, -! USED BY REISNER ET AL 1998 - IF (QR3D(K).GE.1.E-8.AND.QG3D(K).GE.1.E-8) THEN - - UMG = AGN(K)*CONS7/(LAMG(K)**BG) - UMR = ARN(K)*CONS4/(LAMR(K)**BR) - UNG = AGN(K)*CONS8/LAMG(K)**BG - UNR = ARN(K)*CONS6/LAMR(K)**BR - -! SET REASLISTIC LIMITS ON FALLSPEEDS -! bug fix, 10/08/09 - dum=(rhosu/rho(k))**0.54 - UMG=MIN(UMG,20.*dum) - UNG=MIN(UNG,20.*dum) - UMR=MIN(UMR,9.1*dum) - UNR=MIN(UNR,9.1*dum) - - PRACG(K) = CONS41*(((1.2*UMR-0.95*UMG)**2+ & - 0.08*UMG*UMR)**0.5*RHO(K)* & - N0RR(K)*N0G(K)/LAMR(K)**3* & - (5./(LAMR(K)**3*LAMG(K))+ & - 2./(LAMR(K)**2*LAMG(K)**2)+ & - 0.5/(LAMR(k)*LAMG(k)**3))) - - NPRACG(K) = CONS32*RHO(K)*(1.7*(UNR-UNG)**2+ & - 0.3*UNR*UNG)**0.5*N0RR(K)*N0G(K)* & - (1./(LAMR(K)**3*LAMG(K))+ & - 1./(LAMR(K)**2*LAMG(K)**2)+ & - 1./(LAMR(K)*LAMG(K)**3)) - -! MAKE SURE PRACG DOESN'T EXCEED TOTAL RAIN MIXING RATIO -! AS THIS MAY OTHERWISE RESULT IN TOO MUCH TRANSFER OF WATER DURING -! RIME-SPLINTERING - - PRACG(K) = MIN(PRACG(K),QR3D(K)/DT) - - END IF - -!....................................................................... -! RIME-SPLINTERING - SNOW -! HALLET-MOSSOP (1974) -! NUMBER OF SPLINTERS FORMED IS BASED ON MASS OF RIMED WATER - -! DUM1 = MASS OF INDIVIDUAL SPLINTERS - -! HM ADD THRESHOLD SNOW AND DROPLET MIXING RATIO FOR RIME-SPLINTERING -! TO LIMIT RIME-SPLINTERING IN STRATIFORM CLOUDS -! THESE THRESHOLDS CORRESPOND WITH GRAUPEL THRESHOLDS IN RH 1984 - -!v1.4 - IF (QNI3D(K).GE.0.1E-3) THEN - IF (QC3D(K).GE.0.5E-3.OR.QR3D(K).GE.0.1E-3) THEN - IF (PSACWS(K).GT.0..OR.PRACS(K).GT.0.) THEN - IF (T3D(K).LT.270.16 .AND. T3D(K).GT.265.16) THEN - - IF (T3D(K).GT.270.16) THEN - FMULT = 0. - ELSE IF (T3D(K).LE.270.16.AND.T3D(K).GT.268.16) THEN - FMULT = (270.16-T3D(K))/2. - ELSE IF (T3D(K).GE.265.16.AND.T3D(K).LE.268.16) THEN - FMULT = (T3D(K)-265.16)/3. - ELSE IF (T3D(K).LT.265.16) THEN - FMULT = 0. - END IF - -! 1000 IS TO CONVERT FROM KG TO G - -! SPLINTERING FROM DROPLETS ACCRETED ONTO SNOW - - IF (PSACWS(K).GT.0.) THEN - NMULTS(K) = 35.E4*PSACWS(K)*FMULT*1000. - QMULTS(K) = NMULTS(K)*MMULT - -! CONSTRAIN SO THAT TRANSFER OF MASS FROM SNOW TO ICE CANNOT BE MORE MASS -! THAN WAS RIMED ONTO SNOW - - QMULTS(K) = MIN(QMULTS(K),PSACWS(K)) - PSACWS(K) = PSACWS(K)-QMULTS(K) - - END IF - -! RIMING AND SPLINTERING FROM ACCRETED RAINDROPS - - IF (PRACS(K).GT.0.) THEN - NMULTR(K) = 35.E4*PRACS(K)*FMULT*1000. - QMULTR(K) = NMULTR(K)*MMULT - -! CONSTRAIN SO THAT TRANSFER OF MASS FROM SNOW TO ICE CANNOT BE MORE MASS -! THAN WAS RIMED ONTO SNOW - - QMULTR(K) = MIN(QMULTR(K),PRACS(K)) - - PRACS(K) = PRACS(K)-QMULTR(K) - - END IF - - END IF - END IF - END IF - END IF - -!....................................................................... -! RIME-SPLINTERING - GRAUPEL -! HALLET-MOSSOP (1974) -! NUMBER OF SPLINTERS FORMED IS BASED ON MASS OF RIMED WATER - -! DUM1 = MASS OF INDIVIDUAL SPLINTERS - -! HM ADD THRESHOLD SNOW MIXING RATIO FOR RIME-SPLINTERING -! TO LIMIT RIME-SPLINTERING IN STRATIFORM CLOUDS - -! V1.3 -! ONLY CALCULATE FOR GRAUPEL NOT HAIL -! V1.5 -! IF (IHAIL.EQ.0) THEN -! v1.4 - IF (QG3D(K).GE.0.1E-3) THEN - IF (QC3D(K).GE.0.5E-3.OR.QR3D(K).GE.0.1E-3) THEN - IF (PSACWG(K).GT.0..OR.PRACG(K).GT.0.) THEN - IF (T3D(K).LT.270.16 .AND. T3D(K).GT.265.16) THEN - - IF (T3D(K).GT.270.16) THEN - FMULT = 0. - ELSE IF (T3D(K).LE.270.16.AND.T3D(K).GT.268.16) THEN - FMULT = (270.16-T3D(K))/2. - ELSE IF (T3D(K).GE.265.16.AND.T3D(K).LE.268.16) THEN - FMULT = (T3D(K)-265.16)/3. - ELSE IF (T3D(K).LT.265.16) THEN - FMULT = 0. - END IF - -! 1000 IS TO CONVERT FROM KG TO G - -! SPLINTERING FROM DROPLETS ACCRETED ONTO GRAUPEL - - IF (PSACWG(K).GT.0.) THEN - NMULTG(K) = 35.E4*PSACWG(K)*FMULT*1000. - QMULTG(K) = NMULTG(K)*MMULT - -! CONSTRAIN SO THAT TRANSFER OF MASS FROM GRAUPEL TO ICE CANNOT BE MORE MASS -! THAN WAS RIMED ONTO GRAUPEL - - QMULTG(K) = MIN(QMULTG(K),PSACWG(K)) - PSACWG(K) = PSACWG(K)-QMULTG(K) - - END IF - -! RIMING AND SPLINTERING FROM ACCRETED RAINDROPS - - IF (PRACG(K).GT.0.) THEN - NMULTRG(K) = 35.E4*PRACG(K)*FMULT*1000. - QMULTRG(K) = NMULTRG(K)*MMULT - -! CONSTRAIN SO THAT TRANSFER OF MASS FROM GRAUPEL TO ICE CANNOT BE MORE MASS -! THAN WAS RIMED ONTO GRAUPEL - - QMULTRG(K) = MIN(QMULTRG(K),PRACG(K)) - PRACG(K) = PRACG(K)-QMULTRG(K) - - END IF - - END IF - END IF - END IF - END IF -! END IF - -!........................................................................ -! CONVERSION OF RIMED CLOUD WATER ONTO SNOW TO GRAUPEL -! ASSUME CONVERTED SNOW FORMS GRAUPEL NOT HAIL -! HAIL ASSUMED TO ONLY FORM BY FREEZING OF RAIN -! OR COLLISIONS OF RAIN WITH CLOUD ICE - -! V1.3 -! V1.5 -! IF (IHAIL.EQ.0) THEN - IF (PSACWS(K).GT.0.) THEN -! ONLY ALLOW CONVERSION IF QNI > 0.1 AND QC > 0.5 G/KG FOLLOWING RUTLEDGE AND HOBBS (1984) - IF (QNI3D(K).GE.0.1E-3.AND.QC3D(K).GE.0.5E-3) THEN - -! PORTION OF RIMING CONVERTED TO GRAUPEL (REISNER ET AL. 1998, ORIGINALLY IS1991) - PGSACW(K) = MIN(PSACWS(K),CONS17*DT*N0S(K)*QC3D(K)*QC3D(K)* & - ASN(K)*ASN(K)/ & - (RHO(K)*LAMS(K)**(2.*BS+2.))) - -! MIX RAT CONVERTED INTO GRAUPEL AS EMBRYO (REISNER ET AL. 1998, ORIG M1990) - DUM = MAX(RHOSN/(RHOG-RHOSN)*PGSACW(K),0.) - -! NUMBER CONCENTRAITON OF EMBRYO GRAUPEL FROM RIMING OF SNOW - NSCNG(K) = DUM/MG0*RHO(K) -! LIMIT MAX NUMBER CONVERTED TO SNOW NUMBER - NSCNG(K) = MIN(NSCNG(K),NS3D(K)/DT) - -! PORTION OF RIMING LEFT FOR SNOW - PSACWS(K) = PSACWS(K) - PGSACW(K) - END IF - END IF - -! CONVERSION OF RIMED RAINWATER ONTO SNOW CONVERTED TO GRAUPEL - - IF (PRACS(K).GT.0.) THEN -! ONLY ALLOW CONVERSION IF QNI > 0.1 AND QR > 0.1 G/KG FOLLOWING RUTLEDGE AND HOBBS (1984) - IF (QNI3D(K).GE.0.1E-3.AND.QR3D(K).GE.0.1E-3) THEN -! PORTION OF COLLECTED RAINWATER CONVERTED TO GRAUPEL (REISNER ET AL. 1998) - DUM = CONS18*(4./LAMS(K))**3*(4./LAMS(K))**3 & - /(CONS18*(4./LAMS(K))**3*(4./LAMS(K))**3+ & - CONS19*(4./LAMR(K))**3*(4./LAMR(K))**3) - DUM=MIN(DUM,1.) - DUM=MAX(DUM,0.) - PGRACS(K) = (1.-DUM)*PRACS(K) - NGRACS(K) = (1.-DUM)*NPRACS(K) -! LIMIT MAX NUMBER CONVERTED TO MIN OF EITHER RAIN OR SNOW NUMBER CONCENTRATION - NGRACS(K) = MIN(NGRACS(K),NR3D(K)/DT) - NGRACS(K) = MIN(NGRACS(K),NS3D(K)/DT) - -! AMOUNT LEFT FOR SNOW PRODUCTION - PRACS(K) = PRACS(K) - PGRACS(K) - NPRACS(K) = NPRACS(K) - NGRACS(K) -! CONVERSION TO GRAUPEL DUE TO COLLECTION OF SNOW BY RAIN - PSACR(K)=PSACR(K)*(1.-DUM) - END IF - END IF -! END IF - -!....................................................................... -! FREEZING OF RAIN DROPS -! FREEZING ALLOWED BELOW -4 C - - IF (T3D(K).LT.269.15.AND.QR3D(K).GE.QSMALL) THEN - -! IMMERSION FREEZING (BIGG 1953) - MNUCCR(K) = CONS20*NR3D(K)*EXP(AIMM*(TMELT-T3D(K)))/LAMR(K)**3 & - /LAMR(K)**3 - - NNUCCR(K) = PI*NR3D(K)*BIMM*EXP(AIMM*(TMELT-T3D(K)))/LAMR(K)**3 - -! PREVENT DIVERGENCE BETWEEN MIXING RATIO AND NUMBER CONC - NNUCCR(K) = MIN(NNUCCR(K),NR3D(K)/DT) - - END IF - -!....................................................................... -! ACCRETION OF CLOUD LIQUID WATER BY RAIN -! CONTINUOUS COLLECTION EQUATION WITH -! GRAVITATIONAL COLLECTION KERNEL, DROPLET FALL SPEED NEGLECTED - - IF (QR3D(K).GE.1.E-8 .AND. QC3D(K).GE.1.E-8) THEN - -! 12/13/06 HM ADD, REPLACE WITH NEWER FORMULA FROM -! KHAIROUTDINOV AND KOGAN 2000, MWR - - IF (IRAIN.EQ.0) THEN - - DUM=(QC3D(K)*QR3D(K)) - PRA(K) = 67.*(DUM)**1.15 -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - PRA(K)=PRA(K) * accre_enhan(K)*gamma(RELVAR(K)+1.15)/(gamma(RELVAR(K))*RELVAR(K)**1.15) - PRA(K) = PRA(K) /(max(CLDMAXR(K), cloud_frac_thresh))**1.15 ! PRA = (QC3D/CFL3D * QR3D/CLDMAXR * CFL3D)**1.15 - end if -#endif - NPRA(K) = PRA(K)/(QC3D(K)/NC3D(K)) - - ELSE IF (IRAIN.EQ.1) THEN - -! v1.4 -! seifert and beheng (2001) formulation - - dum = 1.-qc3d(k)/(qc3d(k)+qr3d(k)) - dum1 = (dum/(dum+5.e-4))**4 - pra(k) = 5.78e3*rho(k)/1000.*qc3d(k)*qr3d(k)*dum1 - npra(k) = pra(k)*rho(k)/1000.*(nc3d(k)*rho(k)/1.e6)/ & - (qc3d(k)*rho(k)/1000.)*1.e6/rho(k) - - END IF - END IF -!....................................................................... -! SELF-COLLECTION OF RAIN DROPS -! FROM BEHENG(1994) -! FROM NUMERICAL SIMULATION OF THE STOCHASTIC COLLECTION EQUATION -! AS DESCRINED ABOVE FOR AUTOCONVERSION - -! v1.4 replace with seifert and beheng (2001) - - IF (QR3D(K).GE.1.E-8) THEN -! include breakup add 10/09/09 - dum1=300.e-6 - if (1./lamr(k).lt.dum1) then - dum=1. - else if (1./lamr(k).ge.dum1) then - dum=2.-exp(2300.*(1./lamr(k)-dum1)) - end if -! NRAGG(K) = -8.*NR3D(K)*QR3D(K)*RHO(K) - NRAGG(K) = -5.78*dum*NR3D(K)*QR3D(K)*RHO(K) - END IF - -!....................................................................... -! AUTOCONVERSION OF CLOUD ICE TO SNOW -! FOLLOWING HARRINGTON ET AL. (1995) WITH MODIFICATION -! HERE IT IS ASSUMED THAT AUTOCONVERSION CAN ONLY OCCUR WHEN THE -! ICE IS GROWING, I.E. IN CONDITIONS OF ICE SUPERSATURATION -#ifndef CLUBB_CRM - IF (QI3D(K).GE.1.E-8 .AND.QVQVSI(K).GE.1.) THEN - -! COFFI = 2./LAMI(K) -! IF (COFFI.GE.DCS) THEN - NPRCI(K) = CONS21*(QV3D(K)-QVI(K))*RHO(K) & - *N0I(K)*EXP(-LAMI(K)*DCS)*DV(K)/ABI(K) - PRCI(K) = CONS22*NPRCI(K) - NPRCI(K) = MIN(NPRCI(K),NI3D(K)/DT) - -! END IF - END IF -#else - IF(.not.doclubb_gridmean) THEN - IF (QI3D(K).GE.1.E-8 .AND.QVQVSI(K).GE.1.) THEN - -! COFFI = 2./LAMI(K) -! IF (COFFI.GE.DCS) THEN - NPRCI(K) = CONS21*(QV3D(K)-QVI(K))*RHO(K) & - *N0I(K)*EXP(-LAMI(K)*DCS)*DV(K)/ABI(K) - PRCI(K) = CONS22*NPRCI(K) - NPRCI(K) = MIN(NPRCI(K),NI3D(K)/DT) - -! END IF - END IF - ELSE ! doclubb_gridmean - IF (QI3D(K).GE.1.E-8) THEN -! inside liquid clouds, using QVS - NPRCI(k) = CONS21*(QVS(K)-QVI(K))*RHO(K) & - *N0I(K)*EXP(-LAMI(K)*DCS)*DV(K)/ABI(K) * CFL3D(K) -! outside liquid clouds, using ambient QV3D - IF(QVQVSI(K).GE.1.) THEN - NPRCI(k) = NPRCI(k) + CONS21*(QV3D(K)-QVI(K))*RHO(K) & - *N0I(K)*EXP(-LAMI(K)*DCS)*DV(K)/ABI(K) * (CFI3D(K)-CFL3D(K)) - ENDIF - NPRCI(K) = NPRCI(K)/max(CFI3D(K), cloud_frac_thresh) - PRCI(K) = CONS22*NPRCI(K) - NPRCI(K) = MIN(NPRCI(K),NI3D(K)/DT) - END IF - END IF -#endif - -!....................................................................... -! ACCRETION OF CLOUD ICE BY SNOW -! FOR THIS CALCULATION, IT IS ASSUMED THAT THE VS >> VI -! AND DS >> DI FOR CONTINUOUS COLLECTION - - IF (QNI3D(K).GE.1.E-8 .AND. QI3D(K).GE.QSMALL) THEN - PRAI(K) = CONS23*ASN(K)*QI3D(K)*RHO(K)*N0S(K)/ & - LAMS(K)**(BS+3.) - NPRAI(K) = CONS23*ASN(K)*NI3D(K)* & - RHO(K)*N0S(K)/ & - LAMS(K)**(BS+3.) - NPRAI(K)=MIN(NPRAI(K),NI3D(K)/DT) - END IF - -!....................................................................... -! HM, ADD 12/13/06, COLLISION OF RAIN AND ICE TO PRODUCE SNOW OR GRAUPEL -! FOLLOWS REISNER ET AL. 1998 -! ASSUMED FALLSPEED AND SIZE OF ICE CRYSTAL << THAN FOR RAIN - - IF (QR3D(K).GE.1.E-8.AND.QI3D(K).GE.1.E-8.AND.T3D(K).LE.TMELT) THEN - -! ALLOW GRAUPEL FORMATION FROM RAIN-ICE COLLISIONS ONLY IF RAIN MIXING RATIO > 0.1 G/KG, -! OTHERWISE ADD TO SNOW - - IF (QR3D(K).GE.0.1E-3) THEN - NIACR(K)=CONS24*NI3D(K)*N0RR(K)*ARN(K) & - /LAMR(K)**(BR+3.)*RHO(K) - PIACR(K)=CONS25*NI3D(K)*N0RR(K)*ARN(K) & - /LAMR(K)**(BR+3.)/LAMR(K)**3*RHO(K) - PRACI(K)=CONS24*QI3D(K)*N0RR(K)*ARN(K)/ & - LAMR(K)**(BR+3.)*RHO(K) - NIACR(K)=MIN(NIACR(K),NR3D(K)/DT) - NIACR(K)=MIN(NIACR(K),NI3D(K)/DT) - ELSE - NIACRS(K)=CONS24*NI3D(K)*N0RR(K)*ARN(K) & - /LAMR(K)**(BR+3.)*RHO(K) - PIACRS(K)=CONS25*NI3D(K)*N0RR(K)*ARN(K) & - /LAMR(K)**(BR+3.)/LAMR(K)**3*RHO(K) - PRACIS(K)=CONS24*QI3D(K)*N0RR(K)*ARN(K)/ & - LAMR(K)**(BR+3.)*RHO(K) - NIACRS(K)=MIN(NIACRS(K),NR3D(K)/DT) - NIACRS(K)=MIN(NIACRS(K),NI3D(K)/DT) - END IF - END IF - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! NUCLEATION OF CLOUD ICE FROM HOMOGENEOUS AND HETEROGENEOUS FREEZING ON AEROSOL - - IF (INUC.EQ.0) THEN - -! FREEZING OF AEROSOL ONLY ALLOWED BELOW -5 C -! AND ABOVE DELIQUESCENCE THRESHOLD OF 80% -! AND ABOVE ICE SATURATION - -! add threshold according to Greg Thomspon - - if ((QVQVS(K).GE.0.999.and.T3D(K).le.265.15).or. & - QVQVSI(K).ge.1.08) then - -! hm, modify dec. 5, 2006, replace with cooper curve - kc2 = 0.005*exp(0.304*(TMELT-T3D(K)))*1000. ! convert from L-1 to m-3 -! limit to 500 L-1 - kc2 = min(kc2,500.e3) - kc2=MAX(kc2/rho(k),0.) ! convert to kg-1 - - IF (KC2.GT.NI3D(K)+NS3D(K)+NG3D(K)) THEN - NNUCCD(K) = (KC2-NI3D(K)-NS3D(K)-NG3D(K))/DT - MNUCCD(K) = NNUCCD(K)*MI0 - END IF - - END IF - - ELSE IF (INUC.EQ.1) THEN - - IF (T3D(K).LT.TMELT.AND.QVQVSI(K).GT.1.) THEN - - KC2 = 0.16*1000./RHO(K) ! CONVERT FROM L-1 TO KG-1 - IF (KC2.GT.NI3D(K)+NS3D(K)+NG3D(K)) THEN - NNUCCD(K) = (KC2-NI3D(K)-NS3D(K)-NG3D(K))/DT - MNUCCD(K) = NNUCCD(K)*MI0 - END IF - END IF - - END IF - -#ifdef CLUBB_CRM -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! For the case of clex9_oct14, we need to decrease the ice ! -! nucleation in order for the cloud to persist for realistic ! -! lengths. It is suggested to reduce by a factor of 100 ! -! This coefficent can be changed in subroutine init_microphys ! -! in the microphys_driver subroutine. ! -! ! - NNUCCD(K)=NNUCCD(K)*NNUCCD_REDUCE_COEF -! -! Change made by Marc Pilon on 11/16/11 ! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -#endif /* CLUBB_CRM */ - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - 101 CONTINUE - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! CALCULATE EVAP/SUB/DEP TERMS FOR QI,QNI,QR - -! NO VENTILATION FOR CLOUD ICE - - IF (QI3D(K).GE.QSMALL) THEN - - EPSI = 2.*PI*N0I(K)*RHO(K)*DV(K)/(LAMI(K)*LAMI(K)) - - ELSE - EPSI = 0. - END IF - - IF (QNI3D(K).GE.QSMALL) THEN - EPSS = 2.*PI*N0S(K)*RHO(K)*DV(K)* & - (F1S/(LAMS(K)*LAMS(K))+ & - F2S*(ASN(K)*RHO(K)/MU(K))**0.5* & - SC(K)**(1./3.)*CONS10/ & - (LAMS(K)**CONS35)) - ELSE - EPSS = 0. - END IF - - IF (QG3D(K).GE.QSMALL) THEN - EPSG = 2.*PI*N0G(K)*RHO(K)*DV(K)* & - (F1S/(LAMG(K)*LAMG(K))+ & - F2S*(AGN(K)*RHO(K)/MU(K))**0.5* & - SC(K)**(1./3.)*CONS11/ & - (LAMG(K)**CONS36)) - - - ELSE - EPSG = 0. - END IF - - IF (QR3D(K).GE.QSMALL) THEN - EPSR = 2.*PI*N0RR(K)*RHO(K)*DV(K)* & - (F1R/(LAMR(K)*LAMR(K))+ & - F2R*(ARN(K)*RHO(K)/MU(K))**0.5* & - SC(K)**(1./3.)*CONS9/ & - (LAMR(K)**CONS34)) - ELSE - EPSR = 0. - END IF - -! ONLY INCLUDE REGION OF ICE SIZE DIST < DCS -! DUM IS FRACTION OF D*N(D) < DCS - -! LOGIC BELOW FOLLOWS THAT OF HARRINGTON ET AL. 1995 (JAS) - IF (QI3D(K).GE.QSMALL) THEN - DUM=(1.-EXP(-LAMI(K)*DCS)*(1.+LAMI(K)*DCS)) - PRD(K) = EPSI*(QV3D(K)-QVI(K))/ABI(K)*DUM -#ifdef CLUBB_CRM - if(doclubb_gridmean) then -! For ice clouds outside liquid clouds, using ambient QV - PRD(K) = PRD(K) * (CFI3D(K)-CFL3D(K)) -! For ice clouds inside liquid clouds, using saturation vapor pressure over liquid - PRD(K) = PRD(K) + EPSI*(QVS(K)-QVI(K))/ABI(K)*DUM * CFL3D(K) - PRD(K) = PRD(K) / max(CFI3D(K), cloud_frac_thresh) - end if -#endif - ELSE - DUM=0. - END IF -! ADD DEPOSITION IN TAIL OF ICE SIZE DIST TO SNOW IF SNOW IS PRESENT - IF (QNI3D(K).GE.QSMALL) THEN - PRDS(K) = EPSS*(QV3D(K)-QVI(K))/ABI(K)+ & - EPSI*(QV3D(K)-QVI(K))/ABI(K)*(1.-DUM) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - PRDS(K) = (EPSS*(QV3D(K)-QVI(K))/ABI(K)*(CLDMAXALL(K)-CFL3D(K))+ & - EPSS*(QVS(K)-QVI(K))/ABI(K) * CFL3D(K))/max(CLDMAXALL(K), cloud_frac_thresh) & - + (EPSI*(QV3D(K)-QVI(K))/ABI(K)*(1.-DUM)*(CFI3D(K)-CFL3D(K))+ & - EPSI*(QVS(K)-QVI(K))/ABI(K)*(1.-DUM)*CFL3D(K))/max(CFI3D(K), cloud_frac_thresh) - end if -#endif -! OTHERWISE ADD TO CLOUD ICE - ELSE -#ifndef CLUBB_CRM - PRD(K) = PRD(K)+EPSI*(QV3D(K)-QVI(K))/ABI(K)*(1.-DUM) -#else - if(.not.doclubb_gridmean) then - PRD(K) = PRD(K)+EPSI*(QV3D(K)-QVI(K))/ABI(K)*(1.-DUM) - else - PRD(K) = PRD(K)+(EPSI*(QV3D(K)-QVI(K))/ABI(K)*(1.-DUM) * (CFI3D(K) - CFL3D(K)) & - + EPSI*(QVS(K)-QVI(K))/ABI(K)*(1.-DUM) * CFL3D(K))/max(CFI3D(K), cloud_frac_thresh) - end if -#endif - END IF - -! VAPOR DPEOSITION ON GRAUPEL - PRDG(K) = EPSG*(QV3D(K)-QVI(K))/ABI(K) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then -! For graupel outside liquid clouds, using ambient QV - PRDG(K) = PRDG(K)*(CLDMAXALL(K)-CFL3D(K)) -! For graueple insdie liquid clouds, using QVS - PRDG(K) = PRDG(K) + EPSG*(QVS(K)-QVI(K))/ABI(K) * CFL3D(K) - PRDG(K) = PRDG(K) / max(CLDMAXALL(K), cloud_frac_thresh) - end if -#endif - -! NO CONDENSATION ONTO RAIN, ONLY EVAP - - IF (QV3D(K).LT.QVS(K)) THEN - PRE(K) = EPSR*(QV3D(K)-QVS(K))/AB(K) - PRE(K) = MIN(PRE(K),0.) - ELSE - PRE(K) = 0. - END IF - -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - PRE(K) = PRE(K) * max(CLDMAXR(K)-CFL3D(K), 0.0)/max(CLDMAXR(K), cloud_frac_thresh) - if(CFL3D(K).gt.0.10) then ! when there is enough liquid present, - ! no evaporation of rain is allowed - PRE(K) = 0.0 - end if - - end if -#endif - -! MAKE SURE NOT PUSHED INTO ICE SUPERSAT/SUBSAT -! FORMULA FROM REISNER 2 SCHEME - - DUM = (QV3D(K)-QVI(K))/DT - - FUDGEF = 0.9999 - SUM_DEP = PRD(K)+PRDS(K)+MNUCCD(K)+PRDG(K) - - IF( (DUM.GT.0. .AND. SUM_DEP.GT.DUM*FUDGEF) .OR. & - (DUM.LT.0. .AND. SUM_DEP.LT.DUM*FUDGEF) ) THEN - MNUCCD(K) = FUDGEF*MNUCCD(K)*DUM/SUM_DEP - PRD(K) = FUDGEF*PRD(K)*DUM/SUM_DEP - PRDS(K) = FUDGEF*PRDS(K)*DUM/SUM_DEP - PRDG(K) = FUDGEF*PRDG(K)*DUM/SUM_DEP - ENDIF - -! IF CLOUD ICE/SNOW/GRAUPEL VAP DEPOSITION IS NEG, THEN ASSIGN TO SUBLIMATION PROCESSES - - IF (PRD(K).LT.0.) THEN - EPRD(K)=PRD(K) - PRD(K)=0. - END IF - IF (PRDS(K).LT.0.) THEN - EPRDS(K)=PRDS(K) - PRDS(K)=0. - END IF - IF (PRDG(K).LT.0.) THEN - EPRDG(K)=PRDG(K) - PRDG(K)=0. - END IF - -!....................................................................... -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - -! CONSERVATION OF WATER -! THIS IS ADOPTED LOOSELY FROM MM5 RESINER CODE. HOWEVER, HERE WE -! ONLY ADJUST PROCESSES THAT ARE NEGATIVE, RATHER THAN ALL PROCESSES. -! THIS SECTION IS SEPARATED INTO TWO PARTS, IF T < 0 C, T > 0 C -! DUE TO DIFFERENT PROCESSES THAT ACT DEPENDING ON FREEZING/ABOVE FREEZING - -! IF MIXING RATIOS LESS THAN QSMALL, THEN NO DEPLETION OF WATER -! THROUGH MICROPHYSICAL PROCESSES, SKIP CONSERVATION - -! NOTE: CONSERVATION CHECK NOT APPLIED TO NUMBER CONCENTRATION SPECIES. ADDITIONAL CATCH -! BELOW WILL PREVENT NEGATIVE NUMBER CONCENTRATION -! FOR EACH MICROPHYSICAL PROCESS WHICH PROVIDES A SOURCE FOR NUMBER, THERE IS A CHECK -! TO MAKE SURE THAT CAN'T EXCEED TOTAL NUMBER OF DEPLETED SPECIES WITH THE TIME -! STEP - -!****SENSITIVITY - NO ICE - - IF (ILIQ.EQ.1) THEN - MNUCCC(K)=0. - NNUCCC(K)=0. - MNUCCR(K)=0. - NNUCCR(K)=0. - MNUCCD(K)=0. - NNUCCD(K)=0. - END IF - -! ****SENSITIVITY - NO GRAUPEL - IF (IGRAUP.EQ.1) THEN - PRACG(K) = 0. - PSACR(K) = 0. - PSACWG(K) = 0. - PGSACW(K) = 0. - PGRACS(K) = 0. - PRDG(K) = 0. - EPRDG(K) = 0. - EVPMG(K) = 0. - PGMLT(K) = 0. - NPRACG(K) = 0. - NPSACWG(K) = 0. - NSCNG(K) = 0. - NGRACS(K) = 0. - NSUBG(K) = 0. - NGMLTG(K) = 0. - NGMLTR(K) = 0. -! fix 053011 - PIACRS(K)=PIACRS(K)+PIACR(K) - PIACR(K) = 0. - END IF - -! CONSERVATION OF QC - - DUM = (PRC(K)+PRA(K)+MNUCCC(K)+PSACWS(K)+PSACWI(K)+QMULTS(K)+PSACWG(K)+PGSACW(K)+QMULTG(K))*DT - - IF (DUM.GT.QC3D(K).AND.QC3D(K).GE.QSMALL) THEN - RATIO = QC3D(K)/DUM - - PRC(K) = PRC(K)*RATIO - PRA(K) = PRA(K)*RATIO - MNUCCC(K) = MNUCCC(K)*RATIO - PSACWS(K) = PSACWS(K)*RATIO - PSACWI(K) = PSACWI(K)*RATIO - QMULTS(K) = QMULTS(K)*RATIO - QMULTG(K) = QMULTG(K)*RATIO - PSACWG(K) = PSACWG(K)*RATIO - PGSACW(K) = PGSACW(K)*RATIO - END IF - -! CONSERVATION OF QI - - DUM = (-PRD(K)-MNUCCC(K)+PRCI(K)+PRAI(K)-QMULTS(K)-QMULTG(K)-QMULTR(K)-QMULTRG(K) & - -MNUCCD(K)+PRACI(K)+PRACIS(K)-EPRD(K)-PSACWI(K))*DT - - IF (DUM.GT.QI3D(K).AND.QI3D(K).GE.QSMALL) THEN - - RATIO = (QI3D(K)/DT+PRD(K)+MNUCCC(K)+QMULTS(K)+QMULTG(K)+QMULTR(K)+QMULTRG(K)+ & - MNUCCD(K)+PSACWI(K))/ & - (PRCI(K)+PRAI(K)+PRACI(K)+PRACIS(K)-EPRD(K)) - - PRCI(K) = PRCI(K)*RATIO - PRAI(K) = PRAI(K)*RATIO - PRACI(K) = PRACI(K)*RATIO - PRACIS(K) = PRACIS(K)*RATIO - EPRD(K) = EPRD(K)*RATIO - - END IF - -! CONSERVATION OF QR - - DUM=((PRACS(K)-PRE(K))+(QMULTR(K)+QMULTRG(K)-PRC(K))+(MNUCCR(K)-PRA(K))+ & - PIACR(K)+PIACRS(K)+PGRACS(K)+PRACG(K))*DT - - IF (DUM.GT.QR3D(K).AND.QR3D(K).GE.QSMALL) THEN - - RATIO = (QR3D(K)/DT+PRC(K)+PRA(K))/ & - (-PRE(K)+QMULTR(K)+QMULTRG(K)+PRACS(K)+MNUCCR(K)+PIACR(K)+PIACRS(K)+PGRACS(K)+PRACG(K)) - - PRE(K) = PRE(K)*RATIO - PRACS(K) = PRACS(K)*RATIO - QMULTR(K) = QMULTR(K)*RATIO - QMULTRG(K) = QMULTRG(K)*RATIO - MNUCCR(K) = MNUCCR(K)*RATIO - PIACR(K) = PIACR(K)*RATIO - PIACRS(K) = PIACRS(K)*RATIO - PGRACS(K) = PGRACS(K)*RATIO - PRACG(K) = PRACG(K)*RATIO - - END IF - -! CONSERVATION OF QNI -! CONSERVATION FOR GRAUPEL SCHEME - - IF (IGRAUP.EQ.0) THEN - - DUM = (-PRDS(K)-PSACWS(K)-PRAI(K)-PRCI(K)-PRACS(K)-EPRDS(K)+PSACR(K)-PIACRS(K)-PRACIS(K))*DT - - IF (DUM.GT.QNI3D(K).AND.QNI3D(K).GE.QSMALL) THEN - - RATIO = (QNI3D(K)/DT+PRDS(K)+PSACWS(K)+PRAI(K)+PRCI(K)+PRACS(K)+PIACRS(K)+PRACIS(K))/(-EPRDS(K)+PSACR(K)) - - EPRDS(K) = EPRDS(K)*RATIO - PSACR(K) = PSACR(K)*RATIO - - END IF - -! FOR NO GRAUPEL, NEED TO INCLUDE FREEZING OF RAIN FOR SNOW - ELSE IF (IGRAUP.EQ.1) THEN - - DUM = (-PRDS(K)-PSACWS(K)-PRAI(K)-PRCI(K)-PRACS(K)-EPRDS(K)+PSACR(K)-PIACRS(K)-PRACIS(K)-MNUCCR(K))*DT - - IF (DUM.GT.QNI3D(K).AND.QNI3D(K).GE.QSMALL) THEN - - RATIO = (QNI3D(K)/DT+PRDS(K)+PSACWS(K)+PRAI(K)+PRCI(K)+PRACS(K)+PIACRS(K)+PRACIS(K)+MNUCCR(K))/(-EPRDS(K)+PSACR(K)) - - EPRDS(K) = EPRDS(K)*RATIO - PSACR(K) = PSACR(K)*RATIO - - END IF - - END IF - -! CONSERVATION OF QG - - DUM = (-PSACWG(K)-PRACG(K)-PGSACW(K)-PGRACS(K)-PRDG(K)-MNUCCR(K)-EPRDG(K)-PIACR(K)-PRACI(K)-PSACR(K))*DT - - IF (DUM.GT.QG3D(K).AND.QG3D(K).GE.QSMALL) THEN - - RATIO = (QG3D(K)/DT+PSACWG(K)+PRACG(K)+PGSACW(K)+PGRACS(K)+PRDG(K)+MNUCCR(K)+PSACR(K)+& - PIACR(K)+PRACI(K))/(-EPRDG(K)) - - EPRDG(K) = EPRDG(K)*RATIO - - END IF - -! TENDENCIES - - QV3DTEN(K) = QV3DTEN(K)+(-PRE(K)-PRD(K)-PRDS(K)-MNUCCD(K)-EPRD(K)-EPRDS(K)-PRDG(K)-EPRDG(K)) - -! BUG FIX HM, 3/1/11, INCLUDE PIACR AND PIACRS - T3DTEN(K) = T3DTEN(K)+(PRE(K) & - *XXLV(K)+(PRD(K)+PRDS(K)+ & - MNUCCD(K)+EPRD(K)+EPRDS(K)+PRDG(K)+EPRDG(K))*XXLS(K)+ & - (PSACWS(K)+PSACWI(K)+MNUCCC(K)+MNUCCR(K)+ & - QMULTS(K)+QMULTG(K)+QMULTR(K)+QMULTRG(K)+PRACS(K) & - +PSACWG(K)+PRACG(K)+PGSACW(K)+PGRACS(K)+PIACR(K)+PIACRS(K))*XLF(K))/CPM(K) - - QC3DTEN(K) = QC3DTEN(K)+ & - (-PRA(K)-PRC(K)-MNUCCC(K)+PCC(K)- & - PSACWS(K)-PSACWI(K)-QMULTS(K)-QMULTG(K)-PSACWG(K)-PGSACW(K)) - QI3DTEN(K) = QI3DTEN(K)+ & - (PRD(K)+EPRD(K)+PSACWI(K)+MNUCCC(K)-PRCI(K)- & - PRAI(K)+QMULTS(K)+QMULTG(K)+QMULTR(K)+QMULTRG(K)+MNUCCD(K)-PRACI(K)-PRACIS(K)) - QR3DTEN(K) = QR3DTEN(K)+ & - (PRE(K)+PRA(K)+PRC(K)-PRACS(K)-MNUCCR(K)-QMULTR(K)-QMULTRG(K) & - -PIACR(K)-PIACRS(K)-PRACG(K)-PGRACS(K)) - - IF (IGRAUP.EQ.0) THEN - - QNI3DTEN(K) = QNI3DTEN(K)+ & - (PRAI(K)+PSACWS(K)+PRDS(K)+PRACS(K)+PRCI(K)+EPRDS(K)-PSACR(K)+PIACRS(K)+PRACIS(K)) - NS3DTEN(K) = NS3DTEN(K)+(NSAGG(K)+NPRCI(K)-NSCNG(K)-NGRACS(K)+NIACRS(K)) - QG3DTEN(K) = QG3DTEN(K)+(PRACG(K)+PSACWG(K)+PGSACW(K)+PGRACS(K)+ & - PRDG(K)+EPRDG(K)+MNUCCR(K)+PIACR(K)+PRACI(K)+PSACR(K)) - NG3DTEN(K) = NG3DTEN(K)+(NSCNG(K)+NGRACS(K)+NNUCCR(K)+NIACR(K)) - -! FOR NO GRAUPEL, NEED TO INCLUDE FREEZING OF RAIN FOR SNOW - ELSE IF (IGRAUP.EQ.1) THEN - - QNI3DTEN(K) = QNI3DTEN(K)+ & - (PRAI(K)+PSACWS(K)+PRDS(K)+PRACS(K)+PRCI(K)+EPRDS(K)-PSACR(K)+PIACRS(K)+PRACIS(K)+MNUCCR(K)) - NS3DTEN(K) = NS3DTEN(K)+(NSAGG(K)+NPRCI(K)-NSCNG(K)-NGRACS(K)+NIACRS(K)+NNUCCR(K)) - - END IF - - NC3DTEN(K) = NC3DTEN(K)+(-NNUCCC(K)-NPSACWS(K) & - -NPRA(K)-NPRC(K)-NPSACWI(K)-NPSACWG(K)) - - NI3DTEN(K) = NI3DTEN(K)+ & - (NNUCCC(K)-NPRCI(K)-NPRAI(K)+NMULTS(K)+NMULTG(K)+NMULTR(K)+NMULTRG(K)+ & - NNUCCD(K)-NIACR(K)-NIACRS(K)) - - NR3DTEN(K) = NR3DTEN(K)+(NPRC1(K)-NPRACS(K)-NNUCCR(K) & - +NRAGG(K)-NIACR(K)-NIACRS(K)-NPRACG(K)-NGRACS(K)) - -! V1.3 move code below to before saturation adjustment - IF (EPRD(K).LT.0.) THEN - DUM = EPRD(K)*DT/QI3D(K) - DUM = MAX(-1.,DUM) - NSUBI(K) = DUM*NI3D(K)/DT - END IF - IF (EPRDS(K).LT.0.) THEN - DUM = EPRDS(K)*DT/QNI3D(K) - DUM = MAX(-1.,DUM) - NSUBS(K) = DUM*NS3D(K)/DT - END IF - IF (PRE(K).LT.0.) THEN - DUM = PRE(K)*DT/QR3D(K) - DUM = MAX(-1.,DUM) - NSUBR(K) = DUM*NR3D(K)/DT - END IF - IF (EPRDG(K).LT.0.) THEN - DUM = EPRDG(K)*DT/QG3D(K) - DUM = MAX(-1.,DUM) - NSUBG(K) = DUM*NG3D(K)/DT - END IF - -! nsubr(k)=0. -! nsubs(k)=0. -! nsubg(k)=0. - - NI3DTEN(K) = NI3DTEN(K)+NSUBI(K) - NS3DTEN(K) = NS3DTEN(K)+NSUBS(K) - NG3DTEN(K) = NG3DTEN(K)+NSUBG(K) - NR3DTEN(K) = NR3DTEN(K)+NSUBR(K) -#ifdef ECPP -! HM ADD, WRF-CHEM, ADD TENDENCIES FOR C2PREC - C2PREC(K) = PRA(K)+PRC(K)+PSACWS(K)+QMULTS(K)+QMULTG(K)+PSACWG(K)+ & - PGSACW(K)+MNUCCC(K)+PSACWI(K) - if(QC3D(K).gt.1.0e-10) then - QSINK(K) = min(1.0, C2PREC(K)/QC3D(K)) - else - QSINK(K) = 0.0 - end if -#endif /*ECPP*/ - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - IF(ISATADJ.EQ.0) THEN !PB 4/13/09 - -! NOW CALCULATE SATURATION ADJUSTMENT TO CONDENSE EXTRA VAPOR ABOVE -! WATER SATURATION - - DUMT = T3D(K)+DT*T3DTEN(K) - DUMQV = QV3D(K)+DT*QV3DTEN(K) -! hm, add fix for low pressure, 5/12/10 - dum=min(0.99*pres(k),POLYSVP(DUMT,0)) - DUMQSS = EP_2*dum/(PRES(K)-dum) - DUMQC = QC3D(K)+DT*QC3DTEN(K) - DUMQC = MAX(DUMQC,0.) - -! SATURATION ADJUSTMENT FOR LIQUID - - DUMS = DUMQV-DUMQSS - PCC(K) = DUMS/(1.+XXLV(K)**2*DUMQSS/(CPM(K)*RV*DUMT**2))/DT -! IF (PCC(K)*DT+DUMQC.LT.0.) THEN -! PCC(K) = -DUMQC/DT -! END IF -!+++mhwang - IF (PCC(K)*DT+QC3D(K)+DT*QC3DTEN(K).LT.0.) THEN - PCC(K) = -(QC3D(K)+DT*QC3DTEN(K))/DT - END IF -!---mhwang - - QV3DTEN(K) = QV3DTEN(K)-PCC(K) - T3DTEN(K) = T3DTEN(K)+PCC(K)*XXLV(K)/CPM(K) - QC3DTEN(K) = QC3DTEN(K)+PCC(K) - - END IF - -! hm 7/26/11, new output - - aut1d(k)=prc(k) - acc1d(k)=pra(k) - evpr1d(k)=-PRE(K) - if (pcc(k).lt.0.) then - evpc1d(k)=-pcc(k) - else if (pcc(k).gt.0.) then - con1d(k)=pcc(k) - end if - sub1d(k)=-EPRD(K)-EPRDS(K)-EPRDG(K) - dep1d(k)=PRD(K)+PRDS(K)+MNUCCD(K)+PRDG(K) -!....................................................................... -! ACTIVATION OF CLOUD DROPLETS - -!bloss: only do activation if droplet number is predicted -!bloss IF (QC3D(K)+QC3DTEN(K)*DT.GE.QSMALL) THEN - IF (QC3D(K)+QC3DTEN(K)*DT.GE.QSMALL.AND.INUM.EQ.0) THEN - -! EFFECTIVE VERTICAL VELOCITY (M/S) - - IF (ISUB.EQ.0) THEN -! ADD SUB-GRID VERTICAL VELOCITY - DUM = W3D(K)+WVAR(K) - -! ASSUME MINIMUM EFF. SUB-GRID VELOCITY 0.10 M/S -#ifdef CLUBB_CRM - DUM = MAX(DUM,0.01) -#else - DUM = MAX(DUM,0.10) -#endif - - ELSE IF (ISUB.EQ.1) THEN - DUM=W3D(K) - END IF - -! ONLY ACTIVATE IN REGIONS OF UPWARD MOTION - IF (DUM.GE.0.001) THEN - - IF (IBASE.EQ.1) THEN - -! ACTIVATE ONLY IF THERE IS LITTLE CLOUD WATER -! OR IF AT CLOUD BASE, OR AT LOWEST MODEL LEVEL (K=1) - - IDROP=0 - -! V1.3 USE CURRENT VALUE OF QC FOR IDROP - IF (QC3D(K).LE.0.05E-3/RHO(K)) THEN - IDROP=1 - END IF - IF (K.EQ.1) THEN - IDROP=1 - ELSE IF (K.GE.2) THEN - IF (QC3D(K).GT.0.05E-3/RHO(K).AND. & - QC3D(K-1).LE.0.05E-3/RHO(K-1)) THEN - IDROP=1 - END IF - END IF - - IF (IDROP.EQ.1) THEN -! ACTIVATE AT CLOUD BASE OR REGIONS WITH VERY LITTLE LIQ WATER - - IF (IACT.EQ.1) THEN -! USE ROGERS AND YAU (1989) TO RELATE NUMBER ACTIVATED TO W -! BASED ON TWOMEY 1959 - - DUM=DUM*100. ! CONVERT FROM M/S TO CM/S - DUM2 = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.)) - DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3 - DUM2=DUM2/RHO(K) ! CONVERT FROM M-3 TO KG-1 -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0.,DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 - - ELSE IF (IACT.EQ.2) THEN -! DROPLET ACTIVATION FROM ABDUL-RAZZAK AND GHAN (2000) - - SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) - AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) - ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K)) - GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K)) - - GG = 1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+ XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ & - (T3D(K)*RR)-1.)) - - PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT - - ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1) - ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2) - - SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 - SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 - - DUM1 = 1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75) - DUM2 = 1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75) - - SMAX = 1./(DUM1+DUM2)**0.5 - - UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) - UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) - DUM1 = NANEW1/2.*(1.-DERF1(UU1)) - DUM2 = NANEW2/2.*(1.-DERF1(UU2)) - - DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 - -! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL - - DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0.,DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 -#if (defined CRM && defined MODAL_AERO) - ELSE if (IACT.EQ.3) then - INES = 0 - CALL DROP_ACTIVATION_GHAN(DUM, T3D(k), RHO(k), & - DUM2, INES, SMAX, K) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0., DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 -#endif - END IF ! IACT - -!............................................................................. - ELSE IF (IDROP.EQ.0) THEN -! ACTIVATE IN CLOUD INTERIOR -! FIND EQUILIBRIUM SUPERSATURATION - - TAUC=1./(2.*PI*RHO(k)*DV(K)*NC3D(K)*(PGAM(K)+1.)/LAMC(K)) - IF (EPSR.GT.1.E-8) THEN - TAUR=1./EPSR - ELSE - TAUR=1.E8 - END IF - IF (EPSI.GT.1.E-8) THEN - TAUI=1./EPSI - ELSE - TAUI=1.E8 - END IF - IF (EPSS.GT.1.E-8) THEN - TAUS=1./EPSS - ELSE - TAUS=1.E8 - END IF - IF (EPSG.GT.1.E-8) THEN - TAUG=1./EPSG - ELSE - TAUG=1.E8 - END IF - -! EQUILIBRIUM SS INCLUDING BERGERON EFFECT - - DUM3=(QVS(K)*RHO(K)/(PRES(K)-EVS(K))+DQSDT/CP)*G*DUM - DUM3=(DUM3*TAUC*TAUR*TAUI*TAUS*TAUG- & - (QVS(K)-QVI(K))*(TAUC*TAUR*TAUI*TAUG+TAUC*TAUR*TAUS*TAUG+TAUC*TAUR*TAUI*TAUS))/ & - (TAUC*TAUR*TAUI*TAUG+TAUC*TAUR*TAUS*TAUG+TAUC*TAUR*TAUI*TAUS+ & - TAUR*TAUI*TAUS*TAUG+TAUC*TAUI*TAUS*TAUG) - - IF (DUM3/QVS(K).GE.1.E-6) THEN - IF (IACT.EQ.1) THEN - -! FIND MAXIMUM ALLOWED ACTIVATION WITH NON-EQULIBRIUM SS - - DUM=DUM*100. ! CONVERT FROM M/S TO CM/S - DUMACT = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.)) - -! USE POWER LAW CCN SPECTRA - -! CONVERT FROM ABSOLUTE SUPERSATURATION TO SUPERSATURATION RATIO IN % - DUM3=DUM3/QVS(K)*100. - - DUM2=C1*DUM3**K1 -! MAKE SURE VALUE DOESN'T EXCEED THAT FOR NON-EQUILIBRIUM SS - DUM2=MIN(DUM2,DUMACT) - DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3 - DUM2=DUM2/RHO(K) ! CONVERT FROM M-3 TO KG-1 -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0.,DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 - - ELSE IF (IACT.EQ.2) THEN - -! FIND MAXIMUM ALLOWED ACTIVATION WITH NON-EQULIBRIUM SS - - SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) - AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) - ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K)) - GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K)) - - GG = 1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+ XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ & - (T3D(K)*RR)-1.)) - - PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT - - ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1) - ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2) - - SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 - SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 - - DUM1 = 1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75) - DUM2 = 1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75) - - SMAX = 1./(DUM1+DUM2)**0.5 - - UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) - UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) - DUM1 = NANEW1/2.*(1.-DERF1(UU1)) - DUM2 = NANEW2/2.*(1.-DERF1(UU2)) - - DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 - -! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL - - DUMACT = MIN((NANEW1+NANEW2)/RHO(K),DUM2) - -! USE LOGNORMAL AEROSOL - SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) - AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) - - SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 - SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 - -! GET SUPERSATURATION RATIO FROM ABSOLUTE SUPERSATURATION - SMAX = DUM3/QVS(K) - - UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) - UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) - DUM1 = NANEW1/2.*(1.-DERF1(UU1)) - DUM2 = NANEW2/2.*(1.-DERF1(UU2)) - - DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 - -! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL - - DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2) - -! MAKE SURE ISN'T GREATER THAN NON-EQUIL. SS - DUM2=MIN(DUM2,DUMACT) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0.,DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 -#if (defined CRM && defined MODAL_AERO) - ELSE if (IACT.EQ.3) then -! GET SUPERSATURATION RATIO FROM ABSOLUTE SUPERSATURATION - SMAX = DUM3/QVS(K) - - INES = 1 - CALL DROP_ACTIVATION_GHAN(DUM, T3D(k), RHO(k), & - DUM2, INES, SMAX, K) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0., DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 -#endif - - END IF ! IACT - END IF ! DUM3/QVS > 1.E-6 - END IF ! IDROP = 1 - -!....................................................................... - ELSE IF (IBASE.EQ.2) THEN - - IF (IACT.EQ.1) THEN -! USE ROGERS AND YAU (1989) TO RELATE NUMBER ACTIVATED TO W -! BASED ON TWOMEY 1959 - - DUM=DUM*100. ! CONVERT FROM M/S TO CM/S - DUM2 = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.)) - DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3 - DUM2=DUM2/RHO(K) ! CONVERT FROM M-3 TO KG-1 -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0.,DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 - - ELSE IF (IACT.EQ.2) THEN - - SIGVL = 0.0761-1.55E-4*(T3D(K)-TMELT) - AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K) - ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K)) - GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K)) - - GG = 1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+ XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ & - (T3D(K)*RR)-1.)) - - PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT - - ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1) - ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2) - - SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5 - SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5 - - DUM1 = 1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75) - DUM2 = 1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75) - - SMAX = 1./(DUM1+DUM2)**0.5 - - UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1)) - UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2)) - DUM1 = NANEW1/2.*(1.-DERF1(UU1)) - DUM2 = NANEW2/2.*(1.-DERF1(UU2)) - - DUM2 = (DUM1+DUM2)/RHO(K) !CONVERT TO KG-1 - -! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL - - DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0.,DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 -#if (defined CRM && defined MODAL_AERO) - ELSE if (IACT.EQ.3) then - INES = 0 - CALL DROP_ACTIVATION_GHAN(DUM, T3D(k), RHO(k), & - DUM2, INES, SMAX, K) -#ifdef CLUBB_CRM - if(doclubb_gridmean) then - DUM2 = DUM2 * CFL3D(K) - end if -#endif - DUM2 = (DUM2-NC3D(K))/DT - DUM2 = MAX(0., DUM2) - NC3DTEN(K) = NC3DTEN(K)+DUM2 -#endif - END IF ! IACT - END IF ! IBASE - END IF ! W > 0.001 - END IF ! QC3D > QSMALL - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! SUBLIMATE, MELT, OR EVAPORATE NUMBER CONCENTRATION -! THIS FORMULATION ASSUMES 1:1 RATIO BETWEEN MASS LOSS AND -! LOSS OF NUMBER CONCENTRATION - -! IF (PCC(K).LT.0.) THEN -! DUM = PCC(K)*DT/QC3D(K) -! DUM = MAX(-1.,DUM) -! NSUBC(K) = DUM*NC3D(K)/DT -! END IF - - -! nsubr(k)=0. -! nsubs(k)=0. -! nsubg(k)=0. - - END IF !!!!!! TEMPERATURE - -! SWITCH LTRUE TO 1, SINCE HYDROMETEORS ARE PRESENT - LTRUE = 1 - - 200 CONTINUE -#ifdef CLUBB_CRM -! ADDITION BY UWM TO WEIGHT BY SGS CLOUD FRACTION - IF ( CF3D(K) > cloud_frac_thresh ) THEN - - T3D(K) = T3D_INIT + ( T3D(K) - T3D_INIT ) * CF3D(K) ! Absolute temp. - T3DTEN(K) = T3DTEN(K) * CF3D(K) ! Absolute temperature tendency - - QV3D(K) = QV_INIT + ( QV3D(K) - QSAT_INIT ) * CF3D(K) ! Vapor - QV3DTEN(K) = QV3DTEN(K) * CF3D(K) ! Vapor mix ratio time tendency - - QC3D(K) = QC3D(K) * CF3D(K) ! Cloud mix ratio - QC3DTEN(K) = QC3DTEN(K) * CF3D(K) ! Cloud mix ratio time tendency - - IF ( INUM == 0 ) THEN - NC3D(K) = NC3D(K) * CF3D(K) ! Cloud drop num conc - NC3DTEN(K) = NC3DTEN(K) * CF3D(K) ! Cloud drop num conc time tendency - END IF - - QR3D(K) = QR3D(K) * CF3D(K) ! Rain mix ratio - QR3DTEN(K) = QR3DTEN(K) * CF3D(K) ! Rain mix ratio time tendency - - NR3D(K) = NR3D(K) * CF3D(K) ! Rain num conc - NR3DTEN(K) = NR3DTEN(K) * CF3D(K) ! Rain num conc time tendency - - IF ( ILIQ == 0 ) THEN - QI3D(K) = QI3D(K) * CF3D(K) ! Ice mix ratio - QI3DTEN(K) = QI3DTEN(K) * CF3D(K) ! Ice mix ratio time tendency - - NI3D(K) = NI3D(K) * CF3D(K) ! Ice num conc - NI3DTEN(K) = NI3DTEN(K) * CF3D(K) ! Ice num conc time tendency - - QNI3D(K) = QNI3D(K) * CF3D(K) ! Snow mix ratio - QNI3DTEN(K) = QNI3DTEN(K) * CF3D(K) ! Snow mix ratio time tendency - - NS3D(K) = NS3D(K) * CF3D(K) ! Snow num conc - NS3DTEN(K) = NS3DTEN(K) * CF3D(K) ! Snow num conc time tendency - END IF - IF ( IGRAUP == 0 ) THEN - QG3D(K) = QG3D(K) * CF3D(K) ! Graupel mix ratio - QG3DTEN(K) = QG3DTEN(K) * CF3D(K) ! Graupel mix ratio time tendency - - NG3D(K) = NG3D(K) * CF3D(K) ! Graupel num conc - NG3DTEN(K) = NG3DTEN(K) * CF3D(K) ! Graupel num conc time tendency - END IF -! +++mhwang -! add individual microphysical process rates - PRC(K) = PRC(K) * CF3D(K) - PRA(K) = PRA(K) * CF3D(K) - PSMLT(K) = PSMLT(K) * CF3D(K) - EVPMS(K) = EVPMS(K) * CF3D(K) - PRACS(K) = PRACS(K) * CF3D(K) - EVPMG(K) = EVPMG(K) * CF3D(K) - PRACG(K) = PRACG(K) * CF3D(K) - PRE(K) = PRE(K) * CF3D(K) - PGMLT(K) = PGMLT(K) * CF3D(K) - - MNUCCC(K) = MNUCCC(K) * CF3D(K) - PSACWS(K) = PSACWS(K) * CF3D(K) - PSACWI(K) = PSACWI(k) * CF3D(K) - QMULTS(K) = QMULTS(K) * CF3D(K) - QMULTG(K) = QMULTG(K) * CF3D(K) - PSACWG(K) = PSACWG(K) * CF3D(K) - PGSACW(K) = PGSACW(K) * CF3D(K) - - PRD(K) = PRD(K) * CF3D(K) - PRCI(K) = PRCI(K) * CF3D(K) - PRAI(K) = PRAI(K) * CF3D(K) - QMULTR(K) = QMULTR(K) * CF3D(K) - QMULTRG(K) = QMULTRG(K) * CF3D(K) - MNUCCD(K) = MNUCCD(K) * CF3D(K) - PRACI(K) = PRACI(K) * CF3D(K) - PRACIS(K) = PRACIS(K) * CF3D(K) - EPRD(K) = EPRD(K) * CF3D(K) - - MNUCCR(K) = MNUCCR(K) * CF3D(K) - PIACR(K) = PIACR(K) * CF3D(K) - PIACRS(K) = PIACRS(K) * CF3D(K) - PGRACS(K) = PGRACS(K) * CF3D(K) - - PRDS(K) = PRDS(K) * CF3D(K) - EPRDS(K) = EPRDS(K) * CF3D(K) - PSACR(K) = PSACR(K) * CF3D(K) - - PRDG(K) = PRDG(K) * CF3D(K) - EPRDG(K) = EPRDG(K) * CF3D(K) - -! Rain drop number process rates - NPRC1(K) = NPRC1(K)* CF3D(K) - NRAGG(K) = NRAGG(K) * CF3D(K) - NPRACG(K) = NPRACG(K) * CF3D(K) - NSUBR(K) = NSUBR(K) * CF3D(K) - NSMLTR(K) = NSMLTR(K) * CF3D(K) - NGMLTR(K) = NGMLTR(K) * CF3D(K) - NPRACS(K) = NPRACS(K) * CF3D(K) - NNUCCR(K) = NNUCCR(K) * CF3D(K) - NIACR(K) = NIACR(K) * CF3D(K) - NIACRS(K) = NIACRS(K) * CF3D(K) - NGRACS(K) = NGRACS(K) * CF3D(K) - -! hm 7/26/11, new output - aut1d(k)=prc(k) - acc1d(k)=pra(k) - mlt1d(k)=-PSMLT(K)-PGMLT(K)+PRACS(K)+PRACG(K) - evpr1d(k)=-PRE(K)-EVPMS(K)-EVPMG(K) - if (pcc(k).lt.0.) then - evpc1d(k)=-pcc(k) - else if (pcc(k).gt.0.) then - con1d(k)=pcc(k) - end if - sub1d(k)=-EPRD(K)-EPRDS(K)-EPRDG(K) - dep1d(k)=PRD(K)+PRDS(K)+MNUCCD(K)+PRDG(K) - - END IF ! CF3D(K) > 0.01 -#endif /*CLUBB_CRM*/ - - END DO - -! V1.3 move precip initialization to here -! INITIALIZE PRECIP AND SNOW RATES - - PRECRT = 0. - SNOWRT = 0. - -! IF THERE ARE NO HYDROMETEORS, THEN SKIP TO END OF SUBROUTINE - - IF (LTRUE.EQ.0) GOTO 400 - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -!....................................................................... -! CALCULATE SEDIMENATION -! THE NUMERICS HERE FOLLOW FROM REISNER ET AL. (1998) -! FALLOUT TERMS ARE CALCULATED ON SPLIT TIME STEPS TO ENSURE NUMERICAL -! STABILITY, I.E. COURANT# < 1 - -!....................................................................... - - NSTEP = 1 - -! v3 5/27/11 - DO K = KTE,KTS,-1 - - DUMI(K) = QI3D(K)+QI3DTEN(K)*DT - DUMQS(K) = QNI3D(K)+QNI3DTEN(K)*DT - DUMR(K) = QR3D(K)+QR3DTEN(K)*DT - DUMFNI(K) = NI3D(K)+NI3DTEN(K)*DT - DUMFNS(K) = NS3D(K)+NS3DTEN(K)*DT - DUMFNR(K) = NR3D(K)+NR3DTEN(K)*DT - DUMC(K) = QC3D(K)+QC3DTEN(K)*DT - DUMFNC(K) = NC3D(K)+NC3DTEN(K)*DT - DUMG(K) = QG3D(K)+QG3DTEN(K)*DT - DUMFNG(K) = NG3D(K)+NG3DTEN(K)*DT - -! SWITCH FOR CONSTANT DROPLET NUMBER - IF (INUM.EQ.1) THEN - DUMFNC(K) = NC3D(K) - END IF - -! GET DUMMY LAMDA FOR SEDIMENTATION CALCULATIONS - -! MAKE SURE NUMBER CONCENTRATIONS ARE POSITIVE - DUMFNI(K) = MAX(0.,DUMFNI(K)) - DUMFNS(K) = MAX(0.,DUMFNS(K)) - DUMFNC(K) = MAX(0.,DUMFNC(K)) - DUMFNR(K) = MAX(0.,DUMFNR(K)) - DUMFNG(K) = MAX(0.,DUMFNG(K)) - -!...................................................................... -! CLOUD ICE - - IF (DUMI(K).GE.QSMALL) THEN - DLAMI = (CONS12*DUMFNI(K)/DUMI(K))**(1./DI) - DLAMI=MAX(DLAMI,LAMMINI) - DLAMI=MIN(DLAMI,LAMMAXI) - END IF -!...................................................................... -! RAIN - - IF (DUMR(K).GE.QSMALL) THEN - DLAMR = (PI*RHOW*DUMFNR(K)/DUMR(K))**(1./3.) - DLAMR=MAX(DLAMR,LAMMINR) - DLAMR=MIN(DLAMR,LAMMAXR) - END IF -!...................................................................... -! CLOUD DROPLETS - - IF (DUMC(K).GE.QSMALL) THEN - !bloss: option for fixing pgam - if(dofix_pgam) then - pgam(k) = pgam_fixed - else - -! DUM = PRES(K)/(R*T3D(K)) -! V1.5 - PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K))+0.2714 - PGAM(K)=1./(PGAM(K)**2)-1. - PGAM(K)=MAX(PGAM(K),2.) - PGAM(K)=MIN(PGAM(K),10.) - - end if - - DLAMC = (CONS26*DUMFNC(K)*GAMMA(PGAM(K)+4.)/(DUMC(K)*GAMMA(PGAM(K)+1.)))**(1./3.) - LAMMIN = (PGAM(K)+1.)/60.E-6 - LAMMAX = (PGAM(K)+1.)/1.E-6 - DLAMC=MAX(DLAMC,LAMMIN) - DLAMC=MIN(DLAMC,LAMMAX) - END IF -!...................................................................... -! SNOW - - IF (DUMQS(K).GE.QSMALL) THEN - DLAMS = (CONS1*DUMFNS(K)/ DUMQS(K))**(1./DS) - DLAMS=MAX(DLAMS,LAMMINS) - DLAMS=MIN(DLAMS,LAMMAXS) - END IF -!...................................................................... -! GRAUPEL - - IF (DUMG(K).GE.QSMALL) THEN - DLAMG = (CONS2*DUMFNG(K)/ DUMG(K))**(1./DG) - DLAMG=MAX(DLAMG,LAMMING) - DLAMG=MIN(DLAMG,LAMMAXG) - END IF - -!...................................................................... -! CALCULATE NUMBER-WEIGHTED AND MASS-WEIGHTED TERMINAL FALL SPEEDS - -! CLOUD WATER - - IF (DUMC(K).GE.QSMALL) THEN - UNC = ACN(K)*GAMMA(1.+BC+PGAM(K))/ (DLAMC**BC*GAMMA(PGAM(K)+1.)) - UMC = ACN(K)*GAMMA(4.+BC+PGAM(K))/ (DLAMC**BC*GAMMA(PGAM(K)+4.)) - ELSE - UMC = 0. - UNC = 0. - END IF - - IF (DUMI(K).GE.QSMALL) THEN - UNI = AIN(K)*CONS27/DLAMI**BI - UMI = AIN(K)*CONS28/(DLAMI**BI) - ELSE - UMI = 0. - UNI = 0. - END IF - - IF (DUMR(K).GE.QSMALL) THEN - UNR = ARN(K)*CONS6/DLAMR**BR - UMR = ARN(K)*CONS4/(DLAMR**BR) - ELSE - UMR = 0. - UNR = 0. - END IF - - IF (DUMQS(K).GE.QSMALL) THEN - UMS = ASN(K)*CONS3/(DLAMS**BS) - UNS = ASN(K)*CONS5/DLAMS**BS - ELSE - UMS = 0. - UNS = 0. - END IF - - IF (DUMG(K).GE.QSMALL) THEN - UMG = AGN(K)*CONS7/(DLAMG**BG) - UNG = AGN(K)*CONS8/DLAMG**BG - ELSE - UMG = 0. - UNG = 0. - END IF - -! SET REALISTIC LIMITS ON FALLSPEED - -! bug fix, 10/08/09 - dum=(rhosu/rho(k))**0.54 - UMS=MIN(UMS,1.2*dum) - UNS=MIN(UNS,1.2*dum) -! v3 5/27/11 -! fix for correction by AA 4/6/11 - UMI=MIN(UMI,1.2*(rhosu/rho(k))**0.35) - UNI=MIN(UNI,1.2*(rhosu/rho(k))**0.35) - UMR=MIN(UMR,9.1*dum) - UNR=MIN(UNR,9.1*dum) - UMG=MIN(UMG,20.*dum) - UNG=MIN(UNG,20.*dum) - - FR(K) = UMR - FI(K) = UMI - FNI(K) = UNI - FS(K) = UMS - FNS(K) = UNS - FNR(K) = UNR - FC(K) = UMC - FNC(K) = UNC - FG(K) = UMG - FNG(K) = UNG - -! V3.3 MODIFY FALLSPEED BELOW LEVEL OF PRECIP - - IF (K.LE.KTE-1) THEN - IF (FR(K).LT.1.E-10) THEN - FR(K)=FR(K+1) - END IF - IF (FI(K).LT.1.E-10) THEN - FI(K)=FI(K+1) - END IF - IF (FNI(K).LT.1.E-10) THEN - FNI(K)=FNI(K+1) - END IF - IF (FS(K).LT.1.E-10) THEN - FS(K)=FS(K+1) - END IF - IF (FNS(K).LT.1.E-10) THEN - FNS(K)=FNS(K+1) - END IF - IF (FNR(K).LT.1.E-10) THEN - FNR(K)=FNR(K+1) - END IF - IF (FC(K).LT.1.E-10) THEN - FC(K)=FC(K+1) - END IF - IF (FNC(K).LT.1.E-10) THEN - FNC(K)=FNC(K+1) - END IF - IF (FG(K).LT.1.E-10) THEN - FG(K)=FG(K+1) - END IF - IF (FNG(K).LT.1.E-10) THEN - FNG(K)=FNG(K+1) - END IF - END IF ! K LE KTE-1 - -! CALCULATE NUMBER OF SPLIT TIME STEPS - - RGVM = MAX(FR(K),FI(K),FS(K),FC(K),FNI(K),FNR(K),FNS(K),FNC(K),FG(K),FNG(K)) -! VVT CHANGED IFIX -> INT (GENERIC FUNCTION) - NSTEP = MAX(INT(RGVM*DT/DZQ(K)+1.),NSTEP) - -! MULTIPLY VARIABLES BY RHO - DUMR(k) = DUMR(k)*RHO(K) - DUMI(k) = DUMI(k)*RHO(K) - DUMFNI(k) = DUMFNI(K)*RHO(K) - DUMQS(k) = DUMQS(K)*RHO(K) - DUMFNS(k) = DUMFNS(K)*RHO(K) - DUMFNR(k) = DUMFNR(K)*RHO(K) - DUMC(k) = DUMC(K)*RHO(K) - DUMFNC(k) = DUMFNC(K)*RHO(K) - DUMG(k) = DUMG(K)*RHO(K) - DUMFNG(k) = DUMFNG(K)*RHO(K) - - END DO - - DO N = 1,NSTEP - - DO K = KTS,KTE - FALOUTR(K) = FR(K)*DUMR(K) - FALOUTI(K) = FI(K)*DUMI(K) - FALOUTNI(K) = FNI(K)*DUMFNI(K) - FALOUTS(K) = FS(K)*DUMQS(K) - FALOUTNS(K) = FNS(K)*DUMFNS(K) - FALOUTNR(K) = FNR(K)*DUMFNR(K) - FALOUTC(K) = FC(K)*DUMC(K) - FALOUTNC(K) = FNC(K)*DUMFNC(K) - FALOUTG(K) = FG(K)*DUMG(K) - FALOUTNG(K) = FNG(K)*DUMFNG(K) - END DO - -! TOP OF MODEL - - K = KTE - FALTNDR = FALOUTR(K)/DZQ(k) - FALTNDI = FALOUTI(K)/DZQ(k) - FALTNDNI = FALOUTNI(K)/DZQ(k) - FALTNDS = FALOUTS(K)/DZQ(k) - FALTNDNS = FALOUTNS(K)/DZQ(k) - FALTNDNR = FALOUTNR(K)/DZQ(k) - FALTNDC = FALOUTC(K)/DZQ(k) - FALTNDNC = FALOUTNC(K)/DZQ(k) - FALTNDG = FALOUTG(K)/DZQ(k) - FALTNDNG = FALOUTNG(K)/DZQ(k) -! ADD FALLOUT TERMS TO EULERIAN TENDENCIES - - QRSTEN(K) = QRSTEN(K)-FALTNDR/NSTEP/RHO(k) - QISTEN(K) = QISTEN(K)-FALTNDI/NSTEP/RHO(k) - NI3DTEN(K) = NI3DTEN(K)-FALTNDNI/NSTEP/RHO(k) - QNISTEN(K) = QNISTEN(K)-FALTNDS/NSTEP/RHO(k) - NS3DTEN(K) = NS3DTEN(K)-FALTNDNS/NSTEP/RHO(k) - NR3DTEN(K) = NR3DTEN(K)-FALTNDNR/NSTEP/RHO(k) - QCSTEN(K) = QCSTEN(K)-FALTNDC/NSTEP/RHO(k) - NC3DTEN(K) = NC3DTEN(K)-FALTNDNC/NSTEP/RHO(k) - QGSTEN(K) = QGSTEN(K)-FALTNDG/NSTEP/RHO(k) - NG3DTEN(K) = NG3DTEN(K)-FALTNDNG/NSTEP/RHO(k) - - NISTEN(K) = NISTEN(K)-FALTNDNI/NSTEP/RHO(k) - NSSTEN(K) = NSSTEN(K)-FALTNDNS/NSTEP/RHO(k) - NRSTEN(K) = NRSTEN(K)-FALTNDNR/NSTEP/RHO(k) - NCSTEN(K) = NCSTEN(K)-FALTNDNC/NSTEP/RHO(k) - NGSTEN(K) = NGSTEN(K)-FALTNDNG/NSTEP/RHO(k) - - DUMR(K) = DUMR(K)-FALTNDR*DT/NSTEP - DUMI(K) = DUMI(K)-FALTNDI*DT/NSTEP - DUMFNI(K) = DUMFNI(K)-FALTNDNI*DT/NSTEP - DUMQS(K) = DUMQS(K)-FALTNDS*DT/NSTEP - DUMFNS(K) = DUMFNS(K)-FALTNDNS*DT/NSTEP - DUMFNR(K) = DUMFNR(K)-FALTNDNR*DT/NSTEP - DUMC(K) = DUMC(K)-FALTNDC*DT/NSTEP - DUMFNC(K) = DUMFNC(K)-FALTNDNC*DT/NSTEP - DUMG(K) = DUMG(K)-FALTNDG*DT/NSTEP - DUMFNG(K) = DUMFNG(K)-FALTNDNG*DT/NSTEP - - DO K = KTE-1,KTS,-1 - FALTNDR = (FALOUTR(K+1)-FALOUTR(K))/DZQ(K) - FALTNDI = (FALOUTI(K+1)-FALOUTI(K))/DZQ(K) - FALTNDNI = (FALOUTNI(K+1)-FALOUTNI(K))/DZQ(K) - FALTNDS = (FALOUTS(K+1)-FALOUTS(K))/DZQ(K) - FALTNDNS = (FALOUTNS(K+1)-FALOUTNS(K))/DZQ(K) - FALTNDNR = (FALOUTNR(K+1)-FALOUTNR(K))/DZQ(K) - FALTNDC = (FALOUTC(K+1)-FALOUTC(K))/DZQ(K) - FALTNDNC = (FALOUTNC(K+1)-FALOUTNC(K))/DZQ(K) - FALTNDG = (FALOUTG(K+1)-FALOUTG(K))/DZQ(K) - FALTNDNG = (FALOUTNG(K+1)-FALOUTNG(K))/DZQ(K) - -! ADD FALLOUT TERMS TO EULERIAN TENDENCIES - - QRSTEN(K) = QRSTEN(K)+FALTNDR/NSTEP/RHO(k) - QISTEN(K) = QISTEN(K)+FALTNDI/NSTEP/RHO(k) - NI3DTEN(K) = NI3DTEN(K)+FALTNDNI/NSTEP/RHO(k) - QNISTEN(K) = QNISTEN(K)+FALTNDS/NSTEP/RHO(k) - NS3DTEN(K) = NS3DTEN(K)+FALTNDNS/NSTEP/RHO(k) - NR3DTEN(K) = NR3DTEN(K)+FALTNDNR/NSTEP/RHO(k) - QCSTEN(K) = QCSTEN(K)+FALTNDC/NSTEP/RHO(k) - NC3DTEN(K) = NC3DTEN(K)+FALTNDNC/NSTEP/RHO(k) - QGSTEN(K) = QGSTEN(K)+FALTNDG/NSTEP/RHO(k) - NG3DTEN(K) = NG3DTEN(K)+FALTNDNG/NSTEP/RHO(k) - - NISTEN(K) = NISTEN(K)+FALTNDNI/NSTEP/RHO(k) - NSSTEN(K) = NSSTEN(K)+FALTNDNS/NSTEP/RHO(k) - NRSTEN(K) = NRSTEN(K)+FALTNDNR/NSTEP/RHO(k) - NCSTEN(K) = NCSTEN(K)+FALTNDNC/NSTEP/RHO(k) - NGSTEN(K) = NGSTEN(K)+FALTNDNG/NSTEP/RHO(k) - - DUMR(K) = DUMR(K)+FALTNDR*DT/NSTEP - DUMI(K) = DUMI(K)+FALTNDI*DT/NSTEP - DUMFNI(K) = DUMFNI(K)+FALTNDNI*DT/NSTEP - DUMQS(K) = DUMQS(K)+FALTNDS*DT/NSTEP - DUMFNS(K) = DUMFNS(K)+FALTNDNS*DT/NSTEP - DUMFNR(K) = DUMFNR(K)+FALTNDNR*DT/NSTEP - DUMC(K) = DUMC(K)+FALTNDC*DT/NSTEP - DUMFNC(K) = DUMFNC(K)+FALTNDNC*DT/NSTEP - DUMG(K) = DUMG(K)+FALTNDG*DT/NSTEP - DUMFNG(K) = DUMFNG(K)+FALTNDNG*DT/NSTEP - -#ifdef ECPP - RSED(K)=RSED(K)+FALOUTR(K)/NSTEP - ISED(K)=ISED(K)+FALOUTI(K)/NSTEP - CSED(K)=CSED(K)+FALOUTC(K)/NSTEP - SSED(K)=SSED(K)+FALOUTS(K)/NSTEP - GSED(K)=GSED(K)+FALOUTG(K)/NSTEP -#endif - - END DO - -! GET PRECIPITATION AND SNOWFALL ACCUMULATION DURING THE TIME STEP -! FACTOR OF 1000 CONVERTS FROM M TO MM, BUT DIVISION BY DENSITY -! OF LIQUID WATER CANCELS THIS FACTOR OF 1000 - - PRECRT = PRECRT+(FALOUTR(KTS)+FALOUTC(KTS)+FALOUTS(KTS)+FALOUTI(KTS)+FALOUTG(KTS)) & - *DT/NSTEP - SNOWRT = SNOWRT+(FALOUTS(KTS)+FALOUTI(KTS)+FALOUTG(KTS))*DT/NSTEP - - END DO - - DO K=KTS,KTE - -! ADD ON SEDIMENTATION TENDENCIES FOR MIXING RATIO TO REST OF TENDENCIES - - QR3DTEN(K)=QR3DTEN(K)+QRSTEN(K) - QI3DTEN(K)=QI3DTEN(K)+QISTEN(K) - QC3DTEN(K)=QC3DTEN(K)+QCSTEN(K) - QG3DTEN(K)=QG3DTEN(K)+QGSTEN(K) - QNI3DTEN(K)=QNI3DTEN(K)+QNISTEN(K) - -! PUT ALL CLOUD ICE IN SNOW CATEGORY IF MEAN DIAMETER EXCEEDS 2 * dcs - -! V1.7 -!hm 7/9/09 bug fix -! IF (QI3D(K).GE.QSMALL.AND.T3D(K).LT.273.15) THEN - IF (QI3D(K).GE.QSMALL.AND.T3D(K).LT.TMELT.AND.LAMI(K).GE.1.E-10) THEN - - IF (1./LAMI(K).GE.2.*DCS) THEN - QNI3DTEN(K) = QNI3DTEN(K)+QI3D(K)/DT+ QI3DTEN(K) - NS3DTEN(K) = NS3DTEN(K)+NI3D(K)/DT+ NI3DTEN(K) - QI3DTEN(K) = -QI3D(K)/DT - NI3DTEN(K) = -NI3D(K)/DT - END IF - END IF - -! hm add tendencies here, then call sizeparameter -! to ensure consisitency between mixing ratio and number concentration - - QC3D(k) = QC3D(k)+QC3DTEN(k)*DT - QI3D(k) = QI3D(k)+QI3DTEN(k)*DT - QNI3D(k) = QNI3D(k)+QNI3DTEN(k)*DT - QR3D(k) = QR3D(k)+QR3DTEN(k)*DT - NC3D(k) = NC3D(k)+NC3DTEN(k)*DT - NI3D(k) = NI3D(k)+NI3DTEN(k)*DT - NS3D(k) = NS3D(k)+NS3DTEN(k)*DT - NR3D(k) = NR3D(k)+NR3DTEN(k)*DT - - IF (IGRAUP.EQ.0) THEN - QG3D(k) = QG3D(k)+QG3DTEN(k)*DT - NG3D(k) = NG3D(k)+NG3DTEN(k)*DT - END IF - -! ADD TEMPERATURE AND WATER VAPOR TENDENCIES FROM MICROPHYSICS - T3D(K) = T3D(K)+T3DTEN(k)*DT - QV3D(K) = QV3D(K)+QV3DTEN(k)*DT - -! SATURATION VAPOR PRESSURE AND MIXING RATIO - -! hm, add fix for low pressure, 5/12/10 - EVS(K) = min(0.99*pres(k),POLYSVP(T3D(K),0)) ! PA - EIS(K) = min(0.99*pres(k),POLYSVP(T3D(K),1)) ! PA - -! MAKE SURE ICE SATURATION DOESN'T EXCEED WATER SAT. NEAR FREEZING - - IF (EIS(K).GT.EVS(K)) EIS(K) = EVS(K) - - QVS(K) = EP_2*EVS(K)/(PRES(K)-EVS(K)) - QVI(K) = EP_2*EIS(K)/(PRES(K)-EIS(K)) - - QVQVS(K) = QV3D(K)/QVS(K) - QVQVSI(K) = QV3D(K)/QVI(K) - -! AT SUBSATURATION, REMOVE SMALL AMOUNTS OF CLOUD/PRECIP WATER - -! V1.3, change limit from 10^-7 to 10^-6 -! V1.7 7/9/09 change limit from 10^-6 to 10^-8 - - IF (QVQVS(K).LT.0.9) THEN - IF (QR3D(K).LT.1.E-8) THEN - QV3D(K)=QV3D(K)+QR3D(K) - T3D(K)=T3D(K)-QR3D(K)*XXLV(K)/CPM(K) - QR3D(K)=0. - END IF - IF (QC3D(K).LT.1.E-8) THEN - QV3D(K)=QV3D(K)+QC3D(K) - T3D(K)=T3D(K)-QC3D(K)*XXLV(K)/CPM(K) - QC3D(K)=0. - END IF - END IF - - IF (QVQVSI(K).LT.0.9) THEN - IF (QI3D(K).LT.1.E-8) THEN - QV3D(K)=QV3D(K)+QI3D(K) - T3D(K)=T3D(K)-QI3D(K)*XXLS(K)/CPM(K) - QI3D(K)=0. - END IF - IF (QNI3D(K).LT.1.E-8) THEN - QV3D(K)=QV3D(K)+QNI3D(K) - T3D(K)=T3D(K)-QNI3D(K)*XXLS(K)/CPM(K) - QNI3D(K)=0. - END IF - IF (QG3D(K).LT.1.E-8) THEN - QV3D(K)=QV3D(K)+QG3D(K) - T3D(K)=T3D(K)-QG3D(K)*XXLS(K)/CPM(K) - QG3D(K)=0. - END IF - END IF - -!.................................................................. -! IF MIXING RATIO < QSMALL SET MIXING RATIO AND NUMBER CONC TO ZERO - - IF (QC3D(K).LT.QSMALL) THEN -!+++mhwang - QV3D(K)=QV3D(K)+QC3D(K) - T3D(K)=T3D(K)-QC3D(K)*XXLV(K)/CPM(K) -!---mhwang - QC3D(K) = 0. - NC3D(K) = 0. - EFFC(K) = 0. - END IF - IF (QR3D(K).LT.QSMALL) THEN -!+++mhwang - QV3D(K)=QV3D(K)+QR3D(K) - T3D(K)=T3D(K)-QR3D(K)*XXLV(K)/CPM(K) -!---mhwang - QR3D(K) = 0. - NR3D(K) = 0. - EFFR(K) = 0. - END IF - IF (QI3D(K).LT.QSMALL) THEN -!+++mhwang - QV3D(K)=QV3D(K)+QI3D(K) - T3D(K)=T3D(K)-QI3D(K)*XXLS(K)/CPM(K) -!+++mhwang - QI3D(K) = 0. - NI3D(K) = 0. - EFFI(K) = 0. - END IF - IF (QNI3D(K).LT.QSMALL) THEN -!+++mhwang - QV3D(K)=QV3D(K)+QNI3D(K) - T3D(K)=T3D(K)-QNI3D(K)*XXLS(K)/CPM(K) -!+++mhwang - QNI3D(K) = 0. - NS3D(K) = 0. - EFFS(K) = 0. - END IF - IF (QG3D(K).LT.QSMALL) THEN -!+++mhwang - QV3D(K)=QV3D(K)+QG3D(K) - T3D(K)=T3D(K)-QG3D(K)*XXLS(K)/CPM(K) -!+++mhwang - QG3D(K) = 0. - NG3D(K) = 0. - EFFG(K) = 0. - END IF - -!.................................. -! IF THERE IS NO CLOUD/PRECIP WATER, THEN SKIP CALCULATIONS - - IF (QC3D(K).LT.QSMALL.AND.QI3D(K).LT.QSMALL.AND.QNI3D(K).LT.QSMALL & - .AND.QR3D(K).LT.QSMALL.AND.QG3D(K).LT.QSMALL) GOTO 500 - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! CALCULATE INSTANTANEOUS PROCESSES - -! ADD MELTING OF CLOUD ICE TO FORM RAIN - - IF (QI3D(K).GE.QSMALL.AND.T3D(K).GE.TMELT) THEN - QR3D(K) = QR3D(K)+QI3D(K) - T3D(K) = T3D(K)-QI3D(K)*XLF(K)/CPM(K) -! hm 7/26/11, new output - mlt1d(k)=mlt1d(k)+qi3d(k)/dt - QI3D(K) = 0. - NR3D(K) = NR3D(K)+NI3D(K) - NI3D(K) = 0. - END IF - -! ****SENSITIVITY - NO ICE - IF (ILIQ.EQ.1) GOTO 778 - -! HOMOGENEOUS FREEZING OF CLOUD WATER - - IF (T3D(K).LE.233.15.AND.QC3D(K).GE.QSMALL) THEN - QI3D(K)=QI3D(K)+QC3D(K) - T3D(K)=T3D(K)+QC3D(K)*XLF(K)/CPM(K) - QC3D(K)=0. -#ifdef CLUBB_CRM -!+++mhwang test how SAM_CLUBB sensitive to this - NI3D(K)=NI3D(K)+NC3D(K) * NNUCCC_REDUCE_COEF ! -#else - NI3D(K)=NI3D(K)+NC3D(K) -#endif - NC3D(K)=0. - END IF - -! HOMOGENEOUS FREEZING OF RAIN - - IF (IGRAUP.EQ.0) THEN - - IF (T3D(K).LE.233.15.AND.QR3D(K).GE.QSMALL) THEN - QG3D(K) = QG3D(K)+QR3D(K) - T3D(K) = T3D(K)+QR3D(K)*XLF(K)/CPM(K) - QR3D(K) = 0. - NG3D(K) = NG3D(K)+ NR3D(K) - NR3D(K) = 0. - END IF - - ELSE IF (IGRAUP.EQ.1) THEN - - IF (T3D(K).LE.233.15.AND.QR3D(K).GE.QSMALL) THEN - QNI3D(K) = QNI3D(K)+QR3D(K) - T3D(K) = T3D(K)+QR3D(K)*XLF(K)/CPM(K) - QR3D(K) = 0. - NS3D(K) = NS3D(K)+NR3D(K) - NR3D(K) = 0. - END IF - - END IF - - 778 CONTINUE - -! MAKE SURE NUMBER CONCENTRATIONS AREN'T NEGATIVE - - NI3D(K) = MAX(0.,NI3D(K)) - NS3D(K) = MAX(0.,NS3D(K)) - NC3D(K) = MAX(0.,NC3D(K)) - NR3D(K) = MAX(0.,NR3D(K)) - NG3D(K) = MAX(0.,NG3D(K)) - -!...................................................................... -! CLOUD ICE - - IF (QI3D(K).GE.QSMALL) THEN - LAMI(K) = (CONS12* & - NI3D(K)/QI3D(K))**(1./DI) - -! CHECK FOR SLOPE - -! ADJUST VARS - - IF (LAMI(K).LT.LAMMINI) THEN - - LAMI(K) = LAMMINI - - N0I(K) = LAMI(K)**(DI+1.)*QI3D(K)/CONS12 - - NI3D(K) = N0I(K)/LAMI(K) - ELSE IF (LAMI(K).GT.LAMMAXI) THEN - LAMI(K) = LAMMAXI - N0I(K) = LAMI(K)**(DI+1.)*QI3D(K)/CONS12 - - NI3D(K) = N0I(K)/LAMI(K) - END IF - END IF - -!...................................................................... -! RAIN - - IF (QR3D(K).GE.QSMALL) THEN - LAMR(K) = (PI*RHOW*NR3D(K)/QR3D(K))**(1./3.) - -! CHECK FOR SLOPE - -! ADJUST VARS - - IF (LAMR(K).LT.LAMMINR) THEN - - LAMR(K) = LAMMINR - - N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW) - - NR3D(K) = N0RR(K)/LAMR(K) - ELSE IF (LAMR(K).GT.LAMMAXR) THEN - LAMR(K) = LAMMAXR - N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW) - - NR3D(K) = N0RR(K)/LAMR(K) - END IF - - END IF - -!...................................................................... -! CLOUD DROPLETS - -! MARTIN ET AL. (1994) FORMULA FOR PGAM - - IF (QC3D(K).GE.QSMALL) THEN - - !bloss: option for fixing pgam - if(dofix_pgam) then - pgam(k) = pgam_fixed - else - -! DUM = PRES(K)/(R*T3D(K)) -! V1.5 - PGAM(K)=0.0005714*(NC3D(K)/1.E6*RHO(K))+0.2714 - PGAM(K)=1./(PGAM(K)**2)-1. - PGAM(K)=MAX(PGAM(K),2.) - PGAM(K)=MIN(PGAM(K),10.) - - end if - -! CALCULATE LAMC - - LAMC(K) = (CONS26*NC3D(K)*GAMMA(PGAM(K)+4.)/ & - (QC3D(K)*GAMMA(PGAM(K)+1.)))**(1./3.) - -! LAMMIN, 60 MICRON DIAMETER -! LAMMAX, 1 MICRON - - LAMMIN = (PGAM(K)+1.)/60.E-6 - LAMMAX = (PGAM(K)+1.)/1.E-6 - - IF (LAMC(K).LT.LAMMIN) THEN - LAMC(K) = LAMMIN - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 - - ELSE IF (LAMC(K).GT.LAMMAX) THEN - LAMC(K) = LAMMAX - NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+ & - LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26 - - END IF - - END IF - -!...................................................................... -! SNOW - - IF (QNI3D(K).GE.QSMALL) THEN - LAMS(K) = (CONS1*NS3D(K)/QNI3D(K))**(1./DS) - -! CHECK FOR SLOPE - -! ADJUST VARS - - IF (LAMS(K).LT.LAMMINS) THEN - LAMS(K) = LAMMINS - N0S(K) = LAMS(K)**(DS+1.)*QNI3D(K)/CONS1 - - NS3D(K) = N0S(K)/LAMS(K) - - ELSE IF (LAMS(K).GT.LAMMAXS) THEN - - LAMS(K) = LAMMAXS - N0S(K) = LAMS(K)**(DS+1.)*QNI3D(K)/CONS1 - NS3D(K) = N0S(K)/LAMS(K) - END IF - - END IF - -!...................................................................... -! GRAUPEL - - IF (QG3D(K).GE.QSMALL) THEN - LAMG(K) = (CONS2*NG3D(K)/QG3D(K))**(1./DG) - -! CHECK FOR SLOPE - -! ADJUST VARS - - IF (LAMG(K).LT.LAMMING) THEN - LAMG(K) = LAMMING - N0G(K) = LAMG(K)**(DG+1.)*QG3D(K)/CONS2 - - NG3D(K) = N0G(K)/LAMG(K) - - ELSE IF (LAMG(K).GT.LAMMAXG) THEN - - LAMG(K) = LAMMAXG - N0G(K) = LAMG(K)**(DG+1.)*QG3D(K)/CONS2 - - NG3D(K) = N0G(K)/LAMG(K) - END IF - - END IF - - 500 CONTINUE - -! CALCULATE EFFECTIVE RADIUS - -#ifdef CLUBB_CRM - ! Account for subgrid scale effective droplet radii - IF ( CF3D(K) > cloud_frac_thresh ) THEN - TMPQSMALL = QSMALL / CF3D(K) - ELSE - TMPQSMALL = QSMALL - END IF - - IF (QI3D(K).GE.TMPQSMALL) THEN - EFFI(K) = 3./LAMI(K)/2.*1.E6 - ELSE - EFFI(K) = 25. - END IF - - IF (QNI3D(K).GE.TMPQSMALL) THEN - EFFS(K) = 3./LAMS(K)/2.*1.E6 - ELSE - EFFS(K) = 25. - END IF - - IF (QR3D(K).GE.TMPQSMALL) THEN - EFFR(K) = 3./LAMR(K)/2.*1.E6 - ELSE - EFFR(K) = 25. - END IF - - IF (QC3D(K).GE.TMPQSMALL) THEN - EFFC(K) = GAMMA(PGAM(K)+4.)/ & - GAMMA(PGAM(K)+3.)/LAMC(K)/2.*1.E6 - ELSE - EFFC(K) = 25. - END IF - - IF (QG3D(K).GE.TMPQSMALL) THEN - EFFG(K) = 3./LAMG(K)/2.*1.E6 - ELSE - EFFG(K) = 25. - END IF -#else - IF (QI3D(K).GE.QSMALL) THEN - EFFI(K) = 3./LAMI(K)/2.*1.E6 - ELSE - EFFI(K) = 25. - END IF - - IF (QNI3D(K).GE.QSMALL) THEN - EFFS(K) = 3./LAMS(K)/2.*1.E6 - ELSE - EFFS(K) = 25. - END IF - - IF (QR3D(K).GE.QSMALL) THEN - EFFR(K) = 3./LAMR(K)/2.*1.E6 - ELSE - EFFR(K) = 25. - END IF - - IF (QC3D(K).GE.QSMALL) THEN - EFFC(K) = GAMMA(PGAM(K)+4.)/ & - GAMMA(PGAM(K)+3.)/LAMC(K)/2.*1.E6 - ELSE - EFFC(K) = 25. - END IF - - IF (QG3D(K).GE.QSMALL) THEN - EFFG(K) = 3./LAMG(K)/2.*1.E6 - ELSE - EFFG(K) = 25. - END IF -#endif /*CLUBB_CRM*/ - -! HM ADD 1/10/06, ADD UPPER BOUND ON ICE NUMBER, THIS IS NEEDED -! TO PREVENT VERY LARGE ICE NUMBER DUE TO HOMOGENEOUS FREEZING -! OF DROPLETS, ESPECIALLY WHEN INUM = 1, SET MAX AT 10 CM-3 - NI3D(K) = MIN(NI3D(K),10.E6/RHO(K)) -! ADD BOUND ON DROPLET NUMBER - CANNOT EXCEED AEROSOL CONCENTRATION - IF (INUM.EQ.0.AND.IACT.EQ.2) THEN - NC3D(K) = MIN(NC3D(K),(NANEW1+NANEW2)/RHO(K)) - END IF -! SWITCH FOR CONSTANT DROPLET NUMBER - IF (INUM.EQ.1) THEN -! CHANGE NDCNST FROM CM-3 TO KG-1 - NC3D(K) = NDCNST*1.E6/RHO(K) - END IF -#ifdef CLUBB_CRM -! ADDITION BY UWM TO ENSURE THE POSITIVE DEFINITENESS OF VAPOR WATER MIXING RATIO - CALL POSITIVE_QV_ADJ( QV3D(K), QC3D(K), QR3D(K), QI3D(K), & - QNI3D(K), QG3D(K), T3D(K) ) -#endif /*CLUBB_CRM*/ - -#ifdef ECPP -! calculate relative humidity -! - ! SATURATION VAPOR PRESSURE AND MIXING RATIO - - EVS(K) = POLYSVP(T3D(K),0) ! PA -! MAKE SURE ICE SATURATION DOESN'T EXCEED WATER SAT. NEAR FREEZING - QVS(K) = .622*EVS(K)/(PRES(K)-EVS(K)) - QVQVS(K) = QV3D(K)/QVS(K) - RH3D(K)= min(1.0, QVQVS(K)) -#endif /*ECPP*/ - - END DO !!! K LOOP - - 400 CONTINUE - -! ALL DONE !!!!!!!!!!! - RETURN - END SUBROUTINE M2005MICRO_GRAUPEL - -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - REAL FUNCTION POLYSVP (T,TYPE) - -!------------------------------------------- - -! COMPUTE SATURATION VAPOR PRESSURE - -! POLYSVP RETURNED IN UNITS OF PA. -! T IS INPUT IN UNITS OF K. -! TYPE REFERS TO SATURATION WITH RESPECT TO LIQUID (0) OR ICE (1) - - IMPLICIT NONE - - REAL DUM - REAL T - INTEGER TYPE - -! REPLACE GOFF-GRATCH WITH FASTER FORMULATION FROM FLATAU ET AL. 1992, TABLE 4 (RIGHT-HAND COLUMN) - -! ice - real a0i,a1i,a2i,a3i,a4i,a5i,a6i,a7i,a8i - data a0i,a1i,a2i,a3i,a4i,a5i,a6i,a7i,a8i /& - 6.11147274, 0.503160820, 0.188439774e-1, & - 0.420895665e-3, 0.615021634e-5,0.602588177e-7, & - 0.385852041e-9, 0.146898966e-11, 0.252751365e-14/ - -! liquid - real a0,a1,a2,a3,a4,a5,a6,a7,a8 - -! V1.7 - data a0,a1,a2,a3,a4,a5,a6,a7,a8 /& - 6.11239921, 0.443987641, 0.142986287e-1, & - 0.264847430e-3, 0.302950461e-5, 0.206739458e-7, & - 0.640689451e-10,-0.952447341e-13,-0.976195544e-15/ - real dt - -! ICE - - IF (TYPE.EQ.1) THEN - -! POLYSVP = 10.**(-9.09718*(273.16/T-1.)-3.56654* & -! LOG10(273.16/T)+0.876793*(1.-T/273.16)+ & -! LOG10(6.1071))*100. - - - dt = max(-80.,t-273.16) - polysvp = a0i + dt*(a1i+dt*(a2i+dt*(a3i+dt*(a4i+dt*(a5i+dt*(a6i+dt*(a7i+a8i*dt))))))) - polysvp = polysvp*100. - - END IF - -! LIQUID - - IF (TYPE.EQ.0) THEN - - dt = max(-80.,t-273.16) - polysvp = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) - polysvp = polysvp*100. - -! POLYSVP = 10.**(-7.90298*(373.16/T-1.)+ & -! 5.02808*LOG10(373.16/T)- & -! 1.3816E-7*(10**(11.344*(1.-T/373.16))-1.)+ & -! 8.1328E-3*(10**(-3.49149*(373.16/T-1.))-1.)+ & -! LOG10(1013.246))*100. - - END IF - - - END FUNCTION POLYSVP - -!------------------------------------------------------------------------------ - - REAL FUNCTION GAMMA(X) -!---------------------------------------------------------------------- -! -! THIS ROUTINE CALCULATES THE GAMMA FUNCTION FOR A REAL ARGUMENT X. -! COMPUTATION IS BASED ON AN ALGORITHM OUTLINED IN REFERENCE 1. -! THE PROGRAM USES RATIONAL FUNCTIONS THAT APPROXIMATE THE GAMMA -! FUNCTION TO AT LEAST 20 SIGNIFICANT DECIMAL DIGITS. COEFFICIENTS -! FOR THE APPROXIMATION OVER THE INTERVAL (1,2) ARE UNPUBLISHED. -! THOSE FOR THE APPROXIMATION FOR X .GE. 12 ARE FROM REFERENCE 2. -! THE ACCURACY ACHIEVED DEPENDS ON THE ARITHMETIC SYSTEM, THE -! COMPILER, THE INTRINSIC FUNCTIONS, AND PROPER SELECTION OF THE -! MACHINE-DEPENDENT CONSTANTS. -! -! -!******************************************************************* -!******************************************************************* -! -! EXPLANATION OF MACHINE-DEPENDENT CONSTANTS -! -! BETA - RADIX FOR THE FLOATING-POINT REPRESENTATION -! MAXEXP - THE SMALLEST POSITIVE POWER OF BETA THAT OVERFLOWS -! XBIG - THE LARGEST ARGUMENT FOR WHICH GAMMA(X) IS REPRESENTABLE -! IN THE MACHINE, I.E., THE SOLUTION TO THE EQUATION -! GAMMA(XBIG) = BETA**MAXEXP -! XINF - THE LARGEST MACHINE REPRESENTABLE FLOATING-POINT NUMBER; -! APPROXIMATELY BETA**MAXEXP -! EPS - THE SMALLEST POSITIVE FLOATING-POINT NUMBER SUCH THAT -! 1.0+EPS .GT. 1.0 -! XMININ - THE SMALLEST POSITIVE FLOATING-POINT NUMBER SUCH THAT -! 1/XMININ IS MACHINE REPRESENTABLE -! -! APPROXIMATE VALUES FOR SOME IMPORTANT MACHINES ARE: -! -! BETA MAXEXP XBIG -! -! CRAY-1 (S.P.) 2 8191 966.961 -! CYBER 180/855 -! UNDER NOS (S.P.) 2 1070 177.803 -! IEEE (IBM/XT, -! SUN, ETC.) (S.P.) 2 128 35.040 -! IEEE (IBM/XT, -! SUN, ETC.) (D.P.) 2 1024 171.624 -! IBM 3033 (D.P.) 16 63 57.574 -! VAX D-FORMAT (D.P.) 2 127 34.844 -! VAX G-FORMAT (D.P.) 2 1023 171.489 -! -! XINF EPS XMININ -! -! CRAY-1 (S.P.) 5.45E+2465 7.11E-15 1.84E-2466 -! CYBER 180/855 -! UNDER NOS (S.P.) 1.26E+322 3.55E-15 3.14E-294 -! IEEE (IBM/XT, -! SUN, ETC.) (S.P.) 3.40E+38 1.19E-7 1.18E-38 -! IEEE (IBM/XT, -! SUN, ETC.) (D.P.) 1.79D+308 2.22D-16 2.23D-308 -! IBM 3033 (D.P.) 7.23D+75 2.22D-16 1.39D-76 -! VAX D-FORMAT (D.P.) 1.70D+38 1.39D-17 5.88D-39 -! VAX G-FORMAT (D.P.) 8.98D+307 1.11D-16 1.12D-308 -! -!******************************************************************* -!******************************************************************* -! -! ERROR RETURNS -! -! THE PROGRAM RETURNS THE VALUE XINF FOR SINGULARITIES OR -! WHEN OVERFLOW WOULD OCCUR. THE COMPUTATION IS BELIEVED -! TO BE FREE OF UNDERFLOW AND OVERFLOW. -! -! -! INTRINSIC FUNCTIONS REQUIRED ARE: -! -! INT, DBLE, EXP, LOG, REAL, SIN -! -! -! REFERENCES: AN OVERVIEW OF SOFTWARE DEVELOPMENT FOR SPECIAL -! FUNCTIONS W. J. CODY, LECTURE NOTES IN MATHEMATICS, -! 506, NUMERICAL ANALYSIS DUNDEE, 1975, G. A. WATSON -! (ED.), SPRINGER VERLAG, BERLIN, 1976. -! -! COMPUTER APPROXIMATIONS, HART, ET. AL., WILEY AND -! SONS, NEW YORK, 1968. -! -! LATEST MODIFICATION: OCTOBER 12, 1989 -! -! AUTHORS: W. J. CODY AND L. STOLTZ -! APPLIED MATHEMATICS DIVISION -! ARGONNE NATIONAL LABORATORY -! ARGONNE, IL 60439 -! -!---------------------------------------------------------------------- - implicit none - INTEGER I,N - LOGICAL PARITY - REAL & - CONV,EPS,FACT,HALF,ONE,RES,SUM,TWELVE, & - TWO,X,XBIG,XDEN,XINF,XMININ,XNUM,Y,Y1,YSQ,Z,ZERO - REAL, DIMENSION(7) :: C - REAL, DIMENSION(8) :: P - REAL, DIMENSION(8) :: Q -!---------------------------------------------------------------------- -! MATHEMATICAL CONSTANTS -!---------------------------------------------------------------------- - DATA ONE,HALF,TWELVE,TWO,ZERO/1.0E0,0.5E0,12.0E0,2.0E0,0.0E0/ - - -!---------------------------------------------------------------------- -! MACHINE DEPENDENT PARAMETERS -!---------------------------------------------------------------------- - DATA XBIG,XMININ,EPS/35.040E0,1.18E-38,1.19E-7/,XINF/3.4E38/ -!---------------------------------------------------------------------- -! NUMERATOR AND DENOMINATOR COEFFICIENTS FOR RATIONAL MINIMAX -! APPROXIMATION OVER (1,2). -!---------------------------------------------------------------------- - DATA P/-1.71618513886549492533811E+0,2.47656508055759199108314E+1, & - -3.79804256470945635097577E+2,6.29331155312818442661052E+2, & - 8.66966202790413211295064E+2,-3.14512729688483675254357E+4, & - -3.61444134186911729807069E+4,6.64561438202405440627855E+4/ - DATA Q/-3.08402300119738975254353E+1,3.15350626979604161529144E+2, & - -1.01515636749021914166146E+3,-3.10777167157231109440444E+3, & - 2.25381184209801510330112E+4,4.75584627752788110767815E+3, & - -1.34659959864969306392456E+5,-1.15132259675553483497211E+5/ -!---------------------------------------------------------------------- -! COEFFICIENTS FOR MINIMAX APPROXIMATION OVER (12, INF). -!---------------------------------------------------------------------- - DATA C/-1.910444077728E-03,8.4171387781295E-04, & - -5.952379913043012E-04,7.93650793500350248E-04, & - -2.777777777777681622553E-03,8.333333333333333331554247E-02, & - 5.7083835261E-03/ -!---------------------------------------------------------------------- -! STATEMENT FUNCTIONS FOR CONVERSION BETWEEN INTEGER AND FLOAT -!---------------------------------------------------------------------- - CONV(I) = REAL(I) - PARITY=.FALSE. - FACT=ONE - N=0 - Y=X - IF(Y.LE.ZERO)THEN -!---------------------------------------------------------------------- -! ARGUMENT IS NEGATIVE -!---------------------------------------------------------------------- - Y=-X - Y1=AINT(Y) - RES=Y-Y1 - IF(RES.NE.ZERO)THEN - IF(Y1.NE.AINT(Y1*HALF)*TWO)PARITY=.TRUE. - FACT=-PI/SIN(PI*RES) - Y=Y+ONE - ELSE - RES=XINF - GOTO 900 - ENDIF - ENDIF -!---------------------------------------------------------------------- -! ARGUMENT IS POSITIVE -!---------------------------------------------------------------------- - IF(Y.LT.EPS)THEN -!---------------------------------------------------------------------- -! ARGUMENT .LT. EPS -!---------------------------------------------------------------------- - IF(Y.GE.XMININ)THEN - RES=ONE/Y - ELSE - RES=XINF - GOTO 900 - ENDIF - ELSEIF(Y.LT.TWELVE)THEN - Y1=Y - IF(Y.LT.ONE)THEN -!---------------------------------------------------------------------- -! 0.0 .LT. ARGUMENT .LT. 1.0 -!---------------------------------------------------------------------- - Z=Y - Y=Y+ONE - ELSE -!---------------------------------------------------------------------- -! 1.0 .LT. ARGUMENT .LT. 12.0, REDUCE ARGUMENT IF NECESSARY -!---------------------------------------------------------------------- - N=INT(Y)-1 - Y=Y-CONV(N) - Z=Y-ONE - ENDIF -!---------------------------------------------------------------------- -! EVALUATE APPROXIMATION FOR 1.0 .LT. ARGUMENT .LT. 2.0 -!---------------------------------------------------------------------- - XNUM=ZERO - XDEN=ONE - DO I=1,8 - XNUM=(XNUM+P(I))*Z - XDEN=XDEN*Z+Q(I) - END DO - RES=XNUM/XDEN+ONE - IF(Y1.LT.Y)THEN -!---------------------------------------------------------------------- -! ADJUST RESULT FOR CASE 0.0 .LT. ARGUMENT .LT. 1.0 -!---------------------------------------------------------------------- - RES=RES/Y1 - ELSEIF(Y1.GT.Y)THEN -!---------------------------------------------------------------------- -! ADJUST RESULT FOR CASE 2.0 .LT. ARGUMENT .LT. 12.0 -!---------------------------------------------------------------------- - DO I=1,N - RES=RES*Y - Y=Y+ONE - END DO - ENDIF - ELSE -!---------------------------------------------------------------------- -! EVALUATE FOR ARGUMENT .GE. 12.0, -!---------------------------------------------------------------------- - IF(Y.LE.XBIG)THEN - YSQ=Y*Y - SUM=C(7) - DO I=1,6 - SUM=SUM/YSQ+C(I) - END DO - SUM=SUM/Y-Y+SQRTPI - SUM=SUM+(Y-HALF)*LOG(Y) - RES=EXP(SUM) - ELSE - RES=XINF - GOTO 900 - ENDIF - ENDIF -!---------------------------------------------------------------------- -! FINAL ADJUSTMENTS AND RETURN -!---------------------------------------------------------------------- - IF(PARITY)RES=-RES - IF(FACT.NE.ONE)RES=FACT/RES - 900 GAMMA=RES - RETURN -! ---------- LAST LINE OF GAMMA ---------- - END FUNCTION GAMMA - - - REAL FUNCTION DERF1(X) - IMPLICIT NONE - REAL X - REAL, DIMENSION(0 : 64) :: A, B - REAL W,T,Y - INTEGER K,I - DATA A/ & - 0.00000000005958930743E0, -0.00000000113739022964E0, & - 0.00000001466005199839E0, -0.00000016350354461960E0, & - 0.00000164610044809620E0, -0.00001492559551950604E0, & - 0.00012055331122299265E0, -0.00085483269811296660E0, & - 0.00522397762482322257E0, -0.02686617064507733420E0, & - 0.11283791670954881569E0, -0.37612638903183748117E0, & - 1.12837916709551257377E0, & - 0.00000000002372510631E0, -0.00000000045493253732E0, & - 0.00000000590362766598E0, -0.00000006642090827576E0, & - 0.00000067595634268133E0, -0.00000621188515924000E0, & - 0.00005103883009709690E0, -0.00037015410692956173E0, & - 0.00233307631218880978E0, -0.01254988477182192210E0, & - 0.05657061146827041994E0, -0.21379664776456006580E0, & - 0.84270079294971486929E0, & - 0.00000000000949905026E0, -0.00000000018310229805E0, & - 0.00000000239463074000E0, -0.00000002721444369609E0, & - 0.00000028045522331686E0, -0.00000261830022482897E0, & - 0.00002195455056768781E0, -0.00016358986921372656E0, & - 0.00107052153564110318E0, -0.00608284718113590151E0, & - 0.02986978465246258244E0, -0.13055593046562267625E0, & - 0.67493323603965504676E0, & - 0.00000000000382722073E0, -0.00000000007421598602E0, & - 0.00000000097930574080E0, -0.00000001126008898854E0, & - 0.00000011775134830784E0, -0.00000111992758382650E0, & - 0.00000962023443095201E0, -0.00007404402135070773E0, & - 0.00050689993654144881E0, -0.00307553051439272889E0, & - 0.01668977892553165586E0, -0.08548534594781312114E0, & - 0.56909076642393639985E0, & - 0.00000000000155296588E0, -0.00000000003032205868E0, & - 0.00000000040424830707E0, -0.00000000471135111493E0, & - 0.00000005011915876293E0, -0.00000048722516178974E0, & - 0.00000430683284629395E0, -0.00003445026145385764E0, & - 0.00024879276133931664E0, -0.00162940941748079288E0, & - 0.00988786373932350462E0, -0.05962426839442303805E0, & - 0.49766113250947636708E0 / - DATA (B(I), I = 0, 12) / & - -0.00000000029734388465E0, 0.00000000269776334046E0, & - -0.00000000640788827665E0, -0.00000001667820132100E0, & - -0.00000021854388148686E0, 0.00000266246030457984E0, & - 0.00001612722157047886E0, -0.00025616361025506629E0, & - 0.00015380842432375365E0, 0.00815533022524927908E0, & - -0.01402283663896319337E0, -0.19746892495383021487E0, & - 0.71511720328842845913E0 / - DATA (B(I), I = 13, 25) / & - -0.00000000001951073787E0, -0.00000000032302692214E0, & - 0.00000000522461866919E0, 0.00000000342940918551E0, & - -0.00000035772874310272E0, 0.00000019999935792654E0, & - 0.00002687044575042908E0, -0.00011843240273775776E0, & - -0.00080991728956032271E0, 0.00661062970502241174E0, & - 0.00909530922354827295E0, -0.20160072778491013140E0, & - 0.51169696718727644908E0 / - DATA (B(I), I = 26, 38) / & - 0.00000000003147682272E0, -0.00000000048465972408E0, & - 0.00000000063675740242E0, 0.00000003377623323271E0, & - -0.00000015451139637086E0, -0.00000203340624738438E0, & - 0.00001947204525295057E0, 0.00002854147231653228E0, & - -0.00101565063152200272E0, 0.00271187003520095655E0, & - 0.02328095035422810727E0, -0.16725021123116877197E0, & - 0.32490054966649436974E0 / - DATA (B(I), I = 39, 51) / & - 0.00000000002319363370E0, -0.00000000006303206648E0, & - -0.00000000264888267434E0, 0.00000002050708040581E0, & - 0.00000011371857327578E0, -0.00000211211337219663E0, & - 0.00000368797328322935E0, 0.00009823686253424796E0, & - -0.00065860243990455368E0, -0.00075285814895230877E0, & - 0.02585434424202960464E0, -0.11637092784486193258E0, & - 0.18267336775296612024E0 / - DATA (B(I), I = 52, 64) / & - -0.00000000000367789363E0, 0.00000000020876046746E0, & - -0.00000000193319027226E0, -0.00000000435953392472E0, & - 0.00000018006992266137E0, -0.00000078441223763969E0, & - -0.00000675407647949153E0, 0.00008428418334440096E0, & - -0.00017604388937031815E0, -0.00239729611435071610E0, & - 0.02064129023876022970E0, -0.06905562880005864105E0, & - 0.09084526782065478489E0 / - W = ABS(X) - IF (W .LT. 2.2D0) THEN - T = W * W - K = INT(T) - T = T - K - K = K * 13 - Y = ((((((((((((A(K) * T + A(K + 1)) * T + & - A(K + 2)) * T + A(K + 3)) * T + A(K + 4)) * T + & - A(K + 5)) * T + A(K + 6)) * T + A(K + 7)) * T + & - A(K + 8)) * T + A(K + 9)) * T + A(K + 10)) * T + & - A(K + 11)) * T + A(K + 12)) * W - ELSE IF (W .LT. 6.9D0) THEN - K = INT(W) - T = W - K - K = 13 * (K - 2) - Y = (((((((((((B(K) * T + B(K + 1)) * T + & - B(K + 2)) * T + B(K + 3)) * T + B(K + 4)) * T + & - B(K + 5)) * T + B(K + 6)) * T + B(K + 7)) * T + & - B(K + 8)) * T + B(K + 9)) * T + B(K + 10)) * T + & - B(K + 11)) * T + B(K + 12) - Y = Y * Y - Y = Y * Y - Y = Y * Y - Y = 1 - Y * Y - ELSE - Y = 1 - END IF - IF (X .LT. 0) Y = -Y - DERF1 = Y - END FUNCTION DERF1 - -!+---+-----------------------------------------------------------------+ -! - subroutine radar_init - - IMPLICIT NONE - INTEGER:: n - PI5 = PI*PI*PI*PI*PI - lamda4 = lamda_radar*lamda_radar*lamda_radar*lamda_radar - m_w_0 = m_complex_water_ray (lamda_radar, 0.0d0) - m_i_0 = m_complex_ice_maetzler (lamda_radar, 0.0d0) - K_w = (ABS( (m_w_0*m_w_0 - 1.0) /(m_w_0*m_w_0 + 2.0) ))**2 - - do n = 1, nbins+1 - simpson(n) = 0.0d0 - enddo - do n = 1, nbins-1, 2 - simpson(n) = simpson(n) + basis(1) - simpson(n+1) = simpson(n+1) + basis(2) - simpson(n+2) = simpson(n+2) + basis(3) - enddo - - do n = 1, slen - mixingrulestring_s(n:n) = char(0) - matrixstring_s(n:n) = char(0) - inclusionstring_s(n:n) = char(0) - hoststring_s(n:n) = char(0) - hostmatrixstring_s(n:n) = char(0) - hostinclusionstring_s(n:n) = char(0) - mixingrulestring_g(n:n) = char(0) - matrixstring_g(n:n) = char(0) - inclusionstring_g(n:n) = char(0) - hoststring_g(n:n) = char(0) - hostmatrixstring_g(n:n) = char(0) - hostinclusionstring_g(n:n) = char(0) - enddo - - mixingrulestring_s = 'maxwellgarnett' - hoststring_s = 'air' - matrixstring_s = 'water' - inclusionstring_s = 'spheroidal' - hostmatrixstring_s = 'icewater' - hostinclusionstring_s = 'spheroidal' - - mixingrulestring_g = 'maxwellgarnett' - hoststring_g = 'air' - matrixstring_g = 'water' - inclusionstring_g = 'spheroidal' - hostmatrixstring_g = 'icewater' - hostinclusionstring_g = 'spheroidal' - - end subroutine radar_init -!+---+-----------------------------------------------------------------+ - - COMPLEX*16 FUNCTION m_complex_water_ray(lambda,T) - -! Complex refractive Index of Water as function of Temperature T -! [deg C] and radar wavelength lambda [m]; valid for -! lambda in [0.001,1.0] m; T in [-10.0,30.0] deg C -! after Ray (1972) - - IMPLICIT NONE - REAL(kind=selected_real_kind(12)), INTENT(IN):: T,lambda - REAL(kind=selected_real_kind(12)):: epsinf,epss,epsr,epsi - REAL(kind=selected_real_kind(12)):: alpha,lambdas,sigma,nenner - COMPLEX*16, PARAMETER:: i = (0d0,1d0) - - epsinf = 5.27137d0 + 0.02164740d0 * T - 0.00131198d0 * T*T - epss = 78.54d+0 * (1.0 - 4.579d-3 * (T - 25.0) & - + 1.190d-5 * (T - 25.0)*(T - 25.0) & - - 2.800d-8 * (T - 25.0)*(T - 25.0)*(T - 25.0)) - alpha = -16.8129d0/(T+273.16) + 0.0609265d0 - lambdas = 0.00033836d0 * exp(2513.98d0/(T+273.16)) * 1e-2 - - nenner = 1.d0+2.d0*(lambdas/lambda)**(1d0-alpha)*sin(alpha*PI*0.5) & - + (lambdas/lambda)**(2d0-2d0*alpha) - epsr = epsinf + ((epss-epsinf) * ((lambdas/lambda)**(1d0-alpha) & - * sin(alpha*PI*0.5)+1d0)) / nenner - epsi = ((epss-epsinf) * ((lambdas/lambda)**(1d0-alpha) & - * cos(alpha*PI*0.5)+0d0)) / nenner & - + lambda*1.25664/1.88496 - - m_complex_water_ray = SQRT(CMPLX(epsr,-epsi)) - - END FUNCTION m_complex_water_ray - -!+---+-----------------------------------------------------------------+ - - COMPLEX*16 FUNCTION m_complex_ice_maetzler(lambda,T) - -! complex refractive index of ice as function of Temperature T -! [deg C] and radar wavelength lambda [m]; valid for -! lambda in [0.0001,30] m; T in [-250.0,0.0] C -! Original comment from the Matlab-routine of Prof. Maetzler: -! Function for calculating the relative permittivity of pure ice in -! the microwave region, according to C. Maetzler, "Microwave -! properties of ice and snow", in B. Schmitt et al. (eds.) Solar -! System Ices, Astrophys. and Space Sci. Library, Vol. 227, Kluwer -! Academic Publishers, Dordrecht, pp. 241-257 (1998). Input: -! TK = temperature (K), range 20 to 273.15 -! f = frequency in GHz, range 0.01 to 3000 - - IMPLICIT NONE - REAL(kind=selected_real_kind(12)), INTENT(IN):: T,lambda - REAL(kind=selected_real_kind(12)):: f,c,TK,B1,B2,b,deltabeta,betam,beta,theta,alfa - - c = 2.99d8 - TK = T + 273.16 - f = c / lambda * 1d-9 - - B1 = 0.0207 - B2 = 1.16d-11 - b = 335.0d0 - deltabeta = EXP(-10.02 + 0.0364*(TK-273.16)) - betam = (B1/TK) * ( EXP(b/TK) / ((EXP(b/TK)-1)**2) ) + B2*f*f - beta = betam + deltabeta - theta = 300. / TK - 1. - alfa = (0.00504d0 + 0.0062d0*theta) * EXP(-22.1d0*theta) - m_complex_ice_maetzler = 3.1884 + 9.1e-4*(TK-273.16) - m_complex_ice_maetzler = m_complex_ice_maetzler & - + CMPLX(0.0d0, (alfa/f + beta*f)) - m_complex_ice_maetzler = SQRT(CONJG(m_complex_ice_maetzler)) - - END FUNCTION m_complex_ice_maetzler -!+---+-----------------------------------------------------------------+ - - subroutine rayleigh_soak_wetgraupel (x_g, a_geo, b_geo, fmelt, & - meltratio_outside, m_w, m_i, lambda, C_back, & - mixingrule,matrix,inclusion, & - host,hostmatrix,hostinclusion) - - IMPLICIT NONE - - REAL(kind=selected_real_kind(12)), INTENT(in):: x_g, a_geo, b_geo, fmelt, lambda, & - meltratio_outside - REAL(kind=selected_real_kind(12)), INTENT(out):: C_back - COMPLEX*16, INTENT(in):: m_w, m_i - CHARACTER(len=*), INTENT(in):: mixingrule, matrix, inclusion, & - host, hostmatrix, hostinclusion - - COMPLEX*16:: m_core, m_air - REAL(kind=selected_real_kind(12)):: D_large, D_g, rhog, x_w, xw_a, fm, fmgrenz, & - volg, vg, volair, volice, volwater, & - meltratio_outside_grenz, mra - INTEGER:: error - real :: rho_i, rho_w - - rho_i = 900. - rho_w = 1000. - - -! refractive index of air: - m_air = (1.0d0,0.0d0) - -! Limiting the degree of melting --- for safety: - fm = DMAX1(DMIN1(fmelt, 1.0d0), 0.0d0) -! Limiting the ratio of (melting on outside)/(melting on inside): - mra = DMAX1(DMIN1(meltratio_outside, 1.0d0), 0.0d0) - -! ! The relative portion of meltwater melting at outside should increase -! ! from the given input value (between 0 and 1) -! ! to 1 as the degree of melting approaches 1, -! ! so that the melting particle "converges" to a water drop. -! ! Simplest assumption is linear: - mra = mra + (1.0d0-mra)*fm - - x_w = x_g * fm - - D_g = a_geo * x_g**b_geo - - if (D_g .ge. 1d-12) then - - vg = PI/6. * D_g**3 - rhog = DMAX1(DMIN1(x_g / vg, DBLE(rho_i)), 10.0d0) - vg = x_g / rhog - - meltratio_outside_grenz = 1.0d0 - rhog / rho_w - - if (mra .le. meltratio_outside_grenz) then - !..In this case, it cannot happen that, during melting, all the - !.. air inclusions within the ice particle get filled with - !.. meltwater. This only happens at the end of all melting. - volg = vg * (1.0d0 - mra * fm) - - else - !..In this case, at some melting degree fm, all the air - !.. inclusions get filled with meltwater. - fmgrenz=(rho_i-rhog)/(mra*rho_i-rhog+rho_i*rhog/rho_w) - - if (fm .le. fmgrenz) then - !.. not all air pockets are filled: - volg = (1.0 - mra * fm) * vg - else - !..all air pockets are filled with meltwater, now the - !.. entire ice sceleton melts homogeneously: - volg = (x_g - x_w) / rho_i + x_w / rho_w - endif - - endif - - D_large = (6.0 / PI * volg) ** (1./3.) - volice = (x_g - x_w) / (volg * rho_i) - volwater = x_w / (rho_w * volg) - volair = 1.0 - volice - volwater - - !..complex index of refraction for the ice-air-water mixture - !.. of the particle: - m_core = get_m_mix_nested (m_air, m_i, m_w, volair, volice, & - volwater, mixingrule, host, matrix, inclusion, & - hostmatrix, hostinclusion, error) - if (error .ne. 0) then - C_back = 0.0d0 - return - endif - - !..Rayleigh-backscattering coefficient of melting particle: - C_back = (ABS((m_core**2-1.0d0)/(m_core**2+2.0d0)))**2 & - * PI5 * D_large**6 / lamda4 - - else - C_back = 0.0d0 - endif - - end subroutine rayleigh_soak_wetgraupel -!+---+-----------------------------------------------------------------+ - - complex*16 function get_m_mix_nested (m_a, m_i, m_w, volair, & - volice, volwater, mixingrule, host, matrix, & - inclusion, hostmatrix, hostinclusion, cumulerror) - - IMPLICIT NONE - - REAL(kind=selected_real_kind(12)), INTENT(in):: volice, volair, volwater - COMPLEX*16, INTENT(in):: m_a, m_i, m_w - CHARACTER(len=*), INTENT(in):: mixingrule, host, matrix, & - inclusion, hostmatrix, hostinclusion - INTEGER, INTENT(out):: cumulerror - - REAL(kind=selected_real_kind(12)):: vol1, vol2 - COMPLEX*16:: mtmp - INTEGER:: error - - !..Folded: ( (m1 + m2) + m3), where m1,m2,m3 could each be - !.. air, ice, or water - - cumulerror = 0 - get_m_mix_nested = CMPLX(1.0d0,0.0d0) - - if (host .eq. 'air') then - - if (matrix .eq. 'air') then - write(mp_debug,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix - !bloss CALL wrf_debug(150, mp_debug) - cumulerror = cumulerror + 1 - else - vol1 = volice / MAX(volice+volwater,1d-10) - vol2 = 1.0d0 - vol1 - mtmp = get_m_mix (m_a, m_i, m_w, 0.0d0, vol1, vol2, & - mixingrule, matrix, inclusion, error) - cumulerror = cumulerror + error - - if (hostmatrix .eq. 'air') then - get_m_mix_nested = get_m_mix (m_a, mtmp, 2.0*m_a, & - volair, (1.0d0-volair), 0.0d0, mixingrule, & - hostmatrix, hostinclusion, error) - cumulerror = cumulerror + error - elseif (hostmatrix .eq. 'icewater') then - get_m_mix_nested = get_m_mix (m_a, mtmp, 2.0*m_a, & - volair, (1.0d0-volair), 0.0d0, mixingrule, & - 'ice', hostinclusion, error) - cumulerror = cumulerror + error - else - write(mp_debug,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', & - hostmatrix - !bloss CALL wrf_debug(150, mp_debug) - cumulerror = cumulerror + 1 - endif - endif - - elseif (host .eq. 'ice') then - - if (matrix .eq. 'ice') then - write(mp_debug,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix - !bloss CALL wrf_debug(150, mp_debug) - cumulerror = cumulerror + 1 - else - vol1 = volair / MAX(volair+volwater,1d-10) - vol2 = 1.0d0 - vol1 - mtmp = get_m_mix (m_a, m_i, m_w, vol1, 0.0d0, vol2, & - mixingrule, matrix, inclusion, error) - cumulerror = cumulerror + error - - if (hostmatrix .eq. 'ice') then - get_m_mix_nested = get_m_mix (mtmp, m_i, 2.0*m_a, & - (1.0d0-volice), volice, 0.0d0, mixingrule, & - hostmatrix, hostinclusion, error) - cumulerror = cumulerror + error - elseif (hostmatrix .eq. 'airwater') then - get_m_mix_nested = get_m_mix (mtmp, m_i, 2.0*m_a, & - (1.0d0-volice), volice, 0.0d0, mixingrule, & - 'air', hostinclusion, error) - cumulerror = cumulerror + error - else - write(mp_debug,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', & - hostmatrix - !bloss CALL wrf_debug(150, mp_debug) - cumulerror = cumulerror + 1 - endif - endif - - elseif (host .eq. 'water') then - - if (matrix .eq. 'water') then - write(mp_debug,*) 'GET_M_MIX_NESTED: bad matrix: ', matrix - !bloss CALL wrf_debug(150, mp_debug) - cumulerror = cumulerror + 1 - else - vol1 = volair / MAX(volice+volair,1d-10) - vol2 = 1.0d0 - vol1 - mtmp = get_m_mix (m_a, m_i, m_w, vol1, vol2, 0.0d0, & - mixingrule, matrix, inclusion, error) - cumulerror = cumulerror + error - - if (hostmatrix .eq. 'water') then - get_m_mix_nested = get_m_mix (2.0d0*m_a, mtmp, m_w, & - 0.0d0, (1.0d0-volwater), volwater, mixingrule, & - hostmatrix, hostinclusion, error) - cumulerror = cumulerror + error - elseif (hostmatrix .eq. 'airice') then - get_m_mix_nested = get_m_mix (2.0d0*m_a, mtmp, m_w, & - 0.0d0, (1.0d0-volwater), volwater, mixingrule, & - 'ice', hostinclusion, error) - cumulerror = cumulerror + error - else - write(mp_debug,*) 'GET_M_MIX_NESTED: bad hostmatrix: ', & - hostmatrix - !bloss CALL wrf_debug(150, mp_debug) - cumulerror = cumulerror + 1 - endif - endif - - elseif (host .eq. 'none') then - - get_m_mix_nested = get_m_mix (m_a, m_i, m_w, & - volair, volice, volwater, mixingrule, & - matrix, inclusion, error) - cumulerror = cumulerror + error - - else - write(mp_debug,*) 'GET_M_MIX_NESTED: unknown matrix: ', host - !bloss CALL wrf_debug(150, mp_debug) - cumulerror = cumulerror + 1 - endif - - IF (cumulerror .ne. 0) THEN - write(mp_debug,*) 'GET_M_MIX_NESTED: error encountered' - !bloss CALL wrf_debug(150, mp_debug) - get_m_mix_nested = CMPLX(1.0d0,0.0d0) - endif - - end function get_m_mix_nested - -!+---+-----------------------------------------------------------------+ - - COMPLEX*16 FUNCTION get_m_mix (m_a, m_i, m_w, volair, volice, & - volwater, mixingrule, matrix, inclusion, error) - - IMPLICIT NONE - - REAL(kind=selected_real_kind(12)), INTENT(in):: volice, volair, volwater - COMPLEX*16, INTENT(in):: m_a, m_i, m_w - CHARACTER(len=*), INTENT(in):: mixingrule, matrix, inclusion - INTEGER, INTENT(out):: error - - error = 0 - get_m_mix = CMPLX(1.0d0,0.0d0) - - if (mixingrule .eq. 'maxwellgarnett') then - if (matrix .eq. 'ice') then - get_m_mix = m_complex_maxwellgarnett(volice, volair, volwater, & - m_i, m_a, m_w, inclusion, error) - elseif (matrix .eq. 'water') then - get_m_mix = m_complex_maxwellgarnett(volwater, volair, volice, & - m_w, m_a, m_i, inclusion, error) - elseif (matrix .eq. 'air') then - get_m_mix = m_complex_maxwellgarnett(volair, volwater, volice, & - m_a, m_w, m_i, inclusion, error) - else - write(mp_debug,*) 'GET_M_MIX: unknown matrix: ', matrix - !bloss CALL wrf_debug(150, mp_debug) - error = 1 - endif - - else - write(mp_debug,*) 'GET_M_MIX: unknown mixingrule: ', mixingrule - !bloss CALL wrf_debug(150, mp_debug) - error = 2 - endif - - if (error .ne. 0) then - write(mp_debug,*) 'GET_M_MIX: error encountered' - !bloss CALL wrf_debug(150, mp_debug) - endif - - END FUNCTION get_m_mix - -!+---+-----------------------------------------------------------------+ - - COMPLEX*16 FUNCTION m_complex_maxwellgarnett(vol1, vol2, vol3, & - m1, m2, m3, inclusion, error) - - IMPLICIT NONE - - COMPLEX*16 :: m1, m2, m3 - REAL(kind=selected_real_kind(12)) :: vol1, vol2, vol3 - CHARACTER(len=*) :: inclusion - - COMPLEX*16 :: beta2, beta3, m1t, m2t, m3t - INTEGER, INTENT(out) :: error - - error = 0 - - if (DABS(vol1+vol2+vol3-1.0d0) .gt. 1d-6) then - write(mp_debug,*) 'M_COMPLEX_MAXWELLGARNETT: sum of the ', & - 'partial volume fractions is not 1...ERROR' - !bloss CALL wrf_debug(150, mp_debug) - m_complex_maxwellgarnett=CMPLX(-999.99d0,-999.99d0) - error = 1 - return - endif - - m1t = m1**2 - m2t = m2**2 - m3t = m3**2 - - if (inclusion .eq. 'spherical') then - beta2 = 3.0d0*m1t/(m2t+2.0d0*m1t) - beta3 = 3.0d0*m1t/(m3t+2.0d0*m1t) - elseif (inclusion .eq. 'spheroidal') then - beta2 = 2.0d0*m1t/(m2t-m1t) * (m2t/(m2t-m1t)*LOG(m2t/m1t)-1.0d0) - beta3 = 2.0d0*m1t/(m3t-m1t) * (m3t/(m3t-m1t)*LOG(m3t/m1t)-1.0d0) - else - write(mp_debug,*) 'M_COMPLEX_MAXWELLGARNETT: ', & - 'unknown inclusion: ', inclusion - !bloss CALL wrf_debug(150, mp_debug) - m_complex_maxwellgarnett=CMPLX(-999.99d0,-999.99d0, kind=kind(0.d0)) - error = 1 - return - endif - - m_complex_maxwellgarnett = & - SQRT(((1.0d0-vol2-vol3)*m1t + vol2*beta2*m2t + vol3*beta3*m3t) / & - (1.0d0-vol2-vol3+vol2*beta2+vol3*beta3)) - - END FUNCTION m_complex_maxwellgarnett - -!+---+-----------------------------------------------------------------+ -!..Compute radar reflectivity assuming 10 cm wavelength radar and using -!.. Rayleigh approximation. Only complication is melted snow/graupel -!.. which we treat as water-coated ice spheres and use Uli Blahak's -!.. library of routines. The meltwater fraction is simply the amount -!.. of frozen species remaining from what initially existed at the -!.. melting level interface. -!+---+-----------------------------------------------------------------+ - subroutine calc_refl10cm (qv1d, qr1d, qs1d, qg1d, t1d, p1d, dBZ, & - kts, kte, ii, jj, nr1d, ns1d, ng1d) - - IMPLICIT NONE - -!..Sub arguments - INTEGER, INTENT(IN):: kts, kte, ii, jj - REAL, DIMENSION(kts:kte), INTENT(IN):: & - qv1d, qr1d, qs1d, qg1d, t1d, p1d, nr1d, ns1d, ng1d - REAL, DIMENSION(kts:kte), INTENT(INOUT):: dBZ - -!..Local variables - REAL, DIMENSION(kts:kte):: temp, pres, qv, rho - REAL, DIMENSION(kts:kte):: rr, rs, rg,rnr,rns,rng - - REAL(kind=selected_real_kind(12)), DIMENSION(kts:kte):: ilamr, ilamg, N0_r, N0_g,ilams,n0_s - - REAL, DIMENSION(kts:kte):: ze_rain, ze_snow, ze_graupel - - REAL(kind=selected_real_kind(12)):: lamg - REAL(kind=selected_real_kind(12)):: fmelt_s, fmelt_g - - INTEGER:: i, k, k_0 - LOGICAL:: melti - LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg - -!..Single melting snow/graupel particle 70% meltwater on external sfc - REAL(kind=selected_real_kind(12)), PARAMETER:: melt_outside_s = 0.7d0 - REAL(kind=selected_real_kind(12)), PARAMETER:: melt_outside_g = 0.7d0 - - REAL(kind=selected_real_kind(12)):: cback, x, eta, f_d - -! hm added parameter - REAL R1,t_0,dumlams,dumlamr,dumlamg,dumn0s,dumn0r,dumn0g,ocms,obms,ocmg,obmg - - integer n - - R1 = 1.E-12 - t_0 = 273.15 - -!+---+ - - do k = kts, kte - dBZ(k) = -35.0 - enddo - -!+---+-----------------------------------------------------------------+ -!..Put column of data into local arrays. -!+---+-----------------------------------------------------------------+ - do k = kts, kte - temp(k) = t1d(k) - qv(k) = MAX(1.E-10, qv1d(k)) - pres(k) = p1d(k) - rho(k) = 0.622*pres(k)/(R*temp(k)*(qv(k)+0.622)) - if (qr1d(k) .gt. R1) then - rr(k) = qr1d(k)*rho(k) - L_qr(k) = .true. - else - rr(k) = R1 - L_qr(k) = .false. - endif - if (qs1d(k) .gt. R1) then - rs(k) = qs1d(k)*rho(k) - L_qs(k) = .true. - else - rs(k) = R1 - L_qs(k) = .false. - endif - if (qg1d(k) .gt. R1) then - rg(k) = qg1d(k)*rho(k) - L_qg(k) = .true. - else - rg(k) = R1 - L_qg(k) = .false. - endif - -! hm add number concentration - if (nr1d(k) .gt. R1) then - rnr(k) = nr1d(k)*rho(k) - else - rnr(k) = R1 - endif - if (ns1d(k) .gt. R1) then - rns(k) = ns1d(k)*rho(k) - else - rns(k) = R1 - endif - if (ng1d(k) .gt. R1) then - rng(k) = ng1d(k)*rho(k) - else - rng(k) = R1 - endif - - enddo - -!+---+-----------------------------------------------------------------+ -!..Calculate y-intercept, slope, and useful moments for snow. -!+---+-----------------------------------------------------------------+ - do k = kts, kte - -! compute moments for snow - -! calculate slope and intercept parameter - - dumLAMS = (CONS1*rns(K)/rs(K))**(1./DS) - dumN0S = rns(K)*dumLAMS/rho(k) - -! CHECK FOR SLOPE to make sure min/max bounds are not exceeded - -! ADJUST VARS - - IF (dumLAMS.LT.LAMMINS) THEN - dumLAMS = LAMMINS - dumN0S = dumLAMS**4*rs(K)/CONS1 - ELSE IF (dumLAMS.GT.LAMMAXS) THEN - dumLAMS = LAMMAXS - dumN0S = dumLAMS**4*rs(k)/CONS1 - end if - - ilams(k)=1./dumlams - n0_s(k)=dumn0s - - enddo - -!+---+-----------------------------------------------------------------+ -!..Calculate y-intercept, slope values for graupel. -!+---+-----------------------------------------------------------------+ - - do k = kte, kts, -1 - - -! calculate slope and intercept parameter - - dumLAMg = (CONS2*rng(K)/rg(K))**(1./Dg) - dumN0g = rng(K)*dumLAMg/rho(k) - -! CHECK FOR SLOPE to make sure min/max bounds are not exceeded - -! ADJUST VARS - - IF (dumLAMg.LT.LAMMINg) THEN - dumLAMg = LAMMINg - dumN0g = dumLAMg**4*rg(K)/CONS2 - ELSE IF (dumLAMg.GT.LAMMAXg) THEN - dumLAMg = LAMMAXg - dumN0g = dumLAMg**4*rg(k)/CONS2 - end if - - ilamg(k)=1./dumlamg - n0_g(k)=dumn0g - - enddo - -!+---+-----------------------------------------------------------------+ -!..Calculate y-intercept & slope values for rain. -!+---+-----------------------------------------------------------------+ - - do k = kte, kts, -1 - -! calculate slope and intercept parameter - - dumLAMr = (PI*RHOW*rnr(K)/rr(K))**(1./3.) - dumN0r = rnr(K)*dumLAMr/rho(k) - -! CHECK FOR SLOPE to make sure min/max bounds are not exceeded - -! ADJUST VARS - - IF (dumLAMr.LT.LAMMINr) THEN - dumLAMr = LAMMINr - dumN0r = dumLAMr**4*rr(K)/(PI*RHOW) - ELSE IF (dumLAMr.GT.LAMMAXr) THEN - dumLAMr = LAMMAXr - dumN0r = dumLAMr**4*rr(k)/(PI*RHOW) - end if - - ilamr(k)=1./dumlamr - n0_r(k)=dumn0r - - enddo - - melti = .false. - k_0 = kts - do k = kte-1, kts, -1 - if ( (temp(k).gt. T_0) .and. (rr(k).gt. 0.001e-3) & - .and. ((rs(k+1)+rg(k+1)).gt. 0.01e-3) ) then - k_0 = MAX(k+1, k_0) - melti=.true. - goto 195 - endif - enddo - 195 continue - -!+---+-----------------------------------------------------------------+ -!..Assume Rayleigh approximation at 10 cm wavelength. Rain (all temps) -!.. and non-water-coated snow and graupel when below freezing are -!.. simple. Integrations of m(D)*m(D)*N(D)*dD. -!+---+-----------------------------------------------------------------+ - - do k = kts, kte - ze_rain(k) = 1.e-22 - ze_snow(k) = 1.e-22 - ze_graupel(k) = 1.e-22 - if (L_qr(k)) ze_rain(k) = N0_r(k)*720.*ilamr(k)**7 - - if (L_qs(k)) ze_snow(k) = (0.176/0.93) * (6.0/PI)*(6.0/PI) & - * (pi*rhosn/6./900.)*(pi*rhosn/6./900.) & - * N0_s(k)*720.*ilams(k)**7 - if (L_qg(k)) ze_graupel(k) = (0.176/0.93) * (6.0/PI)*(6.0/PI) & - * (pi*rhog/6./900.)* (pi*rhog/6./900.) & - * N0_g(k)*720.*ilamg(k)**7 - enddo - -!+---+-----------------------------------------------------------------+ -!..Special case of melting ice (snow/graupel) particles. Assume the -!.. ice is surrounded by the liquid water. Fraction of meltwater is -!.. extremely simple based on amount found above the melting level. -!.. Uses code from Uli Blahak (rayleigh_soak_wetgraupel and supporting -!.. routines). -!+---+-----------------------------------------------------------------+ - - if (melti .and. k_0.ge.2) then - do k = k_0-1, 1, -1 - -!..Reflectivity contributed by melting snow - fmelt_s = DMIN1(1.0d0-rs(k)/rs(k_0), 1.0d0) - if (fmelt_s.gt.0.01d0 .and. fmelt_s.lt.0.99d0 .and. & - rs(k).gt.R1) then - eta = 0.d0 - obms = 1./ds - ocms = (1./(pi*rhosn/6.))**obms - do n = 1, nbs - x = pi*rhosn/6. * Dds(n)**3 - call rayleigh_soak_wetgraupel (x, DBLE(ocms), DBLE(obms), & - fmelt_s, melt_outside_s, m_w_0, m_i_0, lamda_radar, & - CBACK, mixingrulestring_s, matrixstring_s, & - inclusionstring_s, hoststring_s, & - hostmatrixstring_s, hostinclusionstring_s) - f_d = N0_s(k)* DEXP(-Dds(n)/ilams(k)) - eta = eta + f_d * CBACK * simpson(n) * dts(n) - - enddo - ze_snow(k) = SNGL(lamda4 / (pi5 * K_w) * eta) - endif - - -!..Reflectivity contributed by melting graupel - - fmelt_g = DMIN1(1.0d0-rg(k)/rg(k_0), 1.0d0) - if (fmelt_g.gt.0.01d0 .and. fmelt_g.lt.0.99d0 .and. & - rg(k).gt.R1) then - eta = 0.d0 - lamg = 1./ilamg(k) - obmg = 1./dg - ocmg = (1./(pi*rhog/6.))**obmg - do n = 1, nbg - x = pi*rhog/6. * Ddg(n)**3 - call rayleigh_soak_wetgraupel (x, DBLE(ocmg), DBLE(obmg), & - fmelt_g, melt_outside_g, m_w_0, m_i_0, lamda_radar, & - CBACK, mixingrulestring_g, matrixstring_g, & - inclusionstring_g, hoststring_g, & - hostmatrixstring_g, hostinclusionstring_g) - f_d = N0_g(k)* DEXP(-lamg*Ddg(n)) - eta = eta + f_d * CBACK * simpson(n) * dtg(n) - enddo - ze_graupel(k) = SNGL(lamda4 / (pi5 * K_w) * eta) - endif - - enddo - endif - - do k = kte, kts, -1 - dBZ(k) = 10.*log10((ze_rain(k)+ze_snow(k)+ze_graupel(k))*1.d18) - enddo - - - end subroutine calc_refl10cm -#ifdef CLUBB_CRM -!------------------------------------------------------------------------------- - SUBROUTINE POSITIVE_QV_ADJ( QV, QC, QR, QI, & - QS, QG, T_IN_K ) -! Description: -! The following was produced by UW-Milwaukee to prevent vapor water mixing -! ratio from becoming negative. This is necessary in the event that a -! process, e.g. depositional growth of ice, causes negative vapor. This -! appears to happen in some circumstances due to the code that will set -! vapor to saturation w.r.t to liquid when we have subgrid scale cloud -! fraction greater than our 1% threshold. - -! References: -! None -!------------------------------------------------------------------------------- - use crmx_constants_clubb, only: Lv, Ls, Cp ! Constant(s) - - IMPLICIT NONE - - ! Constant Parameters - ! The value of epsilon was picked based on how small a 4 bytes float we can - ! add to vapor without it being lost to catastophic round-off. For an 8 - ! byte float a smaller value might be used -dschanen 5 Oct 2009. - REAL, PARAMETER :: & - EPS = 1.E-12 ! Small value of vapor [kg/kg] - - ! Input/Output Variables - REAL, INTENT(INOUT) :: & - QV, & ! Vapor water mixing ratio [kg/kg] - QC, & ! Cloud water mixing ratio [kg/kg] - QR, & ! Rain water mixing ratio [kg/kg] - QI, & ! Ice water mixing ratio [kg/kg] - QS, & ! Snow water mixing ratio [kg/kg] - QG ! Graupel water mixing ratio [kg/kg] - - REAL, INTENT(INOUT) :: & - T_IN_K ! Absolute Temperature [K] - - ! Local Variables - REAL :: & - QT_COND_LIQ, & ! Total water in liquid phase [kg/kg] - QT_COND_ICE, & ! Total water in ice phase [kg/kg] - QT_TOTAL ! Total water ice + liquid [kg/kg] - - REAL :: & - DELTA_QV, DELTA_QT_COND_LIQ, DELTA_QT_COND_ICE, REDUCE_COEF - - ! ---- Begin Code ---- - - ! If vapor is greater than or equal to epsilon, then exit. - IF ( QV >= EPS ) RETURN - -! PRINT *, "BEFORE", QV, QC, QR, QI, QS, QG, T_IN_K - - ! Determine total water - QT_COND_LIQ = QC + QR - - QT_COND_ICE = 0.0 - ! Add ice if it is enabled - IF ( ILIQ == 0 ) THEN - QT_COND_ICE = QT_COND_ICE + QS + QI - END IF - - ! Add graupel if it is enabled - IF ( IGRAUP == 0 ) THEN - QT_COND_ICE = QT_COND_ICE + QG - END IF - - ! Total water mixing ratio = vapor + liquid + ice - QT_TOTAL = QV + QT_COND_LIQ + QT_COND_ICE - - ! If the total water available at this altitude is too small, - ! then we need to apply hole-filling globally instead. - IF ( QT_TOTAL < 2 * EPS ) RETURN - - ! Determine delta qv, the amount to change vapor water mixing ratio by. - DELTA_QV = EPS - QV - - ! Set QV to the minimum value - QV = EPS - - ! Reduce other variables according to the amount we've increased vapor by, - ! in order to conserve total water. - REDUCE_COEF = 1. - ( DELTA_QV / (QT_COND_LIQ + QT_COND_ICE) ) - - ! Compute total change in warm-phase variables - QC = QC * REDUCE_COEF - QR = QR * REDUCE_COEF - - DELTA_QT_COND_LIQ = QT_COND_LIQ - ( QC + QR ) - - ! Compute total change in ice-phase variables - - DELTA_QT_COND_ICE = 0.0 - IF ( ILIQ == 0 ) THEN - QI = QI * REDUCE_COEF - QS = QS * REDUCE_COEF - - IF ( IGRAUP /= 0 ) THEN - DELTA_QT_COND_ICE = QT_COND_ICE - ( QI + QS ) - END IF - END IF - - IF ( IGRAUP == 0 ) THEN - QG = QG * REDUCE_COEF - - DELTA_QT_COND_ICE = QT_COND_ICE - ( QI + QS + QG ) - END IF - - ! Adjust absolute temperature - T_IN_K = T_IN_K - ( Lv / Cp * ( DELTA_QT_COND_LIQ ) ) & - - ( Ls / Cp * ( DELTA_QT_COND_ICE ) ) - -! PRINT *, "AFTER", QV, QC, QR, QI, QS, QG, T_IN_K - RETURN - END SUBROUTINE POSITIVE_QV_ADJ -#endif /*CLUBB_CRM*/ - -END MODULE crmx_module_mp_GRAUPEL diff --git a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_cloud.F90 b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_cloud.F90 deleted file mode 100644 index 749678c89c..0000000000 --- a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_cloud.F90 +++ /dev/null @@ -1,133 +0,0 @@ - -subroutine cloud - -! Condensation of cloud water/cloud ice. - -use crmx_vars -use crmx_microphysics -use crmx_micro_params -use crmx_params - -implicit none - -integer i,j,k, kb, kc -real dtabs, tabs1, an, bn, ap, bp, om, ag, omp -real fac1,fac2 -real fff,dfff,qsatt,dqsat -real lstarn,dlstarn,lstarp,dlstarp -integer niter - -an = 1./(tbgmax-tbgmin) -bn = tbgmin * an -ap = 1./(tprmax-tprmin) -bp = tprmin * ap -fac1 = fac_cond+(1+bp)*fac_fus -fac2 = fac_fus*ap -ag = 1./(tgrmax-tgrmin) - -!call t_startf ('cloud') - -do k = 1, nzm - do j = 1, ny - do i = 1, nx - - q(i,j,k)=max(0.,q(i,j,k)) - - -! Initail guess for temperature assuming no cloud water/ice: - - - tabs(i,j,k) = t(i,j,k)-gamaz(k) - tabs1=(tabs(i,j,k)+fac1*qp(i,j,k))/(1.+fac2*qp(i,j,k)) - -! Warm cloud: - - if(tabs1.ge.tbgmax) then - - tabs1=tabs(i,j,k)+fac_cond*qp(i,j,k) - qsatt = qsatw_crm(tabs1,pres(k)) - -! Ice cloud: - - elseif(tabs1.le.tbgmin) then - - tabs1=tabs(i,j,k)+fac_sub*qp(i,j,k) - qsatt = qsati_crm(tabs1,pres(k)) - -! Mixed-phase cloud: - - else - - om = an*tabs1-bn - qsatt = om*qsatw_crm(tabs1,pres(k))+(1.-om)*qsati_crm(tabs1,pres(k)) - - endif - - -! Test if condensation is possible: - - - if(q(i,j,k).gt.qsatt) then - - niter=0 - dtabs = 100. - do while(abs(dtabs).gt.0.01.and.niter.lt.10) - if(tabs1.ge.tbgmax) then - om=1. - lstarn=fac_cond - dlstarn=0. - qsatt=qsatw_crm(tabs1,pres(k)) - dqsat=dtqsatw_crm(tabs1,pres(k)) - else if(tabs1.le.tbgmin) then - om=0. - lstarn=fac_sub - dlstarn=0. - qsatt=qsati_crm(tabs1,pres(k)) - dqsat=dtqsati_crm(tabs1,pres(k)) - else - om=an*tabs1-bn - lstarn=fac_cond+(1.-om)*fac_fus - dlstarn=an*fac_fus - qsatt=om*qsatw_crm(tabs1,pres(k))+(1.-om)*qsati_crm(tabs1,pres(k)) - dqsat=om*dtqsatw_crm(tabs1,pres(k))+(1.-om)*dtqsati_crm(tabs1,pres(k)) - endif - if(tabs1.ge.tprmax) then - omp=1. - lstarp=fac_cond - dlstarp=0. - else if(tabs1.le.tprmin) then - omp=0. - lstarp=fac_sub - dlstarp=0. - else - omp=ap*tabs1-bp - lstarp=fac_cond+(1.-omp)*fac_fus - dlstarp=ap*fac_fus - endif - fff = tabs(i,j,k)-tabs1+lstarn*(q(i,j,k)-qsatt)+lstarp*qp(i,j,k) - dfff=dlstarn*(q(i,j,k)-qsatt)+dlstarp*qp(i,j,k)-lstarn*dqsat-1. - dtabs=-fff/dfff - niter=niter+1 - tabs1=tabs1+dtabs - end do - - qsatt = qsatt + dqsat * dtabs - qn(i,j,k) = max(0.,q(i,j,k)-qsatt) - - else - - qn(i,j,k) = 0. - - endif - - tabs(i,j,k) = tabs1 - qp(i,j,k) = max(0.,qp(i,j,k)) ! just in case - - end do - end do -end do - -!call t_stopf ('cloud') - -end subroutine cloud - diff --git a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_micro_params.F90 b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_micro_params.F90 deleted file mode 100644 index 9e8a22c8db..0000000000 --- a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_micro_params.F90 +++ /dev/null @@ -1,88 +0,0 @@ -module crmx_micro_params - -use crmx_grid, only: nzm - -implicit none - -! Microphysics stuff: - -! Densities of hydrometeors - -real, parameter :: rhor = 1000. ! Density of water, kg/m3 -real, parameter :: rhos = 100. ! Density of snow, kg/m3 -real, parameter :: rhog = 400. ! Density of graupel, kg/m3 -!real, parameter :: rhog = 917. ! hail - Lin 1983 - -! Temperatures limits for various hydrometeors - -real, parameter :: tbgmin = 253.16 ! Minimum temperature for cloud water., K -real, parameter :: tbgmax = 273.16 ! Maximum temperature for cloud ice, K -real, parameter :: tprmin = 268.16 ! Minimum temperature for rain, K -real, parameter :: tprmax = 283.16 ! Maximum temperature for snow+graupel, K -real, parameter :: tgrmin = 223.16 ! Minimum temperature for snow, K -real, parameter :: tgrmax = 283.16 ! Maximum temperature for graupel, K - -! Terminal velocity coefficients - -real, parameter :: a_rain = 842. ! Coeff.for rain term vel -real, parameter :: b_rain = 0.8 ! Fall speed exponent for rain -real, parameter :: a_snow = 4.84 ! Coeff.for snow term vel -real, parameter :: b_snow = 0.25 ! Fall speed exponent for snow -!real, parameter :: a_grau = 40.7! Krueger (1994) ! Coef. for graupel term vel -real, parameter :: a_grau = 94.5 ! Lin (1983) (rhog=400) -!real, parameter :: a_grau = 127.94! Lin (1983) (rhog=917) -real, parameter :: b_grau = 0.5 ! Fall speed exponent for graupel - -! Autoconversion -#ifdef CLUBB_CRM /*microphysical tuning for CLUBB*/ -real, parameter :: qcw0 = 0.6e-3 ! Threshold for water autoconversion, g/g -real, parameter :: qci0 = 1.e-4 ! Threshold for ice autoconversion, g/g -real, parameter :: alphaelq = 10.e-3 ! autoconversion of cloud water rate coef -real, parameter :: betaelq = 6.0e-3 ! autoconversion of cloud ice rate coef -#else -real, parameter :: qcw0 = 1.e-3 ! Threshold for water autoconversion, g/g -real, parameter :: qci0 = 1.e-4 ! Threshold for ice autoconversion, g/g -real, parameter :: alphaelq = 1.e-3 ! autoconversion of cloud water rate coef -real, parameter :: betaelq = 1.e-3 ! autoconversion of cloud ice rate coef -#endif /*CLUBB_CRM*/ - -! Accretion - -real, parameter :: erccoef = 1.0 ! Rain/Cloud water collection efficiency -real, parameter :: esccoef = 1.0 ! Snow/Cloud water collection efficiency -real, parameter :: esicoef = 0.1 ! Snow/cloud ice collection efficiency -real, parameter :: egccoef = 1.0 ! Graupel/Cloud water collection efficiency -real, parameter :: egicoef = 0.1 ! Graupel/Cloud ice collection efficiency - -! Interseption parameters for exponential size spectra - -real, parameter :: nzeror = 8.e6 ! Intercept coeff. for rain -real, parameter :: nzeros = 3.e6 ! Intersept coeff. for snow -real, parameter :: nzerog = 4.e6 ! Intersept coeff. for graupel -!real, parameter :: nzerog = 4.e4 ! hail - Lin 1993 - -real, parameter :: qp_threshold = 1.e-8 ! minimal rain/snow water content - - -! Misc. microphysics variables - -real*4 gam3 ! Gamma function of 3 -real*4 gams1 ! Gamma function of (3 + b_snow) -real*4 gams2 ! Gamma function of (5 + b_snow)/2 -real*4 gams3 ! Gamma function of (4 + b_snow) -real*4 gamg1 ! Gamma function of (3 + b_grau) -real*4 gamg2 ! Gamma function of (5 + b_grau)/2 -real*4 gamg3 ! Gamma function of (4 + b_grau) -real*4 gamr1 ! Gamma function of (3 + b_rain) -real*4 gamr2 ! Gamma function of (5 + b_rain)/2 -real*4 gamr3 ! Gamma function of (4 + b_rain) - -real accrsc(nzm),accrsi(nzm),accrrc(nzm),coefice(nzm) -real accrgc(nzm),accrgi(nzm) -real evaps1(nzm),evaps2(nzm),evapr1(nzm),evapr2(nzm) -real evapg1(nzm),evapg2(nzm) - -real a_bg, a_pr, a_gr - - -end module crmx_micro_params diff --git a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_microphysics.F90 b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_microphysics.F90 deleted file mode 100644 index 779712df70..0000000000 --- a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_microphysics.F90 +++ /dev/null @@ -1,463 +0,0 @@ -module crmx_microphysics - -! module for original SAM bulk microphysics -! Marat Khairoutdinov, 2006 - -use crmx_grid, only: nx,ny,nzm,nz, dimx1_s,dimx2_s,dimy1_s,dimy2_s ! subdomain grid information -use crmx_params, only: doprecip, docloud, doclubb -use crmx_micro_params -implicit none - -!---------------------------------------------------------------------- -!!! required definitions: - -integer, parameter :: nmicro_fields = 2 ! total number of prognostic water vars - -!!! microphysics prognostic variables are storred in this array: - -real micro_field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm, nmicro_fields) - -integer, parameter :: flag_wmass(nmicro_fields) = (/1,1/) -integer, parameter :: index_water_vapor = 1 ! index for variable that has water vapor -integer, parameter :: index_cloud_ice = 1 ! index for cloud ice (sedimentation) -integer, parameter :: flag_precip(nmicro_fields) = (/0,1/) - -! both variables correspond to mass, not number -integer, parameter :: flag_number(nmicro_fields) = (/0,0/) - -! SAM1MOM 3D microphysical fields are output by default. -integer, parameter :: flag_micro3Dout(nmicro_fields) = (/0,0/) - -real fluxbmk (nx, ny, 1:nmicro_fields) ! surface flux of tracers -real fluxtmk (nx, ny, 1:nmicro_fields) ! top boundary flux of tracers - -!!! these arrays are needed for output statistics: - -real mkwle(nz,1:nmicro_fields) ! resolved vertical flux -real mkwsb(nz,1:nmicro_fields) ! SGS vertical flux -real mkadv(nz,1:nmicro_fields) ! tendency due to vertical advection -real mklsadv(nz,1:nmicro_fields) ! tendency due to large-scale vertical advection -real mkdiff(nz,1:nmicro_fields) ! tendency due to vertical diffusion -real mstor(nz,1:nmicro_fields) ! storage terms of microphysical variables - -!====================================================================== -! UW ADDITIONS - -!bloss: arrays with names/units for microphysical outputs in statistics. -character*3, dimension(nmicro_fields) :: mkname -character*80, dimension(nmicro_fields) :: mklongname -character*10, dimension(nmicro_fields) :: mkunits -real, dimension(nmicro_fields) :: mkoutputscale - -! END UW ADDITIONS -!====================================================================== - -!------------------------------------------------------------------ -! Optional (internal) definitions) - -! make aliases for prognostic variables: -! note that the aliases should be local to microphysics - -real q(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! total nonprecipitating water -real qp(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! total precipitating water -equivalence (q(dimx1_s,dimy1_s,1),micro_field(dimx1_s,dimy1_s,1,1)) -equivalence (qp(dimx1_s,dimy1_s,1),micro_field(dimx1_s,dimy1_s,1,2)) - -real qn(nx,ny,nzm) ! cloud condensate (liquid + ice) - -real qpsrc(nz) ! source of precipitation microphysical processes -real qpevp(nz) ! sink of precipitating water due to evaporation - -real vrain, vsnow, vgrau, crain, csnow, cgrau ! precomputed coefs for precip terminal velocity - -CONTAINS - -! required microphysics subroutines and function: -!---------------------------------------------------------------------- -!!! Read microphysics options from prm file - -subroutine micro_setparm() - ! no user-definable options in SAM1MOM microphysics. -end subroutine micro_setparm - -!---------------------------------------------------------------------- -!!! Initialize microphysics: - - -subroutine micro_init() - -#ifdef CLUBB_CRM - use crmx_params, only: doclubb, doclubbnoninter ! dschanen UWM 21 May 2008 - use crmx_params, only: nclubb -#endif - use crmx_grid, only: nrestart - use crmx_vars, only: q0 - use crmx_params, only: dosmoke - integer k, n -#ifdef CLUBB_CRM -! if ( nclubb /= 1 ) then -! write(0,*) "The namelist parameter nclubb is not equal to 1,", & -! " but SAM single moment microphysics is enabled." -! write(0,*) "This will create unrealistic results in subsaturated grid boxes. ", & -! "Exiting..." -! call task_abort() -! end if -#endif - - a_bg = 1./(tbgmax-tbgmin) - a_pr = 1./(tprmax-tprmin) - a_gr = 1./(tgrmax-tgrmin) - -! if(doprecip) call precip_init() - - if(nrestart.eq.0) then - -#ifndef CRM - micro_field = 0. - do k=1,nzm - q(:,:,k) = q0(k) - end do - qn = 0. -#endif - - fluxbmk = 0. - fluxtmk = 0. - -#ifdef CLUBB_CRM - if ( docloud .or. doclubb ) then -#else - if(docloud) then -#endif -#ifndef CRM - call cloud() -#endif - call micro_diagnose() - end if - if(dosmoke) then - call micro_diagnose() - end if - - end if - - mkwle = 0. - mkwsb = 0. - mkadv = 0. - mkdiff = 0. - mklsadv = 0. - mstor = 0. - - qpsrc = 0. - qpevp = 0. - - mkname(1) = 'QT' - mklongname(1) = 'TOTAL WATER (VAPOR + CONDENSATE)' - mkunits(1) = 'g/kg' - mkoutputscale(1) = 1.e3 - - mkname(2) = 'QP' - mklongname(2) = 'PRECIPITATING WATER' - mkunits(2) = 'g/kg' - mkoutputscale(2) = 1.e3 - -! set mstor to be the inital microphysical mixing ratios - do n=1, nmicro_fields - do k=1, nzm - mstor(k, n) = SUM(micro_field(1:nx,1:ny,k,n)) - end do - end do - -end subroutine micro_init - -!---------------------------------------------------------------------- -!!! fill-in surface and top boundary fluxes: -! -subroutine micro_flux() - - use crmx_vars, only: fluxbq, fluxtq - -#ifdef CLUBB_CRM - ! Added by dschanen UWM - use crmx_params, only: doclubb, doclubb_sfc_fluxes, docam_sfc_fluxes - if ( doclubb .and. (doclubb_sfc_fluxes .or. docam_sfc_fluxes) ) then - ! Add this in later - fluxbmk(:,:,index_water_vapor) = 0.0 - else - fluxbmk(:,:,index_water_vapor) = fluxbq(:,:) - end if -#else - fluxbmk(:,:,index_water_vapor) = fluxbq(:,:) -#endif /*CLUBB_CRM*/ - fluxtmk(:,:,index_water_vapor) = fluxtq(:,:) - -end subroutine micro_flux - -!---------------------------------------------------------------------- -!!! compute local microphysics processes (bayond advection and SGS diffusion): -! -subroutine micro_proc() - - use crmx_grid, only: nstep,dt,icycle - use crmx_params, only: dosmoke -#ifdef CLUBB_CRM - use crmx_params, only: doclubb, doclubbnoninter ! dschanen UWM 21 May 2008 - use crmx_clubbvars, only: cloud_frac - use crmx_vars, only: CF3D - use crmx_grid, only: nzm -#endif - - ! Update bulk coefficient - if(doprecip.and.icycle.eq.1) call precip_init() - - if(docloud) then - call cloud() - if(doprecip) call precip_proc() - call micro_diagnose() - end if - if(dosmoke) then - call micro_diagnose() - end if -#ifdef CLUBB_CRM - if ( doclubb ) then ! -dschanen UWM 21 May 2008 - CF3D(:,:, 1:nzm) = cloud_frac(:,:,2:nzm+1) ! CF3D is used in precip_proc_clubb, - ! so it is set here first +++mhwang -! if(doprecip) call precip_proc() - if(doprecip) call precip_proc_clubb() - call micro_diagnose() - end if -#endif /*CLUBB_CRM*/ - -end subroutine micro_proc - -!---------------------------------------------------------------------- -!!! Diagnose arrays nessesary for dynamical core and statistics: -! -subroutine micro_diagnose() - - use crmx_vars - - real omn, omp - integer i,j,k - - do k=1,nzm - do j=1,ny - do i=1,nx - qv(i,j,k) = q(i,j,k) - qn(i,j,k) - omn = max(0.,min(1.,(tabs(i,j,k)-tbgmin)*a_bg)) - qcl(i,j,k) = qn(i,j,k)*omn - qci(i,j,k) = qn(i,j,k)*(1.-omn) - omp = max(0.,min(1.,(tabs(i,j,k)-tprmin)*a_pr)) - qpl(i,j,k) = qp(i,j,k)*omp - qpi(i,j,k) = qp(i,j,k)*(1.-omp) - end do - end do - end do - - - -end subroutine micro_diagnose - -#ifdef CLUBB_CRM -!--------------------------------------------------------------------- -subroutine micro_update() - -! Description: -! This subroutine essentially does what micro_proc does but does not -! call any microphysics subroutines. We need this so that CLUBB gets a -! properly updated value of ice fed in. -! -! dschanen UWM 7 Jul 2008 -!--------------------------------------------------------------------- - -! call cloud() -! call micro_diagnose() - - call micro_diagnose_clubb() - -end subroutine micro_update - -!--------------------------------------------------------------------- -subroutine micro_adjust( new_qv, new_qc ) -! Description: -! Adjust vapor and liquid water. -! Microphysical variables are stored separately in -! SAM's dynamics + CLUBB ( e.g. qv, qcl, qci) and -! SAM's microphysics. (e.g. q and qn). -! This subroutine stores values of qv, qcl updated by CLUBB -! in the single-moment microphysical variables q and qn. -! -! dschanen UWM 20 May 2008 -!--------------------------------------------------------------------- - - use crmx_vars, only: qci - - implicit none - - real, dimension(nx,ny,nzm), intent(in) :: & - new_qv, & ! Water vapor mixing ratio that has been adjusted by CLUBB [kg/kg] - new_qc ! Cloud water mixing ratio that has been adjusted by CLUBB [kg/kg]. - ! For the single moment microphysics, it is liquid + ice - - q(1:nx,1:ny,1:nzm) = new_qv + new_qc ! Vapor + Liquid + Ice - qn(1:nx,1:ny,1:nzm) = new_qc ! Liquid + Ice - - return -end subroutine micro_adjust - -subroutine micro_diagnose_clubb() - - use crmx_vars - use crmx_constants_clubb, only: fstderr, zero_threshold - use crmx_error_code, only: clubb_at_least_debug_level ! Procedur - - real omn, omp - integer i,j,k - - do k=1,nzm - do j=1,ny - do i=1,nx -! For CLUBB, water vapor and liquid water is used -! so set qcl to qn while qci to zero. This also allows us to call CLUBB -! every nclubb th time step (see sgs_proc in sgs.F90) - - qv(i,j,k) = q(i,j,k) - qn(i,j,k) - ! Apply local hole-filling to vapor by converting liquid to vapor. Moist - ! static energy should be conserved, so updating temperature is not - ! needed here. -dschanen 31 August 2011 - if ( qv(i,j,k) < zero_threshold ) then - qn(i,j,k) = qn(i,j,k) + qv(i,j,k) - qv(i,j,k) = zero_threshold - if ( qn(i,j,k) < zero_threshold ) then - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) "Total water at", "i =", i, "j =", j, "k =", k, "is negative.", & - "Applying non-conservative hard clipping." - end if - qn(i,j,k) = zero_threshold - end if ! cloud_liq < 0 - end if ! qv < 0 - - qcl(i,j,k) = qn(i,j,k) - qci(i,j,k) = 0.0 - omp = max(0.,min(1.,(tabs(i,j,k)-tprmin)*a_pr)) - qpl(i,j,k) = qp(i,j,k)*omp - qpi(i,j,k) = qp(i,j,k)*(1.-omp) - end do - end do - end do - -end subroutine micro_diagnose_clubb - -#endif /*CLUBB_CRM*/ -!---------------------------------------------------------------------- -!!! function to compute terminal velocity for precipitating variables: -! In this particular case there is only one precipitating variable. - -real function term_vel_qp(i,j,k,ind) - - use crmx_vars - integer, intent(in) :: i,j,k,ind - real wmax, omp, omg, qrr, qss, qgg - - term_vel_qp = 0. - if(qp(i,j,k).gt.qp_threshold) then - omp = max(0.,min(1.,(tabs(i,j,k)-tprmin)*a_pr)) - if(omp.eq.1.) then - term_vel_qp = vrain*(rho(k)*qp(i,j,k))**crain - elseif(omp.eq.0.) then - omg = max(0.,min(1.,(tabs(i,j,k)-tgrmin)*a_gr)) - qgg=omg*qp(i,j,k) - qss=qp(i,j,k)-qgg - term_vel_qp = (omg*vgrau*(rho(k)*qgg)**cgrau & - +(1.-omg)*vsnow*(rho(k)*qss)**csnow) - else - omg = max(0.,min(1.,(tabs(i,j,k)-tgrmin)*a_gr)) - qrr=omp*qp(i,j,k) - qss=qp(i,j,k)-qrr - qgg=omg*qss - qss=qss-qgg - term_vel_qp = (omp*vrain*(rho(k)*qrr)**crain & - +(1.-omp)*(omg*vgrau*(rho(k)*qgg)**cgrau & - +(1.-omg)*vsnow*(rho(k)*qss)**csnow)) - endif - end if -end function term_vel_qp - -!---------------------------------------------------------------------- -!!! compute sedimentation -! -subroutine micro_precip_fall() - - use crmx_vars - use crmx_params, only : pi - - real omega(nx,ny,nzm) - integer ind - integer i,j,k - - crain = b_rain / 4. - csnow = b_snow / 4. - cgrau = b_grau / 4. - vrain = a_rain * gamr3 / 6. / (pi * rhor * nzeror) ** crain - vsnow = a_snow * gams3 / 6. / (pi * rhos * nzeros) ** csnow - vgrau = a_grau * gamg3 / 6. / (pi * rhog * nzerog) ** cgrau - - do k=1,nzm - do j=1,ny - do i=1,nx - omega(i,j,k) = max(0.,min(1.,(tabs(i,j,k)-tprmin)*a_pr)) - end do - end do - end do - - call precip_fall(qp, term_vel_qp, 2, omega, ind) - - -end subroutine micro_precip_fall - -!---------------------------------------------------------------------- -! called when stepout() called - -subroutine micro_print() -end subroutine micro_print - -!----------------------------------------------------------------------- -! Supply function that computes total water in a domain: -! -real(kind=selected_real_kind(12)) function total_water() - - use crmx_vars, only : nstep,nprint,adz,dz,rho - real(kind=selected_real_kind(12)) tmp - integer i,j,k,m - - total_water = 0. - do m=1,nmicro_fields - if(flag_wmass(m).eq.1) then - do k=1,nzm - tmp = 0. - do j=1,ny - do i=1,nx - tmp = tmp + micro_field(i,j,k,m) - end do - end do - total_water = total_water + tmp*adz(k)*dz*rho(k) - end do - end if - end do - -end function total_water - -! ------------------------------------------------------------------------------- -! dummy effective radius functions: - -function Get_reffc() ! liquid water - real, pointer, dimension(:,:,:) :: Get_reffc -end function Get_reffc - -function Get_reffi() ! ice - real, pointer, dimension(:,:,:) :: Get_reffi -end function Get_reffi - - -end module crmx_microphysics - - - diff --git a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_init.F90 b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_init.F90 deleted file mode 100644 index 04dd336d45..0000000000 --- a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_init.F90 +++ /dev/null @@ -1,117 +0,0 @@ - -subroutine precip_init - -! Initialize precipitation related stuff - -use crmx_vars -use crmx_microphysics -use crmx_micro_params -use crmx_params - -implicit none - -real pratio, coef1, coef2,estw,esti,rrr1,rrr2 -real*4 gammafff -external gammafff -integer k - -gam3 = 3. -gamr1 = 3.+b_rain -gamr2 = (5.+b_rain)/2. -gamr3 = 4.+b_rain -gams1 = 3.+b_snow -gams2 = (5.+b_snow)/2. -gams3 = 4.+b_snow -gamg1 = 3.+b_grau -gamg2 = (5.+b_grau)/2. -gamg3 = 4.+b_grau -gam3 = gammafff(gam3) -gamr1 = gammafff(gamr1) -gamr2 = gammafff(gamr2) -gamr3 = gammafff(gamr3) -gams1 = gammafff(gams1) -gams2 = gammafff(gams2) -gams3 = gammafff(gams3) -gamg1 = gammafff(gamg1) -gamg2 = gammafff(gamg2) -gamg3 = gammafff(gamg3) -!if(masterproc) then -! print*,'gam3=',gam3 -! print*,'gamr1,gamr2,gamr3:',gamr1,gamr2,gamr3 -! print*,'gams1,gams2,gams3:',gams1,gams2,gams3 -! print*,'gamg1,gamg2,gamg3:',gamg1,gamg2,gamg3 -!endif -if(nint(gam3).ne.2) then - if(masterproc)print*,'cannot compute gamma-function in precip_init. Exiting...' - call task_abort -end if - -do k=1,nzm - -! pratio = (1000. / pres(k)) ** 0.4 - pratio = sqrt(1.29 / rho(k)) - - rrr1=393./(tabs0(k)+120.)*(tabs0(k)/273.)**1.5 - rrr2=(tabs0(k)/273.)**1.94*(1000./pres(k)) - - estw = 100.*esatw_crm(tabs0(k)) - esti = 100.*esati_crm(tabs0(k)) - -! accretion by snow: - - coef1 = 0.25 * pi * nzeros * a_snow * gams1 * pratio/ & - (pi * rhos * nzeros/rho(k) ) ** ((3+b_snow)/4.) - coef2 = exp(0.025*(tabs0(k) - 273.15)) - accrsi(k) = coef1 * coef2 * esicoef - accrsc(k) = coef1 * esccoef - coefice(k) = coef2 - -! evaporation of snow: - - coef1 =(lsub/(tabs0(k)*rv)-1.)*lsub/(therco*rrr1*tabs0(k)) - coef2 = rv*tabs0(k)/(diffelq*rrr2*esti) - evaps1(k) = 0.65*4.*nzeros/sqrt(pi*rhos*nzeros)/(coef1+coef2)/sqrt(rho(k)) - evaps2(k) = 0.49*4.*nzeros*gams2*sqrt(a_snow/(muelq*rrr1))/ & - (pi*rhos*nzeros)**((5+b_snow)/8.) / (coef1+coef2) & - * rho(k)**((1+b_snow)/8.)*sqrt(pratio) - -! accretion by graupel: - - coef1 = 0.25*pi*nzerog*a_grau*gamg1*pratio/& - (pi*rhog*nzerog/rho(k))**((3+b_grau)/4.) - coef2 = exp(0.025*(tabs0(k) - 273.15)) - accrgi(k) = coef1 * coef2 * egicoef - accrgc(k) = coef1 * egccoef - -! evaporation of graupel: - - coef1 =(lsub/(tabs0(k)*rv)-1.)*lsub/(therco*rrr1*tabs0(k)) - coef2 = rv*tabs0(k)/(diffelq*rrr2*esti) - evapg1(k) = 0.65*4.*nzerog/sqrt(pi*rhog*nzerog)/(coef1+coef2)/sqrt(rho(k)) - evapg2(k) = 0.49*4.*nzerog*gamg2*sqrt(a_grau/(muelq*rrr1))/ & - (pi * rhog * nzerog)**((5+b_grau)/8.) / (coef1+coef2) & - * rho(k)**((1+b_grau)/8.)*sqrt(pratio) - - -! accretion by rain: - - accrrc(k)= 0.25 * pi * nzeror * a_rain * gamr1 * pratio/ & - (pi * rhor * nzeror / rho(k)) ** ((3+b_rain)/4.)* erccoef - -! evaporation of rain: - - coef1 =(lcond/(tabs0(k)*rv)-1.)*lcond/(therco*rrr1*tabs0(k)) - coef2 = rv*tabs0(k)/(diffelq * rrr2 * estw) - evapr1(k) = 0.78 * 2. * pi * nzeror / & - sqrt(pi * rhor * nzeror) / (coef1+coef2) / sqrt(rho(k)) - evapr2(k) = 0.31 * 2. * pi * nzeror * gamr2 * & - 0.89 * sqrt(a_rain/(muelq*rrr1))/ & - (pi * rhor * nzeror)**((5+b_rain)/8.) / (coef1+coef2) & - * rho(k)**((1+b_rain)/8.)*sqrt(pratio) - -end do - - -end subroutine precip_init - - diff --git a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc.F90 b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc.F90 deleted file mode 100644 index 78b750ca89..0000000000 --- a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc.F90 +++ /dev/null @@ -1,136 +0,0 @@ - -subroutine precip_proc - -use crmx_vars -use crmx_microphysics -use crmx_micro_params -use crmx_params - -implicit none - -integer i,j,k -real autor, autos, accrr, accris, accrcs, accrig, accrcg -real dq, omn, omp, omg, qsatt -real pows1, pows2, powg1, powg2, powr1, powr2, tmp -real qii, qcc, qrr, qss, qgg - -powr1 = (3 + b_rain) / 4. -powr2 = (5 + b_rain) / 8. -pows1 = (3 + b_snow) / 4. -pows2 = (5 + b_snow) / 8. -powg1 = (3 + b_grau) / 4. -powg2 = (5 + b_grau) / 8. - -!call t_startf ('precip_proc') - -do k=1,nzm - qpsrc(k)=0. - qpevp(k)=0. - do j=1,ny - do i=1,nx - -!------- Autoconversion/accretion - - if(qn(i,j,k)+qp(i,j,k).gt.0.) then - - - omn = max(0.,min(1.,(tabs(i,j,k)-tbgmin)*a_bg)) - omp = max(0.,min(1.,(tabs(i,j,k)-tprmin)*a_pr)) - omg = max(0.,min(1.,(tabs(i,j,k)-tgrmin)*a_gr)) - - if(qn(i,j,k).gt.0.) then - - qcc = qn(i,j,k) * omn - qii = qn(i,j,k) * (1.-omn) - - if(qcc .gt. qcw0) then - autor = alphaelq - else - autor = 0. - endif - - if(qii .gt. qci0) then - autos = betaelq*coefice(k) - else - autos = 0. - endif - - accrr = 0. - if(omp.gt.0.001) then - qrr = qp(i,j,k) * omp - accrr = accrrc(k) * qrr ** powr1 - end if - accrcs = 0. - accris = 0. - if(omp.lt.0.999.and.omg.lt.0.999) then - qss = qp(i,j,k) * (1.-omp)*(1.-omg) - tmp = qss ** pows1 - accrcs = accrsc(k) * tmp - accris = accrsi(k) * tmp - end if - accrcg = 0. - accrig = 0. - if(omp.lt.0.999.and.omg.gt.0.001) then - qgg = qp(i,j,k) * (1.-omp)*omg - tmp = qgg ** powg1 - accrcg = accrgc(k) * tmp - accrig = accrgi(k) * tmp - endif - qcc = (qcc+dtn*autor*qcw0)/(1.+dtn*(accrr+accrcs+accrcg+autor)) - qii = (qii+dtn*autos*qci0)/(1.+dtn*(accris+accrig+autos)) - dq = dtn *(accrr*qcc + autor*(qcc-qcw0)+ & - (accris+accrig)*qii + (accrcs+accrcg)*qcc + autos*(qii-qci0)) - dq = min(dq,qn(i,j,k)) - qp(i,j,k) = qp(i,j,k) + dq - q(i,j,k) = q(i,j,k) - dq - qn(i,j,k) = qn(i,j,k) - dq - qpsrc(k) = qpsrc(k) + dq - - elseif(qp(i,j,k).gt.qp_threshold.and.qn(i,j,k).eq.0.) then - - qsatt = 0. - if(omn.gt.0.001) qsatt = qsatt + omn*qsatw_crm(tabs(i,j,k),pres(k)) - if(omn.lt.0.999) qsatt = qsatt + (1.-omn)*qsati_crm(tabs(i,j,k),pres(k)) - dq = 0. - if(omp.gt.0.001) then - qrr = qp(i,j,k) * omp - dq = dq + evapr1(k)*sqrt(qrr) + evapr2(k)*qrr**powr2 - end if - if(omp.lt.0.999.and.omg.lt.0.999) then - qss = qp(i,j,k) * (1.-omp)*(1.-omg) - dq = dq + evaps1(k)*sqrt(qss) + evaps2(k)*qss**pows2 - end if - if(omp.lt.0.999.and.omg.gt.0.001) then - qgg = qp(i,j,k) * (1.-omp)*omg - dq = dq + evapg1(k)*sqrt(qgg) + evapg2(k)*qgg**powg2 - end if - dq = dq * dtn * (q(i,j,k) /qsatt-1.) - dq = max(-0.5*qp(i,j,k),dq) - qp(i,j,k) = qp(i,j,k) + dq - q(i,j,k) = q(i,j,k) - dq - qpevp(k) = qpevp(k) + dq - - else - - q(i,j,k) = q(i,j,k) + qp(i,j,k) - qpevp(k) = qpevp(k) - qp(i,j,k) - qp(i,j,k) = 0. - - endif - - endif - - dq = qp(i,j,k) - qp(i,j,k)=max(0.,qp(i,j,k)) - q(i,j,k) = q(i,j,k) + (dq-qp(i,j,k)) - - end do - enddo -enddo - - - -!call t_stopf ('precip_proc') - -end subroutine precip_proc - diff --git a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc_clubb.F90 b/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc_clubb.F90 deleted file mode 100644 index 5a90a032ff..0000000000 --- a/src/physics/spcam/crm/MICRO_SAM1MOM/crmx_precip_proc_clubb.F90 +++ /dev/null @@ -1,202 +0,0 @@ -#define CLDFRAC -#ifdef CLDFRAC -subroutine precip_proc_clubb - -#ifdef CLUBB_CRM -use crmx_vars -use crmx_microphysics -use crmx_micro_params -use crmx_params -use crmx_vars, only: CF3D - -implicit none - -integer i,j,k -real autor, autos, accrr, accris, accrcs, accrig, accrcg -real dq, omn, omp, omg, qsatt -real pows1, pows2, powg1, powg2, powr1, powr2, tmp -real qii, qcc, qrr, qss, qgg - -real cld3d(nx, ny, nzm), cldmax(nx, ny, nzm) -real cld3d_temp(nx, ny, nzm) -real cloud_frac_thresh -real qclr -real dqpsrc, dqpevp - -powr1 = (3 + b_rain) / 4. -powr2 = (5 + b_rain) / 8. -pows1 = (3 + b_snow) / 4. -pows2 = (5 + b_snow) / 8. -powg1 = (3 + b_grau) / 4. -powg2 = (5 + b_grau) / 8. - -!call t_startf ('precip_proc_clubb') - -! Get cloud fraction of non-precipitating condensate -! and precipitating condensate -cloud_frac_thresh = 0.005 -do j=1, ny - do i=1, nx - do k=nzm, 1, -1 - cld3d(i, j, k) = CF3D(i,j,k) - cld3d_temp(i, j, k) = min(0.999, max(CF3D(i,j,k), cloud_frac_thresh)) - end do - cldmax(i,j,nzm)=cld3d_temp(i,j,nzm) - - do k=nzm-1, 1, -1 - ! if precipitating condensate is smaller than threshold, set cldmax - ! to cloud fraction at current level - if(qp(i, j, k+1).ge.qp_threshold) then - cldmax(i,j,k) = max(cldmax(i,j,k+1), cld3d_temp(i,j,k)) - else - cldmax(i,j,k) = cld3d_temp(i,j,k) - end if - -! if(cld3d(i,j,k).le.cloud_frac_thresh .and. qp(i,j,k).gt.qp_threshold) then -! if(cldmax(i,j,k).lt.0.1) then -! cldmax(i,j,k) = 0.50 -! end if -! end if - end do -! test: assume precipitating hydrometer fill the whole grid box -! cldmax(i,j,:) = 0.999 - - end do -end do - - -do k=1,nzm - qpsrc(k)=0. - qpevp(k)=0. - do j=1,ny - do i=1,nx - dqpsrc = 0.0 - dqpevp = 0.0 - -!------- Autoconversion/accretion - - if(qn(i,j,k)+qp(i,j,k).gt.0.) then - - - omn = max(0.,min(1.,(tabs(i,j,k)-tbgmin)*a_bg)) - omp = max(0.,min(1.,(tabs(i,j,k)-tprmin)*a_pr)) - omg = max(0.,min(1.,(tabs(i,j,k)-tgrmin)*a_gr)) - -! if(qn(i,j,k).gt.0.) then - if(cld3d(i,j,k).gt.0.) then ! the generation of precipitating condensate - - qcc = qn(i,j,k) * omn /cld3d_temp(i,j,k) - qii = qn(i,j,k) * (1.-omn)/cld3d_temp(i,j,k) - - if(qcc .gt. qcw0) then - autor = alphaelq - else - autor = 0. - endif - - if(qii .gt. qci0) then - autos = betaelq*coefice(k) - else - autos = 0. - endif - - accrr = 0. - if(omp.gt.0.001) then - qrr = qp(i,j,k) * omp / cldmax(i,j,k) - accrr = accrrc(k) * qrr ** powr1 - end if - accrcs = 0. - accris = 0. - if(omp.lt.0.999.and.omg.lt.0.999) then - qss = qp(i,j,k) * (1.-omp)*(1.-omg) / cldmax(i,j,k) - tmp = qss ** pows1 - accrcs = accrsc(k) * tmp - accris = accrsi(k) * tmp - end if - accrcg = 0. - accrig = 0. - if(omp.lt.0.999.and.omg.gt.0.001) then - qgg = qp(i,j,k) * (1.-omp)*omg / cldmax(i,j,k) - tmp = qgg ** powg1 - accrcg = accrgc(k) * tmp - accrig = accrgi(k) * tmp - endif - qcc = (qcc+dtn*autor*qcw0)/(1.+dtn*(accrr+accrcs+accrcg+autor)) - qii = (qii+dtn*autos*qci0)/(1.+dtn*(accris+accrig+autos)) - dq = dtn *(accrr*qcc + autor*(qcc-qcw0)+ & - (accris+accrig)*qii + (accrcs+accrcg)*qcc + autos*(qii-qci0)) - - dq = dq * cld3d(i,j,k) ! convert fro the in-cloud value to grid-mean value - - dq = min(dq,qn(i,j,k)) -! qp(i,j,k) = qp(i,j,k) + dq -! q(i,j,k) = q(i,j,k) - dq -! qn(i,j,k) = qn(i,j,k) - dq - dqpsrc = dq - qpsrc(k) = qpsrc(k) + dq - - end if - - !elseif(qp(i,j,k).gt.qp_threshold.and.qn(i,j,k).eq.0.) then - ! Evaporation is only allowed when cldmax exceeds cld3d_temp -! if(qp(i,j,k).gt.qp_threshold.and.cldmax(i,j,k).gt.cld3d_temp(i,j,k)) then - if(qp(i,j,k).gt.qp_threshold.and.qn(i,j,k).eq.0.) then - - qsatt = 0. - if(omn.gt.0.001) qsatt = qsatt + omn*qsatw_crm(tabs(i,j,k),pres(k)) - if(omn.lt.0.999) qsatt = qsatt + (1.-omn)*qsati_crm(tabs(i,j,k),pres(k)) - dq = 0. - if(omp.gt.0.001) then - qrr = qp(i,j,k) * omp /cldmax(i,j,k) - dq = dq + evapr1(k)*sqrt(qrr) + evapr2(k)*qrr**powr2 - end if - if(omp.lt.0.999.and.omg.lt.0.999) then - qss = qp(i,j,k) * (1.-omp)*(1.-omg) / cldmax(i,j,k) - dq = dq + evaps1(k)*sqrt(qss) + evaps2(k)*qss**pows2 - end if - if(omp.lt.0.999.and.omg.gt.0.001) then - qgg = qp(i,j,k) * (1.-omp)*omg /cldmax(i,j,k) - dq = dq + evapg1(k)*sqrt(qgg) + evapg2(k)*qgg**powg2 - end if - -! dq = dq * dtn * (q(i,j,k) /qsatt-1.) - qclr = max(0., (q(i,j,k)-qn(i,j,k)-qsatt * cld3d(i,j,k)))/max(0.001, (1-cld3d(i,j,k))) - qclr = min(qclr, qsatt) - dq = dq * dtn * (qclr/qsatt-1.) - dq = dq * (cldmax(i,j,k) - cld3d_temp(i,j,k)) ! convert this to the grid-mean value - - dq = max(-0.5*qp(i,j,k),dq) -! qp(i,j,k) = qp(i,j,k) + dq -! q(i,j,k) = q(i,j,k) - dq - dqpevp = dq - qpevp(k) = qpevp(k) + dq - - end if - - if(qp(i,j,k).le.qp_threshold .and. cld3d(i,j,k).le.0) then -! q(i,j,k) = q(i,j,k) + qp(i,j,k) - dqpevp = dqpevp - qp(i,j,k) - qpevp(k) = qpevp(k) - qp(i,j,k) -! qp(i,j,k) = 0. - endif - - endif - - qp(i,j,k) = qp(i,j,k) + dqpsrc + dqpevp - q(i,j,k) = q(i,j,k) - dqpsrc - dqpevp - qn(i,j,k) = qn(i,j,k) - dqpsrc - - dq = qp(i,j,k) - qp(i,j,k)=max(0.,qp(i,j,k)) - q(i,j,k) = q(i,j,k) + (dq-qp(i,j,k)) - - end do - enddo -enddo - -!call t_stopf ('precip_proc_clubb') - -#endif /*CLUBB_CRM*/ -end subroutine precip_proc_clubb -#endif - diff --git a/src/physics/spcam/crm/Readme_codes_merging_sam6.8.2_sam6.10.4.txt b/src/physics/spcam/crm/Readme_codes_merging_sam6.8.2_sam6.10.4.txt deleted file mode 100644 index 6703aea205..0000000000 --- a/src/physics/spcam/crm/Readme_codes_merging_sam6.8.2_sam6.10.4.txt +++ /dev/null @@ -1,141 +0,0 @@ - -Here we merge CRM in SPCAM5 (https://svn-ccsm-models.cgd.ucar.edu/cam1/branches/spcam1_5_00_cam5_2_09_pnnl) -from the version of sam6.8.2 (sam_clubb trunk revision r763) to sam6.10.4 (the pnnl branch of sam_clubb revision tag r1130: - http://carson.math.uwm.edu/repos/sam_repos/branches/sam_clubb_r1061_pnnl) - -steps to do this: -1. compare sam_clubb r763 with the pnnl branch of sam_CLUBB r1130 -2. compare sam_clubb r763 with crm in SPCAM5 -3. compare sam_clubb r1130 with crm in SPCAM5 - -copy r763, r1130 to the src directory (models/atm/cam/src/physics/) - -July 1st, 2013: -advect_mom.F90: no change from spcam5_2_09 -advect_all_scalars.F90: not in r763, so copy it directly from r1130. DONE -./ADV_MPDATA/advect_scalar.F90: remove statistical part - /advect_scalar2D.F90: no change from r1130 - /advect_scalar3D.F90: no change from r1130 - /advection.F90: no change from r1130 -./ADV_UM5/advect_scalar.F90: remove statistical part - /advect_scalar2D.F90: no change from r1130 - /advect_scalar3D.F90: no change from r1130 -The above three files listed under ./crm are removed. - -boudaries.F90: copy "use grid, only: dompi" from r1130. So now boudaries.F90 - are identifical for spcam5_2_09 and r1130. -buoyancy.F90: add betu, betd part from r1130 - -clubb_sgs.F90: Incorporate changes from r1130 - -clubbvars.F90: incorporate changes from r1130 to spcam5_2_09 -clubb_silhs_vars.F90: directly copy it from r1130. This is not enabled in MMF. - -comparess3D.F90: the same as spcam5_2_09. No change. -coriolis.F90: update dvdt formula from r1130. - -crm_module.F90: DONE -crmsurface.F90: the same as spcam5_2_09. surface.F90 in r763 and r1130 are - different, but these differences are not relevant to SPCAM. -crmtracers.F90: the same as spcam5_2_09. No change from r763 to r1130. -damping.F90: No change. Note: the damping of t and micro_filed is removed from - r1130. Need to check with Marat to see whether we should incoroprate - this change to SPCAM5 as well. -diagnose.F90: incorporate changes from r763 to r1130 to spcam5_2_09. - -create two new subdirectories: SGS_TKE; SGS_CLUBBkvhkvm for subgrid treatment -./SGS_TKE/diffuse_mom.F90: the same as that in spcam5_2_09 -./SGS_TKE/diffuse_mom2D.F90: the same as r1130. No clubb-related codes, as - CLUBB-related code is added in a separate directory (SGS_CLUBBkvhkvm) -./SGS_TKE/diffuse_mom3d.F90: the same as r1130. No clubb-related codes, as - CLUBB-related code is added in a separate directory (SGS_CLUBBkvhkvm) -./SGS_TKE/diffuse_scalar.F90: the same as spcam5_2_09 (except tkh from sgs) -./SGS_TKE/diffuse_scalar2D.F90: the same as r1130; -./SGS_TKE/diffuse_scalar3D.F90: the same as r1130; -./SGS_TKE/shear_prod2D.F90: no change from r1130 or spcam5_2_09 -./SGS_TKE/shear_prod3D.F90: no change from r1130 or spcam5_2_09 -./SGS_TKE/tke_full.F90: adopted the one from r1130, but add changes from - spcam5_2_09 in terms of *_crm subroutine. In r763, tke is only updated - if .not.doscalar when dosmagor is true, but in r1130, no such - restriction. -./SGS_TKE/sgs.F90: - i) sgs_setparm: comment out reading namelist - ii) no change in sgs_init. This is now called in crm_module.F90, after - micro_init, and grdf_x, grdf_y, grdf_z are calcluated in - sgs_init. These were calcluated in crm_module.F90 in SPCAM5. - iii) sgs_statistics: this may need to be removed - -./SGS_CLUBBkvhkvm/sgs.F90: add docam_sfc_fluxes flag -./SGS_CLUBBkvhkvm/tke_full.F90: the same as the one from ./SGS_TKE/ -./SGS_CLUBBkvhkvm/diffuse_mom.F90: remove statistics -./SGS_CLUBBkvhkvm/diffuse_mom2D.F90: add docam_sfc_fluxes -./SGS_CLUBBkvhkvm/diffuse_mom2D_xy.F90: remove CLUBB-related. -./SGS_CLUBBkvhkvm/diffuse_mom2D_z.F90: add docam_sfc_fluxes -./SGS_CLUBBkvhkvm/diffuse_mom3D.F90: add docam_sfc_fluxes -./SGS_CLUBBkvhkvm/diffuse_mom3D_xy.F90: remove clubb-related -./SGS_CLUBBkvhkvm/diffuse_mom3D_z.F90: add docam_sfc_fluxes -./SGS_CLUBBkvhkvm/diffuse_scalar.F90: incorporate changes from spcam5_2_09 -./SGS_CLUBBkvhkvm/diffuse_scalar_xy.F90: incorporate changes from spcam5_2_09 -./SGS_CLUBBkvhkvm/diffuse_scalar_z.F90: incorporate chagnes from spcam5_2_09 -./SGS_CLUBBkvhkvm/fluxes_scalar_z.F90: incorporate changes from spcam5_2_09 - -domain.F90: no change from spcam5_2_09 -ftt.F: no change from spcam5_2_09 -forcing.F90: no change from spcam5_2_09 -gammaff.c: no change from spcam5_2_09 (seems not included in r1130 or r763) -grid.F90: Identifical to the one from r1130. There are large difference - between r1130 and r763. Need to double check whether there is any - potential issues. -ice_fall.F90: no change from spcam5_2_09 -init.F90: add qtostor to the one from spcam5_2_09 -kurant.F90: adopt one from r1130 -params.F90: adopt one from r1130, but add CRM-related codes. This is quite - different from r763 and spcam5_2_09. Need to double check to see - whether there is any poential issues -periodic.F90: adopt the one from r1130, and change CLUBB to CLUBB_CRM -precip_fall.F90: No change from spcam5_2_09 -press_grad.F90: the same as spcam5_2_09, but adopte changes from r763 to - r1130 ( a fix by P. Bloss). -press_rhs.F90: the same as the one from r1130 -pressure.F90: the same as the one from spcam5_2_09, but add "use params, only: - dowallx, dowally, docolumn". Probably need to check with Marat to see - whether we need update this. Pressure-related subroutines have littles - change from r763 to r1130. -random.F90: no changes from either spcam5_2_09 or r1130 -sat.F90: the same as spcam5_2_09 (quite different from r1130. But no change - from r763 to r1130). - -NO SETDATA.F90 in spcam5, but sgs_init is called in setdata. - so sgs_inti is called in crm_module.F90 - -setparm.F90: adopt from r1130, and add MMF-related from spcam5_2_09 - Things to note: sgs_setparm; forz and fcor are not caclcualted here in - r1130 any more (they are calculated in setgrid.F), but this is still - kept here. -setperturb.F90: Tke is now treated by calling setperturb_sgs. Otherwise, it is - the same as spcam5_2_09. - -stat_clubb.F90: Copy it from r1130. NO CHANGE YET. NEED TO BE CHANGED - -stepout.F90: No change from spcam5_2_09. It is not used in spcam5. so we may - remove it in the future. -task_init.F90: No change from spcam5_2_09 -task_util_NOMPI.F90: No change from spacm5_2_09 -tke_full.F90: deleted, as this has been added into ./SGS_TKE/ -utils.F90: Incorporate changes from r1130. -vars.F90: Incorporate changes from r1130. fcory(ny) is changed to fcory(0:ny). So the calculation of fcory in -crm_module is changed as well. - -./MICRO_SAM1MOM/cloud.F90: the same as spcam5_2_09 -./MICRO_SAM1MOM/micro_params.F90: the same as spcam5_2_09 -./MICRO_SAM1MOM/microphysics.F90: adopt changes from r1130. - s_ar is removed from micro_precip_fall -./MICRO_SAM1MOM/precip_init.F90: the same as spcam5_2_09 -./MICRO_SAM1MOM/precip_proc.F90: the same as spcam5_2_09 -./MICRO_SAM1MOM/precip_proc_clubb.F90: adopt from r1130 -./MICRO_M2005/microphysics.F90: incorporates changes from r1130 -./MICRO_M2005/module_mp_graupel.F90: incorporate change from r1130. Those - changes are quite minor, except a scaling factor is applied to contact - freezing nucleaiton rate and homogeneous freezing of cloud droplets. - -./CLUBB/: create a new CLUBB directory for the latest CLUBB used in MMF diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_sgs.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_sgs.F90 deleted file mode 100644 index 5e76947cfb..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_sgs.F90 +++ /dev/null @@ -1,2366 +0,0 @@ -!------------------------------------------------------------------------------- -! $Id: clubb_sgs.F90 1103 2013-05-14 18:35:02Z minghuai.wang@pnl.gov $ -module crmx_clubb_sgs -#ifdef CLUBB_CRM -! Description: -! Contains function and subroutines for interfacing with the UW Milwaukee -! Single-Column Model and also the CLUBB-SILHS subcolumn generator. - -! References: -! See DOC/CLUBB/clubb_doc/CLUBBeqns.pdf in this directory. -!------------------------------------------------------------------------------- - - use crmx_clubb_core, only: & - setup_clubb_core, advance_clubb_core, & - cleanup_clubb_core - - use crmx_clubb_precision, only: & - time_precision, & ! Constant(s) - core_rknd - - use crmx_domain, only: & - nsubdomains_x, & - nsubdomains_y - - use crmx_clubbvars, only: l_stats_samgrid - - implicit none - - private - - public :: clubb_sgs_setup, advance_clubb_sgs, clubb_sgs_cleanup, & - apply_clubb_sgs_tndcy, apply_clubb_sgs_tndcy_scalars, apply_clubb_sgs_tndcy_mom, t2thetal - - public :: total_energy - - logical, private :: lstats_clubb - - integer, dimension(nsubdomains_x*nsubdomains_y), private :: & - sample_nodes, x_samp, y_samp - - integer, private :: x_samp_node, y_samp_node - -#ifdef CLUBB_LH - integer, private, save :: LH_iter = 0 -#endif /* CLUBB_LH */ - contains -!------------------------------------------------------------------------------- - subroutine clubb_sgs_setup( dt_clubb, latitude, longitude, z, rho, zi, rhow, tv0, tke ) - -! Description: -! Initialize UWM CLUBB. - -! References: -! None -!------------------------------------------------------------------------------- - - ! From the CLUBB directory - use crmx_error_code, only: & - clubb_no_error, set_clubb_debug_level ! Subroutines - - use crmx_parameter_indices, only: & - nparams ! Constant - - use crmx_constants_clubb, only: & - em_min, w_tol_sqd, rt_tol, thl_tol, zero_threshold, & ! Constants - fstderr, fstdout - - use crmx_grid_class, only: & - zm2zt, zt2zm, & ! Functions - gr ! Derived type - - ! These are only needed if we're using a passive scalar - use crmx_array_index, only: & - iisclr_rt, iisclr_thl, iisclr_CO2, & ! [kg/kg]/[K]/[1e6 mol/mol] - iiedsclr_rt, iiedsclr_thl, iiedsclr_CO2 ! " " - - use crmx_parameters_tunable, only: & - read_parameters ! Subroutine - - use crmx_stats_subs, only: & - stats_init ! Subroutine - - use crmx_stat_clubb, only: stats_init_clubb - - use crmx_model_flags, only: & - l_use_boussinesq, & ! Variables - l_tke_aniso - - ! From the SAM directory - use crmx_grid, only: rank, nx, ny, nz, nzm, dx, dy, time, case, caseid, & - nrestart, dimx1_s, dimx2_s, dimy1_s, dimy2_s, ntracers ! Variable(s) - - use crmx_params, only: lcond, cp ! Constants - - use crmx_params, only: doclubb_sfc_fluxes ! Variable(s) -#ifdef CLUBB_LH - use crmx_microphysics, only: & - mkname, nmicro_fields ! Variable(s) - - use crmx_array_index, only: & - iirrainm, iiNrm, iirsnowm, iiricem, iirgraupelm, & ! Variables - iiNcm, iiNsnowm, iiNim, iiNgraupelm - - use latin_hypercube_arrays, only: & - d_variables, & ! Variable - setup_corr_varnce_array ! Procedure - - use crmx_parameters_microphys, only: & - l_lh_vert_overlap, & ! Variable(s) - l_fix_s_t_correlations, & - l_lh_cloud_weighted_sampling, & - LH_microphys_type, & - LH_microphys_disabled, & - LH_microphys_non_interactive, & - LH_microphys_calls, & - LH_seed, & - LH_sequence_length - - use crmx_parameters_microphys, only: & - rrp2_on_rrm2_cloud, & ! Variable(s) - Nrp2_on_Nrm2_cloud, & - Ncp2_on_Ncm2_cloud, & - rrp2_on_rrm2_below, & - Nrp2_on_Nrm2_below, & - Ncp2_on_Ncm2_below - - use crmx_parameters_microphys, only: & - rsnowp2_on_rsnowm2_cloud, & ! Variables - Nsnowp2_on_Nsnowm2_cloud, & - ricep2_on_ricem2_cloud, & - Nicep2_on_Nicem2_cloud, & - rsnowp2_on_rsnowm2_below, & - Nsnowp2_on_Nsnowm2_below, & - ricep2_on_ricem2_below, & - Nicep2_on_Nicem2_below -#else - use crmx_parameters_microphys, only: LH_microphys_type, LH_microphys_disabled -#endif /*CLUBB_LH */ - - use crmx_clubbvars, only: & - upwp, &! u'w'. [m^2/s^2] - vpwp, &! u'w'. [m^2/s^2] - up2, &! u'^2 [m^2/s^2] - vp2, &! v'^2 [m^2/s^2] - wprtp, &! w' r_t'. [(m kg)/(s kg)] - wpthlp, &! w' th_l'. [(m K)/s] - wprcp, &! w' r_c' [(kg/kg) m/s] - wp2, &! w'^2. [m^2/s^2] - rtp2, &! r_t'^2. [(kg/kg)^2] - thlp2, &! th_l'^2. [K^2] - rtpthlp,&! r_t' th_l'. [(kg K)/kg] - wp3 ! w'^3. [m^3/s^3] - - use crmx_clubbvars, only: & - tracer_tndcy, & ! Time tendency of the SAM set of tracers - t_tndcy, & ! CLUBB contribution to moist static energy [K/s] - qc_tndcy, & ! CLUBB contribution to liquid water [kg/kg/s] - qv_tndcy, & ! CLUBB contribution to vapor water [kg/kg/s] - u_tndcy, & ! CLUBB contribution to x-wind [m/s^2] - v_tndcy ! CLUBB contribution to y-wind [m/s^2] - - use crmx_clubbvars, only: & - sclrp2, & ! Passive scalar variance. [{units vary}^2] - sclrpthlp, & ! Passive scalar covariance. [{units vary}^2] - sclrprtp, & ! Passive scalar covariance. [{units vary}^2] - wpsclrp ! w'sclr' [units vary m/s] - - use crmx_clubbvars, only: & - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] - invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] - thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] - thv_ds_zt ! Dry, base-state theta_v on thermo. levels [K] - - use crmx_clubbvars, only: & - sclr_tol, & ! Tolerance on high-order scalars - edsclr_dim, & ! Number of eddy-diffusivity scalars - sclr_dim ! Numer of high-order scalars - - use crmx_clubbvars, only: & - tndcy_precision ! Precision of CLUBB's contribution to the tendencies of mean variables - -#ifdef CLUBB_LH - use crmx_clubb_silhs_vars, only: & - LH_rt, & - LH_t, & - X_nl_all_levs, & - LH_sample_point_weights, & - X_mixt_comp_all_levs, & - micro_field_prior, & - LH_micro_field_sum_tndcy, & - LH_micro_field_avg_tndcy - - use crmx_mt95, only: & - genrand_init, & - genrand_intg -#endif - -#ifdef CRM - use crmx_clubbvars, only: lrestart_clubb -#endif - - implicit none - - ! Constant parameters - logical, parameter :: & - l_uv_nudge = .false., & ! Use u/v nudging (not used) - l_implemented = .true. ! Implemented in a host model (always true) - - integer, parameter :: & - grid_type = 2, & ! The 2 option specifies stretched thermodynamic levels - iunit = 50 ! Fortran I/O unit - - character(len=6), parameter :: & - saturation_equation = "flatau" ! Flatau polynomial approximation for SVP - -#ifdef CLUBB_LH - character(len=*), parameter :: & - input_file_cloud = "/silhs_corr_matrix_cloud.in", & - input_file_below = "/silhs_corr_matrix_below.in" - - logical, parameter :: & - doicemicro = .true. -#endif - real(kind=core_rknd), parameter :: & - theta0 = 300._core_rknd, &! Reference temperature [K] - ts_nudge = 86400._time_precision ! Time scale for u/v nudging (not used) [s] - - ! Input Variables - real(kind=time_precision), intent(in) :: & - dt_clubb ! SAM-CLUBB subcycled model timestep [s] - - real, dimension(nx, ny), intent(in) :: & - latitude, & ! Latitudes for SAM's dynamical core [degrees_N] - longitude ! Longitudes for SAM's dynamical core [degrees_E] - - real, dimension(nzm), intent(in) :: & - z, & ! Thermodynamic/Scalar grid in SAM [m] - rho ! Thermodynamic/Scalar density in SAM [kg/m^3] - - real, dimension(nz), intent(in) :: & - zi, & ! Momentum/Vertical Velocity grid in SAM [m] - rhow ! Momentum/Vertical Velocity density in SAM [kg/m^3] - - real, dimension(nzm), intent(in) :: & - tv0 ! Virtual potential temperature from SAM [K] - - real, dimension(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm), intent(in) :: & - tke ! SGS TKE [m^2/s] - - ! Local Variables - real(kind=core_rknd), dimension(nparams) :: & - clubb_params ! These adjustable CLUBB parameters (C1, C2 ...) - - ! 1D variables with ghost points at the lowest level - real(kind=core_rknd), dimension(nz) :: & - zt, & ! Thermodynamic grid [m] - zm, & ! Momentum grid [m] - em ! Turbulent kinetic energy [-] - - logical :: l_stats ! Stats enabled (T/F) - - logical :: l_output_rad_files ! stats enabled for radiative fields (T/F) - - real(kind=time_precision) :: & - stats_tsamp, & ! Sampling interval for a single column of CLUBB data [s] - stats_tout ! Output interval for a single column of CLUBB data [s] - - character(len=10) :: stats_fmt ! Format of stats output (netCDF/GrADS) - character(len=250) :: fname_prefix ! Prefix for stats filename - - ! Horizontal grid spacings (i.e., dx and dy), used for computing Lscale_max - real(kind=core_rknd) :: host_dx, host_dy ! [m] - - real(kind=core_rknd), dimension(1) :: & - rlat, rlon ! Latitude and Longitude for stats [degrees] - - integer :: & - err_code, & ! Code for when CLUBB fails - i, j, ig, jg, & ! Loop indices - ilen ! Length of a string - - integer :: hydromet_dim - logical :: l_host_applies_sfc_fluxes ! Whether the host model applies the surface fluxes -#ifdef CLUBB_LH - integer :: indx -#endif - - namelist /stats_setting/ l_stats_samgrid, l_stats, l_output_rad_files, & - stats_fmt, stats_tsamp, stats_tout, & - sample_nodes, x_samp, y_samp - -#ifdef CLUBB_LH - namelist /clubb_silhs/ LH_microphys_type, LH_microphys_calls, & - LH_sequence_length, LH_seed, l_lh_vert_overlap, l_fix_s_t_correlations, & - l_lh_cloud_weighted_sampling, rrp2_on_rrm2_cloud, & - rrp2_on_rrm2_below, Nrp2_on_Nrm2_cloud, & - Nrp2_on_Nrm2_below, Ncp2_on_Ncm2_cloud, Ncp2_on_Ncm2_below, & - rsnowp2_on_rsnowm2_cloud, Nsnowp2_on_Nsnowm2_cloud, & - ricep2_on_ricem2_cloud, Nicep2_on_Nicem2_cloud, & - rsnowp2_on_rsnowm2_below, Nsnowp2_on_Nsnowm2_below, & - ricep2_on_ricem2_below, Nicep2_on_Nicem2_below -#endif -!------------------------------------------------------------------------------- -! SAM uses an Arakawa C type grid for the 3D quantities. The UWM SCM has an -! additional `ghost' point on the lowest pressure/thermodynamic level. -! i.e. -! -! SAM vert. vel. grid UWM SCM moment. grid -! -! Dimension Elevation Dimension Elevation -! . . . (nz ) . . zi(nz ) . . . (gr%nz ) . . gr%zm(gr%nz ) . . . -! . . . (nz-1) . . zi(nz-1) . . . (gr%nz-1) . . gr%zm(gr%nz-1) . . . -! | | | | -! . . . (1 ) . . zi(1 ) . . . (1 ) . . gr%zm(1 ) . . . -! -! In SAM the lowest grid point on the vertical velocity levels (or `interface' -! levels) is always 0 meters. The UWM SCM supports an arbitrary starting -! point for the momentum grid, but this code assumes 0 meters. -! -! SAM pressure grid UWM SCM thermo. grid -! -! Dimension Elevation Dimension Elevation -! . . . (nz-1) . . z(nz-1) . . . (gr%nz ) . . gr%zt(gr%nz ) . . . -! . . . (nz-2) . . z(nz-2) . . . (gr%nz-1) . . gr%zt(gr%nz-1) . . . -! | | | | -! . . . (1 ) . . z(1 ) . . . (2 ) . . gr%zt(2 ) . . . -! / / / N/A / / N/A / / / (1 ) / / gr%zt(1 ) / / / -! -! Note that the lowest SCM point is below ground. -!------------------------------------------------------------------------------- - - !----- Begin Code ----- - - ! Set the ghost point to be the distance between the first interface level, - ! which is always zero, and the first pressure level. - zt(1) = real( -z(1), kind=core_rknd ) ! [m] - ! All other pressure levels are determined by the host model - zt(2:nz) = real( z(1:nzm), kind=core_rknd ) ! [m] - - zm = real( zi, kind=core_rknd ) - - ! Set the SCM parameters (C2, etc. ) based on default values - !call read_parameters( -99, "", clubb_params ) - - ! Set the SCM parameters (C2, etc. ) based on a namelist -#ifdef CRM - ! Set the SCM parameters (C2, etc. ) based on default values - call read_parameters( -99, "", clubb_params ) -#else - ! Set the SCM parameters (C2, etc. ) based on a namelist - call read_parameters( iunit, "CLUBB_PARAMETERS/tunable_parameters.in", clubb_params ) -#endif - - ! Set the debug level. Level 2 has additional computational expense since - ! it checks the array variables in CLUBB for invalid values. - call set_clubb_debug_level( 0 ) - - host_dx = real( dx, kind=core_rknd ) - host_dy = real( dy, kind=core_rknd ) - - ! These are for emulating total water or thetal for testing purposes - iisclr_rt = -1 - iisclr_thl = -1 - iisclr_CO2 = -1 - - iiedsclr_rt = -1 - iiedsclr_thl = -1 - iiedsclr_CO2 = -1 - - ! Sanity check - if ( sclr_dim > 0 .and. edsclr_dim > 0 ) then - write(fstderr,*) "Only one scalar scheme can be enabled at one time" - call task_abort() - end if - - ! This is the tolerance on total water in the CLUBB SCM - ! Other tracers will need this value set according to their order of - ! magnitude and the units they are in. Keep in mind that the variable - ! sclrp2 will be clipped to a minimum value of sclr_tol^2 - sclr_tol(1:sclr_dim) = 1.e-8_core_rknd ! total water is in kg/kg - - ! Determine whether clubb is applying the surface flux or the host model - ! from the namelist variable doclubb_sfc_fluxes - l_host_applies_sfc_fluxes = .not. doclubb_sfc_fluxes - -#ifdef CLUBB_LH - hydromet_dim = nmicro_fields + 2 -#else - hydromet_dim = 0 ! The hydromet array in SAM-CLUBB is currently 0 elements -#endif - - call setup_clubb_core & - ( nz, theta0, ts_nudge, & ! In - hydromet_dim, sclr_dim, & ! In - sclr_tol, edsclr_dim, clubb_params, & ! In - l_host_applies_sfc_fluxes, & ! In - l_uv_nudge, saturation_equation, & ! In - l_implemented, grid_type, zm(2), zm(1), zm(nz), & ! In - zm(1:nz), zt(1:nz), & ! In - host_dx, host_dy, zm(1), & ! In - err_code ) - - if ( err_code /= CLUBB_no_error ) then - write(fstderr,*) "Initialization of CLUBB failed" - call task_abort() - end if - - l_stats_samgrid = .false. - l_output_rad_files = .false. - -#ifndef CRM - open(unit=iunit, file="clubb_stats_sam") - read(unit=iunit, nml=stats_setting) - write(0, *) 'l_stats_samgrid', l_stats_samgrid - close(unit=iunit) -#endif /*CRM*/ - - if(.not.l_stats_samgrid) then ! output clubb statistics from clubb side - ! Initialize stats_setting - l_stats = .false. - stats_fmt = "grads" - stats_tsamp = 60._time_precision - stats_tout = 60._time_precision - sample_nodes(:) = -1 ! Which nodes are outputting a column - x_samp(:) = -1 ! Which x point for the nth node - y_samp(:) = -1 ! Which y point for the nth node - -#ifndef CRM - ! Figure out which node and points we're sampling - open(unit=iunit, file="clubb_stats") - read(unit=iunit, nml=stats_setting) - close(unit=iunit) -#endif /*CRM*/ - - if ( is_a_sample_node( rank ) .and. l_stats ) then - - ! Determine and save the local x and y to write to be written to disk - call get_sample_points( rank, x_samp_node, y_samp_node ) - - ! Figure out the position on the global grid - call task_rank_to_index( rank, ig, jg ) - - ! The filename follows the following format: - ! case_caseid_x_y_ - ! e.g. (variables in single quotes) - ! 'BOMEX'_'64x64x75_scm_LES'_x000'1'_y00'10'_'zt' - fname_prefix = trim( case )//"_"//trim( caseid ) - ilen = len( trim( fname_prefix ) ) - fname_prefix = trim( fname_prefix )//"_x0000_y0000" - write(unit=fname_prefix(ilen+3:ilen+6),fmt='(i4.4)') ig+x_samp_node - write(unit=fname_prefix(ilen+9:ilen+12),fmt='(i4.4)') jg+y_samp_node - rlat = real( latitude(x_samp_node,y_samp_node), kind=core_rknd ) - rlon = real( longitude(x_samp_node,y_samp_node), kind=core_rknd ) - - ! Use a bogus date, since SAM does not track the year, and it would require - ! some work to convert the `day' variable to MMDD format - call stats_init( iunit, fname_prefix, "./OUT_STAT/", l_stats, & - stats_fmt, stats_tsamp, stats_tout, "clubb_stats", & - nz, zt, zm, nz, zt, nz, zm, 1, 4, 1900, & - rlat, rlon, & - time, dt_clubb ) - - ! If CLUBB stats are on for this node, toggle a flag in this module - write(fstdout,*) "CLUBB stats enabled" - lstats_clubb = .true. - else - lstats_clubb = .false. - x_samp_node = -1 - y_samp_node = -1 - end if - end if ! .not. l_stats_samgrid - -#ifdef CLUBB_LH - ! Default values for namelist parameters - LH_microphys_type = LH_microphys_non_interactive - LH_microphys_calls = 2 - LH_sequence_length = 1 - LH_seed = 5489_genrand_intg - l_lh_vert_overlap = .true. - l_fix_s_t_correlations = .true. - l_lh_cloud_weighted_sampling = .true. - - ! Variances / Corrlations here are those used with the RICO case - rrp2_on_rrm2_cloud = 0.766 - rrp2_on_rrm2_below = rrp2_on_rrm2_cloud - Nrp2_on_Nrm2_cloud = 0.429 - Nrp2_on_Nrm2_below = Nrp2_on_Nrm2_cloud - Ncp2_on_Ncm2_cloud = 0.003 - Ncp2_on_Ncm2_below = Ncp2_on_Ncm2_cloud - - ! Made up values for the variance of ice/snow, since we currently lack data - ! for this. - rsnowp2_on_rsnowm2_cloud = 0.766 - Nsnowp2_on_Nsnowm2_cloud = 0.429 - ricep2_on_ricem2_cloud = 1.0 - Nicep2_on_Nicem2_cloud = 1.0 - - rsnowp2_on_rsnowm2_below = 0.766 - Nsnowp2_on_Nsnowm2_below = 0.429 - ricep2_on_ricem2_below = 1.0 - Nicep2_on_Nicem2_below = 1.0 - - ! Read the namelist from the prm file - open(unit=iunit, file=trim( case )//"/prm") - read(unit=iunit, nml=clubb_silhs) - close(unit=iunit) - - if ( LH_microphys_type /= LH_microphys_disabled ) then - iiNcm = -1 ! Initialize to no Nc prediction - - ! Determine total number of sample variates other than t, rt, and w. - do indx = 1, nmicro_fields - select case ( trim( mkname(indx) ) ) - case ( 'QR', 'QP' ) - iirrainm = indx - - case ( 'QI' ) - iiricem = indx - - case ( 'QS' ) - iirsnowm = indx - - case ( 'QG' ) - ! This is not currently sampled, but we need the index to copy the - ! mean from saved microphysics field - iirgraupelm = indx - - case ( 'CONP', 'NR' ) - iiNrm = indx - - case ( 'NI' ) - iiNim = indx - - case ( 'NS' ) - iiNsnowm = indx - - case ( 'NG' ) - ! See note above for QG. - iiNgraupelm = indx - - case ( 'CONC', 'NC' ) - iiNcm = indx - - end select - end do ! 1..n_micro_fields - ! This is for when Ncm not predicted but we would like to output the fixed value - if ( iiNcm == -1 ) then - iiNcm = indx + 1 - end if - - ! Determine d_variables and other LH indices by reading in the correlation - ! files and from indexes determined above - call setup_corr_varnce_array( iirrainm, iiNrm, iiricem, iiNim, iirsnowm, iiNsnowm, & ! In - doicemicro, & ! In - trim( case )//input_file_cloud, & ! In - trim( case )//input_file_below, iunit ) ! In - - ! Allocate based on LH_microphys_calls and d_variables - allocate( LH_rt(nx,ny,nzm,LH_microphys_calls), LH_t(nx,ny,nzm,LH_microphys_calls), & - X_nl_all_levs(nx,ny,nzm,LH_microphys_calls,d_variables), & - X_mixt_comp_all_levs(nx,ny,nzm,LH_microphys_calls), & - LH_sample_point_weights(nx,ny,LH_microphys_calls), & - micro_field_prior(nx,ny,nzm,nmicro_fields), & - LH_micro_field_sum_tndcy(nx,ny,nzm,nmicro_fields), & - LH_micro_field_avg_tndcy(nx,ny,nzm,nmicro_fields) ) - - end if ! LH_microphys_type /= disabled -#else - LH_microphys_type = LH_microphys_disabled ! LH_microphys_type is needed even when LH is - ! not enabled in stats_subs.F90 (stats_finalize) - ! +++mhwang 2013-01 -#endif /*CLUBB_LH*/ - - if(l_stats_samgrid) then ! output clubb statistics in SAM - l_stats = .true. - stats_tsamp = dt_clubb - stats_tout = dt_clubb - call stats_init_clubb(l_stats, l_output_rad_files, stats_tsamp, & - stats_tout, nz, nz, nz, time, dt_clubb) - end if - -#ifdef CRM -!+++mhwang, 2012-02-06 (Minghuai.Wang@pnnl.gov) -! rho_ds_zm, rho_ds_zt, thv_ds_zt, thv_ds_zm, invrs_rho_ds_zm, invrs_rho_ds_zt are needed -! to be copied from those from the GCM at the beginning of each GCM time step. - if (lrestart_clubb) then - ! Set variables for the use of the anelastic equation set in CLUBB. - ! Set the value of dry, static, base-state density. - rho_ds_zm(:) = rhow(:) - rho_ds_zt(2:nz) = rho(1:nzm) - rho_ds_zt(1) = LIN_EXT( rho_ds_zt(3), rho_ds_zt(2), gr%zt(3), gr%zt(2), gr%zt(1) ) - ! Set the value of dry, base-state theta_v. - thv_ds_zt(2:nz) = tv0(1:nzm) - thv_ds_zt(1) = tv0(1) - thv_ds_zm(:) = zt2zm( thv_ds_zt ) - - ! Set the value of inverse dry, static, base-state density based on the - ! value of dry, static, base-state density. - invrs_rho_ds_zm(:) = 1.0 / rho_ds_zm(:) - invrs_rho_ds_zt(:) = 1.0 / rho_ds_zt(:) - end if -#endif /*CRM*/ - - ! If this is restart run, just return at this point and do not re-initialize - ! any variables as we would a run starting from the beginning. - -#ifndef CRM - if ( nrestart /= 0 ) return -#else - if (lrestart_clubb ) return -#endif - -#ifdef CLUBB_LH - call genrand_init( put=LH_seed ) -#endif - - if ( sclr_dim > 0 ) then - sclrp2 = 0._core_rknd - sclrprtp = 0._core_rknd - sclrpthlp = 0._core_rknd - wpsclrp = 0._core_rknd - end if - - ! Initialize CLUBB's tendencies to 0 - t_tndcy = 0._tndcy_precision - qc_tndcy = 0._tndcy_precision - qv_tndcy = 0._tndcy_precision - u_tndcy = 0._tndcy_precision - v_tndcy = 0._tndcy_precision - - if ( ntracers > 0 ) then - tracer_tndcy = 0._tndcy_precision - end if - - ! SAM's dynamical core is anelastic, so l_use_boussineq should probably be - ! set to false generally, as it is by default in the CLUBB SCM. - if ( l_use_boussinesq ) then - rho_ds_zm(:) = 1._core_rknd - rho_ds_zt(:) = 1._core_rknd - ! Set the value of dry, base-state theta_v. - thv_ds_zm(:) = theta0 - thv_ds_zt(:) = theta0 - else - ! Set variables for the use of the anelastic equation set in CLUBB. - ! Set the value of dry, static, base-state density. - rho_ds_zm(:) = real( rhow(:), kind=core_rknd ) - rho_ds_zt(2:nz) = real( rho(1:nzm), kind=core_rknd ) - rho_ds_zt(1) = LIN_EXT( rho_ds_zt(3), rho_ds_zt(2), gr%zt(3), gr%zt(2), gr%zt(1) ) - ! Set the value of dry, base-state theta_v. - thv_ds_zt(2:nz) = real( tv0(1:nzm), kind=core_rknd ) - thv_ds_zt(1) = real( tv0(1), kind=core_rknd ) - thv_ds_zm(:) = zt2zm( thv_ds_zt ) - end if - ! Set the value of inverse dry, static, base-state density based on the - ! value of dry, static, base-state density. - invrs_rho_ds_zm(:) = 1.0_core_rknd / rho_ds_zm(:) - invrs_rho_ds_zt(:) = 1.0_core_rknd / rho_ds_zt(:) - - ! Determine the initial value of some variables as in WRF-CLUBB - - wprtp(:,:,:) = 0._core_rknd ! w'rt' - wpthlp(:,:,:) = 0._core_rknd ! w'thl' - wprcp(:,:,:) = 0._core_rknd ! w'rc' - wp3(:,:,:) = 0._core_rknd ! w'^3 - wp2(:,:,:) = w_tol_sqd ! w'^2 - up2(:,:,:) = w_tol_sqd ! u'^2 - vp2(:,:,:) = w_tol_sqd ! v'^2 - rtp2(:,:,:) = rt_tol**2 ! rt'^2 - thlp2(:,:,:) = thl_tol**2 ! thl'^2 - rtpthlp(:,:,:) = 0._core_rknd ! rt'thl' - upwp(:,:,:) = 0._core_rknd ! u'w' - vpwp(:,:,:) = 0._core_rknd ! v'w' - - do i=1, nx, 1 - do j=1, ny, 1 - - ! Extrapolate intial SGS TKE and use it to compute wp2 - ! This value is going to depend on initial noise and whether - ! Smagorinksy diffusion is enabled - em(2:nz) = real( tke(i,j,1:nzm), kind=core_rknd ) - em(1) = LIN_EXT( em(3), em(2), gr%zt(3), gr%zt(2), gr%zt(1) ) - em(1:nz) = max( zt2zm( em(1:nz) ), em_min ) - -! em(:) = 1.0 ! Use this value for comparing DYCOMS II RF02 to the CLUBB SCM. - - !!!! Initialize w'^2 based on initial SGS TKE !!!! - - if ( l_tke_aniso ) then - - ! SGS TKE: em = (1/2) * ( w'^2 + u'^2 + v'^2 ) - ! Evenly divide SGS TKE into its component - ! contributions (w'^2, u'^2, and v'^2). - - wp2(i,j,1:nz) = (2._core_rknd/3._core_rknd) * em(1:nz) - up2(i,j,1:nz) = (2._core_rknd/3._core_rknd) * em(1:nz) - vp2(i,j,1:nz) = (2._core_rknd/3._core_rknd) * em(1:nz) - - else - - ! Assume isotropy for initialization of wp2 - ! SGS TKE: em = (3/2) * w'^2 - - wp2(i,j,1:nz) = (2._core_rknd/3._core_rknd) * em(1:nz) - - end if - - end do ! j=1..ny - end do ! i=1..nx - - return - end subroutine clubb_sgs_setup - -!------------------------------------------------------------------------------- - subroutine advance_clubb_sgs( dt_clubb, time_initial, time_current, & - rho, rhow, wsub, u, v, w, qpl, qci, qpi, & - t, qv, qcl ) - -! Description: -! Advance Cloud Layers Unified By Binormals one timestep. - -! References: -! ``A PDF-Based Model for Boundary Layer Clouds. Part I: -! Method and Model Description'' Golaz, et al. (2002) -! JAS, Vol. 59, pp. 3540--3551. -!------------------------------------------------------------------------------- - - ! From SAM - use crmx_grid, only: & - nx, ny, nxp1, nyp1, nz, nzm,&! Local grid dimensions - nx_gl, ny_gl, &! Global grid dimensions - dimx1_s, dimx2_s, dimy1_s, dimy2_s,& ! Scalars dimensions - dimx1_u, dimx2_u, dimy1_u, dimy2_u,& ! U wind dimensions - dimx1_v, dimx2_v, dimy1_v, dimy2_v,& ! V wind dimensions - dimx1_w, dimx2_w, dimy1_w, dimy2_w,& ! W wind dimensions - YES3D, rank, pres, dompi, & - ntracers - - use crmx_params, only: cp, lfus, lsub, & - ug, vg ! ug and vg are scalars, not arrays - - use crmx_params, only: doclubb ! Variable(s) - - use crmx_params, only: latitude0, longitude0 - - use crmx_vars, only: & - fcory, fluxbt, fluxbq, fluxbu, fluxbv, gamaz, prespot ! Variables - - use crmx_microphysics, only: nmicro_fields - - use crmx_clubbvars, only: & - upwp, &! u'w'. [m^2/s^2] - vpwp, &! u'w'. [m^2/s^2] - up2, &! u'^2 [m^2/s^2] - vp2, &! v'^2 [m^2/s^2] - wprtp, &! w' r_t'. [(m kg)/(s kg)] - wpthlp, &! w' th_l'. [(m K)/s] - wprcp, &! w' r_c'. [(kg/kg) m/s] - wp2, &! w'^2. [m^2/s^2] - rtp2, &! r_t'^2. [(kg/kg)^2] - thlp2, &! th_l'^2. [K^2] - rtpthlp, &! r_t' th_l'. [(kg K)/kg] - rcm, &! Cloud water [kg/kg] - cloud_frac, &! Cloud Fraction. [-] - rcm_in_layer,&! rcm in cloud layer [kg/kg] - cloud_cover, &! Cloud Cover [-] - wp3, &! w'^3. [m^3/s^3] - um, &! x-wind [m/s] - vm ! y-wind [m/s] - - use crmx_clubbvars, only: & - khzm, &! eddy diffusivity on momentum grids [m^2/s] - khzt, &! eddy diffusivity on thermo grids [m^2/s] - qclvarg, &! cloud water variance [kg^2/kg^2] - relvarg, &! relative cloud water variance - accre_enhang ! accretion enhancement - - - - use crmx_clubbvars, only: & - sclrp2, & ! Passive scalar variance. [{units vary}^2] - sclrpthlp, & ! Passive scalar covariance. [{units vary}^2] - sclrprtp, & ! Passive scalar covariance. [{units vary}^2] - wpsclrp ! w'sclr' [units vary m/s] - - use crmx_clubbvars, only: & - u_tndcy,& ! CLUBB contribution to the x wind - v_tndcy,& ! CLUBB contribution to the y wind - qv_tndcy,& ! CLUBB contribution to vapor water mixing ratio - qc_tndcy,& ! CLUBB contribution to liquid water mixing ratio - t_tndcy ! CLUBB contribution to moist static energy - - use crmx_clubbvars, only: & - tracer_tndcy ! CLUBB contribution to a set of tracers - - use crmx_clubbvars, only: & - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] - invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] - thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] - thv_ds_zt ! Dry, base-state theta_v on thermo. levels [K] - - use crmx_clubbvars, only: & - sclr_dim, & ! Constant(s) - edsclr_dim - - use crmx_clubbvars, only: & - tndcy_precision ! Constant(s) - -#ifndef CRM - use tracers, only: & -#else - use crmx_crmtracers, only: & -#endif - fluxbtr, & - tracer - - ! From CLUBB - use crmx_error_code, only: & - clubb_no_error, & ! Constant - clubb_at_least_debug_level ! Function - - use crmx_grid_class, only: & - zm2zt, zt2zm, & ! Functions - gr ! Derived type - - use crmx_stats_variables, only: & - l_stats, l_stats_samp ! Logicals - - use crmx_stats_subs, only: & - stats_begin_timestep, stats_end_timestep ! Subroutines - - use crmx_stat_clubb, only: stats_end_timestep_clubb - - use crmx_pdf_parameter_module, only: & - pdf_parameter ! Derived type - - use crmx_constants_clubb, only: & - fstderr ! Constant - -#ifdef CLUBB_LH - use crmx_parameters_microphys, only: & - l_lh_vert_overlap, & ! Variable(s) - LH_microphys_type, & - LH_microphys_disabled, & - LH_microphys_non_interactive, & - LH_microphys_calls, & - LH_sequence_length - - use crmx_variables_diagnostic_module, only: & - Lscale ! Variable(s) - - use crmx_fill_holes, only: & - vertical_avg ! Procedure(s) - - use crmx_parameters_model, only: & - hydromet_dim ! Variable(s) - - use crmx_array_index, only: & - iirrainm, iiNrm, iirsnowm, iiricem, & ! Variables - iiNcm, iiNsnowm, iiNim, iiNgraupelm, iirgraupelm - - use latin_hypercube_arrays, only: & - xp2_on_xm2_array_cloud, & ! Variable(s) - xp2_on_xm2_array_below, & - corr_array_cloud, & - corr_array_below, & - d_variables - - use crmx_corr_matrix_module, only: & - iiLH_s_mellor, iiLH_w, & - iiLH_rrain, iiLH_rsnow, iiLH_rice, & - iiLH_Nr, iiLH_Nsnow, iiLH_Ni, iiLH_Nc - - use latin_hypercube_driver_module, only: & - LH_subcolumn_generator, & ! Procedure(s) - stats_accumulate_LH - - use crmx_stats_subs, only: & - stats_accumulate_hydromet - - use crmx_stat_clubb, only: stats_end_timestep_clubb - - use crmx_microphysics, only: & - conc, micro_field, nmicro_fields ! Variable(s) - - use crmx_clubb_silhs_vars, only: & - LH_rt, & ! Variable(s) - LH_t, & - X_nl_all_levs, & - LH_sample_point_weights, & - X_mixt_comp_all_levs -#endif /*CLUBB_LH*/ - - implicit none - - ! Parameters - logical, parameter :: & - l_implemented = .true., & ! CLUBB is implemented in a host model, so this is true - l_advect = .false. ! Whether to advect around the high-order moments - - real(kind=core_rknd), parameter, dimension(nz) :: & - zero = 0.0_core_rknd ! Field of zeros - - ! Input - real(kind=time_precision), intent(in) :: & - dt_clubb ! Timestep size for CLUBB [s] - - real(kind=time_precision), intent(in) :: & - time_initial, time_current ! Initial and current time [s] - - real, intent(in), dimension(nzm) :: & - rho ! Air density [kg/m^3] - - real, intent(in), dimension(nz) :: & - wsub,&! Imposed vertical velocity [m/s] - rhow ! Density on vert velocity grid [kg/m^3] - - real, intent(in), dimension(dimx1_u:dimx2_u,dimy1_u:dimy2_u,nzm) :: & - u ! u wind [m/s] - - real, intent(in), dimension(dimx1_v:dimx2_v,dimy1_v:dimy2_v,nzm) :: & - v ! v wind [m/s] - - real, intent(in), dimension(dimx1_w:dimx2_w, dimy1_w:dimy2_w, nz ) :: & - w ! Vertical wind [m/s] - - real, intent(in), dimension(nx,ny,nzm) :: & - qpl,& ! Liquid water mixing ratio (precipitation) [kg/kg] - qci,& ! Cloud ice water mixing ratio [kg/kg] - qpi ! Snow + graupel mixing ratio (precip) [kg/kg] - - real, intent(in), dimension(dimx1_s:dimx2_s,dimy1_s:dimy2_s,nzm) :: & - t ! Moist static energy [K] - - real, intent(in), dimension(nx,ny,nzm) :: & - qv, & ! Water vapor mixing ratio [kg/kg] - qcl ! Liquid water mixing ratio (condensate) [kg/kg] - - ! Local Variables - real(kind=core_rknd) :: & - wpthlp_sfc, &! w' theta_l' at surface [(m K)/s] - wprtp_sfc, &! w' r_t' at surface [(kg m)/( kg s)] - upwp_sfc, &! u'w' at surface [m^2/s^2] - vpwp_sfc ! v'w' at surface [m^2/s^2] - - real(kind=core_rknd), dimension(nz) :: & - thlm, &! Liquid water potential temperature (theta_l) [K] - rtm, &! Total water mixing ratio [kg/kg] - p_in_Pa, &! Pressure [Pa] - rho_zt, &! Density on pressure levels [kg/m^3] - rho_zm, &! Density on momentum levels [kg/m^3] - exner, &! Exner function [-] - wm_zm, &! Imposed subs. + perturbation w on vertical vel. levels [m/s] - wm_zt, &! Imposed subs. + perturbation w on pressure levels [m/s] - rfrzm ! Total ice-phase water mixing ratios [kg/kg] - - real, dimension(nz) :: & - dum ! Dummy array for advection - - real(kind=core_rknd), allocatable, dimension(:,:) :: & - sclrm, & ! Array for high order passive scalars - sclrm_forcing, & ! Large-scale forcing array for passive scalars - edsclrm, & ! Array for eddy passive scalars - edsclrm_forcing ! Large-scale forcing array for eddy passive scalars - - real(kind=core_rknd), allocatable, dimension(:) :: & - wpedsclrp_sfc, & ! Array for passive scalar surface flux - wpsclrp_sfc ! Array for high order scalar surface flux - - ! Thermo grid versions of variables on the momentum grid - real, dimension(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nz) :: & - wp2_zt, rtp2_zt, thlp2_zt, rtpthlp_zt, & - wprtp_zt, wpthlp_zt, up2_zt, vp2_zt, & - um_r4, vm_r4, um_old, vm_old ! wind arrays - - real(kind=tndcy_precision), dimension(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nz) :: & - um_change, vm_change ! Change in u/v [m/s^2] - - type(pdf_parameter), allocatable, dimension(:) :: & - pdf_params ! PDF parameters [units vary] - -#ifdef CLUBB_LH - real(kind=core_rknd), dimension(nz,hydromet_dim) :: & - hydromet ! Collection of all microphysics fields [units vary] - - real(kind=core_rknd), dimension(nzm) :: & - Lscale_vert_avg - - real(kind=core_rknd), dimension(nzm,LH_microphys_calls) :: & - LH_thl -#endif /* CLUBB_LH */ - - real(kind=core_rknd), dimension(nz) :: & - ice_supersat_frac, & - radf - - real(kind=core_rknd), dimension(nz) :: & - khzttemp, khzmtemp - - real(kind=core_rknd), dimension(nz) :: qclvartemp - - integer :: err_code - - ! Array indices - integer :: i, j, k, ig, jg, ip1, jp1, jm1, indx - -#ifdef CLUBB_LH - integer :: km1, kp1 -#endif -!------------------------------------------------------------------------------- - - !----- Begin Code ----- - -#ifndef CRM - call t_startf('advance_clubb') ! For timing -#endif - - ! Initialize err_code to CLUBB_no_error. In the event of the singular - ! matrix, etc. the variable will be set to the appropriate error code - ! within advance_clubb_core - err_code = CLUBB_no_error - - ! Feed nothing into radf (set it to zero) - radf(1:nz) = 0.0_core_rknd - - ! Density is in correct units - rho_zt(2:nz) = real( rho(1:nzm), kind=core_rknd ) - rho_zt(1) = LIN_EXT( rho_zt(3), rho_zt(2), gr%zt(3), gr%zt(2), gr%zt(1) ) - - rho_zm(1:nz) = real( rhow(1:nz), kind=core_rknd ) - - ! Compute and extrapolate Exner function - exner(2:nz) = 1.0_core_rknd / real( prespot(1:nzm), kind=core_rknd ) - exner(1) = 1.0_core_rknd / LIN_EXT( exner(3), exner(2), gr%zt(3), gr%zt(2), gr%zt(1) ) - - ! Allocate passive scalar arrays - allocate( wpsclrp_sfc(sclr_dim), sclrm(nz,sclr_dim), & - sclrm_forcing(nz,sclr_dim) ) - allocate( wpedsclrp_sfc(edsclr_dim), edsclrm(nz,edsclr_dim), & - edsclrm_forcing(nz,edsclr_dim) ) - - ! Allocate variables for the PDF closure scheme - allocate( pdf_params(1:nz) ) - - um_r4 = 0.0 - vm_r4 = 0.0 - do i = 1, nx, 1 - do j = 1, ny, 1 - - ip1 = min( nxp1, i+1 ) ! This is redundant, but we include it for safety - jp1 = min( nyp1, j+1 ) ! This prevents an array out of bounds error - ! for dvdt in a 2D simulation - - ! Average u-wind (east-west wind) to scalar points. - um_r4(i,j,2:nz) = 0.5 * ( u(i,j,1:nzm) + u(ip1,j,1:nzm) ) + ug -! um_r4(i,j,2:nz) = u(i,j,1:nzm) + ug - - um_r4(i,j,1) = um_r4(i,j,2) - - ! Average v-wind (north-south wind) to scalar points. - vm_r4(i,j,2:nz) = 0.5 * ( v(i,j,1:nzm) + v(i,jp1,1:nzm) ) + vg -! vm_r4(i,j,2:nz) = v(i,j,1:nzm) + vg - - vm_r4(i,j,1) = vm_r4(i,j,2) - end do - end do - - ! Adjust the ghost points to allow for interpolation back on to - ! the u & v grid points -#ifndef CRM - if ( dompi ) then - call task_exchange( um_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & - nzm, 3,3,3,3, ntracers+nmicro_fields+19) - call task_exchange( vm_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & - nzm, 3,3,3,3, ntracers+nmicro_fields+20) - else -#endif /*CRM*/ - call bound_exchange( um_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & - nzm, 3,3,3,3, ntracers+nmicro_fields+19) - call bound_exchange( vm_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & - nzm, 3,3,3,3, ntracers+nmicro_fields+20) -#ifndef CRM - end if -#endif /*CRM*/ - ! Lower Boundary condition on u/v - um_r4(:,:,1) = um_r4(:,:,2) - vm_r4(:,:,1) = vm_r4(:,:,2) - - ! Preserve value of u and v to calculate total change from CLUBB - um_old = um_r4 - vm_old = vm_r4 - - ! Copy the SAM precision values into CLUBB precision arrays - um = real( um_r4, kind=core_rknd ) - vm = real( vm_r4, kind=core_rknd ) - - do i=1, nx, 1 - - do j=1, ny, 1 - - if(.not.l_stats_samgrid) then ! clubb statistics output from clubb - ! Sample from a single column - if ( is_a_sample_node( rank ) .and. i == x_samp_node .and. j == y_samp_node & - .and. lstats_clubb ) then - !+++mhwang remove dt_clubb, as with dt_clubb, CLUBB crashed because - ! the number of samples may not be equal to stats_tout/stats_tsamp - ! in stats_end_timestep in stats_subs.F90 - !---mhwang 2013-02 - ! call stats_begin_timestep( time_current-time_initial+dt_clubb ) - call stats_begin_timestep( time_current-time_initial) - else - l_stats_samp = .false. - end if - else ! clubb statistics output from sam - call stats_begin_timestep( time_current-time_initial) - end if - - ! The 2-D flux arrays are already in the correct units - wprtp_sfc = real( fluxbq(i,j), kind=core_rknd ) ! [m kg/kg s] - wpthlp_sfc = real( fluxbt(i,j), kind=core_rknd ) ! [m K/s] -! Vince Larson set sfc momentum flux constant, as a temporary band-aid. -! 25 Feb 2008. - ! These are set for the purposes of computing sfc_var, but this value is - ! not applied to the value of u and v in SAM. - upwp_sfc = real( fluxbu(i,j), kind=core_rknd ) - vpwp_sfc = real( fluxbv(i,j), kind=core_rknd ) -! End of Vince Larson's change - - ! Set the surface flux of the two scalar types to the tracer flux at the - ! bottom of the domain, and set edsclrm to the tracer - do indx = 1, edsclr_dim, 1 - wpedsclrp_sfc(indx) = real( fluxbtr(i,j,indx), kind=core_rknd ) - edsclrm(2:nz,indx) = real( tracer(i,j,1:nzm,indx), kind=core_rknd ) - edsclrm(1,indx) = real( LIN_EXT( edsclrm(3,indx), edsclrm(2,indx), & - gr%zt(3), gr%zt(2), gr%zt(1) ), kind=core_rknd ) - - edsclrm_forcing(1:nz,indx) = 0.0_core_rknd - end do - - do indx = 1, sclr_dim, 1 - wpsclrp_sfc(indx) = real( fluxbtr(i,j,indx), kind=core_rknd ) - sclrm(2:nz,indx) = real( tracer(i,j,1:nzm,indx), kind=core_rknd ) - sclrm(1,indx) = LIN_EXT( sclrm(3,indx), sclrm(2,indx), & - gr%zt(3), gr%zt(2), gr%zt(1) ) - sclrm_forcing(1:nz,indx) = 0.0_core_rknd - end do - - - ! Check for negative values of water vapor being fed from SAM into CLUBB - if ( clubb_at_least_debug_level( 2 ) ) then - do k=1,nzm - if ( qv(i,j,k) < 0. ) then - write(fstderr,*) 'SAM has fed into CLUBB negative rv at grid point i,j,k =', & - i, j, k - end if - end do - - ! Check for negative values of cloud water being fed from SAM into CLUBB - do k=1,nzm - if ( qcl(i,j,k) < 0. ) then - write(fstderr,*) 'SAM has fed into CLUBB negative qcl at grid point i,j.k =', & - i, j, k - end if - end do - end if ! clubb_at_least_debug_level( 2 ) - - ! Total water. Since the SCM does not account for ice, we sum only the - ! non-precipitating liquid and vapor - - ! Total water is the sum of non-precipitating liquid + vapor - rtm(2:nz) = real( qv(i,j,1:nzm) + qcl(i,j,1:nzm), kind=core_rknd ) - rtm(1) = rtm(2) - - ! Cloud water is total non-precipitating liquid - rcm(i,j,2:nz) = real( qcl(i,j,1:nzm), kind=core_rknd ) - rcm(i,j,1) = 0.0_core_rknd ! No below ground cloud water - - ! Note: t is moist static energy, which is not quite the same as liquid - ! potential temperature. - thlm(2:nz) = t2thetal( t(i,j,1:nzm), gamaz(1:nzm), & - qcl(i,j,1:nzm), qpl(i,j,1:nzm), & - qci(i,j,1:nzm), qpi(i,j,1:nzm), & - prespot(1:nzm) ) - thlm(1) = thlm(2) - - ! The w variable requires no extrapolation - - ! Vince Larson added option for l_advect = .true. . 13 Mar 2008. - ! SAM's subroutine 'subsidence' imposes wsub on t, q, u, and v. - ! SAM advects all means using u, v, w. - ! When implemented in a host model, CLUBB imposes wm_zm/wm_zt on higher-order - ! moments but not means. - ! (l_advect=.true.) advects all higher-order moments using u, v, w. - if ( l_advect ) then - wm_zt(1) = 0._core_rknd - wm_zt(2:nz) = real( wsub(1:nzm), kind=core_rknd ) ! Use this if l_advect = .true. - wm_zm = zt2zm( wm_zt ) - else ! l_advect = .false. - ! Higher-order moments are advected vertically but not horizontally. - ! In principle, this could lead to undesirable accumulation. - wm_zt(1) = 0._core_rknd ! Set ghost point to 0. - wm_zt(2:nz) = real( wsub(1:nzm), kind=core_rknd ) ! wsub is on the t-levels - wm_zm(1:nz) = zt2zm( wm_zt ) ! Interpolate imposed subsidence to m-levels - - ! Resolved vertical velocity is on the momentum levels - wm_zm(1:nz) = wm_zm(1:nz) + real( w(i,j,1:nz), kind=core_rknd ) - ! Interpolate resolved w to t-levels - wm_zt(1:nz) = wm_zt + zm2zt( real( w(i,j,1:nz), kind=core_rknd ) ) - end if - ! End Vince Larson's commenting - - ! Add in pressure perturbation, extrapolate, & convert from mb to Pa. - ! Vince Larson of UWM removed perturbation pressure to avoid - ! negative pressure at domain top in ARM9707. 22 Dec 2007. - ! pr(2:nz) = 100. * ( pres(1:nzm) + p(i,j,1:nzm) ) - ! pr(1) = 100. * LIN_EXT( pres(2)+p(i,j,2), pres(1)+p(i,j,1), & - ! gr%zt(3), gr%zt(2), gr%zt(1) ) - P_in_Pa(2:nz) = 100._core_rknd * real( pres(1:nzm), kind=core_rknd ) - P_in_Pa(1) = LIN_EXT( P_in_Pa(3), P_in_Pa(2), & - gr%zt(3), gr%zt(2), gr%zt(1) ) - - ! End Vince Larson's change. - - ! Sum all forms of ice - rfrzm(2:nz) = real( qpi(i,j,1:nzm) + qci(i,j,1:nzm), kind=core_rknd ) - rfrzm(1) = 0._core_rknd - - ! Call the single column model, CLUBB - call advance_clubb_core & - ( l_implemented, dt_clubb, real( fcory(j), kind=core_rknd ), gr%zm(1), & ! In - zero(:), zero(:), zero(:), zero(:), & ! In - sclrm_forcing, edsclrm_forcing, zero(:), & ! In - zero(:), zero(:), zero(:), & ! In - zero(:), wm_zm(:), wm_zt(:), & ! In - wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & ! In - wpsclrp_sfc, wpedsclrp_sfc, & ! In - P_in_Pa(:), rho_zm(:), rho_zt(:), exner(:), & ! In - rho_ds_zm(:), rho_ds_zt(:), invrs_rho_ds_zm(:), & ! In - invrs_rho_ds_zt(:), thv_ds_zm(:), thv_ds_zt(:), & ! In - rfrzm(:), radf, & ! In - um(i,j,:), vm(i,j,:), upwp(i,j,:), vpwp(i,j,:), up2(i,j,:), vp2(i,j,:), & ! In/out - thlm(:), rtm(:), wprtp(i,j,:), wpthlp(i,j,:), & ! In/out - wp2(i,j,:), wp3(i,j,:), rtp2(i,j,:), thlp2(i,j,:), rtpthlp(i,j,:), & ! In/out - sclrm, sclrp2(i,j,:,:), sclrprtp(i,j,:,:), sclrpthlp(i,j,:,:), & ! In/out - wpsclrp(i,j,:,:), edsclrm, err_code, & ! In/out - rcm(i,j,:), wprcp(i,j,:), cloud_frac(i,j,:), ice_supersat_frac, & ! Out - rcm_in_layer(i,j,:), cloud_cover(i,j,:), khzmtemp(:), khzttemp(:), qclvartemp(:), pdf_params ) ! Out - khzt(i,j,1:nzm) = real(khzttemp(2:nz)) - khzm(i,j,1:nzm) = real(khzmtemp(1:nz-1)) - qclvarg(i,j,1:nzm) = real(qclvartemp(2:nz)) - -! diagnose the relative variance of in-cloud water -! The relative variance of in-cloud water follows Guo et al., 2013, J. Climate -! Note this formula is different from what is used in CAM5_CLUBB (Bogenschutz et al., 2013, J. Climate) -! the accretion enhancment follows CAM5_CLUBB -! - do k=1, nzm - relvarg(i,j,k) = 8.0 - accre_enhang(i,j,k) = 1.0 - if(rcm(i,j,k+1).gt.0. .and. qclvartemp(k+1).gt.0) then - relvarg(i,j,k) = real(cloud_frac(i,j,k+1)*qclvartemp(k+1) - (1.-cloud_frac(i,j,k+1))*rcm(i,j,k+1)**2) - if(relvarg(i,j,k).gt. (1.0e-3*(rcm(i,j,k+1)**2)) ) then - relvarg(i,j,k) = real(rcm(i,j,k+1)**2)/relvarg(i,j,k) - else - relvarg(i,j,k) = 1000. - end if - relvarg(i,j,k) = min(1.0, max(0.1, relvarg(i,j,k))) - end if - accre_enhang(i,j,k) = 1.+0.65*(1.0/real(relvarg(i,j,k))) - end do - -#ifdef CLUBB_LH - if ( LH_microphys_type /= LH_microphys_disabled ) then - hydromet = 0._core_rknd - hydromet(2:nz,iiNcm) = real( conc(i,j,1:nzm), kind=core_rknd ) - - if ( iirrainm > 0 ) hydromet(2:nz,iirrainm) = micro_field(i,j,:,iirrainm) - if ( iiNrm > 0 ) hydromet(2:nz,iiNrm) = micro_field(i,j,:,iiNrm) - - if ( iirsnowm > 0 ) hydromet(2:nz,iirsnowm) = micro_field(i,j,:,iirsnowm) - if ( iiNsnowm > 0 ) hydromet(2:nz,iiNsnowm) = micro_field(i,j,:,iiNsnowm) - - if ( iiricem > 0 ) hydromet(2:nz,iiricem) = micro_field(i,j,:,iiricem) - if ( iiNim > 0 ) hydromet(2:nz,iiNim) = micro_field(i,j,:,iiNim) - - ! Note: graupel is not a part of X_nl_all_levs. These lines are - ! strictly for the purpose of outputting graupel from a single column - if ( iirgraupelm > 0 ) hydromet(2:nz,iirgraupelm) = micro_field(i,j,:,iirgraupelm) - if ( iiNgraupelm > 0 ) hydromet(2:nz,iiNgraupelm) = micro_field(i,j,:,iiNgraupelm) - - if ( l_lh_vert_overlap ) then - ! Determine 3pt vertically averaged Lscale - do k = 1, nzm, 1 - kp1 = min( k+1, nz ) - km1 = max( k-1, 1 ) - Lscale_vert_avg(k) = vertical_avg & - ( (kp1-km1+1), rho_ds_zt(km1:kp1), & - Lscale(km1:kp1), gr%invrs_dzt(km1:kp1) ) - end do - else - ! If vertical overlap is disabled, this calculation won't be needed - Lscale_vert_avg = -999. - end if - - call LH_subcolumn_generator & - ( LH_iter, d_variables, LH_microphys_calls, LH_sequence_length, nzm, & ! In - thlm(2:nz), pdf_params(2:nz), wm_zt(2:nz), gr%dzt(2:nz), rcm(i,j,2:nz), & ! In - hydromet(2:nz,iiNcm), rtm(2:nz)-rcm(i,j,2:nz), & ! In - hydromet(2:nz,:), xp2_on_xm2_array_cloud, xp2_on_xm2_array_below, & ! In - corr_array_cloud, corr_array_below, Lscale_vert_avg, & ! In - X_nl_all_levs(i,j,:,:,:), X_mixt_comp_all_levs(i,j,:,:), & ! Out - LH_rt(i,j,:,:), LH_thl, LH_sample_point_weights(i,j,:) )! Out - - ! Convert the thetal sample points into moist static energy sample points - LH_t(i,j,:,:) = convert_thl_to_t_LH( LH_thl, gamaz, prespot, X_nl_all_levs(i,j,:,:,:) ) - - ! Increment the iteration count for the purpose of knowing whether to repeat - LH_iter = LH_iter + 1 - - if(.not.l_stats_samgrid) then - if ( is_a_sample_node( rank ) .and. i == x_samp_node .and. j == y_samp_node ) then - call stats_accumulate_hydromet( hydromet, rho_ds_zt ) ! In - end if - else - ! will this be corret???+++mhwang - call stats_accumulate_hydromet( hydromet, rho_ds_zt ) - end if - end if -#endif - if(.not.l_stats_samgrid) then ! clubb stastics output in clubb - ! Sample stats from a single column - if ( is_a_sample_node( rank ) .and. i == x_samp_node .and. j == y_samp_node ) then - call stats_end_timestep( ) - end if - else ! clubb stastics output in sam - call stats_end_timestep_clubb(i, j) - end if - - ! Check if a critical error has occured within the CLUBB model - if ( err_code /= clubb_no_error ) then - call task_rank_to_index( rank, ig, jg ) - write(fstderr,*) "Task #:", rank, err_code - write(fstderr,*) "Single-column model failed at: ", "nx=", i, ";", "ny=", j, ";" - write(fstderr,*) "x global=", i+ig, ";", "y global=", j+jg, ";" - write(fstderr,*) "longitude=", longitude0, "latitude=", latitude0 - call task_abort( ) - end if - - ! If we're not doing a doclubbnoninter run, then we feed the results back - ! into the 3D SAM model arrays. Here we compute the total tendency to - ! allow for subcycling and save compute time. - if ( doclubb ) then - - ! Check for negative values of water vapor - if ( clubb_at_least_debug_level( 2 ) ) then - do k=1,nz - if ( ( rtm(k) - rcm(i,j,k) ) < 0._core_rknd ) then - write(fstderr,*) 'CLUBB has produced negative rvm at grid level k=', k - end if - end do - end if ! clubb_at_least_debug_level( 2 ) - - ! Re-compute vapor for total water and liquid from CLUBB - !qv(i,j,1:nzm) = rtm(2:nz) - rcm(i,j,2:nz) - qv_tndcy(i,j,1:nzm) = & - ( rtm(2:nz) - rcm(i,j,2:nz) - real( qv(i,j,1:nzm), kind=core_rknd ) ) / dt_clubb - - if ( clubb_at_least_debug_level( 2 ) ) then - ! Check for negative values of cloud water - do k=1,nz - if ( rcm(i,j,k) < 0._core_rknd ) then - write(fstderr,*) 'CLUBB has produced negative rcm at grid level k=', k - end if - end do - end if ! clubb_at_least_debug_level( 2 ) - - ! Re-compute qcl based on new rcm - !qcl(i,j,1:nzm) = rcm(i,j,2:nz) - ! Compute tendency of total water due to CLUBB - qc_tndcy(i,j,1:nzm) = ( rcm(i,j,2:nz) - real( qcl(i,j,1:nzm), kind=core_rknd ) ) & - / dt_clubb - - ! Compute moist static energy based on new thetal -! t(i,j,1:nzm) = thetal2t( thlm(2:nz), gamaz(1:nzm), & -! qcl(i,j,1:nzm), qpl(i,j,1:nzm), & -! qci(i,j,1:nzm), qpi(i,j,1:nzm), & -! prespot(1:nzm) ) - - ! Compute tendency of moist static energy due to CLUBB - ! Note that this formula assumes qci/qpl/qpi won't change rapidly in - ! the time between successive clubb calls in order to avoid calling - ! thetal2t on at every SAM timestep -dschanen 27 Oct 08 - t_tndcy(i,j,1:nzm) = & - ( thetal2t( thlm(2:nz), gamaz(1:nzm), rcm(i,j,2:nz), & - qpl(i,j,1:nzm), qci(i,j,1:nzm), qpi(i,j,1:nzm), prespot(1:nzm) ) & - - real( t(i,j,1:nzm), kind=core_rknd ) ) / dt_clubb - - do indx = 1, edsclr_dim - tracer_tndcy(i,j,1:nzm,indx) = & - ( edsclrm(2:nz,indx) - real( tracer(i,j,1:nzm,indx), kind=core_rknd ) ) & - / dt_clubb - end do - - do indx = 1, sclr_dim - tracer_tndcy(i,j,1:nzm,indx) = & - ( sclrm(2:nz,indx) - real( tracer(i,j,1:nzm,indx), kind=core_rknd ) ) / dt_clubb - end do - - end if ! doclubb - - end do ! j - - end do ! i - - ! De-allocate temporary arrays. This is just in case the compiler isn't - ! 100% Fortran 95 compliant and doesn't de-allocate this memory when it - ! leaves the scope of advance_clubb_sgs - deallocate( wpsclrp_sfc, sclrm ) - deallocate( wpedsclrp_sfc, edsclrm ) - deallocate( pdf_params ) - - ! Copy back the value from the CLUBB precision um and vm - um_r4 = real( um ) - vm_r4 = real( vm ) - - if ( doclubb ) then - - ! Adjust the ghost points to allow for interpolation back onto the u & v grid -#ifndef CRM - if ( dompi ) then - call task_exchange( um_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & - nzm, 3,3,3,3, ntracers+nmicro_fields+19) - call task_exchange( vm_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & - nzm, 3,3,3,3, ntracers+nmicro_fields+20) - else -#endif /*CRM*/ - call bound_exchange( um_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & - nzm, 3,3,3,3, ntracers+nmicro_fields+19) - call bound_exchange( vm_r4(:,:,2:nz), dimx1_s, dimx2_s, dimy1_s, dimy2_s, & - nzm, 3,3,3,3, ntracers+nmicro_fields+20) -#ifndef CRM - end if -#endif - - ! Compute the total change in u due to the CLUBB part of the code - um_change = real( um_r4 - um_old, kind=tndcy_precision ) / dt_clubb - vm_change = real( vm_r4 - vm_old, kind=tndcy_precision ) / dt_clubb - - ! Average the contributions of CLUBB to the wind back on to the u and v grid - ! This has shown to make the model unstable at fine horizontal resolution. - ! To interpolate across subdomain boundaries requires that we - ! transfer information using MPI (via task_exchange). - do i=1, nx, 1 - do j=1, ny, 1 - jm1 = max( dimy1_s, j-1 ) ! For the 2D case vm wind - - ! The horiztontal grid in SAM is always evenly spaced, so we just use - ! 0.5 *( x(n-1)+x(n) ) to interpolate back to the u,v point on the Arakawa C grid - u_tndcy(i,j,1:nzm) = & - 0.4_tndcy_precision * & ! This is a made up coefficient to reduce numerical instability - 0.5_tndcy_precision * & - real( um_change(i,j,2:nz) + um_change(i-1,j,2:nz), kind=tndcy_precision ) - v_tndcy(i,j,1:nzm) = & - 0.4_tndcy_precision * & ! This is a made up coefficient to reduce numerical instability - 0.5_tndcy_precision * & - real( vm_change(i,j,2:nz) + vm_change(i,jm1,2:nz), kind=tndcy_precision ) - - end do ! j - - end do ! i - - end if ! doclubb - - -! Vince Larson attempted to advect higher-order moments horizontally. -! 26 Feb 2008. - -! Horizontal advection of higher-order moments. - -! The following method has the drawback of requiring two interpolations, -! which unnecesarily smooths the fields in the vertical. -! In preparation for advection, interpolate to thermodynamic (scalar) vertical gridpoints. -! (wp3 is already on the thermodynamic gridpoints.) - - -!print*, 'Before advection, wp2(nx,ny,:) =', wp2(nx,ny,:) -! For now we default to not doing this, because the interpolation seems to cause -! and artificial rise in fields such as moisture at a coarse model resolution. -! -dschanen 29 Apr 2008 - if ( l_advect ) then - - do i=1, nx, 1 - do j=1, ny, 1 - - wp2_zt(i,j,:) = real( zm2zt( wp2(i,j,:) ) ) - up2_zt(i,j,:) = real( zm2zt( up2(i,j,:) ) ) - vp2_zt(i,j,:) = real( zm2zt( vp2(i,j,:) ) ) - rtp2_zt(i,j,:) = real( zm2zt( rtp2(i,j,:) ) ) - thlp2_zt(i,j,:) = real( zm2zt( thlp2(i,j,:) ) ) - rtpthlp_zt(i,j,:) = real( zm2zt( rtpthlp(i,j,:) ) ) - wprtp_zt(i,j,:) = real( zm2zt( wprtp(i,j,:) ) ) - wpthlp_zt(i,j,:) = real( zm2zt( wpthlp(i,j,:) ) ) - - end do ! j - end do ! i - -#ifndef CRM - if ( dompi ) then - - call task_exchange( wp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+10 ) - call task_exchange( rtp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+11 ) - call task_exchange( thlp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+12 ) - call task_exchange( rtpthlp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+13 ) - call task_exchange( wprtp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+14 ) - call task_exchange( wpthlp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+15 ) - call task_exchange( wp3(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+16 ) - call task_exchange( up2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+17 ) - call task_exchange( vp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+18 ) - else -#endif /*CRM*/ - - call bound_exchange( wp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+10 ) - call bound_exchange( rtp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+11 ) - call bound_exchange( thlp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+12 ) - call bound_exchange( rtpthlp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+13 ) - call bound_exchange( wprtp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+14 ) - call bound_exchange( wpthlp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+15 ) - call bound_exchange( wp3(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+16 ) - call bound_exchange( up2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+17 ) - call bound_exchange( vp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dimx1_s, dimx2_s, dimy1_s, dimy2_s, nzm, 3,3,3,3, & - ntracers+nmicro_fields+18 ) - -#ifndef CRM - end if -#endif - - ! Now call the standard SAM advection subroutine for scalars - call advect_scalar( wp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dum(1:nz), dum(1:nz), dum(1:nzm), & - dum(1:nzm), dum(1:nzm), .false. ) - - call advect_scalar( wp3(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dum(1:nz), dum(1:nz), dum(1:nzm), & - dum(1:nzm), dum(1:nzm), .false. ) - - call advect_scalar( rtp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dum(1:nz), dum(1:nz), dum(1:nzm), & - dum(1:nzm), dum(1:nzm), .false. ) - - call advect_scalar( thlp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dum(1:nz), dum(1:nz), dum(1:nzm), & - dum(1:nzm), dum(1:nzm), .false. ) - - call advect_scalar( rtpthlp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dum(1:nz), dum(1:nz), dum(1:nzm), & - dum(1:nzm), dum(1:nzm), .false. ) - - call advect_scalar( wprtp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dum(1:nz), dum(1:nz), dum(1:nzm), & - dum(1:nzm), dum(1:nzm), .false. ) - - call advect_scalar( wpthlp_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dum(1:nz), dum(1:nz), dum(1:nzm), & - dum(1:nzm), dum(1:nzm), .false. ) - - call advect_scalar( up2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dum(1:nz), dum(1:nz), dum(1:nzm), & - dum(1:nzm), dum(1:nzm), .false. ) - - call advect_scalar( vp2_zt(dimx1_s:dimx2_s,dimy1_s:dimy2_s,2:nz), & - dum(1:nz), dum(1:nz), dum(1:nzm), & - dum(1:nzm), dum(1:nzm), .false. ) - -!print*, 'After advect, wp2_zt(dimx2_s,dimy2_s,:) =', wp2_zt(dimx2_s,dimy2_s,:) -! -!do i=dimx1_s, dimx2_s, 1 -! do j=dimy1_s, dimy2_s, 1 -! if ( any ( rtp2_zt(i,j,:) < 0.0 ) ) then -! print*, 'After advect, rtp2_zt at ', i, j, " = ", rtp2_zt(i,j,:) -! end if -! end do ! i -!end do ! j -! Now interpolate back to momentum gridpoints. -! (wp3 is already on the thermodynamic gridpoints.) -! do i=dimx1_s, dimx2_s, 1 -! do j=dimy1_s, dimy2_s, 1 - do i=1, nx, 1 - do j=1, ny, 1 - - wp2(i,j,:) = zt2zm( real( wp2_zt(i,j,:), kind=core_rknd ) ) - up2(i,j,:) = zt2zm( real( up2_zt(i,j,:), kind=core_rknd ) ) - vp2(i,j,:) = zt2zm( real( vp2_zt(i,j,:), kind=core_rknd ) ) - rtp2(i,j,:) = zt2zm( real( rtp2_zt(i,j,:), kind=core_rknd ) ) - thlp2(i,j,:) = zt2zm( real( thlp2_zt(i,j,:), kind=core_rknd ) ) - rtpthlp(i,j,:) = zt2zm( real( rtpthlp_zt(i,j,:), kind=core_rknd ) ) - wprtp(i,j,:) = zt2zm( real( wprtp_zt(i,j,:), kind=core_rknd ) ) - wpthlp(i,j,:) = zt2zm( real( wpthlp_zt(i,j,:), kind=core_rknd ) ) - - end do ! j - end do ! i - - ! Clip variances where the top point is negative - where ( wp2(:,:,nz) < 0._core_rknd ) wp2(:,:,nz) = 0._core_rknd - where ( up2(:,:,nz) < 0._core_rknd ) up2(:,:,nz) = 0._core_rknd - where ( vp2(:,:,nz) < 0._core_rknd ) vp2(:,:,nz) = 0._core_rknd - where ( rtp2(:,:,nz) < 0._core_rknd ) rtp2(:,:,nz) = 0._core_rknd - where ( thlp2(:,:,nz) < 0._core_rknd ) thlp2(:,:,nz) = 0._core_rknd - - ! Clip variances where the bottom point is negative - where ( wp2(:,:,1) < 0._core_rknd ) wp2(:,:,1) = 0._core_rknd - where ( up2(:,:,1) < 0._core_rknd ) up2(:,:,1) = 0._core_rknd - where ( vp2(:,:,1) < 0._core_rknd ) vp2(:,:,1) = 0._core_rknd - where ( rtp2(:,:,1) < 0._core_rknd ) rtp2(:,:,1) = 0._core_rknd - where ( thlp2(:,:,1) < 0._core_rknd ) thlp2(:,:,1) = 0._core_rknd - - -!do i=1, nx, 1 -! do j=1, ny, 1 -! if ( any ( rtp2(i,j,:) < 0.0 ) ) then -! print*, 'After interp, rtp2 at ', i, j, " = ", rtp2(i,j,:) -! end if -! end do ! i -!end do ! j -! -!print*, 'After interp back, wp2(nx,ny,:) =', wp2(nx,ny,:) -!! End of Vince Larson's changes. - end if ! ladvect - -#ifndef CRM - call t_stopf('advance_clubb') ! For timing -#endif - - return - end subroutine advance_clubb_sgs - -!------------------------------------------------------------------------------- - subroutine apply_clubb_sgs_tndcy( dt, t, qv, qcl, dudt, dvdt ) - - use crmx_grid, only: & - nx, nxp1, ny, nyp1, dimx1_s, dimx2_s, dimy1_s, dimy2_s, nz, nzm, na, & - rank - - use crmx_domain, only: & - ntracers - -#ifndef CRM - use tracers, only: & -#else - use crmx_crmtracers, only: & -#endif - tracer - - use crmx_clubbvars, only: & - u_tndcy, & ! CLUBB contribution to the x wind - v_tndcy, & ! CLUBB contribution to the y wind - t_tndcy, & ! CLUBB contribution to moist static energy - qc_tndcy,& ! CLUBB contribution to liquid water mixing ratio - qv_tndcy ! CLUBB contribution to vapor water mixing ratio - - use crmx_clubbvars, only: & - tracer_tndcy - - use crmx_clubbvars, only: & - sclr_dim, & ! Constant(s) - edsclr_dim - - use crmx_clubbvars, only: & - rho_ds_zt, & ! Variable(s) - rho_ds_zm - - use crmx_error_code, only: clubb_at_least_debug_level - - use crmx_fill_holes, only: fill_holes_driver - - implicit none - - intrinsic :: any - - ! In variables - real(kind=time_precision), intent(in) :: & - dt ! Timestep [s] - - ! In/Out variables - real, intent(inout), dimension(dimx1_s:dimx2_s,dimy1_s:dimy2_s,nzm) :: & - t ! Moist static energy [K] - - real, intent(inout), dimension(nx,ny,nzm) :: & - qv, & ! Water vapor mixing ratio [kg/kg] - qcl ! Liquid water mixing ratio (condensate) [kg/kg] - - real, intent(inout), dimension(nxp1,ny,nzm,3) :: & - dudt ! u wind tendency [m/s^2] - - real, intent(inout), dimension(nx,nyp1,nzm,3) :: & - dvdt ! v wind tendency [m/s^2] - - ! Local Variables - real(kind=core_rknd), dimension(nz) :: tmpqv, tmpqcl - - real(kind=core_rknd) :: threshold ! Threshold on clipping [units vary] - - integer :: i, j, ig, jg - - ! --- Begin Code --- - -#ifndef CRM - call t_startf('apply_clubb_sgs_tndcy') ! For timing -#endif - - ! Since dudt/dvdt are already time tendencies, we just add the contribution - ! to the existing SAM contribution - dudt(1:nx,1:ny,1:nzm,na) = dudt(1:nx,1:ny,1:nzm,na) + real( u_tndcy(1:nx,1:ny,1:nzm) ) - dvdt(1:nx,1:ny,1:nzm,na) = dvdt(1:nx,1:ny,1:nzm,na) + real( v_tndcy(1:nx,1:ny,1:nzm) ) - - tmpqv = 0.0_core_rknd - tmpqcl = 0.0_core_rknd - - ! Add clubb tendency to qv, qc, t, and tracers - do i = 1, nx, 1 - do j = 1, ny, 1 - - t(i,j,1:nzm) = t(i,j,1:nzm) + real( dt*t_tndcy(i,j,1:nzm) ) - - tmpqv(2:nz) = real( qv(i,j,1:nzm), kind=core_rknd ) + dt*qv_tndcy(i,j,1:nzm) - tmpqcl(2:nz) = real( qcl(i,j,1:nzm), kind=core_rknd ) + dt*qc_tndcy(i,j,1:nzm) - - if ( edsclr_dim > 0 .or. sclr_dim > 0 ) then - tracer(i,j,1:nzm,1:ntracers) = tracer(i,j,1:nzm,1:ntracers) & - + real( dt*tracer_tndcy(i,j,1:nzm,1:ntracers) ) - end if - - ! Apply hole-filling scheme to qv as needed - threshold = 0._core_rknd - if ( any( tmpqv(2:nz) < threshold ) ) then - - ! CLUBB's tendency in this column will produce a negative vapor water, - ! so we apply hole-filling - if ( clubb_at_least_debug_level( 1 ) ) then - call task_rank_to_index( rank, ig, jg ) - write(0,*) "Task #:", rank - write(0,*) "Applying hole-filling scheme to vapor water mixing ratio at:", & - "nx=", i, ";", "ny=", j, ";" - write(0,*) "x global=", i+ig, ";", "y global=", j+jg, ";" - end if - - call fill_holes_driver( 2, threshold, "zt", rho_ds_zt, rho_ds_zm, tmpqv ) - - end if - - ! Update qv - qv(i,j,1:nzm) = real( tmpqv(2:nz) ) - - threshold = 0._core_rknd - ! Apply hole-filling scheme to qcl as needed - if ( any( tmpqcl(2:nz) < threshold ) ) then - - ! CLUBB's tendency in this column will produce a negative cloud water, - ! so we apply hole-filling - if ( clubb_at_least_debug_level( 1 ) ) then - call task_rank_to_index( rank, ig, jg ) - write(0,*) "Task #:", rank - write(0,*) "Applying hole-filling scheme to cloud water mixing ratio at:", & - "nx=", i, ";", "ny=", j, ";" - write(0,*) "x global=", i+ig, ";", "y global=", j+jg, ";" - end if - - call fill_holes_driver( 2, threshold, "zt", rho_ds_zt, rho_ds_zm, tmpqcl ) - - end if - - ! Update qcl - qcl(i,j,1:nzm) = real( tmpqcl(2:nz) ) - - end do ! j = 1, ny - end do ! i = 1, nx - -#ifndef CRM - call t_stopf('apply_clubb_sgs_tndcy') ! For timing -#endif - - return - end subroutine apply_clubb_sgs_tndcy - -!------------------------------------------------------------------------------- - subroutine apply_clubb_sgs_tndcy_mom( dudt, dvdt ) - - use crmx_grid, only: & - nx, nxp1, ny, nyp1, dimx1_s, dimx2_s, dimy1_s, dimy2_s, nz, nzm, na, & - rank - - use crmx_clubbvars, only: & - u_tndcy, & ! CLUBB contribution to the x wind - v_tndcy ! CLUBB contribution to the y wind - - implicit none - - intrinsic :: any - - ! In variables - real, intent(inout), dimension(nxp1,ny,nzm,3) :: & - dudt ! u wind tendency [m/s^2] - - real, intent(inout), dimension(nx,nyp1,nzm,3) :: & - dvdt ! v wind tendency [m/s^2] - - ! --- Begin Code --- - -#ifndef CRM - call t_startf('apply_clubb_sgs_tndcy_mom') ! For timing -#endif - - ! Since dudt/dvdt are already time tendencies, we just add the contribution - ! to the existing SAM contribution - dudt(1:nx,1:ny,1:nzm,na) = dudt(1:nx,1:ny,1:nzm,na) + real( u_tndcy(1:nx,1:ny,1:nzm) ) - dvdt(1:nx,1:ny,1:nzm,na) = dvdt(1:nx,1:ny,1:nzm,na) + real( v_tndcy(1:nx,1:ny,1:nzm) ) - -#ifndef CRM - call t_stopf('apply_clubb_sgs_tndcy_mom') ! For timing -#endif - - return - end subroutine apply_clubb_sgs_tndcy_mom - -!------------------------------------------------------------------------------- - subroutine apply_clubb_sgs_tndcy_scalars( dt, t, qv, qcl) - - use crmx_grid, only: & - nx, nxp1, ny, nyp1, dimx1_s, dimx2_s, dimy1_s, dimy2_s, nz, nzm, na, & - rank, adz, dz - - use crmx_params, only: doclubb_sfc_fluxes - - use crmx_vars, only: rho - - use crmx_domain, only: & - ntracers - -#ifndef CRM - use tracers, only: & -#else - use crmx_crmtracers, only: & -#endif - tracer - - use crmx_clubbvars, only: & - t_tndcy, & ! CLUBB contribution to moist static energy - qc_tndcy,& ! CLUBB contribution to liquid water mixing ratio - qv_tndcy ! CLUBB contribution to vapor water mixing ratio - - use crmx_clubbvars, only: & - tracer_tndcy - - use crmx_clubbvars, only: & - sclr_dim, & ! Constant(s) - edsclr_dim - - use crmx_clubbvars, only: & - rho_ds_zt, & ! Variable(s) - rho_ds_zm - - use crmx_error_code, only: clubb_at_least_debug_level - - use crmx_fill_holes, only: fill_holes_driver - - implicit none - - intrinsic :: any - - ! In variables - real(kind=time_precision), intent(in) :: & - dt ! Timestep [s] - - ! In/Out variables - real, intent(inout), dimension(dimx1_s:dimx2_s,dimy1_s:dimy2_s,nzm) :: & - t ! Moist static energy [K] - - real, intent(inout), dimension(nx,ny,nzm) :: & - qv, & ! Water vapor mixing ratio [kg/kg] - qcl ! Liquid water mixing ratio (condensate) [kg/kg] - - ! Local Variables - real(kind=core_rknd), dimension(nz) :: tmpqv, tmpqcl - - real(kind=core_rknd) :: threshold ! Threshold on clipping [units vary] - - real(kind=core_rknd), dimension(2) :: t_total - - real(kind=core_rknd) :: dt_total - - integer :: i, j, ig, jg, k - - ! --- Begin Code --- - -#ifndef CRM - call t_startf('apply_clubb_sgs_tndcy_scalar') ! For timing -#endif - - tmpqv = 0.0_core_rknd - tmpqcl = 0.0_core_rknd - - ! Add clubb tendency to qv, qc, t, and tracers - do i = 1, nx, 1 - do j = 1, ny, 1 - -! add energy conservation check and fix for CLUBB -! Minghuai Wang, 2012-06 - t_total = 0.0_core_rknd - dt_total = 0.0_core_rknd - t_total(1) = real(sum(t(i,j,1:nzm)*rho(1:nzm)*adz(1:nzm)*dz), kind=core_rknd) - do k=1, nzm -! t_total(1) = t_total(1) +real(t(i,j,k)*rho(k)*adz(k)*dz, kind=core_rknd) - t(i,j,k) = t(i,j,k) + real( dt*t_tndcy(i,j,k) ) -! t_total(2) = t_total(2) +real(t(i,j,k)*rho(k)*adz(k)*dz, kind=core_rknd) -! dt_total = dt_total + real( dt*t_tndcy(i,j,k)*adz(k)*dz, kind=core_rknd) - end do - t_total(2) = real(sum(t(i,j,1:nzm)*rho(1:nzm)*adz(1:nzm)*dz), kind=core_rknd) - dt_total = real(sum(dt*t_tndcy(i,j,1:nzm)*rho(1:nzm)*adz(1:nzm)*dz), kind=core_rknd) - if(abs(t_total(2)-t_total(1))/t_total(1).gt.1.0e-6) then -! write(0, *) 'energy conervation issue in clubb', i,j, & -! abs(t_total(2)-t_total(1))/t_total(1), t_total(1), dt_total - end if - if(.not.doclubb_sfc_fluxes) then - t(i,j,1:nzm) = t(i,j,1:nzm) * real(t_total(1)/t_total(2)) - else - write(0, *) 'need add surface fluxes in energy conservation fix' - stop - end if - - tmpqv(2:nz) = real( qv(i,j,1:nzm), kind=core_rknd ) + dt*qv_tndcy(i,j,1:nzm) - tmpqcl(2:nz) = real( qcl(i,j,1:nzm), kind=core_rknd ) + dt*qc_tndcy(i,j,1:nzm) - - if ( edsclr_dim > 0 .or. sclr_dim > 0 ) then - tracer(i,j,1:nzm,1:ntracers) = tracer(i,j,1:nzm,1:ntracers) & - + real( dt*tracer_tndcy(i,j,1:nzm,1:ntracers) ) - end if - - ! Apply hole-filling scheme to qv as needed - threshold = 0._core_rknd - if ( any( tmpqv(2:nz) < threshold ) ) then - - ! CLUBB's tendency in this column will produce a negative vapor water, - ! so we apply hole-filling - if ( clubb_at_least_debug_level( 1 ) ) then - call task_rank_to_index( rank, ig, jg ) - write(0,*) "Task #:", rank - write(0,*) "Applying hole-filling scheme to vapor water mixing ratio at:", & - "nx=", i, ";", "ny=", j, ";" - write(0,*) "x global=", i+ig, ";", "y global=", j+jg, ";" - end if - - call fill_holes_driver( 2, threshold, "zt", rho_ds_zt, rho_ds_zm, tmpqv ) - - end if - - ! Update qv - qv(i,j,1:nzm) = real( tmpqv(2:nz) ) - - threshold = 0._core_rknd - ! Apply hole-filling scheme to qcl as needed - if ( any( tmpqcl(2:nz) < threshold ) ) then - - ! CLUBB's tendency in this column will produce a negative cloud water, - ! so we apply hole-filling - if ( clubb_at_least_debug_level( 1 ) ) then - call task_rank_to_index( rank, ig, jg ) - write(0,*) "Task #:", rank - write(0,*) "Applying hole-filling scheme to cloud water mixing ratio at:", & - "nx=", i, ";", "ny=", j, ";" - write(0,*) "x global=", i+ig, ";", "y global=", j+jg, ";" - end if - - call fill_holes_driver( 2, threshold, "zt", rho_ds_zt, rho_ds_zm, tmpqcl ) - - end if - - ! Update qcl - qcl(i,j,1:nzm) = real( tmpqcl(2:nz) ) - - end do ! j = 1, ny - end do ! i = 1, nx - -#ifndef CRM - call t_stopf('apply_clubb_sgs_tndcy_scalar') ! For timing -#endif - - return - end subroutine apply_clubb_sgs_tndcy_scalars - -!------------------------------------------------------------------------------- - subroutine clubb_sgs_cleanup( ) -! Description: -! De-allocate memory and exit. -!------------------------------------------------------------------------------- - use crmx_grid, only: rank - - use crmx_stats_subs, only: stats_finalize - - implicit none - - !----- Begin Code ----- - - call cleanup_clubb_core( .true. ) - - if(.not.l_stats_samgrid) then - if ( is_a_sample_node( rank ) ) then - call stats_finalize( ) - end if - else ! when l_stats_samgrid is .true, does not call stats_finalize - ! as some of variables are allocated yet in this case. - end if - - return - end subroutine clubb_sgs_cleanup - -!------------------------------------------------------------------------------- - elemental function t2thetal( t, gamaz, qcl, qpl, qci, qpi, prespot ) & - result( thl ) -! Description: -! Convert moist static energy into the liquid potential temperature -! used in CLUBB. -!------------------------------------------------------------------------------- - use crmx_params, only: & - fac_cond, & ! Variables - fac_sub - - implicit none - - ! Input variables - real, intent(in) :: & - t, & ! Moist static energy [K] - gamaz, & ! grav/Cp*z [m] - qcl, & ! Cloud water mixing ration [kg/kg] - qpl, & ! Rain water mixing ratio (liquid) [kg/kg] - qci, & ! Cloud water mixing ratio (ice) [kg/kg] - qpi, & ! Snow+Graupel mixing ratio [kg/kg] - prespot ! Exner^-1 [-] - - ! Result - real(kind=core_rknd) :: thl ! Liquid pot. temperature [K] - - real :: tabs ! Absolute temp. [K] - - !----- Begin Code ----- - - ! Compute absolute temperature from t - ! Formula comes from module diagnose. - tabs = t - gamaz + fac_cond * ( qcl + qpl ) + fac_sub * ( qci + qpi ) - - ! Compute thetal (don't include ice because CLUBB doesn't) - thl = real( prespot * ( tabs - fac_cond * qcl ), kind=core_rknd ) - - return - end function t2thetal - -!------------------------------------------------------------------------------- - elemental function thetal2t( thl, gamaz, qcl, qpl, qci, qpi, prespot ) & - result( t ) - -! Description: -! Convert liquid potential temperature into moist static energy. -! References: -! None -!------------------------------------------------------------------------------- - use crmx_params, only: & - fac_cond, & ! Variables - fac_sub - - implicit none - - ! Input Variables - real(kind=core_rknd), intent(in) :: & - thl, & ! Liquid potential temperature [K] - qcl ! Cloud water mixing ration [kg/kg] - - real, intent(in) :: & - gamaz, & ! grav/Cp*z [m] - qpl, & ! Rain water mixing ratio (liquid) [kg/kg] - qci, & ! Cloud water mixing ratio (ice) [kg/kg] - qpi, & ! Snow+Graupel mixing ratio [kg/kg] - prespot ! Exner^-1 [-] - - ! Result - real(kind=core_rknd) :: t ! Moist static energy [K] - - real(kind=core_rknd) :: & - tabs, & ! Absolute temp. [K] - theta ! Pot. temp. [K] - - !----- Begin Code ----- - - ! Compute absolute temperature from thl - ! Use fac_cond since CLUBB's thl does not account for ice - theta = thl + real( prespot * fac_cond, kind=core_rknd ) * qcl - tabs = theta / real( prespot, kind=core_rknd ) - ! Compute moist static energy - ! Formula comes from module diagnose - t = tabs + real( gamaz, kind=core_rknd ) & - - real( fac_cond, kind=core_rknd ) * ( qcl + real( qpl, kind=core_rknd ) ) & - - real( fac_sub * ( qci + qpi ), kind=core_rknd ) - - return - end function thetal2t - -!------------------------------------------------------------------------------- - FUNCTION LIN_EXT( var_high, var_low, height_high, height_low, height_ext ) - -! Author: Brian M. Griffin, UW Milwaukee - -! References: None - -! Description: -! This function computes a linear extension of the value of variable. -! Given two known values of a variable at two height values, the value -! of that variable at a height outside of those two height levels -! (rather than a height between those two height levels) is computed. -! -! Here is a diagram: -! -! -------------------------------- Height to be extended to; linear extension -! -! ################################ Height high, know variable value -! -! -! -! ################################ Height low, know variable value -! -! -! -! -------------------------------- Height to be extended to; linear extension -! -! -! FORMULA: -! -! variable(@ Height extension) = -! -! [ (variable(@ Height high) - variable(@ Height low)) / (Height high - Height low) ] -! * (Height extension - Height high) + variable(@ Height high) -!------------------------------------------------------------------------------- - - IMPLICIT NONE - - ! Input Variables - REAL(kind=core_rknd), INTENT(IN):: var_high - REAL(kind=core_rknd), INTENT(IN):: var_low - REAL(kind=core_rknd), INTENT(IN):: height_high - REAL(kind=core_rknd), INTENT(IN):: height_low - REAL(kind=core_rknd), INTENT(IN):: height_ext - - ! Output Variable - REAL(kind=core_rknd):: lin_ext - - !----- Begin Code ----- - - lin_ext = ( var_high - var_low ) / ( height_high - height_low ) & - * ( height_ext - height_high ) + var_high - - RETURN - END FUNCTION LIN_EXT - - !----------------------------------------------------------------------------- - logical function is_a_sample_node( rank ) - - ! Description: - ! Determine if we're output single-columns stats from this node. - ! References: - ! None - !----------------------------------------------------------------------------- - - implicit none - - ! External - intrinsic :: any, spread, size - - ! Input Variable - integer, intent(in) :: rank - - integer :: iter - - ! ---- Begin Code ---- - - ! Initialize - is_a_sample_node = .false. - - ! Determine if we're sampling a column of stats from this node - do iter = 1, size( sample_nodes ) - if ( sample_nodes(iter) == rank ) then - is_a_sample_node = .true. - exit - end if - end do - - return - end function is_a_sample_node - !----------------------------------------------------------------------------- - subroutine get_sample_points( rank, i, j ) - - ! Description: - ! Output the local x and y location to be output for this particular node. - ! - ! References: - ! None - !----------------------------------------------------------------------------- - - implicit none - - ! Input Variable - integer, intent(in) :: rank - - ! Output Variables - integer, intent(out) :: i, j - - integer :: iter - - ! ---- Begin Code ---- - - i = -1 - j = -1 - do iter = 1, size( sample_nodes ) - if ( sample_nodes(iter) == rank ) then - i = x_samp(iter); j = y_samp(iter) - exit - end if - end do - - return - end subroutine get_sample_points - -#ifdef CLUBB_LH - pure function convert_thl_to_t_LH( LH_thl, gamaz, prespot, X_nl_all_levs ) & - result( LH_t ) - - use crmx_grid, only: nzm - - use crmx_clubb_precision, only: & - dp, & - core_rknd - - use crmx_parameters_microphys, only: & - LH_microphys_calls - - use crmx_corr_matrix_module, only: & - iiLH_s_mellor, & - iiLH_rrain, & - iiLH_rsnow, & - iiLH_rice - - use latin_hypercube_arrays, only: & - d_variables - - implicit none - - ! Input Variables - real(kind=core_rknd), dimension(nzm,LH_microphys_calls), intent(in) :: & - LH_thl ! Sample of thetal [K] - - real, dimension(nzm), intent(in) :: & - gamaz, & ! grav/Cp*z [m] - prespot ! 1/exner [-] - - real(kind=dp), dimension(nzm,LH_microphys_calls,d_variables), intent(in) :: & - X_nl_all_levs ! All lognormal variates [units vary] - - ! Output Variables - real(kind=core_rknd), dimension(nzm,LH_microphys_calls) :: & - LH_t ! Latin hypercube samples of moist static energy [K] - - ! Local variables - real(kind=core_rknd), dimension(nzm,LH_microphys_calls) :: & - qcl ! Liquid water [kg/kg] - - real, dimension(nzm,LH_microphys_calls) :: & - qpl, qci, qpi ! Rain, ice, and snow mixing ratio [kg/kg] - - integer :: indx - - ! ---- Begin Code ---- - qcl = 0._core_rknd - qpl = 0._core_rknd - qci = 0._core_rknd - qpi = 0._core_rknd - - if ( iiLH_s_mellor > 0 ) qcl = max( X_nl_all_levs(:,:,iiLH_s_mellor), 0._dp ) - if ( iiLH_rrain > 0 ) qpl = X_nl_all_levs(:,:,iiLH_rrain) - if ( iiLH_rice > 0 ) qci = X_nl_all_levs(:,:,iiLH_rice) - - ! Note: this assumes no graupel samples - if ( iiLH_rsnow > 0 ) qci = X_nl_all_levs(:,:,iiLH_rsnow) - - forall ( indx=1:LH_microphys_calls ) - LH_t(:,indx) = thetal2t( LH_thl(:,indx), gamaz, qcl(:,indx), qpl(:,indx), & - qci(:,indx), qpi(:,indx), prespot ) - end forall - - return - end function convert_thl_to_t_LH -#endif /*CLUBB_LH*/ - -real(8) function total_energy(t) - - use crmx_grid, only: & - nx, nxp1, ny, nyp1, dimx1_s, dimx2_s, dimy1_s, dimy2_s, nz, nzm, na, & - adz, dz - use crmx_vars, only: rho - use crmx_params, only: cp - - implicit none - - real, intent(inout), dimension(dimx1_s:dimx2_s,dimy1_s:dimy2_s,nzm) :: & - t ! Moist static energy [K] - - real(8) tmp - integer i,j,k,m - - total_energy = 0. - do k=1,nzm - tmp = 0. - do j=1,ny - do i=1,nx - tmp = tmp + t(i,j,k) - end do - end do - total_energy = total_energy + tmp*adz(k)*dz*rho(k) * cp - end do - -end function total_energy - -#endif /*CLUBB_CRM*/ -end module crmx_clubb_sgs diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_silhs_vars.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_silhs_vars.F90 deleted file mode 100644 index e21de0e567..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubb_silhs_vars.F90 +++ /dev/null @@ -1,60 +0,0 @@ -module crmx_clubb_silhs_vars -#ifdef CLUBB_LH - - use crmx_grid, only: & - nx, & - ny,& - nz,& - nzm,& - dimx1_s,& - dimx2_s,& - dimy1_s,& - dimy2_s - - use crmx_microphysics, only: & - nmicro_fields - - use crmx_clubb_precision, only: & - core_rknd, & ! CLUBB core real kind - dp - - implicit none - - private ! Default scope - - ! Allocatable variables that can change in dimension at runtime - real(kind=core_rknd), public, allocatable, dimension(:,:,:,:) :: & - LH_rt, & ! Latin hypercube samples of total water [kg/kg] - LH_t ! Latin hypercube samples of moist static energy [K] - - real(kind=dp), public, allocatable, dimension(:,:,:,:,:) :: & - X_nl_all_levs ! Lognormally distributed hydrometeors [units vary] - - integer, public, allocatable, dimension(:,:,:,:) :: & - X_mixt_comp_all_levs ! Which mixture component the sample is in - - real(kind=core_rknd), public, allocatable, dimension(:,:,:) :: & - LH_sample_point_weights ! Weights for cloud weighted sampling - - ! Static variables - real(kind=core_rknd), public, dimension(nx,ny,nzm) :: & - LH_t_sum_tndcy, & ! Sum of all t LH tendencies [K/s] - LH_t_avg_tndcy, & ! Average of all t LH tendencies [K/s] - LH_qn_sum_tndcy, & ! Sum of all qn LH tendencies [kg/kg/s] - LH_qn_avg_tndcy ! Average of all qn LH tendencies [kg/kg/s] - - real, public, dimension(nx,ny,nzm) :: & - t_prior, & ! Saved value of t [K] - qn_prior ! Saved value of liquid water [kg/kg] - - real, public, dimension(nx,ny,nz) :: & - w_prior ! Saved value of w [m/s] - - real, public, allocatable, dimension(:,:,:,:) :: & - micro_field_prior ! Saved values of the micro_fields [units vary] - - real(kind=core_rknd), public, allocatable, dimension(:,:,:,:) :: & - LH_micro_field_sum_tndcy, & ! Sum of all micro_field tendencies [units vary/s] - LH_micro_field_avg_tndcy ! Average of all micro_field tendencies [units vary/s] -#endif /*CLUBB_LH*/ -end module crmx_clubb_silhs_vars diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubbvars.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubbvars.F90 deleted file mode 100644 index 2edefbb344..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_clubbvars.F90 +++ /dev/null @@ -1,115 +0,0 @@ -! $Id: clubbvars.F90 1103 2013-05-14 18:35:02Z minghuai.wang@pnl.gov $ -module crmx_clubbvars -#ifdef CLUBB_CRM -! Description: -! This module contains variables that exist in CLUBB but not in SAM - - use crmx_grid, only: & - ntracers, & - nx, & - ny,& - nz,& - nzm,& - dimx1_s,& - dimx2_s,& - dimy1_s,& - dimy2_s,& - nxp1,& - nyp1,& - YES3D - - use crmx_clubb_precision, only: & - core_rknd ! CLUBB core real kind - - implicit none - - private ! Default Scope - - intrinsic :: selected_real_kind, max - - ! Determines whether to use CLUBB's eddy scalar or high order scalar code on - ! a tracer in SAM - ! To enable the passive scalars, set enable_ to 1, - ! and the dimensions for edsclr or sclr will be 1*ntracers. - integer, private, parameter :: & - enable_eddy_scalars = 0, & - enable_high_order_scalars = 0 - - integer, public, parameter :: & - edsclr_dim = enable_eddy_scalars*ntracers, & ! Number of eddy scalars - sclr_dim = enable_high_order_scalars*ntracers ! Number of high order scalars - - integer, parameter, public :: & - tndcy_precision = selected_real_kind( p=12 ) - - real(kind = core_rknd), public, dimension(nx, ny, nz) :: & - upwp, &! u'w'. [m^2/s^2] - vpwp, &! u'w'. [m^2/s^2] - up2, &! u'^2 [m^2/s^2] - vp2, &! v'^2 [m^2/s^2] - wprtp, &! w' r_t'. [(m kg)/(s kg)] - wpthlp, &! w' th_l'. [(m K)/s] - wprcp, &! w' r_c'. [(kg/kg) m/s] - wp2, &! w'^2. [m^2/s^2] - rtp2, &! r_t'^2. [(kg/kg)^2] - thlp2, &! th_l'^2. [K^2] - rtpthlp, &! r_t' th_l'. [(kg K)/kg] - rcm, &! Cloud water [kg/kg] - cloud_frac, &! Cloud Fraction. [-] - rcm_in_layer,&! rcm in cloud layer [kg/kg] - cloud_cover ! Cloud cover [-] - - real, public, dimension(0:nxp1, 1-YES3D:nyp1, nzm) :: & - khzm, &! eddy diffusivity on momentum grids [m^2/s] - khzt, &! eddy diffusivity on thermo grids [m^2/s] - qclvarg, &! cloud water variance [kg^2/kg^2] - relvarg, &! relative cloud water variance - accre_enhang ! accretion enhancement - - - real(kind=core_rknd), public, dimension(nx, ny) :: & - rtm_spurious_source, & ! Spurious source of total water [kg/kg/s] - thlm_spurious_source ! Spurious source of liquid pot. temp. [K/s] - - ! w'^3 is requires additional ghost points on the x and y dimension, - ! for the purposes of horizontal advection. The variables um and vm - ! require them for the purposes of horizontal interpolation. - real(kind=core_rknd), public, dimension(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nz) :: & - wp3,& ! w'^3. [m^3/s^3] - um, & ! x-wind [m/s] - vm ! y-wind [m/s] - - real(tndcy_precision), public, dimension(nx, ny, nzm) :: & - t_tndcy, & ! CLUBB contribution to moist static energy [K/s] - qc_tndcy, & ! CLUBB contribution to liquid water [kg/kg/s] - qv_tndcy, & ! CLUBB contribution to vapor water [kg/kg/s] - u_tndcy, & ! CLUBB contribution to x-wind [m/s^2] - v_tndcy ! CLUBB contribution to y-wind [m/s^2] - - real(tndcy_precision), public, dimension(nx, ny, nzm, ntracers) :: & - tracer_tndcy ! CLUBB contribution to the tracers [{units vary}/s] - - real(kind=core_rknd), public, dimension(nx,ny,nz,sclr_dim) :: & - sclrp2, & ! Passive scalar variance. [{units vary}^2] - sclrpthlp, & ! Passive scalar covariance. [{units vary} K] - sclrprtp, & ! Passive scalar covariance. [{units vary} kg/kg] - wpsclrp ! w'sclr' [units vary m/s] - - real(kind=core_rknd), public, dimension(sclr_dim) :: & - sclr_tol ! Tolerance on passive scalar [units vary] - - real(kind=core_rknd), public, dimension(nz) :: & - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] - invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] - thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] - thv_ds_zt ! Dry, base-state theta_v on thermo. levels [K] - - logical, public :: l_stats_samgrid ! Stats on sam grid enabled (T/F) - -#ifdef CRM - logical, public :: lrestart_clubb = .false. -#endif -#endif /*CLUBB_CRM*/ -end module crmx_clubbvars diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom.F90 deleted file mode 100644 index 3491c3c4bd..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom.F90 +++ /dev/null @@ -1,24 +0,0 @@ -subroutine diffuse_mom - -! Interface to the diffusion routines - -use crmx_vars -implicit none -integer i,j,k - -!call t_startf ('diffuse_mom') - -if(RUN3D) then -! call diffuse_mom3D() - call diffuse_mom3D_xy() - call diffuse_mom3D_z() -else -! call diffuse_mom2D() - call diffuse_mom2D_xy() - call diffuse_mom2D_z() -endif - -!call t_stopf ('diffuse_mom') - -end subroutine diffuse_mom - diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D.F90 deleted file mode 100644 index 26de915ad7..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D.F90 +++ /dev/null @@ -1,128 +0,0 @@ - -subroutine diffuse_mom2D - -! momentum tendency due to SGS diffusion - -use crmx_vars -use crmx_sgs, only: tk, grdf_x, grdf_z -use crmx_params, only: docolumn -#ifdef CLUBB_CRM -use crmx_params, only: doclubb, doclubb_sfc_fluxes, docam_sfc_fluxes -#endif -implicit none - -real rdx2,rdz2,rdz,rdx25,rdz25,rdx21,rdx251 -real dxz,dzx - -integer i,j,k,ic,ib,kc,kcu -real tkx, tkz, rhoi, iadzw, iadz -real fu(0:nx,1,nz),fv(0:nx,1,nz),fw(0:nx,1,nz) - -rdx2=1./dx/dx -rdx25=0.25*rdx2 - -dxz=dx/dz - -j=1 - -if(.not.docolumn) then - - -do k=1,nzm - - kc=k+1 - kcu=min(kc,nzm) - dxz=dx/(dz*adzw(kc)) - rdx21=rdx2 * grdf_x(k) - rdx251=rdx25 * grdf_x(k) - - do i=0,nx - ic=i+1 - tkx=rdx21*tk(i,j,k) - fu(i,j,k)=-2.*tkx*(u(ic,j,k)-u(i,j,k)) - fv(i,j,k)=-tkx*(v(ic,j,k)-v(i,j,k)) - tkx=rdx251*(tk(i,j,k)+tk(ic,j,k)+tk(i,j,kcu)+tk(ic,j,kcu)) - fw(i,j,k)=-tkx*(w(ic,j,kc)-w(i,j,kc)+(u(ic,j,kcu)-u(ic,j,k))*dxz) - end do - do i=1,nx - ib=i-1 - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(ib,j,k)) - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(ib,j,k)) - dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(ib,j,k)) - end do - -end do - -end if - -!------------------------- -rdz=1./dz -dzx=dz/dx - -do k=1,nzm-1 - kc=k+1 - uwsb(kc)=0. - vwsb(kc)=0. - iadz = 1./adz(k) - iadzw= 1./adzw(kc) - rdz2=rdz*rdz *grdf_z(k) - rdz25=0.25*rdz2 - do i=1,nx - ib=i-1 - tkz=rdz2*tk(i,j,k) - fw(i,j,kc)=-2.*tkz*(w(i,j,kc)-w(i,j,k))*rho(k)*iadz - tkz=rdz25*(tk(i,j,k)+tk(ib,j,k)+tk(i,j,kc)+tk(ib,j,kc)) - fu(i,j,kc)=-tkz*( (u(i,j,kc)-u(i,j,k))*iadzw + & - (w(i,j,kc)-w(ib,j,kc))*dzx)*rhow(kc) - fv(i,j,kc)=-tkz*(v(i,j,kc)-v(i,j,k))*iadzw*rhow(kc) - uwsb(kc)=uwsb(kc)+fu(i,j,kc) - vwsb(kc)=vwsb(kc)+fv(i,j,kc) - end do -end do - -uwsb(1) = 0. -vwsb(1) = 0. - -do i=1,nx - tkz=rdz2*grdf_z(nzm)*tk(i,j,nzm) - fw(i,j,nz)=-2.*tkz*(w(i,j,nz)-w(i,j,nzm))/adz(nzm)*rho(nzm) -#ifdef CLUBB_CRM - ! Add in the surface flux later -dschanen UWM 27 Aug 2008 - if ( doclubb .and. (doclubb_sfc_fluxes .or. docam_sfc_fluxes) ) then - fu(i,j,1) = 0.0 ! This is handled by CLUBB - fv(i,j,1) = 0.0 ! " " - else - fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) - fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) - end if -#else - fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) - fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) -#endif /*CLUBB_CRM*/ - fu(i,j,nz)=fluxtu(i,j) * rdz * rhow(nz) - fv(i,j,nz)=fluxtv(i,j) * rdz * rhow(nz) - uwsb(1) = uwsb(1) + fu(i,j,1) - vwsb(1) = vwsb(1) + fv(i,j,1) -end do - - -do k=1,nzm - kc=k+1 - rhoi = 1./(rho(k)*adz(k)) - do i=1,nx - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi - end do -end do ! k - -do k=2,nzm - rhoi = 1./(rhow(k)*adzw(k)) - do i=1,nx - dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fw(i,j,k+1)-fw(i,j,k))*rhoi - end do -end do ! k - - -end subroutine diffuse_mom2D - - diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_xy.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_xy.F90 deleted file mode 100644 index 5f4605d9e8..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_xy.F90 +++ /dev/null @@ -1,57 +0,0 @@ - -subroutine diffuse_mom2D_xy - -! momentum tendency due to SGS diffusion - -use crmx_vars -use crmx_sgs, only: tk, grdf_x, grdf_z -use crmx_params, only: docolumn -implicit none - -real rdx2,rdz2,rdz,rdx25,rdz25,rdx21,rdx251 -real dxz,dzx - -integer i,j,k,ic,ib,kc,kcu -real tkx, tkz, rhoi, iadzw, iadz -real fu(0:nx,1,nz),fv(0:nx,1,nz),fw(0:nx,1,nz) - -rdx2=1./dx/dx -rdx25=0.25*rdx2 - -dxz=dx/dz - -j=1 - -if(.not.docolumn) then - - -do k=1,nzm - - kc=k+1 - kcu=min(kc,nzm) - dxz=dx/(dz*adzw(kc)) - rdx21=rdx2 * grdf_x(k) - rdx251=rdx25 * grdf_x(k) - - do i=0,nx - ic=i+1 - tkx=rdx21*tk(i,j,k) - fu(i,j,k)=-2.*tkx*(u(ic,j,k)-u(i,j,k)) - fv(i,j,k)=-tkx*(v(ic,j,k)-v(i,j,k)) - tkx=rdx251*(tk(i,j,k)+tk(ic,j,k)+tk(i,j,kcu)+tk(ic,j,kcu)) - fw(i,j,k)=-tkx*(w(ic,j,kc)-w(i,j,kc)+(u(ic,j,kcu)-u(ic,j,k))*dxz) - end do - do i=1,nx - ib=i-1 - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(ib,j,k)) - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(ib,j,k)) - dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(ib,j,k)) - end do - -end do - -end if - -end subroutine diffuse_mom2D_xy - - diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_z.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_z.F90 deleted file mode 100644 index 06fe1169f0..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom2D_z.F90 +++ /dev/null @@ -1,125 +0,0 @@ - -subroutine diffuse_mom2D_z - -! momentum tendency due to SGS diffusion - -use crmx_vars -use crmx_sgs, only: tk, grdf_x, grdf_z -use crmx_params, only: docolumn -#ifdef CLUBB_CRM -use crmx_params, only: doclubb, doclubb_sfc_fluxes, docam_sfc_fluxes -use crmx_sgs, only: tk_clubb -#endif -implicit none - -real rdx2,rdz2,rdz,rdx25,rdz25,rdx21,rdx251 -real dxz,dzx - -integer i,j,k,ic,ib,kc,kcu -real tkx, tkz, rhoi, iadzw, iadz -real fu(0:nx,1,nz),fv(0:nx,1,nz),fw(0:nx,1,nz) -real tktemp(0:nxp1, 1-YES3D:nyp1, nzm) - - -#ifndef CLUBB_CRM -tktemp(:, :, :) = tk(:, :, :) -#else -if(doclubb) then -!tktemp(:, :, :) = 0.0 ! the vertical diffusion of moment has been done in CLUBB -!tktemp(:, :, :) = tk_clubb ! We need this for the vertical diffuseion of verttical velocity -! ! As dudt and dvdt are updated in clubb_sgs, dudt and dvdt are not updated here. -tktemp(:, :, :) = tk_clubb * 0.2 ! use 0.2 here, as 0.4 is found too large for - ! 1.9x2.5 MMF simulation, as the explicit time integration scheme - ! is used for moment in SAM and large diffusion term can cause - ! numerical instability +++mhwang - ! -!tktemp(:, :, :) = tk_clubb * 0.00 ! follow what is done in clubb_sgs. -!tktemp(:, :, :) = tk -else -tktemp(:, :, :) = tk(:, :, :) -endif -#endif - -rdx2=1./dx/dx -rdx25=0.25*rdx2 - -j=1 - -!------------------------- -rdz=1./dz -dzx=dz/dx - -do k=1,nzm-1 - kc=k+1 - uwsb(kc)=0. - vwsb(kc)=0. - iadz = 1./adz(k) - iadzw= 1./adzw(kc) - rdz2=rdz*rdz *grdf_z(k) - rdz25=0.25*rdz2 - do i=1,nx - ib=i-1 - tkz=rdz2*tktemp(i,j,k) - fw(i,j,kc)=-2.*tkz*(w(i,j,kc)-w(i,j,k))*rho(k)*iadz - tkz=rdz25*(tktemp(i,j,k)+tktemp(ib,j,k)+tktemp(i,j,kc)+tktemp(ib,j,kc)) - fu(i,j,kc)=-tkz*( (u(i,j,kc)-u(i,j,k))*iadzw + & - (w(i,j,kc)-w(ib,j,kc))*dzx)*rhow(kc) - fv(i,j,kc)=-tkz*(v(i,j,kc)-v(i,j,k))*iadzw*rhow(kc) - uwsb(kc)=uwsb(kc)+fu(i,j,kc) - vwsb(kc)=vwsb(kc)+fv(i,j,kc) - end do -end do - -uwsb(1) = 0. -vwsb(1) = 0. - -do i=1,nx - tkz=rdz2*grdf_z(nzm)*tktemp(i,j,nzm) - fw(i,j,nz)=-2.*tkz*(w(i,j,nz)-w(i,j,nzm))/adz(nzm)*rho(nzm) -#ifdef CLUBB_CRM - ! Add in the surface flux later -dschanen UWM 27 Aug 2008 - if ( doclubb .and. (doclubb_sfc_fluxes .or. docam_sfc_fluxes) ) then - fu(i,j,1) = 0.0 ! This is handled by CLUBB - fv(i,j,1) = 0.0 ! " " - else - fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) - fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) - end if -#else - fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) - fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) -#endif /*CLUBB_CRM*/ - fu(i,j,nz)=fluxtu(i,j) * rdz * rhow(nz) - fv(i,j,nz)=fluxtv(i,j) * rdz * rhow(nz) - uwsb(1) = uwsb(1) + fu(i,j,1) - vwsb(1) = vwsb(1) + fv(i,j,1) -end do - - -do k=1,nzm - kc=k+1 - rhoi = 1./(rho(k)*adz(k)) - do i=1,nx -#ifdef CLUBB_CRM -! if(.not. doclubb) then ! when doclubb is true, dudt and dvdt have been updated in clubb_sgs - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi -! end if -#else - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi -#endif - end do -end do ! k - -do k=2,nzm - rhoi = 1./(rhow(k)*adzw(k)) - do i=1,nx - dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fw(i,j,k+1)-fw(i,j,k))*rhoi - end do -end do ! k - - -end subroutine diffuse_mom2D_z - - diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D.F90 deleted file mode 100644 index d61d506bb5..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D.F90 +++ /dev/null @@ -1,164 +0,0 @@ - -subroutine diffuse_mom3D - -! momentum tendency due to SGS diffusion - -use crmx_vars -use crmx_sgs, only: tk, grdf_x, grdf_y, grdf_z -use crmx_params, only: docolumn -#ifdef CLUBB_CRM -use crmx_params, only: doclubb, doclubb_sfc_fluxes, docam_sfc_fluxes -#endif -implicit none - -real rdx2,rdy2,rdz2,rdz,rdx25,rdy25 -real rdx21,rdy21,rdx251,rdy251,rdz25 -real dxy,dxz,dyx,dyz,dzx,dzy - -integer i,j,k,ic,ib,jb,jc,kc,kcu -real tkx, tky, tkz, rhoi, iadzw, iadz -real fu(0:nx,0:ny,nz),fv(0:nx,0:ny,nz),fw(0:nx,0:ny,nz) - -rdx2=1./(dx*dx) -rdy2=1./(dy*dy) - -rdx25=0.25*rdx2 -rdy25=0.25*rdy2 - -dxy=dx/dy -dxz=dx/dz -dyx=dy/dx -dyz=dy/dz - - -do k=1,nzm - kc=k+1 - kcu=min(kc,nzm) - dxz=dx/(dz*adzw(kc)) - dyz=dy/(dz*adzw(kc)) - rdx21=rdx2 * grdf_x(k) - rdy21=rdy2 * grdf_y(k) - rdx251=rdx25 * grdf_x(k) - rdy251=rdy25 * grdf_y(k) - do j=1,ny - jb=j-1 - do i=0,nx - ic=i+1 - tkx=rdx21*tk(i,j,k) - fu(i,j,k)=-2.*tkx*(u(ic,j,k)-u(i,j,k)) - tkx=rdx251*(tk(i,j,k)+tk(i,jb,k)+tk(ic,j,k)+tk(ic,jb,k)) - fv(i,j,k)=-tkx*(v(ic,j,k)-v(i,j,k)+(u(ic,j,k)-u(ic,jb,k))*dxy) - tkx=rdx251*(tk(i,j,k)+tk(ic,j,k)+tk(i,j,kcu)+tk(ic,j,kcu)) - fw(i,j,k)=-tkx*(w(ic,j,kc)-w(i,j,kc)+(u(ic,j,kcu)-u(ic,j,k))*dxz) - end do - do i=1,nx - ib=i-1 - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(ib,j,k)) - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(ib,j,k)) - dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(ib,j,k)) - end do - end do - - do j=0,ny - jc=j+1 - do i=1,nx - ib=i-1 - tky=rdy21*tk(i,j,k) - fv(i,j,k)=-2.*tky*(v(i,jc,k)-v(i,j,k)) - tky=rdy251*(tk(i,j,k)+tk(ib,j,k)+tk(i,jc,k)+tk(ib,jc,k)) - fu(i,j,k)=-tky*(u(i,jc,k)-u(i,j,k)+(v(i,jc,k)-v(ib,jc,k))*dyx) - tky=rdy251*(tk(i,j,k)+tk(i,jc,k)+tk(i,j,kcu)+tk(i,jc,kcu)) - fw(i,j,k)=-tky*(w(i,jc,kc)-w(i,j,kc)+(v(i,jc,kcu)-v(i,jc,k))*dyz) - end do - end do - do j=1,ny - jb=j-1 - do i=1,nx - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(i,jb,k)) - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(i,jb,k)) - dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(i,jb,k)) - end do - end do - -end do - -!------------------------- -rdz=1./dz -dzx=dz/dx -dzy=dz/dy - -do k=1,nzm-1 - kc=k+1 - uwsb(kc)=0. - vwsb(kc)=0. - iadz = 1./adz(k) - iadzw= 1./adzw(kc) - rdz2 = rdz*rdz * grdf_z(k) - rdz25 = 0.25*rdz2 - do j=1,ny - jb=j-1 - do i=1,nx - ib=i-1 - tkz=rdz2*tk(i,j,k) - fw(i,j,kc)=-2.*tkz*(w(i,j,kc)-w(i,j,k))*rho(k)*iadz - tkz=rdz25*(tk(i,j,k)+tk(ib,j,k)+tk(i,j,kc)+tk(ib,j,kc)) - fu(i,j,kc)=-tkz*( (u(i,j,kc)-u(i,j,k))*iadzw + & - (w(i,j,kc)-w(ib,j,kc))*dzx)*rhow(kc) - tkz=rdz25*(tk(i,j,k)+tk(i,jb,k)+tk(i,j,kc)+tk(i,jb,kc)) - fv(i,j,kc)=-tkz*( (v(i,j,kc)-v(i,j,k))*iadzw + & - (w(i,j,kc)-w(i,jb,kc))*dzy)*rhow(kc) - uwsb(kc)=uwsb(kc)+fu(i,j,kc) - vwsb(kc)=vwsb(kc)+fv(i,j,kc) - end do - end do -end do - -uwsb(1) = 0. -vwsb(1) = 0. - -do j=1,ny - do i=1,nx - tkz=rdz2*grdf_z(nzm)*tk(i,j,nzm) - fw(i,j,nz)=-2.*tkz*(w(i,j,nz)-w(i,j,nzm))/adz(nzm)*rho(nzm) -#ifdef CLUBB_CRM - ! Add in the surface flux later -dschanen UWM 27 Aug 2008 - if ( doclubb .and. (doclubb_sfc_fluxes .or. docam_sfc_fluxes)) then - fu(i,j,1) = 0.0 ! This is handled by CLUBB - fv(i,j,1) = 0.0 ! " " - else - fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) - fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) - end if -#else - fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) - fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) -#endif /*CLUBB*/ - fu(i,j,nz)=fluxtu(i,j) * rdz * rhow(nz) - fv(i,j,nz)=fluxtv(i,j) * rdz * rhow(nz) - uwsb(1) = uwsb(1) + fu(i,j,1) - vwsb(1) = vwsb(1) + fv(i,j,1) - end do - end do - - do k=1,nzm - kc=k+1 - rhoi = 1./(rho(k)*adz(k)) - do j=1,ny - do i=1,nx - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi - end do - end do - end do ! k - - do k=2,nzm - rhoi = 1./(rhow(k)*adzw(k)) - do j=1,ny - do i=1,nx - dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fw(i,j,k+1)-fw(i,j,k))*rhoi - end do - end do - end do ! k - - -end subroutine diffuse_mom3D diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_xy.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_xy.F90 deleted file mode 100644 index f294f8e60e..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_xy.F90 +++ /dev/null @@ -1,82 +0,0 @@ - -subroutine diffuse_mom3D_xy - -! momentum tendency due to SGS diffusion - -use crmx_vars -use crmx_sgs, only: tk, grdf_x, grdf_y, grdf_z -use crmx_params, only: docolumn -implicit none - -real rdx2,rdy2,rdz2,rdz,rdx25,rdy25 -real rdx21,rdy21,rdx251,rdy251,rdz25 -real dxy,dxz,dyx,dyz,dzx,dzy - -integer i,j,k,ic,ib,jb,jc,kc,kcu -real tkx, tky, tkz, rhoi, iadzw, iadz -real fu(0:nx,0:ny,nz),fv(0:nx,0:ny,nz),fw(0:nx,0:ny,nz) - -rdx2=1./(dx*dx) -rdy2=1./(dy*dy) - -rdx25=0.25*rdx2 -rdy25=0.25*rdy2 - -dxy=dx/dy -dxz=dx/dz -dyx=dy/dx -dyz=dy/dz - - -do k=1,nzm - kc=k+1 - kcu=min(kc,nzm) - dxz=dx/(dz*adzw(kc)) - dyz=dy/(dz*adzw(kc)) - rdx21=rdx2 * grdf_x(k) - rdy21=rdy2 * grdf_y(k) - rdx251=rdx25 * grdf_x(k) - rdy251=rdy25 * grdf_y(k) - do j=1,ny - jb=j-1 - do i=0,nx - ic=i+1 - tkx=rdx21*tk(i,j,k) - fu(i,j,k)=-2.*tkx*(u(ic,j,k)-u(i,j,k)) - tkx=rdx251*(tk(i,j,k)+tk(i,jb,k)+tk(ic,j,k)+tk(ic,jb,k)) - fv(i,j,k)=-tkx*(v(ic,j,k)-v(i,j,k)+(u(ic,j,k)-u(ic,jb,k))*dxy) - tkx=rdx251*(tk(i,j,k)+tk(ic,j,k)+tk(i,j,kcu)+tk(ic,j,kcu)) - fw(i,j,k)=-tkx*(w(ic,j,kc)-w(i,j,kc)+(u(ic,j,kcu)-u(ic,j,k))*dxz) - end do - do i=1,nx - ib=i-1 - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(ib,j,k)) - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(ib,j,k)) - dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(ib,j,k)) - end do - end do - - do j=0,ny - jc=j+1 - do i=1,nx - ib=i-1 - tky=rdy21*tk(i,j,k) - fv(i,j,k)=-2.*tky*(v(i,jc,k)-v(i,j,k)) - tky=rdy251*(tk(i,j,k)+tk(ib,j,k)+tk(i,jc,k)+tk(ib,jc,k)) - fu(i,j,k)=-tky*(u(i,jc,k)-u(i,j,k)+(v(i,jc,k)-v(ib,jc,k))*dyx) - tky=rdy251*(tk(i,j,k)+tk(i,jc,k)+tk(i,j,kcu)+tk(i,jc,kcu)) - fw(i,j,k)=-tky*(w(i,jc,kc)-w(i,j,kc)+(v(i,jc,kcu)-v(i,jc,k))*dyz) - end do - end do - do j=1,ny - jb=j-1 - do i=1,nx - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(i,jb,k)) - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(i,jb,k)) - dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(i,jb,k)) - end do - end do - -end do - -end subroutine diffuse_mom3D_xy diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_z.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_z.F90 deleted file mode 100644 index 31e6232efa..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_mom3D_z.F90 +++ /dev/null @@ -1,134 +0,0 @@ - -subroutine diffuse_mom3D_z - -! momentum tendency due to SGS diffusion - -use crmx_vars -use crmx_sgs, only: tk, grdf_x, grdf_y, grdf_z -use crmx_params, only: docolumn -#ifdef CLUBB_CRM -use crmx_params, only: doclubb, doclubb_sfc_fluxes, docam_sfc_fluxes -use crmx_sgs, only: tk_clubb -#endif -implicit none - -real rdx2,rdy2,rdz2,rdz,rdx25,rdy25 -real rdx21,rdy21,rdx251,rdy251,rdz25 -real dxy,dxz,dyx,dyz,dzx,dzy - -integer i,j,k,ic,ib,jb,jc,kc,kcu -real tkx, tky, tkz, rhoi, iadzw, iadz -real fu(0:nx,0:ny,nz),fv(0:nx,0:ny,nz),fw(0:nx,0:ny,nz) -real tktemp(0:nxp1, 1-YES3D:nyp1, nzm) - -#ifndef CLUBB_CRM -tktemp(:, :, :) = tk(:, :, :) -#else -if(doclubb) then -!tktemp(:, :, :) = 0.0 ! the vertical diffusion of moment has been done in CLUBB -!tktemp(:, :, :) = tk_clubb ! We need this for the vertical diffuseion of vertical velocity -! ! As dudt and dvdt are updated in clubb_sgs, dudt and dvdt are not updated here -tktemp(:, :, :) = tk_clubb * 0.2 ! use 0.2 here, as 0.4 is found too large for - ! 1.9x2.5 MMF simulation, as the explicit time integration scheme - ! is used for moment in SAM and large diffusion term can cause - ! numerical instability +++mhwang -else -tktemp(:, :, :) = tk(:, :, :) -endif -#endif - -rdx2=1./(dx*dx) -rdy2=1./(dy*dy) - -rdx25=0.25*rdx2 -rdy25=0.25*rdy2 - -!------------------------- -rdz=1./dz -dzx=dz/dx -dzy=dz/dy - -do k=1,nzm-1 - kc=k+1 - uwsb(kc)=0. - vwsb(kc)=0. - iadz = 1./adz(k) - iadzw= 1./adzw(kc) - rdz2 = rdz*rdz * grdf_z(k) - rdz25 = 0.25*rdz2 - do j=1,ny - jb=j-1 - do i=1,nx - ib=i-1 - tkz=rdz2*tktemp(i,j,k) - fw(i,j,kc)=-2.*tkz*(w(i,j,kc)-w(i,j,k))*rho(k)*iadz - tkz=rdz25*(tktemp(i,j,k)+tktemp(ib,j,k)+tktemp(i,j,kc)+tktemp(ib,j,kc)) - fu(i,j,kc)=-tkz*( (u(i,j,kc)-u(i,j,k))*iadzw + & - (w(i,j,kc)-w(ib,j,kc))*dzx)*rhow(kc) - tkz=rdz25*(tktemp(i,j,k)+tktemp(i,jb,k)+tktemp(i,j,kc)+tktemp(i,jb,kc)) - fv(i,j,kc)=-tkz*( (v(i,j,kc)-v(i,j,k))*iadzw + & - (w(i,j,kc)-w(i,jb,kc))*dzy)*rhow(kc) - uwsb(kc)=uwsb(kc)+fu(i,j,kc) - vwsb(kc)=vwsb(kc)+fv(i,j,kc) - end do - end do -end do - -uwsb(1) = 0. -vwsb(1) = 0. - -do j=1,ny - do i=1,nx - tkz=rdz2*grdf_z(nzm)*tktemp(i,j,nzm) - fw(i,j,nz)=-2.*tkz*(w(i,j,nz)-w(i,j,nzm))/adz(nzm)*rho(nzm) -#ifdef CLUBB_CRM - ! Add in the surface flux later -dschanen UWM 27 Aug 2008 - if ( doclubb .and. (doclubb_sfc_fluxes .or. docam_sfc_fluxes)) then - fu(i,j,1) = 0.0 ! This is handled by CLUBB - fv(i,j,1) = 0.0 ! " " - else - fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) - fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) - end if -#else - fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) - fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) -#endif /*CLUBB*/ - fu(i,j,nz)=fluxtu(i,j) * rdz * rhow(nz) - fv(i,j,nz)=fluxtv(i,j) * rdz * rhow(nz) - uwsb(1) = uwsb(1) + fu(i,j,1) - vwsb(1) = vwsb(1) + fv(i,j,1) - end do - end do - - do k=1,nzm - kc=k+1 - rhoi = 1./(rho(k)*adz(k)) - do j=1,ny - do i=1,nx -#ifdef CLUBB_CRM -! if(.not. doclubb) then ! when doclubb is true, dudt and dvdt have been updated in clubb_sgs - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi -! end if -#else - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi -#endif - - end do - end do - end do ! k - - - do k=2,nzm - rhoi = 1./(rhow(k)*adzw(k)) - do j=1,ny - do i=1,nx - dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fw(i,j,k+1)-fw(i,j,k))*rhoi - end do - end do - end do ! k - - -end subroutine diffuse_mom3D_z diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar.F90 deleted file mode 100644 index bf3085be14..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar.F90 +++ /dev/null @@ -1,46 +0,0 @@ -subroutine diffuse_scalar (f,fluxb,fluxt, & - fdiff,flux,f2lediff,f2lediss,fwlediff,doit) - -use crmx_grid -use crmx_vars, only: rho, rhow -use crmx_sgs, only: tkh -implicit none - -! input: -real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real fluxb(nx,ny) ! bottom flux -real fluxt(nx,ny) ! top flux -real flux(nz) -real f2lediff(nz),f2lediss(nz),fwlediff(nz) -real fdiff(nz) -logical doit -! Local -real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -integer i,j,k - -!call t_startf ('diffuse_scalars') - -df(:,:,:) = f(:,:,:) - -if(RUN3D) then -! call diffuse_scalar3D (f,fluxb,fluxt,tkh,rho,rhow,flux) - call diffuse_scalar3D_xy (f,fluxb,fluxt,tkh,rho,rhow,flux) - call diffuse_scalar3D_z (f,fluxb,fluxt,tkh,rho,rhow,flux) -else -! call diffuse_scalar2D (f,fluxb,fluxt,tkh,rho,rhow,flux) - call diffuse_scalar2D_xy (f,fluxb,fluxt,tkh,rho,rhow,flux) - call diffuse_scalar2D_z (f,fluxb,fluxt,tkh,rho,rhow,flux) -endif - -do k=1,nzm - fdiff(k)=0. - do j=1,ny - do i=1,nx - fdiff(k)=fdiff(k)+f(i,j,k)-df(i,j,k) - end do - end do -end do - -!call t_stopf ('diffuse_scalars') - -end subroutine diffuse_scalar diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D.F90 deleted file mode 100644 index d8ff8f7587..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D.F90 +++ /dev/null @@ -1,103 +0,0 @@ -subroutine diffuse_scalar2D (field,fluxb,fluxt,tkh,rho,rhow,flux) - -use crmx_grid -use crmx_params, only: docolumn,dowallx,dosgs -use crmx_sgs,only: grdf_x,grdf_z -implicit none - -! input -real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real tkh(0:nxp1, 1-YES3D:nyp1, nzm) ! eddy conductivity -real fluxb(nx,ny) ! bottom flux -real fluxt(nx,ny) ! top flux -real rho(nzm) -real rhow(nz) -real flux(nz) - -! local -real flx(0:nx,1,0:nzm) -real dfdt(nx,ny,nzm) -real rdx2,rdz2,rdz,rdx5,rdz5,tmp -real dxz,dzx,tkx,tkz,rhoi -integer i,j,k,ib,ic,kc,kb - -if(.not.dosgs.and..not.docolumn) return - -rdx2=1./(dx*dx) -rdz2=1./(dz*dz) -rdz=1./dz -dxz=dx/dz -dzx=dz/dx - -j=1 - -dfdt(:,:,:)=0. - -if(dowallx) then - - if(mod(rank,nsubdomains_x).eq.0) then - do k=1,nzm - field(0,j,k) = field(1,j,k) - end do - end if - if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then - do k=1,nzm - field(nx+1,j,k) = field(nx,j,k) - end do - end if - -end if - - -if(.not.docolumn) then - - -do k=1,nzm - - rdx5=0.5*rdx2 *grdf_x(k) - - do i=0,nx - ic=i+1 - tkx=rdx5*(tkh(i,j,k)+tkh(ic,j,k)) - flx(i,j,k)=-tkx*(field(ic,j,k)-field(i,j,k)) - end do - do i=1,nx - ib=i-1 - dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(ib,j,k)) - end do - -end do - -end if - -flux(1) = 0. -tmp=1./adzw(nz) -do i=1,nx - flx(i,j,0)=fluxb(i,j)*rdz*rhow(1) - flx(i,j,nzm)=fluxt(i,j)*rdz*tmp*rhow(nz) - flux(1) = flux(1) + flx(i,j,0) -end do - - -do k=1,nzm-1 - kc=k+1 - flux(kc)=0. - rhoi = rhow(kc)/adzw(kc) - rdz5=0.5*rdz2 * grdf_z(k) - do i=1,nx - tkz=rdz5*(tkh(i,j,k)+tkh(i,j,kc)) - flx(i,j,k)=-tkz*(field(i,j,kc)-field(i,j,k))*rhoi - flux(kc) = flux(kc) + flx(i,j,k) - end do -end do - -do k=1,nzm - kb=k-1 - rhoi = 1./(adz(k)*rho(k)) - do i=1,nx - dfdt(i,j,k)=dtn*(dfdt(i,j,k)-(flx(i,j,k)-flx(i,j,kb))*rhoi) - field(i,j,k)=field(i,j,k) + dfdt(i,j,k) - end do -end do - -end subroutine diffuse_scalar2D diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_xy.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_xy.F90 deleted file mode 100644 index 8657d61349..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_xy.F90 +++ /dev/null @@ -1,79 +0,0 @@ -subroutine diffuse_scalar2D_xy (field,fluxb,fluxt,tkh,rho,rhow,flux) - -use crmx_grid -use crmx_params, only: docolumn,dowallx,dosgs -use crmx_sgs,only: grdf_x,grdf_z -implicit none - -! input -real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real tkh(0:nxp1, 1-YES3D:nyp1, nzm) ! eddy conductivity -real fluxb(nx,ny) ! bottom flux -real fluxt(nx,ny) ! top flux -real rho(nzm) -real rhow(nz) -real flux(nz) - -! local -real flx(0:nx,1,0:nzm) -real dfdt(nx,ny,nzm) -real rdx2,rdz2,rdz,rdx5,rdz5,tmp -real dxz,dzx,tkx,tkz,rhoi -integer i,j,k,ib,ic,kc,kb - -if(.not.dosgs.and..not.docolumn) return - -rdx2=1./(dx*dx) -rdz2=1./(dz*dz) -rdz=1./dz -dxz=dx/dz -dzx=dz/dx - -j=1 - -dfdt(:,:,:)=0. - -if(dowallx) then - - if(mod(rank,nsubdomains_x).eq.0) then - do k=1,nzm - field(0,j,k) = field(1,j,k) - end do - end if - if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then - do k=1,nzm - field(nx+1,j,k) = field(nx,j,k) - end do - end if - -end if - - -if(.not.docolumn) then - - -do k=1,nzm - - rdx5=0.5*rdx2 *grdf_x(k) - - do i=0,nx - ic=i+1 - tkx=rdx5*(tkh(i,j,k)+tkh(ic,j,k)) - flx(i,j,k)=-tkx*(field(ic,j,k)-field(i,j,k)) - end do - do i=1,nx - ib=i-1 - dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(ib,j,k)) - end do - - do i=1,nx - field(i,j,k)=field(i,j,k) + dfdt(i,j,k) * dtn - end do - -end do - -end if - -flux = 0.0 - -end subroutine diffuse_scalar2D_xy diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_z.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_z.F90 deleted file mode 100644 index 4d0b6e76f7..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar2D_z.F90 +++ /dev/null @@ -1,66 +0,0 @@ -subroutine diffuse_scalar2D_z (field,fluxb,fluxt,tkh,rho,rhow,flux) - -use crmx_grid -use crmx_params, only: docolumn,dowallx,dosgs -use crmx_sgs,only: grdf_x,grdf_z -implicit none - -! input -real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real tkh(0:nxp1, 1-YES3D:nyp1, nzm) ! eddy conductivity -real fluxb(nx,ny) ! bottom flux -real fluxt(nx,ny) ! top flux -real rho(nzm) -real rhow(nz) -real flux(nz) - -! local -real flx(0:nx,1,0:nzm) -real dfdt(nx,ny,nzm) -real rdx2,rdz2,rdz,rdx5,rdz5,tmp -real dxz,dzx,tkx,tkz,rhoi -integer i,j,k,ib,ic,kc,kb - -if(.not.dosgs.and..not.docolumn) return - -rdx2=1./(dx*dx) -rdz2=1./(dz*dz) -rdz=1./dz -dxz=dx/dz -dzx=dz/dx - -j=1 - -dfdt(:,:,:)=0. - -flux(1) = 0. -tmp=1./adzw(nz) -do i=1,nx - flx(i,j,0)=fluxb(i,j)*rdz*rhow(1) - flx(i,j,nzm)=fluxt(i,j)*rdz*tmp*rhow(nz) - flux(1) = flux(1) + flx(i,j,0) -end do - - -do k=1,nzm-1 - kc=k+1 - flux(kc)=0. - rhoi = rhow(kc)/adzw(kc) - rdz5=0.5*rdz2 * grdf_z(k) - do i=1,nx - tkz=rdz5*(tkh(i,j,k)+tkh(i,j,kc)) - flx(i,j,k)=-tkz*(field(i,j,kc)-field(i,j,k))*rhoi - flux(kc) = flux(kc) + flx(i,j,k) - end do -end do - -do k=1,nzm - kb=k-1 - rhoi = 1./(adz(k)*rho(k)) - do i=1,nx - dfdt(i,j,k)=dtn*(dfdt(i,j,k)-(flx(i,j,k)-flx(i,j,kb))*rhoi) - field(i,j,k)=field(i,j,k) + dfdt(i,j,k) - end do -end do - -end subroutine diffuse_scalar2D_z diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D.F90 deleted file mode 100644 index f166ee61ea..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D.F90 +++ /dev/null @@ -1,177 +0,0 @@ -subroutine diffuse_scalar3D (field,fluxb,fluxt,tkh,rho,rhow,flux) - -use crmx_grid -use crmx_params, only: docolumn,dowallx,dowally,dosgs -use crmx_sgs, only: grdf_x,grdf_y,grdf_z -implicit none -! input -real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real tkh(0:nxp1,1-YES3D:nyp1,nzm) ! eddy conductivity -real fluxb(nx,ny) ! bottom flux -real fluxt(nx,ny) ! top flux -real rho(nzm) -real rhow(nz) -real flux(nz) -! local -real flx(0:nx,0:ny,0:nzm) -real dfdt(nx,ny,nz) -real rdx2,rdy2,rdz2,rdz,rdx5,rdy5,rdz5,tmp -real dxy,dxz,dyx,dyz,dzx,dzy,tkx,tky,tkz,rhoi -integer i,j,k,ib,ic,jb,jc,kc,kb - - -if(.not.dosgs) return - -rdx2=1./(dx*dx) -rdy2=1./(dy*dy) -rdz2=1./(dz*dz) -rdz=1./dz -dxy=dx/dy -dxz=dx/dz -dyx=dy/dx -dyz=dy/dz -dzx=dz/dx -dzy=dz/dy - -dfdt(:,:,:)=0. - -!----------------------------------------- -if(dowallx) then - - if(mod(rank,nsubdomains_x).eq.0) then - do k=1,nzm - do j=1,ny - field(0,j,k) = field(1,j,k) - end do - end do - end if - if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then - do k=1,nzm - do j=1,ny - field(nx+1,j,k) = field(nx,j,k) - end do - end do - end if - -end if - -if(dowally) then - - if(rank.lt.nsubdomains_x) then - do k=1,nzm - do i=1,nx - field(i,1-YES3D,k) = field(i,1,k) - end do - end do - end if - if(rank.gt.nsubdomains-nsubdomains_x-1) then - do k=1,nzm - do i=1,ny - field(i,ny+YES3D,k) = field(i,ny,k) - end do - end do - end if - -end if - - - -if(dowally) then - - call task_rank_to_index(rank, ib, jb) - if(jb.eq.0) then - do k=1,nzm - do i=1,nx - field(i,1-YES3D,k) = field(i,1,k) - end do - end do - end if - if(jb.eq.nsubdomains_y-1) then - do k=1,nzm - do i=1,nx - field(i,ny+YES3D,k) = field(i,ny,k) - end do - end do - end if - -end if - -!----------------------------------------- - - -! Horizontal diffusion: - - -do k=1,nzm - - rdx5=0.5*rdx2 * grdf_x(k) - rdy5=0.5*rdy2 * grdf_y(k) - - do j=1,ny - do i=0,nx - ic=i+1 - tkx=rdx5*(tkh(i,j,k)+tkh(ic,j,k)) - flx(i,j,k)=-tkx*(field(ic,j,k)-field(i,j,k)) - end do - do i=1,nx - ib=i-1 - dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(ib,j,k)) - end do - end do - - do j=0,ny - jc=j+1 - do i=1,nx - tky=rdy5*(tkh(i,j,k)+tkh(i,jc,k)) - flx(i,j,k)=-tky*(field(i,jc,k)-field(i,j,k)) - end do - end do - do j=1,ny - jb=j-1 - do i=1,nx - dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(i,jb,k)) - end do - end do - -end do ! k - - -! Vertical diffusion: - -flux(1) = 0. -tmp=1./adzw(nz) -do j=1,ny - do i=1,nx - flx(i,j,0)=fluxb(i,j)*rdz*rhow(1) - flx(i,j,nzm)=fluxt(i,j)*rdz*tmp*rhow(nz) - flux(1) = flux(1) + flx(i,j,0) - end do -end do - - -do k=1,nzm-1 - kc=k+1 - flux(kc)=0. - rhoi = rhow(kc)/adzw(kc) - rdz5=0.5*rdz2 * grdf_z(k) - do j=1,ny - do i=1,nx - tkz=rdz5*(tkh(i,j,k)+tkh(i,j,kc)) - flx(i,j,k)=-tkz*(field(i,j,kc)-field(i,j,k))*rhoi - flux(kc) = flux(kc) + flx(i,j,k) - end do - end do -end do - -do k=1,nzm - kb=k-1 - rhoi = 1./(adz(k)*rho(k)) - do j=1,ny - do i=1,nx - dfdt(i,j,k)=dtn*(dfdt(i,j,k)-(flx(i,j,k)-flx(i,j,kb))*rhoi) - field(i,j,k)=field(i,j,k)+dfdt(i,j,k) - end do - end do -end do - -end subroutine diffuse_scalar3D diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_xy.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_xy.F90 deleted file mode 100644 index e9f0db80c7..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_xy.F90 +++ /dev/null @@ -1,146 +0,0 @@ -subroutine diffuse_scalar3D_xy (field,fluxb,fluxt,tkh,rho,rhow,flux) - -use crmx_grid -use crmx_params, only: docolumn,dowallx,dowally,dosgs -use crmx_sgs, only: grdf_x,grdf_y,grdf_z -implicit none -! input -real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real tkh(0:nxp1,1-YES3D:nyp1,nzm) ! eddy conductivity -real fluxb(nx,ny) ! bottom flux -real fluxt(nx,ny) ! top flux -real rho(nzm) -real rhow(nz) -real flux(nz) -! local -real flx(0:nx,0:ny,0:nzm) -real dfdt(nx,ny,nz) -real rdx2,rdy2,rdz2,rdz,rdx5,rdy5,rdz5,tmp -real dxy,dxz,dyx,dyz,dzx,dzy,tkx,tky,tkz,rhoi -integer i,j,k,ib,ic,jb,jc,kc,kb - - -if(.not.dosgs) return - -rdx2=1./(dx*dx) -rdy2=1./(dy*dy) -rdz2=1./(dz*dz) -rdz=1./dz -dxy=dx/dy -dxz=dx/dz -dyx=dy/dx -dyz=dy/dz -dzx=dz/dx -dzy=dz/dy - -dfdt(:,:,:)=0. - -!----------------------------------------- -if(dowallx) then - - if(mod(rank,nsubdomains_x).eq.0) then - do k=1,nzm - do j=1,ny - field(0,j,k) = field(1,j,k) - end do - end do - end if - if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then - do k=1,nzm - do j=1,ny - field(nx+1,j,k) = field(nx,j,k) - end do - end do - end if - -end if - -if(dowally) then - - if(rank.lt.nsubdomains_x) then - do k=1,nzm - do i=1,nx - field(i,1-YES3D,k) = field(i,1,k) - end do - end do - end if - if(rank.gt.nsubdomains-nsubdomains_x-1) then - do k=1,nzm - do i=1,ny - field(i,ny+YES3D,k) = field(i,ny,k) - end do - end do - end if - -end if - - - -if(dowally) then - - call task_rank_to_index(rank, ib, jb) - if(jb.eq.0) then - do k=1,nzm - do i=1,nx - field(i,1-YES3D,k) = field(i,1,k) - end do - end do - end if - if(jb.eq.nsubdomains_y-1) then - do k=1,nzm - do i=1,nx - field(i,ny+YES3D,k) = field(i,ny,k) - end do - end do - end if - -end if - -!----------------------------------------- - - -! Horizontal diffusion: - - -do k=1,nzm - - rdx5=0.5*rdx2 * grdf_x(k) - rdy5=0.5*rdy2 * grdf_y(k) - - do j=1,ny - do i=0,nx - ic=i+1 - tkx=rdx5*(tkh(i,j,k)+tkh(ic,j,k)) - flx(i,j,k)=-tkx*(field(ic,j,k)-field(i,j,k)) - end do - do i=1,nx - ib=i-1 - dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(ib,j,k)) - end do - end do - - do j=0,ny - jc=j+1 - do i=1,nx - tky=rdy5*(tkh(i,j,k)+tkh(i,jc,k)) - flx(i,j,k)=-tky*(field(i,jc,k)-field(i,j,k)) - end do - end do - do j=1,ny - jb=j-1 - do i=1,nx - dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(i,jb,k)) - end do - end do - - do j=1, ny - do i=1, nx - field(i,j,k) = field(i,j,k) + dfdt(i,j,k) * dtn - end do - end do - -end do ! k - -flux = 0.0 - -end subroutine diffuse_scalar3D_xy diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_z.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_z.F90 deleted file mode 100644 index d8066cc750..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar3D_z.F90 +++ /dev/null @@ -1,76 +0,0 @@ -subroutine diffuse_scalar3D_z (field,fluxb,fluxt,tkh,rho,rhow,flux) - -use crmx_grid -use crmx_params, only: docolumn,dowallx,dowally,dosgs -use crmx_sgs, only: grdf_x,grdf_y,grdf_z -implicit none -! input -real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real tkh(0:nxp1,1-YES3D:nyp1,nzm) ! eddy conductivity -real fluxb(nx,ny) ! bottom flux -real fluxt(nx,ny) ! top flux -real rho(nzm) -real rhow(nz) -real flux(nz) -! local -real flx(0:nx,0:ny,0:nzm) -real dfdt(nx,ny,nz) -real rdx2,rdy2,rdz2,rdz,rdx5,rdy5,rdz5,tmp -real dxy,dxz,dyx,dyz,dzx,dzy,tkx,tky,tkz,rhoi -integer i,j,k,ib,ic,jb,jc,kc,kb - - -if(.not.dosgs) return - -rdx2=1./(dx*dx) -rdy2=1./(dy*dy) -rdz2=1./(dz*dz) -rdz=1./dz -dxy=dx/dy -dxz=dx/dz -dyx=dy/dx -dyz=dy/dz -dzx=dz/dx -dzy=dz/dy - -dfdt(:,:,:)=0. - -! Vertical diffusion: - -flux(1) = 0. -tmp=1./adzw(nz) -do j=1,ny - do i=1,nx - flx(i,j,0)=fluxb(i,j)*rdz*rhow(1) - flx(i,j,nzm)=fluxt(i,j)*rdz*tmp*rhow(nz) - flux(1) = flux(1) + flx(i,j,0) - end do -end do - - -do k=1,nzm-1 - kc=k+1 - flux(kc)=0. - rhoi = rhow(kc)/adzw(kc) - rdz5=0.5*rdz2 * grdf_z(k) - do j=1,ny - do i=1,nx - tkz=rdz5*(tkh(i,j,k)+tkh(i,j,kc)) - flx(i,j,k)=-tkz*(field(i,j,kc)-field(i,j,k))*rhoi - flux(kc) = flux(kc) + flx(i,j,k) - end do - end do -end do - -do k=1,nzm - kb=k-1 - rhoi = 1./(adz(k)*rho(k)) - do j=1,ny - do i=1,nx - dfdt(i,j,k)=dtn*(dfdt(i,j,k)-(flx(i,j,k)-flx(i,j,kb))*rhoi) - field(i,j,k)=field(i,j,k)+dfdt(i,j,k) - end do - end do -end do - -end subroutine diffuse_scalar3D_z diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_xy.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_xy.F90 deleted file mode 100644 index 2d3944e1f4..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_xy.F90 +++ /dev/null @@ -1,53 +0,0 @@ -subroutine diffuse_scalar_xy (f,fluxb,fluxt, & - fdiff,flux,f2lediff,f2lediss,fwlediff,doit) - -use crmx_grid -use crmx_vars, only: rho, rhow -use crmx_sgs, only: tkh -implicit none - -! input: -real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real fluxb(nx,ny) ! bottom flux -real fluxt(nx,ny) ! top flux -real flux(nz) -real fdiff(nz) -real f2lediff(nz) -real f2lediss(nz) -real fwlediff(nz) -logical doit -! Local -real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real f0(nzm),df0(nzm),factor_xy -real r2dx,r2dy,r2dx0,r2dy0,r2dz -integer i,j,k,kb,kc,jb,jc - -!call t_startf ('diffuse_scalars_xy') - - - do k=1,nzm - do j=dimy1_s,dimy2_s - do i=dimx1_s,dimx2_s - df(i,j,k) = f(i,j,k) - end do - end do - end do - -if(RUN3D) then - call diffuse_scalar3D_xy (f,fluxb,fluxt,tkh,rho,rhow,flux) -else - call diffuse_scalar2D_xy (f,fluxb,fluxt,tkh,rho,rhow,flux) -endif - - do k=1,nzm - fdiff(k)=0. - do j=1,ny - do i=1,nx - fdiff(k)=fdiff(k)+f(i,j,k)-df(i,j,k) - end do - end do - end do - -!call t_stopf ('diffuse_scalars_xy') - -end subroutine diffuse_scalar_xy diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_z.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_z.F90 deleted file mode 100644 index e74aa7f2b5..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_diffuse_scalar_z.F90 +++ /dev/null @@ -1,70 +0,0 @@ -subroutine diffuse_scalar_z (f,fluxb,fluxt, & - fdiff,flux,f2lediff,f2lediss,fwlediff,doit) - -use crmx_grid -use crmx_vars, only: rho, rhow -use crmx_sgs, only: tkh -#ifdef CLUBB_CRM -use crmx_sgs, only: tkh_clubb -use crmx_params, only: doclubb -#endif -implicit none - -! input: -real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real fluxb(nx,ny) ! bottom flux -real fluxt(nx,ny) ! top flux -real flux(nz) -real fdiff(nz) -real f2lediff(nz) -real f2lediss(nz) -real fwlediff(nz) -logical doit -! Local -real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real tkhtemp(0:nxp1, 1-YES3D:nyp1, nzm) ! eddy diffusivity -real f0(nzm),df0(nzm),factor_xy -real f2lediss_z(nzm) -real r2dx,r2dy,r2dx0,r2dy0,r2dz -integer i,j,k,kb,kc,jb,jc - -!call t_startf ('diffuse_scalars_z') - -tkhtemp = 0.0 -#ifndef CLUBB_CRM -tkhtemp(:, :, :) = tkh(:, :, :) -#else -if(doclubb) then - tkhtemp(:, :, :) = tkh_clubb(:, :, :) -else - tkhtemp(:, :, :) = tkh(:, :, :) -endif -#endif - - do k=1,nzm - do j=dimy1_s,dimy2_s - do i=dimx1_s,dimx2_s - df(i,j,k) = f(i,j,k) - end do - end do - end do - - -if(RUN3D) then - call diffuse_scalar3D_z (f,fluxb,fluxt,tkhtemp,rho,rhow,flux) -else - call diffuse_scalar2D_z (f,fluxb,fluxt,tkhtemp,rho,rhow,flux) -endif - - do k=1,nzm - fdiff(k)=0. - do j=1,ny - do i=1,nx - fdiff(k)=fdiff(k)+f(i,j,k)-df(i,j,k) - end do - end do - end do - -!call t_stopf ('diffuse_scalars_z') - -end subroutine diffuse_scalar_z diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_fluxes_scalar_z.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_fluxes_scalar_z.F90 deleted file mode 100644 index 5cd9b14561..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_fluxes_scalar_z.F90 +++ /dev/null @@ -1,64 +0,0 @@ -subroutine fluxes_scalar_z (f,fluxb,fluxt, & - fdiff,flux,f2lediff,f2lediss,fwlediff,doit) - -!-------------------------------------------------------------------- -! This subroutine is only used to apply the surface fluxes for scalars. -! This is needed when surface fluxes are applied in the host model in SAM_CLUBB -! Here tkh is zet to zero so vertical diffusion is not calculated. -! Minghuai Wang, 2013-02 -!--------------------------------------------------------------------- - -use crmx_grid -use crmx_vars, only: rho, rhow -!use sgs, only: tkh -implicit none - -! input: -real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real fluxb(nx,ny) ! bottom flux -real fluxt(nx,ny) ! top flux -real flux(nz) -real fdiff(nz) -real f2lediff(nz) -real f2lediss(nz) -real fwlediff(nz) -logical doit -! Local -real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real f0(nzm),df0(nzm),factor_xy -real f2lediss_z(nzm) -real tkh2(0:nxp1, 1-YES3D:nyp1, nzm) ! eddy conductivity -real r2dx,r2dy,r2dx0,r2dy0,r2dz -integer i,j,k,kb,kc,jb,jc - -!call t_startf ('fluxes_scalars_z') - -tkh2 = 0.0 - - do k=1,nzm - do j=dimy1_s,dimy2_s - do i=dimx1_s,dimx2_s - df(i,j,k) = f(i,j,k) - end do - end do - end do - - -if(RUN3D) then - call diffuse_scalar3D_z (f,fluxb,fluxt,tkh2,rho,rhow,flux) -else - call diffuse_scalar2D_z (f,fluxb,fluxt,tkh2,rho,rhow,flux) -endif - - do k=1,nzm - fdiff(k)=0. - do j=1,ny - do i=1,nx - fdiff(k)=fdiff(k)+f(i,j,k)-df(i,j,k) - end do - end do - end do - -!call t_stopf ('fluxes_scalars_z') - -end subroutine fluxes_scalar_z diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_sgs.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_sgs.F90 deleted file mode 100644 index 82fb15ad33..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_sgs.F90 +++ /dev/null @@ -1,661 +0,0 @@ -module crmx_sgs - -! module for original SAM subgrid-scale SGS closure (Smagorinsky or 1st-order TKE) -! Marat Khairoutdinov, 2012 - -use crmx_grid, only: nx,nxp1,ny,nyp1,YES3D,nzm,nz,dimx1_s,dimx2_s,dimy1_s,dimy2_s -use crmx_params, only: dosgs -use crmx_vars, only: tke2, tk2 -#ifdef CLUBB_CRM -use crmx_clubbvars, only: khzt, khzm -use crmx_params, only: doclubb -#endif -implicit none - -!---------------------------------------------------------------------- -! Required definitions: - -!!! prognostic scalar (need to be advected arround the grid): - -integer, parameter :: nsgs_fields = 1 ! total number of prognostic sgs vars - -real sgs_field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm, nsgs_fields) - -!!! sgs diagnostic variables that need to exchange boundary information (via MPI): - -#ifndef CLUBB_CRM -integer, parameter :: nsgs_fields_diag = 2 ! total number of diagnostic sgs vars -#else -integer, parameter :: nsgs_fields_diag = 4 ! total number of diagnostic sgs vars -#endif - -! diagnostic fields' boundaries: -integer, parameter :: dimx1_d=0, dimx2_d=nxp1, dimy1_d=1-YES3D, dimy2_d=nyp1 - -real sgs_field_diag(dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm, nsgs_fields_diag) - -logical:: advect_sgs = .false. ! advect prognostics or not, default - not (Smagorinsky) -logical, parameter:: do_sgsdiag_bound = .true. ! exchange boundaries for diagnostics fields - -! SGS fields that output by default (if =1). -integer, parameter :: flag_sgs3Dout(nsgs_fields) = (/0/) -#ifndef CLUBB_CRM -integer, parameter :: flag_sgsdiag3Dout(nsgs_fields_diag) = (/0,0/) -#else -integer, parameter :: flag_sgsdiag3Dout(nsgs_fields_diag) = (/0,0,0,0/) -#endif - -real fluxbsgs (nx, ny, 1:nsgs_fields) ! surface fluxes -real fluxtsgs (nx, ny, 1:nsgs_fields) ! top boundary fluxes - -!!! these arrays may be needed for output statistics: - -real sgswle(nz,1:nsgs_fields) ! resolved vertical flux -real sgswsb(nz,1:nsgs_fields) ! SGS vertical flux -real sgsadv(nz,1:nsgs_fields) ! tendency due to vertical advection -real sgslsadv(nz,1:nsgs_fields) ! tendency due to large-scale vertical advection -real sgsdiff(nz,1:nsgs_fields) ! tendency due to vertical diffusion - -!------------------------------------------------------------------ -! internal (optional) definitions: - -! make aliases for prognostic variables: - -real tke(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! SGS TKE -equivalence (tke(dimx1_s,dimy1_s,1),sgs_field(dimx1_s,dimy1_s,1,1)) - -! make aliases for diagnostic variables: - -real tk (dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm) ! SGS eddy viscosity -real tkh (dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm) ! SGS eddy conductivity -equivalence (tk(dimx1_d,dimy1_d,1), sgs_field_diag(dimx1_d, dimy1_d,1,1)) -equivalence (tkh(dimx1_d,dimy1_d,1), sgs_field_diag(dimx1_d, dimy1_d,1,2)) -#ifdef CLUBB_CRM -real tk_clubb (dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm) ! SGS eddy viscosity -real tkh_clubb (dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm) ! SGS eddy conductivity -equivalence (tk_clubb(dimx1_d,dimy1_d,1), sgs_field_diag(dimx1_d, dimy1_d,1,3)) -equivalence (tkh_clubb(dimx1_d,dimy1_d,1), sgs_field_diag(dimx1_d, dimy1_d,1,4)) -#endif - -real grdf_x(nzm)! grid factor for eddy diffusion in x -real grdf_y(nzm)! grid factor for eddy diffusion in y -real grdf_z(nzm)! grid factor for eddy diffusion in z - -logical:: dosmagor ! if true, then use Smagorinsky closure - -! Local diagnostics: - -real tkesbbuoy(nz), tkesbshear(nz),tkesbdiss(nz), tkesbdiff(nz) - -CONTAINS - -! required microphysics subroutines and function: -!---------------------------------------------------------------------- -!!! Read microphysics options from prm (namelist) file - -subroutine sgs_setparm() - - use crmx_grid, only: case - implicit none - - integer ierr, ios, ios_missing_namelist, place_holder - - !====================================================================== - ! UW ADDITION - NAMELIST /SGS_TKE/ & - dosmagor ! Diagnostic Smagorinsky closure - - NAMELIST /BNCUIODSBJCB/ place_holder - - dosmagor = .true. ! default - - !---------------------------------- - ! Read namelist for microphysics options from prm file: - !------------ - !open(55,file='./'//trim(case)//'/prm', status='old',form='formatted') - - !read (UNIT=55,NML=BNCUIODSBJCB,IOSTAT=ios_missing_namelist) - !rewind(55) !note that one must rewind before searching for new namelists - - !read (55,SGS_TKE,IOSTAT=ios) - - advect_sgs = .not.dosmagor - - !if (ios.ne.0) then - ! !namelist error checking - ! if(ios.ne.ios_missing_namelist) then - ! write(*,*) '****** ERROR: bad specification in SGS_TKE namelist' - ! call task_abort() - ! end if - !end if - !close(55) - - ! END UW ADDITION - !====================================================================== - -end subroutine sgs_setparm - -!---------------------------------------------------------------------- -!!! Initialize sgs: - - -subroutine sgs_init() - - use crmx_grid, only: nrestart, dx, dy, dz, adz, masterproc - use crmx_params, only: LES -#ifdef CLUBB_CRM - use crmx_params, only: doclubb -#endif - integer k - - if(nrestart.eq.0) then - - sgs_field = 0. - sgs_field_diag = 0. - - fluxbsgs = 0. - fluxtsgs = 0. - - end if - -! if(masterproc) then -! if(dosmagor) then -! write(*,*) 'Smagorinsky SGS Closure' -! else -! write(*,*) 'Prognostic TKE 1.5-order SGS Closure' -! end if -!#ifdef CLUBB_CRM -! if ( doclubb ) then -! write(*,*) 'CLUBB Parameterization' -! end if -!#endif -! end if - - if(LES) then - do k=1,nzm - grdf_x(k) = dx**2/(adz(k)*dz)**2 - grdf_y(k) = dy**2/(adz(k)*dz)**2 - grdf_z(k) = 1. - end do - else - do k=1,nzm - grdf_x(k) = min(16.,dx**2/(adz(k)*dz)**2) - grdf_y(k) = min(16.,dy**2/(adz(k)*dz)**2) - grdf_z(k) = 1. - end do - end if - - sgswle = 0. - sgswsb = 0. - sgsadv = 0. - sgsdiff = 0. - sgslsadv = 0. - - -end subroutine sgs_init - -!---------------------------------------------------------------------- -!!! make some initial noise in sgs: -! -subroutine setperturb_sgs(ptype) - -use crmx_vars, only: q0, z -integer, intent(in) :: ptype -integer i,j,k - -select case (ptype) - - case(0) - - do k=1,nzm - do j=1,ny - do i=1,nx - if(k.le.4.and..not.dosmagor) then - tke(i,j,k)=0.04*(5-k) - endif - end do - end do - end do - - case(1) - - do k=1,nzm - do j=1,ny - do i=1,nx - if(q0(k).gt.6.e-3.and..not.dosmagor) then - tke(i,j,k)=1. - endif - end do - end do - end do - - case(2) - - case(3) ! gcss wg1 smoke-cloud case - - do k=1,nzm - do j=1,ny - do i=1,nx - if(q0(k).gt.0.5e-3.and..not.dosmagor) then - tke(i,j,k)=1. - endif - end do - end do - end do - - - case(4) ! gcss wg1 arm case - - do k=1,nzm - do j=1,ny - do i=1,nx - if(z(k).le.150..and..not.dosmagor) then - tke(i,j,k)=0.15*(1.-z(k)/150.) - endif - end do - end do - end do - - - case(5) ! gcss wg1 BOMEX case - - do k=1,nzm - do j=1,ny - do i=1,nx - if(z(k).le.3000..and..not.dosmagor) then - tke(i,j,k)=1.-z(k)/3000. - endif - end do - end do - end do - - case(6) ! GCSS Lagragngian ASTEX - - - do k=1,nzm - do j=1,ny - do i=1,nx - if(q0(k).gt.6.e-3.and..not.dosmagor) then - tke(i,j,k)=1. - endif - end do - end do - end do - - - case default - -end select - -end subroutine setperturb_sgs - -!---------------------------------------------------------------------- -!!! Estimate Courant number limit for SGS -! - -subroutine kurant_sgs(cfl) - -use crmx_grid, only: dt, dx, dy, dz, adz, adzw -implicit none - -real, intent(out) :: cfl - -integer k -real tkhmax(nz) - -do k = 1,nzm - tkhmax(k) = maxval(tkh(1:nx,1:ny,k)) -end do - -cfl = 0. -do k=1,nzm - cfl = max(cfl, & - 0.5*tkhmax(k)*grdf_z(k)*dt/(dz*adzw(k))**2, & - 0.5*tkhmax(k)*grdf_x(k)*dt/dx**2, & - YES3D*0.5*tkhmax(k)*grdf_y(k)*dt/dy**2) -end do - -end subroutine kurant_sgs - - -!---------------------------------------------------------------------- -!!! compute sgs diffusion of momentum: -! -subroutine sgs_mom() -#ifdef CLUBB_CRM - use crmx_params, only: doclubb - use crmx_clubb_sgs, only: apply_clubb_sgs_tndcy_mom - use crmx_vars, only: dudt, dvdt -#endif - -#ifdef CLUBB_CRM - if ( doclubb ) then -! call apply_clubb_sgs_tndcy_mom & -! ( dudt, dvdt ) ! in/out - endif -#endif /*CLUBB_CRM*/ - - call diffuse_mom() - -end subroutine sgs_mom - -!---------------------------------------------------------------------- -!!! compute sgs diffusion of scalars: -! -subroutine sgs_scalars() - - use crmx_vars - use crmx_microphysics - use crmx_crmtracers - use crmx_params, only: dotracers, doclubb, doclubb_sfc_fluxes, doclubbnoninter, docam_sfc_fluxes -#ifdef CLUBB_CRM - use crmx_clubbvars, only: edsclr_dim, sclr_dim - use crmx_clubb_sgs, only: total_energy - use crmx_clubb_sgs, only: apply_clubb_sgs_tndcy_scalars - use crmx_grid, only: dtn - use crmx_clubb_precision, only: time_precision -#endif /*CLUBB_CRM*/ - implicit none - - real dummy(nz) - real f2lediff_xy(nz), f2lediss_xy(nz), fwlediff_xy(nz) - real f2lediff_z(nz), f2lediss_z(nz), fwlediff_z(nz) - real sdiff_xy(nz), sdiff_z(nz) - real fluxbtmp(nx,ny), fluxttmp(nx,ny) !bloss - integer k - - -#ifdef CLUBB_CRM - total_energy_evap = total_energy_evap - total_energy(t) -#endif - -! Update for t, qv, qcl from clubb_sgs -#ifdef CLUBB_CRM - if ( doclubb ) then - - ! Recalculate q, qv, qcl based on new micro_fields (updated by horizontal - ! diffusion) - call micro_update() - - ! Then Re-compute q/qv/qcl based on values computed in CLUBB - call apply_clubb_sgs_tndcy_scalars & - ( real( dtn, kind=time_precision), & ! in - t, qv, qcl) ! in/out - - call micro_adjust( qv, qcl ) ! in - end if -#endif /*CLUBB_CRM*/ - - f2lediff_xy = 0.0 - f2lediss_xy = 0.0 - fwlediff_xy = 0.0 - -! call diffuse_scalar(t,fluxbt,fluxtt,tdiff,twsb, & -! t2lediff,t2lediss,twlediff,.true.) - call diffuse_scalar_xy(t,fluxbt,fluxtt,tdiff_xy,twsb, & - f2lediff_xy,f2lediss_xy,fwlediff_xy,.true.) - f2lediff_z =0.0 - f2lediss_z =0.0 - fwlediff_z =0.0 -#ifdef CLUBB_CRM - ! Diffuse moist static energy in the vertical only if CLUBB is not being - ! called - if ( .not. doclubb ) then - call diffuse_scalar_z(t,fluxbt,fluxtt,tdiff_z,twsb, & - f2lediff_z,f2lediss_z,fwlediff_z,.true.) - else ! doclubb - if(doclubb_sfc_fluxes .or. docam_sfc_fluxes) then - ! The flux will be applied in advance_clubb_core, so the 2nd argument - ! is zero. - call fluxes_scalar_z(t,fzero,fluxtt,tdiff_z,twsb, & - f2lediff_z,f2lediss_z,fwlediff_z,.true.) - else - call fluxes_scalar_z(t,fluxbt,fluxtt,tdiff_z,twsb, & - f2lediff_z,f2lediss_z,fwlediff_z,.true.) - end if - end if -#else - call diffuse_scalar_z(t,fluxbt,fluxtt,tdiff_z,twsb, & - f2lediff_z,f2lediss_z,fwlediff_z,.true.) -#endif - - tdiff = tdiff_xy + tdiff_z - - t2lediff = f2lediff_xy + f2lediff_z - t2lediss = f2lediss_xy + f2lediss_z - twlediff = fwlediff_xy + fwlediff_z - -#ifdef CLUBB_CRM - total_energy_evap = total_energy_evap + total_energy(t) -#endif - - if(advect_sgs) then -! call diffuse_scalar(tke,fzero,fzero,dummy,sgswsb, & -! dummy,dummy,dummy,.false.) - call diffuse_scalar_xy(tke,fzero,fzero,dummy,sgswsb, & - dummy,dummy,dummy,.false.) - call diffuse_scalar_z(tke,fzero,fzero,dummy,sgswsb, & - dummy,dummy,dummy,.false.) - end if - - -! -! diffusion of microphysics prognostics: -! - call micro_flux() - - total_water_evap = total_water_evap - total_water() - - do k = 1,nmicro_fields - if( k.eq.index_water_vapor &! transport water-vapor variable no metter what -#ifdef CLUBB_CRM - .or. ( docloud.or.doclubb.or.doclubbnoninter ).and.flag_precip(k).ne.1 & ! transport non-precipitation vars -#else - .or. docloud.and.flag_precip(k).ne.1 & ! transport non-precipitation vars -#endif - - .or. doprecip.and.flag_precip(k).eq.1 ) then - - fluxbtmp(1:nx,1:ny) = fluxbmk(1:nx,1:ny,k) - fluxttmp(1:nx,1:ny) = fluxtmk(1:nx,1:ny,k) - sdiff_xy = 0.0 - sdiff_z = 0.0 - -! call diffuse_scalar(micro_field(:,:,:,k),fluxbtmp,fluxttmp, & -! mkdiff(:,k),mkwsb(:,k), dummy,dummy,dummy,.false.) - call diffuse_scalar_xy(micro_field(:,:,:,k),fluxbtmp,fluxttmp, & - sdiff_xy,mkwsb(:,k), dummy,dummy,dummy,.false.) - if(k.ne.index_water_vapor) then - call diffuse_scalar_z(micro_field(:,:,:,k),fluxbtmp,fluxttmp, & - sdiff_z,mkwsb(:,k), dummy,dummy,dummy,.false.) - else ! k==index_water_vapor - if(.not. doclubb) then - call diffuse_scalar_z(micro_field(:,:,:,k),fluxbtmp,fluxttmp, & - sdiff_z,mkwsb(:,k), dummy,dummy,dummy,.false.) - else ! doclubb - call fluxes_scalar_z(micro_field(:,:,:,k),fluxbtmp,fluxttmp, & - sdiff_z,mkwsb(:,k), dummy,dummy,dummy,.false.) - end if - end if - mkdiff(:, k) = sdiff_xy + sdiff_z - end if - end do - - total_water_evap = total_water_evap + total_water() - - ! diffusion of tracers: - - if(dotracers) then - - call tracers_flux() - - do k = 1,ntracers - -#ifdef CLUBB_CRM - ! If CLUBB is using the high-order or eddy diffusivity scalars, then - ! we should apply the flux within advance_clubb_core when - ! doclubb_sfc_fluxes is set to true. -dschanen UWM 2 Mar 2010 - if ( ( edsclr_dim > 0 .or. sclr_dim > 0 ) .and. (doclubb_sfc_fluxes .or. docam_sfc_fluxes)) then - fluxbtmp = 0. ! Apply surface flux in CLUBB - else - fluxbtmp = fluxbtr(:,:,k) - end if -#else - fluxbtmp = fluxbtr(:,:,k) -#endif /*CLUBB_CRM*/ - fluxttmp = fluxttr(:,:,k) -! call diffuse_scalar(tracer(:,:,:,k),fluxbtmp,fluxttmp, & -! trdiff(:,k),trwsb(:,k), & -! dummy,dummy,dummy,.false.) - call diffuse_scalar_xy(tracer(:,:,:,k),fluxbtmp,fluxttmp, & - trdiff(:,k),trwsb(:,k), & - dummy,dummy,dummy,.false.) - -#ifdef CLUBB_CRM - ! Only diffuse the tracers if CLUBB is either disabled or using the - ! eddy scalars code to diffuse them. - if ( .not. doclubb .or. ( doclubb .and. edsclr_dim < 1 .and. sclr_dim < 1 ) ) then - call diffuse_scalar_z(tracer(:,:,:,k),fluxbtmp,fluxttmp, & - trdiff(:,k),trwsb(:,k), & - dummy,dummy,dummy,.false.) - end if -#else - call diffuse_scalar_z(tracer(:,:,:,k),fluxbtmp,fluxttmp, & - trdiff(:,k),trwsb(:,k), & - dummy,dummy,dummy,.false.) -#endif -!!$ call diffuse_scalar(tracer(:,:,:,k),fluxbtr(:,:,k),fluxttr(:,:,k),trdiff(:,k),trwsb(:,k), & -!!$ dummy,dummy,dummy,.false.) - - end do - - end if - - - -end subroutine sgs_scalars - -!---------------------------------------------------------------------- -!!! compute sgs processes (beyond advection): -! -subroutine sgs_proc() - - use crmx_grid, only: nstep,dt,icycle - use crmx_params, only: dosmoke -#ifdef CLUBB_CRM - use crmx_clubbvars, only: khzt, khzm - use crmx_microphysics - use crmx_params, only: doclubb, doclubbnoninter, nclubb - use crmx_grid, only: dtn, time, dt - use crmx_vars, only: u, v, w, rho, rhow, wsub, qpl, qci, qpi, t, qv, qcl - use crmx_clubb_precision, only: time_precision - use crmx_clubb_sgs, only: advance_clubb_sgs -#endif - -! SGS CLUBB -#ifdef CLUBB_CRM - if ( doclubb .or. doclubbnoninter ) then - ! In case of ice fall, we recompute qci here for the - ! single-moment scheme. Also, subsidence, diffusion and advection have - ! been applied to micro_field but not qv/qcl so they must be updated. - call micro_update() - - ! We call CLUBB here because adjustments to the wind - ! must occur prior to adams() -dschanen 26 Aug 2008 - ! Here we call clubb only if nstep divides the current timestep, - ! or we're on the very first timestep - -! in the case with m2005, clubb is only called in the first subscycle (icycle=1)) - if ( ((nstep == 1 .or. mod( nstep, nclubb ) == 0) .and. & - (icycle == 1)).and.(nclubb .ne. 1) ) then ! call every CRM step, so dt is used - call advance_clubb_sgs & - ( real( dt*real( nclubb ), kind=time_precision), & ! in - real( 0., kind=time_precision ), & ! in - real( time, kind=time_precision ), & ! in - rho, rhow, wsub, u, v, w, qpl, qci, qpi, & ! in - t, qv, qcl ) ! in - else if(nclubb.eq.1) then ! call every icycle, so dtn is used - call advance_clubb_sgs & - ( real( dtn*real( nclubb ), kind=time_precision), & ! in - real( 0., kind=time_precision ), & ! in - real( time, kind=time_precision ), & ! in - rho, rhow, wsub, u, v, w, qpl, qci, qpi, & ! in - t, qv, qcl ) ! in - end if ! nstep == 1 .or. mod( nstep, nclubb) == 0 - - end if ! doclubb .or. doclubbnoninter -#endif - -! SGS TKE equation: - - if(dosgs) call tke_full() - - tke2 = tke - tk2 = tk - -#ifdef CLUBB_CRM - if(doclubb) then -! tk = khzt -! tkh = khzt - -! tk_clubb = khzt -! tkh_clubb = khzt - tk_clubb = khzm - tkh_clubb = khzm - end if -#endif - - -end subroutine sgs_proc - -!---------------------------------------------------------------------- -!!! Diagnose arrays nessesary for dynamical core and statistics: -! -subroutine sgs_diagnose() -! None - -end subroutine sgs_diagnose - -!---------------------------------------------------------------------- -! called when stepout() called - -subroutine sgs_print() - - call fminmax_print('tke:',tke,dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm) - call fminmax_print('tk:',tk,0,nxp1,1-YES3D,nyp1,nzm) - call fminmax_print('tkh:',tkh,0,nxp1,1-YES3D,nyp1,nzm) - -end subroutine sgs_print - -!---------------------------------------------------------------------- -!!! Initialize the list of sgs statistics -! -subroutine sgs_hbuf_init(namelist,deflist,unitlist,status,average_type,count,sgscount) -character(*) namelist(*), deflist(*), unitlist(*) -integer status(*),average_type(*),count,sgscount - -character*8 name -character*80 longname -character*10 units - -#ifdef CLUBB -if (doclubb) then -name = 'TKCLUBB' -longname = 'Eddy diffusivity from CLUBB' -units = 'm2/s' -call add_to_namelist(count,sgscount,name,longname,units,0) - -name = 'TKHCLUBB' -longname = 'Eddy diffusivity from CLUBB' -units = 'm2/s' -call add_to_namelist(count,sgscount,name,longname,units,0) -end if -#endif - -end subroutine sgs_hbuf_init - - -end module crmx_sgs - - - diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod2D.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod2D.F90 deleted file mode 100644 index 50fe343ebe..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod2D.F90 +++ /dev/null @@ -1,109 +0,0 @@ - -subroutine shear_prod2D(def2) - -use crmx_vars -implicit none - -real def2(nx,ny,nzm) - -real rdx0,rdx,rdx_up,rdx_dn -real rdz,rdzw_up,rdzw_dn -integer i,j,k,ib,ic,kb,kc - -rdx0=1./dx -j=1 - - -do k=2,nzm-1 - - kb=k-1 - kc=k+1 - rdz = 1./(dz*adz(k)) - rdzw_up = 1./(dz*adzw(kc)) - rdzw_dn = 1./(dz*adzw(k)) - rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy - rdx_up=rdx0 * sqrt(dx*rdzw_up) - rdx_dn=rdx0 * sqrt(dx*rdzw_dn) - - do i=1,nx - ib=i-1 - ic=i+1 - - def2(i,j,k)=2.* ( & - ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & - ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & - + 0.5 * ( & - ( (v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & - ( (v(i ,j ,k)-v(ib,j ,k))*rdx )**2 + & - ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & - (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & - ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & - (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 + & - ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & - (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & - ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & - (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 + & - ( (v(i,j ,kc)-v0(kc)-v(i,j , k)+v0(k))*rdzw_up )**2 + & - ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn )**2 ) - - end do -end do ! k - - -k=1 -kc=k+1 - -rdz = 1./(dz*adz(k)) -rdzw_up = 1./(dz*adzw(kc)) -rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy -rdx_up=rdx0 * sqrt(dx*rdzw_up) - -do i=1,nx - ib=i-1 - ic=i+1 - - def2(i,j,k)=2.* ( & - ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & - ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & - + 0.5 * ( & - ( (v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & - ( (v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & - +( (v(i,j ,kc)-v0(kc)-v(i,j,k)+v0(k))*rdzw_up )**2 & - + 0.5 * ( & - ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & - (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & - ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & - (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 ) -end do - -k=nzm -kc=k+1 -kb=k-1 - -rdz = 1./(dz*adz(k)) -rdzw_dn = 1./(dz*adzw(k)) -rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy -rdx_dn=rdx0 * sqrt(dx*rdzw_dn) - - -do i=1,nx - ib=i-1 - ic=i+1 - - def2(i,j,k)=2.* ( & - ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & - ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & - + 0.5 * ( & - ( (v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & - ( (v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & - + ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn )**2 & - + 0.5 * ( & - ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & - (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & - ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & - (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 ) - -end do - -end - diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod3D.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod3D.F90 deleted file mode 100644 index 2ecd9c25a6..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_shear_prod3D.F90 +++ /dev/null @@ -1,155 +0,0 @@ - -subroutine shear_prod3D(def2) - -use crmx_vars -implicit none - -real def2(nx,ny,nzm) - -real rdx0,rdx,rdx_up,rdx_dn -real rdy0,rdy,rdy_up,rdy_dn -real rdz,rdzw_up,rdzw_dn -integer i,j,k,ib,ic,jb,jc,kb,kc - -rdx0=1./dx -rdy0=1./dy - -do k=2,nzm-1 - - kb=k-1 - kc=k+1 - rdz = 1./(dz*adz(k)) - rdzw_up = 1./(dz*adzw(kc)) - rdzw_dn = 1./(dz*adzw(k)) - rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy - rdy=rdy0 * sqrt(dy*rdz) - rdx_up=rdx0 * sqrt(dx*rdzw_up) - rdy_up=rdy0 * sqrt(dy*rdzw_up) - rdx_dn=rdx0 * sqrt(dx*rdzw_dn) - rdy_dn=rdy0 * sqrt(dy*rdzw_dn) - - do j=1,ny - jb=j-YES3D - jc=j+YES3D - do i=1,nx - ib=i-1 - ic=i+1 - - def2(i,j,k)=2.* ( & - ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & - ( (v(i,jc,k)-v(i,j,k))*rdy)**2+ & - ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & - + 0.25 * ( & - ( (u(ic,jc,k)-u(ic,j ,k))*rdy+(v(ic,jc,k)-v(i ,jc,k))*rdx )**2 + & - ( (u(i ,jc,k)-u(i ,j ,k))*rdy+(v(i ,jc,k)-v(ib,jc,k))*rdx )**2 + & - ( (u(ic,j ,k)-u(ic,jb,k))*rdy+(v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & - ( (u(i ,j ,k)-u(i ,jb,k))*rdy+(v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) - def2(i,j,k)=def2(i,j,k) & - + 0.25 * ( & - ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & - (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & - ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & - (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 + & - ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & - (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & - ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & - (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 ) - def2(i,j,k)=def2(i,j,k) & - + 0.25 * ( & - ( (v(i,jc,kc)-v0(kc)-v(i,jc, k)+v0(k))*rdzw_up+ & - (w(i,jc,kc)-w(i,j ,kc))*rdy_up )**2 + & - ( (v(i,j ,kc)-v0(kc)-v(i,j , k)+v0(k))*rdzw_up+ & - (w(i,j ,kc)-w(i,jb,kc))*rdy_up )**2 + & - ( (v(i,jc,k )-v0(k)-v(i,jc,kb)+v0(kb))*rdzw_dn+ & - (w(i,jc,k )-w(i,j ,k ))*rdy_dn )**2 + & - ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn+ & - (w(i,j ,k )-w(i,jb,k ))*rdy_dn )**2 ) - - end do - end do -end do ! k - - -k=1 -kc=k+1 - -rdz = 1./(dz*adz(k)) -rdzw_up = 1./(dz*adzw(kc)) -rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy -rdy=rdy0 * sqrt(dy*rdz) -rdx_up=rdx0 * sqrt(dx*rdzw_up) -rdy_up=rdy0 * sqrt(dy*rdzw_up) - -do j=1,ny - jb=j-YES3D - jc=j+YES3D - do i=1,nx - ib=i-1 - ic=i+1 - - def2(i,j,k)=2.* ( & - ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & - ( (v(i,jc,k)-v(i,j,k))*rdy)**2+ & - ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & - + 0.25 * ( & - ( (u(ic,jc,k)-u(ic,j ,k))*rdy+(v(ic,jc,k)-v(i ,jc,k))*rdx )**2 + & - ( (u(i ,jc,k)-u(i ,j ,k))*rdy+(v(i ,jc,k)-v(ib,jc,k))*rdx )**2 + & - ( (u(ic,j ,k)-u(ic,jb,k))*rdy+(v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & - ( (u(i ,j ,k)-u(i ,jb,k))*rdy+(v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & - + 0.5 * ( & - ( (v(i,jc,kc)-v0(kc)-v(i,jc, k)+v0(k))*rdzw_up+ & - (w(i,jc,kc)-w(i,j ,kc))*rdy_up )**2 + & - ( (v(i,j ,kc)-v0(kc)-v(i,j , k)+v0(k))*rdzw_up+ & - (w(i,j ,kc)-w(i,jb,kc))*rdy_up )**2 ) & - + 0.5 * ( & - ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & - (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & - ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & - (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 ) - - - end do -end do - - -k=nzm -kc=k+1 -kb=k-1 - -rdz = 1./(dz*adz(k)) -rdzw_dn = 1./(dz*adzw(k)) -rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy -rdy=rdy0 * sqrt(dy*rdz) -rdx_dn=rdx0 * sqrt(dx*rdzw_dn) -rdy_dn=rdy0 * sqrt(dy*rdzw_dn) - -do j=1,ny - jb=j-1*YES3D - jc=j+1*YES3D - do i=1,nx - ib=i-1 - ic=i+1 - def2(i,j,k)=2.* ( & - ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & - ( (v(i,jc,k)-v(i,j,k))*rdy)**2+ & - ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & - + 0.25 * ( & - ( (u(ic,jc,k)-u(ic,j ,k))*rdy+(v(ic,jc,k)-v(i ,jc,k))*rdx )**2 + & - ( (u(i ,jc,k)-u(i ,j ,k))*rdy+(v(i ,jc,k)-v(ib,jc,k))*rdx )**2 + & - ( (u(ic,j ,k)-u(ic,jb,k))*rdy+(v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & - ( (u(i ,j ,k)-u(i ,jb,k))*rdy+(v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & - + 0.5 * ( & - ( (v(i,jc,k )-v0(k)-v(i,jc,kb)+v0(kb))*rdzw_dn+ & - (w(i,jc,k )-w(i,j ,k ))*rdy_dn )**2 + & - ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn+ & - (w(i,j ,k )-w(i,jb,k ))*rdy_dn )**2 ) & - + 0.5 * ( & - ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & - (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & - ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & - (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 ) - end do -end do - -end - diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_stat_clubb.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_stat_clubb.F90 deleted file mode 100644 index 8a0bb38481..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_stat_clubb.F90 +++ /dev/null @@ -1,1479 +0,0 @@ -! $Id: stat_clubb.F90 1070 2013-04-19 20:05:10Z minghuai.wang@pnl.gov $ -module crmx_stat_clubb -#ifdef CLUBB_CRM - use crmx_grid, only: nx, ny, nz, nzm - implicit none - - public :: stats_clubb_update - -#ifdef CLUBB_LH - public stats_clubb_silhs_update -#endif - - public :: stats_end_timestep_clubb, stats_init_clubb -#ifndef CRM - public :: hbuf_stats_init_clubb -#endif - - ! Output arrays for CLUBB statistics - real, allocatable, dimension(:,:,:,:) :: out_zt, out_zm, out_rad_zt, out_rad_zm, & - out_sfc, out_LH_zt, out_LH_sfc - - private - - contains -!--------------------------------------------------------------------------------------------------- - subroutine stats_clubb_update( upwp, vpwp, up2, vp2, wprtp, wpthlp, & - wp2, wp3, rtp2, thlp2, rtpthlp, cloud_frac, rcm, um, vm, t_tndcy, & - qc_tndcy, qv_tndcy,u_tndcy,v_tndcy ) - -! Description: -! Update statistics for CLUBB variables -! -! References: -! None -!--------------------------------------------------------------------------------------------------- - use crmx_grid, only: nx, ny, nzm, nz, dimx1_s, dimx2_s, dimy1_s, dimy2_s - -#ifndef CRM - use hbuffer, only: hbuf_put, hbuf_avg_put -#endif - - ! Modules from CLUBB - use crmx_clubb_precision, only: core_rknd ! Constant - - use crmx_interpolation, only: lin_int ! Procedure(s) - - use crmx_grid_class, only: gr - - use crmx_clubbvars, only: tndcy_precision, l_stats_samgrid - - implicit none - - real(kind=core_rknd), dimension(nx, ny, nz), intent(in) :: & - upwp, &! u'w' [m^2/s^2] - vpwp, &! u'w' [m^2/s^2] - up2, &! u'^2 [m^2/s^2] - vp2, &! v'^2 [m^2/s^2] - wprtp, &! w' r_t' [(m kg)/(s kg)] - wpthlp, &! w' th_l' [(m K)/s] - wp2, &! w'^2 [m^2/s^2] - rtp2, &! r_t'^2 [(kg/kg)^2] - thlp2, &! th_l'^2 [K^2] - rtpthlp, &! r_t' th_l' [(kg K)/kg] - cloud_frac, &! Cloud Fraction [-] - rcm ! Cloud water [kg/kg] - - ! w'^3 is requires additional ghost points on the x and y dimension - real(kind=core_rknd), dimension(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nz), intent(in) :: & - wp3,& ! w'^3 [m^3/s^3] - um, & ! x-wind [m/s] - vm ! y-wind [m/s] - - real(tndcy_precision), dimension(nx, ny, nzm), intent(in) :: & - t_tndcy, & ! CLUBB contribution to moist static energy [K/s] - qc_tndcy, & ! CLUBB contribution to liquid water [kg/kg/s] - qv_tndcy, & ! CLUBB contribution to vapor water [kg/kg/s] - u_tndcy, & ! CLUBB contribution to x-wind [m/s^2] - v_tndcy ! CLUBB contribution to y-wind [m/s^2] - - ! Local variables - real, dimension(nzm) :: & - upwp_avg, & - vpwp_avg, & - up2_avg, & - vp2_avg, & - wprtp_avg, & - wpthlp_avg, & - wp2_avg, & - thlp2_avg, & - rtp2_avg, & - rtpthlp_avg,& - sigma_sqd_w_avg, & - Kh_zt_avg, & - tau_zm_avg - - real :: factor_xy - - integer :: i, j, k - - !--------------------------------------------------------- - ! CLUBB variables - ! Notes: The variables located on the vertical velocity levels - ! must be interpolated for the stats grid, which is on the pressure levels. - ! -dschanen 21 Jul 2008 - factor_xy = 1. / real( nx*ny ) - - upwp_avg = 0.0 - vpwp_avg = 0.0 - vp2_avg = 0.0 - up2_avg = 0.0 - wprtp_avg = 0.0 - wpthlp_avg = 0.0 - wp2_avg = 0.0 - - thlp2_avg = 0.0 - rtp2_avg = 0.0 - rtpthlp_avg = 0.0 - - ! Here we omit the ghost point, since the SAM stats don't have one - do i = 1, nx - do j = 1, ny - do k = 1, nzm - upwp_avg(k) = upwp_avg(k) & - + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), upwp(i,j,k+1), upwp(i,j,k) ) - vpwp_avg(k) = vpwp_avg(k) & - + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), vpwp(i,j,k+1), vpwp(i,j,k) ) - vp2_avg(k) = vp2_avg(k) & - + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), vp2(i,j,k+1), vp2(i,j,k) ) - up2_avg(k) = up2_avg(k) & - + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), up2(i,j,k+1), up2(i,j,k) ) - wprtp_avg(k) = wprtp_avg(k) & - + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), wprtp(i,j,k+1), wprtp(i,j,k) ) - wpthlp_avg(k) = wpthlp_avg(k) & - + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), wpthlp(i,j,k+1), wpthlp(i,j,k) ) - wp2_avg(k) = wp2_avg(k) & - + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), wp2(i,j,k+1), wp2(i,j,k) ) - rtp2_avg(k) = rtp2_avg(k) & - + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), rtp2(i,j,k+1), rtp2(i,j,k) ) - thlp2_avg(k) = thlp2_avg(k) & - + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), thlp2(i,j,k+1), thlp2(i,j,k) ) - rtpthlp_avg(k) = rtpthlp_avg(k) & - + lin_int( gr%zt(k+1), gr%zm(k+1), gr%zm(k), rtpthlp(i,j,k+1), rtpthlp(i,j,k) ) - end do ! k = 1..nzm - end do ! j = 1..ny - end do ! i = 1..nx - -#ifndef CRM - ! Velocity grid variables - call hbuf_put('UPWP', upwp_avg, factor_xy) - call hbuf_put('VPWP', vpwp_avg, factor_xy) - call hbuf_put('VP2', vp2_avg, factor_xy) - call hbuf_put('UP2', up2_avg, factor_xy) - call hbuf_put('WPRTP', wprtp_avg, factor_xy) - call hbuf_put('WPTHLP', wpthlp_avg, factor_xy) - call hbuf_put('WP2', wp2_avg, factor_xy) - call hbuf_put('RTP2', rtp2_avg, factor_xy) - call hbuf_put('THLP2', thlp2_avg, factor_xy) - call hbuf_put('RTPTHLP', rtpthlp_avg, factor_xy) - - ! CLUBB thermodynamic grid varibles (SAM pressure levels + ghost point) - call hbuf_avg_put('CLD_FRAC', real( cloud_frac(1:nx,1:ny,2:nz) ), 1,nx, 1,ny, nzm, 1.) - call hbuf_avg_put('RCM', real( rcm(1:nx,1:ny,2:nz) ), 1,nx, 1,ny, nzm, 1.) - call hbuf_avg_put('UM', real( um(1:nx,1:ny,2:nz) ), 1,nx, 1,ny, nzm, 1.) - call hbuf_avg_put('VM', real( vm(1:nx,1:ny,2:nz) ), 1,nx, 1,ny, nzm, 1.) - call hbuf_avg_put('WP3', real( wp3(1:nx,1:ny,2:nz) ), 1,nx, 1,ny, nzm, 1.) - - ! CLUBB tendency of state variables - call hbuf_avg_put('T_TNDCY', real(t_tndcy(1:nx,1:ny,1:nzm)), 1,nx, 1,ny, nzm, 1.) - call hbuf_avg_put('QC_TNDCY', real(qc_tndcy(1:nx,1:ny,1:nzm)), 1,nx, 1,ny, nzm, 1.) - call hbuf_avg_put('QV_TNDCY', real(qv_tndcy(1:nx,1:ny,1:nzm)), 1,nx, 1,ny, nzm, 1.) - call hbuf_avg_put('U_TNDCY', real(U_tndcy(1:nx,1:ny,1:nzm)), 1,nx, 1,ny, nzm, 1.) - call hbuf_avg_put('V_TNDCY', real(V_tndcy(1:nx,1:ny,1:nzm)), 1,nx, 1,ny, nzm, 1.) - - if(l_stats_samgrid) then !output clubb statistics in SAM - call hbuf_clubb_output () - end if -#endif - - return - end subroutine stats_clubb_update - -#ifdef CLUBB_LH -!--------------------------------------------------------------------------------------------------- - subroutine stats_clubb_silhs_update( ) - -! Description: -! Update statistics for CLUBB SILHS variables -! -! References: -! None -!--------------------------------------------------------------------------------------------------- - use crmx_grid, only: nx, ny, nzm, nz - - use hbuffer, only: hbuf_put, hbuf_avg_put - - use crmx_microphysics, only: & - nmicro_fields, mkname, index_water_vapor - - ! Modules from CLUBB - use crmx_clubb_precision, only: core_rknd ! Constant - - use crmx_interpolation, only: lin_int ! Procedure(s) - - use crmx_grid_class, only: gr - - use crmx_clubb_silhs_vars, only: & - LH_rt, LH_t, X_nl_all_levs, LH_sample_point_weights, LH_t_avg_tndcy, & - LH_micro_field_avg_tndcy - - use latin_hypercube_arrays, only: & - d_variables - - use crmx_parameters_microphys, only: & - LH_microphys_calls - - use crmx_corr_matrix_module, only: & - iiLH_s_mellor, iiLH_w, & - iiLH_rrain, iiLH_rsnow, iiLH_rice, & - iiLH_Nr, iiLH_Nsnow, iiLH_Ni, iiLH_Nc - - use crmx_array_index, only: & - iirrainm, iiNrm, iirsnowm, iiricem, & ! Variables - iiNcm, iiNsnowm, iiNim - - implicit none - - ! Local Variables - real, dimension(nx,ny,nzm) :: & - LH_rt_weighted, & - LH_t_weighted - - real, dimension(nx,ny,nzm,d_variables) :: & - X_nl_all_levs_weighted - - character(len=8) :: stat_name - integer :: indx, ivar, k - - ! ---- Begin Code ---- - - ! Determine cloud weighted sample averages - LH_rt_weighted = 0. - LH_t_weighted = 0. - X_nl_all_levs_weighted = 0. - - do indx = 1, LH_microphys_calls - do k = 1, nzm - LH_rt_weighted(:,:,k) = LH_rt_weighted(:,:,k) & - + LH_rt(:,:,k,indx) * LH_sample_point_weights(:,:,indx) - LH_t_weighted(:,:,k) = LH_t_weighted(:,:,k) & - + LH_t(:,:,k,indx) * LH_sample_point_weights(:,:,indx) - - do ivar = 1, d_variables - X_nl_all_levs_weighted(:,:,k,ivar) = X_nl_all_levs_weighted(:,:,k,ivar) & - + X_nl_all_levs(:,:,k,indx,ivar) * LH_sample_point_weights(:,:,indx) - end do - - end do ! k = 1..nzm - end do ! indx = 1..LH_microphys_calls - - LH_rt_weighted = LH_rt_weighted / real( LH_microphys_calls ) - LH_t_weighted = LH_t_weighted / real( LH_microphys_calls ) - X_nl_all_levs_weighted = X_nl_all_levs_weighted / real( LH_microphys_calls ) - - call hbuf_avg_put( 'LH_RT', LH_rt_weighted, 1,nx, 1,ny, nzm, 1. ) - call hbuf_avg_put( 'LH_TL', LH_t_weighted, 1,nx, 1,ny, nzm, 1. ) - - do ivar = 1, d_variables - if ( ivar == iiLH_s_mellor ) then - stat_name = "LH_S_MEL" - else if ( ivar == iiLH_w ) then - stat_name = "LH_W" - else if ( ivar == iiLH_rrain ) then - stat_name = "LH_RRAIN" - else if ( ivar == iiLH_rsnow ) then - stat_name = "LH_RSNOW" - else if ( ivar == iiLH_rice ) then - stat_name = "LH_RICE" - else if ( ivar == iiLH_Nr ) then - stat_name = "LH_NR" - else if ( ivar == iiLH_Nsnow ) then - stat_name = "LH_NSNOW" - else if ( ivar == iiLH_Ni ) then - stat_name = "LH_NI" - else if ( ivar == iiLH_Nc ) then - stat_name = "LH_NC" - end if ! ivar - - call hbuf_avg_put( stat_name, X_nl_all_levs_weighted(:,:,:,ivar), 1,nx, 1,ny, nzm, 1. ) - end do - - ! Tendency averages - - call hbuf_avg_put( 'LH_TL_MC', real( LH_t_avg_tndcy ), & - 1,nx, 1,ny, nzm, 1. ) - - do ivar = 1, nmicro_fields - if ( ivar == index_water_vapor ) then - stat_name = 'LH_RT_MC' - else if ( ivar == iirrainm ) then - stat_name = 'LH_RR_MC' - else if ( ivar == iirsnowm ) then - stat_name = 'LH_RS_MC' - else if ( ivar == iiricem ) then - stat_name = 'LH_RI_MC' - else if ( ivar == iiNim ) then - stat_name = 'LH_NI_MC' - else if ( ivar == iiNrm ) then - stat_name = 'LH_NR_MC' - else if ( ivar == iiNsnowm ) then - stat_name = 'LH_NS_MC' - else - stat_name = '' - end if - if ( stat_name /= '' ) then - call hbuf_avg_put( stat_name, & - real( LH_micro_field_avg_tndcy(:,:,:,ivar) ), & - 1,nx, 1,ny, nzm, 1. ) - end if - end do - - return - end subroutine stats_clubb_silhs_update -#endif /* CLUBB_LH */ - -subroutine stats_init_clubb( l_stats_in, l_output_rad_files_in, stats_tsamp_in, stats_tout_in, & - nzmax, nnrad_zt,nnrad_zm, time_current, delt ) - ! - ! Description: Initializes the statistics saving functionality of - ! the CLUBB model. This is for purpose of SAM-CLUBB interface. Here - ! the traditional stats_init of CLUBB is not called, as it is not compatible - ! with SAM output. This is adopted from clubb_intr.F90 in CAM5.2. - - !----------------------------------------------------------------------- - - - use crmx_stats_variables, only: & - zt, & ! Variables - ztscr01, & - ztscr02, & - ztscr03, & - ztscr04, & - ztscr05, & - ztscr06, & - ztscr07, & - ztscr08, & - ztscr09, & - ztscr10, & - ztscr11, & - ztscr12, & - ztscr13, & - ztscr14, & - ztscr15, & - ztscr16, & - ztscr17, & - ztscr18, & - ztscr19, & - ztscr20, & - ztscr21 - - use crmx_stats_variables, only: & - LH_zt, & ! Variable(s) - LH_sfc - - use crmx_stats_variables, only: & - zm, & ! Variables - zmscr01, & - zmscr02, & - zmscr03, & - zmscr04, & - zmscr05, & - zmscr06, & - zmscr07, & - zmscr08, & - zmscr09, & - zmscr10, & - zmscr11, & - zmscr12, & - zmscr13, & - zmscr14, & - zmscr15, & - zmscr16, & - zmscr17, & - rad_zt - - use crmx_stats_variables, only: & - rad_zm, & - sfc, & - l_stats, & - l_output_rad_files, & - stats_tsamp, & - stats_tout, & - l_stats_samp, & - l_stats_last, & - fname_rad_zt, & - fname_rad_zm, & - fname_sfc, & - l_netcdf, & - l_grads - - use crmx_clubb_precision, only: & - time_precision, & ! Constant(s) - core_rknd - - use crmx_stats_zm, only: & - nvarmax_zm, & ! Constant(s) - stats_init_zm ! Procedure(s) - - use crmx_stats_zt, only: & - nvarmax_zt, & ! Constant(s) - stats_init_zt ! Procedure(s) - - use crmx_stats_LH_zt, only: & - nvarmax_LH_zt, & ! Constant(s) - stats_init_LH_zt ! Procedure(s) - - use crmx_stats_LH_sfc, only: & - nvarmax_LH_sfc, & ! Constant(s) - stats_init_LH_sfc ! Procedure(s) - - use crmx_stats_rad_zt, only: & - nvarmax_rad_zt, & ! Constant(s) - stats_init_rad_zt ! Procedure(s) - - use crmx_stats_rad_zm, only: & - nvarmax_rad_zm, & ! Constant(s) - stats_init_rad_zm ! Procedure(s) - - use crmx_stats_sfc, only: & - nvarmax_sfc, & ! Constant(s) - stats_init_sfc ! Procedure(s) - - use crmx_error_code, only: & - clubb_at_least_debug_level ! Function - - use crmx_constants_clubb, only: & - fstdout, fstderr, var_length ! Constants - - use crmx_parameters_microphys, only: & - LH_microphys_disabled, & ! Constant - LH_microphys_type ! Variable - - implicit none - - ! Input Variables - - logical, intent(in) :: l_stats_in ! Stats on? T/F - - logical, intent(in) :: l_output_rad_files_in ! Rad Stats on? T/F - - real(kind=time_precision), intent(in) :: & - stats_tsamp_in, & ! Sampling interval [s] - stats_tout_in ! Output interval [s] - - integer, intent(in) :: nzmax ! Grid points in the vertical [count] - integer, intent(in) :: nnrad_zt ! Grid points in the radiation grid [count] - integer, intent(in) :: nnrad_zm ! Grid points in the radiation grid [count] - - real(kind=time_precision), intent(in) :: & - time_current ! Model time [s] - - real(kind=time_precision), intent(in) :: & - delt ! Timestep (dt_main in CLUBB) [s] - - - ! Local Variables - - ! Namelist Variables - - character(len=var_length), dimension(nvarmax_zt) :: & - clubb_vars_zt ! Variables on the thermodynamic levels - - character(len=var_length), dimension(nvarmax_LH_zt) :: & - clubb_vars_LH_zt ! Latin Hypercube variables on the thermodynamic levels - - character(len=var_length), dimension(nvarmax_LH_sfc) :: & - clubb_vars_LH_sfc ! Latin Hypercube variables at the surface - - character(len=var_length), dimension(nvarmax_zm) :: & - clubb_vars_zm ! Variables on the momentum levels - - character(len=var_length), dimension(nvarmax_rad_zt) :: & - clubb_vars_rad_zt ! Variables on the radiation levels - - character(len=var_length), dimension(nvarmax_rad_zm) :: & - clubb_vars_rad_zm ! Variables on the radiation levels - - character(len=var_length), dimension(nvarmax_sfc) :: & - clubb_vars_sfc ! Variables at the model surface - - namelist /clubb_stats_nl/ & - clubb_vars_zt, & - clubb_vars_zm, & - clubb_vars_LH_zt, & - clubb_vars_LH_sfc, & - clubb_vars_rad_zt, & - clubb_vars_rad_zm, & - clubb_vars_sfc - - ! Local Variables - - logical :: l_error - - character(len=200) :: fname, temp1, sub - - integer :: i, ntot, read_status - integer :: iunit - - ! Initialize - l_error = .false. - - ! Set stats_variables variables with inputs from calling subroutine - l_stats = l_stats_in - - l_output_rad_files = l_output_rad_files_in - - stats_tsamp = stats_tsamp_in - stats_tout = stats_tout_in - - if ( .not. l_stats ) then - l_stats_samp = .false. - l_stats_last = .false. - return - end if - - ! Initialize namelist variables - - clubb_vars_zt = '' - clubb_vars_zm = '' - clubb_vars_LH_zt = '' - clubb_vars_LH_sfc = '' - clubb_vars_rad_zt = '' - clubb_vars_rad_zm = '' - clubb_vars_sfc = '' - - ! Read variables to compute from the namelist - ! in SAM, namelist is read on every MPI task, so no need for mpibcast -! if (masterproc) then - iunit= 55 - open(unit=iunit,file="clubb_stats_sam") - read(unit=iunit, nml=clubb_stats_nl, iostat=read_status) - if (read_status /= 0) then - stop 'stats_init_clubb: error reading namelist' - end if - close(unit=iunit) -! end if - -!#ifdef SPMD - ! Broadcast namelist variables -! call mpibcast(clubb_vars_zt, var_length*nvarmax_zt, mpichar, 0, mpicom) -! call mpibcast(clubb_vars_zm, var_length*nvarmax_zm, mpichar, 0, mpicom) -! call mpibcast(clubb_vars_LH_zt, var_length*nvarmax_LH_zt, mpichar, 0, mpicom) -! call mpibcast(clubb_vars_LH_sfc, var_length*nvarmax_LH_sfc, mpichar, 0, mpicom) -! call mpibcast(clubb_vars_rad_zt, var_length*nvarmax_rad_zt, mpichar, 0, mpicom) -! call mpibcast(clubb_vars_rad_zm, var_length*nvarmax_rad_zm, mpichar, 0, mpicom) -! call mpibcast(clubb_vars_sfc, var_length*nvarmax_sfc, mpichar, 0, mpicom) -!#endif - - ! Hardcode these for use in SAM-CLUBB, don't want either - l_netcdf = .false. - l_grads = .false. - - ! Check sampling and output frequencies - - ! The model time step length, delt (which is dtmain), should multiply - ! evenly into the statistical sampling time step length, stats_tsamp. - if ( abs( stats_tsamp/delt - real(floor(stats_tsamp/delt), kind=time_precision ) ) & - > 1.e-8_time_precision ) then - l_error = .true. ! This will cause the run to stop. - write(fstderr,*) 'Error: stats_tsamp should be an even multiple of ', & - 'delt (which is dtmain). Check the appropriate ', & - 'model.in file.' - write(fstderr,*) 'stats_tsamp = ', stats_tsamp - write(fstderr,*) 'delt = ', delt - endif - - ! Initialize zt (mass points) - - i = 1 - do while ( ichar(clubb_vars_zt(i)(1:1)) /= 0 & - .and. len_trim(clubb_vars_zt(i)) /= 0 & - .and. i <= nvarmax_zt ) - i = i + 1 - write(2001, *) 'i=', i-1, ' clubb_vars_zt ', trim(clubb_vars_zt(i)) - enddo - ntot = i - 1 - if ( ntot == nvarmax_zt ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_zt than allowed for by nvarmax_zt." - write(fstderr,*) "Check the number of variables listed for clubb_vars_zt ", & - "in the stats namelist, or change nvarmax_zt." - write(fstderr,*) "nvarmax_zt = ", nvarmax_zt - stop "stats_init_clubb: number of zt statistical variables exceeds limit" - endif - - zt%nn = ntot - zt%kk = nzmax - - allocate( zt%z( zt%kk ) ) - - allocate( zt%x( 1, 1, zt%kk, zt%nn ) ) - allocate( zt%n( 1, 1, zt%kk, zt%nn ) ) - allocate( zt%l_in_update( 1, 1, zt%kk, zt%nn ) ) - call stats_zero( zt%kk, zt%nn, zt%x, zt%n, zt%l_in_update ) - - allocate( zt%f%var( zt%nn ) ) - allocate( zt%f%z( zt%kk ) ) - - ! Allocate scratch space - - allocate( ztscr01(zt%kk) ) - allocate( ztscr02(zt%kk) ) - allocate( ztscr03(zt%kk) ) - allocate( ztscr04(zt%kk) ) - allocate( ztscr05(zt%kk) ) - allocate( ztscr06(zt%kk) ) - allocate( ztscr07(zt%kk) ) - allocate( ztscr08(zt%kk) ) - allocate( ztscr09(zt%kk) ) - allocate( ztscr10(zt%kk) ) - allocate( ztscr11(zt%kk) ) - allocate( ztscr12(zt%kk) ) - allocate( ztscr13(zt%kk) ) - allocate( ztscr14(zt%kk) ) - allocate( ztscr15(zt%kk) ) - allocate( ztscr16(zt%kk) ) - allocate( ztscr17(zt%kk) ) - allocate( ztscr18(zt%kk) ) - allocate( ztscr19(zt%kk) ) - allocate( ztscr20(zt%kk) ) - allocate( ztscr21(zt%kk) ) - - ztscr01 = 0.0_core_rknd - ztscr02 = 0.0_core_rknd - ztscr03 = 0.0_core_rknd - ztscr04 = 0.0_core_rknd - ztscr05 = 0.0_core_rknd - ztscr06 = 0.0_core_rknd - ztscr07 = 0.0_core_rknd - ztscr08 = 0.0_core_rknd - ztscr09 = 0.0_core_rknd - ztscr10 = 0.0_core_rknd - ztscr11 = 0.0_core_rknd - ztscr12 = 0.0_core_rknd - ztscr13 = 0.0_core_rknd - ztscr14 = 0.0_core_rknd - ztscr15 = 0.0_core_rknd - ztscr16 = 0.0_core_rknd - ztscr17 = 0.0_core_rknd - ztscr18 = 0.0_core_rknd - ztscr19 = 0.0_core_rknd - ztscr20 = 0.0_core_rknd - ztscr21 = 0.0_core_rknd - - ! Default initialization for array indices for zt - - call stats_init_zt( clubb_vars_zt, l_error ) - - ! Setup output file for LH_zt (Latin Hypercube stats) - - if ( LH_microphys_type /= LH_microphys_disabled ) then - - i = 1 - do while ( ichar(clubb_vars_LH_zt(i)(1:1)) /= 0 & - .and. len_trim(clubb_vars_LH_zt(i)) /= 0 & - .and. i <= nvarmax_LH_zt ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_LH_zt ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "vars_zt than allowed for by nvarmax_LH_zt." - write(fstderr,*) "Check the number of variables listed for clubb_vars_LH_zt ", & - "in the stats namelist, or change nvarmax_LH_zt." - write(fstderr,*) "nvarmax_LH_zt = ", nvarmax_LH_zt - stop "stats_init: number of LH_zt statistical variables exceeds limit" - end if - - LH_zt%nn = ntot - LH_zt%kk = nzmax - - allocate( LH_zt%z( LH_zt%kk ) ) -! LH_zt%z = gzt - - allocate( LH_zt%x( 1, 1, LH_zt%kk, LH_zt%nn ) ) - allocate( LH_zt%n( 1, 1, LH_zt%kk, LH_zt%nn ) ) - allocate( LH_zt%l_in_update( 1, 1, LH_zt%kk, LH_zt%nn ) ) - call stats_zero( LH_zt%kk, LH_zt%nn, LH_zt%x, LH_zt%n, LH_zt%l_in_update ) - - allocate( LH_zt%f%var( LH_zt%nn ) ) - allocate( LH_zt%f%z( LH_zt%kk ) ) - - call stats_init_LH_zt( clubb_vars_LH_zt, l_error ) - - i = 1 - do while ( ichar(clubb_vars_LH_sfc(i)(1:1)) /= 0 & - .and. len_trim(clubb_vars_LH_sfc(i)) /= 0 & - .and. i <= nvarmax_LH_sfc ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_LH_sfc ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "vars_zt than allowed for by nvarmax_LH_sfc." - write(fstderr,*) "Check the number of variables listed for clubb_vars_LH_sfc ", & - "in the stats namelist, or change nvarmax_LH_sfc." - write(fstderr,*) "nvarmax_LH_sfc = ", nvarmax_LH_sfc - stop "stats_init: number of LH_sfc statistical variables exceeds limit" - end if - - LH_sfc%nn = ntot - LH_sfc%kk = 1 - - allocate( LH_sfc%z( LH_sfc%kk ) ) - - allocate( LH_sfc%x( 1, 1, LH_sfc%kk, LH_sfc%nn ) ) - allocate( LH_sfc%n( 1, 1, LH_sfc%kk, LH_sfc%nn ) ) - allocate( LH_sfc%l_in_update( 1, 1, LH_sfc%kk, LH_sfc%nn ) ) - - call stats_zero( LH_sfc%kk, LH_sfc%nn, LH_sfc%x, LH_sfc%n, LH_sfc%l_in_update ) - - allocate( LH_sfc%f%var( LH_sfc%nn ) ) - allocate( LH_sfc%f%z( LH_sfc%kk ) ) - - call stats_init_LH_sfc( clubb_vars_LH_sfc, l_error ) - - end if ! LH_microphys_type /= LH_microphys_disabled - - ! Initialize zm (momentum points) - - i = 1 - do while ( ichar(clubb_vars_zm(i)(1:1)) /= 0 & - .and. len_trim(clubb_vars_zm(i)) /= 0 & - .and. i <= nvarmax_zm ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_zm ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_zm than allowed for by nvarmax_zm." - write(fstderr,*) "Check the number of variables listed for clubb_vars_zm ", & - "in the stats namelist, or change nvarmax_zm." - write(fstderr,*) "nvarmax_zm = ", nvarmax_zm - stop "stats_init_clubb: number of zm statistical variables exceeds limit" - endif - - zm%nn = ntot - zm%kk = nzmax - - allocate( zm%z( zm%kk ) ) - - allocate( zm%x( 1, 1, zm%kk, zm%nn ) ) - allocate( zm%n( 1, 1, zm%kk, zm%nn ) ) - allocate( zm%l_in_update( 1, 1, zm%kk, zm%nn ) ) - - call stats_zero( zm%kk, zm%nn, zm%x, zm%n, zm%l_in_update ) - - allocate( zm%f%var( zm%nn ) ) - allocate( zm%f%z( zm%kk ) ) - - ! Allocate scratch space - - allocate( zmscr01(zm%kk) ) - allocate( zmscr02(zm%kk) ) - allocate( zmscr03(zm%kk) ) - allocate( zmscr04(zm%kk) ) - allocate( zmscr05(zm%kk) ) - allocate( zmscr06(zm%kk) ) - allocate( zmscr07(zm%kk) ) - allocate( zmscr08(zm%kk) ) - allocate( zmscr09(zm%kk) ) - allocate( zmscr10(zm%kk) ) - allocate( zmscr11(zm%kk) ) - allocate( zmscr12(zm%kk) ) - allocate( zmscr13(zm%kk) ) - allocate( zmscr14(zm%kk) ) - allocate( zmscr15(zm%kk) ) - allocate( zmscr16(zm%kk) ) - allocate( zmscr17(zm%kk) ) - - ! Initialize to 0 - zmscr01 = 0.0_core_rknd - zmscr02 = 0.0_core_rknd - zmscr03 = 0.0_core_rknd - zmscr04 = 0.0_core_rknd - zmscr05 = 0.0_core_rknd - zmscr06 = 0.0_core_rknd - zmscr07 = 0.0_core_rknd - zmscr08 = 0.0_core_rknd - zmscr09 = 0.0_core_rknd - zmscr10 = 0.0_core_rknd - zmscr11 = 0.0_core_rknd - zmscr12 = 0.0_core_rknd - zmscr13 = 0.0_core_rknd - zmscr14 = 0.0_core_rknd - zmscr15 = 0.0_core_rknd - zmscr16 = 0.0_core_rknd - zmscr17 = 0.0_core_rknd - - call stats_init_zm( clubb_vars_zm, l_error ) - - ! Initialize rad_zt (radiation points) - - if (l_output_rad_files) then - - i = 1 - do while ( ichar(clubb_vars_rad_zt(i)(1:1)) /= 0 & - .and. len_trim(clubb_vars_rad_zt(i)) /= 0 & - .and. i <= nvarmax_rad_zt ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_rad_zt ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_rad_zt than allowed for by nvarmax_rad_zt." - write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zt ", & - "in the stats namelist, or change nvarmax_rad_zt." - write(fstderr,*) "nvarmax_rad_zt = ", nvarmax_rad_zt - stop "stats_init_clubb: number of rad_zt statistical variables exceeds limit" - endif - - rad_zt%nn = ntot - rad_zt%kk = nnrad_zt - - allocate( rad_zt%z( rad_zt%kk ) ) - - allocate( rad_zt%x( 1, 1, rad_zt%kk, rad_zt%nn ) ) - allocate( rad_zt%n( 1, 1, rad_zt%kk, rad_zt%nn ) ) - allocate( rad_zt%l_in_update( 1, 1, rad_zt%kk, rad_zt%nn ) ) - - call stats_zero( rad_zt%kk, rad_zt%nn, rad_zt%x, rad_zt%n, rad_zt%l_in_update ) - - allocate( rad_zt%f%var( rad_zt%nn ) ) - allocate( rad_zt%f%z( rad_zt%kk ) ) - - - call stats_init_rad_zt( clubb_vars_rad_zt, l_error ) - - ! Initialize rad_zm (radiation points) - - i = 1 - do while ( ichar(clubb_vars_rad_zm(i)(1:1)) /= 0 & - .and. len_trim(clubb_vars_rad_zm(i)) /= 0 & - .and. i <= nvarmax_rad_zm ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_rad_zm ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_rad_zm than allowed for by nvarmax_rad_zm." - write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zm ", & - "in the stats namelist, or change nvarmax_rad_zm." - write(fstderr,*) "nvarmax_rad_zm = ", nvarmax_rad_zm - stop "stats_init_clubb: number of rad_zm statistical variables exceeds limit" - endif - - rad_zm%nn = ntot - rad_zm%kk = nnrad_zm - - allocate( rad_zm%z( rad_zm%kk ) ) - - allocate( rad_zm%x( 1, 1, rad_zm%kk, rad_zm%nn ) ) - allocate( rad_zm%n( 1, 1, rad_zm%kk, rad_zm%nn ) ) - allocate( rad_zm%l_in_update( 1, 1, rad_zm%kk, rad_zm%nn ) ) - - call stats_zero( rad_zm%kk, rad_zm%nn, rad_zm%x, rad_zm%n, rad_zm%l_in_update ) - - allocate( rad_zm%f%var( rad_zm%nn ) ) - allocate( rad_zm%f%z( rad_zm%kk ) ) - - - call stats_init_rad_zm( clubb_vars_rad_zm, l_error ) - end if ! l_output_rad_files - - - ! Initialize sfc (surface point) - - i = 1 - do while ( ichar(clubb_vars_sfc(i)(1:1)) /= 0 & - .and. len_trim(clubb_vars_sfc(i)) /= 0 & - .and. i <= nvarmax_sfc ) - i = i + 1 - end do - ntot = i - 1 - if ( ntot == nvarmax_sfc ) then - write(fstderr,*) "There are more statistical variables listed in ", & - "clubb_vars_sfc than allowed for by nvarmax_sfc." - write(fstderr,*) "Check the number of variables listed for clubb_vars_sfc ", & - "in the stats namelist, or change nvarmax_sfc." - write(fstderr,*) "nvarmax_sfc = ", nvarmax_sfc - stop "stats_init_clubb: number of sfc statistical variables exceeds limit" - endif - - sfc%nn = ntot - sfc%kk = 1 - - allocate( sfc%z( sfc%kk ) ) - - allocate( sfc%x( 1, 1, sfc%kk, sfc%nn ) ) - allocate( sfc%n( 1, 1, sfc%kk, sfc%nn ) ) - allocate( sfc%l_in_update( 1, 1, sfc%kk, sfc%nn ) ) - - call stats_zero( sfc%kk, sfc%nn, sfc%x, sfc%n, sfc%l_in_update ) - - allocate( sfc%f%var( sfc%nn ) ) - allocate( sfc%f%z( sfc%kk ) ) - - call stats_init_sfc( clubb_vars_sfc, l_error ) - - ! Check for errors - - if ( l_error ) then - write(fstderr,*) 'stats_init: errors found' - stop - endif - - allocate(out_zt(nx, ny, nz, zt%nn)) - allocate(out_zm(nx, ny, nz, zm%nn)) - allocate(out_sfc(nx, ny, nz, sfc%nn)) - - if(l_output_rad_files) then - allocate(out_rad_zt(nx, ny, nz, rad_zt%nn)) - allocate(out_rad_zm(nx, ny, nz, rad_zm%nn)) - end if - - if(LH_microphys_type /= LH_microphys_disabled ) then - allocate(out_LH_zt(nx, ny, nz, LH_zt%nn)) - allocate(out_LH_sfc(nx, ny, nz, LH_sfc%nn)) - end if - - return - - end subroutine stats_init_clubb -!================================================================================== ! -! ! -!================================================================================== ! -#ifndef CRM - subroutine hbuf_stats_init_clubb(namelist,deflist,unitlist,status,average_type,count,clubbcount) - - use crmx_stats_variables, only: & - zt, LH_zt, zm, rad_zm, rad_zt, sfc, LH_sfc, l_output_rad_files - use crmx_parameters_microphys, only: & - LH_microphys_disabled, & ! Constant - LH_microphys_type ! Variable - - implicit none - - character(*) namelist(*), deflist(*), unitlist(*) - integer status(*),average_type(*),count, clubbcount, n, ii, jj, ncond - - character*8 name - character*80 longname - character*10 units - -! Local variables - integer :: i - character*100 temp1, sub - - clubbcount = 0 - -! Now call add fields - do i = 1, zt%nn - - temp1 = trim(zt%f%var(i)%name) - sub = temp1 -! if (len(temp1) > 16) sub = temp1(1:16) - -! call addfld(trim(sub),trim(zt%f%var(i)%units),nnzp,& -! 'A',trim(zt%f%var(i)%description),phys_decomp) - call add_to_namelist(count, clubbcount, trim(sub), trim(zt%f%var(i)%description), & - trim(zt%f%var(i)%units), 0) - enddo - - do i = 1, zm%nn - - temp1 = trim(zm%f%var(i)%name) - sub = temp1 -! if (len(temp1) > 16) sub = temp1(1:16) - -! call addfld(trim(sub),trim(zm%f%var(i)%units),nnzp,& -! 'A',trim(zm%f%var(i)%description),phys_decomp) - call add_to_namelist(count, clubbcount, trim(sub), trim(zm%f%var(i)%description), & - trim(zm%f%var(i)%units), 0) - enddo - - if (l_output_rad_files) then - do i = 1, rad_zt%nn -! call addfld(trim(rad_zt%f%var(i)%name),trim(rad_zt%f%var(i)%units),nnzp,& -! 'A',trim(rad_zt%f%var(i)%description),phys_decomp) - call add_to_namelist(count, clubbcount, trim(rad_zt%f%var(i)%name), & - trim(rad_zt%f%var(i)%description), trim(rad_zt%f%var(i)%units), 0) - enddo - - do i = 1, rad_zm%nn -! call addfld(trim(rad_zm%f%var(i)%name),trim(rad_zm%f%var(i)%units),nnzp,& -! 'A',trim(rad_zm%f%var(i)%description),phys_decomp) - call add_to_namelist(count, clubbcount, trim(rad_zm%f%var(i)%name), & - trim(rad_zm%f%var(i)%description), trim(rad_zm%f%var(i)%units), 0) - enddo - endif - - if ( LH_microphys_type /= LH_microphys_disabled ) then - do i=1, LH_zt%nn - call add_to_namelist(count, clubbcount, trim(LH_zt%f%var(i)%name), & - trim(LH_zt%f%var(i)%description), trim(LH_zt%f%var(i)%units), 0) - end do - do i=1, LH_sfc%nn - call add_to_namelist(count, clubbcount, trim(LH_sfc%f%var(i)%name), & - trim(LH_sfc%f%var(i)%description), trim(LH_sfc%f%var(i)%units), 0) - end do - endif - - do i = 1, sfc%nn - call add_to_namelist(count, clubbcount, trim(sfc%f%var(i)%name), & - trim(sfc%f%var(i)%description), trim(sfc%f%var(i)%units), 0) - enddo - - return - - end subroutine hbuf_stats_init_clubb - !================================================================================ - - subroutine hbuf_clubb_output() - - use crmx_stats_variables, only: & - zt, LH_zt, zm, rad_zm, rad_zt, sfc, LH_sfc, l_output_rad_files - use crmx_parameters_microphys, only: & - LH_microphys_disabled, & ! Constant - LH_microphys_type ! Variable - use hbuffer, only: hbuf_avg_put - - implicit none - - ! locale variables - integer :: i - character*100 temp1, sub - - do i = 1, zt%nn - call hbuf_avg_put(trim(zt%f%var(i)%name), out_zt(1:nx, 1:ny, 2:nz, i), 1, nx, 1, ny, nzm, 1.) - enddo - - do i = 1, zm%nn - !Velocity level. Here we just simplely put the last nz-1 onto the pressure level. - call hbuf_avg_put(trim(zm%f%var(i)%name), out_zm(1:nx, 1:ny, 1:(nz-1), i), & - 1, nx, 1, ny, nzm, 1.) - enddo - - if (l_output_rad_files) then - do i = 1, rad_zt%nn - call hbuf_avg_put(trim(rad_zt%f%var(i)%name), & - out_rad_zt(1:nx, 1:ny, 2:nz, i), 1, nx, 1, ny, nzm, 1.) - enddo - - do i = 1, rad_zm%nn - call hbuf_avg_put(trim(rad_zm%f%var(i)%name), & - out_rad_zm(1:nx, 1:ny, 1:(nz-1), i), 1, nx, 1, ny, nzm, 1.) - enddo - endif - - if ( LH_microphys_type /= LH_microphys_disabled ) then - do i=1, LH_zt%nn - call hbuf_avg_put(trim(LH_zt%f%var(i)%name), & - out_LH_zt(1:nx, 1:ny, 2:nz, i), 1, nx, 1, ny, nzm, 1.) - end do - - do i=1, LH_sfc%nn - ! For simplicity, hbuf_avg_put is also called for surface varialbes. - ! so zeroout values from level 2 to nz - out_LH_sfc(:, :, 2:nz, i) = 0.0 - call hbuf_avg_put(trim(LH_sfc%f%var(i)%name), & - out_LH_sfc(1:nx, 1:ny, 1:(nz-1), i), 1, nx, 1, ny, nzm, 1.) - end do - end if - - do i = 1, sfc%nn - ! For simplicity, hbuf_avg_put is also called for surface varialbes. - ! so zeroout values from level 2 to nz - out_sfc(:, :, 2:nz, i) = 0.0 - call hbuf_avg_put(trim(sfc%f%var(i)%name), & - out_sfc(1:nx, 1:ny, 1:(nz-1), i), 1, nx, 1, ny, nzm, 1.) - enddo - - return - - end subroutine hbuf_clubb_output -#endif /*CRM*/ - ! =============================================================================== ! - ! ! - ! =============================================================================== ! - - !----------------------------------------------------------------------- - subroutine stats_end_timestep_clubb(ix, jy) - - ! Description: Called when the stats timestep has ended. This subroutine - ! is responsible for calling statistics to be written to the output - ! format. - !----------------------------------------------------------------------- - - use crmx_constants_clubb, only: & - fstderr ! Constant(s) - - use crmx_stats_variables, only: & - zt, & ! Variable(s) - LH_zt, & - LH_sfc, & - zm, & - rad_zt, & - rad_zm, & - sfc, & - l_stats_last, & - stats_tsamp, & - stats_tout, & - l_output_rad_files - - use crmx_error_code, only: & - clubb_at_least_debug_level ! Procedure(s) - - use crmx_parameters_microphys, only: & - LH_microphys_disabled ! Constant - - use crmx_parameters_microphys, only: & - LH_microphys_type, & ! Variable(s) - LH_microphys_calls - - - implicit none - - - integer, intent(in) :: ix - integer, intent(in) :: jy - - ! Local Variables - - integer :: i, k - logical :: l_error - - ! ---- Begin Code ---- - - ! Check if it is time to write to file - - if ( .not. l_stats_last ) return - - ! Initialize - l_error = .false. - - ! Look for errors by checking the number of sampling points - ! for each variable in the zt statistics at each vertical level. - do i = 1, zt%nn - do k = 1, zt%kk - - if ( zt%n(1,1,k,i) /= 0 .and. & - zt%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(zt%f%var(i)%name), ' in zt ', & - 'at k = ', k, & - '; zt%n(',k,',',i,') = ', zt%n(1,1,k,i) - endif - - endif - - enddo - enddo - - ! Look for errors by checking the number of sampling points - ! for each variable in the zm statistics at each vertical level. - do i = 1, zm%nn - do k = 1, zm%kk - - if ( zm%n(1,1,k,i) /= 0 .and. & - zm%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(zm%f%var(i)%name), ' in zm ', & - 'at k = ', k, & - '; zm%n(',k,',',i,') = ', zm%n(1,1,k,i) - endif - - endif - - enddo - enddo - - if ( LH_microphys_type /= LH_microphys_disabled ) then - ! Look for errors by checking the number of sampling points - ! for each variable in the LH_zt statistics at each vertical level. - do i = 1, LH_zt%nn - do k = 1, LH_zt%kk - - if ( LH_zt%n(1,1,k,i) /= 0 .and. & - LH_zt%n(1,1,k,i) /= floor( stats_tout/stats_tsamp ) .and. & - LH_zt%n(1,1,k,i) /= LH_microphys_calls * floor( stats_tout/stats_tsamp ) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(LH_zt%f%var(i)%name), ' in LH_zt ', & - 'at k = ', k, & - '; LH_zt%n(',k,',',i,') = ', LH_zt%n(1,1,k,i) - end if ! clubb_at_lest_debug_level 1 - - end if ! n /= 0 and n /= LH_microphys_calls * stats_tout/stats_tsamp - - end do ! k = 1 .. LH_zt%kk - end do ! i = 1 .. LH_zt%nn - - ! Look for errors by checking the number of sampling points - ! for each variable in the LH_zt statistics at each vertical level. - do i = 1, LH_sfc%nn - do k = 1, LH_sfc%kk - - if ( LH_sfc%n(1,1,k,i) /= 0 .and. & - LH_sfc%n(1,1,k,i) /= floor( stats_tout/stats_tsamp ) .and. & - LH_sfc%n(1,1,k,i) /= LH_microphys_calls * floor( stats_tout/stats_tsamp ) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(LH_sfc%f%var(i)%name), ' in LH_sfc ', & - 'at k = ', k, & - '; LH_sfc%n(',k,',',i,') = ', LH_sfc%n(1,1,k,i) - end if ! clubb_at_lest_debug_level 1 - - end if ! n /= 0 and n /= LH_microphys_calls * stats_tout/stats_tsamp - - end do ! k = 1 .. LH_sfc%kk - end do ! i = 1 .. LH_sfc%nn - end if ! LH_microphys_type /= LH_microphys_disabled - - - if (l_output_rad_files) then - ! Look for errors by checking the number of sampling points - ! for each variable in the rad_zt statistics at each vertical level. - do i = 1, rad_zt%nn - do k = 1, rad_zt%kk - - if ( rad_zt%n(1,1,k,i) /= 0 .and. & - rad_zt%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(rad_zt%f%var(i)%name), ' in rad_zt ', & - 'at k = ', k, & - '; rad_zt%n(',k,',',i,') = ', rad_zt%n(1,1,k,i) - endif - - endif - - enddo - enddo - - ! Look for errors by checking the number of sampling points - ! for each variable in the rad_zm statistics at each vertical level. - do i = 1, rad_zm%nn - do k = 1, rad_zm%kk - - if ( rad_zm%n(1,1,k,i) /= 0 .and. & - rad_zm%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(rad_zm%f%var(i)%name), ' in rad_zm ', & - 'at k = ', k, & - '; rad_zm%n(',k,',',i,') = ', rad_zm%n(1,1,k,i) - endif - - endif - - enddo - enddo - end if ! l_output_rad_files - - ! Look for errors by checking the number of sampling points - ! for each variable in the sfc statistics at each vertical level. - do i = 1, sfc%nn - do k = 1, sfc%kk - - if ( sfc%n(1,1,k,i) /= 0 .and. & - sfc%n(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then - - l_error = .true. ! This will stop the run - - if ( clubb_at_least_debug_level( 1 ) ) then - write(fstderr,*) 'Possible sampling error for variable ', & - trim(sfc%f%var(i)%name), ' in sfc ', & - 'at k = ', k, & - '; sfc%n(',k,',',i,') = ', sfc%n(1,1,k,i) - endif - - endif - - enddo - enddo - - ! Stop the run if errors are found. - if ( l_error ) then - write(fstderr,*) 'Possible statistical sampling error' - write(fstderr,*) 'For details, set debug_level to a value of at ', & - 'least 1 in the appropriate model.in file.' - stop 'stats_end_timestep: error(s) found' - endif - - ! Compute averages - call stats_avg( zt%kk, zt%nn, zt%x, zt%n ) - call stats_avg( zm%kk, zm%nn, zm%x, zm%n ) - if ( LH_microphys_type /= LH_microphys_disabled ) then - call stats_avg( LH_zt%kk, LH_zt%nn, LH_zt%x, LH_zt%n ) - call stats_avg( LH_sfc%kk, LH_sfc%nn, LH_sfc%x, LH_sfc%n ) - end if - if ( l_output_rad_files ) then - call stats_avg( rad_zt%kk, rad_zt%nn, rad_zt%x, rad_zt%n ) - call stats_avg( rad_zm%kk, rad_zm%nn, rad_zm%x, rad_zm%n ) - end if - call stats_avg( sfc%kk, sfc%nn, sfc%x, sfc%n ) - - ! Here we are not outputting the data, rather reading the stats into - ! arrays which are conformable to CAM output. Also, the data is "flipped" - ! in the vertical level to be the same as CAM output. - do i = 1, zt%nn - do k = 1, zt%kk - out_zt(ix,jy,k,i) = zt%x(1,1,k,i) - if(out_zt(ix,jy,k,i) /= out_zt(ix,jy,k,i)) out_zt(ix,jy,k,i) = 0.0 - enddo - enddo - - do i = 1, zm%nn - do k = 1, zt%kk - out_zm(ix,jy,k,i) = zm%x(1,1,k,i) - if(out_zm(ix,jy,k,i) /= out_zm(ix,jy,k,i)) out_zm(ix,jy,k,i) = 0.0 - enddo - enddo - - if (l_output_rad_files) then - do i = 1, rad_zt%nn - do k = 1, rad_zt%kk - out_rad_zt(ix,jy,k,i) = rad_zt%x(1,1,k,i) - if(out_rad_zt(ix,jy,k,i) /= out_rad_zt(ix,jy,k,i)) out_rad_zt(ix,jy,k,i) = 0.0 - enddo - enddo - - do i = 1, rad_zm%nn - do k = 1, rad_zm%kk - out_rad_zm(ix,jy,k,i) = rad_zm%x(1,1,k,i) - if(out_rad_zm(ix,jy,k,i) /= out_rad_zm(ix,jy,k,i)) out_rad_zm(ix,jy,k,i) = 0.0 - enddo - enddo - endif - - if ( LH_microphys_type /= LH_microphys_disabled ) then - do i=1, LH_zt%nn - do k=1, LH_zt%kk - out_LH_zt(ix,jy,k,i) = LH_zt%x(1,1,k,i) - if(out_LH_zt(ix,jy,k,i) /= out_LH_zt(ix,jy,k,i)) out_LH_zt(ix,jy,k,i) = 0.0 - enddo - enddo - - out_LH_sfc(ix,jy,:,:) = 0.0 - do i=1, LH_sfc%nn - out_LH_sfc(ix,jy,1,i) = LH_sfc%x(1,1,1,i) - if(out_LH_sfc(ix,jy,1,i) /= out_LH_sfc(ix,jy,1,i)) out_LH_sfc(ix,jy,1,i) = 0.0 - end do - endif - - out_sfc(ix, jy, :, :) = 0.0 - do i = 1, sfc%nn - out_sfc(ix,jy,1,i) = sfc%x(1,1,1,i) - if(out_sfc(ix,jy,1,i) /= out_sfc(ix,jy,1,i)) out_sfc(ix,jy,1,i) = 0.0 - enddo - - ! Reset sample fields - call stats_zero( zt%kk, zt%nn, zt%x, zt%n, zt%l_in_update ) - call stats_zero( zm%kk, zm%nn, zm%x, zm%n, zm%l_in_update ) - if (l_output_rad_files) then - call stats_zero( rad_zt%kk, rad_zt%nn, rad_zt%x, rad_zt%n, rad_zt%l_in_update ) - call stats_zero( rad_zm%kk, rad_zm%nn, rad_zm%x, rad_zm%n, rad_zm%l_in_update ) - end if - if ( LH_microphys_type /= LH_microphys_disabled) then - call stats_zero( LH_zt%kk, LH_zt%nn, LH_zt%x, LH_zt%n, LH_zt%l_in_update ) - call stats_zero( LH_sfc%kk, LH_sfc%nn, LH_sfc%x, LH_sfc%n, LH_sfc%l_in_update ) - end if - call stats_zero( sfc%kk, sfc%nn, sfc%x, sfc%n, sfc%l_in_update ) - - return - - end subroutine stats_end_timestep_clubb - - ! =============================================================================== ! - ! ! - ! =============================================================================== ! - - !----------------------------------------------------------------------- - subroutine stats_zero( kk, nn, x, n, l_in_update ) - - ! Description: - ! Initialize stats to zero - !----------------------------------------------------------------------- - - use crmx_clubb_precision, only: & - stat_rknd, & ! Variable(s) - stat_nknd - - - implicit none - - ! Input - integer, intent(in) :: kk, nn - - ! Output - real(kind=stat_rknd), dimension(1,1,kk,nn), intent(out) :: x - integer(kind=stat_nknd), dimension(1,1,kk,nn), intent(out) :: n - logical, dimension(1,1,kk,nn), intent(out) :: l_in_update - - ! Zero out arrays - - if ( nn > 0 ) then - x(:,:,:,:) = 0.0_stat_rknd - n(:,:,:,:) = 0_stat_nknd - l_in_update(:,:,:,:) = .false. - end if - - return - - end subroutine stats_zero - - ! =============================================================================== ! - ! ! - ! =============================================================================== ! - - !----------------------------------------------------------------------- - subroutine stats_avg( kk, nn, x, n ) - - ! Description: - ! Compute the average of stats fields - !----------------------------------------------------------------------- - use crmx_clubb_precision, only: & - stat_rknd, & ! Variable(s) - stat_nknd - - implicit none - - ! Input - integer, intent(in) :: nn, kk - integer(kind=stat_nknd), dimension(1,1,kk,nn), intent(in) :: n - - ! Output - real(kind=stat_rknd), dimension(1,1,kk,nn), intent(inout) :: x - - ! Internal - - integer k,m - - ! Compute averages - - do m=1,nn - do k=1,kk - - if ( n(1,1,k,m) > 0 ) then - x(1,1,k,m) = x(1,1,k,m) / real( n(1,1,k,m), kind=stat_rknd ) - end if - - end do - end do - - return - - end subroutine stats_avg -#endif /* CLUBB_CRM*/ -end module crmx_stat_clubb diff --git a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_tke_full.F90 b/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_tke_full.F90 deleted file mode 100644 index 79dd936cdc..0000000000 --- a/src/physics/spcam/crm/SGS_CLUBBkvhkvm/crmx_tke_full.F90 +++ /dev/null @@ -1,147 +0,0 @@ - -subroutine tke_full - -! this subroutine solves the TKE equation - -use crmx_vars -use crmx_sgs -use crmx_params -implicit none - -real def2(nx,ny,nzm) -real grd,betdz,Ck,Ce,Ces,Ce1,Ce2,smix,Pr,Cee,Cs -real buoy_sgs,ratio,a_prod_sh,a_prod_bu,a_diss -real lstarn, lstarp, bbb, omn, omp -real qsatt,dqsat -integer i,j,k,kc,kb - -!call t_startf('tke_full') - -!Cs = 0.1944 -Cs = 0.15 -Ck=0.1 -Ce=Ck**3/Cs**4 -Ces=Ce/0.7*3.0 - -if(RUN3D) then - call shear_prod3D(def2) -else - call shear_prod2D(def2) -endif - -do k=1,nzm - kb=k-1 - kc=k+1 - - grd=dz*adz(k) - - betdz=bet(k)/dz/(adzw(kc)+adzw(k)) - Ce1=Ce/0.7*0.19 - Ce2=Ce/0.7*0.51 - if(k.eq.1) then - kb=1 - kc=2 - betdz=bet(k)/dz/adzw(kc) - Ce1=Ces/0.7*0.19 - Ce2=Ces/0.7*0.51 - end if - if(k.eq.nzm) then - kb=nzm-1 - kc=nzm - betdz=bet(k)/dz/adzw(k) - Ce1=Ces/0.7*0.19 - Ce2=Ces/0.7*0.51 - end if - tkelediss(k) = 0. - tkesbdiss(k) = 0. - tkesbshear(k)= 0. - tkesbbuoy(k) = 0. - do j=1,ny - do i=1,nx -! SGS buoyancy flux - -!bloss: removed temperature diagnostics for omn. -! - use mass weighted qsat, dqsat and latent heat for cloud -! - separate buoyancy contributions for precipitating water and ice. - - - if(qcl(i,j,k)+qci(i,j,k) .gt. 0.) then - - omn = qcl(i,j,k)/(qcl(i,j,k)+qci(i,j,k)+1.e-20) - lstarn = fac_cond+(1.-omn)*fac_fus - - dqsat = omn*dtqsatw_crm(tabs(i,j,k),pres(k))+ & - (1.-omn)*dtqsati_crm(tabs(i,j,k),pres(k)) - qsatt = omn*qsatw_crm(tabs(i,j,k),pres(k))+(1.-omn)*qsati_crm(tabs(i,j,k),pres(k)) - bbb = 1. + epsv*qsatt-qcl(i,j,k)-qci(i,j,k) -qpl(i,j,k)-qpi(i,j,k)+1.61*tabs(i,j,k)*dqsat - bbb = bbb / (1.+lstarn*dqsat) - buoy_sgs=betdz*(bbb*(t(i,j,kc)-t(i,j,kb)) & - +(bbb*lstarn - (1.+lstarn*dqsat)*tabs(i,j,k))* & - (qv(i,j,kc)+qcl(i,j,kc)+qci(i,j,kc)-qv(i,j,kb)-qcl(i,j,kb)-qci(i,j,kb)) & - + (bbb*fac_cond - (1.+fac_cond*dqsat)*tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & - + (bbb*fac_sub - (1.+fac_sub *dqsat)*tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) -!bloss +(bbb*lstarp - (1.+lstarp*dqsat)*tabs(i,j,k))* & -!bloss (qpl(i,j,kc)+qpi(i,j,kc)-qpl(i,j,kb)-qpi(i,j,kb)) ) - else - - bbb = 1.+epsv*qv(i,j,k)-qpl(i,j,k)-qpi(i,j,k) - buoy_sgs=betdz*( bbb*(t(i,j,kc)-t(i,j,kb)) & - +epsv*tabs(i,j,k)* & - (qv(i,j,kc)+qcl(i,j,kc)+qci(i,j,kc)-qv(i,j,kb)-qcl(i,j,kb)-qci(i,j,kb)) & - +(bbb*fac_cond-tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & - +(bbb*fac_sub -tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) -!bloss +(bbb*lstarp-tabs(i,j,k))* & -!bloss (qpl(i,j,kc)+qpi(i,j,kc)-qpl(i,j,kb)-qpi(i,j,kb)) ) - end if - - if(buoy_sgs.le.0.) then - smix=grd - else - smix=min(grd,max(0.1*grd, sqrt(0.76*tk(i,j,k)/Ck/sqrt(buoy_sgs+1.e-10)))) - end if - - - ratio=smix/grd - Pr=1. -! Pr=1. +2.*ratio - Cee=Ce1+Ce2*ratio - - if(dosmagor) then - - tk(i,j,k)=sqrt(Ck**3/Cee*max(0.,def2(i,j,k)-Pr*buoy_sgs))*smix**2 - tke(i,j,k) = (tk(i,j,k)/(Ck*smix))**2 - a_prod_sh=(tk(i,j,k)+0.001)*def2(i,j,k) - a_prod_bu=-(tk(i,j,k)+0.001)*Pr*buoy_sgs - a_diss=a_prod_sh+a_prod_bu - - else - - tke(i,j,k)=max(0.,tke(i,j,k)) - a_prod_sh=(tk(i,j,k)+0.001)*def2(i,j,k) - a_prod_bu=-(tk(i,j,k)+0.001)*Pr*buoy_sgs - a_diss=min(tke(i,j,k)/(4.*dt),Cee/smix*tke(i,j,k)**1.5) ! cap the diss rate (useful for large time steps - tke(i,j,k)=max(0.,tke(i,j,k)+dtn*(max(0.,a_prod_sh+a_prod_bu)-a_diss)) - tk(i,j,k)=Ck*smix*sqrt(tke(i,j,k)) - - end if - - tkh(i,j,k)=Pr*tk(i,j,k) - - tkelediss(k) = tkelediss(k) - a_prod_sh - tkesbdiss(k) = tkesbdiss(k) + a_diss - tkesbshear(k)= tkesbshear(k)+ a_prod_sh - tkesbbuoy(k) = tkesbbuoy(k) + a_prod_bu - - end do ! i - end do ! j - - tkelediss(k) = tkelediss(k)/float(nx*ny) - - -end do ! k - -!call t_stopf('tke_full') - -end - - diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom.F90 deleted file mode 100644 index 669f8f6e07..0000000000 --- a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom.F90 +++ /dev/null @@ -1,20 +0,0 @@ -subroutine diffuse_mom - -! Interface to the diffusion routines - -use crmx_vars -implicit none -integer i,j,k - -!call t_startf ('diffuse_mom') - -if(RUN3D) then - call diffuse_mom3D() -else - call diffuse_mom2D() -endif - -!call t_stopf ('diffuse_mom') - -end subroutine diffuse_mom - diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom2D.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom2D.F90 deleted file mode 100644 index d336f118b6..0000000000 --- a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom2D.F90 +++ /dev/null @@ -1,114 +0,0 @@ - -subroutine diffuse_mom2D - -! momentum tendency due to SGS diffusion - -use crmx_vars -use crmx_sgs, only: tk, grdf_x, grdf_z -use crmx_params, only: docolumn -implicit none - -real rdx2,rdz2,rdz,rdx25,rdz25,rdx21,rdx251 -real dxz,dzx - -integer i,j,k,ic,ib,kc,kcu -real tkx, tkz, rhoi, iadzw, iadz -real fu(0:nx,1,nz),fv(0:nx,1,nz),fw(0:nx,1,nz) - -rdx2=1./dx/dx -rdx25=0.25*rdx2 - -dxz=dx/dz - -j=1 - -if(.not.docolumn) then - - -do k=1,nzm - - kc=k+1 - kcu=min(kc,nzm) - dxz=dx/(dz*adzw(kc)) - rdx21=rdx2 * grdf_x(k) - rdx251=rdx25 * grdf_x(k) - - do i=0,nx - ic=i+1 - tkx=rdx21*tk(i,j,k) - fu(i,j,k)=-2.*tkx*(u(ic,j,k)-u(i,j,k)) - fv(i,j,k)=-tkx*(v(ic,j,k)-v(i,j,k)) - tkx=rdx251*(tk(i,j,k)+tk(ic,j,k)+tk(i,j,kcu)+tk(ic,j,kcu)) - fw(i,j,k)=-tkx*(w(ic,j,kc)-w(i,j,kc)+(u(ic,j,kcu)-u(ic,j,k))*dxz) - end do - do i=1,nx - ib=i-1 - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(ib,j,k)) - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(ib,j,k)) - dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(ib,j,k)) - end do - -end do - -end if - -!------------------------- -rdz=1./dz -dzx=dz/dx - -do k=1,nzm-1 - kc=k+1 - uwsb(kc)=0. - vwsb(kc)=0. - iadz = 1./adz(k) - iadzw= 1./adzw(kc) - rdz2=rdz*rdz *grdf_z(k) - rdz25=0.25*rdz2 - do i=1,nx - ib=i-1 - tkz=rdz2*tk(i,j,k) - fw(i,j,kc)=-2.*tkz*(w(i,j,kc)-w(i,j,k))*rho(k)*iadz - tkz=rdz25*(tk(i,j,k)+tk(ib,j,k)+tk(i,j,kc)+tk(ib,j,kc)) - fu(i,j,kc)=-tkz*( (u(i,j,kc)-u(i,j,k))*iadzw + & - (w(i,j,kc)-w(ib,j,kc))*dzx)*rhow(kc) - fv(i,j,kc)=-tkz*(v(i,j,kc)-v(i,j,k))*iadzw*rhow(kc) - uwsb(kc)=uwsb(kc)+fu(i,j,kc) - vwsb(kc)=vwsb(kc)+fv(i,j,kc) - end do -end do - -uwsb(1) = 0. -vwsb(1) = 0. - -do i=1,nx - tkz=rdz2*grdf_z(nzm)*tk(i,j,nzm) - fw(i,j,nz)=-2.*tkz*(w(i,j,nz)-w(i,j,nzm))/adz(nzm)*rho(nzm) - fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) - fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) - fu(i,j,nz)=fluxtu(i,j) * rdz * rhow(nz) - fv(i,j,nz)=fluxtv(i,j) * rdz * rhow(nz) - uwsb(1) = uwsb(1) + fu(i,j,1) - vwsb(1) = vwsb(1) + fv(i,j,1) -end do - - -do k=1,nzm - kc=k+1 - rhoi = 1./(rho(k)*adz(k)) - do i=1,nx - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi - end do -end do ! k - -do k=2,nzm - rhoi = 1./(rhow(k)*adzw(k)) - do i=1,nx - dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fw(i,j,k+1)-fw(i,j,k))*rhoi - end do -end do ! k - - -end subroutine diffuse_mom2D - - diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom3D.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom3D.F90 deleted file mode 100644 index 18df252162..0000000000 --- a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_mom3D.F90 +++ /dev/null @@ -1,150 +0,0 @@ - -subroutine diffuse_mom3D - -! momentum tendency due to SGS diffusion - -use crmx_vars -use crmx_sgs, only: tk, grdf_x, grdf_y, grdf_z -use crmx_params, only: docolumn -implicit none - -real rdx2,rdy2,rdz2,rdz,rdx25,rdy25 -real rdx21,rdy21,rdx251,rdy251,rdz25 -real dxy,dxz,dyx,dyz,dzx,dzy - -integer i,j,k,ic,ib,jb,jc,kc,kcu -real tkx, tky, tkz, rhoi, iadzw, iadz -real fu(0:nx,0:ny,nz),fv(0:nx,0:ny,nz),fw(0:nx,0:ny,nz) - -rdx2=1./(dx*dx) -rdy2=1./(dy*dy) - -rdx25=0.25*rdx2 -rdy25=0.25*rdy2 - -dxy=dx/dy -dxz=dx/dz -dyx=dy/dx -dyz=dy/dz - - -do k=1,nzm - kc=k+1 - kcu=min(kc,nzm) - dxz=dx/(dz*adzw(kc)) - dyz=dy/(dz*adzw(kc)) - rdx21=rdx2 * grdf_x(k) - rdy21=rdy2 * grdf_y(k) - rdx251=rdx25 * grdf_x(k) - rdy251=rdy25 * grdf_y(k) - do j=1,ny - jb=j-1 - do i=0,nx - ic=i+1 - tkx=rdx21*tk(i,j,k) - fu(i,j,k)=-2.*tkx*(u(ic,j,k)-u(i,j,k)) - tkx=rdx251*(tk(i,j,k)+tk(i,jb,k)+tk(ic,j,k)+tk(ic,jb,k)) - fv(i,j,k)=-tkx*(v(ic,j,k)-v(i,j,k)+(u(ic,j,k)-u(ic,jb,k))*dxy) - tkx=rdx251*(tk(i,j,k)+tk(ic,j,k)+tk(i,j,kcu)+tk(ic,j,kcu)) - fw(i,j,k)=-tkx*(w(ic,j,kc)-w(i,j,kc)+(u(ic,j,kcu)-u(ic,j,k))*dxz) - end do - do i=1,nx - ib=i-1 - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(ib,j,k)) - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(ib,j,k)) - dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(ib,j,k)) - end do - end do - - do j=0,ny - jc=j+1 - do i=1,nx - ib=i-1 - tky=rdy21*tk(i,j,k) - fv(i,j,k)=-2.*tky*(v(i,jc,k)-v(i,j,k)) - tky=rdy251*(tk(i,j,k)+tk(ib,j,k)+tk(i,jc,k)+tk(ib,jc,k)) - fu(i,j,k)=-tky*(u(i,jc,k)-u(i,j,k)+(v(i,jc,k)-v(ib,jc,k))*dyx) - tky=rdy251*(tk(i,j,k)+tk(i,jc,k)+tk(i,j,kcu)+tk(i,jc,kcu)) - fw(i,j,k)=-tky*(w(i,jc,kc)-w(i,j,kc)+(v(i,jc,kcu)-v(i,jc,k))*dyz) - end do - end do - do j=1,ny - jb=j-1 - do i=1,nx - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,k)-fu(i,jb,k)) - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,k)-fv(i,jb,k)) - dwdt(i,j,kc,na)=dwdt(i,j,kc,na)-(fw(i,j,k)-fw(i,jb,k)) - end do - end do - -end do - -!------------------------- -rdz=1./dz -dzx=dz/dx -dzy=dz/dy - -do k=1,nzm-1 - kc=k+1 - uwsb(kc)=0. - vwsb(kc)=0. - iadz = 1./adz(k) - iadzw= 1./adzw(kc) - rdz2 = rdz*rdz * grdf_z(k) - rdz25 = 0.25*rdz2 - do j=1,ny - jb=j-1 - do i=1,nx - ib=i-1 - tkz=rdz2*tk(i,j,k) - fw(i,j,kc)=-2.*tkz*(w(i,j,kc)-w(i,j,k))*rho(k)*iadz - tkz=rdz25*(tk(i,j,k)+tk(ib,j,k)+tk(i,j,kc)+tk(ib,j,kc)) - fu(i,j,kc)=-tkz*( (u(i,j,kc)-u(i,j,k))*iadzw + & - (w(i,j,kc)-w(ib,j,kc))*dzx)*rhow(kc) - tkz=rdz25*(tk(i,j,k)+tk(i,jb,k)+tk(i,j,kc)+tk(i,jb,kc)) - fv(i,j,kc)=-tkz*( (v(i,j,kc)-v(i,j,k))*iadzw + & - (w(i,j,kc)-w(i,jb,kc))*dzy)*rhow(kc) - uwsb(kc)=uwsb(kc)+fu(i,j,kc) - vwsb(kc)=vwsb(kc)+fv(i,j,kc) - end do - end do -end do - -uwsb(1) = 0. -vwsb(1) = 0. - -do j=1,ny - do i=1,nx - tkz=rdz2*grdf_z(nzm)*tk(i,j,nzm) - fw(i,j,nz)=-2.*tkz*(w(i,j,nz)-w(i,j,nzm))/adz(nzm)*rho(nzm) - fu(i,j,1)=fluxbu(i,j) * rdz * rhow(1) - fv(i,j,1)=fluxbv(i,j) * rdz * rhow(1) - fu(i,j,nz)=fluxtu(i,j) * rdz * rhow(nz) - fv(i,j,nz)=fluxtv(i,j) * rdz * rhow(nz) - uwsb(1) = uwsb(1) + fu(i,j,1) - vwsb(1) = vwsb(1) + fv(i,j,1) - end do - end do - - do k=1,nzm - kc=k+1 - rhoi = 1./(rho(k)*adz(k)) - do j=1,ny - do i=1,nx - dudt(i,j,k,na)=dudt(i,j,k,na)-(fu(i,j,kc)-fu(i,j,k))*rhoi - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fv(i,j,kc)-fv(i,j,k))*rhoi - end do - end do - end do ! k - - do k=2,nzm - rhoi = 1./(rhow(k)*adzw(k)) - do j=1,ny - do i=1,nx - dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fw(i,j,k+1)-fw(i,j,k))*rhoi - end do - end do - end do ! k - - -end subroutine diffuse_mom3D diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar.F90 deleted file mode 100644 index a5b48d4fd8..0000000000 --- a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar.F90 +++ /dev/null @@ -1,42 +0,0 @@ -subroutine diffuse_scalar (f,fluxb,fluxt, & - fdiff,flux,f2lediff,f2lediss,fwlediff,doit) - -use crmx_grid -use crmx_vars, only: rho, rhow -use crmx_sgs, only: tkh -implicit none - -! input: -real f(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real fluxb(nx,ny) ! bottom flux -real fluxt(nx,ny) ! top flux -real flux(nz) -real f2lediff(nz),f2lediss(nz),fwlediff(nz) -real fdiff(nz) -logical doit -! Local -real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -integer i,j,k - -!call t_startf ('diffuse_scalars') - -df(:,:,:) = f(:,:,:) - -if(RUN3D) then - call diffuse_scalar3D (f,fluxb,fluxt,tkh,rho,rhow,flux) -else - call diffuse_scalar2D (f,fluxb,fluxt,tkh,rho,rhow,flux) -endif - -do k=1,nzm - fdiff(k)=0. - do j=1,ny - do i=1,nx - fdiff(k)=fdiff(k)+f(i,j,k)-df(i,j,k) - end do - end do -end do - -!call t_stopf ('diffuse_scalars') - -end subroutine diffuse_scalar diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar2D.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar2D.F90 deleted file mode 100644 index d8ff8f7587..0000000000 --- a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar2D.F90 +++ /dev/null @@ -1,103 +0,0 @@ -subroutine diffuse_scalar2D (field,fluxb,fluxt,tkh,rho,rhow,flux) - -use crmx_grid -use crmx_params, only: docolumn,dowallx,dosgs -use crmx_sgs,only: grdf_x,grdf_z -implicit none - -! input -real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real tkh(0:nxp1, 1-YES3D:nyp1, nzm) ! eddy conductivity -real fluxb(nx,ny) ! bottom flux -real fluxt(nx,ny) ! top flux -real rho(nzm) -real rhow(nz) -real flux(nz) - -! local -real flx(0:nx,1,0:nzm) -real dfdt(nx,ny,nzm) -real rdx2,rdz2,rdz,rdx5,rdz5,tmp -real dxz,dzx,tkx,tkz,rhoi -integer i,j,k,ib,ic,kc,kb - -if(.not.dosgs.and..not.docolumn) return - -rdx2=1./(dx*dx) -rdz2=1./(dz*dz) -rdz=1./dz -dxz=dx/dz -dzx=dz/dx - -j=1 - -dfdt(:,:,:)=0. - -if(dowallx) then - - if(mod(rank,nsubdomains_x).eq.0) then - do k=1,nzm - field(0,j,k) = field(1,j,k) - end do - end if - if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then - do k=1,nzm - field(nx+1,j,k) = field(nx,j,k) - end do - end if - -end if - - -if(.not.docolumn) then - - -do k=1,nzm - - rdx5=0.5*rdx2 *grdf_x(k) - - do i=0,nx - ic=i+1 - tkx=rdx5*(tkh(i,j,k)+tkh(ic,j,k)) - flx(i,j,k)=-tkx*(field(ic,j,k)-field(i,j,k)) - end do - do i=1,nx - ib=i-1 - dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(ib,j,k)) - end do - -end do - -end if - -flux(1) = 0. -tmp=1./adzw(nz) -do i=1,nx - flx(i,j,0)=fluxb(i,j)*rdz*rhow(1) - flx(i,j,nzm)=fluxt(i,j)*rdz*tmp*rhow(nz) - flux(1) = flux(1) + flx(i,j,0) -end do - - -do k=1,nzm-1 - kc=k+1 - flux(kc)=0. - rhoi = rhow(kc)/adzw(kc) - rdz5=0.5*rdz2 * grdf_z(k) - do i=1,nx - tkz=rdz5*(tkh(i,j,k)+tkh(i,j,kc)) - flx(i,j,k)=-tkz*(field(i,j,kc)-field(i,j,k))*rhoi - flux(kc) = flux(kc) + flx(i,j,k) - end do -end do - -do k=1,nzm - kb=k-1 - rhoi = 1./(adz(k)*rho(k)) - do i=1,nx - dfdt(i,j,k)=dtn*(dfdt(i,j,k)-(flx(i,j,k)-flx(i,j,kb))*rhoi) - field(i,j,k)=field(i,j,k) + dfdt(i,j,k) - end do -end do - -end subroutine diffuse_scalar2D diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar3D.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar3D.F90 deleted file mode 100644 index f166ee61ea..0000000000 --- a/src/physics/spcam/crm/SGS_TKE/crmx_diffuse_scalar3D.F90 +++ /dev/null @@ -1,177 +0,0 @@ -subroutine diffuse_scalar3D (field,fluxb,fluxt,tkh,rho,rhow,flux) - -use crmx_grid -use crmx_params, only: docolumn,dowallx,dowally,dosgs -use crmx_sgs, only: grdf_x,grdf_y,grdf_z -implicit none -! input -real field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! scalar -real tkh(0:nxp1,1-YES3D:nyp1,nzm) ! eddy conductivity -real fluxb(nx,ny) ! bottom flux -real fluxt(nx,ny) ! top flux -real rho(nzm) -real rhow(nz) -real flux(nz) -! local -real flx(0:nx,0:ny,0:nzm) -real dfdt(nx,ny,nz) -real rdx2,rdy2,rdz2,rdz,rdx5,rdy5,rdz5,tmp -real dxy,dxz,dyx,dyz,dzx,dzy,tkx,tky,tkz,rhoi -integer i,j,k,ib,ic,jb,jc,kc,kb - - -if(.not.dosgs) return - -rdx2=1./(dx*dx) -rdy2=1./(dy*dy) -rdz2=1./(dz*dz) -rdz=1./dz -dxy=dx/dy -dxz=dx/dz -dyx=dy/dx -dyz=dy/dz -dzx=dz/dx -dzy=dz/dy - -dfdt(:,:,:)=0. - -!----------------------------------------- -if(dowallx) then - - if(mod(rank,nsubdomains_x).eq.0) then - do k=1,nzm - do j=1,ny - field(0,j,k) = field(1,j,k) - end do - end do - end if - if(mod(rank,nsubdomains_x).eq.nsubdomains_x-1) then - do k=1,nzm - do j=1,ny - field(nx+1,j,k) = field(nx,j,k) - end do - end do - end if - -end if - -if(dowally) then - - if(rank.lt.nsubdomains_x) then - do k=1,nzm - do i=1,nx - field(i,1-YES3D,k) = field(i,1,k) - end do - end do - end if - if(rank.gt.nsubdomains-nsubdomains_x-1) then - do k=1,nzm - do i=1,ny - field(i,ny+YES3D,k) = field(i,ny,k) - end do - end do - end if - -end if - - - -if(dowally) then - - call task_rank_to_index(rank, ib, jb) - if(jb.eq.0) then - do k=1,nzm - do i=1,nx - field(i,1-YES3D,k) = field(i,1,k) - end do - end do - end if - if(jb.eq.nsubdomains_y-1) then - do k=1,nzm - do i=1,nx - field(i,ny+YES3D,k) = field(i,ny,k) - end do - end do - end if - -end if - -!----------------------------------------- - - -! Horizontal diffusion: - - -do k=1,nzm - - rdx5=0.5*rdx2 * grdf_x(k) - rdy5=0.5*rdy2 * grdf_y(k) - - do j=1,ny - do i=0,nx - ic=i+1 - tkx=rdx5*(tkh(i,j,k)+tkh(ic,j,k)) - flx(i,j,k)=-tkx*(field(ic,j,k)-field(i,j,k)) - end do - do i=1,nx - ib=i-1 - dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(ib,j,k)) - end do - end do - - do j=0,ny - jc=j+1 - do i=1,nx - tky=rdy5*(tkh(i,j,k)+tkh(i,jc,k)) - flx(i,j,k)=-tky*(field(i,jc,k)-field(i,j,k)) - end do - end do - do j=1,ny - jb=j-1 - do i=1,nx - dfdt(i,j,k)=dfdt(i,j,k)-(flx(i,j,k)-flx(i,jb,k)) - end do - end do - -end do ! k - - -! Vertical diffusion: - -flux(1) = 0. -tmp=1./adzw(nz) -do j=1,ny - do i=1,nx - flx(i,j,0)=fluxb(i,j)*rdz*rhow(1) - flx(i,j,nzm)=fluxt(i,j)*rdz*tmp*rhow(nz) - flux(1) = flux(1) + flx(i,j,0) - end do -end do - - -do k=1,nzm-1 - kc=k+1 - flux(kc)=0. - rhoi = rhow(kc)/adzw(kc) - rdz5=0.5*rdz2 * grdf_z(k) - do j=1,ny - do i=1,nx - tkz=rdz5*(tkh(i,j,k)+tkh(i,j,kc)) - flx(i,j,k)=-tkz*(field(i,j,kc)-field(i,j,k))*rhoi - flux(kc) = flux(kc) + flx(i,j,k) - end do - end do -end do - -do k=1,nzm - kb=k-1 - rhoi = 1./(adz(k)*rho(k)) - do j=1,ny - do i=1,nx - dfdt(i,j,k)=dtn*(dfdt(i,j,k)-(flx(i,j,k)-flx(i,j,kb))*rhoi) - field(i,j,k)=field(i,j,k)+dfdt(i,j,k) - end do - end do -end do - -end subroutine diffuse_scalar3D diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_sgs.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_sgs.F90 deleted file mode 100644 index b252482838..0000000000 --- a/src/physics/spcam/crm/SGS_TKE/crmx_sgs.F90 +++ /dev/null @@ -1,422 +0,0 @@ -module crmx_sgs - -! module for original SAM subgrid-scale SGS closure (Smagorinsky or 1st-order TKE) -! Marat Khairoutdinov, 2012 - -use crmx_grid, only: nx,nxp1,ny,nyp1,YES3D,nzm,nz,dimx1_s,dimx2_s,dimy1_s,dimy2_s -use crmx_params, only: dosgs -use crmx_vars, only: tke2, tk2 -implicit none - -!---------------------------------------------------------------------- -! Required definitions: - -!!! prognostic scalar (need to be advected arround the grid): - -integer, parameter :: nsgs_fields = 1 ! total number of prognostic sgs vars - -real sgs_field(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm, nsgs_fields) - -!!! sgs diagnostic variables that need to exchange boundary information (via MPI): - -integer, parameter :: nsgs_fields_diag = 2 ! total number of diagnostic sgs vars - -! diagnostic fields' boundaries: -integer, parameter :: dimx1_d=0, dimx2_d=nxp1, dimy1_d=1-YES3D, dimy2_d=nyp1 - -real sgs_field_diag(dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm, nsgs_fields_diag) - -logical:: advect_sgs = .false. ! advect prognostics or not, default - not (Smagorinsky) -logical, parameter:: do_sgsdiag_bound = .true. ! exchange boundaries for diagnostics fields - -! SGS fields that output by default (if =1). -integer, parameter :: flag_sgs3Dout(nsgs_fields) = (/0/) -integer, parameter :: flag_sgsdiag3Dout(nsgs_fields_diag) = (/0,0/) - -real fluxbsgs (nx, ny, 1:nsgs_fields) ! surface fluxes -real fluxtsgs (nx, ny, 1:nsgs_fields) ! top boundary fluxes - -!!! these arrays may be needed for output statistics: - -real sgswle(nz,1:nsgs_fields) ! resolved vertical flux -real sgswsb(nz,1:nsgs_fields) ! SGS vertical flux -real sgsadv(nz,1:nsgs_fields) ! tendency due to vertical advection -real sgslsadv(nz,1:nsgs_fields) ! tendency due to large-scale vertical advection -real sgsdiff(nz,1:nsgs_fields) ! tendency due to vertical diffusion - -!------------------------------------------------------------------ -! internal (optional) definitions: - -! make aliases for prognostic variables: - -real tke(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! SGS TKE -equivalence (tke(dimx1_s,dimy1_s,1),sgs_field(dimx1_s,dimy1_s,1,1)) - -! make aliases for diagnostic variables: - -real tk (dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm) ! SGS eddy viscosity -real tkh (dimx1_d:dimx2_d, dimy1_d:dimy2_d, nzm) ! SGS eddy conductivity -equivalence (tk(dimx1_d,dimy1_d,1), sgs_field_diag(dimx1_d, dimy1_d,1,1)) -equivalence (tkh(dimx1_d,dimy1_d,1), sgs_field_diag(dimx1_d, dimy1_d,1,2)) - - -real grdf_x(nzm)! grid factor for eddy diffusion in x -real grdf_y(nzm)! grid factor for eddy diffusion in y -real grdf_z(nzm)! grid factor for eddy diffusion in z - -logical:: dosmagor ! if true, then use Smagorinsky closure - -! Local diagnostics: - -real tkesbbuoy(nz), tkesbshear(nz),tkesbdiss(nz), tkesbdiff(nz) - -CONTAINS - -! required microphysics subroutines and function: -!---------------------------------------------------------------------- -!!! Read microphysics options from prm (namelist) file - -subroutine sgs_setparm() - - use crmx_grid, only: case - implicit none - - integer ierr, ios, ios_missing_namelist, place_holder - - !====================================================================== - NAMELIST /SGS_TKE/ & - dosmagor ! Diagnostic Smagorinsky closure - - NAMELIST /BNCUIODSBJCB/ place_holder - - dosmagor = .true. ! default - - !---------------------------------- - ! Read namelist for microphysics options from prm file: - !------------ - !open(55,file='./'//trim(case)//'/prm', status='old',form='formatted') - - !read (UNIT=55,NML=BNCUIODSBJCB,IOSTAT=ios_missing_namelist) - !rewind(55) !note that one must rewind before searching for new namelists - - !read (55,SGS_TKE,IOSTAT=ios) - - advect_sgs = .not.dosmagor - - !if (ios.ne.0) then - ! !namelist error checking - ! if(ios.ne.ios_missing_namelist) then - ! write(*,*) '****** ERROR: bad specification in SGS_TKE namelist' - ! call task_abort() - ! end if - !end if - !close(55) - - ! END UW ADDITION - !====================================================================== - -end subroutine sgs_setparm - -!---------------------------------------------------------------------- -!!! Initialize sgs: - - -subroutine sgs_init() - - use crmx_grid, only: nrestart, dx, dy, dz, adz, masterproc - use crmx_params, only: LES - integer k - - if(nrestart.eq.0) then - - sgs_field = 0. - sgs_field_diag = 0. - - fluxbsgs = 0. - fluxtsgs = 0. - - end if - -! if(masterproc) then -! if(dosmagor) then -! write(*,*) 'Smagorinsky SGS Closure' -! else -! write(*,*) 'Prognostic TKE 1.5-order SGS Closure' -! end if -! end if - - if(LES) then - do k=1,nzm - grdf_x(k) = dx**2/(adz(k)*dz)**2 - grdf_y(k) = dy**2/(adz(k)*dz)**2 - grdf_z(k) = 1. - end do - else - do k=1,nzm - grdf_x(k) = min(16.,dx**2/(adz(k)*dz)**2) - grdf_y(k) = min(16.,dy**2/(adz(k)*dz)**2) - grdf_z(k) = 1. - end do - end if - - sgswle = 0. - sgswsb = 0. - sgsadv = 0. - sgsdiff = 0. - sgslsadv = 0. - - -end subroutine sgs_init - -!---------------------------------------------------------------------- -!!! make some initial noise in sgs: -! -subroutine setperturb_sgs(ptype) - -use crmx_vars, only: q0, z -integer, intent(in) :: ptype -integer i,j,k - -select case (ptype) - - case(0) - - do k=1,nzm - do j=1,ny - do i=1,nx - if(k.le.4.and..not.dosmagor) then - tke(i,j,k)=0.04*(5-k) - endif - end do - end do - end do - - case(1) - - do k=1,nzm - do j=1,ny - do i=1,nx - if(q0(k).gt.6.e-3.and..not.dosmagor) then - tke(i,j,k)=1. - endif - end do - end do - end do - - case(2) - - case(3) ! gcss wg1 smoke-cloud case - - do k=1,nzm - do j=1,ny - do i=1,nx - if(q0(k).gt.0.5e-3.and..not.dosmagor) then - tke(i,j,k)=1. - endif - end do - end do - end do - - - case(4) ! gcss wg1 arm case - - do k=1,nzm - do j=1,ny - do i=1,nx - if(z(k).le.150..and..not.dosmagor) then - tke(i,j,k)=0.15*(1.-z(k)/150.) - endif - end do - end do - end do - - - case(5) ! gcss wg1 BOMEX case - - do k=1,nzm - do j=1,ny - do i=1,nx - if(z(k).le.3000..and..not.dosmagor) then - tke(i,j,k)=1.-z(k)/3000. - endif - end do - end do - end do - - case(6) ! GCSS Lagragngian ASTEX - - - do k=1,nzm - do j=1,ny - do i=1,nx - if(q0(k).gt.6.e-3.and..not.dosmagor) then - tke(i,j,k)=1. - endif - end do - end do - end do - - - case default - -end select - -end subroutine setperturb_sgs - -!---------------------------------------------------------------------- -!!! Estimate Courant number limit for SGS -! - -subroutine kurant_sgs(cfl) - -use crmx_grid, only: dt, dx, dy, dz, adz, adzw -implicit none - -real, intent(out) :: cfl - -integer k -real tkhmax(nz) - -do k = 1,nzm - tkhmax(k) = maxval(tkh(1:nx,1:ny,k)) -end do - -cfl = 0. -do k=1,nzm - cfl = max(cfl, & - 0.5*tkhmax(k)*grdf_z(k)*dt/(dz*adzw(k))**2, & - 0.5*tkhmax(k)*grdf_x(k)*dt/dx**2, & - YES3D*0.5*tkhmax(k)*grdf_y(k)*dt/dy**2) -end do - -end subroutine kurant_sgs - - -!---------------------------------------------------------------------- -!!! compute sgs diffusion of momentum: -! -subroutine sgs_mom() - - call diffuse_mom() - -end subroutine sgs_mom - -!---------------------------------------------------------------------- -!!! compute sgs diffusion of scalars: -! -subroutine sgs_scalars() - - use crmx_vars - use crmx_microphysics - use crmx_crmtracers - use crmx_params, only: dotracers - implicit none - - real dummy(nz) - real fluxbtmp(nx,ny), fluxttmp(nx,ny) !bloss - integer k - - - call diffuse_scalar(t,fluxbt,fluxtt,tdiff,twsb, & - t2lediff,t2lediss,twlediff,.true.) - - if(advect_sgs) then - call diffuse_scalar(tke,fzero,fzero,dummy,sgswsb, & - dummy,dummy,dummy,.false.) - end if - - -! -! diffusion of microphysics prognostics: -! - call micro_flux() - - total_water_evap = total_water_evap - total_water() - - do k = 1,nmicro_fields - if( k.eq.index_water_vapor &! transport water-vapor variable no metter what - .or. docloud.and.flag_precip(k).ne.1 & ! transport non-precipitation vars - .or. doprecip.and.flag_precip(k).eq.1 ) then - fluxbtmp(1:nx,1:ny) = fluxbmk(1:nx,1:ny,k) - fluxttmp(1:nx,1:ny) = fluxtmk(1:nx,1:ny,k) - call diffuse_scalar(micro_field(:,:,:,k),fluxbtmp,fluxttmp, & - mkdiff(:,k),mkwsb(:,k), dummy,dummy,dummy,.false.) - end if - end do - - total_water_evap = total_water_evap + total_water() - - ! diffusion of tracers: - - if(dotracers) then - - call tracers_flux() - - do k = 1,ntracers - - fluxbtmp = fluxbtr(:,:,k) - fluxttmp = fluxttr(:,:,k) - call diffuse_scalar(tracer(:,:,:,k),fluxbtmp,fluxttmp, & - trdiff(:,k),trwsb(:,k), & - dummy,dummy,dummy,.false.) -!!$ call diffuse_scalar(tracer(:,:,:,k),fluxbtr(:,:,k),fluxttr(:,:,k),trdiff(:,k),trwsb(:,k), & -!!$ dummy,dummy,dummy,.false.) - - end do - - end if - - - -end subroutine sgs_scalars - -!---------------------------------------------------------------------- -!!! compute sgs processes (beyond advection): -! -subroutine sgs_proc() - - use crmx_grid, only: nstep,dt,icycle - use crmx_params, only: dosmoke - -! SGS TKE equation: - - if(dosgs) call tke_full() - - tke2 = tke - tk2 = tk - -end subroutine sgs_proc - -!---------------------------------------------------------------------- -!!! Diagnose arrays nessesary for dynamical core and statistics: -! -subroutine sgs_diagnose() -! None - -end subroutine sgs_diagnose - -!---------------------------------------------------------------------- -! called when stepout() called - -subroutine sgs_print() - - call fminmax_print('tke:',tke,dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm) - call fminmax_print('tk:',tk,0,nxp1,1-YES3D,nyp1,nzm) - call fminmax_print('tkh:',tkh,0,nxp1,1-YES3D,nyp1,nzm) - -end subroutine sgs_print - -!---------------------------------------------------------------------- -!!! Initialize the list of sgs statistics -! -subroutine sgs_hbuf_init(namelist,deflist,unitlist,status,average_type,count,sgscount) -character(*) namelist(*), deflist(*), unitlist(*) -integer status(*),average_type(*),count,sgscount - -end subroutine sgs_hbuf_init - - -end module crmx_sgs - - - diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod2D.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod2D.F90 deleted file mode 100644 index 50fe343ebe..0000000000 --- a/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod2D.F90 +++ /dev/null @@ -1,109 +0,0 @@ - -subroutine shear_prod2D(def2) - -use crmx_vars -implicit none - -real def2(nx,ny,nzm) - -real rdx0,rdx,rdx_up,rdx_dn -real rdz,rdzw_up,rdzw_dn -integer i,j,k,ib,ic,kb,kc - -rdx0=1./dx -j=1 - - -do k=2,nzm-1 - - kb=k-1 - kc=k+1 - rdz = 1./(dz*adz(k)) - rdzw_up = 1./(dz*adzw(kc)) - rdzw_dn = 1./(dz*adzw(k)) - rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy - rdx_up=rdx0 * sqrt(dx*rdzw_up) - rdx_dn=rdx0 * sqrt(dx*rdzw_dn) - - do i=1,nx - ib=i-1 - ic=i+1 - - def2(i,j,k)=2.* ( & - ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & - ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & - + 0.5 * ( & - ( (v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & - ( (v(i ,j ,k)-v(ib,j ,k))*rdx )**2 + & - ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & - (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & - ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & - (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 + & - ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & - (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & - ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & - (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 + & - ( (v(i,j ,kc)-v0(kc)-v(i,j , k)+v0(k))*rdzw_up )**2 + & - ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn )**2 ) - - end do -end do ! k - - -k=1 -kc=k+1 - -rdz = 1./(dz*adz(k)) -rdzw_up = 1./(dz*adzw(kc)) -rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy -rdx_up=rdx0 * sqrt(dx*rdzw_up) - -do i=1,nx - ib=i-1 - ic=i+1 - - def2(i,j,k)=2.* ( & - ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & - ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & - + 0.5 * ( & - ( (v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & - ( (v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & - +( (v(i,j ,kc)-v0(kc)-v(i,j,k)+v0(k))*rdzw_up )**2 & - + 0.5 * ( & - ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & - (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & - ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & - (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 ) -end do - -k=nzm -kc=k+1 -kb=k-1 - -rdz = 1./(dz*adz(k)) -rdzw_dn = 1./(dz*adzw(k)) -rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy -rdx_dn=rdx0 * sqrt(dx*rdzw_dn) - - -do i=1,nx - ib=i-1 - ic=i+1 - - def2(i,j,k)=2.* ( & - ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & - ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & - + 0.5 * ( & - ( (v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & - ( (v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & - + ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn )**2 & - + 0.5 * ( & - ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & - (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & - ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & - (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 ) - -end do - -end - diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod3D.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod3D.F90 deleted file mode 100644 index 2ecd9c25a6..0000000000 --- a/src/physics/spcam/crm/SGS_TKE/crmx_shear_prod3D.F90 +++ /dev/null @@ -1,155 +0,0 @@ - -subroutine shear_prod3D(def2) - -use crmx_vars -implicit none - -real def2(nx,ny,nzm) - -real rdx0,rdx,rdx_up,rdx_dn -real rdy0,rdy,rdy_up,rdy_dn -real rdz,rdzw_up,rdzw_dn -integer i,j,k,ib,ic,jb,jc,kb,kc - -rdx0=1./dx -rdy0=1./dy - -do k=2,nzm-1 - - kb=k-1 - kc=k+1 - rdz = 1./(dz*adz(k)) - rdzw_up = 1./(dz*adzw(kc)) - rdzw_dn = 1./(dz*adzw(k)) - rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy - rdy=rdy0 * sqrt(dy*rdz) - rdx_up=rdx0 * sqrt(dx*rdzw_up) - rdy_up=rdy0 * sqrt(dy*rdzw_up) - rdx_dn=rdx0 * sqrt(dx*rdzw_dn) - rdy_dn=rdy0 * sqrt(dy*rdzw_dn) - - do j=1,ny - jb=j-YES3D - jc=j+YES3D - do i=1,nx - ib=i-1 - ic=i+1 - - def2(i,j,k)=2.* ( & - ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & - ( (v(i,jc,k)-v(i,j,k))*rdy)**2+ & - ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & - + 0.25 * ( & - ( (u(ic,jc,k)-u(ic,j ,k))*rdy+(v(ic,jc,k)-v(i ,jc,k))*rdx )**2 + & - ( (u(i ,jc,k)-u(i ,j ,k))*rdy+(v(i ,jc,k)-v(ib,jc,k))*rdx )**2 + & - ( (u(ic,j ,k)-u(ic,jb,k))*rdy+(v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & - ( (u(i ,j ,k)-u(i ,jb,k))*rdy+(v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) - def2(i,j,k)=def2(i,j,k) & - + 0.25 * ( & - ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & - (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & - ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & - (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 + & - ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & - (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & - ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & - (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 ) - def2(i,j,k)=def2(i,j,k) & - + 0.25 * ( & - ( (v(i,jc,kc)-v0(kc)-v(i,jc, k)+v0(k))*rdzw_up+ & - (w(i,jc,kc)-w(i,j ,kc))*rdy_up )**2 + & - ( (v(i,j ,kc)-v0(kc)-v(i,j , k)+v0(k))*rdzw_up+ & - (w(i,j ,kc)-w(i,jb,kc))*rdy_up )**2 + & - ( (v(i,jc,k )-v0(k)-v(i,jc,kb)+v0(kb))*rdzw_dn+ & - (w(i,jc,k )-w(i,j ,k ))*rdy_dn )**2 + & - ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn+ & - (w(i,j ,k )-w(i,jb,k ))*rdy_dn )**2 ) - - end do - end do -end do ! k - - -k=1 -kc=k+1 - -rdz = 1./(dz*adz(k)) -rdzw_up = 1./(dz*adzw(kc)) -rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy -rdy=rdy0 * sqrt(dy*rdz) -rdx_up=rdx0 * sqrt(dx*rdzw_up) -rdy_up=rdy0 * sqrt(dy*rdzw_up) - -do j=1,ny - jb=j-YES3D - jc=j+YES3D - do i=1,nx - ib=i-1 - ic=i+1 - - def2(i,j,k)=2.* ( & - ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & - ( (v(i,jc,k)-v(i,j,k))*rdy)**2+ & - ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & - + 0.25 * ( & - ( (u(ic,jc,k)-u(ic,j ,k))*rdy+(v(ic,jc,k)-v(i ,jc,k))*rdx )**2 + & - ( (u(i ,jc,k)-u(i ,j ,k))*rdy+(v(i ,jc,k)-v(ib,jc,k))*rdx )**2 + & - ( (u(ic,j ,k)-u(ic,jb,k))*rdy+(v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & - ( (u(i ,j ,k)-u(i ,jb,k))*rdy+(v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & - + 0.5 * ( & - ( (v(i,jc,kc)-v0(kc)-v(i,jc, k)+v0(k))*rdzw_up+ & - (w(i,jc,kc)-w(i,j ,kc))*rdy_up )**2 + & - ( (v(i,j ,kc)-v0(kc)-v(i,j , k)+v0(k))*rdzw_up+ & - (w(i,j ,kc)-w(i,jb,kc))*rdy_up )**2 ) & - + 0.5 * ( & - ( (u(ic,j,kc)-u0(kc)-u(ic,j, k)+u0(k))*rdzw_up+ & - (w(ic,j,kc)-w(i ,j,kc))*rdx_up )**2 + & - ( (u(i ,j,kc)-u0(kc)-u(i ,j, k)+u0(k))*rdzw_up+ & - (w(i ,j,kc)-w(ib,j,kc))*rdx_up )**2 ) - - - end do -end do - - -k=nzm -kc=k+1 -kb=k-1 - -rdz = 1./(dz*adz(k)) -rdzw_dn = 1./(dz*adzw(k)) -rdx=rdx0 * sqrt(dx*rdz) ! take into account grid anisotropy -rdy=rdy0 * sqrt(dy*rdz) -rdx_dn=rdx0 * sqrt(dx*rdzw_dn) -rdy_dn=rdy0 * sqrt(dy*rdzw_dn) - -do j=1,ny - jb=j-1*YES3D - jc=j+1*YES3D - do i=1,nx - ib=i-1 - ic=i+1 - def2(i,j,k)=2.* ( & - ( (u(ic,j,k)-u(i,j,k))*rdx)**2+ & - ( (v(i,jc,k)-v(i,j,k))*rdy)**2+ & - ( (w(i,j,kc)-w(i,j,k))*rdz)**2 ) & - + 0.25 * ( & - ( (u(ic,jc,k)-u(ic,j ,k))*rdy+(v(ic,jc,k)-v(i ,jc,k))*rdx )**2 + & - ( (u(i ,jc,k)-u(i ,j ,k))*rdy+(v(i ,jc,k)-v(ib,jc,k))*rdx )**2 + & - ( (u(ic,j ,k)-u(ic,jb,k))*rdy+(v(ic,j ,k)-v(i ,j ,k))*rdx )**2 + & - ( (u(i ,j ,k)-u(i ,jb,k))*rdy+(v(i ,j ,k)-v(ib,j ,k))*rdx )**2 ) & - + 0.5 * ( & - ( (v(i,jc,k )-v0(k)-v(i,jc,kb)+v0(kb))*rdzw_dn+ & - (w(i,jc,k )-w(i,j ,k ))*rdy_dn )**2 + & - ( (v(i,j ,k )-v0(k)-v(i,j ,kb)+v0(kb))*rdzw_dn+ & - (w(i,j ,k )-w(i,jb,k ))*rdy_dn )**2 ) & - + 0.5 * ( & - ( (u(ic,j,k )-u0(k)-u(ic,j,kb)+u0(kb))*rdzw_dn+ & - (w(ic,j,k )-w(i ,j,k ))*rdx_dn )**2 + & - ( (u(i ,j,k )-u0(k)-u(i ,j,kb)+u0(kb))*rdzw_dn+ & - (w(i ,j,k )-w(ib,j,k ))*rdx_dn )**2 ) - end do -end do - -end - diff --git a/src/physics/spcam/crm/SGS_TKE/crmx_tke_full.F90 b/src/physics/spcam/crm/SGS_TKE/crmx_tke_full.F90 deleted file mode 100644 index 79dd936cdc..0000000000 --- a/src/physics/spcam/crm/SGS_TKE/crmx_tke_full.F90 +++ /dev/null @@ -1,147 +0,0 @@ - -subroutine tke_full - -! this subroutine solves the TKE equation - -use crmx_vars -use crmx_sgs -use crmx_params -implicit none - -real def2(nx,ny,nzm) -real grd,betdz,Ck,Ce,Ces,Ce1,Ce2,smix,Pr,Cee,Cs -real buoy_sgs,ratio,a_prod_sh,a_prod_bu,a_diss -real lstarn, lstarp, bbb, omn, omp -real qsatt,dqsat -integer i,j,k,kc,kb - -!call t_startf('tke_full') - -!Cs = 0.1944 -Cs = 0.15 -Ck=0.1 -Ce=Ck**3/Cs**4 -Ces=Ce/0.7*3.0 - -if(RUN3D) then - call shear_prod3D(def2) -else - call shear_prod2D(def2) -endif - -do k=1,nzm - kb=k-1 - kc=k+1 - - grd=dz*adz(k) - - betdz=bet(k)/dz/(adzw(kc)+adzw(k)) - Ce1=Ce/0.7*0.19 - Ce2=Ce/0.7*0.51 - if(k.eq.1) then - kb=1 - kc=2 - betdz=bet(k)/dz/adzw(kc) - Ce1=Ces/0.7*0.19 - Ce2=Ces/0.7*0.51 - end if - if(k.eq.nzm) then - kb=nzm-1 - kc=nzm - betdz=bet(k)/dz/adzw(k) - Ce1=Ces/0.7*0.19 - Ce2=Ces/0.7*0.51 - end if - tkelediss(k) = 0. - tkesbdiss(k) = 0. - tkesbshear(k)= 0. - tkesbbuoy(k) = 0. - do j=1,ny - do i=1,nx -! SGS buoyancy flux - -!bloss: removed temperature diagnostics for omn. -! - use mass weighted qsat, dqsat and latent heat for cloud -! - separate buoyancy contributions for precipitating water and ice. - - - if(qcl(i,j,k)+qci(i,j,k) .gt. 0.) then - - omn = qcl(i,j,k)/(qcl(i,j,k)+qci(i,j,k)+1.e-20) - lstarn = fac_cond+(1.-omn)*fac_fus - - dqsat = omn*dtqsatw_crm(tabs(i,j,k),pres(k))+ & - (1.-omn)*dtqsati_crm(tabs(i,j,k),pres(k)) - qsatt = omn*qsatw_crm(tabs(i,j,k),pres(k))+(1.-omn)*qsati_crm(tabs(i,j,k),pres(k)) - bbb = 1. + epsv*qsatt-qcl(i,j,k)-qci(i,j,k) -qpl(i,j,k)-qpi(i,j,k)+1.61*tabs(i,j,k)*dqsat - bbb = bbb / (1.+lstarn*dqsat) - buoy_sgs=betdz*(bbb*(t(i,j,kc)-t(i,j,kb)) & - +(bbb*lstarn - (1.+lstarn*dqsat)*tabs(i,j,k))* & - (qv(i,j,kc)+qcl(i,j,kc)+qci(i,j,kc)-qv(i,j,kb)-qcl(i,j,kb)-qci(i,j,kb)) & - + (bbb*fac_cond - (1.+fac_cond*dqsat)*tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & - + (bbb*fac_sub - (1.+fac_sub *dqsat)*tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) -!bloss +(bbb*lstarp - (1.+lstarp*dqsat)*tabs(i,j,k))* & -!bloss (qpl(i,j,kc)+qpi(i,j,kc)-qpl(i,j,kb)-qpi(i,j,kb)) ) - else - - bbb = 1.+epsv*qv(i,j,k)-qpl(i,j,k)-qpi(i,j,k) - buoy_sgs=betdz*( bbb*(t(i,j,kc)-t(i,j,kb)) & - +epsv*tabs(i,j,k)* & - (qv(i,j,kc)+qcl(i,j,kc)+qci(i,j,kc)-qv(i,j,kb)-qcl(i,j,kb)-qci(i,j,kb)) & - +(bbb*fac_cond-tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & - +(bbb*fac_sub -tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) -!bloss +(bbb*lstarp-tabs(i,j,k))* & -!bloss (qpl(i,j,kc)+qpi(i,j,kc)-qpl(i,j,kb)-qpi(i,j,kb)) ) - end if - - if(buoy_sgs.le.0.) then - smix=grd - else - smix=min(grd,max(0.1*grd, sqrt(0.76*tk(i,j,k)/Ck/sqrt(buoy_sgs+1.e-10)))) - end if - - - ratio=smix/grd - Pr=1. -! Pr=1. +2.*ratio - Cee=Ce1+Ce2*ratio - - if(dosmagor) then - - tk(i,j,k)=sqrt(Ck**3/Cee*max(0.,def2(i,j,k)-Pr*buoy_sgs))*smix**2 - tke(i,j,k) = (tk(i,j,k)/(Ck*smix))**2 - a_prod_sh=(tk(i,j,k)+0.001)*def2(i,j,k) - a_prod_bu=-(tk(i,j,k)+0.001)*Pr*buoy_sgs - a_diss=a_prod_sh+a_prod_bu - - else - - tke(i,j,k)=max(0.,tke(i,j,k)) - a_prod_sh=(tk(i,j,k)+0.001)*def2(i,j,k) - a_prod_bu=-(tk(i,j,k)+0.001)*Pr*buoy_sgs - a_diss=min(tke(i,j,k)/(4.*dt),Cee/smix*tke(i,j,k)**1.5) ! cap the diss rate (useful for large time steps - tke(i,j,k)=max(0.,tke(i,j,k)+dtn*(max(0.,a_prod_sh+a_prod_bu)-a_diss)) - tk(i,j,k)=Ck*smix*sqrt(tke(i,j,k)) - - end if - - tkh(i,j,k)=Pr*tk(i,j,k) - - tkelediss(k) = tkelediss(k) - a_prod_sh - tkesbdiss(k) = tkesbdiss(k) + a_diss - tkesbshear(k)= tkesbshear(k)+ a_prod_sh - tkesbbuoy(k) = tkesbbuoy(k) + a_prod_bu - - end do ! i - end do ! j - - tkelediss(k) = tkelediss(k)/float(nx*ny) - - -end do ! k - -!call t_stopf('tke_full') - -end - - diff --git a/src/physics/spcam/crm/crmx_abcoefs.F90 b/src/physics/spcam/crm/crmx_abcoefs.F90 deleted file mode 100644 index 0694eb0143..0000000000 --- a/src/physics/spcam/crm/crmx_abcoefs.F90 +++ /dev/null @@ -1,28 +0,0 @@ - -subroutine abcoefs - -! coefficients for the Adams-Bashforth scheme - -use crmx_grid - -implicit none - -real alpha, beta - -if(nstep.ge.3.and.nadams.eq.3.or.nrestart.eq.2) then - alpha = dt3(nb) / dt3(na) - beta = dt3(nc) / dt3(na) - ct = (2.+3.* alpha) / (6.* (alpha + beta) * beta) - bt = -(1.+2.*(alpha + beta) * ct)/(2. * alpha) - at = 1. - bt - ct -else if(nstep.ge.2) then - at = 3./2. - bt = -1./2. - ct = 0. -else - at = 1. - bt = 0. - ct = 0. -end if - -end subroutine abcoefs diff --git a/src/physics/spcam/crm/crmx_adams.F90 b/src/physics/spcam/crm/crmx_adams.F90 deleted file mode 100644 index 97b35188fc..0000000000 --- a/src/physics/spcam/crm/crmx_adams.F90 +++ /dev/null @@ -1,45 +0,0 @@ - -subroutine adams - -! Adams-Bashforth scheme - -use crmx_vars - -implicit none - -real dtdx, dtdy, dtdz, rhox, rhoy, rhoz -integer i,j,k - -dtdx = dtn/dx -dtdy = dtn/dy -dtdz = dtn/dz - -do k=1,nzm - rhox = rho(k)*dtdx - rhoy = rho(k)*dtdy - rhoz = rhow(k)*dtdz - do j=1,ny - do i=1,nx - - dudt(i,j,k,nc) = u(i,j,k) + dt3(na) & - *(at*dudt(i,j,k,na)+bt*dudt(i,j,k,nb)+ct*dudt(i,j,k,nc)) - - dvdt(i,j,k,nc) = v(i,j,k) + dt3(na) & - *(at*dvdt(i,j,k,na)+bt*dvdt(i,j,k,nb)+ct*dvdt(i,j,k,nc)) - - dwdt(i,j,k,nc) = w(i,j,k) + dt3(na) & - *(at*dwdt(i,j,k,na)+bt*dwdt(i,j,k,nb)+ct*dwdt(i,j,k,nc)) - - u(i,j,k) = 0.5*(u(i,j,k)+dudt(i,j,k,nc)) * rhox - v(i,j,k) = 0.5*(v(i,j,k)+dvdt(i,j,k,nc)) * rhoy - misc(i,j,k) = 0.5*(w(i,j,k)+dwdt(i,j,k,nc)) - w(i,j,k) = 0.5*(w(i,j,k)+dwdt(i,j,k,nc)) * rhoz - - - end do - end do -end do - -end subroutine adams - - diff --git a/src/physics/spcam/crm/crmx_advect2_mom_xy.F90 b/src/physics/spcam/crm/crmx_advect2_mom_xy.F90 deleted file mode 100644 index 600596d177..0000000000 --- a/src/physics/spcam/crm/crmx_advect2_mom_xy.F90 +++ /dev/null @@ -1,95 +0,0 @@ - -subroutine advect2_mom_xy - -! momentum tendency due to 2nd-order-central horizontal advection - -use crmx_vars - -implicit none - -real fu(0:nx,1-YES3D:ny,nzm) -real fv(0:nx,1-YES3D:ny,nzm) -real fw(0:nx,1-YES3D:ny,nzm) -real dx25, dy25, irho - -integer i, j, k, kc, kcu, ic, jb, ib, jc - -dx25 = 0.25 / dx -dy25 = 0.25 / dy - - -if(RUN3D) then - -do k = 1,nzm - kc= k+1 - kcu =min(kc, nzm) - irho = 1./(rhow(kc)*adzw(kc)) - - do j = 1, ny - jb = j-1 - do i = 0, nx - ic = i+1 - fu(i,j,k)=dx25*(u(ic,j,k)+u(i,j,k))*(u(i,j,k)+u(ic,j,k)) - fv(i,j,k)=dx25*(u(ic,j,k)+u(ic,jb,k))*(v(i,j,k)+v(ic,j,k)) - fw(i,j,k)=dx25*(u(ic,j,k)*rho(k)*adz(k)+ & - u(ic,j,kcu)*rho(kcu)*adz(kcu))*(w(i,j,kc)+w(ic,j,kc)) - end do - do i = 1, nx - ib = i-1 - dudt(i,j,k,na) = dudt(i,j,k,na) - (fu(i,j,k)-fu(ib,j,k)) - dvdt(i,j,k,na) = dvdt(i,j,k,na) - (fv(i,j,k)-fv(ib,j,k)) - dwdt(i,j,kc,na) = dwdt(i,j,kc,na)-irho*(fw(i,j,k)-fw(ib,j,k)) - end do - end do - - do j = 0, ny - jc = j+1 - do i = 1, nx - ib = i-1 - fu(i,j,k)=dy25*(v(i,jc,k)+v(ib,jc,k))*(u(i,j,k)+u(i,jc,k)) - fv(i,j,k)=dy25*(v(i,jc,k)+v(i,j,k))*(v(i,j,k)+v(i,jc,k)) - fw(i,j,k)=dy25*(v(i,jc,k)*rho(k)*adz(k)+ & - v(i,jc,kcu)*rho(kcu)*adz(kcu))*(w(i,j,kc)+w(i,jc,kc)) - end do - end do - do j = 1,ny - jb = j-1 - do i = 1, nx - dudt(i,j,k,na) = dudt(i,j,k,na) - (fu(i,j,k) - fu(i,jb,k)) - dvdt(i,j,k,na) = dvdt(i,j,k,na) - (fv(i,j,k) - fv(i,jb,k)) - dwdt(i,j,kc,na)= dwdt(i,j,kc,na)-irho*(fw(i,j,k)-fw(i,jb,k)) - end do - end do - -end do ! k - - -else - -j=1 - -do k = 1,nzm - kc= k+1 - kcu =min(kc, nzm) - irho = 1./(rhow(kc)*adzw(kc)) - - do i = 0, nx - ic = i+1 - fu(i,j,k)=dx25*(u(ic,j,k)+u(i,j,k))*(u(i,j,k)+u(ic,j,k)) - fv(i,j,k)=dx25*(u(ic,j,k)+u(i,j,k))*(v(i,j,k)+v(ic,j,k)) - fw(i,j,k)=dx25*(u(ic,j,k)*rho(k)*adz(k)+ & - u(ic,j,kcu)*rho(kcu)*adz(kcu))*(w(i,j,kc)+w(ic,j,kc)) - end do - do i = 1, nx - ib = i-1 - dudt(i,j,k,na) = dudt(i,j,k,na) - (fu(i,j,k)-fu(ib,j,k)) - dvdt(i,j,k,na) = dvdt(i,j,k,na) - (fv(i,j,k)-fv(ib,j,k)) - dwdt(i,j,kc,na) = dwdt(i,j,kc,na)-irho*(fw(i,j,k)-fw(ib,j,k)) - end do - -end do ! k - -endif - -end subroutine advect2_mom_xy - diff --git a/src/physics/spcam/crm/crmx_advect2_mom_z.F90 b/src/physics/spcam/crm/crmx_advect2_mom_z.F90 deleted file mode 100644 index be5d42734a..0000000000 --- a/src/physics/spcam/crm/crmx_advect2_mom_z.F90 +++ /dev/null @@ -1,93 +0,0 @@ - -subroutine advect2_mom_z - -! momentum tendency due to the 2nd-order-central vertical advection - -use crmx_vars - -implicit none - - -real fuz(nx,ny,nz),fvz(nx,ny,nz),fwz(nx,ny,nzm) -integer i, j, k, kc, kb -real dz2, dz25, www, rhoi - -dz25=1./(4.*dz) -dz2=dz25*2. - -do j=1,ny - do i=1,nx - fuz(i,j,1) = 0. - fvz(i,j,1) = 0. - fuz(i,j,nz) = 0. - fvz(i,j,nz) = 0. - fwz(i,j,1) = 0. - fwz(i,j,nzm) = 0. - end do -end do - -uwle(1) = 0. -vwle(1) = 0. - -if(RUN3D) then - -do k=2,nzm - kb = k-1 - rhoi = dz25 * rhow(k) - uwle(k) = 0. - vwle(k) = 0. - do j=1,ny - do i=1,nx - fuz(i,j,k) = rhoi*(w(i,j,k)+w(i-1,j,k))*(u(i,j,k)+u(i,j,kb)) - fvz(i,j,k) = rhoi*(w(i,j,k)+w(i,j-1,k))*(v(i,j,k)+v(i,j,kb)) - uwle(k) = uwle(k)+fuz(i,j,k) - vwle(k) = vwle(k)+fvz(i,j,k) - end do - end do -end do - -else - -do k=2,nzm - kb = k-1 - rhoi = dz25 * rhow(k) - uwle(k) = 0. - vwle(k) = 0. - do j=1,ny - do i=1,nx - www = rhoi*(w(i,j,k)+w(i-1,j,k)) - fuz(i,j,k) = www*(u(i,j,k)+u(i,j,kb)) - fvz(i,j,k) = www*(v(i,j,k)+v(i,j,kb)) - uwle(k) = uwle(k)+fuz(i,j,k) - vwle(k) = vwle(k)+fvz(i,j,k) - end do - end do -end do - - -endif - -do k=1,nzm - kc = k+1 - rhoi = 1./(rho(k)*adz(k)) - do j=1,ny - do i=1,nx - dudt(i,j,k,na)=dudt(i,j,k,na)-(fuz(i,j,kc)-fuz(i,j,k))*rhoi - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(fvz(i,j,kc)-fvz(i,j,k))*rhoi - fwz(i,j,k)=dz25*(w(i,j,kc)*rhow(kc)+w(i,j,k)*rhow(k))*(w(i,j,kc)+w(i,j,k)) - end do - end do -end do - -do k=2,nzm - kb=k-1 - rhoi = 1./(rhow(k)*adzw(k)) - do j=1,ny - do i=1,nx - dwdt(i,j,k,na)=dwdt(i,j,k,na)-(fwz(i,j,k)-fwz(i,j,kb))*rhoi - end do - end do -end do ! k - -end subroutine advect2_mom_z - diff --git a/src/physics/spcam/crm/crmx_advect_all_scalars.F90 b/src/physics/spcam/crm/crmx_advect_all_scalars.F90 deleted file mode 100644 index f6eb9e0915..0000000000 --- a/src/physics/spcam/crm/crmx_advect_all_scalars.F90 +++ /dev/null @@ -1,73 +0,0 @@ -subroutine advect_all_scalars() - - use crmx_vars - use crmx_microphysics - use crmx_sgs - use crmx_crmtracers -#ifdef CLUBB_CRM - use crmx_params, only: dotracers, doclubb, doclubbnoninter -#else - use crmx_params, only: dotracers -#endif - implicit none - real dummy(nz) - integer k - - -!--------------------------------------------------------- -! advection of scalars : - - call advect_scalar(t,tadv,twle,t2leadv,t2legrad,twleadv,.true.) - -! -! Advection of microphysics prognostics: -! - - do k = 1,nmicro_fields - if( k.eq.index_water_vapor &! transport water-vapor variable no metter what -#ifdef CLUBB_CRM -!Added preprocessor directives. - nielsenb UWM 30 July 2008 - .or. ( docloud .or. doclubb .or. doclubbnoninter ) .and.flag_precip(k).ne.1 & ! transport non-precipitation vars -#else - .or. docloud.and.flag_precip(k).ne.1 & ! transport non-precipitation vars -#endif - .or. doprecip.and.flag_precip(k).eq.1 ) & - call advect_scalar(micro_field(:,:,:,k),mkadv(:,k),mkwle(:,k),dummy,dummy,dummy,.false.) - end do - -! -! Advection of sgs prognostics: -! - - if(dosgs.and.advect_sgs) then - do k = 1,nsgs_fields - call advect_scalar(sgs_field(:,:,:,k),sgsadv(:,k),sgswle(:,k),dummy,dummy,dummy,.false.) - end do - end if - - -! -! Precipitation fallout: -! - if(doprecip) then - - total_water_prec = total_water_prec + total_water() - - call micro_precip_fall() - - total_water_prec = total_water_prec - total_water() - - - end if - - ! advection of tracers: - - if(dotracers) then - - do k = 1,ntracers - call advect_scalar(tracer(:,:,:,k),tradv(:,k),trwle(:,k),dummy,dummy,dummy,.false.) - end do - - end if - -end subroutine advect_all_scalars diff --git a/src/physics/spcam/crm/crmx_advect_mom.F90 b/src/physics/spcam/crm/crmx_advect_mom.F90 deleted file mode 100644 index b1562a09a3..0000000000 --- a/src/physics/spcam/crm/crmx_advect_mom.F90 +++ /dev/null @@ -1,19 +0,0 @@ -subroutine advect_mom - -use crmx_vars -use crmx_params, only: docolumn - -implicit none -integer i,j,k - -if(docolumn) return - -!call t_startf ('advect_mom') - -call advect2_mom_xy() -call advect2_mom_z() - -!call t_stopf ('advect_mom') - -end subroutine advect_mom - diff --git a/src/physics/spcam/crm/crmx_atmosphere.F90 b/src/physics/spcam/crm/crmx_atmosphere.F90 deleted file mode 100644 index 5f9623b931..0000000000 --- a/src/physics/spcam/crm/crmx_atmosphere.F90 +++ /dev/null @@ -1,71 +0,0 @@ - - SUBROUTINE Atmosphere(alt, sigma, delta, theta) -! ------------------------------------------------------------------------- -! PURPOSE - Compute the properties of the 1976 standard atmosphere to 86 km. -! AUTHOR - Ralph Carmichael, Public Domain Aeronautical Software -! NOTE - If alt > 86, the values returned will not be correct, but they will -! not be too far removed from the correct values for density. -! The reference document does not use the terms pressure and temperature -! above 86 km. - IMPLICIT NONE -!============================================================================ -! A R G U M E N T S | -!============================================================================ - REAL,INTENT(IN):: alt ! geometric altitude, km. - REAL,INTENT(OUT):: sigma! density/sea-level standard density - REAL,INTENT(OUT):: delta! pressure/sea-level standard pressure - REAL,INTENT(OUT):: theta! temperature/sea-level standard temperature -!============================================================================ -! L O C A L C O N S T A N T S | -!============================================================================ - REAL,PARAMETER:: REARTH = 6369.0 ! radius of the Earth (km) - REAL,PARAMETER:: GMR = 34.163195 ! gas constant - INTEGER,PARAMETER:: NTAB=8! number of entries in the defining tables -!============================================================================ -! L O C A L V A R I A B L E S | -!============================================================================ - INTEGER:: i,j,k ! counters - REAL:: h ! geopotential altitude (km) - REAL:: tgrad, tbase! temperature gradient and base temp of this layer - REAL:: tlocal ! local temperature - REAL:: deltah ! height above base of this layer -!============================================================================ -! L O C A L A R R A Y S ( 1 9 7 6 S T D. A T M O S P H E R E ) | -!============================================================================ - REAL,DIMENSION(NTAB),PARAMETER:: htab= (/0.0, 11.0, 20.0, 32.0, 47.0, 51.0, 71.0,84.852/) - REAL,DIMENSION(NTAB),PARAMETER:: ttab= (/288.15, 216.65, 216.65, 228.65, 270.65, 270.65, 214.65, 186.946/) - REAL,DIMENSION(NTAB),PARAMETER:: ptab= (/1.0, 2.233611e-1, & -5.403295e-2, 8.5666784e-3, 1.0945601e-3, 6.6063531e-4, 3.9046834e-5, 3.68501e-6/) - REAL,DIMENSION(NTAB),PARAMETER:: gtab= (/-6.5, 0.0, 1.0, 2.8, 0.0, -2.8, -2.0, 0.0/) -!---------------------------------------------------------------------------- - h=alt*REARTH/(alt+REARTH)! convert geometric to geopotential altitude - - i=1 - j=NTAB ! setting up for=binary search - DO - k=(i+j)/2 - IF (h < htab(k)) THEN - j=k - ELSE - i=k - END IF - IF (j <= i+1) EXIT - END DO - - tgrad=gtab(i) ! i will be in 1...NTAB-1 - tbase=ttab(i) - deltah=h-htab(i) - tlocal=tbase+tgrad*deltah - theta=tlocal/ttab(1) ! temperature ratio - - IF (tgrad == 0.0) THEN ! pressure ratio - delta=ptab(i)*EXP(-GMR*deltah/tbase) - ELSE - delta=ptab(i)*(tbase/tlocal)**(GMR/tgrad) - END IF - - sigma=delta/theta ! density ratio - RETURN - END Subroutine Atmosphere - - diff --git a/src/physics/spcam/crm/crmx_bound_duvdt.F90 b/src/physics/spcam/crm/crmx_bound_duvdt.F90 deleted file mode 100644 index ff96184761..0000000000 --- a/src/physics/spcam/crm/crmx_bound_duvdt.F90 +++ /dev/null @@ -1,28 +0,0 @@ - - -subroutine bound_duvdt - -! Periodic boundary exchange - -use crmx_vars -implicit none - -integer i,j,k - - do k=1,nzm - do j=1,ny - dudt(nxp1,j,k,na) = dudt(1,j,k,na) - end do - end do - - if(RUN3D) then - - do k=1,nzm - do i=1,nx - dvdt(i,nyp1,k,na) = dvdt(i,1,k,na) - end do - end do - - endif - -end subroutine bound_duvdt diff --git a/src/physics/spcam/crm/crmx_bound_exchange.F90 b/src/physics/spcam/crm/crmx_bound_exchange.F90 deleted file mode 100644 index c327a0f13f..0000000000 --- a/src/physics/spcam/crm/crmx_bound_exchange.F90 +++ /dev/null @@ -1,206 +0,0 @@ -subroutine bound_exchange(f,dimx1,dimx2,dimy1,dimy2,dimz,i_1, i_2, j_1, j_2, id) - -! periodic boundary exchange - - -use crmx_grid -implicit none - -integer dimx1, dimx2, dimy1, dimy2, dimz -integer i_1, i_2, j_1, j_2 -real f(dimx1:dimx2, dimy1:dimy2, dimz) -integer id ! id of the sent field (dummy variable) - -real buffer((nx+ny)*3*nz) ! buffer for sending data - -integer i, j, k, n -integer i1, i2, j1, j2 - -i1 = i_1 - 1 -i2 = i_2 - 1 -j1 = j_1 - 1 -j2 = j_2 - 1 - -!---------------------------------------------------------------------- -! Send buffers to neighbors -!---------------------------------------------------------------------- - - - if(RUN3D) then - -! "North" -> "South": - - n=0 - do k=1,dimz - do j=ny-j1,ny - do i=1,nx - n = n+1 - buffer(n) = f(i,j,k) - end do - end do - end do - n=0 - do k=1,dimz - do j=-j1,0 - do i=1,nx - n = n+1 - f(i,j,k) = buffer(n) - end do - end do - end do - -! "North-East" -> "South-West": - - n=0 - do k=1,dimz - do j=ny-j1,ny - do i=nx-i1,nx - n = n+1 - buffer(n) = f(i,j,k) - end do - end do - end do - n=0 - do k=1,dimz - do j=-j1,0 - do i=-i1,0 - n = n+1 - f(i,j,k) = buffer(n) - end do - end do - end do - -! "South-East" -> "North-West": - - n=0 - do k=1,dimz - do j=1,1+j2 - do i=nx-i1,nx - n = n+1 - buffer(n) = f(i,j,k) - end do - end do - end do - n=0 - do k=1,dimz - do j=nyp1,nyp1+j2 - do i=-i1,0 - n = n+1 - f(i,j,k) = buffer(n) - end do - end do - end do - -! "South" -> "North": - - n=0 - do k=1,dimz - do j=1,1+j2 - do i=1,nx - n = n+1 - buffer(n) = f(i,j,k) - end do - end do - end do - n=0 - do k=1,dimz - do j=nyp1,nyp1+j2 - do i=1,nx - n = n+1 - f(i,j,k) = buffer(n) - end do - end do - end do - -! "South-West" -> "North-East": - - n=0 - do k=1,dimz - do j=1,1+j2 - do i=1,1+i2 - n = n+1 - buffer(n) = f(i,j,k) - end do - end do - end do - n=0 - do k=1,dimz - do j=nyp1,nyp1+j2 - do i=nxp1,nxp1+i2 - n = n+1 - f(i,j,k) = buffer(n) - end do - end do - end do - - -! To "North-West" -> "South-East": - - n=0 - do k=1,dimz - do j=ny-j1,ny - do i=1,1+i2 - n = n+1 - buffer(n) = f(i,j,k) - end do - end do - end do - n=0 - do k=1,dimz - do j=-j1,0 - do i=nxp1,nxp1+i2 - n = n+1 - f(i,j,k) = buffer(n) - end do - end do - end do - - - endif - -! "East" -> "West": - - n=0 - do k=1,dimz - do j=1,ny - do i=nx-i1,nx - n = n+1 - buffer(n) = f(i,j,k) - end do - end do - end do - n=0 - do k=1,dimz - do j=1,ny - do i=-i1,0 - n = n+1 - f(i,j,k) = buffer(n) - end do - end do - end do - -! "West" -> "East": - - n=0 - do k=1,dimz - do j=1,ny - do i=1,1+i2 - n = n+1 - buffer(n) = f(i,j,k) - end do - end do - end do - n=0 - do k=1,dimz - do j=1,ny - do i=nxp1,nxp1+i2 - n = n+1 - f(i,j,k) = buffer(n) - end do - end do - end do - - -end subroutine bound_exchange - - diff --git a/src/physics/spcam/crm/crmx_boundaries.F90 b/src/physics/spcam/crm/crmx_boundaries.F90 deleted file mode 100644 index 0a642daab1..0000000000 --- a/src/physics/spcam/crm/crmx_boundaries.F90 +++ /dev/null @@ -1,20 +0,0 @@ - -subroutine boundaries(flag) - -use crmx_grid, only: dompi - - -implicit none -integer flag - -!call t_startf ('boundaries') - -if(dompi) then - call task_boundaries(flag) -else - call periodic(flag) -end if - -!call t_stopf ('boundaries') - -end subroutine boundaries diff --git a/src/physics/spcam/crm/crmx_buoyancy.F90 b/src/physics/spcam/crm/crmx_buoyancy.F90 deleted file mode 100644 index 8d8ff6a739..0000000000 --- a/src/physics/spcam/crm/crmx_buoyancy.F90 +++ /dev/null @@ -1,34 +0,0 @@ - -subroutine buoyancy() - -use crmx_vars -use crmx_params -implicit none - -integer i,j,k,kb -real betu, betd - -if(docolumn) return - -do k=2,nzm - kb=k-1 - betu=adz(kb)/(adz(k)+adz(kb)) - betd=adz(k)/(adz(k)+adz(kb)) - do j=1,ny - do i=1,nx - - dwdt(i,j,k,na)=dwdt(i,j,k,na) + & - bet(k)*betu* & - ( tabs0(k)*(epsv*(qv(i,j,k)-qv0(k))-(qcl(i,j,k)+qci(i,j,k)-qn0(k)+qpl(i,j,k)+qpi(i,j,k)-qp0(k))) & - +(tabs(i,j,k)-tabs0(k))*(1.+epsv*qv0(k)-qn0(k)-qp0(k)) ) & - + bet(kb)*betd* & - ( tabs0(kb)*(epsv*(qv(i,j,kb)-qv0(kb))-(qcl(i,j,kb)+qci(i,j,kb)-qn0(kb)+qpl(i,j,kb)+qpi(i,j,kb)-qp0(kb))) & - +(tabs(i,j,kb)-tabs0(kb))*(1.+epsv*qv0(kb)-qn0(kb)-qp0(kb)) ) - - end do ! i - end do ! j -end do ! k - -end subroutine buoyancy - - diff --git a/src/physics/spcam/crm/crmx_compress3D.F90 b/src/physics/spcam/crm/crmx_compress3D.F90 deleted file mode 100644 index a7686880f0..0000000000 --- a/src/physics/spcam/crm/crmx_compress3D.F90 +++ /dev/null @@ -1,165 +0,0 @@ -subroutine compress3D (f,nx,ny,nz,name, long_name, units, & - savebin, dompi, rank, nsubdomains) - - -! Compress3D: Compresses a given 3D array into the byte-array -! and writes the latter into a file. - -use crmx_grid, only: output_sep - implicit none -! Input: - -integer nx,ny,nz -real f(nx,ny,nz) -character*(*) name,long_name,units -integer rank,rrr,ttt,irank,nsubdomains -logical savebin, dompi - -! Local: - -integer(2), allocatable :: byte(:) -real(kind=selected_real_kind(6)), allocatable :: byte4(:) -integer size,count - -character(10) value_min(nz), value_max(nz) -character(7) form -integer int_fac, integer_max, integer_min -parameter (int_fac=2,integer_min=-32000, integer_max=32000) -! parameter (int_fac=1,integer_min=-127, integer_max=127) -real f_max,f_min, f_max1, f_min1, scale -integer i,j,k,req - - -! Allocate byte array: - -size=nx*ny*nz -if(savebin) then - allocate (byte4(size)) -else - allocate (byte(size)) -end if -count = 0 - -if(savebin) then - - do k=1,nz - do j=1,ny - do i=1,nx - count = count+1 - byte4(count) = f(i,j,k) - end do - end do - end do - - if(rank.eq.0) then - write(46) name,' ',long_name,' ',units - write(46) (byte4(k),k=1,count) - end if - - if(output_sep) then - if(rank.ne.0) write(46) (byte4(k),k=1,count) - else - do irank = 1, nsubdomains-1 - call task_barrier() - if(irank.eq.rank) then - call task_bsend_float(0,byte4,count,irank) - end if - if(rank.eq.0) then - call task_receive_float(byte4,count,req) - call task_wait(req,rrr,ttt) - write(46) (byte4(k),k=1,count) - end if - end do - end if - - deallocate(byte4) - - -else - - - do k=1,nz - - f_max=-1.e30 - f_min= 1.e30 - do j=1,ny - do i=1,nx - f_max = max(f_max,f(i,j,k)) - f_min = min(f_min,f(i,j,k)) - end do - end do - if(dompi) then - f_max1=f_max - f_min1=f_min - call task_max_real(f_max1,f_max,1) - call task_min_real(f_min1,f_min,1) - endif - - if(abs(f_max).lt.10..and.abs(f_min).lt.10.) then - form='(f10.7)' - else if(abs(f_max).lt.100..and.abs(f_min).lt.100.) then - form='(f10.6)' - else if(abs(f_max).lt.1000..and.abs(f_min).lt.1000.) then - form='(f10.5)' - else if(abs(f_max).lt.10000..and.abs(f_min).lt.10000.) then - form='(f10.4)' - else if(abs(f_max).lt.100000..and.abs(f_min).lt.100000.) then - form='(f10.3)' - else if(abs(f_max).lt.1000000..and.abs(f_min).lt.1000000.) then - form='(f10.2)' - else if(abs(f_max).lt.10000000..and.abs(f_min).lt.10000000.) then - form='(f10.1)' - else if(abs(f_max).lt.100000000..and.abs(f_min).lt.100000000.) then - form='(f10.0)' - else - form='(f10.0)' - f_min=-999. - f_max= 999. - end if - - write(value_max(k),form) f_max - write(value_min(k),form) f_min - - scale = float(integer_max-integer_min)/(f_max-f_min+1.e-20) - - do j=1,ny - do i=1,nx - count=count+1 - byte(count)= integer_min+scale*(f(i,j,k)-f_min) - end do - end do - - end do ! k - - if(rank.eq.0) then - write(46) name,' ',long_name,' ',units,' ',value_max,value_min - write(46) (byte(k),k=1,count) - end if - - if(output_sep) then - if(rank.ne.0) write(46) (byte(k),k=1,count) - else - do irank = 1, nsubdomains-1 - call task_barrier() - if(irank.eq.rank) then - call task_send_character(0,byte,int_fac*count,irank,req) - call task_wait(req,rrr,ttt) - end if - if(rank.eq.0) then - call task_receive_character(byte,int_fac*count,req) - call task_wait(req,rrr,ttt) - write(46) (byte(k),k=1,count) - end if - end do - end if - - deallocate(byte) - - -end if ! savebin - - -call task_barrier() - -end subroutine compress3D - diff --git a/src/physics/spcam/crm/crmx_coriolis.F90 b/src/physics/spcam/crm/crmx_coriolis.F90 deleted file mode 100644 index 13b1707b3e..0000000000 --- a/src/physics/spcam/crm/crmx_coriolis.F90 +++ /dev/null @@ -1,48 +0,0 @@ - -subroutine coriolis - -use crmx_vars - -implicit none - -real u_av, v_av, w_av -integer i,j,k,ib,ic,jb,jc,kc - -if(RUN3D) then - -do k=1,nzm - kc=k+1 - do j=1,ny - jb=j-1 - jc=j+1 - do i=1,nx - ib=i-1 - ic=i+1 - v_av=0.25*(v(i,j,k)+v(i,jc,k)+v(ib,j,k)+v(ib,jc,k)) - w_av=0.25*(w(i,j,kc)+w(ib,j,kc)+w(i,j,k)+w(ib,j,k)) - dudt(i,j,k,na)=dudt(i,j,k,na)+fcory(j)*(v_av-vg0(k))-fcorzy(j)*w_av - u_av=0.25*(u(i,j,k)+u(ic,j,k)+u(i,jb,k)+u(ic,jb,k)) - dvdt(i,j,k,na)=dvdt(i,j,k,na)-0.5*(fcory(j)+fcory(jb))*(u_av-ug0(k)) - end do ! i - end do ! j -end do ! k - -else - -do k=1,nzm - kc=k+1 - do j=1,ny - do i=1,nx - ib=i-1 - ic=i+1 - w_av=0.25*(w(i,j,kc)+w(ib,j,kc)+w(i,j,k)+w(ib,j,k)) - dudt(i,j,k,na)=dudt(i,j,k,na)+fcory(j)*(v(i,j,k)-vg0(k))-fcorzy(j)*w_av - dvdt(i,j,k,na)=dvdt(i,j,k,na)-fcory(j)*(u(i,j,k)-ug0(k)) - end do ! i - end do ! i -end do ! k - -endif - -end subroutine coriolis - diff --git a/src/physics/spcam/crm/crmx_crm_module.F90 b/src/physics/spcam/crm/crmx_crm_module.F90 deleted file mode 100644 index 8e7ea7b3aa..0000000000 --- a/src/physics/spcam/crm/crmx_crm_module.F90 +++ /dev/null @@ -1,1792 +0,0 @@ -module crmx_crm_module -!--------------------------------------------------------------- -! Super-parameterization's main driver -! Marat Khairoutdinov, 2001-2009 -!--------------------------------------------------------------- - -use crmx_setparm_mod, only : setparm - -contains - -subroutine crm (lchnk, icol, & - tl, ql, qccl, qiil, ul, vl, & - ps, pmid, pdel, phis, & - zmid, zint, dt_gl, plev, & - qltend, qcltend, qiltend, sltend, & - u_crm, v_crm, w_crm, t_crm, micro_fields_crm, & - qrad_crm, & - qc_crm, qi_crm, qpc_crm, qpi_crm, prec_crm, & - t_rad, qv_rad, qc_rad, qi_rad, cld_rad, cld3d_crm, & -#ifdef m2005 - nc_rad, ni_rad, qs_rad, ns_rad, wvar_crm, & -! hm 7/26/11 new output - aut_crm, acc_crm, evpc_crm, evpr_crm, mlt_crm, & - sub_crm, dep_crm, con_crm, & -! hm 8/31/11 new output for gcm-grid and time-step avg process rates - aut_crm_a, acc_crm_a, evpc_crm_a, evpr_crm_a, mlt_crm_a, & - sub_crm_a, dep_crm_a, con_crm_a, & -#endif - precc, precl, precsc, precsl, & - cltot, clhgh, clmed, cllow, cld, cldtop, & - gicewp, gliqwp, & - mc, mcup, mcdn, mcuup, mcudn, & - crm_qc, crm_qi, crm_qs, crm_qg, crm_qr, & -#ifdef m2005 - crm_nc, crm_ni, crm_ns, crm_ng, crm_nr, & -#ifdef MODAL_AERO - naermod, vaerosol, hygro, & -#endif -#endif -#ifdef SPCAM_CLUBB_SGS - clubb_buffer, & - crm_cld, & - clubb_tk, clubb_tkh, & - relvar, accre_enhan, qclvar, & -#endif - crm_tk, crm_tkh, & - mu_crm, md_crm, du_crm, eu_crm, ed_crm, jt_crm, mx_crm, & -#ifdef ECPP - abnd, abnd_tf, massflxbnd, acen, acen_tf, & - rhcen, qcloudcen, qicecen, qlsinkcen, precrcen, precsolidcen, & - qlsink_bfcen, qlsink_avgcen, praincen, & - wupthresh_bnd, wdownthresh_bnd, & - wwqui_cen, wwqui_bnd, wwqui_cloudy_cen, wwqui_cloudy_bnd, & -#endif - tkez, tkesgsz, tkz, flux_u, flux_v, flux_qt, fluxsgs_qt,flux_qp, & - pflx, qt_ls, qt_trans, qp_trans, qp_fall, & - qp_evp, qp_src, t_ls, prectend, precstend, & - ocnfrac, wndls, tau00, bflxls, & - fluxu00, fluxv00, fluxt00, fluxq00, & - taux_crm, tauy_crm, z0m, timing_factor, qtot) - -! dolong, doshort, nrad0, & -! latitude00, longitude00, day00, pres00, tabs_s0, case0, & -! radlwup0, radlwdn0, radswup0, radswdn0, radqrlw0, radqrsw0, & -! lwnsxy,swnsxy,lwntxy,swntxy,solinxy,lwnscxy,swnscxy,lwntcxy,swntcxy,lwdsxy,swdsxy) - - -!--------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 -#ifdef SPCAM_CLUBB_SGS - use crmdims, only: nclubbvars -#endif - use phys_grid, only: get_rlon_p, get_rlat_p, get_gcol_all_p - use ppgrid, only: pcols - use crmx_vars - use crmx_params - use crmx_microphysics - use crmx_sgs - use crmx_crmtracers -#ifdef MODAL_AERO - use modal_aero_data, only: ntot_amode -#endif -#ifdef SPCAM_CLUBB_SGS - use crmx_clubb_sgs, only: advance_clubb_sgs, clubb_sgs_setup, clubb_sgs_cleanup, & - apply_clubb_sgs_tndcy, apply_clubb_sgs_tndcy_scalars, apply_clubb_sgs_tndcy_mom, & ! Subroutines - t2thetal ! Functions - use crmx_clubb_sgs, only: total_energy - use crmx_clubbvars, only: edsclr_dim, sclr_dim, rho_ds_zt, rho_ds_zm, & - rtm_spurious_source, thlm_spurious_source - use crmx_clubb_precision, only: time_precision - use crmx_clubbvars, only: up2, vp2, wprtp, wpthlp, wp2, wp3, rtp2, thlp2, rtpthlp, & - upwp, vpwp, cloud_frac, t_tndcy, qc_tndcy, qv_tndcy, u_tndcy, v_tndcy, lrestart_clubb - use crmx_clubbvars, only: rho_ds_zt, rho_ds_zm, thv_ds_zt, thv_ds_zm, & - invrs_rho_ds_zt, invrs_rho_ds_zm - use crmx_clubbvars, only: tracer_tndcy, sclrp2, sclrprtp, sclrpthlp, wpsclrp - use crmx_fill_holes, only: vertical_integral ! Function - use crmx_numerical_check, only: calculate_spurious_source - use crmx_grid_class, only: gr ! Variable - use crmx_clubb_precision, only: core_rknd ! Constants - use crmx_clubbvars, only: relvarg, accre_enhang, qclvarg -#endif /*CLUBB_SGS*/ -#ifdef ECPP - use crmx_ecppvars, only: qlsink, precr, precsolid, & - area_bnd_final, area_bnd_sum, area_cen_final, area_cen_sum, & - mass_bnd_final, mass_bnd_sum, rh_cen_sum, qcloud_cen_sum, qice_cen_sum, & - qlsink_cen_sum, precr_cen_sum, precsolid_cen_sum, xkhvsum, wup_thresh, wdown_thresh, & - wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum, & - qlsink_bf_cen_sum, qlsink_avg_cen_sum, prain_cen_sum, qlsink_bf, prain - use crmx_module_ecpp_crm_driver, only: ecpp_crm_stat, ecpp_crm_init, ecpp_crm_cleanup, ntavg1_ss, ntavg2_ss - use crmx_ecppvars, only: NCLASS_CL, ncls_ecpp_in, NCLASS_PR -#endif /*ECPP*/ - - use cam_abortutils, only: endrun - use time_manager, only: get_nstep - - implicit none - -! integer, parameter :: r8 = 8 - -! Input: - - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: icol ! column identifier - integer, intent(in) :: plev ! number of levels - real(r8), intent(in) :: ps ! Global grid surface pressure (Pa) - real(r8), intent(in) :: pmid(plev) ! Global grid pressure (Pa) - real(r8), intent(in) :: pdel(plev) ! Layer's pressure thickness (Pa) - real(r8), intent(in) :: phis ! Global grid surface geopotential (m2/s2) - real(r8), intent(in) :: zmid(plev) ! Global grid height (m) - real(r8), intent(in) :: zint(plev+1)! Global grid interface height (m) - real(r8), intent(in) :: qrad_crm(crm_nx, crm_ny, crm_nz) ! CRM rad. heating - real(r8), intent(in) :: dt_gl ! global model's time step - real(r8), intent(in) :: ocnfrac ! area fraction of the ocean - real(r8), intent(in) :: tau00 ! large-scale surface stress (N/m2) - real(r8), intent(in) :: wndls ! large-scale surface wind (m/s) - real(r8), intent(in) :: bflxls ! large-scale surface buoyancy flux (K m/s) - real(r8), intent(in) :: fluxu00 ! surface momenent fluxes [N/m2] - real(r8), intent(in) :: fluxv00 ! surface momenent fluxes [N/m2] - real(r8), intent(in) :: fluxt00 ! surface sensible heat fluxes [K Kg/ (m2 s)] - real(r8), intent(in) :: fluxq00 ! surface latent heat fluxes [ kg/(m2 s)] -! logical, intent(in) :: doshort ! compute shortwave radiation -! logical, intent(in) :: dolong ! compute longwave radiation -! real(r8), intent(in) :: day00 ! initial day -! real(r8), intent(in) :: latitude00 -! real(r8), intent(in) :: longitude00 -! real(r8), intent(in) :: pres00 -! real(r8), intent(in) :: tabs_s0 -! integer , intent(in) :: nrad0 -! character *40 case0 ! 8-symbol id-string to identify a case-name - - -! tl, ql, qccl, qiil, ul, vl are not updated in this subroutine, and set to intent(in), but -! not intent(inout). +++mhwang - real(r8), intent(in) :: tl(plev) ! Global grid temperature (K) - real(r8), intent(in) :: ql(plev) ! Global grid water vapor (g/g) - real(r8), intent(in) :: qccl(plev)! Global grid cloud liquid water (g/g) - real(r8), intent(in) :: qiil(plev)! Global grid cloud ice (g/g) - real(r8), intent(in) :: ul(plev) ! Global grid u (m/s) - real(r8), intent(in) :: vl(plev) ! Global grid v (m/s) - -! Input/Output: -#ifdef SPCAM_CLUBB_SGS - real(r8), intent(inout), target :: clubb_buffer(crm_nx, crm_ny, crm_nz+1,1:nclubbvars) - real(r8), intent(inout) :: crm_cld(crm_nx, crm_ny, crm_nz+1) - real(r8), intent(inout) :: clubb_tk(crm_nx, crm_ny, crm_nz) - real(r8), intent(inout) :: clubb_tkh(crm_nx, crm_ny, crm_nz) - real(r8), intent(inout) :: relvar(crm_nx, crm_ny, crm_nz) - real(r8), intent(inout) :: accre_enhan(crm_nx, crm_ny, crm_nz) - real(r8), intent(inout) :: qclvar(crm_nx, crm_ny, crm_nz) -#endif - real(r8), intent(inout) :: crm_tk(crm_nx, crm_ny, crm_nz) - real(r8), intent(inout) :: crm_tkh(crm_nx, crm_ny, crm_nz) - - real(r8), intent(inout) :: cltot ! shaded cloud fraction - real(r8), intent(inout) :: clhgh ! shaded cloud fraction - real(r8), intent(inout) :: clmed ! shaded cloud fraction - real(r8), intent(inout) :: cllow ! shaded cloud fraction - - -! Output - - real(r8), intent(inout) :: sltend(plev) ! tendency of static energy -! real(r8), intent(inout) :: u_crm (:,:,:) ! CRM v-wind component -! real(r8), intent(inout) :: v_crm (:,:,:) ! CRM v-wind component -! real(r8), intent(inout) :: w_crm (:,:,:) ! CRM w-wind component -! real(r8), intent(inout) :: t_crm (:,:,:) ! CRM temperuture - real(r8), intent(inout) :: u_crm (crm_nx,crm_ny,crm_nz) ! CRM v-wind component - real(r8), intent(inout) :: v_crm (crm_nx,crm_ny,crm_nz) ! CRM v-wind component - real(r8), intent(inout) :: w_crm (crm_nx,crm_ny,crm_nz) ! CRM w-wind component - real(r8), intent(inout) :: t_crm (crm_nx,crm_ny,crm_nz) ! CRM temperuture -! real(r8), intent(inout) :: micro_fields_crm (:,:,:,:) ! CRM total water - real(r8), intent(inout) :: micro_fields_crm (crm_nx,crm_ny,crm_nz,nmicro_fields+1) ! CRM total water - real(r8), intent(inout) :: qltend(plev) ! tendency of water vapor - real(r8), intent(inout) :: qcltend(plev)! tendency of cloud liquid water - real(r8), intent(inout) :: qiltend(plev)! tendency of cloud ice - real(r8), intent(inout) :: t_rad (crm_nx, crm_ny, crm_nz) ! rad temperuture - real(r8), intent(inout) :: qv_rad(crm_nx, crm_ny, crm_nz) ! rad vapor - real(r8), intent(inout) :: qc_rad(crm_nx, crm_ny, crm_nz) ! rad cloud water - real(r8), intent(inout) :: qi_rad(crm_nx, crm_ny, crm_nz) ! rad cloud ice - real(r8), intent(inout) :: cld_rad(crm_nx, crm_ny, crm_nz) ! rad cloud fraction - real(r8), intent(inout) :: cld3d_crm(crm_nx, crm_ny, crm_nz) ! instant 3D cloud fraction -#ifdef m2005 - real(r8), intent(inout) :: nc_rad(crm_nx, crm_ny, crm_nz) ! rad cloud droplet number (#/kg) - real(r8), intent(inout) :: ni_rad(crm_nx, crm_ny, crm_nz) ! rad cloud ice crystal number (#/kg) - real(r8), intent(inout) :: qs_rad(crm_nx, crm_ny, crm_nz) ! rad cloud snow (kg/kg) - real(r8), intent(inout) :: ns_rad(crm_nx, crm_ny, crm_nz) ! rad cloud snow crystal number (#/kg) - real(r8), intent(inout) :: wvar_crm(crm_nx, crm_ny, crm_nz) ! vertical velocity variance (m/s) -! hm 7/26/11 new output - real(r8), intent(inout) :: aut_crm(crm_nx, crm_ny, crm_nz) ! cloud water autoconversion (1/s) - real(r8), intent(inout) :: acc_crm(crm_nx, crm_ny, crm_nz) ! cloud water accretion (1/s) - real(r8), intent(inout) :: evpc_crm(crm_nx, crm_ny, crm_nz) ! cloud water evaporation (1/s) - real(r8), intent(inout) :: evpr_crm(crm_nx, crm_ny, crm_nz) ! rain evaporation (1/s) - real(r8), intent(inout) :: mlt_crm(crm_nx, crm_ny, crm_nz) ! ice, snow, graupel melting (1/s) - real(r8), intent(inout) :: sub_crm(crm_nx, crm_ny, crm_nz) ! ice, snow, graupel sublimation (1/s) - real(r8), intent(inout) :: dep_crm(crm_nx, crm_ny, crm_nz) ! ice, snow, graupel deposition (1/s) - real(r8), intent(inout) :: con_crm(crm_nx, crm_ny, crm_nz) ! cloud water condensation(1/s) -! hm 8/31/11 new output, gcm-grid and time step-avg - real(r8), intent(inout) :: aut_crm_a(plev) ! cloud water autoconversion (1/s) - real(r8), intent(inout) :: acc_crm_a(plev) ! cloud water accretion (1/s) - real(r8), intent(inout) :: evpc_crm_a(plev) ! cloud water evaporation (1/s) - real(r8), intent(inout) :: evpr_crm_a(plev) ! rain evaporation (1/s) - real(r8), intent(inout) :: mlt_crm_a(plev) ! ice, snow, graupel melting (1/s) - real(r8), intent(inout) :: sub_crm_a(plev) ! ice, snow, graupel sublimation (1/s) - real(r8), intent(inout) :: dep_crm_a(plev) ! ice, snow, graupel deposition (1/s) - real(r8), intent(inout) :: con_crm_a(plev) ! cloud water condensation(1/s) -#endif - real(r8), intent(inout) :: precc ! convective precip rate (m/s) - real(r8), intent(inout) :: precl ! stratiform precip rate (m/s) - real(r8), intent(inout) :: cld(plev) ! cloud fraction - real(r8), intent(inout) :: cldtop(plev) ! cloud top pdf - real(r8), intent(inout) :: gicewp(plev) ! ice water path - real(r8), intent(inout) :: gliqwp(plev) ! ice water path - real(r8), intent(inout) :: mc(plev) ! cloud mass flux - real(r8), intent(inout) :: mcup(plev) ! updraft cloud mass flux - real(r8), intent(inout) :: mcdn(plev) ! downdraft cloud mass flux - real(r8), intent(inout) :: mcuup(plev) ! unsat updraft cloud mass flux - real(r8), intent(inout) :: mcudn(plev) ! unsat downdraft cloud mass flux - real(r8), intent(inout) :: crm_qc(plev) ! mean cloud water - real(r8), intent(inout) :: crm_qi(plev) ! mean cloud ice - real(r8), intent(inout) :: crm_qs(plev) ! mean snow - real(r8), intent(inout) :: crm_qg(plev) ! mean graupel - real(r8), intent(inout) :: crm_qr(plev) ! mean rain -#ifdef m2005 - real(r8), intent(inout) :: crm_nc(plev) ! mean cloud water (#/kg) - real(r8), intent(inout) :: crm_ni(plev) ! mean cloud ice (#/kg) - real(r8), intent(inout) :: crm_ns(plev) ! mean snow (#/kg) - real(r8), intent(inout) :: crm_ng(plev) ! mean graupel (#/kg) - real(r8), intent(inout) :: crm_nr(plev) ! mean rain (#/kg) -#ifdef MODAL_AERO - real(r8), intent(in) :: naermod(plev, ntot_amode) ! Aerosol number concentration [/m3] - real(r8), intent(in) :: vaerosol(plev, ntot_amode) ! aerosol volume concentration [m3/m3] - real(r8), intent(in) :: hygro(plev, ntot_amode) ! hygroscopicity of aerosol mode -#endif -#endif - real(r8), intent(inout) :: mu_crm (plev) ! mass flux up - real(r8), intent(inout) :: md_crm (plev) ! mass flux down - real(r8), intent(inout) :: du_crm (plev) ! mass detrainment from updraft - real(r8), intent(inout) :: eu_crm (plev) ! mass entrainment from updraft - real(r8), intent(inout) :: ed_crm (plev) ! mass detrainment from downdraft - real(r8) :: dd_crm (plev) ! mass entraiment from downdraft - real(r8), intent(inout) :: jt_crm ! index of cloud (convection) top - real(r8), intent(inout) :: mx_crm ! index of cloud (convection) bottom - real(r8) :: mui_crm (plev+1) ! mass flux up at the interface - real(r8) :: mdi_crm (plev+1) ! mass flux down at the interface - - real(r8), intent(inout) :: flux_qt(plev) ! nonprecipitating water flux [kg/m2/s] - real(r8), intent(inout) :: fluxsgs_qt(plev) ! sgs nonprecipitating water flux [kg/m2/s] - real(r8), intent(inout) :: tkez(plev) ! tke profile [kg/m/s2] - real(r8), intent(inout) :: tkesgsz(plev) ! sgs tke profile [kg/m/s2] - real(r8), intent(inout) :: tkz(plev) ! tk profile [m2/s] - real(r8), intent(inout) :: flux_u(plev) ! x-momentum flux [m2/s2] - real(r8), intent(inout) :: flux_v(plev) ! y-momentum flux [m2/s2] - real(r8), intent(inout) :: flux_qp(plev) ! precipitating water flux [kg/m2/s or mm/s] - real(r8), intent(inout) :: pflx(plev) ! precipitation flux [m/s] - real(r8), intent(inout) :: qt_ls(plev) ! tendency of nonprec water due to large-scale [kg/kg/s] - real(r8), intent(inout) :: qt_trans(plev)! tendency of nonprec water due to transport [kg/kg/s] - real(r8), intent(inout) :: qp_trans(plev) ! tendency of prec water due to transport [kg/kg/s] - real(r8), intent(inout) :: qp_fall(plev) ! tendency of prec water due to fall-out [kg/kg/s] - real(r8), intent(inout) :: qp_src(plev) ! tendency of prec water due to conversion [kg/kg/s] - real(r8), intent(inout) :: qp_evp(plev) ! tendency of prec water due to evp [kg/kg/s] - real(r8), intent(inout) :: t_ls(plev) ! tendency of lwse due to large-scale [kg/kg/s] ??? - real(r8), intent(inout) :: prectend ! column integrated tendency in precipitating water+ice (kg/m2/s) - real(r8), intent(inout) :: precstend ! column integrated tendency in precipitating ice (kg/m2/s) - real(r8), intent(inout) :: precsc ! convective snow rate (m/s) - real(r8), intent(inout) :: precsl ! stratiform snow rate (m/s) - real(r8), intent(inout):: taux_crm ! zonal CRM surface stress perturbation (N/m2) - real(r8), intent(inout):: tauy_crm ! merid CRM surface stress perturbation (N/m2) - real(r8), intent(inout):: z0m ! surface stress (N/m2) - real(r8), intent(inout):: timing_factor ! crm cpu efficiency - real(r8), intent(inout) :: qc_crm (crm_nx, crm_ny, crm_nz)! CRM cloud water - real(r8), intent(inout) :: qi_crm (crm_nx, crm_ny, crm_nz)! CRM cloud ice - real(r8), intent(inout) :: qpc_crm(crm_nx, crm_ny, crm_nz)! CRM precip water - real(r8), intent(inout) :: qpi_crm(crm_nx, crm_ny, crm_nz)! CRM precip ice - real(r8), intent(inout) :: prec_crm(crm_nx, crm_ny)! CRM precipiation rate -#ifdef ECPP -! at layer center - real(r8), intent(inout) :: acen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud fraction for each sub-sub class for full time period - real(r8), intent(inout) :: acen_tf(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud fraction for end-portion of time period - real(r8), intent(inout) :: rhcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! relative humidity (0-1) - real(r8), intent(inout) :: qcloudcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud water (kg/kg) - real(r8), intent(inout) :: qicecen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud ice (kg/kg) - real(r8), intent(inout) :: qlsinkcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud water loss rate from precipitation (/s??) - real(r8), intent(inout) :: precrcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! liquid (rain) precipitation rate (kg/m2/s) - real(r8), intent(inout) :: precsolidcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! solid (rain) precipitation rate (kg/m2/s) - real(r8), intent(inout) :: qlsink_bfcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud water loss rate from precipitation calculated - ! cloud water before precipitatinog (/s) - real(r8), intent(inout) :: qlsink_avgcen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud water loss rate from precipitation calculated - ! from praincen and qlcoudcen averaged over - ! ntavg1_ss time step (/s??) - real(r8), intent(inout) :: praincen(plev,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud water loss rate from precipitation (kg/kg/s) - real(r8), intent(inout) :: wwqui_cen(plev) ! vertical velocity variance in quiescent class (m2/s2) - real(r8), intent(inout) :: wwqui_cloudy_cen(plev) ! vertical velocity variance in quiescent, and cloudy class (m2/s2) -! at layer boundary - real(r8), intent(inout) :: abnd(plev+1,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud fraction for each sub-sub class for full time period - real(r8), intent(inout) :: abnd_tf(plev+1,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! cloud fraction for end-portion of time period - real(r8), intent(inout) :: massflxbnd(plev+1,NCLASS_CL,ncls_ecpp_in,NCLASS_PR) ! sub-class vertical mass flux (kg/m2/s) at layer bottom boundary. - real(r8), intent(inout) :: wupthresh_bnd(plev+1) ! vertical velocity threshold for updraft (m/s) - real(r8), intent(inout) :: wdownthresh_bnd(plev+1) ! vertical velocity threshold for downdraft (m/s) - real(r8), intent(inout) :: wwqui_bnd(plev+1) ! vertical velocity variance in quiescent class (m2/s2) - real(r8), intent(inout) :: wwqui_cloudy_bnd(plev+1) ! vertical velocity variance in quiescent, and cloudy class (m2/s2) -#endif - -! Local space: - real dummy(nz), t00(nz) - real fluxbtmp(nx,ny), fluxttmp(nx,ny) !bloss - real tln(plev), qln(plev), qccln(plev), qiiln(plev), uln(plev), vln(plev) - real cwp(nx,ny), cwph(nx,ny), cwpm(nx,ny), cwpl(nx,ny) - real(r8) factor_xy, idt_gl - real tmp1, tmp2 - real u2z,v2z,w2z - integer i,j,k,l,ptop,nn,icyc, nstatsteps - integer kx - real(r8), parameter :: umax = 0.5*crm_dx/crm_dt ! maxumum ampitude of the l.s. wind - real(r8), parameter :: wmin = 2. ! minimum up/downdraft velocity for stat - real, parameter :: cwp_threshold = 0.001 ! threshold for cloud condensate for shaded fraction calculation - logical flag_top(nx,ny) - real ustar, bflx, wnd, z0_est, qsat, omg - real colprec,colprecs - real(r8) zs ! surface elevation - integer igstep ! GCM time steps - integer iseed ! seed for random perturbation - integer gcolindex(pcols) ! array of global latitude indices - -#ifdef SPCAM_CLUBB_SGS -!Array indicies for spurious RTM check - -real(kind=core_rknd) :: & - rtm_integral_before(nx,ny), rtm_integral_after(nx,ny), rtm_flux_top, rtm_flux_sfc -real(kind=core_rknd) :: & - thlm_integral_before(nx,ny), thlm_integral_after(nx,ny), thlm_before(nzm), thlm_after(nzm), & - thlm_flux_top, thlm_flux_sfc - -real(kind=core_rknd), dimension(nzm) :: & - rtm_column ! Total water (vapor + liquid) [kg/kg] -#endif - - real cltemp(nx,ny), cmtemp(nx,ny), chtemp(nx, ny), cttemp(nx, ny) - - real(r8), intent(inout) :: qtot(20) - real ntotal_step - -!----------------------------------------------- - - dostatis = .false. ! no statistics are collected. - idt_gl = 1._r8/dt_gl - ptop = plev-nzm+1 - factor_xy = 1._r8/dble(nx*ny) - dummy = 0. - t_rad = 0. - qv_rad = 0. - qc_rad = 0. - qi_rad = 0. - cld_rad = 0. -#ifdef m2005 - nc_rad = 0.0 - ni_rad = 0.0 - qs_rad = 0.0 - ns_rad = 0.0 -#endif - zs=phis/ggr - bflx = bflxls - wnd = wndls - -!----------------------------------------- - igstep = get_nstep() - -#ifdef SPCAM_CLUBB_SGS - if(igstep == 1) then - lrestart_clubb = .false. - else - lrestart_clubb = .true. - endif -#endif - - call task_init () - - call setparm() - -! doshortwave = doshort -! dolongwave = dolong -! day0 = day00-dt_gl/86400. -! latitude = latitude00 -! longitude = longitude00 -! pres0 = pres00 -! tabs_s = tabs_s0 -! case = case0 - - latitude0 = get_rlat_p(lchnk, icol)*57.296_r8 - longitude0 = get_rlon_p(lchnk, icol)*57.296_r8 -! pi = acos(-1.) - if(fcor.eq.-999.) fcor= 4*pi/86400.*sin(latitude0*pi/180.) - fcorz = sqrt(4.*(2*pi/(3600.*24.))**2-fcor**2) - fcory(:) = fcor - fcorzy(:) = fcorz - do j=1,ny - do i=1,nx - latitude(i,j) = latitude0 - longitude(i,j) = longitude0 - end do - end do - - if(ocnfrac.gt.0.5) then - OCEAN = .true. - else - LAND = .true. - end if - -! create CRM vertical grid and initialize some vertical reference arrays: -! - do k = 1, nzm - - z(k) = zmid(plev-k+1) - zint(plev+1) - zi(k) = zint(plev-k+2)- zint(plev+1) - pres(k) = pmid(plev-k+1)/100. - prespot(k)=(1000./pres(k))**(rgas/cp) - bet(k) = ggr/tl(plev-k+1) - gamaz(k)=ggr/cp*z(k) - - end do ! k -! zi(nz) = zint(plev-nz+2) - zi(nz) = zint(plev-nz+2)-zint(plev+1) !+++mhwang, 2012-02-04 - - dz = 0.5*(z(1)+z(2)) - do k=2,nzm - adzw(k) = (z(k)-z(k-1))/dz - end do - adzw(1) = 1. - adzw(nz) = adzw(nzm) -! adz(1) = 1. -! do k=2,nzm-1 -! adz(k) = 0.5*(z(k+1)-z(k-1))/dz -! end do -! adz(nzm) = adzw(nzm) -!+++mhwang fix the adz bug. (adz needs to be consistent with zi) -!2012-02-04 Minghuai Wang (minghuai.wang@pnnl.gov) - do k=1, nzm - adz(k)=(zi(k+1)-zi(k))/dz - end do - - do k = 1,nzm - rho(k) = pdel(plev-k+1)/ggr/(adz(k)*dz) - end do - do k=2,nzm -! rhow(k) = 0.5*(rho(k)+rho(k-1)) -!+++mhwang fix the rhow bug (rhow needes to be consistent with pmid) -!2012-02-04 Minghuai Wang (minghuai.wang@pnnl.gov) - rhow(k) = (pmid(plev-k+2)-pmid(plev-k+1))/ggr/(adzw(k)*dz) - end do - rhow(1) = 2*rhow(2) - rhow(3) -#ifdef SPCAM_CLUBB_SGS /* Fix extropolation for 30 point grid */ - if ( 2*rhow(nzm) - rhow(nzm-1) > 0. ) then - rhow(nz)= 2*rhow(nzm) - rhow(nzm-1) - else - rhow(nz)= sqrt( rhow(nzm) ) - endif -#else - rhow(nz)= 2*rhow(nzm) - rhow(nzm-1) -#endif /*CLUBB_SGS*/ - colprec=0 - colprecs=0 - -! -! Initialize: -! - - -! limit the velocity at the very first step: - - if(u_crm(1,1,1).eq.u_crm(2,1,1).and.u_crm(3,1,2).eq.u_crm(4,1,2)) then - do k=1,nzm - do j=1,ny - do i=1,nx - u_crm(i,j,k) = min( umax, max(-umax,u_crm(i,j,k)) ) - v_crm(i,j,k) = min( umax, max(-umax,v_crm(i,j,k)) )*YES3D - end do - end do - end do - - end if - - u(1:nx,1:ny,1:nzm) = u_crm(1:nx,1:ny,1:nzm) - v(1:nx,1:ny,1:nzm) = v_crm(1:nx,1:ny,1:nzm)*YES3D - w(1:nx,1:ny,1:nzm) = w_crm(1:nx,1:ny,1:nzm) - tabs(1:nx,1:ny,1:nzm) = t_crm(1:nx,1:ny,1:nzm) - micro_field(1:nx,1:ny,1:nzm,1:nmicro_fields) = micro_fields_crm(1:nx,1:ny,1:nzm,1:nmicro_fields) -#ifdef sam1mom - qn(1:nx,1:ny,1:nzm) = micro_fields_crm(1:nx,1:ny,1:nzm,3) -#endif - -#ifdef m2005 - cloudliq(1:nx,1:ny,1:nzm) = micro_fields_crm(1:nx,1:ny,1:nzm,11) -#endif - -#ifdef m2005 - do k=1, nzm -#ifdef MODAL_AERO -! set aerosol data - l=plev-k+1 - naer(k, 1:ntot_amode) = naermod(l, 1:ntot_amode) - vaer(k, 1:ntot_amode) = vaerosol(l, 1:ntot_amode) - hgaer(k, 1:ntot_amode) = hygro(l, 1:ntot_amode) -#endif - do j=1, ny - do i=1, nx -! if(micro_field(i,j,k,iqcl).gt.0) then - if(cloudliq(i,j,k).gt.0) then - if(dopredictNc) then - if( micro_field(i,j,k,incl).eq.0) micro_field(i,j,k,incl) = 1.0e6*Nc0/rho(k) - endif - end if - enddo - enddo - enddo -#endif - - w(:,:,nz)=0. - wsub (:) = 0. !used in clubb, +++mhwang - dudt(:,:,:,1:3) = 0. - dvdt(:,:,:,1:3) = 0. - dwdt(1:nx,1:ny,1:nz,1:3) = 0. - tke(1:nx,1:ny,1:nzm) = 0. - tk(1:nx,1:ny,1:nzm) = 0. - tkh(1:nx,1:ny,1:nzm) = 0. - p(1:nx,1:ny,1:nzm) = 0. - - CF3D(1:nx,1:ny,1:nzm) = 1. - - call micro_init - -! initialize sgs fields - call sgs_init - - do k=1,nzm - - u0(k)=0. - v0(k)=0. - t0(k)=0. - t00(k)=0. - tabs0(k)=0. - q0(k)=0. - qv0(k)=0. -!+++mhwang these are not initialized ?? - qn0(k) = 0.0 - qp0(k) = 0.0 - tke0(k) = 0.0 -!---mhwang - do j=1,ny - do i=1,nx - - t(i,j,k) = tabs(i,j,k)+gamaz(k) & - -fac_cond*qcl(i,j,k)-fac_sub*qci(i,j,k) & - -fac_cond*qpl(i,j,k)-fac_sub*qpi(i,j,k) - - colprec=colprec+(qpl(i,j,k)+qpi(i,j,k))*pdel(plev-k+1) - colprecs=colprecs+qpi(i,j,k)*pdel(plev-k+1) - u0(k)=u0(k)+u(i,j,k) - v0(k)=v0(k)+v(i,j,k) - t0(k)=t0(k)+t(i,j,k) - t00(k)=t00(k)+t(i,j,k)+fac_cond*qpl(i,j,k)+fac_sub*qpi(i,j,k) - tabs0(k)=tabs0(k)+tabs(i,j,k) - q0(k)=q0(k)+qv(i,j,k)+qcl(i,j,k)+qci(i,j,k) - qv0(k) = qv0(k) + qv(i,j,k) - qn0(k) = qn0(k) + qcl(i,j,k) + qci(i,j,k) - qp0(k) = qp0(k) + qpl(i,j,k) + qpi(i,j,k) - tke0(k)=tke0(k)+tke(i,j,k) - - end do - end do - - u0(k) = u0(k) * factor_xy - v0(k) = v0(k) * factor_xy - t0(k) = t0(k) * factor_xy - t00(k) = t00(k) * factor_xy - tabs0(k) = tabs0(k) * factor_xy - q0(k) = q0(k) * factor_xy - qv0(k) = qv0(k) * factor_xy - qn0(k) = qn0(k) * factor_xy - qp0(k) = qp0(k) * factor_xy - tke0(k) = tke0(k) * factor_xy - -#ifdef SPCAM_CLUBB_SGS - ! Update thetav for CLUBB. This is needed when we have a higher model top - ! than is in the sounding, because we subsequently use tv0 to initialize - ! thv_ds_zt/zm, which appear in CLUBB's anelastic buoyancy terms. - ! -dschanen UWM 11 Feb 2010 - tv0(k) = tabs0(k)*prespot(k)*(1.+epsv*q0(k)) -#endif - - l = plev-k+1 - uln(l) = min( umax, max(-umax,ul(l)) ) - vln(l) = min( umax, max(-umax,vl(l)) )*YES3D - ttend(k) = (tl(l)+gamaz(k)- & - fac_cond*(qccl(l)+qiil(l))-fac_fus*qiil(l)-t00(k))*idt_gl - qtend(k) = (ql(l)+qccl(l)+qiil(l)-q0(k))*idt_gl - utend(k) = (uln(l)-u0(k))*idt_gl - vtend(k) = (vln(l)-v0(k))*idt_gl - ug0(k) = uln(l) - vg0(k) = vln(l) - tg0(k) = tl(l)+gamaz(k)-fac_cond*qccl(l)-fac_sub*qiil(l) - qg0(k) = ql(l)+qccl(l)+qiil(l) - - end do ! k - - uhl = u0(1) - vhl = v0(1) - -! estimate roughness length assuming logarithmic profile of velocity near the surface: - - ustar = sqrt(tau00/rho(1)) - z0 = z0_est(z(1),bflx,wnd,ustar) - z0 = max(0.00001,min(1.,z0)) - - timing_factor = 0. - - prectend=colprec - precstend=colprecs - -#ifdef SPCAM_CLUBB_SGS - if(doclubb) then - fluxbu(:, :) = fluxu00/rhow(1) - fluxbv(:, :) = fluxv00/rhow(1) - fluxbt(:, :) = fluxt00/rhow(1) - fluxbq(:, :) = fluxq00/rhow(1) - else - fluxbu(:, :) = 0. - fluxbv(:, :) = 0. - fluxbt(:, :) = 0. - fluxbq(:, :) = 0. - end if -#else - fluxbu=0. - fluxbv=0. - fluxbt=0. - fluxbq=0. -#endif /*CLUBB_SGS*/ - - fluxtu=0. - fluxtv=0. - fluxtt=0. - fluxtq=0. - fzero =0. - precsfc=0. - precssfc=0. - -!--------------------------------------------------- - cld = 0. - cldtop = 0. - gicewp=0 - gliqwp=0 - mc = 0. - mcup = 0. - mcdn = 0. - mcuup = 0. - mcudn = 0. - crm_qc = 0. - crm_qi = 0. - crm_qs = 0. - crm_qg = 0. - crm_qr = 0. -#ifdef m2005 - crm_nc = 0. - crm_ni = 0. - crm_ns = 0. - crm_ng = 0. - crm_nr = 0. -! hm 8/31/11 add new variables - aut_crm_a = 0. - acc_crm_a = 0. - evpc_crm_a = 0. - evpr_crm_a = 0. - mlt_crm_a = 0. - sub_crm_a = 0. - dep_crm_a = 0. - con_crm_a = 0. - -! hm 8/31/11 add new output -! these are increments added to calculate gcm-grid and time-step avg -! note - these values are also averaged over the icycle loop following -! the approach for precsfc - aut1a = 0. - acc1a = 0. - evpc1a = 0. - evpr1a = 0. - mlt1a = 0. - sub1a = 0. - dep1a = 0. - con1a = 0. - -#endif - - mu_crm = 0. - md_crm = 0. - eu_crm = 0. - du_crm = 0. - ed_crm = 0. - dd_crm = 0. - jt_crm = 0. - mx_crm = 0. - - mui_crm = 0. - mdi_crm = 0. - - flux_qt = 0. - flux_u = 0. - flux_v = 0. - fluxsgs_qt = 0. - tkez = 0. - tkesgsz = 0. - tkz = 0. - flux_qp = 0. - pflx = 0. - qt_trans = 0. - qp_trans = 0. - qp_fall = 0. - qp_evp = 0. - qp_src = 0. - qt_ls = 0. - t_ls = 0. - - uwle = 0. - uwsb = 0. - vwle = 0. - vwsb = 0. - qpsrc = 0. - qpevp = 0. - qpfall = 0. - precflux = 0. - - prec_xy = 0.0 - total_water_evap = 0.0 - total_water_prec = 0.0 - tlat = 0.0 - pw_xy = 0.0; cw_xy=0.0; iw_xy = 0.0 - usfc_xy = 0.0; vsfc_xy =0.0; u200_xy =0.0; v200_xy = 0.0; w500_xy = 0.0 - swvp_xy = 0.0; psfc_xy = 0.0; u850_xy = 0.0; v850_xy = 0.0 - -!-------------------------------------------------- -#ifdef sam1mom - if(doprecip) call precip_init() -#endif - - call get_gcol_all_p(lchnk, pcols, gcolindex) - iseed = gcolindex(icol) - if(u(1,1,1).eq.u(2,1,1).and.u(3,1,2).eq.u(4,1,2)) & - call setperturb(iseed) - -#ifndef SPCAM_CLUBB_SGS -!-------------------------- -! do a CLUBB sanity check - if ( doclubb .or. doclubbnoninter ) then - write(0,*) "Cannot call CLUBB if -DCLUBB is not in FFLAGS" - call endrun('crm main') - end if -#endif /*CLUBB_SGS*/ -#ifdef SPCAM_CLUBB_SGS -!------------------------------------------------------------------ -! Do initialization for UWM CLUBB -!------------------------------------------------------------------ - up2(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 1) - vp2(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 2) - wprtp(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 3) - wpthlp(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 4) - wp2(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 5) - wp3(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 6) - rtp2(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 7) - thlp2(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 8) - rtpthlp(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 9) - upwp(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 10) - vpwp(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 11) - cloud_frac(1:nx, 1:ny, 1:nz) = clubb_buffer(1:nx, 1:ny, 1:nz, 12) - t_tndcy(1:nx, 1:ny, 1:nzm) = clubb_buffer(1:nx, 1:ny, 1:nzm, 13) - qc_tndcy(1:nx, 1:ny, 1:nzm) = clubb_buffer(1:nx, 1:ny, 1:nzm, 14) - qv_tndcy(1:nx, 1:ny, 1:nzm) = clubb_buffer(1:nx, 1:ny, 1:nzm, 15) - u_tndcy(1:nx, 1:ny, 1:nzm) = clubb_buffer(1:nx, 1:ny, 1:nzm, 16) - v_tndcy(1:nx, 1:ny, 1:nzm) = clubb_buffer(1:nx, 1:ny, 1:nzm, 17) - -! -! since no tracer is carried in the current version of MMF, these -! tracer-related restart varialbes are set to zero. +++mhwang, 2011-08 - tracer_tndcy = 0.0 - sclrp2 = 0.0 - sclrprtp = 0.0 - sclrpthlp = 0.0 - wpsclrp =0.0 - - if((doclubb.and.docloud).or.(.not.doclubb .and. .not.docloud)) then - write(0, *) 'doclubb and docloud can not both be true or be false' - call endrun('crm_clubb2') - end if - if((doclubb_sfc_fluxes.and.docam_sfc_fluxes)) then - write(0, *) 'doclubb_sfc_fluxes and dosam_sfc_fluxes can not both be true' - call endrun('crm_clubb_fluxes') - end if - - if ( doclubb .or. doclubbnoninter ) then - call clubb_sgs_setup( real( dt*real( nclubb ), kind=time_precision), & - latitude, longitude, z, rho, zi, rhow, tv0, tke ) - end if -#endif /*CLUBB_SGS*/ - -#ifdef ECPP -! ntavg1_ss = dt_gl/3 ! one third of GCM time step, 10 minutes - ntavg1_ss = min(600._r8, dt_gl) ! 10 minutes or the GCM timestep, whichever smaller - ! ntavg1_ss = number of seconds to average between computing categories. - ntavg2_ss = dt_gl ! GCM time step - ! ntavg2_ss = number of seconds to average between outputs. - ! This must be a multiple of ntavgt1_ss. -! -! ecpp_crm_init has to be called after ntavg1_ss and ntavg2_ss are set for -! their values are used in ecpp_crm_init. - call ecpp_crm_init() - - qlsink = 0.0 - qlsink_bf = 0.0 - prain = 0.0 - precr = 0.0 - precsolid = 0.0 -#endif /*ECPP*/ - -!+++mhwangtest -! test water conservtion problem - ntotal_step = 0.0 - qtot(:) = 0.0 - qtotmicro(:) = 0.0 - do k=1, nzm - l=plev-k+1 - do j=1, ny - do i=1, nx -#ifdef m2005 - qtot(1) = qtot(1)+((micro_field(i,j,k,iqr)+micro_field(i,j,k,iqs)+micro_field(i,j,k,iqg)) * pdel(l)/ggr)/(nx*ny) -#endif -#ifdef sam1mom - qtot(1) = qtot(1)+(qpl(i,j,k)+qpi(i,j,k)) * pdel(l)/ggr/(nx*ny) -#endif - enddo - enddo - qtot(1) = qtot(1) + (ql(l)+qccl(l)+qiil(l)) * pdel(l)/ggr - enddo -!---mhwangtest - - nstop = dt_gl/dt - dt = dt_gl/nstop - nsave3D = nint(60/dt) -! if(nint(nsave3D*dt).ne.60)then -! print *,'CRM: time step=',dt,' is not divisible by 60 seconds' -! print *,'this is needed for output every 60 seconds' -! stop -! endif - nstep = 0 - nprint = 1 - ncycle = 0 -! nrad = nstop/nrad0 - day=day0 - -!------------------------------------------------------------------ -! Main time loop -!------------------------------------------------------------------ - -do while(nstep.lt.nstop) - - nstep = nstep + 1 - time = time + dt - day = day0 + time/86400. - timing_factor = timing_factor+1 -!------------------------------------------------------------------ -! Check if the dynamical time step should be decreased -! to handle the cases when the flow being locally linearly unstable -!------------------------------------------------------------------ - - ncycle = 1 - - call kurant() - - do icyc=1,ncycle - - icycle = icyc - dtn = dt/ncycle - dt3(na) = dtn - dtfactor = dtn/dt - -!--------------------------------------------- -! the Adams-Bashforth scheme in time - - call abcoefs() - -!--------------------------------------------- -! initialize stuff: - - call zero() - -!----------------------------------------------------------- -! Buoyancy term: - - call buoyancy() - -!+++mhwangtest -! test water conservtion problem - ntotal_step = ntotal_step + 1. -!---mhwangtest - -!------------------------------------------------------------ -! Large-scale and surface forcing: - - call forcing() - - do k=1,nzm - do j=1,ny - do i=1,nx - t(i,j,k) = t(i,j,k) + qrad_crm(i,j,k)*dtn - end do - end do - end do - -!---------------------------------------------------------- -! suppress turbulence near the upper boundary (spange): - - if(dodamping) call damping() - -!--------------------------------------------------------- -! Ice fall-out - -#ifdef SPCAM_CLUBB_SGS - if ( docloud .or. doclubb ) then - call ice_fall() - end if -#else - if(docloud) then - call ice_fall() - end if -#endif /*CLUBB_SGS*/ - -!---------------------------------------------------------- -! Update scalar boundaries after large-scale processes: - - call boundaries(3) - -!--------------------------------------------------------- -! Update boundaries for velocities: - - call boundaries(0) - -!----------------------------------------------- -! surface fluxes: - - if(dosurface) call crmsurface(bflx) - -!----------------------------------------------------------- -! SGS physics: - - if (dosgs) call sgs_proc() - -#ifdef CLUBB_CRM_OLD -!---------------------------------------------------------- -! Do a timestep with CLUBB if enabled: -! -dschanen UWM 16 May 2008 - - if ( doclubb .or. doclubbnoninter ) then - ! In case of ice fall, we recompute qci here for the - ! single-moment scheme. Also, subsidence, diffusion and advection have - ! been applied to micro_field but not qv/qcl so they must be updated. - call micro_update() - end if ! doclubb .or. doclubbnoninter - - if ( doclubb ) then - ! Calculate the vertical integrals for RTM and THLM so we can later - ! calculate whether CLUBB is a spurious source or sink of either. - ! - nielsenb UWM 4 Jun 2010 - do i = 1,nx - do j = 1,ny - rtm_column = qv(i,j,1:nzm) + qcl(i,j,1:nzm) - rtm_integral_before(i,j) = vertical_integral( (nz - 2 + 1), rho_ds_zt(2:nz), & - rtm_column, gr%invrs_dzt(2:nz) ) - - thlm_before = t2thetal( t(i,j,1:nzm), gamaz(1:nzm), & - qcl(i,j,1:nzm), qpl(i,j,1:nzm), & - qci(i,j,1:nzm), qpi(i,j,1:nzm), & - prespot(1:nzm) ) - - thlm_integral_before(i,j) = vertical_integral( (nz - 2 + 1), rho_ds_zt(2:nz), & - thlm_before(1:nzm), gr%invrs_dzt(2:nz) ) - end do - end do - ! End vertical integral - - end if ! doclubb - - if ( doclubb .or. doclubbnoninter ) then - - ! We call CLUBB here because adjustments to the wind - ! must occur prior to adams() -dschanen 26 Aug 2008 - ! Here we call clubb only if nstep divides the current timestep, - ! or we're on the very first timestep - if ( nstep == 1 .or. mod( nstep, nclubb ) == 0 ) then - - call advance_clubb_sgs & - ( real( dtn*real( nclubb ), kind=time_precision), & ! in - real( 0., kind=time_precision ), & ! in - real( time, kind=time_precision ), & ! in - rho, rhow, wsub, u, v, w, qpl, qci, qpi, & ! in - t, qv, qcl ) ! in - end if ! nstep == 1 .or. mod( nstep, nclubb) == 0 - - end if ! doclubb .or. doclubbnoninter - -#endif /*CLUBB_CRM_OLD*/ -!---------------------------------------------------------- -! Fill boundaries for SGS diagnostic fields: - - call boundaries(4) -!----------------------------------------------- -! advection of momentum: - - call advect_mom() - -!---------------------------------------------------------- -! SGS effects on momentum: - - if(dosgs) call sgs_mom() -#ifdef CLUBB_CRM_OLD - if ( doclubb ) then -! call apply_clubb_sgs_tndcy_mom & -! ( dudt, dvdt ) ! in/out - endif -#endif /*CLUBB_CRM_OLD*/ - -!----------------------------------------------------------- -! Coriolis force: - - if(docoriolis) call coriolis() - -!--------------------------------------------------------- -! compute rhs of the Poisson equation and solve it for pressure. - - call pressure() - -!--------------------------------------------------------- -! find velocity field at n+1/2 timestep needed for advection of scalars: -! Note that at the end of the call, the velocities are in nondimensional form. - - call adams() - -!---------------------------------------------------------- -! Update boundaries for all prognostic scalar fields for advection: - - call boundaries(2) - -!--------------------------------------------------------- -! advection of scalars : - - call advect_all_scalars() - -!----------------------------------------------------------- -! Convert velocity back from nondimensional form: - - call uvw() - -!---------------------------------------------------------- -! Update boundaries for scalars to prepare for SGS effects: - - call boundaries(3) - -!--------------------------------------------------------- -! SGS effects on scalars : - - if (dosgs) call sgs_scalars() - -#ifdef CLUBB_CRM_OLD - ! Re-compute q/qv/qcl based on values computed in CLUBB - if ( doclubb ) then - - ! Recalculate q, qv, qcl based on new micro_fields (updated by horizontal - ! diffusion) - call micro_update() - - ! Then Re-compute q/qv/qcl based on values computed in CLUBB - call apply_clubb_sgs_tndcy_scalars & - ( real( dtn, kind=time_precision), & ! in - t, qv, qcl) ! in/out - - call micro_adjust( qv, qcl ) ! in - - ! Calculate the vertical integrals for RTM and THLM again so - ! calculate whether CLUBB is a spurious source or sink of either. - ! - nielsenb UWM 4 Jun 2010 - do i = 1,nx - do j = 1,ny - rtm_flux_top = rho_ds_zm(nz) * wprtp(i,j,nz) - rtm_flux_sfc = rho_ds_zm(1) * fluxbq(i,j) - rtm_column = qv(i,j,1:nzm) + qcl(i,j,1:nzm) - rtm_integral_after(i,j) = vertical_integral( (nz - 2 + 1), rho_ds_zt(2:nz), & - rtm_column, gr%invrs_dzt(2:nz) ) - - rtm_spurious_source(i,j) = calculate_spurious_source( rtm_integral_after(i,j), & - rtm_integral_before(i,j), & - rtm_flux_top, rtm_flux_sfc, & - 0.0_core_rknd, real( dtn, kind=core_rknd) ) - - thlm_flux_top = rho_ds_zm(nz) * wpthlp(i,j,nz) - thlm_flux_sfc = rho_ds_zm(1) * fluxbt(i,j) - - thlm_after = t2thetal( t(i,j,1:nzm), gamaz(1:nzm), & - qcl(i,j,1:nzm), qpl(i,j,1:nzm), & - qci(i,j,1:nzm), qpi(i,j,1:nzm), & - prespot(1:nzm) ) - - thlm_integral_after(i,j) = vertical_integral( (nz - 2 + 1), rho_ds_zt(2:nz), & - thlm_after(1:nzm), gr%invrs_dzt(2:nz)) - - thlm_spurious_source(i,j) = calculate_spurious_source( thlm_integral_after(i,j), & - thlm_integral_before(i,j), & - thlm_flux_top, thlm_flux_sfc, & - 0.0_core_rknd, real( dtn, kind=core_rknd )) - end do - end do - ! End spurious source calculation - - end if! doclubb -#endif /*CLUBB_CRM_OLD*/ - -!----------------------------------------------------------- -! Cloud condensation/evaporation and precipitation processes: -#ifdef SPCAM_CLUBB_SGS - if(docloud.or.dosmoke.or.doclubb) call micro_proc() -#else - if(docloud.or.dosmoke) call micro_proc() -#endif /*CLUBB_SGS*/ - -!----------------------------------------------------------- -! Compute diagnostics fields: - - call diagnose() - -!---------------------------------------------------------- -! Rotate the dynamic tendency arrays for Adams-bashforth scheme: - - nn=na - na=nc - nc=nb - nb=nn - - end do ! icycle - -!---------------------------------------------------------- -!---------------------------------------------------------- -#ifdef ECPP -! Here ecpp_crm_stat is called every CRM time step (dt), not every subcycle time step (dtn). -! This is what the original MMF model did (t_rad, qv_rad, ...). Do we want to call ecpp_crm_stat -! every subcycle time step??? +++mhwang - call ecpp_crm_stat() -#endif /*ECPP*/ - - cwp = 0. - cwph = 0. - cwpm = 0. - cwpl = 0. - - flag_top(:,:) = .true. - - cltemp = 0.0; cmtemp = 0.0 - chtemp = 0.0; cttemp = 0.0 - - do k=1,nzm - l = plev-k+1 - do j=1,ny - do i=1,nx - -! hm modify 9/7/11 for end of timestep, GCM-grid scale hydrometeor output -! instead of time-step-averaged -! I also modified this for all q and N variables as well as for sam1mom -! for consistency -!hm crm_qc(l) = crm_qc(l) + qcl(i,j,k) -!hm crm_qi(l) = crm_qi(l) + qci(i,j,k) -!hm crm_qr(l) = crm_qr(l) + qpl(i,j,k) -!hm#ifdef sam1mom -!hm omg = max(0.,min(1.,(tabs(i,j,k)-tgrmin)*a_gr)) -!hm crm_qg(l) = crm_qg(l) + qpi(i,j,k)*omg -!hm crm_qs(l) = crm_qs(l) + qpi(i,j,k)*(1.-omg) -!hm#else -! crm_qg(l) = crm_qg(l) + qpi(i,j,k) -! crm_qs(l) = crm_qs(l) + 0. ! temporerary solution -!hm crm_qg(l) = crm_qg(l) + micro_field(i,j,k,iqg) -!hm crm_qs(l) = crm_qs(l) + micro_field(i,j,k,iqs) - -!hm crm_nc(l) = crm_nc(l) + micro_field(i,j,k,incl) -!hm crm_ni(l) = crm_ni(l) + micro_field(i,j,k,inci) -!hm crm_nr(l) = crm_nr(l) + micro_field(i,j,k,inr) -!hm crm_ng(l) = crm_ng(l) + micro_field(i,j,k,ing) -!hm crm_ns(l) = crm_ns(l) + micro_field(i,j,k,ins) - -!hm#endif - - tmp1 = rho(nz-k)*adz(nz-k)*dz*(qcl(i,j,nz-k)+qci(i,j,nz-k)) - cwp(i,j) = cwp(i,j)+tmp1 - cttemp(i,j) = max(CF3D(i,j,nz-k), cttemp(i,j)) - if(cwp(i,j).gt.cwp_threshold.and.flag_top(i,j)) then - cldtop(k) = cldtop(k) + 1 - flag_top(i,j) = .false. - end if - if(pres(nz-k).ge.700.) then - cwpl(i,j) = cwpl(i,j)+tmp1 - cltemp(i,j) = max(CF3D(i,j,nz-k), cltemp(i,j)) - else if(pres(nz-k).lt.400.) then - cwph(i,j) = cwph(i,j)+tmp1 - chtemp(i,j) = max(CF3D(i,j,nz-k), chtemp(i,j)) - else - cwpm(i,j) = cwpm(i,j)+tmp1 - cmtemp(i,j) = max(CF3D(i,j,nz-k), cmtemp(i,j)) - end if - - ! qsat = qsatw_crm(tabs(i,j,k),pres(k)) - ! if(qcl(i,j,k)+qci(i,j,k).gt.min(1.e-5,0.01*qsat)) then - tmp1 = rho(k)*adz(k)*dz - if(tmp1*(qcl(i,j,k)+qci(i,j,k)).gt.cwp_threshold) then - cld(l) = cld(l) + CF3D(i,j,k) - if(w(i,j,k+1)+w(i,j,k).gt.2*wmin) then - mcup(l) = mcup(l) + rho(k)*0.5*(w(i,j,k+1)+w(i,j,k)) * CF3D(i,j,k) - mcuup(l) = mcuup(l) + rho(k)*0.5*(w(i,j,k+1)+w(i,j,k)) * (1.0 - CF3D(i,j,k)) - end if - if(w(i,j,k+1)+w(i,j,k).lt.-2*wmin) then - mcdn(l) = mcdn(l) + rho(k)*0.5*(w(i,j,k+1)+w(i,j,k)) * CF3D(i,j,k) - mcudn(l) = mcudn(l) + rho(k)*0.5*(w(i,j,k+1)+w(i,j,k)) * (1. - CF3D(i,j,k)) - end if - else - if(w(i,j,k+1)+w(i,j,k).gt.2*wmin) then - mcuup(l) = mcuup(l) + rho(k)*0.5*(w(i,j,k+1)+w(i,j,k)) - end if - if(w(i,j,k+1)+w(i,j,k).lt.-2*wmin) then - mcudn(l) = mcudn(l) + rho(k)*0.5*(w(i,j,k+1)+w(i,j,k)) - end if - end if - - t_rad (i,j,k) = t_rad (i,j,k)+tabs(i,j,k) - qv_rad(i,j,k) = qv_rad(i,j,k)+max(0.,qv(i,j,k)) - qc_rad(i,j,k) = qc_rad(i,j,k)+qcl(i,j,k) - qi_rad(i,j,k) = qi_rad(i,j,k)+qci(i,j,k) - cld_rad(i,j,k) = cld_rad(i,j,k) + CF3D(i,j,k) -#ifdef m2005 - nc_rad(i,j,k) = nc_rad(i,j,k)+micro_field(i,j,k,incl) - ni_rad(i,j,k) = ni_rad(i,j,k)+micro_field(i,j,k,inci) - qs_rad(i,j,k) = qs_rad(i,j,k)+micro_field(i,j,k,iqs) - ns_rad(i,j,k) = ns_rad(i,j,k)+micro_field(i,j,k,ins) -#endif - gliqwp(l)=gliqwp(l)+qcl(i,j,k) - gicewp(l)=gicewp(l)+qci(i,j,k) - - end do - end do - end do - -! Diagnose mass fluxes to drive CAM's convective transport of tracers. -! definition of mass fluxes is taken from Xu et al., 2002, QJRMS. - do k=1, nzm+1 - l=plev+1-k+1 - do j=1, ny - do i=1, nx - if(w(i,j,k).gt.0.) then - kx=max(1, k-1) - qsat = qsatw_crm(tabs(i,j,kx),pres(kx)) - if(qcl(i,j,kx)+qci(i,j,kx).gt.min(1.e-5,0.01*qsat)) then - mui_crm(l) = mui_crm(l)+rhow(k)*w(i,j,k) - end if - else if (w(i,j,k).lt.0.) then - kx=min(k+1, nzm) - qsat = qsatw_crm(tabs(i,j,kx),pres(kx)) - if(qcl(i,j,kx)+qci(i,j,kx).gt.min(1.e-5,0.01*qsat)) then - mdi_crm(l) = mdi_crm(l)+rhow(k)*w(i,j,k) - else if(qpl(i,j,kx)+qpi(i,j,kx).gt.1.0e-4) then - mdi_crm(l) = mdi_crm(l)+rhow(k)*w(i,j,k) - end if - end if - end do - end do - end do - -! do k=1,nzm -! radlwup0(k)=radlwup0(k)+radlwup(k) -! radlwdn0(k)=radlwdn0(k)+radlwdn(k) -! radqrlw0(k)=radqrlw0(k)+radqrlw(k) -! radswup0(k)=radswup0(k)+radswup(k) -! radswdn0(k)=radswdn0(k)+radswdn(k) -! radqrsw0(k)=radqrsw0(k)+radqrsw(k) -! end do - - do j=1,ny - do i=1,nx -! if(cwp(i,j).gt.cwp_threshold) cltot = cltot + 1. -! if(cwph(i,j).gt.cwp_threshold) clhgh = clhgh + 1. -! if(cwpm(i,j).gt.cwp_threshold) clmed = clmed + 1. -! if(cwpl(i,j).gt.cwp_threshold) cllow = cllow + 1. -! use maxmimum cloud overlap to calcluate cltot, clhgh, -! cldmed, and cldlow +++ mhwang - if(cwp(i,j).gt.cwp_threshold) cltot = cltot + cttemp(i,j) - if(cwph(i,j).gt.cwp_threshold) clhgh = clhgh + chtemp(i,j) - if(cwpm(i,j).gt.cwp_threshold) clmed = clmed + cmtemp(i,j) - if(cwpl(i,j).gt.cwp_threshold) cllow = cllow + cltemp(i,j) - end do - end do - -! call stepout() -!---------------------------------------------------------- - end do ! main loop -!---------------------------------------------------------- - - tmp1 = 1._r8/ dble(nstop) - t_rad = t_rad * tmp1 - qv_rad = qv_rad * tmp1 - qc_rad = qc_rad * tmp1 - qi_rad = qi_rad * tmp1 - cld_rad = cld_rad * tmp1 -#ifdef m2005 - nc_rad = nc_rad * tmp1 - ni_rad = ni_rad * tmp1 - qs_rad = qs_rad * tmp1 - ns_rad = ns_rad * tmp1 -#endif - -! no CRM tendencies above its top - - tln(1:ptop-1) = tl(1:ptop-1) - qln(1:ptop-1) = ql(1:ptop-1) - qccln(1:ptop-1)= qccl(1:ptop-1) - qiiln(1:ptop-1)= qiil(1:ptop-1) - uln(1:ptop-1) = ul(1:ptop-1) - vln(1:ptop-1) = vl(1:ptop-1) - -! Compute tendencies due to CRM: - - tln(ptop:plev) = 0. - qln(ptop:plev) = 0. - qccln(ptop:plev)= 0. - qiiln(ptop:plev)= 0. - uln(ptop:plev) = 0. - vln(ptop:plev) = 0. - - colprec=0 - colprecs=0 - do k = 1,nzm - l = plev-k+1 - do i=1,nx - do j=1,ny - colprec=colprec+(qpl(i,j,k)+qpi(i,j,k))*pdel(plev-k+1) - colprecs=colprecs+qpi(i,j,k)*pdel(plev-k+1) - tln(l) = tln(l)+tabs(i,j,k) - qln(l) = qln(l)+qv(i,j,k) - qccln(l)= qccln(l)+qcl(i,j,k) - qiiln(l)= qiiln(l)+qci(i,j,k) - uln(l) = uln(l)+u(i,j,k) - vln(l) = vln(l)+v(i,j,k) - end do ! k - end do - end do ! i - - - tln(ptop:plev) = tln(ptop:plev) * factor_xy - qln(ptop:plev) = qln(ptop:plev) * factor_xy - qccln(ptop:plev) = qccln(ptop:plev) * factor_xy - qiiln(ptop:plev) = qiiln(ptop:plev) * factor_xy - uln(ptop:plev) = uln(ptop:plev) * factor_xy - vln(ptop:plev) = vln(ptop:plev) * factor_xy - - sltend = cp * (tln - tl) * idt_gl - qltend = (qln - ql) * idt_gl - qcltend = (qccln - qccl) * idt_gl - qiltend = (qiiln - qiil) * idt_gl - prectend=(colprec-prectend)/ggr*factor_xy * idt_gl - precstend=(colprecs-precstend)/ggr*factor_xy * idt_gl - -! don't use CRM tendencies from two crm top levels - sltend(ptop:ptop+1) = 0. - qltend(ptop:ptop+1) = 0. - qcltend(ptop:ptop+1) = 0. - qiltend(ptop:ptop+1) = 0. -!------------------------------------------------------------- -! -! Save the last step to the permanent core: - - u_crm (1:nx,1:ny,1:nzm) = u (1:nx,1:ny,1:nzm) - v_crm (1:nx,1:ny,1:nzm) = v (1:nx,1:ny,1:nzm) - w_crm (1:nx,1:ny,1:nzm) = w (1:nx,1:ny,1:nzm) - t_crm (1:nx,1:ny,1:nzm) = tabs(1:nx,1:ny,1:nzm) - micro_fields_crm(1:nx,1:ny,1:nzm,1:nmicro_fields) = micro_field(1:nx,1:ny,1:nzm,1:nmicro_fields) -#ifdef sam1mom - micro_fields_crm(1:nx,1:ny,1:nzm,3) = qn(1:nx,1:ny,1:nzm) -#endif -#ifdef m2005 - micro_fields_crm(1:nx,1:ny,1:nzm,11) = cloudliq(1:nx,1:ny,1:nzm) -#endif - crm_tk(1:nx,1:ny,1:nzm) = tk(1:nx, 1:ny, 1:nzm) - crm_tkh(1:nx,1:ny,1:nzm) = tkh(1:nx, 1:ny, 1:nzm) - cld3d_crm(1:nx, 1:ny, 1:nzm) = CF3D(1:nx, 1:ny, 1:nzm) -#ifdef SPCAM_CLUBB_SGS - clubb_buffer(1:nx, 1:ny, 1:nz, 1) = up2(1:nx, 1:ny, 1:nz) - clubb_buffer(1:nx, 1:ny, 1:nz, 2) = vp2(1:nx, 1:ny, 1:nz) - clubb_buffer(1:nx, 1:ny, 1:nz, 3) = wprtp(1:nx, 1:ny, 1:nz) - clubb_buffer(1:nx, 1:ny, 1:nz, 4) = wpthlp(1:nx, 1:ny, 1:nz) - clubb_buffer(1:nx, 1:ny, 1:nz, 5) = wp2(1:nx, 1:ny, 1:nz) - clubb_buffer(1:nx, 1:ny, 1:nz, 6) = wp3(1:nx, 1:ny, 1:nz) - clubb_buffer(1:nx, 1:ny, 1:nz, 7) = rtp2(1:nx, 1:ny, 1:nz) - clubb_buffer(1:nx, 1:ny, 1:nz, 8) = thlp2(1:nx, 1:ny, 1:nz) - clubb_buffer(1:nx, 1:ny, 1:nz, 9) = rtpthlp(1:nx, 1:ny, 1:nz) - clubb_buffer(1:nx, 1:ny, 1:nz, 10) = upwp(1:nx, 1:ny, 1:nz) - clubb_buffer(1:nx, 1:ny, 1:nz, 11) = vpwp(1:nx, 1:ny, 1:nz) - clubb_buffer(1:nx, 1:ny, 1:nz, 12) = cloud_frac(1:nx, 1:ny, 1:nz) - clubb_buffer(1:nx, 1:ny, 1:nzm, 13) = t_tndcy(1:nx, 1:ny, 1:nzm) - clubb_buffer(1:nx, 1:ny, 1:nzm, 14) = qc_tndcy(1:nx, 1:ny, 1:nzm) - clubb_buffer(1:nx, 1:ny, 1:nzm, 15) = qv_tndcy(1:nx, 1:ny, 1:nzm) - clubb_buffer(1:nx, 1:ny, 1:nzm, 16) = u_tndcy(1:nx, 1:ny, 1:nzm) - clubb_buffer(1:nx, 1:ny, 1:nzm, 17) = v_tndcy(1:nx, 1:ny, 1:nzm) - - crm_cld(1:nx, 1:ny, 1:nz) = cloud_frac(1:nx, 1:ny, 1:nz) - clubb_tk(1:nx,1:ny,1:nzm) = tk_clubb(1:nx, 1:ny, 1:nzm) - clubb_tkh(1:nx,1:ny,1:nzm) = tkh_clubb(1:nx, 1:ny, 1:nzm) - relvar(1:nx, 1:ny, 1:nzm) = relvarg(1:nx, 1:ny, 1:nzm) - accre_enhan(1:nx, 1:ny, 1:nzm) = accre_enhang(1:nx, 1:ny, 1:nzm) - qclvar(1:nx, 1:ny, 1:nzm) = qclvarg(1:nx, 1:ny, 1:nzm) -#endif - - do k=1,nzm - do j=1,ny - do i=1,nx - qc_crm(i,j,k) = qcl(i,j,k) - qi_crm(i,j,k) = qci(i,j,k) - qpc_crm(i,j,k) = qpl(i,j,k) - qpi_crm(i,j,k) = qpi(i,j,k) -#ifdef m2005 - wvar_crm(i,j,k) = wvar(i,j,k) -! hm 7/26/11, new output - aut_crm(i,j,k) = aut1(i,j,k) - acc_crm(i,j,k) = acc1(i,j,k) - evpc_crm(i,j,k) = evpc1(i,j,k) - evpr_crm(i,j,k) = evpr1(i,j,k) - mlt_crm(i,j,k) = mlt1(i,j,k) - sub_crm(i,j,k) = sub1(i,j,k) - dep_crm(i,j,k) = dep1(i,j,k) - con_crm(i,j,k) = con1(i,j,k) -#endif - end do - end do - end do - z0m = z0 - taux_crm = taux0 / dble(nstop) - tauy_crm = tauy0 / dble(nstop) - -!--------------------------------------------------------------- -! -! Diagnostics: - -! hm add 9/7/11, change from GCM-time step avg to end-of-timestep - - do k=1,nzm - l = plev-k+1 - do j=1,ny - do i=1,nx - - crm_qc(l) = crm_qc(l) + qcl(i,j,k) - crm_qi(l) = crm_qi(l) + qci(i,j,k) - crm_qr(l) = crm_qr(l) + qpl(i,j,k) -#ifdef sam1mom - omg = max(0.,min(1.,(tabs(i,j,k)-tgrmin)*a_gr)) - crm_qg(l) = crm_qg(l) + qpi(i,j,k)*omg - crm_qs(l) = crm_qs(l) + qpi(i,j,k)*(1.-omg) -#else -! crm_qg(l) = crm_qg(l) + qpi(i,j,k) -! crm_qs(l) = crm_qs(l) + 0. ! temporerary solution - crm_qg(l) = crm_qg(l) + micro_field(i,j,k,iqg) - crm_qs(l) = crm_qs(l) + micro_field(i,j,k,iqs) - - crm_nc(l) = crm_nc(l) + micro_field(i,j,k,incl) - crm_ni(l) = crm_ni(l) + micro_field(i,j,k,inci) - crm_nr(l) = crm_nr(l) + micro_field(i,j,k,inr) - crm_ng(l) = crm_ng(l) + micro_field(i,j,k,ing) - crm_ns(l) = crm_ns(l) + micro_field(i,j,k,ins) -#endif - - end do - end do - end do - - cld = min(1._r8,cld/float(nstop)*factor_xy) - cldtop = min(1._r8,cldtop/float(nstop)*factor_xy) - gicewp(:)=gicewp*pdel(:)*1000./ggr/float(nstop)*factor_xy - gliqwp(:)=gliqwp*pdel(:)*1000./ggr/float(nstop)*factor_xy - mcup = mcup / float(nstop) * factor_xy - mcdn = mcdn / float(nstop) * factor_xy - mcuup = mcuup / float(nstop) * factor_xy - mcudn = mcudn / float(nstop) * factor_xy - mc = mcup + mcdn + mcuup + mcudn -! hm 9/7/11 modify for end-of-timestep instead of timestep-avg output -!hm crm_qc = crm_qc / float(nstop) * factor_xy -!hm crm_qi = crm_qi / float(nstop) * factor_xy -!hm crm_qs = crm_qs / float(nstop) * factor_xy -!hm crm_qg = crm_qg / float(nstop) * factor_xy -!hm crm_qr = crm_qr / float(nstop) * factor_xy -!hm#ifdef m2005 -!hm crm_nc = crm_nc / float(nstop) * factor_xy -!hm crm_ni = crm_ni / float(nstop) * factor_xy -!hm crm_ns = crm_ns / float(nstop) * factor_xy -!hm crm_ng = crm_ng / float(nstop) * factor_xy -!hm crm_nr = crm_nr / float(nstop) * factor_xy - - crm_qc = crm_qc * factor_xy - crm_qi = crm_qi * factor_xy - crm_qs = crm_qs * factor_xy - crm_qg = crm_qg * factor_xy - crm_qr = crm_qr * factor_xy -#ifdef m2005 - crm_nc = crm_nc * factor_xy - crm_ni = crm_ni * factor_xy - crm_ns = crm_ns * factor_xy - crm_ng = crm_ng * factor_xy - crm_nr = crm_nr * factor_xy - - -! hm 8/31/11 new output, gcm-grid- and time-step avg -! add loop over i,j do get horizontal avg, and flip vertical array - do k=1,nzm - l = plev-k+1 - do j=1,ny - do i=1,nx - aut_crm_a(l) = aut_crm_a(l) + aut1a(i,j,k) - acc_crm_a(l) = acc_crm_a(l) + acc1a(i,j,k) - evpc_crm_a(l) = evpc_crm_a(l) + evpc1a(i,j,k) - evpr_crm_a(l) = evpr_crm_a(l) + evpr1a(i,j,k) - mlt_crm_a(l) = mlt_crm_a(l) + mlt1a(i,j,k) - sub_crm_a(l) = sub_crm_a(l) + sub1a(i,j,k) - dep_crm_a(l) = dep_crm_a(l) + dep1a(i,j,k) - con_crm_a(l) = con_crm_a(l) + con1a(i,j,k) - end do - end do - end do - -! note, rates are divded by dt to get mean rate over step - aut_crm_a = aut_crm_a / dble(nstop) * factor_xy / dt - acc_crm_a = acc_crm_a / dble(nstop) * factor_xy / dt - evpc_crm_a = evpc_crm_a / dble(nstop) * factor_xy / dt - evpr_crm_a = evpr_crm_a / dble(nstop) * factor_xy / dt - mlt_crm_a = mlt_crm_a / dble(nstop) * factor_xy / dt - sub_crm_a = sub_crm_a / dble(nstop) * factor_xy / dt - dep_crm_a = dep_crm_a / dble(nstop) * factor_xy / dt - con_crm_a = con_crm_a / dble(nstop) * factor_xy / dt - -#endif - precc = 0. - precl = 0. - precsc = 0. - precsl = 0. - do j=1,ny - do i=1,nx -#ifdef sam1mom - precsfc(i,j) = precsfc(i,j)*dz/dt/dble(nstop) - precssfc(i,j) = precssfc(i,j)*dz/dt/dble(nstop) -#endif -#ifdef m2005 -! precsfc and precssfc from the subroutine of micro_proc in M2005 have a unit mm/s/dz -! precsfc(i,j) = precsfc(i,j)*dz/dble(nstop) !mm/s/dz --> mm/s -! precssfc(i,j) = precssfc(i,j)*dz/dble(nstop) !mm/s/dz --> mm/s -! precsfc and precssfc from the subroutine of micro_proc in M2005 have a unit mm/dz - precsfc(i,j) = precsfc(i,j)*dz/dt/dble(nstop) !mm/s/dz --> mm/s - precssfc(i,j) = precssfc(i,j)*dz/dt/dble(nstop) !mm/s/dz --> mm/s - -#endif - if(precsfc(i,j).gt.10./86400.) then - precc = precc + precsfc(i,j) - precsc = precsc + precssfc(i,j) - else - precl = precl + precsfc(i,j) - precsl = precsl + precssfc(i,j) - end if - end do - end do - prec_crm = precsfc/1000. !mm/s --> m/s - precc = precc*factor_xy/1000. - precl = precl*factor_xy/1000. - precsc = precsc*factor_xy/1000. - precsl = precsl*factor_xy/1000. - -!+++mhwangtest -! test water conservtion problem - do k=1, nzm - l=plev-k+1 - do j=1, ny - do i=1, nx -#ifdef m2005 - qtot(9) = qtot(9)+((micro_field(i,j,k,iqr)+micro_field(i,j,k,iqs)+micro_field(i,j,k,iqg)) * pdel(l)/ggr)/(nx*ny) - qtot(9) = qtot(9)+((micro_field(i,j,k,iqv)+micro_field(i,j,k,iqci)) * pdel(l)/ggr)/(nx*ny) -#endif -#ifdef sam1mom - qtot(9) = qtot(9)+((micro_field(i,j,k,1)+micro_field(i,j,k,2)) * pdel(l)/ggr)/(nx*ny) -#endif - enddo - enddo - enddo - qtot(9) = qtot(9) + (precc+precl)*1000 * dt_gl - - if(abs(qtot(9)-qtot(1))/qtot(1).gt.1.0e-6) then -! write(0, *) 'in crm water middle ', igstep, lchnk, icol, qtot(2:8)/ntotal_step, (qtot(5)-qtot(4)) * ntotal_step/qtot(4), & -! (qtot(6)+(precc+precl)*1000 * dt_gl-qtot(5))*ntotal_step/qtot(5) -! write(0, *) 'in crm water middle2 ', igstep, lchnk, icol, qtot(2:8)/ntotal_step, (qtot(8)-qtot(7)) * ntotal_step/qtot(7) -! write(0, *) 'total water (liquid+vapor)', qtot(16:19)/nstop, (qtot(17)-qtot(16)) * ntotal_step/qtot(16), & -! (qtot(18)-qtot(19)) * ntotal_step/qtot(19), -! call endrun('water conservation in crm.F90') - end if -!---mhwangtest - - cltot = cltot *factor_xy/nstop - clhgh = clhgh *factor_xy/nstop - clmed = clmed *factor_xy/nstop - cllow = cllow *factor_xy/nstop - - jt_crm = plev * 1.0 - mx_crm = 1.0 - do k=1, plev - mu_crm(k)=0.5*(mui_crm(k)+mui_crm(k+1)) - md_crm(k)=0.5*(mdi_crm(k)+mdi_crm(k+1)) - mu_crm(k)=mu_crm(k)*ggr/100. !kg/m2/s --> mb/s - md_crm(k)=md_crm(k)*ggr/100. !kg/m2/s --> mb/s - eu_crm(k) = 0. - if(mui_crm(k)-mui_crm(k+1).gt.0) then - eu_crm(k)=(mui_crm(k)-mui_crm(k+1))*ggr/pdel(k) !/s - else - du_crm(k)=-1.0*(mui_crm(k)-mui_crm(k+1))*ggr/pdel(k) !/s - end if - if(mdi_crm(k+1)-mdi_crm(k).lt.0) then - ed_crm(k)=(mdi_crm(k)-mdi_crm(k+1))*ggr/pdel(k) ! /s - else - dd_crm(k)=-1.*(mdi_crm(k)-mdi_crm(k+1))*ggr/pdel(k) !/s - end if - if(abs(mu_crm(k)).gt.1.0e-15.or.abs(md_crm(k)).gt.1.0e-15) then - jt_crm = min(k*1.0_r8, jt_crm) - mx_crm = max(k*1.0_r8, mx_crm) - end if - end do - -!------------------------------------------------------------- -! Fluxes and other stat: -!------------------------------------------------------------- - do k=1,nzm - u2z = 0. - v2z = 0. - w2z = 0. - do j=1,ny - do i=1,nx - u2z = u2z+(u(i,j,k)-u0(k))**2 - v2z = v2z+(v(i,j,k)-v0(k))**2 - w2z = w2z+0.5*(w(i,j,k+1)**2+w(i,j,k)**2) - end do - end do - -!+++mhwang -! mkwsb, mkle, mkadv, mkdiff (also flux_u, flux_v) seem not calculted correclty in the spcam3.5 codes. -! Only values at the last time step are calculated, but is averaged over the entire GCM -! time step. -!---mhwang - - tmp1 = dz/rhow(k) - tmp2 = tmp1/dtn ! dtn is calculated inside of the icyc loop. - ! It seems wrong to use it here ???? +++mhwang - mkwsb(k,:) = mkwsb(k,:) * tmp1*rhow(k) * factor_xy/nstop !kg/m3/s --> kg/m2/s - mkwle(k,:) = mkwle(k,:) * tmp2*rhow(k) * factor_xy/nstop !kg/m3 --> kg/m2/s - mkadv(k,:) = mkadv(k,:) * factor_xy*idt_gl ! kg/kg --> kg/kg/s - mkdiff(k,:) = mkdiff(k,:) * factor_xy*idt_gl ! kg/kg --> kg/kg/s - -! qpsrc, qpevp, qpfall in M2005 are calculated in micro_flux. - qpsrc(k) = qpsrc(k) * factor_xy*idt_gl - qpevp(k) = qpevp(k) * factor_xy*idt_gl - qpfall(k) = qpfall(k) * factor_xy*idt_gl ! kg/kg in M2005 ---> kg/kg/s - precflux(k) = precflux(k) * factor_xy*dz/dt/nstop !kg/m2/dz in M2005 -->kg/m2/s or mm/s (idt_gl=1/dt/nstop) - - l = plev-k+1 - flux_u(l) = (uwle(k) + uwsb(k))*tmp1*factor_xy/nstop - flux_v(l) = (vwle(k) + vwsb(k))*tmp1*factor_xy/nstop -#ifdef sam1mom - flux_qt(l) = mkwle(k,1) + mkwsb(k,1) - fluxsgs_qt(l) = mkwsb(k,1) - flux_qp(l) = mkwle(k,2) + mkwsb(k,2) - qt_trans(l) = mkadv(k,1) + mkdiff(k,1) - qp_trans(l) = mkadv(k,2) + mkdiff(k,2) -#endif -#ifdef m2005 - flux_qt(l) = mkwle(k,1) + mkwsb(k,1) + & - mkwle(k,iqci) + mkwsb(k,iqci) - fluxsgs_qt(l) = mkwsb(k,1) + mkwsb(k,iqci) - flux_qp(l) = mkwle(k,iqr) + mkwsb(k,iqr) + & - mkwle(k,iqs) + mkwsb(k,iqs) + mkwle(k,iqg) + mkwsb(k,iqg) - qt_trans(l) = mkadv(k,1) + mkadv(k,iqci) + & - mkdiff(k,1) + mkdiff(k,iqci) - qp_trans(l) = mkadv(k,iqr) + mkadv(k,iqs) + mkadv(k,iqg) + & - mkdiff(k,iqr) + mkdiff(k,iqs) + mkdiff(k,iqg) -#endif - tkesgsz(l)= rho(k)*sum(tke(1:nx,1:ny,k))*factor_xy - tkez(l)= rho(k)*0.5*(u2z+v2z*YES3D+w2z)*factor_xy + tkesgsz(l) - tkz(l) = sum(tk(1:nx, 1:ny, k)) * factor_xy - pflx(l) = precflux(k)/1000. !mm/s -->m/s - - qp_fall(l) = qpfall(k) - qp_evp(l) = qpevp(k) - qp_src(l) = qpsrc(k) - - qt_ls(l) = qtend(k) - t_ls(l) = ttend(k) - end do - -#ifdef ECPP - abnd=0.0 - abnd_tf=0.0 - massflxbnd=0.0 - acen=0.0 - acen_tf=0.0 - rhcen=0.0 - qcloudcen=0.0 - qicecen=0.0 - qlsinkcen=0.0 - precrcen=0.0 - precsolidcen=0.0 - wupthresh_bnd = 0.0 - wdownthresh_bnd = 0.0 - wwqui_cen = 0.0 - wwqui_bnd = 0.0 - wwqui_cloudy_cen = 0.0 - wwqui_cloudy_bnd = 0.0 - qlsink_bfcen = 0.0 - qlsink_avgcen = 0.0 - praincen = 0.0 -! default is clear, non-precipitating, and quiescent class - abnd(:,1,1,1)=1.0 - abnd_tf(:,1,1,1)=1.0 - acen(:,1,1,1)=1.0 - acen_tf(:,1,1,1)=1.0 - - do k=1, nzm - l=plev-k+1 - acen(l,:,:,:)=area_cen_sum(k,:,1:ncls_ecpp_in,:) - acen_tf(l,:,:,:)=area_cen_final(k,:,1:ncls_ecpp_in,:) - rhcen(l,:,:,:)=rh_cen_sum(k,:,1:ncls_ecpp_in,:) - qcloudcen(l,:,:,:)=qcloud_cen_sum(k,:,1:ncls_ecpp_in,:) - qicecen(l,:,:,:)=qice_cen_sum(k,:,1:ncls_ecpp_in,:) - qlsinkcen(l,:,:,:)=qlsink_cen_sum(k,:,1:ncls_ecpp_in,:) - precrcen(l,:,:,:)=precr_cen_sum(k,:,1:ncls_ecpp_in,:) - precsolidcen(l,:,:,:)=precsolid_cen_sum(k,:,1:ncls_ecpp_in,:) - wwqui_cen(l) = wwqui_cen_sum(k) - wwqui_cloudy_cen(l) = wwqui_cloudy_cen_sum(k) - qlsink_bfcen(l,:,:,:)=qlsink_bf_cen_sum(k,:,1:ncls_ecpp_in,:) - qlsink_avgcen(l,:,:,:)=qlsink_avg_cen_sum(k,:,1:ncls_ecpp_in,:) - praincen(l,:,:,:)=prain_cen_sum(k,:,1:ncls_ecpp_in,:) - end do - do k=1, nzm+1 - l=plev+1-k+1 - abnd(l,:,:,:)=area_bnd_sum(k,:,1:ncls_ecpp_in,:) - abnd_tf(l,:,:,:)=area_bnd_final(k,:,1:ncls_ecpp_in,:) - massflxbnd(l,:,:,:)=mass_bnd_sum(k,:,1:ncls_ecpp_in,:) - wupthresh_bnd(l)=wup_thresh(k) - wdownthresh_bnd(l)=wdown_thresh(k) - wwqui_bnd(l) = wwqui_bnd_sum(k) - wwqui_cloudy_bnd(l) = wwqui_cloudy_bnd_sum(k) - end do -#endif /*ECPP*/ - - timing_factor = timing_factor / nstop - -#ifdef SPCAM_CLUBB_SGS -! Deallocate CLUBB variables, etc. -! -UWM - if ( doclubb .or. doclubbnoninter ) call clubb_sgs_cleanup( ) -#endif -#ifdef ECPP -! Deallocate ECPP variables - call ecpp_crm_cleanup () -#endif /*ECPP*/ - -end subroutine crm -end module crmx_crm_module diff --git a/src/physics/spcam/crm/crmx_crmsurface.F90 b/src/physics/spcam/crm/crmx_crmsurface.F90 deleted file mode 100644 index f5e3ae17f4..0000000000 --- a/src/physics/spcam/crm/crmx_crmsurface.F90 +++ /dev/null @@ -1,155 +0,0 @@ - subroutine crmsurface(bflx) - - - use crmx_vars - use crmx_params - - implicit none - - real, intent (in) :: bflx - real u_h0, tau00, tauxm, tauym - real diag_ustar - integer i,j - -!-------------------------------------------------------- - - - if(SFC_FLX_FXD.and..not.SFC_TAU_FXD) then - - uhl = uhl + dtn*utend(1) - vhl = vhl + dtn*vtend(1) - - tauxm = 0. - tauym = 0. - - do j=1,ny - do i=1,nx - u_h0 = max(1.,sqrt((0.5*(u(i+1,j,1)+u(i,j,1))+ug)**2+ & - (0.5*(v(i,j+YES3D,1)+v(i,j,1))+vg)**2)) - tau00 = rho(1) * diag_ustar(z(1),bflx,u_h0,z0)**2 - fluxbu(i,j) = -(0.5*(u(i+1,j,1)+u(i,j,1))+ug-uhl)/u_h0*tau00 - fluxbv(i,j) = -(0.5*(v(i,j+YES3D,1)+v(i,j,1))+vg-vhl)/u_h0*tau00 - tauxm = tauxm + fluxbu(i,j) - tauym = tauym + fluxbv(i,j) - end do - end do - - taux0 = taux0 + tauxm/dble(nx*ny) - tauy0 = tauy0 + tauym/dble(nx*ny) - - end if ! SFC_FLX_FXD - - return - end - - - - - -! ---------------------------------------------------------------------- -! -! DISCLAIMER : this code appears to be correct but has not been -! very thouroughly tested. If you do notice any -! anomalous behaviour then please contact Andy and/or -! Bjorn -! -! Function diag_ustar: returns value of ustar using the below -! similarity functions and a specified buoyancy flux (bflx) given in -! kinematic units -! -! phi_m (zeta > 0) = (1 + am * zeta) -! phi_m (zeta < 0) = (1 - bm * zeta)^(-1/4) -! -! where zeta = z/lmo and lmo = (theta_rev/g*vonk) * (ustar^2/tstar) -! -! Ref: Businger, 1973, Turbulent Transfer in the Atmospheric Surface -! Layer, in Workshop on Micormeteorology, pages 67-100. -! -! Code writen March, 1999 by Bjorn Stevens -! -! Code corrected 8th June 1999 (obukhov length was wrong way up, -! so now used as reciprocal of obukhov length) - - real function diag_ustar(z,bflx,wnd,z0) - - implicit none - real, parameter :: vonk = 0.4 ! von Karmans constant - real, parameter :: g = 9.81 ! gravitational acceleration - real, parameter :: am = 4.8 ! " " " - real, parameter :: bm = 19.3 ! " " " - real, parameter :: eps = 1.e-10 ! non-zero, small number - - real, intent (in) :: z ! height where u locates - real, intent (in) :: bflx ! surface buoyancy flux (m^2/s^3) - real, intent (in) :: wnd ! wind speed at z - real, intent (in) :: z0 ! momentum roughness height - - integer :: iterate - real :: lnz, klnz, c1, x, psi1, zeta, rlmo, ustar - - lnz = log(z/z0) - klnz = vonk/lnz - c1 = 3.14159/2. - 3.*log(2.) - - ustar = wnd*klnz - if (bflx /= 0.0) then - do iterate=1,8 - rlmo = -bflx * vonk/(ustar**3 + eps) !reciprocal of - !obukhov length - zeta = min(1.,z*rlmo) - if (zeta > 0.) then - ustar = vonk*wnd /(lnz + am*zeta) - else - x = sqrt( sqrt( 1.0 - bm*zeta ) ) - psi1 = 2.*log(1.0+x) + log(1.0+x*x) - 2.*atan(x) + c1 - ustar = wnd*vonk/(lnz - psi1) - end if - end do - end if - - diag_ustar = ustar - - return - end function diag_ustar -! ---------------------------------------------------------------------- - - - - real function z0_est(z,bflx,wnd,ustar) - -! -! Compute z0 from buoyancy flux, wind, and friction velocity -! -! 2004, Marat Khairoutdinov -! - - implicit none - real, parameter :: vonk = 0.4 ! von Karmans constant - real, parameter :: g = 9.81 ! gravitational acceleration - real, parameter :: am = 4.8 ! " " " - real, parameter :: bm = 19.3 ! " " " - real, parameter :: eps = 1.e-10 ! non-zero, small number - - real, intent (in) :: z ! height where u locates - real, intent (in) :: bflx ! surface buoyancy flux (m^2/s^3) - real, intent (in) :: wnd ! wind speed at z - real, intent (in) :: ustar ! friction velocity - - real :: lnz, klnz, c1, x, psi1, zeta, rlmo - - c1 = 3.14159/2. - 3.*log(2.) - rlmo = -bflx*vonk/(ustar**3+eps) !reciprocal of - zeta = min(1.,z*rlmo) - if (zeta >= 0.) then - psi1 = -am*zeta - else - x = sqrt( sqrt( 1.0 - bm*zeta ) ) - psi1 = 2.*log(1.0+x) + log(1.0+x*x) - 2.*atan(x) + c1 - end if - lnz = max(0.,vonk*wnd/(ustar + eps) + psi1) - z0_est = z*exp(-lnz) - - return - end function z0_est -! ---------------------------------------------------------------------- - diff --git a/src/physics/spcam/crm/crmx_crmtracers.F90 b/src/physics/spcam/crm/crmx_crmtracers.F90 deleted file mode 100644 index 62322267c3..0000000000 --- a/src/physics/spcam/crm/crmx_crmtracers.F90 +++ /dev/null @@ -1,142 +0,0 @@ -module crmx_crmtracers - - -! This module serves as a template for adding tracer transport in the model. The tracers can be -! chemical tracers, or bin microphysics drop/ice categories, etc. -! The number of tracers is set by the parameter ntracers which is set in domain.f90. -! Also, the logical flag dotracers should be set to .true. in namelist (default is .false.). -! The model will transport the tracers around automatically (advection and SGS diffusion). -! The user must supply the initialization in the subroutine tracers_init() in this module. -! By default, the surface flux of all tracers is zero. Nonzero values can be set in tracers_flux(). -! The local sinks/sources of tracers should be supplied in tracers_physics(). - - - - use crmx_grid - implicit none - - real tracer (dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm, 0:ntracers) - real fluxbtr (nx, ny, 0:ntracers) ! surface flux of tracers - real fluxttr (nx, ny, 0:ntracers) ! top boundary flux of tracers - real trwle(nz,0:ntracers) ! resolved vertical flux - real trwsb(nz,0:ntracers) ! SGS vertical flux - real tradv(nz,0:ntracers) ! tendency due to vertical advection - real trdiff(nz,0:ntracers) ! tendency due to vertical diffusion - real trphys(nz,0:ntracers) ! tendency due to physics - character *4 tracername(0:ntracers) - character *10 tracerunits(0:ntracers) - -CONTAINS - - subroutine tracers_init() - - integer k,ntr - character *2 ntrchar - integer, external :: lenstr - - tracer = 0. - fluxbtr = 0. - fluxttr = 0. - -! Add your initialization code here. Default is to set to 0 in setdata.f90. - - if(nrestart.eq.0) then - -! here .... - - end if - -! Specify te tracers' default names: - - ! Default names are TRACER01, TRACER02, etc: - - do ntr = 1,ntracers - write(ntrchar,'(i2)') ntr - do k=1,3-lenstr(ntrchar)-1 - ntrchar(k:k)='0' - end do - tracername(ntr) = 'TR'//ntrchar(1:2) - tracerunits(ntr) = '[TR]' - end do - - end subroutine tracers_init - - - - subroutine tracers_flux() - -! Set surface and top fluxes of tracers. Default is 0 set in setdata.f90 - - end subroutine tracers_flux - - - - subroutine tracers_physics() - - ! add here a call to a subroutine that does something to tracers besides advection and diffusion. - ! The transport is done automatically. - - trphys = 0. ! Default tendency due to physics. You code should compute this to output statistics. - - end subroutine tracers_physics - - - - subroutine tracers_hbuf_init(namelist,deflist,unitlist,status,average_type,count,trcount) - -! Initialize the list of tracers statistics variables written in statistics.f90 - - character(*) namelist(*), deflist(*), unitlist(*) - integer status(*),average_type(*),count,trcount - integer ntr - - - do ntr=1,ntracers - - count = count + 1 - trcount = trcount + 1 - namelist(count) = trim(tracername(ntr)) - deflist(count) = trim(tracername(ntr)) - unitlist(count) = trim(tracerunits(ntr)) - status(count) = 1 - average_type(count) = 0 - count = count + 1 - trcount = trcount + 1 - namelist(count) = trim(tracername(ntr))//'FLX' - deflist(count) = 'Total flux of '//trim(tracername(ntr)) - unitlist(count) = trim(tracerunits(ntr))//' kg/m2/s' - status(count) = 1 - average_type(count) = 0 - count = count + 1 - trcount = trcount + 1 - namelist(count) = trim(tracername(ntr))//'FLXS' - deflist(count) = 'SGS flux of '//trim(tracername(ntr)) - unitlist(count) = trim(tracerunits(ntr))//' kg/m2/s' - status(count) = 1 - average_type(count) = 0 - count = count + 1 - trcount = trcount + 1 - namelist(count) = trim(tracername(ntr))//'ADV' - deflist(count) = 'Tendency of '//trim(tracername(ntr)//'due to vertical advection') - unitlist(count) = trim(tracerunits(ntr))//'/day' - status(count) = 1 - average_type(count) = 0 - count = count + 1 - trcount = trcount + 1 - namelist(count) = trim(tracername(ntr))//'DIFF' - deflist(count) = 'Tendency of '//trim(tracername(ntr)//'due to vertical SGS transport') - unitlist(count) = trim(tracername(ntr))//'/day' - status(count) = 1 - average_type(count) = 0 - count = count + 1 - trcount = trcount + 1 - namelist(count) = trim(tracername(ntr))//'PHYS' - deflist(count) = 'Tendency of '//trim(tracername(ntr)//'due to physics') - unitlist(count) = trim(tracername(ntr))//'/day' - status(count) = 1 - average_type(count) = 0 - end do - - end subroutine tracers_hbuf_init - -end module crmx_crmtracers diff --git a/src/physics/spcam/crm/crmx_damping.F90 b/src/physics/spcam/crm/crmx_damping.F90 deleted file mode 100644 index 6d47ecbe4f..0000000000 --- a/src/physics/spcam/crm/crmx_damping.F90 +++ /dev/null @@ -1,68 +0,0 @@ - -subroutine damping - -! "Spange"-layer damping at the domain top region - -use crmx_vars -use crmx_microphysics, only: micro_field, index_water_vapor -implicit none - -real tau_min ! minimum damping time-scale (at the top) -real tau_max ! maxim damping time-scale (base of damping layer) -real damp_depth ! damping depth as a fraction of the domain height -parameter(tau_min=60., tau_max=450., damp_depth=0.4) -real tau(nzm) -integer i, j, k, n_damp - -if(tau_min.lt.2*dt) then - print*,'Error: in damping() tau_min is too small!' - call task_abort() -end if - -do k=nzm,1,-1 - if(z(nzm)-z(k).lt.damp_depth*z(nzm)) then - n_damp=nzm-k+1 - endif -end do - -do k=nzm,nzm-n_damp,-1 - tau(k) = tau_min *(tau_max/tau_min)**((z(nzm)-z(k))/(z(nzm)-z(nzm-n_damp))) - tau(k)=1./tau(k) -end do - -!+++mhwang recalculate grid-mean u0, v0, t0 first, -! as t have been updated. No need for qv0, as -! qv has not been updated yet the calculation of qv0. -do k=1, nzm - u0(k)=0.0 - v0(k)=0.0 - t0(k)=0.0 - do j=1, ny - do i=1, nx - u0(k) = u0(k) + u(i,j,k)/(nx*ny) - v0(k) = v0(k) + v(i,j,k)/(nx*ny) - t0(k) = t0(k) + t(i,j,k)/(nx*ny) - end do - end do -end do -!---mhwang - -do k = nzm, nzm-n_damp, -1 - do j=1,ny - do i=1,nx - dudt(i,j,k,na)= dudt(i,j,k,na)-(u(i,j,k)-u0(k)) * tau(k) - dvdt(i,j,k,na)= dvdt(i,j,k,na)-(v(i,j,k)-v0(k)) * tau(k) - dwdt(i,j,k,na)= dwdt(i,j,k,na)-w(i,j,k) * tau(k) - t(i,j,k)= t(i,j,k)-dtn*(t(i,j,k)-t0(k)) * tau(k) -! In the old version (SAM7.5?) of SAM, water vapor is the prognostic variable for the two-moment microphyscs. -! So the following damping approach can lead to the negative water vapor. -! micro_field(i,j,k,index_water_vapor)= micro_field(i,j,k,index_water_vapor)- & -! dtn*(qv(i,j,k)+qcl(i,j,k)+qci(i,j,k)-q0(k)) * tau(k) -! a simple fix (Minghuai Wang, 2011-08): - micro_field(i,j,k,index_water_vapor)= micro_field(i,j,k,index_water_vapor)- & - dtn*(qv(i,j,k)-qv0(k)) * tau(k) - end do! i - end do! j -end do ! k - -end subroutine damping diff --git a/src/physics/spcam/crm/crmx_diagnose.F90 b/src/physics/spcam/crm/crmx_diagnose.F90 deleted file mode 100644 index e169eb6aff..0000000000 --- a/src/physics/spcam/crm/crmx_diagnose.F90 +++ /dev/null @@ -1,197 +0,0 @@ -subroutine diagnose - -! Diagnose some useful stuff - -use crmx_vars -use crmx_params -use crmx_sgs, only: sgs_diagnose -implicit none - -integer i,j,k,kb,kc,k200,k500,k850 -real(kind=selected_real_kind(12)) coef, coef1, buffer(nzm,9), buffer1(nzm,8) -real omn, omp, tmp_lwp - -coef = 1./float(nx*ny) - - -k200 = nzm - -do k=1,nzm - u0(k)=0. - v0(k)=0. - t01(k) = tabs0(k) - q01(k) = q0(k) - t0(k)=0. - tabs0(k)=0. - q0(k)=0. - qn0(k)=0. - qp0(k)=0. - p0(k)=0. - kc=min(nzm,k+1) - kb=max(1,k-1) - if(pres(kc).le.200..and.pres(kb).gt.200.) k200=k - coef1 = rho(k)*dz*adz(k)*dtfactor - do j=1,ny - do i=1,nx - tabs(i,j,k) = t(i,j,k)-gamaz(k)+ fac_cond * (qcl(i,j,k)+qpl(i,j,k)) +& - fac_sub *(qci(i,j,k) + qpi(i,j,k)) - u0(k)=u0(k)+u(i,j,k) - v0(k)=v0(k)+v(i,j,k) - p0(k)=p0(k)+p(i,j,k) - t0(k)=t0(k)+t(i,j,k) - tabs0(k)=tabs0(k)+tabs(i,j,k) - q0(k)=q0(k)+qv(i,j,k)+qcl(i,j,k)+qci(i,j,k) - qn0(k) = qn0(k) + qcl(i,j,k) + qci(i,j,k) - qp0(k) = qp0(k) + qpl(i,j,k) + qpi(i,j,k) - - pw_xy(i,j) = pw_xy(i,j)+qv(i,j,k)*coef1 - cw_xy(i,j) = cw_xy(i,j)+qcl(i,j,k)*coef1 - iw_xy(i,j) = iw_xy(i,j)+qci(i,j,k)*coef1 - - end do - end do - u0(k)=u0(k)*coef - v0(k)=v0(k)*coef - t0(k)=t0(k)*coef - tabs0(k)=tabs0(k)*coef - q0(k)=q0(k)*coef - qn0(k)=qn0(k)*coef - qp0(k)=qp0(k)*coef - p0(k)=p0(k)*coef - -end do ! k - -k500 = nzm -do k = 1,nzm - kc=min(nzm,k+1) - if((pres(kc).le.500.).and.(pres(k).gt.500.)) then - if ((500.-pres(kc)).lt.(pres(k)-500.))then - k500=kc - else - k500=k - end if - end if -end do - - -do j=1,ny - do i=1,nx - usfc_xy(i,j) = usfc_xy(i,j) + u(i,j,1)*dtfactor - vsfc_xy(i,j) = vsfc_xy(i,j) + v(i,j,1)*dtfactor - u200_xy(i,j) = u200_xy(i,j) + u(i,j,k200)*dtfactor - v200_xy(i,j) = v200_xy(i,j) + v(i,j,k200)*dtfactor - w500_xy(i,j) = w500_xy(i,j) + w(i,j,k500)*dtfactor - end do -end do - -if(dompi) then - - coef1 = 1./float(nsubdomains) - do k=1,nzm - buffer(k,1) = u0(k) - buffer(k,2) = v0(k) - buffer(k,3) = t0(k) - buffer(k,4) = q0(k) - buffer(k,5) = p0(k) - buffer(k,6) = tabs0(k) - buffer(k,7) = qn0(k) - buffer(k,8) = qp0(k) - end do - call task_sum_real8(buffer,buffer1,nzm*8) - do k=1,nzm - u0(k)=buffer1(k,1)*coef1 - v0(k)=buffer1(k,2)*coef1 - t0(k)=buffer1(k,3)*coef1 - q0(k)=buffer1(k,4)*coef1 - p0(k)=buffer1(k,5)*coef1 - tabs0(k)=buffer1(k,6)*coef1 - qn0(k)=buffer1(k,7)*coef1 - qp0(k)=buffer1(k,8)*coef1 - end do - -end if ! dompi - -qv0 = q0 - qn0 - -!===================================================== -! UW ADDITIONS - -! FIND VERTICAL INDICES OF 850MB, COMPUTE SWVP -k850 = 1 -do k = 1,nzm - if(pres(k).le.850.) then - k850 = k - EXIT - end if -end do - -do k=1,nzm - coef1 = rho(k)*dz*adz(k)*dtfactor - do j=1,ny - do i=1,nx - - ! Saturated water vapor path with respect to water. Can be used - ! with water vapor path (= pw) to compute column-average - ! relative humidity. - swvp_xy(i,j) = swvp_xy(i,j)+qsatw_crm(tabs(i,j,k),pres(k))*coef1 - end do - end do -end do ! k - -! ACCUMULATE AVERAGES OF TWO-DIMENSIONAL STATISTICS -do j=1,ny - do i=1,nx - psfc_xy(i,j) = psfc_xy(i,j) + (100.*pres(1) + p(i,j,1))*dtfactor - - ! 850 mbar horizontal winds - u850_xy(i,j) = u850_xy(i,j) + u(i,j,k850)*dtfactor - v850_xy(i,j) = v850_xy(i,j) + v(i,j,k850)*dtfactor - - end do -end do - -! COMPUTE CLOUD/ECHO HEIGHTS AS WELL AS CLOUD TOP TEMPERATURE -! WHERE CLOUD TOP IS DEFINED AS THE HIGHEST MODEL LEVEL WITH A -! CONDENSATE PATH OF 0.01 kg/m2 ABOVE. ECHO TOP IS THE HIGHEST LEVEL -! WHERE THE PRECIPITATE MIXING RATIO > 0.001 G/KG. - -! initially, zero out heights and set cloudtoptemp to SST -cloudtopheight = 0. -cloudtoptemp = sstxy(1:nx,1:ny) -echotopheight = 0. -do j = 1,ny - do i = 1,nx - ! FIND CLOUD TOP HEIGHT - tmp_lwp = 0. - do k = nzm,1,-1 - tmp_lwp = tmp_lwp + (qcl(i,j,k)+qci(i,j,k))*rho(k)*dz*adz(k) - if (tmp_lwp.gt.0.01) then - cloudtopheight(i,j) = z(k) - cloudtoptemp(i,j) = tabs(i,j,k) - EXIT - end if - end do - ! FIND ECHO TOP HEIGHT - do k = nzm,1,-1 - if (qpl(i,j,k)+qpi(i,j,k).gt.1.e-6) then - echotopheight(i,j) = z(k) - EXIT - end if - end do - end do -end do - -! END UW ADDITIONS -!===================================================== - -!----------------- -! compute some sgs diagnostics: - -call sgs_diagnose() - -!----------------- - -! recompute pressure levels, except at restart (saved levels are used). -!if(dtfactor.ge.0.) call pressz() ! recompute pressure levels - -end subroutine diagnose diff --git a/src/physics/spcam/crm/crmx_domain.F90 b/src/physics/spcam/crm/crmx_domain.F90 deleted file mode 100644 index 4de3be44a6..0000000000 --- a/src/physics/spcam/crm/crmx_domain.F90 +++ /dev/null @@ -1,33 +0,0 @@ -! Set the domain dimensionality, size and number of subdomains. - -module crmx_domain - - use crmdims - implicit none - - integer, parameter :: YES3D = YES3DVAL ! Domain dimensionality: 1 - 3D, 0 - 2D - integer, parameter :: nx_gl = crm_nx ! Number of grid points in X - integer, parameter :: ny_gl = crm_ny ! Number of grid points in Y - integer, parameter :: nz_gl = crm_nz ! Number of pressure (scalar) levels - integer, parameter :: nsubdomains_x = 1 ! No of subdomains in x - integer, parameter :: nsubdomains_y = 1 ! No of subdomains in y - - - ! define # of points in x and y direction to average for - ! output relating to statistical moments. - ! For example, navgmom_x = 8 means the output will be an 8 times coarser grid than the original. - ! If don't wanna such output, just set them to -1 in both directions. - ! See Changes_log/README.UUmods for more details. - integer, parameter :: navgmom_x = -1 - integer, parameter :: navgmom_y = -1 - - integer, parameter :: ntracers = 0 ! number of transported tracers (dotracers=.true.) - -! Note: -! * nx_gl and ny_gl should be a factor of 2,3, or 5 (see User's Guide) -! * if 2D case, ny_gl = nsubdomains_y = 1 ; -! * nsubdomains_x*nsubdomains_y = total number of processors -! * if one processor is used, than nsubdomains_x = nsubdomains_y = 1; -! * if ntracers is > 0, don't forget to set dotracers to .true. in namelist - -end module crmx_domain diff --git a/src/physics/spcam/crm/crmx_ecppvars.F90 b/src/physics/spcam/crm/crmx_ecppvars.F90 deleted file mode 100644 index 8b45ed4897..0000000000 --- a/src/physics/spcam/crm/crmx_ecppvars.F90 +++ /dev/null @@ -1,52 +0,0 @@ -module crmx_ecppvars -#ifdef ECPP - implicit none - - public - - integer, public, parameter :: nupdraft_in = 1 ! Number of updraft class - integer, public, parameter :: ndndraft_in = 1 ! Number of dndraft class - integer, public, parameter :: ncls_ecpp_in = 3 ! Number of total number of ecpp transport class - ! = nupdraft_in+1+ndndraft_in - integer, public, parameter :: ncc_in = 2 ! number of clear/cloudy sub-calsses - integer, public, parameter :: nprcp_in = 2 ! Number of non-precipitating/precipitating sub-classes. - - integer, public, parameter :: QUI = 1, & !Quiescent class - UP1 = 2 !First index for upward classes - - integer, public :: DN1, & !First index of downward classes - NCLASS_TR !Num. of transport classes - !Both initialized based on - !runtime settings - - integer, public :: NCLASS_CL = ncc_in, & !Number of cloud classes - CLR = 1, & !Clear sub-class - CLD = 2 !Cloudy sub-class - - integer, public :: NCLASS_PR = nprcp_in, & !Number of precipitaion classes - PRN = 1, & !Not precipitating sub-class - PRY = 2 !Is precipitating sub-class - - - real,dimension(:,:,:), allocatable :: qlsink, precr, precsolid, rh, qlsink_bf, prain, qcloud_bf, qvs - - real,dimension(:,:,:),allocatable :: & - qcloudsum1, qcloud_bfsum1, qrainsum1, qicesum1, qsnowsum1, qgraupsum1, & - qlsinksum1, qlsink_bfsum1, prainsum1, precrsum1, precsolidsum1, precallsum1, & - altsum1, rhsum1, cf3dsum1, wwsum1, wwsqsum1, tkesgssum1, qvssum1 - -! dim1 = z - real,dimension(:),allocatable :: & - xkhvsum, wup_thresh, wdown_thresh, wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum - -! dims = (z, cloud sub-class, transport-class, precip sub-class) - real, dimension(:,:,:,:), allocatable :: & - area_bnd_final, area_bnd_sum, area_cen_final, area_cen_sum, & - mass_bnd_final, mass_bnd_sum, mass_cen_final, mass_cen_sum, & - ent_bnd_sum, rh_cen_sum, & - qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & - qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & - qlsink_cen_sum, precr_cen_sum, precsolid_cen_sum, precall_cen_sum, & - qlsink_bf_cen_sum, prain_cen_sum, qlsink_avg_cen_sum -#endif /*ECPP*/ -end module crmx_ecppvars diff --git a/src/physics/spcam/crm/crmx_forcing.F90 b/src/physics/spcam/crm/crmx_forcing.F90 deleted file mode 100644 index ebcca7e22f..0000000000 --- a/src/physics/spcam/crm/crmx_forcing.F90 +++ /dev/null @@ -1,48 +0,0 @@ - -subroutine forcing - - use crmx_vars - use crmx_params - use crmx_microphysics, only: micro_field, index_water_vapor, total_water - - implicit none - - real coef,qneg,qpoz, factor - integer i,j,k,nneg - - coef = 1./3600. - - do k=1,nzm - - qpoz = 0. - qneg = 0. - nneg = 0 - - do j=1,ny - do i=1,nx - t(i,j,k)=t(i,j,k) + ttend(k) * dtn - micro_field(i,j,k,index_water_vapor)=micro_field(i,j,k,index_water_vapor) + qtend(k) * dtn - if(micro_field(i,j,k,index_water_vapor).lt.0.) then - nneg = nneg + 1 - qneg = qneg + micro_field(i,j,k,index_water_vapor) - else - qpoz = qpoz + micro_field(i,j,k,index_water_vapor) - end if - dudt(i,j,k,na)=dudt(i,j,k,na) + utend(k) - dvdt(i,j,k,na)=dvdt(i,j,k,na) + vtend(k) - end do - end do - - if(nneg.gt.0.and.qpoz+qneg.gt.0.) then - factor = 1. + qneg/qpoz - do j=1,ny - do i=1,nx - micro_field(i,j,k,index_water_vapor) = max(0.,micro_field(i,j,k,index_water_vapor)*factor) - end do - end do - end if - - end do - -end - diff --git a/src/physics/spcam/crm/crmx_grid.F90 b/src/physics/spcam/crm/crmx_grid.F90 deleted file mode 100644 index ab8cad1d63..0000000000 --- a/src/physics/spcam/crm/crmx_grid.F90 +++ /dev/null @@ -1,167 +0,0 @@ -module crmx_grid - -use crmx_domain -use crmx_advection, only: NADV, NADVS - -implicit none - -character(6), parameter :: version = '6.10.4' -character(8), parameter :: version_date = 'Feb 2013' - -integer, parameter :: nx = nx_gl/nsubdomains_x -integer, parameter :: ny = ny_gl/nsubdomains_y -integer, parameter :: nz = nz_gl+1 -integer, parameter :: nzm = nz-1 - -integer, parameter :: nsubdomains = nsubdomains_x * nsubdomains_y - -logical, parameter :: RUN3D = ny_gl.gt.1 -logical, parameter :: RUN2D = .not.RUN3D - -integer, parameter :: nxp1 = nx + 1 -integer, parameter :: nyp1 = ny + 1 * YES3D -integer, parameter :: nxp2 = nx + 2 -integer, parameter :: nyp2 = ny + 2 * YES3D -integer, parameter :: nxp3 = nx + 3 -integer, parameter :: nyp3 = ny + 3 * YES3D -integer, parameter :: nxp4 = nx + 4 -integer, parameter :: nyp4 = ny + 4 * YES3D - -integer, parameter :: dimx1_u = -1 !!-1 -1 -1 -1 -integer, parameter :: dimx2_u = nxp3 !!nxp3 nxp3 nxp3 nxp3 -integer, parameter :: dimy1_u = 1-(2+NADV)*YES3D !!1-5*YES3D 1-4*YES3D 1-3*YES3D 1-2*YES3D -integer, parameter :: dimy2_u = nyp2+NADV !!nyp5 nyp4 nyp3 nyp2 -integer, parameter :: dimx1_v = -1-NADV !!-4 -3 -2 -1 -integer, parameter :: dimx2_v = nxp2+NADV !!nxp5 nxp4 nxp3 nxp2 -integer, parameter :: dimy1_v = 1-2*YES3D !!1-2*YES3D 1-2*YES3D 1-2*YES3D 1-2*YES3D -integer, parameter :: dimy2_v = nyp3 !!nyp3 nyp3 nyp3 nyp3 -integer, parameter :: dimx1_w = -1-NADV !!-4 -3 -2 -1 -integer, parameter :: dimx2_w = nxp2+NADV !!nxp5 nxp4 nxp3 nxp2 -integer, parameter :: dimy1_w = 1-(2+NADV)*YES3D !!1-5*YES3D 1-4*YES3D 1-3*YES3D 1-2*YES3D -integer, parameter :: dimy2_w = nyp2+NADV !!nyp5 nyp4 nyp3 nyp2 -integer, parameter :: dimx1_s = -2-NADVS !!-4 -3 -2 -2 -integer, parameter :: dimx2_s = nxp3+NADVS !!nxp5 nxp4 nxp3 nxp3 -integer, parameter :: dimy1_s = 1-(3+NADVS)*YES3D !!1-5*YES3D 1-4*YES3D 1-3*YES3D 1-3*YES3D -integer, parameter :: dimy2_s = nyp3+NADVS !!nyp5 nyp4 nyp3 nyp3 - -integer, parameter :: ncols = nx*ny -integer, parameter :: nadams = 3 - -! Vertical grid parameters: -real z(nz) ! height of the pressure levels above surface,m -real pres(nzm) ! pressure,mb at scalar levels -real zi(nz) ! height of the interface levels -real presi(nz) ! pressure,mb at interface levels -real adz(nzm) ! ratio of the thickness of scalar levels to dz -real adzw(nz) ! ratio of the thinckness of w levels to dz -real pres0 ! Reference surface pressure, Pa - -integer:: nstep =0! current number of performed time steps -integer ncycle ! number of subcycles over the dynamical timestep -integer icycle ! current subcycle -integer:: na=1, nb=2, nc=3 ! indeces for swapping the rhs arrays for AB scheme -real at, bt, ct ! coefficients for the Adams-Bashforth scheme -real dtn ! current dynamical timestep (can be smaller than dt) -real dt3(3) ! dynamical timesteps for three most recent time steps -real(kind=selected_real_kind(12)):: time=0. ! current time in sec. -real day ! current day (including fraction) -real dtfactor ! dtn/dt - -! MPI staff: -integer rank ! rank of the current subdomain task (default 0) -integer ranknn ! rank of the "northern" subdomain task -integer rankss ! rank of the "southern" subdomain task -integer rankee ! rank of the "eastern" subdomain task -integer rankww ! rank of the "western" subdomain task -integer rankne ! rank of the "north-eastern" subdomain task -integer ranknw ! rank of the "north-western" subdomain task -integer rankse ! rank of the "south-eastern" subdomain task -integer ranksw ! rank of the "south-western" subdomain task -logical dompi ! logical switch to do multitasking -logical masterproc ! .true. if rank.eq.0 - -character(80) case ! id-string to identify a case-name(set in CaseName file) - -logical dostatis ! flag to permit the gathering of statistics -logical dostatisrad ! flag to permit the gathering of radiation statistics -integer nstatis ! the interval between substeps to compute statistics - -logical :: compute_reffc = .false. -logical :: compute_reffi = .false. - -logical notopened2D ! flag to see if the 2D output datafile is opened -logical notopened3D ! flag to see if the 3D output datafile is opened -logical notopenedmom ! flag to see if the statistical moment file is opened - -!----------------------------------------- -! Parameters controled by namelist PARAMETERS - -real:: dx =0. ! grid spacing in x direction -real:: dy =0. ! grid spacing in y direction -real:: dz =0. ! constant grid spacing in z direction (when dz_constant=.true.) -logical:: doconstdz = .false. ! do constant vertical grid spacing set by dz - -integer:: nstop =0 ! time step number to stop the integration -integer:: nelapse =999999999! time step number to elapse before stoping - -real:: dt=0. ! dynamical timestep -real:: day0=0. ! starting day (including fraction) - -integer:: nrad =1 ! frequency of calling the radiation routines -integer:: nprint =1000 ! frequency of printing a listing (steps) -integer:: nrestart =0 ! switch to control starting/restarting of the model -integer:: nstat =1000 ! the interval in time steps to compute statistics -integer:: nstatfrq =50 ! frequency of computing statistics - -logical:: restart_sep =.false. ! write separate restart files for sub-domains -integer:: nrestart_skip =0 ! number of skips of writing restart (default 0) -logical:: output_sep =.false. ! write separate 3D and 2D files for sub-domains - -character(80):: caseid =''! id-string to identify a run -character(80):: caseid_restart =''! id-string for branch restart file -character(80):: case_restart =''! id-string for branch restart file - -logical:: doisccp = .false. -logical:: domodis = .false. -logical:: domisr = .false. -logical:: dosimfilesout = .false. - -logical:: doSAMconditionals = .false. !core updraft,downdraft conditional statistics -logical:: dosatupdnconditionals = .false.!cloudy updrafts,downdrafts and cloud-free -logical:: doscamiopdata = .false.! initialize the case from a SCAM IOP netcdf input file -logical:: dozero_out_day0 = .false. -character(len=120):: iopfile='' -character(256):: rundatadir ='./RUNDATA' ! path to data directory - -integer:: nsave3D =1000 ! frequency of writting 3D fields (steps) -integer:: nsave3Dstart =99999999! timestep to start writting 3D fields -integer:: nsave3Dend =99999999 ! timestep to end writting 3D fields -logical:: save3Dbin =.false. ! save 3D data in binary format(no 2-byte compression) -logical:: save3Dsep =.false. ! use separate file for each time point for2-model -real :: qnsave3D =0. !threshold manimum cloud water(kg/kg) to save 3D fields -logical:: dogzip3D =.false. ! gzip compress a 3D output file -logical:: rad3Dout = .false. ! output additional 3D radiation foelds (like reff) - -integer:: nsave2D =1000 ! frequency of writting 2D fields (steps) -integer:: nsave2Dstart =99999999! timestep to start writting 2D fields -integer:: nsave2Dend =99999999 ! timestep to end writting 2D fields -logical:: save2Dbin =.false. ! save 2D data in binary format, rather than compressed -logical:: save2Dsep =.false. ! write separate file for each time point for 2D output -logical:: save2Davg =.false. ! flag to time-average 2D output fields (default .false.) -logical:: dogzip2D =.false. ! gzip compress a 2D output file if save2Dsep=.true. - -integer:: nstatmom =1000! frequency of writting statistical moment fields (steps) -integer:: nstatmomstart =99999999! timestep to start writting statistical moment fields -integer:: nstatmomend =99999999 ! timestep to end writting statistical moment fields -logical:: savemomsep =.false.! use one file with stat moments for each time point -logical:: savemombin =.false.! save statistical moment data in binary format - -integer:: nmovie =1000! frequency of writting movie fields (steps) -integer:: nmoviestart =99999999! timestep to start writting statistical moment fields -integer:: nmovieend =99999999 ! timestep to end writting statistical moment fields - -logical :: isInitialized_scamiopdata = .false. -logical :: wgls_holds_omega = .false. - -!----------------------------------------- -end module crmx_grid diff --git a/src/physics/spcam/crm/crmx_ice_fall.F90 b/src/physics/spcam/crm/crmx_ice_fall.F90 deleted file mode 100644 index f16a90ea15..0000000000 --- a/src/physics/spcam/crm/crmx_ice_fall.F90 +++ /dev/null @@ -1,124 +0,0 @@ - -subroutine ice_fall() - - -! Sedimentation of ice: - -use crmx_vars -use crmx_microphysics, only: micro_field, index_cloud_ice -!use micro_params -use crmx_params - -implicit none - -integer i,j,k, kb, kc, kmax, kmin, ici -real coef,dqi,lat_heat,vt_ice -real omnu, omnc, omnd, qiu, qic, qid, tmp_theta, tmp_phi -real fz(nx,ny,nz) - -kmax=0 -kmin=nzm+1 - -do k = 1,nzm - do j = 1, ny - do i = 1, nx - if(qcl(i,j,k)+qci(i,j,k).gt.0..and. tabs(i,j,k).lt.273.15) then - kmin = min(kmin,k) - kmax = max(kmax,k) - end if - end do - end do -end do - -do k = 1,nzm - qifall(k) = 0. - tlatqi(k) = 0. -end do - -if(index_cloud_ice.eq.-1) return - -!call t_startf ('ice_fall') - -fz = 0. - -! Compute cloud ice flux (using flux limited advection scheme, as in -! chapter 6 of Finite Volume Methods for Hyperbolic Problems by R.J. -! LeVeque, Cambridge University Press, 2002). -do k = max(1,kmin-1),kmax - ! Set up indices for x-y planes above and below current plane. - kc = min(nzm,k+1) - kb = max(1,k-1) - ! CFL number based on grid spacing interpolated to interface i,j,k-1/2 - coef = dtn/(0.5*(adz(kb)+adz(k))*dz) - do j = 1,ny - do i = 1,nx - ! Compute cloud ice density in this cell and the ones above/below. - ! Since cloud ice is falling, the above cell is u (upwind), - ! this cell is c (center) and the one below is d (downwind). - - qiu = rho(kc)*qci(i,j,kc) - qic = rho(k) *qci(i,j,k) - qid = rho(kb)*qci(i,j,kb) - - ! Ice sedimentation velocity depends on ice content. The fiting is - ! based on the data by Heymsfield (JAS,2003). -Marat - vt_ice = min(0.4,8.66*(max(0.,qic)+1.e-10)**0.24) ! Heymsfield (JAS, 2003, p.2607) - - ! Use MC flux limiter in computation of flux correction. - ! (MC = monotonized centered difference). -! if (qic.eq.qid) then - if (abs(qic-qid).lt.1.0e-25) then ! when qic, and qid is very small, qic_qid can still be zero - ! even if qic is not equal to qid. so add a fix here +++mhwang - tmp_phi = 0. - else - tmp_theta = (qiu-qic)/(qic-qid) - tmp_phi = max(0.,min(0.5*(1.+tmp_theta),2.,2.*tmp_theta)) - end if - - ! Compute limited flux. - ! Since falling cloud ice is a 1D advection problem, this - ! flux-limited advection scheme is monotonic. - fz(i,j,k) = -vt_ice*(qic - 0.5*(1.-coef*vt_ice)*tmp_phi*(qic-qid)) - end do - end do -end do -fz(:,:,nz) = 0. - -ici = index_cloud_ice - -do k=max(1,kmin-2),kmax - coef=dtn/(dz*adz(k)*rho(k)) - do j=1,ny - do i=1,nx - ! The cloud ice increment is the difference of the fluxes. - dqi=coef*(fz(i,j,k)-fz(i,j,k+1)) - ! Add this increment to both non-precipitating and total water. - micro_field(i,j,k,ici) = micro_field(i,j,k,ici) + dqi - ! Include this effect in the total moisture budget. - qifall(k) = qifall(k) + dqi - - ! The latent heat flux induced by the falling cloud ice enters - ! the liquid-ice static energy budget in the same way as the - ! precipitation. Note: use latent heat of sublimation. - lat_heat = (fac_cond+fac_fus)*dqi - ! Add divergence of latent heat flux to liquid-ice static energy. - t(i,j,k) = t(i,j,k) - lat_heat - ! Add divergence to liquid-ice static energy budget. - tlatqi(k) = tlatqi(k) - lat_heat - end do - end do -end do - -coef=dtn/dz -do j=1,ny - do i=1,nx - dqi=-coef*fz(i,j,1) - precsfc(i,j) = precsfc(i,j)+dqi - precssfc(i,j) = precssfc(i,j)+dqi - end do -end do - -!call t_stopf ('ice_fall') - -end subroutine ice_fall - diff --git a/src/physics/spcam/crm/crmx_kurant.F90 b/src/physics/spcam/crm/crmx_kurant.F90 deleted file mode 100644 index 502843bff8..0000000000 --- a/src/physics/spcam/crm/crmx_kurant.F90 +++ /dev/null @@ -1,56 +0,0 @@ - -subroutine kurant - -use crmx_vars -use crmx_sgs, only: kurant_sgs - -implicit none - -integer i, j, k, ncycle1(1),ncycle2(1) -real wm(nz) ! maximum vertical wind velocity -real uhm(nz) ! maximum horizontal wind velocity -real cfl, cfl_sgs - -ncycle = 1 - -wm(nz)=0. -w_max =0. -u_max =0. -do k = 1,nzm - wm(k) = maxval(abs(w(1:nx,1:ny,k))) - uhm(k) = sqrt(maxval(u(1:nx,1:ny,k)**2+YES3D*v(1:nx,1:ny,k)**2)) -end do -w_max=max(w_max,maxval(w(1:nx,1:ny,1:nz))) -u_max=max(u_max,maxval(uhm(1:nzm))) - -cfl = 0. -do k=1,nzm - cfl = max(cfl,uhm(k)*dt*sqrt((1./dx)**2+YES3D*(1./dy)**2), & - max(wm(k),wm(k+1))*dt/(dz*adzw(k)) ) -end do - -call kurant_sgs(cfl_sgs) -cfl = max(cfl,cfl_sgs) - -ncycle = max(1,ceiling(cfl/0.7)) - -if(dompi) then - ncycle1(1)=ncycle - call task_max_integer(ncycle1,ncycle2,1) - ncycle=ncycle2(1) -end if -if(ncycle.gt.4) then - if(masterproc) print *,'the number of cycles exceeded 4.' -!+++ test +++mhwang - write(0, *) 'cfl', cfl, cfl_sgs, latitude(1, 1), longitude(1,1) - do k=1, nzm - write(0, *) 'k=', k, wm(k), uhm(k) - end do - do i=1, nx - write(0, *) 'i=', i, u(i, 1, 4), v(i, 1, 4), tabs(i,1,4) - end do -!---mhwang - call task_abort() -end if - -end subroutine kurant diff --git a/src/physics/spcam/crm/crmx_module_ecpp_crm_driver.F90 b/src/physics/spcam/crm/crmx_module_ecpp_crm_driver.F90 deleted file mode 100644 index bc1504872b..0000000000 --- a/src/physics/spcam/crm/crmx_module_ecpp_crm_driver.F90 +++ /dev/null @@ -1,773 +0,0 @@ -module crmx_module_ecpp_crm_driver -#ifdef ECPP -!------------------------------------------------------------------------ -! F90 module to prepare CRM output for ECPP module in the MMF model. -! -! This code was written originally by William Gustafson, and is adopted into -! the MMF model by Minghuai Wang (minghuai.wang@pnl.gov), November, 2009. -! -! Assumptiont built into this code: -! -! Open issues: -! - The mask for determining a "moving" or limited spatial average -! is not implemented. -! - The dependencies in Makefile don't work. If a compile fails, -! try "make clean; make" instead to clear out the module files. -! - For uv_in/out, a simple time average is being done and one can -! argue that it should be a weighted average since the number of in -! and out points changes with each time step. The affect is probably -! small for short time averages though. -! - When calculating the standard deviation of vertical velocity, -! each cell is treated equally and the std. dev. is over the 3 dims -! below the cloud tops. We may want to consider weighting each cell -! by either its volume or mass. -! - To get cloud values at vertical cell interface, a simple average -! is being done when an interpolation should technically be done. -! This only affects quiescent cloudy/clear categories. -! - Ditto for getting the density at the vertical cell interface (rho8w). -! -! Differences between the methodology here and in Ferret: -! - When calculating wup_bar and wdown_bar, points with w==0 are ignored -! here and were included in wup in Ferret. -! - Clear fluxes are no longer chopped off at the cloud top. -! - When calculating the std. dev. in and below the cloud, the level -! just above the cloud top is now included so we include w out the -! cloud top. -! - When determining "cloudyother" in Ferret the cloud above the -! interface was used. Now, the average of the cloud above and below -! is used. -! -! William.Gustafson@pnl.gov; 20-Jul-2006 -! v2.0 - Added two-level time averaging, one for the stats and a longer -! period for output. -! v2.1 - 25-Jul-2006; Fixed sign bug with uv_in/out. -! -! v3.0 - aug-sep-2006 - many changes by r.easter and s.ghan -! major change is option for multiple up and downdraft classes -! -! v3.1 - 02-nov-2006 r.easter - replaced uv_in/outsum with u_in/outsum -! & v_in/outsum -! -! v4.0 - 25-Jan-2007, wig; -! - Added areaavgtype switch to output final areas either as -! instantaneous, averaged over the last ntavg1 period of each -! ntavg2 avg, or as averaged over ntavg2. -! - Output areas as average over ntavg2 and also just at end -! of it. -! - Added entrainment averages to output (do not divide by dz). -! -! postproc_wrfout_bb.f90 from postproc_wrfout.f90 - 15-nov-2007, rce; -! - do multiple processings -! -! v5.0 - Nov-2008, wig -! - Major rewrite to include combinations of cloud, precipitation, -! and transport classes -! - Output format changes to multi-dimensional variables based -! on the classes instead of outputting each class separately -! -! 14-Apr-2009, wig: Fixed bug with mode_updnthresh at model top for -! bad calculation of w thresholds. -! -! 16-Apr-2009, wig: Added qcloud weighting to qlsink averages -! -!---------------------------------------------------------------------------------------- - use crmx_ecppvars - use crmx_ecppvars, only: QUI, UP1, DN1, NCLASS_TR, NCLASS_CL, CLR, CLD, NCLASS_PR, PRN, PRY - use cam_abortutils, only: endrun - - public ecpp_crm_stat - public ecpp_crm_init - public ecpp_crm_cleanup - - integer, public :: ntavg1_ss, ntavg2_ss - - private - save - - integer :: nxstag, nystag, nzstag - integer :: itavg1, itavg2, & - ntavg1, ntavg2 - - integer :: mode_updnthresh - integer :: areaavgtype - ! Methodology to compute final area averages: - ! 0 = area categories based on instantaneous - ! values at last time step of ntavg2 - ! 1 = area cat. based on last ntavg1 avgeraging - ! period of each ntavg2 period - ! 2 = area cat. based on average of full ntavg2 - ! period - integer :: plumetype - ! 1 = single plume - ! 2 = two plumes, core and weak - ! 3 = multi-plume, number based on setting of - ! allcomb - logical :: allcomb - ! true if updrafts and downdrafts have all - ! combinations of bases and tops. - real :: cloudthresh, & - prcpthresh, & - downthresh, downthresh2, & - upthresh, upthresh2 - - real :: cloudthresh_trans, & ! the threshold total cloud water for updraft or downdraft - precthresh_trans ! the threshold total rain, snow and graupel for clear, updraft or downdraft - - integer, dimension(:),allocatable :: & - updraftbase, updrafttop, dndrafttop, dndraftbase - integer :: nupdraft, ndndraft - integer :: ndraft_max, nupdraft_max, ndndraft_max - -contains - -!======================================================================================== -subroutine ecpp_crm_init() - - use crmx_grid, only: nx, ny, nzm, dt - use crmx_module_ecpp_stats, only: zero_out_sums1, zero_out_sums2 - use module_ecpp_ppdriver2, only: nupdraft_in, ndndraft_in, ncls_ecpp_in - implicit none - - integer :: kbase, ktop - integer :: m - integer :: nup, ndn - character(len=100) :: msg - - nxstag = nx+1 - nystag = ny+1 - nzstag = nzm+1 - -! ntavg1_ss and ntavg1_ss are defined in crm.F90 in the MMF model. -! ntavg1_ss = dt_gl ! GCM time step -! ntavg1_ss = number of seconds to average between computing categories. -! ntavg2_ss = dt_gl ! GCM time step -! ntavg2_ss = number of seconds to average between outputs. -! This must be a multiple of ntavgt1_ss. - - mode_updnthresh = 16 -! 1 = method originally implemented by Bill G -! wup_thresh = wup_stddev*abs(upthresh) -! wdown_thresh = -wdown_stddev*abs(downthresh) -! 2 = similar to 1, but include the mean wup and wdown -! wup_thresh = wup_bar + wup_stddev*abs(upthresh) -! wdown_thresh = wdown_bar - wdown_stddev*abs(downthresh) -! 3 = user specifies an absolute threshold -! wup_thresh = abs(upthresh) -! wdown_thresh = -abs(downthresh) -! 4 = similar to 1, but do -! wup_thresh = wup_rms*abs(upthresh) -! wdown_thresh = -wdown_rms*abs(downthresh) -! -! 5 = see description in module_ecpp_stats.f90 -! 6, 7 = see descriptions in module_ecpp_stats.f90 -! 8, 9 = see descriptions in module_ecpp_stats.f90 -! 10, 11 = see descriptions in module_ecpp_stats.f90 -! 12, 13 = see descriptions in module_ecpp_stats.f90 - - upthresh = 1. !Multiples of std. dev. to classify as updraft - downthresh = 1. !Multiples of std. dev. to classify as downdraft - upthresh2 = 0.5 ! ...ditto, except for weaker 2nd draft type when plumetype=2 - downthresh2 = 0.5 - -#ifdef CLUBB_CRM - cloudthresh = 2e-7 !Cloud mixing ratio beyond which cell is "cloudy(liquid)" (kg/kg) - ! As now fractional cloudiness is used for classifying cloudy vs. clear, - ! reduce it from 1.0e-6 to 2.0e-7 -#else - cloudthresh = 1e-6 !Cloud mixing ratio beyond which cell is "cloudy(liquid)" (kg/kg) -#endif - - prcpthresh = 1e-6 !Preciptation rate (precr) beyond which cell is raining (kg/m2/s) - ! this is used to classify precipitating vs. nonprecipitating class for wet scavenging. - -!+++mhwang -! high thresholds are used to classify transport classes (following Xu et al., 2002, Q.J.R.M.S. -! - cloudthresh_trans = 1e-5 !Cloud mixing ratio beyond which cell is "cloudy" to classify transport classes (kg/kg) +++mhwang - ! the maxium of cloudthres_trans and 0.01*qvs is used to classify transport class - precthresh_trans = 1e-4 !Preciptation mixing ratio beyond which cell is raining to classify transport classes (kg/kg) !+++mwhang -!---mhwang - - areaavgtype= 1 !final area avg over 0=instantaneous, 1=ntavg1, 2=ntavg2 - plumetype = 1 !1 for single plume, 2 for core and weak plumes, 3 for multiple plumes - allcomb = .false. !true for all combinations of plume bases and tops, false for 1 plume per base - -!---------------------------------------------------------------------------------- -! Sanity check... -!---------------------------------------------------------------------------------- - - if(plumetype>3)then - msg = 'ecpp_crm, plumetype must be <=3' - call endrun(trim(msg)) - endif - - if(plumetype<3 .and. allcomb)then - msg='ecpp_crm, allcomb=true requires plumetype=3' - call endrun(trim(msg)) - endif - - if(areaavgtype>2)then - msg='ecpp_crm, areaavgtype must be <=2' - call endrun(trim(msg)) - endif - - if ((mode_updnthresh < 1) .or. (mode_updnthresh > 17)) then - msg='ecpp_crm, error - must have 1 <= mode_updnthresh <= 17' - call endrun(trim(msg)) - endif - - if( abs(upthresh2) > 0.90*abs(upthresh) ) then - msg='ecpp_crm, error - upthresh2 must be < 0.90*upthresh' - call endrun(trim(msg)) - end if - - if( abs(downthresh2) > 0.90*abs(downthresh) ) then - msg='ecpp_crm, error - downthresh2 must be < 0.90*downthresh' - call endrun(trim(msg)) - end if - -! determine number of updrafts and downdrafts -! -! updraft kbase & ktop definition: -! ww(i,j,k ) > wup_thresh for k=kbase+1:ktop -! <= wup_thresh at k=kbase and k=ktop+1 -! they identify the "T-points" which enclose the updraft "W-points" -! and are affected by the subgrid transport of this updraft -! -! downdraft kbase & ktop definition: -! ww(i,j,k ) < wdown_thresh for k=kbase+1:ktop -! >= wdown_thresh at k=kbase and k=ktop+1 -! they identify the "T-points" which enclose the downdraft "W-points" -! and are affected by the subgrid transport of this downdraft -! -! for both updrafts and downdrafts, -! 1 <= kbase < ktop < nzstag - - nupdraft = 0 - ndndraft = 0 - nupdraft_max = 0 - ndndraft_max = 0 - - select case (plumetype) - case (1) !single plume - nupdraft = 1 - ndndraft = 1 - case (2) !core and weak plumes - nupdraft = 2 - ndndraft = 2 - case (3) - do kbase=1,nzm-1 - if(allcomb)then ! all possible tops - nupdraft=nupdraft+nzm-kbase - else ! one top per base - nupdraft=nupdraft+1 - endif - enddo - do ktop=nzm,2,-1 - if(allcomb)then ! all possible bases - ndndraft=ndndraft+ktop-1 - else ! one base per top - ndndraft=ndndraft+1 - endif - enddo - end select - - nupdraft_max = max( nupdraft_max, nupdraft ) - ndndraft_max = max( ndndraft_max, ndndraft ) - - DN1 = nupdraft + 2 !Setup index of first downdraft class - NCLASS_TR = nupdraft + ndndraft + 1 - - ndraft_max = 1 + nupdraft_max + ndndraft_max - - if(NCLASS_TR.ne.ncls_ecpp_in) then - call endrun('NCLASS_TR should be equal to ncls_ecpp_in') - end if - if((nupdraft.ne.nupdraft_in) .or. (ndndraft.ne.ndndraft_in)) then - call endrun('nupdraft or ndndraft is not set correctly') - end if - - allocate (updraftbase(nupdraft_max), & - updrafttop( nupdraft_max) ) - allocate (dndraftbase(ndndraft_max), & - dndrafttop( ndndraft_max) ) - - select case (plumetype) - case (1) !single plume - updraftbase(1)=1 - updrafttop( 1)=nzm - dndrafttop( 1)=nzm - dndraftbase(1)=1 - case (2) - updraftbase(1:2)=1 - updrafttop( 1:2)=nzm - dndrafttop( 1:2)=nzm - dndraftbase(1:2)=1 - case (3) - m=0 - do kbase=1,nzm-1 - if(allcomb)then ! loop over all possible tops. - do ktop=kbase+1,nzm - m=m+1 - updraftbase(m)=kbase - updrafttop( m)=ktop - enddo - else ! only one top per base - m=m+1 - updraftbase(m)=kbase - updrafttop( m)=nzm - endif - enddo - - m=0 - do ktop=nzm,2,-1 - if(allcomb)then ! loop over all possible bases. - do kbase=ktop-1,1,-1 - m=m+1 - dndrafttop( m)=ktop - dndraftbase(m)=kbase - enddo - else ! only one base per top - m=m+1 - dndrafttop( m)=ktop - dndraftbase(m)=1 - endif - enddo - end select - -!--------------------------------------------------------------------------- -! Allocate arrays -!--------------------------------------------------------------------------- - allocate( qlsink(nx,ny,nzm), precr(nx,ny,nzm), precsolid(nx,ny,nzm), rh(nx, ny, nzm), qvs(nx, ny, nzm)) - - allocate( qlsink_bf(nx, ny, nzm), prain(nx, ny, nzm), qcloud_bf(nx, ny, nzm)) - - allocate( qcloudsum1(nx,ny,nzm), qcloud_bfsum1(nx,ny,nzm), qrainsum1(nx,ny,nzm), & - qicesum1(nx,ny,nzm), qsnowsum1(nx,ny,nzm), qgraupsum1(nx,ny,nzm), & - qlsinksum1(nx,ny,nzm), precrsum1(nx,ny,nzm), & - precsolidsum1(nx,ny,nzm), precallsum1(nx,ny,nzm), & - altsum1(nx,ny,nzm), rhsum1(nx,ny,nzm), cf3dsum1(nx,ny,nzm), & - wwsum1(nx,ny,nzstag), wwsqsum1(nx,ny,nzstag), & - tkesgssum1(nx, ny, nzm), qlsink_bfsum1(nx, ny, nzm), prainsum1(nx, ny, nzm), qvssum1(nx, ny, nzm) ) - - allocate( & - xkhvsum(nzm) ) - - allocate( wwqui_cen_sum(nzm), wwqui_bnd_sum(nzm+1), & - wwqui_cloudy_cen_sum(nzm), wwqui_cloudy_bnd_sum(nzm+1)) - - allocate( wup_thresh(nzm+1), wdown_thresh(nzm+1)) - - allocate( area_bnd_final( nzstag,NCLASS_CL,ndraft_max,NCLASS_PR), & - area_bnd_sum( nzstag,NCLASS_CL,ndraft_max,NCLASS_PR), & - area_cen_final( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - area_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - mass_bnd_final( nzstag,NCLASS_CL,ndraft_max,NCLASS_PR), & - mass_bnd_sum( nzstag,NCLASS_CL,ndraft_max,NCLASS_PR), & - mass_cen_final( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - mass_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - ent_bnd_sum( nzstag,NCLASS_CL,ndraft_max,NCLASS_PR), & - rh_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - qcloud_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - qcloud_bf_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - qrain_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - qice_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - qsnow_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - qgraup_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - qlsink_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - precr_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - precsolid_cen_sum(nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - precall_cen_sum(nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - qlsink_bf_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - qlsink_avg_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR), & - prain_cen_sum( nzm ,NCLASS_CL,ndraft_max,NCLASS_PR) ) - -! Initialize the running sums. - call zero_out_sums1( qcloudsum1(:,:,:), qcloud_bfsum1(:,:,:), qrainsum1(:,:,:), & - qicesum1(:,:,:), qsnowsum1(:,:,:), qgraupsum1(:,:,:), & - qlsinksum1(:,:,:), precrsum1(:,:,:), & - precsolidsum1(:,:,:), precallsum1(:,:,:), & - altsum1(:,:,:), rhsum1(:,:,:), cf3dsum1(:,:,:), & - wwsum1(:,:,:), wwsqsum1(:,:,:), tkesgssum1(:,:,:), & - qlsink_bfsum1(:,:,:), prainsum1(:,:,:), qvssum1(:,:,:) ) - ndn = ndndraft ; nup = nupdraft - call zero_out_sums2( & - xkhvsum(:), & - wwqui_cen_sum(:), wwqui_bnd_sum(:), wwqui_cloudy_cen_sum(:), wwqui_cloudy_bnd_sum(:), & - area_bnd_final(:,:,1:1+nup+ndn,:), area_bnd_sum(:,:,1:1+nup+ndn,:), & - area_cen_final(:,:,1:1+nup+ndn,:), area_cen_sum(:,:,1:1+nup+ndn,:), & - mass_bnd_final(:,:,1:1+nup+ndn,:), mass_bnd_sum(:,:,1:1+nup+ndn,:), & - mass_cen_final(:,:,1:1+nup+ndn,:), mass_cen_sum(:,:,1:1+nup+ndn,:), & - ent_bnd_sum(:,:,1:1+nup+ndn,:), & - rh_cen_sum(:,:,1:1+nup+ndn,:), & - qcloud_cen_sum(:,:,1:1+nup+ndn,:), qcloud_bf_cen_sum(:,:,1:1+nup+ndn,:), qrain_cen_sum(:,:,1:1+nup+ndn,:), & - qice_cen_sum(:,:,1:1+nup+ndn,:), qsnow_cen_sum(:,:,1:1+nup+ndn,:), & - qgraup_cen_sum(:,:,1:1+nup+ndn,:), & - qlsink_cen_sum(:,:,1:1+nup+ndn,:), precr_cen_sum(:,:,1:1+nup+ndn,:), & - precsolid_cen_sum(:,:,1:1+nup+ndn,:), precall_cen_sum(:,:,1:1+nup+ndn,:), & - qlsink_bf_cen_sum(:,:,1:1+nup+ndn,:), qlsink_avg_cen_sum(:,:,1:1+nup+ndn,:), & - prain_cen_sum(:,:,1:1+nup+ndn,:) ) - - wup_thresh(:) = 0.0 - wdown_thresh(:) = 0.0 - - ntavg1 = ntavg1_ss / dt - ntavg2 = ntavg2_ss / dt - itavg1 = 0 - itavg2 = 0 - -end subroutine ecpp_crm_init -!--------------------------------------------------------------------------------------- - -!======================================================================================= -subroutine ecpp_crm_cleanup () - -! deallocate variables - deallocate (updraftbase, & - updrafttop ) - deallocate (dndraftbase, & - dndrafttop ) - - deallocate( qlsink, precr, precsolid, rh, qvs) - - deallocate( qlsink_bf, prain, qcloud_bf) - - deallocate( qcloudsum1, qcloud_bfsum1, qrainsum1, & - qicesum1, qsnowsum1, qgraupsum1, & - qlsinksum1, precrsum1, & - precsolidsum1, precallsum1, & - altsum1, rhsum1, cf3dsum1, & - wwsum1, wwsqsum1, tkesgssum1, & - qlsink_bfsum1, prainsum1, qvssum1 ) - - deallocate( & - xkhvsum, wup_thresh, wdown_thresh ) - - deallocate(wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum) - - deallocate( area_bnd_final, & - area_bnd_sum, & - area_cen_final, & - area_cen_sum, & - mass_bnd_final, & - mass_bnd_sum, & - mass_cen_final, & - mass_cen_sum, & - ent_bnd_sum, & - rh_cen_sum, & - qcloud_cen_sum, & - qcloud_bf_cen_sum, & - qrain_cen_sum, & - qice_cen_sum, & - qsnow_cen_sum, & - qgraup_cen_sum, & - qlsink_cen_sum, & - precr_cen_sum, & - precsolid_cen_sum, & - precall_cen_sum, & - qlsink_bf_cen_sum, & - qlsink_avg_cen_sum, & - prain_cen_sum ) - -end subroutine ecpp_crm_cleanup -!--------------------------------------------------------------------------------------- - -!======================================================================================== -subroutine ecpp_crm_stat() - - use crmx_module_ecpp_stats - use module_data_ecpp1, only: afrac_cut - use crmx_grid, only: nx, ny, nzm, pres - use crmx_vars, only: w, tabs, p, CF3D - use crmx_sgs, only: tke, tk - use crmx_microphysics, only: micro_field, iqv, iqci, iqr, iqs, iqg, cloudliq - use crmx_module_mp_GRAUPEL, only: POLYSVP -#ifdef CLUBB_CRM - use crmx_clubbvars, only: wp2 - use crmx_sgs, only: tk_clubb -#endif - implicit none - - integer :: i, ierr, i_tidx, j, & - ncnt1, ncnt2 - - integer :: nup, ndn - integer :: kbase, ktop, m - integer :: ii, jj, kk - integer :: icl, icls, ipr - - real,dimension(nx, ny, nzm) :: & - qcloud, qrain, qice, qsnow, qgraup, & - precall, alt, xkhv - real, dimension(nx, ny, nzstag) :: ww, wwsq - - real :: EVS - -!------------------------------------------------------------------------ -! Main code section... -!------------------------------------------------------------------------ - - ndn = ndndraft ; nup = nupdraft - - itavg1 = itavg1 + 1 - itavg2 = itavg2 + 1 - ndn = ndndraft ; nup = nupdraft - -! Get values from SAM cloud fields - qcloud(1:nx,1:ny,1:nzm) = cloudliq(1:nx,1:ny,1:nzm) - qrain(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqr) - qice(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqci) - qsnow(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqs) - qgraup(1:nx,1:ny,1:nzm) = micro_field(1:nx,1:ny,1:nzm,iqg) - - precall(:,:,:)= precr(:,:,:) + precsolid(:,:,:) - - do ii=1, nx - do jj=1, ny - do kk=1, nzm - EVS = POLYSVP(tabs(ii,jj,kk),0) ! saturation water vapor pressure (PA) - qvs(ii,jj,kk) = .622*EVS/(pres(kk)*100.-EVS) ! pres(kk) with unit of hPa -! rh(ii,jj,kk) = micro_field(ii,jj,kk,iqv)/QVS ! unit 0-1 -! rh(ii,jj,kk) = min(1.0, rh(ii,jj,kk)) ! RH is diagnosed in microphysics - alt(ii,jj,kk) = 287.*tabs(ii,jj,kk)/(100.*pres(kk)) - - end do - end do - end do - - ww(:,:,:) = w(1:nx,1:ny,1:nzstag) -#ifdef CLUBB_CRM - wwsq(:,:,:) = sqrt(wp2(1:nx, 1:ny, 1:nzstag)) -#else - wwsq(:,:,:) = 0. ! subgrid vertical velocity is not used in the current version of ECPP. -#endif - -#ifdef CLUBB_CRM - xkhv(:,:,:) = tk_clubb(1:nx,1:ny,1:nzm) ! eddy viscosity m2/s -#else - xkhv(:,:,:) = tk(1:nx,1:ny,1:nzm) ! eddy viscosity m2/s -#endif - -!+++mhwangtest -! do ii=1, nx -! do jj=1, ny -! do kk=1, nzm -! if(prain(ii,jj,kk).gt.1.0e-15) then -! if(qcloud_bf(ii,jj,kk)*qlsink_bf(ii,jj,kk)/prain(ii,jj,kk) .lt. 0.90) then -! write(0, *) 'qcloud_bf*qlsink_bf/prain, qlsink_bf, qlsink, qlcoud_bf, qcloud, prain', qcloud_bf(ii,jj,kk)*qlsink_bf(ii,jj,kk)/prain(ii,jj,kk), & -! qlsink_bf(ii, jj, kk) * 86400, qlsink(ii, jj, kk)*86400, qcloud_bf(ii, jj, kk), qcloud(ii, jj, kk), prain(ii, jj, kk) -! end if -! end if -! end do -! end do -! end do -!---mhwangest - - -! Increment the 3-D running sums for averaging period 1. - call rsums1( qcloud, qcloudsum1(:,:,:), & - qcloud_bf, qcloud_bfsum1(:,:,:), & - qrain, qrainsum1(:,:,:), & - qice, qicesum1(:,:,:), & - qsnow, qsnowsum1(:,:,:), & - qgraup, qgraupsum1(:,:,:), & - qlsink, qlsinksum1(:,:,:), & - precr, precrsum1(:,:,:), & - precsolid, precsolidsum1(:,:,:), & - precall, precallsum1(:,:,:), & - alt, altsum1(:,:,:), & - rh, rhsum1(:,:,:), & - CF3D, cf3dsum1(:,:,:), & - ww, wwsum1(:,:,:), & - wwsq, wwsqsum1(:,:,:), & - tke(1:nx,1:ny,1:nzm), tkesgssum1(:,:,:), & - qlsink_bf, qlsink_bfsum1(:,:,:), & - prain, prainsum1(:,:,:), & - qvs, qvssum1(:,:,:) ) - -! Increment the running sums for the level two variables that are not -! already incremented. Consolidate from 3-D to 1-D columns. - call rsums2( & - nx, ny, nzm, & - xkhv, xkhvsum(:) ) - -! Check if we have reached the end of the level 1 time averaging period. - if( mod(itavg1,ntavg1) == 0 ) then - -! Turn the running sums into averages. - if( itavg1 /= 0 ) then - ncnt1 = ntavg1 - else - ncnt1 = 1 - end if - call rsums1ToAvg( ncnt1, qcloudsum1(:,:,:), qcloud_bfsum1(:,:,:), qrainsum1(:,:,:), & - qicesum1(:,:,:), qsnowsum1(:,:,:), & - qgraupsum1(:,:,:), & - qlsinksum1(:,:,:), precrsum1(:,:,:), & - precsolidsum1(:,:,:), precallsum1(:,:,:), & - altsum1(:,:,:), rhsum1(:,:,:), cf3dsum1(:,:,:), & - wwsum1(:,:,:), wwsqsum1(:,:,:), & - tkesgssum1(:,:,:), qlsink_bfsum1(:,:,:), & - prainsum1(:,:,:), qvssum1(:,:,:) ) - -! Determine draft categories and get running sums of them. - call categorization_stats( .true., & - nx, ny, nzm, nupdraft, ndndraft, ndraft_max, & - mode_updnthresh, upthresh, downthresh, & - upthresh2, downthresh2, cloudthresh, prcpthresh, & - cloudthresh_trans, precthresh_trans, & - qvssum1(:,:,:), & - plumetype, allcomb, & - updraftbase(1:nupdraft), updrafttop(1:nupdraft), & - dndraftbase(1:ndndraft), dndrafttop(1:ndndraft), & - qcloudsum1(:,:,:), qcloud_bfsum1(:,:,:), qrainsum1(:,:,:), & - qicesum1(:,:,:), qsnowsum1(:,:,:), qgraupsum1(:,:,:), & - qlsinksum1(:,:,:), precrsum1(:,:,:), & - precsolidsum1(:,:,:), precallsum1(:,:,:), & - altsum1(:,:,:), rhsum1(:,:,:), cf3dsum1(:,:,:), & - wwsum1(:,:,:), wwsqsum1(:,:,:), tkesgssum1(:,:,:), & - qlsink_bfsum1(:,:,:), prainsum1(:,:,:), & - area_bnd_final(:,:,1:1+ndn+nup,:), area_cen_final(:,:,1:1+ndn+nup,:), & - area_bnd_sum(:,:,1:1+ndn+nup,:), area_cen_sum(:,:,1:1+ndn+nup,:), & - ent_bnd_sum(:,:,1:1+ndn+nup,:), mass_bnd_sum(:,:,1:1+ndn+nup,:), & - rh_cen_sum(:,:,1:1+ndn+nup,:), & - qcloud_cen_sum(:,:,1:1+ndn+nup,:), qcloud_bf_cen_sum(:,:,1:1+ndn+nup,:), qrain_cen_sum(:,:,1:1+ndn+nup,:), & - qice_cen_sum(:,:,1:1+ndn+nup,:), qsnow_cen_sum(:,:,1:1+ndn+nup,:), & - qgraup_cen_sum(:,:,1:1+ndn+nup,:), & - qlsink_cen_sum(:,:,1:1+ndn+nup,:), precr_cen_sum(:,:,1:1+ndn+nup,:), & - precsolid_cen_sum(:,:,1:1+nup+ndn,:), precall_cen_sum(:,:,1:1+nup+ndn,:), & - qlsink_bf_cen_sum(:,:,1:1+nup+ndn,:), prain_cen_sum(:,:,1:1+nup+ndn,:), & - wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum, & - wup_thresh, wdown_thresh ) - -! If we want final area categories based on the last avg1 period in each -! avg2 then we need to zero out the running sum just created for the areas -! if it is not the last block of time in ntavg2 - if( areaavgtype==1 .and. .not. mod(itavg2,ntavg2)==0 ) then - call zero_out_areas( & - area_bnd_final(:,:,1:1+ndn+nup,:), & - area_cen_final(:,:,1:1+ndn+nup,:) ) - end if - -! Done with time level one averages so zero them out for next period. - call zero_out_sums1( qcloudsum1(:,:,:), qcloud_bfsum1(:,:,:), qrainsum1(:,:,:), & - qicesum1(:,:,:), qsnowsum1(:,:,:), qgraupsum1(:,:,:), & - qlsinksum1(:,:,:), precrsum1(:,:,:), & - precsolidsum1(:,:,:), precallsum1(:,:,:), & - altsum1(:,:,:), rhsum1(:,:,:), cf3dsum1(:,:,:), & - wwsum1(:,:,:), wwsqsum1(:,:,:), tkesgssum1(:,:,:), & - qlsink_bfsum1(:,:,:), prainsum1(:,:,:), qvssum1(:,:,:) ) - - end if !End of time level one averaging period - -! Check if we have reached the end of a level 2 averaging period. - if( mod(itavg2,ntavg2) == 0 ) then - -! Turn the running sums into averages. ncnt1 in this case is the number -! of calls to categorization_stats during the level 2 averaging period, -! which increment the bnd/cen arrays. - if( itavg2 /= 0 ) then - ncnt1 = ntavg2_ss/ntavg1_ss - ncnt2 = ntavg2 - else - ncnt1 = 1 - ncnt2 = 1 - end if - - call rsums2ToAvg( areaavgtype, nx, ny, ncnt1, ncnt2, & - xkhvsum(:), & - wwqui_cen_sum(:), wwqui_bnd_sum(:), wwqui_cloudy_cen_sum(:), wwqui_cloudy_bnd_sum(:), & - area_bnd_final(:,:,1:1+ndn+nup,:), area_bnd_sum(:,:,1:1+ndn+nup,:), & - area_cen_final(:,:,1:1+ndn+nup,:), area_cen_sum(:,:,1:1+ndn+nup,:), & - mass_bnd_final(:,:,1:1+ndn+nup,:), mass_bnd_sum(:,:,1:1+ndn+nup,:), & - mass_cen_final(:,:,1:1+ndn+nup,:), mass_cen_sum(:,:,1:1+ndn+nup,:), & - ent_bnd_sum(:,:,1:1+ndn+nup,:), & - rh_cen_sum(:,:,1:1+ndn+nup,:), & - qcloud_cen_sum(:,:,1:1+ndn+nup,:), qcloud_bf_cen_sum(:,:,1:1+ndn+nup,:), qrain_cen_sum(:,:,1:1+ndn+nup,:), & - qice_cen_sum(:,:,1:1+ndn+nup,:), qsnow_cen_sum(:,:,1:1+ndn+nup,:), & - qgraup_cen_sum(:,:,1:1+ndn+nup,:), & - qlsink_cen_sum(:,:,1:1+ndn+nup,:), precr_cen_sum(:,:,1:1+ndn+nup,:), & - precsolid_cen_sum(:,:,1:1+ndn+nup,:), precall_cen_sum(:,:,1:1+ndn+nup,:), & - qlsink_bf_cen_sum(:,:,1:1+ndn+nup,:), prain_cen_sum(:,:,1:1+ndn+nup,:) ) - -! get in-cloud value for rh, qcloud, qrain, qice, qsnow, qgraup, -! percr, precsolid, and precall. (qlsink is already in-cloud values) - do kk=1, nzm - do icl=1, NCLASS_CL - do icls=1, ncls_ecpp_in - do ipr=1, NCLASS_PR - if(area_cen_sum(kk, icl, icls, ipr).gt.afrac_cut) then - rh_cen_sum(kk,icl,icls,ipr) = rh_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) - qcloud_cen_sum(kk,icl,icls,ipr) = qcloud_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) - qcloud_bf_cen_sum(kk,icl,icls,ipr) = qcloud_bf_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) - qrain_cen_sum(kk,icl,icls,ipr) = qrain_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) - qice_cen_sum(kk,icl,icls,ipr) = qice_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) - qsnow_cen_sum(kk,icl,icls,ipr) = qsnow_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) - qgraup_cen_sum(kk,icl,icls,ipr) = qgraup_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) - precr_cen_sum(kk,icl,icls,ipr) = precr_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) - precsolid_cen_sum(kk,icl,icls,ipr) = precsolid_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) - precall_cen_sum(kk,icl,icls,ipr) = precall_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) - prain_cen_sum(kk,icl,icls,ipr) = prain_cen_sum(kk,icl,icls,ipr)/area_cen_sum(kk,icl,icls,ipr) - if(qcloud_bf_cen_sum(kk,icl,icls,ipr).gt.1.0e-10) then - qlsink_avg_cen_sum(kk,icl,icls,ipr) = min(1.0/ntavg2_ss, & - prain_cen_sum(kk,icl,icls,ipr)/qcloud_bf_cen_sum(kk,icl,icls,ipr)) - else - qlsink_avg_cen_sum(kk,icl,icls,ipr) = 0.0 - end if - qlsink_bf_cen_sum(kk,icl,icls,ipr) = min(1.0/ntavg2_ss, qlsink_bf_cen_sum(kk,icl,icls,ipr)) - qlsink_cen_sum(kk,icl,icls,ipr) = min(1.0/ntavg2_ss, qlsink_cen_sum(kk,icl,icls,ipr)) - else - rh_cen_sum(kk,icl,icls,ipr) = 0.0 - qcloud_cen_sum(kk,icl,icls,ipr) = 0.0 - qcloud_bf_cen_sum(kk,icl,icls,ipr) = 0.0 - qrain_cen_sum(kk,icl,icls,ipr) = 0.0 - qice_cen_sum(kk,icl,icls,ipr) = 0.0 - qsnow_cen_sum(kk,icl,icls,ipr) = 0.0 - qgraup_cen_sum(kk,icl,icls,ipr) = 0.0 - precr_cen_sum(kk,icl,icls,ipr) = 0.0 - precsolid_cen_sum(kk,icl,icls,ipr) = 0.0 - precall_cen_sum(kk,icl,icls,ipr) = 0.0 - qlsink_bf_cen_sum(kk,icl,icls,ipr) = 0.0 - prain_cen_sum(kk,icl,icls,ipr) = 0.0 - qlsink_avg_cen_sum(kk,icl,icls,ipr) = 0.0 - qlsink_bf_cen_sum(kk,icl,icls,ipr) = 0.0 - qlsink_cen_sum(kk,icl,icls,ipr) = 0.0 - end if - end do - end do - end do -! -! calculate vertical velocity variance for quiescent class - if(sum(area_cen_sum(kk,1:NCLASS_CL, QUI, 1:NCLASS_PR)).gt.afrac_cut) then - wwqui_cen_sum(kk) = wwqui_cen_sum(kk) / sum(area_cen_sum(kk,1:NCLASS_CL, QUI, 1:NCLASS_PR)) - else - wwqui_cen_sum(kk) = 0.0 - end if - if(sum(area_cen_sum(kk,CLD, QUI, 1:NCLASS_PR)).gt.afrac_cut) then - wwqui_cloudy_cen_sum(kk) = wwqui_cloudy_cen_sum(kk) / sum(area_cen_sum(kk, CLD, QUI, 1:NCLASS_PR)) - else - wwqui_cloudy_cen_sum(kk) = 0.0 - end if - - end do ! kk -! -! calcualte vertical velocity variance for quiescent calss at lay boundary - do kk=1, nzm+1 - if(sum(area_bnd_sum(kk,1:NCLASS_CL, QUI, 1:NCLASS_PR)).gt.afrac_cut) then - wwqui_bnd_sum(kk) = wwqui_bnd_sum(kk) / sum(area_bnd_sum(kk,1:NCLASS_CL, QUI, 1:NCLASS_PR)) - else - wwqui_bnd_sum(kk) = 0.0 - end if - if(sum(area_bnd_sum(kk,CLD, QUI, 1:NCLASS_PR)).gt.afrac_cut) then - wwqui_cloudy_bnd_sum(kk) = wwqui_cloudy_bnd_sum(kk) / sum(area_bnd_sum(kk, CLD, QUI, 1:NCLASS_PR)) - else - wwqui_cloudy_bnd_sum(kk) = 0.0 - end if - end do - - end if !End of level two time averaging period - -end subroutine ecpp_crm_stat - -#endif /*ECPP*/ -end module crmx_module_ecpp_crm_driver diff --git a/src/physics/spcam/crm/crmx_module_ecpp_stats.F90 b/src/physics/spcam/crm/crmx_module_ecpp_stats.F90 deleted file mode 100644 index b1f7bf909f..0000000000 --- a/src/physics/spcam/crm/crmx_module_ecpp_stats.F90 +++ /dev/null @@ -1,1805 +0,0 @@ -!------------------------------------------------------------------------ -! F90 module to calculate cloud-model stats needed as innput into ECPP. -! -! Routines in this module: -! boundary_inout -! categorization_stats -! cloud_prcp_check -! determine_transport_thresh -! rsums1 -! rsums1ToAvg -! rsums2 -! rsums2ToAvg -! setup_class_masks -! xyrsumof2d -! xyrsumof3d -! zero_out_areas -! zero_out_sums1 -! zero_out_sums2 -! -! William.Gustafson@pnl.gov; 20-Jul-2006 -! Last modified: 16-Apr-2009, William.Gustafson@pnl.gov -!------------------------------------------------------------------------ -module crmx_module_ecpp_stats -#ifdef ECPP - - use crmx_ecppvars, only: QUI, UP1, DN1, NCLASS_TR, NCLASS_CL, CLR, CLD, NCLASS_PR, PRN, PRY - use cam_abortutils,only: endrun - implicit none - -contains - -!------------------------------------------------------------------------ -subroutine boundary_inout( & - nx, ny, nz, & - uu, vv, & - u_insum, u_outsum, v_insum, v_outsum ) -! Calculates the average in/out-flow velocities and increments the -! running sum of the results. -! William.Gustafson@pnl.gov; 25-Jul-2006 -!------------------------------------------------------------------------ - integer, intent(in) :: nx, ny, nz - real, dimension(:,:,:), intent(in) :: uu, vv - real, dimension(:), intent(inout) :: u_insum, u_outsum, v_insum, v_outsum - - integer :: i, j, k, nxstag, nystag - real :: spd_in, spd_out - - nxstag = nx+1 - nystag = ny+1 -! -! Running sum of inflow/outflow horizontal velocities... -! -! 02-nov-2006 r.easter -! calculate separate in/outflow along x and y boundaries -! because of possibility of fixed boundary conditions -! and non-square domains -! for u_in & u_out, we want the "lineal" average along -! the west and east boundaries, so divide by ny -! for v_in & v_out, we want the "lineal" average along -! the south and north boundaries, so divide by nx -! previous code version divided by "nin" and "nout" -! which is incorrect -! - do k=1,nz - - spd_in = 0.; spd_out = 0. - do j=1,ny - ! Western boundary - if( uu(1,j,k) >= 0. ) then - spd_in = spd_in + uu(1,j,k) - else - spd_out = spd_out - uu(1,j,k) - end if - - ! Eastern boundary - if( uu(nxstag,j,k) <= 0. ) then - spd_in = spd_in - uu(nxstag,j,k) - else - spd_out = spd_out + uu(nxstag,j,k) - end if - end do !j=ny - u_insum(k) = u_insum(k) + spd_in /real(ny) - u_outsum(k) = u_outsum(k) + spd_out/real(ny) - - spd_in = 0.; spd_out = 0. - do i=1,nx - ! Southern boundary - if( vv(i,1,k) >= 0. ) then - spd_in = spd_in + vv(i,1,k) - else - spd_out = spd_out - vv(i,1,k) - end if - - ! Northern boundary - if( vv(i,nystag,k) <= 0. ) then - spd_in = spd_in - vv(i,nystag,k) - else - spd_out = spd_out + vv(i,nystag,k) - end if - end do !i=nx - v_insum(k) = v_insum(k) + spd_in /real(nx) - v_outsum(k) = v_outsum(k) + spd_out/real(nx) - - end do !k=nz -end subroutine boundary_inout - -!------------------------------------------------------------------------ -subroutine rsums1( qcloud, qcloudsum1, & - qcloud_bf, qcloud_bfsum1, & - qrain, qrainsum1, & - qice, qicesum1, & - qsnow, qsnowsum1, & - qgraup, qgraupsum1, & - qlsink, qlsinksum1, & - precr, precrsum1, & - precsolid, precsolidsum1, & - precall, precallsum1, & - alt, altsum1, & - rh, rhsum1, & - cf3d, cf3dsum1, & - ww, wwsum1, & - wwsq, wwsqsum1, & - tkesgs, tkesgssum1, & - qlsink_bf, qlsink_bfsum1, & - prain, prainsum1, & - qvs, qvssum1 ) - -! Increments 3-D running sums for the variables averaged every -! ntavg1_mm minutes. -! William.Gustafson@pnl.gov; 20-Jul-2006 -! Last modified: William.Gustafson@pnl.gof; 25-Nov-2008 -!------------------------------------------------------------------------ - real, dimension(:,:,:), intent(in) :: & - qcloud, qcloud_bf, qrain, qice, qsnow, qgraup, & - qlsink, precr, precsolid, precall, & - alt, rh, cf3d, ww, wwsq, tkesgs, qlsink_bf, prain, qvs - real, dimension(:,:,:), intent(inout) :: & - qcloudsum1, qcloud_bfsum1, qrainsum1, & - qicesum1, qsnowsum1, qgraupsum1, & - qlsinksum1, precrsum1, precsolidsum1, precallsum1, & - altsum1, rhsum1, cf3dsum1, wwsum1, wwsqsum1, tkesgssum1, & - qlsink_bfsum1, prainsum1, qvssum1 - - qcloudsum1 = qcloudsum1 + qcloud - qcloud_bfsum1 = qcloud_bfsum1 + qcloud_bf - qrainsum1 = qrainsum1 + qrain - qicesum1 = qicesum1 + qice - qsnowsum1 = qsnowsum1 + qsnow - qgraupsum1 = qgraupsum1 + qgraup - qlsinksum1 = qlsinksum1 + qlsink*qcloud ! Note this is converted back in rsum2ToAvg - precrsum1 = precrsum1 + precr - precsolidsum1 = precsolidsum1 + precsolid - precallsum1 = precallsum1 + precall - altsum1 = altsum1 + alt - rhsum1 = rhsum1 + rh - cf3dsum1 = cf3dsum1 + cf3d - wwsum1 = wwsum1 + ww - wwsqsum1 = wwsqsum1 + wwsq - tkesgssum1 = tkesgssum1 + tkesgs - qlsink_bfsum1 = qlsink_bfsum1 + qlsink_bf*qcloud_bf ! Note this is converted back in rsum2ToAvg - prainsum1 = prainsum1 + prain - qvssum1 = qvssum1 + qvs - -end subroutine rsums1 - - -!------------------------------------------------------------------------ -subroutine rsums1ToAvg( nt, qcloudsum, qcloud_bfsum, qrainsum, & - qicesum, qsnowsum, qgraupsum, & - qlsinksum, precrsum, precsolidsum, precallsum, & - altsum, rhsum, cf3dsum, wwsum, wwsqsum, tkesgssum, qlsink_bfsum, prainsum, qvssum ) -! Turns the columns of running sums into averages for the level one time -! period. -! William.Gustafson@pnl.gov; 20-Jul-2006 -! Last modified: William.Gustafson@pnl.gov; 25-Nov-2008 -!------------------------------------------------------------------------ - integer, intent(in) :: nt - real, dimension(:,:,:), intent(inout) :: & - qcloudsum, qcloud_bfsum, qrainsum, qicesum, qsnowsum, qgraupsum, & - qlsinksum, precrsum, precsolidsum, precallsum, & - altsum, rhsum, cf3dsum, wwsum, wwsqsum, tkesgssum, qlsink_bfsum, prainsum, qvssum - - real :: ncount - -! print*,"...end of level one averaging period." - - ncount = real(nt) - - qcloudsum = qcloudsum/ncount - qcloud_bfsum = qcloud_bfsum/ncount - qrainsum = qrainsum/ncount - qicesum = qicesum/ncount - qsnowsum = qsnowsum/ncount - qgraupsum = qgraupsum/ncount - qlsinksum = qlsinksum/ncount - precrsum = precrsum/ncount - precsolidsum = precsolidsum/ncount - precallsum = precallsum/ncount - altsum = altsum/ncount - rhsum = rhsum/ncount - cf3dsum = cf3dsum/ncount - wwsum = wwsum/ncount - wwsqsum = wwsqsum/ncount - tkesgssum = tkesgssum/ncount - qlsink_bfsum = qlsink_bfsum/ncount - prainsum = prainsum/ncount - qvssum = qvssum/ncount -end subroutine rsums1ToAvg - -!------------------------------------------------------------------------ -subroutine rsums2( & - nx, ny, nz, & - xkhv, xkhvsum ) -! Increment the running sums for the level 2 time averaging period for -! variables that are not already incremented (i.e. not the area and mass -! flux categories and in/out-flow speed that are already done). The 3-D -! variables are collapsed to 1-D columns. -! William.Gustafson@pnl.gov; 20-Jul-2006 -! Last modified: William.Gustafson@pnl.gov; 25-Nov-2008 -!------------------------------------------------------------------------ - integer, intent(in) :: nx, ny, nz - real, dimension(:,:,:), intent(in) :: & - xkhv - real, dimension(:), intent(inout) :: & - xkhvsum - - integer :: i -! -! Running sums of the simple variables that will be averaged... -! - - call xyrsumof3d(xkhv,xkhvsum) -end subroutine rsums2 - - -!------------------------------------------------------------------------ -subroutine rsums2ToAvg( areaavgtype, nx, ny, nt1, nt2, & - xkhvsum, & - wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum, & - area_bnd_final, area_bnd_sum, & - area_cen_final, area_cen_sum, & - mass_bnd_final, mass_bnd_sum, & - mass_cen_final, mass_cen_sum, & - ent_bnd_sum, & - rh_cen_sum, & - qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & - qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & - qlsink_cen_sum, precr_cen_sum, & - precsolid_cen_sum, precall_cen_sum, & - qlsink_bf_cen_sum, prain_cen_sum ) - -! Turns the columns of level two time period running sums into averages. -! Note that variables that the statistics variables use a different -! number of times. -! -! nt1 = time length of average for area and mass for areaavgtype=2 -! nt2 = time length of average for 2nd averaging period (the whole time) -! -! William.Gustafson@pnl.gov; 20-Jul-2006 -! Last modified: 16-Apr-2009, wig -!------------------------------------------------------------------------ - integer, intent(in) :: areaavgtype, nx, ny, nt1, nt2 - real, dimension(:), intent(inout) :: & - xkhvsum, wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum - real, dimension(:,:,:,:), intent(inout) :: & - area_bnd_final, area_bnd_sum, & - area_cen_final, area_cen_sum, & - mass_bnd_final, mass_bnd_sum, & - mass_cen_final, mass_cen_sum, & - ent_bnd_sum, rh_cen_sum, & - qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & - qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & - qlsink_cen_sum, precr_cen_sum, & - precsolid_cen_sum, precall_cen_sum, & - qlsink_bf_cen_sum, prain_cen_sum - integer :: i, k - real :: ncount2, ncountwind, thesum - -! print*,"...end of level two averaging period." - - ncount2 = real(nx*ny*nt2) - ncountwind = real((nx+1)*ny*nt2) - - xkhvsum = xkhvsum/ncount2 - -! Only touch final areas if doing averages over ntavg2 - if( areaavgtype == 2 ) then - area_bnd_final = area_bnd_final/real(nt1) - area_cen_final = area_cen_final/real(nt1) - end if - - area_bnd_sum = area_bnd_sum/real(nt1) - area_cen_sum = area_cen_sum/real(nt1) - ent_bnd_sum = ent_bnd_sum/real(nt1) - mass_bnd_sum = mass_bnd_sum/real(nt1) - mass_cen_sum = mass_cen_sum/real(nt1) - rh_cen_sum = rh_cen_sum/real(nt1) - qcloud_cen_sum = qcloud_cen_sum/real(nt1) - qcloud_bf_cen_sum = qcloud_bf_cen_sum/real(nt1) - qrain_cen_sum = qrain_cen_sum/real(nt1) - qice_cen_sum = qice_cen_sum/real(nt1) - qsnow_cen_sum = qsnow_cen_sum/real(nt1) - qgraup_cen_sum = qgraup_cen_sum/real(nt1) - do k=1,size(qlsink_cen_sum,1) !Note: must be after qcloud_cen_sum is turned into an avg - ! see rsums1 where qlsink=qlsink*qcloud - thesum = sum(qcloud_cen_sum(k,:,:,:)) - if( thesum > 1e-25 ) then - qlsink_cen_sum(k,:,:,:) = qlsink_cen_sum(k,:,:,:)/thesum/real(nt1) - else - qlsink_cen_sum(k,:,:,:) = 0. - end if - end do - precr_cen_sum = precr_cen_sum/real(nt1) - precsolid_cen_sum = precsolid_cen_sum/real(nt1) - precall_cen_sum = precall_cen_sum/real(nt1) - do k=1,size(qlsink_bf_cen_sum,1) !Note: must be after qcloud_bf_cen_sum is turned into an avg - ! see rsums1 where qlsink=qlsink*qcloud - thesum = sum(qcloud_bf_cen_sum(k,:,:,:)) - if( thesum > 1e-25 ) then - qlsink_bf_cen_sum(k,:,:,:) = qlsink_bf_cen_sum(k,:,:,:)/thesum/real(nt1) - else - qlsink_bf_cen_sum(k,:,:,:) = 0. - end if - end do - - prain_cen_sum = prain_cen_sum/real(nt1) - wwqui_cen_sum = wwqui_cen_sum / real(nt1) - wwqui_bnd_sum = wwqui_bnd_sum / real(nt1) - wwqui_cloudy_cen_sum = wwqui_cloudy_cen_sum / real(nt1) - wwqui_cloudy_bnd_sum = wwqui_cloudy_bnd_sum / real(nt1) - -end subroutine rsums2ToAvg - - -!------------------------------------------------------------------------ -subroutine xyrsumof2d(xin,sumout) -! For a 2-D intput variable (x,y), the x & y dimensions are summed and -! added to a running sum. -! William.Gustafson@pnl.gov; 25-Apr-2006 -!------------------------------------------------------------------------ - real, dimension(:,:), intent(in) :: xin - real, intent(out) :: sumout - - sumout = 0.0 - sumout = sumout + sum(xin(:,:)) -end subroutine xyrsumof2d - - -!------------------------------------------------------------------------ -subroutine xyrsumof3d(xin,sumout) -! For a 3-D intput variable (x,y,z), the x & y dimensions are summed and -! added to a column to return a running sum. -! William.Gustafson@pnl.gov; 26-Jun-2006 -!------------------------------------------------------------------------ - real, dimension(:,:,:), intent(in) :: xin - real, dimension(:), intent(out) :: sumout - - integer :: k - - sumout(:) = 0.0 - do k=1,ubound(sumout,1) - sumout(k) = sumout(k) + sum(xin(:,:,k)) - end do -end subroutine xyrsumof3d - - -!------------------------------------------------------------------------ -subroutine zero_out_areas( & - area_bnd_final, area_cen_final ) -! Zeros out the running sums of final area categories. -! William.Gustafson@pnl.gov; 19-Nov-2008 -!------------------------------------------------------------------------ - real, dimension(:,:,:,:), intent(out) :: & - area_bnd_final, area_cen_final - - area_bnd_final=0. - area_cen_final=0. -end subroutine zero_out_areas - - -!------------------------------------------------------------------------ -subroutine zero_out_sums1( qcloudsum, qcloud_bfsum, qrainsum, & - qicesum, qsnowsum, qgraupsum, & - qlsink, precr, precsolid, precall, & - altsum, rhsum, cf3dsum, wwsum, wwsqsum, tkesgssum, & - qlsink_bfsum, prainsum, qvssum ) -! Zeros out running sum arrays that are averaged every ntavg1_mm minutes. -! William.Gustafson@pnl.gov; 20-Jul-2006 -! Last modified: William.Gustafson@pnl.gov; 25-Nov-2008 -!------------------------------------------------------------------------ - real,dimension(:,:,:), intent(out) :: & - qcloudsum, qcloud_bfsum, qrainsum, qicesum, qsnowsum, qgraupsum, & - qlsink, precr, precsolid, precall, & - altsum, rhsum, cf3dsum, wwsum, wwsqsum, tkesgssum, qlsink_bfsum, prainsum, qvssum - - qcloudsum=0. - qcloud_bfsum=0. - qrainsum=0. - qicesum=0. - qsnowsum=0. - qgraupsum=0. - qlsink=0. - precr=0. - precsolid=0. - precall=0. - altsum=0. - rhsum=0. - cf3dsum=0. - wwsum=0. - wwsqsum=0. - tkesgssum=0. - qlsink_bfsum=0.0 - prainsum=0.0 - qvssum=0.0 -end subroutine zero_out_sums1 - - -!------------------------------------------------------------------------ -subroutine zero_out_sums2( & - xkhvsum, & - wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum, & - area_bnd_final, area_bnd_sum, area_cen_final, area_cen_sum, & - mass_bnd_final, mass_bnd_sum, mass_cen_final, mass_cen_sum, & - ent_bnd_sum, & - rh_cen_sum, & - qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & - qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & - qlsink_cen_sum, & - precr_cen_sum, precsolid_cen_sum, precall_cen_sum, & - qlsink_bf_cen_sum, qlsink_avg_cen_sum, prain_cen_sum ) -! Zeros out running sum arrays that are averaged every ntavg2_mm minutes. -! William.Gustafson@pnl.gov; 20-Jul-2006 -! Last modified: 25-Nov-2008, wig -!------------------------------------------------------------------------ - real,dimension(:), intent(out) :: & - xkhvsum, wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum - real,dimension(:,:,:,:), intent(out) :: & - area_bnd_final, area_bnd_sum, area_cen_final, area_cen_sum, & - mass_bnd_final, mass_bnd_sum, mass_cen_final, mass_cen_sum, & - ent_bnd_sum, rh_cen_sum, & - qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & - qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & - qlsink_cen_sum, & - precr_cen_sum, precsolid_cen_sum, precall_cen_sum, & - qlsink_bf_cen_sum, qlsink_avg_cen_sum, prain_cen_sum - - xkhvsum=0. - wwqui_cen_sum=0. - wwqui_bnd_sum=0. - wwqui_cloudy_cen_sum=0. - wwqui_cloudy_bnd_sum=0. - area_bnd_final=0. - area_bnd_sum=0. - area_cen_final=0. - area_cen_sum=0. - mass_bnd_final=0. - mass_bnd_sum=0. - mass_cen_final=0. - mass_cen_sum=0. - ent_bnd_sum=0. - rh_cen_sum=0. - qcloud_cen_sum=0. - qcloud_bf_cen_sum=0. - qrain_cen_sum=0. - qice_cen_sum=0. - qsnow_cen_sum=0. - qgraup_cen_sum=0. - qlsink_cen_sum=0. - precr_cen_sum=0. - precsolid_cen_sum=0. - precall_cen_sum=0. - qlsink_bf_cen_sum=0. - qlsink_avg_cen_sum=0. - prain_cen_sum=0. -end subroutine zero_out_sums2 - - -!------------------------------------------------------------------------ -subroutine categorization_stats( domass, & - nx, ny, nz, nupdraft, ndndraft, ndraft_max, & - mode_updnthresh, upthresh, downthresh, & - upthresh2, downthresh2, cloudthresh, prcpthresh, & - cloudthresh_trans, precthresh_trans, & - qvs, & - plumetype, allcomb, & -! ctime, & - updraftbase, updrafttop, dndraftbase, dndrafttop, & - qcloud, qcloud_bf, qrain, qice, qsnow, qgraup, & - qlsink, precr, precsolid, precall, & - alt, rh, cf3d, ww, wwsq, tkesgs, & - qlsink_bf, prain, & - area_bnd_final, area_cen_final, & - area_bnd_sum, area_cen_sum, ent_bnd_sum, mass_bnd_sum, & - rh_cen_sum, & - qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & - qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & - qlsink_cen_sum, precr_cen_sum, & - precsolid_cen_sum, precall_cen_sum, & - qlsink_bf_cen_sum, prain_cen_sum, & - wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum, & - wup_thresh, wdown_thresh ) -! -! William.Gustafson@pnl.gov; 25-Nov-2008 -! Last modified: William.Gustafson@pnl.gov; 16-Apr-2009 -!------------------------------------------------------------------------ - use module_data_ecpp1, only: a_quiescn_minaa -! -! Subroutine arguments... -! - logical, intent(in) :: domass !calculate mass fluxes? T/F - integer, intent(in) :: nx, ny, nz, nupdraft, ndndraft, ndraft_max, & - mode_updnthresh, plumetype - logical, intent(in) :: allcomb - real, intent(in) :: & - cloudthresh, prcpthresh, & - downthresh, upthresh, & - downthresh2, upthresh2 - real, intent(in) :: cloudthresh_trans, precthresh_trans -! type(time), intent(in) :: ctime - integer, dimension(:), intent(in) :: & - updraftbase, updrafttop, & - dndraftbase, dndrafttop - real, dimension(:,:,:), intent(in) :: & - qcloud, qcloud_bf, qrain, qice, qsnow, qgraup, & - qlsink, precr, precsolid, precall, & - alt, rh, cf3d, ww, wwsq, tkesgs, qlsink_bf, prain, qvs - real, dimension(:,:,:,:), intent(inout) :: & - area_bnd_final, area_cen_final, & - area_bnd_sum, area_cen_sum, ent_bnd_sum, mass_bnd_sum, & - rh_cen_sum, & - qcloud_cen_sum, qcloud_bf_cen_sum, qrain_cen_sum, & - qice_cen_sum, qsnow_cen_sum, qgraup_cen_sum, & - qlsink_cen_sum, precr_cen_sum, & - precsolid_cen_sum, precall_cen_sum, qlsink_bf_cen_sum, prain_cen_sum - - real, dimension(:), intent(inout) :: wwqui_cen_sum, wwqui_bnd_sum, wwqui_cloudy_cen_sum, wwqui_cloudy_bnd_sum - real, dimension(nz+1), intent(out) :: wdown_thresh, wup_thresh -! -! Local vars... -! - real, dimension(nx,ny,nz+1,NCLASS_CL,ndraft_max,NCLASS_PR) :: mask_bnd - real, dimension(nx,ny,nz,NCLASS_CL,ndraft_max,NCLASS_PR) :: mask_cen - real, dimension(nz+1,2) :: wdown_thresh_k, wup_thresh_k - real, dimension(nx,ny,nz) :: cloudmixr, cloudmixr_total, precmixr_total - integer, dimension(nx,ny) :: cloudtop - real, dimension(nz+1) :: wup_rms_k, wup_bar_k, wup_stddev_k & - , wdown_rms_k, wdown_bar_k, wdown_stddev_k - integer :: kup_top, kdown_top ! defined as the maximum level that allows updraft and downdraft - real :: mask, wwrho_k, wwrho_km1 - real, dimension(nz+1) :: rhoair ! layer-averaged air density - real :: wlarge = 1.0e10 ! m/s - real :: tmpa, tmpb - real, dimension(nz) :: thresh_factorbb_up, thresh_factorbb_down - real :: acen_quiesc, acen_up, acen_down, abnd_quiesc, abnd_up, abnd_down - real :: acen_quiesc_minaa - real :: wwqui_bar_cen(nz), wwqui_bar_bnd(nz+1), wwqui_cloudy_bar_cen(nz), wwqui_cloudy_bar_bnd(nz+1) - - integer :: i, icl, ipr, itr, j, k, km0, km1, km2, nxy, nzstag - integer :: iter - - logical :: thresh_calc_not_done - - acen_quiesc_minaa = a_quiescn_minaa + 0.01 - - nxy = nx*ny - nzstag = nz+1 - -! Transport classification is based on total condensate (cloudmixr_total), and -! cloudy (liquid) and clear (non-liquid) classification is based on liquid water, -! because wet deposition, aqueous chemistry, and droplet activaton, all are for liquid clouds. -! -! Minghuai Wang, 2010-04 -! - cloudmixr = qcloud - cloudmixr_total = qcloud + qice - -! total hydrometer (rain, snow, and graupel) - precmixr_total = qrain+qsnow+qgraup - - rhoair(:) = 0.0 - do j=1,ny - do i=1,nx -! -! Get cloud top height -! Cloud top height is used to determine whether there is updraft/downdraft. No updraft and -! downdraft is allowed above the condensate level (both liquid and ice). - cloudtop(i,j) = 1 !Default to bottom level if no cloud in column. - do k=nz,1,-1 - if( cloudmixr_total(i,j,k) >= cloudthresh_trans ) then -! -! 0.01*qvs may be too large at low level. -! if( cloudmixr_total(i,j,k) >= max(0.01*qvs(i,j,k), cloudthresh_trans) ) then - cloudtop(i,j) = k - exit - end if - end do !k -! -! Get layer-averaged air density - do k=1, nzstag - km0 = min(nz,k) - km1 = max(1,k-1) - rhoair(k) = rhoair(k)+0.5*(1.0/alt(i,j,km1) + 1.0/alt(i,j,km0))/real(nxy) - end do - end do !i - end do !j - - call determine_transport_thresh( & - nx, ny, nz, & - mode_updnthresh, upthresh, downthresh, & - upthresh2, downthresh2, cloudthresh, & - ww, rhoair, & - wdown_thresh_k, wup_thresh_k & - , cloudtop & - , wup_rms_k, wup_bar_k, wup_stddev_k & - , wdown_rms_k, wdown_bar_k, wdown_stddev_k & - , kup_top, kdown_top ) - - wdown_thresh(:) = wdown_thresh_k(:,1) - wup_thresh(:) = wup_thresh_k(:,1) - - if ((nupdraft > 1) .or. (ndndraft > 1)) then - call endrun('*** code for thresh_factorbb_up/down needs nup/dndraft = 1') - end if - thresh_factorbb_up(:) = 1.0 ; thresh_factorbb_down(:) = 1.0 - thresh_calc_not_done = .true. - - iter = 0 -thresh_calc_loop: & - do while ( thresh_calc_not_done ) - - iter = iter + 1 -! if quiescent class area was too small on previous iteration, -! then thresh_factor_acen_quiesc will be > 1.0 -! multiply wup/down_thresh_k by this factor to reduce the -! up/downdraft areas and increase the quiescent area - do k = 1, nzstag - if (k == 1) then - tmpa = thresh_factorbb_up(k) - tmpb = thresh_factorbb_down(k) - else if (k == nzstag) then - tmpa = thresh_factorbb_up(k-1) - tmpb = thresh_factorbb_down(k-1) - else - tmpa = maxval( thresh_factorbb_up(k-1:k) ) - tmpb = maxval( thresh_factorbb_down(k-1:k) ) - end if - wup_thresh_k( k,:) = wup_thresh_k( k,:) * tmpa - wdown_thresh_k(k,:) = wdown_thresh_k(k,:) * tmpb - end do ! k - - do k=1, max(1, kup_top-1) - wup_thresh(k) = wup_thresh_k(k,1) - end do - do k=1, max(1, kdown_top-1) - wdown_thresh(k) = wdown_thresh_k(k,1) - end do - - do k=1, nzstag - if(wup_thresh(k).lt.0.05) then - write(0,*) 'erros in wup_thresh', k, wup_thresh_k(:,1), thresh_factorbb_up(:) - call endrun('wup_thresh errors in ecpp_stat') - end if - end do -! -! fix a bug in the WRF_ECPP, Minghuai Wang, 2009-12. -! set wdown_thresh_k and wup_thresh_k to be an extreme value -! above updraft (kup_top) and downdraft top(kdown_top). -! This will make sure there is no updraft or downdraft above kup_top and kdown_top -! - do k=kup_top, nz+1 - wup_thresh_k(k, :) = wlarge - end do - do k=kdown_top, nz+1 - wdown_thresh_k(k,:) = -1. * wlarge - end do - - call setup_class_masks( & - nx, ny, nz, nupdraft, ndndraft, ndraft_max, & - cloudmixr, cf3d, precall, ww, & - wdown_thresh_k, wup_thresh_k, & - cloudthresh, prcpthresh, & - mask_bnd, mask_cen, & - cloudmixr_total, cloudthresh_trans, precthresh_trans, & - qvs, precmixr_total ) - -! -! ( code added on 14-dec-2009 to guarantee quiescent class -! area > acen_quiesc_minaa ) -! at each level -! calculate total fractional area for quiescent class -! using the current level-1 averages -! if (acen_quiesc < acen_quiesc_minaa), increase the -! thresh_factorbb_up/down(k) by factor of 1.5 or 1.2 -! (also, if acen_down > acen_up, increase thresh_factorbb_up by less -! - thresh_calc_not_done = .false. - do k = 1,nz - acen_quiesc = sum( mask_cen( 1:nx, 1:ny, k, 1:NCLASS_CL, QUI, 1:NCLASS_PR) ) - acen_quiesc = max( acen_quiesc/real(nxy), 0.0 ) - acen_up = sum( mask_cen( 1:nx, 1:ny, k, 1:NCLASS_CL, UP1, 1:NCLASS_PR) ) - acen_up = max( acen_up/real(nxy), 0.0 ) - acen_down = max( (1.0 - acen_quiesc - acen_up), 0.0 ) - - abnd_quiesc = sum( mask_bnd( 1:nx, 1:ny, k, 1:NCLASS_CL, QUI, 1:NCLASS_PR) ) - abnd_quiesc = max( abnd_quiesc/real(nxy), 0.0 ) - abnd_up = sum( mask_bnd( 1:nx, 1:ny, k, 1:NCLASS_CL, UP1, 1:NCLASS_PR) ) - abnd_up = max( abnd_up/real(nxy), 0.0 ) - abnd_down = max( (1.0 - abnd_quiesc - abnd_up), 0.0 ) - - if (min(acen_quiesc, abnd_quiesc) < acen_quiesc_minaa) then - thresh_calc_not_done = .true. - if (acen_down > acen_up ) then - tmpa = acen_up/acen_down - else if (abnd_down > abnd_up ) then - tmpa = abnd_up/abnd_down - else - tmpa = 1.0 - end if - if (min(acen_quiesc,abnd_quiesc) < 0.5*acen_quiesc_minaa) then - thresh_factorbb_down(k) = thresh_factorbb_down(k)*1.5 - thresh_factorbb_up(k) = thresh_factorbb_up(k)*max(1.5*tmpa, 1.25) - else - thresh_factorbb_down(k) = thresh_factorbb_down(k)*1.25 - thresh_factorbb_up(k) = thresh_factorbb_up(k)*max(1.25*tmpa, 1.125) - end if - if(iter.gt.5) then - write(0, *) 'warning: The number of iteration is larger than 5 in ecpp_stat', 'iter=', iter , & - 'acen_quiesc=', acen_quiesc, 'acen_up=', acen_up, 'k=', k, & - 'wthreshdown=', wdown_thresh_k(k,1), 'wthreshup=', wup_thresh_k(k,1) -! call endrun('The number of iteration is larger than 10 in ecpp_stat') - end if - end if - end do ! k - -! thresh_calc_not_done = .false. ! not use this iteration method +++mhwang - - end do thresh_calc_loop - - wwqui_bar_cen(:) = 0.0 - wwqui_cloudy_bar_cen(:) = 0.0 - wwqui_bar_bnd(:) = 0.0 - wwqui_cloudy_bar_bnd(:) = 0.0 - - XYCLASSLOOPS: do j = 1,ny - do i = 1,nx - do ipr = 1,NCLASS_PR - do itr = 1,ndraft_max - do icl = 1,NCLASS_CL -! -! We now have enough information to aggregate the variables into domain -! averages by class. Do this first for the cell centers... -! - do k = 1,nz - mask = mask_cen(i,j,k,icl,itr,ipr)/real(nxy) - - area_cen_final(k,icl,itr,ipr) = area_cen_final(k,icl,itr,ipr) + mask - - if( domass ) then - area_cen_sum(k,icl,itr,ipr) = area_cen_sum(k,icl,itr,ipr) + mask - rh_cen_sum(k,icl,itr,ipr) = rh_cen_sum(k,icl,itr,ipr) + rh(i,j,k)*mask - qcloud_cen_sum(k,icl,itr,ipr) = qcloud_cen_sum(k,icl,itr,ipr) + qcloud(i,j,k)*mask - qcloud_bf_cen_sum(k,icl,itr,ipr) = qcloud_bf_cen_sum(k,icl,itr,ipr) + qcloud_bf(i,j,k)*mask - qrain_cen_sum(k,icl,itr,ipr) = qrain_cen_sum(k,icl,itr,ipr) + qrain(i,j,k)*mask - qice_cen_sum(k,icl,itr,ipr) = qice_cen_sum(k,icl,itr,ipr) + qice(i,j,k)*mask - qsnow_cen_sum(k,icl,itr,ipr) = qsnow_cen_sum(k,icl,itr,ipr) + qsnow(i,j,k)*mask - qgraup_cen_sum(k,icl,itr,ipr) = qgraup_cen_sum(k,icl,itr,ipr) + qgraup(i,j,k)*mask - qlsink_cen_sum(k,icl,itr,ipr) = qlsink_cen_sum(k,icl,itr,ipr) + qlsink(i,j,k)*mask - precr_cen_sum(k,icl,itr,ipr) = precr_cen_sum(k,icl,itr,ipr) + precr(i,j,k)*mask - precsolid_cen_sum(k,icl,itr,ipr) = precsolid_cen_sum(k,icl,itr,ipr) + precsolid(i,j,k)*mask - precall_cen_sum(k,icl,itr,ipr) = precall_cen_sum(k,icl,itr,ipr) + precall(i,j,k)*mask - qlsink_bf_cen_sum(k,icl,itr,ipr) = qlsink_bf_cen_sum(k,icl,itr,ipr) + qlsink_bf(i,j,k)*mask - prain_cen_sum(k,icl,itr,ipr) = prain_cen_sum(k,icl,itr,ipr) + prain(i,j,k)*mask -! -! calculate the mean vertical velocity over the quiescent class +++mhwang -! - if(itr.eq.QUI) then - wwqui_bar_cen(k) = wwqui_bar_cen(k)+(ww(i,j,k)+ww(i,j,k+1))*0.5*mask - if(icl.eq.CLD) then - wwqui_cloudy_bar_cen(k)=wwqui_cloudy_bar_cen(k)+(ww(i,j,k)+ww(i,j,k+1))*0.5*mask - end if - end if - - end if - end do !k -! -! Now, we can do a similar aggregation for the cell boundaries. Here, we -! will also calculate the mass flux and entrainment. -! - do k = 1,nzstag - mask = mask_bnd(i,j,k,icl,itr,ipr)/real(nxy) - - area_bnd_final(k,icl,itr,ipr) = area_bnd_final(k,icl,itr,ipr) + mask - - if( domass ) then - !NOTE: technically we should interpolate and not do a simple - ! average to get density at the cell interface - km0 = min(nz,k) - km1 = max(1,k-1) - km2 = max(1,k-2) - wwrho_k = 0.5*(1.0/alt(i,j,km1) + 1.0/alt(i,j,km0))*ww(i,j,k) - wwrho_km1 = 0.5*(1.0/alt(i,j,km2) + 1.0/alt(i,j,km1))*ww(i,j,km1) - - area_bnd_sum(k,icl,itr,ipr) = area_bnd_sum(k,icl,itr,ipr) + mask - mass_bnd_sum(k,icl,itr,ipr) = mass_bnd_sum(k,icl,itr,ipr) + wwrho_k*mask - ent_bnd_sum(k,icl,itr,ipr) = ent_bnd_sum(k,icl,itr,ipr) + max(0., wwrho_k-wwrho_km1)*mask - -! -! calculate the mean vertical velocity over the quiescent class +++mhwang -! - if(itr.eq.QUI) then - wwqui_bar_bnd(k) = wwqui_bar_bnd(k)+ww(i,j,k)*mask - if(icl.eq.CLD) then - wwqui_cloudy_bar_bnd(k)=wwqui_cloudy_bar_bnd(k)+ww(i,j,k)*mask - end if - end if - - end if - end do !k - - end do !icl - end do !itr - end do !pr - end do !i - end do XYCLASSLOOPS !j - -! -! calcualte vertical velocity variance for quiescent class (total and cloudy) +++mhwang -! - do k=1, nz - if(sum(mask_cen(1:nx, 1:ny, k, 1:NCLASS_CL, QUI, 1:NCLASS_PR)).ge.0.5) then - wwqui_bar_cen(k) = wwqui_bar_cen(k)* real(nxy) /sum(mask_cen(1:nx, 1:ny, k, 1:NCLASS_CL, QUI, 1:NCLASS_PR)) - else - wwqui_bar_cen(k) = 0.0 - end if - if(sum(mask_cen(1:nx, 1:ny, k, CLD, QUI, 1:NCLASS_PR)).ge.0.5) then - wwqui_cloudy_bar_cen(k) = wwqui_cloudy_bar_cen(k)* real(nxy) /sum(mask_cen(1:nx, 1:ny, k, CLD, QUI, 1:NCLASS_PR)) - else - wwqui_cloudy_bar_cen(k) = 0.0 - end if - end do - do k=1, nzstag - if(sum(mask_bnd(1:nx, 1:ny, k, 1:NCLASS_CL, QUI, 1:NCLASS_PR)).ge.0.5) then - wwqui_bar_bnd(k) = wwqui_bar_bnd(k)* real(nxy) /sum(mask_bnd(1:nx, 1:ny, k, 1:NCLASS_CL, QUI, 1:NCLASS_PR)) - else - wwqui_bar_bnd(k) = 0.0 - end if - if(sum(mask_bnd(1:nx, 1:ny, k, CLD, QUI, 1:NCLASS_PR)).ge.0.5) then - wwqui_cloudy_bar_bnd(k) = wwqui_cloudy_bar_bnd(k)* real(nxy) /sum(mask_bnd(1:nx, 1:ny, k, CLD, QUI, 1:NCLASS_PR)) - else - wwqui_cloudy_bar_bnd(k) = 0.0 - end if - end do - - QUIELOOPS: do j = 1,ny - do i = 1,nx - do ipr = 1,NCLASS_PR - do icl = 1,NCLASS_CL - - do k = 1,nz - mask = mask_cen(i,j,k,icl,QUI,ipr)/real(nxy) - -! -! calculate the vertical velocity variance over the quiescent class +++mhwang -! wwqui_bar_cen is used in for both all sky and cloudy sky. -! when wwqui_cloudy_bar_cen was used for cloudy sky, wwqui_cloudy_cen_sum will be smaller than wwqui_cen_sum. -! -#ifdef CLUBB_CRM - wwqui_cen_sum(k) = wwqui_cen_sum(k)+mask * ((ww(i,j,k)+ww(i,j,k+1))*0.5-wwqui_bar_cen(k))**2 + mask * & - (wwsq(i,j,k)+wwsq(i,j,k+1))**2/4. -#else - wwqui_cen_sum(k) = wwqui_cen_sum(k)+mask * ((ww(i,j,k)+ww(i,j,k+1))*0.5-wwqui_bar_cen(k))**2 + mask * & - tkesgs(i,j,k)/3. -#endif - if(icl.eq.CLD) then -#ifdef CLUBB_CRM - wwqui_cloudy_cen_sum(k)=wwqui_cloudy_cen_sum(k)+mask * ((ww(i,j,k)+ww(i,j,k+1))*0.5-wwqui_bar_cen(k))**2 & - + mask * (wwsq(i,j,k)+wwsq(i,j,k+1))**2/4. -#else - wwqui_cloudy_cen_sum(k)=wwqui_cloudy_cen_sum(k)+mask * ((ww(i,j,k)+ww(i,j,k+1))*0.5-wwqui_bar_cen(k))**2 & - + mask * tkesgs(i,j,k)/3. -#endif - end if - end do !k - -! -! Now, we can do a similar aggregation for the cell boundaries. -! - do k = 1,nzstag - mask = mask_bnd(i,j,k,icl,QUI,ipr)/real(nxy) - - !NOTE: technically we should interpolate and not do a simple - ! average to get density at the cell interface - km0 = min(nz,k) - km1 = max(1,k-1) -! -! calculate the mean vertical velocity over the quiescent class +++mhwang -! wwqui_bar_bnd is used in both all sky and cloudy sky. -! when wwqui_cloudy_bar_bnd was used for cloudy sky, wwqui_cloudy_bnd_sum will be smaller than wwqui_bnd_sum. -! -#ifdef CLUBB_CRM - wwqui_bnd_sum(k) = wwqui_bnd_sum(k)+mask * (ww(i,j,k)-wwqui_bar_bnd(k))**2 + mask * wwsq(i,j,k)**2 -#else - wwqui_bnd_sum(k) = wwqui_bnd_sum(k)+mask * (ww(i,j,k)-wwqui_bar_bnd(k))**2 + mask * (tkesgs(i,j,km0)+& - tkesgs(i,j,km1)) * 0.5/3. -#endif - if(icl.eq.CLD) then -#ifdef CLUBB_CRM - wwqui_cloudy_bnd_sum(k)=wwqui_cloudy_bnd_sum(k)+mask * (ww(i,j,k)-wwqui_bar_bnd(k))**2 + mask * & - wwsq(i,j,k)**2 -#else - wwqui_cloudy_bnd_sum(k)=wwqui_cloudy_bnd_sum(k)+mask * (ww(i,j,k)-wwqui_bar_bnd(k))**2 + mask * & - (tkesgs(i,j,km0)+tkesgs(i,j,km1)) * 0.5/3. -#endif - end if - - end do !k - - end do !icl - end do !pr - end do !i - end do QUIELOOPS !j - -! testing small queiscent fraction +++mhwang - do k=1, nz - if(sum(area_cen_final(k,:,1,:)).lt.1.0e-3) then - write(0, *) 'ecpp, area_cen_final, quiescent', sum(area_cen_final(k,:,1,:)), k, area_cen_final(k,:,1,:), & - wdown_thresh_k(k,1), wup_thresh_k(k,1) - write(0, *) 'ecpp, area_cen_final, quiescent, wwk', ww(:,:,k), i, wup_rms_k(k), wup_bar_k(k), wup_stddev_k(k) - write(0, *) 'ecpp, area_cen_final, quiescent, wwk+1', ww(:,:,k+1), i, wup_rms_k(k+1), wup_bar_k(k+1), wup_stddev_k(k+1) -! call endrun('area_cen_final less then 1.0-e3') - end if - end do -! ---mhwang -end subroutine categorization_stats - -!------------------------------------------------------------------------ -subroutine determine_transport_thresh( & - nx, ny, nz, & - mode_updnthresh, upthresh, downthresh, & - upthresh2, downthresh2, cloudthresh, & -! ctime, & - ww, rhoair, & - wdown_thresh_k, wup_thresh_k & - , cloudtop & - , wup_rms_k, wup_bar_k, wup_stddev_k & - , wdown_rms_k, wdown_bar_k, wdown_stddev_k & - , kup_top, kdown_top) -! -! Deterines the velocity thresholds used to indicate whether a cell's -! motion is up, down, or quiescent. This is down for two threshold values -! in each direction by level. A dozen options are available on how this -! is done as documented below and at the top of postproc_wrfout. -! -! William.Gustafosn@pnl.gov; 11-Sep-2008 -! Modified: William.Gustafosn@pnl.gov; 14-Apr-2009 -!------------------------------------------------------------------------ -! use timeroutines -! -! Soubroutine arguments... -! - integer, intent(in) :: nx, ny, nz, mode_updnthresh - real, intent(in) :: & - cloudthresh, & - downthresh, upthresh, & - downthresh2, upthresh2 -! type(time), intent(in) :: ctime - real, dimension(:,:,:), intent(in) :: & - ww - real, dimension(nz+1), intent(in) :: rhoair - real, dimension(nz+1,2), intent(out) :: wdown_thresh_k, wup_thresh_k - integer, dimension(nx,ny), intent(in) :: cloudtop - real, dimension(nz+1), intent(out) :: wup_rms_k, wup_bar_k, wup_stddev_k, wdown_bar_k, wdown_rms_k, wdown_stddev_k - integer, intent(out) :: kup_top, kdown_top ! defined as the maximum level that allows updraft and downdraft -! -! Local vars... -! - real, dimension(nz+1) :: & - tmpveca, tmpvecb, & -! wdown_bar_k, wdown_rms_k, wdown_stddev_k, & -! wup_bar_k, wup_rms_k, wup_stddev_k, & - wup_rms_ksmo, wdown_rms_ksmo - real :: tmpsuma, tmpsumb, tmpw, tmpw_minval, & - wdown_bar, wdown_rms, wdown_stddev, & - wup_bar, wup_rms, wup_stddev - integer, dimension(nx,ny) :: & - cloudtop_upaa, cloudtop_upbb, cloudtop_downaa, cloudtop_downbb - integer, dimension(nz+1) :: nup_k, ndown_k - integer :: i, ib, ic, & - j, jb, jc, & - k, kk, kup_center, kdown_center - integer :: ndown, nup - integer :: ijdel, ijdel_cur, ijdel_upaa, ijdel_upbb, ijdel_downaa, ijdel_downbb - -! Calc cloudtop_upaa(i,j) = max( cloudtop(i-del:i+del,j-del:j+del) ) -! and similar for cloudtop_upbb, cloudtop_downaa/bb -! (assume periodic BC here) - ijdel_upaa = 0 ; ijdel_downaa = 0 - ijdel_upbb = 0 ; ijdel_downbb = 0 - if ((mode_updnthresh == 12) .or. (mode_updnthresh == 13)) then -! ijdel_... = 1 corresponds to 3x3 stencil - ijdel_upaa = 1 ; ijdel_downaa = 1 - ijdel_upbb = 1 ; ijdel_downbb = 1 - end if - ijdel = max( ijdel_upaa, ijdel_upbb, ijdel_downaa, ijdel_downbb ) - - if (ijdel > 0) then - do j = 1, ny - do i = 1, nx - cloudtop_upaa(i,j) = cloudtop(i,j) - cloudtop_downaa(i,j) = cloudtop(i,j) - cloudtop_upbb(i,j) = cloudtop(i,j) - cloudtop_downbb(i,j) = cloudtop(i,j) - do jb = j-ijdel, j+ijdel - jc = jb - if (jc < 1) jc = jc + ny - if (jc > ny) jc = jc - ny - do ib = i-ijdel, i+ijdel - ic = ib - if (ic < 1) ic = ic + nx - if (ic > nx) ic = ic - nx - ijdel_cur = max( iabs(ib-i), iabs(jb-j) ) -! cloudtop_downaa calculated over a (2*ijdel_downaa+1)**2 stencil - if (ijdel_cur <= ijdel_downaa) & - cloudtop_downaa(i,j) = max( cloudtop_downaa(i,j), cloudtop(ic,jc) ) -! cloudtop_upaa calculated over a (2*ijdel_upaa+1)**2 stencil - if (ijdel_cur <= ijdel_upaa) & - cloudtop_upaa(i,j) = max( cloudtop_upaa(i,j), cloudtop(ic,jc) ) -! cloudtop_downbb, cloudtop_upbb similarly - if (ijdel_cur <= ijdel_downbb) & - cloudtop_downbb(i,j) = max( cloudtop_downbb(i,j), cloudtop(ic,jc) ) - if (ijdel_cur <= ijdel_upbb) & - cloudtop_upbb(i,j) = max( cloudtop_upbb(i,j), cloudtop(ic,jc) ) - end do ! ib - end do ! jb -! add on 1 level as a "margin of error" - cloudtop_upaa( i,j) = min( cloudtop_upaa( i,j)+1, nz ) - cloudtop_downaa(i,j) = min( cloudtop_downaa(i,j)+1, nz ) - cloudtop_upbb( i,j) = min( cloudtop_upbb( i,j)+1, nz ) - cloudtop_downbb(i,j) = min( cloudtop_downbb(i,j)+1, nz ) - end do ! i - end do ! j - end if ! (ijdel > 0) - -! new coding here and below -! cloudtop_up/downaa - only grid cells with k<=cloudtop_up/downaa -! are used for calc of wup_rms and wdn_rms -! cloudtop_up/downbb - only grid cells with k<=cloudtop_up/downbb -! can be classified as up/downdraft - if ((mode_updnthresh == 12) .or. (mode_updnthresh == 13)) then -! mode_updnthresh >= 12 is a newer, more consistent usage of cloudtop info -! the cloudtop_upaa/upbb/downaa/downbb values are identical, -! and they correspond to the max cloudtop(i,j) over a 3x3 stencil -! only grid cells with k <= this "local" cloudtop can be up/downdraft grids - continue - else -! mode_updnthresh /= 12,13 corresponds to pre 11-jan-2008 versions of preprocessor -! where only grid cells with k <= cloudtop(i,j) are used for calc of wup/dn_rms, -! but any grid cells can be up/dn [even those with k >> cloudtop(i,j)] - cloudtop_upaa(:,:) = cloudtop(:,:) - cloudtop_downaa(:,:) = cloudtop(:,:) - cloudtop_upbb(:,:) = nz - cloudtop_downbb(:,:) = nz - end if - -! -! Get standard deviation of up and down vertical velocity below the -! cloud tops. For now, each cell is treated equally. We may want to -! consider weighting each cell by its volume or mass. -! - ! Get the mean values first for wup and wdown - ndown = 0; nup = 0 - wdown_bar = 0.; wup_bar = 0. - ndown_k(:) = 0; nup_k(:) = 0 - wdown_bar_k(:) = 0.; wup_bar_k(:) = 0. - kup_top = 1; kdown_top= 1 - do j=1,ny - do i=1,nx - do k=1,cloudtop_upaa(i,j)+1 !Plus 1 is so we get w across top of cloud. - !It is dimmensionally ok since w is dimmed nz+1 - !We intentially ignore when w==0 as to not bias one direction - !over the other for the count. This differs from the Ferret code which - !assigns w=0 to up values. - if( ww(i,j,k) > 0. ) then - nup = nup + 1 - wup_bar = wup_bar + ww(i,j,k) - nup_k(k) = nup_k(k) + 1 - wup_bar_k(k) = wup_bar_k(k) + ww(i,j,k) - kup_top = max(kup_top, k) - end if - end do - do k=1,cloudtop_downaa(i,j)+1 - if( ww(i,j,k) < 0. ) then - ndown = ndown + 1 - wdown_bar = wdown_bar + ww(i,j,k) - ndown_k(k) = ndown_k(k) + 1 - wdown_bar_k(k) = wdown_bar_k(k) + ww(i,j,k) - kdown_top = max(kdown_top, k) - end if - end do - - end do - end do - if( nup > 0 ) wup_bar = wup_bar / nup - if( ndown > 0 ) wdown_bar = wdown_bar / ndown - do k = 1, nz+1 - if( nup_k(k) > 0 ) wup_bar_k(k) = wup_bar_k(k) / nup_k(k) - if( ndown_k(k) > 0 ) wdown_bar_k(k) = wdown_bar_k(k) / ndown_k(k) - end do - - !Now, we can get the std. dev. of wup and wdown. - wdown_stddev = 0.; wup_stddev = 0. - wdown_stddev_k(:) = 0.; wup_stddev_k(:) = 0. - do j=1,ny - do i=1,nx - do k=1,cloudtop_upaa(i,j)+1 !Plus 1 is so we get w across top of cloud. - !We intentionally ignore when w==0 as to not bias one direction - !over the other. - if( ww(i,j,k) > 0. ) then - wup_stddev = wup_stddev + (wup_bar-ww(i,j,k))**2 - wup_stddev_k(k) = wup_stddev_k(k) + (wup_bar_k(k)-ww(i,j,k))**2 - end if - end do - do k=1,cloudtop_downaa(i,j)+1 - if( ww(i,j,k) < 0. ) then - wdown_stddev = wdown_stddev + (wdown_bar-ww(i,j,k))**2 - wdown_stddev_k(k) = wdown_stddev_k(k) + (wdown_bar_k(k)-ww(i,j,k))**2 - end if - end do - end do - end do - if( nup > 0 ) wup_stddev = sqrt(wup_stddev / nup) - if( ndown > 0 ) wdown_stddev = sqrt(wdown_stddev / ndown) - wup_rms = sqrt( wup_bar**2 + wup_stddev**2 ) - wdown_rms = sqrt( wdown_bar**2 + wdown_stddev**2 ) - do k = 1, nz+1 - if( nup_k(k) > 0 ) wup_stddev_k(k) = sqrt(wup_stddev_k(k) / nup_k(k)) - if( ndown_k(k) > 0 ) wdown_stddev_k(k) = sqrt(wdown_stddev_k(k) / ndown_k(k)) - wup_rms_k(k) = sqrt( wup_bar_k(k)**2 + wup_stddev_k(k)**2 ) - wdown_rms_k(k) = sqrt( wdown_bar_k(k)**2 + wdown_stddev_k(k)**2 ) - end do - -! calculated smoothed (3-point) wup/down_rms - tmpveca(:) = wup_rms_k( :) - tmpvecb(:) = wdown_rms_k(:) - do k = 2, nz - wup_rms_ksmo( k) = 0.0 - wdown_rms_ksmo(k) = 0.0 - tmpsuma = 0.0 - do kk = max(k-1,2), min(k+1,nz) - wup_rms_ksmo( k) = wup_rms_ksmo( k) + tmpveca(kk) - wdown_rms_ksmo(k) = wdown_rms_ksmo(k) + tmpvecb(kk) - tmpsuma = tmpsuma + 1.0 - end do - tmpsuma = max(tmpsuma,1.0) - wup_rms_ksmo( k) = wup_rms_ksmo( k)/tmpsuma - wdown_rms_ksmo(k) = wdown_rms_ksmo(k)/tmpsuma - end do - wup_rms_ksmo( 1) = wup_rms_ksmo( 2) - wdown_rms_ksmo(1) = wdown_rms_ksmo(2) - wup_rms_ksmo( nz+1) = wup_rms_ksmo( nz) - wdown_rms_ksmo(nz+1) = wdown_rms_ksmo(nz) - -! print "(2a,2(2x,3f8.4))", & -! " ...wup_bar,std,rms; wdown_bar,std,rms ", & -! wup_bar, wup_stddev, wup_rms, wdown_bar, wdown_stddev, wdown_rms -! if (mode_updnthresh >= 5) then -! print "(a/(15f7.3))", & -! " ... wup_rms_k(2:nz)", (wup_rms_k(k), k=2,nz) -! print "(a/(15f7.3))", & -! " ...wdown_rms_k(2:nz)", (wdown_rms_k(k), k=2,nz) -! end if - -! -! Get masks to determine (cloud vs. clear) (up vs. down vs. other) categories. -! Vertical velocities are checked on the cell vertical interfaces to determine -! if they pass the threshold criteria. Clouds below the interface are then -! used for updrafts and above the int. for downdrafts. Quiescent (other) -! drafts use an average of the cloud above and below the interface to -! determine cloudiness. -! - select case ( mode_updnthresh ) - case ( 1 ) - wup_thresh_k( :,1) = wup_stddev*abs(upthresh) - wdown_thresh_k(:,1) = -wdown_stddev*abs(downthresh) - wup_thresh_k( :,2) = wup_stddev*abs(upthresh2) - wdown_thresh_k(:,2) = -wdown_stddev*abs(downthresh2) - case ( 2 ) - wup_thresh_k( :,1) = wup_bar + wup_stddev*abs(upthresh) - wdown_thresh_k(:,1) = wdown_bar - wdown_stddev*abs(downthresh) - wup_thresh_k( :,2) = wup_bar + wup_stddev*abs(upthresh2) - wdown_thresh_k(:,2) = wdown_bar - wdown_stddev*abs(downthresh2) - case ( 3 ) - wup_thresh_k( :,1) = abs(upthresh) - wdown_thresh_k(:,1) = -abs(downthresh) - wup_thresh_k( :,2) = abs(upthresh2) - wdown_thresh_k(:,2) = -abs(downthresh2) - case ( 4 ) - wup_thresh_k( :,1) = (wup_rms )*abs(upthresh) - wdown_thresh_k(:,1) = -(wdown_rms)*abs(downthresh) - wup_thresh_k( :,2) = (wup_rms )*abs(upthresh2) - wdown_thresh_k(:,2) = -(wdown_rms)*abs(downthresh2) - - case ( 5 ) -! For mode_updnthresh = 5, use a weighted average of wup_rms & wup_rms_ksmo(k) -! because wup_rms_ksmo will be zero (or close to it) at many levels - wup_thresh_k( :,1) = (0.25*wup_rms +0.75*wup_rms_ksmo( :))*abs(upthresh) - wdown_thresh_k(:,1) = -(0.25*wdown_rms+0.75*wdown_rms_ksmo(:))*abs(downthresh) - wup_thresh_k( :,2) = (0.25*wup_rms +0.75*wup_rms_ksmo( :))*abs(upthresh2) - wdown_thresh_k(:,2) = -(0.25*wdown_rms+0.75*wdown_rms_ksmo(:))*abs(downthresh2) - - case ( 6, 7 ) -! For mode_updnthresh = 6 & 7, like case 4 except when k <= "updraft center k", -! use minimum of wup_rms and wup_rms_k for updraft threshold - wup_thresh_k( :,1) = (wup_rms )*abs(upthresh) - wdown_thresh_k(:,1) = -(wdown_rms)*abs(downthresh) - wup_thresh_k( :,2) = (wup_rms )*abs(upthresh2) - wdown_thresh_k(:,2) = -(wdown_rms)*abs(downthresh2) - - tmpsuma = 0.0 ; tmpsumb = 1.0e-30 - do k = 1, nz - tmpw = wup_rms_k(k) - if (mode_updnthresh == 7) tmpw = wup_rms_ksmo(k) - tmpw = max(1.0e-4,tmpw) - tmpw = tmpw * rhoair(k) - tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw - end do - kup_center = nint(tmpsuma/tmpsumb) - tmpw_minval = 0.10 - do k = 1, kup_center - tmpw = wup_rms_k(k) - if (mode_updnthresh == 7) tmpw = wup_rms_ksmo(k) - tmpw = max( tmpw, tmpw_minval ) - tmpw = min( tmpw, wup_rms ) - wup_thresh_k(k,1) = tmpw*abs(upthresh) - wup_thresh_k(k,2) = tmpw*abs(upthresh2) - end do - - case ( 8, 9 ) -! For mode_updnthresh = 8 & 9, like case 6, 7 except that updraft and -! downdraft are treated similarly. So when k >= "downdraft center k", -! use minimum of wdown_rms and wdown_rms_k for downdraft threshold - wup_thresh_k( :,1) = (wup_rms )*abs(upthresh) - wdown_thresh_k(:,1) = -(wdown_rms)*abs(downthresh) - wup_thresh_k( :,2) = (wup_rms )*abs(upthresh2) - wdown_thresh_k(:,2) = -(wdown_rms)*abs(downthresh2) - - tmpsuma = 0.0 ; tmpsumb = 1.0e-30 - do k = 1, nz+1 - tmpw = wup_rms_k(k) - if (mode_updnthresh == 9) tmpw = wup_rms_ksmo(k) - tmpw = max(1.0e-4,tmpw) - tmpw = tmpw * rhoair(k) - tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw - end do - kup_center = nint(tmpsuma/tmpsumb) - tmpw_minval = 0.10 - do k = 1, kup_center - tmpw = wup_rms_k(k) - if (mode_updnthresh == 9) tmpw = wup_rms_ksmo(k) - tmpw = max( tmpw, tmpw_minval ) - tmpw = min( tmpw, wup_rms ) - wup_thresh_k(k,1) = tmpw*abs(upthresh) - wup_thresh_k(k,2) = tmpw*abs(upthresh2) - end do - - tmpsuma = 0.0 ; tmpsumb = 1.0e-30 - do k = 1, nz+1 - tmpw = wdown_rms_k(k) - if (mode_updnthresh == 9) tmpw = wdown_rms_ksmo(k) - tmpw = max(1.0e-4,tmpw) - tmpw = tmpw * rhoair(k) - tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw - end do - kdown_center = nint(tmpsuma/tmpsumb) - tmpw_minval = 0.10 - do k = kdown_center, nz+1 - tmpw = wdown_rms_k(k) - if (mode_updnthresh == 9) tmpw = wdown_rms_ksmo(k) - tmpw = max( tmpw, tmpw_minval ) - tmpw = min( tmpw, wdown_rms ) - wdown_thresh_k(k,1) = -tmpw*abs(downthresh) - wdown_thresh_k(k,2) = -tmpw*abs(downthresh2) - end do - - case ( 14, 15 ) -! case 14 & 15 -- added on 10-dec-2009 -! updraft and k > "updraft center k", wup_rms -! updraft and k <= "updraft center k", use min( wup_rms_k, wup_rms ) -! downdraft and k > "downdraft center k", wdown_rms -! downdraft and k <= "downdraft center k", min( use wdown_rms_k, wdown_rms ) -! The idea is to have a higher threshold in upper troposphere to -! filter out gravity waves motions - tmpsuma = 0.0 ; tmpsumb = 1.0e-30 - do k = 1, nz+1 - tmpw = wup_rms_k(k) - if (mode_updnthresh == 15) tmpw = wup_rms_ksmo(k) - tmpw = max(1.0e-4,tmpw) - tmpw = tmpw * rhoair(k) - tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw - end do - kup_center = nint(tmpsuma/tmpsumb) - tmpw_minval = 0.10 - do k = 1, nz+1 - tmpw = wup_rms_k(k) - if (mode_updnthresh == 15) tmpw = wup_rms_ksmo(k) - if (k > kup_center) then - tmpw = wup_rms - else - tmpw = min( tmpw, wup_rms ) - end if - tmpw = max( tmpw, tmpw_minval ) - wup_thresh_k(k,1) = tmpw*abs(upthresh) - wup_thresh_k(k,2) = tmpw*abs(upthresh2) - end do - - tmpsuma = 0.0 ; tmpsumb = 1.0e-30 - do k = 1, nz+1 - tmpw = wdown_rms_k(k) - if (mode_updnthresh == 15) tmpw = wdown_rms_ksmo(k) - tmpw = max(1.0e-4,tmpw) - tmpw = tmpw * rhoair(k) - tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw - end do - kdown_center = nint(tmpsuma/tmpsumb) - tmpw_minval = 0.10 - do k = 1, nz+1 - tmpw = wdown_rms_k(k) - if (mode_updnthresh == 15) tmpw = wdown_rms_ksmo(k) - if (k > kdown_center) then - tmpw = wdown_rms - else - tmpw = min( tmpw, wdown_rms ) - end if - tmpw = max( tmpw, tmpw_minval ) - wdown_thresh_k(k,1) = -tmpw*abs(downthresh) - wdown_thresh_k(k,2) = -tmpw*abs(downthresh2) - end do - - case ( 16, 17 ) -! case 16 & 17 -- added on 10-dec-2009 -! updraft and k > "updraft center k", use max( wup_rms_k, wup_rms ) -! updraft and k <= "updraft center k", use wup_rms_k -! downdraft and k > "downdraft center k", use max( wdown_rms_k, wdown_rms ) -! downdraft and k <= "downdraft center k", use wdown_rms_k -! The idea is to have a higher threshold in upper troposphere to -! filter out gravity waves motions - tmpsuma = 0.0 ; tmpsumb = 1.0e-30 - do k = 1, nz+1 - tmpw = wup_rms_k(k) - if (mode_updnthresh == 17) tmpw = wup_rms_ksmo(k) - tmpw = max(1.0e-4,tmpw) - tmpw = tmpw * rhoair(k) - tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw - end do - kup_center = nint(tmpsuma/tmpsumb) - tmpw_minval = 0.10 - do k = 1, nz+1 - tmpw = wup_rms_k(k) - if (mode_updnthresh == 17) tmpw = wup_rms_ksmo(k) - if (k > kup_center) tmpw = max( tmpw, wup_rms ) - tmpw = max( tmpw, tmpw_minval ) - wup_thresh_k(k,1) = tmpw*abs(upthresh) - wup_thresh_k(k,2) = tmpw*abs(upthresh2) - end do - - tmpsuma = 0.0 ; tmpsumb = 1.0e-30 - do k = 1, nz+1 - tmpw = wdown_rms_k(k) - if (mode_updnthresh == 17) tmpw = wdown_rms_ksmo(k) - tmpw = max(1.0e-4,tmpw) - tmpw = tmpw * rhoair(k) - tmpsuma = tmpsuma + tmpw*k ; tmpsumb = tmpsumb + tmpw - end do - kdown_center = nint(tmpsuma/tmpsumb) - tmpw_minval = 0.10 - do k = 1, nz+1 - tmpw = wdown_rms_k(k) - if (mode_updnthresh == 17) tmpw = wdown_rms_ksmo(k) - if (k > kdown_center) tmpw = max( tmpw, wdown_rms ) - tmpw = max( tmpw, tmpw_minval ) - wdown_thresh_k(k,1) = -tmpw*abs(downthresh) - wdown_thresh_k(k,2) = -tmpw*abs(downthresh2) - end do - - case ( 10, 11, 12, 13 ) -! For mode_updnthresh = 10, 11, use wup_rms_k and wdown_rms_k at all -! levels (or the w---_rms_ksmo) - tmpw_minval = 0.10 - do k = 1, nz+1 - tmpw = wup_rms_k(k) - if (mode_updnthresh == 11) tmpw = wup_rms_ksmo(k) - if (mode_updnthresh == 13) tmpw = wup_rms_ksmo(k) - tmpw = max( tmpw, tmpw_minval ) - wup_thresh_k(k,1) = tmpw*abs(upthresh) - wup_thresh_k(k,2) = tmpw*abs(upthresh2) - end do - tmpw_minval = 0.10 - do k = 1, nz+1 - tmpw = wdown_rms_k(k) - if (mode_updnthresh == 11) tmpw = wdown_rms_ksmo(k) - if (mode_updnthresh == 13) tmpw = wdown_rms_ksmo(k) - tmpw = max( tmpw, tmpw_minval ) - wdown_thresh_k(k,1) = -tmpw*abs(downthresh) - wdown_thresh_k(k,2) = -tmpw*abs(downthresh2) - end do - - case default - call endrun('determine_transport_thresh error - must have 1 <= mode_updnthresh <= 11') - end select - -end subroutine determine_transport_thresh - - -!------------------------------------------------------------------------ -subroutine setup_class_masks( & - nx, ny, nz, nupdraft, ndndraft, ndraft_max, & - cloudmixr, cf3d, precall, ww, & - wdown_thresh_k, wup_thresh_k, & - cloudthresh, prcpthresh, & - mask_bnd, mask_cen, & - cloudmixr_total, cloudthresh_trans, precthresh_trans, & - qvs, precmixr_total ) -! -! Sets up the masks used for determining quiescent/up/down, clear/cloudy, -! and non-precipitatin/precipitating classes. -! -! William.Gustafosn@pnl.gov; 20-Nov-2008 -! Last modified: William.Gustafson@pnl.gov; 16-Apr-2009 - -! Modification by Minghuai Wang (Minghuai.Wang@pnl.gov), April 23, 2010 -! use total condensate (liquid+ice), different condensate and precipitating thresholds -! to classify transport classes. -! See Xu et al., 2002, Q.J.R.M.S. -! - -!------------------------------------------------------------------------ -! -! Soubroutine arguments... -! - integer, intent(in) :: nx, ny, nz, nupdraft, ndndraft, ndraft_max - real, dimension(:,:,:), intent(in) :: & - cloudmixr, cf3d, precall, ww - real, dimension(nz+1,2), intent(in) :: wdown_thresh_k, wup_thresh_k - real, intent(in) :: cloudthresh, prcpthresh - real, dimension(nx,ny,nz+1,NCLASS_CL,ndraft_max,NCLASS_PR), & - intent(out) :: mask_bnd - real, dimension(nx,ny,nz,NCLASS_CL,ndraft_max,NCLASS_PR), & - intent(out) :: mask_cen - real, dimension( :, :, :), intent(in) :: cloudmixr_total ! total condensate (liquid+ice) - real, intent(in) :: cloudthresh_trans, precthresh_trans ! threshold for transport classes - real, dimension( :, :, :), intent(in) :: qvs, precmixr_total -! -! Local vars... -! - integer, dimension(nz+1,nupdraft) :: maskup - integer, dimension(nz+1,ndndraft) :: maskdn - integer, dimension(nz+1) :: maskqu, & - maskcld_bnd, maskclr_bnd, maskpry_bnd, maskprn_bnd - integer, dimension(nz) :: maskcld, maskclr, maskpry, maskprn - integer :: i, itr, icl, ipr, j, k, m, nzstag - real :: cloudthresh_trans_temp, precthresh_trans_temp - - nzstag = nz+1 -! -! Initialize the masks to zero and then we will accumulate values into -! them as we identify the various classes. -! - mask_bnd = 0. - mask_cen = 0. -! -! Loop over the horizontal dimensions... -! - XYLOOPS : do j = 1,ny - do i=1,nx -! -! Set initial mask values for the vertical cell boundaries... -! - maskup = 0 - maskdn = 0 - maskqu = 0 - maskcld = 0 - maskclr = 0 - maskcld_bnd = 0 - maskclr_bnd = 0 - maskpry = 0 - maskprn = 0 - maskpry_bnd = 0 - maskprn_bnd = 0 - - if( nupdraft > 2 .or. ndndraft > 2 ) then - call endrun('OOPS. Cannot have more than 2 updraft or 2 downdraft categories right now.') - end if - - do k = 1,nzstag - - !Transport upward at cell boundaries... - !We have to take into account the possibility of multiple - !updraft categories. At this point, we handle only the - !cases of one or two categories. We do not yet handle the - !allcomb option. - ! - ! updraft only exist in cloudy area or precipitating clear area ++++mhwang - cloudthresh_trans_temp = cloudthresh_trans -! cloudthresh_trans_temp = max(cloudthresh_trans, 0.01 * (qvs(i,j,max(k-1,1))+qvs(i,j,min(k,nz)))*0.5) - if( (cloudmixr_total(i,j,max(k-1,1))+cloudmixr_total(i,j,min(k,nz)))*0.5 > cloudthresh_trans_temp & -! .or. (precall(i,j,max(k-1,1))+precall(i,j,min(k,nz)))*0.5 > prcpthresh_trans) then !+++mhwang - .or. (precmixr_total(i,j,max(k-1,1))+precmixr_total(i,j,min(k,nz)))*0.5 > precthresh_trans) then !+++mhwang - select case (nupdraft) - case (1) !Only one threshold - if( ww(i,j,k) > wup_thresh_k(k,1) ) then - maskup(k,1) = 1 - end if - case (2) !Two thresholds, assumes 1st is stronger wind - if( ww(i,j,k) > wup_thresh_k(k,1) ) then - maskup(k,1) = 1 - else if( ww(i,j,k) > wup_thresh_k(k,2) & - .and. ww(i,j,k) <= wup_thresh_k(k,1) ) then - maskup(k,2) = 1 - end if - end select - end if ! end cloudmixr_total +++mhwang - - !Transport downward at cell boundaries... - ! - ! downdraft only exist in cloudy area or precipitating clear area +++mhwang - if( (cloudmixr_total(i,j,max(k-1,1))+cloudmixr_total(i,j,min(k,nz)))*0.5 > cloudthresh_trans_temp & -! .or. (precall(i,j,max(k-1,1))+precall(i,j,min(k,nz)))*0.5 > prcpthresh_trans) then !+++mhwang - .or. (precmixr_total(i,j,max(k-1,1))+precmixr_total(i,j,min(k,nz)))*0.5 > precthresh_trans) then !+++mhwang - select case (ndndraft) - case (1) !Only one threshold - if( ww(i,j,k) < wdown_thresh_k(k,1) ) then - maskdn(k,1) = 1 - end if - case (2) !Two thresholds, assumes 1st is stronger wind - if( ww(i,j,k) < wdown_thresh_k(k,1) ) then - maskdn(k,1) = 1 - else if( ww(i,j,k) < wdown_thresh_k(k,2) & - .and. ww(i,j,k) >= wdown_thresh_k(k,1) ) then - maskdn(k,2) = 1 - end if - end select - end if ! end cloudmixr_total, and precall +++mhwang - - !Transport quiescent at cell boundaries if neither up or - !down triggered... - if( sum(maskup(k,:))+sum(maskdn(k,:)) < 1 ) then - maskqu(k) = 1 - end if - - ! Cloudy or clear at cell boundaries... - if( (cloudmixr(i,j,max(k-1,1))+cloudmixr(i,j,min(k,nz)))*0.5 > cloudthresh ) then - maskcld_bnd(k) = 1 - else - maskclr_bnd(k) = 1 - end if - - ! Raining or not at cell boundaries... - if( (precall(i,j,max(k-1,1))+precall(i,j,min(k,nz)))*0.5 > prcpthresh ) then - maskpry_bnd(k) = 1 - else - maskprn_bnd(k) = 1 - end if - - end do !k - do k = 1,nz - - ! Cloudy or clear at cell centers... - if( cloudmixr(i,j,k) > cloudthresh ) then - maskcld(k) = 1 - else - maskclr(k) = 1 - end if - - ! Raining or not at cell centers... - if( precall(i,j,k) > prcpthresh ) then - maskpry(k) = 1 - else - maskprn(k) = 1 - end if - - end do !k -! -! Now, use the initial boundary masks by class to generate a combined -! mask for the cell boundaries. -! - do k = 1,nzstag - - !Upward, or at least upward quiescent - if( sum(maskup(k,:)) > 0 .or. & - (maskqu(k) > 0 .and. ww(i,j,k) > 0) ) then - - !Are we are here because of maskup? If so, then we need to - !parse the correct updraft category. - if( maskqu(k) < 1 ) then - itr = UP1 + maxloc(maskup(k,:),1)-1 - else - itr = QUI - end if - - !For upward motion, determine cloud and precip characteristics - !based on the cell-center values below the boundary. - if( k==1 ) then - icl = CLR - ipr = PRN - else - call cloud_prcp_check(maskcld, CLD, maskclr, CLR, k-1, icl, & - "setup_class_masks: bnd cloud up") - call cloud_prcp_check(maskpry, PRY, maskprn, PRN, k-1, ipr, & - "setup_class_masks: bnd prcp up") - end if - - !Downward, or at least downward quiescent - else if( sum(maskdn(k,:)) > 0 .or. & - (maskqu(k) > 0 .and. ww(i,j,k) < 0) ) then - - !Are we here because of maskdn? If so, then we need to - !parse the correct downdraft category. - if( maskqu(k) < 1 ) then - itr = DN1 + maxloc(maskdn(k,:),1)-1 - else - itr = QUI - end if - - !For downward motion, determine cloud and precip characteristics - !based on the cell-center values above the boundary. - if( k==nzstag ) then - icl = CLR - ipr = PRN - else - call cloud_prcp_check(maskcld, CLD, maskclr, CLR, k, icl, & - "setup_class_masks: bnd cloud down") - call cloud_prcp_check(maskpry, PRY, maskprn, PRN, k, ipr, & - "setup_class_masks: bnd prcp down") - end if - - !Quiescent with w=0. Use the cell-center values averaged - !surrounding the boundary for the cloud/prcp states. - else - itr = QUI - call cloud_prcp_check(maskcld_bnd, CLD, maskclr_bnd, CLR, k, icl, & - "setup_class_masks: bnd cloud quiescent") - call cloud_prcp_check(maskpry_bnd, PRY, maskprn_bnd, PRN, k, ipr, & - "setup_class_masks: bnd prcp quiescent") - end if - -! +++mhwang -! Total condensate and different thresholds are used to classify transport classes. So the following change -! is not needed anymore. Minghuai Wang, 2010-04-23. -! -! In the clear, and non-precipitating class, it is classified as quiescent class in the MMF simulation. -! If this is classed as updraft or downdraft in mode 16, this would lead to too much upraft and downdraft mass fluxes. -! Minghuai Wang, 2010-01-18 (Minghuai.Wang@pnl.gov) -! if(icl.eq.CLR .and. ipr.eq.PRN) then -! itr = QUI -! end if -!---mhwang - - !We have all the class indices determined so now we can set - !the correct mask location to 1. -! mask_bnd(i,j,k,icl,itr,ipr) = 1. -! use fractioal cloudiness in SAM - if(icl.eq.CLR) then - mask_bnd(i,j,k,icl,itr,ipr) = 1. - else if(icl.eq.CLD) then - mask_bnd(i,j,k,CLD,itr,ipr) = (cf3d(i,j,max(k-1,1))+cf3d(i,j,min(k, nz)))*0.5 - mask_bnd(i,j,k,CLR,itr,ipr) = 1. - (cf3d(i,j,max(k-1,1))+cf3d(i,j,min(k, nz)))*0.5 - end if - - - end do !k-loop mask for boundaries -! -! Now, use the initial boundary masks by class to generate a combined -! mask for the cell centers. We determine the transport class based on -! splitting the cell conceptually in half with the upper boundary -! influencing the top half of the cell and the bottom boundary the bottom -! half. Each contributes either 0 or 0.5 of the total contribution of the -! cell's transport. e.g. if both boundaries are upward, then the cell is -! fully an "up" transport cell. If the two boundaries are opposite, then -! the cell is weighted half in each direction for the masking. -! - do k = 1,nz - - !Get the cloud/prcp characteristics at cell center. - call cloud_prcp_check(maskcld, CLD, maskclr, CLR, k, icl) - call cloud_prcp_check(maskpry, PRY, maskprn, PRN, k, ipr) - - !Look at the bottom boundary first and determine it's - !contribution to the cell center transport class. - if( sum(maskup(k,:)) > 0 ) then - itr = UP1 + maxloc(maskup(k,:),1)-1 - else if( sum(maskdn(k,:)) > 0 ) then - itr = DN1 + maxloc(maskdn(k,:),1)-1 - else if( maskqu(k) > 0 ) then - itr = QUI - else - call endrun("ERROR: setup_class_masks: We should not be in this place for cell bottoms.") - stop - end if - -! +++mhwang -! ! Total condensate and different thresholds are used to classify transport classes. So the following change -! is not needed anymore. Minghuai Wang, 2010-04-23. - -! In the clear, and non-precipitating class, it is classified as quiescent class in the MMF simulation. -! If this is classed as updraft or downdraft in mode 16, this would lead to too much upraft and downdraft mass fluxes. -! Minghuai Wang, 2010-01-18 (Minghuai.Wang@pnl.gov) -! if(icl.eq.CLR .and. ipr.eq.PRN) then -! itr = QUI -! end if -!---mhwang - - !We have what we need for the cell bottom classes so increment - !the center mask for the bottom half... -! mask_cen(i,j,k,icl,itr,ipr) = mask_cen(i,j,k,icl,itr,ipr) + 0.5 -! Use fractional cloudiness at SAM - if(icl.eq.CLR) then - mask_cen(i,j,k,icl,itr,ipr) = mask_cen(i,j,k,icl,itr,ipr) + 0.5 - else if(icl.eq.CLD) then - mask_cen(i,j,k,CLD,itr,ipr) = mask_cen(i,j,k,CLD,itr,ipr) + (cf3d(i,j,k))*0.5 - mask_cen(i,j,k,CLR,itr,ipr) = mask_cen(i,j,k,CLR,itr,ipr) + (1. - cf3d(i,j,k)) * 0.5 - end if - - !Next, look at the top boundary and determine it's - !contribution to the cell center transport class. - if( sum(maskup(k+1,:)) > 0 ) then - itr = UP1 + maxloc(maskup(k+1,:),1)-1 - else if( sum(maskdn(k+1,:)) > 0 ) then - itr = DN1 + maxloc(maskdn(k+1,:),1)-1 - else if( maskqu(k+1) > 0 ) then - itr = QUI - else - call endrun("ERROR: setup_class_masks: We should not be in this place for cell tops.") - end if - -! +++mhwang -! In the clear, and non-precipitating class, it is classified as quiescent class in the MMF simulation. -! If this is classed as updraft or downdraft in mode 16, this would lead to too much upraft and downdraft mass fluxes. -! Minghuai Wang, 2010-01-18 (Minghuai.Wang@pnl.gov) -! if(icl.eq.CLR .and. ipr.eq.PRN) then -! itr = QUI -! end if -!---mhwang - - !We have what we need for the cell top classes so increment - !the center mask for the top half... -! mask_cen(i,j,k,icl,itr,ipr) = mask_cen(i,j,k,icl,itr,ipr) + 0.5 -! use fractional cloudiness in SAM - if(icl.eq.CLR) then - mask_cen(i,j,k,icl,itr,ipr) = mask_cen(i,j,k,icl,itr,ipr) + 0.5 - else if(icl.eq.CLD) then - mask_cen(i,j,k,CLD,itr,ipr) = mask_cen(i,j,k,CLD,itr,ipr) + (cf3d(i,j,k))*0.5 - mask_cen(i,j,k,CLR,itr,ipr) = mask_cen(i,j,k,CLR,itr,ipr) + (1. - cf3d(i,j,k)) * 0.5 - end if - - end do !k-loop mask for centers - - end do - end do XYLOOPS -end subroutine setup_class_masks - - -!------------------------------------------------------------------------ -subroutine cloud_prcp_check(mask1, flag1, mask2, flag2, k, iout, msg) -! -! Assigns the flag associated with the mask value that is true to the -! output index. The masks are assumed to be 1-D arrays and k is the -! position in the array to check. -! William.Gustafson@pnl.gov; 11-Sep-2008 -!------------------------------------------------------------------------ -! -! Soubroutine arguments... -! - integer, dimension(:), intent(in) :: mask1, mask2 - integer, intent(in) :: flag1, flag2, k - integer, intent(out) :: iout - character(len=*), optional :: msg -! -! Local var... -! - integer :: n -! -! Sanity check -! - n = ubound(mask1,1) - if( k < 1 .or. k > n) then - write(0, *) 'cloud_prcp_check', 'k =',k, ' n =',n - call endrun('ERROR: k out of bounds in cloud_prcp_check') - end if -! -! Whichever mask has the value 1 has the associated flag put into iout -! - if( mask1(k) > 0 .and. mask2(k) < 1 ) then - iout = flag1 - else if( mask2(k) > 0 .and. mask1(k) < 1) then - iout = flag2 - else - write(0, *) 'cloud_prcp_check', 'k =', k - call endrun("ERROR: neither mask dominates in cloud_prcp_check") - end if - -end subroutine cloud_prcp_check - -#endif /*ECPP*/ -end module crmx_module_ecpp_stats - diff --git a/src/physics/spcam/crm/crmx_params.F90 b/src/physics/spcam/crm/crmx_params.F90 deleted file mode 100644 index f825374c30..0000000000 --- a/src/physics/spcam/crm/crmx_params.F90 +++ /dev/null @@ -1,180 +0,0 @@ -module crmx_params - -use crmx_grid, only: nzm -#ifdef CLUBB_CRM -! Use the CLUBB values for these constants for consistency -use crmx_constants_clubb, only: Cp_clubb => Cp, grav_clubb => grav, Lv_clubb => Lv, Lf_clubb => Lf, & - Ls_clubb => Ls, Rv_clubb => Rv, Rd_clubb => Rd, pi_clubb => pi -#else - -#ifdef CRM -use shr_const_mod, only: shr_const_rdair, shr_const_cpdair, shr_const_latvap, & - shr_const_latice, shr_const_latsub, shr_const_rgas, & - shr_const_mwwv, shr_const_stebol, shr_const_tkfrz, & - shr_const_mwdair, shr_const_g, shr_const_karman, & - shr_const_rhofw -#endif /*CRM*/ - -#endif - -implicit none - -! Constants: - -#ifdef CLUBB_CRM -! Define Cp, ggr, etc. in module constants_clubb -real, parameter :: cp = Cp_clubb -real, parameter :: ggr = grav_clubb -real, parameter :: lcond = Lv_clubb -real, parameter :: lfus = Lf_clubb -real, parameter :: lsub = Ls_clubb -real, parameter :: rv = Rv_clubb -real, parameter :: rgas= Rd_clubb -#else -#ifndef CRM -real, parameter :: cp = 1004. ! Specific heat of air, J/kg/K -real, parameter :: ggr = 9.81 ! Gravity acceleration, m/s2 -real, parameter :: lcond = 2.5104e+06 ! Latent heat of condensation, J/kg -real, parameter :: lfus = 0.3336e+06 ! Latent heat of fusion, J/kg -real, parameter :: lsub = 2.8440e+06 ! Latent heat of sublimation, J/kg -real, parameter :: rv = 461. ! Gas constant for water vapor, J/kg/K -real, parameter :: rgas = 287. ! Gas constant for dry air, J/kg/K -#else -real, parameter :: cp = shr_const_cpdair -real, parameter :: ggr = shr_const_g -real, parameter :: lcond = shr_const_latvap -real, parameter :: lfus = shr_const_latice -real, parameter :: lsub = lcond + lfus -real, parameter :: rv = shr_const_rgas/shr_const_mwwv -real, parameter :: rgas = shr_const_rdair -#endif -#endif -real, parameter :: diffelq = 2.21e-05 ! Diffusivity of water vapor, m2/s -real, parameter :: therco = 2.40e-02 ! Thermal conductivity of air, J/m/s/K -real, parameter :: muelq = 1.717e-05 ! Dynamic viscosity of air - -real, parameter :: fac_cond = lcond/cp -real, parameter :: fac_fus = lfus/cp -real, parameter :: fac_sub = lsub/cp - -#ifdef CLUBB_CRM -real, parameter :: pi = pi_clubb -#else -real, parameter :: pi = 3.141592653589793 -#endif - -! -! internally set parameters: - -real epsv ! = (1-eps)/eps, where eps= Rv/Ra, or =0. if dosmoke=.true. -logical:: dosubsidence = .false. -real fcorz ! Vertical Coriolis parameter -real coszrs - -!---------------------------------------------- -! Parameters set by PARAMETERS namelist: -! Initialized to default values. -!---------------------------------------------- - -real:: ug = 0. ! Velocity of the Domain's drift in x direction -real:: vg = 0. ! Velocity of the Domain's drift in y direction -real:: fcor = -999. ! Coriolis parameter -real:: longitude0 = 0. ! latitude of the domain's center -real:: latitude0 = 0. ! longitude of the domain's center -real:: nxco2 = 1 ! factor to modify co2 concentration -logical:: doradlat = .false. -logical:: doradlon = .false. - -real(kind=selected_real_kind(12)):: tabs_s =0. ! surface temperature,K -real:: delta_sst = 0. ! amplitude of sin-pattern of sst about tabs_s (ocean_type=1) -real:: depth_slab_ocean = 2. ! thickness of the slab-ocean (m) -real:: Szero = 0. ! mean ocean transport (W/m2) -real:: deltaS = 0. ! amplitude of linear variation of ocean transport (W/m2) -real:: timesimpleocean = 0. ! time to start simple ocean - -real:: fluxt0 =0. ! surface sensible flux, Km/s -real:: fluxq0 =0. ! surface latent flux, m/s -real:: tau0 =0. ! surface stress, m2/s2 -real:: z0 =0.035 ! roughness length -real:: soil_wetness =1.! wetness coeff for soil (from 0 to 1.) -integer:: ocean_type =0 ! type of SST forcing -logical:: cem =.false. ! flag for Cloud Ensemble Model -logical:: les =.false. ! flag for Large-Eddy Simulation -logical:: ocean =.false. ! flag indicating that surface is water -logical:: land =.false. ! flag indicating that surface is land -logical:: sfc_flx_fxd =.false. ! surface sensible flux is fixed -logical:: sfc_tau_fxd =.false.! surface drag is fixed - -real:: timelargescale =0. ! time to start large-scale forcing - -! nudging boundaries (between z1 and z2, where z2 > z1): -real:: nudging_uv_z1 =-1., nudging_uv_z2 = 1000000. -real:: nudging_t_z1 =-1., nudging_t_z2 = 1000000. -real:: nudging_q_z1 =-1., nudging_q_z2 = 1000000. -real:: tauls = 99999999. ! nudging-to-large-scaler-profile time-scale -real:: tautqls = 99999999.! nudging-to-large-scaler-profile time-scale for scalars - -logical:: dodamping = .false. -logical:: doupperbound = .false. -logical:: docloud = .false. -logical:: doclubb = .false. ! Enabled the CLUBB parameterization (interactively) -logical:: doclubb_sfc_fluxes = .false. ! Apply the surface fluxes within the CLUBB code rather than SAM -logical:: doclubbnoninter = .false. ! Enable the CLUBB parameterization (non-interactively) -logical:: docam_sfc_fluxes = .false. ! Apply the surface fluxes within CAM -logical:: doprecip = .false. -logical:: dolongwave = .false. -logical:: doshortwave = .false. -logical:: dosgs = .false. -logical:: docoriolis = .false. -logical:: docoriolisz = .false. -logical:: dofplane = .true. -logical:: dosurface = .false. -logical:: dolargescale = .false. -logical:: doradforcing = .false. -logical:: dosfcforcing = .false. -logical:: doradsimple = .false. -logical:: donudging_uv = .false. -logical:: donudging_tq = .false. -logical:: donudging_t = .false. -logical:: donudging_q = .false. -logical:: doensemble = .false. -logical:: dowallx = .false. -logical:: dowally = .false. -logical:: docolumn = .false. -logical:: docup = .false. -logical:: doperpetual = .false. -logical:: doseasons = .false. -logical:: doradhomo = .false. -logical:: dosfchomo = .false. -logical:: dossthomo = .false. -logical:: dodynamicocean = .false. -logical:: dosolarconstant = .false. -logical:: dotracers = .false. -logical:: dosmoke = .false. -logical:: notracegases = .false. - -! Specify solar constant and zenith angle for perpetual insolation. -! Based onn Tompkins and Graig (1998) -! Note that if doperpetual=.true. and dosolarconstant=.false. -! the insolation will be set to the daily-averaged value on day0. -real:: solar_constant = 685. ! solar constant (in W/m2) -real:: zenith_angle = 51.7 ! zenith angle (in degrees) - -integer:: nensemble =0 ! the number of subensemble set of perturbations -integer:: perturb_type = 0 ! type of initial noise in setperturb() -integer:: nclubb = 1 ! SAM timesteps per CLUBB timestep -! Initial bubble parameters. Activated when perturb_type = 2 - real:: bubble_x0 = 0. - real:: bubble_y0 = 0. - real:: bubble_z0 = 0. - real:: bubble_radius_hor = 0. - real:: bubble_radius_ver = 0. - real:: bubble_dtemp = 0. - real:: bubble_dq = 0. - -real uhl ! current large-scale velocity in x near sfc -real vhl ! current large-scale velocity in y near sfc -real :: taux0 = 0. ! surface stress in x, m2/s2 -real :: tauy0 = 0. ! surface stress in y, m2/s2 - -end module crmx_params diff --git a/src/physics/spcam/crm/crmx_periodic.F90 b/src/physics/spcam/crm/crmx_periodic.F90 deleted file mode 100644 index d0126e21ee..0000000000 --- a/src/physics/spcam/crm/crmx_periodic.F90 +++ /dev/null @@ -1,107 +0,0 @@ - -subroutine periodic(flag) - -use crmx_vars -use crmx_microphysics -use crmx_sgs -use crmx_params, only: dotracers, dosgs -use crmx_crmtracers -#ifdef CLUBB_CRM -use crmx_params, only: doclubb, doclubbnoninter -#endif -implicit none - -integer flag, i - -if(flag.eq.0) then - - call bound_exchange(u,dimx1_u,dimx2_u,dimy1_u,dimy2_u,nzm,1,1,1,1,1) - call bound_exchange(v,dimx1_v,dimx2_v,dimy1_v,dimy2_v,nzm,1,1,1,1,2) - ! use w at the top level - 0s anyway - to exchange the sst boundaries (for - ! surface fluxes call - w(1:nx,1:ny,nz) = sstxy(1:nx,1:ny) - call bound_exchange(w,dimx1_w,dimx2_w,dimy1_w,dimy2_w,nz,1,1,1,1,3) - sstxy(0:nx,1-YES3D:ny) = w(0:nx,1-YES3D:ny,nz) - w(0:nx+1,1-YES3D:ny+YES3D,nz) = 0. - -endif - - -if(flag.eq.2) then - - call bound_exchange(u,dimx1_u,dimx2_u,dimy1_u,dimy2_u,nzm,2,3,2+NADV,2+NADV,1) - call bound_exchange(v,dimx1_v,dimx2_v,dimy1_v,dimy2_v,nzm,2+NADV,2+NADV,2,3,2) - call bound_exchange(w,dimx1_w,dimx2_w,dimy1_w,dimy2_w,nz,2+NADV,2+NADV,2+NADV,2+NADV,3) - - call bound_exchange(t,dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm,3+NADVS,3+NADVS,3+NADVS,3+NADVS,4) - do i = 1,nsgs_fields - if(dosgs.and.advect_sgs) & - call bound_exchange(sgs_field(:,:,:,i),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm, & - 3+NADVS,3+NADVS,3+NADVS,3+NADVS,4+i) - end do - do i = 1,nmicro_fields - if( i.eq.index_water_vapor & -#ifdef CLUBB_CRM - ! Vince Larson (UWM) changed so that bound_exchange is called even if - ! docloud = .false. and doclubb = .true. 11 Nov 2007 - .or. (docloud.or.doclubb.or.doclubbnoninter) .and.flag_precip(i).ne.1 & -#else - .or. docloud.and.flag_precip(i).ne.1 & -#endif - .or. doprecip.and.flag_precip(i).eq.1 ) & - call bound_exchange(micro_field(:,:,:,i),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm, & - 3+NADVS,3+NADVS,3+NADVS,3+NADVS,4+nsgs_fields+nsgs_fields_diag+i) - end do - if(dotracers) then - do i=1,ntracers - call bound_exchange(tracer(:,:,:,i),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm, & - 3+NADVS,3+NADVS,3+NADVS,3+NADVS,4+nsgs_fields+nsgs_fields_diag+nmicro_fields+i) - end do - end if - -endif - -if(flag.eq.3) then - - call bound_exchange(t,dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm,1,1,1,1,4) - do i = 1,nsgs_fields - if(dosgs.and.advect_sgs) & - call bound_exchange(sgs_field(:,:,:,i),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm,1,1,1,1,4+i) - end do - do i = 1,nmicro_fields - if( i.eq.index_water_vapor & -#ifdef CLUBB_CRM - ! Vince Larson (UWM) changed so that bound_exchange is called even if - ! docloud = .false. and doclubb = .true. 11 Nov 2007 - .or. (docloud.or.doclubb.or.doclubbnoninter) .and.flag_precip(i).ne.1 & -#else - .or. docloud.and.flag_precip(i).ne.1 & -#endif - .or. doprecip.and.flag_precip(i).eq.1 ) & - call bound_exchange(micro_field(:,:,:,i),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm, & - 1,1,1,1,4+nsgs_fields+nsgs_fields_diag+i) - end do - if(dotracers) then - do i=1,ntracers - call bound_exchange(tracer(:,:,:,i),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm, & - 1,1,1,1,4+nsgs_fields+nsgs_fields_diag+nmicro_fields+i) - end do - end if - -endif - -if(flag.eq.4) then - - do i = 1,nsgs_fields_diag - if(dosgs.and.do_sgsdiag_bound) & - call bound_exchange(sgs_field_diag(:,:,:,i),dimx1_d,dimx2_d,dimy1_d,dimy2_d,nzm, & - 1+dimx1_d,dimx2_d-nx,YES3D+dimy1_d,1-YES3D+dimy2_d-ny,4+nsgs_fields+i) - end do - -end if - - - - -end subroutine periodic - diff --git a/src/physics/spcam/crm/crmx_precip_fall.F90 b/src/physics/spcam/crm/crmx_precip_fall.F90 deleted file mode 100644 index fb81395cee..0000000000 --- a/src/physics/spcam/crm/crmx_precip_fall.F90 +++ /dev/null @@ -1,229 +0,0 @@ -subroutine precip_fall(qp, term_vel, hydro_type, omega, ind) - -! positively definite monotonic advection with non-oscillatory option -! and gravitational sedimentation - -use crmx_vars -use crmx_params -implicit none - - - -real qp(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! falling hydrometeor -integer hydro_type ! 0 - all liquid, 1 - all ice, 2 - mixed -real omega(nx,ny,nzm) ! = 1: liquid, = 0: ice; = 0-1: mixed : used only when hydro_type=2 -integer ind - -! Terminal velocity fnction - -real, external :: term_vel ! terminal velocity function - - -! Local: - -real mx(nzm),mn(nzm), lfac(nz) -real www(nz),fz(nz) -real df(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) -real f0(nzm),df0(nzm) -real eps -integer i,j,k,kc,kb -logical nonos - -real y,pp,pn -pp(y)= max(0.,y) -pn(y)=-min(0.,y) - -real lat_heat, wmax - -real wp(nzm), tmp_qp(nzm), irhoadz(nzm), iwmax(nzm), rhofac(nzm), prec_cfl -integer nprec, iprec -real flagstat - -!-------------------------------------------------------- - -!call t_startf ('precip_fall') - -eps = 1.e-10 -nonos = .true. - - do k = 1,nzm - rhofac(k) = sqrt(1.29/rho(k)) - irhoadz(k) = 1./(rho(k)*adz(k)) ! Useful factor - kb = max(1,k-1) - wmax = dz*adz(kb)/dtn ! Velocity equivalent to a cfl of 1.0. - iwmax(k) = 1./wmax - end do - -! Add sedimentation of precipitation field to the vert. vel. - -do j=1,ny - do i=1,nx - - ! Compute precipitation velocity and flux column-by-column - - prec_cfl = 0. - - do k=1,nzm - - select case (hydro_type) - case(0) - lfac(k) = fac_cond - flagstat = 1. - case(1) - lfac(k) = fac_sub - flagstat = 1. - case(2) - lfac(k) = fac_cond + (1-omega(i,j,k))*fac_fus - flagstat = 1. - case(3) - lfac(k) = 0. - flagstat = 0. - case default - if(masterproc) then - print*, 'unknown hydro_type in precip_fall. exitting ...' - call task_abort - end if - end select - - wp(k)=rhofac(k)*term_vel(i,j,k,ind) - prec_cfl = max(prec_cfl,wp(k)*iwmax(k)) ! Keep column maximum CFL - wp(k) = -wp(k)*rhow(k)*dtn/dz - - end do ! k - - fz(nz)=0. - www(nz)=0. - lfac(nz)=0 - - ! If maximum CFL due to precipitation velocity is greater than 0.9, - ! take more than one advection step to maintain stability. - if (prec_cfl.gt.0.9) then - nprec = CEILING(prec_cfl/0.9) - do k = 1,nzm - ! wp already includes factor of dt, so reduce it by a - ! factor equal to the number of precipitation steps. - wp(k) = wp(k)/float(nprec) - end do - else - nprec = 1 - end if - - do iprec = 1,nprec - - do k = 1,nzm - tmp_qp(k) = qp(i,j,k) ! Temporary array for qp in this column - end do - - !----------------------------------------- - - if(nonos) then - - do k=1,nzm - kc=min(nzm,k+1) - kb=max(1,k-1) - mx(k)=max(tmp_qp(kb),tmp_qp(kc),tmp_qp(k)) - mn(k)=min(tmp_qp(kb),tmp_qp(kc),tmp_qp(k)) - end do - - end if ! nonos - - ! loop over iterations - - do k=1,nzm - ! Define upwind precipitation flux - fz(k)=tmp_qp(k)*wp(k) - end do - - do k=1,nzm - kc=k+1 - tmp_qp(k)=tmp_qp(k)-(fz(kc)-fz(k))*irhoadz(k) !Update temporary qp - end do - - do k=1,nzm - ! Also, compute anti-diffusive correction to previous - ! (upwind) approximation to the flux - kb=max(1,k-1) - ! The precipitation velocity is a cell-centered quantity, - ! since it is computed from the cell-centered - ! precipitation mass fraction. Therefore, a reformulated - ! anti-diffusive flux is used here which accounts for - ! this and results in reduced numerical diffusion. - www(k) = 0.5*(1.+wp(k)*irhoadz(k)) & - *(tmp_qp(kb)*wp(kb) - tmp_qp(k)*wp(k)) ! works for wp(k)<0 - end do - - !---------- non-osscilatory option --------------- - - if(nonos) then - - do k=1,nzm - kc=min(nzm,k+1) - kb=max(1,k-1) - mx(k)=max(tmp_qp(kb),tmp_qp(kc),tmp_qp(k),mx(k)) - mn(k)=min(tmp_qp(kb),tmp_qp(kc),tmp_qp(k),mn(k)) - end do - - do k=1,nzm - kc=min(nzm,k+1) - mx(k)=rho(k)*adz(k)*(mx(k)-tmp_qp(k))/(pn(www(kc)) + pp(www(k))+eps) - mn(k)=rho(k)*adz(k)*(tmp_qp(k)-mn(k))/(pp(www(kc)) + pn(www(k))+eps) - end do - - do k=1,nzm - kb=max(1,k-1) - ! Add limited flux correction to fz(k). - fz(k) = fz(k) & ! Upwind flux - + pp(www(k))*min(1.,mx(k), mn(kb)) & - - pn(www(k))*min(1.,mx(kb),mn(k)) ! Anti-diffusive flux - end do - - endif ! nonos - - ! Update precipitation mass fraction and liquid-ice static - ! energy using precipitation fluxes computed in this column. - do k=1,nzm - kc=k+1 - ! Update precipitation mass fraction. - ! Note that fz is the total flux, including both the - ! upwind flux and the anti-diffusive correction. - qp(i,j,k)=qp(i,j,k)-(fz(kc)-fz(k))*irhoadz(k) - qpfall(k)=qpfall(k)-(fz(kc)-fz(k))*irhoadz(k)*flagstat ! For qp budget - lat_heat = -(lfac(kc)*fz(kc)-lfac(k)*fz(k))*irhoadz(k) - t(i,j,k)=t(i,j,k)-lat_heat - tlat(k)=tlat(k)-lat_heat ! For energy budget - precflux(k) = precflux(k) - fz(k)*flagstat ! For statistics - end do - precsfc(i,j) = precsfc(i,j) - fz(1)*flagstat ! For statistics - precssfc(i,j) = precssfc(i,j) - fz(1)*(1.-omega(i,j,1))*flagstat ! For statistics - prec_xy(i,j) = prec_xy(i,j) - fz(1)*flagstat ! For 2D output - - if (iprec.lt.nprec) then - - ! Re-compute precipitation velocity using new value of qp. - do k=1,nzm - wp(k) = rhofac(k)*term_vel(i,j,k,ind) - ! Decrease precipitation velocity by factor of nprec - wp(k) = -wp(k)*rhow(k)*dtn/dz/float(nprec) - ! Note: Don't bother checking CFL condition at each - ! substep since it's unlikely that the CFL will - ! increase very much between substeps when using - ! monotonic advection schemes. - end do - - fz(nz)=0. - www(nz)=0. - lfac(nz)=0. - - end if - - end do !iprec - - end do -end do - - -!call t_stopf ('precip_fall') - -end subroutine precip_fall - - diff --git a/src/physics/spcam/crm/crmx_press_grad.F90 b/src/physics/spcam/crm/crmx_press_grad.F90 deleted file mode 100644 index f8dbd12da5..0000000000 --- a/src/physics/spcam/crm/crmx_press_grad.F90 +++ /dev/null @@ -1,69 +0,0 @@ - -subroutine press_grad - -! pressure term of the momentum equations - -use crmx_vars -use crmx_params, only: dowallx, dowally -implicit none - -real *8 rdx,rdy,rdz -integer i,j,k,kb,jb,ib - -rdx=1./dx -rdy=1./dy - -do k=1,nzm - kb=max(1,k-1) - rdz = 1./(dz*adzw(k)) - do j=1,ny - jb=j-YES3D - do i=1,nx - ib=i-1 - dudt(i,j,k,na)=dudt(i,j,k,na)-(p(i,j,k)-p(ib,j,k))*rdx - dvdt(i,j,k,na)=dvdt(i,j,k,na)-(p(i,j,k)-p(i,jb,k))*rdy - dwdt(i,j,k,na)=dwdt(i,j,k,na)-(p(i,j,k)-p(i,j,kb))*rdz - end do ! i - end do ! j -end do ! k - -do k=1,nzm - do j=1-YES3D,ny !bloss: 0,n* fixes computation of dp/d* in stats. - do i=0,nx - p(i,j,k)=p(i,j,k)*rho(k) ! convert p'/rho to p' - end do - end do -end do - -if(dowallx.and.mod(rank,nsubdomains_x).eq.0) then - - do k=1,nzm - do j=1,ny - dudt(1,j,k,na) = 0. - end do - end do - -end if - -if(dowally.and.RUN3D.and.rank.lt.nsubdomains_x) then - - do k=1,nzm - do i=1,nx - dvdt(i,1,k,na) = 0. - end do - end do - -end if - -if(dompi) then - call task_bound_duvdt() -else - call bound_duvdt() -endif - -call task_barrier() - -end subroutine press_grad - - - diff --git a/src/physics/spcam/crm/crmx_press_rhs.F90 b/src/physics/spcam/crm/crmx_press_rhs.F90 deleted file mode 100644 index 215a06bc13..0000000000 --- a/src/physics/spcam/crm/crmx_press_rhs.F90 +++ /dev/null @@ -1,105 +0,0 @@ - -subroutine press_rhs - -! right-hand-side of the Poisson equation for pressure - -use crmx_vars -use crmx_params, only: dowallx, dowally - -implicit none - - -real *8 dta,rdx,rdy,rdz,btat,ctat,rup,rdn -integer i,j,k,ic,jc,kc - -if(dowallx.and.mod(rank,nsubdomains_x).eq.0) then - - do k=1,nzm - do j=1,ny - dudt(1,j,k,na) = 0. - end do - end do - -end if - -if(dowally.and.RUN3D.and.rank.lt.nsubdomains_x) then - - do k=1,nzm - do i=1,nx - dvdt(i,1,k,na) = 0. - end do - end do - -end if - - -if(dompi) then - call task_bound_duvdt() -else - call bound_duvdt() -endif - -dta=1./dt3(na)/at -rdx=1./dx -rdy=1./dy -btat=bt/at -ctat=ct/at - -if(RUN3D) then - -do k=1,nzm - kc=k+1 - rdz=1./(adz(k)*dz) - rup = rhow(kc)/rho(k)*rdz - rdn = rhow(k)/rho(k)*rdz - do j=1,ny - jc=j+1 - do i=1,nx - ic=i+1 - p(i,j,k)=(rdx*(u(ic,j,k)-u(i,j,k))+ & - rdy*(v(i,jc,k)-v(i,j,k))+ & - (w(i,j,kc)*rup-w(i,j,k)*rdn) )*dta + & - (rdx*(dudt(ic,j,k,na)-dudt(i,j,k,na))+ & - rdy*(dvdt(i,jc,k,na)-dvdt(i,j,k,na))+ & - (dwdt(i,j,kc,na)*rup-dwdt(i,j,k,na)*rdn) ) + & - btat*(rdx*(dudt(ic,j,k,nb)-dudt(i,j,k,nb))+ & - rdy*(dvdt(i,jc,k,nb)-dvdt(i,j,k,nb))+ & - (dwdt(i,j,kc,nb)*rup-dwdt(i,j,k,nb)*rdn) ) + & - ctat*(rdx*(dudt(ic,j,k,nc)-dudt(i,j,k,nc))+ & - rdy*(dvdt(i,jc,k,nc)-dvdt(i,j,k,nc))+ & - (dwdt(i,j,kc,nc)*rup-dwdt(i,j,k,nc)*rdn) ) - p(i,j,k)=p(i,j,k)*rho(k) - end do - end do -end do - - -else - -j=1 - -do k=1,nzm - kc=k+1 - rdz=1./(adz(k)*dz) - rup = rhow(kc)/rho(k)*rdz - rdn = rhow(k)/rho(k)*rdz - do i=1,nx - ic=i+1 - p(i,j,k)=(rdx*(u(ic,j,k)-u(i,j,k))+ & - (w(i,j,kc)*rup-w(i,j,k)*rdn) )*dta + & - (rdx*(dudt(ic,j,k,na)-dudt(i,j,k,na))+ & - (dwdt(i,j,kc,na)*rup-dwdt(i,j,k,na)*rdn) ) + & - btat*(rdx*(dudt(ic,j,k,nb)-dudt(i,j,k,nb))+ & - (dwdt(i,j,kc,nb)*rup-dwdt(i,j,k,nb)*rdn) ) + & - ctat*(rdx*(dudt(ic,j,k,nc)-dudt(i,j,k,nc))+ & - (dwdt(i,j,kc,nc)*rup-dwdt(i,j,k,nc)*rdn) ) - p(i,j,k)=p(i,j,k)*rho(k) - end do -end do - - -endif - -call task_barrier() - -end subroutine press_rhs diff --git a/src/physics/spcam/crm/crmx_pressure.F90 b/src/physics/spcam/crm/crmx_pressure.F90 deleted file mode 100644 index d8376e782d..0000000000 --- a/src/physics/spcam/crm/crmx_pressure.F90 +++ /dev/null @@ -1,517 +0,0 @@ -! Non-blocking receives before blocking sends - -subroutine pressure - -! Original pressure solver based on horizontal slabs -! (C) 1998, 2002 Marat Khairoutdinov -! Works only when the number of slabs is equal to the number of processors. -! Therefore, the number of processors shouldn't exceed the number of levels nzm -! Also, used for a 2D version -! For more processors for the given number of levels and 3D, use pressure_big - -use crmx_vars -use crmx_params, only: dowallx, dowally, docolumn -implicit none - - -integer, parameter :: npressureslabs = nsubdomains -integer, parameter :: nzslab = max(1,nzm / npressureslabs) -integer, parameter :: nx2=nx_gl+2, ny2=ny_gl+2*YES3D -integer, parameter :: n3i=3*nx_gl/2+1,n3j=3*ny_gl/2+1 - -real f(nx2,ny2,nzslab) ! global rhs and array for FTP coefficeients -real ff(nx+1,ny+2*YES3D,nzm) ! local (subdomain's) version of f -real buff_slabs(nxp1,nyp2,nzslab,npressureslabs) -real buff_subs(nxp1,nyp2,nzslab,nsubdomains) -real bufp_slabs(0:nx,1-YES3D:ny,nzslab,npressureslabs) -real bufp_subs(0:nx,1-YES3D:ny,nzslab,nsubdomains) -common/tmpstack/f,ff,buff_slabs,buff_subs -equivalence (buff_slabs,bufp_slabs) -equivalence (buff_subs,bufp_subs) - -real work(nx2,ny2),trigxi(n3i),trigxj(n3j) ! FFT stuff -integer ifaxj(100),ifaxi(100) - -real(kind=selected_real_kind(12)) a(nzm),b,c(nzm),e,fff(nzm) -real(kind=selected_real_kind(12)) xi,xj,xnx,xny,ddx2,ddy2,pii,factx,facty,eign -real(kind=selected_real_kind(12)) alfa(nzm-1),beta(nzm-1) - -integer reqs_in(nsubdomains) -integer i, j, k, id, jd, m, n, it, jt, ii, jj, tag, rf -integer nyp22, n_in, count -integer iii(0:nx_gl),jjj(0:ny_gl) -logical flag(nsubdomains) -integer iwall,jwall -integer,parameter :: DBL = selected_real_kind(12) - -! check if the grid size allows the computation: - -if(nsubdomains.gt.nzm) then - if(masterproc) print*,'pressure_orig: nzm < nsubdomains. STOP' - call task_abort -endif - -if(mod(nzm,npressureslabs).ne.0) then - if(masterproc) print*,'pressure_orig: nzm/npressureslabs is not round number. STOP' - call task_abort -endif - -!----------------------------------------------------------------- - -if(docolumn) return - -if(dowallx) then - iwall=1 -else - iwall=0 -end if -if(RUN2D) then - nyp22=1 - jwall=0 -else - nyp22=nyp2 - if(dowally) then - jwall=2 - else - jwall=0 - end if -endif - -!----------------------------------------------------------------- -! Compute the r.h.s. of the Poisson equation for pressure - -call press_rhs() - - -!----------------------------------------------------------------- -! Form the horizontal slabs of right-hand-sides of Poisson equation -! for the global domain. Request sending and receiving tasks. - -! iNon-blocking receive first: - -n_in = 0 -do m = 0,nsubdomains-1 - - if(rank.lt.npressureslabs.and.m.ne.nsubdomains-1) then - - n_in = n_in + 1 - call task_receive_float(bufp_subs(0,1-YES3D,1,n_in), & - nzslab*nxp1*nyp1,reqs_in(n_in)) - flag(n_in) = .false. - - endif - - if(rank.lt.npressureslabs.and.m.eq.nsubdomains-1) then - - call task_rank_to_index(rank,it,jt) - n = rank*nzslab - do k = 1,nzslab - do j = 1,ny - do i = 1,nx - f(i+it,j+jt,k) = p(i,j,k+n) - end do - end do - end do - endif - -end do ! m - - -! Blocking send now: - - -do m = 0,nsubdomains-1 - - if(m.lt.npressureslabs.and.m.ne.rank) then - - n = m*nzslab + 1 - call task_bsend_float(m,p(0,1-YES3D,n),nzslab*nxp1*nyp1, 33) - endif - -end do ! m - - -! Fill slabs when receive buffers are full: - -count = n_in -do while (count .gt. 0) - do m = 1,n_in - if(.not.flag(m)) then - call task_test(reqs_in(m), flag(m), rf, tag) - if(flag(m)) then - count=count-1 - call task_rank_to_index(rf,it,jt) - do k = 1,nzslab - do j = 1,ny - do i = 1,nx - f(i+it,j+jt,k) = bufp_subs(i,j,k,m) - end do - end do - end do - endif - endif - end do -end do - - -!------------------------------------------------- -! Perform Fourier transformation for a slab: - -if(rank.lt.npressureslabs) then - - call fftfax_crm(nx_gl,ifaxi,trigxi) - if(RUN3D) call fftfax_crm(ny_gl,ifaxj,trigxj) - - do k=1,nzslab - - call fft991_crm(f(1,1,k),work,trigxi,ifaxi,1,nx2,nx_gl,ny_gl,-1) - - if(RUN3D) then - call fft991_crm(f(1,1,k),work,trigxj,ifaxj,nx2,1,ny_gl,nx_gl+1,-1) - end if - - end do - -endif - - -! Synchronize all slabs: - -call task_barrier() - -!------------------------------------------------- -! Send Fourier coeffiecients back to subdomains: - -! Non-blocking receive first: - -n_in = 0 -do m = 0, nsubdomains-1 - - call task_rank_to_index(m,it,jt) - - if(rank.lt.npressureslabs.and.m.eq.rank) then - - n = rank*nzslab - do k = 1,nzslab - do j = 1,nyp22-jwall - do i = 1,nxp1-iwall - ff(i,j,k+n) = f(i+it,j+jt,k) - end do - end do - end do - - end if - - if(m.lt.npressureslabs-1.or.m.eq.npressureslabs-1 & - .and.rank.ge.npressureslabs) then - - n_in = n_in + 1 - call task_receive_float(buff_slabs(1,1,1,n_in), & - nzslab*nxp1*nyp22,reqs_in(n_in)) - flag(n_in) = .false. - endif - -end do ! m - -! Blocking send now: - -do m = 0, nsubdomains-1 - - call task_rank_to_index(m,it,jt) - - if(rank.lt.npressureslabs.and.m.ne.rank) then - - do k = 1,nzslab - do j = 1,nyp22 - do i = 1,nxp1 - buff_subs(i,j,k,1) = f(i+it,j+jt,k) - end do - end do - end do - - call task_bsend_float(m, buff_subs(1,1,1,1),nzslab*nxp1*nyp22,44) - - endif - -end do ! m - - - -! Fill slabs when receive buffers are complete: - - -count = n_in -do while (count .gt. 0) - do m = 1,n_in - if(.not.flag(m)) then - call task_test(reqs_in(m), flag(m), rf, tag) - if(flag(m)) then - count=count-1 - n = rf*nzslab - do k = 1,nzslab - do j=1,nyp22 - do i=1,nxp1 - ff(i,j,k+n) = buff_slabs(i,j,k,m) - end do - end do - end do - endif - endif - end do -end do - -!------------------------------------------------- -! Solve the tri-diagonal system for Fourier coeffiecients -! in the vertical for each subdomain: - -do k=1,nzm - a(k)=rhow(k)/(adz(k)*adzw(k)*dz*dz) - c(k)=rhow(k+1)/(adz(k)*adzw(k+1)*dz*dz) -end do - -call task_rank_to_index(rank,it,jt) - -ddx2=1._DBL/(dx*dx) -ddy2=1._DBL/(dy*dy) -pii = acos(-1._DBL) -xnx=pii/nx_gl -xny=pii/ny_gl -do j=1,nyp22-jwall - if(dowally) then - jd=j+jt-1 - facty = 1.d0 - else - jd=(j+jt-0.1)/2. - facty = 2.d0 - end if - xj=jd - do i=1,nxp1-iwall - if(dowallx) then - id=i+it-1 - factx = 1.d0 - else - id=(i+it-0.1)/2. - factx = 2.d0 - end if - fff(1:nzm) = ff(i,j,1:nzm) - xi=id - eign=(2._DBL*cos(factx*xnx*xi)-2._DBL)*ddx2+ & - (2._DBL*cos(facty*xny*xj)-2._DBL)*ddy2 - if(id+jd.eq.0) then - b=1._DBL/(eign*rho(1)-a(1)-c(1)) - alfa(1)=-c(1)*b - beta(1)=fff(1)*b - else - b=1._DBL/(eign*rho(1)-c(1)) - alfa(1)=-c(1)*b - beta(1)=fff(1)*b - end if - do k=2,nzm-1 - e=1._DBL/(eign*rho(k)-a(k)-c(k)+a(k)*alfa(k-1)) - alfa(k)=-c(k)*e - beta(k)=(fff(k)-a(k)*beta(k-1))*e - end do - - fff(nzm)=(fff(nzm)-a(nzm)*beta(nzm-1))/ & - (eign*rho(nzm)-a(nzm)+a(nzm)*alfa(nzm-1)) - - do k=nzm-1,1,-1 - fff(k)=alfa(k)*fff(k+1)+beta(k) - end do - ff(i,j,1:nzm) = fff(1:nzm) - - end do -end do - -call task_barrier() - -!----------------------------------------------------------------- -! Send the Fourier coefficient to the tasks performing -! the inverse Fourier transformation: - -! Non-blocking receive first: - -n_in = 0 -do m = 0,nsubdomains-1 - - if(rank.lt.npressureslabs.and.m.ne.nsubdomains-1) then - n_in = n_in + 1 - call task_receive_float(buff_subs(1,1,1,n_in), & - nzslab*nxp1*nyp22, reqs_in(n_in)) - flag(n_in) = .false. - endif - - if(rank.lt.npressureslabs.and.m.eq.nsubdomains-1) then - - call task_rank_to_index(rank,it,jt) - n = rank*nzslab - do k = 1,nzslab - do j = 1,nyp22-jwall - do i = 1,nxp1-iwall - f(i+it,j+jt,k) = ff(i,j,k+n) - end do - end do - end do - - endif - -end do ! m - -! Blocking send now: - -do m = 0,nsubdomains-1 - - if(m.lt.npressureslabs.and.m.ne.rank) then - n = m*nzslab+1 - call task_bsend_float(m,ff(1,1,n),nzslab*nxp1*nyp22, 33) - endif - -end do ! m - - -! Fill slabs when receive buffers are full: - - -count = n_in -do while (count .gt. 0) - do m = 1,n_in - if(.not.flag(m)) then - call task_test(reqs_in(m), flag(m), rf, tag) - if(flag(m)) then - count=count-1 - call task_rank_to_index(rf,it,jt) - do k = 1,nzslab - do j = 1,nyp22-jwall - do i = 1,nxp1-iwall - f(i+it,j+jt,k) = buff_subs(i,j,k,m) - end do - end do - end do - endif - endif - end do -end do - -!------------------------------------------------- -! Perform inverse Fourier transformation: - -if(rank.lt.npressureslabs) then - - do k=1,nzslab - - if(RUN3D) then - call fft991_crm(f(1,1,k),work,trigxj,ifaxj,nx2,1,ny_gl,nx_gl+1,+1) - end if - - call fft991_crm(f(1,1,k),work,trigxi,ifaxi,1,nx2,nx_gl,ny_gl,+1) - - end do - -endif - -call task_barrier() - -!----------------------------------------------------------------- -! Fill the pressure field for each subdomain: - -do i=1,nx_gl - iii(i)=i -end do -iii(0)=nx_gl -do j=1,ny_gl - jjj(j)=j -end do -jjj(0)=ny_gl - -! Non-blocking receive first: - -n_in = 0 -do m = 0, nsubdomains-1 - - call task_rank_to_index(m,it,jt) - - if(m.lt.npressureslabs-1.or. & - m.eq.npressureslabs-1.and.rank.ge.npressureslabs) then - - n_in = n_in + 1 - call task_receive_float(bufp_slabs(0,1-YES3D,1,n_in), & - nzslab*nxp1*nyp1, reqs_in(n_in)) - flag(n_in) = .false. - - endif - - if(rank.lt.npressureslabs.and.m.eq.rank) then - - n = rank*nzslab - do k = 1,nzslab - do j = 1-YES3D,ny - jj=jjj(j+jt) - do i = 0,nx - ii=iii(i+it) - p(i,j,k+n) = f(ii,jj,k) - end do - end do - end do - - end if - -end do ! m - - -! Blocking send now: - -do m = 0, nsubdomains-1 - - call task_rank_to_index(m,it,jt) - - if(rank.lt.npressureslabs.and.m.ne.rank) then - - do k = 1,nzslab - do j = 1-YES3D,ny - jj=jjj(j+jt) - do i = 0,nx - ii=iii(i+it) - bufp_subs(i,j,k,1) = f(ii,jj,k) - end do - end do - end do - - call task_bsend_float(m, bufp_subs(0,1-YES3D,1,1), nzslab*nxp1*nyp1,44) - - endif - -end do ! m - -! Fill the receive buffers: - -count = n_in -do while (count .gt. 0) - do m = 1,n_in - if(.not.flag(m)) then - call task_test(reqs_in(m), flag(m), rf, tag) - if(flag(m)) then - count=count-1 - n = rf*nzslab - do k = 1,nzslab - do j=1-YES3D,ny - do i=0,nx - p(i,j,k+n) = bufp_slabs(i,j,k,m) - end do - end do - end do - endif - endif - end do -end do - - -call task_barrier() - -! Add pressure gradient term to the rhs of the momentum equation: - -call press_grad() - -end - - - diff --git a/src/physics/spcam/crm/crmx_random.F90 b/src/physics/spcam/crm/crmx_random.F90 deleted file mode 100644 index 7e0172527b..0000000000 --- a/src/physics/spcam/crm/crmx_random.F90 +++ /dev/null @@ -1,62 +0,0 @@ -! Simple randaom number generator in the range [0,1] -! ranset_(iseed) initializes with iseed -! ranf_() returns next random numer - - - - - real function ranf_() - implicit none - real rand_ -! ranf_ = rand_(0) - call random_number(ranf_) - return - end - - - subroutine ranset_(iseed) - implicit none - real rand_,ranf_ - integer iseed, i, m, nsteps -! i = rand_(1) ! reinitialize (reset) - nsteps = iseed*10000 - do i = 1,nsteps - m = ranf_() -! m = rand_(0) - end do - return - end - - - - - - real function rand_(iseed) - implicit none - integer iseed - integer ia1, ia0, ia1ma0, ic, ix1, ix0, iy0, iy1 - save ia1, ia0, ia1ma0, ic, ix1, ix0 - data ix1, ix0, ia1, ia0, ia1ma0, ic/0,0,1536,1029,507,1731/ - if (iseed.ne.0) then - ia1 = 1536 - ia0 = 1029 - ia1ma0 = 507 - ic = 1731 - ix1 = 0 - ix0 = 0 - rand_ = 0 - else - iy0 = ia0*ix0 - iy1 = ia1*ix1 + ia1ma0*(ix0-ix1) + iy0 - iy0 = iy0 + ic - ix0 = mod (iy0, 2048) - iy1 = iy1 + (iy0-ix0)/2048 - ix1 = mod (iy1, 2048) - rand_ = ix1*2048 + ix0 - rand_ = rand_ / 4194304. - end if - return - end - - - diff --git a/src/physics/spcam/crm/crmx_sat.F90 b/src/physics/spcam/crm/crmx_sat.F90 deleted file mode 100644 index fb74141d07..0000000000 --- a/src/physics/spcam/crm/crmx_sat.F90 +++ /dev/null @@ -1,122 +0,0 @@ - -! Saturation vapor pressure and mixing ratio. -! Based on Flatau et.al, (JAM, 1992:1507) - valid for T > -80C -! sat. vapor over ice below -80C - used Murphy and Koop (2005) -! For water below -80C simply assumed esw/esi = 2. -! des/dT below -80C computed as a finite difference of es - -real function esatw_crm(t) -implicit none -real t ! temperature (K) -real a0,a1,a2,a3,a4,a5,a6,a7,a8 -data a0,a1,a2,a3,a4,a5,a6,a7,a8 /& - 6.105851, 0.4440316, 0.1430341e-1, & - 0.2641412e-3, 0.2995057e-5, 0.2031998e-7, & - 0.6936113e-10, 0.2564861e-13,-0.3704404e-15/ -! 6.11239921, 0.443987641, 0.142986287e-1, & -! 0.264847430e-3, 0.302950461e-5, 0.206739458e-7, & -! 0.640689451e-10, -0.952447341e-13,-0.976195544e-15/ -real dt - dt = t-273.16 -if(dt.gt.-80.) then - esatw_crm = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) -else - esatw_crm = 2.*0.01*exp(9.550426 - 5723.265/t + 3.53068*Log(t) - 0.00728332*t) -end if -end - - - -real function qsatw_crm(t,p) -implicit none -real t ! temperature (K) -real p ! pressure (mb) -real esat_crm,esatw_crm -esat_crm = esatw_crm(t) -qsatw_crm = 0.622 * esat_crm/max(esat_crm,p-esat_crm) -end - - -real function dtesatw_crm(t) -implicit none -real t ! temperature (K) -real a0,a1,a2,a3,a4,a5,a6,a7,a8 -data a0,a1,a2,a3,a4,a5,a6,a7,a8 /& - 0.443956472, 0.285976452e-1, 0.794747212e-3, & - 0.121167162e-4, 0.103167413e-6, 0.385208005e-9, & - -0.604119582e-12, -0.792933209e-14, -0.599634321e-17/ -real dt,esatw_crm -dt = t-273.16 -if(dt.gt.-80.) then - dtesatw_crm = a0 + dt* (a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) -else - dtesatw_crm = esatw_crm(t+1)-esatw_crm(t) -end if - -end - - -real function dtqsatw_crm(t,p) -implicit none -real t ! temperature (K) -real p ! pressure (mb) -real dtesatw_crm -dtqsatw_crm = 0.622*dtesatw_crm(t)/p -end - - -real function esati_crm(t) -implicit none -real t ! temperature (K) -real a0,a1,a2,a3,a4,a5,a6,a7,a8 -data a0,a1,a2,a3,a4,a5,a6,a7,a8 /& - 6.11147274, 0.503160820, 0.188439774e-1, & - 0.420895665e-3, 0.615021634e-5,0.602588177e-7, & - 0.385852041e-9, 0.146898966e-11, 0.252751365e-14/ -real dt -dt = t-273.16 -if(dt.gt.-80.) then - esati_crm = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) -else - esati_crm = 0.01*exp(9.550426 - 5723.265/t + 3.53068*Log(t) - 0.00728332*t) -end if -end - - - -real function qsati_crm(t,p) -implicit none -real t ! temperature (K) -real p ! pressure (mb) -real esat_crm,esati_crm -esat_crm=esati_crm(t) -qsati_crm=0.622 * esat_crm/max(esat_crm,p-esat_crm) -end - - -real function dtesati_crm(t) -implicit none -real t ! temperature (K) -real a0,a1,a2,a3,a4,a5,a6,a7,a8 -data a0,a1,a2,a3,a4,a5,a6,a7,a8 / & - 0.503223089, 0.377174432e-1,0.126710138e-2, & - 0.249065913e-4, 0.312668753e-6, 0.255653718e-8, & - 0.132073448e-10, 0.390204672e-13, 0.497275778e-16/ -real dt,esati_crm -dt = t-273.16 -if(dt.gt.-80.) then - dtesati_crm = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) -else - dtesati_crm = esati_crm(t+1.)-esati_crm(t) -end if -end - - -real function dtqsati_crm(t,p) -implicit none -real t ! temperature (K) -real p ! pressure (mb) -real dtesati_crm -dtqsati_crm=0.622*dtesati_crm(t)/p -end - diff --git a/src/physics/spcam/crm/crmx_setparm.F90 b/src/physics/spcam/crm/crmx_setparm.F90 deleted file mode 100644 index e843b22621..0000000000 --- a/src/physics/spcam/crm/crmx_setparm.F90 +++ /dev/null @@ -1,140 +0,0 @@ -module crmx_setparm_mod - -contains - -subroutine setparm - -! initialize parameters: - -use crmx_vars -!use micro_params -use crmx_params -use crmx_microphysics, only: micro_setparm -use crmx_sgs, only: sgs_setparm - -implicit none - -integer icondavg, ierr - -!NAMELIST /PARAMETERS/ dodamping, doupperbound, docloud, doprecip, & -! dolongwave, doshortwave, dosgs, & -! docoriolis, dosurface, dolargescale, doradforcing, & -! nadams,fluxt0,fluxq0,tau0,tabs_s,z0,tauls,nelapse, & -! dt, dx, dy, fcor, ug, vg, nstop, caseid, & -! nstat, nstatfrq, nprint, nrestart, doradsimple, & -! nsave3D, nsave3Dstart, nsave3Dend, dosfcforcing, & -! donudging_uv, donudging_tq, dosmagor, doscalar, & -! timelargescale, longitude0, latitude0, day0, nrad, & -! CEM,LES,OCEAN,LAND,SFC_FLX_FXD,SFC_TAU_FXD, soil_wetness, & -! doensemble, nensemble, doxy, dowallx, dowally, & -! nsave2D, nsave2Dstart, nsave2Dend, qnsave3D, & -! docolumn, save2Dbin, save2Davg, save3Dbin, & -! save2Dsep, save3Dsep, dogzip2D, dogzip3D, restart_sep, & -! doseasons, doperpetual, doradhomo, dosfchomo, doisccp, & -! dodynamicocean, ocean_type, & -! dosolarconstant, solar_constant, zenith_angle, rundatadir, & -! dotracers, output_sep, perturb_type, & -! doSAMconditionals, dosatupdnconditionals, & -! doscamiopdata, iopfile, dozero_out_day0, & -! nstatmom, nstatmomstart, nstatmomend, savemomsep, savemombin, & -! nmovie, nmoviestart, nmovieend, nrestart_skip, & -! bubble_x0,bubble_y0,bubble_z0,bubble_radius_hor, & -! bubble_radius_ver,bubble_dtemp,bubble_dq, dosmoke, & -! doclubb, doclubbnoninter, doclubb_sfc_fluxes, & ! added by dschanen UWM -! docam_sfc_fluxes ! added by mhwang - - - -!---------------------------------- -! Read namelist variables from the standard input: -!------------ - -!open(55,file='./'//trim(case)//'/prm', status='old',form='formatted') -!read (55,PARAMETERS) -!close(55) - - doprecip = .true. - dosgs = .true. - dosurface = .true. - dodamping = .true. - dt = CRM_DT - dx = CRM_DX - dy = CRM_DY - CEM = .true. -#ifndef CLUBB_CRM - doclubb = .false. ! then docloud must be .true. - docloud = .true. -#else - doclubb = .true. ! then docloud must be .false. - docloud = .false. - doclubbnoninter = .false. - doclubb_sfc_fluxes = .false. - docam_sfc_fluxes = .true. ! update variables in cam, neither in sam nor in clubb +++mhwang - nclubb = 3 - -#ifdef sam1mom -! for sam1mom, nclubb needs to be 1. -! see comments in ./MICRO_SAM1MOM/microphysics.F90 - nclubb = 3 -#endif - -#endif - rank = 0 ! in MMF model, rank = 0 -!------------------------------------ -! Set parameters - - - ! Allow only special cases for separate output: - - output_sep = output_sep.and.RUN3D - if(output_sep) save2Dsep = .true. - - if(RUN2D) dy=dx - - if(RUN2D.and.YES3D.eq.1) then - print*,'Error: 2D run and YES3D is set to 1. Exitting...' - call task_abort() - endif - if(RUN3D.and.YES3D.eq.0) then - print*,'Error: 3D run and YES3D is set to 0. Exitting...' - call task_abort() - endif -#ifdef CLUBB_CRM - if ( dx >= 1000. .and. LES ) then - print*,'Error: Horizonatal grid spacing is >= 1000. meters' - print*,'but LES is true. Use CEM mode for coarse resolutions.' - call task_abort() - end if -#endif - - if(fcor.eq.-999.) fcor= 4*pi/86400.*sin(latitude0*pi/180.) - fcorz = sqrt(4.*(2*pi/(3600.*24.))**2-fcor**2) - - if(ny.eq.1) dy=dx - dtn = dt - - notopened2D = .true. - notopened3D = .true. - -! call zero_instr_diag() ! initialize instruments output - call sgs_setparm() ! read in SGS options from prm file. - call micro_setparm() ! read in microphysical options from prm file. - - if(dosmoke) then - epsv=0. - else - epsv=0.61 - endif - - if(navgmom_x.lt.0.or.navgmom_y.lt.0) then - nstatmom = 1 - nstatmomstart = 99999999 - nstatmomend = 999999999 - end if - - if(tautqls.eq.99999999.) tautqls = tauls - - masterproc = rank.eq.0 - -end subroutine setparm -end module crmx_setparm_mod diff --git a/src/physics/spcam/crm/crmx_setperturb.F90 b/src/physics/spcam/crm/crmx_setperturb.F90 deleted file mode 100644 index 88bbabeed4..0000000000 --- a/src/physics/spcam/crm/crmx_setperturb.F90 +++ /dev/null @@ -1,59 +0,0 @@ - -subroutine setperturb(iseed) - -! Random noise -! This surboutine has been updated for SPCAM5 (Minghuai.Wang@pnnl.gov, April, 2012). -! Now the random generator is seeded based on the global column id, which gets rid -! of the dependence of the SPCAM reulst on pcols. - -use crmx_vars -use crmx_sgs, only: setperturb_sgs - -implicit none - -integer, intent(in) :: iseed - -integer i,j,k -real rrr,ranf_ -integer, allocatable :: rndm_seed(:) -integer :: rndm_seed_sz -real :: t02(nzm) -real :: tke02(nzm) - -!call ranset_(30*rank) -call random_seed(size=rndm_seed_sz) -allocate(rndm_seed(rndm_seed_sz)) - -rndm_seed = iseed -call random_seed(put=rndm_seed) - -call setperturb_sgs(0) ! set sgs fields - -t02 = 0.0 -tke02 = 0.0 -do k=1,nzm - do j=1,ny - do i=1,nx - rrr=1.-2.*ranf_() - - if(k.le.5) then - t(i,j,k)=t(i,j,k)+0.02*rrr*(6-k) - endif - t02(k) = t02(k) + t(i,j,k)/(nx*ny) - end do - end do - -! energy conservation +++mhwang (2012-06) - do j=1, ny - do i=1, nx - if(k.le.5) then - t(i,j,k) = t(i,j,k) * t0(k)/t02(k) - end if - end do - end do -end do - -deallocate(rndm_seed) - -end - diff --git a/src/physics/spcam/crm/crmx_stepout.F90 b/src/physics/spcam/crm/crmx_stepout.F90 deleted file mode 100644 index 0c7f66bc0f..0000000000 --- a/src/physics/spcam/crm/crmx_stepout.F90 +++ /dev/null @@ -1,196 +0,0 @@ -subroutine stepout(nstatsteps) - -use crmx_vars -!use rad, only: qrad -use crmx_sgs, only: tk, sgs_print -use crmx_crmtracers -use crmx_microphysics, only: micro_print -use crmx_params -implicit none - -integer i,j,k,ic,jc,nstatsteps -integer n -real div, divmax, divmin -real rdx, rdy, rdz, coef -integer im,jm,km -real wmax, qnmax(1), qnmax1(1) -real(kind=selected_real_kind(12)) buffer(6), buffer1(6) -real(kind=selected_real_kind(12)) qi0(nzm) - -#ifdef CLUBB_CRM -real(8) buffer_e(7), buffer1_e(7) -#endif - - - -!------------------------------------------------------------------------------ -!------------------------------------------------------------------------------ -! Print stuff out: - -!call t_startf ('print_out') - -if(masterproc) print *,'NSTEP = ',nstep,' NCYCLE=',ncycle - -if(mod(nstep,nprint).eq.0) then - - - divmin=1.e20 - divmax=-1.e20 - - rdx = 1./dx - rdy = 1./dy - - wmax=0. - do k=1,nzm - coef = rho(k)*adz(k)*dz - rdz = 1./coef - if(ny.ne.1) then - do j=1,ny-1*YES3D - jc = j+1*YES3D - do i=1,nx-1 - ic = i+1 - div = (u(ic,j,k)-u(i,j,k))*rdx + (v(i,jc,k)-v(i,j,k))*rdy + & - (w(i,j,k+1)*rhow(k+1)-w(i,j,k)*rhow(k))*rdz - divmax = max(divmax,div) - divmin = min(divmin,div) - if(w(i,j,k).gt.wmax) then - wmax=w(i,j,k) - im=i - jm=j - km=k - endif - end do - end do - else - j = 1 - do i=1,nx-1 - ic = i+1 - div = (u(ic,j,k)-u(i,j,k))*rdx +(w(i,j,k+1)*rhow(k+1)-w(i,j,k)*rhow(k))*rdz - divmax = max(divmax,div) - divmin = min(divmin,div) - if(w(i,j,k).gt.wmax) then - wmax=w(i,j,k) - im=i - jm=j - km=k - endif - end do - endif - end do - - if(dompi) then - buffer(1) = total_water_before - buffer(2) = total_water_after - buffer(3) = total_water_evap - buffer(4) = total_water_prec - buffer(5) = total_water_ls -#ifdef CLUBB_CRM - buffer(6) = total_water_clubb - - buffer_e(1) = total_energy_before - buffer_e(2) = total_energy_after - buffer_e(3) = total_energy_evap - buffer_e(4) = total_energy_prec - buffer_e(5) = total_energy_ls - buffer_e(6) = total_energy_clubb - buffer_e(7) = total_energy_rad -#endif - call task_sum_real8(buffer, buffer1,6) - total_water_before = buffer1(1) - total_water_after = buffer1(2) - total_water_evap = buffer1(3) - total_water_prec = buffer1(4) - total_water_ls = buffer1(5) -#ifdef CLUBB_CRM - total_water_clubb = buffer1(6) - - call task_sum_real8(buffer_e, buffer1_e,7) - total_energy_before = buffer1_e(1) - total_energy_after = buffer1_e(2) - total_energy_evap = buffer1_e(3) - total_energy_prec = buffer1_e(4) - total_energy_ls = buffer1_e(5) - total_energy_clubb = buffer1_e(6) - total_energy_rad = buffer1_e(7) -#endif - end if - -!print*,rank,minval(u(1:nx,1:ny,:)),maxval(u(1:nx,1:ny,:)) -!print*,rank,'min:',minloc(u(1:nx,1:ny,:)) -!print*,rank,'max:',maxloc(u(1:nx,1:ny,:)) - -!if(masterproc) then - -!print*,'--->',tk(27,1,1) -!print*,'tk->:' -!write(6,'(16f7.2)')((tk(i,1,k),i=1,16),k=nzm,1,-1) -!print*,'p->:' -!write(6,'(16f7.2)')((p(i,1,k),i=1,16),k=nzm,1,-1) -!print*,'u->:' -!write(6,'(16f7.2)')((u(i,1,k),i=1,16),k=nzm,1,-1) -!print*,'v->:' -!write(6,'(16f7.2)')((v(i,1,k),i=1,16),k=nzm,1,-1) -!print*,'w->:' -!write(6,'(16f7.2)')((w(i,1,k),i=1,16),k=nzm,1,-1) -!print*,'qcl:' -!write(6,'(16f7.2)')((qcl(i,13,k)*1000.,i=1,16),k=30,1,-1) -!print*,'qpl:' -!write(6,'(16f7.2)')((qpl(i,13,k)*1000.,i=1,16),k=30,1,-1) -!print*,'qrad:' -!write(6,'(16f7.2)')((qrad(i,13,k)*3600.,i=1,16),k=30,1,-1) -!print*,'qv:' -!write(6,'(16f7.2)')((qv(i,13,k)*1000.,i=1,16),k=30,1,-1) -!print*,'tabs:' -!write(6,'(16f7.2)')((tabs(i,13,k),i=1,16),k=30,1,-1) -! -!end if - -!-------------------------------------------------------- - if(masterproc) then - - print*,'DAY = ',day - write(6,*) 'NSTEP=',nstep - write(6,*) 'div:',divmax,divmin - if(.not.dodynamicocean) write(6,*) 'SST=',tabs_s - write(6,*) 'surface pressure=',pres0 - - endif - - call fminmax_print('u:',u,dimx1_u,dimx2_u,dimy1_u,dimy2_u,nzm) - call fminmax_print('v:',v,dimx1_v,dimx2_v,dimy1_v,dimy2_v,nzm-5) - call fminmax_print('w:',w,dimx1_w,dimx2_w,dimy1_w,dimy2_w,nz) - call fminmax_print('p:',p,0,nx,1-YES3D,ny,nzm) - call fminmax_print('t:',t,dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm) - call fminmax_print('tabs:',tabs,1,nx,1,ny,nzm) - call fminmax_print('qv:',qv,1,nx,1,ny,nzm) - if(dosgs) call sgs_print() -#ifdef CLUBB_CRM - if(docloud.or.doclubb) then -#else - if(docloud) then -#endif /*CLUBB_CRM*/ - call fminmax_print('qcl:',qcl,1,nx,1,ny,nzm) - call fminmax_print('qci:',qci,1,nx,1,ny,nzm) - call micro_print() - end if - if(doprecip) then - call fminmax_print('qpl:',qpl,1,nx,1,ny,nzm) - call fminmax_print('qpi:',qpi,1,nx,1,ny,nzm) - end if -! if(dolongwave.or.doshortwave) call fminmax_print('qrad(K/day):',qrad*86400.,1,nx,1,ny,nzm) - if(dotracers) then - do k=1,ntracers - call fminmax_print(trim(tracername(k))//':',tracer(:,:,:,k),dimx1_s,dimx2_s,dimy1_s,dimy2_s,nzm) - end do - end if - call fminmax_print('shf:',fluxbt*cp*rhow(1),1,nx,1,ny,1) - call fminmax_print('lhf:',fluxbq*lcond*rhow(1),1,nx,1,ny,1) - call fminmax_print('uw:',fluxbu,1,nx,1,ny,1) - call fminmax_print('vw:',fluxbv,1,nx,1,ny,1) - call fminmax_print('sst:',sstxy,0,nx,1-YES3D,ny,1) - -end if ! (mod(nstep,nprint).eq.0) - -!call t_stopf ('print_out') - -end diff --git a/src/physics/spcam/crm/crmx_task_init.F90 b/src/physics/spcam/crm/crmx_task_init.F90 deleted file mode 100644 index 0280dba2f4..0000000000 --- a/src/physics/spcam/crm/crmx_task_init.F90 +++ /dev/null @@ -1,69 +0,0 @@ -subroutine task_init - -! Check things, initialize multitasking: - -use crmx_grid -implicit none - -integer itasks,ntasks - -if(YES3D .ne. 1 .and. YES3D .ne. 0) then - print*,'YES3D is not 1 or 0. STOP' - stop -endif - -if(YES3D .eq. 1 .and. ny_gl .lt. 4) then - print*,'ny_gl is too small for a 3D case.STOP' - stop -endif - -if(YES3D .eq. 0 .and. ny_gl .ne. 1) then - print*,'ny_gl should be 1 for a 2D case. STOP' - stop -endif - -if(nsubdomains.eq.1) then - - rank =0 - ntasks = 1 - dompi = .false. - -else - -! call task_start(rank, ntasks) - -! dompi = .true. - -! call systemf('hostname') - -! if(ntasks.ne.nsubdomains) then -! if(masterproc) print *,'number of processors is not equal to nsubdomains!',& -! ' ntasks=',ntasks,' nsubdomains=',nsubdomains -! call task_abort() -! endif - -! call task_barrier() - -! call task_ranks() - -end if ! nsubdomains.eq.1 - -#ifndef CRM -do itasks=0,nsubdomains-1 - call task_barrier() - if(itasks.eq.rank) then - open(8,file='./CaseName',status='old',form='formatted') - read(8,'(a)') case - close (8) - endif -end do -#endif /*CRM*/ - -masterproc = rank.eq.0 - -#ifndef CRM -if(masterproc) print *,'number of MPI tasks:',ntasks -#endif /*CRM*/ - - -end diff --git a/src/physics/spcam/crm/crmx_task_util_NOMPI.F90 b/src/physics/spcam/crm/crmx_task_util_NOMPI.F90 deleted file mode 100644 index b2c9b4e8c9..0000000000 --- a/src/physics/spcam/crm/crmx_task_util_NOMPI.F90 +++ /dev/null @@ -1,230 +0,0 @@ - - subroutine task_start(rank,numtasks) - integer rank,numtasks - print*, 'MPI call from a single task program! Exiting...' - stop - end - -!---------------------------------------------------------------------- - - subroutine task_abort() - print*,'Aborting the program...' - stop - end -!---------------------------------------------------------------------- - - subroutine task_finish() - print*,'program is finished...' - stop - end - -!---------------------------------------------------------------------- - subroutine task_barrier() - return - end - -!---------------------------------------------------------------------- - - subroutine task_bcast_float(rank_from,buffer,length) - implicit none - integer rank_from ! broadcasting task's rank - real buffer(*) ! buffer of data - integer length ! buffers' length - print*, 'MPIsndf call from a single task program! Exiting...' - stop - end - -!---------------------------------------------------------------------- - - subroutine task_send_float(rank_to,buffer,length,tag,request) - implicit none - integer rank_to ! receiving task's rank - real buffer(*) ! buffer of data - integer length ! buffers' length - integer tag ! tag of the message - integer request ! request id - print*, 'MPIsndf call from a single task program! Exiting...' - stop - end - -!---------------------------------------------------------------------- - - subroutine task_send_integer(rank_to,buffer,length,tag,request) - implicit none - integer rank_to ! receiving task's rank - integer buffer(*) ! buffer of data - integer length ! buffers' length - integer tag ! tag of the message - integer request - print*, 'MPIsndi call from a single task program! Exiting...' - stop - end - -!---------------------------------------------------------------------- - - subroutine task_send_character(rank_to,buffer,length,tag,request) - implicit none - integer rank_to ! receiving task's rank - character*1 buffer(*) ! buffer of data - integer length ! buffers' length - integer tag ! tag of the message - integer request - print*, 'MPIsndi call from a single task program! Exiting...' - stop - end - -!---------------------------------------------------------------------- - - subroutine task_receive_float(buffer,length,request) - real buffer(*) ! buffer of data - integer length ! buffers' length - integer request - print*, 'MPIrcvf call from a single task program! Exiting...' - stop - end - -!---------------------------------------------------------------------- - - subroutine task_receive_charcater(buffer,length,request) - character*1 buffer(*) ! buffer of data - integer length ! buffers' length - integer request - print*, 'MPIrcvi call from a single task program! Exiting...' - stop - end - -!---------------------------------------------------------------------- - - subroutine task_receive_integer(buffer,length,request) - integer buffer(*) ! buffer of data - integer length ! buffers' length - integer request - print*, 'MPIrcvi call from a single task program! Exiting...' - stop - end -!---------------------------------------------------------------------- - - subroutine task_bsend_float(rank_to,buffer,length,tag) - integer rank_to ! receiving task's rank - real buffer(*) ! buffer of data - integer length ! buffers' length - integer tag ! tag of the message - print*, 'MPI call from a single task program! Exiting...' - stop - return - end - -!---------------------------------------------------------------------- - subroutine task_wait(request,rank,tag) - integer request - integer rank, tag - return - end - -!---------------------------------------------------------------------- - - subroutine task_waitall(count,reqs,ranks,tags) - integer count,reqs(count) - integer ranks(count),tags(count) - return - end - -!---------------------------------------------------------------------- - subroutine task_test(request,flag,rank,tag) - integer request - integer rank, tag - logical flag - print*, 'MPItst call from a single task program! Exiting...' - stop - end - -!---------------------------------------------------------------------- - - subroutine task_sum_real(buffer1,buffer2,length) - real buffer1(*) ! buffer of data - real buffer2(*) ! buffer of data - integer length ! buffers' length - print*, 'MPI call from a single task program! Exiting...' - stop - end - -!---------------------------------------------------------------------- - - subroutine task_sum_real8(buffer1,buffer2,length) - real buffer1(*) ! buffer of data - real buffer2(*) ! buffer of data - integer length ! buffers' length - print*, 'MPI call from a single task program! Exiting...' - stop - end -!---------------------------------------------------------------------- - - subroutine task_sum_integer(buffer1,buffer2,length) - real buffer1(*) ! buffer of data - real buffer2(*) ! buffer of data - integer length ! buffers' length - print*, 'MPI call from a single task program! Exiting...' - stop - end -!---------------------------------------------------------------------- - - subroutine task_max_real(buffer1,buffer2,length) - real buffer1(*) ! buffer of data - real buffer2(*) ! buffer of data - integer length ! buffers' length - return - print*, 'MPI call from a single task program! Exiting...' - stop - end -!---------------------------------------------------------------------- - - subroutine task_max_integer(buffer1,buffer2,length) - real buffer1(*) ! buffer of data - real buffer2(*) ! buffer of data - integer length ! buffers' length - print*, 'MPI call from a single task program! Exiting...' - stop - end -!---------------------------------------------------------------------- - - subroutine task_min_real(buffer1,buffer2,length) - real buffer1(*) ! buffer of data - real buffer2(*) ! buffer of data - integer length ! buffers' length - print*, 'MPI call from a single task program! Exiting...' - stop - end -!---------------------------------------------------------------------- - - subroutine task_min_integer(buffer1,buffer2,length) - real buffer1(*) ! buffer of data - real buffer2(*) ! buffer of data - integer length ! buffers' length - print*, 'MPI call from a single task program! Exiting...' - stop - end -!---------------------------------------------------------------------- - - subroutine task_receive_character(buffer,length,request) - character*1 buffer(*) ! buffer of data - integer length ! buffers' length - integer request - print*, 'MPI call from a single task program! Exiting...' - stop - end -!---------------------------------------------------------------------- - subroutine task_rank_to_index (rank,i,j) - integer rank, i, j - i=0 - j=0 - end -!---------------------------------------------------------------------- - subroutine task_bound_duvdt () - return - end -!---------------------------------------------------------------------- - subroutine task_boundaries(flag) - integer flag - end - - diff --git a/src/physics/spcam/crm/crmx_utils.F90 b/src/physics/spcam/crm/crmx_utils.F90 deleted file mode 100644 index 1a9acaecb0..0000000000 --- a/src/physics/spcam/crm/crmx_utils.F90 +++ /dev/null @@ -1,145 +0,0 @@ -integer function lenstr (string) - -! returns string's length ignoring the rightmost blank and null characters - -implicit none -character *(*) string -integer k -lenstr = 0 -do k = 1,len(string) - if (string(k:k).ne.' '.and.string(k:k).ne.char(0)) then - lenstr = lenstr+1 - end if -end do -111 return -end - - - -subroutine averageXY(f,dimx1,dimx2,dimy1,dimy2,dimz,fm) - -use crmx_grid -implicit none -integer dimx1, dimx2, dimy1, dimy2, dimz -real f(dimx1:dimx2, dimy1:dimy2, dimz),fm(nzm) -real(kind=selected_real_kind(12)) ff,factor -integer i,j,k -factor = 1./dble(nx*ny) -do k =1,nzm - ff = 0. - do j =1,ny - do i =1,nx - ff = ff + f(i,j,k) - end do - end do - ff = ff*factor - fm(k) = real(ff) -end do -end - - -subroutine averageXY_MPI(f,dimx1,dimx2,dimy1,dimy2,dimz,fm) - -use crmx_grid -implicit none -integer dimx1, dimx2, dimy1, dimy2, dimz -real f(dimx1:dimx2, dimy1:dimy2, dimz),fm(nzm) -real(kind=selected_real_kind(12)) fm1(nzm),fm2(nzm),factor -integer i,j,k -factor = 1./dble(nx*ny) -do k =1,nzm - fm1(k) = 0. - do j =1,ny - do i =1,nx - fm1(k) = fm1(k) + f(i,j,k) - end do - end do - fm1(k) = fm1(k) * factor -end do -if(dompi) then - do k =1,nzm - fm2(k) = fm1(k) - end do - call task_sum_real8(fm2,fm1,nzm) - do k=1,nzm - fm(k)=real(fm1(k)/dble(nsubdomains)) - end do -else - do k=1,nzm - fm(k)=real(fm1(k)) - end do -endif -end - - - - -subroutine fminmax_print(name,f,dimx1,dimx2,dimy1,dimy2,dimz) - -use crmx_grid -implicit none -integer dimx1, dimx2, dimy1, dimy2, dimz -real f(dimx1:dimx2, dimy1:dimy2, dimz),fmn(nz),fmx(nz) -character *(*) name -real fmin(1),fmax(1),fff(1) -integer i,j,k - -do k=1,dimz - if(dimx2.eq.1.and.dimy2.eq.1) then - fmn(k) = f(1,1,k) - fmx(k) = f(1,1,k) - else - fmn(k) = 1.e30 - fmx(k) =-1.e30 - do j=1,ny - do i=1,nx - fmn(k) = min(fmn(k),f(i,j,k)) - fmx(k) = max(fmx(k),f(i,j,k)) - end do - enddo - end if -enddo -fmin(1) = 1.e30 -fmax(1) =-1.e30 -do k=1,dimz - fmin(1) = min(fmin(1),fmn(k)) - fmax(1) = max(fmax(1),fmx(k)) -end do - -if(dompi) then - fff(1)=fmax(1) - call task_max_real(fff(1),fmax(1),1) - fff(1)=fmin(1) - call task_min_real(fff(1),fmin(1),1) -end if -if(masterproc) print *,name,fmin,fmax -end - - - - -subroutine setvalue(f,n,f0) -implicit none -integer n -real f(n), f0 -integer k -do k=1,n - f(k)=f0 -end do -end - -! determine number of byte in a record in direct access files (can be anything, from 1 to 8): -! can't assume 1 as it is compiler and computer dependent -integer function bytes_in_rec() -implicit none -character*8 str -integer n, err -open(1,status ='scratch',access ='direct',recl=1) -do n = 1,8 - write(1,rec=1,iostat=err) str(1:n) - if (err.ne.0) exit - bytes_in_rec = n -enddo -close(1,status='delete') -end - diff --git a/src/physics/spcam/crm/crmx_uvw.F90 b/src/physics/spcam/crm/crmx_uvw.F90 deleted file mode 100644 index 2edaa17e70..0000000000 --- a/src/physics/spcam/crm/crmx_uvw.F90 +++ /dev/null @@ -1,13 +0,0 @@ -subroutine uvw - -! update the velocity field - -use crmx_vars -use crmx_params -implicit none - -u(1:nx,1:ny,1:nzm) = dudt(1:nx,1:ny,1:nzm,nc) -v(1:nx,1:ny,1:nzm) = dvdt(1:nx,1:ny,1:nzm,nc) -w(1:nx,1:ny,1:nzm) = dwdt(1:nx,1:ny,1:nzm,nc) - -end subroutine uvw diff --git a/src/physics/spcam/crm/crmx_vars.F90 b/src/physics/spcam/crm/crmx_vars.F90 deleted file mode 100644 index f85feeb1e3..0000000000 --- a/src/physics/spcam/crm/crmx_vars.F90 +++ /dev/null @@ -1,259 +0,0 @@ -module crmx_vars - -use crmx_grid -#ifdef CRM -#ifdef MODAL_AERO -use modal_aero_data, only: ntot_amode -#endif -#endif - -implicit none -!-------------------------------------------------------------------- -! prognostic variables: - -real u (dimx1_u:dimx2_u, dimy1_u:dimy2_u, nzm) ! x-wind -real v (dimx1_v:dimx2_v, dimy1_v:dimy2_v, nzm) ! y-wind -real w (dimx1_w:dimx2_w, dimy1_w:dimy2_w, nz ) ! z-wind -real t (dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! liquid/ice water static energy - -!-------------------------------------------------------------------- -! diagnostic variables: - -real p (0:nx, (1-YES3D):ny, nzm) ! perturbation pressure (from Poison eq) -real tabs (nx, ny, nzm) ! temperature -real qv (nx, ny, nzm) ! water vapor -real qcl (nx, ny, nzm) ! liquid water (condensate) -real qpl (nx, ny, nzm) ! liquid water (precipitation) -real qci (nx, ny, nzm) ! ice water (condensate) -real qpi (nx, ny, nzm) ! ice water (precipitation) - -real tke2(dimx1_s:dimx2_s, dimy1_s:dimy2_s, nzm) ! SGS TKE -real tk2 (0:nxp1, (1-YES3D):nyp1, nzm) ! SGS eddyviscosity - -!-------------------------------------------------------------------- -! time-tendencies for prognostic variables - -real dudt (nxp1, ny, nzm, 3) -real dvdt (nx, nyp1, nzm, 3) -real dwdt (nx, ny, nz, 3) - -!---------------------------------------------------------------- -! Temporary storage array: - - real misc(nx, ny, nz) -!------------------------------------------------------------------ -! fluxes at the top and bottom of the domain: - -real fluxbu (nx, ny), fluxbv (nx, ny), fluxbt (nx, ny) -real fluxbq (nx, ny), fluxtu (nx, ny), fluxtv (nx, ny) -real fluxtt (nx, ny), fluxtq (nx, ny), fzero (nx, ny) -real precsfc(nx,ny) ! surface precip. rate -real precssfc(nx,ny) ! surface ice precip. rate - -!----------------------------------------------------------------- -! profiles - -real t0(nzm), q0(nzm), qv0(nzm), tabs0(nzm), tl0(nzm), & - tv0(nzm), u0(nzm), v0(nzm), & - tg0(nzm), qg0(nzm), ug0(nzm), vg0(nzm), p0(nzm), & - tke0(nzm), t01(nzm), q01(nzm), qp0(nzm), qn0(nzm) -!---------------------------------------------------------------- -! "observed" (read from snd file) surface characteristics - -real sstobs, lhobs, shobs -!---------------------------------------------------------------- -! Domain top stuff: - -real gamt0 ! gradient of t() at the top,K/m -real gamq0 ! gradient of q() at the top,g/g/m - -!----------------------------------------------------------------- -! reference vertical profiles: - -real prespot(nzm) ! (1000./pres)**R/cp -real rho(nzm) ! air density at pressure levels,kg/m3 -real rhow(nz) ! air density at vertical velocity levels,kg/m3 -real bet(nzm) ! = ggr/tv0 -real gamaz(nzm) ! ggr/cp*z -real wsub(nz) ! Large-scale subsidence velocity,m/s -real qtend(nzm) ! Large-scale tendency for total water -real ttend(nzm) ! Large-scale tendency for temp. -real utend(nzm) ! Large-scale tendency for u -real vtend(nzm) ! Large-scale tendency for v - - -!--------------------------------------------------------------------- -! Large-scale and surface forcing: - -integer nlsf ! number of large-scale forcing profiles -integer nrfc ! number of radiative forcing profiles -integer nsfc ! number of surface forcing profiles -integer nsnd ! number of observed soundings -integer nzlsf ! number of large-scale forcing profiles -integer nzrfc ! number of radiative forcing profiles -integer nzsnd ! number of observed soundings - -real, allocatable :: dqls(:,:) ! Large-scale tendency for total water -real, allocatable :: dtls(:,:) ! Large-scale tendency for temp. -real, allocatable :: ugls(:,:) ! Large-scale wind in X-direction -real, allocatable :: vgls(:,:) ! Large-scale wind in Y-direction -real, allocatable :: wgls(:,:) ! Large-scale subsidence velocity,m/s -real, allocatable :: pres0ls(:)! Surface pressure, mb -real, allocatable :: zls(:,:) ! Height -real, allocatable :: pls(:,:) ! Pressure -real, allocatable :: dayls(:) ! Large-scale forcing arrays time (days) -real, allocatable :: dtrfc(:,:)! Radiative tendency for pot. temp. -real, allocatable :: dayrfc(:) ! Radiative forcing arrays time (days) -real, allocatable :: prfc(:,:) ! Pressure/Height -real, allocatable :: sstsfc(:) ! SSTs -real, allocatable :: shsfc(:) ! Sensible heat flux,W/m2 -real, allocatable :: lhsfc(:) ! Latent heat flux,W/m2 -real, allocatable :: tausfc(:) ! Surface drag,m2/s2 -real, allocatable :: daysfc(:) ! Surface forcing arrays time (days) -real, allocatable :: usnd(:,:) ! Observed zonal wind -real, allocatable :: vsnd(:,:) ! Observed meriod wind -real, allocatable :: tsnd(:,:) ! Observed Abs. temperature -real, allocatable :: qsnd(:,:) ! Observed Moisture -real, allocatable :: zsnd(:,:) ! Height -real, allocatable :: psnd(:,:) ! Pressure -real, allocatable :: daysnd(:) ! number of sounding samples - -!--------------------------------------------------------------------- -! Horizontally varying stuff (as a function of xy) -! -real sstxy(0:nx,(1-YES3D):ny) ! surface temperature xy-distribution -real fcory(0:ny) ! Coriolis parameter xy-distribution -real fcorzy(ny) ! z-Coriolis parameter xy-distribution -real latitude(nx,ny) ! latitude (degrees) -real longitude(nx,ny) ! longitude(degrees) -real prec_xy(nx,ny) ! mean precip. rate for outout -real shf_xy(nx,ny) ! mean precip. rate for outout -real lhf_xy(nx,ny) ! mean precip. rate for outout -real lwns_xy(nx,ny) ! mean net lw at SFC -real swns_xy(nx,ny) ! mean net sw at SFC -real lwnsc_xy(nx,ny) ! clear-sky mean net lw at SFC -real swnsc_xy(nx,ny) ! clear-sky mean net sw at SFC -real lwnt_xy(nx,ny) ! mean net lw at TOA -real swnt_xy(nx,ny) ! mean net sw at TOA -real lwntc_xy(nx,ny) ! clear-sky mean net lw at TOA -real swntc_xy(nx,ny) ! clear-sky mean net sw at TOA -real solin_xy(nx,ny) ! solar TOA insolation -real pw_xy(nx,ny) ! precipitable water -real cw_xy(nx,ny) ! cloud water path -real iw_xy(nx,ny) ! ice water path -real cld_xy(nx,ny) ! cloud frequency -real u200_xy(nx,ny) ! u-wind at 200 mb -real usfc_xy(nx,ny) ! u-wind at at the surface -real v200_xy(nx,ny) ! v-wind at 200 mb -real vsfc_xy(nx,ny) ! v-wind at the surface -real w500_xy(nx,ny) ! w at 500 mb -real qocean_xy(nx,ny) ! ocean cooling in W/m2 - -!---------------------------------------------------------------------- -! Vertical profiles of quantities sampled for statitistics purposes: - -real & - twle(nz), twsb(nz), precflux(nz), & - uwle(nz), uwsb(nz), vwle(nz), vwsb(nz), & - radlwup(nz), radlwdn(nz), radswup(nz), radswdn(nz), & - radqrlw(nz), radqrsw(nz), w_max, u_max, s_acld, s_acldcold, s_ar, s_arthr, s_sst, & - s_acldl, s_acldm, s_acldh, ncmn, nrmn, z_inv, z_cb, z_ct, z_cbmn, z_ctmn, & - z2_inv, z2_cb, z2_ct, cwpmean, cwp2, precmean, prec2, precmax, nrainy, ncloudy, & - s_acldisccp, s_acldlisccp, s_acldmisccp, s_acldhisccp, s_ptopisccp, & - s_acldmodis, s_acldlmodis, s_acldmmodis, s_acldhmodis, s_ptopmodis, & - s_acldmisr, s_ztopmisr, s_relmodis, s_reimodis, s_lwpmodis, s_iwpmodis, & - s_tbisccp, s_tbclrisccp, s_acldliqmodis, s_acldicemodis, & - s_cldtauisccp,s_cldtaumodis,s_cldtaulmodis,s_cldtauimodis,s_cldalbisccp, & - s_flns,s_flnt,s_flntoa,s_flnsc,s_flntoac,s_flds,s_fsns, & - s_fsnt,s_fsntoa,s_fsnsc,s_fsntoac,s_fsds,s_solin, & - tkeleadv(nz), tkelepress(nz), tkelediss(nz), tkelediff(nz),tkelebuoy(nz), & - t2leadv(nz),t2legrad(nz),t2lediff(nz),t2leprec(nz),t2lediss(nz), & - q2leadv(nz),q2legrad(nz),q2lediff(nz),q2leprec(nz),q2lediss(nz), & - twleadv(nz),twlediff(nz),twlepres(nz),twlebuoy(nz),twleprec(nz), & - qwleadv(nz),qwlediff(nz),qwlepres(nz),qwlebuoy(nz),qwleprec(nz), & - momleadv(nz,3),momlepress(nz,3),momlebuoy(nz,3), & - momlediff(nz,3),tadv(nz),tdiff(nz),tlat(nz), tlatqi(nz),qifall(nz),qpfall(nz) -real tdiff_xy(nz), tdiff_z(nz), ttest0(nzm), ttest1(nz), ttest2(nz, 10) !+++mhwang test - - -! register functions: - - -real, external :: esatw_crm,esati_crm,dtesatw_crm,dtesati_crm -real, external :: qsatw_crm,qsati_crm,dtqsatw_crm,dtqsati_crm -integer, external :: lenstr, bytes_in_rec - -! energy conservation diagnostics: - - real(kind=selected_real_kind(12)) total_water_before, total_water_after - real(kind=selected_real_kind(12)) total_water_evap, total_water_prec, total_water_ls -!#ifdef CLUBB_CRM - real(kind=selected_real_kind(12)) total_water_clubb - real(kind=selected_real_kind(12)) total_energy_before, total_energy_after - real(kind=selected_real_kind(12)) total_energy_evap, total_energy_prec, total_energy_ls - real(kind=selected_real_kind(12)) total_energy_clubb, total_energy_rad -!#endif - real(kind=selected_real_kind(12)) qtotmicro(5) ! total water for water conservation test in microphysics +++mhwang - -!=========================================================================== -! UW ADDITIONS - -! conditional average statistics, subsumes cloud_factor, core_factor, coredn_factor -integer :: ncondavg, icondavg_cld, icondavg_cor, icondavg_cordn, & - icondavg_satdn, icondavg_satup, icondavg_env -real, allocatable :: condavg_factor(:,:) ! replaces cloud_factor, core_factor -real, allocatable :: condavg_mask(:,:,:,:) ! indicator array for various conditional averages -character(LEN=8), allocatable :: condavgname(:) ! array of short names -character(LEN=25), allocatable :: condavglongname(:) ! array of long names - -real qlsvadv(nzm) ! Large-scale vertical advection tendency for total water -real tlsvadv(nzm) ! Large-scale vertical advection tendency for temperature -real ulsvadv(nzm) ! Large-scale vertical advection tendency for zonal velocity -real vlsvadv(nzm) ! Large-scale vertical advection tendency for meridional velocity - -real qnudge(nzm) ! Nudging of horiz.-averaged total water profile -real tnudge(nzm) ! Nudging of horiz.-averaged temperature profile -real unudge(nzm) ! Nudging of horiz.-averaged zonal velocity -real vnudge(nzm) ! Nudging of horiz.-averaged meridional velocity - -real qstor(nzm) ! Storage of horiz.-averaged total water profile -real tstor(nzm) ! Storage of horiz.-averaged temperature profile -real ustor(nzm) ! Storage of horiz.-averaged zonal velocity -real vstor(nzm) ! Storage of horiz.-averaged meridional velocity -real qtostor(nzm) ! Storage of horiz.-averaged total water profile (vapor + liquid) - -real utendcor(nzm) ! coriolis acceleration of zonal velocity -real vtendcor(nzm) ! coriolis acceleration of meridional velocity - -real CF3D(1:nx, 1:ny, 1:nzm) ! Cloud fraction - ! =1.0 when there is no fractional cloudiness scheme - ! = cloud fraction produced by fractioal cloudiness scheme when avaiable - -! 850 mbar horizontal winds -real u850_xy(nx,ny) ! zonal velocity at 850 mb -real v850_xy(nx,ny) ! meridional velocity at 850 mb - -! Surface pressure -real psfc_xy(nx,ny) ! pressure (in millibar) at lowest grid point - -! Saturated water vapor path, useful for computing column relative humidity -real swvp_xy(nx,ny) ! saturated water vapor path (wrt water) - -! Cloud and echo top heights, and cloud top temperature (instantaneous) -real cloudtopheight(nx,ny), echotopheight(nx,ny), cloudtoptemp(nx,ny) - -! END UW ADDITIONS -!=========================================================================== -! Initial bubble parameters. Activated when perturb_type = 2 - real bubble_x0 - real bubble_y0 - real bubble_z0 - real bubble_radius_hor - real bubble_radius_ver - real bubble_dtemp - real bubble_dq - real, allocatable :: naer(:,:) ! Aerosol number concentration [/m3] - real, allocatable :: vaer(:,:) ! aerosol volume concentration [m3/m3] - real, allocatable :: hgaer(:,:) ! hygroscopicity of aerosol mode - -end module crmx_vars diff --git a/src/physics/spcam/crm/crmx_zero.F90 b/src/physics/spcam/crm/crmx_zero.F90 deleted file mode 100644 index a3510da024..0000000000 --- a/src/physics/spcam/crm/crmx_zero.F90 +++ /dev/null @@ -1,16 +0,0 @@ - -subroutine zero - -use crmx_vars -use crmx_microphysics, only : total_water - -implicit none - -integer k - -dudt(:,:,:,na) = 0. -dvdt(:,:,:,na) = 0. -dwdt(:,:,:,na) = 0. -misc(:,:,:) = 0. - -end diff --git a/src/physics/spcam/crm/fft.F b/src/physics/spcam/crm/fft.F deleted file mode 100644 index 2d02fbd981..0000000000 --- a/src/physics/spcam/crm/fft.F +++ /dev/null @@ -1,787 +0,0 @@ - subroutine fft991_crm(a,work,trigs,ifax,inc,jump,n,lot,isign) - dimension a(*),work(*),trigs(*),ifax(*) -c -c subroutine "fft991" - multiple real/half-complex periodic -c fast fourier transform -c -c same as fft99 except that ordering of data corresponds to -c that in mrfft2 -c -c procedure used to convert to half-length complex transform -c is given by cooley, lewis and welch (j. sound vib., vol. 12 -c (1970), 315-337) -c -c a is the array containing input and output data -c work is an area of size (n+1)*lot -c trigs is a previously prepared list of trig function values -c ifax is a previously prepared list of factors of n/2 -c inc is the increment within each data 'vector' -c (e.g. inc=1 for consecutively stored data) -c jump is the increment between the start of each data vector -c n is the length of the data vectors -c lot is the number of data vectors -c isign = +1 for transform from spectral to gridpoint -c = -1 for transform from gridpoint to spectral -c -c ordering of coefficients: -c a(0),b(0),a(1),b(1),a(2),b(2),...,a(n/2),b(n/2) -c where b(0)=b(n/2)=0; (n+2) locations required -c -c ordering of data: -c x(0),x(1),x(2),...,x(n-1) -c -c vectorization is achieved on cray by doing the transforms in -c parallel -c -c *** n.b. n is assumed to be an even number -c -c definition of transforms: -c ------------------------- -c -c isign=+1: x(j)=sum(k=0,...,n-1)(c(k)*exp(2*i*j*k*pi/n)) -c where c(k)=a(k)+i*b(k) and c(n-k)=a(k)-i*b(k) -c -c isign=-1: a(k)=(1/n)*sum(j=0,...,n-1)(x(j)*cos(2*j*k*pi/n)) -c b(k)=-(1/n)*sum(j=0,...,n-1)(x(j)*sin(2*j*k*pi/n)) -c -c -c - nfax=ifax(1) - nx=n+1 - nh=n/2 - ink=inc+inc - if (isign.eq.+1) go to 30 -c -c if necessary, transfer data to work area - igo=50 - if (mod(nfax,2).eq.1) goto 40 - ibase=1 - jbase=1 - do 20 l=1,lot - i=ibase - j=jbase -cdir$ ivdep - do 10 m=1,n - work(j)=a(i) - i=i+inc - j=j+1 - 10 continue - ibase=ibase+jump - jbase=jbase+nx - 20 continue -c - igo=60 - go to 40 -c -c preprocessing (isign=+1) -c ------------------------ -c - 30 continue - call fft99a_crm(a,work,trigs,inc,jump,n,lot) - igo=60 -c -c complex transform -c ----------------- -c - 40 continue - ia=1 - la=1 - do 80 k=1,nfax - if (igo.eq.60) go to 60 - 50 continue - call vpassm_crm(a(ia),a(ia+inc),work(1),work(2),trigs, - * ink,2,jump,nx,lot,nh,ifax(k+1),la) - igo=60 - go to 70 - 60 continue - call vpassm_crm(work(1),work(2),a(ia),a(ia+inc),trigs, - * 2,ink,nx,jump,lot,nh,ifax(k+1),la) - igo=50 - 70 continue - la=la*ifax(k+1) - 80 continue -c - if (isign.eq.-1) go to 130 -c -c if necessary, transfer data from work area - if (mod(nfax,2).eq.1) go to 110 - ibase=1 - jbase=1 - do 100 l=1,lot - i=ibase - j=jbase -cdir$ ivdep - do 90 m=1,n - a(j)=work(i) - i=i+1 - j=j+inc - 90 continue - ibase=ibase+nx - jbase=jbase+jump - 100 continue -c -c fill in zeros at end - 110 continue - ib=n*inc+1 -cdir$ ivdep - do 120 l=1,lot - a(ib)=0.0 - a(ib+inc)=0.0 - ib=ib+jump - 120 continue - go to 140 -c -c postprocessing (isign=-1): -c -------------------------- -c - 130 continue - call fft99b_crm(work,a,trigs,inc,jump,n,lot) -c - 140 continue - return - end - - - - - - subroutine fftfax_crm(n,ifax,trigs) - dimension ifax(13),trigs(*) -c -c mode 3 is used for real/half-complex transforms. it is possible -c to do complex/complex transforms with other values of mode, but -c documentation of the details were not available when this routine -c was written. -c - data mode /3/ - call fax_crm (ifax, n, mode) - i = ifax(1) -cgsp if (ifax(i+1) .gt. 5 .or. n .le. 4) ifax(1) = -99 -cgsp if (ifax(1) .le. 0 )call uliber(33,'fftfax -- invalid n', 20) - call fftrig_crm (trigs, n, mode) - return - end - - - - - - subroutine fax_crm(ifax,n,mode) - dimension ifax(*) - nn=n - if (iabs(mode).eq.1) go to 10 - if (iabs(mode).eq.8) go to 10 - nn=n/2 - if ((nn+nn).eq.n) go to 10 - ifax(1)=-99 - return - 10 k=1 -c test for factors of 4 - 20 if (mod(nn,4).ne.0) go to 30 - k=k+1 - ifax(k)=4 - nn=nn/4 - if (nn.eq.1) go to 80 - go to 20 -c test for extra factor of 2 - 30 if (mod(nn,2).ne.0) go to 40 - k=k+1 - ifax(k)=2 - nn=nn/2 - if (nn.eq.1) go to 80 -c test for factors of 3 - 40 if (mod(nn,3).ne.0) go to 50 - k=k+1 - ifax(k)=3 - nn=nn/3 - if (nn.eq.1) go to 80 - go to 40 -c now find remaining factors - 50 l=5 - inc=2 -c inc alternately takes on values 2 and 4 - 60 if (mod(nn,l).ne.0) go to 70 - k=k+1 - ifax(k)=l - nn=nn/l - if (nn.eq.1) go to 80 - go to 60 - 70 l=l+inc - inc=6-inc - go to 60 - 80 ifax(1)=k-1 -c ifax(1) contains number of factors - nfax=ifax(1) -c sort factors into ascending order - if (nfax.eq.1) go to 110 - do 100 ii=2,nfax - istop=nfax+2-ii - do 90 i=2,istop - if (ifax(i+1).ge.ifax(i)) go to 90 - item=ifax(i) - ifax(i)=ifax(i+1) - ifax(i+1)=item - 90 continue - 100 continue - 110 continue - return - end - - - - - - subroutine fftrig_crm(trigs,n,mode) - dimension trigs(*) - pi=2.0*asin(1.0) - imode=iabs(mode) - nn=n - if (imode.gt.1.and.imode.lt.6) nn=n/2 - del=(pi+pi)/float(nn) - l=nn+nn - do 10 i=1,l,2 - angle=0.5*float(i-1)*del - trigs(i)=cos(angle) - trigs(i+1)=sin(angle) - 10 continue - if (imode.eq.1) return - if (imode.eq.8) return - del=0.5*del - nh=(nn+1)/2 - l=nh+nh - la=nn+nn - do 20 i=1,l,2 - angle=0.5*float(i-1)*del - trigs(la+i)=cos(angle) - trigs(la+i+1)=sin(angle) - 20 continue - if (imode.le.3) return - del=0.5*del - la=la+nn - if (mode.eq.5) go to 40 - do 30 i=2,nn - angle=float(i-1)*del - trigs(la+i)=2.0*sin(angle) - 30 continue - return - 40 continue - del=0.5*del - do 50 i=2,n - angle=float(i-1)*del - trigs(la+i)=sin(angle) - 50 continue - return - end - - - - - - - - - - - subroutine fft99a_crm(a,work,trigs,inc,jump,n,lot) - dimension a(*),work(*),trigs(*) -c -c subroutine fft99a - preprocessing step for fft99, isign=+1 -c (spectral to gridpoint transform) -c - nh=n/2 - nx=n+1 - ink=inc+inc -c -c a(0) and a(n/2) - ia=1 - ib=n*inc+1 - ja=1 - jb=2 -cdir$ ivdep - do 10 l=1,lot - work(ja)=a(ia)+a(ib) - work(jb)=a(ia)-a(ib) - ia=ia+jump - ib=ib+jump - ja=ja+nx - jb=jb+nx - 10 continue -c -c remaining wavenumbers - iabase=2*inc+1 - ibbase=(n-2)*inc+1 - jabase=3 - jbbase=n-1 -c - do 30 k=3,nh,2 - ia=iabase - ib=ibbase - ja=jabase - jb=jbbase - c=trigs(n+k) - s=trigs(n+k+1) -cdir$ ivdep - do 20 l=1,lot - work(ja)=(a(ia)+a(ib))- - * (s*(a(ia)-a(ib))+c*(a(ia+inc)+a(ib+inc))) - work(jb)=(a(ia)+a(ib))+ - * (s*(a(ia)-a(ib))+c*(a(ia+inc)+a(ib+inc))) - work(ja+1)=(c*(a(ia)-a(ib))-s*(a(ia+inc)+a(ib+inc)))+ - * (a(ia+inc)-a(ib+inc)) - work(jb+1)=(c*(a(ia)-a(ib))-s*(a(ia+inc)+a(ib+inc)))- - * (a(ia+inc)-a(ib+inc)) - ia=ia+jump - ib=ib+jump - ja=ja+nx - jb=jb+nx - 20 continue - iabase=iabase+ink - ibbase=ibbase-ink - jabase=jabase+2 - jbbase=jbbase-2 - 30 continue -c - if (iabase.ne.ibbase) go to 50 -c wavenumber n/4 (if it exists) - ia=iabase - ja=jabase -cdir$ ivdep - do 40 l=1,lot - work(ja)=2.0*a(ia) - work(ja+1)=-2.0*a(ia+inc) - ia=ia+jump - ja=ja+nx - 40 continue -c - 50 continue - return - end - - - - - - subroutine fft99b_crm(work,a,trigs,inc,jump,n,lot) - dimension work(*),a(*),trigs(*) -c -c subroutine fft99b - postprocessing step for fft99, isign=-1 -c (gridpoint to spectral transform) -c - nh=n/2 - nx=n+1 - ink=inc+inc -c -c a(0) and a(n/2) - scale=1.0/float(n) - ia=1 - ib=2 - ja=1 - jb=n*inc+1 -cdir$ ivdep - do 10 l=1,lot - a(ja)=scale*(work(ia)+work(ib)) - a(jb)=scale*(work(ia)-work(ib)) - a(ja+inc)=0.0 - a(jb+inc)=0.0 - ia=ia+nx - ib=ib+nx - ja=ja+jump - jb=jb+jump - 10 continue -c -c remaining wavenumbers - scale=0.5*scale - iabase=3 - ibbase=n-1 - jabase=2*inc+1 - jbbase=(n-2)*inc+1 -c - do 30 k=3,nh,2 - ia=iabase - ib=ibbase - ja=jabase - jb=jbbase - c=trigs(n+k) - s=trigs(n+k+1) -cdir$ ivdep - do 20 l=1,lot - a(ja)=scale*((work(ia)+work(ib)) - * +(c*(work(ia+1)+work(ib+1))+s*(work(ia)-work(ib)))) - a(jb)=scale*((work(ia)+work(ib)) - * -(c*(work(ia+1)+work(ib+1))+s*(work(ia)-work(ib)))) - a(ja+inc)=scale*((c*(work(ia)-work(ib))-s*(work(ia+1)+work(ib+1))) - * +(work(ib+1)-work(ia+1))) - a(jb+inc)=scale*((c*(work(ia)-work(ib))-s*(work(ia+1)+work(ib+1))) - * -(work(ib+1)-work(ia+1))) - ia=ia+nx - ib=ib+nx - ja=ja+jump - jb=jb+jump - 20 continue - iabase=iabase+2 - ibbase=ibbase-2 - jabase=jabase+ink - jbbase=jbbase-ink - 30 continue -c - if (iabase.ne.ibbase) go to 50 -c wavenumber n/4 (if it exists) - ia=iabase - ja=jabase - scale=2.0*scale -cdir$ ivdep - do 40 l=1,lot - a(ja)=scale*work(ia) - a(ja+inc)=-scale*work(ia+1) - ia=ia+nx - ja=ja+jump - 40 continue -c - 50 continue - return - end - - - - subroutine vpassm_crm - & (a,b,c,d,trigs,inc1,inc2,inc3,inc4,lot,n,ifac,la) - dimension a(*),b(*),c(*),d(*),trigs(*) -c -c subroutine "vpassm" - multiple version of "vpassa" -c performs one pass through data -c as part of multiple complex fft routine -c a is first real input vector -c b is first imaginary input vector -c c is first real output vector -c d is first imaginary output vector -c trigs is precalculated table of sines " cosines -c inc1 is addressing increment for a and b -c inc2 is addressing increment for c and d -c inc3 is addressing increment between a"s & b"s -c inc4 is addressing increment between c"s & d"s -c lot is the number of vectors -c n is length of vectors -c ifac is current factor of n -c la is product of previous factors -c - data sin36/0.587785252292473/,cos36/0.809016994374947/, - * sin72/0.951056516295154/,cos72/0.309016994374947/, - * sin60/0.866025403784437/ -c - m=n/ifac - iink=m*inc1 - jink=la*inc2 - jump=(ifac-1)*jink - ibase=0 - jbase=0 - igo=ifac-1 - if (igo.gt.4) return - go to (10,50,90,130),igo -c -c coding for factor 2 -c - 10 ia=1 - ja=1 - ib=ia+iink - jb=ja+jink - do 20 l=1,la - i=ibase - j=jbase -cdir$ ivdep - do 15 ijk=1,lot - c(ja+j)=a(ia+i)+a(ib+i) - d(ja+j)=b(ia+i)+b(ib+i) - c(jb+j)=a(ia+i)-a(ib+i) - d(jb+j)=b(ia+i)-b(ib+i) - i=i+inc3 - j=j+inc4 - 15 continue - ibase=ibase+inc1 - jbase=jbase+inc2 - 20 continue - if (la.eq.m) return - la1=la+1 - jbase=jbase+jump - do 40 k=la1,m,la - kb=k+k-2 - c1=trigs(kb+1) - s1=trigs(kb+2) - do 30 l=1,la - i=ibase - j=jbase -cdir$ ivdep - do 25 ijk=1,lot - c(ja+j)=a(ia+i)+a(ib+i) - d(ja+j)=b(ia+i)+b(ib+i) - c(jb+j)=c1*(a(ia+i)-a(ib+i))-s1*(b(ia+i)-b(ib+i)) - d(jb+j)=s1*(a(ia+i)-a(ib+i))+c1*(b(ia+i)-b(ib+i)) - i=i+inc3 - j=j+inc4 - 25 continue - ibase=ibase+inc1 - jbase=jbase+inc2 - 30 continue - jbase=jbase+jump - 40 continue - return -c -c coding for factor 3 -c - 50 ia=1 - ja=1 - ib=ia+iink - jb=ja+jink - ic=ib+iink - jc=jb+jink - do 60 l=1,la - i=ibase - j=jbase -cdir$ ivdep - do 55 ijk=1,lot - c(ja+j)=a(ia+i)+(a(ib+i)+a(ic+i)) - d(ja+j)=b(ia+i)+(b(ib+i)+b(ic+i)) - c(jb+j)=(a(ia+i)-0.5*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)-b(ic+i))) - c(jc+j)=(a(ia+i)-0.5*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)-b(ic+i))) - d(jb+j)=(b(ia+i)-0.5*(b(ib+i)+b(ic+i)))+(sin60*(a(ib+i)-a(ic+i))) - d(jc+j)=(b(ia+i)-0.5*(b(ib+i)+b(ic+i)))-(sin60*(a(ib+i)-a(ic+i))) - i=i+inc3 - j=j+inc4 - 55 continue - ibase=ibase+inc1 - jbase=jbase+inc2 - 60 continue - if (la.eq.m) return - la1=la+1 - jbase=jbase+jump - do 80 k=la1,m,la - kb=k+k-2 - kc=kb+kb - c1=trigs(kb+1) - s1=trigs(kb+2) - c2=trigs(kc+1) - s2=trigs(kc+2) - do 70 l=1,la - i=ibase - j=jbase -cdir$ ivdep - do 65 ijk=1,lot - c(ja+j)=a(ia+i)+(a(ib+i)+a(ic+i)) - d(ja+j)=b(ia+i)+(b(ib+i)+b(ic+i)) - c(jb+j)= - * c1*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)-b(ic+i)))) - * -s1*((b(ia+i)-0.5*(b(ib+i)+b(ic+i)))+(sin60*(a(ib+i)-a(ic+i)))) - d(jb+j)= - * s1*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)-b(ic+i)))) - * +c1*((b(ia+i)-0.5*(b(ib+i)+b(ic+i)))+(sin60*(a(ib+i)-a(ic+i)))) - c(jc+j)= - * c2*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)-b(ic+i)))) - * -s2*((b(ia+i)-0.5*(b(ib+i)+b(ic+i)))-(sin60*(a(ib+i)-a(ic+i)))) - d(jc+j)= - * s2*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)-b(ic+i)))) - * +c2*((b(ia+i)-0.5*(b(ib+i)+b(ic+i)))-(sin60*(a(ib+i)-a(ic+i)))) - i=i+inc3 - j=j+inc4 - 65 continue - ibase=ibase+inc1 - jbase=jbase+inc2 - 70 continue - jbase=jbase+jump - 80 continue - return -c -c coding for factor 4 -c - 90 ia=1 - ja=1 - ib=ia+iink - jb=ja+jink - ic=ib+iink - jc=jb+jink - id=ic+iink - jd=jc+jink - do 100 l=1,la - i=ibase - j=jbase -cdir$ ivdep - do 95 ijk=1,lot - c(ja+j)=(a(ia+i)+a(ic+i))+(a(ib+i)+a(id+i)) - c(jc+j)=(a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i)) - d(ja+j)=(b(ia+i)+b(ic+i))+(b(ib+i)+b(id+i)) - d(jc+j)=(b(ia+i)+b(ic+i))-(b(ib+i)+b(id+i)) - c(jb+j)=(a(ia+i)-a(ic+i))-(b(ib+i)-b(id+i)) - c(jd+j)=(a(ia+i)-a(ic+i))+(b(ib+i)-b(id+i)) - d(jb+j)=(b(ia+i)-b(ic+i))+(a(ib+i)-a(id+i)) - d(jd+j)=(b(ia+i)-b(ic+i))-(a(ib+i)-a(id+i)) - i=i+inc3 - j=j+inc4 - 95 continue - ibase=ibase+inc1 - jbase=jbase+inc2 - 100 continue - if (la.eq.m) return - la1=la+1 - jbase=jbase+jump - do 120 k=la1,m,la - kb=k+k-2 - kc=kb+kb - kd=kc+kb - c1=trigs(kb+1) - s1=trigs(kb+2) - c2=trigs(kc+1) - s2=trigs(kc+2) - c3=trigs(kd+1) - s3=trigs(kd+2) - do 110 l=1,la - i=ibase - j=jbase -cdir$ ivdep - do 105 ijk=1,lot - c(ja+j)=(a(ia+i)+a(ic+i))+(a(ib+i)+a(id+i)) - d(ja+j)=(b(ia+i)+b(ic+i))+(b(ib+i)+b(id+i)) - c(jc+j)= - * c2*((a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i))) - * -s2*((b(ia+i)+b(ic+i))-(b(ib+i)+b(id+i))) - d(jc+j)= - * s2*((a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i))) - * +c2*((b(ia+i)+b(ic+i))-(b(ib+i)+b(id+i))) - c(jb+j)= - * c1*((a(ia+i)-a(ic+i))-(b(ib+i)-b(id+i))) - * -s1*((b(ia+i)-b(ic+i))+(a(ib+i)-a(id+i))) - d(jb+j)= - * s1*((a(ia+i)-a(ic+i))-(b(ib+i)-b(id+i))) - * +c1*((b(ia+i)-b(ic+i))+(a(ib+i)-a(id+i))) - c(jd+j)= - * c3*((a(ia+i)-a(ic+i))+(b(ib+i)-b(id+i))) - * -s3*((b(ia+i)-b(ic+i))-(a(ib+i)-a(id+i))) - d(jd+j)= - * s3*((a(ia+i)-a(ic+i))+(b(ib+i)-b(id+i))) - * +c3*((b(ia+i)-b(ic+i))-(a(ib+i)-a(id+i))) - i=i+inc3 - j=j+inc4 - 105 continue - ibase=ibase+inc1 - jbase=jbase+inc2 - 110 continue - jbase=jbase+jump - 120 continue - return -c -c coding for factor 5 -c - 130 ia=1 - ja=1 - ib=ia+iink - jb=ja+jink - ic=ib+iink - jc=jb+jink - id=ic+iink - jd=jc+jink - ie=id+iink - je=jd+jink - do 140 l=1,la - i=ibase - j=jbase -cdir$ ivdep - do 135 ijk=1,lot - c(ja+j)=a(ia+i)+(a(ib+i)+a(ie+i))+(a(ic+i)+a(id+i)) - d(ja+j)=b(ia+i)+(b(ib+i)+b(ie+i))+(b(ic+i)+b(id+i)) - c(jb+j)=(a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i))) - * -(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i))) - c(je+j)=(a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i))) - * +(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i))) - d(jb+j)=(b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i))) - * +(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i))) - d(je+j)=(b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i))) - * -(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i))) - c(jc+j)=(a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i))) - * -(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i))) - c(jd+j)=(a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i))) - * +(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i))) - d(jc+j)=(b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i))) - * +(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i))) - d(jd+j)=(b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i))) - * -(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i))) - i=i+inc3 - j=j+inc4 - 135 continue - ibase=ibase+inc1 - jbase=jbase+inc2 - 140 continue - if (la.eq.m) return - la1=la+1 - jbase=jbase+jump - do 160 k=la1,m,la - kb=k+k-2 - kc=kb+kb - kd=kc+kb - ke=kd+kb - c1=trigs(kb+1) - s1=trigs(kb+2) - c2=trigs(kc+1) - s2=trigs(kc+2) - c3=trigs(kd+1) - s3=trigs(kd+2) - c4=trigs(ke+1) - s4=trigs(ke+2) - do 150 l=1,la - i=ibase - j=jbase -cdir$ ivdep - do 145 ijk=1,lot - c(ja+j)=a(ia+i)+(a(ib+i)+a(ie+i))+(a(ic+i)+a(id+i)) - d(ja+j)=b(ia+i)+(b(ib+i)+b(ie+i))+(b(ic+i)+b(id+i)) - c(jb+j)= - * c1*((a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i))) - * -(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i)))) - * -s1*((b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i))) - * +(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i)))) - d(jb+j)= - * s1*((a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i))) - * -(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i)))) - * +c1*((b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i))) - * +(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i)))) - c(je+j)= - * c4*((a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i))) - * +(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i)))) - * -s4*((b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i))) - * -(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i)))) - d(je+j)= - * s4*((a(ia+i)+cos72*(a(ib+i)+a(ie+i))-cos36*(a(ic+i)+a(id+i))) - * +(sin72*(b(ib+i)-b(ie+i))+sin36*(b(ic+i)-b(id+i)))) - * +c4*((b(ia+i)+cos72*(b(ib+i)+b(ie+i))-cos36*(b(ic+i)+b(id+i))) - * -(sin72*(a(ib+i)-a(ie+i))+sin36*(a(ic+i)-a(id+i)))) - c(jc+j)= - * c2*((a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i))) - * -(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i)))) - * -s2*((b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i))) - * +(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i)))) - d(jc+j)= - * s2*((a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i))) - * -(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i)))) - * +c2*((b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i))) - * +(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i)))) - c(jd+j)= - * c3*((a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i))) - * +(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i)))) - * -s3*((b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i))) - * -(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i)))) - d(jd+j)= - * s3*((a(ia+i)-cos36*(a(ib+i)+a(ie+i))+cos72*(a(ic+i)+a(id+i))) - * +(sin36*(b(ib+i)-b(ie+i))-sin72*(b(ic+i)-b(id+i)))) - * +c3*((b(ia+i)-cos36*(b(ib+i)+b(ie+i))+cos72*(b(ic+i)+b(id+i))) - * -(sin36*(a(ib+i)-a(ie+i))-sin72*(a(ic+i)-a(id+i)))) - i=i+inc3 - j=j+inc4 - 145 continue - ibase=ibase+inc1 - jbase=jbase+inc2 - 150 continue - jbase=jbase+jump - 160 continue - return - end - - - - - diff --git a/src/physics/spcam/crm/gammafff.c b/src/physics/spcam/crm/gammafff.c deleted file mode 100644 index 67f30643c4..0000000000 --- a/src/physics/spcam/crm/gammafff.c +++ /dev/null @@ -1,18 +0,0 @@ -/* - gamma-function for Fortran - (C) Marat Khairoutdinov */ - -#include -#include - -#ifdef __cplusplus -extern "C" { -#endif - -float gammafff(float *x) {return (float)exp(lgamma(*x));} - -float gammafff_(float *x) {return (float)exp(lgamma(*x));} - -#ifdef __cplusplus -} -#endif diff --git a/src/physics/spcam/crm_physics.F90 b/src/physics/spcam/crm_physics.F90 deleted file mode 100644 index 728bdd6382..0000000000 --- a/src/physics/spcam/crm_physics.F90 +++ /dev/null @@ -1,2480 +0,0 @@ -module crm_physics -!----------------------------------------------------------------------- -! Purpose: -! -! Provides the CAM interface to the crm code. -! -! Revision history: -! June, 2009, Minghuai Wang: -! crm_physics_tend -! July, 2009, Minghuai Wang: m2005_effradius -! -!--------------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, pver, pverp -#ifdef CRM - use cam_abortutils, only: endrun - use physics_types, only: physics_state, physics_tend - use constituents, only: cnst_add, cnst_get_ind, cnst_set_spec_class, cnst_spec_class_cldphysics, & - cnst_spec_class_gas, cnst_name, cnst_longname, sflxnam, apcnst, bpcnst, pcnst -#ifdef m2005 - use module_ecpp_ppdriver2, only: papampollu_init - use crmx_ecppvars, only: NCLASS_CL,ncls_ecpp_in,NCLASS_PR -#endif - - implicit none - private - save - - character(len=2) :: spcam_direction='NS' ! SPCAM 2D orientation - - public :: crm_physics_tend, crm_physics_register, crm_physics_init - public :: crm_implements_cnst, crm_init_cnst - public :: m2005_effradius - - integer :: crm_u_idx, crm_v_idx, crm_w_idx, crm_t_idx - integer :: crm_qt_idx, crm_nc_idx, crm_qr_idx, crm_nr_idx, crm_qi_idx, crm_ni_idx - integer :: crm_qs_idx, crm_ns_idx, crm_qg_idx, crm_ng_idx, crm_qc_idx, crm_qp_idx, crm_qn_idx - integer :: crm_t_rad_idx, crm_qv_rad_idx, crm_qc_rad_idx, crm_qi_rad_idx, crm_cld_rad_idx - integer :: crm_nc_rad_idx, crm_ni_rad_idx, crm_qs_rad_idx, crm_ns_rad_idx, crm_qrad_idx - integer :: crm_qaerwat_idx, crm_dgnumwet_idx - integer :: prec_dp_idx, snow_dp_idx, prec_sh_idx, snow_sh_idx - integer :: prec_sed_idx, snow_sed_idx, prec_pcw_idx, snow_pcw_idx - integer :: cldo_idx, cld_idx, cldtop_idx - integer :: rei_idx, rel_idx, rprdtot_idx, nevapr_idx, prain_idx - integer :: wsedl_idx, dei_idx, des_idx, mu_idx, lambdac_idx - integer :: rate1_cw2pr_st_idx - integer :: qme_idx, icwmrdp_idx, rprddp_idx, icwmrsh_idx, rprdsh_idx - integer :: nevapr_shcu_idx, nevapr_dpcu_idx, ast_idx - integer :: fice_idx,acldy_cen_idx, cmfmc_sh_idx - integer :: clubb_buffer_idx, tk_crm_idx, tke_idx, kvm_idx, kvh_idx, pblh_idx, tpert_idx - integer :: sh_frac_idx, dp_frac_idx - - integer :: & - ixcldliq, &! cloud liquid amount index - ixcldice, &! cloud ice amount index - ixnumliq, &! cloud liquid number index - ixnumice ! cloud ice water index - - integer :: nmodes - - integer, parameter :: ncnst = 4 ! Number of constituents - integer :: ncnst_use - character(len=8), parameter :: & ! Constituent names - cnst_names(ncnst) = (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE'/) - - logical :: use_spcam, prog_modal_aero, do_clubb_sgs - logical :: is_spcam_m2005, is_spcam_sam1mom - - integer :: crm_nx_ny - -#endif - -!======================================================================================================== -contains -!======================================================================================================== - -!--------------------------------------------------------------------------------------------------------- -subroutine crm_physics_register() -#ifdef CRM -!------------------------------------------------------------------------------------------------------- -! -! Purpose: add necessary fileds into physics buffer -! -!-------------------------------------------------------------------------------------------------------- - use spmd_utils, only: masterproc - use physconst, only: mwdry, cpair - use physics_buffer, only: dyn_time_lvls, pbuf_add_field, dtype_r8 - use phys_control, only: phys_getopts, cam_physpkg_is - use crmdims, only: crm_nx, crm_ny, crm_nz, crm_dx, crm_dy, crm_dt, nclubbvars - use cam_history_support,only: add_hist_coord - use crmx_setparm_mod, only: setparm - use rad_constituents, only: rad_cnst_get_info - - is_spcam_m2005 = cam_physpkg_is('spcam_m2005') - is_spcam_sam1mom = cam_physpkg_is('spcam_sam1mom') - - call phys_getopts( use_spcam_out = use_spcam) - call phys_getopts( prog_modal_aero_out = prog_modal_aero) - call phys_getopts( do_clubb_sgs_out = do_clubb_sgs) - - call rad_cnst_get_info(0, nmodes=nmodes) - - ! Register microphysics constituents and save indices. - - ncnst_use = 2 - call cnst_add(cnst_names(1), mwdry, cpair, 0._r8, ixcldliq, & - longname='Grid box averaged cloud liquid amount', is_convtran1=.true.) - call cnst_add(cnst_names(2), mwdry, cpair, 0._r8, ixcldice, & - longname='Grid box averaged cloud ice amount', is_convtran1=.true.) - if (is_spcam_m2005) then - call cnst_add(cnst_names(3), mwdry, cpair, 0._r8, ixnumliq, & - longname='Grid box averaged cloud liquid number', is_convtran1=.false.) - call cnst_add(cnst_names(4), mwdry, cpair, 0._r8, ixnumice, & - longname='Grid box averaged cloud ice number', is_convtran1=.false.) - ncnst_use = 4 - end if - - if(masterproc) then - print*,'_________________________________________' - print*,'_ Super-parameterization run ____________' - print*,'crm_nx=',crm_nx,' crm_ny=',crm_ny,' crm_nz=',crm_nz - print*,'crm_dx=',crm_dx,' crm_dy=',crm_dy,' crm_dt=',crm_dt - if (is_spcam_sam1mom) print*,'Microphysics: SAM1MOM' - if (is_spcam_m2005) print*,'Microphysics: M2005' - print*,'_________________________________________' - end if - - if (do_clubb_sgs) then - call pbuf_add_field('CLUBB_BUFFER','global', dtype_r8, (/pcols,crm_nx,crm_ny,crm_nz+1,nclubbvars/), clubb_buffer_idx) - call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx) - call pbuf_add_field('kvm', 'global', dtype_r8, (/pcols, pverp/), kvm_idx) - call pbuf_add_field('kvh', 'global', dtype_r8, (/pcols, pverp/), kvh_idx) - call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols, pverp/), pblh_idx) - call pbuf_add_field('tpert', 'global', dtype_r8, (/pcols, pverp/), tpert_idx) - end if - - call setparm() - - call pbuf_add_field('CRM_U', 'global', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_u_idx) - call pbuf_add_field('CRM_V', 'global', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_v_idx) - call pbuf_add_field('CRM_W', 'global', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_w_idx) - call pbuf_add_field('CRM_T', 'global', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_t_idx) - call pbuf_add_field('CLDO', 'global', dtype_r8, (/pcols, pver, dyn_time_lvls/), cldo_idx) - call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols, pver, dyn_time_lvls/), cld_idx) - call pbuf_add_field('AST', 'global', dtype_r8, (/pcols, pver, dyn_time_lvls/), ast_idx) - - call pbuf_add_field('CRM_T_RAD', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_t_rad_idx) - call pbuf_add_field('CRM_QV_RAD', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_qv_rad_idx) - call pbuf_add_field('CRM_QC_RAD', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_qc_rad_idx) - call pbuf_add_field('CRM_QI_RAD', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_qi_rad_idx) - call pbuf_add_field('CRM_CLD_RAD', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_cld_rad_idx) - call pbuf_add_field('CRM_QRAD', 'global', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz/), crm_qrad_idx) - - call pbuf_add_field('PREC_DP', 'physpkg', dtype_r8, (/pcols/), prec_dp_idx) - call pbuf_add_field('SNOW_DP', 'physpkg', dtype_r8, (/pcols/), snow_dp_idx) - call pbuf_add_field('PREC_SH', 'physpkg', dtype_r8, (/pcols/), prec_sh_idx) - call pbuf_add_field('SNOW_SH', 'physpkg', dtype_r8, (/pcols/), snow_sh_idx) - call pbuf_add_field('PREC_SED', 'physpkg', dtype_r8, (/pcols/), prec_sed_idx) - call pbuf_add_field('SNOW_SED', 'physpkg', dtype_r8, (/pcols/), snow_sed_idx) - call pbuf_add_field('PREC_PCW', 'physpkg', dtype_r8, (/pcols/), prec_pcw_idx) - call pbuf_add_field('SNOW_PCW', 'physpkg', dtype_r8, (/pcols/), snow_pcw_idx) - call pbuf_add_field('CLDTOP', 'physpkg', dtype_r8, (/pcols,1/), cldtop_idx ) - call pbuf_add_field('RPRDTOT', 'physpkg' ,dtype_r8, (/pcols,pver/), rprdtot_idx ) - call pbuf_add_field('ICWMRSH', 'physpkg' ,dtype_r8, (/pcols,pver/), icwmrsh_idx ) - call pbuf_add_field('RPRDSH', 'physpkg' ,dtype_r8, (/pcols,pver/), rprdsh_idx ) - call pbuf_add_field('NEVAPR_SHCU', 'physpkg' ,dtype_r8, (/pcols,pver/), nevapr_shcu_idx ) - call pbuf_add_field('ICWMRDP', 'physpkg', dtype_r8, (/pcols,pver/), icwmrdp_idx) - call pbuf_add_field('RPRDDP', 'physpkg', dtype_r8, (/pcols,pver/), rprddp_idx) - call pbuf_add_field('NEVAPR_DPCU', 'physpkg', dtype_r8, (/pcols,pver/), nevapr_dpcu_idx) - call pbuf_add_field('REI', 'physpkg', dtype_r8, (/pcols,pver/), rei_idx) - call pbuf_add_field('REL', 'physpkg', dtype_r8, (/pcols,pver/), rel_idx) - call pbuf_add_field('NEVAPR', 'physpkg', dtype_r8, (/pcols,pver/), nevapr_idx) - call pbuf_add_field('PRAIN', 'physpkg', dtype_r8, (/pcols,pver/), prain_idx) - call pbuf_add_field('WSEDL', 'physpkg', dtype_r8, (/pcols,pver/), wsedl_idx) - call pbuf_add_field('QME', 'physpkg', dtype_r8, (/pcols,pver/), qme_idx) - call pbuf_add_field('DEI', 'physpkg', dtype_r8, (/pcols,pver/), dei_idx) - call pbuf_add_field('DES', 'physpkg', dtype_r8, (/pcols,pver/), des_idx) - call pbuf_add_field('MU', 'physpkg', dtype_r8, (/pcols,pver/), mu_idx) - call pbuf_add_field('LAMBDAC', 'physpkg', dtype_r8, (/pcols,pver/), lambdac_idx) - call pbuf_add_field('CMFMC_SH', 'physpkg' ,dtype_r8, (/pcols,pverp/), cmfmc_sh_idx ) - - call pbuf_add_field('FICE', 'physpkg', dtype_r8, (/pcols,pver/), fice_idx) - - if (prog_modal_aero) then - call pbuf_add_field('RATE1_CW2PR_ST','physpkg', dtype_r8, (/pcols,pver/), rate1_cw2pr_st_idx) - call pbuf_add_field('CRM_QAERWAT', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz, nmodes/), crm_qaerwat_idx) - call pbuf_add_field('CRM_DGNUMWET', 'physpkg', dtype_r8, (/pcols,crm_nx, crm_ny, crm_nz, nmodes/), crm_dgnumwet_idx) - endif - - if (is_spcam_m2005) then - call pbuf_add_field('CRM_NC_RAD', 'physpkg', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_nc_rad_idx) - call pbuf_add_field('CRM_NI_RAD', 'physpkg', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_ni_rad_idx) - call pbuf_add_field('CRM_QS_RAD', 'physpkg', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qs_rad_idx) - call pbuf_add_field('CRM_NS_RAD', 'physpkg', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_ns_rad_idx) - - ! Fields for crm_micro array - call pbuf_add_field('CRM_QT', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qt_idx) - call pbuf_add_field('CRM_NC', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_nc_idx) - call pbuf_add_field('CRM_QR', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qr_idx) - call pbuf_add_field('CRM_NR', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_nr_idx) - call pbuf_add_field('CRM_QI', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qi_idx) - call pbuf_add_field('CRM_NI', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_ni_idx) - call pbuf_add_field('CRM_QS', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qs_idx) - call pbuf_add_field('CRM_NS', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_ns_idx) - call pbuf_add_field('CRM_QG', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qg_idx) - call pbuf_add_field('CRM_NG', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_ng_idx) - call pbuf_add_field('CRM_QC', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qc_idx) - else - call pbuf_add_field('CRM_QT', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qt_idx) - call pbuf_add_field('CRM_QP', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qp_idx) - call pbuf_add_field('CRM_QN', 'global', dtype_r8, (/pcols, crm_nx, crm_ny, crm_nz/), crm_qn_idx) - endif - - - if (is_spcam_m2005) then - call pbuf_add_field('TK_CRM', 'global', dtype_r8, (/pcols, pver/), tk_crm_idx) - ! total (all sub-classes) cloudy fractional area in previous time step - call pbuf_add_field('ACLDY_CEN', 'global', dtype_r8, (/pcols,pver/), acldy_cen_idx) - endif - -! Adding crm dimensions to cam history - call add_hist_coord('crm_nx' ,crm_nx, 'CRM NX') - call add_hist_coord('crm_ny' ,crm_ny, 'CRM NY') - call add_hist_coord('crm_nz' ,crm_nz, 'CRM NZ') - call add_hist_coord('crm_z1' ,crm_nz+1,'CRM_Z1') - - call add_hist_coord('pverp' ,pverp, 'pverp ') - call add_hist_coord('pver' ,pver, 'pver ') - -! ifdef needed because of NCLASS_CL -#ifdef m2005 - call add_hist_coord('NCLASS_CL' ,NCLASS_CL,'NCLASS_CL') - call add_hist_coord('ncls_ecpp_in' ,ncls_ecpp_in,'ncls_ecpp_in') - call add_hist_coord('NCLASS_PR' ,NCLASS_PR,'NCLASS_PR') -#endif - -#endif - -end subroutine crm_physics_register -!========================================================================================================= - -subroutine crm_physics_init(pbuf2d) -!------------------------------------------------------------------------------------------------------- -! -! Purpose: initialize some variables, and add necessary fileds into output fields -! -!-------------------------------------------------------------------------------------------------------- - use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_index -#ifdef CRM - use physconst, only: tmelt, rair, cpair, rh2o, latvap, latice - use constituents, only: pcnst, cnst_species_class, cnst_spec_class_gas - use cam_history, only: addfld, add_default, horiz_only - use crmdims, only: crm_nx, crm_ny, crm_nz - use ndrop, only: ndrop_init - use gas_wetdep_opts, only: gas_wetdep_method - use micro_mg_utils, only: micro_mg_utils_init - use time_manager, only: is_first_step - - use cam_history, only: fieldname_len -#ifdef MODAL_AERO - use modal_aero_data, only: cnst_name_cw, ntot_amode, & - lmassptr_amode, lmassptrcw_amode, & - nspec_amode, numptr_amode, numptrcw_amode -#endif - -#endif - - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - -#ifdef CRM - integer :: l, lphase, lspec - character(len=fieldname_len+3) :: fieldname - character(128) :: long_name - character(8) :: unit - -! local variables - integer :: i, m, mm - integer :: icldphy ! index for cloud physic species (water vapor and cloud hydrometers) - - character(len=128):: errstring ! return status (non-blank for error return) - - crm_nx_ny = crm_nx*crm_ny - - !------------------------- - ! Make sure gas_wetdep_method is set to 'MOZ' as 'NEU' is not currently supported by SPCAM - ! 'MOZ' for spcam_sam1mom - ! 'OFF' for spcam_m2005 - if (is_spcam_sam1mom) then - if (gas_wetdep_method /= 'MOZ') call endrun( "crm_physics: gas_wetdep_method must be set to 'MOZ' ") - elseif (is_spcam_m2005) then - if (gas_wetdep_method /= 'OFF') call endrun( "crm_physics: gas_wetdep_method must be set to 'OFF' ") - else - call endrun( "crm_physics: don't know how gas_wetdep_method should be set") - endif - - !------------------------- - ! Initialize the micro_mg_utils - ! Value of dcs in MG 1.0 is 400.e-6_r8 - call micro_mg_utils_init(r8, rair, rh2o, cpair, tmelt, latvap, latice, 400.e-6_r8, errstring) - - !------------------------- - ! Register general history fields - do m = 1, ncnst_use - call cnst_get_ind(cnst_names(m), mm) - if ( any(mm == (/ ixcldliq, ixcldice /)) ) then - ! mass mixing ratios - call addfld(cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg ', cnst_longname(mm)) - call addfld(sflxnam(mm), horiz_only, 'A', 'kg/m2/s ', trim(cnst_name(mm))//' surface flux') - else if ( any(mm == (/ ixnumliq, ixnumice /)) ) then - ! number concentrations - call addfld(cnst_name(mm), (/ 'lev' /), 'A', '1/kg ', cnst_longname(mm)) - call addfld(sflxnam(mm), horiz_only, 'A', '1/m2/s ', trim(cnst_name(mm))//' surface flux') - else - call endrun( "crm_physics: Could not call addfld for constituent with unknown units.") - endif - end do - - do m=1, pcnst - if(cnst_name(m) == 'DMS') then - call addfld('DMSCONV', (/ 'lev' /), 'A', 'kg/kg/s', 'DMS tendency from ZM convection') - end if - if(cnst_name(m) == 'SO2') then - call addfld('SO2CONV', (/ 'lev' /), 'A', 'kg/kg/s', 'SO2 tendency from ZM convection') - end if - end do - - call addfld ('CRM_TK', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'm^2/s', 'Eddy viscosity from CRM') - call addfld ('CRM_TKH', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'm^2/s', 'Eddy viscosity from CRM') - - call addfld ('SPCLD3D ', (/ 'lev' /), 'A', 'fraction', 'cloud fraction on GCM grids') - call addfld ('MU_CRM ', (/ 'lev' /), 'A', 'Pa/s', 'mass flux up from CRM') - call addfld ('MD_CRM ', (/ 'lev' /), 'A', 'Pa/s', 'mass flux down from CRM') - call addfld ('DU_CRM ', (/ 'lev' /), 'A', '/s', 'detrainment from updraft from CRM') - call addfld ('EU_CRM ', (/ 'lev' /), 'A', '/s', 'entraiment rate from updraft') - call addfld ('ED_CRM ', (/ 'lev' /), 'A', '/s', 'entraiment rate from downdraft') - call addfld ('SPQRL ', (/ 'lev' /), 'A', 'K/s', 'long-wave heating rate') - call addfld ('SPQRS ', (/ 'lev' /), 'A', 'K/s', 'short-wave heating rate') - call addfld ('LENGC ', (/ 'ilev' /), 'A', 'm ', 'Mixing length scale for the calcuation of vertical difusivity') - - call addfld ('SPKVH ',(/ 'ilev' /), 'A', 'm2/s ', 'Vertical diffusivity used in dropmixnuc in the MMF call') - call addfld ('SPLCLOUD ',(/ 'lev' /), 'A', ' ', 'Liquid cloud fraction') - call add_default ('SPKVH ', 1, ' ') - call add_default ('SPLCLOUD ', 1, ' ') - - call addfld ('SPCLDTOT', horiz_only, 'A', 'fraction', 'Vertically-integrated total cloud from CRM' ) - call addfld ('SPCLDLOW', horiz_only, 'A', 'fraction', 'Vertically-integrated low cloud from CRM' ) - call addfld ('SPCLDMED', horiz_only, 'A', 'fraction', 'Vertically-integrated mid-level cloud from CRM' ) - call addfld ('SPCLDHGH', horiz_only, 'A', 'fraction', 'Vertically-integrated high cloud from CRM' ) - call add_default ('SPCLDTOT', 1, ' ') - call add_default ('SPCLDLOW', 1, ' ') - call add_default ('SPCLDMED', 1, ' ') - call add_default ('SPCLDHGH', 1, ' ') - - call addfld(apcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg ', trim(cnst_name(ixcldliq))//' after physics' ) - call addfld(bpcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg ', trim(cnst_name(ixcldliq))//' before physics' ) - call addfld(apcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg ', trim(cnst_name(ixcldice))//' after physics' ) - call addfld(bpcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg ', trim(cnst_name(ixcldice))//' before physics' ) - - call addfld ('PRES ',(/ 'lev' /), 'A', 'Pa ','Pressure' ) - call addfld ('DPRES ',(/ 'lev' /), 'A', 'Pa ','Pressure thickness of layer' ) - call addfld ('SPDT ',(/ 'lev' /), 'A', 'K/s ','T tendency due to CRM' ) - call addfld ('SPDQ ',(/ 'lev' /), 'A', 'kg/kg/s ','Q tendency due to CRM' ) - call addfld ('SPDQC ',(/ 'lev' /), 'A', 'kg/kg/s ','QC tendency due to CRM' ) - call addfld ('SPDQI ',(/ 'lev' /), 'A', 'kg/kg/s ','QI tendency due to CRM' ) - call addfld ('SPMC ',(/ 'lev' /), 'A', 'kg/m2/s ','Total mass flux from CRM' ) - call addfld ('SPMCUP ',(/ 'lev' /), 'A', 'kg/m2/s ','Updraft mass flux from CRM' ) - call addfld ('SPMCDN ',(/ 'lev' /), 'A', 'kg/m2/s ','Downdraft mass flux from CRM' ) - call addfld ('SPMCUUP ',(/ 'lev' /), 'A', 'kg/m2/s ','Unsaturated updraft mass flux from CRM' ) - call addfld ('SPMCUDN ',(/ 'lev' /), 'A', 'kg/m2/s ','Unsaturated downdraft mass flux from CRM') - call addfld ('SPQC ',(/ 'lev' /), 'A', 'kg/kg ','Cloud water from CRM' ) - call addfld ('SPQI ',(/ 'lev' /), 'A', 'kg/kg ','Cloud ice from CRM' ) - call addfld ('SPQS ',(/ 'lev' /), 'A', 'kg/kg ','Snow from CRM' ) - call addfld ('SPQG ',(/ 'lev' /), 'A', 'kg/kg ','Graupel from CRM' ) - call addfld ('SPQR ',(/ 'lev' /), 'A', 'kg/kg ','Rain from CRM' ) - call addfld ('SPQTFLX ',(/ 'lev' /), 'A', 'kg/m2/s ','Nonprecip. water flux from CRM' ) - call addfld ('SPUFLX ',(/ 'lev' /), 'A', 'm2/s2 ','x-momentum flux from CRM' ) - call addfld ('SPVFLX ',(/ 'lev' /), 'A', 'm2/s2 ','y-momentum flux from CRM' ) - call addfld ('SPQTFLXS',(/ 'lev' /), 'A', 'kg/m2/s ','SGS Nonprecip. water flux from CRM' ) - call addfld ('SPTKE ',(/ 'lev' /), 'A', 'kg/m/s2 ','Total TKE in CRM' ) - call addfld ('SPTKES ',(/ 'lev' /), 'A', 'kg/m/s2 ','SGS TKE in CRM' ) - call addfld ('SPTK ',(/ 'lev' /), 'A', 'm2/s ','SGS TK in CRM' ) - call addfld ('SPQPFLX ',(/ 'lev' /), 'A', 'kg/m2/s ','Precip. water flux from CRM' ) - call addfld ('SPPFLX ',(/ 'lev' /), 'A', 'm/s ','Precipitation flux from CRM' ) - call addfld ('SPQTLS ',(/ 'lev' /), 'A', 'kg/kg/s ','L.S. Vapor Tendency from CRM' ) - call addfld ('SPQTTR ',(/ 'lev' /), 'A', 'kg/kg/s ','Nonprec. water transport from CRM' ) - call addfld ('SPQPTR ',(/ 'lev' /), 'A', 'kg/kg/s ','Prec. water transport from CRM' ) - call addfld ('SPQPEVP ',(/ 'lev' /), 'A', 'kg/kg/s ','Prec. water evaporation from CRM' ) - call addfld ('SPQPFALL',(/ 'lev' /), 'A', 'kg/kg/s ','Prec. water fall-out from CRM' ) - call addfld ('SPQPSRC ',(/ 'lev' /), 'A', 'kg/kg/s ','Prec. water source from CRM' ) - call addfld ('SPTLS ',(/ 'lev' /), 'A', 'kg/kg/s ','L.S. LIWSE Tendency from CRM' ) - call addfld ('TIMINGF ', horiz_only, 'A', ' ','CRM CPU usage efficiency: 1 - ideal' ) - call addfld ('CLOUDTOP',(/ 'lev' /), 'A', ' ','Cloud Top PDF' ) - - !------------------------- - ! Register m2005 history fields - if (is_spcam_m2005) then - call addfld ('SPNC ',(/ 'lev' /), 'A', '/kg ','Cloud water dropet number from CRM') - call addfld ('SPNI ',(/ 'lev' /), 'A', '/kg ','Cloud ice crystal number from CRM') - call addfld ('SPNS ',(/ 'lev' /), 'A', '/kg ','Snow particle number from CRM') - call addfld ('SPNG ',(/ 'lev' /), 'A', '/kg ','Graupel particle number from CRM') - call addfld ('SPNR ',(/ 'lev' /), 'A', '/kg ','Rain particle number from CRM') - call add_default ('SPNC ', 1, ' ') - call add_default ('SPNI ', 1, ' ') - call add_default ('SPNS ', 1, ' ') - call add_default ('SPNG ', 1, ' ') - call add_default ('SPNR ', 1, ' ') - - call addfld ('CRM_FLIQ ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '1 ','Frequency of Occurrence of Liquid' ) - call addfld ('CRM_FICE ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '1 ','Frequency of Occurrence of Ice' ) - call addfld ('CRM_FRAIN',(/'crm_nx','crm_ny','crm_nz'/), 'A', '1 ','Frequency of Occurrence of Rain' ) - call addfld ('CRM_FSNOW',(/'crm_nx','crm_ny','crm_nz'/), 'A', '1 ','Frequency of Occurrence of Snow' ) - call addfld ('CRM_FGRAP',(/'crm_nx','crm_ny','crm_nz'/), 'A', '1 ','Frequency of Occurrence of Graupel' ) - call addfld ('CRM_QS ',(/'crm_nx','crm_ny','crm_nz'/), 'A', 'kg/kg ','Snow mixing ratio from CRM' ) - call addfld ('CRM_QG ',(/'crm_nx','crm_ny','crm_nz'/), 'A', 'kg/kg ','Graupel mixing ratio from CRM' ) - call addfld ('CRM_QR ',(/'crm_nx','crm_ny','crm_nz'/), 'A', 'kg/kg ','Rain mixing ratio from CRM' ) - - call addfld ('CRM_NC ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/kg ','Cloud water dropet number from CRM' ) - call addfld ('CRM_NI ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/kg ','Cloud ice crystal number from CRM' ) - call addfld ('CRM_NS ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/kg ','Snow particle number from CRM' ) - call addfld ('CRM_NG ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/kg ','Graupel particle number from CRM' ) - call addfld ('CRM_NR ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/kg ','Rain particle number from CRM' ) - - ! below is for *instantaneous* crm output - call addfld ('CRM_AUT ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Autoconversion cloud waterfrom CRM' ) - call addfld ('CRM_ACC ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Accretion cloud water from CRM' ) - call addfld ('CRM_EVPC ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Evaporation cloud water from CRM' ) - call addfld ('CRM_EVPR ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Evaporation rain from CRM' ) - call addfld ('CRM_MLT ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Melting ice snow graupel from CRM' ) - call addfld ('CRM_SUB ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Sublimation ice snow graupel from CRM' ) - call addfld ('CRM_DEP ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Deposition ice snow graupel from CRM' ) - call addfld ('CRM_CON ',(/'crm_nx','crm_ny','crm_nz'/), 'A', '/s ','Condensation cloud water from CRM' ) - - ! below is for *gcm-grid and time-step-avg* process output - call addfld ('A_AUT ',(/ 'lev' /), 'A', '/s ','Avg autoconversion cloud water from CRM' ) - call addfld ('A_ACC ',(/ 'lev' /), 'A', '/s ','Avg accretion cloud water from CRM' ) - call addfld ('A_EVPC ',(/ 'lev' /), 'A', '/s ','Avg evaporation cloud water from CRM' ) - call addfld ('A_EVPR ',(/ 'lev' /), 'A', '/s ','Avg evaporation rain from CRM' ) - call addfld ('A_MLT ',(/ 'lev' /), 'A', '/s ','Avg melting ice snow graupel from CRM' ) - call addfld ('A_SUB ',(/ 'lev' /), 'A', '/s ','Avg sublimation ice snow graupel from CRM' ) - call addfld ('A_DEP ',(/ 'lev' /), 'A', '/s ','Avg deposition ice snow graupel from CRM' ) - call addfld ('A_CON ',(/ 'lev' /), 'A', '/s ','Avg condensation cloud water from CRM' ) - - call addfld ('CRM_REL ', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'micrometers', 'cloud scale droplet effective radius') - call addfld ('CRM_REI ', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'micrometers', 'cloud scale ice crystal effective radius') - call addfld ('CRM_DEI ', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'micrometers', 'cloud scale Mitchell ice effective diameter') - call addfld ('CRM_DES ', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'micrometers', 'cloud scale snow effective diameter') - call addfld ('CRM_MU ', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'micrometers', & - 'cloud scale droplet size distribution shape parameter for radiation') - call addfld ('CRM_LAMBDA',(/'crm_nx','crm_ny','crm_nz'/), 'A', 'micrometers', & - 'cloud scale slope of droplet distribution for radiation') - call addfld ('CRM_TAU ', (/'crm_nx','crm_ny','crm_nz'/), 'A', '1', 'cloud scale cloud optical depth' ) - call addfld ('CRM_WVAR' , (/'crm_nx','crm_ny','crm_nz'/), 'A', 'm/s', 'vertical velocity variance from CRM') - - call addfld ('CRM_FSNT', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'net TOA shortwave fluxes at CRM grids') - call addfld ('CRM_FSNTC', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'net TOA clear-sky shortwave fluxes at CRM grids') - call addfld ('CRM_FSNS', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'net surface shortwave fluxes at CRM grids') - call addfld ('CRM_FSNSC', (/'crm_nx','crm_ny'/), 'A', 'unitless', & - 'net surface clear-sky shortwave fluxes at CRM grids') - call addfld ('CRM_FLNT', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'net TOA longwave fluxes at CRM grids') - call addfld ('CRM_FLNTC', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'net TOA clear-sky longwave fluxes at CRM grids') - call addfld ('CRM_FLNS', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'net surface longwave fluxes at CRM grids') - call addfld ('CRM_FLNSC', (/'crm_nx','crm_ny'/), 'A', 'unitless', & - 'net surface clear-sky longwave fluxes at CRM grids') - - call addfld ('CRM_AODVIS', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'Aerosol optical depth at 550nm in CRM grids',& - flag_xyfill=.true.) - call addfld ('CRM_AOD400', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'Aerosol optical depth at 400nm in CRM grids',& - flag_xyfill=.true.) - call addfld ('CRM_AOD700', (/'crm_nx','crm_ny'/), 'A', 'unitless', 'Aerosol optical depth at 700nm in CRM grids', & - flag_xyfill=.true.) - call addfld ('CRM_AODVISZ',(/'crm_nx','crm_ny','crm_nz'/), 'A', 'unitless', & - 'Aerosol optical depth at each layer at 500nm in CRM grids', flag_xyfill=.true.) - call addfld ('AOD400', horiz_only, 'A', 'unitless', 'Aerosol optical depth at 400nm', & - flag_xyfill=.true.) - call addfld ('AOD700', horiz_only, 'A', 'unitless', 'Aerosol optical depth at 700nm', & - flag_xyfill=.true.) - call add_default ('AOD400', 1, ' ') - call add_default ('AOD700', 1, ' ') - endif - - !------------------------- - ! Register CLUBB history fields - if (do_clubb_sgs) then - call addfld ('UP2 ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'm^2/s^2', 'u prime ^2 from clubb') - call addfld ('VP2 ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'm^2/s^2', 'v prime ^2 from clubb') - call addfld ('WPRTP ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'mkg/skg', 'w prime * rt prime from clubb') - call addfld ('WPTHLP ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'mK/s', 'w prime * th_l prime from clubb') - call addfld ('WP2 ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'm^2/s^2', 'w prime ^2 from clubb') - call addfld ('WP3 ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'm^3/s^3', 'w prime ^3 from clubb') - call addfld ('RTP2 ', (/'crm_nx','crm_ny','crm_z1'/), 'A', '(kg/kg)2', 'r_t prime ^2 from clubb') - call addfld ('THLP2 ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'K^2', 'th_l_prime ^2 from clubb') - call addfld ('RTPTHLP ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'kgK/kg', 'r_t prime * th_l prime from clubb') - call addfld ('UPWP ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'm^2/s^2', 'u prime * w prime from clubb') - call addfld ('VPWP ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'm^2/s^2', 'v prime * w prime from clubb') - call addfld ('CRM_CLD ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'fraction', 'cloud fraction from clubb') - call addfld ('T_TNDCY ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'K/s', 't tendency from clubb') - call addfld ('QV_TNDCY ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'kg/kg/s', 'water vapor tendency from clubb') - call addfld ('QC_TNDCY ', (/'crm_nx','crm_ny','crm_z1'/), 'A', 'kg/kg/s', 'liquid condensate tendency from clubb') - call addfld ('CLUBB_TK', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'm^2/s', 'Eddy viscosity from clubb') - call addfld ('CLUBB_TKH', (/'crm_nx','crm_ny','crm_nz'/), 'A', 'm^2/s', 'Eddy viscosity from clubb') - call addfld ('CRM_RELVAR', (/'crm_nx','crm_ny','crm_nz'/), 'A', '', 'cloud water relative variance from clubb') - call addfld ('ACCRE_ENHAN', (/'crm_nx','crm_ny','crm_nz'/), 'A', '', 'Accretion enhancment from clubb') - call addfld ('QCLVAR', (/'crm_nx','crm_ny','crm_nz'/), 'A', '(kg/kg)^2', 'cloud water variance from clubb') - ! add GCM-scale output - call addfld ('SPUP2', (/ 'lev' /), 'A', 'm^2/s^2', 'u prime ^2 from clubb on GCM grids') - call addfld ('SPVP2', (/ 'lev' /), 'A', 'm^2/s^2', 'v prime ^2 from clubb on GCM grids') - call addfld ('SPWPRTP', (/ 'lev' /), 'A', 'mkg/skg', 'w prime * rt prime from clubb on GCM grids') - call addfld ('SPWPTHLP', (/ 'lev' /), 'A', 'mK/s', 'w prime * th_l prime from clubb on GCM grids') - call addfld ('SPWP2', (/ 'lev' /), 'A', 'm^2/s^2', 'w prime ^2 from clubb on GCM grids') - call addfld ('SPWP3', (/ 'lev' /), 'A', 'm^3/s^3', 'w prime ^3 from clubb on GCM grids') - call addfld ('SPRTP2', (/ 'lev' /), 'A', '(kg/kg)2', 'r_t prime ^2 from clubb on GCM grids') - call addfld ('SPTHLP2', (/ 'lev' /), 'A', 'K^2', 'th_l_prime ^2 from clubb on GCM grids') - call addfld ('SPRTPTHLP', (/ 'lev' /), 'A', 'kgK/kg', 'r_t prime * th_l prime from clubb on GCM grids') - call addfld ('SPUPWP', (/ 'lev' /), 'A', 'm^2/s^2', 'u prime * w prime from clubb on GCM grids') - call addfld ('SPVPWP', (/ 'lev' /), 'A', 'm^2/s^2', 'v prime * w prime from clubb on GCM grids') - call addfld ('SPCRM_CLD ', (/ 'lev' /), 'A', 'fraction', 'cloud fraction from clubb on GCM grids') - call addfld ('SPT_TNDCY ', (/ 'lev' /), 'A', 'K/s', 't tendency from clubb on GCM grids') - call addfld ('SPQV_TNDCY ', (/ 'lev' /), 'A', 'kg/kg/s', 'water vapor tendency from clubb on GCM grids') - call addfld ('SPQC_TNDCY ', (/ 'lev' /), 'A', 'kg/kg/s', 'liquid condensate tendency from clubb on GCM grids') - call addfld ('SPCLUBB_TK', (/ 'lev' /), 'A', 'm^2/s', 'Eddy viscosity from clubb on GCM grids') - call addfld ('SPCLUBB_TKH', (/ 'lev' /), 'A', 'm^2/s', 'Eddy viscosity from clubb on GCM grids') - call addfld ('SPRELVAR', (/ 'lev' /), 'A', '', 'cloud water relative variance from clubb on GCM grids') - call addfld ('SPACCRE_ENHAN',(/ 'lev' /), 'A', '', 'Accretion enhancment from clubb on GCM grids') - call addfld ('SPQCLVAR', (/ 'lev' /), 'A', '', 'cloud water variance from clubb on GCM grids') - endif - - - !------------------------- - ! Register ECPP history fields - ! ifdef needed because of ECPP parameters such as NCLASS_CL and ncls_ecpp_in and papampollu_init -#ifdef m2005 - if (is_spcam_m2005) then - - call papampollu_init () - - call addfld ('ABND ', (/'ilev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'fraction', & - 'cloud fraction for each sub-sub class for full time period at layer boundary') - call addfld ('ABND_TF ', (/'ilev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'fraction', & - 'cloud fraction for each sub-sub class for end-portion of time period at layer boundary') - call addfld ('MASFBND ', (/'ilev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'kg/m2/s', & - 'sub-class vertical mass flux (kg/m2/s) at layer boundary') - call addfld ('ACEN ', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'fraction', & - 'cloud fraction for each sub-sub class for full time period at layer center') - call addfld ('ACEN_TF ', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'fraction', & - 'cloud fraction for each sub-sub class for end-portion of time period at layer center') - call addfld ('RHCEN ', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'fraction', & - 'relative humidity for each sub-sub calss at layer center') - call addfld ('QCCEN ', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'kg/kg', & - 'cloud water for each sub-sub class at layer center') - call addfld ('QICEN ', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'kg/kg', & - 'cloud ice for each sub-sub class at layer center') - call addfld ('QSINK_AFCEN', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', '/s', & - 'cloud water loss rate from precip. using cloud water after precip. for each sub-sub class at layer center') - call addfld ('QSINK_BFCEN', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', '/s', & - 'cloud water loss rate from precip. using cloud water before precip. for each sub-sub class at layer center') - call addfld ('QSINK_AVGCEN', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', '/s', & - 'cloud water loss rate from precip. using averaged cloud water and precip. rate for each sub-sub class at layer center') - call addfld ('PRAINCEN', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'kg/kg/s', & - ' cloud water loss rate from precipitation (kg/kg/s) for each sub-sub class at layer center') - call addfld ('PRECRCEN', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'kg/m2/s', & - 'liquid (rain) precipitation rate for each sub-sub class at layer center') - call addfld ('PRECSCEN', (/'lev ','NCLASS_CL ','ncls_ecpp_in','NCLASS_PR '/), 'A', 'kg/m2/s', & - 'solid (snow, graupel,...) precipitation rate for each sub-sub class at layer center') - call addfld ('WUPTHRES', (/ 'ilev' /), 'A', 'm/s', 'vertical velocity threshold for updraft') - call addfld ('WDNTHRES', (/ 'ilev' /), 'A', 'm/s', 'vertical velocity threshold for dndraft') - call addfld ('WWQUI_CEN', (/ 'lev' /), 'A', 'm2/s2', 'vertical velocity variance in the quiescent class, layer center') - call addfld ('WWQUI_CLD_CEN', (/ 'lev' /), 'A', 'm2/s2', & - 'vertical velocity variance in the cloudy quiescent class, layer center') - call addfld ('WWQUI_BND', (/ 'ilev' /), 'A', 'm2/s2', & - 'vertical velocity variance in the quiescent class, layer boundary') - call addfld ('WWQUI_CLD_BND', (/ 'ilev' /), 'A', 'm2/s2', & - 'vertical velocity variance in the cloudy quiescent class, layer boundary') - endif -#endif - - !------------------------- - ! Register modal aerosol history fields - ! ifdef needed because of use of cnst_name_cw which not defined if not modal aerosols -#ifdef MODAL_AERO - if (prog_modal_aero) then - - call ndrop_init() - - do m=1, pcnst - if(cnst_species_class(m).eq.cnst_spec_class_gas) then - fieldname = trim(cnst_name(m)) // '_mixnuc1sp' - long_name = trim(cnst_name(m)) // ' dropmixnuc mixnuc column tendency in the mmf one ' - call addfld( fieldname, horiz_only, 'A', unit, long_name) - call add_default( fieldname, 1, ' ' ) - end if - end do - - endif - -#endif - - ! These variables do not vary in CRM - call pbuf_set_field (pbuf2d, prec_dp_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, prec_sh_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, snow_sh_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, snow_dp_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, prec_sed_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, snow_sed_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, prec_pcw_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, snow_pcw_idx, 0.0_r8) - - - call addfld ('CRM_U ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'm/s ', 'CRM x-wind' ) - call addfld ('CRM_V ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'm/s ', 'CRM y-wind' ) - call addfld ('CRM_W ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'm/s ', 'CRM z-wind' ) - call addfld ('CRM_T ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'K ', 'CRM Temperature' ) - call addfld ('CRM_QV ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'kg/kg ', 'CRM Water Vapor' ) - call addfld ('CRM_QC ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'kg/kg ', 'CRM Cloud Water' ) - call addfld ('CRM_QI ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'kg/kg ', 'CRM Cloud Ice' ) - call addfld ('CRM_QPC ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'kg/kg ', 'CRM Precipitating Water' ) - call addfld ('CRM_QPI ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'kg/kg ', 'CRM Precipitating Ice' ) - call addfld ('CRM_PREC',(/'crm_nx','crm_ny'/), 'I', 'm/s ', 'CRM Precipitation Rate' ) - call addfld ('CRM_QRS ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'K/s ', 'CRM Shortwave radiative heating rate') - call addfld ('CRM_QRL ',(/'crm_nx','crm_ny', 'crm_nz'/), 'I', 'K/s ', 'CRM Longwave radiative heating rate' ) - - call add_default ('SPDT ', 1, ' ') - call add_default ('SPDQ ', 1, ' ') - call add_default ('SPDQC ', 1, ' ') - call add_default ('SPDQI ', 1, ' ') - call add_default ('SPMC ', 1, ' ') - call add_default ('SPMCUP ', 1, ' ') - call add_default ('SPMCDN ', 1, ' ') - call add_default ('SPMCUUP ', 1, ' ') - call add_default ('SPMCUDN ', 1, ' ') - call add_default ('SPQC ', 1, ' ') - call add_default ('SPQI ', 1, ' ') - call add_default ('SPQS ', 1, ' ') - call add_default ('SPQG ', 1, ' ') - call add_default ('SPQR ', 1, ' ') - call add_default ('SPQTFLX ', 1, ' ') - call add_default ('SPQTFLXS', 1, ' ') - call add_default ('SPTKE ', 1, ' ') - call add_default ('SPTKES ', 1, ' ') - call add_default ('SPTK ', 1, ' ') - call add_default ('SPQPFLX ', 1, ' ') - call add_default ('SPPFLX ', 1, ' ') - call add_default ('SPQTLS ', 1, ' ') - call add_default ('SPQTTR ', 1, ' ') - call add_default ('SPQPTR ', 1, ' ') - call add_default ('SPQPEVP ', 1, ' ') - call add_default ('SPQPFALL', 1, ' ') - call add_default ('SPQPSRC ', 1, ' ') - call add_default ('SPTLS ', 1, ' ') - call add_default ('CLOUDTOP', 1, ' ') - call add_default ('TIMINGF ', 1, ' ') - - sh_frac_idx = pbuf_get_index('SH_FRAC') - dp_frac_idx = pbuf_get_index('DP_FRAC') - call pbuf_set_field (pbuf2d, sh_frac_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, dp_frac_idx, 0.0_r8) - - call pbuf_set_field (pbuf2d, cmfmc_sh_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, rprdsh_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, icwmrsh_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, nevapr_shcu_idx, 0.0_r8) - - call pbuf_set_field (pbuf2d, icwmrdp_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, fice_idx, 0.0_r8) - - call pbuf_set_field (pbuf2d, prain_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, rprdtot_idx, 0.0_r8) - call pbuf_set_field (pbuf2d, nevapr_idx, 0.0_r8) - - if (is_first_step()) then - call pbuf_set_field (pbuf2d, ast_idx, 0.0_r8) - end if -#endif -end subroutine crm_physics_init - -!========================================================================================================= - -function crm_implements_cnst(name) - - ! Return true if specified constituent is implemented by the - ! microphysics package - - character(len=*), intent(in) :: name ! constituent name - logical :: crm_implements_cnst ! return value - -#ifdef CRM - !----------------------------------------------------------------------- - - crm_implements_cnst = any(name == cnst_names) - -#endif -end function crm_implements_cnst - -!=============================================================================== - -subroutine crm_init_cnst(name, q) - - ! Initialize the microphysics constituents, if they are - ! not read from the initial file. - - character(len=*), intent(in) :: name ! constituent name - real(r8), intent(out) :: q(:,:) ! mass mixing ratio (gcol, plev) - !----------------------------------------------------------------------- - -#ifdef CRM - if (crm_implements_cnst(name)) q = 0.0_r8 -#endif - -end subroutine crm_init_cnst - -!=============================================================================== - -!--------------------------------------------------------------------------------------------------------- - subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf, cam_in) - -!------------------------------------------------------------------------------------------ -! Purpose: to update state from CRM physics. -! -! Revision history: -! -! June, 2009, Minghuai Wang: -! These codes are taken out from tphysbc.F90 -! in the spcam3.5, developed by Marat Khairoutdinov -! (mkhairoutdin@ms.cc.sunysb.edu). Here we try to follow the procedure -! in 'Interface to Column Physics and Chemistry packages' to implement -! the CRM physics. -! July, 13, 2009, Minghuai Wang: -! Hydrometer numbers are outputed from SAM when Morrison's microphysics is used, -! and will be used in the radiative transfer code to calculate radius. -! July, 15, 2009, Minghuai Wang: -! Get modal aerosol, and use it in the SAM. -! -!------------------------------------------------------------------------------------------- -#ifdef CRM - use shr_spfn_mod, only: gamma => shr_spfn_gamma - use time_manager, only: is_first_step, get_nstep - use cam_history, only: outfld - use perf_mod - use crmdims, only: crm_nx, crm_ny, crm_nz - use physconst, only: cpair, latvap, gravit - use constituents, only: pcnst, cnst_get_ind - use crmx_crm_module, only: crm - use crmx_microphysics, only: nmicro_fields - use physconst, only: latvap - use check_energy, only: check_energy_chng - use phys_grid, only: get_rlat_all_p, get_rlon_all_p, get_lon_all_p, get_lat_all_p - use modal_aero_calcsize, only: modal_aero_calcsize_sub - use micro_mg_utils, only: size_dist_param_liq, mg_liq_props, mincld, qsmall - -#ifdef MODAL_AERO - use crmclouds_camaerosols, only: crmclouds_mixnuc_tend, spcam_modal_aero_wateruptake_dr - use ndrop, only: loadaer -#endif -#ifdef m2005 - use module_ecpp_ppdriver2, only: parampollu_driver2 - use crmx_ecppvars, only: NCLASS_CL, ncls_ecpp_in, NCLASS_PR - use module_data_ecpp1, only: dtstep_pp_input -#endif -#ifdef SPCAM_CLUBB_SGS - use cloud_cover_diags, only: cloud_cover_diags_out - use pkg_cldoptics, only: cldovrlap -#endif - -#endif - - use physics_buffer, only: physics_buffer_desc, pbuf_old_tim_idx, pbuf_get_index, dyn_time_lvls, pbuf_get_field - use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, physics_ptend_init, & - physics_state_copy, physics_ptend_sum, physics_ptend_scale - use camsrfexch, only: cam_in_t - - real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) - type(physics_state), intent(in) :: state - type(physics_tend), intent(in) :: tend - type(physics_ptend ), intent(out) :: ptend - type(physics_buffer_desc),pointer :: pbuf(:) - type (cam_in_t), intent(in) :: cam_in - -#ifdef CRM - - type(physics_state) :: state_loc ! local copy of state - type(physics_tend) :: tend_loc ! local copy of tend - type(physics_ptend) :: ptend_loc ! local copy of ptend - - ! convective precipitation variables - real(r8), pointer :: prec_dp(:) ! total precipitation from ZM convection [m/s] - real(r8), pointer :: snow_dp(:) ! snow from ZM convection [m/s] - - real(r8), pointer :: nc_rad(:,:,:,:) ! rad cloud water droplet number [#/kg] - real(r8), pointer :: ni_rad(:,:,:,:) ! rad cloud ice crystal number [#/kg] - real(r8), pointer :: qs_rad(:,:,:,:) ! rad cloud snow mass [kg/kg] - real(r8), pointer :: ns_rad(:,:,:,:) ! rad cloud snow crystal number [#/kg] - real(r8), pointer :: cld_rad(:,:,:,:) ! cloud fraction - - real(r8), pointer :: t_rad (:,:,:,:) ! rad temperuture - real(r8), pointer :: qv_rad(:,:,:,:) ! rad vapor - real(r8), pointer :: qc_rad(:,:,:,:) ! rad cloud water - real(r8), pointer :: qi_rad(:,:,:,:) ! rad cloud ice - real(r8), pointer :: crm_qrad(:,:,:,:) - real(r8), pointer :: clubb_buffer (:,:,:,:,:) - - real(r8),pointer :: cldtop_pbuf(:) ! cloudtop location for pbuf - - real(r8),pointer :: tk_crm_ecpp(:,:) - real(r8),pointer :: acldy_cen_tbeg(:,:) ! cloud fraction - real(r8), pointer, dimension(:,:) :: cldo - -! -!--------------------------- Local variables ----------------------------------------------------------- -! - integer lchnk ! chunk identifier - integer ncol ! number of atmospheric columns - - integer nstep ! time steps - - real(r8) qc_crm (pcols,crm_nx, crm_ny, crm_nz) - real(r8) qi_crm (pcols,crm_nx, crm_ny, crm_nz) - real(r8) qpc_crm(pcols,crm_nx, crm_ny, crm_nz) - real(r8) qpi_crm(pcols,crm_nx, crm_ny, crm_nz) - - real(r8),allocatable :: crm_cld(:,:,:,:) - real(r8),allocatable :: clubb_tk(:,:,:,:) - real(r8),allocatable :: clubb_tkh(:,:,:,:) - real(r8),allocatable :: relvar(:,:,:,:) - real(r8),allocatable :: accre_enhan(:,:,:,:) - real(r8),allocatable :: qclvar(:,:,:,:) - - real(r8) crm_tk(pcols,crm_nx, crm_ny, crm_nz) - real(r8) crm_tkh(pcols,crm_nx, crm_ny, crm_nz) - real(r8) cld3d_crm(pcols, crm_nx, crm_ny, crm_nz) ! 3D instaneous cloud fraction - real(r8) prec_crm(pcols,crm_nx, crm_ny) - real(r8) mctot(pcols,pver) ! total cloud mass flux - real(r8) mcup(pcols,pver) ! cloud updraft mass flux - real(r8) mcdn(pcols,pver) ! cloud downdraft mass flux - real(r8) mcuup(pcols,pver) ! unsaturated updraft mass flux - real(r8) mcudn(pcols,pver) ! unsaturated downdraft mass flux - real(r8) spqc(pcols,pver) ! cloud water - real(r8) spqi(pcols,pver) ! cloud ice - real(r8) spqs(pcols,pver) ! snow - real(r8) spqg(pcols,pver) ! graupel - real(r8) spqr(pcols,pver) ! rain - real(r8) spnc(pcols,pver) ! cloud water droplet (#/kg) - real(r8) spni(pcols,pver) ! cloud ice crystal number (#/kg) - real(r8) spns(pcols,pver) ! snow particle number (#/kg) - real(r8) spng(pcols,pver) ! graupel particle number (#/kg) - real(r8) spnr(pcols,pver) ! rain particle number (#/kg) - real(r8) wvar_crm (pcols,crm_nx, crm_ny, crm_nz) ! vertical velocity variance (m/s) - - real(r8) aut_crm (pcols,crm_nx, crm_ny, crm_nz) ! Cloud water autoconversion (1/s) - real(r8) acc_crm (pcols,crm_nx, crm_ny, crm_nz) ! Cloud water accretion by rain (1/s) - real(r8) evpc_crm (pcols,crm_nx, crm_ny, crm_nz) ! Cloud water evaporation (1/s) - real(r8) evpr_crm (pcols,crm_nx, crm_ny, crm_nz) ! Rain evaporation (1/s) - real(r8) mlt_crm (pcols,crm_nx, crm_ny, crm_nz) ! Ice, snow, graupel melting (1/s) - real(r8) sub_crm (pcols,crm_nx, crm_ny, crm_nz) ! Ice, snow, graupel sublimation (1/s) - real(r8) dep_crm (pcols,crm_nx, crm_ny, crm_nz) ! Ice, snow, graupel deposition (1/s) - real(r8) con_crm (pcols,crm_nx, crm_ny, crm_nz) ! Cloud water condensation (1/s) - real(r8) aut_crm_a (pcols,pver) ! Cloud water autoconversion (1/s) - real(r8) acc_crm_a (pcols,pver) ! Cloud water accretion by rain (1/s) - real(r8) evpc_crm_a (pcols,pver) ! Cloud water evaporation (1/s) - real(r8) evpr_crm_a (pcols,pver) ! Rain evaporation (1/s) - real(r8) mlt_crm_a (pcols,pver) ! Ice, snow, graupel melting (1/s) - real(r8) sub_crm_a (pcols,pver) ! Ice, snow, graupel sublimation (1/s) - real(r8) dep_crm_a (pcols,pver) ! Ice, snow, graupel deposition (1/s) - real(r8) con_crm_a (pcols,pver) ! Cloud water condensation (1/s) - - real(r8) flux_qt(pcols,pver) ! nonprecipitating water flux - real(r8) flux_u(pcols,pver) ! x-momentum flux - real(r8) flux_v(pcols,pver) ! y-momentum flux - real(r8) fluxsgs_qt(pcols,pver) ! sgs nonprecipitating water flux - real(r8) tkez(pcols,pver) ! tke profile [kg/m/s2] - real(r8) tkesgsz(pcols,pver) ! sgs tke profile [kg/m/s2] - real(r8) flux_qp(pcols,pver) ! precipitating water flux - real(r8) precflux(pcols,pver) ! precipitation flux - real(r8) qt_ls(pcols,pver) ! water tendency due to large-scale - real(r8) qt_trans(pcols,pver) ! nonprecip water tendency due to transport - real(r8) qp_trans(pcols,pver) ! precip water tendency due to transport - real(r8) qp_fall(pcols,pver) ! precip water tendency due to fall-out - real(r8) qp_evp(pcols,pver) ! precip water tendency due to evap - real(r8) qp_src(pcols,pver) ! precip water tendency due to conversion - real(r8) t_ls(pcols,pver) ! tendency of crm's liwse due to large-scale - real(r8) cldtop(pcols,pver) - real(r8) cwp (pcols,pver) ! in-cloud cloud (total) water path (kg/m2) - real(r8) gicewp(pcols,pver) ! grid-box cloud ice water path (g/m2) - real(r8) gliqwp(pcols,pver) ! grid-box cloud liquid water path (g/m2) - real(r8) gwp (pcols,pver) ! grid-box cloud (total) water path (kg/m2) - real(r8) tgicewp(pcols) ! Vertically integrated ice water path (kg/m2 - real(r8) tgliqwp(pcols) ! Vertically integrated liquid water path (kg/m2) - real(r8) cicewp(pcols,pver) ! in-cloud cloud ice water path (kg/m2) - real(r8) cliqwp(pcols,pver) ! in-cloud cloud liquid water path (kg/m2) - real(r8) tgwp (pcols) ! Vertically integrated (total) cloud water path (kg/m2) - real(r8) precc(pcols) ! convective precipitation [m/s] - real(r8) precl(pcols) ! large scale precipitation [m/s] - real(r8) precsc(pcols) ! convecitve snow [m/s] - real(r8) precsl(pcols) ! convective snow [m/s] - real(r8) cltot(pcols) ! Diagnostic total cloud cover - real(r8) cllow(pcols) ! Diagnostic low cloud cover - real(r8) clmed(pcols) ! Diagnostic mid cloud cover - real(r8) clhgh(pcols) ! Diagnostic hgh cloud cover - real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables - real(r8) ul(pver) - real(r8) vl(pver) - - real(r8) :: mu_crm(pcols,pver) - real(r8) :: md_crm(pcols,pver) - real(r8) :: du_crm(pcols,pver) - real(r8) :: eu_crm(pcols,pver) - real(r8) :: ed_crm(pcols,pver) - real(r8) :: tk_crm(pcols,pver) - real(r8) :: jt_crm(pcols) - real(r8) :: mx_crm(pcols) - real(r8) :: ideep_crm(pcols) - - - integer itim - real(r8), pointer, dimension(:,:) :: cld ! cloud fraction - - real(r8),allocatable :: na(:) ! aerosol number concentration [/m3] - real(r8),allocatable :: va(:) ! aerosol voume concentration [m3/m3] - real(r8),allocatable :: hy(:) ! aerosol bulk hygroscopicity - real(r8),allocatable :: naermod(:,:) ! Aerosol number concentration [/m3] - real(r8),allocatable :: vaerosol(:,:) ! aerosol volume concentration [m3/m3] - real(r8),allocatable :: hygro(:,:) ! hygroscopicity of aerosol mode - integer phase ! phase to determine whether it is interstitial, cloud-borne, or the sum. - - real(r8) cs(pcols, pver) ! air density [kg/m3] - - real(r8),allocatable :: qicecen(:,:,:,:,:) ! cloud ice (kg/kg) - real(r8),allocatable :: qlsink_afcen(:,:,:,:,:) ! cloud water loss rate from precipitation calculated - ! cloud water before precipitatinog (/s) - real(r8),allocatable :: qlsink_bfcen(:,:,:,:,:) ! cloud water loss rate from precipitation calculated - ! cloud water before precipitatinog (/s) - real(r8),allocatable :: qlsink_avgcen(:,:,:,:,:) ! cloud water loss rate from precipitation calculated - ! from praincen and qlcoudcen averaged over - ! ntavg1_ss time step (/s) - real(r8),allocatable :: praincen(:,:,:,:,:) ! cloud water loss rate from precipitation (kg/kg/s) - real(r8),allocatable :: wupthresh_bnd(:,:) - real(r8),allocatable :: wdownthresh_bnd(:,:) - - ! CRM column radiation stuff: - real(r8) prectend(pcols) ! tendency in precipitating water and ice - real(r8) precstend(pcols) ! tendency in precipitating ice - real(r8) icesink(pcols) ! sink of - real(r8) tau00 ! surface stress - real(r8) wnd ! surface wnd - real(r8) bflx ! surface buoyancy flux (Km/s) - real(r8) taux_crm(pcols) ! zonal CRM surface stress perturbation - real(r8) tauy_crm(pcols) ! merid CRM surface stress perturbation - real(r8) z0m(pcols) ! surface momentum roughness length - real(r8), pointer, dimension(:,:) :: qrs, qrl ! rad heating rates - real(r8), pointer, dimension(:,:,:,:) :: crm_u - real(r8), pointer, dimension(:,:,:,:) :: crm_v - real(r8), pointer, dimension(:,:,:,:) :: crm_w - real(r8), pointer, dimension(:,:,:,:) :: crm_t - real(r8), pointer, dimension(:,:,:,:) :: crm_qt - real(r8), pointer, dimension(:,:,:,:) :: crm_qp - real(r8), pointer, dimension(:,:,:,:) :: crm_qn - real(r8), pointer, dimension(:,:,:,:) :: crm_nc - real(r8), pointer, dimension(:,:,:,:) :: crm_qr - real(r8), pointer, dimension(:,:,:,:) :: crm_nr - real(r8), pointer, dimension(:,:,:,:) :: crm_qi - real(r8), pointer, dimension(:,:,:,:) :: crm_ni - real(r8), pointer, dimension(:,:,:,:) :: crm_qs - real(r8), pointer, dimension(:,:,:,:) :: crm_ns - real(r8), pointer, dimension(:,:,:,:) :: crm_qg - real(r8), pointer, dimension(:,:,:,:) :: crm_ng - real(r8), pointer, dimension(:,:,:,:) :: crm_qc - - real(r8), allocatable, dimension(:,:,:,:,:) :: crm_micro - - integer :: pblh_idx - real(r8), pointer, dimension(:) :: pblh - - real(r8), pointer, dimension(:,:) :: wsedl - - real(r8),allocatable :: acen(:,:,:,:,:) ! cloud fraction for each sub-sub class for full time period - real(r8),allocatable :: acen_tf(:,:,:,:,:) ! cloud fraction for end-portion of time period - real(r8),allocatable :: rhcen(:,:,:,:,:) ! relative humidity (0-1) - real(r8),allocatable :: qcloudcen(:,:,:,:,:) ! cloud water (kg/kg) - real(r8),allocatable :: qlsinkcen(:,:,:,:,:) ! cloud water loss rate from precipitation (/s??) - real(r8),allocatable :: precrcen(:,:,:,:,:) ! liquid (rain) precipitation rate (kg/m2/s) - real(r8),allocatable :: precsolidcen(:,:,:,:,:) ! solid (rain) precipitation rate (kg/m2/s) - real(r8),allocatable :: wwqui_cen(:,:) ! vertical velocity variance in quiescent class (m2/s2) - real(r8),allocatable :: wwqui_cloudy_cen(:,:) ! vertical velocity variance in quiescent, and cloudy class (m2/s2) - ! at layer boundary - real(r8),allocatable :: abnd(:,:,:,:,:) ! cloud fraction for each sub-sub class for full time period - real(r8),allocatable :: abnd_tf(:,:,:,:,:) ! cloud fraction for end-portion of time period - real(r8),allocatable :: massflxbnd(:,:,:,:,:) ! sub-class vertical mass flux (kg/m2/s) at layer bottom boundary. - real(r8),allocatable :: wwqui_bnd(:,:) ! vertical velocity variance in quiescent class (m2/s2) - real(r8),allocatable :: wwqui_cloudy_bnd(:,:) ! vertical velocity variance in quiescent, and cloudy class (m2/s2) - - integer, pointer :: nmxrgn(:) ! Number of maximally overlapped regions - real(r8), pointer :: pmxrgn(:,:) ! Maximum values of pressure for each - - real(r8), allocatable :: spup2(:,:) - real(r8), allocatable :: spvp2(:,:) - real(r8), allocatable :: spwprtp(:,:) - real(r8), allocatable :: spwpthlp(:,:) - real(r8), allocatable :: spwp2(:,:) - real(r8), allocatable :: spwp3(:,:) - real(r8), allocatable :: sprtp2(:,:) - real(r8), allocatable :: spthlp2(:,:) - real(r8), allocatable :: sprtpthlp(:,:) - real(r8), allocatable :: spupwp(:,:) - real(r8), allocatable :: spvpwp(:,:) - real(r8), allocatable :: spcrm_cld(:,:) - real(r8), allocatable :: spt_tndcy(:,:) - real(r8), allocatable :: spqv_tndcy(:,:) - real(r8), allocatable :: spqc_tndcy(:,:) - real(r8), allocatable :: spclubb_tk(:,:) - real(r8), allocatable :: spclubb_tkh(:,:) - real(r8), allocatable :: sprelvar(:,:) - real(r8), allocatable :: spaccre_enhan(:,:) - real(r8), allocatable :: spqclvar(:,:) - - real(r8) :: spcld3d (pcols,pver) - - real(r8) :: tmp4d(pcols,crm_nx, crm_ny, crm_nz) - real(r8) :: tmp2d(pcols,pver) - - ! Surface fluxes - real(r8) :: fluxu0 ! surface momenment fluxes - real(r8) :: fluxv0 ! surface momenment fluxes - real(r8) :: fluxt0 ! surface sensible heat fluxes - real(r8) :: fluxq0 ! surface latent heat fluxes - real(r8) :: dtstep_pp ! time step for the ECPP (seconds) - integer :: necpp ! the number of GCM time step in which ECPP is called once. - - - real(r8) radflux(pcols) ! radiative fluxes from radiation calculation (qrs + qrl) - - real(r8) qtot(pcols, 3) ! total water - real(r8) qt_hydro(pcols, 2) ! total hydrometer - real(r8) qt_cloud(pcols, 3) ! total cloud water - real(r8) qtv(pcols, 3) ! total water vapor - real(r8) qli_hydro(pcols, 2) ! column-integraetd rain + snow + graupel - real(r8) qi_hydro(pcols, 2) ! column-integrated snow water + graupel water - real(r8) sfactor - - real(r8) zero(pcols) ! zero - real(r8) timing_factor(pcols) ! factor for crm cpu-usage: 1 means no subcycling - - real(r8) qtotcrm(pcols, 20) ! the toal water calculated in crm.F90 - - real(r8), parameter :: rhow = 1000._r8 - real(r8), parameter :: bc = 2._r8 - real(r8) :: t, mu, acn, dumc, dunc, pgam, lamc - real(r8) :: dunc_arr(pcols,pver) - - integer ii, jj - integer iii - integer i, k, m - integer ifld - logical :: ls, lu, lv, lq(pcnst) - - zero = 0.0_r8 -!======================================================== -!======================================================== -! CRM (Superparameterization). -! Author: Marat Khairoutdinov (mkhairoutdin@ms.cc.sunysb.edu) -!======================================================== - - call t_startf ('crm') - - allocate(crm_micro(pcols,crm_nx,crm_ny,crm_nz,nmicro_fields+1)) - - ! Initialize stuff: - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - - ls = .TRUE. - lq(:) = .FALSE. - lq(1) = .TRUE. - lq(ixcldliq) = .TRUE. - lq(ixcldice) = .TRUE. - lu = .FALSE. - lv = .FALSE. - call physics_ptend_init(ptend, state%psetcols, 'crm', lu=lu, lv=lv, ls=ls, lq=lq) ! Initialize output physics_ptend object - call physics_ptend_init(ptend_loc, state%psetcols, 'crm', lu=lu, lv=lv, ls=ls, lq=lq) ! Initialize local physics_ptend object - - nstep = get_nstep() - - lchnk = state%lchnk - ncol = state%ncol - - itim = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cldo_idx, cldo, start=(/1,1,itim/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim/), kount=(/pcols,pver,1/)) - - call physics_state_copy(state, state_loc) - tend_loc = tend - - !------------------------- - ! Set up general fields - call pbuf_get_field (pbuf, crm_u_idx, crm_u) - call pbuf_get_field (pbuf, crm_v_idx, crm_v) - call pbuf_get_field (pbuf, crm_w_idx, crm_w) - call pbuf_get_field (pbuf, crm_t_idx, crm_t) - call pbuf_get_field (pbuf, crm_qrad_idx, crm_qrad) - call pbuf_get_field (pbuf, crm_t_rad_idx, t_rad) - call pbuf_get_field (pbuf, crm_qv_rad_idx, qv_rad) - call pbuf_get_field (pbuf, crm_qc_rad_idx, qc_rad) - call pbuf_get_field (pbuf, crm_qi_rad_idx, qi_rad) - call pbuf_get_field (pbuf, crm_cld_rad_idx, cld_rad) - - call pbuf_get_field (pbuf, prec_dp_idx, prec_dp) - call pbuf_get_field (pbuf, snow_dp_idx, snow_dp) - - - !------------------------- - ! setup CLUBB fields - if (do_clubb_sgs) then - allocate(nmxrgn (pcols)) - allocate(pmxrgn (pcols,pverp)) - allocate(spup2 (pcols, pver)) - allocate(spvp2 (pcols, pver)) - allocate(spwprtp (pcols, pver)) - allocate(spwpthlp (pcols, pver)) - allocate(spwp2 (pcols, pver)) - allocate(spwp3 (pcols, pver)) - allocate(sprtp2 (pcols, pver)) - allocate(spthlp2 (pcols, pver)) - allocate(sprtpthlp (pcols, pver)) - allocate(spupwp (pcols, pver)) - allocate(spvpwp (pcols, pver)) - allocate(spcrm_cld (pcols, pver)) - allocate(spt_tndcy (pcols, pver)) - allocate(spqv_tndcy (pcols, pver)) - allocate(spqc_tndcy (pcols, pver)) - allocate(spclubb_tk (pcols, pver)) - allocate(spclubb_tkh (pcols, pver)) - allocate(sprelvar (pcols, pver)) - allocate(spaccre_enhan (pcols, pver)) - allocate(spqclvar (pcols, pver)) - allocate(crm_cld (pcols,crm_nx, crm_ny, crm_nz+1)) - allocate(clubb_tk (pcols,crm_nx, crm_ny, crm_nz)) - allocate(clubb_tkh (pcols,crm_nx, crm_ny, crm_nz)) - allocate(relvar (pcols,crm_nx, crm_ny, crm_nz)) - allocate(accre_enhan (pcols,crm_nx, crm_ny, crm_nz)) - allocate(qclvar (pcols,crm_nx, crm_ny, crm_nz)) - - call pbuf_get_field (pbuf, clubb_buffer_idx, clubb_buffer) - - endif - - !------------------------- - ! Setup m2005 fields - if (is_spcam_m2005) then - allocate(na (pcols)) - allocate(va (pcols)) - allocate(hy (pcols)) - allocate(naermod (pver, nmodes)) - allocate(vaerosol (pver, nmodes)) - allocate(hygro (pver, nmodes)) - - call pbuf_get_field(pbuf, crm_nc_rad_idx, nc_rad) - call pbuf_get_field(pbuf, crm_ni_rad_idx, ni_rad) - call pbuf_get_field(pbuf, crm_qs_rad_idx, qs_rad) - call pbuf_get_field(pbuf, crm_ns_rad_idx, ns_rad) - call pbuf_get_field(pbuf, crm_qt_idx, crm_qt) - call pbuf_get_field(pbuf, crm_nc_idx, crm_nc) - call pbuf_get_field(pbuf, crm_qr_idx, crm_qr) - call pbuf_get_field(pbuf, crm_nr_idx, crm_nr) - call pbuf_get_field(pbuf, crm_qi_idx, crm_qi) - call pbuf_get_field(pbuf, crm_ni_idx, crm_ni) - call pbuf_get_field(pbuf, crm_qs_idx, crm_qs) - call pbuf_get_field(pbuf, crm_ns_idx, crm_ns) - call pbuf_get_field(pbuf, crm_qg_idx, crm_qg) - call pbuf_get_field(pbuf, crm_ng_idx, crm_ng) - call pbuf_get_field(pbuf, crm_qc_idx, crm_qc) - - !------------------------- - ! Setup sam1mom fields - else if (is_spcam_sam1mom) then - call pbuf_get_field(pbuf, crm_qt_idx, crm_qt) - call pbuf_get_field(pbuf, crm_qp_idx, crm_qp) - call pbuf_get_field(pbuf, crm_qn_idx, crm_qn) - endif - - - !------------------------- - ! Setup ECPP fields - ! ifdef needed because of use of NCLASS_CL -#ifdef m2005 - if (is_spcam_m2005) then - allocate(acen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(acen_tf (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(rhcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(qcloudcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(qlsinkcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(precrcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(precsolidcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(wwqui_cen (pcols, pver)) - allocate(wwqui_cloudy_cen (pcols, pver)) - - ! at layer boundary - allocate(abnd (pcols,pver+1,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(abnd_tf (pcols,pver+1,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(massflxbnd (pcols,pver+1,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(wwqui_bnd (pcols, pver+1)) - allocate(wwqui_cloudy_bnd (pcols, pver+1)) - - allocate(qicecen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(qlsink_afcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(qlsink_bfcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(qlsink_avgcen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(praincen (pcols,pver,NCLASS_CL,ncls_ecpp_in,NCLASS_PR)) - allocate(wupthresh_bnd (pcols, pverp)) - allocate(wdownthresh_bnd (pcols, pverp)) - - call pbuf_get_field(pbuf, tk_crm_idx, tk_crm_ecpp) - call pbuf_get_field(pbuf, acldy_cen_idx, acldy_cen_tbeg) - - if(is_first_step())then - acldy_cen_tbeg(:ncol,:) = cld(:ncol, :) - end if - - end if -#endif - - !------------------------- - ! Initialize all aerosol and gas species - ! When ECPP is used, dropmixnuc and all transport(deep and shallow) are done in ECPP. - if (is_spcam_sam1mom) then - state_loc%q(:ncol, :pver, :pcnst) = 1.e-36_r8 - ! set the values which SPCAM uses back to state - state_loc%q(:ncol, :pver, 1) = state%q(:ncol, :pver, 1) - state_loc%q(:ncol, :pver, ixcldice) = state%q(:ncol, :pver, ixcldice) - state_loc%q(:ncol, :pver, ixcldliq) = state%q(:ncol, :pver, ixcldliq) - endif - - !------------------------- - !------------------------- - ! On the first_step, initialize values only and do not call CRM - !------------------------- - !------------------------- - if(is_first_step()) then - do k=1,crm_nz - m = pver-k+1 - do i=1,ncol - - if (spcam_direction == 'NS') then - if(crm_ny.eq.1) then ! change domain orientation only for 2D CRM - crm_u(i,:,:,k) = state_loc%v(i,m) - crm_v(i,:,:,k) = state_loc%u(i,m) - else - crm_u(i,:,:,k) = state_loc%u(i,m) - crm_v(i,:,:,k) = state_loc%v(i,m) - end if - else if( spcam_direction == 'WE') then - crm_u(i,:,:,k) = state_loc%u(i,m) - crm_v(i,:,:,k) = state_loc%v(i,m) - endif - - crm_w(i,:,:,k) = 0._r8 - crm_t(i,:,:,k) = state_loc%t(i,m) - - if (is_spcam_sam1mom) then - crm_qt(i,:,:,k) = state_loc%q(i,m,1)+state_loc%q(i,m,ixcldliq)+state_loc%q(i,m,ixcldice) - crm_qp(i,:,:,k) = 0.0_r8 - crm_qn(i,:,:,k) = state_loc%q(i,m,ixcldliq)+state_loc%q(i,m,ixcldice) - - else if (is_spcam_m2005) then - crm_qt(i,:,:,k) = state_loc%q(i,m,1)+state_loc%q(i,m,ixcldliq) - crm_nc(i,:,:,k) = 0.0_r8 - crm_qr(i,:,:,k) = 0.0_r8 - crm_nr(i,:,:,k) = 0.0_r8 - crm_qi(i,:,:,k) = state_loc%q(i,m,ixcldice) - crm_ni(i,:,:,k) = 0.0_r8 - crm_qs(i,:,:,k) = 0.0_r8 - crm_ns(i,:,:,k) = 0.0_r8 - crm_qg(i,:,:,k) = 0.0_r8 - crm_ng(i,:,:,k) = 0.0_r8 - crm_qc(i,:,:,k) = state_loc%q(i,m,ixcldliq) - - - nc_rad(i,:,:,k) = 0._r8 - ni_rad(i,:,:,k) = 0._r8 - qs_rad(i,:,:,k) = 0.0_r8 - ns_rad(i,:,:,k) = 0.0_r8 - wvar_crm(i,:,:,k) = 0.0_r8 - aut_crm(i,:,:,k) = 0.0_r8 - acc_crm(i,:,:,k) = 0.0_r8 - evpc_crm(i,:,:,k) = 0.0_r8 - evpr_crm(i,:,:,k) = 0.0_r8 - mlt_crm(i,:,:,k) = 0.0_r8 - sub_crm(i,:,:,k) = 0.0_r8 - dep_crm(i,:,:,k) = 0.0_r8 - con_crm(i,:,:,k) = 0.0_r8 - endif - - if (do_clubb_sgs) then - ! In the inital run, variables are set in clubb_sgs_setup at the first time step - clubb_buffer(i,:,:,k,:) = 0.0_r8 - endif - - crm_qrad (i,:,:,k) = 0._r8 - qc_crm (i,:,:,k) = 0._r8 - qi_crm (i,:,:,k) = 0._r8 - qpc_crm(i,:,:,k) = 0._r8 - qpi_crm(i,:,:,k) = 0._r8 - t_rad (i,:,:,k) = state_loc%t(i,m) - qv_rad (i,:,:,k) = state_loc%q(i,m,1) - qc_rad (i,:,:,k) = 0._r8 - qi_rad (i,:,:,k) = 0._r8 - cld_rad(i,:,:,k) = 0._r8 - end do - end do - - ! use radiation from grid-cell mean radctl on first time step - prec_crm (:,:,:) = 0._r8 - ptend_loc%q(:,:,1) = 0._r8 - ptend_loc%q(:,:,ixcldliq) = 0._r8 - ptend_loc%q(:,:,ixcldice) = 0._r8 - ptend_loc%s(:,:) = 0._r8 - precc(:) = 0._r8 - precl(:) = 0._r8 - precsc(:) = 0._r8 - precsl(:) = 0._r8 - cltot(:) = 0._r8 - clhgh(:) = 0._r8 - clmed(:) = 0._r8 - cllow(:) = 0._r8 - cld(:,:) = 0._r8 - cldtop(:,:) = 0._r8 - gicewp(:,:) = 0._r8 - gliqwp(:,:) = 0._r8 - mctot(:,:) = 0._r8 - mcup(:,:) = 0._r8 - mcdn(:,:) = 0._r8 - mcuup(:,:) = 0._r8 - mcudn(:,:) = 0._r8 - spqc(:,:) = 0._r8 - spqi(:,:) = 0._r8 - spqs(:,:) = 0._r8 - spqg(:,:) = 0._r8 - spqr(:,:) = 0._r8 - cld3d_crm (:,:,:,:) = 0._r8 - flux_qt(:,:) = 0._r8 - flux_u(:,:) = 0._r8 - flux_v(:,:) = 0._r8 - fluxsgs_qt(:,:) = 0._r8 - tkez(:,:) = 0._r8 - tkesgsz(:,:) = 0._r8 - flux_qp(:,:) = 0._r8 - precflux(:,:) = 0._r8 - qt_ls(:,:) = 0._r8 - qt_trans(:,:) = 0._r8 - qp_trans(:,:) = 0._r8 - qp_fall(:,:) = 0._r8 - qp_evp(:,:) = 0._r8 - qp_src(:,:) = 0._r8 - z0m(:) = 0._r8 - taux_crm(:) = 0._r8 - tauy_crm(:) = 0._r8 - t_ls(:,:) = 0._r8 - - - if (is_spcam_m2005) then - spnc(:,:) = 0._r8 - spni(:,:) = 0._r8 - spns(:,:) = 0._r8 - spng(:,:) = 0._r8 - spnr(:,:) = 0._r8 - aut_crm_a(:,:) = 0._r8 - acc_crm_a(:,:) = 0._r8 - evpc_crm_a(:,:) = 0._r8 - evpr_crm_a(:,:) = 0._r8 - mlt_crm_a(:,:) = 0._r8 - sub_crm_a(:,:) = 0._r8 - dep_crm_a(:,:) = 0._r8 - con_crm_a(:,:) = 0._r8 - abnd = 0.0_r8 - abnd_tf = 0.0_r8 - massflxbnd = 0.0_r8 - acen = 0.0_r8 - acen_tf = 0.0_r8 - rhcen = 0.0_r8 - qcloudcen = 0.0_r8 - qicecen = 0.0_r8 - qlsinkcen = 0.0_r8 - precrcen = 0.0_r8 - precsolidcen = 0.0_r8 - wupthresh_bnd = 0.0_r8 - wdownthresh_bnd = 0.0_r8 - qlsink_afcen = 0.0_r8 - qlsink_bfcen = 0.0_r8 - qlsink_avgcen = 0.0_r8 - praincen = 0.0_r8 - - ! default is clear, non-precipitating, and quiescent class - abnd(:,:,1,1,1) = 1.0_r8 - abnd_tf(:,:,1,1,1) = 1.0_r8 - acen(:,:,1,1,1) = 1.0_r8 - acen_tf(:,:,1,1,1) = 1.0_r8 - wwqui_cen = 0.0_r8 - wwqui_bnd = 0.0_r8 - wwqui_cloudy_cen = 0.0_r8 - wwqui_cloudy_bnd = 0.0_r8 - tk_crm = 0.0_r8 - - ! turbulence - cs(:ncol, 1:pver) = state_loc%pmid(:ncol, 1:pver)/(287.15_r8*state_loc%t(:ncol, 1:pver)) - - endif - - !------------------------- - !------------------------- - ! not is_first_step - !------------------------- - !------------------------- - - else - ptend_loc%q(:,:,1) = 0._r8 - ptend_loc%q(:,:,ixcldliq) = 0._r8 - ptend_loc%q(:,:,ixcldice) = 0._r8 - ptend_loc%s(:,:) = 0._r8 - cwp = 0._r8 - gicewp = 0._r8 - gliqwp = 0._r8 - cltot = 0._r8 - clhgh = 0._r8 - clmed = 0._r8 - cllow = 0._r8 - - qc_crm = 0._r8 - qi_crm = 0._r8 - qpc_crm = 0._r8 - qpi_crm = 0._r8 - prec_crm = 0._r8 - - ! Populate the internal crm_micro array - if (is_spcam_sam1mom) then - crm_micro(:,:,:,:,1) = crm_qt(:,:,:,:) - crm_micro(:,:,:,:,2) = crm_qp(:,:,:,:) - crm_micro(:,:,:,:,3) = crm_qn(:,:,:,:) - else if (is_spcam_m2005) then - crm_micro(:,:,:,:,1) = crm_qt(:,:,:,:) - crm_micro(:,:,:,:,2) = crm_nc(:,:,:,:) - crm_micro(:,:,:,:,3) = crm_qr(:,:,:,:) - crm_micro(:,:,:,:,4) = crm_nr(:,:,:,:) - crm_micro(:,:,:,:,5) = crm_qi(:,:,:,:) - crm_micro(:,:,:,:,6) = crm_ni(:,:,:,:) - crm_micro(:,:,:,:,7) = crm_qs(:,:,:,:) - crm_micro(:,:,:,:,8) = crm_ns(:,:,:,:) - crm_micro(:,:,:,:,9) = crm_qg(:,:,:,:) - crm_micro(:,:,:,:,10) = crm_ng(:,:,:,:) - crm_micro(:,:,:,:,11) = crm_qc(:,:,:,:) - - ! initialize gcm-time-step-avg output at start of each time step - aut_crm_a = 0.0_r8 - acc_crm_a = 0.0_r8 - evpc_crm_a = 0.0_r8 - evpr_crm_a = 0.0_r8 - mlt_crm_a = 0.0_r8 - sub_crm_a = 0.0_r8 - dep_crm_a = 0.0_r8 - con_crm_a = 0.0_r8 - endif - - call t_startf ('crm_call') - - do m=1,crm_nz - k = pver-m+1 - do i = 1,ncol - crm_qrad(i,:,:,m) = crm_qrad(i,:,:,m) / state_loc%pdel(i,k) ! for energy conservation - end do - end do - - if (is_spcam_m2005) then - cs(1:ncol, 1:pver) = state_loc%pmid(1:ncol, 1:pver)/(287.15_r8*state_loc%t(1:ncol, 1:pver)) - end if - - do i = 1,ncol - - tau00 = sqrt(cam_in%wsx(i)**2 + cam_in%wsy(i)**2) - wnd = sqrt(state_loc%u(i,pver)**2 + state_loc%v(i,pver)**2) - bflx = cam_in%shf(i)/cpair + 0.61_r8*state_loc%t(i,pver)*cam_in%lhf(i)/latvap - fluxu0 = cam_in%wsx(i) !N/m2 - fluxv0 = cam_in%wsy(i) !N/m2 - fluxt0 = cam_in%shf(i)/cpair ! K Kg/ (m2 s) - fluxq0 = cam_in%lhf(i)/latvap ! Kg/(m2 s) - - ! - ! calculate total water before calling crm - ! total hydrometer water (rain, snow, and graupel) - if (is_spcam_m2005) then - qt_hydro(i, 1) = 0.0_r8 - qli_hydro(i, 1) = 0.0_r8 - qi_hydro(i, 1) = 0.0_r8 - do m=1, crm_nz - k=pver-m+1 - do ii=1, crm_nx - do jj=1, crm_ny - qt_hydro(i,1) = qt_hydro(i,1)+(crm_qr(i,ii,jj,m)+crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * & - state_loc%pdel(i,k)/gravit - qli_hydro(i,1) = qli_hydro(i,1)+(crm_qr(i,ii,jj,m)+crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * & - state_loc%pdel(i,k)/gravit - qi_hydro(i,1) = qi_hydro(i,1)+(crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * state_loc%pdel(i,k)/gravit - end do - end do - end do - qt_hydro(i,1) = qt_hydro(i,1) / (crm_nx_ny) - qli_hydro(i,1) = qli_hydro(i,1) / (crm_nx_ny) - qi_hydro(i,1) = qi_hydro(i,1) / (crm_nx_ny) - - ! total cloud water and total water vapor - qt_cloud(i,1) = 0._r8 - qtv(i,1) = 0._r8 - do k=1, pver - qt_cloud(i,1) = qt_cloud(i,1) + (state_loc%q(i,k,ixcldliq)+state_loc%q(i,k,ixcldice)) * state_loc%pdel(i,k)/gravit - qtv(i,1) = qtv(i,1) + state_loc%q(i,k,1) * state_loc%pdel(i,k)/gravit - end do - - ! total water - qtot(i,1) = qt_hydro(i,1) + qt_cloud(i,1) + qtv(i,1) - - else if (is_spcam_sam1mom) then - qli_hydro(i, 1) = 0.0_r8 - qi_hydro(i, 1) = 0.0_r8 - do m=1, crm_nz - k=pver-m+1 - do ii=1, crm_nx - do jj=1, crm_ny - sfactor = max(0._r8,min(1._r8,(crm_t(i,ii,jj,m)-268.16_r8)*1._r8/(283.16_r8-268.16_r8))) - qli_hydro(i,1) = qli_hydro(i,1)+crm_qp(i,ii,jj,m) * state_loc%pdel(i,k)/gravit - qi_hydro(i,1) = qi_hydro(i,1)+crm_qp(i,ii,jj,m) * (1-sfactor) * state_loc%pdel(i,k)/gravit - end do - end do - end do - qli_hydro(i,1) = qli_hydro(i,1) / (crm_nx_ny) - qi_hydro(i,1) = qi_hydro(i,1) / (crm_nx_ny) - - ! total cloud water and total water vapor, and energy - qt_cloud(i,1) = 0._r8 - qtv(i,1) = 0._r8 - do k=1, pver - qt_cloud(i,1) = qt_cloud(i,1) + (state_loc%q(i,k,ixcldliq)+state_loc%q(i,k,ixcldice)) * state_loc%pdel(i,k)/gravit - qtv(i,1) = qtv(i,1) + state_loc%q(i,k,1) * state_loc%pdel(i,k)/gravit - end do - endif - -! ifdef required because of loadaer -#ifdef MODAL_AERO - if (prog_modal_aero) then - do k=1, pver - phase = 1 ! interstital aerosols only - do m=1, nmodes - call loadaer( & - state_loc, pbuf, i, i, k, & - m, cs, phase, na, va, & - hy) - naermod(k, m) = na(i) - vaerosol(k, m) = va(i) - hygro(k, m) = hy(i) - end do - end do - endif -#endif - - if (spcam_direction == 'NS') then - if(crm_ny.eq.1) then - ul(:) = state_loc%v(i,:) ! change orientation only if 2D CRM - vl(:) = state_loc%u(i,:) - else - ul(:) = state_loc%u(i,:) - vl(:) = state_loc%v(i,:) - end if - else if (spcam_direction == 'WE') then - ul(:) = state_loc%u(i,:) - vl(:) = state_loc%v(i,:) - endif - - call crm (lchnk, i, & - state_loc%t(i,:), state_loc%q(i,:,1), state_loc%q(i,:,ixcldliq), state_loc%q(i,:,ixcldice), & - ul(:), vl(:), & - state_loc%ps(i), state_loc%pmid(i,:), state_loc%pdel(i,:), state_loc%phis(i), & - state_loc%zm(i,:), state_loc%zi(i,:), ztodt, pver, & - ptend_loc%q(i,:,1), ptend_loc%q(i,:,ixcldliq),ptend_loc%q(i,:,ixcldice), ptend_loc%s(i,:), & - crm_u(i,:,:,:), crm_v(i,:,:,:), crm_w(i,:,:,:), crm_t(i,:,:,:), crm_micro(i,:,:,:,:), & - crm_qrad(i,:,:,:), & - qc_crm(i,:,:,:), qi_crm(i,:,:,:), qpc_crm(i,:,:,:), qpi_crm(i,:,:,:), & - prec_crm(i,:,:), t_rad(i,:,:,:), qv_rad(i,:,:,:), & - qc_rad(i,:,:,:), qi_rad(i,:,:,:), cld_rad(i,:,:,:), cld3d_crm(i, :, :, :), & -#ifdef m2005 - nc_rad(i,:,:,:), ni_rad(i,:,:,:), qs_rad(i,:,:,:), ns_rad(i,:,:,:), wvar_crm(i,:,:,:), & - aut_crm(i,:,:,:), acc_crm(i,:,:,:), evpc_crm(i,:,:,:), evpr_crm(i,:,:,:), mlt_crm(i,:,:,:), & - sub_crm(i,:,:,:), dep_crm(i,:,:,:), con_crm(i,:,:,:), & - aut_crm_a(i,:), acc_crm_a(i,:), evpc_crm_a(i,:), evpr_crm_a(i,:), mlt_crm_a(i,:), & - sub_crm_a(i,:), dep_crm_a(i,:), con_crm_a(i,:), & -#endif - precc(i), precl(i), precsc(i), precsl(i), & - cltot(i), clhgh(i), clmed(i), cllow(i), cld(i,:), cldtop(i,:), & - gicewp(i,:), gliqwp(i,:), & - mctot(i,:), mcup(i,:), mcdn(i,:), mcuup(i,:), mcudn(i,:), & - spqc(i,:), spqi(i,:), spqs(i,:), spqg(i,:), spqr(i,:), & -#ifdef m2005 - spnc(i,:), spni(i,:), spns(i,:), spng(i,:), spnr(i,:), & -#ifdef MODAL_AERO - naermod, vaerosol, hygro, & -#endif -#endif -#ifdef SPCAM_CLUBB_SGS - clubb_buffer(i,:,:,:,:), & - crm_cld(i,:, :, :), & - clubb_tk(i, :, :, :), clubb_tkh(i, :, :, :), & - relvar(i,:, :, :), accre_enhan(i, :, :, :), qclvar(i, :, :, :), & -#endif - crm_tk(i, :, :, :), crm_tkh(i, :, :, :), & - mu_crm(i,:), md_crm(i,:), du_crm(i,:), eu_crm(i,:), & - ed_crm(i,:), jt_crm(i), mx_crm(i), & -#ifdef m2005 - abnd(i,:,:,:,:), abnd_tf(i,:,:,:,:), massflxbnd(i,:,:,:,:), acen(i,:,:,:,:), acen_tf(i,:,:,:,:), & - rhcen(i,:,:,:,:), qcloudcen(i,:,:,:,:), qicecen(i,:,:,:,:), qlsink_afcen(i,:,:,:,:), & - precrcen(i,:,:,:,:), precsolidcen(i,:,:,:,:), & - qlsink_bfcen(i,:,:,:,:), qlsink_avgcen(i,:,:,:,:), praincen(i,:,:,:,:), & - wupthresh_bnd(i,:), wdownthresh_bnd(i,:), & - wwqui_cen(i,:), wwqui_bnd(i,:), wwqui_cloudy_cen(i,:), wwqui_cloudy_bnd(i,:), & -#endif - tkez(i,:), tkesgsz(i,:), tk_crm(i, :), & - flux_u(i,:), flux_v(i,:), flux_qt(i,:), fluxsgs_qt(i,:), flux_qp(i,:), & - precflux(i,:), qt_ls(i,:), qt_trans(i,:), qp_trans(i,:), qp_fall(i,:), & - qp_evp(i,:), qp_src(i,:), t_ls(i,:), prectend(i), precstend(i), & - cam_in%ocnfrac(i), wnd, tau00, bflx, & - fluxu0, fluxv0, fluxt0, fluxq0, & - taux_crm(i), tauy_crm(i), z0m(i), timing_factor(i), qtotcrm(i, :) ) - - ! Retrieve the values back out of the internal crm array structure - if (is_spcam_sam1mom) then - crm_qt(i,:,:,:) = crm_micro(i,:,:,:,1) - crm_qp(i,:,:,:) = crm_micro(i,:,:,:,2) - crm_qn(i,:,:,:) = crm_micro(i,:,:,:,3) - else if (is_spcam_m2005) then - crm_qt(i,:,:,:) = crm_micro(i,:,:,:,1) - crm_nc(i,:,:,:) = crm_micro(i,:,:,:,2) - crm_qr(i,:,:,:) = crm_micro(i,:,:,:,3) - crm_nr(i,:,:,:) = crm_micro(i,:,:,:,4) - crm_qi(i,:,:,:) = crm_micro(i,:,:,:,5) - crm_ni(i,:,:,:) = crm_micro(i,:,:,:,6) - crm_qs(i,:,:,:) = crm_micro(i,:,:,:,7) - crm_ns(i,:,:,:) = crm_micro(i,:,:,:,8) - crm_qg(i,:,:,:) = crm_micro(i,:,:,:,9) - crm_ng(i,:,:,:) = crm_micro(i,:,:,:,10) - crm_qc(i,:,:,:) = crm_micro(i,:,:,:,11) - endif - end do ! i (loop over ncol) - - call t_stopf('crm_call') - - ! There is no separate convective and stratiform precip for CRM: - precc(:ncol) = precc(:ncol) + precl(:ncol) - precl(:ncol) = 0._r8 - precsc(:ncol) = precsc(:ncol) + precsl(:ncol) - precsl(:ncol) = 0._r8 - - prec_dp(:ncol)= precc(:ncol) - snow_dp(:ncol)= precsc(:ncol) - - do m=1,crm_nz - k = pver-m+1 - do i = 1,ncol - crm_qrad(i,:,:,m) = crm_qrad(i,:,:,m) * state_loc%pdel(i,k) ! for energy conservation - end do - end do - - call outfld('PRES ',state_loc%pmid ,pcols ,lchnk ) - call outfld('DPRES ',state_loc%pdel ,pcols ,lchnk ) - call outfld('CRM_U ',crm_u ,pcols ,lchnk ) - call outfld('CRM_V ',crm_v ,pcols ,lchnk ) - call outfld('CRM_W ',crm_w ,pcols ,lchnk ) - call outfld('CRM_T ',crm_t ,pcols ,lchnk ) - call outfld('CRM_QC ',qc_crm ,pcols ,lchnk ) - call outfld('CRM_QI ',qi_crm ,pcols ,lchnk ) - call outfld('CRM_QPC ',qpc_crm ,pcols ,lchnk ) - call outfld('CRM_QPI ',qpi_crm ,pcols ,lchnk ) - call outfld('CRM_PREC',prec_crm ,pcols ,lchnk ) - call outfld('CRM_TK ', crm_tk(:, :, :, :) ,pcols ,lchnk ) - call outfld('CRM_TKH', crm_tkh(:, :, :, :) ,pcols ,lchnk ) - - if (is_spcam_sam1mom) then - tmp4d(:ncol,:,:,:) = crm_qt(:ncol,:,:,:)-qc_crm(:ncol,:,:,:)-qi_crm(:ncol,:,:,:) - call outfld('CRM_QV ',tmp4d,pcols ,lchnk ) - else if (is_spcam_m2005) then - tmp4d(:ncol,:,:,:) = crm_qt(:ncol,:,:,:)-qc_crm(:ncol,:,:,:) - call outfld('CRM_QV ',tmp4d, pcols ,lchnk ) - endif - - - if (is_spcam_m2005) then - call outfld('CRM_NC ', crm_nc ,pcols ,lchnk) - call outfld('CRM_NI ', crm_ni ,pcols ,lchnk) - call outfld('CRM_NR ', crm_nr ,pcols ,lchnk) - call outfld('CRM_NS ', crm_ns ,pcols ,lchnk) - call outfld('CRM_NG ', crm_ng ,pcols ,lchnk) - call outfld('CRM_WVAR', wvar_crm ,pcols ,lchnk) - call outfld('CRM_QR ', crm_qr ,pcols ,lchnk) - call outfld('CRM_QS ', crm_qs ,pcols ,lchnk) - call outfld('CRM_QG ', crm_qg ,pcols ,lchnk) - call outfld('CRM_AUT', aut_crm ,pcols ,lchnk) - call outfld('CRM_ACC', acc_crm ,pcols ,lchnk) - call outfld('CRM_EVPC', evpc_crm ,pcols ,lchnk) - call outfld('CRM_EVPR', evpr_crm ,pcols ,lchnk) - call outfld('CRM_MLT', mlt_crm ,pcols ,lchnk) - call outfld('CRM_SUB', sub_crm ,pcols ,lchnk) - call outfld('CRM_DEP', dep_crm ,pcols ,lchnk) - call outfld('CRM_CON', con_crm ,pcols ,lchnk) - - ! output for time-mean-avg - call outfld('A_AUT', aut_crm_a , pcols ,lchnk) - call outfld('A_ACC', acc_crm_a , pcols ,lchnk) - call outfld('A_EVPC', evpc_crm_a , pcols ,lchnk) - call outfld('A_EVPR', evpr_crm_a , pcols ,lchnk) - call outfld('A_MLT', mlt_crm_a , pcols ,lchnk) - call outfld('A_SUB', sub_crm_a , pcols ,lchnk) - call outfld('A_DEP', dep_crm_a , pcols ,lchnk) - call outfld('A_CON', con_crm_a , pcols ,lchnk) - endif - - if(do_clubb_sgs) then - call outfld('UP2 ' , clubb_buffer(:, :, :, :, 1) ,pcols ,lchnk) - call outfld('VP2 ' , clubb_buffer(:, :, :, :, 2) ,pcols ,lchnk) - call outfld('WPRTP ' , clubb_buffer(:, :, :, :, 3) ,pcols ,lchnk) - call outfld('WPTHLP ' , clubb_buffer(:, :, :, :, 4) ,pcols ,lchnk) - call outfld('WP2 ' , clubb_buffer(:, :, :, :, 5) ,pcols ,lchnk) - call outfld('WP3 ' , clubb_buffer(:, :, :, :, 6) ,pcols ,lchnk) - call outfld('RTP2 ' , clubb_buffer(:, :, :, :, 7) ,pcols ,lchnk) - call outfld('THLP2 ' , clubb_buffer(:, :, :, :, 8) ,pcols ,lchnk) - call outfld('RTPTHLP ' , clubb_buffer(:, :, :, :, 9) ,pcols ,lchnk) - call outfld('UPWP ' , clubb_buffer(:, :, :, :, 10) ,pcols ,lchnk) - call outfld('VPWP ' , clubb_buffer(:, :, :, :, 11) ,pcols ,lchnk) - call outfld('CRM_CLD ' , clubb_buffer(:, :, :, :, 12) ,pcols ,lchnk) - call outfld('T_TNDCY ' , clubb_buffer(:, :, :, :, 13) ,pcols ,lchnk) - call outfld('QC_TNDCY' , clubb_buffer(:, :, :, :, 14) ,pcols ,lchnk) - call outfld('QV_TNDCY' , clubb_buffer(:, :, :, :, 15) ,pcols ,lchnk) - call outfld('CLUBB_TK ', clubb_tk(:, :, :, :) ,pcols ,lchnk) - call outfld('CLUBB_TKH', clubb_tkh(:, :, :, :) ,pcols ,lchnk) - call outfld('CRM_RELVAR', relvar(:, :, :, :) ,pcols ,lchnk) - call outfld('QCLVAR' , qclvar(:, :, :, :) ,pcols ,lchnk) - call outfld('ACCRE_ENHAN', accre_enhan(:, :, :, :) ,pcols ,lchnk) - - spup2 = 0.0_r8; spvp2 = 0.0_r8; spwprtp = 0.0_r8; spwpthlp = 0.0_r8 - spwp2 = 0.0_r8; spwp3 = 0.0_r8; sprtp2 = 0.0_r8; spthlp2 = 0.0_r8 - sprtpthlp = 0.0_r8; spupwp = 0.0_r8; spvpwp = 0.0_r8; spcrm_cld = 0.0_r8 - spt_tndcy = 0.0_r8; spqc_tndcy = 0.0_r8; spqv_tndcy = 0.0_r8 - spclubb_tk = 0.0_r8; spclubb_tkh = 0.0_r8 - sprelvar = 0.0_r8; spaccre_enhan = 0.0_r8; spqclvar = 0.0_r8 - - do i=1, ncol - do jj=1, crm_ny - do ii=1, crm_nx - do m=1, crm_nz+1 - k = pver-m+1 - spup2(i,k) = spup2(i,k) + clubb_buffer(i, ii, jj, m, 1) / (crm_nx_ny) - spvp2(i,k) = spvp2(i,k) + clubb_buffer(i, ii, jj, m, 2) / (crm_nx_ny) - spwprtp(i,k) = spwprtp(i,k) + clubb_buffer(i, ii, jj, m, 3) / (crm_nx_ny) - spwpthlp(i,k) = spwpthlp(i,k) + clubb_buffer(i, ii, jj, m, 4) / (crm_nx_ny) - spwp2(i,k) = spwp2(i,k) + clubb_buffer(i, ii, jj, m, 5) / (crm_nx_ny) - spwp3(i,k) = spwp3(i,k) + clubb_buffer(i, ii, jj, m, 6) / (crm_nx_ny) - sprtp2(i,k) = sprtp2(i,k) + clubb_buffer(i, ii, jj, m, 7) / (crm_nx_ny) - spthlp2(i,k) = spthlp2(i,k) + clubb_buffer(i, ii, jj, m, 8) / (crm_nx_ny) - sprtpthlp(i,k) = sprtpthlp(i,k) + clubb_buffer(i, ii, jj, m, 9) / (crm_nx_ny) - spupwp(i,k) = spupwp(i,k) + clubb_buffer(i, ii, jj, m, 10) / (crm_nx_ny) - spupwp(i,k) = spupwp(i,k) + clubb_buffer(i, ii, jj, m, 11) / (crm_nx_ny) - spcrm_cld(i,k) = spcrm_cld(i,k) + clubb_buffer(i, ii, jj, m, 12) / (crm_nx_ny) - spt_tndcy(i,k) = spt_tndcy(i,k) + clubb_buffer(i, ii, jj, m, 13) / (crm_nx_ny) - spqc_tndcy(i,k) = spqc_tndcy(i,k) + clubb_buffer(i, ii, jj, m, 14) / (crm_nx_ny) - spqv_tndcy(i,k) = spqv_tndcy(i,k) + clubb_buffer(i, ii, jj, m, 15) / (crm_nx_ny) - end do - do m=1, crm_nz - k = pver-m+1 - spclubb_tk(i,k) = spclubb_tk(i,k) + clubb_tk(i, ii, jj, m) / (crm_nx_ny) - spclubb_tkh(i,k) = spclubb_tkh(i,k) + clubb_tkh(i, ii, jj, m) / (crm_nx_ny) - sprelvar(i,k) = sprelvar(i,k) + relvar(i, ii, jj, m) / (crm_nx_ny) - spaccre_enhan(i,k) = spaccre_enhan(i,k) + accre_enhan(i, ii, jj, m) / (crm_nx_ny) - spqclvar(i,k) = spqclvar(i,k) + qclvar(i, ii, jj, m) / (crm_nx_ny) - end do - end do - end do - end do - - call outfld('SPUP2', spup2 ,pcols ,lchnk) - call outfld('SPVP2', spvp2 ,pcols ,lchnk) - call outfld('SPWPRTP', spwprtp ,pcols ,lchnk) - call outfld('SPWPTHLP', spwpthlp ,pcols ,lchnk) - call outfld('SPWP2', spwp2 ,pcols ,lchnk) - call outfld('SPWP3', spwp3 ,pcols ,lchnk) - call outfld('SPRTP2', sprtp2 ,pcols ,lchnk) - call outfld('SPTHLP2', spthlp2 ,pcols ,lchnk) - call outfld('SPRTPTHLP', sprtpthlp ,pcols ,lchnk) - call outfld('SPUPWP', spupwp ,pcols ,lchnk) - call outfld('SPVPWP', spvpwp ,pcols ,lchnk) - call outfld('SPCRM_CLD', spcrm_cld ,pcols ,lchnk) - call outfld('SPT_TNDCY', spt_tndcy ,pcols ,lchnk) - call outfld('SPQC_TNDCY', spqc_tndcy ,pcols ,lchnk) - call outfld('SPQV_TNDCY', spqv_tndcy ,pcols ,lchnk) - call outfld('SPCLUBB_TK ', spclubb_tk ,pcols ,lchnk) - call outfld('SPCLUBB_TKH', spclubb_tkh ,pcols ,lchnk) - call outfld('SPRELVAR', sprelvar ,pcols, lchnk) - call outfld('SPACCRE_ENHAN', spaccre_enhan ,pcols, lchnk) - call outfld('SPQCLVAR', spqclvar ,pcols, lchnk) - endif ! if do_clubb_sgs - - spcld3d = 0.0_r8 - do i=1, ncol - do jj=1, crm_ny - do ii=1, crm_nx - do m=1, crm_nz - k = pver-m+1 - spcld3d(i,k) = spcld3d(i,k) + cld3d_crm(i,ii,jj,m) / (crm_nx_ny) - end do - end do - end do - end do - call outfld('SPCLD3D', spcld3d, pcols, lchnk) - - ifld = pbuf_get_index('QRL') - call pbuf_get_field(pbuf, ifld, qrl) - ifld = pbuf_get_index('QRS') - call pbuf_get_field(pbuf, ifld, qrs) - do k =1 , pver - do i = 1, ncol - qrs(i,k) = qrs(i,k)/state_loc%pdel(i,k) - qrl(i,k) = qrl(i,k)/state_loc%pdel(i,k) - end do - end do - - ! - ! add radiation tendencies to levels above CRM domain and 2 top CRM levels - ! The radiation tendencies in the top 4 GCM levels are set to be zero in the CRM - ptend_loc%s(:ncol, :pver-crm_nz+2) = qrs(:ncol,:pver-crm_nz+2)+qrl(:ncol,:pver-crm_nz+2) - - - ! calculate the radiative fluxes from the radiation calculation - ! This will be used to check energe conservations - radflux(:) = 0.0_r8 - do k=1, pver - do i=1, ncol - radflux(i) = radflux(i) + (qrs(i,k)+qrl(i,k)) * state_loc%pdel(i,k)/gravit - end do - end do - - ftem(:ncol,:pver) = (ptend_loc%s(:ncol,:pver)-qrs(:ncol,:pver)-qrl(:ncol,:pver))/cpair - - tmp2d(:ncol,:) = qrl(:ncol,:)/cpair - call outfld('SPQRL ',tmp2d ,pcols ,lchnk) - - tmp2d(:ncol,:) = qrs(:ncol,:)/cpair - call outfld('SPQRS ',tmp2d ,pcols ,lchnk) - - call outfld('SPDT ',ftem ,pcols ,lchnk) - call outfld('SPDQ ',ptend_loc%q(1,1,1) ,pcols ,lchnk) - call outfld('SPDQC ',ptend_loc%q(1,1,ixcldliq) ,pcols ,lchnk) - call outfld('SPDQI ',ptend_loc%q(1,1,ixcldice) ,pcols ,lchnk) - call outfld('SPMC ',mctot ,pcols ,lchnk) - call outfld('SPMCUP ',mcup ,pcols ,lchnk) - call outfld('SPMCDN ',mcdn ,pcols ,lchnk) - call outfld('SPMCUUP ',mcuup ,pcols ,lchnk) - call outfld('SPMCUDN ',mcudn ,pcols ,lchnk) - call outfld('SPQC ',spqc ,pcols ,lchnk) - call outfld('SPQI ',spqi ,pcols ,lchnk) - call outfld('SPQS ',spqs ,pcols ,lchnk) - call outfld('SPQG ',spqg ,pcols ,lchnk) - call outfld('SPQR ',spqr ,pcols ,lchnk) - call outfld('SPQTFLX ',flux_qt ,pcols ,lchnk) - call outfld('SPUFLX ',flux_u ,pcols ,lchnk) - call outfld('SPVFLX ',flux_v ,pcols ,lchnk) - call outfld('SPTKE ',tkez ,pcols ,lchnk) - call outfld('SPTKES ',tkesgsz ,pcols ,lchnk) - call outfld('SPTK ',tk_crm ,pcols ,lchnk) - call outfld('SPQTFLXS',fluxsgs_qt ,pcols ,lchnk) - call outfld('SPQPFLX ',flux_qp ,pcols ,lchnk) - call outfld('SPPFLX ',precflux ,pcols ,lchnk) - call outfld('SPQTLS ',qt_ls ,pcols ,lchnk) - call outfld('SPQTTR ',qt_trans ,pcols ,lchnk) - call outfld('SPQPTR ',qp_trans ,pcols ,lchnk) - call outfld('SPQPEVP ',qp_evp ,pcols ,lchnk) - call outfld('SPQPFALL',qp_fall ,pcols ,lchnk) - call outfld('SPQPSRC ',qp_src ,pcols ,lchnk) - call outfld('SPTLS ',t_ls ,pcols ,lchnk) - call outfld('CLOUDTOP',cldtop ,pcols ,lchnk) - call outfld('TIMINGF ',timing_factor ,pcols ,lchnk) - - if (is_spcam_m2005) then - call outfld('SPNC ',spnc ,pcols ,lchnk) - call outfld('SPNI ',spni ,pcols ,lchnk) - call outfld('SPNS ',spns ,pcols ,lchnk) - call outfld('SPNG ',spng ,pcols ,lchnk) - call outfld('SPNR ',spnr ,pcols ,lchnk) - endif - - if (.not. do_clubb_sgs) then - call outfld('CLDTOT ',cltot ,pcols,lchnk) - call outfld('CLDHGH ',clhgh ,pcols,lchnk) - call outfld('CLDMED ',clmed ,pcols,lchnk) - call outfld('CLDLOW ',cllow ,pcols,lchnk) - call outfld('CLOUD ',cld, pcols,lchnk) - end if - - ! - ! Compute liquid water paths (for diagnostics only) - tgicewp(:ncol) = 0._r8 - tgliqwp(:ncol) = 0._r8 - do k=1,pver - do i = 1,ncol - cicewp(i,k) = gicewp(i,k) * 1.0e-3_r8 / max(0.01_r8,cld(i,k)) ! In-cloud ice water path. g/m2 --> kg/m2 - cliqwp(i,k) = gliqwp(i,k) * 1.0e-3_r8 / max(0.01_r8,cld(i,k)) ! In-cloud liquid water path. g/m2 --> kg/m2 - tgicewp(i) = tgicewp(i) + gicewp(i,k) *1.0e-3_r8 ! grid cell mean ice water path. g/m2 --> kg/m2 - tgliqwp(i) = tgliqwp(i) + gliqwp(i,k) *1.0e-3_r8 ! grid cell mean ice water path. g/m2 --> kg/m2 - end do - end do - tgwp(:ncol) = tgicewp(:ncol) + tgliqwp(:ncol) - gwp(:ncol,:pver) = gicewp(:ncol,:pver) + gliqwp(:ncol,:pver) - cwp(:ncol,:pver) = cicewp(:ncol,:pver) + cliqwp(:ncol,:pver) - - - call outfld('SPCLDTOT',cltot ,pcols,lchnk) - call outfld('SPCLDHGH',clhgh ,pcols,lchnk) - call outfld('SPCLDMED',clmed ,pcols,lchnk) - call outfld('SPCLDLOW',cllow ,pcols,lchnk) - - if(do_clubb_sgs) then - ! Determine parameters for maximum/random overlap -#ifdef SPCAM_CLUBB_SGS - call cldovrlap(lchnk, ncol, state%pint, cld, nmxrgn, pmxrgn) - call cloud_cover_diags_out(lchnk, ncol, cld, state%pmid, nmxrgn, pmxrgn ) -#endif - deallocate(pmxrgn) - deallocate(nmxrgn) - deallocate(spup2) - deallocate(spvp2) - deallocate(spwprtp) - deallocate(spwpthlp) - deallocate(spwp2) - deallocate(spwp3) - deallocate(sprtp2) - deallocate(spthlp2) - deallocate(sprtpthlp) - deallocate(spupwp) - deallocate(spvpwp) - deallocate(spcrm_cld) - deallocate(spt_tndcy) - deallocate(spqv_tndcy) - deallocate(spqc_tndcy) - deallocate(spclubb_tk) - deallocate(spclubb_tkh) - deallocate(sprelvar) - deallocate(spaccre_enhan) - deallocate(spqclvar) - deallocate(crm_cld) - deallocate(clubb_tk) - deallocate(clubb_tkh) - deallocate(relvar) - deallocate(accre_enhan) - deallocate(qclvar) - endif - - call outfld('CLOUDTOP',cldtop, pcols,lchnk) - call outfld('GCLDLWP' ,gwp , pcols,lchnk) - call outfld('TGCLDCWP',tgwp , pcols,lchnk) - call outfld('TGCLDLWP',tgliqwp, pcols,lchnk) - call outfld('TGCLDIWP',tgicewp, pcols,lchnk) - call outfld('ICLDTWP' ,cwp , pcols,lchnk) - call outfld('ICLDIWP' ,cicewp , pcols,lchnk) - - ! Calculate fields which are needed elsewhere in CAM - call pbuf_get_Field(pbuf, ast_idx, cld) ! AST gets values in cld - - ! Find the cldtop for the physics buffer looking for the first location that has a value in the CRM cldtop field - call pbuf_get_field(pbuf, cldtop_idx, cldtop_pbuf) - cldtop_pbuf = pver - do i=1,ncol - do k=1,pver - if (cldtop(i,k) > 1._r8/(crm_nx_ny)) then - cldtop_pbuf(i)=k - exit - end if - end do - end do - - cs(:ncol, 1:pver) = state_loc%pmid(:ncol, 1:pver) / (287.15_r8*state_loc%t(:ncol, 1:pver)) - - call pbuf_get_Field(pbuf, wsedl_idx, wsedl) - if (is_spcam_m2005) then - dunc_arr(:,:) = state_loc%q(:,:,ixnumliq)/ max(mincld,cld(:,:)) - else - dunc_arr(:ncol,1:pver) = 100.e6_r8 / cs(:ncol,1:pver) - end if - do i=1,ncol - do k=1,pver - t = state_loc%t(i,k) - mu = 1.496e-6_r8 * t**1.5_r8/(t+120._r8) - acn = gravit*rhow/(18._r8*mu) - dumc = min( state_loc%q(i,k,ixcldliq) / max(mincld,cld(i,k)),0.005_r8 ) - dunc = dunc_arr(i,k) - call size_dist_param_liq(mg_liq_props, dumc,dunc,cs(i,k),pgam,lamc) - if (dumc >= qsmall) then - wsedl(i,k)=acn*gamma(4._r8+bc+pgam)/(lamc**bc*gamma(pgam+4._r8)) - else - wsedl(i,k)=0._r8 - endif - end do - end do - - if (is_spcam_m2005) then - - ! For convective transport - do i=1, ncol - ideep_crm(i) = i*1.0_r8 - end do - endif - call outfld('MU_CRM ', mu_crm, pcols, lchnk) - call outfld('MD_CRM ', md_crm, pcols, lchnk) - call outfld('EU_CRM ', eu_crm, pcols, lchnk) - call outfld('DU_CRM ', du_crm, pcols, lchnk) - call outfld('ED_CRM ', ed_crm, pcols, lchnk) - -! NAG requires ifdef because tk_crm_ecpp dereferened when not allocated -#ifdef m2005 - if (is_spcam_m2005) then - - qlsinkcen = qlsink_avgcen - - ! copy local tk_crm into pbuf copy - tk_crm_ecpp = tk_crm - - call outfld('ACEN ' , acen , pcols, lchnk) - call outfld('ABND ' , abnd , pcols, lchnk) - call outfld('ACEN_TF ' , acen_tf , pcols, lchnk) - call outfld('ABND_TF ' , abnd_tf , pcols, lchnk) - call outfld('MASFBND ' , massflxbnd , pcols, lchnk) - call outfld('RHCEN ' , rhcen , pcols, lchnk) - call outfld('QCCEN ' , qcloudcen , pcols, lchnk) - call outfld('QICEN ' , qicecen , pcols, lchnk) - call outfld('QSINK_AFCEN' , qlsink_afcen , pcols, lchnk) - call outfld('PRECRCEN' , precrcen , pcols, lchnk) - call outfld('PRECSCEN' , precsolidcen , pcols, lchnk) - call outfld('WUPTHRES' , wupthresh_bnd , pcols, lchnk) - call outfld('WDNTHRES' , wdownthresh_bnd , pcols, lchnk) - call outfld('WWQUI_CEN' , wwqui_cen , pcols, lchnk) - call outfld('WWQUI_CLD_CEN', wwqui_cloudy_cen , pcols, lchnk) - call outfld('WWQUI_BND' , wwqui_bnd , pcols, lchnk) - call outfld('WWQUI_CLD_BND', wwqui_cloudy_bnd , pcols, lchnk) - call outfld('QSINK_BFCEN' , qlsink_bfcen , pcols, lchnk) - call outfld('QSINK_AVGCEN' , qlsink_avgcen , pcols, lchnk) - call outfld('PRAINCEN' , praincen , pcols, lchnk) - endif -#endif - - if (is_spcam_m2005) then - call cnst_get_ind('NUMLIQ', ixnumliq) - call cnst_get_ind('NUMICE', ixnumice) - ptend_loc%lq(ixnumliq) = .TRUE. - ptend_loc%lq(ixnumice) = .TRUE. - ptend_loc%q(:, :, ixnumliq) = 0._r8 - ptend_loc%q(:, :, ixnumice) = 0._r8 - - do i = 1, ncol - do k=1, crm_nz - m= pver-k+1 - do ii=1, crm_nx - do jj=1, crm_ny - ptend_loc%q(i,m,ixnumliq) = ptend_loc%q(i,m,ixnumliq) + crm_nc(i,ii,jj,k) - ptend_loc%q(i,m,ixnumice) = ptend_loc%q(i,m,ixnumice) + crm_ni(i,ii,jj,k) - end do - end do - ptend_loc%q(i,m,ixnumliq) = (ptend_loc%q(i,m,ixnumliq)/(crm_nx_ny) - state_loc%q(i,m,ixnumliq))/ztodt - ptend_loc%q(i,m,ixnumice) = (ptend_loc%q(i,m,ixnumice)/(crm_nx_ny) - state_loc%q(i,m,ixnumice))/ztodt - end do - end do - end if - - ! Sum into overall ptend - call physics_ptend_sum(ptend_loc, ptend, ncol) - - call physics_update(state_loc, ptend_loc, ztodt, tend_loc) - - ! calculate column water of rain, snow and graupel - if(is_spcam_m2005) then - do i=1, ncol - qt_hydro(i, 2) = 0.0_r8 - qli_hydro(i, 2) = 0.0_r8 - qi_hydro(i, 2) = 0.0_r8 - qtot(i, 3) = 0.0_r8 - qt_cloud(i, 3) = 0.0_r8 - qtv(i, 3) = 0.0_r8 - do m=1, crm_nz - k=pver-m+1 - do ii=1, crm_nx - do jj=1, crm_ny - qt_hydro(i,2) = qt_hydro(i,2) + (crm_qr(i,ii,jj,m)+crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * & - state_loc%pdel(i,k)/gravit - qli_hydro(i,2) = qli_hydro(i,2) + (crm_qr(i,ii,jj,m)+crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * & - state_loc%pdel(i,k)/gravit - qi_hydro(i,2) = qi_hydro(i,2) + (crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * & - state_loc%pdel(i,k)/gravit - qtot(i, 3) = qtot(i,3) + (crm_qr(i,ii,jj,m)+crm_qs(i,ii,jj,m)+crm_qg(i,ii,jj,m)) * & - state_loc%pdel(i,k)/gravit + (crm_qt(i,ii,jj,m)+crm_qi(i,ii,jj,m)) * state_loc%pdel(i,k)/gravit - qt_cloud(i, 3) = qt_cloud(i, 3) + (crm_qt(i,ii,jj,m)+crm_qi(i,ii,jj,m)) * & - state_loc%pdel(i,k)/gravit - end do - end do - end do - qt_hydro(i,2) = qt_hydro(i,2) / (crm_nx_ny) - qli_hydro(i,2) = qli_hydro(i,2) / (crm_nx_ny) - qi_hydro(i,2) = qi_hydro(i,2) / (crm_nx_ny) - qtot(i, 3) = qtot(i, 3) / (crm_nx_ny) - qt_cloud(i, 3) = qt_cloud(i, 3) / (crm_nx_ny) - end do - else if(is_spcam_sam1mom) then - do i=1, ncol - qli_hydro(i, 2) = 0.0_r8 - qi_hydro(i, 2) = 0.0_r8 - do m=1, crm_nz - k=pver-m+1 - do ii=1, crm_nx - do jj=1, crm_ny - sfactor = max(0._r8,min(1._r8,(crm_t(i,ii,jj,m)-268.16_r8)*1._r8/(283.16_r8-268.16_r8))) - qli_hydro(i,2) = qli_hydro(i,2)+crm_qp(i,ii,jj,m) * state_loc%pdel(i,k)/gravit - qi_hydro(i,2) = qi_hydro(i,2) +crm_qp(i,ii,jj,m) * (1-sfactor) * state_loc%pdel(i,k)/gravit - end do - end do - end do - qli_hydro(i,2) = qli_hydro(i,2) / (crm_nx_ny) - qi_hydro(i,2) = qi_hydro(i,2) / (crm_nx_ny) - - ! total cloud water and total water vapor, and energy - qt_cloud(i,2) = 0._r8 - qtv(i,2) = 0._r8 - do k=1, pver - qt_cloud(i,2) = qt_cloud(i,2) + (state_loc%q(i,k,ixcldliq)+state_loc%q(i,k,ixcldice)) * state_loc%pdel(i,k)/gravit - qtv(i,2) = qtv(i,2) + state_loc%q(i,k,1) * state_loc%pdel(i,k)/gravit - end do - end do - end if - - ! check water and energy conservation - call check_energy_chng(state_loc, tend_loc, "crm_tend", nstep, ztodt, zero, & - prec_dp(:ncol)+(qli_hydro(:ncol,2)-qli_hydro(:ncol,1))/ztodt/1000._r8, & - snow_dp(:ncol)+(qi_hydro(:ncol,2)-qi_hydro(:ncol,1))/ztodt/1000._r8, radflux) - - ! - ! calculate total water after crm update - ! total hydrometer water (rain, snow, and graupel) - if (is_spcam_m2005) then - do i=1, ncol - - ! total cloud water and total water vapor - qt_cloud(i,2) = 0._r8 - qtv(i,2) = 0._r8 - do k=1, pver - qt_cloud(i,2) = qt_cloud(i,2) + (state_loc%q(i,k,ixcldliq)+state_loc%q(i,k,ixcldice)) * state_loc%pdel(i,k)/gravit - qtv(i,2) = qtv(i,2) + state_loc%q(i,k,1) * state_loc%pdel(i,k)/gravit - end do - ! total water - qtot(i,2) = qt_hydro(i,2) + qt_cloud(i,2) + qtv(i,2) - - ! to check water conservations - if(abs((qtot(i,2)+(precc(i)+precl(i))*1000_r8*ztodt)-qtot(i,1))/qtot(i,1).gt.1.0e-5_r8) then - write(0, *) 'water before crm call', i, lchnk, qtot(i,1), qtv(i,1), qt_cloud(i,1), qt_hydro(i,1) - write(0, *) 'water after crm call', i, lchnk, qtot(i,2)+(precc(i)+precl(i))*1000*ztodt, & - qtv(i,2), qt_cloud(i,2), qt_hydro(i,2), (precc(i)+precl(i))*1000*ztodt - write(0, *) 'water, nstep, crm call2', nstep, i, lchnk, & - ((qtot(i,2)+(precc(i)+precl(i))*1000_r8*ztodt)-qtot(i,1))/qtot(i,1) - write(0, *) 'water, calcualted in crm.F90', i, lchnk, qtotcrm(i, 1), qtotcrm(i, 9), & - qtot(i, 3)+(precc(i)+precl(i))*1000_r8*ztodt, qt_cloud(i, 3), qtv(i,2)+qt_cloud(i,2) - write(0, *) 'water, temperature', i, lchnk, state_loc%t(i,pver) - end if - end do ! end i - endif - - end if ! (is_first_step()) - - call t_stopf('crm') - -! ifdef needed because of use of dtstep_pp_input and spcam_modal_aero_wateruptake_dr -#ifdef m2005 - if (is_spcam_m2005) then - call t_startf('bc_aerosols_mmf') - - where(qc_rad(:ncol,:,:,:crm_nz)+qi_rad(:ncol,:,:,:crm_nz) > 1.0e-10_r8) - cld_rad(:ncol,:,:,:crm_nz) = cld_rad(:ncol,:,:,:crm_nz) - elsewhere - cld_rad(:ncol,:,:,:crm_nz) = 0.0_r8 - endwhere - - ! temporarily turn on all lq, so it is allocated - lq(:) = .true. - call physics_ptend_init(ptend_loc, state_loc%psetcols, 'crm_physics', lq=lq) - - ! set all ptend%lq to false as they will be set in modal_aero_calcsize_sub - ptend%lq(:) = .false. - call modal_aero_calcsize_sub (state_loc, ptend_loc, ztodt, pbuf) - call spcam_modal_aero_wateruptake_dr(state_loc, pbuf) - - ! Wet deposition is done in ECPP, - ! So tendency from wet depostion is not updated in mz_aero_wet_intr (mz_aerosols_intr.F90) - ! tendency from other parts of crmclouds_aerosol_wet_intr are still updated here. - - ! Sum into overall ptend - call physics_ptend_sum(ptend_loc, ptend, ncol) - call physics_update(state_loc, ptend_loc, ztodt, tend_loc) - - - pblh_idx = pbuf_get_index('pblh') - call pbuf_get_field(pbuf, pblh_idx, pblh) - - ! - ! ECPP is called at every 3rd GCM time step. - ! GCM time step is 10 minutes, and ECPP time step is 30 minutes. - ! - dtstep_pp = dtstep_pp_input - necpp = dtstep_pp/ztodt - - ! Only call ECPP every necpp th time step - ! !!!BE CAUTIOUS (Minghuai Wang, 2017-02)!!!!: - ! ptend_loc from crmclouds_mixnuc_tend and parampollu_driver2 has - ! to be multiplied by necpp, as the updates in state occure in tphysbc_spcam, - ! and the normal time step used in tphysbc_spcam is short - ! and ECPP time step is longer (by a facotr of ncecpp). - ! Otherwise, this will lead to underestimation in wet scavenging. - ! - if(nstep.ne.0 .and. mod(nstep, necpp).eq.0) then - call t_startf('crmclouds_mixnuc') - - call crmclouds_mixnuc_tend (state_loc, ptend_loc, dtstep_pp, cam_in%cflx, pblh, pbuf, & - wwqui_cen, wwqui_cloudy_cen, wwqui_bnd, wwqui_cloudy_bnd) - - ! scale ptend_loc by necpp - call physics_ptend_scale(ptend_loc, necpp*1.0_r8, ncol) - ! Sum into overall ptend - call physics_ptend_sum(ptend_loc, ptend, ncol) - call physics_update(state_loc, ptend_loc, ztodt, tend_loc) - call t_stopf('crmclouds_mixnuc') - - call t_startf('ecpp') - call parampollu_driver2(state_loc, ptend_loc, pbuf, dtstep_pp, dtstep_pp, & - acen, abnd, acen_tf, abnd_tf, massflxbnd, & - rhcen, qcloudcen, qlsinkcen, precrcen, precsolidcen, acldy_cen_tbeg ) - ! scale ptend_loc by necpp - call physics_ptend_scale(ptend_loc, necpp*1.0_r8, ncol) - ! Sum into overall ptend - call physics_ptend_sum(ptend_loc, ptend, ncol) - call physics_update(state_loc, ptend_loc, ztodt, tend_loc) - call t_stopf ('ecpp') - end if - - - call t_stopf('bc_aerosols_mmf') - endif ! /*m2005*/ -#endif - - ! save for old cloud fraction in the MMF simulations - cldo(:ncol, :) = cld(:ncol, :) - - deallocate(crm_micro) - - if (is_spcam_m2005) then - deallocate(acen) - deallocate(acen_tf) - deallocate(rhcen) - deallocate(qcloudcen) - deallocate(qlsinkcen) - deallocate(precrcen) - deallocate(precsolidcen) - deallocate(wwqui_cen) - deallocate(wwqui_cloudy_cen) - deallocate(abnd) - deallocate(abnd_tf) - deallocate(massflxbnd) - deallocate(wwqui_bnd) - deallocate(wwqui_cloudy_bnd) - deallocate(qicecen) - deallocate(qlsink_afcen) - deallocate(qlsink_bfcen) - deallocate(qlsink_avgcen) - deallocate(praincen) - deallocate(wupthresh_bnd) - deallocate(wdownthresh_bnd) - - deallocate(na) - deallocate(va) - deallocate(hy) - deallocate(naermod) - deallocate(vaerosol) - deallocate(hygro) - end if - -#endif - -end subroutine crm_physics_tend - -!===================================================================================================== - -subroutine m2005_effradius(ql, nl,qi,ni,qs, ns, cld, pres, tk, effl, effi, effl_fn, deffi, lamcrad, pgamrad, des) -!----------------------------------------------------------------------------------------------------- -! -! This subroutine is used to calculate droplet and ice crystal effective radius, which will be used -! in the CAM radiation code. The method to calcualte effective radius is taken out of the Morrision's -! two momenent scheme from M2005MICRO_GRAUPEL. It is also very similar with the subroutine of effradius in -! the module of cldwat2m in the CAM source codes. -! -! Adopted by Minghuai Wang (Minghuai.Wang@pnl.gov). -! -!----------------------------------------------------------------------------------------------------- - ! ----------------------------------------------------------- ! - ! Calculate effective radius for pass to radiation code ! - ! If no cloud water, default value is 10 micron for droplets, ! - ! 25 micron for cloud ice. ! - ! Be careful of the unit of effective radius : [micro meter] ! - ! ----------------------------------------------------------- ! - use shr_spfn_mod, only: gamma => shr_spfn_gamma - implicit none - - real(r8), intent(in) :: ql ! Mean LWC of pixels [ kg/kg ] - real(r8), intent(in) :: nl ! Grid-mean number concentration of cloud liquid droplet [#/kg] - real(r8), intent(in) :: qi ! Mean IWC of pixels [ kg/kg ] - real(r8), intent(in) :: ni ! Grid-mean number concentration of cloud ice droplet [#/kg] - real(r8), intent(in) :: qs ! mean snow water content [kg/kg] - real(r8), intent(in) :: ns ! Mean snow crystal number concnetration [#/kg] - real(r8), intent(in) :: cld ! Physical stratus fraction - real(r8), intent(in) :: pres ! Air pressure [Pa] - real(r8), intent(in) :: tk ! air temperature [K] - - real(r8), intent(out) :: effl ! Effective radius of cloud liquid droplet [micro-meter] - real(r8), intent(out) :: effi ! Effective radius of cloud ice droplet [micro-meter] - real(r8), intent(out) :: effl_fn ! effl for fixed number concentration of nlic = 1.e8 - real(r8), intent(out) :: deffi ! ice effective diameter for optics (radiation) - real(r8), intent(out) :: pgamrad ! gamma parameter for optics (radiation) - real(r8), intent(out) :: lamcrad ! slope of droplet distribution for optics (radiation) - real(r8), intent(out) :: des ! snow effective diameter for optics (radiation) [micro-meter] - -#ifdef CRM - real(r8) qlic ! In-cloud LWC [kg/m3] - real(r8) qiic ! In-cloud IWC [kg/m3] - real(r8) nlic ! In-cloud liquid number concentration [#/kg] - real(r8) niic ! In-cloud ice number concentration [#/kg] - - real(r8) cldm ! Constrained stratus fraction [no] - real(r8) mincld ! Minimum stratus fraction [no] - - real(r8) lami, laml, lammax, lammin, pgam, lams, lammaxs, lammins - - real(r8) dcs !autoconversion size threshold [meter] - real(r8) di, ci ! cloud ice mass-diameter relationship - real(r8) ds, cs ! snow crystal mass-diameter relationship - real(r8) qsmall - real(r8) rho ! air density [kg/m3] - real(r8) rhow ! liquid water density [kg/m3] - real(r8) rhoi ! ice density [kg/m3] - real(r8) rhos ! snow density [kg/m3] - real(r8) res ! effective snow diameters - real(r8) pi - - ! ---------------- ! - ! Main computation ! - ! ---------------- ! - - pi = 3.1415926535897932384626434_r8 - qsmall = 1.0e-14_r8 ! in the SAM source code (module_mp_graupel) - rhow = 997._r8 ! in module_mp_graupel, SAM - rhoi = 500._r8 ! in both CAM and SAM - - dcs = 125.e-6_r8 ! in module_mp_graupel, SAM - ci = rhoi * pi/6._r8 - di = 3._r8 - - ! for snow water - rhos = 100._r8 ! in both SAM and CAM5 - cs = rhos*pi/6._r8 - ds = 3._r8 - - - rho = pres / (287.15_r8*tk) ! air density [kg/m3] - - mincld = 0.0001_r8 - cldm = max(cld,mincld) - qlic = min(5.e-3_r8,max(0._r8,ql/cldm)) - qiic = min(5.e-3_r8,max(0._r8,qi/cldm)) - nlic = max(nl,0._r8)/cldm - niic = max(ni,0._r8)/cldm - -!------------------------------------------------------ -! Effective diameters of snow crystals -!------------------------------------------------------ - if(qs.gt.1.0e-7_r8) then - lammaxs=1._r8/10.e-6_r8 - lammins=1._r8/2000.e-6_r8 - lams = (gamma(1._r8+ds)*cs * ns/qs)**(1._r8/ds) - lams = min(lammaxs,max(lams,lammins)) - res = 1.5_r8/lams*1.0e6_r8 - else - res = 500._r8 - end if - - ! - ! from Hugh Morrision: rhos/917 accouts for assumptions about - ! ice density in the Mitchell optics. - ! - des = res * rhos/917._r8 *2._r8 - - ! ------------------------------------- ! - ! Effective radius of cloud ice droplet ! - ! ------------------------------------- ! - - if( qiic.ge.qsmall ) then - niic = min(niic,qiic*1.e20_r8) - lammax = 1._r8/1.e-6_r8 ! in module_mp_graupel, SAM - lammin = 1._r8/(2._r8*dcs+100.e-6_r8) ! in module_mp_graupel, SAM - lami = (gamma(1._r8+di)*ci*niic/qiic)**(1._r8/di) - lami = min(lammax,max(lami,lammin)) - effi = 1.5_r8/lami*1.e6_r8 - else - effi = 25._r8 - endif - - !--hm ice effective radius for david mitchell's optics - !--ac morrison indicates that this is effective diameter - !--ac morrison indicates 917 (for the density of pure ice..) - deffi = effi *rhoi/917._r8*2._r8 - - ! ---------------------------------------- ! - ! Effective radius of cloud liquid droplet ! - ! ---------------------------------------- ! - - if( qlic.ge.qsmall ) then - ! Matin et al., 1994 (JAS) formula for pgam (the same is used in both CAM and SAM). - ! See also Morrison and Grabowski (2007, JAS, Eq. (2)) - nlic = min(nlic,qlic*1.e20_r8) - - ! set the minimum droplet number as 20/cm3. - - pgam = 0.0005714_r8*(nlic*rho/1.e6_r8) + 0.2714_r8 - pgam = 1._r8/(pgam**2)-1._r8 - pgam = min(10._r8,max(pgam,2._r8)) ! in module_mp_graupel, SAM - laml = (pi/6._r8*rhow*nlic*gamma(pgam+4._r8)/(qlic*gamma(pgam+1._r8)))**(1._r8/3._r8) - lammin = (pgam+1._r8)/50.e-6_r8 ! in cldwat2m, CAM - lammax = (pgam+1._r8)/2.e-6_r8 ! in cldwat2m, CAM ! cldwat2m should be used, - ! if lammax is too large, this will lead to crash in - ! src/physics/rrtmg/cloud_rad_props.F90 because - ! klambda-1 can be zero in gam_liquid_lw and gam_liquid_sw - ! and g_lambda(kmu,klambda-1) will not be defined. - - laml = min(max(laml,lammin),lammax) - effl = gamma(pgam+4._r8)/gamma(pgam+3._r8)/laml/2._r8*1.e6_r8 ! in module_mp_graupel, SAM - lamcrad = laml - pgamrad = pgam - else - ! chose 10. over 25, since 10 is a more reasonable value for liquid droplet - effl = 10._r8 ! in cldwat2m, CAM - lamcrad = 0.0_r8 - pgamrad = 0.0_r8 - endif - - ! ---------------------------------------------------------------------- ! - ! Recalculate effective radius for constant number, in order to separate ! - ! first and second indirect effects. Assume constant number of 10^8 kg-1 ! - ! ---------------------------------------------------------------------- ! - - nlic = 1.e8_r8 - if( qlic.ge.qsmall ) then - ! Matin et al., 1994 (JAS) formula for pgam (the same is used in both CAM and SAM). - ! See also Morrison and Grabowski (2007, JAS, Eq. (2)) - nlic = min(nlic,qlic*1.e20_r8) - pgam = 0.0005714_r8*(nlic/1.e6_r8/rho) + 0.2714_r8 - pgam = 1._r8/(pgam**2)-1._r8 - pgam = min(10._r8,max(pgam,2._r8)) ! in module_mp_graupel, SAM - laml = (pi/6._r8*rhow*nlic*gamma(pgam+4._r8)/(qlic*gamma(pgam+1._r8)))**(1._r8/3._r8) - lammin = (pgam+1._r8)/60.e-6_r8 ! in module_mp_graupel, SAM - lammax = (pgam+1._r8)/1.e-6_r8 ! in module_mp_graupel, SAM - - laml = min(max(laml,lammin),lammax) - effl_fn = gamma(pgam+4._r8)/gamma(pgam+3._r8)/laml/2._r8*1.e6_r8 ! in module_mp_graupel, SAM - else - ! chose 10. over 25, since 10 is a more reasonable value for liquid droplet. - effl_fn = 10._r8 ! in cldwat2m, CAM - endif - - return -#endif -end subroutine m2005_effradius - -end module crm_physics diff --git a/src/physics/spcam/crmclouds_camaerosols.F90 b/src/physics/spcam/crmclouds_camaerosols.F90 deleted file mode 100644 index 5b480a8329..0000000000 --- a/src/physics/spcam/crmclouds_camaerosols.F90 +++ /dev/null @@ -1,744 +0,0 @@ -module crmclouds_camaerosols -#if (defined CRM) -#if (defined MODAL_AERO) -!--------------------------------------------------------------------------------------------- -! Purpose: -! -! Provides the necessary subroutines to use cloud fields from the CRM model to drive the -! aerosol-related subroutines in CAM. Several taskes: -! i) to fill the physics buffers with those diagnosed from the CRM clouds. -! ii) to provide the interface for some physics prcoesses, such as droplet activaiton, -! and convetive transport. -! -! An alternative (and better?) approach is to use the ECPP (explicit-cloud parameterized-pollutant). -! This will be done later. -! -! Revision history: -! July, 27, 2009: Minghuai Wang -! -!-------------------------------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid - use cam_abortutils, only: endrun - use crmdims, only: crm_nx, crm_ny, crm_nz - use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index, pbuf_old_tim_idx - use physics_types, only: physics_state, physics_state_copy, physics_ptend - use ref_pres, only: top_lev => clim_modal_aero_top_lev - use wv_saturation, only: qsat_water - implicit none - private - save - - public :: spcam_modal_aero_wateruptake_dr - public :: crmclouds_mixnuc_tend - public :: crmclouds_diag - public :: crmclouds_convect_tend - -!====================================================================================================== -contains - -subroutine spcam_modal_aero_wateruptake_dr(state,pbuf) - -!----------------------------------------------------------------------- -! -! SPCAM specific driver for modal aerosol water uptake code. -! -!----------------------------------------------------------------------- - - use time_manager, only: is_first_step - use modal_aero_wateruptake,only: modal_aero_wateruptake_sub - use physconst, only: pi, rhoh2o - use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_props, rad_cnst_get_aer_props - - - ! Arguments - type(physics_state), target, intent(in) :: state ! Physics state variables - type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer - - ! local variables - - real(r8), parameter :: third = 1._r8/3._r8 - real(r8), parameter :: pi43 = pi*4.0_r8/3.0_r8 - - integer :: ncol ! number of columns - - integer :: i, k, m - integer :: nmodes - integer :: nspec - integer :: mm - - integer :: dgnumwet_idx, qaerwat_idx, wetdens_ap_idx, cld_idx - - integer :: dgnum_idx = 0 - integer :: hygro_idx = 0 - integer :: dryvol_idx = 0 - integer :: dryrad_idx = 0 - integer :: drymass_idx = 0 - integer :: so4dryvol_idx = 0 - integer :: naer_idx = 0 - - real(r8), allocatable :: wtrvol_grid(:,:,:) ! single-particle-mean water volume in wet aerosol (m3) - real(r8), allocatable :: wetvol_grid(:,:,:) ! single-particle-mean wet volume (m3) - real(r8), allocatable :: ncount_clear(:,:,:) ! to count the fraction of clear sky part - - real(r8), pointer :: h2ommr_crm(:,:,:,:) ! specfic humidity in CRM domain - real(r8), pointer :: t_crm(:,:,:,:) ! temperature at the CRM domain - real(r8), pointer :: cldn_crm(:,:,:,:) ! cloud fraction in CRM domain - real(r8), pointer :: qaerwat_crm(:, :, :, :, :) ! aerosol water at CRM domain - real(r8), pointer :: dgncur_awet_crm(:, :, :, :, :) ! wet mode diameter at CRM domain - - real(r8),allocatable :: es_crm(:) ! saturation vapor pressure - real(r8),allocatable :: qs_crm(:) ! saturation specific humidity - real(r8),allocatable :: cldnt(:,:) ! temporal variables - real(r8),allocatable :: rh_crm(:,:,:,:) ! Relative humidity at the CRM grid - real(r8),allocatable :: specdens_1(:) - - real(r8),pointer :: dgncur_a(:,:,:) - real(r8),pointer :: drymass(:,:,:) - real(r8),pointer :: dryrad(:,:,:) - - - real(r8), pointer :: dgncur_awet(:,:,:) - real(r8), pointer :: wetdens(:,:,:) - real(r8), pointer :: qaerwat(:,:,:) - - real(r8), pointer :: h2ommr(:,:) ! specific humidity - real(r8), pointer :: t(:,:) ! temperatures (K) - real(r8), pointer :: pmid(:,:) ! layer pressure (Pa) - real(r8), pointer :: cldn(:,:) ! layer cloud fraction (0-1) - - real(r8), allocatable :: maer(:,:,:) ! aerosol wet mass MR (including water) (kg/kg-air) - real(r8), allocatable :: wetvol(:,:,:) ! single-particle-mean wet volume (m3) - real(r8), allocatable :: wtrvol(:,:,:) ! single-particle-mean water volume in wet aerosol (m3) - real(r8), allocatable :: wtpct(:,:,:) ! sulfate aerosol composition, weight % H2SO4 - real(r8), allocatable :: sulden(:,:,:) ! sulfate aerosol mass density (g/cm3) - - real(r8), pointer :: hygro(:,:,:) ! volume-weighted mean hygroscopicity (--) - real(r8), pointer :: naer(:,:,:) ! aerosol number MR (bounded!) (#/kg-air) - real(r8), pointer :: dryvol(:,:,:) ! single-particle-mean dry volume (m3) - real(r8), pointer :: so4dryvol(:,:,:) ! dry volume of sulfate in single aerosol (m3) - - real(r8) :: specdens, so4specdens - integer :: troplev(pcols) - - real(r8), allocatable :: rhcrystal(:) - real(r8), allocatable :: rhdeliques(:) - - real(r8) :: es(pcols) ! saturation vapor pressure - real(r8) :: qs(pcols) ! saturation specific humidity - - - - real(r8) :: rh(pcols,pver) ! relative humidity (0-1) - - - real(r8), allocatable :: wetrad(:,:,:) ! wet radius of aerosol (m) - - integer :: ii, jj, l - integer :: idx - integer :: itim_old - - - !----------------------------------------------------------------------- - - ncol = state%ncol - - call rad_cnst_get_info(0, nmodes=nmodes) - - allocate(& - es_crm(pcols), & - qs_crm(pcols), & - cldnt(pcols, pver), & - rh_crm(pcols, crm_nx, crm_ny, pver), & - wtrvol_grid(pcols,pver,nmodes), & - wetvol_grid(pcols,pver,nmodes), & - ncount_clear(pcols,pver,nmodes), & - dgncur_a(pcols,pver,nmodes), & - drymass(pcols,pver,nmodes), & - specdens_1(nmodes) ) - - allocate( & - wetrad(pcols,pver,nmodes), & - wetvol(pcols,pver,nmodes), & - wtrvol(pcols,pver,nmodes), & - wtpct(pcols,pver,nmodes), & - sulden(pcols,pver,nmodes), & - rhcrystal(nmodes), & - rhdeliques(nmodes) ) - - wtpct(:,:,:) = 75._r8 - sulden(:,:,:) = 1.923_r8 - - dgnum_idx = pbuf_get_index('DGNUM') - hygro_idx = pbuf_get_index('HYGRO') - dryvol_idx = pbuf_get_index('DRYVOL') - dryrad_idx = pbuf_get_index('DRYRAD') - drymass_idx = pbuf_get_index('DRYMASS') - so4dryvol_idx = pbuf_get_index('SO4DRYVOL') - naer_idx = pbuf_get_index('NAER') - dgnumwet_idx = pbuf_get_index('DGNUMWET') - qaerwat_idx = pbuf_get_index('QAERWAT') - wetdens_ap_idx = pbuf_get_index('WETDENS_AP') - cld_idx = pbuf_get_index('CLD') - - - idx = pbuf_get_index('CRM_QV_RAD') - call pbuf_get_field (pbuf, idx, h2ommr_crm) - idx = pbuf_get_index('CRM_T_RAD') - call pbuf_get_field (pbuf, idx, t_crm) - idx = pbuf_get_index('CRM_CLD_RAD') - call pbuf_get_field (pbuf, idx, cldn_crm) - idx = pbuf_get_index('CRM_QAERWAT') - call pbuf_get_field (pbuf, idx, qaerwat_crm) - idx = pbuf_get_index('CRM_DGNUMWET') - call pbuf_get_field (pbuf, idx, dgncur_awet_crm) - - ncount_clear = 0.0_r8 - wtrvol_grid = 0.0_r8 - wetvol_grid = 0.0_r8 - - call pbuf_get_field(pbuf, hygro_idx, hygro) - call pbuf_get_field(pbuf, dryvol_idx, dryvol) - call pbuf_get_field(pbuf, dryrad_idx, dryrad) - call pbuf_get_field(pbuf, drymass_idx, drymass) - call pbuf_get_field(pbuf, so4dryvol_idx, so4dryvol) - call pbuf_get_field(pbuf, naer_idx, naer) - - call pbuf_get_field(pbuf, dgnum_idx, dgncur_a ) - call pbuf_get_field(pbuf, dgnumwet_idx, dgncur_awet ) - call pbuf_get_field(pbuf, wetdens_ap_idx, wetdens) - call pbuf_get_field(pbuf, qaerwat_idx, qaerwat) - - dgncur_awet(:,:,:) = dgncur_a(:,:,:) - qaerwat = 0._r8 - - h2ommr => state%q(:,:,1) - t => state%t - pmid => state%pmid - - do m = 1, nmodes - ! get mode properties - call rad_cnst_get_mode_props(0, m, rhcrystal=rhcrystal(m), rhdeliques=rhdeliques(m)) - ! get mode info - call rad_cnst_get_info(0, m, nspec=nspec) - - do l = 1, nspec - - ! get species interstitial mixing ratio ('a') - call rad_cnst_get_aer_props(0, m, l, density_aer=specdens) - - if (l == 1) then - ! save off these values to be used as defaults - specdens_1(m) = specdens - end if - - end do - - end do - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - - do jj = 1, crm_ny - do ii = 1, crm_nx - do k = top_lev, pver - mm=pver-k+1 - call qsat_water(t(:ncol,k), pmid(:ncol,k), es(:ncol), qs(:ncol)) - do i = 1, ncol - if (qs(i) > h2ommr(i,k)) then - rh(i,k) = h2ommr(i,k)/qs(i) - else - rh(i,k) = 0.98_r8 - endif - rh(i,k) = max(rh(i,k), 0.0_r8) - rh(i,k) = min(rh(i,k), 0.98_r8) - if (cldn(i,k) .lt. 1.0_r8) then - rh(i,k) = (rh(i,k) - cldn(i,k)) / (1.0_r8 - cldn(i,k)) ! clear portion - end if - rh(i,k) = max(rh(i,k), 0.0_r8) - end do - - if (mm <= crm_nz) call qsat_water(t_crm(:ncol,ii,jj,mm), & - pmid(:ncol,k), es_crm(:ncol), qs_crm(:ncol)) - do i = 1, ncol - rh_crm(i, ii, jj, k) = rh(i,k) - if(mm.le.crm_nz) then - rh_crm(i, ii, jj, k) = h2ommr_crm(i,ii,jj,mm)/qs_crm(i) - rh_crm(i, ii, jj, k) = max(rh_crm(i, ii, jj, k), 0.0_r8) - rh_crm(i, ii, jj, k) = min(rh_crm(i, ii, jj, k), 0.98_r8) - if(cldn_crm(i, ii, jj, mm).gt.0.5_r8) then - ! aerosol water uptake is not calculaed at overcast sky in MMF - rh_crm(i, ii, jj, k) = 0.0_r8 - end if - end if - - rh(i,k) = rh_crm(i, ii, jj, k) - cldnt(i, k) = cldn(i,k) - mm=pver-k+1 - if(mm.le.crm_nz) then - cldnt(i,k) = cldn_crm(i, ii, jj, mm) - end if - - do m=1,nmodes - ncount_clear(i,k,m) = ncount_clear(i,k,m) + (1._r8 - cldnt(i,k)) - end do - end do - end do - - call modal_aero_wateruptake_sub( & - ncol, nmodes, rhcrystal, rhdeliques, dryrad, & - hygro, rh, dryvol, so4dryvol, so4specdens, tropLev, & - wetrad, wetvol, wtrvol, sulden, wtpct) - do m = 1, nmodes - do k = top_lev, pver - do i = 1, ncol - dgncur_awet(i,k,m) = dgncur_a(i,k,m) * (wetrad(i,k,m)/dryrad(i,k,m)) - if(k.ge.pver-crm_nz+1) then - qaerwat_crm(i,ii,jj,pver-k+1,m) = rhoh2o*naer(i,k,m)*wtrvol(i,k,m) - dgncur_awet_crm(i,ii,jj,pver-k+1,m) = dgncur_awet(i,k,m) - end if - wtrvol_grid(i,k,m) = wtrvol_grid(i,k,m) + wtrvol(i,k,m)*(1._r8-cldnt(i,k)) - wetvol_grid(i,k,m) = wetvol_grid(i,k,m) + wetvol(i,k,m)*(1._r8-cldnt(i,k)) - qaerwat(i,k,m) = qaerwat(i,k,m)+ rhoh2o*naer(i,k,m)*wtrvol(i,k,m) * (1-cldnt(i,k)) - - end do - end do - end do - end do - end do - - do m = 1, nmodes - do k = 1, pver - do i = 1, ncol - - if(ncount_clear(i,k,m).gt.1.0e-10_r8) then - qaerwat(i,k,m) = qaerwat(i,k,m)/ncount_clear(i,k,m) - wetvol_grid(i,k,m)=wetvol_grid(i,k,m)/ncount_clear(i,k,m) - wtrvol_grid(i,k,m)=wtrvol_grid(i,k,m)/ncount_clear(i,k,m) - if (wetvol_grid(i,k,m) > 1.0e-30_r8) then - wetdens(i,k,m) = (drymass(i,k,m) + & - rhoh2o*wtrvol_grid(i,k,m))/wetvol_grid(i,k,m) - else - wetdens(i,k,m) = specdens_1(m) - end if - wetrad(i,k,m) = max(dryrad(i,k,m), (wetvol_grid(i,k,m)/pi43)**third) - dgncur_awet(i,k,m) = dgncur_a(i,k,m)* & - (wetrad(i,k,m)/dryrad(i,k,m)) - else - dgncur_awet(i,k,m) = dgncur_a(i,k,m) - qaerwat(i,k,m) = 0.0_r8 - wetdens(i,k,m) = specdens_1(m) - end if - end do ! ncol - end do ! pver - end do ! nmodes - - - - deallocate(& - es_crm, & - qs_crm, & - cldnt, & - rh_crm, & - wtrvol_grid, & - wetvol_grid, & - ncount_clear ) - - deallocate(wetrad, wetvol, wtrvol, wtpct, sulden, rhcrystal, rhdeliques, specdens_1) - -end subroutine spcam_modal_aero_wateruptake_dr - - -!------------------------------------------------------------------------------------------------------ -subroutine crmclouds_mixnuc_tend (state, ptend, dtime, cflx, pblht, pbuf, & - wwqui_cen, wwqui_cloudy_cen, wwqui_bnd, wwqui_cloudy_bnd ) -!----------------------------------------------------------------------------------------------------- -! -! Purpose: to calculate aerosol tendency from dropelt activation and mixing. -! Adopted from mmicro_pcond in cldwat2m.F90 -! -!------------------------------------------------------------------------------------------------------ - use physics_types, only: physics_state, physics_ptend, physics_tend, physics_ptend_init - use physics_buffer, only: physics_buffer_desc, pbuf_old_tim_idx, pbuf_get_index, pbuf_get_field - use physconst, only: gravit, rair, karman - use constituents, only: cnst_get_ind, pcnst, cnst_species_class, cnst_spec_class_gas - use time_manager, only: is_first_step - use cam_history, only: outfld - use ndrop, only: dropmixnuc - use modal_aero_data - use rad_constituents, only: rad_cnst_get_info - -! Input - type(physics_state), intent(in) :: state ! state variables - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(in) :: pblht(pcols) ! PBL height (meter) - real(r8), intent(in) :: dtime ! timestep - real(r8), intent(in) :: cflx(pcols,pcnst) ! constituent flux from surface - real(r8), intent(in) :: wwqui_cen(pcols, pver) ! vertical velocity variance in quiescent class (m2/s2) - real(r8), intent(in) :: wwqui_cloudy_cen(pcols, pver) ! vertical velocity variance in quiescent, and cloudy class (m2/s2) - real(r8), intent(in) :: wwqui_bnd(pcols, pver+1) ! vertical velocity variance in quiescent class (m2/s2) - real(r8), intent(in) :: wwqui_cloudy_bnd(pcols, pver+1) ! vertical velocity variance in quiescent, and cloudy class (m2/s2) - -! output - type(physics_ptend), intent(out) :: ptend ! package tendencies - -! Local variables - integer i,k,m, k1, k2 - integer ifld, itim - integer ixcldliq, ixcldice, ixnumliq - integer l,lnum,lnumcw,lmass,lmasscw - integer :: lchnk ! chunk identifier - integer :: ncol ! number of atmospheric columns - integer :: nmodes - - real(r8) :: nc(pcols, pver) ! droplet number concentration (#/kg) - real(r8) :: nctend(pcols, pver) ! change in droplet number concentration - real(r8) :: omega(pcols, pver) ! grid-averaaged vertical velocity - real(r8) :: qc(pcols, pver) ! liquid water content (kg/kg) - real(r8) :: qi(pcols, pver) ! ice water content (kg/kg) - real(r8) :: lcldn(pcols, pver) - real(r8) :: lcldo(pcols, pver) - real(r8) :: cldliqf(pcols, pver) - - real(r8) :: wsub(pcols, pver) ! subgrid vertical velocity - real(r8) :: ekd_crm(pcols, pverp) ! diffusivity - real(r8) :: kkvh_crm(pcols, pverp) ! eddy diffusivity - real(r8) :: zs(pcols, pver) ! inverse of distance between levels (meter) - real(r8) :: dz(pcols, pver) ! layer depth (m) - real(r8) :: cs(pcols, pver) ! air density - real(r8) :: lc(pcols, pverp) ! mixing length (m) - real(r8) :: zheight(pcols, pverp) ! height at lay interface (m) - - real(r8) :: alc(pcols, pverp) ! asymptotic length scale (m) - real(r8) :: tendnd(pcols, pver) ! tendency of cloud droplet number concentrations (not used in the MMF) - - real(r8),allocatable :: factnum(:,:,:) ! activation fraction for aerosol number - - real(r8) :: qcld, qsmall - - logical :: dommf=.true. ! value insignificant, if present, means that dropmixnuc is called the mmf part. - -! Variables in the physics buffer: - real(r8), pointer, dimension(:,:) :: cldn ! cloud fractin at the current time step - real(r8), pointer, dimension(:,:) :: cldo ! cloud fraction at the previous time step - real(r8), pointer, dimension(:,:) :: acldy_cen ! liquid cloud fraction at the previous time step from ECPP - real(r8), pointer, dimension(:,:) :: kkvh ! vertical diffusivity - real(r8), pointer, dimension(:,:) :: tke ! turbulence kenetic energy - real(r8), pointer, dimension(:,:) :: tk_crm ! m2/s - - logical :: lq(pcnst) - - lchnk = state%lchnk - ncol = state%ncol - - qsmall = 1.e-18_r8 - - call rad_cnst_get_info(0, nmodes=nmodes) - allocate(factnum(pcols,pver,nmodes)) - - lq(:) = .false. - do m=1,ntot_amode - lnum=numptr_amode(m) - if(lnum>0)then - lq(lnum)= .true. - endif - do l=1,nspec_amode(m) - lmass=lmassptr_amode(l,m) - lq(lmass)= .true. - enddo - enddo - - call physics_ptend_init(ptend,state%psetcols,'crmclouds_mixnuc', lq=lq) - -! -! In the MMF model, turbulent mixing for tracer species are turned off in tphysac. -! So the turbulent for gas species mixing are added here. -! - do m=1, pcnst - if(cnst_species_class(m).eq.cnst_spec_class_gas) then - ptend%lq(m) = .true. - end if - end do - - itim = pbuf_old_tim_idx () - ifld = pbuf_get_index ('CLD') - call pbuf_get_field(pbuf, ifld, cldn, start=(/1,1,itim/), kount=(/pcols,pver,1/) ) - ifld = pbuf_get_index ('CLDO') - call pbuf_get_field(pbuf, ifld, cldo, start=(/1,1,itim/), kount=(/pcols,pver,1/) ) - ifld = pbuf_get_index ('ACLDY_CEN') - call pbuf_get_field(pbuf, ifld, acldy_cen) - ifld = pbuf_get_index('kvh') - call pbuf_get_field(pbuf, ifld, kkvh) - - ifld=pbuf_get_index('tke') - call pbuf_get_field(pbuf, ifld, tke) - - ifld = pbuf_get_index('TK_CRM') - call pbuf_get_field(pbuf, ifld, tk_crm) - - - if (is_first_step()) then - kkvh(:,:)= 0.0_r8 - tke(:,:) = 0.0_r8 - endif - - do i=1, ncol - do k=1, pver-1 - zs(i,k) = 1._r8/(state%zm(i,k)-state%zm(i,k+1)) - end do - zs(i,pver) = zs(i,pver-1) - -! calculate height at layer interface (simple calculation) - zheight(i,pverp) = 0.0_r8 - do k=pver, 1, -1 - zheight(i,k) = zheight(i,k+1) + state%pdel(i,k)/state%pmid(i,k)*(rair*state%t(i,k)/gravit) - end do - -! calculate mixing length -! from Holtslag and Boville, 1993, J. Climate. -! - do k=1, pverp - if(zheight(i,k).le.pblht(i)) then - alc(i,k) = 300._r8 - else - alc(i,k) = 30._r8+270._r8*exp(1._r8-zheight(i,k)/pblht(i)) - endif - lc(i,k) = alc(i,k)*karman*zheight(i,k)/(alc(i,k)+karman*zheight(i,k)) - enddo - end do - - call outfld('LENGC', lc, pcols, lchnk) - - kkvh_crm = 0._r8 - do i=1, ncol - do k=1, pver - -! from vertical variance in the quiescent class, which excldues -! the contribution from strong updraft and downdraft. - wsub(i,k) = sqrt(wwqui_cloudy_cen(i,k)) ! use variance in cloudy quiescent area - wsub(i,k) = min(wsub(i,k), 10._r8) - wsub(i,k) = max(0.20_r8, wsub(i,k)) - end do ! end k - - do k=1, pver+1 - - k1=min(k, pver) - k2=max(k-1, 1) -! -! calculate ekd_crm from wsub in the cloudy quiescent class (following a part of ndrop.F90) - ekd_crm(i,k) = min(10.0_r8, max(0.20_r8, sqrt(wwqui_cloudy_bnd(i,k))))* lc(i,k) - kkvh_crm(i,k) = ekd_crm(i,k) - -! set kkvh to kkvh_crm so this will be used in dropmixnuc in the mmf call - kkvh(i,k) = kkvh_crm(i,k) - - end do !end k - - end do - - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - call cnst_get_ind('NUMLIQ', ixnumliq) - - qc(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - qi(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) - nc(:ncol,:pver) = state%q(:ncol,:pver,ixnumliq) - cldliqf(:,:) = 1._r8 - lcldn(:,:) = 0._r8 - lcldo(:,:) = 0._r8 - - - do k=1,pver - do i=1,ncol - qcld=qc(i,k)+qi(i,k) - if(qcld.gt.qsmall)then - -#ifdef ECPP -! -! When ECPP is called, activation associated with cloud fraction change is treated in ECPP. -! so set two cloud fractio be the same here. -! But ECPP still did not treat activation associated with turbulent scale motion, and is -! done in dropmixnuc - lcldn(i,k)=acldy_cen(i,k) - lcldo(i,k)=acldy_cen(i,k) -#else - lcldn(i,k)=cldn(i,k)*qc(i,k)/qcld - lcldo(i,k)=cldo(i,k)*qc(i,k)/qcld -#endif - else - lcldn(i,k)=0._r8 - lcldo(i,k)=0._r8 - endif - enddo - enddo - -! should we set omega to be zero ?? - omega(:ncol, :) = state%omega(:ncol, :) - - call dropmixnuc(state, ptend, dtime, pbuf, wsub, lcldn, lcldo, cldliqf, tendnd, factnum, dommf ) - -! this part is moved into tphysbc after aerosol stuffs. -! - - deallocate(factnum) - -end subroutine crmclouds_mixnuc_tend -!====================================================================================================== - -!------------------------------------------------------------------------------------------------------ -subroutine crmclouds_convect_tend(state, ptend, ztodt, pbuf) -!----------------------------------------------------------------- -! -! Purpose: to do convective transport of tracer species using the cloud fields from CRM and using the -! subroutine of convtran. -! -! Minghuai Wang, July, 2009: adopted from zm_conv_tend_2 -! -!------------------------------------------------------------------------------------------------------ - use physics_types, only: physics_state, physics_ptend, physics_ptend_init - use time_manager, only: get_nstep - use physics_buffer, only: physics_buffer_desc, pbuf_old_tim_idx, pbuf_get_index, pbuf_get_field - use constituents, only: pcnst, cnst_get_ind - use zm_conv, only: convtran - use error_messages, only: alloc_err - -! Arguments -! Input variables: - type(physics_state), intent(in ) :: state ! Physics state variables - real(r8), intent(in) :: ztodt - -! Output variables: - type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies - type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer - -! Local variables - integer :: i, lchnk, istat - integer :: ncol - integer :: nstep - integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. - real(r8), dimension(pcols,pver) :: dpdry - real(r8), dimension(pcols,pver) :: dp ! layer thickness in mbs (between upper/lower interface). - real(r8), dimension(pcols) :: dsubcld ! wg layer thickness in mbs between lcl and maxi. - -! physics buffer fields - integer itim, ifld - real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble - - - real(r8), pointer, dimension(:,:) :: mu !(pcols,pver,begchunk:endchunk) - real(r8), pointer, dimension(:,:) :: eu !(pcols,pver,begchunk:endchunk) - real(r8), pointer, dimension(:,:) :: du !(pcols,pver,begchunk:endchunk) - real(r8), pointer, dimension(:,:) :: md !(pcols,pver,begchunk:endchunk) - real(r8), pointer, dimension(:,:) :: ed !(pcols,pver,begchunk:endchunk) - - real(r8), pointer, dimension(:) :: jtr8 !(pcols,begchunk:endchunk) - ! wg top level index of deep cumulus convection. - real(r8), pointer, dimension(:) :: maxgr8 !(pcols,begchunk:endchunk) - ! wg gathered values of maxi. - real(r8), pointer, dimension(:) :: ideepr8 !(pcols,begchunk:endchunk) - ! w holds position of gathered points vs longitude index - - integer :: jt(pcols) - integer :: maxg(pcols) - integer :: ideep(pcols) - integer :: lengath !(begchunk:endchunk) - logical :: lq(pcnst) - -! -! Initialize -! - - lq(:) = .true. - lq(1) = .false. - lq(ixcldice) = .false. - lq(ixcldliq) = .false. - - call physics_ptend_init(ptend,state%psetcols,'convtran2',lq=lq) - -! -! Associate pointers with physics buffer fields -! - ifld = pbuf_get_index('FRACIS') - call pbuf_get_field(pbuf, ifld, fracis, start=(/1,1,1/), kount=(/pcols,pver,pcnst/) ) - - ifld = pbuf_get_index('MU_CRM') - call pbuf_get_field(pbuf, ifld, mu) - ifld = pbuf_get_index('MD_CRM') - call pbuf_get_field(pbuf, ifld, md) - ifld = pbuf_get_index('DU_CRM') - call pbuf_get_field(pbuf, ifld, du) - ifld = pbuf_get_index('EU_CRM') - call pbuf_get_field(pbuf, ifld, eu) - ifld = pbuf_get_index('ED_CRM') - call pbuf_get_field(pbuf, ifld, ed) - ifld = pbuf_get_index('JT_CRM') - call pbuf_get_field(pbuf, ifld, jtr8) - ifld = pbuf_get_index('MX_CRM') - call pbuf_get_field(pbuf, ifld, maxgr8) - ifld = pbuf_get_index('IDEEP_CRM') - call pbuf_get_field(pbuf, ifld, ideepr8) - - -! Transport all constituents except cloud water and ice -! - - lchnk = state%lchnk - ncol = state%ncol - - nstep = get_nstep() - -! -! Convective transport of all trace species except cloud liquid -! and cloud ice done here because we need to do the scavenging first -! to determine the interstitial fraction. -! - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - - -! Is this ok to get the index??? - jt = int(jtr8+0.5_r8) - maxg = int(maxgr8+0.5_r8) - ideep = int(ideepr8+0.5_r8) - -! calculate lengath from ideep - lengath = 0 - do i=1, ncol - if(ideep(i).ge.1) then - lengath = lengath + 1 - endif - end do - -! -! initialize dpdry for call to convtran -! it is used for tracers of dry smixing ratio type -! - dpdry = 0._r8 - do i = 1,lengath - dpdry(i,:) = state%pdeldry(ideep(i),:)/100._r8 - dp(i,:) = state%pdel(ideep(i),:)/100._r8 - end do - -! dsubdld is not used in convtran, and is set to be zero. - dsubcld = 0._r8 - - - call convtran (lchnk, & - ptend%lq,state%q, pcnst, mu(:,:), md(:,:), & - du(:,:), eu(:,:), ed(:,:), dp(:,:), dsubcld(:), & - jt(:),maxg(:),ideep(:), 1, lengath, & - nstep, fracis, ptend%q, dpdry, ztodt ) - -end subroutine crmclouds_convect_tend -!===================================================================================================== - -!------------------------------------------------------------------------------------------------------ -subroutine crmclouds_diag - -end subroutine crmclouds_diag -!====================================================================================================== - -#endif -#endif /*CRM*/ - -end module crmclouds_camaerosols diff --git a/src/physics/spcam/crmdims.F90 b/src/physics/spcam/crmdims.F90 deleted file mode 100644 index a1765db60c..0000000000 --- a/src/physics/spcam/crmdims.F90 +++ /dev/null @@ -1,11 +0,0 @@ -module crmdims -#ifdef CRM - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - - integer, parameter :: nclubbvars = 17 - - integer, parameter :: crm_nx=SPCAM_NX, crm_ny=SPCAM_NY, crm_nz=SPCAM_NZ - real(r8), parameter :: crm_dx=SPCAM_DX, crm_dy=SPCAM_DX, crm_dt=SPCAM_DT -#endif -end module crmdims diff --git a/src/physics/spcam/ecpp/ecpp_modal_aero_activate.F90 b/src/physics/spcam/ecpp/ecpp_modal_aero_activate.F90 deleted file mode 100644 index 6d2d9b3290..0000000000 --- a/src/physics/spcam/ecpp/ecpp_modal_aero_activate.F90 +++ /dev/null @@ -1,660 +0,0 @@ -module ecpp_modal_aero_activate - -!----------------------------------------------------------------- -! Module interface of aerosol activaiton used in the ECPP treatment -! in the MMF model -! Adopted from ndrop.F90 and from the similar one used in the ECPP -! for the WRF-chem model written by Dick Easter -! -! Minghuai Wang, 2009-11 -!------------------------------------------------------------------ - use shr_kind_mod, only: r8 => shr_kind_r8 - use cam_abortutils, only: endrun - use constituents, only: pcnst - - implicit none - - public parampollu_tdx_activate1 - public parampollu_tdx_activate_intface - -contains - -!----------------------------------------------------------------------- - subroutine parampollu_tdx_activate1( & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, wbnd_bar, & - ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, ifrom_where, activate_onoff_use, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - chem_sub_old, & - mfbnd_use, & - ar_bnd_tavg, & - ent_airamt, & - ido_actres_horz, fmact_horz, fnact_horz, & - fmact_vert, fnact_vert, mfbnd_quiescn_up ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_tdx_activate1 calculates number and mass activation -! fractions associated with vertical and horizontal transfer -! between subclasses -! -!----------------------------------------------------------------------- - - use module_data_mosaic_asect, only: maxd_asize, maxd_atype, & - nsize_aer, ntype_aer - - use module_data_radm2, only: epsilc - - use module_data_ecpp1 - - use module_ecpp_util, only: ecpp_error_fatal, ecpp_message - -! arguments - integer, intent(in) :: & - ktau, ktau_pp, & - it, jt, kts, ktebnd, ktecen -! ktau - time step number -! ktau_pp - time step number for "parameterized pollutants" calculations -! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" -! chem_driver and routines under it do calculations -! over these spatial indices. - - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) - - real(r8), intent(in) :: dtstep, dtstep_pp -! dtstep - main model time step (s) -! dtstep_pp - time step (s) for "parameterized pollutants" calculations - - real(r8), intent(in), dimension( kts:ktecen ) :: & - tcen_bar, pcen_bar, rhocen_bar, dzcen - real(r8), intent(in), dimension( kts:ktebnd ) :: & - rhobnd_bar, wbnd_bar -! tcen_bar - temperature (K) at layer centers -! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries -! pcen_bar - air pressure (Pa) at layer centers -! wbnd_bar - vertical velocity (m/s) at layer boundaries -! dzcen - layer thicknesses (m) -! - integer, intent(in) :: ncls_ecpp -! ncls_ecpp - number of ecpp transport classes in the grid column - integer, intent(in) :: ifrom_where -! 1,2 - from area_change; 10 - from main_integ - integer, intent(in) :: activate_onoff_use -! 1-99 - calc real fmact,fnact -! 200 - set fmact = fmact_testa, ... -! other - set fmact,fnact = 0.0 -! ALSO, ido_actres_horz is set correctly when activate_onoff_use > 0 -! but is set to zero when activate_onoff_use <= 0 - - integer, intent(in) :: ncls_use - - integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use - - real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_sub_old - - real(r8), intent(inout), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & - ar_bnd_tavg, mfbnd_use - - real(r8), intent(in), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - ent_airamt - - integer, intent(out), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp ) :: & - ido_actres_horz -! ido_actres_horz(iccaa,jclsaa,iccbb,jclsbb) is associated with air moving -! into sub-class (iccaa,jclsaa) from sub-class (iccbb,jclsbb) -! ido_actres_horz = +1 or +2 if activation, -1 if resuspension, 0 otherwise -! note that its values are independent of k (i.e., they only depend on the source and -! destination sub-classes) -! the fnact and fmact do depend on k - - real(r8), intent(out), dimension( 1:maxd_asize, 1:maxd_atype, 1:maxcls_ecpp, & - 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - fmact_horz, fnact_horz -! fmact_horz(m,n,jclsaa,iccbb,jclsbb,k) and fnact(...) are associated with air moving -! into sub-class (icc=2,jclsaa,k) from sub-class (iccbb,jclsbb,k) - - real(r8), optional, intent(out), dimension( 1:maxd_asize, 1:maxd_atype, kts:ktecen ) :: & - fmact_vert, fnact_vert -! fnact_vert(m,n,k) and fmact(...) are associated with (quiescent, clear, layer k-1) air moving -! into (quiescent, cloudy, layer k) - - real(r8), optional, intent(in), dimension( kts:ktebnd, 0:2, 0:2 ) :: & - mfbnd_quiescn_up - - -! local variables - integer :: icc, iccb, iccy, ido_actres_tmp, ihorzvert, itmpa - integer :: jcls, jclsy, jj - integer :: k, l - integer :: m, n - - real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpt - real(r8) :: wbar_tmp, wmix_tmp - - real(r8), dimension( 1:maxd_asize, 1:maxd_atype ) :: & - fnact_tmp, fmact_tmp - real(r8), dimension( 1:maxd_asize, 1:maxd_atype, 2 ) :: & - fnact_testa, fmact_testa - - -! initialize fnact/fmact to zero - ido_actres_horz(:,:,:,:) = 0 - fmact_horz(:,:,:,:,:,:) = 0.0_r8 - fnact_horz(:,:,:,:,:,:) = 0.0_r8 - if ( present(fmact_vert) ) fmact_vert(:,:,:) = 0.0_r8 - if ( present(fnact_vert) ) fnact_vert(:,:,:) = 0.0_r8 - - if (activate_onoff_use <= 0) return - - -! temporary values for testing purposes - fmact_testa(:,:,:) = 0.0_r8 - fnact_testa(:,:,:) = 0.0_r8 - - fmact_testa(1,1:3,1) = (/ 0.50_r8, 0.90_r8, 0.95_r8 /) ! updraft_r8 - fnact_testa(1,1:3,1) = (/ 0.40_r8, 0.80_r8, 0.90_r8 /) - fmact_testa(1,1:3,2) = (/ 0.30_r8, 0.80_r8, 0.90_r8 /) ! quiescent - fnact_testa(1,1:3,2) = (/ 0.20_r8, 0.60_r8, 0.80_r8 /) - -! -! horizontal transfer -! - -! first set ido_actres_horz -! note again: ido_actres_horz(icc,jcls,iccy,jclsy) is from iccy,jclsy to icc,jcls - do jclsy = 1, ncls_use - do iccy = 1, 2 - do jcls = 1, ncls_use - do icc = 1, 2 - - if (icc == 1) then - if (iccy == 1) then - ! clear --> clear -- do nothing (no activation or resuspension) - cycle - else - ! cloudy --> clear -- do resuspension - ido_actres_horz(icc,jcls,iccy,jclsy) = -1 - end if - - else - if (iccy == 1) then - ! clear --> cloudy -- do activation for into updrafts & quiescent - ! do nothing for into downdrafts - if (mtype_updnenv_use(icc,jcls) /= mtype_dndraft_ecpp) & - ido_actres_horz(icc,jcls,iccy,jclsy) = 1 - else - ! cloudy --> cloudy -- do (re)activation for into updrafts - ! do nothing for into downdrafts & quiescent - ! if (mtype_updnenv_use(icc,jcls) == mtype_updraft_ecpp) & - ! ido_actres_horz(icc,jcls,iccy,jclsy) = 2 - end if - end if - - end do ! icc - end do ! jcls - end do ! iccy - end do ! jclsy - - - -! next calc activation fractions -horz_k_loop: & - do k = kts, ktecen - -horz_jcls_loop: & - do jcls = 1, ncls_use - icc = 2 - -horz_jclsy_loop: & - do jclsy = 1, ncls_use - -horz_iccy_loop: & - do iccy = 1, 2 - - if (ent_airamt(icc,jcls,iccy,jclsy,k) <= 0.0_r8) cycle horz_iccy_loop - - if (jcls == jcls_qu) then -! quiescent class -! it can entrain from quiescent, updraft, dndraft -! do activation for entrain from clear-any - if (iccy == 2) cycle horz_iccy_loop ! only activate clear --> cloudy - - else if (mtype_updnenv_use(icc,jcls) == mtype_dndraft_ecpp) then -! downdraft class -! it can entrain from quiescent, dndraft -! do activation for none of these - cycle horz_iccy_loop - - else -! updraft class -! it can entrain from quiescent, updraft -! do activation for entrain from any-quiescent and clear-updraft - if (jclsy == jcls_qu) then - continue - else if ( (iccy == 1) .and. & - (mtype_updnenv_use(iccy,jclsy) == & - mtype_updraft_ecpp) ) then - continue - else - cycle horz_iccy_loop - end if - end if - - if (activate_onoff_use == 200) then ! use the fmnact_tst values - jj = 1 - if (jcls == jcls_qu) jj = 2 - fmact_horz(:,:,jcls,iccy,jclsy,k) = fmact_testa(:,:,jj) - fnact_horz(:,:,jcls,iccy,jclsy,k) = fnact_testa(:,:,jj) - end if - - if (activate_onoff_use < 100) then ! calculate "real" values -! stop '*** parampollu_tdx_activate1 - cannot do activate_onoff_use < 100' - - tmpa = 0.5_r8*(mfbnd_use(k,icc,jcls)+mfbnd_use(k+1,icc,jcls)) - tmpb = 0.5_r8*(ar_bnd_tavg(k,icc,jcls)+ar_bnd_tavg(k+1,icc,jcls)) - if (tmpb > 0.0_r8) then - if (abs(tmpa) > abs(tmpb)*w_draft_max) then - wbar_tmp = w_draft_max - else - wbar_tmp = tmpa/tmpb - end if - else - wbar_tmp = 0.0_r8 - end if - wbar_tmp = wbar_tmp + 0.5_r8*(wbnd_bar(k)+wbnd_bar(k+1)) - wmix_tmp = 0.0_r8 - if (max(wbar_tmp,wmix_tmp) <= 0.0_r8) cycle horz_iccy_loop - - ido_actres_tmp = ido_actres_horz(icc,jcls,iccy,jclsy) - ihorzvert = 1 - - call parampollu_tdx_activate_intface( & - ktau, ktau_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - ncls_ecpp, ncls_use, & - it, jt, kts,ktebnd,ktecen, & - k, iccy, jclsy, jcls, & - activate_onoff_use, ido_actres_tmp, & - ihorzvert, ifrom_where, & - chem_sub_old, & - tcen_bar(k), rhocen_bar(k), & - wbar_tmp, wmix_tmp, & - fmact_testa, fnact_testa, & - fmact_tmp, fnact_tmp ) - - fmact_horz(:,:,jcls,iccy,jclsy,k) = fmact_tmp(:,:) - fnact_horz(:,:,jcls,iccy,jclsy,k) = fnact_tmp(:,:) - end if - - end do horz_iccy_loop - end do horz_jclsy_loop - end do horz_jcls_loop - end do horz_k_loop - -! write(*,'(a,i4,1p,4e10.2)') 'tdx_activate1 horz min/max', ifrom_where, & -! minval(fmact_horz(:,:,:,:,:,:)), maxval(fmact_horz(:,:,:,:,:,:)), & -! minval(fnact_horz(:,:,:,:,:,:)), maxval(fnact_horz(:,:,:,:,:,:)) - - -! -! vertical transfer -! in up/dndrafts, vertical transport is clear<-->clear or cloudy<-->cloudy -! so no activation -! in quiescent, can have clear<-->cloudy -! do activation for clear(k-1)-->cloud(k) -! - if ( present(fmact_vert) .and. present(fnact_vert) ) then - -vert_k_loop: & - do k = kts, ktecen - if (k == kts) cycle vert_k_loop - - jcls = jcls_qu - icc = 2 - jclsy = jcls_qu - iccy = 1 - -! mfbnd_quiescn_up(k,iccy,icc) is upwards mass flux from iccy to icc -! at bottom of layer k - if (mfbnd_quiescn_up(k,iccy,icc) <= 0.0_r8) cycle vert_k_loop - - if (activate_onoff_use == 200) then ! use the fmnact_tst values - jj = 2 - fmact_vert(:,:,k) = fmact_testa(:,:,jj) - fnact_vert(:,:,k) = fnact_testa(:,:,jj) - end if - - if (activate_onoff_use < 100) then ! calculate "real" values -! stop '*** parampollu_tdx_activate1 - cannot do activate_onoff_use < 100' - - tmpa = mfbnd_use(k,iccy,jclsy) - tmpb = ar_bnd_tavg(k,iccy,jclsy) - if (tmpb > 0.0_r8) then - if (abs(tmpa) > abs(tmpb)*w_draft_max) then - wbar_tmp = w_draft_max - else - wbar_tmp = tmpa/tmpb - end if - else - wbar_tmp = 0.0_r8 - end if - wbar_tmp = wbar_tmp + wbnd_bar(k) - wmix_tmp = 0.0_r8 - if (max(wbar_tmp,wmix_tmp) <= 0.0_r8) cycle vert_k_loop - - ido_actres_tmp = 1 - - tmpt = 0.5_r8*( tcen_bar(k) + tcen_bar(max(k-1,kts)) ) - - ido_actres_tmp = 1 - ihorzvert = 2 - - call parampollu_tdx_activate_intface( & - ktau, ktau_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - ncls_ecpp, ncls_use, & - it, jt, kts,ktebnd,ktecen, & - k-1, iccy, jclsy, jcls, & - activate_onoff_use, ido_actres_tmp, & - ihorzvert, ifrom_where, & - chem_sub_old, & - tmpt, rhobnd_bar(k), & - wbar_tmp, wmix_tmp, & - fmact_testa, fnact_testa, & - fmact_tmp, fnact_tmp ) - - fmact_vert(:,:,k) = fmact_tmp(:,:) - fnact_vert(:,:,k) = fnact_tmp(:,:) - end if - - end do vert_k_loop - -! write(*,'(a,i4,1p,4e10.2)') 'tdx_activate1 vert min/max', ifrom_where, & -! minval(fmact_vert(:,:,:)), maxval(fmact_vert(:,:,:)), & -! minval(fnact_vert(:,:,:)), maxval(fnact_vert(:,:,:)) - - end if ! ( present(fmact_vert) .and. present(fnact_vert) ) - - - - return - end subroutine parampollu_tdx_activate1 - - - -!----------------------------------------------------------------------- - subroutine parampollu_tdx_activate_intface( & - ktau, ktau_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - ncls_ecpp, ncls_use, & - i, j, kts,ktebnd,ktecen, & - k, iccy, jclsy, jcls, & - activate_onoff_use, ido_actres, & - ihorzvert, ifrom_where, & - chem_sub_old, & - tempair_in, rhoair_in, & - wbar_in, wmix_in, & - fmact_testa, fnact_testa, & - fmact, fnact ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_tdx_activate1 calculates number and mass activation -! fractions associated with vertical and horizontal transfer -! between subclasses -! -!----------------------------------------------------------------------- - - use module_data_mosaic_asect, only: & - maxd_acomp, maxd_asize, maxd_atype, & - ncomp_aer, nsize_aer, ntype_aer, & - nphase_aer, ai_phase, cw_phase, & - numptr_aer, massptr_aer, sigmag_aer - - use module_data_ecpp1 - - use module_ecpp_util, only: ecpp_error_fatal, ecpp_message - - use ndrop, only: activate_modal - -! arguments - integer, intent(in) :: & - ktau, ktau_pp, & - i, j, kts, ktebnd, ktecen -! ktau - time step number -! ktau_pp - time step number for "parameterized pollutants" calculations -! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" -! chem_driver and routines under it do calculations -! over these spatial indices. - - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) - - integer, intent(in) :: & - k, iccy, jclsy, jcls - - real(r8), intent(in) :: tempair_in, rhoair_in, wbar_in, wmix_in -! tempair - temperature (k) -! rhoair - air density (kg/m3) - - integer, intent(in) :: ncls_ecpp -! ncls_ecpp - number of ecpp transport classes in the grid column - integer, intent(in) :: ncls_use - - integer, intent(in) :: activate_onoff_use -! 1-99 - calc real fmact,fnact -! 200 - set fmact = fmact_testa, ... -! other - set fmact,fnact = 0.0 - integer, intent(in) :: ido_actres, ihorzvert, ifrom_where - - real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_sub_old - - real(r8), intent(in), dimension( 1:maxd_asize, 1:maxd_atype, 2 ) :: & - fnact_testa, fmact_testa - - real(r8), intent(out), dimension( 1:maxd_asize, 1:maxd_atype ) :: & - fmact, fnact - - -! local variables - integer :: iphase, jj, l, ll, lun, m, n - integer, save :: ifrom_where_save, ktau_save - data ifrom_where_save, ktau_save / -1, -1 / - - real(r8) :: factscale, flux_fullact - real(r8) :: rhoair - real(r8) :: sumhygro, sumvol - real(r8) :: tempair, tmpc - real(r8) :: wbar, wdiab, wmin, wmax, wmix, wmixmin - - real(r8) :: raercol( 1:1, 1:num_chem_ecpp ) - - real(r8) :: raer (1:pcnst) ! interstitial aerosols - real(r8) :: qqcw (1:pcnst) ! interstitial aerosols - - real(r8), dimension( 1:maxd_asize, 1:maxd_atype ) :: & - fn, fs, fm, fluxn, fluxs, fluxm, hygro, & - maerosol_tot, maerosol_totcw, & - naerosol, naerosolcw, & - vaerosol, vaerosolcw, sigmag - - real(r8), dimension( 1:maxd_acomp, 1:maxd_asize, 1:maxd_atype ) :: & - maerosol, maerosolcw - - - -! initialize fnact/fmact to zero - fmact(:,:) = 0.0_r8 - fnact(:,:) = 0.0_r8 - -! special testing cases - if ((activate_onoff_use <= 0) .or. (activate_onoff_use >= 100)) then - return - else if (activate_onoff_use == 81) then - return - else if (activate_onoff_use == 82) then - jj = 1 - if (jcls == jcls_qu) jj = 2 - fmact(:,:) = fmact_testa(:,:,jj) - fnact(:,:) = fnact_testa(:,:,jj) - return - end if - -! -! calc activation fractions -! - tempair = tempair_in - rhoair = rhoair_in - wbar = wbar_in - wmix = wmix_in - - wmixmin = 0.2_r8 - ! do single updraft, forced to wbar >= wmixmin - wbar = max( wbar+wmix, wmixmin ) - wmix = 0.0_r8 - - wmin = 0.0_r8 - wmax = 50.0_r8 - wdiab = 0.0_r8 - -! load raercol (with units conversion) and calculate hygro - raercol(:,:) = 0.0_r8 - - raer(1:pcnst) = chem_sub_old(k,iccy,jclsy,1:pcnst) - qqcw(1:pcnst) = chem_sub_old(k,iccy,jclsy,pcnst+1:2*pcnst) - -! do loadaer calls - do n=1,ntype_aer - do m=1,nsize_aer(n) - - if(ido_actres ==2 ) then - iphase = 3 - else - iphase = 1 - end if - call loadaer0D (raer, qqcw, n, rhoair, ai_phase, & - naerosol(m,n), vaerosol(m,n), hygro(m,n)) - sigmag(m, n) = sigmag_aer(m,n) - enddo ! m - enddo ! n - -! do activate call - m = 1 ! for the CAM modal aeosol, nsize_aer is always 1. - call activate_modal( wbar, wmix, wdiab, wmin, wmax, tempair, rhoair, & - naerosol(m,:), ntype_aer, & - vaerosol(m,:), hygro(m,:), & - fn(m,:), fm(m,:), fluxn(m,:), fluxm(m,:), flux_fullact ) - -! load results - fmact(:,:) = fm(:,:) - fnact(:,:) = fn(:,:) - -! diagnostics - lun = ldiagaa_ecpp(125) - if ((idiagaa_ecpp(125) > 0) .and. (lun > 0)) then - - if ((ktau /= ktau_save) .or. (ifrom_where /= ifrom_where_save)) & - write(lun,'(//a,4i8)') & - 'activate_intface - ktau, ifrom_where =', ktau, ifrom_where - ktau_save = ktau - ifrom_where_save = ifrom_where - - write(lun,'(2i3,2x,2i2,2x,4i2, 1p,2x,3e8.1, 0p,3x,3f7.3, 2(3x,4f6.3))') & - jcls, k, jclsy, iccy, ido_actres, ihorzvert, maxd_asize, maxd_atype, & - naerosol(1,1:3)*1.0e-6_r8, wbar_in, wmix_in, wbar, fmact(1,1:3), fnact(1,1:3) - write(lun,'(8x,a, 1p,2x,4e10.2)') ' vaerosol', vaerosol(1,1:3) - write(lun,'(8x,a, 1p,2x,4e10.2)') ' hygro ', hygro(1,1:3) - write(lun,'(8x,a, 1p,2x,6e10.2)') ' t,rho', tempair, rhoair - - end if - - - return - end subroutine parampollu_tdx_activate_intface -!========================================================================================================== - -!---------------------------------------------------------------------------------------------------------- - subroutine loadaer0D(raer,qqcw,m,cs, phase, & - naerosol, vaerosol, hygro ) -!------------------------------------------------------------------------- -! This subroutine is adopted from loadaer in ndrop.F90. It is 2D in ndrop.F90, -! but it is 0D here (single point). So that we do not need to define arrays with -! pcols, pver. -! Minghuai Wang, 2009-11 -!------------------------------------------------------------------------- - use modal_aero_data - - implicit none - -! load aerosol number, volume concentrations, and bulk hygroscopicity - - real(r8), intent(in) :: raer(pcnst) ! aerosol mass, number mixing ratios - real(r8), intent(in) :: qqcw(pcnst) ! cloud-borne aerosol mass, number mixing ratios - integer, intent(in) :: m ! m=mode index - real(r8), intent(in) :: cs ! air density (kg/m3) - integer, intent(in) :: phase ! phase of aerosol: 1 for interstitial, 2 for cloud-borne, 3 for sum - real(r8), intent(out) :: naerosol ! interstitial number conc (/m3) - real(r8), intent(out) :: vaerosol ! interstitial+activated volume conc (m3/m3) - real(r8), intent(out) :: hygro ! bulk hygroscopicity of mode - -! internal - - real(r8) vol ! aerosol volume mixing ratio - integer i,lnum,lnumcw,l,lmass,lmasscw - - vaerosol=0._r8 - hygro=0._r8 - - do l=1,nspec_amode(m) - lmass=lmassptr_amode(l,m) ! interstitial - lmasscw=lmassptrcw_amode(l,m) ! cloud-borne - if(phase.eq.3)then - vol=max(raer(lmass)+qqcw(lmasscw),0._r8)/specdens_amode(l,m) - elseif(phase.eq.2)then - vol=max(qqcw(lmasscw),0._r8)/specdens_amode(l,m) - elseif(phase.eq.1)then - vol=max(raer(lmass),0._r8)/specdens_amode(l,m) - else - write(6,*)'phase=',phase,' in loadaer' - call endrun('phase error in loadaer') - endif - vaerosol=vaerosol+vol - hygro=hygro+vol*spechygro(l,m) - enddo - if (vaerosol > 1.0e-30_r8) then ! +++xl add 8/2/2007 - hygro=hygro/(vaerosol) - vaerosol=vaerosol*cs - else - hygro=0.0_r8 - vaerosol=0.0_r8 - endif - - lnum=numptr_amode(m) - lnumcw=numptrcw_amode(m) -! aerosol number predicted - if(phase.eq.3)then - naerosol=(raer(lnum)+qqcw(lnumcw))*cs - elseif(phase.eq.2)then - naerosol=qqcw(lnumcw)*cs - else - naerosol=raer(lnum)*cs - endif -! adjust number so that dgnumlo < dgnum < dgnumhi - naerosol = max( naerosol, vaerosol*voltonumbhi_amode(m) ) - naerosol = min( naerosol, vaerosol*voltonumblo_amode(m) ) - - return - end subroutine loadaer0D -!============================================================================================ - -end module ecpp_modal_aero_activate diff --git a/src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 b/src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 deleted file mode 100644 index 66ff95b967..0000000000 --- a/src/physics/spcam/ecpp/ecpp_modal_cloudchem.F90 +++ /dev/null @@ -1,700 +0,0 @@ -module ecpp_modal_cloudchem - -!----------------------------------------------------------------- -! Module interface for cloud chemistry used in the ECPP treatment -! in the MMF model -! Adopted the similar one used in the ECPP -! for the WRF-chem model written by Dick Easter -! -! Minghuai Wang, 2009-11 -!------------------------------------------------------------------ - use shr_kind_mod, only: r8 => shr_kind_r8 - use cam_abortutils, only: endrun - - implicit none - - public parampollu_tdx_cldchem - -contains - -!----------------------------------------------------------------------- - -subroutine parampollu_tdx_cldchem( & - ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & - itstep_hybrid, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, zbnd, wbnd_bar, & - chem_bar, & - ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - chem_sub_new, & - del_chem_clm_cldchem, del_chem_clm_rename, del_cldchem3d, del_rename3d, & - aqso4_h2o2, aqso4_o3, xphlwc3d, & - ardz_cen_old, ardz_cen_new, rhodz_cen, & - acen_tavg_use, acen_prec_use, & - rh_sub2, qcloud_sub2, qlsink_sub2, & - precr_sub2, precs_sub2, & - chem_bar_iccfactor, activate_onoff_use, & - iphase_of_aerosol, isize_of_aerosol, & - itype_of_aerosol, inmw_of_aerosol, & - laicwpair_of_aerosol,pbuf ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_tdx_cldchem does cloud chemistry -! for one main-integ time sub-step -! -! incoming chem_sub_new holds current sub-class mixing ratios -! outgoing chem_sub_new holds updated sub-class mixing ratios -! -! In the beginning of the subroutine, the vertical coordinate (from bottom to top in ECPP) -! is converted into the one used in CAM: from the top to the bottom. And at the end of the -! subroutine, the vertical coordinate is converted back. -! -!----------------------------------------------------------------------- - - use module_data_ecpp1, only: p_qv, p_qc - - use module_data_radm2, only: epsilc - - use module_data_mosaic_asect, only: ai_phase, cw_phase, & - massptr_aer, maxd_asize, maxd_atype, & - ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer - - use module_data_ecpp1 - - use mo_setsox, only : setsox - use mo_mass_xforms, only : mmr2vmr, vmr2mmr - use modal_aero_rename, only : modal_aero_rename_sub - use modal_aero_data, only : ntot_amode - use physconst, only: gravit - use ppgrid, only: pcols, pver - use time_manager, only: get_nstep - use mo_mean_mass, only: set_mean_mass - use chem_mods, only: gas_pcnst, nfs, indexm - use mo_setinv, only : setinv - use constituents, only: pcnst - use mo_gas_phase_chemdr, only: map2chm - use chemistry, only: imozart - use physics_buffer, only: physics_buffer_desc - - use module_ecpp_util, only: ecpp_error_fatal, ecpp_message - -! arguments - integer, intent(in) :: & - ktau, ktau_pp, itstep_sub, & - it, jt, kts, ktebnd, ktecen, & - itstep_hybrid -! ktau - time step number -! ktau_pp - time step number for "parameterized pollutants" calculations -! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" -! chem_driver and routines under it do calculations -! over these spatial indices. - - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) - - real(r8), intent(in) :: dtstep, dtstep_sub -! dtstep - main model time step (s) -! dtstep_sub - sub time step (s) currently used in ecpp main-integ routine - - real(r8), intent(in), dimension( kts:ktecen ) :: & - tcen_bar, pcen_bar, rhocen_bar, dzcen - real(r8), intent(in), dimension( kts:ktebnd ) :: & - rhobnd_bar, wbnd_bar, zbnd -! tcen_bar - temperature (K) at layer centers -! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries -! pcen_bar - air pressure (Pa) at layer centers -! wbnd_bar - vertical velocity (m/s) at layer boundaries -! zbnd - elevation (m) at layer boundaries -! dzcen - layer thicknesses (m) - - real(r8), intent(in), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & - chem_bar -! chem_bar - mixing ratios of trace gase (ppm) and aerosol species -! (ug/kg for mass species, #/kg for number species) - - integer, intent(in) :: ncls_ecpp, ncls_use - - integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use - - real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_sub_new - - real(r8), intent(inout), dimension( 1:num_chem_ecpp ) :: & - del_chem_clm_cldchem - - real(r8), intent(inout), dimension( 1:num_chem_ecpp ) :: & - del_chem_clm_rename - - real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & - del_cldchem3d ! 3D change from aqueous chemistry - - real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & - del_rename3d ! 3D change from modal merging - - real(r8), intent(inout) :: aqso4_h2o2, & ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) - aqso4_o3 ! SO4 aqueous phase chemistry due to O3 (kg/m2) - - real(r8), intent(inout), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2) :: & - xphlwc3d ! pH value multiplied by lwc - - - real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - ardz_cen_old, ardz_cen_new, acen_tavg_use, acen_prec_use - - real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen - - real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - rh_sub2, qcloud_sub2, qlsink_sub2, precr_sub2, precs_sub2 - - real(r8), intent(in), dimension( 1:2, num_chem_ecpp ) :: chem_bar_iccfactor - - integer, intent(in) :: activate_onoff_use - - integer, intent(in), dimension( 1:num_chem_ecpp ) :: & - iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & - inmw_of_aerosol, laicwpair_of_aerosol - type(physics_buffer_desc), pointer :: pbuf(:) - - - -! local variables - - integer :: icc, iccpp, iccpp1, iccpp2, ipp - integer :: jcls - integer :: k, kk, l, km - integer :: numgas_aqfrac - integer :: p1st - integer :: m, n - integer :: im, in, lnumcw - integer :: ncol - integer :: empty_troplev(pcols) = -99 ! This variable is not used in the modal_aero_rename_no_acc_crs_sub (which is - ! called witin modal_aero_rename_sub) when moal_accum_coars_exch is false - - real(r8) :: tmpa, tmpa1, tmpa2, tmpb1, tmpb2, tmpq, tmpq1, tmpq2, tmpx, tmpx2, tmpy, tmpy2 - real(r8) :: dtmpchem - - real(r8), parameter :: qcldwtr_cutoff = 1.0e-6_r8 - real(r8), parameter :: yph = 4.5_r8 ! in the MMF model, for ECPP, ph value is fixed at 4.5 - real(r8) :: dt_tmp - - real(r8), allocatable :: p_tmp(:,:,:), t_tmp(:,:,:), rho_tmp(:,:,:), & - alt_tmp(:,:,:), cldfra_tmp(:,:,:), & - qlsink_tmp(:,:,:), precr_tmp(:,:,:), & - precs_tmp(:,:,:), precg_tmp(:,:,:), preci_tmp(:,:,:) - real(r8), allocatable :: chem_tmpa(:,:,:,:), chem_tmpb(:,:,:,:), chem_tmpc(:,:,:,:) - - real(r8), allocatable :: cwat_tmp(:,:,:) - real(r8), allocatable :: pdel_tmp(:,:,:) - - real(r8), allocatable :: aqso4_tmp(:,:) - real(r8), allocatable :: aqh2so4_tmp(:,:) - real(r8), allocatable :: aqso4_h2o2_tmp(:) - real(r8), allocatable :: aqso4_o3_tmp(:) - real(r8), allocatable :: xphlwc_tmp(:,:) - real(r8), allocatable :: aqso4_h2o2_3dtmp(:,:) - real(r8), allocatable :: aqso4_o3_3dtmp(:,:) - - real(r8), allocatable :: mmr(:, :), vmr(:,:), mmrcw(:, :), vmrcw(:, :) - real(r8), allocatable :: vmr_3d(:,:,:), vmrcw_3d(:,:, :) - real(r8), allocatable :: vmr_sv1(:,:), vmrcw_sv1(:,:) - real(r8), allocatable :: mbar(:) - real(r8), allocatable :: mmr_3d(:, :, :), mmrcw_3d(:, :, :), mbar_3d(:, :) - real(r8), allocatable :: cldnum(:,:) - - real(r8) :: invariants_full(pcols, pver, nfs) - real(r8) :: t_full(pcols, pver) - real(r8) :: pmid_full(pcols, pver) - real(r8) :: h2ovmr_full(pcols, pver) - real(r8) :: vmr_full(pcols, pver, gas_pcnst) - - real(r8), allocatable :: qsrflx_full(:, :,:), qqcwsrflx_full(:, :,:) - integer :: nsrflx - integer :: nstep - integer :: jsrflx_rename - integer :: latndx_full(pcols, pver) - integer :: lonndx_full(pcols, pver) - real(r8) :: pdel_full(pcols, pver) - real(r8) :: dqdt(pver, gas_pcnst) - real(r8) :: dqdt_other(pver, gas_pcnst) - real(r8) :: dqqcwdt(pver, gas_pcnst) - real(r8) :: dqqcwdt_other(pver, gas_pcnst) - logical :: dotendrn(gas_pcnst) - logical :: dotendqqcwrn(gas_pcnst) - logical :: is_dorename_atik - logical :: dorename_atik(pver) - - p1st = param_first_ecpp - numgas_aqfrac = num_chem_ecpp - - nsrflx = 2 - jsrflx_rename = 2 - nstep = get_nstep() - - -! -! load arrays for interfacing with cloud chemistry subroutine -! -! use the wrfchem "i" index for the ecpp icc & ipp sub-class indices -! use the wrfchem "j" index for the ecpp jcls class index -! all the temporary real*4 arrays must be dimensioned kts:ktebnd -! - allocate ( p_tmp( 1:4,kts:ktecen,1:ncls_use) ) - allocate ( t_tmp( 1:4,kts:ktecen,1:ncls_use) ) - allocate ( rho_tmp( 1:4,kts:ktecen,1:ncls_use) ) - allocate ( alt_tmp( 1:4,kts:ktecen,1:ncls_use) ) - allocate ( cldfra_tmp( 1:4,kts:ktecen,1:ncls_use) ) - allocate ( qlsink_tmp( 1:4,kts:ktecen,1:ncls_use) ) - allocate ( precr_tmp( 1:4,kts:ktecen,1:ncls_use) ) - allocate ( precs_tmp( 1:4,kts:ktecen,1:ncls_use) ) - allocate ( precg_tmp( 1:4,kts:ktecen,1:ncls_use) ) - allocate ( preci_tmp( 1:4,kts:ktecen,1:ncls_use) ) - allocate ( cwat_tmp( 1:4,kts:ktecen,1:ncls_use) ) - allocate ( pdel_tmp( 1:4,kts:ktecen,1:ncls_use) ) - allocate ( chem_tmpa( 1:4,kts:ktecen,1:ncls_use,1:num_chem_ecpp) ) - allocate ( chem_tmpb( 1:4,kts:ktecen,1:ncls_use,1:num_chem_ecpp) ) - allocate ( chem_tmpc( 1:4,kts:ktecen,1:ncls_use,1:num_chem_ecpp) ) - - allocate ( mmr(kts:ktecen,1:gas_pcnst) ) - allocate ( vmr(kts:ktecen,1:gas_pcnst) ) - allocate ( mmrcw(kts:ktecen,1:gas_pcnst) ) - allocate ( vmrcw(kts:ktecen,1:gas_pcnst) ) - allocate ( vmr_sv1(kts:ktecen,1:gas_pcnst) ) - allocate ( vmrcw_sv1(kts:ktecen,1:gas_pcnst) ) - allocate ( mbar(kts:ktecen) ) - allocate ( cldnum(1,kts:ktecen) ) - allocate ( vmr_3d(1,kts:ktecen,1:gas_pcnst) ) - allocate ( vmrcw_3d(1,kts:ktecen,1:gas_pcnst) ) - allocate ( mmr_3d(1, kts:ktecen,1:gas_pcnst) ) - allocate ( mmrcw_3d(1, kts:ktecen, 1:gas_pcnst) ) - allocate ( mbar_3d(1, kts:ktecen) ) - - allocate (aqso4_tmp(1, ntot_amode)) - allocate (aqh2so4_tmp(1, ntot_amode)) - allocate (aqso4_h2o2_tmp(1)) - allocate (aqso4_o3_tmp(1)) - allocate (xphlwc_tmp(1,kts:ktecen)) - allocate (aqso4_h2o2_3dtmp(1,kts:ktecen)) - allocate (aqso4_o3_3dtmp(1,kts:ktecen)) - - allocate (qsrflx_full(pcols, gas_pcnst, nsrflx)) - allocate (qqcwsrflx_full(pcols, gas_pcnst, nsrflx)) - -! chem_tmpa, chem_tmpb and chem_tmpc start from bottom to top, just as chem_sub_new -! But mmr, mmrcw are reordered, starts from top to the bottom for aqueous chemistry at CAM. - do l = 1, num_chem_ecpp - do jcls = 1, ncls_use - do kk = kts, ktecen - k = min( kk, ktecen ) - do icc = 1, 2 - do ipp = 1, 2 - iccpp = 2*(icc-1) + ipp - chem_tmpa(iccpp,k,jcls,l) = chem_sub_new(k,icc,jcls,l) - end do - end do - end do - end do - end do - chem_tmpb(:,:,:,:) = chem_tmpa(:,:,:,:) - chem_tmpc(:,:,:,:) = chem_tmpa(:,:,:,:) - -! -! prepare fields for aqueous chemistry at CAM. - do kk = kts, ktecen - k = min( kk, ktecen ) -! -! vertical coordinate is from bottom to top in the ECPP, -! so convert it to from top to the bottom for aqueous chemistry at CAM. - km = ktecen-k+1 - p_tmp(1:4,k,1:ncls_use) = pcen_bar(km) - t_tmp(1:4,k,1:ncls_use) = tcen_bar(km) - rho_tmp(1:4,k,1:ncls_use) = rhocen_bar(km) - alt_tmp(1:4,k,1:ncls_use) = 1.0_r8/rhocen_bar(km) - pdel_tmp(1:4,k,1:ncls_use) = rhocen_bar(km)*dzcen(km)*gravit - end do - - cldfra_tmp(:,:,:) = 0.0_r8 - qlsink_tmp(:,:,:) = 0.0_r8 - precr_tmp(:,:,:) = 0.0_r8 - precg_tmp(:,:,:) = 0.0_r8 - precs_tmp(:,:,:) = 0.0_r8 - preci_tmp(:,:,:) = 0.0_r8 - cwat_tmp(:,:,:) = 0.0_r8 - - do jcls = 1, ncls_use - do k = kts, ktecen -! -! vertical coordinate is from bottom to top in the ECPP, -! so convert it to from top to the bottom for aqueous chemistry at CAM. - km = ktecen-k+1 - do icc = 1, 2 - do ipp = 1, 2 - iccpp = 2*(icc-1) + ipp - if (ipp == 1) then - tmpa = acen_tavg_use(km,icc,jcls) - acen_prec_use(km,icc,jcls) - else - tmpa = acen_prec_use(km,icc,jcls) - end if - tmpq = qcloud_sub2(km,icc,jcls,ipp) - if ((tmpa > afrac_cut_0p5) .and. (tmpq > qcldwtr_cutoff)) then - qlsink_tmp(iccpp,k,jcls) = qlsink_sub2(km,icc,jcls,ipp) - cwat_tmp(iccpp,k,jcls) = tmpq - end if - - if (icc == 2) then - if(tmpa > afrac_cut_0p5) then - cldfra_tmp(iccpp,k,jcls) = 1.0_r8 - end if - end if - - precr_tmp(iccpp,k,jcls) = precr_sub2(km,icc,jcls,ipp) - precs_tmp(iccpp,k,jcls) = precs_sub2(km,icc,jcls,ipp) - end do - end do - end do - end do - - - dt_tmp = dtstep_sub - - if (cldchem_onoff_ecpp > 0) then - - do jcls = 1, ncls_use - do icc = 2, 2 ! In clear sky, cloud chemistry and renaming are not called. - do ipp = 1, 2 - iccpp = 2*(icc-1) + ipp - ncol = 1 - - !---------------------------------------------------------------------- - ! calculate cldnum from cloud borne aerosol particles - ! Vertical coordinate is from bottom to top in the ECPP for chem_tempb, - ! so convert it to from top to the bottom for aqueous chemistry at CAM. - !---------------------------------------------------------------------- - cldnum(1,:) = 0.0_r8 - do in=1, ntype_aer - do im=1, nsize_aer(in) - lnumcw = numptr_aer(im, in, cw_phase) - do k=kts, ktecen - km=ktecen-k+1 - cldnum(1,k) = cldnum(1,k)+chem_tmpb(iccpp,km,jcls,lnumcw) - end do - end do - end do - - !----------------------------------------------------------------------- - ! ... map incoming concentrations to working array - ! Vertical coordinate is from bottom to top in the ECPP for chem_tempb, - ! so convert it to from top to the bottom for aqueous chemistry at CAM. - !----------------------------------------------------------------------- - mmr(:, :) = 0.0_r8 - mmrcw(:, :) = 0.0_r8 - do m = 1,pcnst - n = map2chm(m) - if( n > 0 ) then - do k = kts, ktecen - km = ktecen-k+1 - mmr(k,n) = chem_tmpb(iccpp,km,jcls,m) - mmrcw(k,n) = chem_tmpb(iccpp,km,jcls,m+pcnst) - end do - end if - end do - - !----------------------------------------------------------------------- - ! ... Set atmosphere mean mass - !----------------------------------------------------------------------- - mmr_3d(1, :, :) = mmr(:, :) - call set_mean_mass( ncol, mmr_3d, mbar_3d ) - mbar(:) = mbar_3d(1, :) - - !----------------------------------------------------------------------- - ! ... Xform from mmr to vmr - !----------------------------------------------------------------------- - vmr_3d(1, :, :) = vmr(:, :) - mmr_3d(1, :, :) = mmr(:, :) - mmrcw_3d(1, :, :) = mmrcw(:, :) - vmrcw_3d(1, :, :) = vmrcw(:, :) - call mmr2vmr( mmr_3d, vmr_3d, mbar_3d, ncol ) - call mmr2vmr( mmrcw_3d, vmrcw_3d, mbar_3d, ncol ) - - vmr_sv1 = vmr_3d(1,:,:) - vmrcw_sv1 = vmrcw_3d(1,:,:) - - vmr(:,:) = vmr_3d(1,:,:) - vmrcw(:,:) = vmrcw_3d(1,:,:) - - !----------------------------------------------------------------------- - ! ... Set the "invariants" - !----------------------------------------------------------------------- - h2ovmr_full(:, :) = 0.0_r8 ! h2ommr is not used in CAM aqueous chemistry, so set it to zero here. - do kk = kts, ktecen - k = min( kk, ktecen) - t_full(:, k) = t_tmp(iccpp, k,jcls) - pmid_full(:, k) = p_tmp(iccpp, k, jcls) - do n=1, gas_pcnst - vmr_full(:, k, n) = vmr(k, n) - end do - end do - call setinv( invariants_full(:it,:,:), t_full, h2ovmr_full(:it,:), vmr_full(:it,:,:), pmid_full, it, jt, pbuf) ! jt=lchnk - - !-------------------------------------------------------------------------- - ! ... Aqueous chemistry - !-------------------------------------------------------------------------- - call setsox( ncol, & ! ncol - jt, & ! lchnk - imozart-1,& ! loffset - dt_tmp, & ! dtime - p_tmp(iccpp:iccpp, :, jcls), & ! press - pdel_tmp(iccpp:iccpp, :, jcls), & ! pdel - t_tmp(iccpp:iccpp, :, jcls), & ! tfld - mbar_3d, & ! mbar(1,:) - cwat_tmp(iccpp:iccpp, :, jcls), & ! lwc - cldfra_tmp(iccpp:iccpp, :, jcls), & ! cldfrc - cldnum, & ! cldnum - invariants_full(it:it,:,indexm), & ! xhnm - invariants_full(it:it,:,:), & ! invariants - vmrcw_3d, & ! qcw - vmr_3d, & ! qin - xphlwc_tmp, & - aqso4_tmp, & - aqh2so4_tmp, & - aqso4_h2o2_tmp, & - aqso4_o3_tmp, & - yph, & - aqso4_h2o2_3dtmp, & - aqso4_o3_3dtmp ) - - !----------------------------------------------------------------------- - ! ... Xform from vmr to mmr - !----------------------------------------------------------------------- - vmr(:,:) = vmr_3d(1,:,:) - vmrcw(:,:) = vmrcw_3d(1,:,:) - call vmr2mmr( vmr, mmr_3d, mbar, ncol ) - call vmr2mmr( vmrcw, mmrcw_3d, mbar, ncol ) - mmr(:, :) = mmr_3d(1, :, :) - mmrcw(:, :) = mmrcw_3d(1, :, :) - - !----------------------------------------------------------------------- - ! ... Form the tendencies - ! Vertical coordinate is from top to bottom in the aqueous chemistry at CAM, - ! so convert it to from bottom to the top in the ECPP for chem_tmpb. - !----------------------------------------------------------------------- - do m = 1,pcnst - n = map2chm(m) - if( n > 0 ) then - do k = kts, ktecen - km = ktecen-k+1 - chem_tmpb(iccpp, k,jcls,m) = mmr(km,n) - chem_tmpb(iccpp, k,jcls,m+pcnst) = mmrcw(km,n) - end do - end if - end do - - do k = kts, ktecen - km = ktecen-k+1 ! acen is defined in the ECPP (from bottom to top) - if (ipp == 1) then - tmpa = acen_tavg_use(k,icc,jcls) - acen_prec_use(k,icc,jcls) - else - tmpa = acen_prec_use(k,icc,jcls) - end if - if (tmpa > afrac_cut_0p5) then - aqso4_h2o2 = aqso4_h2o2+tmpa * aqso4_h2o2_3dtmp(1, km)*dt_tmp - aqso4_o3 = aqso4_o3 + tmpa * aqso4_o3_3dtmp(1, km)*dt_tmp - end if -! -! xphlwc_tmp is defined in CAM( top to bottom), and xphlwc3d is defined in ECPP (bottom to top) - xphlwc3d(k,icc,jcls,ipp) = xphlwc3d(k,icc,jcls,ipp) + xphlwc_tmp(1,km) * tmpa - - end do - -!----------------------------------------------------------------------------- -! ----- renaming: modal aerosol mode merging ------ -!----------------------------------------------------------------------------- - if(rename_onoff_ecpp > 0) then - do kk = kts, ktecen - k = min( kk, ktecen) - pdel_full(:, k) = p_tmp(iccpp, k, jcls) - end do - latndx_full(:,:) = 1 - lonndx_full(:,:) = 1 - qsrflx_full(:,:,:) = 0.0_r8 - qqcwsrflx_full(:,:,:) = 0.0_r8 - dotendrn(:) = .false. - dotendqqcwrn(:) = .false. - dorename_atik(:) = .true. - is_dorename_atik = .true. - dqdt (:,:) = 0.0_r8 - dqqcwdt(:,:) = 0.0_r8 - dqdt_other(:,:)=(vmr-vmr_sv1)/dt_tmp - dqqcwdt_other(:,:)=(vmrcw-vmrcw_sv1)/dt_tmp - - call modal_aero_rename_sub('ecpp_modal_cloudchem', jt, & - ncol, nstep, & - imozart-1, dt_tmp, & - pdel_full, empty_troplev, & - dotendrn, vmr, & - dqdt, dqdt_other, & - dotendqqcwrn, vmrcw, & - dqqcwdt, dqqcwdt_other, & - is_dorename_atik, dorename_atik, & - jsrflx_rename, nsrflx, & - qsrflx_full, qqcwsrflx_full ) - vmr = vmr + dqdt * dt_tmp - vmrcw = vmrcw + dqqcwdt * dt_tmp - - !----------------------------------------------------------------------- - ! ... Xform from vmr to mmr - !----------------------------------------------------------------------- - call vmr2mmr( vmr, mmr_3d, mbar, ncol ) - call vmr2mmr( vmrcw, mmrcw_3d, mbar, ncol ) - mmr(:, :) = mmr_3d(1, :, :) - mmrcw(:, :) = mmrcw_3d(1, :, :) - - !----------------------------------------------------------------------- - ! ... Form the tendencies - ! Vertical coordinate is from top to bottom in the aqueous chemistry at CAM, - ! so convert it to from bottom to the top in the ECPP for chem_tmpb. - !----------------------------------------------------------------------- - do m = 1,pcnst - n = map2chm(m) - if( n > 0 ) then - do k = kts, ktecen - km = ktecen-k+1 - chem_tmpc(iccpp, k,jcls,m) = mmr(km,n) - chem_tmpc(iccpp, k,jcls,m+pcnst) = mmrcw(km,n) - end do - end if - end do - - - end if ! (rename_onoff_ecpp > 0) - - end do - end do - end do - - do l = p1st, num_chem_ecpp - tmpx = 0.0_r8 - tmpx2 = 0.0_r8 - do k = kts, ktecen - tmpy = 0.0_r8 - tmpy2 = 0.0_r8 - do jcls = 1, ncls_use - do icc = 1, 2 - do ipp = 1, 2 - iccpp = 2*(icc-1) + ipp - if (ipp == 1) then - tmpa = acen_tavg_use(k,icc,jcls) - acen_prec_use(k,icc,jcls) - else - tmpa = acen_prec_use(k,icc,jcls) - end if - - if (tmpa > afrac_cut_0p5) then - tmpq = (chem_tmpb(iccpp,k,jcls,l) - chem_tmpa(iccpp,k,jcls,l)) - tmpy = tmpy + tmpa*tmpq - del_cldchem3d(k,icc,jcls,ipp,l)=del_cldchem3d(k,icc,jcls,ipp,l)+tmpa*tmpq - else - del_cldchem3d(k,icc,jcls,ipp,l)=del_cldchem3d(k,icc,jcls,ipp,l)+0.0_r8 - end if - - if(rename_onoff_ecpp > 0 ) then - if (tmpa > afrac_cut_0p5) then - tmpq = (chem_tmpc(iccpp,k,jcls,l) - chem_tmpb(iccpp,k,jcls,l)) - tmpy2 = tmpy2 + tmpa*tmpq - del_rename3d(k,icc,jcls,ipp,l)=del_rename3d(k,icc,jcls,ipp,l)+tmpa*tmpq - else - del_rename3d(k,icc,jcls,ipp,l)=del_rename3d(k,icc,jcls,ipp,l)+0.0_r8 - end if - end if ! (rename_onoff_ecpp > 0.) - - end do ! ipp - end do ! icc - end do ! jcls - tmpx = tmpx + tmpy*rhodz_cen(k) - if(rename_onoff_ecpp > 0 ) tmpx2 = tmpx2+tmpy2 * rhodz_cen(k) - end do ! k - - del_chem_clm_cldchem(l) = del_chem_clm_cldchem(l) + tmpx - if(rename_onoff_ecpp > 0 ) & - del_chem_clm_rename(l) = del_chem_clm_rename(l) + tmpx2 - end do ! l - - end if ! (cldchem_onoff_ecpp > 0) - - if ((cldchem_onoff_ecpp > 0)) then - - do l = p1st, num_chem_ecpp - do k = kts, ktecen - do jcls = 1, ncls_use - do icc = 1, 2 - tmpa1 = acen_tavg_use(k,icc,jcls) - acen_prec_use(k,icc,jcls) - tmpa2 = acen_prec_use(k,icc,jcls) - if ((tmpa1 <= afrac_cut_0p5) .and. (tmpa2 <= afrac_cut_0p5)) cycle - - iccpp1 = 2*(icc-1) + 1 - iccpp2 = 2*(icc-1) + 2 - - if(rename_onoff_ecpp > 0 ) then - if ((tmpa1 > afrac_cut_0p5) .and. (tmpa2 > afrac_cut_0p5)) then - tmpb1 = max( 0.0_r8, min( 1.0_r8, (tmpa1/(tmpa1+tmpa2)) ) ) - tmpb2 = 1.0_r8 - tmpb1 - tmpq1 = chem_tmpa(iccpp1,k,jcls,l)*tmpb1 & - + chem_tmpa(iccpp2,k,jcls,l)*tmpb2 - tmpq2 = chem_tmpc(iccpp1,k,jcls,l)*tmpb1 & - + chem_tmpc(iccpp2,k,jcls,l)*tmpb2 - else if (tmpa1 > afrac_cut_0p5) then - tmpq1 = chem_tmpa(iccpp1,k,jcls,l) - tmpq2 = chem_tmpc(iccpp1,k,jcls,l) - else - tmpq1 = chem_tmpa(iccpp2,k,jcls,l) - tmpq2 = chem_tmpc(iccpp2,k,jcls,l) - end if - else ! no renaming - if ((tmpa1 > afrac_cut_0p5) .and. (tmpa2 > afrac_cut_0p5)) then - tmpb1 = max( 0.0_r8, min( 1.0_r8, (tmpa1/(tmpa1+tmpa2)) ) ) - tmpb2 = 1.0_r8 - tmpb1 - tmpq1 = chem_tmpa(iccpp1,k,jcls,l)*tmpb1 & - + chem_tmpa(iccpp2,k,jcls,l)*tmpb2 - tmpq2 = chem_tmpb(iccpp1,k,jcls,l)*tmpb1 & - + chem_tmpb(iccpp2,k,jcls,l)*tmpb2 - else if (tmpa1 > afrac_cut_0p5) then - tmpq1 = chem_tmpa(iccpp1,k,jcls,l) - tmpq2 = chem_tmpb(iccpp1,k,jcls,l) - else - tmpq1 = chem_tmpa(iccpp2,k,jcls,l) - tmpq2 = chem_tmpb(iccpp2,k,jcls,l) - end if - end if ! (rename_onoff_ecpp > 0) - if (tmpq1 /= tmpq2) chem_sub_new(k,icc,jcls,l) = tmpq2 - - end do ! icc - end do ! jcls - end do ! k - end do ! l - - end if ! ((cldchem_onoff_ecpp > 0)) - - - deallocate ( p_tmp, t_tmp, rho_tmp, alt_tmp, & - cldfra_tmp, & - qlsink_tmp, & - precr_tmp, precs_tmp, precg_tmp, preci_tmp ) - deallocate ( chem_tmpa, chem_tmpb, chem_tmpc) - deallocate ( mmr, mmrcw, vmr, vmrcw, vmr_sv1, vmrcw_sv1, & - mbar, cldnum, mmr_3d, mmrcw_3d, mbar_3d, & - qsrflx_full, qqcwsrflx_full) - - deallocate ( cwat_tmp, pdel_tmp, vmr_3d, vmrcw_3d, & - aqso4_tmp, aqh2so4_tmp, aqso4_h2o2_tmp, & - aqso4_o3_tmp, xphlwc_tmp, aqso4_h2o2_3dtmp, & - aqso4_o3_3dtmp) - return - end subroutine parampollu_tdx_cldchem - -end module ecpp_modal_cloudchem diff --git a/src/physics/spcam/ecpp/ecpp_modal_wetscav.F90 b/src/physics/spcam/ecpp/ecpp_modal_wetscav.F90 deleted file mode 100644 index 862f45278c..0000000000 --- a/src/physics/spcam/ecpp/ecpp_modal_wetscav.F90 +++ /dev/null @@ -1,1898 +0,0 @@ -module ecpp_modal_wetscav - -!----------------------------------------------------------------- -! Module interface for cloud chemistry used in the ECPP treatment -! in the MMF model -! Adopted the similar one used in the ECPP -! for the WRF-chem model written by Dick Easter -! -! Minghuai Wang, 2009-11 -!------------------------------------------------------------------ - use shr_kind_mod, only: r8 => shr_kind_r8 - use perf_mod - use cam_abortutils, only: endrun - - implicit none - - public parampollu_tdx_wetscav_2 - -contains - -!----------------------------------------------------------------------- - subroutine parampollu_tdx_wetscav_2( & - ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & - itstep_hybrid, & - idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & -! rhobnd_bar, zbnd, wbnd_bar, & not needed ? -! chem_bar, & not needed ? -! ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & -! kdraft_bot_use, kdraft_top_use, & not needed ? -! mtype_updnenv_use, & not needed ? - chem_sub_new, & - del_chem_clm_wetscav, & - del_wetscav3d, del_wetresu3d, & -! ardz_cen_old, ardz_cen_new, & not needed ? - rhodz_cen, & - acen_tavg_use, acen_prec_use, & - rh_sub2, qcloud_sub2, qlsink_sub2, & - precr_sub2, precs_sub2, & -! chem_bar_iccfactor, & not needed ? - activate_onoff_use, & - iphase_of_aerosol, isize_of_aerosol, & - itype_of_aerosol, inmw_of_aerosol, & - laicwpair_of_aerosol ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_tdx_wetscav_2 does wet scavenging of aerosols only -! for one main-integ time sub-step -! -! incoming chem_sub_new holds current sub-class mixing ratios -! outgoing chem_sub_new holds updated sub-class mixing ratios -! -!----------------------------------------------------------------------- - -! use module_state_description, only: p_qv, p_qc - -! use module_data_radm2, only: epsilc - -! use module_data_mosaic_asect, only: ai_phase, cw_phase, & -! massptr_aer, maxd_asize, maxd_atype, & -! ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer, & -! waterptr_aer - use module_data_mosaic_asect, only: & - ai_phase, cw_phase, & - massptr_aer, maxd_asize, maxd_atype, & - ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer - - use module_data_ecpp1 - -! use module_ecpp_hoststuff, only: config_flags_ecpp - -! use module_mosaic_wetscav, only: wetscav_cbmz_mosaic - -! use module_ecpp_util, only: ecpp_error_fatal, ecpp_message, & -! parampollu_1clm_set_opts - - implicit none - -! arguments - integer, intent(in) :: & - ktau, ktau_pp, itstep_sub, & - it, jt, kts, ktebnd, ktecen - integer, intent(in) :: itstep_hybrid -! ktau - time step number -! ktau_pp - time step number for "parameterized pollutants" calculations -! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" -! chem_driver and routines under it do calculations -! over these spatial indices. - - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199), & - idiagbb_wetscav - - real(r8), intent(in) :: dtstep, dtstep_sub -! dtstep - main model time step (s) -! dtstep_sub - sub time step (s) currently used in ecpp main-integ routine - - real(r8), intent(in), dimension( kts:ktecen ) :: & - tcen_bar, pcen_bar, rhocen_bar, dzcen -! real(r8), intent(in), dimension( kts:ktebnd ) :: & -! rhobnd_bar, wbnd_bar, zbnd -! tcen_bar - temperature (K) at layer centers -! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries -! pcen_bar - air pressure (Pa) at layer centers -! wbnd_bar - vertical velocity (m/s) at layer boundaries -! zbnd - elevation (m) at layer boundaries -! dzcen - layer thicknesses (m) - -! real(r8), intent(in), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & -! chem_bar -! chem_bar - mixing ratios of trace gase (ppm) and aerosol species -! (ug/kg for mass species, #/kg for number species) - - integer, intent(in) :: ncls_use -! integer, intent(in) :: ncls_ecpp - -! integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & -! kdraft_bot_use, kdraft_top_use, & -! mtype_updnenv_use - - real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_sub_new - - real(r8), intent(inout), dimension( 1:num_chem_ecpp ) :: & - del_chem_clm_wetscav -! del_chem_clm_wetscav(l) = & -! sum( rhodz_cen(kts:ktecen) * ( del_wetscav3d(kts:ktecen,1:2,1:ncls_use,1:2,l) & -! + del_wetresu3d(kts:ktecen,1:2,1:ncls_use,1:2,l) ) ) - - real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & - del_wetscav3d, del_wetresu3d -! del_wetscav3d = acen * (change to chem_sub due to uptake by precip) -! the change for the current time sub-step is added to this array, so the array holds -! the cummulative change over multiple time steps -! this is always negative (or zero), and units are (kg/m^2) -! del_wetresu3d = acen * (change to chem_sub due to resuspension from precip evaporation) -! this is always positive (or zero), and units are (kg/m^2) -! -! units for del_wetscav/resu3d will be (kg/m^2) or (#/m^2) in cam, -! where all tracer mixing ratios are (kg/kgair) -! in wrfchem, units are (ug/m^2) and (#/m^2) for aerosol mass and number -! for gases, they are (mg/m^2) AFTER one applies a molecular weight ratio -! the important thing is that their sum is always equal to the column burden change, -! where column burden = sum_over_k[ (mixing ratio)*(air density, kg/m^3)*(dz, m) ] - - real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - acen_tavg_use, acen_prec_use -! ardz_cen_old, ardz_cen_new, - - real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen - - real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - rh_sub2, qcloud_sub2, qlsink_sub2, precr_sub2, precs_sub2 - -! real(r8), intent(in), dimension( 1:2, num_chem_ecpp ) :: chem_bar_iccfactor - - integer, intent(in) :: activate_onoff_use - - integer, intent(in), dimension( 1:num_chem_ecpp ) :: & - iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & - inmw_of_aerosol, laicwpair_of_aerosol - - - -! local variables - integer, parameter :: nwdt = 1 - - integer :: icc, icc_g, icc_l, iphase, ipp, ipp_l, ipp_g - integer :: jcls, jcls_g, jcls_l - integer :: k, kk, km1, kp1 - integer :: l, ll, lun142 - integer :: lgas_scav(1:num_chem_ecpp) - integer :: m, mwdt - integer :: n - integer, parameter :: maxgas_scav = 4 - integer :: ngas_scav - integer :: p1st - integer :: inwdt - - logical :: skip_aer_resu, skip_gas_scav - logical, dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - is_active, is_precp, is_ptgain, is_ptloss, is_rain -! is_active = .true. if sub-subarea has acen > afrac_cut_0p5 -! is_precp = .true. if sub-subarea has prtb > prsmall -! is_ptgain = .true. prtb increases from k+1 to k for the sub-subarea -! is_ptloss = .true. prtb decreases from k+1 to k for the sub-subarea - logical, dimension( 1:2, 1:maxcls_ecpp, 1:2 ) :: & - ltmp_aa3d - - real(r8) :: delprtb_gtot, delprtb_ltot, delprtb_xtot - real(r8) :: dt_scav - real(r8) :: flxdt, flxdt_kp1 - real(r8) :: qgcx, qgcx_bgn - real(r8) :: frac_scav - real(r8) :: prsmall - real(r8) :: rate_scav - real(r8) :: scavcoef - real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf, tmpq - real(r8) :: tmpx, tmpx2, tmpy, tmpy2 - real(r8) :: tmpa1, tmpa2, tmpb1, tmpb2, tmpq1, tmpq2 - real(r8) :: tmp_ardzcen, tmpvol - - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & - chem_tmpa, chem_tmpb - real(r8), dimension( 1:num_chem_ecpp ) :: curdel_chem_clm_wetscav - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:max_wetdiagtype, 1:num_chem_ecpp ) :: & - delchem_wetscav, delchem_wetresu -! delchem_wetscav = [ change to chem from wet scavenging over dt_scav ] ] * acen_tmp * rhodz_cen -! so units are (kg/m^2) -! delchem_wetresu = similar, but change from resuspension (due to precip evap) - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:max_wetdiagtype, 1:num_chem_ecpp ) :: & - chem_prflxdt, chem_prflxdt_xfer -! chem_prflxdt = [ downwards flux of precip-borne-tracers (kg/m^2/s) for subarea -! if it were spread over the entire host-code grid cell area ] * dt_scav -! so units are (kg/m^2) -! chem_prflxdt_xfer = net transfer of chem_prflxdt into subarea from other subareas - - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: acen_tmp -! acen_tmp = fractional at layer centers for all 2 X 3 X 2 sub-subareas - real(r8), dimension( kts:ktebnd, 1:2, 1:maxcls_ecpp, 1:2 ) :: prra, prsa, prta, prtb -! prta = total (liquid + solid) precip rate (kg/m^2/s) within the subarea -! prra, prsa = liquid, solid precip rate (kg/m^2/s) within the subarea -! prtb = prta*acen_tmp = subarea precip rate -! if it were spread over the entire host-code grid cell area - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - delprtb, delprtb_g, delprtb_l -! depprtb = change in prtb from k+1 to k (kg/m^2/s) -! depprtb_g = increase in prtb from k+1 to k -! depprtb_l = abs( decrease in prtb from k+1 to k ) - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: frac_evap_prtb - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, & - 1:2, 1:maxcls_ecpp, 1:2 ) :: frac_xfer_prtb - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, & - 1:2, 1:maxcls_ecpp, 1:2 ) :: fxaa_evap_prtb -! frac_evap_prtb = fraction of precip (and precip-borne aerosols) entering the -! top of a subarea that is evaporated/resuspended -! frac_xfer_prtb = fraction of precip (and precip-borne aerosols) entering the -! top of a subarea that is transferred to another subarea -! (the first set of icc,jcls,ipp indices are the "xfer from" subarea) -! (the second set of icc,jcls,ipp indices are the "xfer to " subarea) - - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:maxd_asize, 1:maxd_atype ) :: & - scavcoef_num, scavcoef_vol -! scavcoef_vol = below-cloud scavenging coeficient for volume (1/mm) -! scavcoef_num = below-cloud scavenging coeficient for number (1/mm) -! when precip rate = xxx kg/m2/s == xxx mm/s, the scavenging rate (1/s) = scavcoef*xxx - - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, maxgas_scav ) :: & - gasscav_aa, gasscav_bb - - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - gasscav_cc - - - call t_startf('ecpp_wetscav_init') -! write(*,'(a)') 'wetscav_2 doing part 1 stuff' - - lun142 = -1 - if (idiagaa_ecpp(142) > 0) lun142 = ldiagaa_ecpp(142) - if (idiagbb_wetscav <= 0) lun142 = -1 - - p1st = param_first_ecpp - dt_scav = dtstep_sub - - mwdt = 1 - - skip_gas_scav = .false. ! flag for gas scavenging on/off - if (wetscav_onoff_ecpp < 400) skip_gas_scav = .true. - skip_aer_resu = .false. ! flag for aerosol resuspension on/off - if (wetscav_onoff_ecpp == 310) skip_aer_resu = .true. - if (wetscav_onoff_ecpp == 410) skip_aer_resu = .true. - -! load chem_tmpa array - chem_tmpa = 0.0_r8 - do l = p1st, num_chem_ecpp - do jcls = 1, ncls_use - do icc = 1, 2 - do k = kts, ktecen - chem_tmpa(k,icc,jcls,1:2,l) = chem_sub_new(k,icc,jcls,l) - end do - end do - end do - end do - chem_tmpb(:,:,:,:,:) = chem_tmpa(:,:,:,:,:) - - curdel_chem_clm_wetscav(:) = 0.0_r8 - delchem_wetscav(:,:,:,:,:,:) = 0.0_r8 - delchem_wetresu(:,:,:,:,:,:) = 0.0_r8 - chem_prflxdt(:,:,:,:,:,:) = 0.0_r8 - chem_prflxdt_xfer(:,:,:,:,:,:) = 0.0_r8 - - -! precip rates -- 1.0 kgwtr/m^2/s = 1.0e-3 m3wtr/m^2/s = 1.0e-3 m/s -! 7.06e-5 kg/m^2/s = 7.06e-8 m/s = 0.01 inch/h -! 1.00e-7 kg/m^2/s = 1.00e-10 m/s = (0.01 inch/h) * 0.0014 is a very small precip rate! - prsmall = 1.0e-7_r8 - -! load precip rates for each icc,jcls,ipp subarea - prta(:,:,:,:) = 0.0_r8 - prtb(:,:,:,:) = 0.0_r8 - prra(:,:,:,:) = 0.0_r8 - prsa(:,:,:,:) = 0.0_r8 - acen_tmp(:,:,:,:) = 0.0_r8 - - is_active(:,:,:,:) = .false. - is_precp(:,:,:,:) = .false. - is_ptgain(:,:,:,:) = .false. - is_ptloss(:,:,:,:) = .false. - is_rain(:,:,:,:) = .false. - - do jcls = 1, ncls_use - do icc = 1, 2 - do k = kts, ktecen - tmpa = max( 0.0_r8, acen_tavg_use(k,icc,jcls) ) - tmpb = max( 0.0_r8, acen_prec_use(k,icc,jcls) ) - tmpb = min( tmpa, tmpb ) - - if (tmpa <= afrac_cut_0p5) then ! both ipp=1&2 have near-zero area - continue - else if (tmpb <= afrac_cut_0p5) then ! ipp=2 has near-zero area - is_active(k,icc,jcls,1) = .true. - acen_tmp(k,icc,jcls,1) = tmpa - prta(k,icc,jcls,1) = precr_sub2(k,icc,jcls,1) + precs_sub2(k,icc,jcls,1) - prtb(k,icc,jcls,1) = prta(k,icc,jcls,1)*acen_tmp(k,icc,jcls,1) - else if (tmpa-tmpb <= afrac_cut_0p5) then ! ipp=1 has near-zero area - is_active(k,icc,jcls,2) = .true. - acen_tmp(k,icc,jcls,2) = tmpb - prta(k,icc,jcls,2) = precr_sub2(k,icc,jcls,2) + precs_sub2(k,icc,jcls,2) - prtb(k,icc,jcls,2) = prta(k,icc,jcls,2)*acen_tmp(k,icc,jcls,2) - else ! both ipp=1&2 have areas > threshold - is_active(k,icc,jcls,1) = .true. - acen_tmp(k,icc,jcls,1) = tmpa-tmpb - prta(k,icc,jcls,1) = precr_sub2(k,icc,jcls,1) + precs_sub2(k,icc,jcls,1) - prtb(k,icc,jcls,1) = prta(k,icc,jcls,1)*acen_tmp(k,icc,jcls,1) - is_active(k,icc,jcls,2) = .true. - acen_tmp(k,icc,jcls,2) = tmpb - prta(k,icc,jcls,2) = precr_sub2(k,icc,jcls,2) + precs_sub2(k,icc,jcls,2) - prtb(k,icc,jcls,2) = prta(k,icc,jcls,2)*acen_tmp(k,icc,jcls,2) - end if - - do ipp = 1, 2 - if ( is_active(k,icc,jcls,ipp) ) then - prtb(k,icc,jcls,ipp) = prta(k,icc,jcls,ipp)*acen_tmp(k,icc,jcls,ipp) - if (prtb(k,icc,jcls,ipp) > prsmall) then - is_precp(k,icc,jcls,ipp) = .true. - prsa(k,icc,jcls,ipp) = precs_sub2(k,icc,jcls,ipp) - if (precr_sub2(k,icc,jcls,ipp)*acen_tmp(k,icc,jcls,ipp) > prsmall) then - prra(k,icc,jcls,ipp) = precr_sub2(k,icc,jcls,ipp) - is_rain(k,icc,jcls,ipp) = .true. - end if - else - prta(k,icc,jcls,ipp) = 0.0_r8 - prtb(k,icc,jcls,ipp) = 0.0_r8 - end if - end if - end do - end do - end do - end do - call t_stopf('ecpp_wetscav_init') - - -! -! calculate the fractions of precip (and precip-borne aerosols) -! entering the top of a subarea that are either -! > evaporated/resuspended or -! > transferred to another subarea -! - call t_startf('ecpp_wetscav_precip_evap') - call wetscav_2_precip_evap_xfer( & - ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & - idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - is_active, is_precp, is_ptgain, is_ptloss, & - acen_tmp, prtb, frac_evap_prtb, frac_xfer_prtb, & - fxaa_evap_prtb ) - call t_stopf('ecpp_wetscav_precip_evap') - - -! -! calculate below-cloud scavenging coeficients for interstitial aerosols -! - call t_startf('ecpp_wetscav_bcscav') - call wetscav_2_bcscavcoef( & - ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & - idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & - tcen_bar, pcen_bar, rhocen_bar, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - rh_sub2, & - is_active, is_precp, & - chem_tmpa, scavcoef_num, scavcoef_vol ) - call t_stopf('ecpp_wetscav_bcscav') - - -! -! calculate stuff for below-cloud gas scavenging -! - call t_startf('ecpp_wetscav_gascav') - call wetscav_2_gasscav( & - ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & - dt_scav, & - idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - is_active, is_precp, is_rain, & - maxgas_scav, ngas_scav, lgas_scav, & - acen_tmp, prra, & - qcloud_sub2, qlsink_sub2, & - gasscav_aa, gasscav_bb, gasscav_cc ) - call t_stopf('ecpp_wetscav_gascav') - - -! -! -! now calculate -! in-cloud & below-cloud aerosol wet removal -! below-cloud resuspension from evaporating precip -! -! - call t_startf('ecpp_wetscav_main') -wetscav_main_kloop_aa: & - do k = ktecen, kts, -1 - - -! set precip-borne_flux to that of layer above - if (k < ktecen) then - chem_prflxdt(k,:,:,:,:,:) = chem_prflxdt(k+1,:,:,:,:,:) - end if - if (wetscav_onoff_ecpp < 200) cycle wetscav_main_kloop_aa - - -! -! do transfer of precip-borne tracers between subareas -! and resuspension from evaporation -! - if (k < ktecen) then -! loop over the "losing" subareas - do jcls_l = 1, ncls_use - do ipp_l = 1, 2 - do icc_l = 1, 2 - if ( .not. is_ptloss(k,icc_l,jcls_l,ipp_l) ) cycle - -! loop over the "gaining" subareas, -! transferring chem_prflxdt from losing to gaining subarea - do jcls_g = 1, ncls_use - do ipp_g = 1, 2 - do icc_g = 1, 2 - if ( .not. is_ptgain(k,icc_g,jcls_g,ipp_g) ) cycle - tmpa = frac_xfer_prtb(k,icc_l,jcls_l,ipp_l, icc_g,jcls_g,ipp_g) - if (tmpa <= 0.0_r8) cycle - do l = p1st, num_chem_ecpp - if ( skip_gas_scav .and. (inmw_of_aerosol(l) <= 0)) cycle - tmpb = chem_prflxdt(k+1,icc_l,jcls_l,ipp_l,mwdt,l)*tmpa - chem_prflxdt(k ,icc_g,jcls_g,ipp_g,mwdt,l) = & - chem_prflxdt(k ,icc_g,jcls_g,ipp_g,mwdt,l) + tmpb - chem_prflxdt(k ,icc_l,jcls_l,ipp_l,mwdt,l) = & - chem_prflxdt(k ,icc_l,jcls_l,ipp_l,mwdt,l) - tmpb - - chem_prflxdt_xfer(k ,icc_g,jcls_g,ipp_g,mwdt,l) = & - chem_prflxdt_xfer(k ,icc_g,jcls_g,ipp_g,mwdt,l) + tmpb - chem_prflxdt_xfer(k ,icc_l,jcls_l,ipp_l,mwdt,l) = & - chem_prflxdt_xfer(k ,icc_l,jcls_l,ipp_l,mwdt,l) - tmpb - end do - end do ! icc_g - end do ! ipp_g - end do ! jcls_g - -! do resuspension from evaporation here - tmpa = frac_evap_prtb(k,icc_l,jcls_l,ipp_l) - if (tmpa <= 0.0_r8) cycle - - tmp_ardzcen = acen_tmp(k,icc_l,jcls_l,ipp_l)*rhodz_cen(k) - do l = p1st, num_chem_ecpp - if ( skip_gas_scav .and. (inmw_of_aerosol(l) <= 0)) cycle - if ( skip_aer_resu .and. (inmw_of_aerosol(l) > 0)) cycle - tmpd = chem_prflxdt(k+1,icc_l,jcls_l,ipp_l,mwdt,l)*tmpa - delchem_wetresu(k,icc_l,jcls_l,ipp_l,mwdt,l) = & - delchem_wetresu(k,icc_l,jcls_l,ipp_l,mwdt,l) + tmpd - chem_prflxdt(k,icc_l,jcls_l,ipp_l,mwdt,l) = & - chem_prflxdt(k,icc_l,jcls_l,ipp_l,mwdt,l) - tmpd - - if ( is_active(k,icc_l,jcls_l,ipp_l) ) then -! normally resuspend into (k,icc_l,jcls_l,ipp_l) - chem_tmpb(k,icc_l,jcls_l,ipp_l,l) = & - chem_tmpb(k,icc_l,jcls_l,ipp_l,l) + tmpd/tmp_ardzcen - else -! if (k,icc_l,jcls_l,ipp_l) is not active (acen_tmp ~= 0), then resuspend -! uniformly across all active subareas -! (tmpd/rhodz_cen(k)) is the delta(chem) spread over the entire grid area - do jcls_g = 1, ncls_use - do ipp_g = 1, 2 - do icc_g = 1, 2 - tmpf = fxaa_evap_prtb(k,icc_l,jcls_l,ipp_l, icc_g,jcls_g,ipp_g) - if (tmpf <= afrac_cut_0p5) cycle - chem_tmpb(k,icc_g,jcls_g,ipp_g,l) = & - chem_tmpb(k,icc_g,jcls_g,ipp_g,l) + tmpd/(tmpf*rhodz_cen(k)) - end do ! icc_g - end do ! ipp_g - end do ! jcls_g - end if - end do ! l - - end do ! icc_l - end do ! ipp_l - end do ! jcls_l - end if ! (k < kte_cen) - - -! -! do additional resuspension for gases -! currently gases are only in rain (none in solid precip), -! and the previous resuspension involves total precip -! if rain ~= zero in a subarea, then resuspend any rainborne gases -! - if ((k < ktecen) .and. ( .not. skip_gas_scav )) then - do jcls_l = 1, ncls_use - do ipp_l = 1, 2 - do icc_l = 1, 2 - if ( is_rain(k,icc_l,jcls_l,ipp_l) ) cycle - - tmp_ardzcen = acen_tmp(k,icc_l,jcls_l,ipp_l)*rhodz_cen(k) - if ( .not. is_active(k,icc_l,jcls_l,ipp_l) ) then - tmpf = 0.0_r8 - ltmp_aa3d(:,:,:) = .false. - do jcls_g = 1, ncls_use - do ipp_g = 1, 2 - do icc_g = 1, 2 - if ( .not. is_active(k,icc_g,jcls_g,ipp_g) ) cycle - if ((jcls_g == jcls_l) .and. & - (ipp_g == ipp_l) .and. (icc_g == icc_l)) cycle - tmpf = tmpf + acen_tmp(k,icc_g,jcls_g,ipp_g) - ltmp_aa3d(icc_g,jcls_g,ipp_g) = .true. - end do ! icc_g - end do ! ipp_g - end do ! jcls_g - end if - - do ll = 1, ngas_scav - l = lgas_scav(ll) - if ((l < p1st) .or. (l > num_chem_ecpp)) cycle - tmpd = chem_prflxdt(k,icc_l,jcls_l,ipp_l,mwdt,l) - if (tmpd <= 0.0_r8) cycle - - delchem_wetresu(k,icc_l,jcls_l,ipp_l,mwdt,l) = & - delchem_wetresu(k,icc_l,jcls_l,ipp_l,mwdt,l) + tmpd - chem_prflxdt(k,icc_l,jcls_l,ipp_l,mwdt,l) = 0.0_r8 - - if ( is_active(k,icc_l,jcls_l,ipp_l) ) then -! resuspend into (k,icc_l,jcls_l,ipp_l) - chem_tmpb(k,icc_l,jcls_l,ipp_l,l) = & - chem_tmpb(k,icc_l,jcls_l,ipp_l,l) + tmpd/tmp_ardzcen - else -! (k,icc_l,jcls_l,ipp_l) is not active, so resuspend across all active subareas - do jcls_g = 1, ncls_use - do ipp_g = 1, 2 - do icc_g = 1, 2 - if ( .not. ltmp_aa3d(icc_g,jcls_g,ipp_g) ) cycle - chem_tmpb(k,icc_g,jcls_g,ipp_g,l) = & - chem_tmpb(k,icc_g,jcls_g,ipp_g,l) + tmpd/rhodz_cen(k) - end do ! icc_g - end do ! ipp_g - end do ! jcls_g - end if - end do ! ll - - end do ! icc_l - end do ! ipp_l - end do ! jcls_l - end if ! ((k < ktecen) .and. ( .not. skip_gas_scav )) - - -! -! calc in-cloud scavenging of activated aerosols -! - do jcls = 1, ncls_use - do ipp = 1, 2 - do icc = 1, 2 -! cycle ! *** skip for testing - if ( .not. is_active(k,icc,jcls,ipp) ) cycle - if ( .not. is_precp( k,icc,jcls,ipp) ) cycle - - frac_scav = max( 0.0_r8, min( 1.0_r8, qlsink_sub2(k,icc,jcls,ipp)*dt_scav ) ) - tmp_ardzcen = acen_tmp(k,icc,jcls,ipp)*rhodz_cen(k) - - iphase = cw_phase - do n = 1, ntype_aer - do m = 1, nsize_aer(n) - do ll = 0, ncomp_aer(n) - if (ll == 0) then - l = numptr_aer(m,n,iphase) - else - l = massptr_aer(ll,m,n,iphase) - end if - if ((l < p1st) .or. (l > num_chem_ecpp)) cycle - - tmpa = frac_scav*chem_tmpb(k,icc,jcls,ipp,l) - chem_tmpb(k,icc,jcls,ipp,l) = chem_tmpb(k,icc,jcls,ipp,l) - tmpa - - tmpb = tmpa*tmp_ardzcen - delchem_wetscav(k,icc,jcls,ipp,mwdt,l) = & - delchem_wetscav(k,icc,jcls,ipp,mwdt,l) - tmpb - chem_prflxdt(k,icc,jcls,ipp,mwdt,l) = & - chem_prflxdt(k,icc,jcls,ipp,mwdt,l) + tmpb - end do ! ll - end do ! m - end do ! n - end do ! icc - end do ! ipp - end do ! jcls - - -! -! calc below-cloud scavenging of interstitial aerosols -! - do jcls = 1, ncls_use - do ipp = 1, 2 - do icc = 1, 2 -! cycle ! *** skip for testing - if ( .not. is_active(k,icc,jcls,ipp) ) cycle - if ( .not. is_precp( k,icc,jcls,ipp) ) cycle - - tmp_ardzcen = acen_tmp(k,icc,jcls,ipp)*rhodz_cen(k) - - iphase = ai_phase - do n = 1, ntype_aer - do m = 1, nsize_aer(n) - do ll = 0, ncomp_aer(n) - if (ll == 0) then - l = numptr_aer(m,n,iphase) - scavcoef = scavcoef_num(k,icc,jcls,ipp,m,n) - else - l = massptr_aer(ll,m,n,iphase) - scavcoef = scavcoef_vol(k,icc,jcls,ipp,m,n) - end if - if ((l < p1st) .or. (l > num_chem_ecpp)) cycle -! scavcoef = 0.01_r8 ! use simple constant value -! scavcoef = 0.0_r8 ! turn off below-cloud scav - - rate_scav = prta(k,icc,jcls,ipp)*scavcoef - frac_scav = 1.0_r8 - exp( -rate_scav*dt_scav ) - frac_scav = max( 0.0_r8, min( 1.0_r8, frac_scav ) ) - - tmpa = frac_scav*chem_tmpb(k,icc,jcls,ipp,l) - chem_tmpb(k,icc,jcls,ipp,l) = chem_tmpb(k,icc,jcls,ipp,l) - tmpa - - tmpb = tmpa*tmp_ardzcen - delchem_wetscav(k,icc,jcls,ipp,mwdt,l) = & - delchem_wetscav(k,icc,jcls,ipp,mwdt,l) - tmpb - chem_prflxdt(k,icc,jcls,ipp,mwdt,l) = & - chem_prflxdt(k,icc,jcls,ipp,mwdt,l) + tmpb - end do ! ll - end do ! m - end do ! n - end do ! icc - end do ! ipp - end do ! jcls - - -! -! calc gas scavenging -! - if ( .not. skip_gas_scav ) then - do jcls = 1, ncls_use - do ipp = 1, 2 - do icc = 1, 2 -! cycle ! *** skip for testing - if ( .not. is_rain(k,icc,jcls,ipp) ) cycle - tmp_ardzcen = acen_tmp(k,icc,jcls,ipp)*rhodz_cen(k) - - do ll = 1, ngas_scav - l = lgas_scav(ll) - if ((l < p1st) .or. (l > num_chem_ecpp)) cycle - - flxdt_kp1 = chem_prflxdt(k,icc,jcls,ipp,mwdt,l) - qgcx_bgn = chem_tmpb(k,icc,jcls,ipp,l) - tmpa = gasscav_aa(k,icc,jcls,ipp,ll) - tmpb = gasscav_bb(k,icc,jcls,ipp,ll) - tmpc = gasscav_cc(k,icc,jcls,ipp) - tmpe = tmpb + tmpc + tmpa*tmpc - -! this is the solution to the 2 final equations in subr wetscav_2_gasscav - flxdt = flxdt_kp1*((1.0_r8 + tmpa)*tmpc/tmpe) + qgcx_bgn*(tmpa/tmpe) - qgcx = qgcx_bgn*((1.0_r8 + tmpa*(tmpb/tmpe))/(1.0_r8 + tmpa)) & - + flxdt_kp1*(tmpc*(tmpb/tmpe)) - - chem_tmpb(k,icc,jcls,ipp,l) = qgcx - chem_prflxdt(k,icc,jcls,ipp,mwdt,l) = flxdt - tmpf = (qgcx - qgcx_bgn)*tmp_ardzcen - if (tmpf > 0.0_r8) then - delchem_wetresu(k,icc,jcls,ipp,mwdt,l) = & - delchem_wetresu(k,icc,jcls,ipp,mwdt,l) + tmpf - else - delchem_wetscav(k,icc,jcls,ipp,mwdt,l) = & - delchem_wetscav(k,icc,jcls,ipp,mwdt,l) + tmpf - end if - end do ! ll - - end do ! icc - end do ! ipp - end do ! jcls - end if ! ( .not. skip_gas_scav ) - - - end do wetscav_main_kloop_aa - call t_stopf('ecpp_wetscav_main') - - - call t_startf('ecpp_wetscav_endcopy') -! -! load new chem mixratios into chem_sub_new (only if wetscav_onoff_ecpp >= 300) -! calc overall changes to column burdens (only if wetscav_onoff_ecpp >= 200) -! - if (wetscav_onoff_ecpp >= 200) then - - do l = p1st, num_chem_ecpp - if ( skip_gas_scav .and. (inmw_of_aerosol(l) <= 0)) cycle - tmpx = 0.0_r8 ; tmpx2 = 0.0_r8 - do k = kts, ktecen - tmpy = 0.0_r8 ; tmpy2 = 0.0_r8 - do jcls = 1, ncls_use - do icc = 1, 2 - tmpb = 0.0_r8 - tmpc = 0.0_r8 - do ipp = 1, 2 - tmpa = acen_tmp(k,icc,jcls,ipp) - if ( is_active(k,icc,jcls,ipp) ) then - tmpy = tmpy + tmpa*(chem_tmpb(k,icc,jcls,ipp,l) & - - chem_tmpa(k,icc,jcls,ipp,l)) - tmpb = tmpb + tmpa*chem_tmpb(k,icc,jcls,ipp,l) - tmpc = tmpc + tmpa - end if - tmpd = 0.0_r8 - do inwdt=1, nwdt - tmpd = tmpd + delchem_wetscav(k,icc,jcls,ipp,inwdt,l) /rhodz_cen(k) - end do - del_wetscav3d(k,icc,jcls,ipp,l) = del_wetscav3d(k,icc,jcls,ipp,l) + tmpd - tmpe = 0.0_r8 - do inwdt=1, nwdt - tmpe = tmpe + delchem_wetresu(k,icc,jcls,ipp,inwdt,l) /rhodz_cen(k) - end do - del_wetresu3d(k,icc,jcls,ipp,l) = del_wetresu3d(k,icc,jcls,ipp,l) + tmpe - tmpy2 = tmpy2 + tmpd + tmpe - end do ! ipp - if ((acen_tavg_use(k,icc,jcls) > afrac_cut_0p5) .and. & - (tmpc > 0.0_r8) .and. (wetscav_onoff_ecpp >= 300)) then - chem_sub_new(k,icc,jcls,l) = max( 0.0_r8, tmpb )/tmpc - end if - end do ! icc - end do ! jcls - tmpx = tmpx + tmpy*rhodz_cen(k) - tmpx2 = tmpx2 + tmpy2*rhodz_cen(k) - end do ! k - curdel_chem_clm_wetscav(l) = tmpx - ! *** increment del_chem_clm_wetscav with tmpx2 (new way) - ! instead of tmpx (old way) - del_chem_clm_wetscav(l) = del_chem_clm_wetscav(l) + tmpx2 - end do ! l - - end if ! (wetscav_onoff_ecpp >= 200) - call t_stopf('ecpp_wetscav_endcopy') - - call t_startf('ecpp_wetscav_enddiag') -! -! diagnostic checks on the new arrays to see that they are "making sense" -! - if (lun142 > 0) then - - do l = p1st, num_chem_ecpp - - write(lun142,'(//a,i5)') 'diags for species l =', l - - if (lun142 == -999888777) then ! *** skip for testing - - write(lun142,'(a,i5)') 'chem_tmpa for icc=ipp=2 & grid-avg; chem_tmpb ...; b-a ...' - icc = 2 ; ipp = 2 - do k = ktecen, kts, -1 - write(lun142,'(i3,1p,3(2x,4e10.3))') k, & - ( chem_tmpa(k,icc,jcls,ipp,l), jcls=1,ncls_use ), & - sum( chem_tmpa(k,1:2,1:ncls_use,1:2,l)* & - acen_tmp(k,1:2,1:ncls_use,1:2) ), & - ( chem_tmpb(k,icc,jcls,ipp,l), jcls=1,ncls_use ), & - sum( chem_tmpb(k,1:2,1:ncls_use,1:2,l)* & - acen_tmp(k,1:2,1:ncls_use,1:2) ), & - ( (chem_tmpb(k,icc,jcls,ipp,l) - & - chem_tmpa(k,icc,jcls,ipp,l)), jcls=1,ncls_use ), & - sum( ( chem_tmpb(k,1:2,1:ncls_use,1:2,l) - & - chem_tmpa(k,1:2,1:ncls_use,1:2,l) )* & - acen_tmp(k,1:2,1:ncls_use,1:2) ) - end do - - write(lun142,'(/a,i5)') & - 'delchem_wetscav for icc=ipp=2 & grid-avg; delchem_wetresu ...; chem_prflxdt_xfer ...' - icc = 2 ; ipp = 2 - do k = ktecen, kts, -1 - write(lun142,'(i3,1p,3(2x,4e10.3))') k, & - ( delchem_wetscav( k,icc,jcls,ipp,mwdt,l), jcls=1,ncls_use ), & - sum( delchem_wetscav( k,1:2,1:ncls_use,1:2,1:nwdt,l) ), & - ( delchem_wetresu( k,icc,jcls,ipp,mwdt,l), jcls=1,ncls_use ), & - sum( delchem_wetresu( k,1:2,1:ncls_use,1:2,1:nwdt,l) ), & - ( chem_prflxdt_xfer(k,icc,jcls,ipp,mwdt,l), jcls=1,ncls_use ), & - sum( chem_prflxdt_xfer(k,1:2,1:ncls_use,1:2,1:nwdt,l) ) - end do - - write(lun142,'(/a,i5)') & - 'chem_prflxdt for icc=ipp=2 & grid-avg; conserve check stuff' - icc = 2 ; ipp = 2 - do k = ktecen, kts, -1 - kp1 = min(k+1,ktecen) ; tmpa = kp1 - k - write(lun142,'(i3,1p,3(2x,4e10.3))') k, & - ( chem_prflxdt( k,icc,jcls,ipp,mwdt,l), jcls=1,ncls_use ), & - sum( chem_prflxdt( k,1:2,1:ncls_use,1:2,1:nwdt,l) ), & - ( chem_prflxdt( kp1,icc,jcls,ipp,mwdt,l)*tmpa & - - chem_prflxdt( k,icc,jcls,ipp,mwdt,l) & - - delchem_wetscav( k,icc,jcls,ipp,mwdt,l) & - - delchem_wetresu( k,icc,jcls,ipp,mwdt,l) & - + chem_prflxdt_xfer(k,icc,jcls,ipp,mwdt,l), jcls=1,ncls_use ), & - sum( chem_prflxdt( kp1,1:2,1:ncls_use,1:2,1:nwdt,l)*tmpa & - - chem_prflxdt( k,1:2,1:ncls_use,1:2,1:nwdt,l) & - - delchem_wetscav( k,1:2,1:ncls_use,1:2,1:nwdt,l) & - - delchem_wetresu( k,1:2,1:ncls_use,1:2,1:nwdt,l) & - + chem_prflxdt_xfer(k,1:2,1:ncls_use,1:2,1:nwdt,l) ) - end do - - end if ! (lun142 == -999888777) - - write(lun142,'(/2a,i5)') & - 'sum( delchem_wetscav ), sum( delchem_wetresu ), sum( both ),', & - ' curdel_chem_clm_wetscav, (4)-(5)/max(...)' - tmpa = sum( delchem_wetscav( kts:ktecen,1:2,1:ncls_use,1:2,1:nwdt,l) ) - tmpb = sum( delchem_wetresu( kts:ktecen,1:2,1:ncls_use,1:2,1:nwdt,l) ) - tmpc = tmpa + tmpb - tmpd = curdel_chem_clm_wetscav(l) - tmpe = (tmpc - tmpd)/max( abs(tmpc), abs(tmpd), 1.0e-38_r8 ) - write(lun142,'(1p,3(2x,2e11.3))') & - tmpa, tmpb, tmpc, tmpd, tmpe -! if (l == 2) write(lun142,'(3a)') 'qakee - ktau, it_hyb, it_sub, l', & -! 'sum( delchem_wetscav ), sum( delchem_wetresu ), sum( both ),', & -! ' curdel_chem_clm_wetscav, (4)-(5)/max(...)' -! if (l >= 39) write(lun142,'(a,4i4,1p,3(2x,2e11.3))') & -! 'qakee', ktau, itstep_hybrid, itstep_sub, l, & -! tmpa, tmpb, tmpc, tmpd, tmpe - - write(lun142,'(/2a,i5)') & - 'sum( del_wetscav3d ), sum( del_wetresu3d ), sum( both ),', & - ' del_chem_clm_wetscav, (4)-(5)/max(...)' - tmpa = 0.0_r8 ; tmpb = 0.0_r8 - do k = kts, ktecen - tmpa = tmpa + sum( del_wetscav3d(k,1:2,1:ncls_use,1:2,l) ) * rhodz_cen(k) - tmpb = tmpb + sum( del_wetresu3d(k,1:2,1:ncls_use,1:2,l) ) * rhodz_cen(k) - end do - tmpc = tmpa + tmpb - tmpd = del_chem_clm_wetscav(l) - tmpe = (tmpc - tmpd)/max( abs(tmpc), abs(tmpd), 1.0e-38_r8 ) - write(lun142,'(1p,3(2x,2e11.3))') & - tmpa, tmpb, tmpc, tmpd, tmpe -! if (l == 2) write(lun142,'(3a)') 'qakff - ktau, it_hyb, it_sub, l', & -! 'sum( del_wetscav3d ), sum( del_wetresu3d ), sum( both ),', & -! ' del_chem_clm_wetscav, (4)-(5)/max(...)' -! if (l >= 39) write(lun142,'(a,4i4,1p,3(2x,2e11.3))') & -! 'qakff', ktau, itstep_hybrid, itstep_sub, l, & -! tmpa, tmpb, tmpc, tmpd, tmpe - - end do ! l - - write(lun142,'(//a,i5)') 'qlsink*dt_scav for icc=ipp=2; qcloud ...; ardzcen ...' - icc = 2 ; ipp = 2 - do k = ktecen, kts, -1 - write(lun142,'(i3,1p,4(2x,3e10.3))') k, & - ( qlsink_sub2(k,icc,jcls,ipp)*dt_scav, jcls=1,ncls_use ), & - ( qcloud_sub2(k,icc,jcls,ipp), jcls=1,ncls_use ), & - ( acen_tmp(k,icc,jcls,ipp)*rhodz_cen(k), jcls=1,ncls_use ) - end do - - write(lun142,'(//a,i5)') 'prta for icc=ipp=2; prtb ...; delprtb ...' - icc = 2 ; ipp = 2 - do k = ktecen, kts, -1 - write(lun142,'(i3,1p,4(2x,3e10.3))') k, & - ( prta(k,icc,jcls,ipp), jcls=1,ncls_use ), & - ( prtb(k,icc,jcls,ipp), jcls=1,ncls_use ), & - ( prtb(k,icc,jcls,ipp)-prtb(k+1,icc,jcls,ipp), jcls=1,ncls_use ) - end do - - end if ! (lun142 > 0) - - call t_stopf('ecpp_wetscav_enddiag') - - -! write(*,'(a)') 'wetscav_2 DONE' - return - end subroutine parampollu_tdx_wetscav_2 - - - -!----------------------------------------------------------------------- - subroutine wetscav_2_gasscav( & - ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & - dt_scav, & - idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - is_active, is_precp, is_rain, & - maxgas_scav, ngas_scav, lgas_scav, & - acen_tmp, prra, & - qcloud_sub2, qlsink_sub2, & - gasscav_aa, gasscav_bb, gasscav_cc ) - - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! wetscav_2_gasscav does pre-calculations for in-cloud and below-cloud -! of gases (h2o2, so2, and nh3) by rain -! the results are applied in subr parampollu_tdx_wetscav_2 -! -! main assumptions -! reversible scavenging of gases -! prescribed pH for rainwater and cloudwater -! no aqueous phase reactions are treated here -!----------------------------------------------------------------------- - -! use module_state_description, only: p_qv, p_qc - -! use module_data_radm2, only: epsilc - - use module_data_mosaic_asect, only: & - ai_phase, dens_aer, hygro_aer, & - massptr_aer, maxd_asize, maxd_atype, & - ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer, & - dcen_sect, dhi_sect, dlo_sect, sigmag_aer, & - volumhi_sect, volumlo_sect - - use module_data_ecpp1 - - use constituents, only: cnst_get_ind - - use module_ecpp_util, only: ecpp_error_fatal - - implicit none - -! arguments -! ( for definitions see subr parampollu_tdx_wetscav_2 ) - integer, intent(in) :: & - ktau, ktau_pp, itstep_sub, & - it, jt, kts, ktebnd, ktecen - - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199), & - idiagbb_wetscav - - real(r8), intent(in) :: dtstep, dtstep_sub, dt_scav - - real(r8), intent(in), dimension( kts:ktecen ) :: & - tcen_bar, pcen_bar, rhocen_bar, dzcen - - integer, intent(in) :: ncls_use - - logical, intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - is_active, is_precp, is_rain - - integer, intent(in) :: maxgas_scav - integer, intent(out) :: ngas_scav - integer, intent(out), dimension( 1:maxgas_scav ) :: & - lgas_scav - - real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - acen_tmp, qcloud_sub2, qlsink_sub2 - - real(r8), intent(in), dimension( kts:ktebnd, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - prra - - real(r8), intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, maxgas_scav ) :: & - gasscav_aa, gasscav_bb - - real(r8), intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - gasscav_cc - - - -! local variables - integer :: icc, ipp - integer :: itmpa - integer :: jcls - integer :: k - integer :: ll, lun143 - integer :: m - integer :: n - integer :: p1st - -! real(r8), parameter :: piover6 = 3.14159265358979323846_r8/6.0_r8 - real(r8), parameter :: qcldwtr_cutoff = 1.0e-6_r8 - real(r8), parameter :: tmp8over9 = 8.0_r8/9.0_r8 - - real(r8) :: frac_c, frac_g - real(r8) :: hen1c(maxgas_scav), hen1r(maxgas_scav) - real(r8) :: hen2c(maxgas_scav), hen2r(maxgas_scav) - real(r8) :: heffcx(maxgas_scav), heffrx(maxgas_scav) - real(r8) :: hionc, hionr - real(r8) :: kxf_cr, kxf_gcr, kxf_gr(maxgas_scav) - real(r8) :: qcwtr, qrwtr - real(r8) :: scavrate_hno3 - real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf, tmpg - real(r8) :: vfallr - - -! pointers for gases that are scavenged - p1st = param_first_ecpp - - ngas_scav = 4 - if (ngas_scav > maxgas_scav) then - write(*,*) 'subr wetscav_2_gasscav -- ngas_scav > maxgas_scav', & - ngas_scav > maxgas_scav - call ecpp_error_fatal( lunout, & - 'subr wetscav_2_gasscav -- ngas_scav > maxgas_scav' ) - end if - - lgas_scav(:) = -1 - - call cnst_get_ind( 'so2', itmpa, .false. ) - if (itmpa <= 0) call cnst_get_ind( 'SO2', itmpa, .false. ) - if ((itmpa >= p1st) .and. (itmpa <= num_chem_ecpp)) lgas_scav(1) = itmpa - - call cnst_get_ind( 'h2o2', itmpa, .false. ) - if (itmpa <= 0) call cnst_get_ind( 'H2O2', itmpa, .false. ) - if ((itmpa >= p1st) .and. (itmpa <= num_chem_ecpp)) lgas_scav(2) = itmpa - - call cnst_get_ind( 'nh3', itmpa, .false. ) - if (itmpa <= 0) call cnst_get_ind( 'NH3', itmpa, .false. ) - if ((itmpa >= p1st) .and. (itmpa <= num_chem_ecpp)) lgas_scav(3) = itmpa - - call cnst_get_ind( 'h2so4', itmpa, .false. ) - if (itmpa <= 0) call cnst_get_ind( 'H2SO4', itmpa, .false. ) - if ((itmpa >= p1st) .and. (itmpa <= num_chem_ecpp)) lgas_scav(4) = itmpa - -! write(*,'(a,10i5)') 'wetscav_2_gasscav - ngas_scav', ngas_scav -! write(*,'(a,10i5)') 'wetscav_2_gasscav - lgas_scav', lgas_scav(1:maxgas_scav) -! if (ngas_scav /= -13579) stop - - -! -! treatment of gas scavenging (by rain) -! -! primary assumptions are -! gases are reversibly scavenging in rain (e.g., transfer from gas to rain -! and transfer from rain to gas are both treated) -! rainborne gases are treated a locally steady-state, but vary with height -! cloudborne gases in equilibrium with the "interstitial gases" -! and are collected by rain -! pH for the cloud and rainwater are prescribed -! aqueous chemical reaction in rain are not treated -! -! define -! qrx = mixing ratio of rainborne species x (kg-x/kg-air) -! qcx = mixing ratio of cloudborne species x (kg-x/kg-air) -! qgx = mixing ratio of gaseous species x (kg-x/kg-air) -! qgcx = qgx + qcx -! -! the above are defined for each vertical layer and each ecpp subarea -! (in wrf-chem, they are units are actually mg-x/kg-air after a molecular weight -! ratio is applied, but the equations work anyway) -! -! basic equations: -! -! d[acen*rho*qgcx]/dt = acen*rho*[ -kxf_gr*(qgx - qrx/heffrx) - kxf_ct*qcx ] -! -! d[acen*rho*vfallr*qrx]/dz = acen*rho*[ -kxf_gr*(qgx - qrx/heffrx) - kxf_ct*qcx ] -! -! qcx = heffcx*qgx -! -! where -! acen = fractional area of subarea -! rho = air density (kg-air/m^3) -! vfallr = rain fall velocity (m/s, and positive) -! kxf_gr = mass transfer coefficient for gas <--> rain (1/s) -! a power-law curve fit to Schwarz and Levine (19xx) is used -! kxf_ct = rate of collection of cloudwater by rainwater (1/s) == qlsink -! heffrx, heffcx = gaseous-rainborne and gaseous-cloudborne equilibirum partitioning -! coefficients (i.e., modified effective henry law constants) with units of -! [(mol-x/kg-h2o)/(mol-x/kg-air)] == [(kg-x/kg-h2o)/(kg-x/kg-air)] -! -! define -! frac_c = heffcx/(1 + heffgx) so qcx = frac_c*qgcx -! frac_g = 1 - frac_c so qgx = frac_g*qgcx -! kxf_gcr = frac_g*kxf_gr + frac_c*kxf_cr -! -! then -! -! d[acen*rho*qgcx]/dt = acen*rho*[ -kxf_gcr*qgcx + kxf_gr*qrx/heffrx) ] -! -! d[acen*rho*vfallr*qrx]/dz = acen*rho*[ -kxf_gcr*qgcx + kxf_gr*qrx/heffrx) ] -! -! define -! dt = time step ( = ecpp sub time step ) -! flxdt = acen*rho*vfallr*qrx*dt = chem_prflxdt of subr parampollu_tdx_wetscav_2 -! -! then -! -! d[acen*rho*qgcx]/dt = -[acen*rho*kxf_gcr]*qgcx + [kxf_gr/(heffrx*vfallr*dt)]*flxdt -! -! d[flxdt]/dz = -[acen*rho*kxf_gcr*dt]*qgcx + [kxf_gr/(heffrx*vfallr)]*flxdt -! -! now define -! dt = time step (s) -! dz = thickness of layer k (m) -! qgcx = qgcx in layer k at end of time step -! qgcx_bgn = qgcx in layer k at beginning of time step -! flxdt = flxdt in layer k at end of time step -! flxdt_kp1 = flxdt in layer k+1 at end of time step -! -! and use the following finite differencing which is implicit in time -! -! (acen*rho)*(qgcx - qgcx_o)/dt = -[acen*rho*kxf_gcr]*qgcx + [kxf_gr/(heffrx*vfallr*dt)]*flxdt -! which yields -! qgcx*[1 + kxf_gcr*dt] + flxdt*[-kxf_gr/(heffrx*vfallr*acen*rho)] = qgcx_bgn -! -! (flxdt+kp1 - flxdt)/dz = -[acen*rho*kxf_gcr*dt]*qgcx + [kxf_gr/(heffrx*vfallr)]*flxdt -! which yields -! qgcx*[-kxf_gcr*dt] + flxdt*[1/(dz*acen*rho) + kxf_gr/(heffrx*vfallr*acen*rho)] = flxdt_kp1*[1/(dz*acen*rho)] -! -! define -! aa = kxf_gcr*dt -! bb = kxf_gr/(heffrx*vfallr*acen*rho) -! cc = 1/(dz*acen*rho) -! -! then -! qgcx*[1 + aa] + flxdt*[-bb] = qgcx_bgn -! qgcx*[-aa] + flxdt*[cc + bb] = flxdt_kp1*[cc] -! -! these 2 equations are solved in the gas-scavenging section of subr parampollu_tdx_wetscav_2, -! starting at ktecen (where flxdt_kp1 = ) -! the purpose of this routine (subr wetscav_2_gasscav) is to provide the aa, bb, and cc -! - - - lun143 = -1 - if (idiagaa_ecpp(143) > 0) lun143 = ldiagaa_ecpp(143) - if (idiagbb_wetscav /= 1) lun143 = -1 - -! hionr, hionc = prescribed hydrogen ion concentrations (mol/liter-h2o) -! for rainwater and cloudwater - hionr = 10.0_r8**(-5.0_r8) - hionc = 10.0_r8**(-4.5_r8) - -! calculate information needed for the gas scavenging equations -main_kloop_aa: & - do k = kts, ktecen - - do ipp = 1, 2 - do jcls = 1, ncls_use - do icc = 1, 2 - - if ( .not. is_rain(k,icc,jcls,ipp) ) cycle - if (lun143 > 0) write(lun143,'(/a,5i5)') 'wetscav_2_gasscav', & - ktau, k, icc, jcls, ipp - if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'aaaa stuff ', & - tcen_bar(k), pcen_bar(k), rhocen_bar(k), dzcen(k), dt_scav - - -! calculate rain fallspeed and rainwater mixing ratio using Kessler (1969) - tmpa = prra(k,icc,jcls,ipp) ! rain precip rate (kg/m^2/s) - tmpb = sqrt( 1.22_r8/rhocen_bar(k) ) ! density factor for fallspeed -! tmpc = first guess rain water conc (kg/m^3) from Kessler (1969) - tmpc = (tmpa/(12.11_r8*tmpb))**tmp8over9 -! vfallr = rain mean fallspeed (m/s) from its definition, but forced to >= 1 m/s - vfallr = max( 1.0_r8, (tmpa/tmpc) ) -! qrwtr = rain water mixing ratio (kg/kgair) from its definition - qrwtr = tmpa/(vfallr*rhocen_bar(k)) - if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'rain stuff ', & - prra(k,icc,jcls,ipp), acen_tmp(k,icc,jcls,ipp), & - tmpa, tmpb, tmpc, vfallr, qrwtr - -! qcwtr = cloud water mixing ratio (kg/kgair) from its definition - qcwtr = qcloud_sub2(k,icc,jcls,ipp) - if (qcwtr > qcldwtr_cutoff) then - kxf_cr = max( 0.0_r8, qlsink_sub2(k,icc,jcls,ipp) ) - else - qcwtr = 0.0_r8 - kxf_cr = 0.0_r8 - end if - - -! gas-liquid partitioning coefficients -! -! hen1 = effective henry law constant at prescribed ph -! [(mol-x/liter-h2o)/atm] = [(mol-x/kg-h2o)/atm] - hen1r(:) = 0.0_r8 - hen1c(:) = 0.0_r8 - tmpa = (1.0_r8/tcen_bar(k)) - (1.0_r8/298.16_r8) - if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') '0000 hen1 ', & - tcen_bar(k), tmpa, qrwtr, qcwtr -! so2 - tmpb = 1.23_r8*exp(3150.0_r8*tmpa) ! henry law constant - tmpc = 1.3e-2_r8*exp(1960.0_r8*tmpa) ! 1st dissociation constant - hen1r(1) = tmpb*(1.0_r8 + tmpc/hionr) ! effective henry - hen1c(1) = tmpb*(1.0_r8 + tmpc/hionc) ! effective henry - if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'so2 hen1 ', & - tmpb, tmpc, hen1r(1), hen1c(1) -! h2o2 - tmpb = 7.45e4_r8*exp(7300.0_r8*tmpa) ! henry law constant - hen1r(2) = tmpb - hen1c(2) = tmpb - if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'h2o2 hen1 ', & - tmpb, 0.0_r8, hen1r(2), hen1c(2) -!+++mhwang -! set hen1r and hen1d of so2 to be the same as H2O2, which is what used -! in the conventional NCAR CAM. -! Minghuai Wang (Minghuai.Wang@pnl.gov), 2010-02 -! hen1r(1) = hen1r(2) -! hen1c(1) = hen1c(2) -!---mhwang - -! nh3 - tmpb = 6.21e1_r8*exp(4110.0_r8*tmpa) ! henry law constant - tmpc = 1.7e-5_r8*exp(-450.0_r8*tmpa) ! 1st dissociation constant - tmpd = 1.0e-14_r8*exp(-6710.0_r8*tmpa) ! water dissociation constant - hen1r(3) = tmpb*(1.0_r8 + (tmpc/tmpd)*hionr) ! effective henry - hen1c(3) = tmpb*(1.0_r8 + (tmpc/tmpd)*hionc) ! effective henry - if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'nh3 hen1 ', & - tmpb, tmpc, hen1r(3), hen1c(3) -! h2so4 (values are from CAPRAM website) - tmpb = 8.7e11_r8 ! henry law constant - tmpc = 1.0e3_r8 ! 1st dissociation constant - hen1r(4) = tmpb*(1.0_r8 + tmpc/hionr) ! effective henry - hen1c(4) = tmpb*(1.0_r8 + tmpc/hionc) ! effective henry - if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'h2so4 hen1 ', & - tmpb, tmpc, hen1r(4), hen1c(4) - -! hen2 = like hen1 but units = [(mol-x/kg-h2o)/(mol-x/kg-air)] -! ax atm of x = ax*p0 Pa of x = ax*p0/pair (mol-x/mol-air) -! = ax*p0/(pair*0.029) (mol-x/kg-air) - tmpa = (pcen_bar(k)/1.01325e5_r8)*0.028966_r8 - hen2r(1:ngas_scav) = hen1r(1:ngas_scav)*tmpa - hen2c(1:ngas_scav) = hen1c(1:ngas_scav)*tmpa - -! heffrx,cx units = [(mol-x/kg-air)/(mol-x/kg-air)] and includes -! rainwater,cloudwater mixing ratio factor - heffrx(1:ngas_scav) = hen2r(1:ngas_scav)*qrwtr - heffcx(1:ngas_scav) = hen2c(1:ngas_scav)*qcwtr - if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'heffrx,cx ', & - heffrx(1:4), heffcx(1:4) - - -! gas-rain mass transfer rates -! -! scavrate_hno3 = rain scavenging rate for hno3 (1/s) -! this is power law fit to levine and schwartz (1982, atmos environ) -! results, with temperature and pressure adjustments - tmpa = prra(k,icc,jcls,ipp)*3600.0_r8 ! precip rate in mm/hr = kg/m^2/hr - scavrate_hno3 = 6.262e-5_r8*(tmpa**0.7366_r8) & - * ((tcen_bar(k)/298.0_r8)**1.12_r8) & - * ((1.01325e5_r8/pcen_bar(k))**.75_r8) -! for other gases, multiply hno3 rate by ratio of gas diffusivities - kxf_gr(1) = scavrate_hno3*1.08_r8 ! so2 - kxf_gr(2) = scavrate_hno3*1.38_r8 ! h2o2 - kxf_gr(3) = scavrate_hno3*1.59_r8 ! nh3 - kxf_gr(4) = scavrate_hno3*0.80_r8 ! h2so4 - if (lun143 > 0) write(lun143,'(a,1p,8e11.3)') 'kxf_gr,cr ', & - kxf_gr(1:4), kxf_cr - - -! aa, bb, and cc coefficients of the 2 final equations - tmpa = acen_tmp(k,icc,jcls,ipp)*rhocen_bar(k) -! cc = 1/(dz*acen*rho) - gasscav_cc(k,icc,jcls,ipp) = 1.0_r8/(dzcen(k)*tmpa) - - do ll = 1, ngas_scav - frac_c = heffcx(ll)/(1.0_r8 + heffcx(ll)) - frac_g = 1.0_r8 - frac_c - kxf_gcr = frac_g*kxf_gr(ll) + frac_c*kxf_cr -! aa = kxf_gcr*dt - gasscav_aa(k,icc,jcls,ipp,ll) = kxf_gcr*dt_scav - -! bb = kxf_gr/(heffrx*vfallr*acen*rho) - gasscav_bb(k,icc,jcls,ipp,ll) = kxf_gr(ll)/(heffrx(ll)*vfallr*tmpa) -! setting gasscav_bb=0 (heffrx = infinity) gives irreversible scavenging -! gasscav_bb(k,icc,jcls,ipp,ll) = 0.0 - - if (lun143 > 0) write(lun143,'(a,i1,1p,8e11.3)') 'aa/bb/cc ', & - ll, gasscav_aa(k,icc,jcls,ipp,ll), gasscav_bb(k,icc,jcls,ipp,ll), & - gasscav_cc(k,icc,jcls,ipp), frac_g, frac_c, kxf_gcr - end do ! l - - - - end do ! icc - end do ! jcls - end do ! ipp - - end do main_kloop_aa - - - return - end subroutine wetscav_2_gasscav - - - -!----------------------------------------------------------------------- - subroutine wetscav_2_bcscavcoef( & - ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & - idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & - tcen_bar, pcen_bar, rhocen_bar, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - rh_sub2, & - is_active, is_precp, & - chem_tmpa, scavcoef_num, scavcoef_vol ) - - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! wetscav_2_bcscavcoef calculates below-cloud scavenging coefficents -! similar to subr modal_aero_bcscavcoef_get -! -!----------------------------------------------------------------------- - -! use module_state_description, only: p_qv, p_qc - -! use module_data_radm2, only: epsilc - -! use module_data_mosaic_asect, only: ai_phase, cw_phase, & -! massptr_aer, maxd_asize, maxd_atype, & -! ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer, & -! waterptr_aer - use module_data_mosaic_asect, only: & - ai_phase, dens_aer, hygro_aer, & - massptr_aer, maxd_asize, maxd_atype, & - ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer, & - dcen_sect, dhi_sect, dlo_sect, sigmag_aer, & - volumhi_sect, volumlo_sect - - use modal_aero_wateruptake, only: modal_aero_kohler - - use aero_model, only: & - calc_1_impact_rate, & - get_dlndg_nimptblgrow, nimptblgrow_mind, nimptblgrow_maxd, & - get_scavimptblnum, get_scavimptblvol - - use modal_aero_data,only: ntot_amode - - use module_data_ecpp1 - -! use module_ecpp_hoststuff, only: config_flags_ecpp - -! use module_mosaic_wetscav, only: wetscav_cbmz_mosaic - -! use module_ecpp_util, only: ecpp_error_fatal, ecpp_message, & -! parampollu_1clm_set_opts - - implicit none - -! arguments -! ( for definitions see subr parampollu_tdx_wetscav_2 ) - integer, intent(in) :: & - ktau, ktau_pp, itstep_sub, & - it, jt, kts, ktebnd, ktecen - - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199), & - idiagbb_wetscav - - real(r8), intent(in) :: dtstep, dtstep_sub - - real(r8), intent(in), dimension( kts:ktecen ) :: & - tcen_bar, pcen_bar, rhocen_bar - - integer, intent(in) :: ncls_use - - real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - rh_sub2 - - logical, intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - is_active, is_precp - - real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & - chem_tmpa - - real(r8), intent(inout), & - dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:maxd_asize, 1:maxd_atype ) :: & - scavcoef_num, scavcoef_vol -! scavcoef_vol = below-cloud scavenging coeficient for volume (1/mm) -! scavcoef_num = below-cloud scavenging coeficient for number (1/mm) -! when precip rate = xxx kg/m2/s == xxx mm/s, the scavenging rate (1/s) = scavcoef*xxx - - -! local variables - integer :: icc, ipp - integer :: jcls, jgrow - integer :: k - integer :: l, ll, lun142 - integer :: m - integer :: n - integer :: p1st - - real(r8) :: dgratio - real(r8) :: dry_dens, dry_diam, dry_mass, dry_volu - real(r8) :: dry_mass_cut, dry_volu_cut - real(r8) :: fact_leng, fact_mass - real(r8), parameter :: onethird = 1.0_r8/3.0_r8 - real(r8), parameter :: piover6 = 3.14159265358979323846_r8/6.0_r8 - real(r8) :: scavimpnum, scavimpvol - real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf, tmpg - real(r8) :: tmpflo, tmpfhi - real(r8) :: tmp_hygro, tmp_num, tmp_rdry, tmp_rwet, tmp_rh - real(r8) :: watr_mass, wet_dens, wet_diam, wet_volu - real(r8) :: xgrow - real(r8) :: rdry_in_mak(1), hygro_mak(1), s_mak(1), rwet_out_mak(1) - - real(r8) :: scavimptblnum(nimptblgrow_mind:nimptblgrow_maxd, ntot_amode) - real(r8) :: scavimptblvol(nimptblgrow_mind:nimptblgrow_maxd, ntot_amode) - -! NOTE ON UNITS -! -! hostcode wrfchem cam -! mass mixing ratios ug/kg kg/kg -! dry/wet_mass g/kgair kg/kgair -! dens_aer g/cm^3 kg/m^3 -! dry/wet_volu cm^3/kgair m^3/kgair -! volumlo/hi_sect cm^3 m^3 -! dcen_sect cm m -! dry/wet_diam cm m -! - if ( hostcode_is_wrfchem ) then - fact_mass = 1.0e-6_r8 ! ug/kgair --> g/kgair - fact_leng = 1.0e-2_r8 ! cm --> m - dry_mass_cut = 1.0e-26_r8 ! g/kgair = 1.0e-20 ug/kgair - dry_volu_cut = 1.0e-26_r8 ! cm^3/kgair - else - fact_mass = 1.0_r8 ! kg/kgair, unchanged - fact_leng = 1.0_r8 ! m, unchanged - dry_mass_cut = 1.0e-29_r8 ! kg/kgair = 1.0e-20 ug/kgair - dry_volu_cut = 1.0e-32_r8 ! m^3/kgair - end if - -! -! calc below-cloud scavenging coefficients of interstitial aerosols -! - scavcoef_num(:,:,:,:,:,:) = 0.0_r8 - scavcoef_vol(:,:,:,:,:,:) = 0.0_r8 - - - scavimptblvol = get_scavimptblvol() - scavimptblnum = get_scavimptblnum() - - do k = kts, ktecen - do jcls = 1, ncls_use - do ipp = 1, 2 -icc_loop: & - do icc = 1, 2 - if ( .not. is_active(k,icc,jcls,ipp) ) cycle -! if ( .not. is_precp( k,icc,jcls,ipp) ) cycle - - lun142 = 0 -! if ((ktau == 1) .and. (k == 5)) lun142 = 142 - if (k == 5) lun142 = 142 - if (idiagbb_wetscav <= 0) lun142 = -1 - - -! calc below-cloud scavenging coefficients for each aerosol mode - do n = 1, ntype_aer - do m = 1, nsize_aer(n) - -! calc dry mass and dry volume mixing ratios - dry_volu = 0.0_r8 - dry_mass = 0.0_r8 - tmp_hygro = 0.0_r8 - do l = 1, ncomp_aer(n) - tmpa = chem_tmpa(k,icc,jcls,ipp,massptr_aer(l,m,n,ai_phase)) - dry_mass = dry_mass + tmpa - dry_volu = dry_volu + tmpa/dens_aer(l,n) - tmp_hygro = tmp_hygro + (tmpa/dens_aer(l,n))*hygro_aer(l,n) - end do - dry_mass = dry_mass*fact_mass ! g/kgair OR kg/kgair - dry_volu = dry_volu*fact_mass ! cm^3/kgair OR m^3/kgair - -! if negligible aerosol is present at this size and type, cycle - if ((dry_mass < dry_mass_cut) .or. (dry_volu < dry_volu_cut)) then - ! BUT FIRST set dgn_dry/wet and chem_sub( ... water ... ) to default values - cycle - end if - -! calc volume-mean dry diameter - tmp_num = chem_tmpa(k,icc,jcls,ipp,numptr_aer(m,n,ai_phase)) - if (dry_volu <= tmp_num*volumlo_sect(m,n)) then - dry_diam = dlo_sect(m,n) - else if (dry_volu >= tmp_num*volumhi_sect(m,n)) then - dry_diam = dhi_sect(m,n) - else - dry_diam = (dry_volu/(tmp_num*piover6))**onethird - end if - -! calc volume-mean wet diameter - tmp_hygro = tmp_hygro*fact_mass/dry_volu - tmp_rh = max( 0.0_r8, min( 0.99_r8, rh_sub2(k,icc,jcls,ipp) ) ) - tmp_rdry = dry_diam*0.5_r8*fact_leng ! cm OR m --> m - tmp_rwet = tmp_rdry - - rdry_in_mak(1) = tmp_rdry - hygro_mak(1) = tmp_hygro - s_mak(1) = tmp_rh - rwet_out_mak(1) = tmp_rwet -! call modal_aero_kohler( tmp_rdry, tmp_hygro, tmp_rh, tmp_rwet, 1, 1 ) - call modal_aero_kohler( rdry_in_mak, hygro_mak, s_mak, rwet_out_mak, 1) - tmp_rwet = rwet_out_mak(1) - - wet_diam = tmp_rwet*2.0_r8/fact_leng ! m --> cm OR m - wet_diam = min( wet_diam, dry_diam*100.0_r8, 50.0e-6_r8/fact_leng ) - wet_diam = max( wet_diam, dry_diam ) - -! wet_diam = dry_diam ! force water == 0 (for testing) - - wet_volu = dry_volu * (wet_diam/dry_diam)**3 ! cm^3/kgair - watr_mass = max( 0.0_r8, (wet_volu-dry_volu) ) ! g/kgair, as rho_water = 1.0 g/cm^3 -! *** eventually should store this in some array that can be used by cam3 -! for now, leave it alone -! chem_tmpa(k,icc,jcls,ipp,waterptr_aer(m,n)) = watr_mass/fact_mass - - wet_dens = (dry_mass + watr_mass)/wet_volu - dry_dens = dry_mass/dry_volu - -! compute impaction scavenging removal amount for volume -! interpolate table values using log of (actual-wet-size)/(base-dry-size) - -! in the bcscavcoef_get routine, dgratio = dgnum_wet/dgnum_amode -! BUT dgnum_wet/dgnum_amode = (b*dgnum_wet)/(b*dgnum_amode) = dvolmean_wet/dcen_sect -! where b = exp( 1.5 * (log(sigmag)**2) ) -! dgratio = ((wet_volu/dry_volu)**onethird) * (dry_diam/dcen_sect(m,n)) - dgratio = wet_diam/dcen_sect(m,n) - - if ((dgratio .ge. 0.99_r8) .and. (dgratio .le. 1.01_r8)) then - scavimpvol = scavimptblvol(0,m) - scavimpnum = scavimptblnum(0,m) - else - xgrow = log( dgratio ) / get_dlndg_nimptblgrow() - jgrow = int( xgrow ) - if (xgrow .lt. 0._r8) jgrow = jgrow - 1 - if (jgrow .lt. nimptblgrow_mind) then - jgrow = nimptblgrow_mind - xgrow = jgrow - else - jgrow = min( jgrow, nimptblgrow_maxd-1 ) - end if - - tmpfhi = xgrow - jgrow - tmpfhi = max( 0.0_r8, min( 1.0_r8, tmpfhi ) ) - tmpflo = 1.0_r8 - tmpfhi - scavimpvol = tmpflo*scavimptblvol(jgrow,m) + & - tmpfhi*scavimptblvol(jgrow+1,m) - scavimpnum = tmpflo*scavimptblnum(jgrow,m) + & - tmpfhi*scavimptblnum(jgrow+1,m) - end if - - !impaction scavenging removal amount for volume - scavcoef_vol(k,icc,jcls,ipp,m,n) = exp( scavimpvol ) - !impaction scavenging removal amount to number - scavcoef_num(k,icc,jcls,ipp,m,n) = exp( scavimpnum ) - -! test diagnostics - if (lun142 > 0) then - write(lun142,'(/a,8i4)') 'wetscav_2_bcscavcoef diags', & - ktau, k, jcls, ipp, icc, n, m - tmpb = sigmag_aer(m,n) - tmpg = log( sigmag_aer(m,n) ) - tmpg = exp( 1.5_r8*tmpg*tmpg ) - tmpa = dcen_sect(m,n)*dgratio/tmpg - tmpc = dens_aer(1,n) ! bcscavcoef_init uses this - if ( .not. hostcode_is_wrfchem ) then - tmpa = tmpa*1.0e2_r8 ! m --> cm - tmpc = tmpc*1.0e-3_r8 ! kg/m^3 --> g/cm^3 - end if - tmpd = 273.16_r8 ! bcscavcoef_init uses this - tmpe = 0.75e6_r8 ! bcscavcoef_init uses this -! call calc_1_impact_rate( & -! dg0, sigmag, rhoaero, temp, press, & -! scavratenum, scavratevol, lunerr ) - call calc_1_impact_rate( & - tmpa, tmpb, tmpc, tmpd, tmpe, & - tmpf, tmpg, lun142 ) - write(lun142,'(1p,8e11.3)') dgratio, & - tmpa, tmpb, tmpc, tmpd, tmpe - write(lun142,'(1p,8e11.3)') & - scavcoef_num(k,icc,jcls,ipp,m,n), tmpf, & - scavcoef_vol(k,icc,jcls,ipp,m,n), tmpg - write(lun142,'(1p,8e11.3)') & - dry_mass, dry_volu, wet_volu, dry_diam, wet_diam, tmp_rh, & - chem_tmpa(k,icc,jcls,ipp,numptr_aer(m,n,ai_phase)) - end if - - end do ! m - end do ! n - - end do icc_loop ! icc - end do ! ipp - end do ! jcls - end do ! k - - -! write(*,'(a)') 'wetscav_2_bcscavcoef DONE' - return - end subroutine wetscav_2_bcscavcoef - - - -!----------------------------------------------------------------------- - subroutine wetscav_2_precip_evap_xfer( & - ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & - idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - is_active, is_precp, is_ptgain, is_ptloss, & - acen_tmp, prtb, frac_evap_prtb, frac_xfer_prtb, & - fxaa_evap_prtb ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! wetscav_2_precip_evap_xfer calculates the fractions of precip -! (and precip-borne aerosols) entering the top of a subarea that are either -! > evaporated/resuspended or -! > transferred to another subarea -! -!----------------------------------------------------------------------- - -! use module_state_description, only: p_qv, p_qc - -! use module_data_radm2, only: epsilc - -! use module_data_mosaic_asect, only: ai_phase, cw_phase, & -! massptr_aer, maxd_asize, maxd_atype, & -! ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer, & -! waterptr_aer - - use module_data_ecpp1 - - implicit none - -! subr arguments - integer, intent(in) :: & - ktau, ktau_pp, itstep_sub, & - it, jt, kts, ktebnd, ktecen - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199), & - idiagbb_wetscav - integer, intent(in) :: ncls_use - - real(r8), intent(in) :: dtstep, dtstep_sub - - logical, intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - is_active, is_precp - logical, intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - is_ptgain, is_ptloss - - real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: acen_tmp - real(r8), intent(in), dimension( kts:ktebnd, 1:2, 1:maxcls_ecpp, 1:2 ) :: prtb - - real(r8), intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: frac_evap_prtb - real(r8), intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, & - 1:2, 1:maxcls_ecpp, 1:2 ) :: frac_xfer_prtb - real(r8), intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, & - 1:2, 1:maxcls_ecpp, 1:2 ) :: fxaa_evap_prtb -! frac_evap_prtb = fraction of precip (and precip-borne aerosols) entering the -! top of a subarea that is evaporated/resuspended -! frac_xfer_prtb = fraction of precip (and precip-borne aerosols) entering the -! top of a subarea that is transferred to another subarea -! (the first set of icc,jcls,ipp indices are the "xfer from" subarea) -! (the second set of icc,jcls,ipp indices are the "xfer to " subarea) - -! local variables - integer :: icc, icc_g, icc_l, iphase, ipp, ipp_l, ipp_g - integer :: jcls, jcls_g, jcls_l - integer :: k, km1 - integer :: lun141 - integer :: m - - real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf, tmpg, tmph - real(r8) :: tmpvecb(100), tmpvece(100), tmpvecf(100) - - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - delprtb, delprtb_g, delprtb_l - real(r8), dimension( kts:ktecen ) :: & - delprtb_gtot, delprtb_ltot, delprtb_xtot, & - frac_evap, frac_xferg, frac_xferl - - - lun141 = -1 - if (idiagaa_ecpp(141) > 0) lun141 = ldiagaa_ecpp(141) - if (idiagbb_wetscav <= 0) lun141 = -1 - - is_ptloss(kts:ktecen,1:2,1:ncls_use,1:2) = .false. - is_ptgain(kts:ktecen,1:2,1:ncls_use,1:2) = .false. - - frac_evap_prtb(kts:ktecen,1:2,1:ncls_use,1:2) = 0.0_r8 - frac_xfer_prtb(kts:ktecen,1:2,1:ncls_use,1:2, 1:2,1:ncls_use,1:2) = 0.0_r8 - fxaa_evap_prtb(kts:ktecen,1:2,1:ncls_use,1:2, 1:2,1:ncls_use,1:2) = 0.0_r8 - - delprtb_gtot(:) = 0.0_r8 ; delprtb_ltot(:) = 0.0_r8 ; delprtb_xtot(:) = 0.0_r8 - frac_evap(:) = 0.0_r8 ; frac_xferg(:) = 0.0_r8 ; frac_xferl(:) = 0.0_r8 - -main_kloop_aa: & - do k = ktecen, kts, -1 - -! -! calculate the fractions of precip (and precip-borne aerosols) -! entering the top of a subarea that are either -! > evaporated/resuspended or -! > transferred to another subarea -! -! this is a bit tricky because we do not have evaporation information, -! and a decrease in precip from k+1 to k for one subarea -! can be due to that precip being classified as in another subarea -! -! approach here is to calculate precip loss and gains (from k+1 to k) -! for each subarea, then try to balance them out -! any "unbalanced" loss is treated as true evaporation -! - - do ipp = 1, 2 - do jcls = 1, ncls_use - do icc = 1, 2 -! delprtb = change in subarea precip from k+1 to k -! delprtb_g = gain in subarea precip from k+1 to k -! delprtb_l = loss in subarea precip from k+1 to k, but sign is positive - delprtb(k,icc,jcls,ipp) = prtb(k, icc,jcls,ipp) & - - prtb(k+1,icc,jcls,ipp) - delprtb_g(k,icc,jcls,ipp) = max( 0.0_r8, delprtb(k,icc,jcls,ipp) ) - delprtb_l(k,icc,jcls,ipp) = max( 0.0_r8, -delprtb(k,icc,jcls,ipp) ) - if (delprtb_g(k,icc,jcls,ipp) > 0.0_r8) is_ptgain(k,icc,jcls,ipp) = .true. - if (delprtb_l(k,icc,jcls,ipp) > 0.0_r8) is_ptloss(k,icc,jcls,ipp) = .true. - end do - end do - end do - -! delprtb_gtot = sum of delprtb_g over all subareas ; similar for depltrb_ltot - delprtb_gtot(k) = sum( delprtb_g(k,1:2,1:ncls_use,1:2) ) - delprtb_ltot(k) = sum( delprtb_l(k,1:2,1:ncls_use,1:2) ) -! delprtb_xtot = is amount of precip loss that can be balance by precip gain - delprtb_xtot(k) = min( delprtb_gtot(k), delprtb_ltot(k) ) - - if (delprtb_gtot(k) > 0.0_r8) then - frac_xferg(k) = delprtb_xtot(k) / delprtb_gtot(k) - frac_xferg(k) = max( 0.0_r8, min( 1.0_r8, frac_xferg(k) ) ) - end if - - if (delprtb_ltot(k) <= 0.0_r8) cycle main_kloop_aa ! bypass next steps if no loss - - frac_xferl(k) = delprtb_xtot(k) / delprtb_ltot(k) - frac_xferl(k) = max( 0.0_r8, min( 1.0_r8, frac_xferl(k) ) ) - frac_evap(k) = 1.0_r8 - frac_xferl(k) - - -! do calcs associated with balancing of precip loss and gain -! current approach is that there is no preferred pairing of -! "losing" and "gaining" subareas -! one might want to pair the clear and cloud subareas of a -! transport class first -- something to think about in the future -! *** this code is incomplete *** -! -! loop over the "losing" subareas - do jcls_l = 1, ncls_use - do ipp_l = 1, 2 - do icc_l = 1, 2 - if ( .not. is_ptloss(k,icc_l,jcls_l,ipp_l) ) cycle - tmpa = delprtb_l(k,icc_l,jcls_l,ipp_l)/prtb(k+1,icc_l,jcls_l,ipp_l) - frac_evap_prtb(k,icc_l,jcls_l,ipp_l) = frac_evap(k)*tmpa - -! loop over the "gaining" subareas - if (frac_xferl(k) <= 1.0e-7_r8) cycle - do jcls_g = 1, ncls_use - do ipp_g = 1, 2 - do icc_g = 1, 2 - if ( .not. is_ptgain(k,icc_g,jcls_g,ipp_g) ) cycle - tmpb = delprtb_g(k,icc_g,jcls_g,ipp_g)/delprtb_gtot(k) - frac_xfer_prtb(k,icc_l,jcls_l,ipp_l, icc_g,jcls_g,ipp_g) = & - frac_xferl(k)*tmpa*tmpb - end do ! icc_g - end do ! ipp_g - end do ! jcls_g - -! if a subarea exists ( is_active ) and has precip>0 at k+1, -! but does not exist at k, then the evaporated/resuspended material -! from the losing subarea must go to other subareas -! the fxaa_evap_prtb are used for this - if ( .not. is_active(k,icc_l,jcls_l,ipp_l) ) then - tmpf = 0.0_r8 - do jcls_g = 1, ncls_use - do ipp_g = 1, 2 - do icc_g = 1, 2 - if ( .not. is_active(k,icc_g,jcls_g,ipp_g) ) cycle - if ((jcls_g == jcls_l) .and. & - (ipp_g == ipp_l) .and. (icc_g == icc_l)) cycle - tmpf = tmpf + acen_tmp(k,icc_g,jcls_g,ipp_g) - fxaa_evap_prtb(k,icc_l,jcls_l,ipp_l, icc_g,jcls_g,ipp_g) = 1.0_r8 - end do ! icc_g - end do ! ipp_g - end do ! jcls_g - fxaa_evap_prtb(k,icc_l,jcls_l,ipp_l, 1:2,1:ncls_use,1:2) = & - fxaa_evap_prtb(k,icc_l,jcls_l,ipp_l, 1:2,1:ncls_use,1:2)*tmpf - end if - - end do ! icc_l - end do ! ipp_l - end do ! jcls_l - - - end do main_kloop_aa - - -! -! diagnostics for testing -! -! first set shows main arrays that can be inspected visually - if (lun141 > 0) then - - tmph = 3600.0_r8 - do k = ktecen, kts, -1 - - write(lun141,'(a,i3)') 'k =', k - - tmpa = delprtb_ltot(k) - delprtb_xtot(k) - tmpb = sum( frac_evap_prtb(k,1:2,1:ncls_use,1:2)*prtb(k+1,1:2,1:ncls_use,1:2) ) - write(lun141,'(a,2f9.5,2x,3f9.5,2x,2f9.5)') 'frac_xferl/evap, delg/l/xtot=', frac_xferl(k), frac_evap(k), & - 3600.0_r8*delprtb_gtot(k), 3600.0_r8*delprtb_ltot(k), 3600.0_r8*delprtb_xtot(k), & - 3600.0_r8*tmpa, 3600.0_r8*tmpb - - write(lun141,'(a,3(2x,4f9.5))') 'acen =', (((acen_tmp(k,icc,jcls,ipp), icc=1,2), ipp=1,2), jcls=1,ncls_use) - write(lun141,'(a,3(2x,4f9.5))') 'prtb =', (((prtb(k,icc,jcls,ipp)*tmph, icc=1,2), ipp=1,2), jcls=1,ncls_use) - write(lun141,'(a,3(2x,4f9.5))') 'delprtb =', (((delprtb(k,icc,jcls,ipp)*tmph, icc=1,2), ipp=1,2), jcls=1,ncls_use) - write(lun141,'(a,3(2x,4f9.5))') 'delprtb_g =', (((delprtb_g(k,icc,jcls,ipp)*tmph, icc=1,2), ipp=1,2), jcls=1,ncls_use) - write(lun141,'(a,3(2x,4f9.5))') 'delprtb_l =', (((delprtb_l(k,icc,jcls,ipp)*tmph, icc=1,2), ipp=1,2), jcls=1,ncls_use) - icc_l = 2 ; ipp_l = 2 ; icc_g = 2 ; ipp_g = 2 - write(lun141,'(a,3(2x,4f9.5))') 'frac_ev/xf =', ( frac_evap_prtb(k,icc_l,jcls_l,ipp_l), & - ( frac_xfer_prtb(k,icc_l,jcls_l,ipp_l, icc_g,jcls_g,ipp_g), jcls_g=1,ncls_use), jcls_l=1,ncls_use) - - end do - - -! second set does "conservation checks" -! is prtb(k) equal to [prtb(k+1) + gains - losses] ? - do k = ktecen, kts, -1 - - write(lun141,'(a,i3)') 'k =', k - -! here check sum( prtb ) over all subareas - tmpa = sum( prtb(k+1,1:2,1:ncls_use,1:2) ) - tmpb = sum( prtb(k ,1:2,1:ncls_use,1:2) ) - tmpc = tmpa + delprtb_gtot(k) - delprtb_ltot(k) - tmpd = tmpa + delprtb_gtot(k)*(1.0_r8 - frac_xferg(k)) - delprtb_ltot(k)*(1.0_r8 - frac_xferl(k)) - tmpe = (tmpb-tmpc)*tmph ! absolute error in mm/h - tmpf = (tmpb-tmpd)*tmph - tmpe = (tmpb-tmpc)/max(tmpa,tmpb,1.0e-30_r8) ! relative error - tmpf = (tmpb-tmpd)/max(tmpa,tmpb,1.0e-30_r8) - write(lun141,'(a,1p,2e10.2)') 'relerr1/2 =', tmpe, tmpf - -! here check prtb for each subarea - m = 0 - do jcls = 1, ncls_use - do ipp = 1, 2 - do icc = 1, 2 - tmpa = prtb(k+1,icc,jcls,ipp) - tmpb = prtb(k ,icc,jcls,ipp) - tmpc = tmpa + delprtb_g(k,icc,jcls,ipp) - delprtb_l(k,icc,jcls,ipp) - if ( is_ptgain(k,icc,jcls,ipp) ) then - tmpd = tmpa + delprtb_g(k,icc,jcls,ipp)*(1.0_r8 - frac_xferg(k)) & - + sum( frac_xfer_prtb(k,1:2,1:ncls_use,1:2,icc,jcls,ipp)*prtb(k+1,1:2,1:ncls_use,1:2) ) - else if ( is_ptloss(k,icc,jcls,ipp) ) then - tmpd = tmpa - prtb(k+1,icc,jcls,ipp)*( frac_evap_prtb(k,icc,jcls,ipp) & - + sum( frac_xfer_prtb(k,icc,jcls,ipp,1:2,1:ncls_use,1:2) ) ) - else - tmpd = tmpb - end if - tmpe = (tmpb-tmpc)*tmph ! absolute error in mm/h - tmpf = (tmpb-tmpd)*tmph - tmpe = (tmpb-tmpc)/max(tmpa,tmpb,1.0e-30_r8) ! relative error - tmpf = (tmpb-tmpd)/max(tmpa,tmpb,1.0e-30_r8) - m = m + 1 - tmpvece(m) = tmpe - tmpvecf(m) = tmpf - tmpvecb(m) = tmpb*tmph - end do - end do - end do - write(lun141,'(a,1p,3(2x,4e10.2))') 'tmpvecb =', tmpvecb(1:m) - write(lun141,'(a,1p,3(2x,4e10.2))') 'tmpvece =', tmpvece(1:m) - write(lun141,'(a,1p,3(2x,4e10.2))') 'tmpvecf =', tmpvecf(1:m) - - end do ! k = ktecen, kts, -1 - - end if ! (lun141 > 0) - - - end subroutine wetscav_2_precip_evap_xfer - - -end module ecpp_modal_wetscav - diff --git a/src/physics/spcam/ecpp/module_data_ecpp1.F90 b/src/physics/spcam/ecpp/module_data_ecpp1.F90 deleted file mode 100644 index 3c64e259b7..0000000000 --- a/src/physics/spcam/ecpp/module_data_ecpp1.F90 +++ /dev/null @@ -1,229 +0,0 @@ -! file module_data_ecpp1.F -!----------------------------------------------------------------------- - - module module_data_ecpp1 - - use shr_kind_mod, only: r8=>shr_kind_r8 - -! integer, parameter :: r4=4 -! integer, parameter :: r8=8 - - -! following are used to dimension several arrays -! declared in module_ecpp_ppdriver.F with "save" -! in mmf framework, these arrays will be subr parameters -! in wrf-chem framework, doing this is just too much trouble -! because of registry limitations - integer, parameter :: its_ecpptmp=1 - integer, parameter :: ite_ecpptmp=1 - integer, parameter :: jts_ecpptmp=1 - integer, parameter :: jte_ecpptmp=1 - integer, parameter :: kts_ecpptmp=1 - integer, parameter :: kte_ecpptmp=51 - integer, parameter :: ktebnd_ecpptmp=kte_ecpptmp - integer, parameter :: ktecen_ecpptmp=kte_ecpptmp-1 - integer, parameter :: num_chem_ecpptmp=101 - - -! maximum number of ecpp transport classes, used for dimensioning various arrays - integer, parameter :: maxcls_ecpp=3 - integer, parameter :: maxsub_ecpp=maxcls_ecpp - -! maximum number of "precipitation types" for wetscav diagnostics -! currently this is 1 -! the wetscav diagnostics are done for each subarea type, so -! have info on where (up, down, quiescent) the scavenging happens. -! however, they do no account for the fact that precip formed -! in updraft can fall (or shift) into quiescent, etc. -! eventually it might be 2, so would have diagnostics involving -! where precip is formed -- quiescent versus (convective) up/downdrafts) - integer, parameter :: max_wetdiagtype = 1 - -! set this to .false. for cam3-mmf - logical, parameter :: hostcode_is_wrfchem = .false. - - -! these are possible values for mtype_updnenv_ecpp_3d & ..._clm3d & ..._clm3d & ..._clm - integer, parameter :: mtype_updraft_ecpp=1 - integer, parameter :: mtype_dndraft_ecpp=2 - integer, parameter :: mtype_quiescn_ecpp=3 - integer, parameter :: mtype_upempty_ecpp=-1 - integer, parameter :: mtype_dnempty_ecpp=-2 - integer, parameter :: mtype_quempty_ecpp=-3 - -! these are possible values for mtype_clrcldy_ecpp_3d & ..._clm3d & ..._clm3d & ..._clm - integer, parameter :: mtype_iscloud_ecpp=11 - integer, parameter :: mtype_nocloud_ecpp=0 - -! these are possible values for mtype_precip_ecpp_3d & ..._clm3d & ..._clm3d & ..._clm - integer, parameter :: mtype_isprecip_ecpp=21 - integer, parameter :: mtype_noprecip_ecpp=0 - - -! this flag determines whether updraft & dndraft profiles are calculated -! using the "primed" mass fluxes or "full" mass fluxes - integer, save :: ppopt_updn_prof_aa -! these are possible values for the flag - integer, parameter :: ppopt_updn_prof_aa_wfull=2001 - integer, parameter :: ppopt_updn_prof_aa_wprime=2002 - - -! this flag determines whether quiescent subarea mass fluxes are -! provided by the host or calculated in the ppm - integer, save :: ppopt_quiescn_mf - integer, parameter :: ppopt_quiescn_mf_byhost=2101 -! these are possible values for the flag - integer, parameter :: ppopt_quiescn_mf_byppmx1=2101 - - -! this flag determines how the quiescent subarea mixing ratios -! are obtained for source-sink calculations - integer, save :: ppopt_quiescn_sosi -! these are possible values for the flag -! 2201 -- qe = qbar - integer, parameter :: ppopt_quiescn_sosi_x1=2201 -! 2202 -- ae*qe = max( 0.0, (qbar-au*qu-ad*qd) ) - integer, parameter :: ppopt_quiescn_sosi_x2=2202 - - -! this flag determines how the subgrid vertical fluxes (and the -! finite differencing for flux divergence) is calculated - integer, save :: ppopt_chemtend_wq -! these are possible values for the flag -! 2301 -- vertflux = mu*qu + md*qd - (mu+md)*qbar; -! upstream approach for qbar at layer boundaries - integer, parameter :: ppopt_chemtend_wq_wfullx1=2301 -! 2302 -- vertflux = mu'*qu + md'*qd - (mu'+md')*qbar; -! upstream approach for qbar at layer boundaries - integer, parameter :: ppopt_chemtend_wq_wprimex1=2302 - - -! this flag determines how the sub-time-step for integrating the -! d(qbar)/dt equation is determined -! (use sub-timesteps to keep courant number < 1 and -! avoid negative mixing ratios) - integer, save :: ppopt_chemtend_dtsub -! these are possible values for the flag - integer, parameter :: ppopt_chemtend_dtsub_x1=2401 -! 2401 -- dumcournomax = max( dumcourentmax, dumcouroutbmax ) - integer, parameter :: ppopt_chemtend_dtsub_x2=2402 -! 2402 -- dumcournomax = max( dumcourentmax, dumcouroutamax, -! dumcouroutbmax ) - integer, parameter :: ppopt_chemtend_dtsub_x3=2403 -! 2403 -- dtstep_sub = largest value that does not produce -! negative mixing ratios - - -! this flag determines how frequently xxx -! is called to calculate up & dndraft profiles and source/sinks - integer, save :: ppopt_chemtend_updnfreq -! these are possible values for the flag - integer, parameter :: ppopt_chemtend_updnfreq_x1=2501 -! 2501 -- called just once, when istep_sub=1 - integer, parameter :: ppopt_chemtend_updnfreq_x2=2502 -! 2502 -- called for each istep_sub - - - integer, parameter :: lunout = 0 - - -! index of quiescent transport class - integer, parameter :: jcls_quiescn = 1 - integer, parameter :: jcls_qu = jcls_quiescn - - -! subarea-average vertical mass fluxes (kg/m2/s) smaller than this -! are treated as zero -! largest expected flux is ~1 (rho=1, w=10, afrac=0.1) -! so could expect truncation errors between 1e-7 and 1e-6 - real(r8), parameter :: mf_smallaa = 1.0e-6_r8 - - -! subarea-average vertical mass fluxes (kg/m2/s) smaller than -! aw_draft_cut*rho are treated as zero -! note that with a*w = 1e-4 m/s, dz over 1 day = 8.6 m which -! is small -! real(r8), parameter :: aw_draft_cut = 1.0e-4_r8 ! m/s -!! maximum expected updraft -! real(r8), parameter :: w_draft_max = 50.0_r8 ! m/s -!! fractional areas below afrac_cut are ignored -! real(r8), parameter :: afrac_cut = aw_draft_cut/w_draft_max -! real(r8), parameter :: afrac_cut_bb = afrac_cut*0.5_r8 -! real(r8), parameter :: afrac_cut_0p5 = afrac_cut*0.5_r8 -! real(r8), parameter :: afrac_cut_0p2 = afrac_cut*0.2_r8 -! real(r8), parameter :: afrac_cut_0p1 = afrac_cut*0.1_r8 - - real(r8), save :: aw_draft_cut = 1.0e-4_r8 ! m/s -! maximum expected updraft - real(r8), save :: w_draft_max = 50.0_r8 ! m/s -! fractional areas below afrac_cut are ignored - real(r8), save :: afrac_cut - real(r8), save :: afrac_cut_bb, afrac_cut_0p5, afrac_cut_0p2, afrac_cut_0p1 - - -! draft lifetime (s) - real(r8), save :: draft_lifetime - -! activat_onoff_ecpp - if positive, do aerosol activation in ecpp -! (set to +1 for normal runs) - integer, save :: activat_onoff_ecpp - -! cldchem_onoff_ecpp - if positive, do aerosol activation in ecpp -! (set to +1 for normal runs) - integer, save :: cldchem_onoff_ecpp - -! rename_onoff_ecpp - if positive, do aerosol activation in ecpp -! (set to +1 for normal runs) - integer, save :: rename_onoff_ecpp - -! wetscav_onoff_ecpp - if positive, do aerosol activation in ecpp -! (set to +1 for normal runs) - integer, save :: wetscav_onoff_ecpp - -! iflag_ecpp_startup_acw_partition - when positive, do -! "special partitioning" of cloudborne and interstitial aerosol to -! clear and cloudy subareas (cloudy gets less interstitial than clear) -! in subr parampollu_tdx_startup -! for normal runs, set this to +1 - integer, save :: iflag_ecpp_startup_acw_partition - -! iflag_ecpp_startup_host_chemtend - when positive, apply -! host changes to chem mixing ratios (e.g., emissions, gas chem) -! in subr parampollu_tdx_startup -! for normal runs, set this to +1 - integer, save :: iflag_ecpp_startup_host_chemtend - -! iflag_ecpp_test_bypass_1 used for early testing - -! when positive, bypass the parampollu_td--- routine -! for normal runs, set this to 0 - integer, save :: iflag_ecpp_test_bypass_1 - -! iflag_ecpp_test_fixed_fcloud used for (early) testing with various fixed cloud fracs -! for normal runs, set this to zero - integer, save :: iflag_ecpp_test_fixed_fcloud - -! "method" flag for parameterized-pollutants module -! (set to +2223 for normal runs and in mmf) - integer, save :: parampollu_opt - -! minimum fractional area for total quiescent class - real(r8), save :: a_quiescn_minaa = 0.60_r8 ! min area for initial total quiescent - real(r8), save :: a_quiescn_minbb = 0.30_r8 ! min area for final total quiescent - - - integer, save :: num_chem_ecpp, param_first_ecpp - - integer, save :: num_chem - integer, save :: p_qc - integer, save :: p_qv - - integer, save :: p_num_a01, p_num_cw01, p_oin_a01, p_oin_cw01, & - p_num_a03, p_num_cw03, p_oin_a03, p_oin_cw03 - -! time step for the ECPP -! It is fixed to be 1800 s. The GCM time step can be less than 1800s. -! For example, if GCM time step is 600s, ECPP will be called at every third GCM time step - real(r8), parameter :: dtstep_pp_input = 1800.0_r8 - - end module module_data_ecpp1 - diff --git a/src/physics/spcam/ecpp/module_data_mosaic_asect.F90 b/src/physics/spcam/ecpp/module_data_mosaic_asect.F90 deleted file mode 100644 index e07cb29f44..0000000000 --- a/src/physics/spcam/ecpp/module_data_mosaic_asect.F90 +++ /dev/null @@ -1,131 +0,0 @@ -!********************************************************************************** -! This computer software was prepared by Battelle Memorial Institute, hereinafter -! the Contractor, under Contract No. DE-AC05-76RL0 1830 with the Department of -! Energy (DOE). NEITHER THE GOVERNMENT NOR THE CONTRACTOR MAKES ANY WARRANTY, -! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS SOFTWARE. -! -! MOSAIC module: see module_mosaic_driver.F for information and terms of use -!********************************************************************************** - module module_data_mosaic_asect - - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none - - -!----------------------------------------------------------------------- -! -! The variables in this module provide a means of organizing and accessing -! aerosol species in the "chem" array by their chemical component, -! size bin (or mode), "type", and "phase" -! -! Their purpose is to allow flexible coding of process modules, -! compared to "hard-coding" using the chem array p_xxx indices -! (e.g., p_so4_a01, p_so4_a02, ...; p_num_a01, ...) -! -!----------------------------------------------------------------------- -! -! rce & sg 2004-dec-03 - added phase and type capability, -! which changed this module almost completely -! -!----------------------------------------------------------------------- -! -! maxd_atype = maximum allowable number of aerosol types -! maxd_asize = maximum allowable number of aerosol size bins -! maxd_acomp = maximum allowable number of chemical components -! in each aerosol size bin -! maxd_aphase = maximum allowable number of aerosol phases -! (gas, cloud, ice, rain, ...) -! -! ntype_aer = number of aerosol types -! The aerosol type will allow treatment of an externally mixed -! aerosol. The current MOSAIC code has only 1 type, with the implicit -! assumption of internal mixing. Eventually, multiple types -! could treat fresh primary BC/OC, fresh SO4 from nucleation, -! aged BC/OC/SO4/... mixture, soil dust, sea salt, ... -! -! nphase_aer = number of aerosol phases -! -! ai_phase = phase (p) index for interstitial (unactivated) aerosol particles -! cw_phase = phase (p) index for aerosol particles in cloud water -! ci_phase = phase (p) index for aerosol particles in cloud ice -! rn_phase = phase (p) index for aerosol particles in rain -! sn_phase = phase (p) index for aerosol particles in snow -! gr_phase = phase (p) index for aerosol particles in graupel -! [Note: the value of "xx_phase" will be between 1 and nphase_aer -! for phases that are active in a simulation. The others -! will have non-positive values.] -! -! nsize_aer(t) = number of aerosol size bins for aerosol type t -! -! ncomp_aer(t) = number of "regular" chemical components for aerosol type t -! -! massptr_aer(c,s,t,p) = the position/index in the chem array for mixing- -! ratio for chemical component c, size bin s, type t, and phase p. -! -! numptr_aer(s,t,p) = the position/index in the chem array for mixing- -! ratio of particle number for size bin s, type t, and phase p. -! -!----------------------------------------------------------------------- -! -! dens_aer(c,t) = dry density (g/cm^3) of aerosol chemical component -! c of type t -! [Note: dens_aer(c,t) == dens_mastercomp_aer(mastercompptr_aer(c,t)) -! The dens_mastercomp_aer is used in some initialization routines. -! The dens_aer is used in most other places because of convenience.] -! -!----------------------------------------------------------------------- -! -! volumlo_sect(s,t) = 1-particle volume (cm^3) at lower boundary of section m -! volumhi_sect(s,t) = 1-particle volume (cm^3) at upper boundary of section m -! volumcen_sect(s,t)= 1-particle volume (cm^3) at "center" of section m -! -! [Note: the "center" values are defined as follows: -! volumcen_sect == 0.5*(volumlo_sect + volumhi_sect) -! == (pi/6) * (dcen_sect**3) ] -! -! -!----------------------------------------------------------------------- - - integer, save :: maxd_atype = 0 - integer, save :: maxd_asize = 0 - integer, save :: maxd_acomp = 0 - integer, save :: maxd_aphase = 0 - - integer, save :: ai_phase = -999888777 - integer, save :: cw_phase = -999888777 -! integer, save :: ci_phase = -999888777 -! integer, save :: rn_phase = -999888777 -! integer, save :: sn_phase = -999888777 -! integer, save :: gr_phase = -999888777 - - integer, save :: ntype_aer = 0 ! number of types - integer, save :: nphase_aer = 0 ! number of phases - - integer, allocatable :: & - nsize_aer (:), & ! number of size bins - ncomp_aer (:), & ! number of chemical components - massptr_aer( :, :, :, :), & - ! index for mixing ratio - numptr_aer( :, :, :) ! index for the number mixing ratio - - real(r8), allocatable :: dens_aer(:,:) ! aerosol density - real(r8), allocatable :: hygro_aer(:,:) ! hygroscopicity - real(r8), allocatable :: sigmag_aer(:,:) ! geometric standard deviation for aerosol - -! added by Yang Zhang - real(r8), allocatable :: & - volumhi_sect(:,:), & - volumlo_sect(:,:), & - dcen_sect(:,:), & - dlo_sect(:,:), & - dhi_sect(:,:) - -! flag for aerosols +++mhwang - logical, allocatable :: is_aerosol(:) ! true if field is aerosol (any phase) - - integer, allocatable :: & - iphase_of_aerosol(:), isize_of_aerosol(:), itype_of_aerosol(:), & - inmw_of_aerosol(:), laicwpair_of_aerosol(:) - - end module module_data_mosaic_asect diff --git a/src/physics/spcam/ecpp/module_data_radm2.F90 b/src/physics/spcam/ecpp/module_data_radm2.F90 deleted file mode 100644 index 7408bc7249..0000000000 --- a/src/physics/spcam/ecpp/module_data_radm2.F90 +++ /dev/null @@ -1,178 +0,0 @@ -!WRF:MODEL_LAYER:CHEMICS -! - MODULE module_data_radm2 - - use shr_kind_mod, only: r8 => shr_kind_r8 - - IMPLICIT NONE -! REAL(r8), PARAMETER :: epsilc = 1.E-16_r8 - REAL(r8), PARAMETER :: epsilc = 1.E-12_r8 - -!--- for radm solver -! .. Parameters .. - INTEGER, PARAMETER :: ldiag = 18, lpred = 39, lss = 2, & - lump = 4, naqre = 70, nreacj = 21, nreack = 140, & - ntroe = 7, numchem_radm = 41 - INTEGER, PARAMETER :: lspec = lpred + lss - INTEGER, DIMENSION(1:NTROE) :: itroe = (/11, 22, 10, 15, 21, 24, 28/) -! -! -! - INTEGER, PARAMETER :: lso2=1 - INTEGER, PARAMETER :: lsulf=2 - INTEGER, PARAMETER :: lno2=3 - INTEGER, PARAMETER :: lno=4 - INTEGER, PARAMETER :: lo3=5 - INTEGER, PARAMETER :: lhno3=6 - INTEGER, PARAMETER :: lh2o2=7 - INTEGER, PARAMETER :: lald=8 - INTEGER, PARAMETER :: lhcho=9 - INTEGER, PARAMETER :: lop1=10 - INTEGER, PARAMETER :: lop2=11 - INTEGER, PARAMETER :: lpaa=12 - INTEGER, PARAMETER :: lora1=13 - - INTEGER, PARAMETER :: lora2=14 - INTEGER, PARAMETER :: lnh3=15 - INTEGER, PARAMETER :: ln2o5=16 - INTEGER, PARAMETER :: lno3=17 - INTEGER, PARAMETER :: lpan=18 - INTEGER, PARAMETER :: lhc3=19 - INTEGER, PARAMETER :: lhc5=20 - INTEGER, PARAMETER :: lhc8=21 - - INTEGER, PARAMETER :: leth=22 - INTEGER, PARAMETER :: lco=23 - INTEGER, PARAMETER :: lol2=24 - INTEGER, PARAMETER :: lolt=25 - INTEGER, PARAMETER :: loli=26 - INTEGER, PARAMETER :: ltol=27 - INTEGER, PARAMETER :: lxyl=28 - INTEGER, PARAMETER :: laco3=29 - - INTEGER, PARAMETER :: ltpan=30 - INTEGER, PARAMETER :: lhono=31 - INTEGER, PARAMETER :: lhno4=32 - INTEGER, PARAMETER :: lket=33 - INTEGER, PARAMETER :: lgly=34 - INTEGER, PARAMETER :: lmgly=35 - INTEGER, PARAMETER :: ldcb=36 - INTEGER, PARAMETER :: lonit=37 - - INTEGER, PARAMETER :: lcsl=38 - INTEGER, PARAMETER :: liso=39 - INTEGER, PARAMETER :: lho=40 - INTEGER, PARAMETER :: lho2=41 -! parameters for timestep, integration - INTEGER, DIMENSION(1:lpred) :: intgrt = (/1, 1, 1, 0, 1, & - 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, & - 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, & - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & - 1, 1, 1, 1 /) -! INTEGER, DIMENSION(1:lspec) :: qdtc = (/0, 0, 1, 0, 1, & -! 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, & -! 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, & -! 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, & -! 0, 0, 0, 0, 0, 0 /) - INTEGER, DIMENSION(1:lspec) :: qdtc = (/1, 1, 1, 0, 1, & - 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, & - 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, & - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, & - 1, 1, 1, 1, 0, 0 /) -! max, min values, - INTEGER :: itrdu -! - REAL(r8), DIMENSION(1:lspec) :: cmin =(/(1.E-16_r8,itrdu=1,lspec)/) -! - REAL(r8), DIMENSION(1:lspec) :: cmax=(/1._r8, 1._r8, 1._r8, 1._r8, .2_r8, & - 3._r8, .05_r8, .01_r8, .01_r8, .01_r8, .05_r8, .01_r8, .05_r8, .05_r8,.05_r8, & - 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, & - 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8, 1._r8,.0001_r8, .1_r8, & - 1._r8, .001_r8, .01_r8, .01_r8, .01_r8, .01_r8/) - -! -! -! - INTEGER, PARAMETER :: lo3p=1 - INTEGER, PARAMETER :: lo1d=2 - INTEGER, PARAMETER :: ltco3=3 - INTEGER, PARAMETER :: lhc3p=4 - INTEGER, PARAMETER :: lhc5p=5 - INTEGER, PARAMETER :: lhc8p=6 - - INTEGER, PARAMETER :: lol2p=7 - INTEGER, PARAMETER :: loltp=8 - INTEGER, PARAMETER :: lolip=9 - INTEGER, PARAMETER :: ltolp=10 - INTEGER, PARAMETER :: lxylp=11 - INTEGER, PARAMETER :: lethp=12 - INTEGER, PARAMETER :: lketp=13 - INTEGER, PARAMETER :: loln=14 - - INTEGER, PARAMETER :: lxo2=15 - INTEGER, PARAMETER :: lxno2=16 - INTEGER, PARAMETER :: lxho=17 - INTEGER, PARAMETER :: lmo2=18 -! -! - INTEGER, PARAMETER :: lnox=1 - INTEGER, PARAMETER :: lhox=2 - INTEGER, PARAMETER :: lpao3=3 - INTEGER, PARAMETER :: ln2n3=4 -! .. - REAL(r8), PARAMETER :: ch4=1.7_r8 - REAL(r8), PARAMETER :: co2=350._r8 - REAL(r8), PARAMETER :: n2=7.81E5_r8 - REAL(r8), PARAMETER :: o2=2.09E5_r8 - REAL(r8), PARAMETER :: pi=3.141592654_r8 - -! .. - REAL(r8) :: afac(2), & - bfac(2), const(3), eor(nreack), & - thafac(nreack), & - xk0300(ntroe), & - xkf300(ntroe), xmtroe(ntroe), xntroe(ntroe) - -! .. -! .. Data Statements .. - DATA thafac/0.00_r8, 6.50E-12_r8, 1.80E-11_r8, 3.20E-11_r8, 2.20E-10_r8, 2.00E-12_r8, & - 1.60E-12_r8, 1.10E-14_r8, 3.70E-12_r8, 4*0.00_r8, 3.30E-12_r8, 0.00_r8, 3.30E-19_r8, & - 1.40E-13_r8, 1.70E-11_r8, 2.50E-14_r8, 2.50E-12_r8, 2*0.00_r8, 2.00E-21_r8, 2*0.00_r8, & - 1.30E-12_r8, 4.60E-11_r8, 2*0.00_r8, 6.95E-18_r8, 1.37E-17_r8, 1.59E-11_r8, 1.73E-11_r8, & - 3.64E-11_r8, 2.15E-12_r8, 5.32E-12_r8, 1.07E-11_r8, 2.10E-12_r8, 1.89E-11_r8, 4.00E-11_r8, & - 9.00E-12_r8, 6.87E-12_r8, 1.20E-11_r8, 1.15E-11_r8, 1.70E-11_r8, 2.80E-11_r8, 1.00E-11_r8, & - 1.00E-11_r8, 1.00E-11_r8, 6.85E-18_r8, 1.55E-11_r8, 2.55E-11_r8, 2.80E-12_r8, 1.95E+16_r8, & - 4.70E-12_r8, 1.95E+16_r8, 4.20E-12_r8, 4.20E-12_r8, 0.00_r8, 4.20E-12_r8, 0.00_r8, & - 4.20E-12_r8, 0.00_r8, 10*4.20E-12_r8, 6.00E-13_r8, 1.40E-12_r8, 6.00E-13_r8, 1.40E-12_r8, & - 1.40E-12_r8, 2.20E-11_r8, 2.00E-12_r8, 1.00E-11_r8, 3.23E-11_r8, 5.81E-13_r8, 1.20E-14_r8, & - 1.32E-14_r8, 7.29E-15_r8, 1.23E-14_r8, 14*7.70E-14_r8, 1.90E-13_r8, 1.40E-13_r8, & - 4.20E-14_r8, 3.40E-14_r8, 2.90E-14_r8, 1.40E-13_r8, 1.40E-13_r8, 1.70E-14_r8, 1.70E-14_r8, & - 9.60E-13_r8, 1.70E-14_r8, 1.70E-14_r8, 9.60E-13_r8, 3.40E-13_r8, 1.00E-13_r8, 8.40E-14_r8, & - 7.20E-14_r8, 3.40E-13_r8, 3.40E-13_r8, 4.20E-14_r8, 4.20E-14_r8, 1.19E-12_r8, 4.20E-14_r8, & - 4.20E-14_r8, 1.19E-12_r8, 7.70E-14_r8, 1.70E-14_r8, 4.20E-14_r8, 3.60E-16_r8, 4.20E-12_r8, & - 4.20E-12_r8, 7.70E-14_r8, 1.70E-14_r8, 4.20E-14_r8, 3.60E-16_r8, 0.00_r8, 1.70E-14_r8, & - 4.20E-14_r8, 3.60E-16_r8/ -! .. -! constants for RADM2 rate coefficients - DATA eor/0._r8, -120._r8, -110._r8, -70._r8, 0._r8, 1400._r8, 940._r8, 500._r8, -240._r8, 0._r8, 0._r8, & - 0._r8, 0._r8, 200._r8, 0._r8, -530._r8, 2500._r8, -150._r8, 1230._r8, 0._r8, 0._r8, 0._r8, 0._r8, 0._r8, 0._r8, & - -380._r8, -230._r8, 0._r8, 0._r8, 1280._r8, 444._r8, 540._r8, 380._r8, 380._r8, -411._r8, -504._r8, & - -549._r8, -322._r8, -116._r8, 0._r8, 0._r8, -256._r8, 745._r8, 0._r8, 0._r8, 0._r8, 0._r8, 0._r8, 0._r8, & - 444._r8, 540._r8, -409._r8, -181._r8, 13543._r8, 0._r8, 13543._r8, -180._r8, -180._r8, 0._r8, -180._r8, & - 0._r8, -180._r8, 0._r8, -180._r8, -180._r8, -180._r8, -180._r8, -180._r8, -180._r8, -180._r8, -180._r8, & - -180._r8, -180._r8, 2058._r8, 1900._r8, 2058._r8, 1900._r8, 1900._r8, 0._r8, 2923._r8, 1895._r8, & - 975._r8, 0._r8, 2633._r8, 2105._r8, 1136._r8, 2013._r8, -1300._r8, -1300._r8, -1300._r8, -1300._r8, & - -1300._r8, -1300._r8, -1300._r8, -1300._r8, -1300._r8, -1300._r8, -1300._r8, -1300._r8, & - -1300._r8, -1300._r8, 25* -220._r8, -1300._r8, -220._r8, -220._r8, -220._r8, -180._r8, -180._r8, & - -1300._r8, -220._r8, -220._r8, 0._r8, 0._r8, -220._r8, -220._r8, -220._r8/ - - DATA xk0300/1.8E-31_r8, 2.2E-30_r8, 1.8E-31_r8, 7.E-31_r8, 2.2E-30_r8, 2.6E-30_r8, 3.E-31_r8/ - DATA xntroe/3.2_r8, 4.3_r8, 3.2_r8, 2.6_r8, 4.3_r8, 3.2_r8, 3.3_r8/ - DATA xkf300/4.7E-12_r8, 1.5E-12_r8, 4.7E-12_r8, 1.5E-11_r8, 1.5E-12_r8, 2.4E-11_r8, & - 1.5E-12_r8/ - DATA xmtroe/1.4_r8, 0.5_r8, 1.4_r8, 2*.5_r8, 1.3_r8, 0._r8/ - DATA afac/2.1E-27_r8, 1.1E-27_r8/ - DATA bfac/10900._r8, 11200._r8/ - DATA const/7.34E21_r8, 4.4E17_r8, 3.23E33_r8/ - - END MODULE module_data_radm2 diff --git a/src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 b/src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 deleted file mode 100644 index 86455f33ab..0000000000 --- a/src/physics/spcam/ecpp/module_ecpp_ppdriver2.F90 +++ /dev/null @@ -1,1454 +0,0 @@ -module module_ecpp_ppdriver2 - -!------------------------------------------------------------------------------------- -! Purpose: -! Provide the CAM interface to the Explicit-Cloud Parameterized-Pollutant hygrid -! approach for aerosol-cloud interactions in the MMF models. -! -! This module was adopted from the one written for the WRF-chem by Dick Easter. -! -! Minghuai Wang (Minghuai.Wang@pnl.gov), 2009-11 -!--------------------------------------------------------------------------------------- - - use shr_kind_mod, only: r8=>shr_kind_r8 - use ppgrid, only: pcols, pver, pverp - use constituents, only: pcnst, cnst_name, cnst_species_class, cnst_spec_class_aerosol, cnst_spec_class_gas - use crmclouds_camaerosols, only: ecpp_mixnuc_tend => crmclouds_mixnuc_tend - use cam_abortutils, only: endrun - - use crmx_ecppvars, only: nupdraft_in, ndndraft_in, ncls_ecpp_in, ncc_in, nprcp_in - use module_data_ecpp1 - use module_data_mosaic_asect - - implicit none - - public :: parampollu_driver2 - public :: papampollu_init - public :: ecpp_mixnuc_tend - -!+++mhwang follow what done in ndrop.F90. this is for qqcw -! ptr2d_t is used to create arrays of pointers to 2D fields -type ptr2d_t - real(r8), pointer :: fldcw(:,:) -end type ptr2d_t - - contains - -!----------------------------------------------------------------------------------------------- -! -! rce 2005-mar-10 - created -! -!------------------------------------------------------------------------------------------------ - subroutine papampollu_init ( ) -!------------------------------------------------------------------------------------------------ -! -! initialize some data used in ECPP, and map aerosol inforation in cam4 into mosaic. -! -! Minghuai Wang, 2009-11 -!------------------------------------------------------------------------------------------------- - use cam_history, only: addfld, add_default, horiz_only - use modal_aero_data - use module_ecpp_td2clm, only: set_of_aerosol_stuff - use module_ecpp_util, only: parampollu_1clm_set_opts - use phys_control, only: phys_getopts - -! Local variables - integer :: n, ll - integer :: ichem, ichem2 - real(r8) :: pi - real(r8) :: tmpa - logical :: history_aerosol - -! get history_aerosol - call phys_getopts(history_aerosol_out = history_aerosol) - -! calculate pi - pi = 4._r8*atan(1._r8) - -! -! set pp options (should this be done from driver?) -! - - num_chem_ecpp = 2* pcnst - num_chem = num_chem_ecpp - param_first_ecpp = 1 ! set to 1 as this can change - p_qv = 1 - p_qc = 2 - - allocate (is_aerosol(1:num_chem_ecpp)) - allocate (iphase_of_aerosol(1:num_chem_ecpp)) - allocate (isize_of_aerosol(1:num_chem_ecpp)) - allocate (itype_of_aerosol(1:num_chem_ecpp)) - allocate (inmw_of_aerosol(1:num_chem_ecpp)) - allocate (laicwpair_of_aerosol(1:num_chem_ecpp)) - -! -! Map the modal aerosol information in modal_aero_data.F90 to module_data_mosaic_asect.F90 -! In the ECPP written for the WRF-chem, it used the MOSAIC aerosol data. MOSAIC have different -! classifications, and use aeroso types, aerosol size bins, chemical components, and aerosol phases -! to describe aerosols. In the CAM4's modal aerosol treatment, it use aerosol modes, and chemical -! components to describe aerosols, and interstial and cloud-borne aerosols are separately tracked. -! When the ECPP codes are ported from the WRF-chem into the MMF model (CAM4.0_SAM), -! the MOSAIC's description of the aerosols are kept, in order to minimize -! the codes changes, but the aerosol information in CAM4.0 is mapped into the MOSAIC one in the -! following way: aeroso type is equivalent to aerosol modes in CAM4, and aerosol size is one for each aerosol type, -! and the aerosol chemical composition is just the same as that in CAM4. Interstitial aerosols in CAM4 is put into -! the phase 1, and cloud-borne aerosol in CAM4 is put into the pase 2. -Minghuai Wang (minghuai.wang@pnl.gov) -! - maxd_atype = ntot_amode - maxd_asize = 1 - maxd_acomp = nspec_max - maxd_aphase = 2 - - ai_phase = 1 ! index for interstial aerosols - cw_phase = 2 ! index for cloud-borne aerosols - - ntype_aer = ntot_amode - nphase_aer = 2 - - allocate (nsize_aer( 1:maxd_atype )) - allocate (ncomp_aer( 1:maxd_atype )) - allocate (massptr_aer( 1:maxd_acomp, 1:maxd_asize, 1:maxd_atype, 1:maxd_aphase )) - allocate (numptr_aer( 1:maxd_asize, 1:maxd_atype, 1:maxd_aphase )) - allocate (dens_aer( 1:maxd_acomp, 1:maxd_atype )) - allocate (hygro_aer( 1:maxd_acomp, 1:maxd_atype )) - allocate (volumhi_sect( 1:maxd_asize, 1:maxd_atype )) - allocate (volumlo_sect( 1:maxd_asize, 1:maxd_atype )) - allocate (sigmag_aer( 1:maxd_asize, 1:maxd_atype )) - allocate (dcen_sect(1:maxd_asize, 1:maxd_atype )) - allocate (dlo_sect(1:maxd_asize, 1:maxd_atype )) - allocate (dhi_sect(1:maxd_asize, 1:maxd_atype )) - - - nsize_aer(1:maxd_atype) = 1 - ncomp_aer(1:maxd_atype) = nspec_amode(1:ntot_amode) - - massptr_aer(1:maxd_acomp, 1, 1:maxd_atype, 1) = lmassptr_amode(1:nspec_max, 1:ntot_amode) - massptr_aer(1:maxd_acomp, 1, 1:maxd_atype, 2) = lmassptrcw_amode(1:nspec_max, 1:ntot_amode) + pcnst - - numptr_aer(1, 1:maxd_atype, 1) = numptr_amode(1:ntot_amode) - numptr_aer(1, 1:maxd_atype, 2) = numptrcw_amode(1:ntot_amode) + pcnst - - do n=1, ntype_aer - do ll=1, ncomp_aer(n) - dens_aer(ll, n) = specdens_amode(ll, n) - hygro_aer(ll, n) = spechygro(ll, n) - end do - - sigmag_aer(1, n) = sigmag_amode(n) - -! Notes: -! the tmpa factor is because -! dcen_sect, dlo_sect, dhi_sect are used as, -! and are compared to, volume-mean diameters -! dgnum_amode, dgnumlo_amode, dgnumhi_amode are used as, -! and are compared to, number-distribution geometric-mean diameters -! volume_mixing_ratio/(number_mixing_ratio*pi/6) -! = volume_mean_diameter**3 -! = (number_geometric_mean_diameter*tmpa)**3 - - tmpa = exp( 1.5_r8 * log(sigmag_amode(n))**2 ) - dcen_sect(1, n) = dgnum_amode(n)*tmpa - dlo_sect( 1, n) = dgnumlo_amode(n)*tmpa - dhi_sect( 1, n) = dgnumhi_amode(n)*tmpa - - volumlo_sect(1, n) = pi/6 * (dgnumlo_amode(n)*tmpa)**3 - volumhi_sect(1, n) = pi/6 * (dgnumhi_amode(n)*tmpa)**3 - end do - - afrac_cut = aw_draft_cut/w_draft_max - afrac_cut_bb = afrac_cut*0.5_r8 - afrac_cut_0p5 = afrac_cut*0.5_r8 - afrac_cut_0p2 = afrac_cut*0.2_r8 - afrac_cut_0p1 = afrac_cut*0.1_r8 - -! set flags - activat_onoff_ecpp = 1 ! droplet activation; 1 turns on activation - cldchem_onoff_ecpp = 1 ! cloud chemistry - rename_onoff_ecpp = 1 ! renaming (modal merging) - - wetscav_onoff_ecpp = 400 ! wet removable 400 turn on wet scaving - -! set convection lifetime - draft_lifetime = 7200 ! seconds, 2 hours lifetime for the momement - -! set flag for a/c partition - iflag_ecpp_startup_acw_partition = 1 ! 1 to turn on a/c parition - -! set flag for whether update changs from host codes - iflag_ecpp_startup_host_chemtend = 0 - -! set other flags - iflag_ecpp_test_bypass_1 = 0 - iflag_ecpp_test_fixed_fcloud = 0 - - parampollu_opt = 2223 ! method flag for parameterized-pollutants module - -! -! set pp options (should this be done from driver?) -! - call parampollu_1clm_set_opts( & - ppopt_updn_prof_aa_wfull, & - ppopt_quiescn_mf_byppmx1, & - ppopt_quiescn_sosi_x1, & - ppopt_chemtend_wq_wfullx1, & - ppopt_chemtend_dtsub_x1, & - ppopt_chemtend_updnfreq_x1 ) - -! -! some other initialization -! - call set_of_aerosol_stuff(is_aerosol, & - iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & - inmw_of_aerosol, laicwpair_of_aerosol ) - -! add fields into history file - do ichem=param_first_ecpp, pcnst - if ((cnst_species_class(ichem) == cnst_spec_class_aerosol) .or. & - (cnst_species_class(ichem) == cnst_spec_class_gas )) then - if(trim(cnst_name(ichem))//'EP' == 'EP') then - write(0, *) ichem, trim(cnst_name(ichem))//'EP' - call endrun('ecpp init1') - end if - call addfld(trim(cnst_name(ichem))//'EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name(ichem))//' tendency from ECPP' ) - call addfld(trim(cnst_name(ichem))//'ACHEM_EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name(ichem))//' tendency from aqueous chemistry in ECPP' ) - call addfld(trim(cnst_name(ichem))//'RENM_EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name(ichem))//' tendency from renaming in ECPP' ) - call addfld(trim(cnst_name(ichem))//'ACT_EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name(ichem))//' tendency from activation/resuspension in ECPP' ) - call addfld(trim(cnst_name(ichem))//'WET_EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name(ichem))//' tendency from wet removable in ECPP' ) - call addfld(trim(cnst_name(ichem))//'WRESU_EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name(ichem))//' tendency from resuspension in wet removable in ECPP') - call addfld(trim(cnst_name(ichem))//'CONV_EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name(ichem))//' tendency from convective tansport in ECPP') - - call addfld(trim(cnst_name(ichem))//'SFEP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from ECPP' ) - call addfld(trim(cnst_name(ichem))//'SFACHEM_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from aqueus chemistry in ECPP' ) - call addfld(trim(cnst_name(ichem))//'SFRENM_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from renaming in ECPP' ) - call addfld(trim(cnst_name(ichem))//'SFACT_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from activation/resuspension ECPP' ) - call addfld(trim(cnst_name(ichem))//'SFWET_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from wet removable in ECPP' ) - call addfld(trim(cnst_name(ichem))//'SFWRESU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP' ) - call addfld(trim(cnst_name(ichem))//'SFCONV_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from convective transport in ECPP' ) - -! Quiescent class - call addfld(trim(cnst_name(ichem))//'SFACHQU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from aqueus chemistry in ECPP (quiescent)' ) - call addfld(trim(cnst_name(ichem))//'SFREMQU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from renaming in ECPP (quiescent)' ) - call addfld(trim(cnst_name(ichem))//'SFACTQU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from activation/resuspension ECPP (quiescent)' ) - call addfld(trim(cnst_name(ichem))//'SFWETQU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from wet removable in ECPP (quiescent)' ) - call addfld(trim(cnst_name(ichem))//'SFRESQU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP (quiescent)' ) - call addfld(trim(cnst_name(ichem))//'SFCONQU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from convective transport in ECPP (quiescent)' ) - -! Updraft class - call addfld(trim(cnst_name(ichem))//'SFACHUP_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from aqueus chemistry in ECPP (updraft)' ) - call addfld(trim(cnst_name(ichem))//'SFREMUP_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from renaming in ECPP (updraft)' ) - call addfld(trim(cnst_name(ichem))//'SFACTUP_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from activation/resuspension ECPP (updraft)' ) - call addfld(trim(cnst_name(ichem))//'SFWETUP_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from wet removable in ECPP (updraft)' ) - call addfld(trim(cnst_name(ichem))//'SFRESUP_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP (updraft)') - call addfld(trim(cnst_name(ichem))//'SFCONUP_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from convective transport in ECPP (updraft)' ) - -! Downdraft class - call addfld(trim(cnst_name(ichem))//'SFACHDN_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from aqueus chemistry in ECPP (downdraft)' ) - call addfld(trim(cnst_name(ichem))//'SFREMDN_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from renaming in ECPP (downdraft)' ) - call addfld(trim(cnst_name(ichem))//'SFACTDN_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from activation/resuspension ECPP (downdraft)' ) - call addfld(trim(cnst_name(ichem))//'SFWETDN_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from wet removable in ECPP (downdraft)' ) - call addfld(trim(cnst_name(ichem))//'SFRESDN_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP (downdraft)' ) - call addfld(trim(cnst_name(ichem))//'SFCONDN_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name(ichem))//' column-integrated tendency from convective transport in ECPP (downdraft)' ) - endif - - end do - do ichem=param_first_ecpp, pcnst - if(.not. (cnst_name_cw(ichem) == ' ')) then - call addfld(trim(cnst_name_cw(ichem))//'EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name_cw(ichem))//' tendency from ECPP' ) - call addfld(trim(cnst_name_cw(ichem))//'ACHEM_EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name_cw(ichem))//' tendency from aqueous chemistry in ECPP' ) - call addfld(trim(cnst_name_cw(ichem))//'RENM_EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name_cw(ichem))//' tendency from renaming in ECPP' ) - call addfld(trim(cnst_name_cw(ichem))//'ACT_EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name_cw(ichem))//' tendency from activation/resuspension in ECPP' ) - call addfld(trim(cnst_name_cw(ichem))//'WET_EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name_cw(ichem))//' tendency from wet removable in ECPP' ) - call addfld(trim(cnst_name_cw(ichem))//'WRESU_EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name_cw(ichem))//' tendency from resuspension in wet removable in ECPP' ) - call addfld(trim(cnst_name_cw(ichem))//'CONV_EP', (/ 'lev' /), 'A', 'kg/kg/s', & - trim(cnst_name_cw(ichem))//' tendency from convective tansport in ECPP' ) - - call addfld(trim(cnst_name_cw(ichem))//'SFEP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from ECPP' ) - call addfld(trim(cnst_name_cw(ichem))//'SFACHEM_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from aqueus chemistry in ECPP' ) - call addfld(trim(cnst_name_cw(ichem))//'SFRENM_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from renaming chemistry in ECPP' ) - call addfld(trim(cnst_name_cw(ichem))//'SFACT_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from activation/resuspension ECPP' ) - call addfld(trim(cnst_name_cw(ichem))//'SFWET_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from wet removable in ECPP' ) - call addfld(trim(cnst_name_cw(ichem))//'SFWRESU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from resuspension in wet removable in ECPP' ) - call addfld(trim(cnst_name_cw(ichem))//'SFCONV_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from convective transport in ECPP' ) - -! Quiescent class - call addfld(trim(cnst_name_cw(ichem))//'SFACHQU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from aqueus chemistry in ECPP (quiescent)' ) - call addfld(trim(cnst_name_cw(ichem))//'SFREMQU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from renaming in ECPP (quiescent)' ) - call addfld(trim(cnst_name_cw(ichem))//'SFACTQU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from activation/resuspension ECPP (quiescent)' ) - call addfld(trim(cnst_name_cw(ichem))//'SFWETQU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from wet removable in ECPP (quiescent)' ) - call addfld(trim(cnst_name_cw(ichem))//'SFRESQU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP (quiescent)') - call addfld(trim(cnst_name_cw(ichem))//'SFCONQU_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from convective transport in ECPP (quiescent)' ) - -! Updraft class - call addfld(trim(cnst_name_cw(ichem))//'SFACHUP_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from aqueus chemistry in ECPP (updraft)' ) - call addfld(trim(cnst_name_cw(ichem))//'SFREMUP_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from renaming in ECPP (updraft)' ) - call addfld(trim(cnst_name_cw(ichem))//'SFACTUP_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from activation/resuspension ECPP (updraft)' ) - call addfld(trim(cnst_name_cw(ichem))//'SFWETUP_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from wet removable in ECPP (updraft)' ) - call addfld(trim(cnst_name_cw(ichem))//'SFRESUP_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP (updraft)' ) - call addfld(trim(cnst_name_cw(ichem))//'SFCONUP_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from convective transport in ECPP (updraft)' ) - -! Downdraft class - call addfld(trim(cnst_name_cw(ichem))//'SFACHDN_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from aqueus chemistry in ECPP (downdraft)' ) - call addfld(trim(cnst_name_cw(ichem))//'SFREMDN_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from renaming in ECPP (downdraft)' ) - call addfld(trim(cnst_name_cw(ichem))//'SFACTDN_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from activation/resuspension ECPP (downdraft)' ) - call addfld(trim(cnst_name_cw(ichem))//'SFWETDN_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from wet removable in ECPP (downdraft)' ) - call addfld(trim(cnst_name_cw(ichem))//'SFRESDN_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from resupspension in wet removable in ECPP (downdraft)') - call addfld(trim(cnst_name_cw(ichem))//'SFCONDN_EP', horiz_only, 'A', 'kg/m2/s', & - trim(cnst_name_cw(ichem))//' column-integrated tendency from convective transport in ECPP (downdraft)' ) - - end if - end do - - call addfld('AQSO4_H2O2_EP', horiz_only, 'A', 'kg/m2/s', 'SO4 aqueous phase chemistry due to H2O2 (kg/m2/s) in ECPP' ) - call addfld('AQSO4_O3_EP', horiz_only, 'A', 'kg/m2/s', 'SO4 aqueous phase chemistry due to O3 (kg/m2/s) in ECPP' ) - call addfld('XPH_LWC_EP', (/ 'lev' /), 'A', ' ', 'pH value multiplied by lwc in ECPP') - - if(history_aerosol) then - call add_default('AQSO4_H2O2_EP', 1, ' ') - call add_default('AQSO4_O3_EP', 1, ' ') - call add_default('XPH_LWC_EP', 1, ' ') - end if - - if(history_aerosol) then - do ichem=param_first_ecpp, pcnst - if(.not. (cnst_name_cw(ichem) == ' ')) then - call add_default(trim(cnst_name_cw(ichem))//'SFEP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFACHEM_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFRENM_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFACT_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFWET_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFWRESU_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFCONV_EP', 1, ' ') - - call add_default(trim(cnst_name_cw(ichem))//'SFACHQU_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFREMQU_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFACTQU_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFWETQU_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFRESQU_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFCONQU_EP', 1, ' ') - - call add_default(trim(cnst_name_cw(ichem))//'SFACHUP_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFREMUP_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFACTUP_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFWETUP_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFRESUP_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFCONUP_EP', 1, ' ') - - call add_default(trim(cnst_name_cw(ichem))//'SFACHDN_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFREMDN_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFACTDN_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFWETDN_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFRESDN_EP', 1, ' ') - call add_default(trim(cnst_name_cw(ichem))//'SFCONDN_EP', 1, ' ') - end if - - if ((cnst_species_class(ichem) == cnst_spec_class_aerosol) .or. & - (cnst_species_class(ichem) == cnst_spec_class_gas )) then - call add_default(trim(cnst_name(ichem))//'SFEP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFACHEM_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFRENM_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFACT_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFWET_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFWRESU_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFCONV_EP', 1, ' ') - - call add_default(trim(cnst_name(ichem))//'SFACHQU_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFREMQU_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFACTQU_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFWETQU_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFRESQU_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFCONQU_EP', 1, ' ') - - call add_default(trim(cnst_name(ichem))//'SFACHUP_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFREMUP_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFACTUP_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFWETUP_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFRESUP_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFCONUP_EP', 1, ' ') - - call add_default(trim(cnst_name(ichem))//'SFACHDN_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFREMDN_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFACTDN_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFWETDN_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFRESDN_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'SFCONDN_EP', 1, ' ') - end if - - end do - -! for test purpose, additional 3D tendency - do ichem=param_first_ecpp, pcnst - if(trim(cnst_name(ichem)) == 'DMS' .or. trim(cnst_name(ichem)) == 'SO2' .or. & - trim(cnst_name(ichem)) == 'so4_a1') then - call add_default(trim(cnst_name(ichem))//'EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'ACHEM_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'RENM_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'ACT_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'WET_EP', 1, ' ') - call add_default(trim(cnst_name(ichem))//'CONV_EP', 1, ' ') - end if - end do - end if ! end history_aerosol - - end subroutine papampollu_init -!================================================================================================== - -!-------------------------------------------------------------------------------------------------- - subroutine parampollu_driver2( & - state, ptend, pbuf, & - dtstep_in, dtstep_pp_in, & - acen_3d, abnd_3d, & - acen_tf_3d, abnd_tf_3d, & - massflxbnd_3d, & - rhcen_3d, qcloudcen_3d, qlsinkcen_3d, & - precrcen_3d, precsolidcen_3d, & - acldy_cen_tbeg_3d & - ) - -! modules from CAM - use physics_types, only: physics_state, physics_ptend, physics_ptend_init - use physics_buffer, only: physics_buffer_desc, pbuf_old_tim_idx, pbuf_get_index, pbuf_get_field - use physconst, only: gravit - use time_manager, only: get_nstep, is_first_step - use constituents, only: cnst_name - use cam_history, only: outfld -#ifdef MODAL_AERO - use modal_aero_data, only: ntot_amode, cnst_name_cw, qqcw_get_field -#endif - -! modules from ECPP - use module_ecpp_td2clm, only: parampollu_td240clm - - implicit none - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_driver2 is the interface between wrf-chem and the -! parameterized pollutants "1 column" routine -! -! main inputs are -! aerosol and trace gas mixing ratios for a subset of the -! host-code domain -! ecpp (sub-grid) cloud statistics for the same subset of domain -! main outputs are -! updated aerosol and trace gas mixing ratios, with changes due -! to sub-grid vertical transport, activation/resuspension, -! cloud chemistry, and wet removal -! -!----------------------------------------------------------------------- - -! subr arguments - - real(r8), intent(in) :: dtstep_in, dtstep_pp_in -! dtstep_in - main model time step (s) -! dtstep_pp_in - time step (s) for "parameterized pollutants" calculations - - type(physics_state), intent(in) :: state ! Physics state variables - type(physics_ptend), intent(inout) :: ptend ! individual parameterization - type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer - - real(r8), intent(in), dimension( pcols, pverp, 1:ncc_in, 1:ncls_ecpp_in, 1:nprcp_in ) :: & - abnd_3d, abnd_tf_3d, massflxbnd_3d - real(r8), intent(in), dimension( pcols, pver, 1:ncc_in, 1:ncls_ecpp_in, 1:nprcp_in ) :: & - acen_3d, acen_tf_3d, rhcen_3d, & - qcloudcen_3d, qlsinkcen_3d, precrcen_3d, precsolidcen_3d -! *** note - these are not "3d" now but probably will be in the mmf code -! abnd_3d and abnd_tf_3d - sub-class fractional area (--) at layer bottom boundary -! abnd_3d is average for full time period (=dtstep_pp_in) -! abnd_tf_3d is average for end-portion of time period -! acen_3d and acen_tf_3d - sub-class fractional area (--) at layer center -! acen_3d is average for full time period (=dtstep_pp_in) -! acen_tf_3d is average for end-portion of time period -! massflxbnd_3d - sub-class vertical mass flux (kg/m2/s) at layer bottom boundary. -! *** note - These are calculated using wfull, not wprime. -! rhcen_3d - relative humidity (0-1) at layer center -! qcloudcen_3d - cloud water mixing ratio (kg/kg) at layer center -! qlsinkcen_3d - cloud-water first-order loss rate to precipitation (/s) at layer center -! precrcen_3d - liquid (rain) precipitation rate (kg/m2/s) at layer center -! precsolidcen_3d - solid (snow,graupel,...) precipitation rate (kg/m2/s) at layer center - - real(r8), intent(inout), dimension( pcols, pver) :: acldy_cen_tbeg_3d -! acldy_cen_tbeg_3d = total (all sub-classes) cloudy fractional area -! on input, = value from end of the previous time step -! on output, = value from end of the current time step - -!----------------------------------------------------------------------- -! local variables - integer :: ncol, lchnk - integer :: mbuf - integer :: id - integer :: i, icc, ipass, ipp, itmpa, it, ichem, ichem2 - integer :: j, jclrcld, jcls, jclsaa, jclsbb, jt - integer :: nstep, nstep_pp - integer :: k, ka, kb, lk - integer :: l, ll, levdbg_err, levdbg_info - integer :: lun, lun60, lun61, lun131, lun132, lun133, lun134, lun135 - integer :: n, ncls_ecpp, nupdraft, ndndraft - integer :: itmpcnt(pver+1,4) - integer :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) - - integer, dimension( 1:2, 1:maxcls_ecpp ) :: & - kdraft_bot_ecpp, kdraft_top_ecpp, & - mtype_updnenv_ecpp - - real(r8) :: dtstep, dtstep_pp - real(r8) :: tmpa, tmpb, tmpc, tmpd - real(r8) :: za, zb, zc - - integer, dimension( 1:nupdraft_in ) :: & - kupdraftbase, kupdrafttop - integer, dimension( 1:ndndraft_in ) :: & - kdndraftbase, kdndrafttop -! kupdraftbase, kupdrafttop - lower-most and upper-most level for each updraft class -! *** note1- these refer to layer centers, not layer boundaries. Thus -! acen > 0 for kupdraftbase:kupdrafttop and = 0 at other k -! abnd > 0 for kupdraftbase+1:kupdrafttop and = 0 at other k -! massflxbnd > 0 for kupdraftbase+1:kupdrafttop and = 0 at other k -! kdndraftbase, kdndrafttop - lower-most and upper-most level for each downdraft class -! *** note2- these get checked/adjusted later, so simply setting k--draftbase = kts -! and k--drafttop = ktecen is OK - - real(r8) :: tcen_bar (pver) ! temperature at layer centers (K) - real(r8) :: pcen_bar (pver) ! pressure at layer centers (K) - real(r8) :: rhocen_bar (pver) ! air density at layer centers (kg/m3) - real(r8) :: dzcen (pver) ! layer depth (m) - real(r8) :: wcen_bar (pver) ! vertical velocity at layer centers (m/s) - real(r8) :: rhobnd_bar (pverp) ! air density at layer boundaries (kg/m3) - real(r8) :: zbnd (pverp) ! elevation at layer boundaries (m) ???elevation or height???? - real(r8) :: wbnd_bar (pverp) ! vertical velocity at layer boundaries (m/s) - - real(r8) :: chem_bar (pver, 1:num_chem_ecpp) ! mixing ratios of trace gase (ppm) and aerosol species - ! (ug/kg for mass species, #/kg for number species) -#ifdef MODAL_AERO -! real(r8), pointer, dimension(:, :, :) :: qqcw ! cloud-borne aerosol - type(ptr2d_t) :: qqcw(pcnst) -! real(r8) :: qqcwold(pcols, pver, pcnst) -#endif - real(r8), dimension( pverp, 0:2, 0:maxcls_ecpp ) :: & - abnd_tavg, abnd_tfin, mfbnd - real(r8), dimension( pver, 0:2, 0:maxcls_ecpp ) :: & - acen_tavg, acen_tfin, acen_tbeg, acen_prec - real(r8), dimension( pver, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - rh_sub2, qcloud_sub2, qlsink_sub2, precr_sub2, precs_sub2 - real(r8), dimension(pver, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & - del_cldchem, & ! tendency of chem_sub from aqueous chemistry - del_rename, & ! tendency of chem_sub from renaming. - del_wetscav, & ! tendency of chem_sub from wet deposition - del_wetresu - - real(r8), dimension(pver, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - del_activate, & ! tendency of chem_sub from activation/resuspension - del_conv ! tendency of chem_sub from convective transport - - real(r8), dimension(pcols, pver, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & - del_cldchem3d, & ! tendency of chem_sub from aqueous chemistry - del_rename3d, & ! tendency of chem_sub from renaming. - del_wetscav3d, & ! tendency of chem_sub from wet deposition - del_wetresu3d ! tendency of chem_sub from resuspension in wet deposition - - real(r8), dimension(pcols, pver, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - del_activate3d, & ! tendency of chem_sub from activation/resuspension - del_conv3d ! tendency of chem_sub from convective transport - - real(r8), dimension(pcols) :: aqso4_h2o2, & ! SO4 aqueous phase chemistry due to H2O2 (kg/m2/s) - aqso4_o3 ! SO4 aqueous phase chemistry due to O3 (kg/m2/s) - - real(r8), dimension(pver, 1:2, 1:maxcls_ecpp, 1:2) :: xphlwc ! pH value multiplied by lwc - real(r8), dimension(pcols, pver, 1:2, 1:maxcls_ecpp, 1:2) :: xphlwc3d - real(r8), dimension(pcols, pver) :: xphlwc_gcm - - - real(r8), dimension(pcols, pver, 1:num_chem_ecpp) :: & - ptend_cldchem, ptend_rename, ptend_wetscav, ptend_wetresu, ptend_activate, ptend_conv ! tendency at GCM grids - - real(r8), dimension(pcols, pver, 1:maxcls_ecpp, 1:num_chem_ecpp) :: & - ptend_activate_cls, & ! activation tendency for sub transport class - ptend_cldchem_cls, & ! aqueous chemistry - ptend_rename_cls, & ! renaming - ptend_wetscav_cls, & ! wet deposition - ptend_wetresu_cls, & ! resuspension - ptend_conv_cls ! convective transport - - real(r8), dimension(pcols, 1:maxcls_ecpp, 1:num_chem_ecpp) :: & - ptend_activate_cls_col, & ! column-integrated activation tendency for sub transport class - ptend_cldchem_cls_col, & ! aqueous chemistry - ptend_rename_cls_col, & ! renaming - ptend_wetscav_cls_col, & ! wet deposition - ptend_wetresu_cls_col, & ! resuspension - ptend_conv_cls_col ! convective transport - - - real(r8), dimension(pcols, 1:num_chem_ecpp) :: & - ptend_cldchem_col, ptend_rename_col, ptend_wetscav_col, ptend_wetresu_col, ptend_activate_col, ptend_conv_col, & - ptendq_col ! column-integrated tendency - - real(r8), dimension(pcols, pver, 1:pcnst) :: ptend_qqcw ! tendency for cloud-borne aerosols - - real(r8), dimension(pcols, 1:num_chem_ecpp) :: del_chem_col_cldchem, del_chem_col_rename, del_chem_col_wetscav ! column tendency calcuated in ECPP - - character(len=100) :: msg - logical :: lq(pcnst) - -!----------------------------------------------------------------------- -! set flags that turn diagnostic output on/off -! -! for a specific output to be "on", both the -! idiagaa_ecpp(--) and ldiagaa_ecpp(--) be positive -! the ldiagaa_ecpp(--) is the output unit number -! -! 60 - from subr parampollu_driver2 -! short messages on entry and exit -! 61 - from subr parampollu_driver2 -! "rcetestpp diagnostics" block -! 62 - from subr parampollu_td240clm -! short messages on entry and exit, and showing sub-time-step -! 63 - from subr parampollu_check_adjust_inputs -! shows some summary statistics about the check/adjust process -! 115, 116, 117 - from subr parampollu_1clm_dumpaa -! shows various statistics on transport class and subarea -! fractional areas and mass fluxes -! 116 is before call to parampollu_check_adjust_inputs -! 117 is after 1st call to parampollu_check_adjust_inputs -! 115 is after 2nd call to parampollu_check_adjust_inputs -! 118 - from subr parampollu_tdx_main_integ and parampollu_tdx_area_change -! diagnostics involving changes to species 9 in those subrs -! 119 - from subr parampollu_tdx_cleanup -! diagnostics involving changes to species 9 in that subr -! 121 - from subr parampollu_tdx_cleanup -! diagnostics involving mass conservation -! 122 - from subr parampollu_tdx_entdet_sub1 and parampollu_tdx_entdet_diag01 -! diagnostics involving entrainment/detrainment and area changes -! 123 - from subr parampollu_tdx_entdet_sub1 -! diagnostics involving entrainment/detrainment and area changes -! 124 - from subr parampollu_tdx_main_integ -! diagnostics involving sub-time-step for "main integration", -! related to stability and courant number -! 125 - from subr parampollu_tdx_activate_intface -! diagnostics involving aerosol activation and associated vertical velocities -! 131-135 - from subr parampollu_driver2 -! shows various statistics on transport class and subarea -! fractional areas and mass fluxes -! 141-143 - from subr parampollu_tdx_wetscav_2 -! diagnostics for the "new" wetscav code designed for the mmf-with-ecpp -! 155 - from subr parampollu_check_adjust_inputs -! shows "history" of acen_tavg_use thru the check/adjust process -! 161, 162, 164 - from subr parampollu_tdx_startup & parampollu_tdx_partition_acw -! involves partitioning of cloudborne/interstitial aerosol between clear -! and cloudy subareas - -! - idiagaa_ecpp(:) = 0 -! idiagaa_ecpp(60:63) = 1 - idiagaa_ecpp(60:63) = -1 - idiagaa_ecpp(115:119) = 1 ; idiagaa_ecpp(118) = 111 - idiagaa_ecpp(121:125) = 1 - idiagaa_ecpp(131:135) = 1 - idiagaa_ecpp(141:143) = 1 - - idiagaa_ecpp(155) = 1 - idiagaa_ecpp(161) = 1 ; idiagaa_ecpp(162) = 1 ; idiagaa_ecpp(164) = 1 - - idiagaa_ecpp(131:135) = -1 ! not output in the MMF model - idiagaa_ecpp(115:117) = -1 ! not dump the original field in parampollu_td240clm - idiagaa_ecpp(118:119) = -1 - idiagaa_ecpp(121:125) = -1 - idiagaa_ecpp(141:143) = -1 - idiagaa_ecpp(165:167) = -1 - idiagaa_ecpp(164) = -1 - idiagaa_ecpp(161) = -1 - idiagaa_ecpp(162) = -1 - - idiagaa_ecpp(121) = -1 - - do i = 1, 199 - ldiagaa_ecpp(i) = i - end do - ldiagaa_ecpp(60:69) = 6 - ldiagaa_ecpp(62) = 62 - -!----------------------------------------------------------------------- - - lun60 = -1 - if (idiagaa_ecpp(60) > 0) lun60 = ldiagaa_ecpp(60) - lun61 = -1 - if (idiagaa_ecpp(61) > 0) lun61 = ldiagaa_ecpp(61) - lun131 = -1 - if (idiagaa_ecpp(131) > 0) lun131 = ldiagaa_ecpp(131) - lun132 = -1 - if (idiagaa_ecpp(132) > 0) lun132 = ldiagaa_ecpp(132) - lun133 = -1 - if (idiagaa_ecpp(133) > 0) lun133 = ldiagaa_ecpp(133) - lun134 = -1 - if (idiagaa_ecpp(134) > 0) lun134 = ldiagaa_ecpp(134) - lun135 = -1 - if (idiagaa_ecpp(135) > 0) lun135 = ldiagaa_ecpp(135) - - - ncol = state%ncol - lchnk = state%lchnk - - lq(:) = .false. - do ichem=param_first_ecpp, pcnst - if ((cnst_species_class(ichem) == cnst_spec_class_aerosol) .or. & - (cnst_species_class(ichem) == cnst_spec_class_gas )) then - lq(ichem)=.true. - end if - end do - call physics_ptend_init(ptend, state%psetcols,'ecpp',lq=lq) - ptend%q(:,:,:) = 0.0_r8 - - dtstep = dtstep_in - dtstep_pp = dtstep_pp_in - -!rcetestpp diagnostics -------------------------------------------------- - if (lun61 > 0) then - write(lun61,93010) ' ' - write(lun61,93010) 'rcetestpp diagnostics from parampollu_driver2' - write(lun61,93020) 'dtstep, dtstep_pp ', & - dtstep, dtstep_pp -93010 format( a, 8(1x,i6) ) -93020 format( a, 8(1p,e14.6) ) - end if ! (lun61 > 0) -!rcetestpp diagnostics -------------------------------------------------- - - if (num_chem_ecpptmp < num_chem_ecpp) then - msg = '*** parampollu_driver -- bad num_chem_ecpptmp' - call endrun(msg) - end if - -! check for valid ncls_ecpptmp - nupdraft = nupdraft_in - ndndraft = ndndraft_in - ncls_ecpp = (nupdraft + ndndraft + 1) - if (ncls_ecpp > maxcls_ecpp) then - write(msg,'(a,2(1x,i6))') & - '*** parampollu_driver - ncls_ecpp > maxcls_ecpp, values =', & - ncls_ecpp, maxcls_ecpp - call endrun( msg ) - end if - if (ncls_ecpp /= ncls_ecpp_in) then - write(msg,'(a,2(1x,i8))') & - '*** parampollu_driver -- bad ncls_ecpp_in', & - ncls_ecpp_in, ncls_ecpp - call endrun( msg ) - end if - -! on very first time step, initialize acldy_cen_tbeg -! -! *** this code should probably go into parampollu_init0 (or somewhere else) - nstep = get_nstep() - nstep_pp = nstep - if (is_first_step()) then - acldy_cen_tbeg_3d(:,:) = 0.0_r8 - - do k = 1, pver - do i = 1, ncol - tmpa = 0.0_r8 ; tmpb = 0.0_r8 - do ipp = 1, nprcp_in - do jcls = 1, ncls_ecpp - tmpa = tmpa + max( 0.0_r8, acen_3d(i,k,1,jcls,ipp) ) - tmpb = tmpb + max( 0.0_r8, acen_3d(i,k,2,jcls,ipp) ) - end do - end do - - if (abs(tmpa+tmpb-1.0_r8) > 1.0e-3_r8) then - write(msg,'(a,3i5,1pe15.7)') & - '*** parampollu_driver -- bad acen_tbeg - i,j,k,acen', & - i, j, k, (tmpa+tmpb) - call endrun(msg) - end if - tmpa = tmpa/(tmpa+tmpb) - - tmpa = 1.0_r8 ! force to initially clear -- might want to change this - -! when iflag_ecpp_test_fixed_fcloud = 2/3/4/5, force acen_tbeg 100%/0%/70%/30% clear - if ((iflag_ecpp_test_fixed_fcloud >= 2) .and. & - (iflag_ecpp_test_fixed_fcloud <= 5)) then - if (iflag_ecpp_test_fixed_fcloud == 2) then - tmpa = 1.0_r8 - else if (iflag_ecpp_test_fixed_fcloud == 3) then - tmpa = 0.0_r8 - else if (iflag_ecpp_test_fixed_fcloud == 4) then - tmpa = 0.7_r8 - else - tmpa = 0.3_r8 - end if - end if - - acldy_cen_tbeg_3d(i,k) = 1.0_r8 - tmpa - end do - end do - end if - - -! set some variables to their wrf-chem "standard" values - levdbg_err = 0 - levdbg_info = 15 - -#ifdef MODAL_AERO -! mbuf = pbuf_get_fld_idx( 'QQCW' ) -! if ( associated(pbuf(mbuf)%fld_ptr) ) then -! qqcw => pbuf(mbuf)%fld_ptr( 1, 1:pcols, 1:pver, lchnk, 1:pcnst ) -! else -! call endrun( 'pbuf for QQCW not allocated in aerosol_wet_intr' ) -! end if -!+++mhwang 2012-02-22 -! qqcw_get_field is no longer used in ndrop.F90. Make sure -! it is still valid !!!! - do i=1,pcnst - qqcw(i)%fldcw => qqcw_get_field(pbuf, i,lchnk,.true.) - end do -#endif - -! loop over columns - do 2910 i = 1, ncol -! -! load column arrays -! - zbnd(1) = 0.0_r8 - wbnd_bar(1) = 0.0_r8 - do k=pver, 1, -1 - tcen_bar(pver-k+1) = state%t(i,k) - pcen_bar(pver-k+1) = state%pmid(i,k) - -! dry air density is calcualted, because tracer mixing ratios are defined with respect to dry air in CAM. - rhocen_bar(pver-k+1) = state%pmiddry(i,k)/(287.0_r8*state%t(i,k)) - - wbnd_bar(pver-k+2) = -1*state%omega(i,k)/(rhocen_bar(pver-k+1)*gravit) - -! pressure vertical velocity (Pa/s) to height vertical velocity (m/s) - dzcen(pver-k+1) = state%pdeldry(i,k)/gravit/rhocen_bar(pver-k+1) - - zbnd(pver-k+2) = zbnd(pver-k+1) + dzcen(pver-k+1) - end do - - do k = 1, pver+1 - ka = max( 1, min(pver-1, k-1 ) ) - kb = ka + 1 - za = 0.5_r8*(zbnd(ka) + zbnd(ka+1)) - zb = 0.5_r8*(zbnd(kb) + zbnd(kb+1)) - rhobnd_bar(k) = rhocen_bar(ka) & - + (rhocen_bar(kb)-rhocen_bar(ka))*(zbnd(k)-za)/(zb-za) - end do - - chem_bar(:,:) = 0.0_r8 -! Load chem - do k=pver, 1, -1 - do ichem = 1, num_chem_ecpp - if(ichem.le.pcnst) then - chem_bar(pver-k+1, ichem) = state%q(i, k, ichem) -#ifdef MODAL_AERO - else -! chem_bar(pver-k+1, ichem) = qqcw(i, k, ichem-pcnst) - if(associated(qqcw(ichem-pcnst)%fldcw)) then - chem_bar(pver-k+1, ichem) = qqcw(ichem-pcnst)%fldcw(i, k) - else - chem_bar(pver-k+1, ichem) = 0.0_r8 - end if -#endif - end if - end do - end do - -! -! load transport-class arrays -! - -! load other/quiescent - jcls = 1 - - kupdraftbase = 1 - kupdrafttop = pver - kdndraftbase = 1 - kdndrafttop = pver - - kdraft_bot_ecpp( 1:2,jcls) = 1 - kdraft_top_ecpp( 1:2,jcls) = pver - mtype_updnenv_ecpp(1:2,jcls) = mtype_quiescn_ecpp - -! load updrafts - do n = 1, nupdraft - jcls = jcls + 1 - - kdraft_bot_ecpp( 1:2,jcls) = max( kupdraftbase(n), 1 ) - kdraft_top_ecpp( 1:2,jcls) = min( kupdrafttop(n), pver ) - mtype_updnenv_ecpp(1:2,jcls) = mtype_updraft_ecpp - end do - -! load downdrafts - do n = 1, ndndraft - jcls = jcls + 1 - - kdraft_bot_ecpp( 1:2,jcls) = max( kdndraftbase(n), 1 ) - kdraft_top_ecpp( 1:2,jcls) = min( kdndrafttop(n), pver ) - mtype_updnenv_ecpp(1:2,jcls) = mtype_dndraft_ecpp - end do - -! load mfbnd and "area" arrays for all classes - mfbnd( :,:,:) = 0.0_r8 - abnd_tavg(:,:,:) = 0.0_r8 - abnd_tfin(:,:,:) = 0.0_r8 - acen_tavg(:,:,:) = 0.0_r8 - acen_tfin(:,:,:) = 0.0_r8 - - do jcls = 1, ncls_ecpp - do icc = 1, 2 - do k = 1, pver+1 - lk=pver+1-k+1 - mfbnd( lk,icc,jcls) = massflxbnd_3d(i, k,icc,jcls,1) & - + massflxbnd_3d(i, k,icc,jcls,2) - abnd_tavg(lk,icc,jcls) = abnd_3d(i, k,icc,jcls,1) & - + abnd_3d(i, k,icc,jcls,2) - abnd_tfin(lk,icc,jcls) = abnd_tf_3d(i, k,icc,jcls,1) & - + abnd_tf_3d(i, k,icc,jcls,2) - end do ! k - end do ! icc - end do ! jcls - -! load these arrays - acen_prec( :,:,: ) = 0.0_r8 - qcloud_sub2(:,:,:,:) = 0.0_r8 - qlsink_sub2(:,:,:,:) = 0.0_r8 - precr_sub2( :,:,:,:) = 0.0_r8 - precs_sub2( :,:,:,:) = 0.0_r8 - rh_sub2( :,:,:,:) = 0.0_r8 - do k=1, pver - lk=pver-k+1 - acen_tavg( lk,1:2,1:ncls_ecpp ) = acen_3d(i, k,1:2,1:ncls_ecpp,1)+ & - acen_3d(i, k,1:2,1:ncls_ecpp,2) - acen_tfin( lk,1:2,1:ncls_ecpp ) = acen_tf_3d(i, k,1:2,1:ncls_ecpp,1)+ & - acen_tf_3d(i, k,1:2,1:ncls_ecpp,2) - acen_prec( lk,1:2,1:ncls_ecpp ) = acen_3d(i, k,1:2,1:ncls_ecpp,2) - qcloud_sub2(lk,1:2,1:ncls_ecpp,1:2) = qcloudcen_3d(i, k,1:2,1:ncls_ecpp,1:2) - qlsink_sub2(lk,1:2,1:ncls_ecpp,1:2) = qlsinkcen_3d(i, k,1:2,1:ncls_ecpp,1:2) - precr_sub2( lk,1:2,1:ncls_ecpp,1:2) = precrcen_3d(i, k,1:2,1:ncls_ecpp,1:2) - precs_sub2( lk,1:2,1:ncls_ecpp,1:2) = precsolidcen_3d(i, k,1:2,1:ncls_ecpp,1:2) - rh_sub2( lk,1:2,1:ncls_ecpp,1:2) = rhcen_3d(i, k,1:2,1:ncls_ecpp,1:2) - if( sum(acen_tfin( lk,1:2,jcls_qu)).lt.0.05_r8) then - write(0, *) 'test acen_tfin < 0.40', sum(acen_tfin( lk,1:2,jcls_qu)), pcen_bar(lk), i,lk !+++mhwang - end if - end do - -! force kdraft_top > kdraft_bot -! (note: need to change the wrf3d post-processor so this is not needed) - do jcls = 1, ncls_ecpp - do jclrcld = 1, 2 - kdraft_top_ecpp(jclrcld,jcls) = max( kdraft_top_ecpp(jclrcld,jcls), & - kdraft_bot_ecpp(jclrcld,jcls)+1 ) - if (kdraft_top_ecpp(jclrcld,jcls) .gt. pver) then - kdraft_top_ecpp(jclrcld,jcls) = pver - kdraft_bot_ecpp(jclrcld,jcls) = pver-1 - end if - end do - end do - -! load acen_tbeg from 3d saved values - acen_tbeg(:,:,:) = 0.0_r8 - jcls = 1 - do k=1, pver - lk=pver-k+1 - acen_tbeg(lk,2,jcls) = acldy_cen_tbeg_3d(i,k) - acen_tbeg(lk,1,jcls) = 1.0_r8 - acen_tbeg(lk,2,jcls) - end do - -! start of temporary diagnostics ------------------------------ - do ipass = 1, 3 - - do ll = 131, 133 - lun = -1 - if (ll == 131) lun = lun131 - if (ll == 132) lun = lun132 - if (ll == 133) lun = lun133 - if (lun <= 0) cycle - - write(lun,*) - if (ipass .eq. 1) then - n = nupdraft - write(lun,'(a,3i5)') 'updrafts, nup, ktau', n, nstep, nstep_pp - else if (ipass .eq. 2) then - n = ndndraft - write(lun,'(a,3i5)') 'dndrafts, nup, ktau', n, nstep, nstep_pp - else - n = ncls_ecpp - write(lun,'(a,3i5)') 'quiescents, ncls_ecpp, ktau', n, nstep, nstep_pp - end if - end do - - do ka = (2*((pver+1)/2)-1), 1, -2 - tmpa = 0.0_r8 - tmpb = 0.0_r8 - tmpc = 0.0_r8 - tmpd = 0.0_r8 - kb = ka+1 -! kb = ka - - if (ipass .eq. 1) then - jclsaa = 1 + 1 - jclsbb = 1 + nupdraft - else if (ipass .eq. 2) then - jclsaa = 1 + nupdraft + 1 - jclsbb = 1 + nupdraft + ndndraft - else - jclsaa = 1 - jclsbb = 1 - end if - do ipp = 1, 2 - do jcls = jclsaa, jclsbb - tmpa = tmpa + abnd_3d(i,ka,1,jcls,ipp) + abnd_3d(i,kb,1,jcls,ipp) - tmpb = tmpb + abnd_3d(i,ka,2,jcls,ipp) + abnd_3d(i,kb,2,jcls,ipp) - tmpc = tmpc + massflxbnd_3d(i,ka,1,jcls,ipp) + massflxbnd_3d(i,kb,1,jcls,ipp) - tmpd = tmpd + massflxbnd_3d(i,ka,2,jcls,ipp) + massflxbnd_3d(i,kb,2,jcls,ipp) - end do - end do - - tmpa = tmpa*0.5_r8 ; tmpb = tmpb*0.5_r8 ; - tmpc = tmpc*0.5_r8 ; tmpd = tmpd*0.5_r8 - if (lun131 > 0) & - write(lun131,'(i3,2(3x,1p,3e10.2))') ka, & - tmpa, tmpb, (tmpa+tmpb), tmpc, tmpd, (tmpc+tmpd) - - tmpa = tmpa*100.0_r8 ; tmpb = tmpb*100.0_r8 - tmpc = tmpc*100.0_r8 ; tmpd = tmpd*100.0_r8 - if (lun132 > 0) & - write(lun132,'(i3,2(2x, 3f8.3))') ka, & - tmpa, tmpb, (tmpa+tmpb), tmpc, tmpd, (tmpc+tmpd) - - if (lun133 > 0) & - write(lun133,'(i3,2(2x, 3f7.2))') ka, & - tmpa, tmpb, (tmpa+tmpb), tmpc, tmpd, (tmpc+tmpd) - end do ! ka - end do ! ipass - - - if (lun134 > 0) then - do n = 1, nupdraft - write(lun134,'(/a,5i5)') 'updraft -- n, kbase, ktop, ktaus', & - n, kupdraftbase(n), kupdrafttop(n), nstep, nstep_pp - do k = pver+1, 1, -1 - jcls = 1 + n - write(lun134,'(i3,2(2x,2f10.5))') k, & - sum(abnd_3d(i,k,1,jcls,1:2))*100.0_r8, sum(abnd_3d(i,k,2,jcls,1:2))*100.0_r8, & - sum(massflxbnd_3d(i,k,1,jcls,1:2))*100.0_r8, & - sum(massflxbnd_3d(i,k,2,jcls,1:2))*100.0_r8 - end do - end do - - do n = 1, ndndraft - write(lun134,'(/a,5i5)') 'dndraft -- n, kbase, ktop, ktaus', & - n, kdndraftbase(n), kdndrafttop(n), nstep, nstep_pp - do k = pver+1, 1, -1 - jcls = 1 + nupdraft + n - write(lun134,'(i3,2(2x,2f10.5))') k, & - sum(abnd_3d(i,k,1,jcls,1:2))*100.0_r8, sum(abnd_3d(i,k,2,jcls,1:2))*100.0_r8, & - sum(massflxbnd_3d(i,k,1,jcls,1:2))*100.0_r8, & - sum(massflxbnd_3d(i,k,2,jcls,1:2))*100.0_r8 - end do - end do - end if ! (lun134 > 0) - - - if (lun135 > 0) then - itmpcnt(:,:) = 0 - do n = 1, nupdraft - write(lun135,'(/a,5i5)') 'updraft -- n, kbase, ktop, ktaus', & - n, kupdraftbase(n), kupdrafttop(n), nstep, nstep_pp - do k = pver+1, 1, -1 - jcls = 1 + n - tmpa = sum(abnd_3d(i,k,1,jcls,1:2)) - tmpb = sum(abnd_3d(i,k,2,jcls,1:2)) - tmpc = sum(massflxbnd_3d(i,k,1,jcls,1:2)) - tmpd = sum(massflxbnd_3d(i,k,2,jcls,1:2)) - write(lun135,'(i3,2(2x,1p,2e10.2))') k, tmpa, tmpb, tmpc, tmpd - if (tmpa .gt. 0.0_r8) itmpcnt(k,1) = itmpcnt(k,1) + 1 - if (tmpb .gt. 0.0_r8) itmpcnt(k,2) = itmpcnt(k,2) + 1 - if (tmpc .gt. 0.0_r8) itmpcnt(k,3) = itmpcnt(k,3) + 1 - if (tmpd .gt. 0.0_r8) itmpcnt(k,4) = itmpcnt(k,4) + 1 - end do - end do - write(lun135,'(/a,5i5)') 'updraft non-zero counts -- ktaus', & - nstep, nstep_pp - do k = pver+1, 1, -1 - write(lun135,'(i3,2(5x,2i5))') k, itmpcnt(k,1:4) - end do - - itmpcnt(:,:) = 0 - do n = 1, ndndraft - write(lun135,'(/a,5i5)') 'dndraft -- n, kbase, ktop, ktaus', & - n, kdndraftbase(n), kdndrafttop(n), nstep, nstep_pp - do k = pver+1, 1, -1 - jcls = 1 + nupdraft + n - tmpa = sum(abnd_3d(i,k,1,jcls,1:2)) - tmpb = sum(abnd_3d(i,k,2,jcls,1:2)) - tmpc = sum(massflxbnd_3d(i,k,1,jcls,1:2)) - tmpd = sum(massflxbnd_3d(i,k,2,jcls,1:2)) - write(lun135,'(i3,2(2x,1p,2e10.2))') k, tmpa, tmpb, tmpc, tmpd - if (tmpa .gt. 0.0_r8) itmpcnt(k,1) = itmpcnt(k,1) + 1 - if (tmpb .gt. 0.0_r8) itmpcnt(k,2) = itmpcnt(k,2) + 1 - if (tmpc .lt. 0.0_r8) itmpcnt(k,3) = itmpcnt(k,3) + 1 - if (tmpd .lt. 0.0_r8) itmpcnt(k,4) = itmpcnt(k,4) + 1 - end do - end do - write(lun135,'(/a,5i5)') 'dndraft non-zero counts -- ktaus', & - nstep, nstep_pp - do k = pver+1, 1, -1 - write(lun135,'(i3,2(5x,2i5))') k, itmpcnt(k,1:4) - end do - end if ! (lun135 > 0) -! end of temporary diagnostics ------------------------------ - -! -! do parameterized pollutant calculations on current column -! - itmpa = parampollu_opt - - if ((itmpa == 2220) .or. & - (itmpa == 2223)) then - if (lun60 > 0) write(lun60,93010) & - 'calling parampollu_td240clm - i=', i -! write (0, *) i, lchnk, 'before parampollu_td240clm', nstep - call parampollu_td240clm( & - nstep, dtstep, nstep_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, zbnd, wbnd_bar, & - chem_bar, & - ncls_ecpp, & - kdraft_bot_ecpp, kdraft_top_ecpp, & - mtype_updnenv_ecpp, & - mfbnd, & - abnd_tavg, acen_tavg, acen_tfin, acen_tbeg, & - acen_prec, rh_sub2, & - qcloud_sub2, qlsink_sub2, precr_sub2, precs_sub2, & - del_cldchem, del_rename, & - del_wetscav, del_wetresu, & - del_activate, del_conv, & - del_chem_col_cldchem(i,:), del_chem_col_rename(i, :), del_chem_col_wetscav(i, :), & - aqso4_h2o2(i), aqso4_o3(i), xphlwc, & - i, lchnk, 1,pver+1,pver, pbuf & - ) -! write (0, *) i, lchnk, 'after parampollu_td240clm', nstep - - aqso4_h2o2(i) = aqso4_h2o2(i)/dtstep - aqso4_o3(i) = aqso4_o3(i)/dtstep - - else - end if - - -! -! put selected arrays back into 3d arrays -! - if (itmpa > 0) then - - do k = 1, pver - lk=pver-k+1 - acldy_cen_tbeg_3d(i,k) = sum( acen_tfin(lk,2,1:ncls_ecpp) ) - end do - -! Interstial species - ptend_qqcw(i,:,:) = 0.0_r8 - do k=1, pver - lk=pver-k+1 - do ichem=param_first_ecpp, pcnst - if (ptend%lq(ichem)) then - ptend%q(i,k,ichem)= (chem_bar(lk, ichem)-state%q(i,k,ichem))/dtstep - end if -! ptend_qqcw(i,k,ichem)=(chem_bar(lk, ichem+pcnst)-qqcw(i,k,ichem))/dtstep -! qqcw(i,k,ichem) = chem_bar(lk, ichem+pcnst) - if(associated(qqcw(ichem)%fldcw)) then - ptend_qqcw(i,k,ichem)=(chem_bar(lk, ichem+pcnst)-qqcw(ichem)%fldcw(i,k))/dtstep - qqcw(ichem)%fldcw(i,k) = chem_bar(lk, ichem+pcnst) - else - ptend_qqcw(i,k,ichem)= 0.0_r8 - endif - end do - del_cldchem3d(i,k,:,:,:,:) = del_cldchem(lk,:,:,:,:)/dtstep - del_rename3d(i,k,:,:,:,:) = del_rename(lk,:,:,:,:)/dtstep - del_wetscav3d(i,k,:,:,:,:) = del_wetscav(lk,:,:,:,:)/dtstep - del_wetresu3d(i,k,:,:,:,:) = del_wetresu(lk,:,:,:,:)/dtstep - del_activate3d(i,k,:,:,:) = del_activate(lk,:,:,:)/dtstep - del_conv3d(i,k,:,:,:) = del_conv(lk,:,:,:)/dtstep - xphlwc3d(i,k,:,:,:) = xphlwc(lk,:,:,:) - end do -! cloud borne species - - end if - -2910 continue - - - ptend_cldchem = 0.0_r8 - ptend_rename = 0.0_r8 - ptend_wetscav = 0.0_r8 - ptend_wetresu = 0.0_r8 - ptend_activate=0.0_r8 - ptend_conv = 0.0_r8 - xphlwc_gcm = 0.0_r8 - - ptend_cldchem_cls = 0.0_r8 - ptend_rename_cls = 0.0_r8 - ptend_wetscav_cls = 0.0_r8 - ptend_wetresu_cls = 0.0_r8 - ptend_activate_cls=0.0_r8 - ptend_conv_cls = 0.0_r8 - - ptend_cldchem_col = 0.0_r8 - ptend_rename_col = 0.0_r8 - ptend_wetscav_col = 0.0_r8 - ptend_wetresu_col = 0.0_r8 - ptend_activate_col=0.0_r8 - ptend_conv_col = 0.0_r8 - ptendq_col = 0.0_r8 - - ptend_cldchem_cls_col = 0.0_r8 - ptend_rename_cls_col = 0.0_r8 - ptend_wetscav_cls_col = 0.0_r8 - ptend_wetresu_cls_col = 0.0_r8 - ptend_activate_cls_col=0.0_r8 - ptend_conv_cls_col = 0.0_r8 - - do i=1, ncol - do k=1, pver - do jcls = 1, ncls_ecpp - do icc = 1, 2 -! tendency at GCM grids - do ipp=1, 2 - ptend_cldchem(i,k,:) = ptend_cldchem(i,k,:)+del_cldchem3d(i,k,icc,jcls,ipp,:) - ptend_rename(i,k,:) = ptend_rename(i,k,:)+del_rename3d(i,k,icc,jcls,ipp,:) - ptend_wetscav(i,k,:) = ptend_wetscav(i,k,:)+del_wetscav3d(i,k,icc,jcls,ipp,:) - ptend_wetresu(i,k,:) = ptend_wetresu(i,k,:)+del_wetresu3d(i,k,icc,jcls,ipp,:) - xphlwc_gcm(i,k) = xphlwc_gcm(i,k) + xphlwc3d(i,k,icc,jcls,ipp) -! tendency at each transport class: - ptend_cldchem_cls(i,k,jcls,:) = ptend_cldchem_cls(i,k,jcls,:)+del_cldchem3d(i,k,icc,jcls,ipp,:) - ptend_rename_cls(i,k,jcls,:) = ptend_rename_cls(i,k,jcls,:)+del_rename3d(i,k,icc,jcls,ipp,:) - ptend_wetscav_cls(i,k,jcls,:) = ptend_wetscav_cls(i,k,jcls,:)+del_wetscav3d(i,k,icc,jcls,ipp,:) - ptend_wetresu_cls(i,k,jcls,:) = ptend_wetresu_cls(i,k,jcls,:)+del_wetresu3d(i,k,icc,jcls,ipp,:) - end do - - ptend_activate(i,k,:) = ptend_activate(i,k,:)+del_activate3d(i,k,icc,jcls,:) - ptend_activate_cls(i,k,jcls, :) = ptend_activate_cls(i,k,jcls, :) + del_activate3d(i,k,icc,jcls,:) - ptend_conv(i,k,:) = ptend_conv(i,k,:)+del_conv3d(i,k,icc,jcls,:) - ptend_conv_cls(i,k,jcls,:) = ptend_conv_cls(i,k,jcls,:)+del_conv3d(i,k,icc,jcls,:) - end do ! end icc - end do ! end jcls - -! column-integrated tendency - ptend_cldchem_col(i,:) = ptend_cldchem_col(i,:)+ptend_cldchem(i,k,:)*state%pdeldry(i,k)/gravit - ptend_rename_col(i,:) = ptend_rename_col(i,:)+ptend_rename(i,k,:)*state%pdeldry(i,k)/gravit - ptend_wetscav_col(i,:) = ptend_wetscav_col(i,:)+ptend_wetscav(i,k,:)*state%pdeldry(i,k)/gravit - ptend_wetresu_col(i,:) = ptend_wetresu_col(i,:)+ptend_wetresu(i,k,:)*state%pdeldry(i,k)/gravit - ptend_activate_col(i,:) = ptend_activate_col(i,:)+ptend_activate(i,k,:)*state%pdeldry(i,k)/gravit - ptend_conv_col(i,:) = ptend_conv_col(i,:)+ptend_conv(i,k,:)*state%pdeldry(i,k)/gravit - - ptend_cldchem_cls_col(i,:,:) = ptend_cldchem_cls_col(i,:,:)+ptend_cldchem_cls(i,k,:,:)*state%pdeldry(i,k)/gravit - ptend_rename_cls_col(i,:,:) = ptend_rename_cls_col(i,:,:)+ptend_rename_cls(i,k,:,:)*state%pdeldry(i,k)/gravit - ptend_wetscav_cls_col(i,:,:) = ptend_wetscav_cls_col(i,:,:)+ptend_wetscav_cls(i,k,:,:)*state%pdeldry(i,k)/gravit - ptend_wetresu_cls_col(i,:,:) = ptend_wetresu_cls_col(i,:,:)+ptend_wetresu_cls(i,k,:,:)*state%pdeldry(i,k)/gravit - ptend_activate_cls_col(i,:,:) = ptend_activate_cls_col(i,:,:)+ptend_activate_cls(i,k,:,:)*state%pdeldry(i,k)/gravit - ptend_conv_cls_col(i,:,:) = ptend_conv_cls_col(i,:,:)+ptend_conv_cls(i,k,:,:)*state%pdeldry(i,k)/gravit - - - ptendq_col(i,param_first_ecpp:pcnst) = ptendq_col(i,param_first_ecpp:pcnst)+ & - ptend%q(i,k,param_first_ecpp:pcnst)*state%pdeldry(i,k)/gravit - ptendq_col(i,param_first_ecpp+pcnst:pcnst+pcnst) = ptendq_col(i,param_first_ecpp+pcnst:pcnst+pcnst)+ & - ptend_qqcw(i,k,param_first_ecpp:pcnst)*state%pdeldry(i,k)/gravit - end do - end do - - do ichem=param_first_ecpp, pcnst - if ((cnst_species_class(ichem) == cnst_spec_class_aerosol) .or. & - (cnst_species_class(ichem) == cnst_spec_class_gas )) then - call outfld(trim(cnst_name(ichem))//'EP', ptend%q(:,:,ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'ACHEM_EP', ptend_cldchem(:,:,ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'RENM_EP', ptend_rename(:,:,ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'ACT_EP', ptend_activate(:,:,ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'WET_EP', ptend_wetscav(:,:,ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'WRESU_EP', ptend_wetresu(:,:,ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'CONV_EP', ptend_conv(:,:,ichem), pcols, lchnk) - - call outfld(trim(cnst_name(ichem))//'SFEP', ptendq_col(:,ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFACHEM_EP', ptend_cldchem_col(:,ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFRENM_EP', ptend_rename_col(:,ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFACT_EP', ptend_activate_col(:,ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFWET_EP', ptend_wetscav_col(:,ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFWRESU_EP', ptend_wetresu_col(:,ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFCONV_EP', ptend_conv_col(:,ichem), pcols, lchnk) - - call outfld(trim(cnst_name(ichem))//'SFACHQU_EP', ptend_cldchem_cls_col(:,1, ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFACHUP_EP', ptend_cldchem_cls_col(:,2, ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFACHDN_EP', ptend_cldchem_cls_col(:,3, ichem), pcols, lchnk) - - call outfld(trim(cnst_name(ichem))//'SFREMQU_EP', ptend_rename_cls_col(:,1, ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFREMUP_EP', ptend_rename_cls_col(:,2, ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFREMDN_EP', ptend_rename_cls_col(:,3, ichem), pcols, lchnk) - - call outfld(trim(cnst_name(ichem))//'SFACTQU_EP', ptend_activate_cls_col(:,1, ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFACTUP_EP', ptend_activate_cls_col(:,2, ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFACTDN_EP', ptend_activate_cls_col(:,3, ichem), pcols, lchnk) - - call outfld(trim(cnst_name(ichem))//'SFWETQU_EP', ptend_wetscav_cls_col(:,1, ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFWETUP_EP', ptend_wetscav_cls_col(:,2, ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFWETDN_EP', ptend_wetscav_cls_col(:,3, ichem), pcols, lchnk) - - call outfld(trim(cnst_name(ichem))//'SFRESQU_EP', ptend_wetresu_cls_col(:,1, ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFRESUP_EP', ptend_wetresu_cls_col(:,2, ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFRESDN_EP', ptend_wetresu_cls_col(:,3, ichem), pcols, lchnk) - - call outfld(trim(cnst_name(ichem))//'SFCONQU_EP', ptend_conv_cls_col(:,1, ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFCONUP_EP', ptend_conv_cls_col(:,2, ichem), pcols, lchnk) - call outfld(trim(cnst_name(ichem))//'SFCONDN_EP', ptend_conv_cls_col(:,3, ichem), pcols, lchnk) - end if - end do - - do ichem=param_first_ecpp, pcnst - ichem2=ichem+pcnst - if(.not. (cnst_name_cw(ichem) == ' ')) then - call outfld(trim(cnst_name_cw(ichem))//'EP', ptend_qqcw(:,:,ichem), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'ACHEM_EP', ptend_cldchem(:,:,ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'RENM_EP', ptend_rename(:,:,ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'ACT_EP', ptend_activate(:,:,ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'WET_EP', ptend_wetscav(:,:,ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'WRESU_EP', ptend_wetresu(:,:,ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'CONV_EP', ptend_conv(:,:,ichem2), pcols, lchnk) - - call outfld(trim(cnst_name_cw(ichem))//'SFEP', ptendq_col(:,ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFACHEM_EP', ptend_cldchem_col(:,ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFRENM_EP', ptend_rename_col(:,ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFACT_EP', ptend_activate_col(:,ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFWET_EP', ptend_wetscav_col(:,ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFWRESU_EP', ptend_wetresu_col(:,ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFCONV_EP', ptend_conv_col(:,ichem2), pcols, lchnk) - - call outfld(trim(cnst_name_cw(ichem))//'SFACTQU_EP', ptend_activate_cls_col(:,1, ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFACTUP_EP', ptend_activate_cls_col(:,2, ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFACTDN_EP', ptend_activate_cls_col(:,3, ichem2), pcols, lchnk) - - call outfld(trim(cnst_name_cw(ichem))//'SFACHQU_EP', ptend_cldchem_cls_col(:,1, ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFACHUP_EP', ptend_cldchem_cls_col(:,2, ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFACHDN_EP', ptend_cldchem_cls_col(:,3, ichem2), pcols, lchnk) - - call outfld(trim(cnst_name_cw(ichem))//'SFREMQU_EP', ptend_rename_cls_col(:,1, ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFREMUP_EP', ptend_rename_cls_col(:,2, ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFREMDN_EP', ptend_rename_cls_col(:,3, ichem2), pcols, lchnk) - - call outfld(trim(cnst_name_cw(ichem))//'SFWETQU_EP', ptend_wetscav_cls_col(:,1, ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFWETUP_EP', ptend_wetscav_cls_col(:,2, ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFWETDN_EP', ptend_wetscav_cls_col(:,3, ichem2), pcols, lchnk) - - call outfld(trim(cnst_name_cw(ichem))//'SFRESQU_EP', ptend_wetresu_cls_col(:,1, ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFRESUP_EP', ptend_wetresu_cls_col(:,2, ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFRESDN_EP', ptend_wetresu_cls_col(:,3, ichem2), pcols, lchnk) - - call outfld(trim(cnst_name_cw(ichem))//'SFCONQU_EP', ptend_conv_cls_col(:,1, ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFCONUP_EP', ptend_conv_cls_col(:,2, ichem2), pcols, lchnk) - call outfld(trim(cnst_name_cw(ichem))//'SFCONDN_EP', ptend_conv_cls_col(:,3, ichem2), pcols, lchnk) - - do i=1, ncol - do k=1, pver -! if(cnst_name_cw(ichem) == 'bc_c1') then -! if(abs(ptend_wetscav(i, k, ichem2)).gt.1.0e-16 .and. qqcwold(i, k, ichem).gt. 1.0e-13) then -! if(abs(ptend_conv(i, k, ichem2)).lt.1.0e-20 .and. abs(ptend_activate(i, k, ichem2)).lt.1.0e-20) then -! write(0, *) 'nstep, ecpp wet, qqcw', nstep, qqcwold(i, k, ichem), qqcw(i,k,ichem), state%q(i, k, ichem), & -! ptend_wetscav(i, k, ichem2)*1800, ptend_wetscav(i, k, ichem2)*86400/qqcwold(i, k, ichem) -! write(0, *) 'ecpp acen', acen_3d(i, k,2,1:ncls_ecpp,1), acen_3d(i, k,2,1:ncls_ecpp,2) -! write(0, *) 'ecpp qlsink' , qlsinkcen_3d(i, k,2,1:ncls_ecpp,1)*86400, qlsinkcen_3d(i, k,2,1:ncls_ecpp,2)*86400 -! write(0, *) 'ecpp wetscav', del_wetscav3d(i,k,2,1:ncls_ecpp,1, ichem2)*1800, & -! del_wetscav3d(i,k,2,1:ncls_ecpp,2, ichem2)*1800 - -! call endrun('ptend_conv error') -! end if -! end if -! if(abs(ptend_conv_col(i, ichem2)).gt.1.0e-15) then -! write(0, *) 'ptend_conv error', ptend_wetresu_col(i,ichem2)+ptend_wetscav_col(i,ichem2), & -! ptend_cldchem_col(i,ichem2), ptend_activate_col(i,ichem2), ptend_conv_col(i,ichem2), & -! ptendq_col(i,ichem2) -! write(0, *) 'ptend_conv error2' , del_chem_col_wetscav(i, ichem2)/dtstep, del_chem_col_cldchem(i,ichem2)/dtstep -! write(0, *) 'ptend_conv error3' , ptendq_col(i,ichem2), & -! ptend_wetresu_col(i,ichem2)+ptend_wetscav_col(i,ichem2) & -! +ptend_cldchem_col(i,ichem2)+ptend_activate_col(i,ichem2), & -! del_chem_col_wetscav(i, ichem2)/dtstep+ptend_cldchem_col(i,ichem2)+ptend_activate_col(i,ichem2) -! call endrun('ptend_conv error') -! end if -! end if - end do - end do - end if - end do - - call outfld('AQSO4_H2O2_EP', aqso4_h2o2, pcols, lchnk) - call outfld('AQSO4_O3_EP', aqso4_o3, pcols, lchnk) - call outfld('XPH_LWC_EP', xphlwc_gcm, pcols, lchnk) - -! -! qqcw is updated above, and q is upated in tphysbc -! - - return - end subroutine parampollu_driver2 -!------------------------------------------------------------------------- - -!------------------------------------------------------------------------- -end module module_ecpp_ppdriver2 diff --git a/src/physics/spcam/ecpp/module_ecpp_td2clm.F90 b/src/physics/spcam/ecpp/module_ecpp_td2clm.F90 deleted file mode 100644 index 2e2d9e43a2..0000000000 --- a/src/physics/spcam/ecpp/module_ecpp_td2clm.F90 +++ /dev/null @@ -1,5149 +0,0 @@ - module module_ecpp_td2clm - - use ecpp_modal_aero_activate, only: parampollu_tdx_activate1 - use ecpp_modal_cloudchem, only: parampollu_tdx_cldchem - use ecpp_modal_wetscav, only: parampollu_tdx_wetscav_2 - use perf_mod - use cam_abortutils, only: endrun - use physics_buffer, only : physics_buffer_desc - use shr_kind_mod, only : r8 => shr_kind_r8 - - implicit none - - - integer, parameter :: jgrp_up=2, jgrp_dn=3 - - - contains - -!----------------------------------------------------------------------- -! -! rce 2005-mar-10 - created -! -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- - subroutine parampollu_td240clm( & - ktau, dtstep, ktau_pp_in, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, zbnd, wbnd_bar, & - chem_bar, & - ncls_ecpp, & - kdraft_bot_ecpp, kdraft_top_ecpp, & - mtype_updnenv_ecpp, & - mfbnd_ecpp, & - abnd_tavg_ecpp, acen_tavg_ecpp, & - acen_tfin_ecpp, acen_tbeg_ecpp, acen_prec_ecpp, & - rh_sub2, qcloud_sub2, qlsink_sub2, & - precr_sub2, precs_sub2, & - del_cldchem3d, del_rename3d, & - del_wetscav3d, del_wetresu3d, & - del_activate3d, del_conv3d, & - del_chem_clm_cldchem, del_chem_clm_rename, del_chem_clm_wetscav, & - aqso4_h2o2, aqso4_o3, xphlwc3d, & - it, jt, kts,ktebnd,ktecen, pbuf ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_td240clm is a top level routine for doing -! ecpp parameterized pollutants calculations on a single column -! of the host-code grid -! -! this version uses the hybrid time-dependent up/dndraft formulation -! the up and dndrafts are time-dependent, rather than steady state, -! with a lifetime equal "draft_lifetime" -! in the hybrid formulation, the host-code column is conceptually -! divided into ntstep_hybrid == (draft_lifetime/dtstep_pp) pieces -! time integrations over dtstep_pp are done for each piece, sequentially -! the up and downdrafts start "fresh" in the first piece -! at the end of each "piece integration", the up and downdrafts are -! shifted into the next piece -! the the drafts evolve over time = draft_lifetime, but different -! pieces of the environment are affected by different aged drafts -! the hybrid approach avoids two problems of the original time-dependent -! up/dndraft formulation: -! (a) having to store draft information (specifically aerosol mixing -! ratios in the drafts sub-classes) from one host-code time-step to -! the next -! (b) having to determine when drafts should be re-initialized -! -!----------------------------------------------------------------------- - - - use module_data_mosaic_asect, only: ai_phase, cw_phase, nphase_aer - - use module_data_ecpp1 - - use module_data_mosaic_asect, only: is_aerosol, iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & - inmw_of_aerosol, laicwpair_of_aerosol - - use module_ecpp_util, only: ecpp_error_fatal, ecpp_message, & - parampollu_1clm_set_opts - - use cam_abortutils, only: endrun - -! arguments - integer, intent(in) :: & - ktau, ktau_pp_in, & - it, jt, kts, ktebnd, ktecen -! ktau - time step number -! ktau_pp_in - time step number for "parameterized pollutants" calculations -! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" -! chem_driver and routines under it do calculations -! over these spatial indices. - - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) -! these control diagnostic output - - real(r8), intent(in) :: dtstep, dtstep_pp -! dtstep - main model time step (s) -! dtstep_pp - time step (s) for "parameterized pollutants" calculations - - real(r8), intent(in), dimension( kts:ktecen ) :: & - tcen_bar, pcen_bar, rhocen_bar, dzcen - real(r8), intent(in), dimension( kts:ktebnd ) :: & - rhobnd_bar, wbnd_bar, zbnd -! tcen_bar - temperature (K) at layer centers -! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries -! pcen_bar - air pressure (Pa) at layer centers -! wbnd_bar - vertical velocity (m/s) at layer boundaries -! zbnd - elevation (m) at layer boundaries -! dzcen - layer thicknesses (m) - - real(r8), intent(inout), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & - chem_bar -! chem_bar - mixing ratios of trace gase (ppm) and aerosol species -! (ug/kg for mass species, #/kg for number species) - -! NOTE - tcen_bar through chem_bar are all grid-cell averages -! (on the host-code grid) - - integer, intent(in) :: ncls_ecpp -! ncls_ecpp - number of ecpp transport classes in the grid column - - integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & - kdraft_bot_ecpp, kdraft_top_ecpp, & - mtype_updnenv_ecpp -! kdraft_bot_ecpp = lowest layer in/thru which sub-area transport occurs -! = lowest layer for which massflux != 0 at layer upper boundary -! OR areafrac != 0 at layer center -! >= kts -! kdraft_top_ecpp = highest layer in/thru which sub-area transport occurs -! = highest layer for which massflux != 0 at layer lower boundary -! OR areafrac != 0 at layer center -! <= kte-1 -! mtype_updnenv_ecpp - transport-class (updraft, downdraft, or quiescent) - - real(r8), intent(in), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & - abnd_tavg_ecpp, mfbnd_ecpp -! real(r8), intent(in), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & -! acen_tavg_ecpp, acen_tbeg_ecpp, acen_prec_ecpp - real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - acen_tavg_ecpp, acen_tbeg_ecpp, acen_prec_ecpp - real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - acen_tfin_ecpp -! abnd_tavg_ecpp - sub-class fractional area (--) at layer bottom boundary -! acen_tavg_ecpp, acen_tbeg_ecpp, acen_tfin_ecpp - sub-class fractional area (--) -! at layer centers -! _tavg_ is average for full time period (=dtstep_pp_in) -! _tbeg_ is average at beginning of time period -! _tfin_ is average for end-portion of time period -! acen_prec_ecpp - fractional area (---) of the portion of a sub-class that -! has precipitation -! 0 <= acen_prec_ecpp(:,:,:)/acen_tavg_ecpp(:,:,:) <= 1 -! mfbnd_ecpp - sub-class vertical mass flux (kg/m2/s) at layer bottom boundary. -! -! NOTE 1 - these 6 xxx_ecpp arrays contain statistics from the crm -! post-processor or interface. -! Each array has a xxx_use array that contains "checked and adjusted values", -! and those values are the ones that are used. -! NOTE 2 - indexing for these arrays -! the first index is vertical layer -! the second index (0:2): 1=clear, 2=cloudy, and 0=clear+cloudy combined -! the third index is transport class - - real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - rh_sub2, qcloud_sub2, qlsink_sub2, precr_sub2, precs_sub2 -! rh_sub2 - relative humidity (0-1) at layer center -! qcloud_sub2 - cloud water mixing ratio (kg/kg) at layer center -! qlsink_sub2 - cloud-water first-order loss rate to precipitation (kg/kg/s) at layer center -! precr_sub2 - liquid (rain) precipitation rate (kg/m2/s) at layer center -! precsolid_sub2 - solid (snow,graupel,...) precipitation rate (kg/m2/s) at layer center -! -! NOTE - indexing for these arrays -! the first index is vertical layer -! the second index (0:2) is: 1=clear, 2=cloudy -! the third index is transport class -! the fourth index (0:2) is: 1=non-precipitating, 2=precipitating - - real(r8), intent(out), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & - del_cldchem3d, & ! 3D change in chem_sub from aqueous chemistry - del_rename3d, & ! 3D change in chem_sub from renaming (modal merging) - del_wetscav3d, & ! 3D change in chem_sub from wet deposition - del_wetresu3d - - real(r8), intent(out), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - del_activate3d ! 3D change in chem_sub from activation/resuspension - - real(r8), intent(out), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - del_conv3d ! 3D change in chem_sub from convective transport - - real(r8), intent(out) :: aqso4_h2o2, & ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) - aqso4_o3 ! SO4 aqueous phase chemistry due to O3 (kg/m2) - - real(r8), intent(out), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2) :: & - xphlwc3d ! pH value multiplied by lwc - - real(r8), intent(out), dimension( 1:num_chem_ecpp ) :: del_chem_clm_cldchem, del_chem_clm_rename, del_chem_clm_wetscav - type(physics_buffer_desc), pointer :: pbuf(:) - -! local variables - integer :: activate_onoff_use - integer :: icc, iccy, idiag, & - ipass_area_change, ipass_check_adjust_inputs, & - itstep_hybrid - integer :: jcls, jclsbb, jgrp, jgrpbb - integer :: k, ktau_pp - integer :: l, laa, lbb, ll, lun, lun62 - integer :: ncls_use, ntstep_hybrid - - integer, dimension( 1:2, 1:maxcls_ecpp ) :: & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use - - real(r8) :: draft_area_fudge, draft_area_fudge_1m - real(r8) :: tmpa - real(r8) :: tmpd, tmpe, tmpf, tmpg, tmph - real(r8) :: tmpveca(100) - real(r8), save :: tmpvecsva(100), tmpvecsvb(100), tmpvecsvc(100) - - real(r8), dimension( kts:ktebnd ) :: wbnd_bar_use - - real(r8), dimension( kts:ktecen ) :: rhodz_cen - - real(r8), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & - abnd_tavg_use, mfbnd_use, & - abnd_tavg_usex1, mfbnd_usex1, & - ar_bnd_tavg - - real(r8), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - acen_tavg_usex1, acen_tbeg_usex1, acen_tfin_usex1, & - acen_tavg_use, acen_tbeg_use, acen_tfin_use, acen_prec_use, & - ardz_cen_tbeg, ardz_cen_tfin, & - ardz_cen_tavg, & - ardz_cen_old, ardz_cen_new - - real(r8), dimension( kts:ktebnd, 0:2, 0:2 ) :: & - mfbnd_quiescn_up, mfbnd_quiescn_dn - - real(r8), dimension( kts:ktecen, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_cls - - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_sub_new, chem_sub_beg, chem_sub_ac1sv, chem_sub_hysum - - real(r8), dimension( 1:2, num_chem_ecpp ) :: chem_bar_iccfactor - - real(r8), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - del_activate3da ! 3D change in chem_sub from activation/resuspension - - - - character(len=120) :: msg - - - ktau_pp = 10 - - lun62 = -1 - if (idiagaa_ecpp(62) > 0) lun62 = ldiagaa_ecpp(62) - - activate_onoff_use = 0 - if ( (nphase_aer >= 2) .and. & - (ai_phase > 0) .and. (cw_phase > 0) ) & - activate_onoff_use = activat_onoff_ecpp - -! in sub-classes with area ~= 0, chem_sub is set to chem_bar -! EXCEPT for aerosol species, where activated=0 in clear, -! and activated=interstitial=0.5*chem_bar in cloudy - chem_bar_iccfactor(:,:) = 1.0_r8 - if (activate_onoff_use > 0) then - do l = param_first_ecpp, num_chem_ecpp - if ( is_aerosol(l) ) then - if (iphase_of_aerosol(l) == ai_phase) then - chem_bar_iccfactor(2,l) = 1.0_r8 - else if (iphase_of_aerosol(l) == cw_phase) then - chem_bar_iccfactor(2,l) = 1.0_r8 - chem_bar_iccfactor(1,l) = 1.0_r8 - end if - end if - end do - end if - -! -! output the original fields with same format as ppboxmakeinp01 -! - ll = 116 - lun = ldiagaa_ecpp(ll) - if ((idiagaa_ecpp(ll) > 0) .and. (lun > 0)) then - call parampollu_1clm_dumpaa( & - ktau, dtstep, ktau_pp, dtstep_pp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, zbnd, wbnd_bar, & - chem_bar, & - ncls_ecpp, & - kdraft_bot_ecpp, kdraft_top_ecpp, & - mtype_updnenv_ecpp, & - mfbnd_ecpp, abnd_tavg_ecpp, & - acen_tavg_ecpp, acen_tbeg_ecpp, acen_tfin_ecpp, & - it, jt, kts,ktebnd,ktecen, & - lun ) - end if - - -! -! check and adjust input information -! and do startup calcs (for this parampollu timestep) -! - do ipass_check_adjust_inputs = 1, 2 - - call parampollu_check_adjust_inputs( & - ipass_check_adjust_inputs, & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, zbnd, wbnd_bar, & - chem_bar, & - ncls_ecpp, & - kdraft_bot_ecpp, kdraft_top_ecpp, & - mtype_updnenv_ecpp, & - mfbnd_ecpp, abnd_tavg_ecpp, & - acen_tavg_ecpp, acen_tfin_ecpp, acen_prec_ecpp, & - wbnd_bar_use, & - ncls_use, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - mfbnd_use, mfbnd_quiescn_up, mfbnd_quiescn_dn, & - abnd_tavg_use, & - acen_tavg_use, acen_tfin_use, acen_prec_use, & - rhodz_cen, & - it, jt, kts,ktebnd,ktecen ) - -! do startup calcs (for this parampollu timestep) - if (ipass_check_adjust_inputs == 1) then - acen_tbeg_use(:,:,:) = acen_tbeg_ecpp(:,:,:) - else - call parampollu_tdx_startup( & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - rhocen_bar, dzcen, & - chem_bar, chem_cls, & - ncls_ecpp, & - acen_tbeg_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - chem_sub_beg, & - acen_tbeg_use, ardz_cen_tbeg, rhodz_cen, & - activate_onoff_use, & - iphase_of_aerosol, laicwpair_of_aerosol ) - end if - -! output the adjusted fields with same format as ppboxmakeinp01 - if (ipass_check_adjust_inputs == 1) then - acen_tavg_usex1(:,:,:) = acen_tavg_use(:,:,:) - acen_tfin_usex1(:,:,:) = acen_tfin_use(:,:,:) - abnd_tavg_usex1(:,:,:) = abnd_tavg_use(:,:,:) - mfbnd_usex1( :,:,:) = mfbnd_use( :,:,:) - ll = 117 - else - ll = 115 - end if - - lun = ldiagaa_ecpp(ll) - if ((idiagaa_ecpp(ll) > 0) .and. (lun > 0)) then - call parampollu_1clm_dumpaa( & - ktau, dtstep, ktau_pp, dtstep_pp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, zbnd, wbnd_bar_use, & - chem_bar, & - ncls_use, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - mfbnd_use, abnd_tavg_use, & - acen_tavg_use, acen_tbeg_use, acen_tfin_use, & - it, jt, kts,ktebnd,ktecen, & - lun ) - end if - - end do ! ipass_check_adjust_inputs - - - -! *** temporary exit - if (iflag_ecpp_test_bypass_1 > 0) return - - -! save values in these arrays - acen_tbeg_usex1(:,:,:) = acen_tbeg_use(:,:,:) - chem_sub_new(:,:,:,:) = chem_sub_beg(:,:,:,:) - - del_activate3d(:,:,:,:) = 0.0_r8 - -! calc "area*rho*dz" and "area*rho" arrays - ardz_cen_tavg(:,:,:) = 0.0_r8 - ardz_cen_tfin(:,:,:) = 0.0_r8 - ar_bnd_tavg(:,:,:) = 0.0_r8 - do k = kts, ktebnd - do icc = 0, 2 - ar_bnd_tavg( k,icc,0:ncls_use) = abnd_tavg_use(k,icc,0:ncls_use)*rhobnd_bar(k) - if (k > ktecen) cycle - ardz_cen_tavg(k,icc,0:ncls_use) = acen_tavg_use(k,icc,0:ncls_use)*rhodz_cen(k) - ardz_cen_tfin(k,icc,0:ncls_use) = acen_tfin_use(k,icc,0:ncls_use)*rhodz_cen(k) - end do - end do - - -! -! apply area changes (acen_tbeg_use --> ... --> acen_tfin_use) here -! parampollu_opt == 2220 -! apply area changes in one step, before 15000 loop -! parampollu_opt == 2223 -! apply area changes in two steps, before and after 15000 loop -! - ardz_cen_old(:,:,:) = ardz_cen_tbeg(:,:,:) - if (parampollu_opt == 2220) then - ardz_cen_new(:,:,:) = ardz_cen_tfin(:,:,:) - else if (parampollu_opt == 2223) then - ardz_cen_new(:,:,:) = ardz_cen_tavg(:,:,:) - else - stop - end if - -! note about parampollu_tdx_area_change and parampollu_tdx_main_integ -! initial values are taken from chem_sub_new -! final values are put into chem_sub_new - ipass_area_change = 1 - call parampollu_tdx_area_change( & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, wbnd_bar, & - chem_bar, & - ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, ipass_area_change, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - chem_sub_new, & - del_activate3d, & - mfbnd_use, ar_bnd_tavg, & - ardz_cen_old, ardz_cen_new, rhodz_cen, & - chem_bar_iccfactor, activate_onoff_use, & - iphase_of_aerosol, isize_of_aerosol, & - itype_of_aerosol, inmw_of_aerosol, & - laicwpair_of_aerosol ) - - - -! save current chem_sub values - chem_sub_ac1sv(:,:,:,:) = 0.0_r8 - chem_sub_ac1sv(kts:ktecen,1:2,1:ncls_use,1:num_chem_ecpp) = & - chem_sub_new(kts:ktecen,1:2,1:ncls_use,1:num_chem_ecpp) -! initialize chem_sub hybrid-sum - chem_sub_hysum(:,:,:,:) = 0.0_r8 - - ntstep_hybrid = nint( draft_lifetime / dtstep ) - ntstep_hybrid = max( 1, ntstep_hybrid ) - if (lun62 > 0) write(lun62,'(a,2i10)') & - 'parampollu_td240clm - ktau, ntstep_hybrid', & - ktau, ntstep_hybrid - - - del_chem_clm_cldchem(:) = 0.0_r8 - del_chem_clm_rename(:) = 0.0_r8 - del_cldchem3d(:,:,:,:,:) = 0.0_r8 - del_rename3d(:,:,:,:,:) = 0.0_r8 - del_chem_clm_wetscav(:) = 0.0_r8 - del_wetscav3d(:,:,:,:,:) = 0.0_r8 - del_wetresu3d(:,:,:,:,:) = 0.0_r8 - del_activate3da(:,:,:,:) = 0.0_r8 - - aqso4_h2o2 = 0.0_r8 - aqso4_o3 = 0.0_r8 - xphlwc3d(:,:,:,:) = 0.0_r8 - -itstep_hybrid_loop: & - do itstep_hybrid = 1, ntstep_hybrid - ktau_pp = itstep_hybrid + 100 - -! -! main integration -! - ardz_cen_old(:,:,:) = ardz_cen_new(:,:,:) - - call parampollu_tdx_main_integ( & - ktau, dtstep, ktau_pp, dtstep_pp, & - itstep_hybrid, ntstep_hybrid, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, zbnd, wbnd_bar, & - chem_bar, & - ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - chem_sub_new, & - del_chem_clm_cldchem, del_chem_clm_rename, del_chem_clm_wetscav, & - del_cldchem3d, del_rename3d, & - del_wetscav3d, del_wetresu3d, & - del_activate3da, & - aqso4_h2o2, aqso4_o3, xphlwc3d, & - mfbnd_use, mfbnd_quiescn_up, mfbnd_quiescn_dn, & - ar_bnd_tavg, & - ardz_cen_old, ardz_cen_new, rhodz_cen, & - acen_tavg_use, acen_prec_use, & - rh_sub2, qcloud_sub2, qlsink_sub2, & - precr_sub2, precs_sub2, & - chem_bar_iccfactor, activate_onoff_use, & - iphase_of_aerosol, isize_of_aerosol, & - itype_of_aerosol, inmw_of_aerosol, & - laicwpair_of_aerosol, pbuf ) - - - do l = param_first_ecpp, num_chem_ecpp - do jcls = 1, ncls_use -! increment chem_sub_hysum - if ((jcls == jcls_qu) .or. (itstep_hybrid == ntstep_hybrid)) then -! for quiescent (all steps) or up/dndrafts (final step), use chem_sub_new - chem_sub_hysum(kts:ktecen,1:2,jcls,l) = & - chem_sub_hysum(kts:ktecen,1:2,jcls,l) + & - chem_sub_new(kts:ktecen,1:2,jcls,l) - else -! for up/dndrafts (all but final step), use chem_sub_ac1sv - chem_sub_hysum(kts:ktecen,1:2,jcls,l) = & - chem_sub_hysum(kts:ktecen,1:2,jcls,l) + & - chem_sub_ac1sv(kts:ktecen,1:2,jcls,l) - end if - -! on all but final step, prepare for next main_integ by -! restoring jcls_qu to chem_sub_ac1sv values - if ((jcls == jcls_qu) .and. (itstep_hybrid < ntstep_hybrid)) then - chem_sub_new( kts:ktecen,1:2,jcls,l) = & - chem_sub_ac1sv(kts:ktecen,1:2,jcls,l) - end if - -! on (after) final step, convert chem_sub_hysum to an average -! and load into chem_sub_new - if (itstep_hybrid == ntstep_hybrid) then - tmpa = 1.0_r8/ntstep_hybrid - chem_sub_new( kts:ktecen,1:2,jcls,l) = & - chem_sub_hysum(kts:ktecen,1:2,jcls,l)*tmpa - end if - - end do ! jcls - end do ! l - - - end do itstep_hybrid_loop - - tmpa = ntstep_hybrid ; tmpa = 1.0_r8/tmpa - del_chem_clm_cldchem(:) = del_chem_clm_cldchem(:)*tmpa - del_chem_clm_rename(:) = del_chem_clm_rename(:)*tmpa - del_cldchem3d(:,:,:,:,:) = del_cldchem3d(:,:,:,:,:) * tmpa - del_rename3d(:,:,:,:,:) = del_rename3d(:,:,:,:,:) * tmpa - del_chem_clm_wetscav(:) = del_chem_clm_wetscav(:)*tmpa - del_wetscav3d(:,:,:,:,:) = del_wetscav3d(:,:,:,:,:)*tmpa - del_wetresu3d(:,:,:,:,:) = del_wetresu3d(:,:,:,:,:)*tmpa - del_activate3d(:,:,:,:) = del_activate3d(:,:,:,:) + del_activate3da(:,:,:,:) * tmpa - - aqso4_h2o2 = aqso4_h2o2 * tmpa - aqso4_o3 = aqso4_o3 * tmpa - xphlwc3d(:,:,:,:) = xphlwc3d(:,:,:,:) * tmpa - - - ktau_pp = 20 - - -! when parampollu_opt == 2223, do 2nd half of area change here - if (parampollu_opt == 2223) then - ipass_area_change = 2 - ardz_cen_old(:,:,:) = ardz_cen_new(:,:,:) - ardz_cen_new(:,:,:) = ardz_cen_tfin(:,:,:) - - call parampollu_tdx_area_change( & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, wbnd_bar, & - chem_bar, & - ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, ipass_area_change, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - chem_sub_new, & - del_activate3d, & - mfbnd_use, ar_bnd_tavg, & - ardz_cen_old, ardz_cen_new, rhodz_cen, & - chem_bar_iccfactor, activate_onoff_use, & - iphase_of_aerosol, isize_of_aerosol, & - itype_of_aerosol, inmw_of_aerosol, & - laicwpair_of_aerosol ) - - end if - - -! do "cleanup" - call parampollu_tdx_cleanup( & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - chem_bar, chem_cls, & - ncls_ecpp, & - acen_tfin_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - chem_sub_beg, chem_sub_new, & - del_chem_clm_cldchem, del_chem_clm_wetscav, & - del_cldchem3d, del_rename3d, & - del_wetscav3d, del_wetresu3d, & - del_activate3d, del_conv3d, & - acen_tbeg_use, acen_tfin_use, rhodz_cen, & - activate_onoff_use, & - iphase_of_aerosol, isize_of_aerosol, & - itype_of_aerosol, inmw_of_aerosol, & - laicwpair_of_aerosol ) - - -! output precip info -! - if (ktau <= 1) then - tmpvecsva(:) = 0.0_r8 ; tmpvecsvb(:) = 0.0_r8 ; tmpvecsvc(:) = 0.0_r8 - end if - tmpveca(:) = 0.0_r8 - do jcls = 1, ncls_use - do icc = 1, 2 - tmpe = max( 0.0_r8, acen_prec_use(kts,icc,jcls) ) - tmpf = max( 0.0_r8, acen_tavg_use(kts,icc,jcls) - tmpe ) - tmpg = max( 0.0_r8, precr_sub2(kts,icc,jcls,2) ) + & - max( 0.0_r8, precs_sub2(kts,icc,jcls,2) ) - tmph = max( 0.0_r8, precr_sub2(kts,icc,jcls,1) ) + & - max( 0.0_r8, precs_sub2(kts,icc,jcls,1) ) - tmpveca(1) = tmpveca(1) + tmpg - tmpveca(2) = tmpveca(2) + tmph - tmpveca(3) = tmpveca(3) + tmpg*tmpe - tmpveca(4) = tmpveca(4) + tmph*tmpf - do k = kts, ktecen - tmpe = max( 0.0_r8, acen_prec_use(k,icc,jcls) ) - tmpf = max( 0.0_r8, acen_tavg_use(k,icc,jcls) - tmpe ) - tmpg = max( 0.0_r8, precr_sub2(k,icc,jcls,2) ) + & - max( 0.0_r8, precs_sub2(k,icc,jcls,2) ) - tmph = max( 0.0_r8, precr_sub2(k,icc,jcls,1) ) + & - max( 0.0_r8, precs_sub2(k,icc,jcls,1) ) - tmpa = tmpg*tmpe + tmph*tmpf - end do - end do - end do - - if (mod(ktau,18) == 0 .and. ktau.ge.1) then - tmpa = 3600.0_r8/ktau ! converts accumulated precip to time avg and mm/h - end if - - if (mod(ktau,18) == 0 .and. ktau.ge.1) then - do k = kts, ktecen, 5 - tmpveca(:) = 0.0_r8 - do jcls = 1, ncls_use - do icc = 1, 2 - tmpe = max( 0.0_r8, acen_prec_use(k,icc,jcls) ) - tmpf = max( 0.0_r8, acen_tavg_use(k,icc,jcls) - tmpe ) - tmpveca(1) = tmpveca(1) + & - tmpe*max( 0.0_r8, rh_sub2(k,icc,jcls,2) ) + & - tmpf*max( 0.0_r8, rh_sub2(k,icc,jcls,1) ) - tmpveca(2) = tmpveca(2) + & - tmpe*max( 0.0_r8, precr_sub2(k,icc,jcls,2) ) + & - tmpf*max( 0.0_r8, precr_sub2(k,icc,jcls,1) ) - tmpveca(3) = tmpveca(3) + & - tmpe*max( 0.0_r8, precs_sub2(k,icc,jcls,2) ) + & - tmpf*max( 0.0_r8, precs_sub2(k,icc,jcls,1) ) - tmpveca(4) = tmpveca(4) + & - tmpe*max( 0.0_r8, qcloud_sub2(k,icc,jcls,2) ) + & - tmpf*max( 0.0_r8, qcloud_sub2(k,icc,jcls,1) ) - end do - end do - tmpveca(3) = tmpveca(3) + tmpveca(2) - end do - end if - -! -! all done -! - if (lun62 > 0) write(lun62,*) '*** leaving parampollu_td240clm' - return - end subroutine parampollu_td240clm - - - -!----------------------------------------------------------------------- - subroutine parampollu_tdx_main_integ( & - ktau, dtstep, ktau_pp, dtstep_pp, & - itstep_hybrid, ntstep_hybrid, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, zbnd, wbnd_bar, & - chem_bar, & - ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - chem_sub_new, & - del_chem_clm_cldchem, del_chem_clm_rename, del_chem_clm_wetscav, & - del_cldchem3d, del_rename3d, & - del_wetscav3d, del_wetresu3d, & - del_activate3d, & - aqso4_h2o2, aqso4_o3, xphlwc3d, & - mfbnd_use, mfbnd_quiescn_up, mfbnd_quiescn_dn, & - ar_bnd_tavg, & - ardz_cen_old, ardz_cen_new, rhodz_cen, & - acen_tavg_use, acen_prec_use, & - rh_sub2, qcloud_sub2, qlsink_sub2, & - precr_sub2, precs_sub2, & - chem_bar_iccfactor, activate_onoff_use, & - iphase_of_aerosol, isize_of_aerosol, & - itype_of_aerosol, inmw_of_aerosol, & - laicwpair_of_aerosol, pbuf ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_tdx_main_integ does the "main integration" -! of the trace-species conservation equations over time-step dtstep_pp -! -! incoming chem_sub_new holds current sub-class mixing ratios -! outgoing chem_sub_new holds updated sub-class mixing ratios -! -! treats -! sub-grid vertical transport and associated horizontal exchange -! (entrainment and detrainment) -! activation/resuspension -! cloud chemistry and wet removal -! -! does not treat -! horizontal exchange associated with sub-class area changes -! -!----------------------------------------------------------------------- - - use module_data_radm2, only: epsilc - - use module_data_mosaic_asect, only: ai_phase, cw_phase, & - massptr_aer, maxd_asize, maxd_atype, & - ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer - - use module_data_ecpp1 - - use module_ecpp_util, only: ecpp_error_fatal, ecpp_message - -! arguments - integer, intent(in) :: & - ktau, ktau_pp, & - itstep_hybrid, ntstep_hybrid, & - it, jt, kts, ktebnd, ktecen -! ktau - time step number -! ktau_pp - time step number for "parameterized pollutants" calculations -! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" -! chem_driver and routines under it do calculations -! over these spatial indices. - - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) - - real(r8), intent(in) :: dtstep, dtstep_pp -! dtstep - main model time step (s) -! dtstep_pp - time step (s) for "parameterized pollutants" calculations - - real(r8), intent(in), dimension( kts:ktecen ) :: & - tcen_bar, pcen_bar, rhocen_bar, dzcen - real(r8), intent(in), dimension( kts:ktebnd ) :: & - rhobnd_bar, wbnd_bar, zbnd -! tcen_bar - temperature (K) at layer centers -! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries -! pcen_bar - air pressure (Pa) at layer centers -! wbnd_bar - vertical velocity (m/s) at layer boundaries -! zbnd - elevation (m) at layer boundaries -! dzcen - layer thicknesses (m) - - real(r8), intent(in), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & - chem_bar -! chem_bar - mixing ratios of trace gase (ppm) and aerosol species -! (ug/kg for mass species, #/kg for number species) - - integer, intent(in) :: ncls_ecpp -! ncls_ecpp - number of ecpp transport classes in the grid column - - integer, intent(in) :: ncls_use - - integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use - - real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_sub_new - - real(r8), intent(inout), dimension( 1:num_chem_ecpp ) :: del_chem_clm_cldchem, del_chem_clm_rename, del_chem_clm_wetscav - - real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & - del_cldchem3d, & ! 3D change from aqueous chemistry - del_rename3d, & ! 3D change from renaming (modal merging) - del_wetscav3d, & ! 3D change from wet deposition - del_wetresu3d - - real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - del_activate3d ! 3D change from activation/resuspension - - real(r8), intent(inout) :: aqso4_h2o2, & ! SO4 aqueous phase chemistry due to H2O2 (kg/m2) - aqso4_o3 ! SO4 aqueous phase chemistry due to O3 (kg/m2) - - real(r8), intent(inout), dimension(kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2) :: & - xphlwc3d ! pH value multiplied by lwc - - real(r8), intent(inout), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & - mfbnd_use, ar_bnd_tavg - - real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - ardz_cen_old, ardz_cen_new, acen_tavg_use, acen_prec_use - - real(r8), intent(inout), dimension( kts:ktebnd, 0:2, 0:2 ) :: & - mfbnd_quiescn_up, mfbnd_quiescn_dn - - real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen - - real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2 ) :: & - rh_sub2, qcloud_sub2, qlsink_sub2, precr_sub2, precs_sub2 - - real(r8), intent(in), dimension( 1:2, num_chem_ecpp ) :: chem_bar_iccfactor - - integer, intent(in) :: activate_onoff_use - - integer, intent(in), dimension( 1:num_chem_ecpp ) :: & - iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & - inmw_of_aerosol, laicwpair_of_aerosol - type(physics_buffer_desc), pointer :: pbuf(:) - - - -! local variables - integer, parameter :: activate_onoff_testaa = 1 - integer :: icc, iccb, iccy, ido_actres_tmp, ifrom_where, & - itstep_sub, itmpa, iupdn - integer :: idiag118_pt1, idiag118_pt2, idiag118_pt3 - integer :: idiagbb_wetscav - integer :: jcls, jclsy - integer :: k, kb, l, la, laa, lbb, lc, lun118, lun124 - integer :: m, n, ntstep_sub - integer, save :: ntstep_sub_sum = 0 - integer :: p1st - - integer, dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp ) :: & - ido_actres_horz - - logical :: not_aicw - - real(r8) :: ardz_cut - real(r8) :: dtstep_sub - real(r8) :: tmpa, tmpb, tmpc, tmpd - real(r8) :: tmpcourout, tmpcourmax - real(r8) :: tmp_ardz, tmp_del_ardz - real(r8) :: tmp_ardzqa, tmp_del_ardzqa - real(r8) :: tmp_ardzqc, tmp_del_ardzqc - real(r8) :: tmp_del_ardzqa_act, tmp_del_ardzqc_act - real(r8) :: tmp_fmnact - real(r8) :: tmp_qyla, tmp_qylc - real(r8) :: tmp2dxa(0:2,0:maxcls_ecpp), tmp2dxb(0:2,0:maxcls_ecpp) - real(r8) :: xntstep_sub_inv - - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_sub_old - real(r8), dimension( 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - ent_airamt_tot, det_airamt_tot - real(r8), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - ent_airamt, det_airamt - real(r8), dimension( 1:maxd_asize, 1:maxd_atype, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - fmact_horz, fnact_horz - real(r8), dimension( 1:maxd_asize, 1:maxd_atype, kts:ktecen ) :: & - fmact_vert, fnact_vert - real(r8), dimension( kts:ktebnd, 0:maxcls_ecpp, 1:num_chem_ecpp ) :: & - tmpverta, tmphoriz - - real(r8) :: frc_ent_act ! the fraction of updraft entrainment that may experince activation +++mhwang - real(r8) :: frc_tmp - real(r8) :: abnd_up ! cloud fraction in the upper boundary - real(r8) :: abnd_dn ! cloud fraction in the lower boundary - - call t_startf('ecpp_mainintegr') - - p1st = param_first_ecpp - - idiag118_pt1 = 10 * mod( max(idiagaa_ecpp(118),0)/1, 10 ) - idiag118_pt2 = 10 * mod( max(idiagaa_ecpp(118),0)/10, 10 ) - idiag118_pt3 = 10 * mod( max(idiagaa_ecpp(118),0)/100, 10 ) - - lun124 = -1 - if (idiagaa_ecpp(124) > 0) lun124 = ldiagaa_ecpp(124) - - idiagbb_wetscav = 0 - -! -! calc entrain/detrain amounts -! -! first calc net (entrainment-detrainment) amount = area change - ent_airamt_tot(:,:,:) = 0.0_r8 - det_airamt_tot(:,:,:) = 0.0_r8 - do jcls = 1, ncls_use - do icc = 1, 2 - do k = kts, ktecen - ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 - tmpa = max( ardz_cen_new(k,icc,jcls), ardz_cen_old(k,icc,jcls) ) - if (tmpa < ardz_cut) cycle ! k loop - - if (jcls /= jcls_qu) then -! this is for area change -! tmpb = ardz_cen_new(k,icc,jcls) - ardz_cen_old(k,icc,jcls) -! this is for vertical mass flux divergence/convergence - tmpb = (mfbnd_use(k+1,icc,jcls) - mfbnd_use(k,icc,jcls))*dtstep_pp - if (tmpb > 0.0_r8) then - ent_airamt_tot(icc,jcls,k) = tmpb - else if (tmpb < 0.0_r8) then - det_airamt_tot(icc,jcls,k) = -tmpb - end if - - else - ! +mfbnd_quiescn_up(k+1,icc,0 ) is upwards outflow from sub-class - ! at top of layer (and is >= 0) - ! +mfbnd_quiescn_dn(k+1,0 ,icc) is dnwards inflow to sub-class - ! at top of layer (and is <= 0) - ! -mfbnd_quiescn_up(k ,0, ,icc) is upwards inflow to sub-class - ! at bottom of layer (and is <= 0) - ! -mfbnd_quiescn_dn(k ,icc,0 ) is dnwards outflow from sub-class - ! at bottom of layer (and is >= 0) - ! tmpb = net vertical in/outflows - ! (positive if net outflow, negative if net inflow) - tmpb = ( mfbnd_quiescn_up(k+1,icc,0 ) & - + mfbnd_quiescn_dn(k+1,0 ,icc) & - - mfbnd_quiescn_up(k ,0 ,icc) & - - mfbnd_quiescn_dn(k ,icc,0 ) )*dtstep_pp - if (tmpb > 0.0_r8) then - ent_airamt_tot(icc,jcls,k) = tmpb - else if (tmpb < 0.0_r8) then - det_airamt_tot(icc,jcls,k) = -tmpb - end if - - end if - end do - end do - end do - -! next calc detailed ent/det amounts - call t_startf('ecpp_entdet') - ifrom_where = 10 - call parampollu_tdx_entdet_sub1( & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, ifrom_where, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - ardz_cen_old, ardz_cen_new, rhodz_cen, & - ent_airamt_tot, det_airamt_tot, & - ent_airamt, det_airamt ) - call t_stopf('ecpp_entdet') - - -! -! calc activation/resuspension fractions associated with ent/det -! and vertical transport -! - if (activate_onoff_use > 0) then - call t_startf('ecpp_activate') - ifrom_where = 10 - call parampollu_tdx_activate1( & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, wbnd_bar, & - ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, ifrom_where, activate_onoff_use, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - chem_sub_new, & - mfbnd_use, & - ar_bnd_tavg, & - ent_airamt, & - ido_actres_horz, fmact_horz, fnact_horz, & - fmact_vert, fnact_vert, mfbnd_quiescn_up ) - call t_stopf('ecpp_activate') - end if - - -! -! determine number of integration sub-steps -! calc "outflow" courant number for each sub-class -! = (sum of outflow air-mass fluxes) * dt / ardz_cen -! calc tmpcourmax = maximum outflow courant number -! for all layers and sub-classes -! select ntstep_sub (number of integration sub-steps) so that -! (tmpcourmax/ntstep_sub) <= 1.0 -! - if (lun124 > 0) & - write( lun124, '(/a,2i5/a)' ) 'new courout stuff -- ktau, ktau_pp', ktau, ktau_pp, & - 'k, tmpcouroutc(qu), tmpcouroutb(up), tmpcouroutb(dn)' - tmp2dxb(:,:) = -1.0_r8 - tmpcourmax = 0.0_r8 - do k = ktecen, kts, -1 - ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 - do jcls = 1, ncls_use - do icc = 1, 2 - -! tmpa = (air-mass leaving sub-class over dtstep_pp by vertical mass flux) - if (jcls == jcls_qu) then - tmpa = mfbnd_quiescn_up(k+1,icc,0) - mfbnd_quiescn_dn(k,icc,0) - else - tmpa = max(0.0_r8,mfbnd_use(k+1,icc,jcls)) + max(0.0_r8,-mfbnd_use(k,icc,jcls)) - end if - tmpa = tmpa*dtstep_pp -! tmpb = tmpa + (air-mass leaving sub-class over dtstep_pp by horizontal detrainment) - tmpb = tmpa + max(0.0_r8,det_airamt_tot(icc,jcls,k)) - -! (area*rho*dz) is fixed at ardz_cen_new during the integration loop - tmp_ardz = ardz_cen_new(k,icc,jcls) - - if (tmp_ardz < ardz_cut) then - tmpcourout = 0.0_r8 - else if (tmpb > 1.0e3_r8*tmp_ardz) then - tmpcourout = 1.0e3_r8 - else - tmpcourout = tmpb/tmp_ardz - end if - - tmpcourmax = max( tmpcourmax, tmpcourout ) - tmp2dxa(icc,jcls) = tmpcourout - tmp2dxb(icc,jcls) = max( tmp2dxb(icc,jcls), tmpcourout ) - end do ! icc - end do ! jcls - if (lun124 > 0) & - write( lun124, '(i3,1p,3e12.4,2x,3e12.4)' ) k, (tmp2dxa(iccy,1:3), iccy=1,2) - end do ! k - if (lun124 > 0) & - write( lun124, '( a,1p,3e12.4,2x,3e12.4)' ) 'max', (tmp2dxb(iccy,1:3), iccy=1,2) - - if (tmpcourmax > 1.0_r8) then - tmpa = max( 0.0_r8, tmpcourmax-1.0e-7_r8 ) - ntstep_sub = 1 + int( tmpa ) - else - ntstep_sub = 1 - end if - ntstep_sub_sum = ntstep_sub_sum + ntstep_sub - dtstep_sub = dtstep_pp/ntstep_sub - xntstep_sub_inv = 1.0_r8/ntstep_sub - - lun118 = -1 - if (idiag118_pt2 > 0) lun118 = ldiagaa_ecpp(118) - if (lun118 > 0) then - write(lun118,'(a,1p,2e12.4,2i12)') & - ' tmpcourmax, dtstep_sub, nstep_sub =', tmpcourmax, dtstep_sub, & - ntstep_sub, ntstep_sub_sum - end if - if (lun124 > 0) & - write( lun124, '(a,1p,2e12.4,2i12)' ) & - ' tmpcourmax, dtstep_sub, nstep_sub =', tmpcourmax, dtstep_sub, & - ntstep_sub, ntstep_sub_sum - - - -! -! do multiple integration sub-steps -! apply vertical transport and balancing entrainment/detrainment -! -! area change is done elsewhere, so area is fixed at ardz_cen_new -! during the integration loop -! -main_itstep_sub_loop: & - do itstep_sub = 1, ntstep_sub - - call t_startf('ecpp_vertical') - -! copy "current" chem_sub values to chem_sub_old - chem_sub_old(:,:,:,:) = chem_sub_new(:,:,:,:) - - - tmpverta(:,:,:) = 0.0_r8 - tmphoriz( :,:,:) = 0.0_r8 - -! calculate "transport" changes to chem_sub over one time sub-step -! (vertical transport and horizontal exchange, including activation/resuspension) -main_trans_jcls_loop: & - do jcls = 1, ncls_use -main_trans_icc_loop: & - do icc = 1, 2 -main_trans_k_loop: & - do k = kts, ktecen - - -! if area ~= 0, then just set chem_sub_new to chem_bar - ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 - if (ardz_cen_new(k,icc,jcls) < ardz_cut) then - do l = param_first_ecpp, num_chem_ecpp - chem_sub_new(k,icc,jcls,l) = & - chem_bar(k,l)*chem_bar_iccfactor(icc,l) - end do - cycle main_trans_k_loop - end if - - -! la loop goes over all species -! for la = non-aerosol species, loop is executed with lc=0 -! for la = interstitial aerosol species, loop is excecuted with -! lc=activated counterpart -! for la = activated aerosol species, loop is skipped -main_trans_la_loop: & - do la = p1st, num_chem_ecpp - - tmp_del_ardzqa_act = 0.0_r8 - tmp_del_ardzqc_act = 0.0_r8 - - lc = 0 - l = -999888777 - not_aicw = .true. -! if (activate_onoff_use > 999888777) then - if (activate_onoff_use > 0) then - if (iphase_of_aerosol(la) == ai_phase) then - lc = laicwpair_of_aerosol(la) - not_aicw = .false. - else if (iphase_of_aerosol(la) == cw_phase) then - cycle main_trans_la_loop - end if - end if - if ((lc < p1st) .or. (lc > num_chem_ecpp)) lc = -999888777 - m = isize_of_aerosol(la) ; if (m <= 0) m = -999888777 - n = itype_of_aerosol(la) ; if (n <= 0) n = -999888777 - - tmp_ardz = ardz_cen_old(k,icc,jcls) - tmp_ardzqa = chem_sub_old(k,icc,jcls,la)*tmp_ardz - tmp_ardzqc = 0.0_r8 - if (lc > 0) & - tmp_ardzqc = chem_sub_old(k,icc,jcls,lc)*tmp_ardz - -! subtract detrainment loss (no activation/resuspension here) - tmp_del_ardz = -det_airamt_tot(icc,jcls,k)*xntstep_sub_inv - if (tmp_del_ardz < 0.0_r8) then - tmp_ardz = tmp_ardz + tmp_del_ardz - tmp_ardzqa = tmp_ardzqa + chem_sub_old(k,icc,jcls,la)*tmp_del_ardz - tmphoriz(k,jcls,la) = tmphoriz(k,jcls,la) & - + chem_sub_old(k,icc,jcls,la)*tmp_del_ardz - if (lc > 0) then - tmp_ardzqc = tmp_ardzqc + chem_sub_old(k,icc,jcls,lc)*tmp_del_ardz - tmphoriz(k,jcls,lc) = tmphoriz(k,jcls,lc) & - + chem_sub_old(k,icc,jcls,lc)*tmp_del_ardz - end if - end if - -! add entrainment contributions (need activation/resuspension here) -! -!+++mhwang -! Calculate the fraction of entrainment that may expericence activations. -! (we assume only the new cloudy updraft may experience activation, and -! old updraft do not experience activation -! Minghuai Wang, 2010-05 - frc_ent_act = 1.0_r8 - if(mtype_updnenv_use(icc, jcls) == mtype_updraft_ecpp) then - abnd_up = 0.0_r8 - abnd_dn = 0.0_r8 - if(rhobnd_bar(k+1).gt.1.0e-10_r8) then - abnd_up = ar_bnd_tavg(k+1, icc, jcls)/rhobnd_bar(k+1) - end if - if(rhobnd_bar(k).gt.1.0e-10_r8) then - abnd_dn = ar_bnd_tavg(k, icc, jcls)/rhobnd_bar(k) - end if - if(k.eq.kts) then - frc_ent_act = 1.0_r8 - else if(abnd_up.gt.1.0e-5_r8) then - frc_ent_act = 1.0_r8 - min(1.0_r8, abnd_dn/abnd_up) - - if(mfbnd_use(k+1, icc, jcls).gt.1.0e-20_r8) then - frc_tmp = max(1.0e-5_r8, 1.0_r8-mfbnd_use(k, icc, jcls)/mfbnd_use(k+1, icc, jcls)) - frc_ent_act = min(1.0_r8, frc_ent_act / frc_tmp) - endif - end if - end if ! end mtype_updnenv_use -!---mhwang - - -entrain_jclsy_loop: & - do jclsy = 1, ncls_use -entrain_iccy_loop: & - do iccy = 1, 2 - tmp_del_ardz = ent_airamt(icc,jcls,iccy,jclsy,k)*xntstep_sub_inv - if (tmp_del_ardz <= 0.0_r8) cycle entrain_iccy_loop - - if ( not_aicw ) then - ido_actres_tmp = 0 - else - ido_actres_tmp = ido_actres_horz(icc,jcls,iccy,jclsy) - end if - - tmp_qyla = chem_sub_old(k,iccy,jclsy,la) - if (lc > 0) then - tmp_qylc = chem_sub_old(k,iccy,jclsy,lc) - else - tmp_qylc = 0.0_r8 - end if - tmp_ardz = tmp_ardz + tmp_del_ardz - - if (activate_onoff_testaa <= 0) ido_actres_tmp = 0 ! for testing -!+++mhwangtest -! turn activation in entrainment off -! ido_actres_tmp = 0 ! +++mhwangtest - - if (ido_actres_tmp == 0) then - ! non aicw-aerosol species OR no activation or resuspension - tmp_del_ardzqa = tmp_qyla*tmp_del_ardz - tmp_del_ardzqc = tmp_qylc*tmp_del_ardz - - else if (ido_actres_tmp > 0) then - ! activation of (la+lc) - if (inmw_of_aerosol(la) == 1) then -! tmp_fmnact = fnact_horz(m,n,jcls,iccy,jclsy,k) - tmp_fmnact = fnact_horz(m,n,jcls,iccy,jclsy,k) * frc_ent_act !+++mhwang - else -! tmp_fmnact = fmact_horz(m,n,jcls,iccy,jclsy,k) - tmp_fmnact = fmact_horz(m,n,jcls,iccy,jclsy,k) * frc_ent_act ! +++mhwang - end if - if (ido_actres_tmp == 2) then - tmp_del_ardzqa = (tmp_qyla+tmp_qylc)*(1.0_r8-tmp_fmnact)*tmp_del_ardz - tmp_del_ardzqc = (tmp_qyla+tmp_qylc)*(tmp_fmnact )*tmp_del_ardz - else - tmp_del_ardzqa = (tmp_qyla*(1.0_r8-tmp_fmnact) )*tmp_del_ardz - tmp_del_ardzqc = (tmp_qyla*tmp_fmnact + tmp_qylc)*tmp_del_ardz - end if - - else - ! resuspension of lc - tmp_del_ardzqa = (tmp_qyla+tmp_qylc)*tmp_del_ardz - tmp_del_ardzqc = 0.0_r8 - - end if - - tmp_ardzqa = tmp_ardzqa + tmp_del_ardzqa - tmp_ardzqc = tmp_ardzqc + tmp_del_ardzqc - tmphoriz(k,jcls,la) = tmphoriz(k,jcls,la) + tmp_del_ardzqa - if (lc > 0) & - tmphoriz(k,jcls,lc) = tmphoriz(k,jcls,lc) + tmp_del_ardzqc - -! change from activation/resuspension - tmp_del_ardzqa_act = tmp_del_ardzqa_act + (tmp_del_ardzqa - tmp_qyla*tmp_del_ardz) - if (lc > 0) & - tmp_del_ardzqc_act = tmp_del_ardzqc_act + (tmp_del_ardzqc - tmp_qylc*tmp_del_ardz) - - end do entrain_iccy_loop - end do entrain_jclsy_loop - - - if (jcls == jcls_qu) then -! quiescent class -- calc change to layer k mixrat due to vertical transport at lower boundary -! mfbnd_quiescn_up(k,icc1,icc2) is upwards mass flux from icc1 to icc2 -! at bottom of layer k -! mfbnd_quiescn_dn(k,icc1,icc2) is downwards ... -! activation/resuspension calcs -! k-1,clear to k,cloudy - do activation -! k-1,cloudy to k,clear - do resuspension -! k,either to k-1,either - are just calculating loss to k here, so no act/res needed -vert_botqu_iupdn_loop: & - do iupdn = 1, 2 - if (k <= kts) cycle vert_botqu_iupdn_loop ! skip k=kts -vert_botqu_iccy_loop: & - do iccy = 1, 2 - ! kb & iccy refer to the layer and sub-class from which - ! air and tracer mass are leaving - ido_actres_tmp = 0 - if (iupdn == 1) then - ! air is going from kb=k-1,iccb=iccy=1:2 to k,icc - tmp_del_ardz = mfbnd_quiescn_up(k,iccy,icc)*dtstep_sub - kb = k - 1 - iccb = iccy - if (not_aicw .eqv. .false.) then - if ((iccy == 1) .and. (icc == 2)) then - ido_actres_tmp = 1 - else if ((iccy == 2) .and. (icc == 1)) then - ido_actres_tmp = -1 - end if - end if - else - ! air is going from kb=k,iccb=icc to k-1,iccy=1:2 - ! since this is a loss from k, we can calc iccy=1&2 - ! together using mfbnd_quiescn_dn(k,icc,0) - if (iccy > 1) cycle vert_botqu_iccy_loop - tmp_del_ardz = mfbnd_quiescn_dn(k,icc,0)*dtstep_sub - kb = k - iccb = icc - end if - - if (tmp_del_ardz == 0.0_r8) cycle vert_botqu_iccy_loop - - tmp_qyla = chem_sub_old(kb,iccb,jcls,la) - if (lc > 0) then - tmp_qylc = chem_sub_old(kb,iccb,jcls,lc) - else - tmp_qylc = 0.0_r8 - end if - - tmp_ardz = tmp_ardz + tmp_del_ardz - - if (activate_onoff_testaa <= 0) ido_actres_tmp = 0 ! for testing -!+++mhwangtest -! turn activation in entrainment off -! ido_actres_tmp = 0 ! +++mhwangtest - if (ido_actres_tmp == 0) then - ! non aicw-aerosol species OR no activation or resuspension - tmp_del_ardzqa = tmp_qyla*tmp_del_ardz - tmp_del_ardzqc = tmp_qylc*tmp_del_ardz - - else if (ido_actres_tmp > 0) then - ! activation of (la+lc) - if (inmw_of_aerosol(la) == 1) then - tmp_fmnact = fnact_vert(m,n,k) - else - tmp_fmnact = fmact_vert(m,n,k) - end if - tmp_del_ardzqa = (tmp_qyla*(1.0_r8-tmp_fmnact) )*tmp_del_ardz - tmp_del_ardzqc = (tmp_qyla*tmp_fmnact + tmp_qylc)*tmp_del_ardz - - else - ! resuspension of lc - tmp_del_ardzqa = (tmp_qyla+tmp_qylc)*tmp_del_ardz - tmp_del_ardzqc = 0.0_r8 - - end if - - tmp_ardzqa = tmp_ardzqa + tmp_del_ardzqa - tmp_ardzqc = tmp_ardzqc + tmp_del_ardzqc - if (icc == 1) then - tmpverta(k,jcls,la) = tmpverta(k,jcls,la) + tmp_del_ardzqa - if (lc > 0) & - tmpverta(k,jcls,lc) = tmpverta(k,jcls,lc) + tmp_del_ardzqc - end if - -! change from activation/resuspension - tmp_del_ardzqa_act = tmp_del_ardzqa_act + (tmp_del_ardzqa - tmp_qyla*tmp_del_ardz) - if (lc > 0) & - tmp_del_ardzqc_act = tmp_del_ardzqc_act + (tmp_del_ardzqc - tmp_qylc*tmp_del_ardz) - - ! with "pgf90 -O2", code seg-faulted until following statement - ! was added. (note that it is do-nothing, since la>0 always) - if (la < 0) write(*,*) & - 'vert_botqu gggg - icc,iupdn,ido', iccy, iupdn, ido_actres_tmp - end do vert_botqu_iccy_loop - end do vert_botqu_iupdn_loop - -! quiescent class -- calc change to layer k mixrat due to vertical transport at upper boundary -! mfbnd_quiescn_up(k+1,icc1,icc2) is upwards mass flux from icc1 to icc2 -! at top of layer k -! mfbnd_quiescn_dn(k+1,icc1,icc2) is downwards ... -! activation/resuspension calcs -! k+1,clear to k,cloudy - downwards motion so skip activation ??? -! k+1,cloudy to k,clear - do resuspension -! k,either to k+1,either - are just calculating loss to k here, so no act/res needed -vert_topqu_iupdn_loop: & - do iupdn = 1, 2 - if (k >= ktebnd-1) cycle vert_topqu_iupdn_loop ! skip k=ktebnd-1,ktebnd -vert_topqu_iccy_loop: & - do iccy = 1, 2 - ido_actres_tmp = 0 - if (iupdn == 1) then - ! air is going from kb=k,iccb=icc to k+1,iccy=1:2 - ! since this is a loss from k, we can calc iccy=1&2 - ! together using mfbnd_quiescn_up(k+1,icc,0) - if (iccy > 1) cycle vert_topqu_iccy_loop - tmp_del_ardz = -mfbnd_quiescn_up(k+1,icc,0)*dtstep_sub - kb = k - iccb = icc - else - ! air is going from kb=k+1,iccb=iccy=1:2 to k,icc - tmp_del_ardz = -mfbnd_quiescn_dn(k+1,iccy,icc)*dtstep_sub - kb = k+1 - iccb = iccy - if (not_aicw .eqv. .false.) then - if ((iccy == 2) .and. (icc == 1)) then - ido_actres_tmp = -1 - end if - end if - end if - - if (tmp_del_ardz == 0.0_r8) cycle vert_topqu_iccy_loop - - tmp_qyla = chem_sub_old(kb,iccb,jcls,la) - if (lc > 0) then - tmp_qylc = chem_sub_old(kb,iccb,jcls,lc) - else - tmp_qylc = 0.0_r8 - end if - - tmp_ardz = tmp_ardz + tmp_del_ardz - - if (activate_onoff_testaa <= 0) ido_actres_tmp = 0 ! for testing -!+++mhwangtest -! turn activation in entrainment off -! ido_actres_tmp = 0 ! +++mhwangtest - if (ido_actres_tmp == 0) then - ! non aicw-aerosol species OR no activation or resuspension - tmp_del_ardzqa = tmp_qyla*tmp_del_ardz - tmp_del_ardzqc = tmp_qylc*tmp_del_ardz - - else if (ido_actres_tmp > 0) then - ! activation of (la+lc) - if (inmw_of_aerosol(la) == 1) then - tmp_fmnact = fnact_vert(m,n,k) - else - tmp_fmnact = fmact_vert(m,n,k) - end if - tmp_del_ardzqa = (tmp_qyla*(1.0_r8-tmp_fmnact) )*tmp_del_ardz - tmp_del_ardzqc = (tmp_qyla*tmp_fmnact + tmp_qylc)*tmp_del_ardz - - else - ! resuspension of lc - tmp_del_ardzqa = (tmp_qyla+tmp_qylc)*tmp_del_ardz - tmp_del_ardzqc = 0.0_r8 - - end if - - tmp_ardzqa = tmp_ardzqa + tmp_del_ardzqa - tmp_ardzqc = tmp_ardzqc + tmp_del_ardzqc - -! change from activation/resuspension - tmp_del_ardzqa_act = tmp_del_ardzqa_act + (tmp_del_ardzqa - tmp_qyla*tmp_del_ardz) - if (lc > 0) & - tmp_del_ardzqc_act = tmp_del_ardzqc_act + (tmp_del_ardzqc - tmp_qylc*tmp_del_ardz) - - ! with "pgf90 -O2", code seg-faulted until following statement - ! was added. (note that it is do-nothing, since la>0 always) - if (la < 0) write(*,*) & - 'vert_topqu gggg - icc,iupdn,ido', iccy, iupdn, ido_actres_tmp - end do vert_topqu_iccy_loop - end do vert_topqu_iupdn_loop - - - else -! up/dndraft class -- add/subtract vertical transport at lower boundary -! no activation/resuspension here as the vertical transport within up/dndrafts -! is clear-->clear or cloudy-->cloudy. (The within up/dndraft -! clear<-->cloudy is done by ent/detrainment.) - if (k > kts) then - tmp_del_ardz = mfbnd_use(k,icc,jcls)*dtstep_sub - if (abs(tmp_del_ardz) > 0.0_r8) then - if (tmp_del_ardz > 0.0_r8) then - kb = k - 1 - else - kb = k - end if - tmp_ardz = tmp_ardz + tmp_del_ardz - tmp_ardzqa = tmp_ardzqa + chem_sub_old(kb,icc,jcls,la)*tmp_del_ardz - if (lc > 0) & - tmp_ardzqc = tmp_ardzqc + chem_sub_old(kb,icc,jcls,lc)*tmp_del_ardz - if (icc == 1) then - tmpverta(k,jcls,la) = chem_sub_old(kb,icc,jcls,la)*tmp_del_ardz - if (lc > 0) & - tmpverta(k,jcls,lc) = chem_sub_old(kb,icc,jcls,lc)*tmp_del_ardz - end if - end if - end if ! (k > kts) -! up/dndraft class -- add/subtract vertical transport at upper boundary - if (k < ktebnd-1) then - tmp_del_ardz = -mfbnd_use(k+1,icc,jcls)*dtstep_sub - if (abs(tmp_del_ardz) > 0.0_r8) then - if (tmp_del_ardz > 0.0_r8) then - kb = k + 1 - else - kb = k - end if - tmp_ardz = tmp_ardz + tmp_del_ardz - tmp_ardzqa = tmp_ardzqa + chem_sub_old(kb,icc,jcls,la)*tmp_del_ardz - if (lc > 0) & - tmp_ardzqc = tmp_ardzqc + chem_sub_old(kb,icc,jcls,lc)*tmp_del_ardz - end if - end if ! (k < ktebnd-1) - - end if ! (jcls == jcls_qu) - - -! new mixing ratio - chem_sub_new(k,icc,jcls,la) = tmp_ardzqa/ardz_cen_new(k,icc,jcls) - if (lc > 0) & - chem_sub_new(k,icc,jcls,lc) = tmp_ardzqc/ardz_cen_new(k,icc,jcls) - -! change in mixing ratio (*fraction) from activation/resuspension - del_activate3d(k,icc,jcls,la) = del_activate3d(k,icc,jcls,la)+tmp_del_ardzqa_act/rhodz_cen(k) - if (lc > 0) & - del_activate3d(k,icc,jcls,lc) = del_activate3d(k,icc,jcls,lc)+tmp_del_ardzqc_act/rhodz_cen(k) - - end do main_trans_la_loop - - end do main_trans_k_loop - end do main_trans_icc_loop - end do main_trans_jcls_loop - - -! fort.118 diagnostics - lun118 = -1 - if (idiag118_pt3 > 0) then - if (idiag118_pt3 >= 10) lun118 = ldiagaa_ecpp(118) - if (itstep_sub == ntstep_sub) lun118 = ldiagaa_ecpp(118) - end if - if (lun118 > 0) then - do l = param_first_ecpp, num_chem_ecpp - if ((l == 9) .or. (l == 9)) then - - write(lun118,'(/a,3i5)') 'new_main_integ pt3 ktau_pp, istep_sub, l =', ktau_pp, itstep_sub, l - write(lun118,'(2a)') & - '(chem_sub_old(k,icc,jcls,l), chem_sub_new(k,icc,jcls,l), jcls=2,1,-1); ', & - 'updr ardz_cen_new and w; dumverta/b, dumhoriz for updr then env' - - icc = 1 - tmpc = 1.0_r8/dtstep_sub - do k = ktecen, kts, -1 - tmpa = 0.0_r8 - if (ar_bnd_tavg(k,icc,jgrp_up) > 0.0_r8) & - tmpa = mfbnd_use(k,icc,jgrp_up)/ar_bnd_tavg(k,icc,jgrp_up) - write(lun118,'(i3,1p,3(1x,2e10.3),2(1x,3e10.3))') k, & - ( chem_sub_old(k,icc,jcls,l), chem_sub_new(k,icc,jcls,l), jcls=2,1,-1 ), & - ardz_cen_new(k,icc,jgrp_up), tmpa, & - ( tmpverta(k,jcls,l)*tmpc, & - (tmpverta(k,jcls,l)-tmpverta(k+1,jcls,l))*tmpc, & - tmphoriz(k,jcls,l)*tmpc, jcls=2,1,-1 ) - end do ! k - - end if ! (l == ...) - end do ! l - end if ! (lun118 > 0) - - call t_stopf('ecpp_vertical') - - end do main_itstep_sub_loop - -! -! +++mhwang -! move cloud chemistry and wetscavenging outside of istep_sub_loop -! inside of the itstep_sub_loop is too expanseive -! Minghuai Wang, 2010-04-28 -! - itstep_sub = 1 - dtstep_sub = dtstep_pp - -! calculate cloud chemistry changes to chem_sub over one time sub-step -! call t_startf('ecpp_cldchem') -! call parampollu_tdx_cldchem( & -! ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & -! itstep_hybrid, & -! idiagaa_ecpp, ldiagaa_ecpp, & -! tcen_bar, pcen_bar, rhocen_bar, dzcen, & -! rhobnd_bar, zbnd, wbnd_bar, & -! chem_bar, & -! ncls_ecpp, & -! it, jt, kts,ktebnd,ktecen, & -! ncls_use, & -! kdraft_bot_use, kdraft_top_use, & -! mtype_updnenv_use, & -! chem_sub_new, & -! del_chem_clm_cldchem, del_chem_clm_rename, del_cldchem3d, del_rename3d, & -! aqso4_h2o2, aqso4_o3, xphlwc3d, & -! ardz_cen_old, ardz_cen_new, rhodz_cen, & -! acen_tavg_use, acen_prec_use, & -! rh_sub2, qcloud_sub2, qlsink_sub2, & -! precr_sub2, precs_sub2, & -! chem_bar_iccfactor, activate_onoff_use, & -! iphase_of_aerosol, isize_of_aerosol, & -! itype_of_aerosol, inmw_of_aerosol, & -! laicwpair_of_aerosol ) -! call t_stopf('ecpp_cldchem') - - -! calculate wet removal changes to chem_sub over one time sub-step - - if (wetscav_onoff_ecpp >= 100) then - call t_startf('ecpp_wetscav') -! write(*,'(a,3i8)') 'main integ calling wetscav_2', ktau, ktau_pp, itstep_sub - call parampollu_tdx_wetscav_2( & - ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & - itstep_hybrid, & - idiagaa_ecpp, ldiagaa_ecpp, idiagbb_wetscav, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & -! rhobnd_bar, zbnd, wbnd_bar, & not needed ? -! chem_bar, & not needed ? -! ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & -! kdraft_bot_use, kdraft_top_use, & not needed ? -! mtype_updnenv_use, & not needed ? - chem_sub_new, & - del_chem_clm_wetscav, & - del_wetscav3d, del_wetresu3d, & -! ardz_cen_old, ardz_cen_new, & not needed ? - rhodz_cen, & - acen_tavg_use, acen_prec_use, & - rh_sub2, qcloud_sub2, qlsink_sub2, & - precr_sub2, precs_sub2, & -! chem_bar_iccfactor, & not needed ? - activate_onoff_use, & - iphase_of_aerosol, isize_of_aerosol, & - itype_of_aerosol, inmw_of_aerosol, & - laicwpair_of_aerosol ) -! write(*,'(a,3i8)') 'main integ backfrm wetscav_2', ktau, ktau_pp, itstep_sub - call t_stopf('ecpp_wetscav') - end if ! (wetscav_onoff_ecpp >= 100) - -! calculate cloud chemistry changes to chem_sub over one time sub-step - call t_startf('ecpp_cldchem') - call parampollu_tdx_cldchem( & - ktau, dtstep, ktau_pp, itstep_sub, dtstep_sub, & - itstep_hybrid, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, zbnd, wbnd_bar, & - chem_bar, & - ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - chem_sub_new, & - del_chem_clm_cldchem, del_chem_clm_rename, del_cldchem3d, del_rename3d, & - aqso4_h2o2, aqso4_o3, xphlwc3d, & - ardz_cen_old, ardz_cen_new, rhodz_cen, & - acen_tavg_use, acen_prec_use, & - rh_sub2, qcloud_sub2, qlsink_sub2, & - precr_sub2, precs_sub2, & - chem_bar_iccfactor, activate_onoff_use, & - iphase_of_aerosol, isize_of_aerosol, & - itype_of_aerosol, inmw_of_aerosol, & - laicwpair_of_aerosol, pbuf ) - call t_stopf('ecpp_cldchem') - -! end do main_itstep_sub_loop - - call t_stopf('ecpp_mainintegr') - - - return - end subroutine parampollu_tdx_main_integ - - -!----------------------------------------------------------------------- - subroutine parampollu_tdx_area_change( & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, wbnd_bar, & - chem_bar, & - ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, ipass_area_change, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - chem_sub_new, & - del_activate3d, & - mfbnd_use, ar_bnd_tavg, & - ardz_cen_old, ardz_cen_new, rhodz_cen, & - chem_bar_iccfactor, activate_onoff_use, & - iphase_of_aerosol, isize_of_aerosol, & - itype_of_aerosol, inmw_of_aerosol, & - laicwpair_of_aerosol ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_tdx_area_change does -! horizontal exchange associated with sub-class area changes -! -! incoming chem_sub_new holds current sub-class mixing ratios -! outgoing chem_sub_new holds updated sub-class mixing ratios -! -!----------------------------------------------------------------------- - - use module_data_radm2, only: epsilc - - use module_data_mosaic_asect, only: ai_phase, cw_phase, & - maxd_asize, maxd_atype - - use module_data_ecpp1 - - use module_ecpp_util, only: ecpp_error_fatal, ecpp_message - -! arguments - integer, intent(in) :: & - ktau, ktau_pp, & - it, jt, kts, ktebnd, ktecen -! ktau - time step number -! ktau_pp - time step number for "parameterized pollutants" calculations -! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" -! chem_driver and routines under it do calculations -! over these spatial indices. - - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) - - real(r8), intent(in) :: dtstep, dtstep_pp -! dtstep - main model time step (s) -! dtstep_pp - time step (s) for "parameterized pollutants" calculations - - real(r8), intent(in), dimension( kts:ktecen ) :: & - tcen_bar, pcen_bar, rhocen_bar, dzcen - real(r8), intent(in), dimension( kts:ktebnd ) :: & - rhobnd_bar, wbnd_bar -! tcen_bar - temperature (K) at layer centers -! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries -! pcen_bar - air pressure (Pa) at layer centers -! wbnd_bar - vertical velocity (m/s) at layer boundaries -! dzcen - layer thicknesses (m) - - real(r8), intent(in), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & - chem_bar -! chem_bar - mixing ratios of trace gase (ppm) and aerosol species -! (ug/kg for mass species, #/kg for number species) - - integer, intent(in) :: ncls_ecpp -! ncls_ecpp - number of ecpp transport classes in the grid column - - integer, intent(inout) :: ipass_area_change - integer, intent(in) :: ncls_use - - integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use - - real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_sub_new - - real(r8), intent(inout), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - del_activate3d - - real(r8), intent(inout), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & - mfbnd_use, ar_bnd_tavg - - real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - ardz_cen_old, ardz_cen_new - - real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen - - real(r8), intent(in), dimension( 1:2, num_chem_ecpp ) :: chem_bar_iccfactor - - integer, intent(in) :: activate_onoff_use - - integer, intent(in), dimension( 1:num_chem_ecpp ) :: & - iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & - inmw_of_aerosol, laicwpair_of_aerosol - - -! local variables - integer :: icc, iccy, ido_actres_tmp, ifrom_where, itmpa - integer :: idiag118_pt3 - integer :: jcls, jclsy - integer :: k - integer :: l, la, laa, lbb, lc, lun118 - integer :: m, n - integer :: p1st - - integer, dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp ) :: & - ido_actres_horz - - logical :: not_aicw - - real(r8) :: ardz_cut - real(r8) :: tmpa, tmpb, tmpc, tmpd - real(r8) :: tmp_fmnact, tmp_qyla, tmp_qylc - real(r8) :: tmpvecd(0:maxcls_ecpp), tmpvece(0:maxcls_ecpp) - real(r8) :: tmp_del_ardzqa, tmp_del_ardzqc - real(r8) :: tmp_del_ardzqa_act, tmp_del_ardzqc_act - - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_sub_old - real(r8), dimension( 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - ent_airamt_tot, det_airamt_tot - real(r8), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - ent_airamt, det_airamt - real(r8), dimension( 1:maxd_asize, 1:maxd_atype, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - fmact_horz, fnact_horz - - - - p1st = param_first_ecpp - idiag118_pt3 = 10 * mod( max(idiagaa_ecpp(118),0)/100, 10 ) - -! -! calc entrain/detrain amounts -! -! first calc net (entrainment-detrainment) amount = area change - ent_airamt_tot(:,:,:) = 0.0_r8 - det_airamt_tot(:,:,:) = 0.0_r8 - do jcls = 1, ncls_use - do icc = 1, 2 - do k = kts, ktecen - ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 - tmpa = max( ardz_cen_new(k,icc,jcls), ardz_cen_old(k,icc,jcls) ) - if (tmpa >= ardz_cut) then - tmpb = ardz_cen_new(k,icc,jcls) - ardz_cen_old(k,icc,jcls) - if (tmpb > 0.0_r8) then - ent_airamt_tot(icc,jcls,k) = tmpb - else if (tmpb < 0.0_r8) then - det_airamt_tot(icc,jcls,k) = -tmpb - end if - end if - end do - end do - end do - -! next calc detailed ent/det amounts - ifrom_where = ipass_area_change - call parampollu_tdx_entdet_sub1( & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, ifrom_where, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - ardz_cen_old, ardz_cen_new, rhodz_cen, & - ent_airamt_tot, det_airamt_tot, & - ent_airamt, det_airamt ) - - -! -! calc activation/resuspension fractions associated with ent/det -! - if (activate_onoff_use > 0) then - ifrom_where = ipass_area_change - call parampollu_tdx_activate1( & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, wbnd_bar, & - ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, ifrom_where, activate_onoff_use, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - chem_sub_new, & - mfbnd_use, & - ar_bnd_tavg, & - ent_airamt, & - ido_actres_horz, fmact_horz, fnact_horz ) - end if - - -! copy chem_sub_new (= incoming current chem_sub values) into chem_sub_old - chem_sub_old(:,:,:,:) = chem_sub_new(:,:,:,:) - -! calculate new chem_sub -main_jcls_loop: & - do jcls = 1, ncls_use -main_icc_loop: & - do icc = 1, 2 -main_k_loop: & - do k = kts, ktecen - -! if entrainment and detrainment) both ~= 0, then no change - if ( (ent_airamt_tot(icc,jcls,k) < 1.0e-30_r8) .and. & - (det_airamt_tot(icc,jcls,k) < 1.0e-30_r8) ) cycle - -! if new area ~= 0, then just set chem_sub_new to chem_bar - ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 - if (ardz_cen_new(k,icc,jcls) < ardz_cut) then - do l = p1st, num_chem_ecpp - chem_sub_new(k,icc,jcls,l) = & - chem_bar(k,l)*chem_bar_iccfactor(icc,l) - end do - cycle main_k_loop - end if - -! la loop goes over all species -! for la = non-aerosol species, loop is executed with lc=0 -! for la = interstitial aerosol species, loop is excecuted with -! lc=activated counterpart -! for la = activated aerosol species, loop is skipped -main_la_loop: & - do la = p1st, num_chem_ecpp - - tmp_del_ardzqa_act = 0.0_r8 - tmp_del_ardzqc_act = 0.0_r8 - - lc = 0 - not_aicw = .true. - if (activate_onoff_use > 0) then - if (iphase_of_aerosol(la) == ai_phase) then - lc = laicwpair_of_aerosol(la) - not_aicw = .false. - else if (iphase_of_aerosol(la) == cw_phase) then - cycle main_la_loop - end if - end if - if ((lc < p1st) .or. (lc > num_chem_ecpp)) lc = -999888777 - -! tmpd = (original area) - (detrainment to all others) - tmpd = ardz_cen_old(k,icc,jcls) - det_airamt_tot(icc,jcls,k) - tmpd = max( tmpd, 0.0_r8 ) - -! tmpa holds sum_of( mix_ratio * area ) for interstitial -! tmpc holds sum_of( mix_ratio * area ) for activated - tmpa = chem_sub_old(k,icc,jcls,la)*tmpd - if (lc > 0) & - tmpc = chem_sub_old(k,icc,jcls,lc)*tmpd - -! add entrainment contributions - do jclsy = 1, ncls_use - do iccy = 1, 2 - tmpd = ent_airamt(icc,jcls,iccy,jclsy,k) - if (tmpd <= 0.0_r8) cycle - - if ( not_aicw ) then - ido_actres_tmp = 0 - else - ido_actres_tmp = ido_actres_horz(icc,jcls,iccy,jclsy) - end if - - tmp_qyla = chem_sub_old(k,iccy,jclsy,la) - if (lc > 0) then - tmp_qylc = chem_sub_old(k,iccy,jclsy,lc) - else - tmp_qylc = 0.0_r8 - end if - - if (ido_actres_tmp == 0) then - ! non aicw-aerosol species OR no activation or resuspension -! tmpa = tmpa + tmp_qyla*tmpd -! tmpc = tmpc + tmp_qylc*tmpd - tmp_del_ardzqa = tmp_qyla*tmpd - tmp_del_ardzqc = tmp_qylc*tmpd - - else if (ido_actres_tmp > 0) then - ! activation of (la+lc) - m = isize_of_aerosol(la) - n = itype_of_aerosol(la) - if (inmw_of_aerosol(la) == 1) then - tmp_fmnact = fnact_horz(m,n,jcls,iccy,jclsy,k) - else - tmp_fmnact = fmact_horz(m,n,jcls,iccy,jclsy,k) - end if - if (ido_actres_tmp == 2) then -! tmpa = tmpa + (tmp_qyla+tmp_qylc)*(1.0_r8-tmp_fmnact)*tmpd -! tmpc = tmpc + (tmp_qyla+tmp_qylc)*(tmp_fmnact )*tmpd - tmp_del_ardzqa = (tmp_qyla+tmp_qylc)*(1.0_r8-tmp_fmnact)*tmpd - tmp_del_ardzqc = (tmp_qyla+tmp_qylc)*(tmp_fmnact )*tmpd - else -! tmpa = tmpa + (tmp_qyla*(1.0_r8-tmp_fmnact) )*tmpd -! tmpc = tmpc + (tmp_qyla*tmp_fmnact + tmp_qylc)*tmpd - tmp_del_ardzqa = (tmp_qyla*(1.0_r8-tmp_fmnact) )*tmpd - tmp_del_ardzqc = (tmp_qyla*tmp_fmnact + tmp_qylc)*tmpd - end if - - else - ! resuspension of lc -! tmpa = tmpa + (tmp_qyla+tmp_qylc)*tmpd - tmp_del_ardzqa = (tmp_qyla+tmp_qylc)*tmpd - tmp_del_ardzqc = 0.0_r8 - - end if - tmpa = tmpa + tmp_del_ardzqa - if (lc > 0) & - tmpc = tmpc + tmp_del_ardzqc - -! change from activation/resuspension - tmp_del_ardzqa_act = tmp_del_ardzqa_act + (tmp_del_ardzqa - tmp_qyla*tmpd) - if (lc > 0) & - tmp_del_ardzqc_act = tmp_del_ardzqc_act + (tmp_del_ardzqc - tmp_qylc*tmpd) - end do ! iccy - end do ! jclsy - chem_sub_new(k,icc,jcls,la) = tmpa/ardz_cen_new(k,icc,jcls) - if (lc > 0) & - chem_sub_new(k,icc,jcls,lc) = tmpc/ardz_cen_new(k,icc,jcls) - -! change in mixing ratio (*fraction) from activation/resuspension - del_activate3d(k,icc,jcls,la) = del_activate3d(k,icc,jcls,la)+tmp_del_ardzqa_act/rhodz_cen(k) - if (lc > 0) & - del_activate3d(k,icc,jcls,lc) = del_activate3d(k,icc,jcls,lc)+tmp_del_ardzqc_act/rhodz_cen(k) - - end do main_la_loop - - end do main_k_loop - end do main_icc_loop - end do main_jcls_loop - - -! diagnostics - lun118 = -1 - if (idiag118_pt3 >= 10) lun118 = ldiagaa_ecpp(118) - if (lun118 > 0) then - l = 9 - icc = 1 - write(lun118,'(/a,2i5,a,3i5)') 'pt3 ppopt, ipass', parampollu_opt, & - ipass_area_change, ' ktau_pp, istep_sub, l =', ktau_pp, -1, l - write(lun118,'(2a)') '(chem_sub_old(k,icc,jcls,l), ', & - 'chem_sub_new(k,icc,jcls,l), jcls=1,3); up,dn,env a_cen_tmpa/tmpb' - do k = ktecen, kts, -1 - write(lun118,'(i3,1p,7(1x,2e10.3))') k, & - (chem_sub_old(k,icc,jcls,l), chem_sub_new(k,icc,jcls,l), jcls=1,3), & - (ardz_cen_old(k,icc,jcls)/rhodz_cen(k), ardz_cen_new(k,icc,jcls)/rhodz_cen(k), jcls=1,3) - end do - end if ! (lun118 > 0) - - - - return - end subroutine parampollu_tdx_area_change - - - -!----------------------------------------------------------------------- - subroutine parampollu_tdx_entdet_sub1( & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - ncls_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, ifrom_where, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - ardz_cen_old, ardz_cen_new, rhodz_cen, & - ent_airamt_tot, det_airamt_tot, & - ent_airamt, det_airamt ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_tdx_entdet_sub1 calculates -! the "horizontal exchange coefficients" associated with -! area changes or vertical mass fluxes -! -! the net (entrainment-detrainment) for each sub-class is -! obtained trivially -! determining where the entrainment comes from, and where -! the detrainment goes to, is much more involved -! -!----------------------------------------------------------------------- - - use module_data_radm2, only: epsilc - - use module_data_ecpp1 - - use module_ecpp_util, only: ecpp_error_fatal, ecpp_message - -! arguments - integer, intent(in) :: & - ktau, ktau_pp, & - it, jt, kts, ktebnd, ktecen - - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) - - real(r8), intent(in) :: dtstep, dtstep_pp -! dtstep - main model time step (s) -! dtstep_pp - time step (s) for "parameterized pollutants" calculations - - integer, intent(in) :: ncls_ecpp -! ncls_ecpp - number of ecpp transport classes in the grid column - - integer, intent(in) :: ifrom_where - integer, intent(in) :: ncls_use - - integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use - - real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - ardz_cen_old, ardz_cen_new - - real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen - - real(r8), intent(inout), dimension( 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - ent_airamt_tot, det_airamt_tot -! ent_airamt_tot(icc,jcls,k) is the total detrainment into layer k, -! sub-class icc, class jcls from all other sub-classes -! det_airamt_tot(icc,jcls,k) is the total detrainment from layer k, -! sub-class icc, class jcls to all other sub-classes -! units are (kg/m2) -! -! define entdet_net == ent_airamt_tot - det_airamt_tot -! for "area-change" ent/det, entdet_net = rho*dz*d(area) where -! d(area) is the fractional area change over the time-step -! for "vertical-transport" ent/det, entdet_net = d(mfbnd)*dtstep where -! d(mfbnd) is the change in vertical mass flux across a layer -! (mfbnd at layer top minus mfbnd at layer bottom) -! -! up and dndrafts -! in the current formulation, each draft either entrains or detrains -! at a given level, but not both simultaneously -! for incoming ent/det_airamt_tot, one will be >= 0 and the other will be =0 -! the outgoing ent/det_airamt_tot will be unchanged -! quiescent class -! the quiescent class can entrain and detrain simultaneously at a given level -! for incoming ent/det_airamt_tot, one will be >= 0 and will hold the -! net (entrainment-detrainment) -! the outgoing ent/det_airamt_tot can both be >0 -! - - real(r8), intent(out), & - dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - ent_airamt, det_airamt -! ent_airamt(iccaa,jclsaa,iccbb,jclsbb,k) is (positive) the entrainment amount -! into sub-class (iccaa,jclsaa,k) from sub-class (iccbb,jclsbb,k) -! det_airamt(iccaa,jclsaa,iccbb,jclsbb,k) is (positive) the detrainment amount -! from sub-class (iccaa,jclsaa,k) into sub-class (iccbb,jclsbb,k) -! units for both are (kg/m2) - - -! local variables - integer :: icc, iccy, itmpa - integer :: jcls, jclsy - integer :: jgrp, jgrpy, jgrp_of_jcls(1:maxcls_ecpp) - integer :: k - integer :: l, laa, lbb, lunaa, lunbb - integer :: m - - logical, dimension( 1:2, 1:maxcls_ecpp ) :: & - empty_old, empty_new, empty_oldnew - - real(r8) :: tmpa4, tmpb4 - - real(r8), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - ent_airamt_sv1, det_airamt_sv1 - real(r8), dimension( 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - ent_airamt_tot_sv0, det_airamt_tot_sv0, & - ent_airamt_tot_sv1, det_airamt_tot_sv1 - real(r8), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp ) :: & - ecls_aa, dcls_aa - real(r8), dimension( 1:2, 1:maxcls_ecpp ) :: & - ecls_aaunasi, dcls_aaunasi - real(r8), dimension( 1:2, 1:maxcls_ecpp ) :: & - dcls_aalimit - real(r8), dimension( 1:2, 1:3, 1:2, 1:3 ) :: & - egrp_aa, dgrp_aa - real(r8), dimension( 1:2, 1:3 ) :: & - egrp_aaunasi, dgrp_aaunasi - - real(r8), dimension( 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - ecls_aaunasi_sv2, dcls_aaunasi_sv2 - real(r8), dimension( 1:2, 1:3, kts:ktecen ) :: & - egrp_aaunasi_sv2, dgrp_aaunasi_sv2 - - integer, dimension(3), save :: & - ecls_aaunasi_worst_i=0, dcls_aaunasi_worst_i=0, & - ecls_aaunasi_worst_j=0, dcls_aaunasi_worst_j=0, & - ecls_aaunasi_worst_k=0, dcls_aaunasi_worst_k=0, & - ecls_aaunasi_worst_ktau=0, dcls_aaunasi_worst_ktau=0, & - egrp_aaunasi_worst_i=0, dgrp_aaunasi_worst_i=0, & - egrp_aaunasi_worst_j=0, dgrp_aaunasi_worst_j=0, & - egrp_aaunasi_worst_k=0, dgrp_aaunasi_worst_k=0, & - egrp_aaunasi_worst_ktau=0, dgrp_aaunasi_worst_ktau=0 - real(r8), dimension(3), save :: & - ecls_aaunasi_worst=0.0_r8, dcls_aaunasi_worst=0.0_r8, & - egrp_aaunasi_worst=0.0_r8, dgrp_aaunasi_worst=0.0_r8 - - real(r8) :: ardz_cut - real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf - real(r8) :: tmpmatbb(0:2,0:2) - real(r8) :: tmpmatff(1:2,1:2) - real(r8) :: tmpvecbb(0:maxcls_ecpp), tmpvecgg(0:maxcls_ecpp) - - -! diagnostics to fort.122 at selected timesteps - lunaa = -1 -! if ( (ktau <= 10) .or. & -! (ktau == 581) .or. & -! (ktau == 818) ) lunaa = 122 - if ( (ktau <= 10) .or. & - (ktau == 210) .or. & - (ktau == 682) ) lunaa = ldiagaa_ecpp(122) - if (idiagaa_ecpp(122) <= 0) lunaa = -1 - -! save the incoming values of ent/det_airamt_tot - ent_airamt_tot_sv0(:,:,:) = ent_airamt_tot(:,:,:) - det_airamt_tot_sv0(:,:,:) = det_airamt_tot(:,:,:) - -! -! do a very simple calculation that mimics previous code -! up and dndrafts entrain-from and detrain-too -! the quiescent class with the same icc -! (currently the simple calculation results are only used for diagnostic -! purposes, but turning them off would mess up the diagnostics.) -! - ent_airamt(:,:,:,:,:) = 0.0_r8 - det_airamt(:,:,:,:,:) = 0.0_r8 - -entdet_main_kloop_bb: & - do k = kts, ktecen - - do jcls = 1, ncls_use - do icc = 1, 2 - if (jcls == jcls_qu) cycle ! skip quiescent - - tmpa4 = ent_airamt_tot(icc,jcls,k) - if (tmpa4 > 0.0_r8) then - ent_airamt( icc,jcls, icc,jcls_qu, k) = tmpa4 - det_airamt( icc,jcls_qu, icc,jcls, k) = tmpa4 - end if - - tmpa4 = det_airamt_tot(icc,jcls,k) - if (tmpa4 > 0.0_r8) then - det_airamt( icc,jcls, icc,jcls_qu, k) = tmpa4 - ent_airamt( icc,jcls_qu, icc,jcls, k) = tmpa4 - end if - - end do ! icc - end do ! jcls - - end do entdet_main_kloop_bb - - - do k = kts, ktecen - - do jcls = 1, ncls_use - do icc = 1, 2 - tmpa4 = 0.0_r8 - tmpb4 = 0.0_r8 - if (k < ktebnd) then - do jclsy = 1, ncls_use - do iccy = 1, 2 - tmpa4 = tmpa4 + ent_airamt( icc,jcls, iccy,jclsy, k) - tmpb4 = tmpb4 + det_airamt( icc,jcls, iccy,jclsy, k) - end do - end do - end if - ent_airamt_tot(icc,jcls,k) = tmpa4 - det_airamt_tot(icc,jcls,k) = tmpb4 - end do ! icc - end do ! jcls - - end do ! k - - ent_airamt_sv1(:,:,:,:,:) = ent_airamt(:,:,:,:,:) - det_airamt_sv1(:,:,:,:,:) = det_airamt(:,:,:,:,:) - ent_airamt_tot_sv1(:,:,:) = ent_airamt_tot(:,:,:) - det_airamt_tot_sv1(:,:,:) = det_airamt_tot(:,:,:) -! end of simple calculation - - - -! -! -! do the full calculation of horizontal exchanges -! -! - -! reload the incoming values of ent/det_airamt_tot - ent_airamt_tot(:,:,:) = ent_airamt_tot_sv0(:,:,:) - det_airamt_tot(:,:,:) = det_airamt_tot_sv0(:,:,:) - -! calc the jgrp_of_jcls array - icc = 1 - do jcls = 1, ncls_use - if (mtype_updnenv_use(icc,jcls) == mtype_quiescn_ecpp) then - jgrp_of_jcls(jcls) = 1 - else if (mtype_updnenv_use(icc,jcls) == mtype_updraft_ecpp) then - jgrp_of_jcls(jcls) = 2 - else - jgrp_of_jcls(jcls) = 3 - end if - end do - if (lunaa > 0) write(lunaa,'(a,10(2x,2i3))') & - 'jcls and jgrp_of_cls', (jcls, jgrp_of_jcls(jcls), jcls=1,ncls_use) - - ent_airamt(:,:,:,:,:) = 0.0_r8 - det_airamt(:,:,:,:,:) = 0.0_r8 - - ecls_aaunasi_sv2(:,:,:) = 0.0_r8 - egrp_aaunasi_sv2(:,:,:) = 0.0_r8 - dcls_aaunasi_sv2(:,:,:) = 0.0_r8 - dgrp_aaunasi_sv2(:,:,:) = 0.0_r8 - - -entdet_main_kloop_aa: & - do k = kts, ktecen - - ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 - - empty_old(:,:) = .false. - empty_new(:,:) = .false. - empty_oldnew(:,:) = .false. - if (lunaa > 0) write(lunaa,'(/a)') 'k, jcls, emptyold/new/oldnew for icc=1 then icc=2' - do jcls = 1, ncls_use - do icc = 1, 2 - if (ardz_cen_old(k,icc,jcls) < ardz_cut) empty_old(icc,jcls) = .true. - if (ardz_cen_new(k,icc,jcls) < ardz_cut) empty_new(icc,jcls) = .true. - empty_oldnew(icc,jcls) = empty_old(icc,jcls) .and. empty_new(icc,jcls) - end do - if (lunaa > 0) write(lunaa,'(2i3,2(3x,3l3))') k, jcls, & - (empty_old(icc,jcls), empty_new(icc,jcls), empty_oldnew(icc,jcls), icc=1,2) - end do - - if (lunaa > 0) then - write(lunaa,'(/a,1p,10e16.8)') 'ardz_cut,rdz', ardz_cut, rhodz_cen(k) - write(lunaa,'( a,1p,10e16.8)') 'ardz_cen_old', ardz_cen_old(k,0,0), ardz_cen_old(k,1:2,1:3) - write(lunaa,'( a,1p,10e16.8)') 'ardz_cen_new', ardz_cen_new(k,0,0), ardz_cen_new(k,1:2,1:3) - write(lunaa,'( a,1p,10e16.8)') 'new-old ', (ardz_cen_new(k,0,0)-ardz_cen_new(k,0,0)), & - (ardz_cen_new(k,1:2,1:3)-ardz_cen_old(k,1:2,1:3)) - tmpa = 1.0_r8/rhodz_cen(k) - tmpb = sum( ardz_cen_old(k,1:2,1:3) ) - tmpc = sum( ardz_cen_new(k,1:2,1:3) ) - write(lunaa,'( a,1p,10e16.8)') 'area_cen_old', tmpa*tmpb, tmpa*ardz_cen_old(k,1:2,1:3) - write(lunaa,'( a,1p,10e16.8)') 'area_cen_new', tmpa*tmpc, tmpa*ardz_cen_new(k,1:2,1:3) - write(lunaa,'( a,1p,10e16.8)') 'new-old ', tmpa*(tmpc-tmpb), & - tmpa*(ardz_cen_new(k,1:2,1:3)-ardz_cen_old(k,1:2,1:3)) - write(lunaa,'( a/1p,4(1x,3e11.3))') 'ardz_cen_old(0:2,0:3)', ardz_cen_old(k,0:2,0:3) - write(lunaa,'( a/1p,4(1x,3e11.3))') 'ardz_cen_new(0:2,0:3)', ardz_cen_new(k,0:2,0:3) - end if - - -! step 1 -! initialize class and group "assigned" ent/det arrays to zero -! initialize class "unassigned" ent/det arrays to ent/det_airamt_tot -! calc group "unassigned" arrays by summing over classes -! -! *************************************************************** -! should check here that total ent = total det (with very small error allowed) -! then adjust them to be even closer -! *************************************************************** - ecls_aa(:,:,:,:) = 0.0_r8 - dcls_aa(:,:,:,:) = 0.0_r8 - egrp_aa(:,:,:,:) = 0.0_r8 - dgrp_aa(:,:,:,:) = 0.0_r8 - egrp_aaunasi( :,:) = 0.0_r8 - dgrp_aaunasi( :,:) = 0.0_r8 - do jcls = 1, ncls_use - do icc = 1, 2 - ecls_aaunasi(icc,jcls) = ent_airamt_tot(icc,jcls,k) - dcls_aaunasi(icc,jcls) = det_airamt_tot(icc,jcls,k) - jgrp = jgrp_of_jcls(jcls) - egrp_aaunasi(icc,jgrp) = egrp_aaunasi(icc,jgrp) + ecls_aaunasi(icc,jcls) - dgrp_aaunasi(icc,jgrp) = dgrp_aaunasi(icc,jgrp) + dcls_aaunasi(icc,jcls) - if (ifrom_where < 10) then - ! for area-change, detrainment is limited to initial subarea mass - dcls_aalimit(icc,jcls) = ardz_cen_old(k,icc,jcls) - else - dcls_aalimit(icc,jcls) = 1.0e30_r8 - end if - end do - end do - call parampollu_tdx_entdet_diag01( & - 1, lunaa, & - ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & - ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & - det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & - dcls_aalimit ) - - -! step 2 -! for up and dndrafts, if cloudy is entraining and clear is detraining -! (or vice-versa), then assign as much as possible of the ent/det -! as "clear up/dndraft" <--> "cloudy up/dndraft" - do jcls = 1, ncls_use - if (jcls == jcls_qu) cycle - jgrp = jgrp_of_jcls(jcls) - jclsy = jcls - jgrpy = jgrp_of_jcls(jclsy) - do icc = 1, 2 - iccy = 3 - icc - if ( empty_old(icc ,jcls ) ) cycle - if ( empty_new(iccy,jclsy) ) cycle - tmpa = min( dcls_aaunasi(icc,jcls), ecls_aaunasi(iccy,jcls) ) - if (tmpa > 0.0_r8) then - dcls_aaunasi(icc ,jcls ) = dcls_aaunasi(icc ,jcls ) - tmpa - ecls_aaunasi(iccy,jclsy) = ecls_aaunasi(iccy,jclsy) - tmpa - dcls_aalimit(icc ,jcls ) = dcls_aalimit(icc ,jcls ) - tmpa - dcls_aa(icc ,jcls ,iccy,jclsy) = dcls_aa(icc ,jcls ,iccy,jclsy) + tmpa - ecls_aa(iccy,jclsy,icc ,jcls ) = ecls_aa(iccy,jclsy,icc ,jcls ) + tmpa - - dgrp_aaunasi(icc ,jgrp ) = dgrp_aaunasi(icc ,jgrp ) - tmpa - egrp_aaunasi(iccy,jgrpy) = egrp_aaunasi(iccy,jgrpy) - tmpa - dgrp_aa(icc ,jgrp ,iccy,jgrpy) = dgrp_aa(icc ,jgrp ,iccy,jgrpy) + tmpa - egrp_aa(iccy,jgrpy,icc ,jgrp ) = egrp_aa(iccy,jgrpy,icc ,jgrp ) + tmpa - end if - end do ! icc - end do ! jcls - call parampollu_tdx_entdet_diag01( & - 2, lunaa, & - ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & - ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & - det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & - dcls_aalimit ) - - -! step 3 -! for up and dndraft detrainment, assign as much as possible of the det -! as "clear up/dndraft" <--> "clear quiescent" -! and "cloudy up/dndraft" <--> "cloudy quiescent" - do icc = 1, 2 - iccy = icc - jclsy = jcls_qu - jgrpy = jgrp_of_jcls(jclsy) - - ! tmpb = unassigned detrain from all up/dndraft - tmpb = dgrp_aaunasi(icc,2) + dgrp_aaunasi(icc,3) - ! tmpc = portion of tmpb that will be assigned in this step - tmpc = min( tmpb, egrp_aaunasi(icc,1) ) - if (tmpc <= 0.0_r8) cycle - - do jcls = 1, ncls_use - if (jcls == jcls_qu) cycle - if ( empty_old(icc ,jcls ) ) cycle - if ( empty_new(iccy,jclsy) ) cycle - jgrp = jgrp_of_jcls(jcls ) - - ! tmpf is fraction of total-unassigned-draft detrainment due to this jcls - tmpf = min( dcls_aaunasi(icc,jcls), tmpb ) / max( 1.0e-30_r8, tmpb ) - ! tmpa is portion of tmpc applied to this jcls - tmpa = tmpf*tmpc - tmpa = min( tmpa, dcls_aaunasi(icc ,jcls ), ecls_aaunasi(iccy,jclsy) ) - if (tmpa > 0.0_r8) then - dcls_aaunasi(icc ,jcls ) = dcls_aaunasi(icc ,jcls ) - tmpa - ecls_aaunasi(iccy,jclsy) = ecls_aaunasi(iccy,jclsy) - tmpa - dcls_aalimit(icc ,jcls ) = dcls_aalimit(icc ,jcls ) - tmpa - dcls_aa(icc ,jcls ,iccy,jclsy) = dcls_aa(icc ,jcls ,iccy,jclsy) + tmpa - ecls_aa(iccy,jclsy,icc ,jcls ) = ecls_aa(iccy,jclsy,icc ,jcls ) + tmpa - - dgrp_aaunasi(icc ,jgrp ) = dgrp_aaunasi(icc ,jgrp ) - tmpa - egrp_aaunasi(iccy,jgrpy) = egrp_aaunasi(iccy,jgrpy) - tmpa - dgrp_aa(icc ,jgrp ,iccy,jgrpy) = dgrp_aa(icc ,jgrp ,iccy,jgrpy) + tmpa - egrp_aa(iccy,jgrpy,icc ,jgrp ) = egrp_aa(iccy,jgrpy,icc ,jgrp ) + tmpa - end if - end do ! icc - end do ! jcls - call parampollu_tdx_entdet_diag01( & - 3, lunaa, & - ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & - ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & - det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & - dcls_aalimit ) - - -! step 4 -! for up and dndraft detrainment, assign any remaining detrainment to -! quiescent based on the clear/cloudy quiescent areas - - ! tmpvecgg(1) = fraction of quiescent class that is clear (using new areas) - tmpvecgg(1) = ardz_cen_new(k,1,jcls_qu)/ardz_cen_new(k,0,jcls_qu) - tmpvecgg(1) = max( 0.0_r8, min( 1.0_r8, tmpvecgg(1) ) ) - ! tmpvecgg(2) = fraction of quiescent class that is cloudy (using new areas) - tmpvecgg(2) = 1.0_r8 - tmpvecgg(1) - tmpvecgg(2) = max( 0.0_r8, min( 1.0_r8, tmpvecgg(2) ) ) - - ! tmpmatbb(0,0) = unassigned detrain from all up/dndraft - ! tmpmatbb(1,0) = portion of tmpmatbb(0,0) from clear draft to all quiescent - tmpmatbb(1,0) = sum( dgrp_aaunasi(1,2:3) ) - ! tmpmatbb(2,0) = portion of tmpmatbb(0,0) from cloudy draft to all quiescent - tmpmatbb(2,0) = sum( dgrp_aaunasi(2,2:3) ) - tmpmatbb(0,0) = tmpmatbb(1,0) + tmpmatbb(2,0) - - if (tmpmatbb(0,0) > 1.0e-30_r8) then - - ! tmpmatbb(0,1) = portion of tmpmatbb(0,0) from all draft to clear quiescent - ! tmpmatbb(0,2) = portion of tmpmatbb(0,0) from all draft to cloudy quiescent - tmpmatbb(0,1:2) = tmpmatbb(0,0)*tmpvecgg(1:2) - - ! this step can drive the ecls_aaunasi of a quiescent negative, - ! and the negative entrainment gets converted to positive detrainment - ! (from one quiescent subarea to the other) - ! when doing area-change, check that this will not make - ! dcls_aaunasi exceed dcls_aalimit - if (ifrom_where < 10) then - tmpvecbb(1:2) = tmpmatbb(0,1:2) - jclsy = jcls_qu - do iccy = 2, 1, -1 - if (tmpvecbb(iccy) > ecls_aaunasi(iccy,jclsy)) then - tmpd = dcls_aaunasi(iccy,jclsy) & - + (tmpvecbb(iccy) - ecls_aaunasi(iccy,jclsy)) - if (tmpd > dcls_aalimit(iccy,jclsy)) then - tmpvecbb(iccy) = tmpvecbb(iccy) & - - (tmpd - dcls_aalimit(iccy,jclsy)) - tmpvecbb(iccy) = max( 0.0_r8, tmpvecbb(iccy) ) - tmpvecbb(3-iccy) = tmpmatbb(0,0) - tmpvecbb(iccy) - end if - end if - end do - tmpmatbb(0,1:2) = tmpvecbb(1:2) - end if - - ! tmpmatbb(1,1) = portion of tmpmatbb(0,0) from clear draft to clear quiescent - tmpmatbb(1,1) = min( tmpmatbb(0,1), tmpmatbb(1,0) ) - ! tmpmatbb(1,2) = portion of tmpmatbb(0,0) from clear draft to cloudy quiescent - tmpmatbb(1,2) = max( 0.0_r8, (tmpmatbb(1,0) - tmpmatbb(1,1)) ) - - ! tmpmatbb(2,2) = portion of tmpmatbb(0,0) from cloudy draft to cloudy quiescent - tmpmatbb(2,2) = min( tmpmatbb(0,2), tmpmatbb(2,0) ) - ! tmpmatbb(2,1) = portion of tmpmatbb(0,0) from cloudy draft to clear quiescent - tmpmatbb(2,1) = max( 0.0_r8, (tmpmatbb(2,0) - tmpmatbb(2,2)) ) - - tmpmatff(1,2) = tmpmatbb(1,2) / max( 1.0e-37_r8, tmpmatbb(1,0) ) - tmpmatff(1,2) = max( 0.0_r8, min( 1.0_r8, tmpmatff(1,2) ) ) - tmpmatff(1,1) = 1.0_r8 - tmpmatff(1,2) - tmpmatff(1,1) = max( 0.0_r8, min( 1.0_r8, tmpmatff(1,1) ) ) - - tmpmatff(2,2) = tmpmatbb(2,2) / max( 1.0e-37_r8, tmpmatbb(2,0) ) - tmpmatff(2,2) = max( 0.0_r8, min( 1.0_r8, tmpmatff(2,2) ) ) - tmpmatff(2,1) = 1.0_r8 - tmpmatff(2,2) - tmpmatff(2,1) = max( 0.0_r8, min( 1.0_r8, tmpmatff(2,1) ) ) - -! *** now need to apply these *** - do jcls = 1, ncls_use - if (jcls == jcls_qu) cycle ! do jcls - jgrp = jgrp_of_jcls(jcls) - jclsy = jcls_qu - jgrpy = jgrp_of_jcls(jclsy) - do icc = 1, 2 - tmpc = dcls_aaunasi(icc,jcls) - if (tmpc <= 0.0_r8) cycle ! do icc - - do iccy = 1, 2 - if ( empty_old(icc,jcls) ) cycle ! do iccy - if ( empty_new(iccy,jclsy) ) cycle ! do iccy - - tmpa = tmpmatff(icc,iccy) * tmpc - if (tmpa <= 0.0_r8) cycle ! do iccy - - dcls_aaunasi(icc ,jcls ) = dcls_aaunasi(icc ,jcls ) - tmpa - ecls_aaunasi(iccy,jclsy) = ecls_aaunasi(iccy,jclsy) - tmpa - dcls_aalimit(icc ,jcls ) = dcls_aalimit(icc ,jcls ) - tmpa - dcls_aa(icc ,jcls ,iccy,jclsy) = dcls_aa(icc ,jcls ,iccy,jclsy) + tmpa - ecls_aa(iccy,jclsy,icc ,jcls ) = ecls_aa(iccy,jclsy,icc ,jcls ) + tmpa - - dgrp_aaunasi(icc ,jgrp ) = dgrp_aaunasi(icc ,jgrp ) - tmpa - egrp_aaunasi(iccy,jgrpy) = egrp_aaunasi(iccy,jgrpy) - tmpa - dgrp_aa(icc ,jgrp ,iccy,jgrpy) = dgrp_aa(icc ,jgrp ,iccy,jgrpy) + tmpa - egrp_aa(iccy,jgrpy,icc ,jgrp ) = egrp_aa(iccy,jgrpy,icc ,jgrp ) + tmpa - - ! if unassigned entrainment from quiescent goes negative, - ! convert this to positive unassigned detrainment - if (ecls_aaunasi(iccy,jclsy) < 0.0_r8) then - dcls_aaunasi(iccy,jclsy) = dcls_aaunasi(iccy,jclsy) - ecls_aaunasi(iccy,jclsy) - ecls_aaunasi(iccy,jclsy) = 0.0_r8 - end if - if (egrp_aaunasi(iccy,jgrpy) < 0.0_r8) then - dgrp_aaunasi(iccy,jgrpy) = dgrp_aaunasi(iccy,jgrpy) - egrp_aaunasi(iccy,jgrpy) - egrp_aaunasi(iccy,jgrpy) = 0.0_r8 - end if - end do ! iccy - end do ! icc - end do ! jcls - - end if ! (tmpmatbb(0,0) > 1.0e-30_r8) - call parampollu_tdx_entdet_diag01( & - 4, lunaa, & - ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & - ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & - det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & - dcls_aalimit ) - - -! step 5 -! up and dndraft entrainment -! do this in a much simpler manner -! all up and dndraft entrainment comes from quiescent -! contributions from clear and cloudy quiescent are proportional to -! their fractional areas (tmpvecgg(1) & tmpvecgg(2)) - ! tmpvecgg(1) = fraction of quiescent class that is clear (using old areas) - tmpvecgg(1) = ardz_cen_old(k,1,jcls_qu)/ardz_cen_old(k,0,jcls_qu) - tmpvecgg(1) = max( 0.0_r8, min( 1.0_r8, tmpvecgg(1) ) ) - ! tmpvecgg(2) = fraction of quiescent class that is cloudy (using old areas) - tmpvecgg(2) = 1.0_r8 - tmpvecgg(1) - tmpvecgg(2) = max( 0.0_r8, min( 1.0_r8, tmpvecgg(2) ) ) - - jclsy = jcls_qu - jgrpy = jgrp_of_jcls(jclsy) - - ! when doing area-change, check that this will not make - ! dcls_aalimit negative for either quiescent subarea - if (ifrom_where < 10) then - ! total unassigned entrainment to up/dndrafts - tmpa = sum( egrp_aaunasi(1:2,2:3) ) - ! amount of detrainment that will come from quiescent iccy=1,2 - tmpvecbb(1:2) = tmpa*tmpvecgg(1:2) - jclsy = jcls_qu - do iccy = 2, 1, -1 - if (tmpvecbb(iccy) > dcls_aalimit(iccy,jclsy)) then - tmpvecbb(iccy) = dcls_aalimit(iccy,jclsy) - tmpvecbb(3-iccy) = tmpa - tmpvecbb(iccy) - end if - end do - tmpvecgg(2) = tmpvecbb(2)/max( 1.0e-37_r8, tmpa ) - tmpvecgg(2) = max( 0.0_r8, min( 1.0_r8, tmpvecgg(2) ) ) - tmpvecgg(1) = 1.0_r8 - tmpvecgg(2) - tmpvecgg(1) = max( 0.0_r8, min( 1.0_r8, tmpvecgg(1) ) ) - end if - - do jcls = 1, ncls_use - do icc = 1, 2 - iccy = 0 - if (jcls == jcls_qu) cycle - if ( empty_new(icc ,jcls ) ) cycle - jgrp = jgrp_of_jcls(jcls ) - - ! tmpa is unassigned-draft entrainment due to this icc,jcls - tmpa = ecls_aaunasi(icc,jcls) - if (tmpa > 0.0_r8) then - do iccy = 1, 2 - if ( empty_old(iccy,jclsy) ) cycle - if (tmpvecgg(iccy) <= 0.0_r8) cycle - ! tmpb is portion of tmpa coming from iccy,jclsy - tmpb = tmpa*tmpvecgg(iccy) - - ecls_aaunasi(icc ,jcls ) = ecls_aaunasi(icc ,jcls ) - tmpb - dcls_aaunasi(iccy,jclsy) = dcls_aaunasi(iccy,jclsy) - tmpb - dcls_aalimit(iccy,jclsy) = dcls_aalimit(iccy,jclsy) - tmpb - ecls_aa(icc ,jcls ,iccy,jclsy) = ecls_aa(icc ,jcls ,iccy,jclsy) + tmpb - dcls_aa(iccy,jclsy,icc ,jcls ) = dcls_aa(iccy,jclsy,icc ,jcls ) + tmpb - - egrp_aaunasi(icc ,jgrp ) = egrp_aaunasi(icc ,jgrp ) - tmpb - dgrp_aaunasi(iccy,jgrpy) = dgrp_aaunasi(iccy,jgrpy) - tmpb - egrp_aa(icc ,jgrp ,iccy,jgrpy) = egrp_aa(icc ,jgrp ,iccy,jgrpy) + tmpb - dgrp_aa(iccy,jgrpy,icc ,jgrp ) = dgrp_aa(iccy,jgrpy,icc ,jgrp ) + tmpb - - ! if unassigned detrainment from quiescent goes negative, - ! convert this to positive unassigned entrainment - if (dcls_aaunasi(iccy,jclsy) < 0.0_r8) then - ecls_aaunasi(iccy,jclsy) = ecls_aaunasi(iccy,jclsy) - dcls_aaunasi(iccy,jclsy) - dcls_aaunasi(iccy,jclsy) = 0.0_r8 - end if - if (dgrp_aaunasi(iccy,jgrpy) < 0.0_r8) then - egrp_aaunasi(iccy,jgrpy) = egrp_aaunasi(iccy,jgrpy) - dgrp_aaunasi(iccy,jgrpy) - dgrp_aaunasi(iccy,jgrpy) = 0.0_r8 - end if - end do ! iccy - end if ! (tmpa > 0.0) - end do ! icc - end do ! jcls - call parampollu_tdx_entdet_diag01( & - 5, lunaa, & - ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & - ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & - det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & - dcls_aalimit ) - - -! step 6 -! quiescent clear <--> quiescent cloudy exchanges -! if clear is detraining and cloudy is entraining, then assign as much as -! possible of the det/ent as "clear quiescent" --> "cloudy quiescent" -! if cloudy is detraining and clear is entraining, then assign as much as -! possible of the det/ent as "cloudy quiescent" --> "clear quiescent" - do jcls = 1, ncls_use - if (jcls /= jcls_qu) cycle - jgrp = jgrp_of_jcls(jcls) - jclsy = jcls - jgrpy = jgrp_of_jcls(jclsy) - do icc = 1, 2 - iccy = 3 - icc - if ( empty_old(icc ,jcls ) ) cycle - if ( empty_new(iccy,jclsy) ) cycle - tmpa = min( dcls_aaunasi(icc,jcls), ecls_aaunasi(iccy,jcls) ) - if (tmpa > 0.0_r8) then - dcls_aaunasi(icc ,jcls ) = dcls_aaunasi(icc ,jcls ) - tmpa - ecls_aaunasi(iccy,jclsy) = ecls_aaunasi(iccy,jclsy) - tmpa - dcls_aa(icc ,jcls ,iccy,jclsy) = dcls_aa(icc ,jcls ,iccy,jclsy) + tmpa - ecls_aa(iccy,jclsy,icc ,jcls ) = ecls_aa(iccy,jclsy,icc ,jcls ) + tmpa - - dgrp_aaunasi(icc ,jgrp ) = dgrp_aaunasi(icc ,jgrp ) - tmpa - egrp_aaunasi(iccy,jgrpy) = egrp_aaunasi(iccy,jgrpy) - tmpa - dgrp_aa(icc ,jgrp ,iccy,jgrpy) = dgrp_aa(icc ,jgrp ,iccy,jgrpy) + tmpa - egrp_aa(iccy,jgrpy,icc ,jgrp ) = egrp_aa(iccy,jgrpy,icc ,jgrp ) + tmpa - end if - end do ! icc - end do ! jcls - call parampollu_tdx_entdet_diag01( & - 6, lunaa, & - ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & - ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & - det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & - dcls_aalimit ) - - - -! load the current-k ent/det values for each class into ent/det_airamt - ent_airamt(:,:,:,:,k) = ecls_aa(:,:,:,:) - det_airamt(:,:,:,:,k) = dcls_aa(:,:,:,:) - - ecls_aaunasi_sv2(:,:,k) = ecls_aaunasi(:,:) - egrp_aaunasi_sv2(:,:,k) = egrp_aaunasi(:,:) - dcls_aaunasi_sv2(:,:,k) = dcls_aaunasi(:,:) - dgrp_aaunasi_sv2(:,:,k) = dgrp_aaunasi(:,:) - - -! calc largest unassigned ent/det - m = 1 - if (ifrom_where == 10) m = 2 - if (ifrom_where == 2) m = 3 - do jcls = 1, ncls_use - do icc = 1, 2 - if (abs(ecls_aaunasi(icc,jcls)) > abs(ecls_aaunasi_worst(m))) then - ecls_aaunasi_worst(m) = ecls_aaunasi(icc,jcls) - ecls_aaunasi_worst_i(m) = icc - ecls_aaunasi_worst_j(m) = jcls - ecls_aaunasi_worst_k(m) = k - ecls_aaunasi_worst_ktau(m) = ktau - end if - if (abs(dcls_aaunasi(icc,jcls)) > abs(dcls_aaunasi_worst(m))) then - dcls_aaunasi_worst(m) = dcls_aaunasi(icc,jcls) - dcls_aaunasi_worst_i(m) = icc - dcls_aaunasi_worst_j(m) = jcls - dcls_aaunasi_worst_k(m) = k - dcls_aaunasi_worst_ktau(m) = ktau - end if - jgrp = jcls - if (jgrp > 3) cycle - if (abs(egrp_aaunasi(icc,jgrp)) > abs(egrp_aaunasi_worst(m))) then - egrp_aaunasi_worst(m) = egrp_aaunasi(icc,jgrp) - egrp_aaunasi_worst_i(m) = icc - egrp_aaunasi_worst_j(m) = jgrp - egrp_aaunasi_worst_k(m) = k - egrp_aaunasi_worst_ktau(m) = ktau - end if - if (abs(dgrp_aaunasi(icc,jgrp)) > abs(dgrp_aaunasi_worst(m))) then - dgrp_aaunasi_worst(m) = dgrp_aaunasi(icc,jgrp) - dgrp_aaunasi_worst_i(m) = icc - dgrp_aaunasi_worst_j(m) = jgrp - dgrp_aaunasi_worst_k(m) = k - dgrp_aaunasi_worst_ktau(m) = ktau - end if - end do - end do - - - - end do entdet_main_kloop_aa - - -! now calc ent/det_airamt_tot - do k = kts, ktecen - - do jcls = 1, ncls_use - do icc = 1, 2 - tmpa = 0.0_r8 - tmpb = 0.0_r8 - if (k < ktebnd) then - do jclsy = 1, ncls_use - do iccy = 1, 2 - tmpa = tmpa + ent_airamt( icc,jcls, iccy,jclsy, k) - tmpb = tmpb + det_airamt( icc,jcls, iccy,jclsy, k) - end do - end do - end if - ent_airamt_tot(icc,jcls,k) = tmpa - det_airamt_tot(icc,jcls,k) = tmpb - end do ! icc - end do ! jcls - - end do ! k - - -! diagnostic output - if (lunaa > 0) then - do k = kts, ktecen - - write(lunaa,'(/a,3i5)') 'bb parampollu_tdx_entdet_sub1 - ktau, ifrom_where, k', ktau, ifrom_where, k - - write(lunaa,'(a)') 'ent_airamt_tot simple/full' - write(lunaa,'(1p,10e11.3)') ent_airamt_tot_sv1(1:2,1:ncls_use,k) - write(lunaa,'(1p,10e11.3)') ent_airamt_tot( 1:2,1:ncls_use,k) - do jcls = 1, ncls_use - write(lunaa,'(a,i3,a,i3)') 'ent_airamt simple/full for icc,jcls= 1', jcls, ' and 2', jcls - write(lunaa,'(1p,6e11.3,4x,6e11.3)') (ent_airamt_sv1(icc,jcls,1:2,1:ncls_use,k), icc=1,2) - write(lunaa,'(1p,6e11.3,4x,6e11.3)') (ent_airamt( icc,jcls,1:2,1:ncls_use,k), icc=1,2) - end do - - write(lunaa,'(a)') 'det_airamt_tot simple/full' - write(lunaa,'(1p,10e11.3)') det_airamt_tot_sv1(1:2,1:ncls_use,k) - write(lunaa,'(1p,10e11.3)') det_airamt_tot( 1:2,1:ncls_use,k) - do jcls = 1, ncls_use - write(lunaa,'(a,i3,a,i3)') 'det_airamt simple/full for icc,jcls= 1', jcls, ' and 2', jcls - write(lunaa,'(1p,6e11.3,4x,6e11.3)') (det_airamt_sv1(icc,jcls,1:2,1:ncls_use,k), icc=1,2) - write(lunaa,'(1p,6e11.3,4x,6e11.3)') (det_airamt( icc,jcls,1:2,1:ncls_use,k), icc=1,2) - end do - - write(lunaa,'(a)') 'final ecls_aaunasi & egrp_aaunasi // final dcls_aaunasi & dgrp_aaunasi' - write(lunaa,'(1p,6e11.3,4x,6e11.3)') ecls_aaunasi_sv2(1:2,1:ncls_use,k), egrp_aaunasi_sv2(1:2,1:3,k) - write(lunaa,'(1p,6e11.3,4x,6e11.3)') dcls_aaunasi_sv2(1:2,1:ncls_use,k), dgrp_aaunasi_sv2(1:2,1:3,k) - - end do ! k = kts, kte - end if ! (lunaa > 0) - - - lunbb = -1 - if ((parampollu_opt == 2223) .and. (ifrom_where == 2)) lunbb = ldiagaa_ecpp(123) - if ((parampollu_opt == 2220) .and. (ifrom_where == 10)) lunbb = ldiagaa_ecpp(123) - lunbb = ldiagaa_ecpp(123) - if (idiagaa_ecpp(123) <= 0) lunbb = -1 - - if (lunbb > 0) then - write(lunbb,'(/a,3i5)') 'parampollu_tdx_entdet_sub1 - ktau, ifrom_where', ktau, ifrom_where - - do m = 1, 3 - write(lunbb,'(a,i3)') 'm =', m - write(lunbb,'(a,2(3x,3i3,i5,1p,e11.3))') & - 'ecls_aaunasi_worst i/j/k/ktau/val & dcls', & - ecls_aaunasi_worst_i(m), ecls_aaunasi_worst_j(m), ecls_aaunasi_worst_k(m), & - ecls_aaunasi_worst_ktau(m), ecls_aaunasi_worst(m), & - dcls_aaunasi_worst_i(m), dcls_aaunasi_worst_j(m), dcls_aaunasi_worst_k(m), & - dcls_aaunasi_worst_ktau(m), dcls_aaunasi_worst(m) - write(lunbb,'(a,2(3x,3i3,i5,1p,e11.3))') & - 'egrp_aaunasi_worst i/j/k/ktau/val & dgrp', & - egrp_aaunasi_worst_i(m), egrp_aaunasi_worst_j(m), egrp_aaunasi_worst_k(m), & - egrp_aaunasi_worst_ktau(m), egrp_aaunasi_worst(m), & - dgrp_aaunasi_worst_i(m), dgrp_aaunasi_worst_j(m), dgrp_aaunasi_worst_k(m), & - dgrp_aaunasi_worst_ktau(m), dgrp_aaunasi_worst(m) - end do - - end if ! (lunbb > 0) - - -! restore saved values -! ent_airamt(:,:,:,:,:) = ent_airamt_sv1(:,:,:,:,:) -! det_airamt(:,:,:,:,:) = det_airamt_sv1(:,:,:,:,:) -! ent_airamt_tot(:,:,:) = ent_airamt_tot_sv1(:,:,:) -! det_airamt_tot(:,:,:) = det_airamt_tot_sv1(:,:,:) - - - return - end subroutine parampollu_tdx_entdet_sub1 - - - -!----------------------------------------------------------------------- - subroutine parampollu_tdx_entdet_diag01( & - istep, lun, & - ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use, & - ent_airamt_tot_sv1, ecls_aa, ecls_aaunasi, egrp_aa, egrp_aaunasi, & - det_airamt_tot_sv1, dcls_aa, dcls_aaunasi, dgrp_aa, dgrp_aaunasi, & - dcls_aalimit ) - - use module_data_ecpp1 - - integer :: istep, lun, ifrom_where, ktau, k, kts, ktebnd, ktecen, ncls_use - real(r8), dimension( 1:2, 1:maxcls_ecpp, kts:ktecen ) :: & - ent_airamt_tot_sv1, det_airamt_tot_sv1 - real(r8), dimension( 1:2, 1:maxcls_ecpp, 1:2, 1:maxcls_ecpp ) :: & - ecls_aa, dcls_aa - real(r8), dimension( 1:2, 1:maxcls_ecpp ) :: & - ecls_aaunasi, dcls_aaunasi, dcls_aalimit - real(r8), dimension( 1:2, 1:3, 1:2, 1:3 ) :: & - egrp_aa, dgrp_aa - real(r8), dimension( 1:2, 1:3 ) :: & - egrp_aaunasi, dgrp_aaunasi - - integer :: icc, jcls - - if (lun <= 0) return - - write(lun,'(/a,i1,a,3i5)') 'aa', istep, ' parampollu_tdx_entdet_sub1 - ktau, ifrom_where, k', ktau, ifrom_where, k - - write(lun,'(/i3,a)') istep, '=istep - ent_airamt_tot_sv1' - write(lun,'(1p,10e16.8)') ent_airamt_tot_sv1(1:2,1:ncls_use,k) - write(lun,'(i3,a)') istep, '=istep - ecls_aaunasi after' - write(lun,'(1p,10e16.8)') ecls_aaunasi(1:2,1:ncls_use) - write(lun,'(i3,a)') istep, '=istep - egrp_aaunasi after' - write(lun,'(1p,10e16.8)') egrp_aaunasi(1:2,1:3) - do jcls = 1, ncls_use - write(lun,'(i3,a,i3,a,i3)') istep, '=istep - ecls_aa after for icc,jcls= 1', jcls, ' and 2', jcls - write(lun,'(1p,6e16.8)') (ecls_aa(icc,jcls,1:2,1:ncls_use), icc=1,2) - if (jcls > 3) cycle - write(lun,'(i3,a,i3,a,i3)') istep, '=istep - egrp_aa after for icc,jcls= 1', jcls, ' and 2', jcls - write(lun,'(1p,6e16.8)') (egrp_aa(icc,jcls,1:2,1:3), icc=1,2) - end do - - write(lun,'(/i3,a)') istep, '=istep - det_airamt_tot_sv1' - write(lun,'(1p,10e16.8)') det_airamt_tot_sv1(1:2,1:ncls_use,k) - write(lun,'(i3,a)') istep, '=istep - dcls_aalimit after' - write(lun,'(1p,10e16.8)') dcls_aalimit(1:2,1:ncls_use) - write(lun,'(i3,a)') istep, '=istep - dcls_aaunasi after' - write(lun,'(1p,10e16.8)') dcls_aaunasi(1:2,1:ncls_use) - write(lun,'(i3,a)') istep, '=istep - dgrp_aaunasi after' - write(lun,'(1p,10e16.8)') dgrp_aaunasi(1:2,1:3) - do jcls = 1, ncls_use - write(lun,'(i3,a,i3,a,i3)') istep, '=istep - dcls_aa after for icc,jcls= 1', jcls, ' and 2', jcls - write(lun,'(1p,6e16.8)') (dcls_aa(icc,jcls,1:2,1:ncls_use), icc=1,2) - if (jcls > 3) cycle - write(lun,'(i3,a,i3,a,i3)') istep, '=istep - dgrp_aa after for icc,jcls= 1', jcls, ' and 2', jcls - write(lun,'(1p,6e16.8)') (dgrp_aa(icc,jcls,1:2,1:3), icc=1,2) - end do - - return - end subroutine parampollu_tdx_entdet_diag01 - -!----------------------------------------------------------------------- - subroutine set_of_aerosol_stuff(is_aerosol, & - iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & - inmw_of_aerosol, laicwpair_of_aerosol ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! sets following arrays -! -! is_aerosol : logical variable, whether it is an aeroosl speices or not -! -! iphase_of_aerosol(l) = 0 for non-aerosol species -! = ai/cw/..._phase for aerosol species -! isize_of_aerosol(l) = 0 for non-aerosol species -! = size/bin index for aerosol species -! itype_of_aerosol(l) = 0 for non-aerosol species -! = type index for aerosol species -! inmw_of_aerosol(l) = 0 for non-aerosol species -! = 1/2/3 for aerosol number/mass/water species -! laicwpair_of_aerosol(l) = -999888777 for non-aerosol species -! = species index of corresponding ai/cw species -! -!----------------------------------------------------------------------- - -! use module_configure, only: chem_dname_table - - use module_data_ecpp1, only: num_chem_ecpp, param_first_ecpp - - use module_data_mosaic_asect, only: ai_phase, cw_phase, & - massptr_aer, & - ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer - -! arguments - integer, intent(out), dimension( 1:num_chem_ecpp ) :: & - iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & - inmw_of_aerosol, laicwpair_of_aerosol - logical, intent(out) :: is_aerosol(1:num_chem_ecpp) - -! local variables - integer :: j, j2, l, l2, ll, m, n - integer, save :: ientry = 0 - character(len=16) :: tmpname - - is_aerosol (:) = .false. - iphase_of_aerosol(:) = 0 - isize_of_aerosol(:) = 0 - itype_of_aerosol(:) = 0 - laicwpair_of_aerosol(:) = -999888777 - inmw_of_aerosol(:) = 0 - - do j = 1, nphase_aer - do n = 1, ntype_aer - do m = 1, nsize_aer(n) - do ll = 0, ncomp_aer(n) - - l = -999888777 - if (ll == 0) then - l = numptr_aer(m,n,j) - else if (ll <= ncomp_aer(n)) then - l = massptr_aer(ll,m,n,j) - end if - if ((l >= param_first_ecpp) .and. (l <= num_chem_ecpp)) then - is_aerosol(l) = .true. - iphase_of_aerosol(l) = j - isize_of_aerosol(l) = m - itype_of_aerosol(l) = n - if (ll == 0) then - inmw_of_aerosol(l) = 1 - else if (ll <= ncomp_aer(n)) then - inmw_of_aerosol(l) = 2 - else - inmw_of_aerosol(l) = 3 - end if - end if - - if ( (nphase_aer >= 2) .and. & - (ai_phase > 0) .and. (cw_phase > 0) ) then - if (j == ai_phase) then - j2 = cw_phase - else if (j == cw_phase) then - j2 = ai_phase - else - cycle - end if - end if - if (ll == 0) then - l2 = numptr_aer(m,n,j2) - else if (ll <= ncomp_aer(n)) then - l2 = massptr_aer(ll,m,n,j2) - else - cycle - end if - if ((l >= param_first_ecpp) .and. (l <= num_chem_ecpp) .and. & - (l2 >= param_first_ecpp) .and. (l2 <= num_chem_ecpp)) & - laicwpair_of_aerosol(l) = l2 - - end do - end do - end do - end do - - if (ientry == 0) then - do l = param_first_ecpp, num_chem_ecpp -! tmpname = chem_dname_table(1,l) -! write(*,'(2a,6i5)') 'iphase, isize, itype, inmw, l, laicw_pairptr ', tmpname, & - write(*,'(a,l2,7i5)') 'iphase, isize, itype, inmw, l, laicw_pairptr ', & - is_aerosol(l), iphase_of_aerosol(l), isize_of_aerosol(l), itype_of_aerosol(l), & - inmw_of_aerosol(l), l, max(-999,laicwpair_of_aerosol(l)) - end do - end if - ientry = 1 - - return - end subroutine set_of_aerosol_stuff - -!----------------------------------------------------------------------- - subroutine parampollu_tdx_startup( & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - rhocen_bar, dzcen, & - chem_bar, chem_cls, & - ncls_ecpp, & - acen_tbeg, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - chem_sub_beg, & - acen_tbeg_use, ardz_cen_tbeg, rhodz_cen, & - activate_onoff_use, & - iphase_of_aerosol, laicwpair_of_aerosol ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_tdx_startup does some "startup" calculations -! -! re-initializes the acen_tbeg to all-quiescent and the -! chem_cls to chem_bar at the re-init time (if this is turned on) -! -! calculates chem_sub from chem_cls (which involves some assumptions -! for the interstial and activated aerosols) -! -!----------------------------------------------------------------------- - -! use module_state_descption, only: & -! p_num_a01, p_num_cw01, p_oin_a01, p_oin_cw01, & -! p_num_a03, p_num_cw03, p_oin_a03, p_oin_cw03 -! use module_data_ecpp1, only: & -! p_num_a01, p_num_cw01, p_oin_a01, p_oin_cw01, & -! p_num_a03, p_num_cw03, p_oin_a03, p_oin_cw03 - - use module_data_radm2, only: epsilc - - use module_data_mosaic_asect, only: ai_phase, cw_phase - - use module_data_ecpp1 - - use module_ecpp_util, only: ecpp_error_fatal, ecpp_message - -! arguments - integer, intent(in) :: & - ktau, ktau_pp, & - it, jt, kts, ktebnd, ktecen -! ktau - time step number -! ktau_pp - time step number for "parameterized pollutants" calculations -! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" -! chem_driver and routines under it do calculations -! over these spatial indices. - - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) - - real(r8), intent(in) :: dtstep, dtstep_pp -! dtstep - main model time step (s) -! dtstep_pp - time step (s) for "parameterized pollutants" calculations - - real(r8), intent(in), dimension( kts:ktecen ) :: & - rhocen_bar, dzcen -! rhocen_bar, rhobnd_bar - dry air density (kg/m^3) at layer centers and boundaries -! dzcen - layer thicknesses (m) -! - real(r8), intent(in), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & - chem_bar -! chem_bar - mixing ratios of trace gase (ppm) and aerosol species -! (ug/kg for mass species, #/kg for number species) - - real(r8), intent(inout), dimension( kts:ktecen, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_cls - - integer, intent(in) :: ncls_ecpp -! ncls_ecpp - number of ecpp transport classes in the grid column - - real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - acen_tbeg - - integer, intent(in) :: ncls_use - - real(r8), intent(inout), & - dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_sub_beg - - real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - acen_tbeg_use, ardz_cen_tbeg - - real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen - - integer, intent(in) :: activate_onoff_use - - integer, intent(in), dimension( 1:num_chem_ecpp ) :: & - iphase_of_aerosol, laicwpair_of_aerosol - - -! local variables - integer :: icc, itmpa, jcls, jclsbb - integer :: k, l, la, laa, lbb, lc - integer :: lun161, lun162, lun164 - integer :: p1st - - real(r8) :: tmpa, tmpb, tmpqbarold - real(r8), dimension( 0:2 ) :: tmp_acen - real(r8), dimension( 1:num_chem_ecpp ) :: tmp_chem_cls - real(r8), dimension( 1:2, 1:num_chem_ecpp ) :: tmp_chem_sub - - - - p1st = param_first_ecpp - lun161 = -1 - if (idiagaa_ecpp(161) > 0) lun161 = ldiagaa_ecpp(161) - lun162 = -1 - if (idiagaa_ecpp(162) > 0) lun162 = ldiagaa_ecpp(162) - lun164 = -1 - if (idiagaa_ecpp(164) > 0) lun164 = ldiagaa_ecpp(164) - -! do sums of fractional areas over clear/cloudy and classes - do k = kts, ktecen - do jcls = 1, ncls_use - acen_tbeg(k,0,jcls) = sum( acen_tbeg(k,1:2,jcls) ) - end do - do icc = 0, 2 - tmpa = 0.0_r8 - do jclsbb = 2, ncls_use+1 - ! sum order is [2,3,...,ncls,1] instead of [1,2,...,ncls] - jcls = mod(jclsbb-1,ncls_use) + 1 - tmpa = tmpa + acen_tbeg(k,icc,jcls) - end do - acen_tbeg(k,icc,0) = tmpa - end do - end do - - -! -! with hybrid-time-dependent drafts, always do reinit calcs -! -! set all chem_cls = chem_bar for all species and levels - chem_cls(:,:,:) = 0.0_r8 - do l = 1, num_chem_ecpp - do jcls = 1, ncls_use - do k = kts, ktecen - chem_cls(k,jcls,l) = chem_bar(k,l) - end do - end do - end do - -! set up/dndraft areas to zero -! set quiescent areas to overall clear/cloudy fractions - do k = kts, ktecen - tmpa = acen_tbeg(k,1,0) ! this is total clear area (all classes) - tmpa = max( 0.0_r8, min( 1.0_r8, tmpa ) ) - -! force 100%/0%/70%/30% clear when iflag_ecpp_test_fixed_fcloud = 2/3/4/5 - if ((iflag_ecpp_test_fixed_fcloud >= 2) .and. & - (iflag_ecpp_test_fixed_fcloud <= 5)) then - if (iflag_ecpp_test_fixed_fcloud == 2) then - tmpa = 1.0_r8 - else if (iflag_ecpp_test_fixed_fcloud == 3) then - tmpa = 0.0_r8 - else if (iflag_ecpp_test_fixed_fcloud == 4) then - tmpa = 0.7_r8 - else - tmpa = 0.3_r8 - end if - end if - - acen_tbeg(k,:,:) = 0.0_r8 - acen_tbeg(k,0,jcls_qu) = 1.0_r8 - acen_tbeg(k,1,jcls_qu) = tmpa - acen_tbeg(k,2,jcls_qu) = 1.0_r8-tmpa - acen_tbeg(k,0:2,0) = acen_tbeg(k,0:2,jcls_qu) - end do - - -! -! update the chem_cls values based on "host-code" changes to chem_bar -! when iflag_ecpp_startup_host_chemtend > 0 - if (iflag_ecpp_startup_host_chemtend > 0) then - do l = p1st, num_chem_ecpp - do k = kts, ktecen - tmpa = 0.0_r8 - tmpb = 0.0_r8 - do jcls = 1, ncls_use - tmpa = tmpa + acen_tbeg(k,0,jcls)*chem_cls(k,jcls,l) - tmpb = tmpb + acen_tbeg(k,0,jcls) - end do - tmpqbarold = tmpa/max(tmpb,0.99_r8) - if (tmpqbarold < 1.01_r8*max(epsilc,1.0e-20_r8)) then - chem_cls(k,1:ncls_use,l) = chem_bar(k,l) - else if (chem_bar(k,l) > tmpqbarold) then - chem_cls(k,1:ncls_use,l) = chem_cls(k,1:ncls_use,l) + (chem_bar(k,l)-tmpqbarold) - else - chem_cls(k,1:ncls_use,l) = chem_cls(k,1:ncls_use,l) * (chem_bar(k,l)/tmpqbarold) - end if - end do - end do - end if - - -! do chem_sub_beg <-- chem_cls and acen_tbeg_use <-- acen_tbeg -! TODO - for aerosols, special treatment for "a" and "cw" in clear/cloudy sub-classes - acen_tbeg_use(:,:,:) = acen_tbeg(:,:,:) - chem_sub_beg(:,:,:,:) = 0.0_r8 - - do k = kts, ktecen - do jcls = 0, ncls_use - ardz_cen_tbeg(k,0:2,jcls) = acen_tbeg_use(k,0:2,jcls)*rhodz_cen(k) - end do - end do - - do jcls = 1, ncls_use - do k = kts, ktecen - do l = p1st, num_chem_ecpp - chem_sub_beg(k,1:2,jcls,l) = chem_cls(k,jcls,l) - end do - end do - end do - -! for aerosols, special treatment for "a" and "cw" in clear/cloudy sub-classes - if ((activate_onoff_use > 0) .and. (iflag_ecpp_startup_acw_partition > 0)) then - -acwxx1_jcls_loop: & - do jcls = 1, ncls_use -acwxx1_k_loop: & - do k = kts, ktecen - - ! clear subarea ~= 0 --> all cloudy - ! no special treatment in this case - if (acen_tbeg_use(k,1,jcls) < afrac_cut_0p5) cycle acwxx1_k_loop - - ! cloudy subarea ~= 0 and clear subarea > 0 - ! resuspend any cloudborne material - if (acen_tbeg_use(k,2,jcls) < afrac_cut_0p5) then - do la = p1st, num_chem_ecpp - if (iphase_of_aerosol(la) /= ai_phase) cycle - lc = laicwpair_of_aerosol(la) - if (lc < p1st) cycle - if (iphase_of_aerosol(lc) /= cw_phase) cycle - - tmpa = chem_cls(k,jcls,la) + chem_cls(k,jcls,lc) - chem_sub_beg(k,1:2,jcls,la) = tmpa - chem_sub_beg(k,1:2,jcls,lc) = 0.0_r8 - chem_cls(k,jcls,la) = tmpa - chem_cls(k,jcls,lc) = 0.0_r8 - end do ! la - cycle acwxx1_k_loop - end if - - ! at this point, clear and cloudy subareas > 0 - tmp_acen(0:2) = acen_tbeg_use(k,0:2,jcls) - tmp_chem_cls(p1st:num_chem_ecpp) = chem_cls(k,jcls,p1st:num_chem_ecpp) - tmp_chem_sub(1:2,p1st:num_chem_ecpp) = chem_sub_beg(k,1:2,jcls,p1st:num_chem_ecpp) - - if (lun164 > 0) & - write(lun164,'(/a,8i5)') 'aa ktau,jcls,k ', ktau,jcls,k - call parampollu_tdx_partition_acw( & - tmp_acen, tmp_chem_cls, tmp_chem_sub, & - ktau, it, jt, k, jcls, lun164 ) - - chem_sub_beg(k,1:2,jcls,p1st:num_chem_ecpp) = tmp_chem_sub(1:2,p1st:num_chem_ecpp) - - end do acwxx1_k_loop - end do acwxx1_jcls_loop - - end if ! ((activate_onoff_use > 0) .and. (iflag_ecpp_startup_acw_partition > 0)) - - if ((lun161 > 0) .and. (kts > -1)) then -! la = p_num_a03 ; lc = p_num_cw03 -! write(lun161,'(/a,4i6)') 'startup - ktau, l_num_ac03', ktau, la, lc, laicwpair_of_aerosol(la) -! la = p_oin_a03 ; lc = p_oin_cw03 -! if (lun162 > 0) & -! write(lun162,'(/a,4i6)') 'startup - ktau, l_oin_ac03', ktau, la, lc, laicwpair_of_aerosol(la) -! do k = min(10,ktecen), kts, -1 - -! write(lun161,'(i2,2(1x,2l1),2(2x, 2x,2(2x,2f11.8)))') k, & -! (( (acen_tbeg_use(k,icc,jcls)>afrac_cut_0p5), icc=1,2 ), jcls=1,2 ), & -! (( acen_tbeg_use(k,icc,jcls), icc=1,2 ), jcls=1,2 ) - -! la = p_num_a01 ; lc = p_num_cw01 ; tmpa = 1.0e-9 -! la = p_num_a03 ; lc = p_num_cw03 ; tmpa = 1.0e-6 -! write(lun161,'(i2, 1x,a5, 2(3x,f6.3,2(1x,3f6.3)))') k, 'num_3', & -! ( tmpa*chem_bar(k,l), & -! ( tmpa*chem_cls(k,jcls,l), tmpa*chem_sub_beg(k,1:2,jcls,l), jcls=1,2 ), & -! l=la,lc,lc-la ) -! la = p_oin_a01 ; lc = p_oin_cw01 ; tmpa = 1.0 -! la = p_oin_a03 ; lc = p_oin_cw03 ; tmpa = 1.0 -! write(lun161,'(i2, 1x,a5, 2(3x,f6.3,2(1x,3f6.3)))') k, 'oin_3', & -! ( tmpa*chem_bar(k,l), & -! ( tmpa*chem_cls(k,jcls,l), tmpa*chem_sub_beg(k,1:2,jcls,l), jcls=1,2 ), & -! l=la,lc,lc-la ) - -! end do - end if ! ((lun161 > 0) .and. (kts > -1)) - - - return - end subroutine parampollu_tdx_startup - - -!----------------------------------------------------------------------- - subroutine parampollu_tdx_partition_acw( & - acen, chem_cls, chem_sub, & - ktau, i, j, k, jcls, lun164 ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_tdx_partition_acw paritions interstitial ("a") and -! activate/cloudborne ("cw") aerosol species to the clear and cloudy -! fractions of a grid cell (or grid cell transport-class) -! -!----------------------------------------------------------------------- - - use module_data_mosaic_asect, only: ai_phase, cw_phase, & - ncomp_aer, nsize_aer, ntype_aer, & - massptr_aer, numptr_aer, & !waterptr_aer, & - dens_aer, volumlo_sect, volumhi_sect - - use module_data_ecpp1 - - use module_ecpp_util, only: ecpp_error_fatal, ecpp_message, & - parampollu_1clm_set_opts - -! arguments - integer, intent(in) :: & - ktau, i, j, k, jcls, lun164 -! ktau - time step number -! [i, k, j] - spatial (x,z,y) indices for grid cell - - real(r8), intent(in), dimension( 0:2 ) :: acen - - real(r8), intent(in), dimension( 1:num_chem_ecpp ) :: chem_cls - - real(r8), intent(inout), dimension( 1:2, 1:num_chem_ecpp ) :: chem_sub - - -! local variables - integer :: iphase, isize, itmpa, itype - integer :: la, lc, ll - - real(r8) :: fx, fy - real(r8) :: q_a_x, q_a_y, q_a_bar, & - q_c_x, q_c_y, q_c_bar, & - q_ac_x, q_ac_y, q_ac_bar, & - qn_a_x, qn_a_y, qn_a_bar, & - qn_a_x_sv, qn_a_y_sv, & - qv_a_x, qv_a_y, qv_a_bar - real(r8) :: tmpa - - character(len=120) :: msg - - - - if (min(acen(1),acen(2)) < afrac_cut_0p5) then - write(msg,'(a,i10,3i5,1p,2e12.4)') & - '*** parampollu_tdx_partition_acw - bad acen(1:2)', & - ktau, i, j, k, acen(1:2) - call ecpp_message( lunout, msg ) - call ecpp_error_fatal( lunout, msg ) - return - end if - fy = acen(2)/(acen(1)+acen(2)) - fx = 1.0_r8 - fy - -! main loops over aerosol types and sizes - do itype = 1, ntype_aer - do isize = 1, nsize_aer(itype) - -! first partition number and dry-mass species -! in a manner that attempts to get the "a+cw" mixing ratios -! in clear and cloudy subareas to be equal the -! cell/class average (clear+cloudy) "a+cw" mixing ratios - qv_a_x = 0.0_r8 ; qv_a_y = 0.0_r8 - do ll = 0, ncomp_aer(itype) - if (ll == 0) then - la = numptr_aer(isize,itype,ai_phase) - lc = numptr_aer(isize,itype,cw_phase) - else - la = massptr_aer(ll,isize,itype,ai_phase) - lc = massptr_aer(ll,isize,itype,cw_phase) - end if - -! nomenclature for q_... -! a = interstitial; c = cloudborne; ac = a+c -! x = in clear subarea; y = in cloudy subarea; -! bar = average over both subareas -! -! following always hold -! q_ac_any == q_a_any + q_c_any -! q_any_bar == q_any_x*fx + q_any_y*fy -! - q_a_bar = max( 0.0_r8, chem_cls(la) ) - q_c_bar = max( 0.0_r8, chem_cls(lc) ) - q_ac_bar = q_a_bar + q_c_bar - q_c_y = q_c_bar/fy - q_c_x = 0.0_r8 - q_a_y = max( 0.0_r8, (q_ac_bar - q_c_y) ) - q_a_x = max( 0.0_r8, (q_a_bar - q_a_y*fy)/fx ) - -! if ((k <= 5) .and. (isize == 1) .and. (ll == 3)) then - if ((k <= 5) .and. (isize == 3) .and. (ll==3 .or. ll==0)) then - if (lun164 > 0) then - write(lun164,'(/a,8i5)') 'bb ktau,jcls,k,isize,ll', ktau,jcls,k,isize,ll - write(lun164,'(a,1p,8e12.4)') 'acen1/2, fx/y', acen(1:2), fx, fy - write(lun164,'(a,1p,8e12.4)') 'chem_cls ', chem_cls(la), chem_cls(lc) - write(lun164,'(a,1p,8e12.4)') 'chem_sub old ', chem_sub(1:2,la), chem_sub(1:2,lc) - end if - end if - chem_sub(1,la) = q_a_x - chem_sub(2,la) = q_a_y - chem_sub(1,lc) = q_c_x - chem_sub(2,lc) = q_c_y -! if ((k <= 5) .and. (isize == 1) .and. (ll == 3)) then - if ((k <= 5) .and. (isize == 3) .and. (ll==3 .or. ll==0)) then - if (lun164 > 0) & - write(lun164,'(a,1p,8e12.4)') 'chem_sub new ', chem_sub(1:2,la), chem_sub(1:2,lc) - end if - - if (ll == 0) then - qn_a_x = q_a_x - qn_a_y = q_a_y - else - qv_a_x = qv_a_x + q_a_x/dens_aer(ll,itype) - qv_a_y = qv_a_y + q_a_y/dens_aer(ll,itype) - end if - end do - qv_a_x = qv_a_x*1.0e-6_r8 ! because mass mixratios are ug/kg, - qv_a_y = qv_a_y*1.0e-6_r8 ! and want volume mixratio in cm3-aerosol/kg - -! now check that the partitioning has not produced an out-of-bounds size -! (size = mean 1-particle volume) for interstitial in clear or cloudy subareas -! if this has occurred, then partition the number differently - qv_a_bar = qv_a_x*fx + qv_a_y*fy - qn_a_bar = qn_a_x*fx + qn_a_y*fy - qn_a_x_sv = qn_a_x ; qn_a_y_sv = qn_a_y - if ( (qv_a_bar <= 1.0e-30_r8) .or. & - (qv_a_bar <= qn_a_bar*volumlo_sect(isize,itype)) .or. & - (qv_a_bar >= qn_a_bar*volumhi_sect(isize,itype)) ) then - ! neglible dry volume, or size already out-of-bounds - tmpa = max(qv_a_bar,1.0e-35_r8) - qn_a_x = qn_a_bar * ( max(qv_a_x,0.5e-35_r8) / tmpa ) - qn_a_y = qn_a_bar * ( max(qv_a_y,0.5e-35_r8) / tmpa ) - if (qv_a_bar <= 1.0e-30_r8) then - itmpa = 1 - else if (qv_a_bar <= qn_a_bar*volumlo_sect(isize,itype)) then - itmpa = 2 - else - itmpa = 3 - end if - - else if (qv_a_x <= qn_a_x*volumlo_sect(isize,itype)) then - ! size to small in clear subarea - qn_a_x = qv_a_x/volumlo_sect(isize,itype) - qn_a_y = max( 0.0_r8, (qn_a_bar - qn_a_x*fx)/fy ) - itmpa = 4 - else if (qv_a_y <= qn_a_y*volumlo_sect(isize,itype)) then - ! size to small in cloudy subarea - qn_a_y = qv_a_y/volumlo_sect(isize,itype) - qn_a_x = max( 0.0_r8, (qn_a_bar - qn_a_y*fy)/fx ) - itmpa = 5 - - else if (qv_a_x >= qn_a_x*volumhi_sect(isize,itype)) then - ! size to large in clear subarea - qn_a_x = qv_a_x/volumhi_sect(isize,itype) - qn_a_y = max( 0.0_r8, (qn_a_bar - qn_a_x*fx)/fy ) - itmpa = 6 - else if (qv_a_y >= qn_a_y*volumhi_sect(isize,itype)) then - ! size to large in cloudy subarea - qn_a_y = qv_a_y/volumhi_sect(isize,itype) - qn_a_x = max( 0.0_r8, (qn_a_bar - qn_a_y*fy)/fx ) - itmpa = 7 - else - itmpa = 0 - end if - la = numptr_aer(isize,itype,ai_phase) - chem_sub(1,la) = qn_a_x - chem_sub(2,la) = qn_a_y - if ((k <= 5) .and. (isize == 3)) then - if ((itmpa==5) .and. (qv_a_y>0.0_r8)) itmpa=8 - if ((itmpa==5) .and. (qn_a_y>0.0_r8)) itmpa=9 - if (lun164 > 0) then - write(lun164,'(/i1,a,1p,8e12.4)') itmpa, ' final num_a', chem_sub(1:2,la) - write(lun164,'( 13x,1p,8e12.4)') qn_a_x_sv, qn_a_y_sv, qn_a_bar, qv_a_x, qv_a_y - end if - end if - -! aerosol water - do this for now, but it should be improved -! comment out now, need to check with Dick Easter. +++mhwang -! -! la = waterptr_aer(isize,itype) -! tmpa = max(qv_a_bar,1.0e-35) -! chem_sub(1,la) = ( max(qv_a_x,0.5e-35) / tmpa ) * chem_cls(la) -! chem_sub(2,la) = ( max(qv_a_y,0.5e-35) / tmpa ) * chem_cls(la) - - end do - end do - - - - return - end subroutine parampollu_tdx_partition_acw - -!----------------------------------------------------------------------- - subroutine parampollu_tdx_cleanup( & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - chem_bar, chem_cls, & - ncls_ecpp, & - acen_tfin_ecpp, & - it, jt, kts,ktebnd,ktecen, & - ncls_use, & - chem_sub_beg, chem_sub_new, & - del_chem_clm_cldchem, del_chem_clm_wetscav, & - del_cldchem3d, del_rename3d, & - del_wetdep3d, del_wetresu3d, & - del_activate3d, del_conv3d, & - acen_tbeg_use, acen_tfin_use, rhodz_cen, & - activate_onoff_use, & - iphase_of_aerosol, isize_of_aerosol, & - itype_of_aerosol, inmw_of_aerosol, & - laicwpair_of_aerosol ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_tdx_cleanup does some final "cleanup" calculations -! -! calculates final chem_cls and chem_bar from the final chem_sub -! -! calculates beginning and final column-average mixing ratios -! and checks for mass conservation -! -!----------------------------------------------------------------------- - - use module_data_mosaic_asect, only: ai_phase, cw_phase, & - nsize_aer, massptr_aer, numptr_aer - - use module_data_radm2, only: epsilc - - use module_data_ecpp1 - - use module_ecpp_util, only: ecpp_error_fatal, ecpp_message - -! arguments - integer, intent(in) :: & - ktau, ktau_pp, & - it, jt, kts, ktebnd, ktecen -! ktau - time step number -! ktau_pp - time step number for "parameterized pollutants" calculations -! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" -! chem_driver and routines under it do calculations -! over these spatial indices. - - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) - - real(r8), intent(in) :: dtstep, dtstep_pp -! dtstep - main model time step (s) -! dtstep_pp - time step (s) for "parameterized pollutants" calculations - - real(r8), intent(inout), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & - chem_bar -! chem_bar - mixing ratios of trace gase (ppm) and aerosol species -! (ug/kg for mass species, #/kg for number species) - - real(r8), intent(inout), dimension( kts:ktecen, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_cls - - integer, intent(in) :: ncls_ecpp -! ncls_ecpp - number of ecpp transport classes in the grid column - - - real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - acen_tfin_ecpp - - integer, intent(in) :: ncls_use - - real(r8), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - chem_sub_beg, chem_sub_new - - real(r8), intent(inout), dimension( 1:num_chem_ecpp ) :: & - del_chem_clm_cldchem, del_chem_clm_wetscav - - real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:2, 1:num_chem_ecpp ) :: & - del_cldchem3d, del_rename3d, del_wetdep3d, del_wetresu3d - - real(r8), intent(in), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - del_activate3d - - real(r8), intent(out), dimension( kts:ktecen, 1:2, 1:maxcls_ecpp, 1:num_chem_ecpp ) :: & - del_conv3d - - real(r8), intent(in), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - acen_tbeg_use, acen_tfin_use - - real(r8), intent(in), dimension( kts:ktecen ) :: rhodz_cen - - integer, intent(in) :: activate_onoff_use - - integer, intent(in), dimension( 1:num_chem_ecpp ) :: & - iphase_of_aerosol, isize_of_aerosol, itype_of_aerosol, & - inmw_of_aerosol, laicwpair_of_aerosol - - - -! local variables - integer :: ia, ib, icc - integer :: jcls, jclsbb - integer :: k - integer :: l, la, laa, lbb, lc, lewa, lewc, lun119, lun121 - integer :: laicwpair_flagaa - integer, save :: ktaueww = 0 - - real(r8) :: air_clmmass - real(r8) :: chem_cutoff_aa - real(r8) :: tmpa, tmpb, tmpe, tmpew, tmpx, tmpy, tmpz - real(r8) :: tmpa_clmavg(1:6), tmpw_clmavg(1:6) - real(r8) :: tmpveca( kts:ktecen ), tmpvecb( kts:ktecen ) - real(r8) :: tmpvece(1:6) - real(r8), save :: tmpeww = 0.0_r8 - - real(r8), dimension( 1:6, 1:num_chem_ecpp ) :: chem_clmavg - real(r8), dimension( kts:ktecen, 1:num_chem_ecpp ) :: chem_bar_beg - - - - lun121 = -1 - if (idiagaa_ecpp(121) > 0) lun121 = ldiagaa_ecpp(121) - - del_conv3d = 0.0_r8 -! calculate initial clmmass and del_conv3d - air_clmmass = sum( rhodz_cen(kts:ktecen) ) - do l = param_first_ecpp, num_chem_ecpp - tmpveca(:) = 0.0_r8 ; tmpvecb(:) = 0.0_r8 - do jcls = 1, ncls_use - do icc = 1, 2 - do k = kts, ktecen - tmpveca(k) = tmpveca(k) + acen_tbeg_use(k,icc,jcls)*chem_cls( k, jcls,l) - tmpvecb(k) = tmpvecb(k) + acen_tbeg_use(k,icc,jcls)*chem_sub_beg(k,icc,jcls,l) - end do - end do - end do - chem_clmavg(1,l) = sum( rhodz_cen(kts:ktecen)*chem_bar(kts:ktecen,l) ) - chem_clmavg(2,l) = sum( rhodz_cen(kts:ktecen)*tmpveca(kts:ktecen) ) - chem_clmavg(3,l) = sum( rhodz_cen(kts:ktecen)*tmpvecb(kts:ktecen) ) - end do - if ((ktau < 0) .and. (lun121 > 0)) then - l = 17 - icc = 1 -! write(lun121,*) 'ktau, l, ncls_use', ktau, l, ncls_use -! write(lun121,*) 'k, old chem_bar, old chem_cls, chem_sub_beg, acen_tbeg_use' -! do k = ktecen, kts, -1 -! write(lun121,'(i3,1p,e12.5,3(3x,3e12.5))') k, chem_bar(k,l), & -! chem_cls(k,1:3,l), chem_sub_beg(k,icc,1:3,l), acen_tbeg_use(k,icc,1:3) -! end do - end if -! if (ktau > 1) stop - - -! do acen_tfin_ecpp <-- acen_tfin_use - acen_tfin_ecpp(:,:,:) = acen_tfin_use(:,:,:) - - -! compute new chem_cls (class-avg mix ratios) and chem_bar (grid-avg mix ratios) - chem_bar_beg(:,:) = chem_bar(:,:) - do l = param_first_ecpp, num_chem_ecpp - do k = kts, ktecen - - tmpa = 0.0_r8 ; tmpb = 0.0_r8 - do jcls = 1, ncls_use - do icc = 1, 2 - tmpa = tmpa + acen_tfin_use(k,icc,jcls)* & - max(0.0_r8,chem_sub_new(k,icc,jcls,l)) - tmpb = tmpb + acen_tfin_use(k,icc,jcls) - - del_conv3d(k,icc,jcls,l) = (acen_tfin_use(k,icc,jcls)*max(0.0_r8, chem_sub_new(k,icc,jcls,l)) & - - acen_tbeg_use(k,icc,jcls)*chem_sub_beg(k,icc,jcls,l)) & - - del_activate3d(k,icc,jcls,l) & - - del_cldchem3d(k,icc,jcls,1,l)-del_cldchem3d(k,icc,jcls,2,l) & - - del_rename3d(k,icc,jcls,1,l)-del_rename3d(k,icc,jcls,2,l) & - - del_wetdep3d(k,icc,jcls,1,l)-del_wetdep3d(k,icc,jcls,2,l) & - - del_wetresu3d(k,icc,jcls,1,l)-del_wetresu3d(k,icc,jcls,2,l) - end do - end do -! chem_bar(k,l) = max(0.0_r8,tmpa)/tmpb - chem_bar(k,l) = tmpa ! chem_bar is used to calcualte q tendency at the MMF model, - ! so keep it consistent with del_conv3d - - do jcls = 1, ncls_use - tmpa = 0.0_r8 ; tmpb = 0.0_r8 - do icc = 1, 2 - tmpa = tmpa + acen_tfin_use(k,icc,jcls)* & - max(0.0_r8,chem_sub_new(k,icc,jcls,l)) - tmpb = tmpb + acen_tfin_use(k,icc,jcls) - end do - if (tmpb >= afrac_cut_0p5) then - chem_cls(k,jcls,l) = max(0.0_r8,tmpa)/tmpb - else - chem_cls(k,jcls,l) = chem_bar(k,l) - end if - end do - - end do - end do - - -! calculate final clmmass - do l = param_first_ecpp, num_chem_ecpp - tmpveca(:) = 0.0_r8 ; tmpvecb(:) = 0.0_r8 - do jcls = 1, ncls_use - do icc = 1, 2 - do k = kts, ktecen - tmpveca(k) = tmpveca(k) + acen_tfin_use(k,icc,jcls)*chem_cls( k, jcls,l) - tmpvecb(k) = tmpvecb(k) + acen_tfin_use(k,icc,jcls)*chem_sub_new(k,icc,jcls,l) - end do - end do - end do - chem_clmavg(4,l) = sum( rhodz_cen(kts:ktecen)*chem_bar(kts:ktecen,l) ) - chem_clmavg(5,l) = sum( rhodz_cen(kts:ktecen)*tmpveca(kts:ktecen) ) - chem_clmavg(6,l) = sum( rhodz_cen(kts:ktecen)*tmpvecb(kts:ktecen) ) - chem_clmavg(1:6,l) = chem_clmavg(1:6,l)/air_clmmass - end do - if ((ktau < 0) .and. (lun121 > 0)) then - l = 17 - icc = 1 -! write(lun121,*) 'ktau, l, ncls_use', ktau, l, ncls_use -! write(lun121,*) 'k, new chem_bar, new chem_cls, chem_sub_new, acen_tfin_use' - do k = ktecen, kts, -1 -! write(lun121,'(i3,1p,e12.5,3(3x,3e12.5))') k, chem_bar(k,l), & -! chem_cls(k,1:3,l), chem_sub_new(k,icc,1:3,l), acen_tfin_use(k,icc,1:3) - end do - end if -! if (ktau > 5) stop - if ((ktau < 5) .and. (lun121 > 0)) then - l = 9 -! write(lun121,'(/a,3i5)') 'ktau, l, ncls_use ', ktau, l, ncls_use -! write(lun121,'(a)') 'k, ((chem_sub_beg(k,icc,jcls,l), chem_sub_new(k,icc,jcls,l), icc=1,2), jcls=1,...) ' - do k = ktecen, kts, -1 -! write(lun121,'(i3,1p,6(2x,2e10.3))') k, & -! ((chem_sub_beg(k,icc,jcls,l), chem_sub_new(k,icc,jcls,l), icc=1,2), jcls=1,ncls_use) - end do - end if - - -! diagnostic output to unit 121 - if (lun121 > 0) then - -! write(lun121,'(/a,2i6)') 'parampollu_1clm clmmass check - ktau, ktau_pp =', & -! ktau, ktau_pp - lewa = 0 - lewc = 0 - tmpew = 0.0_r8 - chem_cutoff_aa = 3.0_r8*epsilc - laicwpair_flagaa = 0 - if ( (activate_onoff_use > 0) .and. & - (activate_onoff_use /=100) ) laicwpair_flagaa = 2 - do la = param_first_ecpp, num_chem_ecpp - l = -999888777 - lc = 0 - if (laicwpair_flagaa == 2) then - if (iphase_of_aerosol(la) == ai_phase) then - lc = laicwpair_of_aerosol(la) - else if (iphase_of_aerosol(la) == cw_phase) then - cycle - end if - end if - if ((lc < param_first_ecpp) .or. (lc > num_chem_ecpp)) lc = 0 - - ! these are the 3 initial and 3 final values of column-average mixing ratio - ! for the current species (or species la-lc pair) - tmpa_clmavg(1:6) = chem_clmavg(1:6,la) - if (lc > 0) tmpa_clmavg(1:6) = tmpa_clmavg(1:6) + chem_clmavg(1:6,lc) - - ! for the 3 final values, subtract off the change from cldchem and wetscav - tmpa = del_chem_clm_cldchem(la) + del_chem_clm_wetscav(la) - if (lc > 0) tmpa = tmpa + del_chem_clm_cldchem(lc) + del_chem_clm_wetscav(lc) - tmpa = tmpa/air_clmmass - tmpa_clmavg(4:6) = tmpa_clmavg(4:6) - tmpa - - do ia = 1, 6 - ib = mod(ia,6) + 1 - tmpa = tmpa_clmavg(ia) - tmpb = tmpa_clmavg(ib) - tmpvece(ia) = abs( tmpa-tmpb ) & - / max( abs(tmpa), abs(tmpb), 1.0e-30_r8 ) - end do - tmpx = maxval( tmpa_clmavg(1:6) ) - tmpy = minval( tmpa_clmavg(1:6) ) - tmpz = max( abs(tmpx), abs(tmpy), 1.0e-30_r8 ) - ! ignore species with max,min( clmavg mixratios ) < chem_cutoff_aa - if (tmpz >= chem_cutoff_aa) then - tmpe = abs( tmpx-tmpy ) / tmpz - else - tmpe = 0.0_r8 - end if - if (tmpe > tmpew) then - tmpew = tmpe - lewa = la - lewc = lc - tmpw_clmavg(:) = tmpa_clmavg(:) - end if - - if (tmpe > 1.0e-12_r8 ) then - write(lun121,'(a,2i3,1p,2(3x,6e10.2))') 'la/c=', la, lc, & - tmpa_clmavg(1:6), tmpvece(1:6) - - write(0,'(a,2i3,1p,2(3x,6e10.2))') 'mass convervation error in ecpp, la/c=', la, lc, & - tmpa_clmavg(1:6), tmpvece(1:6) - call endrun('mass convervation error in ecpp_cleanup') - end if - end do - if (tmpew > tmpeww) then - tmpeww = tmpew - ktaueww = ktau - end if - if (lewa > 0) then - write(lun121,'(a,2i3,1p,e10.2,10x,2i6,e10.2)') 'worst clmmass error - la/c=', & - lewa, lewc, tmpew, ktau, ktaueww, tmpeww - write(lun121,'(a,1p,6e14.6)') 'chem_clmavg(1:6,l)', tmpw_clmavg(1:6) - end if - - end if ! (lun121 > 0) - - -! diagnostic output to unit 119 - lun119 = -1 - if (idiagaa_ecpp(119) > 0) lun119 = ldiagaa_ecpp(119) - if (lun119 > 0) then - write(lun119,'(/a,2i5)') 'parampollu_1clm - pt2 ktau, ktau_pp =', ktau, ktau_pp -! do laa = param_first_ecpp, num_chem_ecpp, 3 -! lbb = min( laa+2, num_chem_ecpp ) -! do laa = param_first_ecpp, num_chem_ecpp, 4 -! lbb = min( laa+3, num_chem_ecpp ) - do laa = 9, 9 - lbb = min( laa+3, num_chem_ecpp ) - write(lun119,'(/a,4i5)') 'ktau, ktau_pp, laa, lbb =', ktau, ktau_pp, laa, lbb - write(lun119,'(a)') ' k, chem_bar_beg, chem_bar' - do k = ktecen, kts, -1 -! write(lun119,'(i2,4(2x,2f9.5))') k, & - write(lun119,'(i2,4(2x,1p,2e10.2))') k, & - (chem_bar_beg(k,l), chem_bar(k,l), l=laa, lbb) - end do -! write(lun119,'(i2,4(2x,2f9.5))') -1, & - write(lun119,'(i2,4(2x,1p,2e10.2))') -1, & - (chem_clmavg(2,l), chem_clmavg(5,l), l=laa, lbb) -! write(lun119,'(i2,1p,4e20.5))') -2, & - write(lun119,'(i2,4(2x,1p,e20.2))') -2, & - ( (chem_clmavg(2,l)-chem_clmavg(5,l)), l=laa, lbb) - end do - end if ! (lun119 > 0) - - - return - end subroutine parampollu_tdx_cleanup - - - -!----------------------------------------------------------------------- - subroutine parampollu_check_adjust_inputs( & - ipass_check_adjust_inputs, & - ktau, dtstep, ktau_pp, dtstep_pp, & - idiagaa_ecpp, ldiagaa_ecpp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, zbnd, wbnd_bar, & - chem_bar, & - ncls_ecpp, & - kdraft_bot_ecpp, kdraft_top_ecpp, & - mtype_updnenv_ecpp, & - mfbnd_ecpp, abnd_tavg_ecpp, & - acen_tavg_ecpp, acen_tfin_ecpp, acen_prec_ecpp, & - wbnd_bar_use, & - ncls_use, & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use, & - mfbnd_use, mfbnd_quiescn_up, mfbnd_quiescn_dn, & - abnd_tavg_use, & - acen_tavg_use, acen_tfin_use, acen_prec_use, & - rhodz_cen, & - it, jt, kts,ktebnd,ktecen ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_check_adjust_inputs does checking and adjustment -! of several of the ecpp arrays -! -! fractional areas less than afrac_cut are set to zero -! up and downdraft mass fluxes less than ... are set to zero -! remaining fractional areas are adjusted so that the sum is 1.0 -! -! all mass fluxes are set to zero at/above k_max_wnonzero -! up and downdraft mass fluxes and areas are set to zero at/above k_max_updndraft -! cloud fractional areas are set to zero at/above k_max_clouds -! -! the checks and adjustment are designed to eliminate "problems" in -! the input/incoming arrays that might cause the rest of the -! parampollu code to fail -! -!----------------------------------------------------------------------- - - use module_data_ecpp1 - - use module_ecpp_util, only: ecpp_error_fatal, ecpp_message - -! arguments - integer, intent(in) :: & - ipass_check_adjust_inputs, & - ktau, ktau_pp, & - it, jt, kts, ktebnd, ktecen -! ktau - time step number -! ktau_pp - time step number for "parameterized pollutants" calculations - -! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" -! chem_driver and routines under it do calculations -! over these spatial indices. - - integer, intent(in) :: idiagaa_ecpp(1:199), ldiagaa_ecpp(1:199) - - real(r8), intent(in) :: dtstep, dtstep_pp -! dtstep - main model time step (s) -! dtstep_pp - time step (s) for "parameterized pollutants" calculations - - real(r8), intent(in), dimension( kts:ktecen ) :: & - tcen_bar, pcen_bar, rhocen_bar, dzcen - real(r8), intent(in), dimension( kts:ktebnd ) :: & - rhobnd_bar, zbnd, wbnd_bar - - real(r8), intent(inout), dimension( kts:ktebnd ) :: & - wbnd_bar_use - - real(r8), intent(inout), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & - chem_bar - - integer, intent(in) :: ncls_ecpp - integer, intent(inout) :: ncls_use - - integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & - kdraft_bot_ecpp, kdraft_top_ecpp, & - mtype_updnenv_ecpp - integer, intent(inout), dimension( 1:2, 1:maxcls_ecpp ) :: & - kdraft_bot_use, kdraft_top_use, & - mtype_updnenv_use - - real(r8), intent(in), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & - mfbnd_ecpp, abnd_tavg_ecpp - real(r8), intent(inout), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & - mfbnd_use, abnd_tavg_use - real(r8), intent(in), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - acen_tavg_ecpp, acen_tfin_ecpp, acen_prec_ecpp - real(r8), intent(inout), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - acen_tavg_use, acen_tfin_use, acen_prec_use - real(r8), intent(inout), dimension( kts:ktebnd, 0:2, 0:2 ) :: & - mfbnd_quiescn_up, mfbnd_quiescn_dn - real(r8), intent(inout), dimension( kts:ktecen ) :: rhodz_cen - - -! local variables - integer :: k_max_updndraft - integer :: k_max_clouds - integer :: k_max_wnonzero - - integer :: i, icc, itmpa, itmpb - integer :: ido_downdr_area_zeroout, ido_updndr_area_adjust, ipass_2_changes - integer :: ispecial_check_acen_tfin - integer :: ja, jb - integer :: jcls, jclsbb - integer :: jclsicc, jclsicc_noc, jclsicc_cld - integer :: k, ka, kb, ktmpa, ktmpb - integer :: lun63, lun141, lun155 - integer :: ncls_noc, ncls_cld - integer :: nchanges(10) - integer :: kdraft_bot_tmp(1:2,1:maxcls_ecpp), kdraft_top_tmp(1:2,1:maxcls_ecpp) - integer :: mtype_updnenv_tmp(1:2,1:maxcls_ecpp) - - real(r8) :: ardz_cut ! sub-class fractional areas below this value are set to zero - real(r8) :: arw_draft_cut ! mass fluxes below this value are set to zero - real(r8) :: a_sum_toleraa = 1.0e-5_r8 ! tolerance for abs(sum(axxx) - 1.0) - real(r8) :: afrac_noc, afrac_cld - real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf, tmpq, tmpu - real(r8) :: tmp_afrac - real(r8) :: tmp_mfa, tmp_mfb - real(r8) :: tmp_tola, tmp_tolb - real(r8) :: tmpvecaa(0:ktebnd), tmpvecbb(0:ktebnd), tmpvecdd(0:ktebnd) - real(r8) :: tmp0202aa(0:2,0:2) - real(r8) :: updndr_area_adjust - - character(len=100) :: msg - character(len=10) :: area_name10(1:3) = & - (/ 'abnd_tavg ', 'acen_tavg ', 'acen_tfin ' /) - - - lun63 = -1 - if (idiagaa_ecpp(63) > 0) lun63 = ldiagaa_ecpp(63) - lun141 = -1 - if (idiagaa_ecpp(141) > 0) lun141 = ldiagaa_ecpp(141) - lun155 = -1 - if (idiagaa_ecpp(155) > 0) lun155 = ldiagaa_ecpp(155) - - if ((ipass_check_adjust_inputs /= 1) .and. & - (ipass_check_adjust_inputs /= 2)) return - - -! force w = 0 at kbnd >= k_max_wnonzero -! (note - doing k_max_wnonzero = ktebnd-1 would probably be ok) - k_max_wnonzero = ktebnd-1 - -! force up/dn draft mf & afrac = 0 at kbnd,kcen >= k_max_updndraft -! (note - currently set k_max_updndraft & _kclouds to almost top of domain) - k_max_updndraft = ktebnd-1 - -! force cloud fraction = 0 at kbnd,kcen >= k_max_clouds - k_max_clouds = ktebnd-1 - - nchanges(:) = 0 - - -!----------------------------------------------------- -! when ipass_check_adjust_inputs == 2, -! skip to he beginning of the special stuff for ipass_check_adjust_inputs == 2 - if (ipass_check_adjust_inputs == 2) goto 20000 -!----------------------------------------------------- - - -! -! copy from "_ecpp" arrays to "_use" arrays -! - ncls_use = ncls_ecpp - - kdraft_bot_use(:,:) = kdraft_bot_ecpp(:,:) - kdraft_top_use(:,:) = kdraft_top_ecpp(:,:) - - mtype_updnenv_use(:,:) = mtype_updnenv_ecpp(:,:) - - wbnd_bar_use(:) = wbnd_bar(:) - - mfbnd_use(:,:,:) = mfbnd_ecpp(:,:,:) - abnd_tavg_use(:,:,:) = max( abnd_tavg_ecpp(:,:,:), 0.0_r8 ) - acen_tavg_use(:,:,:) = max( acen_tavg_ecpp(:,:,:), 0.0_r8 ) - acen_tfin_use(:,:,:) = max( acen_tfin_ecpp(:,:,:), 0.0_r8 ) -! acen_tavg_use(kte,:,:) = 0.0 -! acen_tfin_use(kte,:,:) = 0.0 - -! calc rhodz_cen - rhodz_cen(kts:ktecen) = rhocen_bar(kts:ktecen)*dzcen(kts:ktecen) - - -! check that -! the mtype_updnenv_use are valid -! there is exactly one of each quiescent transport class (cloudy, clear) - jclsicc_noc = -1 - jclsicc_cld = -1 - ncls_noc = 0 - ncls_cld = 0 - msg = ' ' - - do jcls = 1, ncls_use - do icc = 1, 2 - jclsicc = jcls*10 + icc - if ((mtype_updnenv_use(icc,jcls) == mtype_quiescn_ecpp) .and. & - (icc == 1)) then - jclsicc_noc = jclsicc - ncls_noc = ncls_noc + 1 - end if - if ((mtype_updnenv_use(icc,jcls) == mtype_quiescn_ecpp) .and. & - (icc == 2)) then - jclsicc_cld = jclsicc - ncls_cld = ncls_cld + 1 - end if - - if ( ((jcls == jcls_qu) .and. & - (mtype_updnenv_use(icc,jcls) /= mtype_quiescn_ecpp)) .or. & - ((jcls /= jcls_qu) .and. & - (mtype_updnenv_use(icc,jcls) /= mtype_updraft_ecpp) .and. & - (mtype_updnenv_use(icc,jcls) /= mtype_dndraft_ecpp)) ) then - write( msg, '(a,5(1x,i5))' ) & - '*** parampollu_check_adjust_inputs - bad mtype_updnenv', & - it, jt, jcls, icc, mtype_updnenv_use(icc,jcls) - call ecpp_message( lunout, msg ) - end if - end do - end do - - if ((jclsicc_noc <= 0) .or. (ncls_noc > 1)) then - write(msg,'(a,2(1x,i5))') & - '*** parampollu_check_adjust_inputs - bad jclsicc_noc, ncls_noc =', & - jclsicc_noc, ncls_noc - call ecpp_message( lunout, msg ) - end if - if ((jclsicc_cld <= 0) .or. (ncls_cld > 1)) then - write(msg,'(a,2(1x,i5))') & - '*** parampollu_check_adjust_inputs - bad jclsicc_cld, ncls_cld =', & - jclsicc_cld, ncls_cld - call ecpp_message( lunout, msg ) - end if - if (msg /= ' ') call ecpp_error_fatal( lunout, msg ) - - - if ((ktau==4) .and. (lun155 > 0)) then - write(lun155,'(/a,3i5)') 'aaa', ktau, ipass_check_adjust_inputs - write(lun155,'(3(i5,i3,1pe16.8))') ((jcls,icc,acen_tavg_use(26,icc,jcls),icc=0,2),jcls=0,3) - end if -! *** this is for testing -! when iflag_ecpp_test_fixed_fcloud == 2/3/4/5, -! set clear fractions to 1.0/0.0/0.7/0.3 -! set cloudy fractions to 0.0/1.0/0.3/0.7 -! -! *** also set k_max_clouds=kte+1 so that it has no effect -! - if ((iflag_ecpp_test_fixed_fcloud >= 2) .and. & - (iflag_ecpp_test_fixed_fcloud <= 5)) then - k_max_clouds = ktebnd+1 - - if (iflag_ecpp_test_fixed_fcloud == 2) then - tmpvecaa(1) = 1.0_r8 - else if (iflag_ecpp_test_fixed_fcloud == 3) then - tmpvecaa(1) = 0.0_r8 - else if (iflag_ecpp_test_fixed_fcloud == 4) then - tmpvecaa(1) = 0.7_r8 - else - tmpvecaa(1) = 0.3_r8 - end if - tmpvecaa(2) = 1.0_r8 - tmpvecaa(1) - - do k = kts, ktebnd - do jcls = 1, ncls_use - tmpa = sum( mfbnd_use(k,1:2,jcls) ) - mfbnd_use(k,1:2,jcls) = tmpa*tmpvecaa(1:2) - - tmpa = sum( abnd_tavg_use(k,1:2,jcls) ) - abnd_tavg_use(k,1:2,jcls) = tmpa*tmpvecaa(1:2) - - if (k > ktecen) cycle - - tmpa = sum( acen_tavg_use(k,1:2,jcls) ) - acen_tavg_use(k,1:2,jcls) = tmpa*tmpvecaa(1:2) - - tmpa = sum( acen_tfin_use(k,1:2,jcls) ) - acen_tfin_use(k,1:2,jcls) = tmpa*tmpvecaa(1:2) - end do ! jcls - end do ! k - end if ! ((iflag_ecpp_test_fixed_fcloud >= 2) .and. (iflag_ecpp_test_fixed_fcloud <= 5)) - - -! check that fractional areas sum to 1.0 (within small tolerance) -! then normalize to exactly 1.0 -! also check and total quiescent areas are each >= a_quiescn_minaa - do k = kts, ktebnd - do jcls = 1, ncls_use - abnd_tavg_use(k,0,jcls) = sum( abnd_tavg_use(k,1:2,jcls) ) - if (k > ktecen) cycle - acen_tavg_use(k,0,jcls) = sum( acen_tavg_use(k,1:2,jcls) ) - acen_tfin_use(k,0,jcls) = sum( acen_tfin_use(k,1:2,jcls) ) - end do - do icc = 0, 2 - abnd_tavg_use(k,icc,0) = sum( abnd_tavg_use(k,icc,1:ncls_use) ) - if (k > ktecen) cycle - acen_tavg_use(k,icc,0) = sum( acen_tavg_use(k,icc,1:ncls_use) ) - acen_tfin_use(k,icc,0) = sum( acen_tfin_use(k,icc,1:ncls_use) ) - end do - - do i = 1, 3 - if ((i >= 2) .and. (k > ktecen)) cycle - if (i == 1) then - tmpa = abnd_tavg_use(k,0,0) - else if (i == 2) then - tmpa = acen_tavg_use(k,0,0) - else - tmpa = acen_tfin_use(k,0,0) - end if - if (abs(tmpa-1.0_r8) < a_sum_toleraa) cycle - write(msg,'(2a,i5,1pe15.7)') & - '*** parampollu_check_adjust_inputs - bad ', & - area_name10(i), k, tmpa - call ecpp_message( lunout, msg ) - call ecpp_error_fatal( lunout, msg ) - end do - - tmpa = abnd_tavg_use(k,0,0) - abnd_tavg_use(k,0:2,0:ncls_use) = abnd_tavg_use(k,0:2,0:ncls_use)/tmpa - if (k <= ktecen) then - tmpa = acen_tavg_use(k,0,0) - acen_tavg_use(k,0:2,0:ncls_use) = acen_tavg_use(k,0:2,0:ncls_use)/tmpa - tmpa = acen_tfin_use(k,0,0) - acen_tfin_use(k,0:2,0:ncls_use) = acen_tfin_use(k,0:2,0:ncls_use)/tmpa - end if - - do i = 1, 3 - if ((i >= 2) .and. (k > ktecen)) cycle - jcls = jcls_qu - if (i == 1) then - tmpa = abnd_tavg_use(k,0,jcls) - else if (i == 2) then - tmpa = acen_tavg_use(k,0,jcls) - else - tmpa = acen_tfin_use(k,0,jcls) - end if - msg = ' ' - if (tmpa < a_quiescn_minaa) then - write(msg,'(2a,i5,1p,2e10.2)') & - '*** parampollu_check_adjust_inputs - a_quiescent(v1) too small ', & - area_name10(i), k, tmpa, a_quiescn_minaa - call ecpp_message( lunout, msg ) - call ecpp_error_fatal( lunout, msg ) - end if - end do - - end do - - -! eliminate cloudy subareas when k >= k_max_clouds - do k = kts, ktebnd - if (k < k_max_clouds) cycle - mfbnd_use( k,1,0:ncls_use) = mfbnd_use( k,1,0:ncls_use) & - + mfbnd_use( k,2,0:ncls_use) - mfbnd_use( k,2,0:ncls_use) = 0.0_r8 - abnd_tavg_use(k,1,0:ncls_use) = abnd_tavg_use(k,1,0:ncls_use) & - + abnd_tavg_use(k,2,0:ncls_use) - abnd_tavg_use(k,2,0:ncls_use) = 0.0_r8 - if (k > ktecen) cycle - acen_tavg_use(k,1,0:ncls_use) = acen_tavg_use(k,1,0:ncls_use) & - + acen_tavg_use(k,2,0:ncls_use) - acen_tavg_use(k,2,0:ncls_use) = 0.0_r8 - acen_tfin_use(k,1,0:ncls_use) = acen_tfin_use(k,1,0:ncls_use) & - + acen_tfin_use(k,2,0:ncls_use) - acen_tfin_use(k,2,0:ncls_use) = 0.0_r8 - end do - - -! at k = kts and k >= k_max_wnonzero -! set mfbnd and wbnd_bar = 0 -! set areas = 0 for drafts (at kts set abnd=0 but allow acen>0) - do k = kts, ktebnd - if ((k > kts) .and. (k < k_max_wnonzero)) cycle - - mfbnd_use(k,:,:) = 0.0_r8 - wbnd_bar_use(k) = 0.0_r8 - - do jcls = 1, ncls_use - if (jcls == jcls_qu) then - abnd_tavg_use(k,0:2,jcls) = abnd_tavg_use(k,0:2,0) - if ((k == kts) .or. (k > ktecen)) cycle - acen_tavg_use(k,0:2,jcls) = acen_tavg_use(k,0:2,0) - acen_tfin_use(k,0:2,jcls) = acen_tfin_use(k,0:2,0) - else - abnd_tavg_use(k,0:2,jcls) = 0.0_r8 - if ((k == kts) .or. (k > ktecen)) cycle - acen_tavg_use(k,0:2,jcls) = 0.0_r8 - acen_tfin_use(k,0:2,jcls) = 0.0_r8 - end if - end do - end do - - -! at k >= k_max_updndraft -! set mfbnd = 0 and areas = 0 for drafts -! set mfbnd = abnd*wbnd_bar*rhobnd_bar for quiescents - do k = kts, ktebnd - if ((k < k_max_updndraft) .or. (k >= k_max_wnonzero)) cycle - - do jcls = 1, ncls_use - if (jcls == jcls_qu) then - abnd_tavg_use(k,0:2,jcls) = abnd_tavg_use(k,0:2,0) - mfbnd_use(k,1:2,jcls) = & - abnd_tavg_use(k,1:2,jcls)*wbnd_bar_use(k)*rhobnd_bar(k) - if (k > ktecen) cycle - acen_tavg_use(k,0:2,jcls) = acen_tavg_use(k,0:2,0) - acen_tfin_use(k,0:2,jcls) = acen_tfin_use(k,0:2,0) - else - abnd_tavg_use(k,0:2,jcls) = 0.0_r8 - mfbnd_use(k,0:2,jcls) = 0.0_r8 - if (k > ktecen) cycle - acen_tavg_use(k,0:2,jcls) = 0.0_r8 - acen_tfin_use(k,0:2,jcls) = 0.0_r8 - end if - end do - end do - - - if ((ktau==4) .and. (lun155 > 0)) then - write(lun155,'(/a,3i5)') 'bbb', ktau, ipass_check_adjust_inputs - write(lun155,'(3(i5,i3,1pe16.8))') ((jcls,icc,acen_tavg_use(26,icc,jcls),icc=0,2),jcls=0,3) - end if -! -! check updraft/dndraft -! - do 3590 jcls = 1, ncls_use - if (jcls == jcls_qu) goto 3590 - - do 3490 icc = 1, 2 - jclsicc = jcls*10 + icc - -! check kts <= kdraft_bot <= ktecen -! and kdraft_bot < kdraft_top <= ktecen - if ( (kdraft_bot_use(icc,jcls) < kts) .or. & - (kdraft_bot_use(icc,jcls) > ktecen) .or. & - (kdraft_top_use(icc,jcls) <= kdraft_bot_use(icc,jcls)) .or. & - (kdraft_top_use(icc,jcls) > ktecen) ) then - msg = '*** parampollu_check_adjust_inputs - ' // & - 'bad up/dndraft kdraft_bot/_top' - call ecpp_message( lunout, msg ) - write( msg, '(a,4(1x,i5))' ) 'it, jt, jclsicc, mtype_updnenv =', & - it, jt, jclsicc, icc, mtype_updnenv_use(icc,jcls) - call ecpp_message( lunout, msg ) - write( msg, '(a,2(1x,i5),2(1x,i10))' ) & - 'kts, ktebnd, kdraft_bot, kdraft_top =', & - kts, ktebnd, kdraft_bot_use(icc,jcls), kdraft_top_use(icc,jcls) - call ecpp_message( lunout, msg ) - call ecpp_error_fatal( lunout, msg ) - end if - -! check/adjust mbfnd_use and abnd_tavg_use -! if either is below the cut-off value, set both to zero -! also set both to zero outside of [kdraft_bot_use, kdraft_top_use] -! set the kdraft_bot/top_use -! -! note that kdraft_bot/top define bottom/top for layer centers -! for layer boundaries, the up/dndraft mfbnd and abnd are zero -! at the bottom of kdraft_bot and at the top of kdraft_top -! - ktmpa = -999888777 ; ktmpb = -999888778 - do k = kts, ktebnd - arw_draft_cut = aw_draft_cut*rhobnd_bar(k) - - tmp_mfa = mfbnd_use(k,icc,jcls) - tmp_mfb = tmp_mfa - tmpa = abnd_tavg_use(k,icc,jcls) - tmpb = tmpa - - if ( (k <= kdraft_bot_use(icc,jcls)) .or. & - (k > kdraft_top_use(icc,jcls)) .or. & - (k == kts) ) then - tmp_mfb = 0.0_r8 - else - if (mtype_updnenv_use(icc,jcls) == mtype_updraft_ecpp) then - if ( tmp_mfa < arw_draft_cut) tmp_mfb = 0.0_r8 - else - if (-tmp_mfa < arw_draft_cut) tmp_mfb = 0.0_r8 - end if - if (abnd_tavg_use(k,icc,jcls) < afrac_cut) tmp_mfb = 0.0_r8 - end if - - if (tmp_mfb /= 0.0_r8) then - tmpb = max( tmpb, afrac_cut ) - else - tmpb = 0.0_r8 - end if - - mfbnd_use(k,icc,jcls) = tmp_mfb - abnd_tavg_use(k,icc,jcls) = tmpb - if (tmp_mfb /= 0.0_r8) then - if (ktmpa <= 0) ktmpa = k-1 - ktmpb = k - end if - -! set change counts -! increment/decrement abnd of quiescent class if up/dndraft abnd has changed - if (tmp_mfb /= tmp_mfa) then - nchanges(1) = nchanges(1) + 1 - end if - if (tmpb /= tmpa) then - nchanges(2) = nchanges(2) + 1 - abnd_tavg_use(k,icc,jcls_qu) = abnd_tavg_use(k,icc,jcls_qu) & - + (tmpa-tmpb) - end if - - end do - - kdraft_bot_use(icc,jcls) = ktmpa - kdraft_top_use(icc,jcls) = ktmpb - -! check/adjust acen_tavg_use -! set acen_tavg to zero outside of kdraft_bot:kdraft_top -! set acen_tavg to zero if abnd_tavg=0 at both layer boundaries (14-apr-2009) - do k = kts, ktecen - tmpa = acen_tavg_use(k,icc,jcls) - tmpb = tmpa - - if ( (k < kdraft_bot_use(icc,jcls)) .or. & - (k > kdraft_top_use(icc,jcls)) ) then - tmpb = 0.0_r8 - else - tmpe = 0.5_r8*( abnd_tavg_use(k, icc,jcls) + & - abnd_tavg_use(k+1,icc,jcls) ) - if (tmpe > 0.0_r8) then - tmpb = max( afrac_cut, tmpe ) - else - tmpb = 0.0_r8 - end if - end if - - if (tmpb /= tmpa) then - nchanges(3) = nchanges(3) + 1 - acen_tavg_use(k,icc,jcls_qu) = & - acen_tavg_use(k,icc,jcls_qu) + (tmpa-tmpb) - end if - - acen_tavg_use(k,icc,jcls) = tmpb - end do - -! check/adjust acen_tfin_use -! set acen_tfin to zero if it is < afrac_cut or if k >= k_max_updndraft -! set acen_tfin to zero if acen_tavg=0 (14-apr-2009) -! for case of parampollu_opt == 2220, but iflag_ecpp_test_fixed_fcloud /= 2,3,4,5 -! do not allow acen_tfin=0 if acen_tavg>0 -! (14-apr-2009 -- do similar for all parampollu_opt) - ispecial_check_acen_tfin = 0 - if (parampollu_opt == 2220) then - ispecial_check_acen_tfin = 1 - if ((iflag_ecpp_test_fixed_fcloud >= 2) .and. & - (iflag_ecpp_test_fixed_fcloud <= 5)) ispecial_check_acen_tfin = 0 - end if - if (ispecial_check_acen_tfin <= 0) then - ispecial_check_acen_tfin = 2 - if ((iflag_ecpp_test_fixed_fcloud >= 2) .and. & - (iflag_ecpp_test_fixed_fcloud <= 5)) ispecial_check_acen_tfin = 0 - end if - - do k = kts, ktecen - tmpa = acen_tfin_use(k,icc,jcls) - tmpb = tmpa - - if ((tmpa < afrac_cut) .or. & - (k >= k_max_updndraft)) then - tmpb = 0.0_r8 - end if - if (acen_tavg_use(k,icc,jcls) <= 0.0_r8) then - tmpb = 0.0_r8 - end if - - if (ispecial_check_acen_tfin > 0) then - if (tmpb < afrac_cut) then - if (acen_tavg_use(k,icc,jcls) >= afrac_cut) then - if (ispecial_check_acen_tfin == 2) then - tmpb = max( 0.5_r8*acen_tavg_use(k,icc,jcls), afrac_cut ) - else - tmpb = acen_tavg_use(k,icc,jcls) - end if - end if - end if - end if - - if (tmpb /= tmpa) then - nchanges(4) = nchanges(4) + 1 - acen_tfin_use(k,icc,jcls_qu) = & - acen_tfin_use(k,icc,jcls_qu) + (tmpa-tmpb) - end if - - acen_tfin_use(k,icc,jcls) = tmpb - end do - -! for empty sub-class (mfbnd/abnd/acen=0 at all levels), -! set kdraft_bot/top_use to ktecen - if ((kdraft_bot_use(icc,jcls) < -999888000) .and. & - (kdraft_top_use(icc,jcls) < -999888000)) then - kdraft_bot_use(icc,jcls) = ktecen - kdraft_top_use(icc,jcls) = ktecen - end if - -3490 continue - -! sum clear and cloudy mfbnd_use - do k = kts, ktebnd - mfbnd_use(k,0,jcls) = sum( mfbnd_use(k,1:2,jcls) ) - end do - -3590 continue - - -! -! check/adjust quiescent transport-class -! - - if ((ktau==4) .and. (lun155 > 0)) then - write(lun155,'(/a,3i5)') 'ccc', ktau, ipass_check_adjust_inputs - write(lun155,'(3(i5,i3,1pe16.8))') ((jcls,icc,acen_tavg_use(26,icc,jcls),icc=0,2),jcls=0,3) - end if -! first set to zero any areas that are < afrac_cut - do k = kts, ktebnd - do i = 1, 3 - jcls = jcls_qu - if ((i >= 2) .and. (k > ktecen)) cycle - - if (i == 1) then - tmpvecaa(0:2) = abnd_tavg_use(k,0:2,jcls) - else if (i == 2) then - tmpvecaa(0:2) = acen_tavg_use(k,0:2,jcls) - else - tmpvecaa(0:2) = acen_tfin_use(k,0:2,jcls) - end if - - tmpvecbb(0:2) = tmpvecaa(0:2) - tmpvecbb(0) = tmpvecbb(1) + tmpvecbb(2) - do icc = 1, 2 - if (tmpvecbb(icc) < afrac_cut) then - tmpvecbb(3-icc) = tmpvecbb(0) - tmpvecbb(icc) = 0.0_r8 - end if - end do - -! for case of parampollu_opt == 2220, but iflag_ecpp_test_fixed_fcloud /= 2,3,4,5 -! do not allow acen_tfin=0 if acen_tavg>0 - if ((i == 3) .and. (ispecial_check_acen_tfin > 0)) then - do icc = 1, 2 - if (tmpvecbb(icc) < afrac_cut) then - if (acen_tavg_use(k,icc,jcls) >= afrac_cut) then - tmpvecbb(icc) = acen_tavg_use(k,icc,jcls) - tmpvecbb(3-icc) = tmpvecbb(0) - tmpvecbb(icc) - end if - end if - end do - end if - - if ((tmpvecbb(1) < 0.0_r8) .or. & - (tmpvecbb(2) < 0.0_r8) .or. & - (tmpvecbb(0) < a_quiescn_minbb)) then -! at this point, the total (adjusted) quiescent area is too small - write(msg,'(a,1p,3e12.4)') & - ' tmpvecaa(0:2) = v1 quiescent areas =', tmpvecaa(0:2) - call ecpp_message( lunout, msg ) - write(msg,'(a,1p,3e12.4)') & - ' tmpvecbb(0:2) = v2 quiescent areas =', tmpvecbb(0:2) - call ecpp_message( lunout, msg ) - - write(msg,'(2a,2i5)') & - '*** parampollu_check_adjust_inputs - a_quiescent(v2) too small ', & - area_name10(i), k, i - call ecpp_message( lunout, msg ) - call ecpp_error_fatal( lunout, msg ) - end if - - if (i == 1) then - abnd_tavg_use(k,0:2,jcls) = tmpvecbb(0:2) - else if (i == 2) then - acen_tavg_use(k,0:2,jcls) = tmpvecbb(0:2) - else - acen_tfin_use(k,0:2,jcls) = tmpvecbb(0:2) - end if - end do ! i = 1, 3 - end do ! k = kts, ktebnd - - -! recalc summed area fractions - do k = kts, ktebnd - do jcls = 1, ncls_use - abnd_tavg_use(k,0,jcls) = sum( abnd_tavg_use(k,1:2,jcls) ) - if (k > ktecen) cycle - acen_tavg_use(k,0,jcls) = sum( acen_tavg_use(k,1:2,jcls) ) - acen_tfin_use(k,0,jcls) = sum( acen_tfin_use(k,1:2,jcls) ) - end do - do icc = 0, 2 - abnd_tavg_use(k,icc,0) = sum( abnd_tavg_use(k,icc,1:ncls_use) ) - if (k > ktecen) cycle - acen_tavg_use(k,icc,0) = sum( acen_tavg_use(k,icc,1:ncls_use) ) - acen_tfin_use(k,icc,0) = sum( acen_tfin_use(k,icc,1:ncls_use) ) - end do - end do ! k = kts, ktebnd - - -! calc kdraft_bot_use & kdraft_top_use - jcls = jcls_qu - do icc = 1, 2 - ktmpa = -999888777 ; ktmpb = -999888778 - do k = kts, ktecen - if (acen_tavg_use(k,icc,jcls) > 0.0_r8) then - if (ktmpa <= 0) ktmpa = k - ktmpb = k - end if - end do - kdraft_bot_use(icc,jcls) = ktmpa - kdraft_top_use(icc,jcls) = ktmpb - end do - -! normally allow cloudy quiescent to be empty -! if iflag_ecpp_test_fixed_fcloud=3 (special testing), allow clear quiescent to be empty - icc = 2 - if (iflag_ecpp_test_fixed_fcloud == 3) icc = 1 - if ((kdraft_bot_use(icc,jcls) < -999888000) .and. & - (kdraft_top_use(icc,jcls) < -999888000)) then - kdraft_bot_use(icc,jcls) = ktecen - kdraft_top_use(icc,jcls) = ktecen - end if - -! check for validity of kdraft_bot_use & kdraft_top_use - ka = min( kdraft_bot_use(1,jcls), kdraft_bot_use(2,jcls) ) - kb = max( kdraft_top_use(1,jcls), kdraft_top_use(2,jcls) ) - do icc = 1, 2 - if ( (kdraft_bot_use(icc,jcls) < kts) .or. & - (kdraft_bot_use(icc,jcls) > ktecen) .or. & - (kdraft_bot_use(icc,jcls) > kdraft_top_use(icc,jcls)) .or. & - (kdraft_top_use(icc,jcls) > ktecen) .or. & - (ka /= kts) .or. & - (kb /= ktecen) ) then - jclsicc = jcls*10 + icc - msg = '*** parampollu_check_adjust_inputs - ' // & - 'bad quiescent transport-class kdraft_bot/top_use' - call ecpp_message( lunout, msg ) - write( msg, '(a,4(1x,i5))' ) 'it, jt, jclsicc, mtype_updnenv =', & - it, jt, jclsicc, mtype_updnenv_use(icc,jcls) - call ecpp_message( lunout, msg ) - write( msg, '(a,2(1x,i5),2(1x,i10))' ) & - 'kts, ktebnd, kdraft_bot, kdraft_top =', & - kts, ktebnd, kdraft_bot_use(icc,jcls), kdraft_top_use(icc,jcls) - call ecpp_message( lunout, msg ) - call ecpp_error_fatal( lunout, msg ) - end if - end do - - -!----------------------------------------------------- -! here ipass_check_adjust_inputs == 1 -! skip over the special stuff for ipass_check_adjust_inputs == 2 -!----------------------------------------------------- - if ((ktau==4) .and. (lun155 > 0)) then - write(lun155,'(/a,3i5)') 'ddd', ktau, ipass_check_adjust_inputs - write(lun155,'(3(i5,i3,1pe16.8))') ((jcls,icc,acen_tavg_use(26,icc,jcls),icc=0,2),jcls=0,3) - end if - goto 30000 - - -!----------------------------------------------------- -! special stuff for ipass_check_adjust_inputs == 2 -!----------------------------------------------------- -20000 continue - ipass_2_changes = 0 - - -! for testing only -- reduce up/dndraft areas -! *** NOTE / TODO - in the "new" code, this may not work correctly - ido_updndr_area_adjust = 0 - if (ido_updndr_area_adjust > 0) then - ipass_2_changes = ipass_2_changes + 1 - - updndr_area_adjust = 1.0_r8 - tmpb = 1.0_r8 - updndr_area_adjust - do k = kts, ktebnd - do icc = 0, 2 - do jcls = 1, ncls_use - if (jcls == jcls_qu) cycle - - abnd_tavg_use(k,icc,jcls_qu) = abnd_tavg_use(k,icc,jcls_qu) & - + abnd_tavg_use(k,icc,jcls )*tmpb - abnd_tavg_use(k,icc,jcls ) = abnd_tavg_use(k,icc,jcls )*updndr_area_adjust - - if (k > ktecen) cycle - - acen_tavg_use(k,icc,jcls_qu) = acen_tavg_use(k,icc,jcls_qu) & - + acen_tavg_use(k,icc,jcls )*tmpb - acen_tavg_use(k,icc,jcls ) = acen_tavg_use(k,icc,jcls )*updndr_area_adjust - - acen_tfin_use(k,icc,jcls_qu) = acen_tfin_use(k,icc,jcls_qu) & - + acen_tfin_use(k,icc,jcls )*tmpb - acen_tfin_use(k,icc,jcls ) = acen_tfin_use(k,icc,jcls )*updndr_area_adjust - - end do - end do - end do - end if ! (ido_updndr_area_adjust > 0) - - -! for testing only -- zero out downdraft -! *** NOTE / TODO - in the "new" code, this may not work correctly - ido_downdr_area_zeroout = 0 - if (ido_downdr_area_zeroout > 0) then - ipass_2_changes = ipass_2_changes + 1 - - do k = kts, ktebnd - do icc = 0, 2 - do jcls = 1, ncls_use - if (jcls == jcls_qu) cycle - if (mtype_updnenv_use(icc,jcls) /= mtype_dndraft_ecpp) cycle - - abnd_tavg_use(k,icc,jcls_qu) = abnd_tavg_use(k,icc,jcls_qu) & - + abnd_tavg_use(k,icc,jcls ) - abnd_tavg_use(k,icc,jcls ) = 0.0_r8 - - mfbnd_use( k,icc,jcls_qu) = mfbnd_use( k,icc,jcls_qu) & - + mfbnd_use( k,icc,jcls ) - mfbnd_use( k,icc,jcls ) = 0.0_r8 - - if (k > ktecen) cycle - - acen_tavg_use(k,icc,jcls_qu) = acen_tavg_use(k,icc,jcls_qu) & - + acen_tavg_use(k,icc,jcls ) - acen_tavg_use(k,icc,jcls ) = 0.0_r8 - - acen_tfin_use(k,icc,jcls_qu) = acen_tfin_use(k,icc,jcls_qu) & - + acen_tfin_use(k,icc,jcls ) - acen_tfin_use(k,icc,jcls ) = 0.0_r8 - end do - end do - end do - end if ! (ido_downdr_area_zeroout > 0) - - -! if (ipass_2_changes == 0) return - - -!----------------------------------------------------- -! common stuff for ipass_check_adjust_inputs == 1,2 -!----------------------------------------------------- -30000 continue -! -! check/adjust quiescent abnd_tavg_use (and mfbnd_use) -! -! before 15-jul-2008 code -! code above may have set afrac_bnd=0 in some transport-class -! now adjust afrac_bnd in quiescent transport-class so that -! all-transport-class-sum = 1.0 -! -! on/after 15-jul-2008 code -! the post-processor does not correctly identify the clear versus -! cloudy parts of the quiescent abnd_tavg -! (it calcs an average qcloud for 2 layers adjacent to the boundary, -! and if qcloud in either layer exceeds cutoff, then the average -! will too (almost always), so this is biased) -! so instead, set these based on the clear/cloud quiescent acen_tavg_use -! also, apportion the quiescent mfbnd_use similarly -! - mfbnd_quiescn_up(:,:,:) = 0.0_r8 - mfbnd_quiescn_dn(:,:,:) = 0.0_r8 - - jcls = jcls_qu - do k = kts, ktecen -! first calc tmpvecdd(k) = fraction of layer-k quiescent-class that is clear - ardz_cut = afrac_cut*rhodz_cen(k)*0.3_r8 - if ((acen_tavg_use(k,1,jcls) >= ardz_cut) .and. & - (acen_tavg_use(k,2,jcls) >= ardz_cut)) then - ! clear and cloudy both > 0 - tmpvecdd(k) = acen_tavg_use(k,1,jcls)/acen_tavg_use(k,0,jcls) - tmpvecdd(k) = max( 0.0_r8, min( 1.0_r8, tmpvecdd(k) ) ) - else if (acen_tavg_use(k,2,jcls) >= ardz_cut) then - ! only cloudy > 0 - tmpvecdd(k) = 0.0_r8 - else - ! only clear > 0 - tmpvecdd(k) = 1.0_r8 - end if - end do - - - do k = kts+1, ktecen -! calc (total quiescent "w-prime" mass flux) = - (sum of up/dndraft mass fluxes) - tmp_mfa = 0.0_r8 - do jcls = 1, ncls_use - if (jcls == jcls_qu) cycle - mfbnd_use(k,0,jcls) = sum( mfbnd_use(k,1:2,jcls) ) - tmp_mfa = tmp_mfa + mfbnd_use(k,0,jcls) - end do - jcls = jcls_qu - mfbnd_use(k,0,jcls) = -tmp_mfa - -! partition total quiescent mass flux to clear/cloudy using the -! quiescent clear/cloud amounts in the "upwind" layer - if (mfbnd_use(k,0,jcls) < 0.0_r8) then - tmpvecaa(1) = tmpvecdd(k) ! upwind is layer above - tmpvecbb(1) = tmpvecdd(k-1) ! downwind is layer below - else - tmpvecaa(1) = tmpvecdd(k-1) ! upwind is layer below - tmpvecbb(1) = tmpvecdd(k) ! downwind is layer above - end if - tmpvecaa(2) = 1.0_r8 - tmpvecaa(1) - tmpvecbb(2) = 1.0_r8 - tmpvecbb(1) - - mfbnd_use(k,1:2,jcls) = mfbnd_use(k,0,jcls)*tmpvecaa(1:2) -! same for abnd - abnd_tavg_use(k,1:2,jcls) = abnd_tavg_use(k,0,jcls)*tmpvecaa(1:2) - -! do other sums - do icc = 0, 2 - mfbnd_use( k,icc,0) = sum( mfbnd_use( k,icc,1:ncls_use) ) - abnd_tavg_use(k,icc,0) = sum( abnd_tavg_use(k,icc,1:ncls_use) ) - end do - - -! now calculate more detailed up and down fluxes -! mfbnd_quiescn_up(k,jccfrom,jcctooo) is mbbnd from (k,jccfrom) to (k+1,jcctooo) -! with jccfrom=0/1/2=both/clear/cloudy; and jcctooo=0/1/2=similar -! -! the clear-->both and cloudy-->both are already determined -! the clear-->clear and cloudy-->cloudy are calculated maximum overlap -! of cloudy and clear regions -! the clear-->cloudy and cloudy-->clear are simply what is left -! -! tmpvecaa holds clear/cloudy fractions of the upwind layer -! tmpvecbb holds clear/cloudy fractions of the downwind layer - jcls = jcls_qu - tmp0202aa(0:2,0) = mfbnd_use(k,0:2,jcls) - tmp0202aa(0:2,1:2) = 0.0_r8 - do ja = 1, 2 - jb = 3-ja - tmpa = 0.0_r8 - if (tmpvecaa(ja) > 0.0_r8) & - tmpa = min(tmpvecbb(ja),tmpvecaa(ja))/tmpvecaa(ja) - tmpa = max( 0.0_r8, min( 1.0_r8, tmpa ) ) - tmp0202aa(ja,ja) = tmp0202aa(ja,0)*tmpa - tmp0202aa(ja,jb) = tmp0202aa(ja,0)*(1.0_r8-tmpa) - end do - do jb = 1, 2 - tmp0202aa(0,jb) = sum( tmp0202aa(1:2,jb) ) - end do - if (mfbnd_use(k,0,jcls) < 0.0_r8) then - mfbnd_quiescn_dn(k,0:2,0:2) = tmp0202aa(0:2,0:2) - else if (mfbnd_use(k,0,jcls) > 0.0_r8) then - mfbnd_quiescn_up(k,0:2,0:2) = tmp0202aa(0:2,0:2) - end if - -! if ((ipass_check_adjust_inputs == 2) .and. (lun141 > 0)) then -! if (k == kts+1) write( 141, '(/a,2i5)' ) & -! 'mfbnd_quiescn at ktau, ipass =', ktau, ipass_check_adjust_inputs -! write( 141, '(i3,1p,2e11.3,2(2x,4e11.3))' ) k, mfbnd_use(k,1:2,jcls), & -! mfbnd_quiescn_up(k,1:2,1:2), mfbnd_quiescn_dn(k,1:2,1:2) -! end if - - end do ! k = kts+1, ktecen - - -! for "empty" drafts, reset the kbot & ktop, and also the mtype_updnenv_use -! -! *** currently the reset of mtype_updnenv_use is deactivated - kdraft_bot_tmp(:,:) = kdraft_bot_use(:,:) - kdraft_top_tmp(:,:) = kdraft_top_use(:,:) - mtype_updnenv_tmp(:,:) = mtype_updnenv_use(:,:) - if (lun63 > 0) write(lun63,'(a/2a)') & - 'parampollu_check_adjust_inputs transport-class summary', & - ' jcls mcc, mf/af nonzero, mtype_tmp/use, ', & - 'kbase/top_inp, kbase/top_tmp, kbase/top_use' - do jcls = 1, ncls_use - do icc = 1, 2 - itmpa = 0 - itmpb = 0 - do k = kts, ktebnd - if (mfbnd_use(k,icc,jcls) /= 0.0_r8) itmpa = itmpa + 1 - if (abnd_tavg_use(k,icc,jcls) /= 0.0_r8) itmpb = itmpb + 1 - end do - if (itmpa+itmpb <= 0) then - kdraft_bot_use(icc,jcls) = ktecen - kdraft_top_use(icc,jcls) = ktecen -! if (mtype_updnenv_use(icc,jcls) == mtype_updraft_ecpp) then -! mtype_updnenv_use(icc,jcls) = mtype_upempty_ecpp -! else if (mtype_updnenv_use(icc,jcls) == mtype_dndraft_ecpp) then -! mtype_updnenv_use(icc,jcls) = mtype_dnempty_ecpp -! else -! mtype_updnenv_use(icc,jcls) = mtype_quempty_ecpp -! end if - end if - if (lun63 > 0) write(lun63,'(2i5,5(5x,2i5))') & - jcls, icc, itmpa, itmpb, & - mtype_updnenv_tmp(icc,jcls), mtype_updnenv_use(icc,jcls), & - kdraft_bot_ecpp(icc,jcls), kdraft_top_ecpp(icc,jcls), & - kdraft_bot_tmp(icc,jcls), kdraft_top_tmp(icc,jcls), & - kdraft_bot_use(icc,jcls), kdraft_top_use(icc,jcls) - end do - end do - - -! now adjust area with precipitation - acen_prec_use(:,:,:) = 0.0_r8 - do jcls = 1, ncls_use - do icc = 1, 2 - do k = kts, ktecen - if (acen_tavg_use(k,icc,jcls) < afrac_cut) cycle - if (acen_prec_ecpp(k,icc,jcls) < afrac_cut) cycle - - tmpa = acen_prec_ecpp(k,icc,jcls) ! portion of sub-area with precip - tmpb = acen_tavg_use(k,icc,jcls) - tmpa ! portion of sub-area without precip - if (tmpb < afrac_cut) tmpa = acen_tavg_use(k,icc,jcls) - acen_prec_use(k,icc,jcls) = tmpa - end do - end do - end do - - -! final recalc summed area fractions - do k = kts, ktebnd - do jcls = 1, ncls_use - abnd_tavg_use(k,0,jcls) = sum( abnd_tavg_use(k,1:2,jcls) ) - if (k > ktecen) cycle - acen_tavg_use(k,0,jcls) = sum( acen_tavg_use(k,1:2,jcls) ) - acen_tfin_use(k,0,jcls) = sum( acen_tfin_use(k,1:2,jcls) ) - acen_prec_use(k,0,jcls) = sum( acen_prec_use(k,1:2,jcls) ) - end do - do icc = 0, 2 - abnd_tavg_use(k,icc,0) = sum( abnd_tavg_use(k,icc,1:ncls_use) ) - if (k > ktecen) cycle - acen_tavg_use(k,icc,0) = sum( acen_tavg_use(k,icc,1:ncls_use) ) - acen_tfin_use(k,icc,0) = sum( acen_tfin_use(k,icc,1:ncls_use) ) - acen_prec_use(k,icc,0) = sum( acen_prec_use(k,icc,1:ncls_use) ) - end do - end do - - - if (lun63 > 0) then - write(lun63,'(a,i2)') 'parampollu_check_adjust_inputs -- ipass =', & - ipass_check_adjust_inputs - do k = 1, 10 - write(lun63,'(a,i2,a,i10)') ' nchanges(', k, ') =', nchanges(k) - end do - end if ! (lun63 > 0) - - - if ((ktau==4) .and. (lun155 > 0)) then - write(lun155,'(/a,3i5)') 'eee', ktau, ipass_check_adjust_inputs - write(lun155,'(3(i5,i3,1pe16.8))') ((jcls,icc,acen_tavg_use(26,icc,jcls),icc=0,2),jcls=0,3) - end if - - return - end subroutine parampollu_check_adjust_inputs - - - -!----------------------------------------------------------------------- - subroutine parampollu_1clm_dumpaa( & - ktau, dtstep, ktau_pp, dtstep_pp, & - tcen_bar, pcen_bar, rhocen_bar, dzcen, & - rhobnd_bar, zbnd, wbnd_bar, & - chem_bar, & - ncls_ecpp, & - kdraft_bot_ecpp, kdraft_top_ecpp, & - mtype_updnenv_ecpp, & - mfbnd, abnd_tavg, & - acen_tavg, acen_tbeg, acen_tfin, & - it, jt, kts,ktebnd,ktecen, & - lun ) - -!----------------------------------------------------------------------- -! DESCRIPTION -! -! parampollu_1clm_dumpaa does a diagnostic print of -! numerous ecpp arrays -! -!----------------------------------------------------------------------- - - use module_data_ecpp1 - - use module_ecpp_util, only: ecpp_error_fatal, ecpp_message - -! arguments - integer, intent(in) :: & - ktau, ktau_pp, & - it, jt, kts, ktebnd, ktecen, & - lun -! ktau - time step number -! ktau_pp - time step number for "parameterized pollutants" calculations - -! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile" -! chem_driver and routines under it do calculations -! over these spatial indices. - - real(r8), intent(in) :: dtstep, dtstep_pp -! dtstep - main model time step (s) -! dtstep_pp - time step (s) for "parameterized pollutants" calculations - - real(r8), intent(in), dimension( kts:ktecen ) :: & - tcen_bar, pcen_bar, rhocen_bar, dzcen - real(r8), intent(in), dimension( kts:ktebnd ) :: & - rhobnd_bar, zbnd, wbnd_bar - - real(r8), intent(in), dimension( kts:ktecen, 1:num_chem_ecpp ) :: & - chem_bar - - integer, intent(in) :: ncls_ecpp - - integer, intent(in), dimension( 1:2, 1:maxcls_ecpp ) :: & - kdraft_bot_ecpp, kdraft_top_ecpp, & - mtype_updnenv_ecpp - - real(r8), intent(in), dimension( kts:ktebnd, 0:2, 0:maxcls_ecpp ) :: & - mfbnd, abnd_tavg - real(r8), intent(in), dimension( kts:ktecen, 0:2, 0:maxcls_ecpp ) :: & - acen_tavg, acen_tbeg, acen_tfin - - character(len=8), dimension( kts:ktebnd ) :: dumchar8 - - -! local variables - integer :: iclrcld - integer :: itmp_mtype_clrcldy(1:2) - integer :: jcls, jclsaa, jclsbb - integer :: k, l - - real(r8) :: duma - real(r8), dimension( kts:ktebnd ) :: dumarr1, dumarr2, dumarr3, dumarr4, dumarr5 - - -! -! output with same format as ppboxmakeinp01 -! -9400 format( a ) -9410 format( 5i15 ) -9415 format( a, i10 ) -9416 format( a, 5i10 ) -!9420 format( 5(1pe15.7) ) -9420 format( 5(1pe12.4) ) - - if (lun <= 0) return - - - itmp_mtype_clrcldy(1) = mtype_nocloud_ecpp - itmp_mtype_clrcldy(2) = mtype_iscloud_ecpp - -! write(lun,9400) 'output from ppboxmakeinp01' - write(lun,9400) - write(lun,9400) - write(lun,9416) 'output from ppboxmakeinp01 - ktau, ktau_pp', & - ktau, ktau_pp - - write(lun,9400) 'kts, kte, ncls_ecpp_clm' - write(lun,9410) kts, ktebnd, ncls_ecpp - - write(lun,9410) num_chem_ecpp - - write(lun,9400) 'rho,z,w bnd' - do k = kts, ktebnd - write(lun,9420) rhobnd_bar(k), & - zbnd(k), wbnd_bar(k) - end do - - write(lun,9400) 'p,t,rho cen' - do k = kts, ktecen - write(lun,9420) pcen_bar(k), tcen_bar(k), rhocen_bar(k) - end do - - do l = 1, num_chem_ecpp - write(lun,9415) 'chem ', l - write(lun,9420) (chem_bar(k,l), k=kts,ktecen) - end do - - do jcls = 1, ncls_ecpp - do iclrcld = 1, 2 - write(lun,9416) 'jcls, iclrcld // mtype a,b,c; kdraft a,b', jcls, iclrcld - write(lun,9410) & - mtype_updnenv_ecpp(iclrcld,jcls), & - itmp_mtype_clrcldy(iclrcld), mtype_noprecip_ecpp, & - kdraft_bot_ecpp(iclrcld,jcls), kdraft_top_ecpp(iclrcld,jcls) - - write(lun,9416) 'afrac', jcls, iclrcld - write(lun,9420) (abnd_tavg(k,iclrcld,jcls), k=kts,ktebnd) - - write(lun,9416) 'mf', jcls, iclrcld - write(lun,9420) (mfbnd(k,iclrcld,jcls), k=kts,ktebnd) - end do - end do - - - write(lun,'(/a)') 'baraa' - write(lun,'(a)') ' k z(km) p(mb) rho t(C) w(cm/s)' - do k = ktebnd, kts, -1 - if (k < ktebnd) then - duma = zbnd(k) + 0.5_r8*dzcen(k) - write(lun,'(i2,2x,f8.3,f8.1,f8.4,f8.1, 8x)') & - k, duma*1.0e-3_r8, pcen_bar(k)*1.0e-2_r8, rhocen_bar(k), tcen_bar(k)-273.16_r8 - end if - duma = k-0.5_r8 - write(lun,'( f4.1,f8.3, 8x,f8.4, 8x,f8.2)') & - duma, zbnd(k)*1.0e-3_r8, rhobnd_bar(k), wbnd_bar(k)*1.0e2_r8 - end do - write(lun,'(a)') ' k z(km) p(mb) rho t(C) w(cm/s)' - - write(lun,'(/a)') 'draftaa' - do jcls = 1, ncls_ecpp - do iclrcld = 1, 2 - write(lun,'(/a,7i5)') 'draftbb - ktau_pp, jcls, iclrcld, updn, clrcldy, top, bot =', & - ktau_pp, jcls, iclrcld, & - mtype_updnenv_ecpp(iclrcld,jcls), itmp_mtype_clrcldy(iclrcld), & - kdraft_bot_ecpp(iclrcld,jcls), kdraft_top_ecpp(iclrcld,jcls) - - write(lun,'(a)') 'afrac' - do k = kts, ktebnd - duma = abnd_tavg(k,iclrcld,jcls) - if (duma == 0.0_r8) then - dumchar8(k) = ' 0. ' - else if (abs(duma) >= 5.0e-5_r8) then - write(dumchar8(k),'(f8.4)') duma - else - write(dumchar8(k),'(1p,e8.0)') duma - end if - end do - write(lun,'(15a)') (dumchar8(k), k=kts,ktebnd) - - do k = kts, ktebnd - duma = max( 1.0e-10_r8, abnd_tavg(k,iclrcld,jcls) ) - dumarr1(k) = mfbnd(k,iclrcld,jcls)/(rhobnd_bar(k)*duma) - end do - write(lun,'(a)') 'w' - write(lun,'(15f8.4)') (dumarr1(k), k=kts,ktebnd) - - write(lun,'(a)') 'mfbnd' - write(lun,'(1p,10e12.5)') (mfbnd(k,iclrcld,jcls), k=kts,ktebnd) - - write(lun,'(a)') 'abnd_tavg' - write(lun,'(1p,10e12.5)') (abnd_tavg(k,iclrcld,jcls), k=kts,ktebnd) -! write(lun,'(1p,15e8.1 )') (abnd_tavg(k,iclrcld,jcls), k=kts,ktebnd) - - write(lun,'(a)') 'acen_tavg' - write(lun,'(1p,10e12.5)') (acen_tavg(k,iclrcld,jcls), k=kts,ktecen) - - write(lun,'(a)') 'acen_tbeg' - write(lun,'(1p,10e12.5)') (acen_tbeg(k,iclrcld,jcls), k=kts,ktecen) - - write(lun,'(a)') 'acen_tfin' - write(lun,'(1p,10e12.5)') (acen_tfin(k,iclrcld,jcls), k=kts,ktecen) - - end do - end do - - do k = kts, ktebnd - dumarr1(k) = 0.0_r8 - dumarr2(k) = 0.0_r8 - dumarr3(k) = 0.0_r8 - dumarr4(k) = 0.0_r8 - dumarr5(k) = 0.0_r8 - do jcls = 1, ncls_ecpp - do iclrcld = 1, 2 - dumarr1(k) = dumarr1(k) + mfbnd(k,iclrcld,jcls) - dumarr2(k) = dumarr2(k) + abnd_tavg(k,iclrcld,jcls) - if (k > ktecen) cycle - dumarr3(k) = dumarr3(k) + acen_tavg(k,iclrcld,jcls) - dumarr4(k) = dumarr4(k) + acen_tbeg(k,iclrcld,jcls) - dumarr5(k) = dumarr5(k) + acen_tfin(k,iclrcld,jcls) - end do - end do - duma = max( 1.0e-10_r8, dumarr2(k) ) - dumarr1(k) = dumarr1(k)/(rhobnd_bar(k)*duma) - end do - write(lun,'(/a,4i5)') 'draftbb - ktau_pp, all subs =', & - ktau_pp - write(lun,'(a)') 'wbar' - write(lun,'(12f10.5)') (wbnd_bar(k), k=kts,ktebnd) - write(lun,'(a)') '(mfbnd summed over all subs)/rhobnd' - write(lun,'(12f10.5)') (dumarr1(k), k=kts,ktebnd) - write(lun,'(a)') '(abnd_tavg-1) summed over all subs' - write(lun,'(1p,12e10.2)') ((dumarr2(k)-1.0_r8), k=kts,ktebnd) - write(lun,'(a)') '(acen_tavg-1) summed over all subs' - write(lun,'(1p,12e10.2)') ((dumarr3(k)-1.0_r8), k=kts,ktecen) - write(lun,'(a)') '(acen_tbeg-1) summed over all subs' - write(lun,'(1p,12e10.2)') ((dumarr4(k)-1.0_r8), k=kts,ktecen) - write(lun,'(a)') '(acen_tfin-1) summed over all subs' - write(lun,'(1p,12e10.2)') ((dumarr5(k)-1.0_r8), k=kts,ktecen) - - - do jclsaa = 1, ncls_ecpp, 3 - jclsbb = min( jclsaa+2, ncls_ecpp ) - write(lun,'(/a,3i5)') 'draftcc - ktau_pp, jclsaa, jclsbb', & - ktau_pp, jclsaa, jclsbb - write(lun,'(a)') & - 'k, acen_tavg(k,1:2,jclsaa:jclsbb), mfbnd(k+1,1:2,jclsaa:jclsbb)' - do k = ktecen, kts, -1 - write(lun,'(i3,2x,3(1x,2f8.5),2x,1p,3(1x,2e10.2))') k, & - acen_tavg(k,1:2,jclsaa:jclsbb), & - mfbnd(k,1:2,jclsaa:jclsbb) - end do - end do - - - - return - end subroutine parampollu_1clm_dumpaa - - - -!----------------------------------------------------------------------- - end module module_ecpp_td2clm diff --git a/src/physics/spcam/ecpp/module_ecpp_util.F90 b/src/physics/spcam/ecpp/module_ecpp_util.F90 deleted file mode 100644 index 5318fd75bd..0000000000 --- a/src/physics/spcam/ecpp/module_ecpp_util.F90 +++ /dev/null @@ -1,112 +0,0 @@ -!#********************************************************************************** -! This computer software was prepared by Battelle Memorial Institute, hereinafter -! the Contractor, under Contract No. DE-AC05-76RL0 1830 with the Department of -! Energy (DOE). NEITHER THE GOVERNMENT NOR THE CONTRACTOR MAKES ANY WARRANTY, -! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS SOFTWARE. -! -! miscellaneous debuging routines for CBMZ and MOSAIC -!********************************************************************************** - module module_ecpp_util - - use cam_abortutils, only: endrun - - contains - -!----------------------------------------------------------------------- - subroutine ecpp_debugmsg( lun, level, str ) -! -! when lun > 0, writes "str" to unit "lun" -! when lun <= 0, passes "str" on to wrf_debug -! - implicit none -! subr arguments - integer, intent(in) :: lun, level - character(len=*), intent(in) :: str -! local variables - integer n - - n = max( 1, len_trim(str) ) - if (lun .ge. 0) then - write(lun,'(a)') str(1:n) - else - call endrun( str(1:n) ) - end if - return - end subroutine ecpp_debugmsg - - -!----------------------------------------------------------------------- - subroutine ecpp_message( lun, str ) -! -! when lun > 0, writes "str" to unit "lun" -! when lun <= 0, passes "str" on to wrf_message -! - implicit none -! subr arguments - integer, intent(in) :: lun - character(len=*), intent(in) :: str -! local variables - integer n - - n = max( 1, len_trim(str) ) - if (lun .ge. 0) then - write(lun,'(a)') str(1:n) - else - call endrun( str(1:n) ) - end if - return - end subroutine ecpp_message - - -!----------------------------------------------------------------------- - subroutine ecpp_error_fatal( lun, str ) -! -! when lun > 0, writes "str" to unit "lun" -! then (always) passes "str" on to wrf_error_fatal -! - implicit none -! subr arguments - integer, intent(in) :: lun - character(len=*), intent(in) :: str -! local variables - integer n - - n = max( 1, len_trim(str) ) - call endrun( str(1:n) ) - return - end subroutine ecpp_error_fatal - - -!----------------------------------------------------------------------- - subroutine parampollu_1clm_set_opts( & - xppopt_updn_prof_aa, & - xppopt_quiescn_mf, xppopt_quiescn_sosi, & - xppopt_chemtend_wq, xppopt_chemtend_dtsub, & - xppopt_chemtend_updnfreq ) - - use module_data_ecpp1 - - implicit none - - -! subr arguments - integer, intent(in) :: & - xppopt_updn_prof_aa, & - xppopt_quiescn_mf, xppopt_quiescn_sosi, & - xppopt_chemtend_wq, xppopt_chemtend_dtsub, & - xppopt_chemtend_updnfreq - - - ppopt_updn_prof_aa = xppopt_updn_prof_aa - ppopt_quiescn_mf = xppopt_quiescn_mf - ppopt_quiescn_sosi = xppopt_quiescn_sosi - ppopt_chemtend_wq = xppopt_chemtend_wq - ppopt_chemtend_dtsub = xppopt_chemtend_dtsub - ppopt_chemtend_updnfreq = xppopt_chemtend_updnfreq - - - return - end subroutine parampollu_1clm_set_opts - -!----------------------------------------------------------------------- - end module module_ecpp_util diff --git a/src/physics/spcam/spcam_drivers.F90 b/src/physics/spcam/spcam_drivers.F90 deleted file mode 100644 index 2c850286df..0000000000 --- a/src/physics/spcam/spcam_drivers.F90 +++ /dev/null @@ -1,2396 +0,0 @@ -module spcam_drivers - - -use camsrfexch, only: cam_out_t, cam_in_t -use ppgrid, only: pcols, pver -use camsrfexch , only: cam_export -use shr_kind_mod, only: r8 => shr_kind_r8 -#ifdef CRM -use crmdims, only: crm_nx, crm_ny, crm_nz -#endif -use radiation, only: rad_out_t -use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index -use physics_types, only: physics_state, physics_state_copy, physics_ptend -use pkg_cldoptics, only: cldems, cldovrlap, cldefr -use phys_grid, only: get_rlat_all_p, get_rlon_all_p -use cam_history, only: outfld -use cam_history_support, only : fillvalue - -implicit none -save -private - -type rad_avgdata_type_sam1mom - real(r8), allocatable :: solin_m(:) ! Solar incident flux - real(r8), allocatable :: fsntoa_m(:) ! Net solar flux at TOA - real(r8), allocatable :: fsutoa_m(:) ! upwelling solar flux at TOA - real(r8), allocatable :: fsntoac_m(:) ! Clear sky net solar flux at TOA - real(r8), allocatable :: fsnirt_m(:) ! Near-IR flux absorbed at toa - real(r8), allocatable :: fsnrtc_m(:) ! Clear sky near-IR flux absorbed at toa - real(r8), allocatable :: fsnirtsq_m(:) ! Near-IR flux absorbed at toa >= 0.7 microns - real(r8), allocatable :: fsntc_m(:) ! Clear sky total column abs solar flux - real(r8), allocatable :: fsnsc_m(:) ! Clear sky surface abs solar flux - real(r8), allocatable :: fsdsc_m(:) ! Clear sky surface downwelling solar flux - real(r8), allocatable :: flut_m(:) ! Upward flux at top of model - real(r8), allocatable :: flutc_m(:) ! Upward Clear Sky flux at top of model - real(r8), allocatable :: flntc_m(:) ! Clear sky lw flux at model top - real(r8), allocatable :: flnsc_m(:) ! Clear sky lw flux at srf (up-down) - real(r8), allocatable :: fldsc_m(:) ! Clear sky lw flux at srf (down) - real(r8), allocatable :: flwds_m(:) ! Down longwave flux at surface - real(r8), allocatable :: fsns_m(:) ! Surface solar absorbed flux - real(r8), allocatable :: fsnr_m(:) - real(r8), allocatable :: fsnt_m(:) ! Net column abs solar flux at model top - real(r8), allocatable :: flns_m(:) ! Srf longwave cooling (up-down) flux - real(r8), allocatable :: flnt_m(:) ! Net outgoing lw flux at model top - real(r8), allocatable :: flnr_m(:) - real(r8), allocatable :: fsds_m(:) ! Surface solar down flux - real(r8), allocatable :: fln200_m(:) ! net longwave flux interpolated to 200 mb - real(r8), allocatable :: fln200c_m(:) ! net clearsky longwave flux interpolated to 200 mb - real(r8), allocatable :: fsn200_m(:) ! fns interpolated to 200 mb - real(r8), allocatable :: fsn200c_m(:) ! fcns interpolated to 200 mb - real(r8), allocatable :: sols_m(:) ! Solar downward visible direct to surface - real(r8), allocatable :: soll_m(:) ! Solar downward near infrared direct to surface - real(r8), allocatable :: solsd_m(:) ! Solar downward visible diffuse to surface - real(r8), allocatable :: solld_m(:) ! Solar downward near infrared diffuse to surface - real(r8), allocatable :: qrs_m(:,:) - real(r8), allocatable :: qrl_m(:,:) - real(r8), allocatable :: qrsc_m(:,:) - real(r8), allocatable :: qrlc_m(:,:) - real(r8), allocatable :: rel_crm(:,:,:,:) - real(r8), allocatable :: rei_crm(:,:,:,:) - real(r8), allocatable :: qrl_crm(:,:,:,:) - real(r8), allocatable :: qrs_crm(:,:,:,:) - real(r8), allocatable :: fsdtoa_m(:) ! Solar input = Flux Solar Downward Top of Atmosphere - real(r8), allocatable :: flds_m(:) ! Down longwave flux at surface - - real(r8), pointer :: t_rad (:,:,:,:) ! rad temperuture - real(r8), pointer :: qv_rad(:,:,:,:) ! rad vapor - real(r8), pointer :: qc_rad(:,:,:,:) ! rad cloud water - real(r8), pointer :: qi_rad(:,:,:,:) ! rad cloud ice - real(r8), pointer :: crm_qrad(:,:,:,:) ! rad heating - - real(r8), allocatable :: tot_cld_vistau_m(:,:) ! gbx water+ice cloud optical depth (only during day, night = fillvalue) - real(r8), allocatable :: tot_icld_vistau_m(:,:) ! in-cld water+ice cloud optical depth (only during day, night = fillvalue) - real(r8), allocatable :: liq_icld_vistau_m(:,:) ! in-cld liq cloud optical depth (only during day, night = fillvalue) - real(r8), allocatable :: ice_icld_vistau_m(:,:) ! in-cld ice cloud optical depth (only during day, night = fillvalue) - real(r8), allocatable :: nct_tot_icld_vistau_m(:,:) ! the number of CRM columns that has in-cloud visible sw optical depth - real(r8), allocatable :: nct_liq_icld_vistau_m(:,:) ! the number of CRM column that has liq in-cloud visible sw optical depth - real(r8), allocatable :: nct_ice_icld_vistau_m(:,:) ! the number of CRM column that has ice in-cloud visible sw optical depth - - ! Just used in m2005 -- needed for compilation only - real(r8), allocatable :: snow_icld_vistau_m(:,:) ! snow in-cloud visible sw optical depth for output on history files - real(r8), allocatable :: nct_snow_icld_vistau_m(:,:) ! the number of CRM column that has snow in-cloud visible sw optical depth - real(r8), allocatable :: crm_aodvisz(:,:,:,:) ! layer aerosol optical depth at 550nm at CRM grids - real(r8), allocatable :: crm_aodvis(:,:,:) ! AOD at 550nm at CRM grids - real(r8), allocatable :: crm_aod400(:,:,:) ! AOD at 400nm at CRM grids - real(r8), allocatable :: crm_aod700(:,:,:) ! AOD at 700nm at CRM grids - real(r8), allocatable :: aod400(:) ! AOD at 400nm at CRM grids - real(r8), allocatable :: aod700(:) ! AOD at 700nm at CRM grids - real(r8), allocatable :: cld_tau_crm(:,:,:,:) - real(r8), allocatable :: crm_fsnt(:,:,:) ! net shortwave fluxes at TOA at CRM grids - real(r8), allocatable :: crm_fsntc(:,:,:) ! net clear-sky shortwave fluxes at TOA at CRM grids - real(r8), allocatable :: crm_fsns(:,:,:) ! net shortwave fluxes at surface at CRM grids - real(r8), allocatable :: crm_fsnsc(:,:,:) ! net clear-sky shortwave fluxes at surface at CRM grids - real(r8), allocatable :: crm_flnt(:,:,:) ! net longwave fluxes at TOA at CRM grids - real(r8), allocatable :: crm_flntc(:,:,:) ! net clear-sky longwave fluxes at TOA at CRM grids - real(r8), allocatable :: crm_flns(:,:,:) ! net longwave fluxes at surface at CRM grids - real(r8), allocatable :: crm_flnsc(:,:,:) ! net clear-sky longwave fluxes at surface at CRM grids - real(r8), allocatable :: crm_swcf(:,:,:) ! shortwave cloud forcing at CRM grids -end type rad_avgdata_type_sam1mom - -type rad_avgdata_type_m2005 - real(r8),allocatable :: solin_m(:) ! Solar incident flux - real(r8),allocatable :: fsntoa_m(:) ! Net solar flux at TOA - real(r8),allocatable :: fsutoa_m(:) ! upwelling solar flux at TOA - real(r8),allocatable :: fsntoac_m(:) ! Clear sky net solar flux at TOA - real(r8),allocatable :: fsnirt_m(:) ! Near-IR flux absorbed at toa - real(r8),allocatable :: fsnrtc_m(:) ! Clear sky near-IR flux absorbed at toa - real(r8),allocatable :: fsnirtsq_m(:) ! Near-IR flux absorbed at toa >= 0.7 microns - real(r8),allocatable :: fsntc_m(:) ! Clear sky total column abs solar flux - real(r8),allocatable :: fsnsc_m(:) ! Clear sky surface abs solar flux - real(r8),allocatable :: fsdsc_m(:) ! Clear sky surface downwelling solar flux - real(r8),allocatable :: flut_m(:) ! Upward flux at top of model - real(r8),allocatable :: flutc_m(:) ! Upward Clear Sky flux at top of model - real(r8),allocatable :: flntc_m(:) ! Clear sky lw flux at model top - real(r8),allocatable :: flnsc_m(:) ! Clear sky lw flux at srf (up-down) - real(r8),allocatable :: fldsc_m(:) ! Clear sky lw flux at srf (down) - real(r8),allocatable :: flwds_m(:) ! Down longwave flux at surface - real(r8),allocatable :: fsns_m(:) ! Surface solar absorbed flux - real(r8),allocatable :: fsnr_m(:) - real(r8),allocatable :: fsnt_m(:) ! Net column abs solar flux at model top - real(r8),allocatable :: flns_m(:) ! Srf longwave cooling (up-down) flux - real(r8),allocatable :: flnt_m(:) ! Net outgoing lw flux at model top - real(r8),allocatable :: flnr_m(:) - real(r8),allocatable :: fsds_m(:) ! Surface solar down flux - real(r8),allocatable :: fln200_m(:) ! net longwave flux interpolated to 200 mb - real(r8),allocatable :: fln200c_m(:) ! net clearsky longwave flux interpolated to 200 mb - real(r8),allocatable :: fsn200_m(:) ! fns interpolated to 200 mb - real(r8),allocatable :: fsn200c_m(:) ! fcns interpolated to 200 mb - real(r8),allocatable :: sols_m(:) ! Solar downward visible direct to surface - real(r8),allocatable :: soll_m(:) ! Solar downward near infrared direct to surface - real(r8),allocatable :: solsd_m(:) ! Solar downward visible diffuse to surface - real(r8),allocatable :: solld_m(:) ! Solar downward near infrared diffuse to surface - real(r8),allocatable :: qrs_m(:,:) - real(r8),allocatable :: qrl_m(:,:) - real(r8),allocatable :: qrsc_m(:,:) - real(r8),allocatable :: qrlc_m(:,:) - real(r8),allocatable :: su_m(:,:,:) ! shortwave spectral flux up - real(r8),allocatable :: sd_m(:,:,:) ! shortwave spectral flux down - real(r8),allocatable :: lu_m(:,:,:) ! longwave spectral flux up - real(r8),allocatable :: ld_m(:,:,:) ! longwave spectral flux down - real(r8),pointer :: su(:,:,:) ! shortwave spectral flux up - real(r8),pointer :: sd(:,:,:) ! shortwave spectral flux down - real(r8),pointer :: lu(:,:,:) ! longwave spectral flux up - real(r8),pointer :: ld(:,:,:) ! longwave spectral flux down - real(r8), allocatable :: dei_crm(:,:,:,:) ! cloud scale ice effective diameter for optics - real(r8), allocatable :: mu_crm(:,:,:,:) ! cloud scale gamma parameter for optics - real(r8), allocatable :: lambdac_crm(:,:,:,:) ! cloud scale slope of droplet distribution for optics - real(r8), allocatable :: des_crm(:,:,:,:) ! cloud scale snow crystal diameter (micro-meter) - real(r8), allocatable :: rel_crm(:,:,:,:) - real(r8), allocatable :: rei_crm(:,:,:,:) - real(r8), allocatable :: cld_tau_crm(:,:,:,:) - real(r8), allocatable :: qrl_crm(:,:,:,:) - real(r8), allocatable :: qrs_crm(:,:,:,:) - real(r8), allocatable :: crm_fsnt(:,:,:) ! net shortwave fluxes at TOA at CRM grids - real(r8), allocatable :: crm_fsntc(:,:,:) ! net clear-sky shortwave fluxes at TOA at CRM grids - real(r8), allocatable :: crm_fsns(:,:,:) ! net shortwave fluxes at surface at CRM grids - real(r8), allocatable :: crm_fsnsc(:,:,:) ! net clear-sky shortwave fluxes at surface at CRM grids - real(r8), allocatable :: crm_flnt(:,:,:) ! net longwave fluxes at TOA at CRM grids - real(r8), allocatable :: crm_flntc(:,:,:) ! net clear-sky longwave fluxes at TOA at CRM grids - real(r8), allocatable :: crm_flns(:,:,:) ! net longwave fluxes at surface at CRM grids - real(r8), allocatable :: crm_flnsc(:,:,:) ! net clear-sky longwave fluxes at surface at CRM grids - real(r8), allocatable :: crm_swcf(:,:,:) ! shortwave cloud forcing at CRM grids - - - real(r8), allocatable :: crm_aodvisz(:,:,:,:) ! layer aerosol optical depth at 550nm at CRM grids - real(r8), allocatable :: crm_aodvis(:,:,:) ! AOD at 550nm at CRM grids - real(r8), allocatable :: crm_aod400(:,:,:) ! AOD at 400nm at CRM grids - real(r8), allocatable :: crm_aod700(:,:,:) ! AOD at 700nm at CRM grids - real(r8), allocatable :: aod400(:) ! AOD at 400nm at CRM grids - real(r8), allocatable :: aod700(:) ! AOD at 700nm at CRM grids - - real(r8), pointer :: t_rad (:,:,:) ! rad temperuture - real(r8), pointer :: qv_rad(:,:,:) ! rad vapor - real(r8), pointer :: qc_rad(:,:,:) ! rad cloud water - real(r8), pointer :: qi_rad(:,:,:) ! rad cloud ice - real(r8), pointer :: crm_qrad(:,:,:) ! rad heating - - real(r8), allocatable :: tot_cld_vistau_m(:,:) ! gbx water+ice cloud optical depth (only during day, night = fillvalue) - real(r8), allocatable :: tot_icld_vistau_m(:,:) ! in-cld water+ice cloud optical depth (only during day, night = fillvalue) - real(r8), allocatable :: liq_icld_vistau_m(:,:) ! in-cld liq cloud optical depth (only during day, night = fillvalue) - real(r8), allocatable :: ice_icld_vistau_m(:,:) ! in-cld ice cloud optical depth (only during day, night = fillvalue) - real(r8), allocatable :: nct_tot_icld_vistau_m(:,:) ! the number of CRM columns that has in-cloud visible sw optical depth - real(r8), allocatable :: nct_liq_icld_vistau_m(:,:) ! the number of CRM column that has liq in-cloud visible sw optical depth - real(r8), allocatable :: nct_ice_icld_vistau_m(:,:) ! the number of CRM column that has ice in-cloud visible sw optical depth - - ! These do not need N_DIAG dimension - real(r8),allocatable :: snow_tau(:,:,:) ! snow extinction optical depth - - real(r8),allocatable :: snow_lw_abs (:,:,:) ! snow absorption optics depth (LW) - - ! Just used in m2005 - real(r8),allocatable :: snow_icld_vistau_m(:,:) ! snow in-cloud visible sw optical depth for output on history files - real(r8),allocatable :: nct_snow_icld_vistau_m(:,:) ! the number of CRM column that has snow in-cloud visible sw optical depth - - -end type rad_avgdata_type_m2005 - -public :: tphysbc_spcam, spcam_register, spcam_init - -integer :: dei_idx = -1 -integer :: mu_idx = -1 -integer :: lambdac_idx = -1 -integer :: des_idx = -1 -integer :: dgnumwet_crm_idx = -1 -integer :: qaerwat_crm_idx = -1 -integer :: rel_idx = -1 -integer :: rei_idx = -1 -integer :: landm_idx = -1 -integer :: iciwp_idx = -1 -integer :: iclwp_idx = -1 -integer :: icswp_idx = -1 -integer :: cld_idx = -1 -integer :: dgnumwet_idx = -1 -integer :: qaerwat_idx = -1 -integer :: crm_t_rad_idx = -1 -integer :: crm_qc_rad_idx = -1 -integer :: crm_qi_rad_idx = -1 -integer :: crm_qv_rad_idx = -1 -integer :: crm_qrad_idx = -1 -integer :: crm_cld_rad_idx = -1 -integer :: crm_nc_rad_idx = -1 -integer :: crm_ni_rad_idx = -1 -integer :: crm_qs_rad_idx = -1 -integer :: crm_ns_rad_idx = -1 -integer :: cicewp_idx = -1 -integer :: cliqwp_idx = -1 -integer :: cldemis_idx = -1 -integer :: cldtau_idx = -1 -integer :: pmxrgn_idx = -1 -integer :: nmxrgn_idx = -1 -integer :: qrs_idx = -1 -integer :: qrl_idx = -1 -integer :: fsns_idx = -1 -integer :: fsnt_idx = -1 -integer :: flns_idx = -1 -integer :: flnt_idx = -1 -integer :: fsds_idx = -1 -integer :: cldfsnow_idx = -1 - -! Minghuai - todo -- CAC note -! These values will be "averaged" as appropriate and stored back in the pbuf -! They should no longer be "saved" -- Probably will want to put in rad_avgdata structure -! Email from Minghaui - 10/10/14 said to put on todo list as he did not have -! time to address it now -! real(r8),allocatable :: cicewp(:,:) -! real(r8),allocatable :: cliqwp(:,:) -! real(r8),allocatable :: rel(:,:) -! real(r8),allocatable :: rei(:,:) -! real(r8),allocatable :: dei(:,:) -! real(r8),allocatable :: mu(:,:) -! real(r8),allocatable :: lambdac(:,:) -! real(r8),allocatable :: des(:,:) -! real(r8),allocatable :: cld(:,:) ! cloud fraction -! real(r8),allocatable :: cldfsnow(:,:) ! cloud fraction of just "snow clouds- whatever they are" -! real(r8),allocatable :: csnowp(:,:) -! real(r8),allocatable :: dgnumwet(:,:,:) ! number mode diameter -! real(r8),allocatable :: qaerwat(:,:,:) ! aerosol water - - -integer :: nmodes -logical :: is_spcam_m2005, is_spcam_sam1mom -logical :: prog_modal_aero - -contains -subroutine tphysbc_spcam (ztodt, state, & - tend, pbuf, & - cam_out, cam_in ) - !----------------------------------------------------------------------- - ! - ! Purpose: - ! Evaluate and apply physical processes that are calculated BEFORE - ! coupling to land, sea, and ice models. - ! - ! Processes currently included are: - ! - ! o Resetting Negative Tracers to Positive - ! o Global Mean Total Energy Fixer - ! o Dry Adjustment - ! o Asymmetric Turbulence Scheme : Deep Convection & Shallow Convection - ! o Stratiform Macro-Microphysics - ! o Wet Scavenging of Aerosol - ! o Radiation - ! - ! Method: - ! - ! Each parameterization should be implemented with this sequence of calls: - ! 1) Call physics interface - ! 2) Check energy - ! 3) Call physics_update - ! See Interface to Column Physics and Chemistry Packages - ! http://www.ccsm.ucar.edu/models/atm-cam/docs/phys-interface/index.html - ! - !----------------------------------------------------------------------- - - use physics_buffer, only : pbuf_old_tim_idx, dyn_time_lvls - use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, & - physics_state_check - use dadadj_cam, only: dadadj_tend - use cam_diagnostics, only: diag_conv_tend_ini, diag_phys_writeout, diag_conv, diag_export, diag_state_b4_phys_write - use cam_history, only: outfld - use constituents, only: pcnst, qmin, cnst_get_ind - use time_manager, only: get_nstep - use check_energy, only: check_energy_chng, check_energy_fix - use check_energy, only: check_tracers_data, check_tracers_init - use dycore, only: dycore_is - use radiation, only: radiation_tend - use cloud_diagnostics, only: cloud_diagnostics_calc - use perf_mod - use tropopause, only: tropopause_output - use cam_abortutils, only: endrun -#ifdef CRM - use crm_physics, only: crm_physics_tend -#endif - use phys_control, only: phys_getopts - use sslt_rebin, only: sslt_rebin_adv - use qneg_module, only: qneg3 - - implicit none - - ! - ! Arguments - ! - real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) - - type(physics_state), intent(inout) :: state - type(physics_tend ), intent(inout) :: tend - type(physics_buffer_desc), pointer :: pbuf(:) - - type(cam_out_t), intent(inout) :: cam_out - type(cam_in_t), intent(in) :: cam_in - - -#ifdef CRM - ! - !---------------------------Local workspace----------------------------- - ! - - type(physics_ptend) :: ptend ! indivdual parameterization tendencies - type(physics_state) :: state_loc - - integer :: nstep ! current timestep number - - real(r8) :: net_flx(pcols) - - real(r8) cldn(pcols,pver) - - - integer lchnk ! chunk identifier - integer ncol ! number of atmospheric columns - - integer i ! index - integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. - - ! physics buffer fields to compute tendencies for stratiform package - integer itim_old, ifld - real(r8), pointer, dimension(:,:) :: cld ! cloud fraction - - - ! physics buffer fields for total energy and mass adjustment - real(r8), pointer, dimension(: ) :: teout - real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: cldliqini - real(r8), pointer, dimension(:,:) :: cldiceini - real(r8), pointer, dimension(:,:) :: dtcore - - real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble - - - ! energy checking variables - real(r8) :: zero(pcols) ! array of zeros - real(r8) :: flx_heat(pcols) - type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes - - logical :: state_debug_checks ! Debug physics_state. - - - type(rad_avgdata_type_sam1mom) :: rad_avgdata_sam1mom - type(rad_avgdata_type_m2005) :: rad_avgdata_m2005 - type(rad_out_t) :: rd - - integer :: teout_idx, qini_idx, cldliqini_idx, cldiceini_idx - integer :: ii, jj - !----------------------------------------------------------------------- - call t_startf('bc_init') - zero = 0._r8 - - lchnk = state%lchnk - ncol = state%ncol - - nstep = get_nstep() - - teout_idx = pbuf_get_index('TEOUT') - qini_idx = pbuf_get_index('QINI') - cldliqini_idx = pbuf_get_index('CLDLIQINI') - cldiceini_idx = pbuf_get_index('CLDICEINI') - - call phys_getopts(state_debug_checks_out=state_debug_checks) - - ! Associate pointers with physics buffer fields - itim_old = pbuf_old_tim_idx() - ifld = pbuf_get_index('CLD') - call pbuf_get_field(pbuf, ifld, cld, (/1,1,itim_old/),(/pcols,pver,1/)) - - call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) - - call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) - call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) - - ifld = pbuf_get_index('DTCORE') - call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - - ifld = pbuf_get_index('FRACIS') - call pbuf_get_field(pbuf, ifld, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) - fracis (:ncol,:,1:pcnst) = 1._r8 - - ! Set physics tendencies to 0 - tend %dTdt(:ncol,:pver) = 0._r8 - tend %dudt(:ncol,:pver) = 0._r8 - tend %dvdt(:ncol,:pver) = 0._r8 - - call qneg3('TPHYSBCb',lchnk ,ncol ,pcols ,pver , & - 1, pcnst, qmin ,state%q ) - - ! Validate state coming from the dynamics. - if (state_debug_checks) & - call physics_state_check(state, name="before tphysbc (dycore?)") - ! - ! Dump out "before physics" state - ! - call diag_state_b4_phys_write (state) - - ! compute mass integrals of input tracers state - call check_tracers_init(state, tracerint) - - call t_stopf('bc_init') - - !=================================================== - ! Global mean total energy fixer - !=================================================== - call t_startf('energy_fixer') - - if (dycore_is('LR') .or. dycore_is('SE')) then - call check_energy_fix(state, ptend, nstep, flx_heat) - call physics_update(state, ptend, ztodt, tend) - call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) - call outfld('EFIX', flx_heat, pcols,lchnk) - end if - ! Save state for convective tendency calculations. - call diag_conv_tend_ini(state, pbuf) - - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - qini (:ncol,:pver) = state%q(:ncol,:pver, 1) - cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) - - - call outfld('TEOUT', teout , pcols, lchnk ) - call outfld('TEINP', state%te_ini, pcols, lchnk ) - call outfld('TEFIX', state%te_cur, pcols, lchnk ) - - ! T tendency due to dynamics - if( nstep > dyn_time_lvls-1 ) then - dtcore(:ncol,:pver) = (state%t(:ncol,:pver) - dtcore(:ncol,:pver))/(ztodt) - call outfld( 'DTCORE', dtcore, pcols, lchnk ) - end if - - call t_stopf('energy_fixer') - - call sslt_rebin_adv(pbuf, state) - - ! - !=================================================== - ! Dry adjustment - ! This code block is not a good example of interfacing a parameterization - !=================================================== - call t_startf('dry_adjustment') - - call dadadj_tend (ztodt, state, ptend) - call physics_update(state, ptend, ztodt, tend) - - call t_stopf('dry_adjustment') - - ! ------------------------------------------------------------------------------- - ! Call cloud resolving model - ! ------------------------------------------------------------------------------- - - call crm_physics_tend(ztodt, state, tend, ptend, pbuf, cam_in) - call physics_update(state, ptend, ztodt, tend) - - !=================================================== - ! Moist physical parameteriztions complete: - ! send dynamical variables, and derived variables to history file - !=================================================== - - call t_startf('bc_history_write') - call diag_phys_writeout(state, pbuf) - call diag_conv(state, ztodt, pbuf) - - call t_stopf('bc_history_write') - - !=================================================== - ! Write cloud diagnostics on history file - !=================================================== - - if (is_spcam_sam1mom) then - call spcam_radiation_setup_sam1mom(cam_in, cldn, state, pbuf, rad_avgdata_sam1mom, state_loc) - else if (is_spcam_m2005) then - call spcam_radiation_setup_m2005(state, pbuf, rad_avgdata_m2005, state_loc) - end if - - call t_startf('bc_cld_diag_history_write') - - call cloud_diagnostics_calc(state, pbuf) - - call t_stopf('bc_cld_diag_history_write') - - !=================================================== - ! Radiation computations - !=================================================== - call t_startf('radiation') - - if (is_spcam_sam1mom) then - do jj=1,crm_ny - do ii=1,crm_nx - call spcam_radiation_col_setup_sam1mom(ii, jj, state_loc, pbuf, rad_avgdata_sam1mom) - call radiation_tend(state_loc, ptend, pbuf, & - cam_out, cam_in, & - net_flx, rd) - call spcam_radiation_col_finalize_sam1mom(state, ii, jj, pbuf, rd, cam_out, rad_avgdata_sam1mom) - end do - end do - call spcam_radiation_finalize_sam1mom(cam_in, state, pbuf, rad_avgdata_sam1mom, cam_out, cldn, net_flx, ptend) - - else if(is_spcam_m2005) then - do jj=1,crm_ny - do ii=1,crm_nx - call spcam_radiation_col_setup_m2005(ii, jj, ixcldice, ixcldliq, state_loc, pbuf, rad_avgdata_m2005) - call radiation_tend(state_loc, ptend, pbuf, & - cam_out, cam_in, & - net_flx, rd) - call spcam_radiation_col_finalize_m2005(state, ii, jj, pbuf, rd, cam_out, rad_avgdata_m2005) - end do - end do - call spcam_radiation_finalize_m2005(cam_in, state, pbuf, rad_avgdata_m2005, cam_out, net_flx, ptend) - end if - - ! Set net flux used by spectral dycores - do i=1,ncol - tend%flx_net(i) = net_flx(i) - end do - - ! don't add radiative tendency to GCM temperature in case of superparameterization - ! as it was added above as part of crm tendency. - ptend%s = 0._r8 - - call physics_update(state, ptend, ztodt, tend) - - call check_energy_chng(state, tend, "spradheat", nstep, ztodt, zero, zero, zero, zero) - - call t_stopf('radiation') - - ! Diagnose the location of the tropopause and its location to the history file(s). - call t_startf('tropopause') - call tropopause_output(state) - call t_stopf('tropopause') - - ! Save atmospheric fields to force surface models - call t_startf('cam_export') - call cam_export (state,cam_out,pbuf) - call t_stopf('cam_export') - - ! Write export state to history file - call t_startf('diag_export') - call diag_export(cam_out) - call t_stopf('diag_export') - -#endif -end subroutine tphysbc_spcam - -!=============================================================================== - -subroutine spcam_register() - use physics_buffer, only: pbuf_add_field, dtype_r8, dyn_time_lvls ! is dyn_time_lvls needed ??? - use phys_control, only: cam_physpkg_is -#ifdef CRM - use crm_physics, only: crm_physics_register - use crmx_vars, only: naer, vaer, hgaer - use crmx_grid -#ifdef MODAL_AERO - use modal_aero_data, only: ntot_amode - - allocate(naer(nzm, ntot_amode)) ! Aerosol number concentration [/m3] - allocate(vaer(nzm, ntot_amode)) ! aerosol volume concentration [m3/m3] - allocate(hgaer(nzm, ntot_amode)) ! hygroscopicity of aerosol mode -#endif - - - call crm_physics_register() - -#endif - - is_spcam_m2005 = cam_physpkg_is('spcam_m2005') - is_spcam_sam1mom = cam_physpkg_is('spcam_sam1mom') - - if (is_spcam_m2005) then - call pbuf_add_field('ICSWP', 'physpkg',dtype_r8,(/pcols,pver/), icswp_idx) - call pbuf_add_field('CLDFSNOW', 'physpkg',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldfsnow_idx) - endif - -end subroutine spcam_register - -!=============================================================================== - -subroutine spcam_init(pbuf2d) - use physics_buffer, only: pbuf_get_index - use phys_control, only: phys_getopts -#ifdef CRM - use crm_physics, only: crm_physics_init -#endif - use rad_constituents, only: rad_cnst_get_info - - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - -#ifdef CRM - - call phys_getopts(prog_modal_aero_out = prog_modal_aero) - - call rad_cnst_get_info(0, nmodes=nmodes) - - dei_idx = pbuf_get_index('DEI') - mu_idx = pbuf_get_index('MU') - lambdac_idx = pbuf_get_index('LAMBDAC') - des_idx = pbuf_get_index('DES') - rel_idx = pbuf_get_index('REL') - rei_idx = pbuf_get_index('REI') - landm_idx = pbuf_get_index('LANDM') - cld_idx = pbuf_get_index('CLD') - qrs_idx = pbuf_get_index('QRS') - qrl_idx = pbuf_get_index('QRL') - fsns_idx = pbuf_get_index('FSNS') - fsds_idx = pbuf_get_index('FSDS') - fsnt_idx = pbuf_get_index('FSNT') - flnt_idx = pbuf_get_index('FLNT') - flns_idx = pbuf_get_index('FLNS') - - crm_t_rad_idx = pbuf_get_index('CRM_T_RAD') - crm_qc_rad_idx = pbuf_get_index('CRM_QC_RAD') - crm_qi_rad_idx = pbuf_get_index('CRM_QI_RAD') - crm_qv_rad_idx = pbuf_get_index('CRM_QV_RAD') - crm_qrad_idx = pbuf_get_index('CRM_QRAD') - crm_cld_rad_idx = pbuf_get_index('CRM_CLD_RAD') - - - if (is_spcam_sam1mom) then - cldemis_idx = pbuf_get_index('CLDEMIS') - cldtau_idx = pbuf_get_index('CLDTAU') - cicewp_idx = pbuf_get_index('CICEWP') - cliqwp_idx = pbuf_get_index('CLIQWP') - pmxrgn_idx = pbuf_get_index('PMXRGN') - nmxrgn_idx = pbuf_get_index('NMXRGN') - else if (is_spcam_m2005) then - iciwp_idx = pbuf_get_index('ICIWP') - iclwp_idx = pbuf_get_index('ICLWP') - crm_nc_rad_idx = pbuf_get_index('CRM_NC_RAD') - crm_ni_rad_idx = pbuf_get_index('CRM_NI_RAD') - crm_qs_rad_idx = pbuf_get_index('CRM_QS_RAD') - crm_ns_rad_idx = pbuf_get_index('CRM_NS_RAD') - end if - - if (prog_modal_aero) then - dgnumwet_idx = pbuf_get_index('DGNUMWET') - qaerwat_idx = pbuf_get_index('QAERWAT') - dgnumwet_crm_idx = pbuf_get_index('CRM_DGNUMWET') - qaerwat_crm_idx = pbuf_get_index('CRM_QAERWAT') - end if - - ! Initialize the crm_physics layer - call crm_physics_init(pbuf2d) - -#endif -end subroutine spcam_init - -!=============================================================================== - -subroutine spcam_radiation_setup_m2005(state, pbuf, rad_avgdata, state_loc) - - use physics_buffer, only: physics_buffer_desc, pbuf_get_field - use physics_buffer, only: pbuf_old_tim_idx - - type(physics_state), intent(in) :: state - type(physics_buffer_desc), intent(inout), pointer :: pbuf(:) - - type(rad_avgdata_type_m2005), intent(out) :: rad_avgdata - type(physics_state), intent(out) :: state_loc - -#ifdef m2005 - real(r8), pointer, dimension(:, :) :: cicewp - real(r8), pointer, dimension(:, :) :: cliqwp - real(r8), pointer, dimension(:, :) :: csnowp - real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) - real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) - real(r8), pointer, dimension(:,:) :: cld ! cloud fraction - real(r8), pointer, dimension(:,:) :: cldfsnow ! cloud fraction of just "snow clouds- whatever they are" - real(r8), pointer, dimension(:, :) :: dei ! ice effective diameter for optics (radiation) - real(r8), pointer, dimension(:, :) :: mu ! gamma parameter for optics (radiation) - real(r8), pointer, dimension(:, :) :: lambdac ! slope of droplet distribution for optics (radiation) - real(r8), pointer, dimension(:, :) :: des ! snow crystatl diameter for optics (mirometer, radiation) - - integer :: ncol ! number of atmospheric columns - integer :: itim_old - - ncol = state%ncol - - call physics_state_copy(state, state_loc) - - allocate(rad_avgdata%solin_m (pcols)) - allocate(rad_avgdata%fsntoa_m (pcols)) - allocate(rad_avgdata%fsutoa_m (pcols)) - allocate(rad_avgdata%fsntoac_m (pcols)) - allocate(rad_avgdata%fsnirt_m (pcols)) - allocate(rad_avgdata%fsnrtc_m (pcols)) - allocate(rad_avgdata%fsnirtsq_m (pcols)) - allocate(rad_avgdata%fsntc_m (pcols)) - allocate(rad_avgdata%fsnsc_m (pcols)) - allocate(rad_avgdata%fsdsc_m (pcols)) - allocate(rad_avgdata%flut_m (pcols)) - allocate(rad_avgdata%flutc_m (pcols)) - allocate(rad_avgdata%flntc_m (pcols)) - allocate(rad_avgdata%flnsc_m (pcols)) - allocate(rad_avgdata%fldsc_m (pcols)) - allocate(rad_avgdata%flwds_m (pcols)) - allocate(rad_avgdata%fsns_m (pcols)) - allocate(rad_avgdata%fsnr_m (pcols)) - allocate(rad_avgdata%fsnt_m (pcols)) - allocate(rad_avgdata%flns_m (pcols)) - allocate(rad_avgdata%flnt_m (pcols)) - allocate(rad_avgdata%flnr_m (pcols)) - allocate(rad_avgdata%fsds_m (pcols)) - allocate(rad_avgdata%fln200_m (pcols)) - allocate(rad_avgdata%fln200c_m (pcols)) - allocate(rad_avgdata%fsn200_m (pcols)) - allocate(rad_avgdata%fsn200c_m (pcols)) - allocate(rad_avgdata%sols_m (pcols)) - allocate(rad_avgdata%soll_m (pcols)) - allocate(rad_avgdata%solsd_m (pcols)) - allocate(rad_avgdata%solld_m (pcols)) - allocate(rad_avgdata%qrs_m (pcols,pver)) - allocate(rad_avgdata%qrl_m (pcols,pver)) - allocate(rad_avgdata%qrsc_m (pcols,pver)) - allocate(rad_avgdata%qrlc_m (pcols,pver)) - allocate(rad_avgdata%rel_crm (pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%rei_crm (pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%cld_tau_crm (pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%qrl_crm (pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%qrs_crm (pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%crm_fsnt (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_fsntc (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_fsns (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_fsnsc (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_flnt (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_flntc (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_flns (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_flnsc (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_swcf (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_aodvisz (pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%crm_aodvis (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_aod400 (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_aod700 (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%aod400 (pcols)) - allocate(rad_avgdata%aod700 (pcols)) - - allocate(rad_avgdata%tot_cld_vistau_m (pcols,pver)) - allocate(rad_avgdata%tot_icld_vistau_m (pcols,pver)) - allocate(rad_avgdata%liq_icld_vistau_m (pcols,pver)) - allocate(rad_avgdata%ice_icld_vistau_m (pcols,pver)) - allocate(rad_avgdata%nct_tot_icld_vistau_m (pcols,pver)) - allocate(rad_avgdata%nct_liq_icld_vistau_m (pcols,pver)) - allocate(rad_avgdata%nct_ice_icld_vistau_m (pcols,pver)) - allocate(rad_avgdata%snow_icld_vistau_m (pcols,pver)) - allocate(rad_avgdata%nct_snow_icld_vistau_m(pcols,pver)) - - allocate(rad_avgdata%dei_crm(pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%mu_crm(pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%lambdac_crm(pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%des_crm(pcols, crm_nx, crm_ny, crm_nz)) - - call pbuf_get_field(pbuf, iciwp_idx, cicewp) - call pbuf_get_field(pbuf, iclwp_idx, cliqwp) - call pbuf_get_field(pbuf, icswp_idx, csnowp) - call pbuf_get_field(pbuf, rel_idx, rel) - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, dei_idx, dei) - call pbuf_get_field(pbuf, mu_idx, mu) - call pbuf_get_field(pbuf, lambdac_idx, lambdac) - call pbuf_get_field(pbuf, des_idx, des) - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - if (cldfsnow_idx > 0) then - call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - endif - - ! Initialize the summation values - - rad_avgdata%solin_m = 0._r8 - rad_avgdata%fsntoa_m = 0._r8 - rad_avgdata%fsutoa_m = 0._r8 - rad_avgdata%fsntoac_m = 0._r8 - rad_avgdata%fsnirt_m = 0._r8 - rad_avgdata%fsnrtc_m = 0._r8 - rad_avgdata%fsnirtsq_m = 0._r8 - rad_avgdata%fsntc_m = 0._r8 - rad_avgdata%fsnsc_m = 0._r8 - rad_avgdata%fsdsc_m = 0._r8 - rad_avgdata%flut_m = 0._r8 - rad_avgdata%flutc_m = 0._r8 - rad_avgdata%flntc_m = 0._r8 - rad_avgdata%flnsc_m = 0._r8 - rad_avgdata%fldsc_m = 0._r8 - rad_avgdata%flwds_m = 0._r8 - rad_avgdata%fsns_m = 0._r8 - rad_avgdata%fsnt_m = 0._r8 - rad_avgdata%flns_m = 0._r8 - rad_avgdata%flnt_m = 0._r8 - rad_avgdata%flnr_m = 0._r8 - rad_avgdata%fsds_m = 0._r8 - rad_avgdata%fsnr_m = 0._r8 - rad_avgdata%fln200_m = 0._r8 - rad_avgdata%fln200c_m = 0._r8 - rad_avgdata%fsn200_m = 0._r8 - rad_avgdata%fsn200c_m = 0._r8 - rad_avgdata%sols_m = 0._r8 - rad_avgdata%soll_m = 0._r8 - rad_avgdata%solsd_m = 0._r8 - rad_avgdata%solld_m = 0._r8 - rad_avgdata%qrs_m = 0._r8 - rad_avgdata%qrl_m = 0._r8 - rad_avgdata%qrsc_m = 0._r8 - rad_avgdata%qrlc_m = 0._r8 - rad_avgdata%qrs_crm = 0._r8 - rad_avgdata%qrl_crm = 0._r8 - rad_avgdata%cld_tau_crm = 0.0_r8 - rad_avgdata%crm_aodvisz = 0._r8 - rad_avgdata%crm_aodvis = 0._r8 - - rad_avgdata%crm_aod400 = 0._r8 ; rad_avgdata%crm_aod700 = 0._r8 - rad_avgdata%aod400 = 0._r8 ; rad_avgdata%aod700 = 0._r8 - rad_avgdata%crm_fsnt = 0._r8 ; rad_avgdata%crm_fsntc = 0._r8 - rad_avgdata%crm_fsns = 0._r8 ; rad_avgdata%crm_fsnsc = 0._r8 - rad_avgdata%crm_flnt = 0._r8 ; rad_avgdata%crm_flntc = 0._r8 - rad_avgdata%crm_flns = 0._r8 ; rad_avgdata%crm_flnsc = 0._r8 - rad_avgdata%crm_swcf = 0._r8 - - - rad_avgdata%tot_cld_vistau_m = 0._r8 - rad_avgdata%tot_icld_vistau_m = 0._r8 ; rad_avgdata%nct_tot_icld_vistau_m = 0._r8 - rad_avgdata%liq_icld_vistau_m = 0._r8 ; rad_avgdata%nct_liq_icld_vistau_m = 0._r8 - rad_avgdata%ice_icld_vistau_m = 0._r8 ; rad_avgdata%nct_ice_icld_vistau_m = 0._r8 - rad_avgdata%snow_icld_vistau_m = 0._r8 ; rad_avgdata%nct_snow_icld_vistau_m = 0._r8 - - ! Initialize the pbuf values - lambdac = 0.0_r8 - des = 0.0_r8 - cicewp(1:ncol,1:pver) = 0.0_r8 - cliqwp(1:ncol,1:pver) = 0.0_r8 - csnowp(1:ncol,1:pver) = 0.0_r8 - cld = 0.0_r8 - cldfsnow = 0.0_r8 - rel = 0.0_r8 - rei = 0.0_r8 - dei = 0.0_r8 - mu = 0.0_r8 - -#endif -end subroutine spcam_radiation_setup_m2005 - -!=============================================================================== - -subroutine spcam_radiation_col_setup_m2005(ii, jj, ixcldice, ixcldliq, state_loc, pbuf, rad_avgdata) - - use physics_buffer, only: pbuf_old_tim_idx - use physconst, only: gravit -#ifdef CRM - use crm_physics, only: m2005_effradius -#endif - - - integer, intent(in) :: ii,jj - integer, intent(in) :: ixcldice, ixcldliq ! constituent indices for cloud liq and ice water. - - type(physics_state), intent(inout) :: state_loc - type(physics_buffer_desc), intent(inout), pointer :: pbuf(:) - type(rad_avgdata_type_m2005), intent(inout) :: rad_avgdata - -#ifdef m2005 - real(r8),pointer :: nc_rad(:,:,:,:) ! rad cloud water droplet number (#/kg) - real(r8),pointer :: ni_rad(:,:,:,:) ! rad cloud ice crystal nubmer (#/kg) - real(r8),pointer :: qs_rad(:,:,:,:) ! rad cloud snow crystal mass (kg/kg) - real(r8),pointer :: ns_rad(:,:,:,:) ! rad cloud snow crystal nubmer (#/kg) - - - real(r8),pointer :: t_rad (:,:,:,:) ! rad temperuture - real(r8),pointer :: qv_rad(:,:,:,:) ! rad vapor - real(r8),pointer :: qc_rad(:,:,:,:) ! rad cloud water - real(r8),pointer :: qi_rad(:,:,:,:) ! rad cloud ice - real(r8),pointer :: crm_qrad(:,:,:,:) ! rad heating - real(r8),pointer :: cld_rad(:,:,:,:) ! rad cloud fraction - - - real(r8), pointer, dimension(:,:) :: cicewp - real(r8), pointer, dimension(:,:) :: cliqwp - real(r8), pointer, dimension(:,:) :: csnowp - real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) - real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) - real(r8), pointer, dimension(:,:) :: cld ! cloud fraction - real(r8), pointer, dimension(:,:) :: cldfsnow ! cloud fraction of just "snow clouds- whatever they are" - real(r8), pointer, dimension(:,:) :: dei ! ice effective diameter for optics (radiation) - real(r8), pointer, dimension(:,:) :: mu ! gamma parameter for optics (radiation) - real(r8), pointer, dimension(:,:) :: lambdac ! slope of droplet distribution for optics (radiation) - real(r8), pointer, dimension(:,:) :: des ! snow crystatl diameter for optics (mirometer, radiation) - real(r8), pointer, dimension(:,:,:) :: dgnumwet ! number mode diameter - real(r8), pointer, dimension(:,:,:) :: qaerwat ! aerosol water - - real(r8),pointer, dimension(:,:,:,:,:) :: qaerwat_crm ! aerosol water - real(r8),pointer, dimension(:,:,:,:,:) :: dgnumwet_crm ! wet mode dimaeter - - real(r8) :: qtot - real(r8) :: effl ! droplet effective radius [micrometer] - real(r8) :: effi ! ice crystal effective radius [micrometer] - real(r8) :: effl_fn ! effl for fixed number concentration of nlic = 1.e8 - - real(r8) :: deffi ! ice effective diameter for optics (radiation) - real(r8) :: lamc ! slope of droplet distribution for optics (radiation) - real(r8) :: pgam ! gamma parameter for optics (radiation) - real(r8) :: dest ! snow crystal effective diameters for optics (radiation) (micro-meter) - - - integer :: itim_old - integer :: m, k, i - integer :: ncol ! number of atmospheric columns - - ncol = state_loc%ncol - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - - call pbuf_get_field(pbuf, dei_idx, dei) - call pbuf_get_field(pbuf, mu_idx, mu) - call pbuf_get_field(pbuf, lambdac_idx, lambdac) - call pbuf_get_field(pbuf, des_idx, des) - if (prog_modal_aero) then - call pbuf_get_field(pbuf, dgnumwet_crm_idx, dgnumwet_crm) - call pbuf_get_field(pbuf, qaerwat_crm_idx, qaerwat_crm) - call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet) - call pbuf_get_field(pbuf, qaerwat_idx, qaerwat) - endif - - call pbuf_get_field(pbuf, rel_idx, rel) - call pbuf_get_field(pbuf, rei_idx, rei) - - call pbuf_get_field(pbuf, crm_t_rad_idx, t_rad) - call pbuf_get_field(pbuf, crm_qc_rad_idx, qc_rad) - call pbuf_get_field(pbuf, crm_qi_rad_idx, qi_rad) - call pbuf_get_field(pbuf, crm_qv_rad_idx, qv_rad) - call pbuf_get_field(pbuf, crm_qrad_idx, crm_qrad) - call pbuf_get_field(pbuf, crm_cld_rad_idx, cld_rad) - - crm_qrad=0._r8 - - - call pbuf_get_field(pbuf, iciwp_idx, cicewp) - call pbuf_get_field(pbuf, iclwp_idx, cliqwp) - call pbuf_get_field(pbuf, icswp_idx, csnowp) - - call pbuf_get_field(pbuf, crm_nc_rad_idx, nc_rad, start=(/1,1,1,1/), kount=(/pcols,crm_nx, crm_ny, crm_nz/)) - call pbuf_get_field(pbuf, crm_ni_rad_idx, ni_rad, start=(/1,1,1,1/), kount=(/pcols,crm_nx, crm_ny, crm_nz/)) - call pbuf_get_field(pbuf, crm_qs_rad_idx, qs_rad, start=(/1,1,1,1/), kount=(/pcols,crm_nx, crm_ny, crm_nz/)) - call pbuf_get_field(pbuf, crm_ns_rad_idx, ns_rad, start=(/1,1,1,1/), kount=(/pcols,crm_nx, crm_ny, crm_nz/)) - - if (cldfsnow_idx > 0) then - call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - endif - - do m=1,crm_nz - k = pver-m+1 - do i=1,ncol - - qtot = qc_rad(i,ii,jj,m) + qi_rad(i,ii,jj,m) - if(qtot.gt.1.e-9_r8) then - cld(i,k) = min(0.99_r8, cld_rad(i,ii,jj,m)) - - ! In-cloud ice water path. - cicewp(i,k) = qi_rad(i,ii,jj,m)*state_loc%pdel(i,k)/gravit / max(0.01_r8,cld(i,k)) - ! In-cloud liquid water path. - cliqwp(i,k) = qc_rad(i,ii,jj,m)*state_loc%pdel(i,k)/gravit / max(0.01_r8,cld(i,k)) - else - cld(i,k) = 0._r8 - cicewp(i,k) = 0._r8 ! In-cloud ice water path. - cliqwp(i,k) = 0._r8 ! In-cloud liquid water path. - end if - - ! - ! snow water-related variables: - ! snow water is an important component in m2005 microphysics, and is therefore taken - ! account in the radiative calculation (snow water path is several times larger than ice water path in m2005 globally). - ! - if( qs_rad(i, ii, jj, m).gt.1.0e-7_r8) then - cldfsnow(i,k) = 0.99_r8 - csnowp(i,k) = qs_rad(i,ii,jj,m)*state_loc%pdel(i,k)/gravit / max(0.001_r8,cldfsnow(i,k)) - else - cldfsnow(i,k) = 0.0_r8 - csnowp(i,k) = 0.0_r8 - end if - - - ! update ice water, liquid water, water vapor, and temperature in state_loc - state_loc%q(i,k,ixcldice) = qi_rad(i,ii,jj,m) - state_loc%q(i,k,ixcldliq) = qc_rad(i,ii,jj,m) - state_loc%q(i,k,1) = max(1.e-9_r8,qv_rad(i,ii,jj,m)) - state_loc%t(i,k) = t_rad(i, ii, jj, m) - - ! Using CRM scale aerosol water to calculate aerosol optical depth. - ! Here we assume no aerosol water uptake at cloudy sky at CRM grids. - ! This is not really phyisically correct. But if we assume 100% of relative humidity for - ! aerosol water uptake, this will bias 'AODVIS' to be large, since 'AODVIS' is used - ! to compare with observated clear sky AOD. In the future, AODVIS is needed to be calcualted - ! from clear sky CRM AOD only. But before this is done, we will assume no water uptake at CCRM - ! cloudy grids (The radiative effects of this assumption will be small, since in cloudy sky, - ! aerosol effects is small anyway. - ! - if (prog_modal_aero) then - qaerwat(i, k, 1:nmodes) = qaerwat_crm(i, ii, jj, m, 1:nmodes) - dgnumwet(i, k, 1:nmodes) = dgnumwet_crm(i, ii, jj, m, 1:nmodes) - endif - end do ! i - end do ! m - - - ! update effective radius - do m=1,crm_nz - k = pver-m+1 - do i=1,ncol - - call m2005_effradius(qc_rad(i,ii,jj,m), nc_rad(i,ii,jj,m), qi_rad(i,ii,jj,m), & - ni_rad(i,ii,jj,m), qs_rad(i,ii,jj,m), ns_rad(i,ii,jj,m), & - 1.0_r8, state_loc%pmid(i,k), state_loc%t(i,k), effl, effi, effl_fn, deffi, lamc, pgam, dest) - - rel(i,k) = effl - rei(i,k) = effi - dei(i,k) = deffi - mu(i,k) = pgam - lambdac(i,k) = lamc - des(i,k) = dest - - rad_avgdata%dei_crm(i,ii,jj,m) = dei(i,k) - rad_avgdata%mu_crm(i,ii,jj,m) = mu(i,k) - rad_avgdata%lambdac_crm(i,ii,jj,m) = lambdac(i,k) - rad_avgdata%des_crm(i,ii,jj,m) = des(i,k) - rad_avgdata%rel_crm(i,ii,jj,m) = rel(i,k) - rad_avgdata%rei_crm(i,ii,jj,m) = rei(i,k) - end do - end do - -#endif -end subroutine spcam_radiation_col_setup_m2005 - -!=============================================================================== - -subroutine spcam_radiation_finalize_m2005(cam_in, state, pbuf, rad_avgdata, cam_out, net_flx, ptend) - - use physconst, only: cpair - use rad_constituents,only: rad_cnst_out - - use physconst, only: cappa - use radiation_data, only: rad_data_write - use radheat, only: radheat_tend - use time_manager, only: get_curr_calday - use physics_buffer, only: pbuf_old_tim_idx - use radheat, only: radheat_tend - use orbit, only: zenith - - type(cam_in_t), intent(in) :: cam_in - type(physics_state), intent(in) :: state - - - type(physics_buffer_desc), intent(inout), pointer :: pbuf(:) - type(rad_avgdata_type_m2005), intent(inout) :: rad_avgdata - type(cam_out_t), intent(inout) :: cam_out - - real(r8), intent(inout) :: net_flx(pcols) - type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies - - - -#ifdef m2005 - - real(r8), parameter :: factor_xy = 1._r8/dble(crm_nx*crm_ny) - - real(r8), pointer, dimension(:,:) :: cicewp - real(r8), pointer, dimension(:,:) :: cliqwp - real(r8), pointer, dimension(:,:) :: csnowp - real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) - real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) - real(r8), pointer, dimension(:,:) :: landm - real(r8), pointer, dimension(:,:) :: cld ! cloud fraction - real(r8), pointer, dimension(:,:) :: cldfsnow ! cloud fraction of just "snow clouds- whatever they are" - real(r8), pointer, dimension(:,:) :: dei ! ice effective diameter for optics (radiation) - real(r8), pointer, dimension(:,:) :: mu ! gamma parameter for optics (radiation) - real(r8), pointer, dimension(:,:) :: lambdac ! slope of droplet distribution for optics (radiation) - real(r8), pointer, dimension(:,:) :: des ! snow crystatl diameter for optics (mirometer, radiation) - real(r8), pointer, dimension(:,:,:) :: dgnumwet ! number mode diameter - real(r8), pointer, dimension(:,:,:) :: qaerwat ! aerosol water - real(r8), pointer, dimension(:,:,:,:) :: crm_qrad ! rad heating - real(r8), pointer, dimension(:,:) :: qrs - real(r8), pointer, dimension(:,:) :: qrl - real(r8), pointer, dimension(:) :: fsns ! Surface solar absorbed flux - real(r8), pointer, dimension(:) :: fsnt ! Net column abs solar flux at model top - real(r8), pointer, dimension(:) :: flns ! Srf longwave cooling (up-down) flux - real(r8), pointer, dimension(:) :: flnt ! Net outgoing lw flux at model top - real(r8), pointer, dimension(:) :: fsds ! Surface solar down flux - - integer :: lchnk ! chunk identifier - integer :: ncol ! number of atmospheric columns - - integer :: Nday ! Number of daylight columns - integer :: Nnite ! Number of night columns - integer :: itim_old - integer :: i, k, m - - integer, dimension(pcols) :: IdxNite ! Indicies of night coumns - - real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables - real(r8) :: calday ! current calendar day - real(r8) :: clat(pcols) ! current latitudes(radians) - real(r8) :: clon(pcols) ! current longitudes(radians) - real(r8) :: coszrs(pcols) ! Cosine solar zenith angle - - - lchnk = state%lchnk - ncol = state%ncol - - calday = get_curr_calday() - - ! - ! Cosine solar zenith angle for current time step - ! - call get_rlat_all_p(lchnk, ncol, clat) - call get_rlon_all_p(lchnk, ncol, clon) - call zenith (calday, clat, clon, coszrs, ncol) - - ! Gather night/day column indices. - Nday = 0 - Nnite = 0 - do i = 1, ncol - if ( coszrs(i) > 0.0_r8 ) then - Nday = Nday + 1 - else - Nnite = Nnite + 1 - IdxNite(Nnite) = i - end if - end do - - - - ! Shortwave - - ftem(:ncol,:pver) = rad_avgdata%qrs_m(:ncol,:pver)/cpair - call outfld('QRS'//' ',ftem ,pcols,lchnk) - ftem(:ncol,:pver) = rad_avgdata%qrsc_m(:ncol,:pver)/cpair - call outfld('QRSC'//' ',ftem ,pcols,lchnk) - call outfld('SOLIN'//' ',rad_avgdata%solin_m(:) ,pcols,lchnk) - call outfld('FSDS'//' ',rad_avgdata%fsds_m(:) ,pcols,lchnk) - call outfld('FSNIRTOA'//' ',rad_avgdata%fsnirt_m(:),pcols,lchnk) - call outfld('FSNRTOAC'//' ',rad_avgdata%fsnrtc_m(:),pcols,lchnk) - call outfld('FSNRTOAS'//' ',rad_avgdata%fsnirtsq_m(:),pcols,lchnk) - call outfld('FSNT'//' ',rad_avgdata%fsnt_m(:) ,pcols,lchnk) - call outfld('FSNS'//' ',rad_avgdata%fsns_m(:) ,pcols,lchnk) - call outfld('FSNTC'//' ',rad_avgdata%fsntc_m(:) ,pcols,lchnk) - call outfld('FSNSC'//' ',rad_avgdata%fsnsc_m(:) ,pcols,lchnk) - call outfld('FSDSC'//' ',rad_avgdata%fsdsc_m(:) ,pcols,lchnk) - call outfld('FSNTOA'//' ',rad_avgdata%fsntoa_m(:),pcols,lchnk) - call outfld('FSUTOA'//' ',rad_avgdata%fsutoa_m(:),pcols,lchnk) - call outfld('FSNTOAC'//' ',rad_avgdata%fsntoac_m(:),pcols,lchnk) - call outfld('SOLS'//' ',rad_avgdata%sols_m(:) ,pcols,lchnk) - call outfld('SOLL'//' ',rad_avgdata%soll_m(:) ,pcols,lchnk) - call outfld('SOLSD'//' ',rad_avgdata%solsd_m(:) ,pcols,lchnk) - call outfld('SOLLD'//' ',rad_avgdata%solld_m(:) ,pcols,lchnk) - call outfld('FSN200'//' ',rad_avgdata%fsn200_m(:),pcols,lchnk) - call outfld('FSN200C'//' ',rad_avgdata%fsn200c_m(:),pcols,lchnk) - call outfld('SWCF'//' ',rad_avgdata%fsntoa_m(:)-rad_avgdata%fsntoac_m(:) ,pcols,lchnk) - call outfld('FSNR'//' ',rad_avgdata%fsnr_m(:) ,pcols,lchnk) - - do i = 1, nnite - rad_avgdata%crm_aodvis(idxnite(i), :, :) = fillvalue - rad_avgdata%crm_aod400(idxnite(i), :, :) = fillvalue - rad_avgdata%crm_aod700(idxnite(i), :, :) = fillvalue - rad_avgdata%aod400(idxnite(i)) = fillvalue - rad_avgdata%aod700(idxnite(i)) = fillvalue - rad_avgdata%crm_aodvisz(idxnite(i), :, :, :) = fillvalue - rad_avgdata%tot_cld_vistau_m(IdxNite(i),:) = fillvalue - rad_avgdata%tot_icld_vistau_m(IdxNite(i),:) = fillvalue - rad_avgdata%liq_icld_vistau_m(IdxNite(i),:) = fillvalue - rad_avgdata%ice_icld_vistau_m(IdxNite(i),:) = fillvalue - if (cldfsnow_idx > 0) then - rad_avgdata%snow_icld_vistau_m(IdxNite(i),:) = fillvalue - endif - end do - - call outfld('CRM_FSNT', rad_avgdata%crm_fsnt, pcols, lchnk) - call outfld('CRM_FSNTC', rad_avgdata%crm_fsntc, pcols, lchnk) - call outfld('CRM_FSNS', rad_avgdata%crm_fsns, pcols, lchnk) - call outfld('CRM_FSNSC', rad_avgdata%crm_fsnsc, pcols, lchnk) - call outfld('CRM_AODVIS', rad_avgdata%crm_aodvis, pcols, lchnk) - call outfld('CRM_AOD400', rad_avgdata%crm_aod400, pcols, lchnk) - call outfld('CRM_AOD700', rad_avgdata%crm_aod700, pcols, lchnk) - call outfld('AOD400', rad_avgdata%aod400, pcols, lchnk) - call outfld('AOD700', rad_avgdata%aod700, pcols, lchnk) - call outfld('CRM_AODVISZ', rad_avgdata%crm_aodvisz, pcols, lchnk) - call outfld('TOT_CLD_VISTAU', rad_avgdata%tot_cld_vistau_m, pcols, lchnk) - call outfld('TOT_ICLD_VISTAU', rad_avgdata%tot_icld_vistau_m, pcols, lchnk) - call outfld('LIQ_ICLD_VISTAU', rad_avgdata%liq_icld_vistau_m, pcols, lchnk) - call outfld('ICE_ICLD_VISTAU', rad_avgdata%ice_icld_vistau_m, pcols, lchnk) - if (cldfsnow_idx > 0) then - call outfld('SNOW_ICLD_VISTAU', rad_avgdata%snow_icld_vistau_m, pcols, lchnk) - endif - - ! Longwave - call outfld('QRL'//' ',rad_avgdata%qrl_m (:ncol,:)/cpair,ncol,lchnk) - call outfld('QRLC'//' ',rad_avgdata%qrlc_m(:ncol,:)/cpair,ncol,lchnk) - call outfld('FLNT'//' ',rad_avgdata%flnt_m(:) ,pcols,lchnk) - call outfld('FLUT'//' ',rad_avgdata%flut_m(:) ,pcols,lchnk) - call outfld('FLUTC'//' ',rad_avgdata%flutc_m(:) ,pcols,lchnk) - call outfld('FLNTC'//' ',rad_avgdata%flntc_m(:) ,pcols,lchnk) - call outfld('FLNS'//' ',rad_avgdata%flns_m(:) ,pcols,lchnk) - - call outfld('FLDSC'//' ',rad_avgdata%fldsc_m(:) ,pcols,lchnk) - call outfld('FLNSC'//' ',rad_avgdata%flnsc_m(:) ,pcols,lchnk) - call outfld('LWCF'//' ',rad_avgdata%flutc_m(:)-rad_avgdata%flut_m(:) ,pcols,lchnk) - call outfld('FLN200'//' ',rad_avgdata%fln200_m(:),pcols,lchnk) - call outfld('FLN200C'//' ',rad_avgdata%fln200c_m(:),pcols,lchnk) - call outfld('FLDS'//' ',rad_avgdata%flwds_m(:) ,pcols,lchnk) - call outfld('FLNR'//' ',rad_avgdata%flnr_m(:),pcols,lchnk) - - call outfld('CRM_FLNT', rad_avgdata%crm_flnt, pcols, lchnk) - call outfld('CRM_FLNTC', rad_avgdata%crm_flntc, pcols, lchnk) - call outfld('CRM_FLNS', rad_avgdata%crm_flns, pcols, lchnk) - call outfld('CRM_FLNSC', rad_avgdata%crm_flnsc, pcols, lchnk) - - call outfld('CRM_REL', rad_avgdata%rel_crm, pcols, lchnk) - call outfld('CRM_REI', rad_avgdata%rei_crm, pcols, lchnk) - call outfld('CRM_MU', rad_avgdata%mu_crm, pcols, lchnk) - call outfld('CRM_DEI', rad_avgdata%dei_crm, pcols, lchnk) - call outfld('CRM_DES', rad_avgdata%des_crm, pcols, lchnk) - call outfld('CRM_LAMBDA', rad_avgdata%lambdac_crm, pcols, lchnk) - call outfld('CRM_TAU', rad_avgdata%cld_tau_crm, pcols, lchnk) - call outfld('CRM_QRL', rad_avgdata%qrl_crm, pcols, lchnk) - call outfld('CRM_QRS', rad_avgdata%qrs_crm, pcols, lchnk) - - - - do i=1, ncol - do k=1, pver - rad_avgdata%tot_cld_vistau_m(i,k) = rad_avgdata%tot_icld_vistau_m(i,k) * factor_xy - if(rad_avgdata%nct_tot_icld_vistau_m(i,k).ge. 0.1_r8) then - rad_avgdata%tot_icld_vistau_m(i,k) = rad_avgdata%tot_icld_vistau_m(i,k)/rad_avgdata%nct_tot_icld_vistau_m(i,k) - else - rad_avgdata%tot_icld_vistau_m(i,k) = 0.0_r8 - end if - - if(rad_avgdata%nct_liq_icld_vistau_m(i,k).ge. 0.1_r8) then - rad_avgdata%liq_icld_vistau_m(i,k) = rad_avgdata%liq_icld_vistau_m(i,k)/rad_avgdata%nct_liq_icld_vistau_m(i,k) - else - rad_avgdata%liq_icld_vistau_m(i,k) = 0.0_r8 - end if - - if(rad_avgdata%nct_ice_icld_vistau_m(i,k).ge. 0.1_r8) then - rad_avgdata%ice_icld_vistau_m(i,k) = rad_avgdata%ice_icld_vistau_m(i,k)/rad_avgdata%nct_ice_icld_vistau_m(i,k) - else - rad_avgdata%ice_icld_vistau_m(i,k) = 0.0_r8 - end if - - if(rad_avgdata%nct_snow_icld_vistau_m(i,k).ge. 0.1_r8) then - rad_avgdata%snow_icld_vistau_m(i,k) = rad_avgdata%snow_icld_vistau_m(i,k)/rad_avgdata%nct_snow_icld_vistau_m(i,k) - else - rad_avgdata%snow_icld_vistau_m(i,k) = 0.0_r8 - end if - - end do - end do - - ! Output aerosol mmr - call rad_cnst_out(0, state, pbuf) - - - ! restore to the non-spcam values - - call pbuf_get_field(pbuf, iciwp_idx, cicewp) - call pbuf_get_field(pbuf, iclwp_idx, cliqwp) - call pbuf_get_field(pbuf, icswp_idx, csnowp) - call pbuf_get_field(pbuf, rel_idx, rel) - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, landm_idx, landm) - call pbuf_get_field(pbuf, dei_idx, dei) - call pbuf_get_field(pbuf, mu_idx, mu) - call pbuf_get_field(pbuf, lambdac_idx, lambdac) - call pbuf_get_field(pbuf, des_idx, des) - call pbuf_get_field(pbuf, crm_qrad_idx, crm_qrad) - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - - if (cldfsnow_idx > 0) then - call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - endif - - if (prog_modal_aero) then - call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) - call pbuf_get_field(pbuf, qaerwat_idx, qaerwat, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) - endif - - do m=1,crm_nz - k = pver-m+1 - do i = 1,ncol - ! for energy conservation - crm_qrad(i,:,:,m) = (rad_avgdata%qrs_crm(i,:,:,m)+rad_avgdata%qrl_crm(i,:,:,m)) * state%pdel(i,k) - end do - end do - - ! output rad inputs and resulting heating rates - call rad_data_write( pbuf, state, cam_in, coszrs ) - - ! Compute net radiative heating tendency - call radheat_tend(state, pbuf, ptend, rad_avgdata%qrl_m(:,:), rad_avgdata%qrs_m(:,:), rad_avgdata%fsns_m(:), & - rad_avgdata%fsnt_m(:), rad_avgdata%flns_m(:), rad_avgdata%flnt_m(:), cam_in%asdir, net_flx) - - ! Compute heating rate for dtheta/dt - do k=1,pver - do i=1,ncol - ftem(i,k) = (rad_avgdata%qrs_m(i,k) + rad_avgdata%qrl_m(i,k))/cpair * (1.e5_r8/state%pmid(i,k))**cappa - end do - end do - call outfld('HR ',ftem ,pcols ,lchnk ) - - ! convert radiative heating rates to Q*dp for energy conservation - call pbuf_get_field(pbuf, qrs_idx, qrs) - call pbuf_get_field(pbuf, qrl_idx, qrl) - do k =1 , pver - do i = 1, ncol - qrs(i,k) = rad_avgdata%qrs_m(i,k)*state%pdel(i,k) - qrl(i,k) = rad_avgdata%qrl_m(i,k)*state%pdel(i,k) - end do - end do - - ! Output icall=0 (climate) - cam_out%flwds(:ncol) = rad_avgdata%flwds_m(:ncol) - cam_out%netsw(:ncol) = rad_avgdata%fsns_m(:ncol) - cam_out%sols(:ncol) = rad_avgdata%sols_m(:ncol) - cam_out%soll(:ncol) = rad_avgdata%soll_m(:ncol) - cam_out%solsd(:ncol) = rad_avgdata%solsd_m(:ncol) - cam_out%solld(:ncol) = rad_avgdata%solld_m(:ncol) - - - call pbuf_get_field(pbuf, fsns_idx, fsns) - call pbuf_get_field(pbuf, fsnt_idx, fsnt) - call pbuf_get_field(pbuf, flns_idx, flns) - call pbuf_get_field(pbuf, flnt_idx, flnt) - call pbuf_get_field(pbuf, fsds_idx, fsds) - fsns(:ncol) = rad_avgdata%fsns_m(:ncol) - fsnt(:ncol) = rad_avgdata%fsnt_m(:ncol) - flns(:ncol) = rad_avgdata%flns_m(:ncol) - flnt(:ncol) = rad_avgdata%flnt_m(:ncol) - fsds(:ncol) = rad_avgdata%fsds_m(:ncol) - - deallocate(rad_avgdata%solin_m) - deallocate(rad_avgdata%fsntoa_m) - deallocate(rad_avgdata%fsutoa_m) - deallocate(rad_avgdata%fsntoac_m) - deallocate(rad_avgdata%fsnirt_m) - deallocate(rad_avgdata%fsnrtc_m) - deallocate(rad_avgdata%fsnirtsq_m) - deallocate(rad_avgdata%fsntc_m) - deallocate(rad_avgdata%fsnsc_m) - deallocate(rad_avgdata%fsdsc_m) - deallocate(rad_avgdata%flut_m) - deallocate(rad_avgdata%flutc_m) - deallocate(rad_avgdata%flntc_m) - deallocate(rad_avgdata%flnsc_m) - deallocate(rad_avgdata%fldsc_m) - deallocate(rad_avgdata%flwds_m) - deallocate(rad_avgdata%fsns_m) - deallocate(rad_avgdata%fsnr_m) - deallocate(rad_avgdata%fsnt_m) - deallocate(rad_avgdata%flns_m) - deallocate(rad_avgdata%flnt_m) - deallocate(rad_avgdata%flnr_m) - deallocate(rad_avgdata%fsds_m) - deallocate(rad_avgdata%fln200_m) - deallocate(rad_avgdata%fln200c_m) - deallocate(rad_avgdata%fsn200_m) - deallocate(rad_avgdata%fsn200c_m) - deallocate(rad_avgdata%sols_m) - deallocate(rad_avgdata%soll_m) - deallocate(rad_avgdata%solsd_m) - deallocate(rad_avgdata%solld_m) - deallocate(rad_avgdata%qrs_m) - deallocate(rad_avgdata%qrl_m) - deallocate(rad_avgdata%qrsc_m) - deallocate(rad_avgdata%qrlc_m) - deallocate(rad_avgdata%rel_crm) - deallocate(rad_avgdata%rei_crm) - deallocate(rad_avgdata%cld_tau_crm) - deallocate(rad_avgdata%qrl_crm) - deallocate(rad_avgdata%qrs_crm) - deallocate(rad_avgdata%crm_fsnt) - deallocate(rad_avgdata%crm_fsntc) - deallocate(rad_avgdata%crm_fsns) - deallocate(rad_avgdata%crm_fsnsc) - deallocate(rad_avgdata%crm_flnt) - deallocate(rad_avgdata%crm_flntc) - deallocate(rad_avgdata%crm_flns) - deallocate(rad_avgdata%crm_flnsc) - deallocate(rad_avgdata%crm_swcf) - deallocate(rad_avgdata%crm_aodvisz) - deallocate(rad_avgdata%crm_aodvis) - deallocate(rad_avgdata%crm_aod400) - deallocate(rad_avgdata%crm_aod700) - deallocate(rad_avgdata%aod400) - deallocate(rad_avgdata%aod700) - - deallocate(rad_avgdata%tot_cld_vistau_m) - deallocate(rad_avgdata%tot_icld_vistau_m) - deallocate(rad_avgdata%liq_icld_vistau_m) - deallocate(rad_avgdata%ice_icld_vistau_m) - deallocate(rad_avgdata%nct_tot_icld_vistau_m) - - deallocate(rad_avgdata%nct_liq_icld_vistau_m) - deallocate(rad_avgdata%nct_ice_icld_vistau_m) - deallocate(rad_avgdata%snow_icld_vistau_m) - deallocate(rad_avgdata%nct_snow_icld_vistau_m) - - deallocate(rad_avgdata%dei_crm) - deallocate(rad_avgdata%mu_crm) - deallocate(rad_avgdata%lambdac_crm) - deallocate(rad_avgdata%des_crm) - -#endif -end subroutine spcam_radiation_finalize_m2005 - -!=============================================================================== - -subroutine spcam_radiation_col_finalize_m2005(state, ii, jj, pbuf, rd, cam_out, rad_avgdata) - - use physconst, only: cpair - use physics_buffer, only: pbuf_old_tim_idx - use radiation, only: radiation_do - use cam_history, only: hist_fld_active - - type(physics_state), intent(in) :: state - integer, intent(in) :: ii - integer, intent(in) :: jj - type(physics_buffer_desc), pointer :: pbuf(:) - type(rad_out_t), intent(in) :: rd - type(cam_out_t), intent(inout) :: cam_out - - type(rad_avgdata_type_m2005), intent(inout) :: rad_avgdata - -#ifdef m2005 - - real(r8), parameter :: cgs2mks = 1.e-3_r8 - real(r8), parameter :: factor_xy = 1._r8/dble(crm_nx*crm_ny) - - integer :: i, k, m - integer :: ncol - integer :: itim_old - - logical :: dosw, dolw - - real(r8), pointer, dimension(:,:) :: qrs, qrl, cld - real(r8), pointer, dimension(:) :: fsds, fsns, fsnt, flns, flnt - - ncol = state%ncol - - dosw = radiation_do('sw') ! do shortwave heating calc this timestep? - dolw = radiation_do('lw') ! do longwave heating calc this timestep? - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - call pbuf_get_field(pbuf, qrs_idx, qrs) - call pbuf_get_field(pbuf, qrl_idx, qrl) - - call pbuf_get_field(pbuf, fsns_idx, fsns) - call pbuf_get_field(pbuf, fsnt_idx, fsnt) - call pbuf_get_field(pbuf, flns_idx, flns) - call pbuf_get_field(pbuf, flnt_idx, flnt) - call pbuf_get_field(pbuf, fsds_idx, fsds) - - ! convert radiative heating rates from Q*dp for energy conservation - do k =1 , pver - do i = 1, ncol - qrs(i,k) = qrs(i,k)/state%pdel(i,k) - qrl(i,k) = qrl(i,k)/state%pdel(i,k) - end do - end do - - do m=1,crm_nz - k = pver-m+1 - do i=1,ncol - rad_avgdata%cld_tau_crm(i,ii,jj,m)= rd%cld_tau_cloudsim(i,k) - end do ! i - end do ! m - - if (dosw) then - - do i=1, ncol - rad_avgdata%qrs_m(i,:pver) = rad_avgdata%qrs_m(i,:pver) + qrs(i,:pver) *factor_xy - rad_avgdata%fsds_m(i) = rad_avgdata%fsds_m(i) + fsds(i) *factor_xy - rad_avgdata%fsnt_m(i) = rad_avgdata%fsnt_m(i) + fsnt(i) *factor_xy - rad_avgdata%fsns_m(i) = rad_avgdata%fsns_m(i) + fsns(i) *factor_xy - rad_avgdata%qrsc_m(i,:pver) = rad_avgdata%qrsc_m(i,:pver) + rd%qrsc(i,:pver) *factor_xy - rad_avgdata%solin_m(i) = rad_avgdata%solin_m(i) + rd%solin(i) *factor_xy - rad_avgdata%fsnirt_m(i) = rad_avgdata%fsnirt_m(i) + rd%fsnirt(i) *factor_xy - rad_avgdata%fsnrtc_m(i) = rad_avgdata%fsnrtc_m(i) + rd%fsnrtc(i) *factor_xy - rad_avgdata%fsnirtsq_m(i) = rad_avgdata%fsnirtsq_m(i) + rd%fsnirtsq(i) *factor_xy - rad_avgdata%fsntc_m(i) = rad_avgdata%fsntc_m(i) + rd%fsntc(i) *factor_xy - rad_avgdata%fsnsc_m(i) = rad_avgdata%fsnsc_m(i) + rd%fsnsc(i) *factor_xy - rad_avgdata%fsdsc_m(i) = rad_avgdata%fsdsc_m(i) + rd%fsdsc(i) *factor_xy - rad_avgdata%fsntoa_m(i) = rad_avgdata%fsntoa_m(i) + rd%fsntoa(i) *factor_xy - rad_avgdata%fsutoa_m(i) = rad_avgdata%fsutoa_m(i) + rd%fsutoa(i) *factor_xy - rad_avgdata%fsntoac_m(i) = rad_avgdata%fsntoac_m(i) + rd%fsntoac(i) *factor_xy - rad_avgdata%sols_m(i) = rad_avgdata%sols_m(i) + cam_out%sols(i) *factor_xy - rad_avgdata%soll_m(i) = rad_avgdata%soll_m(i) + cam_out%soll(i) *factor_xy - rad_avgdata%solsd_m(i) = rad_avgdata%solsd_m(i) + cam_out%solsd(i) *factor_xy - rad_avgdata%solld_m(i) = rad_avgdata%solld_m(i) + cam_out%solld(i) *factor_xy - rad_avgdata%fsn200_m(i) = rad_avgdata%fsn200_m(i) + rd%fsn200(i) *factor_xy - rad_avgdata%fsn200c_m(i) = rad_avgdata%fsn200c_m(i) + rd%fsn200c(i) *factor_xy - if (hist_fld_active('FSNR')) then - rad_avgdata%fsnr_m(i) = rad_avgdata%fsnr_m(i) + rd%fsnr(i) *factor_xy - end if - rad_avgdata%crm_fsnt(i, ii, jj) = fsnt(i) - rad_avgdata%crm_fsntc(i,ii,jj) = rd%fsntc(i) - rad_avgdata%crm_fsns(i, ii, jj) = fsns(i) - rad_avgdata%crm_fsnsc(i,ii,jj) = rd%fsnsc(i) - rad_avgdata%crm_swcf(i,ii,jj) = rd%fsntoa(i) - rd%fsntoac(i) - rad_avgdata%crm_aodvis(i,ii,jj) = sum(rd%aer_tau550(i, :)) - rad_avgdata%crm_aod400(i,ii,jj) = sum(rd%aer_tau400(i, :)) - rad_avgdata%crm_aod700(i,ii,jj) = sum(rd%aer_tau700(i, :)) - rad_avgdata%aod400(i) = rad_avgdata%aod400(i)+rad_avgdata%crm_aod400(i,ii,jj) * factor_xy - rad_avgdata%aod700(i) = rad_avgdata%aod700(i)+rad_avgdata%crm_aod700(i,ii,jj) * factor_xy - end do - do m=1,crm_nz - k = pver-m+1 - rad_avgdata%qrs_crm(:ncol,ii,jj,m) = qrs(:ncol,k) / cpair - rad_avgdata%crm_aodvisz(:ncol, ii, jj, m) = rd%aer_tau550(:ncol,k) - end do - - do i=1, ncol - do k=1, pver - if(rd%tot_icld_vistau(i,k).gt.1.0e-10_r8) then - rad_avgdata%tot_icld_vistau_m(i,k) = rad_avgdata%tot_icld_vistau_m(i,k) + & - rd%tot_icld_vistau(i,k)*cld(i,k) - rad_avgdata%nct_tot_icld_vistau_m(i,k) = rad_avgdata%nct_tot_icld_vistau_m(i,k) + cld(i,k) - end if - if(rd%liq_icld_vistau(i,k).gt.1.0e-10_r8) then - rad_avgdata%liq_icld_vistau_m(i,k) = rad_avgdata%liq_icld_vistau_m(i,k) + & - rd%liq_icld_vistau(i,k)*cld(i,k) - rad_avgdata%nct_liq_icld_vistau_m(i,k) = rad_avgdata%nct_liq_icld_vistau_m(i,k) + cld(i,k) - end if - if(rd%ice_icld_vistau(i,k).gt.1.0e-10_r8) then - rad_avgdata%ice_icld_vistau_m(i,k) = rad_avgdata%ice_icld_vistau_m(i,k) + & - rd%ice_icld_vistau(i,k)*cld(i,k) - rad_avgdata%nct_ice_icld_vistau_m(i,k) = rad_avgdata%nct_ice_icld_vistau_m(i,k) + cld(i,k) - end if - if(rd%snow_icld_vistau(i,k).gt.1.0e-10_r8) then - rad_avgdata%snow_icld_vistau_m(i,k) = rad_avgdata%snow_icld_vistau_m(i,k) + & - rd%snow_icld_vistau(i,k) - rad_avgdata%nct_snow_icld_vistau_m(i,k) = rad_avgdata%nct_snow_icld_vistau_m(i,k) + 1 - end if - end do - end do - end if ! dosw - - if (dolw) then - - do i=1, ncol - rad_avgdata%qrl_m(i,:pver) = rad_avgdata%qrl_m(i,:pver) + qrl(i,:pver)*factor_xy - rad_avgdata%qrlc_m(i,:pver) = rad_avgdata%qrlc_m(i,:pver) + rd%qrlc(i,:pver)*factor_xy - rad_avgdata%flnt_m(i) = rad_avgdata%flnt_m(i) + flnt(i) *factor_xy - rad_avgdata%flut_m(i) = rad_avgdata%flut_m(i)+rd%flut(i) *factor_xy - rad_avgdata%flutc_m(i) = rad_avgdata%flutc_m(i)+rd%flutc(i) *factor_xy - rad_avgdata%flntc_m(i) = rad_avgdata%flntc_m(i)+rd%flntc(i) *factor_xy - rad_avgdata%flns_m(i) = rad_avgdata%flns_m(i) + flns(i) *factor_xy - rad_avgdata%flnsc_m(i) = rad_avgdata%flnsc_m(i)+rd%flnsc(i) *factor_xy - rad_avgdata%fldsc_m(i) = rad_avgdata%fldsc_m(i)+rd%fldsc(i) *factor_xy - rad_avgdata%flwds_m(i) = rad_avgdata%flwds_m(i)+cam_out%flwds(i) *factor_xy - rad_avgdata%fln200_m(i) = rad_avgdata%fln200_m(i)+rd%fln200(i) *factor_xy - rad_avgdata%fln200c_m(i) = rad_avgdata%fln200c_m(i)+rd%fln200c(i) *factor_xy - if (hist_fld_active('FLNR')) then - rad_avgdata%flnr_m(i) = rad_avgdata%flnr_m(i)+rd%flnr(i) *factor_xy - end if - - call pbuf_get_field(pbuf, fsns_idx, fsns) - call pbuf_get_field(pbuf, fsnt_idx, fsnt) - call pbuf_get_field(pbuf, flns_idx, flns) - call pbuf_get_field(pbuf, flnt_idx, flnt) - call pbuf_get_field(pbuf, fsds_idx, fsds) - - rad_avgdata%crm_flnt(i, ii, jj) = flnt(i) - rad_avgdata%crm_flntc(i,ii,jj) = rd%flntc(i) - rad_avgdata%crm_flns(i, ii, jj) = flns(i) - rad_avgdata%crm_flnsc(i,ii,jj) = rd%flnsc(i) - do m=1,crm_nz - k = pver-m+1 - rad_avgdata%qrl_crm(:ncol,ii,jj,m) = qrl(:ncol,k) / cpair - end do - - end do - - end if !dolw - - -#endif - -end subroutine spcam_radiation_col_finalize_m2005 - -!=============================================================================== - -subroutine spcam_radiation_setup_sam1mom(cam_in, cldn, state, pbuf, rad_avgdata, state_loc) - - use physics_buffer, only: physics_buffer_desc, pbuf_get_field - use physics_buffer, only: pbuf_old_tim_idx - - type(cam_in_t), intent(in) :: cam_in - real(r8), dimension(:,:), intent(out) :: cldn - type(physics_state), intent(in) :: state - type(physics_buffer_desc), intent(inout), pointer :: pbuf(:) - - type(rad_avgdata_type_sam1mom) :: rad_avgdata - type(physics_state), intent(inout) :: state_loc - -#ifdef sam1mom - real(r8),pointer :: emis(:,:) ! Cloud longwave emissivity - real(r8),pointer :: cldtau(:,:) ! Cloud longwave optical depth - real(r8),pointer :: cicewp(:,:) ! in-cloud cloud ice water path - real(r8),pointer :: cliqwp(:,:) ! in-cloud cloud liquid water path - - real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) - real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) - real(r8), pointer, dimension(:,:) :: cld - real(r8), pointer, dimension(:) :: landm ! land fraction ramp - - - integer :: lchnk ! chunk identifier - integer :: ncol ! number of atmospheric columns - integer :: itim_old - - ncol = state%ncol - lchnk = state%lchnk - - - call physics_state_copy(state, state_loc) - - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - - ! Save the grid level cld values as cld will be overwritten with each crm-scale level value during radiation - cldn = cld - - allocate(rad_avgdata%solin_m (pcols)) - allocate(rad_avgdata%fsntoa_m (pcols)) - allocate(rad_avgdata%fsutoa_m (pcols)) - allocate(rad_avgdata%fsntoac_m (pcols)) - allocate(rad_avgdata%fsnirt_m (pcols)) - allocate(rad_avgdata%fsnrtc_m (pcols)) - allocate(rad_avgdata%fsnirtsq_m (pcols)) - allocate(rad_avgdata%fsntc_m (pcols)) - allocate(rad_avgdata%fsnsc_m (pcols)) - allocate(rad_avgdata%fsdsc_m (pcols)) - allocate(rad_avgdata%flut_m (pcols)) - allocate(rad_avgdata%flutc_m (pcols)) - allocate(rad_avgdata%flntc_m (pcols)) - allocate(rad_avgdata%flnsc_m (pcols)) - allocate(rad_avgdata%fldsc_m (pcols)) - allocate(rad_avgdata%flwds_m (pcols)) - allocate(rad_avgdata%fsns_m (pcols)) - allocate(rad_avgdata%fsnr_m (pcols)) - allocate(rad_avgdata%fsnt_m (pcols)) - allocate(rad_avgdata%flns_m (pcols)) - allocate(rad_avgdata%flnt_m (pcols)) - allocate(rad_avgdata%flnr_m (pcols)) - allocate(rad_avgdata%fsds_m (pcols)) - allocate(rad_avgdata%fln200_m (pcols)) - allocate(rad_avgdata%fln200c_m (pcols)) - allocate(rad_avgdata%fsn200_m (pcols)) - allocate(rad_avgdata%fsn200c_m (pcols)) - allocate(rad_avgdata%sols_m (pcols)) - allocate(rad_avgdata%soll_m (pcols)) - allocate(rad_avgdata%solsd_m (pcols)) - allocate(rad_avgdata%solld_m (pcols)) - allocate(rad_avgdata%qrs_m (pcols,pver)) - allocate(rad_avgdata%qrl_m (pcols,pver)) - allocate(rad_avgdata%qrsc_m (pcols,pver)) - allocate(rad_avgdata%qrlc_m (pcols,pver)) - allocate(rad_avgdata%rel_crm (pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%rei_crm (pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%cld_tau_crm (pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%qrl_crm (pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%qrs_crm (pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%crm_fsnt (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_fsntc (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_fsns (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_fsnsc (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_flnt (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_flntc (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_flns (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_flnsc (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_swcf (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_aodvisz (pcols, crm_nx, crm_ny, crm_nz)) - allocate(rad_avgdata%crm_aodvis (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_aod400 (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%crm_aod700 (pcols, crm_nx, crm_ny)) - allocate(rad_avgdata%aod400 (pcols)) - allocate(rad_avgdata%aod700 (pcols)) - allocate(rad_avgdata%fsdtoa_m (pcols)) - allocate(rad_avgdata%flds_m (pcols)) - - allocate(rad_avgdata%tot_cld_vistau_m ( pcols,pver)) - allocate(rad_avgdata%tot_icld_vistau_m (pcols,pver)) - allocate(rad_avgdata%liq_icld_vistau_m (pcols,pver)) - allocate(rad_avgdata%ice_icld_vistau_m (pcols,pver)) - allocate(rad_avgdata%nct_tot_icld_vistau_m(pcols,pver)) - allocate(rad_avgdata%nct_liq_icld_vistau_m(pcols,pver)) - allocate(rad_avgdata%nct_ice_icld_vistau_m(pcols,pver)) - - call pbuf_get_field(pbuf, rel_idx, rel) - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, landm_idx, landm) - call pbuf_get_field(pbuf, crm_t_rad_idx, rad_avgdata%t_rad) - call pbuf_get_field(pbuf, crm_qc_rad_idx, rad_avgdata%qc_rad) - call pbuf_get_field(pbuf, crm_qi_rad_idx, rad_avgdata%qi_rad) - call pbuf_get_field(pbuf, crm_qv_rad_idx, rad_avgdata%qv_rad) - call pbuf_get_field(pbuf, crm_qrad_idx, rad_avgdata%crm_qrad) - - - ! pbuf cloud properties set in cloud_diagnostics - call pbuf_get_field(pbuf, cicewp_idx, cicewp) - call pbuf_get_field(pbuf, cliqwp_idx, cliqwp) - call pbuf_get_field(pbuf, cldemis_idx, emis) - call pbuf_get_field(pbuf, cldtau_idx, cldtau) - - - rad_avgdata%solin_m = 0._r8 - rad_avgdata%fsntoa_m = 0._r8 - rad_avgdata%fsutoa_m = 0._r8 - rad_avgdata%fsntoac_m = 0._r8 - rad_avgdata%fsnirt_m = 0._r8 - rad_avgdata%fsnrtc_m = 0._r8 - rad_avgdata%fsnirtsq_m = 0._r8 - rad_avgdata%fsntc_m = 0._r8 - rad_avgdata%fsdtoa_m = 0._r8 - rad_avgdata%fsnsc_m = 0._r8 - rad_avgdata%fsdsc_m = 0._r8 - rad_avgdata%flut_m = 0._r8 - rad_avgdata%flutc_m = 0._r8 - rad_avgdata%flntc_m = 0._r8 - rad_avgdata%flnsc_m = 0._r8 - rad_avgdata%flds_m = 0._r8 - rad_avgdata%fldsc_m = 0._r8 - rad_avgdata%fsns_m = 0._r8 - rad_avgdata%fsnt_m = 0._r8 - rad_avgdata%flns_m = 0._r8 - rad_avgdata%flnt_m = 0._r8 - rad_avgdata%flnr_m = 0._r8 - rad_avgdata%fsds_m = 0._r8 - rad_avgdata%fsnr_m = 0._r8 - rad_avgdata%fln200_m = 0._r8 - rad_avgdata%fln200c_m = 0._r8 - rad_avgdata%fsn200_m = 0._r8 - rad_avgdata%fsn200c_m = 0._r8 - rad_avgdata%sols_m = 0._r8 - rad_avgdata%soll_m = 0._r8 - rad_avgdata%solsd_m = 0._r8 - rad_avgdata%solld_m = 0._r8 - rad_avgdata%qrs_m = 0._r8 - rad_avgdata%qrl_m = 0._r8 - rad_avgdata%qrsc_m = 0._r8 - rad_avgdata%qrlc_m = 0._r8 - rad_avgdata%qrs_crm = 0._r8 - rad_avgdata%qrl_crm = 0._r8 - - rad_avgdata%tot_cld_vistau_m =0._r8 - rad_avgdata%tot_icld_vistau_m=0._r8 ; rad_avgdata%nct_tot_icld_vistau_m=0._r8 - rad_avgdata%liq_icld_vistau_m=0._r8 ; rad_avgdata%nct_liq_icld_vistau_m=0._r8 - rad_avgdata%ice_icld_vistau_m=0._r8 ; rad_avgdata%nct_ice_icld_vistau_m=0._r8 - - - ! Compute effective sizes - call cldefr(lchnk, ncol, cam_in%landfrac, state%t, rel, rei, state%ps, state%pmid, landm, cam_in%icefrac, cam_in%snowhland) - - cicewp(1:ncol,1:pver) = 0._r8 - cliqwp(1:ncol,1:pver) = 0._r8 - -#endif -end subroutine spcam_radiation_setup_sam1mom - -!=============================================================================== - -subroutine spcam_radiation_col_setup_sam1mom(ii, jj, state_loc, pbuf, rad_avgdata) - - use physics_buffer, only: pbuf_old_tim_idx - use physconst, only: gravit - - integer,intent(in) :: ii,jj - - type(physics_state), intent(inout) :: state_loc - type(physics_buffer_desc), intent(inout), pointer :: pbuf(:) - type(rad_avgdata_type_sam1mom), intent(inout) :: rad_avgdata - -#ifdef sam1mom - - real(r8),pointer :: emis(:,:) ! Cloud longwave emissivity - real(r8),pointer :: cldtau(:,:) ! Cloud longwave optical depth - real(r8),pointer :: cicewp(:,:) ! in-cloud cloud ice water path - real(r8),pointer :: cliqwp(:,:) ! in-cloud cloud liquid water path - - real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) - real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) - real(r8), pointer, dimension(:,:,:,:) :: cld_rad ! rad cloud fraction - real(r8), pointer, dimension(:,:) :: pmxrgn ! Maximum values of pressure for each - ! maximally overlapped region. - ! 0->pmxrgn(i,1) is range of pressure for - ! 1st region,pmxrgn(i,1)->pmxrgn(i,2) for - ! 2nd region, etc - integer, pointer, dimension(:) :: nmxrgn ! pbuf pointer to Number of maximally overlapped regions - - real(r8) :: qtot - real(r8), dimension(pcols,pver) :: fice - real(r8), dimension(pcols,pver) :: tmp - real(r8), pointer, dimension(:,:) :: cld ! cloud fraction - - integer :: itim_old - integer :: m, k, i - - integer :: lchnk ! chunk identifier - integer :: ncol ! number of atmospheric columns - - lchnk = state_loc%lchnk - ncol = state_loc%ncol - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - - call pbuf_get_field(pbuf, pmxrgn_idx, pmxrgn) - call pbuf_get_field(pbuf, nmxrgn_idx, nmxrgn) - call pbuf_get_field(pbuf, rel_idx, rel) - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, crm_cld_rad_idx, cld_rad) - - call pbuf_get_field(pbuf, crm_t_rad_idx, rad_avgdata%t_rad) - call pbuf_get_field(pbuf, crm_qc_rad_idx, rad_avgdata%qc_rad) - call pbuf_get_field(pbuf, crm_qi_rad_idx, rad_avgdata%qi_rad) - call pbuf_get_field(pbuf, crm_qv_rad_idx, rad_avgdata%qv_rad) - call pbuf_get_field(pbuf, crm_qrad_idx, rad_avgdata%crm_qrad) - - - ! pbuf cloud properties set in cloud_diagnostics - call pbuf_get_field(pbuf, cicewp_idx, cicewp) - call pbuf_get_field(pbuf, cliqwp_idx, cliqwp) - call pbuf_get_field(pbuf, cldemis_idx, emis) - call pbuf_get_field(pbuf, cldtau_idx, cldtau) - - fice(1:ncol,1:pver-crm_nz) = 0._r8 - - do m=1,crm_nz - k = pver-m+1 - do i=1,ncol - - qtot = rad_avgdata%qc_rad(i,ii,jj,m) + rad_avgdata%qi_rad(i,ii,jj,m) - if(qtot.gt.1.e-9_r8) then - fice(i,k) = rad_avgdata%qi_rad(i,ii,jj,m)/qtot - ! In case CRM produces fractional cloudiness - cld(i,k) = min(0.99_r8, cld_rad(i,ii,jj,m)) - - cicewp(i,k) = rad_avgdata%qi_rad(i,ii,jj,m)*state_loc%pdel(i,k)/gravit*1000.0_r8 & - / max(0.01_r8,cld(i,k)) ! In-cloud ice water path. - cliqwp(i,k) = rad_avgdata%qc_rad(i,ii,jj,m)*state_loc%pdel(i,k)/gravit*1000.0_r8 & - / max(0.01_r8,cld(i,k)) ! In-cloud liquid water path. - else - fice(i,k)=0._r8 - cld(i,k)=0._r8 - cicewp(i,k) = 0._r8 ! In-cloud ice water path. - cliqwp(i,k) = 0._r8 ! In-cloud liquid water path. - end if - end do ! i - end do ! m - - ! Cloud emissivity. - - tmp(:ncol,:) = cicewp(:ncol,:) + cliqwp(:ncol,:) - call cldems(lchnk, ncol, tmp, fice, rei, emis, cldtau) - - call cldovrlap(lchnk, ncol, state_loc%pint, cld, nmxrgn, pmxrgn) - - ! Setup the trad and qvrad variables (now in state) - do m=1,crm_nz - k = pver-m+1 - do i=1,ncol - state_loc%q(i,k,1) = max(1.e-9_r8,rad_avgdata%qv_rad(i,ii,jj,m)) - state_loc%t(i,k) = rad_avgdata%t_rad(i,ii,jj,m) - end do - end do - - -#endif -end subroutine spcam_radiation_col_setup_sam1mom - -!=============================================================================== - -subroutine spcam_radiation_finalize_sam1mom(cam_in, state, pbuf, rad_avgdata, cam_out, cldn, net_flx, ptend) - - use physconst, only: cpair - use rad_constituents,only: rad_cnst_out - - use physconst, only: cappa - use radiation_data, only: rad_data_write - use radheat, only: radheat_tend - use time_manager, only: get_curr_calday - use physics_buffer, only: pbuf_old_tim_idx - use orbit, only: zenith - - type(cam_in_t), intent(in) :: cam_in - type(physics_state), intent(in) :: state - - - type(physics_buffer_desc), intent(inout), pointer :: pbuf(:) - type(rad_avgdata_type_sam1mom), intent(inout) :: rad_avgdata - type(cam_out_t), intent(inout) :: cam_out - real(r8), dimension(:,:), intent(in) :: cldn - real(r8), intent(inout) :: net_flx(pcols) - - type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies - -#ifdef sam1mom - - integer :: lchnk ! chunk identifier - integer :: ncol ! number of atmospheric columns - integer :: i, k, m - real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables - - real(r8), pointer, dimension(:,:) :: qrs, qrl, cld - real(r8), pointer :: fsns(:) ! Surface solar absorbed flux - real(r8), pointer :: fsnt(:) ! Net column abs solar flux at model top - real(r8), pointer :: flns(:) ! Srf longwave cooling (up-down) flux - real(r8), pointer :: flnt(:) ! Net outgoing lw flux at model top - real(r8), pointer :: fsds(:) ! Surface solar down flux - - - - real(r8) :: calday ! current calendar day - real(r8) :: clat(pcols) ! current latitudes(radians) - real(r8) :: clon(pcols) ! current longitudes(radians) - real(r8) :: coszrs(pcols) ! Cosine solar zenith angle - real(r8) :: factor_xy - - integer :: Nday ! Number of daylight columns - integer :: Nnite ! Number of night columns - integer, dimension(pcols) :: IdxDay ! Indicies of daylight coumns - integer, dimension(pcols) :: IdxNite ! Indicies of night coumns - integer :: itim_old - - lchnk = state%lchnk - ncol = state%ncol - - call pbuf_get_field(pbuf, qrs_idx, qrs) - call pbuf_get_field(pbuf, qrl_idx, qrl) - - factor_xy = 1._r8/dble(crm_nx*crm_ny) - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - ! Reassign the grid level cld values since cld was overwritten with each crm-scale level value during radiation - cld = cldn - - - do m=1,crm_nz - k = pver-m+1 - do i = 1,ncol - ! for energy conservation - rad_avgdata%crm_qrad(i,:,:,m) = (rad_avgdata%qrs_crm(i,:,:,m)+rad_avgdata%qrl_crm(i,:,:,m)) * state%pdel(i,k) - end do - end do - - call pbuf_get_field(pbuf, fsns_idx, fsns) - call pbuf_get_field(pbuf, fsnt_idx, fsnt) - call pbuf_get_field(pbuf, flns_idx, flns) - call pbuf_get_field(pbuf, flnt_idx, flnt) - call pbuf_get_field(pbuf, fsds_idx, fsds) - - fsns = rad_avgdata%fsns_m(:) - fsnt = rad_avgdata%fsnt_m(:) - flns = rad_avgdata%flns_m(:) - flnt = rad_avgdata%flnt_m(:) - fsds = rad_avgdata%fsds_m(:) - - calday = get_curr_calday() - - ! Cosine solar zenith angle for current time step - call get_rlat_all_p(lchnk, ncol, clat) - call get_rlon_all_p(lchnk, ncol, clon) - call zenith (calday, clat, clon, coszrs, ncol) - - ! Gather night/day column indices. - Nday = 0 - Nnite = 0 - do i = 1, ncol - if ( coszrs(i) > 0.0_r8 ) then - Nday = Nday + 1 - IdxDay(Nday) = i - else - Nnite = Nnite + 1 - IdxNite(Nnite) = i - end if - end do - - cam_out%sols(:ncol) = rad_avgdata%sols_m(:ncol) - cam_out%soll(:ncol) = rad_avgdata%soll_m(:ncol) - cam_out%solsd(:ncol) = rad_avgdata%solsd_m(:ncol) - cam_out%solld(:ncol) = rad_avgdata%solld_m(:ncol) - - call outfld('CRM_QRS ',rad_avgdata%qrs_crm,pcols,lchnk) - call outfld('QRS ',rad_avgdata%qrs_m(:,:)/cpair ,pcols,lchnk) - call outfld('QRSC ',rad_avgdata%qrsc_m/cpair,pcols,lchnk) - call outfld('SOLIN ',rad_avgdata%solin_m(:) ,pcols,lchnk) - call outfld('FSDS ',rad_avgdata%fsds_m(:) ,pcols,lchnk) - call outfld('FSNIRTOA',rad_avgdata%fsnirt_m(:),pcols,lchnk) - call outfld('FSNRTOAC',rad_avgdata%fsnrtc_m(:),pcols,lchnk) - call outfld('FSNRTOAS',rad_avgdata%fsnirtsq_m(:),pcols,lchnk) - call outfld('FSNT ',rad_avgdata%fsnt_m(:) ,pcols,lchnk) - call outfld('FSDTOA ',rad_avgdata%fsdtoa_m(:),pcols,lchnk) - call outfld('FSNS ',rad_avgdata%fsns_m(:) ,pcols,lchnk) - call outfld('FSNTC ',rad_avgdata%fsntc_m(:) ,pcols,lchnk) - call outfld('FSNSC ',rad_avgdata%fsnsc_m(:) ,pcols,lchnk) - call outfld('FSDSC ',rad_avgdata%fsdsc_m(:) ,pcols,lchnk) - call outfld('FSNTOA ',rad_avgdata%fsntoa_m(:),pcols,lchnk) - call outfld('FSUTOA ',rad_avgdata%fsutoa_m(:),pcols,lchnk) - call outfld('FSNTOAC ',rad_avgdata%fsntoac_m(:),pcols,lchnk) - call outfld('SOLS ',cam_out%sols ,pcols,lchnk) - call outfld('SOLL ',cam_out%soll ,pcols,lchnk) - call outfld('SOLSD ',cam_out%solsd ,pcols,lchnk) - call outfld('SOLLD ',cam_out%solld ,pcols,lchnk) - call outfld('FSN200 ',rad_avgdata%fsn200_m(:),pcols,lchnk) - call outfld('FSN200C ',rad_avgdata%fsn200c_m(:),pcols,lchnk) - call outfld('FSNR' ,rad_avgdata%fsnr_m(:) ,pcols,lchnk) - call outfld('SWCF ',rad_avgdata%fsntoa_m(:ncol)-rad_avgdata%fsntoac_m(:ncol) ,pcols,lchnk) - - do i=1, Nday - do k=1, pver - rad_avgdata%tot_cld_vistau_m(IdxDay(i),k) = rad_avgdata%tot_icld_vistau_m(IdxDay(i),k) * factor_xy - if(rad_avgdata%nct_tot_icld_vistau_m(IdxDay(i),k).ge. 0.1_r8) then - rad_avgdata%tot_icld_vistau_m(IdxDay(i),k) = rad_avgdata%tot_icld_vistau_m(IdxDay(i),k)/& - rad_avgdata%nct_tot_icld_vistau_m(IdxDay(i),k) - else - rad_avgdata%tot_icld_vistau_m(IdxDay(i),k) = 0.0_r8 - end if - if(rad_avgdata%nct_liq_icld_vistau_m(IdxDay(i),k).ge. 0.1_r8) then - rad_avgdata%liq_icld_vistau_m(IdxDay(i),k) = rad_avgdata%liq_icld_vistau_m(IdxDay(i),k)/& - rad_avgdata%nct_liq_icld_vistau_m(IdxDay(i),k) - else - rad_avgdata%liq_icld_vistau_m(IdxDay(i),k) = 0.0_r8 - end if - if(rad_avgdata%nct_ice_icld_vistau_m(IdxDay(i),k).ge. 0.1_r8) then - rad_avgdata%ice_icld_vistau_m(IdxDay(i),k) = rad_avgdata%ice_icld_vistau_m(IdxDay(i),k)/& - rad_avgdata%nct_ice_icld_vistau_m(IdxDay(i),k) - else - rad_avgdata%ice_icld_vistau_m(IdxDay(i),k) = 0.0_r8 - end if - end do - end do - - ! add fillvalue for night columns - do i = 1, Nnite - rad_avgdata%tot_cld_vistau_m(IdxNite(i),:) = fillvalue - rad_avgdata%tot_icld_vistau_m(IdxNite(i),:) = fillvalue - rad_avgdata%liq_icld_vistau_m(IdxNite(i),:) = fillvalue - rad_avgdata%ice_icld_vistau_m(IdxNite(i),:) = fillvalue - end do - - call outfld ('TOT_CLD_VISTAU ',rad_avgdata%tot_cld_vistau_m ,pcols,lchnk) - call outfld ('TOT_ICLD_VISTAU ',rad_avgdata%tot_icld_vistau_m ,pcols,lchnk) - call outfld ('LIQ_ICLD_VISTAU ',rad_avgdata%liq_icld_vistau_m ,pcols,lchnk) - call outfld ('ICE_ICLD_VISTAU ',rad_avgdata%ice_icld_vistau_m ,pcols,lchnk) - - - ! Longwave - cam_out%flwds(:) = rad_avgdata%flds_m(:) - call outfld('CRM_QRL ',rad_avgdata%qrl_crm, pcols, lchnk) - call outfld('QRL ',rad_avgdata%qrl_m(:ncol,:)/cpair, ncol, lchnk) - call outfld('QRLC ',rad_avgdata%qrlc_m(:ncol,:)/cpair, ncol, lchnk) - call outfld('FLNT ',rad_avgdata%flnt_m , pcols, lchnk) - call outfld('FLUT ',rad_avgdata%flut_m, pcols, lchnk) - call outfld('FLUTC ',rad_avgdata%flutc_m, pcols, lchnk) - call outfld('FLNTC ',rad_avgdata%flntc_m, pcols, lchnk) - call outfld('FLNS ',rad_avgdata%flns_m, pcols, lchnk) - call outfld('FLDS ',rad_avgdata%flds_m, pcols, lchnk) - call outfld('FLNSC ',rad_avgdata%flnsc_m, pcols, lchnk) - call outfld('FLDSC ',rad_avgdata%fldsc_m, pcols, lchnk) - call outfld('LWCF ',rad_avgdata%flutc_m-rad_avgdata%flut_m, pcols, lchnk) - call outfld('FLN200 ',rad_avgdata%fln200_m, pcols, lchnk) - call outfld('FLN200C ',rad_avgdata%fln200c_m, pcols, lchnk) - call outfld('FLNR ' ,rad_avgdata%flnr_m, pcols, lchnk) - - ! Output aerosol mmr - call rad_cnst_out(0, state, pbuf) - - ! output rad inputs and resulting heating rates - call rad_data_write( pbuf, state, cam_in, coszrs ) - - ! Compute net radiative heating tendency - call radheat_tend(state, pbuf, ptend, rad_avgdata%qrl_m, rad_avgdata%qrs_m, rad_avgdata%fsns_m, & - rad_avgdata%fsnt_m, rad_avgdata%flns_m, rad_avgdata%flnt_m, cam_in%asdir, net_flx) - - ! Compute heating rate for dtheta/dt - do k=1,pver - do i=1,ncol - ftem(i,k) = (rad_avgdata%qrs_m(i,k) + rad_avgdata%qrl_m(i,k))/cpair * (1.e5_r8/state%pmid(i,k))**cappa - end do - end do - call outfld('HR ',ftem ,pcols ,lchnk ) - - do k =1 , pver - do i = 1, ncol - qrs(i,k) = rad_avgdata%qrs_m(i,k)*state%pdel(i,k) - qrl(i,k) = rad_avgdata%qrl_m(i,k)*state%pdel(i,k) - end do - end do - - cam_out%netsw(:ncol) = rad_avgdata%fsns_m(:ncol) - cam_out%flwds(:ncol) = rad_avgdata%flds_m(:ncol) - - deallocate(rad_avgdata%solin_m) - deallocate(rad_avgdata%fsntoa_m) - deallocate(rad_avgdata%fsutoa_m) - deallocate(rad_avgdata%fsntoac_m) - deallocate(rad_avgdata%fsnirt_m) - deallocate(rad_avgdata%fsnrtc_m) - deallocate(rad_avgdata%fsnirtsq_m) - deallocate(rad_avgdata%fsntc_m) - deallocate(rad_avgdata%fsnsc_m) - deallocate(rad_avgdata%fsdsc_m) - deallocate(rad_avgdata%flut_m) - deallocate(rad_avgdata%flutc_m) - deallocate(rad_avgdata%flntc_m) - deallocate(rad_avgdata%flnsc_m) - deallocate(rad_avgdata%fldsc_m) - deallocate(rad_avgdata%flwds_m) - deallocate(rad_avgdata%fsns_m) - deallocate(rad_avgdata%fsnr_m) - deallocate(rad_avgdata%fsnt_m) - deallocate(rad_avgdata%flns_m) - deallocate(rad_avgdata%flnt_m) - deallocate(rad_avgdata%flnr_m) - deallocate(rad_avgdata%fsds_m) - deallocate(rad_avgdata%fln200_m) - deallocate(rad_avgdata%fln200c_m) - deallocate(rad_avgdata%fsn200_m) - deallocate(rad_avgdata%fsn200c_m) - deallocate(rad_avgdata%sols_m) - deallocate(rad_avgdata%soll_m) - deallocate(rad_avgdata%solsd_m) - deallocate(rad_avgdata%solld_m) - deallocate(rad_avgdata%qrs_m) - deallocate(rad_avgdata%qrl_m) - deallocate(rad_avgdata%qrsc_m) - deallocate(rad_avgdata%qrlc_m) - deallocate(rad_avgdata%rel_crm) - deallocate(rad_avgdata%rei_crm) - deallocate(rad_avgdata%cld_tau_crm) - deallocate(rad_avgdata%qrl_crm) - deallocate(rad_avgdata%qrs_crm) - deallocate(rad_avgdata%crm_fsnt) - deallocate(rad_avgdata%crm_fsntc) - deallocate(rad_avgdata%crm_fsns) - deallocate(rad_avgdata%crm_fsnsc) - deallocate(rad_avgdata%crm_flnt) - deallocate(rad_avgdata%crm_flntc) - deallocate(rad_avgdata%crm_flns) - deallocate(rad_avgdata%crm_flnsc) - deallocate(rad_avgdata%crm_swcf) - deallocate(rad_avgdata%crm_aodvisz) - deallocate(rad_avgdata%crm_aodvis) - deallocate(rad_avgdata%crm_aod400) - deallocate(rad_avgdata%crm_aod700) - deallocate(rad_avgdata%aod400) - deallocate(rad_avgdata%aod700) - deallocate(rad_avgdata%fsdtoa_m) - deallocate(rad_avgdata%flds_m) - - deallocate(rad_avgdata%tot_cld_vistau_m) - deallocate(rad_avgdata%tot_icld_vistau_m) - deallocate(rad_avgdata%liq_icld_vistau_m) - deallocate(rad_avgdata%ice_icld_vistau_m) - deallocate(rad_avgdata%nct_tot_icld_vistau_m) - deallocate(rad_avgdata%nct_liq_icld_vistau_m) - deallocate(rad_avgdata%nct_ice_icld_vistau_m) -#endif - -end subroutine spcam_radiation_finalize_sam1mom - -subroutine spcam_radiation_col_finalize_sam1mom(state, ii, jj, pbuf, rd, cam_out, rad_avgdata) - - use physconst, only: cpair - use physics_buffer, only: pbuf_old_tim_idx - use orbit, only: zenith - use time_manager, only: get_curr_calday - use radiation, only: radiation_do - - type(physics_state), intent(in) :: state - integer, intent(in) :: ii - integer, intent(in) :: jj - type(physics_buffer_desc), pointer :: pbuf(:) - type(rad_out_t), intent(in) :: rd - type(cam_out_t), intent(inout) :: cam_out - - real(r8), parameter :: cgs2mks = 1.e-3_r8 - - type(rad_avgdata_type_sam1mom), intent(inout) :: rad_avgdata - -#ifdef sam1mom - - real(r8), pointer :: fsns(:) ! Surface solar absorbed flux - real(r8), pointer :: fsnt(:) ! Net column abs solar flux at model top - real(r8), pointer :: flns(:) ! Srf longwave cooling (up-down) flux - real(r8), pointer :: flnt(:) ! Net outgoing lw flux at model top - real(r8), pointer :: fsds(:) ! Surface solar down flux - - integer :: itim_old - integer :: ncol - integer :: i, m, k, lchnk - - - logical :: dosw, dolw - integer :: Nday ! Number of daylight columns - integer :: Nnite ! Number of night columns - integer, dimension(pcols) :: IdxDay ! Indicies of daylight coumns - - - real(r8) :: calday ! current calendar day - real(r8) :: clat(pcols) ! current latitudes(radians) - real(r8) :: clon(pcols) ! current longitudes(radians) - real(r8) :: coszrs(pcols) ! Cosine solar zenith angle - real(r8) :: factor_xy - - real(r8), pointer, dimension(:,:) :: cld - real(r8), pointer, dimension(:,:) :: qrs - real(r8), pointer, dimension(:,:) :: qrl - - ncol = state%ncol - lchnk = state%lchnk - - calday = get_curr_calday() - - ! Cosine solar zenith angle for current time step - call get_rlat_all_p(lchnk, ncol, clat) - call get_rlon_all_p(lchnk, ncol, clon) - call zenith (calday, clat, clon, coszrs, ncol) - - ! Gather night/day column indices. - Nday = 0 - Nnite = 0 - do i = 1, ncol - if ( coszrs(i) > 0.0_r8 ) then - Nday = Nday + 1 - IdxDay(Nday) = i - else - Nnite = Nnite + 1 - end if - end do - - dosw = radiation_do('sw') ! do shortwave heating calc this timestep? - dolw = radiation_do('lw') ! do longwave heating calc this timestep? - - factor_xy = 1._r8/dble(crm_nx*crm_ny) - - itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) - - call pbuf_get_field(pbuf, qrs_idx,qrs) - call pbuf_get_field(pbuf, qrl_idx,qrl) - call pbuf_get_field(pbuf, qrl_idx,qrl) - - ! convert radiative heating rates from Q*dp for energy conservation - do k =1 , pver - do i = 1, ncol - qrs(i,k) = qrs(i,k)/state%pdel(i,k) - qrl(i,k) = qrl(i,k)/state%pdel(i,k) - end do - end do - - if (dosw) then - call pbuf_get_field(pbuf, fsds_idx, fsds) - call pbuf_get_field(pbuf, fsns_idx, fsns) - call pbuf_get_field(pbuf, fsnt_idx, fsnt) - do i=1,ncol - rad_avgdata%fsds_m(i) = rad_avgdata%fsds_m(i) +fsds(i) *factor_xy - rad_avgdata%fsns_m(i) = rad_avgdata%fsns_m(i) +fsns(i) *factor_xy - rad_avgdata%fsnt_m(i) = rad_avgdata%fsnt_m(i) +fsnt(i) *factor_xy - - rad_avgdata%solin_m(i) = rad_avgdata%solin_m(i) +rd%solin(i)*factor_xy - rad_avgdata%fsnirt_m(i) = rad_avgdata%fsnirt_m(i) +rd%fsnirt(i)*factor_xy - rad_avgdata%fsnrtc_m(i) = rad_avgdata%fsnrtc_m(i) +rd%fsnrtc(i)*factor_xy - rad_avgdata%fsnirtsq_m(i)= rad_avgdata%fsnirtsq_m(i)+rd%fsnirtsq(i)*factor_xy - rad_avgdata%fsdtoa_m(i) = rad_avgdata%fsdtoa_m(i) +rd%fsdtoa(i)*factor_xy - rad_avgdata%fsntc_m(i) = rad_avgdata%fsntc_m(i) +rd%fsntc(i)*factor_xy - rad_avgdata%fsnsc_m(i) = rad_avgdata%fsnsc_m(i) +rd%fsnsc(i)*factor_xy - rad_avgdata%fsdsc_m(i) = rad_avgdata%fsdsc_m(i) +rd%fsdsc(i)*factor_xy - rad_avgdata%fsntoa_m(i) = rad_avgdata%fsntoa_m(i) +rd%fsntoa(i)*factor_xy - rad_avgdata%fsutoa_m(i) = rad_avgdata%fsutoa_m(i) +rd%fsutoa(i)*factor_xy - rad_avgdata%fsntoac_m(i) = rad_avgdata%fsntoac_m(i) +rd%fsntoac(i)*factor_xy - - ! sols, soll, solsd, solld have unit of mks, so no conversion is needed - rad_avgdata%sols_m(i) = rad_avgdata%sols_m(i) +cam_out%sols(i) *factor_xy - rad_avgdata%soll_m(i) = rad_avgdata%soll_m(i) +cam_out%soll(i) *factor_xy - rad_avgdata%solsd_m(i) = rad_avgdata%solsd_m(i) +cam_out%solsd(i) *factor_xy - rad_avgdata%solld_m(i) = rad_avgdata%solld_m(i) +cam_out%solld(i) *factor_xy - - rad_avgdata%fsn200_m(i) = rad_avgdata%fsn200_m(i) +rd%fsn200(i) *factor_xy - rad_avgdata%fsn200c_m(i) = rad_avgdata%fsn200c_m(i) +rd%fsn200c(i) *factor_xy - rad_avgdata%fsnr_m(i) = rad_avgdata%fsnr_m(i) +rd%fsnr(i) *factor_xy - end do - rad_avgdata%qrs_m(:ncol,:pver) = rad_avgdata%qrs_m(:ncol,:pver) + qrs(:ncol,:pver) *factor_xy - rad_avgdata%qrsc_m(:ncol,:pver) = rad_avgdata%qrsc_m(:ncol,:pver) + rd%qrsc(:ncol,:pver)*factor_xy - do m=1,crm_nz - k = pver-m+1 - rad_avgdata%qrs_crm(:ncol,ii,jj,m) = qrs(:ncol,k) / cpair - end do - do i=1, Nday - do k=1, pver - if((rd%liq_icld_vistau(IdxDay(i),k)+rd%ice_icld_vistau(IdxDay(i),k)).gt.1.0e-10_r8) then - rad_avgdata%tot_icld_vistau_m(IdxDay(i),k) = rad_avgdata%tot_icld_vistau_m(IdxDay(i),k) + & - (rd%liq_icld_vistau(IdxDay(i),k)+rd%ice_icld_vistau(IdxDay(i),k)) * cld(i,k) - rad_avgdata%nct_tot_icld_vistau_m(IdxDay(i),k) = rad_avgdata%nct_tot_icld_vistau_m(IdxDay(i),k) + cld(i,k) - end if - if(rd%liq_icld_vistau(IdxDay(i),k).gt.1.0e-10_r8) then - rad_avgdata%liq_icld_vistau_m(IdxDay(i),k) = rad_avgdata%liq_icld_vistau_m(IdxDay(i),k) + & - rd%liq_icld_vistau(IdxDay(i),k) * cld(i,k) - rad_avgdata%nct_liq_icld_vistau_m(IdxDay(i),k) = rad_avgdata%nct_liq_icld_vistau_m(IdxDay(i),k) + cld(i,k) - end if - if(rd%ice_icld_vistau(IdxDay(i),k).gt.1.0e-10_r8) then - rad_avgdata%ice_icld_vistau_m(IdxDay(i),k) = rad_avgdata%ice_icld_vistau_m(IdxDay(i),k) + & - rd%ice_icld_vistau(IdxDay(i),k) * cld(i,k) - rad_avgdata%nct_ice_icld_vistau_m(IdxDay(i),k) = rad_avgdata%nct_ice_icld_vistau_m(IdxDay(i),k) + cld(i,k) - end if - end do - end do - end if ! dosw - - if (dolw) then - call pbuf_get_field(pbuf, flns_idx, flns) - call pbuf_get_field(pbuf, flnt_idx, flnt) - do i=1,ncol - rad_avgdata%flns_m(i) = rad_avgdata%flns_m(i) +flns(i) *factor_xy - rad_avgdata%flnt_m(i) = rad_avgdata%flnt_m(i) +flnt(i) *factor_xy - - rad_avgdata%flut_m(i) = rad_avgdata%flut_m(i) +rd%flut(i) *factor_xy - rad_avgdata%flutc_m(i) = rad_avgdata%flutc_m(i) +rd%flutc(i) *factor_xy - rad_avgdata%flds_m(i) = rad_avgdata%flds_m(i) +cam_out%flwds(i) *factor_xy - rad_avgdata%fldsc_m(i) = rad_avgdata%fldsc_m(i) +rd%fldsc(i) *factor_xy - rad_avgdata%flntc_m(i) = rad_avgdata%flntc_m(i) +rd%flntc(i) *factor_xy - rad_avgdata%fln200_m(i) = rad_avgdata%fln200_m(i) +rd%fln200(i) *factor_xy - rad_avgdata%fln200c_m(i) = rad_avgdata%fln200c_m(i) +rd%fln200c(i) *factor_xy - rad_avgdata%flnsc_m(i) = rad_avgdata%flnsc_m(i) +rd%flnsc(i) *factor_xy - rad_avgdata%flnr_m(i) = rad_avgdata%flnr_m(i) +rd%flnr(i) *factor_xy - end do - rad_avgdata%qrl_m(:ncol,:pver) = rad_avgdata%qrl_m(:ncol,:pver) + qrl(:ncol,:pver) *factor_xy - rad_avgdata%qrlc_m(:ncol,:pver) = rad_avgdata%qrlc_m(:ncol,:pver) + rd%qrlc(:ncol,:pver) *factor_xy - - do m=1,crm_nz - k = pver-m+1 - rad_avgdata%qrl_crm(:ncol,ii,jj,m) = qrl(:ncol,k) / cpair - end do - end if - - do m=1,crm_nz - k = pver-m+1 - do i = 1,ncol - ! for energy conservation - rad_avgdata%crm_qrad(i,ii,jj,m) = (rad_avgdata%qrs_crm(i,ii,jj,m)+rad_avgdata%qrl_crm(i,ii,jj,m)) * state%pdel(i,k) - end do - end do - -#endif -end subroutine spcam_radiation_col_finalize_sam1mom - -end module spcam_drivers diff --git a/src/physics/waccm/aurora_params.F90 b/src/physics/waccm/aurora_params.F90 index 2755184438..737ff608eb 100644 --- a/src/physics/waccm/aurora_params.F90 +++ b/src/physics/waccm/aurora_params.F90 @@ -20,6 +20,6 @@ module aurora_params real(r8) :: dskofc(2) = -huge(1.0_r8) real(r8) :: phin(2) = -huge(1.0_r8) - logical :: amie_period = .false. ! true during a period of prescribed high-latitude electric potential + logical :: prescribed_period = .false. ! true during a period of prescribed high-latitude electric potential end module aurora_params diff --git a/src/physics/waccm/efield.F90 b/src/physics/waccm/efield.F90 index 3ad30a970a..90508549b2 100644 --- a/src/physics/waccm/efield.F90 +++ b/src/physics/waccm/efield.F90 @@ -81,7 +81,7 @@ module efield integer, parameter :: & nmlon1f = nmlon/4, & ! 1 fourth mlon nmlon2f = nmlon/2, & ! 2 fourths mlon - nmlon3f = 3*nmlon/4 ! 3 fourths mlon + nmlon3f = 3*nmlon/4 ! 3 fourths mlon real(r8) :: & ylatm(0:nmlat), & ! magnetic latitudes (deg) @@ -1194,7 +1194,7 @@ subroutine bnd_sinus( ihlat_bnd, itrans_width ) ! Author: A. Maute Nov 2003 am 11/20/03 !---------------------------------------------------------------------------- - use sv_decomp, only : svdcmp, svbksb + external DGESV ! LAPACK routine to solve matrix eq !---------------------------------------------------------------------------- ! ... dummy arguments @@ -1216,6 +1216,11 @@ subroutine bnd_sinus( ihlat_bnd, itrans_width ) real(r8) :: w(nmax_a,nmax_a) real(r8) :: f(-nmax_sin:nmax_sin,0:nmlon) + real(r8) :: x(nmax_a) + integer :: ipiv(nmax_a), info + + character(len=120) :: msg + !---------------------------------------------------------------------------- ! Sinusoidal Boundary calculation !---------------------------------------------------------------------------- @@ -1224,6 +1229,7 @@ subroutine bnd_sinus( ihlat_bnd, itrans_width ) u(:,:) = 0._r8 v(:,:) = 0._r8 w(:,:) = 0._r8 + ipiv(:) = 0 do ilon = 0,nmlon ! long. bnd = nmlath - ihlat_bnd(ilon) ! switch from pole=0 to pole =90 @@ -1238,19 +1244,18 @@ subroutine bnd_sinus( ihlat_bnd, itrans_width ) end do end do end do - -! if (debug) write(iulog,*) ' Single Value Decomposition' - call svdcmp( u, nmax_a, nmax_a, nmax_a, nmax_a, w, v ) - -! if (debug) write(iulog,*) ' Solving' - call svbksb( u, w, v, nmax_a, nmax_a, nmax_a, nmax_a, rhs, lsg ) +! + x(:) = rhs(:) + call DGESV( nmax_a, 1, u, nmax_a, ipiv, x, nmax_a, info) + if (info/=0) then + write(msg,'(a,i4)') 'bnd_sinus -- LAPACK DGESV return error code: ',info + if (masterproc) write(iulog,*) trim(msg) + call endrun(trim(msg)) + end if + lsg(:) = x(:) ! do ilon = 0,nmlon ! long. -! sum = 0._r8 sum = dot_product( lsg(-nmax_sin+ishf:nmax_sin+ishf),f(-nmax_sin:nmax_sin,ilon) ) -! do i = -nmax_sin,nmax_sin -! sum = sum + lsg(i+ishf)*f(i,ilon) -! end do ihlat_bnd(ilon) = nmlath - int( sum + .5_r8 ) ! closest point itrans_width(ilon) = int( 8._r8 - 2._r8*cos( ylonm(ilon)*dtr ) + .5_r8 )/dlatm ! 6 to 10 deg. end do diff --git a/src/physics/waccm/iondrag.F90 b/src/physics/waccm/iondrag.F90 index 8a66c61147..eab5b73c7a 100644 --- a/src/physics/waccm/iondrag.F90 +++ b/src/physics/waccm/iondrag.F90 @@ -1268,8 +1268,9 @@ subroutine jouleheat_tend( lchnk, ncol, state, ptend, pbuf, & ! This is called from sub iondrag_calc. !------------------------------------------------------------------------------- - use physconst, only: pi,cpairv - use phys_grid, only: get_rlon_p, get_rlat_p + use physconst, only: pi + use air_composition, only: cpairv + use phys_grid, only: get_rlon_p, get_rlat_p !------------------------------------------------------------------------------- ! dummy arguments diff --git a/src/physics/waccm/mo_aurora.F90 b/src/physics/waccm/mo_aurora.F90 index ac754294d1..f6e5039570 100644 --- a/src/physics/waccm/mo_aurora.F90 +++ b/src/physics/waccm/mo_aurora.F90 @@ -56,7 +56,7 @@ module mo_aurora use spmd_utils, only: masterproc use aurora_params, only: power=>hpower, plevel, aurora_params_set use aurora_params, only: ctpoten, theta0, dskofa, offa, phid, rrad - use aurora_params, only: amie_period + use aurora_params, only: prescribed_period implicit none @@ -136,8 +136,8 @@ module mo_aurora logical :: aurora_active = .false. integer :: indxAIPRS = -1 integer :: indxQTe = -1 - integer :: indxAMIEefxg = -1 ! am_amie_201712 - integer :: indxAMIEkevg = -1 ! am_amie_201712 + integer :: indxEfx = -1 + integer :: indxKev = -1 real(r8), parameter :: h2deg = 15._r8 ! hour to degree @@ -152,8 +152,9 @@ subroutine aurora_register ! add ionization rates to phys buffer for waccmx ionosphere module - call pbuf_add_field('AurIPRateSum', 'physpkg', dtype_r8, (/pcols,pver/), indxAIPRS) ! Sum of ion auroral production rates for O2 - call pbuf_add_field('QTeAur', 'physpkg', dtype_r8, (/pcols/), indxQTe) ! for electron temperature + ! Sum of ion auroral production rates for O2 + call pbuf_add_field('AurIPRateSum', 'physpkg', dtype_r8, (/pcols,pver/), indxAIPRS) + call pbuf_add_field('QTeAur', 'physpkg', dtype_r8, (/pcols/), indxQTe) ! for electron temperature endsubroutine aurora_register @@ -187,13 +188,17 @@ subroutine aurora_inti(pbuf2d) integer :: ierr real(r8) :: x_nan - indxAMIEefxg = pbuf_get_index('AMIE_efxg', errcode=ierr) - indxAMIEkevg = pbuf_get_index('AMIE_kevg', errcode=ierr) + indxEfx = pbuf_get_index('AUREFX', errcode=ierr) + indxKev = pbuf_get_index('AURKEV', errcode=ierr) - if (indxAMIEefxg>0 .and. indxAMIEkevg>0) then + if (indxEfx>0 .and. indxKev>0) then x_nan = nan - call pbuf_set_field(pbuf2d, indxAMIEefxg, x_nan) - call pbuf_set_field(pbuf2d, indxAMIEkevg, x_nan) + call pbuf_set_field(pbuf2d, indxEfx, x_nan) + call pbuf_set_field(pbuf2d, indxKev, x_nan) + endif + + if (indxAIPRS>0) then + call pbuf_set_field(pbuf2d, indxAIPRS, 0._r8) endif theta0(:) = nan @@ -471,8 +476,8 @@ subroutine aurora_prod( tn, o2, o1, mbar, rlats, & !----------------------------------------------------------------------- ! ... output mag lons, lats !----------------------------------------------------------------------- - call outfld( 'ALONM', r2d*alonm(:ncol,lchnk), pcols, lchnk ) - call outfld( 'ALATM', r2d*alatm(:ncol,lchnk), pcols, lchnk ) + call outfld( 'ALONM', r2d*alonm(:ncol,lchnk), ncol, lchnk ) + call outfld( 'ALATM', r2d*alatm(:ncol,lchnk), ncol, lchnk ) if (indxQTe>0) then call pbuf_get_field(pbuf, indxQTe, qteaur) @@ -794,8 +799,8 @@ subroutine aurora_heat( flux, flux2, alfa, alfa2, & wrk, & ! temp wrk array dtheta ! latitudinal variation (Gaussian) real(r8) :: ekev - real(r8), pointer :: amie_efxg(:) ! Pointer to pbuf AMIE energy flux (mW m-2) - real(r8), pointer :: amie_kevg(:) ! Pointer to pbuf AMIE mean energy (keV) + real(r8), pointer :: pr_efx(:) ! Pointer to pbuf prescribed energy flux (mW m-2) + real(r8), pointer :: pr_kev(:) ! Pointer to pbuf prescribed mean energy (keV) real(r8), pointer :: qteaur(:) ! for electron temperature integer :: n @@ -856,16 +861,16 @@ subroutine aurora_heat( flux, flux2, alfa, alfa2, & !---------------------------------------------------------------------------------------------- ! ... If turned on, use amie energy flux and mean energy to replace flux(:) and alfa(:) !---------------------------------------------------------------------------------------------- - if (amie_period .and. indxAMIEefxg>0 .and. indxAMIEkevg>0) then + if (prescribed_period .and. indxEfx>0 .and. indxKev>0) then !--------------------------------------------------------------------------- - ! Overwrite with AMIE mean energy and energy flux in physics buffer + ! Overwrite with prescribed mean energy and energy flux in physics buffer !--------------------------------------------------------------------------- - call pbuf_get_field(pbuf, indxAMIEefxg, amie_efxg) - call pbuf_get_field(pbuf, indxAMIEkevg, amie_kevg) + call pbuf_get_field(pbuf, indxEfx, pr_efx) + call pbuf_get_field(pbuf, indxKev, pr_kev) do n=1,ncol - ekev = max(amie_kevg(n),1._r8) + ekev = max(pr_kev(n),1._r8) alfa(n) = ekev/2._r8 - flux(n) = max(amie_efxg(n)/(ekev*1.602e-9_r8),1.e-20_r8) + flux(n) = max(pr_efx(n)/(ekev*1.602e-9_r8),1.e-20_r8) enddo endif diff --git a/src/physics/waccm/nlte_aliarms.F90 b/src/physics/waccm/nlte_aliarms.F90 new file mode 100644 index 0000000000..0107479efb --- /dev/null +++ b/src/physics/waccm/nlte_aliarms.F90 @@ -0,0 +1,169 @@ +module nlte_aliarms + +! +! provides calculation of non-LTE heating rates by ALI-ARMS non-LTE code +! + use ppgrid, only: pcols, pver + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use iso_c_binding, only: c_float, c_int + + implicit none + private + save + +! Public interfaces + public :: nlte_aliarms_init + public :: nlte_aliarms_calc + + + integer(c_int) :: pver_c = -1 ! pver for the ALI_ARMS C code (limited by max_pressure_lw) + + real(r8) :: o1_mw_inv = -huge(1.0_r8) ! O molecular weight (inverse) + real(r8) :: o2_mw_inv = -huge(1.0_r8) ! O2 molecular weight (inverse) + real(r8) :: co2_mw_inv = -huge(1.0_r8) ! CO2 molecular weight (inverse) + real(r8) :: n2_mw_inv = -huge(1.0_r8) ! N2 molecular weight (inverse) +contains + +!----------------------------------------------------------------- + subroutine nlte_aliarms_init(max_pressure_lw,co2_mw,n2_mw,o1_mw,o2_mw) +!----------------------------------------------------------------- +! +! +!----------------------------------------------------------------- + + use cam_history, only: addfld + use ref_pres, only: pref_mid + + real(r8), intent(in) :: max_pressure_lw ! Pa + real(r8), intent(in) :: o1_mw ! O molecular weight + real(r8), intent(in) :: o2_mw ! O2 molecular weight + real(r8), intent(in) :: co2_mw ! CO2 molecular weight + real(r8), intent(in) :: n2_mw ! N2 molecular weight + + integer :: iver + + if (masterproc) then + write(iulog,*) 'init: ALI-ARMS non-LTE code' + end if + + call addfld ('ALIARMS_Q',(/ 'lev' /), 'A','K/s','Non-LTE LW CO2 heating rate') + + co2_mw_inv = 1._r8/co2_mw + o1_mw_inv = 1._r8/o1_mw + o2_mw_inv = 1._r8/o2_mw + n2_mw_inv = 1._r8/n2_mw + + pver_c=0 + do iver = 1,pver + if (pref_mid(iver) < max_pressure_lw) then + pver_c=pver_c+1 + else + exit ! Have gone past the maximum pressure + end if + end do + + end subroutine nlte_aliarms_init + +!----------------------------------------------------------------- + subroutine nlte_aliarms_calc (lchnk,ncol,state_zm,pmid,t,xo2mmr,xommr,xn2mmr,xco2mmr,cool) +!----------------------------------------------------------------- +! +! +!----------------------------------------------------------------- + + use air_composition, only: mbarv + use cam_history, only: outfld + use shr_infnan_mod, only: is_nan => shr_infnan_isnan + use shr_kind_mod, only: SHR_KIND_CM + use cam_abortutils, only: endrun + +! Input variables + integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: lchnk ! chunk identifier + + real(r8), intent(in) :: state_zm(pcols,pver) ! model height (m) + real(r8), intent(in) :: pmid(pcols,pver) ! model pressure at mid-point (Pa) + real(r8), intent(in) :: t(pcols,pver) ! Neutral temperature (K) + + real(r8), intent(in) :: xco2mmr(pcols,pver) ! CO2 mass mixing ratio profile + real(r8), intent(in) :: xn2mmr(pcols,pver) ! N2 mass mixing ratio profile + real(r8), intent(in) :: xommr(pcols,pver) ! O mass mixing ratio profile + real(r8), intent(in) :: xo2mmr(pcols,pver) ! O2 mass mixing ratio profile + +! Output variables + real(r8), intent(out) :: cool(pcols,pver) ! CO2 NLTE cooling rate (K/s) + +! local variables + + real(c_float), dimension(pver_c) :: p, tn, zkm + real(c_float), dimension(pver_c) :: co2_vmr, o_vmr, n2_vmr, o2_vmr + real(c_float), dimension(pver_c) :: ali_cool + + integer :: icol, iver, i, j + + character (len=SHR_KIND_CM) :: errstring + + ! Interface to ali C routine + ! Note that ali uses single precision C floats, so conversions from r8 to c_float are made before calling ali + interface + subroutine ali_(zkm, p, tn, co2_vmr, o_vmr, n2_vmr, o2_vmr, ali_cool, pver_c) bind(c,name='ali_') + use iso_c_binding, only: c_float, c_int + real(c_float), dimension(*) :: p, tn, zkm ! (in) input pressure(Pa), temperature(K) and height (km) + real(c_float), dimension(*) :: co2_vmr, o_vmr, n2_vmr, o2_vmr ! (in) volume mixing ratios + real(c_float), dimension(*) :: ali_cool ! (out) cooling rate (K/s) + integer(c_int) :: pver_c + end subroutine ali_ + end interface + + cool(:,:) = 0.0_r8 + + do icol=1,ncol + + ali_cool(:) = 0.0_c_float + zkm(:) = 0.0_c_float + tn(:) = 0.0_c_float + co2_vmr(:) = 0.0_c_float + o_vmr(:) = 0.0_c_float + n2_vmr(:) = 0.0_c_float + o2_vmr(:) = 0.0_c_float + + p(:pver_c) = pmid(icol,:pver_c)*1.0e-5_c_float ! convert pmid in Pa to bars + zkm(:pver_c) = state_zm(icol,:pver_c)*1.e-3_c_float + tn(:pver_c) = t(icol,:pver_c) + + ! Convert to VMR from mmr + co2_vmr(:pver_c) = mbarv(icol,:pver_c ,lchnk) * xco2mmr(icol,:pver_c) * co2_mw_inv + o_vmr(:pver_c) = mbarv(icol,:pver_c ,lchnk) * xommr(icol,:pver_c) * o1_mw_inv + n2_vmr(:pver_c) = mbarv(icol,:pver_c ,lchnk) * xn2mmr(icol,:pver_c) * n2_mw_inv + o2_vmr(:pver_c) = mbarv(icol,:pver_c ,lchnk) * xo2mmr(icol,:pver_c) * o2_mw_inv + + call ali(zkm, p, tn, co2_vmr, o_vmr, n2_vmr, o2_vmr, ali_cool, pver_c) + + cool(icol,:pver_c) = ali_cool(:pver_c) + + enddo + + ! Check the rates + do j=1,pver + do i=1,ncol + if (is_nan(cool(i,j))) then + write(errstring,*) 'nlte_aliarms_calc: Nan in qrlaliarms for chunk=', lchnk, ' column index=',i,' vertical index=',j + call endrun (errstring) + end if + end do + end do + + ! Check cool for any way out-of-bounds values + if (any(cool(:ncol,:pver_c) > 0.2_r8) .or. any(cool(:ncol,:pver_c)<-1.0_r8)) then + write(errstring,*) 'nlte_aliarms_calc: Cooling rate (cool) is greater than .2 or less than -1 K/s for chunk ', lchnk + call endrun (errstring) + end if + + call outfld ('ALIARMS_Q', cool, pcols, lchnk) + + end subroutine nlte_aliarms_calc + + end module nlte_aliarms + diff --git a/src/physics/waccm/nlte_lw.F90 b/src/physics/waccm/nlte_lw.F90 index ff795ce881..ad85edd322 100644 --- a/src/physics/waccm/nlte_lw.F90 +++ b/src/physics/waccm/nlte_lw.F90 @@ -8,7 +8,10 @@ module nlte_lw use ppgrid, only: pcols, pver use pmgrid, only: plev use rad_constituents, only: rad_cnst_get_gas, rad_cnst_get_info + use nlte_fomichev, only: nlte_fomichev_init, nlte_fomichev_calc, nocooling, o3pcooling + use nlte_aliarms, only: nlte_aliarms_init, nlte_aliarms_calc + use waccm_forcing, only: waccm_forcing_init, waccm_forcing_adv, get_cnst use cam_logfile, only: iulog @@ -18,6 +21,7 @@ module nlte_lw ! Public interfaces public & + nlte_register, & nlte_init, & nlte_timestep_init, & nlte_tend @@ -29,29 +33,42 @@ module nlte_lw ! = .true. uses MOZART constituents ! = .false. uses constituents from bnd dataset cftgcm + logical :: nlte_use_aliarms = .false. + integer :: nlte_aliarms_every_X = 0 + logical :: use_data_o3 logical :: use_waccm_forcing = .false. - real(r8) :: o3_mw ! O3 molecular weight + real(r8) :: o3_mw = -huge(1.0_r8) ! O3 molecular weight ! indexes of required constituents in model constituent array - integer :: ico2 ! CO2 index - integer :: io1 ! O index - integer :: io2 ! O2 index - integer :: io3 ! O3 index - integer :: ih ! H index - integer :: ino ! NO index + integer :: ico2 = -1 ! CO2 index + integer :: io1 = -1 ! O index + integer :: io2 = -1 ! O2 index + integer :: io3 = -1 ! O3 index + integer :: ih = -1 ! H index + integer :: ino = -1 ! NO index + integer :: qrlaliarms_idx = -1 ! merge limits for data ozone - integer :: nbot_mlt ! bottom of pure tgcm range - integer :: ntop_cam ! bottom of merge range - real(r8):: wt_o3_mrg(pver) ! merge weights for cam o3 + integer :: nbot_mlt = huge(1) ! bottom of pure tgcm range + integer :: ntop_cam = huge(1) ! bottom of merge range + real(r8):: wt_o3_mrg(pver) = -huge(1.0_r8) ! merge weights for cam o3 !================================================================================================ contains !================================================================================================ - subroutine nlte_init (pref_mid, nlte_use_mo_in, nlte_limit_co2) + subroutine nlte_register() + use physics_buffer, only: pbuf_add_field, dtype_r8 + + call pbuf_add_field('qrlaliarms', 'global', dtype_r8, (/pcols,pver/),qrlaliarms_idx) + + end subroutine nlte_register + +!================================================================================================ + + subroutine nlte_init (pref_mid, max_pressure_lw, nlte_use_mo_in, nlte_limit_co2, nlte_use_aliarms_in, nlte_aliarms_every_X_in) ! ! Initialize the nlte parameterizations and tgcm forcing data, if required !------------------------------------------------------------------------ @@ -62,15 +79,18 @@ subroutine nlte_init (pref_mid, nlte_use_mo_in, nlte_limit_co2) use phys_control, only: phys_getopts real(r8), intent(in) :: pref_mid(plev) + real(r8), intent(in) :: max_pressure_lw logical, intent(in) :: nlte_use_mo_in logical, intent(in) :: nlte_limit_co2 + logical, intent(in) :: nlte_use_aliarms_in + integer, intent(in) :: nlte_aliarms_every_X_in - real(r8) :: o1_mw ! O molecular weight - real(r8) :: o2_mw ! O2 molecular weight - real(r8) :: co2_mw ! CO2 molecular weight - real(r8) :: n2_mw ! N2 molecular weight - real(r8) :: no_mw ! NO molecular weight + real(r8) :: o1_mw = -huge(1.0_r8) ! O molecular weight + real(r8) :: o2_mw = -huge(1.0_r8) ! O2 molecular weight + real(r8) :: co2_mw = -huge(1.0_r8) ! CO2 molecular weight + real(r8) :: n2_mw = -huge(1.0_r8) ! N2 molecular weight + real(r8) :: no_mw = -huge(1.0_r8) ! NO molecular weight real(r8) :: psh(pver) ! pressure scale height real(r8) :: pshmn ! lower range of merge real(r8) :: pshmx ! upper range of merge @@ -82,8 +102,10 @@ subroutine nlte_init (pref_mid, nlte_use_mo_in, nlte_limit_co2) call phys_getopts(history_waccm_out=history_waccm) -! Set flag to use mozart (or tgcm) consituents - nlte_use_mo = nlte_use_mo_in +! Set flag to use mozart (or tgcm) consituents and flag to use ALI-ARMS scheme + nlte_use_mo = nlte_use_mo_in + nlte_use_aliarms = nlte_use_aliarms_in + nlte_aliarms_every_X = nlte_aliarms_every_X_in ! ask rad_constituents module whether the O3 used in the climate ! calculation is from data @@ -108,7 +130,7 @@ subroutine nlte_init (pref_mid, nlte_use_mo_in, nlte_limit_co2) if (psh(k) >= pshmx) nbot_mlt = k if (psh(k) >= pshmn) ntop_cam = k+1 end do - + wt_o3_mrg(:) = 0._r8 do k = nbot_mlt+1, ntop_cam-1 wt_o3_mrg(k) = 1._r8 - tanh( (psh(k)-pshmn)/pshdd ) @@ -153,6 +175,11 @@ subroutine nlte_init (pref_mid, nlte_use_mo_in, nlte_limit_co2) ! Initialize Fomichev parameterization call nlte_fomichev_init (co2_mw, n2_mw, o1_mw, o2_mw, o3_mw, no_mw, nlte_limit_co2) +! Initialize ALI-ARMS parameterization + if (nlte_use_aliarms) then + call nlte_aliarms_init (max_pressure_lw,co2_mw,n2_mw,o1_mw,o2_mw) + end if + ! Initialize waccm forcing data if (use_waccm_forcing) then call waccm_forcing_init () @@ -162,12 +189,11 @@ subroutine nlte_init (pref_mid, nlte_use_mo_in, nlte_limit_co2) if (nlte_use_mo) then write(iulog,*) 'NLTE constituents are obtained from the MOZART chemistry module' - else + else write(iulog,*) 'NLTE constituents are obtained from boundary dataset' endif end if -! add to masterfield list call addfld ('QRLNLTE',(/ 'lev' /), 'A','K/s','Non-LTE LW heating (includes QNO and QO3P)') call addfld ('QNO', (/ 'lev' /), 'A','K/s','NO cooling') call addfld ('QCO2', (/ 'lev' /), 'A','K/s','CO2 cooling') @@ -190,22 +216,21 @@ end subroutine nlte_init !======================================================================= subroutine nlte_timestep_init(state, pbuf2d) - use physics_types,only : physics_state - use ppgrid, only : begchunk, endchunk - use physics_buffer, only : physics_buffer_desc + use physics_types, only: physics_state + use ppgrid, only: begchunk, endchunk + use physics_buffer, only: physics_buffer_desc ! ! Time interpolation of waccm forcing fields to the current time ! !------------------------------------------------------------------------ - type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_state), intent(in):: state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) - !---------------------------Local workspace-------------------------------------- - + if (use_waccm_forcing) then call waccm_forcing_adv (state, pbuf2d) endif @@ -213,20 +238,25 @@ subroutine nlte_timestep_init(state, pbuf2d) return end subroutine nlte_timestep_init +!================================================================================================ !================================================================================================ - subroutine nlte_tend(state, pbuf, qrlf) + subroutine nlte_tend(state, pbuf, qrlf) ! ! Driver for nlte calculations !------------------------------------------------------------------------- - use physconst, only: mwdry, cpairv + use physconst, only: mwdry + use air_composition, only: cpairv use physics_types, only: physics_state use physics_buffer, only : physics_buffer_desc + use perf_mod, only: t_startf, t_stopf use cam_history, only: outfld + use physics_buffer,only: pbuf_get_field + use time_manager, only: get_nstep ! Arguments type(physics_state), target, intent(in) :: state ! Physics state variables - + type(physics_buffer_desc), pointer :: pbuf(:) real(r8), intent(out) :: qrlf(pcols,pver) ! nlte longwave heating rate @@ -235,24 +265,29 @@ subroutine nlte_tend(state, pbuf, qrlf) integer :: lchnk ! chunk identifier integer :: ncol ! no. of columns in chunk - real(r8) :: nocool (pcols,pver) ! NO cooling - real(r8) :: o3pcool (pcols,pver) ! O3P cooling + real(r8) :: nocool (pcols,pver) ! NO cooling (K/s) + real(r8) :: o3pcool (pcols,pver) ! O3P cooling (K/s) real(r8) :: qout (pcols,pver) ! temp for outfld - real(r8) :: co2cool(pcols,pver), o3cool(pcols,pver), c2scool(pcols,pver) + real(r8) :: co2cool(pcols,pver), o3cool(pcols,pver), c2scool(pcols,pver) ! (K/s) - real(r8), pointer, dimension(:,:) :: xco2mmr ! CO2 mmr - real(r8), pointer, dimension(:,:) :: xommr ! O mmr - real(r8), pointer, dimension(:,:) :: xo2mmr ! O2 mmr - real(r8), pointer, dimension(:,:) :: xo3mmr ! O3 mmr - real(r8), pointer, dimension(:,:) :: xhmmr ! H mmr + real(r8), pointer :: qrlaliarms(:,:) ! ALI-ARMS NLTE CO2 cooling rate (K/s) + + real(r8) :: qrlfomichev(pcols,pver) ! Fomichev cooling rate ! (K/s) + + real(r8), pointer, dimension(:,:) :: xco2mmr ! CO2 mmr + real(r8), pointer, dimension(:,:) :: xommr ! O mmr + real(r8), pointer, dimension(:,:) :: xo2mmr ! O2 mmr + real(r8), pointer, dimension(:,:) :: xo3mmr ! O3 mmr + real(r8), pointer, dimension(:,:) :: xhmmr ! H mmr real(r8), pointer, dimension(:,:) :: xnommr ! NO mmr - real(r8), pointer, dimension(:,:) :: xn2mmr ! N2 mmr + real(r8), pointer, dimension(:,:) :: xn2mmr ! N2 mmr - real(r8), target :: n2mmr (pcols,pver) ! N2 mmr + real(r8), target :: n2mmr (pcols,pver) ! N2 mmr real(r8), target :: o3mrg(pcols,pver) ! merged O3 real(r8), pointer, dimension(:,:) :: to3mmr ! O3 mmr (tgcm) integer :: k + integer :: nstep !------------------------------------------------------------------------ @@ -272,31 +307,59 @@ subroutine nlte_tend(state, pbuf, qrlf) if (nlte_use_mo) then ! Get relevant constituents from the chemistry module - xco2mmr => state%q(:,:,ico2) - xommr => state%q(:,:,io1) - xo2mmr => state%q(:,:,io2) - xhmmr => state%q(:,:,ih) - xnommr => state%q(:,:,ino) + xco2mmr => state%q(:,:,ico2) + xommr => state%q(:,:,io1) + xo2mmr => state%q(:,:,io2) + xhmmr => state%q(:,:,ih) + xnommr => state%q(:,:,ino) else call get_cnst (lchnk, co2=xco2mmr, o1=xommr, o2=xo2mmr, no=xnommr, h=xhmmr) endif - + do k = 1,pver n2mmr (:ncol,k) = 1._r8 - (xommr(:ncol,k) + xo2mmr(:ncol,k) + xhmmr(:ncol,k)) enddo xn2mmr => n2mmr(:,:) -! do non-LTE parameterization +! do non-LTE cooling rate calculations + + call t_startf('nlte_fomichev_calc') call nlte_fomichev_calc (lchnk,ncol,state%pmid,state%pint,state%t, & - xo2mmr,xommr,xo3mmr,xn2mmr,xco2mmr,qrlf,co2cool,o3cool,c2scool) + xo2mmr,xommr,xo3mmr,xn2mmr,xco2mmr,qrlfomichev,co2cool,o3cool,c2scool) + call t_stopf('nlte_fomichev_calc') + + + ! Call the optional ALI-ARMS. Note that this does not replace the fomichev + ! call as the other individual cooling rates from fomichev still need to be calculated + + if (nlte_use_aliarms) then + + call t_startf('nlte_aliarms_calc') + + call pbuf_get_field(pbuf, qrlaliarms_idx, qrlaliarms ) + ! Only run ALI-ARMS every nlte_aliarms_every_X timesteps + nstep = get_nstep() + if (MOD(nstep, nlte_aliarms_every_X) == 0) then + call nlte_aliarms_calc (lchnk,ncol,state%zm, state%pmid,state%t,xo2mmr,xommr,xn2mmr,xco2mmr,qrlaliarms) + end if + + ! Apply the ALI-ARMS heating rate to the qrlf summation + qrlf(:ncol,:) = o3cool(:ncol,:) + qrlaliarms(:ncol,:) * cpairv(:ncol,:,lchnk) + + call t_stopf('nlte_aliarms_calc') + + else + qrlf(:ncol,:) = qrlfomichev(:ncol,:) + end if + -! do NO cooling +! do NO cooling call nocooling (ncol, state%t, state%pmid, xnommr,xommr,xo2mmr,xo3mmr,xn2mmr,nocool) -! do O3P cooling +! do O3P cooling call o3pcooling (ncol, state%t, xommr, o3pcool) do k = 1,pver diff --git a/src/physics/waccm/radheat.F90 b/src/physics/waccm/radheat.F90 index 5aa4ddfc83..092b40b260 100644 --- a/src/physics/waccm/radheat.F90 +++ b/src/physics/waccm/radheat.F90 @@ -7,7 +7,7 @@ module radheat ! ! This module provides a hook to allow incorporating additional ! radiative terms (eUV heating and nonLTE longwave cooling). -! +! ! Original version: B.A. Boville ! Change weighting function for RRTMG: A J Conley !----------------------------------------------------------------------- @@ -16,13 +16,14 @@ module radheat ! Cubic polynomial is chosen so that derivative is zero at minimum and maximum pressures ! and is monotonically increasing from zero at minimum pressure to one at maximum pressure - use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: masterproc - use ppgrid, only: pcols, pver - use physics_types, only: physics_state, physics_ptend, physics_ptend_init - use physconst, only: gravit, cpairv + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc + use ppgrid, only: pcols, pver + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use physconst, only: gravit + use air_composition, only: cpairv use perf_mod - use cam_logfile, only: iulog + use cam_logfile, only: iulog implicit none private @@ -31,6 +32,7 @@ module radheat ! Public interfaces public & radheat_readnl, &! + radheat_register, &! radheat_init, &! radheat_timestep_init, &! radheat_tend ! return net radiative heating @@ -41,8 +43,10 @@ module radheat logical :: nlte_use_mo = .true. ! Determines which constituents are used from NLTE calculations ! = .true. uses prognostic constituents ! = .false. uses constituents from prescribed dataset waccm_forcing_file - logical :: nlte_limit_co2 = .false. ! if true apply upper limit to co2 in the Formichev scheme - + logical :: nlte_limit_co2 = .false. ! if true apply upper limit to co2 in the Fomichev scheme + logical :: nlte_use_aliarms = .false. ! If true, use ALI-ARMS for the cooling rate calculation + integer :: nlte_aliarms_every_X = 1 ! Call aliarms every X times radiation is called + ! Private variables for merging heating rates real(r8):: qrs_wt(pver) ! merge weight for cam solar heating real(r8):: qrl_wt(pver) ! merge weight for cam long wave heating @@ -52,19 +56,15 @@ module radheat ! sw merge region ! highest altitude (lowest pressure) of merge region (Pa) - real(r8) :: min_pressure_sw= 5._r8 + real(r8) :: min_pressure_sw= 5._r8 ! lowest altitude (lowest pressure) of merge region (Pa) - real(r8) :: max_pressure_sw=50._r8 - real(r8) :: delta_merge_sw ! range of merge region - real(r8) :: midpoint_sw ! midpoint of merge region + real(r8) :: max_pressure_sw=50._r8 ! lw merge region ! highest altitude (lowest pressure) of merge region (Pa) - real(r8) :: min_pressure_lw= 5._r8 + real(r8) :: min_pressure_lw= 5._r8 ! lowest altitude (highest pressure) of merge region (Pa) - real(r8) :: max_pressure_lw=50._r8 - real(r8) :: delta_merge_lw ! range of merge region - real(r8) :: midpoint_lw ! midpoint of merge region + real(r8) :: max_pressure_lw=50._r8 integer :: ntop_qrs_cam ! top level for pure cam solar heating @@ -77,7 +77,7 @@ subroutine radheat_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit use cam_abortutils, only: endrun - use spmd_utils, only : mpicom, masterprocid, mpi_logical + use spmd_utils, only : mpicom, masterprocid, mpi_logical, mpi_integer use waccm_forcing, only: waccm_forcing_readnl @@ -87,7 +87,7 @@ subroutine radheat_readnl(nlfile) integer :: unitn, ierr character(len=*), parameter :: subname = 'radheat_readnl' - namelist /radheat_nl/ nlte_use_mo, nlte_limit_co2 + namelist /radheat_nl/ nlte_use_mo, nlte_limit_co2, nlte_use_aliarms,nlte_aliarms_every_X if (masterproc) then unitn = getunit() @@ -104,14 +104,33 @@ subroutine radheat_readnl(nlfile) end if - call mpi_bcast (nlte_use_mo, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast (nlte_limit_co2, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast (nlte_use_mo, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("radheat_readnl: FATAL: mpi_bcast: nlte_use_mo") + call mpi_bcast (nlte_limit_co2, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("radheat_readnl: FATAL: mpi_bcast: nlte_limit_co2") + call mpi_bcast (nlte_use_aliarms, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("radheat_readnl: FATAL: mpi_bcast: nlte_use_aliarms") + call mpi_bcast (nlte_aliarms_every_X, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun("radheat_readnl: FATAL: mpi_bcast: nlte_aliarms_every_X") ! Have waccm_forcing read its namelist as well. call waccm_forcing_readnl(nlfile) end subroutine radheat_readnl +!================================================================================================ + + subroutine radheat_register + + use nlte_lw, only : nlte_register + + ! only ALI-ARMS has pbuf fields to register + if (nlte_use_aliarms) then + call nlte_register() + end if + + end subroutine radheat_register + !================================================================================================ subroutine radheat_init(pref_mid) @@ -119,6 +138,7 @@ subroutine radheat_init(pref_mid) use nlte_lw, only: nlte_init use cam_history, only: add_default, addfld use phys_control, only: phys_getopts + use physics_buffer, only : physics_buffer_desc ! args @@ -126,6 +146,10 @@ subroutine radheat_init(pref_mid) ! local vars + real(r8) :: delta_merge_sw ! range of merge region + real(r8) :: midpoint_sw ! midpoint of merge region + real(r8) :: delta_merge_lw ! range of merge region + real(r8) :: midpoint_lw ! midpoint of merge region real(r8) :: psh(pver) ! pressure scale height integer :: k logical :: camrt @@ -150,10 +174,10 @@ subroutine radheat_init(pref_mid) min_pressure_lw = 1e5_r8*exp(-10._r8) max_pressure_lw = 1e5_r8*exp(-8.57_r8) else - min_pressure_sw = 5._r8 - max_pressure_sw = 50._r8 - min_pressure_lw = 5._r8 - max_pressure_lw = 50._r8 + min_pressure_sw = 5._r8 + max_pressure_sw = 50._r8 + min_pressure_lw = 5._r8 + max_pressure_lw = 50._r8 endif delta_merge_sw = max_pressure_sw - min_pressure_sw @@ -167,7 +191,7 @@ subroutine radheat_init(pref_mid) ! pressure scale heights for camrt merging (waccm4) psh(k)=log(1e5_r8/pref_mid(k)) - if ( pref_mid(k) .le. min_pressure_sw ) then + if ( pref_mid(k) .le. min_pressure_sw ) then qrs_wt(k) = 0._r8 else if( pref_mid(k) .ge. max_pressure_sw) then qrs_wt(k) = 1._r8 @@ -182,13 +206,13 @@ subroutine radheat_init(pref_mid) endif endif - if ( pref_mid(k) .le. min_pressure_lw ) then + if ( pref_mid(k) .le. min_pressure_lw ) then qrl_wt(k)= 0._r8 else if( pref_mid(k) .ge. max_pressure_lw) then qrl_wt(k)= 1._r8 else if (camrt) then - ! camrt + ! camrt qrl_wt(k) = 1._r8 - tanh( (psh(k) - 8.57_r8) / 0.71_r8 ) else ! rrtmg @@ -198,7 +222,7 @@ subroutine radheat_init(pref_mid) endif end do - + ! determine upppermost level that is purely solar heating (no MLT chem heationg) ntop_qrs_cam = 0 do k=pver,1,-1 @@ -219,7 +243,7 @@ subroutine radheat_init(pref_mid) end if if (waccm_heating) then - call nlte_init(pref_mid, nlte_use_mo, nlte_limit_co2) + call nlte_init(pref_mid, max_pressure_lw, nlte_use_mo, nlte_limit_co2, nlte_use_aliarms,nlte_aliarms_every_X) endif ! Add history variables to master field list @@ -253,7 +277,7 @@ subroutine radheat_timestep_init (state, pbuf2d) use ppgrid, only : begchunk, endchunk use physics_buffer, only : physics_buffer_desc - type(physics_state), intent(in):: state(begchunk:endchunk) + type(physics_state), intent(in):: state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -271,21 +295,21 @@ subroutine radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, & ! Compute net radiative heating from qrs and qrl, and the associated net ! boundary flux. ! -! This routine provides the waccm hook for computing nonLTE cooling and -! eUV heating. +! This routine provides the waccm hook for computing nonLTE cooling and +! eUV heating. !----------------------------------------------------------------------- use cam_history, only: outfld use nlte_lw, only: nlte_tend use mo_waccm_hrates, only: waccm_hrates, has_hrates use waccm_forcing, only: get_solar - + use physics_buffer, only : physics_buffer_desc use tidal_diag, only: get_tidal_coeffs ! Arguments type(physics_state), intent(in) :: state ! Physics state variables - + type(physics_buffer_desc), pointer :: pbuf(:) type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencie real(r8), intent(in) :: qrl(pcols,pver) ! longwave heating @@ -295,7 +319,7 @@ subroutine radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, & real(r8), intent(in) :: flns(pcols) ! Srf longwave cooling (up-down) flux real(r8), intent(in) :: flnt(pcols) ! Net outgoing lw flux at model top real(r8), intent(in) :: asdir(pcols) ! shortwave, direct albedo - real(r8), intent(out) :: net_flx(pcols) + real(r8), intent(out) :: net_flx(pcols) ! Local variables integer :: i, k @@ -391,7 +415,7 @@ subroutine merge_qrs (ncol, hcam, hmlt, hmrg, cpair) integer k do k = 1, pver - hmrg(:ncol,k) = qrs_wt(k)*hcam(:ncol,k) + (1._r8 - qrs_wt(k))*cpair(:ncol,k)*hmlt(:ncol,k) + hmrg(:ncol,k) = qrs_wt(k)*hcam(:ncol,k) + (1._r8 - qrs_wt(k))*cpair(:ncol,k)*hmlt(:ncol,k) end do end subroutine merge_qrs @@ -416,7 +440,7 @@ subroutine merge_qrl (ncol, hcam, hmlt, hmrg) !-------------------------------------------------------------------- do k = 1, pver - hmrg(:ncol,k) = qrl_wt(k) * hcam(:ncol,k) + (1._r8-qrl_wt(k)) * hmlt(:ncol,k) + hmrg(:ncol,k) = qrl_wt(k) * hcam(:ncol,k) + (1._r8-qrl_wt(k)) * hmlt(:ncol,k) end do end subroutine merge_qrl diff --git a/src/physics/waccmx/ion_electron_temp.F90 b/src/physics/waccmx/ion_electron_temp.F90 index 372c02cff6..3e5718eaa4 100644 --- a/src/physics/waccmx/ion_electron_temp.F90 +++ b/src/physics/waccmx/ion_electron_temp.F90 @@ -10,12 +10,13 @@ module ion_electron_temp !--------------------------------------------------------------------------------- use shr_kind_mod, only : r8 => shr_kind_r8 ! Real kind to declare variables use ppgrid, only : pcols, pver, pverp ! Dimensions and chunk bounds + use ppgrid, only : begchunk, endchunk use cam_history, only : outfld, hist_fld_active, write_inithist ! Routine to output fields to history files use cam_history, only : horiz_only, addfld, add_default ! Routines and variables for adding fields to history output use physics_types, only : physics_state, & ! Structures containing physics state variables physics_ptend, & ! Structures containing physics tendency variables physics_ptend_init ! Routine to initialize physics tendency variables - use physics_buffer, only : pbuf_add_field, & ! + use physics_buffer, only : pbuf_add_field, pbuf_get_chunk, & pbuf_get_index,dtype_r8, & ! physics_buffer_desc, & ! pbuf_get_field, & ! Needed to access physics buffer @@ -33,17 +34,19 @@ module ion_electron_temp use spmd_utils, only : masterproc use cam_logfile, only : iulog ! Output unit use ionos_state_mod, only : ionos_state + use air_composition,only : cpairv implicit none save - + private ! Make default type private to the module !------------------------ - ! PUBLIC: interfaces + ! PUBLIC: interfaces !------------------------ public :: ion_electron_temp_init ! Initialization + public :: ion_electron_temp_timestep_init public :: ion_electron_temp_register ! Registration of ionosphere variables in pbuf physics buffer public :: ion_electron_temp_inidat ! Get fields from initial condition file into physics buffer public :: ion_electron_temp_tend ! Calculate tendencies for extended model ionosphere @@ -51,7 +54,7 @@ module ion_electron_temp !------------------------------------------------------------------------ ! PRIVATE: Rest of the data and interfaces are private to this module - !------------------------------------------------------------------------ + !------------------------------------------------------------------------ real(r8), parameter :: kboltz_ev = 8.617E-5_r8 ! Boltzmann constant (eV/K) real(r8), parameter :: temax = 7.0E3_r8 ! maximum electron temperature (K) real(r8), parameter :: dayOPFlux = 2.0E8_r8 ! Daytime O+ flux at upper boundary ( @@ -59,11 +62,11 @@ module ion_electron_temp real(r8), parameter :: rads2Degs = 180._r8/pi ! radians to degrees - ! private data real(r8) :: rMassOp ! O+ molecular weight kg/kmol logical :: steady_state_ion_elec_temp = .true. + logical :: initialized_TiTe = .false. integer :: index_te=-1, index_ti=-1 ! Indices to find ion and electron temperature in pbuf @@ -75,7 +78,7 @@ subroutine ion_electron_temp_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit - use spmd_utils, only: mpicom, masterprocid, mpicom, mpi_logical + use spmd_utils, only: mpicom, masterprocid, mpicom, mpi_logical character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -112,12 +115,12 @@ end subroutine ion_electron_temp_readnl !============================================================================== subroutine ion_electron_temp_init(pbuf2d) - + !----------------------------------------------------------------------- ! Time independent initialization for ionosphere simulation. !----------------------------------------------------------------------- - use phys_control, only : phys_getopts !Method used to get flag for waccmx ionosphere output variables + use phys_control, only: phys_getopts !Method used to get flag for waccmx ionosphere output variables type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -127,22 +130,22 @@ subroutine ion_electron_temp_init(pbuf2d) if (steady_state_ion_elec_temp) then call steady_state_tei_init(pbuf2d) end if - + call phys_getopts(history_waccmx_out=history_waccmx) !------------------------------------------------------------------------------- - ! Add history variables for ionosphere + ! Add history variables for ionosphere !------------------------------------------------------------------------------- - call addfld ('QIonElec' ,(/ 'lev' /), 'I', 'K/s', 'Electron Ion Thermal Heating Rate') + call addfld ('QIonElec' ,(/ 'lev' /), 'I', 'K sec-1', 'Electron Ion Thermal Heating Rate') call addfld ('TElec&IC' ,(/ 'lev' /), 'I', 'K', 'Electron Temperature') call addfld ('TIon&IC' ,(/ 'lev' /), 'I', 'K', 'Ion Temperature') call addfld ('TElec' ,(/ 'lev' /), 'I', 'K', 'Electron Temperature') call addfld ('TIon' ,(/ 'lev' /), 'I', 'K', 'Ion Temperature') call addfld ('ElecColDens' ,horiz_only , 'I', 'TECU', 'Electron Column Density') if (.not.steady_state_ion_elec_temp) then - call addfld ('QIN' ,(/ 'lev' /), 'I', 'J/kg/s', 'Ion-neutral Heating') - call addfld ('QEN' ,(/ 'lev' /), 'I', ' ', 'Electron-neutral Heating') - call addfld ('QEI' ,(/ 'lev' /), 'I', ' ', 'Electron-ion Heating') + call addfld ('QIN' ,(/ 'lev' /), 'I', 'K sec-1','Ion-neutral Heating Rate') + call addfld ('QEN' ,(/ 'lev' /), 'I', 'K sec-1','Electron-neutral Heating Rate') + call addfld ('QEI' ,(/ 'lev' /), 'I', 'K sec-1','Electron-ion Heating Rate') call addfld ('LOSS_g3' ,(/ 'lev' /), 'I', ' ', 'Loss Term g3') call addfld ('LOSS_EI' ,(/ 'lev' /), 'I', ' ', 'Loss Term EI') call addfld ('LOSS_IN' ,(/ 'lev' /), 'I', ' ', 'Loss Term IN') @@ -181,14 +184,36 @@ subroutine ion_electron_temp_init(pbuf2d) if (sIndxOp > 0) then rMassOp = adv_mass(sIndxOp) else - call endrun('update_teti: Cannot find short-lived index for Op in update_teti') + call endrun('update_teti: Cannot find short-lived index for Op in update_teti') endif endif endif end subroutine ion_electron_temp_init -!============================================================================== +!============================================================================== + subroutine ion_electron_temp_timestep_init(phys_state,pbuf2d) + use time_manager, only: is_first_step + + type(physics_state), intent(in) :: phys_state(begchunk:endchunk) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + integer :: ncol + integer :: lchnk + type(physics_buffer_desc), pointer :: phys_buffer_chunk(:) + + if (is_first_step() .and. .not.initialized_TiTe .and. index_te>0 .and. index_ti>0) then + do lchnk=begchunk,endchunk + ncol=phys_state(lchnk)%ncol + phys_buffer_chunk => pbuf_get_chunk(pbuf2d,lchnk) + call pbuf_set_field(phys_buffer_chunk,index_te,phys_state(lchnk)%t(:ncol,:),start=(/1,1/), kount=(/ncol,pver/)) + call pbuf_set_field(phys_buffer_chunk,index_ti,phys_state(lchnk)%t(:ncol,:),start=(/1,1/), kount=(/ncol,pver/)) + end do + initialized_TiTe=.true. + endif + end subroutine ion_electron_temp_timestep_init + +!============================================================================== subroutine ion_electron_temp_register @@ -197,16 +222,16 @@ subroutine ion_electron_temp_register ! ! Ion production rates pcols,pver,nIonRates, ! so firstdim = 1 middledim = pver lastdim = nIonRates. - ! + ! ! pcols dimension and lchnk assumed here ! !----------------------------------------------------------------------- - + !------------------------------------------------------------------------------ - ! Electron temperature in physics buffer (global so can write to history files) + ! Electron temperature in physics buffer (global so can write to history files) !------------------------------------------------------------------------------ call pbuf_add_field('TElec','global',dtype_r8,(/pcols,pver/), index_te) - + !-------------------------------------------------------------------------- ! Ion temperature in physics buffer (global so can write to history files) !-------------------------------------------------------------------------- @@ -222,13 +247,13 @@ subroutine ion_electron_temp_inidat(ncid_ini, pbuf2d) ! Grab fields from initial condition file and put in physics buffer !----------------------------------------------------------------------- - use pio, only : file_desc_t - use cam_grid_support, only : cam_grid_check, cam_grid_id - use cam_grid_support, only : cam_grid_get_dim_names - use cam_abortutils, only : endrun - use physics_buffer, only : pbuf_set_field - use ncdio_atm, only : infld - use ppgrid, only : pcols, pver, begchunk, endchunk + use pio, only: file_desc_t + use cam_grid_support, only: cam_grid_check, cam_grid_id + use cam_grid_support, only: cam_grid_get_dim_names + use cam_abortutils, only: endrun + use ncdio_atm, only: infld + use ppgrid, only: pcols, pver, begchunk, endchunk + use infnan, only: nan, assignment(=) type(file_desc_t), intent(inout) :: ncid_ini ! Initial condition file id type(physics_buffer_desc), pointer :: pbuf2d(:,:) ! Physics buffer @@ -240,7 +265,9 @@ subroutine ion_electron_temp_inidat(ncid_ini, pbuf2d) real(r8),pointer :: tI(:,:,:) ! Ion temperature pointer integer :: ierr character(len=*), parameter :: subname='ION_ELECTRON_TEMP_INIDAT' - + real(r8) :: nanval + + nanval=nan found = .false. grid_id = cam_grid_id('physgrid') @@ -251,7 +278,7 @@ subroutine ion_electron_temp_inidat(ncid_ini, pbuf2d) if (index_te>0) then !--------------------------------------------------------------------------------- - ! Electron temperature in to physics buffer. If not found use neutral temperature + ! Electron temperature !--------------------------------------------------------------------------------- allocate(tE(pcols,pver,begchunk:endchunk)) call infld( 'TElec',ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & @@ -259,35 +286,48 @@ subroutine ion_electron_temp_inidat(ncid_ini, pbuf2d) if (.not.found) then if (masterproc) write(iulog,*) 'ion_electron_temp_inidat: Could not find electron temperature in ic file. ' & - // 'Using neutral temperature' + // 'Try to read neutral temperature.' call infld( 'T',ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & tE, found, gridname='physgrid') endif + if (found) then + call pbuf_set_field(pbuf2d, index_te, tE) + else + call pbuf_set_field(pbuf2d, index_te, nanval) + endif - call pbuf_set_field(pbuf2d, index_te, tE) - + initialized_TiTe = found deallocate(tE) endif if (index_ti>0) then !---------------------------------------------------------------------------- - ! Ion temperature in to physics buffer. If not found use neutral temperature + ! Ion temperature !---------------------------------------------------------------------------- allocate(tI(pcols,pver,begchunk:endchunk)) - call infld( 'TIon',ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & - tI, found, gridname='physgrid') - - if (.not.found) then - if (masterproc) write(iulog,*) 'ion_electron_temp_inidat: Could not find ion temperature in ic file. ' & - // 'Using neutral temperature' - call infld( 'T',ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + if (initialized_TiTe) then ! try to initialize ion temp only if electron temp was initialized above + call infld( 'TIon',ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & tI, found, gridname='physgrid') + if (.not.found) then + if (masterproc) write(iulog,*) 'ion_electron_temp_inidat: Could not find ion temperature in ic file. ' & + // 'Try to read neutral temperature.' + call infld( 'T',ncid_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, & + tI, found, gridname='physgrid') + endif + endif + if (found) then + call pbuf_set_field(pbuf2d, index_ti, tI) + else + call pbuf_set_field(pbuf2d, index_ti, nanval) endif - call pbuf_set_field(pbuf2d, index_ti, tI) - + initialized_TiTe = initialized_TiTe .and. found deallocate(tI) endif + if (index_te>0 .and. index_ti>0 .and. .not.initialized_TiTe) then + write(iulog,*) 'ion_electron_temp_inidat: Not able to read temperatures from IC file.' & + //' Will set ion and electron temperatures to neutral temperature (state%t) on initial timestep.' + endif end subroutine ion_electron_temp_inidat @@ -295,15 +335,14 @@ end subroutine ion_electron_temp_inidat subroutine ion_electron_temp_tend(state, ptend, pbuf, ztodt) - use physconst, only : cpairv !------------------------------------------------------------------------------------- - ! Calculate dry static energy and O+ tendency for extended ionosphere simulation + ! Calculate dry static energy and O+ tendency for extended ionosphere simulation !------------------------------------------------------------------------------------- !------------------------------Arguments-------------------------------- - use physics_types, only : physics_ptend_sum - + use physics_types, only: physics_ptend_sum + type(physics_state), intent(in) :: state ! physics state structure type(physics_ptend), intent(inout) :: ptend ! parameterization tendency structure type(physics_buffer_desc),pointer :: pbuf(:) ! physics buffer @@ -315,15 +354,15 @@ subroutine ion_electron_temp_tend(state, ptend, pbuf, ztodt) type(physics_ptend) :: ptend_loc ! Local parameterization tendencies type(ionos_state) :: istate ! ionosphere state structure - integer :: lchnk ! Chunk number - integer :: ncol ! Number of columns in chunk - + integer :: lchnk ! Chunk number + integer :: ncol ! Number of columns in chunk + integer :: teTiBot ! bottom of ionosphere calculations - real(r8), dimension(:,:), pointer :: tE ! Pointer to electron temperature in pbuf (K) - real(r8), dimension(:,:), pointer :: tI ! Pointer to ion temperature in pbuf (K) - - logical :: ls + real(r8), dimension(:,:), pointer :: tE ! Pointer to electron temperature in pbuf (K) + real(r8), dimension(:,:), pointer :: tI ! Pointer to ion temperature in pbuf (K) + + logical :: ls real(r8) :: dse_tend(pcols,pver) ! dry static energy tendency real(r8) :: qionelec(pcols,pver) ! diagnostic heating rate (neutrals) @@ -335,11 +374,11 @@ subroutine ion_electron_temp_tend(state, ptend, pbuf, ztodt) lchnk = state%lchnk ncol = state%ncol - ls = .TRUE. + ls = .TRUE. call physics_ptend_init(ptend_loc, state%psetcols, 'ionosphere', ls=ls) !------------------------------------------------------------------------------------------------------------------- - ! Get electron and ion temperatures from physics buffer. + ! Get electron and ion temperatures from physics buffer. !------------------------------------------------------------------------------------------------------------------- call pbuf_get_field(pbuf, index_te, tE) call pbuf_get_field(pbuf, index_ti, tI) @@ -385,30 +424,31 @@ end subroutine ion_electron_temp_tend !=============================================================================== subroutine update_istate(state, pbuf, istate, teTiBot) - + !--------------------------------------------------------------------------------------- ! Time independent initialization for extended ionosphere simulation called in phys_init ! of physpkg module which is called in cam_comp module !--------------------------------------------------------------------------------------- - use mo_apex, only : bnorth, beast, bdown ! Magnetic field components - use time_manager, only : get_curr_calday ! Routine to get current calendar day - use physconst, only : rairv, mbarv, rearth ! Constituent dependent rair and mbar - use ref_pres, only : press_lim_idx - use orbit, only : zenith - - use short_lived_species, only : slvd_index,slvd_pbf_ndx => pbf_idx ! Routines to access short lived species + use mo_apex, only: bnorth, beast, bdown ! Magnetic field components + use time_manager, only: get_curr_calday ! Routine to get current calendar day + use physconst, only: rearth + use air_composition, only: rairv, mbarv ! Constituent dependent rair and mbar + use ref_pres, only: press_lim_idx + use orbit, only: zenith + + use short_lived_species, only: slvd_index,slvd_pbf_ndx => pbf_idx ! Routines to access short lived species type(physics_buffer_desc), pointer :: pbuf(:) ! physics buffer type(physics_state), intent(in), target :: state ! physics state structure type(ionos_state), intent(inout), target :: istate ! ionosphere state structure - integer, intent(out) :: teTiBot ! bottom of ionosphere calculations + integer, intent(out) :: teTiBot ! bottom of ionosphere calculations -!---------------------------Local storage------------------------------- +!---------------------------Local storage------------------------------- integer,parameter :: nCnst = 9 ! Number of species needed from state%q or pbuf - integer :: lchnk ! Chunk number - integer :: ncol ! Number of columns in current chunk + integer :: lchnk ! Chunk number + integer :: ncol ! Number of columns in current chunk integer :: indxIR ! pbuf index for ionization rates integer :: indxAIPRS ! pbuf index for aurora ion production rate sum @@ -422,7 +462,7 @@ subroutine update_istate(state, pbuf, istate, teTiBot) integer :: iCol ! Counter for column loops integer :: iIonR ! Counter for ionization rates loops integer :: iCnst ! Counter for constituent loop - + integer :: indxSP ! pbuf index for Pedersen Conductivity integer :: indxSH ! pbuf index for Hall Conductivity @@ -453,9 +493,9 @@ subroutine update_istate(state, pbuf, istate, teTiBot) real(r8), dimension(pcols,pver) :: sourceR ! R term of source g4 calculation real(r8), dimension(pcols,pver) :: sourceEff ! Efficiency term of source g4 calculation - + real(r8), dimension(:,:),pointer :: rairvi ! Constituent dependent gas constant - + real(r8), dimension(:,:),pointer :: dipMag ! dip angle for each column (radians) real(r8), parameter :: rMassN2 = 28._r8 ! N2 molecular weight kg/kmol @@ -475,7 +515,7 @@ subroutine update_istate(state, pbuf, istate, teTiBot) real(r8), dimension(:,:) ,pointer :: ndens ! Constituent number density (cm-3) - real(r8), dimension(:,:,:),pointer :: ionRates ! Pointer to ionization rates for O+,O2+,N+,N2+,NO+ in pbuf (s-1) + real(r8), dimension(:,:,:),pointer :: ionRates ! Pointer to ionization rates for O+,O2+,N+,N2+,NO+ in pbuf (s-1) ! (from modules mo_jeuv and mo_jshort) real(r8), dimension(:,:,:),pointer :: ionPRates ! ionization rates temporary array (s-1 cm-3) @@ -496,7 +536,7 @@ subroutine update_istate(state, pbuf, istate, teTiBot) !-------------------------------------------------------------------------------- - sourceR = 0._r8 + sourceR = 0._r8 sourceEff = 0._r8 mmrN2 => istate%n2_mmr @@ -512,24 +552,24 @@ subroutine update_istate(state, pbuf, istate, teTiBot) sourceR(:,:) = 0._r8 sourceEff(:,:) = 0._r8 - + !tempout(:,:) = 0._r8 - + !-------------------------------------------------------------------------------------- - ! Get lchnk from state + ! Get lchnk from state !-------------------------------------------------------------------------------------- lchnk = state%lchnk ncol = state%ncol !------------------------------------------------------------------------------------------------------ - ! Set the bottom of the ionosphere calculations at around 50 Pascals or 0.5 hectopascals(millibars). + ! Set the bottom of the ionosphere calculations at around 50 Pascals or 0.5 hectopascals(millibars). ! teTiBotPres is in Pascals. !------------------------------------------------------------------------------------------------------ - teTiBot = press_lim_idx(teTiBotPres, top=.false.) + teTiBot = press_lim_idx(teTiBotPres, top=.false.) !---------------------------------------------------------------- ! Get latitude and longitude of each column in this chunk - !---------------------------------------------------------------- + !---------------------------------------------------------------- geoLatR => state%lat(1:ncol) geoLonR => state%lon(1:ncol) @@ -560,9 +600,9 @@ subroutine update_istate(state, pbuf, istate, teTiBot) !------------------------------------------------------------------------------------- ! Calculate neutral temperature on interface levels. tN vertical dimension is pver - !------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------- do iVer = 2, pver - + do iCol = 1, ncol tNInt(iCol,iVer) = 0.5_r8 * tN(iCol,iVer) + 0.5_r8 * tN(iCol,iVer-1) @@ -571,31 +611,31 @@ subroutine update_istate(state, pbuf, istate, teTiBot) enddo do iCol = 1, ncol - tNInt(iCol,1) = 1.5_r8 * tNInt(iCol,2) - 0.5_r8 * tNInt(iCol,3) + tNInt(iCol,1) = 1.5_r8 * tNInt(iCol,2) - 0.5_r8 * tNInt(iCol,3) enddo do iCol = 1, ncol - tNInt(iCol,pverp) = 1.5_r8 * tNInt(iCol,pver) - 0.5_r8 * tNInt(iCol,pver-1) + tNInt(iCol,pverp) = 1.5_r8 * tNInt(iCol,pver) - 0.5_r8 * tNInt(iCol,pver-1) enddo !-------------------------------------------------------------- ! Get zenith angle - !-------------------------------------------------------------- - calDay = get_curr_calday() + !-------------------------------------------------------------- + calDay = get_curr_calday() call zenith(calDay,geoLatR(1:ncol),geoLonR(1:ncol),cosZenAngR(1:ncol),ncol) do iCol = 1, ncol zenAngD(iCol) = ACOS(cosZenAngR(iCol)) * rads2Degs - + enddo !--------------------------------------------------------------------------------------- ! Expand magnetic field components in vertical to make 3D, pcols,pver,begchunk:endchunk - ! These are used in calculation of magnetic dip angle and magnetic declination angle so + ! These are used in calculation of magnetic dip angle and magnetic declination angle so ! store in local ionosphere module structure. !--------------------------------------------------------------------------------------- do iVer = 1, pver - + do iCol = 1, ncol bNorth3d(iCol,iVer) = bnorth(iCol,lchnk) @@ -603,12 +643,12 @@ subroutine update_istate(state, pbuf, istate, teTiBot) bDown3d(iCol,iVer) = bdown(iCol,lchnk) enddo - + enddo !------------------------------------------------------------------------ ! Get constituent dependent gas constant and derive on interface levels - !------------------------------------------------------------------------ + !------------------------------------------------------------------------ do iVer = 2, pver do iCol = 1, ncol rairvi(iCol,iVer) = 0.5_r8 * rairv(iCol,iVer-1,lchnk) + 0.5_r8 * rairv(iCol,iVer,lchnk) @@ -624,7 +664,7 @@ subroutine update_istate(state, pbuf, istate, teTiBot) !------------------------------------------------------------------------------- ! Need to get dip angle from magnetic field components - !------------------------------------------------------------------------------- + !------------------------------------------------------------------------------- do iVer = 1, pver do iCol = 1, ncol dipMag(iCol,iVer) = ATAN(bDown3d(iCol,iVer) / SQRT(bNorth3d(iCol,iVer)**2 + bEast3d(iCol,iVer)**2)) @@ -634,7 +674,7 @@ subroutine update_istate(state, pbuf, istate, teTiBot) enddo !------------------------------------------------------------------------------------------- - ! Set up constituents to be accessed here from pbuf or state%q. + ! Set up constituents to be accessed here from pbuf or state%q. !------------------------------------------------------------------------------------------- cCnst = (/'O ','O2 ','NO ','H ','N ','e ','Op ','O2p','NOp'/) @@ -642,18 +682,18 @@ subroutine update_istate(state, pbuf, istate, teTiBot) !-------------------------------------- ! Assign density to istate array - !-------------------------------------- + !-------------------------------------- if (cCnst(iCnst) == 'O ') ndens => istate%ndensO1(1:ncol,1:pver) - if (cCnst(iCnst) == 'O2 ') ndens => istate%ndensO2(1:ncol,1:pver) - if (cCnst(iCnst) == 'NO ') ndens => istate%ndensNO(1:ncol,1:pver) - if (cCnst(iCnst) == 'N ') ndens => istate%ndensN1(1:ncol,1:pver) + if (cCnst(iCnst) == 'O2 ') ndens => istate%ndensO2(1:ncol,1:pver) + if (cCnst(iCnst) == 'NO ') ndens => istate%ndensNO(1:ncol,1:pver) + if (cCnst(iCnst) == 'N ') ndens => istate%ndensN1(1:ncol,1:pver) if (cCnst(iCnst) == 'e ') ndens => istate%ndensE(1:ncol,1:pver) if (cCnst(iCnst) == 'Op ') ndens => istate%ndensOp(1:ncol,1:pver) if (cCnst(iCnst) == 'O2p') ndens => istate%ndensO2p(1:ncol,1:pver) if (cCnst(iCnst) == 'NOp') ndens => istate%ndensNOp(1:ncol,1:pver) !------------------------------------------------------------------------------------------- - ! Set flag and get field mmr whether each constituent is short-lived(pbuf) or not(state%q). + ! Set flag and get field mmr whether each constituent is short-lived(pbuf) or not(state%q). !------------------------------------------------------------------------------------------- call cnst_get_ind( TRIM(cCnst(iCnst)), indxCnst, abort=.false. ) if (indxCnst < 0) then @@ -672,10 +712,10 @@ subroutine update_istate(state, pbuf, istate, teTiBot) !-------------------------------------------------------------------------------------------------------------- ! Need to get number density (cgs units) from mass mixing ratio. mbarv is kg/mole, same as rMass units ! kg/kg * (kg/mole)/(kg/mole) * (Pa or N/m*m)/((Joules/K or N*m/K) * (K)) = m-3 * 1E-06 = cm-3 - !--------------------------------------------------------------------------------------------------------------- + !--------------------------------------------------------------------------------------------------------------- ndens(1:ncol,1:pver) = mmr(1:ncol,1:pver) * mbarv(1:ncol,1:pver,lchnk) / rMass * & pMid(1:ncol,1:pver) / (kboltz * tN(1:ncol,1:pver)) * 1.E-06_r8 - + if (cCnst(iCnst) == 'O ') then mmrO1(1:ncol,1:pver) = mmr(1:ncol,1:pver) ndensO1(1:ncol,1:pver) = ndens(1:ncol,1:pver) @@ -692,18 +732,18 @@ subroutine update_istate(state, pbuf, istate, teTiBot) !---------------------------------------------------------------------------- if (iCnst == nCnst) then - mmrN2(1:ncol,1:pver) = 1._r8 - (mmrO2(1:ncol,1:pver) + mmrO1(1:ncol,1:pver)) + mmrN2(1:ncol,1:pver) = 1._r8 - (mmrO2(1:ncol,1:pver) + mmrO1(1:ncol,1:pver)) mmrN2(1:ncol,1:pver) = MAX(1.e-20_r8,mmrN2(1:ncol,1:pver)) ndensN2(1:ncol,1:pver) = mmrN2(1:ncol,1:pver) * mbarv(1:ncol,1:pver,lchnk) / rMassN2 * & - pMid(1:ncol,1:pver) / (kboltz * tN(1:ncol,1:pver)) * 1.E-06_r8 - + pMid(1:ncol,1:pver) / (kboltz * tN(1:ncol,1:pver)) * 1.E-06_r8 + endif - + enddo ! nCnst if (hist_fld_active('ElecColDens')) then !--------------------------------------- - ! Calculate electron column density + ! Calculate electron column density !--------------------------------------- !------------------------------------------------------------------------------ ! Convert geopotential altitude in meters to geometric altitude in centimeters @@ -720,10 +760,10 @@ subroutine update_istate(state, pbuf, istate, teTiBot) enddo zThickness(1:ncol,1) = (1.5_r8 * zThickness(1:ncol,2)) - (0.5_r8 * zThickness(1:ncol,3)) - zThickness(1:ncol,pver) = (1.5_r8 * zThickness(1:ncol,pver-1)) - (0.5_r8 * zThickness(1:ncol,pver-2)) + zThickness(1:ncol,pver) = (1.5_r8 * zThickness(1:ncol,pver-1)) - (0.5_r8 * zThickness(1:ncol,pver-2)) !---------------------------------------------------------------------------------- - ! Calculate electron column density converting from cm-2 to TEC units (1E16 m-2) + ! Calculate electron column density converting from cm-2 to TEC units (1E16 m-2) ! and make available for history output !---------------------------------------------------------------------------------- eColDens(1:ncol) = sum(ndensE(1:ncol,:) * zThickness(1:ncol,:), dim=2) / 1.E12_r8 @@ -732,16 +772,16 @@ subroutine update_istate(state, pbuf, istate, teTiBot) endif !------------------------------------------------------------------------------------ - ! Get ionization rates from physics buffer which were calculated in mo_jeuv and + ! Get ionization rates from physics buffer which were calculated in mo_jeuv and ! mo_jshort modules. Rates array dimensions are pcols, pver, nIonRates. Units s-1 !------------------------------------------------------------------------------------ indxIR = pbuf_get_index( 'IonRates' ) call pbuf_get_field(pbuf, indxIR, ionRates) !---------------------------------------------------------------------------------------------- - ! Need to convert these ionization rates to ion production rates by multiplying number density - ! of neutral species appropriate from reactions in mo_jeuv(jeuv) and mo_jshort(jshort)(for NO) - !---------------------------------------------------------------------------------------------- + ! Need to convert these ionization rates to ion production rates by multiplying number density + ! of neutral species appropriate from reactions in mo_jeuv(jeuv) and mo_jshort(jshort)(for NO) + !---------------------------------------------------------------------------------------------- do iVer = 1, pver do iCol = 1, ncol @@ -760,14 +800,14 @@ subroutine update_istate(state, pbuf, istate, teTiBot) !---------------------------------------------- ! Sum ion production rates all reactions - !---------------------------------------------- + !---------------------------------------------- sumIonPRates(iCol,iVer) = SUM(ionPRates(iCol,iVer,1:11)) enddo enddo if (.not.steady_state_ion_elec_temp) then !------------------------------------------------------------------------------------------- - ! Get aurora ion production rate sum from physics buffer which were calculated in mo_aurora + ! Get aurora ion production rate sum from physics buffer which were calculated in mo_aurora ! module. Rate array dimensions are pcols, pver. Units s-1 cm-3 !------------------------------------------------------------------------------------------- indxAIPRS = pbuf_get_index( 'AurIPRateSum' ) @@ -785,7 +825,7 @@ subroutine update_istate(state, pbuf, istate, teTiBot) !------------------------------------------------------------------------------- ! Calculate g4 source term for electron temperature update - !------------------------------------------------------------------------------- + !------------------------------------------------------------------------------- sourceg4(iCol,iVer) = (sumIonPRates(iCol,iVer) + aurIPRateSum(iCol,iVer)) * sourceEff(iCol,iVer) enddo @@ -797,7 +837,7 @@ subroutine update_istate(state, pbuf, istate, teTiBot) call outfld ('AURIPRATESUM', aurIPRateSum, pcols, lchnk) !---------------------------------------------------------------------------------------------- - ! Get Pedersen and Hall Conductivities from physics buffer which were calculated in iondrag + ! Get Pedersen and Hall Conductivities from physics buffer which were calculated in iondrag ! module. Conductivity array dimensions are pcols, pver !------------------------------------------------------------------------------- indxSP = pbuf_get_index( 'PedConduct' ) @@ -816,13 +856,13 @@ end subroutine update_istate subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTiBot) !----------------------------------------------------------------------- - ! Routine to compute the electron and ion temperature + ! Routine to compute the electron and ion temperature !----------------------------------------------------------------------- - use physconst, only : gravit ! Gravity (m/s2) - use physconst, only : rairv, mbarv ! Constituent dependent rair and mbar - use mo_apex, only: alatm - + use physconst, only: gravit ! Gravity (m/s2) + use air_composition, only: rairv, mbarv ! Constituent dependent rair and mbar + use mo_apex, only: alatm + !------------------------------Arguments-------------------------------- type(physics_state), intent(in), target :: state ! physics state structure @@ -833,17 +873,17 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi real(r8), intent(in) :: ztodt ! physics time step - real(r8), dimension(:,:), pointer, intent(inout) :: tE ! Pointer to electron temperature in pbuf (K) - real(r8), dimension(:,:), pointer, intent(inout) :: tI ! Pointer to ion temperature in pbuf (K) + real(r8), dimension(:,:), pointer, intent(inout) :: tE ! Pointer to electron temperature in pbuf (K) + real(r8), dimension(:,:), pointer, intent(inout) :: tI ! Pointer to ion temperature in pbuf (K) - integer, intent(in) :: teTiBot ! bottom of ionosphere calculations + integer, intent(in) :: teTiBot ! bottom of ionosphere calculations !---------------------------Local storage------------------------------- integer, parameter :: maxIter = 6 ! maximum number of iterations to solve for electron/ion temperature - - integer :: lchnk ! Chunk number - integer :: ncol ! Number of atmospheric columns - integer :: teTiBotP ! bottom of ionosphere calculations plus one more level + + integer :: lchnk ! Chunk number + integer :: ncol ! Number of atmospheric columns + integer :: teTiBotP ! bottom of ionosphere calculations plus one more level integer :: iVer ! Counter for vertical loops integer :: iCol ! Counter for column loops @@ -859,13 +899,13 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi real(r8), parameter :: lossc9 = 5.7E-4_r8 ! c9 constant needed for loss term g3 for electron temperature update real(r8), parameter :: lossc13 = 7.E-5_r8 ! c13 constant needed for loss term g3 for electron temperature update - real(r8), parameter :: lossc4pCoef = 1.77E-19_r8 - real(r8), parameter :: lossc6pCoef = 1.21E-18_r8 + real(r8), parameter :: lossc4pCoef = 1.77E-19_r8 + real(r8), parameter :: lossc6pCoef = 1.21E-18_r8 real(r8), parameter :: lossc8pCoef = 7.9E-19_r8 - real(r8), parameter :: lossc10pCoef = 1.3E-4_r8 + real(r8), parameter :: lossc10pCoef = 1.3E-4_r8 real(r8), parameter :: lossc11pCoef = 3.125E-21_r8 real(r8), parameter :: lossc12pCoef = 3.4E-12_r8 - real(r8), parameter :: lossc14pCoef = 1.57E-12_r8 + real(r8), parameter :: lossc14pCoef = 1.57E-12_r8 real(r8), parameter :: lossc15pCoef = 2.9E-14_r8 real(r8), parameter :: lossc16pCoef = 6.9E-14_r8 real(r8), parameter :: lossc3pC1 = 3.2E-8_r8 @@ -881,7 +921,7 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi real(r8), parameter :: losscinCoef7 = 5.8e-14_r8 real(r8), parameter :: losscinCoef8 = 0.14e-14_r8 real(r8), parameter :: losscinCoef9 = 4.4e-14_r8 - + real(r8), parameter :: FeDCoef1 = -9.0E+7_r8 real(r8), parameter :: FeDCoef2 = 4.0E+7_r8 @@ -889,7 +929,7 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi real(r8), parameter :: losscACoef2 = -3352.6_r8 real(r8), parameter :: losscACoef3 = 2.0E-7_r8 real(r8), parameter :: losscACoef4 = -4605.2_r8 - real(r8), parameter :: losscACoef5 = 2.53E-6_r8 + real(r8), parameter :: losscACoef5 = 2.53E-6_r8 real(r8), parameter :: losscACoef6 = -17620._r8 real(r8), parameter :: loss10pCoef = 3200._r8 @@ -941,26 +981,26 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi real(r8), dimension(:,:), pointer :: ndensNOp ! NO plus ion number density (cm-3) real(r8), dimension(:,:), pointer :: sourceg4 ! g4 source term for electron/ion temperature update - + real(r8), dimension(:,:), pointer :: dipMag ! dip angle for each column (radians) real(r8), dimension(pcols) :: dlatm ! magnetic latitude of each phys column (degrees) real(r8), dimension(:), pointer :: zenAngD ! zenith angle (degrees) real(r8), dimension(pcols) :: FeUB ! electron heat flux at upper boundary - + real(r8), dimension(pver) :: sqrtTE ! Square root of electron temperature - + real(r8), dimension(pver) :: Ke ! electron conductivity real(r8), dimension(pverp) :: Kei ! electron conductivity interface levels real(r8), dimension(pcols,pver) :: lossc4p ! c4 prime of Lc(eN2) component of loss term real(r8), dimension(pcols,pver) :: lossceN2 ! Lc(eN2) component of loss term equation - + real(r8), dimension(pcols,pver) :: lossc6p ! c6 prime of Lc(eO2) component of loss term equation real(r8), dimension(pcols,pver) :: lossceO2 ! Lc(eO2) component of loss term equation - + real(r8), dimension(pcols,pver) :: lossc8p ! c8 prime of Lc(eO) component of loss term equation real(r8), dimension(pcols,pver) :: lossceO1 ! Lc(eO) component of loss term equation @@ -971,22 +1011,22 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi real(r8), dimension(pcols,pver) :: lossc11p ! c11 prime of Lc(eO2)v component of loss term equation real(r8), dimension(pcols,pver) :: lossceO2v ! Lc(eO2)v component of loss term equation - + real(r8), dimension(pcols,pver) :: lossc12p ! c12 prime of Lc(eO)f component of loss term equation real(r8), dimension(pcols,pver) :: lossceOf ! Lc(eO)f component of loss term equation - + real(r8), dimension(pcols,pver) :: lossc14p ! c14 prime of Lc(eO)1D component of loss term equation real(r8), dimension(pcols,pver) :: losscf2d ! d of f2 of Lc(eO)1D component of loss term equation real(r8), dimension(pcols,pver) :: losscf2 ! f2 of Lc(eO)1D component of loss term equation real(r8), dimension(pcols,pver) :: losscf3 ! f3 of Lc(eO)1D component of loss term equation real(r8), dimension(pcols,pver) :: lossceO1D ! Lc(eO)1D component of loss term equation - + real(r8), dimension(pcols,pver) :: lossc15p ! c15 prime of Lc(eN2)Rot component of loss term equation real(r8), dimension(pcols,pver) :: lossceN2Rot ! Lc(eN2)Rot component of loss term equation - + real(r8), dimension(pcols,pver) :: lossc16p ! c16 prime of Lc(eO2)Rot component of loss term equation real(r8), dimension(pcols,pver) :: lossceO2Rot ! Lc(eO2)Rot component of loss term equation - + real(r8), dimension(pcols,pver) :: lossc3p ! c3 prime of Lc(ei) component of loss term equation real(r8), dimension(pcols,pver) :: losscei ! Lc(ei) component of loss term equation real(r8), dimension(pcols,pver) :: losscin ! ion-neutral heating coeff. @@ -995,11 +1035,11 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi real(r8), dimension(pcols,pverp) :: delZi ! Delta z: interfaces real(r8), dimension(pcols,pver) :: delZ ! Delta z: midpoints - + real(r8), dimension(pcols,pver) :: qjoule ! joule heating - real(r8), dimension(pcols,pver) :: qen ! electron-neutral heating - real(r8), dimension(pcols,pver) :: qei ! electron-ion Coulomb heating - real(r8), dimension(pcols,pver) :: qin ! ion-neutral heating + real(r8), dimension(pcols,pver) :: qen ! electron-neutral heating (units: ev/g/s) + real(r8), dimension(pcols,pver) :: qei ! electron-ion Coulomb heating (units: ev/g/s) + real(r8), dimension(pcols,pver) :: qin ! ion-neutral heating (units: ev/g/s) real(r8), dimension(pcols,pver) :: rho ! mass density real(r8), dimension(pcols,pver) :: wrk2 @@ -1013,8 +1053,9 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi logical, dimension(pcols) :: colConv ! flag for column converging logical :: converged ! Flag for convergence in electron temperature ! calculation iteration loop + real(r8) :: qrate(pcols,pver) ! heating rate diagnostic - !--------------------------------------------------------------------------------------------------------- + !--------------------------------------------------------------------------------------------------------- ! Initialize arrays to zero and column convergence logical to .false. !--------------------------------------------------------------------------------------------------------- @@ -1049,12 +1090,12 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi losscin(:,:) = 0._r8 lossg3(:,:) = 0._r8 delZi(:,:) = 0._r8 - delZ(:,:) = 0._r8 - subDiag(:) = 0._r8 - superDiag(:) = 0._r8 - diag(:) = 0._r8 - rHS(:) = 0._r8 - teTemp(:) = 0._r8 + delZ(:,:) = 0._r8 + subDiag(:) = 0._r8 + superDiag(:) = 0._r8 + diag(:) = 0._r8 + rHS(:) = 0._r8 + teTemp(:) = 0._r8 qjoule(:,:) = 0._r8 qei(:,:) = 0._r8 qen(:,:) = 0._r8 @@ -1068,7 +1109,7 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi !-------------------------------------------------------------------------------------- lchnk = state%lchnk ncol = state%ncol - + !------------------------------------------- ! Calculate some commonly used variables !------------------------------------------- @@ -1085,28 +1126,28 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi qjoule(1:ncol,1:teTiBot) = dSETendIn(1:ncol,1:teTiBot) * sToQConv ! convert from J/kg/s to ev/g/s pInt => state%pint(1:ncol,1:pverp) - tNInt => istate%tNInt(1:ncol,1:pverp) + tNInt => istate%tNInt(1:ncol,1:pverp) rairvi => istate%rairvi(1:ncol,1:pverp) !---------------------------------------------------------------- ! Get variables needed from the ionosphere state structure !---------------------------------------------------------------- - ndensO2 => istate%ndensO2(1:ncol,1:pver) + ndensO2 => istate%ndensO2(1:ncol,1:pver) ndensO1 => istate%ndensO1(1:ncol,1:pver) - ndensE => istate%ndensE(1:ncol,1:pver) - ndensOp => istate%ndensOp(1:ncol,1:pver) + ndensE => istate%ndensE(1:ncol,1:pver) + ndensOp => istate%ndensOp(1:ncol,1:pver) ndensO2p => istate%ndensO2p(1:ncol,1:pver) ndensNOp => istate%ndensNOp(1:ncol,1:pver) - ndensN2 => istate%ndensN2(1:ncol,1:pver) + ndensN2 => istate%ndensN2(1:ncol,1:pver) sourceg4 => istate%sourceg4(1:ncol,1:pver) dipMag => istate%dipMag(1:ncol,1:pver) - zenAngD => istate%zenAngD(1:ncol) - + zenAngD => istate%zenAngD(1:ncol) + !------------------------------------------------------------------------------------------------------------------- - ! Set electron temperature limits + ! Set electron temperature limits !------------------------------------------------------------------------------------------------------------------- tE(1:ncol,1:pver) = MAX(tN(1:ncol,1:pver),tE(1:ncol,1:pver)) tE(1:ncol,1:pver) = MIN(temax,tE(1:ncol,1:pver)) @@ -1119,12 +1160,12 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi tI(1:ncol,teTiBotP:pver) = tN(1:ncol,teTiBotP:pver) wrk2(1:ncol,1:teTiBot) = ndensE(1:ncol,1:teTiBot)/wrk1/(SIN(dipMag(1:ncol,1:teTiBot)))**2._r8 - + dlatm(:ncol) = rads2Degs* alatm(:ncol,lchnk) - + !----------------------------------------------------------------------------- - ! Get terms needed for loss term g3 for electron temperature update which do - ! not need to be updated in iteration loop. + ! Get terms needed for loss term g3 for electron temperature update which do + ! not need to be updated in iteration loop. !----------------------------------------------------------------------------- do iCol = 1, ncol @@ -1154,12 +1195,12 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi enddo !iVer loop !---------------------------------------------------------------------------------- - ! Calculate upper boundary heat flux + ! Calculate upper boundary heat flux !---------------------------------------------------------------------------------- if (ABS(dlatm(iCol)) < 10.0_r8) then FeDB = 0._r8 else if (ABS(dlatm(iCol)) >= 10.0_r8 .and. ABS(dlatm(iCol)) < 40.0_r8) then - FeDB = 0.5_r8 * (1._r8 + SIN(pi * (ABS(dlatm(iCol)) - 15.0_r8) /30.0_r8)) + FeDB = 0.5_r8 * (1._r8 + COS(pi * (ABS(dlatm(iCol)) - 40.0_r8) /30.0_r8)) else FeDB = 1._r8 end if @@ -1196,30 +1237,30 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi !---------------------------------------------------------- delZi(iCol,1:teTiBotP) = delZi(iCol,1:teTiBotP)*100._r8 delZ(iCol,1:teTiBot) = delZ(iCol,1:teTiBot)*100._r8 - + endif ! Column not converged enddo !iCol loop !------------------------------------------------------------------------------------------------------- - ! Iterate to calculate new electron temperature. + ! Iterate to calculate new electron temperature. ! Time splitting is used: first solve the heating/cooling equation, then solve the diffusion equations. - ! Also, set convergence flag to false and iterate until true or 6 iterations, whichever comes first + ! Also, set convergence flag to false and iterate until true or 6 iterations, whichever comes first !------------------------------------------------------------------------------------------------------- - converged = .false. + converged = .false. iter = 0 do while (.not. converged .and. iter < maxIter) - + !-------------------------------------------------------------------------------------------------------- - ! Increment iteration loop counter and save electron temperature from previous iteration for convergence + ! Increment iteration loop counter and save electron temperature from previous iteration for convergence ! test at end of interation loop. Also, take square root of electron temperature to be used later - !-------------------------------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------------------------------- iter = iter + 1 - + tEPrevI(1:ncol,1:teTiBot) = tE(1:ncol,1:teTiBot) !-------------------------------------------------------------------------------------------------------- - ! Loop over columns then vertical levels and call tridiagonal solver for each column to get electron + ! Loop over columns then vertical levels and call tridiagonal solver for each column to get electron ! temperature !-------------------------------------------------------------------------------------------------------- do iCol = 1, ncol @@ -1231,7 +1272,7 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi do iVer = 1, teTiBot !----------------------------------------------------------------------------- - ! Get loss term g3 for electron temperature update. Need to calculate + ! Get loss term g3 for electron temperature update. Need to calculate ! constituent dependent loss terms which make up g3 !----------------------------------------------------------------------------- lossceN2(iCol,iVer) = lossc4p(iCol,iVer) * (1._r8 - lossc5 * tE(iCol,iVer)) * tE(iCol,iVer) @@ -1239,7 +1280,7 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi lossceO1(iCol,iVer) = lossc8p(iCol,iVer) * (1._r8 + lossc9 * tE(iCol,iVer)) * sqrtTE(iVer) if (tE(iCol,iVer) < 1000.0_r8) then - losscA(iCol,iVer) = losscACoef1 * EXP(losscACoef2 / tE(iCol,iVer)) + losscA(iCol,iVer) = losscACoef1 * EXP(losscACoef2 / tE(iCol,iVer)) endif if (tE(iCol,iVer) >= 1000.0_r8 .AND. tE(iCol,iVer) <= 2000.0_r8) then losscA(iCol,iVer) = losscACoef3 * EXP(losscACoef4 / tE(iCol,iVer)) @@ -1260,7 +1301,7 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi losscf2dC4 * (tE(iCol,iVer) - losscf2dC3) * (tE(iCol,iVer) - losscf2dC5) losscf2(iCol,iVer) = losscf2d(iCol,iVer) * (1._r8 / losscf2C1 - 1._r8 / tE(iCol,iVer)) losscf3(iCol,iVer) = losscf3c1 * (1._r8 / tN(iCol,iVer) - 1._r8 / tE(iCol,iVer)) - lossceO1D(iCol,iVer) = lossc14p(iCol,iVer) * EXP(losscf2(iCol,iVer)) * & + lossceO1D(iCol,iVer) = lossc14p(iCol,iVer) * EXP(losscf2(iCol,iVer)) * & (1._r8 - EXP(losscf3(iCol,iVer))) / tENDiff(iCol,iVer) lossceN2Rot(iCol,iVer) = lossc15p(iCol,iVer) / sqrtTE(iVer) lossceO2Rot(iCol,iVer) = lossc16p(iCol,iVer) / sqrtTE(iVer) @@ -1281,7 +1322,7 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi enddo ! End of column loop !----------------------------------------------------- - ! Calculate thermal conductivity of electron gas + ! Calculate thermal conductivity of electron gas !----------------------------------------------------- do iCol = 1, ncol @@ -1358,8 +1399,8 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi enddo !--------------------------------------------------------------------------------------------------------- - ! Calculate ion temperature from electron temperature, ion-neutral and electron-ion loss terms, neutral - ! temperature, mass density and joule heating. Set minimum value to neutral temperature and maximum + ! Calculate ion temperature from electron temperature, ion-neutral and electron-ion loss terms, neutral + ! temperature, mass density and joule heating. Set minimum value to neutral temperature and maximum ! value to electron temperature for each column and vertical level !--------------------------------------------------------------------------------------------------------- do iVer = 1,teTiBot @@ -1372,10 +1413,10 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi !-------------------------------------------------------------------------------------------------------- ! Check for convergence which is a change of electron temperature ratio to previous loop for all levels - ! and columns of less than 0.05K. Had to modify this to do convergence check on each column since + ! and columns of less than 0.05K. Had to modify this to do convergence check on each column since ! checking all columns in a chunk gives different answers depending on number of tasks and tasks per node. !-------------------------------------------------------------------------------------------------------- - if (ALL(ABS(tE(iCol,1:teTiBot) / tEPrevI(iCol,1:teTiBot) - 1._r8) < 0.05_r8)) then + if (ALL(ABS(tE(iCol,1:teTiBot) / tEPrevI(iCol,1:teTiBot) - 1._r8) < 0.05_r8)) then colConv(iCol) = .true. @@ -1410,11 +1451,16 @@ subroutine update_teti(state, dSETendIn, dSETendOut, ztodt, istate, tE, tI, teTi qei(1:ncol,1:teTiBot) = losscei(1:ncol,1:teTiBot) * (tE(1:ncol,1:teTiBot)-ti(1:ncol,1:teTiBot)) / rho(1:ncol,1:teTiBot) qin(1:ncol,1:teTiBot) = losscin(1:ncol,1:teTiBot) * (tI(1:ncol,1:teTiBot)-tN(1:ncol,1:teTiBot)) / rho(1:ncol,1:teTiBot) - dSETendOut(1:ncol,1:teTiBot) = (qei(1:ncol,1:teTiBot)+qen(1:ncol,1:teTiBot)) / sToQConv ! J/kg/s + dSETendOut(1:ncol,1:teTiBot) = (qei(1:ncol,1:teTiBot)+qen(1:ncol,1:teTiBot)) / sToQConv ! J/kg/s + + qrate(:ncol,:) = qen(:ncol,:)/sToQConv/cpairv(:ncol,:,lchnk) ! K/s + call outfld ('QEN', qrate, pcols, lchnk) + + qrate(:ncol,:) = qei(:ncol,:)/sToQConv/cpairv(:ncol,:,lchnk) ! K/s + call outfld ('QEI', qrate, pcols, lchnk) - call outfld ('QEN', qen, pcols, lchnk) - call outfld ('QEI', qei, pcols, lchnk) - call outfld ('QIN', qin, pcols, lchnk) + qrate(:ncol,:) = qin(:ncol,:)/sToQConv/cpairv(:ncol,:,lchnk) ! K/s + call outfld ('QIN', qrate, pcols, lchnk) return diff --git a/src/physics/waccmx/majorsp_diffusion.F90 b/src/physics/waccmx/majorsp_diffusion.F90 index bef8bffa82..9784abd01f 100644 --- a/src/physics/waccmx/majorsp_diffusion.F90 +++ b/src/physics/waccmx/majorsp_diffusion.F90 @@ -4,7 +4,7 @@ module majorsp_diffusion ! This module computes the diffusion of major species (O2 and O) mass mixing ! ratio. This routine computes both the molecular and eddy diffusivity. This ! is adapted from the major species diffusion calculation of TIME-GCM. -! +! ! Calling sequence: ! initialization: ! init @@ -134,9 +134,9 @@ subroutine mspd_intr(ztodt ,state ,ptend) !------------------------------------------------------------------------------- ! interface routine. output tendency. !------------------------------------------------------------------------------- - use physics_types, only: physics_state, physics_ptend - use upper_bc, only: ubc_get_vals - use physconst, only: rairv, mbarv + use physics_types, only: physics_state, physics_ptend + use upper_bc, only: ubc_get_vals + use air_composition, only: rairv, mbarv !------------------------------Arguments-------------------------------- real(r8), intent(in) :: ztodt ! 2 delta-t @@ -147,7 +147,6 @@ subroutine mspd_intr(ztodt ,state ,ptend) real(r8) :: tendo2o(pcols,pver,2) ! temporary array for o2 and o tendency real(r8) :: ubc_mmr(pcols,pcnst) ! upper bndy mixing ratios (kg/kg) real(r8) :: ubc_t(pcols) ! upper bndy temperature (K) - real(r8) :: ubc_flux(pcols,pcnst) ! upper bndy flux (kg/s/m^2) integer :: lchnk ! chunk identifier integer :: ncol ! number of atmospheric columns integer :: i, k ! indexing integers @@ -164,7 +163,7 @@ subroutine mspd_intr(ztodt ,state ,ptend) !---------------------------------------------------------------------------------------------- tendo2o(:ncol,:,io2) = ptend%q(:ncol,:,indx_O2) tendo2o(:ncol,:,io1) = ptend%q(:ncol,:,indx_O) - + !---------------------------------------------------------------------- ! Operate on copies of the input states, convert to tendencies at end. !---------------------------------------------------------------------- @@ -175,8 +174,7 @@ subroutine mspd_intr(ztodt ,state ,ptend) !------------------------------------------- ! set upper boundary values of O2 and O MMR. !------------------------------------------- - call ubc_get_vals( lchnk, ncol, state%pint, state%zi, state%t, state%q, & - state%omega, state%phis, ubc_t, ubc_mmr, ubc_flux ) + call ubc_get_vals( lchnk, ncol, state%pint, state%zi, ubc_t, ubc_mmr ) o2mmr_ubc(:ncol) = ubc_mmr(:ncol,indx_O2) ommr_ubc(:ncol) = ubc_mmr(:ncol,indx_O) endif @@ -218,7 +216,7 @@ subroutine mspdiff (lchnk ,ncol , !----------------------------------------------------------------------- ! Driver routine to compute major species diffusion (O2 and O). -! Turbulent diffusivities and boundary layer nonlocal transport terms are +! Turbulent diffusivities and boundary layer nonlocal transport terms are ! obtained from the turbulence module. !---------------------------Arguments------------------------------------ use ref_pres, only: lev0 => nbot_molec @@ -234,7 +232,7 @@ subroutine mspdiff (lchnk ,ncol , real(r8), intent(in) :: rairv(pcols,pver) ! composition dependent gas "constant" real(r8), intent(in) :: mbarv(pcols,pver) ! composition dependent mean mass - real(r8), intent(inout) :: q(pcols,pver,pcnst) ! constituents + real(r8), intent(inout) :: q(pcols,pver,pcnst) ! constituents !---------------------------Local storage------------------------------- real(r8) :: o2(pcols,pver), o1(pcols,pver) ! o2, o1 mixing ratio (kg/kg moist air) @@ -352,7 +350,7 @@ subroutine mspdiff (lchnk ,ncol , ! Set up mean mass working array !------------------------------------------------------------------ ! ep, ak at the interface level immediately below midpoint level nbot_molec - + ! WKS4 = .5*(DMBAR/DZ)/MBAR do i=1,ncol wks4(i) = (mbarv(i,lev0)-mbarv(i,lev0+1))/ & @@ -362,7 +360,7 @@ subroutine mspdiff (lchnk ,ncol , !----------------------------------- ! Calculate coefficient matrices !----------------------------------- - km = 1 + km = 1 kp = 2 do i=1, ncol ep(i,io2,kp) = 1._r8-(2._r8/(mbarv(i,lev0+1)+mbarv(i,lev0)))* & @@ -385,8 +383,8 @@ subroutine mspdiff (lchnk ,ncol , enddo enddo ! -! WKS1=MBAR/M3*(T00/(T0+T))*0.25/(TAU*DET(ak)) ak at the interface level -! immediately below midpoint level nbot_molec. +! WKS1=MBAR/M3*(T00/(T0+T))*0.25/(TAU*DET(ak)) ak at the interface level +! immediately below midpoint level nbot_molec. do i=1,ncol wks1(i) = 0.5_r8*(mbarv(i,lev0+1)+mbarv(i,lev0))*rmassinv_n2* & (2._r8*t00/(t(i,lev0+1)+t(i,lev0)))**0.25_r8/ & @@ -431,7 +429,7 @@ subroutine mspdiff (lchnk ,ncol , enddo enddo - + !--------------------------------------------- ! Calculate coefficients for diagonals and rhs !--------------------------------------------- @@ -456,11 +454,11 @@ subroutine mspdiff (lchnk ,ncol , pk(i,isp,m) = (ak(i,isp,m,km)*(rdzmid(i,k+1)+ep(i,m,km)/2._r8)- & expzi(i,k+1)*difk(i,k+1)*(rdzmid(i,k+1)- & wks3(i))*delta(isp,m))*rdz(i,k) - + rk(i,isp,m) = (ak(i,isp,m,kp)*(rdzmid(i,k)-ep(i,m,kp)/2._r8)- & expzi(i,k)*difk(i,k)*(rdzmid(i,k)+ & wks4(i))*delta(isp,m))*rdz(i,k) - + qk(i,isp,m) = -(ak(i,isp,m,km)*(rdzmid(i,k+1)-ep(i,m,km)/2._r8)+ & ak(i,isp,m,kp)*(rdzmid(i,k)+ep(i,m,kp)/2._r8))*rdz(i,k)+ & ((expzi(i,k)*difk(i,k)*(rdzmid(i,k)-wks4(i))+ & @@ -475,7 +473,7 @@ subroutine mspdiff (lchnk ,ncol , fk(i,io2) = expzm(i,k)*o2(i,k)*rztodt fk(i,io1) = expzm(i,k)*o1(i,k)*rztodt enddo - + !---------------------------- ! Lower boundary !---------------------------- @@ -538,10 +536,10 @@ subroutine mspdiff (lchnk ,ncol , .5_r8*(o1(i,k)+ommr_ubc(i)))- & (1._r8-delta(io1,m))*(phi(io1,m)-phi(io1,3))* & .5_r8*(o1(i,k)+ommr_ubc(i)) - + enddo enddo - + ! ! WKS1=MBAR/M3*(T00/(T0+T))**0.25/(TAU*DET(ALFA)) do i=1,ncol @@ -559,7 +557,7 @@ subroutine mspdiff (lchnk ,ncol , do isp=io2,io1 do i=1,ncol ak(i,isp,m,kp) = ak(i,isp,m,kp)*wks1(i) - + pk(i,isp,m) = (ak(i,isp,m,km)*(rdzmid(i,k+1)+ep(i,m,km)/2._r8)- & expzi(i,k+1)*difk(i,k+1)*(rdzmid(i,k+1)- & wks3(i))*delta(isp,m))*rdz(i,k) @@ -591,7 +589,7 @@ subroutine mspdiff (lchnk ,ncol , enddo else - + do i=1,ncol wks3(i) = wks4(i) enddo diff --git a/src/physics/waccmx/steady_state_tei.F90 b/src/physics/waccmx/steady_state_tei.F90 index 6ff0ba52b6..135b9055c8 100644 --- a/src/physics/waccmx/steady_state_tei.F90 +++ b/src/physics/waccmx/steady_state_tei.F90 @@ -1,13 +1,13 @@ module steady_state_tei - use shr_kind_mod, only : r8 => shr_kind_r8 ! Real kind to declare variables - use physics_buffer, only : pbuf_get_index, & ! - physics_buffer_desc, & ! - pbuf_get_field, & ! Needed to access physics buffer - pbuf_set_field - use physics_types, only : physics_state ! Structures containing physics state variables - use ppgrid, only : pcols, pver, pverp, begchunk, endchunk - use cam_abortutils, only : endrun + use shr_kind_mod, only: r8 => shr_kind_r8 ! Real kind to declare variables + use physics_buffer, only: pbuf_get_index, & ! + physics_buffer_desc, & ! + pbuf_get_field, & ! Needed to access physics buffer + pbuf_set_field + use physics_types, only: physics_state ! Structures containing physics state variables + use ppgrid, only: pcols, pver, pverp, begchunk, endchunk + use cam_abortutils, only: endrun implicit none @@ -38,10 +38,10 @@ subroutine steady_state_tei_init(pbuf2d) ! Time independent initialization for ionosphere simulation. !----------------------------------------------------------------------- - use constituents, only : cnst_get_ind - use mo_chem_utls, only : get_spc_ndx ! Routine to get index of adv_mass array for short lived species - use chem_mods, only : adv_mass ! Array holding mass values for short lived species - use infnan, only: nan, assignment(=) + use constituents, only: cnst_get_ind + use mo_chem_utls, only: get_spc_ndx ! Routine to get index of adv_mass array for short lived species + use chem_mods, only: adv_mass ! Array holding mass values for short lived species + use infnan, only: nan, assignment(=) type(physics_buffer_desc), pointer :: pbuf2d(:,:) real(r8) :: nanval @@ -69,12 +69,12 @@ end subroutine steady_state_tei_init !============================================================================== subroutine steady_state_tei_tend(state,istate, dse_tend, pbuf) - use tei_mod, only : settei - use physconst, only : mbarv ! Constituent dependent mbar - use solar_parms_data, only : f107=>solar_parms_f107 ! 10.7 cm solar flux - use mo_apex, only : alatm - use perf_mod, only : t_startf, t_stopf ! timing utils - use ionos_state_mod, only : ionos_state + use tei_mod, only: settei + use air_composition, only: mbarv ! Constituent dependent mbar + use solar_parms_data, only: f107=>solar_parms_f107 ! 10.7 cm solar flux + use mo_apex, only: alatm + use perf_mod, only: t_startf, t_stopf ! timing utils + use ionos_state_mod, only: ionos_state !------------------------------------------------------------------------------------- ! Calculate dry static energy and O+ tendency for extended ionosphere simulation !------------------------------------------------------------------------------------- diff --git a/src/utils/air_composition.F90 b/src/utils/air_composition.F90 new file mode 100644 index 0000000000..6046ffebf1 --- /dev/null +++ b/src/utils/air_composition.F90 @@ -0,0 +1,1202 @@ +! air_composition module defines major species of the atmosphere and manages +! the physical properties that are dependent on the composition of air +module air_composition + + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + + implicit none + private + save + + public :: air_composition_readnl + public :: air_composition_init + public :: dry_air_composition_update + public :: water_composition_update + + ! get_cp_dry: (generalized) heat capacity for dry air + public :: get_cp_dry + ! get_cp: (generalized) heat capacity + public :: get_cp + ! get_R_dry: (generalized) dry air gas constant + public :: get_R_dry + ! get_R: Compute generalized R + public :: get_R + ! get_mbarv: molecular weight of dry air + public :: get_mbarv + + private :: air_species_info + + integer, parameter :: unseti = -HUGE(1) + real(r8), parameter :: unsetr = HUGE(1.0_r8) + + ! composition of air + ! + integer, parameter :: num_names_max = 20 ! Should match namelist definition + character(len=6) :: dry_air_species(num_names_max) + character(len=6) :: water_species_in_air(num_names_max) + + integer, protected, public :: dry_air_species_num + integer, protected, public :: water_species_in_air_num + + ! Thermodynamic variables + integer, protected, public :: thermodynamic_active_species_num = unseti + integer, allocatable, protected, public :: thermodynamic_active_species_idx(:) + integer, allocatable, public :: thermodynamic_active_species_idx_dycore(:) + real(r8), allocatable, protected, public :: thermodynamic_active_species_cp(:) + real(r8), allocatable, protected, public :: thermodynamic_active_species_cv(:) + real(r8), allocatable, protected, public :: thermodynamic_active_species_R(:) + ! thermodynamic_active_species_mwi: inverse molecular weights dry air + real(r8), allocatable, protected, public :: thermodynamic_active_species_mwi(:) + ! thermodynamic_active_species_kv: molecular diffusion + real(r8), allocatable, protected, public :: thermodynamic_active_species_kv(:) + ! thermodynamic_active_species_kc: thermal conductivity + real(r8), allocatable, protected, public :: thermodynamic_active_species_kc(:) + ! + ! for energy computations liquid and ice species need to be identified + ! + ! thermodynamic_active_species_liq_num: number of liquid water species + integer, protected, public :: thermodynamic_active_species_liq_num = unseti + ! thermodynamic_active_species_ice_num: number of frozen water species + integer, protected, public :: thermodynamic_active_species_ice_num = unseti + ! thermodynamic_active_species_liq_idx: index of liquid water species + integer, allocatable, protected, public :: thermodynamic_active_species_liq_idx(:) + ! thermodynamic_active_species_liq_idx_dycore: index of liquid water species + integer, allocatable, public :: thermodynamic_active_species_liq_idx_dycore(:) + ! thermodynamic_active_species_ice_idx: index of ice water species + integer, allocatable, protected, public :: thermodynamic_active_species_ice_idx(:) + ! thermodynamic_active_species_ice_idx_dycore: index of ice water species + integer, allocatable, public :: thermodynamic_active_species_ice_idx_dycore(:) + ! enthalpy_reference_state: choices: 'ice', 'liq', 'wv' + character(len=3), public, protected :: enthalpy_reference_state = 'xxx' + + integer, protected, public :: wv_idx = -1 ! Water vapor index + + !------------- Variables for consistent themodynamics -------------------- + ! + + ! standard dry air (constant composition) + real(r8), public, protected :: mmro2 = unsetr ! Mass mixing ratio of O2 + real(r8), public, protected :: mmrn2 = unsetr ! Mass mixing ratio of N2 + real(r8), public, protected :: o2_mwi = unsetr ! Inverse mol. weight of O2 + real(r8), public, protected :: n2_mwi = unsetr ! Inverse mol. weight of N2 + real(r8), public, protected :: mbar = unsetr ! Mean mass at mid level + + ! coefficients in expressions for molecular diffusion coefficients + ! kv1,..,kv3 are coefficients for kmvis calculation + ! kc1,..,kc3 are coefficients for kmcnd calculation + ! Liu, H.-L., et al. (2010), Thermosphere extension of the Whole Atmosphere Community Climate Model, + ! J. Geophys. Res., 115, A12302, doi:10.1029/2010JA015586. + real(r8), public, parameter :: kv1 = 4.03_r8 * 1.e-7_r8 + real(r8), public, parameter :: kv2 = 3.42_r8 * 1.e-7_r8 + real(r8), public, parameter :: kv3 = 3.9_r8 * 1.e-7_r8 + real(r8), public, parameter :: kc1 = 56._r8 * 1.e-5_r8 + real(r8), public, parameter :: kc2 = 56._r8 * 1.e-5_r8 + real(r8), public, parameter :: kc3 = 75.9_r8 * 1.e-5_r8 + + real(r8), public, parameter :: kv_temp_exp = 0.69_r8 + real(r8), public, parameter :: kc_temp_exp = 0.69_r8 + + ! cpairv: composition dependent specific heat at constant pressure + real(r8), public, protected, allocatable :: cpairv(:,:,:) + ! rairv: composition dependent gas "constant" + real(r8), public, protected, allocatable :: rairv(:,:,:) + ! cappav: rairv / cpairv + real(r8), public, protected, allocatable :: cappav(:,:,:) + ! mbarv: composition dependent atmosphere mean mass + real(r8), public, protected, allocatable :: mbarv(:,:,:) + ! cp_or_cv_dycore: enthalpy or internal energy scaling factor for + ! energy consistency + real(r8), public, protected, allocatable :: cp_or_cv_dycore(:,:,:) + ! + ! Interfaces for public routines + interface get_cp_dry + module procedure get_cp_dry_1hd + module procedure get_cp_dry_2hd + end interface get_cp_dry + + interface get_cp + module procedure get_cp_1hd + module procedure get_cp_2hd + end interface get_cp + + interface get_R_dry + module procedure get_R_dry_1hd + module procedure get_R_dry_2hd + end interface get_R_dry + + interface get_R + module procedure get_R_1hd + module procedure get_R_2hd + end interface get_R + + interface get_mbarv + module procedure get_mbarv_1hd + end interface get_mbarv + +CONTAINS + + ! Read namelist variables. + subroutine air_composition_readnl(nlfile) + use namelist_utils, only: find_group_name + use spmd_utils, only: masterproc, mpicom, masterprocid + use spmd_utils, only: mpi_character + use cam_logfile, only: iulog + + ! Dummy argument: filepath for file containing namelist input + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr, indx + integer, parameter :: lsize = 76 + character(len=*), parameter :: subname = 'air_composition_readnl :: ' + character(len=lsize) :: banner + character(len=lsize) :: bline + + ! Variable components of dry air and water species in air + namelist /air_composition_nl/ dry_air_species, water_species_in_air + !----------------------------------------------------------------------- + + banner = repeat('*', lsize) + bline = "***"//repeat(' ', lsize - 6)//"***" + + ! Read variable components of dry air and water species in air + dry_air_species = (/ (' ', indx = 1, num_names_max) /) + water_species_in_air = (/ (' ', indx = 1, num_names_max) /) + + if (masterproc) then + open(newunit=unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'air_composition_nl', status=ierr) + if (ierr == 0) then + read(unitn, air_composition_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname//'ERROR reading namelist, air_composition_nl') + end if + end if + close(unitn) + end if + + call mpi_bcast(dry_air_species, len(dry_air_species)*num_names_max, & + mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: dry_air_species") + call mpi_bcast(water_species_in_air, & + len(water_species_in_air)*num_names_max, mpi_character, & + masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: water_species_in_air") + + dry_air_species_num = 0 + water_species_in_air_num = 0 + do indx = 1, num_names_max + if ( (LEN_TRIM(dry_air_species(indx)) > 0) .and. & + (TRIM(dry_air_species(indx)) /= 'N2')) then + dry_air_species_num = dry_air_species_num + 1 + end if + if (LEN_TRIM(water_species_in_air(indx)) > 0) then + water_species_in_air_num = water_species_in_air_num + 1 + end if + end do + + ! Initialize number of thermodynamically active species + thermodynamic_active_species_num = & + dry_air_species_num + water_species_in_air_num + + if (masterproc) then + write(iulog, *) banner + write(iulog, *) bline + + if (dry_air_species_num == 0) then + write(iulog, *) " Thermodynamic properties of dry air are ", & + "fixed at troposphere values" + else + write(iulog, *) " Thermodynamic properties of dry air are ", & + "based on variable composition of the following species:" + do indx = 1, dry_air_species_num + write(iulog, *) ' ', trim(dry_air_species(indx)) + end do + write(iulog,*) ' ' + end if + write(iulog,*) " Thermodynamic properties of moist air are ", & + "based on variable composition of the following water species:" + do indx = 1, water_species_in_air_num + write(iulog, *) ' ', trim(water_species_in_air(indx)) + end do + write(iulog, *) bline + write(iulog, *) banner + end if + + end subroutine air_composition_readnl + + !=========================================================================== + + subroutine air_composition_init() + use string_utils, only: int2str + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use physconst, only: r_universal, cpair, rair, cpwv, rh2o, cpliq, cpice, mwdry + use constituents, only: cnst_get_ind, cnst_mw + use ppgrid, only: pcols, pver, begchunk, endchunk + integer :: icnst, ix, isize, ierr, idx + integer :: liq_num, ice_num + integer :: liq_idx(water_species_in_air_num) + integer :: ice_idx(water_species_in_air_num) + logical :: has_liq, has_ice + real(r8) :: mw + + character(len=*), parameter :: subname = 'composition_init' + character(len=*), parameter :: errstr = subname//": failed to allocate " + + ! + ! define cp and R for species in species_name + ! + ! Last major species in namelist dry_air_species is derived from the + ! other major species (since the sum of dry mixing ratios for + ! major species of dry air add must add to one) + ! + ! cv = R * dofx / 2; cp = R * (1 + (dofx / 2)) + ! DOF == Degrees of Freedom + ! dof1 = monatomic ideal gas, 3 translational DOF + real(r8), parameter :: dof1 = 3._r8 + real(r8), parameter :: cv1 = 0.5_r8 * r_universal * dof1 + real(r8), parameter :: cp1 = 0.5_r8 * r_universal * (2._r8 + dof1) + ! dof2 = diatomic ideal gas, 3 translational + 2 rotational = 5 DOF + real(r8), parameter :: dof2 = 5._r8 + real(r8), parameter :: cv2 = 0.5_r8 * r_universal * dof2 + real(r8), parameter :: cp2 = 0.5_r8 * r_universal * (2._r8 + dof2) + ! dof3 = polyatomic ideal gas, 3 translational + 3 rotational = 6 DOF + real(r8), parameter :: dof3 = 6._r8 + real(r8), parameter :: cv3 = 0.5_r8 * r_universal * dof3 + real(r8), parameter :: cp3 = 0.5_r8 * r_universal * (2._r8 + dof3) + + liq_num = 0 + ice_num = 0 + has_liq = .false. + has_ice = .false. + ! standard dry air (constant composition) + o2_mwi = 1._r8 / 32._r8 + n2_mwi = 1._r8 / 28._r8 + mmro2 = 0.235_r8 + mmrn2 = 0.765_r8 + mbar = 1._r8 / ((mmro2 * o2_mwi) + (mmrn2 * n2_mwi)) + + ! init for variable composition dry air + + isize = dry_air_species_num + water_species_in_air_num + allocate(thermodynamic_active_species_idx(isize), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"thermodynamic_active_species_idx") + end if + allocate(thermodynamic_active_species_idx_dycore(isize), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"thermodynamic_active_species_idx_dycore") + end if + allocate(thermodynamic_active_species_cp(0:isize), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"thermodynamic_active_species_cp") + end if + allocate(thermodynamic_active_species_cv(0:isize), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"thermodynamic_active_species_cv") + end if + allocate(thermodynamic_active_species_R(0:isize), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"thermodynamic_active_species_R") + end if + + isize = dry_air_species_num + allocate(thermodynamic_active_species_mwi(0:isize), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"thermodynamic_active_species_mwi") + end if + allocate(thermodynamic_active_species_kv(0:isize), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"thermodynamic_active_species_kv") + end if + allocate(thermodynamic_active_species_kc(0:isize), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"thermodynamic_active_species_kc") + end if + !------------------------------------------------------------------------ + ! Allocate constituent dependent properties + !------------------------------------------------------------------------ + allocate(cpairv(pcols,pver,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"cpairv") + end if + allocate(rairv(pcols,pver,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"rairv") + end if + allocate(cappav(pcols,pver,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"cappav") + end if + allocate(mbarv(pcols,pver,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"mbarv") + end if + allocate(cp_or_cv_dycore(pcols,pver,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"cp_or_cv_dycore") + end if + + thermodynamic_active_species_idx = -HUGE(1) + thermodynamic_active_species_idx_dycore = -HUGE(1) + thermodynamic_active_species_cp = 0.0_r8 + thermodynamic_active_species_cv = 0.0_r8 + thermodynamic_active_species_R = 0.0_r8 + thermodynamic_active_species_mwi = 0.0_r8 + thermodynamic_active_species_kv = 0.0_r8 + thermodynamic_active_species_kc = 0.0_r8 + !------------------------------------------------------------------------ + ! Initialize constituent dependent properties + !------------------------------------------------------------------------ + cpairv(:pcols, :pver, begchunk:endchunk) = cpair + rairv(:pcols, :pver, begchunk:endchunk) = rair + cappav(:pcols, :pver, begchunk:endchunk) = rair / cpair + mbarv(:pcols, :pver, begchunk:endchunk) = mwdry + ! + if (dry_air_species_num > 0) then + ! + ! The last major species in dry_air_species is derived from the + ! others and constants associated with it are initialized here + ! + if (TRIM(dry_air_species(dry_air_species_num + 1)) == 'N2') then + call air_species_info('N', ix, mw) + mw = 2.0_r8 * mw + icnst = 0 ! index for the derived tracer N2 + thermodynamic_active_species_cp(icnst) = cp2 / mw + thermodynamic_active_species_cv(icnst) = cv2 / mw !N2 + thermodynamic_active_species_R (icnst) = r_universal / mw + thermodynamic_active_species_mwi(icnst) = 1.0_r8 / mw + thermodynamic_active_species_kv(icnst) = kv2 + thermodynamic_active_species_kc(icnst) = kc2 + ! + ! if last major species is not N2 then add code here + ! + else + write(iulog, *) subname, ' derived major species not found: ', & + dry_air_species(dry_air_species_num) + call endrun(subname//': derived major species not found') + end if + else + ! + ! dry air is not species dependent + ! + icnst = 0 + thermodynamic_active_species_cp (icnst) = cpair + thermodynamic_active_species_cv (icnst) = cpair - rair + thermodynamic_active_species_R (icnst) = rair + end if + ! + !************************************************************************ + ! + ! add prognostic components of dry air + ! + !************************************************************************ + ! + icnst = 1 + do idx = 1, dry_air_species_num + select case (TRIM(dry_air_species(idx))) + ! + ! O + ! + case('O') + call air_species_info('O', ix, mw) + thermodynamic_active_species_idx(icnst) = ix + thermodynamic_active_species_cp (icnst) = cp1 / mw + thermodynamic_active_species_cv (icnst) = cv1 / mw + thermodynamic_active_species_R (icnst) = r_universal / mw + thermodynamic_active_species_mwi(icnst) = 1.0_r8 / mw + thermodynamic_active_species_kv(icnst) = kv3 + thermodynamic_active_species_kc(icnst) = kc3 + icnst = icnst + 1 + ! + ! O2 + ! + case('O2') + call air_species_info('O2', ix, mw) + thermodynamic_active_species_idx(icnst) = ix + thermodynamic_active_species_cp (icnst) = cp2 / mw + thermodynamic_active_species_cv (icnst) = cv2 / mw + thermodynamic_active_species_R (icnst) = r_universal / mw + thermodynamic_active_species_mwi(icnst) = 1.0_r8 / mw + thermodynamic_active_species_kv(icnst) = kv1 + thermodynamic_active_species_kc(icnst) = kc1 + icnst = icnst + 1 + ! + ! H + ! + case('H') + call air_species_info('H', ix, mw) + thermodynamic_active_species_idx(icnst) = ix + thermodynamic_active_species_cp (icnst) = cp1 / mw + thermodynamic_active_species_cv (icnst) = cv1 / mw + thermodynamic_active_species_R (icnst) = r_universal / mw + thermodynamic_active_species_mwi(icnst) = 1.0_r8 / mw + ! Hydrogen not included in calculation of diffusivity and conductivity + thermodynamic_active_species_kv(icnst) = 0.0_r8 + thermodynamic_active_species_kc(icnst) = 0.0_r8 + icnst = icnst + 1 + ! + ! If support for more major species is to be included add code here + ! + case default + write(iulog, *) subname, ' dry air component not found: ', & + dry_air_species(idx) + call endrun(subname//': dry air component not found') + end select + + if (masterproc) then + write(iulog, *) "Dry air composition ", & + TRIM(dry_air_species(idx)), & + icnst-1,thermodynamic_active_species_idx(icnst-1), & + thermodynamic_active_species_mwi(icnst-1), & + thermodynamic_active_species_cp(icnst-1), & + thermodynamic_active_species_cv(icnst-1) + end if + end do + isize = dry_air_species_num+1 + icnst = 0 ! N2 + if(isize > 0) then + if(masterproc) then + write(iulog, *) "Dry air composition ", & + TRIM(dry_air_species(idx)), & + icnst, -1, thermodynamic_active_species_mwi(icnst), & + thermodynamic_active_species_cp(icnst), & + thermodynamic_active_species_cv(icnst) + end if + end if + ! + !************************************************************************ + ! + ! Add non-dry components of moist air (water vapor and condensates) + ! + !************************************************************************ + ! + icnst = dry_air_species_num + 1 + do idx = 1, water_species_in_air_num + select case (TRIM(water_species_in_air(idx))) + ! + ! Q + ! + case('Q') + call air_species_info('Q', ix, mw) + wv_idx = ix + thermodynamic_active_species_idx(icnst) = ix + thermodynamic_active_species_cp (icnst) = cpwv + thermodynamic_active_species_cv (icnst) = cv3 / mw + thermodynamic_active_species_R (icnst) = rh2o + icnst = icnst + 1 + ! + ! CLDLIQ + ! + case('CLDLIQ') + call air_species_info('CLDLIQ', ix, mw) + thermodynamic_active_species_idx(icnst) = ix + thermodynamic_active_species_cp (icnst) = cpliq + thermodynamic_active_species_cv (icnst) = cpliq + liq_num = liq_num+1 + liq_idx (liq_num) = ix + icnst = icnst + 1 + has_liq = .true. + ! + ! CLDICE + ! + case('CLDICE') + call air_species_info('CLDICE', ix, mw) + thermodynamic_active_species_idx(icnst) = ix + thermodynamic_active_species_cp (icnst) = cpice + thermodynamic_active_species_cv (icnst) = cpice + ice_num = ice_num+1 + ice_idx(ice_num) = ix + icnst = icnst + 1 + has_ice = .true. + ! + ! RAINQM + ! + case('RAINQM') + call air_species_info('RAINQM', ix, mw) + thermodynamic_active_species_idx(icnst) = ix + thermodynamic_active_species_cp (icnst) = cpliq + thermodynamic_active_species_cv (icnst) = cpliq + liq_num = liq_num+1 + liq_idx(liq_num) = ix + icnst = icnst + 1 + has_liq = .true. + ! + ! SNOWQM + ! + case('SNOWQM') + call air_species_info('SNOWQM', ix, mw) + thermodynamic_active_species_idx(icnst) = ix + thermodynamic_active_species_cp (icnst) = cpice + thermodynamic_active_species_cv (icnst) = cpice + ice_num = ice_num+1 + ice_idx(ice_num) = ix + icnst = icnst + 1 + has_ice = .true. + ! + ! GRAUQM + ! + case('GRAUQM') + call air_species_info('GRAUQM', ix, mw) + thermodynamic_active_species_idx(icnst) = ix + thermodynamic_active_species_cp (icnst) = cpice + thermodynamic_active_species_cv (icnst) = cpice + ice_num = ice_num+1 + ice_idx(ice_num) = ix + icnst = icnst + 1 + has_ice = .true. + ! + ! If support for more major species is to be included add code here + ! + case default + write(iulog, *) subname, ' moist air component not found: ', & + water_species_in_air(idx) + call endrun(subname//': moist air component not found') + end select + ! + ! + ! + if (masterproc) then + write(iulog, *) "Thermodynamic active species ", & + TRIM(water_species_in_air(idx)) + write(iulog, *) " global index : ", & + icnst-1 + write(iulog, *) " thermodynamic_active_species_idx : ", & + thermodynamic_active_species_idx(icnst-1) + write(iulog, *) " cp : ", & + thermodynamic_active_species_cp(icnst-1) + write(iulog, *) " cv : ", & + thermodynamic_active_species_cv(icnst-1) + if (has_liq) then + write(iulog, *) " register phase (liquid or ice) :", & + " liquid" + end if + if (has_ice) then + write(iulog, *) " register phase (liquid or ice) :", & + " ice" + end if + write(iulog, *) " " + end if + has_liq = .false. + has_ice = .false. + end do + + allocate(thermodynamic_active_species_liq_idx(liq_num), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"thermodynamic_active_species_liq_idx") + end if + allocate(thermodynamic_active_species_liq_idx_dycore(liq_num), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"thermodynamic_active_species_liq_idx_dycore") + end if + allocate(thermodynamic_active_species_ice_idx(ice_num), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"thermodynamic_active_species_ice_idx") + end if + allocate(thermodynamic_active_species_ice_idx_dycore(ice_num), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"thermodynamic_active_species_ice_idx_dycore") + end if + + thermodynamic_active_species_liq_idx = liq_idx(1:liq_num) + thermodynamic_active_species_liq_num = liq_num + + ! array initialized by the dycore + thermodynamic_active_species_liq_idx_dycore = -99 + + thermodynamic_active_species_ice_idx = ice_idx(1:ice_num) + thermodynamic_active_species_ice_num = ice_num + + ! array initialized by the dycore + thermodynamic_active_species_ice_idx_dycore = -99 + + if (water_species_in_air_num /= 1 + liq_num+ice_num) then + write(iulog, '(2a,2(i0,a))') subname, & + " water_species_in_air_num = ", & + water_species_in_air_num, ", should be ", & + (1 + liq_num + ice_num), " (1 + liq_num + ice_num)" + call endrun(subname//': water_species_in_air_num /= 1+liq_num+ice_num') + end if + enthalpy_reference_state = 'ice' + if (masterproc) then + write(iulog, *) 'Enthalpy reference state : ', & + TRIM(enthalpy_reference_state) + end if + end subroutine air_composition_init + + !=========================================================================== + !----------------------------------------------------------------------- + ! dry_air_composition_update: Update the physics "constants" that vary + !------------------------------------------------------------------------- + !=========================================================================== + + subroutine dry_air_composition_update(mmr, lchnk, ncol, to_dry_factor) + use cam_abortutils, only: endrun + !(mmr = dry mixing ratio, if not, use to_dry_factor to convert!) + real(r8), intent(in) :: mmr(:,:,:) ! mixing ratios for species dependent dry air + integer, intent(in) :: lchnk ! Chunk number + integer, intent(in) :: ncol ! number of columns + real(r8), optional, intent(in) :: to_dry_factor(:,:) + + call get_R_dry(mmr(:ncol, :, :), thermodynamic_active_species_idx, & + rairv(:ncol, :, lchnk), fact=to_dry_factor) + call get_cp_dry(mmr(:ncol,:,:), thermodynamic_active_species_idx, & + cpairv(:ncol,:,lchnk), fact=to_dry_factor) + call get_mbarv(mmr(:ncol,:,:), thermodynamic_active_species_idx, & + mbarv(:ncol,:,lchnk), fact=to_dry_factor) + cappav(:ncol,:,lchnk) = rairv(:ncol,:,lchnk) / cpairv(:ncol,:,lchnk) + end subroutine dry_air_composition_update + + !=========================================================================== + !--------------------------------------------------------------------------- + ! water_composition_update: Update generalized cp or cv depending on dycore + !--------------------------------------------------------------------------- + !=========================================================================== + + subroutine water_composition_update(mmr, lchnk, ncol, vcoord, to_dry_factor) + use cam_abortutils, only: endrun + use string_utils, only: int2str + use dyn_tests_utils, only: vc_height, vc_moist_pressure, vc_dry_pressure + real(r8), intent(in) :: mmr(:,:,:) ! constituents array + integer, intent(in) :: lchnk ! Chunk number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: vcoord + real(r8), optional, intent(in) :: to_dry_factor(:,:) + + character(len=*), parameter :: subname = 'water_composition_update' + + if (vcoord==vc_dry_pressure) then + call get_cp(mmr(:ncol,:,:),.false.,cp_or_cv_dycore(:ncol,:,lchnk), factor=to_dry_factor, & + active_species_idx_dycore=thermodynamic_active_species_idx,cpdry=cpairv(:ncol,:,lchnk)) + else if (vcoord==vc_height) then + call get_R(mmr(:ncol,:,:), thermodynamic_active_species_idx, & + cp_or_cv_dycore(:ncol,:,lchnk), fact=to_dry_factor, Rdry=rairv(:ncol,:,lchnk)) + ! + ! internal energy coefficient for MPAS + ! (equation 92 in Eldred et al. 2023; https://rmets.onlinelibrary.wiley.com/doi/epdf/10.1002/qj.4353) + ! + cp_or_cv_dycore(:ncol,:,lchnk)=cp_or_cv_dycore(:ncol,:,lchnk)*& + (cpairv(:ncol,:,lchnk)-rairv(:ncol,:,lchnk)) /rairv(:ncol,:,lchnk) + else if (vcoord==vc_moist_pressure) then + ! no update needed for moist pressure vcoord + else + call endrun(subname//" vertical coordinate not supported; vcoord="// int2str(vcoord)) + end if + end subroutine water_composition_update + + !=========================================================================== + !*************************************************************************** + ! + ! get_cp_dry: Compute dry air heat capacity under constant pressure + ! + !*************************************************************************** + ! + subroutine get_cp_dry_1hd(tracer, active_species_idx, cp_dry, fact) + use cam_abortutils, only: endrun + use string_utils, only: int2str + use physconst, only: cpair + + ! Dummy arguments + ! tracer: tracer array + real(r8), intent(in) :: tracer(:,:,:) + integer, intent(in) :: active_species_idx(:) + ! fact: optional dry pressure level thickness + real(r8), optional, intent(in) :: fact(:,:) + ! cp_dry: dry air heat capacity under constant pressure + real(r8), intent(out) :: cp_dry(:,:) + + ! Local variables + integer :: idx, kdx , m_cnst, qdx + ! factor: dry pressure level thickness + real(r8) :: factor(SIZE(cp_dry, 1), SIZE(cp_dry, 2)) + real(r8) :: residual(SIZE(cp_dry, 1), SIZE(cp_dry, 2)) + real(r8) :: mmr + character(len=*), parameter :: subname = 'get_cp_dry_1hd: ' + + if (dry_air_species_num == 0) then + ! dry air heat capacity not species dependent + cp_dry = cpair + else + ! dry air heat capacity is species dependent + if (present(fact)) then + if (SIZE(fact, 1) /= SIZE(factor, 1)) then + call endrun(subname//"SIZE mismatch in dimension 1 "// & + int2str(SIZE(fact, 1))//' /= '//int2str(SIZE(factor, 1))) + end if + if (SIZE(fact, 2) /= SIZE(factor, 2)) then + call endrun(subname//"SIZE mismatch in dimension 2 "// & + int2str(SIZE(fact, 2))//' /= '//int2str(SIZE(factor, 2))) + end if + factor = fact(:,:) + else + factor = 1.0_r8 + end if + + cp_dry = 0.0_r8 + residual = 1.0_r8 + do qdx = 1, dry_air_species_num + m_cnst = active_species_idx(qdx) + do kdx = 1, SIZE(cp_dry, 2) + do idx = 1, SIZE(cp_dry, 1) + mmr = tracer(idx, kdx, m_cnst) * factor(idx, kdx) + cp_dry(idx, kdx) = cp_dry(idx, kdx) + & + (thermodynamic_active_species_cp(qdx) * mmr) + residual(idx, kdx) = residual(idx, kdx) - mmr + end do + end do + end do + qdx = 0 ! N2 + do kdx = 1, SIZE(cp_dry, 2) + do idx = 1, SIZE(cp_dry, 1) + cp_dry(idx, kdx) = cp_dry(idx, kdx) + & + (thermodynamic_active_species_cp(qdx) * residual(idx, kdx)) + end do + end do + end if + end subroutine get_cp_dry_1hd + + !=========================================================================== + + subroutine get_cp_dry_2hd(tracer, active_species_idx, cp_dry, fact) + ! Version of get_cp_dry for arrays that have a second horizontal index + + ! Dummy arguments + ! tracer: tracer array + real(r8), intent(in) :: tracer(:,:,:,:) + integer, intent(in) :: active_species_idx(:) + ! fact: optional dry pressure level thickness + real(r8), optional, intent(in) :: fact(:,:,:) + ! cp_dry: dry air heat capacity under constant pressure + real(r8), intent(out) :: cp_dry(:,:,:) + + ! Local variable + integer :: jdx + + do jdx = 1, SIZE(cp_dry, 2) + if (present(fact)) then + call get_cp_dry(tracer(:,jdx,:,:), active_species_idx, & + cp_dry(:,jdx,:), fact=fact(:,jdx,:)) + else + call get_cp_dry(tracer(:,jdx,:,:), active_species_idx, & + cp_dry(:,jdx,:)) + end if + end do + + end subroutine get_cp_dry_2hd + + !=========================================================================== + ! + !*************************************************************************** + ! + ! get_cp: Compute generalized heat capacity at constant pressure + ! + !*************************************************************************** + ! + subroutine get_cp_1hd(tracer, inv_cp, cp, factor, active_species_idx_dycore, cpdry) + use cam_abortutils, only: endrun + use string_utils, only: int2str + + ! Dummy arguments + ! tracer: Tracer array + ! + ! factor not present then tracer must be dry mixing ratio + ! if factor present tracer*factor must be dry mixing ratio + ! + real(r8), intent(in) :: tracer(:,:,:) + ! inv_cp: output inverse cp instead of cp + logical, intent(in) :: inv_cp + real(r8), intent(out) :: cp(:,:) + ! dp: if provided then tracer is mass not mixing ratio + real(r8), optional, intent(in) :: factor(:,:) + ! active_species_idx_dycore: array of indices for index of + ! thermodynamic active species in dycore tracer array + ! (if different from physics index) + integer, optional, intent(in) :: active_species_idx_dycore(:) + real(r8),optional, intent(in) :: cpdry(:,:) + + ! LOCAL VARIABLES + integer :: qdx, itrac + real(r8) :: sum_species(SIZE(cp, 1), SIZE(cp, 2)) + real(r8) :: sum_cp(SIZE(cp, 1), SIZE(cp, 2)) + real(r8) :: factor_local(SIZE(cp, 1), SIZE(cp, 2)) + integer :: idx_local(thermodynamic_active_species_num) + character(LEN=*), parameter :: subname = 'get_cp_1hd: ' + + if (present(active_species_idx_dycore)) then + if (SIZE(active_species_idx_dycore) /= & + thermodynamic_active_species_num) then + call endrun(subname//"SIZE mismatch "// & + int2str(SIZE(active_species_idx_dycore))//' /= '// & + int2str(thermodynamic_active_species_num)) + end if + idx_local = active_species_idx_dycore + else + idx_local = thermodynamic_active_species_idx + end if + + if (present(factor)) then + factor_local = factor + else + factor_local = 1.0_r8 + end if + + sum_species = 1.0_r8 ! all dry air species sum to 1 + do qdx = dry_air_species_num + 1, thermodynamic_active_species_num + itrac = idx_local(qdx) + sum_species(:,:) = sum_species(:,:) + (tracer(:,:,itrac) * factor_local(:,:)) + end do + + if (dry_air_species_num == 0) then + sum_cp = thermodynamic_active_species_cp(0) + else if (present(cpdry)) then + ! + ! if cpdry is known don't recompute + ! + sum_cp = cpdry + else + call get_cp_dry(tracer, idx_local, sum_cp, fact=factor_local) + end if + do qdx = dry_air_species_num + 1, thermodynamic_active_species_num + itrac = idx_local(qdx) + sum_cp(:,:) = sum_cp(:,:)+ & + thermodynamic_active_species_cp(qdx) * tracer(:,:,itrac)* factor_local(:,:) + end do + if (inv_cp) then + cp = sum_species / sum_cp + else + cp = sum_cp / sum_species + end if + end subroutine get_cp_1hd + + !=========================================================================== + + subroutine get_cp_2hd(tracer, inv_cp, cp, factor, active_species_idx_dycore, cpdry) + ! Version of get_cp for arrays that have a second horizontal index + use cam_abortutils, only: endrun + use string_utils, only: int2str + + ! Dummy arguments + ! tracer: Tracer array + ! + real(r8), intent(in) :: tracer(:,:,:,:) + ! inv_cp: output inverse cp instead of cp + logical, intent(in) :: inv_cp + real(r8), intent(out) :: cp(:,:,:) + real(r8), optional, intent(in) :: factor(:,:,:) + real(r8), optional, intent(in) :: cpdry(:,:,:) + + ! active_species_idx_dycore: array of indicies for index of + ! thermodynamic active species in dycore tracer array + ! (if different from physics index) + integer, optional, intent(in) :: active_species_idx_dycore(:) + + ! Local variables + integer :: jdx + integer :: idx_local(thermodynamic_active_species_num) + character(len=*), parameter :: subname = 'get_cp_2hd: ' + + do jdx = 1, SIZE(cp, 2) + if (present(factor).and.present(cpdry)) then + call get_cp(tracer(:, jdx, :, :), inv_cp, cp(:, jdx, :),& + factor=factor(:, jdx, :), active_species_idx_dycore=active_species_idx_dycore, cpdry=cpdry(:,jdx,:)) + else if (present(factor)) then + call get_cp(tracer(:, jdx, :, :), inv_cp, cp(:, jdx, :),& + factor=factor(:, jdx, :), active_species_idx_dycore=active_species_idx_dycore) + else if (present(cpdry)) then + call get_cp(tracer(:, jdx, :, :), inv_cp, cp(:, jdx, :),& + active_species_idx_dycore=active_species_idx_dycore, cpdry=cpdry(:,jdx,:)) + else + call get_cp(tracer(:, jdx, :, :), inv_cp, cp(:, jdx, :),& + active_species_idx_dycore=active_species_idx_dycore) + end if + end do + + end subroutine get_cp_2hd + + !=========================================================================== + + !*************************************************************************** + ! + ! get_R_dry: Compute generalized dry air gas constant R + ! + !*************************************************************************** + ! + subroutine get_R_dry_1hd(tracer, active_species_idx_dycore, R_dry, fact) + use physconst, only: rair + + ! tracer: tracer array + real(r8), intent(in) :: tracer(:, :, :) + ! active_species_idx_dycore: index of active species in tracer + integer, intent(in) :: active_species_idx_dycore(:) + ! R_dry: dry air R + real(r8), intent(out) :: R_dry(:, :) + ! fact: optional factor for converting tracer to dry mixing ratio + real(r8), optional, intent(in) :: fact(:, :) + + ! Local variables + integer :: idx, kdx, m_cnst, qdx + real(r8) :: factor(SIZE(tracer, 1), SIZE(tracer, 2)) + real(r8) :: residual(SIZE(R_dry, 1), SIZE(R_dry, 2)) + real(r8) :: mmr + + if (dry_air_species_num == 0) then + ! + ! dry air not species dependent + ! + R_dry = rair + else + if (present(fact)) then + factor = fact(:,:) + else + factor = 1.0_r8 + end if + + R_dry = 0.0_r8 + residual = 1.0_r8 + do qdx = 1, dry_air_species_num + m_cnst = active_species_idx_dycore(qdx) + do kdx = 1, SIZE(R_dry, 2) + do idx = 1, SIZE(R_dry, 1) + mmr = tracer(idx, kdx, m_cnst) * factor(idx, kdx) + R_dry(idx, kdx) = R_dry(idx, kdx) + & + (thermodynamic_active_species_R(qdx) * mmr) + residual(idx, kdx) = residual(idx, kdx) - mmr + end do + end do + end do + ! + ! N2 derived from the others + ! + qdx = 0 + do kdx = 1, SIZE(R_dry, 2) + do idx = 1, SIZE(R_dry, 1) + R_dry(idx, kdx) = R_dry(idx, kdx) + & + (thermodynamic_active_species_R(qdx) * residual(idx, kdx)) + end do + end do + end if + end subroutine get_R_dry_1hd + + !=========================================================================== + + subroutine get_R_dry_2hd(tracer, active_species_idx_dycore, R_dry, fact) + ! Version of get_R_dry for arrays that have a second horizontal index + + ! tracer: tracer array + real(r8), intent(in) :: tracer(:, :, :, :) + ! active_species_idx_dycore: index of active species in tracer + integer, intent(in) :: active_species_idx_dycore(:) + ! R_dry: dry air R + real(r8), intent(out) :: R_dry(:, :, :) + ! fact: optional factor for converting tracer to dry mixing ratio + real(r8), optional, intent(in) :: fact(:, :, :) + + ! Local variable + integer :: jdx + + do jdx = 1, SIZE(tracer, 2) + if (present(fact)) then + call get_R_dry(tracer(:, jdx, :, :), active_species_idx_dycore, & + R_dry(:, jdx, :), fact=fact(:, jdx, :)) + else + call get_R_dry(tracer(:, jdx, :, :), active_species_idx_dycore, & + R_dry(:, jdx, :)) + end if + end do + + end subroutine get_R_dry_2hd + + !=========================================================================== + ! + !*************************************************************************** + ! + ! get_R: Compute generalized R + ! This code (both 1hd and 2hd) is currently unused and untested + ! + !*************************************************************************** + ! + subroutine get_R_1hd(tracer, active_species_idx, R, fact, Rdry) + use cam_abortutils, only: endrun + use string_utils, only: int2str + use physconst, only: rair + + ! Dummy arguments + ! tracer: !tracer array + real(r8), intent(in) :: tracer(:, :, :) + ! active_species_idx: index of active species in tracer + integer, intent(in) :: active_species_idx(:) + ! R: generalized gas constant + real(r8), intent(out) :: R(:, :) + ! fact: optional factor for converting tracer to dry mixing ratio + real(r8), optional, intent(in) :: fact(:, :) + real(r8), optional, intent(in) :: Rdry(:, :) + + ! Local variables + integer :: qdx, itrac + real(r8) :: factor(SIZE(tracer, 1), SIZE(tracer, 2)) + real(r8) :: sum_species(SIZE(R, 1), SIZE(R, 2)) + integer :: idx_local(thermodynamic_active_species_num) + + character(len=*), parameter :: subname = 'get_R_1hd: ' + + if (present(fact)) then + if (SIZE(fact, 1) /= SIZE(factor, 1)) then + call endrun(subname//"SIZE mismatch in dimension 1 "// & + int2str(SIZE(fact, 1))//' /= '//int2str(SIZE(factor, 1))) + end if + if (SIZE(fact, 2) /= SIZE(factor, 2)) then + call endrun(subname//"SIZE mismatch in dimension 2 "// & + int2str(SIZE(fact, 2))//' /= '//int2str(SIZE(factor, 2))) + end if + factor = fact(:,:) + else + factor = 1.0_r8 + end if + + if (dry_air_species_num == 0) then + R = rair + else if (present(Rdry)) then + R = Rdry + else + call get_R_dry(tracer, active_species_idx, R, fact=factor) + end if + + idx_local = active_species_idx + sum_species = 1.0_r8 ! all dry air species sum to 1 + do qdx = dry_air_species_num + 1, thermodynamic_active_species_num + itrac = idx_local(qdx) + sum_species(:,:) = sum_species(:,:) + & + (tracer(:,:,itrac) * factor(:,:)) + end do + do qdx = dry_air_species_num + 1, thermodynamic_active_species_num + itrac = idx_local(qdx) + R(:,:) = R(:,:) + & + (thermodynamic_active_species_R(qdx) * tracer(:,:,itrac) * & + factor(:,:)) + end do + R = R / sum_species + end subroutine get_R_1hd + + !=========================================================================== + + subroutine get_R_2hd(tracer, active_species_idx, R, fact) + + ! Dummy arguments + ! tracer: !tracer array + real(r8), intent(in) :: tracer(:, :, :, :) + ! active_species_idx: index of active species in tracer + integer, intent(in) :: active_species_idx(:) + ! R: generalized gas constant + real(r8), intent(out) :: R(:, :, :) + ! fact: optional factor for converting tracer to dry mixing ratio + real(r8), optional, intent(in) :: fact(:, :, :) + + ! Local variable + integer :: jdx + + do jdx = 1, SIZE(tracer, 2) + if (present(fact)) then + call get_R(tracer(:, jdx, :, :), active_species_idx, & + R(:, jdx, :), fact=fact(:, jdx, :)) + else + call get_R(tracer(:, jdx, :, :), active_species_idx, & + R(:, jdx, :)) + end if + end do + + end subroutine get_R_2hd + + !=========================================================================== + + !************************************************************************************************************************* + ! + ! compute molecular weight dry air + ! + !************************************************************************************************************************* + ! + subroutine get_mbarv_1hd(tracer, active_species_idx, mbarv_in, fact) + use physconst, only: mwdry + real(r8), intent(in) :: tracer(:,:,:) !tracer array + integer, intent(in) :: active_species_idx(:) !index of active species in tracer + real(r8), intent(out) :: mbarv_in(:,:) !molecular weight of dry air + real(r8), optional, intent(in) :: fact(:,:) !factor for converting tracer to dry mixing ratio + + integer :: idx, kdx, m_cnst, qdx + real(r8):: factor(SIZE(mbarv_in, 1), SIZE(mbarv_in, 2)) + real(r8):: residual(SIZE(tracer, 1), SIZE(mbarv_in, 2)) + real(r8):: mm + ! + ! dry air not species dependent + ! + if (dry_air_species_num==0) then + mbarv_in = mwdry + else + if (present(fact)) then + factor(:,:) = fact(:,:) + else + factor(:,:) = 1.0_r8 + endif + + mbarv_in = 0.0_r8 + residual = 1.0_r8 + do qdx = 1, dry_air_species_num + m_cnst = active_species_idx(qdx) + do kdx = 1, SIZE(mbarv_in, 2) + do idx = 1, SIZE(mbarv_in, 1) + mm = tracer(idx, kdx, m_cnst) * factor(idx, kdx) + mbarv_in(idx, kdx) = mbarv_in(idx, kdx) + thermodynamic_active_species_mwi(qdx) * mm + residual(idx, kdx) = residual(idx, kdx) - mm + end do + end do + end do + qdx = 0 ! N2 + do kdx = 1, SIZE(mbarv_in, 2) + do idx = 1, SIZE(mbarv_in, 1) + mbarv_in(idx, kdx) = mbarv_in(idx, kdx) + thermodynamic_active_species_mwi(qdx) * residual(idx, kdx) + end do + end do + mbarv_in(:,:) = 1.0_r8 / mbarv_in(:,:) + end if + end subroutine get_mbarv_1hd + + !=========================================================================== + + subroutine air_species_info(name, index, molec_weight, caller) + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use constituents, only: cnst_get_ind, cnst_mw + ! Find the constituent index of and return it in + ! . Return the constituent molecular weight in + ! + + ! Dummy arguments + character(len=*), intent(in) :: name + integer, intent(out) :: index + real(r8), intent(out) :: molec_weight + character(len=*), optional, intent(in) :: caller + ! Local parameter + character(len=*), parameter :: subname = 'air_species_info: ' + + call cnst_get_ind(trim(name), index, abort=.false.) + if (index < 1) then + if (present(caller)) then + write(iulog, *) trim(caller), ": air component not found, '", & + trim(name), "'" + call endrun(trim(caller)//": air component not found, '"// & + trim(name)//"'") + else + write(iulog, *) subname, "air component not found, '", & + trim(name), "'" + call endrun(subname//"air component not found, '"// & + trim(name)//"'") + end if + else + molec_weight = cnst_mw(index) + end if + + end subroutine air_species_info + + +end module air_composition diff --git a/src/utils/cam_abortutils.F90 b/src/utils/cam_abortutils.F90 index 33c1128262..16d2b3f885 100644 --- a/src/utils/cam_abortutils.F90 +++ b/src/utils/cam_abortutils.F90 @@ -1,11 +1,31 @@ module cam_abortutils - use shr_sys_mod, only: endrun => shr_sys_abort + use shr_kind_mod, only: SHR_KIND_CL + use shr_sys_mod, only: endrun => shr_sys_abort - implicit none - private - save + implicit none + private + save - public :: endrun + public :: endrun + public :: handle_allocate_error + +CONTAINS + + subroutine handle_allocate_error(retval, subname, fieldname) + ! if is not zero, generate an error message and abort + ! Dummy arguments + integer, intent(in) :: retval + character(len=*), intent(in) :: subname + character(len=*), intent(in) :: fieldname + ! Local variable + character(len=SHR_KIND_CL) :: errmsg + + if (retval /= 0) then + write(errmsg, '(4a,i0)') trim(subname), ' error allocating ', & + trim(fieldname), ', error = ', retval + call endrun(errmsg) + end if + end subroutine handle_allocate_error end module cam_abortutils diff --git a/src/utils/cam_ccpp/ccpp_constituent_prop_mod.F90 b/src/utils/cam_ccpp/ccpp_constituent_prop_mod.F90 new file mode 100644 index 0000000000..29ae61fc53 --- /dev/null +++ b/src/utils/cam_ccpp/ccpp_constituent_prop_mod.F90 @@ -0,0 +1,278 @@ +! This module is the CAM version of the CCPP generated module of the same name +module ccpp_constituent_prop_mod + + implicit none + private + + ! Define CAM version of constituent properties mod + type, public :: ccpp_constituent_prop_ptr_t + logical, private :: thermo_active = .false. + logical, private :: water_species = .false. + logical, private :: species_is_dry + character(len=256) :: std_name = '' + + contains + procedure :: standard_name => ccp_get_standard_name + procedure :: set_standard_name => ccp_set_standard_name + procedure :: is_thermo_active => ccp_is_thermo_active + procedure :: is_water_species => ccp_is_water_species + procedure :: set_thermo_active => ccp_set_thermo_active + procedure :: set_water_species => ccp_set_water_species + procedure :: is_dry => ccp_is_dry + procedure :: set_dry => ccp_set_dry + + end type ccpp_constituent_prop_ptr_t + + ! CCPP properties init routine + public :: ccpp_const_props_init + + ! Public properties DDT variable: + type(ccpp_constituent_prop_ptr_t), allocatable, public :: ccpp_const_props(:) + +contains + +!+++++++++++++++++++++++++++++++++++++++ +!CCPP constituent properties DDT methods +!+++++++++++++++++++++++++++++++++++++++ + + subroutine ccp_get_standard_name(this, std_name, errcode, errmsg) + ! Return this constituent's standard name + + ! Dummy arguments + class(ccpp_constituent_prop_ptr_t), intent(in) :: this + character(len=*), intent(out) :: std_name + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + + std_name = this%std_name + + ! Provide err values if requested: + if(present(errcode)) then + errcode = 0 + end if + if(present(errmsg)) then + errmsg = '' + end if + + end subroutine ccp_get_standard_name + + !------ + + subroutine ccp_set_standard_name(this, std_name, errcode, errmsg) + ! Set this constituent's standard name + + ! Dummy arguments + class(ccpp_constituent_prop_ptr_t), intent(inout) :: this + character(len=*), intent(in) :: std_name + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + + this%std_name = std_name + + ! Provide err values if requested: + if(present(errcode)) then + errcode = 0 + end if + if(present(errmsg)) then + errmsg = '' + end if + + end subroutine ccp_set_standard_name + + !------ + + subroutine ccp_is_thermo_active(this, val_out, errcode, errmsg) + + ! Dummy arguments + class(ccpp_constituent_prop_ptr_t), intent(in) :: this + logical, intent(out) :: val_out + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + + ! Pass back thermo active property: + val_out = this%thermo_active + + ! Provide err values if requested: + if(present(errcode)) then + errcode = 0 + end if + if(present(errmsg)) then + errmsg = '' + end if + + end subroutine ccp_is_thermo_active + + !------ + + subroutine ccp_is_water_species(this, val_out, errcode, errmsg) + + ! Dummy arguments + class(ccpp_constituent_prop_ptr_t), intent(in) :: this + logical, intent(out) :: val_out + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + + ! Pass back water species property: + val_out = this%water_species + + ! Provide err values if requested: + if(present(errcode)) then + errcode = 0 + end if + if(present(errmsg)) then + errmsg = '' + end if + + end subroutine ccp_is_water_species + + !------ + + subroutine ccp_is_dry(this, val_out, errcode, errmsg) + + ! Dummy arguments + class(ccpp_constituent_prop_ptr_t), intent(in) :: this + logical, intent(out) :: val_out + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + + ! Pass back water species property: + val_out = this%species_is_dry + + ! Provide err values if requested: + if(present(errcode)) then + errcode = 0 + end if + if(present(errmsg)) then + errmsg = '' + end if + + end subroutine ccp_is_dry + + !------ + + subroutine ccp_set_thermo_active(this, thermo_flag, errcode, errmsg) + ! Set whether this constituent is thermodynamically active, which + ! means that certain physics schemes will use this constitutent + ! when calculating thermodynamic quantities (e.g. enthalpy). + + ! Dummy arguments + class(ccpp_constituent_prop_ptr_t), intent(inout) :: this + logical, intent(in) :: thermo_flag + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + + ! Set thermodynamically active flag for this constituent: + this%thermo_active = thermo_flag + + ! Provide err values if requested: + if(present(errcode)) then + errcode = 0 + end if + if(present(errmsg)) then + errmsg = '' + end if + + end subroutine ccp_set_thermo_active + + !------ + + subroutine ccp_set_water_species(this, water_flag, errcode, errmsg) + ! Set whether this constituent is a water species, which means + ! that this constituent represents a particular phase or type + ! of water in the atmosphere. + + ! Dummy arguments + class(ccpp_constituent_prop_ptr_t), intent(inout) :: this + logical, intent(in) :: water_flag + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + + ! Set thermodynamically active flag for this constituent: + this%water_species = water_flag + + ! Provide err values if requested: + if(present(errcode)) then + errcode = 0 + end if + if(present(errmsg)) then + errmsg = '' + end if + + end subroutine ccp_set_water_species + + subroutine ccp_set_dry(this, dry_flag, errcode, errmsg) + ! Set whether this constituent is a dry species or not using the dry_flag which is passed in + + ! Dummy arguments + class(ccpp_constituent_prop_ptr_t), intent(inout) :: this + logical, intent(in) :: dry_flag + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + + ! Set dry_flag for this constituent: + this%species_is_dry = dry_flag + + ! Provide err values if requested: + if(present(errcode)) then + errcode = 0 + end if + if(present(errmsg)) then + errmsg = '' + end if + + end subroutine ccp_set_dry + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!CAM-equivalent CCPP constituents initialization routine +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +subroutine ccpp_const_props_init(ix_qv) + + ! Use statements: + use constituents, only: pcnst, cnst_get_type_byind + use cam_abortutils, only: handle_allocate_error + use air_composition, only: dry_air_species_num + use air_composition, only: thermodynamic_active_species_idx + + integer, intent(in) :: ix_qv + ! Local variables: + integer :: ierr + integer :: m + + character(len=*), parameter :: subname = 'ccpp_const_prop_init:' + + ! Allocate constituents object: + allocate(ccpp_const_props(pcnst), stat=ierr) + + ! Check if allocation succeeded: + call handle_allocate_error(ierr, subname, 'ccpp_const_props(pcnst)') + + ! Set "thermo_active" property: + do m = 1,pcnst + if(any(thermodynamic_active_species_idx == m)) then + call ccpp_const_props(m)%set_thermo_active(.true.) + end if + end do + + ! Set "water_species" property: + do m=1,pcnst + if(any(thermodynamic_active_species_idx(dry_air_species_num+1:) == m)) then + call ccpp_const_props(m)%set_water_species(.true.) + end if + end do + + ! Set "set_dry" property: + do m=1,pcnst + if (cnst_get_type_byind(m).eq.'dry') then + call ccpp_const_props(m)%set_dry(.true.) + else + call ccpp_const_props(m)%set_dry(.false.) + end if + end do + + ! Set "std_name" property: + call ccpp_const_props(ix_qv)%set_standard_name('water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water') + +end subroutine ccpp_const_props_init + +end module ccpp_constituent_prop_mod diff --git a/src/utils/cam_ccpp/ccpp_kinds.F90 b/src/utils/cam_ccpp/ccpp_kinds.F90 new file mode 100644 index 0000000000..c95c2b08c3 --- /dev/null +++ b/src/utils/cam_ccpp/ccpp_kinds.F90 @@ -0,0 +1,12 @@ +! This module is the CAM version of the CCPP generated module of the same name +module ccpp_kinds + + use shr_kind_mod, only: kind_phys => shr_kind_r8 + + + implicit none + private + + public kind_phys + +end module ccpp_kinds diff --git a/src/utils/cam_diagnostic_utils.F90 b/src/utils/cam_diagnostic_utils.F90 new file mode 100644 index 0000000000..7a6921904a --- /dev/null +++ b/src/utils/cam_diagnostic_utils.F90 @@ -0,0 +1,85 @@ +module cam_diagnostic_utils + +! Collection of routines used for diagnostic calculations. + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver + + +implicit none +private +save + +public :: & + cpslec ! compute sea level pressure + +!=============================================================================== +contains +!=============================================================================== + +subroutine cpslec(ncol, pmid, phis, ps, t, psl, gravit, rair) + +!----------------------------------------------------------------------- +! +! Compute sea level pressure. +! +! Uses ECMWF formulation Algorithm: See section 3.1.b in NCAR NT-396 "Vertical +! Interpolation and Truncation of Model-Coordinate Data +! +!----------------------------------------------------------------------- + + !-----------------------------Arguments--------------------------------- + integer , intent(in) :: ncol ! longitude dimension + + real(r8), intent(in) :: pmid(pcols,pver) ! Atmospheric pressure (pascals) + real(r8), intent(in) :: phis(pcols) ! Surface geopotential (m**2/sec**2) + real(r8), intent(in) :: ps(pcols) ! Surface pressure (pascals) + real(r8), intent(in) :: T(pcols,pver) ! Vertical slice of temperature (top to bot) + real(r8), intent(in) :: gravit ! Gravitational acceleration + real(r8), intent(in) :: rair ! gas constant for dry air + + real(r8), intent(out):: psl(pcols) ! Sea level pressures (pascals) + + !-----------------------------Parameters-------------------------------- + real(r8), parameter :: xlapse = 6.5e-3_r8 ! Temperature lapse rate (K/m) + + !-----------------------------Local Variables--------------------------- + integer :: i ! Loop index + real(r8) :: alpha ! Temperature lapse rate in terms of pressure ratio (unitless) + real(r8) :: Tstar ! Computed surface temperature + real(r8) :: TT0 ! Computed temperature at sea-level + real(r8) :: alph ! Power to raise P/Ps to get rate of increase of T with pressure + real(r8) :: beta ! alpha*phis/(R*T) term used in approximation of PSL + !----------------------------------------------------------------------- + + alpha = rair*xlapse/gravit + do i=1,ncol + if ( abs(phis(i)/gravit) < 1.e-4_r8 )then + psl(i)=ps(i) + else + Tstar=T(i,pver)*(1._r8+alpha*(ps(i)/pmid(i,pver)-1._r8)) ! pg 7 eq 5 + + TT0=Tstar + xlapse*phis(i)/gravit ! pg 8 eq 13 + + if ( Tstar<=290.5_r8 .and. TT0>290.5_r8 ) then ! pg 8 eq 14.1 + alph=rair/phis(i)*(290.5_r8-Tstar) + else if (Tstar>290.5_r8 .and. TT0>290.5_r8) then ! pg 8 eq 14.2 + alph=0._r8 + Tstar= 0.5_r8 * (290.5_r8 + Tstar) + else + alph=alpha + if (Tstar<255._r8) then + Tstar= 0.5_r8 * (255._r8 + Tstar) ! pg 8 eq 14.3 + endif + endif + + beta = phis(i)/(rair*Tstar) + psl(i)=ps(i)*exp( beta*(1._r8-alph*beta/2._r8+((alph*beta)**2)/3._r8)) + end if + enddo + +end subroutine cpslec + +!=============================================================================== + +end module cam_diagnostic_utils diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index 4e6ebf6e3a..d4c7fc9792 100644 --- a/src/utils/cam_grid_support.F90 +++ b/src/utils/cam_grid_support.F90 @@ -15,7 +15,11 @@ module cam_grid_support public iMap integer, parameter, public :: max_hcoordname_len = 16 - real(r8), parameter :: grid_fill_value = -900.0_r8 + integer, parameter, public :: maxsplitfiles = 2 + + type, public :: vardesc_ptr_t + type(var_desc_t), pointer :: p => NULL() + end type vardesc_ptr_t !--------------------------------------------------------------------------- ! ! horiz_coord_t: Information for horizontal dimension attributes @@ -33,8 +37,8 @@ module cam_grid_support integer(iMap), pointer :: map(:) => NULL() ! map (dof) for dist. coord logical :: latitude ! .false. means longitude real(r8), pointer :: bnds(:,:) => NULL() ! bounds, if present - type(var_desc_t), pointer :: vardesc => NULL() ! If we are to write coord - type(var_desc_t), pointer :: bndsvdesc => NULL() ! If we are to write bounds + type(vardesc_ptr_t) :: vardesc(maxsplitfiles) ! If we are to write coord + type(vardesc_ptr_t) :: bndsvdesc(maxsplitfiles) ! If we are to write bounds contains procedure :: get_coord_len => horiz_coord_len procedure :: num_elem => horiz_coord_num_elem @@ -55,7 +59,7 @@ module cam_grid_support type, abstract :: cam_grid_attribute_t character(len=max_hcoordname_len) :: name = '' ! attribute name character(len=max_chars) :: long_name = '' ! attribute long_name - type(var_desc_t), pointer :: vardesc => NULL() + type(vardesc_ptr_t) :: vardesc(maxsplitfiles) ! We aren't going to use this until we sort out PGI issues class(cam_grid_attribute_t), pointer :: next => NULL() contains @@ -157,7 +161,7 @@ module cam_grid_support type(horiz_coord_t), pointer :: lon_coord => NULL() ! Longitude coord logical :: unstructured ! Is this needed? logical :: block_indexed ! .false. for lon/lat - logical :: attrs_defined = .false. + logical :: attrs_defined(2) = .false. logical :: zonal_grid = .false. type(cam_filemap_t), pointer :: map => null() ! global dim map (dof) type(cam_grid_attr_ptr_t), pointer :: attributes => NULL() @@ -267,12 +271,13 @@ module cam_grid_support ! NB: This will not compile on some pre-13 Intel compilers ! (fails on 12.1.0.233 on Frankfurt, passes on 13.0.1.117 on Yellowstone) abstract interface - subroutine write_cam_grid_attr(attr, File) + subroutine write_cam_grid_attr(attr, File, file_index) use pio, only: file_desc_t import :: cam_grid_attribute_t ! Dummy arguments class(cam_grid_attribute_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, optional, intent(in) :: file_index end subroutine write_cam_grid_attr end interface @@ -315,6 +320,8 @@ end subroutine print_attr_spec public :: cam_grid_is_zonal ! Functions for dealing with patch masks public :: cam_grid_compute_patch + ! Functions for dealing with grid areas + public :: cam_grid_get_areawt interface cam_grid_attribute_register module procedure add_cam_grid_attribute_0d_int @@ -544,7 +551,7 @@ end function horiz_coord_create ! !--------------------------------------------------------------------------- - subroutine write_horiz_coord_attr(this, File, dimid_out) + subroutine write_horiz_coord_attr(this, File, dimid_out, file_index) use pio, only: file_desc_t, pio_put_att, pio_noerr, pio_double use pio, only: pio_bcast_error, pio_seterrorhandling, pio_inq_varid use cam_pio_utils, only: cam_pio_def_dim, cam_pio_def_var @@ -553,6 +560,7 @@ subroutine write_horiz_coord_attr(this, File, dimid_out) class(horiz_coord_t), intent(inout) :: this type(file_desc_t), intent(inout) :: File ! PIO file Handle integer, optional, intent(out) :: dimid_out + integer, optional, intent(in) :: file_index ! Local variables type(var_desc_t) :: vardesc @@ -561,9 +569,16 @@ subroutine write_horiz_coord_attr(this, File, dimid_out) integer :: bnds_dimid ! PIO dim ID for bounds integer :: err_handling integer :: ierr + integer :: file_index_loc ! We will handle errors for this routine - call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) + call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if ! Make sure the dimension exists in the file call this%get_dim_name(dimname) @@ -573,38 +588,33 @@ subroutine write_horiz_coord_attr(this, File, dimid_out) ierr = pio_inq_varid(File, trim(this%name), vardesc) if (ierr /= PIO_NOERR) then ! Variable not already defined, it is up to us to define the variable - if (associated(this%vardesc)) then + if (associated(this%vardesc(file_index_loc)%p)) then ! This should not happen (i.e., internal error) call endrun('write_horiz_coord_attr: vardesc already allocated for '//trim(dimname)) end if - allocate(this%vardesc) + allocate(this%vardesc(file_index_loc)%p) call cam_pio_def_var(File, trim(this%name), pio_double, & - (/ dimid /), this%vardesc, existOK=.false.) - ierr= pio_put_att(File, this%vardesc, '_FillValue', grid_fill_value) - call cam_pio_handle_error(ierr, 'Error writing "_FillValue" attr in write_horiz_coord_attr') + (/ dimid /), this%vardesc(file_index_loc)%p, existOK=.false.) ! long_name - ierr=pio_put_att(File, this%vardesc, 'long_name', trim(this%long_name)) + ierr=pio_put_att(File, this%vardesc(file_index_loc)%p, 'long_name', trim(this%long_name)) call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_horiz_coord_attr') ! units - ierr=pio_put_att(File, this%vardesc, 'units', trim(this%units)) + ierr=pio_put_att(File, this%vardesc(file_index_loc)%p, 'units', trim(this%units)) call cam_pio_handle_error(ierr, 'Error writing "units" attr in write_horiz_coord_attr') ! Take care of bounds if they exist if (associated(this%bnds)) then - allocate(this%bndsvdesc) - ierr=pio_put_att(File, this%vardesc, 'bounds', trim(this%name)//'_bnds') + allocate(this%bndsvdesc(file_index_loc)%p) + ierr=pio_put_att(File, this%vardesc(file_index_loc)%p, 'bounds', trim(this%name)//'_bnds') call cam_pio_handle_error(ierr, 'Error writing "'//trim(this%name)//'_bnds" attr in write_horiz_coord_attr') call cam_pio_def_dim(File, 'nbnd', 2, bnds_dimid, existOK=.true.) call cam_pio_def_var(File, trim(this%name)//'_bnds', pio_double, & - (/ bnds_dimid, dimid /), this%bndsvdesc, existOK=.false.) + (/ bnds_dimid, dimid /), this%bndsvdesc(file_index_loc)%p, existOK=.false.) call cam_pio_handle_error(ierr, 'Error defining "'//trim(this%name)//'bnds" in write_horiz_coord_attr') ! long_name - ierr=pio_put_att(File, this%bndsvdesc, 'long_name', trim(this%name)//' bounds') + ierr=pio_put_att(File, this%bndsvdesc(file_index_loc)%p, 'long_name', trim(this%name)//' bounds') call cam_pio_handle_error(ierr, 'Error writing bounds "long_name" attr in write_horiz_coord_attr') - ! fill value - ierr= pio_put_att(File, this%vardesc, '_FillValue', grid_fill_value) - call cam_pio_handle_error(ierr, 'Error writing "_FillValue" attr in write_horiz_coord_attr') ! units - ierr=pio_put_att(File, this%bndsvdesc, 'units', trim(this%units)) + ierr=pio_put_att(File, this%bndsvdesc(file_index_loc)%p, 'units', trim(this%units)) call cam_pio_handle_error(ierr, 'Error writing bounds "units" attr in write_horiz_coord_attr') end if ! There are bounds for this coordinate end if ! We define the variable @@ -626,7 +636,7 @@ end subroutine write_horiz_coord_attr ! !--------------------------------------------------------------------------- - subroutine write_horiz_coord_var(this, File) + subroutine write_horiz_coord_var(this, File, file_index) use cam_pio_utils, only: cam_pio_get_decomp use pio, only: file_desc_t, pio_double, iosystem_desc_t use pio, only: pio_put_var, pio_write_darray @@ -641,6 +651,7 @@ subroutine write_horiz_coord_var(this, File) ! Dummy arguments class(horiz_coord_t), intent(inout) :: this type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, optional, intent(in) :: file_index ! Local variables character(len=120) :: errormsg @@ -649,12 +660,19 @@ subroutine write_horiz_coord_var(this, File) integer :: fdims(1) integer :: err_handling type(io_desc_t) :: iodesc + integer :: file_index_loc !!XXgoldyXX: HACK to get around circular dependencies. Fix this!! type(iosystem_desc_t), pointer :: piosys !!XXgoldyXX: End of this part of the hack + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if + ! Check to make sure we are supposed to write this var - if (associated(this%vardesc)) then + if (associated(this%vardesc(file_index_loc)%p)) then ! We will handle errors for this routine call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) @@ -666,22 +684,22 @@ subroutine write_horiz_coord_var(this, File) call this%get_coord_len(fdims(1)) allocate(iodesc) call cam_pio_get_decomp(iodesc, ldims, fdims, PIO_DOUBLE, this%map) - call pio_write_darray(File, this%vardesc, iodesc, this%values, ierr) + call pio_write_darray(File, this%vardesc(file_index_loc)%p, iodesc, this%values, ierr) nullify(iodesc) ! CAM PIO system takes over memory management of iodesc #else !!XXgoldyXX: HACK to get around circular dependencies. Fix this!! piosys => shr_pio_getiosys(atm_id) call pio_initdecomp(piosys, pio_double, (/this%dimsize/), this%map, & iodesc) - call pio_write_darray(File, this%vardesc, iodesc, this%values, ierr) + call pio_write_darray(File, this%vardesc(file_index_loc)%p, iodesc, this%values, ierr) call pio_syncfile(File) call pio_freedecomp(File, iodesc) ! Take care of bounds if they exist - if (associated(this%bnds) .and. associated(this%bndsvdesc)) then + if (associated(this%bnds) .and. associated(this%bndsvdesc(file_index_loc)%p)) then call pio_initdecomp(piosys, pio_double, (/2, this%dimsize/), & this%map, iodesc) - call pio_write_darray(File, this%bndsvdesc, iodesc, this%bnds, ierr) + call pio_write_darray(File, this%bndsvdesc(file_index_loc)%p, iodesc, this%bnds, ierr) call pio_syncfile(File) call pio_freedecomp(File, iodesc) end if @@ -689,10 +707,10 @@ subroutine write_horiz_coord_var(this, File) !!XXgoldyXX: End of this part of the hack else ! This is a local variable, pio_put_var should work fine - ierr = pio_put_var(File, this%vardesc, this%values) + ierr = pio_put_var(File, this%vardesc(file_index_loc)%p, this%values) ! Take care of bounds if they exist - if (associated(this%bnds) .and. associated(this%bndsvdesc)) then - ierr = pio_put_var(File, this%bndsvdesc, this%bnds) + if (associated(this%bnds) .and. associated(this%bndsvdesc(file_index_loc)%p)) then + ierr = pio_put_var(File, this%bndsvdesc(file_index_loc)%p, this%bnds) end if end if write(errormsg, *) 'Error writing variable values for ',trim(this%name),& @@ -703,12 +721,12 @@ subroutine write_horiz_coord_var(this, File) call pio_seterrorhandling(File, err_handling) ! We are done with this variable descriptor, reset for next file - deallocate(this%vardesc) - nullify(this%vardesc) + deallocate(this%vardesc(file_index_loc)%p) + nullify(this%vardesc(file_index_loc)%p) ! Same with the bounds descriptor - if (associated(this%bndsvdesc)) then - deallocate(this%bndsvdesc) - nullify(this%bndsvdesc) + if (associated(this%bndsvdesc(file_index_loc)%p)) then + deallocate(this%bndsvdesc(file_index_loc)%p) + nullify(this%bndsvdesc(file_index_loc)%p) end if end if ! Do we write the variable? @@ -1622,6 +1640,57 @@ function cam_grid_get_lonvals(id) result(lonvals) end if end function cam_grid_get_lonvals + function cam_grid_get_areawt(id) result(wtvals) + + ! Dummy argument + integer, intent(in) :: id + real(r8), pointer :: wtvals(:) + + ! Local variables + character(len=max_chars) :: wtname + integer :: gridind + class(cam_grid_attribute_t), pointer :: attrptr + character(len=120) :: errormsg + + nullify(attrptr) + gridind = get_cam_grid_index(id) + if (gridind > 0) then + select case(trim(cam_grids(gridind)%name)) + case('GLL') + wtname='area_weight_gll' + case('FV') + wtname='gw' + case('INI') + wtname='area_weight_ini' + case('physgrid') + wtname='areawt' + case('FVM') + wtname='area_weight_fvm' + case('mpas_cell') + wtname='area_weight_mpas' + case default + call endrun('cam_grid_get_areawt: Invalid gridname:'//trim(cam_grids(gridind)%name)) + end select + + call find_cam_grid_attr(gridind, trim(wtname), attrptr) + if (.not.associated(attrptr)) then + write(errormsg, '(4a)') & + 'cam_grid_get_areawt: error retrieving weight attribute ', trim(wtname), & + ' for cam grid ', cam_grids(gridind)%name + call endrun(errormsg) + else + call attrptr%print_attr() + select type(attrptr) + type is (cam_grid_attribute_1d_r8_t) + wtvals => attrptr%values + class default + call endrun('cam_grid_get_areawt: wt attribute is not a real datatype') + end select + end if + end if + + end function cam_grid_get_areawt + ! Find the longitude and latitude of a range of map entries ! beg and end are the range of the first source index. blk is a block or chunk index subroutine cam_grid_get_coords(id, beg, end, blk, lon, lat) @@ -2121,7 +2190,7 @@ end subroutine setAttrPtrNext ! !--------------------------------------------------------------------------- - subroutine write_cam_grid_attr_0d_int(attr, File) + subroutine write_cam_grid_attr_0d_int(attr, File, file_index) use pio, only: file_desc_t, pio_put_att, pio_noerr, pio_int, & pio_inq_att, PIO_GLOBAL use cam_pio_utils, only: cam_pio_def_var @@ -2129,25 +2198,30 @@ subroutine write_cam_grid_attr_0d_int(attr, File) ! Dummy arguments class(cam_grid_attribute_0d_int_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, optional, intent(in) :: file_index ! Local variables - character(len=120) :: errormsg integer :: attrtype integer(imap) :: attrlen integer :: ierr + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if ! Since more than one grid can share an attribute, assume that if the ! vardesc is associated, that grid defined the attribute - if (.not. associated(attr%vardesc)) then + if (.not. associated(attr%vardesc(file_index_loc)%p)) then if (len_trim(attr%long_name) > 0) then ! This 0d attribute is a scalar variable with a long_name attribute ! First, define the variable - allocate(attr%vardesc) - call cam_pio_def_var(File, trim(attr%name), pio_int, attr%vardesc, & + allocate(attr%vardesc(file_index_loc)%p) + call cam_pio_def_var(File, trim(attr%name), pio_int, attr%vardesc(file_index_loc)%p, & existOK=.false.) - ierr= pio_put_att(File, attr%vardesc, '_FillValue', int(grid_fill_value)) - call cam_pio_handle_error(ierr, 'Error writing "_FillValue" attr in write_cam_grid_attr_0d_int') - ierr=pio_put_att(File, attr%vardesc, 'long_name', trim(attr%long_name)) + ierr=pio_put_att(File, attr%vardesc(file_index_loc)%p, 'long_name', trim(attr%long_name)) call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_0d_int') else ! This 0d attribute is a global attribute @@ -2171,23 +2245,30 @@ end subroutine write_cam_grid_attr_0d_int ! !--------------------------------------------------------------------------- - subroutine write_cam_grid_attr_0d_char(attr, File) + subroutine write_cam_grid_attr_0d_char(attr, File, file_index) use pio, only: file_desc_t, pio_put_att, pio_noerr, & pio_inq_att, PIO_GLOBAL ! Dummy arguments class(cam_grid_attribute_0d_char_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, optional, intent(in) :: file_index ! Local variables - character(len=120) :: errormsg integer :: attrtype integer(imap) :: attrlen integer :: ierr + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if ! Since more than one grid can share an attribute, assume that if the ! vardesc is associated, that grid defined the attribute - if (.not. associated(attr%vardesc)) then + if (.not. associated(attr%vardesc(file_index_loc)%p)) then ! The 0d char attributes are global attribues ! Check to see if the attribute already exists in the file ierr = pio_inq_att(File, PIO_GLOBAL, attr%name, attrtype, attrlen) @@ -2208,23 +2289,31 @@ end subroutine write_cam_grid_attr_0d_char ! !--------------------------------------------------------------------------- - subroutine write_cam_grid_attr_1d_int(attr, File) + subroutine write_cam_grid_attr_1d_int(attr, File, file_index) use pio, only: file_desc_t, pio_put_att, pio_noerr use pio, only: pio_inq_dimid, pio_int - use cam_pio_utils, only: cam_pio_def_var + use cam_pio_utils, only: cam_pio_def_var, cam_pio_closefile ! Dummy arguments class(cam_grid_attribute_1d_int_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, optional, intent(in) :: file_index ! Local variables integer :: dimid ! PIO dimension ID character(len=120) :: errormsg integer :: ierr + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if ! Since more than one grid can share an attribute, assume that if the ! vardesc is associated, that grid defined the attribute - if (.not. associated(attr%vardesc)) then + if (.not. associated(attr%vardesc(file_index_loc)%p)) then ! Check to see if the dimension already exists in the file ierr = pio_inq_dimid(File, trim(attr%dimname), dimid) if (ierr /= PIO_NOERR) then @@ -2232,15 +2321,14 @@ subroutine write_cam_grid_attr_1d_int(attr, File) ! NB: It should have been defined as part of a coordinate write(errormsg, *) 'write_cam_grid_attr_1d_int: dimension, ', & trim(attr%dimname), ', does not exist' + call cam_pio_closefile(File) call endrun(errormsg) end if ! Time to define the variable - allocate(attr%vardesc) + allocate(attr%vardesc(file_index_loc)%p) call cam_pio_def_var(File, trim(attr%name), pio_int, (/dimid/), & - attr%vardesc, existOK=.false.) - ierr= pio_put_att(File, attr%vardesc, '_FillValue', int(grid_fill_value)) - call cam_pio_handle_error(ierr, 'Error writing "_FillValue" attr in write_cam_grid_attr_1d_int') - ierr = pio_put_att(File, attr%vardesc, 'long_name', trim(attr%long_name)) + attr%vardesc(file_index_loc)%p, existOK=.false.) + ierr = pio_put_att(File, attr%vardesc(file_index_loc)%p, 'long_name', trim(attr%long_name)) call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_1d_int') end if @@ -2254,23 +2342,31 @@ end subroutine write_cam_grid_attr_1d_int ! !--------------------------------------------------------------------------- - subroutine write_cam_grid_attr_1d_r8(attr, File) + subroutine write_cam_grid_attr_1d_r8(attr, File, file_index) use pio, only: file_desc_t, pio_put_att, pio_noerr, pio_double, & pio_inq_dimid - use cam_pio_utils, only: cam_pio_def_var + use cam_pio_utils, only: cam_pio_def_var, cam_pio_closefile ! Dummy arguments class(cam_grid_attribute_1d_r8_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, optional, intent(in) :: file_index ! Local variables integer :: dimid ! PIO dimension ID character(len=120) :: errormsg integer :: ierr + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if ! Since more than one grid can share an attribute, assume that if the ! vardesc is associated, that grid defined the attribute - if (.not. associated(attr%vardesc)) then + if (.not. associated(attr%vardesc(file_index_loc)%p)) then ! Check to see if the dimension already exists in the file ierr = pio_inq_dimid(File, trim(attr%dimname), dimid) if (ierr /= PIO_NOERR) then @@ -2278,17 +2374,15 @@ subroutine write_cam_grid_attr_1d_r8(attr, File) ! NB: It should have been defined as part of a coordinate write(errormsg, *) 'write_cam_grid_attr_1d_r8: dimension, ', & trim(attr%dimname), ', does not exist' + call cam_pio_closefile(File) call endrun(errormsg) end if ! Time to define the variable - allocate(attr%vardesc) + allocate(attr%vardesc(file_index_loc)%p) call cam_pio_def_var(File, trim(attr%name), pio_double, (/dimid/), & - attr%vardesc, existOK=.false.) - ! fill value - ierr = pio_put_att(File, attr%vardesc, '_FillValue', grid_fill_value) - call cam_pio_handle_error(ierr, 'Error writing "_FillValue" attr in write_cam_grid_attr_1d_r8') + attr%vardesc(file_index_loc)%p, existOK=.false.) ! long_name - ierr = pio_put_att(File, attr%vardesc, 'long_name', trim(attr%long_name)) + ierr = pio_put_att(File, attr%vardesc(file_index_loc)%p, 'long_name', trim(attr%long_name)) call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_1d_r8') end if @@ -2344,14 +2438,14 @@ end subroutine cam_grid_attribute_copy ! coordinates. ! !--------------------------------------------------------------------------- - subroutine cam_grid_write_attr(File, grid_id, header_info) + subroutine cam_grid_write_attr(File, grid_id, header_info, file_index) use pio, only: file_desc_t, PIO_BCAST_ERROR, pio_seterrorhandling - use pio, only: pio_inq_dimid ! Dummy arguments type(file_desc_t), intent(inout) :: File ! PIO file Handle integer, intent(in) :: grid_id type(cam_grid_header_info_t), intent(inout) :: header_info + integer, optional, intent(in) :: file_index ! Local variables integer :: gridind @@ -2359,13 +2453,19 @@ subroutine cam_grid_write_attr(File, grid_id, header_info) type(cam_grid_attr_ptr_t), pointer :: attrPtr integer :: dimids(2) integer :: err_handling + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if gridind = get_cam_grid_index(grid_id) !! Fill this in to make sure history finds grid header_info%grid_id = grid_id if (allocated(header_info%hdims)) then - ! This shouldn't happen but, no harm, no foul deallocate(header_info%hdims) end if @@ -2379,7 +2479,7 @@ subroutine cam_grid_write_attr(File, grid_id, header_info) end if ! Only write this grid if not already defined - if (cam_grids(gridind)%attrs_defined) then + if (cam_grids(gridind)%attrs_defined(file_index_loc)) then ! We need to fill out the hdims info for this grid call cam_grids(gridind)%find_dimids(File, dimids) if (dimids(2) < 0) then @@ -2391,8 +2491,8 @@ subroutine cam_grid_write_attr(File, grid_id, header_info) end if else ! Write the horizontal coord attributes first so that we have the dims - call cam_grids(gridind)%lat_coord%write_attr(File, dimids(2)) - call cam_grids(gridind)%lon_coord%write_attr(File, dimids(1)) + call cam_grids(gridind)%lat_coord%write_attr(File, dimids(2), file_index=file_index_loc) + call cam_grids(gridind)%lon_coord%write_attr(File, dimids(1), file_index=file_index_loc) if (dimids(2) == dimids(1)) then allocate(header_info%hdims(1)) @@ -2410,7 +2510,7 @@ subroutine cam_grid_write_attr(File, grid_id, header_info) !!XXgoldyXX: Is this not working in PGI? ! attr => attrPtr%getAttr() attr => attrPtr%attr - call attr%write_attr(File) + call attr%write_attr(File, file_index=file_index_loc) !!XXgoldyXX: Is this not working in PGI? ! attrPtr => attrPtr%getNext() attrPtr => attrPtr%next @@ -2418,140 +2518,168 @@ subroutine cam_grid_write_attr(File, grid_id, header_info) ! Back to previous I/O error handling call pio_seterrorhandling(File, err_handling) - - cam_grids(gridind)%attrs_defined = .true. + cam_grids(gridind)%attrs_defined(file_index_loc) = .true. end if end subroutine cam_grid_write_attr - subroutine write_cam_grid_val_0d_int(attr, File) - use pio, only: file_desc_t, pio_inq_varid, pio_put_var + subroutine write_cam_grid_val_0d_int(attr, File, file_index) + use pio, only: file_desc_t, pio_put_var ! Dummy arguments class(cam_grid_attribute_0d_int_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File + integer, optional, intent(in) :: file_index ! Local variables - character(len=120) :: errormsg integer :: ierr + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if ! We only write this var if it is a variable - if (associated(attr%vardesc)) then - ierr = pio_put_var(File, attr%vardesc, attr%ival) + if (associated(attr%vardesc(file_index_loc)%p)) then + ierr = pio_put_var(File, attr%vardesc(file_index_loc)%p, attr%ival) call cam_pio_handle_error(ierr, 'Error writing value in write_cam_grid_val_0d_int') - deallocate(attr%vardesc) - nullify(attr%vardesc) + deallocate(attr%vardesc(file_index_loc)%p) + nullify(attr%vardesc(file_index_loc)%p) end if end subroutine write_cam_grid_val_0d_int - subroutine write_cam_grid_val_0d_char(attr, File) + subroutine write_cam_grid_val_0d_char(attr, File, file_index) use pio, only: file_desc_t ! Dummy arguments class(cam_grid_attribute_0d_char_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File + integer, optional, intent(in) :: file_index ! This subroutine is a stub because global attributes are written ! in define mode return end subroutine write_cam_grid_val_0d_char - subroutine write_cam_grid_val_1d_int(attr, File) + subroutine write_cam_grid_val_1d_int(attr, File, file_index) use pio, only: file_desc_t, pio_put_var, pio_int, & - pio_inq_varid, pio_write_darray, io_desc_t, pio_freedecomp + pio_write_darray, io_desc_t, pio_freedecomp use cam_pio_utils, only: cam_pio_newdecomp ! Dummy arguments class(cam_grid_attribute_1d_int_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File + integer, optional, intent(in) :: file_index ! Local variables - character(len=120) :: errormsg integer :: ierr type(io_desc_t), pointer :: iodesc + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if nullify(iodesc) ! Since more than one grid can share an attribute, assume that if the ! vardesc is not associated, another grid write the values - if (associated(attr%vardesc)) then + if (associated(attr%vardesc(file_index_loc)%p)) then ! Write out the values for this dimension variable if (associated(attr%map)) then ! This is a distributed variable, use pio_write_darray allocate(iodesc) call cam_pio_newdecomp(iodesc, (/attr%dimsize/), attr%map, pio_int) - call pio_write_darray(File, attr%vardesc, iodesc, attr%values, ierr) + call pio_write_darray(File, attr%vardesc(file_index_loc)%p, iodesc, attr%values, ierr) call pio_freedecomp(File, iodesc) deallocate(iodesc) nullify(iodesc) else ! This is a local variable, pio_put_var should work fine - ierr = pio_put_var(File, attr%vardesc, attr%values) + ierr = pio_put_var(File, attr%vardesc(file_index_loc)%p, attr%values) end if call cam_pio_handle_error(ierr, 'Error writing variable values in write_cam_grid_val_1d_int') - deallocate(attr%vardesc) - nullify(attr%vardesc) + deallocate(attr%vardesc(file_index_loc)%p) + nullify(attr%vardesc(file_index_loc)%p) end if end subroutine write_cam_grid_val_1d_int - subroutine write_cam_grid_val_1d_r8(attr, File) + subroutine write_cam_grid_val_1d_r8(attr, File, file_index) use pio, only: file_desc_t, pio_put_var, pio_double, & - pio_inq_varid, pio_write_darray, io_desc_t, pio_freedecomp + pio_write_darray, io_desc_t, pio_freedecomp use cam_pio_utils, only: cam_pio_newdecomp ! Dummy arguments class(cam_grid_attribute_1d_r8_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File + integer, optional, intent(in) :: file_index ! Local variables - character(len=120) :: errormsg integer :: ierr type(io_desc_t), pointer :: iodesc + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if nullify(iodesc) ! Since more than one grid can share an attribute, assume that if the ! vardesc is not associated, another grid write the values - if (associated(attr%vardesc)) then + if (associated(attr%vardesc(file_index_loc)%p)) then ! Write out the values for this dimension variable if (associated(attr%map)) then ! This is a distributed variable, use pio_write_darray allocate(iodesc) call cam_pio_newdecomp(iodesc, (/attr%dimsize/), attr%map, pio_double) - call pio_write_darray(File, attr%vardesc, iodesc, attr%values, ierr) + call pio_write_darray(File, attr%vardesc(file_index_loc)%p, iodesc, attr%values, ierr) call pio_freedecomp(File, iodesc) deallocate(iodesc) nullify(iodesc) else ! This is a local variable, pio_put_var should work fine - ierr = pio_put_var(File, attr%vardesc, attr%values) + ierr = pio_put_var(File, attr%vardesc(file_index_loc)%p, attr%values) end if call cam_pio_handle_error(ierr, 'Error writing variable values in write_cam_grid_val_1d_r8') - deallocate(attr%vardesc) - nullify(attr%vardesc) + deallocate(attr%vardesc(file_index_loc)%p) + nullify(attr%vardesc(file_index_loc)%p) end if end subroutine write_cam_grid_val_1d_r8 - subroutine cam_grid_write_var(File, grid_id) + subroutine cam_grid_write_var(File, grid_id, file_index) use pio, only: file_desc_t, pio_bcast_error, pio_seterrorhandling ! Dummy arguments type(file_desc_t), intent(inout) :: File ! PIO file Handle integer, intent(in) :: grid_id + integer, optional, intent(in) :: file_index ! Local variables integer :: gridind integer :: err_handling class(cam_grid_attribute_t), pointer :: attr type(cam_grid_attr_ptr_t), pointer :: attrPtr + integer :: file_index_loc + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if gridind = get_cam_grid_index(grid_id) ! Only write if not already done - if (cam_grids(gridind)%attrs_defined) then + if (cam_grids(gridind)%attrs_defined(file_index_loc)) then ! Write the horizontal coorinate values - call cam_grids(gridind)%lon_coord%write_var(File) - call cam_grids(gridind)%lat_coord%write_var(File) + call cam_grids(gridind)%lon_coord%write_var(File, file_index) + call cam_grids(gridind)%lat_coord%write_var(File, file_index) ! We will handle errors for this routine call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) @@ -2562,7 +2690,7 @@ subroutine cam_grid_write_var(File, grid_id) !!XXgoldyXX: Is this not working in PGI? ! attr => attrPtr%getAttr() attr => attrPtr%attr - call attr%write_val(File) + call attr%write_val(File, file_index=file_index_loc) !!XXgoldyXX: Is this not working in PGI? ! attrPtr => attrPtr%getNext() attrPtr => attrPtr%next @@ -2571,7 +2699,7 @@ subroutine cam_grid_write_var(File, grid_id) ! Back to previous I/O error handling call pio_seterrorhandling(File, err_handling) - cam_grids(gridind)%attrs_defined = .false. + cam_grids(gridind)%attrs_defined(file_index_loc) = .false. end if end subroutine cam_grid_write_var @@ -3010,7 +3138,7 @@ subroutine cam_grid_find_dimids(this, File, dimids) integer, intent(out) :: dimids(:) ! Local vaariables - integer :: dsize, ierr + integer :: ierr integer :: err_handling character(len=max_hcoordname_len) :: dimname1, dimname2 @@ -3560,7 +3688,6 @@ subroutine cam_grid_get_patch_mask(this, lonl, lonu, latl, latu, patch, cco) if ( (abs(lat - latmin) <= maxangle) .and. & (abs(lon - lonmin) <= maxangle)) then ! maxangle could be pi but why waste all those trig functions? - ! XXgoldyXX: What should we use for maxangle given coarse Eul grids? if ((lat == latmin) .and. (lon == lonmin)) then dist = 0.0_r8 else @@ -3891,8 +4018,6 @@ subroutine cam_grid_patch_get_decomp(this, field_lens, file_lens, dtype, & end subroutine cam_grid_patch_get_decomp subroutine cam_grid_patch_compact(this, collected_output) - use spmd_utils, only: mpi_sum, mpi_integer, mpicom - use shr_mpi_mod, only: shr_mpi_chkerr ! Dummy arguments class(cam_grid_patch_t) :: this @@ -3996,6 +4121,7 @@ subroutine cam_grid_patch_write_vals(this, File, header_info) deallocate(coord) nullify(coord) end if + call pio_freedecomp(File, iodesc) ! Write out lat if (associated(this%latmap)) then field_lens(1) = size(this%latmap, 1) diff --git a/src/utils/cam_map_utils.F90 b/src/utils/cam_map_utils.F90 index 8c2295e5af..bd4ede5179 100644 --- a/src/utils/cam_map_utils.F90 +++ b/src/utils/cam_map_utils.F90 @@ -1,20 +1,12 @@ module cam_map_utils use pio, only: iMap=>PIO_OFFSET_KIND use cam_abortutils, only: endrun - use cam_logfile, only: iulog -!!XXgoldyXX: v -use spmd_utils, only: npes, iam, mpicom, masterproc -use shr_sys_mod, only: shr_sys_flush -!!XXgoldyXX: ^ implicit none private public iMap -!!XXgoldyXX: v -logical, public, save :: goldy_debug = .false. -!!XXgoldyXX: ^ integer, private, save :: unique_map_index = 0 integer, private, parameter :: max_srcs = 2 integer, private, parameter :: max_dests = 2 @@ -357,7 +349,7 @@ subroutine cam_filemap_init(this, pemap, unstruct, src, dest) this%dest(2) = 2 end if ! We may have holes in the 'block' decomposition which is specified by - ! having src(2) < 0. + ! having src(2) < 0. ! NB: This is currently a special purpose hack in that it is purely ! convention that the last dimension specifies the block index and ! that those blocks may not be filled. @@ -655,6 +647,7 @@ end subroutine cam_filemap_coordDests !--------------------------------------------------------------------------- subroutine cam_filemap_get_filemap(this, fieldlens, filelens, filemap, & src_in, dest_in, permutation_in) + use shr_kind_mod, only: SHR_KIND_CL ! Dummy arguments class(cam_filemap_t) :: this @@ -674,10 +667,12 @@ subroutine cam_filemap_get_filemap(this, fieldlens, filelens, filemap, & integer :: fmind, j integer(iMap) :: mapSize, mapPos, pos, fileSize integer :: mapcnt ! Dimension count - integer :: locsize ! Total local # elements integer :: tind, tlen ! Temporarys integer :: i1, i2, i3, i4, i5, i6, i7 integer :: i(7) + character(len=SHR_KIND_CL) :: errmsg + character(len=32) :: errfmt + character(len=*), parameter :: subname = 'cam_filemap_get_filemap: ' ! This shouldn't happen but, who knows what evil lurks in the hearts of SEs if (associated(filemap)) then @@ -686,7 +681,7 @@ subroutine cam_filemap_get_filemap(this, fieldlens, filelens, filemap, & end if ! - fileSize = product(filelens) + fileSize = product( int(filelens,kind=iMap) ) srccnt = size(fieldlens) srclens(1:srccnt) = fieldlens(1:srccnt) if (srccnt < 7) then @@ -703,7 +698,7 @@ subroutine cam_filemap_get_filemap(this, fieldlens, filelens, filemap, & if (present(src_in)) then mapcnt = size(src_in) ! Just used until end of loop below if (mapcnt > max_srcs) then - call endrun('cam_filemap_get_filemap: src_in too large') + call endrun(subname//'src_in too large') end if end if do j = 1, max_srcs @@ -737,7 +732,15 @@ subroutine cam_filemap_get_filemap(this, fieldlens, filelens, filemap, & ! it is still an error if the map has more elements than the array mapSize = this%num_elem() if (mapPos < this%num_mapped()) then - call endrun('cam_filemap_get_filemap: Map size too large for array dims') + if (mapcnt > 1) then + write(errfmt, '(a,i0,2a)') "(a,i0,a,", mapcnt, '(i0,", "),")")' + else + write(errfmt, '(a,i0,2a)') '(a,i0,a,i0,")")' + end if + write(errmsg, errfmt) 'Map size (', & + this%num_mapped(), ') too large for array dims (', & + srclens(mapind(1:mapcnt)) + call endrun(subname//trim(errmsg)) end if ! dsize is a global offset for each dimension @@ -751,7 +754,7 @@ subroutine cam_filemap_get_filemap(this, fieldlens, filelens, filemap, & allocate(src_ind(srccnt)) if (present(permutation_in)) then if (size(permutation_in) /= size(src_ind)) then - call endrun('cam_filemap_get_filemap: permutation_in must have same rank as fieldlens') + call endrun(subname//'permutation_in must have same rank as fieldlens') end if src_ind = permutation_in else @@ -767,26 +770,26 @@ subroutine cam_filemap_get_filemap(this, fieldlens, filelens, filemap, & do while (ANY(dest_in == fmind)) fmind = fmind + 1 if (fmind > size(dsize)) then - call endrun('cam_filemap_get_filemap: permutation calculation dest_in error') + call endrun(subname//'permutation calculation dest_in error') end if end do else do while (ANY(this%dest == fmind)) fmind = fmind + 1 if (fmind > size(dsize)) then - call endrun('cam_filemap_get_filemap: permutation calculation dest error') + call endrun(subname//'permutation calculation dest error') end if end do end if if (fmind > size(dsize)) then - call endrun('cam_filemap_get_filemap: permutation calculation error') + call endrun(subname//'permutation calculation error') end if src_ind(j) = fmind fmind = fmind + 1 end if end do end if - + ! Step through the map and fill in local positions for each entry fmind = 1 do i7 = 1, srclens(7) @@ -817,14 +820,17 @@ subroutine cam_filemap_get_filemap(this, fieldlens, filelens, filemap, & end if end do if (tind > mapSize) then - call endrun('cam_filemap_get_filemap: internal error, tind') + write(errmsg, '(2(a,i0),a,12x,5(i0,", "),")")') & + 'internal error, tind (', tind, ') > mapSize (', & + mapSize, '), srclens = (', srclens(1:5) + call endrun(subname//trim(errmsg)) end if mapPos = this%map_val(tind, dsize, dest_in) if ((mapPos > 0) .and. ((pos + mapPos) > fileSize)) then - call endrun('cam_filemap_get_filemap: internal error, pos') + call endrun(subname//'internal error, pos') end if if ((pos + mapPos) < 0) then - call endrun('cam_filemap_get_filemap: internal error, mpos') + call endrun(subname//'internal error, mpos') end if if (mapPos > 0) then filemap(fmind) = pos + mapPos @@ -841,7 +847,7 @@ subroutine cam_filemap_get_filemap(this, fieldlens, filelens, filemap, & end do end do if ((fmind - 1) /= size(filemap)) then - call endrun('cam_filemap_get_filemap: internal error, fmind') + call endrun(subname//'internal error, fmind') end if deallocate(dsize) end subroutine cam_filemap_get_filemap @@ -1094,7 +1100,7 @@ subroutine cam_filemap_compact(this, lonmap, latmap, & logical, optional, intent(in) :: dups_ok_in ! Dup coords OK ! Local variables - integer :: i, j + integer :: i integer :: ierr integer(iMap), pointer :: data(:) => NULL() integer, pointer :: indices(:) => NULL() @@ -1147,7 +1153,7 @@ subroutine cam_filemap_compact(this, lonmap, latmap, & deallocate(indices) nullify(indices) end if - ! Get a global index sort of lat and lon maps + ! Get a global index sort of lat and lon maps !! Compress latmap if (associated(latmap)) then ! Allocate indices diff --git a/src/utils/cam_pio_utils.F90 b/src/utils/cam_pio_utils.F90 index 4217c24a35..63691c8910 100644 --- a/src/utils/cam_pio_utils.F90 +++ b/src/utils/cam_pio_utils.F90 @@ -3,7 +3,7 @@ module cam_pio_utils use pio, only: io_desc_t, iosystem_desc_t, file_desc_t, var_desc_t use pio, only: pio_freedecomp, pio_rearr_subset, pio_rearr_box - use shr_kind_mod, only: r8=>shr_kind_r8 + use shr_kind_mod, only: r4 => shr_kind_r4, r8 => shr_kind_r8 use cam_logfile, only: iulog use perf_mod, only: t_startf, t_stopf use spmd_utils, only: masterproc @@ -20,6 +20,8 @@ module cam_pio_utils public :: init_pio_subsystem ! called from cam_comp public :: cam_pio_get_decomp ! Find an existing decomp or create a new one public :: cam_pio_handle_error ! If error, print a custom error message + public :: cam_pio_set_fill ! Set the PIO fill value to PIO_FILL + public :: cam_pio_inq_var_fill ! Return the buffer fill value public :: cam_permute_array public :: calc_permutation @@ -78,6 +80,12 @@ module cam_pio_utils module procedure cam_pio_get_var_3d_r8_perm end interface + interface cam_pio_inq_var_fill + module procedure inq_var_fill_i4 + module procedure inq_var_fill_r4 + module procedure inq_var_fill_r8 + end interface cam_pio_inq_var_fill + interface calc_permutation module procedure calc_permutation_int module procedure calc_permutation_char @@ -124,7 +132,7 @@ logical function use_scam_limits(File, start, kount, dimnames) latidx, lonidx) if (present(dimnames)) then if (trim(dimnames(1)) == 'lon') then - start(1) = lonidx ! First dim always lon for Eulerian dycore + start(1) = lonidx ! This could be generalized -- for now, stick with single column kount(1) = 1 else @@ -296,15 +304,16 @@ subroutine permute_array_r8(array, perm) end subroutine permute_array_r8 subroutine cam_pio_handle_error(ierr, errorstr) - use cam_abortutils, only: endrun - use pio, only: pio_noerr + use shr_kind_mod, only: SHR_KIND_CL + use cam_abortutils, only: endrun + use pio, only: pio_noerr ! Dummy arguments integer, intent(in) :: ierr character(len=*), intent(in) :: errorstr ! Local variables - character(len=256) :: errormsg + character(len=SHR_KIND_CL) :: errormsg if (ierr /= PIO_NOERR) then write(errormsg, '(a,i6,2a)') '(PIO:', ierr, ') ', trim(errorstr) @@ -500,7 +509,6 @@ subroutine cam_pio_get_decomp(iodesc, ldims, fdims, dtype, map, & ! Local variables logical :: found - integer :: i integer(PIO_OFFSET_KIND), pointer :: dof(:) type(iodesc_list), pointer :: iodesc_p character(len=errormsg_str_len) :: errormsg @@ -554,14 +562,7 @@ subroutine cam_pio_newdecomp(iodesc, dims, dof, dtype) integer(kind=PIO_OFFSET_KIND), intent(in) :: dof(:) integer, intent(in) :: dtype - if(pio_iotype == pio_iotype_pnetcdf) then - pio_rearranger = PIO_REARR_SUBSET - else - pio_rearranger = PIO_REARR_BOX - endif - - call pio_initdecomp(pio_subsystem, dtype, dims, dof, iodesc, & - rearr=pio_rearranger) + call pio_initdecomp(pio_subsystem, dtype, dims, dof, iodesc) end subroutine cam_pio_newdecomp @@ -1132,12 +1133,14 @@ subroutine cam_pio_openfile(file, fname, mode) integer :: ierr + if(pio_iotask_rank(pio_subsystem) == 0) then + write(iulog,*) 'Opening existing file ', trim(fname), file%fh + end if + ierr = pio_openfile(pio_subsystem, file, pio_iotype, fname, mode) if(ierr/= PIO_NOERR) then call endrun('Failed to open '//trim(fname)//' to read') - else if(pio_iotask_rank(pio_subsystem) == 0) then - write(iulog,*) 'Opened existing file ', trim(fname), file%fh end if end subroutine cam_pio_openfile @@ -1174,10 +1177,121 @@ logical function cam_pio_fileexists(fname) end if ! Back to whatever error handling was running before this routine - call pio_seterrorhandling(File, err_handling) + call pio_seterrorhandling(pio_subsystem, err_handling) end function cam_pio_fileexists + integer function cam_pio_set_fill(File, fillmode, old_mode) result(ierr) +#ifdef PIO2 + use pio, only: PIO_FILL, pio_set_fill +#endif + ! Dummy arguments + type(File_desc_t), intent(in) :: File + integer, optional, intent(in) :: fillmode + integer, optional, intent(out) :: old_mode + ! Local variables + integer :: oldfill + integer :: fillval + +#ifdef PIO2 + if (present(fillmode)) then + fillval = fillmode + else + fillval = PIO_FILL + end if + ierr = pio_set_fill(File, fillval, oldfill) + if (present(old_mode)) then + old_mode = oldfill + end if +#else + ierr = 0 + if (present(old_mode)) then + old_mode = 0 + end if +#endif + end function cam_pio_set_fill + + integer function inq_var_fill_i4(File, vdesc, fillvalue, no_fill) result(ierr) +#ifdef PIO2 + use pio, only: pio_inq_var_fill +#endif + use pio, only: PIO_NOERR + + ! Dummy arguments + type(File_desc_t), intent(in) :: File + type(var_desc_t), intent(in) :: vdesc + ! fillvalue needs to not be optional to avoid ambiguity + integer, target, intent(out) :: fillvalue + integer, optional, intent(out) :: no_fill + ! Local variable + integer :: no_fill_use + +#ifdef PIO2 + ierr = pio_inq_var_fill(File, vdesc, no_fill_use, fillvalue) + if (present(no_fill)) then + no_fill = no_fill_use + end if +#else + ierr = PIO_NOERR + fillvalue = 0 +#endif + + end function inq_var_fill_i4 + + integer function inq_var_fill_r4(File, vdesc, fillvalue, no_fill) result(ierr) +#ifdef PIO2 + use pio, only: pio_inq_var_fill +#endif + use pio, only: PIO_NOERR + + ! Dummy arguments + type(File_desc_t), intent(in) :: File + type(var_desc_t), intent(in) :: vdesc + ! fillvalue needs to not be optional to avoid ambiguity + real(r4), target, intent(out) :: fillvalue + integer, optional, intent(out) :: no_fill + ! Local variable + integer :: no_fill_use + +#ifdef PIO2 + ierr = pio_inq_var_fill(File, vdesc, no_fill_use, fillvalue) + if (present(no_fill)) then + no_fill = no_fill_use + end if +#else + ierr = PIO_NOERR + fillvalue = 0.0_R4 +#endif + + end function inq_var_fill_r4 + + integer function inq_var_fill_r8(File, vdesc, fillvalue, no_fill) result(ierr) +#ifdef PIO2 + use pio, only: pio_inq_var_fill +#endif + use pio, only: PIO_NOERR + + ! Dummy arguments + type(File_desc_t), intent(in) :: File + type(var_desc_t), intent(in) :: vdesc + ! fillvalue needs to not be optional to avoid ambiguity + real(r8), target, intent(out) :: fillvalue + integer, optional, intent(out) :: no_fill + ! Local variable + integer :: no_fill_use + +#ifdef PIO2 + ierr = pio_inq_var_fill(File, vdesc, no_fill_use, fillvalue) + if (present(no_fill)) then + no_fill = no_fill_use + end if +#else + ierr = PIO_NOERR + fillvalue = 0.0_R8 +#endif + + end function inq_var_fill_r8 + subroutine find_dump_filename(fieldname, filename) ! Dummy arguments diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 new file mode 100644 index 0000000000..f65649c4ef --- /dev/null +++ b/src/utils/cam_thermo.F90 @@ -0,0 +1,1815 @@ +! cam_thermo module provides interfaces to compute thermodynamic quantities +module cam_thermo + + use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only: endrun + use air_composition, only: thermodynamic_active_species_num + use air_composition, only: thermodynamic_active_species_idx + use air_composition, only: thermodynamic_active_species_idx_dycore + use air_composition, only: thermodynamic_active_species_cp + use air_composition, only: thermodynamic_active_species_R + use air_composition, only: thermodynamic_active_species_mwi + use air_composition, only: thermodynamic_active_species_kv + use air_composition, only: thermodynamic_active_species_kc + use air_composition, only: thermodynamic_active_species_liq_num + use air_composition, only: thermodynamic_active_species_ice_num + use air_composition, only: thermodynamic_active_species_liq_idx + use air_composition, only: thermodynamic_active_species_liq_idx_dycore + use air_composition, only: thermodynamic_active_species_ice_idx + use air_composition, only: thermodynamic_active_species_ice_idx_dycore + use air_composition, only: dry_air_species_num + use air_composition, only: enthalpy_reference_state + use air_composition, only: mmro2, mmrn2, o2_mwi, n2_mwi, mbar + + implicit none + private + save + + ! subroutines to compute thermodynamic quantities + ! + ! See Lauritzen et al. (2018) for formulae + ! DOI: 10.1029/2017MS001257 + ! https://opensky.ucar.edu/islandora/object/articles:21929 + + ! cam_thermo_init: Initialize constituent dependent properties + public :: cam_thermo_init + ! cam_thermo_dry_air_update: Update dry air composition dependent properties + public :: cam_thermo_dry_air_update + ! cam_thermo_water_update: Update water dependent properties + public :: cam_thermo_water_update + ! get_enthalpy: enthalpy quantity = dp*cp*T + public :: get_enthalpy + ! get_virtual_temp: virtual temperature + public :: get_virtual_temp + ! get_sum_species: sum of thermodynamically active species: + ! Note: dp = dp_dry * sum_species + public :: get_sum_species + ! get_virtual_theta: virtual potential temperature + public :: get_virtual_theta + ! cam_thermo_calc_kappav: update species dependent kappa for FV dycore + public :: cam_thermo_calc_kappav + ! get_dp: pressure level thickness from dry dp and dry mixing ratios + public :: get_dp + ! get_pmid_from_dp: full level pressure from dp (approximation depends on dycore) + public :: get_pmid_from_dp + ! get_ps: surface pressure + public :: get_ps + ! get_gz: geopotential + public :: get_gz + ! get_Richardson_number: Richardson number at layer interfaces + public :: get_Richardson_number + ! get_kappa_dry: (generalized) dry kappa = R_dry/cp_dry + public :: get_kappa_dry + ! get_dp_ref: reference pressure layer thickness (include topography) + public :: get_dp_ref + ! get_molecular_diff_coef: molecular diffusion and thermal conductivity + public :: get_molecular_diff_coef + ! get_molecular_diff_coef_reference: reference vertical profile of density, + ! molecular diffusion and thermal conductivity + public :: get_molecular_diff_coef_reference + ! get_rho_dry: dry density from temperature (temp) and + ! pressure (dp_dry and tracer) + public :: get_rho_dry + ! get_exner: Exner pressure + public :: get_exner + ! get_hydrostatic_energy: Vertically integrated total energy + public :: get_hydrostatic_energy + + ! Public variables + ! mixing_ratio options + integer, public, parameter :: DRY_MIXING_RATIO = 1 + integer, public, parameter :: MASS_MIXING_RATIO = 2 + !--------------- Variables below here are for WACCM-X --------------------- + ! kmvis: molecular viscosity kg/m/s + real(r8), public, protected, allocatable :: kmvis(:,:,:) + ! kmcnd: molecular conductivity J/m/s/K + real(r8), public, protected, allocatable :: kmcnd(:,:,:) + + !------------- Variables for consistent themodynamics -------------------- + ! + + ! + ! Interfaces for public routines + interface get_gz + ! get_gz_geopotential (with dp_dry, ptop, temp, and phis as input) + module procedure get_gz_from_dp_dry_ptop_temp_1hd + ! get_gz_given_dp_Tv_Rdry: geopotential (with dp,dry R and Tv as input) + module procedure get_gz_given_dp_Tv_Rdry_1hd + module procedure get_gz_given_dp_Tv_Rdry_2hd + end interface get_gz + + interface get_enthalpy + module procedure get_enthalpy_1hd + module procedure get_enthalpy_2hd + end interface get_enthalpy + + interface get_virtual_temp + module procedure get_virtual_temp_1hd + module procedure get_virtual_temp_2hd + end interface get_virtual_temp + + interface get_sum_species + module procedure get_sum_species_1hd + module procedure get_sum_species_2hd + end interface get_sum_species + + interface get_dp + module procedure get_dp_1hd + module procedure get_dp_2hd + end interface get_dp + + interface get_pmid_from_dp + module procedure get_pmid_from_dpdry_1hd + module procedure get_pmid_from_dp_1hd + end interface get_pmid_from_dp + + interface get_exner + module procedure get_exner_1hd + end interface get_exner + + interface get_virtual_theta + module procedure get_virtual_theta_1hd + end interface get_virtual_theta + + interface get_Richardson_number + module procedure get_Richardson_number_1hd + end interface get_Richardson_number + + interface get_ps + module procedure get_ps_1hd + module procedure get_ps_2hd + end interface get_ps + + interface get_kappa_dry + module procedure get_kappa_dry_1hd + module procedure get_kappa_dry_2hd + end interface get_kappa_dry + + interface get_dp_ref + module procedure get_dp_ref_1hd + module procedure get_dp_ref_2hd + end interface get_dp_ref + + interface get_rho_dry + module procedure get_rho_dry_1hd + module procedure get_rho_dry_2hd + end interface get_rho_dry + + interface get_molecular_diff_coef + module procedure get_molecular_diff_coef_1hd + module procedure get_molecular_diff_coef_2hd + end interface get_molecular_diff_coef + + interface cam_thermo_calc_kappav + ! Since this routine is currently only used by the FV dycore, + ! a 1-d interface is not needed (but can easily be added) + module procedure cam_thermo_calc_kappav_2hd + end interface cam_thermo_calc_kappav + + interface get_hydrostatic_energy + module procedure get_hydrostatic_energy_1hd + ! This routine is currently only called from the physics so a + ! 2-d interface is not needed (but can easily be added) + end interface get_hydrostatic_energy + + integer, public, parameter :: thermo_budget_num_vars = 10 + integer, public, parameter :: wvidx = 1 + integer, public, parameter :: wlidx = 2 + integer, public, parameter :: wiidx = 3 + integer, public, parameter :: seidx = 4 ! enthalpy or internal energy (W/m2) index + integer, public, parameter :: poidx = 5 ! surface potential or potential energy index + integer, public, parameter :: keidx = 6 ! kinetic energy index + integer, public, parameter :: mridx = 7 + integer, public, parameter :: moidx = 8 + integer, public, parameter :: ttidx = 9 + integer, public, parameter :: teidx = 10 + character (len = 2) ,public, dimension(thermo_budget_num_vars) :: thermo_budget_vars = & + (/"WV" ,"WL" ,"WI" ,"SE" ,"PO" ,"KE" ,"MR" ,"MO" ,"TT" ,"TE" /) + character (len = 46) ,public, dimension(thermo_budget_num_vars) :: thermo_budget_vars_descriptor = (/& + "Total column water vapor ",& + "Total column liquid water ",& + "Total column frozen water ",& + "Total column enthalpy or internal energy ",& + "Total column srf potential or potential energy",& + "Total column kinetic energy ",& + "Total column wind axial angular momentum ",& + "Total column mass axial angular momentum ",& + "Total column test_tracer ",& + "Total column energy (ke + se + po) "/) + + character (len = 14), public, dimension(thermo_budget_num_vars) :: & + thermo_budget_vars_unit = (/& + "kg/m2 ","kg/m2 ","kg/m2 ","J/m2 ",& + "J/m2 ","J/m2 ","kg*m2/s*rad2 ","kg*m2/s*rad2 ",& + "kg/m2 ","J/m2 "/) + logical ,public, dimension(thermo_budget_num_vars) :: thermo_budget_vars_massv = (/& + .true.,.true.,.true.,.false.,.false.,.false.,.false.,.false.,.true.,.false./) +CONTAINS + + !=========================================================================== + + subroutine cam_thermo_init() + use shr_infnan_mod, only: assignment(=), shr_infnan_qnan + use ppgrid, only: pcols, pver, pverp, begchunk, endchunk + + integer :: ierr + character(len=*), parameter :: subname = "cam_thermo_init" + character(len=*), parameter :: errstr = subname//": failed to allocate " + + !------------------------------------------------------------------------ + ! Allocate constituent dependent properties + !------------------------------------------------------------------------ + allocate(kmvis(pcols,pverp,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"kmvis") + end if + allocate(kmcnd(pcols,pverp,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"kmcnd") + end if + + !------------------------------------------------------------------------ + ! Initialize constituent dependent properties + !------------------------------------------------------------------------ + kmvis(:pcols, :pver, begchunk:endchunk) = shr_infnan_qnan + kmcnd(:pcols, :pver, begchunk:endchunk) = shr_infnan_qnan + + end subroutine cam_thermo_init + ! + !*************************************************************************** + ! + ! cam_thermo_dry_air_update: update dry air species dependent constants for physics + ! + !*************************************************************************** + ! + subroutine cam_thermo_dry_air_update(mmr, T, lchnk, ncol, to_dry_factor) + use air_composition, only: dry_air_composition_update + use string_utils, only: int2str + !------------------------------Arguments---------------------------------- + !(mmr = dry mixing ratio, if not use to_dry_factor to convert) + real(r8), intent(in) :: mmr(:,:,:) ! constituents array + real(r8), intent(in) :: T(:,:) ! temperature + integer, intent(in) :: lchnk ! Chunk number + integer, intent(in) :: ncol ! number of columns + real(r8), optional, intent(in) :: to_dry_factor(:,:)!if mmr moist convert + ! + !---------------------------Local storage------------------------------- + real(r8):: sponge_factor(SIZE(mmr, 2)) + character(len=*), parameter :: subname = 'cam_thermo_update: ' + + if (present(to_dry_factor)) then + if (SIZE(to_dry_factor, 1) /= ncol) then + call endrun(subname//'DIM 1 of to_dry_factor is'//int2str(SIZE(to_dry_factor,1))//'but should be'//int2str(ncol)) + end if + end if + + sponge_factor = 1.0_r8 + call dry_air_composition_update(mmr, lchnk, ncol, to_dry_factor=to_dry_factor) + call get_molecular_diff_coef(T(:ncol,:), .true., sponge_factor, kmvis(:ncol,:,lchnk), & + kmcnd(:ncol,:,lchnk), tracer=mmr(:ncol,:,:), fact=to_dry_factor, & + active_species_idx_dycore=thermodynamic_active_species_idx) + end subroutine cam_thermo_dry_air_update + ! + !*************************************************************************** + ! + ! cam_thermo_water+update: update water species dependent constants for physics + ! + !*************************************************************************** + ! + subroutine cam_thermo_water_update(mmr, lchnk, ncol, vcoord, to_dry_factor) + use air_composition, only: water_composition_update + !----------------------------------------------------------------------- + ! Update the physics "constants" that vary + !------------------------------------------------------------------------- + + !------------------------------Arguments---------------------------------- + + real(r8), intent(in) :: mmr(:,:,:) ! constituents array + integer, intent(in) :: lchnk ! Chunk number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: vcoord + real(r8), optional, intent(in) :: to_dry_factor(:,:) + ! + logical :: lcp + + call water_composition_update(mmr, lchnk, ncol, vcoord, to_dry_factor=to_dry_factor) + end subroutine cam_thermo_water_update + + !=========================================================================== + + ! + !*********************************************************************** + ! + ! Compute enthalpy = cp*T*dp, where dp is pressure level thickness, + ! cp is generalized cp and T temperature + ! + ! Note: tracer is in units of m*dp_dry ("mass") + ! + !*********************************************************************** + ! + subroutine get_enthalpy_1hd(tracer_mass, temp, dp_dry, & + enthalpy, active_species_idx_dycore) + use air_composition, only: dry_air_species_num, get_cp_dry + ! Dummy arguments + ! tracer_mass: tracer array (mass weighted) + real(r8), intent(in) :: tracer_mass(:,:,:) + ! temp: temperature + real(r8), intent(in) :: temp(:,:) + ! dp_dry: dry presure level thickness + real(r8), intent(in) :: dp_dry(:,:) + ! enthalpy: enthalpy in each column: sum cp*T*dp + real(r8), intent(out) :: enthalpy(:,:) + ! + ! active_species_idx_dycore: + ! array of indicies for index of thermodynamic active species in + ! dycore tracer array (if different from physics index) + ! + integer, optional, intent(in) :: active_species_idx_dycore(:) + + ! Local vars + integer :: qdx, itrac + character(len=*), parameter :: subname = 'get_enthalpy: ' + + ! + ! "mass-weighted" cp (dp must be dry) + ! + if (dry_air_species_num == 0) then + enthalpy(:,:) = thermodynamic_active_species_cp(0) * & + dp_dry(:,:) + else + if (present(active_species_idx_dycore)) then + call get_cp_dry(tracer_mass, active_species_idx_dycore, & + enthalpy, fact=1.0_r8/dp_dry(:,:)) + else + call get_cp_dry(tracer_mass, thermodynamic_active_species_idx, & + enthalpy, fact=1.0_r8/dp_dry(:,:)) + end if + enthalpy(:,:) = enthalpy(:,:) * dp_dry(:,:) + end if + ! + ! tracer is in units of m*dp ("mass"), where: + ! m is the dry mixing ratio + ! dp is the dry pressure level thickness + ! + do qdx = dry_air_species_num + 1, thermodynamic_active_species_num + if (present(active_species_idx_dycore)) then + itrac = active_species_idx_dycore(qdx) + else + itrac = thermodynamic_active_species_idx(qdx) + end if + enthalpy(:,:) = enthalpy(:,:) + & + (thermodynamic_active_species_cp(qdx) * tracer_mass(:,:,itrac)) + end do + enthalpy(:,:) = enthalpy(:,:) * temp(:,:) + + end subroutine get_enthalpy_1hd + + !=========================================================================== + + subroutine get_enthalpy_2hd(tracer_mass, temp, dp_dry, & + enthalpy, active_species_idx_dycore) + ! Dummy arguments + ! tracer_mass: tracer array (mass weighted) + real(r8), intent(in) :: tracer_mass(:,:,:,:) + ! temp: temperature + real(r8), intent(in) :: temp(:,:,:) + ! dp_dry: dry presure level thickness + real(r8), intent(in) :: dp_dry(:,:,:) + ! enthalpy: enthalpy in each column: sum cp*T*dp + real(r8), intent(out) :: enthalpy(:,:,:) + ! + ! active_species_idx_dycore: + ! array of indicies for index of thermodynamic active species in + ! dycore tracer array (if different from physics index) + ! + integer, optional, intent(in) :: active_species_idx_dycore(:) + + ! Local variables + integer :: jdx + character(len=*), parameter :: subname = 'get_enthalpy_2hd: ' + + do jdx = 1, SIZE(tracer_mass, 2) + call get_enthalpy(tracer_mass(:, jdx, :, :), temp(:, jdx, :), & + dp_dry(:, jdx, :), enthalpy(:, jdx, :), & + active_species_idx_dycore=active_species_idx_dycore) + end do + + end subroutine get_enthalpy_2hd + + !=========================================================================== + + !************************************************************************** + ! + ! get_virtual_temp: Compute virtual temperature T_v + ! + ! tracer is in units of dry mixing ratio unless optional argument + ! dp_dry is present in which case tracer is in units of "mass" (=m*dp) + ! + ! If temperature is not supplied then just return factor that T + ! needs to be multiplied by to get T_v + ! + !************************************************************************** + ! + subroutine get_virtual_temp_1hd(tracer, T_v, temp, dp_dry, sum_q, & + active_species_idx_dycore) + use cam_abortutils, only: endrun + use string_utils, only: int2str + use air_composition, only: dry_air_species_num, get_R_dry + + ! Dummy Arguments + ! tracer: tracer array + real(r8), intent(in) :: tracer(:, :, :) + ! T_v: virtual temperature + real(r8), intent(out) :: T_v(:, :) + ! temp: temperature + real(r8), optional, intent(in) :: temp(:, :) + ! dp_dry: dry pressure level thickness + real(r8), optional, intent(in) :: dp_dry(:, :) + ! sum_q: sum tracer + real(r8), optional, intent(out) :: sum_q(:, :) + ! + ! array of indicies for index of thermodynamic active species in + ! dycore tracer array (if different from physics index) + ! + integer, optional, intent(in) :: active_species_idx_dycore(:) + + ! Local Variables + integer :: itrac, qdx + real(r8) :: sum_species(SIZE(tracer, 1), SIZE(tracer, 2)) + real(r8) :: factor(SIZE(tracer, 1), SIZE(tracer, 2)) + real(r8) :: Rd(SIZE(tracer, 1), SIZE(tracer, 2)) + integer :: idx_local(thermodynamic_active_species_num) + character(len=*), parameter :: subname = 'get_virtual_temp_1hd: ' + + if (present(active_species_idx_dycore)) then + if (SIZE(active_species_idx_dycore) /= & + thermodynamic_active_species_num) then + call endrun(subname//"SIZE mismatch "// & + int2str(SIZE(active_species_idx_dycore))//' /= '// & + int2str(thermodynamic_active_species_num)) + end if + idx_local = active_species_idx_dycore + else + idx_local = thermodynamic_active_species_idx + end if + + call get_sum_species(tracer, idx_local, sum_species, dp_dry=dp_dry, factor=factor) + + call get_R_dry(tracer, idx_local, Rd, fact=factor) + t_v(:, :) = Rd(:, :) + do qdx = dry_air_species_num + 1, thermodynamic_active_species_num + itrac = idx_local(qdx) + t_v(:, :) = t_v(:, :) + (thermodynamic_active_species_R(qdx) * & + tracer(:, :, itrac) * factor(:, :)) + end do + if (present(temp)) then + t_v(:, :) = t_v(:, :) * temp(:, :) / (Rd(:, :) * sum_species) + else + t_v(:, :) = t_v(:, :) / (Rd(:, :) * sum_species) + end if + if (present(sum_q)) then + sum_q = sum_species + end if + + end subroutine get_virtual_temp_1hd + + !=========================================================================== + + subroutine get_virtual_temp_2hd(tracer, T_v, temp, dp_dry, sum_q, & + active_species_idx_dycore) + + ! Dummy Arguments + ! tracer: tracer array + real(r8), intent(in) :: tracer(:, :, :, :) + ! T_v: virtual temperature + real(r8), intent(out) :: T_v(:, :, :) + ! temp: temperature + real(r8), optional, intent(in) :: temp(:, :, :) + ! dp_dry: dry pressure level thickness + real(r8), optional, intent(in) :: dp_dry(:, :, :) + ! sum_q: sum tracer + real(r8), optional, intent(out) :: sum_q(:, :, :) + ! + ! array of indicies for index of thermodynamic active species in + ! dycore tracer array (if different from physics index) + ! + integer, optional, intent(in) :: active_species_idx_dycore(:) + + ! Local vars + integer :: jdx + character(len=*), parameter :: subname = 'get_virtual_temp_2hd: ' + + ! Rather than do a bunch of copying into temp variables, do the + ! combinatorics + do jdx = 1, SIZE(tracer, 2) + if (present(temp) .and. present(dp_dry) .and. present(sum_q)) then + call get_virtual_temp(tracer(:, jdx, :, :), T_v(:, jdx, :), & + temp=temp(:, jdx, :), dp_dry=dp_dry(:, jdx, :), & + sum_q=sum_q(:, jdx, :), & + active_species_idx_dycore=active_species_idx_dycore) + else if (present(temp) .and. present(dp_dry)) then + call get_virtual_temp(tracer(:, jdx, :, :), T_v(:, jdx, :), & + temp=temp(:, jdx, :), dp_dry=dp_dry(:, jdx, :), & + active_species_idx_dycore=active_species_idx_dycore) + else if (present(temp) .and. present(sum_q)) then + call get_virtual_temp(tracer(:, jdx, :, :), T_v(:, jdx, :), & + temp=temp(:, jdx, :), sum_q=sum_q(:, jdx, :), & + active_species_idx_dycore=active_species_idx_dycore) + else if (present(dp_dry) .and. present(sum_q)) then + call get_virtual_temp(tracer(:, jdx, :, :), T_v(:, jdx, :), & + dp_dry=dp_dry(:, jdx, :), sum_q=sum_q(:, jdx, :), & + active_species_idx_dycore=active_species_idx_dycore) + else if (present(temp)) then + call get_virtual_temp(tracer(:, jdx, :, :), T_v(:, jdx, :), & + temp=temp(:, jdx, :), & + active_species_idx_dycore=active_species_idx_dycore) + else if (present(dp_dry)) then + call get_virtual_temp(tracer(:, jdx, :, :), T_v(:, jdx, :), & + dp_dry=dp_dry(:, jdx, :), & + active_species_idx_dycore=active_species_idx_dycore) + else if (present(sum_q)) then + call get_virtual_temp(tracer(:, jdx, :, :), T_v(:, jdx, :), & + sum_q=sum_q(:, jdx, :), & + active_species_idx_dycore=active_species_idx_dycore) + else + call get_virtual_temp(tracer(:, jdx, :, :), T_v(:, jdx, :), & + active_species_idx_dycore=active_species_idx_dycore) + end if + end do + + end subroutine get_virtual_temp_2hd + + !=========================================================================== + + ! + !*************************************************************************** + ! + ! get_sum_species: + ! + ! Compute sum of thermodynamically active species + ! + ! tracer is in units of dry mixing ratio unless optional argument + ! dp_dry is present in which case tracer is in units of "mass" (=m*dp) + ! + !*************************************************************************** + ! + subroutine get_sum_species_1hd(tracer, active_species_idx, & + sum_species, dp_dry, factor) + use air_composition, only: dry_air_species_num + + ! Dummy arguments + ! tracer: Tracer array + real(r8), intent(in) :: tracer(:, :, :) + ! active_species_idx: Index for thermodynamic active tracers + integer, intent(in) :: active_species_idx(:) + ! dp_dry: Dry pressure level thickness. + ! If present, then tracer is in units of mass + real(r8), optional, intent(in) :: dp_dry(:, :) + ! sum_species: sum species + real(r8), intent(out) :: sum_species(:, :) + ! factor: to moist factor + real(r8), optional, intent(out) :: factor(:, :) + ! Local variables + real(r8) :: factor_loc(SIZE(tracer, 1), SIZE(tracer, 2)) + integer :: qdx, itrac + if (present(dp_dry)) then + factor_loc = 1.0_r8 / dp_dry(:,:) + else + factor_loc = 1.0_r8 + end if + sum_species = 1.0_r8 ! all dry air species sum to 1 + do qdx = dry_air_species_num + 1, thermodynamic_active_species_num + itrac = active_species_idx(qdx) + sum_species(:,:) = sum_species(:,:) + (tracer(:,:,itrac) * factor_loc(:,:)) + end do + if (present(factor)) then + factor = factor_loc + end if + end subroutine get_sum_species_1hd + + !=========================================================================== + + subroutine get_sum_species_2hd(tracer, active_species_idx, & + sum_species,dp_dry, factor) + + ! Dummy arguments + ! tracer: Tracer array + real(r8), intent(in) :: tracer(:, :, :, :) + ! active_species_idx: Index for thermodynamic active tracers + integer, intent(in) :: active_species_idx(:) + ! dp_dry: Dry pressure level thickness. + ! If present, then tracer is in units of mass + real(r8), optional, intent(in) :: dp_dry(:, :, :) + ! sum_species: sum species + real(r8), intent(out) :: sum_species(:, :, :) + ! factor: to moist factor + real(r8), optional, intent(out) :: factor(:, :, :) + ! Local variable + integer :: jdx + + do jdx = 1, SIZE(tracer, 2) + if (present(dp_dry) .and. present(factor)) then + call get_sum_species(tracer(:, jdx, :, :), active_species_idx, & + sum_species(:, jdx, :), dp_dry=dp_dry(:, jdx, :), factor=factor(:, jdx, :)) + else if (present(dp_dry)) then + call get_sum_species(tracer(:, jdx, :, :), active_species_idx, & + sum_species(:, jdx, :), dp_dry=dp_dry(:, jdx, :)) + else if (present(factor)) then + call get_sum_species(tracer(:, jdx, :, :), active_species_idx, & + sum_species(:, jdx, :), factor=factor(:, jdx, :)) + else + call get_sum_species(tracer(:, jdx, :, :), active_species_idx, & + sum_species(:, jdx, :)) + end if + end do + + end subroutine get_sum_species_2hd + + !=========================================================================== + + !*************************************************************************** + ! + ! get_dp: Compute pressure level thickness from dry pressure and + ! thermodynamic active species mixing ratios + ! + ! Tracer can either be in units of dry mixing ratio (mixing_ratio=1) or + ! "mass" (=m*dp_dry) (mixing_ratio=2) + ! + !*************************************************************************** + ! + subroutine get_dp_1hd(tracer, mixing_ratio, active_species_idx, dp_dry, dp, ps, ptop) + use air_composition, only: dry_air_species_num + use string_utils, only: int2str + + real(r8), intent(in) :: tracer(:, :, :) ! tracers; quantity specified by mixing_ratio arg + integer, intent(in) :: mixing_ratio ! 1 => tracer is dry mixing ratio + ! 2 => tracer is mass (q*dp) + integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array + real(r8), intent(in) :: dp_dry(:, :) ! dry pressure level thickness + real(r8), intent(out) :: dp(:, :) ! pressure level thickness + real(r8), optional,intent(out) :: ps(:) ! surface pressure (if ps present then ptop + ! must be present) + real(r8), optional,intent(in) :: ptop ! pressure at model top + + integer :: idx, kdx, m_cnst, qdx + + character(len=*), parameter :: subname = 'get_dp_1hd: ' + + dp = dp_dry + if (mixing_ratio == DRY_MIXING_RATIO) then + do qdx = dry_air_species_num + 1, thermodynamic_active_species_num + m_cnst = active_species_idx(qdx) + do kdx = 1, SIZE(tracer, 2) + do idx = 1, SIZE(tracer, 1) + dp(idx, kdx) = dp(idx, kdx) + dp_dry(idx, kdx)*tracer(idx, kdx, m_cnst) + end do + end do + end do + else if (mixing_ratio == MASS_MIXING_RATIO) then + do qdx = dry_air_species_num + 1, thermodynamic_active_species_num + m_cnst = active_species_idx(qdx) + do kdx = 1, SIZE(tracer, 2) + do idx = 1, SIZE(tracer, 1) + dp(idx, kdx) = dp(idx, kdx) + tracer(idx, kdx, m_cnst) + end do + end do + end do + else + call endrun(subname//'unrecognized input ('//int2str(mixing_ratio)//') for mixing_ratio') + end if + if (present(ps)) then + if (present(ptop)) then + ps = ptop + do kdx = 1, SIZE(tracer, 2) + do idx = 1, SIZE(tracer, 1) + ps(idx) = ps(idx) + dp(idx, kdx) + end do + end do + else + call endrun(subname//'if ps is present ptop must be present') + end if + end if + end subroutine get_dp_1hd + + subroutine get_dp_2hd(tracer, mixing_ratio, active_species_idx, dp_dry, dp, ps, ptop) + ! Version of get_dp for arrays that have a second horizontal index + real(r8), intent(in) :: tracer(:,:,:,:) ! tracers; quantity specified by mixing_ratio arg + integer, intent(in) :: mixing_ratio ! 1 => tracer is dry mixing ratio + ! 2 => tracer is mass (q*dp) + integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array + real(r8), intent(in) :: dp_dry(:,:,:) ! dry pressure level thickness + real(r8), intent(out) :: dp(:,:,:) ! pressure level thickness + real(r8), optional,intent(out) :: ps(:,:) ! surface pressure + real(r8), optional,intent(in) :: ptop ! pressure at model top + + integer :: jdx + + do jdx = 1, SIZE(tracer, 2) + if (present(ps)) then + call get_dp(tracer(:, jdx, :, :), mixing_ratio, active_species_idx, & + dp_dry(:, jdx, :), dp(:, jdx, :), ps=ps(:,jdx), ptop=ptop) + else + call get_dp(tracer(:, jdx, :, :), mixing_ratio, active_species_idx, & + dp_dry(:, jdx, :), dp(:, jdx, :), ptop=ptop) + end if + end do + + end subroutine get_dp_2hd + !=========================================================================== + + !************************************************************************************************************************* + ! + ! compute mid-level (full level) pressure from dry pressure and water tracers + ! + !************************************************************************************************************************* + ! + subroutine get_pmid_from_dpdry_1hd(tracer, mixing_ratio, active_species_idx, dp_dry, ptop, pmid, pint, dp) + + real(r8), intent(in) :: tracer(:,:,:) ! tracers; quantity specified by mixing_ratio arg + integer, intent(in) :: mixing_ratio ! 1 => tracer is mixing ratio + ! 2 => tracer is mass (q*dp) + integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array + real(r8), intent(in) :: dp_dry(:,:) ! dry pressure level thickness + real(r8), intent(in) :: ptop ! model top pressure + real(r8), intent(out) :: pmid(:,:) ! mid-level pressure + real(r8), optional, intent(out) :: pint(:,:) ! half-level pressure + real(r8), optional, intent(out) :: dp(:,:) ! presure level thickness + + real(r8) :: dp_local(SIZE(tracer, 1), SIZE(tracer, 2)) ! local pressure level thickness + real(r8) :: pint_local(SIZE(tracer, 1), SIZE(tracer, 2) + 1)! local interface pressure + + call get_dp(tracer, mixing_ratio, active_species_idx, dp_dry, dp_local) + + call get_pmid_from_dp(dp_local, ptop, pmid, pint_local) + + if (present(pint)) pint=pint_local + if (present(dp)) dp=dp_local + end subroutine get_pmid_from_dpdry_1hd + + !=========================================================================== + + !************************************************************************************************************************* + ! + ! compute mid-level (full level) pressure + ! + !************************************************************************************************************************* + ! + subroutine get_pmid_from_dp_1hd(dp, ptop, pmid, pint) + use dycore, only: dycore_is + real(r8), intent(in) :: dp(:,:) ! pressure level thickness + real(r8), intent(in) :: ptop ! pressure at model top + real(r8), intent(out) :: pmid(:,:) ! mid (full) level pressure + real(r8), optional, intent(out) :: pint(:,:) ! pressure at interfaces (half levels) + + real(r8) :: pint_local(SIZE(dp, 1), SIZE(dp,2) + 1) + integer :: kdx + + pint_local(:, 1) = ptop + do kdx = 2, SIZE(dp, 2) + 1 + pint_local(:, kdx) = dp(:, kdx - 1) + pint_local(:, kdx - 1) + end do + + if (dycore_is('LR') .or. dycore_is('FV3')) then + do kdx = 1, SIZE(dp, 2) + pmid(:, kdx) = dp(:, kdx) / (log(pint_local(:, kdx + 1)) - log(pint_local(:, kdx))) + end do + else + do kdx = 1, SIZE(dp, 2) + pmid(:, kdx) = 0.5_r8 * (pint_local(:, kdx) + pint_local(:, kdx + 1)) + end do + end if + if (present(pint)) pint=pint_local + end subroutine get_pmid_from_dp_1hd + + !=========================================================================== + + !**************************************************************************************************************** + ! + ! Compute Exner pressure + ! + !**************************************************************************************************************** + ! + subroutine get_exner_1hd(tracer, mixing_ratio, active_species_idx, dp_dry, ptop, p00, inv_exner, exner, poverp0) + use string_utils, only: int2str + real(r8), intent(in) :: tracer(:,:,:) ! tracers; quantity specified by mixing_ratio arg + integer, intent(in) :: mixing_ratio ! 1 => tracer is mixing ratio + ! 2 => tracer is mass (q*dp) + integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array + real(r8), intent(in) :: dp_dry(:,:) ! dry pressure level thickness + real(r8), intent(in) :: ptop ! pressure at model top + real(r8), intent(in) :: p00 ! reference pressure for Exner pressure (usually 1000hPa) + logical , intent(in) :: inv_exner ! logical for outputting inverse Exner or Exner pressure + real(r8), intent(out) :: exner(:,:) + real(r8), optional, intent(out) :: poverp0(:,:) ! for efficiency when a routine needs this variable + + real(r8) :: pmid(SIZE(tracer, 1), SIZE(tracer, 2)) + real(r8) :: kappa_dry(SIZE(tracer, 1), SIZE(tracer, 2)) + character(len=*), parameter :: subname = 'get_exner_1hd: ' + ! + ! compute mid level pressure + ! + call get_pmid_from_dp(tracer, mixing_ratio, active_species_idx, dp_dry, ptop, pmid) + ! + ! compute kappa = Rd / cpd + ! + if (mixing_ratio == DRY_MIXING_RATIO) then + call get_kappa_dry(tracer, active_species_idx, kappa_dry) + else if (mixing_ratio == MASS_MIXING_RATIO) then + call get_kappa_dry(tracer, active_species_idx, kappa_dry, 1.0_r8 / dp_dry) + else + call endrun(subname//'unrecognized input ('//int2str(mixing_ratio)//') for mixing_ratio') + end if + if (inv_exner) then + exner(:,:) = (p00 / pmid(:,:)) ** kappa_dry(:,:) + else + exner(:,:) = (pmid(:,:) / p00) ** kappa_dry(:,:) + end if + if (present(poverp0)) poverp0 = pmid(:,:) / p00 + end subroutine get_exner_1hd + + !=========================================================================== + + !**************************************************************************************************************** + ! + ! Compute virtual potential temperature from dp_dry, m, T and ptop. + ! + !**************************************************************************************************************** + ! + subroutine get_virtual_theta_1hd(tracer, mixing_ratio, active_species_idx, dp_dry, ptop, p00, temp, theta_v) + real(r8), intent(in) :: tracer(:,:,:) ! tracers; quantity specified by mixing_ratio arg + integer, intent(in) :: mixing_ratio ! 1 => tracer is dry mixing ratio + ! 2 => tracer is mass (q*dp) + integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array + real(r8), intent(in) :: dp_dry(:,:) ! dry pressure level thickness + real(r8), intent(in) :: ptop ! pressure at model top + real(r8), intent(in) :: p00 ! reference pressure for Exner pressure (usually 1000hPa) + real(r8), intent(in) :: temp(:,:) ! temperature + real(r8), intent(out) :: theta_v(:,:) ! virtual potential temperature + + real(r8) :: iexner(SIZE(tracer, 1), SIZE(tracer, 2)) + + call get_exner(tracer, mixing_ratio, active_species_idx, dp_dry, ptop, p00, .true., iexner) + + theta_v(:,:) = temp(:,:) * iexner(:,:) + + end subroutine get_virtual_theta_1hd + + !=========================================================================== + + !**************************************************************************************************************** + ! + ! Compute geopotential from dry pressure level thichkness, water tracers, model top pressure and temperature + ! + !**************************************************************************************************************** + ! + subroutine get_gz_from_dp_dry_ptop_temp_1hd(tracer, mixing_ratio, active_species_idx, & + dp_dry, ptop, temp, phis, gz, pmid, dp, T_v) + use air_composition, only: get_R_dry + use string_utils, only: int2str + real(r8), intent(in) :: tracer(:,:,:) ! tracer; quantity specified by mixing_ratio arg + integer, intent(in) :: mixing_ratio ! 1 => tracer is dry mixing ratio + ! 2 => tracer is mass (q*dp) + integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array + real(r8), intent(in) :: dp_dry(:,:) ! dry pressure level thickness + real(r8), intent(in) :: ptop ! pressure at model top + real(r8), intent(in) :: temp(:,:) ! temperature + real(r8), intent(in) :: phis(:) ! surface geopotential + real(r8), intent(out) :: gz(:,:) ! geopotential + real(r8), optional, intent(out) :: pmid(:,:) ! mid-level pressure + real(r8), optional, intent(out) :: dp(:,:) ! pressure level thickness + real(r8), optional, intent(out) :: t_v(:,:) ! virtual temperature + + + real(r8), dimension(SIZE(tracer, 1), SIZE(tracer, 2)) :: pmid_local, t_v_local, dp_local, R_dry + real(r8), dimension(SIZE(tracer, 1), SIZE(tracer, 2) + 1) :: pint + character(len=*), parameter :: subname = 'get_gz_from_dp_dry_ptop_temp_1hd: ' + + + call get_pmid_from_dp(tracer, mixing_ratio, active_species_idx, & + dp_dry, ptop, pmid_local, pint=pint, dp=dp_local) + if (mixing_ratio == DRY_MIXING_RATIO) then + call get_virtual_temp(tracer, t_v_local, temp=temp, active_species_idx_dycore=active_species_idx) + call get_R_dry(tracer, active_species_idx, R_dry) + else if (mixing_ratio == MASS_MIXING_RATIO) then + call get_virtual_temp(tracer, t_v_local, temp=temp, dp_dry=dp_dry, active_species_idx_dycore=active_species_idx) + call get_R_dry(tracer,active_species_idx, R_dry, fact=1.0_r8 / dp_dry) + else + call endrun(subname//'unrecognized input ('//int2str(mixing_ratio)//') for mixing_ratio') + end if + call get_gz(dp_local, T_v_local, R_dry, phis, ptop, gz, pmid_local) + + if (present(pmid)) pmid=pmid_local + if (present(T_v)) T_v=T_v_local + if (present(dp)) dp=dp_local + end subroutine get_gz_from_dp_dry_ptop_temp_1hd + + !=========================================================================== + + !*************************************************************************** + ! + ! Compute geopotential from pressure level thickness and virtual temperature + ! + !*************************************************************************** + ! + subroutine get_gz_given_dp_Tv_Rdry_1hd(dp, T_v, R_dry, phis, ptop, gz, pmid) + use dycore, only: dycore_is + real(r8), intent(in) :: dp (:,:) ! pressure level thickness + real(r8), intent(in) :: T_v (:,:) ! virtual temperature + real(r8), intent(in) :: R_dry(:,:) ! R dry + real(r8), intent(in) :: phis (:) ! surface geopotential + real(r8), intent(in) :: ptop ! model top presure + real(r8), intent(out) :: gz(:,:) ! geopotential + real(r8), optional, intent(out) :: pmid(:,:) ! mid-level pressure + + + real(r8), dimension(SIZE(dp, 1), SIZE(dp, 2)) :: pmid_local + real(r8), dimension(SIZE(dp, 1), SIZE(dp, 2) + 1) :: pint + real(r8), dimension(SIZE(dp, 1)) :: gzh, Rdry_tv + integer :: kdx + + call get_pmid_from_dp(dp, ptop, pmid_local, pint) + + ! + ! integrate hydrostatic eqn + ! + gzh = phis + if (dycore_is('LR') .or. dycore_is('FV3')) then + do kdx = SIZE(dp, 2), 1, -1 + Rdry_tv(:) = R_dry(:, kdx) * T_v(:, kdx) + gz(:, kdx) = gzh(:) + Rdry_tv(:) * (1.0_r8 - pint(:, kdx) / pmid_local(:, kdx)) + gzh(:) = gzh(:) + Rdry_tv(:) * (log(pint(:, kdx + 1)) - log(pint(:, kdx))) + end do + else + do kdx = SIZE(dp,2), 1, -1 + Rdry_tv(:) = R_dry(:,kdx) * T_v(:, kdx) + gz(:,kdx) = gzh(:) + Rdry_tv(:) * 0.5_r8 * dp(:, kdx) / pmid_local(:, kdx) + gzh(:) = gzh(:) + Rdry_tv(:) * dp(:, kdx) / pmid_local(:, kdx) + end do + end if + if (present(pmid)) pmid=pmid_local + end subroutine get_gz_given_dp_Tv_Rdry_1hd + + subroutine get_gz_given_dp_Tv_Rdry_2hd(dp, T_v, R_dry, phis, ptop, gz, pmid) + ! Version of get_gz_given_dp_Tv_Rdry for arrays that have a second horizontal index + real(r8), intent(in) :: dp (:,:,:) ! pressure level thickness + real(r8), intent(in) :: T_v (:,:,:) ! virtual temperature + real(r8), intent(in) :: R_dry(:,:,:) ! R dry + real(r8), intent(in) :: phis (:,:) ! surface geopotential + real(r8), intent(in) :: ptop ! model top presure + real(r8), intent(out) :: gz(:,:,:) ! geopotential + real(r8), optional, intent(out) :: pmid(:,:,:) ! mid-level pressure + + integer :: jdx + + do jdx = 1, SIZE(dp, 2) + if (present(pmid)) then + call get_gz(dp(:, jdx, :), T_v(:, jdx, :), R_dry(:, jdx, :), phis(:, jdx), & + ptop, gz(:, jdx, :), pmid=pmid(:, jdx, :)) + else + call get_gz(dp(:, jdx, :), T_v(:, jdx, :), R_dry(:, jdx, :), phis(:, jdx), ptop, gz(:, jdx, :)) + end if + end do + + + end subroutine get_gz_given_dp_Tv_Rdry_2hd + + !=========================================================================== + + !*************************************************************************** + ! + ! Compute Richardson number at cell interfaces (half levels) + ! + !*************************************************************************** + ! + subroutine get_Richardson_number_1hd(tracer,mixing_ratio, active_species_idx, dp_dry, ptop, & + p00, temp, v, Richardson_number, pmid, dp) + real(r8), intent(in) :: tracer(:,:,:) ! tracer; quantity specified by mixing_ratio arg + integer, intent(in) :: mixing_ratio ! 1 => tracer is dry mixing ratio + ! 2 => tracer is mass (q*dp) + integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array + real(r8), intent(in) :: dp_dry(:,:) ! dry pressure level thickness + real(r8), intent(in) :: ptop ! pressure at model top + real(r8), intent(in) :: p00 ! reference pressure for Exner pressure (usually 1000hPa) + real(r8), intent(in) :: temp(:,:) ! temperature + real(r8), intent(in) :: v(:,:,:) ! velocity components + real(r8), intent(out) :: Richardson_number(:,:) + real(r8), optional, intent(out) :: pmid(:,:) + real(r8), optional, intent(out) :: dp(:,:) + + real(r8), dimension(SIZE(tracer, 1), SIZE(tracer, 2)) :: gz, theta_v + real(r8), dimension(SIZE(tracer, 1)) :: pt1, pt2, phis + integer :: kdx, kdxm1 + real(r8), parameter:: ustar2 = 1.E-4_r8 + + phis = 0.0_r8 + call get_gz(tracer, mixing_ratio, active_species_idx, dp_dry, ptop, temp, phis, gz, pmid=pmid, dp=dp) + call get_virtual_theta(tracer, mixing_ratio, active_species_idx, dp_dry, ptop, p00, temp, theta_v) + Richardson_number(:, 1) = 0.0_r8 + Richardson_number(:, SIZE(tracer, 2) + 1) = 0.0_r8 + do kdx = SIZE(tracer, 2), 2, -1 + kdxm1 = kdx - 1 + pt1(:) = theta_v(:, kdxm1) + pt2(:) = theta_v(:, kdx) + Richardson_number(:, kdx) = (gz(:, kdxm1) - gz(:, kdx)) * (pt1 - pt2) / ( 0.5_r8*(pt1 + pt2) * & + ((v(:, 1, kdxm1) - v(:, 1, kdx)) ** 2 + (v(:, 2, kdxm1) - v(:, 2, kdx)) ** 2 + ustar2) ) + end do + end subroutine get_Richardson_number_1hd + + ! + !**************************************************************************************************************** + ! + ! get surface pressure from dry pressure and thermodynamic active species (e.g., forms of water: water vapor, cldliq, etc.) + ! + !**************************************************************************************************************** + ! + subroutine get_ps_1hd(tracer_mass, active_species_idx, dp_dry, ps, ptop) + use air_composition, only: dry_air_species_num + + real(r8), intent(in) :: tracer_mass(:,:,:) ! Tracer array (q*dp) + real(r8), intent(in) :: dp_dry(:,:) ! dry pressure level thickness + real(r8), intent(out) :: ps(:) ! surface pressure + real(r8), intent(in) :: ptop + integer, intent(in) :: active_species_idx(:) + + integer :: idx, kdx, m_cnst, qdx + real(r8) :: dp(SIZE(tracer_mass, 1), SIZE(tracer_mass, 2)) ! dry pressure level thickness + + dp = dp_dry + do qdx = dry_air_species_num + 1, thermodynamic_active_species_num + m_cnst = active_species_idx(qdx) + do kdx = 1, SIZE(tracer_mass, 2) + do idx = 1, SIZE(tracer_mass, 1) + dp(idx, kdx) = dp(idx, kdx) + tracer_mass(idx, kdx, m_cnst) + end do + end do + end do + ps = ptop + do kdx = 1, SIZE(tracer_mass, 2) + do idx = 1, SIZE(tracer_mass, 1) + ps(idx) = ps(idx) + dp(idx, kdx) + end do + end do + end subroutine get_ps_1hd + + subroutine get_ps_2hd(tracer_mass, active_species_idx, dp_dry, ps, ptop) + ! Version of get_ps for arrays that have a second horizontal index + real(r8), intent(in) :: tracer_mass(:,:,:,:) ! Tracer array (q*dp) + real(r8), intent(in) :: dp_dry(:,:,:) ! dry pressure level thickness + real(r8), intent(out) :: ps(:,:) ! surface pressure + real(r8), intent(in) :: ptop + integer, intent(in) :: active_species_idx(:) + + integer :: jdx + + do jdx = 1, SIZE(tracer_mass, 2) + call get_ps(tracer_mass(:, jdx, :, :), active_species_idx, dp_dry(:, jdx, :), ps(:, jdx), ptop) + end do + + end subroutine get_ps_2hd + + !=========================================================================== + + !************************************************************************************************************************* + ! + ! compute generalized kappa =Rdry/cpdry + ! + !************************************************************************************************************************* + ! + subroutine get_kappa_dry_1hd(tracer, active_species_idx, kappa_dry, fact) + use air_composition, only: dry_air_species_num, get_R_dry, get_cp_dry + use physconst, only: rair, cpair + + real(r8), intent(in) :: tracer(:,:,:) !tracer array + integer, intent(in) :: active_species_idx(:) !index of thermodynamic active tracers + real(r8), intent(out) :: kappa_dry(:,:) !kappa dry + real(r8), optional, intent(in) :: fact(:,:) !factor for converting tracer to dry mixing ratio + ! + real(r8), allocatable, dimension(:,:) :: cp_dry,R_dry + integer :: ierr + character(len=*), parameter :: subname = "get_kappa_dry_1hd" + character(len=*), parameter :: errstr = subname//": failed to allocate " + ! + ! dry air not species dependent + if (dry_air_species_num==0) then + kappa_dry = rair / cpair + else + allocate(R_dry(SIZE(kappa_dry, 1), SIZE(kappa_dry, 2)), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"R_dry") + end if + allocate(cp_dry(SIZE(kappa_dry, 1), SIZE(kappa_dry, 2)), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"cp_dry") + end if + call get_cp_dry(tracer, active_species_idx, cp_dry, fact=fact) + call get_R_dry( tracer, active_species_idx, R_dry, fact=fact) + kappa_dry = R_dry / cp_dry + deallocate(R_dry, cp_dry) + end if + end subroutine get_kappa_dry_1hd + + subroutine get_kappa_dry_2hd(tracer, active_species_idx, kappa_dry, fact) + ! Version of get_kappa_dry for arrays that have a second horizontal index + real(r8), intent(in) :: tracer(:,:,:,:) !tracer array + integer, intent(in) :: active_species_idx(:) !index of thermodynamic active tracers + real(r8), intent(out) :: kappa_dry(:,:,:) !kappa dry + real(r8), optional, intent(in) :: fact(:,:,:) !factor for converting tracer to dry mixing ratio + + integer :: jdx + + do jdx = 1, SIZE(tracer, 2) + if (present(fact)) then + call get_kappa_dry(tracer(:, jdx, :, :), active_species_idx, kappa_dry(:, jdx, :), fact=fact(:, jdx, :)) + else + call get_kappa_dry(tracer(:, jdx, :, :), active_species_idx, kappa_dry(:, jdx, :)) + end if + end do + + end subroutine get_kappa_dry_2hd + + !=========================================================================== + + !************************************************************************************************************************* + ! + ! compute reference pressure levels + ! + !************************************************************************************************************************* + ! + subroutine get_dp_ref_1hd(hyai, hybi, ps0, phis, dp_ref, ps_ref) + use physconst, only: tref, rair + real(r8), intent(in) :: hyai(:) + real(r8), intent(in) :: hybi(:) + real(r8), intent(in) :: ps0 + real(r8), intent(in) :: phis(:) + real(r8), intent(out) :: dp_ref(:,:) + real(r8), intent(out) :: ps_ref(:) + integer :: kdx + ! + ! use static reference pressure (hydrostatic balance incl. effect of topography) + ! + ps_ref(:) = ps0 * exp(-phis(:) / (rair * tref)) + do kdx = 1, SIZE(dp_ref, 2) + dp_ref(:,kdx) = ((hyai(kdx + 1) - hyai(kdx)) * ps0 + (hybi(kdx + 1) - hybi(kdx)) * ps_ref(:)) + end do + end subroutine get_dp_ref_1hd + + subroutine get_dp_ref_2hd(hyai, hybi, ps0, phis, dp_ref, ps_ref) + ! Version of get_dp_ref for arrays that have a second horizontal index + real(r8), intent(in) :: hyai(:) + real(r8), intent(in) :: hybi(:) + real(r8), intent(in) :: ps0 + real(r8), intent(in) :: phis(:,:) + real(r8), intent(out) :: dp_ref(:,:,:) + real(r8), intent(out) :: ps_ref(:,:) + integer :: jdx + + do jdx = 1, SIZE(dp_ref, 2) + call get_dp_ref(hyai, hybi, ps0, phis(:, jdx), dp_ref(:, jdx, :), ps_ref(:, jdx)) + end do + + end subroutine get_dp_ref_2hd + + !=========================================================================== + + !************************************************************************************************************************* + ! + ! compute dry densisty from temperature (temp) and pressure (dp_dry and tracer) + ! + !************************************************************************************************************************* + ! + subroutine get_rho_dry_1hd(tracer, temp, ptop, dp_dry, tracer_mass, rho_dry, rhoi_dry, & + active_species_idx_dycore) + use air_composition, only: get_R_dry + ! args + real(r8), intent(in) :: tracer(:,:,:) ! Tracer array + real(r8), intent(in) :: temp(:,:) ! Temperature + real(r8), intent(in) :: ptop + real(r8), intent(in) :: dp_dry(:,:) + logical, intent(in) :: tracer_mass + real(r8), optional,intent(out) :: rho_dry(:,:) + real(r8), optional,intent(out) :: rhoi_dry(:,:) + ! + ! array of indicies for index of thermodynamic active species in dycore tracer array + ! (if different from physics index) + ! + integer, optional, intent(in) :: active_species_idx_dycore(:) + + ! local vars + integer :: idx, kdx + real(r8), dimension(SIZE(tracer, 1), SIZE(tracer, 2)) :: pmid + real(r8), dimension(SIZE(tracer, 1), SIZE(tracer, 2) + 1) :: pint + real(r8), allocatable :: R_dry(:,:) + integer, dimension(thermodynamic_active_species_num) :: idx_local + integer :: ierr + character(len=*), parameter :: subname = "get_rho_dry_1hd" + character(len=*), parameter :: errstr = subname//": failed to allocate " + + if (present(active_species_idx_dycore)) then + idx_local = active_species_idx_dycore + else + idx_local = thermodynamic_active_species_idx + end if + ! + ! we assume that air is dry where molecular viscosity may be significant + ! + call get_pmid_from_dp(dp_dry, ptop, pmid, pint=pint) + if (present(rhoi_dry)) then + allocate(R_dry(SIZE(tracer, 1), SIZE(tracer, 2) + 1), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"R_dry") + end if + if (tracer_mass) then + call get_R_dry(tracer, idx_local, R_dry, fact=1.0_r8 / dp_dry) + else + call get_R_dry(tracer, idx_local, R_dry) + end if + do kdx = 2, SIZE(tracer, 2) + 1 + rhoi_dry(:, kdx) = 0.5_r8 * (temp(:, kdx) + temp(:, kdx - 1))!could be more accurate! + rhoi_dry(:, kdx) = pint(:,kdx) / (rhoi_dry(:, kdx) * R_dry(:, kdx)) !ideal gas law for dry air + end do + ! + ! extrapolate top level value + ! + kdx=1 + rhoi_dry(:, kdx) = 1.5_r8 * (temp(:, kdx) - 0.5_r8 * temp(:, kdx + 1)) + rhoi_dry(:, kdx) = pint(:, kdx) / (rhoi_dry(:, kdx) * R_dry(:, kdx)) !ideal gas law for dry air + deallocate(R_dry) + end if + if (present(rho_dry)) then + allocate(R_dry(SIZE(tracer, 1), size(rho_dry, 2)), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"R_dry") + end if + if (tracer_mass) then + call get_R_dry(tracer, idx_local, R_dry, fact=1.0_r8 / dp_dry) + else + call get_R_dry(tracer, idx_local, R_dry) + end if + do kdx = 1, SIZE(rho_dry, 2) + do idx = 1, SIZE(rho_dry, 1) + rho_dry(idx, kdx) = pmid(idx, kdx) / (temp(idx, kdx) * R_dry(idx, kdx)) !ideal gas law for dry air + end do + end do + deallocate(R_dry) + end if + end subroutine get_rho_dry_1hd + + subroutine get_rho_dry_2hd(tracer, temp, ptop, dp_dry, tracer_mass, rho_dry, rhoi_dry, & + active_species_idx_dycore) + ! Version of get_rho_dry for arrays that have a second horizontal index + real(r8), intent(in) :: tracer(:,:,:,:) ! Tracer array + real(r8), intent(in) :: temp(:,:,:) ! Temperature + real(r8), intent(in) :: ptop + real(r8), intent(in) :: dp_dry(:,:,:) + logical, intent(in) :: tracer_mass + real(r8), optional,intent(out) :: rho_dry(:,:,:) + real(r8), optional,intent(out) :: rhoi_dry(:,:,:) + ! + ! array of indicies for index of thermodynamic active species in dycore tracer array + ! (if different from physics index) + ! + integer, optional, intent(in) :: active_species_idx_dycore(:) + + integer :: jdx + + do jdx = 1, SIZE(tracer, 2) + if (present(rho_dry) .and. present(rhoi_dry)) then + call get_rho_dry(tracer(:, jdx, :, :), temp(:, jdx, :), ptop, dp_dry(:, jdx, :), & + tracer_mass, rho_dry=rho_dry(:, jdx, :), rhoi_dry=rhoi_dry(:, jdx, :), & + active_species_idx_dycore=active_species_idx_dycore) + else if (present(rho_dry)) then + call get_rho_dry(tracer(:, jdx, :, :), temp(:, jdx, :), ptop, dp_dry(:, jdx, :), & + tracer_mass, rho_dry=rho_dry(:, jdx, :), active_species_idx_dycore=active_species_idx_dycore) + else if (present(rhoi_dry)) then + call get_rho_dry(tracer(:, jdx, :, :), temp(:, jdx, :), ptop, dp_dry(:, jdx, :), & + tracer_mass, rhoi_dry=rhoi_dry(:, jdx, :), active_species_idx_dycore=active_species_idx_dycore) + else + call get_rho_dry(tracer(:, jdx, :, :), temp(:, jdx, :), ptop, dp_dry(:, jdx, :), tracer_mass, & + active_species_idx_dycore=active_species_idx_dycore) + end if + end do + + end subroutine get_rho_dry_2hd + !=========================================================================== + + !************************************************************************************************************************* + ! + ! compute 3D molecular diffusion and thermal conductivity + ! + !************************************************************************************************************************* + ! + subroutine get_molecular_diff_coef_1hd(temp, get_at_interfaces, sponge_factor, kmvis, kmcnd, & + tracer, fact, active_species_idx_dycore, mbarv_in) + use air_composition, only: dry_air_species_num, get_mbarv + use air_composition, only: kv1, kc1, kv2, kc2, kv_temp_exp, kc_temp_exp + + ! args + real(r8), intent(in) :: temp(:,:) ! temperature + logical, intent(in) :: get_at_interfaces ! true: compute kmvis and kmcnd at interfaces + ! false: compute kmvis and kmcnd at mid-levels + real(r8), intent(in) :: sponge_factor(:) ! multiply kmvis and kmcnd with sponge_factor + ! (for sponge layer) + real(r8), intent(out) :: kmvis(:,:) + real(r8), intent(out) :: kmcnd(:,:) + real(r8), intent(in) :: tracer(:,:,:) ! tracer array + integer, intent(in), optional :: active_species_idx_dycore(:) ! index of active species in tracer + real(r8), intent(in), optional :: fact(:,:) ! if tracer is in units of mass or moist + ! fact converts to dry mixing ratio: tracer/fact + real(r8), intent(in), optional :: mbarv_in(:,:) ! composition dependent atmosphere mean mass + ! + ! local vars + ! + integer :: idx, kdx, icnst, ispecies + real(r8):: mbarvi, mm, residual ! Mean mass at mid level + real(r8):: cnst_vis, cnst_cnd, temp_local + real(r8), dimension(SIZE(tracer,1), SIZE(sponge_factor, 1)) :: factor, mbarv + integer, dimension(thermodynamic_active_species_num) :: idx_local + character(len=*), parameter :: subname = 'get_molecular_diff_coef_1hd: ' + + !-------------------------------------------- + ! Set constants needed for updates + !-------------------------------------------- + + if (dry_air_species_num==0) then + + cnst_vis = (kv1 * mmro2 * o2_mwi + kv2 * mmrn2 * n2_mwi) * mbar + cnst_cnd = (kc1 * mmro2 * o2_mwi + kc2 * mmrn2 * n2_mwi) * mbar + if (get_at_interfaces) then + do kdx = 2, SIZE(sponge_factor, 1) + do idx = 1, SIZE(tracer, 1) + temp_local = 0.5_r8 * (temp(idx, kdx) + temp(idx, kdx - 1)) + kmvis(idx, kdx) = sponge_factor(kdx) * cnst_vis * temp_local ** kv_temp_exp + kmcnd(idx, kdx) = sponge_factor(kdx) * cnst_cnd * temp_local ** kc_temp_exp + end do + end do + ! + ! extrapolate top level value + ! + kmvis(1:SIZE(tracer, 1), 1) = 1.5_r8 * kmvis(1:SIZE(tracer, 1), 2) - 0.5_r8 * kmvis(1:SIZE(tracer, 1), 3) + kmcnd(1:SIZE(tracer, 1), 1) = 1.5_r8 * kmcnd(1:SIZE(tracer, 1), 2) - 0.5_r8 * kmcnd(1:SIZE(tracer, 1), 3) + else if (.not. get_at_interfaces) then + do kdx = 1, SIZE(sponge_factor, 1) + do idx = 1, SIZE(tracer, 1) + kmvis(idx, kdx) = sponge_factor(kdx) * cnst_vis * temp(idx, kdx) ** kv_temp_exp + kmcnd(idx, kdx) = sponge_factor(kdx) * cnst_cnd * temp(idx, kdx) ** kc_temp_exp + end do + end do + else + call endrun(subname//'get_at_interfaces must be .true. or .false.') + end if + else + if (present(active_species_idx_dycore)) then + idx_local = active_species_idx_dycore + else + idx_local = thermodynamic_active_species_idx + end if + if (present(fact)) then + factor = fact(:,:) + else + factor = 1.0_r8 + endif + if (present(mbarv_in)) then + mbarv = mbarv_in + else + call get_mbarv(tracer, idx_local, mbarv, fact=factor) + end if + ! + ! major species dependent code + ! + if (get_at_interfaces) then + do kdx = 2, SIZE(sponge_factor, 1) + do idx = 1, SIZE(tracer, 1) + kmvis(idx, kdx) = 0.0_r8 + kmcnd(idx, kdx) = 0.0_r8 + residual = 1.0_r8 + do icnst = 1, dry_air_species_num + ispecies = idx_local(icnst) + mm = 0.5_r8 * (tracer(idx, kdx, ispecies) * factor(idx, kdx) + & + tracer(idx, kdx - 1, ispecies) * factor(idx, kdx-1)) + kmvis(idx, kdx) = kmvis(idx, kdx) + thermodynamic_active_species_kv(icnst) * & + thermodynamic_active_species_mwi(icnst) * mm + kmcnd(idx, kdx) = kmcnd(idx, kdx) + thermodynamic_active_species_kc(icnst) * & + thermodynamic_active_species_mwi(icnst) * mm + residual = residual - mm + end do + icnst = 0 ! N2 + kmvis(idx, kdx) = kmvis(idx, kdx) + thermodynamic_active_species_kv(icnst) * & + thermodynamic_active_species_mwi(icnst) * residual + kmcnd(idx, kdx) = kmcnd(idx, kdx) + thermodynamic_active_species_kc(icnst) * & + thermodynamic_active_species_mwi(icnst) * residual + + temp_local = 0.5_r8 * (temp(idx, kdx - 1) + temp(idx, kdx)) + mbarvi = 0.5_r8 * (mbarv(idx, kdx - 1) + mbarv(idx, kdx)) + kmvis(idx, kdx) = kmvis(idx, kdx) * mbarvi * temp_local ** kv_temp_exp + kmcnd(idx, kdx) = kmcnd(idx, kdx) * mbarvi * temp_local ** kc_temp_exp + enddo + end do + do idx = 1, SIZE(tracer, 1) + kmvis(idx, 1) = 1.5_r8 * kmvis(idx, 2) - .5_r8 * kmvis(idx, 3) + kmcnd(idx, 1) = 1.5_r8 * kmcnd(idx, 2) - .5_r8 * kmcnd(idx, 3) + kmvis(idx, SIZE(sponge_factor, 1) + 1) = kmvis(idx, SIZE(sponge_factor, 1)) + kmcnd(idx, SIZE(sponge_factor, 1) + 1) = kmcnd(idx, SIZE(sponge_factor, 1)) + end do + else if (.not. get_at_interfaces) then + do kdx = 1, SIZE(sponge_factor, 1) + do idx = 1, SIZE(tracer, 1) + kmvis(idx, kdx) = 0.0_r8 + kmcnd(idx, kdx) = 0.0_r8 + residual = 1.0_r8 + do icnst = 1, dry_air_species_num - 1 + ispecies = idx_local(icnst) + mm = tracer(idx, kdx, ispecies) * factor(idx, kdx) + kmvis(idx, kdx) = kmvis(idx, kdx) + thermodynamic_active_species_kv(icnst) * & + thermodynamic_active_species_mwi(icnst) * mm + kmcnd(idx, kdx) = kmcnd(idx, kdx) + thermodynamic_active_species_kc(icnst) * & + thermodynamic_active_species_mwi(icnst) * mm + residual = residual - mm + end do + icnst = dry_air_species_num + kmvis(idx, kdx) = kmvis(idx, kdx) + thermodynamic_active_species_kv(icnst) * & + thermodynamic_active_species_mwi(icnst) * residual + kmcnd(idx, kdx) = kmcnd(idx, kdx) + thermodynamic_active_species_kc(icnst) * & + thermodynamic_active_species_mwi(icnst) * residual + + kmvis(idx, kdx) = kmvis(idx, kdx) * mbarv(idx, kdx) * temp(idx, kdx) ** kv_temp_exp + kmcnd(idx, kdx) = kmcnd(idx, kdx) * mbarv(idx, kdx) * temp(idx, kdx) ** kc_temp_exp + end do + end do + else + call endrun(subname//'get_at_interfaces must be .true. or .false.') + end if + end if + end subroutine get_molecular_diff_coef_1hd + + subroutine get_molecular_diff_coef_2hd(temp, get_at_interfaces, sponge_factor, kmvis, kmcnd, & + tracer, fact, active_species_idx_dycore, mbarv_in) + ! Version of get_molecular_diff_coef for arrays that have a second horizontal index + real(r8), intent(in) :: temp(:,:,:) ! temperature + logical, intent(in) :: get_at_interfaces ! true: compute kmvis and kmcnd at interfaces + ! false: compute kmvis and kmcnd at mid-levels + real(r8), intent(in) :: sponge_factor(:) ! multiply kmvis and kmcnd with sponge_factor + ! (for sponge layer) + real(r8), intent(out) :: kmvis(:,:,:) + real(r8), intent(out) :: kmcnd(:,:,:) + real(r8), intent(in) :: tracer(:,:,:,:) ! tracer array + integer, intent(in), optional :: active_species_idx_dycore(:) ! index of active species in tracer + real(r8), intent(in), optional :: fact(:,:,:) ! if tracer is in units of mass or moist + ! fact converts to dry mixing ratio: tracer/fact + real(r8), intent(in), optional :: mbarv_in(:,:,:) ! composition dependent atmosphere mean mass + integer :: jdx + + do jdx = 1, SIZE(tracer, 2) + if (present(fact) .and. present(mbarv_in)) then + call get_molecular_diff_coef(temp(:, jdx, :), get_at_interfaces, sponge_factor, & + kmvis(:, jdx, :), kmcnd(:, jdx, :), tracer(:, jdx, :, :), fact=fact(:, jdx, :), & + active_species_idx_dycore=active_species_idx_dycore, mbarv_in=mbarv_in(:, jdx, :)) + else if (present(fact)) then + call get_molecular_diff_coef(temp(:, jdx, :), get_at_interfaces, sponge_factor, & + kmvis(:, jdx, :), kmcnd(:, jdx, :), tracer(:, jdx, :, :), fact=fact(:, jdx, :), & + active_species_idx_dycore=active_species_idx_dycore) + else if (present(mbarv_in)) then + call get_molecular_diff_coef(temp(:, jdx, :), get_at_interfaces, sponge_factor, & + kmvis(:, jdx, :), kmcnd(:, jdx, :), tracer(:, jdx, :, :), & + active_species_idx_dycore=active_species_idx_dycore, mbarv_in=mbarv_in(:, jdx, :)) + else + call get_molecular_diff_coef(temp(:, jdx, :), get_at_interfaces, sponge_factor, & + kmvis(:, jdx, :), kmcnd(:, jdx, :), tracer(:, jdx, :, :), & + active_species_idx_dycore=active_species_idx_dycore) + end if + end do + + end subroutine get_molecular_diff_coef_2hd + !=========================================================================== + + !*************************************************************************** + ! + ! compute reference vertical profile of density, molecular diffusion and thermal conductivity + ! + !*************************************************************************** + ! + subroutine get_molecular_diff_coef_reference(tref,press,sponge_factor,kmvis_ref,kmcnd_ref,rho_ref) + use physconst, only: rair + use air_composition, only: kv1, kv2, kc1, kc2, kv_temp_exp, kc_temp_exp + ! args + real(r8), intent(in) :: tref !reference temperature + real(r8), intent(in) :: press(:) !pressure + real(r8), intent(in) :: sponge_factor(:) !multiply kmvis and kmcnd with sponge_factor (for sponge layer) + real(r8), intent(out) :: kmvis_ref(:) !reference molecular diffusion coefficient + real(r8), intent(out) :: kmcnd_ref(:) !reference thermal conductivity coefficient + real(r8), intent(out) :: rho_ref(:) !reference density + + ! local vars + integer :: kdx + + !-------------------------------------------- + ! Set constants needed for updates + !-------------------------------------------- + + do kdx = 1, SIZE(press, 1) + rho_ref(kdx) = press(kdx) / (tref * rair) !ideal gas law for dry air + kmvis_ref(kdx) = sponge_factor(kdx) * & + (kv1 * mmro2 * o2_mwi + & + kv2 * mmrn2 * n2_mwi) * mbar * & + tref ** kv_temp_exp + kmcnd_ref(kdx) = sponge_factor(kdx) * & + (kc1 * mmro2 * o2_mwi + & + kc2 * mmrn2 * n2_mwi) * mbar * & + tref ** kc_temp_exp + end do + end subroutine get_molecular_diff_coef_reference + + !========================================================================== + + ! + !*************************************************************************** + ! + ! cam_thermo_calc_kappav: update species dependent kappa for FV dycore + ! + !*************************************************************************** + ! + subroutine cam_thermo_calc_kappav_2hd(tracer, kappav, cpv) + use air_composition, only: get_R_dry, get_cp_dry + ! assumes moist MMRs + + ! Dummy arguments + real(r8), intent(in) :: tracer(:, :, :, :) + real(r8), intent(out) :: kappav(:, :, :) + real(r8), optional, intent(out) :: cpv(:, :, :) + + ! Local variables + real(r8) :: rgas_var(SIZE(tracer, 1), SIZE(tracer, 2), SIZE(tracer, 3)) + real(r8) :: cp_var(SIZE(tracer, 1), SIZE(tracer, 2), SIZE(tracer, 3)) + integer :: ind, jnd, knd + + !----------------------------------------------------------------------- + ! Calculate constituent dependent specific heat, gas constant and cappa + !----------------------------------------------------------------------- + call get_R_dry(tracer, thermodynamic_active_species_idx, rgas_var) + call get_cp_dry(tracer, thermodynamic_active_species_idx, cp_var) + !$omp parallel do private(ind,jnd,knd) + do knd = 1, SIZE(tracer, 3) + do jnd = 1, SIZE(tracer, 2) + do ind = 1, SIZE(tracer, 1) + kappav(ind,jnd,knd) = rgas_var(ind,jnd,knd) / cp_var(ind,jnd,knd) + end do + end do + end do + + if (present(cpv)) then + cpv(:,:,:) = cp_var(:,:,:) + end if + + end subroutine cam_thermo_calc_kappav_2hd + + !=========================================================================== + ! + !*************************************************************************** + ! + ! compute column integrated total energy consistent with vertical + ! coordinate as well as vertical integrals of water mass (H2O,wv,liq,ice) + ! + ! if subroutine is asked to compute "te" then the latent heat terms are + ! added to the kinetic (ke), internal + geopotential (se) energy terms + ! + ! subroutine assumes that enthalpy term (rho*cp*T) uses dry air heat capacity + ! + !*************************************************************************** + ! + subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & + cp_or_cv, U, V, T, vcoord, ptop, phis, z_mid, dycore_idx, qidx, & + te, se, po, ke, wv, H2O, liq, ice) + + use cam_logfile, only: iulog + use dyn_tests_utils, only: vc_height, vc_moist_pressure, vc_dry_pressure + use air_composition, only: wv_idx + use physconst, only: rga, latvap, latice + + ! Dummy arguments + ! tracer: tracer mixing ratio + ! + ! note - if pdeldry passed to subroutine then tracer mixing ratio must be dry + real(r8), intent(in) :: tracer(:,:,:) + logical, intent(in) :: moist_mixing_ratio + ! pdel: pressure level thickness + real(r8), intent(in) :: pdel_in(:,:) + ! cp_or_cv: dry air heat capacity under constant pressure or + ! constant volume (depends on vcoord) + real(r8), intent(in) :: cp_or_cv(:,:) + real(r8), intent(in) :: U(:,:) + real(r8), intent(in) :: V(:,:) + real(r8), intent(in) :: T(:,:) + integer, intent(in) :: vcoord ! vertical coordinate + real(r8), intent(in), optional :: ptop(:) + real(r8), intent(in), optional :: phis(:) + real(r8), intent(in), optional :: z_mid(:,:) + ! dycore_idx: use dycore index for thermodynamic active species + logical, intent(in), optional :: dycore_idx + ! qidx: Index of water vapor + integer, intent(in), optional :: qidx + ! H2O: vertically integrated total water + real(r8), intent(out), optional :: H2O(:) + ! TE: vertically integrated total energy + real(r8), intent(out), optional :: te (:) + ! KE: vertically integrated kinetic energy + real(r8), intent(out), optional :: ke (:) + ! SE: vertically integrated enthalpy (pressure coordinate) + ! or internal energy (z coordinate) + real(r8), intent(out), optional :: se (:) + ! PO: vertically integrated PHIS term (pressure coordinate) + ! or potential energy (z coordinate) + real(r8), intent(out), optional :: po (:) + ! WV: vertically integrated water vapor + real(r8), intent(out), optional :: wv (:) + ! liq: vertically integrated liquid + real(r8), intent(out), optional :: liq(:) + ! ice: vertically integrated ice + real(r8), intent(out), optional :: ice(:) + + ! Local variables + real(r8) :: ke_vint(SIZE(tracer, 1)) ! Vertical integral of KE + real(r8) :: se_vint(SIZE(tracer, 1)) ! Vertical integral of enthalpy or internal energy + real(r8) :: po_vint(SIZE(tracer, 1)) ! Vertical integral of PHIS or potential energy + real(r8) :: wv_vint(SIZE(tracer, 1)) ! Vertical integral of wv + real(r8) :: liq_vint(SIZE(tracer, 1)) ! Vertical integral of liq + real(r8) :: ice_vint(SIZE(tracer, 1)) ! Vertical integral of ice + real(r8) :: pdel(SIZE(tracer, 1),SIZE(tracer, 2)) !moist pressure level thickness + real(r8) :: latsub ! latent heat of sublimation + + integer :: ierr + integer :: kdx, idx ! coord indices + integer :: qdx ! tracer index + integer :: wvidx ! water vapor index + integer, allocatable :: species_idx(:) + integer, allocatable :: species_liq_idx(:) + integer, allocatable :: species_ice_idx(:) + character(len=*), parameter :: subname = 'get_hydrostatic_energy' + + allocate(species_idx(thermodynamic_active_species_num), stat=ierr) + if ( ierr /= 0 ) then + call endrun(subname//': allocation error for species_idx array') + end if + allocate(species_liq_idx(thermodynamic_active_species_liq_num), stat=ierr) + if ( ierr /= 0 ) then + call endrun(subname//': allocation error for species_liq_idx array') + end if + allocate(species_ice_idx(thermodynamic_active_species_ice_num), stat=ierr) + if ( ierr /= 0 ) then + call endrun(subname//': allocation error for species_ice_idx array') + end if + + if (present(dycore_idx))then + if (dycore_idx) then + species_idx(:) = thermodynamic_active_species_idx_dycore(:) + species_liq_idx(:) = thermodynamic_active_species_liq_idx_dycore(:) + species_ice_idx(:) = thermodynamic_active_species_ice_idx_dycore(:) + else + species_idx(:) = thermodynamic_active_species_idx(:) + species_liq_idx(:) = thermodynamic_active_species_liq_idx(:) + species_ice_idx(:) = thermodynamic_active_species_ice_idx(:) + end if + else + species_idx(:) = thermodynamic_active_species_idx(:) + species_liq_idx(:) = thermodynamic_active_species_liq_idx(:) + species_ice_idx(:) = thermodynamic_active_species_ice_idx(:) + end if + + if (present(qidx)) then + wvidx = qidx + else + wvidx = wv_idx + end if + + if (moist_mixing_ratio) then + pdel = pdel_in + else + pdel = pdel_in + do qdx = dry_air_species_num+1, thermodynamic_active_species_num + pdel(:,:) = pdel(:,:) + pdel_in(:, :)*tracer(:,:,species_idx(qdx)) + end do + end if + + ke_vint = 0._r8 + se_vint = 0._r8 + select case (vcoord) + case(vc_moist_pressure, vc_dry_pressure) + if (.not. present(ptop).or. (.not. present(phis))) then + write(iulog, *) subname, ' ptop and phis must be present for ', & + 'moist/dry pressure vertical coordinate' + call endrun(subname//': ptop and phis must be present for '// & + 'moist/dry pressure vertical coordinate') + end if + po_vint = ptop + do kdx = 1, SIZE(tracer, 2) + do idx = 1, SIZE(tracer, 1) + ke_vint(idx) = ke_vint(idx) + (pdel(idx, kdx) * & + 0.5_r8 * (U(idx, kdx)**2 + V(idx, kdx)**2)) * rga + se_vint(idx) = se_vint(idx) + (T(idx, kdx) * & + cp_or_cv(idx, kdx) * pdel(idx, kdx) * rga) + po_vint(idx) = po_vint(idx)+pdel(idx, kdx) + + end do + end do + do idx = 1, SIZE(tracer, 1) + po_vint(idx) = (phis(idx) * po_vint(idx) * rga) + end do + case(vc_height) + if (.not. present(phis)) then + write(iulog, *) subname, ' phis must be present for ', & + 'heigt-based vertical coordinate' + call endrun(subname//': phis must be present for '// & + 'height-based vertical coordinate') + end if + po_vint = 0._r8 + do kdx = 1, SIZE(tracer, 2) + do idx = 1, SIZE(tracer, 1) + ke_vint(idx) = ke_vint(idx) + (pdel(idx, kdx) * & + 0.5_r8 * (U(idx, kdx)**2 + V(idx, kdx)**2) * rga) + se_vint(idx) = se_vint(idx) + (T(idx, kdx) * & + cp_or_cv(idx, kdx) * pdel(idx, kdx) * rga) + ! z_mid is height above ground + po_vint(idx) = po_vint(idx) + (z_mid(idx, kdx) + & + phis(idx) * rga) * pdel(idx, kdx) + end do + end do + case default + write(iulog, *) subname, ' vertical coordinate not supported: ', vcoord + call endrun(subname//': vertical coordinate not supported') + end select + if (present(te)) then + te = se_vint + po_vint+ ke_vint + end if + if (present(se)) then + se = se_vint + end if + if (present(po)) then + po = po_vint + end if + if (present(ke)) then + ke = ke_vint + end if + ! + ! vertical integral of total liquid water + ! + if (.not.moist_mixing_ratio) then + pdel = pdel_in! set pseudo density to dry + end if + + wv_vint = 0._r8 + do kdx = 1, SIZE(tracer, 2) + do idx = 1, SIZE(tracer, 1) + wv_vint(idx) = wv_vint(idx) + (tracer(idx, kdx, wvidx) * & + pdel(idx, kdx) * rga) + end do + end do + if (present(wv)) wv = wv_vint + + liq_vint = 0._r8 + do qdx = 1, thermodynamic_active_species_liq_num + do kdx = 1, SIZE(tracer, 2) + do idx = 1, SIZE(tracer, 1) + liq_vint(idx) = liq_vint(idx) + (pdel(idx, kdx) * & + tracer(idx, kdx, species_liq_idx(qdx)) * rga) + end do + end do + end do + if (present(liq)) liq = liq_vint + + ! + ! vertical integral of total frozen (ice) water + ! + ice_vint = 0._r8 + do qdx = 1, thermodynamic_active_species_ice_num + do kdx = 1, SIZE(tracer, 2) + do idx = 1, SIZE(tracer, 1) + ice_vint(idx) = ice_vint(idx) + (pdel(idx, kdx) * & + tracer(idx, kdx, species_ice_idx(qdx)) * rga) + end do + end do + end do + if (present(ice)) ice = ice_vint + ! Compute vertical integrals of total water. + if (present(H2O)) then + H2O = wv_vint + liq_vint + ice_vint + end if + ! + ! latent heat terms depend on enthalpy reference state + ! + latsub = latvap + latice + if (present(te)) then + select case (TRIM(enthalpy_reference_state)) + case('ice') + te = te + (latsub * wv_vint) + (latice * liq_vint) + case('liq') + te = te + (latvap * wv_vint) - (latice * ice_vint) + case('wv') + te = te - (latvap * liq_vint) - (latsub * ice_vint) + case default + write(iulog, *) subname, ' enthalpy reference state not ', & + 'supported: ', TRIM(enthalpy_reference_state) + call endrun(subname//': enthalpy reference state not supported') + end select + end if + deallocate(species_idx, species_liq_idx, species_ice_idx) + end subroutine get_hydrostatic_energy_1hd + +end module cam_thermo diff --git a/src/utils/cam_thermo_formula.F90 b/src/utils/cam_thermo_formula.F90 new file mode 100644 index 0000000000..7781e9da9c --- /dev/null +++ b/src/utils/cam_thermo_formula.F90 @@ -0,0 +1,14 @@ +module cam_thermo_formula + + implicit none + private + save + + ! energy_formula options for use by CCPPized check_energy + integer, public, parameter :: ENERGY_FORMULA_DYCORE_FV = 0 ! vc_moist_pressure + integer, public, parameter :: ENERGY_FORMULA_DYCORE_SE = 1 ! vc_dry_pressure + integer, public, parameter :: ENERGY_FORMULA_DYCORE_MPAS = 2 ! vc_height + + !REMOVECAM: in CAM, energy_formula_physics and energy_formula_dycore still uses vc_physics + ! and vc_dycore in dyn_tests_utils. The values are the same. +end module cam_thermo_formula diff --git a/src/utils/ccpp_kinds.F90 b/src/utils/ccpp_kinds.F90 deleted file mode 100644 index 505001a625..0000000000 --- a/src/utils/ccpp_kinds.F90 +++ /dev/null @@ -1,12 +0,0 @@ -! This module is a placeholder for the CCPP generated module of the same name -module ccpp_kinds - - use shr_kind_mod, only: kind_phys => shr_kind_r8 - - - implicit none - private - - public kind_phys - -end module ccpp_kinds diff --git a/src/utils/coords_1d.F90 b/src/utils/coords_1d.F90 deleted file mode 100644 index c854cecabb..0000000000 --- a/src/utils/coords_1d.F90 +++ /dev/null @@ -1,151 +0,0 @@ -module coords_1d - -! This module defines the Coords1D type, which is intended to to cache -! commonly used information derived from a collection of sets of 1-D -! coordinates. - -use shr_kind_mod, only: r8 => shr_kind_r8 - -implicit none -private -save - -public :: Coords1D - -type :: Coords1D - ! Number of sets of coordinates in the object. - integer :: n = 0 - ! Number of coordinates in each set. - integer :: d = 0 - - ! All fields below will be allocated with first dimension "n". - ! The second dimension is d+1 for ifc, d for mid, del, and rdel, and - ! d-1 for dst and rdst. - - ! Cell interface coordinates. - real(r8), allocatable :: ifc(:,:) - ! Coordinates at cell mid-points. - real(r8), allocatable :: mid(:,:) - ! Width of cells. - real(r8), allocatable :: del(:,:) - ! Distance between cell midpoints. - real(r8), allocatable :: dst(:,:) - ! Reciprocals: 1/del and 1/dst. - real(r8), allocatable :: rdel(:,:) - real(r8), allocatable :: rdst(:,:) - contains - procedure :: section - procedure :: finalize -end type Coords1D - -interface Coords1D - module procedure new_Coords1D_from_fields - module procedure new_Coords1D_from_int -end interface - -contains - -! Constructor to create an object from existing data. -function new_Coords1D_from_fields(ifc, mid, del, dst, & - rdel, rdst) result(coords) - real(r8), USE_CONTIGUOUS intent(in) :: ifc(:,:) - real(r8), USE_CONTIGUOUS intent(in) :: mid(:,:) - real(r8), USE_CONTIGUOUS intent(in) :: del(:,:) - real(r8), USE_CONTIGUOUS intent(in) :: dst(:,:) - real(r8), USE_CONTIGUOUS intent(in) :: rdel(:,:) - real(r8), USE_CONTIGUOUS intent(in) :: rdst(:,:) - type(Coords1D) :: coords - - coords = allocate_coords(size(ifc, 1), size(ifc, 2) - 1) - - coords%ifc = ifc - coords%mid = mid - coords%del = del - coords%dst = dst - coords%rdel = rdel - coords%rdst = rdst - -end function new_Coords1D_from_fields - -! Constructor if you only have interface coordinates; derives all the other -! fields. -function new_Coords1D_from_int(ifc) result(coords) - real(r8), USE_CONTIGUOUS intent(in) :: ifc(:,:) - type(Coords1D) :: coords - - coords = allocate_coords(size(ifc, 1), size(ifc, 2) - 1) - - coords%ifc = ifc - coords%mid = 0.5_r8 * (ifc(:,:coords%d)+ifc(:,2:)) - coords%del = coords%ifc(:,2:) - coords%ifc(:,:coords%d) - coords%dst = coords%mid(:,2:) - coords%mid(:,:coords%d-1) - coords%rdel = 1._r8/coords%del - coords%rdst = 1._r8/coords%dst - -end function new_Coords1D_from_int - -! Create a new Coords1D object that is a subsection of some other object, -! e.g. if you want only the first m coordinates, use d_bnds=[1, m]. -! -! Originally this used pointers, but it was found to actually be cheaper -! in practice just to make a copy, especially since pointers can impede -! optimization. -function section(self, n_bnds, d_bnds) - class(Coords1D), intent(in) :: self - integer, intent(in) :: n_bnds(2), d_bnds(2) - type(Coords1D) :: section - - section = allocate_coords(n_bnds(2)-n_bnds(1)+1, d_bnds(2)-d_bnds(1)+1) - - section%ifc = self%ifc(n_bnds(1):n_bnds(2),d_bnds(1):d_bnds(2)+1) - section%mid = self%mid(n_bnds(1):n_bnds(2),d_bnds(1):d_bnds(2)) - section%del = self%del(n_bnds(1):n_bnds(2),d_bnds(1):d_bnds(2)) - section%dst = self%dst(n_bnds(1):n_bnds(2),d_bnds(1):d_bnds(2)-1) - section%rdel = self%rdel(n_bnds(1):n_bnds(2),d_bnds(1):d_bnds(2)) - section%rdst = self%rdst(n_bnds(1):n_bnds(2),d_bnds(1):d_bnds(2)-1) - -end function section - -! Quick utility to get allocate each array with the correct size. -function allocate_coords(n, d) result(coords) - integer, intent(in) :: n, d - type(Coords1D) :: coords - - coords%n = n - coords%d = d - - allocate(coords%ifc(coords%n,coords%d+1)) - allocate(coords%mid(coords%n,coords%d)) - allocate(coords%del(coords%n,coords%d)) - allocate(coords%dst(coords%n,coords%d-1)) - allocate(coords%rdel(coords%n,coords%d)) - allocate(coords%rdst(coords%n,coords%d-1)) - -end function allocate_coords - -! Deallocate and reset to initial state. -subroutine finalize(self) - class(Coords1D), intent(inout) :: self - - self%n = 0 - self%d = 0 - - call guarded_deallocate(self%ifc) - call guarded_deallocate(self%mid) - call guarded_deallocate(self%del) - call guarded_deallocate(self%dst) - call guarded_deallocate(self%rdel) - call guarded_deallocate(self%rdst) - -contains - - subroutine guarded_deallocate(array) - real(r8), allocatable :: array(:,:) - - if (allocated(array)) deallocate(array) - - end subroutine guarded_deallocate - -end subroutine finalize - -end module coords_1d diff --git a/src/utils/error_messages.F90 b/src/utils/error_messages.F90 deleted file mode 100644 index a2a64bca91..0000000000 --- a/src/utils/error_messages.F90 +++ /dev/null @@ -1,151 +0,0 @@ -module error_messages - - !----------------------------------------------------------------------- - ! - ! Purpose: - ! General purpose routines for issuing error messages. - ! - ! Author: B. Eaton - ! - !----------------------------------------------------------------------- - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - - implicit none - save - private - public :: & - alloc_err, &! Issue error message after non-zero return from an allocate statement. - handle_err, &! Issue error message after non-zero return from anything - handle_ncerr ! Handle error returns from netCDF library procedures. - - ! If an error message string is not empty, abort with that string as the - ! error message. - public :: handle_errmsg - -!############################################################################## -contains -!############################################################################## - - subroutine alloc_err( istat, routine, name, nelem ) - - !----------------------------------------------------------------------- - ! Purpose: - ! Issue error message after non-zero return from an allocate statement. - ! - ! Author: B. Eaton - !----------------------------------------------------------------------- - - integer, intent(in) ::& - istat ! status from allocate statement - character(len=*), intent(in) ::& - routine, &! routine that called allocate - name ! name of array - integer, intent(in) ::& - nelem ! number of elements attempted to allocate - !----------------------------------------------------------------------- - - if ( istat .ne. 0 ) then - write(iulog,*)'ERROR trying to allocate memory in routine: ' & - //trim(routine) - write(iulog,*)' Variable name: '//trim(name) - write(iulog,*)' Number of elements: ',nelem - call endrun ('ALLOC_ERR') - end if - - return - - end subroutine alloc_err - -!############################################################################## - - subroutine handle_err( istat, msg ) - - !----------------------------------------------------------------------- - ! Purpose: - ! Issue error message after non-zero return from anything. - ! - ! Author: T. Henderson - !----------------------------------------------------------------------- - - integer, intent(in) :: istat ! status, zero = "no error" - character(len=*), intent(in) :: msg ! error message to print - !----------------------------------------------------------------------- - - if ( istat .ne. 0 ) then - call endrun (trim(msg)) - end if - - return - - end subroutine handle_err - -!############################################################################## - - subroutine handle_ncerr( ret, mes, line ) - - !----------------------------------------------------------------------- - ! Purpose: - ! Check netCDF library function return code. If error detected - ! issue error message then abort. - ! - ! Author: B. Eaton - !----------------------------------------------------------------------- - -!----------------------------------------------------------------------- - use netcdf -!----------------------------------------------------------------------- - - integer, intent(in) ::& - ret ! return code from netCDF library routine - character(len=*), intent(in) ::& - mes ! message to be printed if error detected - integer, intent(in), optional :: line - !----------------------------------------------------------------------- - - if ( ret .ne. NF90_NOERR ) then - if(present(line)) then - write(iulog,*) mes, line - else - write(iulog,*) mes - end if - write(iulog,*) nf90_strerror( ret ) - call endrun ('HANDLE_NCERR') - endif - - return - - end subroutine handle_ncerr - -!############################################################################## - - subroutine handle_errmsg(errmsg, subname, extra_msg) - - ! String that is asserted to be null. - character(len=*), intent(in) :: errmsg - ! Name of procedure generating the message. - character(len=*), intent(in), optional :: subname - ! Additional message from the procedure calling this one. - character(len=*), intent(in), optional :: extra_msg - - if (trim(errmsg) /= "") then - - if (present(extra_msg)) & - write(iulog,*) "handle_errmsg: & - &Message from caller: ",trim(extra_msg) - - if (present(subname)) then - call endrun("ERROR: handle_errmsg: "// & - trim(subname)//": "//trim(errmsg)) - else - call endrun("ERROR: handle_errmsg: "// & - "Error message received from routine: "//trim(errmsg)) - end if - - end if - - end subroutine handle_errmsg - -!############################################################################## - -end module error_messages diff --git a/src/utils/gmean_mod.F90 b/src/utils/gmean_mod.F90 index 79ab89ec48..2abbe369ed 100644 --- a/src/utils/gmean_mod.F90 +++ b/src/utils/gmean_mod.F90 @@ -1,48 +1,45 @@ module gmean_mod - !----------------------------------------------------------------------- - ! - ! Purpose: - ! Perform mixed layer global calculations for energy conservation checks. - ! - ! Methods: - ! Reproducible (nonscalable): - ! Gather to a master processor who does all the work. - ! Reproducible (scalable): - ! Convert to fixed point (integer representation) to enable - ! reproducibility when using MPI collectives. Results compared with - ! a nonreproducible (but scalable) algorithm using floating point - ! and MPI_Allreduce to verify the results are good enough. - ! - ! Author: Byron Boville from SOM code by Jim Rosinski/Bruce Briegleb - ! Modified: P. Worley to aggregate calculations (4/04) - ! Modified: J. White/P. Worley to introduce scalable algorithms; - ! B. Eaton to remove dycore-specific dependencies and to - ! introduce gmean_mass (10/07) - ! Modified: P. Worley to replace in-place implementation with call - ! to repro_sum. - ! - !----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: masterproc, mpicom, MPI_REAL8 - use ppgrid, only: pcols, begchunk, endchunk - use shr_reprosum_mod, only: shr_reprosum_calc, shr_reprosum_tolExceeded, & - shr_reprosum_reldiffmax, shr_reprosum_recompute - use perf_mod - use cam_logfile, only: iulog - - implicit none - private - save - - public :: gmean ! compute global mean of 2D fields on physics decomposition - - interface gmean - module procedure gmean_arr - module procedure gmean_scl - end interface gmean - - private :: gmean_float_repro - private :: gmean_fixed_repro + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Perform global mean calculations for energy conservation and other checks. + ! + ! Method: + ! Reproducible (scalable): + ! Convert to fixed point (integer representation) to enable + ! reproducibility when using MPI collectives. + ! If error checking is on (via setting reprosum_diffmax > 0 and + ! reprosum_recompute = .true. in user_nl_cpl), shr_reprosum_calc will + ! check the accuracy of its computation with a fast but + ! non-reproducible algorithm. If any error is reported, report + ! the difference and the expected sum and abort run (call endrun) + ! + ! + !----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use ppgrid, only: pcols, begchunk, endchunk + use shr_reprosum_mod, only: shr_reprosum_calc, shr_reprosum_tolExceeded + use shr_reprosum_mod, only: shr_reprosum_reldiffmax, shr_reprosum_recompute + use perf_mod, only: t_startf, t_stopf + use cam_logfile, only: iulog + + implicit none + private + + public :: gmean ! compute global mean of 2D fields on physics decomposition + public :: gmean_init ! Initialize gmean (maybe run tests) + public :: test_gmean ! test accuracy of gmean + + interface gmean + module procedure gmean_arr + module procedure gmean_scl + end interface gmean + + private :: gmean_fixed_repro + private :: gmean_float_norepro + + ! Set do_gmean_tests to .true. to run a gmean challenge test + logical, private :: do_gmean_tests = .false. CONTAINS @@ -50,261 +47,342 @@ module gmean_mod !======================================================================== ! - subroutine gmean_arr (arr, arr_gmean, nflds) - !----------------------------------------------------------------------- - ! - ! Purpose: - ! Compute the global mean of each field in "arr" in the physics - ! chunked decomposition - ! - !----------------------------------------------------------------------- - ! - ! Arguments - ! - integer, intent(in) :: nflds ! number of fields - real(r8), intent(in) :: arr(pcols,begchunk:endchunk,nflds) - ! Input array, chunked - real(r8), intent(out):: arr_gmean(nflds) ! global means - ! - ! Local workspace - ! - real(r8) :: rel_diff(2,nflds) ! relative differences between - ! 'fast' reproducible and - ! nonreproducible means - integer :: ifld ! field index - logical :: write_warning - ! - !----------------------------------------------------------------------- - ! - call t_startf ('gmean_fixed_repro') - call gmean_fixed_repro(arr, arr_gmean, rel_diff, nflds) - call t_stopf ('gmean_fixed_repro') - - ! check that "fast" reproducible sum is accurate enough. If not, calculate - ! using old method - write_warning = masterproc - if ( shr_reprosum_tolExceeded('gmean', nflds, write_warning, & - iulog, rel_diff) ) then - if ( shr_reprosum_recompute ) then - do ifld=1,nflds - if ( rel_diff(1,ifld) > shr_reprosum_reldiffmax ) then - call t_startf ('gmean_float_repro') - call gmean_float_repro(arr(:,:,ifld), arr_gmean(ifld), 1) - call t_stopf ('gmean_float_repro') - endif - enddo - endif - endif - - return - end subroutine gmean_arr - - ! - !======================================================================== - ! - - subroutine gmean_scl (arr, gmean) - use phys_grid, only : get_ncols_p - - !----------------------------------------------------------------------- - ! - ! Purpose: - ! Compute the global mean of each field in "arr" in the physics - ! chunked decomposition - ! - !----------------------------------------------------------------------- - ! - ! Arguments - ! - real(r8), intent(in) :: arr(pcols,begchunk:endchunk) - ! Input array, chunked - real(r8), intent(out):: gmean ! global means - ! - ! Local workspace - ! - integer, parameter :: nflds = 1 - real(r8) :: gmean_array(nflds) - real(r8) :: array(pcols,begchunk:endchunk,nflds) - integer :: ncols, lchnk - - do lchnk=begchunk,endchunk - ncols = get_ncols_p(lchnk) - array(:ncols,lchnk,1) = arr(:ncols,lchnk) - enddo - call gmean_arr(array,gmean_array,nflds) - gmean = gmean_array(1) - - end subroutine gmean_scl - -! -!======================================================================== -! - - subroutine gmean_float_repro (arr, arr_gmean, nflds) -!----------------------------------------------------------------------- -! -! Purpose: -! Compute the global mean of each field in "arr" in the physics -! chunked decomposition - all work is done on the masterproc to avoid -! order of operations differences and assure bfb reproducibility. -! -!----------------------------------------------------------------------- - - use dycore, only: dycore_is - use phys_grid, only: gather_chunk_to_field - use dyn_grid, only: get_horiz_grid_dim_d, get_horiz_grid_d, get_dyn_grid_parm_real1d - use physconst, only: pi -! -! Arguments -! - integer, intent(in) :: nflds ! number of fields - real(r8), intent(in) :: & - arr(pcols,begchunk:endchunk,nflds) ! Input array, chunked - real(r8), intent(out):: arr_gmean(nflds) ! global means -! -! Local workspace -! - real(r8), pointer :: w(:) - real(r8) :: zmean ! zonal mean value - real(r8) :: tmean ! temp global mean value - integer :: i, j, ifld, n ! longitude, latitude, field, - ! and global column indices - integer :: hdim1, hdim2 ! dimensions of rectangular horizontal - ! grid data structure, If 1D data - ! structure, then hdim2_d == 1. - integer :: ngcols ! global column count (all) - - integer :: ierr ! MPI error return - ! rectangular version of arr - real(r8), allocatable :: arr_field(:,:,:) - - ! column integration weight (from dynamics) - real(r8), dimension(:), allocatable :: wght_d - -! -!----------------------------------------------------------------------- -! - call get_horiz_grid_dim_d(hdim1, hdim2) - allocate(arr_field(hdim1,hdim2,nflds)) - - arr_field(:,:,:) = 0.0_r8 - call gather_chunk_to_field (1, 1, nflds, hdim1, arr, arr_field) - - if (masterproc) then - - if (dycore_is('UNSTRUCTURED')) then - - ngcols = hdim1*hdim2 - allocate ( wght_d(1:ngcols) ) - - wght_d = 0.0_r8 - call get_horiz_grid_d(ngcols, wght_d_out=wght_d) + subroutine gmean_init(do_test) + !----------------------------------------------------------------------- + ! + ! Purpose: Possibly run a test + ! + !----------------------------------------------------------------------- + ! + logical, optional, intent(in) :: do_test + + logical :: do_test_use + + if (present(do_test)) then + do_test_use = do_test + else + do_test_use = do_gmean_tests + end if - do ifld=1,nflds - arr_gmean(ifld) = 0._r8 - do j=1,hdim2 - do i=1,hdim1 - n = (j-1)*hdim1 + i - arr_gmean(ifld) = arr_gmean(ifld) + & - arr_field(i,j,ifld)*wght_d(n) - end do - end do - arr_gmean(ifld) = arr_gmean(ifld) / (4.0_r8 * pi) - end do + if (do_test_use) then + call test_gmean() + end if - deallocate ( wght_d ) - - else - w => get_dyn_grid_parm_real1d('w') - do ifld=1,nflds - tmean = 0._r8 - do j=1,hdim2 - zmean = 0._r8 - do i=1,hdim1 - zmean = zmean + arr_field(i,j,ifld) - end do - tmean = tmean + zmean * 0.5_r8*w(j)/hdim1 - end do - arr_gmean(ifld) = tmean + end subroutine gmean_init + + ! + !======================================================================== + ! + + subroutine gmean_arr (arr, arr_gmean, nflds) + use shr_strconvert_mod, only: toString + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Compute the global mean of each field in "arr" in the physics + ! chunked decomposition + ! + ! Method is to call shr_reprosum_calc (called from gmean_fixed_repro) + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: nflds ! number of fields + real(r8), intent(in) :: arr(pcols, begchunk:endchunk, nflds) + real(r8), intent(out) :: arr_gmean(nflds) ! global means + ! + ! Local workspace + ! + real(r8) :: rel_diff(2, nflds) + integer :: ifld ! field index + integer :: num_err + logical :: write_warning + ! + !----------------------------------------------------------------------- + ! + call t_startf('gmean_arr') + call t_startf ('gmean_fixed_repro') + call gmean_fixed_repro(arr, arr_gmean, rel_diff, nflds) + call t_stopf ('gmean_fixed_repro') + + ! check that "fast" reproducible sum is accurate enough. If not, calculate + ! using old method + write_warning = masterproc + num_err = 0 + if (shr_reprosum_tolExceeded('gmean', nflds, write_warning, & + iulog, rel_diff)) then + if (shr_reprosum_recompute) then + do ifld = 1, nflds + if (rel_diff(1, ifld) > shr_reprosum_reldiffmax) then + call gmean_float_norepro(arr(:,:,ifld), arr_gmean(ifld), ifld) + num_err = num_err + 1 + end if end do - end if - + end if + call t_stopf('gmean_arr') + if (num_err > 0) then + call endrun('gmean: '//toString(num_err)//' reprosum errors found') end if - call mpi_bcast (arr_gmean, nflds, MPI_REAL8, 0, mpicom, ierr) - deallocate(arr_field) - - return + end subroutine gmean_arr + + ! + !======================================================================== + ! + + subroutine gmean_scl (arr, gmean) + use phys_grid, only: get_ncols_p + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Compute the global mean of each field in "arr" in the physics + ! chunked decomposition + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + real(r8), intent(in) :: arr(pcols, begchunk:endchunk) + ! Input array, chunked + real(r8), intent(out):: gmean ! global means + ! + ! Local workspace + ! + integer, parameter :: nflds = 1 + real(r8) :: gmean_array(nflds) + real(r8) :: array(pcols, begchunk:endchunk, nflds) + integer :: ncols, lchnk + + do lchnk = begchunk, endchunk + ncols = get_ncols_p(lchnk) + array(:ncols, lchnk, 1) = arr(:ncols, lchnk) + end do + call gmean_arr(array, gmean_array, nflds) + gmean = gmean_array(1) + + end subroutine gmean_scl + + ! + !======================================================================== + ! + + subroutine gmean_float_norepro(arr, repro_sum, index) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Compute the global mean of in the physics chunked + ! decomposition using a fast but non-reproducible algorithm. + ! Log that value along with the value computed by + ! shr_reprosum_calc () + ! + !----------------------------------------------------------------------- + + use physconst, only: pi + use spmd_utils, only: masterproc, masterprocid, MPI_REAL8, MPI_SUM, mpicom + use phys_grid, only: get_ncols_p, get_wght_p + ! + ! Arguments + ! + real(r8), intent(in) :: arr(pcols, begchunk:endchunk) + real(r8), intent(in) :: repro_sum ! Value computed by reprosum + integer, intent(in) :: index ! Index of field in original call + ! + ! Local workspace + ! + integer :: lchnk, ncols, icol + integer :: ierr + real(r8) :: wght + real(r8) :: check + real(r8) :: check_sum + real(r8), parameter :: pi4 = 4.0_r8 * pi + + ! + !----------------------------------------------------------------------- + ! + ! Calculate and print out non-reproducible value + check = 0.0_r8 + do lchnk = begchunk, endchunk + ncols = get_ncols_p(lchnk) + do icol = 1, ncols + wght = get_wght_p(lchnk, icol) + check = check + arr(icol, lchnk) * wght + end do + end do + call MPI_reduce(check, check_sum, 1, MPI_REAL8, check_sum, MPI_SUM, & + masterprocid, mpicom, ierr) + if (masterproc) then + write(iulog, '(a,i0,2(a,e20.13e2))') 'gmean(', index, ') = ', & + check_sum / pi4, ', reprosum reported ', repro_sum + end if - end subroutine gmean_float_repro + end subroutine gmean_float_norepro -! -!======================================================================== -! + ! + !======================================================================== + ! subroutine gmean_fixed_repro (arr, arr_gmean, rel_diff, nflds) -!----------------------------------------------------------------------- -! -! Purpose: -! Compute the global mean of each field in "arr" in the physics -! chunked decomposition with a reproducible yet scalable implementation -! based on a fixed-point algorithm. -! -!----------------------------------------------------------------------- - use phys_grid, only : get_ncols_p, get_wght_all_p, ngcols_p, & - get_nlcols_p - use physconst, only: pi -! -! Arguments -! - integer, intent(in) :: nflds ! number of fields - real(r8), intent(in) :: & - arr(pcols,begchunk:endchunk,nflds) ! Input array, chunked - real(r8), intent(out):: arr_gmean(nflds) ! global means - real(r8), intent(out):: rel_diff(2,nflds) ! relative and absolute - ! differences between - ! reproducible and nonreproducible - ! means -! -! Local workspace -! - integer :: lchnk, i, ifld ! chunk, column, field indices - integer :: ncols ! number of columns in current chunk - integer :: count ! summand count - integer :: ierr ! MPI error return - - real(r8) :: wght(pcols) ! column for integration weights - real(r8), allocatable :: xfld(:,:) ! weighted summands - integer :: nlcols -! -!----------------------------------------------------------------------- -! + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Compute the global mean of each field in "arr" in the physics + ! chunked decomposition with a reproducible yet scalable implementation + ! based on a fixed-point algorithm. + ! + !----------------------------------------------------------------------- + use spmd_utils, only: mpicom + use phys_grid, only: get_ncols_p, get_wght_all_p, get_nlcols_p + use phys_grid, only: ngcols_p => num_global_phys_cols + use physconst, only: pi + ! + ! Arguments + ! + integer, intent(in) :: nflds ! number of fields + real(r8), intent(in) :: arr(pcols,begchunk:endchunk,nflds) + ! arr_gmean: output global sums + real(r8), intent(out) :: arr_gmean(nflds) + ! rel_diff: relative and absolute differences from shr_reprosum_calc + real(r8), intent(out) :: rel_diff(2, nflds) + ! + ! Local workspace + ! + integer :: lchnk, icol, ifld ! chunk, column, field indices + integer :: ncols ! # columns in current chunk + integer :: count ! summand count + + real(r8) :: wght(pcols) ! integration weights + real(r8), allocatable :: xfld(:,:) ! weighted summands + integer :: nlcols + ! + !----------------------------------------------------------------------- + ! nlcols = get_nlcols_p() allocate(xfld(nlcols, nflds)) -! pre-weight summands - do ifld=1,nflds + ! pre-weight summands + do ifld = 1, nflds count = 0 - do lchnk=begchunk,endchunk + do lchnk = begchunk, endchunk ncols = get_ncols_p(lchnk) call get_wght_all_p(lchnk, ncols, wght) - do i=1,ncols + do icol = 1, ncols count = count + 1 - xfld(count,ifld) = arr(i,lchnk,ifld)*wght(i) + xfld(count, ifld) = arr(icol, lchnk, ifld) * wght(icol) end do end do end do -! call fixed-point algorithm - call shr_reprosum_calc (xfld, arr_gmean, count, nlcols, nflds, & - gbl_count=ngcols_p, commid=mpicom, rel_diff=rel_diff) + ! call fixed-point algorithm + call shr_reprosum_calc (xfld, arr_gmean, count, nlcols, nflds, & + gbl_count=ngcols_p, commid=mpicom, rel_diff=rel_diff) deallocate(xfld) -! final normalization + ! final normalization arr_gmean(:) = arr_gmean(:) / (4.0_r8 * pi) - return - end subroutine gmean_fixed_repro + subroutine test_gmean(max_diff) + ! Test gmean on some different field patterns + ! Test 1: Just 1, easy peasy + ! Test 2: Positive definite, moderate dynamic range + ! Test 3: Positive definite, large dynamic range (pattern 1) + ! Test 4: Positive definite, large dynamic range (pattern 2) + ! Test 5: Large dynamic range (pattern 1) + ! Test 6: Large dynamic range (pattern 2) + use shr_kind_mod, only: SHR_KIND_CL, INT64 => SHR_KIND_I8 + use physconst, only: pi + use spmd_utils, only: iam, masterproc + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use phys_grid, only: get_ncols_p, get_gcol_p, get_wght_p + use phys_grid, only: ngcols_p => num_global_phys_cols + + ! Dummy argument + real(r8), optional, intent(in) :: max_diff + ! Local variables + integer, parameter :: num_tests = 6 + integer :: lchnk, ncols, icol, gcol, findex + integer(INT64) :: test_val + real(r8) :: test_arr(pcols,begchunk:endchunk,num_tests) + real(r8) :: test_mean(num_tests) + real(r8) :: expect(num_tests) + real(r8) :: diff, wght + real(r8) :: max_diff_use + real(r8), parameter :: fact2 = 1.0e-8_r8 + real(r8), parameter :: ifact = 1.0e6_r8 + real(r8), parameter :: pi4 = 4.0_r8 * pi + real(r8), parameter :: max_diff_def = 1.0e-14_r8 + character(len=SHR_KIND_CL) :: errmsg(num_tests) + character(len=*), parameter :: subname = 'test_gmean: ' + + if (present(max_diff)) then + max_diff_use = max_diff + else + max_diff_use = max_diff_def + end if + test_arr = 0.0_r8 + do lchnk = begchunk, endchunk + ncols = get_ncols_p(lchnk) + do icol = 1, ncols + gcol = get_gcol_p(lchnk, icol) + test_arr(icol, lchnk, 1) = 1.0_r8 + wght = get_wght_p(lchnk, icol) + test_arr(icol, lchnk, 2) = real(gcol, r8) * pi4 / wght + test_arr(icol, lchnk, 3) = test_arr(icol, lchnk, 2) * fact2 + if (mod(gcol, 2) == 1) then + test_arr(icol, lchnk, 4) = test_arr(icol, lchnk, 3) + ifact + test_arr(icol, lchnk, 6) = test_arr(icol, lchnk, 3) + ifact + else + test_arr(icol, lchnk, 4) = test_arr(icol, lchnk, 3) + test_arr(icol, lchnk, 6) = test_arr(icol, lchnk, 3) - ifact + end if + if (gcol > (ngcols_p / 2)) then + test_arr(icol, lchnk, 5) = test_arr(icol, lchnk, 3) + ifact + test_arr(icol, lchnk, 3) = test_arr(icol, lchnk, 3) + ifact + else + ! test_arr 3 already has correct value + test_arr(icol, lchnk, 5) = test_arr(icol, lchnk, 3) - ifact + end if + end do + end do + test_mean(:) = -2.71828_r8 * pi + expect(1) = 1.0_r8 + test_val = int(ngcols_p, INT64) + test_val = (test_val + 1) * test_val / 2_INT64 + expect(2) = real(test_val, r8) + expect(3) = (expect(2) * fact2) + (ifact / 2.0_r8) + expect(4) = expect(3) + expect(5) = expect(2) * fact2 + expect(6) = expect(5) + call gmean(test_arr, test_mean, num_tests) + errmsg = '' + do findex = 1, num_tests + diff = abs(test_mean(findex) - expect(findex)) / expect(findex) + if (diff > max_diff_use) then + write(errmsg(findex), '(i0,a,i0,3(a,e20.13e2))') iam, & + ': test_mean(', findex, ') FAIL: ', test_mean(findex), & + ' /= ', expect(findex), ', diff = ', diff + end if + end do + if (ANY(len_trim(errmsg) > 0)) then + call endrun(subname//trim(errmsg(1))//'\n'//trim(errmsg(2))//'\n'// & + trim(errmsg(3))//'\n'//trim(errmsg(4))//'\n'// & + trim(errmsg(5))//'\n'//trim(errmsg(6))) + end if + if (masterproc) then + do findex = 1, num_tests + write(iulog, '(2a,i0,a,e20.13e2)') subname, 'test_mean(', findex, & + ') = ', test_mean(findex) + end do + end if + end subroutine test_gmean + + ! + !======================================================================== + ! + end module gmean_mod diff --git a/src/utils/hycoef.F90 b/src/utils/hycoef.F90 index 2abfbb2ec7..241abf5c7e 100644 --- a/src/utils/hycoef.F90 +++ b/src/utils/hycoef.F90 @@ -21,6 +21,10 @@ module hycoef ! interfaces p(k) = hyai(k)*ps0 + hybi(k)*ps ! midpoints p(k) = hyam(k)*ps0 + hybm(k)*ps ! +! Note: Module data with a target attribute are targets of pointers in hist_coord_t +! objects in the cam_history_support module. They are associated by the calls +! to add_hist_coord and add_vert_coord +! !----------------------------------------------------------------------- real(r8), public, target :: hyai(plevp) ! ps0 component of hybrid coordinate - interfaces @@ -41,7 +45,7 @@ module hycoef real(r8), public, protected :: ps0 = 1.0e5_r8 ! Base state surface pressure (pascals) real(r8), public, protected :: psr = 1.0e5_r8 ! Reference surface pressure (pascals) #endif -real(r8), target :: alev(plev) ! level values (pascals) for 'lev' coord +real(r8), target :: alev(plev) ! level values (hPa) for 'lev' coord real(r8), target :: ailev(plevp) ! interface level values for 'ilev' coord integer, public :: nprlev ! number of pure pressure levels at top diff --git a/src/utils/linear_1d_operators.F90 b/src/utils/linear_1d_operators.F90 deleted file mode 100644 index f0b6211d49..0000000000 --- a/src/utils/linear_1d_operators.F90 +++ /dev/null @@ -1,1180 +0,0 @@ -module linear_1d_operators - -! This module provides the type "TriDiagOp" to represent operators on a 1D -! grid as tridiagonal matrices, and related types to represent boundary -! conditions. -! -! The focus is on solving diffusion equations with a finite volume method -! in one dimension, but other utility operators are provided, e.g. a second -! order approximation to the first derivative. -! -! In order to allow vectorization to occur, as well as to avoid unnecessary -! copying/reshaping of data in CAM, TriDiagOp actually represents a -! collection of independent operators that can be applied to collections of -! independent data; the innermost index is over independent systems (e.g. -! CAM columns). -! -! A simple example: -! ! First derivative operator -! op = first_derivative(coords) -! ! Convert data to its derivative (extrapolate at boundaries). -! call op%apply(data) -! -! With explicit boundary conditions: -! op = first_derivative(coords, & -! l_bndry=BoundaryFixedFlux(), & -! r_bndry=BoundaryFixedLayer(layer_distance)) -! call op%apply(data, & -! l_cond=BoundaryFlux(flux, dt, thickness), & -! r_cond=BoundaryData(boundary)) -! -! Implicit solution example: -! ! Construct diffusion matrix. -! op = diffusion_operator(coords, d) -! call op%lmult_as_diag(-dt) -! call op%add_to_diag(1._r8) -! ! Decompose in order to invert the operation. -! decomp = TriDiagDecomp(op) -! ! Diffuse data for one time step (fixed flux boundaries). -! call decomp%left_div(data) - -use shr_kind_mod, only: r8 => shr_kind_r8 -use shr_log_mod, only: errMsg => shr_log_errMsg -use shr_sys_mod, only: shr_sys_abort -use coords_1d, only: Coords1D - -implicit none -private -save - -! Main type. -public :: TriDiagOp -public :: operator(+) -public :: operator(-) - -! Decomposition used for inversion (left division). -public :: TriDiagDecomp - -! Multiplies by 0. -public :: zero_operator - -! Construct identity. -public :: identity_operator - -! Produce a TriDiagOp that is simply a diagonal matrix. -public :: diagonal_operator - -! For solving the diffusion-advection equation with implicit Euler. -public :: diffusion_operator -public :: advection_operator - -! Derivatives accurate to second order on a non-uniform grid. -public :: first_derivative -public :: second_derivative - -! Boundary condition types. -public :: BoundaryType -public :: BoundaryZero -public :: BoundaryFirstOrder -public :: BoundaryExtrapolate -public :: BoundaryFixedLayer -public :: BoundaryFixedFlux - -! Boundary data types. -public :: BoundaryCond -public :: BoundaryNoData -public :: BoundaryData -public :: BoundaryFlux - -! TriDiagOp represents operators that can work between nearest neighbors, -! with some extra logic at the boundaries. The implementation is a -! tridiagonal matrix plus boundary info. -type :: TriDiagOp - private - ! The number of independent systems. - integer, public :: nsys - ! The size of the matrix (number of grid cells). - integer, public :: ncel - ! Super-, sub-, and regular diagonals. - real(r8), allocatable :: spr(:,:) - real(r8), allocatable :: sub(:,:) - real(r8), allocatable :: diag(:,:) - ! Buffers to hold boundary data; Details depend on the type of boundary - ! being used. - real(r8), allocatable :: left_bound(:) - real(r8), allocatable :: right_bound(:) - contains - ! Applies the operator to a set of data. - procedure :: apply => apply_tridiag - ! Given the off-diagonal elements, fills in the diagonal so that the - ! operator will have the constant function as an eigenvector with - ! eigenvalue 0. This is used internally as a utility for construction of - ! derivative operators. - procedure :: deriv_diag => make_tridiag_deriv_diag - ! Add/substract another tridiagonal from this one in-place (without - ! creating a temporary object). - procedure :: add => add_in_place_tridiag_ops - procedure :: subtract => subtract_in_place_tridiag_ops - ! Add input vector or scalar to the diagonal. - procedure :: scalar_add_tridiag - procedure :: diagonal_add_tridiag - generic :: add_to_diag => scalar_add_tridiag, diagonal_add_tridiag - ! Treat input vector (or scalar) as if it was the diagonal of an - ! operator, and multiply this operator on the left by that value. - procedure :: scalar_lmult_tridiag - procedure :: diagonal_lmult_tridiag - generic :: lmult_as_diag => & - scalar_lmult_tridiag, diagonal_lmult_tridiag - ! Deallocate and reset. - procedure :: finalize => tridiag_finalize -end type TriDiagOp - -interface operator(+) - module procedure add_tridiag_ops -end interface operator(+) - -interface operator(-) - module procedure subtract_tridiag_ops -end interface operator(-) - -interface TriDiagOp - module procedure new_TriDiagOp -end interface TriDiagOp - -! -! Boundary condition types for the operators. -! -! Note that BoundaryFixedLayer and BoundaryFixedFlux are the only options -! supported for backwards operation (i.e. decomp%left_div). The others are -! meant for direct application only (e.g. to find a derivative). -! -! BoundaryZero means that the operator fixes boundaries to 0. -! BoundaryFirstOrder means a one-sided approximation for the first -! derivative. -! BoundaryExtrapolate means that a second order approximation will be used, -! even at the boundaries. Boundary points do this by using their next- -! nearest neighbor to extrapolate. -! BoundaryFixedLayer means that there's an extra layer outside of the given -! grid, which must be specified when applying/inverting the operator. -! BoundaryFixedFlux is intended to provide a fixed-flux condition for -! typical advection/diffusion operators. It tweaks the edge condition -! to work on an input current rather than a value. -! -! The different types were originally implemented through polymorphism, but -! PGI required this to be done via enum instead. -integer, parameter :: zero_bndry = 0 -integer, parameter :: first_order_bndry = 1 -integer, parameter :: extrapolate_bndry = 2 -integer, parameter :: fixed_layer_bndry = 3 -integer, parameter :: fixed_flux_bndry = 4 - -type :: BoundaryType - private - integer :: bndry_type = fixed_flux_bndry - real(r8), allocatable :: edge_width(:) - contains - procedure :: make_left - procedure :: make_right - procedure :: finalize => boundary_type_finalize -end type BoundaryType - -abstract interface - subroutine deriv_seed(del_minus, del_plus, sub, spr) - import :: r8 - real(r8), USE_CONTIGUOUS intent(in) :: del_minus(:) - real(r8), USE_CONTIGUOUS intent(in) :: del_plus(:) - real(r8), USE_CONTIGUOUS intent(out) :: sub(:) - real(r8), USE_CONTIGUOUS intent(out) :: spr(:) - end subroutine deriv_seed -end interface - -interface BoundaryZero - module procedure new_BoundaryZero -end interface BoundaryZero - -interface BoundaryFirstOrder - module procedure new_BoundaryFirstOrder -end interface BoundaryFirstOrder - -interface BoundaryExtrapolate - module procedure new_BoundaryExtrapolate -end interface BoundaryExtrapolate - -interface BoundaryFixedLayer - module procedure new_BoundaryFixedLayer -end interface BoundaryFixedLayer - -interface BoundaryFixedFlux - module procedure new_BoundaryFixedFlux -end interface BoundaryFixedFlux - -! -! Data for boundary conditions themselves. -! -! "No data" conditions perform extrapolation, if BoundaryExtrapolate was -! the boundary type used to construct the operator. -! -! "Data" conditions contain extra data, which effectively extends the -! system with an extra cell. -! -! "Flux" conditions contain prescribed fluxes. -! -! The condition you can use depends on the boundary type from above that -! was used in the operator's construction. For BoundaryFixedLayer use -! BoundaryData. For BoundaryFixedFlux use BoundaryFlux. For everything -! else, use BoundaryNoData. - -! The switches using this enumeration used to be unnecessary due to use of -! polymorphism, but this had to be backed off due to insufficient PGI -! support for type extension. -integer, parameter :: no_data_cond = 0 -integer, parameter :: data_cond = 1 -integer, parameter :: flux_cond = 2 - -type :: BoundaryCond - private - integer :: cond_type = no_data_cond - real(r8), allocatable :: edge_data(:) - contains - procedure :: apply_left - procedure :: apply_right - procedure :: finalize => boundary_cond_finalize -end type BoundaryCond - -! Constructors for different types of BoundaryCond. -interface BoundaryNoData - module procedure new_BoundaryNoData -end interface BoundaryNoData - -interface BoundaryData - module procedure new_BoundaryData -end interface BoundaryData - -interface BoundaryFlux - module procedure new_BoundaryFlux -end interface BoundaryFlux - -! Opaque type to hold a tridiagonal matrix decomposition. -! -! Method used is similar to Richtmyer and Morton (1967,pp 198-201), but -! the order of iteration is reversed, leading to A and C being swapped, and -! some differences in the indexing. -type :: TriDiagDecomp - private - integer :: nsys = 0 - integer :: ncel = 0 - ! These correspond to A_k, E_k, and 1 / (B_k - A_k * E_{k+1}) - real(r8), allocatable :: ca(:,:) - real(r8), allocatable :: ze(:,:) - real(r8), allocatable :: dnom(:,:) -contains - procedure :: left_div => decomp_left_div - procedure :: finalize => decomp_finalize -end type TriDiagDecomp - -interface TriDiagDecomp - module procedure new_TriDiagDecomp -end interface TriDiagDecomp - -contains - -! Operator that sets to 0. -function zero_operator(nsys, ncel) result(op) - ! Sizes for operator. - integer, intent(in) :: nsys, ncel - - type(TriDiagOp) :: op - - op = TriDiagOp(nsys, ncel) - - op%spr = 0._r8 - op%sub = 0._r8 - op%diag = 0._r8 - op%left_bound = 0._r8 - op%right_bound = 0._r8 - -end function zero_operator - -! Operator that does nothing. -function identity_operator(nsys, ncel) result(op) - ! Sizes for operator. - integer, intent(in) :: nsys, ncel - - type(TriDiagOp) :: op - - op = TriDiagOp(nsys, ncel) - - op%spr = 0._r8 - op%sub = 0._r8 - op%diag = 1._r8 - op%left_bound = 0._r8 - op%right_bound = 0._r8 - -end function identity_operator - -! Create an operator that just does an element-wise product by some data. -function diagonal_operator(diag) result(op) - ! Data to multiply by. - real(r8), USE_CONTIGUOUS intent(in) :: diag(:,:) - - type(TriDiagOp) :: op - - op = TriDiagOp(size(diag, 1), size(diag, 2)) - - op%spr = 0._r8 - op%sub = 0._r8 - op%diag = diag - op%left_bound = 0._r8 - op%right_bound = 0._r8 - -end function diagonal_operator - -! Diffusion matrix operator constructor. Given grid coordinates, a set of -! diffusion coefficients, and boundaries, creates a matrix corresponding -! to a finite volume representation of the operation: -! -! d/dx (d_coef * d/dx) -! -! This differs from what you would get from combining the first and second -! derivative operations, which would be more appropriate for a finite -! difference scheme that does not use grid cell averages. -function diffusion_operator(coords, d_coef, l_bndry, r_bndry) & - result(op) - ! Grid cell locations. - type(Coords1D), intent(in) :: coords - ! Diffusion coefficient defined on interfaces. - real(r8), USE_CONTIGUOUS intent(in) :: d_coef(:,:) - ! Objects representing the kind of boundary on each side. - class(BoundaryType), target, intent(in), optional :: l_bndry, r_bndry - ! Output operator. - type(TriDiagOp) :: op - - ! Selectors to implement default boundary. - class(BoundaryType), pointer :: l_bndry_loc, r_bndry_loc - ! Fixed flux is default, no allocation/deallocation needed. - type(BoundaryType), target :: bndry_default - - ! Level index. - integer :: k - - if (present(l_bndry)) then - l_bndry_loc => l_bndry - else - l_bndry_loc => bndry_default - end if - - if (present(r_bndry)) then - r_bndry_loc => r_bndry - else - r_bndry_loc => bndry_default - end if - - ! Allocate the operator. - op = TriDiagOp(coords%n, coords%d) - - ! d_coef over the distance to the next cell gives you the matrix term for - ! flux of material between cells. Dividing by cell thickness translates - ! this to a tendency on the concentration. Hence the basic pattern is - ! d_coef*rdst*rdel. - ! - ! Boundary conditions for a fixed layer simply extend this by calculating - ! the distance to the midpoint of the extra edge layer. - - select case (l_bndry_loc%bndry_type) - case (fixed_layer_bndry) - op%left_bound = 2._r8*d_coef(:,1)*coords%rdel(:,1) / & - (l_bndry_loc%edge_width+coords%del(:,1)) - case default - op%left_bound = 0._r8 - end select - - do k = 1, coords%d-1 - op%spr(:,k) = d_coef(:,k+1)*coords%rdst(:,k)*coords%rdel(:,k) - op%sub(:,k) = d_coef(:,k+1)*coords%rdst(:,k)*coords%rdel(:,k+1) - end do - - select case (r_bndry_loc%bndry_type) - case (fixed_layer_bndry) - op%right_bound = 2._r8*d_coef(:,coords%d+1)*coords%rdel(:,coords%d) / & - (r_bndry_loc%edge_width+coords%del(:,coords%d)) - case default - op%right_bound = 0._r8 - end select - - ! Above, we found all off-diagonals. Now get the diagonal. - call op%deriv_diag() - -end function diffusion_operator - -! Advection matrix operator constructor. Similar to diffusion_operator, it -! constructs an operator A corresponding to: -! -! A y = d/dx (-v_coef * y) -! -! Again, this is targeted at representing this operator acting on grid-cell -! averages in a finite volume scheme, rather than a literal representation. -function advection_operator(coords, v_coef, l_bndry, r_bndry) & - result(op) - ! Grid cell locations. - type(Coords1D), intent(in) :: coords - ! Advection coefficient (effective velocity). - real(r8), USE_CONTIGUOUS intent(in) :: v_coef(:,:) - ! Objects representing the kind of boundary on each side. - class(BoundaryType), target, intent(in), optional :: l_bndry, r_bndry - ! Output operator. - type(TriDiagOp) :: op - - ! Selectors to implement default boundary. - class(BoundaryType), pointer :: l_bndry_loc, r_bndry_loc - ! Fixed flux is default, no allocation/deallocation needed. - type(BoundaryType), target :: bndry_default - - ! Negative derivative of v. - real(r8) :: v_deriv(coords%n,coords%d) - - if (present(l_bndry)) then - l_bndry_loc => l_bndry - else - l_bndry_loc => bndry_default - end if - - if (present(r_bndry)) then - r_bndry_loc => r_bndry - else - r_bndry_loc => bndry_default - end if - - ! Allocate the operator. - op = TriDiagOp(coords%n, coords%d) - - ! Construct the operator in two stages using the product rule. First - ! create (-v * d/dx), then -dv/dx, and add the two. - ! - ! For the first part, we want to interpolate to interfaces (weighted - ! average involving del/2*dst), multiply by -v to get flux, then divide - ! by cell thickness, which gives a concentration tendency: - ! - ! (del/(2*dst))*(-v_coef)/del - ! - ! Simplifying gives -v_coef*rdst*0.5, as seen below. - - select case (l_bndry_loc%bndry_type) - case (fixed_layer_bndry) - op%left_bound = v_coef(:,1) / & - (l_bndry_loc%edge_width+coords%del(:,1)) - case default - op%left_bound = 0._r8 - end select - - op%sub = v_coef(:,2:coords%d)*coords%rdst*0.5_r8 - op%spr = -op%sub - - select case (r_bndry_loc%bndry_type) - case (fixed_layer_bndry) - op%right_bound = v_coef(:,coords%d+1) / & - (r_bndry_loc%edge_width+coords%del(:,coords%d)) - case default - op%right_bound = 0._r8 - end select - - ! Above, we found all off-diagonals. Now get the diagonal. This must be - ! done at this specific point, since the other half of the operator is - ! not "derivative-like" in the sense of yielding 0 for a constant input. - call op%deriv_diag() - - ! The second half of the operator simply involves taking a first-order - ! derivative of v. Since v is on the interfaces, just use: - ! (v(k+1) - v(k))*rdel(k) - v_deriv(:,1) = v_coef(:,2)*coords%rdel(:,1) - - select case (l_bndry_loc%bndry_type) - case (fixed_layer_bndry) - v_deriv(:,1) = v_deriv(:,1) - v_coef(:,1)*coords%rdel(:,1) - end select - - v_deriv(:,2:coords%d-1) = (v_coef(:,3:coords%d) - & - v_coef(:,2:coords%d-1))*coords%rdel(:,2:coords%d-1) - - v_deriv(:,coords%d) = -v_coef(:,coords%d)*coords%rdel(:,coords%d) - - select case (r_bndry_loc%bndry_type) - case (fixed_layer_bndry) - v_deriv(:,coords%d) = v_deriv(:,coords%d) & - + v_coef(:,coords%d+1)*coords%del(:,coords%d) - end select - - ! Combine the two pieces. - op%diag = op%diag - v_deriv - -end function advection_operator - -! Second order approximation to the first and second derivatives on a non- -! uniform grid. -! -! Both operators are constructed with the same method, except for a "seed" -! function that takes local distances between points to create the -! off-diagonal terms. -function first_derivative(grid_spacing, l_bndry, r_bndry) result(op) - ! Distances between points. - real(r8), USE_CONTIGUOUS intent(in) :: grid_spacing(:,:) - ! Boundary conditions. - class(BoundaryType), intent(in), optional :: l_bndry, r_bndry - ! Output operator. - type(TriDiagOp) :: op - - op = deriv_op_from_seed(grid_spacing, first_derivative_seed, & - l_bndry, r_bndry) - -end function first_derivative - -subroutine first_derivative_seed(del_minus, del_plus, sub, spr) - ! Distances to next and previous point. - real(r8), USE_CONTIGUOUS intent(in) :: del_minus(:) - real(r8), USE_CONTIGUOUS intent(in) :: del_plus(:) - ! Off-diagonal matrix terms. - real(r8), USE_CONTIGUOUS intent(out) :: sub(:) - real(r8), USE_CONTIGUOUS intent(out) :: spr(:) - - real(r8) :: del_sum(size(del_plus)) - - del_sum = del_plus + del_minus - - sub = - del_plus / (del_minus*del_sum) - spr = del_minus / (del_plus*del_sum) - -end subroutine first_derivative_seed - -function second_derivative(grid_spacing, l_bndry, r_bndry) result(op) - ! Distances between points. - real(r8), USE_CONTIGUOUS intent(in) :: grid_spacing(:,:) - ! Boundary conditions. - class(BoundaryType), intent(in), optional :: l_bndry, r_bndry - ! Output operator. - type(TriDiagOp) :: op - - op = deriv_op_from_seed(grid_spacing, second_derivative_seed, & - l_bndry, r_bndry) - -end function second_derivative - -subroutine second_derivative_seed(del_minus, del_plus, sub, spr) - ! Distances to next and previous point. - real(r8), USE_CONTIGUOUS intent(in) :: del_minus(:) - real(r8), USE_CONTIGUOUS intent(in) :: del_plus(:) - ! Off-diagonal matrix terms. - real(r8), USE_CONTIGUOUS intent(out) :: sub(:) - real(r8), USE_CONTIGUOUS intent(out) :: spr(:) - - real(r8) :: del_sum(size(del_plus)) - - del_sum = del_plus + del_minus - - sub = 2._r8 / (del_minus*del_sum) - spr = 2._r8 / (del_plus*del_sum) - -end subroutine second_derivative_seed - -! Brains behind the first/second derivative functions. -function deriv_op_from_seed(grid_spacing, seed, l_bndry, r_bndry) result(op) - ! Distances between points. - real(r8), USE_CONTIGUOUS intent(in) :: grid_spacing(:,:) - ! Function to locally construct matrix elements. - procedure(deriv_seed) :: seed - ! Boundary conditions. - class(BoundaryType), target, intent(in), optional :: l_bndry, r_bndry - ! Output operator. - type(TriDiagOp) :: op - - ! Selectors to implement default boundary. - class(BoundaryType), pointer :: l_bndry_loc, r_bndry_loc - ! Fixed flux is default, no allocation/deallocation needed. - type(BoundaryType), target :: bndry_default - - integer :: k - - if (present(l_bndry)) then - l_bndry_loc => l_bndry - else - l_bndry_loc => bndry_default - end if - - if (present(r_bndry)) then - r_bndry_loc => r_bndry - else - r_bndry_loc => bndry_default - end if - - ! Number of grid points is one greater than the spacing. - op = TriDiagOp(size(grid_spacing, 1), size(grid_spacing, 2) + 1) - - ! Left boundary condition. - call l_bndry_loc%make_left(grid_spacing, seed, & - op%left_bound, op%spr(:,1)) - - do k = 2, op%ncel-1 - call seed(grid_spacing(:,k-1), grid_spacing(:,k), & - op%sub(:,k-1), op%spr(:,k)) - end do - - ! Right boundary condition. - call r_bndry_loc%make_right(grid_spacing, seed, & - op%sub(:,op%ncel-1), op%right_bound) - - ! Above, we found all off-diagonals. Now get the diagonal. - call op%deriv_diag() - -end function deriv_op_from_seed - -! Boundary constructors. Most simply set an internal flag, but -! BoundaryFixedLayer accepts an argument representing the distance to the -! location where the extra layer is defined. - -function new_BoundaryZero() result(new_bndry) - type(BoundaryType) :: new_bndry - - new_bndry%bndry_type = zero_bndry - -end function new_BoundaryZero - -function new_BoundaryFirstOrder() result(new_bndry) - type(BoundaryType) :: new_bndry - - new_bndry%bndry_type = first_order_bndry - -end function new_BoundaryFirstOrder - -function new_BoundaryExtrapolate() result(new_bndry) - type(BoundaryType) :: new_bndry - - new_bndry%bndry_type = extrapolate_bndry - -end function new_BoundaryExtrapolate - -function new_BoundaryFixedLayer(width) result(new_bndry) - real(r8), USE_CONTIGUOUS intent(in) :: width(:) - type(BoundaryType) :: new_bndry - - new_bndry%bndry_type = fixed_layer_bndry - new_bndry%edge_width = width - -end function new_BoundaryFixedLayer - -function new_BoundaryFixedFlux() result(new_bndry) - type(BoundaryType) :: new_bndry - - new_bndry%bndry_type = fixed_flux_bndry - -end function new_BoundaryFixedFlux - -! The make_left and make_right methods implement the boundary conditions -! using an input seed. - -subroutine make_left(self, grid_spacing, seed, term1, term2) - class(BoundaryType), intent(in) :: self - real(r8), USE_CONTIGUOUS intent(in) :: grid_spacing(:,:) - procedure(deriv_seed) :: seed - real(r8), USE_CONTIGUOUS intent(out) :: term1(:) - real(r8), USE_CONTIGUOUS intent(out) :: term2(:) - - real(r8) :: del_plus(size(term1)), del_minus(size(term1)) - - select case (self%bndry_type) - case (zero_bndry) - term1 = 0._r8 - term2 = 0._r8 - case (first_order_bndry) - ! To calculate to first order, just use a really huge del_minus (i.e. - ! pretend that there's a point so far away it doesn't matter). - del_plus = grid_spacing(:,1) - del_minus = del_plus * 4._r8 / epsilon(1._r8) - call seed(del_minus, del_plus, term1, term2) - case (extrapolate_bndry) - ! To extrapolate from the boundary, use distance from the nearest - ! neighbor (as usual) and the second nearest neighbor (with a negative - ! sign, since we are using two points on the same side). - del_plus = grid_spacing(:,1) - del_minus = - (grid_spacing(:,1) + grid_spacing(:,2)) - call seed(del_minus, del_plus, term1, term2) - case (fixed_layer_bndry) - ! Use edge value to extend the grid. - del_plus = grid_spacing(:,1) - del_minus = self%edge_width - call seed(del_minus, del_plus, term1, term2) - case (fixed_flux_bndry) - ! Treat grid as uniform, but then zero out the contribution from data - ! on one side (since it will be prescribed). - del_plus = grid_spacing(:,1) - del_minus = del_plus - call seed(del_minus, del_plus, term1, term2) - term1 = 0._r8 - case default - call shr_sys_abort("Invalid boundary type at "// & - errMsg(__FILE__, __LINE__)) - end select - -end subroutine make_left - -subroutine make_right(self, grid_spacing, seed, term1, term2) - class(BoundaryType), intent(in) :: self - real(r8), USE_CONTIGUOUS intent(in) :: grid_spacing(:,:) - procedure(deriv_seed) :: seed - real(r8), USE_CONTIGUOUS intent(out) :: term1(:) - real(r8), USE_CONTIGUOUS intent(out) :: term2(:) - - real(r8) :: del_plus(size(term1)), del_minus(size(term1)) - - select case (self%bndry_type) - case (zero_bndry) - term1 = 0._r8 - term2 = 0._r8 - case (first_order_bndry) - ! Use huge del_plus, analogous to how left boundary works. - del_minus = grid_spacing(:,size(grid_spacing, 2)) - del_plus = del_minus * 4._r8 / epsilon(1._r8) - call seed(del_minus, del_plus, term1, term2) - case (extrapolate_bndry) - ! Same strategy as left boundary, but reversed. - del_plus = - (grid_spacing(:,size(grid_spacing, 2) - 1) + & - grid_spacing(:,size(grid_spacing, 2))) - del_minus = grid_spacing(:,size(grid_spacing, 2)) - call seed(del_minus, del_plus, term1, term2) - case (fixed_layer_bndry) - ! Use edge value to extend the grid. - del_plus = self%edge_width - del_minus = grid_spacing(:,size(grid_spacing, 2)) - call seed(del_minus, del_plus, term1, term2) - case (fixed_flux_bndry) - ! Uniform grid, but with edge zeroed. - del_plus = grid_spacing(:,size(grid_spacing, 2)) - del_minus = del_plus - call seed(del_minus, del_plus, term1, term2) - term2 = 0._r8 - case default - call shr_sys_abort("Invalid boundary type at "// & - errMsg(__FILE__, __LINE__)) - end select - -end subroutine make_right - -subroutine boundary_type_finalize(self) - class(BoundaryType), intent(inout) :: self - - self%bndry_type = fixed_flux_bndry - if (allocated(self%edge_width)) deallocate(self%edge_width) - -end subroutine boundary_type_finalize - -! Constructor for TriDiagOp; this just sets the size and allocates -! arrays. -type(TriDiagOp) function new_TriDiagOp(nsys, ncel) - - integer, intent(in) :: nsys, ncel - - new_TriDiagOp%nsys = nsys - new_TriDiagOp%ncel = ncel - - allocate(new_TriDiagOp%spr(nsys,ncel-1), & - new_TriDiagOp%sub(nsys,ncel-1), & - new_TriDiagOp%diag(nsys,ncel), & - new_TriDiagOp%left_bound(nsys), & - new_TriDiagOp%right_bound(nsys)) - -end function new_TriDiagOp - -! Deallocator for TriDiagOp. -subroutine tridiag_finalize(self) - class(TriDiagOp), intent(inout) :: self - - self%nsys = 0 - self%ncel = 0 - - if (allocated(self%spr)) deallocate(self%spr) - if (allocated(self%sub)) deallocate(self%sub) - if (allocated(self%diag)) deallocate(self%diag) - if (allocated(self%left_bound)) deallocate(self%left_bound) - if (allocated(self%right_bound)) deallocate(self%right_bound) - -end subroutine tridiag_finalize - -! Boundary condition constructors. - -function new_BoundaryNoData() result(new_cond) - type(BoundaryCond) :: new_cond - - new_cond%cond_type = no_data_cond - ! No edge data, so leave it unallocated. - -end function new_BoundaryNoData - -function new_BoundaryData(data) result(new_cond) - real(r8), USE_CONTIGUOUS intent(in) :: data(:) - type(BoundaryCond) :: new_cond - - new_cond%cond_type = data_cond - new_cond%edge_data = data - -end function new_BoundaryData - -function new_BoundaryFlux(flux, dt, spacing) result(new_cond) - real(r8), USE_CONTIGUOUS intent(in) :: flux(:) - real(r8), intent(in) :: dt - real(r8), USE_CONTIGUOUS intent(in) :: spacing(:) - type(BoundaryCond) :: new_cond - - new_cond%cond_type = flux_cond - new_cond%edge_data = flux*dt/spacing - -end function new_BoundaryFlux - -! Application of input data. -! -! When no data is input, assume that any bound term is applied to the -! third element in from the edge for extrapolation. Boundary conditions -! that don't need any edge data at all can then simply set the boundary -! terms to 0. - -function apply_left(self, bound_term, array) result(delta_edge) - class(BoundaryCond), intent(in) :: self - real(r8), USE_CONTIGUOUS intent(in) :: bound_term(:) - real(r8), USE_CONTIGUOUS intent(in) :: array(:,:) - real(r8) :: delta_edge(size(array, 1)) - - select case (self%cond_type) - case (no_data_cond) - delta_edge = bound_term*array(:,3) - case (data_cond) - delta_edge = bound_term*self%edge_data - case (flux_cond) - delta_edge = self%edge_data - case default - call shr_sys_abort("Invalid boundary condition at "// & - errMsg(__FILE__, __LINE__)) - end select - -end function apply_left - -function apply_right(self, bound_term, array) result(delta_edge) - class(BoundaryCond), intent(in) :: self - real(r8), USE_CONTIGUOUS intent(in) :: bound_term(:) - real(r8), USE_CONTIGUOUS intent(in) :: array(:,:) - real(r8) :: delta_edge(size(array, 1)) - - select case (self%cond_type) - case (no_data_cond) - delta_edge = bound_term*array(:,size(array, 2)-2) - case (data_cond) - delta_edge = bound_term*self%edge_data - case (flux_cond) - delta_edge = self%edge_data - case default - call shr_sys_abort("Invalid boundary condition at "// & - errMsg(__FILE__, __LINE__)) - end select - -end function apply_right - -subroutine boundary_cond_finalize(self) - class(BoundaryCond), intent(inout) :: self - - self%cond_type = no_data_cond - if (allocated(self%edge_data)) deallocate(self%edge_data) - -end subroutine boundary_cond_finalize - -! Apply an operator and return the new data. -function apply_tridiag(self, array, l_cond, r_cond) result(output) - ! Operator to apply. - class(TriDiagOp), intent(in) :: self - ! Data to act on. - real(r8), USE_CONTIGUOUS intent(in) :: array(:,:) - ! Objects representing boundary conditions. - class(BoundaryCond), target, intent(in), optional :: l_cond, r_cond - ! Function result. - real(r8) :: output(size(array, 1), size(array, 2)) - - ! Local objects to implement default. - class(BoundaryCond), pointer :: l_cond_loc, r_cond_loc - ! Default state is no data, no allocation/deallocation needed. - type(BoundaryCond), target :: cond_default - - ! Level index. - integer :: k - - if (present(l_cond)) then - l_cond_loc => l_cond - else - l_cond_loc => cond_default - end if - - if (present(r_cond)) then - r_cond_loc => r_cond - else - r_cond_loc => cond_default - end if - - ! Left boundary. - output(:,1) = self%diag(:,1)*array(:,1) + & - self%spr(:,1)*array(:,2) + & - l_cond_loc%apply_left(self%left_bound, array) - - do k = 2, self%ncel-1 - output(:,k) = & - self%sub(:,k-1)*array(:,k-1) + & - self%diag(:,k)*array(:,k ) + & - self%spr(:,k)*array(:,k+1) - end do - - ! Right boundary. - output(:,self%ncel) = & - self%sub(:,self%ncel-1)*array(:,self%ncel-1) + & - self%diag(:,self%ncel)*array(:,self%ncel) + & - r_cond_loc%apply_right(self%right_bound, array) - -end function apply_tridiag - -! Fill in the diagonal for a TriDiagOp for a derivative operator, where -! the off diagonal elements are already filled in. -subroutine make_tridiag_deriv_diag(self) - - class(TriDiagOp), intent(inout) :: self - - ! If a derivative operator operates on a constant function, it must - ! return 0 everywhere. To force this, make sure that all rows add to - ! zero in the matrix. - self%diag(:,:self%ncel-1) = - self%spr - self%diag(:,self%ncel) = - self%right_bound - self%diag(:,1) = self%diag(:,1) - self%left_bound - self%diag(:,2:) = self%diag(:,2:) - self%sub - -end subroutine make_tridiag_deriv_diag - -! Sum two TriDiagOp objects into a new one; this is just the addition of -! all the entries. -function add_tridiag_ops(op1, op2) result(new_op) - - type(TriDiagOp), intent(in) :: op1, op2 - type(TriDiagOp) :: new_op - - new_op = op1 - - call new_op%add(op2) - -end function add_tridiag_ops - -subroutine add_in_place_tridiag_ops(self, other) - - class(TriDiagOp), intent(inout) :: self - class(TriDiagOp), intent(in) :: other - - self%spr = self%spr + other%spr - self%sub = self%sub + other%sub - self%diag = self%diag + other%diag - - self%left_bound = self%left_bound + other%left_bound - self%right_bound = self%right_bound + other%right_bound - -end subroutine add_in_place_tridiag_ops - -! Subtract two TriDiagOp objects. -function subtract_tridiag_ops(op1, op2) result(new_op) - - type(TriDiagOp), intent(in) :: op1, op2 - type(TriDiagOp) :: new_op - - new_op = op1 - - call new_op%subtract(op2) - -end function subtract_tridiag_ops - -! Subtract two TriDiagOp objects. -subroutine subtract_in_place_tridiag_ops(self, other) - - class(TriDiagOp), intent(inout) :: self - class(TriDiagOp), intent(in) :: other - - self%spr = self%spr - other%spr - self%sub = self%sub - other%sub - self%diag = self%diag - other%diag - - self%left_bound = self%left_bound - other%left_bound - self%right_bound = self%right_bound - other%right_bound - -end subroutine subtract_in_place_tridiag_ops - -! Equivalent to adding a multiple of the identity. -subroutine scalar_add_tridiag(self, constant) - - class(TriDiagOp), intent(inout) :: self - real(r8), intent(in) :: constant - - self%diag = self%diag + constant - -end subroutine scalar_add_tridiag - -! Equivalent to adding the diagonal operator constructed from diag_array. -subroutine diagonal_add_tridiag(self, diag_array) - - class(TriDiagOp), intent(inout) :: self - real(r8), USE_CONTIGUOUS intent(in) :: diag_array(:,:) - - self%diag = self%diag + diag_array - -end subroutine diagonal_add_tridiag - -! Multiply a scalar by an array. -subroutine scalar_lmult_tridiag(self, constant) - - class(TriDiagOp), intent(inout) :: self - real(r8), intent(in) :: constant - - self%spr = self%spr * constant - self%sub = self%sub * constant - self%diag = self%diag * constant - - self%left_bound = self%left_bound * constant - self%right_bound = self%right_bound * constant - -end subroutine scalar_lmult_tridiag - -! Multiply in an array as if it contained the entries of a diagonal matrix -! being multiplied from the left. -subroutine diagonal_lmult_tridiag(self, diag_array) - - class(TriDiagOp), intent(inout) :: self - real(r8), USE_CONTIGUOUS intent(in) :: diag_array(:,:) - - self%spr = self%spr * diag_array(:,:self%ncel-1) - self%sub = self%sub * diag_array(:,2:) - self%diag = self%diag * diag_array(:,:) - - self%left_bound = self%left_bound * diag_array(:,1) - self%right_bound = self%right_bound * diag_array(:,self%ncel) - -end subroutine diagonal_lmult_tridiag - -! Decomposition constructor -! -! The equation to be solved later (with left_div) is: -! - A(k)*q(k+1) + B(k)*q(k) - C(k)*q(k-1) = D(k) -! -! The solution (effectively via LU decomposition) has the form: -! E(k) = C(k) / (B(k) - A(k)*E(k+1)) -! F(k) = (D(k) + A(k)*F(k+1)) / (B(k) - A(k)*E(k+1)) -! q(k) = E(k) * q(k-1) + F(k) -! -! Unlike Richtmyer and Morton, E and F are defined by iterating backward -! down to level 1, and then q iterates forward. -! -! E can be calculated and stored now, without knowing D. -! To calculate F later, we store A and the denominator. -function new_TriDiagDecomp(op, graft_decomp) result(decomp) - type(TriDiagOp), intent(in) :: op - type(TriDiagDecomp), intent(in), optional :: graft_decomp - - type(TriDiagDecomp) :: decomp - - integer :: k - - if (present(graft_decomp)) then - decomp%nsys = graft_decomp%nsys - decomp%ncel = graft_decomp%ncel - else - decomp%nsys = op%nsys - decomp%ncel = op%ncel - end if - - ! Simple allocation with no error checking. - allocate(decomp%ca(decomp%nsys,decomp%ncel)) - allocate(decomp%dnom(decomp%nsys,decomp%ncel)) - allocate(decomp%ze(decomp%nsys,decomp%ncel)) - - ! decomp%ca is simply the negative of the tridiagonal's superdiagonal. - decomp%ca(:,:op%ncel-1) = -op%spr - decomp%ca(:,op%ncel) = -op%right_bound - - if (present(graft_decomp)) then - ! Copy in graft_decomp beyond op%ncel. - decomp%ca(:,op%ncel+1:) = graft_decomp%ca(:,op%ncel+1:) - decomp%dnom(:,op%ncel+1:) = graft_decomp%dnom(:,op%ncel+1:) - decomp%ze(:,op%ncel+1:) = graft_decomp%ze(:,op%ncel+1:) - ! Fill in dnom edge value. - decomp%dnom(:,op%ncel) = 1._r8 / (op%diag(:,op%ncel) - & - decomp%ca(:,op%ncel)*decomp%ze(:,op%ncel+1)) - else - ! If no grafting, the edge value of dnom comes from the diagonal. - decomp%dnom(:,op%ncel) = 1._r8 / op%diag(:,op%ncel) - end if - - do k = op%ncel - 1, 1, -1 - decomp%ze(:,k+1) = - op%sub(:,k) * decomp%dnom(:,k+1) - decomp%dnom(:,k) = 1._r8 / & - (op%diag(:,k) - decomp%ca(:,k)*decomp%ze(:,k+1)) - end do - - ! Don't multiply edge level by denom, because we want to leave it up to - ! the BoundaryCond object to decide what this means in left_div. - decomp%ze(:,1) = -op%left_bound - -end function new_TriDiagDecomp - -! Left-division (multiplication by inverse) using a decomposed operator. -! -! See the comment above for the constructor for a quick explanation of the -! intermediate variables. The "q" argument is "D(k)" on input and "q(k)" on -! output. -subroutine decomp_left_div(decomp, q, l_cond, r_cond) - - ! Decomposed matrix. - class(TriDiagDecomp), intent(in) :: decomp - ! Data to left-divide by the matrix. - real(r8), USE_CONTIGUOUS intent(inout) :: q(:,:) - ! Objects representing boundary conditions. - class(BoundaryCond), intent(in), optional :: l_cond, r_cond - - ! "F" from the equation above. - real(r8) :: zf(decomp%nsys,decomp%ncel) - - ! Level index. - integer :: k - - ! Include boundary conditions. - if (present(l_cond)) then - q(:,1) = q(:,1) + l_cond%apply_left(decomp%ze(:,1), q) - end if - - if (present(r_cond)) then - q(:,decomp%ncel) = q(:,decomp%ncel) + & - r_cond%apply_right(decomp%ca(:,decomp%ncel), q) - end if - - zf(:,decomp%ncel) = q(:,decomp%ncel) * decomp%dnom(:,decomp%ncel) - - do k = decomp%ncel - 1, 1, -1 - zf(:,k) = (q(:,k) + decomp%ca(:,k)*zf(:,k+1)) * decomp%dnom(:,k) - end do - - ! Perform back substitution - - q(:,1) = zf(:,1) - - do k = 2, decomp%ncel - q(:,k) = zf(:,k) + decomp%ze(:,k)*q(:,k-1) - end do - -end subroutine decomp_left_div - -! Decomposition deallocation. -subroutine decomp_finalize(decomp) - class(TriDiagDecomp), intent(inout) :: decomp - - decomp%nsys = 0 - decomp%ncel = 0 - - if (allocated(decomp%ca)) deallocate(decomp%ca) - if (allocated(decomp%dnom)) deallocate(decomp%dnom) - if (allocated(decomp%ze)) deallocate(decomp%ze) - -end subroutine decomp_finalize - -end module linear_1d_operators diff --git a/src/utils/namelist_utils.F90 b/src/utils/namelist_utils.F90 deleted file mode 100644 index c12dfad2d6..0000000000 --- a/src/utils/namelist_utils.F90 +++ /dev/null @@ -1,6 +0,0 @@ -module namelist_utils - -use shr_nl_mod, only: & - find_group_name => shr_nl_find_group_name - -end module namelist_utils diff --git a/src/utils/physconst.F90 b/src/utils/physconst.F90 index 4da502f3eb..a06f347640 100644 --- a/src/utils/physconst.F90 +++ b/src/utils/physconst.F90 @@ -1,1863 +1,275 @@ module physconst -! Physical constants. Use csm_share values whenever available. - + ! Physical constants. Use csm_share values whenever available. use shr_kind_mod, only: r8 => shr_kind_r8 - use shr_const_mod, only: shr_const_g, shr_const_stebol, shr_const_tkfrz, & - shr_const_mwdair, shr_const_rdair, shr_const_mwwv, & - shr_const_latice, shr_const_latvap, shr_const_cpdair, & - shr_const_rhofw, shr_const_cpwv, shr_const_rgas, & - shr_const_karman, shr_const_pstd, shr_const_rhodair,& - shr_const_avogad, shr_const_boltz, shr_const_cpfw, & - shr_const_rwv, shr_const_zvir, shr_const_pi, & - shr_const_rearth, shr_const_sday, shr_const_cday, & - shr_const_spval, shr_const_omega, shr_const_cpvir, & - shr_const_tktrip, shr_const_cpice + use shr_const_mod, only: shr_const_g + use shr_const_mod, only: shr_const_stebol + use shr_const_mod, only: shr_const_tkfrz + use shr_const_mod, only: shr_const_mwdair + use shr_const_mod, only: shr_const_rdair + use shr_const_mod, only: shr_const_mwwv + use shr_const_mod, only: shr_const_latice + use shr_const_mod, only: shr_const_latvap + use shr_const_mod, only: shr_const_cpdair + use shr_const_mod, only: shr_const_rhofw + use shr_const_mod, only: shr_const_cpwv + use shr_const_mod, only: shr_const_rgas + use shr_const_mod, only: shr_const_karman + use shr_const_mod, only: shr_const_pstd + use shr_const_mod, only: shr_const_rhodair + use shr_const_mod, only: shr_const_avogad + use shr_const_mod, only: shr_const_boltz + use shr_const_mod, only: shr_const_cpfw + use shr_const_mod, only: shr_const_rwv + use shr_const_mod, only: shr_const_zvir + use shr_const_mod, only: shr_const_pi + use shr_const_mod, only: shr_const_rearth + use shr_const_mod, only: shr_const_sday + use shr_const_mod, only: shr_const_cday + use shr_const_mod, only: shr_const_spval + use shr_const_mod, only: shr_const_omega + use shr_const_mod, only: shr_const_cpvir + use shr_const_mod, only: shr_const_tktrip + use shr_const_mod, only: shr_const_cpice use shr_flux_mod, only: shr_flux_adjust_constants - use ppgrid, only: pcols, pver, pverp, begchunk, endchunk use cam_abortutils, only: endrun -use constituents, only: pcnst + use constituents, only: pcnst -implicit none -private -save + implicit none + private + save -public :: physconst_readnl -public :: physconst_init -public :: physconst_update -public :: physconst_calc_kappav -public :: composition_init -! -! subroutines to compute thermodynamic quantities -! -! See Lauritzen et al. (2018) for formulaes -! -public :: get_dp ! pressure level thickness from dry dp and dry mixing ratios -public :: get_pmid_from_dp ! full level pressure from dp (approximation depends on dycore) -public :: get_ps ! surface pressure -public :: get_thermal_energy ! thermal energy quantity = dp*cp*T -public :: get_virtual_temp ! virtual temperature -public :: get_cp ! (generalized) heat capacity -public :: get_cp_dry ! (generalized) heat capacity for dry air -public :: get_sum_species ! sum of thermodynamically active species: dp_dry*sum_species=dp -public :: get_virtual_theta ! virtual potential temperature -public :: get_gz ! geopotential -public :: get_gz_given_dp_Tv_Rdry ! geopotential (with dp,dry R and Tv as input) -public :: get_Richardson_number ! Richardson number at layer interfaces -public :: get_hydrostatic_static_energy ! geopotential, dry static energy, and kinetic energy -public :: get_R_dry ! (generalized) dry air gas constant -public :: get_kappa_dry ! (generalized) dry kappa = R_dry/cp_dry -public :: get_dp_ref ! reference pressure layer thickness (include topography) -public :: get_molecular_diff_coef ! molecular diffusion and thermal conductivity -public :: get_molecular_diff_coef_reference ! reference vertical profile of density, molecular diffusion & - ! and thermal conductivity -public :: get_rho_dry ! dry densisty from temperature (temp) and pressure (dp_dry and tracer) -public :: get_exner ! Exner pressure + public :: physconst_readnl -! Constants based off share code or defined in physconst + ! Constants based off share code or defined in physconst -real(r8), public, parameter :: avogad = shr_const_avogad ! Avogadro's number (molecules/kmole) -real(r8), public, parameter :: boltz = shr_const_boltz ! Boltzman's constant (J/K/molecule) -real(r8), public, parameter :: cday = shr_const_cday ! sec in calendar day ~ sec -real(r8), public, parameter :: cpliq = shr_const_cpfw ! specific heat of fresh h2o (J/K/kg) -real(r8), public, parameter :: cpice = shr_const_cpice ! specific heat of ice (J/K/kg) -real(r8), public, parameter :: karman = shr_const_karman ! Von Karman constant -real(r8), public, parameter :: latice = shr_const_latice ! Latent heat of fusion (J/kg) -real(r8), public, parameter :: latvap = shr_const_latvap ! Latent heat of vaporization (J/kg) -real(r8), public, parameter :: pi = shr_const_pi ! 3.14... + real(r8), public, parameter :: avogad = shr_const_avogad ! Avogadro's number (molecules kmole-1) + real(r8), public, parameter :: boltz = shr_const_boltz ! Boltzman's constant (J K-1 molecule-1) + real(r8), public, parameter :: cday = shr_const_cday ! sec in calendar day (seconds) + real(r8), public, parameter :: cpliq = shr_const_cpfw ! specific heat of fresh h2o (J K-1 kg-1) + real(r8), public, parameter :: cpice = shr_const_cpice ! specific heat of ice (J K-1 kg-1) + real(r8), public, parameter :: karman = shr_const_karman ! Von Karman constant + real(r8), public, parameter :: latice = shr_const_latice ! Latent heat of fusion (J kg-1) + real(r8), public, parameter :: latvap = shr_const_latvap ! Latent heat of vaporization (J kg-1) + real(r8), public, parameter :: pi = shr_const_pi ! 3.14... #ifdef planet_mars -real(r8), public, parameter :: pstd = 6.0E1_r8 ! Standard pressure (Pascals) + real(r8), public, parameter :: pstd = 6.0E1_r8 ! Standard pressure (Pascals) #else -real(r8), public, parameter :: pstd = shr_const_pstd ! Standard pressure (Pascals) -real(r8), public, parameter :: tref = 288._r8 ! Reference temperature -real(r8), public, parameter :: lapse_rate = 0.0065_r8 ! reference lapse rate [K/m] + real(r8), public, parameter :: pstd = shr_const_pstd ! Standard pressure (Pascals) + real(r8), public, parameter :: tref = 288._r8 ! Reference temperature (K) + real(r8), public, parameter :: lapse_rate = 0.0065_r8 ! reference lapse rate (K m-1) #endif -real(r8), public, parameter :: r_universal = shr_const_rgas ! Universal gas constant (J/K/kmol) -real(r8), public, parameter :: rhoh2o = shr_const_rhofw ! Density of liquid water (STP) -real(r8), public, parameter :: spval = shr_const_spval !special value -real(r8), public, parameter :: stebol = shr_const_stebol ! Stefan-Boltzmann's constant (W/m^2/K^4) -real(r8), public, parameter :: h2otrip = shr_const_tktrip ! Triple point temperature of water (K) - -real(r8), public, parameter :: c0 = 2.99792458e8_r8 ! Speed of light in a vacuum (m/s) -real(r8), public, parameter :: planck = 6.6260755e-34_r8 ! Planck's constant (J.s) - -! Molecular weights -real(r8), public, parameter :: mwco2 = 44._r8 ! molecular weight co2 -real(r8), public, parameter :: mwn2o = 44._r8 ! molecular weight n2o -real(r8), public, parameter :: mwch4 = 16._r8 ! molecular weight ch4 -real(r8), public, parameter :: mwf11 = 136._r8 ! molecular weight cfc11 -real(r8), public, parameter :: mwf12 = 120._r8 ! molecular weight cfc12 -real(r8), public, parameter :: mwo3 = 48._r8 ! molecular weight O3 -real(r8), public, parameter :: mwso2 = 64._r8 -real(r8), public, parameter :: mwso4 = 96._r8 -real(r8), public, parameter :: mwh2o2 = 34._r8 -real(r8), public, parameter :: mwdms = 62._r8 -real(r8), public, parameter :: mwnh4 = 18._r8 - - -! modifiable physical constants for aquaplanet - -real(r8), public, protected :: gravit = shr_const_g ! gravitational acceleration (m/s**2) -real(r8), public, protected :: sday = shr_const_sday ! sec in siderial day ~ sec -real(r8), public, protected :: mwh2o = shr_const_mwwv ! molecular weight h2o -real(r8), public, protected :: cpwv = shr_const_cpwv ! specific heat of water vapor (J/K/kg) -real(r8), public, protected :: mwdry = shr_const_mwdair ! molecular weight dry air -real(r8), public, protected :: cpair = shr_const_cpdair ! specific heat of dry air (J/K/kg) -real(r8), public, protected :: rearth = shr_const_rearth ! radius of earth (m) -real(r8), public, protected :: tmelt = shr_const_tkfrz ! Freezing point of water (K) - -!--------------- Variables below here are derived from those above ----------------------- - -real(r8), public, protected :: rga = 1._r8/shr_const_g ! reciprocal of gravit -real(r8), public, protected :: ra = 1._r8/shr_const_rearth ! reciprocal of earth radius -real(r8), public, protected :: omega = shr_const_omega ! earth rot ~ rad/sec -real(r8), public, protected :: rh2o = shr_const_rwv ! Water vapor gas constant ~ J/K/kg -real(r8), public, protected :: rair = shr_const_rdair ! Dry air gas constant ~ J/K/kg -real(r8), public, protected :: epsilo = shr_const_mwwv/shr_const_mwdair ! ratio of h2o to dry air molecular weights -real(r8), public, protected :: zvir = shr_const_zvir ! (rh2o/rair) - 1 -real(r8), public, protected :: cpvir = shr_const_cpvir ! CPWV/CPDAIR - 1.0 -real(r8), public, protected :: rhodair = shr_const_rhodair ! density of dry air at STP ~ kg/m^3 -real(r8), public, protected :: cappa = (shr_const_rgas/shr_const_mwdair)/shr_const_cpdair ! R/Cp -real(r8), public, protected :: ez ! Coriolis expansion coeff -> omega/sqrt(0.375) -real(r8), public, protected :: Cpd_on_Cpv = shr_const_cpdair/shr_const_cpwv - -!--------------- Variables below here are for WACCM-X ----------------------- -real(r8), public, dimension(:,:,:), pointer :: cpairv ! composition dependent specific heat at constant pressure -real(r8), public, dimension(:,:,:), pointer :: rairv ! composition dependent gas "constant" -real(r8), public, dimension(:,:,:), pointer :: cappav ! rairv/cpairv -real(r8), public, dimension(:,:,:), pointer :: mbarv ! composition dependent atmosphere mean mass -real(r8), public, dimension(:,:,:), pointer :: kmvis ! molecular viscosity kg/m/s -real(r8), public, dimension(:,:,:), pointer :: kmcnd ! molecular conductivity J/m/s/K - -!--------------- Variables for consistent themodynamics -------------------- -! -! composition of air -! -integer, parameter :: num_names_max = 30 -character(len=6 ) :: dry_air_species(num_names_max) -character(len=6 ) :: water_species_in_air(num_names_max) - -integer, protected, public :: dry_air_species_num -integer, protected, public :: water_species_in_air_num - -integer, protected, public :: thermodynamic_active_species_num -integer, allocatable, protected, public :: thermodynamic_active_species_idx(:) -integer, allocatable, public :: thermodynamic_active_species_idx_dycore(:) -real(r8), allocatable, protected, public :: thermodynamic_active_species_cp(:) -real(r8), allocatable, protected, public :: thermodynamic_active_species_cv(:) -real(r8), allocatable, protected, public :: thermodynamic_active_species_R(:) -real(r8), allocatable, protected, public :: thermodynamic_active_species_mwi(:)!inverse molecular weights dry air -real(r8), allocatable, protected, public :: thermodynamic_active_species_kv(:) !molecular diffusion -real(r8), allocatable, protected, public :: thermodynamic_active_species_kc(:) !thermal conductivity - -! standard dry air (constant composition) -real(r8) :: mmro2, mmrn2 ! Mass mixing ratios of O2 and N2 -real(r8) :: o2_mwi, n2_mwi ! Inverse molecular weights -real(r8) :: mbar ! Mean mass at mid level - -! coefficients in expressions for molecular diffusion coefficients -! kv1,..,kv4 are coefficients for kmvis calculation -! kc1,..,kc4 are coefficients for kmcnd calculation -real(r8), parameter :: & - kv1 = 4.03_r8, & - kv2 = 3.42_r8, & - kv3 = 3.9_r8, & - kv4 = 0.69_r8, & - kc1 = 56._r8, & - kc2 = 56._r8, & - kc3 = 75.9_r8, & - kc4 = 0.69_r8 - -!================================================================================================ -contains -!================================================================================================ - -! Read namelist variables. -subroutine physconst_readnl(nlfile) - - use namelist_utils, only: find_group_name - use spmd_utils, only: masterproc, mpicom, masterprocid, mpi_real8, mpi_character - use cam_logfile, only: iulog - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr, i - character(len=*), parameter :: subname = 'physconst_readnl' - logical :: newg, newsday, newmwh2o, newcpwv, newmwdry, newcpair, newrearth, newtmelt, newomega - - - ! Physical constants needing to be reset (e.g., for aqua planet experiments) - namelist /physconst_nl/ gravit, sday, mwh2o, cpwv, mwdry, cpair, rearth, tmelt, omega - - ! Variable components of dry air and water species in air - namelist /air_composition_nl/ dry_air_species, water_species_in_air - !----------------------------------------------------------------------------- - - if (masterproc) then - open( newunit=unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'physconst_nl', status=ierr) - if (ierr == 0) then - read(unitn, physconst_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - end if - - ! Broadcast namelist variables - call MPI_bcast(gravit, 1, mpi_real8, masterprocid, mpicom, ierr) - call MPI_bcast(sday, 1, mpi_real8, masterprocid, mpicom, ierr) - call MPI_bcast(mwh2o, 1, mpi_real8, masterprocid, mpicom, ierr) - call MPI_bcast(cpwv, 1, mpi_real8, masterprocid, mpicom, ierr) - call MPI_bcast(mwdry, 1, mpi_real8, masterprocid, mpicom, ierr) - call MPI_bcast(cpair, 1, mpi_real8, masterprocid, mpicom, ierr) - call MPI_bcast(rearth, 1, mpi_real8, masterprocid, mpicom, ierr) - call MPI_bcast(tmelt, 1, mpi_real8, masterprocid, mpicom, ierr) - call MPI_bcast(omega, 1, mpi_real8, masterprocid, mpicom, ierr) - - newg = gravit .ne. shr_const_g - newsday = sday .ne. shr_const_sday - newmwh2o = mwh2o .ne. shr_const_mwwv - newcpwv = cpwv .ne. shr_const_cpwv - newmwdry = mwdry .ne. shr_const_mwdair - newcpair = cpair .ne. shr_const_cpdair - newrearth= rearth .ne. shr_const_rearth - newtmelt = tmelt .ne. shr_const_tkfrz - newomega = omega .ne. shr_const_omega - - if (newg .or. newsday .or. newmwh2o .or. newcpwv .or. newmwdry .or. newrearth .or. newtmelt .or. newomega) then + real(r8), public, parameter :: r_universal = shr_const_rgas ! Universal gas constant (J K-1 kmol-1) + real(r8), public, parameter :: rhoh2o = shr_const_rhofw ! Density of liquid water at STP (kg m-3) + real(r8), public, parameter :: spval = shr_const_spval !special value + real(r8), public, parameter :: stebol = shr_const_stebol ! Stefan-Boltzmann's constant (W m-2 K-4) + real(r8), public, parameter :: h2otrip = shr_const_tktrip ! Triple point temperature of water (K) + + real(r8), public, parameter :: c0 = 2.99792458e8_r8 ! Speed of light in a vacuum (m s-1) + real(r8), public, parameter :: planck = 6.6260755e-34_r8 ! Planck's constant (J.s) + real(r8), public, parameter :: amu = 1.66053886e-27_r8 ! Atomic Mass Unit (kg) + + ! Molecular weights (g mol-1) + real(r8), public, parameter :: mwco2 = 44._r8 ! molecular weight co2 + real(r8), public, parameter :: mwn2o = 44._r8 ! molecular weight n2o + real(r8), public, parameter :: mwch4 = 16._r8 ! molecular weight ch4 + real(r8), public, parameter :: mwf11 = 136._r8 ! molecular weight cfc11 + real(r8), public, parameter :: mwf12 = 120._r8 ! molecular weight cfc12 + real(r8), public, parameter :: mwo3 = 48._r8 ! molecular weight O3 + real(r8), public, parameter :: mwso2 = 64._r8 ! molecular weight so2 + real(r8), public, parameter :: mwso4 = 96._r8 ! molecular weight so4 + real(r8), public, parameter :: mwh2o2 = 34._r8 ! molecular weight h2o2 + real(r8), public, parameter :: mwdms = 62._r8 ! molecular weight dms + real(r8), public, parameter :: mwnh4 = 18._r8 ! molecular wieght nh4 + real(r8), public, protected :: mwh2o = shr_const_mwwv ! molecular weight h2o + real(r8), public, protected :: mwdry = shr_const_mwdair ! molecular weight dry air + + ! modifiable physical constants for other planets (including aquaplanet) + real(r8), public, protected :: gravit = shr_const_g ! gravitational acceleration (m s-2) + real(r8), public, protected :: sday = shr_const_sday ! sec in sidereal day (seconds) + real(r8), public, protected :: cpwv = shr_const_cpwv ! specific heat of water vapor (J K-1 kg-1) + real(r8), public, protected :: cpair = shr_const_cpdair ! specific heat of dry air (J K-1 kg-1) + real(r8), public, protected :: rearth = shr_const_rearth ! radius of earth (m) + real(r8), public, protected :: tmelt = shr_const_tkfrz ! Freezing point of water (K) + + !----- Variables below here are derived from those above ----------------- + + real(r8), public, protected :: rga = 1._r8/shr_const_g ! reciprocal of gravit (s2 m-1) + real(r8), public, protected :: ra = 1._r8/shr_const_rearth ! reciprocal of earth radius (m-1) + real(r8), public, protected :: omega = shr_const_omega ! earth rot (rad sec-1) + real(r8), public, protected :: rh2o = shr_const_rwv ! Water vapor gas constant (J K-1 kg-1) + real(r8), public, protected :: rair = shr_const_rdair ! Dry air gas constant (J K-1 kg-1) + real(r8), public, protected :: epsilo = shr_const_mwwv/shr_const_mwdair ! ratio of h2o to dry air molecular weights + real(r8), public, protected :: zvir = shr_const_zvir ! (rh2o/rair) - 1 + real(r8), public, protected :: cpvir = shr_const_cpvir ! CPWV/CPDAIR - 1.0 + real(r8), public, protected :: rhodair = shr_const_rhodair ! density of dry air at STP (kg m-3) + real(r8), public, protected :: cappa = (shr_const_rgas/shr_const_mwdair)/shr_const_cpdair ! R/Cp + real(r8), public, protected :: ez ! Coriolis expansion coeff -> omega/sqrt(0.375) + real(r8), public, protected :: Cpd_on_Cpv = shr_const_cpdair/shr_const_cpwv + +!============================================================================== +CONTAINS +!============================================================================== + + ! Read namelist variables. + subroutine physconst_readnl(nlfile) + use namelist_utils, only: find_group_name + use spmd_utils, only: masterproc, mpicom, masterprocid + use spmd_utils, only: mpi_real8 + use cam_logfile, only: iulog + use dyn_tests_utils, only: vc_physics, vc_moist_pressure + use dyn_tests_utils, only: string_vc, vc_str_lgth + + ! Dummy argument: filepath for file containing namelist input + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + logical :: newg + logical :: newsday + logical :: newmwh2o + logical :: newcpwv + logical :: newmwdry + logical :: newcpair + logical :: newrearth + logical :: newtmelt + logical :: newomega + integer, parameter :: lsize = 76 + integer, parameter :: fsize = 23 + character(len=*), parameter :: subname = 'physconst_readnl :: ' + character(len=vc_str_lgth) :: str + character(len=lsize) :: banner + character(len=lsize) :: bline + character(len=fsize) :: field + + ! Physical constants needing to be reset + ! (e.g., for aqua planet experiments) + namelist /physconst_nl/ gravit, sday, mwh2o, cpwv, mwdry, & + cpair, rearth, tmelt, omega + !----------------------------------------------------------------------- + + banner = repeat('*', lsize) + bline = "***"//repeat(' ', lsize - 6)//"***" +2000 format("*** ",a,2(" ",E18.10)," ***") if (masterproc) then - write(iulog,*)'****************************************************************************' - write(iulog,*)'*** New Physical Constant Values set via namelist ***' - write(iulog,*)'*** ***' - write(iulog,*)'*** Physical Constant Old Value New Value ***' - if (newg) write(iulog,*)'*** GRAVIT ',shr_const_g,gravit,'***' - if (newsday) write(iulog,*)'*** SDAY ',shr_const_sday,sday,'***' - if (newmwh2o) write(iulog,*)'*** MWH20 ',shr_const_mwwv,mwh2o,'***' - if (newcpwv) write(iulog,*)'*** CPWV ',shr_const_cpwv,cpwv,'***' - if (newmwdry) write(iulog,*)'*** MWDRY ',shr_const_mwdair,mwdry,'***' - if (newcpair) write(iulog,*)'*** CPAIR ',shr_const_cpdair,cpair,'***' - if (newrearth) write(iulog,*)'*** REARTH ',shr_const_rearth,rearth,'***' - if (newtmelt) write(iulog,*)'*** TMELT ',shr_const_tkfrz,tmelt,'***' - if (newomega) write(iulog,*)'*** OMEGA ',shr_const_omega,omega,'***' - write(iulog,*)'****************************************************************************' - end if - rga = 1._r8/gravit - ra = 1._r8/rearth - if (.not. newomega) then - omega = 2.0_r8*pi/sday + open(newunit=unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'physconst_nl', status=ierr) + if (ierr == 0) then + read(unitn, physconst_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname//'ERROR reading namelist, physconst_nl') + end if + end if + close(unitn) end if - cpvir = cpwv/cpair - 1._r8 - epsilo = mwh2o/mwdry - - ! rair and rh2o have to be defined before any of the variables that use them - - rair = r_universal/mwdry - rh2o = r_universal/mwh2o - - cappa = rair/cpair - rhodair = pstd/(rair*tmelt) - zvir = (rh2o/rair)-1.0_R8 - ez = omega / sqrt(0.375_r8) - Cpd_on_Cpv = cpair/cpwv - - ! Adjust constants in shr_flux_mod. - call shr_flux_adjust_constants(zvir=zvir, cpvir=cpvir, gravit=gravit) - - else - ez = omega / sqrt(0.375_r8) - end if - ! Read variable components of dry air and water species in air - - dry_air_species = (/ (' ', i=1,num_names_max) /) - water_species_in_air = (/ (' ', i=1,num_names_max) /) - - if (masterproc) then - open( newunit=unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'air_composition_nl', status=ierr) - if (ierr == 0) then - read(unitn, air_composition_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') + ! Broadcast namelist variables + call MPI_bcast(gravit, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: gravit") + call MPI_bcast(sday, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: sday") + call MPI_bcast(mwh2o, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: mwh20") + call MPI_bcast(cpwv, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: cpwv") + call MPI_bcast(mwdry, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: mwdry") + call MPI_bcast(cpair, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: cpair") + call MPI_bcast(rearth, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: rearth") + call MPI_bcast(tmelt, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: tmelt") + call MPI_bcast(omega, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: omega") + + newg = gravit /= shr_const_g + newsday = sday /= shr_const_sday + newmwh2o = mwh2o /= shr_const_mwwv + newcpwv = cpwv /= shr_const_cpwv + newmwdry = mwdry /= shr_const_mwdair + newcpair = cpair /= shr_const_cpdair + newrearth= rearth /= shr_const_rearth + newtmelt = tmelt /= shr_const_tkfrz + newomega = omega /= shr_const_omega + + if (newg .or. newsday .or. newmwh2o .or. newcpwv .or. newmwdry .or. & + newrearth .or. newtmelt .or. newomega) then + if (masterproc) then + write(iulog, *) banner + write(iulog, *) '*** New Physical Constant Values set ', & + 'via namelist ***' + write(iulog, *) bline + write(iulog, *) '*** Physical Constant Old Value New Value ***' + if (newg) then + field = 'GRAVIT' + write(iulog, 2000) field, shr_const_g, gravit + end if + if (newsday) then + field = 'SDAY' + write(iulog, 2000) field, shr_const_sday, sday + end if + if (newmwh2o) then + field = 'MWH20' + write(iulog, 2000) field, shr_const_mwwv, mwh2o + end if + if (newcpwv) then + field = 'CPWV' + write(iulog, 2000) field, shr_const_cpwv, cpwv + end if + if (newmwdry) then + field = 'MWDRY' + write(iulog, 2000) field, shr_const_mwdair, mwdry + end if + if (newcpair) then + field = 'CPAIR' + write(iulog, 2000) field, shr_const_cpdair, cpair + end if + if (newrearth) then + field = 'REARTH' + write(iulog, 2000) field, shr_const_rearth, rearth + end if + if (newtmelt) then + field = 'TMELT' + write(iulog, 2000) field, shr_const_tkfrz, tmelt + end if + if (newomega) then + field = 'OMEGA' + write(iulog, 2000) field, shr_const_omega, omega + end if + write(iulog,*) banner end if - end if - close(unitn) - end if - - call mpi_bcast(dry_air_species, len(dry_air_species)*num_names_max, mpi_character, & - masterprocid, mpicom, ierr) - call mpi_bcast(water_species_in_air, len(water_species_in_air)*num_names_max, mpi_character, & - masterprocid, mpicom, ierr) - - dry_air_species_num = 0 - water_species_in_air_num = 0 - do i = 1, num_names_max - if (.not. LEN(TRIM(dry_air_species(i)))==0) then - dry_air_species_num = dry_air_species_num + 1 - end if - if (.not. LEN(TRIM(water_species_in_air(i)))==0) then - water_species_in_air_num = water_species_in_air_num + 1 - endif - end do - thermodynamic_active_species_num = dry_air_species_num+water_species_in_air_num + rga = 1._r8 / gravit + ra = 1._r8 / rearth + if (.not. newomega) then + omega = 2.0_r8 * pi / sday + end if + cpvir = (cpwv / cpair) - 1._r8 + epsilo = mwh2o / mwdry - if (masterproc) then + ! defined rair and rh2o before any of the variables that use them + rair = r_universal / mwdry + rh2o = r_universal / mwh2o - write(iulog,*)'****************************************************************************' - write(iulog,*)' ' + cappa = rair / cpair + rhodair = pstd / (rair * tmelt) + zvir = (rh2o / rair) - 1.0_r8 + Cpd_on_Cpv = cpair / cpwv - if (dry_air_species_num == 0) then - write(iulog,*)' Thermodynamic properties of dry air are fixed at troposphere values' - else - write(iulog,*)' Thermodynamic properties of dry air are based on variable' - write(iulog,*)' composition of the following species:' - do i = 1, dry_air_species_num - write(iulog,*)' ', trim(dry_air_species(i)) - end do - write(iulog,*) ' ' + ! Adjust constants in shr_flux_mod. + call shr_flux_adjust_constants(zvir=zvir, cpvir=cpvir, gravit=gravit) end if - write(iulog,*)' Thermodynamic properties of moist air are based on variable' - write(iulog,*)' composition of the following water species:' - do i = 1, water_species_in_air_num - write(iulog,*)' ', trim(water_species_in_air(i)) - end do - - write(iulog,*)' ' - write(iulog,*)'****************************************************************************' - - end if - -end subroutine physconst_readnl - -!=============================================================================== - -subroutine physconst_init() - - integer :: ierr - - !------------------------------------------------------------------------------- - ! Allocate constituent dependent properties - !------------------------------------------------------------------------------- - allocate( cpairv(pcols,pver,begchunk:endchunk), & - rairv(pcols,pver,begchunk:endchunk), & - cappav(pcols,pver,begchunk:endchunk), & - mbarv(pcols,pver,begchunk:endchunk), & - kmvis(pcols,pverp,begchunk:endchunk), & - kmcnd(pcols,pverp,begchunk:endchunk), stat=ierr ) - if ( ierr /= 0 ) call endrun('physconst: allocate failed in physconst_init') - - !------------------------------------------------------------------------------- - ! Initialize constituent dependent properties - !------------------------------------------------------------------------------- - cpairv(:pcols,:pver,begchunk:endchunk) = cpair - rairv(:pcols,:pver,begchunk:endchunk) = rair - cappav(:pcols,:pver,begchunk:endchunk) = rair/cpair - mbarv(:pcols,:pver,begchunk:endchunk) = mwdry - -end subroutine physconst_init - -!=============================================================================== - - subroutine composition_init() - use constituents, only: cnst_get_ind, cnst_mw - use spmd_utils, only: masterproc - use cam_logfile, only: iulog - character(len=*), parameter :: subname = 'composition_init' - real(r8) :: mw, dof1, dof2, dof3 - - integer :: icnst,ix,i - - ! standard dry air (constant composition) - o2_mwi = 1._r8/32._r8 - n2_mwi = 1._r8/28._r8 - mmro2 = 0.235_r8 - mmrn2 = 0.765_r8 - mbar = 1._r8/(mmro2*o2_mwi + mmrn2*n2_mwi) - - ! init for variable composition dry air - - i = dry_air_species_num+water_species_in_air_num - allocate(thermodynamic_active_species_idx(i)) - allocate(thermodynamic_active_species_idx_dycore(i)) - allocate(thermodynamic_active_species_cp(0:i)) - allocate(thermodynamic_active_species_cv(0:i)) - allocate(thermodynamic_active_species_R(0:i)) - - i = dry_air_species_num - allocate(thermodynamic_active_species_mwi(i)) - allocate(thermodynamic_active_species_kv(i)) - allocate(thermodynamic_active_species_kc(i)) - thermodynamic_active_species_idx = -999 - thermodynamic_active_species_idx_dycore = -999 - thermodynamic_active_species_cp = 0.0_r8 - thermodynamic_active_species_cv = 0.0_r8 - thermodynamic_active_species_R = 0.0_r8 - thermodynamic_active_species_mwi = 0.0_r8 - thermodynamic_active_species_kv = 0.0_r8 - thermodynamic_active_species_kc = 0.0_r8 - ! - ! define cp and R for species in species_name - ! - ! Last major species in namelist dry_air_species is derived from the other major species - ! (since sum of dry mixing ratios for major species of dry air add must add to one) - ! - dof1 = 3._r8 ! monatomic ideal gas cv=dof1/2 * R; cp=(1+dof1/2) * R; dof=3 translational - dof2 = 5._r8 ! diatomic ideal gas cv=dof2/2 * R; cp=(1+dof2/2) * R; dof=3 tranlational + 2 rotational - dof3 = 6._r8 ! polyatomic ideal gas cv=dof3/2 * R; cp=(1+dof3/2) * R; dof=3 tranlational + 3 rotational - ! - if (dry_air_species_num>0) then - ! - ! last major species in dry_air_species is derived from the others and constants associated with it - ! are initialized here - ! - if (TRIM(dry_air_species(dry_air_species_num))=='N2') then - call cnst_get_ind('N' ,ix, abort=.false.) - if (ix<1) then - write(iulog, *) subname//' dry air component not found: ', dry_air_species(dry_air_species_num) - call endrun(subname // ':: dry air component not found') - else - mw = 2.0_r8*cnst_mw(ix) - icnst = dry_air_species_num - thermodynamic_active_species_idx(icnst) = 1!note - this is not used since this tracer value is derived - thermodynamic_active_species_cp (icnst) = 0.5_r8*shr_const_rgas*(2._r8+dof2)/mw !N2 - thermodynamic_active_species_cv (icnst) = 0.5_r8*shr_const_rgas*dof2/mw !N2 - thermodynamic_active_species_R (icnst) = shr_const_rgas/mw - thermodynamic_active_species_mwi(icnst) = 1.0_r8/mw - thermodynamic_active_species_kv(icnst) = 3.42_r8 - thermodynamic_active_species_kc(icnst) = 56._r8 - end if - ! - ! if last major species is not N2 then add code here - ! - else - write(iulog, *) subname//' derived major species not found: ', dry_air_species(dry_air_species_num) - call endrun(subname // ':: derived major species not found') - end if - else + ez = omega / sqrt(0.375_r8) ! - ! dry air is not species dependent + ! vertical coordinate info ! - icnst = 0 - thermodynamic_active_species_cp (icnst) = cpair - thermodynamic_active_species_cv (icnst) = cpair - rair - thermodynamic_active_species_R (icnst) = rair - end if - ! - !****************************************************************************** - ! - ! add prognostic components of dry air - ! - !****************************************************************************** - ! - icnst = 1 - do i=1,dry_air_species_num-1 - select case (TRIM(dry_air_species(i))) - ! - ! O - ! - case('O') - call cnst_get_ind('O' ,ix, abort=.false.) - if (ix<1) then - write(iulog, *) subname//' dry air component not found: ', dry_air_species(i) - call endrun(subname // ':: dry air component not found') - else - mw = cnst_mw(ix) - thermodynamic_active_species_idx(icnst) = ix - thermodynamic_active_species_cp (icnst) = 0.5_r8*shr_const_rgas*(2._r8+dof1)/mw - thermodynamic_active_species_cv (icnst) = 0.5_r8*shr_const_rgas*dof1/mw - thermodynamic_active_species_R (icnst) = shr_const_rgas/mw - thermodynamic_active_species_mwi(icnst) = 1.0_r8/mw - thermodynamic_active_species_kv(icnst) = 3.9_r8 - thermodynamic_active_species_kc(icnst) = 75.9_r8 - icnst = icnst+1 - end if - ! - ! O2 - ! - case('O2') - call cnst_get_ind('O2' ,ix, abort=.false.) - if (ix<1) then - write(iulog, *) subname//' dry air component not found: ', dry_air_species(i) - call endrun(subname // ':: dry air component not found') - else - mw = cnst_mw(ix) - thermodynamic_active_species_idx(icnst) = ix - thermodynamic_active_species_cp (icnst) = 0.5_r8*shr_const_rgas*(2._r8+dof2)/mw - thermodynamic_active_species_cv (icnst) = 0.5_r8*shr_const_rgas*dof2/mw - thermodynamic_active_species_R (icnst) = shr_const_rgas/mw - thermodynamic_active_species_mwi(icnst) = 1.0_r8/mw - thermodynamic_active_species_kv(icnst) = 4.03_r8 - thermodynamic_active_species_kc(icnst) = 56._r8 - icnst = icnst+1 - end if - ! - ! H - ! - case('H') - call cnst_get_ind('H' ,ix, abort=.false.) - if (ix<1) then - write(iulog, *) subname//' dry air component not found: ', dry_air_species(i) - call endrun(subname // ':: dry air component not found') - else - mw = cnst_mw(ix) - thermodynamic_active_species_idx(icnst) = ix - thermodynamic_active_species_cp (icnst) = 0.5_r8*shr_const_rgas*(2._r8+dof1)/mw - thermodynamic_active_species_cv (icnst) = 0.5_r8*shr_const_rgas*dof1/mw - thermodynamic_active_species_R (icnst) = shr_const_rgas/mw - thermodynamic_active_species_mwi(icnst) = 1.0_r8/mw - thermodynamic_active_species_kv(icnst) = 0.0_r8 - thermodynamic_active_species_kc(icnst) = 0.0_r8 - icnst = icnst+1 - end if - ! - ! If support for more major species is to be included add code here - ! - case default - write(iulog, *) subname//' dry air component not found: ', dry_air_species(i) - call endrun(subname // ':: dry air component not found') - end select - + vc_physics = vc_moist_pressure if (masterproc) then - write(iulog, *) "Dry air composition ",TRIM(dry_air_species(i)),& - icnst-1,thermodynamic_active_species_idx(icnst-1),& - thermodynamic_active_species_mwi(icnst-1),& - thermodynamic_active_species_cp(icnst-1),& - thermodynamic_active_species_cv(icnst-1) + call string_vc(vc_physics, str) + write(iulog, *) 'vertical coordinate physics : ', trim(str) end if - end do - i = dry_air_species_num - if (i>0) then - if (masterproc) then - write(iulog, *) "Dry air composition ",TRIM(dry_air_species(i)),& - icnst,thermodynamic_active_species_idx(icnst),& - thermodynamic_active_species_mwi(icnst),& - thermodynamic_active_species_cp(icnst),& - thermodynamic_active_species_cv(icnst) - end if - end if - ! - !************************************************************************************ - ! - ! Add non-dry components of moist air (water vapor and condensates) - ! - !************************************************************************************ - ! - icnst = dry_air_species_num+1 - do i=1,water_species_in_air_num - select case (TRIM(water_species_in_air(i))) - ! - ! Q - ! - case('Q') - call cnst_get_ind('Q' ,ix, abort=.false.) - if (ix<1) then - write(iulog, *) subname//' moist air component not found: ', water_species_in_air(i) - call endrun(subname // ':: moist air component not found') - else - mw = cnst_mw(ix) - thermodynamic_active_species_idx(icnst) = ix - thermodynamic_active_species_cp (icnst) = cpwv - thermodynamic_active_species_cv (icnst) = 0.5_r8*shr_const_rgas*dof3/mw - thermodynamic_active_species_R (icnst) = rh2o - icnst = icnst+1 - end if - ! - ! CLDLIQ - ! - case('CLDLIQ') - call cnst_get_ind('CLDLIQ' ,ix, abort=.false.) - if (ix<1) then - write(iulog, *) subname//' moist air component not found: ', water_species_in_air(i) - call endrun(subname // ':: moist air component not found') - else - thermodynamic_active_species_idx(icnst) = ix - thermodynamic_active_species_cp (icnst) = cpliq - thermodynamic_active_species_cv (icnst) = cpliq - icnst = icnst+1 - end if - ! - ! CLDICE - ! - case('CLDICE') - call cnst_get_ind('CLDICE' ,ix, abort=.false.) - if (ix<1) then - write(iulog, *) subname//' moist air component not found: ', water_species_in_air(i) - call endrun(subname // ':: moist air component not found') - else - thermodynamic_active_species_idx(icnst) = ix - thermodynamic_active_species_cp (icnst) = cpice - thermodynamic_active_species_cv (icnst) = cpice - icnst = icnst+1 - end if - ! - ! RAINQM - ! - case('RAINQM') - call cnst_get_ind('RAINQM' ,ix, abort=.false.) - if (ix<1) then - write(iulog, *) subname//' moist air component not found: ', water_species_in_air(i) - call endrun(subname // ':: moist air component not found') - else - thermodynamic_active_species_idx(icnst) = ix - thermodynamic_active_species_cp (icnst) = cpliq - thermodynamic_active_species_cv (icnst) = cpliq - icnst = icnst+1 - end if - ! - ! SNOWQM - ! - case('SNOWQM') - call cnst_get_ind('SNOWQM' ,ix, abort=.false.) - if (ix<1) then - write(iulog, *) subname//' moist air component not found: ', water_species_in_air(i) - call endrun(subname // ':: moist air component not found') - else - thermodynamic_active_species_idx(icnst) = ix - thermodynamic_active_species_cp (icnst) = cpice - thermodynamic_active_species_cv (icnst) = cpice - icnst = icnst+1 - end if - ! - ! GRAUQM - ! - case('GRAUQM') - call cnst_get_ind('GRAUQM' ,ix, abort=.false.) - if (ix<1) then - write(iulog, *) subname//' moist air component not found: ', water_species_in_air(i) - call endrun(subname // ':: moist air component not found') - else - mw = cnst_mw(ix) - thermodynamic_active_species_idx(icnst) = ix - thermodynamic_active_species_cp (icnst) = cpice - thermodynamic_active_species_cv (icnst) = cpice - icnst = icnst+1 - end if - ! - ! If support for more major species is to be included add code here - ! - case default - write(iulog, *) subname//' moist air component not found: ', water_species_in_air(i) - call endrun(subname // ':: moist air component not found') - end select - ! - ! - ! - if (masterproc) then - write(iulog, *) "Thermodynamic active species ",TRIM(water_species_in_air(i)),& - icnst-1,thermodynamic_active_species_idx(icnst-1),& - thermodynamic_active_species_cp(icnst-1),& - thermodynamic_active_species_cv(icnst-1) - end if - end do - - end subroutine composition_init - ! - !**************************************************************************************************************** - ! - ! update species dependent constants for physics - ! - !**************************************************************************************************************** - ! - subroutine physconst_update(mmr, t, lchnk, ncol, to_moist_factor) - - !----------------------------------------------------------------------- - ! Update the physics "constants" that vary - !----------------------------------------------------------------------- - - !------------------------------Arguments-------------------------------------------------------------- - - real(r8), intent(in) :: mmr(pcols,pver,pcnst) ! constituents q array from state structure - real(r8), intent(in) :: t(pcols,pver) ! temperature t array from state structure - integer, intent(in) :: lchnk ! Chunk number - integer, intent(in) :: ncol ! number of columns - real(r8), optional, intent(in) :: to_moist_factor(:,:) - ! - !---------------------------Local storage------------------------------------------------------------- - real(r8):: to_moist_fact(ncol,pver) - real(r8):: sponge_factor(pver) - - to_moist_fact(:,:) = 1._r8 - - if (present(to_moist_factor)) then - to_moist_fact(:ncol,:) = to_moist_factor(:ncol,:) - end if - - !-------------------------------------------- - ! update cpairv, rairv, mbarv, and cappav - !-------------------------------------------- - call get_R_dry(1,ncol,1,1,1,pver,1,pver,pcnst, mmr(:ncol,:,:), thermodynamic_active_species_idx, & - rairv(:ncol,:,lchnk), fact=to_moist_fact(:ncol,:)) - call get_cp_dry(1,ncol,1,1,1,pver,1,pver,pcnst, mmr(:ncol,:,:), thermodynamic_active_species_idx, & - cpairv(:ncol,:,lchnk), fact=to_moist_fact(:ncol,:)) - call get_mbarv(1,ncol,1,1,1,pver,pver,pcnst, mmr(:ncol,:,:), thermodynamic_active_species_idx, & - mbarv(:ncol,:,lchnk), fact=to_moist_fact(:ncol,:)) - sponge_factor = 1.0_r8 - call get_molecular_diff_coef(1,ncol,1,1,pver,pver,t(:ncol,:),1,sponge_factor,kmvis(:ncol,:,lchnk), & - kmcnd(:ncol,:,lchnk), pcnst, tracer=mmr(:ncol,:,:), fact=to_moist_fact(:ncol,:), & - active_species_idx_dycore=thermodynamic_active_species_idx) - - end subroutine physconst_update - ! - !**************************************************************************************************************** - ! - ! update species dependent kappa for FV dycore - ! - !**************************************************************************************************************** - ! - subroutine physconst_calc_kappav( i0,i1,j0,j1,k0,k1,ntotq, tracer, kappav, cpv ) - ! assumes moist MMRs - - ! args - integer, intent(in) :: i0,i1,j0,j1,k0,k1, ntotq - real(r8), intent(in) :: tracer(i0:i1,j0:j1,k0:k1,ntotq) ! Tracer array - real(r8), intent(out) :: kappav(i0:i1,j0:j1,k0:k1) - real(r8), optional, intent(out) :: cpv(i0:i1,j0:j1,k0:k1) - - ! local vars - real(r8), dimension(i0:i1,j0:j1,k0:k1) :: rgas_var, cp_var - integer :: i,j,k - - !----------------------------------------------------------------------- - ! Calculate constituent dependent specific heat, gas constant and cappa - !----------------------------------------------------------------------- - call get_R_dry (i0,i1,j0,j1,k0,k1,k0,k1,ntotq,tracer,thermodynamic_active_species_idx,rgas_var) - call get_cp_dry(i0,i1,j0,j1,k0,k1,k0,k1,ntotq,tracer,thermodynamic_active_species_idx,cp_var) -!$omp parallel do private(i,j,k) - do k = k0,k1 - do j = j0,j1 - do i = i0,i1 - kappav(i,j,k) = rgas_var(i,j,k)/cp_var(i,j,k) - enddo - enddo - enddo - - if (present(cpv)) then - cpv(:,:,:) = cp_var(:,:,:) - endif - - end subroutine physconst_calc_kappav - ! - !**************************************************************************************************************** - ! - ! Compute pressure level thickness from dry pressure and thermodynamic active species mixing ratios - ! - ! Tracer can either be in units of dry mixing ratio (mixing_ratio=1) or "mass" (=m*dp_dry) (mixing_ratio=2) - ! - !**************************************************************************************************************** - ! - subroutine get_dp(i0,i1,j0,j1,k0,k1,ntrac,tracer,mixing_ratio,active_species_idx,dp_dry,dp,ps,ptop) - integer, intent(in) :: i0,i1,j0,j1,k0,k1,ntrac ! array bounds - real(r8), intent(in) :: tracer(i0:i1,j0:j1,k0:k1,1:ntrac) ! tracers; quantity specified by mixing_ratio arg - integer, intent(in) :: mixing_ratio ! 1 => tracer is dry mixing ratio - ! 2 => tracer is mass (q*dp) - integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array - real(r8), intent(in) :: dp_dry(i0:i1,j0:j1,k0:k1) ! dry pressure level thickness - real(r8), intent(out) :: dp(i0:i1,j0:j1,k0:k1) ! pressure level thickness - real(r8), optional,intent(out) :: ps(i0:i1,j0:j1) ! surface pressure (if ps present then ptop - ! must be present) - real(r8), optional,intent(in) :: ptop ! pressure at model top - - integer :: i,j,k,m_cnst,nq - - dp = dp_dry - if (mixing_ratio==1) then - do nq=dry_air_species_num+1,thermodynamic_active_species_num - m_cnst = active_species_idx(nq) - do k=k0,k1 - do j=j0,j1 - do i = i0,i1 - dp(i,j,k) = dp(i,j,k) + dp_dry(i,j,k)*tracer(i,j,k,m_cnst) - end do - end do - end do - end do - else - do nq=dry_air_species_num+1,thermodynamic_active_species_num - m_cnst = active_species_idx(nq) - do k=k0,k1 - do j=j0,j1 - do i = i0,i1 - dp(i,j,k) = dp(i,j,k) + tracer(i,j,k,m_cnst) - end do - end do - end do - end do - end if - if (present(ps)) then - if (present(ptop)) then - ps = ptop - do k=k0,k1 - do j=j0,j1 - do i = i0,i1 - ps(i,j) = ps(i,j)+dp(i,j,k) - end do - end do - end do - else - call endrun('get_dp: if ps is present ptop must be present') - end if - end if - end subroutine get_dp - ! - !************************************************************************************************************************* - ! - ! compute mid-level (full level) pressure from dry pressure and water tracers - ! - !************************************************************************************************************************* - ! - subroutine get_pmid_from_dpdry(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx, & - dp_dry, ptop, pmid, pint, dp) - - integer, intent(in) :: i0,i1,j0,j1,nlev,ntrac ! array bounds - real(r8), intent(in) :: tracer(i0:i1,j0:j1,nlev,1:ntrac) ! tracers; quantity specified by mixing_ratio arg - integer, intent(in) :: mixing_ratio ! 1 => tracer is mixing ratio - ! 2 => tracer is mass (q*dp) - integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array - real(r8), intent(in) :: dp_dry(i0:i1,j0:j1,nlev) ! dry pressure level thickness - real(r8), intent(in) :: ptop ! model top pressure - real(r8), intent(out) :: pmid(i0:i1,j0:j1,nlev) ! mid-level pressure - real(r8), optional, intent(out) :: pint(i0:i1,j0:j1,nlev+1) ! half-level pressure - real(r8), optional, intent(out) :: dp(i0:i1,j0:j1,nlev) ! presure level thickness - - real(r8) :: dp_local(i0:i1,j0:j1,nlev) ! local pressure level thickness - real(r8) :: pint_local(i0:i1,j0:j1,nlev+1) ! local interface pressure - integer :: k - - call get_dp(i0,i1,j0,j1,1,nlev,ntrac,tracer,mixing_ratio,active_species_idx,dp_dry,dp_local) - pint_local(:,:,1) = ptop - do k=2,nlev+1 - pint_local(:,:,k) = dp_local(:,:,k-1)+pint_local(:,:,k-1) - end do - - call get_pmid_from_dp(i0,i1,j0,j1,1,nlev,dp_local,ptop,pmid,pint_local) - - if (present(pint)) pint=pint_local - if (present(dp)) dp=dp_local - end subroutine get_pmid_from_dpdry - ! - !************************************************************************************************************************* - ! - ! compute mid-level (full level) pressure - ! - !************************************************************************************************************************* - ! - subroutine get_pmid_from_dp(i0,i1,j0,j1,k0,k1,dp,ptop,pmid,pint) - use dycore, only: dycore_is - integer, intent(in) :: i0,i1,j0,j1,k0,k1 ! array bounds - real(r8), intent(in) :: dp(i0:i1,j0:j1,k0:k1) ! dry pressure level thickness - real(r8), intent(in) :: ptop ! pressure at model top - real(r8), intent(out) :: pmid(i0:i1,j0:j1,k0:k1) ! mid (full) level pressure - real(r8), optional, intent(out) :: pint(i0:i1,j0:j1,k0:k1+1) ! pressure at interfaces (half levels) - - real(r8) :: pint_local(i0:i1,j0:j1,k0:k1+1) - integer :: k - - pint_local(:,:,k0) = ptop - do k=k0+1,k1+1 - pint_local(:,:,k) = dp(:,:,k-1)+pint_local(:,:,k-1) - end do - - if (dycore_is ('LR').or.dycore_is ('SE')) then - do k=k0,k1 - pmid(:,:,k) = dp(:,:,k)/(log(pint_local(:,:,k+1))-log(pint_local(:,:,k))) - end do - else - do k=k0,k1 - pmid(:,:,k) = 0.5_r8*(pint_local(:,:,k)+pint_local(:,:,k+1)) - end do - end if - if (present(pint)) pint=pint_local - end subroutine get_pmid_from_dp - ! - !**************************************************************************************************************** - ! - ! Compute Exner pressure - ! - !**************************************************************************************************************** - ! - subroutine get_exner(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx,& - dp_dry,ptop,p00,inv_exner,exner,poverp0) - integer, intent(in) :: i0,i1,j0,j1,nlev,ntrac ! index bounds - real(r8), intent(in) :: tracer(i0:i1,j0:j1,nlev,1:ntrac) ! tracers; quantity specified by mixing_ratio arg - integer, intent(in) :: mixing_ratio ! 1 => tracer is mixing ratio - ! 2 => tracer is mass (q*dp) - integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array - real(r8), intent(in) :: dp_dry(i0:i1,j0:j1,nlev) ! dry pressure level thickness - real(r8), intent(in) :: ptop ! pressure at model top - real(r8), intent(in) :: p00 ! reference pressure for Exner pressure (usually 1000hPa) - logical , intent(in) :: inv_exner ! logical for outputting inverse Exner or Exner pressure - real(r8), intent(out) :: exner(i0:i1,j0:j1,nlev) - real(r8), optional, intent(out) :: poverp0(i0:i1,j0:j1,nlev)! for efficiency when a routine needs this variable - - real(r8) :: pmid(i0:i1,j0:j1,nlev),kappa_dry(i0:i1,j0:j1,nlev) - ! - ! compute mid level pressure - ! - call get_pmid_from_dpdry(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx,dp_dry,ptop,pmid) - ! - ! compute kappa = Rd/cpd - ! - if (mixing_ratio==1) then - call get_kappa_dry(i0,i1,j0,j1,1,nlev,nlev,ntrac,tracer,active_species_idx,kappa_dry) - else - call get_kappa_dry(i0,i1,j0,j1,1,nlev,nlev,ntrac,tracer,active_species_idx,kappa_dry,1.0_r8/dp_dry) - end if - if (inv_exner) then - exner(:,:,:) = (p00/pmid(:,:,:))**kappa_dry(:,:,:) - else - exner(:,:,:) = (pmid(:,:,:)/p00)**kappa_dry(:,:,:) - end if - if (present(poverp0)) poverp0=pmid(:,:,:)/p00 - end subroutine get_exner - ! - !**************************************************************************************************************** - ! - ! Compute virtual potential temperature from dp_dry, m, T and ptop. - ! - !**************************************************************************************************************** - ! - subroutine get_virtual_theta(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx, & - dp_dry,ptop,p00,temp,theta_v) - integer, intent(in) :: i0,i1,j0,j1,nlev,ntrac - real(r8), intent(in) :: tracer(i0:i1,j0:j1,nlev,1:ntrac) ! tracers; quantity specified by mixing_ratio arg - integer, intent(in) :: mixing_ratio ! 1 => tracer is dry mixing ratio - ! 2 => tracer is mass (q*dp) - integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array - real(r8), intent(in) :: dp_dry(i0:i1,j0:j1,nlev) ! dry pressure level thickness - real(r8), intent(in) :: ptop ! pressure at model top - real(r8), intent(in) :: p00 ! reference pressure for Exner pressure (usually 1000hPa) - real(r8), intent(in) :: temp(i0:i1,j0:j1,nlev) ! temperature - real(r8), intent(out) :: theta_v(i0:i1,j0:j1,nlev) ! virtual potential temperature - - real(r8) :: iexner(i0:i1,j0:j1,nlev) - - call get_exner(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx, & - dp_dry,ptop,p00,.true.,iexner) - - theta_v(:,:,:) = temp(:,:,:)*iexner(:,:,:) - - end subroutine get_virtual_theta - ! - !**************************************************************************************************************** - ! - ! Compute geopotential from dry pressure level thichkness, water tracers, model top pressure and temperature - ! - !**************************************************************************************************************** - ! - subroutine get_gz(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx, & - dp_dry,ptop,temp,phis,gz,pmid,dp,T_v) - integer, intent(in) :: i0,i1,j0,j1,nlev,ntrac ! array bounds - real(r8), intent(in) :: tracer(i0:i1,j0:j1,nlev,1:ntrac) ! tracer; quantity specified by mixing_ratio arg - integer, intent(in) :: mixing_ratio ! 1 => tracer is dry mixing ratio - ! 2 => tracer is mass (q*dp) - integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array - real(r8), intent(in) :: dp_dry(i0:i1,j0:j1,nlev) ! dry pressure level thickness - real(r8), intent(in) :: ptop ! pressure at model top - real(r8), intent(in) :: temp(i0:i1,j0:j1,nlev) ! temperature - real(r8), intent(in) :: phis(i0:i1,j0:j1) ! surface geopotential - real(r8), intent(out) :: gz(i0:i1,j0:j1,nlev) ! geopotential - real(r8), optional, intent(out) :: pmid(i0:i1,j0:j1,nlev) ! mid-level pressure - real(r8), optional, intent(out) :: dp(i0:i1,j0:j1,nlev) ! pressure level thickness - real(r8), optional, intent(out) :: t_v(i0:i1,j0:j1,nlev) ! virtual temperature - - - real(r8), dimension(i0:i1,j0:j1,nlev) :: pmid_local, t_v_local, dp_local, R_dry - real(r8), dimension(i0:i1,j0:j1,nlev+1) :: pint - - call get_pmid_from_dpdry(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx, & - dp_dry,ptop,pmid_local,pint=pint,dp=dp_local) - if (mixing_ratio==1) then - call get_virtual_temp(i0,i1,j0,j1,1,nlev,ntrac,tracer,t_v_local,temp=temp,& - active_species_idx_dycore=active_species_idx) - call get_R_dry(i0,i1,j0,j1,1,nlev,1,nlev,ntrac,tracer,active_species_idx,R_dry) - else - call get_virtual_temp(i0,i1,j0,j1,1,nlev,ntrac,tracer,t_v_local,temp=temp,dp_dry=dp_dry,& - active_species_idx_dycore=active_species_idx) - call get_R_dry(i0,i1,j0,j1,1,nlev,1,nlev,ntrac,tracer,active_species_idx, & - R_dry,fact=1.0_r8/dp_dry) - end if - call get_gz_given_dp_Tv_Rdry(i0,i1,j0,j1,nlev,dp_local,T_v_local,R_dry,phis,ptop,gz,pmid_local) - - if (present(pmid)) pmid=pmid_local - if (present(T_v)) T_v=T_v_local - if (present(dp)) dp=dp_local - end subroutine get_gz - ! - !**************************************************************************************************************** - ! - ! Compute geopotential from pressure level thickness and virtual temperature - ! - !**************************************************************************************************************** - ! - subroutine get_gz_given_dp_Tv_Rdry(i0,i1,j0,j1,nlev,dp,T_v,R_dry,phis,ptop,gz,pmid) - use dycore, only: dycore_is - integer, intent(in) :: i0,i1,j0,j1,nlev ! array bounds - real(r8), intent(in) :: dp (i0:i1,j0:j1,nlev) ! pressure level thickness - real(r8), intent(in) :: T_v (i0:i1,j0:j1,nlev) ! virtual temperature - real(r8), intent(in) :: R_dry(i0:i1,j0:j1,nlev) ! R dry - real(r8), intent(in) :: phis (i0:i1,j0:j1) ! surface geopotential - real(r8), intent(in) :: ptop ! model top presure - real(r8), intent(out) :: gz(i0:i1,j0:j1,nlev) ! geopotential - real(r8), optional, intent(out) :: pmid(i0:i1,j0:j1,nlev) ! mid-level pressure - - - real(r8), dimension(i0:i1,j0:j1,nlev) :: pmid_local - real(r8), dimension(i0:i1,j0:j1,nlev+1) :: pint - real(r8), dimension(i0:i1,j0:j1) :: gzh, Rdry_tv - integer :: k - - call get_pmid_from_dp(i0,i1,j0,j1,1,nlev,dp,ptop,pmid_local,pint) - - ! - ! integrate hydrostatic eqn - ! - gzh = phis - if (dycore_is ('LR').or.dycore_is ('SE')) then - do k=nlev,1,-1 - Rdry_tv(:,:) = R_dry(:,:,k)*T_v(:,:,k) - gz(:,:,k) = gzh(:,:)+Rdry_tv(:,:)*(1.0_r8-pint(:,:,k)/pmid_local(:,:,k)) - gzh(:,:) = gzh(:,:) + Rdry_tv(:,:)*(log(pint(:,:,k+1))-log(pint(:,:,k))) - end do - else - do k=nlev,1,-1 - Rdry_tv(:,:) = R_dry(:,:,k)*T_v(:,:,k) - gz(:,:,k) = gzh(:,:)+Rdry_tv(:,:)*0.5_r8*dp(:,:,k)/pmid_local(:,:,k) - gzh(:,:) = gzh(:,:) + Rdry_tv(:,:)*dp(:,:,k)/pmid_local(:,:,k) - end do - end if - if (present(pmid)) pmid=pmid_local - end subroutine get_gz_given_dp_Tv_Rdry - ! - !**************************************************************************************************************** - ! - ! Compute Richardson number at cell interfaces (half levels) - ! - !**************************************************************************************************************** - ! - subroutine get_Richardson_number(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx,& - dp_dry,ptop,p00,temp,v,Richardson_number,pmid,dp) - integer, intent(in) :: i0,i1,j0,j1,nlev,ntrac - real(r8), intent(in) :: tracer(i0:i1,j0:j1,nlev,1:ntrac) ! tracer; quantity specified by mixing_ratio arg - integer, intent(in) :: mixing_ratio ! 1 => tracer is dry mixing ratio - ! 2 => tracer is mass (q*dp) - integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array - real(r8), intent(in) :: dp_dry(i0:i1,j0:j1,nlev) ! dry pressure level thickness - real(r8), intent(in) :: ptop ! pressure at model top - real(r8), intent(in) :: p00 ! reference pressure for Exner pressure (usually 1000hPa) - real(r8), intent(in) :: temp(i0:i1,j0:j1,nlev) ! temperature - real(r8), intent(in) :: v(i0:i1,j0:j1,2,nlev) ! velocity components - real(r8), intent(out) :: Richardson_number(i0:i1,j0:j1,nlev+1)! - real(r8), optional, intent(out) :: pmid(i0:i1,j0:j1,nlev) ! - real(r8), optional, intent(out) :: dp(i0:i1,j0:j1,nlev) ! - - real(r8), dimension(i0:i1,j0:j1,nlev):: gz,theta_v - real(r8), dimension(i0:i1,j0:j1) :: pt1, pt2, phis - integer :: k,km1 - real(r8), parameter:: ustar2 = 1.E-4_r8 - - phis = 0.0_r8 - if (present(pmid).and.present(dp)) then - call get_gz(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx, & - dp_dry,ptop,temp,phis,gz,pmid=pmid,dp=dp) - else if (present(pmid)) then - call get_gz(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx, & - dp_dry,ptop,temp,phis,gz,pmid=pmid) - else if (present(dp)) then - call get_gz(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx, & - dp_dry,ptop,temp,phis,gz,dp=dp) - else - call get_gz(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx, & - dp_dry,ptop,temp,phis,gz) - end if - call get_virtual_theta(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx, & - dp_dry,ptop,p00,temp,theta_v) - Richardson_number(:,:,1) = 0.0_r8 - Richardson_number(:,:,nlev+1) = 0.0_r8 - do k=nlev-1,2,-1 - km1=k-1 - pt1(:,:) = theta_v(:,:,km1) - pt2(:,:) = theta_v(:,:,k) - Richardson_number(:,:,k) = (gz(:,:,km1)-gz(:,:,k))*(pt1-pt2)/( 0.5_r8*(pt1+pt2)* & - ((v(:,:,1,km1)-v(:,:,1,k))**2+(v(:,:,2,km1)-v(:,:,2,k))**2+ustar2) ) - end do - end subroutine get_Richardson_number - - subroutine get_hydrostatic_static_energy(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx,& - dp_dry,ptop,temp,phis,v,KE,thermalE,gz) - integer, intent(in) :: i0,i1,j0,j1,nlev,ntrac - real(r8), intent(in) :: tracer(i0:i1,j0:j1,nlev,1:ntrac) ! tracer; quantity specified by mixing_ratio arg - integer, intent(in) :: mixing_ratio ! 1 => tracer is dry mixing ratio - ! 2 => tracer is mass (q*dp) - integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array - real(r8), intent(in) :: dp_dry(i0:i1,j0:j1,nlev) ! dry pressure level thickness - real(r8), intent(in) :: ptop ! pressure at model top - real(r8), intent(in) :: phis(i0:i1,j0:j1) ! surface geopotential - real(r8), intent(in) :: temp(i0:i1,j0:j1,nlev) ! temperature - real(r8), intent(in) :: v(i0:i1,j0:j1,2,nlev) ! velocity components - - real(r8), intent(out) :: KE(i0:i1,j0:j1,nlev),thermalE(i0:i1,j0:j1,nlev),gz(i0:i1,j0:j1,nlev) - - real(r8), dimension(i0:i1,j0:j1,nlev):: T_v,cp_dry - - call get_gz(i0,i1,j0,j1,nlev,ntrac,tracer,mixing_ratio,active_species_idx, & - dp_dry,ptop,temp,phis,gz,T_v=T_v) - if (mixing_ratio==1) then - call get_cp_dry(i0,i1,j0,j1,1,nlev,1,nlev,ntrac,tracer,active_species_idx,cp_dry) - else - call get_cp_dry(i0,i1,j0,j1,1,nlev,1,nlev,ntrac,tracer,active_species_idx,cp_dry, & - fact=1.0_r8/dp_dry) - end if - - thermalE(:,:,:) = cp_dry(:,:,:)*T_v(:,:,:) - KE(:,:,:) = 0.5_r8*(v(:,:,2,:)**2+v(:,:,1,:)**2) - end subroutine get_hydrostatic_static_energy - ! - !**************************************************************************************************************** - ! - ! get pressure from dry pressure and thermodynamic active species (e.g., forms of water: water vapor, cldliq, etc.) - ! - !**************************************************************************************************************** - ! - subroutine get_ps(i0,i1,j0,j1,k0,k1,ntrac,tracer_mass,active_species_idx,dp_dry,ps,ptop) - integer, intent(in) :: i0,i1,j0,j1,k0,k1,ntrac - real(r8), intent(in) :: tracer_mass(i0:i1,j0:j1,k0:k1,1:ntrac) ! Tracer array - real(r8), intent(in) :: dp_dry(i0:i1,j0:j1,k0:k1) ! dry pressure level thickness - real(r8), intent(out) :: ps(i0:i1,j0:j1) ! surface pressure - real(r8), intent(in) :: ptop - integer, intent(in) :: active_species_idx(:) - - integer :: i,j,k,m_cnst,nq - real(r8) :: dp(i0:i1,j0:j1,k0:k1) ! dry pressure level thickness - - dp = dp_dry - do nq=dry_air_species_num+1,thermodynamic_active_species_num - m_cnst = active_species_idx(nq) - do k=k0,k1 - do j=j0,j1 - do i = i0,i1 - dp(i,j,k) = dp(i,j,k) + tracer_mass(i,j,k,m_cnst) - end do - end do - end do - end do - ps = ptop - do k=k0,k1 - do j=j0,j1 - do i = i0,i1 - ps(i,j) = ps(i,j)+dp(i,j,k) - end do - end do - end do - end subroutine get_ps - ! - !**************************************************************************************************************** - ! - ! Compute dry air heaet capacity under constant pressure - ! - !**************************************************************************************************************** - ! - subroutine get_cp_dry(i0,i1,j0,j1,k0,k1,k0_trac,k1_trac,ntrac,tracer,active_species_idx,cp_dry,fact) - integer, intent(in) :: i0,i1,j0,j1,k0,k1,ntrac,k0_trac,k1_trac - real(r8), intent(in) :: tracer(i0:i1,j0:j1,k0_trac:k1_trac,1:ntrac) ! Tracer array - integer, intent(in) :: active_species_idx(:) - real(r8), optional, intent(in) :: fact(i0:i1,j0:j1,k0_trac:k1_trac) ! dry pressure level thickness - real(r8), intent(out) :: cp_dry(i0:i1,j0:j1,k0:k1) ! dry pressure level thickness - - integer :: i,j,k,m_cnst,nq - real(r8) :: factor(i0:i1,j0:j1,k0_trac:k1_trac) ! dry pressure level thickness - real(r8) :: residual(i0:i1,j0:j1,k0:k1), mm - ! - ! dry air not species dependent - ! - if (dry_air_species_num==0) then - cp_dry = cpair - else - if (present(fact)) then - factor = fact(:,:,:) - else - factor = 1.0_r8 - endif - - cp_dry = 0.0_r8 - residual = 1.0_r8 - do nq=1,dry_air_species_num-1 - m_cnst = active_species_idx(nq) - do k=k0,k1 - do j=j0,j1 - do i = i0,i1 - mm = tracer(i,j,k,m_cnst)*factor(i,j,k) - cp_dry(i,j,k) = cp_dry(i,j,k)+thermodynamic_active_species_cp(nq)*mm - residual(i,j,k) = residual(i,j,k) - mm - end do - end do - end do - end do - nq = dry_air_species_num - do k=k0,k1 - do j=j0,j1 - do i = i0,i1 - cp_dry(i,j,k) = cp_dry(i,j,k)+thermodynamic_active_species_cp(nq)*residual(i,j,k) - end do - end do - end do - end if - end subroutine get_cp_dry - ! - !**************************************************************************************************************** - ! - ! Compute generalized dry air gas constant R - ! - !**************************************************************************************************************** - ! - subroutine get_R_dry(i0,i1,j0,j1,k0,k1,k0_trac,k1_trac,ntrac,tracer,active_species_idx_dycore,R_dry,fact) - integer, intent(in) :: i0,i1,j0,j1,k0,k1,ntrac,k0_trac,k1_trac !array boundas - real(r8), intent(in) :: tracer(i0:i1,j0:j1,k0_trac:k1_trac,1:ntrac)!tracer array - integer, intent(in) :: active_species_idx_dycore(:) !index of active species in tracer - real(r8), intent(out) :: R_dry(i0:i1,j0:j1,k0:k1) !dry air R - real(r8), optional, intent(in) :: fact(i0:i1,j0:j1,k0_trac:k1_trac) !factor for converting tracer to dry mixing ratio - - integer :: i,j,k,m_cnst,nq - real(r8):: factor(i0:i1,j0:j1,k0_trac:k1_trac), residual(i0:i1,j0:j1,k0:k1), mm - if (dry_air_species_num==0) then - ! - ! dry air not species dependent - ! - R_dry = rair - else - if (present(fact)) then - factor = fact(:,:,:) - else - factor = 1.0_r8 - endif - - R_dry = 0.0_r8 - residual = 1.0_r8 - do nq=1,dry_air_species_num-1 - m_cnst = active_species_idx_dycore(nq) - do k=k0,k1 - do j=j0,j1 - do i = i0,i1 - mm = tracer(i,j,k,m_cnst)*factor(i,j,k) - R_dry(i,j,k) = R_dry(i,j,k)+thermodynamic_active_species_R(nq)*mm - residual(i,j,k) = residual(i,j,k) - mm - end do - end do - end do - end do - ! - ! last dry air constituent derived from the others - ! - nq = dry_air_species_num - do k=k0,k1 - do j=j0,j1 - do i = i0,i1 - R_dry(i,j,k) = R_dry(i,j,k)+thermodynamic_active_species_R(nq)*residual(i,j,k) - end do - end do - end do - end if - end subroutine get_R_dry - ! - !************************************************************************************************************************* - ! - ! Compute generalized R - ! - !************************************************************************************************************************* - ! - subroutine get_R(i0,i1,j0,j1,k0,k1,k0_trac,k1_trac,ntrac,tracer,active_species_idx,R,fact) - integer, intent(in) :: i0,i1,j0,j1,k0,k1,ntrac,k0_trac,k1_trac - real(r8), intent(in) :: tracer(i0:i1,j0:j1,k0_trac:k1_trac,1:ntrac)!tracer array - integer, intent(in) :: active_species_idx(:) !index of active species in tracer - real(r8), intent(out) :: R(i0:i1,j0:j1,k0:k1) !generalized gas constant - real(r8), optional, intent(in) :: fact(i0:i1,j0:j1,k0_trac:k1_trac) !factor for converting tracer to dry mixing ratio - - integer :: nq,itrac - real(r8):: factor(i0:i1,j0:j1,k0_trac:k1_trac) - real(r8), dimension(i0:i1,j0:j1,k0:k1) :: sum_species - integer, dimension(thermodynamic_active_species_num):: idx_local - if (present(fact)) then - call get_R_dry(i0,i1,j0,j1,k0,k1,k0_trac,k1_trac,ntrac,tracer,active_species_idx,R,fact=fact) - factor = fact(:,:,:) - else - call get_R_dry(i0,i1,j0,j1,k0,k1,k0_trac,k1_trac,ntrac,tracer,active_species_idx,R) - factor = 1.0_r8 - end if - idx_local = active_species_idx - sum_species = 1.0_r8 !all dry air species sum to 1 - do nq=dry_air_species_num+1,thermodynamic_active_species_num - itrac = idx_local(nq) - sum_species(:,:,:) = sum_species(:,:,:) + tracer(:,:,:,itrac)*factor(:,:,:) - end do - do nq=dry_air_species_num+1,thermodynamic_active_species_num - itrac = idx_local(nq) - R(:,:,:) = R(:,:,:)+thermodynamic_active_species_R(nq)*tracer(:,:,:,itrac)*factor(:,:,:) - end do - R=R/sum_species - end subroutine get_R - ! - !************************************************************************************************************************* - ! - ! compute molecular weight dry air - ! - !************************************************************************************************************************* - ! - subroutine get_mbarv(i0,i1,j0,j1,k0,k1,nlev,ntrac,tracer,active_species_idx,mbarv,fact) - integer, intent(in) :: i0,i1,j0,j1,k0,k1,ntrac, nlev - real(r8), intent(in) :: tracer(i0:i1,j0:j1,nlev,1:ntrac) !tracer array - integer, intent(in) :: active_species_idx(:) !index of active species in tracer - real(r8), intent(out) :: mbarv(i0:i1,j0:j1,k0:k1) !molecular weight of dry air - real(r8), optional, intent(in) :: fact(i0:i1,j0:j1,nlev) !factor for converting tracer to dry mixing ratio - - integer :: i,j,k,m_cnst,nq - real(r8):: factor(i0:i1,j0:j1,k0:k1), residual(i0:i1,j0:j1,k0:k1), mm - ! - ! dry air not species dependent - ! - if (dry_air_species_num==0) then - mbarv = mwdry - else - if (present(fact)) then - factor = fact(:,:,:) - else - factor = 1.0_r8 - endif - - mbarv = 0.0_r8 - residual = 1.0_r8 - do nq=1,dry_air_species_num-1 - m_cnst = active_species_idx(nq) - do k=k0,k1 - do j=j0,j1 - do i = i0,i1 - mm = tracer(i,j,k,m_cnst)*factor(i,j,k) - mbarv(i,j,k) = mbarv(i,j,k)+thermodynamic_active_species_mwi(nq)*mm - residual(i,j,k) = residual(i,j,k) - mm - end do - end do - end do - end do - nq = dry_air_species_num - do k=k0,k1 - do j=j0,j1 - do i = i0,i1 - mbarv(i,j,k) = mbarv(i,j,k)+thermodynamic_active_species_mwi(nq)*residual(i,j,k) - end do - end do - end do - mbarv(i0:i1,j0:j1,k0:k1) = 1.0_r8/mbarv(i0:i1,j0:j1,k0:k1) - end if - end subroutine get_mbarv - ! - !************************************************************************************************************************* - ! - ! compute generalized kappa =Rdry/cpdry - ! - !************************************************************************************************************************* - ! - subroutine get_kappa_dry(i0,i1,j0,j1,k0,k1,nlev,ntrac,tracer,active_species_idx,kappa_dry,fact) - integer, intent(in) :: i0,i1,j0,j1,k0,k1,ntrac,nlev - real(r8), intent(in) :: tracer(i0:i1,j0:j1,nlev,1:ntrac) !tracer array - integer, intent(in) :: active_species_idx(:) !index of thermodynamic active tracers - real(r8), intent(out) :: kappa_dry(i0:i1,j0:j1,k0:k1) !kappa dry - real(r8), optional, intent(in) :: fact(i0:i1,j0:j1,nlev) !factor for converting tracer to dry mixing ratio - ! - real(r8), allocatable, dimension(:,:,:) :: cp_dry,R_dry - ! - ! dry air not species dependent - if (dry_air_species_num==0) then - kappa_dry= rair/cpair - else - allocate(R_dry(i0:i1,j0:j1,k0:k1)) - allocate(cp_dry(i0:i1,j0:j1,k0:k1)) - if (present(fact)) then - call get_cp_dry(i0,i1,j0,j1,k0,k1,1,nlev,ntrac,tracer,active_species_idx,cp_dry,fact=fact) - call get_R_dry(i0,i1,j0,j1,k0,k1,1,nlev,ntrac,tracer,active_species_idx,R_dry,fact=fact) - else - call get_cp_dry(i0,i1,j0,j1,k0,k1,1,nlev,ntrac,tracer,active_species_idx,cp_dry) - call get_R_dry(i0,i1,j0,j1,k0,k1,1,nlev,ntrac,tracer,active_species_idx,R_dry) - end if - kappa_dry = R_dry/cp_dry - deallocate(R_dry,cp_dry) - end if - end subroutine get_kappa_dry - ! - !**************************************************************************************************************** - ! - ! Compute sum of thermodynamically active species - ! - ! tracer is in units of dry mixing ratio unless optional argument dp_dry is present in which case tracer is - ! in units of "mass" (=m*dp) - ! - !**************************************************************************************************************** - ! - subroutine get_sum_species(i0,i1,j0,j1,k0,k1,ntrac,tracer,active_species_idx,sum_species,dp_dry) - integer, intent(in) :: i0,i1,j0,j1,k0,k1,ntrac - real(r8), intent(in) :: tracer(i0:i1,j0:j1,k0:k1,1:ntrac) ! tracer array - integer, intent(in) :: active_species_idx(:) ! index for thermodynamic active tracers - real(r8), optional, intent(in) :: dp_dry(i0:i1,j0:j1,k0:k1) ! dry pressure level thickness is present - ! then tracer is in units of mass - real(r8), intent(out) :: sum_species(i0:i1,j0:j1,k0:k1) ! sum species - - real(r8) :: factor(i0:i1,j0:j1,k0:k1) - integer :: nq,itrac - - if (present(dp_dry)) then - factor = 1.0_r8/dp_dry(:,:,:) - else - factor = 1.0_r8 - endif - sum_species = 1.0_r8 !all dry air species sum to 1 - do nq=dry_air_species_num+1,thermodynamic_active_species_num - itrac = active_species_idx(nq) - sum_species(:,:,:) = sum_species(:,:,:) + tracer(:,:,:,itrac)*factor(:,:,:) - end do - end subroutine get_sum_species - ! - !**************************************************************************************************************** - ! - ! g*compute thermal energy = cp*T*dp, where dp is pressure level thickness, cp is generalized cp and T temperature - ! - ! Note:tracer is in units of m*dp_dry ("mass") - ! - !**************************************************************************************************************** - ! - subroutine get_thermal_energy(i0,i1,j0,j1,k0,k1,ntrac,tracer_mass,temp,dp_dry,thermal_energy, & - active_species_idx_dycore) - integer, intent(in) :: i0,i1,j0,j1,k0,k1,ntrac - real(r8), intent(in) :: tracer_mass(i0:i1,j0:j1,k0:k1,ntrac)!tracer array (mass weighted) - real(r8), intent(in) :: temp(i0:i1,j0:j1,k0:k1) !temperature - real(r8), intent(in) :: dp_dry(i0:i1,j0:j1,k0:k1) !dry presure level thickness - real(r8), optional, intent(out):: thermal_energy(i0:i1,j0:j1,k0:k1) !thermal energy in each column: sum cp*T*dp - ! - ! array of indicies for index of thermodynamic active species in dycore tracer array - ! (if different from physics index) - ! - integer, optional, dimension(:) :: active_species_idx_dycore - - ! local vars - integer :: nq, itrac - integer, dimension(thermodynamic_active_species_num) :: idx_local - ! - ! some sanity checks - ! - if (present(active_species_idx_dycore)) then - idx_local = active_species_idx_dycore - else - idx_local = thermodynamic_active_species_idx - end if - ! - ! "mass-weighted" cp (dp must be dry) - ! - if (dry_air_species_num==0) then - thermal_energy(:,:,:) = thermodynamic_active_species_cp(0)*dp_dry(:,:,:) - else - call get_cp_dry(i0,i1,j0,j1,k0,k1,k0,k1,ntrac,tracer_mass,idx_local,thermal_energy,fact=1.0_r8/dp_dry(:,:,:)) - thermal_energy(:,:,:) = thermal_energy(:,:,:)*dp_dry(:,:,:) - end if - ! - ! tracer is in units of m*dp ("mass"), where m is dry mixing ratio and dry pressure level thickness - ! - do nq=dry_air_species_num+1,thermodynamic_active_species_num - itrac = idx_local(nq) - thermal_energy(:,:,:) = thermal_energy(:,:,:)+thermodynamic_active_species_cp(nq)*tracer_mass(:,:,:,itrac) - end do - thermal_energy(:,:,:) = thermal_energy(:,:,:)*temp(:,:,:) - end subroutine get_thermal_energy - ! - !**************************************************************************************************************** - ! - ! Compute virtual temperature T_v - ! - ! tracer is in units of dry mixing ratio unless optional argument dp_dry is present in which case tracer is - ! in units of "mass" (=m*dp) - ! - ! If temperature is not supplied then just return factor that T needs to be multiplied by to get T_v - ! - !**************************************************************************************************************** - ! - subroutine get_virtual_temp(i0,i1,j0,j1,k0,k1,ntrac,tracer,T_v,temp,dp_dry,sum_q, & - active_species_idx_dycore) - use cam_logfile, only: iulog - ! args - integer, intent(in) :: i0,i1,j0,j1,k0,k1,ntrac - real(r8), intent(in) :: tracer(i0:i1,j0:j1,k0:k1,ntrac) !tracer array - real(r8), intent(out) :: T_v(i0:i1,j0:j1,k0:k1) !virtual temperature - real(r8), optional, intent(in) :: temp(i0:i1,j0:j1,k0:k1) !temperature - real(r8), optional, intent(in) :: dp_dry(i0:i1,j0:j1,k0:k1) !dry pressure level thickness - real(r8), optional,intent(out) :: sum_q(i0:i1,j0:j1,k0:k1) !sum tracer - ! - ! array of indicies for index of thermodynamic active species in dycore tracer array - ! (if different from physics index) - ! - integer, optional, intent(in) :: active_species_idx_dycore(:) - - ! local vars - integer :: itrac,nq - real(r8), dimension(i0:i1,j0:j1,k0:k1) :: sum_species, factor, Rd - integer, dimension(thermodynamic_active_species_num) :: idx_local,idx - - if (present(active_species_idx_dycore)) then - idx_local = active_species_idx_dycore - else - idx_local = thermodynamic_active_species_idx - end if - - if (present(dp_dry)) then - factor = 1.0_r8/dp_dry - else - factor = 1.0_r8 - end if - - sum_species = 1.0_r8 !all dry air species sum to 1 - do nq=dry_air_species_num+1,thermodynamic_active_species_num - itrac = idx_local(nq) - sum_species(:,:,:) = sum_species(:,:,:) + tracer(:,:,:,itrac)*factor(:,:,:) - end do - - call get_R_dry (i0,i1,j0,j1,k0,k1,k0,k1,ntrac,tracer,idx_local,Rd,fact=factor) - t_v(:,:,:) = Rd(:,:,:) - do nq=dry_air_species_num+1,thermodynamic_active_species_num - itrac = idx_local(nq) - t_v(:,:,:) = t_v(:,:,:)+thermodynamic_active_species_R(nq)*tracer(:,:,:,itrac)*factor(:,:,:) - end do - if (present(temp)) then - t_v(:,:,:) = t_v(:,:,:)*temp(:,:,:)/(Rd(:,:,:)*sum_species) - else - t_v(:,:,:) = t_v(:,:,:)/(Rd(:,:,:)*sum_species) - end if - if (present(sum_q)) sum_q=sum_species - end subroutine get_virtual_temp - ! - !************************************************************************************************************************* - ! - ! Compute generalized heat capacity at constant pressure - ! - !************************************************************************************************************************* - ! - subroutine get_cp(i0,i1,j0,j1,k0,k1,ntrac,tracer,inv_cp,cp,dp_dry,active_species_idx_dycore) - use cam_logfile, only: iulog - ! args - integer, intent(in) :: i0,i1,j0,j1,k0,k1,ntrac - real(r8), intent(in) :: tracer(i0:i1,j0:j1,k0:k1,ntrac) ! Tracer array - real(r8), optional, intent(in) :: dp_dry(i0:i1,j0:j1,k0:k1) - logical , intent(in) :: inv_cp!output inverse cp instead of cp - real(r8), intent(out) :: cp(i0:i1,j0:j1,k0:k1) - ! - ! array of indicies for index of thermodynamic active species in dycore tracer array - ! (if different from physics index) - ! - integer, optional, intent(in) :: active_species_idx_dycore(:) - - ! local vars - integer :: nq,i,j,k, itrac - real(r8), dimension(i0:i1,j0:j1,k0:k1) :: sum_species, sum_cp, factor - integer, dimension(thermodynamic_active_species_num) :: idx_local - - if (present(active_species_idx_dycore)) then - idx_local = active_species_idx_dycore - else - idx_local = thermodynamic_active_species_idx - end if - - if (present(dp_dry)) then - factor = 1.0_r8/dp_dry - else - factor = 1.0_r8 - end if - - sum_species = 1.0_r8 !all dry air species sum to 1 - do nq=dry_air_species_num+1,thermodynamic_active_species_num - itrac = idx_local(nq) - sum_species(:,:,:) = sum_species(:,:,:) + tracer(:,:,:,itrac)*factor(:,:,:) - end do - - if (dry_air_species_num==0) then - sum_cp = thermodynamic_active_species_cp(0) - else - call get_cp_dry(i0,i1,j0,j1,k0,k1,k0,k1,ntrac,tracer,idx_local,sum_cp,fact=factor) - end if - do nq=dry_air_species_num+1,thermodynamic_active_species_num - itrac = idx_local(nq) - sum_cp(:,:,:) = sum_cp(:,:,:)+thermodynamic_active_species_cp(nq)*tracer(:,:,:,itrac)*factor(:,:,:) - end do - if (inv_cp) then - cp=sum_species/sum_cp - else - cp=sum_cp/sum_species - end if - - end subroutine get_cp - ! - !************************************************************************************************************************* - ! - ! compute reference pressure levels - ! - !************************************************************************************************************************* - ! - subroutine get_dp_ref(hyai, hybi, ps0, i0,i1,j0,j1,k0,k1,phis,dp_ref,ps_ref) - integer, intent(in) :: i0,i1,j0,j1,k0,k1 - real(r8), intent(in) :: hyai(k0:k1+1),hybi(k0:k1+1),ps0 - real(r8), intent(in) :: phis(i0:i1,j0:j1) - real(r8), intent(out) :: dp_ref(i0:i1,j0:j1,k0:k1) - real(r8), intent(out) :: ps_ref(i0:i1,j0:j1) - integer :: k - ! - ! use static reference pressure (hydrostatic balance incl. effect of topography) - ! - ps_ref(:,:) = ps0*exp(-phis(:,:)/(Rair*Tref)) - do k=k0,k1 - dp_ref(:,:,k) = ((hyai(k+1)-hyai(k))*ps0 + (hybi(k+1)-hybi(k))*ps_ref(:,:)) - end do - end subroutine get_dp_ref - ! - !************************************************************************************************************************* - ! - ! compute dry densisty from temperature (temp) and pressure (dp_dry and tracer) - ! - !************************************************************************************************************************* - ! - subroutine get_rho_dry(i0,i1,j0,j1,k1,nlev,ntrac,tracer,temp,ptop,dp_dry,tracer_mass,& - rho_dry, rhoi_dry,active_species_idx_dycore,pint_out,pmid_out) - ! args - integer, intent(in) :: i0,i1,j0,j1,k1,ntrac,nlev - real(r8), intent(in) :: tracer(i0:i1,j0:j1,nlev,ntrac) ! Tracer array - real(r8), intent(in) :: temp(i0:i1,j0:j1,1:nlev) ! Temperature - real(r8), intent(in) :: ptop - real(r8), intent(in) :: dp_dry(i0:i1,j0:j1,nlev) - logical, intent(in) :: tracer_mass - real(r8), optional,intent(out) :: rho_dry(i0:i1,j0:j1,1:k1) - real(r8), optional,intent(out) :: rhoi_dry(i0:i1,j0:j1,1:k1+1) - ! - ! array of indicies for index of thermodynamic active species in dycore tracer array - ! (if different from physics index) - ! - integer, optional, intent(in) :: active_species_idx_dycore(:) - real(r8),optional,intent(out) :: pint_out(i0:i1,j0:j1,1:k1+1) - real(r8),optional,intent(out) :: pmid_out(i0:i1,j0:j1,1:k1) - - ! local vars - integer :: i,j,k - real(r8), dimension(i0:i1,j0:j1,1:k1) :: pmid - real(r8):: pint(i0:i1,j0:j1,1:k1+1) - real(r8), allocatable :: R_dry(:,:,:) - integer, dimension(thermodynamic_active_species_num):: idx_local - - if (present(active_species_idx_dycore)) then - idx_local = active_species_idx_dycore - else - idx_local = thermodynamic_active_species_idx - end if - ! - ! we assume that air is dry where molecular viscosity may be significant - ! - call get_pmid_from_dp(i0,i1,j0,j1,1,k1,dp_dry,ptop,pmid,pint=pint) - if (present(pint_out)) pint_out=pint - if (present(pint_out)) pmid_out=pmid - if (present(rhoi_dry)) then - allocate(R_dry(i0:i1,j0:j1,1:k1+1)) - if (tracer_mass) then - call get_R_dry(i0,i1,j0,j1,1,k1+1,1,nlev,ntrac,tracer,idx_local,R_dry,fact=1.0_r8/dp_dry) - else - call get_R_dry(i0,i1,j0,j1,1,k1+1,1,nlev,ntrac,tracer,idx_local,R_dry) - end if - do k=2,k1+1 - rhoi_dry(i0:i1,j0:j1,k) = 0.5_r8*(temp(i0:i1,j0:j1,k)+temp(i0:i1,j0:j1,k-1))!could be more accurate! - rhoi_dry(i0:i1,j0:j1,k) = pint(i0:i1,j0:j1,k)/(rhoi_dry(i0:i1,j0:j1,k)*R_dry(i0:i1,j0:j1,k)) !ideal gas law for dry air - end do - ! - ! extrapolate top level value - ! - k=1 - rhoi_dry(i0:i1,j0:j1,k) = 1.5_r8*(temp(i0:i1,j0:j1,1)-0.5_r8*temp(i0:i1,j0:j1,2)) - rhoi_dry(i0:i1,j0:j1,k) = pint(i0:i1,j0:j1,1)/(rhoi_dry(i0:i1,j0:j1,k)*R_dry(i0:i1,j0:j1,k)) !ideal gas law for dry air - deallocate(R_dry) - end if - if (present(rho_dry)) then - allocate(R_dry(i0:i1,j0:j1,1:k1)) - if (tracer_mass) then - call get_R_dry(i0,i1,j0,j1,1,k1,1,nlev,ntrac,tracer,idx_local,R_dry,fact=1.0_r8/dp_dry) - else - call get_R_dry(i0,i1,j0,j1,1,k1,1,nlev,ntrac,tracer,idx_local,R_dry) - end if - do k=1,k1 - do j=j0,j1 - do i=i0,i1 - rho_dry(i,j,k) = pmid(i,j,k)/(temp(i,j,k)*R_dry(i,j,k)) !ideal gas law for dry air - end do - end do - end do - end if - end subroutine get_rho_dry - ! - !************************************************************************************************************************* - ! - ! compute 3D molecular diffusion and thermal conductivity - ! - !************************************************************************************************************************* - ! - subroutine get_molecular_diff_coef(i0,i1,j0,j1,k1,nlev,temp,get_at_interfaces,sponge_factor,kmvis,kmcnd, ntrac,& - tracer, fact, active_species_idx_dycore, mbarv_in) - ! args - integer, intent(in) :: i0,i1,j0,j1,k1,nlev - real(r8), intent(in) :: temp(i0:i1,j0:j1,nlev) ! temperature - integer, intent(in) :: get_at_interfaces ! 1: compute kmvis and kmcnd at interfaces - ! 0: compute kmvis and kmcnd at mid-levels - real(r8), intent(in) :: sponge_factor(1:k1) ! multiply kmvis and kmcnd with sponge_factor (for sponge layer) - real(r8), intent(out) :: kmvis(i0:i1,j0:j1,1:k1+get_at_interfaces) - real(r8), intent(out) :: kmcnd(i0:i1,j0:j1,1:k1+get_at_interfaces) - integer , intent(in) :: ntrac - real(r8), intent(in) :: tracer(i0:i1,j0:j1,nlev,1:ntrac) ! tracer array - integer, intent(in), optional :: active_species_idx_dycore(:) ! index of active species in tracer - real(r8), intent(in), optional :: fact(i0:i1,j0:j1,k1) ! if tracer is in units of mass or moist - ! fact converts to dry mixing ratio: tracer/fact - real(r8), intent(in), optional :: mbarv_in(i0:i1,j0:j1,1:k1) ! composition dependent atmosphere mean mass - ! - ! local vars - ! - integer :: i,j,k,icnst,ispecies - real(r8):: mbarvi,mm,residual ! Mean mass at mid level - real(r8):: cnst_vis, cnst_cnd, temp_local - real(r8), dimension(i0:i1,j0:j1,1:k1) :: factor,mbarv - integer, dimension(thermodynamic_active_species_num):: idx_local - - !-------------------------------------------- - ! Set constants needed for updates - !-------------------------------------------- - - if (dry_air_species_num==0) then - - cnst_vis = (kv1*mmro2*o2_mwi + kv2*mmrn2*n2_mwi)*mbar*1.e-7_r8 - cnst_cnd = (kc1*mmro2*o2_mwi + kc2*mmrn2*n2_mwi)*mbar*1.e-5_r8 - if (get_at_interfaces==1) then - do k=2,k1 - do j=j0,j1 - do i=i0,i1 - temp_local = 0.5_r8*(temp(i,j,k)+temp(i,j,k-1)) - kmvis(i,j,k) = sponge_factor(k)*cnst_vis*temp_local**kv4 - kmcnd(i,j,k) = sponge_factor(k)*cnst_cnd*temp_local**kc4 - end do - end do - end do - ! - ! extrapolate top level value - ! - kmvis(i0:i1,j0:j1,1) = 1.5_r8*kmvis(i0:i1,j0:j1,2)-0.5_r8*kmvis(i0:i1,j0:j1,3) - kmcnd(i0:i1,j0:j1,1) = 1.5_r8*kmcnd(i0:i1,j0:j1,2)-0.5_r8*kmcnd(i0:i1,j0:j1,3) - else if (get_at_interfaces==0) then - do k=1,k1 - do j=j0,j1 - do i=i0,i1 - kmvis(i,j,k) = sponge_factor(k)*cnst_vis*temp(i,j,k)**kv4 - kmcnd(i,j,k) = sponge_factor(k)*cnst_cnd*temp(i,j,k)**kc4 - end do - end do - end do - else - call endrun('get_molecular_diff_coef: get_at_interfaces must be 0 or 1') - end if - else - if (present(active_species_idx_dycore)) then - idx_local = active_species_idx_dycore - else - idx_local = thermodynamic_active_species_idx - end if - if (present(fact)) then - factor = fact(:,:,:) - else - factor = 1.0_r8 - endif - if (present(mbarv_in)) then - mbarv = mbarv_in - else - call get_mbarv(i0,i1,j0,j1,1,k1,nlev,ntrac,tracer,idx_local,mbarv,fact=factor) - end if - ! - ! major species dependent code - ! - if (get_at_interfaces==1) then - do k=2,k1 - do j=j0,j1 - do i=i0,i1 - kmvis(i,j,k) = 0.0_r8 - kmcnd(i,j,k) = 0.0_r8 - residual = 1.0_r8 - do icnst=1,dry_air_species_num-1 - ispecies = idx_local(icnst) - mm = 0.5_r8*(tracer(i,j,k,ispecies)*factor(i,j,k)+tracer(i,j,k-1,ispecies)*factor(i,j,k-1)) - kmvis(i,j,k) = kmvis(i,j,k)+thermodynamic_active_species_kv(icnst)* & - thermodynamic_active_species_mwi(icnst)*mm - kmcnd(i,j,k) = kmcnd(i,j,k)+thermodynamic_active_species_kc(icnst)* & - thermodynamic_active_species_mwi(icnst)*mm - residual = residual - mm - end do - icnst=dry_air_species_num - ispecies = idx_local(icnst) - kmvis(i,j,k) = kmvis(i,j,k)+thermodynamic_active_species_kv(icnst)* & - thermodynamic_active_species_mwi(icnst)*residual - kmcnd(i,j,k) = kmcnd(i,j,k)+thermodynamic_active_species_kc(icnst)* & - thermodynamic_active_species_mwi(icnst)*residual - - temp_local = .5_r8*(temp(i,j,k-1)+temp(i,j,k)) - mbarvi = 0.5_r8*(mbarv(i,j,k-1)+mbarv(i,j,k)) - kmvis(i,j,k) = kmvis(i,j,k)*mbarvi*temp_local**kv4*1.e-7_r8 - kmcnd(i,j,k) = kmcnd(i,j,k)*mbarvi*temp_local**kc4*1.e-5_r8 - enddo - enddo - end do - do j=j0,j1 - do i=i0,i1 - kmvis(i,j,1) = 1.5_r8*kmvis(i,j,2)-.5_r8*kmvis(i,j,3) - kmcnd(i,j,1) = 1.5_r8*kmcnd(i,j,2)-.5_r8*kmcnd(i,j,3) - kmvis(i,j,k1+1) = kmvis(i,j,k1) - kmcnd(i,j,k1+1) = kmcnd(i,j,k1) - end do - end do - else if (get_at_interfaces==0) then - else - call endrun('get_molecular_diff_coef: get_at_interfaces must be 0 or 1') - end if - end if - end subroutine get_molecular_diff_coef - ! - !************************************************************************************************************************* - ! - ! compute reference vertical profile of density, molecular diffusion and thermal conductivity - ! - !************************************************************************************************************************* - ! - subroutine get_molecular_diff_coef_reference(k0,k1,tref,press,sponge_factor,kmvis_ref,kmcnd_ref,rho_ref) - ! args - integer, intent(in) :: k0,k1 !min/max vertical index - real(r8), intent(in) :: tref !reference temperature - real(r8), intent(in) :: press(k0:k1) !pressure - real(r8), intent(in) :: sponge_factor(k0:k1) !multiply kmvis and kmcnd with sponge_factor (for sponge layer) - real(r8), intent(out) :: kmvis_ref(k0:k1) !reference molecular diffusion coefficient - real(r8), intent(out) :: kmcnd_ref(k0:k1) !reference thermal conductivity coefficient - real(r8), intent(out) :: rho_ref(k0:k1) !reference density - - ! local vars - integer :: k - - !-------------------------------------------- - ! Set constants needed for updates - !-------------------------------------------- - - do k=k0,k1 - rho_ref(k) = press(k)/(tref*Rair) !ideal gas law for dry air - kmvis_ref(k) = sponge_factor(k)* & - (kv1*mmro2*o2_mwi + & - kv2*mmrn2*n2_mwi)*mbar* & - tref**kv4 * 1.e-7_r8 - kmcnd_ref(k) = sponge_factor(k)* & - (kc1*mmro2*o2_mwi + & - kc2*mmrn2*n2_mwi)*mbar* & - tref**kc4 * 1.e-5_r8 - end do - end subroutine get_molecular_diff_coef_reference + end subroutine physconst_readnl end module physconst diff --git a/src/utils/spmd_utils.F90 b/src/utils/spmd_utils.F90 index d768c47ab3..8cd5d040a2 100644 --- a/src/utils/spmd_utils.F90 +++ b/src/utils/spmd_utils.F90 @@ -1,11 +1,11 @@ module spmd_utils -!----------------------------------------------------------------------- -! +!----------------------------------------------------------------------- +! ! Purpose: This module is responsible for miscellaneous SPMD utilities -! and information that are shared between dynamics and -! physics packages. -! +! and information that are shared between dynamics and +! physics packages. +! ! Author: ! Original routines: CMS ! Module: T. Henderson, December 2003 @@ -14,7 +14,7 @@ module spmd_utils ! SMP node id logic: P. Worley ! ! $Id$ -! +! !----------------------------------------------------------------------- ! @@ -41,7 +41,7 @@ module spmd_utils !- module boilerplate -------------------------------------------------- !----------------------------------------------------------------------- implicit none - include 'mpif.h' + include 'mpif.h' private ! Make the default access private save ! @@ -61,18 +61,16 @@ module spmd_utils mpi_packed, mpi_tag_ub, mpi_info_null, & mpi_comm_null, mpi_group_null, mpi_undefined, & mpi_status_size, mpi_success, mpi_status_ignore, & - mpi_max, mpi_min, mpi_sum, mpi_band, & - mpir8 - - - - + mpi_max, mpi_min, mpi_sum, mpi_band, mpir8 +#if ( defined SPMD ) + public :: mpi_address_kind +#endif !----------------------------------------------------------------------- ! Public interfaces ---------------------------------------------------- !----------------------------------------------------------------------- - public pair ! $$$here... originally from eul|sld/spmd_dyn - public ceil2 ! $$$here... originally from eul|sld/spmd_dyn + public pair + public ceil2 public spmdinit public spmd_utils_readnl #if ( defined SPMD ) @@ -84,14 +82,50 @@ module spmd_utils public altalltoallv #endif +!----------------------------------------------------------------------- +! Public communication types-------------------------------------------- +!----------------------------------------------------------------------- + type, public :: spmd_col_trans + ! spmd_col_trans holds information for setting up a communications pattern + integer :: source_task + integer :: source_index + integer :: dest_task + integer :: dest_index + integer :: mpi_tag + end type spmd_col_trans + + type, public :: column_redist_t + ! column_redist_t holds information needed to redistribute columns + ! Fields used for both send and receive + integer :: mpi_comm = MPI_COMM_NULL ! Comm for dest tasks + integer :: recv_iam = -1 ! rank in mpi_comm + integer :: recv_master_id = -1 ! rank of mpi_comm 'master' + integer :: max_nflds = 0 ! max fields at one time + integer :: num_rounds = 0 ! # of field sum blocks + integer, pointer :: dest_tasks(:) => NULL() ! Destination tasks + integer, pointer :: col_starts(:) => NULL() ! Global start col per dest + integer, pointer :: num_rflds(:) => NULL() ! # flds per round + ! Data used by receiving tasks + integer, pointer :: recv_cnts(:) => NULL() ! # cols from each PE + integer, pointer :: recv_disps(:) => NULL() ! col offsets from each PE + integer, pointer :: recv_reorder(:) => NULL() ! Reordering after receive + ! Data used by sending tasks + integer :: strt_nfld = -1 ! first field for this task + integer :: my_nflds = 0 ! # fields for this task + integer, pointer :: task_sizes(:) => NULL() ! # of task cols per dest + integer, pointer :: task_indices(:) => NULL() ! Global index for each col + integer, pointer :: send_disps(:) => NULL() ! cols offsets to each PE + integer, pointer :: send_reorder(:) => NULL() ! Reordering before send + end type column_redist_t + !----------------------------------------------------------------------- ! Public data ---------------------------------------------------------- !----------------------------------------------------------------------- ! physics-motivated dynamics decomposition request logical, parameter :: def_mirror = .false. ! default - logical, public :: phys_mirror_decomp_req = def_mirror + logical, public :: phys_mirror_decomp_req = def_mirror ! flag indicating whether latitudes and their - ! reflections across the equator should be + ! reflections across the equator should be ! assigned to consecutive processes #if (defined SPMD) @@ -107,9 +141,10 @@ module spmd_utils integer, public :: npes integer, public :: nsmps integer, allocatable, public :: proc_smp_map(:) - integer, parameter :: DEFAULT_MASTERPROC=0 - ! the value of iam which is assigned - ! the masterproc duties + ! DEFAULT_MASTERPROC is the value of iam which is assigned masterproc duties + integer, parameter :: DEFAULT_MASTERPROC = 0 + ! spmd_col_trans_mpi_type is a handle to be used for column reordering + integer, public, protected :: spmd_col_trans_mpi_type !----------------------------------------------------------------------- ! Private data --------------------------------------------------------- @@ -132,9 +167,9 @@ module spmd_utils ! Flow-controlled gather option: ! < 0: use MPI_Gather -! >= 0: use point-to-point with handshaking messages and -! preposting receive requests up to -! min(max(1,fc_gather_flow_cntl),max_gather_block_size) +! >= 0: use point-to-point with handshaking messages and +! preposting receive requests up to +! min(max(1,fc_gather_flow_cntl),max_gather_block_size) ! ahead integer, private, parameter :: max_gather_block_size = 64 ! max and default integer, public :: fc_gather_flow_cntl = max_gather_block_size @@ -172,17 +207,17 @@ integer function ceil2(n) end function ceil2 !======================================================================== - + subroutine spmdinit( mpicom_atm ) - !----------------------------------------------------------------------- - ! - ! Purpose: MPI initialization routine: - ! + !----------------------------------------------------------------------- + ! + ! Purpose: MPI initialization routine: + ! ! Method: get number of cpus, processes, tids, etc ! dynamics and physics decompositions are set up later - ! + ! ! Author: CCM Core Group - ! + ! !----------------------------------------------------------------------- implicit none @@ -194,7 +229,7 @@ subroutine spmdinit( mpicom_atm ) ! integer i,j,c ! indices integer npthreads ! thread status - integer ier ! return error status + integer ier ! return error status integer length ! length of name integer max_len ! maximum name length integer, allocatable :: lengths(:)! max lengths of names for use in gatherv @@ -205,6 +240,14 @@ subroutine spmdinit( mpicom_atm ) character(len=mpi_max_processor_name) :: tmp_name ! temporary storage character(len=mpi_max_processor_name), allocatable :: smp_names(:) ! SMP name logical mpi_running ! returned value indicates if MPI_INIT has been called + ! For creating new MPI type for column info transfer + integer :: h1, hind + integer :: ierr + integer(kind=MPI_ADDRESS_KIND) :: offsets(6) ! For new MPI types + integer :: origtypes(6) ! For new MPI types + integer(kind=MPI_ADDRESS_KIND) :: extent ! For new MPI types + type(spmd_col_trans) :: dummy_loc(2) ! For new MPI types + type(spmd_col_trans) :: col_trans_type_temp !--------------------------------------------------------------------------- ! @@ -225,11 +268,11 @@ subroutine spmdinit( mpicom_atm ) mpipk = mpi_packed mpimax = mpi_max ! - ! Get my id + ! Get my id ! - call mpi_comm_rank (mpicom, iam, ier) + call mpi_comm_rank (mpicom, iam, ier) masterprocid = DEFAULT_MASTERPROC - if (iam == DEFAULT_MASTERPROC) then + if (iam == DEFAULT_MASTERPROC) then masterproc = .true. else masterproc = .false. @@ -243,9 +286,9 @@ subroutine spmdinit( mpicom_atm ) allocate ( lengths(npes) ) allocate ( proc_name(max_len) ) allocate ( proc_names(max_len*npes) ) - + ! - ! Get processor names and send to root. + ! Get processor names and send to root. ! call mpi_get_processor_name (tmp_name, length, ier) proc_name(:) = ' ' @@ -324,8 +367,37 @@ subroutine spmdinit( mpicom_atm ) deallocate(proc_name) deallocate(proc_names) + ! Create a type for transferring column information + allocate(lengths(6)) + lengths(:) = 1 + origtypes(:) = MPI_INTEGER + h1 = 0 + h1 = h1 + 1 + call MPI_Get_address(dummy_loc(1)%source_task, offsets(h1), ierr) + h1 = h1 + 1 + call MPI_Get_address(dummy_loc(1)%source_index, offsets(h1), ierr) + h1 = h1 + 1 + call MPI_Get_address(dummy_loc(1)%dest_task, offsets(h1), ierr) + h1 = h1 + 1 + call MPI_Get_address(dummy_loc(1)%dest_index, offsets(h1), ierr) + h1 = h1 + 1 + call MPI_Get_address(dummy_loc(1)%mpi_tag, offsets(h1), ierr) + do hind = h1, 1, -1 + offsets(hind) = offsets(hind) - offsets(1) + end do + call MPI_type_create_struct(h1, lengths(1:h1), offsets(1:h1), & + origtypes(1:h1), col_trans_type_temp, ierr) + ! Adjust for padding + call MPI_Get_address(dummy_loc(1)%source_task, offsets(1), ierr) + call MPI_Get_address(dummy_loc(2)%source_task, offsets(2), ierr) + extent = offsets(2) - offsets(1) + call MPI_type_create_resized(col_trans_type_temp, 0_MPI_ADDRESS_KIND, & + extent, spmd_col_trans_mpi_type, ierr) + call MPI_type_commit(spmd_col_trans_mpi_type, ierr) + deallocate(lengths) + #else - ! + ! ! spmd is not defined ! mpicom = mpicom_atm @@ -337,7 +409,7 @@ subroutine spmdinit( mpicom_atm ) allocate ( proc_smp_map(0:0) ) proc_smp_map(:) = -1 -#endif +#endif end subroutine spmdinit @@ -350,14 +422,14 @@ subroutine swapm (steps, nprocs, swapids, & rcvbuf, rbuf_siz, rcvlths, rdispls, & comm, comm_protocol, comm_maxreq ) -!----------------------------------------------------------------------- -! -! Purpose: -! Reduced version of original swapm (for swap of multiple messages -! using MPI point-to-point routines), more efficiently implementing a +!----------------------------------------------------------------------- +! +! Purpose: +! Reduced version of original swapm (for swap of multiple messages +! using MPI point-to-point routines), more efficiently implementing a ! subset of the swap protocols. -! -! Method: +! +! Method: ! comm_protocol: ! = 3 or 5: use nonblocking send ! = 2 or 4: use blocking send @@ -370,7 +442,7 @@ subroutine swapm (steps, nprocs, swapids, & ! Author of original version: P. Worley ! Ported to CAM: P. Worley, December 2003 ! Simplified version: P. Worley, October, 2008 -! +! !----------------------------------------------------------------------- !----------------------------------------------------------------------- @@ -388,7 +460,7 @@ subroutine swapm (steps, nprocs, swapids, & ! buffer where outgoing messages ! should be sent from integer, intent(in) :: rcvlths(0:nprocs-1)! length of incoming messages - integer, intent(in) :: rdispls(0:nprocs-1)! offset from beginning of receive + integer, intent(in) :: rdispls(0:nprocs-1)! offset from beginning of receive ! buffer where incoming messages ! should be placed real(r8), intent(in) :: sndbuf(sbuf_siz) ! outgoing message buffer @@ -396,7 +468,7 @@ subroutine swapm (steps, nprocs, swapids, & integer, intent(in) :: comm ! MPI communicator integer, intent(in) :: comm_protocol ! swap_comm protocol - integer, intent(in) :: comm_maxreq ! maximum number of outstanding + integer, intent(in) :: comm_maxreq ! maximum number of outstanding ! nonblocking requests ! @@ -404,23 +476,23 @@ subroutine swapm (steps, nprocs, swapids, & ! integer :: p ! process index integer :: istep ! loop index - integer :: offset_s ! index of message beginning in + integer :: offset_s ! index of message beginning in ! send buffer - integer :: offset_r ! index of message beginning in + integer :: offset_r ! index of message beginning in ! receive buffer integer :: sndids(steps) ! send request ids integer :: rcvids(steps) ! receive request ids integer :: hs_rcvids(steps) ! handshake receive request ids - integer :: maxreq, maxreqh ! maximum number of outstanding + integer :: maxreq, maxreqh ! maximum number of outstanding ! nonblocking requests (and half) integer :: hs_s, hs_r(steps) ! handshake variables (send/receive) integer :: rstep ! "receive" step index logical :: handshake, sendd ! protocol option flags - integer :: ier ! return error status - integer :: status(MPI_STATUS_SIZE) ! MPI status + integer :: ier ! return error status + integer :: status(MPI_STATUS_SIZE) ! MPI status ! !------------------------------------------------------------------------------------- ! @@ -496,7 +568,7 @@ subroutine swapm (steps, nprocs, swapids, & enddo rstep = maxreq - ! Send (and start receiving) data + ! Send (and start receiving) data do istep=1,steps p = swapids(istep) @@ -574,7 +646,7 @@ subroutine swapm (steps, nprocs, swapids, & enddo rstep = maxreq - ! Send (and start receiving) data + ! Send (and start receiving) data do istep=1,steps p = swapids(istep) @@ -648,7 +720,7 @@ subroutine swapm (steps, nprocs, swapids, & enddo rstep = maxreq - ! Send (and start receiving) data + ! Send (and start receiving) data do istep=1,steps p = swapids(istep) @@ -704,7 +776,7 @@ subroutine swapm (steps, nprocs, swapids, & enddo rstep = maxreq - ! Send (and start receiving) data + ! Send (and start receiving) data do istep=1,steps p = swapids(istep) @@ -763,19 +835,19 @@ end subroutine swapm ! !======================================================================== -!----------------------------------------------------------------------- -! -! Purpose: gather collective with additional flow control, so as to -! be more robust when used with high process counts. -! If flow_cntl optional parameter +!----------------------------------------------------------------------- +! +! Purpose: gather collective with additional flow control, so as to +! be more robust when used with high process counts. +! If flow_cntl optional parameter ! < 0: use MPI_Gather -! >= 0: use point-to-point with handshaking messages and -! preposting receive requests up to -! min(max(1,flow_cntl),max_gather_block_size) +! >= 0: use point-to-point with handshaking messages and +! preposting receive requests up to +! min(max(1,flow_cntl),max_gather_block_size) ! ahead if optional flow_cntl parameter is present. ! Otherwise, fc_gather_flow_cntl is used in its place. ! Default value is 64. -! +! ! Entry points: ! fc_gatherv functionally equivalent to mpi_gatherv ! fc_gathervr4 functionally equivalent to mpi_gatherv for real*4 data @@ -843,7 +915,7 @@ subroutine fc_gatherv (sendbuf, sendcnt, sendtype, & endif if (fc_gather) then - + #if defined( WRAP_MPI_TIMING ) call t_startf ('fc_gatherv_r8') #endif @@ -904,7 +976,7 @@ subroutine fc_gatherv (sendbuf, sendcnt, sendtype, & #endif else - + #if defined( WRAP_MPI_TIMING ) call t_startf ('mpi_gatherv') #endif @@ -981,7 +1053,7 @@ subroutine fc_gathervr4 (sendbuf, sendcnt, sendtype, & endif if (fc_gather) then - + #if defined( WRAP_MPI_TIMING ) call t_startf ('fc_gatherv_r4') #endif @@ -1042,7 +1114,7 @@ subroutine fc_gathervr4 (sendbuf, sendcnt, sendtype, & #endif else - + #if defined( WRAP_MPI_TIMING ) call t_startf ('mpi_gatherv') #endif @@ -1119,7 +1191,7 @@ subroutine fc_gathervint (sendbuf, sendcnt, sendtype, & endif if (fc_gather) then - + #if defined( WRAP_MPI_TIMING ) call t_startf ('fc_gatherv_int') #endif @@ -1180,7 +1252,7 @@ subroutine fc_gathervint (sendbuf, sendcnt, sendtype, & #endif else - + #if defined( WRAP_MPI_TIMING ) call t_startf ('mpi_gatherv') #endif @@ -1257,7 +1329,7 @@ subroutine fc_gathervc (sendbuf, sendcnt, sendtype, & endif if (fc_gather) then - + #if defined( WRAP_MPI_TIMING ) call t_startf ('fc_gatherv_char') #endif @@ -1318,7 +1390,7 @@ subroutine fc_gathervc (sendbuf, sendcnt, sendtype, & #endif else - + #if defined( WRAP_MPI_TIMING ) call t_startf ('mpi_gatherv') #endif @@ -1341,19 +1413,19 @@ end subroutine fc_gathervc !======================================================================== #endif -!----------------------------------------------------------------------- -! +!----------------------------------------------------------------------- +! ! Purpose: implementations of MPI_Alltoall using different messaging ! layers and different communication protocols, controlled ! by option argument: ! 0: use mpi_alltoallv ! 1: use point-to-point MPI-1 two-sided implementation -! 2: use point-to-point MPI-2 one-sided implementation if supported, +! 2: use point-to-point MPI-2 one-sided implementation if supported, ! otherwise use MPI-1 implementation -! 3: use Co-Array Fortran implementation if supported, +! 3: use Co-Array Fortran implementation if supported, ! otherwise use MPI-1 implementation ! otherwise use mpi_sendrecv implementation -! +! ! Entry points: ! altalltoallv ! @@ -1379,7 +1451,7 @@ subroutine altalltoallv (option, mytid, nprocs, steps, dests, & integer, intent(in) :: option ! 0: mpi_alltoallv ! 1: swap package - ! 2: mpi2 + ! 2: mpi2 ! 3: co-array fortran ! otherwise: sendrecv integer, intent(in) :: mytid @@ -1395,7 +1467,7 @@ subroutine altalltoallv (option, mytid, nprocs, steps, dests, & integer, intent(in) :: rdispls(0:nprocs-1) integer, intent(in) :: recvtype integer, intent(in) :: msgtag - integer, intent(in) :: pdispls(0:nprocs-1) ! displacement at + integer, intent(in) :: pdispls(0:nprocs-1) ! displacement at ! destination integer, intent(in) :: desttype integer, intent(in) :: recvwin @@ -1583,26 +1655,26 @@ subroutine altalltoallv (option, mytid, nprocs, steps, dests, & end subroutine altalltoallv #endif - + subroutine spmd_utils_readnl(nlfile) -!----------------------------------------------------------------------- -! -! Purpose: +!----------------------------------------------------------------------- +! +! Purpose: ! Read spmd utils namelist to set swap communication protocol options as ! well as the flow control gather options -! -! Method: +! +! Method: ! spmd_utils_readnl: ! ! Author of original version: J. Truesdale -! +! !----------------------------------------------------------------------- !----------------------------------------------------------------------- use namelist_utils, only: find_group_name use units, only: getunit, freeunit use mpishorthand - + implicit none !---------------------------Input arguments-------------------------- ! @@ -1613,7 +1685,7 @@ subroutine spmd_utils_readnl(nlfile) ! integer :: unitn, ierr character(len=*), parameter :: subname = 'spmd_utils_readnl' - + namelist /spmd_utils_nl/ swap_comm_protocol,swap_comm_maxreq,fc_gather_flow_cntl !----------------------------------------------------------------------------- @@ -1631,8 +1703,8 @@ subroutine spmd_utils_readnl(nlfile) end if close(unitn) call freeunit(unitn) - - + + if ((swap_comm_protocol < min_comm_protocol) .or. & (swap_comm_protocol > max_comm_protocol)) then write(iulog,*) & @@ -1645,21 +1717,20 @@ subroutine spmd_utils_readnl(nlfile) ' Using default value.' swap_comm_protocol = def_comm_protocol endif - + write(iulog,*) 'SPMD SWAP_COMM OPTIONS: ' write(iulog,*) ' swap_comm_protocol = ', swap_comm_protocol - write(iulog,*) ' swap_comm_maxreq = ', swap_comm_maxreq + write(iulog,*) ' swap_comm_maxreq = ', swap_comm_maxreq write(iulog,*) 'SPMD FLOW CONTROL GATHER OPTION: ' write(iulog,*) ' fc_gather_flow_cntl = ', fc_gather_flow_cntl endif - + ! Broadcast namelist variables call mpibcast (swap_comm_protocol , 1, mpiint , 0, mpicom) call mpibcast (swap_comm_maxreq , 1, mpiint , 0, mpicom) call mpibcast (fc_gather_flow_cntl, 1, mpiint , 0, mpicom) #endif - + end subroutine spmd_utils_readnl - - end module spmd_utils + end module spmd_utils diff --git a/src/utils/srf_field_check.F90 b/src/utils/srf_field_check.F90 index d1c0adfbca..97d210bb5e 100644 --- a/src/utils/srf_field_check.F90 +++ b/src/utils/srf_field_check.F90 @@ -17,10 +17,6 @@ module srf_field_check logical, public, protected :: active_Fall_fco2_lnd = .false. logical, public, protected :: active_Faoo_fco2_ocn = .false. - ! output from atm - logical, public, protected :: active_Faxa_nhx = .false. - logical, public, protected :: active_Faxa_noy = .false. - public :: set_active_Sl_ram1 public :: set_active_Sl_fv public :: set_active_Sl_soilw @@ -29,8 +25,6 @@ module srf_field_check public :: set_active_Fall_flxfire public :: set_active_Fall_fco2_lnd public :: set_active_Faoo_fco2_ocn - public :: set_active_Faxa_nhx - public :: set_active_Faxa_noy !=============================================================================== contains @@ -76,14 +70,4 @@ subroutine set_active_Faoo_fco2_ocn(is_active) active_Faoo_fco2_ocn = is_active end subroutine set_active_Faoo_fco2_ocn - subroutine set_active_Faxa_nhx(is_active) - logical, intent(in) :: is_active - active_Faxa_nhx = is_active - end subroutine set_active_Faxa_nhx - - subroutine set_active_Faxa_noy(is_active) - logical, intent(in) :: is_active - active_Faxa_noy = is_active - end subroutine set_active_Faxa_noy - end module srf_field_check diff --git a/src/utils/std_atm_profile.F90 b/src/utils/std_atm_profile.F90 index 5664baa3ac..d37dc4d04c 100644 --- a/src/utils/std_atm_profile.F90 +++ b/src/utils/std_atm_profile.F90 @@ -47,21 +47,33 @@ module std_atm_profile real(r8), parameter :: g0 = 9.80665_r8 ! gravitational acceleration (m/s^2) real(r8), parameter :: mw = 0.0289644_r8 ! molar mass of dry air (kg/mol) real(r8), parameter :: c1 = g0*mw/rg - + !========================================================================================= CONTAINS !========================================================================================= -subroutine std_atm_pres(height, pstd) - +subroutine std_atm_pres(height, pstd, user_specified_ps) + ! arguments - real(r8), intent(in) :: height(:) ! height above sea level in meters - real(r8), intent(out) :: pstd(:) ! std pressure in Pa - - integer :: i, ii, k, nlev + real(r8), intent(in) :: height(:) ! height above sea level in meters + real(r8), intent(out) :: pstd(:) ! std pressure in Pa + real(r8), optional, intent(in) :: user_specified_ps + + integer :: i, ii, k, nlev + integer :: ierr + real(r8) :: pb_local(nreg) + character(len=*), parameter :: routine = 'std_atm_pres' !---------------------------------------------------------------------------- - + + ! Initialize local standard pressure values array + pb_local = pb + + ! Set new surface pressure value if provided by the caller + if (present(user_specified_ps)) then + pb_local(1) = user_specified_ps + end if + nlev = size(height) do k = 1, nlev if (height(k) < 0.0_r8) then @@ -76,33 +88,32 @@ subroutine std_atm_pres(height, pstd) end if end do find_region end if - + if (lb(ii) /= 0._r8) then - pstd(k) = pb(ii) * ( tb(ii) / (tb(ii) + lb(ii)*(height(k) - hb(ii)) ) )**(c1/lb(ii)) + pstd(k) = pb_local(ii) * ( tb(ii) / (tb(ii) + lb(ii)*(height(k) - hb(ii)) ) )**(c1/lb(ii)) else - pstd(k) = pb(ii) * exp( -c1*(height(k) - hb(ii))/tb(ii) ) + pstd(k) = pb_local(ii) * exp( -c1*(height(k) - hb(ii))/tb(ii) ) end if - - end do + end do end subroutine std_atm_pres !========================================================================================= subroutine std_atm_height(pstd, height) - + ! arguments real(r8), intent(in) :: pstd(:) ! std pressure in Pa real(r8), intent(out) :: height(:) ! height above sea level in meters - + integer :: i, ii, k, nlev logical :: found_region character(len=*), parameter :: routine = 'std_atm_height' !---------------------------------------------------------------------------- - + nlev = size(height) do k = 1, nlev - + if (pstd(k) <= pb(nreg)) then ii = nreg else if (pstd(k) > pb(1)) then @@ -129,16 +140,16 @@ end subroutine std_atm_height !========================================================================================= subroutine std_atm_temp(height, temp) - + ! arguments real(r8), intent(in) :: height(:) ! std pressure in Pa real(r8), intent(out) :: temp(:) ! temperature - + ! local vars integer :: i, ii, k, nlev character(len=*), parameter :: routine = 'std_atm_temp' !---------------------------------------------------------------------------- - + nlev = size(height) do k = 1, nlev if (height(k) < 0.0_r8) then @@ -158,7 +169,7 @@ subroutine std_atm_temp(height, temp) else temp(k) = tb(ii) end if - + end do end subroutine std_atm_temp diff --git a/src/utils/table_interp_mod.F90 b/src/utils/table_interp_mod.F90 new file mode 100644 index 0000000000..9daac52b51 --- /dev/null +++ b/src/utils/table_interp_mod.F90 @@ -0,0 +1,214 @@ +!---------------------------------------------------------------------------- +! Utility module used for interpolation of aerosol optics table +! NOTE: Results will be set to table edges for interpolations beyond +! the edges -- no extropolations +!---------------------------------------------------------------------------- +module table_interp_mod + use shr_kind_mod, only: r8=>shr_kind_r8 + + implicit none + + private + public :: table_interp + public :: table_interp_wghts + public :: table_interp_calcwghts + + ! overload the interpolation routines + interface table_interp + module procedure interp1d + module procedure interp2d + module procedure interp4d + end interface table_interp + + ! interpolation weights and indices + type :: table_interp_wghts + real(r8) :: wt1 + real(r8) :: wt2 + integer :: ix1 + integer :: ix2 + end type table_interp_wghts + +contains + + !-------------------------------------------------------------------------- + ! 1-D interpolation + !-------------------------------------------------------------------------- + pure function interp1d( ncol, nxs, xwghts, tbl ) result(res) + + integer, intent(in) :: ncol ! number of model columns + integer, intent(in) :: nxs ! table size + real(r8), intent(in) :: tbl(nxs) ! table values to be interpolated + type(table_interp_wghts), intent(in) :: xwghts(ncol) ! interpolation weights and indices + + real(r8) :: res(ncol) + + integer :: i + + do i = 1,ncol + + res(i) = xwghts(i)%wt1*tbl(xwghts(i)%ix1) & + + xwghts(i)%wt2*tbl(xwghts(i)%ix2) + + end do + + end function interp1d + + !-------------------------------------------------------------------------- + ! 2-D interpolation + !-------------------------------------------------------------------------- + pure function interp2d( ncoef, ncol, nxs, nys, xwghts, ywghts, tbl ) result(res) + + integer, intent(in) :: ncoef ! number chebyshev coefficients + integer, intent(in) :: ncol ! number of model columns + integer, intent(in) :: nxs ! table x-dimension size + integer, intent(in) :: nys ! table y-dimension size + real(r8), intent(in) :: tbl(ncoef,nxs,nys) ! table values to be interpolated + type(table_interp_wghts), intent(in) :: xwghts(ncol) ! x interpolation weights and indices + type(table_interp_wghts), intent(in) :: ywghts(ncol) ! y interpolation weights and indices + + real(r8) :: res(ncoef,ncol) + + real(r8) :: fx(ncoef,2) + + integer :: i + + do i = 1,ncol + + ! interp x dir + fx(:,1) = xwghts(i)%wt1*tbl(:,xwghts(i)%ix1,ywghts(i)%ix1) & ! @ y1 + + xwghts(i)%wt2*tbl(:,xwghts(i)%ix2,ywghts(i)%ix1) + fx(:,2) = xwghts(i)%wt1*tbl(:,xwghts(i)%ix1,ywghts(i)%ix2) & ! @ y2 + + xwghts(i)%wt2*tbl(:,xwghts(i)%ix2,ywghts(i)%ix2) + + ! interp y dir + res(:,i) = ywghts(i)%wt1*fx(:,1) + ywghts(i)%wt2*fx(:,2) + + end do + + end function interp2d + + !-------------------------------------------------------------------------- + ! 4-D interpolation + !-------------------------------------------------------------------------- + pure function interp4d( ncol, nxs, nys, nzs, nts, xwghts, ywghts, zwghts, twghts, tbl ) result(res) + + integer, intent(in) :: ncol ! number of model columns + integer, intent(in) :: nxs ! table x-dimension size + integer, intent(in) :: nys ! table y-dimension size + integer, intent(in) :: nzs ! table z-dimension size + integer, intent(in) :: nts ! table t-dimension size + real(r8), intent(in) :: tbl(nxs,nys,nzs,nts) ! table values to be interpolated + type(table_interp_wghts), intent(in) :: xwghts(ncol) ! x interpolation weights and indices + type(table_interp_wghts), intent(in) :: ywghts(ncol) ! y interpolation weights and indices + type(table_interp_wghts), intent(in) :: zwghts(ncol) ! z interpolation weights and indices + type(table_interp_wghts), intent(in) :: twghts(ncol) ! t interpolation weights and indices + + real(r8) :: res(ncol) + + real(r8) :: fx(8) + real(r8) :: fy(4) + real(r8) :: fz(2) + + integer :: i + + do i = 1,ncol + + ! interp x dir + fx(1) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix1,zwghts(i)%ix1,twghts(i)%ix1) & ! @ y1, z1, t1 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix1,zwghts(i)%ix1,twghts(i)%ix1) + fx(2) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix2,zwghts(i)%ix1,twghts(i)%ix1) & ! @ y2, z1, t1 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix2,zwghts(i)%ix1,twghts(i)%ix1) + + fx(3) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix1,zwghts(i)%ix2,twghts(i)%ix1) & ! @ y1, z2, t1 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix1,zwghts(i)%ix2,twghts(i)%ix1) + fx(4) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix2,zwghts(i)%ix2,twghts(i)%ix1) & ! @ y2, z2, t1 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix2,zwghts(i)%ix2,twghts(i)%ix1) + + fx(5) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix1,zwghts(i)%ix1,twghts(i)%ix2) & ! @ y1, z1, t2 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix1,zwghts(i)%ix1,twghts(i)%ix2) + fx(6) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix2,zwghts(i)%ix1,twghts(i)%ix2) & ! @ y2, z1, t2 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix2,zwghts(i)%ix1,twghts(i)%ix2) + + fx(7) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix1,zwghts(i)%ix2,twghts(i)%ix2) & ! @ y1, z2, t2 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix1,zwghts(i)%ix2,twghts(i)%ix2) + fx(8) = xwghts(i)%wt1*tbl(xwghts(i)%ix1,ywghts(i)%ix2,zwghts(i)%ix2,twghts(i)%ix2) & ! @ y2, z2, t2 + + xwghts(i)%wt2*tbl(xwghts(i)%ix2,ywghts(i)%ix2,zwghts(i)%ix2,twghts(i)%ix2) + + ! interp y dir + fy(1) = ywghts(i)%wt1*fx(1) + ywghts(i)%wt2*fx(2) ! @ z1, t1 + fy(2) = ywghts(i)%wt1*fx(3) + ywghts(i)%wt2*fx(4) ! @ z2, t1 + fy(3) = ywghts(i)%wt1*fx(5) + ywghts(i)%wt2*fx(6) ! @ z1, t2 + fy(4) = ywghts(i)%wt1*fx(7) + ywghts(i)%wt2*fx(8) ! @ z2, t2 + + ! interp z dir + fz(1) = zwghts(i)%wt1*fy(1) + zwghts(i)%wt2*fy(2) ! @ t1 + fz(2) = zwghts(i)%wt1*fy(3) + zwghts(i)%wt2*fy(4) ! @ t2 + + ! interp t dir + res(i) = twghts(i)%wt1*fz(1) + twghts(i)%wt2*fz(2) + + end do + + end function interp4d + + !-------------------------------------------------------------------------- + ! determines interpolation weights and indices for given values at the model columns + !-------------------------------------------------------------------------- + pure function table_interp_calcwghts( ngrid, xgrid, ncols, xcols ) result(wghts) + + integer, intent(in) :: ngrid ! number of grid point values + real(r8), intent(in) :: xgrid(ngrid) ! grid point values + integer, intent(in) :: ncols ! number of model columns + real(r8), intent(in) :: xcols(ncols) ! values at the model columns + + type(table_interp_wghts) :: wghts(ncols) ! interpolations weights at the model columns + + integer :: i + real(r8) :: xs(ncols) + + xs(:) = xcols(:) + + ! do not extrapolate beyond the edges of the table + where(xs < xgrid(1)) + xs = xgrid(1) + end where + where(xs > xgrid(ngrid)) + xs = xgrid(ngrid) + end where + + do i = 1,ncols + wghts(i)%ix2 = find_index(ngrid,xgrid,xs(i)) + wghts(i)%ix1 = wghts(i)%ix2 - 1 + wghts(i)%wt1 = (xgrid(wghts(i)%ix2)-xs(i)) & + /(xgrid(wghts(i)%ix2)-xgrid(wghts(i)%ix1)) + wghts(i)%wt2 = 1._r8 - wghts(i)%wt1 + end do + + end function table_interp_calcwghts + + ! private methods + !-------------------------------------------------------------------------- + !-------------------------------------------------------------------------- + ! determines last index of grid vals of which is greater then or equal to + ! value vx + !-------------------------------------------------------------------------- + pure function find_index( nvals, vals, vx ) result(res) + integer, intent(in) :: nvals + real(r8), intent(in) :: vals(nvals) + real(r8), intent(in) :: vx + integer :: res + + integer :: ndx + + res = -1 + + find_ndx: do ndx = 2, nvals + if (vals(ndx)>=vx) then + res = ndx + exit find_ndx + end if + end do find_ndx + + end function find_index + +end module table_interp_mod diff --git a/src/utils/time_manager.F90 b/src/utils/time_manager.F90 index 38ad3b4db2..aeeae9b3f4 100644 --- a/src/utils/time_manager.F90 +++ b/src/utils/time_manager.F90 @@ -33,7 +33,7 @@ module time_manager get_curr_time, &! return components of elapsed time since reference date at end of current timestep get_prev_time, &! return components of elapsed time since reference date at beg of current timestep get_curr_calday, &! return calendar day at end of current timestep - get_julday, &! return julian day from input date, time + get_julday, &! return julian day from input date, time get_calday, &! return calendar day from input date is_first_step, &! return true on first step of initial run is_first_restart_step, &! return true on first step of restart or branch run @@ -50,6 +50,7 @@ module time_manager set_time_float_from_date, &! returns a float representation of time given yr, mon, day, sec set_date_from_time_float ! returns yr, mon, day, sec given time float +public :: is_leapyear ! Private module data @@ -65,7 +66,7 @@ module time_manager ! The target attribute for tm_cal is needed (at least by NAG) because there are ! pointers to this object inside ESMF_Time objects. type(ESMF_Calendar), target :: tm_cal ! calendar -type(ESMF_Clock) :: tm_clock ! Model clock +type(ESMF_Clock) :: tm_clock ! Model clock type(ESMF_Time) :: tm_perp_date ! perpetual date !========================================================================================= @@ -259,16 +260,18 @@ subroutine set_time_float_from_date( time, year, month, day, sec ) type(ESMF_TimeInterval) :: diff integer :: useday - if ( (calendar==shr_cal_noleap) .and. (month==2) .and. (day==29) ) then ! workaround leap days for NOLEAP cal + if ( ((calendar==shr_cal_noleap).or.(.not.is_leapyear(year))) & + .and. (month==2) .and. (day==29) ) then + ! set day to 28 when the calendar / year does not have a leap day useday = 28 - else + else useday = day endif call ESMF_TimeSet( date, yy=year, mm=month, dd=useday, s=sec, calendar=tm_cal, rc=rc) if ( rc .ne. ESMF_SUCCESS ) then - call chkrc(rc, sub//': error return from ESMF_TimeSet for set_time_float_from_date') + call chkrc(rc, sub//': error return from ESMF_TimeSet for set_time_float_from_date') endif call ESMF_ClockGet(tm_clock, refTime=ref_date, rc=rc ) @@ -314,6 +317,14 @@ subroutine set_date_from_time_float( time, year, month, day, sec ) endsubroutine set_date_from_time_float +!========================================================================================= + +logical function is_leapyear( yr ) + integer, intent(in) :: yr + is_leapyear = (mod(yr, 400) == 0 .or. mod(yr,100) /= 0) .and. mod(yr,4)==0 +end function is_leapyear + + !========================================================================================= integer function TimeGetymd( date, tod ) @@ -550,7 +561,7 @@ subroutine get_curr_date(yr, mon, day, tod, offset) tod ! time of day (seconds past 0Z) integer, optional, intent(in) :: offset ! Offset from current time in seconds. - ! Positive for future times, negative + ! Positive for future times, negative ! for previous times. ! Local variables @@ -594,7 +605,7 @@ subroutine get_perp_date(yr, mon, day, tod, offset) tod ! time of day (seconds past 0Z) integer, optional, intent(in) :: offset ! Offset from current time in seconds. - ! Positive for future times, negative + ! Positive for future times, negative ! for previous times. ! Local variables @@ -829,7 +840,7 @@ function get_curr_calday(offset) ! Arguments integer, optional, intent(in) :: offset ! Offset from current time in seconds. - ! Positive for future times, negative + ! Positive for future times, negative ! for previous times. ! Return value real(r8) :: get_curr_calday @@ -877,7 +888,7 @@ function get_curr_calday(offset) ! ! The zenith angle calculation is only capable of using a 365-day calendar. ! If a Gregorian calendar is being used, the last day of a leap year (day 366) -! is sent to the model as a repetition of the previous day (day 365). +! is sent to the model as a repetition of the previous day (day 365). ! This is done by decrementing calday by 1 immediately below. ! bundy, July 2008 ! @@ -893,7 +904,7 @@ function get_curr_calday(offset) end if end function get_curr_calday - + !========================================================================== ! return julian day function get_julday(yr_in,mon,day,sec) result(julday) @@ -958,7 +969,7 @@ function get_calday(ymd, tod) ! ! The zenith angle calculation is only capable of using a 365-day calendar. ! If a Gregorian calendar is being used, the last day of a leap year (day 366) -! is sent to the model as a repetition of the previous day (day 365). +! is sent to the model as a repetition of the previous day (day 365). ! This is done by decrementing calday by 1 immediately below. ! bundy, July 2008 ! @@ -996,7 +1007,7 @@ end function get_calday end function timemgr_get_calendar_cf !========================================================================================= - + function timemgr_is_caltype( cal_in ) ! Return true if incoming calendar type string matches actual calendar type in use @@ -1012,7 +1023,7 @@ function timemgr_is_caltype( cal_in ) end function timemgr_is_caltype !========================================================================================= - + function is_end_curr_day() ! Return true if current timestep is last timestep in current day. diff --git a/src/utils/zonal_mean_mod.F90 b/src/utils/zonal_mean_mod.F90 new file mode 100644 index 0000000000..25e3f8564a --- /dev/null +++ b/src/utils/zonal_mean_mod.F90 @@ -0,0 +1,2000 @@ +module zonal_mean_mod +!====================================================================== +! +! Purpose: Compute and make use of Zonal Mean values on physgrid +! +! This module implements 3 data structures for the spectral analysis +! and synthesis of zonal mean values based on m=0 spherical harmonics. +! +! ZonalMean_t: For the analysis/synthesis of zonal mean values +! on a 2D grid of points distributed over the +! surface of a sphere. +! ZonalProfile_t: For the analysis/synthesis of zonal mean values +! on a meridional grid that spans the latitudes +! from SP to NP +! ZonalAverage_t: To calculate zonal mean values via a simple +! area weighted bin-averaging of 2D grid points +! assigned to each latitude band. +! +! NOTE: The weighting of the Zonal Profiles values is scaled such +! that ZonalMean_t amplitudes can be used to evaluate values +! on the ZonalProfile_t grid and vice-versa. +! +! The ZonalMean_t computes global integrals to compute basis +! amplitudes. For distributed environments the cost of these +! can be reduced using the The ZonalAverage_t data structures. +! +! USAGE: +! +! (1) Compute Zonal mean amplitudes and synthesize values on 2D/3D physgrid +! +! Usage: type(ZonalMean_t):: ZM +! ========================================= +! call ZM%init(nbas) +! ------------------ +! - Initialize the data structure with 'nbas' basis functions +! for the given physgrid latitudes and areas. +! +! Arguments: +! integer ,intent(in):: nbas -Number of m=0 spherical harmonics +! +! call ZM%calc_amps(Gdata,Bamp) +! ----------------------------- +! - For the initialized ZonalMean_t; Given Gdata() values on the physgrid, +! compute the zonal mean basis amplitudes Bamp(). +! +! Interface: 2D data on the physgrid +! real(r8),intent(in ):: Gdata(pcols,begchunk:endchunk) +! real(r8),intent(out):: Bamp (nbas) +! +! Interface: 3D data on the physgrid +! real(r8),intent(in ):: Gdata(pcols,pver,begchunk:endchunk) +! real(r8),intent(out):: Bamp (nbas,pver) +! +! call ZM%eval_grid(Bamp,Gdata) +! ----------------------------- +! - For the initialized ZonalMean_t; Given Bamp() zonal mean basis +! amplitudes, compute the Gdata() values on the physgrid. +! +! Interface: 2D data on the physgrid +! real(r8),intent(in ):: Bamp (nbas) +! real(r8),intent(out):: Gdata(pcols,begchunk:endchunk) +! +! Interface: 3D data on the physgrid +! real(r8),intent(in ):: Bamp (nbas,pver) +! real(r8),intent(out):: Gdata(pcols,pver,begchunk:endchunk) +! +! +! (2) Compute Zonal mean amplitudes and synthesize values on Zonal profile grid +! +! Usage: type(ZonalProfile_t):: ZP +! ========================================= +! call ZP%init(lats,area,nlat,nbas,GEN_GAUSSLATS=.true.) +! ------------------------------------------------------ +! - Initialize the data structure for the given number of +! latitudes. Either use the given Latitudes and weights, +! or OPTIONALLY create profile gridpoints and associated +! area weights from SP to NP. Then initialize 'nbas' basis +! functions for the profile gridpoints. +! If the user supplies the lats/area values, the area values must +! be correctly scaled such that the global area adds up to 4PI. +! Otherwise, the ampitudes between ZonalProfile_t and ZonalMean_t +! are not interchangable. +! +! Arguments: +! real(r8),intent(inout):: lats(:) - Latitudes of meridional grid. +! real(r8),intent(inout):: area(:) - Area of each meridional gridpoint. +! integer ,intent(in) :: nlat - Number of meridional gridpoints. +! integer ,intent(in) :: nbas - Number of m=0 spherical harmonics +! logical ,intent(in),optional:: GEN_GAUSLATS - Flag to generate +! lats/areas values. +! +! call ZP%calc_amps(Zdata,Bamp) +! ----------------------------- +! - Given Zdata() on the Zonal profile grid, compute the +! zonal basis amplitudes Bamp(). +! +! Interface: 1D data on (nlat) grid +! real(r8),intent(in ):: Zdata(nlat) - Meridional Profile data +! real(r8),intent(out):: Bamp (nbas) - Zonal Basis Amplitudes +! +! Interface: 2D data on (nlat,pver) grid +! real(r8),intent(in ):: Zdata(nlat,pver) - Meridional Profile data +! real(r8),intent(out):: Bamp (nbas,pver) - Zonal Basis Amplitudes +! +! call ZP%eval_grid(Bamp,Zdata) +! ----------------------------- +! - Given Bamp() zonal basis amplitudes, evaluate the Zdata() +! values on the Zonal profile grid. +! +! Interface: 1D data on (nlat) grid +! real(r8),intent(in ):: Bamp (nbas) - Zonal Basis Amplitudes +! real(r8),intent(out):: Zdata(nlat) - Meridional Profile data +! +! Interface: 2D data on (nlat,pver) grid +! real(r8),intent(in ):: Bamp (nbas,pver) - Zonal Basis Amplitudes +! real(r8),intent(out):: Zdata(nlat,pver) - Meridional Profile data +! +! (3) Compute Zonal mean averages (FASTER/LESS-ACCURATE) on Zonal profile grid +! (For the created zonal profile, just bin average area weighted +! 2D/3D physgrid grid values) +! +! Usage: type(ZonalAverage_t):: ZA +! ========================================= +! call ZA%init(lats,area,nlat,GEN_GAUSSLATS=.true.) +! -------------------------------------------------- +! - Given the latitude/area for the nlat meridional gridpoints, initialize +! the ZonalAverage data structure for computing bin-averaging of physgrid +! values. It is assumed that the domain of these gridpoints of the +! profile span latitudes from SP to NP. +! The optional GEN_GAUSSLATS flag allows for the generation of Gaussian +! latitude gridpoints. The generated grid over-writes the given values +! lats and area passed by the user. +! +! Arguments: +! real(r8),intent(inout):: lats(nlat) - Latitudes of meridional grid. +! real(r8),intent(inout):: area(nlat) - Area of meridional gridpoints. +! integer ,intent(in):: nlat - Number of meridional gridpoints +! logical,intent(in),optional:: GEN_GAUSLATS - Flag to generate +! lats/areas values. +! +! call ZA%binAvg(Gdata,Zdata) +! --------------------------- +! - For the initialized ZonalAverage_t; Given Gdata() on the physgrid, +! compute bin averages and return Zdata() on the Zonal profile grid. +! +! Interface: 2D data on the physgrid +! real(r8),intent(out):: Gdata(pcols,begchunk:endchunk) +! real(r8),intent(out):: Zdata(nlat) +! +! Interface: 3D data on the physgrid +! real(r8),intent(out):: Gdata(pcols,pver,begchunk:endchunk) +! real(r8),intent(out):: Zdata(nlat,pver) +! +!====================================================================== + + use shr_kind_mod, only: r8=>SHR_KIND_R8 + use phys_grid, only: get_ncols_p, get_rlat_p, get_wght_all_p, get_nlcols_p + use ppgrid, only: begchunk, endchunk, pcols + use shr_reprosum_mod,only: shr_reprosum_calc + use cam_abortutils, only: endrun, handle_allocate_error + use spmd_utils, only: mpicom + use physconst, only: pi + use phys_grid, only: ngcols_p => num_global_phys_cols + use cam_logfile, only: iulog + + implicit none + private + + public :: ZonalMean_t + public :: ZonalProfile_t + public :: ZonalAverage_t + + ! Type definitions + !------------------- + type ZonalMean_t + private + integer :: nbas + real(r8),allocatable:: area (:,:) + real(r8),allocatable:: basis(:,:,:) + real(r8),allocatable:: map (:,:) + contains + procedure,pass:: init => init_ZonalMean + generic,public:: calc_amps => calc_ZonalMean_2Damps, & + calc_ZonalMean_3Damps + generic,public:: eval_grid => eval_ZonalMean_2Dgrid, & + eval_ZonalMean_3Dgrid + procedure,private,pass:: calc_ZonalMean_2Damps + procedure,private,pass:: calc_ZonalMean_3Damps + procedure,private,pass:: eval_ZonalMean_2Dgrid + procedure,private,pass:: eval_ZonalMean_3Dgrid + procedure, pass :: final => final_ZonalMean + end type ZonalMean_t + + type ZonalProfile_t + private + integer :: nlat + integer :: nbas + real(r8),allocatable:: area (:) + real(r8),allocatable:: basis(:,:) + real(r8),allocatable:: map (:,:) + contains + procedure,pass:: init => init_ZonalProfile + generic,public:: calc_amps => calc_ZonalProfile_1Damps, & + calc_ZonalProfile_2Damps + generic,public:: eval_grid => eval_ZonalProfile_1Dgrid, & + eval_ZonalProfile_2Dgrid + procedure,private,pass:: calc_ZonalProfile_1Damps + procedure,private,pass:: calc_ZonalProfile_2Damps + procedure,private,pass:: eval_ZonalProfile_1Dgrid + procedure,private,pass:: eval_ZonalProfile_2Dgrid + procedure, pass :: final => final_ZonalProfile + end type ZonalProfile_t + + type ZonalAverage_t + private + integer :: nlat + real(r8),allocatable:: area (:) + real(r8),allocatable:: a_norm (:) + real(r8),allocatable:: area_g (:,:) + integer ,allocatable:: idx_map(:,:) + contains + procedure,pass:: init => init_ZonalAverage + generic,public:: binAvg => calc_ZonalAverage_2DbinAvg, & + calc_ZonalAverage_3DbinAvg + procedure,private,pass:: calc_ZonalAverage_2DbinAvg + procedure,private,pass:: calc_ZonalAverage_3DbinAvg + procedure, pass :: final => final_ZonalAverage + end type ZonalAverage_t + + real(r8), parameter :: halfPI = 0.5_r8*pi + real(r8), parameter :: twoPI = 2.0_r8*pi + real(r8), parameter :: fourPI = 4.0_r8*pi + real(r8), parameter :: qrtrPI = 0.25_r8*pi + real(r8), parameter :: invSqrt4pi = 1._r8/sqrt(fourPI) + +contains + !======================================================================= + subroutine init_ZonalMean(this,I_nbas) + ! + ! init_ZonalMean: Initialize the ZonalMean data structures for the + ! physics grid. It is assumed that the domain + ! of these gridpoints spans the surface of the sphere. + ! The representation of basis functions is + ! normalized w.r.t integration over the sphere. + !===================================================================== + ! + ! Passed Variables + !------------------ + class(ZonalMean_t) :: this + integer ,intent(in):: I_nbas + ! + ! Local Values + !-------------- + real(r8),allocatable:: Clats(:,:) + real(r8),allocatable:: Bcoef(:) + real(r8),allocatable:: Csum (:,:) + real(r8),allocatable:: Cvec (:) + real(r8),allocatable:: Bsum (:,:) + real(r8),allocatable:: Bnorm(:) + real(r8),allocatable:: Bcov (:,:) + real(r8):: area(pcols),rlat + + integer :: nn,n2,nb,lchnk,ncols,cc + integer :: cnum,Cvec_len + + integer :: nlcols, count, astat + character(len=*), parameter :: subname = 'init_ZonalMean' + + if (I_nbas<1) then + call endrun('ZonalMean%init: ERROR I_nbas must be greater than 0') + end if + + ! Allocate space + !----------------- + if(allocated(this%area )) deallocate(this%area) + if(allocated(this%basis)) deallocate(this%basis) + if(allocated(this%map )) deallocate(this%map) + + this%nbas = I_nbas + allocate(this%area (pcols,begchunk:endchunk), stat=astat) + call handle_allocate_error(astat, subname, 'this%area') + allocate(this%basis(pcols,begchunk:endchunk,I_nbas), stat=astat) + call handle_allocate_error(astat, subname, 'this%basis') + allocate(this%map (I_nbas,I_nbas), stat=astat) + call handle_allocate_error(astat, subname, 'this%map') + this%area (:,:) = 0._r8 + this%basis(:,:,:) = 0._r8 + this%map (:,:) = 0._r8 + + Cvec_len = 0 + do nn= 1,this%nbas + do n2=nn,this%nbas + Cvec_len = Cvec_len + 1 + end do + end do + + nlcols = get_nlcols_p() + + allocate(Clats(pcols,begchunk:endchunk), stat=astat) + call handle_allocate_error(astat, subname, 'Clats') + allocate(Bcoef(I_nbas/2+1), stat=astat) + call handle_allocate_error(astat, subname, 'Bcoef') + allocate(Csum (nlcols, Cvec_len), stat=astat) + call handle_allocate_error(astat, subname, 'Csum') + allocate(Cvec (Cvec_len), stat=astat) + call handle_allocate_error(astat, subname, 'Cvec') + allocate(Bsum (nlcols, I_nbas), stat=astat) + call handle_allocate_error(astat, subname, 'Bsum') + allocate(Bnorm(I_nbas), stat=astat) + call handle_allocate_error(astat, subname, 'Bnorm') + allocate(Bcov (I_nbas,I_nbas), stat=astat) + call handle_allocate_error(astat, subname, 'Bcov') + + Bsum(:,:) = 0._r8 + Csum(:,:) = 0._r8 + + ! Save a copy of the area weights for each ncol gridpoint + ! and convert Latitudes to SP->NP colatitudes in radians + !------------------------------------------------------- + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + call get_wght_all_p(lchnk, ncols, area) + do cc = 1,ncols + rlat=get_rlat_p(lchnk,cc) + this%area(cc,lchnk) = area(cc) + Clats (cc,lchnk) = rlat + halfPI + end do + end do + + ! Add first basis for the mean values. + !------------------------------------------ + this%basis(:,begchunk:endchunk,1) = invSqrt4pi + + ! Loop over the remaining basis functions + !--------------------------------------- + do nn=2,this%nbas + nb = nn-1 + + ! Generate coefs for the basis + !------------------------------ + call sh_gen_basis_coefs(nb,0,Bcoef) + + ! Create basis for the coefs at each ncol gridpoint + !--------------------------------------------------- + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + do cc = 1,ncols + call sh_create_basis(nb,0,Clats(cc,lchnk),Bcoef,this%basis(cc,lchnk,nn)) + end do + end do + end do ! nn=2,this%nbas + + ! Numerically normalize the basis funnctions + !-------------------------------------------------------------- + do nn=1,this%nbas + count = 0 + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + do cc = 1,ncols + count=count+1 + Bsum(count,nn) = this%basis(cc,lchnk,nn)*this%basis(cc,lchnk,nn)*this%area(cc,lchnk) + end do + end do + end do ! nn=1,this%nbas + + call shr_reprosum_calc(Bsum, Bnorm, count, nlcols, this%nbas, gbl_count=ngcols_p, commid=mpicom) + + do nn=1,this%nbas + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + this%basis(:ncols,lchnk,nn) = this%basis(:ncols,lchnk,nn)/sqrt(Bnorm(nn)) + end do + end do ! nn=1,this%nbas + + ! Compute covariance matrix for basis functions + ! (Yes, they are theoretically orthonormal, but lets make sure) + !--------------------------------------------------------------- + cnum = 0 + do nn= 1,this%nbas + do n2=nn,this%nbas + cnum = cnum + 1 + count = 0 + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + do cc = 1,ncols + count=count+1 + Csum(count,cnum) = this%basis(cc,lchnk,nn)*this%basis(cc,lchnk,n2)*this%area(cc,lchnk) + end do + end do + + end do + end do + + call shr_reprosum_calc(Csum, Cvec, count, nlcols, Cvec_len, gbl_count=ngcols_p, commid=mpicom) + + cnum = 0 + do nn= 1,this%nbas + do n2=nn,this%nbas + cnum = cnum + 1 + Bcov(nn,n2) = Cvec(cnum) + Bcov(n2,nn) = Cvec(cnum) + end do + end do + + ! Invert to get the basis amplitude map + !-------------------------------------- + call Invert_Matrix(Bcov,this%nbas,this%map) + + ! End Routine + !------------ + deallocate(Clats) + deallocate(Bcoef) + deallocate(Csum ) + deallocate(Cvec ) + deallocate(Bsum ) + deallocate(Bnorm) + deallocate(Bcov ) + + end subroutine init_ZonalMean + !======================================================================= + + + !======================================================================= + subroutine calc_ZonalMean_2Damps(this,I_Gdata,O_Bamp) + ! + ! calc_ZonalMean_2Damps: Given 2D data values for the ncol gridpoints, + ! compute the zonal mean basis amplitudes. + !===================================================================== + ! + ! Passed Variables + !------------------ + class(ZonalMean_t) :: this + real(r8),intent(in ) :: I_Gdata(pcols,begchunk:endchunk) + real(r8),intent(out) :: O_Bamp(:) + ! + ! Local Values + !-------------- + real(r8),allocatable :: Csum(:,:) + real(r8),allocatable :: Gcov(:) + integer :: nn,n2,ncols,lchnk,cc + integer :: nlcols, count, astat + + character(len=*), parameter :: subname = 'calc_ZonalMean_2Damps' + + nlcols = get_nlcols_p() + + allocate(Gcov(this%nbas), stat=astat) + call handle_allocate_error(astat, subname, 'Gcov') + allocate(Csum(nlcols, this%nbas), stat=astat) + call handle_allocate_error(astat, subname, 'Csum') + Csum(:,:) = 0._r8 + + ! Compute Covariance with input data and basis functions + !-------------------------------------------------------- + do nn= 1,this%nbas + count = 0 + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + do cc = 1,ncols + count=count+1 + Csum(count,nn) = I_Gdata(cc,lchnk)*this%basis(cc,lchnk,nn)*this%area(cc,lchnk) + end do + end do + end do + + call shr_reprosum_calc(Csum, Gcov, count, nlcols, this%nbas, gbl_count=ngcols_p, commid=mpicom) + + ! Multiply by map to get the amplitudes + !------------------------------------------- + do nn=1,this%nbas + O_Bamp(nn) = 0._r8 + do n2=1,this%nbas + O_Bamp(nn) = O_Bamp(nn) + this%map(n2,nn)*Gcov(n2) + end do + end do + + ! End Routine + !------------ + deallocate(Csum) + deallocate(Gcov) + + end subroutine calc_ZonalMean_2Damps + !======================================================================= + + + !======================================================================= + subroutine calc_ZonalMean_3Damps(this,I_Gdata,O_Bamp) + ! + ! calc_ZonalMean_3Damps: Given 3D data values for the ncol,nlev gridpoints, + ! compute the zonal mean basis amplitudes. + !===================================================================== + ! + ! Passed Variables + !------------------ + class(ZonalMean_t) :: this + real(r8),intent(in ):: I_Gdata(:,:,begchunk:) + real(r8),intent(out):: O_Bamp (:,:) + ! + ! Local Values + !-------------- + real(r8),allocatable:: Csum (:,:) + real(r8),allocatable:: Gcov (:) + integer:: nn,n2,ncols,lchnk,cc + integer:: Nsum,ns,ll + integer :: nlcols, count, astat + + integer :: nlev + character(len=*), parameter :: subname = 'calc_ZonalMean_3Damps' + + nlev = size(I_Gdata,dim=2) + + nlcols = get_nlcols_p() + allocate(Gcov(this%nbas), stat=astat) + call handle_allocate_error(astat, subname, 'Gcov') + allocate(Csum(nlcols, this%nbas), stat=astat) + call handle_allocate_error(astat, subname, 'Csum') + + Csum(:,:) = 0._r8 + O_Bamp(:,:) = 0._r8 + + ! Compute Covariance with input data and basis functions + !-------------------------------------------------------- + do ll= 1,nlev + + Csum(:,:) = 0._r8 + Gcov(:) = 0._r8 + + do nn= 1,this%nbas + count = 0 + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + do cc = 1,ncols + count=count+1 + Csum(count,nn) = I_Gdata(cc,ll,lchnk)*this%basis(cc,lchnk,nn)*this%area(cc,lchnk) + end do + end do + end do + + call shr_reprosum_calc(Csum, Gcov, count, nlcols, this%nbas, gbl_count=ngcols_p, commid=mpicom) + + ! Multiply by map to get the amplitudes + !------------------------------------------- + do nn=1,this%nbas + O_Bamp(nn,ll) = 0._r8 + do n2=1,this%nbas + O_Bamp(nn,ll) = O_Bamp(nn,ll) + this%map(n2,nn)*Gcov(n2) + end do + end do + + end do + + ! End Routine + !------------ + deallocate(Csum) + deallocate(Gcov) + + end subroutine calc_ZonalMean_3Damps + !======================================================================= + + + !======================================================================= + subroutine eval_ZonalMean_2Dgrid(this,I_Bamp,O_Gdata) + ! + ! eval_ZonalMean_2Dgrid: Given the zonal mean basis amplitudes, + ! compute 2D data values for the ncol gridpoints. + !===================================================================== + ! + ! Passed Variables + !------------------ + class(ZonalMean_t) :: this + real(r8),intent(in ):: I_Bamp (:) + real(r8),intent(out):: O_Gdata(pcols,begchunk:endchunk) + ! + ! Local Values + !-------------- + integer:: nn,ncols,lchnk,cc + + O_Gdata(:,:) = 0._r8 + + ! Construct grid values from basis amplitudes. + !-------------------------------------------------- + + do nn=1,this%nbas + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + do cc = 1,ncols + O_Gdata(cc,lchnk) = O_Gdata(cc,lchnk) + (I_Bamp(nn)*this%basis(cc,lchnk,nn)) + end do + end do + end do + + end subroutine eval_ZonalMean_2Dgrid + !======================================================================= + + + !======================================================================= + subroutine eval_ZonalMean_3Dgrid(this,I_Bamp,O_Gdata) + ! + ! eval_ZonalMean_3Dgrid: Given the zonal mean basis amplitudes, + ! compute 3D data values for the ncol,nlev gridpoints. + !===================================================================== + ! + ! Passed Variables + !------------------ + class(ZonalMean_t) :: this + real(r8),intent(in ):: I_Bamp (:,:) + real(r8),intent(out):: O_Gdata(:,:,begchunk:) + ! + ! Local Values + !-------------- + integer:: nn,ncols,lchnk,cc + integer:: ll + + integer :: nlev + nlev = size(O_Gdata,dim=2) + + O_Gdata(:,:,:) = 0._r8 + + ! Construct grid values from basis amplitudes. + !-------------------------------------------------- + + do ll = 1,nlev + do nn=1,this%nbas + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + do cc = 1,ncols + O_Gdata(cc,ll,lchnk) = O_Gdata(cc,ll,lchnk) + (I_Bamp(nn,ll)*this%basis(cc,lchnk,nn)) + end do + end do + end do + end do + + end subroutine eval_ZonalMean_3Dgrid + !======================================================================= + + !======================================================================= + subroutine final_ZonalMean(this) + class(ZonalMean_t) :: this + + if(allocated(this%area )) deallocate(this%area) + if(allocated(this%basis)) deallocate(this%basis) + if(allocated(this%map )) deallocate(this%map) + + end subroutine final_ZonalMean + !======================================================================= + + !======================================================================= + subroutine init_ZonalProfile(this,IO_lats,IO_area,I_nlat,I_nbas,GEN_GAUSSLATS) + ! + ! init_ZonalProfile: Initialize the ZonalProfile data structure for the + ! given nlat gridpoints. It is assumed that the domain + ! of these gridpoints of the profile span latitudes + ! from SP to NP. + ! The representation of basis functions functions is + ! normalized w.r.t integration over the sphere so that + ! when configured for tha same number of basis functions, + ! the calculated amplitudes are interchangable with + ! those for the ZonalMean_t class. + ! + ! The optional GEN_GAUSSLATS flag allows for the + ! generation of Gaussian latitudes. The generated grid + ! over-writes the values of IO_lats/IO_area passed by + ! the user. + !===================================================================== + ! + ! Passed Variables + !------------------ + class(ZonalProfile_t) :: this + real(r8) ,intent(inout):: IO_lats(:) + real(r8) ,intent(inout):: IO_area(:) + integer ,intent(in):: I_nlat + integer ,intent(in):: I_nbas + logical,optional,intent(in):: GEN_GAUSSLATS + ! + ! Local Values + !-------------- + real(r8),allocatable:: Clats(:) + real(r8),allocatable:: Bcoef(:) + real(r8),allocatable:: Bcov (:,:) + real(r8):: Bnorm + integer :: ii,nn,n2,nb,ierr, astat + logical :: generate_lats + + character(len=*), parameter :: subname = 'init_ZonalProfile' + + generate_lats = .false. + + if (present(GEN_GAUSSLATS)) then + generate_lats = GEN_GAUSSLATS + end if + + ! Allocate space + !----------------- + if(allocated(this%area )) deallocate(this%area) + if(allocated(this%basis)) deallocate(this%basis) + if(allocated(this%map )) deallocate(this%map) + + this%nlat = I_nlat + this%nbas = I_nbas + allocate(this%area (I_nlat), stat=astat) + call handle_allocate_error(astat, subname, 'this%area') + allocate(this%basis(I_nlat,I_nbas), stat=astat) + call handle_allocate_error(astat, subname, 'this%basis') + allocate(this%map (I_nbas,I_nbas), stat=astat) + call handle_allocate_error(astat, subname, 'this%map') + + allocate(Clats(I_nlat), stat=astat) + call handle_allocate_error(astat, subname, 'Clats') + allocate(Bcoef(I_nbas/2+1), stat=astat) + call handle_allocate_error(astat, subname, 'Bcoef') + allocate(Bcov (I_nbas,I_nbas), stat=astat) + call handle_allocate_error(astat, subname, 'Bcov') + + ! Optionally create the Latitude Gridpoints + ! and their associated area weights. Otherwise + ! they need to be supplied by the user. + !----------------------------------------------- + if(generate_lats) then + + ! Create a Gaussian grid from SP to NP + !-------------------------------------- + call sh_create_gaus_grid(I_nlat,Clats,IO_area,ierr) + if (ierr/=0) then + call endrun('init_ZonalProfile: Error creating Gaussian grid') + end if + + ! Convert generated colatitudes SP->NP to Lats and convert + ! to degrees and scale the area for global 2D integrals + !----------------------------------------------------------- + do nn=1,I_nlat + IO_lats(nn) = (45._r8*Clats(nn)/qrtrPI) - 90._r8 + IO_area(nn) = IO_area(nn)*twoPI + end do + else + ! Convert Latitudes to SP->NP colatitudes in radians + !---------------------------------------------------- + do nn=1,I_nlat + Clats(nn) = (IO_lats(nn) + 90._r8)*qrtrPI/45._r8 + end do + endif + + ! Copy the area weights for each nlat + ! gridpoint to the data structure + !--------------------------------------- + this%area(1:I_nlat) = IO_area(1:I_nlat) + + ! Add first basis for the mean values. + !------------------------------------------ + this%basis(:,1) = invSqrt4pi + Bnorm = 0._r8 + do ii=1,I_nlat + Bnorm = Bnorm + (this%basis(ii,1)*this%basis(ii,1)*this%area(ii)) + end do + this%basis(:,1) = this%basis(:,1)/sqrt(Bnorm) + + ! Loop over the remaining basis functions + !--------------------------------------- + do nn=2,I_nbas + nb = nn-1 + + ! Generate coefs for the basis + !------------------------------ + call sh_gen_basis_coefs(nb,0,Bcoef) + + ! Create an un-normalized basis for the + ! coefs at each nlat gridpoint + !--------------------------------------- + do ii=1,I_nlat + call sh_create_basis(nb,0,Clats(ii),Bcoef,this%basis(ii,nn)) + end do + + ! Numerically normalize the basis funnction + !-------------------------------------------------------------- + Bnorm = 0._r8 + do ii=1,I_nlat + Bnorm = Bnorm + (this%basis(ii,nn)*this%basis(ii,nn)*this%area(ii)) + end do + this%basis(:,nn) = this%basis(:,nn)/sqrt(Bnorm) + + end do ! nn=1,I_nbas + + ! Compute covariance matrix for basis functions + ! (Yes, they are theoretically orthonormal, but lets make sure) + !-------------------------------------------------------------- + do nn=1,I_nbas + do n2=1,I_nbas + Bcov(nn,n2) = 0._r8 + do ii=1,I_nlat + Bcov(nn,n2) = Bcov(nn,n2) + (this%basis(ii,nn)*this%basis(ii,n2)*this%area(ii)) + end do + end do + end do + + ! Invert to get the basis amplitude map + !-------------------------------------- + call Invert_Matrix(Bcov,I_nbas,this%map) + + ! End Routine + !------------ + deallocate(Clats) + deallocate(Bcoef) + deallocate(Bcov ) + + end subroutine init_ZonalProfile + !======================================================================= + + + !======================================================================= + subroutine calc_ZonalProfile_1Damps(this,I_Zdata,O_Bamp) + ! + ! calc_ZonalProfile_1Damps: Given 1D data values for the nlat zonal + ! profiles gridpoints, compute the zonal + ! profile basis amplitudes. + !===================================================================== + ! + ! Passed Variables + !------------------ + class(ZonalProfile_t):: this + real(r8),intent(in ):: I_Zdata(:) + real(r8),intent(out):: O_Bamp (:) + ! + ! Local Values + !-------------- + real(r8),allocatable:: Gcov(:) + integer:: ii,nn,n2, astat + character(len=*), parameter :: subname = 'calc_ZonalProfile_1Damps' + + ! Compute Covariance with input data and basis functions + !-------------------------------------------------------- + allocate(Gcov(this%nbas), stat=astat) + call handle_allocate_error(astat, subname, 'Gcov') + do nn=1,this%nbas + Gcov(nn) = 0._r8 + do ii=1,this%nlat + Gcov(nn) = Gcov(nn) + (I_Zdata(ii)*this%basis(ii,nn)*this%area(ii)) + end do + end do + + ! Multiply by map to get the amplitudes + !------------------------------------------- + do nn=1,this%nbas + O_Bamp(nn) = 0._r8 + do n2=1,this%nbas + O_Bamp(nn) = O_Bamp(nn) + this%map(n2,nn)*Gcov(n2) + end do + end do + + deallocate(Gcov) + + end subroutine calc_ZonalProfile_1Damps + !======================================================================= + + + !======================================================================= + subroutine calc_ZonalProfile_2Damps(this,I_Zdata,O_Bamp) + ! + ! calc_ZonalProfile_2Damps: Given 2D data values for the nlat,nlev zonal + ! profiles gridpoints, compute the zonal + ! profile basis amplitudes. + !===================================================================== + ! + ! Passed Variables + !------------------ + class(ZonalProfile_t):: this + real(r8),intent(in ):: I_Zdata(:,:) + real(r8),intent(out):: O_Bamp (:,:) + ! + ! Local Values + !-------------- + real(r8),allocatable:: Gcov(:,:) + integer:: ii,nn,n2,ilev + + integer :: nlev, astat + character(len=*), parameter :: subname = 'calc_ZonalProfile_2Damps' + + nlev = size(I_Zdata,dim=2) + + ! Compute Covariance with input data and basis functions + !-------------------------------------------------------- + allocate(Gcov(this%nbas,nlev), stat=astat) + call handle_allocate_error(astat, subname, 'Gcov') + do ilev=1,nlev + do nn=1,this%nbas + Gcov(nn,ilev) = 0._r8 + do ii=1,this%nlat + Gcov(nn,ilev) = Gcov(nn,ilev) + (I_Zdata(ii,ilev)*this%basis(ii,nn)*this%area(ii)) + end do + end do + end do + + ! Multiply by map to get the amplitudes + !------------------------------------------- + do ilev=1,nlev + do nn=1,this%nbas + O_Bamp(nn,ilev) = 0._r8 + do n2=1,this%nbas + O_Bamp(nn,ilev) = O_Bamp(nn,ilev) + this%map(n2,nn)*Gcov(n2,ilev) + end do + end do + end do + deallocate(Gcov) + + end subroutine calc_ZonalProfile_2Damps + !======================================================================= + + + !======================================================================= + subroutine eval_ZonalProfile_1Dgrid(this,I_Bamp,O_Zdata) + ! + ! eval_ZonalProfile_1Dgrid: Given the zonal profile basis amplitudes, + ! compute 1D data values for the nlat gridpoints. + !===================================================================== + ! + ! Passed Variables + !------------------ + class(ZonalProfile_t):: this + real(r8),intent(in ):: I_Bamp (:) + real(r8),intent(out):: O_Zdata(:) + ! + ! Local Values + !-------------- + integer:: ii,nn + + ! Construct grid values from basis amplitudes. + !-------------------------------------------------- + O_Zdata(1:this%nlat) = 0._r8 + do nn=1,this%nbas + do ii=1,this%nlat + O_Zdata(ii) = O_Zdata(ii) + (I_Bamp(nn)*this%basis(ii,nn)) + end do + end do + + end subroutine eval_ZonalProfile_1Dgrid + !======================================================================= + + + !======================================================================= + subroutine eval_ZonalProfile_2Dgrid(this,I_Bamp,O_Zdata) + ! + ! eval_ZonalProfile_2Dgrid: Given the zonal profile basis amplitudes, + ! compute 2D data values for the nlat,nlev gridpoints. + !===================================================================== + ! + ! Passed Variables + !------------------ + class(ZonalProfile_t):: this + real(r8),intent(in ):: I_Bamp (:,:) + real(r8),intent(out):: O_Zdata(:,:) + ! + ! Local Values + !-------------- + integer:: ii,nn,ilev + + integer :: nlev + + nlev = size(I_Bamp,dim=2) + + ! Construct grid values from basis amplitudes. + !-------------------------------------------------- + O_Zdata(1:this%nlat,1:nlev) = 0._r8 + do nn=1,this%nbas + do ilev=1,nlev + do ii=1,this%nlat + O_Zdata(ii,ilev) = O_Zdata(ii,ilev) + (I_Bamp(nn,ilev)*this%basis(ii,nn)) + end do + end do + end do + + end subroutine eval_ZonalProfile_2Dgrid + !======================================================================= + + !======================================================================= + subroutine final_ZonalProfile(this) + class(ZonalProfile_t) :: this + + if(allocated(this%area )) deallocate(this%area) + if(allocated(this%basis)) deallocate(this%basis) + if(allocated(this%map )) deallocate(this%map) + + end subroutine final_ZonalProfile + !======================================================================= + + !======================================================================= + subroutine init_ZonalAverage(this,IO_lats,IO_area,I_nlat,GEN_GAUSSLATS) + ! + ! init_ZonalAverage: Initialize the ZonalAverage data structure for the + ! given nlat gridpoints. It is assumed that the domain + ! of these gridpoints of the profile span latitudes + ! from SP to NP. + ! + ! The optional GEN_GAUSSLATS flag allows for the + ! generation of Gaussian latitudes. The generated grid + ! over-writes the values of IO_lats/IO_area passed by + ! the user. + !===================================================================== + ! + ! Passed Variables + !------------------ + class(ZonalAverage_t) :: this + real(r8) ,intent(inout):: IO_lats(:) + real(r8) ,intent(inout):: IO_area(:) + integer ,intent(in):: I_nlat + logical,optional,intent(in):: GEN_GAUSSLATS + ! + ! Local Values + !-------------- + real(r8),allocatable:: Clats (:) + real(r8),allocatable:: Glats (:,:) + real(r8),allocatable:: BinLat(:) + real(r8),allocatable:: Asum (:,:) + real(r8),allocatable:: Anorm (:) + real(r8):: area(pcols),rlat + integer :: nn,jj,ierr, astat + integer :: ncols,lchnk,cc,jlat + integer :: nlcols, count + logical :: generate_lats + character(len=*), parameter :: subname = 'init_ZonalAverage' + + generate_lats = .false. + + if (present(GEN_GAUSSLATS)) then + generate_lats = GEN_GAUSSLATS + end if + + nlcols = get_nlcols_p() + + ! Allocate space + !----------------- + if(allocated(this%area )) deallocate(this%area) + if(allocated(this%a_norm )) deallocate(this%a_norm) + if(allocated(this%area_g )) deallocate(this%area_g) + if(allocated(this%idx_map)) deallocate(this%idx_map) + + this%nlat = I_nlat + allocate(this%area (I_nlat), stat=astat) + call handle_allocate_error(astat, subname, 'this%area') + allocate(this%a_norm (I_nlat), stat=astat) + call handle_allocate_error(astat, subname, 'this%a_norm') + allocate(this%area_g (pcols,begchunk:endchunk), stat=astat) + call handle_allocate_error(astat, subname, 'this%area_g') + allocate(this%idx_map(pcols,begchunk:endchunk), stat=astat) + call handle_allocate_error(astat, subname, 'this%idx_map') + + allocate(Clats (I_nlat), stat=astat) + call handle_allocate_error(astat, subname, 'Clats') + allocate(BinLat(I_nlat+1), stat=astat) + call handle_allocate_error(astat, subname, 'BinLat') + allocate(Glats (pcols,begchunk:endchunk), stat=astat) + call handle_allocate_error(astat, subname, 'Glats') + allocate(Asum (nlcols,I_nlat), stat=astat) + call handle_allocate_error(astat, subname, 'Asum') + allocate(Anorm (I_nlat), stat=astat) + call handle_allocate_error(astat, subname, 'Anorm') + + ! Optionally create the Latitude Gridpoints + ! and their associated area weights. Otherwise + ! they need to be supplied by the user. + !----------------------------------------------- + if(generate_lats) then + + ! Create a Gaussin grid from SP to NP + !-------------------------------------- + call sh_create_gaus_grid(this%nlat,Clats,IO_area,ierr) + if (ierr/=0) then + call endrun('init_ZonalAverage: Error creating Gaussian grid') + end if + + ! Convert generated colatitudes SP->NP to Lats and convert + ! to degrees and scale the area for global 2D integrals + !----------------------------------------------------------- + do nn=1,this%nlat + IO_lats(nn) = (45._r8*Clats(nn)/qrtrPI) - 90._r8 + IO_area(nn) = IO_area(nn)*twoPI + end do + else + ! Convert Latitudes to SP->NP colatitudes in radians + !---------------------------------------------------- + do nn=1,this%nlat + Clats(nn) = (IO_lats(nn) + 90._r8)*qrtrPI/45._r8 + end do + endif + + ! Copy the Lat grid area weights to the data structure + !----------------------------------------------------- + this%area(1:this%nlat) = IO_area(1:this%nlat) + + ! Save a copy of the area weights for each 2D gridpoint + ! and convert Latitudes to SP->NP colatitudes in radians + !------------------------------------------------------- + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + call get_wght_all_p(lchnk, ncols, area) + do cc = 1,ncols + rlat=get_rlat_p(lchnk,cc) + this%area_g(cc,lchnk) = area(cc) + Glats (cc,lchnk) = rlat + halfPI + end do + end do + + ! Set boundaries for Latitude bins + !----------------------------------- + BinLat(1) = 0._r8 + BinLat(this%nlat+1) = pi + do nn=2,this%nlat + BinLat(nn) = (Clats(nn-1)+Clats(nn))/2._r8 + end do + + ! Loop over 2D gridpoints and determine its lat bin index + !--------------------------------------------------------- + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + do cc = 1,ncols + jlat = -1 + if((Glats(cc,lchnk)<=BinLat(2)).and. & + (Glats(cc,lchnk)>=BinLat(1)) ) then + jlat = 1 + elseif((Glats(cc,lchnk)>=BinLat(this%nlat) ).and. & + (Glats(cc,lchnk)<=BinLat(this%nlat+1)) ) then + jlat = this%nlat + else + do jj=2,(this%nlat-1) + if((Glats(cc,lchnk)>BinLat(jj )).and. & + (Glats(cc,lchnk)<=BinLat(jj+1)) ) then + jlat = jj + exit + endif + end do + endif + if (jlat<1) then + call endrun('ZonalAverage init ERROR: jlat not in range') + endif + this%idx_map(cc,lchnk) = jlat + end do + end do + + ! Initialize 2D Area sums for each bin + !-------------------------------------- + Asum(:,:) = 0._r8 + Anorm(:) = 0._r8 + count = 0 + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + do cc = 1,ncols + jlat = this%idx_map(cc,lchnk) + count=count+1 + Asum(count,jlat) = this%area_g(cc,lchnk) + end do + end do + + call shr_reprosum_calc(Asum, Anorm, count, nlcols, I_nlat, gbl_count=ngcols_p, commid=mpicom) + + this%a_norm = Anorm + + if (.not.all(Anorm(:)>0._r8)) then + write(iulog,*) 'init_ZonalAverage -- ERROR in Anorm values: ' + do jlat = 1,I_nlat + if (.not.Anorm(jlat)>0._r8) then + write(iulog,*) ' Anorm(',jlat,'): ', Anorm(jlat) + endif + end do + call endrun('init_ZonalAverage -- ERROR in Anorm values') + end if + + ! End Routine + !------------ + deallocate(Clats) + deallocate(BinLat) + deallocate(Glats) + deallocate(Asum) + deallocate(Anorm) + + end subroutine init_ZonalAverage + !======================================================================= + + + !======================================================================= + subroutine calc_ZonalAverage_2DbinAvg(this,I_Gdata,O_Zdata) + ! + ! calc_ZonalAverage_2DbinAvg: Given 2D data values for ncol gridpoints, + ! compute the nlat area weighted binAvg profile + !===================================================================== + ! + ! Passed Variables + !------------------ + class(ZonalAverage_t):: this + real(r8),intent(in ):: I_Gdata(pcols,begchunk:endchunk) + real(r8),intent(out):: O_Zdata(:) + ! + ! Local Values + !-------------- + real(r8),allocatable:: Asum (:,:) + integer:: nn,ncols,lchnk,cc,jlat + integer :: nlcols, count, astat + character(len=*), parameter :: subname = 'calc_ZonalAverage_2DbinAvg' + + nlcols = get_nlcols_p() + + + ! Initialize Zonal profile + !--------------------------- + allocate(Asum(nlcols,this%nlat), stat=astat) + call handle_allocate_error(astat, subname, 'Asum') + Asum(:,:) = 0._r8 + + O_Zdata(1:this%nlat) = 0._r8 + + ! Compute area-weighted sums + !----------------------------- + count = 0 + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + do cc = 1,ncols + jlat = this%idx_map(cc,lchnk) + count=count+1 + Asum(count,jlat) = I_Gdata(cc,lchnk)*this%area_g(cc,lchnk) + end do + end do + + call shr_reprosum_calc(Asum,O_Zdata,count, nlcols, this%nlat,gbl_count=ngcols_p, commid=mpicom) + + ! Divide by area norm to get the averages + !----------------------------------------- + do nn=1,this%nlat + O_Zdata(nn) = O_Zdata(nn)/this%a_norm(nn) + end do + + deallocate(Asum) + + end subroutine calc_ZonalAverage_2DbinAvg + !======================================================================= + + + !======================================================================= + subroutine calc_ZonalAverage_3DbinAvg(this,I_Gdata,O_Zdata) + ! + ! calc_ZonalAverage_3DbinAvg: Given 3D data values for ncol,nlev gridpoints, + ! compute the nlat,nlev area weighted binAvg profile + !===================================================================== + ! + ! Passed Variables + !------------------ + class(ZonalAverage_t):: this + real(r8),intent(in ):: I_Gdata(:,:,begchunk:) + real(r8),intent(out):: O_Zdata(:,:) + ! + ! Local Values + !-------------- + real(r8),allocatable:: Gsum(:) + real(r8),allocatable:: Asum(:,:) + integer:: nn,ncols,lchnk,cc,jlat + integer:: Nsum,ilev,ns + + integer :: nlev + integer :: nlcols, count, astat + character(len=*), parameter :: subname = 'calc_ZonalAverage_3DbinAvg' + + nlev = size(I_Gdata,dim=2) + nlcols = get_nlcols_p() + + ! Initialize Zonal profile + !--------------------------- + Nsum = this%nlat*nlev + allocate(Gsum(Nsum), stat=astat) + call handle_allocate_error(astat, subname, 'Gsum') + allocate(Asum(nlcols,Nsum), stat=astat) + call handle_allocate_error(astat, subname, 'Asum') + Asum(:,:) = 0._r8 + + O_Zdata(1:this%nlat,1:nlev) = 0._r8 + + ! Compute area-weighted sums + !----------------------------- + do ilev = 1,nlev + count = 0 + do lchnk=begchunk,endchunk + ncols = get_ncols_p(lchnk) + do cc = 1,ncols + jlat = this%idx_map(cc,lchnk) + ns = jlat + (ilev-1)*this%nlat + count=count+1 + Asum(count,ns) = I_Gdata(cc,ilev,lchnk)*this%area_g(cc,lchnk) + end do + end do + end do + + call shr_reprosum_calc(Asum,Gsum, count, nlcols, Nsum, gbl_count=ngcols_p, commid=mpicom) + + ! Divide by area norm to get the averages + !----------------------------------------- + do ilev = 1,nlev + do nn = 1,this%nlat + ns = nn + (ilev-1)*this%nlat + O_Zdata(nn,ilev) = Gsum(ns)/this%a_norm(nn) + end do + end do + + deallocate(Gsum) + deallocate(Asum) + + end subroutine calc_ZonalAverage_3DbinAvg + !======================================================================= + + !======================================================================= + subroutine final_ZonalAverage(this) + class(ZonalAverage_t) :: this + + if(allocated(this%area )) deallocate(this%area) + if(allocated(this%a_norm )) deallocate(this%a_norm) + if(allocated(this%area_g )) deallocate(this%area_g) + if(allocated(this%idx_map)) deallocate(this%idx_map) + + end subroutine final_ZonalAverage + !======================================================================= + + + !======================================================================= + subroutine Invert_Matrix(I_Mat,Nbas,O_InvMat) + ! + ! Invert_Matrix: Given the NbasxNbas matrix, calculate and return + ! the inverse of the matrix. + ! + ! Implemented with the LAPACK DGESV routine. + ! + !==================================================================== + ! + ! Passed Variables + !------------------ + real(r8), intent(inout) :: I_Mat(:,:) ! input matrix contains P*L*U + ! decomposition on output + integer, intent(in) :: Nbas + real(r8), intent(out) :: O_InvMat(:,:) + ! + ! Local Values + !------------- + integer, allocatable :: Indx(:) ! pivot indices + integer :: astat, ii + character(len=*), parameter :: subname = 'Invert_Matrix' + character(len=80) :: msg + + external DGESV + + ! Allocate work space + !--------------------- + allocate(Indx(Nbas), stat=astat) + call handle_allocate_error(astat, subname, 'Indx') + + ! Initialize the inverse array with the identity matrix + !------------------------------------------------------- + O_InvMat(:,:) = 0._r8 + do ii=1,Nbas + O_InvMat(ii,ii) = 1._r8 + end do + + call DGESV(Nbas, Nbas, I_Mat, Nbas, Indx, O_InvMat, Nbas, astat) + + if (astat < 0) then + write(msg, '(a, i1, a)') 'argument # ', abs(astat), ' has an illegal value' + call endrun(subname//': DGESV error return: '//msg) + else if (astat > 0) then + call endrun(subname//': DGESV error return: matrix is singular') + end if + + deallocate(Indx) + + end subroutine Invert_Matrix + !======================================================================= + + !======================================================================= + ! legacy spherepack routines + !======================================================================= + subroutine sh_gen_basis_coefs(nn,mm,cp) + ! + ! spherepack alfk + ! + ! dimension of real cp(nn/2 + 1) + ! arguments + ! + ! purpose computes fourier coefficients in the trigonometric series + ! representation of the normalized associated + ! legendre function pbar(nn,mm,theta) for use by + ! sh_gen_basis_coefs in calculating pbar(nn,mm,theta). + ! + ! first define the normalized associated + ! legendre functions + ! + ! pbar(mm,nn,theta) = sqrt((2*nn+1)*factorial(nn-mm) + ! /(2*factorial(nn+mm)))*sin(theta)**mm/(2**nn* + ! factorial(nn)) times the (nn+mm)th derivative of + ! (x**2-1)**nn with respect to x=cos(theta) + ! + ! where theta is colatitude. + ! + ! then subroutine sh_gen_basis_coefs computes the coefficients + ! cp(k) in the following trigonometric + ! expansion of pbar(m,n,theta). + ! + ! 1) for n even and m even, pbar(mm,nn,theta) = + ! .5*cp(1) plus the sum from k=1 to k=nn/2 + ! of cp(k+1)*cos(2*k*th) + ! + ! 2) for nn even and mm odd, pbar(mm,nn,theta) = + ! the sum from k=1 to k=nn/2 of + ! cp(k)*sin(2*k*th) + ! + ! 3) for n odd and m even, pbar(mm,nn,theta) = + ! the sum from k=1 to k=(nn+1)/2 of + ! cp(k)*cos((2*k-1)*th) + ! + ! 4) for nn odd and mm odd, pbar(mm,nn,theta) = + ! the sum from k=1 to k=(nn+1)/2 of + ! cp(k)*sin((2*k-1)*th) + ! + ! arguments + ! + ! on input nn + ! nonnegative integer specifying the degree of + ! pbar(nn,mm,theta) + ! + ! mm + ! is the order of pbar(nn,mm,theta). mm can be + ! any integer however cp is computed such that + ! pbar(nn,mm,theta) = 0 if abs(m) is greater + ! than nn and pbar(nn,mm,theta) = (-1)**mm* + ! pbar(nn,-mm,theta) for negative mm. + ! + ! on output cp + ! array of length (nn/2)+1 + ! which contains the fourier coefficients in + ! the trigonometric series representation of + ! pbar(nn,mm,theta) + ! + ! special conditions none + ! + ! algorithm the highest order coefficient is determined in + ! closed form and the remainig coefficients are + ! determined as the solution of a backward + ! recurrence relation. + ! + !===================================================================== + ! + ! Passed Variables + !------------------ + integer ,intent(in ):: nn + integer ,intent(in ):: mm + real(r8),intent(out):: cp(nn/2+1) + ! + ! Local Values + !---------------- + real(r8):: fnum,fnmh + real(r8):: pm1 + real(r8):: t1,t2 + real(r8):: fden + real(r8):: cp2 + real(r8):: fnnp1 + real(r8):: fnmsq + real(r8):: fk + real(r8):: a1,b1,C1 + integer :: ma,nmms2,nex + integer :: ii,jj + + real(r8),parameter:: SC10=1024._r8 + real(r8),parameter:: SC20=SC10*SC10 + real(r8),parameter:: SC40=SC20*SC20 + + cp(1) = 0._r8 + ma = abs(mm) + if(ma>nn) return + + if((nn-1)<0) then + cp(1) = sqrt(2._r8) + return + elseif((nn-1)==0) then + if(ma/=0) then + cp(1) = sqrt(.75_r8) + if(mm==-1) cp(1) = -cp(1) + else + cp(1) = sqrt(1.5_r8) + endif + return + else + if(mod(nn+ma,2)/=0) then + nmms2 = (nn-ma-1)/2 + fnum = nn + ma + 2 + fnmh = nn - ma + 2 + pm1 = -1._r8 + else + nmms2 = (nn-ma)/2 + fnum = nn + ma + 1 + fnmh = nn - ma + 1 + pm1 = 1._r8 + endif + endif + + t1 = 1._r8/SC20 + nex = 20 + fden = 2._r8 + if(nmms2>=1) then + do ii = 1,nmms2 + t1 = fnum*t1/fden + if (t1>SC20) then + t1 = t1/SC40 + nex = nex + 40 + endif + fnum = fnum + 2._r8 + fden = fden + 2._r8 + end do + endif + + if(mod(ma/2,2)/=0) then + t1 = -t1/2._r8**(nn-1-nex) + else + t1 = t1/2._r8**(nn-1-nex) + endif + t2 = 1._r8 + if(ma/=0) then + do ii = 1,ma + t2 = fnmh*t2/ (fnmh+pm1) + fnmh = fnmh + 2._r8 + end do + endif + + cp2 = t1*sqrt((nn+.5_r8)*t2) + fnnp1 = nn*(nn+1) + fnmsq = fnnp1 - 2._r8*ma*ma + + if((mod(nn,2)==0).and.(mod(ma,2)==0)) then + jj = 1+(nn+1)/2 + else + jj = (nn+1)/2 + endif + + cp(jj) = cp2 + if(mm<0) then + if(mod(ma,2)/=0) cp(jj) = -cp(jj) + endif + if(jj<=1) return + + fk = nn + a1 = (fk-2._r8)*(fk-1._r8) - fnnp1 + b1 = 2._r8* (fk*fk-fnmsq) + cp(jj-1) = b1*cp(jj)/a1 + + jj = jj - 1 + do while(jj>1) + fk = fk - 2._r8 + a1 = (fk-2._r8)*(fk-1._r8) - fnnp1 + b1 = -2._r8*(fk*fk-fnmsq) + c1 = (fk+1._r8)*(fk+2._r8) - fnnp1 + cp(jj-1) = -(b1*cp(jj)+c1*cp(jj+1))/a1 + jj = jj - 1 + end do + + end subroutine sh_gen_basis_coefs + !======================================================================= + + !======================================================================= + subroutine sh_create_basis(nn,mm,theta,cp,pb) + ! + ! spherepack lfpt + ! + ! dimension of + ! arguments + ! cp((nn/2)+1) + ! + ! purpose routine sh_create_basis uses coefficients computed by + ! routine sh_gen_basis_coefs to compute the + ! normalized associated legendre function pbar(nn,mm,theta) + ! at colatitude theta. + ! + ! arguments + ! + ! on input nn + ! nonnegative integer specifying the degree of + ! pbar(nn,mm,theta) + ! mm + ! is the order of pbar(nn,mm,theta). mm can be + ! any integer however pbar(nn,mm,theta) = 0 + ! if abs(mm) is greater than nn and + ! pbar(nn,mm,theta) = (-1)**mm*pbar(nn,-mm,theta) + ! for negative mm. + ! + ! theta + ! colatitude in radians + ! + ! cp + ! array of length (nn/2)+1 + ! containing coefficients computed by routine + ! sh_gen_basis_coefs + ! + ! on output pb + ! variable containing pbar(n,m,theta) + ! + ! special conditions calls to routine sh_create_basis must be preceded by an + ! appropriate call to routine sh_gen_basis_coefs. + ! + ! algorithm the trigonometric series formula used by + ! routine sh_create_basis to calculate pbar(nn,mm,theta) at + ! colatitude theta depends on mm and nn as follows: + ! + ! 1) for nn even and mm even, the formula is + ! .5*cp(1) plus the sum from k=1 to k=n/2 + ! of cp(k)*cos(2*k*theta) + ! 2) for nn even and mm odd. the formula is + ! the sum from k=1 to k=nn/2 of + ! cp(k)*sin(2*k*theta) + ! 3) for nn odd and mm even, the formula is + ! the sum from k=1 to k=(nn+1)/2 of + ! cp(k)*cos((2*k-1)*theta) + ! 4) for nn odd and mm odd, the formula is + ! the sum from k=1 to k=(nn+1)/2 of + ! cp(k)*sin((2*k-1)*theta) + ! + !===================================================================== + integer, intent(in) :: nn,mm + real(r8), intent(in) :: theta + real(r8), intent(in) :: cp(:) + real(r8), intent(out) :: pb + + real(r8) :: cdt + real(r8) :: sdt + real(r8) :: ct + real(r8) :: st + real(r8) :: summ + real(r8) :: cth + + integer:: ma,nmod,mmod,kdo + integer:: kp1,kk + + pb = 0._r8 + ma = abs(mm) + if(ma>nn) return + + if(nn<=0) then + if(ma<=0) then + pb = sqrt(.5_r8) + return + endif + endif + + nmod = mod(nn,2) + mmod = mod(ma,2) + + if(nmod<=0) then + if(mmod<=0) then + kdo = nn/2 + 1 + cdt = cos(theta+theta) + sdt = sin(theta+theta) + ct = 1._r8 + st = 0._r8 + summ = .5_r8*cp(1) + do kp1 = 2,kdo + cth = cdt*ct - sdt*st + st = sdt*ct + cdt*st + ct = cth + summ = summ + cp(kp1)*ct + end do + pb = summ + return + endif + kdo = nn/2 + cdt = cos(theta+theta) + sdt = sin(theta+theta) + ct = 1._r8 + st = 0._r8 + summ = 0._r8 + do kk = 1,kdo + cth = cdt*ct - sdt*st + st = sdt*ct + cdt*st + ct = cth + summ = summ + cp(kk)*st + end do + pb = summ + return + endif + + kdo = (nn+1)/2 + if(mmod<=0) then + cdt = cos(theta+theta) + sdt = sin(theta+theta) + ct = cos(theta) + st = -sin(theta) + summ = 0._r8 + do kk = 1,kdo + cth = cdt*ct - sdt*st + st = sdt*ct + cdt*st + ct = cth + summ = summ + cp(kk)*ct + end do + pb = summ + return + endif + + cdt = cos(theta+theta) + sdt = sin(theta+theta) + ct = cos(theta) + st = -sin(theta) + summ = 0._r8 + do kk = 1,kdo + cth = cdt*ct - sdt*st + st = sdt*ct + cdt*st + ct = cth + summ = summ + cp(kk)*st + end do + pb = summ + + end subroutine sh_create_basis + !======================================================================= + + !======================================================================= + subroutine sh_create_gaus_grid(nlat,theta,wts,ierr) + ! + ! spherepack gaqd + ! . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + ! . . + ! . copyright (c) 2001 by ucar . + ! . . + ! . university corporation for atmospheric research . + ! . . + ! . all rights reserved . + ! . . + ! . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + ! + ! February 2002 + ! + ! gauss points and weights are computed using the fourier-newton + ! described in "on computing the points and weights for + ! gauss-legendre quadrature", paul n. swarztrauber, siam journal + ! on scientific computing (DOI 10.1137/S1064827500379690). + ! This routine is faster and more accurate than older program + ! with the same name. + ! + ! computes the nlat gaussian colatitudes and weights + ! in double precision. the colatitudes are in radians and lie in the + ! in the interval (0,pi). + ! + ! input parameters + ! + ! nlat the number of gaussian colatitudes in the interval (0,pi) + ! (between the two poles). nlat must be greater than zero. + ! + ! output parameters + ! + ! theta a double precision array with length nlat + ! containing the gaussian colatitudes in + ! increasing radians on the interval (0,pi). + ! + ! wts a double precision array with lenght nlat + ! containing the gaussian weights. + ! + ! ierror = 0 no errors + ! = 1 if nlat<=0 + ! + !=================================================================== + ! + ! Passed variables + !----------------- + integer ,intent(in ) :: nlat + real(r8),intent(out) :: theta(nlat) + real(r8),intent(out) :: wts(nlat) + integer ,intent(out) :: ierr + ! + ! Local Values + !------------- + real(r8):: sgnd + real(r8):: xx,dtheta,dthalf + real(r8):: cmax,zprev,zlast,zero,zhold,pb,dpb,dcor,summ,cz + integer :: mnlat,ns2,nhalf,nix,it,ii + + real(r8), parameter :: eps = epsilon(1._r8) + + ! check work space length + !------------------------ + if(nlat<=0) then + ierr = 1 + return + endif + ierr = 0 + + ! compute weights and points analytically when nlat=1,2 + !------------------------------------------------------- + if(nlat==1) then + theta(1) = acos(0._r8) + wts (1) = 2._r8 + return + elseif(nlat==2) then + xx = sqrt(1._r8/3._r8) + theta(1) = acos( xx) + theta(2) = acos(-xx) + wts (1) = 1._r8 + wts (2) = 1._r8 + return + endif + + ! Proceed for nlat > 2 + !---------------------- + mnlat = mod(nlat,2) + ns2 = nlat/2 + nhalf = (nlat+1)/2 + + call sh_fourier_coefs_dp(nlat,cz,theta(ns2+1),wts(ns2+1)) + + dtheta = halfPI/nhalf + dthalf = dtheta/2._r8 + cmax = .2_r8*dtheta + + ! estimate first point next to theta = pi/2 + !------------------------------------------- + if(mnlat/=0) then + zero = halfPI - dtheta + zprev = halfPI + nix = nhalf - 1 + else + zero = halfPI - dthalf + nix = nhalf + endif + + do while(nix/=0) + dcor = huge(1._r8) + it = 0 + do while (abs(dcor) > eps*abs(zero)) + it = it + 1 + ! newton iterations + !----------------------- + call sh_legp_dlegp_theta(nlat,zero,cz,theta(ns2+1),wts(ns2+1),pb,dpb) + dcor = pb/dpb + if(dcor.ne.0._r8) then + sgnd = dcor/abs(dcor) + else + sgnd = 1._r8 + endif + dcor = sgnd*min(abs(dcor),cmax) + zero = zero - dcor + end do + + theta(nix) = zero + zhold = zero + + ! wts(nix) = (nlat+nlat+1)/(dpb*dpb) + ! yakimiw's formula permits using old pb and dpb + !-------------------------------------------------- + wts(nix) = (nlat+nlat+1)/ (dpb+pb*dcos(zlast)/dsin(zlast))**2 + nix = nix - 1 + if(nix==nhalf-1) zero = 3._r8*zero - pi + if(nix0) then + cth = cdt + sth = sdt + do kk = 1,kdo + pb = pb + cp(kk)*cth + dpb = dpb - dcp(kk)*sth + chh = cdt*cth - sdt*sth + sth = sdt*cth + cdt*sth + cth = chh + end do + endif + else + ! n odd + !----------- + kdo = (nn+1)/2 + pb = 0._r8 + dpb = 0._r8 + cth = dcos(theta) + sth = dsin(theta) + do kk = 1,kdo + pb = pb + cp(kk)*cth + dpb = dpb - dcp(kk)*sth + chh = cdt*cth - sdt*sth + sth = sdt*cth + cdt*sth + cth = chh + end do + endif + + end subroutine sh_legp_dlegp_theta + !======================================================================= + +end module zonal_mean_mod diff --git a/test/system/TGIT.sh b/test/system/TGIT.sh index db04179217..e6d6557030 100755 --- a/test/system/TGIT.sh +++ b/test/system/TGIT.sh @@ -1,6 +1,6 @@ #!/bin/sh # Test for bad git repo -# Ensures that the top-level CAM directory +# Ensures that the top-level CAM directory # has ".git" directory and ".gitignore" file, # and no other git files or directories. @@ -9,7 +9,7 @@ # 2: Missing ".git" directory # 3: Missing ".gitignore" file # 4: Missing ".github" directory -# 5: More than three ".git*" files or directories +# 5: Missing ".gitmodules" file # 6: Error from running an external command # Utility to check return code. @@ -66,7 +66,7 @@ The ".gitignore" file is missing from the CAM git repo. Was this repo cloned, c modified incorrectly? If so then copy the .gitignore file from a standard CAM git repo. EOF rc=3 - fi + fi # Check for ".github" directory: if [ ! -d "${cam_top_dir}/.github" ]; then @@ -77,15 +77,11 @@ EOF rc=4 fi - # Check if there are more ".git*" files or directories than just ".git", ".gitignore", - # and ".github": - git_file_num=$(find "${cam_top_dir}" -maxdepth 1 -name '.git*' | wc -l) - - check_code "$?" "Problem running 'find' command for multi-git file check." - - if [ "${git_file_num}" -gt 3 ]; then + # Check for ".github" directory: + if [ ! -f "${cam_top_dir}/.gitmodules" ]; then cat < ] (directory for saving baselines of cime tests)" echo "${hprefix} [ --no-baseline] (baselines of cime tests are not saved)" + echo "${hprefix} [ --xml-driver ] (mct or nuopc)" echo "${hprefix} [ --cesm ] (default aux_cam)" echo "${hprefix} [ --rerun-cesm ] (rerun the cesm tests with the --use-existing-flag)" echo "${hprefix} [ --namelists-only ] (Only perform namelist actions for tests. Incompatible with --rerun-cesm.)" @@ -181,6 +182,14 @@ while [ "${1:0:1}" == "-" ]; do fi ;; + --xml-driver ) + if [ $# -lt 2 ]; then + perr "${1} specify mct or nuopc)" + fi + xml_driver="${2}" + shift + ;; + --namelists-only ) namelists_only=true if [ "${use_existing}" != "" ]; then @@ -205,14 +214,15 @@ fi #will attach timestamp onto end of script name to prevent overwriting start_date="`date --iso-8601=seconds`" cur_time=`date '+%H%M%S'` +date_str="`date '+%Y%m%d%H%M%S'`" hostname=`hostname` case $hostname in - ##cheyenne - ch* | r* ) - submit_script_cime="`pwd -P`/test_driver_cheyenne_cime_${cur_time}.sh" + ##derecho + derecho* | dec* ) + submit_script_cime="`pwd -P`/test_driver_derecho_cime_${cur_time}.sh" if [ -z "$CAM_ACCOUNT" ]; then echo "ERROR: Must set the environment variable CAM_ACCOUNT" @@ -220,30 +230,34 @@ case $hostname in fi if [ -z "$CAM_BATCHQ" ]; then - export CAM_BATCHQ="regular" + export CAM_BATCHQ="main" fi # wallclock for run job wallclock_limit="5:00:00" if [ $gmake_j = 0 ]; then - gmake_j=36 + gmake_j=128 fi - # run tests on 2 nodes using 18 tasks/node, 2 threads/task - CAM_TASKS=36 + # run tests on 1 node using 64 tasks/node, 2 threads/task + # These settings are ignored on derecho. + # PE layouts come from config_pes.xml. + CAM_TASKS=64 CAM_THREADS=2 - # change parallel configuration on 2 nodes using 32 tasks, 1 threads/task + # change parallel configuration on 1 nodes using 32 tasks, 1 threads/task + # These settings are ignored on derecho. + # PE layouts come from config_pes.xml. CAM_RESTART_TASKS=32 CAM_RESTART_THREADS=1 - mach_workspace="/glade/scratch" + mach_workspace="/glade/derecho/scratch" # Check for CESM baseline directory - if [ -n "{$BL_TESTDIR}" ] && [ ! -d "${BL_TESTDIR}" ]; then + if [ -n "${BL_TESTDIR}" ] && [ ! -d "${BL_TESTDIR}" ]; then echo "CESM_BASELINE ${BL_TESTDIR} not found. Check BL_TESTDIR for correct tag name." - exit + exit 3 fi #------------------------------------------- @@ -254,16 +268,16 @@ cat > ${submit_script_cime} << EOF #PBS -N cime-tests #PBS -q $CAM_BATCHQ #PBS -A $CAM_ACCOUNT -#PBS -l walltime=4:00:00 -#PBS -l select=1:ncpus=36:mpiprocs=36 +#PBS -l walltime=$wallclock_limit +#PBS -l select=1:ncpus=128:mpiprocs=128 #PBS -j oe -#PBS -l inception=login EOF ##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^ ;; + ##hobart hob* | h[[:digit:]]* ) submit_script_cime="`pwd -P`/test_driver_hobart_cime_${cur_time}.sh" @@ -322,13 +336,6 @@ EOF ##izumi izu* | i[[:digit:]]* ) - - # Run git and r8 tests - echo "###################################################" - export ADDREALKIND_EXE=/fs/cgd/csm/tools/addrealkind/addrealkind; ${CAM_ROOT}/test/system/TR8.sh - echo "###################################################" - ${CAM_ROOT}/test/system/TGIT.sh - echo "###################################################" submit_script_cime="`pwd -P`/test_driver_izumi_cime_${cur_time}.sh" export PATH=/cluster/torque/bin:${PATH} @@ -384,6 +391,58 @@ EOF ##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^ ;; + ##casper + casper* | crhtc* ) + submit_script_cime="`pwd -P`/test_driver_casper_cime_${cur_time}.sh" + + if [ -z "$CAM_ACCOUNT" ]; then + echo "ERROR: Must set the environment variable CAM_ACCOUNT" + exit 2 + fi + + if [ -z "$CAM_BATCHQ" ]; then + export CAM_BATCHQ="casper" + fi + + # wallclock for run job + wallclock_limit="00:59:00" + + if [ $gmake_j = 0 ]; then + gmake_j=36 + fi + + # run tests on 1 nodes using 18 tasks/node, 2 threads/task + CAM_TASKS=18 + CAM_THREADS=2 + + # change parallel configuration on 1 nodes using 32 tasks, 1 threads/task + CAM_RESTART_TASKS=32 + CAM_RESTART_THREADS=1 + + mach_workspace="/glade/scratch" + + # Check for CESM baseline directory + if [ -n "${BL_TESTDIR}" ] && [ ! -d "${BL_TESTDIR}" ]; then + echo "CESM_BASELINE ${BL_TESTDIR} not found. Check BL_TESTDIR for correct tag name." + exit + fi + +#------------------------------------------- + +cat > ${submit_script_cime} << EOF +#!/bin/bash +# +#PBS -N cime-tests +#PBS -q $CAM_BATCHQ +#PBS -A $CAM_ACCOUNT +#PBS -l walltime=$wallclock_limit +#PBS -l select=1:ncpus=36:mpiprocs=36:mem=300GB +#PBS -j oe +#PBS -V +EOF + +##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^ + ;; * ) echo "ERROR: machine $hostname not currently supported"; exit 1 ;; esac @@ -393,8 +452,8 @@ esac cesm_test_mach="" comp="" -if [ "${hostname:0:4}" == "chey" ]; then - cesm_test_mach="cheyenne" +if [ "${hostname:0:5}" == "derec" ] || [ "${hostname:0:3}" == "dec" ]; then + cesm_test_mach="derecho" fi if [ "${hostname:0:6}" == "hobart" ]; then cesm_test_mach="hobart" @@ -402,26 +461,37 @@ fi if [ "${hostname:0:5}" == "izumi" ]; then cesm_test_mach="izumi" fi +if [ "${hostname:0:6}" == "casper" ] || [ "${hostname:0:5}" == "crhtc" ]; then + cesm_test_mach="casper" +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 - if [ "${hostname:0:5}" != "izumi" ]; then + if [ "${hostname:0:5}" != "izumi" ] && [ "${hostname:0:7}" != "derecho" ]; then module load python fi + for cesm_test in ${cesm_test_suite}; do testargs="--xml-category ${cesm_test} --xml-machine ${cesm_test_mach} --retry 2" if [ -n "${use_existing}" ]; then test_id="${use_existing}" else - idstr="`date '+%Y%m%d%H%M%S'`" - test_id=${cesm_test}${comp}"_"${idstr} + test_id=${cesm_test}${comp}"_"${date_str} fi currdir="`pwd -P`" logfile="${currdir}/${test_id}.log" + # Create an empty logfile so that other tasks can append to it + if [ -f "${logfile}" ]; then + rm -f ${logfile} + fi + touch ${logfile} script_dir="${CIME_ROOT}/scripts" if [ ! -d "${script_dir}" ]; then echo "ERROR: CIME scripts dir not found at ${script_dir}" @@ -432,8 +502,37 @@ if [ "${cesm_test_suite}" != "none" -a -n "${cesm_test_mach}" ]; then exit 1 fi - ##setup CESM work directory - cesm_testdir=$mach_workspace/$LOGNAME/$test_id + ## If this is a Nag test, run the r8 and git tests + if [ "${comp}" == "_nag" ]; then + sepstr="################################################################" + echo "${sepstr}" | tee -a ${logfile} + ark_file="/fs/cgd/csm/tools/addrealkind/addrealkind" + tr8_script="${CAM_ROOT}/test/system/TR8.sh" + export ADDREALKIND_EXE="${ark_file}"; ${tr8_script} | tee -a ${logfile} + res=${PIPESTATUS[0]} + if [ $res -eq 0 ]; then + echo "TR8 test PASS" | tee -a ${logfile} + else + echo "TR8 test FAIL, rc = $res" | tee -a ${logfile} + fi + echo "${sepstr}" | tee -a ${logfile} + ${CAM_ROOT}/test/system/TGIT.sh | tee -a ${logfile} + res=${PIPESTATUS[0]} + if [ $res -eq 0 ]; then + echo "TGIT test PASS" | tee -a ${logfile} + else + echo "TGIT test FAIL, rc = $res" | tee -a ${logfile} + fi + echo "${sepstr}" | tee -a ${logfile} + fi + + ## Setup CESM work directory + if [ "${hostname:0:6}" == "casper" ] || [ "${hostname:0:5}" == "crhtc" ]; then + ## Would fail to compile on Casper with long folder name + cesm_testdir=$mach_workspace/$LOGNAME/$cesm_test + else + cesm_testdir=$mach_workspace/$LOGNAME/$test_id + fi if [ -e ${cesm_testdir} ]; then if [ -n "${use_existing}" ]; then @@ -451,12 +550,14 @@ 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 - # cheyenne - chey* | r* ) + # derecho + derec* | dec* ) + testargs="${testargs} --test-root ${cesm_testdir} --output-root ${cesm_testdir}" + ;; + # casper + casper* | crhtc* ) testargs="${testargs} --queue ${CAM_BATCHQ} --test-root ${cesm_testdir} --output-root ${cesm_testdir}" ;; *) @@ -486,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` @@ -519,18 +618,29 @@ if [ "${cesm_test_suite}" != "none" -a -n "${cesm_test_mach}" ]; then fi fi + if [ -n "${xml_driver}" ]; then + testargs="${testargs} --xml-driver ${xml_driver}" + fi echo "" - echo "CESM test results will be in: ${cesm_testdir}" | tee ${logfile} + echo "CESM test results will be in: ${cesm_testdir}" | tee -a ${logfile} echo "Running ./create_test ${testargs}" | tee -a ${logfile} if [ "${hostname:0:2}" == "ch" ]; then echo "cd ${script_dir}" >> ${submit_script_cime} + echo "module load python" >> ${submit_script_cime} echo './create_test' ${testargs} >> ${submit_script_cime} chmod u+x ${submit_script_cime} qsub ${submit_script_cime} fi + if [ "${hostname:0:2}" == "de" ]; then + echo "cd ${script_dir}" >> ${submit_script_cime} + echo './create_test' ${testargs} >> ${submit_script_cime} + chmod u+x ${submit_script_cime} + qsub ${submit_script_cime} + fi + if [ "${hostname:0:6}" == "hobart" ]; then echo "cd ${script_dir}" >> ${submit_script_cime} echo './create_test' ${testargs} >> ${submit_script_cime} @@ -549,6 +659,14 @@ if [ "${cesm_test_suite}" != "none" -a -n "${cesm_test_mach}" ]; then fi fi + if [ "${hostname:0:6}" == "casper" ] || [ "${hostname:0:5}" == "crhtc" ]; then + echo "cd ${script_dir}" >> ${submit_script_cime} + echo "module load python" >> ${submit_script_cime} + echo './create_test' ${testargs} >> ${submit_script_cime} + chmod u+x ${submit_script_cime} + qsub ${submit_script_cime} + fi + done fi diff --git a/tools/CUPiD b/tools/CUPiD new file mode 160000 index 0000000000..18c0e37022 --- /dev/null +++ b/tools/CUPiD @@ -0,0 +1 @@ +Subproject commit 18c0e370222070ae6b9bc061d3d404b115fdc1d3 diff --git a/tools/definehires/Makefile b/tools/definehires/Makefile deleted file mode 100644 index ef34446982..0000000000 --- a/tools/definehires/Makefile +++ /dev/null @@ -1,127 +0,0 @@ -# Makefile to build definesurf on various platforms -# Note: If netcdf library is not built in the standard location, you must set the environment -# variables INC_NETCDF and LIB_NETCDF - -EXEDIR = . -EXENAME = definehires -RM = rm - -.SUFFIXES: -.SUFFIXES: .F90 .o - -# Check for the NetCDF library and include directories -ifeq ($(LIB_NETCDF),$(null)) -LIB_NETCDF := /usr/local/lib -endif - -ifeq ($(INC_NETCDF),$(null)) -INC_NETCDF := /usr/local/include -endif - -# Determine platform -UNAMES := $(shell uname -s) -UNAMEM := $(findstring CRAY,$(shell uname -m)) - -# Architecture-specific flags and rules -# -#------------------------------------------------------------------------ -# Cray -#------------------------------------------------------------------------ - -ifeq ($(UNAMEM),CRAY) -FC = f90 -FFLAGS = -c -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.F90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# SGI -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),IRIX64) -FC = f90 -FFLAGS = -c -I$(INC_NETCDF) -64 -mips4 -bytereclen -s -r8 -LDFLAGS = -64 -L/usr/local/lib64/r4i4 -L$(LIB_NETCDF) -lnetcdf -.F90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# SUN -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),SunOS) -FC = f90 -FFLAGS = -c -stackvar -f -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.F90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# AIX -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),AIX) -FC = xlf90 -FFLAGS = -c -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.F90.o: - $(FC) $(FFLAGS) -qsuffix=f=F90 $< -endif - -#------------------------------------------------------------------------ -# OSF1 -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),OSF1) -FC = f90 -FFLAGS = -c -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.F90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# Linux -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),Linux) -ifeq ($(USER_FC),$(null)) -FC := pgf90 -FFLAGS = -c -I$(INC_NETCDF) -fast -r8 -byteswapio -else -FC := $(USER_FC) -endif -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf - -ifeq ($(FC),lf95) - FFLAGS := -c --trace --trap --wide -CcdRR8 -I$(INC_NETCDF) - ifeq ($(DEBUG),TRUE) - #TBH: this works FFLAGS += -g --chk --pca - #TBH: this FAILS FFLAGS += -g --chk a,e,s,u,x --pca - FFLAGS += -g --chk a,e,s,u --pca - else - FFLAGS += -O - endif -endif - -.F90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# Default rules and macros -#------------------------------------------------------------------------ - -OBJS := gtopo30_to_10min.o shr_kind_mod.o - -$(EXEDIR)/$(EXENAME): $(OBJS) - $(FC) -o $@ $(OBJS) $(LDFLAGS) - -clean: - $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) - -gtopo30_to_10min.o: shr_kind_mod.o diff --git a/tools/definehires/README b/tools/definehires/README deleted file mode 100644 index 5834c3961a..0000000000 --- a/tools/definehires/README +++ /dev/null @@ -1,114 +0,0 @@ -*** Lahey compiler note If you build definehires with lf95, you must -*** execute with the -T runtime option, to get the proper byte -*** ordering on input. Otherwise, you get nonsense. The GTOPO30 input -*** files are binary, with "bigendian" ordering. -*** definesurf -Wl,-T - -Running gnumake in this directory will create an executable named -"definehires". Its function is to produce a 10-minute topography -dataset from a USGS 30-second topographic dataset. The 30-second -dataset contains only a height field. The 10-minute dataset contains - height field, a binary land mask, and a fractional land mask. - -Ocean points are indicated in the 30-second dataset by a missing data -flag and are assumed to have elevation 0m. However, the Caspian Sea -is not flagged as ocean. The definehires program generates a Caspian -Sea based on elevation, and reports these points as ocean while -generating the 10-minute dataset. This is done through three calls to -the new routine expand_sea. - -The 30-second dataset needed by definehires can be obtained from the -following USGS web site: - -http://edcdaac.usgs.gov/gtopo30/gtopo30.asp - -For each tile in the dataset, both the *.DEM and *.HDR files must be -present in the directory from which definehires is run. On NCAR -machines, this may be accomplished by repeating the following snippet -from a user csh or tcsh shell. - ->> foreach temp ( /fs/cgd/csm/inputdata/atm/cam2/gtopo30data/* ) -foreach? ln -s $temp -foreach? end - -Once the appropriate data files are in place, simply type: -./definehires - -This will produce a new 10-minute high-resolution dataset named -topo_gtopo30_10min.nc - - - -------------------------------------- -Feb 01, 2005 -------------------------------------- - -------------------------------------- -*********** definehires ************* -------------------------------------- - -The GTOPO30 30" is converted to a 10' dataset using definehires - Originally by Jiundar Chern (jchern@dao.gsfc.nasa.gov), - updated by Jim McCaa (jmccaa@ucar.edu) - updated by B.A. Boville - -./definehires generates file "topo_gtopo30_10min.nc" containing 5 variables - lon dimension variable of longitudes - lat dimension variable of latitudes - variance variance of 30" height w.r.t. 10' grid - htopo average terrain height on 10' grid - landfract land fraction on 10' grid, - cells are either land or ocean on 30" grid - Caspian sea is identified as ocean, but has nonzero height - -The original GTOPO30 files contain only elevation, with a flag for -ocean points (NODATA=-9999). The Caspian Sea is not connected to the -oceans and is not at sea level. Definehires identifies the Caspian Sea -in the 30" data using an algorithm based on elevation. Therefore, -the land fraction reflects the presence of the Caspian and the -elevation is nonzero. - -method: - - Subroutine expand_sea is called 3 times, once for each GTOPO30 tile - which contains part of the Caspian. The arguments include the x,y - indices of a start point which is known to be in the Caspian. These - 3 points had to identified by hand. - - 1. the start point is flagged by - adding NODATA + NODATA to the original height - setting a flag true for the block of surrounding points: - (startx-1:startx+1,starty-1:starty+1) - - 2. find points with the same elevation as the start point and whose - flag is true. Flag them the same way as the start point. - - This provides an expanding mask of potential Caspian points, which - are flagged true, and an expanding region of actual Caspian points - which are flagged with the original elavation + NODATA + NODATA. - - Subroutine avg is called to compute the area weighted average and - land fraction of the 30" data with respect to the 10' grid. The - weighting accounts for the area change with latitude. Points with - elavation = NODATA are given elevation = 0 and land fraction = - 0. Caspian points (elevation < NODATA) are given their original - elevation (elevation - NODATA - NODATA) and land fraction = 0. - - The variance of the 30" height data with respect to the 10' average - is computed without area weighting. - -Note on method. The Caspian terrain height flag is exact because the -height is an integer. However, I would have preferred to - - Convert the height of ocean points from NODATA to ZERO and make a - land fraction array with 0. or 1.. This could be done with a - subroutine find_ocn. - - Then the Caspian points would retain their original elevations and - also get land fraction 0 in find_caspian (instead of - expand_sea). Still called for only the 3 tiles. - - Subroutine avg would not have to recognize anything special about - Caspian points. - - diff --git a/tools/definehires/gtopo30_to_10min.F90 b/tools/definehires/gtopo30_to_10min.F90 deleted file mode 100644 index 50ccae5c2e..0000000000 --- a/tools/definehires/gtopo30_to_10min.F90 +++ /dev/null @@ -1,721 +0,0 @@ -! -! DATE CODED: Oct 17, 2000 -! DESCRIPTION: This program reads USGS 30-sec terrain dataset in 33 tiles and converts -! them to 10-min resolution global dataset in one single NetCDF file. -! -! Author: Jiundar Chern (jchern@dao.gsfc.nasa.gov) -! -! ** Modified November, 2003 *** -! This code has been modified by Jim McCaa (jmccaa@ucar.edu) for use at NCAR. -! In particular: -! 1) Paths and compiler options have been changed. -! 2) The code now generates a Caspian Sea based on elevation, and reports these points -! as ocean. This is done through three calls to the new routine expand_sea. -! -! ** Modified February 4, 2005 B.A. Boville *** -! -! ROUTINES CALLED: -! netcdf routines -! -! COMPILING: -! -! NCAR SGI (chinookfe) f90 -I/usr/local/include -O -64 -mips4 -bytereclen -s -! -o gtopo30_to_10min gtopo30_to_10min.F90 -L/usr/local/lib64/r4i4 -lnetcdf -r8 - -! NASA DAO SGI: f90 -I/ford1/local/IRIX64/netcdf/include -O -64 -mips4 -bytereclen -s -! -o gtopo30_to_10min gtopo30_to_10min.F90 -L/ford1/local/IRIX64/netcdf/lib -lnetcdf -r8 - - program convterr - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This program converts USGS 30-sec terrain data set to 10-min resolution -! terrain data set. -! - implicit none -! - integer, parameter :: ntile = 33 ! number of tiles in USGS GTOPO30 dataset - integer, parameter :: im10 = 2160 ! total grids in x direction of 10-min global dataset - integer, parameter :: jm10 = 1080 ! total grids in y direction of 10-min global dataset - real(r8), parameter :: dx30s = 1.0/120.0 ! space interval for 30-sec data (in degree) - real(r8), parameter :: dx10m = 1.0/6.0 ! space interval for 10-min data (in degree) - - character (len=7) :: nmtile(ntile) ! name of each tile - integer :: ncols,nrows ! number of columns and rows for 30-sec tile - integer :: nodata ! integer for ocean point - integer :: ncol10,nrow10 ! number of columns and rows for 10-min tile - real(r8):: ulxmap ! longitude at the center of the upper-left corner cell in the 30-sec tile - real(r8):: ulymap ! latitude at the center of the upper-left corner cell in the 30-sec tile - real(r8):: lon1_10m ! longitude at the center of grid (1,1) in the 10-min global data - real(r8):: lat1_10m ! latitude at the center of grid (1,1) in the 10-min global data - real(r8):: lonsw10 ! longitude at the center of southwest corner cell in the 10-min tile - real(r8):: latsw10 ! latitude at the center of southwest corner cell in the 10-min tile - integer :: i1,j1 ! the (i,j) point of the southwest corner of the 10-min tile in the global grid - real(r8), dimension(im10,jm10) :: terr ! global 10-min terrain data - real(r8), dimension(im10,jm10) :: variance ! global 10-min variance of elevation - real(r8), dimension(im10,jm10) :: land_fraction !global 10-min land fraction - - integer :: alloc_error,dealloc_error - integer :: i,j,n ! index - integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile - real(r8), allocatable, dimension(:,:) :: terr10m ! terrain data for 10-min tile - real(r8), allocatable, dimension(:,:) :: psea10m ! percentage of ocaen for 10-min tile - real(r8), allocatable, dimension(:,:) :: var10m ! variance of 30-sec elevations for 10-min tile -! - lat1_10m=-90.0 + 0.5 * dx10m - lon1_10m=0.5*dx10m -! -! Initialize each tile name -! - nmtile(1) = 'W180N90' - nmtile(2) = 'W140N90' - nmtile(3) = 'W100N90' - nmtile(4) = 'W060N90' - nmtile(5) = 'W020N90' - nmtile(6) = 'E020N90' - nmtile(7) = 'E060N90' - nmtile(8) = 'E100N90' - nmtile(9) = 'E140N90' - - nmtile(10) = 'W180N40' - nmtile(11) = 'W140N40' - nmtile(12) = 'W100N40' - nmtile(13) = 'W060N40' - nmtile(14) = 'W020N40' - nmtile(15) = 'E020N40' - nmtile(16) = 'E060N40' - nmtile(17) = 'E100N40' - nmtile(18) = 'E140N40' - - nmtile(19) = 'W180S10' - nmtile(20) = 'W140S10' - nmtile(21) = 'W100S10' - nmtile(22) = 'W060S10' - nmtile(23) = 'W020S10' - nmtile(24) = 'E020S10' - nmtile(25) = 'E060S10' - nmtile(26) = 'E100S10' - nmtile(27) = 'E140S10' - - nmtile(28) = 'W180S60' - nmtile(29) = 'W120S60' - nmtile(30) = 'W060S60' - nmtile(31) = 'W000S60' - nmtile(32) = 'E060S60' - nmtile(33) = 'E120S60' - - do j = 1, jm10 - do i = 1, im10 - terr(i,j) = -9999.0 - variance(i,j) = -9999.0 - land_fraction(i,j) = -9999.0 - end do - end do - - do n = 1,ntile -! -! Read header for each tile -! - call rdheader(nmtile(n),nrows,ncols,nodata,ulxmap,ulymap) - -! -! Allocate space for array iterr -! - allocate ( iterr(ncols,nrows),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for iterr' - stop - end if -! -! Read terr data for each tile -! - call rdterr(nmtile(n),nrows,ncols,iterr) -! -! Allocate space for arrays terr10m and psea10m -! - nrow10 =nrows*dx30s/dx10m - ncol10 =ncols*dx30s/dx10m - allocate ( terr10m(ncol10,nrow10),psea10m(ncol10,nrow10),var10m(ncol10,nrow10),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr10m, psea10m, and var10m' - stop - end if -! -! Expand Caspian Sea for tiles 6 and 15 -! - if(nmtile(n).eq.'E020N90')call expand_sea(ncols,nrows,iterr,nodata,3600,5300) - if(nmtile(n).eq.'E020N90')call expand_sea(ncols,nrows,iterr,nodata,4088,5874) - if(nmtile(n).eq.'E020N40')call expand_sea(ncols,nrows,iterr,nodata,3600,1) -! -! area average of 30-sec tile to 10-min tile -! - call avg(ncols,nrows,iterr,nodata,ulymap,dx30s,ncol10,nrow10,terr10m,psea10m,var10m) - -! -! Print some info on the fields - print *, "min and max elevations: ", minval(terr10m), maxval(terr10m) - print *, "min and max variacnes: ", minval(var10m) , maxval(var10m) - print *, "min and max land frac: ", minval(psea10m), maxval(psea10m) -! -! fit the 10-min tile into global 10-min dataset -! Note: the 30-sec and 10-min tiles are scaned from north to south, the global 10-min dataset are -! scaned from south to north (90S to 90N) and east to west (0E to -0.1666667W) -! - latsw10 = nint(ulymap + 0.5 * dx30s) - nrow10 * dx10m + 0.5 * dx10m - lonsw10 = nint(ulxmap - 0.5 * dx30s) + 0.5 * dx10m - if( lonsw10 < 0.0 ) lonsw10=360.0+lonsw10 - i1 = nint( (lonsw10 - lon1_10m) / dx10m )+1 - if( i1 <= 0 ) i1 = i1 + im10 - if( i1 > im10 ) i1 = i1 - im10 - j1 = nint( (latsw10 - lat1_10m) / dx10m )+1 - -! print*,'ulymap,ulxmap,latsw10,lonsw10 = ',ulymap,ulxmap,latsw10,lonsw10 -! print*,'i1,j1 = ', i1,j1 - - call fitin(ncol10,nrow10,terr10m,psea10m,var10m,i1,j1,im10,jm10,terr,variance,land_fraction) -! -! Deallocate working space for arrays iterr, terr10m and psea10m -! - deallocate ( iterr,terr10m,psea10m,var10m,stat=dealloc_error ) - if( dealloc_error /= 0 ) then - print*,'Unexpected deallocation error for arrays iterr,terr10m,psea10m,var10m' - stop - end if - - end do - -! -! Print some info on the fields - print *, "min and max elevations: ", minval(terr), maxval(terr) - print *, "min and max variances: ", minval(variance), maxval(variance) - print *, "min and max land frac: ", minval(land_fraction), maxval(land_fraction) -! -! Write 10-min terrain dataset, variance and land_fraction to NetCDF file -! - call wrtncdf(im10,jm10,terr,variance, land_fraction,dx10m) - - end program convterr - - subroutine rdheader(nmtile,nrows,ncols,nodata,ulxmap,ulymap) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine read the header of USGA Global30 sec TOPO data set. -! - implicit none -! -! Dummy arguments -! - character (len=7), intent(in) :: nmtile ! name of the tile - integer, intent(out) :: nrows ! number of rows - integer, intent(out) :: ncols ! number of column - integer, intent(out) :: nodata ! integer for ocean data point - real(r8), intent(out) :: ulxmap - real(r8), intent(out) :: ulymap -! -! Local variables -! - character (len=11) :: flheader ! file name of the header - character (len=13) :: chars ! dummy character - - flheader=nmtile//'.HDR' - - print*,'flheader = ', flheader -! -! Open GTOPO30 Header File -! - open(unit=10,file=flheader,status='old',form='formatted') -! -! Read GTOPO30 Header file -! - read (10, *) - read (10, *) - read (10, *) chars,nrows - print*,chars,' = ',nrows - read (10, *) chars,ncols - print*,chars,' = ',ncols - read (10, *) - read (10, *) - read (10, *) - read (10, *) - read (10, *) - read (10, *) chars,nodata - print*,chars,' = ',nodata - read (10, *) chars,ulxmap - print*,chars,' = ',ulxmap - read (10, *) chars,ulymap - print*,chars,' = ',ulymap - close(10) - - end subroutine rdheader - - subroutine rdterr(nmtile,nrows,ncols,iterr) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine read the USGS Global 30-sec terrain data for each tile. -! - implicit none -! -! Dummy arguments -! - character (len=7), intent(in) :: nmtile ! name of the tile - integer, intent(in) :: nrows ! number of rows - integer, intent(in) :: ncols ! number of column - integer*2, dimension(ncols,nrows), intent(out) :: iterr ! terrain data -! -! Local variables -! - character (len=11) :: flterr ! file name for each terr dataset - integer :: io_error ! I/O status - integer :: i,j ! Index - integer :: length ! record length - - flterr=nmtile//'.DEM' - -! print*,'flterr = ', flterr -! print*,'nrows,ncols = ',nrows,ncols -! -! Open GTOPO30 Terrain dataset File -! - - length = 2 * ncols * nrows - io_error=0 - open(unit=11,file=flterr,access='direct',recl=length,iostat=io_error) - if( io_error /= 0 ) then - print*,'Open file error in subroutine rdterr' - print*,'iostat = ', io_error - stop - end if -! -! Read GTOPO30 Terrain data file -! - read (11,rec=1,iostat=io_error) ((iterr(i,j),i=1,ncols),j=1,nrows) -! - if( io_error /= 0 ) then - print*,'Data file error in subroutine rdterr' - print*,'iostat = ', io_error - stop - end if -! -! Print some info on the fields - print *, "min and max elevations: ", minval(iterr), maxval(iterr) -! -! Correct missing data in source files -! -! Missing data near dateline - - if( nmtile == 'W180S60' ) then - do j = 1, nrows - iterr(1,j) = iterr(2,j) - end do - else if (nmtile == 'E120S60') then - do j = 1, nrows - iterr(ncols-1,j) = iterr(ncols-2,j) - iterr(ncols,j) = iterr(ncols-2,j) - end do - end if -! -! Missing data at the southermost row near South pole -! - if( nmtile == 'E060S60' .or. nmtile == 'E120S60' .or. nmtile == 'W000S60' .or. & - nmtile == 'W060S60' .or. nmtile == 'W120S60' .or. nmtile == 'W180S60' ) then - do i=1,ncols - iterr(i,nrows) = iterr(i,nrows-1) - end do - end if -! -! print*,'iterr(1,1),iterr(ncols,nrows) = ', & -! iterr(1,1),iterr(ncols,nrows) - - close (11) - end subroutine rdterr - - subroutine avg(ncols,nrows,iterr,nodata,ulymap,dx30s,ncol10,nrow10,terr10m,psea10m,var10m) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine reduces the resolution of the terrain data from 30-sec to 10-min and -! compute the percentage of ocean cover (psea10m) -! - implicit none -! -! Dummy arguments -! - integer, intent(in) :: ncols ! number of column for 30-sec tile - integer, intent(in) :: nrows ! number of rows for 30-sec tile - integer*2, dimension(ncols,nrows), intent(inout) :: iterr ! terrain data for 30-sec tile - integer, intent(in) :: nodata ! integer for ocean data point - real(r8),intent(in) :: ulymap ! latitude at the center of the upper-left corner cell in the 30-sec tile - real(r8),intent(in) :: dx30s ! spacing interval for 30-sec data (in degree) - integer, intent(in) :: nrow10 ! number of rows for 10-min tile - integer, intent(in) :: ncol10 ! number of columns for 10-min tile - real(r8), dimension(ncol10,nrow10), intent(out) :: terr10m ! terrain data for 10-min tile - real(r8), dimension(ncol10,nrow10), intent(out) :: psea10m ! percentage ocean coverage for 10-min tile - real(r8), dimension(ncol10,nrow10), intent(out) :: var10m ! variance of 30-sec elevations -! -! Local variables -! - real(r8) :: lats,latn ! latitudes (in rad) for ths south and north edges of each 30-sec cell - real(r8) :: wt ! area weighting of each 30-sec cell - real(r8) :: wt_tot ! total weighting of each 10-min cell - real(r8) :: sumterr ! summation of terrain height of each 10-min cell - real(r8) :: sumsea ! summation of sea coverage of each 10-min cell - real(r8) :: pi ! pi=3.1415 - real(r8) :: latul ! latitude of the upper-left coner of 30-sec tile - integer :: n1,itmp,i1,i2,j1,j2 ! temporary working spaces - integer :: i,j,ii,jj ! index - logical, dimension(ncols,nrows) :: oflag - - pi = 4.0 * atan(1.0) -! - n1 = ncols / ncol10 - print*,'ncols,ncol10,n1 = ',ncols,ncol10,n1 - - itmp = nint( ulymap + 0.5 * dx30s ) - latul = itmp - print*,'ulymap,latul = ', ulymap,latul - oflag = .false. - - do j = 1, nrow10 - j1 = (j-1) * n1 + 1 - j2 = j * n1 - do i = 1, ncol10 - i1 = (i-1) * n1 + 1 - i2 = i * n1 - wt_tot = 0.0 - sumterr = 0.0 - sumsea = 0.0 - - do jj = j1, j2 - latn = ( latul - (jj -1) * dx30s ) * pi / 180.0 - lats = ( latul - jj * dx30s ) * pi / 180.0 - wt = sin( latn ) - sin( lats ) - - do ii = i1, i2 - wt_tot=wt_tot+wt - if ( iterr(ii,jj) == nodata ) then - sumsea = sumsea + wt - oflag(ii,jj) = .true. - else - if ( iterr(ii,jj) .lt.nodata ) then - ! this can only happen in the expand_sea routine - sumsea = sumsea + wt - oflag(ii,jj) = .true. - iterr(ii,jj) = iterr(ii,jj) - nodata - nodata - endif - sumterr = sumterr + iterr(ii,jj) * wt - end if - end do - end do - - terr10m(i,j) = sumterr / wt_tot - psea10m(i,j) = sumsea / wt_tot - - end do - end do - - ! Now compute variance of 30-second points - - do j = 1, nrow10 - j1 = (j-1) * n1 + 1 - j2 = j * n1 - - do i = 1, ncol10 - i1 = (i-1) * n1 + 1 - i2 = i * n1 - - wt_tot = 0.0 - var10m(i,j) = 0.0 - wt = 1.0 - do jj = j1, j2 - do ii = i1, i2 - wt_tot = wt_tot + wt - if ( .not. oflag(ii,jj) ) then - var10m(i,j) = var10m(i,j) + wt * (iterr(ii,jj)-terr10m(i,j))**2 - end if - end do - end do - var10m(i,j) = var10m(i,j) / wt_tot - - end do - end do - - end subroutine avg - - subroutine expand_sea(ncols,nrows,iterr,nodata,startx,starty) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine reduces the resolution of the terrain data from 30-sec to 10-min and -! compute the percentage of ocean cover (psea10m) -! - implicit none -! -! Dummy arguments -! - integer, intent(in) :: ncols ! number of column for 30-sec tile - integer, intent(in) :: nrows ! number of rows for 30-sec tile - integer*2, dimension(ncols,nrows), intent(inout) :: iterr ! terrain data for 30-sec tile - integer, intent(in) :: nodata ! integer for ocean data point - integer, intent(in) :: startx, starty ! where to begin the sea -! -! Local variables -! - real(r8):: maxh - integer :: i,j,per,ii,jj ! index - logical, dimension(0:ncols+1,0:nrows+1) :: flag ! terrain data for 30-sec tile - logical :: found - - flag = .false. - - maxh = iterr(startx,starty) - - iterr(startx,starty) = iterr(startx,starty) + nodata + nodata - flag(startx-1:startx+1,starty-1:starty+1) = .true. - - per = 0 - print *, 'expanding sea at ',maxh,' m ' - -2112 per = per + 1 - found = .false. - do j = starty - per, starty + per, per*2 - do i = startx - per, startx + per - if(i.ge.1.and.i.le.ncols.and.j.ge.1.and.j.le.nrows)then - if( iterr(i,j).eq.maxh .and. flag(i,j) ) then - iterr(i,j) = iterr(i,j) + nodata + nodata - flag(i-1:i+1,j-1:j+1) = .true. - found = .true. - endif - endif - end do - end do - - do i = startx - per, startx + per, per*2 - do j = starty - per + 1, starty + per - 1 - if(i.ge.1.and.i.le.ncols.and.j.ge.1.and.j.le.nrows)then - if( iterr(i,j).eq.maxh .and. flag(i,j) ) then - iterr(i,j) = iterr(i,j) + nodata + nodata - flag(i-1:i+1,j-1:j+1) = .true. - found = .true. - endif - endif - end do - end do - if (found)goto 2112 - print *, 'done with expand_sea' - return - - end subroutine expand_sea - - subroutine fitin(ncol10,nrow10,terr10m,psea10m,var10m,i1,j1,im10,jm10,terr,variance,land_fraction) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine put 10-min tile into the global dataset -! - implicit none -! -! Dummy arguments -! - integer, intent(in) :: ncol10 ! number of columns for 10-min tile - integer, intent(in) :: nrow10 ! number of rows for 10-min tile - real(r8), dimension(ncol10,nrow10), intent(in) :: terr10m ! terrain data for 10-min tile - real(r8), dimension(ncol10,nrow10), intent(in) :: psea10m ! percentage ocean coverage for 10-min tile - real(r8), dimension(ncol10,nrow10), intent(in) :: var10m ! variance of 30-sec elev for 10-min tile - integer, intent(in) :: i1,j1 ! the (i,j) point of the southwest corner of the 10-min tile - ! in the global grid - integer, intent(in) :: im10,jm10 ! the dimensions of the 10-min global dataset - real(r8),dimension(im10,jm10), intent(out) :: terr ! global 10-min terrain data - real(r8),dimension(im10,jm10), intent(out) :: variance ! global 10-min variance of elev - real(r8),dimension(im10,jm10), intent(out) :: land_fraction ! global 10-min land fraction -! -! Local variables -! - integer :: i,j,ii,jj ! index - - do j = 1, nrow10 - jj = j1 + (nrow10 - j) - do i = 1, ncol10 - ii = i1 + (i-1) - if( ii > im10 ) ii = ii - im10 - terr(ii,jj) = terr10m(i,j) - land_fraction(ii,jj) = 1.0 - psea10m(i,j) - variance(ii,jj) = var10m(i,j) - if( i == 1 .and. j == 1 ) & - print*,'i,j,ii,jj = ',i,j,ii,jj - if( i == ncol10 .and. j == nrow10 ) & - print*,'i,j,ii,jj = ',i,j,ii,jj - end do - end do - end subroutine fitin - - subroutine wrtncdf(im10,jm10,terr,variance,land_fraction,dx10m) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine save 10-min terrain data, variance, land fraction to NetCDF file -! - implicit none - -# include - -! -! Dummy arguments -! - integer, intent(in) :: im10,jm10 ! the dimensions of the 10-min global dataset - real(r8),dimension(im10,jm10), intent(in) :: terr ! global 10-min terrain data - real(r8),dimension(im10,jm10), intent(in) :: variance ! global 10-min variance data - real(r8),dimension(im10,jm10), intent(in) :: land_fraction !global 10-min land fraction - real(r8), intent(in) :: dx10m -! -! Local variables -! - real(r8),dimension(im10) :: lonar ! longitude array - real(r8),dimension(im10) :: latar ! latitude array - character (len=32) :: fout ! NetCDF output file - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: varianceid - integer :: htopoid - integer :: landfid - integer, dimension(2) :: variancedim,htopodim,landfdim - integer :: status ! return value for error control of netcdf routin - integer :: i,j - character (len=8) :: datestring - -! -! Fill lat and lon arrays -! - do i = 1,im10 - lonar(i)= dx10m * (i-0.5) - enddo - do j = 1,jm10 - latar(j)= -90.0 + dx10m * (j-0.5) - enddo - - fout='topo_gtopo30_10min.nc' -! -! Create NetCDF file for output -! - status = nf_create (fout, NF_WRITE, foutid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Create dimensions for output -! - status = nf_def_dim (foutid, 'lon', im10, lonid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'lat', jm10, latid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Create variable for output -! - variancedim(1)=lonid - variancedim(2)=latid - status = nf_def_var (foutid,'variance', NF_FLOAT, 2, variancedim, varianceid) - if (status .ne. NF_NOERR) call handle_err(status) - - htopodim(1)=lonid - htopodim(2)=latid - status = nf_def_var (foutid,'htopo', NF_FLOAT, 2, htopodim, htopoid) - if (status .ne. NF_NOERR) call handle_err(status) - - landfdim(1)=lonid - landfdim(2)=latid - status = nf_def_var (foutid,'landfract', NF_FLOAT, 2, landfdim, landfid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! Create attributes for output variables -! - status = nf_put_att_text (foutid,varianceid,'long_name', 29, 'variance of 30-sec elevations') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,varianceid,'units', 8, 'meter**2') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,htopoid,'long_name', 41, '10-min elevation from USGS 30-sec dataset') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,htopoid,'units', 5, 'meter') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,landfid,'long_name', 23, '10-minute land fraction') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,landfid,'units', 14, 'fraction (0-1)') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '10-minute USGS topo data') - if (status .ne. NF_NOERR) call handle_err(status) - call DATE_AND_TIME(DATE=datestring) - status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! End define mode for output file -! - status = nf_enddef (foutid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Write variable for output -! - status = nf_put_var_double (foutid, varianceid, variance) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_var_double (foutid, htopoid, terr) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_var_double (foutid, landfid, land_fraction) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_var_double (foutid, latvid, latar) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_var_double (foutid, lonvid, lonar) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! Close output file -! - status = nf_close (foutid) - if (status .ne. NF_NOERR) call handle_err(status) - - end subroutine wrtncdf -!************************************************************************ -!!handle_err -!************************************************************************ -! -!!ROUTINE: handle_err -!!DESCRIPTION: error handler -!-------------------------------------------------------------------------- - - subroutine handle_err(status) - - implicit none - -# include - - integer status - - if (status .ne. nf_noerr) then - print *, nf_strerror(status) - stop 'Stopped' - endif - - end subroutine handle_err - - diff --git a/tools/definehires/shr_kind_mod.F90 b/tools/definehires/shr_kind_mod.F90 deleted file mode 100644 index fc1ed8e94a..0000000000 --- a/tools/definehires/shr_kind_mod.F90 +++ /dev/null @@ -1,20 +0,0 @@ -!=============================================================================== -! CVS: $Id$ -! CVS: $Source$ -! CVS: $Name$ -!=============================================================================== - -MODULE shr_kind_mod - - !---------------------------------------------------------------------------- - ! precision/kind constants add data public - !---------------------------------------------------------------------------- - public - integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real - integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real - integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real - integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer - integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer - integer,parameter :: SHR_KIND_IN = kind(1) ! native integer - -END MODULE shr_kind_mod diff --git a/tools/definesurf/Makefile b/tools/definesurf/Makefile deleted file mode 100644 index dd13a5bdd4..0000000000 --- a/tools/definesurf/Makefile +++ /dev/null @@ -1,144 +0,0 @@ -# Makefile to build definesurf on various platforms -# Note: If netcdf library is not built in the standard location, you must set the environment -# variables INC_NETCDF and LIB_NETCDF - -EXEDIR = . -EXENAME = definesurf -RM = rm - -.SUFFIXES: -.SUFFIXES: .f90 .o - -# Check for the NetCDF library and include directories -ifeq ($(LIB_NETCDF),$(null)) -LIB_NETCDF := /usr/local/lib -endif - -ifeq ($(INC_NETCDF),$(null)) -INC_NETCDF := /usr/local/include -endif - -# Determine platform -UNAMES := $(shell uname -s) -UNAMEM := $(findstring CRAY,$(shell uname -m)) - -# Architecture-specific flags and rules -# -#------------------------------------------------------------------------ -# Cray -#------------------------------------------------------------------------ - -ifeq ($(UNAMEM),CRAY) -FC = f90 -FFLAGS = -c -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.f90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# SGI -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),IRIX64) -FC = f90 -FFLAGS = -64 -c -I$(INC_NETCDF) -LDFLAGS = -64 -L/usr/local/lib64/r4i4 -lnetcdf -.f90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# SUN -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),SunOS) -FC = f90 -FFLAGS = -c -stackvar -f -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.f90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# AIX -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),AIX) -FC = xlf90 -FFLAGS = -c -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.f90.o: - $(FC) $(FFLAGS) -qsuffix=f=f90 $< -endif - -#------------------------------------------------------------------------ -# OSF1 -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),OSF1) -FC = f90 -FFLAGS = -c -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.f90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# Linux -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),Linux) -ifeq ($(USER_FC),$(null)) -FC := pgf90 -FFLAGS = -c -I$(INC_NETCDF) -fast -else -FC := $(USER_FC) -endif -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf - -ifeq ($(FC),lf95) -FFLAGS = -c --trace --trap -I$(INC_NETCDF) -g -LDFLAGS += -g -endif - -.f90.o: - $(FC) $(FFLAGS) $< -endif - -#------------------------------------------------------------------------ -# Default rules and macros -#------------------------------------------------------------------------ - -OBJS := ao.o ao_i.o area_ave.o binf2c.o cell_area.o \ - chkdims.o endrun.o fmain.o handle_error.o inimland.o \ - lininterp.o map_i.o max_ovr.o shr_kind_mod.o sghphis.o sm121.o \ - terrain_filter.o varf2c.o wrap_nf.o interplandm.o map2f.o - -$(EXEDIR)/$(EXENAME): $(OBJS) - $(FC) -o $@ $(OBJS) $(LDFLAGS) - -clean: - $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) - -ao.o: shr_kind_mod.o -ao_i.o: shr_kind_mod.o -area_ave.o: shr_kind_mod.o -binf2c.o: shr_kind_mod.o -cell_area.o: shr_kind_mod.o -chkdims.o: -endrun.o: -fmain.o: shr_kind_mod.o -handle_error.o: -inimland.o: shr_kind_mod.o -lininterp.o: shr_kind_mod.o -map_i.o: shr_kind_mod.o -max_ovr.o: shr_kind_mod.o -shr_kind_mod.o: -sghphis.o: shr_kind_mod.o -sm121.o: shr_kind_mod.o -terrain_filter.o: -map2f.o: -varf2c.o: shr_kind_mod.o -wrap_nf.o: -interplandm.o: diff --git a/tools/definesurf/README b/tools/definesurf/README deleted file mode 100644 index f0d9427e8e..0000000000 --- a/tools/definesurf/README +++ /dev/null @@ -1,156 +0,0 @@ -Running gnumake in this directory will create an executable named -"definesurf". Its function is to compute required CAM initial dataset -variables SGH, PHIS, and LANDFRAC from a high-resolution topography dataset, -and LANDM_COSLAT from a T42 "master", then add or replace the values on an -existing initial dataset. SGH is the standard deviation of PHIS used in the -gravity wave drag scheme. PHIS is the geopotential height. LANDFRAC is land -fraction. LANDM_COSLAT is a field derived from LANDFRAC which is required by -the prognostic cloud water parameterization. There is a cosine(latitude) -dependence built in to the function. - -The cam standard high resolution dataset is now based on the USGS -GTOPO30 digital elevation model at 30" resolution. It is converted to -10' resolution by definehires. - -The older high resolution topography dataset (10') used by definesurf -is named topo.nc and is included as part of the CAM distribution in -the datasets tar file. topo.nc was derived from the U.S. Navy Global -Elevation 10-MIN dataset DS754.0 Please refer to the following NCAR -website for more information: - -http://www.scd.ucar.edu/dss/catalogs/geo.html - -The algorithms within this code should be considered experimental. -For example, a 1-2-1 smoothing operator (sm121, called from subroutine -sghphis) is applied twice in succession to the topography variance -field regardless of horizontal resolution. Also, a spectral filter -will be applied to the PHIS field within the CAM at model startup -(except for the fv dycore) if PHIS was defined from the high -resolution topography dataset. The model determines this by checking -for the presence of netcdf attribute "from_hires" on variable PHIS. - -------------------------------------- -Feb 01, 2005 -------------------------------------- -------------------------------------- -*********** definesurf ************** -------------------------------------- - -A 10' data file is read in and averaged to the model grid by -definesurf. The present form of definesurf also takes a model initial -condition file as input and gets model grid description from it. The -terrain data mapped to the model grid is output on a new file. - -Command line flags are used for - -t name - (required) name of 10' data file - -g name - (required) name of cam initial condition file containing grid description - -l name - (required) name of land mask file on ?? grid - -r - (optional) do not extend Ross sea (default is extend) - -v - (optional) verbose (default is false) - -del2 - (optional) filter the elevations with a del2 filter (use for fv only) - -remap - (optional) filter the elevations with a remapping filter (use for fv only) - -sgh - (optional) filter the standard deviations with same filter as height - name - (required) name of i.c. file with existing terrain data, - must be final argument - -definesurf -t topo_gtopo30_10min.nc -g cami_*.nc -l landm_coslat.nc -remap oro_GTOPO30.nc -generates the file oro_GTOPO30.nc using the remapping filter. - -definesurf calls shgphis, which recognizes 2 input 10' data file formats - Old style, no 30" variance data on 10' grid, variance = -1 - land fraction called "ftopo" - New style, 30" variance data is present - land fraction called "landfract" - - Land fraction and 30" variance (if present) are averaged to the - model grid. - - if plon >= 128 then - Height is averaged to the model grid and the variance w.r.t to the - 10' data is computed. - if plon < 128 then - Height is averaged to a 3 degree grid and the variance w.r.t to the - 10' data is computed. The avg height and the variance of - the 3 degree data are then averaged to the model grid. - - 1-2-1 smoothers are applied twice to the model grid averaged values - of the two variance fields: 10' w.r.t. model grid; 30" w.r.t. 10' - (if 30" variance is present). - - The averaged and smoothed variances are converted to standard - deviations. - - The averaged height is converted to a geopotential (z*9.80616) - -Attributes are added to input file to describe what definesurf is doing. - -Land mask for clouds is interpolated to model grid. - -Extend land to -79 degrees for Ross ice shelf, unless -r flag was -set. - -Run terrain filter, if requested (-remap or -del2). Should only be -done for fv grids. For spectral grid, filtering is done in the model -based on the value of the attribute "from_hires". - Diffusive filter or remapping is appled to - surface geopotential - standard deviation of 10' data w.r.t. model grid - standard deviation of 30" data w.r.t. 10' grid (if present) - -**** It is not clear that the filter should be applied to the -**** standard deviations. - - The remapping filter removes structure near grid scale by using the - ppm mapping code to go to a half resolution grid and back to the - full resolution grid. Order (accuracy) parameters iord=7 and jord=3 - are used. A polar filter is also applied. - -------------------------------------------------------- -******* diffusive (-del2) terrain filter notes ******** -------------------------------------------------------- - -The del2 filter is a bit of a pain to figure out from the code (as is the -spectral one applied in the model for eul and sld dycores). It looks like - -(1) h(n+1) = h(n) + c*del2(h(n)), c=0.25 - -del2(h) = div(grad(h)) - -however, buried inside the del2 routine is a scaling by -CD = 0.25*DL*DP*coszc**2, - -coszc = cos(60*pi/180) [= 0.5] -DL = 2*pi/NLON is delta lambda -DP = pi / (NLAT-1) is delta phi -so -CD = 0.0625 * 2*pi/NLON * pi/(NLAT-1) = 0.4 / NLON / (NLAT-1) - -So the scaling factor reduces as the square of the resolution, just like -a del2 coefficient should, in order to maintain a constant damping rate -at the truncation limit. -CD = 3E-5, for 2x2.5 - -However, the number of iterations is NLON/12, so there is an additional -scaling upward of diffusion with resolution. - -going back to (1) -h(n+1) = h(n) + c*CD*del2(h(n)) -c*CD = 7.57E-6 for 2x2.5 -c*CD is just dt*k for a normal diffusion equation, where dt is the time -step and k is the diffusivity on the unit sphere. For a sphere with -radius a (=6.37E6), the diffusivity is K=k*a**2 . -Then dt*K = c*CD*a**2 = 3E8 and assuming dt=3600, K = 8.5E4 - -The del4 diffusivity in the spectral case is 5E15 at T63. The equivalent -del2 coefficient is K = 5E15 * 63*64/a**2 = 5E5 to damp wave 63 at the -same rate. - -So, we have K_fv ~ 8.5E4 and K_eul ~ 5E5. So the fv damping should -actually be less than the spectral/eulerian damping. - -Also, the damping is applied 25 times in the spectral case and NLON/12 -times for fv. NLON/12 =12 for 2x2.5, =24 for 1x1.25 and =48 for -0.5x0.625. - -The big difference is that the spectral/eulerian actually uses del4, -which confines the damping much closer to grid scale. diff --git a/tools/definesurf/ao.f90 b/tools/definesurf/ao.f90 deleted file mode 100644 index 33d7494215..0000000000 --- a/tools/definesurf/ao.f90 +++ /dev/null @@ -1,141 +0,0 @@ -subroutine ao (nlon_i , nlat_i , numlon_i, lon_i , lat_i , & - nlon_o , nlat_o , numlon_o, lon_o , lat_o , & - area_o , re , mx_ovr , n_ovr , i_ovr , & - j_ovr , w_ovr ) - - use shr_kind_mod, only: r8 => shr_kind_r8 - -! ----------------------------------------------------------------- - implicit none -! ------------------------ code history --------------------------- -! source file: ao.F -! purpose: weights and indices for area of overlap between -! input and output grids -! date last revised: March 1996 -! author: Gordon Bonan -! standardized: -! reviewed: -! ----------------------------------------------------------------- - -! ------------------- input variables ----------------------------- - integer nlon_i !maximum number of input longitude points - integer nlat_i !number of input latitude points - integer numlon_i(nlat_i) !number of input lon pts for each latitude - integer nlon_o !maximum number of output longitude points - integer nlat_o !number of output latitude points - integer numlon_o(nlat_o) !number of output lon pts for each latitude - integer mx_ovr !maximum number of overlapping input cells - - real(r8) lon_i(nlon_i+1,nlat_i) !input grid cell longitude, w. edge (deg) - real(r8) lon_o(nlon_o+1,nlat_o) !output grid cell longitude, w. edge (deg) - real(r8) lat_i(nlat_i+1) !input grid cell latitude, s. edge (deg) - real(r8) lat_o(nlat_o+1) !output grid cell latitude, s. edge (deg) - real(r8) area_o(nlon_o,nlat_o) !area of output grid cell - real(r8) re !radius of earth -! ----------------------------------------------------------------- - -! ------------------- input/output variables ---------------------- - integer n_ovr(nlon_o,nlat_o ) !number of overlapping input cells - integer i_ovr(nlon_o,nlat_o,mx_ovr) !lon index, overlapping input cell - integer j_ovr(nlon_o,nlat_o,mx_ovr) !lat index, overlapping input cell - - real(r8) w_ovr(nlon_o,nlat_o,mx_ovr) !overlap weights for input cells -! ----------------------------------------------------------------- - -! ------------------- local variables ----------------------------- - integer io,ii !output and input grids longitude loop index - integer jo,ji !output and input grids latitude loop index - - real(r8) lonw,lone,dx !west, east longitudes of overlap and difference - real(r8) lats,latn,dy !south, north latitudes of overlap and difference - real(r8) deg2rad !pi/180 - real(r8) a_ovr !area of overlap - real(r8) zero,one - parameter (zero=0.0) ! Needed as arg to "max" - parameter (one=1.) ! Needed as arg to "atan" -! ----------------------------------------------------------------- - - deg2rad = (4.*atan(one)) / 180. - -! ----------------------------------------------------------------- -! for each output grid cell: find overlapping input grid cell and area of -! input grid cell that overlaps with output grid cell. cells overlap if: -! -! southern edge of input grid < northern edge of output grid AND -! northern edge of input grid > southern edge of output grid -! -! western edge of input grid < eastern edge of output grid AND -! eastern edge of input grid > western edge of output grid -! -! lon_o(io,jo) lon_o(io+1,jo) -! -! | | -! --------------------- lat_o(jo+1) -! | | -! | | -! xxxxxxxxxxxxxxx lat_i(ji+1) | -! x | x | -! x input | x output | -! x cell | x cell | -! x ii,ji | x io,jo | -! x | x | -! x ----x---------------- lat_o(jo ) -! x x -! xxxxxxxxxxxxxxx lat_i(ji ) -! x x -! lon_i(ii,ji) lon_i(ii+1,ji) -! ----------------------------------------------------------------- - -! note that code does not vectorize but is only called during -! initialization. - - do jo = 1, nlat_o - do io = 1, numlon_o(jo) - -! loop through all input grid cells to find overlap with output grid. - - do ji = 1, nlat_i - if ( lat_i(ji ).lt.lat_o(jo+1) .and. & - lat_i(ji+1).gt.lat_o(jo ) ) then !lat ok - - do ii = 1, numlon_i(ji) - if ( lon_i(ii ,ji).lt.lon_o(io+1,jo) .and. & - lon_i(ii+1,ji).gt.lon_o(io ,jo) ) then !lon okay - -! increment number of overlapping cells. make sure 0 < n_ovr < mx_ovr - - n_ovr(io,jo) = n_ovr(io,jo) + 1 -! if (n_ovr(io,jo) .gt. mx_ovr) then -! write (6,*) 'AO error: n_ovr= ',n_ovr(io,jo), & -! ' exceeded mx_ovr = ',mx_ovr, & -! ' for output lon,lat = ',io,jo -! call endrun -! end if - -! determine area of overlap - - lone = min(lon_o(io+1,jo),lon_i(ii+1,ji))*deg2rad !e edge - lonw = max(lon_o(io ,jo),lon_i(ii ,ji))*deg2rad !w edge - dx = max(zero,(lone-lonw)) - latn = min(lat_o(jo+1),lat_i(ji+1))*deg2rad !n edge - lats = max(lat_o(jo ),lat_i(ji ))*deg2rad !s edge - dy = max(zero,(sin(latn)-sin(lats))) - a_ovr = dx*dy*re*re - -! determine indices and weights. re cancels in the division by area - - i_ovr(io,jo,n_ovr(io,jo)) = ii - j_ovr(io,jo,n_ovr(io,jo)) = ji - w_ovr(io,jo,n_ovr(io,jo)) = a_ovr/area_o(io,jo) - - end if - end do - - end if - end do - - end do - end do - - return -end subroutine ao diff --git a/tools/definesurf/ao_i.f90 b/tools/definesurf/ao_i.f90 deleted file mode 100644 index 87b96eb815..0000000000 --- a/tools/definesurf/ao_i.f90 +++ /dev/null @@ -1,178 +0,0 @@ -subroutine ao_i(nlon_i , nlat_i , numlon_i, lon_i , lat_i , & - nlon_o , nlat_o , numlon_o, lon_o , lat_o , & - mx_ovr , i_ovr , j_ovr , w_ovr , re , & - area_o , relerr ) - - use shr_kind_mod, only: r8 => shr_kind_r8 - -! ----------------------------------------------------------------- - implicit none -! ------------------------ code history --------------------------- -! source file: ao_i.F -! purpose: area averaging initialization: indices and weights -! date last revised: November 1996 -! author: Gordon Bonan -! standardized: -! reviewed: -! ----------------------------------------------------------------- - -! ------------------------ notes ---------------------------------- -! get indices and weights for area-averaging between input and output grids - -! o input grid does not have to be finer resolution than output grid - -! o both grids must be oriented south to north, i.e., cell(lat+1) -! must be north of cell(lat). the southern edge of the first row -! must be -90 (south pole) and the northern edge of the last row -! must be +90 (north pole) - -! o both grids must be oriented eastwards, i.e., cell(lon+1) must be -! east of cell(lon). but the two grids do not have to start at the -! same longitude, i.e., one grid can start at dateline and go east; -! the other grid can start at greenwich and go east. longitudes for -! the western edge of the cells must increase continuously and span -! 360 degrees. examples -! dateline : -180 to 180 (- longitudes west of greenwich) -! greenwich : 0 to 360 -! greenwich (centered): -dx/2 to -dx/2 + 360 (- longitudes west of greenwich) - -! for each output grid cell -! o number of input grid cells that overlap with output grid cell (n_ovr) -! o longitude index (1 <= i_ovr <= nlon_i) of the overlapping input grid cell -! o latitude index (1 <= j_ovr <= nlat_i) of the overlapping input grid cell - -! for field values fld_i on an input grid with dimensions nlon_i and nlat_i -! field values fld_o on an output grid with dimensions nlon_o and nlat_o are -! fld_o(io,jo) = -! fld_i(i_ovr(io,jo, 1),j_ovr(io,jo, 1)) * w_ovr(io,jo, 1) + -! ... + ... + -! fld_i(i_ovr(io,jo,mx_ovr),j_ovr(io,jo,mx_ovr)) * w_ovr(io,jo,mx_ovr) - -! error check: overlap weights of input cells sum to 1 for each output cell -! ----------------------------------------------------------------- - -! ------------------- input variables ----------------------------- - integer nlon_i !input grid max number of input longitude points - integer nlat_i !input grid number of input latitude points - integer numlon_i(nlat_i) !input grid number of lon points for each lat - integer nlon_o !output grid max number of output lon points - integer nlat_o !output grid number of output latitude points - integer numlon_o(nlat_o) !output grid number of lon points for each lat - integer mx_ovr !max num of input cells that overlap output cell - - real(r8) lon_i(nlon_i+1,nlat_i) !input grid cell lon, western edge (degrees) - real(r8) lon_o(nlon_o+1,nlat_o) !output grid cell lon, western edge (degrees) - real(r8) lat_i(nlat_i+1) !input grid cell lat, southern edge (degrees) - real(r8) lat_o(nlat_o+1) !output grid cell lat, southern edge (degrees) - real(r8) area_o(nlon_o,nlat_o) !cell area on output grid - real(r8) re !radius of earth - real(r8) relerr !max error: sum overlap weights ne 1 -! ----------------------------------------------------------------- - -! ------------------- output variables ---------------------------- - integer i_ovr(nlon_o,nlat_o,mx_ovr) !lon index, overlapping input cell - integer j_ovr(nlon_o,nlat_o,mx_ovr) !lat index, overlapping input cell - real(r8) w_ovr(nlon_o,nlat_o,mx_ovr) !overlap weights for input cells -! ----------------------------------------------------------------- - -! ------------------- local variables ----------------------------- - integer io,ii !input and output grids longitude loop index - integer jo,ji !input and output grids latitude loop index - integer n !overlapping cell index - - real(r8) offset !used to shift x-grid 360 degrees - real(r8) f_ovr !sum of overlap weights for cells on output grid -! -! Dynamic -! - integer n_ovr(nlon_o,nlat_o) !number of overlapping input cells - -! ----------------------------------------------------------------- -! initialize overlap weights on output grid to zero for maximum -! number of overlapping points. set lat and lon indices of overlapping -! input cells to dummy values. set number of overlapping cells to zero -! ----------------------------------------------------------------- - - do n = 1, mx_ovr - do jo = 1, nlat_o - do io = 1, numlon_o(jo) - i_ovr(io,jo,n) = 1 - j_ovr(io,jo,n) = 1 - w_ovr(io,jo,n) = 0. - end do - end do - end do - - do jo = 1, nlat_o - do io = 1, numlon_o(jo) - n_ovr(io,jo) = 0 - end do - end do - -! ----------------------------------------------------------------- -! first pass to find cells that overlap, area of overlap, and weights -! ----------------------------------------------------------------- - - call ao (nlon_i , nlat_i , numlon_i, lon_i , lat_i , & - nlon_o , nlat_o , numlon_o, lon_o , lat_o , & - area_o , re , mx_ovr , n_ovr , i_ovr , & - j_ovr , w_ovr ) - -! ----------------------------------------------------------------- -! second pass to find cells that overlap, area of overlap, and weights -! ----------------------------------------------------------------- - -! shift x-grid to locate periodic grid intersections -! the following assumes that all lon_i(1,:) have the same value -! independent of latitude and that the same holds for lon_o(1,:) - - if (lon_i(1,1) .lt. lon_o(1,1)) then - offset = 360.0 - else - offset = -360.0 - end if - - do ji = 1,nlat_i - do ii = 1, numlon_i(ji) + 1 - lon_i(ii,ji) = lon_i(ii,ji) + offset - end do - end do - -! find overlap - - call ao (nlon_i , nlat_i , numlon_i , lon_i , lat_i , & - nlon_o , nlat_o , numlon_o , lon_o , lat_o , & - area_o , re , mx_ovr , n_ovr , i_ovr , & - j_ovr , w_ovr ) - -! restore x-grid (un-shift x-grid) - - do ji = 1,nlat_i - do ii = 1, numlon_i(ji) + 1 - lon_i(ii,ji) = lon_i(ii,ji) - offset - end do - end do - -! ----------------------------------------------------------------- -! error check: overlap weights for input grid cells must sum to 1 -! ----------------------------------------------------------------- - - do jo = 1, nlat_o - do io = 1, numlon_o(jo) - f_ovr = 0. - - do n = 1, mx_ovr - f_ovr = f_ovr + w_ovr(io,jo,n) - end do - - if (abs(f_ovr-1.) .gt. relerr) then - write (6,*) 'AO_I error: area not conserved for',' lon,lat = ', io,jo - write (6,'(a30,e20.10)') ' sum of overlap weights = ', f_ovr - call endrun - end if - - end do - end do - - return -end subroutine ao_i diff --git a/tools/definesurf/area_ave.f90 b/tools/definesurf/area_ave.f90 deleted file mode 100644 index cbcdbcd3af..0000000000 --- a/tools/definesurf/area_ave.f90 +++ /dev/null @@ -1,59 +0,0 @@ -subroutine area_ave (nlat_i , nlon_i , numlon_i, fld_i , & - nlat_o , nlon_o , numlon_o, fld_o , & - i_ovr , j_ovr , w_ovr , nmax ) - - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none -! ------------------------ code history --------------------------- -! source file: area_ave.F -! purpose: area averaging of field from input to output grids -! date last revised: November 1996 -! author: Gordon Bonan -! standardized: -! reviewed: -! ----------------------------------------------------------------- - -! ------------------- input variables ----------------------------- - integer nlat_i ! number of latitude points for input grid - integer nlat_o ! number of latitude points for output grid - integer nlon_i ! maximum number of longitude points for input grid - integer nlon_o ! maximum number of longitude points for output grid - integer nmax ! maximum number of overlapping cells - integer numlon_i(nlat_i) ! input grid number of lon points at each lat - integer numlon_o(nlat_o) ! input grid number of lon points at each lat - integer i_ovr(nlon_o,nlat_o,nmax) ! lon index, overlapping input cell - integer j_ovr(nlon_o,nlat_o,nmax) ! lat index, overlapping input cell - - real(r8) fld_i(nlon_i,nlat_i) !field for input grid - real(r8) w_ovr(nlon_o,nlat_o,nmax) ! overlap weights for input cells -! ----------------------------------------------------------------- - -! ------------------- output variables ---------------------------- - real(r8) fld_o(nlon_o,nlat_o) !field for output grid -! ----------------------------------------------------------------- - -! ------------------- local variables ----------------------------- - integer jo,ji !latitude index for output,input grids - integer io,ii !longitude index for output,input grids - integer n !overlapping cell index -! ----------------------------------------------------------------- - - do jo = 1, nlat_o - do io =1, numlon_o(jo) - fld_o(io,jo) = 0. - end do - end do - - do n = 1, nmax - do jo = 1, nlat_o - do io =1, numlon_o(jo) - ii = i_ovr(io,jo,n) - ji = j_ovr(io,jo,n) - fld_o(io,jo) = fld_o(io,jo) + w_ovr(io,jo,n)*fld_i(ii,ji) - end do - end do - end do - - return -end subroutine area_ave diff --git a/tools/definesurf/binf2c.f90 b/tools/definesurf/binf2c.f90 deleted file mode 100644 index f43ca19ee4..0000000000 --- a/tools/definesurf/binf2c.f90 +++ /dev/null @@ -1,218 +0,0 @@ -subroutine binf2c(flon , flat ,nflon ,nflat ,fine , & - clon , clat ,nclon ,nclat ,cmean ) - - use shr_kind_mod, only: r8 => shr_kind_r8 - -!----------------------------------------------------------------------------- -! Bin going from a fine grid to a coarse grid. -! A schematic for the coarse and fine grid systems is shown in -! Figure 1. This code assumes that each data point is represent -! it's surrounding area, called a cell. The first grid data point -! for both grids is assumed to be located at 0E (GM). This -! implies that the 1st cell for both the fine and the coarse grids -! strattles the Greenwich Meridian (GM). This code also assumes -! that there is no data wraparound (last data value is located at -! 360-dx). -! -! FIGURE 1: Overview of the coarse (X) and fine (@) grids -! longitudinal structure where: -! X = location of each coarse grid data point -! @ = location of each fine grid data point -! -! Greenwich Greenwich -! 0 Coarse cells 360 -! : v : -! clon(1): clon(2) v clon(3) clon(nclon): -! v : v v v v : -! xxxxxxxxxxxxxxxxxxxxxxxxxxxx..xxxxxxxxxxxxxxxx : -! x x x x x : -! x x x x x : -! x c(1) x c(2) x x c(nclon)x : -! x X x X x x X x : -! x ___ ___ ___ ___ ___ ___ ___ ___ ___ ___ ___ : -! x | | | | | | | | | | | | | : -! x | @ | @ | @ | @ | @ | @ |..| @ | @ | @ | @ | @ | : -! xxx|___|___|___|___|___|___| |___|___|___|___|___| : -! v v v v v : -! flon(1) flon(3) v flon(nflon-1) flon(nflon) -! : v : -! : Fine cells : -! 0 360 -! -! The Longitude/Latitude search: -! ------------------------------ -! -! Given a coarse grid cell with west and east boundaries of cWest -! and cEast and south and north boundaries of cSouth and cNorth -! (outlined by "x" in figure 2), find the indices of the fine grid -! points which are contained within the coarse grid cell. imin and -! imax are the indices fine grid points which overlap the western -! and eastern boundary of the coarse cell. jmin and jmax are the -! corresponding indices in the S-N direction. Bin these overlapping -! values to generate coarse(n), the coarse grid data values. -! -! FIGURE 2: Detail of Coarse and Fine cell overlap. -! @ = fine grid data point -! X = coarse grid data point -! -! cWest cEast -! | | x | | x | -! -@-------@---x---@-------@-----x-@- -! | | x*xxxxxxxxxxxxxxxxx*x|xx cNorth -! | | x | | x | -! | | x | | x | -! @-------@---x---@-------@-----x-@- jmax -! | | x | c(n) | x | -! | @ | x | | x | -! | | x | | x | -! @-------@---x---@-------@-----x-@- jmin -! | | x | | x | -! | @ | x*xxxxxxx@xxxxxxxxx*x|xx cSouth -! | | x | | x | -! -@-------@---x---@-------@-----x-@- -! | imin imax | -! -! -! When a cell coarse cell strattles the Greenwich Meridian -! --------------------------------------------------------- -! -! The first coarse grid cell strattles the GM, so when the western -! boundary of the coarse cell is < 0, an additional search is carried out. -! It ASSUMES that the easternmost fine grid point overlaps and searches -! westward from nflon, looking for a grid point west of clon(1) -! This generates a second set of longitudinal indices, imin1 and imax1. -! See Figure 3. -! -! Figure 3: Detail of Coarse cell strattling GM: -! ----------------------------------------------- -! -! Greenwich Greenwich -! 0 360 -! cWest : cEast cWest : -! clon(1): clon(2) clon(nclon+1)=clon(1) -! v : v v : -! xxxxxxxxxxxxxxxxxxxxxxx ... xxxxxxxxxxxxxxxx : -! x x x x x : -! x x x x x : -! x c(1) x x x c(nclon)x : -! x X x x x X x : -! x ___ ___ ___ _ ___ ___ ___ : -! x | | | | | | | : -! x | @ | @ | @ | @ | @ | @ | : -! xxx|___|___|___|_ ___|___|___| : -! ^ : ^ ^ ^ ^ : -! flon(1): ^ flon(3) flon(nflon-1) ^ : -! ^ : ^ ^ ^ : -! ^ :flon(2) ^ flon(nflon) -! ^ : ^ ^ ^ : -! imin : imax imin1 imax1 : -! : : -! -! -! In this case, imin=1, imax=2, imin1=nflon-1 and imax1=nflon. -! because the last two cells of the fine grid will have some -! contribution the the 1st cell of the coarse grid. -! -!----------------------------------------------------------------------- - implicit none -!-----------------------------Arguments--------------------------------- - - integer nflon ! Input: number of fine longitude points - integer nflat ! Input: number of fine latitude points - integer nclon ! Input: number of coarse longitude points - integer nclat ! Input: number of coarse latitude points - - real(r8) flon(nflon) ! Input: fine grid lons, centers (deg) - real(r8) flat(nflat) ! Input: fine grid lats, centers (deg) - real(r8) fine(nflon,nflat) ! Input: Fine grid data array - real(r8) clon(nclon+1,nclat) ! Input: coarse grid cell lons, west edge (deg) - real(r8) clat(nclat+1) ! Input: coarse grid cell lat, south edge (deg) - real(r8) cmean(nclon,nclat) ! Output: mean of fine grid points over coarse cell - -!--------------------------Local variables------------------------------ - - real(r8) cWest ! Coarse cell longitude, west edge (deg) - real(r8) cEast ! Coarse cell longitude, east edge (deg) - real(r8) cSouth ! Coarse cell latitude, south edge (deg) - real(r8) cNorth ! Coarse cell latitude, notrh edge (deg) - real(r8) sum ! coarse tmp value - - integer i,j ! Indices - integer imin ,imax ! Max/Min E-W indices of intersecting fine cell. - integer imin1,imax1 ! fine E-W indices when coarse cell strattles GM - integer jmin ,jmax ! Max/Min N-S indices of intersecting fine cell. - integer iclon,jclat ! coarse grid indices - integer num ! increment - -!----------------------------------------------------------------------------- - - do jclat= 1,nclat ! loop over coarse latitudes - cSouth = clat(jclat) - cNorth = clat(jclat+1) - - do iclon=1,nclon ! loop over coarse longitudes - cWest = clon(iclon,jclat) - cEAST = clon(iclon+1,jclat) - -! 1. Normal longitude search: Find imin and imax - - imin = 0 - imax = 0 - do i=1,nflon-1 ! loop over fine lons, W -> E - if (flon(i) .gt. cEast) goto 10 ! fine grid point is E of coarse box - if (flon(i) .ge. cWest .and. imin.eq.0) imin=i - imax=i - enddo - -! 2. If cWest < 0, then coarse cell strattles GM. Hunt westward -! from the end to find indices of any overlapping fine grid cells: -! imin1 and imax1. - -10 imin1 = 0 ! borders for cWest, cEast - imax1 = -1 ! borders for cWest, cEast - if (cWest .lt. 0) then - cWest = cWest + 360. - imax1 = nflon - do i=nflon,1,-1 ! loop over fine lons, E -> W - imin1=i - if (flon(i) .le. cWest) goto 20 ! fine grid point is W of coarse box - enddo - endif - -! 3. Do the latitude search S -> N for jmin and jmax - -20 jmin = 0 - jmax = 0 - do j=1,nflat ! loop over fine lats, S -> N - if (flat(j) .gt. cNorth) goto 30 ! fine grid point is N of coarse box - if (flat(j) .ge. cSouth .and. jmin.eq.0) jmin=j - jmax=j - enddo -30 continue - -! 4. Sum - - sum = 0. ! Initialize coarse data value - num = 0 - - do j=jmin,jmax ! loop over fine lats, S -> N - do i=imin,imax ! loop over fine lons, W -> E - sum = sum + fine(i,j) - num = num + 1 - enddo - do i=imin1,imax1 ! If coarse cell strattles GM - sum = sum + fine(i,j) - num = num + 1 - enddo - enddo - - if (num .gt. 0) then - cmean(iclon,jclat) = sum/num - else - cmean(iclon,jclat) = 1.e30 - endif - - end do - end do - return -end subroutine binf2c diff --git a/tools/definesurf/cell_area.f90 b/tools/definesurf/cell_area.f90 deleted file mode 100644 index 2e8272aaeb..0000000000 --- a/tools/definesurf/cell_area.f90 +++ /dev/null @@ -1,51 +0,0 @@ -subroutine cell_area (nlat, nlon, numlon, lon_w, lat_s, re, area) - - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none -! ------------------------ code history --------------------------- -! source file: cell_area.F -! purpose: area of grid cells -! date last revised: March 1996 -! author: Gordon Bonan -! standardized: -! reviewed: -! ----------------------------------------------------------------- - -! ------------------- input variables ----------------------------- - integer nlat !number of latitude points - integer nlon !maximum number of longitude points - integer numlon(nlat) !number of longitude points for each latitude - real(r8) lon_w(nlon+1,nlat) !grid cell longitude, western edge (degrees) - real(r8) lat_s(nlat+1) !grid cell latitude, southern edge (degrees) -! ----------------------------------------------------------------- - -! ------------------- output variables ---------------------------- - real(r8) re !radius of earth (km) - real(r8) area(nlon,nlat) !cell area (km**2) -! ----------------------------------------------------------------- - -! ------------------- local variables ----------------------------- - integer i !longitude index - integer j !latitude index - - real(r8) dx !cell width - real(r8) dy !cell length - real(r8) deg2rad !pi/180 - real(r8) one - parameter (one=1.) ! Argument to atan -! ----------------------------------------------------------------- - - deg2rad = (4.*atan(one)) / 180. - re = 6371.227709 - - do j = 1, nlat - do i = 1, numlon(j) - dx = (lon_w(i+1,j)-lon_w(i,j)) * deg2rad - dy = sin(lat_s(j+1)*deg2rad) - sin(lat_s(j)*deg2rad) - area(i,j) = dx*dy*re*re - end do - end do - - return -end subroutine cell_area diff --git a/tools/definesurf/chkdims.f90 b/tools/definesurf/chkdims.f90 deleted file mode 100644 index cb9be4ce32..0000000000 --- a/tools/definesurf/chkdims.f90 +++ /dev/null @@ -1,52 +0,0 @@ -subroutine chkdims (fileid, name, varid, londimid, latdimid, timdimid, verbose) - - implicit none - - include 'netcdf.inc' - - integer fileid, varid, londimid, latdimid - integer timdimid - logical verbose - character*(*) name - - integer ret - integer ndims, dimids(nf_max_dims) - - ret = nf_inq_varid (fileid, name, varid) - - if (ret.eq.NF_NOERR) then - - dimids(:) = -999 - ret = nf_inq_varndims (fileid, varid, ndims) - ret = nf_inq_vardimid (fileid, varid, dimids) - - if (ret.ne.NF_NOERR) then - write(6,*)'NF_INQ_VAR failed for ',name - call handle_error (ret) - end if - - if (ndims.eq.3 .and. dimids(3).ne.timdimid) then - write(6,*)'3rd dim of ', name, ' must be time' - call endrun - end if - - if (dimids(1).ne.londimid .or. dimids(2).ne.latdimid) then - write(6,*)'Dims of ', name,' must be lon by lat' - call endrun - end if - - if (verbose) write(6,*)'Overwriting existing ',name,' with hi-res topo' - - else - - dimids(1) = londimid - dimids(2) = latdimid - dimids(3) = timdimid - if (verbose) write(6,*)name,' does not exist on netcdf file: Creating.' - ret = nf_redef (fileid) - ret = nf_def_var (fileid, name, NF_DOUBLE, 3, dimids, varid) - if (ret.ne.NF_NOERR) call handle_error (ret) - ret = nf_enddef (fileid) - - end if -end subroutine chkdims diff --git a/tools/definesurf/endrun.f90 b/tools/definesurf/endrun.f90 deleted file mode 100644 index 71b2194a6f..0000000000 --- a/tools/definesurf/endrun.f90 +++ /dev/null @@ -1,7 +0,0 @@ -subroutine endrun - implicit none - include 'netcdf.inc' - - call abort - stop 999 -end subroutine endrun diff --git a/tools/definesurf/fmain.f90 b/tools/definesurf/fmain.f90 deleted file mode 100644 index c14b337c64..0000000000 --- a/tools/definesurf/fmain.f90 +++ /dev/null @@ -1,458 +0,0 @@ -program fmain - - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none - - include 'netcdf.inc' -! -! Local workspace -! - real(r8), parameter :: fillvalue = 1.d36 - real(r8), parameter :: filter_coefficient = 0.25D0 - - character(len=128) :: topofile = ' ' ! input high resolution (10 min) file name - character(len=128) :: landmfile = ' ' ! input land mask file name - character(len=128) :: gridfile = ' ' ! input initial condition file with grid definition - character(len=128) :: outbcfile = ' ' ! output boundary condition file with PHIS, SGH, etc. - character(len= 80) :: arg ! used for parsing command line arguments - character(len=256) :: cmdline ! input command line - character(len=256) :: history ! history attribute text - character(len= 8) :: datestring - character(len= 32) :: z_filter_type ! type of filter applied to height - character(len= 32) :: s_filter_type ! type of filter applied to standard deviations - - logical verbose ! Add print statements - logical make_ross ! Make Ross ice shelf south of -79 - logical filter_del2 ! Execute SJ Lin's del2 terrain filter - logical filter_remap ! Execute SJ Lin's newer remapping terrain filter - logical filter_sgh ! Filter SGH and SGH30 in addition to height - logical reduced_grid ! reduced grid defined - logical have_sgh30 ! input topofile has sgh30, output will also - - integer cmdlen ! character array lengths - integer gridid - integer foutid ! output file id - integer lonid, londimid, rlonid ! longitude dimension variable ids - integer latid, latdimid ! latitude dimension variable ids - integer sghid, phisid, landfid, nlonid, landmid, sgh30id ! output variable netcdf ids - integer start(4), count(4) - integer plon, nlat - integer i, j - integer ret - integer nargs ! input arg - integer n ! index loops thru input args - - integer dim(2) ! dimension list for output variables - - integer , allocatable :: nlon(:) - real(r8), allocatable :: mlatcnts(:) ! model cell center latitudes - real(r8), allocatable :: mloncnts(:,:) ! model cell center longitudes - real(r8), allocatable :: sgh(:,:) - real(r8), allocatable :: sgh30(:,:) - real(r8), allocatable :: phis(:,:) - real(r8), allocatable :: fland(:,:) - real(r8), allocatable :: landm(:,:) - - integer iargc - external iargc -! -! Default settings before parsing argument list -! - verbose = .false. - make_ross = .true. - filter_del2 = .false. - filter_remap = .false. - filter_sgh = .false. - reduced_grid = .false. - -! parse input arguments - - nargs = iargc() - n = 1 - cmdline = char(10) // 'definesurf ' - do while (n .le. nargs) - arg = ' ' - call getarg (n, arg) - n = n + 1 - - select case (arg) -! topography file name (10') - case ('-t') - call getarg (n, arg) - n = n + 1 - topofile = arg - cmdline = trim(cmdline) // ' -t ' // trim(topofile) -! grid file name - case ('-g') - call getarg (n, arg) - n = n + 1 - gridfile = arg - cmdline = trim(cmdline) // ' -g ' // trim(gridfile) -! verbose mode - case ('-v') - verbose = .true. - cmdline = trim(cmdline) // ' -v' -! landmask file name - case ('-l') - call getarg (n, arg) - n = n + 1 - landmfile = arg - cmdline = trim(cmdline) // ' -l ' // trim(landmfile) -! extend Ross Sea - case ('-r') - make_ross = .false. - cmdline = trim(cmdline) // ' -r' -! use del2 filter on heights - case ('-del2') - filter_del2 = .true. - cmdline = trim(cmdline) // ' -del2' -! use remap filter on heights - case ('-remap') - filter_remap = .true. - cmdline = trim(cmdline) // ' -remap' -! apply filter to sgh (and sgh30) in addition to height - case ('-sgh') - filter_sgh = .true. - cmdline = trim(cmdline) // ' -sgh' -! not one of the above, must be output file name - case default - if (outbcfile .eq. ' ') then - outbcfile = arg - else - write (6,*) 'Argument ', arg,' is not known' - call usage_exit (' ') - end if - cmdline = trim(cmdline) // ' ' // trim(arg) - end select - end do - - if (outbcfile == ' ') then - call usage_exit ('Must enter an output file name') - end if - - if (gridfile == ' ') then - call usage_exit ('Must enter gridfile name via -g arg (can use a model history file)') - end if - - if (topofile == ' ') then - call usage_exit ('Must enter topofile name via -t arg') - end if - - if (filter_remap .and. filter_del2) then - write(6,*)'Both filter_remap and filter_del2 set: using filter_remap' - end if - - if (.not. filter_remap .and. .not. filter_del2) then - write(6,*)'No filter being applied to height field' - if (filter_sgh) call usage_exit ('Must filter height to filter sgh') - end if - - if (landmfile == ' ') then - call usage_exit ('Must enter landmfile name via -l arg') - end if - -! Open the grid file - ret = nf_open (trim(gridfile), nf_nowrite, gridid) - if (ret /= nf_noerr) then - write(6,*)nf_strerror(ret) - write(6,*)'Unable to open input file ', trim(gridfile), ' for writing' - stop 999 - end if - -! Get the grid dimensions from the grid file - call wrap_inq_dimid (gridid, 'lon', londimid) - call wrap_inq_dimlen (gridid, londimid, plon ) - call wrap_inq_dimid (gridid, 'lat', latdimid) - call wrap_inq_dimlen (gridid, latdimid, nlat ) -! -! Get longitude and latitude arrays for model grid. -! If reduced grid, 2-d variable containing lon values for each lat is called "rlon". -! First allocate space for dynamic arrays now that sizes are known -! - allocate (nlon(nlat)) - allocate (mlatcnts(nlat)) - allocate (mloncnts(plon,nlat)) - - if (nf_inq_varid (gridid, 'nlon', nlonid) == nf_noerr) then - if (nf_get_var_int (gridid, nlonid, nlon) /= nf_noerr) then - write(6,*)'nf_get_var_int() failed for nlon' - call endrun - end if - reduced_grid = .true. - else - nlon(:) = plon - end if - - do j=1,nlat - if (nlon(j)<1 .or. nlon(j)>plon) then - write(6,*)'nlon(',j,')=',nlon(j),' is invalid.' - write(6,*)'Must be between 1 and ',plon - call endrun - end if - end do - - call wrap_inq_varid (gridid, 'lat', latid) - call wrap_get_var8 (gridid, latid, mlatcnts) - - if (nf_inq_varid (gridid, 'lon', lonid) == nf_noerr) then - call wrap_get_var8 (gridid, lonid, mloncnts(1,1)) - do j=2,nlat - mloncnts(:,j) = mloncnts(:,1) - end do - else - call wrap_inq_varid (gridid, 'rlon', rlonid) - call wrap_get_var8 (gridid, rlonid, mloncnts) - end if - -! Close the grid file - if (nf_close (gridid) == nf_noerr) then - write(6,*) 'close grid file ', trim(gridfile) - else - write(6,*) 'ERROR CLOSING NETCDF FILE ',trim(gridfile) - end if -! -! Allocate space for variables -! - allocate (sgh(plon,nlat)) - allocate (sgh30(plon,nlat)) - allocate (phis(plon,nlat)) - allocate (fland(plon,nlat)) - allocate (landm(plon,nlat)) -! -! Determine model topographic height and 2 standard deviations -! - call sghphis (plon, nlat, nlon, mlatcnts, mloncnts, topofile, & - verbose, sgh, sgh30, have_sgh30, phis, fland) - -! Do the terrain filter. -! Note: not valid if a reduced grid is used. - if (filter_remap) then - z_filter_type = 'remap' - write(6,*)'Remapping terrain filtering' -! 7 and 3 are the recommended mapping accuracy settings - call map2f (plon, nlat, phis, 7, 3, .true.) - if (filter_sgh) then - s_filter_type = 'remap' - write(6,*)'Filtering standard deviation' - call map2f (plon, nlat, sgh, 7, 3, .true.) - if(have_sgh30) call map2f(plon, nlat, sgh30, 7, 3, .true.) - else - s_filter_type = 'none (2x[1-2-1])' - write(6,*)'Not filtering standard deviation' - end if - else if (filter_del2) then - z_filter_type = 'del2' - write(6,*) 'Del2 Terrain filtering' - call sm2(plon, nlat, phis, plon/12, filter_coefficient) - if (filter_sgh) then - s_filter_type = 'del2' - write(6,*)'Filtering standard deviation' - call sm2(plon, nlat, sgh, plon/12, filter_coefficient) - if(have_sgh30) call sm2(plon, nlat, sgh30, plon/12, filter_coefficient) - else - s_filter_type = 'none (2x[1-2-1])' - write(6,*)'Not filtering standard deviation' - end if - else - z_filter_type = 'none' - s_filter_type = 'none (2x[1-2-1])' - endif -! -! Adjustments to land fraction: -! 1. Extend land fraction for Ross Ice shelf -! 2. Set land fractions < .001 to 0.0 -! 3. flag regions outside reduced grid -! - do j=1,nlat - do i=1,nlon(j) -! -! Overwrite FLAND flag as land for Ross ice shelf - if (make_ross .and. mlatcnts(j) < -79.) then - fland(i,j) = 1. - end if - - if (fland(i,j) < .001_r8) fland(i,j) = 0.0 - - end do -! -! Fill region outside reduced grid with flag values - do i=nlon(j)+1,plon - sgh(i,j) = fillvalue - if(have_sgh30) sgh30(i,j) = fillvalue - phis(i,j) = fillvalue - fland(i,j) = fillvalue - landm(i,j) = fillvalue - end do - end do -! -! Calculate LANDM field required by cloud water. -! -!JR Replace original resolution-dependent calculation with interpolation. -!JR -!JR call inimland (plon, nlat, nlon, mlatcnts, mloncnts, topofile, & -!JR verbose, make_ross, landm) -! - call interplandm (plon, nlat, nlon, mlatcnts, mloncnts, & - landmfile, landm) - -! Create NetCDF file for output - ret = nf_create (outbcfile, NF_CLOBBER, foutid) - if (ret .ne. NF_NOERR) call handle_error(ret) - -! Create dimensions for output - call wrap_def_dim (foutid, 'lon', plon, lonid) - call wrap_def_dim (foutid, 'lat', nlat, latid) - dim(1)=lonid - dim(2)=latid - -! Create latitude dimension variable for output - ret = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latdimid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_text (foutid,latdimid,'long_name', 'latitude') - call wrap_put_att_text (foutid,latdimid,'units' , 'degrees_north') - -! Create longitude dimension variable for output - if (.not.reduced_grid) then - ret = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, londimid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_text (foutid,londimid,'long_name', 'longitude') - call wrap_put_att_text (foutid,londimid,'units' , 'degrees_east') - -! For reduced grid, add longitude limits (nlon) and lons (rlon) - else - ret = nf_def_var (foutid,'nlon', NF_INT, 1, lonid, londimid) - if (ret .ne. NF_NOERR) call handle_error(ret) - ret = nf_def_var (foutid,'rlon', NF_DOUBLE, 2, dim, rlonid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_text (foutid,rlonid,'long_name', 'longitude') - call wrap_put_att_text (foutid,rlonid,'units' , 'degrees_east') - end if - -! Create variables for output - ret = nf_def_var (foutid,'PHIS' , NF_DOUBLE, 2, dim, phisid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_double (foutid, phisid, '_FillValue', nf_double, 1, fillvalue) - call wrap_put_att_double (foutid, phisid, 'missing_value', nf_double, 1, fillvalue) - call wrap_put_att_text (foutid, phisid, 'long_name' , 'surface geopotential') - call wrap_put_att_text (foutid, phisid, 'units' , 'm2/s2') - call wrap_put_att_text (foutid, phisid, 'from_hires', 'true') - call wrap_put_att_text (foutid, phisid, 'filter' , z_filter_type) - - ret = nf_def_var (foutid,'SGH' , NF_DOUBLE, 2, dim, sghid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_double (foutid, sghid, '_FillValue', nf_double, 1, fillvalue) - call wrap_put_att_double (foutid, sghid, 'missing_value', nf_double, 1, fillvalue) - call wrap_put_att_text (foutid, sghid, 'long_name' , 'standard deviation of 10-min elevations') - call wrap_put_att_text (foutid, sghid, 'units' , 'm') - call wrap_put_att_text (foutid, sghid, 'from_hires', 'true') - call wrap_put_att_text (foutid, sghid, 'filter' , s_filter_type) - - if (have_sgh30) then - ret = nf_def_var (foutid,'SGH30' , NF_DOUBLE, 2, dim, sgh30id) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_double (foutid, sgh30id, '_FillValue', nf_double, 1, fillvalue) - call wrap_put_att_double (foutid, sgh30id, 'missing_value', nf_double, 1, fillvalue) - call wrap_put_att_text (foutid, sgh30id, 'long_name' , 'standard deviation of elevation from 30s to 10m') - call wrap_put_att_text (foutid, sgh30id, 'units' , 'm') - call wrap_put_att_text (foutid, sgh30id, 'from_hires', 'true') - call wrap_put_att_text (foutid, sgh30id, 'filter' , s_filter_type) - endif - - ret = nf_def_var (foutid,'LANDFRAC' , NF_DOUBLE, 2, dim, landfid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_double (foutid, landfid, '_FillValue', nf_double, 1, fillvalue) - call wrap_put_att_double (foutid, landfid, 'missing_value', nf_double, 1, fillvalue) - call wrap_put_att_text (foutid, landfid, 'long_name' , 'gridbox land fraction') - call wrap_put_att_text (foutid, landfid, 'from_hires', 'true') - - ret = nf_def_var (foutid,'LANDM_COSLAT', NF_DOUBLE, 2, dim, landmid) - if (ret .ne. NF_NOERR) call handle_error(ret) - call wrap_put_att_double (foutid, landmid, '_FillValue', nf_double, 1, fillvalue) - call wrap_put_att_double (foutid, landmid, 'missing_value', nf_double, 1, fillvalue) - call wrap_put_att_text (foutid, landmid, 'long_name' , & - 'land ocean transition mask: ocean (0), continent (1), transition (0-1)') - call wrap_put_att_text (foutid, landmid, 'from_hires', 'true') - -! Define history attribute. - call DATE_AND_TIME(DATE=datestring) - history = 'Written on date: ' // datestring // cmdline - call wrap_put_att_text (foutid, nf_global, 'history', history) - -! Define Ross Sea attribute - if (make_ross) then - write (6,*) 'Extending Ross ice shelf south of -79 degrees' - call wrap_put_att_text (foutid, nf_global, 'make_ross', 'true') - else - write (6,*) 'Not doing anything special for Ross ice shelf' - call wrap_put_att_text (foutid, nf_global, 'make_ross', 'false') - end if - -! Define source file attributes - call wrap_put_att_text (foutid, nf_global, 'topofile', topofile) - cmdlen = len_trim (gridfile) - call wrap_put_att_text (foutid, nf_global, 'gridfile', gridfile) - cmdlen = len_trim (landmfile) - call wrap_put_att_text (foutid, nf_global, 'landmask', landmfile) - - -! End definition of netCDF file - ret = nf_enddef (foutid) - if (ret/=NF_NOERR) call handle_error (ret) - - -! Write data to file - write(6,*) 'Writing surface quantities' - -! Write dimension variables - call wrap_put_var8 (foutid, latdimid, mlatcnts) - if (.not.reduced_grid) then - call wrap_put_var8 (foutid, londimid, mloncnts(:,1)) - else - ret = nf_put_var_int (foutid, nlonid, nlon) - if (ret/=NF_NOERR) call handle_error (ret) - call wrap_put_vara8 (foutid, rlonid, start, count, mloncnts) - end if - - start(:) = 1 - count(1) = plon - count(2) = nlat - count(3:) = 1 - - call wrap_put_vara8 (foutid, sghid, start, count, sgh) - if(have_sgh30) call wrap_put_vara8 (foutid, sgh30id, start, count, sgh30) - call wrap_put_vara8 (foutid, phisid , start, count, phis) - call wrap_put_vara8 (foutid, landfid, start, count, fland) - call wrap_put_vara8 (foutid, landmid, start, count, landm) - - if (nf_close (foutid) == nf_noerr) then - write(6,*) 'Successfully defined surface quantities on ', trim(outbcfile) - else - write(6,*) 'ERROR CLOSING NETCDF FILE ',trim(outbcfile) - end if - - deallocate (nlon) - deallocate (mlatcnts) - deallocate (mloncnts) - deallocate (sgh) - deallocate (sgh30) - deallocate (phis) - deallocate (fland) - deallocate (landm) - - stop 0 -end program fmain - -subroutine usage_exit (arg) - implicit none - character*(*) arg - - if (arg /= ' ') write (6,*) arg - write (6,*) 'Usage: definesurf -t topofile -g gridfile -l landmfile [-v] [-r] [-del2] [-remap] outfile' - write (6,*) ' -v verbose mode' - write (6,*) ' -r Do *not* extend Ross Ice Shelf as land ice' - write (6,*) ' -del2 use del2 terrain filter (not a valid option for reduced grid)' - write (6,*) ' -remap use remapping filter (not a valid option for reduced grid)' - write (6,*) ' -sgh filter sgh and sgh30 using same terrain filter' - stop 999 -end subroutine usage_exit diff --git a/tools/definesurf/handle_error.f90 b/tools/definesurf/handle_error.f90 deleted file mode 100644 index 519f829097..0000000000 --- a/tools/definesurf/handle_error.f90 +++ /dev/null @@ -1,11 +0,0 @@ -subroutine handle_error (ret) - implicit none - - integer ret - - include 'netcdf.inc' - - write(6,*) nf_strerror (ret) - call abort - stop 999 -end subroutine handle_error diff --git a/tools/definesurf/inimland.f90 b/tools/definesurf/inimland.f90 deleted file mode 100644 index af929f1b98..0000000000 --- a/tools/definesurf/inimland.f90 +++ /dev/null @@ -1,205 +0,0 @@ -subroutine inimland (plon, nlat, nlon_reduced, mlatcnts, mloncnts, topofile, & - verbose, make_ross, landm_reduced) - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none -! -! Input arguments -! - integer , intent(in) :: plon ! number of longitudes - integer , intent(in) :: nlat ! number of latitudes - integer , intent(in) :: nlon_reduced(nlat) ! number of reduced latitudes - real(r8), intent(in) :: mlatcnts(nlat) ! latitude at center of grid cell - real(r8), intent(in) :: mloncnts(plon,nlat) ! model cell ceneter longitudes - character(len=*), intent(in) :: topofile ! high res topo file - logical, intent(in) :: verbose ! verbose output - logical, intent(in) :: make_ross ! flag to make Ross ice shelf -! -! Output arguments -! - real(r8), intent(out) :: landm_reduced(plon,nlat) ! landm on reduced grid - -! Local variables - - real(r8) landm(plon,nlat) ! landm on full grid - real(r8) clon(plon) - real(r8) clon_reduced(plon,nlat) - real(r8) cont(plon,nlat) - real(r8) temp(plon,nlat) - real(r8) dmax - real(r8) arad - real(r8) dist - real(r8) sum - real(r8) cs(nlat) - real(r8) ss(nlat) - real(r8) c1 - real(r8) s1 - real(r8) c2 - real(r8) s2 - real(r8) dx - real(r8) dy - real(r8) term - real(r8) pi - real(r8) sgh(plon,nlat) ! required by SGHPHIS (unused locally) - real(r8) phis(plon,nlat) ! required by SGHPHIS (unused locally) - real(r8) oro(plon,nlat) ! land/ocean flag - real(r8) fland(plon,nlat) ! land fraction output from SGHPHIS - real(r8) mloncnts_full(plon,nlat) ! longitudes for rectangular grid - - integer i - integer j - integer ii - integer jj - integer iplm1 - integer jof - integer iof - integer itmp - integer jmin, jmax - integer nlon(nlat) - integer latid - - pi = acos(-1.d0) -! -! Define longitudes for a rectangular grid: index nlat/2+1 will be a latitude -! closest to the equator, i.e. with the most points in a reduced grid. -! - nlon(:) = plon - do j=1,nlat - mloncnts_full(:,j) = mloncnts(:,nlat/2+1) - end do - - call sghphis (plon, nlat, nlon, mlatcnts, mloncnts_full, topofile, & - verbose, sgh, phis, fland) -! -! Define land mask. Set all non-land points to ocean (i.e. not sea ice). -! - where (fland(:,:) >= 0.5) - oro(:,:) = 1. - elsewhere - oro(:,:) = 0. - endwhere -! -! Overwrite ORO flag as land for Ross ice shelf: note that the ORO field -! defined in this routine is only used locally. -! - do j=1,nlat - if (make_ross .and. mlatcnts(j) < -79.) then - do i=1,plon - oro(i,j) = 1. - end do - end if - end do -! -! Code lifted directly from cldwat.F -! - dmax = 2.e6 ! distance to carry the mask - arad = 6.37e6 - do i = 1,plon - clon(i) = 2.*(i-1)*pi/plon - end do -! -! first isolate the contenents -! as land points not surrounded by ocean or ice -! - do j = 1,nlat - cs(j) = cos(mlatcnts(j)*pi/180.) - ss(J) = sin(mlatcnts(j)*pi/180.) - do i = 1,plon - cont(i,j) = 0. - if (nint(oro(i,j)) .eq. 1) then - cont(i,j) = 1. - endif - end do - temp(1,j) = cont(1,j) - temp(plon,j) = cont(plon,j) - end do - - do i = 1,plon - temp(i,1) = cont(i,1) - temp(i,nlat) = cont(i,nlat) - end do -! -! get rid of one and two point islands -! - do j = 2,nlat-1 - do i = 2,plon-1 - sum = cont(i ,j+1) + cont(i ,j-1) & - + cont(i+1,j+1) + cont(i+1,j-1) & - + cont(i-1,j+1) + cont(i-1,j-1) & - + cont(i+1,j ) + cont(i-1,j) & - + cont(i ,j ) - if (sum.le.2.) then - temp(i,j) = 0. - else - temp(i,j) = 1. - endif - enddo - end do - - do j = 1,nlat - do i = 1,plon - cont(i,j) = temp(i,j) - end do - end do -! -! construct a function which is one over land, -! zero over ocean points beyond dmax from land -! - iplm1 = 2*plon - 1 - dy = pi*arad/nlat - jof = dmax/dy + 1 -! write (6,*) ' lat bands to check ', 2*jof+1 - do j = 1,nlat - c1 = cs(j) - s1 = ss(j) - dx = 2*pi*arad*cs(j)/plon -! -! if dx is too small, int(dmax/dx) may exceed the maximum size -! of an integer, especially on Suns, causing a core dump. Test -! to avoid that. -! - if (dx .lt. 1. .and. dmax .gt. 10000.) then - iof = plon - else - iof = min(int(dmax/dx) + 1, plon) - end if - do i = 1,plon - temp(i,j) = 0. - landm(i,j) = 0. - jmin = max(1,j-jof) - jmax = min(nlat,j+jof) - do jj = jmin, jmax - s2 = ss(jj) - c2 = cs(jj) - do itmp = -iof,iof - ii = mod(i+itmp+iplm1,plon)+1 - term = s1*s2 + c1*c2*cos(clon(ii)-clon(i)) - if (term.gt.0.9999999) term = 1. - dist = arad*acos(term) - landm(i,j) = max(landm(i,j), (1.-dist/dmax)*cont(ii,jj)) -! if (dist.lt.dmax .and. cont(ii,jj).eq.1) then -! landm(i,j) = max(landm(i,j), 1.-dist/dmax) -! endif - end do - end do - end do - end do -! -! Interpolate to reduced grid. Redefine clon in terms of degrees for interpolation -! - do i = 1,plon - clon(i) = (i-1)*360./plon - end do - do j=1,nlat - do i=1,nlon_reduced(j) - clon_reduced(i,j) = (i-1)*360./nlon_reduced(j) - end do - end do - - do j=1,nlat - call lininterp (landm(1,j), plon, 1, clon, & - landm_reduced(1,j), nlon_reduced(j), 1, clon_reduced(1,j), .true.) - end do - - return - end diff --git a/tools/definesurf/interplandm.f90 b/tools/definesurf/interplandm.f90 deleted file mode 100644 index 88e5fd3d17..0000000000 --- a/tools/definesurf/interplandm.f90 +++ /dev/null @@ -1,92 +0,0 @@ -subroutine interplandm (plono, nlato, nlono, lato, rlono, & - landmfile, landmo) -! -! Read LANDM_COSLAT from input file and interpolate to output grid. -! The input grid is assumed rectangular, but the output grid may -! be reduced. -! - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none - - include 'netcdf.inc' -! -! Input arguments -! - integer , intent(in) :: plono ! output longitude dimension - integer , intent(in) :: nlato ! number of latitudes - integer , intent(in) :: nlono(nlato) ! number of reduced latitudes - real(r8), intent(in) :: lato(nlato) ! latitude at center of grid cell - real(r8), intent(in) :: rlono(plono,nlato) ! longitude on (potentially reduced) output grid - character(len=*), intent(in) :: landmfile ! file containing input LANDM_COSLAT -! -! Output arguments -! - real(r8), intent(out) :: landmo(plono,nlato) ! landm on reduced grid - -! Local variables - - integer :: nloni - integer :: nlati - integer :: i,j ! spatial indices - integer :: ret ! return code - - integer :: landmfileid ! netcdf file id for landm file - integer :: londimid, latdimid ! lon, lat dimension ids - integer :: lonid, latid ! lon, lat var ids - integer :: landmid ! landm variable id - - real(r8), allocatable :: landmi(:,:) ! landm on full grid - real(r8), allocatable :: lati(:) - real(r8), allocatable :: loni(:) - real(r8), allocatable :: xtemp(:,:) ! temporary for interpolation - - ret = nf_open (landmfile, nf_nowrite, landmfileid) - if (ret /= nf_noerr) then - write(6,*)nf_strerror(ret) - write(6,*)'Unable to open input file ', trim (landmfile) - stop 999 - end if -! -! Retrieve grid info and LANDM_COSLAT field from from offline file. -! - call wrap_inq_dimid (landmfileid, 'lat', latdimid) - call wrap_inq_dimlen (landmfileid, latdimid, nlati) - - call wrap_inq_dimid (landmfileid, 'lon', londimid) - call wrap_inq_dimlen (landmfileid, londimid, nloni) - - allocate (lati(nlati)) - allocate (loni(nloni)) - allocate (landmi(nloni,nlati)) - - call wrap_inq_varid (landmfileid, 'lat', latid) - call wrap_get_var8 (landmfileid, latid, lati) - - call wrap_inq_varid (landmfileid, 'lon', lonid) - call wrap_get_var8 (landmfileid, lonid, loni) - - call wrap_inq_varid (landmfileid, 'LANDM_COSLAT', landmid) - call wrap_get_var8 (landmfileid, landmid, landmi) - - allocate (xtemp(nloni,nlato)) -! -! For rectangular -> reduced, interpolate first in latitude, then longitude -! - do i=1,nloni - call lininterp (landmi(i,1), nlati, nloni, lati, & - xtemp(i,1), nlato, nloni, lato, .false.) - end do - - do j=1,nlato - call lininterp (xtemp(1,j), nloni, 1, loni, & - landmo(1,j), nlono(j), 1, rlono(1,j), .true.) - end do - - deallocate (xtemp) - deallocate (lati) - deallocate (loni) - deallocate (landmi) - - return -end subroutine interplandm diff --git a/tools/definesurf/lininterp.f90 b/tools/definesurf/lininterp.f90 deleted file mode 100644 index 9d5d9d9e76..0000000000 --- a/tools/definesurf/lininterp.f90 +++ /dev/null @@ -1,174 +0,0 @@ -subroutine lininterp (arrin, nxin, incin, xin, & - arrout, nxout, incout, xout, periodic) - use shr_kind_mod, only: r8 => shr_kind_r8 - -!----------------------------------------------------------------------- -! -! Do a linear interpolation from input mesh defined by xin to output -! mesh defined by xout. Where extrapolation is necessary, values will -! be copied from the extreme edge of the input grid. -! -!---------------------------Code history-------------------------------- -! -! Original version: J. Rosinski -! -!----------------------------------------------------------------------- - implicit none -!----------------------------------------------------------------------- -! -! Arguments -! - integer nxin, incin - integer nxout, incout - - real(r8) xin(nxin), xout(nxout) - real(r8) arrin(incin,nxin) - real(r8) arrout(incout,nxout) - - logical periodic -! -! Local workspace -! - integer i, ii ! input grid indices - integer im, ip, iiprev ! input grid indices - integer icount ! number of values - - real(r8) extrap ! percent grid non-overlap - real(r8) dxinwrap ! delta-x on input grid for 2-pi - real(r8) avgdxin ! avg input delta-x - real(r8) ratio ! compare dxinwrap to avgdxin -! -! Dynamic -! - integer iim(nxout) ! interp. indices minus - integer iip(nxout) ! interp. indices plus - - real(r8) wgtm(nxout) ! interp. weight minus - real(r8) wgtp(nxout) ! interp. weight plus -! -! Just copy the data and return if input dimensions are 1 -! - if (nxin.eq.1 .and. nxout.eq.1) then - arrout(1,1) = arrin(1,1) - else if (nxin.eq.1) then - write(6,*)'LININTERP: Must have at least 2 input points' - call abort - end if - icount = 0 - do i=1,nxin-1 - if (xin(i).gt.xin(i+1)) icount = icount + 1 - end do - do i=1,nxout-1 - if (xout(i).gt.xout(i+1)) icount = icount + 1 - end do - if (icount.gt.0) then - write(6,*)'LININTERP: Non-monotonic coordinate array(s) found' - call abort - end if -! -! Initialize index arrays for later checking -! - do i=1,nxout - iim(i) = 0 - iip(i) = 0 - end do - if (periodic) then -! -! Periodic case: for values which extend beyond boundaries, assume -! periodicity and interpolate between endpoints. First check for sane -! periodicity assumption. -! - if (xin(1).lt.0. .or. xin(nxin).gt.360.) then - write(6,*)'LININTERP: For periodic Input x-grid must be between 0 and 360' - call abort - end if - if (xout(1).lt.0. .or. xout(nxout).gt.360.) then - write(6,*)'Output x-grid must be between 0 and 360' - call abort - end if - dxinwrap = xin(1) + 360. - xin(nxin) - avgdxin = (xin(nxin)-xin(1))/(nxin-1.) - ratio = dxinwrap/avgdxin - if (ratio.lt.0.9 .or. ratio.gt.1.1) then - write(6,*)'LININTERP: Insane dxinwrap value =',dxinwrap,' avg=', avgdxin - call abort - end if - do im=1,nxout - if (xout(im).gt.xin(1)) exit - iim(im) = nxin - iip(im) = 1 - wgtm(im) = (xin(1) - xout(im)) /dxinwrap - wgtp(im) = (xout(im)+360. - xin(nxin))/dxinwrap - end do - do ip=nxout,1,-1 - if (xout(ip).le.xin(nxin)) exit - iim(ip) = nxin - iip(ip) = 1 - wgtm(ip) = (xin(1)+360. - xout(ip)) /dxinwrap - wgtp(ip) = (xout(ip) - xin(nxin))/dxinwrap - end do - else -! -! Non-periodic case: for values which extend beyond boundaries, set weights -! such that values will just be copied. -! - do im=1,nxout - if (xout(im).gt.xin(1)) exit - iim(im) = 1 - iip(im) = 1 - wgtm(im) = 1. - wgtp(im) = 0. - end do - do ip=nxout,1,-1 - if (xout(ip).le.xin(nxin)) exit - iim(ip) = nxin - iip(ip) = nxin - wgtm(ip) = 1. - wgtp(ip) = 0. - end do - end if -! -! Loop though output indices finding input indices and weights -! - iiprev = 1 - do i=im,ip - do ii=iiprev,nxin-1 - if (xout(i).gt.xin(ii) .and. xout(i).le.xin(ii+1)) then - iim(i) = ii - iip(i) = ii + 1 - wgtm(i) = (xin(ii+1)-xout(i))/(xin(ii+1)-xin(ii)) - wgtp(i) = (xout(i)-xin(ii))/(xin(ii+1)-xin(ii)) - goto 30 - end if - end do - write(6,*)'LININTERP: Failed to find interp values' -30 iiprev = ii - end do -! -! Check grid overlap -! - extrap = 100.*((im - 1.) + (nxout - ip))/nxout - if (extrap.gt.30.) then - write(6,*)'********LININTERP WARNING:',extrap,' % of output', & - ' grid will have to be extrapolated********' - end if -! -! Check that interp/extrap points have been found for all outputs -! - icount = 0 - do i=1,nxout - if (iim(i).eq.0 .or. iip(i).eq.0) icount = icount + 1 - end do - if (icount.gt.0) then - write(6,*)'LININTERP: Point found without interp indices' - call abort - end if -! -! Do the interpolation -! - do i=1,nxout - arrout(1,i) = arrin(1,iim(i))*wgtm(i) + arrin(1,iip(i))*wgtp(i) - end do - return -end subroutine lininterp - diff --git a/tools/definesurf/map2f.f90 b/tools/definesurf/map2f.f90 deleted file mode 100644 index 1fb58b3f8a..0000000000 --- a/tools/definesurf/map2f.f90 +++ /dev/null @@ -1,1039 +0,0 @@ - subroutine map2f(im, jm, qm, iord, jord, pfilter) -! -! This is a stand alone 2-Grid-Wave filter for filtering the terrain for -! the finite-volume dynamical core -! Developed and coded by S.-J. Lin -! Data Assimilation Office, NASA/GSFC -! - implicit none -! Input - integer, intent(in):: im ! E-W diimension (e.g., 144 for 2.5 deg) - integer, intent(in):: jm ! N-S dimension (S pole to N pole; 91 for 2 deg) - integer, intent(in):: iord ! Mapping accuracy for E-W; recommended value=7 - integer, intent(in):: jord ! Mapping accuracy for N-S; recommended value=3 - logical, intent(in):: pfilter ! Polar filter (set to .T. for normal application) - -! Input/Output - real*8, intent(inout):: qm(im,jm) ! array to be filtered - -! Local - integer im2, jm2 - integer ndeg - real*8, allocatable:: q2(:,:) - real*8, allocatable:: lon1(:) - real*8, allocatable:: lon2(:) - real*8, allocatable:: sin1(:) - real*8, allocatable:: sin2(:) - real*8, allocatable:: qt1(:,:), qt2(:,:) - - real*8 dx1, dx2 - real*8 dy1, dy2 - - integer i, j - real*8 pi - - ndeg = 45 ! starting latitude for polar filter - pi = 4.d0 * datan(1.d0) - - im2 = im / 2 - if (im2*2 /= im) then - write(*,*) 'Stop in map2f; im=', im - stop - endif - - jm2 = (jm-1) / 2 + 1 - - allocate ( qt1(im2,jm) ) - allocate ( qt2(im2,jm2) ) - - allocate ( q2(im2,jm2) ) - allocate ( lon1(im+1) ) - allocate ( lon2(im2+1) ) - allocate ( sin1(jm+1) ) - allocate ( sin2(jm2+1) ) - - dx1 = 360./im - dx2 = 360./im2 - - dy1 = pi/(jm-1) - dy2 = pi/(jm2-1) - - do i=1,im+1 - lon1(i) = dx1 * (-0.5 + (i-1) ) - enddo - - do i=1,im2+1 - lon2(i) = dx2 * (-0.5 + (i-1) ) - enddo - - sin1(1) = -1. - sin2(1) = -1. - - sin1(jm +1) = 1. - sin2(jm2+1) = 1. - - do j=2,jm - sin1(j) = dsin( -0.5*pi + dy1*(-0.5+(j-1)) ) - enddo - - do j=2,jm2 - sin2(j) = dsin( -0.5*pi + dy2*(-0.5+(j-1)) ) - enddo - - call polavg(qm, im, jm, 1, jm) - if( pfilter ) call plft2d(im, jm, qm, 2, jm-1, ndeg) - -!============================== -! From full --> half resolution -!============================== - - call xmap(iord, im, jm, sin1, lon1, qm, im2, lon2, qt1 ) - call ymap(im2, jm, sin1, qt1, jm2, sin2, qt2, 0, jord) - -!============================== -! From half --> full resolution -!============================== - - call ymap(im2, jm2, sin2, qt2, jm, sin1, qt1, 0, jord) - call xmap(iord, im2, jm, sin1, lon2, qt1, im, lon1, qm ) - -! Apply Monotonicity preserving polar filter - if( pfilter ) call plft2d(im, jm, qm, 2, jm-1, ndeg) - call polavg(qm, im, jm, 1, jm) - - deallocate ( q2 ) - deallocate ( lon1 ) - deallocate ( lon2 ) - deallocate ( sin1 ) - deallocate ( sin2 ) - - deallocate ( qt1 ) - deallocate ( qt2 ) - - return - end - - subroutine polavg(p, im, jm, jfirst, jlast) - - implicit none - - integer im, jm, jfirst, jlast - real*8 p(im,jfirst:jlast) - real*8 sum1 - integer i - - if ( jfirst == 1 ) then - sum1 = 0. - do i=1,im - sum1 = sum1 + p(i,1) - enddo - sum1 = sum1/im - - do i=1,im - p(i,1) = sum1 - enddo - endif - - if ( jlast == jm ) then - sum1 = 0. - do i=1,im - sum1 = sum1 + p(i,jm) - enddo - sum1 = sum1/im - - do i=1,im - p(i,jm) = sum1 - enddo - endif - - return - end - - subroutine setrig(im, jm, dp, dl, cosp, cose, sinp, sine) - - implicit none - - integer im, jm - integer j, jm1 - real*8 sine(jm),cosp(jm),sinp(jm),cose(jm) - real*8 dp, dl - real*8 pi, ph5 - - jm1 = jm - 1 - pi = 4.d0 * datan(1.d0) - dl = (pi+pi)/dble(im) - dp = pi/dble(jm1) - - do 10 j=2,jm - ph5 = -0.5d0*pi + (dble(j-1)-0.5d0)*(pi/dble(jm1)) -10 sine(j) = dsin(ph5) - - cosp( 1) = 0. - cosp(jm) = 0. - - do 80 j=2,jm1 -80 cosp(j) = (sine(j+1)-sine(j)) / dp - -! Define cosine at edges.. - - do 90 j=2,jm -90 cose(j) = 0.5 * (cosp(j-1) + cosp(j)) - cose(1) = cose(2) - - sinp( 1) = -1. - sinp(jm) = 1. - - do 100 j=2,jm1 -100 sinp(j) = 0.5 * (sine(j) + sine(j+1)) - - return - end - - subroutine ymap(im, jm, sin1, q1, jn, sin2, q2, iv, jord) - -! Routine to perform area preserving mapping in N-S from an arbitrary -! resolution to another. -! -! sin1 (1) = -1 must be south pole; sin1(jm+1)=1 must be N pole. -! -! sin1(1) < sin1(2) < sin1(3) < ... < sin1(jm) < sin1(jm+1) -! sin2(1) < sin2(2) < sin2(3) < ... < sin2(jn) < sin2(jn+1) -! -! Developer: S.-J. Lin -! First version: piece-wise constant mapping -! Apr 1, 2000 -! Last modified: - - implicit none - -! Input - integer im ! original E-W dimension - integer jm ! original N-S dimension - integer jn ! Target N-S dimension - integer jord - integer iv ! iv=0 scalar; iv=1: vector - real*8 sin1(jm+1) ! original southern edge of the cell - ! sin(lat1) - real*8 sin2(jn+1) ! Target cell's southern edge - real*8 q1(im,jm) ! original data at center of the cell - ! sin(lat2) -! Output - real*8 q2(im,jn) ! Mapped data at the target resolution - -! Local - integer i, j0, m, mm - integer j - -! PPM related arrays - real*8 al(im,jm) - real*8 ar(im,jm) - real*8 a6(im,jm) - real*8 dy1(jm) - - real*8 r3, r23 - parameter ( r3 = 1./3., r23 = 2./3. ) - real*8 pl, pr, qsum, esl - real*8 dy, sum - - do j=1,jm - dy1(j) = sin1(j+1) - sin1(j) - enddo - -! *********************** -! Area preserving mapping -! *********************** - -! Construct subgrid PP distribution - if ( jord == 1 ) then - - do j=1,jm - do i=1,im - a6(i,j) = 0. - ar(i,j) = q1(i,j) - al(i,j) = q1(i,j) - enddo - enddo - - else - - call ppm_lat(im, jm, q1, al, ar, a6, jord, iv) - do i=1,im -! SP - a6(i, 1) = 0. - ar(i, 1) = q1(i,1) - al(i, 1) = q1(i,1) -! NP - a6(i,jm) = 0. - ar(i,jm) = q1(i,jm) - al(i,jm) = q1(i,jm) - enddo - endif - - do 1000 i=1,im - j0 = 1 - do 555 j=1,jn - do 100 m=j0,jm -! -! locate the southern edge: sin2(i) -! - if(sin2(j) .ge. sin1(m) .and. sin2(j) .le. sin1(m+1)) then - pl = (sin2(j)-sin1(m)) / dy1(m) - if(sin2(j+1) .le. sin1(m+1)) then -! entire new cell is within the original cell - pr = (sin2(j+1)-sin1(m)) / dy1(m) - q2(i,j) = al(i,m) + 0.5*(a6(i,m)+ar(i,m)-al(i,m)) & - *(pr+pl)-a6(i,m)*r3*(pr*(pr+pl)+pl**2) - j0 = m - goto 555 - else -! South most fractional area - qsum = (sin1(m+1)-sin2(j))*(al(i,m)+0.5*(a6(i,m)+ & - ar(i,m)-al(i,m))*(1.+pl)-a6(i,m)* & - (r3*(1.+pl*(1.+pl)))) - do mm=m+1,jm -! locate the eastern edge: sin2(j+1) - if(sin2(j+1) .gt. sin1(mm+1) ) then -! Whole layer - qsum = qsum + dy1(mm)*q1(i,mm) - else -! North most fractional area - dy = sin2(j+1)-sin1(mm) - esl = dy / dy1(mm) - qsum = qsum + dy*(al(i,mm)+0.5*esl* & - (ar(i,mm)-al(i,mm)+a6(i,mm)*(1.-r23*esl))) - j0 = mm - goto 123 - endif - enddo - goto 123 - endif - endif -100 continue -123 q2(i,j) = qsum / ( sin2(j+1) - sin2(j) ) -555 continue -1000 continue - -! Final processing for poles - - if ( iv == 0 ) then - -! South pole - sum = 0. - do i=1,im - sum = sum + q2(i,1) - enddo - - sum = sum / im - do i=1,im - q2(i,1) = sum - enddo - -! North pole: - sum = 0. - do i=1,im - sum = sum + q2(i,jn) - enddo - - sum = sum / im - do i=1,im - q2(i,jn) = sum - enddo - - endif - - return - end - - subroutine ppm_lat(im, jm, q, al, ar, a6, jord, iv) - implicit none - -!INPUT - integer im, jm ! Dimensions - real*8 q(im,jm) - real*8 al(im,jm) - real*8 ar(im,jm) - real*8 a6(im,jm) - integer jord - integer iv ! iv=0 scalar - ! iv=1 vector -! Local - real*8 dm(im,jm) - real*8 r3 - parameter ( r3 = 1./3. ) - integer i, j, im2, iop, jm1 - real*8 tmp, qmax, qmin - real*8 qop - -! Compute dm: linear slope - - do j=2,jm-1 - do i=1,im - dm(i,j) = 0.25*(q(i,j+1) - q(i,j-1)) - qmax = max(q(i,j-1),q(i,j),q(i,j+1)) - q(i,j) - qmin = q(i,j) - min(q(i,j-1),q(i,j),q(i,j+1)) - dm(i,j) = sign(min(abs(dm(i,j)),qmin,qmax),dm(i,j)) - enddo - enddo - - im2 = im/2 - jm1 = jm - 1 - -!Poles: - if (iv == 1 ) then -! SP - do i=1,im - if( i .le. im2) then - qop = -q(i+im2,2) - else - qop = -q(i-im2,2) - endif - tmp = 0.25*(q(i,2) - qop) - qmax = max(q(i,2),q(i,1), qop) - q(i,1) - qmin = q(i,1) - min(q(i,2),q(i,1), qop) - dm(i,1) = sign(min(abs(tmp),qmax,qmin),tmp) - enddo -! NP - do i=1,im - if( i .le. im2) then - qop = -q(i+im2,jm1) - else - qop = -q(i-im2,jm1) - endif - tmp = 0.25*(qop - q(i,jm1)) - qmax = max(qop,q(i,jm), q(i,jm1)) - q(i,jm) - qmin = q(i,jm) - min(qop,q(i,jm), q(i,jm1)) - dm(i,jm) = sign(min(abs(tmp),qmax,qmin),tmp) - enddo - else -! -!********* -! Scalar: -!********* -! SP - do i=1,im2 - tmp = 0.25*(q(i,2)-q(i+im2,2)) - qmax = max(q(i,2),q(i,1), q(i+im2,2)) - q(i,1) - qmin = q(i,1) - min(q(i,2),q(i,1), q(i+im2,2)) - dm(i,1) = sign(min(abs(tmp),qmax,qmin),tmp) - enddo - - do i=im2+1,im - dm(i, 1) = - dm(i-im2, 1) - enddo -! NP - do i=1,im2 - tmp = 0.25*(q(i+im2,jm1)-q(i,jm1)) - qmax = max(q(i+im2,jm1),q(i,jm), q(i,jm1)) - q(i,jm) - qmin = q(i,jm) - min(q(i+im2,jm1),q(i,jm), q(i,jm1)) - dm(i,jm) = sign(min(abs(tmp),qmax,qmin),tmp) - enddo - - do i=im2+1,im - dm(i,jm) = - dm(i-im2,jm) - enddo - endif - - do j=2,jm - do i=1,im - al(i,j) = 0.5*(q(i,j-1)+q(i,j)) + r3*(dm(i,j-1) - dm(i,j)) - enddo - enddo - - do j=1,jm-1 - do i=1,im - ar(i,j) = al(i,j+1) - enddo - enddo - - do j=2,jm-1 - do i=1,im - a6(i,j) = 3.*(q(i,j)+q(i,j) - (al(i,j)+ar(i,j))) - enddo - - call lmppm(dm(1,j), a6(1,j), ar(1,j), & - al(1,j), q(1,j), im, jord-3) - enddo - - return - end - - subroutine xmap(iord, im, jm, sin1, lon1, q1, in, lon2, q2) - -! Routine to perform area preserving mapping in E-W from an arbitrary -! resolution to another. -! Periodic domain will be assumed, i.e., the eastern wall bounding cell -! im is lon1(im+1) = lon1(1); Note the equal sign is true geographysically. -! -! lon1(1) < lon1(2) < lon1(3) < ... < lon1(im) < lon1(im+1) -! lon2(1) < lon2(2) < lon2(3) < ... < lon2(in) < lon2(in+1) -! -! Developer: S.-J. Lin -! First version: piece-wise constant mapping -! Apr 1, 2000 -! Last modified: - - implicit none - -! Input - integer iord - integer im ! original E-W dimension - integer in ! Target E-W dimension - integer jm ! original N-S dimension - real*8 lon1(im+1) ! original western edge of the cell - real*8 sin1(jm+1) - real*8 q1(im,jm) ! original data at center of the cell - real*8 lon2(in+1) ! Target cell's western edge - -! Output - real*8 q2(in,jm) ! Mapped data at the target resolution - -! Local - integer i1, i2 - integer i, i0, m, mm - integer j - integer ird - -! PPM related arrays - real*8 qtmp(-im:im+im) - real*8 al(-im:im+im) - real*8 ar(-im:im+im) - real*8 a6(-im:im+im) - real*8 x1(-im:im+im+1) - real*8 dx1(-im:im+im) - real*8 r3, r23 - parameter ( r3 = 1./3., r23 = 2./3. ) - real*8 pl, pr, qsum, esl - real*8 dx - logical found - - do i=1,im+1 - x1(i) = lon1(i) - enddo - - do i=1,im - dx1(i) = x1(i+1) - x1(i) - enddo - -! check to see if ghosting is necessary - -!************** -! Western edge: -!************** - found = .false. - i1 = 1 - do while ( .not. found ) - if( lon2(1) .ge. x1(i1) ) then - found = .true. - else - i1 = i1 - 1 - if (i1 .lt. -im) then - write(6,*) 'failed in xmap' - stop - else - x1(i1) = x1(i1+1) - dx1(im+i1) - dx1(i1) = dx1(im+i1) - endif - endif - enddo - -!************** -! Eastern edge: -!************** - found = .false. - i2 = im+1 - do while ( .not. found ) - if( lon2(in+1) .le. x1(i2) ) then - found = .true. - else - i2 = i2 + 1 - if (i2 .gt. 2*im) then - write(6,*) 'failed in xmap' - stop - else - dx1(i2-1) = dx1(i2-1-im) - x1(i2) = x1(i2-1) + dx1(i2-1) - endif - endif - enddo - - do 1000 j=1,jm - -! *********************** -! Area preserving mapping -! *********************** - -! Construct subgrid PP distribution - if ( abs(sin1(j)+sin1(j+1)) > 1.5 ) then - ird = 3 - elseif ( abs(sin1(j)+sin1(j+1)) < 1.0 ) then - ird = 8 - else - ird = iord - endif - - if ( iord == 1 ) then - do i=1,im - qtmp(i) = q1(i,j) - al(i) = q1(i,j) - ar(i) = q1(i,j) - a6(i) = 0. - enddo - qtmp(0 ) = q1(im,j) - qtmp(im+1) = q1(1, j) - else - call ppm_cycle(im, q1(1,j), al(1), ar(1), a6(1), qtmp, ird) - endif - -! check to see if ghosting is necessary - -! Western edge - if ( i1 .le. 0 ) then - do i=i1,0 - qtmp(i) = qtmp(im+i) - al(i) = al(im+i) - ar(i) = ar(im+i) - a6(i) = a6(im+i) - enddo - endif - -! Eastern edge: - if ( i2 .gt. im+1 ) then - do i=im+1,i2-1 - qtmp(i) = qtmp(i-im) - al(i) = al(i-im) - ar(i) = ar(i-im) - a6(i) = a6(i-im) - enddo - endif - - i0 = i1 - - do 555 i=1,in - do 100 m=i0,i2-1 -! -! locate the western edge: lon2(i) -! - if(lon2(i) .ge. x1(m) .and. lon2(i) .le. x1(m+1)) then - pl = (lon2(i)-x1(m)) / dx1(m) - if(lon2(i+1) .le. x1(m+1)) then -! entire new grid is within the original grid - pr = (lon2(i+1)-x1(m)) / dx1(m) - q2(i,j) = al(m) + 0.5*(a6(m)+ar(m)-al(m)) & - *(pr+pl)-a6(m)*r3*(pr*(pr+pl)+pl**2) - i0 = m - goto 555 - else -! Left most fractional area - qsum = (x1(m+1)-lon2(i))*(al(m)+0.5*(a6(m)+ & - ar(m)-al(m))*(1.+pl)-a6(m)* & - (r3*(1.+pl*(1.+pl)))) - do mm=m+1,i2-1 -! locate the eastern edge: lon2(i+1) - if(lon2(i+1) .gt. x1(mm+1) ) then -! Whole layer - qsum = qsum + dx1(mm)*qtmp(mm) - else -! Right most fractional area - dx = lon2(i+1)-x1(mm) - esl = dx / dx1(mm) - qsum = qsum + dx*(al(mm)+0.5*esl* & - (ar(mm)-al(mm)+a6(mm)*(1.-r23*esl))) - i0 = mm - goto 123 - endif - enddo - goto 123 - endif - endif -100 continue -123 q2(i,j) = qsum / ( lon2(i+1) - lon2(i) ) -555 continue -1000 continue - - return - end - - subroutine ppm_cycle(im, q, al, ar, a6, p, iord) - implicit none - - real*8 r3 - parameter ( r3 = 1./3. ) - -! Input - integer im, iord - real*8 q(1) -! Output - real*8 al(1) - real*8 ar(1) - real*8 a6(1) - real*8 p(-im:im+im) - -! local - real*8 dm(0:im) - integer i, lmt - real*8 tmp, qmax, qmin - - p(0) = q(im) - do i=1,im - p(i) = q(i) - enddo - p(im+1) = q(1) - -! 2nd order slope - do i=1,im - tmp = 0.25*(p(i+1) - p(i-1)) - qmax = max(p(i-1), p(i), p(i+1)) - p(i) - qmin = p(i) - min(p(i-1), p(i), p(i+1)) - dm(i) = sign(min(abs(tmp),qmax,qmin), tmp) - enddo - dm(0) = dm(im) - - do i=1,im - al(i) = 0.5*(p(i-1)+p(i)) + (dm(i-1) - dm(i))*r3 - enddo - - do i=1,im-1 - ar(i) = al(i+1) - enddo - ar(im) = al(1) - - do i=1,im - a6(i) = 3.*(p(i)+p(i) - (al(i)+ar(i))) - enddo - - if(iord <= 6) then - lmt = iord - 3 - if(lmt <= 2) call lmppm(dm(1),a6(1),ar(1),al(1),p(1),im,lmt) - else - call huynh(im, ar(1), al(1), p(1), a6(1), dm(1)) - call lmppm(dm(1),a6(1),ar(1),al(1),p(1),im,2) - endif - - return - end - - subroutine lmppm(dm, a6, ar, al, p, im, lmt) - implicit none - real*8 r12 - parameter ( r12 = 1./12. ) - - integer im, lmt - integer i - real*8 a6(im),ar(im),al(im),p(im),dm(im) - real*8 da1, da2, fmin, a6da - -! LMT = 0: full monotonicity -! LMT = 1: semi-monotonic constraint (no undershoot) -! LMT = 2: positive-definite constraint - - if(lmt.eq.0) then - -! Full constraint - do 100 i=1,im - if(dm(i) .eq. 0.) then - ar(i) = p(i) - al(i) = p(i) - a6(i) = 0. - else - da1 = ar(i) - al(i) - da2 = da1**2 - a6da = a6(i)*da1 - if(a6da .lt. -da2) then - a6(i) = 3.*(al(i)-p(i)) - ar(i) = al(i) - a6(i) - elseif(a6da .gt. da2) then - a6(i) = 3.*(ar(i)-p(i)) - al(i) = ar(i) - a6(i) - endif - endif -100 continue - - elseif(lmt == 1) then -! Semi-monotonic constraint - do 150 i=1,im - if(abs(ar(i)-al(i)) .ge. -a6(i)) go to 150 - if(p(i).lt.ar(i) .and. p(i).lt.al(i)) then - ar(i) = p(i) - al(i) = p(i) - a6(i) = 0. - elseif(ar(i) .gt. al(i)) then - a6(i) = 3.*(al(i)-p(i)) - ar(i) = al(i) - a6(i) - else - a6(i) = 3.*(ar(i)-p(i)) - al(i) = ar(i) - a6(i) - endif -150 continue - elseif(lmt == 2) then -! Positive definite constraint - do 250 i=1,im - if(abs(ar(i)-al(i)) >= -a6(i)) go to 250 - fmin = p(i) + 0.25*(ar(i)-al(i))**2/a6(i) + a6(i)*r12 - if(fmin >= 0.) go to 250 - if(p(i).lt.ar(i) .and. p(i).lt.al(i)) then - ar(i) = p(i) - al(i) = p(i) - a6(i) = 0. - elseif(ar(i) .gt. al(i)) then - a6(i) = 3.*(al(i)-p(i)) - ar(i) = al(i) - a6(i) - else - a6(i) = 3.*(ar(i)-p(i)) - al(i) = ar(i) - a6(i) - endif -250 continue - endif - return - end - - subroutine huynh(im, ar, al, p, d2, d1) - -! Enforce Huynh's 2nd constraint in 1D periodic domain - - implicit none - integer im, i - real*8 ar(im) - real*8 al(im) - real*8 p(im) - real*8 d2(im) - real*8 d1(im) - -! Local scalars: - real*8 pmp - real*8 lac - real*8 pmin - real*8 pmax - -! Compute d1 and d2 - d1(1) = p(1) - p(im) - do i=2,im - d1(i) = p(i) - p(i-1) - enddo - - do i=1,im-1 - d2(i) = d1(i+1) - d1(i) - enddo - d2(im) = d1(1) - d1(im) - -! Constraint for AR -! i = 1 - pmp = p(1) + 2.0 * d1(1) - lac = p(1) + 0.5 * (d1(1)+d2(im)) + d2(im) - pmin = min(p(1), pmp, lac) - pmax = max(p(1), pmp, lac) - ar(1) = min(pmax, max(ar(1), pmin)) - - do i=2, im - pmp = p(i) + 2.0*d1(i) - lac = p(i) + 0.5*(d1(i)+d2(i-1)) + d2(i-1) - pmin = min(p(i), pmp, lac) - pmax = max(p(i), pmp, lac) - ar(i) = min(pmax, max(ar(i), pmin)) - enddo - -! Constraint for AL - do i=1, im-1 - pmp = p(i) - 2.0*d1(i+1) - lac = p(i) + 0.5*(d2(i+1)-d1(i+1)) + d2(i+1) - pmin = min(p(i), pmp, lac) - pmax = max(p(i), pmp, lac) - al(i) = min(pmax, max(al(i), pmin)) - enddo - -! i=im - i = im - pmp = p(im) - 2.0*d1(1) - lac = p(im) + 0.5*(d2(1)-d1(1)) + d2(1) - pmin = min(p(im), pmp, lac) - pmax = max(p(im), pmp, lac) - al(im) = min(pmax, max(al(im), pmin)) - -! compute A6 (d2) - do i=1, im - d2(i) = 3.*(p(i)+p(i) - (al(i)+ar(i))) - enddo - return - end - - subroutine plft2d(im, jm, p, JS, JN, ndeg) -! -! This is a weak LOCAL polar filter. -! Developer: Shian-Jiann Lin - - implicit none - - integer im - integer jm - integer js, jn, ndeg - real*8 p(im,jm) - - integer i, j, n, ideg, jj, jc - real*8 cosp(jm),cose(jm) - real*8 a(0:im/2+1) - - real*8 sine(jm),sinp(jm) - real*8, allocatable, save :: se(:), sc(:) - - real*8 pi, dp, dl, e0, ycrit, coszc, smax, rn, rn2, esl, tmp - - data IDEG /0/ - - if(IDEG .ne. ndeg) then - IDEG = ndeg -! (e0 = 2.6) - e0 = 0.5 * sqrt(27.) - PI = 4. * ATAN(1.) - - allocate( sc(jm), se(jm)) - - call setrig(im, jm, dp, dl, cosp, cose, sinp, sine) - - ycrit = IDEG*PI/180. - coszc = cos(ycrit) - - smax = (jm-1)/2 - write(6,*) 'Critical latitude in local pft = ',ndeg - - a(0) = 1. - do n=1,im/2+1 - rn = n - rn2 = 2*n - a(n) = sqrt(rn2+1.) * ((rn2+1.)/rn2)**rn - enddo - - do j=2,jm-1 - sc(j) = coszc / cosp(j) - - IF(sc(j) > 1. .and. sc(j) <= 1.5 ) THEN - esl = 1./ sc(j) - sc(j) = 1. + (1.-esl) / (1.+esl) - ELSEIF(sc(j) > 1.5 .and. sc(j) <= e0 ) THEN - esl = 1./ sc(j) - sc(j) = 1. + 2./ (27.*esl**2 - 2.) - ELSEIF(sc(j) > e0) THEN -! Search - do jj=1,im/2 - if(sc(j) <= a(jj)) then - jc = jj -! write(*,*) 'jc=', jc - goto 111 - endif - enddo - jc = im/2 + 1 -111 continue - - tmp = ((sc(j) - a(jc-1))/(a(jc) - a(jc-1)))**0.25 - sc(j) = jc + min(1.d0, tmp) -! sc(j) = min(smax,sc(j)) - ENDIF - enddo -! ==================================================== - do j=2,jm - se(j) = coszc / cose(j) - IF(se(j) > 1. .and. se(j) <= 1.5 ) THEN - esl = 1./ se(j) - se(j) = 1. + (1.-esl) / (1.+esl) - ELSEIF(se(j) > 1.5 .and. se(j) <= e0 ) THEN - esl = 1./ se(j) - se(j) = 1. + 2./ (27.*esl**2 - 2.) - ELSEIF(se(j) > e0) THEN -! Search - do jj=1,im/2 - if(se(j) <= a(jj)) then - jc = jj - goto 222 - endif - enddo - - jc = im/2 + 1 -222 continue - tmp = ((se(j) - a(jc-1))/(a(jc) - a(jc-1)))**0.25 - se(j) = jc + min(1.d0, tmp) -! se(j) = min(smax,se(j)) - ENDIF - enddo - - do i=1,im - se( 2) = sc(2) - se(jm) = sc(jm-1) - enddo - - do j=2,jm-1 -! write(*,*) j,sc(j) - enddo - ENDIF - - if( JN == (jm-1) ) then -! Cell-centered variables - call lpft(im, jm, p, 2, jm-1, Sc) - else -! Cell-edge variables - call lpft(im, jm, p, 2, jm, Se) - endif - return - end - - - subroutine lpft(im, jm, p, j1, j2, s) - implicit none - - integer im, jm, j1, j2 - real*8 p(im,jm) - real*8 s(jm) - -! Local - integer i, j, n, nt - - real*8 ptmp(0:im+1) - real*8 q(0:im+1) - real*8 frac, rsc, bt - - do 2500 j=j1,j2 - if(s(j) > 1.02) then - - NT = INT(S(j)) - frac = S(j) - NT - NT = NT-1 - - rsc = 1. / (1.+frac) - bt = 0.5 * frac - - do i=1,im - ptmp(i) = p(i,j) - enddo - - ptmp(0) = p(im,j) - ptmp(im+1) = p(1 ,j) - - if( NT < 1 ) then - do i=1,im - p(i,j) = rsc * (ptmp(i) + bt*(ptmp(i-1)+ptmp(i+1))) - enddo - else - do i=1,im - q(i) = rsc * (ptmp(i) + bt*(ptmp(i-1)+ptmp(i+1))) - enddo - - do 500 N=1,NT - q(0) = q(im) - do i=1,im - ptmp(i) = q(i) + q(i-1) - enddo - ptmp(im+1) = ptmp(1) - - if ( n == nt ) then - do i=1,im - p(i,j) = 0.25*(ptmp(i) + ptmp(i+1)) - enddo - else - do i=1,im - q(i) = 0.25*(ptmp(i) + ptmp(i+1)) - enddo - endif -500 continue - endif - endif -2500 continue - - return - end diff --git a/tools/definesurf/map_i.f90 b/tools/definesurf/map_i.f90 deleted file mode 100644 index d73e02e7db..0000000000 --- a/tools/definesurf/map_i.f90 +++ /dev/null @@ -1,136 +0,0 @@ -subroutine map_i (nlon_i , nlat_i , numlon_i, lon_i , lat_i, & - nlon_o , nlat_o , numlon_o, lon_o , lat_o, & - mxovr_i2o, iovr_i2o, jovr_i2o, wovr_i2o) - - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - -! ------------------------ code history --------------------------- -! source file: map_i.F -! purpose: driver for area averaging initialization -! date last revised: July 2000 -! author: Mariana Vertenstein -! ----------------------------------------------------------------- - -! ------------------------ notes ---------------------------------- -! o get indices and weights for area-averaging: -! -! from input surface grid to output model grid -! -! o input surface and output model grids can be any resolution BUT: -! -! both grids must be oriented south to north, i.e., cell(lat+1) -! must be north of cell(lat). the southern edge of the first row -! must be -90 (south pole) and the northern edge of the last row -! must be +90 (north pole) -! -! both grids must be oriented eastwards, i.e., cell(lon+1) must be -! east of cell(lon). but the two grids do not have to start at the -! same longitude, i.e., one grid can start at dateline and go east; -! the other grid can start at greenwich and go east. longitudes for -! the western edge of the cells must increase continuously and span -! 360 degrees. examples -! dateline : -180 to 180 (- longitudes west of greenwich) -! greenwich : 0 to 360 -! greenwich (centered): -dx/2 to -dx/2 + 360 (- longitudes west of greenwich) -! -! o field values fld_i on an input grid with dimensions nlon_i and nlat_i => -! field values fld_o on an output grid with dimensions nlon_o and nlat_o as -! -! fld_o(io,jo) = -! fld_i(i_ovr(io,jo, 1 ),j_ovr(io,jo, 1 )) * w_ovr(io,jo, 1 ) + -! fld_i(i_ovr(io,jo,mxovr_i),j_ovr(io,jo,mxovr_i)) * w_ovr(io,jo,mxovr_i) -! -! o error checks: -! overlap weights of input cells sum to 1 for each output cell -! global sums of dummy fields are conserved for input => model area-averaging -! ----------------------------------------------------------------- - -! ------------------- arguments ----------------------------------- - integer , intent(in) :: nlon_i !input grid max number of longitude points - integer , intent(in) :: nlat_i !input grid number of latitude points - integer , intent(in) :: numlon_i(nlat_i) !input grid number of longitude points at each lat - real(r8), intent(in) :: lon_i(nlon_i+1,nlat_i) !input grid cell longitude, west edge (degrees) - real(r8), intent(in) :: lat_i(nlat_i+1) !input grid cell latitude, south edge (degrees) - integer , intent(in) :: nlon_o !model grid max number of longitude points - integer , intent(in) :: nlat_o !model grid number of latitude points - integer , intent(in) :: numlon_o(nlat_o) !model grid number of longitude points at each lat - real(r8), intent(in) :: lon_o(nlon_o+1,nlat_o) !model grid cell longitude, west edge (degrees) - real(r8), intent(in) :: lat_o(nlat_o+1) !model grid cell latitude, south edge (degrees) - integer , intent(in) :: mxovr_i2o !max number of input cells that overlap model cell - integer , intent(out):: iovr_i2o(nlon_o,nlat_o,mxovr_i2o) !lon index of overlap input cell - integer , intent(out):: jovr_i2o(nlon_o,nlat_o,mxovr_i2o) !lat index of overlap input cell - real(r8), intent(out):: wovr_i2o(nlon_o,nlat_o,mxovr_i2o) !weight of overlap input cell -! ----------------------------------------------------------------- -! -! ------------------- local variables ----------------------------- -! - real(r8) fld_i(nlon_i,nlat_i) !dummy input grid field - real(r8) fld_o(nlon_o,nlat_o) !dummy model grid field - real(r8) area_i(nlon_i,nlat_i) !input grid cell area - real(r8) area_o(nlon_o,nlat_o) !model grid cell area - real(r8) re !radius of earth - real(r8) sum_fldo !global sum of dummy model field - real(r8) sum_fldi !global sum of dummy input field - integer io,ii !model and input longitude loop indices - integer jo,ji !model and input latitude loop indices - real(r8), parameter :: relerr = 0.000001 !relative error for error checks -! ----------------------------------------------------------------- - -! ----------------------------------------------------------------- -! get cell areas -! ----------------------------------------------------------------- - - call cell_area (nlat_i, nlon_i, numlon_i, lon_i, lat_i, re, area_i) - - call cell_area (nlat_o, nlon_o, numlon_o, lon_o, lat_o, re, area_o) - -! ----------------------------------------------------------------- -! get indices and weights for mapping from input grid to model grid -! ----------------------------------------------------------------- - - call ao_i (nlon_i , nlat_i , numlon_i, lon_i , lat_i , & - nlon_o , nlat_o , numlon_o, lon_o , lat_o , & - mxovr_i2o, iovr_i2o , jovr_i2o, wovr_i2o , re , & - area_o , relerr ) - -! ----------------------------------------------------------------- -! error check: global sum fld_o = global sum fld_i -! ----------------------------------------------------------------- -! -! make dummy input field and sum globally -! - sum_fldi = 0. - do ji = 1, nlat_i - do ii = 1, numlon_i(ji) - fld_i(ii,ji) = (ji-1)*nlon_i + ii - sum_fldi = sum_fldi + area_i(ii,ji)*fld_i(ii,ji) - end do - end do -! -! area-average model field from input field -! - call area_ave (nlat_i , nlon_i , numlon_i ,fld_i , & - nlat_o , nlon_o , numlon_o ,fld_o , & - iovr_i2o , jovr_i2o , wovr_i2o , mxovr_i2o) -! -! global sum of model field -! - sum_fldo = 0. - do jo = 1, nlat_o - do io = 1, numlon_o(jo) - sum_fldo = sum_fldo + area_o(io,jo)*fld_o(io,jo) - end do - end do -! -! check for conservation -! - if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then - write (6,*) 'map_i error srf => model: srf field not conserved' - write (6,'(a23,e20.10)') 'global sum model field = ',sum_fldo - write (6,'(a23,e20.10)') 'global sum srf field = ',sum_fldi - call endrun - end if - - return -end subroutine map_i diff --git a/tools/definesurf/max_ovr.f90 b/tools/definesurf/max_ovr.f90 deleted file mode 100644 index 46b01fdc38..0000000000 --- a/tools/definesurf/max_ovr.f90 +++ /dev/null @@ -1,93 +0,0 @@ -subroutine max_ovr (nlon_i, nlat_i, numlon_i, nlon_o, nlat_o, numlon_o, & - lon_i , lat_i , lon_o , lat_o , novr_max) - - use shr_kind_mod, only: r8 => shr_kind_r8 - -! ----------------------------------------------------------------- - implicit none -! ------------------------ code history --------------------------- -! source file: max_ovr -! purpose: determine maximum number of overlapping cells -! input and output grids -! date last revised: March 1997 -! author: Mariana Vertenstein -! standardized: -! reviewed: -! ----------------------------------------------------------------- - -! ------------------- input variables ----------------------------- - integer, intent(in) :: nlon_i !number of input longitude points - integer, intent(in) :: nlat_i !number of input latitude points - integer, intent(in) :: numlon_i(nlat_i) !number of longitude points for each input grid cell latitude - integer, intent(in) :: nlon_o !number of output longitude points - integer, intent(in) :: nlat_o !number of output latitude points - integer, intent(in) :: numlon_o(nlat_o) !number of longitude points for each output grid cell latitude - real(r8), intent(in) :: lon_i(nlon_i+1,nlat_i) !input grid cell longitude, western edge - real(r8), intent(in) :: lat_i(nlat_i+1) !input grid cell latitude, southern edge - real(r8), intent(in) :: lon_o(nlon_o+1,nlat_o) !output grid cell longitude, western edge - real(r8), intent(in) :: lat_o(nlat_o+1) !output grid cell latitude , southern edge - integer , intent(out):: novr_max !maximum number of overlapping input cells -! ----------------------------------------------------------------- - -! ------------------- local variables ----------------------------- - integer novr !number of overlapping input cells - integer io,ii !output and input grids longitude loop index - integer jo,ji !output and input grids latitude loop index -! ----------------------------------------------------------------- - - -! ----------------------------------------------------------------- -! for each output grid cell: find overlapping input grid cell and area of -! input grid cell that overlaps with output grid cell. cells overlap if: -! -! southern edge of input grid < northern edge of output grid AND -! northern edge of input grid > southern edge of output grid -! -! western edge of input grid < eastern edge of output grid AND -! eastern edge of input grid > western edge of output grid -! -! lon_o(io,jo) lon_o(io+1,jo) -! -! | | -! --------------------- lat_o(jo+1) -! | | -! | | -! xxxxxxxxxxxxxxx lat_i(ji+1) | -! x | x | -! x input | x output | -! x cell | x cell | -! x ii,ji | x io,jo | -! x | x | -! x ----x---------------- lat_o(jo ) -! x x -! xxxxxxxxxxxxxxx lat_i(ji ) -! x x -! lon_i(ii,ji) lon_i(ii+1,ji) -! ----------------------------------------------------------------- - -! -! determine maximum number of overlapping cells -! loop through all input grid cells to find overlap with output grid. -! code does not vectorize but is only called during initialization. -! - novr_max = 0 - do jo = 1, nlat_o - do io = 1, numlon_o(jo) - novr = 0 - do ji = 1, nlat_i - if (lat_i(ji ).lt.lat_o(jo+1) .and. & - lat_i(ji+1).gt.lat_o(jo )) then !lat ok - do ii = 1, numlon_i(ji) - if (lon_i(ii ,ji).lt.lon_o(io+1,jo) .and. & - lon_i(ii+1,ji).gt.lon_o(io ,jo)) then !lon okay - novr = novr + 1 ! increment number of ovrlap cells for io,jo - end if - end do - end if - end do - if (novr .gt. novr_max) novr_max = novr - end do - end do - - return -end subroutine max_ovr diff --git a/tools/definesurf/sghphis.f90 b/tools/definesurf/sghphis.f90 deleted file mode 100644 index 39a694aa84..0000000000 --- a/tools/definesurf/sghphis.f90 +++ /dev/null @@ -1,340 +0,0 @@ -subroutine sghphis (plon, plat, numlons, mlatcnts, mloncnts, & - topofile, verbose, sgh, sgh30, have_sgh30, phis, fland ) - -!----------------------------------------------------------------------- -! -! Read high resolution topo dataset and calculate values of phis and sgh -! for the model resolution this model -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - - implicit none - include 'netcdf.inc' -! -!----------------------------------------------------------------------- -! -! parameters -! - integer , parameter :: ntopolon = 2160 - integer , parameter :: ntopolat = 1080 - integer , parameter :: n2x2lon = 180 - integer , parameter :: n2x2lat = 90 - integer , parameter :: n3x3lon = 120 - integer , parameter :: n3x3lat = 60 - real(r8), parameter :: r8_360 = 360. ! For argument compatibility to mod -! -! arguments -! - integer , intent(in) :: plon ! maximum number of model longitudes - integer , intent(in) :: plat ! number of model latitudes - integer , intent(in) :: numlons(plat) ! number of model longitudes per latitude - real(r8), intent(in) :: mlatcnts(plat) ! model cell center latitudes - real(r8), intent(in) :: mloncnts(plon,plat) ! model cell ceneter longitudes - logical , intent(in) :: verbose ! true => verbose output - character(len=*), intent(in) :: topofile ! high resolution topo file - real(r8), intent(out):: phis(plon,plat) ! model geopotention height - real(r8), intent(out):: sgh(plon,plat) ! model standard dev of geopotential height above 10min - real(r8), intent(out):: sgh30(plon,plat) ! model standard dev of geopotential height from 30s to 10m - logical , intent(out):: have_sgh30 ! true => variance is on topofile, sgh30 will be output - real(r8), intent(out):: fland(plon,plat) ! model fractional land -! -! Local workspace : note that anything with plon or plat in its dimension is dynamic -! - real(r8) wt ! weight for area averaging - real(r8) dx,dy ! increments for definition of intermed grid - -! high resolution topo grid - - integer lonid_topo, latid_topo ! input topo file vars - integer htopoid,ftopoid,ret,varianceid ! input topo file vars - real(r8) tloncnts(ntopolon) ! topo cell center lon boundaries - real(r8) tlatcnts(ntopolat) ! topo cell center lat boundaries - real(r8) tlons(ntopolon+1,ntopolat) ! topo cell W lon boundaries - real(r8) tlats(ntopolat+1) ! topo cell N lat boundaries - real(r8) ftopo(ntopolon,ntopolat) ! Land fraction array - real(r8) htopo(ntopolon,ntopolat) ! Topographic heights - real(r8) variance(ntopolon,ntopolat) ! Variance of elev at 30sec - -! intermediate grid - - real(r8) lons3x3(n3x3lon+1,n3x3lat) ! list of topo cell W lon boundaries - real(r8) lats3x3(n3x3lat+1) ! list of topo cell N lat boundaries - integer num3x3lons(n3x3lat) ! number if longitudes per latitude - real(r8) mnhgt3x3(n3x3lon,n3x3lat) ! intermediate topo height - real(r8) varhgt3x3(n3x3lon,n3x3lat) ! intermediate topovariance - -! model grid - - real(r8) mlons(plon+1,plat) ! model cell W lon boundaries - real(r8) mlats(plat+1) ! model cell N lat boundaries - real(r8) mnhgt(plon,plat) ! model topographic height - real(r8) varhgt(plon,plat) ! model topographic variance - real(r8) summn, sumvar ! use only for pole point calculations - -! other vars - - real(r8) xmax ! temporary variable - real(r8), parameter :: eps = 1.e-6 ! eps criterion for pole point - integer imax, jmax ! indices - integer i,j,ii,ji,io,jo,n ! indices - integer ncid_topo ! topographic netcdf id - integer ioe - integer mxovr ! max number of fine grid points used in area calculation of model grid point -! -! Space needed in 3 dimensions to store the initial data. This space is -! required because the input data file does not have a predetermined -! ordering of the latitude records. A specific order is imposed in the -! transforms so that the results will be reproducible. -! -! Dynamic -! - integer , allocatable :: iovr(:,:,:) ! lon index of overlap input cell - integer , allocatable :: jovr(:,:,:) ! lat index of overlap input cell - real(r8), allocatable :: wovr(:,:,:) ! weight of overlap input cell -! -!----------------------------------------------------------------------- -! -!---------------------------------------------------------------------------- -! Read in navy topo cell locations and determine cell edges (Uniform grid) -!---------------------------------------------------------------------------- -! - ret = nf_open (topofile, nf_nowrite, ncid_topo) - if (ret == nf_noerr) then - if (verbose) write(6,*)'Successfully opened netcdf topofile ',trim(topofile) - ret = nf_inq_varid (ncid_topo, 'variance', varianceid) - if (ret == NF_NOERR) then - if (verbose) write(6,*)'Found a new style topofile.' - call wrap_get_var8 (ncid_topo, varianceid, variance ) - call wrap_inq_varid (ncid_topo, 'landfract', ftopoid ) - have_sgh30 = .true. - else - if (verbose) write(6,*)'Found an old style topofile.' - call wrap_inq_varid (ncid_topo, 'ftopo', ftopoid ) - have_sgh30 = .false. - end if - call wrap_get_var8 (ncid_topo, ftopoid, ftopo) - call wrap_inq_varid (ncid_topo, 'htopo', htopoid ) - call wrap_get_var8 (ncid_topo, htopoid, htopo) - else - write(6,*)'cannot open topo file successfully' - call endrun - endif - - call wrap_inq_varid (ncid_topo, 'lon', lonid_topo) - call wrap_inq_varid (ncid_topo, 'lat', latid_topo) - - call wrap_get_var8 (ncid_topo, latid_topo, tlatcnts) - call wrap_get_var8 (ncid_topo, lonid_topo, tloncnts) - ret = nf_close (ncid_topo) - - tloncnts(:) = mod(tloncnts(:)+r8_360,r8_360) - - tlats(:) = 1.e36 - tlats(1) = -90. ! south pole - do j = 2, ntopolat - tlats(j) = (tlatcnts(j-1) + tlatcnts(j)) / 2. ! southern edges - end do - tlats(ntopolat+1) = 90. ! north pole - - tlons(:,:) = 1.e36 - do j = 1,ntopolat - dx = 360./ntopolon - tlons(1,j) = tloncnts(1) - dx/2. - do i = 2, ntopolon - tlons(i,j) = tloncnts(i) - dx/2. - end do - tlons(ntopolon+1,j) = tloncnts(ntopolon) + dx/2. - end do -! -!---------------------------------------------------------------------------- -! Determine model cell edges -!---------------------------------------------------------------------------- -! - mlats(:) = 1.e36 - mlats(1) = -90. ! south pole - do j = 2,plat - mlats(j) = (mlatcnts(j-1) + mlatcnts(j)) / 2. ! southern edges - end do - mlats(plat+1) = 90. ! north pole - - do j = 1,plat - dx = 360./(numlons(j)) - do i = 1,plon+1 - mlons(i,j) = -dx/2. + (i-1)*dx - end do - end do - -! -!---------------------------------------------------------------------------- -! Calculate fractional land -!---------------------------------------------------------------------------- -! - call binf2c(tloncnts ,tlatcnts ,ntopolon ,ntopolat ,ftopo, & - mlons ,mlats ,plon ,plat ,fland) -! -!---------------------------------------------------------------------------- -! Calculate standard deviation of elevation from 30sec to 10min -!---------------------------------------------------------------------------- - - if (have_sgh30) then - call binf2c(tloncnts ,tlatcnts ,ntopolon ,ntopolat ,variance, & - mlons ,mlats ,plon ,plat ,sgh30) - else - sgh30 = -1 - endif -!------------------------------------------------------------------------- -! Calculate determine mean and variance of topographic height, plon >=128 -!------------------------------------------------------------------------- -! - if (plon >= 128) then - call binf2c(tloncnts ,tlatcnts ,ntopolon ,ntopolat ,htopo, & - mlons ,mlats ,plon ,plat ,mnhgt) - - call varf2c(tloncnts ,tlatcnts ,ntopolon ,ntopolat ,htopo , & - mlons ,mlats ,plon ,plat ,mnhgt , & - varhgt ) - end if - -!------------------------------------------------------------------------- -! Calculate determine mean and variance of topographic height, plon < 128 -!------------------------------------------------------------------------- - - if (plon < 128) then -! -! bin to uniform 3x3 deg grid then area avg to output grid -! get 3x3 cell boundaries for binning routine -! - dy = 180./n3x3lat - do j = 1, n3x3lat+1 - lats3x3(j) = -90.0 + (j-1)*dy - end do - - num3x3lons(:) = n3x3lon - do j = 1,n3x3lat - dx = 360./(num3x3lons(j)) - do i = 1, num3x3lons(j)+1 - lons3x3(i,j) = 0. + (i-1)*dx - end do - end do -! -! bin mean height to intermed grid -! - call binf2c (tloncnts, tlatcnts, ntopolon, ntopolat, htopo, & - lons3x3 , lats3x3 , n3x3lon , n3x3lat , mnhgt3x3) -! -! get variation of topography mean height over the intermed grid -! - call varf2c (tloncnts, tlatcnts, ntopolon, ntopolat, htopo , & - lons3x3 , lats3x3 , n3x3lon , n3x3lat , mnhgt3x3, & - varhgt3x3 ) -! -! get maximum number of 3x3 cells which will to be used in area average -! for each model cell -! - call max_ovr (n3x3lon, n3x3lat, num3x3lons, plon , plat, numlons, & - lons3x3, lats3x3, mlons , mlats , mxovr ) -! -! do area average from intermediate regular grid to gauss grid -! get memory for pointer based arrays -! - allocate(iovr(plon,plat,mxovr)) - allocate(jovr(plon,plat,mxovr)) - allocate(wovr(plon,plat,mxovr)) - - call map_i (n3x3lon, n3x3lat, num3x3lons, lons3x3, lats3x3, & - plon , plat , numlons , mlons , mlats , & - mxovr , iovr , jovr , wovr ) - - do jo = 1, plat - do io = 1, numlons(jo) - mnhgt(io,jo) = 0. - varhgt(io,jo) = 0. - do n = 1, mxovr ! overlap cell index - ii = iovr(io,jo,n) ! lon index (input grid) of overlap cell - ji = jovr(io,jo,n) ! lat index (input grid) of overlap cell - wt = wovr(io,jo,n) ! overlap weight - mnhgt(io,jo) = mnhgt(io,jo) + mnhgt3x3(ii,ji) * wt - varhgt(io,jo) = varhgt(io,jo) + varhgt3x3(ii,ji) * wt - end do - end do - end do - -! If model grid contains pole points, then overwrite above values of phis and sgh at the -! poles with average of values of nearest 2x2 band - this is a fair approximation and -! is done so that above mapping routines do not have to be rewritten to correctly evaulte -! the area average of the pole points - - if (mlatcnts(1)-eps < -90.0 .and. mlatcnts(plat)+eps > 90.0) then - write(6,*)' determining sgh and phis at poles' - summn = 0 - sumvar = 0 - do io = 1,numlons(2) - summn = summn + mnhgt(io,2) - sumvar = sumvar + varhgt(io,2) - end do - do io = 1,numlons(1) - mnhgt(io,1) = summn/numlons(2) - varhgt(io,1) = sumvar/numlons(2) - end do - summn = 0 - sumvar = 0 - do io = 1,numlons(plat-1) - summn = summn + mnhgt(io,plat-1) - sumvar = sumvar + varhgt(io,plat-1) - end do - do io = 1,numlons(plat) - mnhgt(io,plat) = summn/numlons(plat-1) - varhgt(io,plat) = sumvar/numlons(plat-1) - end do - endif - - deallocate(iovr) - deallocate(jovr) - deallocate(wovr) - - end if - -! 1-2-1 smoothing for variation height - - call sm121(varhgt,plon,plat,numlons) - call sm121(varhgt,plon,plat,numlons) - if (have_sgh30) then - call sm121(sgh30,plon,plat,numlons) - call sm121(sgh30,plon,plat,numlons) - end if -! -! get standard deviation for smoothed height field -! -! determine geopotential height field. The multiplication by 9.80616 -! causes phis to be only accurate to 32-bit roundoff on some machines -! - xmax = -1.d99 - do jo=1,plat - do io=1,numlons(jo) - if (varhgt(io,jo) < 0.5) then - sgh(io,jo) = 0. - else - sgh(io,jo) = sqrt(varhgt(io,jo)) - end if - if (have_sgh30) then - if (sgh30(io,jo) < 0.5) then - sgh30(io,jo) = 0. - else - sgh30(io,jo) = sqrt(sgh30(io,jo)) - end if - end if - if (sgh(io,jo) > xmax) then - xmax = sgh(io,jo) - imax = io - jmax = jo - end if - phis(io,jo) = mnhgt(io,jo) * 9.80616 - end do - end do - - if (verbose) write(6,*)'Max SGH =',xmax,' at i,j=', imax, jmax - - return -end subroutine sghphis diff --git a/tools/definesurf/shr_kind_mod.f90 b/tools/definesurf/shr_kind_mod.f90 deleted file mode 100644 index fc1ed8e94a..0000000000 --- a/tools/definesurf/shr_kind_mod.f90 +++ /dev/null @@ -1,20 +0,0 @@ -!=============================================================================== -! CVS: $Id$ -! CVS: $Source$ -! CVS: $Name$ -!=============================================================================== - -MODULE shr_kind_mod - - !---------------------------------------------------------------------------- - ! precision/kind constants add data public - !---------------------------------------------------------------------------- - public - integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real - integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real - integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real - integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer - integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer - integer,parameter :: SHR_KIND_IN = kind(1) ! native integer - -END MODULE shr_kind_mod diff --git a/tools/definesurf/sm121.f90 b/tools/definesurf/sm121.f90 deleted file mode 100644 index c4b491616a..0000000000 --- a/tools/definesurf/sm121.f90 +++ /dev/null @@ -1,86 +0,0 @@ -subroutine sm121 (a, plon, nlat, nlon) - - use shr_kind_mod, only: r8 => shr_kind_r8 - -! -! perform 1-2-1 smoothing using data array a. On reduced grid, linearly -! interpolate to a rectangular grid (nlon(j),3) before interpolating -! -!----------------------------------------------------------------------- - implicit none -!-----------------------------Arguments--------------------------------- - - integer plon ! Input: Lon dim - integer nlat ! Input: Lat dim - integer nlon(nlat) ! Number of longitudes per latitude - real(r8) a(plon,nlat) ! I/O: Array to be smoothed - -!--------------------------Local variables------------------------------ - - integer i,j ! Indices - integer imin,imax ! Indices - integer jmax,jmin ! Indices -! -! Dynamic -! - real(r8) xin(plon,nlat) - real(r8) xout(plon) - real(r8) temp(plon,nlat) ! Temp array - real(r8) tempjmin(plon) ! Temp array - real(r8) tempjmax(plon) ! Temp array -! -!----------------------------------------------------------------------- -! - temp(:,:) = a(:,:) -! -! first do the S and N boundaries. -! - do i=1,nlon(1) - imin = i - 1 - imax = i + 1 - if( imin .lt. 1 ) imin = imin + nlon(1) - if( imax .gt. nlon(1)) imax = imax - nlon(1) - a(i,1) = (temp(imin,1) + 3.*temp(i,1) +temp(imax,1))/5. - end do - - do i=1,nlon(nlat) - imin = i - 1 - imax = i + 1 - if( imin .lt. 1 ) imin = imin + nlon(nlat) - if( imax .gt. nlon(nlat)) imax = imax - nlon(nlat) - a(i,nlat) = (temp(imin,nlat)+3.*temp(i,nlat)+temp(imax,nlat))/5. - end do -! -! Define xin array for each latitude -! - do j=1,nlat - do i=1,nlon(j) - xin(i,j) = (i-1)*360./nlon(j) - end do - end do -! -! Linearly interpolate data N and S of each target latitude to the longitudes -! of each target latitude before applying 1-2-1 filter -! - do j=2,nlat-1 - jmin = j - 1 - jmax = j + 1 - xout(:) = xin(:,j) - call lininterp (temp(1,jmin), nlon(jmin), 1, xin(1,jmin), & - tempjmin, nlon(j), 1, xout, .true.) - call lininterp (temp(1,jmax), nlon(jmax), 1, xin(1,jmax), & - tempjmax, nlon(j), 1, xout, .true.) - - do i=1,nlon(j) - imin = i - 1 - imax = i + 1 - if( imin .lt. 1 ) imin = imin + nlon(j) - if( imax .gt. nlon(j)) imax = imax - nlon(j) - a(i,j) = (tempjmin(i) + & - temp(imin,j) + 4.*temp(i,j) + temp(imax,j) + & - tempjmax(i) ) / 8. - enddo - enddo -! - return -end subroutine sm121 diff --git a/tools/definesurf/terrain_filter.f90 b/tools/definesurf/terrain_filter.f90 deleted file mode 100644 index fb80d9c492..0000000000 --- a/tools/definesurf/terrain_filter.f90 +++ /dev/null @@ -1,320 +0,0 @@ -! Terrain Filter -! -! Contributed by S.J. Lin. -! -! Added to the definesurf program by G. Grant, 30 June 2000. -! Updated with latest version from S.J. by B. Eaton, 23 August 2001 -! -! Notes from S.J.: -! -! "I compute the unsmoothed mean height and the variance -! exactly the same as the standard CCM utility. The only difference -! is the grid being uniformly spaced from North pole to South pole. -! The filter is applied to the mean height and the sqaure root of -! the variance (the standard deviation). -! -! For the 2x2.5 deg resolution -! -! mlon = 144 -! mlat = 91 -! -! Assuming the mean height is Z(mlon,mlat), and the standard deviation -! (the sqaure root of the variance) is SD(moln,mlat), the filter -! algorithm goes like this: -! -! call sm2(mlon, mlat, Z, itmax_Z, 0.25D0) -! call sm2(mlon, mlat, SD, itmax_SD, 0.25D0) -! -! where 0.25D0 is the dimensionless filter coefficient, and -! -! itmax_Z = 2*mlat -! itmax_SD = mlon -! -! [As discussed elsewhere] the above filtering is a bit too strong. -! But it is the filter I used up to now. -! I am currently testing the following setting -! -! itmax_Z = mlat/2 -! itmax_SD = mlon/4 -! " - - - subroutine sm2(im, jm, ht, itmax, c) -! -! Del-2 diffusion on the sphere -! - implicit none - -! Input: - integer im ! e-w dimension (eg, 144 for 2.5 deg resolution) - integer jm ! n-s doemsnion (eg, 91 for 2 deg resolution) - integer itmax ! iteration count - real*8 c ! filter coefficient - -! Input/Output - real*8 ht(im,jm) ! array to be filtered - -! Local - real*8 dg(im,jm) ! del2 of h - real*8 cose(jm), cosp(jm), sinp(jm), sine(jm) - real*8 dl - real*8 dp - real*8 fmin, fmax - integer jm1 - integer mnk, mxk - integer ndeg - integer it, i, j - real*8 s1, s2 - - jm1 = jm-1 - - call setrig(im, jm, dp, DL, cosp, cose, sinp, sine) - - call pmnx(ht, im, jm, fmin, fmax, mnk, mxk) - write(6,*) 'hmax=', fmax,' at j= ',mxk - write(6,*) 'hmin=', fmin,' at j= ',mnk - - ndeg = 60 ! starting latitude for the monotonicity - ! preserving polar filter - - call pmnx(ht,im,jm,fmin,fmax,mnk,mxk) - write(6,*) 'hmax=', fmax,' at j= ',mxk - write(6,*) 'hmin=', fmin,' at j= ',mnk - -! Apply Monotonicity preserving polar filter - call plft2d(im, jm, ht, 2, jm1, ndeg) - call avgp2(ht, sine, im, jm) - - do it=1,itmax - call del2(ht, im, jm, dg, cosp, cose, sine, DL, dp, ndeg) - call plft2d(im, jm, dg, 2, jm1, ndeg) - - do j=1,jm - do i=1,im - ht(i,j) = ht(i,j) + c*dg(i,j) - enddo - enddo - enddo - -! Final polar filter - call plft2d(im, jm, ht, 2, jm1, ndeg) - - return - end - - subroutine del2(h, im, jm, dg, cosp, cose, sine, dL, dp, ndeg) - implicit none - -! AE = 1 (unit radius) -! Input: - integer im - integer jm - integer ndeg -! Input-output - - real*8 h(im,jm) - real*8 dg(im,jm) ! del2 of h - real*8 cose(jm),cosp(jm) - real*8 sine(jm) - real*8 PI, ycrit, coszc, CD - real*8 DL, dp - -! Local - real*8 fx(im,jm) ! e-w fluxes - real*8 fy(im,jm) ! n-s fluxes - integer i, j - - call grad(h, im, jm, fx, fy, cosp, dl, dp) - - PI = 4. * ATAN(1.) - ycrit = float(ndeg)*PI/180. - coszc = cos(ycrit) - - CD = 0.25*DL*DP*coszc**2 -! CD = 0.25*DL*DP*cosp(2)**2 - - do j=2,jm-1 - do i=1,im - fx(i,j) = fx(i,j) * CD - enddo - enddo - - do j=2,jm - do i=1,im - fy(i,j) = fy(i,j) * CD - enddo - enddo - - call divg(im,jm,fx,fy,DG,cosp,cose,sine, dl, dp) - - return - end - - subroutine divg(im, jm, fx, fy, dg, cosp, cose, sine, dl, dp) - implicit none - - integer im - integer jm - real*8 fx(im,jm) ! e-w fluxes - real*8 fy(im,jm) ! n-s fluxes - real*8 DG(im,jm) ! del2 of h - real*8 wk(im,jm) - real*8 cosp(jm), cose(jm), sine(jm) - real*8 rdx - real*8 dl, dp, CDP, sum1, sum2 - integer i,j - - do j=2,jm-1 - - rdx = 1./ (cosp(j)*DL) - - do i=1,im-1 - DG(i,j) = (fx(i+1,j) - fx(i,j)) * rdx - enddo - DG(im,j) = (fx(1,j) - fx(im,j)) * rdx - enddo - - do j=2,jm - do i=1,im - wk(i,j) = fy(i,j) * cose(j) - enddo - enddo - - do j=2,jm-1 - CDP = 1./ (DP*cosp(j)) - do i=1,im - DG(i,j) = DG(i,j) + (wk(i,j+1) - wk(i,j)) * CDP - enddo - enddo - -! Poles; - - sum1 = wk(im, 2) - sum2 = wk(im,jm) - - do i=1,im-1 - sum1 = sum1 + wk(i, 2) - sum2 = sum2 + wk(i,jm) - enddo - - sum1 = sum1 / ( float(im)*(1.+sine(2)) ) - sum2 = -sum2 / ( float(im)*(1.+sine(2)) ) - - do i=1,im - DG(i, 1) = sum1 - DG(i,jm) = sum2 - enddo - - return - end - - subroutine grad(h, im, jm, fx, fy, cosp, DL, DP) - implicit none - integer im - integer jm - real*8 h(im,jm) - real*8 fx(im,jm) ! e-w fluxes - real*8 fy(im,jm) ! n-s fluxes - real*8 cosp(jm) - real*8 RDP, DL, DP, rdx - integer i, j - - RDP = 1./ DP - - do j=2,jm - do i=1,im - fy(i,j) = (h(i,j) - h(i,j-1)) * RDP - enddo - enddo - - do j=2,jm-1 - - rdx = 1./ (cosp(j)*DL) - fx(1,j) = (h(1,j) - h(im,j)) * rdx - do i=2,im - fx(i,j) = (h(i,j) - h(i-1,j)) * rdx - enddo - enddo - - return - end - - subroutine avgp2(p, sine, im, jm) - implicit none - integer im, jm - real*8 p(im,jm) - real*8 sine(jm) - real*8 sum1, sum2 - real*8 sum3, sum4 - real*8 rim - integer i - integer j - integer jm1 - - jm1 = jm-1 - rim = 1./ float(im) - - call sump2(p(1,1),p(1,jm),IM,sum1,sum2) - sum1 = sum1*(1.+sine(2)) - sum2 = sum2*(1.+sine(2)) - - call sump2(p(1,2),p(1,jm1),IM,sum3,sum4) - sum1 = rim * ( sum1 + sum3*(sine(3)-sine(2)) ) / (1.+sine(3)) - sum2 = rim * ( sum2 + sum4*(sine(3)-sine(2)) ) / (1.+sine(3)) - - do i=1,im - P(i, 1) = sum1 - P(i, 2) = sum1 - P(i,jm1) = sum2 - P(i, jm) = sum2 - enddo - return - end - - subroutine sump2(p1,p2,im,s1,s2) - implicit none - integer im,i - real*8 s1,s2 - real*8 p1(*),p2(*) - - s1 = p1(im) - s2 = p2(im) - - do i=1,im-1 - s1 = s1 + p1(i) - s2 = s2 + p2(i) - enddo - return - end - - subroutine pmnx(a,nx,ny,fmin,fmax,mnk,mxk) - implicit none - integer nx - integer ny - integer mnk - integer mxk - real*8 a(nx,*) - real*8 fmax, fmin, temp - integer i,j - - fmax = a(1,1) - fmin = a(1,1) - mnk = 1 - mxk = 1 - - do j=1,ny - do i=1,nx - temp = a(i,j) - if(temp.gt.fmax) then - fmax = temp - mxk = j - elseif(temp .lt. fmin) then - fmin = temp - mnk = j - endif - enddo - enddo - - return - end - diff --git a/tools/definesurf/varf2c.f90 b/tools/definesurf/varf2c.f90 deleted file mode 100644 index c7f638ff41..0000000000 --- a/tools/definesurf/varf2c.f90 +++ /dev/null @@ -1,219 +0,0 @@ -subroutine varf2c(flon ,flat ,nflon ,nflat ,fine , & - clon ,clat ,nclon ,nclat ,cmean , & - cvar ) - - use shr_kind_mod, only: r8 => shr_kind_r8 - -!----------------------------------------------------------------------------- -! Bin going from a fine grid to a coarse grid. -! A schematic for the coarse and fine grid systems is shown in -! Figure 1. This code assumes that each data point is represent -! it's surrounding area, called a cell. The first grid data point -! for both grids is assumed to be located at 0E (GM). This -! implies that the 1st cell for both the fine and the coarse grids -! strattles the Greenwich Meridian (GM). This code also assumes -! that there is no data wraparound (last data value is located at -! 360-dx). -! -! FIGURE 1: Overview of the coarse (X) and fine (@) grids -! longitudinal structure where: -! X = location of each coarse grid data point -! @ = location of each fine grid data point -! -! Greenwich Greenwich -! 0 Coarse cells 360 -! : v : -! clon(1): clon(2) v clon(3) clon(nclon): -! v : v v v v : -! xxxxxxxxxxxxxxxxxxxxxxxxxxxx..xxxxxxxxxxxxxxxx : -! x x x x x : -! x x x x x : -! x c(1) x c(2) x x c(nclon)x : -! x X x X x x X x : -! x ___ ___ ___ ___ ___ ___ ___ ___ ___ ___ ___ : -! x | | | | | | | | | | | | | : -! x | @ | @ | @ | @ | @ | @ |..| @ | @ | @ | @ | @ | : -! xxx|___|___|___|___|___|___| |___|___|___|___|___| : -! v v v v v : -! flon(1) flon(3) v flon(nflon-1) flon(nflon) -! : v : -! : Fine cells : -! 0 360 -! -! The Longitude/Latitude search: -! ------------------------------ -! -! Given a coarse grid cell with west and east boundaries of cWest -! and cEast and south and north boundaries of cSouth and cNorth -! (outlined by "x" in figure 2), find the indices of the fine grid -! points which are contained within the coarse grid cell. imin and -! imax are the indices fine grid points which overlap the western -! and eastern boundary of the coarse cell. jmin and jmax are the -! corresponding indices in the S-N direction. Bin these overlapping -! values to generate coarse(n), the coarse grid data values. -! -! FIGURE 2: Detail of Coarse and Fine cell overlap. -! @ = fine grid data point -! X = coarse grid data point -! -! cWest cEast -! | | x | | x | -! -@-------@---x---@-------@-----x-@- -! | | x*xxxxxxxxxxxxxxxxx*x|xx cNorth -! | | x | | x | -! | | x | | x | -! @-------@---x---@-------@-----x-@- jmax -! | | x | c(n) | x | -! | @ | x | | x | -! | | x | | x | -! @-------@---x---@-------@-----x-@- jmin -! | | x | | x | -! | @ | x*xxxxxxx@xxxxxxxxx*x|xx cSouth -! | | x | | x | -! -@-------@---x---@-------@-----x-@- -! | imin imax | -! -! -! When a cell coarse cell strattles the Greenwich Meridian -! --------------------------------------------------------- -! -! The first coarse grid cell strattles the GM, so when the western -! boundary of the coarse cell is < 0, an additional search is carried out. -! It ASSUMES that the easternmost fine grid point overlaps and searches -! westward from nflon, looking for a grid point west of clon(1) -! This generates a second set of longitudinal indices, imin1 and imax1. -! See Figure 3. -! -! Figure 3: Detail of Coarse cell strattling GM: -! ----------------------------------------------- -! -! Greenwich Greenwich -! 0 360 -! cWest : cEast cWest : -! clon(1): clon(2) clon(nclon+1)=clon(1) -! v : v v : -! xxxxxxxxxxxxxxxxxxxxxxx ... xxxxxxxxxxxxxxxx : -! x x x x x : -! x x x x x : -! x c(1) x x x c(nclon)x : -! x X x x x X x : -! x ___ ___ ___ _ ___ ___ ___ : -! x | | | | | | | : -! x | @ | @ | @ | @ | @ | @ | : -! xxx|___|___|___|_ ___|___|___| : -! ^ : ^ ^ ^ ^ : -! flon(1): ^ flon(3) flon(nflon-1) ^ : -! ^ : ^ ^ ^ : -! ^ :flon(2) ^ flon(nflon) -! ^ : ^ ^ ^ : -! imin : imax imin1 imax1 : -! : : -! -! -! In this case, imin=1, imax=2, imin1=nflon-1 and imax1=nflon. -! because the last two cells of the fine grid will have some -! contribution the the 1st cell of the coarse grid. -! -!----------------------------------------------------------------------- - implicit none -!-----------------------------Arguments--------------------------------- - - integer nflon ! Input: number of fine longitude points - integer nflat ! Input: number of fine latitude points - integer nclon ! Input: number of coarse longitude points - integer nclat ! Input: number of coarse latitude points - - real(r8) flon(nflon) ! Input: fine grid lons, centers (deg) - real(r8) flat(nflat) ! Input: fine grid lats, centers (deg) - real(r8) fine(nflon,nflat) ! Input: Fine grid data array - real(r8) clon(nclon+1,nclat) ! Input: coarse grid cell lons, west edge (deg) - real(r8) clat(nclat+1) ! Input: coarse grid cell lat, south edge (deg) - real(r8) cmean(nclon,nclat) ! Input: mean of fine points over coarse grid cell - real(r8) cvar (nclon,nclat) ! Output:variance of fine points over coarse cell - -!--------------------------Local variables------------------------------ - - real(r8) cWest ! Coarse cell longitude, west edge (deg) - real(r8) cEast ! Coarse cell longitude, east edge (deg) - real(r8) cSouth ! Coarse cell latitude, south edge (deg) - real(r8) cNorth ! Coarse cell latitude, notrh edge (deg) - real(r8) sum ! coarse tmp value - - integer i,j ! Indices - integer imin ,imax ! Max/Min E-W indices of intersecting fine cell. - integer imin1,imax1 ! fine E-W indices when coarse cell strattles GM - integer jmin ,jmax ! Max/Min N-S indices of intersecting fine cell. - integer iclon,jclat ! coarse grid indices - integer num ! increment - -!----------------------------------------------------------------------------- - - do jclat= 1,nclat ! loop over coarse latitudes - cSouth = clat(jclat) - cNorth = clat(jclat+1) - - do iclon=1,nclon ! loop over coarse longitudes - cWest = clon(iclon,jclat) - cEAST = clon(iclon+1,jclat) - -! 1. Normal longitude search: Find imin and imax - - imin = 0 - imax = 0 - do i=1,nflon-1 ! loop over fine lons, W -> E - if (flon(i) .gt. cEast) goto 10 ! fine grid point is E of coarse box - if (flon(i) .ge. cWest .and. imin.eq.0) imin=i - imax=i - enddo - -! 2. If cWest < 0, then coarse cell strattles GM. Hunt westward -! from the end to find indices of any overlapping fine grid cells: -! imin1 and imax1. - -10 imin1 = 0 ! borders for cWest, cEast - imax1 = -1 ! borders for cWest, cEast - if (cWest .lt. 0) then - cWest = cWest + 360. - imax1 = nflon - do i=nflon,1,-1 ! loop over fine lons, E -> W - imin1=i - if (flon(i) .le. cWest) goto 20 ! fine grid point is W of coarse box - enddo - endif - -! 3. Do the latitude search S -> N for jmin and jmax - -20 jmin = 0 - jmax = 0 - do j=1,nflat ! loop over fine lats, S -> N - if (flat(j) .gt. cNorth) goto 30 ! fine grid point is N of coarse box - if (flat(j) .ge. cSouth .and. jmin.eq.0) jmin=j - jmax=j - enddo -30 continue - -! 4. Sdv - - sum = 0. ! Initialize coarse data value - num = 0 - - do j=jmin,jmax ! loop over fine lats, S -> N - do i=imin,imax ! loop over fine lons, W -> E - sum = sum + (fine(i,j) - cmean(iclon,jclat))**2 - num = num + 1 - enddo - do i=imin1,imax1 ! If coarse cell strattles GM - sum = sum + (fine(i,j) - cmean(iclon,jclat))**2 - num = num + 1 - enddo - enddo - - if (num .gt. 0) then - cvar(iclon,jclat) = sum/num - else - cvar(iclon,jclat) = 1.e30 - endif - end do - end do - return -end subroutine varf2c diff --git a/tools/definesurf/wrap_nf.f90 b/tools/definesurf/wrap_nf.f90 deleted file mode 100644 index c340b3817b..0000000000 --- a/tools/definesurf/wrap_nf.f90 +++ /dev/null @@ -1,146 +0,0 @@ -subroutine wrap_inq_varid (nfid, varname, varid) - implicit none - include 'netcdf.inc' - - integer nfid, varid - character*(*) varname - - integer ret - - ret = nf_inq_varid (nfid, varname, varid) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_inq_varid - -subroutine wrap_inq_dimlen (nfid, dimid, dimlen) - implicit none - include 'netcdf.inc' - - integer nfid, dimid, dimlen - - integer ret - - ret = nf_inq_dimlen (nfid, dimid, dimlen) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_inq_dimlen - -subroutine wrap_inq_dimid (nfid, dimname, dimid) - implicit none - include 'netcdf.inc' - - integer nfid, dimid - character*(*) dimname - - integer ret - - ret = nf_inq_dimid (nfid, dimname, dimid) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_inq_dimid - -subroutine wrap_inq_var (nfid, varid, varname, xtype, ndims, dimids, natts) - implicit none - include 'netcdf.inc' - - integer nfid, varid, xtype, ndims, dimids(nf_max_dims), natts - character*(*) varname - - integer ret - - ret = nf_inq_var (nfid, varid, varname, xtype, ndims, dimids, natts) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_inq_var - -subroutine wrap_def_dim (nfid, dimname, len, dimid) - implicit none - include 'netcdf.inc' - - integer nfid, len, dimid - character*(*) dimname - - integer ret - - ret = nf_def_dim (nfid, dimname, len, dimid) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_def_dim - -subroutine wrap_get_var8 (nfid, varid, arr) - implicit none - include 'netcdf.inc' - - integer nfid, varid - real*8 arr(*) - - integer ret - - ret = nf_get_var_double (nfid, varid, arr) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_get_var8 - -subroutine wrap_put_var8 (nfid, varid, arr) - implicit none - include 'netcdf.inc' - - integer nfid, varid - real*8 arr(*) - - integer ret - ret = nf_put_var_double (nfid, varid, arr) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_put_var8 - -subroutine wrap_get_vara8 (nfid, varid, start, count, arr) - implicit none - include 'netcdf.inc' - - integer nfid, varid, start(*), count(*) - real*8 arr(*) - - integer ret - - ret = nf_get_vara_double (nfid, varid, start, count, arr) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_get_vara8 - -subroutine wrap_put_vara8 (nfid, varid, start, count, arr) - implicit none - include 'netcdf.inc' - - integer nfid, varid - integer start(*), count(*) - real*8 arr(*) - - integer ret - ret = nf_put_vara_double (nfid, varid, start, count, arr) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_put_vara8 - -subroutine wrap_put_att_text (nfid, varid, attname, atttext) - implicit none - include 'netcdf.inc' - - integer, intent(in):: nfid - integer, intent(in):: varid - character*(*), intent(in):: attname - character*(*), intent(in):: atttext - - integer ret ! NetCDF return code - integer siz - - siz = len_trim(atttext) - ret = nf_put_att_text (nfid, varid, attname, siz, atttext) - if (ret/=NF_NOERR) call handle_error (ret) -end subroutine wrap_put_att_text - -subroutine wrap_put_att_double (nfid, varid, name, xtype, len, dvals) - implicit none - include 'netcdf.inc' - - integer nfid, varid, xtype, len - character*(*) name - real*8 dvals - - integer ret - - ret = nf_put_att_double (nfid, varid, name, xtype, len, dvals) - if (ret.ne.NF_NOERR) call handle_error (ret) -end subroutine wrap_put_att_double - diff --git a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90 b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90 index 0e4fc2c202..3d0a26cc6e 100644 --- a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90 +++ b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90 @@ -571,8 +571,8 @@ subroutine binning(plev ,plato ,plono ,plat ,plon , & ! ! starting at 0 deg and moving ! ! eastward real*8 gwo (plato) ! Output Gaussian wgts (if relevant grid) - integer dyn_flag ! Dynamics flag of input grid: Eul=1, FV=0 - integer dyn_flago ! Dynamics flag of output grid: Eul=1, FV=0 + integer dyn_flag ! Dynamics flag of input grid: FV=0 + integer dyn_flago ! Dynamics flag of output grid: FV=0 real*8 bin_factor ! bin-box area expansion/contraction factor relative to ! ! output grid-box area. ! diff --git a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90-EXTEND b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90-EXTEND index 0e4fc2c202..3d0a26cc6e 100644 --- a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90-EXTEND +++ b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90-EXTEND @@ -571,8 +571,8 @@ ! ! starting at 0 deg and moving ! ! eastward real*8 gwo (plato) ! Output Gaussian wgts (if relevant grid) - integer dyn_flag ! Dynamics flag of input grid: Eul=1, FV=0 - integer dyn_flago ! Dynamics flag of output grid: Eul=1, FV=0 + integer dyn_flag ! Dynamics flag of input grid: FV=0 + integer dyn_flago ! Dynamics flag of output grid: FV=0 real*8 bin_factor ! bin-box area expansion/contraction factor relative to ! ! output grid-box area. ! diff --git a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90-ORIG b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90-ORIG index 07e3c16dd5..c3c6f8113d 100644 --- a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90-ORIG +++ b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.f90-ORIG @@ -571,8 +571,8 @@ ! ! starting at 0 deg and moving ! ! eastward real*8 gwo (plato) ! Output Gaussian wgts (if relevant grid) - integer dyn_flag ! Dynamics flag of input grid: Eul=1, FV=0 - integer dyn_flago ! Dynamics flag of output grid: Eul=1, FV=0 + integer dyn_flag ! Dynamics flag of input grid: FV=0 + integer dyn_flago ! Dynamics flag of output grid: FV=0 real*8 bin_factor ! bin-box area expansion/contraction factor relative to ! ! output grid-box area. ! diff --git a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.stub b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.stub index 063a496c56..cea7413b1c 100644 --- a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.stub +++ b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/MAKEIC.stub @@ -116,8 +116,8 @@ C ! starting from southern-most lat C ! starting at 0 deg and moving C ! eastward real*8 gwo (plato) ! Output Gaussian wgts (if relevant grid) - integer dyn_flag ! Dynamics flag of input grid: Eul=1, FV=0 - integer dyn_flago ! Dynamics flag of output grid: Eul=1, FV=0 + integer dyn_flag ! Dynamics flag of input grid: FV=0 + integer dyn_flago ! Dynamics flag of output grid: FV=0 real*8 bin_factor ! bin-box area expansion/contraction factor relative to C ! output grid-box area. C diff --git a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC.ncl b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC.ncl index e42ff54980..1b33ae37dd 100644 --- a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC.ncl +++ b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC.ncl @@ -62,9 +62,6 @@ begin adjust_state_from_topo = field@adjust_state_from_topo mass_fix = False - if(dycore .eq. "eul") then - mass_fix = True - end if ;------------------------ ; Define disk directories @@ -231,8 +228,8 @@ begin exit_script = False - if(dycore .ne. "eul" .and. dycore .ne. "fv" .and. dycore .ne. "homme" ) then - print("Error: 'dycore' must be: 'eul', 'fv', or 'homme'") + if(dycore .ne. "fv" .and. dycore .ne. "homme" ) then + print("Error: 'dycore' must be: 'fv', or 'homme'") print(" 'dycore' is currently: "+dycore) exit_script = True end if diff --git a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_Create_field_Master_List.ncl b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_Create_field_Master_List.ncl index a2f5c49363..19a24719ad 100644 --- a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_Create_field_Master_List.ncl +++ b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_Create_field_Master_List.ncl @@ -10,7 +10,7 @@ function Create_field_Master_List(spectral_trunc_setting:integer, field:string ) ;********************************************************************************************; ; ; ; Create_field_Master_List ; -; spectral_trunc_setting : integer; Spectral truncation (Eulerian only) ; +; spectral_trunc_setting : integer; Spectral truncation (if Gaussian grid) ; ; "field" is a master variable carrying meta-data needed for file ; ; processing ; ; ; @@ -29,7 +29,7 @@ begin Master_List@dimensions = new( (/field_dim/), string ) ; "2D" or "3D" designation Master_List@horz_interp = new( (/field_dim/), string ) ; flag to indicate which type of horizontal interpolation to use Master_List@vert_interp = new( (/field_dim/), string ) ; flag to indicate which type of vertical interpolation to use - Master_List@spec_trunc = new( (/field_dim/), integer) ; Spectral truncation to use (if Eulerian dycore) + Master_List@spec_trunc = new( (/field_dim/), integer) ; Spectral truncation (if Gaussian grid). Master_List@bin_factor = new( (/field_dim/), double ) ; bin factor to use if horizontal interpolation is "binning" ; (typical value: 1.) Master_List@loutput = new( (/field_dim/), logical) ; Flag to output field (if False, field is used only for internal processing @@ -56,7 +56,7 @@ begin ; Options for horizontal: "no_interp" ; "cubic" ; recommended only for non-tracer species ; "cubic_sp" ; should only be used for tracers and water products like Q, CLDLIQ, CLDICE, CLOUD, etc. - ; "spectral" ; only for non-tracer species in the Eulerian dycore + ; "spectral" ; only for non-tracer species (if Gaussian grid) ; "binning" ; "conservative remapping" --> recommended for all horizontal interpolations ; ; Options for vertical: "no_interp" @@ -733,9 +733,6 @@ begin print(" Valid post-processing options are: '"+post_process_flags+"'") exit end if - if( field@dycore .ne. "eul") then - Master_List@spec_trunc(ifield) = -1 - end if end do delete(Master_List@_FillValue) diff --git a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_ERAI.csh b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_ERAI.csh index 45105f799e..a21e1099ed 100755 --- a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_ERAI.csh +++ b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_ERAI.csh @@ -23,11 +23,11 @@ setenv REF_DATE 20070901 # Output file format setenv CASE ERAI_f09_L30 # Case name that will be appended to name of output file -setenv DYCORE fv # Dycore ("eul" or "fv" are the current choices) +setenv DYCORE fv # Dycore ("fv" is the only current choice) setenv PRECISION float # "double" or "float" are the current choices of output precision -setenv PTRM -1 # "M" spectral truncation (for "eul" dycore only; ignored for other dycores; "-1" = no trunc) -setenv PTRN -1 # "N" spectral truncation (for "eul" dycore only; ignored for other dycores; "-1" = no trunc) -setenv PTRK -1 # "K" spectral truncation (for "eul" dycore only; ignored for other dycores; "-1" = no trunc) +setenv PTRM -1 # "M" spectral truncation (for Gaussian grid; "-1" = no trunc) +setenv PTRN -1 # "N" spectral truncation (for Gaussian grid; "-1" = no trunc) +setenv PTRK -1 # "K" spectral truncation (for Gaussian grid; "-1" = no trunc) setenv PLAT 192 # Number of latitudes on output IC file setenv PLON 288 # Number of longitudes on output IC file setenv PLEV 30 # Number of vert levs on output IC file diff --git a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_extract_analyses_info.ncl b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_extract_analyses_info.ncl index cf0e726b5e..54cad74295 100644 --- a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_extract_analyses_info.ncl +++ b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_extract_analyses_info.ncl @@ -260,7 +260,7 @@ begin if(ftype .eq. "CAM") then - ; Standard CAM Eulerian or FV file + ; Standard CAM FV file file_dim_names = getvardims (data) diff --git a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_procedures.ncl b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_procedures.ncl index c2acc74f2d..fece1c56f7 100644 --- a/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_procedures.ncl +++ b/tools/nudging/Gen_Data/Gen_Data_FVdycore/Gen_Data_SETNAME_f09/makeIC_procedures.ncl @@ -2493,7 +2493,7 @@ begin ; extracted field@horz_interp = new( (/field_dim/), string ) ; flag to indicate which type of horizontal interpolation to use field@vert_interp = new( (/field_dim/), string ) ; flag to indicate which type of vertical interpolation to use - field@spec_trunc = new( (/field_dim/), integer) ; Spectral truncation to use (if Eulerian dycore) + field@spec_trunc = new( (/field_dim/), integer) ; Spectral truncation to use (if Gaussian grid) field@bin_factor = new( (/field_dim/), double ) ; bin factor to use if horizontal interpolation is "binning" ; (typical value: 1.) field@processed = new( (/field_dim/), logical) ; Set to False until field is processed @@ -2738,24 +2738,12 @@ begin ;------------------------- if(field@plevo .gt. 0) then - if(field@dycore .eq. "eul") then - filedimdef(cdf,(/"lat" ,"lon" ,"lev" ,"ilev" ,"time","scalar"/),\ - (/field@plato,field@plono,field@plevo,field@plevo+1,1 ,1 /),\ - (/False ,False , False , False , True , False /) ) - end if - if(field@dycore .eq. "fv") then filedimdef(cdf,(/"lat" ,"lon" ,"slat" ,"slon" ,"lev" ,"ilev" ,"time","scalar"/),\ (/field@plato,field@plono,field@plato-1,field@plono,field@plevo,field@plevo+1,1 ,1 /),\ (/False ,False ,False ,False , False , False , True , False /) ) end if else - if(field@dycore .eq. "eul") then - filedimdef(cdf,(/"lat" ,"lon" ,"time","scalar"/),\ - (/field@plato,field@plono,1 ,1 /),\ - (/False ,False , True , False /) ) - end if - if(field@dycore .eq. "fv") then filedimdef(cdf,(/"lat" ,"lon" ,"slat" ,"slon" ,"time","scalar"/),\ (/field@plato,field@plono,field@plato-1,field@plono,1 ,1 /),\ @@ -2877,89 +2865,6 @@ begin ; Define dycore-specific parameters and coordinates ;-------------------------------------------------- -;--------- -; Eulerian -;--------- - - if(field@dycore .eq. "eul") then - - filevardef (cdf,"lat","double",(/"lat"/)) - cdf->lat@long_name = "latitude" - cdf->lat@units = "degrees_north" - - filevardef (cdf,"lon","double",(/"lon"/)) - cdf->lon@long_name = "longitude" - cdf->lon@units = "degrees_east" - - filevardef (cdf,"ntrm","integer",(/"scalar"/)) - cdf->ntrm@long_name = "spectral truncation parameter M" - - filevardef (cdf,"ntrn","integer",(/"scalar"/)) - cdf->ntrn@long_name = "spectral truncation parameter N" - - filevardef (cdf,"ntrk","integer",(/"scalar"/)) - cdf->ntrk@long_name = "spectral truncation parameter K" - - filevardef (cdf,"gw","double",(/"lat"/)) - cdf->gw@long_name = "gauss weights" - -;----------------------- -; Pre-set some variables -;----------------------- - - del_lon = (360./field@plono) - - cdf->lon = ispan(0,field@plono-1,1)*del_lon - gau_info = gaus(field@plato/2) - cdf->lat = gau_info(:,0) - cdf->gw = gau_info(:,1) - - cdf->ntrm = field@ptrmo - cdf->ntrn = field@ptrno - cdf->ntrk = field@ptrko - - field@lat = cdf->lat - field@lon = cdf->lon - -;--------------------------------------------------- -; Define field variables, dimensions, and attributes -;--------------------------------------------------- - - time_dim = "time" - lev_dim = "lev" - count = 0 - do i = 0,nfields-1 - - if(field@loutput(i)) then - count = count + 1 - - print (" Declare space for output field: "+field(i)+ \ - " (field "+count+" of "+nfields_out+")") - - lat_dim = "lat" - lon_dim = "lon" - - if(field@dimensions(i) .eq. "2D") then - filevardef (cdf,field(i),field@precision,(/time_dim,lat_dim,lon_dim/)) - end if - if(field@dimensions(i) .eq. "3D") then - filevardef (cdf,field(i),field@precision,(/time_dim,lev_dim,lat_dim,lon_dim /)) - end if - - cdf->$field(i)$@long_name = field@long_name (i) - cdf->$field(i)$@units = field@units (i) - cdf->$field(i)$@source_file = fname(field@source_file (i)) - cdf->$field(i)$@source_field_name = field@source_field(i) - cdf->$field(i)$@horz_interp_flag = field@horz_interp (i) - if(field@dimensions(i) .eq. "3D") then - cdf->$field(i)$@vert_interp_flag = field@vert_interp (i) - end if - end if - - end do - - end if - ;--- ; FV ;--- diff --git a/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/MAKEIC.f90 b/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/MAKEIC.f90 index da5561735c..a985fcf97a 100644 --- a/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/MAKEIC.f90 +++ b/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/MAKEIC.f90 @@ -571,8 +571,8 @@ subroutine binning(plev ,plato ,plono ,plat ,plon , & ! ! starting at 0 deg and moving ! ! eastward real*8 gwo (plato) ! Output Gaussian wgts (if relevant grid) - integer dyn_flag ! Dynamics flag of input grid: Eul=1, FV=0 - integer dyn_flago ! Dynamics flag of output grid: Eul=1, FV=0 + integer dyn_flag ! Dynamics flag of input grid: FV=0 + integer dyn_flago ! Dynamics flag of output grid: FV=0 real*8 bin_factor ! bin-box area expansion/contraction factor relative to ! ! output grid-box area. ! diff --git a/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/MAKEIC.stub b/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/MAKEIC.stub index 74963f0d30..6b0ccd939b 100644 --- a/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/MAKEIC.stub +++ b/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/MAKEIC.stub @@ -116,8 +116,8 @@ C ! starting from southern-most lat C ! starting at 0 deg and moving C ! eastward real*8 gwo (plato) ! Output Gaussian wgts (if relevant grid) - integer dyn_flag ! Dynamics flag of input grid: Eul=1, FV=0 - integer dyn_flago ! Dynamics flag of output grid: Eul=1, FV=0 + integer dyn_flag ! Dynamics flag of input grid: FV=0 + integer dyn_flago ! Dynamics flag of output grid: FV=0 real*8 bin_factor ! bin-box area expansion/contraction factor relative to C ! output grid-box area. C diff --git a/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_Create_field_Master_List.ncl b/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_Create_field_Master_List.ncl index 1731f775e4..5351042467 100644 --- a/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_Create_field_Master_List.ncl +++ b/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_Create_field_Master_List.ncl @@ -10,7 +10,7 @@ function Create_field_Master_List(spectral_trunc_setting:integer, field:string ) ;********************************************************************************************; ; ; ; Create_field_Master_List ; -; spectral_trunc_setting : integer; Spectral truncation (Eulerian only) ; +; spectral_trunc_setting : integer; Spectral truncation (Gaussian grid only) ; ; "field" is a master variable carrying meta-data needed for file ; ; processing ; ; ; @@ -29,7 +29,7 @@ begin Master_List@dimensions = new( (/field_dim/), string ) ; "2D" or "3D" designation Master_List@horz_interp = new( (/field_dim/), string ) ; flag to indicate which type of horizontal interpolation to use Master_List@vert_interp = new( (/field_dim/), string ) ; flag to indicate which type of vertical interpolation to use - Master_List@spec_trunc = new( (/field_dim/), integer) ; Spectral truncation to use (if Eulerian dycore) + Master_List@spec_trunc = new( (/field_dim/), integer) ; Spectral truncation to use (if Gaussian grid) Master_List@bin_factor = new( (/field_dim/), double ) ; bin factor to use if horizontal interpolation is "conserve" ; (typical value: 1.) Master_List@loutput = new( (/field_dim/), logical) ; Flag to output field (if False, field is used only for internal processing @@ -746,9 +746,6 @@ begin print(" Valid post-processing options are: '"+post_process_flags+"'") exit end if - if( field@dycore .ne. "eul") then - Master_List@spec_trunc(ifield) = -1 - end if end do delete(Master_List@_FillValue) diff --git a/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_extract_analyses_info.ncl b/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_extract_analyses_info.ncl index 5c10beed42..87ef53cbe1 100644 --- a/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_extract_analyses_info.ncl +++ b/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_extract_analyses_info.ncl @@ -265,7 +265,7 @@ begin if(ftype .eq. "CAM") then - ; Standard CAM Eulerian or FV file + ; Standard CAM FV file file_dim_names = getvardims (data) diff --git a/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_se_procedures.ncl b/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_se_procedures.ncl index f04670080b..f5db9ae6bf 100644 --- a/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_se_procedures.ncl +++ b/tools/nudging/Gen_Data/Gen_Data_SEdycore/Gen_Data_SETNAME_ne30/makeIC_se_procedures.ncl @@ -1216,7 +1216,7 @@ begin ; interpolation to use field@vert_interp =new( (/field_dim/), string ) ; flag to indicate which type of vertical ; interpolation to use - field@spec_trunc =new( (/field_dim/), integer) ; Spectral truncation to use (if Eulerian dycore) + field@spec_trunc =new( (/field_dim/), integer) ; Spectral truncation to use (if Gaussian grid) field@bin_factor =new( (/field_dim/), double ) ; bin factor to use if horizontal ; interpolation is "binning" (typical value: 1.) field@processed =new( (/field_dim/), logical) ; Set to False until field is processed diff --git a/tools/topo_tool/bin_to_cube/Makefile b/tools/topo_tool/bin_to_cube/Makefile deleted file mode 100644 index 84d1b39138..0000000000 --- a/tools/topo_tool/bin_to_cube/Makefile +++ /dev/null @@ -1,82 +0,0 @@ -EXEDIR = . -EXENAME = bin_to_cube -RM = rm - -.SUFFIXES: -.SUFFIXES: .F90 .o - - -# -# setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib -# - -FC = lf95 -#DEBUG=TRUE - -# Check for the NetCDF library and include directories -ifeq ($(LIB_NETCDF),$(null)) -LIB_NETCDF := /usr/local/lib -endif - -ifeq ($(INC_NETCDF),$(null)) -INC_NETCDF := /usr/local/include -endif - -# Determine platform -UNAMES := $(shell uname -s) -UNAMEM := $(findstring CRAY,$(shell uname -m)) - - -#------------------------------------------------------------------------ -# LF95 -#------------------------------------------------------------------------ - -ifeq ($(FC),lf95) -# -# Tramhill -# - INC_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/include - LIB_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib - - LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -lnetcdff -lcurl -lhdf5 -lhdf5_hl -mcmodel=medium - FFLAGS := -c --trace --trap --wide -CcdRR8 -I$(INC_NETCDF) - ifeq ($(DEBUG),TRUE) - #TBH: this works FFLAGS += -g --chk --pca - #TBH: this FAILS FFLAGS += -g --chk a,e,s,u,x --pca - FFLAGS += -g --chk a,e,s,u --pca - else - FFLAGS += -O - endif - -endif - - -#------------------------------------------------------------------------ -# AIX -#------------------------------------------------------------------------ - -ifeq ($(UNAMES),AIX) -FC = xlf90 -FFLAGS = -c -I$(INC_NETCDF) -LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -.F90.o: - $(FC) $(FFLAGS) -qsuffix=f=F90 $< -endif - - -.F90.o: - $(FC) $(FFLAGS) $< - -#------------------------------------------------------------------------ -# Default rules and macros -#------------------------------------------------------------------------ - -OBJS := bin_to_cube.o shr_kind_mod.o - -$(EXEDIR)/$(EXENAME): $(OBJS) - $(FC) -o $@ $(OBJS) $(LDFLAGS) - -clean: - $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) - -bin_to_cube.o: shr_kind_mod.o diff --git a/tools/topo_tool/bin_to_cube/README b/tools/topo_tool/bin_to_cube/README deleted file mode 100644 index aa65664798..0000000000 --- a/tools/topo_tool/bin_to_cube/README +++ /dev/null @@ -1,23 +0,0 @@ -This program reads USGS 30-sec terrain dataset from NetCDF file and bins it to an approximately -3km cubed-sphere grid and outputs the data in netCDF format. - -The LANDM_COSLAT field is read in from a separate netCDF file and linearly interpolated to the 3km cubed-sphere grid. - -Input files needed: - -1. USGS raw data in netCDF format: usgs-rawdata.nc (must be placed in same dirctory as the executables) - Generated with software in gen_netCDF_from_USGS/ directory - - File may be found at: - - $CESMDATA/inputdata/atm/cam/gtopo30data/usgs-rawdata.nc - -2. landm_coslat dataset (must be placed in same dirctory as the executables). E.g.: - - ln -s /fs/cgd/csm/inputdata/atm/cam2/hrtopo/landm_coslat.nc . - - The landm_coslat field is not used in CAM5! - -Output file: - -USGS-topo-cube.nc diff --git a/tools/topo_tool/bin_to_cube/bin_to_cube.F90 b/tools/topo_tool/bin_to_cube/bin_to_cube.F90 deleted file mode 100644 index 89ea086a37..0000000000 --- a/tools/topo_tool/bin_to_cube/bin_to_cube.F90 +++ /dev/null @@ -1,931 +0,0 @@ -! -! DATE CODED: Nov 7, 2011 -! -! DESCRIPTION: This program reads USGS 30-sec terrain dataset from NetCDF file and -! bins it to an approximately 3km cubed-sphere grid and outputs the -! data in netCDF format. -! -! The LANDM_COSLAT field is read in from a separate netCDF file and linearly -! interpolated to the 3km cubed-sphere grid. -! -! Author: Peter Hjort Lauritzen (pel@ucar.edu) -! -! ROUTINES CALLED: -! netcdf routines -! -! COMPILING: -! -program convterr - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none -# include - ! - integer :: im, jm - - integer, parameter :: ncube = 3000 !dimension of cubed-sphere grid -! integer, parameter :: ncube = 540 !dimension of cubed-sphere grid - ! integer, parameter :: ncube = 361 ! for debugging - - integer*2, allocatable, dimension(:,:) :: terr ! global 30-sec terrain data - integer*1, allocatable, dimension(:,:) :: landfrac ! global 30-sec land fraction - - integer :: alloc_error,dealloc_error - integer :: i,j,n,k,index ! index - integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile - integer ncid,status, dimlatid,dimlonid, landid, topoid ! for netCDF USGS data file - integer :: srcid,dstid ! for netCDF weight file - - real(r8), allocatable, dimension(:) :: lon , lat - real(r8), allocatable, dimension(:) :: lon_landm , lat_landm - real(r8), allocatable, dimension(:,:) :: landm_coslat - integer :: im_landm, jm_landm - integer :: lonid, latid - integer :: lon_vid, lat_vid - - REAL (r8), PARAMETER :: tiny = 1.0E-10 - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: rad2deg = 180.0/pi - REAL (r8), PARAMETER :: deg2rad = pi/180.0 - - real(r8) :: alpha, beta,da,wt,dlat - integer :: ipanel,icube,jcube - real(r8), allocatable, dimension(:,:,:) :: weight,terr_cube,landfrac_cube,sgh30_cube - real(r8), allocatable, dimension(:,:,:) :: landm_coslat_cube - integer , allocatable, dimension(:,:) :: idx,idy,idp - ! - real(r8) :: dx,dy - ! - ! for "bi-linear" interpolation - ! - real(r8) :: lambda,theta,wx,wy - integer :: ilon,ilat,ip1,jp1 - ! - ! variable for regridding - ! - integer :: src_grid_dim ! for netCDF weight file - ! - ! this is only used if target grid is a lat-lon grid - ! - integer , parameter :: im_target = 360 , jm_target = 180 - logical , parameter :: ltarget_rll = .TRUE. - ! - ! this is only used if target grid is not a lat-lon grid - ! - real(r8), allocatable, dimension(:) :: lon_target, lat_target - ! - ! compute volume of surface topography - ! - real(r8) :: vol,dx_rad,vol_cube,area_latlon,darea_latlon ! latitude array - real(r8), allocatable, dimension(:,:) :: darea_cube - - ! - ! read in USGS data from netCDF file - ! - ! status = nf_open('topo-lowres.nc', 0, ncid) !for debugging - status = nf_open('usgs-rawdata.nc', 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - - status = NF_INQ_DIMID(ncid, 'lat', dimlatid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimlatid, jm) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_INQ_DIMID(ncid, 'lon', dimlonid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimlonid, im) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "lon-lat dimensions: ",im,jm - - allocate ( landfrac(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - allocate ( terr(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr' - stop - end if - - allocate ( lon(im),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - allocate ( lat(jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - terr = -999999 - landfrac = -99.0 - - status = NF_INQ_VARID(ncid, 'landfract', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_INT1(ncid, landid,landfrac) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of 30sec land fraction",MINVAL(landfrac),MAXVAL(landfrac) - - - status = NF_INQ_VARID(ncid, 'htopo', topoid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "read terrain data" - status = NF_GET_VAR_INT2(ncid, topoid,terr) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_INQ_VARID(ncid, 'lon', lonid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "read lon" - status = NF_GET_VAR_DOUBLE(ncid, lonid,lon) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_INQ_VARID(ncid, 'lat', latid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "read lat" - status = NF_GET_VAR_DOUBLE(ncid, latid,lat) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - print *,"close file topo.nc" - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err(status) - - WRITE(*,*) 'done reading in USGS data from netCDF file' - - WRITE(*,*) "Adjustments to land fraction: Extend land fraction for Ross Ice shelf by" - WRITE(*,*) "setting all landfractions south of 79S to 1" - DO j=1,jm - IF (lat(j)<-79.0) THEN - DO i=1,im - landfrac(i,j) = 1 - END DO - END IF - END DO - - WRITE(*,*) "compute volume for USGS raw data" - vol = 0.0 - dx = (lon(2)-lon(1)) - dx_rad = dx*deg2rad - do j=1,jm - do i=1,im - darea_latlon = dx_rad*(SIN(deg2rad*(-90.0+dx*j))-SIN(deg2rad*(-90.0+dx*(j-1)))) - vol = vol+DBLE(terr(i,j))*darea_latlon - area_latlon = area_latlon + darea_latlon - end do - end do - vol = vol/area_latlon - WRITE(*,*) "consistency of lat-lon area",area_latlon-4.0*pi - WRITE(*,*) "volume of topography about sea-level (raw usgs data)",vol - - - ! - !**************************************************** - ! - ! read LANDM_COSLAT - ! - !**************************************************** - ! - WRITE(*,*) "read LANDM_COSLAT from file" - status = nf_open('landm_coslat.nc', 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - - status = NF_INQ_DIMID(ncid, 'lat', dimlatid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimlatid, jm_landm) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_INQ_DIMID(ncid, 'lon', dimlonid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimlonid, im_landm) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "lon-lat dimensions: ",im_landm,jm_landm - - allocate ( landm_coslat(im_landm,jm_landm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - allocate ( lon_landm(im_landm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - allocate ( lat_landm(jm_landm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - do j = 1, jm_landm - do i = 1, im_landm - landm_coslat(i,j) = -999999.99 - end do - end do - - status = NF_INQ_VARID(ncid, 'LANDM_COSLAT', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,landm_coslat) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of landm_coslat",MINVAL(landm_coslat),MAXVAL(landm_coslat) - - status = NF_INQ_VARID(ncid, 'lon', lonid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "read lon" - status = NF_GET_VAR_DOUBLE(ncid, lonid,lon_landm) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_INQ_VARID(ncid, 'lat', latid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - WRITE(*,*) "read lat" - status = NF_GET_VAR_DOUBLE(ncid, latid,lat_landm) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - print *,"close file" - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err(status) - - WRITE(*,*) 'done reading in LANDM_COSLAT data from netCDF file' - - ! - ! bin data on cubed-sphere grid - ! - da = pi / DBLE(2*ncube)!equal-angle cubed-sphere grid spacing - lon = deg2rad*lon - lat = deg2rad*lat - dlat = pi/DBLE(jm) - allocate ( weight(ncube,ncube,6),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for weight' - stop - end if - weight = 0.0 - allocate ( terr_cube(ncube,ncube,6),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr_cube' - stop - end if - terr_cube = 0.0 - allocate ( landfrac_cube(ncube,ncube,6),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr_cube' - stop - end if - landfrac_cube = 0.0 - allocate ( landm_coslat_cube(ncube,ncube,6),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr_cube' - stop - end if - landm_coslat_cube = 0.0 - - - allocate ( idx(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for idx' - stop - end if - allocate ( idy(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for idy' - stop - end if - allocate ( idp(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for idp' - stop - end if - - WRITE(*,*) "bin lat-lon data on cubed-sphere" - - ! - ! for debugging ONLY - ! -! DO j=1,jm -! DO i=1,im -!! terr(i,j) = 10000.0*(2.0+cos(lat(j))*cos(lat(j))*cos(2.0*lon(i)))!Y22 -!! terr(i,j) = 10000.0*(2.0+(sin(2.0*lat(j))**16)*cos(16.0*lon(i))) !Y16_32 -! terr(i,j) = 10000.0*(2.0+cos(16.0*lon(i))) !Y16_32 -! END DO -! END DO - - DO j=1,jm - DO i=1,im -! WRITE(*,*) "bin to cube ",100.0*FLOAT(i+(j-1)*im)/FLOAT(im*jm),"% done" - call CubedSphereABPFromRLL(lon(i), lat(j), alpha, beta, ipanel) - icube = CEILING((alpha + piq) / da) - jcube = CEILING((beta + piq) / da) - IF (icube<1.OR.icube>ncube.OR.jcube<1.OR.jcube>ncube) THEN - WRITE(*,*) "fatal error in search algorithm" - WRITE(*,*) "icube or jcube out of range: ",icube,jcube - STOP - END IF - wt = SIN( lat(j)+0.5*dlat ) - SIN( lat(j)-0.5*dlat ) - weight(icube,jcube,ipanel) = weight(icube,jcube,ipanel)+wt - ! - terr_cube (icube,jcube,ipanel) = terr_cube (icube,jcube,ipanel)+wt*DBLE(terr(i,j)) - landfrac_cube(icube,jcube,ipanel) = landfrac_cube(icube,jcube,ipanel)+wt*DBLE(landfrac(i,j)) - ! - ! save "index-association" for variance computation - ! - idx(i,j) = icube - idy(i,j) = jcube - idp(i,j) = ipanel - END DO - END DO - - dx = deg2rad*(lon_landm(2)-lon_landm(1)) - ! - ! lat_landm is not exactly equally spaced so a search is needed in the loop below - ! - dy = deg2rad*(lat_landm(2)-lat_landm(1)) - DO k=1,6 - DO j=1,ncube - DO i=1,ncube - IF (ABS(weight(i,j,k))<1.0E-9) THEN - WRITE(*,*) "there is no lat-lon grid point in cubed sphere cell ",i,j,k - WRITE(*,*) "fatal error" - STOP - ELSE - terr_cube (i,j,k) = terr_cube (i,j,k)/weight(i,j,k) - landfrac_cube (i,j,k) = landfrac_cube (i,j,k)/weight(i,j,k) - END IF - ! - ! linearly interpolate landm_coslat - ! - alpha = -piq+(i-0.5)*da - beta = -piq+(j-0.5)*da - CALL CubedSphereRLLFromABP(alpha, beta, k, lambda, theta) - IF (theta>lat_landm(jm_landm)*deg2rad-tiny) THEN - landm_coslat_cube(i,j,k) = 0.0 - ELSE IF (theta1.0.OR.wy<0.0) - jp1 = ilat+1 - wy = (theta -lat_landm(ilat)*deg2rad)/((lat_landm(jp1)-lat_landm(ilat))*deg2rad) - IF (wy>1.0) THEN - ilat=ilat+1 - ELSE IF (wy<0.0) THEN - ilat=ilat-1 - END IF - END DO - - IF (wx>1.0+tiny.OR.wx<0.0-tiny) THEN - WRITE(*,*) "wx out of range",wx - stop - END IF - IF (wy>1.0+tiny.OR.wy<0.0-tiny) THEN - WRITE(*,*) "wy out of range",wy - stop - END IF - ! - ! "crude" bi-linear interpolation - ! - landm_coslat_cube(i,j,k) =& - (1.0-wx)*(1.0-wy)*landm_coslat(ilon,ilat)+ wx *(1-wy)*landm_coslat(ip1,ilat)+& - (1.0-wx)* wy *landm_coslat(ilon,jp1 )+ wx * wy *landm_coslat(ip1,jp1) - END IF - END DO - END DO - END DO - WRITE(*,*) "min/max value of terr_cube:", MINVAL(terr_cube), MAXVAL(terr_cube) - WRITE(*,*) "min/max value of landm_coslat_cube:", MINVAL(landm_coslat_cube), MAXVAL(landm_coslat_cube) - ! - ! compute volume of topography on cubed-sphere - ! - WRITE(*,*) "compute volume for cubed-sphere binned data" - allocate (darea_cube(ncube,ncube),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for idp' - stop - end if - CALL EquiangularAllAreas(ncube, darea_cube) - vol_cube = 0.0 - do ipanel=1,6 - do j=1,ncube - do i=1,ncube - vol_cube = vol_cube+terr_cube(i,j,ipanel)*darea_cube(i,j) - end do - end do - end do - vol_cube=vol_cube/(4.0*pi) - deallocate(darea_cube) - WRITE(*,*) "mean height (globally) of topography about sea-level (3km cube data)",vol_cube,(vol_cube-vol)/vol - !********************************************************* - ! - ! compute variance - ! - !********************************************************* - ! - allocate ( sgh30_cube(ncube,ncube,6),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for sgh30_cube' - stop - end if - sgh30_cube = 0.0 - DO j=1,jm - DO i=1,im - icube = idx(i,j) - jcube = idy(i,j) - ipanel = idp(i,j) - wt = SIN( lat(j)+0.5*dlat ) - SIN( lat(j)-0.5*dlat ) - sgh30_cube(icube,jcube,ipanel) = sgh30_cube(icube,jcube,ipanel) + & - (wt*(terr_cube(icube,jcube,ipanel)-terr(i,j))**2)/weight(icube,jcube,ipanel) - END DO - END DO - ! sgh30_cube=sgh30_cube/weight - WRITE(*,*) "min/max value of sgh30_cube:", MINVAL(sgh30_cube), MAXVAL(sgh30_cube) - ! - ! write data to NetCDF file - ! - CALL wrt_cube(ncube,terr_cube,landfrac_cube,landm_coslat_cube,sgh30_cube) - DEALLOCATE(weight,terr,landfrac,idx,idy,idp,lat,lon) - WRITE(*,*) "done writing cubed sphere data" -end program convterr - - -!************************************************************************ -!!handle_err -!************************************************************************ -! -!!ROUTINE: handle_err -!!DESCRIPTION: error handler -!-------------------------------------------------------------------------- - -subroutine handle_err(status) - - implicit none - -# include - - integer status - - if (status .ne. nf_noerr) then - print *, nf_strerror(status) - stop 'Stopped' - endif - -end subroutine handle_err - - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereABPFromRLL -! -! Description: -! Determine the (alpha,beta,panel) coordinate of a point on the sphere from -! a given regular lat lon coordinate. -! -! Parameters: -! lon - Coordinate longitude -! lat - Coordinate latitude -! alpha (OUT) - Alpha coordinate -! beta (OUT) - Beta coordinate -! ipanel (OUT) - Face panel -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereABPFromRLL(lon, lat, alpha, beta, ipanel) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - REAL (R8), INTENT(IN) :: lon, lat - REAL (R8), INTENT(OUT) :: alpha, beta - INTEGER, INTENT(OUT) :: ipanel - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: rotate_cube = 0.0 - - ! Local variables - REAL (R8) :: xx, yy, zz, pm - REAL (R8) :: sx, sy, sz - INTEGER :: ix, iy, iz - - ! Translate to (x,y,z) space - xx = COS(lon-rotate_cube) * COS(lat) - yy = SIN(lon-rotate_cube) * COS(lat) - zz = SIN(lat) - - pm = MAX(ABS(xx), ABS(yy), ABS(zz)) - - ! Check maximality of the x coordinate - IF (pm == ABS(xx)) THEN - IF (xx > 0) THEN; ix = 1; ELSE; ix = -1; ENDIF - ELSE - ix = 0 - ENDIF - - ! Check maximality of the y coordinate - IF (pm == ABS(yy)) THEN - IF (yy > 0) THEN; iy = 1; ELSE; iy = -1; ENDIF - ELSE - iy = 0 - ENDIF - - ! Check maximality of the z coordinate - IF (pm == ABS(zz)) THEN - IF (zz > 0) THEN; iz = 1; ELSE; iz = -1; ENDIF - ELSE - iz = 0 - ENDIF - - ! Panel assignments - IF (iz == 1) THEN - ipanel = 6; sx = yy; sy = -xx; sz = zz - - ELSEIF (iz == -1) THEN - ipanel = 5; sx = yy; sy = xx; sz = -zz - - ELSEIF ((ix == 1) .AND. (iy /= 1)) THEN - ipanel = 1; sx = yy; sy = zz; sz = xx - - ELSEIF ((ix == -1) .AND. (iy /= -1)) THEN - ipanel = 3; sx = -yy; sy = zz; sz = -xx - - ELSEIF ((iy == 1) .AND. (ix /= -1)) THEN - ipanel = 2; sx = -xx; sy = zz; sz = yy - - ELSEIF ((iy == -1) .AND. (ix /= 1)) THEN - ipanel = 4; sx = xx; sy = zz; sz = -yy - - ELSE - WRITE(*,*) 'Fatal Error: CubedSphereABPFromRLL failed' - WRITE(*,*) '(xx, yy, zz) = (', xx, ',', yy, ',', zz, ')' - WRITE(*,*) 'pm =', pm, ' (ix, iy, iz) = (', ix, ',', iy, ',', iz, ')' - STOP - ENDIF - - ! Use panel information to calculate (alpha, beta) coords - alpha = ATAN(sx / sz) - beta = ATAN(sy / sz) - -END SUBROUTINE CubedSphereABPFromRLL - - - -! -! write netCDF file -! -subroutine wrt_cube(ncube,terr_cube,landfrac_cube,landm_coslat_cube,sgh30_cube) - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none -# include - - ! - ! Dummy arguments - ! - integer, intent(in) :: ncube - real (r8), dimension(6*ncube*ncube), intent(in) :: terr_cube,landfrac_cube,sgh30_cube,landm_coslat_cube - ! - ! Local variables - ! - !----------------------------------------------------------------------- - ! - ! grid coordinates and masks - ! - !----------------------------------------------------------------------- - - real (r8), dimension(6*ncube*ncube) :: grid_center_lat ! lat/lon coordinates for - real (r8), dimension(6*ncube*ncube) :: grid_center_lon ! each grid center in degrees - - integer :: ncstat ! general netCDF status variable - integer :: nc_grid_id ! netCDF grid dataset id - integer :: nc_gridsize_id ! netCDF grid size dim id - integer :: nc_gridrank_id ! netCDF grid rank dim id - integer :: nc_griddims_id ! netCDF grid dimension size id - integer :: nc_grdcntrlat_id ! netCDF grid center lat id - integer :: nc_grdcntrlon_id ! netCDF grid center lon id - integer :: nc_terr_id - integer :: nc_landfrac_id - integer :: nc_landm_coslat_id - integer :: nc_var_id - - - integer, dimension(2) :: nc_dims2_id ! netCDF dim id array for 2-d arrays - integer :: grid_dims - - character(18), parameter :: grid_file_out = 'USGS-topo-cube.nc' - character(90), parameter :: grid_name = 'equi-angular gnomonic cubed sphere grid' - - character (len=32) :: fout ! NetCDF output file - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: status ! return value for error control of netcdf routin - integer :: i,j,k - character (len=8) :: datestring - - integer :: atm_add,n - real(r8) :: xgno_ce,lon,ygno_ce,lat - - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: rad2deg = 180.0/pi - - real(r8) :: da, a1,a2,a3,a4,dbg_area,max_size - real(r8), dimension(2,2) :: ang - real(r8) :: tmp_lon,min_lon,max_lon!,sum,lflag_value - logical :: lflag - - grid_dims = 6*ncube*ncube - - dbg_area = 0.0 - - da = pi / DBLE(2*ncube) - atm_add = 1 - do k=1,6 - do j=1,ncube - ygno_ce = -piq + da * (DBLE(j-1)+0.5) !center of cell - do i=1,ncube - xgno_ce = -piq + da * (DBLE(i-1)+0.5) - call CubedSphereRLLFromABP(xgno_ce, ygno_ce, k, lon, lat) - grid_center_lon(atm_add ) = lon*rad2deg - grid_center_lat(atm_add ) = lat*rad2deg - atm_add = atm_add+1 - end do - end do - end do - - WRITE(*,*) "Create NetCDF file for output" - ncstat = nf_create (grid_file_out, NF_64BIT_OFFSET,nc_grid_id) - call handle_err(ncstat) - - ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',len_trim(grid_name), grid_name) - call handle_err(ncstat) - - WRITE(*,*) "define grid size dimension" - ncstat = nf_def_dim (nc_grid_id, 'grid_size', 6*ncube*ncube, nc_gridsize_id) - call handle_err(ncstat) - - WRITE(*,*) "define grid rank dimension" - ncstat = nf_def_dim (nc_grid_id, 'grid_rank', 1, nc_gridrank_id) - call handle_err(ncstat) - - WRITE(*,*) "define grid dimension size array" - ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,1, nc_gridrank_id, nc_griddims_id) - call handle_err(ncstat) - - WRITE(*,*) "define grid center latitude array" - ncstat = nf_def_var (nc_grid_id, 'lat', NF_DOUBLE,1, nc_gridsize_id, nc_grdcntrlat_id) - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',13, 'degrees_north') - call handle_err(ncstat) - - WRITE(*,*) "define grid center longitude array" - ncstat = nf_def_var (nc_grid_id, 'lon', NF_DOUBLE,1, nc_gridsize_id, nc_grdcntrlon_id) - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',12, 'degrees_east') - call handle_err(ncstat) - - WRITE(*,*) "define terr_cube array" - ncstat = nf_def_var (nc_grid_id, 'terr', NF_DOUBLE,1, nc_gridsize_id, nc_terr_id) - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_terr_id, 'units',1, 'm') - call handle_err(ncstat) - - WRITE(*,*) "define landfrac_cube array" - ncstat = nf_def_var (nc_grid_id, 'LANDFRAC', NF_DOUBLE,1, nc_gridsize_id, nc_landfrac_id) - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_landfrac_id, 'long_name',70,& - 'land ocean transition mask: ocean (0), continent (1), transition (0-1)') - call handle_err(ncstat) - - WRITE(*,*) "define landm_coslat_cube array" - ncstat = nf_def_var (nc_grid_id, 'LANDM_COSLAT', NF_DOUBLE,1, nc_gridsize_id, nc_landm_coslat_id) - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_landm_coslat_id, 'long_name',35,'smoothed land ocean transition mask') - call handle_err(ncstat) - - WRITE(*,*) "define sgh30_cube array" - ncstat = nf_def_var (nc_grid_id, 'SGH30', NF_DOUBLE,1, nc_gridsize_id, nc_var_id) - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_var_id, 'units',12, 'm') - call handle_err(ncstat) - ncstat = nf_put_att_text (nc_grid_id, nc_var_id, 'long_name',58,& - 'variance of elevation from 30s lat-lon to 3km cubed-sphere') - - WRITE(*,*) "end definition stage" - ncstat = nf_enddef(nc_grid_id) - call handle_err(ncstat) - - !----------------------------------------------------------------------- - ! - ! write grid data - ! - !----------------------------------------------------------------------- - - - WRITE(*,*) "write grid data" - ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims) - call handle_err(ncstat) - - ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, grid_center_lat) - call handle_err(ncstat) - - ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, grid_center_lon) - call handle_err(ncstat) - - ncstat = nf_put_var_double(nc_grid_id, nc_terr_id, terr_cube) - call handle_err(ncstat) - - ncstat = nf_put_var_double(nc_grid_id, nc_landfrac_id, landfrac_cube) - call handle_err(ncstat) - - ncstat = nf_put_var_double(nc_grid_id, nc_landm_coslat_id, landm_coslat_cube) - call handle_err(ncstat) - - ncstat = nf_put_var_double(nc_grid_id, nc_var_id, sgh30_cube) - call handle_err(ncstat) - - WRITE(*,*) "Close output file" - ncstat = nf_close(nc_grid_id) - call handle_err(ncstat) -end subroutine wrt_cube - - -!------------------------------------------------------------------------------ -! SUBROUTINE EquiangularAllAreas -! -! Description: -! Compute the area of all cubed sphere grid cells, storing the results in -! a two dimensional array. -! -! Parameters: -! icube - Resolution of the cubed sphere -! dA (OUT) - Output array containing the area of all cubed sphere grid cells -!------------------------------------------------------------------------------ -SUBROUTINE EquiangularAllAreas(icube, dA) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - INTEGER, INTENT(IN) :: icube - REAL (r8), DIMENSION(icube,icube), INTENT(OUT) :: dA - - ! Local variables - INTEGER :: k, k1, k2 - REAL (r8) :: a1, a2, a3, a4 - REAL (r8), DIMENSION(icube+1,icube+1) :: ang - REAL (r8), DIMENSION(icube+1) :: gp - - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - - - !#ifdef DBG - REAL (r8) :: dbg1 !DBG - !#endif - - ! Recall that we are using equi-angular spherical gridding - ! Compute the angle between equiangular cubed sphere projection grid lines. - DO k = 1, icube+1 - gp(k) = -piq + (pi/DBLE(2*(icube))) * DBLE(k-1) - ENDDO - - DO k2=1,icube+1 - DO k1=1,icube+1 - ang(k1,k2) =ACOS(-SIN(gp(k1)) * SIN(gp(k2))) - ENDDO - ENDDO - - DO k2=1,icube - DO k1=1,icube - a1 = ang(k1 , k2 ) - a2 = pi - ang(k1+1, k2 ) - a3 = pi - ang(k1 , k2+1) - a4 = ang(k1+1, k2+1) - - ! area = r*r*(-2*pi+sum(interior angles)) - DA(k1,k2) = -2.0*pi+a1+a2+a3+a4 - ENDDO - ENDDO - - !#ifdef DBG - ! Only for debugging - test consistency - dbg1 = 0.0 !DBG - DO k2=1,icube - DO k1=1,icube - dbg1 = dbg1 + DA(k1,k2) !DBG - ENDDO - ENDDO - write(*,*) 'DAcube consistency: ',dbg1-4.0*pi/6.0 !DBG - !#endif -END SUBROUTINE EquiangularAllAreas - - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereRLLFromABP -! -! Description: -! Determine the lat lon coordinate of a point on a sphere given its -! (alpha,beta,panel) coordinate. -! -! Parameters: -! alpha - Alpha coordinate -! beta - Beta coordinate -! panel - Cubed sphere panel id -! lon (OUT) - Calculated longitude -! lat (OUT) - Calculated latitude -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereRLLFromABP(alpha, beta, ipanel, lon, lat) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - REAL (r8), INTENT(IN) :: alpha, beta - INTEGER , INTENT(IN) :: ipanel - REAL (r8), INTENT(OUT) :: lon, lat - ! Local variables - REAL (r8) :: xx, yy, zz, rotate_cube - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - - rotate_cube = 0.0 - ! Convert to cartesian coordinates - CALL CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) - ! Convert back to lat lon - lat = ASIN(zz) - if (xx==0.0.and.yy==0.0) THEN - lon = 0.0 - else - lon = ATAN2(yy, xx) +rotate_cube - IF (lon<0.0) lon=lon+2.0*pi - IF (lon>2.0*pi) lon=lon-2.0*pi - end if -END SUBROUTINE CubedSphereRLLFromABP - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereXYZFromABP -! -! Description: -! Determine the Cartesian coordinate of a point on a sphere given its -! (alpha,beta,panel) coordinate. -! -! Parameters: -! alpha - Alpha coordinate -! beta - Beta coordinate -! panel - Cubed sphere panel id -! xx (OUT) - Calculated x coordinate -! yy (OUT) - Calculated y coordinate -! zz (OUT) - Calculated z coordinate -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - REAL (r8), INTENT(IN) :: alpha, beta - INTEGER , INTENT(IN) :: ipanel - REAL (r8), INTENT(OUT) :: xx, yy, zz - ! Local variables - REAL (r8) :: a1, b1, pm - REAL (r8) :: sx, sy, sz - - ! Convert to Cartesian coordinates - a1 = TAN(alpha) - b1 = TAN(beta) - - sz = (1.0 + a1 * a1 + b1 * b1)**(-0.5) - sx = sz * a1 - sy = sz * b1 - ! Panel assignments - IF (ipanel == 6) THEN - yy = sx; xx = -sy; zz = sz - ELSEIF (ipanel == 5) THEN - yy = sx; xx = sy; zz = -sz - ELSEIF (ipanel == 1) THEN - yy = sx; zz = sy; xx = sz - ELSEIF (ipanel == 3) THEN - yy = -sx; zz = sy; xx = -sz - ELSEIF (ipanel == 2) THEN - xx = -sx; zz = sy; yy = sz - ELSEIF (ipanel == 4) THEN - xx = sx; zz = sy; yy = -sz - ELSE - WRITE(*,*) 'Fatal Error: Panel out of range in CubedSphereXYZFromABP' - WRITE(*,*) '(alpha, beta, panel) = (', alpha, ',', beta, ',', ipanel, ')' - STOP - ENDIF -END SUBROUTINE CubedSphereXYZFromABP - - diff --git a/tools/topo_tool/bin_to_cube/shr_kind_mod.F90 b/tools/topo_tool/bin_to_cube/shr_kind_mod.F90 deleted file mode 100644 index fc1ed8e94a..0000000000 --- a/tools/topo_tool/bin_to_cube/shr_kind_mod.F90 +++ /dev/null @@ -1,20 +0,0 @@ -!=============================================================================== -! CVS: $Id$ -! CVS: $Source$ -! CVS: $Name$ -!=============================================================================== - -MODULE shr_kind_mod - - !---------------------------------------------------------------------------- - ! precision/kind constants add data public - !---------------------------------------------------------------------------- - public - integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real - integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real - integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real - integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer - integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer - integer,parameter :: SHR_KIND_IN = kind(1) ! native integer - -END MODULE shr_kind_mod diff --git a/tools/topo_tool/cube_to_target/Makefile b/tools/topo_tool/cube_to_target/Makefile deleted file mode 100644 index 23d518cf03..0000000000 --- a/tools/topo_tool/cube_to_target/Makefile +++ /dev/null @@ -1,69 +0,0 @@ -EXEDIR = . -EXENAME = cube_to_target -RM = rm - -.SUFFIXES: -.SUFFIXES: .F90 .o - -FC = lf95 -DEBUG = FALSE - - -# Check for the NetCDF library and include directories -ifeq ($(LIB_NETCDF),$(null)) -LIB_NETCDF := /usr/local/lib -endif - -ifeq ($(INC_NETCDF),$(null)) -INC_NETCDF := /usr/local/include -endif - -# Determine platform -UNAMES := $(shell uname -s) -UNAMEM := $(findstring CRAY,$(shell uname -m)) - -#------------------------------------------------------------------------ -# LF95 -#------------------------------------------------------------------------ -# -# setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib -# -ifeq ($(FC),lf95) -# -# Tramhill -# - INC_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/include - LIB_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib - - LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -lnetcdff -lcurl -lhdf5 -lhdf5_hl -mcmodel=medium - FFLAGS := -c --trace --trap --wide -CcdRR8 -I$(INC_NETCDF) - ifeq ($(DEBUG),TRUE) -# FFLAGS += --chk aesu -Cpp --trace - FFLAGS += -g --chk a,e,s,u --pca - else - FFLAGS += -O - endif - -endif - - - -.F90.o: - $(FC) $(FFLAGS) $< - -#------------------------------------------------------------------------ -# Default rules and macros -#------------------------------------------------------------------------ - -OBJS := reconstruct.o remap.o cube_to_target.o shr_kind_mod.o - -$(EXEDIR)/$(EXENAME): $(OBJS) - $(FC) -o $@ $(OBJS) $(LDFLAGS) - -clean: - $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) - -cube_to_target.o: shr_kind_mod.o remap.o reconstruct.o -remap.o: -reconstruct.o: remap.o -#reconstruct.o : shr_kind_mod.o diff --git a/tools/topo_tool/cube_to_target/README b/tools/topo_tool/cube_to_target/README deleted file mode 100644 index 134b6de4f9..0000000000 --- a/tools/topo_tool/cube_to_target/README +++ /dev/null @@ -1,20 +0,0 @@ -cube_to_target performs rigourous remapping of topo variables from cubed-sphere grid to -any target grid. In the process SGH is computed. - -Input files: - -1. USGS-topo-cube.nc (may be found here $CESMDATA/inputdata/atm/cam/hrtopo/USGS-topo-cube3000.nc) - - This is the topo data on a cubed-sphere (default is 3km cubed-sphere grid) - -2. target.nc (e.g., $CESMDATA/inputdata/atm/cam/grid-description/se/ne30np4_091226_pentagons.nc) - - This is a SCRIP/ESMF grid descriptor file for the target grid - -3. phis-smooth.nc - - (optional) The user may provide a smoothed PHIS field. The software then recomputes SGH to - account for the smoothing in the sub-grid-scale. - - - diff --git a/tools/topo_tool/cube_to_target/cube_to_target.F90 b/tools/topo_tool/cube_to_target/cube_to_target.F90 deleted file mode 100644 index 3f73f6a47b..0000000000 --- a/tools/topo_tool/cube_to_target/cube_to_target.F90 +++ /dev/null @@ -1,2008 +0,0 @@ -! -! DATE CODED: Nov 7, 2011 to Oct 15, 2012 -! DESCRIPTION: Remap topo data from cubed-sphere grid to target grid using rigorous remapping -! (Lauritzen, Nair and Ullrich, 2010, J. Comput. Phys.) -! -! Author: Peter Hjort Lauritzen (pel@ucar.edu), AMP/CGD/NESL/NCAR -! -program convterr - use shr_kind_mod, only: r8 => shr_kind_r8 - use reconstruct - implicit none -# include - - !************************************** - ! - ! USER SETTINGS BELOW - ! - !************************************** - ! - ! - ! if smoothed PHIS is available SGH needs to be recomputed to account for the sub-grid-scale - ! variability introduced by the smoothing - ! - logical :: lsmooth_terr = .FALSE. - ! - ! PHIS is smoothed by other software/dynamical core - ! - logical :: lexternal_smooth_terr = .FALSE. ! lexternal_smooth_terr = .FALSE. is NOT supported currently - ! - ! set PHIS=0.0 if LANDFRAC<0.01 - ! - logical :: lzero_out_ocean_point_phis = .FALSE. - ! - ! For internal smoothing (experimental at this point) - ! =================================================== - ! - ! if smoothing is internal (lexternal_smooth_terr=.FALSE.) choose coarsening factor - ! - ! recommendation: 2*(target resolution)/(0.03 degree) - ! - ! factor must be an even integer - ! - integer, parameter :: factor = 60 !coarse grid = 2.25 degrees - integer, parameter :: norder = 2 - integer, parameter :: nmono = 0 - integer, parameter :: npd = 1 - ! - !********************************************************************** - ! - ! END OF USER SETTINS BELOW - ! (do not edit beyond this point unless you know what you are doing!) - ! - !********************************************************************** - ! - integer :: im, jm, ncoarse - integer :: ncube !dimension of cubed-sphere grid - - real(r8), allocatable, dimension(:) :: landm_coslat, landfrac, terr, sgh30 - real(r8), allocatable, dimension(:) :: terr_coarse !for internal smoothing - - integer :: alloc_error,dealloc_error - integer :: i,j,n,k,index - integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile - integer ncid,status, dimlatid,dimlonid, landid, topoid ! for netCDF USGS data file - integer :: srcid,dstid, jm_dbg ! for netCDF weight file - integer, dimension(2) :: src_grid_dims ! for netCDF weight file - - integer :: dimid - - logical :: ldbg - real(r8), allocatable, dimension(:) :: lon , lat - real(r8), allocatable, dimension(:) :: lon_landm , lat_landm - real(r8), allocatable, dimension(:) :: area - integer :: im_landm, jm_landm - integer :: lonid, latid, phisid - ! - ! constants - ! - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: pih = 0.50*pi - REAL (r8), PARAMETER :: deg2rad = pi/180.0 - - real(r8) :: wt,dlat - integer :: ipanel,icube,jcube - real(r8), allocatable, dimension(:,:,:) :: weight,terr_cube,landfrac_cube,sgh30_cube - real(r8), allocatable, dimension(:,:,:) :: landm_coslat_cube - integer, allocatable, dimension(:,:) :: idx,idy,idp - integer :: npatch, isub,jsub, itmp, iplm1,jmin,jmax - real(r8) :: sum,dx,scale,dmax,arad,jof,term,s1,c1,clon,iof,dy,s2,c2,dist - ! - ! for linear interpolation - ! - real(r8) :: lambda,theta,wx,wy,offset - integer :: ilon,ilat,ip1,jp1 - ! - ! variable for regridding - ! - integer :: src_grid_dim ! for netCDF weight file - integer :: n_a,n_b,n_s,n_aid,n_bid,n_sid - integer :: count - real(r8), allocatable, dimension(:) :: landfrac_target, terr_target, sgh30_target, sgh_target - real(r8), allocatable, dimension(:) :: landm_coslat_target, area_target - ! - ! this is only used if target grid is a lat-lon grid - ! - integer , parameter :: im_target = 360 , jm_target = 180 - ! - ! this is only used if target grid is not a lat-lon grid - ! - real(r8), allocatable, dimension(:) :: lon_target, lat_target - ! - ! new - ! - integer :: ntarget, ntarget_id, ncorner, ncorner_id, nrank, nrank_id - integer :: ntarget_smooth - real(r8), allocatable, dimension(:,:):: target_corner_lon, target_corner_lat - real(r8), allocatable, dimension(:) :: target_center_lon, target_center_lat, target_area - integer :: ii,ip,jx,jy,jp - real(r8), dimension(:), allocatable :: xcell, ycell, xgno, ygno - real(r8), dimension(:), allocatable :: gauss_weights,abscissae - integer, parameter :: ngauss = 3 - integer :: jmax_segments,jall - real(r8) :: tmp - - real(r8), allocatable, dimension(:,:) :: weights_all - integer , allocatable, dimension(:,:) :: weights_eul_index_all - integer , allocatable, dimension(:) :: weights_lgr_index_all - integer :: ix,iy - ! - ! volume of topography - ! - real(r8) :: vol_target, vol_target_un, area_target_total,vol_source,vol_tmp - integer :: nlon,nlon_smooth,nlat,nlat_smooth - logical :: ltarget_latlon,lpole - real(r8), allocatable, dimension(:,:) :: terr_smooth - ! - ! for internal filtering - ! - real(r8), allocatable, dimension(:,:) :: weights_all_coarse - integer , allocatable, dimension(:,:) :: weights_eul_index_all_coarse - integer , allocatable, dimension(:) :: weights_lgr_index_all_coarse - real(r8), allocatable, dimension(:) :: area_target_coarse - real(r8), allocatable, dimension(:,:) :: da_coarse,da - real(r8), allocatable, dimension(:,:) :: recons,centroids - integer :: nreconstruction - - integer :: jmax_segments_coarse,jall_coarse,ncube_coarse - real(r8) :: all_weights - - ! - ! turn extra debugging on/off - ! - ldbg = .FALSE. - - nreconstruction = 1 - ! - !********************************************************* - ! - ! read in target grid - ! - !********************************************************* - ! - status = nf_open('target.nc', 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - - status = NF_INQ_DIMID(ncid, 'grid_size', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, ntarget) - WRITE(*,*) "dimension of target grid: ntarget=",ntarget - - status = NF_INQ_DIMID(ncid, 'grid_corners', ncorner_id) - status = NF_INQ_DIMLEN(ncid, ncorner_id, ncorner) - WRITE(*,*) "maximum number of corners: ncorner=",ncorner - - status = NF_INQ_DIMID(ncid, 'grid_rank', nrank_id);status = NF_INQ_DIMLEN(ncid, nrank_id, nrank) - WRITE(*,*) "grid rank: nrank=",nrank - IF (nrank==2) THEN - WRITE(*,*) "target grid is a lat-lon grid" - ltarget_latlon = .TRUE. - status = NF_INQ_DIMID(ncid, 'nlon', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, nlon) - status = NF_INQ_DIMID(ncid, 'nlat', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, nlat) - status = NF_INQ_DIMID(ncid, 'lpole', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, lpole) - WRITE(*,*) "nlon=",nlon,"nlat=",nlat - IF (lpole) THEN - WRITE(*,*) "center of most Northern grid cell is lat=90; similarly for South pole" - ELSE - WRITE(*,*) "center of most Northern grid cell is NOT lat=90; similarly for South pole" - END IF - ELSE IF (nrank==1) THEN - ltarget_latlon = .FALSE. - ELSE - WRITE(*,*) "nrank out of range",nrank - STOP - ENDIF - - allocate ( target_corner_lon(ncorner,ntarget),stat=alloc_error) - allocate ( target_corner_lat(ncorner,ntarget),stat=alloc_error) - - status = NF_INQ_VARID(ncid, 'grid_corner_lon', lonid) - status = NF_GET_VAR_DOUBLE(ncid, lonid,target_corner_lon) - IF (maxval(target_corner_lon)>10.0) target_corner_lon = deg2rad*target_corner_lon - - status = NF_INQ_VARID(ncid, 'grid_corner_lat', latid) - status = NF_GET_VAR_DOUBLE(ncid, latid,target_corner_lat) - IF (maxval(target_corner_lat)>10.0) target_corner_lat = deg2rad*target_corner_lat - ! - ! for writing remapped data on file at the end of the program - ! - allocate ( target_center_lon(ntarget),stat=alloc_error) - allocate ( target_center_lat(ntarget),stat=alloc_error) - allocate ( target_area (ntarget),stat=alloc_error)!dbg - - status = NF_INQ_VARID(ncid, 'grid_center_lon', lonid) - status = NF_GET_VAR_DOUBLE(ncid, lonid,target_center_lon) - - status = NF_INQ_VARID(ncid, 'grid_center_lat', latid) - status = NF_GET_VAR_DOUBLE(ncid, latid,target_center_lat) - - status = NF_INQ_VARID(ncid, 'grid_area', latid) - status = NF_GET_VAR_DOUBLE(ncid, latid,target_area) - - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - !**************************************************** - ! - ! get dimension of cubed-sphere grid - ! - !**************************************************** - ! - WRITE(*,*) "get dimension of cubed-sphere data from file" - status = nf_open('USGS-topo-cube.nc', 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - - status = NF_INQ_DIMID(ncid, 'grid_size', dimid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimid, n) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - ncube = INT(SQRT(DBLE(n/6))) - WRITE(*,*) "cubed-sphere dimension: ncube = ",ncube - WRITE(*,*) "average grid-spacing at the Equator (degrees):" ,90.0/ncube - - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - !**************************************************** - ! - ! compute weights for remapping - ! - !**************************************************** - ! - jall = ncube*ncube*12*10 !anticipated number of weights (cab be tweaked) - jmax_segments = 100000 !can be tweaked - - allocate (weights_all(jall,nreconstruction),stat=alloc_error ) - allocate (weights_eul_index_all(jall,3),stat=alloc_error ) - allocate (weights_lgr_index_all(jall),stat=alloc_error ) - - CALL overlap_weights(weights_lgr_index_all,weights_eul_index_all,weights_all,& - jall,ncube,ngauss,ntarget,ncorner,jmax_segments,target_corner_lon,target_corner_lat,nreconstruction) - ! - !**************************************************** - ! - ! read cubed-sphere 3km data - ! - !**************************************************** - ! - WRITE(*,*) "read cubed-sphere 3km data from file" - status = nf_open('USGS-topo-cube.nc', 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - - status = NF_INQ_DIMID(ncid, 'grid_size', dimid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimid, n) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - ncube = INT(SQRT(DBLE(n/6))) - WRITE(*,*) "cubed-sphere dimension, ncube: ",ncube - - allocate ( landm_coslat(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - status = NF_INQ_VARID(ncid, 'LANDM_COSLAT', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,landm_coslat) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of landm_coslat",MINVAL(landm_coslat),MAXVAL(landm_coslat) - ! - ! read LANDFRAC - ! - allocate ( landfrac(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - status = NF_INQ_VARID(ncid, 'LANDFRAC', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,landfrac) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of landfrac",MINVAL(landfrac),MAXVAL(landfrac) - ! - ! read terr - ! - allocate ( terr(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - status = NF_INQ_VARID(ncid, 'terr', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,terr) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of terr",MINVAL(terr),MAXVAL(terr) - ! - ! - ! - allocate ( sgh30(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - status = NF_INQ_VARID(ncid, 'SGH30', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,sgh30) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of sgh30",MINVAL(sgh30),MAXVAL(sgh30) - print *,"close file" - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err(status) - - WRITE(*,*) 'done reading in LANDM_COSLAT data from netCDF file' - ! - !********************************************************* - ! - ! do actual remapping - ! - !********************************************************* - ! - allocate (terr_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr_target' - stop - end if - allocate (landfrac_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac_target' - stop - end if - allocate (landm_coslat_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac_target' - stop - end if - allocate (sgh30_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for sgh30_target' - stop - end if - allocate (area_target(ntarget),stat=alloc_error ) - terr_target = 0.0 - landfrac_target = 0.0 - sgh30_target = 0.0 - landm_coslat_target = 0.0 - area_target = 0.0 - - tmp = 0.0 - do count=1,jall - i = weights_lgr_index_all(count) - wt = weights_all(count,1) - area_target (i) = area_target(i) + wt - end do - - do count=1,jall - i = weights_lgr_index_all(count) - - ix = weights_eul_index_all(count,1) - iy = weights_eul_index_all(count,2) - ip = weights_eul_index_all(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix - - wt = weights_all(count,1) - - terr_target (i) = terr_target (i) + wt*terr (ii)/area_target(i) - landfrac_target (i) = landfrac_target (i) + wt*landfrac (ii)/area_target(i) - landm_coslat_target(i) = landm_coslat_target(i) + wt*landm_coslat(ii)/area_target(i) - sgh30_target (i) = sgh30_target (i) + wt*sgh30 (ii)/area_target(i) - - tmp = tmp+wt*terr(ii) - end do - - - write(*,*) "tmp", tmp - WRITE(*,*) "max difference between target grid area and remapping software area",& - MAXVAL(target_area-area_target) - - do count=1,ntarget - if (terr_target(count)>8848.0) then - ! - ! max height is higher than Mount Everest - ! - write(*,*) "FATAL error: max height is higher than Mount Everest!" - write(*,*) "terr_target",count,terr_target(count) - write(*,*) "(lon,lat) locations of vertices of cell with excessive max height::" - do i=1,ncorner - write(*,*) target_corner_lon(i,count),target_corner_lat(i,count) - end do - STOP - else if (terr_target(count)<-423.0) then - ! - ! min height is lower than Dead Sea - ! - write(*,*) "FATAL error: min height is lower than Dead Sea!" - write(*,*) "terr_target",count,terr_target(count) - write(*,*) "(lon,lat) locations of vertices of cell with excessive min height::" - do i=1,ncorner - write(*,*) target_corner_lon(i,count),target_corner_lat(i,count) - end do - STOP - else - - end if - end do - WRITE(*,*) "Elevation data passed min/max consistency check!" - WRITE(*,*) - - WRITE(*,*) "min/max of unsmoothed terr_target : ",MINVAL(terr_target ),MAXVAL(terr_target ) - WRITE(*,*) "min/max of landfrac_target : ",MINVAL(landfrac_target),MAXVAL(landfrac_target) - WRITE(*,*) "min/max of landm_coslat_target : ",& - MINVAL(landm_coslat_target),MAXVAL(landm_coslat_target) - WRITE(*,*) "min/max of var30_target : ",MINVAL(sgh30_target ),MAXVAL(sgh30_target ) - ! - ! compute mean height (globally) of topography about sea-level for target grid unfiltered elevation - ! - vol_target_un = 0.0 - area_target_total = 0.0 - DO i=1,ntarget - area_target_total = area_target_total+area_target(i) - vol_target_un = vol_target_un+terr_target(i)*area_target(i) - END DO - WRITE(*,*) "mean height (globally) of topography about sea-level for target grid unfiltered elevation",& - vol_target_un/area_target_total - - ! - ! diagnostics - ! - vol_source = 0.0 - allocate ( dA(ncube,ncube),stat=alloc_error ) - CALL EquiangularAllAreas(ncube, dA) - DO jp=1,6 - DO jy=1,ncube - DO jx=1,ncube - ii = (jp-1)*ncube*ncube+(jy-1)*ncube+jx - vol_source = vol_source+terr(ii)*dA(jx,jy) - END DO - END DO - END DO - WRITE(*,*) "volume of input cubed-sphere terrain :",vol_source - WRITE(*,*) "average elevation of input cubed-sphere terrain:",vol_source/(4.0*pi) - - DEALLOCATE(dA) - ! - ! - ! - allocate (sgh_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for sgh_target' - stop - end if - ! - ! compute variance with respect to cubed-sphere data - ! - WRITE(*,*) "compute variance with respect to 3km cubed-sphere data: SGH" - - IF (lsmooth_terr) THEN - WRITE(*,*) "smoothing PHIS" - IF (lexternal_smooth_terr) THEN - WRITE(*,*) "using externally generated smoothed topography" - - status = nf_open('phis-smooth.nc', 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - ! - IF (.NOT.ltarget_latlon) THEN - ! - !********************************************************* - ! - ! read in smoothed topography - ! - !********************************************************* - ! - status = NF_INQ_DIMID (ncid, 'ncol', ntarget_id ) - status = NF_INQ_DIMLEN(ncid, ntarget_id , ntarget_smooth) - IF (ntarget.NE.ntarget_smooth) THEN - WRITE(*,*) "mismatch in smoothed data-set and target grid specification" - WRITE(*,*) ntarget, ntarget_smooth - STOP - END IF - status = NF_INQ_VARID(ncid, 'PHIS', phisid) - ! - ! overwrite terr_target with smoothed version - ! - status = NF_GET_VAR_DOUBLE(ncid, phisid,terr_target) - terr_target = terr_target/9.80616 - ELSE - ! - ! read in smoothed lat-lon topography - ! - status = NF_INQ_DIMID(ncid, 'lon', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, nlon_smooth) - status = NF_INQ_DIMID(ncid, 'lat', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, nlat_smooth) - IF (nlon.NE.nlon_smooth.OR.nlat.NE.nlat_smooth) THEN - WRITE(*,*) "smoothed topography dimensions do not match target grid dimensions" - WRITE(*,*) "target grid : nlon ,nlat =",nlon,nlat - WRITE(*,*) "smoothed topo: nlon_smooth,nlat_smooth =",nlon_smooth,nlat_smooth - STOP - END IF - ALLOCATE(terr_smooth(nlon_smooth,nlat_smooth),stat=alloc_error) - status = NF_INQ_VARID(ncid, 'PHIS', phisid) - status = NF_GET_VAR_DOUBLE(ncid, phisid,terr_smooth) - ! - ! overwrite terr_target with smoothed version - ! - ii=1 - DO j=1,nlat - DO i=1,nlon - terr_target(ii) = terr_smooth(i,j)/9.80616 - ii=ii+1 - END DO - END DO - DEALLOCATE(terr_smooth) - END IF - ELSE - WRITE(*,*) "unstested software - uncomment this line of you know what you are doing!" - STOP - ! - !***************************************************** - ! - ! smoothing topography internally - ! - !***************************************************** - ! - WRITE(*,*) "internally smoothing orography" - ! CALL smooth(terr_target,ntarget,target_corner_lon,target_corner_lat) - ! - ! smooth topography internally - ! - ncoarse = n/(factor*factor) - ! - ! - ! - ncube_coarse = ncube/factor - WRITE(*,*) "resolution of coarse grid", 90.0/ncube_coarse - allocate ( terr_coarse(ncoarse),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - WRITE(*,*) "coarsening" - allocate ( dA_coarse(ncube_coarse,ncube_coarse),stat=alloc_error ) - CALL coarsen(terr,terr_coarse,factor,n,dA_coarse) - ! - ! - ! - vol_tmp = 0.0 - DO jp=1,6 - DO jy=1,ncube_coarse - DO jx=1,ncube_coarse - ii = (jp-1)*ncube_coarse*ncube_coarse+(jy-1)*ncube_coarse+jx - vol_tmp = vol_tmp+terr_coarse(ii)*dA_coarse(jx,jy) - END DO - END DO - END DO - WRITE(*,*) "volume of coarsened cubed-sphere terrain :",vol_source - WRITE(*,*) "difference between coarsened cubed-sphere data and input cubed-sphere data",& - vol_tmp-vol_source - - - - WRITE(*,*) "done coarsening" - - nreconstruction = 1 - IF (norder>1) THEN - IF (norder == 2) THEN - nreconstruction = 3 - ELSEIF (norder == 3) THEN - nreconstruction = 6 - END IF - ALLOCATE(recons (nreconstruction, ncoarse), STAT=status) - ALLOCATE(centroids(nreconstruction, ncoarse), STAT=status) - CALL get_reconstruction(terr_coarse,norder, nmono, recons, npd,da_coarse,& - ncube_coarse+1,nreconstruction,centroids) - SELECT CASE (nmono) - CASE (0) - WRITE(*,*) "coarse grid reconstructions are not filtered with shape-preesrving filter" - CASE (1) - WRITE(*,*) "coarse grid reconstructions are filtered with shape-preserving filter" - CASE DEFAULT - WRITE(*,*) "nmono out of range: ",nmono - STOP - END SELECT - SELECT CASE (0) - CASE (0) - WRITE(*,*) "coarse grid reconstructions are not filtered with positive definite filter" - CASE (1) - WRITE(*,*) "coarse grid reconstructions filtered with positive definite filter" - CASE DEFAULT - WRITE(*,*) "npd out of range: ",npd - STOP - END SELECT - END IF - - jall_coarse = (ncube*ncube*12) !anticipated number of weights - jmax_segments_coarse = jmax_segments!/factor ! - WRITE(*,*) "anticipated",jall_coarse - allocate (weights_all_coarse(jall_coarse,nreconstruction),stat=alloc_error ) - allocate (weights_eul_index_all_coarse(jall_coarse,3),stat=alloc_error ) - allocate (weights_lgr_index_all_coarse(jall_coarse),stat=alloc_error ) - ! - ! - ! - CALL overlap_weights(weights_lgr_index_all_coarse,weights_eul_index_all_coarse,weights_all_coarse,& - jall_coarse,ncube_coarse,ngauss,ntarget,ncorner,jmax_segments_coarse,target_corner_lon,& - target_corner_lat,nreconstruction) - WRITE(*,*) "MIN/MAX of area-weight [0:1]: ",& - MINVAL(weights_all_coarse(:,1)),MAXVAL(weights_all_coarse(:,1)) - ! - ! compute new weights - ! - - ! - ! do mapping - ! - terr_target = 0.0 - tmp = 0.0 - allocate ( area_target_coarse(ntarget),stat=alloc_error) - all_weights = 0.0 - area_target_coarse = 0.0 - do count=1,jall_coarse - i = weights_lgr_index_all_coarse(count) - wt = weights_all_coarse(count,1) - area_target_coarse (i) = area_target_coarse(i) + wt - all_weights = all_weights+wt - end do - WRITE(*,*) "sum of all weights (coarse to target) minus area of sphere : ",all_weights-4.0*pi - WRITE(*,*) "MIN/MAX of area_target_coarse [0:1]:",& - MINVAL(area_target_coarse),MAXVAL(area_target_coarse) - IF (norder==1) THEN - do count=1,jall_coarse - i = weights_lgr_index_all_coarse(count) - - ix = weights_eul_index_all_coarse(count,1) - iy = weights_eul_index_all_coarse(count,2) - ip = weights_eul_index_all_coarse(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix - - wt = weights_all_coarse(count,1) - - terr_target(i) = terr_target(i) + wt*terr_coarse(ii)/area_target_coarse(i) - tmp = tmp+wt*terr_coarse(ii) - end do - ELSE IF (norder==2) THEN - do count=1,jall_coarse - i = weights_lgr_index_all_coarse(count) - IF (i>jall_coarse.OR.i<1) THEN - WRITE(*,*) i,jall_coarse - STOP - END IF - ix = weights_eul_index_all_coarse(count,1) - iy = weights_eul_index_all_coarse(count,2) - ip = weights_eul_index_all_coarse(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix - - terr_target(i) = terr_target(i) + (weights_all_coarse(count,1)*(& - ! - ! all constant terms - ! - terr_coarse(ii) & - - recons(1,ii)*centroids(1,ii) & - - recons(2,ii)*centroids(2,ii) & - ! - ! + recons(3,ii)*(2.0*centroids(1,ii)**2-centroids(3,ii))& - ! + recons(4,ii)*(2.0*centroids(2,ii)**2-centroids(4,ii))& - ! - ! + recons(5,ii)*(2.0*centroids(1,ii)*centroids(2,ii)-centroids(5,ii))& - )+& - ! - ! linear terms - ! - weights_all_coarse(count,2)*(& - - recons(1,ii)& - - ! - recons(3,ii)*2.0*centroids(1,ii)& - ! - recons(5,ii)* centroids(2,ii)& - )+& - ! - weights_all_coarse(count,3)*(& - recons(2,ii)& - ! - ! - recons(4,ii)*2.0*centroids(2,ii)& - ! - recons(5,ii)* centroids(1,ii)& - )& - ! - ! quadratic terms - ! - ! weights_all_coarse(count,4)*recons(3,ii)+& - ! weights_all_coarse(count,5)*recons(4,ii)+& - ! weights_all_coarse(count,6)*recons(5,ii) - )/area_target_coarse(i) - end do - DEALLOCATE(centroids) - DEALLOCATE(recons) - DEALLOCATE(weights_all_coarse) - - ELSE IF (norder==3) THEN - ! recons(4,:) = 0.0 - ! recons(5,:) = 0.0 - do count=1,jall_coarse - i = weights_lgr_index_all_coarse(count) - IF (i>jall_coarse.OR.i<1) THEN - WRITE(*,*) i,jall_coarse - STOP - END IF - ix = weights_eul_index_all_coarse(count,1) - iy = weights_eul_index_all_coarse(count,2) - ip = weights_eul_index_all_coarse(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix - - ! terr_target(i) = terr_target(i) + wt*terr_coarse(ii)/area_target_coarse(i) - - ! WRITE(*,*) count,area_target_coarse(i) - ! terr_target(i) = terr_target(i) + area_target_coarse(i) - ! - terr_target(i) = terr_target(i) + (weights_all_coarse(count,1)*(& - - - ! centroids(5,ii))/area_target_coarse(i)) - ! centroids(1,ii)/area_target_coarse(i)) - ! /area_target_coarse(i)) - - - - - ! - ! all constant terms - ! - terr_coarse(ii) & - - recons(1,ii)*centroids(1,ii) & - - recons(2,ii)*centroids(2,ii) & - ! - + recons(3,ii)*(2.0*centroids(1,ii)**2-centroids(3,ii))& - + recons(4,ii)*(2.0*centroids(2,ii)**2-centroids(4,ii))& - ! - + recons(5,ii)*(2.0*centroids(1,ii)*centroids(2,ii)-centroids(5,ii))& - )+& - ! - ! linear terms - ! - weights_all_coarse(count,2)*(& - - recons(1,ii)& - - - recons(3,ii)*2.0*centroids(1,ii)& - - recons(5,ii)* centroids(2,ii)& - )+& - ! - weights_all_coarse(count,3)*(& - recons(2,ii)& - ! - - recons(4,ii)*2.0*centroids(2,ii)& - - recons(5,ii)* centroids(1,ii)& - )+& - ! - ! quadratic terms - ! - weights_all_coarse(count,4)*recons(3,ii)+& - weights_all_coarse(count,5)*recons(4,ii)+& - weights_all_coarse(count,6)*recons(5,ii))/area_target_coarse(i) - end do - DEALLOCATE(centroids) - DEALLOCATE(recons) - DEALLOCATE(weights_all_coarse) - END IF - DEALLOCATE(area_target_coarse) - WRITE(*,*) "done smoothing" - END IF - ! - ! compute mean height (globally) of topography about sea-level for target grid filtered elevation - ! - vol_target = 0.0 - DO i=1,ntarget - vol_target = vol_target+terr_target(i)*area_target(i) - ! if (ABS(area_target(i)-area_target_coarse(i))>0.000001) THEN - ! WRITE(*,*) "xxx",area_target(i),area_target_coarse(i),area_target(i)-area_target_coarse(i) - ! STOP - ! END IF - END DO - WRITE(*,*) "mean height (globally) of topography about sea-level for target grid filtered elevation",& - vol_target/area_target_total - WRITE(*,*) "percentage change in mean height between filtered and unfiltered elevations",& - 100.0*(vol_target-vol_target_un)/vol_target_un - WRITE(*,*) "percentage change in mean height between input cubed-sphere and unfiltered elevations",& - 100.0*(vol_source-vol_target_un)/vol_source - - END IF - ! - ! Done internal smoothing - ! - WRITE(*,*) "min/max of terr_target : ",MINVAL(terr_target),MAXVAL(terr_target) - - if (lzero_out_ocean_point_phis) then - WRITE(*,*) "if ocean mask PHIS=0.0" - end if - - - sgh_target=0.0 - do count=1,jall - i = weights_lgr_index_all(count)!! - ! - ix = weights_eul_index_all(count,1) - iy = weights_eul_index_all(count,2) - ip = weights_eul_index_all(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! - - wt = weights_all(count,1) - - if (lzero_out_ocean_point_phis.AND.landfrac_target(i).lt.0.01_r8) then - terr_target(i) = 0.0_r8 !5*terr_target(i) - end if - sgh_target(i) = sgh_target(i)+wt*((terr_target(i)-terr(ii))**2)/area_target(i) - end do - - - - ! - ! zero out small values - ! - DO i=1,ntarget - IF (landfrac_target(i)<.001_r8) landfrac_target(i) = 0.0 - IF (sgh_target(i)<0.5) sgh_target(i) = 0.0 - IF (sgh30_target(i)<0.5) sgh30_target(i) = 0.0 - END DO - sgh_target = SQRT(sgh_target) - sgh30_target = SQRT(sgh30_target) - WRITE(*,*) "min/max of sgh_target : ",MINVAL(sgh_target),MAXVAL(sgh_target) - WRITE(*,*) "min/max of sgh30_target : ",MINVAL(sgh30_target),MAXVAL(sgh30_target) - - DEALLOCATE(terr,weights_all,weights_eul_index_all,landfrac,landm_coslat) - - - IF (ltarget_latlon) THEN - CALL wrtncdf_rll(nlon,nlat,lpole,ntarget,terr_target,landfrac_target,sgh_target,sgh30_target,& - landm_coslat_target,target_center_lon,target_center_lat,.true.) - ELSE - CALL wrtncdf_unstructured(ntarget,terr_target,landfrac_target,sgh_target,sgh30_target,& - landm_coslat_target,target_center_lon,target_center_lat) - END IF - DEALLOCATE(terr_target,landfrac_target,sgh30_target,sgh_target,landm_coslat_target) - -end program convterr - -! -! -! -subroutine wrtncdf_unstructured(n,terr,landfrac,sgh,sgh30,landm_coslat,lon,lat) - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - -# include - - ! - ! Dummy arguments - ! - integer, intent(in) :: n - real(r8),dimension(n) , intent(in) :: terr, landfrac,sgh,sgh30,lon, lat, landm_coslat - ! - ! Local variables - ! - character (len=64) :: fout ! NetCDF output file - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: terrid,nid - integer :: terrdim,landfracid,sghid,sgh30id,landm_coslatid - integer :: status ! return value for error control of netcdf routin - integer :: i,j - integer, dimension(2) :: nc_lat_vid,nc_lon_vid - character (len=8) :: datestring - integer :: nc_gridcorn_id, lat_vid, lon_vid - - real(r8), parameter :: fillvalue = 1.d36 - - fout='new-topo-file.nc' - ! - ! Create NetCDF file for output - ! - print *,"Create NetCDF file for output" - status = nf_create (fout, NF_64BIT_OFFSET , foutid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Create dimensions for output - ! - status = nf_def_dim (foutid, 'ncol', n, nid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Create variable for output - ! - print *,"Create variable for output" - status = nf_def_var (foutid,'PHIS', NF_DOUBLE, 1, nid, terrid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'LANDFRAC', NF_DOUBLE, 1, nid, landfracid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'SGH', NF_DOUBLE, 1, nid, sghid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'SGH30', NF_DOUBLE, 1, nid, sgh30id) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'LANDM_COSLAT', NF_DOUBLE, 1, nid, landm_coslatid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, nid, latvid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, nid, lonvid) - if (status .ne. NF_NOERR) call handle_err(status) - - ! - ! Create attributes for output variables - ! - status = nf_put_att_text (foutid,terrid,'long_name', 21, 'surface geopotential') - status = nf_put_att_text (foutid,terrid,'units', 5, 'm2/s2') - status = nf_put_att_double (foutid, terrid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, terrid, '_FillValue' , nf_double, 1, fillvalue) - ! status = nf_put_att_text (foutid,terrid,'filter', 35, 'area averaged from USGS 30-sec data') - - status = nf_put_att_double (foutid, sghid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, sghid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, sghid, 'long_name' , 48, & - 'standard deviation of 3km cubed-sphere elevation and target grid elevation') - status = nf_put_att_text (foutid, sghid, 'units' , 1, 'm') - ! status = nf_put_att_text (foutid, sghid, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, sgh30id, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, sgh30id, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, sgh30id, 'long_name' , 49, & - 'standard deviation of 30s elevation from 3km cubed-sphere cell average height') - status = nf_put_att_text (foutid, sgh30id, 'units' , 1, 'm') - ! status = nf_put_att_text (foutid, sgh30id, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, landm_coslatid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, landm_coslatid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, landm_coslatid, 'long_name' , 23, 'smoothed land fraction') - status = nf_put_att_text (foutid, landm_coslatid, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, landfracid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, landfracid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, landfracid, 'long_name', 21, 'gridbox land fraction') - ! status = nf_put_att_text (foutid, landfracid, 'filter', 40, 'area averaged from 30-sec USGS raw data') - - - status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') - if (status .ne. NF_NOERR) call handle_err(status) - ! status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') - ! if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') - if (status .ne. NF_NOERR) call handle_err(status) - ! status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') - ! if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,NF_GLOBAL,'source', 50, 'USGS 30-sec dataset binned to ncube3000 (cube-sphere) grid') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') - if (status .ne. NF_NOERR) call handle_err(status) - call DATE_AND_TIME(DATE=datestring) - status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) - if (status .ne. NF_NOERR) call handle_err(status) - - ! - ! End define mode for output file - ! - status = nf_enddef (foutid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Write variable for output - ! - print*,"writing terrain data",MINVAL(terr),MAXVAL(terr) - status = nf_put_var_double (foutid, terrid, terr*9.80616) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing terrain data" - - print*,"writing landfrac data",MINVAL(landfrac),MAXVAL(landfrac) - status = nf_put_var_double (foutid, landfracid, landfrac) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing landfrac data" - - print*,"writing sgh data",MINVAL(sgh),MAXVAL(sgh) - status = nf_put_var_double (foutid, sghid, sgh) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh data" - - print*,"writing sgh30 data",MINVAL(sgh30),MAXVAL(sgh30) - status = nf_put_var_double (foutid, sgh30id, sgh30) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh30 data" - - print*,"writing landm_coslat data",MINVAL(landm_coslat),MAXVAL(landm_coslat) - status = nf_put_var_double (foutid, landm_coslatid, landm_coslat) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh30 data" - ! - print*,"writing lat data" - status = nf_put_var_double (foutid, latvid, lat) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lat data" - - print*,"writing lon data" - status = nf_put_var_double (foutid, lonvid, lon) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lon data" - ! - ! Close output file - ! - print *,"close file" - status = nf_close (foutid) - if (status .ne. NF_NOERR) call handle_err(status) -end subroutine wrtncdf_unstructured -! -!************************************************************** -! -! if target grid is lat-lon output structured -! -!************************************************************** -! -subroutine wrtncdf_rll(nlon,nlat,lpole,n,terr_in,landfrac_in,sgh_in,sgh30_in,landm_coslat_in,lon,lat,lprepare_fv_smoothing_routine) - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - -# include - - ! - ! Dummy arguments - ! - integer, intent(in) :: n,nlon,nlat - ! - ! lprepare_fv_smoothing_routine is to make a NetCDF file that can be used with the CAM-FV smoothing software - ! - logical , intent(in) :: lpole,lprepare_fv_smoothing_routine - real(r8),dimension(n) , intent(in) :: terr_in, landfrac_in,sgh_in,sgh30_in,lon, lat, landm_coslat_in - ! - ! Local variables - ! - character (len=32) :: fout ! NetCDF output file - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: terrid,nid - integer :: terrdim,landfracid,sghid,sgh30id,landm_coslatid - integer :: status ! return value for error control of netcdf routin - integer :: i,j - integer, dimension(2) :: nc_lat_vid,nc_lon_vid - character (len=8) :: datestring - integer :: nc_gridcorn_id, lat_vid, lon_vid - real(r8), parameter :: fillvalue = 1.d36 - real(r8) :: ave - - real(r8),dimension(nlon) :: lonar ! longitude array - real(r8),dimension(nlat) :: latar ! latitude array - - integer, dimension(2) :: htopodim,landfdim,sghdim,sgh30dim,landmcoslatdim - real(r8),dimension(n) :: terr, landfrac,sgh,sgh30,landm_coslat - - IF (nlon*nlat.NE.n) THEN - WRITE(*,*) "inconsistent input for wrtncdf_rll" - STOP - END IF - ! - ! we assume that the unstructured layout of the lat-lon grid is ordered in latitude rows, that is, - ! unstructured index n is given by - ! - ! n = (j-1)*nlon+i - ! - ! where j is latitude index and i longitude index - ! - do i = 1,nlon - lonar(i)= lon(i) - enddo - do j = 1,nlat - latar(j)= lat((j-1)*nlon+1) - enddo - - terr = terr_in - sgh=sgh_in - sgh30 =sgh30_in - landfrac = landfrac_in - landm_coslat = landm_coslat_in - - if (lpole) then - write(*,*) "average pole control volume" - ! - ! North pole - terr - ! - ave = 0.0 - do i=1,nlon - ave = ave + terr_in(i) - end do - terr(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + terr_in(i) - end do - terr(n-(nlon+1):n) = ave/DBLE(nlon) - - ! - ! North pole - sgh - ! - ave = 0.0 - do i=1,nlon - ave = ave + sgh_in(i) - end do - sgh(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + sgh_in(i) - end do - sgh(n-(nlon+1):n) = ave/DBLE(nlon) - - ! - ! North pole - sgh30 - ! - ave = 0.0 - do i=1,nlon - ave = ave + sgh30_in(i) - end do - sgh30(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + sgh30_in(i) - end do - sgh30(n-(nlon+1):n) = ave/DBLE(nlon) - - ! - ! North pole - landfrac - ! - ave = 0.0 - do i=1,nlon - ave = ave + landfrac_in(i) - end do - landfrac(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + landfrac_in(i) - end do - landfrac(n-(nlon+1):n) = ave/DBLE(nlon) - - ! - ! North pole - landm_coslat - ! - ave = 0.0 - do i=1,nlon - ave = ave + landm_coslat_in(i) - end do - landm_coslat(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + landm_coslat_in(i) - end do - landm_coslat(n-(nlon+1):n) = ave/DBLE(nlon) - end if - - - fout='final.nc' - ! - ! Create NetCDF file for output - ! - print *,"Create NetCDF file for output" - status = nf_create (fout, NF_64BIT_OFFSET , foutid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Create dimensions for output - ! - print *,"Create dimensions for output" - status = nf_def_dim (foutid, 'lon', nlon, lonid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'lat', nlat, latid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Create variable for output - ! - print *,"Create variable for output" - - htopodim(1)=lonid - htopodim(2)=latid - - if (lprepare_fv_smoothing_routine) then - status = nf_def_var (foutid,'htopo', NF_DOUBLE, 2, htopodim, terrid) - else - status = nf_def_var (foutid,'PHIS', NF_DOUBLE, 2, htopodim, terrid) - end if - if (status .ne. NF_NOERR) call handle_err(status) - - landfdim(1)=lonid - landfdim(2)=latid - - if (lprepare_fv_smoothing_routine) then - status = nf_def_var (foutid,'ftopo', NF_DOUBLE, 2, landfdim, landfracid) - else - status = nf_def_var (foutid,'LANDFRAC', NF_DOUBLE, 2, landfdim, landfracid) - end if - - if (status .ne. NF_NOERR) call handle_err(status) - - sghdim(1)=lonid - sghdim(2)=latid - - status = nf_def_var (foutid,'SGH', NF_DOUBLE, 2, sghdim, sghid) - if (status .ne. NF_NOERR) call handle_err(status) - - sgh30dim(1)=lonid - sgh30dim(2)=latid - - status = nf_def_var (foutid,'SGH30', NF_DOUBLE, 2, sgh30dim, sgh30id) - if (status .ne. NF_NOERR) call handle_err(status) - - landmcoslatdim(1)=lonid - landmcoslatdim(2)=latid - - status = nf_def_var (foutid,'LANDM_COSLAT', NF_DOUBLE, 2, landmcoslatdim, landm_coslatid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) - if (status .ne. NF_NOERR) call handle_err(status) - - ! - ! Create attributes for output variables - ! - status = nf_put_att_text (foutid,terrid,'long_name', 21, 'surface geopotential') - status = nf_put_att_text (foutid,terrid,'units', 5, 'm2/s2') - status = nf_put_att_text (foutid,terrid,'filter', 35, 'area averaged from ncube3000 data') - status = nf_put_att_double (foutid, terrid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, terrid, '_FillValue' , nf_double, 1, fillvalue) - - - status = nf_put_att_double (foutid, sghid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, sghid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, sghid, 'long_name' , 48, & - 'standard deviation of 3km cubed-sphere elevation and target grid elevation') - status = nf_put_att_text (foutid, sghid, 'units' , 1, 'm') - status = nf_put_att_text (foutid, sghid, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, sgh30id, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, sgh30id, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, sgh30id, 'long_name' , 49, & - 'standard deviation of 30s elevation from 3km cubed-sphere cell average height') - status = nf_put_att_text (foutid, sgh30id, 'units' , 1, 'm') - status = nf_put_att_text (foutid, sgh30id, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, landm_coslatid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, landm_coslatid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, landm_coslatid, 'long_name' , 23, 'smoothed land fraction') - status = nf_put_att_text (foutid, landm_coslatid, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, landfracid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, landfracid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, landfracid, 'long_name', 21, 'gridbox land fraction') - status = nf_put_att_text (foutid, landfracid, 'filter', 40, 'area averaged from 30-sec USGS raw data') - - - status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') - if (status .ne. NF_NOERR) call handle_err(status) - ! status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') - ! if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') - if (status .ne. NF_NOERR) call handle_err(status) - ! status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') - ! if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') - if (status .ne. NF_NOERR) call handle_err(status) - call DATE_AND_TIME(DATE=datestring) - status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) - if (status .ne. NF_NOERR) call handle_err(status) - - ! - ! End define mode for output file - ! - status = nf_enddef (foutid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Write variable for output - ! - print*,"writing terrain data",MINVAL(terr),MAXVAL(terr) - if (lprepare_fv_smoothing_routine) then - status = nf_put_var_double (foutid, terrid, terr) - else - status = nf_put_var_double (foutid, terrid, terr*9.80616) - end if - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing terrain data" - - print*,"writing landfrac data",MINVAL(landfrac),MAXVAL(landfrac) - status = nf_put_var_double (foutid, landfracid, landfrac) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing landfrac data" - - print*,"writing sgh data",MINVAL(sgh),MAXVAL(sgh) - status = nf_put_var_double (foutid, sghid, sgh) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh data" - - print*,"writing sgh30 data",MINVAL(sgh30),MAXVAL(sgh30) - status = nf_put_var_double (foutid, sgh30id, sgh30) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh30 data" - - print*,"writing landm_coslat data",MINVAL(landm_coslat),MAXVAL(landm_coslat) - status = nf_put_var_double (foutid, landm_coslatid, landm_coslat) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh30 data" - ! - print*,"writing lat data" - status = nf_put_var_double (foutid, latvid, latar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lat data" - - print*,"writing lon data" - status = nf_put_var_double (foutid, lonvid, lonar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lon data" - ! - ! Close output file - ! - print *,"close file" - status = nf_close (foutid) - if (status .ne. NF_NOERR) call handle_err(status) -end subroutine wrtncdf_rll -!************************************************************************ -!!handle_err -!************************************************************************ -! -!!ROUTINE: handle_err -!!DESCRIPTION: error handler -!-------------------------------------------------------------------------- - -subroutine handle_err(status) - - implicit none - -# include - - integer status - - if (status .ne. nf_noerr) then - print *, nf_strerror(status) - stop 'Stopped' - endif - -end subroutine handle_err - - -SUBROUTINE coarsen(f,fcoarse,nf,n,dA_coarse) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - REAL (R8), DIMENSION(n) , INTENT(IN) :: f - REAL (R8), DIMENSION(n/nf), INTENT(OUT) :: fcoarse - INTEGER, INTENT(in) :: n,nf - REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6)))/nf,INT(SQRT(DBLE(n/6)))/nf),INTENT(OUT) :: dA_coarse - !must be an even number - ! - ! local workspace - ! - ! ncube = INT(SQRT(DBLE(n/6))) - - REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6))),INT(SQRT(DBLE(n/6)))):: dA - REAL (R8) :: sum, sum_area,tmp - INTEGER :: jx,jy,jp,ii,ii_coarse,coarse_ncube,ncube - INTEGER :: jx_coarse,jy_coarse,jx_s,jy_s - - - ! REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6)))/nf,INT(SQRT(DBLE(n/6)))/nf) :: dAtmp - - ncube = INT(SQRT(DBLE(n/6))) - coarse_ncube = ncube/nf - - IF (ABS(DBLE(ncube)/DBLE(nf)-coarse_ncube)>0.000001) THEN - WRITE(*,*) "ncube/nf must be an integer" - WRITE(*,*) "ncube and nf: ",ncube,nf - STOP - END IF - - da_coarse = 0.0 - - WRITE(*,*) "compute all areas" - CALL EquiangularAllAreas(ncube, dA) - ! CALL EquiangularAllAreas(coarse_ncube, dAtmp)!dbg - tmp = 0.0 - DO jp=1,6 - DO jy_coarse=1,coarse_ncube - DO jx_coarse=1,coarse_ncube - ! - ! inner loop - ! - sum = 0.0 - sum_area = 0.0 - DO jy_s=1,nf - jy = (jy_coarse-1)*nf+jy_s - DO jx_s=1,nf - jx = (jx_coarse-1)*nf+jx_s - ii = (jp-1)*ncube*ncube+(jy-1)*ncube+jx - sum = sum +f(ii)*dA(jx,jy) - sum_area = sum_area+dA(jx,jy) - ! WRITE(*,*) "jx,jy",jx,jy - END DO - END DO - tmp = tmp+sum_area - da_coarse(jx_coarse,jy_coarse) = sum_area - ! WRITE(*,*) "jx_coarse,jy_coarse",jx_coarse,jy_coarse,& - ! da_coarse(jx_coarse,jy_coarse)-datmp(jx_coarse,jy_coarse) - ii_coarse = (jp-1)*coarse_ncube*coarse_ncube+(jy_coarse-1)*coarse_ncube+jx_coarse - fcoarse(ii_coarse) = sum/sum_area - END DO - END DO - END DO - WRITE(*,*) "coarsened surface area",tmp-4.0*3.141592654 -END SUBROUTINE COARSEN - -SUBROUTINE overlap_weights(weights_lgr_index_all,weights_eul_index_all,weights_all,& - jall,ncube,ngauss,ntarget,ncorner,jmax_segments,target_corner_lon,target_corner_lat,nreconstruction) - use shr_kind_mod, only: r8 => shr_kind_r8 - use remap - IMPLICIT NONE - - - INTEGER, INTENT(INOUT) :: jall !anticipated number of weights - INTEGER, INTENT(IN) :: ncube, ngauss, ntarget, jmax_segments, ncorner, nreconstruction - - INTEGER, DIMENSION(jall,3), INTENT(OUT) :: weights_eul_index_all - REAL(R8), DIMENSION(jall,nreconstruction) , INTENT(OUT) :: weights_all - INTEGER, DIMENSION(jall) , INTENT(OUT) :: weights_lgr_index_all - - REAL(R8), DIMENSION(ncorner,ntarget), INTENT(IN) :: target_corner_lon, target_corner_lat - - INTEGER, DIMENSION(ncorner+1) :: ipanel_array, ipanel_tmp - REAL(R8), DIMENSION(ncorner) :: lat, lon - REAL(R8), DIMENSION(0:ncube+2):: xgno, ygno - REAL(R8), DIMENSION(0:ncorner+1) :: xcell, ycell - - REAL(R8), DIMENSION(ngauss) :: gauss_weights, abscissae - - REAL(R8) :: da, tmp, alpha, beta - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: pih = 0.50*pi - INTEGER :: i, j,ncorner_this_cell,k,ip,ipanel,ii,jx,jy,jcollect - integer :: alloc_error - - REAL (r8), PARAMETER :: rad2deg = 180.0/pi - - real(r8), allocatable, dimension(:,:) :: weights - integer , allocatable, dimension(:,:) :: weights_eul_index - - - LOGICAL:: ldbg = .FAlSE. - - INTEGER :: jall_anticipated - - jall_anticipated = jall - - ipanel_array = -99 - ! - da = pih/DBLE(ncube) - xgno(0) = -bignum - DO i=1,ncube+1 - xgno(i) = TAN(-piq+(i-1)*da) - END DO - xgno(ncube+2) = bignum - ygno = xgno - - CALL glwp(ngauss,gauss_weights,abscissae) - - - allocate (weights(jmax_segments,nreconstruction),stat=alloc_error ) - allocate (weights_eul_index(jmax_segments,2),stat=alloc_error ) - - tmp = 0.0 - jall = 1 - DO i=1,ntarget - WRITE(*,*) "cell",i," ",100.0*DBLE(i)/DBLE(ntarget),"% done" - ! - !--------------------------------------------------- - ! - ! determine how many vertices the cell has - ! - !--------------------------------------------------- - ! - CALL remove_duplicates_latlon(ncorner,target_corner_lon(:,i),target_corner_lat(:,i),& - ncorner_this_cell,lon,lat,1.0E-10,ldbg) - - IF (ldbg) THEN - WRITE(*,*) "number of vertices ",ncorner_this_cell - WRITE(*,*) "vertices locations lon,",lon(1:ncorner_this_cell)*rad2deg - WRITE(*,*) "vertices locations lat,",lat(1:ncorner_this_cell)*rad2deg - DO j=1,ncorner_this_cell - WRITE(*,*) lon(j)*rad2deg, lat(j)*rad2deg - END DO - WRITE(*,*) " " - END IF - ! - !--------------------------------------------------- - ! - ! determine how many and which panels the cell spans - ! - !--------------------------------------------------- - ! - DO j=1,ncorner_this_cell - CALL CubedSphereABPFromRLL(lon(j), lat(j), alpha, beta, ipanel_tmp(j), .TRUE.) - IF (ldbg) WRITE(*,*) "ipanel for corner ",j," is ",ipanel_tmp(j) - END DO - ipanel_tmp(ncorner_this_cell+1) = ipanel_tmp(1) - ! make sure to include possible overlap areas not on the face the vertices are located - IF (MINVAL(lat(1:ncorner_this_cell))<-pi/6.0) THEN - ! include South-pole panel in search - ipanel_tmp(ncorner_this_cell+1) = 5 - IF (ldbg) WRITE(*,*) "add panel 5 to search" - END IF - IF (MAXVAL(lat(1:ncorner_this_cell))>pi/6.0) THEN - ! include North-pole panel in search - ipanel_tmp(ncorner_this_cell+1) = 6 - IF (ldbg) WRITE(*,*) "add panel 6 to search" - END IF - ! - ! remove duplicates in ipanel_tmp - ! - CALL remove_duplicates_integer(ncorner_this_cell+1,ipanel_tmp(1:ncorner_this_cell+1),& - k,ipanel_array(1:ncorner_this_cell+1)) - ! - !--------------------------------------------------- - ! - ! loop over panels with possible overlap areas - ! - !--------------------------------------------------- - ! - DO ip = 1,k - ipanel = ipanel_array(ip) - DO j=1,ncorner_this_cell - ii = ipanel - CALL CubedSphereABPFromRLL(lon(j), lat(j), alpha, beta, ii,.FALSE.) - IF (j==1) THEN - jx = CEILING((alpha + piq) / da) - jy = CEILING((beta + piq) / da) - END IF - xcell(ncorner_this_cell+1-j) = TAN(alpha) - ycell(ncorner_this_cell+1-j) = TAN(beta) - END DO - xcell(0) = xcell(ncorner_this_cell) - ycell(0) = ycell(ncorner_this_cell) - xcell(ncorner_this_cell+1) = xcell(1) - ycell(ncorner_this_cell+1) = ycell(1) - - jx = MAX(MIN(jx,ncube+1),0) - jy = MAX(MIN(jy,ncube+1),0) - - CALL compute_weights_cell(xcell(0:ncorner_this_cell+1),ycell(0:ncorner_this_cell+1),& - jx,jy,nreconstruction,xgno,ygno,& - 1, ncube+1, 1,ncube+1, tmp,& - ngauss,gauss_weights,abscissae,weights,weights_eul_index,jcollect,jmax_segments,& - ncube,0,ncorner_this_cell,ldbg) - - weights_all(jall:jall+jcollect-1,1:nreconstruction) = weights(1:jcollect,1:nreconstruction) - - weights_eul_index_all(jall:jall+jcollect-1,1:2) = weights_eul_index(1:jcollect,:) - weights_eul_index_all(jall:jall+jcollect-1, 3) = ipanel - weights_lgr_index_all(jall:jall+jcollect-1 ) = i - - jall = jall+jcollect - IF (jall>jall_anticipated) THEN - WRITE(*,*) "more weights than anticipated" - WRITE(*,*) "increase jall" - STOP - END IF - IF (ldbg) WRITE(*,*) "jcollect",jcollect - END DO - END DO - jall = jall-1 - WRITE(*,*) "sum of all weights divided by surface area of sphere =",tmp/(4.0*pi) - WRITE(*,*) "actual number of weights",jall - WRITE(*,*) "anticipated number of weights",jall_anticipated - IF (jall>jall_anticipated) THEN - WRITE(*,*) "anticipated number of weights < actual number of weights" - WRITE(*,*) "increase jall!" - STOP - END IF - WRITE(*,*) MINVAL(weights_all(1:jall,1)),MAXVAL(weights_all(1:jall,1)) - IF (ABS(tmp/(4.0*pi))-1.0>0.001) THEN - WRITE(*,*) "sum of all weights does not match the surface area of the sphere" - WRITE(*,*) "sum of all weights is : ",tmp - WRITE(*,*) "surface area of sphere: ",4.0*pi - STOP - END IF -END SUBROUTINE overlap_weights - - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereABPFromRLL -! -! Description: -! Determine the (alpha,beta,panel) coordinate of a point on the sphere from -! a given regular lat lon coordinate. -! -! Parameters: -! lon - Coordinate longitude -! lat - Coordinate latitude -! alpha (OUT) - Alpha coordinate -! beta (OUT) - Beta coordinate -! ipanel (OUT) - Face panel -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereABPFromRLL(lon, lat, alpha, beta, ipanel, ldetermine_panel) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - REAL (R8), INTENT(IN) :: lon, lat - REAL (R8), INTENT(OUT) :: alpha, beta - INTEGER :: ipanel - LOGICAL, INTENT(IN) :: ldetermine_panel - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: rotate_cube = 0.0 - - ! Local variables - REAL (R8) :: xx, yy, zz, pm - REAL (R8) :: sx, sy, sz - INTEGER :: ix, iy, iz - - ! Translate to (x,y,z) space - xx = COS(lon-rotate_cube) * COS(lat) - yy = SIN(lon-rotate_cube) * COS(lat) - zz = SIN(lat) - - pm = MAX(ABS(xx), ABS(yy), ABS(zz)) - - ! Check maximality of the x coordinate - IF (pm == ABS(xx)) THEN - IF (xx > 0) THEN; ix = 1; ELSE; ix = -1; ENDIF - ELSE - ix = 0 - ENDIF - - ! Check maximality of the y coordinate - IF (pm == ABS(yy)) THEN - IF (yy > 0) THEN; iy = 1; ELSE; iy = -1; ENDIF - ELSE - iy = 0 - ENDIF - - ! Check maximality of the z coordinate - IF (pm == ABS(zz)) THEN - IF (zz > 0) THEN; iz = 1; ELSE; iz = -1; ENDIF - ELSE - iz = 0 - ENDIF - - ! Panel assignments - IF (ldetermine_panel) THEN - IF (iz == 1) THEN - ipanel = 6; sx = yy; sy = -xx; sz = zz - - ELSEIF (iz == -1) THEN - ipanel = 5; sx = yy; sy = xx; sz = -zz - - ELSEIF ((ix == 1) .AND. (iy /= 1)) THEN - ipanel = 1; sx = yy; sy = zz; sz = xx - - ELSEIF ((ix == -1) .AND. (iy /= -1)) THEN - ipanel = 3; sx = -yy; sy = zz; sz = -xx - - ELSEIF ((iy == 1) .AND. (ix /= -1)) THEN - ipanel = 2; sx = -xx; sy = zz; sz = yy - - ELSEIF ((iy == -1) .AND. (ix /= 1)) THEN - ipanel = 4; sx = xx; sy = zz; sz = -yy - - ELSE - WRITE(*,*) 'Fatal Error: CubedSphereABPFromRLL failed' - WRITE(*,*) '(xx, yy, zz) = (', xx, ',', yy, ',', zz, ')' - WRITE(*,*) 'pm =', pm, ' (ix, iy, iz) = (', ix, ',', iy, ',', iz, ')' - STOP - ENDIF - ELSE - IF (ipanel == 6) THEN - sx = yy; sy = -xx; sz = zz - ELSEIF (ipanel == 5) THEN - sx = yy; sy = xx; sz = -zz - ELSEIF (ipanel == 1) THEN - sx = yy; sy = zz; sz = xx - ELSEIF (ipanel == 3) THEN - sx = -yy; sy = zz; sz = -xx - ELSEIF (ipanel == 2) THEN - sx = -xx; sy = zz; sz = yy - ELSEIF (ipanel == 4) THEN - sx = xx; sy = zz; sz = -yy - ELSE - WRITE(*,*) "ipanel out of range",ipanel - STOP - END IF - END IF - - ! Use panel information to calculate (alpha, beta) coords - alpha = ATAN(sx / sz) - beta = ATAN(sy / sz) - -END SUBROUTINE CubedSphereABPFromRLL - -!------------------------------------------------------------------------------ -! SUBROUTINE EquiangularAllAreas -! -! Description: -! Compute the area of all cubed sphere grid cells, storing the results in -! a two dimensional array. -! -! Parameters: -! icube - Resolution of the cubed sphere -! dA (OUT) - Output array containing the area of all cubed sphere grid cells -!------------------------------------------------------------------------------ -SUBROUTINE EquiangularAllAreas(icube, dA) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - INTEGER, INTENT(IN) :: icube - REAL (r8), DIMENSION(icube,icube), INTENT(OUT) :: dA - - ! Local variables - INTEGER :: k, k1, k2 - REAL (r8) :: a1, a2, a3, a4 - REAL (r8), DIMENSION(icube+1,icube+1) :: ang - REAL (r8), DIMENSION(icube+1) :: gp - - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - - - !#ifdef DBG - REAL (r8) :: dbg1 !DBG - !#endif - - ! Recall that we are using equi-angular spherical gridding - ! Compute the angle between equiangular cubed sphere projection grid lines. - DO k = 1, icube+1 - gp(k) = -piq + (pi/DBLE(2*(icube))) * DBLE(k-1) - ENDDO - - DO k2=1,icube+1 - DO k1=1,icube+1 - ang(k1,k2) =ACOS(-SIN(gp(k1)) * SIN(gp(k2))) - ENDDO - ENDDO - - DO k2=1,icube - DO k1=1,icube - a1 = ang(k1 , k2 ) - a2 = pi - ang(k1+1, k2 ) - a3 = pi - ang(k1 , k2+1) - a4 = ang(k1+1, k2+1) - ! area = r*r*(-2*pi+sum(interior angles)) - DA(k1,k2) = -2.0*pi+a1+a2+a3+a4 - ENDDO - ENDDO - - !#ifdef DBG - ! Only for debugging - test consistency - dbg1 = 0.0 !DBG - DO k2=1,icube - DO k1=1,icube - dbg1 = dbg1 + DA(k1,k2) !DBG - ENDDO - ENDDO - write(*,*) 'DAcube consistency: ',dbg1-4.0*pi/6.0 !DBG - !#endif -END SUBROUTINE EquiangularAllAreas - - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereRLLFromABP -! -! Description: -! Determine the lat lon coordinate of a point on a sphere given its -! (alpha,beta,panel) coordinate. -! -! Parameters: -! alpha - Alpha coordinate -! beta - Beta coordinate -! panel - Cubed sphere panel id -! lon (OUT) - Calculated longitude -! lat (OUT) - Calculated latitude -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereRLLFromABP(alpha, beta, ipanel, lon, lat) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - REAL (r8), INTENT(IN) :: alpha, beta - INTEGER , INTENT(IN) :: ipanel - REAL (r8), INTENT(OUT) :: lon, lat - ! Local variables - REAL (r8) :: xx, yy, zz, rotate_cube - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - - rotate_cube = 0.0 - ! Convert to cartesian coordinates - CALL CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) - ! Convert back to lat lon - lat = ASIN(zz) - if (xx==0.0.and.yy==0.0) THEN - lon = 0.0 - else - lon = ATAN2(yy, xx) +rotate_cube - IF (lon<0.0) lon=lon+2.0*pi - IF (lon>2.0*pi) lon=lon-2.0*pi - end if -END SUBROUTINE CubedSphereRLLFromABP - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereXYZFromABP -! -! Description: -! Determine the Cartesian coordinate of a point on a sphere given its -! (alpha,beta,panel) coordinate. -! -! Parameters: -! alpha - Alpha coordinate -! beta - Beta coordinate -! panel - Cubed sphere panel id -! xx (OUT) - Calculated x coordinate -! yy (OUT) - Calculated y coordinate -! zz (OUT) - Calculated z coordinate -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - REAL (r8), INTENT(IN) :: alpha, beta - INTEGER , INTENT(IN) :: ipanel - REAL (r8), INTENT(OUT) :: xx, yy, zz - ! Local variables - REAL (r8) :: a1, b1, pm - REAL (r8) :: sx, sy, sz - - ! Convert to Cartesian coordinates - a1 = TAN(alpha) - b1 = TAN(beta) - - sz = (1.0 + a1 * a1 + b1 * b1)**(-0.5) - sx = sz * a1 - sy = sz * b1 - ! Panel assignments - IF (ipanel == 6) THEN - yy = sx; xx = -sy; zz = sz - ELSEIF (ipanel == 5) THEN - yy = sx; xx = sy; zz = -sz - ELSEIF (ipanel == 1) THEN - yy = sx; zz = sy; xx = sz - ELSEIF (ipanel == 3) THEN - yy = -sx; zz = sy; xx = -sz - ELSEIF (ipanel == 2) THEN - xx = -sx; zz = sy; yy = sz - ELSEIF (ipanel == 4) THEN - xx = sx; zz = sy; yy = -sz - ELSE - WRITE(*,*) 'Fatal Error: Panel out of range in CubedSphereXYZFromABP' - WRITE(*,*) '(alpha, beta, panel) = (', alpha, ',', beta, ',', ipanel, ')' - STOP - ENDIF -END SUBROUTINE CubedSphereXYZFromABP - - -SUBROUTINE remove_duplicates_integer(n_in,f_in,n_out,f_out) - use shr_kind_mod, only: r8 => shr_kind_r8 - integer, intent(in) :: n_in - integer,dimension(n_in), intent(in) :: f_in - integer, intent(out) :: n_out - integer,dimension(n_in), intent(out) :: f_out - ! - ! local work space - ! - integer :: k,i,j - ! - ! remove duplicates in ipanel_tmp - ! - k = 1 - f_out(1) = f_in(1) - outer: do i=2,n_in - do j=1,k - ! if (f_out(j) == f_in(i)) then - if (ABS(f_out(j)-f_in(i))<1.0E-10) then - ! Found a match so start looking again - cycle outer - end if - end do - ! No match found so add it to the output - k = k + 1 - f_out(k) = f_in(i) - end do outer - n_out = k -END SUBROUTINE remove_duplicates_integer - -SUBROUTINE remove_duplicates_latlon(n_in,lon_in,lat_in,n_out,lon_out,lat_out,tiny,ldbg) - use shr_kind_mod, only: r8 => shr_kind_r8 - integer, intent(in) :: n_in - real(r8),dimension(n_in), intent(inout) :: lon_in,lat_in - real, intent(in) :: tiny - integer, intent(out) :: n_out - real(r8),dimension(n_in), intent(out) :: lon_out,lat_out - logical :: ldbg - ! - ! local work space - ! - integer :: k,i,j - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: pih = 0.50*pi - ! - ! for pole points: make sure the longitudes are identical so that algorithm below works properly - ! - do i=2,n_in - if (abs(lat_in(i)-pih) 0) .AND. (j < ncube_reconstruct)) THEN - beta = gp(j) - beta_next = gp(j+1) - ELSEIF (j == -1) THEN - beta = -piq - (gp(3) + piq) - beta_next = -piq - (gp(2) + piq) - ELSEIF (j == 0) THEN - beta = -piq - (gp(2) + piq) - beta_next = -piq - ELSEIF (j == ncube_reconstruct) THEN - beta = piq - beta_next = piq + (piq - gp(ncube_reconstruct-1)) - ELSEIF (j == ncube_reconstruct+1) THEN - beta = piq + (piq - gp(ncube_reconstruct-1)) - beta_next = piq + (piq - gp(ncube_reconstruct-2)) - ENDIF - - DO i = -1, ncube_reconstruct+1 - IF ((i > 0) .AND. (i < ncube_reconstruct)) THEN - alpha = gp(i) - alpha_next = gp(i+1) - ELSEIF (i == -1) THEN - alpha = -piq - (gp(3) + piq) - alpha_next = -piq - (gp(2) + piq) - ELSEIF (i == 0) THEN - alpha = -piq - (gp(2) + piq) - alpha_next = -piq - ELSEIF (i == ncube_reconstruct) THEN - alpha = piq - alpha_next = piq + (piq - gp(ncube_reconstruct-1)) - ELSEIF (i == ncube_reconstruct+1) THEN - alpha = piq + (piq - gp(ncube_reconstruct-1)) - alpha_next = piq + (piq - gp(ncube_reconstruct-2)) - ENDIF - abp_centroid(1,i,j) = & - I_10_ab(alpha_next,beta_next)-I_10_ab(alpha ,beta_next)+& - I_10_ab(alpha ,beta )-I_10_ab(alpha_next,beta ) -! - ASINH(COS(alpha_next) * TAN(beta_next)) & -! + ASINH(COS(alpha_next) * TAN(beta)) & -! + ASINH(COS(alpha) * TAN(beta_next)) & -! - ASINH(COS(alpha) * TAN(beta)) - - abp_centroid(2,i,j) = & - I_01_ab(alpha_next,beta_next)-I_01_ab(alpha ,beta_next)+& - I_01_ab(alpha ,beta )-I_01_ab(alpha_next,beta ) -! - ASINH(TAN(alpha_next) * COS(beta_next)) & -! + ASINH(TAN(alpha_next) * COS(beta)) & -! + ASINH(TAN(alpha) * COS(beta_next)) & -! - ASINH(TAN(alpha) * COS(beta)) - - !ADD PHL START - IF (order>2) THEN - ! TAN(alpha)^2 component - abp_centroid(3,i,j) =& - I_20_ab(alpha_next,beta_next)-I_20_ab(alpha ,beta_next)+& - I_20_ab(alpha ,beta )-I_20_ab(alpha_next,beta ) - - ! TAN(beta)^2 component - abp_centroid(4,i,j) = & - I_02_ab(alpha_next,beta_next)-I_02_ab(alpha ,beta_next)+& - I_02_ab(alpha ,beta )-I_02_ab(alpha_next,beta ) - - ! TAN(alpha) TAN(beta) component - abp_centroid(5,i,j) = & - I_11_ab(alpha_next,beta_next)-I_11_ab(alpha ,beta_next)+& - I_11_ab(alpha ,beta )-I_11_ab(alpha_next,beta ) - ENDIF - !ADD PHL END - ENDDO - ENDDO - -! -! PHL outcommented below -! - ! High order calculations -! IF (order > 2) THEN -! DO k = 1, nlon -! DO i = 1, int_nx(nlat,k)-1 -! IF ((int_itype(i,k) > 4) .AND. (int_np(1,i,k) == 1)) THEN -! abp_centroid(3, int_a(i,k), int_b(i,k)) = & -! abp_centroid(3, int_a(i,k), int_b(i,k)) + int_wt_2a(i,k) -! abp_centroid(4, int_a(i,k), int_b(i,k)) = & -! abp_centroid(4, int_a(i,k), int_b(i,k)) + int_wt_2b(i,k) -! abp_centroid(5, int_a(i,k), int_b(i,k)) = & -! abp_centroid(5, int_a(i,k), int_b(i,k)) + int_wt_2c(i,k) -! ENDIF -! ENDDO -! ENDDO -! ENDIF - - ! Normalize with element areas - DO j = -1, ncube_reconstruct+1 - IF ((j > 0) .AND. (j < ncube_reconstruct)) THEN - beta = gp(j) - beta_next = gp(j+1) - ELSEIF (j == -1) THEN - beta = -piq - (gp(3) + piq) - beta_next = -piq - (gp(2) + piq) - ELSEIF (j == 0) THEN - beta = -piq - (gp(2) + piq) - beta_next = -piq - ELSEIF (j == ncube_reconstruct) THEN - beta = piq - beta_next = piq + (piq - gp(ncube_reconstruct-1)) - ELSEIF (j == ncube_reconstruct+1) THEN - beta = piq + (piq - gp(ncube_reconstruct-1)) - beta_next = piq + (piq - gp(ncube_reconstruct-2)) - ENDIF - DO i = -1, ncube_reconstruct+1 - IF ((i > 0) .AND. (i < ncube_reconstruct)) THEN - alpha = gp(i) - alpha_next = gp(i+1) - ELSEIF (i == -1) THEN - alpha = -piq - (gp(3) + piq) - alpha_next = -piq - (gp(2) + piq) - ELSEIF (i == 0) THEN - alpha = -piq - (gp(2) + piq) - alpha_next = -piq - ELSEIF (i == ncube_reconstruct) THEN - alpha = piq - alpha_next = piq + (piq - gp(ncube_reconstruct-1)) - ELSEIF (i == ncube_reconstruct+1) THEN - alpha = piq + (piq - gp(ncube_reconstruct-1)) - alpha_next = piq + (piq - gp(ncube_reconstruct-2)) - ENDIF - - IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - area = DAcube(i,j) - ELSE - area = EquiangularElementArea(alpha, alpha_next - alpha, & - beta, beta_next - beta) - ENDIF - - abp_centroid(1,i,j) = abp_centroid(1,i,j) / area - abp_centroid(2,i,j) = abp_centroid(2,i,j) / area - - IF (order > 2) THEN - IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - abp_centroid(3,i,j) = abp_centroid(3,i,j) / area - abp_centroid(4,i,j) = abp_centroid(4,i,j) / area - abp_centroid(5,i,j) = abp_centroid(5,i,j) / area - ENDIF - ENDIF - ENDDO - ENDDO - - WRITE(*,*) '...Done computing ABP element centroids' - - END SUBROUTINE ComputeABPElementCentroids - -!------------------------------------------------------------------------------ -! FUNCTION EvaluateABPReconstruction -! -! Description: -! Evaluate the sub-grid scale reconstruction at the given point. -! -! Parameters: -! fcubehalo - Array of element values -! recons - Array of reconstruction coefficients -! a - Index of element in alpha direction (1 <= a <= ncube_reconstruct-1) -! b - Index of element in beta direction (1 <= b <= ncube_reconstruct-1) -! p - Panel index of element -! alpha - Alpha coordinate of evaluation point -! beta - Beta coordinate of evaluation point -! order - Order of the reconstruction -! value (OUT) - Result of function evaluation at given point -!------------------------------------------------------------------------------ - SUBROUTINE EvaluateABPReconstruction( & - fcubehalo, recons, a, b, p, alpha, beta, order, value) - IMPLICIT NONE - - ! Dummy variables - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(IN) :: recons - INTEGER (KIND=int_kind), INTENT(IN) :: a, b, p - REAL (KIND=dbl_kind), INTENT(IN) :: alpha, beta - INTEGER (KIND=int_kind), INTENT(IN) :: order - - REAL (KIND=dbl_kind), INTENT(OUT) :: value - - ! Evaluate constant order terms - value = fcubehalo(a,b,p) - - ! Evaluate linear order terms - IF (order > 1) THEN - value = value + recons(1,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b)) - value = value + recons(2,a,b,p) * (TAN(beta) - abp_centroid(2,a,b)) - ENDIF - - ! Evaluate second order terms - IF (order > 2) THEN - value = value + recons(3,a,b,p) * & - (abp_centroid(1,a,b)**2 - abp_centroid(3,a,b)) - value = value + recons(4,a,b,p) * & - (abp_centroid(2,a,b)**2 - abp_centroid(4,a,b)) - value = value + recons(5,a,b,p) * & - (abp_centroid(1,a,b) * abp_centroid(2,a,b) - & - abp_centroid(5,a,b)) - - value = value + recons(3,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b))**2 - value = value + recons(4,a,b,p) * (TAN(beta) - abp_centroid(2,a,b))**2 - value = value + recons(5,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b)) & - * (TAN(beta) - abp_centroid(2,a,b)) - ENDIF - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ABPHaloMinMax -! -! Description: -! Calculate the minimum and maximum values of the cell-averaged function -! around the given element. -! -! Parameters: -! fcubehalo - Cell-averages for the cubed sphere -! a - Local element alpha index -! b - Local element beta index -! p - Local element panel index -! min_val (OUT) - Minimum value in the halo -! max_val (OUT) - Maximum value in the halo -! nomiddle - whether to not include the middle cell (index a,b) in the search. -! -! NOTE: Since this routine is not vectorized, it will likely be called MANY times. -! To speed things up, make sure to pass the first argument as the ENTIRE original -! array, not as a subset of it, since repeatedly cutting up that array and creating -! an array temporary (on some compilers) is VERY slow. -! ex: -! CALL APBHaloMinMax(zarg, a, ...) !YES -! CALL ABPHaloMinMax(zarg(-1:ncube_reconstruct+1,-1:ncube_reconstruct+1,:)) !NO -- slow -!------------------------------------------------------------------------------ - SUBROUTINE ABPHaloMinMax(fcubehalo, a, b, p, min_val, max_val, nomiddle) - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: a, b, p - REAL (KIND=dbl_kind), INTENT(OUT) :: min_val, max_val - LOGICAL, INTENT(IN) :: nomiddle - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, il, jl, inew, jnew - REAL (KIND=dbl_kind) :: value - - min_val = fcubehalo(a,b,p) - max_val = fcubehalo(a,b,p) - value = fcubehalo(a,b,p) - - DO il = a-1,a+1 - DO jl = b-1,b+1 - - i = il - j = jl - - inew = i - jnew = j - - IF (nomiddle .AND. i==a .AND. j==b) CYCLE - - !Interior - IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - value = fcubehalo(i,j,p) - - ELSE - - - !The next 4.0 regions are cases in which a,b themselves lie in the panel's halo, and the cell's "halo" (in this usage the 8.0 cells surrounding it) might wrap around into another part of the halo. This happens for (a,b) = {(1,:0),(ncube_reconstruct-1,:0),(1,ncube_reconstruct:),(ncube_reconstruct-1,ncube_reconstruct:)} and for the transposes thereof ({(:0,1), etc.}). In these cases (i,j) could lie in the "Corners" where nothing should lie. We correct this by moving i,j to its appropriate position on the "facing" halo, and then the remainder of the routine then moves it onto the correct face. - -101 FORMAT("ERROR cannot find (i,j) = (", I4, ", ", I4, ") for (a,b,p) = ", I4, ",", I4, ",", I4, ")") -102 FORMAT("i,j,p = ", 3I4, " moved to " 2I4, " (CASE ", I1, ")") - !NOTE: we need the general case to be able to properly handle (0,0), (ncube_reconstruct,0), etc. Note that we don't need to bother with (0,0), etc. when a, b lie in the interior, since both sides of the (0,0) cell are already accounted for by this routine. - !LOWER LEFT - IF (i < 1 .AND. j < 1) THEN - IF (a < 1) THEN !(a,b) centered on left halo, cross to lower halo - inew = 1-j - jnew = i - ELSE IF (b < 1) THEN !(a,b) centered on lower halo, cross to left halo - jnew = 1-i - inew = j - END IF -! WRITE(*,102) i, j, p, inew, jnew, 1 - !LOWER RIGHT - ELSE IF (i > ncube_reconstruct-1 .AND. j < 1) THEN - IF (a > ncube_reconstruct-1) THEN !(a,b) centered on right halo, cross to lower halo - inew = ncube_reconstruct-1+j - jnew = ncube_reconstruct-i - ELSE IF (b < 1) THEN !(a,b) centered on lower halo, cross to right halo - jnew = 1+(i-ncube_reconstruct) - inew = ncube_reconstruct-j - END IF -! WRITE(*,102) i, j, p, inew, jnew, 2 - !UPPER LEFT - ELSE IF (i < 1 .AND. j > ncube_reconstruct-1) THEN - IF (a < 1) THEN! (a,b) centered on left halo, cross to upper halo - inew = 1-(j-ncube_reconstruct) - jnew = ncube_reconstruct-i - ELSE IF (b > ncube_reconstruct-1) THEN !(a,b) centered on upper halo, cross to left halo - inew = ncube_reconstruct-j - jnew = ncube_reconstruct-1-i - END IF -! WRITE(*,102) i, j, p, inew, jnew, 3 - !UPPER RIGHT - ELSE IF (i > ncube_reconstruct-1 .AND. j > ncube_reconstruct-1) THEN - IF (a > ncube_reconstruct-1) THEN !(a,b) centered on right halo, cross to upper halo - inew = ncube_reconstruct-1-(ncube_reconstruct-j) - jnew = i - ELSE IF (b > ncube_reconstruct-1) THEN !(a,b) centered on upper halo, cross to right halo - inew = j - jnew = ncube_reconstruct-1-(ncube_reconstruct-i) - END IF -! WRITE(*,102) i, j, p, inew, jnew, 4 - END IF - - i = inew - j = jnew - - - !Lower halo ("halo" meaning the panel's halo, not the nine-cell halo - IF ((i < 1) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - IF (p == 1) THEN - value = fcubehalo(ncube_reconstruct-1+i,j,4) - ELSEIF (p == 2) THEN - value = fcubehalo(ncube_reconstruct-1+i,j,1) - ELSEIF (p == 3) THEN - value = fcubehalo(ncube_reconstruct-1+i,j,2) - ELSEIF (p == 4) THEN - value = fcubehalo(ncube_reconstruct-1+i,j,3) - ELSEIF (p == 5) THEN - value = fcubehalo(j,1-i,4) - ELSEIF (p == 6) THEN - value = fcubehalo(ncube_reconstruct-j,ncube_reconstruct-1+i,4) - ENDIF - - !Upper halo - ELSEIF ((i > ncube_reconstruct-1) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - IF (p == 1) THEN - value = fcubehalo(i-ncube_reconstruct+1,j,2) - ELSEIF (p == 2) THEN - value = fcubehalo(i-ncube_reconstruct+1,j,3) - ELSEIF (p == 3) THEN - value = fcubehalo(i-ncube_reconstruct+1,j,4) - ELSEIF (p == 4) THEN - value = fcubehalo(i-ncube_reconstruct+1,j,1) - ELSEIF (p == 5) THEN - value = fcubehalo(ncube_reconstruct-j,i-ncube_reconstruct+1,2) - ELSEIF (p == 6) THEN - value = fcubehalo(j,2*ncube_reconstruct-i-1,2) - ENDIF - - !Left halo - ELSEIF ((j < 1) .AND. (i > 0) .AND. (i < ncube_reconstruct)) THEN - IF (p == 1) THEN - value = fcubehalo(i,ncube_reconstruct-1+j,5) - ELSEIF (p == 2) THEN - value = fcubehalo(ncube_reconstruct-1+j,ncube_reconstruct-i,5) - ELSEIF (p == 3) THEN - value = fcubehalo(ncube_reconstruct-i,1-j,5) - ELSEIF (p == 4) THEN - value = fcubehalo(1-j,i,5) - ELSEIF (p == 5) THEN - value = fcubehalo(ncube_reconstruct-i,1-j,3) - ELSEIF (p == 6) THEN - value = fcubehalo(i,ncube_reconstruct-1+j,1) - ENDIF - - !Right halo - ELSEIF ((j > ncube_reconstruct-1) .AND. (i > 0) .AND. (i < ncube_reconstruct)) THEN - IF (p == 1) THEN - value = fcubehalo(i,j-ncube_reconstruct+1,6) - ELSEIF (p == 2) THEN - value = fcubehalo(2*ncube_reconstruct-j-1,i,6) - ELSEIF (p == 3) THEN - value = fcubehalo(ncube_reconstruct-i, 2*ncube_reconstruct-j-1,6) - ELSEIF (p == 4) THEN - value = fcubehalo(j-ncube_reconstruct+1,ncube_reconstruct-i,6) - ELSEIF (p == 5) THEN - value = fcubehalo(i,j-ncube_reconstruct+1,1) - ELSEIF (p == 6) THEN - value = fcubehalo(ncube_reconstruct-i, 2*ncube_reconstruct-j-1,3) - ENDIF - - ENDIF - - END IF - min_val = MIN(min_val, value) - max_val = MAX(max_val, value) - ENDDO - ENDDO - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE MonotonizeABPGradient -! -! Description: -! Apply a monotonic filter to the calculated ABP gradient. -! -! Parameters: -! fcubehalo - Scalar field on the cubed sphere to use in reconstruction -! order - Order of the reconstruction -! recons (INOUT) - Array of reconstructed coefficients -! selective - whether to apply a simple form of selective limiting, - !which assumes that if a point is larger/smaller than ALL of its - !surrounding points, that the extremum is physical, and that - !filtering should not be applied to it. -! -! Remarks: -! This monotonizing scheme is based on the monotone scheme for unstructured -! grids of Barth and Jespersen (1989). -!------------------------------------------------------------------------------ - SUBROUTINE MonotonizeABPGradient(fcubehalo, order, recons, selective) - -! USE selective_limiting - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - LOGICAL, INTENT(IN) :: selective - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, k, m, n, skip - - REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi - REAL (KIND=dbl_kind) :: disc, mx, my, lam, gamma_min, gamma_max - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: & - gamma - - ! The first-order piecewise constant scheme is monotone by construction - IF (order == 1) THEN - RETURN - ENDIF - -! -! xxxxx -! -! IF (selective) THEN -! CALL smoothness2D(fcubehalo, gamma, 2) -! WRITE(*,*) 'gamma range: max ', MAXVAL(gamma), " min ", MINVAL(gamma) -! DO i=1,ncube_reconstruct-1 -! WRITE(*,*) gamma(i, i, 3) -! ENDDO -! skip = 0 -! END IF - - - ! Apply monotone limiting - DO k = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - - - IF (selective) THEN - - CALL ABPHaloMinMax(gamma, i, j, k, gamma_min, gamma_max, .FALSE.) - - IF (gamma_max/(gamma_min + tiny) < lammax) THEN - skip = skip + 1 - CYCLE - END IF - - END IF - - CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) - - - ! Initialize the limiter - min_phi = one - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), local_min, local_max, min_phi) - ENDDO - ENDDO - - ! For the third order method, the minima and maxima may occur along - ! the line segments given by du/dx = 0 and du/dy = 0. Also check - ! for the presence of a maxima / minima of the quadratic within - ! the domain. - IF (order == 3) THEN - disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) - - ! Check if the quadratic is minimized within the element - IF (ABS(disc) > tiny) THEN - mx = - recons(5,i,j,k) * recons(2,i,j,k) & - + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) - my = - recons(5,i,j,k) * recons(1,i,j,k) & - + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) - - mx = mx / disc + abp_centroid(1,i,j) - my = my / disc + abp_centroid(2,i,j) - - IF ((mx - TAN(gp(i)) > -tiny) .AND. & - (mx - TAN(gp(i+1)) < tiny) .AND. & - (my - TAN(gp(j)) > -tiny) .AND. & - (my - TAN(gp(j+1)) < tiny) & - ) THEN - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDIF - ENDIF - - ! Check all potential minimizer points along element boundaries - IF (ABS(recons(5,i,j,k)) > tiny) THEN - - ! Left/right edge, intercept with du/dx = 0 - DO m = i, i+1 - my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / recons(5,i,j,k) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - - ! Top/bottom edge, intercept with du/dy = 0 - DO n = j, j+1 - mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Top/bottom edge, intercept with du/dx = 0 - IF (ABS(recons(3,i,j,k)) > tiny) THEN - DO n = j, j+1 - mx = - recons(1,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Left/right edge, intercept with du/dy = 0 - IF (ABS(recons(4,i,j,k)) > tiny) THEN - DO m = i, i+1 - my = - recons(2,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - ENDIF - - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - ! Apply monotone limiter to all reconstruction coefficients - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - - IF (order > 2) THEN - recons(3,i,j,k) = min_phi * recons(3,i,j,k) - recons(4,i,j,k) = min_phi * recons(4,i,j,k) - recons(5,i,j,k) = min_phi * recons(5,i,j,k) - ENDIF - ENDDO - ENDDO - ENDDO - - IF (selective) WRITE(*,*) 'skipped ', skip, ' points out of ', 6*(ncube_reconstruct-1)**2 - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE PosDefABPGradient -! -! Description: -! Scale the reconstructions so they are positive definite -! -! Parameters: -! fcubehalo - Scalar field on the cubed sphere to use in reconstruction -! order - Order of the reconstruction -! recons (INOUT) - Array of reconstructed coefficients -! -! Remarks: -! This monotonizing scheme is based on the monotone scheme for unstructured -! grids of Barth and Jespersen (1989), but simpler. This simply finds the -! minimum and then scales the reconstruction so that it is 0. -!------------------------------------------------------------------------------ - SUBROUTINE PosDefABPGradient(fcubehalo, order, recons) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, k, m, n - - REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi - REAL (KIND=dbl_kind) :: disc, mx, my, lam, gamma_min, gamma_max - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: & - gamma - - ! The first-order piecewise constant scheme is monotone by construction - IF (order == 1) THEN - RETURN - ENDIF - - - ! Apply monotone limiting - DO k = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - - !If the average value in the cell is 0.0, then we should skip - !all of the scaling and just set the reconstruction to 0.0 -! IF (ABS(fcubehalo(i,j,k)) < tiny) THEN -! recons(:,i,j,k) = 0.0 -! CYCLE -! END IF - CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) - - - !This allowance for miniscule negative values appearing around the cell being - !filtered/limited. Before this, negative values would be caught in adjust_limiter - !and would stop the model. Doing this only causes minor negative values; no blowing - !up is observed. The rationale is the same as for the monotone filter, which does - !allow miniscule negative values due to roundoff error --- of the order E-10 --- - !in flux-form methods (and E-17 in the s-L method, indicating that roundoff error - !is more severe in the flux-form method, as we expect since we are often subtracting - !2.0 values which are very close together. - local_min = MIN(0.0,local_min) - local_max = bignum !prevents scaling upward; for positive - !definite limiting we don't care about the upper bound - - ! Initialize the limiter - min_phi = one - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), local_min, local_max, min_phi) - ENDDO - ENDDO - - ! For the third order method, the minima and maxima may occur along - ! the line segments given by du/dx = 0 and du/dy = 0. Also check - ! for the presence of a maxima / minima of the quadratic within - ! the domain. - IF (order == 3) THEN - disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) - - ! Check if the quadratic is minimized within the element - IF (ABS(disc) > tiny) THEN - mx = - recons(5,i,j,k) * recons(2,i,j,k) & - + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) - my = - recons(5,i,j,k) * recons(1,i,j,k) & - + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) - - mx = mx / disc + abp_centroid(1,i,j) - my = my / disc + abp_centroid(2,i,j) - - IF ((mx - TAN(gp(i)) > -tiny) .AND. & - (mx - TAN(gp(i+1)) < tiny) .AND. & - (my - TAN(gp(j)) > -tiny) .AND. & - (my - TAN(gp(j+1)) < tiny) & - ) THEN - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDIF - ENDIF - - ! Check all potential minimizer points along element boundaries - IF (ABS(recons(5,i,j,k)) > tiny) THEN - - ! Left/right edge, intercept with du/dx = 0 - DO m = i, i+1 - my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / recons(5,i,j,k) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - - ! Top/bottom edge, intercept with du/dy = 0 - DO n = j, j+1 - mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Top/bottom edge, intercept with du/dx = 0 - IF (ABS(recons(3,i,j,k)) > tiny) THEN - DO n = j, j+1 - mx = - recons(1,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Left/right edge, intercept with du/dy = 0 - IF (ABS(recons(4,i,j,k)) > tiny) THEN - DO m = i, i+1 - my = - recons(2,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - ENDIF - - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - ! Apply monotone limiter to all reconstruction coefficients - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - - IF (order > 2) THEN - recons(3,i,j,k) = min_phi * recons(3,i,j,k) - recons(4,i,j,k) = min_phi * recons(4,i,j,k) - recons(5,i,j,k) = min_phi * recons(5,i,j,k) - ENDIF - - ENDDO - ENDDO - ENDDO - - - END SUBROUTINE PosDefABPGradient - -!------------------------------------------------------------------------------ -! SUBROUTINE MonotonizeABPGradient_New -! -! Description: -! Apply a monotonic filter to the calculated ABP gradient. -! -! Parameters: -! fcubehalo - Scalar field on the cubed sphere to use in reconstruction -! order - Order of the reconstruction -! recons (INOUT) - Array of reconstructed coefficients -! -! Remarks: -! This monotonizing scheme is similar to the one in MonotonizeABPGradient, -! except the second order derivatives are limited after the first order -! derivatives. -!------------------------------------------------------------------------------ - SUBROUTINE MonotonizeABPGradient_New(fcubehalo, order, recons) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, k, m, n - - REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi, linval - REAL (KIND=dbl_kind) :: disc, mx, my - - ! The first-order piecewise constant scheme is monotone by construction - IF (order == 1) THEN - RETURN - ENDIF - - ! Apply monotone limiting - DO k = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max, .FALSE.) - - ! Initialize the limiter - min_phi = one - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point, only taking into - ! account the linear component of the reconstruction. - value = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), local_min, local_max, min_phi) - ENDDO - ENDDO - - ! Apply monotone limiter to all reconstruction coefficients - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - - ! For the third order method, the minima and maxima may occur along - ! the line segments given by du/dx = 0 and du/dy = 0. Also check - ! for the presence of a maxima / minima of the quadratic within - ! the domain. - IF (order == 3) THEN - ! Reset the limiter - min_phi = one - - ! Calculate discriminant, which we use to determine the absolute - ! minima/maxima of the paraboloid - disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) - - ! Check if the quadratic is minimized within the element - IF (ABS(disc) > tiny) THEN - mx = - recons(5,i,j,k) * recons(2,i,j,k) & - + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) - my = - recons(5,i,j,k) * recons(1,i,j,k) & - + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) - - mx = mx / disc + abp_centroid(1,i,j) - my = my / disc + abp_centroid(2,i,j) - - IF ((mx - TAN(gp(i)) > -tiny) .AND. & - (mx - TAN(gp(i+1)) < tiny) .AND. & - (my - TAN(gp(j)) > -tiny) .AND. & - (my - TAN(gp(j+1)) < tiny) & - ) THEN - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDIF - ENDIF - - ! Check all potential minimizer points along element boundaries - IF (ABS(recons(5,i,j,k)) > tiny) THEN - - ! Left/right edge, intercept with du/dx = 0 - DO m = i, i+1 - my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / recons(5,i,j,k) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - - ! Top/bottom edge, intercept with du/dy = 0 - DO n = j, j+1 - mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Top/bottom edge, intercept with du/dx = 0 - IF (ABS(recons(3,i,j,k)) > tiny) THEN - DO n = j, j+1 - mx = - recons(1,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Left/right edge, intercept with du/dy = 0 - IF (ABS(recons(4,i,j,k)) > tiny) THEN - DO m = i, i+1 - my = - recons(2,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - ENDIF - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), gp(n), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - ENDDO - - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - WRITE (*,*) '2: ', min_phi - - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - recons(3,i,j,k) = min_phi * recons(3,i,j,k) - recons(4,i,j,k) = min_phi * recons(4,i,j,k) - recons(5,i,j,k) = min_phi * recons(5,i,j,k) - ENDIF - ENDDO - ENDDO - ENDDO - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient_NEL -! -! Description: -! Construct a non-equidistant linear reconstruction of the gradient -! within each element on an ABP grid. -! -! Parameters: -! fcubehalo - Scalar field on the ABP grid to use in reconstruction -! recons (OUT) - Array of reconstructed coefficients for total elements -! order - Order of the scheme (2 or 3) -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient_NEL(fcubehalo, recons, order) - -! USE CubedSphereTrans -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind) :: alpha1, alpha2, beta1, beta2 - REAL (KIND=dbl_kind) :: dx_left, dx_right, top_value, bot_value - - DO p = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - dx_left = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) - dx_right = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) - - recons(1,i,j,p) = & - (+ fcubehalo(i-1,j,p) * dx_right**2 & - - fcubehalo(i+1,j,p) * dx_left**2 & - - fcubehalo(i,j,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - - recons(2,i,j,p) = & - (+ fcubehalo(i,j-1,p) * dx_right**2 & - - fcubehalo(i,j+1,p) * dx_left**2 & - - fcubehalo(i,j,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - IF (order > 2) THEN - dx_left = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) - dx_right = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) - - recons(3,i,j,p) = & - (+ fcubehalo(i-1,j,p) * dx_right & - - fcubehalo(i+1,j,p) * dx_left & - - fcubehalo(i,j,p) * (dx_right - dx_left)) / & - (dx_right * dx_left * (dx_left - dx_right)) - - dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - - recons(4,i,j,p) = & - (+ fcubehalo(i,j-1,p) * dx_right & - - fcubehalo(i,j+1,p) * dx_left & - - fcubehalo(i,j,p) * (dx_right - dx_left)) / & - (dx_right * dx_left * (dx_left - dx_right)) - ENDIF - ENDDO - ENDDO - - IF (order > 2) THEN - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - dx_left = abp_centroid(1,i-1,j+1) - abp_centroid(1,i,j+1) - dx_right = abp_centroid(1,i+1,j+1) - abp_centroid(1,i,j+1) - - top_value = & - (+ fcubehalo(i-1,j+1,p) * dx_right**2 & - - fcubehalo(i+1,j+1,p) * dx_left**2 & - - fcubehalo(i,j+1,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - dx_left = abp_centroid(1,i-1,j-1) - abp_centroid(1,i,j-1) - dx_right = abp_centroid(1,i+1,j-1) - abp_centroid(1,i,j-1) - - bot_value = & - (+ fcubehalo(i-1,j-1,p) * dx_right**2 & - - fcubehalo(i+1,j-1,p) * dx_left**2 & - - fcubehalo(i,j-1,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - - recons(5,i,j,p) = & - (+ bot_value * dx_right**2 & - - top_value * dx_left**2 & - - recons(1,i,j,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - ENDDO - ENDDO - ENDIF - ENDDO - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient_NEP -! -! Description: -! Construct a non-equidistant parabolic reconstruction of the gradient -! within each element on an ABP grid. -! -! Parameters: -! fcubehalo - Scalar field on the ABP grid to use in reconstruction -! recons (OUT) - Array of reconstructed coefficients for total elements -! order - Order of the scheme (2 or 3) -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient_NEP(fcubehalo, recons, order) - - -! USE CubedSphereTrans -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind) :: x1, x2, x4, x5, y1, y2, y3, y4, y5 - - REAL (KIND=dbl_kind), DIMENSION(5) :: t, pa, denom - - DO p = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - ! X-direction reconstruction - x1 = abp_centroid(1,i-2,j) - abp_centroid(1,i,j) - x2 = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) - x4 = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) - x5 = abp_centroid(1,i+2,j) - abp_centroid(1,i,j) - - !IF (i == 1) THEN - ! x1 = piq - !ELSEIF (i == ncube_reconstruct-1) THEN - ! x5 = -piq - !ENDIF - - y1 = fcubehalo(i-2,j,p) - y2 = fcubehalo(i-1,j,p) - y3 = fcubehalo(i,j,p) - y4 = fcubehalo(i+1,j,p) - y5 = fcubehalo(i+2,j,p) - - denom(1) = (x2 - x1) * (x4 - x1) * (x5 - x1) * x1 - denom(2) = (x1 - x2) * (x4 - x2) * (x5 - x2) * x2 - denom(4) = (x1 - x4) * (x2 - x4) * (x5 - x4) * x4 - denom(5) = (x1 - x5) * (x2 - x5) * (x4 - x5) * x5 - - t(1) = x5 * x4 * x2 - t(2) = x5 * x4 * x1 - t(4) = x5 * x2 * x1 - t(5) = x4 * x2 * x1 - t(3) = (t(1) + t(2) + t(4) + t(5)) / (x1 * x2 * x4 * x5) - - pa(1) = x2 * x4 + x2 * x5 + x4 * x5 - pa(2) = x1 * x4 + x1 * x5 + x4 * x5 - pa(4) = x1 * x2 + x1 * x5 + x2 * x5 - pa(5) = x1 * x2 + x1 * x4 + x2 * x4 - pa(3) = (pa(1) + pa(2) + pa(4) + pa(5)) / (2.0 * x1 * x2 * x4 * x5) - - recons(1,i,j,p) = & - + y1 * t(1) / denom(1) & - + y2 * t(2) / denom(2) & - - y3 * t(3) & - + y4 * t(4) / denom(4) & - + y5 * t(5) / denom(5) - - IF (order > 2) THEN - recons(3,i,j,p) = & - - y1 * pa(1) / denom(1) & - - y2 * pa(2) / denom(2) & - + y3 * pa(3) & - - y4 * pa(4) / denom(4) & - - y5 * pa(5) / denom(5) - ENDIF - - ! Y-direction reconstruction - x1 = abp_centroid(2,i,j-2) - abp_centroid(2,i,j) - x2 = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - x4 = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - x5 = abp_centroid(2,i,j+2) - abp_centroid(2,i,j) - - !IF (j == 1) THEN - ! x1 = piq - !ELSEIF (j == ncube_reconstruct-1) THEN - ! x5 = -piq - !ENDIF - - y1 = fcubehalo(i,j-2,p) - y2 = fcubehalo(i,j-1,p) - y3 = fcubehalo(i,j,p) - y4 = fcubehalo(i,j+1,p) - y5 = fcubehalo(i,j+2,p) - - denom(1) = (x2 - x1) * (x4 - x1) * (x5 - x1) * x1 - denom(2) = (x1 - x2) * (x4 - x2) * (x5 - x2) * x2 - denom(4) = (x1 - x4) * (x2 - x4) * (x5 - x4) * x4 - denom(5) = (x1 - x5) * (x2 - x5) * (x4 - x5) * x5 - - t(1) = x5 * x4 * x2 - t(2) = x5 * x4 * x1 - t(4) = x5 * x2 * x1 - t(5) = x4 * x2 * x1 - t(3) = (t(1) + t(2) + t(4) + t(5)) / (x1 * x2 * x4 * x5) - - pa(1) = x2 * x4 + x2 * x5 + x4 * x5 - pa(2) = x1 * x4 + x1 * x5 + x4 * x5 - pa(4) = x1 * x2 + x1 * x5 + x2 * x5 - pa(5) = x1 * x2 + x1 * x4 + x2 * x4 - pa(3) = (pa(1) + pa(2) + pa(4) + pa(5)) / (2.0 * x1 * x2 * x4 * x5) - - recons(2,i,j,p) = & - + y1 * t(1) / denom(1) & - + y2 * t(2) / denom(2) & - - y3 * t(3) & - + y4 * t(4) / denom(4) & - + y5 * t(5) / denom(5) - - IF (order > 2) THEN - recons(4,i,j,p) = & - - y1 * pa(1) / denom(1) & - - y2 * pa(2) / denom(2) & - + y3 * pa(3) & - - y4 * pa(4) / denom(4) & - - y5 * pa(5) / denom(5) - recons(5,i,j,p) = 0.0 - ENDIF - - ENDDO - ENDDO - IF (order > 2) THEN - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - x1 = abp_centroid(1,i-1,j+1) - abp_centroid(1,i,j+1) - x2 = abp_centroid(1,i+1,j+1) - abp_centroid(1,i,j+1) - - y2 = (+ fcubehalo(i-1,j+1,p) * x2**2 & - - fcubehalo(i+1,j+1,p) * x1**2 & - - fcubehalo(i,j+1,p) * (x2**2 - x1**2)) / & - (x2 * x1 * (x2 - x1)) - - x1 = abp_centroid(1,i-1,j-1) - abp_centroid(1,i,j-1) - x2 = abp_centroid(1,i+1,j-1) - abp_centroid(1,i,j-1) - - y1 = (+ fcubehalo(i-1,j-1,p) * x2**2 & - - fcubehalo(i+1,j-1,p) * x1**2 & - - fcubehalo(i,j-1,p) * (x2**2 - x1**2)) / & - (x2 * x1 * (x2 - x1)) - - x1 = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - x2 = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - - recons(5,i,j,p) = & - (+ y1 * x2**2 & - - y2 * x1**2 & - - recons(1,i,j,p) * (x2**2 - x1**2)) / & - (x2 * x1 * (x2 - x1)) - - ENDDO - ENDDO - ENDIF - ENDDO - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient_PLM -! -! Description: -! Construct a piecewise linear reconstruction of the gradient within -! each element on an ABP grid. -! -! Parameters: -! fcubehalo - Scalar field on the ABP grid to use in reconstruction -! recons (OUT) - Array of reconstructed coefficients for total elements -! order - Order of the scheme (2 or 3) -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient_PLM(fcubehalo, recons, order) - -! USE CubedSphereTrans -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind) :: width - - ! ABP width between elements - width = pih / DBLE(ncube_reconstruct-1) - - DO p = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - ! df/dx - recons(1,i,j,p) = (fcubehalo(i+1,j,p) - fcubehalo(i-1,j,p)) / & - (2.0 * width) - - ! df/dy - recons(2,i,j,p) = (fcubehalo(i,j+1,p) - fcubehalo(i,j-1,p)) / & - (2.0 * width) - - ! Stretching - recons(1,i,j,p) = recons(1,i,j,p) / (one + abp_centroid(1,i,j)**2) - recons(2,i,j,p) = recons(2,i,j,p) / (one + abp_centroid(2,i,j)**2) - - ! Third order scheme - IF (order > 2) THEN - ! d^2f/dx^2 - recons(3,i,j,p) = & - (fcubehalo(i+1,j,p) - 2.0 * fcubehalo(i,j,p) & - + fcubehalo(i-1,j,p)) / (width * width) - - ! d^2f/dy^2 - recons(4,i,j,p) = & - (fcubehalo(i,j+1,p) - 2.0 * fcubehalo(i,j,p) & - + fcubehalo(i,j-1,p)) / (width * width) - - ! d^2f/dxdy - recons(5,i,j,p) = & - (+ fcubehalo(i+1,j+1,p) - fcubehalo(i-1,j+1,p) & - - fcubehalo(i+1,j-1,p) + fcubehalo(i-1,j-1,p) & - ) / (4.0 * width * width) - - ! Stretching - recons(3,i,j,p) = & - (- 2.0 * abp_centroid(1,i,j) * (one + abp_centroid(1,i,j)**2) * recons(1,i,j,p) & - + recons(3,i,j,p)) / (one + abp_centroid(1,i,j)**2)**2 - - recons(4,i,j,p) = & - (- 2.0 * abp_centroid(2,i,j) * (one + abp_centroid(2,i,j)**2) * recons(2,i,j,p) & - + recons(4,i,j,p)) / (one + abp_centroid(2,i,j)**2)**2 - - recons(5,i,j,p) = recons(5,i,j,p) / & - ((one + abp_centroid(1,i,j)**2) * (one + abp_centroid(2,i,j)**2)) - - ! Scaling - recons(3,i,j,p) = 0.5 * recons(3,i,j,p) - recons(4,i,j,p) = 0.5 * recons(4,i,j,p) - - ENDIF - ENDDO - ENDDO - ENDDO - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient_PPM -! -! Description: -! Construct a piecewise parabolic reconstruction of the gradient within -! each element on an ABP grid. -! -! Parameters: -! fcubehalo - Scalar field on the ABP grid to use in reconstruction -! recons (OUT) - Array of reconstructed coefficients for total elements -! order - Order of the scheme (2 or 3) -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient_PPM(fcubehalo, recons, order) - - -! USE CubedSphereTrans -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind) :: width - - ! ABP width between elements - width = pih / DBLE(ncube_reconstruct-1) - - DO p = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - ! df/dalfa - recons(1,i,j,p) = & - (+ fcubehalo(i+2,j,p) - 8.0 * fcubehalo(i+1,j,p) & - + 8.0 * fcubehalo(i-1,j,p) - fcubehalo(i-2,j,p)) / & - (- 12.0 * width) - - ! df/dbeta - recons(2,i,j,p) = & - (+ fcubehalo(i,j+2,p) - 8.0 * fcubehalo(i,j+1,p) & - + 8.0 * fcubehalo(i,j-1,p) - fcubehalo(i,j-2,p)) / & - (- 12.0 * width) - - ! Stretching - recons(1,i,j,p) = recons(1,i,j,p) / (one + abp_centroid(1,i,j)**2) - recons(2,i,j,p) = recons(2,i,j,p) / (one + abp_centroid(2,i,j)**2) - - ! Third order scheme - IF (order > 2) THEN - ! d^2f/dx^2 - recons(3,i,j,p) = (- fcubehalo(i+2,j,p) & - + 16_dbl_kind * fcubehalo(i+1,j,p) & - - 30_dbl_kind * fcubehalo(i,j,p) & - + 16_dbl_kind * fcubehalo(i-1,j,p) & - - fcubehalo(i-2,j,p) & - ) / (12_dbl_kind * width**2) - - ! d^2f/dy^2 - recons(4,i,j,p) = (- fcubehalo(i,j+2,p) & - + 16_dbl_kind * fcubehalo(i,j+1,p) & - - 30_dbl_kind * fcubehalo(i,j,p) & - + 16_dbl_kind * fcubehalo(i,j-1,p) & - - fcubehalo(i,j-2,p) & - ) / (12_dbl_kind * width**2) - - ! d^2f/dxdy - recons(5,i,j,p) = & - (+ fcubehalo(i+1,j+1,p) - fcubehalo(i-1,j+1,p) & - - fcubehalo(i+1,j-1,p) + fcubehalo(i-1,j-1,p) & - ) / (4.0 * width * width) - - ! Stretching - recons(3,i,j,p) = & - (- 2.0 * abp_centroid(1,i,j) * (one + abp_centroid(1,i,j)**2) * recons(1,i,j,p) & - + recons(3,i,j,p)) / (one + abp_centroid(1,i,j)**2)**2 - - recons(4,i,j,p) = & - (- 2.0 * abp_centroid(2,i,j) * (one + abp_centroid(2,i,j)**2) * recons(2,i,j,p) & - + recons(4,i,j,p)) / (one + abp_centroid(2,i,j)**2)**2 - - recons(5,i,j,p) = recons(5,i,j,p) / & - ((one + abp_centroid(1,i,j)**2) * (one + abp_centroid(2,i,j)**2)) - - ! Scaling - recons(3,i,j,p) = 0.5 * recons(3,i,j,p) - recons(4,i,j,p) = 0.5 * recons(4,i,j,p) - ENDIF - ENDDO - ENDDO - ENDDO - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient -! -! Description: -! Compute the reconstructed gradient in gnomonic coordinates for each -! ABP element. -! -! Parameters: -! fcube - Scalar field on the cubed sphere to use in reconstruction -! halomethod - Method for computing halo elements -! (0) Piecewise constant -! (1) Piecewise linear -! (3) Piecewise cubic -! recons_method - Method for computing the sub-grid scale gradient -! (0) Non-equidistant linear reconstruction -! (1) Non-equidistant parabolic reconstruction -! (2) Piecewise linear reconstruction with stretching -! (3) Piecewise parabolic reconstruction with stretching -! order - Order of the method being applied -! kmono - Apply monotone limiting (1) or not (0) -! recons (INOUT) - Array of reconstructed coefficients -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient( & - fcube, halomethod, recons_method, order, kmono, recons, kpd, kscheme) - -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(1:ncube_reconstruct-1, 1:ncube_reconstruct-1, 6), INTENT(IN) :: fcube - - INTEGER (KIND=int_kind), INTENT(IN) :: halomethod, recons_method - INTEGER (KIND=int_kind), INTENT(IN) :: order, kmono, kpd, kscheme - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: fcubehalo - - ! Report status - WRITE (*,*) '...Performing sub-grid scale reconstruction on ABP grid' - - ! Compute element haloes - WRITE(*,*) "fill cubed-sphere halo for reconstruction" - DO p = 1, 6 - IF (halomethod == 0) THEN - CALL CubedSphereFillHalo(fcube, fcubehalo, p, ncube_reconstruct, 2) - - ELSEIF (halomethod == 1) THEN - CALL CubedSphereFillHalo_Linear(fcube, fcubehalo, p, ncube_reconstruct) - - ELSEIF (halomethod == 3) THEN - !halomethod is always 3 in the standard CSLAM setup - CALL CubedSphereFillHalo_Cubic(fcube, fcubehalo, p, ncube_reconstruct) - ELSE - WRITE (*,*) 'Fatal Error: In ReconstructABPGradient' - WRITE (*,*) 'Invalid halo method: ', halomethod - WRITE (*,*) 'Halo method must be 0, 1 or 3.' - STOP - ENDIF - ENDDO - - ! Nonequidistant linear reconstruction - IF (recons_method == 1) THEN - CALL ReconstructABPGradient_NEL(fcubehalo, recons, order) - - ! Nonequidistant parabolic reconstruction (JCP paper) - ELSEIF (recons_method == 2) THEN - WRITE(*,*) "Nonequidistant parabolic reconstruction" - CALL ReconstructABPGradient_NEP(fcubehalo, recons, order) - - ! Piecewise linear reconstruction with rotation - ELSEIF (recons_method == 3) THEN - CALL ReconstructABPGradient_PLM(fcubehalo, recons, order) - - ! Piecewise parabolic reconstruction with rotation - ELSEIF (recons_method == 4) THEN - CALL ReconstructABPGradient_PPM(fcubehalo, recons, order) - - ELSE - WRITE(*,*) 'Fatal Error: In ReconstructABPGradient' - WRITE(*,*) 'Specified recons_method out of range. Given: ', recons_method - WRITE(*,*) 'Valid values: 1, 2, 3, 4' - STOP - ENDIF - - ! Apply monotone filtering - SELECT CASE (kmono) - CASE (0) !Do nothing - WRITE(*,*) "no filter applied to the reconstruction" - CASE (1) - - !Simplest filter: just scales the recon so it's extreme value - !is no bigger than the original values of this point and its neighbors - CALL MonotonizeABPGradient(fcubehalo, order, recons, .FALSE.) - - CASE (2) - - !Applies a more sophisticated Van Leer limiter (or, to be consistent, a filter) - CALL VanLeerLimit(fcubehalo, order, recons) - - CASE (3) - - !Applies a selective filter - CALL MonotonizeABPGradient(fcubehalo, order, recons, .TRUE.) - - CASE (4) - - !A filter that filters the linear part first - CALL MonotonizeABPGradient_New(fcubehalo, order, recons) - - CASE DEFAULT - WRITE(*,*) "Limiter kmono = ", kmono, " does not exist." - STOP 1201 - - END SELECT - - !Apply positive-definite filtering, if desired. This should - !ONLY be applied to the S-L method, since the flux-form - !method needs something different done. (In particular, using - !positive-definite reconstructions does not ensure that a flux- - !form scheme is positive definite, since we could get negatives - !when subtracting the resulting fluxes.) - !HOWEVER...we will allow this to be enabled, for testing purposes - IF ( (kpd > 0 .AND. kscheme == 2) .OR. (kpd == 2 .AND. kscheme == 4) ) THEN - WRITE(*,*) "applying positive deifnite constraint" - CALL PosDefABPGradient(fcubehalo, order, recons) - END IF - - - END SUBROUTINE - - - -!------------------------------------------------------------------------------ -!------------------------------------------------------------------------------ -! SUBROUTINE AdjustLimiter -! -! Description: -! Adjust the slope limiter based on new point values. -! -! Parameters: -! value - Point value -! element_value - Value at the center of the element -! local_max - Local maximum value of the function (from neighbours) -! local_min - Local minimum value of the function (to neighbours) -! min_phi (INOUT) - Slope limiter -!------------------------------------------------------------------------------ - SUBROUTINE AdjustLimiter(value, element_value, local_min, local_max, min_phi) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), INTENT(IN) :: value, element_value - REAL (KIND=dbl_kind), INTENT(IN) :: local_min, local_max - REAL (KIND=dbl_kind), INTENT(INOUT) :: min_phi - - ! Local variables - REAL (KIND=dbl_kind) :: phi = 0.0 - - IF ((local_min > element_value ) .OR. (local_max < element_value )) THEN - WRITE (*,*) 'Fatal Error: In AdjustLimiter' - WRITE (*,*) 'Local min: ', local_min, ' max: ', local_max - WRITE (*,*) 'Elemn: ', element_value - STOP - ENDIF - - ! Check against the minimum bound on the reconstruction - IF (value - element_value > tiny * value) THEN - phi = (local_max - element_value) / & - (value - element_value) - - min_phi = MIN(min_phi, phi) - - ! Check against the maximum bound on the reconstruction - ELSEIF (value - element_value < -tiny * value) THEN - phi = (local_min - element_value) / & - (value - element_value) - - min_phi = MIN(min_phi, phi) - - ENDIF - - IF (min_phi < 0.0) THEN - WRITE (*,*) 'Fatal Error: In AdjustLimiter' - WRITE (*,*) 'Min_Phi: ', min_phi - WRITE (*,*) 'Phi: ', phi - WRITE (*,*) 'Value: ', value - WRITE (*,*) 'Elemn: ', element_value - WRITE (*,*) 'Val-E: ', value - element_value - STOP - ENDIF - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE VanLeerLimit -! -! Description: -! Apply a 2D Van Leer-type limiter to a reconstruction. This acts ONLY -! on the linear part of the reconstruction , if any. If passed a PCoM -! reconstruction, this just returns without altering the recon. -! -! Parameters: -! fcubehalo - Scalar field on the cubed sphere to use in reconstruction -! order - Order of the reconstruction -! recons (INOUT) - Array of reconstructed coefficients -! -! Remarks: -! The Van Leer Limiter described here is given on pages 328--329 -! of Dukowicz and Baumgardner (2000). There are no guarantees -! on what it will do to PPM. -!------------------------------------------------------------------------------ - SUBROUTINE VanLeerLimit(fcubehalo, order, recons) - - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, k, m, n - - REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi, & - recon_min, recon_max - - ! The first-order piecewise constant scheme is monotone by construction - IF (order == 1) THEN - RETURN - ENDIF - - ! Apply monotone limiting - DO k = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) - - ! Initialize the limiter - min_phi = one - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element. For the Van Leer limiter, we - !wish to find BOTH of the reconstruction extrema. - recon_min = bignum - recon_max = -bignum - - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) - recon_min = MIN(recon_min, value) - recon_max = MAX(recon_max, value) - - ENDDO - ENDDO - - !This is equation 27 in Dukowicz and Baumgardner 2000 - min_phi = MIN(one, MAX(0.0, (local_min - fcubehalo(i,j,k))/(recon_min - fcubehalo(i,j,k))), & - MAX(0.0, (local_max - fcubehalo(i,j,k))/(recon_max - fcubehalo(i,j,k))) ) - - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - ! Apply monotone limiter to all reconstruction coefficients - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - - END DO - END DO - END DO - - - - - END SUBROUTINE VanLeerLimit - - !------------------------------------------------------------------------------ - ! SUBROUTINE EquiangularElementArea - ! - ! Description: - ! Compute the area of a single equiangular cubed sphere grid cell. - ! - ! Parameters: - ! alpha - Alpha coordinate of lower-left corner of grid cell - ! da - Delta alpha - ! beta - Beta coordinate of lower-left corner of grid cell - ! db - Delta beta - !------------------------------------------------------------------------------ - REAL(KIND=dbl_kind) FUNCTION EquiangularElementArea(alpha, da, beta, db) - - IMPLICIT NONE - -! REAL (kind=dbl_kind) :: EquiangularElementArea - REAL (kind=dbl_kind) :: alpha, da, beta, db - REAL (kind=dbl_kind) :: a1, a2, a3, a4 - - ! Calculate interior grid angles - a1 = EquiangularGridAngle(alpha , beta ) - a2 = pi - EquiangularGridAngle(alpha+da, beta ) - a3 = pi - EquiangularGridAngle(alpha , beta+db) - a4 = EquiangularGridAngle(alpha+da, beta+db) - - ! Area = r*r*(-2*pi+sum(interior angles)) - EquiangularElementArea = -pi2 + a1 + a2 + a3 + a4 - - END FUNCTION EquiangularElementArea - - !------------------------------------------------------------------------------ - ! FUNCTION EquiangularGridAngle - ! - ! Description: - ! Compute the angle between equiangular cubed sphere projection grid lines. - ! - ! Parameters: - ! alpha - Alpha coordinate of evaluation point - ! beta - Beta coordinate of evaluation point - !------------------------------------------------------------------------------ - REAL(KIND=dbl_kind) FUNCTION EquiangularGridAngle(alpha, beta) - IMPLICIT NONE - REAL (kind=dbl_kind) :: alpha, beta - EquiangularGridAngle = ACOS(-SIN(alpha) * SIN(beta)) - END FUNCTION EquiangularGridAngle - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereFillHalo -! -! Description: -! Recompute the cubed sphere data storage array, with the addition of a -! halo region around the specified panel. -! -! Parameters: -! parg - Current panel values -! zarg (OUT) - Calculated panel values with halo/ghost region -! np - Panel number -! ncube - Dimension of the cubed sphere (# of grid lines) -! nhalo - Number of halo/ghost elements around each panel -!------------------------------------------------------------------------------ - SUBROUTINE CubedSphereFillHalo(parg, zarg, np, ncube, nhalo) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & - INTENT(OUT) :: zarg - - INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube,nhalo - - ! Local variables - INTEGER (KIND=int_kind) :: jh,jhy - - !zarg = 0.0 !DBG - zarg(1:ncube-1,1:ncube-1,np) = parg(1:ncube-1,1:ncube-1,np) - - zarg(1-nhalo:0,1-nhalo:0,np) = 0.0 - zarg(1-nhalo:0,ncube:ncube+nhalo-1,np) = 0.0 - zarg(ncube:ncube+nhalo-1,1-nhalo:0,np) = 0.0 - zarg(ncube:ncube+nhalo-1,ncube:ncube+nhalo-1,np) = 0.0 - - ! Equatorial panels - IF (np==1) THEN - DO jh=1,nhalo - zarg(ncube+jh-1,1:ncube-1 ,1) = parg(jh ,1:ncube-1 ,2) !exchange right - zarg(1-jh ,1:ncube-1 ,1) = parg(ncube-jh ,1:ncube-1 ,4) !exchange left - zarg(1:ncube-1 ,1-jh ,1) = parg(1:ncube-1 ,ncube-jh ,5) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,1) = parg(1:ncube-1 ,jh ,6) !exchange over - ENDDO - - ELSE IF (np==2) THEN - DO jh=1,nhalo - zarg(1-jh ,1:ncube-1 ,2) = parg(ncube-jh,1:ncube-1 ,1) !exchange left - zarg(ncube+jh-1,1:ncube-1 ,2) = parg(jh ,1:ncube-1 ,3) !exchange right - zarg(1:ncube-1 ,1-jh ,2) = parg(ncube-jh,ncube-1:1:-1,5) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,2) = parg(ncube-jh,1:ncube-1 ,6) !exchange over - ENDDO - - ELSE IF (np==3) THEN - DO jh=1,nhalo - zarg(ncube+jh-1,1:ncube-1 ,3) = parg(jh ,1:ncube-1,4) !exchange right - zarg(1-jh ,1:ncube-1 ,3) = parg(ncube-jh ,1:ncube-1,2) !exchange left - zarg(1:ncube-1 ,1-jh ,3) = parg(ncube-1:1:-1,jh ,5) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,3) = parg(ncube-1:1:-1,ncube-jh ,6) !exchange over - ENDDO - - ELSE IF (np==4) THEN - DO jh=1,nhalo - zarg(1-jh ,1:ncube-1 ,4) = parg(ncube-jh,1:ncube-1 ,3) !exchange left - zarg(ncube+jh-1,1:ncube-1 ,4) = parg(jh ,1:ncube-1 ,1) !exchange right - zarg(1:ncube-1 ,1-jh ,4) = parg(jh ,1:ncube-1 ,5) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,4) = parg(jh ,ncube-1:1:-1,6) !exchange over - ENDDO - - ! Bottom panel - ELSE IF (np==5) THEN - DO jh=1,nhalo - zarg(1-jh ,1:ncube-1 ,5) = parg(1:ncube-1 ,jh ,4) !exchange left - zarg(ncube+jh-1,1:ncube-1 ,5) = parg(ncube-1:1:-1,jh ,2) !exchange right - zarg(1:ncube-1 ,1-jh ,5) = parg(ncube-1:1:-1,jh ,3) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,5) = parg(1:ncube-1 ,jh ,1) !exchange over - ENDDO - - ! Top panel - ELSE IF (np==6) THEN - DO jh=1,nhalo - zarg(1-jh ,1:ncube-1 ,6) = parg(ncube-1:1:-1,ncube-jh,4) !exchange left - zarg(ncube+jh-1,1:ncube-1 ,6) = parg(1:ncube-1 ,ncube-jh,2) !exchange right - zarg(1:ncube-1 ,1-jh ,6) = parg(1:ncube-1 ,ncube-jh,1) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,6) = parg(ncube-1:1:-1,ncube-jh,3) !exchange over - ENDDO - - ELSE - WRITE (*,*) 'Fatal error: In CubedSphereFillHalo' - WRITE (*,*) 'Invalid panel id ', np - STOP - ENDIF - - END SUBROUTINE CubedSphereFillHalo - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereFillHalo_Linear -! -! Description: -! Recompute the cubed sphere data storage array, with the addition of a -! 2-element halo region around the specified panel. Use linear order -! interpolation to translate between panels. -! -! Parameters: -! parg - Current panel values -! zarg (OUT) - Calculated panel values with halo/ghost region -! np - Panel number -! ncube - Dimension of the cubed sphere (# of grid lines) -!------------------------------------------------------------------------------ - SUBROUTINE CubedSphereFillHalo_Linear(parg, zarg, np, ncube) - -! USE CubedSphereTrans ! Cubed sphere transforms - - IMPLICIT NONE - - INTEGER (KIND=int_kind), PARAMETER :: nhalo = 2 - - REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & - INTENT(OUT) :: zarg - - INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube - - ! Local variables - INTEGER (KIND=int_kind) :: ii, iref, jj, ipanel, imin, imax - REAL (KIND=dbl_kind) :: width, lon, lat, beta, a, newbeta - - REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: prealpha - REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: newalpha - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6) :: yarg - - ! Use 0.0 order interpolation to begin - CALL CubedSphereFillHalo(parg, yarg, np, ncube, nhalo) - - zarg(:,:,np) = yarg(:,:,np) - - ! Calculate the overlapping alpha coordinates - width = pih / DBLE(ncube-1) - - DO jj = 1, nhalo - DO ii = 0, ncube - prealpha(ii, jj) = width * (DBLE(ii-1) + 0.5) - piq - beta = - width * (DBLE(jj-1) + 0.5) - piq - - CALL CubedSphereABPFromABP(prealpha(ii,jj), beta, 1, 5, & - newalpha(ii,jj), newbeta) - ENDDO - ENDDO - - ! Now apply linear interpolation to obtain edge components - DO jj = 1, nhalo - ! Reset the reference index - iref = 2 - - ! Interpolation can be applied to more elements after first band - IF (jj == 1) THEN - imin = 1 - imax = ncube-1 - ELSE - imin = 0 - imax = ncube - ENDIF - - ! Apply linear interpolation - DO ii = imin, imax - DO WHILE ((iref .NE. ncube-1) .AND. & - (newalpha(ii,jj) > prealpha(iref,jj))) - iref = iref + 1 - ENDDO - - IF ((newalpha(ii,jj) > prealpha(iref-1,jj)) .AND. & - (newalpha(ii,jj) .LE. prealpha(iref ,jj))) & - THEN - a = (newalpha(ii,jj) - prealpha(iref-1,jj)) / & - (prealpha(iref,jj) - prealpha(iref-1,jj)) - - IF ((a < 0.0) .OR. (a > one)) THEN - WRITE (*,*) 'FAIL in CubedSphereFillHalo_Linear' - WRITE (*,*) 'a out of bounds' - STOP - ENDIF - - ! Bottom edge of panel - zarg(ii, 1-jj, np) = & - (one - a) * yarg(iref-1, 1-jj, np) + & - a * yarg(iref, 1-jj, np) - - ! Left edge of panel - zarg(1-jj, ii, np) = & - (one - a) * yarg(1-jj, iref-1, np) + & - a * yarg(1-jj, iref, np) - - ! Top edge of panel - zarg(ii, ncube+jj-1, np) = & - (one - a) * yarg(iref-1, ncube+jj-1, np) + & - a * yarg(iref, ncube+jj-1, np) - - ! Right edge of panel - zarg(ncube+jj-1, ii, np) = & - (one - a) * yarg(ncube+jj-1, iref-1, np) + & - a * yarg(ncube+jj-1, iref, np) - - ELSE - WRITE (*,*) 'FAIL in CubedSphereFillHalo_Linear' - WRITE (*,*) 'ii: ', ii, ' jj: ', jj - WRITE (*,*) 'newalpha: ', newalpha(ii,jj) - WRITE (*,*) 'prealpha: ', prealpha(iref-1,jj), '-', prealpha(iref,jj) - STOP - ENDIF - ENDDO - ENDDO - - ! Fill in corner bits - zarg(0, 0, np) = & - 0.25 * (zarg(1,0,np) + zarg(0,1,np) + & - zarg(-1,0,np) + zarg(0,-1,np)) - zarg(0, ncube, np) = & - 0.25 * (zarg(0,ncube-1,np) + zarg(0,ncube+1,np) + & - zarg(-1,ncube,np) + zarg(1,ncube,np)) - zarg(ncube, 0, np) = & - 0.25 * (zarg(ncube-1,0,np) + zarg(ncube+1,0,np) + & - zarg(ncube,-1,np) + zarg(ncube,1,np)) - zarg(ncube, ncube, np) = & - 0.25 * (zarg(ncube-1,ncube,np) + zarg(ncube+1,ncube,np) + & - zarg(ncube,ncube-1,np) + zarg(ncube,ncube+1,np)) - - END SUBROUTINE CubedSphereFillHalo_Linear - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereFillHalo_Cubic -! -! Description: -! Recompute the cubed sphere data storage array, with the addition of a -! 2-element halo region around the specified panel. Use higher order -! interpolation to translate between panels. -! -! Parameters: -! parg - Current panel values -! zarg (OUT) - Calculated panel values with halo/ghost region -! np - Panel number -! ncube - Dimension of the cubed sphere (# of grid lines) -!------------------------------------------------------------------------------ - SUBROUTINE CubedSphereFillHalo_Cubic(parg, zarg, np, ncube) - -! USE CubedSphereTrans ! Cubed sphere transforms -! USE MathUtils ! Has function for 1D cubic interpolation - - IMPLICIT NONE - - INTEGER (KIND=int_kind), PARAMETER :: nhalo = 2 - - REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & - INTENT(OUT) :: zarg - - INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube - - ! Local variables - INTEGER (KIND=int_kind) :: ii, iref, ibaseref, jj, ipanel, imin, imax - REAL (KIND=dbl_kind) :: width, lon, lat, beta, a, newbeta - - REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: prealpha - REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: newalpha - REAL (KIND=dbl_kind), DIMENSION(1:4) :: C, D, X - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6) :: yarg - - ! Use 0.0 order interpolation to begin - CALL CubedSphereFillHalo(parg, yarg, np, ncube, nhalo) - - zarg(:,:,np) = yarg(:,:,np) - - ! Calculate the overlapping alpha coordinates - width = pih / DBLE(ncube-1) - - DO jj = 1, nhalo - DO ii = 0, ncube - ! - ! alpha,beta for the cell center (extending the panel) - ! - prealpha(ii, jj) = width * (DBLE(ii-1) + 0.5) - piq - beta = - width * (DBLE(jj-1) + 0.5) - piq - - CALL CubedSphereABPFromABP(prealpha(ii,jj), beta, 1, 5, & - newalpha(ii,jj), newbeta) - ENDDO - ENDDO - - ! Now apply cubic interpolation to obtain edge components - DO jj = 1, nhalo - ! Reset the reference index, which gives the element in newalpha that - ! is closest to ii, looking towards larger values of alpha. - iref = 2 - - ! Interpolation can be applied to more elements after first band -! IF (jj == 1) THEN -! imin = 1 -! imax = ncube-1 -! ELSE - imin = 0 - imax = ncube -! ENDIF - - ! Apply cubic interpolation - DO ii = imin, imax - DO WHILE ((iref .NE. ncube-1) .AND. & - (newalpha(ii,jj) > prealpha(iref,jj))) - iref = iref + 1 - ENDDO - - ! Smallest index for cubic interpolation - apply special consideration - IF (iref == 2) THEN - ibaseref = iref-1 - - ! Largest index for cubic interpolation - apply special consideration - ELSEIF (iref == ncube-1) THEN - ibaseref = iref-3 - - ! Normal range - ELSE - ibaseref = iref-2 - ENDIF - - ! Bottom edge of panel - zarg(ii, 1-jj, np) = & - CUBIC_EQUISPACE_INTERP( & - width, newalpha(ii,jj) - prealpha(ibaseref,jj), & - yarg(ibaseref:ibaseref+3, 1-jj, np)) - - ! Left edge of panel - zarg(1-jj, ii, np) = & - CUBIC_EQUISPACE_INTERP( & - width, newalpha(ii,jj) - prealpha(ibaseref,jj), & - yarg(1-jj, ibaseref:ibaseref+3, np)) - - ! Top edge of panel - zarg(ii, ncube+jj-1, np) = & - CUBIC_EQUISPACE_INTERP( & - width, newalpha(ii,jj) - prealpha(ibaseref,jj), & - yarg(ibaseref:ibaseref+3, ncube+jj-1, np)) - - ! Right edge of panel - zarg(ncube+jj-1, ii, np) = & - CUBIC_EQUISPACE_INTERP( & - width, newalpha(ii,jj) - prealpha(ibaseref,jj), & - yarg(ncube+jj-1, ibaseref:ibaseref+3, np)) - - ENDDO - ENDDO - - ! Fill in corner bits - zarg(0, 0, np) = & - 0.25 * (zarg(1,0,np) + zarg(0,1,np) + & - zarg(-1,0,np) + zarg(0,-1,np)) - zarg(0, ncube, np) = & - 0.25 * (zarg(0,ncube-1,np) + zarg(0,ncube+1,np) + & - zarg(-1,ncube,np) + zarg(1,ncube,np)) - zarg(ncube, 0, np) = & - 0.25 * (zarg(ncube-1,0,np) + zarg(ncube+1,0,np) + & - zarg(ncube,-1,np) + zarg(ncube,1,np)) - zarg(ncube, ncube, np) = & - 0.25 * (zarg(ncube-1,ncube,np) + zarg(ncube+1,ncube,np) + & - zarg(ncube,ncube-1,np) + zarg(ncube,ncube+1,np)) - - END SUBROUTINE CubedSphereFillHalo_Cubic - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereABPFromABP -! -! Description: -! Determine the (alpha,beta,idest) coordinate of a source point on -! panel isource. -! -! Parameters: -! alpha_in - Alpha coordinate in -! beta_in - Beta coordinate in -! isource - Source panel -! idest - Destination panel -! alpha_out (OUT) - Alpha coordinate out -! beta_out (OUT) - Beta coordiante out -!------------------------------------------------------------------------------ - SUBROUTINE CubedSphereABPFromABP(alpha_in, beta_in, isource, idest, & - alpha_out, beta_out) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), INTENT(IN) :: alpha_in, beta_in - INTEGER (KIND=int_kind), INTENT(IN) :: isource, idest - REAL (KIND=dbl_kind), INTENT(OUT) :: alpha_out, beta_out - - ! Local variables - REAL (KIND=dbl_kind) :: a1, b1 - REAL (KIND=dbl_kind) :: xx, yy, zz - REAL (KIND=dbl_kind) :: sx, sy, sz - - ! Convert to relative Cartesian coordinates - a1 = TAN(alpha_in) - b1 = TAN(beta_in) - - sz = (one + a1 * a1 + b1 * b1)**(-0.5) - sx = sz * a1 - sy = sz * b1 - - ! Convert to full Cartesian coordinates - IF (isource == 6) THEN - yy = sx; xx = -sy; zz = sz - - ELSEIF (isource == 5) THEN - yy = sx; xx = sy; zz = -sz - - ELSEIF (isource == 1) THEN - yy = sx; zz = sy; xx = sz - - ELSEIF (isource == 3) THEN - yy = -sx; zz = sy; xx = -sz - - ELSEIF (isource == 2) THEN - xx = -sx; zz = sy; yy = sz - - ELSEIF (isource == 4) THEN - xx = sx; zz = sy; yy = -sz - - ELSE - WRITE(*,*) 'Fatal Error: Source panel invalid in CubedSphereABPFromABP' - WRITE(*,*) 'panel = ', isource - STOP - ENDIF - - ! Convert to relative Cartesian coordinates on destination panel - IF (idest == 6) THEN - sx = yy; sy = -xx; sz = zz - - ELSEIF (idest == 5) THEN - sx = yy; sy = xx; sz = -zz - - ELSEIF (idest == 1) THEN - sx = yy; sy = zz; sz = xx - - ELSEIF (idest == 3) THEN - sx = -yy; sy = zz; sz = -xx - - ELSEIF (idest == 2) THEN - sx = -xx; sy = zz; sz = yy - - ELSEIF (idest == 4) THEN - sx = xx; sy = zz; sz = -yy - - ELSE - WRITE(*,*) 'Fatal Error: Dest panel invalid in CubedSphereABPFromABP' - WRITE(*,*) 'panel = ', idest - STOP - ENDIF - IF (sz < 0) THEN - WRITE(*,*) 'Fatal Error: In CubedSphereABPFromABP' - WRITE(*,*) 'Invalid relative Z coordinate' - STOP - ENDIF - - ! Use panel information to calculate (alpha, beta) coords - alpha_out = ATAN(sx / sz) - beta_out = ATAN(sy / sz) - - END SUBROUTINE - - -!------------------------------------------------------------------------------ -! FUNCTION CUBIC_EQUISPACE_INTERP -! -! Description: -! Apply cubic interpolation on the specified array of values, where all -! points are equally spaced. -! -! Parameters: -! dx - Spacing of points -! x - X coordinate where interpolation is to be applied -! y - Array of 4 values = f(x + k * dx) where k = 0,1,2,3 -!------------------------------------------------------------------------------ - FUNCTION CUBIC_EQUISPACE_INTERP(dx, x, y) - - IMPLICIT NONE - - REAL (KIND=dbl_kind) :: CUBIC_EQUISPACE_INTERP - REAL (KIND=dbl_kind) :: dx, x - REAL (KIND=dbl_kind), DIMENSION(1:4) :: y - - CUBIC_EQUISPACE_INTERP = & - (-y(1) / (6.0 * dx**3)) * (x - dx) * (x - 2.0 * dx) * (x - 3.0 * dx) + & - ( y(2) / (2.0 * dx**3)) * (x) * (x - 2.0 * dx) * (x - 3.0 * dx) + & - (-y(3) / (2.0 * dx**3)) * (x) * (x - dx) * (x - 3.0 * dx) + & - ( y(4) / (6.0 * dx**3)) * (x) * (x - dx) * (x - 2.0 * dx) - - END FUNCTION CUBIC_EQUISPACE_INTERP - -! FUNCTION I_10_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind) :: I_10_AB -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! I_10_ab = -ASINH(COS(alpha) * TAN(beta)) -! END FUNCTION I_10_AB -!! -! -! REAL (KIND=dbl_kind) FUNCTION I_01_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! I_01_ab = -ASINH(COS(beta) * TAN(alpha)) -! END FUNCTION I_01_AB -! -! REAL (KIND=dbl_kind) FUNCTION I_20_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! -! I_20_ab = TAN(beta)*ASINH(COS(beta)*TAN(alpha))+ACOS(SIN(alpha)*SIN(beta)) -! END FUNCTION I_20_AB -! -! REAL (KIND=dbl_kind) FUNCTION I_02_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! -! I_02_ab = TAN(alpha)*ASINH(TAN(beta)*COS(alpha))+ACOS(SIN(alpha)*SIN(beta)) -! END FUNCTION I_02_AB -! -! REAL (KIND=dbl_kind) FUNCTION I_11_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! -! I_11_ab = -SQRT(1.0+TAN(alpha)**2+TAN(beta)**2) -! END FUNCTION I_11_AB -! - - -END MODULE reconstruct - diff --git a/tools/topo_tool/cube_to_target/remap.F90 b/tools/topo_tool/cube_to_target/remap.F90 deleted file mode 100644 index b56b7fd493..0000000000 --- a/tools/topo_tool/cube_to_target/remap.F90 +++ /dev/null @@ -1,1561 +0,0 @@ -MODULE remap - INTEGER, PARAMETER :: & - int_kind = KIND(1), & - real_kind = SELECTED_REAL_KIND(p=14,r=100),& - dbl_kind = selected_real_kind(13) - - INTEGER :: nc,nhe - -! LOGICAL, PARAMETER:: ldbgr_r = .FALSE. - LOGICAL :: ldbgr - LOGICAL :: ldbg_global - - REAL(kind=real_kind), PARAMETER :: & - one = 1.0 ,& - aa = 1.0 ,& - tiny= 1.0E-9 ,& - bignum = 1.0E20 - REAL (KIND=dbl_kind), parameter :: fuzzy_width = 10.0*tiny !CAM-SE add - - contains - - - subroutine compute_weights_cell(xcell_in,ycell_in,jx,jy,nreconstruction,xgno,ygno,& - jx_min, jx_max, jy_min, jy_max,tmp,& - ngauss,gauss_weights,abscissae,weights,weights_eul_index,jcollect,jmax_segments,& - nc_in,nhe_in,nvertex,ldbg) - - implicit none - integer (kind=int_kind) , intent(in):: nreconstruction, jx,jy,ngauss,jmax_segments - real (kind=real_kind) , dimension(0:nvertex+1) :: xcell_in,ycell_in -! real (kind=real_kind) , dimension(0:5), intent(in):: xcell_in,ycell_in - integer (kind=int_kind), intent(in) :: nc_in,nhe_in,nvertex - logical, intent(in) :: ldbg - ! - ! ipanel is just for debugging - ! - integer (kind=int_kind), intent(in) :: jx_min, jy_min, jx_max, jy_max - real (kind=real_kind), dimension(-nhe_in:nc_in+2+nhe_in), intent(in) :: xgno - real (kind=real_kind), dimension(-nhe_in:nc_in+2+nhe_in), intent(in) :: ygno - ! - ! for Gaussian quadrature - ! - real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae - ! - ! boundaries of domain - ! - real (kind=real_kind):: tmp - ! - ! Number of Eulerian sub-cell integrals for the cell in question - ! - integer (kind=int_kind), intent(out) :: jcollect - ! - ! local workspace - ! - ! - ! max number of line segments is: - ! - ! (number of longitudes)*(max average number of crossings per line segment = 3)*ncube*2 - ! - real (kind=real_kind) , & - dimension(jmax_segments,nreconstruction), intent(out) :: weights - integer (kind=int_kind), & - dimension(jmax_segments,2), intent(out) :: weights_eul_index - - real (kind=real_kind), dimension(0:3) :: x,y - integer (kind=int_kind),dimension(0:5) :: jx_eul, jy_eul - integer (kind=int_kind) :: jsegment,i - ! - ! variables for registering crossings with Eulerian latitudes and longitudes - ! - integer (kind=int_kind) :: jcross_lat, iter - ! - ! max. crossings per side is 2*nhe - ! - real (kind=real_kind), & - dimension(jmax_segments,2) :: r_cross_lat - integer (kind=int_kind), & - dimension(jmax_segments,2) :: cross_lat_eul_index - real (kind=real_kind) , dimension(1:nvertex) :: xcell,ycell - - real (kind=real_kind) :: eps - - ldbg_global = ldbg - ldbgr = ldbg - - nc = nc_in - nhe = nhe_in - - xcell = xcell_in(1:nvertex) - ycell = ycell_in(1:nvertex) - - - ! - ! this is to avoid ill-conditioning problems - ! - eps = 1.0E-9 - - jsegment = 0 - weights = 0.0D0 - jcross_lat = 0 - ! - !********************** - ! - ! Integrate cell sides - ! - !********************** - - - IF (jx<-nhe.OR.jx>nc+1+nhe.OR.jy<-nhe.OR.jy>nc+1+nhe) THEN - WRITE(*,*) "jx,jy,-nhe,nc+1+nhe",jx,jy,-nhe,nc+1+nhe - STOP - END IF - - - call side_integral(xcell,ycell,nvertex,jsegment,jmax_segments,& - weights,weights_eul_index,nreconstruction,jx,jy,xgno,ygno,jx_min, jx_max, jy_min, jy_max,& - ngauss,gauss_weights,abscissae,& - jcross_lat,r_cross_lat,cross_lat_eul_index) - - ! - !********************** - ! - ! Do inner integrals - ! - !********************** - ! - call compute_inner_line_integrals_lat_nonconvex(r_cross_lat,cross_lat_eul_index,& - jcross_lat,jsegment,jmax_segments,xgno,jx_min, jx_max, jy_min, jy_max,& - weights,weights_eul_index,& - nreconstruction,ngauss,gauss_weights,abscissae) - ! - ! collect line-segment that reside in the same Eulerian cell - ! - if (jsegment>0) then - call collect(weights,weights_eul_index,nreconstruction,jcollect,jsegment,jmax_segments) - ! - ! DBG - ! - tmp=0.0 - do i=1,jcollect - tmp=tmp+weights(i,1) - enddo - - IF (abs(tmp)>0.01) THEN - WRITE(*,*) "sum of weights too large",tmp - stop - END IF - IF (tmp<-1.0E-9) THEN - WRITE(*,*) "sum of weights is negative - negative area?",tmp,jx,jy - ! ldbgr=.TRUE. - stop - END IF - else - jcollect = 0 - end if - end subroutine compute_weights_cell - - - ! - !**************************************************************************** - ! - ! organize data and store it - ! - !**************************************************************************** - ! - subroutine collect(weights,weights_eul_index,nreconstruction,jcollect,jsegment,jmax_segments) - implicit none - integer (kind=int_kind) , intent(in) :: nreconstruction - real (kind=real_kind) , dimension(jmax_segments,nreconstruction), intent(inout) :: weights - integer (kind=int_kind), dimension(jmax_segments,2 ), intent(inout) :: weights_eul_index - integer (kind=int_kind), INTENT(OUT ) :: jcollect - integer (kind=int_kind), INTENT(IN ) :: jsegment,jmax_segments - ! - ! local workspace - ! - integer (kind=int_kind) :: imin, imax, jmin, jmax, i,j,k,h - logical :: ltmp - - real (kind=real_kind) , dimension(jmax_segments,nreconstruction) :: weights_out - integer (kind=int_kind), dimension(jmax_segments,2 ) :: weights_eul_index_out - - weights_out = 0.0D0 - weights_eul_index_out = -100 - - imin = MINVAL(weights_eul_index(1:jsegment,1)) - imax = MAXVAL(weights_eul_index(1:jsegment,1)) - jmin = MINVAL(weights_eul_index(1:jsegment,2)) - jmax = MAXVAL(weights_eul_index(1:jsegment,2)) - - ltmp = .FALSE. - - jcollect = 1 - - do j=jmin,jmax - do i=imin,imax - do k=1,jsegment - if (weights_eul_index(k,1)==i.AND.weights_eul_index(k,2)==j) then - weights_out(jcollect,1:nreconstruction) = & - weights_out(jcollect,1:nreconstruction) + weights(k,1:nreconstruction) - ltmp = .TRUE. - h = k - endif - enddo - if (ltmp) then - weights_eul_index_out(jcollect,:) = weights_eul_index(h,:) - jcollect = jcollect+1 - endif - ltmp = .FALSE. - enddo - enddo - jcollect = jcollect-1 - weights = weights_out - weights_eul_index = weights_eul_index_out - end subroutine collect - ! - !***************************************************************************************** - ! - ! - ! - !***************************************************************************************** - ! - subroutine compute_inner_line_integrals_lat(r_cross_lat,cross_lat_eul_index,& - jcross_lat,jsegment,jmax_segments,xgno,jx_min,jx_max,jy_min, jy_max,weights,weights_eul_index,& - nreconstruction,ngauss,gauss_weights,abscissae)!phl add jx_min etc. - implicit none - ! - ! for Gaussian quadrature - ! - real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae - ! - ! variables for registering crossings with Eulerian latitudes and longitudes - ! - integer (kind=int_kind), intent(in):: jcross_lat, jmax_segments,nreconstruction,ngauss - integer (kind=int_kind), intent(inout):: jsegment - ! - ! max. crossings per side is 2*nhe - ! - real (kind=real_kind), & - dimension(jmax_segments,2), intent(in):: r_cross_lat - integer (kind=int_kind), & - dimension(jmax_segments,2), intent(in):: cross_lat_eul_index - integer (kind=int_kind), intent(in) ::jx_min, jx_max, jy_min, jy_max - real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: xgno - real (kind=real_kind) , & - dimension(jmax_segments,nreconstruction), intent(inout) :: weights - integer (kind=int_kind), & - dimension(jmax_segments,2), intent(inout) :: weights_eul_index - real (kind=real_kind) , dimension(nreconstruction) :: weights_tmp - - integer (kind=int_kind) :: imin, imax, jmin, jmax, i,j,k, isgn, h, eul_jx, eul_jy - integer (kind=int_kind) :: idx_start_y,idx_end_y - logical :: ltmp,lcontinue - real (kind=real_kind), dimension(2) :: rstart,rend,rend_tmp - real (kind=real_kind), dimension(2) :: xseg, yseg -5 FORMAT(10e14.6) - - - if (jcross_lat>0) then - do i=MINVAL(cross_lat_eul_index(1:jcross_lat,2)),MAXVAL(cross_lat_eul_index(1:jcross_lat,2)) - ! - ! find "first" crossing with Eulerian cell i - ! - do k=1,jcross_lat - if (cross_lat_eul_index(k,2)==i) exit - enddo - do j=k+1,jcross_lat - ! - ! find "second" crossing with Eulerian cell i - ! - if (cross_lat_eul_index(j,2)==i) then - if (r_cross_lat(k,1)0) then - do i=MINVAL(cross_lat_eul_index(1:jcross_lat,2)),MAXVAL(cross_lat_eul_index(1:jcross_lat,2)) - ! WRITE(*,*) "looking at latitude ",i !xxxx - count = 1 - ! - ! find all crossings with Eulerian latitude i - ! - do k=1,jcross_lat - if (cross_lat_eul_index(k,2)==i) then - ! WRITE(*,*) "other crossings with latitude",i ," is ",k!xxxx - r_cross_lat_seg (count,:) = r_cross_lat (k,:) - cross_lat_eul_index_seg(count,:) = cross_lat_eul_index(k,:) - - IF (ldbg_global) then - WRITE(*,*) r_cross_lat_seg(count,1),r_cross_lat_seg(count,2) - WRITE(*,*) " " - END IF - count = count+1 - end if - enddo - count = count-1 - IF (ABS((count/2)-DBLE(count)/2.0)1000) THEN - WRITE(*,*) "search not converging",iter - STOP - END IF - lsame_cell_x = (x(2).GE.xgno(jx_eul).AND.x(2).LE.xgno(jx_eul+1)) - lsame_cell_y = (y(2).GE.ygno(jy_eul).AND.y(2).LE.ygno(jy_eul+1)) -! IF (ldbgr) WRITE(*,*) "lsame_cell_x,lsame_cell_y=",lsame_cell_x,lsame_cell_y - IF (lsame_cell_x.AND.lsame_cell_y) THEN - ! - !**************************** - ! - ! same cell integral - ! - !**************************** - ! -! IF (ldbgr) WRITE(*,*) "same cell integral",jx_eul,jy_eul - xseg(1) = x(1); yseg(1) = y(1); xseg(2) = x(2); yseg(2) = y(2) - jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; - lcontinue = .FALSE. - ! - ! prepare for next side if (x(2),y(2)) is on a grid line - ! - IF (x(2).EQ.xgno(jx_eul+1).AND.x(3)>xgno(jx_eul+1)) THEN - ! - ! cross longitude jx_eul+1 - ! -! IF (ldbgr) WRITE(*,*) "cross longitude",jx_eul+1 - jx_eul=jx_eul+1 - ELSE IF (x(2).EQ.xgno(jx_eul ).AND.x(3)ygno(jy_eul+1)) THEN - ! - ! register crossing with latitude: line-segments point Northward - ! - jcross_lat = jcross_lat + 1 - jy_eul = jy_eul + 1 -! IF (ldbgr) WRITE(*,*) "cross latitude",jy_eul - cross_lat_eul_index(jcross_lat,1) = jx_eul - cross_lat_eul_index(jcross_lat,2) = jy_eul - r_cross_lat(jcross_lat,1) = x(2) - r_cross_lat(jcross_lat,2) = y(2) - ELSE IF (y(2).EQ.ygno(jy_eul ).AND.y(3)y(1) else "0" - ysgn2 = INT(SIGN(1.0D0,y(2)-y(1))) !"1" if y(2)>y(1) else "-1" - ! - !******************************************************************************* - ! - ! there is at least one crossing with latitudes but no crossing with longitudes - ! - !******************************************************************************* - ! - yeul = ygno(jy_eul+ysgn1) - IF (x(1).EQ.x(2)) THEN - ! - ! line segment is parallel to longitude (infinite slope) - ! -! IF (ldbgr) WRITE(*,*) "line segment parallel to longitude" - xcross = x(1) - ELSE - slope = (y(2)-y(1))/(x(2)-x(1)) - xcross = x_cross_eul_lat(x(1),y(1),yeul,slope) - ! - ! constrain crossing to be "physically" possible - ! - xcross = MIN(MAX(xcross,xgno(jx_eul)),xgno(jx_eul+1)) - - -! IF (ldbgr) WRITE(*,*) "cross latitude" - ! - ! debugging - ! - IF (xcross.GT.xgno(jx_eul+1).OR.xcross.LT.xgno(jx_eul)) THEN - WRITE(*,*) "xcross is out of range",jx,jy - WRITE(*,*) "xcross-xgno(jx_eul+1), xcross-xgno(jx_eul))",& - xcross-xgno(jx_eul+1), xcross-ygno(jx_eul) - STOP - END IF - END IF - xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xcross; yseg(2) = yeul - jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; - ! - ! prepare for next iteration - ! - x(0) = x(1); y(0) = y(1); x(1) = xcross; y(1) = yeul; jy_eul = jy_eul+ysgn2 - ! - ! register crossing with latitude - ! - jcross_lat = jcross_lat+1 - cross_lat_eul_index(jcross_lat,1) = jx_eul - if (ysgn2>0) then - cross_lat_eul_index(jcross_lat,2) = jy_eul - else - cross_lat_eul_index(jcross_lat,2) = jy_eul+1 - end if - r_cross_lat(jcross_lat,1) = xcross - r_cross_lat(jcross_lat,2) = yeul - ELSE IF (lsame_cell_y) THEN -! IF (ldbgr) WRITE(*,*) "same cell y" - ! - !******************************************************************************* - ! - ! there is at least one crossing with longitudes but no crossing with latitudes - ! - !******************************************************************************* - ! - xsgn1 = (1+INT(SIGN(1.0D0,x(2)-x(1))))/2 !"1" if x(2)>x(1) else "0" - xsgn2 = INT(SIGN(1.0D0,x(2)-x(1))) !"1" if x(2)>x(1) else "-1" - xeul = xgno(jx_eul+xsgn1) -! IF (ldbgr) WRITE(*,*) " crossing longitude",jx_eul+xsgn1 - IF (ABS(x(2)-x(1))x(1) else "0" - xsgn2 = (INT(SIGN(1.0D0,x(2)-x(1)))) !"1" if x(2)>x(1) else "0" - xeul = xgno(jx_eul+xsgn1) - ysgn1 = (1+INT(SIGN(1.0D0,y(2)-y(1))))/2 !"1" if y(2)>y(1) else "0" - ysgn2 = INT(SIGN(1.0D0,y(2)-y(1))) !"1" if y(2)>y(1) else "-1" - yeul = ygno(jy_eul+ysgn1) - - slope = (y(2)-y(1))/(x(2)-x(1)) - IF (ABS(x(2)-x(1))0.AND.xcross.LE.xeul).OR.(xsgn2<0.AND.xcross.GE.xeul)) THEN - ! - ! cross latitude - ! -! IF (ldbgr) WRITE(*,*) "crossing latitude",jy_eul+ysgn1 - xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xcross; yseg(2) = yeul - jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; - ! - ! prepare for next iteration - ! - x(0) = x(1); y(0) = y(1); x(1) = xcross; y(1) = yeul; jy_eul = jy_eul+ysgn2 - ! - ! register crossing with latitude - ! - jcross_lat = jcross_lat+1 - cross_lat_eul_index(jcross_lat,1) = jx_eul - if (ysgn2>0) then - cross_lat_eul_index(jcross_lat,2) = jy_eul - else - cross_lat_eul_index(jcross_lat,2) = jy_eul+1 - end if - r_cross_lat(jcross_lat,1) = xcross - r_cross_lat(jcross_lat,2) = yeul - ELSE - ! - ! cross longitude - ! -! IF (ldbgr) WRITE(*,*) "crossing longitude",jx_eul+xsgn1 - xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xeul; yseg(2) = ycross - jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; - ! - ! prepare for next iteration - ! - x(0) = x(1); y(0) = y(1); x(1) = xeul; y(1) = ycross; jx_eul = jx_eul+xsgn2 - END IF - - END IF - END IF - ! - ! register line-segment (don't register line-segment if outside of panel) - ! - if (jx_eul_tmp>=jx_min.AND.jy_eul_tmp>=jy_min.AND.& - jx_eul_tmp<=jx_max-1.AND.jy_eul_tmp<=jy_max-1) then - ! jx_eul_tmp<=jx_max-1.AND.jy_eul_tmp<=jy_max-1.AND.side_count<3) then - jsegment=jsegment+1 - weights_eul_index(jsegment,1) = jx_eul_tmp - weights_eul_index(jsegment,2) = jy_eul_tmp - call get_weights_gauss(weights(jsegment,1:nreconstruction),& - xseg,yseg,nreconstruction,ngauss,gauss_weights,abscissae) - -! if (ldbg_global) then -! OPEN(unit=40, file='side_integral.dat',status='old',access='append') -! WRITE(40,*) xseg(1),yseg(1) -! WRITE(40,*) xseg(2),yseg(2) -! WRITE(40,*) " " -! CLOSE(40) -! end if - - - jdbg=jdbg+1 - - if (xseg(1).EQ.xseg(2))then - slope = bignum - else if (abs(yseg(1) -yseg(2))0) THEN - compute_slope = (y(2)-y(1))/(x(2)-x(1)) - else - compute_slope = bignum - end if - end function compute_slope - - real (kind=real_kind) function y_cross_eul_lon(x,y,xeul,slope) - implicit none - real (kind=real_kind), intent(in) :: x,y - real (kind=real_kind) , intent(in) :: xeul,slope - ! line: y=a*x+b - real (kind=real_kind) :: a,b - b = y-slope*x - y_cross_eul_lon = slope*xeul+b - end function y_cross_eul_lon - - real (kind=real_kind) function x_cross_eul_lat(x,y,yeul,slope) - implicit none - real (kind=real_kind), intent(in) :: x,y - real (kind=real_kind) , intent(in) :: yeul,slope - - if (fuzzy(ABS(slope),fuzzy_width)>0) THEN - x_cross_eul_lat = x+(yeul-y)/slope - ELSE - ! WRITE(*,*) "WARNING: slope is epsilon - ABORT" - x_cross_eul_lat = bignum - END IF - end function x_cross_eul_lat - - subroutine get_weights_exact(weights,xseg,yseg,nreconstruction) -! use cslam_analytic_mod, only: I_00, I_10, I_01, I_20, I_02, I_11 - implicit none - integer (kind=int_kind), intent(in) :: nreconstruction - real (kind=real_kind), dimension(nreconstruction), intent(out) :: weights - real (kind=real_kind), dimension(2 ), intent(in) :: xseg,yseg - ! - ! compute weights - ! - real (kind=real_kind) :: tmp,slope,b,integral,dx2,xc - integer (kind=int_kind) :: i -! weights(:) = -half*(xseg(1)*yseg(2)-xseg(2)*yseg(1)) !dummy for testing - - weights(1) = ((I_00(xseg(2),yseg(2))-I_00(xseg(1),yseg(1)))) - if (ABS(weights(1))>1.0) THEN - WRITE(*,*) "1 exact weights(jsegment)",weights(1),xseg,yseg - stop - end if - if (nreconstruction>1) then - weights(2) = ((I_10(xseg(2),yseg(2))-I_10(xseg(1),yseg(1)))) - weights(3) = ((I_01(xseg(2),yseg(2))-I_01(xseg(1),yseg(1)))) - endif - if (nreconstruction>3) then - weights(4) = ((I_20(xseg(2),yseg(2))-I_20(xseg(1),yseg(1)))) - weights(5) = ((I_02(xseg(2),yseg(2))-I_02(xseg(1),yseg(1)))) - weights(6) = ((I_11(xseg(2),yseg(2))-I_11(xseg(1),yseg(1)))) - endif - - end subroutine get_weights_exact - - - - subroutine get_weights_gauss(weights,xseg,yseg,nreconstruction,ngauss,gauss_weights,abscissae) - implicit none - integer (kind=int_kind), intent(in) :: nreconstruction,ngauss - real (kind=real_kind), dimension(nreconstruction), intent(out) :: weights - real (kind=real_kind), dimension(2 ), intent(in) :: xseg,yseg - real (kind=real_kind) :: slope - ! - ! compute weights - ! - ! - ! for Gaussian quadrature - ! - real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae - - ! if line-segment parallel to x or y use exact formulaes else use qudrature - ! - real (kind=real_kind) :: tmp,b,integral,dx2,xc,x,y - integer (kind=int_kind) :: i - - - - -! if (fuzzy(abs(xseg(1) -xseg(2)),fuzzy_width)==0)then - if (xseg(1).EQ.xseg(2))then - weights = 0.0D0 - else if (abs(yseg(1) -yseg(2))1) then - weights(2) = ((I_10(xseg(2),yseg(2))-I_10(xseg(1),yseg(1)))) - weights(3) = ((I_01(xseg(2),yseg(2))-I_01(xseg(1),yseg(1)))) - endif - if (nreconstruction>3) then - weights(4) = ((I_20(xseg(2),yseg(2))-I_20(xseg(1),yseg(1)))) - weights(5) = ((I_02(xseg(2),yseg(2))-I_02(xseg(1),yseg(1)))) - weights(6) = ((I_11(xseg(2),yseg(2))-I_11(xseg(1),yseg(1)))) - endif - else - - - slope = (yseg(2)-yseg(1))/(xseg(2)-xseg(1)) - b = yseg(1)-slope*xseg(1) - dx2 = 0.5D0*(xseg(2)-xseg(1)) - if (ldbgr) WRITE(*,*) "dx2 and slope in gauss weight",dx2,slope - xc = 0.5D0*(xseg(1)+xseg(2)) - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_00(x,y) - enddo - weights(1) = integral*dx2 - if (nreconstruction>1) then - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_10(x,y) - enddo - weights(2) = integral*dx2 - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_01(x,y) - enddo - weights(3) = integral*dx2 - endif - if (nreconstruction>3) then - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_20(x,y) - enddo - weights(4) = integral*dx2 - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_02(x,y) - enddo - weights(5) = integral*dx2 - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_11(x,y) - enddo - weights(6) = integral*dx2 - endif - end if - end subroutine get_weights_gauss - - real (kind=real_kind) function F_00(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_00 =y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) - end function F_00 - - real (kind=real_kind) function F_10(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_10 =x*y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) - end function F_10 - - real (kind=real_kind) function F_01(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_01 =-1.0D0/(SQRT(1.0D0+x*x+y*y)) - end function F_01 - - real (kind=real_kind) function F_20(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_20 =x*x*y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) - end function F_20 - - real (kind=real_kind) function F_02(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,alpha, tmp - - x = x_in - y = y_in - - alpha = ATAN(x) - tmp=y*COS(alpha) - F_02 =-y/SQRT(1.0D0+x*x+y*y)+log(tmp+sqrt(tmp*tmp+1)) - - ! - ! cos(alpha) = 1/sqrt(1+x*x) - ! - end function F_02 - - real (kind=real_kind) function F_11(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_11 =-x/(SQRT(1.0D0+x*x+y*y)) - end function F_11 - - subroutine which_eul_cell(x,j_eul,gno) - implicit none - integer (kind=int_kind) , intent(inout) :: j_eul - real (kind=real_kind), dimension(3) , intent(in) :: x - real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: gno !phl -! real (kind=real_kind), intent(in) :: eps - - real (kind=real_kind) :: d1,d2,d3,d1p1 - logical :: lcontinue - integer :: iter - - - ! - ! this is not needed in transport code search - ! -! IF (x(1)gno(nc+2+nhe)) j_eul=nc+1+nhe -! RETURN - -! j_eul = MIN(MAX(j_eul,-nhe),nc+1+nhe) !added - - lcontinue = .TRUE. - iter = 0 - IF (ldbgr) WRITE(*,*) "from which_eul_cell",x(1),x(2),x(3) - DO WHILE (lcontinue) - iter = iter+1 - IF (x(1).GE.gno(j_eul).AND.x(1).LT.gno(j_eul+1)) THEN - lcontinue = .FALSE. - ! - ! special case when x(1) is on top of grid line - ! - IF (x(1).EQ.gno(j_eul)) THEN -! IF (ABS(x(1)-gno(j_eul))1000.OR.j_eul<-nhe.OR.j_eul>nc+2+nhe) THEN - WRITE(*,*) "search in which_eul_cell not converging!", iter,j_eul - WRITE(*,*) "input", x - WRITE(*,*) "gno", gno(nc),gno(nc+1),gno(nc+2),gno(nc+3) - STOP - END IF - END DO - END subroutine which_eul_cell - - - subroutine truncate_vertex(x,j_eul,gno) - implicit none - integer (kind=int_kind) , intent(inout) :: j_eul - real (kind=real_kind) , intent(inout) :: x - real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: gno !phl -! real (kind=real_kind), intent(in) :: eps - - logical :: lcontinue - integer :: iter - real (kind=real_kind) :: xsgn,dist,dist_new,tmp - - ! - ! this is not needed in transport code search - ! -! IF (xgno(nc+2+nhe)) j_eul=nc+1+nhe -! -! RETURN - - - lcontinue = .TRUE. - iter = 0 - dist = bignum -! j_eul = MIN(MAX(j_eul,-nhe),nc+1+nhe) !added - xsgn = INT(SIGN(1.0_dbl_kind,x-gno(j_eul))) - DO WHILE (lcontinue) - iter = iter+1 - tmp = x-gno(j_eul) - dist_new = ABS(tmp) - IF (dist_new>dist) THEN - lcontinue = .FALSE. -! ELSE IF (ABS(tmp)<1.0E-11) THEN - ELSE IF (ABS(tmp)<1.0E-9) THEN -! ELSE IF (ABS(tmp)<1.0E-4) THEN - x = gno(j_eul) - lcontinue = .FALSE. - ELSE - j_eul = j_eul+xsgn - dist = dist_new - END IF - IF (iter>10000) THEN - WRITE(*,*) "truncate vertex not converging" - STOP - END IF - END DO - END subroutine truncate_vertex - - - - -!******************************************************************************** -! -! Gauss-Legendre quadrature -! -! Tabulated values -! -!******************************************************************************** -subroutine gauss_points(n,weights,points) - implicit none - real (kind=real_kind), dimension(n), intent(out) :: weights, points - integer (kind=int_kind) , intent(in ) :: n - - select case (n) -! CASE(1) -! abscissae(1) = 0.0D0 -! weights(1) = 2.0D0 - case(2) - points(1) = -sqrt(1.0D0/3.0D0) - points(2) = sqrt(1.0D0/3.0D0) - weights(1) = 1.0D0 - weights(2) = 1.0D0 - case(3) - points(1) = -0.774596669241483377035853079956D0 - points(2) = 0.0D0 - points(3) = 0.774596669241483377035853079956D0 - weights(1) = 0.555555555555555555555555555556D0 - weights(2) = 0.888888888888888888888888888889D0 - weights(3) = 0.555555555555555555555555555556D0 - case(4) - points(1) = -0.861136311594052575223946488893D0 - points(2) = -0.339981043584856264802665659103D0 - points(3) = 0.339981043584856264802665659103D0 - points(4) = 0.861136311594052575223946488893D0 - weights(1) = 0.347854845137453857373063949222D0 - weights(2) = 0.652145154862546142626936050778D0 - weights(3) = 0.652145154862546142626936050778D0 - weights(4) = 0.347854845137453857373063949222D0 - case(5) - points(1) = -(1.0D0/3.0D0)*sqrt(5.0D0+2.0D0*sqrt(10.0D0/7.0D0)) - points(2) = -(1.0D0/3.0D0)*sqrt(5.0D0-2.0D0*sqrt(10.0D0/7.0D0)) - points(3) = 0.0D0 - points(4) = (1.0D0/3.0D0)*sqrt(5.0D0-2.0D0*sqrt(10.0D0/7.0D0)) - points(5) = (1.0D0/3.0D0)*sqrt(5.0D0+2.0D0*sqrt(10.0D0/7.0D0)) - weights(1) = (322.0D0-13.0D0*sqrt(70.0D0))/900.0D0 - weights(2) = (322.0D0+13.0D0*sqrt(70.0D0))/900.0D0 - weights(3) = 128.0D0/225.0D0 - weights(4) = (322.0D0+13.0D0*sqrt(70.0D0))/900.0D0 - weights(5) = (322.0D0-13.0D0*sqrt(70.0D0))/900.0D0 - case default - write(*,*) 'n out of range in glwp of module gll. n=',n - write(*,*) '0 0.0D0) THEN - signum = 1.0D0 - ELSEIF (x < 0.0D0) THEN - signum = -1.0D0 - ELSE - signum = 0.0D0 - ENDIF - end function - -!------------------------------------------------------------------------------ -! FUNCTION SIGNUM_FUZZY -! -! Description: -! Gives the sign of the given real number, returning zero if x is within -! a small amount from zero. -!------------------------------------------------------------------------------ - function signum_fuzzy(x) - implicit none - - real (kind=real_kind) :: signum_fuzzy - real (kind=real_kind) :: x - - IF (x > fuzzy_width) THEN - signum_fuzzy = 1.0D0 - ELSEIF (x < fuzzy_width) THEN - signum_fuzzy = -1.0D0 - ELSE - signum_fuzzy = 0.0D0 - ENDIF - end function - - function fuzzy(x,epsilon) - implicit none - - integer (kind=int_kind) :: fuzzy - real (kind=real_kind), intent(in) :: epsilon - real (kind=real_kind) :: x - - IF (ABS(x)epsilon) THEN - fuzzy = 1 - ELSE !IF (x < fuzzy_width) THEN - fuzzy = -1 - ENDIF - end function - -! -! see, e.g., http://local.wasp.uwa.edu.au/~pbourke/geometry/lineline2d/ -! -subroutine check_lines_cross(x1,x2,x3,x4,y1,y2,y3,y4,lcross) - implicit none - real (kind=real_kind), INTENT(IN) :: x1,x2,x3,x4,y1,y2,y3,y4 - LOGICAL, INTENT(OUT) :: lcross - ! - ! local workspace - ! - real (kind=real_kind) :: cp,tx,ty - - cp = (y4-y3)*(x2-x1)-(x4-x3)*(y2-y1) - IF (ABS(cp)-tiny.AND.tx<1.0D0+tiny.AND.& - ty>-tiny.AND.ty<1.0D0+tiny) THEN - lcross = .TRUE. - ELSE - lcross = .FALSE. -! WRITE(*,*) "not parallel but not crossing,",tx,ty - ENDIF - ENDIF -end subroutine check_lines_cross - - - REAL (KIND=dbl_kind) FUNCTION I_00(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y - - x = x_in/aa - y = y_in/aa -! x = x_in -! y = y_in - I_00 = ATAN(x*y/SQRT(one+x*x+y*y)) - END FUNCTION I_00 - - REAL (KIND=dbl_kind) FUNCTION I_10(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y,tmp - - x = x_in/aa - y = y_in/aa - tmp = ATAN(x) - I_10 = -ASINH(y*COS(tmp)) - ! - ! = -arcsinh(y/sqrt(1+x^2)) - ! - END FUNCTION I_10 - - REAL (KIND=dbl_kind) FUNCTION I_10_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - I_10_ab = -ASINH(COS(alpha) * TAN(beta)) - END FUNCTION I_10_AB - - REAL (KIND=dbl_kind) FUNCTION I_01(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y!,beta - - x = x_in/aa - y = y_in/aa -! beta = ATAN(y) -! I_01 = -ASINH(x*COS(beta)) - I_01 = -ASINH(x/SQRT(1+y*y)) - END FUNCTION I_01 - - REAL (KIND=dbl_kind) FUNCTION I_01_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - I_01_ab = -ASINH(COS(beta) * TAN(alpha)) - END FUNCTION I_01_AB - - REAL (KIND=dbl_kind) FUNCTION I_20(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y, tmp!,alpha,beta - - x = x_in/aa - y = y_in/aa -! alpha = aa*ATAN(x) -! beta = aa*ATAN(y) - - tmp = one+y*y - -! I_20 = y*ASINH(COS(beta)*x)+ACOS(SIN(alpha)*SIN(beta)) - I_20 = y*ASINH(x/SQRT(tmp))+ACOS(x*y/(SQRT((one+x*x)*tmp))) - END FUNCTION I_20 - - REAL (KIND=dbl_kind) FUNCTION I_20_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - - I_20_ab = TAN(beta)*ASINH(COS(beta)*TAN(alpha))+ACOS(SIN(alpha)*SIN(beta)) - END FUNCTION I_20_AB - - REAL (KIND=dbl_kind) FUNCTION I_02(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y, tmp!,alpha,beta - - x = x_in/aa - y = y_in/aa -! alpha = aa*ATAN(x) -! beta = aa*ATAN(y) - - tmp=one+x*x - - I_02 = x*ASINH(y/SQRT(tmp))+ACOS(x*y/SQRT(tmp*(1+y*y))) - END FUNCTION I_02 - - REAL (KIND=dbl_kind) FUNCTION I_02_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - - I_02_ab = TAN(alpha)*ASINH(TAN(beta)*COS(alpha))+ACOS(SIN(alpha)*SIN(beta)) - END FUNCTION I_02_AB - - - REAL (KIND=dbl_kind) FUNCTION I_11(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y - - x = x_in/aa - y = y_in/aa - - I_11 = -SQRT(1+x*x+y*y) - END FUNCTION I_11 - - REAL (KIND=dbl_kind) FUNCTION I_11_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - - I_11_ab = -SQRT(one+TAN(alpha)**2+TAN(beta)**2) - END FUNCTION I_11_AB -!------------------------------------------------------------------------------ -! FUNCTION ASINH -! -! Description: -! Hyperbolic arcsin function -!------------------------------------------------------------------------------ - FUNCTION ASINH(x) - IMPLICIT NONE - - REAL (KIND=dbl_kind) :: ASINH - REAL (KIND=dbl_kind) :: x - - ASINH = LOG(x + SQRT(x * x + one)) - END FUNCTION - - - !******************************************************************************** - ! - ! Gauss-Legendre quadrature - ! - ! Tabulated values - ! - !******************************************************************************** - SUBROUTINE glwp(n,weights,abscissae) - IMPLICIT NONE - REAL (KIND=dbl_kind), DIMENSION(n), INTENT(OUT) :: weights, abscissae - INTEGER (KIND=int_kind) , INTENT(IN ) :: n - - SELECT CASE (n) - CASE(1) - abscissae(1) = 0.0 - weights(1) = 2.0 - CASE(2) - abscissae(1) = -SQRT(1.0/3.0) - abscissae(2) = SQRT(1.0/3.0) - weights(1) = 1.0 - weights(2) = 1.0 - CASE(3) - abscissae(1) = -0.774596669241483377035853079956_dbl_kind - abscissae(2) = 0.0 - abscissae(3) = 0.774596669241483377035853079956_dbl_kind - weights(1) = 0.555555555555555555555555555556_dbl_kind - weights(2) = 0.888888888888888888888888888889_dbl_kind - weights(3) = 0.555555555555555555555555555556_dbl_kind - CASE(4) - abscissae(1) = -0.861136311594052575223946488893_dbl_kind - abscissae(2) = -0.339981043584856264802665659103_dbl_kind - abscissae(3) = 0.339981043584856264802665659103_dbl_kind - abscissae(4) = 0.861136311594052575223946488893_dbl_kind - weights(1) = 0.347854845137453857373063949222_dbl_kind - weights(2) = 0.652145154862546142626936050778_dbl_kind - weights(3) = 0.652145154862546142626936050778_dbl_kind - weights(4) = 0.347854845137453857373063949222_dbl_kind - CASE(5) - abscissae(1) = -(1.0/3.0)*SQRT(5.0+2.0*SQRT(10.0/7.0)) - abscissae(2) = -(1.0/3.0)*SQRT(5.0-2.0*SQRT(10.0/7.0)) - abscissae(3) = 0.0 - abscissae(4) = (1.0/3.0)*SQRT(5.0-2.0*SQRT(10.0/7.0)) - abscissae(5) = (1.0/3.0)*SQRT(5.0+2.0*SQRT(10.0/7.0)) - weights(1) = (322.0_dbl_kind-13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind - weights(2) = (322.0_dbl_kind+13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind - weights(3) = 128.0_dbl_kind/225.0_dbl_kind - weights(4) = (322.0_dbl_kind+13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind - weights(5) = (322.0_dbl_kind-13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind - CASE DEFAULT - WRITE(*,*) 'n out of range in glwp of module gll. n=',n - WRITE(*,*) '0 shr_kind_r8 - implicit none -! - integer, parameter :: ntile = 33 ! number of tiles in USGS GTOPO30 dataset - integer, parameter :: im = 43200 ! total grids in x direction of 30-sec global dataset - integer, parameter :: jm = 21600 ! total grids in y direction of 30-sec global dataset - real(r8), parameter :: dx = 1.0/120.0 ! space interval for 30-sec data (in degree) - - character (len=7) :: nmtile(ntile) ! name of each tile - integer :: ncols,nrows ! number of columns and rows for 30-sec tile - integer :: nodata ! integer for ocean point - real(r8):: ulxmap ! longitude at the center of the upper-left corner cell in the 30-sec tile - real(r8):: ulymap ! latitude at the center of the upper-left corner cell in the 30-sec tile - real(r8):: lon_start ! longitude at the center of grid (1,1) in the 30-sec netCDF global data - real(r8):: lat_start ! latitude at the center of grid (1,1) in the 30-sec netCDF global data - real(r8):: lonsw ! longitude at the center of southwest corner cell in the 30-sec tile - real(r8):: latsw ! latitude at the center of southwest corner cell in the 30-sec tile - integer :: i1,j1 ! the (i,j) point of the southwest corner of the 30-sec tile in the global grid - - integer*2, allocatable, dimension(:,:) :: terr ! global 30-sec terrain data - integer*1, allocatable, dimension(:,:) :: land_fraction ! global 30-sec land fraction - - integer :: alloc_error,dealloc_error - integer :: i,j,n ! index - integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile - integer*2, allocatable, dimension(:,:) :: terr_tile ! terrain data for 30-sec tile - integer*1, allocatable, dimension(:,:) :: land_fraction_tile -! - lat_start=-90.0 + 0.5 * dx - lon_start=0.5*dx - ! - ! Initialize each tile name - ! - nmtile(1) = 'W180N90' - nmtile(2) = 'W140N90' - nmtile(3) = 'W100N90' - nmtile(4) = 'W060N90' - nmtile(5) = 'W020N90' - nmtile(6) = 'E020N90' - nmtile(7) = 'E060N90' - nmtile(8) = 'E100N90' - nmtile(9) = 'E140N90' - - nmtile(10) = 'W180N40' - nmtile(11) = 'W140N40' - nmtile(12) = 'W100N40' - nmtile(13) = 'W060N40' - nmtile(14) = 'W020N40' - nmtile(15) = 'E020N40' - nmtile(16) = 'E060N40' - nmtile(17) = 'E100N40' - nmtile(18) = 'E140N40' - - nmtile(19) = 'W180S10' - nmtile(20) = 'W140S10' - nmtile(21) = 'W100S10' - nmtile(22) = 'W060S10' - nmtile(23) = 'W020S10' - nmtile(24) = 'E020S10' - nmtile(25) = 'E060S10' - nmtile(26) = 'E100S10' - nmtile(27) = 'E140S10' - - nmtile(28) = 'W180S60' - nmtile(29) = 'W120S60' - nmtile(30) = 'W060S60' - nmtile(31) = 'W000S60' - nmtile(32) = 'E060S60' - nmtile(33) = 'E120S60' - - - allocate ( land_fraction(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for land_fraction' - stop - end if - - allocate ( terr(im,jm),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr' - stop - end if - - do j = 1, jm - do i = 1, im - terr(i,j) = -999999.0 - land_fraction(i,j) = -99.0 - end do - end do - - do n = 1,ntile -! -! Read header for each tile -! - call rdheader(nmtile(n),nrows,ncols,nodata,ulxmap,ulymap) - -! -! Allocate space for array iterr -! - allocate ( iterr(ncols,nrows),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for iterr' - stop - end if -! -! Read terr data for each tile -! - call rdterr(nmtile(n),nrows,ncols,iterr) -! -! Allocate space for arrays terr_tile and psea10m -! - allocate ( terr_tile(ncols,nrows),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr_tile' - stop - end if - allocate ( land_fraction_tile(ncols,nrows),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for land_fraction_tile' - stop - end if -! -! Expand Caspian Sea for tiles 6 and 15 -! - if(nmtile(n).eq.'E020N90')call expand_sea(ncols,nrows,iterr,nodata,3600,5300) - if(nmtile(n).eq.'E020N90')call expand_sea(ncols,nrows,iterr,nodata,4088,5874) - if(nmtile(n).eq.'E020N40')call expand_sea(ncols,nrows,iterr,nodata,3600,1) - print *, "min and maxiterr: ", minval(iterr), maxval(iterr) -! -! area average of 30-sec tile to 30-sec tile -! - call avg(ncols,nrows,iterr,nodata,ulymap,dx,terr_tile,land_fraction_tile) - -! -! Print some info on the fields - print *, "min and max elevations: ", minval(terr_tile), maxval(terr_tile) - print *, "min and max land_fraction: ", minval(land_fraction_tile), maxval(land_fraction_tile) -! -! fit the 30-sec tile into global 30-sec dataset -! - - latsw= ulymap - (nrows-1) * dx - lonsw = ulxmap - if( lonsw < 0.0 ) lonsw=360.0+lonsw - i1 = nint( (lonsw - lon_start) / dx )+1 - if( i1 <= 0 ) i1 = i1 + im - if( i1 > im ) i1 = i1 - im - j1 = nint( (latsw- lat_start) / dx )+1 - -! print*,'ulymap,ulxmap,latsw10,lonsw = ',ulymap,ulxmap,latsw10,lonsw -! print*,'i1,j1 = ', i1,j1 - - call fitin(ncols,nrows,terr_tile,land_fraction_tile,i1,j1,im,jm,terr,land_fraction) -! -! Deallocate working space for arrays iterr, terr_tile and psea10m -! - deallocate ( iterr,terr_tile,land_fraction_tile,stat=dealloc_error ) - if( dealloc_error /= 0 ) then - print*,'Unexpected deallocation error for arrays iterr,terr_tile' - stop - end if - - end do - WRITE(*,*) 'done reading in USGS data' -! -! Print some info on the fields - print *, "min and max elevations: ", minval(terr), maxval(terr) - print *, "min and max land frac: ", minval(land_fraction), maxval(land_fraction) -! -! Write 30-sec terrain dataset, and land_fraction to NetCDF file -! -! call wrtncdf(im,jm,terr,land_fraction,dx) - call wrtncdf(im,jm,terr,land_fraction,dx,100) - end program convterr - - subroutine rdheader(nmtile,nrows,ncols,nodata,ulxmap,ulymap) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine read the header of USGA Global30 sec TOPO data set. -! - implicit none -! -! Dummy arguments -! - character (len=7), intent(in) :: nmtile ! name of the tile - integer, intent(out) :: nrows ! number of rows - integer, intent(out) :: ncols ! number of column - integer, intent(out) :: nodata ! integer for ocean data point - real(r8), intent(out) :: ulxmap - real(r8), intent(out) :: ulymap -! -! Local variables -! - character (len=11) :: flheader ! file name of the header - character (len=13) :: chars ! dummy character - - flheader=nmtile//'.HDR' - - print*,'flheader = ', flheader -! -! Open GTOPO30 Header File -! - open(unit=10,file=flheader,status='old',form='formatted') -! -! Read GTOPO30 Header file -! - read (10, *) - read (10, *) - read (10, *) chars,nrows - print*,chars,' = ',nrows - read (10, *) chars,ncols - print*,chars,' = ',ncols - read (10, *) - read (10, *) - read (10, *) - read (10, *) - read (10, *) - read (10, *) chars,nodata - print*,chars,' = ',nodata - read (10, *) chars,ulxmap - print*,chars,' = ',ulxmap - read (10, *) chars,ulymap - print*,chars,' = ',ulymap - close(10) - - end subroutine rdheader - - subroutine rdterr(nmtile,nrows,ncols,iterr) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine read the USGS Global 30-sec terrain data for each tile. -! - implicit none -! -! Dummy arguments -! - character (len=7), intent(in) :: nmtile ! name of the tile - integer, intent(in) :: nrows ! number of rows - integer, intent(in) :: ncols ! number of column - integer*2, dimension(ncols,nrows), intent(out) :: iterr ! terrain data -! -! Local variables -! - character (len=11) :: flterr ! file name for each terr dataset - integer :: io_error ! I/O status - integer :: i,j ! Index - integer :: length ! record length - - flterr=nmtile//'.DEM' - -! print*,'flterr = ', flterr -! print*,'nrows,ncols = ',nrows,ncols -! -! Open GTOPO30 Terrain dataset File -! - - length = 2 * ncols * nrows - io_error=0 - open(unit=11,file=flterr,access='direct',recl=length,iostat=io_error) - if( io_error /= 0 ) then - print*,'Open file error in subroutine rdterr' - print*,'iostat = ', io_error - stop - end if -! -! Read GTOPO30 Terrain data file -! - read (11,rec=1,iostat=io_error) ((iterr(i,j),i=1,ncols),j=1,nrows) -! - if( io_error /= 0 ) then - print*,'Data file error in subroutine rdterr' - print*,'iostat = ', io_error - stop - end if -! -! Print some info on the fields - print *, "min and max elevations: ", minval(iterr), maxval(iterr) -! -! Correct missing data in source files -! -! Missing data near dateline - - if( nmtile == 'W180S60' ) then - do j = 1, nrows - iterr(1,j) = iterr(2,j) - end do - else if (nmtile == 'E120S60') then - do j = 1, nrows - iterr(ncols-1,j) = iterr(ncols-2,j) - iterr(ncols,j) = iterr(ncols-2,j) - end do - end if -! -! Missing data at the southermost row near South pole -! - if( nmtile == 'E060S60' .or. nmtile == 'E120S60' .or. nmtile == 'W000S60' .or. & - nmtile == 'W060S60' .or. nmtile == 'W120S60' .or. nmtile == 'W180S60' ) then - do i=1,ncols - iterr(i,nrows) = iterr(i,nrows-1) - end do - end if -! -! print*,'iterr(1,1),iterr(ncols,nrows) = ', & -! iterr(1,1),iterr(ncols,nrows) - - close (11) - end subroutine rdterr - - subroutine avg(ncols,nrows,iterr,nodata,ulymap,dx,terr_tile,land_fraction_tile) - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none -! -! Dummy arguments -! - integer, intent(in) :: ncols ! number of column for 30-sec tile - integer, intent(in) :: nrows ! number of rows for 30-sec tile - integer*2, dimension(ncols,nrows), intent(inout) :: iterr ! terrain data for 30-sec tile - integer, intent(in) :: nodata ! integer for ocean data point - real(r8),intent(in) :: ulymap ! latitude at the center of the upper-left corner cell in the 30-sec tile - real(r8),intent(in) :: dx ! spacing interval for 30-sec data (in degree) - integer*2, dimension(ncols,nrows), intent(out) :: terr_tile ! terrain data for 30-sec tile - integer*1, dimension(ncols,nrows), intent(out) :: land_fraction_tile -! -! Local variables -! - real(r8) :: lats,latn ! latitudes (in rad) for ths south and north edges of each 30-sec cell - real(r8) :: wt ! area weighting of each 30-sec cell - real(r8) :: wt_tot ! total weighting of each 30-sec cell - real(r8) :: sumterr ! summation of terrain height of each 30-sec cell - real(r8) :: sumsea ! summation of sea coverage of each 30-sec cell - real(r8) :: pi ! pi=3.1415 - real(r8) :: latul ! latitude of the upper-left coner of 30-sec tile - integer :: n1,itmp,i1,i2,j1,j2 ! temporary working spaces - integer :: i,j,ii,jj ! index - logical, dimension(ncols,nrows) :: oflag - - pi = 4.0 * atan(1.0) -! - n1 = ncols / ncols - print*,'ncols,ncols,n1 = ',ncols,ncols,n1 - - itmp = nint( ulymap + 0.5 * dx ) - latul = itmp - print*,'ulymap,latul = ', ulymap,latul - oflag = .false. - - do j = 1, nrows - j1 = j - j2 = j - do i = 1, ncols - i1 = i - i2 = i - terr_tile(i,j) = 0 - land_fraction_tile(i,j) = 1 - if ( iterr(i,j) == nodata ) then - land_fraction_tile(i,j) = 0 - else - if ( iterr(i,j) .lt.nodata ) then - ! this can only happen in the expand_sea routine - land_fraction_tile(i,j) = 0 - iterr(i,j) = iterr(i,j) - nodata - nodata - endif - terr_tile(i,j) = iterr(i,j) - end if - end do - end do - - end subroutine avg - - subroutine expand_sea(ncols,nrows,iterr,nodata,startx,starty) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine reduces the resolution of the terrain data from 30-sec to 30-sec and -! compute the percentage of ocean cover (psea10m) -! - implicit none -! -! Dummy arguments -! - integer, intent(in) :: ncols ! number of column for 30-sec tile - integer, intent(in) :: nrows ! number of rows for 30-sec tile - integer*2, dimension(ncols,nrows), intent(inout) :: iterr ! terrain data for 30-sec tile - integer, intent(in) :: nodata ! integer for ocean data point - integer, intent(in) :: startx, starty ! where to begin the sea -! -! Local variables -! - real(r8):: maxh - integer :: i,j,per,ii,jj ! index - logical, dimension(0:ncols+1,0:nrows+1) :: flag ! terrain data for 30-sec tile - logical :: found - - flag = .false. - - maxh = iterr(startx,starty) - - iterr(startx,starty) = iterr(startx,starty) + nodata + nodata - flag(startx-1:startx+1,starty-1:starty+1) = .true. - - per = 0 - print *, 'expanding sea at ',maxh,' m ' - -2112 per = per + 1 - found = .false. - do j = starty - per, starty + per, per*2 - do i = startx - per, startx + per - if(i.ge.1.and.i.le.ncols.and.j.ge.1.and.j.le.nrows)then - if( iterr(i,j).eq.maxh .and. flag(i,j) ) then - iterr(i,j) = iterr(i,j) + nodata + nodata - flag(i-1:i+1,j-1:j+1) = .true. - found = .true. - endif - endif - end do - end do - - do i = startx - per, startx + per, per*2 - do j = starty - per + 1, starty + per - 1 - if(i.ge.1.and.i.le.ncols.and.j.ge.1.and.j.le.nrows)then - if( iterr(i,j).eq.maxh .and. flag(i,j) ) then - iterr(i,j) = iterr(i,j) + nodata + nodata - flag(i-1:i+1,j-1:j+1) = .true. - found = .true. - endif - endif - end do - end do - if (found)goto 2112 - print *, 'done with expand_sea' - return - - end subroutine expand_sea - - subroutine fitin(ncols,nrows,terr_tile,land_fraction_tile,i1,j1,im,jm,terr,land_fraction) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine put 30-sec tile into the global dataset -! - implicit none -! -! Dummy arguments -! - integer, intent(in) :: ncols ! number of columns for 30-sec tile - integer, intent(in) :: nrows ! number of rows for 30-sec tile - integer*2, dimension(ncols,nrows), intent(in) :: terr_tile ! terrain data for 30-sec tile - integer*1, dimension(ncols,nrows), intent(in) :: land_fraction_tile - integer, intent(in) :: i1,j1 ! the (i,j) point of the southwest corner of the 30-sec tile - ! in the global grid - integer, intent(in) :: im,jm ! the dimensions of the 30-sec global dataset - integer*2,dimension(im,jm), intent(out) :: terr ! global 30-sec terrain data - integer*1,dimension(im,jm), intent(out) :: land_fraction ! global 30-sec land fraction -! -! Local variables -! - integer :: i,j,ii,jj ! index - - do j = 1, nrows - jj = j1 + (nrows - j) - do i = 1, ncols - ii = i1 + (i-1) - - if( i == 1 .and. j == 1 ) & - print*,'i,j,ii,jj = ',i,j,ii,jj - if( i == ncols .and. j == nrows ) & - print*,'i,j,ii,jj = ',i,j,ii,jj - - if( ii > im ) ii = ii - im - terr(ii,jj) = terr_tile(i,j) - land_fraction(ii,jj) = land_fraction_tile(i,j) - end do - end do - end subroutine fitin - - subroutine wrtncdf(im,jm,terr,land_fraction,dx) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine save 30-sec terrain data, land fraction to NetCDF file -! - implicit none - -# include - -! -! Dummy arguments -! - integer, intent(in) :: im,jm ! the dimensions of the 30-sec global dataset - integer*2,dimension(im,jm), intent(in) :: terr ! global 30-sec terrain data - integer*1,dimension(im,jm), intent(in) :: land_fraction !global 30-sec land fraction - real(r8), intent(in) :: dx -! -! Local variables -! - real(r8),dimension(im) :: lonar ! longitude array - real(r8),dimension(im) :: latar ! latitude array - character (len=32) :: fout ! NetCDF output file - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: htopoid - integer :: landfid - integer, dimension(2) :: htopodim,landfdim - integer :: status ! return value for error control of netcdf routin - integer :: i,j - character (len=8) :: datestring - - integer*2,dimension(im,jm) :: h ! global 30-sec terrain data - integer*1,dimension(im,jm) :: lnd - - -! -! Fill lat and lon arrays -! - do i = 1,im - lonar(i)= dx * (i-0.5) - enddo - do j = 1,jm - latar(j)= -90.0 + dx * (j-0.5) - enddo - - do j=1,jm - do i=1,im - h(i,j) = terr(i,j) - lnd(i,j) = land_fraction(i,j) - end do - end do - - fout='usgs-rawdata.nc' -! -! Create NetCDF file for output -! - print *,"Create NetCDF file for output" - status = nf_create (fout, NF_64BIT_OFFSET , foutid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Create dimensions for output -! - print *,"Create dimensions for output" - status = nf_def_dim (foutid, 'lon', im, lonid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'lat', jm, latid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Create variable for output -! - print *,"Create variable for output" - htopodim(1)=lonid - htopodim(2)=latid - status = nf_def_var (foutid,'htopo', NF_INT, 2, htopodim, htopoid) - if (status .ne. NF_NOERR) call handle_err(status) -! - landfdim(1)=lonid - landfdim(2)=latid - status = nf_def_var (foutid,'landfract', NF_INT, 2, landfdim, landfid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! Create attributes for output variables -! - status = nf_put_att_text (foutid,htopoid,'long_name', 41, '30-sec elevation from USGS 30-sec dataset') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,htopoid,'units', 5, 'meter') - if (status .ne. NF_NOERR) call handle_err(status) -! - status = nf_put_att_text (foutid,landfid,'long_name', 23, '30-second land fraction') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,landfid,'units', 14, 'fraction (0-1)') - if (status .ne. NF_NOERR) call handle_err(status) -! - status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') - if (status .ne. NF_NOERR) call handle_err(status) - call DATE_AND_TIME(DATE=datestring) - status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! End define mode for output file -! - status = nf_enddef (foutid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Write variable for output -! - print*,"writing terrain data" - status = nf_put_var_int2 (foutid, htopoid, h) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing terrain data" -! - status = nf_put_var_int1 (foutid, landfid, lnd) - if (status .ne. NF_NOERR) call handle_err(status) -! - print*,"writing lat data" - status = nf_put_var_double (foutid, latvid, latar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lat data" - - print*,"writing lon data" - status = nf_put_var_double (foutid, lonvid, lonar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lon data" -! -! Close output file -! - print *,"close file" - status = nf_close (foutid) - if (status .ne. NF_NOERR) call handle_err(status) - - end subroutine wrtncdf - - - ! - ! same as wrtncdf but the output is coarsened - ! - subroutine wrtncdf_coarse(im,jm,terr,land_fraction,dx,ic) - use shr_kind_mod, only: r8 => shr_kind_r8 -! -! This subroutine save 30-sec terrain data, land fraction to NetCDF file -! - implicit none - -# include - -! -! Dummy arguments -! - integer, intent(in) :: im,jm ! the dimensions of the 30-sec global dataset - integer, intent(in) :: ic ! coarsening factor - integer*2,dimension(im,jm), intent(in) :: terr ! global 30-sec terrain data - integer*1,dimension(im,jm), intent(in) :: land_fraction !global 30-sec land fraction - real(r8), intent(in) :: dx -! -! Local variables -! - real(r8),dimension(im/ic) :: lonar ! longitude array - real(r8),dimension(im/ic) :: latar ! latitude array - character (len=32) :: fout ! NetCDF output file - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: htopoid - integer :: landfid - integer, dimension(2) :: htopodim,landfdim - integer :: status ! return value for error control of netcdf routin - integer :: i,j - character (len=8) :: datestring - - integer*2,dimension(im/ic,jm/ic) :: h ! global 30-sec terrain data - integer*1,dimension(im/ic,jm/ic) :: lnd - - -! -! Fill lat and lon arrays -! - do i = 1,im/ic - lonar(i)= real(ic)*dx * (i-0.5) - enddo - do j = 1,jm/ic - latar(j)= -90.0 + real(ic)*dx * (j-0.5) - enddo - - do j=1,jm/ic - do i=1,im/ic - h(i,j) = terr(i*ic,j*ic) - lnd(i,j) = land_fraction(i*ic,j*ic) - end do - end do - - fout='usgs-lowres.nc' -! -! Create NetCDF file for output -! - print *,"Create NetCDF file for output" - status = nf_create (fout, NF_64BIT_OFFSET , foutid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Create dimensions for output -! - print *,"Create dimensions for output" - status = nf_def_dim (foutid, 'lon', im/ic, lonid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'lat', jm/ic, latid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Create variable for output -! - print *,"Create variable for output" - htopodim(1)=lonid - htopodim(2)=latid - status = nf_def_var (foutid,'htopo', NF_INT, 2, htopodim, htopoid) - if (status .ne. NF_NOERR) call handle_err(status) -! - landfdim(1)=lonid - landfdim(2)=latid - status = nf_def_var (foutid,'landfract', NF_INT, 2, landfdim, landfid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! Create attributes for output variables -! - status = nf_put_att_text (foutid,htopoid,'long_name', 41, '30-sec elevation from USGS 30-sec dataset') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,htopoid,'units', 5, 'meter') - if (status .ne. NF_NOERR) call handle_err(status) -! - status = nf_put_att_text (foutid,landfid,'long_name', 23, '30-second land fraction') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,landfid,'units', 14, 'fraction (0-1)') - if (status .ne. NF_NOERR) call handle_err(status) -! - status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') - if (status .ne. NF_NOERR) call handle_err(status) - call DATE_AND_TIME(DATE=datestring) - status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) - if (status .ne. NF_NOERR) call handle_err(status) - -! -! End define mode for output file -! - status = nf_enddef (foutid) - if (status .ne. NF_NOERR) call handle_err(status) -! -! Write variable for output -! - print*,"writing terrain data" - status = nf_put_var_int2 (foutid, htopoid, h) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing terrain data" -! - status = nf_put_var_int1 (foutid, landfid, lnd) - if (status .ne. NF_NOERR) call handle_err(status) -! - print*,"writing lat data" - status = nf_put_var_double (foutid, latvid, latar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lat data" - - print*,"writing lon data" - status = nf_put_var_double (foutid, lonvid, lonar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lon data" -! -! Close output file -! - print *,"close file" - status = nf_close (foutid) - if (status .ne. NF_NOERR) call handle_err(status) - - end subroutine wrtncdf_coarse -!************************************************************************ -!!handle_err -!************************************************************************ -! -!!ROUTINE: handle_err -!!DESCRIPTION: error handler -!-------------------------------------------------------------------------- - - subroutine handle_err(status) - - implicit none - -# include - - integer status - - if (status .ne. nf_noerr) then - print *, nf_strerror(status) - stop 'Stopped' - endif - - end subroutine handle_err - - - diff --git a/tools/topo_tool/gen_netCDF_from_USGS/shr_kind_mod.F90 b/tools/topo_tool/gen_netCDF_from_USGS/shr_kind_mod.F90 deleted file mode 100644 index fc1ed8e94a..0000000000 --- a/tools/topo_tool/gen_netCDF_from_USGS/shr_kind_mod.F90 +++ /dev/null @@ -1,20 +0,0 @@ -!=============================================================================== -! CVS: $Id$ -! CVS: $Source$ -! CVS: $Name$ -!=============================================================================== - -MODULE shr_kind_mod - - !---------------------------------------------------------------------------- - ! precision/kind constants add data public - !---------------------------------------------------------------------------- - public - integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real - integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real - integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real - integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer - integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer - integer,parameter :: SHR_KIND_IN = kind(1) ! native integer - -END MODULE shr_kind_mod